From 0f7f1d833086cf90f568ae3bb229bebeebfb7bd2 Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Mon, 21 Sep 2026 18:08:00 +0000 Subject: [PATCH 01/49] Import complete Beyond Bethe permanent development and complexity dependency --- LeanPool.lean | 706 +++++ LeanPool/BeyondBethe.lean | 726 +++++ LeanPool/BeyondBethe/BeyondBethe.lean | 260 ++ .../BeyondBethe/AdaptiveRoundedEllipsoid.lean | 583 ++++ .../BeyondBethe/AlgorithmicSpec.lean | 516 ++++ .../BeyondBethe/ApproximateKKT.lean | 250 ++ .../BeyondBethe/BeyondBethe/AxiomAudit.lean | 10 + LeanPool/BeyondBethe/BeyondBethe/Bethe.lean | 121 + .../BeyondBethe/BetheBisection.lean | 385 +++ .../BeyondBethe/BetheEpigraph.lean | 552 ++++ .../BeyondBethe/BetheEpigraphFeasibility.lean | 270 ++ .../BeyondBethe/BetheEpigraphGeometry.lean | 767 +++++ .../BeyondBethe/BetheFloorCutFormula.lean | 94 + .../BetheThresholdFeasibility.lean | 191 ++ .../BeyondBethe/BinaryDirectedElementary.lean | 252 ++ .../BeyondBethe/BinaryLongDivision.lean | 348 +++ .../BeyondBethe/BinaryRationalComparison.lean | 93 + .../BeyondBethe/BinaryRationalFloor.lean | 82 + .../BeyondBethe/BeyondBethe/Birkhoff.lean | 130 + .../BeyondBethe/BeyondBethe/Capacity.lean | 353 +++ .../BeyondBethe/CapacityOrder.lean | 79 + .../BeyondBethe/CapacityScaling.lean | 87 + .../BeyondBethe/CertificateCapacity.lean | 263 ++ .../BeyondBethe/CertificateMagnitude.lean | 446 +++ .../BeyondBethe/CertifiedPairWeights.lean | 290 ++ .../BeyondBethe/CleanConstants.lean | 330 +++ .../BeyondBethe/BeyondBethe/CleanGain.lean | 361 +++ .../BeyondBethe/BeyondBethe/CleanWitness.lean | 972 +++++++ .../BeyondBethe/BeyondBethe/ClusterAlpha.lean | 106 + .../BeyondBethe/ClusterCertificate.lean | 364 +++ .../BeyondBethe/ClusterFactors.lean | 187 ++ .../BeyondBethe/ClusterProduct.lean | 527 ++++ .../BeyondBethe/BeyondBethe/Completion.lean | 339 +++ .../BeyondBethe/BeyondBethe/CoreEncoding.lean | 459 +++ .../BeyondBethe/CycleTransfer.lean | 299 ++ LeanPool/BeyondBethe/BeyondBethe/Cycles.lean | 717 +++++ .../BeyondBethe/DirectedCertificateValue.lean | 525 ++++ .../BeyondBethe/DirectedElementary.lean | 887 ++++++ .../BeyondBethe/DirectedOptimizerOracle.lean | 308 ++ .../BeyondBethe/DirectedPairCost.lean | 257 ++ .../BeyondBethe/DyadicMagnitudePrecision.lean | 144 + .../BeyondBethe/DyadicRounding.lean | 194 ++ LeanPool/BeyondBethe/BeyondBethe/Entropy.lean | 859 ++++++ .../BeyondBethe/ExcursionTransfer.lean | 375 +++ .../BeyondBethe/ExecutableCertificate.lean | 207 ++ .../ExecutableCertificateMagnitude.lean | 45 + .../BeyondBethe/ExecutableInterior.lean | 200 ++ .../ExecutablePositiveRoutine.lean | 155 ++ .../ExecutableScannedBetheOptimizer.lean | 332 +++ .../BeyondBethe/ExecutableTransfer.lean | 144 + .../BeyondBethe/ExplicitBetheOptimizer.lean | 353 +++ .../ExplicitBetheThresholdFeasibility.lean | 161 ++ .../BeyondBethe/ExplicitBounds.lean | 740 +++++ .../BeyondBethe/ExplicitOptimizerScales.lean | 435 +++ .../BeyondBethe/ExplicitPositiveRoutine.lean | 160 ++ .../BeyondBethe/ExplicitScales.lean | 403 +++ .../ExplicitScheduledFeasibility.lean | 240 ++ .../BeyondBethe/FinalAssembly.lean | 507 ++++ LeanPool/BeyondBethe/BeyondBethe/Gain.lean | 432 +++ LeanPool/BeyondBethe/BeyondBethe/Gibbs.lean | 265 ++ .../BeyondBethe/BeyondBethe/GoodRowScore.lean | 775 ++++++ .../BeyondBethe/GreedyRowMatching.lean | 385 +++ .../BeyondBethe/BeyondBethe/KuhnMatching.lean | 929 +++++++ .../BeyondBethe/KuhnSmallStep.lean | 377 +++ .../BeyondBethe/MachineArithmeticTests.lean | 291 ++ .../BeyondBethe/MachineBetheAffineEntry.lean | 526 ++++ .../MachineBetheAffineLineSum.lean | 1017 +++++++ .../MachineBetheEpigraphOracle.lean | 1018 +++++++ .../MachineBetheFeasibilityFit.lean | 142 + .../MachineBetheFeasibilityLoop.lean | 641 +++++ .../MachineBetheFeasibilitySemantics.lean | 528 ++++ .../MachineBetheFloorCutEntry.lean | 387 +++ .../MachineBetheFloorCutVector.lean | 329 +++ .../BeyondBethe/MachineBetheFloorScan.lean | 1485 ++++++++++ .../BeyondBethe/MachineBetheFloorTest.lean | 133 + .../BeyondBethe/MachineBetheHeightCap.lean | 167 ++ .../BeyondBethe/MachineBetheHeightNormal.lean | 158 ++ .../BeyondBethe/MachineBinaryAdd.lean | 385 +++ .../MachineBinaryAddSemantics.lean | 210 ++ .../BeyondBethe/MachineBinaryCompare.lean | 106 + .../BeyondBethe/MachineBinaryDivision.lean | 675 +++++ .../BeyondBethe/MachineBinaryGCD.lean | 211 ++ .../BeyondBethe/MachineBinaryListInit.lean | 59 + .../BeyondBethe/MachineBinaryListSnoc.lean | 77 + .../BeyondBethe/MachineBinaryMul.lean | 321 +++ .../BeyondBethe/MachineBinarySub.lean | 510 ++++ .../BeyondBethe/MachineBitAssembly.lean | 318 +++ .../BeyondBethe/BeyondBethe/MachineBool.lean | 120 + .../BeyondBethe/MachineBooleanInit.lean | 399 +++ .../BeyondBethe/MachineBooleanMemory.lean | 244 ++ .../BeyondBethe/MachineBoundedUnary.lean | 267 ++ .../MachineCertificateAssembly.lean | 327 +++ .../MachineCertificateExpGuard.lean | 298 ++ .../MachineCertificatePotentials.lean | 137 + .../BeyondBethe/MachineCertificateScales.lean | 234 ++ .../MachineCertifiedPairEligibility.lean | 977 +++++++ .../MachineCompletedAlgorithm.lean | 455 +++ .../MachineDirectedAffineGradientEntry.lean | 359 +++ .../MachineDirectedAffineGradientVector.lean | 374 +++ .../MachineDirectedEpigraphNormal.lean | 81 + .../BeyondBethe/MachineDirectedLog.lean | 1011 +++++++ ...ineDirectedNegativeGradientCoordinate.lean | 219 ++ .../MachineDirectedNegativeGradientEntry.lean | 164 ++ ...neDirectedNegativeObjectiveCoordinate.lean | 497 ++++ .../MachineDirectedNegativeObjectiveSum.lean | 2472 +++++++++++++++++ .../MachineDirectedTransferCost.lean | 308 ++ .../BeyondBethe/MachineDyadicFloor.lean | 397 +++ .../BeyondBethe/MachineDyadicFloorMatrix.lean | 564 ++++ .../BeyondBethe/MachineDyadicFloorVector.lean | 535 ++++ .../BeyondBethe/MachineEncoding.lean | 125 + .../MachineExecutableCertificate.lean | 115 + .../MachineExecutablePositiveAlgorithm.lean | 160 ++ ...chineExecutableScannedOptimizerOutput.lean | 1267 +++++++++ .../MachineExplicitCertificate.lean | 39 + .../BeyondBethe/MachineFPBasics.lean | 134 + .../BeyondBethe/MachineFactorial.lean | 307 ++ .../BeyondBethe/MachineFinalScalars.lean | 43 + .../BeyondBethe/MachineFourCoreCost.lean | 269 ++ .../BeyondBethe/MachineGreedyRowMatching.lean | 1841 ++++++++++++ .../BeyondBethe/MachineIntegerArithmetic.lean | 414 +++ .../BeyondBethe/MachineIntegerCompare.lean | 107 + .../MachineIntegerSignedMagnitude.lean | 129 + .../BeyondBethe/MachineKuhnEncoding.lean | 636 +++++ .../BeyondBethe/MachineKuhnInvariant.lean | 589 ++++ .../BeyondBethe/MachineKuhnRunner.lean | 445 +++ .../BeyondBethe/MachineKuhnSemantics.lean | 431 +++ .../BeyondBethe/MachineKuhnStep.lean | 560 ++++ .../BeyondBethe/MachineLengthBits.lean | 70 + .../BeyondBethe/MachineListIndex.lean | 172 ++ .../BeyondBethe/MachineListReverse.lean | 314 +++ .../BeyondBethe/MachineListUpdate.lean | 1004 +++++++ .../BeyondBethe/MachineMatchingGain.lean | 428 +++ .../BeyondBethe/MachineMateAllSome.lean | 297 ++ .../BeyondBethe/MachineMateMemory.lean | 108 + .../BeyondBethe/MachineMatrixAddDelta.lean | 800 ++++++ .../BeyondBethe/MachineMatrixDimension.lean | 73 + .../BeyondBethe/MachineMatrixNonnegative.lean | 476 ++++ .../MachineMatrixNormalization.lean | 67 + .../MachineMatrixNormalizeEntries.lean | 761 +++++ .../BeyondBethe/MachineMatrixSum.lean | 747 +++++ .../MachineMatrixSupportProduct.lean | 585 ++++ .../MachineNaturalCombinators.lean | 63 + .../BeyondBethe/MachineNearbyCoordinate.lean | 252 ++ .../BeyondBethe/MachineNearbyMatrixSum.lean | 989 +++++++ .../MachineNestedMatrixMemory.lean | 118 + .../MachineOptimizerBisectionLoop.lean | 583 ++++ .../MachineOptimizerBisectionSchedule.lean | 338 +++ .../MachineOptimizerBisectionSemantics.lean | 475 ++++ .../MachineOptimizerCertificateBoundary.lean | 154 + .../MachineOptimizerDerivedScales.lean | 512 ++++ .../MachineOptimizerEntryLength.lean | 400 +++ .../MachineOptimizerFeasibilityCall.lean | 285 ++ .../MachineOptimizerFeasibilitySchedule.lean | 864 ++++++ .../MachineOptimizerInteriorScale.lean | 639 +++++ .../MachineOptimizerMatrixBitBound.lean | 573 ++++ .../MachineOptimizerRoundingSchedule.lean | 573 ++++ .../MachineOptimizerStateBound.lean | 490 ++++ .../BeyondBethe/MachineOptimizerTests.lean | 109 + .../BeyondBethe/MachineOutputEncoding.lean | 208 ++ .../BeyondBethe/MachinePerfectMatching.lean | 181 ++ .../BeyondBethe/MachinePositiveAlgorithm.lean | 305 ++ .../BeyondBethe/MachineRAMBridge.lean | 176 ++ .../BeyondBethe/MachineRAMSmoke.lean | 57 + .../MachineRationalArithmetic.lean | 254 ++ .../BeyondBethe/MachineRationalBallInit.lean | 679 +++++ .../BeyondBethe/MachineRationalCompare.lean | 77 + .../MachineRationalDirectionUpdateMatrix.lean | 811 ++++++ .../MachineRationalDirectionUpdateRow.lean | 414 +++ .../MachineRationalEllipsoidCenterUpdate.lean | 298 ++ .../MachineRationalEllipsoidEncoding.lean | 238 ++ .../MachineRationalEllipsoidScalars.lean | 341 +++ .../MachineRationalEllipsoidUpdate.lean | 127 + .../BeyondBethe/MachineRationalExp.lean | 426 +++ .../BeyondBethe/MachineRationalFloor.lean | 100 + .../BeyondBethe/MachineRationalLogSeries.lean | 734 +++++ .../MachineRationalMatrixColumn.lean | 620 +++++ .../BeyondBethe/MachineRationalMatrixMul.lean | 676 +++++ .../MachineRationalMatrixMulVector.lean | 547 ++++ .../MachineRationalMatrixUpdate.lean | 220 ++ .../BeyondBethe/MachineRationalMin.lean | 60 + .../MachineRationalNormalization.lean | 173 ++ .../MachineRationalNormalizedDirection.lean | 68 + .../BeyondBethe/MachineRationalPower.lean | 350 +++ .../BeyondBethe/MachineRationalRowAdd.lean | 639 +++++ .../BeyondBethe/MachineRationalRowDivide.lean | 639 +++++ .../MachineRationalTransposeMulVector.lean | 672 +++++ .../BeyondBethe/MachineRationalUnary.lean | 178 ++ .../BeyondBethe/MachineRationalVectorDot.lean | 679 +++++ .../BeyondBethe/MachineRationalVectorL1.lean | 553 ++++ .../MachineRationalVectorScale.lean | 80 + .../BeyondBethe/MachineRationalVectorSub.lean | 550 ++++ .../BeyondBethe/MachineRationalVectorSum.lean | 113 + .../BeyondBethe/MachineRepeatPair.lean | 344 +++ .../MachineRowComplementUpperSum.lean | 729 +++++ .../BeyondBethe/MachineRowPairDisjoint.lean | 493 ++++ .../BeyondBethe/MachineScheduledLog.lean | 267 ++ .../BeyondBethe/MachineScheduledLogWidth.lean | 472 ++++ .../MachineScheduledRoundedEllipsoid.lean | 459 +++ .../MachineScheduledStateEncodingBound.lean | 174 ++ .../BeyondBethe/MachineSmallDimension.lean | 144 + .../BeyondBethe/MachineSmoothedMatrix.lean | 119 + .../BeyondBethe/MachineSmoothingDelta.lean | 329 +++ .../BeyondBethe/MachineTrimHighZeros.lean | 257 ++ .../MachineUnaryGridGenerator.lean | 1277 +++++++++ .../MachineUnaryMatrixGenerator.lean | 1269 +++++++++ .../BeyondBethe/MachineUnaryRange.lean | 331 +++ LeanPool/BeyondBethe/BeyondBethe/Main.lean | 255 ++ .../BeyondBethe/MatchingAlgorithm.lean | 37 + .../BeyondBethe/MatrixPerturbation.lean | 205 ++ .../BeyondBethe/BeyondBethe/NearCase.lean | 1627 +++++++++++ .../BeyondBethe/NumericalAffine.lean | 384 +++ .../BeyondBethe/NumericalCapacity.lean | 118 + .../BeyondBethe/NumericalInterior.lean | 321 +++ .../BeyondBethe/NumericalNearby.lean | 301 ++ .../BeyondBethe/NumericalPotentials.lean | 113 + .../BeyondBethe/NumericalScales.lean | 456 +++ .../BeyondBethe/NumericalTransfer.lean | 152 + .../BeyondBethe/NumericalWitness.lean | 507 ++++ .../BeyondBethe/BeyondBethe/Optimizer.lean | 768 +++++ .../BeyondBethe/OptimizerOutputEncoding.lean | 39 + .../BeyondBethe/PairFactorization.lean | 223 ++ .../BeyondBethe/PairStability.lean | 290 ++ .../BeyondBethe/PairedCertificate.lean | 483 ++++ .../BeyondBethe/PalomarComplexity.lean | 149 + .../BeyondBethe/BeyondBethe/Permanent.lean | 116 + .../BeyondBethe/RationalEllipsoid.lean | 1358 +++++++++ .../BeyondBethe/RationalEncodingBounds.lean | 427 +++ .../BeyondBethe/RationalEpigraphOracle.lean | 182 ++ .../BeyondBethe/RationalFeasibility.lean | 548 ++++ .../BeyondBethe/RationalLinearOracle.lean | 198 ++ .../BeyondBethe/BeyondBethe/RawRational.lean | 160 ++ .../BeyondBethe/RawRationalBitBounds.lean | 452 +++ .../BeyondBethe/BeyondBethe/RobustCycle.lean | 785 ++++++ .../BeyondBethe/RoundedEllipsoid.lean | 370 +++ .../RoundedEllipsoidBitBounds.lean | 539 ++++ .../RoundedEllipsoidIterationBounds.lean | 435 +++ .../BeyondBethe/RoundedEllipsoidScales.lean | 323 +++ .../BeyondBethe/RoundedFeasibility.lean | 286 ++ .../RoundedFeasibilityBitBounds.lean | 217 ++ .../BeyondBethe/BeyondBethe/RowStability.lean | 1846 ++++++++++++ .../BeyondBethe/ScannedBetheBisection.lean | 366 +++ .../ScannedBetheThresholdFeasibility.lean | 169 ++ .../BeyondBethe/ScheduledFeasibility.lean | 380 +++ .../ScheduledRoundedEllipsoid.lean | 709 +++++ .../ScheduledRoundedEllipsoidIteration.lean | 183 ++ .../BeyondBethe/BeyondBethe/Sequential.lean | 366 +++ .../BeyondBethe/SequentialNormalization.lean | 118 + LeanPool/BeyondBethe/BeyondBethe/Slack.lean | 164 ++ .../BeyondBethe/BeyondBethe/Smoothing.lean | 238 ++ .../BeyondBethe/SourceAnariRezaei.lean | 831 ++++++ .../BeyondBethe/SourceAnariRezaeiList.lean | 389 +++ .../BeyondBethe/SourceAnariRezaeiMerge.lean | 480 ++++ .../BeyondBethe/SourceBetheLower.lean | 123 + .../BeyondBethe/SourceBetheUpper.lean | 84 + .../BeyondBethe/SourceStableBivariate.lean | 379 +++ .../BeyondBethe/SourceStableClosure.lean | 722 +++++ .../BeyondBethe/SourceStableEncoding.lean | 665 +++++ .../BeyondBethe/SourceStableInduction.lean | 227 ++ .../BeyondBethe/SourceStableReindex.lean | 192 ++ .../BeyondBethe/SourceStableSlice.lean | 246 ++ .../SourceStableSpecialization.lean | 235 ++ .../BeyondBethe/SourceStableTable.lean | 277 ++ .../BeyondBethe/SourceVontobel.lean | 506 ++++ LeanPool/BeyondBethe/BeyondBethe/Stable.lean | 120 + .../BeyondBethe/StrongEntropy.lean | 156 ++ .../BeyondBethe/BeyondBethe/Transfer.lean | 340 +++ .../BeyondBethe/TransferIdentity.lean | 293 ++ .../BeyondBethe/WeakSeparation.lean | 269 ++ LeanPool/BeyondBethe/Complexitylib.lean | 16 + .../Complexitylib/Asymptotics.lean | 448 +++ .../Complexitylib/Asymptotics/PolyBound.lean | 88 + .../Asymptotics/PolynomialComposition.lean | 46 + .../BeyondBethe/Complexitylib/Circuits.lean | 11 + .../Complexitylib/Circuits/AndOrNot.lean | 9 + .../Complexitylib/Circuits/AndOrNot/Defs.lean | 95 + .../Complexitylib/Circuits/Basic.lean | 366 +++ .../Complexitylib/Circuits/Encoding.lean | 10 + .../Complexitylib/Circuits/Encoding/Defs.lean | 251 ++ .../Circuits/Encoding/Internal.lean | 9 + .../Circuits/Encoding/Internal/Codec.lean | 552 ++++ .../BeyondBethe/Complexitylib/Classes.lean | 18 + .../Complexitylib/Classes/Containments.lean | 312 +++ .../Complexitylib/Classes/Exponential.lean | 32 + .../Complexitylib/Classes/FNP.lean | 9 + .../Complexitylib/Classes/FNP/Defs.lean | 43 + .../BeyondBethe/Complexitylib/Classes/L.lean | 70 + .../BeyondBethe/Complexitylib/Classes/NP.lean | 37 + .../Complexitylib/Classes/NP/Witness.lean | 157 ++ .../BeyondBethe/Complexitylib/Classes/P.lean | 70 + .../Complexitylib/Classes/P/Cobham.lean | 95 + .../Complexitylib/Classes/P/Cobham/Defs.lean | 131 + .../Classes/P/Cobham/Internal.lean | 1142 ++++++++ .../Classes/P/Cobham/Internal/Algebra.lean | 543 ++++ .../Classes/P/Cobham/Internal/BlockScan.lean | 77 + .../Classes/P/Cobham/Internal/Blocks.lean | 303 ++ .../Classes/P/Cobham/Internal/Cat.lean | 413 +++ .../Classes/P/Cobham/Internal/ConsBit.lean | 226 ++ .../Classes/P/Cobham/Internal/Encoding.lean | 971 +++++++ .../Classes/P/Cobham/Internal/Extract.lean | 251 ++ .../Classes/P/Cobham/Internal/FstBlock.lean | 357 +++ .../Classes/P/Cobham/Internal/HeadFlag.lean | 170 ++ .../Classes/P/Cobham/Internal/Iterate.lean | 966 +++++++ .../P/Cobham/Internal/IterateLayout.lean | 574 ++++ .../Classes/P/Cobham/Internal/MulLen.lean | 718 +++++ .../Classes/P/Cobham/Internal/Reorder.lean | 709 +++++ .../Classes/P/Cobham/Internal/Reverse.lean | 313 +++ .../Classes/P/Cobham/Internal/Simulate.lean | 536 ++++ .../Classes/P/Cobham/Internal/SndBlock.lean | 452 +++ .../P/Cobham/Internal/StepAlgebra.lean | 756 +++++ .../Classes/P/Cobham/Internal/TakeLen.lean | 616 ++++ .../Classes/P/Cobham/Internal/Vec.lean | 50 + .../Complexitylib/Classes/P/Cobham/Vec.lean | 120 + .../Complexitylib/Classes/P/Composition.lean | 28 + .../Complexitylib/Classes/P/Defs.lean | 41 + .../Complexitylib/Classes/P/FinsetDomain.lean | 41 + .../Classes/P/FinsetDomain/Internal.lean | 484 ++++ .../Complexitylib/Classes/P/Internal.lean | 121 + .../Classes/P/Internal/Composition.lean | 40 + .../Classes/P/Internal/NormalForm.lean | 54 + .../Classes/P/Internal/Preimage.lean | 39 + .../Complexitylib/Classes/P/NormalForm.lean | 43 + .../Classes/P/PairWithInput.lean | 29 + .../Classes/P/PairWithInput/Internal.lean | 32 + .../Complexitylib/Classes/P/Preimage.lean | 29 + .../Complexitylib/Classes/P/UnaryLength.lean | 29 + .../Classes/P/UnaryLength/Internal.lean | 29 + .../Complexitylib/Classes/Pairing.lean | 47 + .../Complexitylib/Classes/Randomized.lean | 111 + .../Complexitylib/Classes/Space.lean | 42 + .../Complexitylib/Classes/Time.lean | 55 + .../BeyondBethe/Complexitylib/Encoding.lean | 12 + .../Complexitylib/Encoding/Data.lean | 229 ++ .../Complexitylib/Encoding/DataEncode.lean | 122 + .../Complexitylib/Encoding/Delimit.lean | 209 ++ .../Complexitylib/Encoding/Pairing.lean | 263 ++ .../BeyondBethe/Complexitylib/Languages.lean | 9 + .../Complexitylib/Languages/LastBit.lean | 127 + .../BeyondBethe/Complexitylib/Mathlib.lean | 10 + .../Complexitylib/Mathlib/FinsetPrefixes.lean | 71 + .../Complexitylib/Mathlib/NatBits.lean | 216 ++ .../BeyondBethe/Complexitylib/Models.lean | 10 + .../Models/RandomAccessMachine.lean | 365 +++ .../Models/RandomAccessMachine/Classes.lean | 42 + .../RandomAccessMachine/Classes/Defs.lean | 43 + .../Models/RandomAccessMachine/Defs.lean | 264 ++ .../Models/RandomAccessMachine/Internal.lean | 282 ++ .../RandomAccessMachine/Simulation.lean | 10 + .../Simulation/RegisterStore.lean | 313 +++ .../Simulation/RegisterStore/Containment.lean | 85 + .../RegisterStore/Containment/Defs.lean | 80 + .../RegisterStore/Containment/Internal.lean | 224 ++ .../Simulation/RegisterStore/Defs.lean | 311 +++ .../RegisterStore/DenseOverlay.lean | 235 ++ .../RegisterStore/DenseOverlay/Defs.lean | 152 + .../RegisterStore/DenseOverlay/Internal.lean | 509 ++++ .../Simulation/RegisterStore/Internal.lean | 1146 ++++++++ .../Simulation/RegisterStore/Machine.lean | 27 + .../RegisterStore/Machine/AddressEq.lean | 98 + .../RegisterStore/Machine/AddressEq/Defs.lean | 47 + .../Machine/AddressEq/Internal.lean | 156 ++ .../Machine/DenseInputLookup.lean | 164 ++ .../Machine/DenseInputLookup/Defs.lean | 179 ++ .../Machine/DenseInputLookup/Internal.lean | 1103 ++++++++ .../RegisterStore/Machine/EntryAppend.lean | 73 + .../Machine/EntryAppend/Defs.lean | 67 + .../Machine/EntryAppend/Internal.lean | 264 ++ .../RegisterStore/Machine/EntryCleanup.lean | 73 + .../Machine/EntryCleanup/Defs.lean | 140 + .../Machine/EntryCleanup/Internal.lean | 352 +++ .../RegisterStore/Machine/EntryDecode.lean | 177 ++ .../Machine/EntryDecode/Defs.lean | 116 + .../Machine/EntryDecode/Internal.lean | 186 ++ .../Machine/EntryDecode/LinearInternal.lean | 183 ++ .../RegisterStore/Machine/EntryEncode.lean | 208 ++ .../Machine/EntryEncode/Defs.lean | 73 + .../Machine/EntryEncode/Internal.lean | 492 ++++ .../RegisterStore/Machine/EntryLookup.lean | 124 + .../Machine/EntryLookup/Defs.lean | 62 + .../Machine/EntryLookup/Internal.lean | 119 + .../Machine/EntryLookupRestore.lean | 165 ++ .../RegisterStore/Machine/EntryMatch.lean | 207 ++ .../Machine/EntryMatch/Defs.lean | 166 ++ .../Machine/EntryMatch/Internal.lean | 556 ++++ .../RegisterStore/Machine/EntryMissCopy.lean | 75 + .../Machine/EntryMissCopy/Defs.lean | 82 + .../Machine/EntryMissCopy/Internal.lean | 269 ++ .../RegisterStore/Machine/EntryReplace.lean | 81 + .../Machine/EntryReplace/Defs.lean | 88 + .../Machine/EntryReplace/Internal.lean | 359 +++ .../RegisterStore/Machine/EntryScan.lean | 112 + .../RegisterStore/Machine/EntryScan/Defs.lean | 194 ++ .../Machine/EntryScan/Internal.lean | 12 + .../Machine/EntryScan/Internal/Bounds.lean | 161 ++ .../Machine/EntryScan/Internal/Ctrl.lean | 219 ++ .../Machine/EntryScan/Internal/Inv.lean | 236 ++ .../Machine/EntryScan/Internal/Sem.lean | 225 ++ .../RegisterStore/Machine/EntryScanStep.lean | 80 + .../Machine/EntryScanStep/Defs.lean | 81 + .../Machine/EntryScanStep/Internal.lean | 184 ++ .../RegisterStore/Machine/EntryUpdate.lean | 185 ++ .../Machine/EntryUpdate/BoundsInternal.lean | 237 ++ .../Machine/EntryUpdate/Defs.lean | 391 +++ .../Machine/EntryUpdate/Internal.lean | 18 + .../Machine/EntryUpdate/Internal/Ctrl.lean | 666 +++++ .../Machine/EntryUpdate/Internal/End.lean | 253 ++ .../Machine/EntryUpdate/Internal/Hit.lean | 598 ++++ .../Machine/EntryUpdate/Internal/Inv.lean | 414 +++ .../Machine/EntryUpdate/Internal/Loop.lean | 127 + .../Machine/EntryUpdate/Internal/Miss.lean | 241 ++ .../Machine/EntryUpdate/Internal/Out.lean | 107 + .../Machine/EntryUpdate/Internal/Sem.lean | 138 + .../Machine/EntryUpdate/Internal/Step.lean | 110 + .../Machine/EntryUpdate/Internal/Time.lean | 330 +++ .../Machine/EntryUpdate/Progress.lean | 195 ++ .../Machine/EntryUpdate/Source.lean | 521 ++++ .../Machine/EntryUpdate/Tagged.lean | 55 + .../Machine/EntryUpdate/TaggedDefs.lean | 52 + .../Machine/EntryUpdate/TaggedProof.lean | 199 ++ .../RegisterStore/Machine/Instruction.lean | 557 ++++ .../Machine/Instruction/Control.lean | 633 +++++ .../Machine/Instruction/Defs.lean | 732 +++++ .../Machine/Instruction/Dense.lean | 20 + .../Machine/Instruction/DenseControl.lean | 377 +++ .../Machine/Instruction/DenseCtrlSim.lean | 171 ++ .../Machine/Instruction/DenseDefs.lean | 246 ++ .../Machine/Instruction/DenseDirect.lean | 547 ++++ .../Machine/Instruction/DenseDispatch.lean | 523 ++++ .../Machine/Instruction/DenseImm.lean | 173 ++ .../Machine/Instruction/DenseLoad.lean | 365 +++ .../Machine/Instruction/DenseSim.lean | 76 + .../Machine/Instruction/DenseSimData.lean | 991 +++++++ .../Machine/Instruction/DenseSimDefs.lean | 249 ++ .../Machine/Instruction/DenseStore.lean | 483 ++++ .../Machine/Instruction/Direct.lean | 513 ++++ .../Machine/Instruction/Dispatch.lean | 347 +++ .../Machine/Instruction/Immediate.lean | 366 +++ .../Machine/Instruction/Internal.lean | 366 +++ .../Machine/Instruction/Load.lean | 419 +++ .../Machine/Instruction/Sim.lean | 12 + .../Machine/Instruction/Sim/Control.lean | 565 ++++ .../Machine/Instruction/Sim/Data.lean | 1423 ++++++++++ .../Machine/Instruction/Sim/Defs.lean | 616 ++++ .../Machine/Instruction/Sim/Internal.lean | 1203 ++++++++ .../Machine/Instruction/Store.lean | 552 ++++ .../RegisterStore/Machine/Lookup.lean | 11 + .../RegisterStore/Machine/Lookup/Defs.lean | 779 ++++++ .../Machine/Lookup/DenseInternal.lean | 586 ++++ .../Machine/Lookup/Internal.lean | 16 + .../Machine/Lookup/Internal/Assemble.lean | 272 ++ .../Machine/Lookup/Internal/Bounds.lean | 106 + .../Machine/Lookup/Internal/Prepare.lean | 191 ++ .../Machine/Lookup/Internal/Reset.lean | 327 +++ .../Machine/Lookup/Internal/Restore.lean | 709 +++++ .../Machine/Lookup/Internal/Scan.lean | 148 + .../Machine/Lookup/Internal/Static.lean | 383 +++ .../Machine/Lookup/Internal/Value.lean | 440 +++ .../RegisterStore/Machine/Program.lean | 168 ++ .../RegisterStore/Machine/Program/Bounds.lean | 79 + .../Machine/Program/Bounds/Defs.lean | 69 + .../Machine/Program/Bounds/Internal.lean | 2293 +++++++++++++++ .../Machine/Program/Decision.lean | 67 + .../Machine/Program/Decision/Defs.lean | 49 + .../Machine/Program/DecisionInternal.lean | 200 ++ .../RegisterStore/Machine/Program/Defs.lean | 206 ++ .../Machine/Program/DenseBounds.lean | 82 + .../Machine/Program/DenseBoundsDefs.lean | 80 + .../Machine/Program/DenseBoundsProof.lean | 2054 ++++++++++++++ .../Machine/Program/DenseDecision.lean | 64 + .../Machine/Program/DenseDecisionDefs.lean | 46 + .../Machine/Program/DenseDecisionProof.lean | 207 ++ .../Machine/Program/DenseDefs.lean | 69 + .../Machine/Program/DenseInit.lean | 48 + .../Machine/Program/DenseInitDefs.lean | 119 + .../Machine/Program/DenseInitProof.lean | 583 ++++ .../Machine/Program/DenseInternal.lean | 520 ++++ .../RegisterStore/Machine/Program/Init.lean | 10 + .../Machine/Program/Init/Defs.lean | 310 +++ .../Machine/Program/Init/Internal.lean | 2336 ++++++++++++++++ .../Machine/Program/Initialization.lean | 79 + .../Machine/Program/Internal.lean | 1402 ++++++++++ .../RegisterStore/Machine/WordDecode.lean | 397 +++ .../Machine/WordDecode/Defs.lean | 368 +++ .../Machine/WordDecode/Internal.lean | 1528 ++++++++++ .../Machine/WordDecode/LinearInternal.lean | 838 ++++++ .../RegisterStore/Machine/WordEncode.lean | 162 ++ .../Machine/WordEncode/Defs.lean | 139 + .../Machine/WordEncode/Internal.lean | 495 ++++ .../Simulation/TMConfig.lean | 111 + .../Simulation/TMConfig/Defs.lean | 162 ++ .../Simulation/TMConfig/Internal.lean | 153 + .../Simulation/TMConfig/Sparse.lean | 58 + .../Simulation/TMConfig/Sparse/ABI.lean | 108 + .../Simulation/TMConfig/Sparse/ABI/Defs.lean | 215 ++ .../TMConfig/Sparse/ABI/Internal.lean | 13 + .../TMConfig/Sparse/ABI/Internal/Capture.lean | 101 + .../Sparse/ABI/Internal/Decision.lean | 137 + .../TMConfig/Sparse/ABI/Internal/Loop.lean | 691 +++++ .../TMConfig/Sparse/ABI/Internal/Marshal.lean | 940 +++++++ .../Sparse/ABI/Internal/Resources.lean | 1230 ++++++++ .../TMConfig/Sparse/Containment.lean | 67 + .../TMConfig/Sparse/Containment/Internal.lean | 203 ++ .../Simulation/TMConfig/Sparse/Defs.lean | 133 + .../Simulation/TMConfig/Sparse/Internal.lean | 291 ++ .../Simulation/TMConfig/Sparse/Step.lean | 354 +++ .../Simulation/TMConfig/Sparse/Step/Defs.lean | 294 ++ .../TMConfig/Sparse/Step/Internal.lean | 25 + .../TMConfig/Sparse/Step/Internal/Action.lean | 1231 ++++++++ .../Sparse/Step/Internal/Dispatch.lean | 463 +++ .../Sparse/Step/Internal/Iteration.lean | 215 ++ .../TMConfig/Sparse/Step/Internal/Layout.lean | 130 + .../TMConfig/Sparse/Step/Internal/Load.lean | 193 ++ .../Sparse/Step/Internal/Resources.lean | 889 ++++++ .../Simulation/TMConfig/Step.lean | 240 ++ .../Simulation/TMConfig/Step/Defs.lean | 228 ++ .../Simulation/TMConfig/Step/Internal.lean | 20 + .../TMConfig/Step/Internal/Action.lean | 1181 ++++++++ .../TMConfig/Step/Internal/Dispatch.lean | 245 ++ .../TMConfig/Step/Internal/Layout.lean | 201 ++ .../TMConfig/Step/Internal/Load.lean | 362 +++ .../TMConfig/Step/Internal/Resources.lean | 261 ++ .../Models/RandomAccessMachine/Soundness.lean | 188 ++ .../RandomAccessMachine/Structured.lean | 72 + .../RandomAccessMachine/Structured/Defs.lean | 215 ++ .../Structured/GateEval.lean | 129 + .../Structured/GateEval/Defs.lean | 169 ++ .../Structured/GateEval/Internal.lean | 1694 +++++++++++ .../Structured/GateStep.lean | 120 + .../Structured/GateStep/Defs.lean | 119 + .../Structured/GateStep/Internal.lean | 1042 +++++++ .../Structured/GateStreamStep.lean | 101 + .../Structured/GateStreamStep/Defs.lean | 209 ++ .../Structured/GateStreamStep/Internal.lean | 1068 +++++++ .../Structured/Hamming.lean | 113 + .../Structured/Hamming/Defs.lean | 111 + .../Structured/Hamming/Internal.lean | 475 ++++ .../Structured/Internal.lean | 401 +++ .../Structured/Internal/Resources.lean | 581 ++++ .../Structured/LastBit.lean | 90 + .../Structured/LastBit/Defs.lean | 72 + .../Structured/PairValidate.lean | 111 + .../Structured/PairValidate/Defs.lean | 69 + .../Structured/PairValidate/Internal.lean | 43 + .../Structured/Scanner.lean | 182 ++ .../Structured/Scanner/Defs.lean | 250 ++ .../Structured/Scanner/Internal.lean | 857 ++++++ .../Structured/Switch.lean | 73 + .../Structured/Switch/Compiled.lean | 69 + .../Structured/Switch/Defs.lean | 61 + .../Structured/Switch/Internal.lean | 180 ++ .../Structured/ThreeSATSyntax.lean | 84 + .../Structured/ThreeSATSyntax/Defs.lean | 85 + .../Structured/UnaryDecode.lean | 144 + .../Structured/UnaryDecode/Defs.lean | 146 + .../Structured/UnaryDecode/Internal.lean | 761 +++++ .../Complexitylib/Models/TuringMachine.lean | 905 ++++++ .../Models/TuringMachine/Combinators.lean | 1034 +++++++ .../TuringMachine/Combinators/Apply.lean | 175 ++ .../Combinators/ForBinaryWork.lean | 73 + .../Combinators/ForBinaryWork/Defs.lean | 157 ++ .../Combinators/ForBinaryWork/Internal.lean | 311 +++ .../TuringMachine/Combinators/ForInput.lean | 10 + .../Combinators/ForInput/Defs.lean | 146 + .../Combinators/ForInput/Internal.lean | 261 ++ .../Combinators/ForWorkOnes.lean | 10 + .../Combinators/ForWorkOnes/Defs.lean | 139 + .../Combinators/ForWorkOnes/Internal.lean | 199 ++ .../TuringMachine/Combinators/Internal.lean | 25 + .../Combinators/Internal/Complement.lean | 229 ++ .../Combinators/Internal/Generic.lean | 366 +++ .../Combinators/Internal/If.lean | 361 +++ .../Combinators/Internal/Loop.lean | 354 +++ .../Combinators/Internal/Retarget.lean | 714 +++++ .../Combinators/Internal/Scanner.lean | 235 ++ .../Combinators/Internal/Seq.lean | 163 ++ .../Combinators/Internal/Union.lean | 1259 +++++++++ .../Combinators/RetargetCompute.lean | 166 ++ .../Combinators/RetargetCompute/Defs.lean | 91 + .../Combinators/RetargetCompute/Internal.lean | 286 ++ .../TuringMachine/Combinators/WorkBranch.lean | 206 ++ .../Combinators/WorkBranch/Defs.lean | 114 + .../Combinators/WorkBranch/Internal.lean | 469 ++++ .../Combinators/WorkSymbolBranch.lean | 98 + .../Combinators/WorkSymbolBranch/Defs.lean | 83 + .../WorkSymbolBranch/Internal.lean | 260 ++ .../Models/TuringMachine/Composition.lean | 63 + .../TuringMachine/Composition/Defs.lean | 127 + .../TuringMachine/Composition/Internal.lean | 130 + .../Composition/Internal/FirstPhase.lean | 187 ++ .../Composition/Internal/Tail.lean | 560 ++++ .../Composition/PairWithInput.lean | 43 + .../Composition/PairWithInput/Defs.lean | 59 + .../Composition/PairWithInput/Internal.lean | 292 ++ .../Models/TuringMachine/Frame.lean | 234 ++ .../Models/TuringMachine/Hoare.lean | 382 +++ .../Models/TuringMachine/Hoare/Defs.lean | 320 +++ .../TuringMachine/Hoare/RetargetOutput.lean | 77 + .../Models/TuringMachine/Hoare/Space.lean | 178 ++ .../TuringMachine/Hoare/Space/Defs.lean | 43 + .../TuringMachine/Hoare/Space/Internal.lean | 246 ++ .../Models/TuringMachine/Internal.lean | 693 +++++ .../TuringMachine/Internal/OutputBounds.lean | 102 + .../Models/TuringMachine/Lift.lean | 594 ++++ .../Models/TuringMachine/OutputBounds.lean | 58 + .../Models/TuringMachine/Placement.lean | 140 + .../Models/TuringMachine/Placement/Defs.lean | 184 ++ .../TuringMachine/Placement/Internal.lean | 211 ++ .../Models/TuringMachine/Registers.lean | 235 ++ .../Models/TuringMachine/Registers/Arith.lean | 290 ++ .../Models/TuringMachine/Registers/Emit.lean | 878 ++++++ .../TuringMachine/Registers/EmitSeq.lean | 70 + .../TuringMachine/Registers/ForReg.lean | 522 ++++ .../TuringMachine/Registers/Horner.lean | 610 ++++ .../TuringMachine/Registers/InputLen.lean | 486 ++++ .../TuringMachine/Registers/RegisterOps.lean | 961 +++++++ .../Models/TuringMachine/SpaceTime.lean | 9 + .../TuringMachine/SpaceTime/Internal.lean | 9 + .../SpaceTime/Internal/Reachability.lean | 52 + .../Models/TuringMachine/Subroutines.lean | 482 ++++ .../Subroutines/BinaryAddConst.lean | 110 + .../Subroutines/BinaryAddConst/Defs.lean | 47 + .../Subroutines/BinaryAddConst/Internal.lean | 402 +++ .../TuringMachine/Subroutines/BinaryCopy.lean | 109 + .../Subroutines/BinaryCopy/Defs.lean | 45 + .../Subroutines/BinaryCopy/Internal.lean | 314 +++ .../TuringMachine/Subroutines/BinaryEq.lean | 68 + .../Subroutines/BinaryEq/Defs.lean | 108 + .../Subroutines/BinaryEq/Internal.lean | 399 +++ .../TuringMachine/Subroutines/BinaryFor.lean | 10 + .../Subroutines/BinaryFor/Defs.lean | 285 ++ .../Subroutines/BinaryFor/Internal.lean | 11 + .../BinaryFor/Internal/Comparison.lean | 722 +++++ .../BinaryFor/Internal/Control.lean | 307 ++ .../Subroutines/BinaryFor/Internal/Loop.lean | 193 ++ .../TuringMachine/Subroutines/BinaryPred.lean | 142 + .../Subroutines/BinaryPred/Defs.lean | 233 ++ .../Subroutines/BinaryPred/Internal.lean | 891 ++++++ .../Subroutines/BinaryRippleAdd.lean | 164 ++ .../Subroutines/BinaryRippleAdd/Defs.lean | 164 ++ .../Subroutines/BinaryRippleAdd/Internal.lean | 20 + .../BinaryRippleAdd/Internal/Bounds.lean | 49 + .../BinaryRippleAdd/Internal/Out.lean | 59 + .../BinaryRippleAdd/Internal/Pure.lean | 184 ++ .../BinaryRippleAdd/Internal/Rewind.lean | 219 ++ .../BinaryRippleAdd/Internal/Scan.lean | 578 ++++ .../BinaryRippleAdd/Internal/Sem.lean | 251 ++ .../Subroutines/BinaryRippleSub.lean | 150 + .../Subroutines/BinaryRippleSub/Defs.lean | 274 ++ .../Subroutines/BinaryRippleSub/Internal.lean | 14 + .../BinaryRippleSub/Internal/Backward.lean | 623 +++++ .../BinaryRippleSub/Internal/Out.lean | 63 + .../BinaryRippleSub/Internal/Pure.lean | 229 ++ .../BinaryRippleSub/Internal/Rewind.lean | 181 ++ .../BinaryRippleSub/Internal/Scan.lean | 577 ++++ .../BinaryRippleSub/Internal/Sem.lean | 334 +++ .../Subroutines/BinaryShiftMul.lean | 173 ++ .../Subroutines/BinaryShiftMul/Defs.lean | 210 ++ .../Subroutines/BinaryShiftMul/Internal.lean | 11 + .../BinaryShiftMul/Internal/Out.lean | 66 + .../BinaryShiftMul/Internal/Pure.lean | 154 + .../BinaryShiftMul/Internal/Sem.lean | 1781 ++++++++++++ .../TuringMachine/Subroutines/BinarySucc.lean | 157 ++ .../Subroutines/BinarySucc/Defs.lean | 162 ++ .../Subroutines/BinarySucc/Internal.lean | 605 ++++ .../TuringMachine/Subroutines/ClearWork.lean | 102 + .../Subroutines/ClearWork/Defs.lean | 35 + .../Subroutines/ClearWork/Internal.lean | 131 + .../TuringMachine/Subroutines/CopyOutput.lean | 39 + .../Subroutines/CopyToVirtualInput.lean | 195 ++ .../Subroutines/CopyWorkOutput.lean | 105 + .../TuringMachine/Subroutines/Counter.lean | 1294 +++++++++ .../TuringMachine/Subroutines/Internal.lean | 1969 +++++++++++++ .../Subroutines/Internal/CopyOutput.lean | 169 ++ .../Subroutines/Internal/CopyWorkOutput.lean | 351 +++ .../Subroutines/MoveLeftStep.lean | 110 + .../TuringMachine/Subroutines/PairEmit.lean | 74 + .../Subroutines/PairEmit/Defs.lean | 135 + .../Subroutines/PairEmit/Internal.lean | 348 +++ .../Subroutines/PairValidate.lean | 104 + .../Subroutines/PairValidate/Defs.lean | 79 + .../Subroutines/PairValidate/Internal.lean | 152 + .../TuringMachine/Subroutines/ParkAll.lean | 88 + .../Subroutines/ResetBinary.lean | 88 + .../Subroutines/ResetBinary/Defs.lean | 36 + .../Subroutines/ResetBinary/Internal.lean | 159 ++ .../Subroutines/ResetBinaryMany.lean | 112 + .../Subroutines/ResetBinaryMany/Defs.lean | 54 + .../Subroutines/ResetBinaryMany/Internal.lean | 215 ++ .../TuringMachine/Subroutines/ResetTapes.lean | 309 +++ .../TuringMachine/Subroutines/RewindList.lean | 141 + .../Subroutines/UnaryLength.lean | 39 + .../Subroutines/UnaryLength/Defs.lean | 65 + .../Subroutines/UnaryLength/Internal.lean | 138 + .../TuringMachine/Subroutines/WipeLoop.lean | 250 ++ .../TuringMachine/Subroutines/WipeStep.lean | 110 + .../Models/TuringMachine/Tape.lean | 9 + .../Models/TuringMachine/Tape/Encoding.lean | 402 +++ .../Models/TuringMachine/WorkReadOnly.lean | 95 + LeanPool/BeyondBethe/Complexitylib/SAT.lean | 15 + .../Complexitylib/SAT/Encoding.lean | 299 ++ .../Complexitylib/SAT/Language.lean | 154 + .../BeyondBethe/Complexitylib/SAT/Rename.lean | 190 ++ .../Complexitylib/SAT/Semantics.lean | 381 +++ .../Complexitylib/SAT/ThreeCNF.lean | 129 + .../Complexitylib/SAT/ThreeSAT.lean | 187 ++ .../Complexitylib/SAT/ThreeSAT/Syntax.lean | 214 ++ .../Complexitylib/SAT/Verifier.lean | 456 +++ LeanPool/BeyondBethe/Solution.lean | 37 + LeanPool/projects.yml | 32 + 708 files changed, 232678 insertions(+) create mode 100644 LeanPool/BeyondBethe.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/AdaptiveRoundedEllipsoid.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/AlgorithmicSpec.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/ApproximateKKT.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/AxiomAudit.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/Bethe.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/BetheBisection.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/BetheEpigraph.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/BetheEpigraphFeasibility.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/BetheEpigraphGeometry.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/BetheFloorCutFormula.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/BetheThresholdFeasibility.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/BinaryDirectedElementary.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/BinaryLongDivision.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/BinaryRationalComparison.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/BinaryRationalFloor.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/Birkhoff.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/Capacity.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/CapacityOrder.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/CapacityScaling.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/CertificateCapacity.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/CertificateMagnitude.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/CertifiedPairWeights.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/CleanConstants.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/CleanGain.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/CleanWitness.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/ClusterAlpha.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/ClusterCertificate.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/ClusterFactors.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/ClusterProduct.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/Completion.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/CoreEncoding.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/CycleTransfer.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/Cycles.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/DirectedCertificateValue.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/DirectedElementary.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/DirectedOptimizerOracle.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/DirectedPairCost.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/DyadicMagnitudePrecision.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/DyadicRounding.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/Entropy.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/ExcursionTransfer.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/ExecutableCertificate.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/ExecutableCertificateMagnitude.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/ExecutableInterior.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/ExecutablePositiveRoutine.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/ExecutableScannedBetheOptimizer.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/ExecutableTransfer.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/ExplicitBetheOptimizer.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/ExplicitBetheThresholdFeasibility.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/ExplicitBounds.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/ExplicitOptimizerScales.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/ExplicitPositiveRoutine.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/ExplicitScales.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/ExplicitScheduledFeasibility.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/FinalAssembly.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/Gain.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/Gibbs.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/GoodRowScore.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/GreedyRowMatching.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/KuhnMatching.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/KuhnSmallStep.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineArithmeticTests.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineBetheAffineEntry.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineBetheAffineLineSum.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineBetheEpigraphOracle.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineBetheFeasibilityFit.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineBetheFeasibilityLoop.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineBetheFeasibilitySemantics.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineBetheFloorCutEntry.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineBetheFloorCutVector.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineBetheFloorScan.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineBetheFloorTest.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineBetheHeightCap.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineBetheHeightNormal.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineBinaryAdd.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineBinaryAddSemantics.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineBinaryCompare.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineBinaryDivision.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineBinaryGCD.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineBinaryListInit.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineBinaryListSnoc.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineBinaryMul.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineBinarySub.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineBitAssembly.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineBool.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineBooleanInit.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineBooleanMemory.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineBoundedUnary.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineCertificateAssembly.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineCertificateExpGuard.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineCertificatePotentials.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineCertificateScales.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineCertifiedPairEligibility.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineCompletedAlgorithm.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineDirectedAffineGradientEntry.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineDirectedAffineGradientVector.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineDirectedEpigraphNormal.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineDirectedLog.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineDirectedNegativeGradientCoordinate.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineDirectedNegativeGradientEntry.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineDirectedNegativeObjectiveCoordinate.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineDirectedNegativeObjectiveSum.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineDirectedTransferCost.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineDyadicFloor.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineDyadicFloorMatrix.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineDyadicFloorVector.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineEncoding.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineExecutableCertificate.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineExecutablePositiveAlgorithm.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineExecutableScannedOptimizerOutput.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineExplicitCertificate.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineFPBasics.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineFactorial.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineFinalScalars.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineFourCoreCost.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineGreedyRowMatching.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineIntegerArithmetic.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineIntegerCompare.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineIntegerSignedMagnitude.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineKuhnEncoding.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineKuhnInvariant.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineKuhnRunner.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineKuhnSemantics.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineKuhnStep.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineLengthBits.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineListIndex.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineListReverse.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineListUpdate.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineMatchingGain.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineMateAllSome.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineMateMemory.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineMatrixAddDelta.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineMatrixDimension.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineMatrixNonnegative.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineMatrixNormalization.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineMatrixNormalizeEntries.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineMatrixSum.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineMatrixSupportProduct.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineNaturalCombinators.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineNearbyCoordinate.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineNearbyMatrixSum.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineNestedMatrixMemory.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerBisectionLoop.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerBisectionSchedule.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerBisectionSemantics.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerCertificateBoundary.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerDerivedScales.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerEntryLength.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerFeasibilityCall.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerFeasibilitySchedule.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerInteriorScale.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerMatrixBitBound.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerRoundingSchedule.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerStateBound.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerTests.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineOutputEncoding.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachinePerfectMatching.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachinePositiveAlgorithm.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineRAMBridge.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineRAMSmoke.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineRationalArithmetic.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineRationalBallInit.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineRationalCompare.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineRationalDirectionUpdateMatrix.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineRationalDirectionUpdateRow.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineRationalEllipsoidCenterUpdate.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineRationalEllipsoidEncoding.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineRationalEllipsoidScalars.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineRationalEllipsoidUpdate.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineRationalExp.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineRationalFloor.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineRationalLogSeries.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineRationalMatrixColumn.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineRationalMatrixMul.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineRationalMatrixMulVector.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineRationalMatrixUpdate.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineRationalMin.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineRationalNormalization.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineRationalNormalizedDirection.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineRationalPower.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineRationalRowAdd.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineRationalRowDivide.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineRationalTransposeMulVector.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineRationalUnary.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineRationalVectorDot.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineRationalVectorL1.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineRationalVectorScale.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineRationalVectorSub.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineRationalVectorSum.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineRepeatPair.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineRowComplementUpperSum.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineRowPairDisjoint.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineScheduledLog.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineScheduledLogWidth.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineScheduledRoundedEllipsoid.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineScheduledStateEncodingBound.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineSmallDimension.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineSmoothedMatrix.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineSmoothingDelta.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineTrimHighZeros.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineUnaryGridGenerator.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineUnaryMatrixGenerator.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineUnaryRange.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/Main.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MatchingAlgorithm.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/MatrixPerturbation.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/NearCase.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/NumericalAffine.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/NumericalCapacity.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/NumericalInterior.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/NumericalNearby.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/NumericalPotentials.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/NumericalScales.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/NumericalTransfer.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/NumericalWitness.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/Optimizer.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/OptimizerOutputEncoding.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/PairFactorization.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/PairStability.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/PairedCertificate.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/PalomarComplexity.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/Permanent.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/RationalEllipsoid.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/RationalEncodingBounds.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/RationalEpigraphOracle.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/RationalFeasibility.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/RationalLinearOracle.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/RawRational.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/RawRationalBitBounds.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/RobustCycle.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/RoundedEllipsoid.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/RoundedEllipsoidBitBounds.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/RoundedEllipsoidIterationBounds.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/RoundedEllipsoidScales.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/RoundedFeasibility.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/RoundedFeasibilityBitBounds.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/RowStability.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/ScannedBetheBisection.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/ScannedBetheThresholdFeasibility.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/ScheduledFeasibility.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/ScheduledRoundedEllipsoid.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/ScheduledRoundedEllipsoidIteration.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/Sequential.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/SequentialNormalization.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/Slack.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/Smoothing.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/SourceAnariRezaei.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/SourceAnariRezaeiList.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/SourceAnariRezaeiMerge.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/SourceBetheLower.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/SourceBetheUpper.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/SourceStableBivariate.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/SourceStableClosure.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/SourceStableEncoding.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/SourceStableInduction.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/SourceStableReindex.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/SourceStableSlice.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/SourceStableSpecialization.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/SourceStableTable.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/SourceVontobel.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/Stable.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/StrongEntropy.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/Transfer.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/TransferIdentity.lean create mode 100644 LeanPool/BeyondBethe/BeyondBethe/WeakSeparation.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Asymptotics.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Asymptotics/PolyBound.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Asymptotics/PolynomialComposition.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Circuits.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Circuits/AndOrNot.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Circuits/AndOrNot/Defs.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Circuits/Basic.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Circuits/Encoding.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Circuits/Encoding/Defs.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Circuits/Encoding/Internal.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Circuits/Encoding/Internal/Codec.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Classes.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Classes/Containments.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Classes/Exponential.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Classes/FNP.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Classes/FNP/Defs.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Classes/L.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Classes/NP.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Classes/NP/Witness.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Classes/P.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Defs.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/Algebra.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/BlockScan.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/Blocks.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/Cat.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/ConsBit.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/Encoding.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/Extract.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/FstBlock.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/HeadFlag.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/Iterate.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/IterateLayout.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/MulLen.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/Reorder.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/Reverse.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/Simulate.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/SndBlock.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/StepAlgebra.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/TakeLen.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/Vec.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Vec.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Classes/P/Composition.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Classes/P/Defs.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Classes/P/FinsetDomain.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Classes/P/FinsetDomain/Internal.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Classes/P/Internal.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Classes/P/Internal/Composition.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Classes/P/Internal/NormalForm.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Classes/P/Internal/Preimage.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Classes/P/NormalForm.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Classes/P/PairWithInput.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Classes/P/PairWithInput/Internal.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Classes/P/Preimage.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Classes/P/UnaryLength.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Classes/P/UnaryLength/Internal.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Classes/Pairing.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Classes/Randomized.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Classes/Space.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Classes/Time.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Encoding.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Encoding/Data.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Encoding/DataEncode.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Encoding/Delimit.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Encoding/Pairing.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Languages.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Languages/LastBit.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Mathlib.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Mathlib/FinsetPrefixes.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Mathlib/NatBits.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Classes.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Classes/Defs.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Defs.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Internal.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Containment.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Containment/Defs.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Containment/Internal.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Defs.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/DenseOverlay.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/DenseOverlay/Defs.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/DenseOverlay/Internal.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Internal.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/AddressEq.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/AddressEq/Defs.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/AddressEq/Internal.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/DenseInputLookup.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/DenseInputLookup/Defs.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/DenseInputLookup/Internal.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryAppend.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryAppend/Defs.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryAppend/Internal.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryCleanup.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryCleanup/Defs.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryCleanup/Internal.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryDecode.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryDecode/Defs.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryDecode/Internal.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryDecode/LinearInternal.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryEncode.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryEncode/Defs.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryEncode/Internal.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryLookup.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryLookup/Defs.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryLookup/Internal.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryLookupRestore.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryMatch.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryMatch/Defs.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryMatch/Internal.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryMissCopy.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryMissCopy/Defs.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryMissCopy/Internal.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryReplace.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryReplace/Defs.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryReplace/Internal.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryScan.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryScan/Defs.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryScan/Internal.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryScan/Internal/Bounds.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryScan/Internal/Ctrl.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryScan/Internal/Inv.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryScan/Internal/Sem.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryScanStep.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryScanStep/Defs.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryScanStep/Internal.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/BoundsInternal.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Defs.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Ctrl.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/End.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Hit.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Inv.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Loop.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Miss.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Out.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Sem.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Step.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Time.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Progress.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Source.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Tagged.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/TaggedDefs.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/TaggedProof.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Control.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Defs.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Dense.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseControl.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseCtrlSim.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseDefs.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseDirect.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseDispatch.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseImm.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseLoad.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseSim.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseSimData.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseSimDefs.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseStore.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Direct.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Dispatch.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Immediate.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Internal.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Load.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Sim.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Sim/Control.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Sim/Data.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Sim/Defs.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Sim/Internal.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Store.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/Defs.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/DenseInternal.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/Internal.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/Internal/Assemble.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/Internal/Bounds.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/Internal/Prepare.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/Internal/Reset.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/Internal/Restore.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/Internal/Scan.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/Internal/Static.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/Internal/Value.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Bounds.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Bounds/Defs.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Bounds/Internal.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Decision.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Decision/Defs.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DecisionInternal.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Defs.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseBounds.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseBoundsDefs.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseBoundsProof.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseDecision.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseDecisionDefs.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseDecisionProof.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseDefs.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseInit.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseInitDefs.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseInitProof.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseInternal.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Init.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Init/Defs.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Init/Internal.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Initialization.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Internal.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/WordDecode.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/WordDecode/Defs.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/WordDecode/Internal.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/WordDecode/LinearInternal.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/WordEncode.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/WordEncode/Defs.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/WordEncode/Internal.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Defs.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Internal.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/ABI.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/ABI/Defs.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/ABI/Internal.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/ABI/Internal/Capture.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/ABI/Internal/Decision.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/ABI/Internal/Loop.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/ABI/Internal/Marshal.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/ABI/Internal/Resources.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Containment.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Containment/Internal.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Defs.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Internal.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Step.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Step/Defs.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Step/Internal.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Step/Internal/Action.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Step/Internal/Dispatch.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Step/Internal/Iteration.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Step/Internal/Layout.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Step/Internal/Load.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Step/Internal/Resources.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Step.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Step/Defs.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Step/Internal.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Step/Internal/Action.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Step/Internal/Dispatch.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Step/Internal/Layout.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Step/Internal/Load.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Step/Internal/Resources.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Soundness.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Defs.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/GateEval.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/GateEval/Defs.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/GateEval/Internal.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/GateStep.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/GateStep/Defs.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/GateStep/Internal.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/GateStreamStep.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/GateStreamStep/Defs.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/GateStreamStep/Internal.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Hamming.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Hamming/Defs.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Hamming/Internal.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Internal.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Internal/Resources.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/LastBit.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/LastBit/Defs.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/PairValidate.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/PairValidate/Defs.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/PairValidate/Internal.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Scanner.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Scanner/Defs.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Scanner/Internal.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Switch.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Switch/Compiled.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Switch/Defs.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Switch/Internal.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/ThreeSATSyntax.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/ThreeSATSyntax/Defs.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/UnaryDecode.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/UnaryDecode/Defs.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/UnaryDecode/Internal.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/Apply.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/ForBinaryWork.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/ForBinaryWork/Defs.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/ForBinaryWork/Internal.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/ForInput.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/ForInput/Defs.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/ForInput/Internal.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/ForWorkOnes.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/ForWorkOnes/Defs.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/ForWorkOnes/Internal.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/Internal.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/Internal/Complement.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/Internal/Generic.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/Internal/If.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/Internal/Loop.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/Internal/Retarget.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/Internal/Scanner.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/Internal/Seq.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/Internal/Union.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/RetargetCompute.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/RetargetCompute/Defs.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/RetargetCompute/Internal.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/WorkBranch.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/WorkBranch/Defs.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/WorkBranch/Internal.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/WorkSymbolBranch.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/WorkSymbolBranch/Defs.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/WorkSymbolBranch/Internal.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Composition.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Composition/Defs.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Composition/Internal.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Composition/Internal/FirstPhase.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Composition/Internal/Tail.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Composition/PairWithInput.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Composition/PairWithInput/Defs.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Composition/PairWithInput/Internal.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Frame.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Hoare.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Hoare/Defs.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Hoare/RetargetOutput.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Hoare/Space.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Hoare/Space/Defs.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Hoare/Space/Internal.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Internal.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Internal/OutputBounds.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Lift.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/OutputBounds.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Placement.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Placement/Defs.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Placement/Internal.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Registers.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Registers/Arith.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Registers/Emit.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Registers/EmitSeq.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Registers/ForReg.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Registers/Horner.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Registers/InputLen.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Registers/RegisterOps.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/SpaceTime.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/SpaceTime/Internal.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/SpaceTime/Internal/Reachability.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryAddConst.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryAddConst/Defs.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryAddConst/Internal.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryCopy.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryCopy/Defs.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryCopy/Internal.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryEq.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryEq/Defs.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryEq/Internal.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryFor.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryFor/Defs.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryFor/Internal.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryFor/Internal/Comparison.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryFor/Internal/Control.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryFor/Internal/Loop.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryPred.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryPred/Defs.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryPred/Internal.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleAdd.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleAdd/Defs.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleAdd/Internal.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleAdd/Internal/Bounds.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleAdd/Internal/Out.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleAdd/Internal/Pure.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleAdd/Internal/Rewind.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleAdd/Internal/Scan.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleAdd/Internal/Sem.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleSub.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleSub/Defs.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleSub/Internal.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleSub/Internal/Backward.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleSub/Internal/Out.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleSub/Internal/Pure.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleSub/Internal/Rewind.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleSub/Internal/Scan.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleSub/Internal/Sem.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryShiftMul.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryShiftMul/Defs.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryShiftMul/Internal.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryShiftMul/Internal/Out.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryShiftMul/Internal/Pure.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryShiftMul/Internal/Sem.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinarySucc.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinarySucc/Defs.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinarySucc/Internal.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/ClearWork.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/ClearWork/Defs.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/ClearWork/Internal.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/CopyOutput.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/CopyToVirtualInput.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/CopyWorkOutput.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/Counter.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/Internal.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/Internal/CopyOutput.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/Internal/CopyWorkOutput.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/MoveLeftStep.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/PairEmit.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/PairEmit/Defs.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/PairEmit/Internal.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/PairValidate.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/PairValidate/Defs.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/PairValidate/Internal.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/ParkAll.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/ResetBinary.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/ResetBinary/Defs.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/ResetBinary/Internal.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/ResetBinaryMany.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/ResetBinaryMany/Defs.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/ResetBinaryMany/Internal.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/ResetTapes.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/RewindList.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/UnaryLength.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/UnaryLength/Defs.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/UnaryLength/Internal.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/WipeLoop.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/WipeStep.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Tape.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Tape/Encoding.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/WorkReadOnly.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/SAT.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/SAT/Encoding.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/SAT/Language.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/SAT/Rename.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/SAT/Semantics.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/SAT/ThreeCNF.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/SAT/ThreeSAT.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/SAT/ThreeSAT/Syntax.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/SAT/Verifier.lean create mode 100644 LeanPool/BeyondBethe/Solution.lean diff --git a/LeanPool.lean b/LeanPool.lean index 50fa6e5b30..d40e05f9ca 100644 --- a/LeanPool.lean +++ b/LeanPool.lean @@ -223,6 +223,712 @@ import LeanPool.ArtinWedderburn.SetProd import LeanPool.BannaiBannaiStanton import LeanPool.BannaiBannaiStanton.BoundOnDistanceSet import LeanPool.Basic +import LeanPool.BeyondBethe +import LeanPool.BeyondBethe.BeyondBethe +import LeanPool.BeyondBethe.BeyondBethe.AdaptiveRoundedEllipsoid +import LeanPool.BeyondBethe.BeyondBethe.AlgorithmicSpec +import LeanPool.BeyondBethe.BeyondBethe.ApproximateKKT +import LeanPool.BeyondBethe.BeyondBethe.AxiomAudit +import LeanPool.BeyondBethe.BeyondBethe.Bethe +import LeanPool.BeyondBethe.BeyondBethe.BetheBisection +import LeanPool.BeyondBethe.BeyondBethe.BetheEpigraph +import LeanPool.BeyondBethe.BeyondBethe.BetheEpigraphFeasibility +import LeanPool.BeyondBethe.BeyondBethe.BetheEpigraphGeometry +import LeanPool.BeyondBethe.BeyondBethe.BetheFloorCutFormula +import LeanPool.BeyondBethe.BeyondBethe.BetheThresholdFeasibility +import LeanPool.BeyondBethe.BeyondBethe.BinaryDirectedElementary +import LeanPool.BeyondBethe.BeyondBethe.BinaryLongDivision +import LeanPool.BeyondBethe.BeyondBethe.BinaryRationalComparison +import LeanPool.BeyondBethe.BeyondBethe.BinaryRationalFloor +import LeanPool.BeyondBethe.BeyondBethe.Birkhoff +import LeanPool.BeyondBethe.BeyondBethe.Capacity +import LeanPool.BeyondBethe.BeyondBethe.CapacityOrder +import LeanPool.BeyondBethe.BeyondBethe.CapacityScaling +import LeanPool.BeyondBethe.BeyondBethe.CertificateCapacity +import LeanPool.BeyondBethe.BeyondBethe.CertificateMagnitude +import LeanPool.BeyondBethe.BeyondBethe.CertifiedPairWeights +import LeanPool.BeyondBethe.BeyondBethe.CleanConstants +import LeanPool.BeyondBethe.BeyondBethe.CleanGain +import LeanPool.BeyondBethe.BeyondBethe.CleanWitness +import LeanPool.BeyondBethe.BeyondBethe.ClusterAlpha +import LeanPool.BeyondBethe.BeyondBethe.ClusterCertificate +import LeanPool.BeyondBethe.BeyondBethe.ClusterFactors +import LeanPool.BeyondBethe.BeyondBethe.ClusterProduct +import LeanPool.BeyondBethe.BeyondBethe.Completion +import LeanPool.BeyondBethe.BeyondBethe.CoreEncoding +import LeanPool.BeyondBethe.BeyondBethe.CycleTransfer +import LeanPool.BeyondBethe.BeyondBethe.Cycles +import LeanPool.BeyondBethe.BeyondBethe.DirectedCertificateValue +import LeanPool.BeyondBethe.BeyondBethe.DirectedElementary +import LeanPool.BeyondBethe.BeyondBethe.DirectedOptimizerOracle +import LeanPool.BeyondBethe.BeyondBethe.DirectedPairCost +import LeanPool.BeyondBethe.BeyondBethe.DyadicMagnitudePrecision +import LeanPool.BeyondBethe.BeyondBethe.DyadicRounding +import LeanPool.BeyondBethe.BeyondBethe.Entropy +import LeanPool.BeyondBethe.BeyondBethe.ExcursionTransfer +import LeanPool.BeyondBethe.BeyondBethe.ExecutableCertificate +import LeanPool.BeyondBethe.BeyondBethe.ExecutableCertificateMagnitude +import LeanPool.BeyondBethe.BeyondBethe.ExecutableInterior +import LeanPool.BeyondBethe.BeyondBethe.ExecutablePositiveRoutine +import LeanPool.BeyondBethe.BeyondBethe.ExecutableScannedBetheOptimizer +import LeanPool.BeyondBethe.BeyondBethe.ExecutableTransfer +import LeanPool.BeyondBethe.BeyondBethe.ExplicitBetheOptimizer +import LeanPool.BeyondBethe.BeyondBethe.ExplicitBetheThresholdFeasibility +import LeanPool.BeyondBethe.BeyondBethe.ExplicitBounds +import LeanPool.BeyondBethe.BeyondBethe.ExplicitOptimizerScales +import LeanPool.BeyondBethe.BeyondBethe.ExplicitPositiveRoutine +import LeanPool.BeyondBethe.BeyondBethe.ExplicitScales +import LeanPool.BeyondBethe.BeyondBethe.ExplicitScheduledFeasibility +import LeanPool.BeyondBethe.BeyondBethe.FinalAssembly +import LeanPool.BeyondBethe.BeyondBethe.Gain +import LeanPool.BeyondBethe.BeyondBethe.Gibbs +import LeanPool.BeyondBethe.BeyondBethe.GoodRowScore +import LeanPool.BeyondBethe.BeyondBethe.GreedyRowMatching +import LeanPool.BeyondBethe.BeyondBethe.KuhnMatching +import LeanPool.BeyondBethe.BeyondBethe.KuhnSmallStep +import LeanPool.BeyondBethe.BeyondBethe.MachineArithmeticTests +import LeanPool.BeyondBethe.BeyondBethe.MachineBetheAffineEntry +import LeanPool.BeyondBethe.BeyondBethe.MachineBetheAffineLineSum +import LeanPool.BeyondBethe.BeyondBethe.MachineBetheEpigraphOracle +import LeanPool.BeyondBethe.BeyondBethe.MachineBetheFeasibilityFit +import LeanPool.BeyondBethe.BeyondBethe.MachineBetheFeasibilityLoop +import LeanPool.BeyondBethe.BeyondBethe.MachineBetheFeasibilitySemantics +import LeanPool.BeyondBethe.BeyondBethe.MachineBetheFloorCutEntry +import LeanPool.BeyondBethe.BeyondBethe.MachineBetheFloorCutVector +import LeanPool.BeyondBethe.BeyondBethe.MachineBetheFloorScan +import LeanPool.BeyondBethe.BeyondBethe.MachineBetheFloorTest +import LeanPool.BeyondBethe.BeyondBethe.MachineBetheHeightCap +import LeanPool.BeyondBethe.BeyondBethe.MachineBetheHeightNormal +import LeanPool.BeyondBethe.BeyondBethe.MachineBinaryAdd +import LeanPool.BeyondBethe.BeyondBethe.MachineBinaryAddSemantics +import LeanPool.BeyondBethe.BeyondBethe.MachineBinaryCompare +import LeanPool.BeyondBethe.BeyondBethe.MachineBinaryDivision +import LeanPool.BeyondBethe.BeyondBethe.MachineBinaryGCD +import LeanPool.BeyondBethe.BeyondBethe.MachineBinaryListInit +import LeanPool.BeyondBethe.BeyondBethe.MachineBinaryListSnoc +import LeanPool.BeyondBethe.BeyondBethe.MachineBinaryMul +import LeanPool.BeyondBethe.BeyondBethe.MachineBinarySub +import LeanPool.BeyondBethe.BeyondBethe.MachineBitAssembly +import LeanPool.BeyondBethe.BeyondBethe.MachineBool +import LeanPool.BeyondBethe.BeyondBethe.MachineBooleanInit +import LeanPool.BeyondBethe.BeyondBethe.MachineBooleanMemory +import LeanPool.BeyondBethe.BeyondBethe.MachineBoundedUnary +import LeanPool.BeyondBethe.BeyondBethe.MachineCertificateAssembly +import LeanPool.BeyondBethe.BeyondBethe.MachineCertificateExpGuard +import LeanPool.BeyondBethe.BeyondBethe.MachineCertificatePotentials +import LeanPool.BeyondBethe.BeyondBethe.MachineCertificateScales +import LeanPool.BeyondBethe.BeyondBethe.MachineCertifiedPairEligibility +import LeanPool.BeyondBethe.BeyondBethe.MachineCompletedAlgorithm +import LeanPool.BeyondBethe.BeyondBethe.MachineDirectedAffineGradientEntry +import LeanPool.BeyondBethe.BeyondBethe.MachineDirectedAffineGradientVector +import LeanPool.BeyondBethe.BeyondBethe.MachineDirectedEpigraphNormal +import LeanPool.BeyondBethe.BeyondBethe.MachineDirectedLog +import LeanPool.BeyondBethe.BeyondBethe.MachineDirectedNegativeGradientCoordinate +import LeanPool.BeyondBethe.BeyondBethe.MachineDirectedNegativeGradientEntry +import LeanPool.BeyondBethe.BeyondBethe.MachineDirectedNegativeObjectiveCoordinate +import LeanPool.BeyondBethe.BeyondBethe.MachineDirectedNegativeObjectiveSum +import LeanPool.BeyondBethe.BeyondBethe.MachineDirectedTransferCost +import LeanPool.BeyondBethe.BeyondBethe.MachineDyadicFloor +import LeanPool.BeyondBethe.BeyondBethe.MachineDyadicFloorMatrix +import LeanPool.BeyondBethe.BeyondBethe.MachineDyadicFloorVector +import LeanPool.BeyondBethe.BeyondBethe.MachineEncoding +import LeanPool.BeyondBethe.BeyondBethe.MachineExecutableCertificate +import LeanPool.BeyondBethe.BeyondBethe.MachineExecutablePositiveAlgorithm +import LeanPool.BeyondBethe.BeyondBethe.MachineExecutableScannedOptimizerOutput +import LeanPool.BeyondBethe.BeyondBethe.MachineExplicitCertificate +import LeanPool.BeyondBethe.BeyondBethe.MachineFPBasics +import LeanPool.BeyondBethe.BeyondBethe.MachineFactorial +import LeanPool.BeyondBethe.BeyondBethe.MachineFinalScalars +import LeanPool.BeyondBethe.BeyondBethe.MachineFourCoreCost +import LeanPool.BeyondBethe.BeyondBethe.MachineGreedyRowMatching +import LeanPool.BeyondBethe.BeyondBethe.MachineIntegerArithmetic +import LeanPool.BeyondBethe.BeyondBethe.MachineIntegerCompare +import LeanPool.BeyondBethe.BeyondBethe.MachineIntegerSignedMagnitude +import LeanPool.BeyondBethe.BeyondBethe.MachineKuhnEncoding +import LeanPool.BeyondBethe.BeyondBethe.MachineKuhnInvariant +import LeanPool.BeyondBethe.BeyondBethe.MachineKuhnRunner +import LeanPool.BeyondBethe.BeyondBethe.MachineKuhnSemantics +import LeanPool.BeyondBethe.BeyondBethe.MachineKuhnStep +import LeanPool.BeyondBethe.BeyondBethe.MachineLengthBits +import LeanPool.BeyondBethe.BeyondBethe.MachineListIndex +import LeanPool.BeyondBethe.BeyondBethe.MachineListReverse +import LeanPool.BeyondBethe.BeyondBethe.MachineListUpdate +import LeanPool.BeyondBethe.BeyondBethe.MachineMatchingGain +import LeanPool.BeyondBethe.BeyondBethe.MachineMateAllSome +import LeanPool.BeyondBethe.BeyondBethe.MachineMateMemory +import LeanPool.BeyondBethe.BeyondBethe.MachineMatrixAddDelta +import LeanPool.BeyondBethe.BeyondBethe.MachineMatrixDimension +import LeanPool.BeyondBethe.BeyondBethe.MachineMatrixNonnegative +import LeanPool.BeyondBethe.BeyondBethe.MachineMatrixNormalization +import LeanPool.BeyondBethe.BeyondBethe.MachineMatrixNormalizeEntries +import LeanPool.BeyondBethe.BeyondBethe.MachineMatrixSum +import LeanPool.BeyondBethe.BeyondBethe.MachineMatrixSupportProduct +import LeanPool.BeyondBethe.BeyondBethe.MachineNaturalCombinators +import LeanPool.BeyondBethe.BeyondBethe.MachineNearbyCoordinate +import LeanPool.BeyondBethe.BeyondBethe.MachineNearbyMatrixSum +import LeanPool.BeyondBethe.BeyondBethe.MachineNestedMatrixMemory +import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerBisectionLoop +import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerBisectionSchedule +import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerBisectionSemantics +import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerCertificateBoundary +import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerDerivedScales +import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerEntryLength +import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerFeasibilityCall +import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerFeasibilitySchedule +import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerInteriorScale +import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerMatrixBitBound +import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerRoundingSchedule +import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerStateBound +import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerTests +import LeanPool.BeyondBethe.BeyondBethe.MachineOutputEncoding +import LeanPool.BeyondBethe.BeyondBethe.MachinePerfectMatching +import LeanPool.BeyondBethe.BeyondBethe.MachinePositiveAlgorithm +import LeanPool.BeyondBethe.BeyondBethe.MachineRAMBridge +import LeanPool.BeyondBethe.BeyondBethe.MachineRAMSmoke +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalArithmetic +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalBallInit +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalCompare +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalDirectionUpdateMatrix +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalDirectionUpdateRow +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalEllipsoidCenterUpdate +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalEllipsoidEncoding +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalEllipsoidScalars +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalEllipsoidUpdate +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalExp +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalFloor +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalLogSeries +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalMatrixColumn +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalMatrixMul +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalMatrixMulVector +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalMatrixUpdate +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalMin +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalNormalization +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalNormalizedDirection +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalPower +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalRowAdd +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalRowDivide +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalTransposeMulVector +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalUnary +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalVectorDot +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalVectorL1 +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalVectorScale +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalVectorSub +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalVectorSum +import LeanPool.BeyondBethe.BeyondBethe.MachineRepeatPair +import LeanPool.BeyondBethe.BeyondBethe.MachineRowComplementUpperSum +import LeanPool.BeyondBethe.BeyondBethe.MachineRowPairDisjoint +import LeanPool.BeyondBethe.BeyondBethe.MachineScheduledLog +import LeanPool.BeyondBethe.BeyondBethe.MachineScheduledLogWidth +import LeanPool.BeyondBethe.BeyondBethe.MachineScheduledRoundedEllipsoid +import LeanPool.BeyondBethe.BeyondBethe.MachineScheduledStateEncodingBound +import LeanPool.BeyondBethe.BeyondBethe.MachineSmallDimension +import LeanPool.BeyondBethe.BeyondBethe.MachineSmoothedMatrix +import LeanPool.BeyondBethe.BeyondBethe.MachineSmoothingDelta +import LeanPool.BeyondBethe.BeyondBethe.MachineTrimHighZeros +import LeanPool.BeyondBethe.BeyondBethe.MachineUnaryGridGenerator +import LeanPool.BeyondBethe.BeyondBethe.MachineUnaryMatrixGenerator +import LeanPool.BeyondBethe.BeyondBethe.MachineUnaryRange +import LeanPool.BeyondBethe.BeyondBethe.Main +import LeanPool.BeyondBethe.BeyondBethe.MatchingAlgorithm +import LeanPool.BeyondBethe.BeyondBethe.MatrixPerturbation +import LeanPool.BeyondBethe.BeyondBethe.NearCase +import LeanPool.BeyondBethe.BeyondBethe.NumericalAffine +import LeanPool.BeyondBethe.BeyondBethe.NumericalCapacity +import LeanPool.BeyondBethe.BeyondBethe.NumericalInterior +import LeanPool.BeyondBethe.BeyondBethe.NumericalNearby +import LeanPool.BeyondBethe.BeyondBethe.NumericalPotentials +import LeanPool.BeyondBethe.BeyondBethe.NumericalScales +import LeanPool.BeyondBethe.BeyondBethe.NumericalTransfer +import LeanPool.BeyondBethe.BeyondBethe.NumericalWitness +import LeanPool.BeyondBethe.BeyondBethe.Optimizer +import LeanPool.BeyondBethe.BeyondBethe.OptimizerOutputEncoding +import LeanPool.BeyondBethe.BeyondBethe.PairFactorization +import LeanPool.BeyondBethe.BeyondBethe.PairStability +import LeanPool.BeyondBethe.BeyondBethe.PairedCertificate +import LeanPool.BeyondBethe.BeyondBethe.PalomarComplexity +import LeanPool.BeyondBethe.BeyondBethe.Permanent +import LeanPool.BeyondBethe.BeyondBethe.RationalEllipsoid +import LeanPool.BeyondBethe.BeyondBethe.RationalEncodingBounds +import LeanPool.BeyondBethe.BeyondBethe.RationalEpigraphOracle +import LeanPool.BeyondBethe.BeyondBethe.RationalFeasibility +import LeanPool.BeyondBethe.BeyondBethe.RationalLinearOracle +import LeanPool.BeyondBethe.BeyondBethe.RawRational +import LeanPool.BeyondBethe.BeyondBethe.RawRationalBitBounds +import LeanPool.BeyondBethe.BeyondBethe.RobustCycle +import LeanPool.BeyondBethe.BeyondBethe.RoundedEllipsoid +import LeanPool.BeyondBethe.BeyondBethe.RoundedEllipsoidBitBounds +import LeanPool.BeyondBethe.BeyondBethe.RoundedEllipsoidIterationBounds +import LeanPool.BeyondBethe.BeyondBethe.RoundedEllipsoidScales +import LeanPool.BeyondBethe.BeyondBethe.RoundedFeasibility +import LeanPool.BeyondBethe.BeyondBethe.RoundedFeasibilityBitBounds +import LeanPool.BeyondBethe.BeyondBethe.RowStability +import LeanPool.BeyondBethe.BeyondBethe.ScannedBetheBisection +import LeanPool.BeyondBethe.BeyondBethe.ScannedBetheThresholdFeasibility +import LeanPool.BeyondBethe.BeyondBethe.ScheduledFeasibility +import LeanPool.BeyondBethe.BeyondBethe.ScheduledRoundedEllipsoid +import LeanPool.BeyondBethe.BeyondBethe.ScheduledRoundedEllipsoidIteration +import LeanPool.BeyondBethe.BeyondBethe.Sequential +import LeanPool.BeyondBethe.BeyondBethe.SequentialNormalization +import LeanPool.BeyondBethe.BeyondBethe.Slack +import LeanPool.BeyondBethe.BeyondBethe.Smoothing +import LeanPool.BeyondBethe.BeyondBethe.SourceAnariRezaei +import LeanPool.BeyondBethe.BeyondBethe.SourceAnariRezaeiList +import LeanPool.BeyondBethe.BeyondBethe.SourceAnariRezaeiMerge +import LeanPool.BeyondBethe.BeyondBethe.SourceBetheLower +import LeanPool.BeyondBethe.BeyondBethe.SourceBetheUpper +import LeanPool.BeyondBethe.BeyondBethe.SourceStableBivariate +import LeanPool.BeyondBethe.BeyondBethe.SourceStableClosure +import LeanPool.BeyondBethe.BeyondBethe.SourceStableEncoding +import LeanPool.BeyondBethe.BeyondBethe.SourceStableInduction +import LeanPool.BeyondBethe.BeyondBethe.SourceStableReindex +import LeanPool.BeyondBethe.BeyondBethe.SourceStableSlice +import LeanPool.BeyondBethe.BeyondBethe.SourceStableSpecialization +import LeanPool.BeyondBethe.BeyondBethe.SourceStableTable +import LeanPool.BeyondBethe.BeyondBethe.SourceVontobel +import LeanPool.BeyondBethe.BeyondBethe.Stable +import LeanPool.BeyondBethe.BeyondBethe.StrongEntropy +import LeanPool.BeyondBethe.BeyondBethe.Transfer +import LeanPool.BeyondBethe.BeyondBethe.TransferIdentity +import LeanPool.BeyondBethe.BeyondBethe.WeakSeparation +import LeanPool.BeyondBethe.Complexitylib +import LeanPool.BeyondBethe.Complexitylib.Asymptotics +import LeanPool.BeyondBethe.Complexitylib.Asymptotics.PolyBound +import LeanPool.BeyondBethe.Complexitylib.Asymptotics.PolynomialComposition +import LeanPool.BeyondBethe.Complexitylib.Circuits +import LeanPool.BeyondBethe.Complexitylib.Circuits.AndOrNot +import LeanPool.BeyondBethe.Complexitylib.Circuits.AndOrNot.Defs +import LeanPool.BeyondBethe.Complexitylib.Circuits.Basic +import LeanPool.BeyondBethe.Complexitylib.Circuits.Encoding +import LeanPool.BeyondBethe.Complexitylib.Circuits.Encoding.Defs +import LeanPool.BeyondBethe.Complexitylib.Circuits.Encoding.Internal +import LeanPool.BeyondBethe.Complexitylib.Circuits.Encoding.Internal.Codec +import LeanPool.BeyondBethe.Complexitylib.Classes +import LeanPool.BeyondBethe.Complexitylib.Classes.Containments +import LeanPool.BeyondBethe.Complexitylib.Classes.Exponential +import LeanPool.BeyondBethe.Complexitylib.Classes.FNP +import LeanPool.BeyondBethe.Complexitylib.Classes.FNP.Defs +import LeanPool.BeyondBethe.Complexitylib.Classes.L +import LeanPool.BeyondBethe.Complexitylib.Classes.NP +import LeanPool.BeyondBethe.Complexitylib.Classes.NP.Witness +import LeanPool.BeyondBethe.Complexitylib.Classes.P +import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham +import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Defs +import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal +import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.Algebra +import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.BlockScan +import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.Blocks +import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.Cat +import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.ConsBit +import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.Encoding +import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.Extract +import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.FstBlock +import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.HeadFlag +import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.Iterate +import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.IterateLayout +import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.MulLen +import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.Reorder +import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.Reverse +import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.Simulate +import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.SndBlock +import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.StepAlgebra +import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.TakeLen +import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.Vec +import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Vec +import LeanPool.BeyondBethe.Complexitylib.Classes.P.Composition +import LeanPool.BeyondBethe.Complexitylib.Classes.P.Defs +import LeanPool.BeyondBethe.Complexitylib.Classes.P.FinsetDomain +import LeanPool.BeyondBethe.Complexitylib.Classes.P.FinsetDomain.Internal +import LeanPool.BeyondBethe.Complexitylib.Classes.P.Internal +import LeanPool.BeyondBethe.Complexitylib.Classes.P.Internal.Composition +import LeanPool.BeyondBethe.Complexitylib.Classes.P.Internal.NormalForm +import LeanPool.BeyondBethe.Complexitylib.Classes.P.Internal.Preimage +import LeanPool.BeyondBethe.Complexitylib.Classes.P.NormalForm +import LeanPool.BeyondBethe.Complexitylib.Classes.P.PairWithInput +import LeanPool.BeyondBethe.Complexitylib.Classes.P.PairWithInput.Internal +import LeanPool.BeyondBethe.Complexitylib.Classes.P.Preimage +import LeanPool.BeyondBethe.Complexitylib.Classes.P.UnaryLength +import LeanPool.BeyondBethe.Complexitylib.Classes.P.UnaryLength.Internal +import LeanPool.BeyondBethe.Complexitylib.Classes.Pairing +import LeanPool.BeyondBethe.Complexitylib.Classes.Randomized +import LeanPool.BeyondBethe.Complexitylib.Classes.Space +import LeanPool.BeyondBethe.Complexitylib.Classes.Time +import LeanPool.BeyondBethe.Complexitylib.Encoding +import LeanPool.BeyondBethe.Complexitylib.Encoding.Data +import LeanPool.BeyondBethe.Complexitylib.Encoding.DataEncode +import LeanPool.BeyondBethe.Complexitylib.Encoding.Delimit +import LeanPool.BeyondBethe.Complexitylib.Encoding.Pairing +import LeanPool.BeyondBethe.Complexitylib.Languages +import LeanPool.BeyondBethe.Complexitylib.Languages.LastBit +import LeanPool.BeyondBethe.Complexitylib.Mathlib +import LeanPool.BeyondBethe.Complexitylib.Mathlib.FinsetPrefixes +import LeanPool.BeyondBethe.Complexitylib.Mathlib.NatBits +import LeanPool.BeyondBethe.Complexitylib.Models +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Classes +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Classes.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Containment +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Containment.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Containment.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.DenseOverlay +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.DenseOverlay.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.DenseOverlay.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.AddressEq +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.AddressEq.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.AddressEq.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.DenseInputLookup +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.DenseInputLookup.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.DenseInputLookup.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryAppend +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryAppend.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryAppend.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryCleanup +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryCleanup.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryCleanup.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryDecode +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryDecode.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryDecode.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryDecode.LinearInternal +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryEncode +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryEncode.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryEncode.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryLookup +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryLookup.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryLookup.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryLookupRestore +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryMatch +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryMatch.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryMatch.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryMissCopy +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryMissCopy.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryMissCopy.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryReplace +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryReplace.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryReplace.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryScan +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryScan.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryScan.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryScan.Internal.Bounds +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryScan.Internal.Ctrl +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryScan.Internal.Inv +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryScan.Internal.Sem +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryScanStep +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryScanStep.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryScanStep.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.BoundsInternal +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Ctrl +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.End +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Hit +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Inv +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Loop +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Miss +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Out +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Sem +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Step +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Time +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Progress +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Source +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Tagged +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.TaggedDefs +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.TaggedProof +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Control +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Dense +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.DenseControl +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.DenseCtrlSim +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.DenseDefs +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.DenseDirect +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.DenseDispatch +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.DenseImm +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.DenseLoad +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.DenseSim +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.DenseSimData +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.DenseSimDefs +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.DenseStore +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Direct +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Dispatch +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Immediate +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Load +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Sim +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Sim.Control +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Sim.Data +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Sim.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Sim.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Store +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.DenseInternal +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Internal.Assemble +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Internal.Bounds +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Internal.Prepare +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Internal.Reset +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Internal.Restore +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Internal.Scan +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Internal.Static +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Internal.Value +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Bounds +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Bounds.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Bounds.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Decision +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Decision.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.DecisionInternal +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.DenseBounds +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.DenseBoundsDefs +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.DenseBoundsProof +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.DenseDecision +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.DenseDecisionDefs +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.DenseDecisionProof +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.DenseDefs +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.DenseInit +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.DenseInitDefs +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.DenseInitProof +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.DenseInternal +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Init +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Init.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Init.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Initialization +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.WordDecode +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.WordDecode.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.WordDecode.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.WordDecode.LinearInternal +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.WordEncode +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.WordEncode.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.WordEncode.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.ABI +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.ABI.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.ABI.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.ABI.Internal.Capture +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.ABI.Internal.Decision +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.ABI.Internal.Loop +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.ABI.Internal.Marshal +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.ABI.Internal.Resources +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.Containment +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.Containment.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.Step +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.Step.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.Step.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.Step.Internal.Action +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.Step.Internal.Dispatch +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.Step.Internal.Iteration +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.Step.Internal.Layout +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.Step.Internal.Load +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.Step.Internal.Resources +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Step +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Step.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Step.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Step.Internal.Action +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Step.Internal.Dispatch +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Step.Internal.Layout +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Step.Internal.Load +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Step.Internal.Resources +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Soundness +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.GateEval +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.GateEval.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.GateEval.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.GateStep +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.GateStep.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.GateStep.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.GateStreamStep +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.GateStreamStep.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.GateStreamStep.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.Hamming +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.Hamming.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.Hamming.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.Internal.Resources +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.LastBit +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.LastBit.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.PairValidate +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.PairValidate.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.PairValidate.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.Scanner +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.Scanner.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.Scanner.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.Switch +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.Switch.Compiled +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.Switch.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.Switch.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.ThreeSATSyntax +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.ThreeSATSyntax.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.UnaryDecode +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.UnaryDecode.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.UnaryDecode.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.Apply +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.ForBinaryWork +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.ForBinaryWork.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.ForBinaryWork.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.ForInput +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.ForInput.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.ForInput.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.ForWorkOnes +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.ForWorkOnes.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.ForWorkOnes.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.Internal.Complement +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.Internal.Generic +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.Internal.If +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.Internal.Loop +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.Internal.Retarget +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.Internal.Scanner +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.Internal.Seq +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.Internal.Union +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.RetargetCompute +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.RetargetCompute.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.RetargetCompute.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.WorkBranch +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.WorkBranch.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.WorkBranch.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.WorkSymbolBranch +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.WorkSymbolBranch.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.WorkSymbolBranch.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Composition +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Composition.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Composition.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Composition.Internal.FirstPhase +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Composition.Internal.Tail +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Composition.PairWithInput +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Composition.PairWithInput.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Composition.PairWithInput.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Frame +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Hoare +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Hoare.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Hoare.RetargetOutput +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Hoare.Space +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Hoare.Space.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Hoare.Space.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Internal.OutputBounds +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Lift +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.OutputBounds +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Placement +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Placement.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Placement.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Registers +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Registers.Arith +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Registers.Emit +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Registers.EmitSeq +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Registers.ForReg +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Registers.Horner +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Registers.InputLen +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Registers.RegisterOps +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.SpaceTime +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.SpaceTime.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.SpaceTime.Internal.Reachability +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryAddConst +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryAddConst.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryAddConst.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryCopy +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryCopy.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryCopy.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryEq +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryEq.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryEq.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryFor +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryFor.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryFor.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryFor.Internal.Comparison +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryFor.Internal.Control +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryFor.Internal.Loop +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryPred +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryPred.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryPred.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleAdd +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleAdd.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleAdd.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleAdd.Internal.Bounds +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleAdd.Internal.Out +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleAdd.Internal.Pure +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleAdd.Internal.Rewind +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleAdd.Internal.Scan +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleAdd.Internal.Sem +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleSub +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleSub.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleSub.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleSub.Internal.Backward +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleSub.Internal.Out +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleSub.Internal.Pure +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleSub.Internal.Rewind +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleSub.Internal.Scan +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleSub.Internal.Sem +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryShiftMul +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryShiftMul.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryShiftMul.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryShiftMul.Internal.Out +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryShiftMul.Internal.Pure +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryShiftMul.Internal.Sem +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinarySucc +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinarySucc.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinarySucc.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.ClearWork +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.ClearWork.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.ClearWork.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.CopyOutput +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.CopyToVirtualInput +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.CopyWorkOutput +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.Counter +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.Internal.CopyOutput +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.Internal.CopyWorkOutput +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.MoveLeftStep +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.PairEmit +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.PairEmit.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.PairEmit.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.PairValidate +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.PairValidate.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.PairValidate.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.ParkAll +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.ResetBinary +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.ResetBinary.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.ResetBinary.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.ResetBinaryMany +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.ResetBinaryMany.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.ResetBinaryMany.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.ResetTapes +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.RewindList +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.UnaryLength +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.UnaryLength.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.UnaryLength.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.WipeLoop +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.WipeStep +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Tape +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Tape.Encoding +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.WorkReadOnly +import LeanPool.BeyondBethe.Complexitylib.SAT +import LeanPool.BeyondBethe.Complexitylib.SAT.Encoding +import LeanPool.BeyondBethe.Complexitylib.SAT.Language +import LeanPool.BeyondBethe.Complexitylib.SAT.Rename +import LeanPool.BeyondBethe.Complexitylib.SAT.Semantics +import LeanPool.BeyondBethe.Complexitylib.SAT.ThreeCNF +import LeanPool.BeyondBethe.Complexitylib.SAT.ThreeSAT +import LeanPool.BeyondBethe.Complexitylib.SAT.ThreeSAT.Syntax +import LeanPool.BeyondBethe.Complexitylib.SAT.Verifier +import LeanPool.BeyondBethe.Solution import LeanPool.Biswal import LeanPool.Biswal.Theorem1 import LeanPool.Biswal.Theorem23 diff --git a/LeanPool/BeyondBethe.lean b/LeanPool/BeyondBethe.lean new file mode 100644 index 0000000000..68895f6550 --- /dev/null +++ b/LeanPool/BeyondBethe.lean @@ -0,0 +1,726 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe +import LeanPool.BeyondBethe.BeyondBethe.AdaptiveRoundedEllipsoid +import LeanPool.BeyondBethe.BeyondBethe.AlgorithmicSpec +import LeanPool.BeyondBethe.BeyondBethe.ApproximateKKT +import LeanPool.BeyondBethe.BeyondBethe.AxiomAudit +import LeanPool.BeyondBethe.BeyondBethe.Bethe +import LeanPool.BeyondBethe.BeyondBethe.BetheBisection +import LeanPool.BeyondBethe.BeyondBethe.BetheEpigraph +import LeanPool.BeyondBethe.BeyondBethe.BetheEpigraphFeasibility +import LeanPool.BeyondBethe.BeyondBethe.BetheEpigraphGeometry +import LeanPool.BeyondBethe.BeyondBethe.BetheFloorCutFormula +import LeanPool.BeyondBethe.BeyondBethe.BetheThresholdFeasibility +import LeanPool.BeyondBethe.BeyondBethe.BinaryDirectedElementary +import LeanPool.BeyondBethe.BeyondBethe.BinaryLongDivision +import LeanPool.BeyondBethe.BeyondBethe.BinaryRationalComparison +import LeanPool.BeyondBethe.BeyondBethe.BinaryRationalFloor +import LeanPool.BeyondBethe.BeyondBethe.Birkhoff +import LeanPool.BeyondBethe.BeyondBethe.Capacity +import LeanPool.BeyondBethe.BeyondBethe.CapacityOrder +import LeanPool.BeyondBethe.BeyondBethe.CapacityScaling +import LeanPool.BeyondBethe.BeyondBethe.CertificateCapacity +import LeanPool.BeyondBethe.BeyondBethe.CertificateMagnitude +import LeanPool.BeyondBethe.BeyondBethe.CertifiedPairWeights +import LeanPool.BeyondBethe.BeyondBethe.CleanConstants +import LeanPool.BeyondBethe.BeyondBethe.CleanGain +import LeanPool.BeyondBethe.BeyondBethe.CleanWitness +import LeanPool.BeyondBethe.BeyondBethe.ClusterAlpha +import LeanPool.BeyondBethe.BeyondBethe.ClusterCertificate +import LeanPool.BeyondBethe.BeyondBethe.ClusterFactors +import LeanPool.BeyondBethe.BeyondBethe.ClusterProduct +import LeanPool.BeyondBethe.BeyondBethe.Completion +import LeanPool.BeyondBethe.BeyondBethe.CoreEncoding +import LeanPool.BeyondBethe.BeyondBethe.CycleTransfer +import LeanPool.BeyondBethe.BeyondBethe.Cycles +import LeanPool.BeyondBethe.BeyondBethe.DirectedCertificateValue +import LeanPool.BeyondBethe.BeyondBethe.DirectedElementary +import LeanPool.BeyondBethe.BeyondBethe.DirectedOptimizerOracle +import LeanPool.BeyondBethe.BeyondBethe.DirectedPairCost +import LeanPool.BeyondBethe.BeyondBethe.DyadicMagnitudePrecision +import LeanPool.BeyondBethe.BeyondBethe.DyadicRounding +import LeanPool.BeyondBethe.BeyondBethe.Entropy +import LeanPool.BeyondBethe.BeyondBethe.ExcursionTransfer +import LeanPool.BeyondBethe.BeyondBethe.ExecutableCertificate +import LeanPool.BeyondBethe.BeyondBethe.ExecutableCertificateMagnitude +import LeanPool.BeyondBethe.BeyondBethe.ExecutableInterior +import LeanPool.BeyondBethe.BeyondBethe.ExecutablePositiveRoutine +import LeanPool.BeyondBethe.BeyondBethe.ExecutableScannedBetheOptimizer +import LeanPool.BeyondBethe.BeyondBethe.ExecutableTransfer +import LeanPool.BeyondBethe.BeyondBethe.ExplicitBetheOptimizer +import LeanPool.BeyondBethe.BeyondBethe.ExplicitBetheThresholdFeasibility +import LeanPool.BeyondBethe.BeyondBethe.ExplicitBounds +import LeanPool.BeyondBethe.BeyondBethe.ExplicitOptimizerScales +import LeanPool.BeyondBethe.BeyondBethe.ExplicitPositiveRoutine +import LeanPool.BeyondBethe.BeyondBethe.ExplicitScales +import LeanPool.BeyondBethe.BeyondBethe.ExplicitScheduledFeasibility +import LeanPool.BeyondBethe.BeyondBethe.FinalAssembly +import LeanPool.BeyondBethe.BeyondBethe.Gain +import LeanPool.BeyondBethe.BeyondBethe.Gibbs +import LeanPool.BeyondBethe.BeyondBethe.GoodRowScore +import LeanPool.BeyondBethe.BeyondBethe.GreedyRowMatching +import LeanPool.BeyondBethe.BeyondBethe.KuhnMatching +import LeanPool.BeyondBethe.BeyondBethe.KuhnSmallStep +import LeanPool.BeyondBethe.BeyondBethe.MachineArithmeticTests +import LeanPool.BeyondBethe.BeyondBethe.MachineBetheAffineEntry +import LeanPool.BeyondBethe.BeyondBethe.MachineBetheAffineLineSum +import LeanPool.BeyondBethe.BeyondBethe.MachineBetheEpigraphOracle +import LeanPool.BeyondBethe.BeyondBethe.MachineBetheFeasibilityFit +import LeanPool.BeyondBethe.BeyondBethe.MachineBetheFeasibilityLoop +import LeanPool.BeyondBethe.BeyondBethe.MachineBetheFeasibilitySemantics +import LeanPool.BeyondBethe.BeyondBethe.MachineBetheFloorCutEntry +import LeanPool.BeyondBethe.BeyondBethe.MachineBetheFloorCutVector +import LeanPool.BeyondBethe.BeyondBethe.MachineBetheFloorScan +import LeanPool.BeyondBethe.BeyondBethe.MachineBetheFloorTest +import LeanPool.BeyondBethe.BeyondBethe.MachineBetheHeightCap +import LeanPool.BeyondBethe.BeyondBethe.MachineBetheHeightNormal +import LeanPool.BeyondBethe.BeyondBethe.MachineBinaryAdd +import LeanPool.BeyondBethe.BeyondBethe.MachineBinaryAddSemantics +import LeanPool.BeyondBethe.BeyondBethe.MachineBinaryCompare +import LeanPool.BeyondBethe.BeyondBethe.MachineBinaryDivision +import LeanPool.BeyondBethe.BeyondBethe.MachineBinaryGCD +import LeanPool.BeyondBethe.BeyondBethe.MachineBinaryListInit +import LeanPool.BeyondBethe.BeyondBethe.MachineBinaryListSnoc +import LeanPool.BeyondBethe.BeyondBethe.MachineBinaryMul +import LeanPool.BeyondBethe.BeyondBethe.MachineBinarySub +import LeanPool.BeyondBethe.BeyondBethe.MachineBitAssembly +import LeanPool.BeyondBethe.BeyondBethe.MachineBool +import LeanPool.BeyondBethe.BeyondBethe.MachineBooleanInit +import LeanPool.BeyondBethe.BeyondBethe.MachineBooleanMemory +import LeanPool.BeyondBethe.BeyondBethe.MachineBoundedUnary +import LeanPool.BeyondBethe.BeyondBethe.MachineCertificateAssembly +import LeanPool.BeyondBethe.BeyondBethe.MachineCertificateExpGuard +import LeanPool.BeyondBethe.BeyondBethe.MachineCertificatePotentials +import LeanPool.BeyondBethe.BeyondBethe.MachineCertificateScales +import LeanPool.BeyondBethe.BeyondBethe.MachineCertifiedPairEligibility +import LeanPool.BeyondBethe.BeyondBethe.MachineCompletedAlgorithm +import LeanPool.BeyondBethe.BeyondBethe.MachineDirectedAffineGradientEntry +import LeanPool.BeyondBethe.BeyondBethe.MachineDirectedAffineGradientVector +import LeanPool.BeyondBethe.BeyondBethe.MachineDirectedEpigraphNormal +import LeanPool.BeyondBethe.BeyondBethe.MachineDirectedLog +import LeanPool.BeyondBethe.BeyondBethe.MachineDirectedNegativeGradientCoordinate +import LeanPool.BeyondBethe.BeyondBethe.MachineDirectedNegativeGradientEntry +import LeanPool.BeyondBethe.BeyondBethe.MachineDirectedNegativeObjectiveCoordinate +import LeanPool.BeyondBethe.BeyondBethe.MachineDirectedNegativeObjectiveSum +import LeanPool.BeyondBethe.BeyondBethe.MachineDirectedTransferCost +import LeanPool.BeyondBethe.BeyondBethe.MachineDyadicFloor +import LeanPool.BeyondBethe.BeyondBethe.MachineDyadicFloorMatrix +import LeanPool.BeyondBethe.BeyondBethe.MachineDyadicFloorVector +import LeanPool.BeyondBethe.BeyondBethe.MachineEncoding +import LeanPool.BeyondBethe.BeyondBethe.MachineExecutableCertificate +import LeanPool.BeyondBethe.BeyondBethe.MachineExecutablePositiveAlgorithm +import LeanPool.BeyondBethe.BeyondBethe.MachineExecutableScannedOptimizerOutput +import LeanPool.BeyondBethe.BeyondBethe.MachineExplicitCertificate +import LeanPool.BeyondBethe.BeyondBethe.MachineFPBasics +import LeanPool.BeyondBethe.BeyondBethe.MachineFactorial +import LeanPool.BeyondBethe.BeyondBethe.MachineFinalScalars +import LeanPool.BeyondBethe.BeyondBethe.MachineFourCoreCost +import LeanPool.BeyondBethe.BeyondBethe.MachineGreedyRowMatching +import LeanPool.BeyondBethe.BeyondBethe.MachineIntegerArithmetic +import LeanPool.BeyondBethe.BeyondBethe.MachineIntegerCompare +import LeanPool.BeyondBethe.BeyondBethe.MachineIntegerSignedMagnitude +import LeanPool.BeyondBethe.BeyondBethe.MachineKuhnEncoding +import LeanPool.BeyondBethe.BeyondBethe.MachineKuhnInvariant +import LeanPool.BeyondBethe.BeyondBethe.MachineKuhnRunner +import LeanPool.BeyondBethe.BeyondBethe.MachineKuhnSemantics +import LeanPool.BeyondBethe.BeyondBethe.MachineKuhnStep +import LeanPool.BeyondBethe.BeyondBethe.MachineLengthBits +import LeanPool.BeyondBethe.BeyondBethe.MachineListIndex +import LeanPool.BeyondBethe.BeyondBethe.MachineListReverse +import LeanPool.BeyondBethe.BeyondBethe.MachineListUpdate +import LeanPool.BeyondBethe.BeyondBethe.MachineMatchingGain +import LeanPool.BeyondBethe.BeyondBethe.MachineMateAllSome +import LeanPool.BeyondBethe.BeyondBethe.MachineMateMemory +import LeanPool.BeyondBethe.BeyondBethe.MachineMatrixAddDelta +import LeanPool.BeyondBethe.BeyondBethe.MachineMatrixDimension +import LeanPool.BeyondBethe.BeyondBethe.MachineMatrixNonnegative +import LeanPool.BeyondBethe.BeyondBethe.MachineMatrixNormalization +import LeanPool.BeyondBethe.BeyondBethe.MachineMatrixNormalizeEntries +import LeanPool.BeyondBethe.BeyondBethe.MachineMatrixSum +import LeanPool.BeyondBethe.BeyondBethe.MachineMatrixSupportProduct +import LeanPool.BeyondBethe.BeyondBethe.MachineNaturalCombinators +import LeanPool.BeyondBethe.BeyondBethe.MachineNearbyCoordinate +import LeanPool.BeyondBethe.BeyondBethe.MachineNearbyMatrixSum +import LeanPool.BeyondBethe.BeyondBethe.MachineNestedMatrixMemory +import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerBisectionLoop +import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerBisectionSchedule +import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerBisectionSemantics +import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerCertificateBoundary +import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerDerivedScales +import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerEntryLength +import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerFeasibilityCall +import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerFeasibilitySchedule +import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerInteriorScale +import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerMatrixBitBound +import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerRoundingSchedule +import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerStateBound +import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerTests +import LeanPool.BeyondBethe.BeyondBethe.MachineOutputEncoding +import LeanPool.BeyondBethe.BeyondBethe.MachinePerfectMatching +import LeanPool.BeyondBethe.BeyondBethe.MachinePositiveAlgorithm +import LeanPool.BeyondBethe.BeyondBethe.MachineRAMBridge +import LeanPool.BeyondBethe.BeyondBethe.MachineRAMSmoke +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalArithmetic +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalBallInit +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalCompare +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalDirectionUpdateMatrix +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalDirectionUpdateRow +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalEllipsoidCenterUpdate +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalEllipsoidEncoding +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalEllipsoidScalars +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalEllipsoidUpdate +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalExp +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalFloor +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalLogSeries +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalMatrixColumn +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalMatrixMul +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalMatrixMulVector +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalMatrixUpdate +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalMin +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalNormalization +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalNormalizedDirection +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalPower +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalRowAdd +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalRowDivide +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalTransposeMulVector +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalUnary +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalVectorDot +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalVectorL1 +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalVectorScale +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalVectorSub +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalVectorSum +import LeanPool.BeyondBethe.BeyondBethe.MachineRepeatPair +import LeanPool.BeyondBethe.BeyondBethe.MachineRowComplementUpperSum +import LeanPool.BeyondBethe.BeyondBethe.MachineRowPairDisjoint +import LeanPool.BeyondBethe.BeyondBethe.MachineScheduledLog +import LeanPool.BeyondBethe.BeyondBethe.MachineScheduledLogWidth +import LeanPool.BeyondBethe.BeyondBethe.MachineScheduledRoundedEllipsoid +import LeanPool.BeyondBethe.BeyondBethe.MachineScheduledStateEncodingBound +import LeanPool.BeyondBethe.BeyondBethe.MachineSmallDimension +import LeanPool.BeyondBethe.BeyondBethe.MachineSmoothedMatrix +import LeanPool.BeyondBethe.BeyondBethe.MachineSmoothingDelta +import LeanPool.BeyondBethe.BeyondBethe.MachineTrimHighZeros +import LeanPool.BeyondBethe.BeyondBethe.MachineUnaryGridGenerator +import LeanPool.BeyondBethe.BeyondBethe.MachineUnaryMatrixGenerator +import LeanPool.BeyondBethe.BeyondBethe.MachineUnaryRange +import LeanPool.BeyondBethe.BeyondBethe.Main +import LeanPool.BeyondBethe.BeyondBethe.MatchingAlgorithm +import LeanPool.BeyondBethe.BeyondBethe.MatrixPerturbation +import LeanPool.BeyondBethe.BeyondBethe.NearCase +import LeanPool.BeyondBethe.BeyondBethe.NumericalAffine +import LeanPool.BeyondBethe.BeyondBethe.NumericalCapacity +import LeanPool.BeyondBethe.BeyondBethe.NumericalInterior +import LeanPool.BeyondBethe.BeyondBethe.NumericalNearby +import LeanPool.BeyondBethe.BeyondBethe.NumericalPotentials +import LeanPool.BeyondBethe.BeyondBethe.NumericalScales +import LeanPool.BeyondBethe.BeyondBethe.NumericalTransfer +import LeanPool.BeyondBethe.BeyondBethe.NumericalWitness +import LeanPool.BeyondBethe.BeyondBethe.Optimizer +import LeanPool.BeyondBethe.BeyondBethe.OptimizerOutputEncoding +import LeanPool.BeyondBethe.BeyondBethe.PairFactorization +import LeanPool.BeyondBethe.BeyondBethe.PairStability +import LeanPool.BeyondBethe.BeyondBethe.PairedCertificate +import LeanPool.BeyondBethe.BeyondBethe.PalomarComplexity +import LeanPool.BeyondBethe.BeyondBethe.Permanent +import LeanPool.BeyondBethe.BeyondBethe.RationalEllipsoid +import LeanPool.BeyondBethe.BeyondBethe.RationalEncodingBounds +import LeanPool.BeyondBethe.BeyondBethe.RationalEpigraphOracle +import LeanPool.BeyondBethe.BeyondBethe.RationalFeasibility +import LeanPool.BeyondBethe.BeyondBethe.RationalLinearOracle +import LeanPool.BeyondBethe.BeyondBethe.RawRational +import LeanPool.BeyondBethe.BeyondBethe.RawRationalBitBounds +import LeanPool.BeyondBethe.BeyondBethe.RobustCycle +import LeanPool.BeyondBethe.BeyondBethe.RoundedEllipsoid +import LeanPool.BeyondBethe.BeyondBethe.RoundedEllipsoidBitBounds +import LeanPool.BeyondBethe.BeyondBethe.RoundedEllipsoidIterationBounds +import LeanPool.BeyondBethe.BeyondBethe.RoundedEllipsoidScales +import LeanPool.BeyondBethe.BeyondBethe.RoundedFeasibility +import LeanPool.BeyondBethe.BeyondBethe.RoundedFeasibilityBitBounds +import LeanPool.BeyondBethe.BeyondBethe.RowStability +import LeanPool.BeyondBethe.BeyondBethe.ScannedBetheBisection +import LeanPool.BeyondBethe.BeyondBethe.ScannedBetheThresholdFeasibility +import LeanPool.BeyondBethe.BeyondBethe.ScheduledFeasibility +import LeanPool.BeyondBethe.BeyondBethe.ScheduledRoundedEllipsoid +import LeanPool.BeyondBethe.BeyondBethe.ScheduledRoundedEllipsoidIteration +import LeanPool.BeyondBethe.BeyondBethe.Sequential +import LeanPool.BeyondBethe.BeyondBethe.SequentialNormalization +import LeanPool.BeyondBethe.BeyondBethe.Slack +import LeanPool.BeyondBethe.BeyondBethe.Smoothing +import LeanPool.BeyondBethe.BeyondBethe.SourceAnariRezaei +import LeanPool.BeyondBethe.BeyondBethe.SourceAnariRezaeiList +import LeanPool.BeyondBethe.BeyondBethe.SourceAnariRezaeiMerge +import LeanPool.BeyondBethe.BeyondBethe.SourceBetheLower +import LeanPool.BeyondBethe.BeyondBethe.SourceBetheUpper +import LeanPool.BeyondBethe.BeyondBethe.SourceStableBivariate +import LeanPool.BeyondBethe.BeyondBethe.SourceStableClosure +import LeanPool.BeyondBethe.BeyondBethe.SourceStableEncoding +import LeanPool.BeyondBethe.BeyondBethe.SourceStableInduction +import LeanPool.BeyondBethe.BeyondBethe.SourceStableReindex +import LeanPool.BeyondBethe.BeyondBethe.SourceStableSlice +import LeanPool.BeyondBethe.BeyondBethe.SourceStableSpecialization +import LeanPool.BeyondBethe.BeyondBethe.SourceStableTable +import LeanPool.BeyondBethe.BeyondBethe.SourceVontobel +import LeanPool.BeyondBethe.BeyondBethe.Stable +import LeanPool.BeyondBethe.BeyondBethe.StrongEntropy +import LeanPool.BeyondBethe.BeyondBethe.Transfer +import LeanPool.BeyondBethe.BeyondBethe.TransferIdentity +import LeanPool.BeyondBethe.BeyondBethe.WeakSeparation +import LeanPool.BeyondBethe.Complexitylib.Asymptotics +import LeanPool.BeyondBethe.Complexitylib.Asymptotics.PolyBound +import LeanPool.BeyondBethe.Complexitylib.Asymptotics.PolynomialComposition +import LeanPool.BeyondBethe.Complexitylib.Circuits.AndOrNot.Defs +import LeanPool.BeyondBethe.Complexitylib.Circuits.Basic +import LeanPool.BeyondBethe.Complexitylib.Circuits.Encoding.Defs +import LeanPool.BeyondBethe.Complexitylib.Circuits.Encoding.Internal.Codec +import LeanPool.BeyondBethe.Complexitylib.Classes.Containments +import LeanPool.BeyondBethe.Complexitylib.Classes.Exponential +import LeanPool.BeyondBethe.Complexitylib.Classes.FNP.Defs +import LeanPool.BeyondBethe.Complexitylib.Classes.L +import LeanPool.BeyondBethe.Complexitylib.Classes.NP +import LeanPool.BeyondBethe.Complexitylib.Classes.NP.Witness +import LeanPool.BeyondBethe.Complexitylib.Classes.P +import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham +import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Defs +import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal +import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.Algebra +import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.BlockScan +import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.Blocks +import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.Cat +import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.ConsBit +import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.Encoding +import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.Extract +import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.FstBlock +import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.HeadFlag +import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.Iterate +import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.IterateLayout +import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.MulLen +import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.Reorder +import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.Reverse +import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.Simulate +import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.SndBlock +import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.StepAlgebra +import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.TakeLen +import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.Vec +import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Vec +import LeanPool.BeyondBethe.Complexitylib.Classes.P.Composition +import LeanPool.BeyondBethe.Complexitylib.Classes.P.Defs +import LeanPool.BeyondBethe.Complexitylib.Classes.P.FinsetDomain +import LeanPool.BeyondBethe.Complexitylib.Classes.P.FinsetDomain.Internal +import LeanPool.BeyondBethe.Complexitylib.Classes.P.Internal +import LeanPool.BeyondBethe.Complexitylib.Classes.P.Internal.Composition +import LeanPool.BeyondBethe.Complexitylib.Classes.P.Internal.NormalForm +import LeanPool.BeyondBethe.Complexitylib.Classes.P.Internal.Preimage +import LeanPool.BeyondBethe.Complexitylib.Classes.P.NormalForm +import LeanPool.BeyondBethe.Complexitylib.Classes.P.PairWithInput +import LeanPool.BeyondBethe.Complexitylib.Classes.P.PairWithInput.Internal +import LeanPool.BeyondBethe.Complexitylib.Classes.P.Preimage +import LeanPool.BeyondBethe.Complexitylib.Classes.P.UnaryLength +import LeanPool.BeyondBethe.Complexitylib.Classes.P.UnaryLength.Internal +import LeanPool.BeyondBethe.Complexitylib.Classes.Pairing +import LeanPool.BeyondBethe.Complexitylib.Classes.Randomized +import LeanPool.BeyondBethe.Complexitylib.Classes.Space +import LeanPool.BeyondBethe.Complexitylib.Classes.Time +import LeanPool.BeyondBethe.Complexitylib.Encoding.Data +import LeanPool.BeyondBethe.Complexitylib.Encoding.DataEncode +import LeanPool.BeyondBethe.Complexitylib.Encoding.Delimit +import LeanPool.BeyondBethe.Complexitylib.Encoding.Pairing +import LeanPool.BeyondBethe.Complexitylib.Languages.LastBit +import LeanPool.BeyondBethe.Complexitylib.Mathlib.FinsetPrefixes +import LeanPool.BeyondBethe.Complexitylib.Mathlib.NatBits +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Classes +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Classes.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Containment +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Containment.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Containment.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.DenseOverlay +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.DenseOverlay.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.DenseOverlay.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.AddressEq +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.AddressEq.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.AddressEq.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.DenseInputLookup +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.DenseInputLookup.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.DenseInputLookup.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryAppend +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryAppend.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryAppend.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryCleanup +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryCleanup.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryCleanup.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryDecode +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryDecode.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryDecode.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryDecode.LinearInternal +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryEncode +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryEncode.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryEncode.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryLookup +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryLookup.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryLookup.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryLookupRestore +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryMatch +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryMatch.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryMatch.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryMissCopy +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryMissCopy.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryMissCopy.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryReplace +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryReplace.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryReplace.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryScan +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryScan.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryScan.Internal.Bounds +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryScan.Internal.Ctrl +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryScan.Internal.Inv +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryScan.Internal.Sem +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryScanStep +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryScanStep.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryScanStep.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.BoundsInternal +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Ctrl +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.End +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Hit +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Inv +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Loop +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Miss +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Out +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Sem +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Step +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Time +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Progress +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Source +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Tagged +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.TaggedDefs +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.TaggedProof +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Control +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Dense +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.DenseControl +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.DenseCtrlSim +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.DenseDefs +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.DenseDirect +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.DenseDispatch +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.DenseImm +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.DenseLoad +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.DenseSim +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.DenseSimData +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.DenseSimDefs +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.DenseStore +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Direct +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Dispatch +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Immediate +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Load +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Sim.Control +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Sim.Data +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Sim.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Sim.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Store +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.DenseInternal +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Internal.Assemble +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Internal.Bounds +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Internal.Prepare +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Internal.Reset +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Internal.Restore +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Internal.Scan +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Internal.Static +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Internal.Value +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Bounds +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Bounds.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Bounds.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Decision +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Decision.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.DecisionInternal +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.DenseBounds +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.DenseBoundsDefs +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.DenseBoundsProof +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.DenseDecision +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.DenseDecisionDefs +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.DenseDecisionProof +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.DenseDefs +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.DenseInit +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.DenseInitDefs +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.DenseInitProof +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.DenseInternal +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Init.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Init.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Initialization +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.WordDecode +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.WordDecode.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.WordDecode.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.WordDecode.LinearInternal +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.WordEncode +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.WordEncode.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.WordEncode.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.ABI +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.ABI.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.ABI.Internal.Capture +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.ABI.Internal.Decision +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.ABI.Internal.Loop +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.ABI.Internal.Marshal +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.ABI.Internal.Resources +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.Containment +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.Containment.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.Step +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.Step.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.Step.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.Step.Internal.Action +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.Step.Internal.Dispatch +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.Step.Internal.Iteration +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.Step.Internal.Layout +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.Step.Internal.Load +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.Step.Internal.Resources +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Step +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Step.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Step.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Step.Internal.Action +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Step.Internal.Dispatch +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Step.Internal.Layout +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Step.Internal.Load +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Step.Internal.Resources +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Soundness +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.GateEval +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.GateEval.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.GateEval.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.GateStep +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.GateStep.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.GateStep.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.GateStreamStep +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.GateStreamStep.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.GateStreamStep.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.Hamming +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.Hamming.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.Hamming.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.Internal.Resources +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.LastBit +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.LastBit.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.PairValidate +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.PairValidate.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.PairValidate.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.Scanner +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.Scanner.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.Scanner.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.Switch +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.Switch.Compiled +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.Switch.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.Switch.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.ThreeSATSyntax +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.ThreeSATSyntax.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.UnaryDecode +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.UnaryDecode.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.UnaryDecode.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.Apply +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.ForBinaryWork +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.ForBinaryWork.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.ForBinaryWork.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.ForInput.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.ForInput.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.ForWorkOnes.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.ForWorkOnes.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.Internal.Complement +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.Internal.Generic +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.Internal.If +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.Internal.Loop +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.Internal.Retarget +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.Internal.Scanner +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.Internal.Seq +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.Internal.Union +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.RetargetCompute +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.RetargetCompute.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.RetargetCompute.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.WorkBranch +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.WorkBranch.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.WorkBranch.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.WorkSymbolBranch +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.WorkSymbolBranch.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.WorkSymbolBranch.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Composition +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Composition.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Composition.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Composition.Internal.FirstPhase +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Composition.Internal.Tail +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Composition.PairWithInput +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Composition.PairWithInput.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Composition.PairWithInput.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Frame +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Hoare +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Hoare.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Hoare.RetargetOutput +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Hoare.Space +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Hoare.Space.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Hoare.Space.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Internal.OutputBounds +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Lift +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.OutputBounds +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Placement +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Placement.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Placement.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Registers +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Registers.Arith +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Registers.Emit +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Registers.EmitSeq +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Registers.ForReg +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Registers.Horner +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Registers.InputLen +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Registers.RegisterOps +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.SpaceTime.Internal.Reachability +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryAddConst +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryAddConst.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryAddConst.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryCopy +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryCopy.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryCopy.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryEq +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryEq.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryEq.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryFor.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryFor.Internal.Comparison +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryFor.Internal.Control +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryFor.Internal.Loop +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryPred +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryPred.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryPred.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleAdd +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleAdd.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleAdd.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleAdd.Internal.Bounds +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleAdd.Internal.Out +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleAdd.Internal.Pure +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleAdd.Internal.Rewind +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleAdd.Internal.Scan +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleAdd.Internal.Sem +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleSub +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleSub.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleSub.Internal.Backward +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleSub.Internal.Out +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleSub.Internal.Pure +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleSub.Internal.Rewind +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleSub.Internal.Scan +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleSub.Internal.Sem +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryShiftMul +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryShiftMul.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryShiftMul.Internal.Out +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryShiftMul.Internal.Pure +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryShiftMul.Internal.Sem +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinarySucc +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinarySucc.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinarySucc.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.ClearWork +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.ClearWork.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.ClearWork.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.CopyOutput +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.CopyToVirtualInput +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.CopyWorkOutput +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.Counter +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.Internal.CopyOutput +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.Internal.CopyWorkOutput +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.MoveLeftStep +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.PairEmit +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.PairEmit.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.PairEmit.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.PairValidate +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.PairValidate.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.PairValidate.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.ParkAll +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.ResetBinary +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.ResetBinary.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.ResetBinary.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.ResetBinaryMany +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.ResetBinaryMany.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.ResetBinaryMany.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.ResetTapes +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.RewindList +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.UnaryLength +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.UnaryLength.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.UnaryLength.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.WipeLoop +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.WipeStep +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Tape.Encoding +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.WorkReadOnly +import LeanPool.BeyondBethe.Complexitylib.SAT.Encoding +import LeanPool.BeyondBethe.Complexitylib.SAT.Language +import LeanPool.BeyondBethe.Complexitylib.SAT.Rename +import LeanPool.BeyondBethe.Complexitylib.SAT.Semantics +import LeanPool.BeyondBethe.Complexitylib.SAT.ThreeCNF +import LeanPool.BeyondBethe.Complexitylib.SAT.ThreeSAT +import LeanPool.BeyondBethe.Complexitylib.SAT.ThreeSAT.Syntax +import LeanPool.BeyondBethe.Complexitylib.SAT.Verifier +import LeanPool.BeyondBethe.Solution + +/-! +# Beyond the Bethe approximation of the permanent + +Source: url:https://github.com/nimaanari/formalization-beyond-bethe +Authors: Nima Anari +Status: verified +Main declarations: `BeyondBethe.theoremOne` +Tags: permanent, approximation-algorithms, computational-complexity, stable-polynomials +MSC: 68W25, 15A15 +-/ + +/- +Upstream attribution notices: + +# Third-party notices + +## pomegranate.sty + +The vendored `pomegranate.sty` is from Nima Anari's `tex-garden` and is used +to make the paper and arXiv source bundle self-contained. + +Copyright (c) 2020 Nima Anari + +Licensed under the MIT License: + +> Permission is hereby granted, free of charge, to any person obtaining a copy +> of this software and associated documentation files (the "Software"), to +> deal in the Software without restriction, including without limitation the +> rights to use, copy, modify, merge, publish, distribute, sublicense, and/or +> sell copies of the Software, and to permit persons to whom the Software is +> furnished to do so, subject to the following conditions: +> +> The above copyright notice and this permission notice shall be included in +> all copies or substantial portions of the Software. +> +> THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +> IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +> FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +> AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +> LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING +> FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS +> IN THE SOFTWARE. + +-/ diff --git a/LeanPool/BeyondBethe/BeyondBethe.lean b/LeanPool/BeyondBethe/BeyondBethe.lean new file mode 100644 index 0000000000..01035ab857 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe.lean @@ -0,0 +1,260 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.Permanent +import LeanPool.BeyondBethe.BeyondBethe.Birkhoff +import LeanPool.BeyondBethe.BeyondBethe.Entropy +import LeanPool.BeyondBethe.BeyondBethe.Bethe +import LeanPool.BeyondBethe.BeyondBethe.Stable +import LeanPool.BeyondBethe.BeyondBethe.Capacity +import LeanPool.BeyondBethe.BeyondBethe.CapacityOrder +import LeanPool.BeyondBethe.BeyondBethe.CapacityScaling +import LeanPool.BeyondBethe.BeyondBethe.PairedCertificate +import LeanPool.BeyondBethe.BeyondBethe.PairStability +import LeanPool.BeyondBethe.BeyondBethe.PairFactorization +import LeanPool.BeyondBethe.BeyondBethe.ClusterProduct +import LeanPool.BeyondBethe.BeyondBethe.ClusterFactors +import LeanPool.BeyondBethe.BeyondBethe.ClusterAlpha +import LeanPool.BeyondBethe.BeyondBethe.CertificateCapacity +import LeanPool.BeyondBethe.BeyondBethe.ClusterCertificate +import LeanPool.BeyondBethe.BeyondBethe.Gibbs +import LeanPool.BeyondBethe.BeyondBethe.SequentialNormalization +import LeanPool.BeyondBethe.BeyondBethe.Sequential +import LeanPool.BeyondBethe.BeyondBethe.Slack +import LeanPool.BeyondBethe.BeyondBethe.CoreEncoding +import LeanPool.BeyondBethe.BeyondBethe.Cycles +import LeanPool.BeyondBethe.BeyondBethe.GoodRowScore +import LeanPool.BeyondBethe.BeyondBethe.RobustCycle +import LeanPool.BeyondBethe.BeyondBethe.RowStability +import LeanPool.BeyondBethe.BeyondBethe.SourceAnariRezaei +import LeanPool.BeyondBethe.BeyondBethe.SourceAnariRezaeiMerge +import LeanPool.BeyondBethe.BeyondBethe.SourceAnariRezaeiList +import LeanPool.BeyondBethe.BeyondBethe.SourceBetheUpper +import LeanPool.BeyondBethe.BeyondBethe.SourceBetheLower +import LeanPool.BeyondBethe.BeyondBethe.SourceStableClosure +import LeanPool.BeyondBethe.BeyondBethe.SourceStableBivariate +import LeanPool.BeyondBethe.BeyondBethe.SourceStableTable +import LeanPool.BeyondBethe.BeyondBethe.SourceStableSpecialization +import LeanPool.BeyondBethe.BeyondBethe.SourceStableSlice +import LeanPool.BeyondBethe.BeyondBethe.SourceStableInduction +import LeanPool.BeyondBethe.BeyondBethe.SourceStableEncoding +import LeanPool.BeyondBethe.BeyondBethe.SourceStableReindex +import LeanPool.BeyondBethe.BeyondBethe.Transfer +import LeanPool.BeyondBethe.BeyondBethe.TransferIdentity +import LeanPool.BeyondBethe.BeyondBethe.Optimizer +import LeanPool.BeyondBethe.BeyondBethe.CycleTransfer +import LeanPool.BeyondBethe.BeyondBethe.ExcursionTransfer +import LeanPool.BeyondBethe.BeyondBethe.Gain +import LeanPool.BeyondBethe.BeyondBethe.CleanWitness +import LeanPool.BeyondBethe.BeyondBethe.CleanGain +import LeanPool.BeyondBethe.BeyondBethe.CleanConstants +import LeanPool.BeyondBethe.BeyondBethe.Smoothing +import LeanPool.BeyondBethe.BeyondBethe.Completion +import LeanPool.BeyondBethe.BeyondBethe.AlgorithmicSpec +import LeanPool.BeyondBethe.BeyondBethe.PalomarComplexity +import LeanPool.BeyondBethe.BeyondBethe.DirectedElementary +import LeanPool.BeyondBethe.BeyondBethe.ExplicitBounds +import LeanPool.BeyondBethe.BeyondBethe.KuhnMatching +import LeanPool.BeyondBethe.BeyondBethe.GreedyRowMatching +import LeanPool.BeyondBethe.BeyondBethe.NearCase +import LeanPool.BeyondBethe.BeyondBethe.NumericalScales +import LeanPool.BeyondBethe.BeyondBethe.ExplicitScales +import LeanPool.BeyondBethe.BeyondBethe.ExecutableCertificate +import LeanPool.BeyondBethe.BeyondBethe.ExecutableTransfer +import LeanPool.BeyondBethe.BeyondBethe.DirectedCertificateValue +import LeanPool.BeyondBethe.BeyondBethe.NumericalNearby +import LeanPool.BeyondBethe.BeyondBethe.NumericalInterior +import LeanPool.BeyondBethe.BeyondBethe.NumericalCapacity +import LeanPool.BeyondBethe.BeyondBethe.NumericalTransfer +import LeanPool.BeyondBethe.BeyondBethe.NumericalPotentials +import LeanPool.BeyondBethe.BeyondBethe.NumericalAffine +import LeanPool.BeyondBethe.BeyondBethe.DirectedOptimizerOracle +import LeanPool.BeyondBethe.BeyondBethe.WeakSeparation +import LeanPool.BeyondBethe.BeyondBethe.ExecutableInterior +import LeanPool.BeyondBethe.BeyondBethe.RationalEllipsoid +import LeanPool.BeyondBethe.BeyondBethe.DyadicRounding +import LeanPool.BeyondBethe.BeyondBethe.DyadicMagnitudePrecision +import LeanPool.BeyondBethe.BeyondBethe.MatrixPerturbation +import LeanPool.BeyondBethe.BeyondBethe.RoundedEllipsoid +import LeanPool.BeyondBethe.BeyondBethe.RoundedEllipsoidScales +import LeanPool.BeyondBethe.BeyondBethe.AdaptiveRoundedEllipsoid +import LeanPool.BeyondBethe.BeyondBethe.RoundedEllipsoidBitBounds +import LeanPool.BeyondBethe.BeyondBethe.RoundedEllipsoidIterationBounds +import LeanPool.BeyondBethe.BeyondBethe.ScheduledRoundedEllipsoid +import LeanPool.BeyondBethe.BeyondBethe.ScheduledRoundedEllipsoidIteration +import LeanPool.BeyondBethe.BeyondBethe.ScheduledFeasibility +import LeanPool.BeyondBethe.BeyondBethe.RationalEncodingBounds +import LeanPool.BeyondBethe.BeyondBethe.BinaryLongDivision +import LeanPool.BeyondBethe.BeyondBethe.RawRational +import LeanPool.BeyondBethe.BeyondBethe.RawRationalBitBounds +import LeanPool.BeyondBethe.BeyondBethe.BinaryRationalComparison +import LeanPool.BeyondBethe.BeyondBethe.BinaryRationalFloor +import LeanPool.BeyondBethe.BeyondBethe.MachineEncoding +import LeanPool.BeyondBethe.BeyondBethe.MachineFPBasics +import LeanPool.BeyondBethe.BeyondBethe.MachineBool +import LeanPool.BeyondBethe.BeyondBethe.MachineBinaryAdd +import LeanPool.BeyondBethe.BeyondBethe.MachineBinaryAddSemantics +import LeanPool.BeyondBethe.BeyondBethe.MachineBinaryMul +import LeanPool.BeyondBethe.BeyondBethe.MachineBinarySub +import LeanPool.BeyondBethe.BeyondBethe.MachineBinaryCompare +import LeanPool.BeyondBethe.BeyondBethe.MachineOutputEncoding +import LeanPool.BeyondBethe.BeyondBethe.MachineBinaryDivision +import LeanPool.BeyondBethe.BeyondBethe.MachineBinaryGCD +import LeanPool.BeyondBethe.BeyondBethe.MachineIntegerSignedMagnitude +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalNormalization +import LeanPool.BeyondBethe.BeyondBethe.MachineIntegerArithmetic +import LeanPool.BeyondBethe.BeyondBethe.MachineIntegerCompare +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalArithmetic +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalUnary +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalPower +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalCompare +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalMin +import LeanPool.BeyondBethe.BeyondBethe.MachineFactorial +import LeanPool.BeyondBethe.BeyondBethe.MachineSmoothingDelta +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalRowAdd +import LeanPool.BeyondBethe.BeyondBethe.MachineMatrixAddDelta +import LeanPool.BeyondBethe.BeyondBethe.MachineSmoothedMatrix +import LeanPool.BeyondBethe.BeyondBethe.MachineCompletedAlgorithm +import LeanPool.BeyondBethe.BeyondBethe.MachinePositiveAlgorithm +import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerCertificateBoundary +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalVectorSum +import LeanPool.BeyondBethe.BeyondBethe.MachineCertificatePotentials +import LeanPool.BeyondBethe.BeyondBethe.MachineCertificateScales +import LeanPool.BeyondBethe.BeyondBethe.MachineScheduledLog +import LeanPool.BeyondBethe.BeyondBethe.MachineNearbyCoordinate +import LeanPool.BeyondBethe.BeyondBethe.MachineScheduledLogWidth +import LeanPool.BeyondBethe.BeyondBethe.MachineNearbyMatrixSum +import LeanPool.BeyondBethe.BeyondBethe.MachineRowComplementUpperSum +import LeanPool.BeyondBethe.BeyondBethe.MachineDirectedTransferCost +import LeanPool.BeyondBethe.BeyondBethe.MachineFourCoreCost +import LeanPool.BeyondBethe.BeyondBethe.MachineCertifiedPairEligibility +import LeanPool.BeyondBethe.BeyondBethe.MachineRowPairDisjoint +import LeanPool.BeyondBethe.BeyondBethe.MachineGreedyRowMatching +import LeanPool.BeyondBethe.BeyondBethe.MachineMatchingGain +import LeanPool.BeyondBethe.BeyondBethe.MachineCertificateAssembly +import LeanPool.BeyondBethe.BeyondBethe.CertificateMagnitude +import LeanPool.BeyondBethe.BeyondBethe.MachineCertificateExpGuard +import LeanPool.BeyondBethe.BeyondBethe.MachineExplicitCertificate +import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerEntryLength +import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerMatrixBitBound +import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerInteriorScale +import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerDerivedScales +import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerBisectionSchedule +import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerFeasibilitySchedule +import LeanPool.BeyondBethe.BeyondBethe.ExplicitScheduledFeasibility +import LeanPool.BeyondBethe.BeyondBethe.ExplicitBetheThresholdFeasibility +import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerRoundingSchedule +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalBallInit +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalVectorDot +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalVectorL1 +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalEllipsoidScalars +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalNormalizedDirection +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalVectorScale +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalVectorSub +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalEllipsoidCenterUpdate +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalDirectionUpdateRow +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalDirectionUpdateMatrix +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalEllipsoidUpdate +import LeanPool.BeyondBethe.BeyondBethe.MachineDyadicFloorVector +import LeanPool.BeyondBethe.BeyondBethe.MachineDyadicFloorMatrix +import LeanPool.BeyondBethe.BeyondBethe.MachineScheduledRoundedEllipsoid +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalMatrixMulVector +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalMatrixMul +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalMatrixColumn +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalTransposeMulVector +import LeanPool.BeyondBethe.BeyondBethe.MachineBetheAffineLineSum +import LeanPool.BeyondBethe.BeyondBethe.MachineBetheAffineEntry +import LeanPool.BeyondBethe.BeyondBethe.MachineBetheFloorTest +import LeanPool.BeyondBethe.BeyondBethe.MachineBetheFloorScan +import LeanPool.BeyondBethe.BeyondBethe.MachineBetheHeightCap +import LeanPool.BeyondBethe.BeyondBethe.BetheFloorCutFormula +import LeanPool.BeyondBethe.BeyondBethe.MachineBetheFloorCutEntry +import LeanPool.BeyondBethe.BeyondBethe.MachineDirectedNegativeObjectiveCoordinate +import LeanPool.BeyondBethe.BeyondBethe.MachineDirectedNegativeObjectiveSum +import LeanPool.BeyondBethe.BeyondBethe.MachineDirectedNegativeGradientCoordinate +import LeanPool.BeyondBethe.BeyondBethe.MachineDirectedNegativeGradientEntry +import LeanPool.BeyondBethe.BeyondBethe.MachineDirectedAffineGradientEntry +import LeanPool.BeyondBethe.BeyondBethe.MachineUnaryGridGenerator +import LeanPool.BeyondBethe.BeyondBethe.MachineDirectedAffineGradientVector +import LeanPool.BeyondBethe.BeyondBethe.MachineBinaryListSnoc +import LeanPool.BeyondBethe.BeyondBethe.MachineBinaryListInit +import LeanPool.BeyondBethe.BeyondBethe.MachineBetheFloorCutVector +import LeanPool.BeyondBethe.BeyondBethe.MachineBetheHeightNormal +import LeanPool.BeyondBethe.BeyondBethe.MachineDirectedEpigraphNormal +import LeanPool.BeyondBethe.BeyondBethe.MachineBetheEpigraphOracle +import LeanPool.BeyondBethe.BeyondBethe.ScannedBetheThresholdFeasibility +import LeanPool.BeyondBethe.BeyondBethe.MachineBetheFeasibilityLoop +import LeanPool.BeyondBethe.BeyondBethe.MachineBetheFeasibilitySemantics +import LeanPool.BeyondBethe.BeyondBethe.MachineScheduledStateEncodingBound +import LeanPool.BeyondBethe.BeyondBethe.MachineBetheFeasibilityFit +import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerStateBound +import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerFeasibilityCall +import LeanPool.BeyondBethe.BeyondBethe.ScannedBetheBisection +import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerBisectionLoop +import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerBisectionSemantics +import LeanPool.BeyondBethe.BeyondBethe.ExecutableScannedBetheOptimizer +import LeanPool.BeyondBethe.BeyondBethe.OptimizerOutputEncoding +import LeanPool.BeyondBethe.BeyondBethe.MachineUnaryMatrixGenerator +import LeanPool.BeyondBethe.BeyondBethe.MachineExecutableScannedOptimizerOutput +import LeanPool.BeyondBethe.BeyondBethe.ExecutablePositiveRoutine +import LeanPool.BeyondBethe.BeyondBethe.ExecutableCertificateMagnitude +import LeanPool.BeyondBethe.BeyondBethe.MachineExecutableCertificate +import LeanPool.BeyondBethe.BeyondBethe.MachineExecutablePositiveAlgorithm +import LeanPool.BeyondBethe.BeyondBethe.MachineDyadicFloor +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalFloor +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalLogSeries +import LeanPool.BeyondBethe.BeyondBethe.MachineBoundedUnary +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalExp +import LeanPool.BeyondBethe.BeyondBethe.MachineLengthBits +import LeanPool.BeyondBethe.BeyondBethe.MachineDirectedLog +import LeanPool.BeyondBethe.BeyondBethe.MachineMatrixNonnegative +import LeanPool.BeyondBethe.BeyondBethe.MachineSmallDimension +import LeanPool.BeyondBethe.BeyondBethe.MachineMatrixSum +import LeanPool.BeyondBethe.BeyondBethe.MachineMatrixDimension +import LeanPool.BeyondBethe.BeyondBethe.MachineListIndex +import LeanPool.BeyondBethe.BeyondBethe.MachineListUpdate +import LeanPool.BeyondBethe.BeyondBethe.MachineListReverse +import LeanPool.BeyondBethe.BeyondBethe.MachineBooleanMemory +import LeanPool.BeyondBethe.BeyondBethe.MachineBooleanInit +import LeanPool.BeyondBethe.BeyondBethe.MachineMateMemory +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalMatrixUpdate +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalRowDivide +import LeanPool.BeyondBethe.BeyondBethe.MachineMatrixNormalizeEntries +import LeanPool.BeyondBethe.BeyondBethe.MachineMatrixSupportProduct +import LeanPool.BeyondBethe.BeyondBethe.MachineKuhnEncoding +import LeanPool.BeyondBethe.BeyondBethe.MachineKuhnStep +import LeanPool.BeyondBethe.BeyondBethe.MachineKuhnSemantics +import LeanPool.BeyondBethe.BeyondBethe.MachineKuhnInvariant +import LeanPool.BeyondBethe.BeyondBethe.MachineKuhnRunner +import LeanPool.BeyondBethe.BeyondBethe.MachineMateAllSome +import LeanPool.BeyondBethe.BeyondBethe.MachinePerfectMatching +import LeanPool.BeyondBethe.BeyondBethe.MachineMatrixNormalization +import LeanPool.BeyondBethe.BeyondBethe.MachineFinalScalars +import LeanPool.BeyondBethe.BeyondBethe.MachineRAMBridge +import LeanPool.BeyondBethe.BeyondBethe.MachineBitAssembly +import LeanPool.BeyondBethe.BeyondBethe.MachineTrimHighZeros +import LeanPool.BeyondBethe.BeyondBethe.MachineRAMSmoke +import LeanPool.BeyondBethe.BeyondBethe.BinaryDirectedElementary +import LeanPool.BeyondBethe.BeyondBethe.RationalFeasibility +import LeanPool.BeyondBethe.BeyondBethe.RoundedFeasibility +import LeanPool.BeyondBethe.BeyondBethe.RoundedFeasibilityBitBounds +import LeanPool.BeyondBethe.BeyondBethe.RationalLinearOracle +import LeanPool.BeyondBethe.BeyondBethe.RationalEpigraphOracle +import LeanPool.BeyondBethe.BeyondBethe.BetheEpigraph +import LeanPool.BeyondBethe.BeyondBethe.BetheEpigraphFeasibility +import LeanPool.BeyondBethe.BeyondBethe.StrongEntropy +import LeanPool.BeyondBethe.BeyondBethe.ApproximateKKT +import LeanPool.BeyondBethe.BeyondBethe.BetheEpigraphGeometry +import LeanPool.BeyondBethe.BeyondBethe.BetheThresholdFeasibility +import LeanPool.BeyondBethe.BeyondBethe.BetheBisection +import LeanPool.BeyondBethe.BeyondBethe.ExplicitOptimizerScales +import LeanPool.BeyondBethe.BeyondBethe.ExplicitBetheOptimizer +import LeanPool.BeyondBethe.BeyondBethe.ExplicitPositiveRoutine +import LeanPool.BeyondBethe.BeyondBethe.NumericalWitness +import LeanPool.BeyondBethe.BeyondBethe.FinalAssembly +import LeanPool.BeyondBethe.BeyondBethe.Main + +/-! # Beyond Bethe -/ diff --git a/LeanPool/BeyondBethe/BeyondBethe/AdaptiveRoundedEllipsoid.lean b/LeanPool/BeyondBethe/BeyondBethe/AdaptiveRoundedEllipsoid.lean new file mode 100644 index 0000000000..12f43ccecd --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/AdaptiveRoundedEllipsoid.lean @@ -0,0 +1,583 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.RoundedEllipsoidScales +import Mathlib.Tactic + +/-! # Adaptive Rounded Ellipsoid -/ + +open scoped BigOperators + +namespace BeyondBethe + +/-! +# The proof-specification rounded ellipsoid update + +This file discharges the quantitative hypotheses of +`inflatedDyadicRound_contains` using the least precision selected from the +exact determinant. This update is a mathematical specification used to prove +the rounding estimates. The machine implementation must instead use an +a-priori precision schedule proved to dominate this selector; it must not +evaluate `Matrix.det` at run time. +-/ + +/-- Round one exact state at the proof-specification precision. -/ +def adaptiveRoundedEllipsoid {d : ℕ} (U : RationalEllipsoidState d) : + RationalEllipsoidState d := + inflatedDyadicRound (roundedEllipsoidPrecision U) + (roundedEllipsoidInflation d) U + +/-- Exact central cut followed by adaptive bounded-bit rounding. -/ +def adaptiveRoundedEllipsoidCentralUpdate {d : ℕ} + (E : RationalEllipsoidState d) (a : Fin d → ℚ) : + RationalEllipsoidState d := + adaptiveRoundedEllipsoid (rationalEllipsoidCentralUpdate E a) + +theorem rationalMatrixAbsBound_one_le {d : ℕ} + (A : Matrix (Fin d) (Fin d) ℚ) : + 1 ≤ rationalMatrixAbsBound A := by + rw [rationalMatrixAbsBound] + exact le_add_of_nonneg_right + (Finset.sum_nonneg fun i _ ↦ Finset.sum_nonneg fun j _ ↦ abs_nonneg _) + +theorem adaptiveRounded_entry_bound {d : ℕ} + (U : RationalEllipsoidState d) (i j : Fin d) : + abs (((dyadicFloorMatrix (roundedEllipsoidPrecision U) + U.basis i j : ℚ) : ℝ)) ≤ + (2 * rationalMatrixAbsBound U.basis : ℚ) := by + let M := rationalMatrixAbsBound U.basis + have hM1 : (1 : ℚ) ≤ M := rationalMatrixAbsBound_one_le U.basis + have hentry : abs (U.basis i j) < M := + abs_entry_lt_rationalMatrixAbsBound U.basis i j + have hround := abs_dyadicFloor_le (roundedEllipsoidPrecision U) (U.basis i j) + have hmesh := dyadicMesh_le_one (roundedEllipsoidPrecision U) + have hq : abs (dyadicFloor (roundedEllipsoidPrecision U) (U.basis i j)) ≤ + 2 * M := by + dsimp only [M] at hM1 hentry ⊢ + linarith + exact_mod_cast hq + +theorem adaptiveRounded_det_lower {d : ℕ} (hd : 0 < d) + (U : RationalEllipsoidState d) (hdet : Matrix.det U.basis ≠ 0) : + ((abs (Matrix.det U.basis) / 2 : ℚ) : ℝ) ≤ + abs (Matrix.det + (fun i j ↦ ((dyadicFloorMatrix (roundedEllipsoidPrecision U) + U.basis i j : ℚ) : ℝ))) := by + let Mq := rationalMatrixAbsBound U.basis + let p := roundedEllipsoidPrecision U + let Δq := abs (Matrix.det U.basis) + let A : Matrix (Fin d) (Fin d) ℝ := + fun i j ↦ ((dyadicFloorMatrix p U.basis i j : ℚ) : ℝ) + let B : Matrix (Fin d) (Fin d) ℝ := + fun i j ↦ ((U.basis i j : ℚ) : ℝ) + have hMq1 : (1 : ℚ) ≤ Mq := rationalMatrixAbsBound_one_le U.basis + have hMreal : (1 : ℝ) ≤ (Mq : ℝ) := by exact_mod_cast hMq1 + have hBentry : ∀ i j, abs (B i j) ≤ (Mq : ℝ) := by + intro i j + change abs (((U.basis i j : ℚ) : ℝ)) ≤ (Mq : ℝ) + exact_mod_cast (abs_entry_lt_rationalMatrixAbsBound U.basis i j).le + have hpert := abs_det_dyadicFloorMatrix_sub_det_le p U.basis hMreal + (by simpa only [B] using hBentry) + have hlossQ := adaptive_determinant_rounding_loss_lt hd U hdet + have hloss : + d.factorial * + (d * (dyadicMesh p : ℝ) * (2 * (Mq : ℝ)) ^ d) < + (Δq : ℝ) / (128 * (d : ℝ) ^ 3) := by + have hc : + ((roundedDeterminantCoefficient d Mq * + dyadicMesh p : ℚ) : ℝ) < + ((Δq / (128 * d ^ 3) : ℚ) : ℝ) := by + exact_mod_cast hlossQ + norm_num only [roundedDeterminantCoefficient, Rat.cast_mul, + Rat.cast_pow, Rat.cast_natCast, Rat.cast_div] at hc + convert hc using 1 <;> ring + have hsmallLoss : + d.factorial * + (d * (dyadicMesh p : ℝ) * (2 * (Mq : ℝ)) ^ d) < + (Δq : ℝ) / 2 := by + have hdR : (1 : ℝ) ≤ d := by exact_mod_cast hd + have hΔ : 0 < (Δq : ℝ) := by + exact_mod_cast (abs_pos.mpr hdet) + have hden : (2 : ℝ) ≤ 128 * (d : ℝ) ^ 3 := by + nlinarith [one_le_pow₀ (n := 3) hdR] + have hfrac : (Δq : ℝ) / (128 * (d : ℝ) ^ 3) ≤ (Δq : ℝ) / 2 := + div_le_div_of_nonneg_left hΔ.le (by norm_num) hden + exact hloss.trans_le hfrac + have htriangle : abs (Matrix.det B) ≤ + abs (Matrix.det A - Matrix.det B) + abs (Matrix.det A) := by + calc + abs (Matrix.det B) = + abs ((Matrix.det B - Matrix.det A) + Matrix.det A) := by ring_nf + _ ≤ abs (Matrix.det B - Matrix.det A) + abs (Matrix.det A) := + abs_add_le _ _ + _ = abs (Matrix.det A - Matrix.det B) + abs (Matrix.det A) := by + rw [show Matrix.det B - Matrix.det A = + -(Matrix.det A - Matrix.det B) by ring, abs_neg] + have hcastB : Matrix.det B = ((Matrix.det U.basis : ℚ) : ℝ) := by + rw [show B = U.basis.map (fun q : ℚ ↦ (q : ℝ)) by rfl, Rat.cast_det] + have hpert' : abs (Matrix.det A - Matrix.det B) ≤ + d.factorial * + (d * (dyadicMesh p : ℝ) * (2 * (Mq : ℝ)) ^ d) := by + simpa only [A, B] using hpert + rw [hcastB] at htriangle hpert' + have hΔcast : abs (((Matrix.det U.basis : ℚ) : ℝ)) = (Δq : ℝ) := by + exact_mod_cast (show abs (Matrix.det U.basis) = Δq by rfl) + rw [hΔcast] at htriangle + have hresult : (Δq : ℝ) / 2 ≤ abs (Matrix.det A) := by linarith + simpa only [A, p, Δq, Rat.cast_div, Rat.cast_ofNat] using hresult + +theorem adaptiveRounded_contains {d : ℕ} (hd : 0 < d) + (U : RationalEllipsoidState d) (hdet : Matrix.det U.basis ≠ 0) + {y : Fin d → ℝ} (hy : finiteNormSq y ≤ 1) : + ∃ y' : Fin d → ℝ, finiteNormSq y' ≤ 1 ∧ + rationalEllipsoidPoint (adaptiveRoundedEllipsoid U) y' = + rationalEllipsoidPoint U y := by + let Mq := rationalMatrixAbsBound U.basis + let Mr : ℝ := 2 * (Mq : ℝ) + let Δq := abs (Matrix.det U.basis) + let D : ℝ := ((Δq / 2 : ℚ) : ℝ) + let η := roundedEllipsoidInflation d + let p := roundedEllipsoidPrecision U + have hMq : 0 < Mq := rationalMatrixAbsBound_pos U.basis + have hMr : (1 : ℝ) ≤ Mr := by + dsimp only [Mr] + have hMq1 := rationalMatrixAbsBound_one_le U.basis + exact_mod_cast (show (1 : ℚ) ≤ 2 * Mq by linarith) + have hD : 0 < D := by + dsimp only [D, Δq] + exact_mod_cast (div_pos (abs_pos.mpr hdet) (by norm_num : (0 : ℚ) < 2)) + have hη : 0 ≤ η := roundedEllipsoidInflation_nonneg d + have hentries : ∀ i j, + abs (((dyadicFloorMatrix p U.basis i j : ℚ) : ℝ)) ≤ Mr := by + intro i j + simpa only [p, Mr, Rat.cast_mul, Rat.cast_ofNat] using + adaptiveRounded_entry_bound U i j + have hdetLower : D ≤ abs (Matrix.det + (fun i j ↦ ((dyadicFloorMatrix p U.basis i j : ℚ) : ℝ))) := by + simpa only [D, Δq, p] using adaptiveRounded_det_lower hd U hdet + have hinverseQ := adaptive_inverse_rounding_loss_lt hd U hdet + have hinverse : + (roundedInverseCoefficient d Mq : ℝ) * (dyadicMesh p : ℝ) < + (η : ℝ) * (Δq : ℝ) / (2 * (d : ℝ)) := by + exact_mod_cast hinverseQ + let V : ℝ := + (d * (d.factorial * Mr ^ d) * + (((d + 1 : ℕ) : ℝ) * (dyadicMesh p : ℝ))) / D + have hVform : V = + ((roundedInverseCoefficient d Mq : ℚ) : ℝ) * + (dyadicMesh p : ℝ) / D := by + have hCcast : ((roundedInverseCoefficient d Mq : ℚ) : ℝ) = + (d : ℝ) * (d.factorial * (2 * (Mq : ℝ)) ^ d) * (d + 1) := by + simp [roundedInverseCoefficient] + rw [hCcast] + dsimp only [V, Mr] + norm_num only [Nat.cast_add, Nat.cast_one] + ring + have hV0 : 0 ≤ V := by + have hMr0 : 0 ≤ Mr := by linarith [hMr] + have hMrpow : 0 ≤ Mr ^ d := pow_nonneg hMr0 _ + have hmesh0 : 0 ≤ (dyadicMesh p : ℝ) := by + exact_mod_cast dyadicMesh_nonneg p + dsimp only [V] + exact div_nonneg + (mul_nonneg + (mul_nonneg (by positivity) + (mul_nonneg (by positivity) hMrpow)) + (mul_nonneg (by positivity) hmesh0)) hD.le + have hV : V ≤ (η : ℝ) / d := by + rw [hVform] + have hΔ : 0 < (Δq : ℝ) := by + exact_mod_cast (abs_pos.mpr hdet) + have hdR : (0 : ℝ) < d := by exact_mod_cast hd + have hDform : D = (Δq : ℝ) / 2 := by + dsimp only [D] + norm_num + rw [hDform] + have hposDen : 0 < (Δq : ℝ) / 2 := div_pos hΔ (by norm_num) + rw [div_le_iff₀ hposDen] + have hηR : 0 ≤ (η : ℝ) := by exact_mod_cast hη + calc + ((roundedInverseCoefficient d Mq : ℚ) : ℝ) * + (dyadicMesh p : ℝ) ≤ + (η : ℝ) * (Δq : ℝ) / (2 * (d : ℝ)) := hinverse.le + _ = ((η : ℝ) / d) * ((Δq : ℝ) / 2) := by ring + have hsmall : + d * V ^ 2 ≤ (η : ℝ) ^ 2 := by + have hdR : (1 : ℝ) ≤ d := by exact_mod_cast hd + have hηR : 0 ≤ (η : ℝ) := by exact_mod_cast hη + have hdiv0 : 0 ≤ (η : ℝ) / d := div_nonneg hηR (by positivity) + have hsq : V ^ 2 ≤ ((η : ℝ) / d) ^ 2 := + (sq_le_sq₀ hV0 hdiv0).2 hV + have hdpos : (0 : ℝ) < d := by positivity + calc + (d : ℝ) * V ^ 2 ≤ d * ((η : ℝ) / d) ^ 2 := + mul_le_mul_of_nonneg_left hsq hdpos.le + _ = (η : ℝ) ^ 2 / d := by field_simp + _ ≤ (η : ℝ) ^ 2 := + (div_le_self (sq_nonneg (η : ℝ)) hdR) + have hsmall' : + d * + ((d * (d.factorial * Mr ^ d) * + ((d + 1 : ℕ) * (dyadicMesh p : ℝ))) / D) ^ 2 ≤ + (η : ℝ) ^ 2 := by simpa only [V] using hsmall + simpa only [adaptiveRoundedEllipsoid, p, η] using + inflatedDyadicRound_contains hd p η U hη hD hMr hentries + hdetLower hsmall' hy + +theorem det_adaptiveRoundedEllipsoid_ne_zero {d : ℕ} (hd : 0 < d) + (U : RationalEllipsoidState d) (hdet : Matrix.det U.basis ≠ 0) : + Matrix.det (adaptiveRoundedEllipsoid U).basis ≠ 0 := by + let p := roundedEllipsoidPrecision U + have hround : Matrix.det (dyadicFloorMatrix p U.basis) ≠ 0 := by + intro hz + have hlower := adaptiveRounded_det_lower hd U hdet + have hzeroReal : Matrix.det + (fun i j ↦ ((dyadicFloorMatrix p U.basis i j : ℚ) : ℝ)) = 0 := by + rw [show (fun i j ↦ ((dyadicFloorMatrix p U.basis i j : ℚ) : ℝ)) = + (dyadicFloorMatrix p U.basis).map (fun q : ℚ ↦ (q : ℝ)) by rfl, + ← Rat.cast_det, hz] + simp + rw [hzeroReal] at hlower + have hpos : (0 : ℝ) < ((abs (Matrix.det U.basis) / 2 : ℚ) : ℝ) := by + exact_mod_cast div_pos (abs_pos.mpr hdet) (by norm_num : (0 : ℚ) < 2) + linarith + rw [adaptiveRoundedEllipsoid, det_inflatedDyadicRound_basis] + exact mul_ne_zero + (pow_ne_zero _ (by + have hη := roundedEllipsoidInflation_pos hd + linarith)) hround + +theorem det_adaptiveRoundedEllipsoidCentralUpdate_ne_zero {d : ℕ} + (hd : 0 < d) (E : RationalEllipsoidState d) (a : Fin d → ℚ) + (hdet : Matrix.det E.basis ≠ 0) + (hb : rationalPulledBackNormal E a ≠ 0) : + Matrix.det (adaptiveRoundedEllipsoidCentralUpdate E a).basis ≠ 0 := by + let U := rationalEllipsoidCentralUpdate E a + have hdetU : Matrix.det U.basis ≠ 0 := by + dsimp only [U] + rw [det_rationalEllipsoidCentralUpdate hd E a hb] + exact mul_ne_zero hdet (mul_ne_zero + (pow_ne_zero _ (rationalEllipsoidPerpScale_pos d).ne') + (rationalEllipsoidParallelScale_pos hd).ne') + exact det_adaptiveRoundedEllipsoid_ne_zero hd U hdetU + +/-- The adaptive central-cut update preserves every point surviving the cut, +with no residual numerical hypothesis. -/ +theorem adaptiveRoundedEllipsoidCentralUpdate_contains {d : ℕ} + (hd : 0 < d) (E : RationalEllipsoidState d) (a : Fin d → ℚ) + (hdet : Matrix.det E.basis ≠ 0) + (hb : rationalPulledBackNormal E a ≠ 0) + {y : Fin d → ℝ} (hy : finiteNormSq y ≤ 1) + (hcut : finiteDot + (fun i ↦ (rationalPulledBackNormal E a i : ℝ)) y ≤ 0) : + ∃ y' : Fin d → ℝ, finiteNormSq y' ≤ 1 ∧ + rationalEllipsoidPoint + (adaptiveRoundedEllipsoidCentralUpdate E a) y' = + rationalEllipsoidPoint E y := by + let U := rationalEllipsoidCentralUpdate E a + have hdetU : Matrix.det U.basis ≠ 0 := by + dsimp only [U] + rw [det_rationalEllipsoidCentralUpdate hd E a hb] + exact mul_ne_zero hdet (mul_ne_zero + (pow_ne_zero _ (rationalEllipsoidPerpScale_pos d).ne') + (rationalEllipsoidParallelScale_pos hd).ne') + obtain ⟨z, hz, hpoint⟩ := + rationalEllipsoidCentralUpdate_contains hd E a hb hy hcut + obtain ⟨z', hz', hround⟩ := adaptiveRounded_contains hd U hdetU hz + refine ⟨z', hz', ?_⟩ + rw [adaptiveRoundedEllipsoidCentralUpdate, hround, hpoint] + +/-- The determinant cost of the explicit inflation is tiny compared with a +central-cut contraction. -/ +theorem roundedEllipsoidInflation_pow_bound {d : ℕ} (hd : 0 < d) : + (1 + (roundedEllipsoidInflation d : ℝ)) ^ d ≤ + 1 + 1 / (512 * (d : ℝ) ^ 3) := by + let η : ℝ := (roundedEllipsoidInflation d : ℝ) + let t : ℝ := d * η + have hη : 0 < η := by + dsimp only [η] + exact_mod_cast roundedEllipsoidInflation_pos hd + have htform : t = 1 / (1024 * (d : ℝ) ^ 3) := by + dsimp only [t, η, roundedEllipsoidInflation] + push_cast + field_simp [Nat.ne_of_gt hd] + have ht0 : 0 ≤ t := mul_nonneg (by positivity) hη.le + have hdR : (1 : ℝ) ≤ d := by exact_mod_cast hd + have ht1 : t ≤ 1 := by + rw [htform] + have hden : (1 : ℝ) ≤ 1024 * (d : ℝ) ^ 3 := by + nlinarith [one_le_pow₀ (n := 3) hdR] + exact (div_le_one (by positivity : (0 : ℝ) < 1024 * (d : ℝ) ^ 3)).2 hden + have hbase : 1 + η ≤ Real.exp η := by + simpa [add_comm] using Real.add_one_le_exp η + have hpow : (1 + η) ^ d ≤ (Real.exp η) ^ d := + pow_le_pow_left₀ (by positivity) hbase d + have hexpEq : (Real.exp η) ^ d = Real.exp t := by + rw [← Real.exp_nat_mul] + have hrem := Real.abs_exp_sub_one_sub_id_le + (x := t) (by rw [abs_of_nonneg ht0]; exact ht1) + have hexpUpper : Real.exp t ≤ 1 + t + t ^ 2 := by + have hle := le_trans (le_abs_self (Real.exp t - 1 - t)) hrem + linarith + have htSq : t ^ 2 ≤ t := by nlinarith + calc + (1 + (roundedEllipsoidInflation d : ℝ)) ^ d = (1 + η) ^ d := rfl + _ ≤ (Real.exp η) ^ d := hpow + _ = Real.exp t := hexpEq + _ ≤ 1 + t + t ^ 2 := hexpUpper + _ ≤ 1 + 2 * t := by linarith + _ = 1 + 1 / (512 * (d : ℝ) ^ 3) := by + rw [htform] + ring + +theorem roundedContraction_arithmetic {d : ℕ} (hd : 0 < d) : + (1 + 1 / (512 * (d : ℝ) ^ 3)) * + (1 - 7 / (128 * (d : ℝ) ^ 3)) ≤ + 1 - 1 / (32 * (d : ℝ) ^ 3) := by + let u : ℝ := 1 / (d : ℝ) ^ 3 + have hu0 : 0 ≤ u := by dsimp only [u]; positivity + have hdR : (1 : ℝ) ≤ d := by exact_mod_cast hd + have hu1 : u ≤ 1 := by + dsimp only [u] + exact (div_le_one (by positivity : (0 : ℝ) < (d : ℝ) ^ 3)).2 + (one_le_pow₀ (n := 3) hdR) + have hrewrite : + (1 + 1 / (512 * (d : ℝ) ^ 3)) * + (1 - 7 / (128 * (d : ℝ) ^ 3)) = + (1 + u / 512) * (1 - 7 * u / 128) := by + dsimp only [u] + ring + have htarget : + 1 - 1 / (32 * (d : ℝ) ^ 3) = 1 - u / 32 := by + dsimp only [u] + ring + rw [hrewrite, htarget] + nlinarith [sq_nonneg u] + +/-- Every adaptive rounded central cut still contracts the stored determinant +by an explicit inverse-polynomial factor. -/ +theorem abs_det_adaptiveRoundedCentralUpdate_le {d : ℕ} (hd : 0 < d) + (E : RationalEllipsoidState d) (a : Fin d → ℚ) + (hdet : Matrix.det E.basis ≠ 0) + (hb : rationalPulledBackNormal E a ≠ 0) : + abs ((Matrix.det + (adaptiveRoundedEllipsoidCentralUpdate E a).basis : ℚ) : ℝ) ≤ + (1 - 1 / (32 * (d : ℝ) ^ 3)) * + abs ((Matrix.det E.basis : ℚ) : ℝ) := by + let U := rationalEllipsoidCentralUpdate E a + let Mq := rationalMatrixAbsBound U.basis + let p := roundedEllipsoidPrecision U + let η := roundedEllipsoidInflation d + let L : ℝ := d.factorial * + (d * (dyadicMesh p : ℝ) * (2 * (Mq : ℝ)) ^ d) + let ΔE : ℝ := abs ((Matrix.det E.basis : ℚ) : ℝ) + let ΔU : ℝ := abs ((Matrix.det U.basis : ℚ) : ℝ) + let q : ℝ := + (rationalEllipsoidPerpScale d : ℝ) ^ (d - 1) * + (rationalEllipsoidParallelScale d : ℝ) + have hdetU : Matrix.det U.basis ≠ 0 := by + dsimp only [U] + rw [det_rationalEllipsoidCentralUpdate hd E a hb] + exact mul_ne_zero hdet (mul_ne_zero + (pow_ne_zero _ (rationalEllipsoidPerpScale_pos d).ne') + (rationalEllipsoidParallelScale_pos hd).ne') + have hΔE0 : 0 ≤ ΔE := abs_nonneg _ + have hΔU0 : 0 ≤ ΔU := abs_nonneg _ + have hq0 : 0 ≤ q := by + dsimp only [q] + exact mul_nonneg + (pow_nonneg (Rat.cast_nonneg.mpr + (rationalEllipsoidPerpScale_pos d).le) _) + (Rat.cast_nonneg.mpr (rationalEllipsoidParallelScale_pos hd).le) + have hq1 : q ≤ 1 := + (rationalEllipsoid_volumeFactor_lt_one hd).le + have hqContract : q ≤ 1 - 1 / (16 * (d : ℝ) ^ 3) := + rationalEllipsoid_volumeFactor_le_one_sub hd + have hΔeq : ΔU = ΔE * q := by + have hdetEq := det_rationalEllipsoidCentralUpdate hd E a hb + dsimp only [U, ΔU, ΔE, q] + rw [hdetEq, Rat.cast_mul, abs_mul] + norm_num only [Rat.cast_mul, Rat.cast_pow, Rat.cast_sub, + Rat.cast_div, Rat.cast_one, Rat.cast_natCast] + rw [abs_of_nonneg hq0] + have hΔUle : ΔU ≤ ΔE := by + rw [hΔeq] + simpa only [mul_one] using mul_le_mul_of_nonneg_left hq1 hΔE0 + have hMq1 : (1 : ℝ) ≤ (Mq : ℝ) := by + exact_mod_cast rationalMatrixAbsBound_one_le U.basis + have hUentry : ∀ i j, abs ((U.basis i j : ℚ) : ℝ) ≤ (Mq : ℝ) := by + intro i j + exact_mod_cast (abs_entry_lt_rationalMatrixAbsBound U.basis i j).le + have hupper0 := abs_det_inflatedDyadicRound_le p η U + (roundedEllipsoidInflation_nonneg d) hMq1 hUentry + have hupper : + abs ((Matrix.det + (adaptiveRoundedEllipsoidCentralUpdate E a).basis : ℚ) : ℝ) ≤ + (1 + (η : ℝ)) ^ d * (ΔU + L) := by + simpa only [adaptiveRoundedEllipsoidCentralUpdate, + adaptiveRoundedEllipsoid, U, p, η, ΔU, L] using hupper0 + have hlossQ := adaptive_determinant_rounding_loss_lt hd U hdetU + have hloss : L < ΔU / (128 * (d : ℝ) ^ 3) := by + have hc : + ((roundedDeterminantCoefficient d Mq * dyadicMesh p : ℚ) : ℝ) < + ((abs (Matrix.det U.basis) / (128 * d ^ 3) : ℚ) : ℝ) := by + exact_mod_cast hlossQ + norm_num only [roundedDeterminantCoefficient, Rat.cast_mul, + Rat.cast_pow, Rat.cast_natCast, Rat.cast_div] at hc + have hc' : L < + ((abs (Matrix.det U.basis) : ℚ) : ℝ) / + (128 * (d : ℝ) ^ 3) := by + dsimp only [L] + simpa [mul_assoc, mul_left_comm, mul_comm] using hc + have habsCast : ((abs (Matrix.det U.basis) : ℚ) : ℝ) = ΔU := by + dsimp only [ΔU] + exact_mod_cast (show abs (Matrix.det U.basis) = + abs (Matrix.det U.basis) by rfl) + rw [habsCast] at hc' + exact hc' + have hlossE : L ≤ ΔE / (128 * (d : ℝ) ^ 3) := by + have hden : 0 < (128 : ℝ) * (d : ℝ) ^ 3 := by positivity + exact hloss.le.trans + (div_le_div_of_nonneg_right hΔUle hden.le) + have hbracket : ΔU + L ≤ + ΔE * (1 - 7 / (128 * (d : ℝ) ^ 3)) := by + rw [hΔeq] + have hq' : q ≤ 1 - 8 / (128 * (d : ℝ) ^ 3) := by + convert hqContract using 1 <;> ring + have hqmul := mul_le_mul_of_nonneg_left hq' hΔE0 + calc + ΔE * q + L ≤ + ΔE * (1 - 8 / (128 * (d : ℝ) ^ 3)) + + ΔE / (128 * (d : ℝ) ^ 3) := add_le_add hqmul hlossE + _ = ΔE * (1 - 7 / (128 * (d : ℝ) ^ 3)) := by ring + have hfactor0 : 0 ≤ 1 - 7 / (128 * (d : ℝ) ^ 3) := by + have hdR : (1 : ℝ) ≤ d := by exact_mod_cast hd + have hden : (7 : ℝ) ≤ 128 * (d : ℝ) ^ 3 := by + nlinarith [one_le_pow₀ (n := 3) hdR] + exact sub_nonneg.mpr + ((div_le_one (by positivity : (0 : ℝ) < 128 * (d : ℝ) ^ 3)).2 hden) + have hscale := roundedEllipsoidInflation_pow_bound hd + have hscale0 : 0 ≤ (1 + (η : ℝ)) ^ d := by + exact pow_nonneg (by + have hη0 : (0 : ℝ) ≤ (η : ℝ) := by + exact_mod_cast roundedEllipsoidInflation_nonneg d + linarith) _ + calc + abs ((Matrix.det + (adaptiveRoundedEllipsoidCentralUpdate E a).basis : ℚ) : ℝ) ≤ + (1 + (η : ℝ)) ^ d * (ΔU + L) := hupper + _ ≤ (1 + (η : ℝ)) ^ d * + (ΔE * (1 - 7 / (128 * (d : ℝ) ^ 3))) := + mul_le_mul_of_nonneg_left hbracket hscale0 + _ ≤ (1 + 1 / (512 * (d : ℝ) ^ 3)) * + (ΔE * (1 - 7 / (128 * (d : ℝ) ^ 3))) := by + exact mul_le_mul_of_nonneg_right hscale + (mul_nonneg hΔE0 hfactor0) + _ = ΔE * ((1 + 1 / (512 * (d : ℝ) ^ 3)) * + (1 - 7 / (128 * (d : ℝ) ^ 3))) := by ring + _ ≤ ΔE * (1 - 1 / (32 * (d : ℝ) ^ 3)) := + mul_le_mul_of_nonneg_left (roundedContraction_arithmetic hd) hΔE0 + _ = (1 - 1 / (32 * (d : ℝ) ^ 3)) * + abs ((Matrix.det E.basis : ℚ) : ℝ) := by + simp only [ΔE] + ring + +/-- Rounding also retains a fixed fraction of the old determinant from +below. Hence the determinant magnitude can lose only two binary bits per +iteration, even on infeasible instances. -/ +theorem quarter_abs_det_le_adaptiveRoundedCentralUpdate {d : ℕ} + (hd : 0 < d) (E : RationalEllipsoidState d) (a : Fin d → ℚ) + (hdet : Matrix.det E.basis ≠ 0) + (hb : rationalPulledBackNormal E a ≠ 0) : + (1 / 4 : ℝ) * abs ((Matrix.det E.basis : ℚ) : ℝ) ≤ + abs ((Matrix.det + (adaptiveRoundedEllipsoidCentralUpdate E a).basis : ℚ) : ℝ) := by + let U := rationalEllipsoidCentralUpdate E a + let p := roundedEllipsoidPrecision U + let η := roundedEllipsoidInflation d + let ΔE : ℝ := abs ((Matrix.det E.basis : ℚ) : ℝ) + let ΔU : ℝ := abs ((Matrix.det U.basis : ℚ) : ℝ) + let q : ℝ := + (rationalEllipsoidPerpScale d : ℝ) ^ (d - 1) * + (rationalEllipsoidParallelScale d : ℝ) + have hdetU : Matrix.det U.basis ≠ 0 := by + dsimp only [U] + rw [det_rationalEllipsoidCentralUpdate hd E a hb] + exact mul_ne_zero hdet (mul_ne_zero + (pow_ne_zero _ (rationalEllipsoidPerpScale_pos d).ne') + (rationalEllipsoidParallelScale_pos hd).ne') + have hq0 : 0 ≤ q := by + dsimp only [q] + exact mul_nonneg + (pow_nonneg (Rat.cast_nonneg.mpr + (rationalEllipsoidPerpScale_pos d).le) _) + (Rat.cast_nonneg.mpr (rationalEllipsoidParallelScale_pos hd).le) + have hΔeq : ΔU = ΔE * q := by + have hdetEq := det_rationalEllipsoidCentralUpdate hd E a hb + dsimp only [U, ΔU, ΔE, q] + rw [hdetEq, Rat.cast_mul, abs_mul] + norm_num only [Rat.cast_mul, Rat.cast_pow, Rat.cast_sub, + Rat.cast_div, Rat.cast_one, Rat.cast_natCast] + rw [abs_of_nonneg hq0] + have hqLower : (1 / 2 : ℝ) ≤ q := by + simpa only [q] using rationalEllipsoid_volumeFactor_ge_half hd + have hΔlower : (1 / 2 : ℝ) * ΔE ≤ ΔU := by + rw [hΔeq] + have hh : (1 / 2 : ℝ) * ΔE ≤ q * ΔE := + mul_le_mul_of_nonneg_right hqLower (by + dsimp only [ΔE] + exact abs_nonneg _) + simpa only [mul_comm] using hh + have hround0 := adaptiveRounded_det_lower hd U hdetU + have hround : ΔU / 2 ≤ + abs (((Matrix.det (dyadicFloorMatrix p U.basis) : ℚ) : ℝ)) := by + have hcastDet : Matrix.det + (fun i j ↦ ((dyadicFloorMatrix p U.basis i j : ℚ) : ℝ)) = + ((Matrix.det (dyadicFloorMatrix p U.basis) : ℚ) : ℝ) := by + rw [show (fun i j ↦ + ((dyadicFloorMatrix p U.basis i j : ℚ) : ℝ)) = + (dyadicFloorMatrix p U.basis).map (fun q : ℚ ↦ (q : ℝ)) by rfl, + Rat.cast_det] + have habsCast : + (((abs (Matrix.det U.basis) : ℚ) : ℚ) : ℝ) = + abs (((Matrix.det U.basis : ℚ) : ℝ)) := by + exact_mod_cast (show abs (Matrix.det U.basis) = + abs (Matrix.det U.basis) by rfl) + norm_num only [Rat.cast_div, Rat.cast_ofNat] at hround0 + rw [hcastDet] at hround0 + simpa only [p, ΔU, habsCast] using hround0 + have hscale : (1 : ℝ) ≤ (1 + (η : ℝ)) ^ d := by + apply one_le_pow₀ + have hη0 : (0 : ℝ) ≤ (η : ℝ) := by + dsimp only [η] + exact_mod_cast roundedEllipsoidInflation_nonneg d + linarith + have hstored : + abs (((Matrix.det (dyadicFloorMatrix p U.basis) : ℚ) : ℝ)) ≤ + abs ((Matrix.det + (adaptiveRoundedEllipsoidCentralUpdate E a).basis : ℚ) : ℝ) := by + rw [adaptiveRoundedEllipsoidCentralUpdate, adaptiveRoundedEllipsoid, + det_inflatedDyadicRound_basis, Rat.cast_mul, abs_mul] + change abs (((1 + η) ^ d : ℚ) : ℝ) * + abs (((Matrix.det (dyadicFloorMatrix p U.basis) : ℚ) : ℝ)) ≥ _ + have hscaleAbs : (1 : ℝ) ≤ abs (((1 + η) ^ d : ℚ) : ℝ) := by + rw [Rat.cast_pow, Rat.cast_add, Rat.cast_one, + abs_of_nonneg (pow_nonneg (by + have hη0 : (0 : ℝ) ≤ (η : ℝ) := by + dsimp only [η] + exact_mod_cast roundedEllipsoidInflation_nonneg d + linarith) d)] + exact hscale + simpa only [one_mul] using mul_le_mul_of_nonneg_right hscaleAbs + (abs_nonneg (((Matrix.det (dyadicFloorMatrix p U.basis) : ℚ) : ℝ))) + calc + (1 / 4 : ℝ) * ΔE = ((1 / 2 : ℝ) * ΔE) / 2 := by ring + _ ≤ ΔU / 2 := div_le_div_of_nonneg_right hΔlower (by norm_num) + _ ≤ abs (((Matrix.det (dyadicFloorMatrix p U.basis) : ℚ) : ℝ)) := hround + _ ≤ abs ((Matrix.det + (adaptiveRoundedEllipsoidCentralUpdate E a).basis : ℚ) : ℝ) := hstored + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/AlgorithmicSpec.lean b/LeanPool/BeyondBethe/BeyondBethe/AlgorithmicSpec.lean new file mode 100644 index 0000000000..fadbd1681d --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/AlgorithmicSpec.lean @@ -0,0 +1,516 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.Completion +import LeanPool.BeyondBethe.Complexitylib.Classes.P +import LeanPool.BeyondBethe.Complexitylib.Encoding.DataEncode +import LeanPool.BeyondBethe.Complexitylib.Encoding.Pairing +import Mathlib.Data.List.OfFn +import Mathlib.Data.Nat.Pairing + +/-! # Algorithmic Spec -/ + +namespace BeyondBethe + +open Complexity + +/-- A square rational matrix together with its dimension. Bundling the +dimension turns the family of inputs in Theorem 1 into one machine input +type. -/ +abbrev RationalMatrixInput := Σ n : ℕ, Matrix (Fin n) (Fin n) ℚ + +/-- The signed-magnitude payload used for integers. The Boolean distinguishes +`ofNat` from `negSucc`, so this representation has no duplicate zero. -/ +def integerPayload : ℤ → Bool × ℕ + | .ofNat n => (false, n) + | .negSucc n => (true, n + 1) + +theorem integerPayload_injective : Function.Injective integerPayload := by + intro a b h + cases a <;> cases b <;> simp [integerPayload] at h ⊢ <;> omega + +/-- Explicit tree encoding of an integer: one sign bit and the binary natural +payload supplied by `DataEncode ℕ`. -/ +instance integerDataEncode : DataEncode ℤ where + encode z := DataEncode.encode (integerPayload z) + h_inj := DataEncode.h_inj.comp integerPayload_injective + +/-- A rational is represented by its canonical reduced numerator and positive +denominator. These are fields of Lean's `Rat`, rather than an arbitrary +fraction representing the same number. -/ +def rationalPayload (q : ℚ) : ℤ × ℕ := (q.num, q.den) + +theorem rationalPayload_injective : Function.Injective rationalPayload := by + intro p q h + exact Rat.ext (congrArg Prod.fst h) (congrArg Prod.snd h) + +instance rationalDataEncode : DataEncode ℚ where + encode q := DataEncode.encode (rationalPayload q) + h_inj := DataEncode.h_inj.comp rationalPayload_injective + +/-- Row-major list representation of a fixed-size matrix. -/ +def rationalMatrixRows {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) : List (List ℚ) := + List.ofFn fun i ↦ List.ofFn fun j ↦ A i j + +theorem rationalMatrixRows_injective {n : ℕ} : + Function.Injective (@rationalMatrixRows n) := by + intro A B hrows + change List.ofFn (fun i ↦ List.ofFn (A i)) = + List.ofFn (fun i ↦ List.ofFn (B i)) at hrows + have houter := List.ofFn_injective hrows + ext i j + have hinner := congrFun houter i + exact congrFun (List.ofFn_injective hinner) j + +/-- Dimension followed by exactly `n` rows of exactly `n` rational entries. -/ +def rationalMatrixInputPayload : RationalMatrixInput → ℕ × List (List ℚ) + | ⟨n, A⟩ => (n, rationalMatrixRows A) + +theorem rationalMatrixInputPayload_injective : + Function.Injective rationalMatrixInputPayload := by + intro x y h + obtain ⟨n, A⟩ := x + obtain ⟨m, B⟩ := y + have hnm : n = m := congrArg Prod.fst h + subst m + have hrows : rationalMatrixRows A = rationalMatrixRows B := + congrArg Prod.snd h + have hAB : A = B := rationalMatrixRows_injective hrows + subst B + rfl + +instance rationalMatrixInputDataEncode : DataEncode RationalMatrixInput where + encode x := DataEncode.encode (rationalMatrixInputPayload x) + h_inj := DataEncode.h_inj.comp rationalMatrixInputPayload_injective + +/-- An explicit injective binary code. We retain injectivity in the structure +so no later complexity statement can silently identify distinct typed inputs. -/ +structure OrdinaryBinaryEncoding (α : Type*) where + encode : α → List Bool + injective : Function.Injective encode + +/-- The least-significant-bit-first binary expansion is injective, including +the convention `Nat.bits 0 = []`. -/ +theorem natBits_injective : Function.Injective Nat.bits := by + intro a b h + have hrec : ∀ n : ℕ, + n.bits.foldr (fun bit acc => Nat.bit bit acc) 0 = n := by + intro n + induction n using Nat.binaryRec' with + | zero => simp + | bit bit n hn ih => + rw [Nat.bits_append_bit n bit hn] + simp [ih] + have := congrArg (List.foldr (fun bit acc => Nat.bit bit acc) 0) h + simpa [hrec] using this + +/-- Canonical signed binary code. `false` denotes `Int.ofNat`; `true` +denotes `Int.negSucc`. The payload is an ordinary binary natural. -/ +def integerBinaryCode (z : ℤ) : List Bool := + Int.casesOn z (fun n ↦ false :: n.bits) (fun n ↦ true :: n.bits) + +@[simp] theorem integerBinaryRec_ofNat (n : ℕ) : + Int.rec (fun k ↦ false :: k.bits) (fun k ↦ true :: k.bits) + (Int.ofNat n) = false :: n.bits := by + rfl + +@[simp] theorem integerBinaryRec_natCast (n : ℕ) : + Int.rec (fun k ↦ false :: k.bits) (fun k ↦ true :: k.bits) (n : ℤ) = + false :: n.bits := by + rfl + +@[simp] theorem integerBinaryRec_negSucc (n : ℕ) : + Int.rec (fun k ↦ false :: k.bits) (fun k ↦ true :: k.bits) + (Int.negSucc n) = true :: n.bits := by + rfl + +@[simp] theorem integerBinaryRec_zero : + Int.rec (fun n ↦ false :: n.bits) (fun n ↦ true :: n.bits) (0 : ℤ) = + [false] := by + rfl + +@[simp] theorem integerBinaryRec_one : + Int.rec (fun n ↦ false :: n.bits) (fun n ↦ true :: n.bits) (1 : ℤ) = + [false, true] := by + rfl + +@[simp] theorem integerBinaryCode_ofNat (n : ℕ) : + integerBinaryCode (Int.ofNat n) = false :: n.bits := by + rfl + +@[simp] theorem integerBinaryCode_negSucc (n : ℕ) : + integerBinaryCode (Int.negSucc n) = true :: n.bits := by + rfl + +theorem integerBinaryCode_injective : Function.Injective integerBinaryCode := by + intro a b h + cases a with + | ofNat a => + cases b with + | ofNat b => + simp only [integerBinaryCode, List.cons.injEq, true_and] at h + exact congrArg Int.ofNat (natBits_injective h) + | negSucc b => + simp [integerBinaryCode] at h + | negSucc a => + cases b with + | ofNat b => + simp [integerBinaryCode] at h + | negSucc b => + simp only [integerBinaryCode, List.cons.injEq, true_and] at h + exact congrArg Int.negSucc (natBits_injective h) + +/-- A natural-number code for integers. Even naturals encode nonnegative +integers, while odd naturals encode `Int.negSucc`. -/ +def integerNatCode (z : ℤ) : ℕ := + Int.casesOn z (fun n ↦ 2 * n) (fun n ↦ 2 * n + 1) + +@[simp] theorem integerNatRec_ofNat (n : ℕ) : + Int.rec (fun k ↦ 2 * k) (fun k ↦ 2 * k + 1) (Int.ofNat n) = + 2 * n := by + rfl + +@[simp] theorem integerNatRec_natCast (n : ℕ) : + Int.rec (fun k ↦ 2 * k) (fun k ↦ 2 * k + 1) (n : ℤ) = 2 * n := by + rfl + +@[simp] theorem integerNatRec_negSucc (n : ℕ) : + Int.rec (fun k ↦ 2 * k) (fun k ↦ 2 * k + 1) (Int.negSucc n) = + 2 * n + 1 := by + rfl + +@[simp] theorem integerNatRec_zero : + Int.rec (fun n ↦ 2 * n) (fun n ↦ 2 * n + 1) (0 : ℤ) = 0 := by + rfl + +@[simp] theorem integerNatCode_ofNat (n : ℕ) : + integerNatCode (Int.ofNat n) = 2 * n := by + rfl + +@[simp] theorem integerNatCode_negSucc (n : ℕ) : + integerNatCode (Int.negSucc n) = 2 * n + 1 := by + rfl + +theorem integerNatCode_injective : Function.Injective integerNatCode := by + intro a b h + cases a with + | ofNat a => + cases b with + | ofNat b => + simp only [integerNatCode] at h + exact congrArg Int.ofNat (by omega) + | negSucc b => + have hparity := congrArg (fun n : ℕ => n % 2) h + simp [integerNatCode] at hparity + | negSucc a => + cases b with + | ofNat b => + have hparity := congrArg (fun n : ℕ => n % 2) h + simp [integerNatCode] at hparity + | negSucc b => + simp only [integerNatCode] at h + exact congrArg Int.negSucc (by omega) + +/-- A matrix entry is stored as a self-delimiting pair, so a machine can +extract its numerator and denominator without first implementing arithmetic +unpairing. -/ +def rationalEntryBinaryCode (q : ℚ) : List Bool := + pair (integerBinaryCode q.num) q.den.bits + +theorem rationalEntryBinaryCode_injective : + Function.Injective rationalEntryBinaryCode := by + intro p q h + obtain ⟨hnum, hden⟩ := pair_inj h + exact Rat.ext (integerBinaryCode_injective hnum) (natBits_injective hden) + +/-- A rational output is represented by one natural number: Szudzik's +pairing of the canonical integer code of its numerator and its positive +denominator. -/ +def rationalNatCode (q : ℚ) : ℕ := + Nat.pair (integerNatCode q.num) q.den + +theorem rationalNatCode_injective : Function.Injective rationalNatCode := by + intro p q h + have hpayload : + integerNatCode p.num = integerNatCode q.num ∧ p.den = q.den := + Nat.pair_eq_pair.mp h + exact Rat.ext (integerNatCode_injective hpayload.1) hpayload.2 + +/-- Canonical rational output code. Using the ordinary binary expansion of +one natural makes every output bit accessible to the verified RAM decision +simulator. -/ +def rationalBinaryCode (q : ℚ) : List Bool := + (rationalNatCode q).bits + +theorem rationalBinaryCode_injective : Function.Injective rationalBinaryCode := by + exact natBits_injective.comp rationalNatCode_injective + +/-- Right-nested self-delimiting encoding of a finite list. The empty list +is empty, while a nonempty list starts with the nonempty `pair` code. -/ +def binaryListCode {α : Type*} (encode : α → List Bool) : + List α → List Bool + | [] => [] + | x :: xs => pair (encode x) (binaryListCode encode xs) + +theorem binaryListCode_injective {α : Type*} {encode : α → List Bool} + (hencode : Function.Injective encode) : + Function.Injective (binaryListCode encode) := by + intro xs + induction xs with + | nil => + intro ys h + cases ys with + | nil => rfl + | cons y ys => + have hlen := congrArg List.length h + simp [binaryListCode] at hlen + omega + | cons x xs ih => + intro ys h + cases ys with + | nil => + have hlen := congrArg List.length h + simp [binaryListCode] at hlen + | cons y ys => + simp only [binaryListCode] at h + obtain ⟨hxy, hxsys⟩ := pair_inj h + exact congrArg₂ List.cons (hencode hxy) (ih hxsys) + +/-- Machine-facing matrix code: binary dimension followed by the right-nested +row list, whose rows and rational entries use the same canonical pairing +scheme. -/ +def rationalMatrixBinaryCode (x : RationalMatrixInput) : List Bool := + pair x.1.bits + (binaryListCode (binaryListCode rationalEntryBinaryCode) + (rationalMatrixRows x.2)) + +theorem rationalMatrixBinaryCode_injective : + Function.Injective rationalMatrixBinaryCode := by + intro x y h + obtain ⟨n, A⟩ := x + obtain ⟨m, B⟩ := y + simp only [rationalMatrixBinaryCode] at h + obtain ⟨hnm, hrows⟩ := pair_inj h + have hnm' : n = m := natBits_injective hnm + subst m + have hrowCode : + Function.Injective (binaryListCode rationalEntryBinaryCode) := + binaryListCode_injective rationalEntryBinaryCode_injective + have hrows' : rationalMatrixRows A = rationalMatrixRows B := + binaryListCode_injective hrowCode hrows + have hAB : A = B := rationalMatrixRows_injective hrows' + subst B + rfl + +/-- Canonical machine-facing binary encoding of one rational. -/ +def rationalBinaryEncoding : OrdinaryBinaryEncoding ℚ where + encode := rationalBinaryCode + injective := rationalBinaryCode_injective + +/-- Canonical machine-facing binary encoding of the dimension and row-major +matrix entries. -/ +def rationalMatrixBinaryEncoding : OrdinaryBinaryEncoding RationalMatrixInput where + encode := rationalMatrixBinaryCode + injective := rationalMatrixBinaryCode_injective + +/-- Length of the canonical parenthesized binary encoding of typed data. -/ +def encodedBitLength (α : Type) [DataEncode α] (x : α) : ℕ := + (DataEncode.bitstringEncode x).length + +theorem encodedBitLength_eq_dataSize + {α : Type} [DataEncode α] (x : α) : + encodedBitLength α x = (DataEncode.encode x).size := by + simp [encodedBitLength, DataEncode.bitstringEncode_def] + +/-- The canonical natural encoding contains, in particular, every bit of the +ordinary binary expansion. -/ +theorem nat_size_le_encodedBitLength (n : ℕ) : + n.size ≤ encodedBitLength ℕ n := by + rw [encodedBitLength_eq_dataSize] + change n.size ≤ (Data.l (n.bits.map fun b ↦ DataEncode.encode b)).size + rw [← Nat.size_eq_bits_len] + induction n.bits with + | nil => simp + | cons b bs ih => + cases b <;> simp [DataEncode.encode, Data.size] at ih ⊢ <;> omega + +theorem nat_log_two_lt_encodedBitLength {n : ℕ} (hn : n ≠ 0) : + Nat.log 2 n < encodedBitLength ℕ n := by + exact (Nat.lt_size.mpr (Nat.pow_log_le_self 2 hn)).trans_le + (nat_size_le_encodedBitLength n) + +@[simp] theorem integerPayload_snd (z : ℤ) : + (integerPayload z).2 = z.natAbs := by + cases z <;> simp [integerPayload] + +theorem natAbs_encodedBitLength_lt_integer (z : ℤ) : + encodedBitLength ℕ z.natAbs < encodedBitLength ℤ z := by + rw [encodedBitLength_eq_dataSize, encodedBitLength_eq_dataSize] + change (DataEncode.encode z.natAbs).size < + (DataEncode.encode (integerPayload z)).size + rw [DataEncode_pair] + exact Data.size_lt_of_mem (by simp) + +theorem denominator_encodedBitLength_lt_rational (q : ℚ) : + encodedBitLength ℕ q.den < encodedBitLength ℚ q := by + rw [encodedBitLength_eq_dataSize, encodedBitLength_eq_dataSize] + change (DataEncode.encode q.den).size < + (DataEncode.encode (rationalPayload q)).size + rw [DataEncode_pair] + exact Data.size_lt_of_mem (by simp [rationalPayload]) + +theorem numerator_encodedBitLength_lt_rational (q : ℚ) : + encodedBitLength ℤ q.num < encodedBitLength ℚ q := by + rw [encodedBitLength_eq_dataSize, encodedBitLength_eq_dataSize] + change (DataEncode.encode q.num).size < + (DataEncode.encode (rationalPayload q)).size + rw [DataEncode_pair] + exact Data.size_lt_of_mem (by simp [rationalPayload]) + +theorem numerator_natAbs_log_lt_rationalBitLength (q : ℚ) + (hnum : q.num.natAbs ≠ 0) : + Nat.log 2 q.num.natAbs < encodedBitLength ℚ q := by + exact (nat_log_two_lt_encodedBitLength hnum).trans + ((natAbs_encodedBitLength_lt_integer q.num).trans + (numerator_encodedBitLength_lt_rational q)) + +theorem denominator_log_lt_rationalBitLength (q : ℚ) : + Nat.log 2 q.den < encodedBitLength ℚ q := by + exact (nat_log_two_lt_encodedBitLength q.den_nz).trans + (denominator_encodedBitLength_lt_rational q) + +/-- A positive rational is bounded below by a dyadic whose exponent is its +ordinary encoded length. This is the elementary bridge from binary input +size to the lower-entry parameter used by the numerical optimizer. -/ +theorem dyadic_encodedBitLength_lt_positive_rational + {q : ℚ} (hq : 0 < q) : + (1 / 2 : ℚ) ^ encodedBitLength ℚ q < q := by + let L := encodedBitLength ℚ q + have hdenlog : Nat.log 2 q.den < L := denominator_log_lt_rationalBitLength q + have hdenpow : q.den < 2 ^ L := Nat.lt_pow_of_log_lt (by norm_num) hdenlog + have hnum : 0 < q.num := Rat.num_pos.mpr hq + have hnum0 : q.num.natAbs ≠ 0 := Int.natAbs_ne_zero.mpr hnum.ne' + have hnum1 : 1 ≤ q.num.natAbs := Nat.one_le_iff_ne_zero.mpr hnum0 + have hnumabs : (q.num.natAbs : ℤ) = q.num := + Int.natAbs_of_nonneg hnum.le + have hqrep : q = (q.num.natAbs : ℚ) / (q.den : ℚ) := by + calc + q = (q.num : ℚ) / (q.den : ℚ) := (Rat.num_div_den q).symm + _ = (q.num.natAbs : ℚ) / (q.den : ℚ) := by + congr 1 + change (q.num : ℚ) = ((q.num.natAbs : ℤ) : ℚ) + rw [hnumabs] + have hdenpowQ : (q.den : ℚ) < (2 : ℚ) ^ L := by exact_mod_cast hdenpow + have hrecip : 1 / (2 : ℚ) ^ L < 1 / (q.den : ℚ) := by + exact one_div_lt_one_div_of_lt (by positivity) hdenpowQ + calc + (1 / 2 : ℚ) ^ L = 1 / (2 : ℚ) ^ L := by + simp only [one_div, inv_pow] + _ < 1 / (q.den : ℚ) := hrecip + _ ≤ (q.num.natAbs : ℚ) / (q.den : ℚ) := by + have hnum1Q : (1 : ℚ) ≤ (q.num.natAbs : ℚ) := by + exact_mod_cast hnum1 + exact div_le_div_of_nonneg_right hnum1Q + (by positivity : (0 : ℚ) ≤ (q.den : ℚ)) + _ = q := hqrep.symm + +/-- The same canonical binary length also gives a coarse dyadic upper bound +on every positive rational. -/ +theorem positive_rational_lt_two_pow_encodedBitLength + {q : ℚ} (hq : 0 < q) : + q < (2 : ℚ) ^ encodedBitLength ℚ q := by + let L := encodedBitLength ℚ q + have hnum : 0 < q.num := Rat.num_pos.mpr hq + have hnum0 : q.num.natAbs ≠ 0 := Int.natAbs_ne_zero.mpr hnum.ne' + have hnumlog : Nat.log 2 q.num.natAbs < L := + numerator_natAbs_log_lt_rationalBitLength q hnum0 + have hnumpow : q.num.natAbs < 2 ^ L := + Nat.lt_pow_of_log_lt (by norm_num) hnumlog + have hnumabs : (q.num.natAbs : ℤ) = q.num := + Int.natAbs_of_nonneg hnum.le + have hqrep : q = (q.num.natAbs : ℚ) / (q.den : ℚ) := by + calc + q = (q.num : ℚ) / (q.den : ℚ) := (Rat.num_div_den q).symm + _ = (q.num.natAbs : ℚ) / (q.den : ℚ) := by + congr 1 + change (q.num : ℚ) = ((q.num.natAbs : ℤ) : ℚ) + rw [hnumabs] + have hdenNat : 1 ≤ q.den := Nat.one_le_iff_ne_zero.mpr q.den_nz + have hden : (1 : ℚ) ≤ q.den := by exact_mod_cast hdenNat + have hquot : (q.num.natAbs : ℚ) / (q.den : ℚ) ≤ + (q.num.natAbs : ℚ) := by + rw [div_le_iff₀ (by positivity : (0 : ℚ) < q.den)] + have hnumQ : (0 : ℚ) ≤ q.num.natAbs := by positivity + nlinarith + calc + q = (q.num.natAbs : ℚ) / (q.den : ℚ) := hqrep + _ ≤ (q.num.natAbs : ℚ) := hquot + _ < (2 : ℚ) ^ encodedBitLength ℚ q := by + simpa only [L] using (show (q.num.natAbs : ℚ) < (2 : ℚ) ^ L by + exact_mod_cast hnumpow) + +/-- A deliberately simple common bit bound for all entries of a fixed-size +rational matrix. The sum, rather than a maximum, keeps the definition +primitive and gives an immediate polynomial bound. -/ +def rationalMatrixEntryBitBound {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) : ℕ := + 1 + ∑ i, ∑ j, encodedBitLength ℚ (A i j) + +theorem entry_encodedBitLength_lt_matrixBound {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) (i j : Fin n) : + encodedBitLength ℚ (A i j) < rationalMatrixEntryBitBound A := by + have hrow : encodedBitLength ℚ (A i j) ≤ + ∑ k, encodedBitLength ℚ (A i k) := + Finset.single_le_sum + (f := fun k ↦ encodedBitLength ℚ (A i k)) + (fun k _ ↦ Nat.zero_le _) (Finset.mem_univ j) + have hmatrix : (∑ k, encodedBitLength ℚ (A i k)) ≤ + ∑ l, ∑ k, encodedBitLength ℚ (A l k) := + Finset.single_le_sum + (f := fun l ↦ ∑ k, encodedBitLength ℚ (A l k)) + (fun l _ ↦ Finset.sum_nonneg fun k _ ↦ Nat.zero_le _) + (Finset.mem_univ i) + simp only [rationalMatrixEntryBitBound] + omega + +/-- Every positive entry is bounded below by the same dyadic determined by +the matrix encoding. -/ +theorem matrix_dyadic_bitBound_lt_entry {n : ℕ} + {A : Matrix (Fin n) (Fin n) ℚ} (hA : ∀ i j, 0 < A i j) + (i j : Fin n) : + (1 / 2 : ℚ) ^ rationalMatrixEntryBitBound A < A i j := by + have hlen := (entry_encodedBitLength_lt_matrixBound A i j).le + have hpow : (1 / 2 : ℚ) ^ rationalMatrixEntryBitBound A ≤ + (1 / 2 : ℚ) ^ encodedBitLength ℚ (A i j) := + pow_le_pow_of_le_one (by norm_num) (by norm_num) hlen + exact hpow.trans_lt (dyadic_encodedBitLength_lt_positive_rational (hA i j)) + +/-- Bundle a dimension-indexed rational-matrix algorithm into a single typed +function. -/ +def bundledAlgorithm + (alg : ∀ n, Matrix (Fin n) (Fin n) ℚ → ℚ) + (x : RationalMatrixInput) : ℚ := + alg x.1 x.2 + +/-- A total string function realizes a typed matrix algorithm when it produces +the canonical rational encoding on every canonically encoded matrix input. +Its behavior on malformed strings is deliberately unrestricted. -/ +def StringRealizes + (F : List Bool → List Bool) + (alg : ∀ n, Matrix (Fin n) (Fin n) ℚ → ℚ) : Prop := + ∀ x : RationalMatrixInput, + F (rationalMatrixBinaryCode x) = + rationalBinaryCode (bundledAlgorithm alg x) + +/-- The concrete polynomial-time assertion used in Theorem 1. `FP` is +Complexitylib's deterministic multitape-Turing-machine class with a polynomial +step bound. -/ +def RunsInPolynomialTime + (alg : ∀ n, Matrix (Fin n) (Fin n) ℚ → ℚ) : Prop := + ∃ F : List Bool → List Bool, F ∈ Complexity.FP ∧ StringRealizes F alg + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/ApproximateKKT.lean b/LeanPool/BeyondBethe/BeyondBethe/ApproximateKKT.lean new file mode 100644 index 0000000000..006ee1ec6c --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/ApproximateKKT.lean @@ -0,0 +1,250 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.StrongEntropy +import LeanPool.BeyondBethe.BeyondBethe.ExplicitBounds +import LeanPool.BeyondBethe.BeyondBethe.NumericalPotentials +import Mathlib.Tactic + +/-! # Approximate KKT -/ + +open scoped BigOperators + +namespace BeyondBethe + +/-! +# From objective accuracy to an approximate KKT certificate + +The regularizer makes the objective strongly concave. Consequently an +approximately optimal doubly stochastic matrix is close to an exact +maximizer. On an explicitly truncated interior of the Birkhoff polytope the +logarithmic gradient is Lipschitz, so closeness of the matrices gives +closeness of their gradients. Finally, anchored row and column potentials +turn that gradient estimate into the approximate logarithmic KKT equations +used by the permanent certificate. + +The executable elementary-function oracle approximates the *negative* +gradient. The last theorem below records the corresponding sign and the +additive fixedValue `2 + tau` explicitly. +-/ + +/-- On a common floor `delta`, one coordinate of the regularized Bethe +gradient is `3 / delta`-Lipschitz when `0 <= tau <= 1`. -/ +theorem regularizedBetheGradient_sub_abs_le + {ι : Type*} {τ δ : ℝ} {A X Y : Matrix ι ι ℝ} + (hτ0 : 0 ≤ τ) (hτ1 : τ ≤ 1) (hδ : 0 < δ) + (hXlo : ∀ i j, δ ≤ X i j) (hYlo : ∀ i j, δ ≤ Y i j) + (hXcomp : ∀ i j, δ ≤ 1 - X i j) + (hYcomp : ∀ i j, δ ≤ 1 - Y i j) + (i j : ι) : + abs (regularizedBetheGradient τ A X i j - + regularizedBetheGradient τ A Y i j) ≤ + 3 * abs (X i j - Y i j) / δ := by + have hlog := abs_log_sub_log_le_div hδ (hXlo i j) (hYlo i j) + have hcomplog := abs_log_sub_log_le_div hδ (hXcomp i j) (hYcomp i j) + have hcoef0 : 0 ≤ 1 + τ := by linarith + have hcoef2 : 1 + τ ≤ 2 := by linarith + have hscaled : + abs ((1 + τ) * + (Real.log (X i j) - Real.log (Y i j))) ≤ + 2 * (abs (X i j - Y i j) / δ) := by + rw [abs_mul, abs_of_nonneg hcoef0] + calc + (1 + τ) * abs (Real.log (X i j) - Real.log (Y i j)) ≤ + (1 + τ) * (abs (X i j - Y i j) / δ) := + mul_le_mul_of_nonneg_left hlog hcoef0 + _ ≤ 2 * (abs (X i j - Y i j) / δ) := + mul_le_mul_of_nonneg_right hcoef2 (by positivity) + have hcompdiff : + abs ((1 - X i j) - (1 - Y i j)) = abs (X i j - Y i j) := by + rw [show (1 - X i j) - (1 - Y i j) = + -(X i j - Y i j) by ring, abs_neg] + rw [hcompdiff] at hcomplog + have htriangle := abs_add_le + (-(1 + τ) * (Real.log (X i j) - Real.log (Y i j))) + (-(Real.log (1 - X i j) - Real.log (1 - Y i j))) + have hfirst : + abs (-(1 + τ) * (Real.log (X i j) - Real.log (Y i j))) = + abs ((1 + τ) * (Real.log (X i j) - Real.log (Y i j))) := by + rw [show -(1 + τ) * (Real.log (X i j) - Real.log (Y i j)) = + -((1 + τ) * (Real.log (X i j) - Real.log (Y i j))) by ring, + abs_neg] + have hid : + regularizedBetheGradient τ A X i j - + regularizedBetheGradient τ A Y i j = + -(1 + τ) * (Real.log (X i j) - Real.log (Y i j)) + + -(Real.log (1 - X i j) - Real.log (1 - Y i j)) := by + simp only [regularizedBetheGradient] + ring + rw [hid] + calc + abs (_ + _) ≤ + abs ((1 + τ) * + (Real.log (X i j) - Real.log (Y i j))) + + abs (Real.log (1 - X i j) - Real.log (1 - Y i j)) := by + simpa only [hfirst, abs_neg] using htriangle + _ ≤ 2 * (abs (X i j - Y i j) / δ) + + abs (X i j - Y i j) / δ := add_le_add hscaled hcomplog + _ = 3 * abs (X i j - Y i j) / δ := by ring + +/-- A single coordinate is bounded by the Frobenius norm. This square-only +form avoids introducing square roots into the rational algorithm. -/ +theorem abs_matrixCoordinate_le_of_sum_sq_le + {ι κ : Type*} [Fintype ι] [Fintype κ] + {D : Matrix ι κ ℝ} {ρ : ℝ} (hρ : 0 ≤ ρ) + (hsq : (∑ i, ∑ j, (D i j) ^ 2) ≤ ρ ^ 2) + (a : ι) (b : κ) : abs (D a b) ≤ ρ := by + have hcoord : (D a b) ^ 2 ≤ ∑ i, ∑ j, (D i j) ^ 2 := by + calc + (D a b) ^ 2 ≤ ∑ j, (D a j) ^ 2 := + Finset.single_le_sum (fun j _ ↦ sq_nonneg (D a j)) + (Finset.mem_univ b) + _ ≤ ∑ i, ∑ j, (D i j) ^ 2 := + Finset.single_le_sum + (fun i _ ↦ Finset.sum_nonneg fun j _ ↦ sq_nonneg (D i j)) + (Finset.mem_univ a) + have habs0 : 0 ≤ abs (D a b) := abs_nonneg _ + rw [← sq_abs] at hcoord + nlinarith [hcoord.trans hsq] + +/-- A sufficiently small objective gap forces entrywise proximity to an exact +regularized maximizer. The arithmetic hypothesis `4 g <= tau rho^2` is +chosen so that every quantity can be selected rationally. -/ +theorem regularizedBetheMaximizer_coordinate_close_of_gap + {ι : Type*} [Fintype ι] [DecidableEq ι] + (hcard : 1 < Fintype.card ι) + {τ g ρ : ℝ} (hτ : 0 < τ) (hρ : 0 ≤ ρ) + (hscale : 4 * g ≤ τ * ρ ^ 2) + {A X Y : Matrix ι ι ℝ} + (hX : IsDoublyStochastic X) (hY : IsDoublyStochastic Y) + (hmax : ∀ Z, IsDoublyStochastic Z → + regularizedBetheObjective τ A Z ≤ + regularizedBetheObjective τ A X) + (hgap : regularizedBetheObjective τ A X - + regularizedBetheObjective τ A Y ≤ g) + (i j : ι) : abs (X i j - Y i j) ≤ ρ := by + have hdist := regularizedBetheMaximizer_distance_sq_le_gap + hcard hτ.le hX hY hmax + have hsquares : + (∑ i, ∑ j, (X i j - Y i j) ^ 2) ≤ ρ ^ 2 := by + nlinarith + exact abs_matrixCoordinate_le_of_sum_sq_le hρ hsquares i j + +/-- Objective accuracy plus a common interior floor controls the model error +between the negative gradients at an approximate and an exact optimizer. -/ +theorem negativeGradient_close_of_objective_gap + {ι : Type*} [Fintype ι] [DecidableEq ι] + (hcard : 1 < Fintype.card ι) + {τ g ρ δ : ℝ} (hτ : 0 < τ) (hτ1 : τ ≤ 1) + (hρ : 0 ≤ ρ) (hδ : 0 < δ) + (hscale : 4 * g ≤ τ * ρ ^ 2) + {A X Y : Matrix ι ι ℝ} + (hX : IsDoublyStochastic X) (hY : IsDoublyStochastic Y) + (hmax : ∀ Z, IsDoublyStochastic Z → + regularizedBetheObjective τ A Z ≤ + regularizedBetheObjective τ A X) + (hgap : regularizedBetheObjective τ A X - + regularizedBetheObjective τ A Y ≤ g) + (hXlo : ∀ i j, δ ≤ X i j) (hYlo : ∀ i j, δ ≤ Y i j) + (hXcomp : ∀ i j, δ ≤ 1 - X i j) + (hYcomp : ∀ i j, δ ≤ 1 - Y i j) + (i j : ι) : + abs (-regularizedBetheGradient τ A Y i j - + -regularizedBetheGradient τ A X i j) ≤ 3 * ρ / δ := by + have hcoord := regularizedBetheMaximizer_coordinate_close_of_gap + hcard hτ hρ hscale hX hY hmax hgap i j + have hcoord' : abs (Y i j - X i j) ≤ ρ := by + simpa only [abs_sub_comm] using hcoord + have hgrad := regularizedBetheGradient_sub_abs_le (A := A) hτ.le hτ1 hδ + hYlo hXlo hYcomp hXcomp i j + rw [show -regularizedBetheGradient τ A Y i j - + -regularizedBetheGradient τ A X i j = + -(regularizedBetheGradient τ A Y i j - + regularizedBetheGradient τ A X i j) by ring, abs_neg] + exact hgrad.trans (by + exact div_le_div_of_nonneg_right + (mul_le_mul_of_nonneg_left hcoord' (by norm_num)) hδ.le) + +/-- The complete analytic bridge to the certificate interface. `Gtilde` is +an executable approximation to the negative gradient at the returned point +`Y`. Anchoring it produces explicit potentials; the signs and the derivative +fixedValue are incorporated in the displayed output potentials. -/ +theorem approximateLogKKT_of_objective_gap + {ι : Type*} [Fintype ι] [DecidableEq ι] [Nonempty ι] + (hcard : 1 < Fintype.card ι) + {τ g ρ δ evaluationError : ℝ} + (hτ : 0 < τ) (hτ1 : τ ≤ 1) (hρ : 0 ≤ ρ) (hδ : 0 < δ) + (hscale : 4 * g ≤ τ * ρ ^ 2) + {A X Y Gtilde : Matrix ι ι ℝ} + (hX : IsDoublyStochastic X) (hY : IsDoublyStochastic Y) + (hmax : ∀ Z, IsDoublyStochastic Z → + regularizedBetheObjective τ A Z ≤ + regularizedBetheObjective τ A X) + (hgap : regularizedBetheObjective τ A X - + regularizedBetheObjective τ A Y ≤ g) + (hXint : ∀ i, IsInteriorProbabilityVector (X i)) + (hXlo : ∀ i j, δ ≤ X i j) (hYlo : ∀ i j, δ ≤ Y i j) + (hXcomp : ∀ i j, δ ≤ 1 - X i j) + (hYcomp : ∀ i j, δ ≤ 1 - Y i j) + (heval : ∀ i j, + abs (-regularizedBetheGradient τ A Y i j - Gtilde i j) ≤ + evaluationError) + (i0 j0 : ι) : + HasApproximateLogKKT + (evaluationError + 4 * (evaluationError + 3 * ρ / δ)) τ A Y + (fun i ↦ -anchoredRowPotential Gtilde j0 i + (2 + τ)) + (fun j ↦ -anchoredColumnPotential Gtilde i0 j0 j) := by + obtain ⟨R, C, hRC⟩ := exists_rowColumnPotentials_of_rectangle_identity + (fun i j ↦ regularizedBetheGradient τ A X i j) + (fun hik hjl ↦ regularizedGradient_rectangle_identity + hX hXint hmax hik hjl) + have hstar : ∀ i j, + -regularizedBetheGradient τ A X i j = -R i + -C j := by + intro i j + rw [hRC i j] + ring + have hmodel : ∀ i j, + abs (Gtilde i j - -regularizedBetheGradient τ A X i j) ≤ + evaluationError + 3 * ρ / δ := by + intro i j + have hclose := negativeGradient_close_of_objective_gap + hcard hτ hτ1 hρ hδ hscale hX hY hmax hgap + hXlo hYlo hXcomp hYcomp i j + calc + abs (Gtilde i j - -regularizedBetheGradient τ A X i j) = + abs ((Gtilde i j - -regularizedBetheGradient τ A Y i j) + + (-regularizedBetheGradient τ A Y i j - + -regularizedBetheGradient τ A X i j)) := by congr 1 <;> ring + _ ≤ abs (Gtilde i j - -regularizedBetheGradient τ A Y i j) + + abs (-regularizedBetheGradient τ A Y i j - + -regularizedBetheGradient τ A X i j) := abs_add_le _ _ + _ ≤ evaluationError + 3 * ρ / δ := by + have heval' : + abs (Gtilde i j - -regularizedBetheGradient τ A Y i j) ≤ + evaluationError := by + simpa only [abs_sub_comm] using heval i j + exact add_le_add heval' hclose + intro i j + have hres := anchoredPotentials_residual_of_evaluation + hstar hmodel heval i0 j0 i j + change abs (Real.log (A i j) - + ((-anchoredRowPotential Gtilde j0 i + (2 + τ)) + + -anchoredColumnPotential Gtilde i0 j0 j + + (1 + τ) * Real.log (Y i j) + Real.log (1 - Y i j))) ≤ _ + have hid : + Real.log (A i j) - + ((-anchoredRowPotential Gtilde j0 i + (2 + τ)) + + -anchoredColumnPotential Gtilde i0 j0 j + + (1 + τ) * Real.log (Y i j) + Real.log (1 - Y i j)) = + -(-regularizedBetheGradient τ A Y i j - + (anchoredRowPotential Gtilde j0 i + + anchoredColumnPotential Gtilde i0 j0 j)) := by + simp only [regularizedBetheGradient] + ring + rw [hid, abs_neg] + exact hres + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/AxiomAudit.lean b/LeanPool/BeyondBethe/BeyondBethe/AxiomAudit.lean new file mode 100644 index 0000000000..7daf097a0b --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/AxiomAudit.lean @@ -0,0 +1,10 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe +import LeanPool.BeyondBethe.Solution + +/-! # Axiom Audit -/ diff --git a/LeanPool/BeyondBethe/BeyondBethe/Bethe.lean b/LeanPool/BeyondBethe/BeyondBethe/Bethe.lean new file mode 100644 index 0000000000..347a926851 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/Bethe.lean @@ -0,0 +1,121 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.Birkhoff +import LeanPool.BeyondBethe.BeyondBethe.Entropy +import Mathlib.Analysis.Convex.Function +import Mathlib.Tactic + +/-! # Bethe -/ + +open scoped BigOperators + +namespace BeyondBethe + +def Matrix.Positive + {m n : Type*} (A : Matrix m n ℝ) : Prop := + ∀ i j, 0 < A i j + +/-- Feasibility for the Bethe program on a matrix with possible zero entries. +The support condition realizes the paper's `-∞` convention without using +extended reals in the objective. -/ +def BetheAdmissible + {n : Type*} [Fintype n] (A X : Matrix n n ℝ) : Prop := + IsDoublyStochastic X ∧ ∀ i j, A i j = 0 → X i j = 0 + +/-- Bethe objective (paper (2)), using `negMulLog` for the continuous +`-x log x` term. -/ +noncomputable def betheRowObjective + {n : Type*} [Fintype n] (A X : Matrix n n ℝ) (i : n) : ℝ := by + classical + exact ∑ j : n, + (X i j * Real.log (A i j) + Real.negMulLog (X i j) + + (1 - X i j) * Real.log (1 - X i j)) + +noncomputable def betheObjective + {n : Type*} [Fintype n] (A X : Matrix n n ℝ) : ℝ := by + classical + exact ∑ i : n, betheRowObjective A X i + +/-- Singleton factor in logarithmic coordinates. -/ +noncomputable def singletonFactor + {n : Type*} [Fintype n] (A X : Matrix n n ℝ) (i : n) : ℝ := + Real.exp (betheRowObjective A X i) + +theorem prod_singletonFactor_eq_exp_betheObjective + {n : Type*} [Fintype n] + (A X : Matrix n n ℝ) : + ∏ i, singletonFactor A X i = Real.exp (betheObjective A X) := by + classical + simp only [singletonFactor, betheObjective] + exact (Real.exp_sum Finset.univ (betheRowObjective A X)).symm + +/-- Variational logarithm of the Bethe permanent. -/ +noncomputable def betheLogValue + {n : Type*} [Fintype n] (A : Matrix n n ℝ) : ℝ := + sSup {v : ℝ | ∃ X, BetheAdmissible A X ∧ betheObjective A X = v} + +/-- Bethe permanent. If the positive support has no perfect matching, both +the permanent and the variational lower bound are zero. -/ +noncomputable def bethePermanent + {n : Type*} [Fintype n] [DecidableEq n] + (A : Matrix n n ℝ) : ℝ := by + classical + exact if Matrix.HasPerfectMatching A then Real.exp (betheLogValue A) else 0 + +theorem bethePermanent_eq_zero_of_noPerfectMatching + {n : Type*} [Fintype n] [DecidableEq n] + (A : Matrix n n ℝ) (hA : ¬Matrix.HasPerfectMatching A) : + bethePermanent A = 0 := by + simp [bethePermanent, hA] + +theorem bethePermanent_pos_of_hasPerfectMatching + {n : Type*} [Fintype n] [DecidableEq n] + (A : Matrix n n ℝ) (hA : Matrix.HasPerfectMatching A) : + 0 < bethePermanent A := by + simp [bethePermanent, hA, Real.exp_pos] + +/-- Exact interface for the Gurvits and Anari--Rezaei Bethe sandwich. -/ +def BetheSandwich : Prop := + ∀ {n : Type*} [Fintype n] [DecidableEq n] + (A : Matrix n n ℝ), Matrix.Nonnegative A → + bethePermanent A ≤ Matrix.permanent A ∧ + Matrix.permanent A ≤ + (Real.sqrt 2) ^ Fintype.card n * bethePermanent A + +/-- Exact interface for Vontobel's concavity theorem, restricted to positive +matrices as used in the structural proof. -/ +def VontobelBetheConcavity : Prop := + ∀ {n : Type*} [Fintype n] + (A : Matrix n n ℝ), Matrix.Positive A → + ConcaveOn ℝ {X : Matrix n n ℝ | IsDoublyStochastic X} + (betheObjective A) + +/-- Row-entropy regularization from paper (34). -/ +noncomputable def regularizedBetheObjective + {n : Type*} [Fintype n] + (τ : ℝ) (A X : Matrix n n ℝ) : ℝ := + betheObjective A X + τ * totalRowEntropy X + +/-- Comparing a regularized maximizer with any unregularized competitor loses +at most `τ n log n` in the Bethe objective. This is the quantitative part of +paper Lemma 14 that does not use KKT or boundary analysis. -/ +theorem regularized_near_bethe + {n : Type*} [Fintype n] [DecidableEq n] [Nonempty n] + {τ : ℝ} (hτ : 0 ≤ τ) (A X Y : Matrix n n ℝ) + (hX : IsDoublyStochastic X) (hY : IsDoublyStochastic Y) + (hmax : regularizedBetheObjective τ A Y ≤ + regularizedBetheObjective τ A X) : + betheObjective A Y - + τ * (Fintype.card n * Real.log (Fintype.card n)) + ≤ betheObjective A X := by + have hEY0 := totalRowEntropy_nonneg hY + have hEX := totalRowEntropy_le hX + rw [regularizedBetheObjective, regularizedBetheObjective] at hmax + have hτEX := mul_le_mul_of_nonneg_left hEX hτ + nlinarith + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/BetheBisection.lean b/LeanPool/BeyondBethe/BeyondBethe/BetheBisection.lean new file mode 100644 index 0000000000..ae20f30b7c --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/BetheBisection.lean @@ -0,0 +1,385 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.BetheThresholdFeasibility +import Mathlib.Tactic + +/-! # Bethe Bisection -/ + +namespace BeyondBethe + +/-! +# Rational bisection for the regularized Bethe objective + +The bisection uses only the concrete threshold feasibility runner. An +accepted midpoint becomes the new upper endpoint and carries its rational +witness. An exhausted midpoint becomes the new lower endpoint. Correctness +uses the proved implication that exhaustion can occur only below the exact +optimum plus the explicit smoothing slack. +-/ + +def betheNegativeObjectiveLower (m : ℕ) : ℚ := + -(2 * (m + 1) ^ 2) + +def betheNegativeObjectiveUpper {m : ℕ} + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) : ℚ := + (m + 1) * rationalMatrixEntryBitBound A + (m + 1) + +def betheSmoothingSlack {m : ℕ} + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (mix r : ℚ) : ℚ := + mix * rationalRegularizedObjectiveRange A + 2 * r + +def betheBisectionInitialHigh {m : ℕ} + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (mix r : ℚ) : ℚ := + betheNegativeObjectiveUpper A + betheSmoothingSlack A mix r + +theorem negativeObjective_mem_initial_interval + {m : ℕ} {τ : ℚ} (hτ0 : 0 ≤ τ) (hτ1 : τ ≤ 1) + {A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ} + (hApos : ∀ i j, 0 < A i j) (hAupper : ∀ i j, A i j ≤ 1) + {X : Matrix (Fin (m + 1)) (Fin (m + 1)) ℝ} + (hX : IsDoublyStochastic X) : + (betheNegativeObjectiveLower m : ℝ) ≤ + -regularizedBetheObjective (τ : ℝ) + (fun i j ↦ (A i j : ℝ)) X ∧ + -regularizedBetheObjective (τ : ℝ) + (fun i j ↦ (A i j : ℝ)) X ≤ + (betheNegativeObjectiveUpper A : ℝ) := by + have h := negativeRegularizedBetheObjective_rational_bounds + (n := m + 1) (by omega) hτ0 hτ1 hApos hAupper hX + norm_num [betheNegativeObjectiveLower, betheNegativeObjectiveUpper] at h ⊢ + exact h + +/-- Executable state of the rational bisection. -/ +structure BetheBisectionState (d : ℕ) where + low : ℚ + high : ℚ + witness : Option (Fin d → ℚ) + +/-- One bisection step. -/ +def betheBisectionStep {m : ℕ} + (τ : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (p : ℕ) (δ r : ℚ) (s : BetheBisectionState (m * m + 1)) : + BetheBisectionState (m * m + 1) := + let mid := (s.low + s.high) / 2 + match runBetheThresholdFeasibility τ A p δ mid r with + | .accepted q => ⟨s.low, mid, some q⟩ + | .exhausted _ => ⟨mid, s.high, s.witness⟩ + +/-- Iterate the bisection a prescribed number of times. -/ +def runBetheBisection {m : ℕ} + (τ : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (p : ℕ) (δ r : ℚ) : + ℕ → BetheBisectionState (m * m + 1) → + BetheBisectionState (m * m + 1) + | 0, s => s + | N + 1, s => runBetheBisection τ A p δ r N + (betheBisectionStep τ A p δ r s) + +/-- Initialize by querying the explicit global upper endpoint. -/ +def initialBetheBisectionState {m : ℕ} + (τ : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (p : ℕ) (δ mix r : ℚ) : BetheBisectionState (m * m + 1) := + let high := betheBisectionInitialHigh A mix r + match runBetheThresholdFeasibility τ A p δ high r with + | .accepted q => ⟨betheNegativeObjectiveLower m, high, some q⟩ + | .exhausted _ => ⟨betheNegativeObjectiveLower m, high, none⟩ + +@[simp] theorem initialBetheBisectionState_low {m : ℕ} + (τ : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (p : ℕ) (δ mix r : ℚ) : + (initialBetheBisectionState τ A p δ mix r).low = + betheNegativeObjectiveLower m := by + rw [initialBetheBisectionState] + split <;> rfl + +@[simp] theorem initialBetheBisectionState_high {m : ℕ} + (τ : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (p : ℕ) (δ mix r : ℚ) : + (initialBetheBisectionState τ A p δ mix r).high = + betheBisectionInitialHigh A mix r := by + rw [initialBetheBisectionState] + split <;> rfl + +/-- A stored witness is certified by an actual accepted run at the state's +current upper endpoint. -/ +def BetheBisectionWitnessValid {m : ℕ} + (τ : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (p : ℕ) (δ r : ℚ) (s : BetheBisectionState (m * m + 1)) : Prop := + ∀ q, s.witness = some q → + runBetheThresholdFeasibility τ A p δ s.high r = .accepted q ∧ + BetheEpigraphOracleAccepted τ A p δ s.high q + +theorem initialBetheBisectionState_witnessValid {m : ℕ} + (τ : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (p : ℕ) (δ mix r : ℚ) : + BetheBisectionWitnessValid τ A p δ r + (initialBetheBisectionState τ A p δ mix r) := by + intro q hq + rw [initialBetheBisectionState] at hq ⊢ + split at hq <;> rename_i hrun + · cases hq + exact ⟨hrun, runBetheThresholdFeasibility_acceptsOnly + τ A p δ _ r hrun⟩ + · contradiction + +theorem betheBisectionStep_witnessValid {m : ℕ} + (τ : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (p : ℕ) (δ r : ℚ) {s : BetheBisectionState (m * m + 1)} + (hs : BetheBisectionWitnessValid τ A p δ r s) : + BetheBisectionWitnessValid τ A p δ r + (betheBisectionStep τ A p δ r s) := by + intro q hq + rw [betheBisectionStep] at hq ⊢ + split at hq <;> rename_i hrun + · cases hq + exact ⟨hrun, runBetheThresholdFeasibility_acceptsOnly + τ A p δ _ r hrun⟩ + · exact hs q hq + +theorem runBetheBisection_witnessValid {m : ℕ} + (τ : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (p : ℕ) (δ r : ℚ) {s : BetheBisectionState (m * m + 1)} + (hs : BetheBisectionWitnessValid τ A p δ r s) (N : ℕ) : + BetheBisectionWitnessValid τ A p δ r + (runBetheBisection τ A p δ r N s) := by + induction N generalizing s with + | zero => simpa [runBetheBisection] using hs + | succ N ih => + rw [runBetheBisection] + exact ih (betheBisectionStep_witnessValid τ A p δ r hs) + +/-- Every step halves the rational interval width exactly. -/ +theorem betheBisectionStep_width {m : ℕ} + (τ : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (p : ℕ) (δ r : ℚ) (s : BetheBisectionState (m * m + 1)) : + (betheBisectionStep τ A p δ r s).high - + (betheBisectionStep τ A p δ r s).low = + (s.high - s.low) / 2 := by + rw [betheBisectionStep] + split <;> ring + +theorem runBetheBisection_width {m : ℕ} + (τ : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (p : ℕ) (δ r : ℚ) (N : ℕ) + (s : BetheBisectionState (m * m + 1)) : + (runBetheBisection τ A p δ r N s).high - + (runBetheBisection τ A p δ r N s).low = + (s.high - s.low) / 2 ^ N := by + induction N generalizing s with + | zero => simp [runBetheBisection] + | succ N ih => + rw [runBetheBisection, ih, betheBisectionStep_width] + rw [pow_succ] + ring + +/-- If every exhausted query lies below `cutoff`, a bisection step preserves +the invariant that the lower endpoint is at most `cutoff`. -/ +theorem betheBisectionStep_low_le_cutoff {m : ℕ} + (τ : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (p : ℕ) (δ r : ℚ) {cutoff : ℝ} + (hbelow : ∀ (u : ℚ) (E : RationalEllipsoidState (m * m + 1)), + runBetheThresholdFeasibility τ A p δ u r = .exhausted E → + (u : ℝ) < cutoff) + {s : BetheBisectionState (m * m + 1)} + (hlow : (s.low : ℝ) ≤ cutoff) : + ((betheBisectionStep τ A p δ r s).low : ℚ) ≤ cutoff := by + rw [betheBisectionStep] + split <;> rename_i hrun + · exact hlow + · exact (hbelow _ _ hrun).le + +theorem runBetheBisection_low_le_cutoff {m : ℕ} + (τ : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (p : ℕ) (δ r : ℚ) {cutoff : ℝ} + (hbelow : ∀ (u : ℚ) (E : RationalEllipsoidState (m * m + 1)), + runBetheThresholdFeasibility τ A p δ u r = .exhausted E → + (u : ℝ) < cutoff) + {s : BetheBisectionState (m * m + 1)} + (hlow : (s.low : ℝ) ≤ cutoff) (N : ℕ) : + (((runBetheBisection τ A p δ r N s).low : ℚ) : ℝ) ≤ cutoff := by + induction N generalizing s with + | zero => simpa [runBetheBisection] using hlow + | succ N ih => + rw [runBetheBisection] + exact ih (betheBisectionStep_low_le_cutoff τ A p δ r hbelow hlow) + +/-- Once a witness exists, every later state still carries one. -/ +theorem runBetheBisection_preserves_some {m : ℕ} + (τ : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (p : ℕ) (δ r : ℚ) {s : BetheBisectionState (m * m + 1)} + (hsome : ∃ q, s.witness = some q) (N : ℕ) : + ∃ q, (runBetheBisection τ A p δ r N s).witness = some q := by + induction N generalizing s with + | zero => simpa [runBetheBisection] using hsome + | succ N ih => + rw [runBetheBisection] + apply ih + rw [betheBisectionStep] + split + · rename_i q hrun + exact ⟨q, rfl⟩ + · exact hsome + +/-- The explicit global upper endpoint is guaranteed to initialize the +bisection with an accepted witness. -/ +theorem initialBetheBisectionState_has_witness_of_optimizer + {m : ℕ} (hm : 0 < m) {τ : ℚ} (hτ0 : 0 < τ) (hτ1 : τ ≤ 1) + {A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ} + (hApos : ∀ i j, 0 < A i j) (hAupper : ∀ i j, A i j ≤ 1) + {X : Matrix (Fin (m + 1)) (Fin (m + 1)) ℝ} + (hX : IsDoublyStochastic X) + (hmax : ∀ Y, IsDoublyStochastic Y → + regularizedBetheObjective (τ : ℝ) + (fun i j ↦ (A i j : ℝ)) Y ≤ + regularizedBetheObjective (τ : ℝ) + (fun i j ↦ (A i j : ℝ)) X) + {mix δ r : ℚ} (hmix0 : 0 < mix) (hmix1 : mix ≤ 1) + (hδ : 0 < δ) (hr : 0 < r) + (hspike : r / mix ≤ 1 / (m + 1 : ℚ)) + (hfloor : δ ≤ (1 - mix) * + numericalInteriorFloor (m + 1) (rationalMatrixEntryBitBound A) τ) + (p : ℕ) : + ∃ q, (initialBetheBisectionState τ A p δ mix r).witness = some q := by + have hupper := (negativeObjective_mem_initial_interval hτ0.le hτ1 + hApos hAupper hX).2 + have hthreshold : + -regularizedBetheObjective (τ : ℝ) + (fun i j ↦ (A i j : ℝ)) X + + (mix : ℝ) * (rationalRegularizedObjectiveRange A : ℝ) + + 2 * (r : ℝ) ≤ (betheBisectionInitialHigh A mix r : ℝ) := by + rw [betheBisectionInitialHigh, betheSmoothingSlack] + push_cast + linarith + obtain ⟨q, hrun, _⟩ := runBetheThresholdFeasibility_accepts_of_slack + hm hτ0 hτ1 hApos hAupper hX hmax hmix0 hmix1 hδ hr + hspike hfloor hthreshold p + refine ⟨q, ?_⟩ + rw [initialBetheBisectionState, hrun] + +/-- Complete semantic guarantee of executable bisection: it returns a +rational interior doubly stochastic matrix whose regularized objective gap +is the sum of the smoothing slack, the exact dyadic interval width, and the +directed-evaluation loss. -/ +theorem runBetheBisection_objective_gap + {m : ℕ} (hm : 0 < m) {τ : ℚ} (hτ0 : 0 < τ) (hτ1 : τ ≤ 1) + {A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ} + (hApos : ∀ i j, 0 < A i j) (hAupper : ∀ i j, A i j ≤ 1) + {X : Matrix (Fin (m + 1)) (Fin (m + 1)) ℝ} + (hX : IsDoublyStochastic X) + (hmax : ∀ Y, IsDoublyStochastic Y → + regularizedBetheObjective (τ : ℝ) + (fun i j ↦ (A i j : ℝ)) Y ≤ + regularizedBetheObjective (τ : ℝ) + (fun i j ↦ (A i j : ℝ)) X) + {mix δ r : ℚ} (hmix0 : 0 < mix) (hmix1 : mix ≤ 1) + (hδ : 0 < δ) (hr : 0 < r) + (hspike : r / mix ≤ 1 / (m + 1 : ℚ)) + (hfloor : δ ≤ (1 - mix) * + numericalInteriorFloor (m + 1) (rationalMatrixEntryBitBound A) τ) + (p N : ℕ) : + let s0 := initialBetheBisectionState τ A p δ mix r + let sN := runBetheBisection τ A p δ r N s0 + ∃ q : Fin (m * m + 1) → ℚ, + sN.witness = some q ∧ + BetheEpigraphOracleAccepted τ A p δ sN.high q ∧ + IsDoublyStochastic (acceptedBetheMatrix q) ∧ + (∀ i j, (δ : ℝ) ≤ acceptedBetheMatrix q i j) ∧ + regularizedBetheObjective (τ : ℝ) + (fun i j ↦ (A i j : ℝ)) X - + regularizedBetheObjective (τ : ℝ) + (fun i j ↦ (A i j : ℝ)) (acceptedBetheMatrix q) ≤ + (betheSmoothingSlack A mix r : ℝ) + + (((betheBisectionInitialHigh A mix r - + betheNegativeObjectiveLower m) / 2 ^ N : ℚ) : ℝ) + + (betheObjectiveEvaluationError m p : ℝ) := by + dsimp only + let s0 := initialBetheBisectionState τ A p δ mix r + let sN := runBetheBisection τ A p δ r N s0 + have hsome0 : ∃ q, s0.witness = some q := by + simpa only [s0] using initialBetheBisectionState_has_witness_of_optimizer + hm hτ0 hτ1 hApos hAupper hX hmax hmix0 hmix1 hδ hr + hspike hfloor p + obtain ⟨q, hq⟩ := runBetheBisection_preserves_some + τ A p δ r hsome0 N + have hqN : sN.witness = some q := by simpa only [sN] using hq + have hvalid0 := initialBetheBisectionState_witnessValid + τ A p δ mix r + have hvalidN := runBetheBisection_witnessValid + τ A p δ r hvalid0 N + have hcertificate : BetheEpigraphOracleAccepted τ A p δ sN.high q := by + exact (hvalidN q (by simpa only [sN] using hqN)).2 + have hbounds := negativeObjective_mem_initial_interval hτ0.le hτ1 + hApos hAupper hX + let cutoff : ℝ := + -regularizedBetheObjective (τ : ℝ) + (fun i j ↦ (A i j : ℝ)) X + + (betheSmoothingSlack A mix r : ℝ) + have hslack0 : 0 ≤ betheSmoothingSlack A mix r := by + rw [betheSmoothingSlack] + exact add_nonneg + (mul_nonneg hmix0.le (rationalRegularizedObjectiveRange_nonneg A)) + (mul_nonneg (by norm_num) hr.le) + have hlow0 : (s0.low : ℝ) ≤ cutoff := by + rw [show s0.low = betheNegativeObjectiveLower m by + simp only [s0, initialBetheBisectionState_low]] + dsimp only [cutoff] + have hslack0R : 0 ≤ (betheSmoothingSlack A mix r : ℝ) := + Rat.cast_nonneg.mpr hslack0 + linarith [hbounds.1] + have hbelow : ∀ (u : ℚ) (E : RationalEllipsoidState (m * m + 1)), + runBetheThresholdFeasibility τ A p δ u r = .exhausted E → + (u : ℝ) < cutoff := by + intro u E hrun + have h := runBetheThresholdFeasibility_exhausted_lt_optimum_add_slack + hm hτ0 hτ1 hApos hAupper hX hmax hmix0 hmix1 hδ hr + hspike hfloor p hrun + dsimp only [cutoff] + rw [betheSmoothingSlack] + push_cast + simpa [add_assoc] using h + have hlowN : (sN.low : ℝ) ≤ cutoff := by + simpa only [sN] using runBetheBisection_low_le_cutoff + τ A p δ r hbelow hlow0 N + have hwidthQ := runBetheBisection_width τ A p δ r N s0 + have hwidth : (sN.high : ℝ) - (sN.low : ℝ) = + (((betheBisectionInitialHigh A mix r - + betheNegativeObjectiveLower m) / 2 ^ N : ℚ) : ℝ) := by + have hwidthQ' : sN.high - sN.low = + (betheBisectionInitialHigh A mix r - + betheNegativeObjectiveLower m) / 2 ^ N := by + simpa only [sN, s0, initialBetheBisectionState_high, + initialBetheBisectionState_low] using hwidthQ + exact_mod_cast hwidthQ' + have hhigh : (sN.high : ℝ) ≤ cutoff + + (((betheBisectionInitialHigh A mix r - + betheNegativeObjectiveLower m) / 2 ^ N : ℚ) : ℝ) := by + linarith + have hobjective := + BetheEpigraphOracleAccepted_exact_objective_upper_compact + hm hτ0.le hτ1 hApos hδ hcertificate + have hheight : ((epigraphHeight q : ℚ) : ℝ) ≤ (sN.high : ℝ) := by + exact_mod_cast hcertificate.2.1 + have hreturned : + -regularizedBetheObjective (τ : ℝ) + (fun i j ↦ (A i j : ℝ)) (acceptedBetheMatrix q) ≤ + (sN.high : ℝ) + (betheObjectiveEvaluationError m p : ℝ) := by + have hobjective' : + -regularizedBetheObjective (τ : ℝ) + (fun i j ↦ (A i j : ℝ)) (acceptedBetheMatrix q) ≤ + ((epigraphHeight q : ℚ) : ℝ) + + (betheObjectiveEvaluationError m p : ℝ) := by + simpa only [affineNegativeObjective, acceptedBetheMatrix] using hobjective + linarith + refine ⟨q, hqN, hcertificate, + BetheEpigraphOracleAccepted_doublyStochastic hδ.le hcertificate, + BetheEpigraphOracleAccepted_entry_floor hcertificate, ?_⟩ + dsimp only [cutoff] at hhigh + linarith + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/BetheEpigraph.lean b/LeanPool/BeyondBethe/BeyondBethe/BetheEpigraph.lean new file mode 100644 index 0000000000..009031ed65 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/BetheEpigraph.lean @@ -0,0 +1,552 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.RationalEpigraphOracle +import LeanPool.BeyondBethe.BeyondBethe.WeakSeparation +import Mathlib.Tactic + +/-! # Bethe Epigraph -/ + +open scoped BigOperators + +namespace BeyondBethe + +/-! +# The concrete directed Bethe epigraph data + +The upper-left `m`-by-`m` affine coordinates are flattened into `m^2` +rational coordinates. This file connects the already certified directed +objective and gradient evaluations to the generic rational epigraph oracle. +-/ + +def squareMatrixToVector {m : ℕ} {R : Type*} + (Y : Matrix (Fin m) (Fin m) R) : Fin (m * m) → R := + fun k ↦ + let ij := finProdFinEquiv.symm k + Y ij.1 ij.2 + +def vectorToSquareMatrix {m : ℕ} {R : Type*} + (y : Fin (m * m) → R) : Matrix (Fin m) (Fin m) R := + fun i j ↦ y (finProdFinEquiv (i, j)) + +@[simp] theorem vectorToSquareMatrix_squareMatrixToVector + {m : ℕ} {R : Type*} (Y : Matrix (Fin m) (Fin m) R) : + vectorToSquareMatrix (squareMatrixToVector Y) = Y := by + ext i j + simp [vectorToSquareMatrix, squareMatrixToVector] + +@[simp] theorem squareMatrixToVector_vectorToSquareMatrix + {m : ℕ} {R : Type*} (y : Fin (m * m) → R) : + squareMatrixToVector (vectorToSquareMatrix y) = y := by + ext k + change y (finProdFinEquiv (finProdFinEquiv.symm k)) = y k + rw [Equiv.apply_symm_apply] + +theorem squareMatrixToVector_injective {m : ℕ} {R : Type*} : + Function.Injective (@squareMatrixToVector m R) := by + intro Y Z h + calc + Y = vectorToSquareMatrix (squareMatrixToVector Y) := + (vectorToSquareMatrix_squareMatrixToVector Y).symm + _ = vectorToSquareMatrix (squareMatrixToVector Z) := by rw [h] + _ = Z := vectorToSquareMatrix_squareMatrixToVector Z + +theorem sum_squareMatrixToVector {m : ℕ} {R : Type*} [AddCommMonoid R] + (Y : Matrix (Fin m) (Fin m) R) : + (∑ k, squareMatrixToVector Y k) = ∑ i, ∑ j, Y i j := by + calc + (∑ k, squareMatrixToVector Y k) = + ∑ ij : Fin m × Fin m, + squareMatrixToVector Y (finProdFinEquiv ij) := + (finProdFinEquiv.sum_comp (squareMatrixToVector Y)).symm + _ = ∑ ij : Fin m × Fin m, Y ij.1 ij.2 := by + apply Finset.sum_congr rfl + intro ij _ + simp [squareMatrixToVector] + _ = ∑ i, ∑ j, Y i j := Fintype.sum_prod_type _ + +theorem finiteDot_squareMatrixToVector {m : ℕ} {R : Type*} [CommSemiring R] + (G D : Matrix (Fin m) (Fin m) R) : + finiteDot (squareMatrixToVector G) (squareMatrixToVector D) = + matrixPairing G D := by + change (∑ k, squareMatrixToVector + (fun i j ↦ G i j * D i j) k) = ∑ i, ∑ j, G i j * D i j + rw [sum_squareMatrixToVector] + +theorem vectorL1_squareMatrixToVector {m : ℕ} + (D : Matrix (Fin m) (Fin m) ℝ) : + vectorL1 (squareMatrixToVector D) = matrixL1 D := by + change (∑ k, squareMatrixToVector + (fun i j ↦ abs (D i j)) k) = ∑ i, ∑ j, abs (D i j) + rw [sum_squareMatrixToVector] + +/-- Rational affine matrix represented by a flattened epigraph base point. -/ +def betheAffineMatrixQ {m : ℕ} (y : Fin (m * m) → ℚ) : + Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ := + birkhoffAffineMap (vectorToSquareMatrix y) + +/-- Concrete directed value and affine-gradient endpoints. -/ +def betheDirectedEpigraphData {m : ℕ} + (τ : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) (p : ℕ) : + DirectedEpigraphData (m * m) where + lower y := directedNegativeObjectiveLower τ A (betheAffineMatrixQ y) p + gradient y := squareMatrixToVector + (affinePullbackGradient + (directedNegativeGradientLowerMatrix τ A (betheAffineMatrixQ y) p)) + +theorem cast_vectorToSquareMatrix {m : ℕ} + (y : Fin (m * m) → ℚ) (i j : Fin m) : + ((vectorToSquareMatrix y i j : ℚ) : ℝ) = + vectorToSquareMatrix (fun k ↦ (y k : ℝ)) i j := by + rfl + +theorem cast_betheAffineMatrixQ {m : ℕ} + (y : Fin (m * m) → ℚ) (i j : Fin (m + 1)) : + ((betheAffineMatrixQ y i j : ℚ) : ℝ) = + birkhoffAffineMap (vectorToSquareMatrix + (fun k ↦ (y k : ℝ))) i j := by + refine Fin.lastCases ?_ (fun i ↦ ?_) i <;> + refine Fin.lastCases ?_ (fun j ↦ ?_) j + · simp [betheAffineMatrixQ, vectorToSquareMatrix] + · simp [betheAffineMatrixQ, vectorToSquareMatrix] + · simp [betheAffineMatrixQ, vectorToSquareMatrix] + · simp [betheAffineMatrixQ, vectorToSquareMatrix] + +/-- The stored rational value is a certified lower endpoint for the exact +negative regularized objective at every rational interior query. -/ +theorem betheDirectedEpigraphData_lower {m : ℕ} + {τ : ℚ} {A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ} + (hτ0 : 0 ≤ τ) (hτ1 : τ ≤ 1) (hA : ∀ i j, 0 < A i j) + {y : Fin (m * m) → ℚ} + (hX0 : ∀ i j, 0 < betheAffineMatrixQ y i j) + (hX1 : ∀ i j, betheAffineMatrixQ y i j < 1) (p : ℕ) : + ((betheDirectedEpigraphData τ A p).lower y : ℝ) ≤ + affineNegativeObjective (τ : ℝ) + (fun i j ↦ (A i j : ℝ)) + (vectorToSquareMatrix (fun k ↦ (y k : ℝ))) := by + have h := (directedNegativeObjective_bounds hτ0 hτ1 hA hX0 hX1 p).1 + simpa [betheDirectedEpigraphData, affineNegativeObjective, + cast_betheAffineMatrixQ] using h + +/-- The flattened stored gradient has the same explicit coordinate error as +the affine pullback matrix. -/ +theorem betheDirectedEpigraphData_gradient_error {m : ℕ} + {τ : ℚ} {A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ} + (hτ0 : 0 ≤ τ) (hτ1 : τ ≤ 1) (hA : ∀ i j, 0 < A i j) + {y : Fin (m * m) → ℚ} + (hX0 : ∀ i j, 0 < betheAffineMatrixQ y i j) + (hX1 : ∀ i j, betheAffineMatrixQ y i j < 1) (p : ℕ) + (k : Fin (m * m)) : + abs ((((betheDirectedEpigraphData τ A p).gradient y k : ℚ) : ℝ) - + squareMatrixToVector + (affinePullbackGradient + (negativeGradientMatrix (τ : ℝ) + (fun i j ↦ (A i j : ℝ)) + (fun i j ↦ ((betheAffineMatrixQ y i j : ℚ) : ℝ)))) k) ≤ + 16 * (((1 / 2 : ℚ) ^ p : ℚ) : ℝ) := by + let ij := finProdFinEquiv.symm k + simpa [betheDirectedEpigraphData, squareMatrixToVector, ij, + affinePullbackGradient, abs_sub_comm] using + directedAffineGradient_error hτ0 hτ1 hA hX0 hX1 p ij.1 ij.2 + +/-- Exact bounded epigraph body in flattened affine coordinates. -/ +def BetheEpigraphTarget {m : ℕ} + (τ : ℝ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℝ) + (δ upper : ℝ) (z : Fin (m * m + 1) → ℝ) : Prop := + let Y := vectorToSquareMatrix (epigraphBase z) + let X := birkhoffAffineMap Y + (∀ i j, δ ≤ X i j) ∧ + affineNegativeObjective τ A Y ≤ epigraphHeight z ∧ + epigraphHeight z ≤ upper + +theorem BetheEpigraphTarget_doublyStochastic {m : ℕ} + {τ : ℝ} {A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℝ} + {δ upper : ℝ} (hδ : 0 ≤ δ) {z : Fin (m * m + 1) → ℝ} + (hz : BetheEpigraphTarget τ A δ upper z) : + IsDoublyStochastic + (birkhoffAffineMap (vectorToSquareMatrix (epigraphBase z))) := by + let Y := vectorToSquareMatrix (epigraphBase z) + let X := birkhoffAffineMap Y + have hfloor : ∀ i j, δ ≤ X i j := by + simpa only [BetheEpigraphTarget, Y, X] using hz.1 + refine ⟨fun i j ↦ hδ.trans (hfloor i j), ?_, ?_⟩ + · exact birkhoffAffineMap_row_sum Y + · exact birkhoffAffineMap_col_sum Y + +/-- On the truncated rational domain, the concrete directed nonlinear oracle +returns only valid strict cuts for the exact Bethe epigraph. -/ +theorem betheDirectedEpigraphOracle_cut_valid {m : ℕ} (hm : 0 < m) + {τ : ℚ} {A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ} + (hτ0 : 0 ≤ τ) (hτ1 : τ ≤ 1) (hA : ∀ i j, 0 < A i j) + {δ : ℚ} (hδ : 0 < δ) {upper : ℝ} (p : ℕ) + (E : RationalEllipsoidState (m * m + 1)) + (hqueryFloor : ∀ i j, δ ≤ + betheAffineMatrixQ (epigraphBase E.center) i j) + {a : Fin (m * m + 1) → ℚ} + (hresponse : directedEpigraphOracle + (betheDirectedEpigraphData τ A p) + (16 * (1 / 2 : ℚ) ^ p) (m * m) E = .cut a) + {z : Fin (m * m + 1) → ℝ} + (hz : BetheEpigraphTarget (τ : ℝ) + (fun i j ↦ (A i j : ℝ)) (δ : ℝ) upper z) : + a ≠ 0 ∧ finiteDot (fun i ↦ (a i : ℝ)) + (fun i ↦ z i - rationalCenterReal E i) < 0 := by + let yq : Fin (m * m) → ℚ := epigraphBase E.center + let Yq : Matrix (Fin m) (Fin m) ℚ := vectorToSquareMatrix yq + let Xq : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ := + birkhoffAffineMap Yq + let Y : Matrix (Fin m) (Fin m) ℝ := + vectorToSquareMatrix (epigraphBase z) + let X : Matrix (Fin (m + 1)) (Fin (m + 1)) ℝ := + birkhoffAffineMap Y + have hqueryFloor' : ∀ i j, δ ≤ Xq i j := by + simpa only [Xq, Yq, yq, betheAffineMatrixQ] using hqueryFloor + have hquery := birkhoffAffineMap_interior hm hδ hqueryFloor' + have hXqDS := hquery.1 + have hXqInt := hquery.2 + have hXq0 : ∀ i j, 0 < Xq i j := by + intro i j + exact hδ.trans_le (hqueryFloor' i j) + have hXq1 : ∀ i j, Xq i j < 1 := by + intro i j + have h := (hXqInt i).2 j |>.2 + change ((Xq i j : ℚ) : ℝ) < 1 at h + exact_mod_cast h + have hδreal : 0 ≤ (δ : ℝ) := Rat.cast_nonneg.mpr hδ.le + have hXDS : IsDoublyStochastic X := by + simpa only [X, Y] using + BetheEpigraphTarget_doublyStochastic hδreal hz + have htargetFloor : ∀ i j, (δ : ℝ) ≤ X i j := by + simpa only [BetheEpigraphTarget, X, Y] using hz.1 + have htargetEpigraph : + affineNegativeObjective (τ : ℝ) (fun i j ↦ (A i j : ℝ)) Y ≤ + epigraphHeight z := by + simpa only [BetheEpigraphTarget, X, Y] using hz.2.1 + let YqR : Matrix (Fin m) (Fin m) ℝ := + fun i j ↦ (Yq i j : ℝ) + let Gm : Matrix (Fin m) (Fin m) ℝ := + affinePullbackGradient + (negativeGradientMatrix (τ : ℝ) (fun i j ↦ (A i j : ℝ)) + (fun i j ↦ (Xq i j : ℝ))) + let Gv : Fin (m * m) → ℝ := squareMatrixToVector Gm + have hcastXq : birkhoffAffineMap YqR = + (fun i j ↦ (Xq i j : ℝ)) := by + ext i j + symm + simpa only [Xq, Yq, YqR, yq] using cast_betheAffineMatrixQ yq i j + have hsupportMatrix := affineNegativeObjective_support hm + (Rat.cast_nonneg.mpr hτ0) + (A := fun i j ↦ (A i j : ℝ)) + (Y := YqR) (Z := Y) + (by rw [hcastXq]; exact hXqDS) + hXDS + (by rw [hcastXq]; exact hXqInt) + have hsupport : + affineNegativeObjective (τ : ℝ) (fun i j ↦ (A i j : ℝ)) YqR + + finiteDot Gv + (fun k ↦ epigraphBase z k - (yq k : ℝ)) ≤ + affineNegativeObjective (τ : ℝ) (fun i j ↦ (A i j : ℝ)) Y := by + have hDvec : + (fun k ↦ epigraphBase z k - (yq k : ℝ)) = + squareMatrixToVector (fun i j ↦ Y i j - YqR i j) := by + ext k + have hk : finProdFinEquiv (finProdFinEquiv.symm k) = k := + Equiv.apply_symm_apply finProdFinEquiv k + change epigraphBase z k - (yq k : ℝ) = + epigraphBase z (finProdFinEquiv (finProdFinEquiv.symm k)) - + (yq (finProdFinEquiv (finProdFinEquiv.symm k)) : ℝ) + rw [hk] + rw [hDvec, finiteDot_squareMatrixToVector] + simpa only [Gm, hcastXq] using hsupportMatrix + have hlower := betheDirectedEpigraphData_lower hτ0 hτ1 hA + (by simpa only [Xq, yq, betheAffineMatrixQ] using hXq0) + (by simpa only [Xq, yq, betheAffineMatrixQ] using hXq1) p + have hgradient : ∀ k, + abs ((((betheDirectedEpigraphData τ A p).gradient yq k : ℚ) : ℝ) - + Gv k) ≤ 16 * (((1 / 2 : ℚ) ^ p : ℚ) : ℝ) := by + intro k + simpa only [Gv, Gm, Xq, yq, betheAffineMatrixQ] using + betheDirectedEpigraphData_gradient_error hτ0 hτ1 hA hXq0 hXq1 p k + have hD : vectorL1 (fun k ↦ epigraphBase z k - (yq k : ℝ)) ≤ + (m * m : ℝ) := by + rw [vectorL1] + calc + (∑ k, abs (epigraphBase z k - (yq k : ℝ))) ≤ ∑ _k : Fin (m * m), 1 := by + apply Finset.sum_le_sum + intro k _ + let ij := finProdFinEquiv.symm k + have hk : finProdFinEquiv ij = k := by + simpa only [ij] using Equiv.apply_symm_apply finProdFinEquiv k + have hz0 : 0 ≤ epigraphBase z k := by + have := hXDS.nonnegative ij.1.castSucc ij.2.castSucc + simp only [X, Y, birkhoffAffineMap_castSucc_castSucc, + vectorToSquareMatrix] at this + rwa [hk] at this + have hz1 : epigraphBase z k ≤ 1 := by + have := hXDS.entry_le_one ij.1.castSucc ij.2.castSucc + simp only [X, Y, birkhoffAffineMap_castSucc_castSucc, + vectorToSquareMatrix] at this + rwa [hk] at this + have hq0 : 0 ≤ (yq k : ℝ) := by + have := hXqDS.nonnegative ij.1.castSucc ij.2.castSucc + simp only [Xq, Yq, birkhoffAffineMap_castSucc_castSucc, + vectorToSquareMatrix] at this + rwa [hk] at this + have hq1 : (yq k : ℝ) ≤ 1 := by + have := hXqDS.entry_le_one ij.1.castSucc ij.2.castSucc + simp only [Xq, Yq, birkhoffAffineMap_castSucc_castSucc, + vectorToSquareMatrix] at this + rwa [hk] at this + rw [abs_le] + constructor <;> linarith + _ = (m * m : ℝ) := by simp + apply directedEpigraphOracle_cut_valid + (data := betheDirectedEpigraphData τ A p) + (he := by positivity) E hresponse + (fY := affineNegativeObjective (τ : ℝ) + (fun i j ↦ (A i j : ℝ)) YqR) + (fZ := affineNegativeObjective (τ : ℝ) + (fun i j ↦ (A i j : ℝ)) Y) + (G := Gv) (z := z) + · simpa only [yq] using hsupport + · simpa only [yq, YqR] using hlower + · simpa only [yq, Rat.cast_mul, Rat.cast_pow, Rat.cast_div, + Rat.cast_one, Rat.cast_ofNat] using hgradient + · norm_num only [Rat.cast_mul, Rat.cast_natCast] + simpa only [yq] using hD + · exact htargetEpigraph + +/-- Matrix covector selecting one full Birkhoff coordinate. -/ +def matrixEntryCovector {n : ℕ} (i j : Fin n) : Matrix (Fin n) (Fin n) ℚ := + fun a b ↦ if a = i ∧ b = j then 1 else 0 + +/-- Normal for the exact lower-floor inequality at one recovered Birkhoff +entry. The last epigraph coordinate is zero. -/ +def betheFloorCutNormal {m : ℕ} (i j : Fin (m + 1)) : + Fin (m * m + 1) → ℚ := + Fin.snoc (fun k ↦ + -squareMatrixToVector + (affinePullbackGradient (matrixEntryCovector i j)) k) 0 + +@[simp] theorem betheFloorCutNormal_castSucc {m : ℕ} + (i j : Fin (m + 1)) (k : Fin (m * m)) : + betheFloorCutNormal i j k.castSucc = + -squareMatrixToVector + (affinePullbackGradient (matrixEntryCovector i j)) k := by + simp [betheFloorCutNormal] + +@[simp] theorem betheFloorCutNormal_last {m : ℕ} + (i j : Fin (m + 1)) : + betheFloorCutNormal i j (Fin.last (m * m)) = 0 := by + simp [betheFloorCutNormal] + +theorem affinePullback_entryCovector_ne_zero {m : ℕ} (hm : 0 < m) + (i j : Fin (m + 1)) : + affinePullbackGradient (matrixEntryCovector i j) ≠ 0 := by + let k0 : Fin m := ⟨0, hm⟩ + refine Fin.lastCases ?_ (fun i ↦ ?_) i <;> + refine Fin.lastCases ?_ (fun j ↦ ?_) j + · intro hzero + have h := congrFun (congrFun hzero k0) k0 + simp [affinePullbackGradient, matrixEntryCovector] at h + · intro hzero + have h := congrFun (congrFun hzero k0) j + have hne : Fin.last m ≠ j.castSucc := (Fin.castSucc_ne_last j).symm + simp [affinePullbackGradient, matrixEntryCovector, hne] at h + · intro hzero + have h := congrFun (congrFun hzero i) k0 + have hne : Fin.last m ≠ i.castSucc := (Fin.castSucc_ne_last i).symm + simp [affinePullbackGradient, matrixEntryCovector, hne] at h + · intro hzero + have h := congrFun (congrFun hzero i) j + have hnei : Fin.last m ≠ i.castSucc := (Fin.castSucc_ne_last i).symm + have hnej : Fin.last m ≠ j.castSucc := (Fin.castSucc_ne_last j).symm + simp [affinePullbackGradient, matrixEntryCovector, hnei, hnej] at h + +theorem betheFloorCutNormal_ne_zero {m : ℕ} (hm : 0 < m) + (i j : Fin (m + 1)) : betheFloorCutNormal i j ≠ 0 := by + intro hzero + apply affinePullback_entryCovector_ne_zero hm i j + have hvec : squareMatrixToVector + (affinePullbackGradient (matrixEntryCovector i j)) = 0 := by + ext k + have h := congrFun hzero k.castSucc + rw [betheFloorCutNormal_castSucc] at h + simp only [Pi.zero_apply] at h + exact neg_eq_zero.mp h + exact squareMatrixToVector_injective hvec + +/-- Fixed deterministic order of all recovered matrix entries. -/ +def fullMatrixEntryList (m : ℕ) : List (Fin (m + 1) × Fin (m + 1)) := + (List.ofFn fun i : Fin (m + 1) ↦ i).flatMap fun i ↦ + (List.ofFn fun j : Fin (m + 1) ↦ j).map fun j ↦ (i, j) + +theorem mem_fullMatrixEntryList (m : ℕ) (i j : Fin (m + 1)) : + (i, j) ∈ fullMatrixEntryList m := by + rw [fullMatrixEntryList, List.mem_flatMap] + refine ⟨i, (List.mem_ofFn).2 ⟨i, rfl⟩, ?_⟩ + rw [List.mem_map] + exact ⟨j, (List.mem_ofFn).2 ⟨j, rfl⟩, rfl⟩ + +def firstBetheFloorViolation {m : ℕ} (δ : ℚ) + (y : Fin (m * m) → ℚ) : + List (Fin (m + 1) × Fin (m + 1)) → + Option (Fin (m + 1) × Fin (m + 1)) + | [] => none + | ij :: entries => + if betheAffineMatrixQ y ij.1 ij.2 < δ then some ij + else firstBetheFloorViolation δ y entries + +def firstBetheFloorViolationAll {m : ℕ} (δ : ℚ) + (y : Fin (m * m) → ℚ) : Option (Fin (m + 1) × Fin (m + 1)) := + firstBetheFloorViolation δ y (fullMatrixEntryList m) + +theorem firstBetheFloorViolation_is_below {m : ℕ} {δ : ℚ} + {y : Fin (m * m) → ℚ} + {entries : List (Fin (m + 1) × Fin (m + 1))} {ij} + (hfind : firstBetheFloorViolation δ y entries = some ij) : + betheAffineMatrixQ y ij.1 ij.2 < δ := by + induction entries with + | nil => simp [firstBetheFloorViolation] at hfind + | cons ab entries ih => + rw [firstBetheFloorViolation] at hfind + split at hfind <;> rename_i htest + · cases hfind + exact htest + · exact ih hfind + +theorem firstBetheFloorViolation_eq_none_iff {m : ℕ} (δ : ℚ) + (y : Fin (m * m) → ℚ) + (entries : List (Fin (m + 1) × Fin (m + 1))) : + firstBetheFloorViolation δ y entries = none ↔ + ∀ ij ∈ entries, δ ≤ betheAffineMatrixQ y ij.1 ij.2 := by + induction entries with + | nil => simp [firstBetheFloorViolation] + | cons ab entries ih => + rw [firstBetheFloorViolation] + split <;> rename_i htest + · constructor + · intro hnone + contradiction + · intro hall + exact ((not_lt_of_ge (hall ab (by simp))) htest).elim + · rw [ih] + have hab : δ ≤ betheAffineMatrixQ y ab.1 ab.2 := not_lt.mp htest + simp [hab] + +theorem firstBetheFloorViolationAll_eq_none_iff {m : ℕ} (δ : ℚ) + (y : Fin (m * m) → ℚ) : + firstBetheFloorViolationAll δ y = none ↔ + ∀ i j, δ ≤ betheAffineMatrixQ y i j := by + rw [firstBetheFloorViolationAll, + firstBetheFloorViolation_eq_none_iff] + constructor + · intro h i j + exact h (i, j) (mem_fullMatrixEntryList m i j) + · intro h ij _ + exact h ij.1 ij.2 + +theorem matrixPairing_entryCovector {n : ℕ} (i j : Fin n) + (D : Matrix (Fin n) (Fin n) ℝ) : + matrixPairing (fun a b ↦ (matrixEntryCovector i j a b : ℝ)) D = D i j := by + rw [matrixPairing] + have hrow : ∀ a : Fin n, + (∑ b, (matrixEntryCovector i j a b : ℝ) * D a b) = + if a = i then D i j else 0 := by + intro a + by_cases hai : a = i + · subst a + simp only [if_true] + calc + (∑ b, (matrixEntryCovector i j i b : ℝ) * D i b) = + (matrixEntryCovector i j i j : ℝ) * D i j := by + apply Finset.sum_eq_single j + · intro b _ hbj + simp [matrixEntryCovector, hbj] + · simp + _ = D i j := by simp [matrixEntryCovector] + · simp [matrixEntryCovector, hai] + simp_rw [hrow] + simp + +/-- A detected floor violation gives a strict cut for every target point +whose recovered matrix satisfies the floor. -/ +theorem betheFloorCut_valid {m : ℕ} {δ : ℚ} + {y : Fin (m * m) → ℚ} {i j : Fin (m + 1)} + (hbelow : betheAffineMatrixQ y i j < δ) + {z : Fin (m * m + 1) → ℝ} + (hfloor : (δ : ℝ) ≤ + birkhoffAffineMap (vectorToSquareMatrix (epigraphBase z)) i j) : + finiteDot (fun k ↦ (betheFloorCutNormal i j k : ℝ)) + (fun k ↦ z k - + (((Fin.snoc y (0 : ℚ) : Fin (m * m + 1) → ℚ) k : ℚ) : ℝ)) < 0 := by + let Yq : Matrix (Fin m) (Fin m) ℝ := + vectorToSquareMatrix (fun k ↦ (y k : ℝ)) + let Y : Matrix (Fin m) (Fin m) ℝ := + vectorToSquareMatrix (epigraphBase z) + let Gq : Matrix (Fin (m + 1)) (Fin (m + 1)) ℝ := + fun a b ↦ (matrixEntryCovector i j a b : ℝ) + have hadjoint := matrixPairing_affineMap_sub Gq Yq Y + have hentry : + birkhoffAffineMap Y i j - birkhoffAffineMap Yq i j = + matrixPairing + (affinePullbackGradient Gq) (fun a b ↦ Y a b - Yq a b) := by + rw [← hadjoint, matrixPairing_entryCovector] + have hqueryCast : birkhoffAffineMap Yq i j = + (betheAffineMatrixQ y i j : ℝ) := by + symm + exact cast_betheAffineMatrixQ y i j + have hstrict : 0 < birkhoffAffineMap Y i j - birkhoffAffineMap Yq i j := by + rw [hqueryCast] + have hbelowR : (betheAffineMatrixQ y i j : ℝ) < (δ : ℝ) := by + exact_mod_cast hbelow + linarith + have hpullCast : + (fun a b ↦ + ((affinePullbackGradient (matrixEntryCovector i j) a b : ℚ) : ℝ)) = + affinePullbackGradient Gq := by + ext a b + simp [Gq, affinePullbackGradient, matrixEntryCovector] + have hnormalCast : + (fun k ↦ ((-squareMatrixToVector + (affinePullbackGradient (matrixEntryCovector i j)) k : ℚ) : ℝ)) = + fun k ↦ -squareMatrixToVector (affinePullbackGradient Gq) k := by + ext k + rw [Rat.cast_neg] + congr 1 + have hk := congrFun (congrArg squareMatrixToVector hpullCast) k + exact hk + have hdotBase : + finiteDot + (fun k ↦ ((-squareMatrixToVector + (affinePullbackGradient (matrixEntryCovector i j)) k : ℚ) : ℝ)) + (fun k ↦ epigraphBase z k - (y k : ℝ)) = + -matrixPairing (affinePullbackGradient Gq) + (fun a b ↦ Y a b - Yq a b) := by + have hDvec : (fun k ↦ epigraphBase z k - (y k : ℝ)) = + squareMatrixToVector (fun a b ↦ Y a b - Yq a b) := by + ext k + have hk : finProdFinEquiv (finProdFinEquiv.symm k) = k := + Equiv.apply_symm_apply finProdFinEquiv k + change epigraphBase z k - (y k : ℝ) = + epigraphBase z (finProdFinEquiv (finProdFinEquiv.symm k)) - + (y (finProdFinEquiv (finProdFinEquiv.symm k)) : ℝ) + rw [hk] + rw [hDvec, hnormalCast] + rw [finiteDot] + simp_rw [neg_mul, Finset.sum_neg_distrib] + rw [← finiteDot, finiteDot_squareMatrixToVector] + rw [finiteDot, Fin.sum_univ_castSucc] + simp only [betheFloorCutNormal_castSucc, betheFloorCutNormal_last, + Rat.cast_neg, Rat.cast_zero, zero_mul, add_zero, Fin.snoc_last, + Fin.snoc_castSucc] + rw [finiteDot] at hdotBase + norm_num only [Rat.cast_neg] at hdotBase + simp only [epigraphBase] at hdotBase + rw [hdotBase, ← hentry] + linarith + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/BetheEpigraphFeasibility.lean b/LeanPool/BeyondBethe/BeyondBethe/BetheEpigraphFeasibility.lean new file mode 100644 index 0000000000..1cf8b64319 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/BetheEpigraphFeasibility.lean @@ -0,0 +1,270 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.BetheEpigraph +import Mathlib.Tactic + +/-! # Bethe Epigraph Feasibility -/ + +open scoped BigOperators + +namespace BeyondBethe + +/-! +# A complete executable oracle for the bounded Bethe epigraph + +The oracle first enforces every entry floor exactly, then the rational height +cap, and only then invokes the directed elementary-function oracle. This +ordering makes every logarithm query legal and leaves no domain condition as +an oracle hypothesis. +-/ + +/-- Normal of the upper bound on the last, epigraph-height coordinate. -/ +def epigraphUpperNormal (d : ℕ) : Fin (d + 1) → ℚ := + Fin.snoc 0 1 + +theorem epigraphUpperNormal_ne_zero (d : ℕ) : + epigraphUpperNormal d ≠ 0 := by + intro hzero + have h := congrFun hzero (Fin.last d) + norm_num [epigraphUpperNormal] at h + +theorem epigraphUpperNormal_dot_displacement {d : ℕ} + (z : Fin (d + 1) → ℝ) (q : Fin (d + 1) → ℚ) : + finiteDot (fun k ↦ (epigraphUpperNormal d k : ℝ)) + (fun k ↦ z k - (q k : ℝ)) = + epigraphHeight z - (epigraphHeight q : ℚ) := by + rw [finiteDot, Fin.sum_univ_castSucc] + simp [epigraphUpperNormal, epigraphHeight] + +/-- Complete rational oracle for a height-bounded, floor-truncated Bethe +epigraph. -/ +def betheBoundedEpigraphOracle {m : ℕ} + (τ : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (p : ℕ) (δ upper : ℚ) : RationalCentralOracle (m * m + 1) := + fun E ↦ + match firstBetheFloorViolationAll δ (epigraphBase E.center) with + | some ij => .cut (betheFloorCutNormal ij.1 ij.2) + | none => + if upper < epigraphHeight E.center then + .cut (epigraphUpperNormal (m * m)) + else + directedEpigraphOracle + (betheDirectedEpigraphData τ A p) + (16 * (1 / 2 : ℚ) ^ p) (m * m) E + +/-- Exact rational facts obtained whenever the complete oracle accepts. -/ +def BetheEpigraphOracleAccepted {m : ℕ} + (τ : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (p : ℕ) (δ upper : ℚ) (q : Fin (m * m + 1) → ℚ) : Prop := + (∀ i j, δ ≤ betheAffineMatrixQ (epigraphBase q) i j) ∧ + epigraphHeight q ≤ upper ∧ + (betheDirectedEpigraphData τ A p).lower (epigraphBase q) ≤ + epigraphHeight q + (16 * (1 / 2 : ℚ) ^ p) * (m * m) + +/-- Full rational objective-evaluation loss charged on acceptance. -/ +def betheObjectiveEvaluationError (m p : ℕ) : ℚ := + 16 * (1 / 2 : ℚ) ^ p * (m * m) + + 3 * (m + 1) ^ 2 * (1 / 2 : ℚ) ^ p + +theorem betheObjectiveEvaluationError_nonneg (m p : ℕ) : + 0 ≤ betheObjectiveEvaluationError m p := by + rw [betheObjectiveEvaluationError] + positivity + +/-- Real matrix encoded by the base coordinates of an accepted epigraph +point. -/ +def acceptedBetheMatrix {m : ℕ} (q : Fin (m * m + 1) → ℚ) : + Matrix (Fin (m + 1)) (Fin (m + 1)) ℝ := + birkhoffAffineMap + (vectorToSquareMatrix (fun k ↦ ((epigraphBase q k : ℚ) : ℝ))) + +/-- The exact floor tests and affine recovery identities make every accepted +matrix doubly stochastic. -/ +theorem BetheEpigraphOracleAccepted_doublyStochastic {m : ℕ} + {τ : ℚ} {A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ} + {p : ℕ} {δ upper : ℚ} (hδ : 0 ≤ δ) + {q : Fin (m * m + 1) → ℚ} + (haccepted : BetheEpigraphOracleAccepted τ A p δ upper q) : + IsDoublyStochastic (acceptedBetheMatrix q) := by + refine ⟨?_, birkhoffAffineMap_row_sum _, birkhoffAffineMap_col_sum _⟩ + intro i j + have hfloorQ := haccepted.1 i j + have hfloor : (δ : ℝ) ≤ acceptedBetheMatrix q i j := by + change (δ : ℝ) ≤ birkhoffAffineMap + (vectorToSquareMatrix (fun k ↦ ((epigraphBase q k : ℚ) : ℝ))) i j + rw [← cast_betheAffineMatrixQ (epigraphBase q) i j] + exact_mod_cast hfloorQ + exact (Rat.cast_nonneg.mpr hδ).trans hfloor + +theorem BetheEpigraphOracleAccepted_entry_floor {m : ℕ} + {τ : ℚ} {A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ} + {p : ℕ} {δ upper : ℚ} + {q : Fin (m * m + 1) → ℚ} + (haccepted : BetheEpigraphOracleAccepted τ A p δ upper q) : + ∀ i j, (δ : ℝ) ≤ acceptedBetheMatrix q i j := by + intro i j + change (δ : ℝ) ≤ birkhoffAffineMap + (vectorToSquareMatrix (fun k ↦ ((epigraphBase q k : ℚ) : ℝ))) i j + rw [← cast_betheAffineMatrixQ (epigraphBase q) i j] + exact_mod_cast haccepted.1 i j + +/-- Every cut returned by the complete executable oracle is valid for the +exact bounded epigraph. -/ +theorem betheBoundedEpigraphOracle_valid {m : ℕ} (hm : 0 < m) + {τ : ℚ} {A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ} + (hτ0 : 0 ≤ τ) (hτ1 : τ ≤ 1) (hA : ∀ i j, 0 < A i j) + {δ : ℚ} (hδ : 0 < δ) (p : ℕ) (upper : ℚ) : + RationalCentralOracleValid + (BetheEpigraphTarget (τ : ℝ) (fun i j ↦ (A i j : ℝ)) + (δ : ℝ) (upper : ℝ)) + (betheBoundedEpigraphOracle τ A p δ upper) := by + intro E a hresponse + rw [betheBoundedEpigraphOracle] at hresponse + split at hresponse <;> rename_i hfloorScan + · rename_i ij + cases hresponse + refine ⟨betheFloorCutNormal_ne_zero hm ij.1 ij.2, ?_⟩ + intro z hz + have hbelow : betheAffineMatrixQ (epigraphBase E.center) + ij.1 ij.2 < δ := by + apply firstBetheFloorViolation_is_below + simpa only [firstBetheFloorViolationAll] using hfloorScan + have htargetFloor : (δ : ℝ) ≤ + birkhoffAffineMap + (vectorToSquareMatrix (epigraphBase z)) ij.1 ij.2 := by + simpa only [BetheEpigraphTarget] using hz.1 ij.1 ij.2 + have hcut := betheFloorCut_valid hbelow htargetFloor + rw [finiteDot, Fin.sum_univ_castSucc] at hcut ⊢ + simpa [rationalCenterReal, epigraphBase] using hcut.le + · split at hresponse <;> rename_i hheight + · cases hresponse + refine ⟨epigraphUpperNormal_ne_zero (m * m), ?_⟩ + intro z hz + have hdot := epigraphUpperNormal_dot_displacement z E.center + rw [show finiteDot + (fun i ↦ (epigraphUpperNormal (m * m) i : ℝ)) + (fun i ↦ z i - rationalCenterReal E i) = + epigraphHeight z - (epigraphHeight E.center : ℚ) by + simpa only [rationalCenterReal] using hdot] + have hzUpper : epigraphHeight z ≤ (upper : ℝ) := by + simpa only [BetheEpigraphTarget] using hz.2.2 + have hheightReal : (upper : ℝ) < + ((epigraphHeight E.center : ℚ) : ℝ) := by + exact_mod_cast hheight + linarith + · have hqueryFloor : ∀ i j, δ ≤ + betheAffineMatrixQ (epigraphBase E.center) i j := + (firstBetheFloorViolationAll_eq_none_iff δ + (epigraphBase E.center)).mp hfloorScan + refine ⟨directedEpigraphOracle_cut_ne_zero + (betheDirectedEpigraphData τ A p) + (16 * (1 / 2 : ℚ) ^ p) (m * m) E hresponse, ?_⟩ + intro z hz + exact (betheDirectedEpigraphOracle_cut_valid hm hτ0 hτ1 hA hδ + (upper := (upper : ℝ)) p E hqueryFloor hresponse hz).2.le + +/-- Acceptance of the complete oracle certifies every rational test in its +three branches. -/ +theorem betheBoundedEpigraphOracle_acceptsOnly {m : ℕ} + (τ : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (p : ℕ) (δ upper : ℚ) : + RationalCentralOracleAcceptsOnly + (BetheEpigraphOracleAccepted τ A p δ upper) + (betheBoundedEpigraphOracle τ A p δ upper) := by + intro E hresponse + rw [betheBoundedEpigraphOracle] at hresponse + split at hresponse <;> rename_i hfloorScan + · contradiction + · split at hresponse <;> rename_i hheight + · contradiction + · rw [directedEpigraphOracle] at hresponse + split at hresponse <;> rename_i hnonlinear + · contradiction + · cases hresponse + refine ⟨ + (firstBetheFloorViolationAll_eq_none_iff δ + (epigraphBase E.center)).mp hfloorScan, + not_lt.mp hheight, ?_⟩ + exact not_lt.mp hnonlinear + +/-- Acceptance controls the exact negative objective, not merely its directed +lower endpoint. The first error term is the safety margin in the nonlinear +cut test; the second is the full width of the directed objective interval. +Keeping both terms explicit prevents a one-sided-evaluation gap in the weak +optimization proof. -/ +theorem BetheEpigraphOracleAccepted_exact_objective_upper {m : ℕ} + (hm : 0 < m) {τ : ℚ} + {A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ} + (hτ0 : 0 ≤ τ) (hτ1 : τ ≤ 1) (hA : ∀ i j, 0 < A i j) + {p : ℕ} {δ upper : ℚ} (hδ : 0 < δ) + {q : Fin (m * m + 1) → ℚ} + (haccepted : BetheEpigraphOracleAccepted τ A p δ upper q) : + affineNegativeObjective (τ : ℝ) (fun i j ↦ (A i j : ℝ)) + (vectorToSquareMatrix + (fun k ↦ ((epigraphBase q k : ℚ) : ℝ))) ≤ + ((epigraphHeight q : ℚ) : ℝ) + + ((16 * (1 / 2 : ℚ) ^ p * (m * m) : ℚ) : ℝ) + + 3 * ((m + 1 : ℕ) : ℝ) ^ 2 * + (((1 / 2 : ℚ) ^ p : ℚ) : ℝ) := by + let y : Fin (m * m) → ℚ := epigraphBase q + let Xq : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ := + betheAffineMatrixQ y + have hfloor : ∀ i j, δ ≤ Xq i j := by + simpa only [Xq, y] using haccepted.1 + have hX0 : ∀ i j, 0 < Xq i j := fun i j ↦ + hδ.trans_le (hfloor i j) + have hinterior := birkhoffAffineMap_interior hm hδ + (Y := vectorToSquareMatrix y) (by + simpa only [Xq, betheAffineMatrixQ] using hfloor) + have hX1 : ∀ i j, Xq i j < 1 := by + intro i j + have h := (hinterior.2 i).2 j |>.2 + change ((Xq i j : ℚ) : ℝ) < 1 at h + exact_mod_cast h + have hbounds := directedNegativeObjective_bounds hτ0 hτ1 hA hX0 hX1 p + have hlowerAcceptedQ : + directedNegativeObjectiveLower τ A Xq p ≤ + epigraphHeight q + 16 * (1 / 2 : ℚ) ^ p * (m * m) := by + simpa only [BetheEpigraphOracleAccepted, + betheDirectedEpigraphData, Xq, y] using haccepted.2.2 + have hlowerAccepted : + (directedNegativeObjectiveLower τ A Xq p : ℝ) ≤ + ((epigraphHeight q : ℚ) : ℝ) + + ((16 * (1 / 2 : ℚ) ^ p * (m * m) : ℚ) : ℝ) := by + exact_mod_cast hlowerAcceptedQ + have hcast : + birkhoffAffineMap + (vectorToSquareMatrix + (fun k ↦ ((epigraphBase q k : ℚ) : ℝ))) = + fun i j ↦ ((Xq i j : ℚ) : ℝ) := by + ext i j + symm + simpa only [Xq, y] using cast_betheAffineMatrixQ y i j + rw [affineNegativeObjective, hcast] + linarith [hbounds.2.1, hbounds.2.2] + +theorem BetheEpigraphOracleAccepted_exact_objective_upper_compact {m : ℕ} + (hm : 0 < m) {τ : ℚ} + {A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ} + (hτ0 : 0 ≤ τ) (hτ1 : τ ≤ 1) (hA : ∀ i j, 0 < A i j) + {p : ℕ} {δ upper : ℚ} (hδ : 0 < δ) + {q : Fin (m * m + 1) → ℚ} + (haccepted : BetheEpigraphOracleAccepted τ A p δ upper q) : + affineNegativeObjective (τ : ℝ) (fun i j ↦ (A i j : ℝ)) + (vectorToSquareMatrix + (fun k ↦ ((epigraphBase q k : ℚ) : ℝ))) ≤ + ((epigraphHeight q : ℚ) : ℝ) + + (betheObjectiveEvaluationError m p : ℝ) := by + have h := BetheEpigraphOracleAccepted_exact_objective_upper + hm hτ0 hτ1 hA hδ haccepted + rw [betheObjectiveEvaluationError] + norm_num only [Rat.cast_add, Rat.cast_mul, Rat.cast_pow, Rat.cast_div, + Rat.cast_one, Rat.cast_ofNat, Rat.cast_natCast, Nat.cast_add, + Nat.cast_one, Nat.cast_mul, Nat.cast_pow] at h ⊢ + linarith + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/BetheEpigraphGeometry.lean b/LeanPool/BeyondBethe/BeyondBethe/BetheEpigraphGeometry.lean new file mode 100644 index 0000000000..e39324fffd --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/BetheEpigraphGeometry.lean @@ -0,0 +1,767 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.BetheEpigraphFeasibility +import LeanPool.BeyondBethe.BeyondBethe.ExecutableInterior +import LeanPool.BeyondBethe.BeyondBethe.ApproximateKKT +import Mathlib.Tactic + +/-! # Bethe Epigraph Geometry -/ + +open scoped BigOperators + +namespace BeyondBethe + +/-! +# Explicit geometry of the truncated Bethe epigraph + +This file supplies the quantitative geometry needed by the rational +ellipsoid routine. In particular, it records an ordinary binary-input range +bound and exact formulas for one-coordinate perturbations in the flattened +Birkhoff affine coordinates. +-/ + +/-- A polynomially encoded global range for the regularized objective on the +Birkhoff polytope of a normalized positive rational matrix. -/ +def rationalRegularizedObjectiveRange {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) : ℚ := + n * rationalMatrixEntryBitBound A + 3 * n ^ 2 + +theorem rationalRegularizedObjectiveRange_nonneg {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) : + 0 ≤ rationalRegularizedObjectiveRange A := by + rw [rationalRegularizedObjectiveRange] + positivity + +/-- The displayed rational range bounds the difference between the objective +at any two doubly stochastic matrices. -/ +theorem regularizedBetheObjective_sub_le_rationalRange + {n : ℕ} (hn : 1 ≤ n) {τ : ℚ} (hτ0 : 0 ≤ τ) (hτ1 : τ ≤ 1) + {A : Matrix (Fin n) (Fin n) ℚ} + (hApos : ∀ i j, 0 < A i j) (hAupper : ∀ i j, A i j ≤ 1) + {X Z : Matrix (Fin n) (Fin n) ℝ} + (hX : IsDoublyStochastic X) (hZ : IsDoublyStochastic Z) : + regularizedBetheObjective (τ : ℝ) (fun i j ↦ (A i j : ℝ)) X - + regularizedBetheObjective (τ : ℝ) (fun i j ↦ (A i j : ℝ)) Z ≤ + (rationalRegularizedObjectiveRange A : ℝ) := by + letI : Nonempty (Fin n) := Fin.pos_iff_nonempty.mp (by omega) + let B := rationalMatrixEntryBitBound A + let m : ℚ := (1 / 2 : ℚ) ^ B + have hmQ : 0 < m := by positivity + have hm : 0 < (m : ℝ) := Rat.cast_pos.mpr hmQ + have hAlower : ∀ i j, (m : ℝ) ≤ (A i j : ℝ) := by + intro i j + exact_mod_cast (matrix_dyadic_bitBound_lt_entry hApos i j).le + have hAposR : Matrix.Positive (fun i j ↦ (A i j : ℝ)) := by + intro i j + exact Rat.cast_pos.mpr (hApos i j) + have hAupperR : ∀ i j, (A i j : ℝ) ≤ 1 := by + intro i j + exact_mod_cast hAupper i j + have hentropyX0 := totalRowEntropy_nonneg hX + have hentropyZ0 := totalRowEntropy_nonneg hZ + have hentropyX := totalRowEntropy_le hX + have hlogn : Real.log n ≤ (n : ℝ) := by + have hlog := log_natCast_le_natCast_mul_log_two hn + have hlog2 : Real.log 2 ≤ 1 := by + have h := Real.log_le_sub_one_of_pos (x := (2 : ℝ)) (by norm_num) + norm_num at h + exact h + have hn0 : 0 ≤ (n : ℝ) := by positivity + nlinarith + have hentropyX' : totalRowEntropy X ≤ (n : ℝ) ^ 2 := by + simp only [Fintype.card_fin] at hentropyX + have hn0 : 0 ≤ (n : ℝ) := by positivity + nlinarith + have hbetheUpper := betheObjective_le_totalRowEntropy + hAposR hAupperR hX + have hbetheLower := betheObjective_lower_of_entry_lower hm hAlower hZ + simp only [Fintype.card_fin] at hbetheLower + have hτ0R : 0 ≤ (τ : ℝ) := Rat.cast_nonneg.mpr hτ0 + have hτ1R : (τ : ℝ) ≤ 1 := by exact_mod_cast hτ1 + have hregUpper : + regularizedBetheObjective (τ : ℝ) + (fun i j ↦ (A i j : ℝ)) X ≤ 2 * (n : ℝ) ^ 2 := by + rw [regularizedBetheObjective] + have hτEntropy : (τ : ℝ) * totalRowEntropy X ≤ totalRowEntropy X := + mul_le_of_le_one_left hentropyX0 hτ1R + linarith + have hregLower : + (n : ℝ) * Real.log (m : ℝ) - n ≤ + regularizedBetheObjective (τ : ℝ) + (fun i j ↦ (A i j : ℝ)) Z := by + rw [regularizedBetheObjective] + have hτEntropy : 0 ≤ (τ : ℝ) * totalRowEntropy Z := + mul_nonneg hτ0R hentropyZ0 + linarith + have hlogm : Real.log (m : ℝ) = -(B : ℝ) * Real.log 2 := by + simp only [m, Rat.cast_pow, Rat.cast_div, Rat.cast_one, Rat.cast_ofNat] + rw [Real.log_pow] + rw [show (1 / 2 : ℝ) = (2 : ℝ)⁻¹ by norm_num, Real.log_inv] + ring + have hlog2 : Real.log 2 ≤ 1 := by + have h := Real.log_le_sub_one_of_pos (x := (2 : ℝ)) (by norm_num) + norm_num at h + exact h + have hB0 : 0 ≤ (B : ℝ) := by positivity + have hnR : (1 : ℝ) ≤ n := by exact_mod_cast hn + rw [rationalRegularizedObjectiveRange] + push_cast + rw [hlogm] at hregLower + nlinarith [mul_le_mul_of_nonneg_left hlog2 hB0] + +/-- Explicit absolute bounds on the negative regularized objective. These +give rational endpoints for bisection without evaluating a logarithm. -/ +theorem negativeRegularizedBetheObjective_rational_bounds + {n : ℕ} (hn : 1 ≤ n) {τ : ℚ} (hτ0 : 0 ≤ τ) (hτ1 : τ ≤ 1) + {A : Matrix (Fin n) (Fin n) ℚ} + (hApos : ∀ i j, 0 < A i j) (hAupper : ∀ i j, A i j ≤ 1) + {X : Matrix (Fin n) (Fin n) ℝ} + (hX : IsDoublyStochastic X) : + ((-(2 * n ^ 2 : ℚ) : ℚ) : ℝ) ≤ + -regularizedBetheObjective (τ : ℝ) + (fun i j ↦ (A i j : ℝ)) X ∧ + -regularizedBetheObjective (τ : ℝ) + (fun i j ↦ (A i j : ℝ)) X ≤ + ((n * rationalMatrixEntryBitBound A + n : ℕ) : ℝ) := by + letI : Nonempty (Fin n) := Fin.pos_iff_nonempty.mp (by omega) + let B := rationalMatrixEntryBitBound A + let a : ℚ := (1 / 2 : ℚ) ^ B + have haQ : 0 < a := by positivity + have ha : 0 < (a : ℝ) := Rat.cast_pos.mpr haQ + have hAlower : ∀ i j, (a : ℝ) ≤ (A i j : ℝ) := by + intro i j + exact_mod_cast (matrix_dyadic_bitBound_lt_entry hApos i j).le + have hAposR : Matrix.Positive (fun i j ↦ (A i j : ℝ)) := by + intro i j + exact Rat.cast_pos.mpr (hApos i j) + have hAupperR : ∀ i j, (A i j : ℝ) ≤ 1 := by + intro i j + exact_mod_cast hAupper i j + have hentropy0 := totalRowEntropy_nonneg hX + have hentropy := totalRowEntropy_le hX + have hlogn : Real.log n ≤ (n : ℝ) := by + have hlog := log_natCast_le_natCast_mul_log_two hn + have hlog2 : Real.log 2 ≤ 1 := by + have h := Real.log_le_sub_one_of_pos (x := (2 : ℝ)) (by norm_num) + norm_num at h + exact h + have hn0 : 0 ≤ (n : ℝ) := by positivity + nlinarith + have hentropy' : totalRowEntropy X ≤ (n : ℝ) ^ 2 := by + simp only [Fintype.card_fin] at hentropy + have hn0 : 0 ≤ (n : ℝ) := by positivity + nlinarith + have hbetheUpper := betheObjective_le_totalRowEntropy + hAposR hAupperR hX + have hbetheLower := betheObjective_lower_of_entry_lower ha hAlower hX + simp only [Fintype.card_fin] at hbetheLower + have hτ0R : 0 ≤ (τ : ℝ) := Rat.cast_nonneg.mpr hτ0 + have hτ1R : (τ : ℝ) ≤ 1 := by exact_mod_cast hτ1 + have hregUpper : + regularizedBetheObjective (τ : ℝ) + (fun i j ↦ (A i j : ℝ)) X ≤ 2 * (n : ℝ) ^ 2 := by + rw [regularizedBetheObjective] + have hτEntropy : (τ : ℝ) * totalRowEntropy X ≤ totalRowEntropy X := + mul_le_of_le_one_left hentropy0 hτ1R + linarith + have hregLower : + (n : ℝ) * Real.log (a : ℝ) - n ≤ + regularizedBetheObjective (τ : ℝ) + (fun i j ↦ (A i j : ℝ)) X := by + rw [regularizedBetheObjective] + have hτEntropy : 0 ≤ (τ : ℝ) * totalRowEntropy X := + mul_nonneg hτ0R hentropy0 + linarith + have hloga : Real.log (a : ℝ) = -(B : ℝ) * Real.log 2 := by + simp only [a, Rat.cast_pow, Rat.cast_div, Rat.cast_one, Rat.cast_ofNat] + rw [Real.log_pow] + rw [show (1 / 2 : ℝ) = (2 : ℝ)⁻¹ by norm_num, Real.log_inv] + ring + have hlog2 : Real.log 2 ≤ 1 := by + have h := Real.log_le_sub_one_of_pos (x := (2 : ℝ)) (by norm_num) + norm_num at h + exact h + have hB0 : 0 ≤ (B : ℝ) := by positivity + rw [hloga] at hregLower + constructor + · push_cast + linarith + · push_cast + nlinarith [mul_le_mul_of_nonneg_left hlog2 hB0] + +/-- A vector with a single nonzero coordinate. -/ +def coordinateSpike {d : ℕ} {R : Type*} [Zero R] + (k : Fin d) (r : R) : Fin d → R := + fun i ↦ if i = k then r else 0 + +@[simp] theorem coordinateSpike_apply_self {d : ℕ} {R : Type*} [Zero R] + (k : Fin d) (r : R) : coordinateSpike k r k = r := by + simp [coordinateSpike] + +theorem vectorL1_coordinateSpike {d : ℕ} (k : Fin d) (r : ℝ) : + vectorL1 (coordinateSpike k r) = abs r := by + classical + rw [vectorL1, Finset.sum_eq_single k] + · simp [coordinateSpike] + · intro b _ hbk + simp [coordinateSpike, hbk] + · simp + +/-- Package a base vector and a height into one epigraph point. -/ +def epigraphPoint {d : ℕ} {R : Type*} + (y : Fin d → R) (s : R) : Fin (d + 1) → R := + Fin.snoc y s + +@[simp] theorem epigraphBase_epigraphPoint {d : ℕ} {R : Type*} + (y : Fin d → R) (s : R) : epigraphBase (epigraphPoint y s) = y := by + ext i + simp [epigraphBase, epigraphPoint] + +@[simp] theorem epigraphHeight_epigraphPoint {d : ℕ} {R : Type*} + (y : Fin d → R) (s : R) : epigraphHeight (epigraphPoint y s) = s := by + simp [epigraphHeight, epigraphPoint] + +/-- Adding one flattened-coordinate spike changes the recovered full matrix +by at most the spike magnitude in every entry. -/ +theorem birkhoffAffineMap_vector_spike_abs_sub_le + {m : ℕ} (y : Fin (m * m) → ℝ) (k : Fin (m * m)) (r : ℝ) + (i j : Fin (m + 1)) : + abs (birkhoffAffineMap + (vectorToSquareMatrix (fun l ↦ y l + coordinateSpike k r l)) i j - + birkhoffAffineMap (vectorToSquareMatrix y) i j) ≤ abs r := by + have hmap := birkhoffAffineMap_abs_sub_le_l1 + (vectorToSquareMatrix (fun l ↦ y l + coordinateSpike k r l)) + (vectorToSquareMatrix y) i j + apply hmap.trans_eq + change matrixL1 + (fun i j ↦ + vectorToSquareMatrix (fun l ↦ y l + coordinateSpike k r l) i j - + vectorToSquareMatrix y i j) = abs r + rw [← vectorL1_squareMatrixToVector] + have hvec : squareMatrixToVector + (fun i j ↦ + vectorToSquareMatrix (fun l ↦ y l + coordinateSpike k r l) i j - + vectorToSquareMatrix y i j) = coordinateSpike k r := by + ext l + change (y (finProdFinEquiv (finProdFinEquiv.symm l)) + + coordinateSpike k r (finProdFinEquiv (finProdFinEquiv.symm l))) - + y (finProdFinEquiv (finProdFinEquiv.symm l)) = coordinateSpike k r l + rw [Equiv.apply_symm_apply] + ring + rw [hvec, vectorL1_coordinateSpike] + +/-- Real upper-left coordinates of the Birkhoff barycenter. -/ +noncomputable def uniformAffineCoordinatesReal (m : ℕ) : Matrix (Fin m) (Fin m) ℝ := + fun _ _ ↦ 1 / (m + 1) + +@[simp] theorem birkhoffAffineMap_uniformAffineCoordinatesReal + (m : ℕ) (i j : Fin (m + 1)) : + birkhoffAffineMap (uniformAffineCoordinatesReal m) i j = 1 / (m + 1) := by + refine Fin.lastCases ?_ (fun i ↦ ?_) i <;> + refine Fin.lastCases ?_ (fun j ↦ ?_) j + · simp [uniformAffineCoordinatesReal] + field_simp + ring + · simp [uniformAffineCoordinatesReal] + field_simp + ring + · simp [uniformAffineCoordinatesReal] + field_simp + ring + · simp [uniformAffineCoordinatesReal] + +/-- A one-coordinate affine perturbation of the barycenter remains doubly +stochastic as long as its magnitude is at most the uniform entry. -/ +theorem uniformAffineSpike_doublyStochastic + {m : ℕ} (hm : 0 < m) (k : Fin (m * m)) {q : ℝ} + (hq : abs q ≤ 1 / (m + 1 : ℝ)) : + IsDoublyStochastic + (birkhoffAffineMap + (vectorToSquareMatrix + (fun l ↦ squareMatrixToVector (uniformAffineCoordinatesReal m) l + + coordinateSpike k q l))) := by + let Zbase := vectorToSquareMatrix + (fun l ↦ squareMatrixToVector (uniformAffineCoordinatesReal m) l + + coordinateSpike k q l) + have hu : 0 < 1 / (m + 1 : ℝ) := by positivity + have hnonneg : Matrix.Nonnegative (birkhoffAffineMap Zbase) := by + intro i j + have hclose := birkhoffAffineMap_vector_spike_abs_sub_le + (squareMatrixToVector (uniformAffineCoordinatesReal m)) k q i j + rw [vectorToSquareMatrix_squareMatrixToVector, + birkhoffAffineMap_uniformAffineCoordinatesReal] at hclose + have hlower := (abs_le.mp hclose).1 + dsimp only [Zbase] + linarith + exact ⟨hnonneg, birkhoffAffineMap_row_sum Zbase, + birkhoffAffineMap_col_sum Zbase⟩ + +/-- Mixing an exact feasible point with a perturbed barycenter supplies all +three facts needed for the epigraph geometry: feasibility, a quantitative +entry floor, and an objective upper bound obtained from concavity and the +global range. -/ +theorem smoothedUniformSpike_properties + {m : ℕ} (hm : 0 < m) {τ : ℚ} (hτ0 : 0 ≤ τ) (hτ1 : τ ≤ 1) + {A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ} + (hApos : ∀ i j, 0 < A i j) (hAupper : ∀ i j, A i j ≤ 1) + {X : Matrix (Fin (m + 1)) (Fin (m + 1)) ℝ} + (hX : IsDoublyStochastic X) {δ0 : ℝ} + (hXfloor : ∀ i j, δ0 ≤ X i j) + {mix : ℝ} (hmix0 : 0 ≤ mix) (hmix1 : mix ≤ 1) + (k : Fin (m * m)) {q : ℝ} + (hq : abs q ≤ 1 / (m + 1 : ℝ)) : + let Zbase := vectorToSquareMatrix + (fun l ↦ squareMatrixToVector (uniformAffineCoordinatesReal m) l + + coordinateSpike k q l) + let Ybase := fun i j ↦ + (1 - mix) * birkhoffAffineCoordinates X i j + mix * Zbase i j + IsDoublyStochastic (birkhoffAffineMap Ybase) ∧ + (∀ i j, (1 - mix) * δ0 ≤ birkhoffAffineMap Ybase i j) ∧ + affineNegativeObjective (τ : ℝ) (fun i j ↦ (A i j : ℝ)) Ybase ≤ + -regularizedBetheObjective (τ : ℝ) + (fun i j ↦ (A i j : ℝ)) X + + mix * (rationalRegularizedObjectiveRange A : ℝ) := by + let Zbase := vectorToSquareMatrix + (fun l ↦ squareMatrixToVector (uniformAffineCoordinatesReal m) l + + coordinateSpike k q l) + let Ybase := fun i j ↦ + (1 - mix) * birkhoffAffineCoordinates X i j + mix * Zbase i j + have hZ : IsDoublyStochastic (birkhoffAffineMap Zbase) := by + simpa only [Zbase] using uniformAffineSpike_doublyStochastic hm k hq + have hrecover : birkhoffAffineMap (birkhoffAffineCoordinates X) = X := + birkhoffAffineMap_coordinates_of_unit_sums X hX.row_sum hX.col_sum + have hmap : birkhoffAffineMap Ybase = + matrixSegment mix X (birkhoffAffineMap Zbase) := by + rw [show Ybase = fun i j ↦ + (1 - mix) * birkhoffAffineCoordinates X i j + mix * Zbase i j by rfl, + birkhoffAffineMap_affineCombination, hrecover] + rfl + have hmixDS := matrixSegment_doublyStochastic hmix0 hmix1 hX hZ + have hfloor : ∀ i j, + (1 - mix) * δ0 ≤ birkhoffAffineMap Ybase i j := by + intro i j + rw [hmap] + dsimp only [matrixSegment] + have hweight0 : 0 ≤ 1 - mix := sub_nonneg.mpr hmix1 + have hleft := mul_le_mul_of_nonneg_left (hXfloor i j) hweight0 + have hright : 0 ≤ mix * birkhoffAffineMap Zbase i j := + mul_nonneg hmix0 (hZ.nonnegative i j) + linarith + have hconc := regularizedBetheObjective_segment_lower + (show 1 < Fintype.card (Fin (m + 1)) by simp; omega) + (Rat.cast_nonneg.mpr hτ0) hmix0 hmix1 + (fun i j ↦ (A i j : ℝ)) hX hZ + have hrange := regularizedBetheObjective_sub_le_rationalRange + (show 1 ≤ m + 1 by omega) hτ0 hτ1 hApos hAupper hX hZ + refine ⟨by rwa [hmap], hfloor, ?_⟩ + rw [affineNegativeObjective, hmap] + nlinarith + +/-- The unperturbed affine-coordinate center obtained by mixing `X` with the +Birkhoff barycenter. -/ +noncomputable def smoothedUniformAffineBase {m : ℕ} + (X : Matrix (Fin (m + 1)) (Fin (m + 1)) ℝ) (mix : ℝ) : + Matrix (Fin m) (Fin m) ℝ := + fun i j ↦ (1 - mix) * birkhoffAffineCoordinates X i j + + mix * uniformAffineCoordinatesReal m i j + +/-- Multiplying a barycenter spike by the mixing weight produces exactly the +corresponding spike in the flattened mixed coordinates. -/ +theorem squareMatrixToVector_smoothedUniformSpike_of_mul + {m : ℕ} (X : Matrix (Fin (m + 1)) (Fin (m + 1)) ℝ) + (mix : ℝ) (k : Fin (m * m)) (q r : ℝ) (hqr : mix * q = r) : + let Zbase := vectorToSquareMatrix + (fun l ↦ squareMatrixToVector (uniformAffineCoordinatesReal m) l + + coordinateSpike k q l) + let Ybase := fun i j ↦ + (1 - mix) * birkhoffAffineCoordinates X i j + mix * Zbase i j + squareMatrixToVector Ybase = + fun l ↦ squareMatrixToVector (smoothedUniformAffineBase X mix) l + + coordinateSpike k r l := by + dsimp only + ext l + simp only [squareMatrixToVector, vectorToSquareMatrix] + rw [show ((finProdFinEquiv.symm l).1, + (finProdFinEquiv.symm l).2) = finProdFinEquiv.symm l by rfl, + Equiv.apply_symm_apply] + have hspike : mix * coordinateSpike k q l = coordinateSpike k r l := by + by_cases hlk : l = k + · subst l + simp only [coordinateSpike_apply_self] + exact hqr + · simp [coordinateSpike, hlk] + simp only [smoothedUniformAffineBase] + rw [mul_add, hspike] + ring + +/-- A base-coordinate spike leaves the epigraph height unchanged. -/ +theorem epigraphPoint_add_baseSpike {d : ℕ} + (y : Fin d → ℝ) (s : ℝ) (k : Fin d) (r : ℝ) : + (fun i ↦ epigraphPoint y s i + + if i = k.castSucc then r else 0) = + epigraphPoint (fun l ↦ y l + coordinateSpike k r l) s := by + ext i + refine Fin.lastCases ?_ (fun i ↦ ?_) i <;> + simp [epigraphPoint, coordinateSpike, k.castSucc_ne_last, + Ne.symm k.castSucc_ne_last] + +/-- A negative base-coordinate spike leaves the epigraph height unchanged. -/ +theorem epigraphPoint_sub_baseSpike {d : ℕ} + (y : Fin d → ℝ) (s : ℝ) (k : Fin d) (r : ℝ) : + (fun i ↦ epigraphPoint y s i - + if i = k.castSucc then r else 0) = + epigraphPoint (fun l ↦ y l - coordinateSpike k r l) s := by + ext i + refine Fin.lastCases ?_ (fun i ↦ ?_) i <;> + simp [epigraphPoint, coordinateSpike, k.castSucc_ne_last, + Ne.symm k.castSucc_ne_last] + +/-- A spike in the last coordinate changes only the epigraph height. -/ +theorem epigraphPoint_add_heightSpike {d : ℕ} + (y : Fin d → ℝ) (s r : ℝ) : + (fun i ↦ epigraphPoint y s i + + if i = Fin.last d then r else 0) = epigraphPoint y (s + r) := by + ext i + refine Fin.lastCases ?_ (fun i ↦ ?_) i <;> simp [epigraphPoint] + +/-- A negative spike in the last coordinate changes only the epigraph +height. -/ +theorem epigraphPoint_sub_heightSpike {d : ℕ} + (y : Fin d → ℝ) (s r : ℝ) : + (fun i ↦ epigraphPoint y s i - + if i = Fin.last d then r else 0) = epigraphPoint y (s - r) := by + ext i + refine Fin.lastCases ?_ (fun i ↦ ?_) i <;> simp [epigraphPoint] + +/-- Convert the three smoothing conclusions into membership in a bounded +Bethe epigraph at an arbitrary admissible height. -/ +theorem smoothedUniformSpike_mem_epigraph + {m : ℕ} (hm : 0 < m) {τ : ℚ} (hτ0 : 0 ≤ τ) (hτ1 : τ ≤ 1) + {A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ} + (hApos : ∀ i j, 0 < A i j) (hAupper : ∀ i j, A i j ≤ 1) + {X : Matrix (Fin (m + 1)) (Fin (m + 1)) ℝ} + (hX : IsDoublyStochastic X) {δ0 : ℝ} + (hXfloor : ∀ i j, δ0 ≤ X i j) + {mix : ℝ} (hmix0 : 0 ≤ mix) (hmix1 : mix ≤ 1) + (k : Fin (m * m)) {q : ℝ} + (hq : abs q ≤ 1 / (m + 1 : ℝ)) + {δ s upper : ℝ} (hδ : δ ≤ (1 - mix) * δ0) + (hobjective : + -regularizedBetheObjective (τ : ℝ) + (fun i j ↦ (A i j : ℝ)) X + + mix * (rationalRegularizedObjectiveRange A : ℝ) ≤ s) + (hsupper : s ≤ upper) : + let Zbase := vectorToSquareMatrix + (fun l ↦ squareMatrixToVector (uniformAffineCoordinatesReal m) l + + coordinateSpike k q l) + let Ybase := fun i j ↦ + (1 - mix) * birkhoffAffineCoordinates X i j + mix * Zbase i j + BetheEpigraphTarget (τ : ℝ) (fun i j ↦ (A i j : ℝ)) δ upper + (epigraphPoint (squareMatrixToVector Ybase) s) := by + dsimp only + have hproperties := smoothedUniformSpike_properties hm hτ0 hτ1 + hApos hAupper hX hXfloor hmix0 hmix1 k hq + simp only [BetheEpigraphTarget, epigraphBase_epigraphPoint, + epigraphHeight_epigraphPoint, + vectorToSquareMatrix_squareMatrixToVector] + exact ⟨fun i j ↦ hδ.trans (hproperties.2.1 i j), + hproperties.2.2.trans hobjective, hsupper⟩ + +/-- The truncated epigraph above a threshold with two radii of objective +slack contains a full coordinate cross. This is the exact inner-region +statement used by the square-root-free ellipsoid termination theorem. -/ +theorem BetheEpigraphTarget_smoothed_inner_cross + {m : ℕ} (hm : 0 < m) {τ : ℚ} (hτ0 : 0 ≤ τ) (hτ1 : τ ≤ 1) + {A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ} + (hApos : ∀ i j, 0 < A i j) (hAupper : ∀ i j, A i j ≤ 1) + {X : Matrix (Fin (m + 1)) (Fin (m + 1)) ℝ} + (hX : IsDoublyStochastic X) {δ0 : ℝ} + (hXfloor : ∀ i j, δ0 ≤ X i j) + {mix r : ℝ} (hmix0 : 0 < mix) (hmix1 : mix ≤ 1) (hr : 0 ≤ r) + (hspike : r / mix ≤ 1 / (m + 1 : ℝ)) + {δ upper : ℝ} (hδ : δ ≤ (1 - mix) * δ0) + (hslack : + -regularizedBetheObjective (τ : ℝ) + (fun i j ↦ (A i j : ℝ)) X + + mix * (rationalRegularizedObjectiveRange A : ℝ) + 2 * r ≤ upper) : + let ycenter := squareMatrixToVector (smoothedUniformAffineBase X mix) + let zcenter := epigraphPoint ycenter (upper - r) + (∀ k, BetheEpigraphTarget (τ : ℝ) (fun i j ↦ (A i j : ℝ)) + δ upper (fun i ↦ zcenter i + if i = k then r else 0)) ∧ + (∀ k, BetheEpigraphTarget (τ : ℝ) (fun i j ↦ (A i j : ℝ)) + δ upper (fun i ↦ zcenter i - if i = k then r else 0)) := by + dsimp only + have hmix0' : 0 ≤ mix := hmix0.le + have hobjectiveCenter : + -regularizedBetheObjective (τ : ℝ) + (fun i j ↦ (A i j : ℝ)) X + + mix * (rationalRegularizedObjectiveRange A : ℝ) ≤ upper - r := by + linarith + have hcenterUpper : upper - r ≤ upper := by linarith + have hobjectiveLow : + -regularizedBetheObjective (τ : ℝ) + (fun i j ↦ (A i j : ℝ)) X + + mix * (rationalRegularizedObjectiveRange A : ℝ) ≤ upper - 2 * r := by + linarith + have hlowUpper : upper - 2 * r ≤ upper := by linarith + have hqplus : abs (r / mix) ≤ 1 / (m + 1 : ℝ) := by + rw [abs_div, abs_of_nonneg hr, abs_of_pos hmix0] + exact hspike + have hqminus : abs (-r / mix) ≤ 1 / (m + 1 : ℝ) := by + rw [abs_div, abs_neg, abs_of_nonneg hr, abs_of_pos hmix0] + exact hspike + let k0 : Fin (m * m) := ⟨0, Nat.mul_pos hm hm⟩ + constructor + · intro k + refine Fin.lastCases ?_ (fun k ↦ ?_) k + · let Zbase := vectorToSquareMatrix + (fun l ↦ squareMatrixToVector (uniformAffineCoordinatesReal m) l + + coordinateSpike k0 0 l) + let Ybase := fun i j ↦ + (1 - mix) * birkhoffAffineCoordinates X i j + mix * Zbase i j + have hmem : BetheEpigraphTarget (τ : ℝ) + (fun i j ↦ (A i j : ℝ)) δ upper + (epigraphPoint (squareMatrixToVector Ybase) upper) := by + simpa only [Zbase, Ybase] using + smoothedUniformSpike_mem_epigraph hm hτ0 hτ1 hApos hAupper + hX hXfloor hmix0' hmix1 k0 (q := 0) (by + simp; positivity) hδ + (hobjectiveCenter.trans hcenterUpper) le_rfl + have hvec : squareMatrixToVector Ybase = + squareMatrixToVector (smoothedUniformAffineBase X mix) := by + have h := squareMatrixToVector_smoothedUniformSpike_of_mul + X mix k0 0 0 (by ring) + calc + squareMatrixToVector Ybase = + fun l ↦ squareMatrixToVector + (smoothedUniformAffineBase X mix) l + + coordinateSpike k0 0 l := by + simpa only [Zbase, Ybase] using h + _ = squareMatrixToVector (smoothedUniformAffineBase X mix) := by + ext l + simp [coordinateSpike] + rw [epigraphPoint_add_heightSpike, show upper - r + r = upper by ring, + ← hvec] + exact hmem + · let q := r / mix + let Zbase := vectorToSquareMatrix + (fun l ↦ squareMatrixToVector (uniformAffineCoordinatesReal m) l + + coordinateSpike k q l) + let Ybase := fun i j ↦ + (1 - mix) * birkhoffAffineCoordinates X i j + mix * Zbase i j + have hmul : mix * q = r := by + dsimp only [q] + field_simp [hmix0.ne'] + have hmem : BetheEpigraphTarget (τ : ℝ) + (fun i j ↦ (A i j : ℝ)) δ upper + (epigraphPoint (squareMatrixToVector Ybase) (upper - r)) := by + simpa only [Zbase, Ybase, q] using + smoothedUniformSpike_mem_epigraph hm hτ0 hτ1 hApos hAupper + hX hXfloor hmix0' hmix1 k hqplus hδ + hobjectiveCenter hcenterUpper + have hvec : squareMatrixToVector Ybase = + fun l ↦ squareMatrixToVector (smoothedUniformAffineBase X mix) l + + coordinateSpike k r l := by + simpa only [Zbase, Ybase, q] using + squareMatrixToVector_smoothedUniformSpike_of_mul + X mix k q r hmul + rw [epigraphPoint_add_baseSpike, ← hvec] + exact hmem + · intro k + refine Fin.lastCases ?_ (fun k ↦ ?_) k + · let Zbase := vectorToSquareMatrix + (fun l ↦ squareMatrixToVector (uniformAffineCoordinatesReal m) l + + coordinateSpike k0 0 l) + let Ybase := fun i j ↦ + (1 - mix) * birkhoffAffineCoordinates X i j + mix * Zbase i j + have hmem : BetheEpigraphTarget (τ : ℝ) + (fun i j ↦ (A i j : ℝ)) δ upper + (epigraphPoint (squareMatrixToVector Ybase) (upper - 2 * r)) := by + simpa only [Zbase, Ybase] using + smoothedUniformSpike_mem_epigraph hm hτ0 hτ1 hApos hAupper + hX hXfloor hmix0' hmix1 k0 (q := 0) (by + simp; positivity) hδ hobjectiveLow hlowUpper + have hvec : squareMatrixToVector Ybase = + squareMatrixToVector (smoothedUniformAffineBase X mix) := by + have h := squareMatrixToVector_smoothedUniformSpike_of_mul + X mix k0 0 0 (by ring) + calc + squareMatrixToVector Ybase = + fun l ↦ squareMatrixToVector + (smoothedUniformAffineBase X mix) l + + coordinateSpike k0 0 l := by + simpa only [Zbase, Ybase] using h + _ = squareMatrixToVector (smoothedUniformAffineBase X mix) := by + ext l + simp [coordinateSpike] + rw [epigraphPoint_sub_heightSpike, + show upper - r - r = upper - 2 * r by ring, ← hvec] + exact hmem + · let q := -r / mix + let Zbase := vectorToSquareMatrix + (fun l ↦ squareMatrixToVector (uniformAffineCoordinatesReal m) l + + coordinateSpike k q l) + let Ybase := fun i j ↦ + (1 - mix) * birkhoffAffineCoordinates X i j + mix * Zbase i j + have hmul : mix * q = -r := by + dsimp only [q] + field_simp [hmix0.ne'] + have hmem : BetheEpigraphTarget (τ : ℝ) + (fun i j ↦ (A i j : ℝ)) δ upper + (epigraphPoint (squareMatrixToVector Ybase) (upper - r)) := by + simpa only [Zbase, Ybase, q] using + smoothedUniformSpike_mem_epigraph hm hτ0 hτ1 hApos hAupper + hX hXfloor hmix0' hmix1 k hqminus hδ + hobjectiveCenter hcenterUpper + have hvec : squareMatrixToVector Ybase = + fun l ↦ squareMatrixToVector (smoothedUniformAffineBase X mix) l + + coordinateSpike k (-r) l := by + simpa only [Zbase, Ybase, q] using + squareMatrixToVector_smoothedUniformSpike_of_mul + X mix k q (-r) hmul + have hspikeNeg : + (fun l ↦ squareMatrixToVector (smoothedUniformAffineBase X mix) l - + coordinateSpike k r l) = + fun l ↦ squareMatrixToVector (smoothedUniformAffineBase X mix) l + + coordinateSpike k (-r) l := by + ext l + by_cases hlk : l = k + · subst l + simp [coordinateSpike] + ring + · simp [coordinateSpike, hlk] + rw [epigraphPoint_sub_baseSpike, hspikeNeg, ← hvec] + exact hmem + +/-- A coordinatewise bound controls the Euclidean square norm with a +square-root-free radius. -/ +theorem finiteNormSq_le_dimension_sq_of_abs_le + {d : ℕ} (hd : 0 < d) {C : ℝ} (hC : 0 ≤ C) + (x : Fin d → ℝ) (hx : ∀ i, abs (x i) ≤ C) : + finiteNormSq x ≤ ((d : ℝ) * C) ^ 2 := by + have hterm : ∀ i, x i ^ 2 ≤ C ^ 2 := by + intro i + have habs := hx i + have hlower := (abs_le.mp habs).1 + have hupper := (abs_le.mp habs).2 + nlinarith + rw [finiteNormSq, finiteDot] + calc + (∑ i, x i * x i) ≤ ∑ _i : Fin d, C ^ 2 := + Finset.sum_le_sum fun i _ ↦ by simpa [pow_two] using hterm i + _ = (d : ℝ) * C ^ 2 := by simp + _ ≤ ((d : ℝ) * C) ^ 2 := by + have hdR : (1 : ℝ) ≤ d := by exact_mod_cast hd + nlinarith [sq_nonneg C] + +/-- Every flattened base coordinate of a nonnegatively truncated epigraph +point lies in the unit interval. -/ +theorem BetheEpigraphTarget_epigraphBase_abs_le_one + {m : ℕ} {τ : ℝ} {A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℝ} + {δ upper : ℝ} (hδ : 0 ≤ δ) {z : Fin (m * m + 1) → ℝ} + (hz : BetheEpigraphTarget τ A δ upper z) (l : Fin (m * m)) : + abs (epigraphBase z l) ≤ 1 := by + let ij := finProdFinEquiv.symm l + let X := birkhoffAffineMap (vectorToSquareMatrix (epigraphBase z)) + have hX := BetheEpigraphTarget_doublyStochastic hδ hz + have hentry0 : 0 ≤ X ij.1.castSucc ij.2.castSucc := + hX.nonnegative _ _ + have hentry1 : X ij.1.castSucc ij.2.castSucc ≤ 1 := + hX.entry_le_one _ _ + have hcoordinate : X ij.1.castSucc ij.2.castSucc = epigraphBase z l := by + simp only [X, birkhoffAffineMap_castSucc_castSucc, vectorToSquareMatrix, ij] + rw [show ((finProdFinEquiv.symm l).1, + (finProdFinEquiv.symm l).2) = finProdFinEquiv.symm l by rfl, + Equiv.apply_symm_apply] + rw [← hcoordinate, abs_of_nonneg hentry0] + exact hentry1 + +/-- A coordinate cross in the truncated epigraph is contained in an explicit +ball centered at zero. The center of the cross may depend on the exact +optimizer, but the containing ball depends only on the rational height and +radius supplied to the algorithm. -/ +theorem BetheEpigraphTarget_inner_cross_outer_zero + {m : ℕ} (hm : 0 < m) + {τ : ℝ} {A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℝ} + {δ upper r : ℝ} (hδ : 0 ≤ δ) (hr : 0 ≤ r) + (ycenter : Fin (m * m) → ℝ) + (hplus : ∀ k, BetheEpigraphTarget τ A δ upper + (fun i ↦ epigraphPoint ycenter (upper - r) i + + if i = k then r else 0)) + (hminus : ∀ k, BetheEpigraphTarget τ A δ upper + (fun i ↦ epigraphPoint ycenter (upper - r) i - + if i = k then r else 0)) : + let C := 1 + abs upper + 2 * r + (∀ k, finiteNormSq + (fun i ↦ epigraphPoint ycenter (upper - r) i + + if i = k then r else 0) ≤ + (((m * m + 1 : ℕ) : ℝ) * C) ^ 2) ∧ + (∀ k, finiteNormSq + (fun i ↦ epigraphPoint ycenter (upper - r) i - + if i = k then r else 0) ≤ + (((m * m + 1 : ℕ) : ℝ) * C) ^ 2) := by + dsimp only + let C : ℝ := 1 + abs upper + 2 * r + have hC : 0 ≤ C := by + dsimp only [C] + linarith [abs_nonneg upper] + have honeC : (1 : ℝ) ≤ C := by + dsimp only [C] + linarith [abs_nonneg upper] + constructor + · intro k + apply finiteNormSq_le_dimension_sq_of_abs_le (by omega) hC + intro i + refine Fin.lastCases ?_ (fun l ↦ ?_) i + · by_cases hk : Fin.last (m * m) = k + · have hvalue : + epigraphPoint ycenter (upper - r) (Fin.last (m * m)) + + (if Fin.last (m * m) = k then r else 0) = upper := by + subst k + simp [epigraphPoint] + rw [hvalue] + dsimp only [C] + linarith [abs_nonneg upper] + · have htriangle : abs (upper - r) ≤ abs upper + r := by + calc + abs (upper - r) ≤ abs upper + abs r := abs_sub upper r + _ = abs upper + r := by rw [abs_of_nonneg hr] + simp only [epigraphPoint, Fin.snoc_last, if_neg hk, add_zero] + exact htriangle.trans (by dsimp only [C]; linarith) + · have hbase := BetheEpigraphTarget_epigraphBase_abs_le_one hδ + (hplus k) l + simpa only [epigraphBase] using hbase.trans honeC + · intro k + apply finiteNormSq_le_dimension_sq_of_abs_le (by omega) hC + intro i + refine Fin.lastCases ?_ (fun l ↦ ?_) i + · by_cases hk : Fin.last (m * m) = k + · have htriangle : abs (upper - 2 * r) ≤ abs upper + 2 * r := by + calc + abs (upper - 2 * r) ≤ abs upper + abs (2 * r) := + abs_sub upper (2 * r) + _ = abs upper + 2 * r := by rw [abs_of_nonneg (mul_nonneg (by norm_num) hr)] + have hvalue : + epigraphPoint ycenter (upper - r) (Fin.last (m * m)) - + (if Fin.last (m * m) = k then r else 0) = + upper - 2 * r := by + subst k + simp [epigraphPoint] + ring + rw [hvalue] + exact htriangle.trans (by dsimp only [C]; linarith) + · have htriangle : abs (upper - r) ≤ abs upper + r := by + calc + abs (upper - r) ≤ abs upper + abs r := abs_sub upper r + _ = abs upper + r := by rw [abs_of_nonneg hr] + simp only [epigraphPoint, Fin.snoc_last, if_neg hk, sub_zero] + exact htriangle.trans (by dsimp only [C]; linarith) + · have hbase := BetheEpigraphTarget_epigraphBase_abs_le_one hδ + (hminus k) l + simpa only [epigraphBase] using hbase.trans honeC + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/BetheFloorCutFormula.lean b/LeanPool/BeyondBethe/BeyondBethe/BetheFloorCutFormula.lean new file mode 100644 index 0000000000..58cdbbb982 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/BetheFloorCutFormula.lean @@ -0,0 +1,94 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.BetheEpigraph + +/-! +# Coordinate formula for Bethe floor-cut normals + +The machine implementation uses the four signed indicators obtained by +pulling one recovered matrix coordinate back to the flattened upper-left +block. This file proves that direct formula equal to `betheFloorCutNormal`, +separately from any encoding or iteration argument. +-/ + +namespace BeyondBethe + +/-- Base-coordinate coefficient of the lower-floor cut at recovered entry +`(i,j)`. It is the negative of the four-corner affine pullback. -/ +def explicitBetheFloorCutBaseEntry {m : ℕ} + (i j : Fin (m + 1)) (a b : Fin m) : ℚ := + -(if a.castSucc = i ∧ b.castSucc = j then 1 else 0) + + (if a.castSucc = i ∧ Fin.last m = j then 1 else 0) + + (if Fin.last m = i ∧ b.castSucc = j then 1 else 0) - + (if Fin.last m = i ∧ Fin.last m = j then 1 else 0) + +/-- Full epigraph-vector formula, with zero in the last coordinate. -/ +def explicitBetheFloorCutNormal {m : ℕ} (i j : Fin (m + 1)) : + Fin (m * m + 1) → ℚ := + Fin.snoc (fun k ↦ + let ab := finProdFinEquiv.symm k + explicitBetheFloorCutBaseEntry i j ab.1 ab.2) 0 + +theorem neg_affinePullback_entryCovector {m : ℕ} + (i j : Fin (m + 1)) (a b : Fin m) : + -affinePullbackGradient (matrixEntryCovector i j) a b = + explicitBetheFloorCutBaseEntry i j a b := by + simp only [affinePullbackGradient, matrixEntryCovector, + explicitBetheFloorCutBaseEntry] + by_cases hab : a.castSucc = i ∧ b.castSucc = j <;> + by_cases haLast : a.castSucc = i ∧ Fin.last m = j <;> + by_cases hLastB : Fin.last m = i ∧ b.castSucc = j <;> + by_cases hLastLast : Fin.last m = i ∧ Fin.last m = j <;> + simp [hab, haLast, hLastB, hLastLast] <;> ring + +theorem explicitBetheFloorCutNormal_eq {m : ℕ} + (i j : Fin (m + 1)) : + explicitBetheFloorCutNormal i j = betheFloorCutNormal i j := by + ext k + refine Fin.lastCases ?_ (fun k ↦ ?_) k + · simp [explicitBetheFloorCutNormal, betheFloorCutNormal] + · rw [betheFloorCutNormal_castSucc] + simp only [explicitBetheFloorCutNormal, Fin.snoc_castSucc, + squareMatrixToVector] + exact (neg_affinePullback_entryCovector i j + (finProdFinEquiv.symm k).1 (finProdFinEquiv.symm k).2).symm + +@[simp] theorem explicitBetheFloorCutBaseEntry_upperLeft {m : ℕ} + (i j a b : Fin m) : + explicitBetheFloorCutBaseEntry i.castSucc j.castSucc a b = + if a = i ∧ b = j then -1 else 0 := by + have hi : Fin.last m ≠ i.castSucc := (Fin.castSucc_ne_last i).symm + have hj : Fin.last m ≠ j.castSucc := (Fin.castSucc_ne_last j).symm + by_cases hai : a = i <;> by_cases hbj : b = j <;> + simp [explicitBetheFloorCutBaseEntry, hai, hbj, hi, hj] + +@[simp] theorem explicitBetheFloorCutBaseEntry_lastColumn {m : ℕ} + (i a b : Fin m) : + explicitBetheFloorCutBaseEntry i.castSucc (Fin.last m) a b = + if a = i then 1 else 0 := by + have hi : Fin.last m ≠ i.castSucc := (Fin.castSucc_ne_last i).symm + have hb : b.castSucc ≠ Fin.last m := Fin.castSucc_ne_last b + by_cases hai : a = i <;> + simp [explicitBetheFloorCutBaseEntry, hai, hi, hb] + +@[simp] theorem explicitBetheFloorCutBaseEntry_lastRow {m : ℕ} + (j a b : Fin m) : + explicitBetheFloorCutBaseEntry (Fin.last m) j.castSucc a b = + if b = j then 1 else 0 := by + have hj : Fin.last m ≠ j.castSucc := (Fin.castSucc_ne_last j).symm + have ha : a.castSucc ≠ Fin.last m := Fin.castSucc_ne_last a + by_cases hbj : b = j <;> + simp [explicitBetheFloorCutBaseEntry, hbj, hj, ha] + +@[simp] theorem explicitBetheFloorCutBaseEntry_corner {m : ℕ} + (a b : Fin m) : + explicitBetheFloorCutBaseEntry (Fin.last m) (Fin.last m) a b = -1 := by + have ha : a.castSucc ≠ Fin.last m := Fin.castSucc_ne_last a + have hb : b.castSucc ≠ Fin.last m := Fin.castSucc_ne_last b + simp [explicitBetheFloorCutBaseEntry, ha, hb] + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/BetheThresholdFeasibility.lean b/LeanPool/BeyondBethe/BeyondBethe/BetheThresholdFeasibility.lean new file mode 100644 index 0000000000..ae40ba33ce --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/BetheThresholdFeasibility.lean @@ -0,0 +1,191 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.BetheEpigraphGeometry +import LeanPool.BeyondBethe.BeyondBethe.ScheduledFeasibility +import Mathlib.Tactic + +/-! # Bethe Threshold Feasibility -/ + +namespace BeyondBethe + +/-! +# Executable feasibility at a rational Bethe threshold + +This file instantiates the generic rational ellipsoid loop with a completely +explicit zero-centered outer ball and the coordinate cross constructed from +an exact regularized optimizer. The optimizer occurs only in the proof of +termination; the executable state, oracle, radius, and budget use rational +input data alone. +-/ + +/-- A square-root-free rational outer radius for the bounded epigraph cross. -/ +def betheEpigraphOuterRadius (m : ℕ) (upper r : ℚ) : ℚ := + (m * m + 1) * (1 + abs upper + 2 * r) + +theorem betheEpigraphOuterRadius_pos (m : ℕ) {upper r : ℚ} + (hr : 0 ≤ r) : 0 < betheEpigraphOuterRadius m upper r := by + rw [betheEpigraphOuterRadius] + positivity + +theorem cast_betheEpigraphOuterRadius (m : ℕ) (upper r : ℚ) : + (betheEpigraphOuterRadius m upper r : ℝ) = + ((m * m + 1 : ℕ) : ℝ) * + (1 + abs (upper : ℝ) + 2 * (r : ℝ)) := by + rw [betheEpigraphOuterRadius] + push_cast + rfl + +/-- The exact call budget obtained from the explicit outer and inner radii. -/ +def betheThresholdFeasibilityBudget (m : ℕ) (upper r : ℚ) : ℕ := + let d := m * m + 1 + 32 * d ^ 3 * rationalBallDyadicExponent d + (betheEpigraphOuterRadius m upper r) r + +/-- Execute the complete rational oracle for one rational objective +threshold. The initial ellipsoid is centered at zero and every parameter is +computed from the input rationals. -/ +def runBetheThresholdFeasibility {m : ℕ} + (τ : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (p : ℕ) (δ upper r : ℚ) : + RationalFeasibilityResult (m * m + 1) := + runScheduledRationalFeasibility (betheBoundedEpigraphOracle τ A p δ upper) + (betheThresholdFeasibilityBudget m upper r) + (rationalBallEllipsoid (m * m + 1) 0 + (betheEpigraphOuterRadius m upper r)) + +/-- Every accepted result of the specialized runner satisfies the exact +rational acceptance predicate of the complete oracle. -/ +theorem runBetheThresholdFeasibility_acceptsOnly {m : ℕ} + (τ : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (p : ℕ) (δ upper r : ℚ) {q : Fin (m * m + 1) → ℚ} + (hrun : runBetheThresholdFeasibility τ A p δ upper r = .accepted q) : + BetheEpigraphOracleAccepted τ A p δ upper q := by + exact runScheduledRationalFeasibility_acceptsOnly + (betheBoundedEpigraphOracle_acceptsOnly τ A p δ upper) + (by simpa only [runBetheThresholdFeasibility, + betheThresholdFeasibilityBudget] using hrun) + +/-- If a rational threshold has the displayed smoothing and height slack, +the executable feasibility run returns an accepted rational point. -/ +theorem runBetheThresholdFeasibility_accepts_of_slack + {m : ℕ} (hm : 0 < m) {τ : ℚ} (hτ0 : 0 < τ) (hτ1 : τ ≤ 1) + {A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ} + (hApos : ∀ i j, 0 < A i j) (hAupper : ∀ i j, A i j ≤ 1) + {X : Matrix (Fin (m + 1)) (Fin (m + 1)) ℝ} + (hX : IsDoublyStochastic X) + (hmax : ∀ Y, IsDoublyStochastic Y → + regularizedBetheObjective (τ : ℝ) + (fun i j ↦ (A i j : ℝ)) Y ≤ + regularizedBetheObjective (τ : ℝ) + (fun i j ↦ (A i j : ℝ)) X) + {mix δ upper r : ℚ} (hmix0 : 0 < mix) (hmix1 : mix ≤ 1) + (hδ : 0 < δ) (hr : 0 < r) + (hspike : r / mix ≤ 1 / (m + 1 : ℚ)) + (hfloor : δ ≤ (1 - mix) * + numericalInteriorFloor (m + 1) (rationalMatrixEntryBitBound A) τ) + (hslack : + -regularizedBetheObjective (τ : ℝ) + (fun i j ↦ (A i j : ℝ)) X + + (mix : ℝ) * (rationalRegularizedObjectiveRange A : ℝ) + + 2 * (r : ℝ) ≤ (upper : ℝ)) + (p : ℕ) : + ∃ q : Fin (m * m + 1) → ℚ, + runBetheThresholdFeasibility τ A p δ upper r = .accepted q ∧ + BetheEpigraphOracleAccepted τ A p δ upper q := by + let δ0 : ℚ := numericalInteriorFloor (m + 1) + (rationalMatrixEntryBitBound A) τ + have hoptimizerFloor : ∀ i j, (δ0 : ℝ) ≤ X i j := by + intro i j + exact (regularizedOptimizer_meets_executable_floor + (n := m + 1) (by omega) hτ0 hApos hAupper hX hmax i j).1 + have hcross := BetheEpigraphTarget_smoothed_inner_cross hm hτ0.le hτ1 + hApos hAupper hX hoptimizerFloor + (Rat.cast_pos.mpr hmix0) (by exact_mod_cast hmix1) + (Rat.cast_nonneg.mpr hr.le) (by + have hs := (Rat.cast_le (K := ℝ)).mpr hspike + norm_num only [Rat.cast_div, Rat.cast_one, Rat.cast_natCast] at hs + simpa using hs) + (δ := (δ : ℝ)) (upper := (upper : ℝ)) (by + exact_mod_cast hfloor) hslack + let ycenter := squareMatrixToVector (smoothedUniformAffineBase X (mix : ℝ)) + let zcenter := epigraphPoint ycenter ((upper : ℝ) - (r : ℝ)) + have hcross' : + (∀ k, BetheEpigraphTarget (τ : ℝ) (fun i j ↦ (A i j : ℝ)) + (δ : ℝ) (upper : ℝ) + (fun i ↦ zcenter i + if i = k then (r : ℝ) else 0)) ∧ + (∀ k, BetheEpigraphTarget (τ : ℝ) (fun i j ↦ (A i j : ℝ)) + (δ : ℝ) (upper : ℝ) + (fun i ↦ zcenter i - if i = k then (r : ℝ) else 0)) := by + simpa only [ycenter, zcenter] using hcross + have houter := BetheEpigraphTarget_inner_cross_outer_zero hm + (Rat.cast_nonneg.mpr hδ.le) (Rat.cast_nonneg.mpr hr.le) ycenter + hcross'.1 hcross'.2 + have hR : 0 < betheEpigraphOuterRadius m upper r := + betheEpigraphOuterRadius_pos m hr.le + obtain ⟨q, hrun, hgood⟩ := runScheduledRationalFeasibility_ball_accepts + (d := m * m + 1) (by omega) + (Target := BetheEpigraphTarget (τ : ℝ) (fun i j ↦ (A i j : ℝ)) + (δ : ℝ) (upper : ℝ)) + (Good := BetheEpigraphOracleAccepted τ A p δ upper) + (oracle := betheBoundedEpigraphOracle τ A p δ upper) + (betheBoundedEpigraphOracle_valid hm hτ0.le hτ1 hApos hδ p upper) + (betheBoundedEpigraphOracle_acceptsOnly τ A p δ upper) + (0 : Fin (m * m + 1) → ℚ) hR hr + hcross'.1 hcross'.2 + (by + intro k + have hk := houter.1 k + rw [cast_betheEpigraphOuterRadius] + simpa [zcenter, ycenter] using hk) + (by + intro k + have hk := houter.2 k + rw [cast_betheEpigraphOuterRadius] + simpa [zcenter, ycenter] using hk) + refine ⟨q, ?_, hgood⟩ + simpa only [runBetheThresholdFeasibility, + betheThresholdFeasibilityBudget] using hrun + +/-- Conversely, exhaustion certifies that the queried threshold is strictly +below the exact optimum plus the smoothing slack. This is a theorem about +the concrete runner, not an oracle assumption. -/ +theorem runBetheThresholdFeasibility_exhausted_lt_optimum_add_slack + {m : ℕ} (hm : 0 < m) {τ : ℚ} (hτ0 : 0 < τ) (hτ1 : τ ≤ 1) + {A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ} + (hApos : ∀ i j, 0 < A i j) (hAupper : ∀ i j, A i j ≤ 1) + {X : Matrix (Fin (m + 1)) (Fin (m + 1)) ℝ} + (hX : IsDoublyStochastic X) + (hmax : ∀ Y, IsDoublyStochastic Y → + regularizedBetheObjective (τ : ℝ) + (fun i j ↦ (A i j : ℝ)) Y ≤ + regularizedBetheObjective (τ : ℝ) + (fun i j ↦ (A i j : ℝ)) X) + {mix δ upper r : ℚ} (hmix0 : 0 < mix) (hmix1 : mix ≤ 1) + (hδ : 0 < δ) (hr : 0 < r) + (hspike : r / mix ≤ 1 / (m + 1 : ℚ)) + (hfloor : δ ≤ (1 - mix) * + numericalInteriorFloor (m + 1) (rationalMatrixEntryBitBound A) τ) + (p : ℕ) {E : RationalEllipsoidState (m * m + 1)} + (hrun : runBetheThresholdFeasibility τ A p δ upper r = .exhausted E) : + (upper : ℝ) < + -regularizedBetheObjective (τ : ℝ) + (fun i j ↦ (A i j : ℝ)) X + + (mix : ℝ) * (rationalRegularizedObjectiveRange A : ℝ) + + 2 * (r : ℝ) := by + by_contra hnot + have hslack : + -regularizedBetheObjective (τ : ℝ) + (fun i j ↦ (A i j : ℝ)) X + + (mix : ℝ) * (rationalRegularizedObjectiveRange A : ℝ) + + 2 * (r : ℝ) ≤ (upper : ℝ) := not_lt.mp hnot + obtain ⟨q, haccepted, _⟩ := runBetheThresholdFeasibility_accepts_of_slack + hm hτ0 hτ1 hApos hAupper hX hmax hmix0 hmix1 hδ hr + hspike hfloor hslack p + rw [hrun] at haccepted + contradiction + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/BinaryDirectedElementary.lean b/LeanPool/BeyondBethe/BeyondBethe/BinaryDirectedElementary.lean new file mode 100644 index 0000000000..cfb92008a7 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/BinaryDirectedElementary.lean @@ -0,0 +1,252 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.BinaryRationalFloor +import LeanPool.BeyondBethe.BeyondBethe.BinaryRationalComparison +import LeanPool.BeyondBethe.BeyondBethe.DirectedElementary +import Mathlib.Tactic + +/-! # Binary Directed Elementary -/ + +namespace BeyondBethe + +/-! +# Directed elementary functions through verified binary arithmetic + +The analytic definitions in `DirectedElementary.lean` are convenient field +expressions. The definitions below give extensionally equal, machine-facing +programs whose rational operations are the explicit long-division, bounded +Euclid, and normalization routines from the binary arithmetic layer. +-/ + +/-- Partial sum of the odd logarithm series, evaluated by a fixed natural +loop. -/ +def binaryRationalLogSeriesSum (x : ℚ) : ℕ → ℚ + | 0 => 0 + | N + 1 => + binaryRatAdd (binaryRationalLogSeriesSum x N) + (binaryRatDiv (binaryRatPow x (2 * N + 1)) (2 * N + 1)) + +theorem binaryRationalLogSeriesSum_eq (x : ℚ) : ∀ N : ℕ, + binaryRationalLogSeriesSum x N = + ∑ k ∈ Finset.range N, x ^ (2 * k + 1) / (2 * k + 1) := by + intro N + induction N with + | zero => simp [binaryRationalLogSeriesSum] + | succ N ih => + rw [binaryRationalLogSeriesSum, binaryRatAdd_eq_add, + binaryRatDiv_eq_div, binaryRatPow_eq_pow, ih, + Finset.sum_range_succ] + +def binaryRationalLogSeries (x : ℚ) (N : ℕ) : ℚ := + binaryRatMul 2 (binaryRationalLogSeriesSum x N) + +theorem binaryRationalLogSeries_eq (x : ℚ) (N : ℕ) : + binaryRationalLogSeries x N = rationalLogSeries x N := by + rw [binaryRationalLogSeries, rationalLogSeries, + binaryRatMul_eq_mul, binaryRationalLogSeriesSum_eq] + +def binaryRationalLogSeriesError (x : ℚ) (N : ℕ) : ℚ := + binaryRatMul 2 + (binaryRatDiv (binaryRatPow x (2 * N + 1)) + (binaryRatSub 1 (binaryRatPow x 2))) + +theorem binaryRationalLogSeriesError_eq (x : ℚ) (N : ℕ) : + binaryRationalLogSeriesError x N = rationalLogSeriesError x N := by + simp [binaryRationalLogSeriesError, rationalLogSeriesError, + binaryRatMul_eq_mul, binaryRatDiv_eq_div, binaryRatSub_eq_sub, + binaryRatPow_eq_pow] + +def binaryRationalLogUnitParameter (y : ℚ) : ℚ := + binaryRatDiv (binaryRatSub y 1) (binaryRatAdd y 1) + +theorem binaryRationalLogUnitParameter_eq (y : ℚ) : + binaryRationalLogUnitParameter y = rationalLogUnitParameter y := by + simp [binaryRationalLogUnitParameter, rationalLogUnitParameter, + binaryRatDiv_eq_div, binaryRatSub_eq_sub, binaryRatAdd_eq_add] + +def binaryDirectedLogUnitLower (y : ℚ) (N : ℕ) : ℚ := + binaryRationalLogSeries (binaryRationalLogUnitParameter y) N + +theorem binaryDirectedLogUnitLower_eq (y : ℚ) (N : ℕ) : + binaryDirectedLogUnitLower y N = directedLogUnitLower y N := by + simp [binaryDirectedLogUnitLower, directedLogUnitLower, + binaryRationalLogSeries_eq, binaryRationalLogUnitParameter_eq] + +def binaryDirectedLogUnitUpper (y : ℚ) (N : ℕ) : ℚ := + binaryRatAdd + (binaryRationalLogSeries (binaryRationalLogUnitParameter y) N) + (binaryRationalLogSeriesError (binaryRationalLogUnitParameter y) N) + +theorem binaryDirectedLogUnitUpper_eq (y : ℚ) (N : ℕ) : + binaryDirectedLogUnitUpper y N = directedLogUnitUpper y N := by + simp [binaryDirectedLogUnitUpper, directedLogUnitUpper, + binaryRatAdd_eq_add, binaryRationalLogSeries_eq, + binaryRationalLogSeriesError_eq, binaryRationalLogUnitParameter_eq] + +/-- Base-two logarithm read from the length of the canonical binary word. -/ +def binaryNatLog2 (n : ℕ) : ℕ := n.size - 1 + +theorem binaryNatLog2_eq_log_two (n : ℕ) : + binaryNatLog2 n = Nat.log 2 n := by + by_cases hn : n = 0 + · subst n + simp [binaryNatLog2] + · have hsize := Nat.size_eq_log_two_add_one hn + rw [binaryNatLog2, hsize] + omega + +def binaryRationalBinaryScale (q : ℚ) : ℚ := + binaryRatDiv + (binaryRatPow 2 (binaryNatLog2 q.num.natAbs)) + (binaryRatPow 2 (binaryNatLog2 q.den)) + +theorem binaryRationalBinaryScale_eq (q : ℚ) : + binaryRationalBinaryScale q = rationalBinaryScale q := by + simp [binaryRationalBinaryScale, rationalBinaryScale, + binaryRatDiv_eq_div, binaryRatPow_eq_pow, + binaryNatLog2_eq_log_two] + +/-- Signed range-reduction exponent computed from binary word lengths. -/ +def binaryRationalBinaryExponent (q : ℚ) : ℤ := + (binaryNatLog2 q.num.natAbs : ℤ) - (binaryNatLog2 q.den : ℤ) + +theorem binaryRationalBinaryExponent_eq (q : ℚ) : + binaryRationalBinaryExponent q = rationalBinaryExponent q := by + simp [binaryRationalBinaryExponent, rationalBinaryExponent, + binaryNatLog2_eq_log_two] + +def binaryRationalBinaryResidual (q : ℚ) : ℚ := + binaryRatDiv q (binaryRationalBinaryScale q) + +theorem binaryRationalBinaryResidual_eq (q : ℚ) : + binaryRationalBinaryResidual q = rationalBinaryResidual q := by + simp [binaryRationalBinaryResidual, rationalBinaryResidual, + binaryRatDiv_eq_div, binaryRationalBinaryScale_eq] + +def binaryRationalLogUnit (q : ℚ) : ℚ := + if binaryRatLt (binaryRationalBinaryResidual q) 1 then + binaryRatInv (binaryRationalBinaryResidual q) + else + binaryRationalBinaryResidual q + +theorem binaryRationalLogUnit_eq (q : ℚ) : + binaryRationalLogUnit q = rationalLogUnit q := by + simp [binaryRationalLogUnit, rationalLogUnit, + binaryRationalBinaryResidual_eq, binaryRatInv_eq_inv, + binaryRatLt_eq_true_iff] + +def binaryDirectedIntMulLower (k : ℤ) (lo hi : ℚ) : ℚ := + if 0 ≤ k then binaryRatMul k lo else binaryRatMul k hi + +theorem binaryDirectedIntMulLower_eq (k : ℤ) (lo hi : ℚ) : + binaryDirectedIntMulLower k lo hi = directedIntMulLower k lo hi := by + simp [binaryDirectedIntMulLower, directedIntMulLower, + binaryRatMul_eq_mul] + +def binaryDirectedIntMulUpper (k : ℤ) (lo hi : ℚ) : ℚ := + if 0 ≤ k then binaryRatMul k hi else binaryRatMul k lo + +theorem binaryDirectedIntMulUpper_eq (k : ℤ) (lo hi : ℚ) : + binaryDirectedIntMulUpper k lo hi = directedIntMulUpper k lo hi := by + simp [binaryDirectedIntMulUpper, directedIntMulUpper, + binaryRatMul_eq_mul] + +/-- Complete directed lower logarithm implemented only with binary rational +primitives and fixed natural loops. -/ +def binaryDirectedLogLower (q : ℚ) (N : ℕ) : ℚ := + let kPart := binaryDirectedIntMulLower (binaryRationalBinaryExponent q) + (binaryDirectedLogUnitLower 2 N) (binaryDirectedLogUnitUpper 2 N) + let y := binaryRationalLogUnit q + binaryRatAdd kPart + (if binaryRatLt (binaryRationalBinaryResidual q) 1 then + binaryRatNeg (binaryDirectedLogUnitUpper y N) + else + binaryDirectedLogUnitLower y N) + +theorem binaryDirectedLogLower_eq (q : ℚ) (N : ℕ) : + binaryDirectedLogLower q N = directedLogLower q N := by + simp [binaryDirectedLogLower, directedLogLower, + binaryDirectedIntMulLower_eq, binaryDirectedLogUnitLower_eq, + binaryDirectedLogUnitUpper_eq, binaryRationalLogUnit_eq, + binaryRationalBinaryResidual_eq, binaryRatNeg_eq_neg, + binaryRatAdd_eq_add, binaryRationalBinaryExponent_eq, + binaryRatLt_eq_true_iff] + +def binaryDirectedLogUpper (q : ℚ) (N : ℕ) : ℚ := + let kPart := binaryDirectedIntMulUpper (binaryRationalBinaryExponent q) + (binaryDirectedLogUnitLower 2 N) (binaryDirectedLogUnitUpper 2 N) + let y := binaryRationalLogUnit q + binaryRatAdd kPart + (if binaryRatLt (binaryRationalBinaryResidual q) 1 then + binaryRatNeg (binaryDirectedLogUnitLower y N) + else + binaryDirectedLogUnitUpper y N) + +theorem binaryDirectedLogUpper_eq (q : ℚ) (N : ℕ) : + binaryDirectedLogUpper q N = directedLogUpper q N := by + simp [binaryDirectedLogUpper, directedLogUpper, + binaryDirectedIntMulUpper_eq, binaryDirectedLogUnitLower_eq, + binaryDirectedLogUnitUpper_eq, binaryRationalLogUnit_eq, + binaryRationalBinaryResidual_eq, binaryRatNeg_eq_neg, + binaryRatAdd_eq_add, binaryRationalBinaryExponent_eq, + binaryRatLt_eq_true_iff] + +/-- Natural ceiling used by the exponential schedule, now routed through the +verified rational-floor implementation. -/ +def binaryRationalCeilNat (t : ℚ) : ℕ := + Int.toNat (binaryRatCeil t) + +theorem binaryRationalCeilNat_eq (t : ℚ) : + binaryRationalCeilNat t = rationalCeilNat t := by + rw [binaryRationalCeilNat, rationalCeilNat, binaryRatCeil_eq_ceil] + +def binaryRationalExpApproxSteps (t loss : ℚ) : ℕ := + 2 * binaryRationalCeilNat + (binaryRatAdd t (binaryRatDiv (binaryRatPow t 2) loss)) + 1 + +theorem binaryRationalExpApproxSteps_eq (t loss : ℚ) : + binaryRationalExpApproxSteps t loss = + rationalExpApproxSteps t loss := by + simp [binaryRationalExpApproxSteps, rationalExpApproxSteps, + binaryRationalCeilNat_eq, binaryRatAdd_eq_add, + binaryRatDiv_eq_div, binaryRatPow_eq_pow] + +def binaryRationalNegativeExpLower (t loss : ℚ) : ℚ := + let M := binaryRationalExpApproxSteps t loss + binaryRatPow + (binaryRatSub 1 (binaryRatDiv t M)) M + +theorem binaryRationalNegativeExpLower_eq (t loss : ℚ) : + binaryRationalNegativeExpLower t loss = + rationalNegativeExpLower t loss := by + simp [binaryRationalNegativeExpLower, rationalNegativeExpLower, + binaryRationalExpApproxSteps_eq, binaryRatPow_eq_pow, + binaryRatSub_eq_sub, binaryRatDiv_eq_div] + +def binaryRationalPositiveExpLower (t loss : ℚ) : ℚ := + let M := binaryRationalExpApproxSteps t loss + binaryRatPow + (binaryRatAdd 1 (binaryRatDiv t M)) M + +theorem binaryRationalPositiveExpLower_eq (t loss : ℚ) : + binaryRationalPositiveExpLower t loss = + rationalPositiveExpLower t loss := by + simp [binaryRationalPositiveExpLower, rationalPositiveExpLower, + binaryRationalExpApproxSteps_eq, binaryRatPow_eq_pow, + binaryRatAdd_eq_add, binaryRatDiv_eq_div] + +def binaryRationalExpLower (s loss : ℚ) : ℚ := + if binaryRatNonnegative s then binaryRationalPositiveExpLower s loss + else binaryRationalNegativeExpLower (binaryRatNeg s) loss + +theorem binaryRationalExpLower_eq (s loss : ℚ) : + binaryRationalExpLower s loss = rationalExpLower s loss := by + simp [binaryRationalExpLower, rationalExpLower, + binaryRationalPositiveExpLower_eq, binaryRationalNegativeExpLower_eq, + binaryRatNeg_eq_neg, binaryRatNonnegative_eq_true_iff] + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/BinaryLongDivision.lean b/LeanPool/BeyondBethe/BeyondBethe/BinaryLongDivision.lean new file mode 100644 index 0000000000..e160aaf8f6 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/BinaryLongDivision.lean @@ -0,0 +1,348 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.Complexitylib.Mathlib.NatBits +import Mathlib.Tactic + +/-! # Binary Long Division -/ + +namespace BeyondBethe + +/-! +# Binary long division + +This file starts the machine-level arithmetic layer with a structural +long-division recurrence on little-endian binary words. The recurrence uses +only doubling, comparison, and subtraction. Its proof does not appeal to +`Nat.div` or `Nat.mod` while the recurrence is running; those operations occur +only in the extensional correctness statement. +-/ + +/-- The numeric value of one bit. -/ +def bitValue (b : Bool) : ℕ := if b then 1 else 0 + +@[simp] theorem bitValue_false : bitValue false = 0 := rfl + +@[simp] theorem bitValue_true : bitValue true = 1 := rfl + +theorem bitValue_le_one (b : Bool) : bitValue b ≤ 1 := by + cases b <;> simp [bitValue] + +/-- One most-significant-to-least-significant long-division step. The pair is +`(quotient, remainder)` for the already processed high bits. -/ +def binaryLongDivStep (divisor : ℕ) (b : Bool) (qr : ℕ × ℕ) : ℕ × ℕ := + let trial := 2 * qr.2 + bitValue b + if divisor = 0 then + (0, trial) + else if divisor ≤ trial then + (2 * qr.1 + 1, trial - divisor) + else + (2 * qr.1, trial) + +/-- Divide a little-endian binary word by processing its high-order tail +first. -/ +def binaryLongDivBits (divisor : ℕ) : List Bool → ℕ × ℕ + | [] => (0, 0) + | b :: bits => binaryLongDivStep divisor b (binaryLongDivBits divisor bits) + +@[simp] theorem binaryLongDivBits_nil (divisor : ℕ) : + binaryLongDivBits divisor [] = (0, 0) := rfl + +@[simp] theorem binaryLongDivBits_cons (divisor : ℕ) (b : Bool) + (bits : List Bool) : + binaryLongDivBits divisor (b :: bits) = + binaryLongDivStep divisor b (binaryLongDivBits divisor bits) := rfl + +/-- The zero-divisor branch follows Lean's convention: quotient zero and the +entire input as remainder. -/ +theorem binaryLongDivBits_zero (bits : List Bool) : + binaryLongDivBits 0 bits = (0, Nat.fromBitsLE bits) := by + induction bits with + | nil => + change (0, 0) = (0, 0) + rfl + | cons b bits ih => + simp [binaryLongDivBits, binaryLongDivStep, ih, + Nat.fromBitsLE_cons, bitValue, Nat.add_comm] + +/-- Algebraic preservation performed by one positive-divisor step. -/ +theorem binaryLongDivStep_invariant {divisor : ℕ} (hdivisor : 0 < divisor) + (b : Bool) (q r : ℕ) (hr : r < divisor) : + let out := binaryLongDivStep divisor b (q, r) + 2 * (q * divisor + r) + bitValue b = + out.1 * divisor + out.2 ∧ + out.2 < divisor := by + have htrial : 2 * r + bitValue b < 2 * divisor := by + have hb := bitValue_le_one b + omega + rw [binaryLongDivStep] + simp only [Prod.fst, Prod.snd] + split + · rename_i hzero + omega + · split + · rename_i hle + constructor + · have hcancel : divisor + (2 * r + bitValue b - divisor) = + 2 * r + bitValue b := Nat.add_sub_of_le hle + calc + 2 * (q * divisor + r) + bitValue b = + 2 * (q * divisor) + (2 * r + bitValue b) := by ring + _ = 2 * (q * divisor) + + (divisor + (2 * r + bitValue b - divisor)) := by rw [hcancel] + _ = (2 * q + 1) * divisor + + (2 * r + bitValue b - divisor) := by ring + · omega + · rename_i hnle + constructor + · ring + · omega + +/-- Fundamental invariant of the recurrence for a positive divisor. -/ +theorem binaryLongDivBits_invariant {divisor : ℕ} (hdivisor : 0 < divisor) : + ∀ bits : List Bool, + let qr := binaryLongDivBits divisor bits + Nat.fromBitsLE bits = qr.1 * divisor + qr.2 ∧ qr.2 < divisor := by + intro bits + induction bits with + | nil => + simp [binaryLongDivBits, Nat.fromBitsLE, Nat.fromBits, hdivisor] + | cons b bits ih => + let q := (binaryLongDivBits divisor bits).1 + let r := (binaryLongDivBits divisor bits).2 + have ihEq : Nat.fromBitsLE bits = q * divisor + r := by + simpa only [q, r] using ih.1 + have ihRem : r < divisor := by + simpa only [r] using ih.2 + have hstep := binaryLongDivStep_invariant hdivisor b q r ihRem + rw [Nat.fromBitsLE_cons, binaryLongDivBits_cons] + simpa only [bitValue, q, r, ihEq, add_comm] using hstep + +/-- Extensional correctness of binary long division. -/ +theorem binaryLongDivBits_eq_div_mod (divisor : ℕ) (bits : List Bool) : + binaryLongDivBits divisor bits = + (Nat.fromBitsLE bits / divisor, Nat.fromBitsLE bits % divisor) := by + by_cases hzero : divisor = 0 + · subst divisor + simpa using binaryLongDivBits_zero bits + · have hpos : 0 < divisor := Nat.pos_of_ne_zero hzero + let q := (binaryLongDivBits divisor bits).1 + let r := (binaryLongDivBits divisor bits).2 + have hinv := binaryLongDivBits_invariant hpos bits + have hinvEq : Nat.fromBitsLE bits = q * divisor + r := by + simpa only [q, r] using hinv.1 + have hinvRem : r < divisor := by + simpa only [r] using hinv.2 + have hquot : Nat.fromBitsLE bits / divisor = q := by + apply Nat.div_eq_of_lt_le + · rw [hinvEq] + omega + · rw [hinvEq] + calc + q * divisor + r < q * divisor + divisor := + Nat.add_lt_add_left hinvRem _ + _ = (q + 1) * divisor := by ring + have hrem : Nat.fromBitsLE bits % divisor = r := by + rw [hinvEq, Nat.add_mod] + simp [Nat.mod_eq_of_lt hinvRem] + apply Prod.ext + · simpa only [q] using hquot.symm + · simpa only [r] using hrem.symm + +/-- Natural-number wrapper using Lean's canonical little-endian bits. -/ +def binaryLongDiv (dividend divisor : ℕ) : ℕ × ℕ := + binaryLongDivBits divisor dividend.bits + +theorem binaryLongDiv_eq_div_mod (dividend divisor : ℕ) : + binaryLongDiv dividend divisor = + (dividend / divisor, dividend % divisor) := by + rw [binaryLongDiv, binaryLongDivBits_eq_div_mod, + Nat.fromBitsLE_bits] + +theorem binaryLongDiv_remainder_lt {dividend divisor : ℕ} + (hdivisor : 0 < divisor) : + (binaryLongDiv dividend divisor).2 < divisor := by + rw [binaryLongDiv_eq_div_mod] + exact Nat.mod_lt _ hdivisor + +theorem binaryLongDivBits_quotient_le_value (divisor : ℕ) + (bits : List Bool) : + (binaryLongDivBits divisor bits).1 ≤ Nat.fromBitsLE bits := by + rw [binaryLongDivBits_eq_div_mod] + exact Nat.div_le_self _ _ + +theorem binaryLongDivBits_remainder_le_value (divisor : ℕ) + (bits : List Bool) : + (binaryLongDivBits divisor bits).2 ≤ Nat.fromBitsLE bits := by + rw [binaryLongDivBits_eq_div_mod] + exact Nat.mod_le _ _ + +/-- Both result registers fit in the input word width. -/ +theorem binaryLongDivBits_components_lt_width (divisor : ℕ) + (bits : List Bool) : + (binaryLongDivBits divisor bits).1 < 2 ^ bits.length ∧ + (binaryLongDivBits divisor bits).2 < 2 ^ bits.length := by + have hvalue := Nat.fromBitsLE_lt_pow_length bits + exact ⟨(binaryLongDivBits_quotient_le_value divisor bits).trans_lt hvalue, + (binaryLongDivBits_remainder_le_value divisor bits).trans_lt hvalue⟩ + +/-- Euclid's algorithm with its remainder supplied by the verified binary +division recurrence. -/ +def binaryEuclid (a : ℕ) : ℕ → ℕ + | 0 => a + | b + 1 => + binaryEuclid (b + 1) (binaryLongDiv a (b + 1)).2 +termination_by b => b +decreasing_by + exact binaryLongDiv_remainder_lt (by omega) + +theorem binaryEuclid_eq_gcd : ∀ a b : ℕ, + binaryEuclid a b = Nat.gcd a b := by + intro a b + induction b using Nat.strong_induction_on generalizing a with + | h b ih => + cases b with + | zero => simp [binaryEuclid] + | succ b => + have hrem : a % (b + 1) < b + 1 := Nat.mod_lt _ (by omega) + rw [binaryEuclid, binaryLongDiv_eq_div_mod] + simp only [Prod.snd] + rw [ih (a % (b + 1)) hrem] + calc + Nat.gcd (b + 1) (a % (b + 1)) = + Nat.gcd (a % (b + 1)) (b + 1) := Nat.gcd_comm _ _ + _ = Nat.gcd (b + 1) a := (Nat.gcd_rec (b + 1) a).symm + _ = Nat.gcd a (b + 1) := Nat.gcd_comm _ _ + +/-- One total Euclid step. Once the second register is zero it is a no-op. -/ +def binaryEuclidStep (state : ℕ × ℕ) : ℕ × ℕ := + if state.2 = 0 then state + else (state.2, (binaryLongDiv state.1 state.2).2) + +theorem binaryEuclidStep_eq (a b : ℕ) : + binaryEuclidStep (a, b) = + if b = 0 then (a, b) else (b, a % b) := by + simp [binaryEuclidStep, binaryLongDiv_eq_div_mod] + +theorem binaryEuclidStep_zero (a : ℕ) : + binaryEuclidStep (a, 0) = (a, 0) := by + simp [binaryEuclidStep] + +/-- For `0 < r < b`, the next Euclidean remainder is at most half of +`b`. -/ +theorem mod_le_half_of_pos_of_lt {b r : ℕ} (hr0 : 0 < r) (hrb : r < b) : + b % r ≤ b / 2 := by + by_cases hrhalf : r ≤ b / 2 + · exact (Nat.mod_lt b hr0).le.trans hrhalf + · have hbr : r ≤ b := hrb.le + rw [Nat.mod_eq_sub_mod hbr, Nat.mod_eq_of_lt (by omega)] + omega + +/-- Irrespective of the first register, two Euclid steps halve the second +register. -/ +theorem binaryEuclidStep_two_snd_le_half (a b : ℕ) : + ((binaryEuclidStep^[2]) (a, b)).2 ≤ b / 2 := by + by_cases hb : b = 0 + · subst b + simp [Function.iterate_succ_apply, binaryEuclidStep_zero] + · have hbpos : 0 < b := Nat.pos_of_ne_zero hb + let r := a % b + have hrb : r < b := by + dsimp only [r] + exact Nat.mod_lt _ hbpos + have hfirst : binaryEuclidStep (a, b) = (b, r) := by + rw [binaryEuclidStep_eq, if_neg hb] + rw [show (binaryEuclidStep^[2]) (a, b) = + binaryEuclidStep (binaryEuclidStep (a, b)) by rfl, hfirst] + by_cases hr : r = 0 + · rw [hr, binaryEuclidStep_zero] + simp + · rw [binaryEuclidStep_eq, if_neg hr] + simp only [Prod.snd] + exact mod_le_half_of_pos_of_lt (Nat.pos_of_ne_zero hr) hrb + +/-- Fixed-budget Euclid loop. -/ +def binaryEuclidIterate (steps : ℕ) (state : ℕ × ℕ) : ℕ × ℕ := + (binaryEuclidStep^[steps]) state + +theorem binaryEuclidIterate_zero (steps a : ℕ) : + binaryEuclidIterate steps (a, 0) = (a, 0) := by + induction steps with + | zero => rfl + | succ steps ih => + rw [binaryEuclidIterate, Function.iterate_succ_apply, + binaryEuclidStep_zero] + simpa only [binaryEuclidIterate] using ih + +/-- Two steps per available input bit suffice to reach remainder zero. -/ +theorem binaryEuclidIterate_snd_eq_zero_of_lt_pow : + ∀ k a b : ℕ, b < 2 ^ k → + (binaryEuclidIterate (2 * k) (a, b)).2 = 0 := by + intro k + induction k with + | zero => + intro a b hb + have : b = 0 := by simpa using hb + subst b + simp [binaryEuclidIterate] + | succ k ih => + intro a b hb + by_cases hb0 : b = 0 + · subst b + simp [binaryEuclidIterate_zero] + · let afterTwo := (binaryEuclidStep^[2]) (a, b) + have hhalf := binaryEuclidStep_two_snd_le_half a b + have hbhalf : b / 2 < 2 ^ k := by + rw [pow_succ] at hb + omega + have hafter : afterTwo.2 < 2 ^ k := by + exact hhalf.trans_lt hbhalf + have htail := ih afterTwo.1 afterTwo.2 hafter + rw [binaryEuclidIterate] at htail ⊢ + rw [show 2 * (k + 1) = 2 * k + 2 by omega, + Function.iterate_add_apply] + exact htail + +theorem binaryEuclidStep_gcd (state : ℕ × ℕ) : + Nat.gcd (binaryEuclidStep state).1 (binaryEuclidStep state).2 = + Nat.gcd state.1 state.2 := by + rcases state with ⟨a, b⟩ + rw [binaryEuclidStep_eq] + split + · rfl + · simp only [Prod.fst, Prod.snd] + calc + Nat.gcd b (a % b) = Nat.gcd (a % b) b := Nat.gcd_comm _ _ + _ = Nat.gcd b a := (Nat.gcd_rec b a).symm + _ = Nat.gcd a b := Nat.gcd_comm _ _ + +theorem binaryEuclidIterate_gcd (steps : ℕ) (state : ℕ × ℕ) : + Nat.gcd (binaryEuclidIterate steps state).1 + (binaryEuclidIterate steps state).2 = + Nat.gcd state.1 state.2 := by + induction steps generalizing state with + | zero => rfl + | succ steps ih => + rw [binaryEuclidIterate, Function.iterate_succ_apply] + change Nat.gcd + (binaryEuclidIterate steps (binaryEuclidStep state)).1 + (binaryEuclidIterate steps (binaryEuclidStep state)).2 = _ + rw [ih, binaryEuclidStep_gcd] + +/-- Machine-facing gcd: a fixed `2 * bitlength` loop rather than an +unbounded semantic recursion. -/ +def binaryEuclidBounded (a b : ℕ) : ℕ := + (binaryEuclidIterate (2 * b.size) (a, b)).1 + +theorem binaryEuclidBounded_eq_gcd (a b : ℕ) : + binaryEuclidBounded a b = Nat.gcd a b := by + have hb : b < 2 ^ b.size := Nat.lt_size_self b + have hzero := binaryEuclidIterate_snd_eq_zero_of_lt_pow b.size a b hb + have hgcd := binaryEuclidIterate_gcd (2 * b.size) (a, b) + rw [hzero, Nat.gcd_zero_right] at hgcd + exact hgcd + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/BinaryRationalComparison.lean b/LeanPool/BeyondBethe/BeyondBethe/BinaryRationalComparison.lean new file mode 100644 index 0000000000..864157b053 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/BinaryRationalComparison.lean @@ -0,0 +1,93 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.RawRationalBitBounds +import Mathlib.Tactic + +/-! # Binary Rational Comparison -/ + +namespace BeyondBethe + +/-! +# Rational comparison through signed cross multiplication + +The machine-facing numerical path must not hide an order oracle on canonical +rationals. The tests below compare signed cross products of the stored +numerators and positive denominators. Their correctness is a direct +consequence of positivity of the denominators. +-/ + +/-- Strict rational comparison by signed cross multiplication. -/ +def binaryRatLt (q r : ℚ) : Bool := + decide (q.num * (r.den : ℤ) < r.num * (q.den : ℤ)) + +theorem binaryRatLt_eq_true_iff (q r : ℚ) : + binaryRatLt q r = true ↔ q < r := by + simp only [binaryRatLt, decide_eq_true_eq] + constructor + · intro h + have hcross : (q.num : ℚ) * (r.den : ℚ) < + (r.num : ℚ) * (q.den : ℚ) := by + exact_mod_cast h + have hdiv : (q.num : ℚ) / (q.den : ℚ) < + (r.num : ℚ) / (r.den : ℚ) := + (div_lt_div_iff₀ (by positivity) (by positivity)).2 hcross + simpa only [q.num_div_den, r.num_div_den] using hdiv + · intro h + have hdiv : (q.num : ℚ) / (q.den : ℚ) < + (r.num : ℚ) / (r.den : ℚ) := by + simpa only [q.num_div_den, r.num_div_den] using h + have hcross := + (div_lt_div_iff₀ (by positivity : (0 : ℚ) < q.den) + (by positivity : (0 : ℚ) < r.den)).1 hdiv + exact_mod_cast hcross + +/-- Non-strict rational comparison by signed cross multiplication. -/ +def binaryRatLe (q r : ℚ) : Bool := + decide (q.num * (r.den : ℤ) ≤ r.num * (q.den : ℤ)) + +theorem binaryRatLe_eq_true_iff (q r : ℚ) : + binaryRatLe q r = true ↔ q ≤ r := by + simp only [binaryRatLe, decide_eq_true_eq] + constructor + · intro h + have hcross : (q.num : ℚ) * (r.den : ℚ) ≤ + (r.num : ℚ) * (q.den : ℚ) := by + exact_mod_cast h + have hdiv : (q.num : ℚ) / (q.den : ℚ) ≤ + (r.num : ℚ) / (r.den : ℚ) := + (div_le_div_iff₀ (by positivity) (by positivity)).2 hcross + simpa only [q.num_div_den, r.num_div_den] using hdiv + · intro h + have hdiv : (q.num : ℚ) / (q.den : ℚ) ≤ + (r.num : ℚ) / (r.den : ℚ) := by + simpa only [q.num_div_den, r.num_div_den] using h + have hcross := + (div_le_div_iff₀ (by positivity : (0 : ℚ) < q.den) + (by positivity : (0 : ℚ) < r.den)).1 hdiv + exact_mod_cast hcross + +/-- Equality of canonical rationals by equality of their stored fields. -/ +def binaryRatEq (q r : ℚ) : Bool := + decide (q.num = r.num ∧ q.den = r.den) + +theorem binaryRatEq_eq_true_iff (q r : ℚ) : + binaryRatEq q r = true ↔ q = r := by + simp only [binaryRatEq, decide_eq_true_eq] + constructor + · rintro ⟨hnum, hden⟩ + exact Rat.ext hnum hden + · rintro rfl + exact ⟨rfl, rfl⟩ + +/-- Sign test read directly from the stored numerator. -/ +def binaryRatNonnegative (q : ℚ) : Bool := decide (0 ≤ q.num) + +theorem binaryRatNonnegative_eq_true_iff (q : ℚ) : + binaryRatNonnegative q = true ↔ 0 ≤ q := by + simp [binaryRatNonnegative, Rat.num_nonneg] + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/BinaryRationalFloor.lean b/LeanPool/BeyondBethe/BeyondBethe/BinaryRationalFloor.lean new file mode 100644 index 0000000000..8f117b10d9 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/BinaryRationalFloor.lean @@ -0,0 +1,82 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.RawRationalBitBounds +import LeanPool.BeyondBethe.BeyondBethe.DyadicRounding +import Mathlib.Tactic + +/-! # Binary Rational Floor -/ + +namespace BeyondBethe + +/-! +# Rational floor through verified binary division + +The numerical implementation repeatedly rounds rational state entries to a +dyadic grid. This file removes `Int.floor` from the machine-facing path: the +quotient and remainder are obtained by `binaryLongDiv`, whose recurrence and +fixed-width bounds are proved in `BinaryLongDivision.lean`. +-/ + +/-- Euclidean floor of a canonical rational. For a negative numerator, +`-a/d` rounds to `-(a/d)` when the remainder vanishes and to +`-(a/d+1)` otherwise. -/ +def binaryRatFloor (q : ℚ) : ℤ := + let qr := binaryLongDiv q.num.natAbs q.den + if 0 ≤ q.num then + (qr.1 : ℤ) + else if qr.2 = 0 then + -(qr.1 : ℤ) + else + -((qr.1 + 1 : ℕ) : ℤ) + +theorem binaryRatFloor_eq_floor (q : ℚ) : + binaryRatFloor q = Int.floor q := by + rw [Rat.floor_def', binaryRatFloor, binaryLongDiv_eq_div_mod] + simp only [Prod.fst, Prod.snd] + cases hnum : q.num with + | ofNat n => + simp [hnum, Int.ediv] + | negSucc n => + have hden : 0 < q.den := q.den_pos + by_cases hrem : (n + 1) % q.den = 0 + · simp [hnum, hrem, Int.ediv, Int.bdiv, Int.bmod] + have hdvdNat : q.den ∣ n + 1 := Nat.dvd_of_mod_eq_zero hrem + have hdvdInt : (q.den : ℤ) ∣ ((n + 1 : ℕ) : ℤ) := by + exact_mod_cast hdvdNat + have hrepr : Int.negSucc n = -((n + 1 : ℕ) : ℤ) := by omega + rw [hrepr, Int.neg_ediv_of_dvd hdvdInt] + norm_num + · simp [hnum, hrem, Int.ediv, Int.bdiv, Int.bmod] + have hndvdNat : ¬q.den ∣ n + 1 := by + rwa [Nat.dvd_iff_mod_eq_zero] + have hndvdInt : ¬(q.den : ℤ) ∣ ((n + 1 : ℕ) : ℤ) := by + exact_mod_cast hndvdNat + have hrepr : Int.negSucc n = -((n + 1 : ℕ) : ℤ) := by omega + rw [hrepr, Int.neg_ediv, if_neg hndvdInt, + Int.sign_eq_one_of_pos (by exact_mod_cast hden)] + norm_num [Nat.add_comm] + ring + +/-- Ceiling obtained from the same verified floor routine. -/ +def binaryRatCeil (q : ℚ) : ℤ := -binaryRatFloor (-q) + +theorem binaryRatCeil_eq_ceil (q : ℚ) : + binaryRatCeil q = Int.ceil q := by + rw [binaryRatCeil, binaryRatFloor_eq_floor] + simpa only [neg_neg] using + congrArg Neg.neg (Int.floor_neg (a := q)) + +/-- Machine-facing dyadic floor, using verified integer division in the only +non-field operation. -/ +def binaryDyadicFloor (p : ℕ) (q : ℚ) : ℚ := + (binaryRatFloor (q * (2 : ℚ) ^ p) : ℚ) / (2 : ℚ) ^ p + +theorem binaryDyadicFloor_eq_dyadicFloor (p : ℕ) (q : ℚ) : + binaryDyadicFloor p q = dyadicFloor p q := by + rw [binaryDyadicFloor, dyadicFloor, binaryRatFloor_eq_floor] + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/Birkhoff.lean b/LeanPool/BeyondBethe/BeyondBethe/Birkhoff.lean new file mode 100644 index 0000000000..1f8726295c --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/Birkhoff.lean @@ -0,0 +1,130 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.Permanent +import Mathlib.Tactic + +/-! # Birkhoff -/ + +open scoped BigOperators + +namespace BeyondBethe + +/-- Membership in the Birkhoff polytope, stated without bundling the matrix. -/ +def IsDoublyStochastic + {n : Type*} [Fintype n] (X : Matrix n n ℝ) : Prop := + Matrix.Nonnegative X ∧ + (∀ i, ∑ j, X i j = 1) ∧ + (∀ j, ∑ i, X i j = 1) + +theorem IsDoublyStochastic.nonnegative + {n : Type*} [Fintype n] {X : Matrix n n ℝ} + (hX : IsDoublyStochastic X) : Matrix.Nonnegative X := + hX.1 + +theorem IsDoublyStochastic.row_sum + {n : Type*} [Fintype n] {X : Matrix n n ℝ} + (hX : IsDoublyStochastic X) (i : n) : + ∑ j, X i j = 1 := + hX.2.1 i + +theorem IsDoublyStochastic.col_sum + {n : Type*} [Fintype n] {X : Matrix n n ℝ} + (hX : IsDoublyStochastic X) (j : n) : + ∑ i, X i j = 1 := + hX.2.2 j + +theorem IsDoublyStochastic.entry_le_one + {n : Type*} [Fintype n] [DecidableEq n] + {X : Matrix n n ℝ} (hX : IsDoublyStochastic X) (i j : n) : + X i j ≤ 1 := by + rw [← hX.row_sum i] + exact Finset.single_le_sum + (fun k _ ↦ hX.nonnegative i k) (Finset.mem_univ j) + +theorem IsDoublyStochastic.entry_lt_one_of_positive + {n : Type*} [Fintype n] [DecidableEq n] + {X : Matrix n n ℝ} (hX : IsDoublyStochastic X) + (hXpos : ∀ i j, 0 < X i j) (hcard : 1 < Fintype.card n) + (i j : n) : + X i j < 1 := by + obtain ⟨k, hkj⟩ := Fintype.exists_ne_of_one_lt_card hcard j + rw [← hX.row_sum i] + calc + X i j < X i j + X i k := lt_add_of_pos_right _ (hXpos i k) + _ = ∑ l ∈ ({j, k} : Finset n), X i l := by + rw [Finset.sum_pair hkj.symm] + _ ≤ ∑ l, X i l := Finset.sum_le_sum_of_subset_of_nonneg + (Finset.subset_univ _) (fun l _ _ ↦ hX.nonnegative i l) + +/-- Total column mass of two rows. -/ +def pairAlpha {n : Type*} (X : Matrix n n ℝ) (r s j : n) : ℝ := + X r j + X s j + +theorem pairAlpha_nonneg + {n : Type*} [Fintype n] {X : Matrix n n ℝ} + (hX : IsDoublyStochastic X) (r s j : n) : + 0 ≤ pairAlpha X r s j := by + exact add_nonneg (hX.nonnegative r j) (hX.nonnegative s j) + +theorem pairAlpha_le_one + {n : Type*} [Fintype n] [DecidableEq n] + {X : Matrix n n ℝ} (hX : IsDoublyStochastic X) + {r s : n} (hrs : r ≠ s) (j : n) : + pairAlpha X r s j ≤ 1 := by + rw [← hX.col_sum j] + calc + pairAlpha X r s j = ∑ i ∈ ({r, s} : Finset n), X i j := by + simp [pairAlpha, hrs] + _ ≤ ∑ i, X i j := by + exact Finset.sum_le_sum_of_subset_of_nonneg (Finset.subset_univ _) + fun i _ _ ↦ hX.nonnegative i j + +theorem exists_ne_ne_of_two_lt_card + {ι : Type*} [Fintype ι] [DecidableEq ι] + (hcard : 2 < Fintype.card ι) (r s : ι) : + ∃ t, t ≠ r ∧ t ≠ s := by + obtain ⟨x, y, z, hxy, hxz, hyz⟩ := Fintype.two_lt_card_iff.mp hcard + by_cases hx : x ≠ r ∧ x ≠ s + · exact ⟨x, hx⟩ + by_cases hy : y ≠ r ∧ y ≠ s + · exact ⟨y, hy⟩ + simp only [not_and_or, not_ne_iff] at hx hy + rcases hx with hxr | hxs <;> rcases hy with hyr | hys + · exact False.elim (hxy (hxr.trans hyr.symm)) + · refine ⟨z, ?_, ?_⟩ + · exact fun hzr ↦ hxz (hxr.trans hzr.symm) + · exact fun hzs ↦ hyz (hys.trans hzs.symm) + · refine ⟨z, ?_, ?_⟩ + · exact fun hzr ↦ hyz (hyr.trans hzr.symm) + · exact fun hzs ↦ hxz (hxs.trans hzs.symm) + · exact False.elim (hxy (hxs.trans hys.symm)) + +theorem pairAlpha_lt_one_of_positive + {ι : Type*} [Fintype ι] [DecidableEq ι] + {X : Matrix ι ι ℝ} (hX : IsDoublyStochastic X) + (hXpos : ∀ i j, 0 < X i j) (hcard : 2 < Fintype.card ι) + {r s : ι} (hrs : r ≠ s) (j : ι) : + pairAlpha X r s j < 1 := by + obtain ⟨t, htr, hts⟩ := exists_ne_ne_of_two_lt_card hcard r s + calc + pairAlpha X r s j < pairAlpha X r s j + X t j := + lt_add_of_pos_right _ (hXpos t j) + _ = ∑ i ∈ ({r, s, t} : Finset ι), X i j := by + simp [pairAlpha, hrs, Ne.symm htr, Ne.symm hts] + ring + _ ≤ ∑ i, X i j := Finset.sum_le_sum_of_subset_of_nonneg + (Finset.subset_univ _) (fun i _ _ ↦ hX.nonnegative i j) + _ = 1 := hX.col_sum j + +theorem sum_pairAlpha + {n : Type*} [Fintype n] + {X : Matrix n n ℝ} (hX : IsDoublyStochastic X) (r s : n) : + ∑ j, pairAlpha X r s j = 2 := by + simp_rw [pairAlpha, Finset.sum_add_distrib, hX.row_sum] + norm_num + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/Capacity.lean b/LeanPool/BeyondBethe/BeyondBethe/Capacity.lean new file mode 100644 index 0000000000..7219da3bce --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/Capacity.lean @@ -0,0 +1,353 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.CapacityOrder +import LeanPool.BeyondBethe.BeyondBethe.Entropy +import Mathlib.Tactic + +/-! # Capacity -/ + +open scoped BigOperators + +namespace BeyondBethe + +/-- A monomial with a natural exponent vector. -/ +noncomputable def natMonomial + {σ : Type*} [Fintype σ] (z : σ → ℝ) (E : σ → ℕ) : ℝ := + ∏ j, (z j) ^ (E j) + +/-- A finite positive-coefficient polynomial presented by its list of +monomials. -/ +noncomputable def finitePolynomial + {κ σ : Type*} [Fintype κ] [Fintype σ] + (c : κ → ℝ) (E : κ → σ → ℕ) (z : σ → ℝ) : ℝ := + ∑ e, c e * natMonomial z (E e) + +/-- Barycenter of the exponent vectors under a distribution `θ`. -/ +noncomputable def exponentMoment + {κ σ : Type*} [Fintype κ] + (θ : κ → ℝ) (E : κ → σ → ℕ) (j : σ) : ℝ := + ∑ e, θ e * (E e j : ℝ) + +/-- Entropic objective on a positive coefficient representation. -/ +noncomputable def entropyCapacityCertificate + {κ : Type*} [Fintype κ] (θ c : κ → ℝ) : ℝ := + ∑ e, θ e * Real.log (c e / θ e) + +theorem log_natMonomial + {σ : Type*} [Fintype σ] + {z : σ → ℝ} (hz : ∀ j, 0 < z j) (E : σ → ℕ) : + Real.log (natMonomial z E) = + ∑ j, (E j : ℝ) * Real.log (z j) := by + rw [natMonomial, Real.log_prod] + · apply Finset.sum_congr rfl + intro j _ + simpa using Real.log_pow (z j) (E j) + · intro j _ + exact (pow_pos (hz j) _).ne' + +theorem log_realMonomial + {σ : Type*} [Fintype σ] + {z α : σ → ℝ} (hz : ∀ j, 0 < z j) : + Real.log (realMonomial z α) = + ∑ j, α j * Real.log (z j) := by + rw [realMonomial, Real.log_prod] + · apply Finset.sum_congr rfl + intro j _ + exact Real.log_rpow (hz j) (α j) + · intro j _ + exact (Real.rpow_pos_of_pos (hz j) _).ne' + +theorem averaged_log_natMonomial + {κ σ : Type*} [Fintype κ] [Fintype σ] + (θ : κ → ℝ) (E : κ → σ → ℕ) + {z : σ → ℝ} (hz : ∀ j, 0 < z j) : + ∑ e, θ e * Real.log (natMonomial z (E e)) = + ∑ j, exponentMoment θ E j * Real.log (z j) := by + simp_rw [log_natMonomial hz] + calc + ∑ e, θ e * (∑ j, (E e j : ℝ) * Real.log (z j)) = + ∑ e, ∑ j, (θ e * (E e j : ℝ)) * Real.log (z j) := by + apply Finset.sum_congr rfl + intro e _ + rw [Finset.mul_sum] + apply Finset.sum_congr rfl + intro j _ + ring + _ = ∑ j, ∑ e, (θ e * (E e j : ℝ)) * Real.log (z j) := + Finset.sum_comm + _ = ∑ j, exponentMoment θ E j * Real.log (z j) := by + apply Finset.sum_congr rfl + intro j _ + rw [exponentMoment, Finset.sum_mul] + +/-- The certificate-producing direction of paper Lemma 4, for a strictly +positive feasible distribution. Unlike the reverse equality, this direction +uses only finite log-sum and has no convex-duality dependency. -/ +theorem entropyCapacityCertificate_le_log_ratio + {κ σ : Type*} [Fintype κ] [DecidableEq κ] [Fintype σ] + {θ c : κ → ℝ} {E : κ → σ → ℕ} {α z : σ → ℝ} + (hθ : ∀ e, 0 < θ e) (hθsum : ∑ e, θ e = 1) + (hc : ∀ e, 0 < c e) (hz : ∀ j, 0 < z j) + (hmoment : ∀ j, exponentMoment θ E j = α j) : + entropyCapacityCertificate θ c ≤ + Real.log (finitePolynomial c E z / realMonomial z α) := by + let w : κ → ℝ := fun e ↦ c e * natMonomial z (E e) + have hnatpos : ∀ e, 0 < natMonomial z (E e) := by + intro e + rw [natMonomial] + exact Finset.prod_pos fun j _ ↦ pow_pos (hz j) _ + have hw : ∀ e, 0 < w e := fun e ↦ mul_pos (hc e) (hnatpos e) + have hlogsum := log_sum_inequality hθ hθsum hw + have hpoly : ∑ e, w e = finitePolynomial c E z := by + rfl + rw [hpoly] at hlogsum + have hsplit : ∀ e, + Real.log (w e / θ e) = + Real.log (c e / θ e) + Real.log (natMonomial z (E e)) := by + intro e + dsimp [w] + rw [Real.log_div (mul_ne_zero (hc e).ne' (hnatpos e).ne') (hθ e).ne', + Real.log_mul (hc e).ne' (hnatpos e).ne', + Real.log_div (hc e).ne' (hθ e).ne'] + ring + simp_rw [hsplit, mul_add, Finset.sum_add_distrib] at hlogsum + rw [averaged_log_natMonomial θ E hz] at hlogsum + have hmomlog : + ∑ j, exponentMoment θ E j * Real.log (z j) = + Real.log (realMonomial z α) := by + rw [log_realMonomial hz] + apply Finset.sum_congr rfl + intro j _ + rw [hmoment j] + rw [hmomlog] at hlogsum + have hpolypos : 0 < finitePolynomial c E z := by + rw [← hpoly] + exact Finset.sum_pos (fun e _ ↦ hw e) (by + by_contra hempty + have hzero : ∑ e, θ e = 0 := by + rw [Finset.not_nonempty_iff_eq_empty.mp hempty] + simp + linarith) + have hmonopos : 0 < realMonomial z α := by + rw [realMonomial] + exact Finset.prod_pos fun j _ ↦ Real.rpow_pos_of_pos (hz j) _ + rw [Real.log_div hpolypos.ne' hmonopos.ne'] + rw [le_sub_iff_add_le] + simpa [entropyCapacityCertificate, add_comm] using hlogsum + +/-- Certificate-producing capacity inequality with zero witness weights +allowed. This is the boundary form used by the clean-pair witness. -/ +theorem entropyCapacityCertificate_le_log_ratio_nonnegative + {κ σ : Type*} [Fintype κ] [DecidableEq κ] [Fintype σ] + {θ c : κ → ℝ} {E : κ → σ → ℕ} {α z : σ → ℝ} + (hθ : ∀ e, 0 ≤ θ e) (hθsum : ∑ e, θ e = 1) + (hc : ∀ e, 0 < c e) (hz : ∀ j, 0 < z j) + (hmoment : ∀ j, exponentMoment θ E j = α j) : + entropyCapacityCertificate θ c ≤ + Real.log (finitePolynomial c E z / realMonomial z α) := by + let w : κ → ℝ := fun e ↦ c e * natMonomial z (E e) + have hnatpos : ∀ e, 0 < natMonomial z (E e) := by + intro e + rw [natMonomial] + exact Finset.prod_pos fun j _ ↦ pow_pos (hz j) _ + have hw : ∀ e, 0 < w e := fun e ↦ mul_pos (hc e) (hnatpos e) + have hlogsum := log_sum_inequality_nonnegative hθ hθsum hw + have hpoly : ∑ e, w e = finitePolynomial c E z := by + rfl + rw [hpoly] at hlogsum + have hsplit : ∀ e, + θ e * Real.log (w e / θ e) = + θ e * Real.log (c e / θ e) + + θ e * Real.log (natMonomial z (E e)) := by + intro e + by_cases hzero : θ e = 0 + · simp [hzero] + · dsimp [w] + rw [Real.log_div (mul_ne_zero (hc e).ne' (hnatpos e).ne') hzero, + Real.log_mul (hc e).ne' (hnatpos e).ne', + Real.log_div (hc e).ne' hzero] + ring + simp_rw [hsplit, Finset.sum_add_distrib] at hlogsum + rw [averaged_log_natMonomial θ E hz] at hlogsum + have hmomlog : + ∑ j, exponentMoment θ E j * Real.log (z j) = + Real.log (realMonomial z α) := by + rw [log_realMonomial hz] + apply Finset.sum_congr rfl + intro j _ + rw [hmoment j] + rw [hmomlog] at hlogsum + have hpolypos : 0 < finitePolynomial c E z := by + rw [← hpoly] + exact Finset.sum_pos (fun e _ ↦ hw e) (by + by_contra hempty + have hzero : ∑ e, θ e = 0 := by + rw [Finset.not_nonempty_iff_eq_empty.mp hempty] + simp + linarith) + have hmonopos : 0 < realMonomial z α := realMonomial_pos hz α + rw [Real.log_div hpolypos.ne' hmonopos.ne'] + rw [le_sub_iff_add_le] + simpa [entropyCapacityCertificate, add_comm] using hlogsum + +/-- Capacity of a polynomial given by a finite coefficient/exponent list. -/ +noncomputable def finitePolynomialCapacity + {κ σ : Type*} [Fintype κ] [Fintype σ] + (c : κ → ℝ) (E : κ → σ → ℕ) (α : σ → ℝ) : ℝ := + sInf {v : ℝ | ∃ z : σ → ℝ, (∀ j, 0 < z j) ∧ + v = finitePolynomial c E z / realMonomial z α} + +theorem exp_entropyCapacityCertificate_le_finitePolynomialCapacity + {κ σ : Type*} [Fintype κ] [DecidableEq κ] [Fintype σ] + {θ c : κ → ℝ} {E : κ → σ → ℕ} {α : σ → ℝ} + (hθ : ∀ e, 0 ≤ θ e) (hθsum : ∑ e, θ e = 1) + (hc : ∀ e, 0 < c e) + (hmoment : ∀ j, exponentMoment θ E j = α j) : + Real.exp (entropyCapacityCertificate θ c) ≤ + finitePolynomialCapacity c E α := by + apply le_csInf + · let one : σ → ℝ := fun _ ↦ 1 + exact ⟨finitePolynomial c E one / realMonomial one α, + ⟨one, fun _ ↦ by norm_num, rfl⟩⟩ + · intro value hvalue + obtain ⟨z, hz, rfl⟩ := hvalue + have hlog := entropyCapacityCertificate_le_log_ratio_nonnegative + hθ hθsum hc hz hmoment + have hpolypos : 0 < finitePolynomial c E z := by + rw [finitePolynomial] + exact Finset.sum_pos (fun e _ ↦ mul_pos (hc e) (by + rw [natMonomial] + exact Finset.prod_pos fun j _ ↦ pow_pos (hz j) _)) + (by + by_contra hempty + have hzero : ∑ e, θ e = 0 := by + rw [Finset.not_nonempty_iff_eq_empty.mp hempty] + simp + linarith) + have hratio : 0 < finitePolynomial c E z / realMonomial z α := + div_pos hpolypos (realMonomial_pos hz α) + have hexp := Real.exp_le_exp.mpr hlog + rw [Real.exp_log hratio] at hexp + exact hexp + +theorem entropyCapacityCertificate_le_log_finitePolynomialCapacity + {κ σ : Type*} [Fintype κ] [DecidableEq κ] [Fintype σ] + {θ c : κ → ℝ} {E : κ → σ → ℕ} {α : σ → ℝ} + (hθ : ∀ e, 0 ≤ θ e) (hθsum : ∑ e, θ e = 1) + (hc : ∀ e, 0 < c e) + (hmoment : ∀ j, exponentMoment θ E j = α j) : + entropyCapacityCertificate θ c ≤ + Real.log (finitePolynomialCapacity c E α) := by + have hexp := exp_entropyCapacityCertificate_le_finitePolynomialCapacity + hθ hθsum hc hmoment + have hcap : 0 < finitePolynomialCapacity c E α := + (Real.exp_pos _).trans_le hexp + have hlog := Real.log_le_log (Real.exp_pos _) hexp + rw [Real.log_exp] at hlog + exact hlog + +noncomputable def supportCoefficient + {σ : Type*} (p : MvPolynomial σ ℝ) (d : p.support) : ℝ := + p.coeff d + +def supportExponent + {σ : Type*} (p : MvPolynomial σ ℝ) (d : p.support) (j : σ) : ℕ := + d.1 j + +theorem finitePolynomial_support_eq_eval + {σ : Type*} [Fintype σ] (p : MvPolynomial σ ℝ) (z : σ → ℝ) : + finitePolynomial (supportCoefficient p) (supportExponent p) z = + p.eval z := by + classical + rw [finitePolynomial, MvPolynomial.eval_eq] + calc + (∑ d : p.support, + supportCoefficient p d * natMonomial z (supportExponent p d)) = + ∑ d ∈ p.support, p.coeff d * ∏ j, z j ^ d j := by + simpa [supportCoefficient, supportExponent, natMonomial] using + Finset.sum_coe_sort p.support + (fun d ↦ p.coeff d * ∏ j, z j ^ d j) + _ = ∑ d ∈ p.support, + p.coeff d * ∏ i ∈ d.support, z i ^ d i := by + apply Finset.sum_congr rfl + intro d _ + congr 1 + change (∏ j, z j ^ d j) = d.prod (fun i e ↦ z i ^ e) + exact (Finsupp.prod_fintype d (fun i e ↦ z i ^ e) + (fun i ↦ pow_zero (z i))).symm + +theorem finitePolynomialCapacity_support_eq_polynomialCapacity + {σ : Type*} [Fintype σ] (p : MvPolynomial σ ℝ) (α : σ → ℝ) : + finitePolynomialCapacity (supportCoefficient p) (supportExponent p) α = + polynomialCapacity α p := by + rw [finitePolynomialCapacity, polynomialCapacity] + congr 1 + ext value + simp only [Set.mem_setOf_eq] + constructor + · rintro ⟨z, hz, rfl⟩ + exact ⟨z, hz, by rw [finitePolynomial_support_eq_eval]⟩ + · rintro ⟨z, hz, rfl⟩ + exact ⟨z, hz, by rw [finitePolynomial_support_eq_eval]⟩ + +/-- One-sided entropy certificate for an `MvPolynomial`, including boundary +witnesses with zero weights. Unlike the reverse entropy-duality equality, +this theorem is proved directly from log-sum. -/ +theorem supportEntropyCertificate_le_log_polynomialCapacity + {σ : Type*} [Fintype σ] + {p : MvPolynomial σ ℝ} {θ : p.support → ℝ} {α : σ → ℝ} + (hθ : ∀ d, 0 ≤ θ d) (hθsum : ∑ d, θ d = 1) + (hcoeff : ∀ d : p.support, 0 < p.coeff d) + (hmoment : ∀ j, + exponentMoment θ (supportExponent p) j = α j) : + entropyCapacityCertificate θ (supportCoefficient p) ≤ + Real.log (polynomialCapacity α p) := by + classical + rw [← finitePolynomialCapacity_support_eq_polynomialCapacity] + exact entropyCapacityCertificate_le_log_finitePolynomialCapacity + hθ hθsum hcoeff hmoment + +theorem finitePolynomial_nonneg + {κ σ : Type*} [Fintype κ] [Fintype σ] + {c : κ → ℝ} {E : κ → σ → ℕ} {z : σ → ℝ} + (hc : ∀ e, 0 ≤ c e) (hz : ∀ j, 0 ≤ z j) : + 0 ≤ finitePolynomial c E z := by + rw [finitePolynomial] + exact Finset.sum_nonneg fun e _ ↦ mul_nonneg (hc e) + (Finset.prod_nonneg fun j _ ↦ pow_nonneg (hz j) _) + +/-- A nonnegative finite subpolynomial has no larger capacity than the full +polynomial. This lets the sparse clean-pair witness ignore all unused +monomials. -/ +theorem finitePolynomialCapacity_le_polynomialCapacity_of_eval_le + {κ σ : Type*} [Fintype κ] [Fintype σ] + {c : κ → ℝ} {E : κ → σ → ℕ} {α : σ → ℝ} + {p : MvPolynomial σ ℝ} + (hc : ∀ e, 0 ≤ c e) + (heval : ∀ z : σ → ℝ, (∀ j, 0 ≤ z j) → + finitePolynomial c E z ≤ p.eval z) : + finitePolynomialCapacity c E α ≤ polynomialCapacity α p := by + apply le_csInf + · let one : σ → ℝ := fun _ ↦ 1 + exact ⟨p.eval one / realMonomial one α, + ⟨one, fun _ ↦ by norm_num, rfl⟩⟩ + · intro value hvalue + obtain ⟨z, hz, rfl⟩ := hvalue + have hmono : 0 < realMonomial z α := realMonomial_pos hz α + have hfinUpper : finitePolynomialCapacity c E α ≤ + finitePolynomial c E z / realMonomial z α := by + apply csInf_le + · exact ⟨0, fun value hvalue ↦ by + obtain ⟨w, hw, rfl⟩ := hvalue + exact div_nonneg + (finitePolynomial_nonneg hc (fun j ↦ (hw j).le)) + (realMonomial_pos hw α).le⟩ + · exact ⟨z, hz, rfl⟩ + exact hfinUpper.trans + (div_le_div_of_nonneg_right (heval z (fun j ↦ (hz j).le)) hmono.le) + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/CapacityOrder.lean b/LeanPool/BeyondBethe/BeyondBethe/CapacityOrder.lean new file mode 100644 index 0000000000..9499a6f6c0 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/CapacityOrder.lean @@ -0,0 +1,79 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.Stable +import Mathlib.Tactic + +/-! # Capacity Order -/ + +open scoped BigOperators + +namespace BeyondBethe + +open MvPolynomial + +theorem realMonomial_pos + {σ : Type*} [Fintype σ] {z : σ → ℝ} + (hz : ∀ i, 0 < z i) (α : σ → ℝ) : + 0 < realMonomial z α := by + rw [realMonomial] + exact Finset.prod_pos fun i _ ↦ Real.rpow_pos_of_pos (hz i) _ + +theorem eval_nonneg_of_nonnegativeCoefficients + {σ : Type*} [Fintype σ] + {p : MvPolynomial σ ℝ} (hp : HasNonnegativeCoefficients p) + {z : σ → ℝ} (hz : ∀ i, 0 ≤ z i) : + 0 ≤ p.eval z := by + rw [eval_eq] + apply Finset.sum_nonneg + intro d _ + exact mul_nonneg (hp d) (Finset.prod_nonneg fun i _ ↦ + pow_nonneg (hz i) _) + +theorem polynomialCapacity_nonneg + {σ : Type*} [Fintype σ] + {p : MvPolynomial σ ℝ} (hp : HasNonnegativeCoefficients p) + (α : σ → ℝ) : + 0 ≤ polynomialCapacity α p := by + apply le_csInf + · let one : σ → ℝ := fun _ ↦ 1 + exact ⟨p.eval one / realMonomial one α, + ⟨one, fun _ ↦ by norm_num, rfl⟩⟩ + · intro b hb + obtain ⟨z, hz, rfl⟩ := hb + exact div_nonneg + (eval_nonneg_of_nonnegativeCoefficients hp (fun i ↦ le_of_lt (hz i))) + (le_of_lt (realMonomial_pos hz α)) + +theorem polynomialCapacity_le_ratio + {σ : Type*} [Fintype σ] + {p : MvPolynomial σ ℝ} (hp : HasNonnegativeCoefficients p) + (α z : σ → ℝ) (hz : ∀ i, 0 < z i) : + polynomialCapacity α p ≤ p.eval z / realMonomial z α := by + apply csInf_le + · exact ⟨0, fun b hb ↦ by + obtain ⟨w, hw, rfl⟩ := hb + exact div_nonneg + (eval_nonneg_of_nonnegativeCoefficients hp + (fun i ↦ le_of_lt (hw i))) + (le_of_lt (realMonomial_pos hw α))⟩ + · exact ⟨z, hz, rfl⟩ + +theorem le_polynomialCapacity_of_le_ratio + {σ : Type*} [Fintype σ] + {p : MvPolynomial σ ℝ} {α : σ → ℝ} {L : ℝ} + (hL : ∀ z : σ → ℝ, (∀ i, 0 < z i) → + L ≤ p.eval z / realMonomial z α) : + L ≤ polynomialCapacity α p := by + apply le_csInf + · let one : σ → ℝ := fun _ ↦ 1 + exact ⟨p.eval one / realMonomial one α, + ⟨one, fun _ ↦ by norm_num, rfl⟩⟩ + · intro b hb + obtain ⟨z, hz, rfl⟩ := hb + exact hL z hz + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/CapacityScaling.lean b/LeanPool/BeyondBethe/BeyondBethe/CapacityScaling.lean new file mode 100644 index 0000000000..5aaa0a199b --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/CapacityScaling.lean @@ -0,0 +1,87 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.CapacityOrder +import Mathlib.Tactic + +/-! # Capacity Scaling -/ + +open scoped BigOperators + +namespace BeyondBethe + +open MvPolynomial + +theorem realMonomial_pointwise_mul + {σ : Type*} [Fintype σ] + (c z α : σ → ℝ) (hc : ∀ i, 0 ≤ c i) (hz : ∀ i, 0 ≤ z i) : + realMonomial (fun i ↦ c i * z i) α = + realMonomial c α * realMonomial z α := by + rw [realMonomial, realMonomial, realMonomial, + ← Finset.prod_mul_distrib] + apply Finset.prod_congr rfl + intro i _ + exact Real.mul_rpow (hc i) (hz i) + +theorem rescaled_polynomial_ratio_eq + {σ : Type*} [Fintype σ] + {p q : MvPolynomial σ ℝ} {α c z : σ → ℝ} {scale : ℝ} + (hc : ∀ i, 0 < c i) (hz : ∀ i, 0 < z i) + (heval : ∀ w : σ → ℝ, + p.eval w = scale * q.eval (fun i ↦ c i * w i)) : + p.eval z / realMonomial z α = + (scale * realMonomial c α) * + (q.eval (fun i ↦ c i * z i) / + realMonomial (fun i ↦ c i * z i) α) := by + have hcz : realMonomial (fun i ↦ c i * z i) α = + realMonomial c α * realMonomial z α := + realMonomial_pointwise_mul c z α + (fun i ↦ (hc i).le) (fun i ↦ (hz i).le) + rw [heval, hcz] + field_simp [ne_of_gt (realMonomial_pos hc α), + ne_of_gt (realMonomial_pos hz α)] + +/-- Capacity is covariant under a positive scalar and a positive diagonal +change of variables. This is the exact rescaling used in paper Lemma 18. -/ +theorem polynomialCapacity_eq_of_positive_diagonal_rescaling + {σ : Type*} [Fintype σ] + {p q : MvPolynomial σ ℝ} {α c : σ → ℝ} {scale : ℝ} + (hp : HasNonnegativeCoefficients p) + (hq : HasNonnegativeCoefficients q) + (hscale : 0 < scale) (hc : ∀ i, 0 < c i) + (heval : ∀ z : σ → ℝ, + p.eval z = scale * q.eval (fun i ↦ c i * z i)) : + polynomialCapacity α p = + (scale * realMonomial c α) * polynomialCapacity α q := by + let k : ℝ := scale * realMonomial c α + have hk : 0 < k := mul_pos hscale (realMonomial_pos hc α) + apply le_antisymm + · have hdiv : polynomialCapacity α p / k ≤ + polynomialCapacity α q := by + apply le_polynomialCapacity_of_le_ratio + intro w hw + let z : σ → ℝ := fun i ↦ w i / c i + have hz : ∀ i, 0 < z i := fun i ↦ div_pos (hw i) (hc i) + have hcz : (fun i ↦ c i * z i) = w := by + funext i + dsimp [z] + field_simp [ne_of_gt (hc i)] + have hratio := rescaled_polynomial_ratio_eq (α := α) hc hz heval + rw [hcz] at hratio + have hupper := polynomialCapacity_le_ratio hp α z hz + rw [hratio] at hupper + exact (div_le_iff₀ hk).2 (by simpa [k, mul_comm] using hupper) + simpa [k, mul_comm] using (div_le_iff₀ hk).1 hdiv + · apply le_polynomialCapacity_of_le_ratio + intro z hz + let w : σ → ℝ := fun i ↦ c i * z i + have hw : ∀ i, 0 < w i := fun i ↦ mul_pos (hc i) (hz i) + have hlower := polynomialCapacity_le_ratio hq α w hw + have hratio := rescaled_polynomial_ratio_eq (α := α) hc hz heval + rw [hratio] + exact mul_le_mul_of_nonneg_left hlower hk.le + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/CertificateCapacity.lean b/LeanPool/BeyondBethe/BeyondBethe/CertificateCapacity.lean new file mode 100644 index 0000000000..0e6a858364 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/CertificateCapacity.lean @@ -0,0 +1,263 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.ClusterFactors +import LeanPool.BeyondBethe.BeyondBethe.CapacityOrder +import Mathlib.Analysis.MeanInequalities + +/-! # Certificate Capacity -/ + +open scoped BigOperators + +namespace BeyondBethe + +open MvPolynomial + +noncomputable def linearCapacityValue + {ι : Type*} [Fintype ι] + (u α : ι → ℝ) : ℝ := + ∏ i, (u i / α i) ^ (α i) + +theorem positiveLinearPolynomial_eval + {ι : Type*} [Fintype ι] [DecidableEq ι] + (u z : ι → ℝ) : + (positiveLinearPolynomial u).eval z = ∑ i, u i * z i := by + rw [positiveLinearPolynomial, eval_sum] + apply Finset.sum_congr rfl + intro i _ + rw [eval_monomial] + simp + +theorem linearCapacityValue_mul_realMonomial + {ι : Type*} [Fintype ι] + {u α z : ι → ℝ} + (hu : ∀ i, 0 < u i) (hα : ∀ i, 0 < α i) + (hz : ∀ i, 0 < z i) : + linearCapacityValue u α * realMonomial z α = + ∏ i, (u i * z i / α i) ^ (α i) := by + rw [linearCapacityValue, realMonomial, ← Finset.prod_mul_distrib] + apply Finset.prod_congr rfl + intro i _ + rw [← Real.mul_rpow (le_of_lt (div_pos (hu i) (hα i))) + (le_of_lt (hz i))] + congr 1 + field_simp + +theorem linearCapacityValue_le_ratio + {ι : Type*} [Fintype ι] [DecidableEq ι] + {u α z : ι → ℝ} + (hu : ∀ i, 0 < u i) (hα : ∀ i, 0 < α i) + (hαsum : ∑ i, α i = 1) (hz : ∀ i, 0 < z i) : + linearCapacityValue u α ≤ + (positiveLinearPolynomial u).eval z / realMonomial z α := by + rw [le_div_iff₀ (realMonomial_pos hz α), + linearCapacityValue_mul_realMonomial hu hα hz, + positiveLinearPolynomial_eval] + calc + (∏ i, (u i * z i / α i) ^ (α i)) ≤ + ∑ i, α i * (u i * z i / α i) := by + exact Real.geom_mean_le_arith_mean_weighted Finset.univ α + (fun i ↦ u i * z i / α i) + (fun i _ ↦ le_of_lt (hα i)) hαsum + (fun i _ ↦ le_of_lt (div_pos (mul_pos (hu i) (hz i)) (hα i))) + _ = ∑ i, u i * z i := by + apply Finset.sum_congr rfl + intro i _ + field_simp [ne_of_gt (hα i)] + +theorem linearCapacityValue_le_capacity + {ι : Type*} [Fintype ι] [DecidableEq ι] + {u α : ι → ℝ} + (hu : ∀ i, 0 < u i) (hα : ∀ i, 0 < α i) + (hαsum : ∑ i, α i = 1) : + linearCapacityValue u α ≤ + polynomialCapacity α (positiveLinearPolynomial u) := by + apply le_polynomialCapacity_of_le_ratio + intro z hz + exact linearCapacityValue_le_ratio hu hα hαsum hz + +/-- Exact weighted AM--GM capacity of a positive linear form. -/ +theorem linearCapacityValue_eq_capacity + {ι : Type*} [Fintype ι] [DecidableEq ι] + {u α : ι → ℝ} + (hu : ∀ i, 0 < u i) (hα : ∀ i, 0 < α i) + (hαsum : ∑ i, α i = 1) : + linearCapacityValue u α = + polynomialCapacity α (positiveLinearPolynomial u) := by + apply le_antisymm + · exact linearCapacityValue_le_capacity hu hα hαsum + · let z : ι → ℝ := fun i ↦ α i / u i + have hz : ∀ i, 0 < z i := fun i ↦ div_pos (hα i) (hu i) + have hupper := polynomialCapacity_le_ratio + (p := positiveLinearPolynomial u) + (positiveLinearPolynomial_nonnegativeCoefficients + (fun i ↦ le_of_lt (hu i))) α z hz + have heval : (positiveLinearPolynomial u).eval z = 1 := by + rw [positiveLinearPolynomial_eval] + calc + (∑ i, u i * z i) = ∑ i, α i := by + apply Finset.sum_congr rfl + intro i _ + dsimp [z] + field_simp [ne_of_gt (hu i)] + _ = 1 := hαsum + have hterm : ∀ i, + (z i) ^ (α i) = ((u i / α i) ^ (α i))⁻¹ := by + intro i + have hratio : z i = (u i / α i)⁻¹ := by + dsimp [z] + field_simp [ne_of_gt (hu i), ne_of_gt (hα i)] + rw [hratio, Real.inv_rpow (le_of_lt (div_pos (hu i) (hα i)))] + have hmono : realMonomial z α = (linearCapacityValue u α)⁻¹ := by + rw [realMonomial, linearCapacityValue] + simp_rw [hterm] + exact Finset.prod_inv_distrib _ + rw [heval, hmono, one_div, inv_inv] at hupper + exact hupper + +noncomputable def selectorCapacityValue + {κ ι : Type*} [Fintype κ] [Fintype ι] + (α : κ × ι → ℝ) : ℝ := + ∏ j, linearCapacityValue (fun _ : κ ↦ 1) (fun c ↦ α (c, j)) + +theorem columnSelector_eval + {κ ι : Type*} [Fintype κ] [DecidableEq κ] + [Fintype ι] [DecidableEq ι] + (z : κ × ι → ℝ) : + (columnSelector κ ι).eval z = ∏ j, ∑ c, z (c, j) := by + rw [columnSelector_eq_product, columnSelectorProduct, eval_prod] + apply Finset.prod_congr rfl + intro j _ + rw [eval_sum] + simp + +theorem realMonomial_eq_prod_columns + {κ ι : Type*} [Fintype κ] [Fintype ι] + (z α : κ × ι → ℝ) : + realMonomial z α = + ∏ j, realMonomial (fun c ↦ z (c, j)) (fun c ↦ α (c, j)) := by + rw [realMonomial] + simp only [realMonomial, Fintype.prod_prod_type] + exact Finset.prod_comm + +theorem selectorCapacityValue_mul_realMonomial + {κ ι : Type*} [Fintype κ] [Fintype ι] + {α : κ × ι → ℝ} {z : κ × ι → ℝ} + (hα : ∀ v, 0 < α v) (hz : ∀ v, 0 < z v) : + selectorCapacityValue α * realMonomial z α = + ∏ j, (linearCapacityValue (fun _ : κ ↦ 1) + (fun c ↦ α (c, j)) * + realMonomial (fun c ↦ z (c, j)) (fun c ↦ α (c, j))) := by + rw [selectorCapacityValue, realMonomial_eq_prod_columns, + ← Finset.prod_mul_distrib] + +theorem selectorCapacityValue_le_ratio + {κ ι : Type*} [Fintype κ] [DecidableEq κ] + [Fintype ι] [DecidableEq ι] + {α : κ × ι → ℝ} {z : κ × ι → ℝ} + (hα : ∀ v, 0 < α v) + (hαcol : ∀ j, ∑ c, α (c, j) = 1) + (hz : ∀ v, 0 < z v) : + selectorCapacityValue α ≤ + (columnSelector κ ι).eval z / realMonomial z α := by + rw [le_div_iff₀ (realMonomial_pos hz α), columnSelector_eval, + selectorCapacityValue_mul_realMonomial hα hz] + apply Finset.prod_le_prod + · intro j _ + exact mul_nonneg + (Finset.prod_nonneg fun c _ ↦ Real.rpow_nonneg + (le_of_lt (div_pos (by norm_num) (hα (c, j)))) _) + (le_of_lt (realMonomial_pos (fun c ↦ hz (c, j)) + (fun c ↦ α (c, j)))) + · intro j _ + have hlin := linearCapacityValue_le_ratio + (u := fun _ : κ ↦ 1) (α := fun c ↦ α (c, j)) + (z := fun c ↦ z (c, j)) + (fun _ ↦ by norm_num) (fun c ↦ hα (c, j)) + (hαcol j) (fun c ↦ hz (c, j)) + rw [le_div_iff₀ (realMonomial_pos (fun c ↦ hz (c, j)) + (fun c ↦ α (c, j)))] at hlin + simpa only [positiveLinearPolynomial_eval, one_mul] using hlin + +theorem selectorCapacityValue_le_capacity + {κ ι : Type*} [Fintype κ] [DecidableEq κ] + [Fintype ι] [DecidableEq ι] + {α : κ × ι → ℝ} + (hα : ∀ v, 0 < α v) + (hαcol : ∀ j, ∑ c, α (c, j) = 1) : + selectorCapacityValue α ≤ + polynomialCapacity α (columnSelector κ ι) := by + apply le_polynomialCapacity_of_le_ratio + intro z hz + exact selectorCapacityValue_le_ratio hα hαcol hz + +noncomputable def clusterProductCapacityValue + {n : ℕ} (A : Matrix (Fin n) (Fin n) ℝ) (C : RowClustering n) + (α : C.Cluster × Fin n → ℝ) : ℝ := + ∏ c, polynomialCapacity (fun j ↦ α (c, j)) + (injectionPolynomial (fun k j ↦ A (C.rows ⟨c, k⟩) j)) + +theorem rowClusterProduct_eval_eq_prod_injection + {n : ℕ} (A : Matrix (Fin n) (Fin n) ℝ) (C : RowClustering n) + (z : C.Cluster × Fin n → ℝ) : + (rowClusterProduct A C).eval z = + ∏ c, (injectionPolynomial + (fun k j ↦ A (C.rows ⟨c, k⟩) j)).eval (fun j ↦ z (c, j)) := by + rw [rowClusterProduct, eval_prod] + apply Finset.prod_congr rfl + intro c _ + rw [rowClusterPolynomial_eq_rename_injectionPolynomial, + eval_rename] + rfl + +theorem realMonomial_eq_prod_clusters + {κ ι : Type*} [Fintype κ] [Fintype ι] + (z α : κ × ι → ℝ) : + realMonomial z α = + ∏ c, realMonomial (fun j ↦ z (c, j)) (fun j ↦ α (c, j)) := by + rw [realMonomial] + simp only [realMonomial, Fintype.prod_prod_type] + +theorem clusterProductCapacityValue_nonneg + {n : ℕ} {A : Matrix (Fin n) (Fin n) ℝ} (C : RowClustering n) + (hA : Matrix.Nonnegative A) (α : C.Cluster × Fin n → ℝ) : + 0 ≤ clusterProductCapacityValue A C α := by + rw [clusterProductCapacityValue] + exact Finset.prod_nonneg fun c _ ↦ polynomialCapacity_nonneg + (injectionPolynomial_nonnegativeCoefficients + (fun k j ↦ hA (C.rows ⟨c, k⟩) j)) _ + +theorem clusterProductCapacityValue_le_ratio + {n : ℕ} {A : Matrix (Fin n) (Fin n) ℝ} (C : RowClustering n) + (hA : Matrix.Nonnegative A) (α : C.Cluster × Fin n → ℝ) + (z : C.Cluster × Fin n → ℝ) (hz : ∀ v, 0 < z v) : + clusterProductCapacityValue A C α ≤ + (rowClusterProduct A C).eval z / realMonomial z α := by + rw [clusterProductCapacityValue, + rowClusterProduct_eval_eq_prod_injection, + realMonomial_eq_prod_clusters, ← Finset.prod_div_distrib] + apply Finset.prod_le_prod + · intro c _ + exact polynomialCapacity_nonneg + (injectionPolynomial_nonnegativeCoefficients + (fun k j ↦ hA (C.rows ⟨c, k⟩) j)) _ + · intro c _ + exact polynomialCapacity_le_ratio + (injectionPolynomial_nonnegativeCoefficients + (fun k j ↦ hA (C.rows ⟨c, k⟩) j)) + (fun j ↦ α (c, j)) (fun j ↦ z (c, j)) + (fun j ↦ hz (c, j)) + +theorem clusterProductCapacityValue_le_capacity + {n : ℕ} {A : Matrix (Fin n) (Fin n) ℝ} (C : RowClustering n) + (hA : Matrix.Nonnegative A) (α : C.Cluster × Fin n → ℝ) : + clusterProductCapacityValue A C α ≤ + polynomialCapacity α (rowClusterProduct A C) := by + apply le_polynomialCapacity_of_le_ratio + intro z hz + exact clusterProductCapacityValue_le_ratio C hA α z hz + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/CertificateMagnitude.lean b/LeanPool/BeyondBethe/BeyondBethe/CertificateMagnitude.lean new file mode 100644 index 0000000000..9c7ada2ddb --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/CertificateMagnitude.lean @@ -0,0 +1,446 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.ExplicitBetheOptimizer +import LeanPool.BeyondBethe.BeyondBethe.MachineMatrixDimension +import LeanPool.BeyondBethe.BeyondBethe.RationalEncodingBounds +import LeanPool.BeyondBethe.BeyondBethe.SourceStableReindex +import Mathlib.Tactic + +/-! # Certificate Magnitude -/ + +open scoped BigOperators + +namespace BeyondBethe + +open Complexity + +/-! +# A polynomial magnitude bound for the final certificate logarithm + +The rational exponential routine necessarily has running time proportional to +the bit length of its answer. This file proves that, on the positive +normalized matrices on which the optimizer is used, the logarithm passed to +that routine has polynomial numerical magnitude. The proof avoids inspecting +the optimizer's rational arithmetic: the certified permanent sandwich and the +elementary input-size bounds on the permanent already give both sides. +-/ + +def explicitCertificateMagnitudeBudget {n : ℕ} + (B : Matrix (Fin n) (Fin n) ℚ) : ℕ := + n * (rationalMatrixEntryBitBound B + n + 1) + +def rationalListDataCost (xs : List ℚ) : ℕ := + (xs.map fun q ↦ encodedBitLength ℚ q).sum + +def rationalRowsDataCost (rows : List (List ℚ)) : ℕ := + (rows.map rationalListDataCost).sum + +theorem rational_encodedBitLength_le_entryCode (q : ℚ) : + encodedBitLength ℚ q ≤ 12 + 8 * (rationalEntryBinaryCode q).length := by + have h := rational_encodedBitLength_le q + have hnum := integerNatAbs_size_le_binaryCode_length q.num + have hnumCode : (integerBinaryCode q.num).length ≤ + (rationalEntryBinaryCode q).length := by + rw [rationalEntryBinaryCode, pair_length] + omega + have hden : q.den.size ≤ (rationalEntryBinaryCode q).length := by + rw [rationalEntryBinaryCode, pair_length, Nat.size_eq_bits_len] + omega + omega + +theorem rationalListDataCost_le (xs : List ℚ) : + rationalListDataCost xs ≤ + 12 * xs.length + 8 * (binaryListCode rationalEntryBinaryCode xs).length := by + induction xs with + | nil => simp [rationalListDataCost, binaryListCode] + | cons q qs ih => + rw [rationalListDataCost, List.map_cons, List.sum_cons, + List.length_cons, binaryListCode, pair_length] + have hq := rational_encodedBitLength_le_entryCode q + have ih' : (qs.map fun q ↦ encodedBitLength ℚ q).sum ≤ + 12 * qs.length + + 8 * (binaryListCode rationalEntryBinaryCode qs).length := by + simpa only [rationalListDataCost] using ih + omega + +theorem rationalRowsDataCost_le (rows : List (List ℚ)) : + rationalRowsDataCost rows ≤ + 12 * (rows.map List.length).sum + + 8 * (binaryListCode (binaryListCode rationalEntryBinaryCode) rows).length := by + induction rows with + | nil => simp [rationalRowsDataCost, binaryListCode] + | cons row rows ih => + rw [rationalRowsDataCost, List.map_cons, List.sum_cons, + binaryListCode, pair_length] + simp only [List.map_cons, List.sum_cons] + have hrow := rationalListDataCost_le row + have ih' : (rows.map rationalListDataCost).sum ≤ + 12 * (rows.map List.length).sum + + 8 * (binaryListCode + (binaryListCode rationalEntryBinaryCode) rows).length := by + simpa only [rationalRowsDataCost] using ih + omega + +theorem rationalRowsEntryCount_le_codeLength (rows : List (List ℚ)) : + (rows.map List.length).sum ≤ + (binaryListCode (binaryListCode rationalEntryBinaryCode) rows).length := by + induction rows with + | nil => simp [binaryListCode] + | cons row rows ih => + rw [List.map_cons, List.sum_cons, binaryListCode, pair_length] + have hrow := list_length_le_binaryListCode_length + rationalEntryBinaryCode row + omega + +theorem rationalMatrixEntryBitBound_le_machineCode + {n : ℕ} (hn : 1 ≤ n) (B : Matrix (Fin n) (Fin n) ℚ) : + rationalMatrixEntryBitBound B ≤ + 32 * (rationalMatrixBinaryEncoding.encode ⟨n, B⟩).length := by + let rows := rationalMatrixRows B + let rowsCode := binaryListCode + (binaryListCode rationalEntryBinaryCode) rows + let word := rationalMatrixBinaryEncoding.encode ⟨n, B⟩ + have hrowsCode : rowsCode.length ≤ word.length := by + change rowsCode.length ≤ (pair n.bits rowsCode).length + simpa using machinePairSecond_length_le (pair n.bits rowsCode) + have hcount : n ^ 2 = (rows.map List.length).sum := by + simp only [rows, rationalMatrixRows, List.map_ofFn, List.sum_ofFn, + Function.comp_apply, List.length_ofFn] + simp + ring + have hnSq : n ^ 2 ≤ word.length := by + rw [hcount] + exact (rationalRowsEntryCount_le_codeLength rows).trans hrowsCode + have hcost : + (∑ i, ∑ j, encodedBitLength ℚ (B i j)) = rationalRowsDataCost rows := by + simp only [rationalRowsDataCost, rationalListDataCost, rows, + rationalMatrixRows, List.map_ofFn, List.sum_ofFn, Function.comp_apply] + have hdata := rationalRowsDataCost_le rows + rw [← hcost, ← hcount] at hdata + have hwordPos : 1 ≤ word.length := hn.trans (matrix_dimension_le_code_length B) + rw [rationalMatrixEntryBitBound] + nlinarith + +theorem positive_normalized_log_permanent_bounds + {n : ℕ} (hn : 1 ≤ n) + (B : Matrix (Fin n) (Fin n) ℚ) + (hBpos : ∀ i j, 0 < B i j) + (hBupper : ∀ i j, B i j ≤ 1) : + -(n * rationalMatrixEntryBitBound B : ℝ) ≤ + Real.log (Matrix.permanent (fun i j ↦ (B i j : ℝ))) ∧ + Real.log (Matrix.permanent (fun i j ↦ (B i j : ℝ))) ≤ + (n : ℝ) ^ 2 := by + classical + let Br : Matrix (Fin n) (Fin n) ℝ := fun i j ↦ (B i j : ℝ) + let J : Matrix (Fin n) (Fin n) ℝ := fun _ _ ↦ 1 + let L := rationalMatrixEntryBitBound B + let d : ℚ := (1 / 2 : ℚ) ^ L + have hBrpos : Matrix.Positive Br := by + intro i j + exact Rat.cast_pos.mpr (hBpos i j) + have hBr0 : Matrix.Nonnegative Br := fun i j ↦ (hBrpos i j).le + have hperpos : 0 < Matrix.permanent Br := + permanent_pos_of_positive Br hBrpos + have hdQ : 0 < d := by positivity + have hdR : 0 < (d : ℝ) := Rat.cast_pos.mpr hdQ + have hmin : ∀ i j, (d : ℝ) ≤ Br i j := by + intro i j + have hq := (matrix_dyadic_bitBound_lt_entry hBpos i j).le + have hr : (((1 / 2 : ℚ) ^ rationalMatrixEntryBitBound B : ℚ) : ℝ) ≤ + (B i j : ℝ) := by exact_mod_cast hq + simpa only [d, L, Br] using hr + have hlowerPermanent : (d : ℝ) ^ n ≤ Matrix.permanent Br := by + simpa using + (Matrix.pow_card_le_permanent_of_hasPerfectMatching Br hdR.le hBr0 + (fun i j _ ↦ hmin i j) (positiveMatrix_hasPerfectMatching hBrpos)) + have hlogLower := Real.log_le_log (pow_pos hdR n) hlowerPermanent + have hlogTwoUpper : Real.log 2 ≤ (1 : ℝ) := by + have h := Real.log_le_sub_one_of_pos (x := (2 : ℝ)) (by norm_num) + norm_num at h ⊢ + exact h + have hscaleNonneg : 0 ≤ (n : ℝ) * L := by positivity + have hscaledLog : (n : ℝ) * L * Real.log 2 ≤ (n : ℝ) * L := by + simpa using mul_le_mul_of_nonneg_left hlogTwoUpper hscaleNonneg + have hlower : -(n * L : ℝ) ≤ Real.log (Matrix.permanent Br) := by + rw [Real.log_pow] at hlogLower + have hlogHalf : Real.log (1 / 2 : ℝ) = -Real.log 2 := by + rw [Real.log_div (by norm_num : (1 : ℝ) ≠ 0) + (by norm_num : (2 : ℝ) ≠ 0)] + norm_num + have hdcast : (d : ℝ) = (1 / 2 : ℝ) ^ L := by + norm_num [d] + rw [hdcast, Real.log_pow] at hlogLower + rw [hlogHalf] at hlogLower + push_cast + nlinarith + have hBJ : ∀ i j, Br i j ≤ J i j := by + intro i j + have hr : (B i j : ℝ) ≤ 1 := by exact_mod_cast hBupper i j + simpa only [Br, J] using hr + have hperJ : Matrix.permanent J = (Nat.factorial n : ℝ) := by + simp [J, Matrix.permanent, Fintype.card_perm] + have hupperPermanent : Matrix.permanent Br ≤ (n : ℝ) ^ n := by + calc + Matrix.permanent Br ≤ Matrix.permanent J := + Matrix.permanent_mono_real hBr0 hBJ + _ = (Nat.factorial n : ℝ) := hperJ + _ ≤ ((n ^ n : ℕ) : ℝ) := by exact_mod_cast Nat.factorial_le_pow n + _ = (n : ℝ) ^ n := by norm_num + have hnR : 0 < (n : ℝ) := by exact_mod_cast hn + have hpowpos : 0 < (n : ℝ) ^ n := pow_pos hnR n + have hlogUpper := Real.log_le_log hperpos hupperPermanent + rw [Real.log_pow] at hlogUpper + have hlogn : Real.log (n : ℝ) ≤ n := by + have h := Real.log_le_sub_one_of_pos hnR + linarith + have hnnonneg : 0 ≤ (n : ℝ) := hnR.le + have hscaledN := mul_le_mul_of_nonneg_left hlogn hnnonneg + have hupper : Real.log (Matrix.permanent Br) ≤ (n : ℝ) ^ 2 := by + nlinarith + simpa only [Br, L] using And.intro hlower hupper + +theorem preSmoothingBase_explicit_le_exp_one : + preSmoothingBase (explicitCertifiedEpsilon : ℝ) ≤ Real.exp 1 := by + have hε : 0 ≤ (explicitCertifiedEpsilon : ℝ) := by + exact_mod_cast explicitCertifiedEpsilon_pos.le + have hexpNonpos : Real.exp + (-(explicitCertifiedEpsilon : ℝ) + + (explicitCertifiedEpsilon : ℝ) / 4) ≤ 1 := by + rw [← Real.exp_zero] + exact Real.exp_le_exp.mpr (by linarith) + have hsqrt : Real.sqrt 2 ≤ (2 : ℝ) := by + rw [Real.sqrt_le_left (by norm_num : (0 : ℝ) ≤ 2)] + norm_num + have hbaseTwo : preSmoothingBase (explicitCertifiedEpsilon : ℝ) ≤ 2 := by + rw [preSmoothingBase] + calc + Real.sqrt 2 * Real.exp + (-(explicitCertifiedEpsilon : ℝ) + + (explicitCertifiedEpsilon : ℝ) / 4) ≤ + Real.sqrt 2 * 1 := + mul_le_mul_of_nonneg_left hexpNonpos (Real.sqrt_nonneg 2) + _ ≤ 2 := by simpa using hsqrt + have htwoExp : (2 : ℝ) ≤ Real.exp 1 := by + have h := Real.add_one_le_exp (1 : ℝ) + norm_num at h ⊢ + exact h + exact hbaseTwo.trans htwoExp + +theorem explicitExpEvaluationLoss_le_one : + (explicitExpEvaluationLoss : ℝ) ≤ 1 := by + have hq : explicitExpEvaluationLoss ≤ (1 : ℚ) := by + rw [explicitExpEvaluationLoss, explicitCertifiedEpsilon, + explicitCertifiedEpsilon_eq] + norm_num [explicitXi, explicitDelta, explicitEta, explicitRowRatio] + exact_mod_cast hq + +/-- The magnitude argument depends only on the certified matrix and KKT +relations, not on how the optimizer breaks ties. This form is used by the +row-major executable optimizer. -/ +theorem certificateLog_abs_le_of_feasibleApproximateKKT + (m : ℕ) (B : Matrix (Fin (m + 2)) (Fin (m + 2)) ℚ) + (X : Matrix (Fin (m + 2)) (Fin (m + 2)) ℚ) + (R C : Fin (m + 2) → ℚ) + (hBpos : ∀ i j, 0 < B i j) + (hBupper : ∀ i j, B i j ≤ 1) + (hX : IsDoublyStochastic (fun i j ↦ ((X i j : ℚ) : ℝ))) + (hXpos : ∀ i j, 0 < (X i j : ℝ)) + (happrox : HasApproximateLogKKT (explicitKKTError : ℝ) + (explicitRegularizationScale (m + 2) : ℝ) + (fun i j ↦ (B i j : ℝ)) + (fun i j ↦ ((X i j : ℚ) : ℝ)) + (fun i ↦ (R i : ℝ)) (fun j ↦ (C j : ℝ))) : + abs ((explicitDirectedCertificateLog X R C : ℚ) : ℝ) ≤ + explicitCertificateMagnitudeBudget B := by + let n := m + 2 + let qlog : ℝ := (explicitDirectedCertificateLog X R C : ℚ) + let qvalue : ℝ := (explicitDirectedCertificateValue X R C : ℚ) + let P : ℝ := Matrix.permanent (fun i j ↦ (B i j : ℝ)) + change abs qlog ≤ explicitCertificateMagnitudeBudget B + have hXint : ∀ i, IsInteriorProbabilityVector + (fun j ↦ ((X i j : ℚ) : ℝ)) := by + intro i + refine ⟨hX.row_probability i, fun j ↦ ⟨hXpos i j, ?_⟩⟩ + exact hX.entry_lt_one_of_positive hXpos (by simp) i j + have hBR : Matrix.Positive (fun i j ↦ (B i j : ℝ)) := fun i j ↦ + Rat.cast_pos.mpr (hBpos i j) + have hcert := explicitDirectedCertificate_twoSided + anariOveisGharanStableCoefficient (n := m + 2) (by omega) + hBR hX hXint happrox + have hlossQ : 0 < explicitExpEvaluationLoss * (m + 2) := + mul_pos explicitExpEvaluationLoss_pos (by positivity) + have hexp := rationalExpLower_bounds + (s := explicitDirectedCertificateLog X R C) hlossQ + have hexp' : Real.exp + (qlog - (explicitExpEvaluationLoss : ℝ) * n) ≤ qvalue ∧ + qvalue ≤ Real.exp qlog := by + have hdim : m + 1 + 1 = m + 2 := by omega + simpa [qlog, qvalue, n, explicitDirectedCertificateValue, hdim] using hexp + have hperbounds := positive_normalized_log_permanent_bounds + (n := m + 2) (by omega) B hBpos hBupper + have hPpos : 0 < P := permanent_pos_of_positive _ hBR + have hqvaluePos : 0 < qvalue := by + simpa only [qvalue] using explicitDirectedCertificateValue_pos + (n := m + 2) (by omega) X R C + have hqUpperLog : qlog - (explicitExpEvaluationLoss : ℝ) * n ≤ + Real.log P := by + have h := Real.log_le_log (Real.exp_pos _) + (hexp'.1.trans (by simpa only [qvalue, P] using hcert.1)) + simpa using h + have hlossScaled : (explicitExpEvaluationLoss : ℝ) * n ≤ n := by + exact mul_le_of_le_one_left (by positivity) explicitExpEvaluationLoss_le_one + have hqUpper : qlog ≤ (n : ℝ) ^ 2 + n := by + have hp := hperbounds.2 + simp only [P, n] at hqUpperLog hp hlossScaled ⊢ + linarith + have hbasePow : + (preSmoothingBase (explicitCertifiedEpsilon : ℝ)) ^ n ≤ + Real.exp (n : ℝ) := by + calc + (preSmoothingBase (explicitCertifiedEpsilon : ℝ)) ^ n ≤ + (Real.exp 1) ^ n := + pow_le_pow_left₀ (preSmoothingBase_pos _).le + preSmoothingBase_explicit_le_exp_one n + _ = Real.exp (n : ℝ) := by rw [← Real.exp_nat_mul]; norm_num + have hPExp : P ≤ Real.exp ((n : ℝ) + qlog) := by + calc + P ≤ (preSmoothingBase (explicitCertifiedEpsilon : ℝ)) ^ n * qvalue := by + simpa only [P, qvalue] using hcert.2 + _ ≤ Real.exp (n : ℝ) * Real.exp qlog := + mul_le_mul hbasePow hexp'.2 hqvaluePos.le (Real.exp_pos _).le + _ = Real.exp ((n : ℝ) + qlog) := by rw [Real.exp_add] + have hqLowerLog : Real.log P ≤ (n : ℝ) + qlog := by + have h := Real.log_le_log hPpos hPExp + simpa using h + have hqLower : -((n : ℝ) * rationalMatrixEntryBitBound B + n) ≤ qlog := by + have hp := hperbounds.1 + simp only [P, n] at hqLowerLog hp ⊢ + linarith + have hbudget : (n : ℝ) * rationalMatrixEntryBitBound B + n ≤ + (explicitCertificateMagnitudeBudget B : ℕ) := by + simp only [explicitCertificateMagnitudeBudget, n] + push_cast + nlinarith + have hupperBudget : (n : ℝ) ^ 2 + n ≤ + (explicitCertificateMagnitudeBudget B : ℕ) := by + have hL : 1 ≤ rationalMatrixEntryBitBound B := by + rw [rationalMatrixEntryBitBound] + omega + simp only [explicitCertificateMagnitudeBudget, n] + push_cast + nlinarith + rw [abs_le] + exact ⟨(neg_le_neg hbudget).trans hqLower, + hqUpper.trans hupperBudget⟩ + +theorem explicitOptimizerCertificateLog_abs_le + (m : ℕ) (B : Matrix (Fin (m + 2)) (Fin (m + 2)) ℚ) + (hBpos : ∀ i j, 0 < B i j) + (hBupper : ∀ i j, B i j ≤ 1) : + abs ((explicitDirectedCertificateLog + (explicitBetheOptimizerMatrix (m := m + 1) B) + (explicitBetheOptimizerRowPotential (m := m + 1) B) + (explicitBetheOptimizerColumnPotential (m := m + 1) B) : ℚ) : ℝ) ≤ + explicitCertificateMagnitudeBudget B := by + let n := m + 2 + let X := explicitBetheOptimizerMatrix (m := m + 1) B + let R := explicitBetheOptimizerRowPotential (m := m + 1) B + let C := explicitBetheOptimizerColumnPotential (m := m + 1) B + let qlog : ℝ := (explicitDirectedCertificateLog X R C : ℚ) + let qvalue : ℝ := (explicitDirectedCertificateValue X R C : ℚ) + let P : ℝ := Matrix.permanent (fun i j ↦ (B i j : ℝ)) + change abs qlog ≤ explicitCertificateMagnitudeBudget B + have hpoint := explicitBetheOptimizerPoint_spec (m := m + 1) + (by omega) B hBpos hBupper + have hX : IsDoublyStochastic (fun i j ↦ ((X i j : ℚ) : ℝ)) := by + simpa only [X] using hpoint.2.1 + have hXlo : ∀ i j, (explicitOptimizerFloor B : ℝ) ≤ (X i j : ℝ) := by + simpa only [X] using hpoint.2.2.1 + have hfloor : 0 < (explicitOptimizerFloor B : ℝ) := + Rat.cast_pos.mpr (explicitOptimizerFloor_pos B) + have hXpos : ∀ i j, 0 < (X i j : ℝ) := fun i j ↦ + hfloor.trans_le (hXlo i j) + have hXint : ∀ i, IsInteriorProbabilityVector + (fun j ↦ ((X i j : ℚ) : ℝ)) := by + intro i + refine ⟨hX.row_probability i, fun j ↦ ⟨hXpos i j, ?_⟩⟩ + exact hX.entry_lt_one_of_positive hXpos (by simp) i j + have happrox := explicitBetheOptimizer_hasApproximateLogKKT + (m := m + 1) (by omega) B hBpos hBupper + have hBR : Matrix.Positive (fun i j ↦ (B i j : ℝ)) := fun i j ↦ + Rat.cast_pos.mpr (hBpos i j) + have hcert := explicitDirectedCertificate_twoSided + anariOveisGharanStableCoefficient (n := m + 2) (by omega) + hBR hX hXint (by simpa only [X, R, C] using happrox) + have hlossQ : 0 < explicitExpEvaluationLoss * (m + 2) := + mul_pos explicitExpEvaluationLoss_pos (by positivity) + have hexp := rationalExpLower_bounds + (s := explicitDirectedCertificateLog X R C) hlossQ + have hexp' : Real.exp + (qlog - (explicitExpEvaluationLoss : ℝ) * n) ≤ qvalue ∧ + qvalue ≤ Real.exp qlog := by + have hdim : m + 1 + 1 = m + 2 := by omega + simpa [qlog, qvalue, n, explicitDirectedCertificateValue, hdim] using hexp + have hperbounds := positive_normalized_log_permanent_bounds + (n := m + 2) (by omega) B hBpos hBupper + have hPpos : 0 < P := permanent_pos_of_positive _ hBR + have hqvaluePos : 0 < qvalue := by + simpa only [qvalue, R, C] using explicitDirectedCertificateValue_pos + (n := m + 2) (by omega) X R C + have hqUpperLog : qlog - (explicitExpEvaluationLoss : ℝ) * n ≤ + Real.log P := by + have h := Real.log_le_log (Real.exp_pos _) + (hexp'.1.trans (by simpa only [qvalue, P] using hcert.1)) + simpa using h + have hlossScaled : (explicitExpEvaluationLoss : ℝ) * n ≤ n := by + exact mul_le_of_le_one_left (by positivity) explicitExpEvaluationLoss_le_one + have hqUpper : qlog ≤ (n : ℝ) ^ 2 + n := by + have hp := hperbounds.2 + simp only [P, n] at hqUpperLog hp hlossScaled ⊢ + linarith + have hbasePow : + (preSmoothingBase (explicitCertifiedEpsilon : ℝ)) ^ n ≤ + Real.exp (n : ℝ) := by + calc + (preSmoothingBase (explicitCertifiedEpsilon : ℝ)) ^ n ≤ + (Real.exp 1) ^ n := + pow_le_pow_left₀ (preSmoothingBase_pos _).le + preSmoothingBase_explicit_le_exp_one n + _ = Real.exp (n : ℝ) := by rw [← Real.exp_nat_mul]; norm_num + have hPExp : P ≤ Real.exp ((n : ℝ) + qlog) := by + calc + P ≤ (preSmoothingBase (explicitCertifiedEpsilon : ℝ)) ^ n * qvalue := by + simpa only [P, qvalue] using hcert.2 + _ ≤ Real.exp (n : ℝ) * Real.exp qlog := + mul_le_mul hbasePow hexp'.2 hqvaluePos.le (Real.exp_pos _).le + _ = Real.exp ((n : ℝ) + qlog) := by rw [Real.exp_add] + have hqLowerLog : Real.log P ≤ (n : ℝ) + qlog := by + have h := Real.log_le_log hPpos hPExp + simpa using h + have hqLower : -((n : ℝ) * rationalMatrixEntryBitBound B + n) ≤ qlog := by + have hp := hperbounds.1 + simp only [P, n] at hqLowerLog hp ⊢ + linarith + have hbudget : (n : ℝ) * rationalMatrixEntryBitBound B + n ≤ + (explicitCertificateMagnitudeBudget B : ℕ) := by + simp only [explicitCertificateMagnitudeBudget, n] + push_cast + nlinarith + have hupperBudget : (n : ℝ) ^ 2 + n ≤ + (explicitCertificateMagnitudeBudget B : ℕ) := by + have hL : 1 ≤ rationalMatrixEntryBitBound B := by + rw [rationalMatrixEntryBitBound] + omega + simp only [explicitCertificateMagnitudeBudget, n] + push_cast + nlinarith + rw [abs_le] + constructor + · exact (neg_le_neg hbudget).trans hqLower + · exact hqUpper.trans hupperBudget + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/CertifiedPairWeights.lean b/LeanPool/BeyondBethe/BeyondBethe/CertifiedPairWeights.lean new file mode 100644 index 0000000000..54c52df1e2 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/CertifiedPairWeights.lean @@ -0,0 +1,290 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.DirectedPairCost +import LeanPool.BeyondBethe.BeyondBethe.GreedyRowMatching +import Mathlib.Tactic + +/-! # Certified Pair Weights -/ + +namespace BeyondBethe + +/-! +# Executable fixedValue-gain row-pair certificates + +A row pair is retained when some two distinct columns pass the directed +four-core-cost test. Every retained pair receives the same rational gain. +This avoids both numerical pair-capacity optimization and numerical +maximum-weight matching. +-/ + +/-- Finite, decidable eligibility test for a row pair. -/ +def HasCertifiedCorePair {n : ℕ} + (τ : ℚ) (X : Matrix (Fin n) (Fin n) ℚ) + (κ : ℚ) (p : ℕ) (q : RowPair n) : Prop := + ∃ a b : Fin n, a ≠ b ∧ + directedFourCoreCostUpper τ X + (rowPairRow q 0) (rowPairRow q 1) a b p ≤ κ + +instance {n : ℕ} (τ : ℚ) (X : Matrix (Fin n) (Fin n) ℚ) + (κ : ℚ) (p : ℕ) (q : RowPair n) : + Decidable (HasCertifiedCorePair τ X κ p q) := by + unfold HasCertifiedCorePair + infer_instance + +/-- The executable row-pair weight: either the fixed certified gain or zero. -/ +def certifiedConstantRowWeight {n : ℕ} + (τ : ℚ) (X : Matrix (Fin n) (Fin n) ℚ) + (κ γ : ℚ) (p : ℕ) (q : RowPair n) : ℚ := + if HasCertifiedCorePair τ X κ p q then γ else 0 + +theorem certifiedConstantRowWeight_nonneg {n : ℕ} + (τ : ℚ) (X : Matrix (Fin n) (Fin n) ℚ) + (κ γ : ℚ) (p : ℕ) (q : RowPair n) (hγ : 0 ≤ γ) : + 0 ≤ certifiedConstantRowWeight τ X κ γ p q := by + rw [certifiedConstantRowWeight] + split_ifs + · exact hγ + · exact le_rfl + +theorem certifiedConstantRowWeight_eq_gamma_iff {n : ℕ} + (τ : ℚ) (X : Matrix (Fin n) (Fin n) ℚ) + (κ γ : ℚ) (p : ℕ) (q : RowPair n) (hγ : γ ≠ 0) : + certifiedConstantRowWeight τ X κ γ p q = γ ↔ + HasCertifiedCorePair τ X κ p q := by + by_cases h : HasCertifiedCorePair τ X κ p q + · simp [certifiedConstantRowWeight, h] + · rw [certifiedConstantRowWeight, if_neg h] + exact iff_of_false (fun he ↦ hγ he.symm) h + +theorem certifiedConstantRowWeight_eq_gamma_of_threshold {n : ℕ} + (τ : ℚ) (X : Matrix (Fin n) (Fin n) ℚ) + (κ γ : ℚ) (p : ℕ) (q : RowPair n) (hγ : 0 < γ) + (hthreshold : γ ≤ certifiedConstantRowWeight τ X κ γ p q) : + certifiedConstantRowWeight τ X κ γ p q = γ := by + by_cases h : HasCertifiedCorePair τ X κ p q + · simp [certifiedConstantRowWeight, h] + · simp [certifiedConstantRowWeight, h] at hthreshold + linarith + +/-- Passing the rational test proves the fixed weight is a lower bound on the +true logarithmic pair gain for an exact KKT matrix. -/ +theorem certifiedConstantRowWeight_le_log_pairGain + {n : ℕ} {κ ξ₀ γ ell ξ : ℝ} {τ : ℚ} + (hgain : CleanPairGainGuarantee κ ξ₀ γ) + (hell : 1 ≤ ell) (hlogn : Real.log n ≤ ell * Real.log 2) + (hξ : 0 < ξ) (hξ₀ : ξ ≤ ξ₀) + (hτscale : (τ : ℝ) = ξ / (4 * ell)) + {A : Matrix (Fin n) (Fin n) ℝ} + {X : Matrix (Fin n) (Fin n) ℚ} + (hA : Matrix.Positive A) + (hXds : IsDoublyStochastic (fun i j ↦ ((X i j : ℚ) : ℝ))) + (hXint : ∀ i, IsInteriorProbabilityVector + (fun j ↦ ((X i j : ℚ) : ℝ))) + {R C : Fin n → ℝ} + (hKKT : HasLogKKT (τ : ℝ) A + (fun i j ↦ ((X i j : ℚ) : ℝ)) R C) + {κq γq : ℚ} (hκ : (κq : ℝ) ≤ κ) (hγq : (γq : ℝ) ≤ γ) + (p : ℕ) (q : RowPair n) + (heligible : HasCertifiedCorePair τ X κq p q) : + (γq : ℝ) ≤ Real.log (pairGain A + (fun i j ↦ ((X i j : ℚ) : ℝ)) + (rowPairRow q 0) (rowPairRow q 1)) := by + obtain ⟨a, b, hab, hcostQ⟩ := heligible + have hτlower : (-1 : ℚ) ≤ τ := by + have hτpos : (0 : ℝ) < (τ : ℝ) := by rw [hτscale]; positivity + have hτposQ : (0 : ℚ) < τ := by exact_mod_cast hτpos + linarith + have hcostUpper := fourCoreTransferCost_le_directedFourCoreCostUpper + hτlower hXint (rowPairRow q 0) (rowPairRow q 1) a b p + have hcostCast : + (directedFourCoreCostUpper τ X + (rowPairRow q 0) (rowPairRow q 1) a b p : ℝ) ≤ (κq : ℝ) := by + exact_mod_cast hcostQ + have hcost : fourCoreTransferCost (τ : ℝ) + (fun i j ↦ ((X i j : ℚ) : ℝ)) + (rowPairRow q 0) (rowPairRow q 1) a b ≤ κ := + hcostUpper.trans (hcostCast.trans hκ) + let rscale : Fin n → ℝ := fun i ↦ Real.exp (R i) + let cscale : Fin n → ℝ := fun j ↦ Real.exp (C j) + have hmult : HasMultiplicativeKKT (τ : ℝ) A + (fun i j ↦ ((X i j : ℚ) : ℝ)) rscale cscale := + hasMultiplicativeKKT_of_logKKT hA hXint hKKT + exact hγq.trans (hgain hell hlogn hξ hξ₀ hτscale hA hXds hXint + (fun i ↦ Real.exp_pos _) (fun j ↦ Real.exp_pos _) hmult + (rowPairRow_ne q) hab hcost) + +/-- A true clean pair whose cost has the stated numerical margin passes the +directed test and therefore receives the fixed gain. -/ +theorem successfulCleanCycle_certifiedConstantRowWeight + {n : ℕ} {κstruct η : ℝ} {τ κgain γ : ℚ} + {P : Matrix (Fin n) (Fin n) ℝ} + {X : Matrix (Fin n) (Fin n) ℚ} + (hτ0 : 0 ≤ τ) (hτ1 : τ ≤ 1) + (hXint : ∀ i, IsInteriorProbabilityVector + (fun j ↦ ((X i j : ℚ) : ℝ))) + (p : ℕ) + (hmargin : 4 * (n + 3 : ℝ) * ((1 / 2 : ℚ) ^ p : ℚ) ≤ + (κgain : ℝ) - κstruct) + (f g : Equiv.Perm (Fin n)) + (c : cleanCycleFactors η P (alternatingRowPerm f g)) + (hc : c ∈ successfulCleanCycles κstruct (τ : ℝ) η P + (fun i j ↦ ((X i j : ℚ) : ℝ)) f g) : + certifiedConstantRowWeight τ X κgain γ p (cleanCycleRowPair c) = γ := by + have hcost : fourCoreTransferCost (τ : ℝ) + (fun i j ↦ ((X i j : ℚ) : ℝ)) + (cleanCycleRow c 0) (cleanCycleRow c 1) + (f (cleanCycleRow c 0)) (g (cleanCycleRow c 0)) ≤ κstruct := by + have hnot : ¬ κstruct < fourCoreTransferCost (τ : ℝ) + (fun i j ↦ ((X i j : ℚ) : ℝ)) + (cleanCycleRow c 0) (cleanCycleRow c 1) + (f (cleanCycleRow c 0)) (g (cleanCycleRow c 0)) := by + simpa [successfulCleanCycles, failedCleanCycles] using hc + exact le_of_not_gt hnot + have hu := directedFourCoreCostUpper_le_add_error hτ0 hτ1 hXint + (cleanCycleRow c 0) (cleanCycleRow c 1) + (f (cleanCycleRow c 0)) (g (cleanCycleRow c 0)) p + have huκ : (directedFourCoreCostUpper τ X + (cleanCycleRow c 0) (cleanCycleRow c 1) + (f (cleanCycleRow c 0)) (g (cleanCycleRow c 0)) p : ℝ) ≤ + (κgain : ℝ) := by linarith + have huκq : directedFourCoreCostUpper τ X + (cleanCycleRow c 0) (cleanCycleRow c 1) + (f (cleanCycleRow c 0)) (g (cleanCycleRow c 0)) p ≤ κgain := by + exact_mod_cast huκ + have hcols := cleanCycle_core_columns c + rw [certifiedConstantRowWeight] + split_ifs with h + · rfl + · exfalso + apply h + refine ⟨f (cleanCycleRow c 0), g (cleanCycleRow c 0), hcols.2.1, ?_⟩ + simpa only [rowPairRow_cleanCycleRowPair] using huκq + +/-- The disjoint successful clean cycles force a large executable greedy +gain once the directed cost test has enough precision. -/ +theorem greedyCertifiedMatchingGain_ge_successful_of_costMargin + {n : ℕ} {κstruct η : ℝ} {τ κgain γ : ℚ} + {P : Matrix (Fin n) (Fin n) ℝ} + {X : Matrix (Fin n) (Fin n) ℚ} + (hτ0 : 0 ≤ τ) (hτ1 : τ ≤ 1) + (hXint : ∀ i, IsInteriorProbabilityVector + (fun j ↦ ((X i j : ℚ) : ℝ))) + (p : ℕ) (hγ : 0 ≤ γ) + (hmargin : 4 * (n + 3 : ℝ) * ((1 / 2 : ℚ) ^ p : ℚ) ≤ + (κgain : ℝ) - κstruct) + (f g : Equiv.Perm (Fin n)) : + (((successfulCleanCycles κstruct (τ : ℝ) η P + (fun i j ↦ ((X i j : ℚ) : ℝ)) f g).card : ℝ) * (γ : ℝ)) / 2 ≤ + (greedyCertifiedMatchingGain + (certifiedConstantRowWeight τ X κgain γ p) γ : ℝ) := by + exact greedyCertifiedMatchingGain_ge_successfulCleanCycles f g + (certifiedConstantRowWeight τ X κgain γ p) hγ + (fun c hc ↦ le_of_eq (successfulCleanCycle_certifiedConstantRowWeight + hτ0 hτ1 hXint p hmargin f g c hc).symm) + +/-- Full near-case conclusion for the executable threshold-greedy +certificate. The structural threshold `κstruct` is allowed to be smaller +than the certified gain threshold `κgain`; their difference is exactly the +directed-evaluation margin. -/ +theorem nearCase_greedyCertifiedMatchingGain_ge_threeSixteenths + (hrowInequality : AnariRezaeiRowInequality) + {n : ℕ} (hn : 2 ≤ n) + {κstruct ell ξ η δ : ℝ} {τ κgain γ : ℚ} + (hκstruct : 0 < κstruct) + (hell : 1 ≤ ell) (hlogn : Real.log n ≤ ell * Real.log 2) + (hξ : 0 < ξ) (hτscale : (τ : ℝ) = ξ / (4 * ell)) + (hτ0 : 0 ≤ τ) (hτ1 : τ ≤ 1) (hγ : 0 ≤ γ) + (hη : 0 < η) (hηtenth : η ≤ 1 / 10) + (hrowSmall : δ / (η / 3074) ^ 4 ≤ 1 / 128) + (hcycleSmall : 6 / Real.log 2 * + (δ + (1 + Real.log 2 / 2) * (δ / (η / 3074) ^ 4) + + goodRowOmega η) ≤ 1 / 16) + (htransferSmall : + δ + 2 * ξ + binaryEntropy η + η + + (1 + Real.log 2) * (δ / (η / 3074) ^ 4) ≤ + (1 / 16) * ((1 / 2 - η) * κstruct)) + {A : Matrix (Fin n) (Fin n) ℝ} + {X : Matrix (Fin n) (Fin n) ℚ} + (hA : Matrix.Positive A) + (hX : IsDoublyStochastic (fun i j ↦ ((X i j : ℚ) : ℝ))) + (hXint : ∀ i, IsInteriorProbabilityVector + (fun j ↦ ((X i j : ℚ) : ℝ))) + {R C : Fin n → ℝ} + (hKKT : HasLogKKT (τ : ℝ) A + (fun i j ↦ ((X i j : ℚ) : ℝ)) R C) + (hnear : betheSlack n (betheLogValue A) + (Real.log (Matrix.permanent A)) < δ * n) + (p : ℕ) + (hmargin : 4 * (n + 3 : ℝ) * ((1 / 2 : ℚ) ^ p : ℚ) ≤ + (κgain : ℝ) - κstruct) : + 3 * (γ : ℝ) / 16 * n ≤ + (greedyCertifiedMatchingGain + (certifiedConstantRowWeight τ X κgain γ p) γ : ℝ) := by + obtain ⟨f, g, hsuccess⟩ := + nearCase_successfulCleanCycles_count_ge_threeEighths hrowInequality hn + hκstruct hell hlogn hξ hτscale hη hηtenth hrowSmall hcycleSmall + htransferSmall hA hX hXint hKKT hnear + have hgreedy := greedyCertifiedMatchingGain_ge_successful_of_costMargin + (P := assignmentMarginal A) (η := η) + hτ0 hτ1 hXint p hγ hmargin f g + have hγR : (0 : ℝ) ≤ (γ : ℝ) := by exact_mod_cast hγ + have hscaled := mul_le_mul_of_nonneg_right hsuccess hγR + calc + 3 * (γ : ℝ) / 16 * n = ((3 * (n : ℝ) / 8) * (γ : ℝ)) / 2 := by ring + _ ≤ (((successfulCleanCycles κstruct (τ : ℝ) η + (assignmentMarginal A) (fun i j ↦ ((X i j : ℚ) : ℝ)) f g).card : ℝ) * + (γ : ℝ)) / 2 := by linarith + _ ≤ _ := hgreedy + +/-- The matching test uses the same fixed precision as the final certificate +evaluation. The generous additive fixedValue keeps the executable matcher and +its analytic correctness theorem literally aligned. -/ +def directedPairCostPrecision (n : ℕ) : ℕ := n + 400 + +theorem n_add_three_le_four_mul_two_pow (n : ℕ) : + n + 3 ≤ 4 * 2 ^ n := by + induction n with + | zero => norm_num + | succ n ih => + calc + n + 1 + 3 ≤ 2 * (n + 3) := by omega + _ ≤ 2 * (4 * 2 ^ n) := Nat.mul_le_mul_left 2 ih + _ = 4 * 2 ^ (n + 1) := by rw [pow_succ]; ring + +theorem directedPairCostPrecision_error_le (n : ℕ) : + 4 * (n + 3 : ℝ) * + ((1 / 2 : ℚ) ^ directedPairCostPrecision n : ℚ) ≤ + (((1 / 10000 : ℚ) : ℚ) : ℝ) := by + have hn : (n + 3 : ℝ) ≤ 4 * (2 : ℝ) ^ n := by + exact_mod_cast n_add_three_le_four_mul_two_pow n + rw [directedPairCostPrecision, show n + 400 = n + 400 by rfl, pow_add] + norm_num only [Rat.cast_mul, Rat.cast_pow, Rat.cast_div, Rat.cast_one, + Rat.cast_ofNat] + have hpowpos : 0 < (2 : ℝ) ^ n := by positivity + calc + 4 * (n + 3 : ℝ) * ((1 / 2 : ℝ) ^ n * (1 / 2 : ℝ) ^ 400) ≤ + 4 * (n + 3 : ℝ) * + ((1 / 2 : ℝ) ^ n * (1 / 1048576 : ℝ)) := by + gcongr + norm_num + _ ≤ + 4 * (4 * (2 : ℝ) ^ n) * + ((1 / 2 : ℝ) ^ n * (1 / 1048576 : ℝ)) := by gcongr + _ = 1 / 65536 := by + have hcancel : (2 : ℝ) ^ n * (1 / 2 : ℝ) ^ n = 1 := by + rw [← mul_pow] + norm_num + calc + 4 * (4 * (2 : ℝ) ^ n) * + ((1 / 2 : ℝ) ^ n * (1 / 1048576 : ℝ)) = + (16 / 1048576 : ℝ) * + ((2 : ℝ) ^ n * (1 / 2 : ℝ) ^ n) := by ring + _ = 16 / 1048576 := by rw [hcancel, mul_one] + _ = 1 / 65536 := by norm_num + _ ≤ 1 / 10000 := by norm_num + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/CleanConstants.lean b/LeanPool/BeyondBethe/BeyondBethe/CleanConstants.lean new file mode 100644 index 0000000000..431afaff94 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/CleanConstants.lean @@ -0,0 +1,330 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.CleanGain +import Mathlib.Tactic + +/-! # Clean Constants -/ + +open scoped BigOperators Topology + +namespace BeyondBethe + +/-- The first line of paper (61), with `negMulLog` encoding the convention +`0 log 0 = 0`. -/ +noncomputable def cleanCoreFunction (κ ρ : ℝ) : ℝ := + (1 - ρ) * Real.log ((2 * (Real.exp (-κ)) ^ 2) / (1 - ρ)) + + ρ * Real.log (Real.exp (-κ)) - Real.negMulLog ρ - ρ + +/-- Separate the core contribution in (61) from its entropy-regularization +loss. -/ +theorem cleanGainLowerBound_eq_core_sub_entropy + {ι : Type*} [Fintype ι] + {κ τ ρ : ℝ} {α : ι → ℝ} : + cleanGainLowerBound κ τ ρ α = cleanCoreFunction κ ρ - + τ * (-(∑ l, α l * Real.log (α l)) + ρ * Real.log 2) := by + rw [cleanGainLowerBound, cleanCoreFunction, Real.negMulLog_def] + ring + +/-- If the core term is above `log 2 / 2` and the entropy bracket is below +`4 ell`, the paper's choice `tau = xi / (4 ell)` loses less than `xi`. -/ +theorem cleanGainLowerBound_gt_of_core_and_entropy + {ι : Type*} [Fintype ι] + {κ τ ρ ξ ell : ℝ} {α : ι → ℝ} + (hξ : 0 < ξ) (hell : 0 < ell) + (hτ : τ = ξ / (4 * ell)) + (hcore : Real.log 2 / 2 < cleanCoreFunction κ ρ) + (hentropy : -(∑ l, α l * Real.log (α l)) + ρ * Real.log 2 < + 4 * ell) : + Real.log 2 / 2 - ξ < cleanGainLowerBound κ τ ρ α := by + let B := -(∑ l, α l * Real.log (α l)) + ρ * Real.log 2 + have hτpos : 0 < τ := by rw [hτ]; positivity + have hloss : τ * B < ξ := by + calc + τ * B < τ * (4 * ell) := mul_lt_mul_of_pos_left hentropy hτpos + _ = ξ := by rw [hτ]; field_simp + rw [cleanGainLowerBound_eq_core_sub_entropy] + dsimp only [B] at hloss + linarith + +/-- The outside entropy in (62) is at most `rho log(n/rho)`. The subtype +cardinality argument is explicit: outside columns inject into all `n` +columns. -/ +theorem outsidePairEntropy_le + {n : ℕ} {X : Matrix (Fin n) (Fin n) ℝ} + (hX : IsDoublyStochastic X) + {r s a b : Fin n} + (hρ : 0 < outsideMassTwo (pairAlpha X r s) a b) : + -(∑ l : OutsideColumn a b, + pairAlpha X r s l.1 * Real.log (pairAlpha X r s l.1)) ≤ + outsideMassTwo (pairAlpha X r s) a b * + Real.log (n / outsideMassTwo (pairAlpha X r s) a b) := by + let ρ := outsideMassTwo (pairAlpha X r s) a b + let αo : OutsideColumn a b → ℝ := fun l ↦ pairAlpha X r s l.1 + have hne : ¬ IsEmpty (OutsideColumn a b) := by + intro hempty + letI : IsEmpty (OutsideColumn a b) := hempty + have hsum := sum_outsideColumn_eq_outsideMassTwo + (pairAlpha X r s) a b + have hzero : (∑ l : OutsideColumn a b, pairAlpha X r s l.1) = 0 := by + apply Finset.sum_eq_zero + intro l _ + exact isEmptyElim l + linarith [hsum, hzero] + letI : Nonempty (OutsideColumn a b) := not_isEmpty_iff.mp hne + have hsum : ∑ l, αo l = ρ := by + dsimp only [αo, ρ] + exact sum_outsideColumn_eq_outsideMassTwo _ _ _ + have hα : ∀ l, 0 ≤ αo l := fun l ↦ pairAlpha_nonneg hX r s l.1 + have hent := shannonEntropy_of_mass_le hα (show 0 < ρ from hρ) hsum + have hcard : Fintype.card (OutsideColumn a b) ≤ n := by + simpa using Fintype.card_le_of_injective + (fun l : OutsideColumn a b ↦ l.1) Subtype.val_injective + have hcardpos : 0 < (Fintype.card (OutsideColumn a b) : ℝ) := by + exact_mod_cast Fintype.card_pos + have hquot : (Fintype.card (OutsideColumn a b) : ℝ) / ρ ≤ n / ρ := by + apply div_le_div_of_nonneg_right _ hρ.le + exact_mod_cast hcard + have hlog : Real.log ((Fintype.card (OutsideColumn a b) : ℝ) / ρ) ≤ + Real.log (n / ρ) := + Real.log_le_log (div_pos hcardpos hρ) hquot + have hfinal := hent.trans (mul_le_mul_of_nonneg_left hlog hρ.le) + dsimp only [αo, ρ] at hfinal ⊢ + have heq : + -(∑ l : OutsideColumn a b, + pairAlpha X r s l.1 * Real.log (pairAlpha X r s l.1)) = + shannonEntropy (fun l : OutsideColumn a b ↦ pairAlpha X r s l.1) := by + rw [shannonEntropy, ← Finset.sum_neg_distrib] + apply Finset.sum_congr rfl + intro l _ + rw [Real.negMulLog_def] + ring + rw [heq] + exact hfinal + +/-- A deliberately slack version of the entropy estimate below (61). +The elementary bound `negMulLog rho <= 1-rho` is already enough once +`rho < 1/10`; the sharper `1/e` in the paper is not needed here. -/ +theorem outsideEntropyBracket_lt_four_scale + {n : ℕ} {X : Matrix (Fin n) (Fin n) ℝ} + (hX : IsDoublyStochastic X) + {r s a b : Fin n} + (hρ : 0 < outsideMassTwo (pairAlpha X r s) a b) + (hρsmall : outsideMassTwo (pairAlpha X r s) a b < 1 / 10) + {ell : ℝ} (hell : 1 ≤ ell) + (hlogn : Real.log n ≤ ell * Real.log 2) : + -(∑ l : OutsideColumn a b, + pairAlpha X r s l.1 * Real.log (pairAlpha X r s l.1)) + + outsideMassTwo (pairAlpha X r s) a b * Real.log 2 < + 4 * ell := by + let ρ := outsideMassTwo (pairAlpha X r s) a b + have hent := outsidePairEntropy_le hX hρ + have hnpos : 0 < (n : ℝ) := by + exact_mod_cast (show 0 < n from Fin.pos_iff_nonempty.mpr ⟨r⟩) + have hlogdiv : Real.log ((n : ℝ) / ρ) = + Real.log n - Real.log ρ := Real.log_div hnpos.ne' hρ.ne' + have hnml : Real.negMulLog ρ ≤ 1 - ρ := + Real.negMulLog_le_one_sub_self hρ.le + have hlog2pos : 0 < Real.log 2 := Real.log_pos (by norm_num) + have hlog2lt : Real.log 2 < 1 := by + have h := Real.log_lt_sub_one_of_pos (by norm_num : (0 : ℝ) < 2) + (by norm_num : (2 : ℝ) ≠ 1) + norm_num at h ⊢ + exact h + have hrlog : ρ * Real.log 2 < 1 / 10 := by + have h := mul_lt_mul_of_pos_right hρsmall hlog2pos + nlinarith + have hellpos : 0 < ell := lt_of_lt_of_le (by norm_num) hell + have hmain : ρ * (ell * Real.log 2) < ell / 10 := by + have h := mul_lt_mul_of_pos_left hrlog hellpos + nlinarith + have hfirst : + -(∑ l : OutsideColumn a b, + pairAlpha X r s l.1 * Real.log (pairAlpha X r s l.1)) ≤ + ρ * (ell * Real.log 2) + Real.negMulLog ρ := by + calc + -(∑ l : OutsideColumn a b, + pairAlpha X r s l.1 * Real.log (pairAlpha X r s l.1)) ≤ + ρ * Real.log ((n : ℝ) / ρ) := hent + _ = ρ * Real.log n + Real.negMulLog ρ := by + rw [hlogdiv, Real.negMulLog_def] + ring + _ ≤ ρ * (ell * Real.log 2) + Real.negMulLog ρ := by + gcongr + dsimp only [ρ] at hfirst hnml hmain hrlog hρ hρsmall ⊢ + linarith + +theorem cleanCoreFunction_continuousAt_zero : + ContinuousAt (fun p : ℝ × ℝ => cleanCoreFunction p.1 p.2) (0, 0) := by + unfold cleanCoreFunction + have hfst : ContinuousAt (fun p : ℝ × ℝ => p.1) (0, 0) := continuousAt_fst + have hsnd : ContinuousAt (fun p : ℝ × ℝ => p.2) (0, 0) := continuousAt_snd + have hden : ContinuousAt (fun p : ℝ × ℝ => 1 - p.2) (0, 0) := + continuousAt_const.sub hsnd + have hexp : ContinuousAt (fun p : ℝ × ℝ => Real.exp (-p.1)) (0, 0) := + Real.continuous_exp.continuousAt.comp_of_eq hfst.neg rfl + have hnum : ContinuousAt + (fun p : ℝ × ℝ => 2 * Real.exp (-p.1) ^ 2) (0, 0) := + continuousAt_const.mul (hexp.pow 2) + have hfrac := hnum.div hden (by norm_num) + have hlogfrac := hfrac.log (by norm_num) + have hlogexp := hexp.log (by norm_num) + have hnml : ContinuousAt (fun p : ℝ × ℝ => Real.negMulLog p.2) (0, 0) := + Real.continuous_negMulLog.continuousAt.comp_of_eq hsnd rfl + convert ((hden.mul hlogfrac).add (hsnd.mul hlogexp)).sub hnml |>.sub hsnd using 1 <;> + ext p <;> rfl + +/-- Uniform continuity at `(kappa,rho)=(0,0)` makes the core contribution +strictly larger than `log 2 / 2` throughout a small rectangle. -/ +theorem cleanCore_uniform_rectangle : ∃ ε : ℝ, 0 < ε ∧ ∀ κ ρ : ℝ, + |κ| < ε → |ρ| < ε → Real.log 2 / 2 < cleanCoreFunction κ ρ := by + have hcont := cleanCoreFunction_continuousAt_zero + have hlog : 0 < Real.log 2 := Real.log_pos (by norm_num) + have hval : Real.log 2 / 2 < cleanCoreFunction 0 0 := by + simp [cleanCoreFunction] + linarith + have hevent : ∀ᶠ p : ℝ × ℝ in nhds (0, 0), + Real.log 2 / 2 < cleanCoreFunction p.1 p.2 := + hcont.eventually (isOpen_Ioi.mem_nhds hval) + change {p : ℝ × ℝ | + Real.log 2 / 2 < cleanCoreFunction p.1 p.2} ∈ nhds (0, 0) at hevent + rw [Metric.mem_nhds_iff] at hevent + rcases hevent with ⟨ε, hε, hball⟩ + refine ⟨ε, hε, fun κ ρ hκ hρ => ?_⟩ + change (κ, ρ) ∈ {p : ℝ × ℝ | + Real.log 2 / 2 < cleanCoreFunction p.1 p.2} + apply hball + simp only [Metric.mem_ball, Prod.dist_eq, Real.dist_eq, sub_zero, + max_lt_iff] + exact ⟨hκ, hρ⟩ + +/-- The upper envelope `bar rho_kappa` from paper (51). -/ +noncomputable def leakageEnvelope (κ : ℝ) : ℝ := + 2 * (Real.exp κ - 1) + +/-- A positive rational local-cost threshold for which every admissible +leakage lies in the uniform core rectangle and is below `1/10`. -/ +theorem exists_rational_core_cost : + ∃ κq : ℚ, 0 < κq ∧ leakageEnvelope (κq : ℝ) < 1 / 10 ∧ + ∀ ρ : ℝ, 0 ≤ ρ → ρ ≤ leakageEnvelope (κq : ℝ) → + Real.log 2 / 2 < cleanCoreFunction (κq : ℝ) ρ := by + rcases cleanCore_uniform_rectangle with ⟨ε, hε, hcore⟩ + let η : ℝ := min ε (1 / 10) + have hη : 0 < η := lt_min hε (by norm_num) + have hbarcont : ContinuousAt leakageEnvelope 0 := by + unfold leakageEnvelope + fun_prop + have hbarzero : leakageEnvelope 0 = 0 := by simp [leakageEnvelope] + have hevent : ∀ᶠ κ : ℝ in nhds 0, + -η < leakageEnvelope κ ∧ leakageEnvelope κ < η := by + exact hbarcont.eventually (show ∀ᶠ y : ℝ in nhds (leakageEnvelope 0), + -η < y ∧ y < η by + rw [hbarzero] + exact isOpen_Ioo.mem_nhds ⟨neg_lt_zero.mpr hη, hη⟩) + change {κ : ℝ | + -η < leakageEnvelope κ ∧ leakageEnvelope κ < η} ∈ nhds 0 at hevent + rw [Metric.mem_nhds_iff] at hevent + rcases hevent with ⟨δ, hδ, hball⟩ + obtain ⟨κq : ℚ, hκqpos, hκqsmall⟩ := + exists_rat_btwn (show (0 : ℝ) < min ε δ from lt_min hε hδ) + have hκcastpos : 0 < (κq : ℝ) := hκqpos + have hκeps : (κq : ℝ) < ε := hκqsmall.trans_le (min_le_left _ _) + have hκδ : (κq : ℝ) < δ := hκqsmall.trans_le (min_le_right _ _) + have hbarinterval : -η < leakageEnvelope (κq : ℝ) ∧ + leakageEnvelope (κq : ℝ) < η := by + apply hball + rw [Metric.mem_ball, Real.dist_eq, sub_zero, abs_of_pos hκcastpos] + exact hκδ + refine ⟨κq, ?_, ?_, ?_⟩ + · exact_mod_cast hκcastpos + · exact hbarinterval.2.trans_le (min_le_right _ _) + · intro ρ hρ hρbar + have hρeps : ρ < ε := + hρbar.trans_lt (hbarinterval.2.trans_le (min_le_left _ _)) + exact hcore (κq : ℝ) ρ + (by simpa [abs_of_pos hκcastpos] using hκeps) + (by simpa [abs_of_nonneg hρ] using hρeps) + +/-- The analytic conclusion of the clean-pair lemma, after a clean component +has supplied two distinct rows and two distinct core columns. -/ +def CleanPairGainGuarantee (κ₀ ξ₀ γ₀ : ℝ) : Prop := + ∀ {n : ℕ} {ell ξ τ : ℝ} + {A X : Matrix (Fin n) (Fin n) ℝ} + {rscale cscale : Fin n → ℝ}, + 1 ≤ ell → + Real.log n ≤ ell * Real.log 2 → + 0 < ξ → ξ ≤ ξ₀ → τ = ξ / (4 * ell) → + (∀ i j, 0 < A i j) → + IsDoublyStochastic X → + (∀ i, IsInteriorProbabilityVector (X i)) → + (∀ i, 0 < rscale i) → (∀ j, 0 < cscale j) → + HasMultiplicativeKKT τ A X rscale cscale → + ∀ {r s a b : Fin n}, r ≠ s → a ≠ b → + fourCoreTransferCost τ X r s a b ≤ κ₀ → + γ₀ ≤ Real.log (pairGain A X r s) + +/-- Paper Lemma 19: rational absolute constants exist for which every clean +pair of small local transfer cost has a uniform positive logarithmic gain. +The graph-theoretic word "clean" is used earlier in the paper only to supply +the two distinct rows and columns appearing in this analytic statement. -/ +theorem exists_rational_cleanPairGain_constants : + ∃ κ₀ ξ₀ γ₀ : ℚ, 0 < κ₀ ∧ 0 < ξ₀ ∧ 0 < γ₀ ∧ + CleanPairGainGuarantee (κ₀ : ℝ) (ξ₀ : ℝ) (γ₀ : ℝ) := by + rcases exists_rational_core_cost with + ⟨κ₀, hκ₀pos, hbarSmall, hcore⟩ + have hlog2pos : 0 < Real.log 2 := Real.log_pos (by norm_num) + obtain ⟨ξ₀ : ℚ, hξ₀posR, hξ₀small⟩ := + exists_rat_btwn (show (0 : ℝ) < Real.log 2 / 4 by positivity) + have hgapPos : 0 < Real.log 2 / 2 - (ξ₀ : ℝ) := by + linarith + obtain ⟨γ₀ : ℚ, hγ₀posR, hγ₀gap⟩ := exists_rat_btwn hgapPos + refine ⟨κ₀, ξ₀, γ₀, hκ₀pos, ?_, ?_, ?_⟩ + · exact_mod_cast hξ₀posR + · exact_mod_cast hγ₀posR + · intro n ell ξ τ A X rscale cscale hell hlogn hξ hξ₀ hτ + hApos hX hXint hrscale hcscale hKKT r s a b hrs hab hcost + have hellpos : 0 < ell := lt_of_lt_of_le (by norm_num) hell + have hτpos : 0 < τ := by rw [hτ]; positivity + have hκ₀posR : 0 < (κ₀ : ℝ) := by exact_mod_cast hκ₀pos + let ρ := outsideMassTwo (pairAlpha X r s) a b + have hρnonneg : 0 ≤ ρ := by + dsimp only [ρ, outsideMassTwo] + exact Finset.sum_nonneg fun j _ ↦ pairAlpha_nonneg hX r s j + by_cases hρzero : ρ = 0 + · have hbarNonneg : 0 ≤ leakageEnvelope (κ₀ : ℝ) := by + rw [leakageEnvelope] + have hexp : 1 ≤ Real.exp (κ₀ : ℝ) := by + rw [← Real.exp_zero] + exact Real.exp_le_exp.mpr hκ₀posR.le + linarith + have hcoreZero := hcore 0 le_rfl hbarNonneg + have hcoreLog : Real.log 2 / 2 < + Real.log (2 * (Real.exp (-(κ₀ : ℝ))) ^ 2) := by + simpa [cleanCoreFunction] using hcoreZero + have hgain := log_pairGain_ge_core_of_zeroLeakage + hτpos.le hApos hX hXint hrscale hcscale hKKT hrs hab hcost + (by simpa only [ρ] using hρzero) + have hγcore : (γ₀ : ℝ) < Real.log 2 / 2 := by linarith + exact le_of_lt (hγcore.trans (hcoreLog.trans_le hgain)) + · have hρpos : 0 < ρ := lt_of_le_of_ne hρnonneg (Ne.symm hρzero) + have hρbar : ρ ≤ leakageEnvelope (κ₀ : ℝ) := by + dsimp only [ρ, leakageEnvelope] + exact pairOutsideMass_le_exp hτpos.le hκ₀posR.le hXint hab hcost + have hρsmall : ρ < 1 / 10 := hρbar.trans_lt hbarSmall + have hρone : ρ < 1 := hρsmall.trans (by norm_num) + have hcoreRho := hcore ρ hρnonneg hρbar + have hentropy := outsideEntropyBracket_lt_four_scale hX hρpos + hρsmall hell hlogn + have hclean := cleanGainLowerBound_gt_of_core_and_entropy + hξ hellpos hτ hcoreRho hentropy + have hgain := log_pairGain_ge_cleanGainLowerBound_of_positiveLeakage + hτpos.le hApos hX hXint hrscale hcscale hKKT hrs hab hcost + hρpos hρone + have hγlower : (γ₀ : ℝ) < Real.log 2 / 2 - ξ := by + linarith + exact le_of_lt (hγlower.trans (hclean.trans_le hgain)) + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/CleanGain.lean b/LeanPool/BeyondBethe/BeyondBethe/CleanGain.lean new file mode 100644 index 0000000000..f28df14867 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/CleanGain.lean @@ -0,0 +1,361 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.CleanWitness +import LeanPool.BeyondBethe.BeyondBethe.PairFactorization +import Mathlib.Tactic + +/-! # Clean Gain -/ + +open scoped BigOperators + +namespace BeyondBethe + +/-- The right-hand side of paper (61), before the final uniform choice of +constants. -/ +noncomputable def cleanGainLowerBound + {ι : Type*} [Fintype ι] + (κ τ ρ : ℝ) (α : ι → ℝ) : ℝ := + (1 - ρ) * Real.log ((2 * (Real.exp (-κ)) ^ 2) / (1 - ρ)) + + ρ * Real.log (Real.exp (-κ)) + ρ * Real.log ρ - ρ - + τ * (-(∑ l, α l * Real.log (α l)) + ρ * Real.log 2) + +theorem isEmpty_outsideColumn_of_pairAlpha_outsideMass_eq_zero + {ι : Type*} [Fintype ι] [DecidableEq ι] + {X : Matrix ι ι ℝ} (hX : IsDoublyStochastic X) + (hXint : ∀ i, IsInteriorProbabilityVector (X i)) + {r s a b : ι} + (hzero : outsideMassTwo (pairAlpha X r s) a b = 0) : + IsEmpty (OutsideColumn a b) := by + constructor + intro l + have hsum : (∑ x : OutsideColumn a b, pairAlpha X r s x.1) = 0 := by + rw [sum_outsideColumn_eq_outsideMassTwo, hzero] + have hle : pairAlpha X r s l.1 ≤ + ∑ x : OutsideColumn a b, pairAlpha X r s x.1 := + Finset.single_le_sum + (fun x _ ↦ pairAlpha_nonneg hX r s x.1) (Finset.mem_univ l) + have hpos : 0 < pairAlpha X r s l.1 := + add_pos ((hXint r).2 l.1).1 ((hXint s).2 l.1).1 + linarith + +/-- At zero leakage the limiting witness mentioned in paper (52) is the +point mass on the core pair, and it has the required exponent moment. -/ +theorem cleanWitness_pairAlpha_zero + {ι : Type*} [Fintype ι] [DecidableEq ι] + {X : Matrix ι ι ℝ} (hX : IsDoublyStochastic X) + {r s a b : ι} (hrs : r ≠ s) (hab : a ≠ b) + (hzero : outsideMassTwo (pairAlpha X r s) a b = 0) + (hempty : IsEmpty (OutsideColumn a b)) : + let α := pairAlpha X r s + let θ := capacityWitnessMass 0 0 0 + (fun l : OutsideColumn a b ↦ α l.1) + IsProbabilityVector θ ∧ + ∀ j, exponentMoment θ (cleanWitnessExponent a b) j = α j := by + letI : IsEmpty (OutsideColumn a b) := hempty + dsimp only + have ha : pairAlpha X r s a = 1 := by + have hsplit := twoCore_add_outsideMassTwo_eq_sum + (pairAlpha X r s) hab + rw [hzero, sum_pairAlpha hX r s] at hsplit + have hlea := pairAlpha_le_one hX hrs a + have hleb := pairAlpha_le_one hX hrs b + linarith + have hb : pairAlpha X r s b = 1 := by + have hsplit := twoCore_add_outsideMassTwo_eq_sum + (pairAlpha X r s) hab + rw [hzero, sum_pairAlpha hX r s] at hsplit + have hlea := pairAlpha_le_one hX hrs a + have hleb := pairAlpha_le_one hX hrs b + linarith + constructor + · constructor + · intro e + rcases e with e | e + · simp [capacityWitnessMass] + · exact isEmptyElim e + · simp [capacityWitnessMass] + · intro j + have hj : j = a ∨ j = b := by + by_contra h + push Not at h + let l : OutsideColumn a b := ⟨j, by + simp [outsideColumnFinset, h.1, h.2]⟩ + exact isEmptyElim l + rcases hj with rfl | rfl + · rw [exponentMoment] + simp [capacityWitnessMass, cleanWitnessExponent, ha] + · rw [exponentMoment] + simp [capacityWitnessMass, cleanWitnessExponent, hb] + +theorem pairTransferPolynomialCapacity_pos + {ι : Type*} [Fintype ι] [DecidableEq ι] + {τ : ℝ} {X : Matrix ι ι ℝ} (hX : IsDoublyStochastic X) + (hXint : ∀ i, IsInteriorProbabilityVector (X i)) + {r s a b : ι} (hrs : r ≠ s) (hab : a ≠ b) + (hρ : 0 < outsideMassTwo (pairAlpha X r s) a b) + (hρ1 : outsideMassTwo (pairAlpha X r s) a b ≤ 1) : + 0 < polynomialCapacity (pairAlpha X r s) + (pairPolynomial (fun j ↦ transferU τ (X r) j) + (fun j ↦ transferU τ (X s) j)) := by + let α := pairAlpha X r s + let ρ := outsideMassTwo α a b + let δa := 1 - α a + let δb := 1 - α b + let Ur : ι → ℝ := fun j ↦ transferU τ (X r) j + let Us : ι → ℝ := fun j ↦ transferU τ (X s) j + let θ := capacityWitnessMass ρ δa δb + (fun l : OutsideColumn a b ↦ α l.1) + have hprob := cleanWitness_pairAlpha_isProbabilityVector + hX hrs hab hρ hρ1 + have hmom := cleanWitness_pairAlpha_moment hX hab hρ + have hcoeff : ∀ e, 0 < cleanWitnessCoefficient Ur Us a b e := + cleanWitnessCoefficient_positive + (fun j ↦ transferU_pos (hXint r) j) + (fun j ↦ transferU_pos (hXint s) j) a b + have hexp := exp_entropyCapacityCertificate_le_finitePolynomialCapacity + hprob.1 hprob.2 hcoeff hmom + have hcap := cleanWitnessCapacity_le_pairPolynomialCapacity hab + (u := Ur) (v := Us) (α := α) + (fun j ↦ (transferU_pos (τ := τ) (hXint r) j).le) + (fun j ↦ (transferU_pos (τ := τ) (hXint s) j).le) + dsimp only [α, Ur, Us] at hcap ⊢ + exact (Real.exp_pos _).trans_le (hexp.trans hcap) + +/-- Positive-leakage branch of paper Lemma 19 through equation (61). Every +factor in the pair factorization and every boundary-sensitive logarithm is +accounted for explicitly. -/ +theorem log_pairGain_ge_cleanGainLowerBound_of_positiveLeakage + {n : ℕ} {τ κ : ℝ} (hτ : 0 ≤ τ) + {A X : Matrix (Fin n) (Fin n) ℝ} + {rscale cscale : Fin n → ℝ} + (hApos : ∀ i j, 0 < A i j) + (hX : IsDoublyStochastic X) + (hXint : ∀ i, IsInteriorProbabilityVector (X i)) + (hrscale : ∀ i, 0 < rscale i) (hcscale : ∀ j, 0 < cscale j) + (hKKT : HasMultiplicativeKKT τ A X rscale cscale) + {r s a b : Fin n} (hrs : r ≠ s) (hab : a ≠ b) + (hcost : fourCoreTransferCost τ X r s a b ≤ κ) + (hρ : 0 < outsideMassTwo (pairAlpha X r s) a b) + (hρ1 : outsideMassTwo (pairAlpha X r s) a b < 1) : + cleanGainLowerBound κ τ + (outsideMassTwo (pairAlpha X r s) a b) + (fun l : OutsideColumn a b ↦ pairAlpha X r s l.1) ≤ + Real.log (pairGain A X r s) := by + let α := pairAlpha X r s + let ρ := outsideMassTwo α a b + let δa := 1 - α a + let δb := 1 - α b + let Ur : Fin n → ℝ := fun j ↦ transferU τ (X r) j + let Us : Fin n → ℝ := fun j ↦ transferU τ (X s) j + let cap := polynomialCapacity α (pairPolynomial Ur Us) + let prodFactor := ∏ j, (1 - α j) ^ (1 - α j) + let scale := 1 / (rowZeta τ (X r) * rowZeta τ (X s)) + have hfactor := pairGain_factorization hApos hX hXint + hrscale hcscale hKKT r s + have hcard := two_lt_card_of_outsideMassTwo_pos hab hρ + have hXpos : ∀ i j, 0 < X i j := fun i j ↦ (hXint i).2 j |>.1 + have hαlt : ∀ j, α j < 1 := fun j ↦ + pairAlpha_lt_one_of_positive hX hXpos hcard hrs j + have hcomp : ∀ j, 0 < 1 - α j := fun j ↦ sub_pos.mpr (hαlt j) + have hprodPos : 0 < prodFactor := by + dsimp only [prodFactor] + exact Finset.prod_pos fun j _ ↦ Real.rpow_pos_of_pos (hcomp j) _ + have hcapPos : 0 < cap := by + dsimp only [cap, α, Ur, Us] + exact pairTransferPolynomialCapacity_pos hX hXint hrs hab hρ hρ1.le + have hzetaR : 0 < rowZeta τ (X r) := + rowZeta_pos (fun j ↦ (hXint r).2 j |>.1) + have hzetaS : 0 < rowZeta τ (X s) := + rowZeta_pos (fun j ↦ (hXint s).2 j |>.1) + have hzetaRle : rowZeta τ (X r) ≤ 1 := + rowZeta_le_one hτ (hX.row_probability r) + have hzetaSle : rowZeta τ (X s) ≤ 1 := + rowZeta_le_one hτ (hX.row_probability s) + have hdenPos : 0 < rowZeta τ (X r) * rowZeta τ (X s) := + mul_pos hzetaR hzetaS + have hdenLe : rowZeta τ (X r) * rowZeta τ (X s) ≤ 1 := + (mul_le_mul hzetaRle hzetaSle hzetaS.le (by norm_num)).trans_eq + (mul_one 1) + have hscalePos : 0 < scale := by + dsimp only [scale] + exact one_div_pos.mpr hdenPos + have hscaleOne : 1 ≤ scale := by + dsimp only [scale] + exact (le_div_iff₀ hdenPos).2 (by simpa using hdenLe) + have hlogScale : 0 ≤ Real.log scale := Real.log_nonneg hscaleOne + have hlogFactor : Real.log (pairGain A X r s) = + Real.log scale + + (∑ j, (1 - α j) * Real.log (1 - α j)) + + Real.log cap := by + rw [hfactor] + dsimp only [scale, prodFactor, cap, α, Ur, Us] + rw [Real.log_mul (mul_pos hscalePos hprodPos).ne' hcapPos.ne', + Real.log_mul hscalePos.ne' hprodPos.ne', + Real.log_prod (fun j _ ↦ + (Real.rpow_pos_of_pos (hcomp j) _).ne')] + simp_rw [Real.log_rpow (hcomp _)] + ring + have hsumDecomp : + (∑ j, (1 - α j) * Real.log (1 - α j)) = + δa * Real.log δa + δb * Real.log δb + + ∑ l : OutsideColumn a b, + (1 - α l.1) * Real.log (1 - α l.1) := by + have hsplit := twoCore_add_outsideMassTwo_eq_sum + (fun j ↦ (1 - α j) * Real.log (1 - α j)) hab + rw [← sum_outsideColumn_eq_outsideMassTwo] at hsplit + dsimp only [δa, δb] + exact hsplit.symm + have houtsideFactor : + -ρ ≤ ∑ l : OutsideColumn a b, + (1 - α l.1) * Real.log (1 - α l.1) := by + calc + -ρ = ∑ l : OutsideColumn a b, -α l.1 := by + rw [Finset.sum_neg_distrib, + show (∑ l : OutsideColumn a b, α l.1) = ρ by + exact sum_outsideColumn_eq_outsideMassTwo α a b] + _ ≤ ∑ l : OutsideColumn a b, + (1 - α l.1) * Real.log (1 - α l.1) := by + apply Finset.sum_le_sum + intro l _ + exact neg_alpha_le_one_sub_mul_log (hαlt l.1) + have hsumLower : + δa * Real.log δa + δb * Real.log δb - ρ ≤ + ∑ j, (1 - α j) * Real.log (1 - α j) := by + rw [hsumDecomp] + linarith + have hδpos := pairAlpha_coreDeficit_pos hX hXint hrs hab hρ + have hδsum : δa + δb = ρ := by + have hsplit := twoCore_add_outsideMassTwo_eq_sum α hab + rw [show ∑ j, α j = 2 by + simpa only [α] using sum_pairAlpha hX r s] at hsplit + dsimp only [δa, δb, ρ] + linarith + have hcancel := core_entropy_cancellation + hδpos.1 hδpos.2 hρ hδsum + have hcapLower := pairTransfer_capacity_theta_bound hτ hX hXint + hrs hab hcost hρ hρ1 + rw [hlogFactor] + dsimp only [cleanGainLowerBound, α, ρ, δa, δb, Ur, Us, cap] at * + linarith + +/-- Zero-leakage branch of paper Lemma 19. This formalizes the manuscript's +"limiting distribution concentrated on `{a,b}`" directly, without a limit +argument. -/ +theorem log_pairGain_ge_core_of_zeroLeakage + {n : ℕ} {τ κ : ℝ} (hτ : 0 ≤ τ) + {A X : Matrix (Fin n) (Fin n) ℝ} + {rscale cscale : Fin n → ℝ} + (hApos : ∀ i j, 0 < A i j) + (hX : IsDoublyStochastic X) + (hXint : ∀ i, IsInteriorProbabilityVector (X i)) + (hrscale : ∀ i, 0 < rscale i) (hcscale : ∀ j, 0 < cscale j) + (hKKT : HasMultiplicativeKKT τ A X rscale cscale) + {r s a b : Fin n} (hrs : r ≠ s) (hab : a ≠ b) + (hcost : fourCoreTransferCost τ X r s a b ≤ κ) + (hzero : outsideMassTwo (pairAlpha X r s) a b = 0) : + Real.log (2 * (Real.exp (-κ)) ^ 2) ≤ + Real.log (pairGain A X r s) := by + let α := pairAlpha X r s + let Ur : Fin n → ℝ := fun j ↦ transferU τ (X r) j + let Us : Fin n → ℝ := fun j ↦ transferU τ (X s) j + let cap := polynomialCapacity α (pairPolynomial Ur Us) + let scale := 1 / (rowZeta τ (X r) * rowZeta τ (X s)) + letI : IsEmpty (OutsideColumn a b) := + isEmpty_outsideColumn_of_pairAlpha_outsideMass_eq_zero hX hXint hzero + let θ := capacityWitnessMass 0 0 0 + (fun l : OutsideColumn a b ↦ α l.1) + have hzeroWitness := cleanWitness_pairAlpha_zero hX hrs hab hzero + (inferInstance : IsEmpty (OutsideColumn a b)) + have hcoeff : ∀ e, 0 < cleanWitnessCoefficient Ur Us a b e := + cleanWitnessCoefficient_positive + (fun j ↦ transferU_pos (hXint r) j) + (fun j ↦ transferU_pos (hXint s) j) a b + have hcertUpper := + cleanWitnessEntropyCertificate_le_log_pairPolynomialCapacity hab + hzeroWitness.1.1 hzeroWitness.1.2 hcoeff hzeroWitness.2 + (fun j ↦ (transferU_pos (hXint r) j).le) + (fun j ↦ (transferU_pos (hXint s) j).le) + have hcertCore : entropyCapacityCertificate θ + (cleanWitnessCoefficient Ur Us a b) = + Real.log (cleanWitnessCoefficient Ur Us a b (Sum.inl ())) := by + dsimp only [θ] + simp [entropyCapacityCertificate, capacityWitnessMass] + have hcore := fourCoreTransfer_lower hτ hXint hcost + have hcoreCoeff := cleanWitnessCoefficient_core_lower + (Real.exp_pos _).le hcore.1 hcore.2.1 hcore.2.2.1 hcore.2.2.2 + have hcoreBase : 0 < 2 * (Real.exp (-κ)) ^ 2 := + mul_pos (by norm_num) (sq_pos_of_pos (Real.exp_pos _)) + have hlogCore : Real.log (2 * (Real.exp (-κ)) ^ 2) ≤ + Real.log (cleanWitnessCoefficient Ur Us a b (Sum.inl ())) := + Real.log_le_log hcoreBase hcoreCoeff + have hcapLower : Real.log (2 * (Real.exp (-κ)) ^ 2) ≤ + Real.log cap := by + dsimp only [cap] + exact hlogCore.trans (hcertCore ▸ hcertUpper) + have hexp := exp_entropyCapacityCertificate_le_finitePolynomialCapacity + hzeroWitness.1.1 hzeroWitness.1.2 hcoeff hzeroWitness.2 + have hcapFinite := cleanWitnessCapacity_le_pairPolynomialCapacity hab + (u := Ur) (v := Us) (α := α) + (fun j ↦ (transferU_pos (hXint r) j).le) + (fun j ↦ (transferU_pos (hXint s) j).le) + have hcapPos : 0 < cap := by + dsimp only [cap] + exact (Real.exp_pos _).trans_le (hexp.trans hcapFinite) + have ha : α a = 1 := by + have hsplit := twoCore_add_outsideMassTwo_eq_sum α hab + rw [show outsideMassTwo α a b = 0 by simpa only [α] using hzero, + show ∑ j, α j = 2 by simpa only [α] using sum_pairAlpha hX r s] + at hsplit + have hlea := pairAlpha_le_one hX hrs a + have hleb := pairAlpha_le_one hX hrs b + dsimp only [α] + linarith + have hb : α b = 1 := by + have hsplit := twoCore_add_outsideMassTwo_eq_sum α hab + rw [show outsideMassTwo α a b = 0 by simpa only [α] using hzero, + show ∑ j, α j = 2 by simpa only [α] using sum_pairAlpha hX r s] + at hsplit + have hlea := pairAlpha_le_one hX hrs a + have hleb := pairAlpha_le_one hX hrs b + dsimp only [α] + linarith + have hαone : ∀ j, α j = 1 := by + intro j + have hj : j = a ∨ j = b := by + by_contra h + push Not at h + let l : OutsideColumn a b := ⟨j, by + simp [outsideColumnFinset, h.1, h.2]⟩ + exact isEmptyElim l + exact hj.elim (fun h ↦ h ▸ ha) (fun h ↦ h ▸ hb) + have hfactor := pairGain_factorization hApos hX hXint + hrscale hcscale hKKT r s + have hgainEq : pairGain A X r s = scale * cap := by + rw [hfactor] + simp_rw [show ∀ j, pairAlpha X r s j = 1 by + simpa only [α] using hαone] + simp [scale, cap, α, Ur, Us] + have hzetaR : 0 < rowZeta τ (X r) := + rowZeta_pos (fun j ↦ (hXint r).2 j |>.1) + have hzetaS : 0 < rowZeta τ (X s) := + rowZeta_pos (fun j ↦ (hXint s).2 j |>.1) + have hdenPos : 0 < rowZeta τ (X r) * rowZeta τ (X s) := + mul_pos hzetaR hzetaS + have hdenLe : rowZeta τ (X r) * rowZeta τ (X s) ≤ 1 := by + have hrle := rowZeta_le_one hτ (hX.row_probability r) + have hsle := rowZeta_le_one hτ (hX.row_probability s) + nlinarith [mul_nonneg hzetaR.le hzetaS.le, + mul_nonneg (sub_nonneg.mpr hrle) (sub_nonneg.mpr hsle)] + have hscaleOne : 1 ≤ scale := by + dsimp only [scale] + exact (le_div_iff₀ hdenPos).2 (by simpa using hdenLe) + have hcapGain : cap ≤ pairGain A X r s := by + rw [hgainEq] + exact le_mul_of_one_le_left hcapPos.le hscaleOne + exact hcapLower.trans (Real.log_le_log hcapPos hcapGain) + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/CleanWitness.lean b/LeanPool/BeyondBethe/BeyondBethe/CleanWitness.lean new file mode 100644 index 0000000000..e00123fadb --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/CleanWitness.lean @@ -0,0 +1,972 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.Gain +import LeanPool.BeyondBethe.BeyondBethe.PairedCertificate +import Mathlib.Tactic + +/-! # Clean Witness -/ + +open scoped BigOperators + +namespace BeyondBethe + +def outsideColumnFinset + {ι : Type*} [Fintype ι] [DecidableEq ι] (a b : ι) : Finset ι := + (Finset.univ.erase a).erase b + +abbrev OutsideColumn + {ι : Type*} [Fintype ι] [DecidableEq ι] (a b : ι) := + {j // j ∈ outsideColumnFinset a b} + +theorem OutsideColumn.ne_a + {ι : Type*} [Fintype ι] [DecidableEq ι] + {a b : ι} (l : OutsideColumn a b) : l.1 ≠ a := by + exact (Finset.mem_erase.mp (Finset.mem_erase.mp l.2).2).1 + +theorem OutsideColumn.ne_b + {ι : Type*} [Fintype ι] [DecidableEq ι] + {a b : ι} (l : OutsideColumn a b) : l.1 ≠ b := by + exact (Finset.mem_erase.mp l.2).1 + +theorem two_lt_card_of_outsideMassTwo_pos + {ι : Type*} [Fintype ι] [DecidableEq ι] + {p : ι → ℝ} {a b : ι} (hab : a ≠ b) + (hρ : 0 < outsideMassTwo p a b) : + 2 < Fintype.card ι := by + have houtside : (outsideColumnFinset a b).Nonempty := by + by_contra hempty + have hzero : outsideMassTwo p a b = 0 := by + rw [outsideMassTwo, show (Finset.univ.erase a).erase b = ∅ by + exact Finset.not_nonempty_iff_eq_empty.mp hempty] + simp + linarith + obtain ⟨l, hl⟩ := houtside + let lo : OutsideColumn a b := ⟨l, hl⟩ + exact Fintype.two_lt_card_iff.mpr + ⟨a, b, lo.1, hab, Ne.symm lo.ne_a, Ne.symm lo.ne_b⟩ + +theorem pairAlpha_coreDeficit_pos + {ι : Type*} [Fintype ι] [DecidableEq ι] + {X : Matrix ι ι ℝ} (hX : IsDoublyStochastic X) + (hXint : ∀ i, IsInteriorProbabilityVector (X i)) + {r s a b : ι} (hrs : r ≠ s) (hab : a ≠ b) + (hρ : 0 < outsideMassTwo (pairAlpha X r s) a b) : + 0 < 1 - pairAlpha X r s a ∧ 0 < 1 - pairAlpha X r s b := by + have hcard := two_lt_card_of_outsideMassTwo_pos hab hρ + have hXpos : ∀ i j, 0 < X i j := fun i j ↦ (hXint i).2 j |>.1 + exact ⟨sub_pos.mpr (pairAlpha_lt_one_of_positive hX hXpos hcard hrs a), + sub_pos.mpr (pairAlpha_lt_one_of_positive hX hXpos hcard hrs b)⟩ + +noncomputable def cleanWitnessExponent + {ι : Type*} [Fintype ι] [DecidableEq ι] (a b : ι) : + CapacityWitnessEdge (OutsideColumn a b) → ι → ℕ + | Sum.inl _, j => if j = a ∨ j = b then 1 else 0 + | Sum.inr (Sum.inl l), j => if j = a ∨ j = l.1 then 1 else 0 + | Sum.inr (Sum.inr l), j => if j = b ∨ j = l.1 then 1 else 0 + +/-- The unordered pair of columns represented by a clean-witness atom. -/ +noncomputable def cleanWitnessEndpoints + {ι : Type*} [Fintype ι] [DecidableEq ι] (a b : ι) : + CapacityWitnessEdge (OutsideColumn a b) → ι × ι + | Sum.inl _ => (a, b) + | Sum.inr (Sum.inl l) => (a, l.1) + | Sum.inr (Sum.inr l) => (b, l.1) + +/-- Give a witness edge either of its two ordered orientations. -/ +noncomputable def cleanWitnessOrientedPair + {ι : Type*} [Fintype ι] [DecidableEq ι] (a b : ι) : + CapacityWitnessEdge (OutsideColumn a b) × Bool → ι × ι := + fun eo ↦ if eo.2 then (cleanWitnessEndpoints a b eo.1).swap + else cleanWitnessEndpoints a b eo.1 + +theorem cleanWitnessOrientedPair_injective + {ι : Type*} [Fintype ι] [DecidableEq ι] + {a b : ι} (hab : a ≠ b) : + Function.Injective (cleanWitnessOrientedPair a b) := by + intro x y h + rcases x with ⟨e, o⟩ + rcases y with ⟨f, p⟩ + rcases e with e | e <;> rcases f with f | f + · cases e + cases f + cases o <;> cases p <;> + simp_all [cleanWitnessOrientedPair, cleanWitnessEndpoints, hab] + · rcases f with l | l <;> cases e + all_goals cases o <;> cases p <;> + simp_all [cleanWitnessOrientedPair, cleanWitnessEndpoints, hab, + l.ne_a, l.ne_b, Ne.symm l.ne_a, Ne.symm l.ne_b] + · rcases e with l | l <;> cases f + all_goals cases o <;> cases p <;> + simp_all [cleanWitnessOrientedPair, cleanWitnessEndpoints, hab, + l.ne_a, l.ne_b, Ne.symm l.ne_a, Ne.symm l.ne_b] + · rcases e with l | l <;> rcases f with m | m + all_goals cases o <;> cases p <;> + simp_all [cleanWitnessOrientedPair, cleanWitnessEndpoints, hab, + l.ne_a, l.ne_b, m.ne_a, m.ne_b, Ne.symm l.ne_a, + Ne.symm l.ne_b, Ne.symm m.ne_a, Ne.symm m.ne_b] + +/-- The actual coefficient in the pair polynomial of a witness edge. -/ +noncomputable def cleanWitnessCoefficient + {ι : Type*} [Fintype ι] [DecidableEq ι] + (u v : ι → ℝ) (a b : ι) : + CapacityWitnessEdge (OutsideColumn a b) → ℝ := fun e ↦ + let p := cleanWitnessEndpoints a b e + u p.1 * v p.2 + u p.2 * v p.1 + +noncomputable def expectedLogCoefficient + {κ : Type*} [Fintype κ] (θ c : κ → ℝ) : ℝ := + ∑ e, θ e * Real.log (c e) + +theorem entropyCapacityCertificate_eq_expectedLogCoefficient_add_entropy + {κ : Type*} [Fintype κ] {θ c : κ → ℝ} + (hc : ∀ e, 0 < c e) : + entropyCapacityCertificate θ c = + expectedLogCoefficient θ c + shannonEntropy θ := by + rw [entropyCapacityCertificate, expectedLogCoefficient, shannonEntropy, + ← Finset.sum_add_distrib] + apply Finset.sum_congr rfl + intro e _ + by_cases hθ : θ e = 0 + · simp [hθ, Real.negMulLog_def] + · rw [Real.log_div (hc e).ne' hθ, Real.negMulLog_def] + ring + +theorem cleanWitnessExponent_eq_endpoints + {ι : Type*} [Fintype ι] [DecidableEq ι] + (a b : ι) (e : CapacityWitnessEdge (OutsideColumn a b)) (j : ι) : + cleanWitnessExponent a b e j = + if j = (cleanWitnessEndpoints a b e).1 ∨ + j = (cleanWitnessEndpoints a b e).2 then 1 else 0 := by + rcases e with _ | e + · rfl + · rcases e with l | l <;> rfl + +theorem cleanWitnessEndpoints_ne + {ι : Type*} [Fintype ι] [DecidableEq ι] + {a b : ι} (hab : a ≠ b) + (e : CapacityWitnessEdge (OutsideColumn a b)) : + (cleanWitnessEndpoints a b e).1 ≠ + (cleanWitnessEndpoints a b e).2 := by + rcases e with _ | e + · exact hab + · rcases e with l | l + · exact Ne.symm l.ne_a + · exact Ne.symm l.ne_b + +theorem natMonomial_pair + {ι : Type*} [Fintype ι] [DecidableEq ι] + (z : ι → ℝ) {a b : ι} (hab : a ≠ b) : + natMonomial z (fun j ↦ if j = a ∨ j = b then 1 else 0) = + z a * z b := by + rw [natMonomial] + simp only [pow_ite, pow_one, pow_zero] + rw [Finset.prod_ite] + have hfilter : + Finset.univ.filter (fun j ↦ j = a ∨ j = b) = {a, b} := by + ext j + simp [eq_comm] + rw [hfilter] + simp [hab] + +theorem natMonomial_cleanWitnessExponent + {ι : Type*} [Fintype ι] [DecidableEq ι] + {a b : ι} (hab : a ≠ b) (z : ι → ℝ) + (e : CapacityWitnessEdge (OutsideColumn a b)) : + natMonomial z (cleanWitnessExponent a b e) = + z (cleanWitnessEndpoints a b e).1 * + z (cleanWitnessEndpoints a b e).2 := by + have hexp : cleanWitnessExponent a b e = fun j ↦ + if j = (cleanWitnessEndpoints a b e).1 ∨ + j = (cleanWitnessEndpoints a b e).2 then 1 else 0 := + funext (cleanWitnessExponent_eq_endpoints a b e) + rw [hexp] + exact natMonomial_pair z (cleanWitnessEndpoints_ne hab e) + +/-- The sparse witness polynomial is exactly the sum over both orientations +of its selected two-column sets. -/ +theorem finitePolynomial_cleanWitness_eq_oriented_sum + {ι : Type*} [Fintype ι] [DecidableEq ι] + {a b : ι} (hab : a ≠ b) (u v z : ι → ℝ) : + finitePolynomial (cleanWitnessCoefficient u v a b) + (cleanWitnessExponent a b) z = + ∑ eo : CapacityWitnessEdge (OutsideColumn a b) × Bool, + u (cleanWitnessOrientedPair a b eo).1 * + v (cleanWitnessOrientedPair a b eo).2 * + z (cleanWitnessOrientedPair a b eo).1 * + z (cleanWitnessOrientedPair a b eo).2 := by + rw [finitePolynomial, Fintype.sum_prod_type] + apply Finset.sum_congr rfl + intro e _ + rw [natMonomial_cleanWitnessExponent hab] + simp [cleanWitnessCoefficient, cleanWitnessOrientedPair] + ring + +theorem cleanWitnessOrientedPair_mem_offDiag + {ι : Type*} [Fintype ι] [DecidableEq ι] + {a b : ι} (hab : a ≠ b) + (eo : CapacityWitnessEdge (OutsideColumn a b) × Bool) : + cleanWitnessOrientedPair a b eo ∈ + (Finset.univ : Finset ι).offDiag := by + rcases eo with ⟨e, o⟩ + cases o + · simp [cleanWitnessOrientedPair, cleanWitnessEndpoints_ne hab e] + · simp [cleanWitnessOrientedPair, (cleanWitnessEndpoints_ne hab e).symm] + +/-- The witness polynomial consists of distinct monomials from the full pair +polynomial, so its value is pointwise no larger on the nonnegative orthant. -/ +theorem finitePolynomial_cleanWitness_le_pairPolynomial_eval + {ι : Type*} [Fintype ι] [DecidableEq ι] + {a b : ι} (hab : a ≠ b) + {u v z : ι → ℝ} (hu : ∀ j, 0 ≤ u j) (hv : ∀ j, 0 ≤ v j) + (hz : ∀ j, 0 ≤ z j) : + finitePolynomial (cleanWitnessCoefficient u v a b) + (cleanWitnessExponent a b) z ≤ + (pairPolynomial u v).eval z := by + let f : ι × ι → ℝ := fun e ↦ + u e.1 * v e.2 * z e.1 * z e.2 + let orient := cleanWitnessOrientedPair a b + have himage : + (∑ eo : CapacityWitnessEdge (OutsideColumn a b) × Bool, + f (orient eo)) = + ∑ e ∈ Finset.image orient Finset.univ, f e := by + symm + simpa only [Finset.mem_univ, Set.mem_setOf_eq] using + (Finset.sum_image (s := Finset.univ) (f := f) + (g := orient) (cleanWitnessOrientedPair_injective hab).injOn) + have hsubset : Finset.image orient Finset.univ ⊆ + (Finset.univ : Finset ι).offDiag := by + intro e he + rw [Finset.mem_image] at he + obtain ⟨eo, _, rfl⟩ := he + exact cleanWitnessOrientedPair_mem_offDiag hab eo + rw [finitePolynomial_cleanWitness_eq_oriented_sum hab] + change (∑ eo, f (orient eo)) ≤ _ + rw [himage, pairPolynomial_eval] + exact Finset.sum_le_sum_of_subset_of_nonneg hsubset (by + intro e _ _ + exact mul_nonneg + (mul_nonneg (mul_nonneg (hu e.1) (hv e.2)) (hz e.1)) (hz e.2)) + +theorem cleanWitnessCoefficient_nonnegative + {ι : Type*} [Fintype ι] [DecidableEq ι] + {u v : ι → ℝ} (hu : ∀ j, 0 ≤ u j) (hv : ∀ j, 0 ≤ v j) + (a b : ι) : ∀ e, 0 ≤ cleanWitnessCoefficient u v a b e := by + intro e + exact add_nonneg + (mul_nonneg (hu _) (hv _)) (mul_nonneg (hu _) (hv _)) + +theorem cleanWitnessCoefficient_positive + {ι : Type*} [Fintype ι] [DecidableEq ι] + {u v : ι → ℝ} (hu : ∀ j, 0 < u j) (hv : ∀ j, 0 < v j) + (a b : ι) : ∀ e, 0 < cleanWitnessCoefficient u v a b e := by + intro e + exact add_pos (mul_pos (hu _) (hv _)) (mul_pos (hu _) (hv _)) + +theorem cleanWitnessCoefficient_core_lower + {ι : Type*} [Fintype ι] [DecidableEq ι] + {u v : ι → ℝ} {a b : ι} {w : ℝ} (hw : 0 ≤ w) + (hua : w ≤ u a) (hub : w ≤ u b) + (hva : w ≤ v a) (hvb : w ≤ v b) : + 2 * w ^ 2 ≤ + cleanWitnessCoefficient u v a b (Sum.inl ()) := by + simp only [cleanWitnessCoefficient, cleanWitnessEndpoints] + have h₁ : w * w ≤ u a * v b := mul_le_mul hua hvb hw (hw.trans hua) + have h₂ : w * w ≤ u b * v a := mul_le_mul hub hva hw (hw.trans hub) + nlinarith + +theorem cleanWitnessCoefficient_left_lower + {ι : Type*} [Fintype ι] [DecidableEq ι] + {u v : ι → ℝ} {a b : ι} {w : ℝ} + (hua : w ≤ u a) (hva : w ≤ v a) + (hu : ∀ j, 0 ≤ u j) (hv : ∀ j, 0 ≤ v j) + (l : OutsideColumn a b) : + w * (u l.1 + v l.1) ≤ + cleanWitnessCoefficient u v a b (Sum.inr (Sum.inl l)) := by + simp only [cleanWitnessCoefficient, cleanWitnessEndpoints] + have h₁ := mul_le_mul_of_nonneg_right hua (hv l.1) + have h₂ := mul_le_mul_of_nonneg_right hva (hu l.1) + nlinarith + +theorem cleanWitnessCoefficient_right_lower + {ι : Type*} [Fintype ι] [DecidableEq ι] + {u v : ι → ℝ} {a b : ι} {w : ℝ} + (hub : w ≤ u b) (hvb : w ≤ v b) + (hu : ∀ j, 0 ≤ u j) (hv : ∀ j, 0 ≤ v j) + (l : OutsideColumn a b) : + w * (u l.1 + v l.1) ≤ + cleanWitnessCoefficient u v a b (Sum.inr (Sum.inr l)) := by + simp only [cleanWitnessCoefficient, cleanWitnessEndpoints] + have h₁ := mul_le_mul_of_nonneg_right hub (hv l.1) + have h₂ := mul_le_mul_of_nonneg_right hvb (hu l.1) + nlinarith + +/-- Paper (57): the expected log coefficient of the clean witness. The +proof keeps the two outside families separate and then uses +`delta_a + delta_b = rho`; this is exactly where their normalizing factors +cancel. -/ +theorem cleanWitness_expectedLogCoefficient_lower + {ι : Type*} [Fintype ι] [DecidableEq ι] + {u v : ι → ℝ} {a b : ι} {w ρ δa δb : ℝ} + {α : OutsideColumn a b → ℝ} + (hw : 0 < w) (hρ : 0 < ρ) (hρ1 : ρ ≤ 1) + (hδa : 0 ≤ δa) (hδb : 0 ≤ δb) + (hδsum : δa + δb = ρ) (hα : ∀ l, 0 ≤ α l) + (hαsum : ∑ l, α l = ρ) + (hu : ∀ j, 0 < u j) (hv : ∀ j, 0 < v j) + (hua : w ≤ u a) (hub : w ≤ u b) + (hva : w ≤ v a) (hvb : w ≤ v b) : + (1 - ρ) * Real.log (2 * w ^ 2) + ρ * Real.log w + + ∑ l, α l * Real.log (u l.1 + v l.1) ≤ + expectedLogCoefficient (capacityWitnessMass ρ δa δb α) + (cleanWitnessCoefficient u v a b) := by + let V : OutsideColumn a b → ℝ := fun l ↦ u l.1 + v l.1 + have hV : ∀ l, 0 < V l := fun l ↦ add_pos (hu l.1) (hv l.1) + have hcoreLower := cleanWitnessCoefficient_core_lower hw.le + hua hub hva hvb + have hcoreBase : 0 < 2 * w ^ 2 := mul_pos (by norm_num) (sq_pos_of_pos hw) + have hcoreLog : Real.log (2 * w ^ 2) ≤ + Real.log (cleanWitnessCoefficient u v a b (Sum.inl ())) := + Real.log_le_log hcoreBase hcoreLower + have hleftLog : ∀ l, + Real.log (w * V l) ≤ Real.log + (cleanWitnessCoefficient u v a b (Sum.inr (Sum.inl l))) := by + intro l + apply Real.log_le_log (mul_pos hw (hV l)) + exact cleanWitnessCoefficient_left_lower hua hva + (fun j ↦ (hu j).le) (fun j ↦ (hv j).le) l + have hrightLog : ∀ l, + Real.log (w * V l) ≤ Real.log + (cleanWitnessCoefficient u v a b (Sum.inr (Sum.inr l))) := by + intro l + apply Real.log_le_log (mul_pos hw (hV l)) + exact cleanWitnessCoefficient_right_lower hub hvb + (fun j ↦ (hu j).le) (fun j ↦ (hv j).le) l + have hcoreWeighted : + (1 - ρ) * Real.log (2 * w ^ 2) ≤ + (1 - ρ) * Real.log + (cleanWitnessCoefficient u v a b (Sum.inl ())) := + mul_le_mul_of_nonneg_left hcoreLog (sub_nonneg.mpr hρ1) + have hleftWeighted : + (∑ l, (δb / ρ * α l) * Real.log (w * V l)) ≤ + ∑ l, (δb / ρ * α l) * Real.log + (cleanWitnessCoefficient u v a b (Sum.inr (Sum.inl l))) := by + apply Finset.sum_le_sum + intro l _ + exact mul_le_mul_of_nonneg_left (hleftLog l) + (mul_nonneg (div_nonneg hδb hρ.le) (hα l)) + have hrightWeighted : + (∑ l, (δa / ρ * α l) * Real.log (w * V l)) ≤ + ∑ l, (δa / ρ * α l) * Real.log + (cleanWitnessCoefficient u v a b (Sum.inr (Sum.inr l))) := by + apply Finset.sum_le_sum + intro l _ + exact mul_le_mul_of_nonneg_left (hrightLog l) + (mul_nonneg (div_nonneg hδa hρ.le) (hα l)) + have hlowerIdentity : + (1 - ρ) * Real.log (2 * w ^ 2) + ρ * Real.log w + + ∑ l, α l * Real.log (V l) = + (1 - ρ) * Real.log (2 * w ^ 2) + + (∑ l, (δb / ρ * α l) * Real.log (w * V l)) + + ∑ l, (δa / ρ * α l) * Real.log (w * V l) := by + simp_rw [Real.log_mul hw.ne' (hV _).ne', mul_add, + Finset.sum_add_distrib] + rw [show (∑ l, δb / ρ * α l * Real.log w) = + (δb / ρ) * ρ * Real.log w by + calc + (∑ l, δb / ρ * α l * Real.log w) = + (δb / ρ * Real.log w) * ∑ l, α l := by + rw [Finset.mul_sum] + apply Finset.sum_congr rfl + intro l _ + ring + _ = (δb / ρ) * ρ * Real.log w := by rw [hαsum]; ring] + rw [show (∑ l, δa / ρ * α l * Real.log w) = + (δa / ρ) * ρ * Real.log w by + calc + (∑ l, δa / ρ * α l * Real.log w) = + (δa / ρ * Real.log w) * ∑ l, α l := by + rw [Finset.mul_sum] + apply Finset.sum_congr rfl + intro l _ + ring + _ = (δa / ρ) * ρ * Real.log w := by rw [hαsum]; ring] + rw [show (∑ l, δb / ρ * α l * Real.log (V l)) = + (δb / ρ) * ∑ l, α l * Real.log (V l) by + rw [Finset.mul_sum] + apply Finset.sum_congr rfl + intro l _ + ring] + rw [show (∑ l, δa / ρ * α l * Real.log (V l)) = + (δa / ρ) * ∑ l, α l * Real.log (V l) by + rw [Finset.mul_sum] + apply Finset.sum_congr rfl + intro l _ + ring] + field_simp [hρ.ne'] + linear_combination + -(ρ * Real.log w + ∑ x, α x * Real.log (V x)) * hδsum + rw [hlowerIdentity] + rw [expectedLogCoefficient] + simp only [Fintype.sum_sum_type, Fintype.sum_unique, + capacityWitnessMass] + linarith + +/-- Paper (58): exact entropy of the clean witness in the positive-leakage +case. -/ +theorem shannonEntropy_capacityWitnessMass + {ι : Type*} [Fintype ι] + {ρ δa δb : ℝ} {α : ι → ℝ} + (hρ : 0 < ρ) (hδa : 0 < δa) (hδb : 0 < δb) + (hδsum : δa + δb = ρ) (hα : ∀ l, 0 < α l) + (hαsum : ∑ l, α l = ρ) : + shannonEntropy (capacityWitnessMass ρ δa δb α) = + -(1 - ρ) * Real.log (1 - ρ) - + (∑ l, α l * Real.log (α l)) - + δa * Real.log (δa / ρ) - + δb * Real.log (δb / ρ) := by + have hleft : + (∑ l, -(δb / ρ * α l) * Real.log (δb / ρ * α l)) = + -δb * Real.log (δb / ρ) - + (δb / ρ) * ∑ l, α l * Real.log (α l) := by + simp_rw [Real.log_mul (div_pos hδb hρ).ne' (hα _).ne', mul_add, + Finset.sum_add_distrib] + rw [show (∑ l, -(δb / ρ * α l) * Real.log (δb / ρ)) = + -δb * Real.log (δb / ρ) by + calc + (∑ l, -(δb / ρ * α l) * Real.log (δb / ρ)) = + (-(δb / ρ) * Real.log (δb / ρ)) * ∑ l, α l := by + rw [Finset.mul_sum] + apply Finset.sum_congr rfl + intro l _ + ring + _ = -δb * Real.log (δb / ρ) := by + rw [hαsum] + field_simp [hρ.ne']] + rw [show (∑ l, -(δb / ρ * α l) * Real.log (α l)) = + -(δb / ρ) * ∑ l, α l * Real.log (α l) by + rw [Finset.mul_sum] + apply Finset.sum_congr rfl + intro l _ + ring] + ring + have hright : + (∑ l, -(δa / ρ * α l) * Real.log (δa / ρ * α l)) = + -δa * Real.log (δa / ρ) - + (δa / ρ) * ∑ l, α l * Real.log (α l) := by + simp_rw [Real.log_mul (div_pos hδa hρ).ne' (hα _).ne', mul_add, + Finset.sum_add_distrib] + rw [show (∑ l, -(δa / ρ * α l) * Real.log (δa / ρ)) = + -δa * Real.log (δa / ρ) by + calc + (∑ l, -(δa / ρ * α l) * Real.log (δa / ρ)) = + (-(δa / ρ) * Real.log (δa / ρ)) * ∑ l, α l := by + rw [Finset.mul_sum] + apply Finset.sum_congr rfl + intro l _ + ring + _ = -δa * Real.log (δa / ρ) := by + rw [hαsum] + field_simp [hρ.ne']] + rw [show (∑ l, -(δa / ρ * α l) * Real.log (α l)) = + -(δa / ρ) * ∑ l, α l * Real.log (α l) by + rw [Finset.mul_sum] + apply Finset.sum_congr rfl + intro l _ + ring] + ring + rw [shannonEntropy] + simp only [Fintype.sum_sum_type, Fintype.sum_unique, + capacityWitnessMass, Real.negMulLog_def] + rw [hleft, hright] + field_simp [hρ.ne'] + linear_combination + -(∑ l, α l * Real.log (α l)) * hδsum + +/-- Summed form of paper (56). -/ +theorem sum_alpha_log_pairTransfer_lower + {ι : Type*} [Fintype ι] [DecidableEq ι] + {a b : ι} {τ ρ : ℝ} (hτ : 0 ≤ τ) + {p q : ι → ℝ} (hp : IsInteriorProbabilityVector p) + (hq : IsInteriorProbabilityVector q) + (hρ : ∑ l : OutsideColumn a b, (p l.1 + q l.1) = ρ) : + -τ * ρ * Real.log 2 + + (1 + τ) * + (∑ l : OutsideColumn a b, + (p l.1 + q l.1) * Real.log (p l.1 + q l.1)) ≤ + ∑ l : OutsideColumn a b, + (p l.1 + q l.1) * + Real.log (transferU τ p l.1 + transferU τ q l.1) := by + have hα : ∀ l : OutsideColumn a b, 0 < p l.1 + q l.1 := + fun l ↦ add_pos (hp.2 l.1).1 (hq.2 l.1).1 + have htwo : (0 : ℝ) < 2 := by norm_num + have hterm : ∀ l : OutsideColumn a b, + -τ * Real.log 2 + (1 + τ) * Real.log (p l.1 + q l.1) ≤ + Real.log (transferU τ p l.1 + transferU τ q l.1) := by + intro l + have hlower := pairTransferSum_lower hτ hp hq l.1 + have hlowerPos : 0 < (2 : ℝ) ^ (-τ) * + (p l.1 + q l.1) ^ (1 + τ) := + mul_pos (Real.rpow_pos_of_pos htwo _) (Real.rpow_pos_of_pos (hα l) _) + have hlog := Real.log_le_log hlowerPos hlower + rw [Real.log_mul (Real.rpow_pos_of_pos htwo _).ne' + (Real.rpow_pos_of_pos (hα l) _).ne', + Real.log_rpow htwo, Real.log_rpow (hα l)] at hlog + linarith + calc + -τ * ρ * Real.log 2 + (1 + τ) * + (∑ l : OutsideColumn a b, + (p l.1 + q l.1) * Real.log (p l.1 + q l.1)) = + ∑ l : OutsideColumn a b, (p l.1 + q l.1) * + (-τ * Real.log 2 + + (1 + τ) * Real.log (p l.1 + q l.1)) := by + rw [show (∑ l : OutsideColumn a b, (p l.1 + q l.1) * + (-τ * Real.log 2 + + (1 + τ) * Real.log (p l.1 + q l.1))) = + (∑ l : OutsideColumn a b, (p l.1 + q l.1)) * + (-τ * Real.log 2) + + (1 + τ) * ∑ l : OutsideColumn a b, + (p l.1 + q l.1) * Real.log (p l.1 + q l.1) by + simp_rw [mul_add] + rw [Finset.sum_add_distrib, ← Finset.sum_mul, Finset.mul_sum] + apply congrArg₂ (· + ·) rfl + apply Finset.sum_congr rfl + intro l _ + ring] + rw [hρ] + ring + _ ≤ ∑ l : OutsideColumn a b, + (p l.1 + q l.1) * + Real.log (transferU τ p l.1 + transferU τ q l.1) := by + apply Finset.sum_le_sum + intro l _ + exact mul_le_mul_of_nonneg_left (hterm l) (hα l).le + +/-- The quantitative lower bound used in paper (59) already holds for the +explicit sparse entropy certificate itself. Keeping this stronger form +visible is what permits the numerical algorithm to evaluate the witness +directly, without optimizing a capacity. -/ +theorem cleanWitness_capacity_theta_lower + {ι : Type*} [Fintype ι] [DecidableEq ι] + {a b : ι} (hab : a ≠ b) + {u v : ι → ℝ} {w ρ δa δb τ : ℝ} + {α : OutsideColumn a b → ℝ} + (hw : 0 < w) (hρ : 0 < ρ) (hρ1 : ρ < 1) + (hδa : 0 < δa) (hδb : 0 < δb) + (hδsum : δa + δb = ρ) + (hα : ∀ l, 0 < α l) (hαsum : ∑ l, α l = ρ) + (hu : ∀ j, 0 < u j) (hv : ∀ j, 0 < v j) + (hua : w ≤ u a) (hub : w ≤ u b) + (hva : w ≤ v a) (hvb : w ≤ v b) + (houtside : + -τ * ρ * Real.log 2 + + (1 + τ) * (∑ l, α l * Real.log (α l)) ≤ + ∑ l, α l * Real.log (u l.1 + v l.1)) : + (1 - ρ) * Real.log ((2 * w ^ 2) / (1 - ρ)) + + ρ * Real.log w - τ * ρ * Real.log 2 + + τ * (∑ l, α l * Real.log (α l)) - + δa * Real.log (δa / ρ) - + δb * Real.log (δb / ρ) ≤ + entropyCapacityCertificate (capacityWitnessMass ρ δa δb α) + (cleanWitnessCoefficient u v a b) := by + let θ := capacityWitnessMass ρ δa δb α + have hcoeff : ∀ e, 0 < cleanWitnessCoefficient u v a b e := + cleanWitnessCoefficient_positive hu hv a b + have hexpected := cleanWitness_expectedLogCoefficient_lower + hw hρ hρ1.le hδa.le hδb.le hδsum (fun l ↦ (hα l).le) + hαsum hu hv hua hub hva hvb + have hentropy := shannonEntropy_capacityWitnessMass + hρ hδa hδb hδsum hα hαsum + have hcertEq := + entropyCapacityCertificate_eq_expectedLogCoefficient_add_entropy + (θ := θ) hcoeff + have hratio : Real.log ((2 * w ^ 2) / (1 - ρ)) = + Real.log (2 * w ^ 2) - Real.log (1 - ρ) := by + rw [Real.log_div (mul_pos (by norm_num) (sq_pos_of_pos hw)).ne' + (sub_pos.mpr hρ1).ne'] + have hlower : + (1 - ρ) * Real.log ((2 * w ^ 2) / (1 - ρ)) + + ρ * Real.log w - τ * ρ * Real.log 2 + + τ * (∑ l, α l * Real.log (α l)) - + δa * Real.log (δa / ρ) - + δb * Real.log (δb / ρ) ≤ + entropyCapacityCertificate θ + (cleanWitnessCoefficient u v a b) := by + rw [hcertEq, hentropy, hratio] + dsimp only [θ] at hexpected ⊢ + linarith + simpa only [θ] using hlower + +/-- Paper (59), separated from its particular transfer-vector +instantiation. This theorem composes the explicit witness bound with the +one-sided entropy certificate for polynomial capacity. -/ +theorem cleanWitness_capacity_theta_bound_of_certificate + {ι : Type*} [Fintype ι] [DecidableEq ι] + {a b : ι} (hab : a ≠ b) + {u v αfull : ι → ℝ} {w ρ δa δb τ : ℝ} + {α : OutsideColumn a b → ℝ} + (hw : 0 < w) (hρ : 0 < ρ) (hρ1 : ρ < 1) + (hδa : 0 < δa) (hδb : 0 < δb) + (hδsum : δa + δb = ρ) + (hα : ∀ l, 0 < α l) (hαsum : ∑ l, α l = ρ) + (hu : ∀ j, 0 < u j) (hv : ∀ j, 0 < v j) + (hua : w ≤ u a) (hub : w ≤ u b) + (hva : w ≤ v a) (hvb : w ≤ v b) + (hmoment : ∀ j, + exponentMoment (capacityWitnessMass ρ δa δb α) + (cleanWitnessExponent a b) j = αfull j) + (hcertUpper : + entropyCapacityCertificate (capacityWitnessMass ρ δa δb α) + (cleanWitnessCoefficient u v a b) ≤ + Real.log (polynomialCapacity αfull (pairPolynomial u v))) + (houtside : + -τ * ρ * Real.log 2 + + (1 + τ) * (∑ l, α l * Real.log (α l)) ≤ + ∑ l, α l * Real.log (u l.1 + v l.1)) : + (1 - ρ) * Real.log ((2 * w ^ 2) / (1 - ρ)) + + ρ * Real.log w - τ * ρ * Real.log 2 + + τ * (∑ l, α l * Real.log (α l)) - + δa * Real.log (δa / ρ) - + δb * Real.log (δb / ρ) ≤ + Real.log (polynomialCapacity αfull (pairPolynomial u v)) := by + exact (cleanWitness_capacity_theta_lower hab hw hρ hρ1 hδa hδb + hδsum hα hαsum hu hv hua hub hva hvb houtside).trans hcertUpper + +/-- The sparse-witness capacity is bounded by the capacity of the full pair +polynomial. This is the omitted subpolynomial step in paper Lemma 19. -/ +theorem cleanWitnessCapacity_le_pairPolynomialCapacity + {ι : Type*} [Fintype ι] [DecidableEq ι] + {a b : ι} (hab : a ≠ b) {u v α : ι → ℝ} + (hu : ∀ j, 0 ≤ u j) (hv : ∀ j, 0 ≤ v j) : + finitePolynomialCapacity (cleanWitnessCoefficient u v a b) + (cleanWitnessExponent a b) α ≤ + polynomialCapacity α (pairPolynomial u v) := by + exact finitePolynomialCapacity_le_polynomialCapacity_of_eval_le + (cleanWitnessCoefficient_nonnegative hu hv a b) + (fun z hz ↦ finitePolynomial_cleanWitness_le_pairPolynomial_eval + hab hu hv hz) + +/-- A feasible clean witness certifies the capacity of the full pair +polynomial, not merely the sparse polynomial supported on the witness. -/ +theorem cleanWitnessEntropyCertificate_le_log_pairPolynomialCapacity + {ι : Type*} [Fintype ι] [DecidableEq ι] + {a b : ι} (hab : a ≠ b) {u v α : ι → ℝ} + {θ : CapacityWitnessEdge (OutsideColumn a b) → ℝ} + (hθ : ∀ e, 0 ≤ θ e) (hθsum : ∑ e, θ e = 1) + (hcoeff : ∀ e, 0 < cleanWitnessCoefficient u v a b e) + (hmoment : ∀ j, + exponentMoment θ (cleanWitnessExponent a b) j = α j) + (hu : ∀ j, 0 ≤ u j) (hv : ∀ j, 0 ≤ v j) : + entropyCapacityCertificate θ (cleanWitnessCoefficient u v a b) ≤ + Real.log (polynomialCapacity α (pairPolynomial u v)) := by + have hfinite := entropyCapacityCertificate_le_log_finitePolynomialCapacity + hθ hθsum hcoeff hmoment + have hexp := exp_entropyCapacityCertificate_le_finitePolynomialCapacity + hθ hθsum hcoeff hmoment + have hfinitePos : 0 < finitePolynomialCapacity + (cleanWitnessCoefficient u v a b) (cleanWitnessExponent a b) α := + (Real.exp_pos _).trans_le hexp + have hcap := cleanWitnessCapacity_le_pairPolynomialCapacity + hab hu hv (α := α) + exact hfinite.trans (Real.log_le_log hfinitePos hcap) + +/-- Paper (59) for the full pair polynomial. -/ +theorem cleanWitness_capacity_theta_bound + {ι : Type*} [Fintype ι] [DecidableEq ι] + {a b : ι} (hab : a ≠ b) + {u v αfull : ι → ℝ} {w ρ δa δb τ : ℝ} + {α : OutsideColumn a b → ℝ} + (hw : 0 < w) (hρ : 0 < ρ) (hρ1 : ρ < 1) + (hδa : 0 < δa) (hδb : 0 < δb) + (hδsum : δa + δb = ρ) + (hα : ∀ l, 0 < α l) (hαsum : ∑ l, α l = ρ) + (hu : ∀ j, 0 < u j) (hv : ∀ j, 0 < v j) + (hua : w ≤ u a) (hub : w ≤ u b) + (hva : w ≤ v a) (hvb : w ≤ v b) + (hmoment : ∀ j, + exponentMoment (capacityWitnessMass ρ δa δb α) + (cleanWitnessExponent a b) j = αfull j) + (houtside : + -τ * ρ * Real.log 2 + + (1 + τ) * (∑ l, α l * Real.log (α l)) ≤ + ∑ l, α l * Real.log (u l.1 + v l.1)) : + (1 - ρ) * Real.log ((2 * w ^ 2) / (1 - ρ)) + + ρ * Real.log w - τ * ρ * Real.log 2 + + τ * (∑ l, α l * Real.log (α l)) - + δa * Real.log (δa / ρ) - + δb * Real.log (δb / ρ) ≤ + Real.log (polynomialCapacity αfull (pairPolynomial u v)) := by + have hθnonneg : ∀ e, + 0 ≤ capacityWitnessMass ρ δa δb α e := + capacityWitness_nonnegative hρ hρ1.le hδa.le hδb.le + (fun l ↦ (hα l).le) + have hθsum : ∑ e, capacityWitnessMass ρ δa δb α e = 1 := + capacityWitness_sum hρ hδsum hαsum + have hcoeff : ∀ e, 0 < cleanWitnessCoefficient u v a b e := + cleanWitnessCoefficient_positive hu hv a b + have hcert := + cleanWitnessEntropyCertificate_le_log_pairPolynomialCapacity hab + hθnonneg hθsum hcoeff hmoment + (fun j ↦ (hu j).le) (fun j ↦ (hv j).le) + exact cleanWitness_capacity_theta_bound_of_certificate hab hw hρ hρ1 + hδa hδb hδsum hα hαsum hu hv hua hub hva hvb hmoment hcert + houtside + +theorem cleanWitness_coreA_moment + {ι : Type*} [Fintype ι] [DecidableEq ι] + {a b : ι} (hab : a ≠ b) + {ρ δa δb αa : ℝ} {α : OutsideColumn a b → ℝ} + (hρ : 0 < ρ) (hαsum : ∑ l, α l = ρ) + (hδa : δa + αa = 1) (hδsum : δa + δb = ρ) : + exponentMoment (capacityWitnessMass ρ δa δb α) + (cleanWitnessExponent a b) a = αa := by + rw [exponentMoment] + simp only [Fintype.sum_sum_type, Fintype.sum_unique, + cleanWitnessExponent, if_pos (Or.inl rfl), Nat.cast_one, mul_one] + have hright : ∀ l : OutsideColumn a b, + ((if a = b ∨ a = l.1 then 1 else 0 : ℕ) : ℝ) = 0 := by + intro l + simp [hab, l.ne_a.symm] + simp_rw [hright, mul_zero, Finset.sum_const_zero, add_zero] + simp only [true_or, or_true, if_true, Nat.cast_one, mul_one] + exact capacityWitness_coreA_marginal hρ hαsum hδa hδsum + +theorem cleanWitness_coreB_moment + {ι : Type*} [Fintype ι] [DecidableEq ι] + {a b : ι} (hab : a ≠ b) + {ρ δa δb αb : ℝ} {α : OutsideColumn a b → ℝ} + (hρ : 0 < ρ) (hαsum : ∑ l, α l = ρ) + (hδb : δb + αb = 1) (hδsum : δa + δb = ρ) : + exponentMoment (capacityWitnessMass ρ δa δb α) + (cleanWitnessExponent a b) b = αb := by + rw [exponentMoment] + simp only [Fintype.sum_sum_type, Fintype.sum_unique, + cleanWitnessExponent, if_pos (Or.inr rfl), Nat.cast_one, mul_one] + have hleft : ∀ l : OutsideColumn a b, + ((if b = a ∨ b = l.1 then 1 else 0 : ℕ) : ℝ) = 0 := by + intro l + simp [hab.symm, l.ne_b.symm] + simp_rw [hleft, mul_zero, Finset.sum_const_zero, zero_add] + simp only [true_or, or_true, if_true, Nat.cast_one, mul_one] + exact capacityWitness_coreB_marginal hρ hαsum hδb hδsum + +theorem cleanWitness_outside_moment + {ι : Type*} [Fintype ι] [DecidableEq ι] + {a b : ι} {ρ δa δb : ℝ} {α : OutsideColumn a b → ℝ} + (hρ : 0 < ρ) (hδsum : δa + δb = ρ) + (l : OutsideColumn a b) : + exponentMoment (capacityWitnessMass ρ δa δb α) + (cleanWitnessExponent a b) l.1 = α l := by + rw [exponentMoment] + simp only [Fintype.sum_sum_type, Fintype.sum_unique, + cleanWitnessExponent] + have hcore : ¬(l.1 = a ∨ l.1 = b) := by + exact fun h ↦ h.elim l.ne_a l.ne_b + rw [if_neg hcore, Nat.cast_zero, mul_zero, zero_add] + have hleft : + (∑ x : OutsideColumn a b, + capacityWitnessMass ρ δa δb α (Sum.inr (Sum.inl x)) * + ((if l.1 = a ∨ l.1 = x.1 then 1 else 0 : ℕ) : ℝ)) = + capacityWitnessMass ρ δa δb α (Sum.inr (Sum.inl l)) := by + let f : OutsideColumn a b → ℝ := fun x ↦ + capacityWitnessMass ρ δa δb α (Sum.inr (Sum.inl x)) * + ((if l.1 = a ∨ l.1 = x.1 then 1 else 0 : ℕ) : ℝ) + have hsingle : (∑ x, f x) = f l := Fintype.sum_eq_single l (by + intro x hxl + have hne : l.1 ≠ x.1 := by + intro heq + apply hxl + exact Subtype.ext heq.symm + have hcond : ¬(l.1 = a ∨ l.1 = x.1) := + fun h ↦ h.elim l.ne_a hne + have hlx : l ≠ x := Ne.symm hxl + simp [f, hcond, l.ne_a, hlx]) + simpa [f, l.ne_a] using hsingle + have hright : + (∑ x : OutsideColumn a b, + capacityWitnessMass ρ δa δb α (Sum.inr (Sum.inr x)) * + ((if l.1 = b ∨ l.1 = x.1 then 1 else 0 : ℕ) : ℝ)) = + capacityWitnessMass ρ δa δb α (Sum.inr (Sum.inr l)) := by + let f : OutsideColumn a b → ℝ := fun x ↦ + capacityWitnessMass ρ δa δb α (Sum.inr (Sum.inr x)) * + ((if l.1 = b ∨ l.1 = x.1 then 1 else 0 : ℕ) : ℝ) + have hsingle : (∑ x, f x) = f l := Fintype.sum_eq_single l (by + intro x hxl + have hne : l.1 ≠ x.1 := by + intro heq + apply hxl + exact Subtype.ext heq.symm + have hcond : ¬(l.1 = b ∨ l.1 = x.1) := + fun h ↦ h.elim l.ne_b hne + have hlx : l ≠ x := Ne.symm hxl + simp [f, hcond, l.ne_b, hlx]) + simpa [f, l.ne_b] using hsingle + rw [hleft, hright] + exact capacityWitness_outside_marginal hρ hδsum l + +/-- The distribution in paper (52) has the claimed mean exponent vector. -/ +theorem cleanWitness_moment + {ι : Type*} [Fintype ι] [DecidableEq ι] + {a b : ι} (hab : a ≠ b) + {ρ δa δb : ℝ} {α : ι → ℝ} + (hρ : 0 < ρ) + (hαsum : ∑ l : OutsideColumn a b, α l.1 = ρ) + (hδa : δa + α a = 1) (hδb : δb + α b = 1) + (hδsum : δa + δb = ρ) : + ∀ j, + exponentMoment + (capacityWitnessMass ρ δa δb (fun l ↦ α l.1)) + (cleanWitnessExponent a b) j = α j := by + intro j + by_cases hja : j = a + · subst j + exact cleanWitness_coreA_moment hab hρ hαsum hδa hδsum + by_cases hjb : j = b + · subst j + exact cleanWitness_coreB_moment hab hρ hαsum hδb hδsum + · let l : OutsideColumn a b := ⟨j, by + simp [outsideColumnFinset, hja, hjb]⟩ + simpa [l] using cleanWitness_outside_moment + (α := fun l : OutsideColumn a b ↦ α l.1) hρ hδsum l + +theorem sum_outsideColumn_eq_outsideMassTwo + {ι : Type*} [Fintype ι] [DecidableEq ι] + (p : ι → ℝ) (a b : ι) : + (∑ l : OutsideColumn a b, p l.1) = outsideMassTwo p a b := by + change (∑ l : ↥(outsideColumnFinset a b), p l.1) = + ∑ j ∈ outsideColumnFinset a b, p j + exact Finset.sum_coe_sort (outsideColumnFinset a b) (fun j ↦ p j) + +/-- The paper's witness has mean `alpha_j = X_rj + X_sj` once its parameters +`rho`, `delta_a`, and `delta_b` are instantiated. -/ +theorem cleanWitness_pairAlpha_moment + {ι : Type*} [Fintype ι] [DecidableEq ι] + {X : Matrix ι ι ℝ} (hX : IsDoublyStochastic X) + {r s a b : ι} (hab : a ≠ b) + (hρ : 0 < outsideMassTwo (pairAlpha X r s) a b) : + let α := pairAlpha X r s + let ρ := outsideMassTwo α a b + let δa := 1 - α a + let δb := 1 - α b + ∀ j, + exponentMoment + (capacityWitnessMass ρ δa δb + (fun l : OutsideColumn a b ↦ α l.1)) + (cleanWitnessExponent a b) j = α j := by + dsimp only + apply cleanWitness_moment hab hρ + · exact sum_outsideColumn_eq_outsideMassTwo _ _ _ + · ring + · ring + · have hsplit := twoCore_add_outsideMassTwo_eq_sum + (pairAlpha X r s) hab + rw [sum_pairAlpha hX r s] at hsplit + linarith + +/-- Nonnegativity and normalization of the clean witness in the `rho > 0` +case. -/ +theorem cleanWitness_pairAlpha_isProbabilityVector + {ι : Type*} [Fintype ι] [DecidableEq ι] + {X : Matrix ι ι ℝ} (hX : IsDoublyStochastic X) + {r s a b : ι} (hrs : r ≠ s) (hab : a ≠ b) + (hρ : 0 < outsideMassTwo (pairAlpha X r s) a b) + (hρ1 : outsideMassTwo (pairAlpha X r s) a b ≤ 1) : + let α := pairAlpha X r s + let ρ := outsideMassTwo α a b + let δa := 1 - α a + let δb := 1 - α b + IsProbabilityVector + (capacityWitnessMass ρ δa δb + (fun l : OutsideColumn a b ↦ α l.1)) := by + dsimp only + have hδa : 0 ≤ 1 - pairAlpha X r s a := + sub_nonneg.mpr (pairAlpha_le_one hX hrs a) + have hδb : 0 ≤ 1 - pairAlpha X r s b := + sub_nonneg.mpr (pairAlpha_le_one hX hrs b) + have hα : ∀ l : OutsideColumn a b, 0 ≤ pairAlpha X r s l.1 := + fun l ↦ pairAlpha_nonneg hX r s l.1 + have hsplit := twoCore_add_outsideMassTwo_eq_sum + (pairAlpha X r s) hab + rw [sum_pairAlpha hX r s] at hsplit + have hδsum : (1 - pairAlpha X r s a) + + (1 - pairAlpha X r s b) = + outsideMassTwo (pairAlpha X r s) a b := by + linarith + constructor + · exact capacityWitness_nonnegative hρ hρ1 hδa hδb hα + · exact capacityWitness_sum hρ hδsum + (sum_outsideColumn_eq_outsideMassTwo _ _ _) + +/-- The capacity portion of paper Lemma 19, through displayed equation (59), +for the actual transfer vectors and pair marginals. -/ +theorem pairTransfer_capacity_theta_bound + {ι : Type*} [Fintype ι] [DecidableEq ι] + {τ κ : ℝ} (hτ : 0 ≤ τ) + {X : Matrix ι ι ℝ} (hX : IsDoublyStochastic X) + (hXint : ∀ i, IsInteriorProbabilityVector (X i)) + {r s a b : ι} (hrs : r ≠ s) (hab : a ≠ b) + (hcost : fourCoreTransferCost τ X r s a b ≤ κ) + (hρ : 0 < outsideMassTwo (pairAlpha X r s) a b) + (hρ1 : outsideMassTwo (pairAlpha X r s) a b < 1) : + let α := pairAlpha X r s + let ρ := outsideMassTwo α a b + let δa := 1 - α a + let δb := 1 - α b + let Ur := fun j ↦ transferU τ (X r) j + let Us := fun j ↦ transferU τ (X s) j + (1 - ρ) * Real.log ((2 * (Real.exp (-κ)) ^ 2) / (1 - ρ)) + + ρ * Real.log (Real.exp (-κ)) - τ * ρ * Real.log 2 + + τ * (∑ l : OutsideColumn a b, α l.1 * Real.log (α l.1)) - + δa * Real.log (δa / ρ) - δb * Real.log (δb / ρ) ≤ + Real.log (polynomialCapacity α (pairPolynomial Ur Us)) := by + dsimp only + let α := pairAlpha X r s + let ρ := outsideMassTwo α a b + let δa := 1 - α a + let δb := 1 - α b + let Ur : ι → ℝ := fun j ↦ transferU τ (X r) j + let Us : ι → ℝ := fun j ↦ transferU τ (X s) j + have hcore := fourCoreTransfer_lower hτ hXint hcost + have hδpos := pairAlpha_coreDeficit_pos hX hXint hrs hab hρ + have hαpos : ∀ l : OutsideColumn a b, 0 < α l.1 := by + intro l + exact add_pos ((hXint r).2 l.1).1 ((hXint s).2 l.1).1 + have hαsum : ∑ l : OutsideColumn a b, α l.1 = ρ := + sum_outsideColumn_eq_outsideMassTwo α a b + have hδsum : δa + δb = ρ := by + have hsplit := twoCore_add_outsideMassTwo_eq_sum α hab + rw [show ∑ j, α j = 2 by + simpa only [α] using sum_pairAlpha hX r s] at hsplit + dsimp only [δa, δb, ρ] + linarith + have hmoment : ∀ j, + exponentMoment + (capacityWitnessMass ρ δa δb + (fun l : OutsideColumn a b ↦ α l.1)) + (cleanWitnessExponent a b) j = α j := by + simpa only [α, ρ, δa, δb] using + cleanWitness_pairAlpha_moment hX hab hρ + have houtside : + -τ * ρ * Real.log 2 + + (1 + τ) * + (∑ l : OutsideColumn a b, + α l.1 * Real.log (α l.1)) ≤ + ∑ l : OutsideColumn a b, + α l.1 * Real.log (Ur l.1 + Us l.1) := by + exact sum_alpha_log_pairTransfer_lower (a := a) (b := b) + hτ (hXint r) (hXint s) (by simpa only [α, ρ, pairAlpha] using hαsum) + have hUr : ∀ j, 0 < Ur j := fun j ↦ transferU_pos (hXint r) j + have hUs : ∀ j, 0 < Us j := fun j ↦ transferU_pos (hXint s) j + apply cleanWitness_capacity_theta_bound hab (Real.exp_pos _) hρ hρ1 + hδpos.1 hδpos.2 hδsum hαpos hαsum hUr hUs + · exact hcore.1 + · exact hcore.2.1 + · exact hcore.2.2.1 + · exact hcore.2.2.2 + · exact hmoment + · exact houtside + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/ClusterAlpha.lean b/LeanPool/BeyondBethe/BeyondBethe/ClusterAlpha.lean new file mode 100644 index 0000000000..31bc2fced8 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/ClusterAlpha.lean @@ -0,0 +1,106 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.ClusterFactors +import LeanPool.BeyondBethe.BeyondBethe.Birkhoff +import Mathlib.Tactic + +/-! # Cluster Alpha -/ + +open scoped BigOperators + +namespace BeyondBethe + +/-- The total `X`-mass which a row cluster sends to a column. This is the +vector `alpha` used when the stable coefficient inequality is applied to the +cluster polynomial and the column selector. -/ +noncomputable def clusterAlpha + {n : ℕ} (X : Matrix (Fin n) (Fin n) ℝ) (C : RowClustering n) : + C.Cluster × Fin n → ℝ := + fun v ↦ ∑ k, X (C.rows ⟨v.1, k⟩) v.2 + +theorem clusterAlpha_nonnegative + {n : ℕ} {X : Matrix (Fin n) (Fin n) ℝ} (C : RowClustering n) + (hX : IsDoublyStochastic X) (v : C.Cluster × Fin n) : + 0 ≤ clusterAlpha X C v := by + rw [clusterAlpha] + exact Finset.sum_nonneg fun k _ ↦ hX.nonnegative (C.rows ⟨v.1, k⟩) v.2 + +theorem clusterAlpha_pos + {n : ℕ} {X : Matrix (Fin n) (Fin n) ℝ} (C : RowClustering n) + (hX : ∀ i j, 0 < X i j) {c : C.Cluster} (hc : 0 < C.size c) + (j : Fin n) : + 0 < clusterAlpha X C (c, j) := by + rw [clusterAlpha] + letI : Nonempty (Fin (C.size c)) := ⟨⟨0, hc⟩⟩ + exact Finset.sum_pos + (fun k _ ↦ hX (C.rows ⟨c, k⟩) j) + Finset.univ_nonempty + +theorem clusterAlpha_row_sum + {n : ℕ} {X : Matrix (Fin n) (Fin n) ℝ} (C : RowClustering n) + (hX : IsDoublyStochastic X) (c : C.Cluster) : + ∑ j, clusterAlpha X C (c, j) = C.size c := by + change ∑ j, ∑ k, X (C.rows ⟨c, k⟩) j = C.size c + rw [Finset.sum_comm] + simp_rw [hX.row_sum] + simp + +theorem clusterAlpha_col_sum + {n : ℕ} {X : Matrix (Fin n) (Fin n) ℝ} (C : RowClustering n) + (hX : IsDoublyStochastic X) (j : Fin n) : + ∑ c, clusterAlpha X C (c, j) = 1 := by + change ∑ c, ∑ k, X (C.rows ⟨c, k⟩) j = 1 + rw [← Fintype.sum_sigma'] + calc + (∑ s : Σ c, Fin (C.size c), X (C.rows s) j) = + ∑ i, X i j := Equiv.sum_comp C.rows (fun i ↦ X i j) + _ = 1 := hX.col_sum j + +theorem clusterAlpha_le_one + {n : ℕ} {X : Matrix (Fin n) (Fin n) ℝ} (C : RowClustering n) + (hX : IsDoublyStochastic X) (c : C.Cluster) (j : Fin n) : + clusterAlpha X C (c, j) ≤ 1 := by + let e : Fin (C.size c) → (Σ d, Fin (C.size d)) := fun k ↦ ⟨c, k⟩ + have he : Function.Injective e := by + intro k l h + exact eq_of_heq (Sigma.mk.inj_iff.mp h).2 + have hslice : + clusterAlpha X C (c, j) = + ∑ s ∈ (Finset.univ.image e), X (C.rows s) j := by + rw [clusterAlpha, Finset.sum_image he.injOn] + rw [hslice, ← hX.col_sum j] + calc + (∑ s ∈ (Finset.univ.image e), X (C.rows s) j) ≤ + ∑ s : Σ d, Fin (C.size d), X (C.rows s) j := by + exact Finset.sum_le_sum_of_subset_of_nonneg + (Finset.subset_univ _) (fun s _ _ ↦ hX.nonnegative (C.rows s) j) + _ = ∑ i, X i j := Equiv.sum_comp C.rows (fun i ↦ X i j) + +theorem clusterAlpha_total_sum + {n : ℕ} {X : Matrix (Fin n) (Fin n) ℝ} (C : RowClustering n) + (hX : IsDoublyStochastic X) : + ∑ v, clusterAlpha X C v = n := by + rw [Fintype.sum_prod_type] + simp_rw [clusterAlpha_row_sum C hX] + exact_mod_cast sum_clusterSizes_eq C + +theorem clusterAlpha_in_unit_interval + {n : ℕ} {X : Matrix (Fin n) (Fin n) ℝ} (C : RowClustering n) + (hX : IsDoublyStochastic X) (v : C.Cluster × Fin n) : + 0 ≤ clusterAlpha X C v ∧ clusterAlpha X C v ≤ 1 := by + exact ⟨clusterAlpha_nonnegative C hX v, + clusterAlpha_le_one C hX v.1 v.2⟩ + +theorem clusterAlpha_pos_of_singletonPairs + {n : ℕ} {X : Matrix (Fin n) (Fin n) ℝ} (C : RowClustering n) + (hX : ∀ i j, 0 < X i j) (hclusters : IsSingletonPairClustering C) + (v : C.Cluster × Fin n) : + 0 < clusterAlpha X C v := by + apply clusterAlpha_pos C hX (c := v.1) + rcases hclusters v.1 with h | h <;> omega + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/ClusterCertificate.lean b/LeanPool/BeyondBethe/BeyondBethe/ClusterCertificate.lean new file mode 100644 index 0000000000..6b7abd01a1 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/ClusterCertificate.lean @@ -0,0 +1,364 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.CertificateCapacity +import LeanPool.BeyondBethe.BeyondBethe.ClusterAlpha +import LeanPool.BeyondBethe.BeyondBethe.Bethe +import Mathlib.Tactic + +/-! # Cluster Certificate -/ + +open scoped BigOperators + +namespace BeyondBethe + +/-- The part of the stable boundary factor which remains after the powers of +`alpha` cancel against the column-selector capacity. -/ +noncomputable def clusterComplementFactor + {σ : Type*} [Fintype σ] (α : σ → ℝ) : ℝ := + ∏ v, (1 - α v) ^ (1 - α v) + +theorem stableBoundaryFactor_nonnegative + {σ : Type*} [Fintype σ] {α : σ → ℝ} + (hα : ∀ v, 0 ≤ α v ∧ α v ≤ 1) : + 0 ≤ stableBoundaryFactor α := by + rw [stableBoundaryFactor] + exact Finset.prod_nonneg fun v _ ↦ mul_nonneg + (Real.rpow_nonneg (hα v).1 _) (Real.rpow_nonneg (sub_nonneg.mpr (hα v).2) _) + +theorem selectorCapacityValue_pos + {κ ι : Type*} [Fintype κ] [Fintype ι] + {α : κ × ι → ℝ} (hα : ∀ v, 0 < α v) : + 0 < selectorCapacityValue α := by + rw [selectorCapacityValue] + apply Finset.prod_pos + intro j _ + rw [linearCapacityValue] + exact Finset.prod_pos fun c _ ↦ + Real.rpow_pos_of_pos (div_pos (by norm_num) (hα (c, j))) _ + +theorem boundaryTerm_mul_selectorTerm + {a : ℝ} (ha : 0 < a) : + (a ^ a * (1 - a) ^ (1 - a)) * (1 / a) ^ a = + (1 - a) ^ (1 - a) := by + rw [one_div, Real.inv_rpow (le_of_lt ha)] + have hp : 0 < a ^ a := Real.rpow_pos_of_pos ha _ + calc + (a ^ a * (1 - a) ^ (1 - a)) * (a ^ a)⁻¹ = + (a ^ a * (a ^ a)⁻¹) * (1 - a) ^ (1 - a) := by ring + _ = (1 - a) ^ (1 - a) := by rw [mul_inv_cancel₀ hp.ne', one_mul] + +theorem stableBoundaryFactor_mul_selectorCapacityValue + {κ ι : Type*} [Fintype κ] [Fintype ι] + {α : κ × ι → ℝ} (hα : ∀ v, 0 < α v) : + stableBoundaryFactor α * selectorCapacityValue α = + clusterComplementFactor α := by + rw [stableBoundaryFactor, selectorCapacityValue, clusterComplementFactor] + simp only [linearCapacityValue, Fintype.prod_prod_type] + have hcomm : + (∏ j, ∏ c, (1 / α (c, j)) ^ α (c, j)) = + ∏ c, ∏ j, (1 / α (c, j)) ^ α (c, j) := + Finset.prod_comm + rw [hcomm] + rw [← Finset.prod_mul_distrib] + apply Finset.prod_congr rfl + intro c _ + rw [← Finset.prod_mul_distrib] + apply Finset.prod_congr rfl + intro j _ + exact boundaryTerm_mul_selectorTerm (hα (c, j)) + +/-- The cluster form of the paired certificate: singleton and pair factors +are recovered below by specializing each local injection polynomial. -/ +noncomputable def clusterCertificateValue + {n : ℕ} (A : Matrix (Fin n) (Fin n) ℝ) (C : RowClustering n) + (α : C.Cluster × Fin n → ℝ) : ℝ := + clusterComplementFactor α * clusterProductCapacityValue A C α + +/-- The factor contributed by one cluster before distinguishing singleton and +pair clusters. -/ +noncomputable def localClusterCertificate + {n : ℕ} (A : Matrix (Fin n) (Fin n) ℝ) (C : RowClustering n) + (α : C.Cluster × Fin n → ℝ) (c : C.Cluster) : ℝ := + (∏ j, (1 - α (c, j)) ^ (1 - α (c, j))) * + polynomialCapacity (fun j ↦ α (c, j)) + (injectionPolynomial (fun k j ↦ A (C.rows ⟨c, k⟩) j)) + +theorem clusterCertificateValue_eq_prod_local + {n : ℕ} (A : Matrix (Fin n) (Fin n) ℝ) (C : RowClustering n) + (α : C.Cluster × Fin n → ℝ) : + clusterCertificateValue A C α = + ∏ c, localClusterCertificate A C α c := by + rw [clusterCertificateValue, clusterComplementFactor, + clusterProductCapacityValue] + simp only [Fintype.prod_prod_type, localClusterCertificate, + ← Finset.prod_mul_distrib] + +/-- The unique row in a cluster whose size has been identified as one. -/ +noncomputable def singletonClusterRow + {n : ℕ} (C : RowClustering n) (c : C.Cluster) (hc : C.size c = 1) : + Fin n := + C.rows ⟨c, (Fin.castOrderIso hc).symm 0⟩ + +/-- The two ordered rows in a cluster whose size has been identified as two. +The order is immaterial to the symmetric pair certificate. -/ +noncomputable def pairClusterRow + {n : ℕ} (C : RowClustering n) (c : C.Cluster) (hc : C.size c = 2) : + Fin 2 → Fin n := + fun k ↦ C.rows ⟨c, (Fin.castOrderIso hc).symm k⟩ + +theorem pairClusterRow_ne + {n : ℕ} (C : RowClustering n) (c : C.Cluster) (hc : C.size c = 2) : + pairClusterRow C c hc 0 ≠ pairClusterRow C c hc 1 := by + intro h + have hs := C.rows.injective h + have hk : (0 : Fin 2) = 1 := by + apply (Fin.castOrderIso hc).symm.injective + exact eq_of_heq (Sigma.mk.inj_iff.mp hs).2 + norm_num at hk + +theorem clusterAlpha_eq_singleton + {n : ℕ} (X : Matrix (Fin n) (Fin n) ℝ) (C : RowClustering n) + (c : C.Cluster) (hc : C.size c = 1) (j : Fin n) : + clusterAlpha X C (c, j) = X (singletonClusterRow C c hc) j := by + let e : Fin (C.size c) ≃ Fin 1 := (Fin.castOrderIso hc).toEquiv + change (∑ k : Fin (C.size c), X (C.rows ⟨c, k⟩) j) = _ + calc + (∑ k : Fin (C.size c), X (C.rows ⟨c, k⟩) j) = + ∑ k : Fin 1, X (C.rows ⟨c, e.symm k⟩) j := + (Equiv.sum_comp e.symm + (fun k : Fin (C.size c) ↦ X (C.rows ⟨c, k⟩) j)).symm + _ = X (singletonClusterRow C c hc) j := by + simp [singletonClusterRow, e] + +theorem clusterAlpha_eq_pair + {n : ℕ} (X : Matrix (Fin n) (Fin n) ℝ) (C : RowClustering n) + (c : C.Cluster) (hc : C.size c = 2) (j : Fin n) : + clusterAlpha X C (c, j) = + pairAlpha X (pairClusterRow C c hc 0) (pairClusterRow C c hc 1) j := by + let e : Fin (C.size c) ≃ Fin 2 := (Fin.castOrderIso hc).toEquiv + change (∑ k : Fin (C.size c), X (C.rows ⟨c, k⟩) j) = _ + calc + (∑ k : Fin (C.size c), X (C.rows ⟨c, k⟩) j) = + ∑ k : Fin 2, X (C.rows ⟨c, e.symm k⟩) j := + (Equiv.sum_comp e.symm + (fun k : Fin (C.size c) ↦ X (C.rows ⟨c, k⟩) j)).symm + _ = pairAlpha X (pairClusterRow C c hc 0) + (pairClusterRow C c hc 1) j := by + simp [Fin.sum_univ_two, pairAlpha, pairClusterRow, e] + +theorem clusterInjectionPolynomial_eq_singleton + {n : ℕ} (A : Matrix (Fin n) (Fin n) ℝ) (C : RowClustering n) + (c : C.Cluster) (hc : C.size c = 1) : + injectionPolynomial (fun k j ↦ A (C.rows ⟨c, k⟩) j) = + positiveLinearPolynomial (fun j ↦ A (singletonClusterRow C c hc) j) := by + let e : Fin (C.size c) ≃ Fin 1 := (Fin.castOrderIso hc).toEquiv + calc + injectionPolynomial (fun k j ↦ A (C.rows ⟨c, k⟩) j) = + injectionPolynomial (fun k : Fin 1 ↦ fun j ↦ + A (C.rows ⟨c, e.symm k⟩) j) := + injectionPolynomial_reindex_rows _ e + _ = positiveLinearPolynomial (fun j ↦ + A (singletonClusterRow C c hc) j) := by + rw [injectionPolynomial_fin_one] + rfl + +theorem clusterInjectionPolynomial_eq_pair + {n : ℕ} (A : Matrix (Fin n) (Fin n) ℝ) (C : RowClustering n) + (c : C.Cluster) (hc : C.size c = 2) : + injectionPolynomial (fun k j ↦ A (C.rows ⟨c, k⟩) j) = + pairPolynomial (fun j ↦ A (pairClusterRow C c hc 0) j) + (fun j ↦ A (pairClusterRow C c hc 1) j) := by + let e : Fin (C.size c) ≃ Fin 2 := (Fin.castOrderIso hc).toEquiv + calc + injectionPolynomial (fun k j ↦ A (C.rows ⟨c, k⟩) j) = + injectionPolynomial (fun k : Fin 2 ↦ fun j ↦ + A (C.rows ⟨c, e.symm k⟩) j) := + injectionPolynomial_reindex_rows _ e + _ = pairPolynomial (fun j ↦ A (pairClusterRow C c hc 0) j) + (fun j ↦ A (pairClusterRow C c hc 1) j) := by + rw [injectionPolynomial_fin_two] + rfl + +noncomputable def singletonProductValue + {n : ℕ} (A X : Matrix (Fin n) (Fin n) ℝ) (i : Fin n) : ℝ := + ∏ j, (A i j / X i j) ^ (X i j) * + (1 - X i j) ^ (1 - X i j) + +noncomputable def pairCertificateValue + {n : ℕ} (A X : Matrix (Fin n) (Fin n) ℝ) (r s : Fin n) : ℝ := + (∏ j, (1 - pairAlpha X r s j) ^ (1 - pairAlpha X r s j)) * + polynomialCapacity (pairAlpha X r s) + (pairPolynomial (fun j ↦ A r j) (fun j ↦ A s j)) + +theorem localClusterCertificate_eq_singletonProduct + {n : ℕ} {A X : Matrix (Fin n) (Fin n) ℝ} (C : RowClustering n) + (hA : ∀ i j, 0 < A i j) (hX : IsDoublyStochastic X) + (hXpos : ∀ i j, 0 < X i j) + (c : C.Cluster) (hc : C.size c = 1) : + localClusterCertificate A C (clusterAlpha X C) c = + singletonProductValue A X (singletonClusterRow C c hc) := by + rw [localClusterCertificate] + simp_rw [clusterAlpha_eq_singleton X C c hc] + rw [clusterInjectionPolynomial_eq_singleton A C c hc, + ← linearCapacityValue_eq_capacity + (fun j ↦ hA (singletonClusterRow C c hc) j) + (fun j ↦ hXpos (singletonClusterRow C c hc) j) + (hX.row_sum (singletonClusterRow C c hc))] + rw [singletonProductValue, linearCapacityValue, + ← Finset.prod_mul_distrib] + apply Finset.prod_congr rfl + intro j _ + ring + +theorem localClusterCertificate_eq_pairCertificate + {n : ℕ} (A X : Matrix (Fin n) (Fin n) ℝ) (C : RowClustering n) + (c : C.Cluster) (hc : C.size c = 2) : + localClusterCertificate A C (clusterAlpha X C) c = + pairCertificateValue A X (pairClusterRow C c hc 0) + (pairClusterRow C c hc 1) := by + rw [localClusterCertificate, pairCertificateValue] + simp_rw [clusterAlpha_eq_pair X C c hc] + rw [clusterInjectionPolynomial_eq_pair A C c hc] + +theorem singletonProductValue_eq_singletonFactor + {n : ℕ} {A X : Matrix (Fin n) (Fin n) ℝ} + (hcard : 2 ≤ n) (hA : ∀ i j, 0 < A i j) + (hX : IsDoublyStochastic X) (hXpos : ∀ i j, 0 < X i j) + (i : Fin n) : + singletonProductValue A X i = singletonFactor A X i := by + have hXlt : ∀ j, X i j < 1 := fun j ↦ + hX.entry_lt_one_of_positive hXpos (by + simpa only [Fintype.card_fin] using + (lt_of_lt_of_le (by norm_num : 1 < 2) hcard)) i j + rw [singletonProductValue, singletonFactor, betheRowObjective, + Real.exp_sum] + apply Finset.prod_congr rfl + intro j _ + rw [Real.rpow_def_of_pos (div_pos (hA i j) (hXpos i j)), + Real.rpow_def_of_pos (sub_pos.mpr (hXlt j)), ← Real.exp_add] + congr 1 + rw [Real.negMulLog, Real.log_div (hA i j).ne' (hXpos i j).ne'] + ring + +/-- The paper's factor attached to a singleton-or-pair cluster. A clustering +of this kind is equivalent to a matching together with harmless names and an +ordering of the two rows in each matched pair. -/ +noncomputable def paperClusterFactor + {n : ℕ} (A X : Matrix (Fin n) (Fin n) ℝ) (C : RowClustering n) + (hclusters : IsSingletonPairClustering C) (c : C.Cluster) : ℝ := + if hc : C.size c = 1 then + singletonFactor A X (singletonClusterRow C c hc) + else + let hc2 : C.size c = 2 := (hclusters c).resolve_left hc + pairCertificateValue A X (pairClusterRow C c hc2 0) + (pairClusterRow C c hc2 1) + +theorem localClusterCertificate_eq_paperClusterFactor + {n : ℕ} {A X : Matrix (Fin n) (Fin n) ℝ} (C : RowClustering n) + (hcard : 2 ≤ n) (hA : ∀ i j, 0 < A i j) + (hX : IsDoublyStochastic X) (hXpos : ∀ i j, 0 < X i j) + (hclusters : IsSingletonPairClustering C) (c : C.Cluster) : + localClusterCertificate A C (clusterAlpha X C) c = + paperClusterFactor A X C hclusters c := by + rw [paperClusterFactor] + split + next hc => + exact (localClusterCertificate_eq_singletonProduct C hA hX hXpos c hc).trans + (singletonProductValue_eq_singletonFactor hcard hA hX hXpos _) + next hc => + let hc2 : C.size c = 2 := (hclusters c).resolve_left hc + exact localClusterCertificate_eq_pairCertificate A X C c hc2 + +/-- The polynomial heart of the paired lower certificate. All clustering, +stability, coefficient-pairing, capacity monotonicity, and cancellation steps +are internal. The theorem keeps the stable-coefficient statement as an +explicit argument for modularity; `SourceStableReindex` discharges it from +Mathlib in the final theorem. -/ +theorem clusterCertificateValue_le_permanent + {n : ℕ} + (stableCoefficient : AnariOveisGharanStableCoefficient.{0}) + {A X : Matrix (Fin n) (Fin n) ℝ} (C : RowClustering n) + (hcard : 2 ≤ n) (hA : ∀ i j, 0 < A i j) + (hX : IsDoublyStochastic X) (hXpos : ∀ i j, 0 < X i j) + (hclusters : IsSingletonPairClustering C) : + clusterCertificateValue A C (clusterAlpha X C) ≤ Matrix.permanent A := by + let α := clusterAlpha X C + have hαpos : ∀ v, 0 < α v := + clusterAlpha_pos_of_singletonPairs C hXpos hclusters + have hαunit : ∀ v, 0 ≤ α v ∧ α v ≤ 1 := + clusterAlpha_in_unit_interval C hX + have hαsum : ∑ v, α v = n := clusterAlpha_total_sum C hX + have hA0 : Matrix.Nonnegative A := fun i j ↦ le_of_lt (hA i j) + have hstable := singletonPairCluster_stableCoefficient_lower + stableCoefficient C hcard hA hclusters α hαunit hαsum + have hcluster := clusterProductCapacityValue_le_capacity C hA0 α + have hselector := selectorCapacityValue_le_capacity hαpos + (clusterAlpha_col_sum C hX) + have hboundary0 : 0 ≤ stableBoundaryFactor α := + stableBoundaryFactor_nonnegative hαunit + have hcluster0 : 0 ≤ clusterProductCapacityValue A C α := + clusterProductCapacityValue_nonneg C hA0 α + have hselector0 : 0 ≤ selectorCapacityValue α := + le_of_lt (selectorCapacityValue_pos hαpos) + have hcapCluster0 : + 0 ≤ polynomialCapacity α (rowClusterProduct A C) := + polynomialCapacity_nonneg (rowClusterProduct_nonnegativeCoefficients C hA0) α + have hreplaceCluster : + stableBoundaryFactor α * clusterProductCapacityValue A C α ≤ + stableBoundaryFactor α * polynomialCapacity α (rowClusterProduct A C) := + mul_le_mul_of_nonneg_left hcluster hboundary0 + have hreplaceCluster' : + stableBoundaryFactor α * clusterProductCapacityValue A C α * + selectorCapacityValue α ≤ + stableBoundaryFactor α * polynomialCapacity α (rowClusterProduct A C) * + selectorCapacityValue α := + mul_le_mul_of_nonneg_right hreplaceCluster hselector0 + have hreplaceSelector : + stableBoundaryFactor α * polynomialCapacity α (rowClusterProduct A C) * + selectorCapacityValue α ≤ + stableBoundaryFactor α * polynomialCapacity α (rowClusterProduct A C) * + polynomialCapacity α (columnSelector C.Cluster (Fin n)) := by + apply mul_le_mul_of_nonneg_left hselector + exact mul_nonneg hboundary0 hcapCluster0 + have hraw : + stableBoundaryFactor α * clusterProductCapacityValue A C α * + selectorCapacityValue α ≤ Matrix.permanent A := + hreplaceCluster'.trans (hreplaceSelector.trans hstable) + rw [clusterCertificateValue] + calc + clusterComplementFactor α * clusterProductCapacityValue A C α = + stableBoundaryFactor α * clusterProductCapacityValue A C α * + selectorCapacityValue α := by + rw [← stableBoundaryFactor_mul_selectorCapacityValue hαpos] + ring + _ ≤ Matrix.permanent A := hraw + +/-- Paper Theorem 5 in an equivalent cluster presentation of a row matching. +The product contains one Bethe singleton factor for every unmatched row and +one pair-capacity factor for every matched pair. -/ +theorem pairedLowerCertificate_for_clustering + {n : ℕ} + (stableCoefficient : AnariOveisGharanStableCoefficient.{0}) + {A X : Matrix (Fin n) (Fin n) ℝ} (C : RowClustering n) + (hcard : 2 ≤ n) (hA : ∀ i j, 0 < A i j) + (hX : IsDoublyStochastic X) (hXpos : ∀ i j, 0 < X i j) + (hclusters : IsSingletonPairClustering C) : + (∏ c, paperClusterFactor A X C hclusters c) ≤ Matrix.permanent A := by + calc + (∏ c, paperClusterFactor A X C hclusters c) = + ∏ c, localClusterCertificate A C (clusterAlpha X C) c := by + apply Finset.prod_congr rfl + intro c _ + exact (localClusterCertificate_eq_paperClusterFactor C hcard hA hX + hXpos hclusters c).symm + _ = clusterCertificateValue A C (clusterAlpha X C) := + (clusterCertificateValue_eq_prod_local A C (clusterAlpha X C)).symm + _ ≤ Matrix.permanent A := + clusterCertificateValue_le_permanent stableCoefficient C hcard hA + hX hXpos hclusters + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/ClusterFactors.lean b/LeanPool/BeyondBethe/BeyondBethe/ClusterFactors.lean new file mode 100644 index 0000000000..8fed4f7217 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/ClusterFactors.lean @@ -0,0 +1,187 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.ClusterProduct +import LeanPool.BeyondBethe.BeyondBethe.PairStability +import Mathlib.Data.Fin.Tuple.Embedding + +/-! # Cluster Factors -/ + +open scoped BigOperators + +namespace BeyondBethe + +open MvPolynomial + +theorem injectionPolynomial_reindex_rows + {m m' n : ℕ} (B : Fin m → Fin n → ℝ) (e : Fin m ≃ Fin m') : + injectionPolynomial B = + injectionPolynomial (fun k j ↦ B (e.symm k) j) := by + rw [injectionPolynomial, injectionPolynomial] + let E := Equiv.embeddingCongr e (Equiv.refl (Fin n)) + calc + (∑ f : Fin m ↪ Fin n, + monomial (∑ k, Finsupp.single (f k) 1) + (∏ k, B k (f k))) = + ∑ f : Fin m ↪ Fin n, + monomial (∑ k, Finsupp.single (E f k) 1) + (∏ k, B (e.symm k) (E f k)) := by + apply Finset.sum_congr rfl + intro f _ + have hexp : (∑ k, Finsupp.single (E f k) 1) = + ∑ k, Finsupp.single (f k) 1 := by + simpa [E] using Equiv.sum_comp e.symm + (fun k ↦ Finsupp.single (f k) 1) + have hweight : (∏ k, B (e.symm k) (E f k)) = + ∏ k, B k (f k) := by + simpa [E] using Equiv.prod_comp e.symm + (fun k ↦ B k (f k)) + rw [hexp, hweight] + _ = ∑ f : Fin m' ↪ Fin n, + monomial (∑ k, Finsupp.single (f k) 1) + (∏ k, B (e.symm k) (f k)) := + Equiv.sum_comp E (fun f ↦ + monomial (∑ k, Finsupp.single (f k) 1) + (∏ k, B (e.symm k) (f k))) + +theorem injectionPolynomial_fin_one + {n : ℕ} (B : Fin 1 → Fin n → ℝ) : + injectionPolynomial B = positiveLinearPolynomial (B 0) := by + rw [injectionPolynomial, positiveLinearPolynomial] + let e := Function.Embedding.oneEmbeddingEquiv (one := Fin 1) (α := Fin n) + calc + (∑ f : Fin 1 ↪ Fin n, + monomial (∑ k, Finsupp.single (f k) 1) + (∏ k, B k (f k))) = + ∑ f : Fin 1 ↪ Fin n, + monomial (Finsupp.single (e f) 1) (B 0 (e f)) := by + apply Finset.sum_congr rfl + intro f _ + simp [e, Function.Embedding.oneEmbeddingEquiv] + _ = ∑ j : Fin n, monomial (Finsupp.single j 1) (B 0 j) := + Equiv.sum_comp e + (fun j ↦ monomial (Finsupp.single j 1) (B 0 j)) + +theorem injectionPolynomial_fin_two + {n : ℕ} (B : Fin 2 → Fin n → ℝ) : + injectionPolynomial B = pairPolynomial (B 0) (B 1) := by + rw [injectionPolynomial, pairPolynomial] + let e := Function.Embedding.twoEmbeddingEquiv (α := Fin n) + calc + (∑ f : Fin 2 ↪ Fin n, + monomial (∑ k, Finsupp.single (f k) 1) + (∏ k, B k (f k))) = + ∑ f : Fin 2 ↪ Fin n, + monomial + (Finsupp.single (f 0) 1 + Finsupp.single (f 1) 1) + (B 0 (f 0) * B 1 (f 1)) := by + apply Finset.sum_congr rfl + intro f _ + simp [Fin.sum_univ_two, Fin.prod_univ_two] + _ = ∑ p : {(a, b) : Fin n × Fin n | a ≠ b}, + monomial + (Finsupp.single p.1.1 1 + Finsupp.single p.1.2 1) + (B 0 p.1.1 * B 1 p.1.2) := + by + simpa [e, Function.Embedding.twoEmbeddingEquiv] using + Equiv.sum_comp e (fun p ↦ + monomial + (Finsupp.single p.1.1 1 + Finsupp.single p.1.2 1) + (B 0 p.1.1 * B 1 p.1.2)) + _ = ∑ p ∈ (Finset.univ : Finset (Fin n)).offDiag, + monomial + (Finsupp.single p.1 1 + Finsupp.single p.2 1) + (B 0 p.1 * B 1 p.2) := by + symm + apply Finset.sum_subtype + intro p + simp + +theorem injectionPolynomial_fin_one_isRealStable + {n : ℕ} [Nonempty (Fin n)] {B : Fin 1 → Fin n → ℝ} + (hB : ∀ k j, 0 < B k j) : + IsRealStable (injectionPolynomial B) := by + rw [injectionPolynomial_fin_one] + exact positiveLinearPolynomial_isRealStable (fun j ↦ hB 0 j) + +theorem injectionPolynomial_fin_two_isRealStable + {n : ℕ} {B : Fin 2 → Fin n → ℝ} + (hcard : 2 ≤ n) (hB : ∀ k j, 0 < B k j) : + IsRealStable (injectionPolynomial B) := by + rw [injectionPolynomial_fin_two] + exact pairPolynomial_isRealStable_of_pos (by simpa using hcard) + (fun j ↦ hB 0 j) (fun j ↦ hB 1 j) + +theorem rowClusterPolynomial_isRealStable_of_size_one + {n : ℕ} [Nonempty (Fin n)] + {A : Matrix (Fin n) (Fin n) ℝ} (C : RowClustering n) + (hA : ∀ i j, 0 < A i j) (c : C.Cluster) + (hc : C.size c = 1) : + IsRealStable (rowClusterPolynomial A C c) := by + rw [rowClusterPolynomial_eq_rename_injectionPolynomial] + apply IsRealStable.rename + let e : Fin (C.size c) ≃ Fin 1 := (Fin.castOrderIso hc).toEquiv + rw [injectionPolynomial_reindex_rows _ e] + exact injectionPolynomial_fin_one_isRealStable + (fun k j ↦ hA (C.rows ⟨c, e.symm k⟩) j) + +theorem rowClusterPolynomial_isRealStable_of_size_two + {n : ℕ} {A : Matrix (Fin n) (Fin n) ℝ} (C : RowClustering n) + (hcard : 2 ≤ n) (hA : ∀ i j, 0 < A i j) (c : C.Cluster) + (hc : C.size c = 2) : + IsRealStable (rowClusterPolynomial A C c) := by + rw [rowClusterPolynomial_eq_rename_injectionPolynomial] + apply IsRealStable.rename + let e : Fin (C.size c) ≃ Fin 2 := (Fin.castOrderIso hc).toEquiv + rw [injectionPolynomial_reindex_rows _ e] + exact injectionPolynomial_fin_two_isRealStable hcard + (fun k j ↦ hA (C.rows ⟨c, e.symm k⟩) j) + +def IsSingletonPairClustering + {n : ℕ} (C : RowClustering n) : Prop := + ∀ c, C.size c = 1 ∨ C.size c = 2 + +theorem rowClusterProduct_isRealStable_of_singletonPairs + {n : ℕ} {A : Matrix (Fin n) (Fin n) ℝ} (C : RowClustering n) + (hcard : 2 ≤ n) (hA : ∀ i j, 0 < A i j) + (hclusters : IsSingletonPairClustering C) : + IsRealStable (rowClusterProduct A C) := by + letI : Nonempty (Fin n) := Fintype.card_pos_iff.mp (by + simpa using (lt_of_lt_of_le (by norm_num : 0 < 2) hcard)) + apply rowClusterProduct_isRealStable_of_factors + intro c + rcases hclusters c with hc | hc + · exact rowClusterPolynomial_isRealStable_of_size_one C hA c hc + · exact rowClusterPolynomial_isRealStable_of_size_two C hcard hA c hc + +theorem singletonPairCluster_stableCoefficient_lower + {n : ℕ} + (stableCoefficient : AnariOveisGharanStableCoefficient.{0}) + {A : Matrix (Fin n) (Fin n) ℝ} (C : RowClustering n) + (hcard : 2 ≤ n) (hA : ∀ i j, 0 < A i j) + (hclusters : IsSingletonPairClustering C) + (α : C.Cluster × Fin n → ℝ) + (hα : ∀ v, 0 ≤ α v ∧ α v ≤ 1) + (hαsum : (∑ v, α v) = n) : + stableBoundaryFactor α * + polynomialCapacity α (rowClusterProduct A C) * + polynomialCapacity α (columnSelector C.Cluster (Fin n)) ≤ + Matrix.permanent A := by + letI : Nonempty (Fin n) := Fintype.card_pos_iff.mp (by + simpa using (lt_of_lt_of_le (by norm_num : 0 < 2) hcard)) + letI : Nonempty C.Cluster := + ⟨(C.rows.symm (Classical.choice inferInstance)).1⟩ + apply rowClusterProduct_stableCoefficient_lower stableCoefficient C + · intro i j + exact le_of_lt (hA i j) + · exact fun c ↦ by + rcases hclusters c with hc | hc + · exact rowClusterPolynomial_isRealStable_of_size_one C hA c hc + · exact rowClusterPolynomial_isRealStable_of_size_two C hcard hA c hc + · exact hα + · exact hαsum + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/ClusterProduct.lean b/LeanPool/BeyondBethe/BeyondBethe/ClusterProduct.lean new file mode 100644 index 0000000000..91a61489aa --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/ClusterProduct.lean @@ -0,0 +1,527 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.PairedCertificate + +/-! # Cluster Product -/ + +open scoped BigOperators + +namespace BeyondBethe + +open MvPolynomial + +theorem prod_monomial + {σ ι : Type*} [DecidableEq ι] + (s : Finset ι) (e : ι → σ →₀ ℕ) (w : ι → ℝ) : + ∏ i ∈ s, monomial (e i) (w i) = + monomial (∑ i ∈ s, e i) (∏ i ∈ s, w i) := by + induction s using Finset.induction_on with + | empty => simp + | @insert a s ha ih => + simp [ha, ih, monomial_mul] + +/-- An independent injection of the rows of each cluster into the columns. +Choices belonging to different clusters are not required to have disjoint +images; the column selector enforces that condition later. -/ +abbrev ClusterChoice {n : ℕ} (C : RowClustering n) := + (c : C.Cluster) → Fin (C.size c) ↪ Fin n + +/-- Aggregate map from all row slots to columns. -/ +def clusterChoiceMap + {n : ℕ} (C : RowClustering n) (f : ClusterChoice C) : + (Σ c, Fin (C.size c)) → Fin n := + fun s ↦ f s.1 s.2 + +/-- A cluster choice compatible with the column selector uses every column +exactly once. -/ +def IsGlobalClusterChoice + {n : ℕ} (C : RowClustering n) (f : ClusterChoice C) : Prop := + Function.Bijective (clusterChoiceMap C f) + +abbrev GlobalClusterChoice {n : ℕ} (C : RowClustering n) := + {f : ClusterChoice C // IsGlobalClusterChoice C f} + +/-- A permutation (columns to rows) induces the column choice of every row +slot by applying the inverse permutation to its row. -/ +noncomputable def permutationClusterChoice + {n : ℕ} (C : RowClustering n) (σ : Equiv.Perm (Fin n)) : + ClusterChoice C := + fun c ↦ + { toFun := fun k ↦ σ.symm (C.rows ⟨c, k⟩) + inj' := by + intro k k' h + have hs : (⟨c, k⟩ : Σ c, Fin (C.size c)) = ⟨c, k'⟩ := + C.rows.injective (σ.symm.injective h) + simpa using hs } + +@[simp] +theorem permutationClusterChoice_apply + {n : ℕ} (C : RowClustering n) (σ : Equiv.Perm (Fin n)) + (c : C.Cluster) (k : Fin (C.size c)) : + permutationClusterChoice C σ c k = σ.symm (C.rows ⟨c, k⟩) := rfl + +theorem permutationClusterChoice_global + {n : ℕ} (C : RowClustering n) (σ : Equiv.Perm (Fin n)) : + IsGlobalClusterChoice C (permutationClusterChoice C σ) := by + change Function.Bijective (fun s ↦ σ.symm (C.rows s)) + exact σ.symm.bijective.comp C.rows.bijective + +/-- Global cluster choices are exactly permutations. -/ +noncomputable def permutationGlobalClusterChoiceEquiv + {n : ℕ} (C : RowClustering n) : + Equiv.Perm (Fin n) ≃ GlobalClusterChoice C where + toFun σ := ⟨permutationClusterChoice C σ, + permutationClusterChoice_global C σ⟩ + invFun f := + (Equiv.ofBijective (clusterChoiceMap C f.1) f.2).symm.trans C.rows + left_inv σ := by + apply Equiv.ext + intro j + let e := Equiv.ofBijective + (clusterChoiceMap C (permutationClusterChoice C σ)) + (permutationClusterChoice_global C σ) + change C.rows (e.symm j) = σ j + apply σ.symm.injective + rw [σ.symm_apply_apply] + have he := e.apply_symm_apply j + change clusterChoiceMap C (permutationClusterChoice C σ) (e.symm j) = j at he + exact he + right_inv f := by + apply Subtype.ext + funext c + apply Function.Embedding.ext + intro k + simp [clusterChoiceMap, permutationClusterChoice] + +noncomputable instance globalClusterChoiceFintype + {n : ℕ} (C : RowClustering n) : Fintype (GlobalClusterChoice C) := + Fintype.ofEquiv (Equiv.Perm (Fin n)) + (permutationGlobalClusterChoiceEquiv C) + +/-- Exponent vector contributed by a family of independent cluster choices. -/ +noncomputable def clusterChoiceExponent + {n : ℕ} (C : RowClustering n) (f : ClusterChoice C) : + C.Cluster × Fin n →₀ ℕ := + ∑ c, ∑ k, Finsupp.single (c, f c k) 1 + +@[simp] +theorem clusterChoiceExponent_apply + {n : ℕ} (C : RowClustering n) (f : ClusterChoice C) + (c : C.Cluster) (j : Fin n) : + clusterChoiceExponent C f (c, j) = + ((Finset.univ : Finset (Fin (C.size c))).filter + (fun k ↦ f c k = j)).card := by + classical + simp [clusterChoiceExponent, Finsupp.single_apply] + rw [Finset.sum_eq_single c] + · congr 1 + ext k + simp + · intro b _ hbc + simp [hbc] + · simp + +/-- A cluster-choice monomial lies in the selector support exactly when the +aggregate choice is a bijection from row slots to columns. -/ +theorem exists_selectorExponent_eq_iff_global + {n : ℕ} (C : RowClustering n) (f : ClusterChoice C) : + (∃ h : Fin n → C.Cluster, + clusterChoiceExponent C f = selectorExponent h) ↔ + IsGlobalClusterChoice C f := by + classical + constructor + · rintro ⟨h, he⟩ + constructor + · rintro ⟨c, k⟩ ⟨d, l⟩ hsame + have hcpos : 0 < clusterChoiceExponent C f (c, f c k) := by + rw [clusterChoiceExponent_apply] + exact Finset.card_pos.mpr ⟨k, by simp⟩ + have hdpos : 0 < clusterChoiceExponent C f (d, f d l) := by + rw [clusterChoiceExponent_apply] + exact Finset.card_pos.mpr ⟨l, by simp⟩ + rw [he, selectorExponent_apply] at hcpos hdpos + have hc : c = h (f c k) := by + by_contra hne + simp [hne] at hcpos + have hd : d = h (f d l) := by + by_contra hne + simp [hne] at hdpos + have hcd : c = d := by + change f c k = f d l at hsame + rw [hc, hd, hsame] + subst d + have hkl : k = l := (f c).injective hsame + subst l + rfl + · intro j + have hone : clusterChoiceExponent C f (h j, j) = 1 := by + rw [he, selectorExponent_apply] + simp + rw [clusterChoiceExponent_apply] at hone + have hnonempty : + ((Finset.univ : Finset (Fin (C.size (h j)))).filter + (fun k ↦ f (h j) k = j)).Nonempty := by + rw [Finset.nonempty_iff_ne_empty] + intro hempty + rw [hempty] at hone + simp at hone + obtain ⟨k, hk⟩ := hnonempty + exact ⟨⟨h j, k⟩, (Finset.mem_filter.mp hk).2⟩ + · intro hglobal + let e := Equiv.ofBijective (clusterChoiceMap C f) hglobal + refine ⟨fun j ↦ (e.symm j).1, ?_⟩ + ext v + rcases v with ⟨c, j⟩ + rw [clusterChoiceExponent_apply, selectorExponent_apply] + by_cases hc : c = (e.symm j).1 + · subst c + have hs : + ((Finset.univ : Finset (Fin (C.size (e.symm j).1))).filter + (fun k ↦ f (e.symm j).1 k = j)) = + {(e.symm j).2} := by + ext k + simp only [Finset.mem_filter, Finset.mem_univ, true_and, + Finset.mem_singleton] + constructor + · intro hk + have hmaps : clusterChoiceMap C f ⟨(e.symm j).1, k⟩ = + clusterChoiceMap C f (e.symm j) := by + change f (e.symm j).1 k = clusterChoiceMap C f (e.symm j) + rw [hk] + exact (e.apply_symm_apply j).symm + have hslots : (⟨(e.symm j).1, k⟩ : Σ c, Fin (C.size c)) = e.symm j := + e.injective hmaps + have hslots' : + (⟨(e.symm j).1, k⟩ : Σ c, Fin (C.size c)) = + ⟨(e.symm j).1, (e.symm j).2⟩ := + hslots.trans (Sigma.eta (e.symm j)).symm + exact eq_of_heq (Sigma.mk.inj_iff.mp hslots').2 + · intro hk + subst k + have he := e.apply_symm_apply j + change f (e.symm j).1 (e.symm j).2 = j at he + exact he + rw [hs] + simp + · have hs : + ((Finset.univ : Finset (Fin (C.size c))).filter + (fun k ↦ f c k = j)) = ∅ := by + ext k + simp only [Finset.mem_filter, Finset.mem_univ, true_and] + constructor + · intro hk + have hmaps : clusterChoiceMap C f ⟨c, k⟩ = + clusterChoiceMap C f (e.symm j) := by + change f c k = clusterChoiceMap C f (e.symm j) + rw [hk] + exact (e.apply_symm_apply j).symm + have hslots : (⟨c, k⟩ : Σ c, Fin (C.size c)) = e.symm j := + e.injective hmaps + exact (hc (congrArg Sigma.fst hslots)).elim + · simp + rw [hs] + simp [hc] + +theorem sum_selector_matches_choice_of_global + {n : ℕ} (C : RowClustering n) (f : ClusterChoice C) (w : ℝ) + (hg : IsGlobalClusterChoice C f) : + (∑ h : Fin n → C.Cluster, + if clusterChoiceExponent C f = selectorExponent h then w else 0) = w := by + classical + obtain ⟨h, he⟩ := (exists_selectorExponent_eq_iff_global C f).mpr hg + rw [Finset.sum_eq_single h] + · simp [he] + · intro h' _ hh' + have hne : clusterChoiceExponent C f ≠ selectorExponent h' := by + intro he' + apply hh' + exact (selectorExponent_injective (he.symm.trans he')).symm + simp [hne] + · simp + +theorem sum_selector_matches_choice_of_not_global + {n : ℕ} (C : RowClustering n) (f : ClusterChoice C) (w : ℝ) + (hg : ¬IsGlobalClusterChoice C f) : + (∑ h : Fin n → C.Cluster, + if clusterChoiceExponent C f = selectorExponent h then w else 0) = 0 := by + classical + apply Finset.sum_eq_zero + intro h _ + have hne : clusterChoiceExponent C f ≠ selectorExponent h := by + intro he + exact hg ((exists_selectorExponent_eq_iff_global C f).mp ⟨h, he⟩) + simp [hne] + +/-- Matrix weight contributed by a family of independent cluster choices. -/ +noncomputable def clusterChoiceWeight + {n : ℕ} (A : Matrix (Fin n) (Fin n) ℝ) (C : RowClustering n) + (f : ClusterChoice C) : ℝ := + ∏ c, ∏ k, A (C.rows ⟨c, k⟩) (f c k) + +theorem sum_clusterSizes_eq + {n : ℕ} (C : RowClustering n) : + (∑ c, C.size c) = n := by + calc + (∑ c, C.size c) = ∑ c, Fintype.card (Fin (C.size c)) := by simp + _ = Fintype.card (Σ c, Fin (C.size c)) := Fintype.card_sigma.symm + _ = Fintype.card (Fin n) := Fintype.card_congr C.rows + _ = n := Fintype.card_fin n + +theorem clusterChoiceExponent_degree + {n : ℕ} (C : RowClustering n) (f : ClusterChoice C) : + Finsupp.degree (clusterChoiceExponent C f) = n := by + rw [clusterChoiceExponent, map_sum] + simp [map_sum, Finsupp.degree_single, sum_clusterSizes_eq C] + +theorem clusterChoiceExponent_le_one + {n : ℕ} (C : RowClustering n) (f : ClusterChoice C) + (v : C.Cluster × Fin n) : + clusterChoiceExponent C f v ≤ 1 := by + rcases v with ⟨c, j⟩ + rw [clusterChoiceExponent_apply] + apply Finset.card_le_one.mpr + intro k hk l hl + exact (f c).injective ((Finset.mem_filter.mp hk).2.trans + (Finset.mem_filter.mp hl).2.symm) + +theorem clusterChoiceWeight_permutation + {n : ℕ} (A : Matrix (Fin n) (Fin n) ℝ) (C : RowClustering n) + (σ : Equiv.Perm (Fin n)) : + clusterChoiceWeight A C (permutationClusterChoice C σ) = + ∏ j, A (σ j) j := by + rw [clusterChoiceWeight] + calc + (∏ c, ∏ k, A (C.rows ⟨c, k⟩) + (permutationClusterChoice C σ c k)) = + ∏ s : Σ c, Fin (C.size c), + A (C.rows s) (σ.symm (C.rows s)) := by + rw [Fintype.prod_sigma] + rfl + _ = ∏ i, A i (σ.symm i) := + Equiv.prod_comp C.rows (fun i ↦ A i (σ.symm i)) + _ = ∏ j, A (σ j) j := by + symm + simpa using Equiv.prod_comp σ (fun i ↦ A i (σ.symm i)) + +theorem sum_globalClusterChoiceWeight_eq_permanent + {n : ℕ} (A : Matrix (Fin n) (Fin n) ℝ) (C : RowClustering n) : + (∑ f : GlobalClusterChoice C, clusterChoiceWeight A C f.1) = + Matrix.permanent A := by + rw [Matrix.permanent] + symm + calc + (∑ σ : Equiv.Perm (Fin n), ∏ j, A (σ j) j) = + ∑ σ : Equiv.Perm (Fin n), + clusterChoiceWeight A C + (permutationGlobalClusterChoiceEquiv C σ).1 := by + apply Finset.sum_congr rfl + intro σ _ + exact (clusterChoiceWeight_permutation A C σ).symm + _ = ∑ f : GlobalClusterChoice C, clusterChoiceWeight A C f.1 := + Equiv.sum_comp (permutationGlobalClusterChoiceEquiv C) + (fun f ↦ clusterChoiceWeight A C f.1) + +/-- The polynomial for one row cluster. Its monomials inject the rows in the +cluster into distinct columns. For clusters of sizes one and two these are, +respectively, the singleton linear form and the pair polynomial of the paper. -/ +noncomputable def rowClusterPolynomial + {n : ℕ} (A : Matrix (Fin n) (Fin n) ℝ) (C : RowClustering n) + (c : C.Cluster) : MvPolynomial (C.Cluster × Fin n) ℝ := + ∑ f : Fin (C.size c) ↪ Fin n, + monomial (∑ k, Finsupp.single (c, f k) 1) + (∏ k, A (C.rows ⟨c, k⟩) (f k)) + +/-- The same injection polynomial before placing its variables in a named +cluster. -/ +noncomputable def injectionPolynomial + {m n : ℕ} (B : Fin m → Fin n → ℝ) : MvPolynomial (Fin n) ℝ := + ∑ f : Fin m ↪ Fin n, + monomial (∑ k, Finsupp.single (f k) 1) + (∏ k, B k (f k)) + +theorem injectionPolynomial_nonnegativeCoefficients + {m n : ℕ} {B : Fin m → Fin n → ℝ} + (hB : ∀ k j, 0 ≤ B k j) : + HasNonnegativeCoefficients (injectionPolynomial B) := by + intro d + rw [injectionPolynomial, coeff_sum] + apply Finset.sum_nonneg + intro f _ + rw [coeff_monomial] + split + · exact Finset.prod_nonneg fun k _ ↦ hB k (f k) + · exact le_rfl + +theorem rowClusterPolynomial_eq_rename_injectionPolynomial + {n : ℕ} (A : Matrix (Fin n) (Fin n) ℝ) (C : RowClustering n) + (c : C.Cluster) : + rowClusterPolynomial A C c = + MvPolynomial.rename (fun j : Fin n ↦ (c, j)) + (injectionPolynomial (fun k j ↦ A (C.rows ⟨c, k⟩) j)) := by + rw [rowClusterPolynomial, injectionPolynomial, map_sum] + apply Finset.sum_congr rfl + intro f _ + rw [rename_monomial] + have hexp : + Finsupp.mapDomain (fun j : Fin n ↦ (c, j)) + (∑ k, Finsupp.single (f k) 1) = + ∑ k, Finsupp.single (c, f k) 1 := by + simpa only [Finsupp.mapDomain_single, + Finsupp.mapDomain.addMonoidHom_apply] using + map_sum (Finsupp.mapDomain.addMonoidHom + (fun j : Fin n ↦ (c, j))) + (fun k ↦ Finsupp.single (f k) 1) Finset.univ + rw [hexp] + +/-- The full cluster product `p` in paper equation (10). -/ +noncomputable def rowClusterProduct + {n : ℕ} (A : Matrix (Fin n) (Fin n) ℝ) (C : RowClustering n) : + MvPolynomial (C.Cluster × Fin n) ℝ := + ∏ c, rowClusterPolynomial A C c + +/-- Expanding the product makes the independent choice made by every cluster +explicit. Collisions between different clusters remain present here. -/ +theorem rowClusterProduct_eq_sum_choices + {n : ℕ} (A : Matrix (Fin n) (Fin n) ℝ) (C : RowClustering n) : + rowClusterProduct A C = + ∑ f : ClusterChoice C, + monomial (clusterChoiceExponent C f) (clusterChoiceWeight A C f) := by + simp only [rowClusterProduct, rowClusterPolynomial] + rw [Fintype.prod_sum] + apply Finset.sum_congr rfl + intro f _ + rw [clusterChoiceExponent, clusterChoiceWeight] + simpa using prod_monomial (Finset.univ : Finset C.Cluster) + (fun c ↦ ∑ k, Finsupp.single (c, f c k) 1) + (fun c ↦ ∏ k, A (C.rows ⟨c, k⟩) (f c k)) + +theorem rowClusterPolynomial_isHomogeneous + {n : ℕ} (A : Matrix (Fin n) (Fin n) ℝ) (C : RowClustering n) + (c : C.Cluster) : + (rowClusterPolynomial A C c).IsHomogeneous (C.size c) := by + rw [rowClusterPolynomial] + apply MvPolynomial.IsHomogeneous.sum + intro f _ + apply isHomogeneous_monomial + rw [map_sum] + simp [Finsupp.degree_single] + +theorem rowClusterProduct_isHomogeneous + {n : ℕ} (A : Matrix (Fin n) (Fin n) ℝ) (C : RowClustering n) : + (rowClusterProduct A C).IsHomogeneous n := by + rw [rowClusterProduct] + have h := MvPolynomial.IsHomogeneous.prod Finset.univ + (rowClusterPolynomial A C) C.size + (fun c _ ↦ rowClusterPolynomial_isHomogeneous A C c) + simpa only [sum_clusterSizes_eq C] using h + +theorem rowClusterProduct_nonnegativeCoefficients + {n : ℕ} {A : Matrix (Fin n) (Fin n) ℝ} (C : RowClustering n) + (hA : Matrix.Nonnegative A) : + HasNonnegativeCoefficients (rowClusterProduct A C) := by + intro d + rw [rowClusterProduct_eq_sum_choices, coeff_sum] + apply Finset.sum_nonneg + intro f _ + rw [coeff_monomial] + split + · exact Finset.prod_nonneg fun c _ ↦ + Finset.prod_nonneg fun k _ ↦ hA (C.rows ⟨c, k⟩) (f c k) + · exact le_rfl + +theorem rowClusterProduct_isMultiaffine + {n : ℕ} (A : Matrix (Fin n) (Fin n) ℝ) (C : RowClustering n) : + IsMultiaffine (rowClusterProduct A C) := by + intro v + rw [rowClusterProduct_eq_sum_choices] + refine (degreeOf_sum_le v _ _).trans (Finset.sup_le ?_) + intro f _ + by_cases hw : clusterChoiceWeight A C f = 0 + · simp [hw] + · rw [degreeOf_monomial_eq _ _ hw] + exact clusterChoiceExponent_le_one C f v + +theorem rowClusterProduct_isRealStable_of_factors + {n : ℕ} (A : Matrix (Fin n) (Fin n) ℝ) (C : RowClustering n) + (hstable : ∀ c, IsRealStable (rowClusterPolynomial A C c)) : + IsRealStable (rowClusterProduct A C) := by + intro z hz + rw [rowClusterProduct, MvPolynomial.eval₂_prod] + apply Finset.prod_ne_zero_iff.mpr + intro c _ + exact hstable c z hz + +/- Paper equation (12), now for the actual product of cluster factors rather +than for its selector-compatible truncation. Independent cluster choices +that collide at a column disappear from the coefficient pairing; the +remaining choices are exactly permutations. -/ +theorem coefficientInnerProduct_rowClusterProduct_eq_permanent + {n : ℕ} (A : Matrix (Fin n) (Fin n) ℝ) (C : RowClustering n) : + coefficientInnerProduct (rowClusterProduct A C) + (columnSelector C.Cluster (Fin n)) = Matrix.permanent A := by + classical + rw [coefficientInnerProduct_columnSelector, + rowClusterProduct_eq_sum_choices] + simp_rw [coeff_sum, coeff_monomial] + rw [Finset.sum_comm] + calc + (∑ f : ClusterChoice C, ∑ h : Fin n → C.Cluster, + if clusterChoiceExponent C f = selectorExponent h then + clusterChoiceWeight A C f else 0) = + ∑ f ∈ (Finset.univ : Finset (ClusterChoice C)).filter + (IsGlobalClusterChoice C), clusterChoiceWeight A C f := by + rw [Finset.sum_filter] + apply Finset.sum_congr rfl + intro f _ + by_cases hg : IsGlobalClusterChoice C f + · rw [if_pos hg, + sum_selector_matches_choice_of_global C f _ hg] + · rw [if_neg hg, + sum_selector_matches_choice_of_not_global C f _ hg] + _ = ∑ f : GlobalClusterChoice C, clusterChoiceWeight A C f.1 := by + apply Finset.sum_subtype + intro f + simp + _ = Matrix.permanent A := sum_globalClusterChoiceWeight_eq_permanent A C + +/-- The stable-coefficient theorem applied to the actual cluster product and +column selector. All polynomial hypotheses and the permanent coefficient +identity are discharged internally. The coefficient inequality remains an +explicit argument here to keep this intermediate theorem modular; the final +theorem supplies its internal reconstruction from `SourceStableReindex`. -/ +theorem rowClusterProduct_stableCoefficient_lower + {n : ℕ} [Nonempty (Fin n)] + (stableCoefficient : AnariOveisGharanStableCoefficient.{0}) + {A : Matrix (Fin n) (Fin n) ℝ} (C : RowClustering n) + [Nonempty C.Cluster] + (hA : Matrix.Nonnegative A) + (hfactorStable : ∀ c, IsRealStable (rowClusterPolynomial A C c)) + (α : C.Cluster × Fin n → ℝ) + (hα : ∀ v, 0 ≤ α v ∧ α v ≤ 1) + (hαsum : (∑ v, α v) = n) : + stableBoundaryFactor α * + polynomialCapacity α (rowClusterProduct A C) * + polynomialCapacity α (columnSelector C.Cluster (Fin n)) ≤ + Matrix.permanent A := by + have hselectorHomogeneous : + (columnSelector C.Cluster (Fin n)).IsHomogeneous n := by + simpa only [Fintype.card_fin] using + columnSelector_isHomogeneous C.Cluster (Fin n) + have hpair := stableCoefficient (σ := C.Cluster × Fin n) + (rowClusterProduct A C) (columnSelector C.Cluster (Fin n)) n α + (rowClusterProduct_nonnegativeCoefficients C hA) + (columnSelector_nonnegativeCoefficients C.Cluster (Fin n)) + (rowClusterProduct_isMultiaffine A C) + (columnSelector_isMultiaffine C.Cluster (Fin n)) + (rowClusterProduct_isRealStable_of_factors A C hfactorStable) + (columnSelector_isRealStable C.Cluster (Fin n)) + (rowClusterProduct_isHomogeneous A C) + hselectorHomogeneous + hα hαsum + rwa [coefficientInnerProduct_rowClusterProduct_eq_permanent] at hpair + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/Completion.lean b/LeanPool/BeyondBethe/BeyondBethe/Completion.lean new file mode 100644 index 0000000000..6a1f858a94 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/Completion.lean @@ -0,0 +1,339 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.Permanent +import LeanPool.BeyondBethe.BeyondBethe.Slack +import Mathlib.Analysis.SpecialFunctions.ExpDeriv +import Mathlib.Analysis.SpecialFunctions.Pow.Real + +/-! # Completion -/ + +namespace BeyondBethe + +/-- The improvement in the positive-matrix dichotomy (paper (46)). -/ +noncomputable def epsilonPlus (δ ξ γ : ℝ) : ℝ := + min (δ - ξ) (3 * γ / 8 - ξ) + +theorem epsilonPlus_pos {δ ξ γ : ℝ} + (hδ : ξ < δ) (hγ : ξ < 3 * γ / 8) : + 0 < epsilonPlus δ ξ γ := by + rw [epsilonPlus, lt_min_iff] + exact ⟨sub_pos.mpr hδ, sub_pos.mpr hγ⟩ + +/-- The two cases in Proposition 20 combine to the exponent in (45). -/ +theorem positiveDichotomy_exponent + {n : ℕ} {r δ ξ γ : ℝ} + (h : r ≤ (Real.log 2 / 2 - δ + ξ) * n ∨ + r ≤ (Real.log 2 / 2 + ξ - 3 * γ / 8) * n) : + r ≤ (Real.log 2 / 2 - epsilonPlus δ ξ γ) * n := by + rcases h with hfar | hnear + · refine hfar.trans (mul_le_mul_of_nonneg_right ?_ (Nat.cast_nonneg n)) + rw [epsilonPlus] + have hmin : min (δ - ξ) (3 * γ / 8 - ξ) ≤ δ - ξ := min_le_left _ _ + linarith + · refine hnear.trans (mul_le_mul_of_nonneg_right ?_ (Nat.cast_nonneg n)) + rw [epsilonPlus] + have hmin : min (δ - ξ) (3 * γ / 8 - ξ) ≤ 3 * γ / 8 - ξ := min_le_right _ _ + linarith + +/-- Paper (65): in the far case, Bethe slack pays for the logarithmic gap; +the paired gain can only help. -/ +theorem farCase_logGap + {n : ℕ} {logPermanent logBethe objective gain δ ξ : ℝ} + (hslack : δ * n ≤ betheSlack n logBethe logPermanent) + (hobjective : logBethe - ξ * n ≤ objective) + (hgain : 0 ≤ gain) : + logPermanent - (objective + gain) ≤ + (Real.log 2 / 2 - δ + ξ) * n := by + rw [betheSlack] at hslack + nlinarith + +/-- Paper (69): in the near case, the matching gain subtracts directly from +the upper half of the Bethe sandwich. -/ +theorem nearCase_logGap + {n : ℕ} {logPermanent logBethe objective gain γ ξ : ℝ} + (hupper : logPermanent ≤ logBethe + n * (Real.log 2 / 2)) + (hobjective : logBethe - ξ * n ≤ objective) + (hgain : 3 * γ / 8 * n ≤ gain) : + logPermanent - (objective + gain) ≤ + (Real.log 2 / 2 + ξ - 3 * γ / 8) * n := by + nlinarith + +/-- The proof's far/near split with the structural part of the near case +isolated in one explicit implication. -/ +theorem completionCaseDisjunction + {n : ℕ} + {logPermanent logBethe objective gain δ ξ γ : ℝ} + (hobjective : logBethe - ξ * n ≤ objective) + (hgainNonneg : 0 ≤ gain) + (hupper : logPermanent ≤ logBethe + n * (Real.log 2 / 2)) + (hnearGain : betheSlack n logBethe logPermanent < δ * n → + 3 * γ / 8 * n ≤ gain) : + logPermanent - (objective + gain) ≤ + (Real.log 2 / 2 - δ + ξ) * n ∨ + logPermanent - (objective + gain) ≤ + (Real.log 2 / 2 + ξ - 3 * γ / 8) * n := by + by_cases hfar : δ * n ≤ betheSlack n logBethe logPermanent + · exact Or.inl (farCase_logGap hfar hobjective hgainNonneg) + · exact Or.inr (nearCase_logGap hupper hobjective + (hnearGain (lt_of_not_ge hfar))) + +/-- Quantitative count used in the near case: the row and long-component +losses leave at least `59 n / 128` clean pairs. -/ +theorem cleanPair_count_ge_fiftyNine + {n bad long clean : ℝ} + (hbad : bad ≤ n / 128) (hlong : long ≤ n / 16) + (hclean : n - 2 * bad - long ≤ 2 * clean) : + 59 * n / 128 ≤ clean := by + linarith + +/-- After discarding at most `n/16` expensive pairs, the remaining disjoint +clean pairs number at least `3n/8`. -/ +theorem successfulCleanPair_count_ge_threeEighths + {n clean failed successful : ℝ} + (hn : 0 ≤ n) (hclean : 59 * n / 128 ≤ clean) + (hfailed : failed ≤ n / 16) + (hsuccess : clean - failed ≤ successful) : + 3 * n / 8 ≤ successful := by + linarith + +/-- Multiplying the successful-pair count by the uniform gain gives paper +(68). -/ +theorem matchingGain_ge_threeEighths + {n successful γ matchingGain : ℝ} + (hγ : 0 ≤ γ) (hsuccess : 3 * n / 8 ≤ successful) + (hmatching : successful * γ ≤ matchingGain) : + 3 * γ / 8 * n ≤ matchingGain := by + nlinarith + +/-- Rearrangement of the robust cycle-information inequality used in (66). +The displayed definition of `cycleError` is kept as a hypothesis so this +lemma remains the exact scalar accounting step. -/ +theorem longRow_count_le_cycleError + {n D N bad δ rowError ω cycleError : ℝ} + (hn : 0 ≤ n) + (hlogD : D ≤ δ * n) + (hbad : bad ≤ rowError * n) + (hrobust : Real.log 2 / 6 * N - + (1 + Real.log 2 / 2) * bad - n * ω ≤ D) + (hcycle : cycleError = 6 / Real.log 2 * + (δ + (1 + Real.log 2 / 2) * rowError + ω)) : + N ≤ cycleError * n := by + have hlog : 0 < Real.log 2 := Real.log_pos (by norm_num) + have hscale : Real.log 2 / 6 * cycleError = + δ + (1 + Real.log 2 / 2) * rowError + ω := by + rw [hcycle] + field_simp [hlog.ne'] + have hscaled : Real.log 2 / 6 * N ≤ + Real.log 2 / 6 * (cycleError * n) := by + nlinarith [mul_le_mul_of_nonneg_left hbad + (show 0 ≤ 1 + Real.log 2 / 2 by positivity)] + exact le_of_mul_le_mul_left hscaled + (div_pos hlog (by norm_num : (0 : ℝ) < 6)) + +/-- The Markov step for expensive clean pairs after (67), abstracted from +the graph indexing: cancel their common positive minimum cost. -/ +theorem failedPair_count_le_transferError + {failed transferError n minCost totalCost : ℝ} + (hmin : 0 < minCost) + (hfailed : failed * minCost ≤ totalCost) + (htotal : totalCost ≤ transferError * n * minCost) : + failed ≤ transferError * n := by + exact le_of_mul_le_mul_right (hfailed.trans htotal) hmin + +/-- Exponentiating the logarithmic bound uses exactly the base appearing in +paper Proposition 20. -/ +theorem exp_logTwoHalf_sub (ε : ℝ) : + Real.exp (Real.log 2 / 2 - ε) = + Real.sqrt 2 * Real.exp (-ε) := by + rw [sub_eq_add_neg, Real.exp_add] + congr 1 + rw [← Real.exp_log (Real.sqrt_pos.2 (by norm_num : (0 : ℝ) < 2))] + congr 1 + rw [Real.log_sqrt (by norm_num : (0 : ℝ) ≤ 2)] + +theorem logGap_implies_positive_approximation + {n : ℕ} {L per ε : ℝ} + (hL : 0 < L) (hper : 0 < per) + (hlog : Real.log per - Real.log L ≤ + (Real.log 2 / 2 - ε) * n) : + per ≤ (Real.sqrt 2 * Real.exp (-ε)) ^ n * L := by + have hexp := Real.exp_le_exp.mpr hlog + have hleft : Real.exp (Real.log per - Real.log L) = per / L := by + rw [Real.exp_sub, Real.exp_log hper, Real.exp_log hL] + have hright : Real.exp ((Real.log 2 / 2 - ε) * n) = + (Real.sqrt 2 * Real.exp (-ε)) ^ n := by + rw [Real.exp_mul, Real.rpow_natCast, exp_logTwoHalf_sub] + rw [hleft, hright] at hexp + exact (div_le_iff₀ hL).mp hexp + +/-- Exact scalar assembly of paper Proposition 20. The disjunction consists +of the far-slack and near-tight estimates proved in the two structural cases. -/ +theorem positiveDichotomy_approximation + {n : ℕ} {L per δ ξ γ : ℝ} + (hL : 0 < L) (hper : 0 < per) + (hcases : + Real.log per - Real.log L ≤ + (Real.log 2 / 2 - δ + ξ) * n ∨ + Real.log per - Real.log L ≤ + (Real.log 2 / 2 + ξ - 3 * γ / 8) * n) : + per ≤ + (Real.sqrt 2 * Real.exp (-epsilonPlus δ ξ γ)) ^ n * L := by + apply logGap_implies_positive_approximation hL hper + exact positiveDichotomy_exponent hcases + +/-- Two-sided form of the positive-matrix conclusion, conditional on the +paired certificate lower bound and the two case estimates. -/ +theorem positiveDichotomy_twoSided + {n : ℕ} {L per δ ξ γ : ℝ} + (hL : 0 < L) (hper : 0 < per) (hlower : L ≤ per) + (hcases : + Real.log per - Real.log L ≤ + (Real.log 2 / 2 - δ + ξ) * n ∨ + Real.log per - Real.log L ≤ + (Real.log 2 / 2 + ξ - 3 * γ / 8) * n) : + L ≤ per ∧ + per ≤ (Real.sqrt 2 * Real.exp (-epsilonPlus δ ξ γ)) ^ n * L := + ⟨hlower, positiveDichotomy_approximation hL hper hcases⟩ + +/-- Positive-matrix proposition with its remaining structural obligation +shown explicitly as `hnearGain`. This is the exact boundary between the +already checked analytic assembly and the good-row/cycle/transfer counting +argument. -/ +theorem positiveMatrix_twoSided_of_nearGain + {n : ℕ} {L per logBethe objective gain δ ξ γ : ℝ} + (hL : 0 < L) (hper : 0 < per) (hlower : L ≤ per) + (hlogL : Real.log L = objective + gain) + (hobjective : logBethe - ξ * n ≤ objective) + (hgainNonneg : 0 ≤ gain) + (hupper : Real.log per ≤ logBethe + n * (Real.log 2 / 2)) + (hnearGain : betheSlack n logBethe (Real.log per) < δ * n → + 3 * γ / 8 * n ≤ gain) : + L ≤ per ∧ + per ≤ (Real.sqrt 2 * Real.exp (-epsilonPlus δ ξ γ)) ^ n * L := by + apply positiveDichotomy_twoSided hL hper hlower + rw [hlogL] + exact completionCaseDisjunction hobjective hgainNonneg hupper hnearGain + +/-- The numerical and smoothing losses in the appendix consume at most half +of the positive-matrix logarithmic improvement. -/ +theorem numerical_smoothing_loss + {ε numericalLoss smoothingLoss : ℝ} + (hnum : numericalLoss ≤ ε / 4) + (hsmooth : smoothingLoss ≤ ε / 4) : + -ε + numericalLoss + smoothingLoss ≤ -ε / 2 := by + linarith + +/-- The purely numerical conclusion of Theorem 1, separated from its +bit-complexity assertion. -/ +def ApproximationGuarantee + (alg : ∀ n, Matrix (Fin n) (Fin n) ℚ → ℚ) (c : ℝ) : Prop := + 0 < c ∧ c < Real.sqrt 2 ∧ + ∀ n (A : Matrix (Fin n) (Fin n) ℚ), + Matrix.Nonnegative A → + ((alg n A : ℚ) : ℝ) ≤ ((Matrix.permanent A : ℚ) : ℝ) ∧ + ((Matrix.permanent A : ℚ) : ℝ) ≤ c ^ n * ((alg n A : ℚ) : ℝ) + +/-- The last scalar step in the paper: any positive logarithmic improvement +produces a base strictly below `sqrt 2`. -/ +theorem improvedBase_lt_sqrtTwo {ε : ℝ} (hε : 0 < ε) : + Real.sqrt 2 * Real.exp (-ε) < Real.sqrt 2 := by + have hsqrt : 0 < Real.sqrt 2 := Real.sqrt_pos.2 (by norm_num) + have hexp : Real.exp (-ε) < 1 := by + simpa only [Real.exp_zero] using Real.exp_lt_exp.mpr (neg_neg_of_pos hε) + nlinarith [mul_lt_mul_of_pos_left hexp hsqrt] + +/-- The final base (paper (59)). -/ +noncomputable def finalBase (ε : ℝ) : ℝ := + Real.sqrt 2 * Real.exp (-ε / 2) + +theorem finalBase_lt_sqrtTwo {ε : ℝ} (hε : 0 < ε) : + finalBase ε < Real.sqrt 2 := by + rw [finalBase] + have hhalf : 0 < ε / 2 := by linarith + simpa only [neg_div] using improvedBase_lt_sqrtTwo hhalf + +theorem finalBase_pos (ε : ℝ) : 0 < finalBase ε := by + exact mul_pos (Real.sqrt_pos.2 (by norm_num)) (Real.exp_pos _) + +/-- The base available before paying for smoothing and directed numerical +rounding. The certified computation is allowed to spend one quarter of the +positive-matrix improvement. -/ +noncomputable def preSmoothingBase (ε : ℝ) : ℝ := + Real.sqrt 2 * Real.exp (-ε + ε / 4) + +theorem preSmoothingBase_pos (ε : ℝ) : 0 < preSmoothingBase ε := by + exact mul_pos (Real.sqrt_pos.2 (by norm_num)) (Real.exp_pos _) + +theorem preSmoothingBase_mul_exp_quarter (ε : ℝ) : + preSmoothingBase ε * Real.exp (ε / 4) = finalBase ε := by + rw [preSmoothingBase, finalBase] + rw [mul_assoc, ← Real.exp_add] + congr 1 + ring + +/-- The scalar completion of the smoothing argument. This theorem is the +exact non-algorithmic content of the last paragraph of the paper: a certified +positive-matrix lower bound that has spent at most one quarter of `ε` on +numerics can spend another quarter on smoothing and retain improvement +`ε / 2`. -/ +theorem assemble_smoothing_and_numerics + {n : ℕ} {per perSmooth lower χ ε : ℝ} + (_hε : 0 < ε) (hχ : 0 ≤ χ) (hχsmall : χ ≤ ε / 2) + (hlowerPos : 0 < lower) + (hsmoothLower : per ≤ perSmooth) + (hsmoothUpper : perSmooth ≤ (1 + χ * n / 2) * per) + (hcertLower : lower ≤ perSmooth) + (hcertUpper : perSmooth ≤ (preSmoothingBase ε) ^ n * lower) : + lower / (1 + χ * n / 2) ≤ per ∧ + per ≤ (finalBase ε) ^ n * (lower / (1 + χ * n / 2)) := by + have hn : 0 ≤ (n : ℝ) := Nat.cast_nonneg n + have hfactorPos : 0 < 1 + χ * n / 2 := by positivity + have hlower : lower / (1 + χ * n / 2) ≤ per := by + rw [div_le_iff₀ hfactorPos] + simpa [mul_comm] using hcertLower.trans hsmoothUpper + have hfactorExp : + 1 + χ * n / 2 ≤ Real.exp (ε / 4) ^ n := by + calc + 1 + χ * n / 2 ≤ Real.exp (χ * n / 2) := by + simpa [add_comm] using Real.add_one_le_exp (χ * n / 2) + _ ≤ Real.exp ((ε / 4) * n) := by + apply Real.exp_le_exp.mpr + have hmul := mul_le_mul_of_nonneg_right hχsmall + (show 0 ≤ (n : ℝ) / 2 by positivity) + nlinarith + _ = Real.exp (ε / 4) ^ n := by + rw [← Real.exp_nat_mul] + congr 1 + ring + have hbase : + (1 + χ * n / 2) * (preSmoothingBase ε) ^ n ≤ + (finalBase ε) ^ n := by + calc + (1 + χ * n / 2) * (preSmoothingBase ε) ^ n + ≤ Real.exp (ε / 4) ^ n * (preSmoothingBase ε) ^ n := + mul_le_mul_of_nonneg_right hfactorExp + (pow_nonneg (preSmoothingBase_pos ε).le n) + _ = (finalBase ε) ^ n := by + rw [← mul_pow, mul_comm, preSmoothingBase_mul_exp_quarter] + have hper : per ≤ (preSmoothingBase ε) ^ n * lower := + hsmoothLower.trans hcertUpper + have hupper : + per ≤ (finalBase ε) ^ n * (lower / (1 + χ * n / 2)) := by + rw [show (finalBase ε) ^ n * (lower / (1 + χ * n / 2)) = + ((finalBase ε) ^ n * lower) / (1 + χ * n / 2) by ring] + rw [le_div_iff₀ hfactorPos] + calc + per * (1 + χ * n / 2) + ≤ ((preSmoothingBase ε) ^ n * lower) * + (1 + χ * n / 2) := + mul_le_mul_of_nonneg_right hper hfactorPos.le + _ = ((1 + χ * n / 2) * (preSmoothingBase ε) ^ n) * lower := by ring + _ ≤ (finalBase ε) ^ n * lower := + mul_le_mul_of_nonneg_right hbase hlowerPos.le + exact ⟨hlower, hupper⟩ + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/CoreEncoding.lean b/LeanPool/BeyondBethe/BeyondBethe/CoreEncoding.lean new file mode 100644 index 0000000000..07d1f48410 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/CoreEncoding.lean @@ -0,0 +1,459 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.Entropy +import Mathlib.Combinatorics.Hall.Basic +import Mathlib.Data.Fin.Rev +import Mathlib.GroupTheory.Perm.Cycle.Factors +import Mathlib.Tactic + +/-! # Core Encoding -/ + +namespace BeyondBethe + +open Equiv + +variable {α : Type*} [Fintype α] [DecidableEq α] + +/-- Whether the assignment `σ` uses one of the two prescribed matching edges +at row `i`. -/ +def UsesCoreEdge (f g σ : Equiv.Perm α) (i : α) : Prop := + σ i = f i ∨ σ i = g i + +/-- The paper's core encoding for a two-regular bipartite multigraph written +as the union of two perfect matchings. `none` is the symbol `star`; an escaped +edge records its column exactly. -/ +noncomputable def twoMatchingEncoding (f g σ : Equiv.Perm α) : α → Option α := by + classical + exact fun i ↦ if UsesCoreEdge f g σ i then none else some (σ i) + +/-- The permutation of row vertices obtained by following an `f`-edge and +then returning along a `g`-edge. Its nontrivial cycles are precisely the +components containing at least two rows. -/ +def alternatingRowPerm (f g : Equiv.Perm α) : Equiv.Perm α := + f.trans g.symm + +@[simp] +theorem alternatingRowPerm_apply (f g : Equiv.Perm α) (i : α) : + alternatingRowPerm f g i = g.symm (f i) := rfl + +theorem same_twoMatchingEncoding_core_iff + {f g σ τ : Equiv.Perm α} + (henc : twoMatchingEncoding f g σ = twoMatchingEncoding f g τ) + (i : α) : + UsesCoreEdge f g σ i ↔ UsesCoreEdge f g τ i := by + classical + have hi := congrFun henc i + constructor + · intro hσ + by_contra hτ + simpa [twoMatchingEncoding, hσ, hτ] using hi + · intro hτ + by_contra hσ + simpa [twoMatchingEncoding, hσ, hτ] using hi + +theorem same_twoMatchingEncoding_of_escape + {f g σ τ : Equiv.Perm α} + (henc : twoMatchingEncoding f g σ = twoMatchingEncoding f g τ) + {i : α} (hσ : ¬ UsesCoreEdge f g σ i) : + σ i = τ i := by + classical + have hi := congrFun henc i + have hτ : ¬ UsesCoreEdge f g τ i := by + exact fun h ↦ hσ ((same_twoMatchingEncoding_core_iff henc i).2 h) + simpa [twoMatchingEncoding, hσ, hτ] using hi + +theorem alternatingRowPerm_fixed_iff + (f g : Equiv.Perm α) (i : α) : + alternatingRowPerm f g i = i ↔ f i = g i := by + constructor + · intro h + have hg := congrArg g h + simpa [alternatingRowPerm] using hg + · intro h + apply g.injective + simp [alternatingRowPerm, h] + +/-- One oriented disagreement propagates by one step around the alternating +cycle. This is the direct form of the paper's "paths have unique perfect +matchings" observation. -/ +theorem oriented_disagreement_step + {f g σ τ : Equiv.Perm α} + (henc : twoMatchingEncoding f g σ = twoMatchingEncoding f g τ) + {i : α} (hσi : σ i = f i) (hτi : τ i = g i) + (hfg : f i ≠ g i) : + σ (alternatingRowPerm f g i) = f (alternatingRowPerm f g i) ∧ + τ (alternatingRowPerm f g i) = g (alternatingRowPerm f g i) := by + let j := alternatingRowPerm f g i + have hgj : g j = f i := by + simp [j, alternatingRowPerm] + have hji : j ≠ i := by + intro h + apply hfg + rw [← hgj, h] + let k := τ.symm (f i) + have hτk : τ k = f i := by simp [k] + have hki : k ≠ i := by + intro h + apply hfg + rw [← hτk, h, hτi] + have hσk_ne : σ k ≠ f i := by + intro h + exact hki (σ.injective (h.trans hσi.symm)) + have hτcore : UsesCoreEdge f g τ k := by + by_contra hk + have hσescape : ¬ UsesCoreEdge f g σ k := by + exact fun h ↦ hk ((same_twoMatchingEncoding_core_iff henc k).1 h) + have heq := same_twoMatchingEncoding_of_escape henc hσescape + exact hσk_ne (heq.trans hτk) + have hτk_g : τ k = g k := by + rcases hτcore with hτk_f | hτk_g + · exact absurd (f.injective (hτk_f.symm.trans hτk)) hki + · exact hτk_g + have hkj : k = j := by + apply g.injective + rw [← hτk_g, hτk, hgj] + have hτj_g : τ j = g j := by + rw [← hkj] + exact hτk_g + have hσcore : UsesCoreEdge f g σ j := + (same_twoMatchingEncoding_core_iff henc j).2 (Or.inr hτj_g) + have hσj_g_ne : σ j ≠ g j := by + intro h + apply hji + exact (σ.injective (hσi.trans (hgj.symm.trans h.symm))).symm + refine ⟨?_, hτj_g⟩ + rcases hσcore with h | h + · exact h + · exact absurd h hσj_g_ne + +/-- A disagreement in either orientation propagates by one alternating step. -/ +theorem disagreement_step + {f g σ τ : Equiv.Perm α} + (henc : twoMatchingEncoding f g σ = twoMatchingEncoding f g τ) + {i : α} (hne : σ i ≠ τ i) : + σ (alternatingRowPerm f g i) ≠ τ (alternatingRowPerm f g i) := by + have hσcore : UsesCoreEdge f g σ i := by + by_contra h + exact hne (same_twoMatchingEncoding_of_escape henc h) + have hτcore : UsesCoreEdge f g τ i := + (same_twoMatchingEncoding_core_iff henc i).1 hσcore + rcases hσcore with hσf | hσg <;> rcases hτcore with hτf | hτg + · exact absurd (hσf.trans hτf.symm) hne + · obtain h := oriented_disagreement_step henc hσf hτg + (fun hfg ↦ hne (hσf.trans (hfg.trans hτg.symm))) + intro heq + have hstepFixed : alternatingRowPerm f g (alternatingRowPerm f g i) = + alternatingRowPerm f g i := + (alternatingRowPerm_fixed_iff f g _).2 (h.1.symm.trans (heq.trans h.2)) + have hiFixed : alternatingRowPerm f g i = i := by + exact (alternatingRowPerm f g).injective hstepFixed + have hfg0 : f i = g i := + (alternatingRowPerm_fixed_iff f g i).1 hiFixed + exact hne (hσf.trans (hfg0.trans hτg.symm)) + · obtain h := oriented_disagreement_step henc.symm hτf hσg + (fun hfg ↦ hne ((hσg.trans hfg.symm).trans hτf.symm)) + intro heq + have hstepFixed : alternatingRowPerm f g (alternatingRowPerm f g i) = + alternatingRowPerm f g i := + (alternatingRowPerm_fixed_iff f g _).2 (h.1.symm.trans (heq.symm.trans h.2)) + have hiFixed : alternatingRowPerm f g i = i := by + exact (alternatingRowPerm f g).injective hstepFixed + have hfg0 : f i = g i := + (alternatingRowPerm_fixed_iff f g i).1 hiFixed + exact hne (hσg.trans (hfg0.symm.trans hτf.symm)) + · exact absurd (hσg.trans hτg.symm) hne + +theorem disagreement_pow + {f g σ τ : Equiv.Perm α} + (henc : twoMatchingEncoding f g σ = twoMatchingEncoding f g τ) + {i : α} (hne : σ i ≠ τ i) : + ∀ k : ℕ, + σ (((alternatingRowPerm f g) ^ k) i) ≠ + τ (((alternatingRowPerm f g) ^ k) i) := by + intro k + induction k with + | zero => simpa using hne + | succ k ih => + simpa only [← Equiv.Perm.mul_apply, ← pow_succ'] using + disagreement_step henc ih + +/-- A chosen row in the support of a nontrivial alternating cycle. -/ +noncomputable def cycleRepresentative + (h : Equiv.Perm α) (c : h.cycleFactorsFinset) : α := + Classical.choose + ((Equiv.Perm.mem_cycleFactorsFinset_iff.mp c.property).1.nonempty_support) + +theorem cycleRepresentative_mem + (h : Equiv.Perm α) (c : h.cycleFactorsFinset) : + cycleRepresentative h c ∈ (c : Equiv.Perm α).support := + Classical.choose_spec + ((Equiv.Perm.mem_cycleFactorsFinset_iff.mp c.property).1.nonempty_support) + +/-- One Boolean choice for every nontrivial alternating cycle. -/ +noncomputable def cycleSignature + (f g σ : Equiv.Perm α) : + (alternatingRowPerm f g).cycleFactorsFinset → Bool := + fun c ↦ decide (σ (cycleRepresentative (alternatingRowPerm f g) c) = + f (cycleRepresentative (alternatingRowPerm f g) c)) + +theorem cycleSignature_injective_on_encoding_fiber + {f g : Equiv.Perm α} {y : α → Option α} : + Set.InjOn (cycleSignature f g) + {σ | twoMatchingEncoding f g σ = y} := by + intro σ hσ τ hτ hsig + have henc : twoMatchingEncoding f g σ = twoMatchingEncoding f g τ := + hσ.trans hτ.symm + ext i + by_contra hne + let h := alternatingRowPerm f g + have hsupport : i ∈ h.support := by + rw [Equiv.Perm.mem_support] + intro hfix + have hfg : f i = g i := + (alternatingRowPerm_fixed_iff f g i).1 hfix + have hσcore : UsesCoreEdge f g σ i := by + by_contra hout + exact hne (same_twoMatchingEncoding_of_escape henc hout) + have hτcore : UsesCoreEdge f g τ i := + (same_twoMatchingEncoding_core_iff henc i).1 hσcore + rcases hσcore with hσf | hσg <;> rcases hτcore with hτf | hτg <;> + apply hne <;> simp_all + let c : h.cycleFactorsFinset := + ⟨h.cycleOf i, Equiv.Perm.cycleOf_mem_cycleFactorsFinset_iff.mpr hsupport⟩ + have hirep : h.SameCycle i (cycleRepresentative h c) := by + apply (Equiv.Perm.sameCycle_iff_cycleOf_eq_of_mem_support hsupport + (Equiv.Perm.mem_cycleFactorsFinset_support_le c.property + (cycleRepresentative_mem h c))).2 + simpa [c] using + (Equiv.Perm.cycle_is_cycleOf (cycleRepresentative_mem h c) c.property) + obtain ⟨k, hk⟩ := hirep.exists_nat_pow_eq + have hneRep : + σ (cycleRepresentative h c) ≠ τ (cycleRepresentative h c) := by + rw [← hk] + exact disagreement_pow henc hne k + have hsigc := congrFun hsig c + change decide (σ (cycleRepresentative h c) = f (cycleRepresentative h c)) = + decide (τ (cycleRepresentative h c) = f (cycleRepresentative h c)) at hsigc + have hsigc' : + (σ (cycleRepresentative h c) = f (cycleRepresentative h c)) ↔ + τ (cycleRepresentative h c) = f (cycleRepresentative h c) := by + exact decide_eq_decide.mp hsigc + have hσcore : UsesCoreEdge f g σ (cycleRepresentative h c) := by + by_contra hout + exact hneRep (same_twoMatchingEncoding_of_escape henc hout) + have hτcore : UsesCoreEdge f g τ (cycleRepresentative h c) := + (same_twoMatchingEncoding_core_iff henc _).1 hσcore + rcases hσcore with hσf | hσg <;> rcases hτcore with hτf | hτg + · exact hneRep (hσf.trans hτf.symm) + · exact hneRep (hσf.trans (hsigc'.mp hσf).symm) + · exact hneRep ((hsigc'.mpr hτf).trans hτf.symm) + · exact hneRep (hσg.trans hτg.symm) + +/-- Graph-specific fiber bound in paper Lemma 9. A completed two-regular +bipartite multigraph is written as the union of perfect matchings `f` and `g`; +its components with at least two rows are the nontrivial cycles of +`alternatingRowPerm f g`. -/ +theorem twoMatchingEncoding_fiber_card_le + (f g : Equiv.Perm α) (y : α → Option α) : + (Finset.univ.filter fun σ : Equiv.Perm α ↦ + twoMatchingEncoding f g σ = y).card ≤ + 2 ^ (alternatingRowPerm f g).cycleFactorsFinset.card := by + let S := Finset.univ.filter fun σ : Equiv.Perm α ↦ + twoMatchingEncoding f g σ = y + let sigType := (alternatingRowPerm f g).cycleFactorsFinset → Bool + let encode : ↥S → sigType := fun σ ↦ cycleSignature f g σ.1 + have hinj : Function.Injective encode := by + intro σ τ h + apply Subtype.ext + have hσ : twoMatchingEncoding f g σ.1 = y := by + have hp := σ.property + dsimp only [S] at hp + exact (Finset.mem_filter.mp hp).2 + have hτ : twoMatchingEncoding f g τ.1 = y := by + have hp := τ.property + dsimp only [S] at hp + exact (Finset.mem_filter.mp hp).2 + exact cycleSignature_injective_on_encoding_fiber hσ hτ h + calc + S.card = Fintype.card S := (Fintype.card_coe S).symm + _ ≤ Fintype.card sigType := Fintype.card_le_of_injective encode hinj + _ = 2 ^ (alternatingRowPerm f g).cycleFactorsFinset.card := by + simp [sigType, Fintype.card_fun] + +/-- A spanning two-regular bipartite multigraph. The two slots at each row +record its two incident edges, while `columnDegree` says that every column is +incident to exactly two edge slots. Parallel edges are represented by equal +values in the two row slots. -/ +structure TwoRegularBipartiteMultigraph (α : Type*) [Fintype α] + [DecidableEq α] where + edge : α → Fin 2 → α + columnDegree : ∀ j, + (∑ i, ∑ k : Fin 2, if edge i k = j then 1 else 0) = 2 + +namespace TwoRegularBipartiteMultigraph + +variable (K : TwoRegularBipartiteMultigraph α) + +/-- Column neighbors of one row, with parallel edges ignored. -/ +noncomputable def neighbors (i : α) : Finset α := by + classical + exact Finset.univ.image (K.edge i) + +theorem mem_neighbors_iff (i j : α) : + j ∈ K.neighbors i ↔ ∃ k : Fin 2, K.edge i k = j := by + classical + simp [neighbors, eq_comm] + +private theorem localColumnCount_le_two (s : Finset α) (j : α) : + (∑ i ∈ s, ∑ k : Fin 2, if K.edge i k = j then 1 else 0) ≤ 2 := by + calc + (∑ i ∈ s, ∑ k : Fin 2, if K.edge i k = j then 1 else 0) ≤ + ∑ i, ∑ k : Fin 2, if K.edge i k = j then 1 else 0 := by + apply Finset.sum_le_sum_of_subset_of_nonneg (Finset.subset_univ _) + intro i _ _ + exact Finset.sum_nonneg (fun k _ ↦ by positivity) + _ = 2 := K.columnDegree j + +private theorem localColumnCount_eq_zero_of_notMem + (s : Finset α) {j : α} (hj : j ∉ s.biUnion K.neighbors) : + (∑ i ∈ s, ∑ k : Fin 2, if K.edge i k = j then 1 else 0) = 0 := by + apply Finset.sum_eq_zero + intro i hi + apply Finset.sum_eq_zero + intro k _ + have hne : K.edge i k ≠ j := by + intro h + apply hj + rw [Finset.mem_biUnion] + exact ⟨i, hi, (K.mem_neighbors_iff i j).2 ⟨k, h⟩⟩ + simp [hne] + +/-- The neighborhood family of a two-regular bipartite multigraph satisfies +Hall's condition. Multiplicities are essential in the proof: `2|S|` edge +slots leave `S`, while at most `2|N(S)|` slots enter its neighborhood. -/ +theorem hall_condition (s : Finset α) : + s.card ≤ (s.biUnion K.neighbors).card := by + let L : α → ℕ := fun j ↦ + ∑ i ∈ s, ∑ k : Fin 2, if K.edge i k = j then 1 else 0 + have hpartition : 2 * s.card = ∑ j, L j := by + dsimp [L] + calc + 2 * s.card = ∑ i ∈ s, ∑ _k : Fin 2, 1 := by simp [mul_comm] + _ = ∑ i ∈ s, ∑ k : Fin 2, ∑ j, if K.edge i k = j then 1 else 0 := by + apply Finset.sum_congr rfl + intro i _ + apply Finset.sum_congr rfl + intro k _ + simp + _ = ∑ i ∈ s, ∑ j, ∑ k : Fin 2, + if K.edge i k = j then 1 else 0 := by + apply Finset.sum_congr rfl + intro i _ + exact Finset.sum_comm + _ = ∑ j, ∑ i ∈ s, ∑ k : Fin 2, + if K.edge i k = j then 1 else 0 := by + exact Finset.sum_comm + have hrestrict : + (∑ j, L j) = ∑ j ∈ s.biUnion K.neighbors, L j := by + symm + apply Finset.sum_subset (Finset.subset_univ _) + intro j _ hj + exact K.localColumnCount_eq_zero_of_notMem s hj + have hbound : + (∑ j ∈ s.biUnion K.neighbors, L j) ≤ + ∑ _j ∈ s.biUnion K.neighbors, 2 := by + apply Finset.sum_le_sum + intro j _ + exact K.localColumnCount_le_two s j + have htwice : 2 * s.card ≤ 2 * (s.biUnion K.neighbors).card := by + rw [hpartition, hrestrict] + simpa [mul_comm] using hbound + omega + +private theorem finTwo_eq_or_eq_rev (k chosen : Fin 2) : + k = chosen ∨ k = Fin.rev chosen := by + fin_cases k <;> fin_cases chosen <;> simp + +private theorem sum_finTwo_split (a : Fin 2 → ℕ) (chosen : Fin 2) : + (∑ k, a k) = a chosen + a (Fin.rev chosen) := by + fin_cases chosen <;> simp [Fin.sum_univ_two, add_comm] + +/-- Every spanning two-regular bipartite multigraph is the union of two +perfect matchings. This is the precise edge-coloring fact needed to pass +from the paper's stub completion to `twoMatchingEncoding`. -/ +theorem exists_twoMatching_decomposition : + ∃ f g : Equiv.Perm α, + (∀ i, (∃ k : Fin 2, K.edge i k = f i) ∧ + ∃ k : Fin 2, K.edge i k = g i) ∧ + ∀ i k, K.edge i k = f i ∨ K.edge i k = g i := by + classical + obtain ⟨p, hpInjective, hpEdge⟩ := + (Finset.all_card_le_biUnion_card_iff_exists_injective K.neighbors).1 + K.hall_condition + have hpBijective : Function.Bijective p := + (Fintype.bijective_iff_injective_and_card p).2 ⟨hpInjective, rfl⟩ + let f : Equiv.Perm α := Equiv.ofBijective p hpBijective + have hfEdge : ∀ i, ∃ k : Fin 2, K.edge i k = f i := by + intro i + exact (K.mem_neighbors_iff i (f i)).1 (hpEdge i) + let chosen : α → Fin 2 := fun i ↦ Classical.choose (hfEdge i) + have hchosen : ∀ i, K.edge i (chosen i) = f i := fun i ↦ + Classical.choose_spec (hfEdge i) + let q : α → α := fun i ↦ K.edge i (Fin.rev (chosen i)) + have hresidual : ∀ j, + (∑ i, if q i = j then 1 else 0) = 1 := by + intro j + have hsplit : + (∑ i, ∑ k : Fin 2, if K.edge i k = j then 1 else 0) = + (∑ i, if f i = j then 1 else 0) + + ∑ i, if q i = j then 1 else 0 := by + calc + (∑ i, ∑ k : Fin 2, if K.edge i k = j then 1 else 0) = + ∑ i, ((if K.edge i (chosen i) = j then 1 else 0) + + if K.edge i (Fin.rev (chosen i)) = j then 1 else 0) := by + apply Finset.sum_congr rfl + intro i _ + exact sum_finTwo_split + (fun k ↦ if K.edge i k = j then 1 else 0) (chosen i) + _ = (∑ i, if f i = j then 1 else 0) + + ∑ i, if q i = j then 1 else 0 := by + rw [Finset.sum_add_distrib] + simp only [hchosen, q] + have hchosenCount : (∑ i, if f i = j then 1 else 0) = 1 := by + simp_rw [f.apply_eq_iff_eq_symm_apply] + rw [Finset.sum_ite_eq' Finset.univ (f.symm j)] + simp + rw [K.columnDegree j, hchosenCount] at hsplit + omega + have hqInjective : Function.Injective q := by + intro i i' hii' + let fiber := Finset.univ.filter fun r ↦ q r = q i + have hcard : fiber.card = 1 := by + rw [Finset.card_filter] + exact hresidual (q i) + obtain ⟨a, ha⟩ := Finset.card_eq_one.mp hcard + have hi : i ∈ fiber := by simp [fiber] + have hi' : i' ∈ fiber := by simp [fiber, hii'] + have hia : i = a := by simpa [ha] using hi + have hi'a : i' = a := by simpa [ha] using hi' + exact hia.trans hi'a.symm + have hqBijective : Function.Bijective q := + (Fintype.bijective_iff_injective_and_card q).2 ⟨hqInjective, rfl⟩ + let g : Equiv.Perm α := Equiv.ofBijective q hqBijective + refine ⟨f, g, ?_, ?_⟩ + · intro i + exact ⟨hfEdge i, ⟨Fin.rev (chosen i), rfl⟩⟩ + · intro i k + rcases finTwo_eq_or_eq_rev k (chosen i) with hk | hk + · left + rw [hk, hchosen] + · right + exact hk ▸ rfl + +end TwoRegularBipartiteMultigraph + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/CycleTransfer.lean b/LeanPool/BeyondBethe/BeyondBethe/CycleTransfer.lean new file mode 100644 index 0000000000..594cc9af14 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/CycleTransfer.lean @@ -0,0 +1,299 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.RobustCycle +import LeanPool.BeyondBethe.BeyondBethe.Optimizer +import LeanPool.BeyondBethe.BeyondBethe.ExcursionTransfer +import Mathlib.Tactic + +/-! # Cycle Transfer -/ + +open scoped BigOperators + +namespace BeyondBethe + +/-- Columns outside the two core edges at a row. -/ +noncomputable def coreOutside + {ι : Type*} [Fintype ι] [DecidableEq ι] + (a b : ι) : Finset ι := + Finset.univ.filter fun j ↦ a ≠ j ∧ b ≠ j + +theorem massOn_coreOutside_of_ne + {n : ℕ} {p : Fin n → ℝ} (hp : IsProbabilityVector p) + {a b : Fin n} (hab : a ≠ b) : + massOn (coreOutside a b) p = 1 - p a - p b := by + rw [massOn, coreOutside, Finset.sum_filter] + exact sum_away_from_two hp hab + +theorem massOn_coreOutside_same + {n : ℕ} {p : Fin n → ℝ} (hp : IsProbabilityVector p) (a : Fin n) : + massOn (coreOutside a a) p = 1 - p a := by + rw [massOn, coreOutside, Finset.sum_filter] + have haway := sum_ite_ne_eq_sum_sub p a + rw [hp.sum_eq_one] at haway + have hsame : (∑ j, if a ≠ j ∧ a ≠ j then p j else 0) = + ∑ j, if j ≠ a then p j else 0 := by + apply Finset.sum_congr rfl + intro j _ + by_cases hja : j = a + · subst j + simp + · simp [hja, Ne.symm hja] + rw [hsame, haway] + +theorem coreOutside_comm + {ι : Type*} [Fintype ι] [DecidableEq ι] (a b : ι) : + coreOutside a b = coreOutside b a := by + ext j + simp only [coreOutside, Finset.mem_filter, Finset.mem_univ, true_and] + constructor + · rintro ⟨haj, hbj⟩ + exact ⟨hbj, haj⟩ + · rintro ⟨hbj, haj⟩ + exact ⟨haj, hbj⟩ + +/-- If two distinct coordinates both belong to another two-element core, +then the two cores, and hence their complements, agree. -/ +theorem coreOutside_eq_of_pair_membership + {ι : Type*} [Fintype ι] [DecidableEq ι] + {a b c d : ι} (hab : a ≠ b) + (ha : a = c ∨ a = d) (hb : b = c ∨ b = d) : + coreOutside c d = coreOutside a b := by + rcases ha with ha | ha <;> rcases hb with hb | hb + · exact False.elim (hab (ha.trans hb.symm)) + · rw [ha, hb] + · rw [ha, hb, coreOutside_comm] + · exact False.elim (hab (ha.trans hb.symm)) + +theorem sum_negMulLog_coreOutside + {n : ℕ} (p : Fin n → ℝ) (a b : Fin n) : + (∑ j ∈ coreOutside a b, Real.negMulLog (p j)) = + ∑ j, if a ≠ j ∧ b ≠ j then Real.negMulLog (p j) else 0 := by + rw [coreOutside, Finset.sum_filter] + +/-- The row coordinate of the cycle encoding is exactly the coarsening used +in the excursion-transfer argument. -/ +theorem coreOutcome_entropy_eq_coarsenedRowEntropy + {n : ℕ} {p : Fin n → ℝ} (hp : IsStrictProbabilityVector p) + (a b : Fin n) : + shannonEntropy (pushforwardMass p (coreOutcome a b)) = + coarsenedRowEntropy (coreOutside a b) p := by + by_cases hab : a = b + · subst b + rw [coreOutcome_entropy_same p a, coarsenedRowEntropy, + scaledConditionalEntropyOn, binaryEntropy, + massOn_coreOutside_same hp.probability, + sum_negMulLog_coreOutside] + have hout := sum_ite_ne_eq_sum_sub + (fun j ↦ Real.negMulLog (p j)) a + have hsame : + (∑ j, if a ≠ j ∧ a ≠ j then Real.negMulLog (p j) else 0) = + ∑ j, if j ≠ a then Real.negMulLog (p j) else 0 := by + apply Finset.sum_congr rfl + intro j _ + by_cases hja : j = a + · subst j + simp + · simp [hja, Ne.symm hja] + rw [hsame, hout, shannonEntropy, Real.negMulLog_def] + ring + · rw [coreOutcome_entropy_eq_twoCoreCoarsenedEntropy p hab, + twoCoreCoarsenedEntropy, coarsenedRowEntropy, + scaledConditionalEntropyOn, binaryEntropy, + massOn_coreOutside_of_ne hp.probability hab, + sum_negMulLog_coreOutside] + have hmass : 1 - (1 - p a - p b) = p a + p b := by ring + rw [hmass, Real.negMulLog_def] + ring + +/-- Rowwise form of the preceding bridge for the actual completed graph. -/ +theorem coordinateEncoding_entropy_eq_coarsenedRowEntropy + {n : ℕ} {μ : Equiv.Perm (Fin n) → ℝ} + {P : Matrix (Fin n) (Fin n) ℝ} + (hmarg : HasAssignmentMarginals μ P) + (hP : ∀ i, IsStrictProbabilityVector (P i)) + (f g : Equiv.Perm (Fin n)) (i : Fin n) : + shannonEntropy (pushforwardMass (rowOrientedMass μ) + (fun σ ↦ twoMatchingEncoding f g σ i)) = + coarsenedRowEntropy (coreOutside (f i) (g i)) (P i) := by + rw [coordinateEncoding_mass hmarg f g i] + exact coreOutcome_entropy_eq_coarsenedRowEntropy (hP i) (f i) (g i) + +theorem two_mul_cycleFactors_card_le + {n : ℕ} (h : Equiv.Perm (Fin n)) : + 2 * h.cycleFactorsFinset.card ≤ n := by + have htwo : 2 * h.cycleFactorsFinset.card ≤ + ∑ c : h.cycleFactorsFinset, + (c : Equiv.Perm (Fin n)).support.card := by + calc + 2 * h.cycleFactorsFinset.card = + ∑ _c : h.cycleFactorsFinset, 2 := by simp [Nat.mul_comm] + _ ≤ ∑ c : h.cycleFactorsFinset, + (c : Equiv.Perm (Fin n)).support.card := by + apply Finset.sum_le_sum + intro c _ + exact (Equiv.Perm.mem_cycleFactorsFinset_iff.mp c.property).1.two_le_card_support + have hsupport : + (∑ c : h.cycleFactorsFinset, + (c : Equiv.Perm (Fin n)).support.card) ≤ n := by + have hle := sum_cycleSupport_inter_card_le h Finset.univ + simpa using hle + omega + +/-- Paper Lemma 9 in the exact coarsened-row form needed for equation (39). -/ +theorem twoMatching_entropy_le_halfBits_add_coarsenedRows + {n : ℕ} {μ : Equiv.Perm (Fin n) → ℝ} + {P : Matrix (Fin n) (Fin n) ℝ} + (hμ : IsProbabilityVector μ) + (hmarg : HasAssignmentMarginals μ P) + (hP : ∀ i, IsStrictProbabilityVector (P i)) + (f g : Equiv.Perm (Fin n)) : + shannonEntropy μ ≤ n * (Real.log 2 / 2) + + ∑ i, coarsenedRowEntropy (coreOutside (f i) (g i)) (P i) := by + have hcore := twoMatching_coreEncoding_sum_coordinates hμ f g + simp_rw [coordinateEncoding_entropy_eq_coarsenedRowEntropy + hmarg hP f g] at hcore + have hcountNat := two_mul_cycleFactors_card_le (alternatingRowPerm f g) + have hcount : + ((alternatingRowPerm f g).cycleFactorsFinset.card : ℝ) * + Real.log 2 ≤ n * (Real.log 2 / 2) := by + have hcountR : + 2 * ((alternatingRowPerm f g).cycleFactorsFinset.card : ℝ) ≤ n := by + exact_mod_cast hcountNat + have hlog : 0 ≤ Real.log 2 := Real.log_nonneg (by norm_num) + nlinarith [mul_le_mul_of_nonneg_right hcountR hlog] + linarith + +/-- End-to-end form of the excursion-transfer estimate for a completed +two-matching graph. This theorem closes the informal identification of a +good row's two heavy coordinates with its two graph edges: consequently the +mass outside the encoded core is at most `η`. -/ +theorem twoMatching_coreTransferCost_normalized_le + {n : ℕ} (hn : 0 < n) + {μ : Equiv.Perm (Fin n) → ℝ} + {P X : Matrix (Fin n) (Fin n) ℝ} + (hμ : IsProbabilityVector μ) + (hmarg : HasAssignmentMarginals μ P) + (hP : ∀ i, IsStrictProbabilityVector (P i)) + {τ B η : ℝ} (hτ : 0 ≤ τ) + (hXint : ∀ i, IsInteriorProbabilityVector (X i)) + (hη : η ∈ Set.Icc (0 : ℝ) (2 : ℝ)⁻¹) + (f g : Equiv.Perm (Fin n)) + (hheavy : ∀ i j, j ∈ heavyCoordinates η (P i) → + j = f i ∨ j = g i) + (hglobal : matrixTransferCost P + (fun i j ↦ transferU τ (X i) j) ≤ + B + shannonEntropy μ - n * (Real.log 2 / 2)) : + coreTransferCost (fun i ↦ coreOutside (f i) (g i)) P + (fun i j ↦ transferU τ (X i) j) / n ≤ + B / n + binaryEntropy η + η + + (1 + Real.log 2) * ((badRows η P).card : ℝ) / n := by + letI : Nonempty (Fin n) := Fin.pos_iff_nonempty.mp hn + have hencoding := twoMatching_entropy_le_halfBits_add_coarsenedRows + hμ hmarg hP f g + have hbefore : matrixTransferCost P + (fun i j ↦ transferU τ (X i) j) ≤ + B + ∑ i, coarsenedRowEntropy (coreOutside (f i) (g i)) (P i) := by + linarith + have hρ : ∀ i, + massOn (coreOutside (f i) (g i)) (P i) ∈ Set.Icc (0 : ℝ) 1 := by + intro i + constructor + · rw [massOn] + exact Finset.sum_nonneg fun j _ ↦ (hP i).probability.nonnegative j + · exact (massOn_le_sum_univ _ + (fun j ↦ (hP i).probability.nonnegative j)).trans_eq + (hP i).probability.sum_eq_one + have hgood : ∀ i ∈ goodRows η P, + massOn (coreOutside (f i) (g i)) (P i) ≤ η := by + intro i hi + have hi' : IsGoodRow η (P i) := by + simpa [goodRows] using hi + obtain ⟨a, b, hab, hdist⟩ := hi' + have hcore := goodRow_witness_mem_heavyCoordinates + (hP i).probability hab hdist + have ha := hheavy i a hcore.1 + have hb := hheavy i b hcore.2 + have houtside : coreOutside (f i) (g i) = coreOutside a b := + coreOutside_eq_of_pair_membership hab ha hb + rw [houtside, massOn_coreOutside_of_ne (hP i).probability hab] + rw [halfHalfL1Distance_eq (hP i).probability hab] at hdist + linarith [abs_nonneg (P i a - 1 / 2), abs_nonneg (P i b - 1 / 2)] + have hnormalized := coreTransferCost_normalized_le_for_transferU + (fun i ↦ coreOutside (f i) (g i)) (goodRows η P) + hτ (fun i j ↦ (hP i).positive j) hXint hbefore hη hρ hgood + have hbad : (Finset.univ \ goodRows η P) = badRows η P := by + ext i + simp [goodRows, badRows] + rw [hbad] at hnormalized + simpa [Fintype.card_fin] using hnormalized + +/-- The preceding transfer estimate with every probabilistic, slack, and +optimization quantity instantiated for the Gibbs distribution of a positive +matrix. Apart from the logarithmic KKT equations, all inputs to paper +Lemmas 16 and 17 are discharged here. -/ +theorem gibbs_twoMatching_coreTransferCost_normalized_le + {n : ℕ} (hn : 0 < n) + (A : Matrix (Fin n) (Fin n) ℝ) (hA : Matrix.Positive A) + {τ ξ η : ℝ} (hτ : 0 ≤ τ) + (hbudget : τ * (n * Real.log n) ≤ ξ * n) + (hη : η ∈ Set.Icc (0 : ℝ) (2 : ℝ)⁻¹) + (f g : Equiv.Perm (Fin n)) + (hheavy : ∀ i j, j ∈ heavyCoordinates η (assignmentMarginal A i) → + j = f i ∨ j = g i) + {X : Matrix (Fin n) (Fin n) ℝ} + (hX : IsDoublyStochastic X) + (hXint : ∀ i, IsInteriorProbabilityVector (X i)) + {r c : Fin n → ℝ} (hKKT : HasLogKKT τ A X r c) : + coreTransferCost (fun i ↦ coreOutside (f i) (g i)) + (assignmentMarginal A) (fun i j ↦ transferU τ (X i) j) / n ≤ + betheSlack n (betheLogValue A) (Real.log (Matrix.permanent A)) / n + + 2 * ξ + binaryEntropy η + η + + (1 + Real.log 2) * + ((badRows η (assignmentMarginal A)).card : ℝ) / n := by + let P := assignmentMarginal A + let μ := gibbsProbability A + let D := gibbsSequentialDivergence A + let E := betheSuboptimality (betheLogValue A) (betheObjective A P) + let S := betheSlack n (betheLogValue A) + (Real.log (Matrix.permanent A)) + have hper : 0 < Matrix.permanent A := permanent_pos_of_positive A hA + have hPds : IsDoublyStochastic P := + assignmentMarginal_doublyStochastic A + (fun i j ↦ (hA i j).le) hper.ne' + have hPstrict : ∀ i, IsStrictProbabilityVector (P i) := + assignmentMarginal_strictProbabilityVector A hA + have hEτ : regularizedBetheObjective τ A X - + regularizedBetheObjective τ A P ≤ E + ξ * n := by + exact regularizedDifference_le_betheSuboptimality_add_budget + hn hτ hbudget hA hX hPds + have hregularizer : τ * totalRowEntropy P ≤ ξ * n := by + have hentropy : totalRowEntropy P ≤ n * Real.log n := by + letI : Nonempty (Fin n) := Fin.pos_iff_nonempty.mp hn + simpa using totalRowEntropy_le hPds + exact (mul_le_mul_of_nonneg_left hentropy hτ).trans hbudget + have hdivergence : D = -shannonEntropy μ + ∑ i, rowScore (P i) := by + exact gibbsSequentialDivergence_eq_entropy A hA + have hseq : Real.log (Matrix.permanent A) = + betheObjective A P + (∑ i, rowCorrection (P i)) - D := by + exact gibbs_exact_sequential_identity A hA + have hslack : S = E + (∑ i, rowDeficit (P i)) + D := by + exact slack_decomposition_rowDeficit P hseq + have hglobal : matrixTransferCost P + (fun i j ↦ transferU τ (X i) j) ≤ + S + 2 * ξ * n + shannonEntropy μ - + n * (Real.log 2 / 2) := by + exact global_transfer_upper_of_logKKT_and_slack + hX hPds hXint hKKT hEτ hregularizer hdivergence hslack + have hcore := twoMatching_coreTransferCost_normalized_le + hn (gibbsProbability_isProbabilityVector A hA) + (gibbs_hasAssignmentMarginals A) hPstrict hτ hXint hη f g hheavy + (B := S + 2 * ξ * n) hglobal + have hnR : (n : ℝ) ≠ 0 := by exact_mod_cast hn.ne' + dsimp only [P, μ, S] at hcore ⊢ + convert hcore using 1 <;> field_simp [hnR] <;> ring + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/Cycles.lean b/LeanPool/BeyondBethe/BeyondBethe/Cycles.lean new file mode 100644 index 0000000000..02d0637991 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/Cycles.lean @@ -0,0 +1,717 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.RowStability +import LeanPool.BeyondBethe.BeyondBethe.CoreEncoding +import Mathlib.Analysis.Convex.SpecificFunctions.Basic +import Mathlib.Tactic + +/-! # Cycles -/ + +namespace BeyondBethe + +/-- The Riemann-sum error `e(a,x)` from paper (27). Lean's conventions +`a / 0 = 0` and `log 1 = 0` make the displayed formula agree with the paper's +boundary convention `e(a,0)=a`. -/ +noncomputable def suffixError (a x : ℝ) : ℝ := + a - x * Real.log (1 + a / x) + +/-- An antiderivative of `log` with its continuous value at zero. -/ +noncomputable def logIntegralPrimitive (x : ℝ) : ℝ := + x * Real.log x - x + +/-- Suffix score for a list written in the chosen order. -/ +noncomputable def listSuffixScore : List ℝ → ℝ + | [] => 0 + | a :: l => a * Real.log (a + l.sum) + listSuffixScore l + +noncomputable def listSuffixErrorSum : List ℝ → ℝ + | [] => 0 + | a :: l => suffixError a l.sum + listSuffixErrorSum l + +theorem listSuffixScore_ofFn + {n : ℕ} (f : Fin n → ℝ) : + listSuffixScore (List.ofFn f) = + ∑ t, f t * Real.log (∑ k, if t ≤ k then f k else 0) := by + induction n with + | zero => simp [listSuffixScore] + | succ n ih => + rw [List.ofFn_succ, listSuffixScore, Fin.sum_univ_succ, + ih (fun k ↦ f k.succ)] + congr 1 + · congr 2 + rw [List.sum_ofFn, Fin.sum_univ_succ] + simp + · apply Finset.sum_congr rfl + intro i _ + congr 2 + rw [Fin.sum_univ_succ] + simp + +/-- Reindexing bridge between the paper's ordered-list Riemann sum and the +permutation-indexed suffix score used in `rowT`. -/ +theorem listSuffixScore_ofFn_eq_ordered_score + {n : ℕ} (p : Fin n → ℝ) (π : Equiv.Perm (Fin n)) : + listSuffixScore (List.ofFn (fun t ↦ p (π t))) = + ∑ j, p j * Real.log (suffixMass p π j) := by + calc + listSuffixScore (List.ofFn (fun t ↦ p (π t))) = + ∑ t, p (π t) * Real.log + (∑ k, if t ≤ k then p (π k) else 0) := by + exact listSuffixScore_ofFn (fun t ↦ p (π t)) + _ = ∑ t, p (π t) * Real.log (suffixMass p π (π t)) := by + apply Finset.sum_congr rfl + intro t _ + rw [← orderedSuffixWeight_eq_suffixMass + (fun _ j ↦ p j) π t] + rfl + _ = ∑ j, p j * Real.log (suffixMass p π j) := + Equiv.sum_comp π (fun j ↦ p j * Real.log (suffixMass p π j)) + +/-- One interval in the telescoping Riemann-sum calculation. -/ +theorem suffix_step_identity {a x : ℝ} (ha : 0 ≤ a) (hx : 0 ≤ x) : + a * Real.log (a + x) = + logIntegralPrimitive (a + x) - logIntegralPrimitive x + suffixError a x := by + by_cases hx0 : x = 0 + · subst x + simp [logIntegralPrimitive, suffixError] + · have hxpos : 0 < x := lt_of_le_of_ne hx (Ne.symm hx0) + have hsum : a + x ≠ 0 := (add_pos_of_nonneg_of_pos ha hxpos).ne' + have hratio : 1 + a / x = (a + x) / x := by + field_simp + ring + simp only [suffixError, logIntegralPrimitive] + rw [hratio, Real.log_div hsum hx0] + ring + +/-- The error term is nonnegative, including at the boundary `x=0`. -/ +theorem suffixError_nonneg {a x : ℝ} (ha : 0 ≤ a) (hx : 0 ≤ x) : + 0 ≤ suffixError a x := by + by_cases hx0 : x = 0 + · subst x + simpa [suffixError] using ha + · have hxpos : 0 < x := lt_of_le_of_ne hx (Ne.symm hx0) + have harg : 0 < 1 + a / x := by positivity + have hlog := Real.log_le_sub_one_of_pos harg + have hmul := mul_le_mul_of_nonneg_left hlog hx + have hsimplify : x * ((1 + a / x) - 1) = a := by + field_simp + ring + rw [hsimplify] at hmul + rw [suffixError] + linarith + +/-- For fixed nonnegative `a`, the Riemann-sum error is nonincreasing in the +suffix mass, as asserted in paper Lemma 11. -/ +theorem suffixError_anti {a x y : ℝ} + (ha : 0 ≤ a) (hx : 0 ≤ x) (hxy : x ≤ y) : + suffixError a y ≤ suffixError a x := by + have hy : 0 ≤ y := hx.trans hxy + by_cases hy0 : y = 0 + · have hx0 : x = 0 := le_antisymm (hxy.trans_eq hy0) hx + simp [hx0, hy0] + have hypos : 0 < y := lt_of_le_of_ne hy (Ne.symm hy0) + by_cases hx0 : x = 0 + · subst x + have harg : 1 ≤ 1 + a / y := by + exact le_add_of_nonneg_right (div_nonneg ha hy) + have hlog : 0 ≤ Real.log (1 + a / y) := Real.log_nonneg harg + have hprod : 0 ≤ y * Real.log (1 + a / y) := mul_nonneg hy hlog + simp only [suffixError, zero_mul, div_zero, add_zero, Real.log_one, sub_zero] + linarith + · have hxpos : 0 < x := lt_of_le_of_ne hx (Ne.symm hx0) + let lam : ℝ := x / y + have hlam0 : 0 ≤ lam := div_nonneg hx hy + have hlam1 : lam ≤ 1 := (div_le_one hypos).2 hxy + have hfirst : 0 < 1 + a / x := by positivity + have hone : (1 : ℝ) ∈ Set.Ioi 0 := by norm_num + have hconc := strictConcaveOn_log_Ioi.concaveOn.2 + (show 1 + a / x ∈ Set.Ioi (0 : ℝ) from hfirst) + hone hlam0 (sub_nonneg.mpr hlam1) (by ring : lam + (1 - lam) = 1) + have hcombo : + lam * (1 + a / x) + (1 - lam) * (1 : ℝ) = 1 + a / y := by + dsimp [lam] + field_simp + ring + have hlogs : + lam * Real.log (1 + a / x) ≤ Real.log (1 + a / y) := by + simpa only [smul_eq_mul, Real.log_one, mul_zero, add_zero, hcombo] using hconc + have hmul := mul_le_mul_of_nonneg_left hlogs hy + have hlam_mul : y * (lam * Real.log (1 + a / x)) = + x * Real.log (1 + a / x) := by + dsimp [lam] + field_simp + rw [hlam_mul] at hmul + rw [suffixError, suffixError] + linarith + +/-- Finite telescoping form of the suffix Riemann-sum identity, before +normalizing the total mass to one. -/ +theorem listSuffixScore_identity (p : List ℝ) + (hp : ∀ x ∈ p, 0 ≤ x) : + listSuffixScore p = + logIntegralPrimitive p.sum + listSuffixErrorSum p := by + induction p with + | nil => simp [listSuffixScore, listSuffixErrorSum, logIntegralPrimitive] + | cons a p ih => + have ha : 0 ≤ a := hp a (by simp) + have hp' : ∀ x ∈ p, 0 ≤ x := by + intro x hx + exact hp x (by simp [hx]) + have hsum : 0 ≤ p.sum := List.sum_nonneg hp' + rw [listSuffixScore, listSuffixErrorSum, ih hp'] + rw [suffix_step_identity ha hsum] + simp only [List.sum_cons] + ring + +/-- Paper Lemma 11 in ordered-list form. -/ +theorem listSuffixScore_eq_neg_one_add_errors (p : List ℝ) + (hp : ∀ x ∈ p, 0 ≤ x) (hsum : p.sum = 1) : + listSuffixScore p = -1 + listSuffixErrorSum p := by + rw [listSuffixScore_identity p hp, hsum] + simp [logIntegralPrimitive] + +theorem listSuffixErrorSum_nonneg (p : List ℝ) + (hp : ∀ x ∈ p, 0 ≤ x) : + 0 ≤ listSuffixErrorSum p := by + induction p with + | nil => simp [listSuffixErrorSum] + | cons a p ih => + have ha : 0 ≤ a := hp a (by simp) + have hp' : ∀ x ∈ p, 0 ≤ x := by + intro x hx + exact hp x (by simp [hx]) + simp only [listSuffixErrorSum] + exact add_nonneg (suffixError_nonneg ha (List.sum_nonneg hp')) (ih hp') + +/-- The coarse consequence `T(p) ≥ -1` used for bad rows, stated for an +arbitrary fixed ordering. -/ +theorem listSuffixScore_ge_neg_one (p : List ℝ) + (hp : ∀ x ∈ p, 0 ≤ x) (hsum : p.sum = 1) : + -1 ≤ listSuffixScore p := by + rw [listSuffixScore_eq_neg_one_add_errors p hp hsum] + linarith [listSuffixErrorSum_nonneg p hp] + +theorem fixed_order_suffixScore_ge_neg_one + {n : ℕ} {p : Fin n → ℝ} + (hp : IsProbabilityVector p) (π : Equiv.Perm (Fin n)) : + -1 ≤ ∑ j, p j * Real.log (suffixMass p π j) := by + rw [← listSuffixScore_ofFn_eq_ordered_score] + apply listSuffixScore_ge_neg_one + · intro x hx + simp only [List.mem_ofFn] at hx + obtain ⟨t, rfl⟩ := hx + exact hp.nonnegative (π t) + · rw [List.sum_ofFn] + exact (Equiv.sum_comp π p).trans hp.sum_eq_one + +/-- The coarse part of paper Lemma 12: every row has suffix score at least +`-1`. -/ +theorem rowT_ge_neg_one + {n : ℕ} {p : Fin n → ℝ} (hp : IsProbabilityVector p) : + -1 ≤ rowT p := by + rw [rowT, ← uniformAverage_const + (α := Equiv.Perm (Fin n)) (-1)] + unfold uniformAverage + exact div_le_div_of_nonneg_right + (Finset.sum_le_sum fun π _ ↦ fixed_order_suffixScore_ge_neg_one hp π) + (Nat.cast_nonneg _) + +theorem rowScore_ge_entropy_sub_one + {n : ℕ} {p : Fin n → ℝ} (hp : IsProbabilityVector p) : + shannonEntropy p - 1 ≤ rowScore p := by + rw [rowScore] + linarith [rowT_ge_neg_one hp] + +theorem fourthRoot_pow_four {d : ℝ} (hd : 0 ≤ d) : + fourthRoot d ^ 4 = d := by + rw [fourthRoot] + have hsqrt : 0 ≤ Real.sqrt d := Real.sqrt_nonneg d + calc + Real.sqrt (Real.sqrt d) ^ 4 = + (Real.sqrt (Real.sqrt d) ^ 2) ^ 2 := by ring + _ = (Real.sqrt d) ^ 2 := by rw [Real.sq_sqrt hsqrt] + _ = d := Real.sq_sqrt hd + +/-- A row is good when one of the half--half vectors is within the selected +`L¹` threshold. -/ +def IsGoodRow {n : ℕ} (eta : ℝ) (p : Fin n → ℝ) : Prop := + ∃ a b : Fin n, a ≠ b ∧ halfHalfL1Distance p a b ≤ eta + +/-- The rows that fail the preceding structural test. -/ +noncomputable def badRows + {n : ℕ} (eta : ℝ) (P : Matrix (Fin n) (Fin n) ℝ) : Finset (Fin n) := by + classical + exact Finset.univ.filter fun i ↦ ¬ IsGoodRow eta (P i) + +/-- Paper (22): a good row has two heavy coordinates and little mass outside +them. -/ +theorem goodRow_heavy_coordinates + {n : ℕ} {eta : ℝ} {p : Fin n → ℝ} + (hp : IsProbabilityVector p) (hgood : IsGoodRow eta p) : + ∃ a b : Fin n, a ≠ b ∧ + 1 / 2 - eta ≤ p a ∧ 1 / 2 - eta ≤ p b ∧ + 1 - p a - p b ≤ eta := by + obtain ⟨a, b, hab, hdist⟩ := hgood + have hsum : |p a - 1 / 2| + |p b - 1 / 2| + (1 - p a - p b) ≤ eta := by + simpa [halfHalfL1Distance_eq hp hab] using hdist + have htail : 0 ≤ 1 - p a - p b := by + rw [← sum_away_from_two hp hab] + exact Finset.sum_nonneg (fun j _ ↦ by + by_cases h : a ≠ j ∧ b ≠ j <;> simp [h, hp.nonnegative j]) + refine ⟨a, b, hab, ?_, ?_, ?_⟩ + · have habs := neg_le_abs (p a - 1 / 2) + have hbabs := abs_nonneg (p b - 1 / 2) + linarith + · have habs := neg_le_abs (p b - 1 / 2) + have haabs := abs_nonneg (p a - 1 / 2) + linarith + · have haabs := abs_nonneg (p a - 1 / 2) + have hbabs := abs_nonneg (p b - 1 / 2) + linarith + +/-- Heavy coordinates of one row, equivalently its neighbors in the heavy +bipartite graph. -/ +noncomputable def heavyCoordinates + {n : ℕ} (eta : ℝ) (p : Fin n → ℝ) : Finset (Fin n) := by + classical + exact Finset.univ.filter fun j ↦ 1 / 2 - eta ≤ p j + +/-- Paper's degree-at-most-two assertion for the heavy graph. -/ +theorem heavyCoordinates_card_le_two + {n : ℕ} {eta : ℝ} {p : Fin n → ℝ} + (hp : IsProbabilityVector p) (heta : eta ≤ 1 / 10) : + (heavyCoordinates eta p).card ≤ 2 := by + by_contra h + have hcardNat : 3 ≤ (heavyCoordinates eta p).card := by omega + have hcardReal : (3 : ℝ) ≤ (heavyCoordinates eta p).card := by + exact_mod_cast hcardNat + have hsumLower : + ((heavyCoordinates eta p).card : ℝ) * (1 / 2 - eta) ≤ + ∑ j ∈ heavyCoordinates eta p, p j := by + calc + ((heavyCoordinates eta p).card : ℝ) * (1 / 2 - eta) = + ∑ j ∈ heavyCoordinates eta p, (1 / 2 - eta) := by + rw [Finset.sum_const, nsmul_eq_mul] + _ ≤ ∑ j ∈ heavyCoordinates eta p, p j := by + apply Finset.sum_le_sum + intro j hj + simpa [heavyCoordinates] using hj + have hsumUpper : (∑ j ∈ heavyCoordinates eta p, p j) ≤ 1 := by + rw [← hp.sum_eq_one] + exact Finset.sum_le_sum_of_subset_of_nonneg (Finset.subset_univ _) + (fun j _ _ ↦ hp.nonnegative j) + have hfactor : (2 / 5 : ℝ) ≤ 1 / 2 - eta := by linarith + have hmul := mul_le_mul hcardReal hfactor (by norm_num) (by positivity) + nlinarith + +/-- A good row has exactly two heavy coordinates. -/ +theorem goodRow_has_exactly_two_heavyCoordinates + {n : ℕ} {eta : ℝ} {p : Fin n → ℝ} + (hp : IsProbabilityVector p) (heta : eta ≤ 1 / 10) + (hgood : IsGoodRow eta p) : + (heavyCoordinates eta p).card = 2 := by + obtain ⟨a, b, hab, ha, hb, _⟩ := goodRow_heavy_coordinates hp hgood + have haMem : a ∈ heavyCoordinates eta p := by + simpa [heavyCoordinates] using ha + have hbMem : b ∈ heavyCoordinates eta p := by + simpa [heavyCoordinates] using hb + have htwo : ({a, b} : Finset (Fin n)).card ≤ + (heavyCoordinates eta p).card := + Finset.card_le_card (by + intro j hj + simp only [Finset.mem_insert, Finset.mem_singleton] at hj + rcases hj with rfl | rfl + · exact haMem + · exact hbMem) + have habCard : ({a, b} : Finset (Fin n)).card = 2 := by simp [hab] + rw [habCard] at htwo + exact le_antisymm (heavyCoordinates_card_le_two hp heta) htwo + +noncomputable def heavyRows + {n : ℕ} (eta : ℝ) (P : Matrix (Fin n) (Fin n) ℝ) + (j : Fin n) : Finset (Fin n) := + heavyCoordinates eta (fun i ↦ P i j) + +/-- Both sides of the heavy bipartite graph have degree at most two. -/ +theorem heavy_graph_degree_bounds + {n : ℕ} {eta : ℝ} {P : Matrix (Fin n) (Fin n) ℝ} + (hP : IsDoublyStochastic P) (heta : eta ≤ 1 / 10) : + (∀ i, (heavyCoordinates eta (P i)).card ≤ 2) ∧ + ∀ j, (heavyRows eta P j).card ≤ 2 := by + constructor + · intro i + exact heavyCoordinates_card_le_two (hP.row_probability i) heta + · intro j + apply heavyCoordinates_card_le_two + · exact ⟨fun i ↦ hP.nonnegative i j, hP.col_sum j⟩ + · exact heta + +/-- Missing half-edges at row vertices of the heavy graph. -/ +abbrev RowStub + {n : ℕ} (eta : ℝ) (P : Matrix (Fin n) (Fin n) ℝ) := + Σ i : Fin n, Fin (2 - (heavyCoordinates eta (P i)).card) + +/-- Missing half-edges at column vertices of the heavy graph. -/ +abbrev ColumnStub + {n : ℕ} (eta : ℝ) (P : Matrix (Fin n) (Fin n) ℝ) := + Σ j : Fin n, Fin (2 - (heavyRows eta P j).card) + +/-- The two sides of the bipartite heavy graph have the same total degree. -/ +theorem sum_heavy_degrees + {n : ℕ} (eta : ℝ) (P : Matrix (Fin n) (Fin n) ℝ) : + (∑ i, (heavyCoordinates eta (P i)).card) = + ∑ j, (heavyRows eta P j).card := by + classical + simp only [heavyCoordinates, heavyRows, Finset.card_filter] + rw [Finset.sum_comm] + +theorem stub_card_eq + {n : ℕ} {eta : ℝ} {P : Matrix (Fin n) (Fin n) ℝ} + (hP : IsDoublyStochastic P) (heta : eta ≤ 1 / 10) : + Fintype.card (RowStub eta P) = Fintype.card (ColumnStub eta P) := by + have hdegree := sum_heavy_degrees eta P + have hbounds := heavy_graph_degree_bounds hP heta + have hrow : (∑ i, ((2 - (heavyCoordinates eta (P i)).card) + + (heavyCoordinates eta (P i)).card)) = ∑ _i : Fin n, 2 := by + apply Finset.sum_congr rfl + intro i _ + exact Nat.sub_add_cancel (hbounds.1 i) + have hcol : (∑ j, ((2 - (heavyRows eta P j).card) + + (heavyRows eta P j).card)) = ∑ _j : Fin n, 2 := by + apply Finset.sum_congr rfl + intro j _ + exact Nat.sub_add_cancel (hbounds.2 j) + rw [Finset.sum_add_distrib] at hrow hcol + simp only [Finset.sum_const, Finset.card_univ, Fintype.card_fin, + nsmul_eq_mul] at hrow hcol + simp only [RowStub, ColumnStub, Fintype.card_sigma, Fintype.card_fin] + omega + +/-- The formal content of "pair the row stubs arbitrarily with the column +stubs": such a pairing exists because the cardinalities agree. Each paired +stub is an added edge, with parallel edges allowed. -/ +noncomputable def completeHeavyGraphStubEquiv + {n : ℕ} {eta : ℝ} {P : Matrix (Fin n) (Fin n) ℝ} + (hP : IsDoublyStochastic P) (heta : eta ≤ 1 / 10) : + RowStub eta P ≃ ColumnStub eta P := + Fintype.equivOfCardEq (stub_card_eq hP heta) + +/-- The two edge slots at a row, split into existing heavy edges and missing +stubs. -/ +noncomputable def heavyRowSlotEquiv + {n : ℕ} {eta : ℝ} {P : Matrix (Fin n) (Fin n) ℝ} + (hP : IsDoublyStochastic P) (heta : eta ≤ 1 / 10) (i : Fin n) : + Fin 2 ≃ (heavyCoordinates eta (P i) : Type) ⊕ + Fin (2 - (heavyCoordinates eta (P i)).card) := by + apply Fintype.equivOfCardEq + simp only [Fintype.card_fin, Fintype.card_sum, Fintype.card_coe] + simpa [Nat.add_comm] using + (Nat.sub_add_cancel (heavy_graph_degree_bounds hP heta |>.1 i)).symm + +/-- The analogous two-slot decomposition at a column. -/ +noncomputable def heavyColumnSlotEquiv + {n : ℕ} {eta : ℝ} {P : Matrix (Fin n) (Fin n) ℝ} + (hP : IsDoublyStochastic P) (heta : eta ≤ 1 / 10) (j : Fin n) : + Fin 2 ≃ (heavyRows eta P j : Type) ⊕ + Fin (2 - (heavyRows eta P j).card) := by + apply Fintype.equivOfCardEq + simp only [Fintype.card_fin, Fintype.card_sum, Fintype.card_coe] + simpa [Nat.add_comm] using + (Nat.sub_add_cancel (heavy_graph_degree_bounds hP heta |>.2 j)).symm + +/-- Reindex an existing heavy edge by its column rather than its row. -/ +noncomputable def heavyEdgeTranspose + {n : ℕ} (eta : ℝ) (P : Matrix (Fin n) (Fin n) ℝ) : + (Σ i, (heavyCoordinates eta (P i) : Type)) ≃ + Σ j, (heavyRows eta P j : Type) where + toFun e := ⟨e.2.1, ⟨e.1, by + simpa [heavyRows, heavyCoordinates] using e.2.2⟩⟩ + invFun e := ⟨e.2.1, ⟨e.1, by + simpa [heavyRows, heavyCoordinates] using e.2.2⟩⟩ + left_inv e := by rcases e with ⟨i, j, h⟩; rfl + right_inv e := by rcases e with ⟨j, i, h⟩; rfl + +/-- The stub completion as an explicit bijection from row edge-slots to +column edge-slots. On existing heavy edges it transposes the endpoints; on +new edges it uses the arbitrary stub pairing. -/ +noncomputable def heavyCompletionSlotEquiv + {n : ℕ} {eta : ℝ} {P : Matrix (Fin n) (Fin n) ℝ} + (hP : IsDoublyStochastic P) (heta : eta ≤ 1 / 10) : + (Σ _i : Fin n, Fin 2) ≃ Σ _j : Fin n, Fin 2 := + (Equiv.sigmaCongrRight fun i ↦ heavyRowSlotEquiv hP heta i) |>.trans + (Equiv.sigmaSumDistrib + (fun i ↦ (heavyCoordinates eta (P i) : Type)) + (fun i ↦ Fin (2 - (heavyCoordinates eta (P i)).card))) |>.trans + (Equiv.sumCongr (heavyEdgeTranspose eta P) + (completeHeavyGraphStubEquiv hP heta)) |>.trans + (Equiv.sigmaSumDistrib + (fun j ↦ (heavyRows eta P j : Type)) + (fun j ↦ Fin (2 - (heavyRows eta P j).card))).symm |>.trans + (Equiv.sigmaCongrRight fun j ↦ (heavyColumnSlotEquiv hP heta j).symm) + +/-- The completed heavy graph, now packaged as a spanning two-regular +bipartite multigraph. -/ +noncomputable def completedHeavyMultigraph + {n : ℕ} {eta : ℝ} {P : Matrix (Fin n) (Fin n) ℝ} + (hP : IsDoublyStochastic P) (heta : eta ≤ 1 / 10) : + TwoRegularBipartiteMultigraph (Fin n) where + edge i k := (heavyCompletionSlotEquiv hP heta ⟨i, k⟩).1 + columnDegree j := by + let E := heavyCompletionSlotEquiv hP heta + calc + (∑ i, ∑ k : Fin 2, + if (E ⟨i, k⟩).1 = j then 1 else 0) = + ∑ e : Σ _i : Fin n, Fin 2, + if (E e).1 = j then 1 else 0 := by + rw [Fintype.sum_sigma] + _ = ∑ e : Σ _j : Fin n, Fin 2, + if e.1 = j then 1 else 0 := + E.sum_comp (fun e ↦ if e.1 = j then 1 else 0) + _ = 2 := by + rw [Fintype.sum_sigma] + calc + (∑ x : Fin n, ∑ _y : Fin 2, + if x = j then 1 else 0) = + ∑ x : Fin n, if x = j then 2 else 0 := by + apply Finset.sum_congr rfl + intro x _ + by_cases hx : x = j <;> simp [hx] + _ = 2 := by + rw [Finset.sum_ite_eq' Finset.univ j] + simp + +/-- The stub completion retains every original heavy edge. -/ +theorem heavyEdge_mem_completedHeavyMultigraph + {n : ℕ} {eta : ℝ} {P : Matrix (Fin n) (Fin n) ℝ} + (hP : IsDoublyStochastic P) (heta : eta ≤ 1 / 10) + {i j : Fin n} (hij : j ∈ heavyCoordinates eta (P i)) : + ∃ k : Fin 2, (completedHeavyMultigraph hP heta).edge i k = j := by + let k := (heavyRowSlotEquiv hP heta i).symm (Sum.inl ⟨j, hij⟩) + refine ⟨k, ?_⟩ + simp [completedHeavyMultigraph, heavyCompletionSlotEquiv, k] + rfl + +/-- The paper's completed heavy graph admits a two-perfect-matching +presentation, and every original heavy edge belongs to one of those +matchings. -/ +theorem exists_heavyCompletion_twoMatchings + {n : ℕ} {eta : ℝ} {P : Matrix (Fin n) (Fin n) ℝ} + (hP : IsDoublyStochastic P) (heta : eta ≤ 1 / 10) : + ∃ f g : Equiv.Perm (Fin n), + ∀ i j, j ∈ heavyCoordinates eta (P i) → + j = f i ∨ j = g i := by + let K := completedHeavyMultigraph hP heta + obtain ⟨f, g, _, hcover⟩ := K.exists_twoMatching_decomposition + refine ⟨f, g, ?_⟩ + intro i j hij + obtain ⟨k, hk⟩ := heavyEdge_mem_completedHeavyMultigraph hP heta hij + rcases hcover i k with h | h + · exact Or.inl (hk.symm.trans h) + · exact Or.inr (hk.symm.trans h) + +/-- Entropic core of paper Lemma 9. Once the graph argument proves that each +encoding fiber has at most `2^m` assignments, the desired one-bit-per-cycle +bound follows without any further probabilistic input. -/ +theorem coreEncoding_of_fiber_bound + {Ω Y : Type*} [Fintype Ω] [Fintype Y] + [DecidableEq Ω] [DecidableEq Y] + {μ : Ω → ℝ} (hμ : IsProbabilityVector μ) (encode : Ω → Y) + (m : ℕ) + (hfiber : ∀ y, (Finset.univ.filter fun x ↦ encode x = y).card ≤ 2 ^ m) : + shannonEntropy μ ≤ + shannonEntropy (pushforwardMass μ encode) + m * Real.log 2 := by + have h := entropy_le_pushforward_add_log_fiberBound hμ encode (2 ^ m) + (Nat.one_le_pow m 2 (by norm_num)) hfiber + rw [Nat.cast_pow, Nat.cast_ofNat, Real.log_pow] at h + simpa [Nat.cast_ofNat] using h + +/-- Paper Lemma 9 for a completed two-regular bipartite multigraph presented +as the union of two perfect matchings. The nontrivial cycles of the +alternating row permutation are exactly the components with at least two +rows; doubled one-row components contribute no bit. -/ +theorem twoMatching_coreEncoding + {α : Type*} [Fintype α] [DecidableEq α] + {μ : Equiv.Perm α → ℝ} (hμ : IsProbabilityVector μ) + (f g : Equiv.Perm α) : + shannonEntropy μ ≤ + shannonEntropy + (pushforwardMass μ (twoMatchingEncoding f g)) + + (alternatingRowPerm f g).cycleFactorsFinset.card * Real.log 2 := by + apply coreEncoding_of_fiber_bound hμ (twoMatchingEncoding f g) + (alternatingRowPerm f g).cycleFactorsFinset.card + exact twoMatchingEncoding_fiber_card_le f g + +/-- Core-encoding entropy bound for an actual stub completion of the paper's +heavy graph. The witnesses `f,g` contain every heavy edge, and the cycle +count is therefore the number of nontrivial components of this completed +two-matching presentation. -/ +theorem exists_heavyCompletion_coreEncoding + {n : ℕ} {eta : ℝ} {P : Matrix (Fin n) (Fin n) ℝ} + (hP : IsDoublyStochastic P) (heta : eta ≤ 1 / 10) + {μ : Equiv.Perm (Fin n) → ℝ} (hμ : IsProbabilityVector μ) : + ∃ f g : Equiv.Perm (Fin n), + (∀ i j, j ∈ heavyCoordinates eta (P i) → + j = f i ∨ j = g i) ∧ + shannonEntropy μ ≤ + shannonEntropy + (pushforwardMass μ (twoMatchingEncoding f g)) + + (alternatingRowPerm f g).cycleFactorsFinset.card * Real.log 2 := by + obtain ⟨f, g, hheavy⟩ := exists_heavyCompletion_twoMatchings hP heta + exact ⟨f, g, hheavy, twoMatching_coreEncoding hμ f g⟩ + +/-- Contrapositive of explicit row stability: a bad row pays a definite +fourth-power deficit. -/ +theorem bad_row_deficit_lower + (hrow : AnariRezaeiRowInequality) + {n : ℕ} (hn : 2 ≤ n) {eta : ℝ} (heta : 0 ≤ eta) + {p : Fin n → ℝ} (hp : IsStrictProbabilityVector p) + (hbad : ¬ IsGoodRow eta p) : + (eta / 3074) ^ 4 < rowDeficit p := by + obtain ⟨a, b, hab, hdist⟩ := row_stability_explicit hrow hn p hp + have hetaDist : eta < halfHalfL1Distance p a b := by + by_contra h + exact hbad ⟨a, b, hab, le_of_not_gt h⟩ + have hroot : eta < 3074 * fourthRoot (rowDeficit p) := + hetaDist.trans_le hdist + have hd0 := hrow hn p hp.1 + have hbase : eta / 3074 < fourthRoot (rowDeficit p) := by + rw [div_lt_iff₀ (by norm_num : (0 : ℝ) < 3074)] + simpa [mul_comm] using hroot + have hpow : (eta / 3074) ^ 4 < fourthRoot (rowDeficit p) ^ 4 := + pow_lt_pow_left₀ hbase (div_nonneg heta (by norm_num)) (by omega) + rw [fourthRoot_pow_four hd0] at hpow + exact hpow + +/-- Summed form of paper (21): bad rows consume the row-deficit part of the +Bethe slack. -/ +theorem badRow_count_mul_le_sum_deficit + (hrow : AnariRezaeiRowInequality) + {n : ℕ} (hn : 2 ≤ n) {eta : ℝ} (heta : 0 ≤ eta) + {P : Matrix (Fin n) (Fin n) ℝ} + (hP : ∀ i, IsStrictProbabilityVector (P i)) : + ((badRows eta P).card : ℝ) * (eta / 3074) ^ 4 ≤ + ∑ i, rowDeficit (P i) := by + calc + ((badRows eta P).card : ℝ) * (eta / 3074) ^ 4 = + ∑ i ∈ badRows eta P, (eta / 3074) ^ 4 := by + rw [Finset.sum_const, nsmul_eq_mul] + _ ≤ ∑ i ∈ badRows eta P, rowDeficit (P i) := by + apply Finset.sum_le_sum + intro i hi + have hbad : ¬ IsGoodRow eta (P i) := by + simpa [badRows] using hi + exact (bad_row_deficit_lower hrow hn heta (hP i) hbad).le + _ ≤ ∑ i, rowDeficit (P i) := by + apply Finset.sum_le_sum_of_subset_of_nonneg (Finset.subset_univ _) + intro i _ _ + exact hrow hn (P i) (hP i).1 + +theorem badRow_count_le_slack + (hrow : AnariRezaeiRowInequality) + {n : ℕ} (hn : 2 ≤ n) {eta Delta : ℝ} (heta : 0 < eta) + {P : Matrix (Fin n) (Fin n) ℝ} + (hP : ∀ i, IsStrictProbabilityVector (P i)) + (hsum : (∑ i, rowDeficit (P i)) ≤ Delta) : + ((badRows eta P).card : ℝ) ≤ Delta / (eta / 3074) ^ 4 := by + have hcost := badRow_count_mul_le_sum_deficit hrow hn heta.le hP + apply (le_div_iff₀ (pow_pos (div_pos heta (by norm_num)) 4)).2 + exact hcost.trans hsum + +/-- Scalar assembly in paper Lemma 13. The two hypotheses are respectively +the entropy-score estimate (29) and the component accounting estimate (30). -/ +theorem robust_cycle_information_of_accounting + {D G components N bad n ω : ℝ} + (hω : 0 ≤ ω) (hG : G ≤ n) + (hscore : + G * (Real.log 2 / 2 - ω) - bad - components * Real.log 2 ≤ D) + (haccount : N / 6 - bad / 2 ≤ G / 2 - components) : + Real.log 2 / 6 * N - + (1 + Real.log 2 / 2) * bad - n * ω ≤ D := by + have hlog : 0 ≤ Real.log 2 := Real.log_nonneg (by norm_num) + have haccount' := mul_le_mul_of_nonneg_left haccount hlog + have hωG := mul_le_mul_of_nonneg_right hG hω + nlinarith + +/-- A component contributes one ambiguity bit exactly when it has at least +two rows. -/ +def nontrivialComponentCount (k : ℕ) : ℕ := + if 2 ≤ k then 1 else 0 + +/-- Good rows belonging to components with at least three rows. -/ +def longComponentGoodRows (k g : ℕ) : ℕ := + if 3 ≤ k then g else 0 + +/-- The component-by-component inequality behind paper (30). It includes +one-row doubled components explicitly: such a component must contain no good +row and contributes no ambiguity bit. -/ +theorem component_accounting + {C : Type*} [Fintype C] + (k g b : C → ℕ) + (hpos : ∀ c, 1 ≤ k c) + (hpartition : ∀ c, g c + b c = k c) + (hone : ∀ c, k c = 1 → g c = 0) : + (∑ c, (g c : ℝ)) / 2 - + ∑ c, (nontrivialComponentCount (k c) : ℝ) ≥ + (∑ c, (longComponentGoodRows (k c) (g c) : ℝ)) / 6 - + (∑ c, (b c : ℝ)) / 2 := by + have hpoint : ∀ c, + (longComponentGoodRows (k c) (g c) : ℝ) / 6 - (b c : ℝ) / 2 ≤ + (g c : ℝ) / 2 - (nontrivialComponentCount (k c) : ℝ) := by + intro c + have hpartR : (g c : ℝ) + b c = k c := by exact_mod_cast hpartition c + by_cases hk3 : 3 ≤ k c + · have hk2 : 2 ≤ k c := by omega + simp only [longComponentGoodRows, if_pos hk3, + nontrivialComponentCount, if_pos hk2, Nat.cast_one] + have hk3R : (3 : ℝ) ≤ k c := by exact_mod_cast hk3 + nlinarith + · have hklt : k c < 3 := by omega + have hkpos := hpos c + have hkcases : k c = 1 ∨ k c = 2 := by omega + rcases hkcases with hk1 | hk2eq + · have hgzero := hone c hk1 + simp [longComponentGoodRows, nontrivialComponentCount, hk1, hgzero] + positivity + · have hk2 : 2 ≤ k c := by omega + simp only [longComponentGoodRows, if_neg hk3, + nontrivialComponentCount, if_pos hk2, Nat.cast_zero, zero_div, + Nat.cast_one] + have hk2R : (k c : ℝ) = 2 := by exact_mod_cast hk2eq + nlinarith + calc + (∑ c, (longComponentGoodRows (k c) (g c) : ℝ)) / 6 - + (∑ c, (b c : ℝ)) / 2 = + ∑ c, ((longComponentGoodRows (k c) (g c) : ℝ) / 6 - + (b c : ℝ) / 2) := by + rw [Finset.sum_sub_distrib, Finset.sum_div, Finset.sum_div] + _ ≤ ∑ c, ((g c : ℝ) / 2 - + (nontrivialComponentCount (k c) : ℝ)) := + Finset.sum_le_sum fun c _ ↦ hpoint c + _ = (∑ c, (g c : ℝ)) / 2 - + ∑ c, (nontrivialComponentCount (k c) : ℝ) := by + rw [Finset.sum_sub_distrib, Finset.sum_div] + +/-- Clean two-row components contain at least `n - 2b - N` good rows, +hence half as many disjoint clean pairs. -/ +theorem clean_pair_count + {cleanPairs n bad long : ℕ} + (hrows : n - 2 * bad - long ≤ 2 * cleanPairs) : + ((n - 2 * bad - long : ℕ) : ℝ) / 2 ≤ cleanPairs := by + apply (div_le_iff₀ (by norm_num : (0 : ℝ) < 2)).2 + have hr : ((n - 2 * bad - long : ℕ) : ℝ) ≤ ((2 * cleanPairs : ℕ) : ℝ) := by + exact_mod_cast hrows + simpa [mul_comm] using hr + +/-- Markov-counting step used after (44): if every failed clean pair costs at +least `a`, total cost `R` permits at most `R/a` failures. -/ +theorem costly_pair_count + {failed : ℕ} {a R : ℝ} (ha : 0 < a) + (hcost : (failed : ℝ) * a ≤ R) : + (failed : ℝ) ≤ R / a := by + exact (le_div_iff₀ ha).2 hcost + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/DirectedCertificateValue.lean b/LeanPool/BeyondBethe/BeyondBethe/DirectedCertificateValue.lean new file mode 100644 index 0000000000..d93f2622dd --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/DirectedCertificateValue.lean @@ -0,0 +1,525 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.ExecutableTransfer +import LeanPool.BeyondBethe.BeyondBethe.DirectedPairCost +import Mathlib.Tactic + +/-! # Directed Certificate Value -/ + +open scoped BigOperators + +namespace BeyondBethe + +/-! +# Directed evaluation of the executable certificate + +At the nearby KKT matrix, the Bethe objective has a particularly simple +logarithmic form. It uses only the rational point, rational row and column +potentials, and logarithms of `X_ij` and `1-X_ij`; the irrational nearby +matrix never has to be materialized. +-/ + +def directedNearbyCoordinateLower + (τ x : ℚ) (p : ℕ) : ℚ := + scheduledLogLower (1 - x) p + + τ * x * scheduledLogLower x p + +def directedNearbyBetheLower {n : ℕ} + (τ : ℚ) (X : Matrix (Fin n) (Fin n) ℚ) + (R C : Fin n → ℚ) (p : ℕ) : ℚ := + (∑ i, R i) + (∑ j, C j) + + ∑ i, ∑ j, directedNearbyCoordinateLower τ (X i j) p + +theorem weighted_potentials_eq_sum + {n : ℕ} {X : Matrix (Fin n) (Fin n) ℝ} + (hX : IsDoublyStochastic X) (R C : Fin n → ℝ) : + (∑ i, ∑ j, X i j * (R i + C j)) = + (∑ i, R i) + ∑ j, C j := by + have hrow : (∑ i, ∑ j, X i j * R i) = ∑ i, R i := by + apply Finset.sum_congr rfl + intro i _ + rw [← Finset.sum_mul, hX.row_sum i, one_mul] + have hcol : (∑ i, ∑ j, X i j * C j) = ∑ j, C j := by + rw [Finset.sum_comm] + apply Finset.sum_congr rfl + intro j _ + rw [← Finset.sum_mul, hX.col_sum j, one_mul] + simp_rw [mul_add, Finset.sum_add_distrib] + rw [hrow, hcol] + +theorem nearbyBetheObjective_eq_logExpression + {n : ℕ} {τ : ℚ} {Xq : Matrix (Fin n) (Fin n) ℚ} + (R C : Fin n → ℚ) + (hX : IsDoublyStochastic (fun i j ↦ ((Xq i j : ℚ) : ℝ))) + (hXint : ∀ i, IsInteriorProbabilityVector + (fun j ↦ ((Xq i j : ℚ) : ℝ))) : + betheObjective + (nearbyKKTMatrix (τ : ℝ) + (fun i j ↦ ((Xq i j : ℚ) : ℝ)) + (fun i ↦ (R i : ℝ)) (fun j ↦ (C j : ℝ))) + (fun i j ↦ ((Xq i j : ℚ) : ℝ)) = + (∑ i, (R i : ℝ)) + (∑ j, (C j : ℝ)) + + ∑ i, ∑ j, + (Real.log ((1 - Xq i j : ℚ) : ℝ) + + (τ : ℝ) * (Xq i j : ℝ) * + Real.log (Xq i j : ℝ)) := by + let X : Matrix (Fin n) (Fin n) ℝ := + fun i j ↦ ((Xq i j : ℚ) : ℝ) + let Rr : Fin n → ℝ := fun i ↦ (R i : ℝ) + let Cr : Fin n → ℝ := fun j ↦ (C j : ℝ) + have hpos : ∀ i j, 0 < X i j := fun i j ↦ (hXint i).2 j |>.1 + have hlt : ∀ i j, X i j < 1 := fun i j ↦ (hXint i).2 j |>.2 + have hpot := weighted_potentials_eq_sum hX Rr Cr + rw [betheObjective] + change (∑ i, betheRowObjective + (nearbyKKTMatrix (τ : ℝ) X Rr Cr) X i) = _ + simp_rw [betheRowObjective, Real.negMulLog_def] + simp_rw [log_nearbyKKTMatrix hpos hlt] + change (∑ i, ∑ j, + (X i j * (Rr i + Cr j + (1 + (τ : ℝ)) * Real.log (X i j) + + Real.log (1 - X i j)) + + (-X i j * Real.log (X i j)) + + (1 - X i j) * Real.log (1 - X i j))) = _ + have hcoordinate : ∀ i j, + X i j * (Rr i + Cr j + (1 + (τ : ℝ)) * Real.log (X i j) + + Real.log (1 - X i j)) + + (-X i j * Real.log (X i j)) + + (1 - X i j) * Real.log (1 - X i j) = + X i j * (Rr i + Cr j) + + (Real.log (1 - X i j) + + (τ : ℝ) * X i j * Real.log (X i j)) := by + intro i j + ring + simp_rw [hcoordinate, Finset.sum_add_distrib] + rw [hpot] + simp only [X, Rr, Cr] + push_cast + ring + +theorem scheduledLogLower_error {q : ℚ} (hq : 0 < q) (p : ℕ) : + Real.log (q : ℝ) ≤ + (scheduledLogLower q p : ℝ) + ((1 / 2 : ℚ) ^ p : ℚ) := by + have hupper := log_le_scheduledLogUpper hq p + have hwidthQ := scheduledLog_width_le hq p + have hwidth : + (scheduledLogUpper q p : ℝ) - + (scheduledLogLower q p : ℝ) ≤ + (((1 / 2 : ℚ) ^ p : ℚ) : ℝ) := by + exact_mod_cast hwidthQ + linarith + +theorem directedNearbyCoordinateLower_bounds + {τ x : ℚ} (hτ0 : 0 ≤ τ) (hτ1 : τ ≤ 1) + (hx0 : 0 < x) (hx1 : x < 1) (p : ℕ) : + (directedNearbyCoordinateLower τ x p : ℝ) ≤ + Real.log ((1 - x : ℚ) : ℝ) + + (τ : ℝ) * (x : ℝ) * Real.log (x : ℝ) ∧ + Real.log ((1 - x : ℚ) : ℝ) + + (τ : ℝ) * (x : ℝ) * Real.log (x : ℝ) ≤ + (directedNearbyCoordinateLower τ x p : ℝ) + + 2 * (((1 / 2 : ℚ) ^ p : ℚ) : ℝ) := by + have hcx : 0 < 1 - x := sub_pos.mpr hx1 + have hloX := scheduledLogLower_le_log hx0 p + have hloC := scheduledLogLower_le_log hcx p + have herrX := scheduledLogLower_error hx0 p + have herrC := scheduledLogLower_error hcx p + norm_num only [Rat.cast_sub, Rat.cast_one] at hloC herrC + have hcoef0 : 0 ≤ (τ : ℝ) * (x : ℝ) := by positivity + have hcoef1 : (τ : ℝ) * (x : ℝ) ≤ 1 := by + have hτr : (0 : ℝ) ≤ (τ : ℝ) := by exact_mod_cast hτ0 + have hτr1 : (τ : ℝ) ≤ 1 := by exact_mod_cast hτ1 + have hxr : (0 : ℝ) ≤ (x : ℝ) := by exact_mod_cast hx0.le + have hxr1 : (x : ℝ) ≤ 1 := by exact_mod_cast hx1.le + nlinarith + rw [directedNearbyCoordinateLower] + push_cast + constructor + · exact add_le_add hloC (mul_le_mul_of_nonneg_left hloX hcoef0) + · have hscaled := mul_le_mul_of_nonneg_left herrX hcoef0 + have he : 0 ≤ ((((1 / 2 : ℚ) ^ p : ℚ)) : ℝ) := by positivity + have hcoefError : + ((τ : ℝ) * (x : ℝ)) * + ((((1 / 2 : ℚ) ^ p : ℚ)) : ℝ) ≤ + ((((1 / 2 : ℚ) ^ p : ℚ)) : ℝ) := + mul_le_of_le_one_left he hcoef1 + norm_num only [Rat.cast_pow, Rat.cast_div, Rat.cast_one, + Rat.cast_ofNat] at herrX herrC hscaled he hcoefError ⊢ + nlinarith + +theorem directedNearbyBetheLower_bounds + {n : ℕ} {τ : ℚ} {Xq : Matrix (Fin n) (Fin n) ℚ} + (R C : Fin n → ℚ) + (hτ0 : 0 ≤ τ) (hτ1 : τ ≤ 1) + (hX : IsDoublyStochastic (fun i j ↦ ((Xq i j : ℚ) : ℝ))) + (hXint : ∀ i, IsInteriorProbabilityVector + (fun j ↦ ((Xq i j : ℚ) : ℝ))) (p : ℕ) : + (directedNearbyBetheLower τ Xq R C p : ℝ) ≤ + betheObjective + (nearbyKKTMatrix (τ : ℝ) + (fun i j ↦ ((Xq i j : ℚ) : ℝ)) + (fun i ↦ (R i : ℝ)) (fun j ↦ (C j : ℝ))) + (fun i j ↦ ((Xq i j : ℚ) : ℝ)) ∧ + betheObjective + (nearbyKKTMatrix (τ : ℝ) + (fun i j ↦ ((Xq i j : ℚ) : ℝ)) + (fun i ↦ (R i : ℝ)) (fun j ↦ (C j : ℝ))) + (fun i j ↦ ((Xq i j : ℚ) : ℝ)) ≤ + (directedNearbyBetheLower τ Xq R C p : ℝ) + + 2 * (n : ℝ) ^ 2 * (((1 / 2 : ℚ) ^ p : ℚ) : ℝ) := by + let exactCoordinate : Fin n → Fin n → ℝ := fun i j ↦ + Real.log ((1 - Xq i j : ℚ) : ℝ) + + (τ : ℝ) * (Xq i j : ℝ) * Real.log (Xq i j : ℝ) + let lowerCoordinate : Fin n → Fin n → ℝ := fun i j ↦ + (directedNearbyCoordinateLower τ (Xq i j) p : ℝ) + have hcoord : ∀ i j, + lowerCoordinate i j ≤ exactCoordinate i j ∧ + exactCoordinate i j ≤ lowerCoordinate i j + + 2 * (((1 / 2 : ℚ) ^ p : ℚ) : ℝ) := by + intro i j + have hx0 : 0 < Xq i j := by + have h := (hXint i).2 j |>.1 + change 0 < ((Xq i j : ℚ) : ℝ) at h + exact Rat.cast_pos.mp h + have hx1 : Xq i j < 1 := by + have h := (hXint i).2 j |>.2 + change ((Xq i j : ℚ) : ℝ) < 1 at h + exact (Rat.cast_lt (K := ℝ)).mp (by simpa using h) + exact directedNearbyCoordinateLower_bounds hτ0 hτ1 hx0 hx1 p + have hsumLower : (∑ i, ∑ j, lowerCoordinate i j) ≤ + ∑ i, ∑ j, exactCoordinate i j := + Finset.sum_le_sum fun i _ ↦ Finset.sum_le_sum fun j _ ↦ (hcoord i j).1 + have hsumUpper : (∑ i, ∑ j, exactCoordinate i j) ≤ + (∑ i, ∑ j, lowerCoordinate i j) + + 2 * (n : ℝ) ^ 2 * (((1 / 2 : ℚ) ^ p : ℚ) : ℝ) := by + calc + (∑ i, ∑ j, exactCoordinate i j) ≤ + ∑ i, ∑ j, (lowerCoordinate i j + + 2 * (((1 / 2 : ℚ) ^ p : ℚ) : ℝ)) := + Finset.sum_le_sum fun i _ ↦ + Finset.sum_le_sum fun j _ ↦ (hcoord i j).2 + _ = (∑ i, ∑ j, lowerCoordinate i j) + + 2 * (n : ℝ) ^ 2 * (((1 / 2 : ℚ) ^ p : ℚ) : ℝ) := by + simp [Finset.sum_add_distrib] + ring + rw [nearbyBetheObjective_eq_logExpression R C hX hXint] + rw [directedNearbyBetheLower] + push_cast + have hsumLower' : + (∑ i, ∑ j, (directedNearbyCoordinateLower τ (Xq i j) p : ℝ)) ≤ + ∑ i, ∑ j, (Real.log ((1 - Xq i j : ℚ) : ℝ) + + (τ : ℝ) * (Xq i j : ℝ) * Real.log (Xq i j : ℝ)) := by + simpa only [lowerCoordinate, exactCoordinate] using hsumLower + have hsumUpper' : + (∑ i, ∑ j, (Real.log ((1 - Xq i j : ℚ) : ℝ) + + (τ : ℝ) * (Xq i j : ℝ) * Real.log (Xq i j : ℝ))) ≤ + (∑ i, ∑ j, + (directedNearbyCoordinateLower τ (Xq i j) p : ℝ)) + + 2 * (n : ℝ) ^ 2 * (((1 / 2 : ℚ) ^ p : ℚ) : ℝ) := by + simpa only [lowerCoordinate, exactCoordinate] using hsumUpper + norm_num only [Rat.cast_sub, Rat.cast_one, Rat.cast_pow, + Rat.cast_div, Rat.cast_ofNat] at hsumLower' hsumUpper' ⊢ + constructor <;> linarith + +/-- Fixed precision used for evaluating the final logarithmic certificate. +The additive fixedValue is deliberately generous; it is independent of the +input and absorbs the tiny hard-coded structural scale. -/ +def directedCertificatePrecision (n : ℕ) : ℕ := n + 400 + +@[simp] theorem directedCertificatePrecision_eq_pairCostPrecision (n : ℕ) : + directedCertificatePrecision n = directedPairCostPrecision n := by + rfl + +def explicitKKTError : ℚ := explicitCertifiedEpsilon / 32 + +def explicitLogEvaluationLoss : ℚ := explicitCertifiedEpsilon / 32 + +def explicitExpEvaluationLoss : ℚ := explicitCertifiedEpsilon / 32 + +theorem explicitKKTError_pos : 0 < explicitKKTError := by + exact div_pos explicitCertifiedEpsilon_pos (by norm_num) + +theorem explicitLogEvaluationLoss_pos : 0 < explicitLogEvaluationLoss := by + exact div_pos explicitCertifiedEpsilon_pos (by norm_num) + +theorem explicitExpEvaluationLoss_pos : 0 < explicitExpEvaluationLoss := by + exact div_pos explicitCertifiedEpsilon_pos (by norm_num) + +theorem dyadic_399_le_logEvaluationLoss : + (1 / 2 : ℝ) ^ 399 ≤ (explicitLogEvaluationLoss : ℝ) := by + have hq : (1 / 2 : ℚ) ^ 399 ≤ explicitLogEvaluationLoss := by + rw [explicitLogEvaluationLoss, explicitCertifiedEpsilon, + explicitCertifiedEpsilon_eq] + norm_num [explicitXi, explicitDelta, explicitEta, explicitRowRatio] + have hcast : (((1 / 2 : ℚ) ^ 399 : ℚ) : ℝ) ≤ + (explicitLogEvaluationLoss : ℝ) := Rat.cast_le.mpr hq + norm_num only [Rat.cast_pow, Rat.cast_div, Rat.cast_one, + Rat.cast_ofNat] at hcast + exact hcast + +theorem directedCertificatePrecision_error + {n : ℕ} (hn : 1 ≤ n) : + 2 * (n : ℝ) ^ 2 * + (((1 / 2 : ℚ) ^ directedCertificatePrecision n : ℚ) : ℝ) ≤ + (explicitLogEvaluationLoss : ℝ) * n := by + have hnat : n ≤ 2 ^ n := n.lt_two_pow_self.le + have hnatR : (n : ℝ) ≤ (2 : ℝ) ^ n := by exact_mod_cast hnat + have hpowpos : 0 < (2 : ℝ) ^ n := by positivity + have hratio : (n : ℝ) * (1 / 2 : ℝ) ^ n ≤ 1 := by + simp only [one_div, inv_pow] + rw [mul_inv_le_iff₀ hpowpos] + simpa using hnatR + have hconst := dyadic_399_le_logEvaluationLoss + rw [directedCertificatePrecision, pow_add] + norm_num only [Rat.cast_mul, Rat.cast_pow, Rat.cast_div, + Rat.cast_one, Rat.cast_ofNat] + have hnR : (0 : ℝ) ≤ n := by positivity + have hshift : 2 * (1 / 2 : ℝ) ^ 400 = (1 / 2 : ℝ) ^ 399 := by + rw [show 400 = 399 + 1 by omega, pow_succ] + ring + have hratioScaled : + (n : ℝ) * ((n : ℝ) * (1 / 2 : ℝ) ^ n) * + (1 / 2 : ℝ) ^ 399 ≤ + (n : ℝ) * 1 * (1 / 2 : ℝ) ^ 399 := by + exact mul_le_mul_of_nonneg_right + (mul_le_mul_of_nonneg_left hratio hnR) + (pow_nonneg (by norm_num) _) + calc + 2 * (n : ℝ) ^ 2 * + ((1 / 2 : ℝ) ^ n * (1 / 2 : ℝ) ^ 400) = + (n : ℝ) * + ((n : ℝ) * (1 / 2 : ℝ) ^ n) * + (1 / 2 : ℝ) ^ 399 := by + rw [← hshift] + ring + _ ≤ (n : ℝ) * 1 * (1 / 2 : ℝ) ^ 399 := hratioScaled + _ = (n : ℝ) * (1 / 2 : ℝ) ^ 399 := by ring + _ ≤ (n : ℝ) * (explicitLogEvaluationLoss : ℝ) := + mul_le_mul_of_nonneg_left hconst hnR + _ = (explicitLogEvaluationLoss : ℝ) * n := by ring + +/-- Rational lower endpoint for the complete nearby certificate logarithm. -/ +def explicitDirectedCertificateLog {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℚ) : ℚ := + directedNearbyBetheLower (explicitRegularizationScale n) X R C + (directedCertificatePrecision n) + + explicitCertifiedMatchingGain X - explicitKKTError * n + +/-- Fully rational positive certificate computed from rational approximate-KKT +data. -/ +def explicitDirectedCertificateValue {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℚ) : ℚ := + rationalExpLower (explicitDirectedCertificateLog X R C) + (explicitExpEvaluationLoss * n) + +theorem explicitDirectedCertificateLog_bounds + {n : ℕ} (hn : 2 ≤ n) + {X : Matrix (Fin n) (Fin n) ℚ} (R C : Fin n → ℚ) + (hX : IsDoublyStochastic (fun i j ↦ ((X i j : ℚ) : ℝ))) + (hXint : ∀ i, IsInteriorProbabilityVector + (fun j ↦ ((X i j : ℚ) : ℝ))) : + (explicitDirectedCertificateLog X R C : ℝ) ≤ + executableNearbyCertificateLog (explicitKKTError : ℝ) X + (fun i ↦ (R i : ℝ)) (fun j ↦ (C j : ℝ)) ∧ + executableNearbyCertificateLog (explicitKKTError : ℝ) X + (fun i ↦ (R i : ℝ)) (fun j ↦ (C j : ℝ)) ≤ + (explicitDirectedCertificateLog X R C : ℝ) + + (explicitLogEvaluationLoss : ℝ) * n := by + have hτ0 : 0 ≤ explicitRegularizationScale n := + (explicitRegularizationScale_pos (show 0 < n by omega)).le + have hτ1 : explicitRegularizationScale n ≤ 1 := + explicitRegularizationScale_le_one (show 1 ≤ n by omega) + have hb := directedNearbyBetheLower_bounds R C hτ0 hτ1 hX hXint + (directedCertificatePrecision n) + have herr := directedCertificatePrecision_error (show 1 ≤ n by omega) + rw [explicitDirectedCertificateLog, executableNearbyCertificateLog] + norm_num only [Rat.cast_add, Rat.cast_sub, Rat.cast_mul, Rat.cast_natCast] + constructor <;> dsimp only <;> linarith + +theorem explicitDirectedCertificateValue_pos + {n : ℕ} (hn : 1 ≤ n) + (X : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℚ) : + 0 < (explicitDirectedCertificateValue X R C : ℝ) := by + have hlossQ : 0 < explicitExpEvaluationLoss * n := + mul_pos explicitExpEvaluationLoss_pos (by exact_mod_cast hn) + have h := rationalExpLower_bounds + (s := explicitDirectedCertificateLog X R C) hlossQ + exact (Real.exp_pos _).trans_le h.1 + +/-- The fully rational certificate inherits the positive-matrix estimate. +All three numerical losses are explicit: approximate KKT transfer, directed +logarithms, and directed exponentiation. -/ +theorem explicitDirectedCertificate_twoSided + (stableCoefficient : AnariOveisGharanStableCoefficient.{0}) + {n : ℕ} (hn : 2 ≤ n) + {A : Matrix (Fin n) (Fin n) ℝ} + {X : Matrix (Fin n) (Fin n) ℚ} {R C : Fin n → ℚ} + (hA : Matrix.Positive A) + (hX : IsDoublyStochastic (fun i j ↦ ((X i j : ℚ) : ℝ))) + (hXint : ∀ i, IsInteriorProbabilityVector + (fun j ↦ ((X i j : ℚ) : ℝ))) + (happrox : HasApproximateLogKKT (explicitKKTError : ℝ) + (explicitRegularizationScale n : ℝ) A + (fun i j ↦ ((X i j : ℚ) : ℝ)) + (fun i ↦ (R i : ℝ)) (fun j ↦ (C j : ℝ))) : + (explicitDirectedCertificateValue X R C : ℝ) ≤ + Matrix.permanent A ∧ + Matrix.permanent A ≤ + (preSmoothingBase (explicitCertifiedEpsilon : ℝ)) ^ n * + (explicitDirectedCertificateValue X R C : ℝ) := by + let qlog : ℝ := (explicitDirectedCertificateLog X R C : ℝ) + let exactLog : ℝ := executableNearbyCertificateLog + (explicitKKTError : ℝ) X + (fun i ↦ (R i : ℝ)) (fun j ↦ (C j : ℝ)) + let qvalue : ℝ := (explicitDirectedCertificateValue X R C : ℝ) + let L : ℝ := executableNearbyCertificateValue + (explicitKKTError : ℝ) X + (fun i ↦ (R i : ℝ)) (fun j ↦ (C j : ℝ)) + have hlog := explicitDirectedCertificateLog_bounds hn R C hX hXint + have hlog' : qlog ≤ exactLog ∧ + exactLog ≤ qlog + (explicitLogEvaluationLoss : ℝ) * n := by + simpa only [qlog, exactLog] using hlog + have hlossQ : 0 < explicitExpEvaluationLoss * n := + mul_pos explicitExpEvaluationLoss_pos (by exact_mod_cast (show 0 < n by omega)) + have hexpQ := rationalExpLower_bounds + (s := explicitDirectedCertificateLog X R C) hlossQ + have hexp : Real.exp + (qlog - (explicitExpEvaluationLoss : ℝ) * n) ≤ qvalue ∧ + qvalue ≤ Real.exp qlog := by + simpa only [qlog, qvalue, explicitDirectedCertificateValue, + Rat.cast_mul, Rat.cast_natCast] using hexpQ + have htransfer := executableNearbyCertificate_twoSided + stableCoefficient hn hA hX hXint happrox + have htransfer' : L ≤ Matrix.permanent A ∧ + Matrix.permanent A ≤ + (Real.sqrt 2 * Real.exp + (-((explicitCertifiedEpsilon : ℝ) - + 2 * (explicitKKTError : ℝ)))) ^ n * L := by + simpa only [L, explicitCertifiedEpsilon] using htransfer + have hL : L = Real.exp exactLog := by + rfl + constructor + · have hqL : qvalue ≤ L := by + rw [hL] + exact hexp.2.trans (Real.exp_le_exp.mpr hlog'.1) + exact hqL.trans htransfer'.1 + · have hLq : L ≤ + (Real.exp (explicitLogEvaluationLoss : ℝ) * + Real.exp (explicitExpEvaluationLoss : ℝ)) ^ n * qvalue := by + rw [hL] + have hfirst : Real.exp exactLog ≤ + (Real.exp (explicitLogEvaluationLoss : ℝ)) ^ n * + Real.exp qlog := by + calc + Real.exp exactLog ≤ Real.exp + (qlog + (explicitLogEvaluationLoss : ℝ) * n) := + Real.exp_le_exp.mpr hlog'.2 + _ = (Real.exp (explicitLogEvaluationLoss : ℝ)) ^ n * + Real.exp qlog := by + rw [Real.exp_add] + rw [show (explicitLogEvaluationLoss : ℝ) * (n : ℝ) = + (n : ℝ) * (explicitLogEvaluationLoss : ℝ) by ring, + Real.exp_nat_mul] + ring + have hsecond : Real.exp qlog ≤ + (Real.exp (explicitExpEvaluationLoss : ℝ)) ^ n * qvalue := by + have hfactor0 : 0 ≤ + (Real.exp (explicitExpEvaluationLoss : ℝ)) ^ n := + pow_nonneg (Real.exp_pos _).le n + have hscaled := mul_le_mul_of_nonneg_left hexp.1 hfactor0 + have hid : (Real.exp (explicitExpEvaluationLoss : ℝ)) ^ n * + Real.exp (qlog - (explicitExpEvaluationLoss : ℝ) * n) = + Real.exp qlog := by + rw [← Real.exp_nat_mul, ← Real.exp_add] + congr 1 + ring + rwa [hid] at hscaled + calc + Real.exp exactLog ≤ + (Real.exp (explicitLogEvaluationLoss : ℝ)) ^ n * + Real.exp qlog := hfirst + _ ≤ (Real.exp (explicitLogEvaluationLoss : ℝ)) ^ n * + ((Real.exp (explicitExpEvaluationLoss : ℝ)) ^ n * qvalue) := + mul_le_mul_of_nonneg_left hsecond + (pow_nonneg (Real.exp_pos _).le n) + _ = (Real.exp (explicitLogEvaluationLoss : ℝ) * + Real.exp (explicitExpEvaluationLoss : ℝ)) ^ n * qvalue := by + rw [mul_pow] + ring + have hraw := htransfer'.2.trans + (mul_le_mul_of_nonneg_left hLq + (pow_nonneg (mul_nonneg (Real.sqrt_nonneg _) + (Real.exp_pos _).le) n)) + have hbase : + (Real.sqrt 2 * Real.exp + (-((explicitCertifiedEpsilon : ℝ) - + 2 * (explicitKKTError : ℝ)))) * + (Real.exp (explicitLogEvaluationLoss : ℝ) * + Real.exp (explicitExpEvaluationLoss : ℝ)) ≤ + preSmoothingBase (explicitCertifiedEpsilon : ℝ) := by + rw [preSmoothingBase] + have hε0 : 0 < (explicitCertifiedEpsilon : ℝ) := by + exact_mod_cast explicitCertifiedEpsilon_pos + have hsqrt : 0 < Real.sqrt 2 := Real.sqrt_pos.2 (by norm_num) + have hexpMono : + Real.exp + (-((explicitCertifiedEpsilon : ℝ) - + 2 * (explicitKKTError : ℝ)) + + (explicitLogEvaluationLoss : ℝ) + + (explicitExpEvaluationLoss : ℝ)) ≤ + Real.exp (-(explicitCertifiedEpsilon : ℝ) + + (explicitCertifiedEpsilon : ℝ) / 4) := by + apply Real.exp_le_exp.mpr + norm_num [explicitKKTError, explicitLogEvaluationLoss, + explicitExpEvaluationLoss] + nlinarith + calc + Real.sqrt 2 * Real.exp + (-((explicitCertifiedEpsilon : ℝ) - + 2 * (explicitKKTError : ℝ))) * + (Real.exp (explicitLogEvaluationLoss : ℝ) * + Real.exp (explicitExpEvaluationLoss : ℝ)) = + Real.sqrt 2 * Real.exp + (-((explicitCertifiedEpsilon : ℝ) - + 2 * (explicitKKTError : ℝ)) + + (explicitLogEvaluationLoss : ℝ) + + (explicitExpEvaluationLoss : ℝ)) := by + rw [← Real.exp_add + (explicitLogEvaluationLoss : ℝ) + (explicitExpEvaluationLoss : ℝ)] + rw [show Real.sqrt 2 * Real.exp + (-((explicitCertifiedEpsilon : ℝ) - + 2 * (explicitKKTError : ℝ))) * + Real.exp ((explicitLogEvaluationLoss : ℝ) + + (explicitExpEvaluationLoss : ℝ)) = + Real.sqrt 2 * + (Real.exp (-((explicitCertifiedEpsilon : ℝ) - + 2 * (explicitKKTError : ℝ))) * + Real.exp ((explicitLogEvaluationLoss : ℝ) + + (explicitExpEvaluationLoss : ℝ))) by ring] + rw [← Real.exp_add] + congr 2 + ring + _ ≤ Real.sqrt 2 * Real.exp + (-(explicitCertifiedEpsilon : ℝ) + + (explicitCertifiedEpsilon : ℝ) / 4) := + mul_le_mul_of_nonneg_left hexpMono hsqrt.le + have hbasePow := pow_le_pow_left₀ + (mul_nonneg (mul_nonneg (Real.sqrt_nonneg _) (Real.exp_pos _).le) + (mul_nonneg (Real.exp_pos _).le (Real.exp_pos _).le)) hbase n + calc + Matrix.permanent A ≤ + ((Real.sqrt 2 * Real.exp + (-((explicitCertifiedEpsilon : ℝ) - + 2 * (explicitKKTError : ℝ)))) * + (Real.exp (explicitLogEvaluationLoss : ℝ) * + Real.exp (explicitExpEvaluationLoss : ℝ))) ^ n * qvalue := by + simpa [mul_pow, mul_assoc] using hraw + _ ≤ (preSmoothingBase (explicitCertifiedEpsilon : ℝ)) ^ n * qvalue := + mul_le_mul_of_nonneg_right hbasePow + (explicitDirectedCertificateValue_pos (show 1 ≤ n by omega) X R C).le + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/DirectedElementary.lean b/LeanPool/BeyondBethe/BeyondBethe/DirectedElementary.lean new file mode 100644 index 0000000000..5a1babb5e1 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/DirectedElementary.lean @@ -0,0 +1,887 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.AlgorithmicSpec +import Mathlib.Analysis.SpecialFunctions.Log.Deriv +import Mathlib.Data.Nat.Log +import Mathlib.Data.Rat.Floor + +/-! # Directed Elementary -/ + +open scoped BigOperators + +namespace BeyondBethe + +/-- The first `N` terms of twice the inverse-hyperbolic-tangent series, +computed exactly over the rationals. -/ +def rationalLogSeries (x : ℚ) (N : ℕ) : ℚ := + 2 * ∑ k ∈ Finset.range N, x ^ (2 * k + 1) / (2 * k + 1) + +/-- A rational upper bound for the omitted tail when `0 ≤ x < 1`. -/ +def rationalLogSeriesError (x : ℚ) (N : ℕ) : ℚ := + 2 * (x ^ (2 * N + 1) / (1 - x ^ 2)) + +theorem cast_rationalLogSeries (x : ℚ) (N : ℕ) : + ((rationalLogSeries x N : ℚ) : ℝ) = + 2 * ∑ k ∈ Finset.range N, + (x : ℝ) ^ (2 * k + 1) / (2 * k + 1) := by + simp [rationalLogSeries] + +theorem cast_rationalLogSeriesError (x : ℚ) (N : ℕ) : + ((rationalLogSeriesError x N : ℚ) : ℝ) = + 2 * ((x : ℝ) ^ (2 * N + 1) / (1 - (x : ℝ) ^ 2)) := by + simp [rationalLogSeriesError] + +/-- The range-reduction parameter taking `y ∈ [1,2]` to `x ∈ [0,1/3]`. -/ +def rationalLogUnitParameter (y : ℚ) : ℚ := (y - 1) / (y + 1) + +theorem rationalLogUnitParameter_nonneg {y : ℚ} (hy : 1 ≤ y) : + 0 ≤ rationalLogUnitParameter y := by + exact div_nonneg (sub_nonneg.mpr hy) (by linarith) + +theorem rationalLogUnitParameter_lt_one {y : ℚ} (hy : 1 ≤ y) : + rationalLogUnitParameter y < 1 := by + rw [rationalLogUnitParameter, div_lt_one (by linarith)] + linarith + +theorem rationalLogUnitParameter_le_third {y : ℚ} + (hy1 : 1 ≤ y) (hy2 : y ≤ 2) : + rationalLogUnitParameter y ≤ 1 / 3 := by + rw [rationalLogUnitParameter, div_le_iff₀ (by linarith)] + linarith + +theorem rationalLogUnitParameter_ratio {y : ℚ} (hy : 1 ≤ y) : + (1 + rationalLogUnitParameter y) / + (1 - rationalLogUnitParameter y) = y := by + have hden : y + 1 ≠ 0 := by linarith + rw [rationalLogUnitParameter] + field_simp [hden] + ring + +/-- Directed lower approximation to `log y` for a rational `y ∈ [1,2]`. -/ +def directedLogUnitLower (y : ℚ) (N : ℕ) : ℚ := + rationalLogSeries (rationalLogUnitParameter y) N + +/-- Directed upper approximation to `log y` for a rational `y ∈ [1,2]`. -/ +def directedLogUnitUpper (y : ℚ) (N : ℕ) : ℚ := + rationalLogSeries (rationalLogUnitParameter y) N + + rationalLogSeriesError (rationalLogUnitParameter y) N + +theorem directedLogUnitLower_le_log {y : ℚ} (hy : 1 ≤ y) (N : ℕ) : + ((directedLogUnitLower y N : ℚ) : ℝ) ≤ Real.log (y : ℝ) := by + let x := rationalLogUnitParameter y + have hx0q : 0 ≤ x := rationalLogUnitParameter_nonneg hy + have hx1q : x < 1 := rationalLogUnitParameter_lt_one hy + have hx0 : 0 ≤ (x : ℝ) := by exact_mod_cast hx0q + have hx1 : (x : ℝ) < 1 := by exact_mod_cast hx1q + have h := Real.sum_range_le_log_div hx0 hx1 N + have hratioq := rationalLogUnitParameter_ratio hy + have hratio : (1 + (x : ℝ)) / (1 - (x : ℝ)) = (y : ℝ) := by + exact_mod_cast hratioq + rw [hratio] at h + rw [directedLogUnitLower, cast_rationalLogSeries] + dsimp only [x] at h ⊢ + linarith + +theorem log_le_directedLogUnitUpper {y : ℚ} (hy : 1 ≤ y) (N : ℕ) : + Real.log (y : ℝ) ≤ ((directedLogUnitUpper y N : ℚ) : ℝ) := by + let x := rationalLogUnitParameter y + have hx0q : 0 ≤ x := rationalLogUnitParameter_nonneg hy + have hx1q : x < 1 := rationalLogUnitParameter_lt_one hy + have hx0 : 0 ≤ (x : ℝ) := by exact_mod_cast hx0q + have hx1 : (x : ℝ) < 1 := by exact_mod_cast hx1q + have h := Real.log_div_le_sum_range_add hx0 hx1 N + have hratioq := rationalLogUnitParameter_ratio hy + have hratio : (1 + (x : ℝ)) / (1 - (x : ℝ)) = (y : ℝ) := by + exact_mod_cast hratioq + rw [hratio] at h + rw [directedLogUnitUpper, Rat.cast_add, cast_rationalLogSeries, + cast_rationalLogSeriesError] + dsimp only [x] at h ⊢ + linarith + +theorem directedLogUnit_width {y : ℚ} (N : ℕ) : + directedLogUnitUpper y N - directedLogUnitLower y N = + rationalLogSeriesError (rationalLogUnitParameter y) N := by + simp [directedLogUnitUpper, directedLogUnitLower] + +/-- The dyadic scale obtained by comparing the leading binary positions of a +positive rational's numerator and denominator. -/ +def rationalBinaryScale (q : ℚ) : ℚ := + (2 : ℚ) ^ Nat.log 2 q.num.natAbs / (2 : ℚ) ^ Nat.log 2 q.den + +/-- The residual after dyadic range reduction. -/ +def rationalBinaryResidual (q : ℚ) : ℚ := q / rationalBinaryScale q + +theorem positive_rational_num_natAbs_ne_zero {q : ℚ} (hq : 0 < q) : + q.num.natAbs ≠ 0 := by + have hnum : 0 < q.num := Rat.num_pos.mpr hq + exact Int.natAbs_ne_zero.mpr hnum.ne' + +theorem rationalBinaryResidual_formula {q : ℚ} (hq : 0 < q) : + rationalBinaryResidual q = + ((q.num.natAbs : ℚ) * (2 : ℚ) ^ Nat.log 2 q.den) / + ((q.den : ℚ) * (2 : ℚ) ^ Nat.log 2 q.num.natAbs) := by + have hnum : 0 < q.num := Rat.num_pos.mpr hq + have hnumabs : (q.num.natAbs : ℤ) = q.num := + Int.natAbs_of_nonneg hnum.le + have hden : (q.den : ℚ) ≠ 0 := by positivity + have hpowNum : (2 : ℚ) ^ Nat.log 2 q.num.natAbs ≠ 0 := by positivity + have hpowDen : (2 : ℚ) ^ Nat.log 2 q.den ≠ 0 := by positivity + have hqrep : q = (q.num.natAbs : ℚ) / (q.den : ℚ) := by + calc + q = (q.num : ℚ) / (q.den : ℚ) := (Rat.num_div_den q).symm + _ = (q.num.natAbs : ℚ) / (q.den : ℚ) := by + congr 1 + change (q.num : ℚ) = ((q.num.natAbs : ℤ) : ℚ) + rw [hnumabs] + rw [rationalBinaryResidual, rationalBinaryScale] + nth_rw 1 [hqrep] + field_simp [hden, hpowNum, hpowDen] + +theorem rationalBinaryResidual_gt_half {q : ℚ} (hq : 0 < q) : + 1 / 2 < rationalBinaryResidual q := by + let a := q.num.natAbs + let b := q.den + let A : ℚ := (2 : ℚ) ^ Nat.log 2 a + let B : ℚ := (2 : ℚ) ^ Nat.log 2 b + have ha0 : a ≠ 0 := positive_rational_num_natAbs_ne_zero hq + have hb0 : b ≠ 0 := q.den_nz + have hA : A ≤ (a : ℚ) := by + dsimp only [A] + exact_mod_cast Nat.pow_log_le_self 2 ha0 + have hB : B ≤ (b : ℚ) := by + dsimp only [B] + exact_mod_cast Nat.pow_log_le_self 2 hb0 + have haUpper : (a : ℚ) < 2 * A := by + have := Nat.lt_pow_succ_log_self (by norm_num : 1 < 2) a + dsimp only [A] + exact_mod_cast (by simpa [pow_succ, mul_comm] using this) + have hbUpper : (b : ℚ) < 2 * B := by + have := Nat.lt_pow_succ_log_self (by norm_num : 1 < 2) b + dsimp only [B] + exact_mod_cast (by simpa [pow_succ, mul_comm] using this) + have hApos : 0 < A := by positivity + have hBpos : 0 < B := by positivity + have habpos : 0 < (b : ℚ) * A := mul_pos (by positivity) hApos + have hprod : (b : ℚ) * A < 2 * ((a : ℚ) * B) := calc + (b : ℚ) * A < (2 * B) * A := + mul_lt_mul_of_pos_right hbUpper hApos + _ ≤ (2 * B) * a := + mul_le_mul_of_nonneg_left hA (mul_nonneg (by norm_num) hBpos.le) + _ = 2 * (a * B) := by ring + rw [rationalBinaryResidual_formula hq] + change 1 / 2 < (a * B) / (b * A) + rw [div_lt_div_iff₀ (by norm_num : (0 : ℚ) < 2) habpos] + simpa [mul_assoc, mul_left_comm, mul_comm] using hprod + +theorem rationalBinaryResidual_lt_two {q : ℚ} (hq : 0 < q) : + rationalBinaryResidual q < 2 := by + let a := q.num.natAbs + let b := q.den + let A : ℚ := (2 : ℚ) ^ Nat.log 2 a + let B : ℚ := (2 : ℚ) ^ Nat.log 2 b + have ha0 : a ≠ 0 := positive_rational_num_natAbs_ne_zero hq + have hb0 : b ≠ 0 := q.den_nz + have hA : A ≤ (a : ℚ) := by + dsimp only [A] + exact_mod_cast Nat.pow_log_le_self 2 ha0 + have hB : B ≤ (b : ℚ) := by + dsimp only [B] + exact_mod_cast Nat.pow_log_le_self 2 hb0 + have haUpper : (a : ℚ) < 2 * A := by + have := Nat.lt_pow_succ_log_self (by norm_num : 1 < 2) a + dsimp only [A] + exact_mod_cast (by simpa [pow_succ, mul_comm] using this) + have hbUpper : (b : ℚ) < 2 * B := by + have := Nat.lt_pow_succ_log_self (by norm_num : 1 < 2) b + dsimp only [B] + exact_mod_cast (by simpa [pow_succ, mul_comm] using this) + have hApos : 0 < A := by positivity + have hBpos : 0 < B := by positivity + have habpos : 0 < (b : ℚ) * A := mul_pos (by positivity) hApos + have hprod : (a : ℚ) * B < 2 * ((b : ℚ) * A) := calc + (a : ℚ) * B < (2 * A) * B := + mul_lt_mul_of_pos_right haUpper hBpos + _ ≤ (2 * A) * b := + mul_le_mul_of_nonneg_left hB (mul_nonneg (by norm_num) hApos.le) + _ = 2 * (b * A) := by ring + rw [rationalBinaryResidual_formula hq] + change (a * B) / (b * A) < 2 + rw [div_lt_iff₀ habpos] + simpa using hprod + +theorem rationalBinaryResidual_pos {q : ℚ} (hq : 0 < q) : + 0 < rationalBinaryResidual q := + (by norm_num : (0 : ℚ) < 1 / 2).trans (rationalBinaryResidual_gt_half hq) + +/-- If the residual is below one, inversion moves it into the unit interval; +otherwise it is already there. -/ +def rationalLogUnit (q : ℚ) : ℚ := + if rationalBinaryResidual q < 1 then + (rationalBinaryResidual q)⁻¹ + else rationalBinaryResidual q + +theorem rationalLogUnit_bounds {q : ℚ} (hq : 0 < q) : + 1 ≤ rationalLogUnit q ∧ rationalLogUnit q < 2 := by + have hr0 := rationalBinaryResidual_pos hq + have hrHalf := rationalBinaryResidual_gt_half hq + have hrTwo := rationalBinaryResidual_lt_two hq + rw [rationalLogUnit] + split_ifs with hr + · constructor + · exact (one_le_inv₀ hr0).2 hr.le + · have hinv := (inv_lt_inv₀ hr0 (by norm_num : (0 : ℚ) < 1 / 2)).2 hrHalf + norm_num at hinv ⊢ + exact hinv + · exact ⟨le_of_not_gt hr, hrTwo⟩ + +/-- The signed leading-bit displacement between numerator and denominator. -/ +def rationalBinaryExponent (q : ℚ) : ℤ := + (Nat.log 2 q.num.natAbs : ℤ) - (Nat.log 2 q.den : ℤ) + +theorem rationalBinaryScale_pos (q : ℚ) : 0 < rationalBinaryScale q := by + unfold rationalBinaryScale + positivity + +theorem log_rationalBinaryScale (q : ℚ) : + Real.log (rationalBinaryScale q : ℝ) = + (rationalBinaryExponent q : ℝ) * Real.log 2 := by + have hnum : ((2 : ℝ) ^ Nat.log 2 q.num.natAbs) ≠ 0 := by positivity + have hden : ((2 : ℝ) ^ Nat.log 2 q.den) ≠ 0 := by positivity + rw [rationalBinaryScale, Rat.cast_div, Rat.cast_pow, Rat.cast_pow, + Rat.cast_ofNat, Real.log_div hnum hden, Real.log_pow, Real.log_pow] + simp only [rationalBinaryExponent, Int.cast_sub, Int.cast_natCast] + ring + +theorem log_rational_eq_scale_add_residual {q : ℚ} (hq : 0 < q) : + Real.log (q : ℝ) = + (rationalBinaryExponent q : ℝ) * Real.log 2 + + Real.log (rationalBinaryResidual q : ℝ) := by + have hsQ := rationalBinaryScale_pos q + have hrQ := rationalBinaryResidual_pos hq + have hs : 0 < (rationalBinaryScale q : ℝ) := by exact_mod_cast hsQ + have hr : 0 < (rationalBinaryResidual q : ℝ) := by exact_mod_cast hrQ + have hqeqQ : q = rationalBinaryScale q * rationalBinaryResidual q := by + rw [rationalBinaryResidual] + field_simp [(rationalBinaryScale_pos q).ne'] + have hqeq : (q : ℝ) = + (rationalBinaryScale q : ℝ) * (rationalBinaryResidual q : ℝ) := by + exact_mod_cast hqeqQ + rw [hqeq, Real.log_mul hs.ne' hr.ne', log_rationalBinaryScale] + +theorem log_residual_eq_signed_log_unit {q : ℚ} (hq : 0 < q) : + Real.log (rationalBinaryResidual q : ℝ) = + if rationalBinaryResidual q < 1 then + -Real.log (rationalLogUnit q : ℝ) + else Real.log (rationalLogUnit q : ℝ) := by + have hrQ := rationalBinaryResidual_pos hq + have hr : (rationalBinaryResidual q : ℝ) ≠ 0 := by + exact_mod_cast hrQ.ne' + rw [rationalLogUnit] + split_ifs with h + · simp [Rat.cast_inv, Real.log_inv] + · rfl + +/-- Directed multiplication by an integer: for a negative coefficient the +lower endpoint uses the upper approximation. -/ +def directedIntMulLower (k : ℤ) (lo hi : ℚ) : ℚ := + if 0 ≤ k then (k : ℚ) * lo else (k : ℚ) * hi + +/-- Directed multiplication by an integer: for a negative coefficient the +upper endpoint uses the lower approximation. -/ +def directedIntMulUpper (k : ℤ) (lo hi : ℚ) : ℚ := + if 0 ≤ k then (k : ℚ) * hi else (k : ℚ) * lo + +theorem directedIntMulLower_le {k : ℤ} {lo hi : ℚ} {x : ℝ} + (hlo : (lo : ℝ) ≤ x) (hhi : x ≤ (hi : ℝ)) : + ((directedIntMulLower k lo hi : ℚ) : ℝ) ≤ (k : ℝ) * x := by + rw [directedIntMulLower] + split_ifs with hk + · push_cast + exact mul_le_mul_of_nonneg_left hlo (by exact_mod_cast hk) + · push_cast + exact mul_le_mul_of_nonpos_left hhi (by exact_mod_cast (le_of_not_ge hk)) + +theorem le_directedIntMulUpper {k : ℤ} {lo hi : ℚ} {x : ℝ} + (hlo : (lo : ℝ) ≤ x) (hhi : x ≤ (hi : ℝ)) : + (k : ℝ) * x ≤ ((directedIntMulUpper k lo hi : ℚ) : ℝ) := by + rw [directedIntMulUpper] + split_ifs with hk + · push_cast + exact mul_le_mul_of_nonneg_left hhi (by exact_mod_cast hk) + · push_cast + exact mul_le_mul_of_nonpos_left hlo (by exact_mod_cast (le_of_not_ge hk)) + +/-- Rational lower bound on `log q` for every positive rational `q`. -/ +def directedLogLower (q : ℚ) (N : ℕ) : ℚ := + let kPart := directedIntMulLower (rationalBinaryExponent q) + (directedLogUnitLower 2 N) (directedLogUnitUpper 2 N) + let y := rationalLogUnit q + kPart + if rationalBinaryResidual q < 1 then + -directedLogUnitUpper y N + else directedLogUnitLower y N + +/-- Rational upper bound on `log q` for every positive rational `q`. -/ +def directedLogUpper (q : ℚ) (N : ℕ) : ℚ := + let kPart := directedIntMulUpper (rationalBinaryExponent q) + (directedLogUnitLower 2 N) (directedLogUnitUpper 2 N) + let y := rationalLogUnit q + kPart + if rationalBinaryResidual q < 1 then + -directedLogUnitLower y N + else directedLogUnitUpper y N + +theorem directedLogLower_le_log {q : ℚ} (hq : 0 < q) (N : ℕ) : + ((directedLogLower q N : ℚ) : ℝ) ≤ Real.log (q : ℝ) := by + have htwoLo := directedLogUnitLower_le_log (y := (2 : ℚ)) (by norm_num) N + have htwoHi := log_le_directedLogUnitUpper (y := (2 : ℚ)) (by norm_num) N + have hk := directedIntMulLower_le + (k := rationalBinaryExponent q) htwoLo htwoHi + norm_num at hk + have hyBounds := rationalLogUnit_bounds hq + have hyLo := directedLogUnitLower_le_log hyBounds.1 N + have hyHi := log_le_directedLogUnitUpper hyBounds.1 N + rw [log_rational_eq_scale_add_residual hq, + log_residual_eq_signed_log_unit hq] + rw [directedLogLower] + split_ifs with hr + · push_cast + linarith + · push_cast + linarith + +theorem log_le_directedLogUpper {q : ℚ} (hq : 0 < q) (N : ℕ) : + Real.log (q : ℝ) ≤ ((directedLogUpper q N : ℚ) : ℝ) := by + have htwoLo := directedLogUnitLower_le_log (y := (2 : ℚ)) (by norm_num) N + have htwoHi := log_le_directedLogUnitUpper (y := (2 : ℚ)) (by norm_num) N + have hk := le_directedIntMulUpper + (k := rationalBinaryExponent q) htwoLo htwoHi + norm_num at hk + have hyBounds := rationalLogUnit_bounds hq + have hyLo := directedLogUnitLower_le_log hyBounds.1 N + have hyHi := log_le_directedLogUnitUpper hyBounds.1 N + rw [log_rational_eq_scale_add_residual hq, + log_residual_eq_signed_log_unit hq] + rw [directedLogUpper] + split_ifs with hr + · push_cast + linarith + · push_cast + linarith + +theorem rationalLogSeriesError_nonneg {x : ℚ} (hx0 : 0 ≤ x) (hx1 : x < 1) + (N : ℕ) : 0 ≤ rationalLogSeriesError x N := by + rw [rationalLogSeriesError] + have hpow : x ^ 2 < 1 := pow_lt_one₀ hx0 hx1 (by norm_num) + have hden : 0 < 1 - x ^ 2 := by linarith + positivity + +theorem rationalLogSeriesError_le_geometric {x : ℚ} + (hx0 : 0 ≤ x) (hx : x ≤ 1 / 3) (N : ℕ) : + rationalLogSeriesError x N ≤ + 4 * (1 / 3 : ℚ) ^ (2 * N + 1) := by + have hx1 : x < 1 := hx.trans_lt (by norm_num) + have hsq : x ^ 2 ≤ (1 / 3 : ℚ) ^ 2 := + pow_le_pow_left₀ hx0 hx 2 + have hden : 0 < 1 - x ^ 2 := by nlinarith + have hcoef : 2 / (1 - x ^ 2) ≤ (4 : ℚ) := by + rw [div_le_iff₀ hden] + nlinarith + have hpow : x ^ (2 * N + 1) ≤ + (1 / 3 : ℚ) ^ (2 * N + 1) := + pow_le_pow_left₀ hx0 hx _ + rw [rationalLogSeriesError] + calc + 2 * (x ^ (2 * N + 1) / (1 - x ^ 2)) = + x ^ (2 * N + 1) * (2 / (1 - x ^ 2)) := by ring + _ ≤ (1 / 3 : ℚ) ^ (2 * N + 1) * (2 / (1 - x ^ 2)) := + mul_le_mul_of_nonneg_right hpow (div_nonneg (by norm_num) hden.le) + _ ≤ (1 / 3 : ℚ) ^ (2 * N + 1) * 4 := + mul_le_mul_of_nonneg_left hcoef (by positivity) + _ = 4 * (1 / 3 : ℚ) ^ (2 * N + 1) := by ring + +theorem four_mul_two_pow_le_three_pow (p : ℕ) : + 4 * 2 ^ p ≤ 3 ^ (2 * p + 3) := by + induction p with + | zero => norm_num + | succ p ih => + calc + 4 * 2 ^ (p + 1) = 2 * (4 * 2 ^ p) := by ring + _ ≤ 2 * 3 ^ (2 * p + 3) := Nat.mul_le_mul_left 2 ih + _ ≤ 9 * 3 ^ (2 * p + 3) := by gcongr <;> norm_num + _ = 3 ^ (2 * (p + 1) + 3) := by + rw [show 2 * (p + 1) + 3 = (2 * p + 3) + 2 by omega, + pow_add] + ring + +theorem geometric_log_error_le_dyadic (p : ℕ) : + 4 * (1 / 3 : ℚ) ^ (2 * (p + 1) + 1) ≤ (1 / 2 : ℚ) ^ p := by + have hnat := four_mul_two_pow_le_three_pow p + have hrat : (4 : ℚ) * (2 : ℚ) ^ p ≤ (3 : ℚ) ^ (2 * p + 3) := by + exact_mod_cast hnat + rw [show 2 * (p + 1) + 1 = 2 * p + 3 by omega] + simp only [one_div, inv_pow] + rw [mul_inv_le_iff₀ (by positivity : (0 : ℚ) < 3 ^ (2 * p + 3))] + rw [mul_comm ((2 : ℚ) ^ p)⁻¹] + rw [le_mul_inv_iff₀ (by positivity : (0 : ℚ) < 2 ^ p)] + simpa using hrat + +theorem directedLogUnit_width_le_dyadic {y : ℚ} + (hy1 : 1 ≤ y) (hy2 : y ≤ 2) (p : ℕ) : + directedLogUnitUpper y (p + 1) - directedLogUnitLower y (p + 1) ≤ + (1 / 2 : ℚ) ^ p := by + rw [directedLogUnit_width] + exact (rationalLogSeriesError_le_geometric + (rationalLogUnitParameter_nonneg hy1) + (rationalLogUnitParameter_le_third hy1 hy2) (p + 1)).trans + (geometric_log_error_le_dyadic p) + +theorem directedIntMul_width (k : ℤ) (lo hi : ℚ) : + directedIntMulUpper k lo hi - directedIntMulLower k lo hi = + (k.natAbs : ℚ) * (hi - lo) := by + cases k with + | ofNat n => simp [directedIntMulUpper, directedIntMulLower]; ring + | negSucc n => simp [directedIntMulUpper, directedIntMulLower]; ring + +theorem directedLog_width (q : ℚ) (N : ℕ) : + directedLogUpper q N - directedLogLower q N = + (rationalBinaryExponent q).natAbs * + (directedLogUnitUpper 2 N - directedLogUnitLower 2 N) + + (directedLogUnitUpper (rationalLogUnit q) N - + directedLogUnitLower (rationalLogUnit q) N) := by + rw [directedLogUpper, directedLogLower] + split_ifs <;> + rw [← directedIntMul_width] <;> + ring + +theorem nat_succ_mul_dyadic_succ_le_one (m : ℕ) : + (m + 1 : ℚ) * (1 / 2 : ℚ) ^ (m + 1) ≤ 1 := by + have hn : m + 1 ≤ 2 ^ (m + 1) := (m + 1).lt_two_pow_self.le + have hq : (m + 1 : ℚ) ≤ (2 : ℚ) ^ (m + 1) := by exact_mod_cast hn + simp only [one_div, inv_pow] + rw [mul_inv_le_iff₀ (by positivity : (0 : ℚ) < 2 ^ (m + 1))] + simpa using hq + +theorem nat_succ_mul_shifted_dyadic_le (p m : ℕ) : + (m + 1 : ℚ) * (1 / 2 : ℚ) ^ (p + m + 1) ≤ + (1 / 2 : ℚ) ^ p := by + rw [show p + m + 1 = p + (m + 1) by omega, pow_add] + have h := nat_succ_mul_dyadic_succ_le_one m + calc + (m + 1 : ℚ) * ((1 / 2 : ℚ) ^ p * (1 / 2 : ℚ) ^ (m + 1)) = + (1 / 2 : ℚ) ^ p * + ((m + 1 : ℚ) * (1 / 2 : ℚ) ^ (m + 1)) := by ring + _ ≤ (1 / 2 : ℚ) ^ p * 1 := + mul_le_mul_of_nonneg_left h (by positivity) + _ = (1 / 2 : ℚ) ^ p := mul_one _ + +/-- A precision schedule compensating for the signed dyadic exponent. Its +number of series terms is linear in the requested precision and in the binary +length displacement of the input rational. -/ +def directedLogTerms (q : ℚ) (p : ℕ) : ℕ := + p + (rationalBinaryExponent q).natAbs + 2 + +/-- The signed range-reduction exponent is at most twice the canonical input +length. This makes the series schedule polynomial in ordinary binary input +length rather than in the numerical magnitude of `q`. -/ +theorem rationalBinaryExponent_natAbs_le_two_bitLength + {q : ℚ} (hq : 0 < q) : + (rationalBinaryExponent q).natAbs ≤ 2 * encodedBitLength ℚ q := by + have hnum := numerator_natAbs_log_lt_rationalBitLength q + (positive_rational_num_natAbs_ne_zero hq) + have hden := denominator_log_lt_rationalBitLength q + have habs := Int.natAbs_sub_le + (Nat.log 2 q.num.natAbs : ℤ) (Nat.log 2 q.den : ℤ) + simp only [Int.natAbs_natCast] at habs + rw [rationalBinaryExponent] + omega + +theorem directedLogTerms_le_input_precision + {q : ℚ} (hq : 0 < q) (p : ℕ) : + directedLogTerms q p ≤ p + 2 * encodedBitLength ℚ q + 2 := by + have h := rationalBinaryExponent_natAbs_le_two_bitLength hq + rw [directedLogTerms] + omega + +theorem directedLog_width_le_dyadic {q : ℚ} (hq : 0 < q) (p : ℕ) : + directedLogUpper q (directedLogTerms q p) - + directedLogLower q (directedLogTerms q p) ≤ + (1 / 2 : ℚ) ^ p := by + let m := (rationalBinaryExponent q).natAbs + let precision := p + m + 1 + have hterms : directedLogTerms q p = precision + 1 := by + simp [directedLogTerms, precision, m] + have htwo := directedLogUnit_width_le_dyadic + (y := (2 : ℚ)) (by norm_num) (by norm_num) precision + have hy := rationalLogUnit_bounds hq + have hunit := directedLogUnit_width_le_dyadic + hy.1 hy.2.le precision + rw [directedLog_width, hterms] + change (m : ℚ) * + (directedLogUnitUpper 2 (precision + 1) - + directedLogUnitLower 2 (precision + 1)) + + (directedLogUnitUpper (rationalLogUnit q) (precision + 1) - + directedLogUnitLower (rationalLogUnit q) (precision + 1)) ≤ _ + calc + (m : ℚ) * + (directedLogUnitUpper 2 (precision + 1) - + directedLogUnitLower 2 (precision + 1)) + + (directedLogUnitUpper (rationalLogUnit q) (precision + 1) - + directedLogUnitLower (rationalLogUnit q) (precision + 1)) ≤ + (m : ℚ) * (1 / 2 : ℚ) ^ precision + + (1 / 2 : ℚ) ^ precision := by + gcongr + _ = (m + 1 : ℚ) * (1 / 2 : ℚ) ^ precision := by ring + _ ≤ (1 / 2 : ℚ) ^ p := by + simpa only [precision] using nat_succ_mul_shifted_dyadic_le p m + +/-- The natural-number ceiling of a nonnegative rational. Unlike the raw +numerator, its numerical value depends on the magnitude of the rational and +not on the size of a possibly huge denominator. -/ +def rationalCeilNat (t : ℚ) : ℕ := Int.toNat ⌈t⌉ + +theorem le_rationalCeilNat {t : ℚ} (ht : 0 ≤ t) : + t ≤ rationalCeilNat t := by + have hceil : t ≤ ((⌈t⌉ : ℤ) : ℚ) := Int.le_ceil t + have hnonneg : (0 : ℤ) ≤ ⌈t⌉ := Int.ceil_nonneg ht + rw [← Int.toNat_of_nonneg hnonneg] at hceil + exact hceil + +/-- Number of Bernoulli factors used for a one-sided exponential sandwich. +For nonnegative `t`, this is strictly larger than `2t`. The former version +used `t.num.natAbs`, which is exponential in the bit length for a bounded +rational with a large denominator; the ceiling is the correct magnitude +parameter. -/ +def rationalExpSandwichSteps (t : ℚ) : ℕ := 2 * rationalCeilNat t + 1 + +/-- A fully rational substitute for evaluating a negative exponential. -/ +def rationalExpSandwichFactor (t : ℚ) : ℚ := + let M := rationalExpSandwichSteps t + (1 - t / M) ^ M + +theorem nonnegative_rational_le_num_natAbs {t : ℚ} (ht : 0 ≤ t) : + t ≤ (t.num.natAbs : ℚ) := by + have hnum : 0 ≤ t.num := Rat.num_nonneg.mpr ht + have hnumabs : (t.num.natAbs : ℤ) = t.num := Int.natAbs_of_nonneg hnum + have hden : (1 : ℚ) ≤ t.den := by exact_mod_cast t.den_pos + calc + t = (t.num : ℚ) / (t.den : ℚ) := (Rat.num_div_den t).symm + _ = (t.num.natAbs : ℚ) / (t.den : ℚ) := by + congr 1 + change (t.num : ℚ) = ((t.num.natAbs : ℤ) : ℚ) + rw [hnumabs] + _ ≤ (t.num.natAbs : ℚ) := div_le_self (by positivity) hden + +theorem two_mul_lt_rationalExpSandwichSteps {t : ℚ} (ht : 0 ≤ t) : + 2 * t < rationalExpSandwichSteps t := by + have hle := le_rationalCeilNat ht + rw [rationalExpSandwichSteps] + push_cast + linarith + +theorem rationalExpSandwich_argument_bounds {t : ℚ} (ht : 0 ≤ t) : + 0 ≤ t / rationalExpSandwichSteps t ∧ + t / rationalExpSandwichSteps t < 1 / 2 := by + have hM : (0 : ℚ) < rationalExpSandwichSteps t := by + have hMN : 0 < rationalExpSandwichSteps t := by + simp [rationalExpSandwichSteps] + exact_mod_cast hMN + constructor + · exact div_nonneg ht hM.le + · rw [div_lt_iff₀ hM] + have := two_mul_lt_rationalExpSandwichSteps ht + linarith + +theorem log_one_sub_between_neg_two_mul_and_neg {x : ℝ} + (hx0 : 0 ≤ x) (hxhalf : x < 1 / 2) : + -2 * x ≤ Real.log (1 - x) ∧ Real.log (1 - x) ≤ -x := by + have hbase : 0 < 1 - x := by linarith + have hupper := Real.log_le_sub_one_of_pos hbase + have hlower0 := Real.one_sub_inv_le_log_of_pos hbase + have hratio : x / (1 - x) ≤ 2 * x := by + rw [div_le_iff₀ hbase] + nlinarith + have hid : 1 - (1 - x)⁻¹ = -x / (1 - x) := by + field_simp [hbase.ne'] + ring + rw [hid] at hlower0 + have hneg : -x / (1 - x) = -(x / (1 - x)) := by ring + rw [hneg] at hlower0 + constructor <;> linarith + +/-- The rational Bernoulli factor lies between the two exponential losses +needed in the final certificate. Thus the implementation does not need a +separate transcendental exponential evaluator at this step. -/ +theorem rationalExpSandwichFactor_bounds {t : ℚ} (ht : 0 ≤ t) : + Real.exp (-2 * (t : ℝ)) ≤ (rationalExpSandwichFactor t : ℝ) ∧ + (rationalExpSandwichFactor t : ℝ) ≤ Real.exp (-(t : ℝ)) := by + let M := rationalExpSandwichSteps t + let x : ℚ := t / M + have hxQ := rationalExpSandwich_argument_bounds ht + have hx0Q : 0 ≤ x := by simpa [x, M] using hxQ.1 + have hxhalfQ : x < 1 / 2 := by simpa [x, M] using hxQ.2 + have hx0 : 0 ≤ (x : ℝ) := by exact_mod_cast hx0Q + have hxhalf' : (x : ℝ) < (((1 / 2 : ℚ) : ℝ)) := by + exact_mod_cast hxhalfQ + have hxhalf : (x : ℝ) < 1 / 2 := by norm_num at hxhalf' ⊢; exact hxhalf' + have hbase : 0 < (1 : ℝ) - x := by linarith + have hlog := log_one_sub_between_neg_two_mul_and_neg hx0 hxhalf + have hMposQ : (0 : ℚ) < M := by + have hMN : 0 < M := by simp [M, rationalExpSandwichSteps] + exact_mod_cast hMN + have hMpos : (0 : ℝ) < M := by exact_mod_cast hMposQ + have hMxQ : (M : ℚ) * x = t := by + dsimp only [x] + field_simp [hMposQ.ne'] + have hMx : (M : ℝ) * (x : ℝ) = (t : ℝ) := by exact_mod_cast hMxQ + have hlogPow : Real.log (((1 : ℝ) - x) ^ M) = + (M : ℝ) * Real.log ((1 : ℝ) - x) := Real.log_pow _ _ + have hfactorPos : 0 < ((1 : ℝ) - x) ^ M := pow_pos hbase M + have hlowerLog : -2 * (t : ℝ) ≤ Real.log (((1 : ℝ) - x) ^ M) := by + rw [hlogPow] + have := mul_le_mul_of_nonneg_left hlog.1 hMpos.le + nlinarith + have hupperLog : Real.log (((1 : ℝ) - x) ^ M) ≤ -(t : ℝ) := by + rw [hlogPow] + have := mul_le_mul_of_nonneg_left hlog.2 hMpos.le + nlinarith + have hfactorCast : (rationalExpSandwichFactor t : ℝ) = + ((1 : ℝ) - x) ^ M := by + simp [rationalExpSandwichFactor, x, M] + rw [hfactorCast] + constructor + · rw [← Real.exp_log hfactorPos] + exact Real.exp_le_exp.mpr hlowerLog + · rw [← Real.exp_log hfactorPos] + exact Real.exp_le_exp.mpr hupperLog + +/-- A magnitude-sensitive step count for a relative logarithmic loss +`loss`. Its numerical size is `O(t + t^2/loss)` and is independent of the +denominator used to represent `t`. -/ +def rationalExpApproxSteps (t loss : ℚ) : ℕ := + 2 * rationalCeilNat (t + t ^ 2 / loss) + 1 + +/-- Directed rational lower approximation to `exp (-t)`. -/ +def rationalNegativeExpLower (t loss : ℚ) : ℚ := + let M := rationalExpApproxSteps t loss + (1 - t / M) ^ M + +theorem rationalExpApproxSteps_gt_two_mul + {t loss : ℚ} (ht : 0 ≤ t) (hloss : 0 < loss) : + 2 * t < rationalExpApproxSteps t loss := by + have hu0 : 0 ≤ t + t ^ 2 / loss := by positivity + have hceil := le_rationalCeilNat hu0 + have htceil : t ≤ rationalCeilNat (t + t ^ 2 / loss) := by + have htu : t ≤ t + t ^ 2 / loss := + le_add_of_nonneg_right (div_nonneg (sq_nonneg t) hloss.le) + exact htu.trans hceil + rw [rationalExpApproxSteps] + push_cast + linarith + +theorem rationalExpApproxSteps_controls_error + {t loss : ℚ} (ht : 0 ≤ t) (hloss : 0 < loss) : + 2 * t ^ 2 / rationalExpApproxSteps t loss ≤ loss := by + let u : ℚ := t + t ^ 2 / loss + let M : ℚ := rationalExpApproxSteps t loss + have hu0 : 0 ≤ u := by dsimp only [u]; positivity + have hceil := le_rationalCeilNat hu0 + have hMpos : 0 < M := by + dsimp only [M, rationalExpApproxSteps] + positivity + have hcontrol : 2 * (t ^ 2 / loss) ≤ M := by + have hsquare : t ^ 2 / loss ≤ u := by + dsimp only [u] + linarith + have htwo : 2 * u ≤ M := by + dsimp only [M, rationalExpApproxSteps] + push_cast + linarith + linarith + rw [div_le_iff₀ hMpos] + have := mul_le_mul_of_nonneg_right hcontrol hloss.le + field_simp [hloss.ne'] at this ⊢ + nlinarith + +theorem log_one_sub_between_neg_add_two_sq_and_neg {x : ℝ} + (hx0 : 0 ≤ x) (hxhalf : x < 1 / 2) : + -x - 2 * x ^ 2 ≤ Real.log (1 - x) ∧ + Real.log (1 - x) ≤ -x := by + have hbase : 0 < 1 - x := by linarith + have hupper := Real.log_le_sub_one_of_pos hbase + have hlower0 := Real.one_sub_inv_le_log_of_pos hbase + have hratio : x / (1 - x) ≤ x + 2 * x ^ 2 := by + rw [div_le_iff₀ hbase] + nlinarith + have hid : 1 - (1 - x)⁻¹ = -x / (1 - x) := by + field_simp [hbase.ne'] + ring + rw [hid] at hlower0 + have hneg0 := neg_le_neg hratio + have hneg : -x - 2 * x ^ 2 ≤ -x / (1 - x) := by + calc + -x - 2 * x ^ 2 = -(x + 2 * x ^ 2) := by ring + _ ≤ -(x / (1 - x)) := hneg0 + _ = -x / (1 - x) := by ring + exact ⟨hneg.trans hlower0, by linarith⟩ + +/-- The accurate negative-exponential routine has prescribed multiplicative +logarithmic loss. -/ +theorem rationalNegativeExpLower_bounds + {t loss : ℚ} (ht : 0 ≤ t) (hloss : 0 < loss) : + Real.exp (-(t : ℝ) - (loss : ℝ)) ≤ + (rationalNegativeExpLower t loss : ℝ) ∧ + (rationalNegativeExpLower t loss : ℝ) ≤ + Real.exp (-(t : ℝ)) := by + let M := rationalExpApproxSteps t loss + let x : ℚ := t / M + have hMposQ : (0 : ℚ) < M := by + dsimp only [M, rationalExpApproxSteps] + positivity + have htwo := rationalExpApproxSteps_gt_two_mul ht hloss + have hx0Q : 0 ≤ x := div_nonneg ht hMposQ.le + have hxhalfQ : x < 1 / 2 := by + dsimp only [x] + rw [div_lt_iff₀ hMposQ] + linarith + have hx0 : 0 ≤ (x : ℝ) := by exact_mod_cast hx0Q + have hxhalf' : (x : ℝ) < (((1 / 2 : ℚ)) : ℝ) := by + exact_mod_cast hxhalfQ + have hxhalf : (x : ℝ) < 1 / 2 := by + norm_num at hxhalf' ⊢ + exact hxhalf' + have hbase : 0 < (1 : ℝ) - x := by linarith + have hlog := log_one_sub_between_neg_add_two_sq_and_neg hx0 hxhalf + have hMpos : (0 : ℝ) < M := by exact_mod_cast hMposQ + have hMxQ : (M : ℚ) * x = t := by + dsimp only [x] + field_simp [hMposQ.ne'] + have hMx : (M : ℝ) * (x : ℝ) = (t : ℝ) := by + exact_mod_cast hMxQ + have herrQ := rationalExpApproxSteps_controls_error ht hloss + have herr : 2 * (t : ℝ) ^ 2 / (M : ℝ) ≤ (loss : ℝ) := by + exact_mod_cast herrQ + have hMxx : (M : ℝ) * (2 * (x : ℝ) ^ 2) = + 2 * (t : ℝ) ^ 2 / (M : ℝ) := by + have hMne : (M : ℝ) ≠ 0 := hMpos.ne' + rw [show (x : ℝ) = (t : ℝ) / (M : ℝ) by + exact_mod_cast (rfl : x = t / M)] + field_simp [hMne] + have hlogPow : Real.log (((1 : ℝ) - x) ^ M) = + (M : ℝ) * Real.log ((1 : ℝ) - x) := Real.log_pow _ _ + have hfactorPos : 0 < ((1 : ℝ) - x) ^ M := pow_pos hbase M + have hlowerLog : -(t : ℝ) - (loss : ℝ) ≤ + Real.log (((1 : ℝ) - x) ^ M) := by + rw [hlogPow] + have hscaled := mul_le_mul_of_nonneg_left hlog.1 hMpos.le + nlinarith [hMx, hMxx, herr] + have hupperLog : Real.log (((1 : ℝ) - x) ^ M) ≤ -(t : ℝ) := by + rw [hlogPow] + have hscaled := mul_le_mul_of_nonneg_left hlog.2 hMpos.le + nlinarith + have hfactorCast : (rationalNegativeExpLower t loss : ℝ) = + ((1 : ℝ) - x) ^ M := by + simp [rationalNegativeExpLower, x, M] + rw [hfactorCast] + constructor + · rw [← Real.exp_log hfactorPos] + exact Real.exp_le_exp.mpr hlowerLog + · rw [← Real.exp_log hfactorPos] + exact Real.exp_le_exp.mpr hupperLog + +/-- Directed rational lower approximation to `exp t` for `t ≥ 0`. -/ +def rationalPositiveExpLower (t loss : ℚ) : ℚ := + let M := rationalExpApproxSteps t loss + (1 + t / M) ^ M + +theorem log_one_add_between_sub_sq_and_self {x : ℝ} (hx : 0 ≤ x) : + x - x ^ 2 ≤ Real.log (1 + x) ∧ Real.log (1 + x) ≤ x := by + have hbase : 0 < 1 + x := by linarith + have hlower0 := Real.one_sub_inv_le_log_of_pos hbase + have hupper0 := Real.log_le_sub_one_of_pos hbase + have hid : 1 - (1 + x)⁻¹ = x / (1 + x) := by + field_simp [hbase.ne'] + ring + rw [hid] at hlower0 + have hpoly : x - x ^ 2 ≤ x / (1 + x) := by + rw [le_div_iff₀ hbase] + nlinarith [sq_nonneg x] + exact ⟨hpoly.trans hlower0, by linarith⟩ + +theorem rationalPositiveExpLower_bounds + {t loss : ℚ} (ht : 0 ≤ t) (hloss : 0 < loss) : + Real.exp ((t : ℝ) - (loss : ℝ)) ≤ + (rationalPositiveExpLower t loss : ℝ) ∧ + (rationalPositiveExpLower t loss : ℝ) ≤ Real.exp (t : ℝ) := by + let M := rationalExpApproxSteps t loss + let x : ℚ := t / M + have hMposQ : (0 : ℚ) < M := by + dsimp only [M, rationalExpApproxSteps] + positivity + have hx0Q : 0 ≤ x := div_nonneg ht hMposQ.le + have hx0 : 0 ≤ (x : ℝ) := by exact_mod_cast hx0Q + have hbase : 0 < (1 : ℝ) + x := by positivity + have hlog := log_one_add_between_sub_sq_and_self hx0 + have hMpos : (0 : ℝ) < M := by exact_mod_cast hMposQ + have hMxQ : (M : ℚ) * x = t := by + dsimp only [x] + field_simp [hMposQ.ne'] + have hMx : (M : ℝ) * (x : ℝ) = (t : ℝ) := by exact_mod_cast hMxQ + have herrQ := rationalExpApproxSteps_controls_error ht hloss + have herr : (t : ℝ) ^ 2 / (M : ℝ) ≤ (loss : ℝ) := by + have hcast : 2 * (t : ℝ) ^ 2 / (M : ℝ) ≤ (loss : ℝ) := by + exact_mod_cast herrQ + have hnonneg : 0 ≤ (t : ℝ) ^ 2 / (M : ℝ) := by positivity + have hid : 2 * (t : ℝ) ^ 2 / (M : ℝ) = + 2 * ((t : ℝ) ^ 2 / (M : ℝ)) := by ring + rw [hid] at hcast + linarith + have hMxx : (M : ℝ) * (x : ℝ) ^ 2 = + (t : ℝ) ^ 2 / (M : ℝ) := by + have hMne : (M : ℝ) ≠ 0 := hMpos.ne' + rw [show (x : ℝ) = (t : ℝ) / (M : ℝ) by + exact_mod_cast (rfl : x = t / M)] + field_simp [hMne] + have hlogPow : Real.log (((1 : ℝ) + x) ^ M) = + (M : ℝ) * Real.log ((1 : ℝ) + x) := Real.log_pow _ _ + have hfactorPos : 0 < ((1 : ℝ) + x) ^ M := pow_pos hbase M + have hlowerLog : (t : ℝ) - (loss : ℝ) ≤ + Real.log (((1 : ℝ) + x) ^ M) := by + rw [hlogPow] + have hscaled := mul_le_mul_of_nonneg_left hlog.1 hMpos.le + nlinarith [hMx, hMxx, herr] + have hupperLog : Real.log (((1 : ℝ) + x) ^ M) ≤ (t : ℝ) := by + rw [hlogPow] + have hscaled := mul_le_mul_of_nonneg_left hlog.2 hMpos.le + nlinarith + have hfactorCast : (rationalPositiveExpLower t loss : ℝ) = + ((1 : ℝ) + x) ^ M := by + simp [rationalPositiveExpLower, x, M] + rw [hfactorCast] + constructor + · rw [← Real.exp_log hfactorPos] + exact Real.exp_le_exp.mpr hlowerLog + · rw [← Real.exp_log hfactorPos] + exact Real.exp_le_exp.mpr hupperLog + +/-- Directed rational lower exponential at an arbitrary rational argument. -/ +def rationalExpLower (s loss : ℚ) : ℚ := + if 0 ≤ s then rationalPositiveExpLower s loss + else rationalNegativeExpLower (-s) loss + +theorem rationalExpLower_bounds {s loss : ℚ} (hloss : 0 < loss) : + Real.exp ((s : ℝ) - (loss : ℝ)) ≤ + (rationalExpLower s loss : ℝ) ∧ + (rationalExpLower s loss : ℝ) ≤ Real.exp (s : ℝ) := by + rw [rationalExpLower] + split_ifs with hs + · exact rationalPositiveExpLower_bounds hs hloss + · have hneg : 0 ≤ -s := neg_nonneg.mpr (le_of_not_ge hs) + have h := rationalNegativeExpLower_bounds hneg hloss + norm_num only [Rat.cast_neg] at h ⊢ + convert h using 1 <;> ring + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/DirectedOptimizerOracle.lean b/LeanPool/BeyondBethe/BeyondBethe/DirectedOptimizerOracle.lean new file mode 100644 index 0000000000..7397e4e391 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/DirectedOptimizerOracle.lean @@ -0,0 +1,308 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.DirectedPairCost +import LeanPool.BeyondBethe.BeyondBethe.Optimizer +import LeanPool.BeyondBethe.BeyondBethe.NumericalAffine +import Mathlib.Tactic + +/-! # Directed Optimizer Oracle -/ + +open scoped BigOperators + +namespace BeyondBethe + +/-! +# Directed rational values for the convex-optimization oracle + +The weak optimization algorithm uses the convex function obtained by +negating the regularized Bethe objective. This file gives rational lower and +upper endpoints for both a coordinate value and a coordinate of its gradient. +Every endpoint is executable and every error bound is stated in terms of the +prescribed dyadic precision. +-/ + +/-- Lower endpoint for one coordinate of the gradient of the negative +regularized Bethe objective. -/ +def directedNegativeGradientLower + (τ a x : ℚ) (p : ℕ) : ℚ := + -scheduledLogUpper a p + + (1 + τ) * scheduledLogLower x p + + scheduledLogLower (1 - x) p + (2 + τ) + +/-- Upper endpoint for one coordinate of the gradient of the negative +regularized Bethe objective. -/ +def directedNegativeGradientUpper + (τ a x : ℚ) (p : ℕ) : ℚ := + -scheduledLogLower a p + + (1 + τ) * scheduledLogUpper x p + + scheduledLogUpper (1 - x) p + (2 + τ) + +/-- The exact real coordinate of the negative gradient. -/ +noncomputable def negativeRegularizedBetheGradientCoordinate + (τ a x : ℝ) : ℝ := + -Real.log a + (1 + τ) * Real.log x + + Real.log (1 - x) + (2 + τ) + +theorem negativeRegularizedBetheGradientCoordinate_eq_neg + {τ a x : ℝ} : + negativeRegularizedBetheGradientCoordinate τ a x = + -(Real.log a - (1 + τ) * Real.log x - + Real.log (1 - x) - (2 + τ)) := by + simp [negativeRegularizedBetheGradientCoordinate] + ring + +/-- A directed interval for the negative gradient has width at most four +dyadic units when `0 ≤ τ ≤ 1`. -/ +theorem directedNegativeGradient_bounds + {τ a x : ℚ} (hτ0 : 0 ≤ τ) (hτ1 : τ ≤ 1) + (ha : 0 < a) (hx0 : 0 < x) (hx1 : x < 1) (p : ℕ) : + (directedNegativeGradientLower τ a x p : ℝ) ≤ + negativeRegularizedBetheGradientCoordinate + (τ : ℝ) (a : ℝ) (x : ℝ) ∧ + negativeRegularizedBetheGradientCoordinate + (τ : ℝ) (a : ℝ) (x : ℝ) ≤ + (directedNegativeGradientUpper τ a x p : ℝ) ∧ + (directedNegativeGradientUpper τ a x p : ℝ) - + (directedNegativeGradientLower τ a x p : ℝ) ≤ + 4 * (((1 / 2 : ℚ) ^ p : ℚ) : ℝ) := by + have hcx : 0 < 1 - x := sub_pos.mpr hx1 + have hAlo := scheduledLogLower_le_log ha p + have hAup := log_le_scheduledLogUpper ha p + have hXlo := scheduledLogLower_le_log hx0 p + have hXup := log_le_scheduledLogUpper hx0 p + have hClo := scheduledLogLower_le_log hcx p + have hCup := log_le_scheduledLogUpper hcx p + norm_num only [Rat.cast_sub, Rat.cast_one] at hClo hCup + have hAgapQ := scheduledLog_width_le ha p + have hXgapQ := scheduledLog_width_le hx0 p + have hCgapQ := scheduledLog_width_le hcx p + have hAgap : + (scheduledLogUpper a p : ℝ) - (scheduledLogLower a p : ℝ) ≤ + (((1 / 2 : ℚ) ^ p : ℚ) : ℝ) := by exact_mod_cast hAgapQ + have hXgap : + (scheduledLogUpper x p : ℝ) - (scheduledLogLower x p : ℝ) ≤ + (((1 / 2 : ℚ) ^ p : ℚ) : ℝ) := by exact_mod_cast hXgapQ + have hCgap : + (scheduledLogUpper (1 - x) p : ℝ) - + (scheduledLogLower (1 - x) p : ℝ) ≤ + (((1 / 2 : ℚ) ^ p : ℚ) : ℝ) := by exact_mod_cast hCgapQ + have hcoef0 : 0 ≤ (1 + τ : ℝ) := by exact_mod_cast (by linarith : (0 : ℚ) ≤ 1 + τ) + have hcoef2 : (1 + τ : ℝ) ≤ 2 := by exact_mod_cast (by linarith : 1 + τ ≤ (2 : ℚ)) + have hscaledLower := mul_le_mul_of_nonneg_left hXlo hcoef0 + have hscaledUpper := mul_le_mul_of_nonneg_left hXup hcoef0 + have hdyadic : 0 ≤ ((((1 / 2 : ℚ) ^ p : ℚ)) : ℝ) := by positivity + have hscaledGap : + (1 + (τ : ℝ)) * + ((scheduledLogUpper x p : ℝ) - + (scheduledLogLower x p : ℝ)) ≤ + 2 * (((1 / 2 : ℚ) ^ p : ℚ) : ℝ) := by + calc + (1 + (τ : ℝ)) * + ((scheduledLogUpper x p : ℝ) - + (scheduledLogLower x p : ℝ)) ≤ + (1 + (τ : ℝ)) * + (((1 / 2 : ℚ) ^ p : ℚ) : ℝ) := + mul_le_mul_of_nonneg_left hXgap hcoef0 + _ ≤ 2 * (((1 / 2 : ℚ) ^ p : ℚ) : ℝ) := + mul_le_mul_of_nonneg_right hcoef2 hdyadic + constructor + · rw [directedNegativeGradientLower, + negativeRegularizedBetheGradientCoordinate] + push_cast + linarith + constructor + · rw [directedNegativeGradientUpper, + negativeRegularizedBetheGradientCoordinate] + push_cast + linarith + · rw [directedNegativeGradientUpper, directedNegativeGradientLower] + push_cast + norm_num only [Rat.cast_pow, Rat.cast_div, Rat.cast_one, + Rat.cast_ofNat] at hAgap hCgap hscaledGap hdyadic ⊢ + linarith + +/-- Lower endpoint for the negative of one regularized Bethe coordinate. -/ +def directedNegativeObjectiveCoordinateLower + (τ a x : ℚ) (p : ℕ) : ℚ := + -x * scheduledLogUpper a p + + (1 + τ) * x * scheduledLogLower x p - + (1 - x) * scheduledLogUpper (1 - x) p + +/-- Upper endpoint for the negative of one regularized Bethe coordinate. -/ +def directedNegativeObjectiveCoordinateUpper + (τ a x : ℚ) (p : ℕ) : ℚ := + -x * scheduledLogLower a p + + (1 + τ) * x * scheduledLogUpper x p - + (1 - x) * scheduledLogLower (1 - x) p + +/-- Exact negative coordinate value, written in logarithmic form on the +interior of the unit interval. -/ +noncomputable def negativeRegularizedBetheCoordinate + (τ a x : ℝ) : ℝ := + -x * Real.log a + (1 + τ) * x * Real.log x - + (1 - x) * Real.log (1 - x) + +theorem negativeRegularizedBetheCoordinate_eq_neg + {τ a x : ℝ} : + negativeRegularizedBetheCoordinate τ a x = + -regularizedBetheCoordinate τ a x := by + rw [negativeRegularizedBetheCoordinate, regularizedBetheCoordinate, + Real.negMulLog_def] + ring + +/-- A directed interval for a negative objective coordinate has width at most +three dyadic units. -/ +theorem directedNegativeObjectiveCoordinate_bounds + {τ a x : ℚ} (hτ0 : 0 ≤ τ) (hτ1 : τ ≤ 1) + (ha : 0 < a) (hx0 : 0 < x) (hx1 : x < 1) (p : ℕ) : + (directedNegativeObjectiveCoordinateLower τ a x p : ℝ) ≤ + negativeRegularizedBetheCoordinate (τ : ℝ) (a : ℝ) (x : ℝ) ∧ + negativeRegularizedBetheCoordinate (τ : ℝ) (a : ℝ) (x : ℝ) ≤ + (directedNegativeObjectiveCoordinateUpper τ a x p : ℝ) ∧ + (directedNegativeObjectiveCoordinateUpper τ a x p : ℝ) - + (directedNegativeObjectiveCoordinateLower τ a x p : ℝ) ≤ + 3 * (((1 / 2 : ℚ) ^ p : ℚ) : ℝ) := by + have hcx : 0 < 1 - x := sub_pos.mpr hx1 + have hAlo := scheduledLogLower_le_log ha p + have hAup := log_le_scheduledLogUpper ha p + have hXlo := scheduledLogLower_le_log hx0 p + have hXup := log_le_scheduledLogUpper hx0 p + have hClo := scheduledLogLower_le_log hcx p + have hCup := log_le_scheduledLogUpper hcx p + norm_num only [Rat.cast_sub, Rat.cast_one] at hClo hCup + have hAgapQ := scheduledLog_width_le ha p + have hXgapQ := scheduledLog_width_le hx0 p + have hCgapQ := scheduledLog_width_le hcx p + have hAgap : + (scheduledLogUpper a p : ℝ) - (scheduledLogLower a p : ℝ) ≤ + (((1 / 2 : ℚ) ^ p : ℚ) : ℝ) := by exact_mod_cast hAgapQ + have hXgap : + (scheduledLogUpper x p : ℝ) - (scheduledLogLower x p : ℝ) ≤ + (((1 / 2 : ℚ) ^ p : ℚ) : ℝ) := by exact_mod_cast hXgapQ + have hCgap : + (scheduledLogUpper (1 - x) p : ℝ) - + (scheduledLogLower (1 - x) p : ℝ) ≤ + (((1 / 2 : ℚ) ^ p : ℚ) : ℝ) := by exact_mod_cast hCgapQ + have hx0r : 0 ≤ (x : ℝ) := by exact_mod_cast hx0.le + have hx1r : (x : ℝ) ≤ 1 := by exact_mod_cast hx1.le + have hcx0r : 0 ≤ (1 - x : ℝ) := by exact_mod_cast (sub_nonneg.mpr hx1.le) + have hcoef0 : 0 ≤ (1 + τ : ℝ) := by exact_mod_cast (by linarith : (0 : ℚ) ≤ 1 + τ) + have hcoef2 : (1 + τ : ℝ) ≤ 2 := by exact_mod_cast (by linarith : 1 + τ ≤ (2 : ℚ)) + have hmiddle0 : 0 ≤ (1 + (τ : ℝ)) * (x : ℝ) := mul_nonneg hcoef0 hx0r + have hmiddle2 : (1 + (τ : ℝ)) * (x : ℝ) ≤ 2 := by nlinarith + have hdyadic : 0 ≤ ((((1 / 2 : ℚ) ^ p : ℚ)) : ℝ) := by positivity + have hAweighted := mul_le_mul_of_nonneg_left hAgap hx0r + have hXweighted := mul_le_mul_of_nonneg_left hXgap hmiddle0 + have hCweighted := mul_le_mul_of_nonneg_left hCgap hcx0r + have hAweightBound : + (x : ℝ) * (((1 / 2 : ℚ) ^ p : ℚ) : ℝ) ≤ + (((1 / 2 : ℚ) ^ p : ℚ) : ℝ) := + mul_le_of_le_one_left hdyadic hx1r + have hXweightBound : + ((1 + (τ : ℝ)) * (x : ℝ)) * + (((1 / 2 : ℚ) ^ p : ℚ) : ℝ) ≤ + 2 * (((1 / 2 : ℚ) ^ p : ℚ) : ℝ) := + mul_le_mul_of_nonneg_right hmiddle2 hdyadic + have hCweightBound : + (1 - (x : ℝ)) * (((1 / 2 : ℚ) ^ p : ℚ) : ℝ) ≤ + (((1 / 2 : ℚ) ^ p : ℚ) : ℝ) := + mul_le_of_le_one_left hdyadic (by linarith) + have hscaledXlo := mul_le_mul_of_nonneg_left hXlo hmiddle0 + have hscaledXup := mul_le_mul_of_nonneg_left hXup hmiddle0 + have hscaledAlo := mul_le_mul_of_nonneg_left hAlo hx0r + have hscaledAup := mul_le_mul_of_nonneg_left hAup hx0r + have hscaledClo := mul_le_mul_of_nonneg_left hClo hcx0r + have hscaledCup := mul_le_mul_of_nonneg_left hCup hcx0r + constructor + · rw [directedNegativeObjectiveCoordinateLower, + negativeRegularizedBetheCoordinate] + push_cast + linarith + constructor + · rw [directedNegativeObjectiveCoordinateUpper, + negativeRegularizedBetheCoordinate] + push_cast + linarith + · rw [directedNegativeObjectiveCoordinateUpper, + directedNegativeObjectiveCoordinateLower] + push_cast + norm_num only [Rat.cast_pow, Rat.cast_div, Rat.cast_one, + Rat.cast_ofNat] at hAweighted hXweighted hCweighted hAweightBound hXweightBound hCweightBound hdyadic ⊢ + nlinarith + +/-- Rational lower endpoint for the complete negative objective. -/ +def directedNegativeObjectiveLower {n : ℕ} + (τ : ℚ) (A X : Matrix (Fin n) (Fin n) ℚ) (p : ℕ) : ℚ := + ∑ i, ∑ j, directedNegativeObjectiveCoordinateLower τ (A i j) (X i j) p + +/-- Rational upper endpoint for the complete negative objective. -/ +def directedNegativeObjectiveUpper {n : ℕ} + (τ : ℚ) (A X : Matrix (Fin n) (Fin n) ℚ) (p : ℕ) : ℚ := + ∑ i, ∑ j, directedNegativeObjectiveCoordinateUpper τ (A i j) (X i j) p + +/-- Summing the coordinate intervals yields an `3 n² 2⁻ᵖ` interval for the +complete negative objective. -/ +theorem directedNegativeObjective_bounds + {n : ℕ} {τ : ℚ} {A X : Matrix (Fin n) (Fin n) ℚ} + (hτ0 : 0 ≤ τ) (hτ1 : τ ≤ 1) + (hA : ∀ i j, 0 < A i j) + (hX0 : ∀ i j, 0 < X i j) (hX1 : ∀ i j, X i j < 1) (p : ℕ) : + (directedNegativeObjectiveLower τ A X p : ℝ) ≤ + -regularizedBetheObjective (τ : ℝ) + (fun i j ↦ (A i j : ℝ)) (fun i j ↦ (X i j : ℝ)) ∧ + -regularizedBetheObjective (τ : ℝ) + (fun i j ↦ (A i j : ℝ)) (fun i j ↦ (X i j : ℝ)) ≤ + (directedNegativeObjectiveUpper τ A X p : ℝ) ∧ + (directedNegativeObjectiveUpper τ A X p : ℝ) - + (directedNegativeObjectiveLower τ A X p : ℝ) ≤ + 3 * (n : ℝ) ^ 2 * (((1 / 2 : ℚ) ^ p : ℚ) : ℝ) := by + have hcoord := fun i j ↦ directedNegativeObjectiveCoordinate_bounds + hτ0 hτ1 (hA i j) (hX0 i j) (hX1 i j) p + rw [regularizedBetheObjective_eq_sum_coordinates] + have hexact : + -(∑ i, ∑ j, regularizedBetheCoordinate (τ : ℝ) + (A i j : ℝ) (X i j : ℝ)) = + ∑ i, ∑ j, negativeRegularizedBetheCoordinate + (τ : ℝ) (A i j : ℝ) (X i j : ℝ) := by + rw [← Finset.sum_neg_distrib] + apply Finset.sum_congr rfl + intro i _ + rw [← Finset.sum_neg_distrib] + apply Finset.sum_congr rfl + intro j _ + exact negativeRegularizedBetheCoordinate_eq_neg.symm + rw [hexact] + constructor + · rw [directedNegativeObjectiveLower] + push_cast + exact Finset.sum_le_sum fun i _ ↦ + Finset.sum_le_sum fun j _ ↦ (hcoord i j).1 + constructor + · rw [directedNegativeObjectiveUpper] + push_cast + exact Finset.sum_le_sum fun i _ ↦ + Finset.sum_le_sum fun j _ ↦ (hcoord i j).2.1 + · rw [directedNegativeObjectiveUpper, directedNegativeObjectiveLower] + push_cast + rw [← Finset.sum_sub_distrib] + calc + ∑ i, ((∑ j, (directedNegativeObjectiveCoordinateUpper τ + (A i j) (X i j) p : ℝ)) - + ∑ j, (directedNegativeObjectiveCoordinateLower τ + (A i j) (X i j) p : ℝ)) ≤ + ∑ i, ∑ j, 3 * (((1 / 2 : ℚ) ^ p : ℚ) : ℝ) := by + apply Finset.sum_le_sum + intro i _ + rw [← Finset.sum_sub_distrib] + exact Finset.sum_le_sum fun j _ ↦ (hcoord i j).2.2 + _ = 3 * (n : ℝ) ^ 2 * + (((1 / 2 : ℚ) ^ p : ℚ) : ℝ) := by + simp [Fintype.card_fin] + ring + _ = 3 * (n : ℝ) ^ 2 * (1 / 2 : ℝ) ^ p := by norm_num + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/DirectedPairCost.lean b/LeanPool/BeyondBethe/BeyondBethe/DirectedPairCost.lean new file mode 100644 index 0000000000..bba32d5c0f --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/DirectedPairCost.lean @@ -0,0 +1,257 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.DirectedElementary +import LeanPool.BeyondBethe.BeyondBethe.TransferIdentity +import LeanPool.BeyondBethe.BeyondBethe.Gain +import Mathlib.Tactic + +/-! # Directed Pair Cost -/ + +open scoped BigOperators + +namespace BeyondBethe + +/-! +# Directed rational evaluation of the four-core transfer cost + +The algorithm does not need to approximate a pair capacity. It only needs a +one-sided test for the local transfer cost used by the clean-pair lemma. The +formula below evaluates every logarithm over `ℚ` and is deliberately directed +upward: passing the rational test proves that the true real cost passes. +-/ + +/-- The precision-scheduled lower endpoint for a positive rational logarithm. -/ +def scheduledLogLower (q : ℚ) (p : ℕ) : ℚ := + directedLogLower q (directedLogTerms q p) + +/-- The precision-scheduled upper endpoint for a positive rational logarithm. -/ +def scheduledLogUpper (q : ℚ) (p : ℕ) : ℚ := + directedLogUpper q (directedLogTerms q p) + +theorem scheduledLogLower_le_log {q : ℚ} (hq : 0 < q) (p : ℕ) : + (scheduledLogLower q p : ℝ) ≤ Real.log (q : ℝ) := + directedLogLower_le_log hq _ + +theorem log_le_scheduledLogUpper {q : ℚ} (hq : 0 < q) (p : ℕ) : + Real.log (q : ℝ) ≤ (scheduledLogUpper q p : ℝ) := + log_le_directedLogUpper hq _ + +theorem scheduledLog_width_le {q : ℚ} (hq : 0 < q) (p : ℕ) : + scheduledLogUpper q p - scheduledLogLower q p ≤ (1 / 2 : ℚ) ^ p := + directedLog_width_le_dyadic hq p + +/-- Directed upper endpoint for `log (1 / transferU τ (X i) j)`. +The final sum is `log (complementProduct (X i))`. -/ +def directedTransferCostUpper {n : ℕ} + (τ : ℚ) (X : Matrix (Fin n) (Fin n) ℚ) + (i j : Fin n) (p : ℕ) : ℚ := + -(1 + τ) * scheduledLogLower (X i j) p - + scheduledLogLower (1 - X i j) p + + ∑ k, scheduledLogUpper (1 - X i k) p + +theorem transferCost_le_directedTransferCostUpper + {n : ℕ} {τ : ℚ} {X : Matrix (Fin n) (Fin n) ℚ} + (hτ : -1 ≤ τ) + (hXint : ∀ i, IsInteriorProbabilityVector + (fun j ↦ ((X i j : ℚ) : ℝ))) + (i j : Fin n) (p : ℕ) : + Real.log (1 / transferU (τ : ℝ) + (fun k ↦ ((X i k : ℚ) : ℝ)) j) ≤ + (directedTransferCostUpper τ X i j p : ℝ) := by + have hxq : 0 < X i j := by + have h := (hXint i).2 j |>.1 + norm_num only [Rat.cast_pos] at h + exact h + have hcxq : 0 < 1 - X i j := by + have := (hXint i).2 j |>.2 + have hxltq : X i j < 1 := + (Rat.cast_lt (K := ℝ)).mp (by simpa using this) + linarith + have hlogx := scheduledLogLower_le_log hxq p + have hlogc := scheduledLogLower_le_log hcxq p + have hcoef : (0 : ℝ) ≤ 1 + (τ : ℝ) := by exact_mod_cast (by linarith : (0 : ℚ) ≤ 1 + τ) + have hfirst : -(1 + (τ : ℝ)) * Real.log (X i j : ℝ) ≤ + -(1 + (τ : ℝ)) * (scheduledLogLower (X i j) p : ℝ) := by + exact mul_le_mul_of_nonpos_left hlogx (neg_nonpos.mpr hcoef) + have hsecond : -Real.log ((1 - X i j : ℚ) : ℝ) ≤ + -(scheduledLogLower (1 - X i j) p : ℝ) := neg_le_neg hlogc + have hsum : Real.log (complementProduct + (fun k ↦ ((X i k : ℚ) : ℝ))) ≤ + ∑ k, (scheduledLogUpper (1 - X i k) p : ℝ) := by + rw [complementProduct, Real.log_prod] + · exact Finset.sum_le_sum fun k _ ↦ by + have hckq : 0 < 1 - X i k := by + have := (hXint i).2 k |>.2 + have hxltq : X i k < 1 := + (Rat.cast_lt (K := ℝ)).mp (by simpa using this) + linarith + simpa using log_le_scheduledLogUpper hckq p + · intro k _ + exact (sub_pos.mpr ((hXint i).2 k |>.2)).ne' + rw [log_one_div_transferU (hXint i)] + rw [directedTransferCostUpper] + push_cast + norm_num only [Rat.cast_sub, Rat.cast_one] at hlogc hsecond ⊢ + linarith + +/-- The directed endpoint exceeds the true transfer cost by at most one +dyadic unit for each logarithm, with coefficient `1+τ` on the distinguished +coordinate. -/ +theorem directedTransferCostUpper_le_add_error + {n : ℕ} {τ : ℚ} {X : Matrix (Fin n) (Fin n) ℚ} + (hτ0 : 0 ≤ τ) (hτ1 : τ ≤ 1) + (hXint : ∀ i, IsInteriorProbabilityVector + (fun j ↦ ((X i j : ℚ) : ℝ))) + (i j : Fin n) (p : ℕ) : + (directedTransferCostUpper τ X i j p : ℝ) ≤ + Real.log (1 / transferU (τ : ℝ) + (fun k ↦ ((X i k : ℚ) : ℝ)) j) + + (n + 3 : ℝ) * ((1 / 2 : ℚ) ^ p : ℚ) := by + have hxq : 0 < X i j := by + have h := (hXint i).2 j |>.1 + norm_num only [Rat.cast_pos] at h + exact h + have hcxq : 0 < 1 - X i j := by + have := (hXint i).2 j |>.2 + have hxltq : X i j < 1 := + (Rat.cast_lt (K := ℝ)).mp (by simpa using this) + linarith + let e : ℚ := (1 / 2 : ℚ) ^ p + have hwidthx := scheduledLog_width_le hxq p + have hwidthc := scheduledLog_width_le hcxq p + have hxlo := scheduledLogLower_le_log hxq p + have hxhi := log_le_scheduledLogUpper hxq p + have hclo := scheduledLogLower_le_log hcxq p + have hchi := log_le_scheduledLogUpper hcxq p + have hxerr : Real.log (X i j : ℝ) ≤ + (scheduledLogLower (X i j) p : ℝ) + (e : ℝ) := by + have hw : ((scheduledLogUpper (X i j) p - + scheduledLogLower (X i j) p : ℚ) : ℝ) ≤ (e : ℝ) := by + exact_mod_cast hwidthx + push_cast at hw + linarith + have hcerr : Real.log ((1 - X i j : ℚ) : ℝ) ≤ + (scheduledLogLower (1 - X i j) p : ℝ) + (e : ℝ) := by + have hw : ((scheduledLogUpper (1 - X i j) p - + scheduledLogLower (1 - X i j) p : ℚ) : ℝ) ≤ (e : ℝ) := by + exact_mod_cast hwidthc + push_cast at hw + linarith + have hsumUpper : + ∑ k, (scheduledLogUpper (1 - X i k) p : ℝ) ≤ + Real.log (complementProduct (fun k ↦ ((X i k : ℚ) : ℝ))) + + n * (e : ℝ) := by + rw [complementProduct, Real.log_prod] + · have hpoint : ∀ k : Fin n, + (scheduledLogUpper (1 - X i k) p : ℝ) ≤ + Real.log (((1 - X i k : ℚ) : ℝ)) + (e : ℝ) := by + intro k + have hckq : 0 < 1 - X i k := by + have := (hXint i).2 k |>.2 + have hxltq : X i k < 1 := + (Rat.cast_lt (K := ℝ)).mp (by simpa using this) + linarith + have hw := scheduledLog_width_le hckq p + have hlo := scheduledLogLower_le_log hckq p + have hwR : ((scheduledLogUpper (1 - X i k) p - + scheduledLogLower (1 - X i k) p : ℚ) : ℝ) ≤ (e : ℝ) := by + exact_mod_cast hw + push_cast at hwR + linarith + calc + ∑ k, (scheduledLogUpper (1 - X i k) p : ℝ) ≤ + ∑ k, (Real.log (((1 - X i k : ℚ) : ℝ)) + (e : ℝ)) := + Finset.sum_le_sum fun k _ ↦ hpoint k + _ = (∑ k, Real.log (((1 - X i k : ℚ) : ℝ))) + n * (e : ℝ) := by + simp [Finset.sum_add_distrib] + _ = (∑ k, Real.log (1 - (X i k : ℝ))) + n * (e : ℝ) := by + congr 2 + funext k + norm_num + · intro k _ + exact (sub_pos.mpr ((hXint i).2 k |>.2)).ne' + have hτR0 : (0 : ℝ) ≤ (τ : ℝ) := by exact_mod_cast hτ0 + have hτR1 : (τ : ℝ) ≤ 1 := by exact_mod_cast hτ1 + have hmul : -(1 + (τ : ℝ)) * + (scheduledLogLower (X i j) p : ℝ) ≤ + -(1 + (τ : ℝ)) * Real.log (X i j : ℝ) + + 2 * (e : ℝ) := by + have hm := mul_le_mul_of_nonneg_left hxerr + (show 0 ≤ 1 + (τ : ℝ) by linarith) + nlinarith + have hnegc : -(scheduledLogLower (1 - X i j) p : ℝ) ≤ + -Real.log ((1 - X i j : ℚ) : ℝ) + (e : ℝ) := by linarith + change (directedTransferCostUpper τ X i j p : ℝ) ≤ + Real.log (1 / transferU (τ : ℝ) + (fun k ↦ ((X i k : ℚ) : ℝ)) j) + (n + 3 : ℝ) * (e : ℝ) + rw [log_one_div_transferU (hXint i)] + rw [directedTransferCostUpper] + push_cast + norm_num only [Rat.cast_sub, Rat.cast_one] at hcerr hnegc ⊢ + calc + -(1 + (τ : ℝ)) * (scheduledLogLower (X i j) p : ℝ) - + (scheduledLogLower (1 - X i j) p : ℝ) + + ∑ k, (scheduledLogUpper (1 - X i k) p : ℝ) ≤ + (-(1 + (τ : ℝ)) * Real.log (X i j : ℝ) + + 2 * (e : ℝ)) + + (-Real.log (1 - (X i j : ℝ)) + + (e : ℝ)) + + (Real.log (complementProduct (fun k ↦ ((X i k : ℚ) : ℝ))) + + n * (e : ℝ)) := by + linarith + _ = -(1 + (τ : ℝ)) * Real.log (X i j : ℝ) - + Real.log (1 - (X i j : ℝ)) + + Real.log (complementProduct (fun k ↦ ((X i k : ℚ) : ℝ))) + + (n + 3 : ℝ) * (e : ℝ) := by ring + +/-- Directed upper endpoint for the sum of the four core transfer costs. -/ +def directedFourCoreCostUpper {n : ℕ} + (τ : ℚ) (X : Matrix (Fin n) (Fin n) ℚ) + (r s a b : Fin n) (p : ℕ) : ℚ := + directedTransferCostUpper τ X r a p + + directedTransferCostUpper τ X r b p + + directedTransferCostUpper τ X s a p + + directedTransferCostUpper τ X s b p + +theorem fourCoreTransferCost_le_directedFourCoreCostUpper + {n : ℕ} {τ : ℚ} {X : Matrix (Fin n) (Fin n) ℚ} + (hτ : -1 ≤ τ) + (hXint : ∀ i, IsInteriorProbabilityVector + (fun j ↦ ((X i j : ℚ) : ℝ))) + (r s a b : Fin n) (p : ℕ) : + fourCoreTransferCost (τ : ℝ) + (fun i j ↦ ((X i j : ℚ) : ℝ)) r s a b ≤ + (directedFourCoreCostUpper τ X r s a b p : ℝ) := by + rw [fourCoreTransferCost, directedFourCoreCostUpper] + push_cast + linarith [transferCost_le_directedTransferCostUpper hτ hXint r a p, + transferCost_le_directedTransferCostUpper hτ hXint r b p, + transferCost_le_directedTransferCostUpper hτ hXint s a p, + transferCost_le_directedTransferCostUpper hτ hXint s b p] + +theorem directedFourCoreCostUpper_le_add_error + {n : ℕ} {τ : ℚ} {X : Matrix (Fin n) (Fin n) ℚ} + (hτ0 : 0 ≤ τ) (hτ1 : τ ≤ 1) + (hXint : ∀ i, IsInteriorProbabilityVector + (fun j ↦ ((X i j : ℚ) : ℝ))) + (r s a b : Fin n) (p : ℕ) : + (directedFourCoreCostUpper τ X r s a b p : ℝ) ≤ + fourCoreTransferCost (τ : ℝ) + (fun i j ↦ ((X i j : ℚ) : ℝ)) r s a b + + 4 * (n + 3 : ℝ) * ((1 / 2 : ℚ) ^ p : ℚ) := by + have hra := directedTransferCostUpper_le_add_error hτ0 hτ1 hXint r a p + have hrb := directedTransferCostUpper_le_add_error hτ0 hτ1 hXint r b p + have hsa := directedTransferCostUpper_le_add_error hτ0 hτ1 hXint s a p + have hsb := directedTransferCostUpper_le_add_error hτ0 hτ1 hXint s b p + have hecast : ((((1 / 2 : ℚ) ^ p : ℚ)) : ℝ) = (1 / 2 : ℝ) ^ p := by + norm_num + rw [fourCoreTransferCost, directedFourCoreCostUpper] + push_cast + rw [← hecast] + linarith + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/DyadicMagnitudePrecision.lean b/LeanPool/BeyondBethe/BeyondBethe/DyadicMagnitudePrecision.lean new file mode 100644 index 0000000000..95e0e7e91a --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/DyadicMagnitudePrecision.lean @@ -0,0 +1,144 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.DyadicRounding +import Mathlib.Data.Nat.Size +import Mathlib.Tactic + +/-! # Dyadic Magnitude Precision -/ + +namespace BeyondBethe + +/-! +# A magnitude-sensitive dyadic precision + +Using the full encoding length of a rational as a dyadic precision is much +too conservative: the determinant of a dyadic `d`-by-`d` matrix can have a +denominator with `d p` bits even when its numerical magnitude is bounded +away from zero. Iterating that rule would multiply the stored precision by +the dimension. The definition below instead uses the *difference* between +the denominator and numerator bit lengths. It therefore measures +`log₂ (1 / q)`, up to an additive fixedValue, rather than the cost of writing +the exact reduced fraction. +-/ + +/-- A total precision selector. On a positive rational it is, up to two +guard bits, the binary exponent needed to resolve its magnitude. -/ +def positiveDyadicPrecision (q : ℚ) : ℕ := + q.den.size + 2 - q.num.natAbs.size + +theorem positiveDyadicPrecision_add_num_size_ge (q : ℚ) : + q.den.size + 2 ≤ + positiveDyadicPrecision q + q.num.natAbs.size := by + rw [positiveDyadicPrecision] + omega + +/-- The selected dyadic mesh is strictly below every positive input. -/ +theorem dyadicMesh_positiveDyadicPrecision_lt {q : ℚ} (hq : 0 < q) : + dyadicMesh (positiveDyadicPrecision q) < q := by + let a := q.num.natAbs + let D := q.den.size + let N := a.size + let p := positiveDyadicPrecision q + have hnum : 0 < q.num := Rat.num_pos.mpr hq + have ha0 : 0 < a := by + dsimp only [a] + exact Int.natAbs_pos.mpr hnum.ne' + have hN0 : 0 < N := by + dsimp only [N] + exact Nat.size_pos.mpr ha0 + have haLower : 2 ^ (N - 1) ≤ a := by + rw [← Nat.lt_size] + dsimp only [N] + omega + have hdenUpper : q.den < 2 ^ D := by + dsimp only [D] + exact Nat.lt_size_self q.den + have hsum : D + 2 ≤ p + N := by + simpa only [D, N, p] using positiveDyadicPrecision_add_num_size_ge q + have hexp : 2 ^ (D + 1) ≤ 2 ^ (p + (N - 1)) := by + apply Nat.pow_le_pow_right (by norm_num : 0 < 2) + omega + have hmulLower : 2 ^ (p + (N - 1)) ≤ 2 ^ p * a := by + rw [pow_add] + exact Nat.mul_le_mul_left _ haLower + have hdenMul : q.den < 2 ^ p * a := by + calc + q.den < 2 ^ D := hdenUpper + _ < 2 ^ (D + 1) := by + rw [pow_succ] + have : 0 < 2 ^ D := by positivity + omega + _ ≤ 2 ^ (p + (N - 1)) := hexp + _ ≤ 2 ^ p * a := hmulLower + have hqrep : q = (a : ℚ) / (q.den : ℚ) := by + calc + q = (q.num : ℚ) / (q.den : ℚ) := (Rat.num_div_den q).symm + _ = (a : ℚ) / (q.den : ℚ) := by + congr 1 + have haz : (a : ℤ) = q.num := by + dsimp only [a] + exact Int.natAbs_of_nonneg hnum.le + have hcast := congrArg (fun z : ℤ ↦ (z : ℚ)) haz.symm + simpa using hcast + have hdenMulQ : (q.den : ℚ) < (2 : ℚ) ^ p * (a : ℚ) := by + exact_mod_cast hdenMul + change 1 / (2 : ℚ) ^ p < q + rw [hqrep] + have hpow : (0 : ℚ) < (2 : ℚ) ^ p := by positivity + have hden : (0 : ℚ) < q.den := by positivity + rw [div_lt_div_iff₀ hpow hden] + simpa [mul_comm, mul_left_comm, mul_assoc] using hdenMulQ + +/-- Conversely, any proved dyadic lower bound on a positive rational gives +a direct upper bound on the selected precision. This is the key estimate +that prevents precision from tracking irrelevant exact denominators. -/ +theorem positiveDyadicPrecision_le_of_dyadicMesh_le + {q : ℚ} (hq : 0 < q) {P : ℕ} + (hlower : dyadicMesh P ≤ q) : + positiveDyadicPrecision q ≤ P + 2 := by + let a := q.num.natAbs + let D := q.den.size + let N := a.size + have hnum : 0 < q.num := Rat.num_pos.mpr hq + have ha0 : 0 < a := by + dsimp only [a] + exact Int.natAbs_pos.mpr hnum.ne' + have hqrep : q = (a : ℚ) / (q.den : ℚ) := by + calc + q = (q.num : ℚ) / (q.den : ℚ) := (Rat.num_div_den q).symm + _ = (a : ℚ) / (q.den : ℚ) := by + congr 1 + have haz : (a : ℤ) = q.num := by + dsimp only [a] + exact Int.natAbs_of_nonneg hnum.le + have hcast := congrArg (fun z : ℤ ↦ (z : ℚ)) haz.symm + simpa using hcast + have hcrossQ : (q.den : ℚ) ≤ (2 : ℚ) ^ P * (a : ℚ) := by + rw [dyadicMesh, hqrep] at hlower + have hpow : (0 : ℚ) < (2 : ℚ) ^ P := by positivity + have hden : (0 : ℚ) < q.den := by positivity + rw [div_le_div_iff₀ hpow hden] at hlower + simpa [mul_comm, mul_left_comm, mul_assoc] using hlower + have hcross : q.den ≤ 2 ^ P * a := by + exact_mod_cast hcrossQ + have haUpper : a < 2 ^ N := by + dsimp only [N] + exact Nat.lt_size_self a + have hdenUpper : q.den < 2 ^ (P + N) := by + calc + q.den ≤ 2 ^ P * a := hcross + _ < 2 ^ P * 2 ^ N := + Nat.mul_lt_mul_of_pos_left haUpper (by positivity) + _ = 2 ^ (P + N) := by rw [pow_add] + have hD : D ≤ P + N := by + dsimp only [D] + exact Nat.size_le.mpr hdenUpper + dsimp only [D, N, a] at hD + rw [positiveDyadicPrecision] + omega + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/DyadicRounding.lean b/LeanPool/BeyondBethe/BeyondBethe/DyadicRounding.lean new file mode 100644 index 0000000000..29e6e61f64 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/DyadicRounding.lean @@ -0,0 +1,194 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.AlgorithmicSpec +import LeanPool.BeyondBethe.BeyondBethe.RationalEllipsoid +import Mathlib.Data.Rat.Floor +import Mathlib.Tactic + +/-! # Dyadic Rounding -/ + +open scoped BigOperators + +namespace BeyondBethe + +/-! +# Executable dyadic rounding + +The exact rational ellipsoid update is mathematically convenient, but its +reduced numerators and denominators need not have polynomial length after a +polynomial number of iterations. This file defines the rounding primitive +used by the bounded-bit implementation. It is deliberately just integer +floor followed by division by a power of two, so its output has an explicit +dyadic presentation and its error is proved directly from the floor axioms. +-/ + +/-- The mesh of the dyadic grid with `p` fractional bits. -/ +def dyadicMesh (p : ℕ) : ℚ := 1 / (2 : ℚ) ^ p + +theorem dyadicMesh_pos (p : ℕ) : 0 < dyadicMesh p := by + simp [dyadicMesh] + +theorem dyadicMesh_nonneg (p : ℕ) : 0 ≤ dyadicMesh p := + (dyadicMesh_pos p).le + +theorem dyadicMesh_le_one (p : ℕ) : dyadicMesh p ≤ 1 := by + rw [dyadicMesh, one_div] + exact inv_le_one_of_one_le₀ (one_le_pow₀ (by norm_num : (1 : ℚ) ≤ 2)) + +/-- Finer dyadic grids have smaller mesh. -/ +theorem dyadicMesh_antitone {p q : ℕ} (hpq : p ≤ q) : + dyadicMesh q ≤ dyadicMesh p := by + obtain ⟨k, rfl⟩ := Nat.exists_eq_add_of_le hpq + rw [dyadicMesh, dyadicMesh] + exact one_div_le_one_div_of_le (by positivity : (0 : ℚ) < (2 : ℚ) ^ p) + (by + rw [pow_add] + simpa only [mul_one] using mul_le_mul_of_nonneg_left + (one_le_pow₀ (by norm_num : (1 : ℚ) ≤ 2)) + (by positivity : (0 : ℚ) ≤ (2 : ℚ) ^ p)) + +theorem dyadicMesh_mul_pow_two (p : ℕ) : + dyadicMesh p * (2 : ℚ) ^ p = 1 := by + simp [dyadicMesh] + +/-- Round a rational down to the `2^-p` grid. This is executable integer +division, not a choice of a nearby rational. -/ +def dyadicFloor (p : ℕ) (q : ℚ) : ℚ := + (Int.floor (q * (2 : ℚ) ^ p) : ℚ) / (2 : ℚ) ^ p + +theorem dyadicFloor_eq_floor_mul_mesh (p : ℕ) (q : ℚ) : + dyadicFloor p q = (Int.floor (q * (2 : ℚ) ^ p) : ℚ) * dyadicMesh p := by + simp [dyadicFloor, dyadicMesh, div_eq_mul_inv] + +theorem dyadicFloor_mul_pow_two (p : ℕ) (q : ℚ) : + dyadicFloor p q * (2 : ℚ) ^ p = + (Int.floor (q * (2 : ℚ) ^ p) : ℚ) := by + rw [dyadicFloor] + field_simp + +/-- Rounding down never increases the input. -/ +theorem dyadicFloor_le (p : ℕ) (q : ℚ) : dyadicFloor p q ≤ q := by + have hfloor : + ((Int.floor (q * (2 : ℚ) ^ p) : ℤ) : ℚ) ≤ + q * (2 : ℚ) ^ p := Int.floor_le _ + rw [dyadicFloor] + exact (div_le_iff₀ (by positivity : (0 : ℚ) < (2 : ℚ) ^ p)).2 + (by simpa [mul_comm] using hfloor) + +/-- The one-sided rounding error is strictly smaller than one mesh. -/ +theorem lt_dyadicFloor_add_mesh (p : ℕ) (q : ℚ) : + q < dyadicFloor p q + dyadicMesh p := by + have hfloor : q * (2 : ℚ) ^ p < + ((Int.floor (q * (2 : ℚ) ^ p) : ℤ) : ℚ) + 1 := + Int.lt_floor_add_one _ + rw [dyadicFloor, dyadicMesh] + have hp : (0 : ℚ) < (2 : ℚ) ^ p := by positivity + rw [show + ((Int.floor (q * (2 : ℚ) ^ p) : ℤ) : ℚ) / (2 : ℚ) ^ p + + 1 / (2 : ℚ) ^ p = + (((Int.floor (q * (2 : ℚ) ^ p) : ℤ) : ℚ) + 1) / + (2 : ℚ) ^ p by rw [add_div]] + exact (lt_div_iff₀ hp).2 (by simpa [mul_comm] using hfloor) + +theorem dyadicFloor_error_nonneg (p : ℕ) (q : ℚ) : + 0 ≤ q - dyadicFloor p q := sub_nonneg.mpr (dyadicFloor_le p q) + +theorem dyadicFloor_error_lt (p : ℕ) (q : ℚ) : + q - dyadicFloor p q < dyadicMesh p := by + linarith [lt_dyadicFloor_add_mesh p q] + +/-- Absolute-error form used by vector and matrix estimates. -/ +theorem abs_dyadicFloor_sub_lt (p : ℕ) (q : ℚ) : + abs (dyadicFloor p q - q) < dyadicMesh p := by + rw [abs_of_nonpos (sub_nonpos.mpr (dyadicFloor_le p q))] + simpa only [neg_sub] using dyadicFloor_error_lt p q + +theorem abs_dyadicFloor_le (p : ℕ) (q : ℚ) : + abs (dyadicFloor p q) < abs q + dyadicMesh p := by + calc + abs (dyadicFloor p q) = + abs ((dyadicFloor p q - q) + q) := by ring_nf + _ ≤ abs (dyadicFloor p q - q) + abs q := abs_add_le _ _ + _ < dyadicMesh p + abs q := by + gcongr + exact abs_dyadicFloor_sub_lt p q + _ = abs q + dyadicMesh p := by ring + +/-- Coordinatewise dyadic rounding of a finite vector. -/ +def dyadicFloorVector {d : ℕ} (p : ℕ) (x : Fin d → ℚ) : Fin d → ℚ := + fun i ↦ dyadicFloor p (x i) + +/-- Coordinatewise dyadic rounding of a finite matrix. -/ +def dyadicFloorMatrix {m n : ℕ} (p : ℕ) + (A : Matrix (Fin m) (Fin n) ℚ) : Matrix (Fin m) (Fin n) ℚ := + fun i j ↦ dyadicFloor p (A i j) + +theorem dyadicFloorVector_error_l1_lt {d : ℕ} (hd : 0 < d) (p : ℕ) + (x : Fin d → ℚ) : + (∑ i, abs (dyadicFloorVector p x i - x i)) < d * dyadicMesh p := by + letI : Nonempty (Fin d) := Fin.pos_iff_nonempty.mp hd + rw [show (d : ℚ) * dyadicMesh p = + ∑ _i : Fin d, dyadicMesh p by simp] + apply Finset.sum_lt_sum + · intro i _ + exact (abs_dyadicFloor_sub_lt p (x i)).le + · let i : Fin d := ⟨0, hd⟩ + exact ⟨i, Finset.mem_univ i, abs_dyadicFloor_sub_lt p (x i)⟩ + +theorem dyadicFloorVector_error_normSq_lt {d : ℕ} (hd : 0 < d) + (p : ℕ) (x : Fin d → ℚ) : + finiteNormSq (fun i ↦ dyadicFloorVector p x i - x i) < + d * dyadicMesh p ^ 2 := by + letI : Nonempty (Fin d) := Fin.pos_iff_nonempty.mp hd + rw [finiteNormSq, finiteDot, + show (d : ℚ) * dyadicMesh p ^ 2 = + ∑ _i : Fin d, dyadicMesh p ^ 2 by simp] + have hentry : ∀ i : Fin d, + (dyadicFloorVector p x i - x i) * + (dyadicFloorVector p x i - x i) < dyadicMesh p ^ 2 := by + intro i + have habs : abs (dyadicFloorVector p x i - x i) < dyadicMesh p := by + simpa only [dyadicFloorVector] using abs_dyadicFloor_sub_lt p (x i) + have habs0 : 0 ≤ abs (dyadicFloorVector p x i - x i) := abs_nonneg _ + have hmesh := dyadicMesh_nonneg p + calc + (dyadicFloorVector p x i - x i) * + (dyadicFloorVector p x i - x i) = + abs (dyadicFloorVector p x i - x i) ^ 2 := by + rw [sq_abs, sq] + _ < dyadicMesh p ^ 2 := (sq_lt_sq₀ habs0 hmesh).2 habs + apply Finset.sum_lt_sum + · intro i _ + exact (hentry i).le + · let i : Fin d := ⟨0, hd⟩ + exact ⟨i, Finset.mem_univ i, hentry i⟩ + +theorem dyadicFloorMatrix_entry_error_lt {m n : ℕ} (p : ℕ) + (A : Matrix (Fin m) (Fin n) ℚ) (i : Fin m) (j : Fin n) : + abs (dyadicFloorMatrix p A i j - A i j) < dyadicMesh p := + abs_dyadicFloor_sub_lt p (A i j) + +theorem cast_dyadicFloorMatrix_entry_error_lt {m n : ℕ} (p : ℕ) + (A : Matrix (Fin m) (Fin n) ℚ) (i : Fin m) (j : Fin n) : + abs (((dyadicFloorMatrix p A i j - A i j : ℚ) : ℝ)) < + (dyadicMesh p : ℝ) := by + exact_mod_cast dyadicFloorMatrix_entry_error_lt p A i j + +theorem abs_cast_dyadicFloorMatrix_le {m n : ℕ} (p : ℕ) + (A : Matrix (Fin m) (Fin n) ℚ) (i : Fin m) (j : Fin n) : + abs ((dyadicFloorMatrix p A i j : ℚ) : ℝ) < + abs ((A i j : ℚ) : ℝ) + (dyadicMesh p : ℝ) := by + exact_mod_cast abs_dyadicFloor_le p (A i j) + +/-- Every rounded value has a concrete integer-over-power-of-two +presentation. Later bit-complexity proofs use this presentation rather than +the implementation-dependent reduced numerator and denominator. -/ +theorem dyadicFloor_has_integer_presentation (p : ℕ) (q : ℚ) : + ∃ z : ℤ, dyadicFloor p q = (z : ℚ) / (2 : ℚ) ^ p := by + exact ⟨Int.floor (q * (2 : ℚ) ^ p), rfl⟩ + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/Entropy.lean b/LeanPool/BeyondBethe/BeyondBethe/Entropy.lean new file mode 100644 index 0000000000..5e6ca0bdbe --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/Entropy.lean @@ -0,0 +1,859 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.Birkhoff +import Mathlib.Analysis.Convex.Jensen +import Mathlib.Analysis.MeanInequalities +import Mathlib.Analysis.SpecialFunctions.Log.NegMulLog +import Mathlib.Analysis.SpecialFunctions.Pow.Real +import Mathlib.Data.Fintype.Perm +import Mathlib.Tactic + +/-! # Entropy -/ + +open scoped BigOperators + +namespace BeyondBethe + +/-- A probability vector on a finite type. -/ +def IsProbabilityVector + {ι : Type*} [Fintype ι] (p : ι → ℝ) : Prop := + (∀ i, 0 ≤ p i) ∧ ∑ i, p i = 1 + +/-- A probability vector with full support. -/ +def IsStrictProbabilityVector + {ι : Type*} [Fintype ι] (p : ι → ℝ) : Prop := + IsProbabilityVector p ∧ ∀ i, 0 < p i + +theorem IsStrictProbabilityVector.probability + {ι : Type*} [Fintype ι] {p : ι → ℝ} + (hp : IsStrictProbabilityVector p) : + IsProbabilityVector p := + hp.1 + +theorem IsStrictProbabilityVector.positive + {ι : Type*} [Fintype ι] {p : ι → ℝ} + (hp : IsStrictProbabilityVector p) (i : ι) : + 0 < p i := + hp.2 i + +theorem IsProbabilityVector.nonnegative + {ι : Type*} [Fintype ι] {p : ι → ℝ} + (hp : IsProbabilityVector p) (i : ι) : + 0 ≤ p i := + hp.1 i + +theorem IsProbabilityVector.sum_eq_one + {ι : Type*} [Fintype ι] {p : ι → ℝ} + (hp : IsProbabilityVector p) : + ∑ i, p i = 1 := + hp.2 + +theorem IsProbabilityVector.le_one + {ι : Type*} [Fintype ι] [DecidableEq ι] + {p : ι → ℝ} (hp : IsProbabilityVector p) (i : ι) : + p i ≤ 1 := by + rw [← hp.sum_eq_one] + exact Finset.single_le_sum + (fun j _ ↦ hp.nonnegative j) (Finset.mem_univ i) + +theorem IsDoublyStochastic.row_probability + {n : Type*} [Fintype n] {X : Matrix n n ℝ} + (hX : IsDoublyStochastic X) (i : n) : + IsProbabilityVector (X i) := by + exact ⟨hX.nonnegative i, hX.row_sum i⟩ + +/-- Shannon entropy with the convention `0 log 0 = 0`. -/ +noncomputable def shannonEntropy + {ι : Type*} [Fintype ι] (p : ι → ℝ) : ℝ := + ∑ i, Real.negMulLog (p i) + +theorem shannonEntropy_nonneg + {ι : Type*} [Fintype ι] [DecidableEq ι] + {p : ι → ℝ} (hp : IsProbabilityVector p) : + 0 ≤ shannonEntropy p := by + apply Finset.sum_nonneg + intro i _ + exact Real.negMulLog_nonneg (hp.nonnegative i) (hp.le_one i) + +/-- Entropy is at most the logarithm of the support size. -/ +theorem shannonEntropy_le_log_card + {ι : Type*} [Fintype ι] [DecidableEq ι] [Nonempty ι] + {p : ι → ℝ} (hp : IsProbabilityVector p) : + shannonEntropy p ≤ Real.log (Fintype.card ι) := by + let N : ℝ := Fintype.card ι + have hN : 0 < N := by + dsimp [N] + exact_mod_cast Fintype.card_pos + have hweights : ∑ _i : ι, (1 / N : ℝ) = 1 := by + rw [Finset.sum_const, Finset.card_univ, nsmul_eq_mul] + dsimp [N] + field_simp + have hJ := Real.concaveOn_negMulLog.le_map_sum + (t := Finset.univ) (w := fun _i : ι ↦ 1 / N) (p := p) + (fun _ _ ↦ by positivity) hweights + (fun i _ ↦ hp.nonnegative i) + have havg : + (1 / N) * shannonEntropy p ≤ Real.negMulLog (1 / N) := by + simpa only [smul_eq_mul, shannonEntropy, ← Finset.mul_sum, + hp.sum_eq_one, mul_one] using hJ + have hmul := mul_le_mul_of_nonneg_left havg hN.le + have hleft : N * ((1 / N) * shannonEntropy p) = shannonEntropy p := by + field_simp + have hright : N * Real.negMulLog (1 / N) = Real.log N := by + rw [Real.negMulLog_def] + field_simp + simp [Real.log_inv] + rw [hleft, hright] at hmul + simpa [N] using hmul + +/-- Total row entropy of a doubly stochastic matrix. -/ +noncomputable def totalRowEntropy + {n : Type*} [Fintype n] (X : Matrix n n ℝ) : ℝ := + ∑ i, shannonEntropy (X i) + +theorem totalRowEntropy_nonneg + {n : Type*} [Fintype n] [DecidableEq n] + {X : Matrix n n ℝ} (hX : IsDoublyStochastic X) : + 0 ≤ totalRowEntropy X := by + exact Finset.sum_nonneg fun i _ ↦ + shannonEntropy_nonneg (hX.row_probability i) + +theorem totalRowEntropy_le + {n : Type*} [Fintype n] [DecidableEq n] [Nonempty n] + {X : Matrix n n ℝ} (hX : IsDoublyStochastic X) : + totalRowEntropy X ≤ + Fintype.card n * Real.log (Fintype.card n) := by + rw [totalRowEntropy] + calc + ∑ i, shannonEntropy (X i) + ≤ ∑ _i : n, Real.log (Fintype.card n) := + Finset.sum_le_sum fun i _ ↦ + shannonEntropy_le_log_card (hX.row_probability i) + _ = Fintype.card n * Real.log (Fintype.card n) := by + simp [nsmul_eq_mul] + +/-- Binary entropy, again with the continuous boundary convention. -/ +noncomputable def binaryEntropy (t : ℝ) : ℝ := + Real.negMulLog t + Real.negMulLog (1 - t) + +theorem binaryEntropy_symm (t : ℝ) : + binaryEntropy (1 - t) = binaryEntropy t := by + rw [binaryEntropy, binaryEntropy] + ring_nf + +/-- Exact entropy loss when two positive atoms of masses `u` and `v` are +merged. This is the scalar identity used in paper (26). -/ +theorem entropy_loss_merge_two {u v : ℝ} (hu : 0 < u) (hv : 0 < v) : + Real.negMulLog u + Real.negMulLog v - Real.negMulLog (u + v) = + (u + v) * binaryEntropy (u / (u + v)) := by + have hs : u + v ≠ 0 := (add_pos hu hv).ne' + have hratio : 1 - u / (u + v) = v / (u + v) := by + field_simp + ring + rw [binaryEntropy, hratio] + simp only [Real.negMulLog_def] + rw [Real.log_div hu.ne' hs, Real.log_div hv.ne' hs] + field_simp + ring + +/-- Finite log-sum inequality with strictly positive weights. This is the +one-sided, certificate-producing half of the entropy duality for capacity. -/ +theorem log_sum_inequality + {ι : Type*} [Fintype ι] [DecidableEq ι] + {θ w : ι → ℝ} + (hθ : ∀ i, 0 < θ i) (hθsum : ∑ i, θ i = 1) + (hw : ∀ i, 0 < w i) : + ∑ i, θ i * Real.log (w i / θ i) ≤ Real.log (∑ i, w i) := by + let r : ι → ℝ := fun i ↦ w i / θ i + have hr : ∀ i, 0 < r i := fun i ↦ div_pos (hw i) (hθ i) + have hAM := Real.geom_mean_le_arith_mean_weighted + Finset.univ θ r + (fun i _ ↦ (hθ i).le) hθsum + (fun i _ ↦ (hr i).le) + have harith : ∑ i, θ i * r i = ∑ i, w i := by + apply Finset.sum_congr rfl + intro i _ + dsimp [r] + field_simp [(hθ i).ne'] + rw [harith] at hAM + have hprod : 0 < ∏ i, (r i) ^ (θ i) := + Finset.prod_pos fun i _ ↦ Real.rpow_pos_of_pos (hr i) _ + have hlog := Real.log_le_log hprod hAM + rw [Real.log_prod (fun i _ ↦ (Real.rpow_pos_of_pos (hr i) _).ne')] at hlog + simp_rw [Real.log_rpow (hr _) ] at hlog + simpa [r] using hlog + +/-- Log-sum with zero weights allowed. Terms of weight zero use Lean's +continuous convention `0 * log 0 = 0`; the proof restricts to the positive +support before applying the strict version. -/ +theorem log_sum_inequality_nonnegative + {ι : Type*} [Fintype ι] [DecidableEq ι] + {θ w : ι → ℝ} + (hθ : ∀ i, 0 ≤ θ i) (hθsum : ∑ i, θ i = 1) + (hw : ∀ i, 0 < w i) : + ∑ i, θ i * Real.log (w i / θ i) ≤ Real.log (∑ i, w i) := by + let s : Finset ι := Finset.univ.filter fun i ↦ 0 < θ i + have hs : s.Nonempty := by + by_contra hempty + have hzero : ∀ i, θ i = 0 := by + intro i + have hnot : ¬0 < θ i := by + intro hi + exact hempty ⟨i, by simp [s, hi]⟩ + exact le_antisymm (le_of_not_gt hnot) (hθ i) + have : (∑ i, θ i) = 0 := by simp [hzero] + linarith + letI : Nonempty s := ⟨⟨hs.choose, hs.choose_spec⟩⟩ + let θs : s → ℝ := fun i ↦ θ i + let ws : s → ℝ := fun i ↦ w i + have hθs : ∀ i, 0 < θs i := by + intro i + exact (Finset.mem_filter.mp i.property).2 + have hθsSum : ∑ i, θs i = 1 := by + have hsupport : (∑ i ∈ s, θ i) = ∑ i, θ i := by + apply Finset.sum_subset (Finset.subset_univ s) + intro i _ hi + have hnot : ¬0 < θ i := by + intro hpos + exact hi (by simp [s, hpos]) + exact le_antisymm (le_of_not_gt hnot) (hθ i) + calc + (∑ i : s, θs i) = ∑ i ∈ s, θ i := by + simpa [θs] using Finset.sum_coe_sort s (fun i ↦ θ i) + _ = 1 := by rw [hsupport, hθsum] + have hstrict := log_sum_inequality hθs hθsSum (fun i ↦ hw i) + have hleft : (∑ i : s, θs i * Real.log (ws i / θs i)) = + ∑ i, θ i * Real.log (w i / θ i) := by + have hsupport : + (∑ i ∈ s, θ i * Real.log (w i / θ i)) = + ∑ i, θ i * Real.log (w i / θ i) := by + apply Finset.sum_subset (Finset.subset_univ s) + intro i _ hi + have hnot : ¬0 < θ i := by + intro hpos + exact hi (by simp [s, hpos]) + have hzero : θ i = 0 := le_antisymm (le_of_not_gt hnot) (hθ i) + simp [hzero] + calc + (∑ i : s, θs i * Real.log (ws i / θs i)) = + ∑ i ∈ s, θ i * Real.log (w i / θ i) := by + simpa [θs, ws] using Finset.sum_coe_sort s + (fun i ↦ θ i * Real.log (w i / θ i)) + _ = ∑ i, θ i * Real.log (w i / θ i) := hsupport + have hrightSupport : (∑ i : s, ws i) = ∑ i ∈ s, w i := by + simpa [ws] using Finset.sum_coe_sort s (fun i ↦ w i) + have hsupportPos : 0 < ∑ i : s, ws i := + Finset.sum_pos (fun i _ ↦ hw i) Finset.univ_nonempty + have hallPos : 0 < ∑ i, w i := + Finset.sum_pos (fun i _ ↦ hw i) (hs.mono (Finset.subset_univ s)) + have hsumLe : (∑ i : s, ws i) ≤ ∑ i, w i := by + rw [hrightSupport] + exact Finset.sum_le_sum_of_subset_of_nonneg (Finset.subset_univ s) + (fun i _ _ ↦ (hw i).le) + rw [hleft] at hstrict + exact hstrict.trans (Real.log_le_log hsupportPos hsumLe) + +/-- Entropy bound for a nonnegative vector of total mass `ρ`. This is the +scaled form used for the outside mass in paper (60). -/ +theorem shannonEntropy_of_mass_le + {ι : Type*} [Fintype ι] [DecidableEq ι] [Nonempty ι] + {α : ι → ℝ} {ρ : ℝ} + (hα : ∀ i, 0 ≤ α i) (hρ : 0 < ρ) (hsum : ∑ i, α i = ρ) : + shannonEntropy α ≤ ρ * Real.log (Fintype.card ι / ρ) := by + let q : ι → ℝ := fun i ↦ α i / ρ + have hq : IsProbabilityVector q := by + constructor + · intro i + exact div_nonneg (hα i) hρ.le + · dsimp [q] + rw [← Finset.sum_div, hsum, div_self hρ.ne'] + have hscale : shannonEntropy α = + ρ * shannonEntropy q - ρ * Real.log ρ := by + calc + shannonEntropy α = + ∑ i, (ρ * Real.negMulLog (q i) - α i * Real.log ρ) := by + rw [shannonEntropy] + apply Finset.sum_congr rfl + intro i _ + by_cases hzero : α i = 0 + · simp [hzero, q] + · simp only [Real.negMulLog_def] + rw [Real.log_div hzero hρ.ne'] + dsimp [q] + field_simp + ring + _ = ρ * shannonEntropy q - (∑ i, α i) * Real.log ρ := by + rw [Finset.sum_sub_distrib, ← Finset.mul_sum, + ← Finset.sum_mul, shannonEntropy] + _ = ρ * shannonEntropy q - ρ * Real.log ρ := by rw [hsum] + have hentropy := shannonEntropy_le_log_card hq + have hmul := mul_le_mul_of_nonneg_left hentropy hρ.le + rw [hscale] + rw [Real.log_div (by exact_mod_cast Fintype.card_ne_zero) hρ.ne'] + linarith + +/-- Probability mass induced on the values of a deterministic map. -/ +noncomputable def pushforwardMass + {α β : Type*} [Fintype α] [Fintype β] [DecidableEq β] + (μ : α → ℝ) (f : α → β) (y : β) : ℝ := + ∑ x, if f x = y then μ x else 0 + +theorem pushforwardMass_isProbabilityVector + {α β : Type*} [Fintype α] [Fintype β] [DecidableEq β] + (μ : α → ℝ) (hμ : IsProbabilityVector μ) (f : α → β) : + IsProbabilityVector (pushforwardMass μ f) := by + classical + constructor + · intro y + exact Finset.sum_nonneg (fun x _ ↦ by + by_cases h : f x = y + · simp only [if_pos h] + exact hμ.nonnegative x + · simp only [if_neg h] + exact le_rfl) + · simp only [pushforwardMass] + calc + (∑ y, ∑ x, if f x = y then μ x else 0) = + ∑ x, ∑ y, if f x = y then μ x else 0 := Finset.sum_comm + _ = ∑ x, μ x := by simp + _ = 1 := hμ.sum_eq_one + +theorem pushforwardMass_comp + {α β γ : Type*} [Fintype α] [Fintype β] [Fintype γ] + [DecidableEq β] [DecidableEq γ] + (μ : α → ℝ) (f : α → β) (g : β → γ) (z : γ) : + pushforwardMass (pushforwardMass μ f) g z = + pushforwardMass μ (g ∘ f) z := by + classical + calc + pushforwardMass (pushforwardMass μ f) g z = + ∑ y, ∑ x, if g y = z ∧ f x = y then μ x else 0 := by + unfold pushforwardMass + apply Finset.sum_congr rfl + intro y _ + by_cases hy : g y = z + · simp [hy] + · simp [hy] + _ = ∑ x, ∑ y, if g y = z ∧ f x = y then μ x else 0 := + Finset.sum_comm + _ = pushforwardMass μ (g ∘ f) z := by + unfold pushforwardMass + apply Finset.sum_congr rfl + intro x _ + by_cases hx : g (f x) = z + · simp only [Function.comp_apply, if_pos hx] + rw [Finset.sum_eq_single (f x)] + · simp [hx] + · intro y _ hy + simp [Ne.symm hy] + · simp + · simp only [Function.comp_apply, if_neg hx] + apply Finset.sum_eq_zero + intro y _ + by_cases hy : f x = y + · subst y + simp [hx] + · simp [hy] + +theorem pushforwardMass_equiv_apply + {α β : Type*} [Fintype α] [Fintype β] [DecidableEq β] + (μ : α → ℝ) (e : α ≃ β) (y : β) : + pushforwardMass μ e y = μ (e.symm y) := by + classical + unfold pushforwardMass + rw [Finset.sum_eq_single (e.symm y)] + · simp + · intro x _ hx + have hne : e x ≠ y := by + intro h + apply hx + exact e.injective (h.trans (e.apply_symm_apply y).symm) + simp [hne] + · simp + +theorem shannonEntropy_pushforward_equiv + {α β : Type*} [Fintype α] [Fintype β] [DecidableEq β] + (μ : α → ℝ) (e : α ≃ β) : + shannonEntropy (pushforwardMass μ e) = shannonEntropy μ := by + simp_rw [shannonEntropy, pushforwardMass_equiv_apply] + exact e.symm.sum_comp (fun x ↦ Real.negMulLog (μ x)) + +/-- The first marginal of a probability mass on a finite product. -/ +noncomputable def firstMarginal + {α β : Type*} [Fintype β] (μ : α × β → ℝ) (x : α) : ℝ := + ∑ y, μ (x, y) + +/-- The second marginal of a probability mass on a finite product. -/ +noncomputable def secondMarginal + {α β : Type*} [Fintype α] (μ : α × β → ℝ) (y : β) : ℝ := + ∑ x, μ (x, y) + +/-- Conditional second-coordinate mass. It is set to zero on a zero-mass +first-coordinate fiber, using Lean's division convention. -/ +noncomputable def conditionalSecond + {α β : Type*} [Fintype β] (μ : α × β → ℝ) (x : α) (y : β) : ℝ := + μ (x, y) / firstMarginal μ x + +theorem firstMarginal_isProbabilityVector + {α β : Type*} [Fintype α] [Fintype β] + {μ : α × β → ℝ} (hμ : IsProbabilityVector μ) : + IsProbabilityVector (firstMarginal μ) := by + constructor + · intro x + exact Finset.sum_nonneg fun y _ ↦ hμ.nonnegative (x, y) + · change (∑ x, ∑ y, μ (x, y)) = 1 + rw [← Finset.sum_product] + exact hμ.sum_eq_one + +theorem secondMarginal_isProbabilityVector + {α β : Type*} [Fintype α] [Fintype β] + {μ : α × β → ℝ} (hμ : IsProbabilityVector μ) : + IsProbabilityVector (secondMarginal μ) := by + constructor + · intro y + exact Finset.sum_nonneg fun x _ ↦ hμ.nonnegative (x, y) + · change (∑ y, ∑ x, μ (x, y)) = 1 + rw [Finset.sum_comm, ← Finset.sum_product] + exact hμ.sum_eq_one + +theorem firstMarginal_eq_pushforward_fst + {α β : Type*} [Fintype α] [Fintype β] [DecidableEq α] + (μ : α × β → ℝ) : + firstMarginal μ = pushforwardMass μ Prod.fst := by + funext x + unfold firstMarginal pushforwardMass + rw [Fintype.sum_prod_type] + rw [Finset.sum_eq_single x] + · simp + · intro z _ hzx + simp [hzx] + · simp + +theorem secondMarginal_eq_pushforward_snd + {α β : Type*} [Fintype α] [Fintype β] [DecidableEq β] + (μ : α × β → ℝ) : + secondMarginal μ = pushforwardMass μ Prod.snd := by + funext y + unfold secondMarginal pushforwardMass + rw [Fintype.sum_prod_type, Finset.sum_comm] + rw [Finset.sum_eq_single y] + · simp + · intro z _ hzy + simp [hzy] + · simp + +theorem joint_eq_firstMarginal_mul_conditionalSecond + {α β : Type*} [Fintype β] + {μ : α × β → ℝ} (hμ : ∀ z, 0 ≤ μ z) (x : α) (y : β) : + μ (x, y) = firstMarginal μ x * conditionalSecond μ x y := by + by_cases hx : firstMarginal μ x = 0 + · have hxy : μ (x, y) = 0 := by + have hle : μ (x, y) ≤ firstMarginal μ x := by + rw [firstMarginal] + exact Finset.single_le_sum (fun z _ ↦ hμ (x, z)) (Finset.mem_univ y) + exact le_antisymm (hle.trans_eq hx) (hμ (x, y)) + simp [conditionalSecond, hx, hxy] + · rw [conditionalSecond] + field_simp + +theorem sum_conditionalSecond + {α β : Type*} [Fintype β] + {μ : α × β → ℝ} {x : α} (hx : firstMarginal μ x ≠ 0) : + ∑ y, conditionalSecond μ x y = 1 := by + change (∑ y, μ (x, y) / firstMarginal μ x) = 1 + rw [← Finset.sum_div] + change firstMarginal μ x / firstMarginal μ x = 1 + exact div_self hx + +theorem weighted_conditionalSecond_sum + {α β : Type*} [Fintype α] [Fintype β] + {μ : α × β → ℝ} (hμ : ∀ z, 0 ≤ μ z) (y : β) : + ∑ x, firstMarginal μ x * conditionalSecond μ x y = + secondMarginal μ y := by + simp_rw [← joint_eq_firstMarginal_mul_conditionalSecond hμ] + rfl + +theorem conditionalSecond_nonnegative + {α β : Type*} [Fintype β] + {μ : α × β → ℝ} (hμ : ∀ z, 0 ≤ μ z) (x : α) (y : β) : + 0 ≤ conditionalSecond μ x y := by + exact div_nonneg (hμ (x, y)) + (Finset.sum_nonneg fun z _ ↦ hμ (x, z)) + +/-- Chain-rule decomposition of the entropy of a finite pair. The +conditional term is written with the zero-fiber convention used by +`conditionalSecond`. -/ +theorem jointEntropy_eq_first_add_conditional + {α β : Type*} [Fintype α] [Fintype β] + {μ : α × β → ℝ} (hμ : IsProbabilityVector μ) : + shannonEntropy μ = + shannonEntropy (firstMarginal μ) + + ∑ x, firstMarginal μ x * shannonEntropy (conditionalSecond μ x) := by + rw [shannonEntropy, Fintype.sum_prod_type] + calc + (∑ x, ∑ y, Real.negMulLog (μ (x, y))) = + ∑ x, (Real.negMulLog (firstMarginal μ x) + + firstMarginal μ x * shannonEntropy (conditionalSecond μ x)) := by + apply Finset.sum_congr rfl + intro x _ + have hfactor : ∀ y, μ (x, y) = + firstMarginal μ x * conditionalSecond μ x y := + joint_eq_firstMarginal_mul_conditionalSecond hμ.nonnegative x + calc + (∑ y, Real.negMulLog (μ (x, y))) = + ∑ y, Real.negMulLog + (firstMarginal μ x * conditionalSecond μ x y) := by + apply Finset.sum_congr rfl + intro y _ + rw [hfactor y] + _ = ∑ y, (conditionalSecond μ x y * + Real.negMulLog (firstMarginal μ x) + + firstMarginal μ x * Real.negMulLog (conditionalSecond μ x y)) := by + apply Finset.sum_congr rfl + intro y _ + exact Real.negMulLog_mul _ _ + _ = (∑ y, conditionalSecond μ x y) * + Real.negMulLog (firstMarginal μ x) + + firstMarginal μ x * + ∑ y, Real.negMulLog (conditionalSecond μ x y) := by + rw [Finset.sum_add_distrib, ← Finset.sum_mul, ← Finset.mul_sum] + _ = Real.negMulLog (firstMarginal μ x) + + firstMarginal μ x * shannonEntropy (conditionalSecond μ x) := by + by_cases hx : firstMarginal μ x = 0 + · simp [hx, shannonEntropy] + · rw [sum_conditionalSecond hx, one_mul, shannonEntropy] + _ = shannonEntropy (firstMarginal μ) + + ∑ x, firstMarginal μ x * shannonEntropy (conditionalSecond μ x) := by + rw [Finset.sum_add_distrib, shannonEntropy] + +/-- Concavity of `-x log x` bounds the averaged conditional entropy by the +entropy of the second marginal. -/ +theorem conditionalEntropy_le_secondMarginalEntropy + {α β : Type*} [Fintype α] [Fintype β] + {μ : α × β → ℝ} (hμ : IsProbabilityVector μ) : + (∑ x, firstMarginal μ x * shannonEntropy (conditionalSecond μ x)) ≤ + shannonEntropy (secondMarginal μ) := by + simp_rw [shannonEntropy, Finset.mul_sum] + rw [Finset.sum_comm] + apply Finset.sum_le_sum + intro y _ + have hfirst := firstMarginal_isProbabilityVector hμ + have hJ := Real.concaveOn_negMulLog.le_map_sum + (t := Finset.univ) (w := firstMarginal μ) + (p := fun x ↦ conditionalSecond μ x y) + (fun x _ ↦ hfirst.nonnegative x) hfirst.sum_eq_one + (fun x _ ↦ conditionalSecond_nonnegative hμ.nonnegative x y) + simpa only [smul_eq_mul, weighted_conditionalSecond_sum hμ.nonnegative y] using hJ + +/-- Subadditivity of Shannon entropy for a finite pair. -/ +theorem jointEntropy_le_sum_marginals + {α β : Type*} [Fintype α] [Fintype β] + {μ : α × β → ℝ} (hμ : IsProbabilityVector μ) : + shannonEntropy μ ≤ + shannonEntropy (firstMarginal μ) + + shannonEntropy (secondMarginal μ) := by + rw [jointEntropy_eq_first_add_conditional hμ] + linarith [conditionalEntropy_le_secondMarginalEntropy hμ] + +/-- Subadditivity for a finite vector, in exactly the form used to pass from +the entropy of the paper's joint core encoding to the sum of its rowwise +entropies. -/ +theorem functionEntropy_le_sum_coordinateEntropies + {β : Type*} [Fintype β] [DecidableEq β] : + ∀ {n : ℕ} {μ : (Fin n → β) → ℝ}, IsProbabilityVector μ → + shannonEntropy μ ≤ + ∑ i, shannonEntropy (pushforwardMass μ fun y ↦ y i) := by + intro n + induction n with + | zero => + intro μ hμ + have hupper := shannonEntropy_le_log_card hμ + simpa using hupper + | succ n ih => + intro μ hμ + let e : (Fin (n + 1) → β) ≃ β × (Fin n → β) := + (Fin.consEquiv (fun _ : Fin (n + 1) ↦ β)).symm + let μ' : (β × (Fin n → β)) → ℝ := pushforwardMass μ e + have hμ' : IsProbabilityVector μ' := + pushforwardMass_isProbabilityVector μ hμ e + have hpair := jointEntropy_le_sum_marginals hμ' + have htailProb : IsProbabilityVector (secondMarginal μ') := + secondMarginal_isProbabilityVector hμ' + have htail := ih htailProb + have hhead : firstMarginal μ' = + pushforwardMass μ (fun y ↦ y 0) := by + rw [firstMarginal_eq_pushforward_fst] + funext y + rw [pushforwardMass_comp] + congr 1 + have htailDist : secondMarginal μ' = + pushforwardMass μ (fun y ↦ Fin.tail y) := by + rw [secondMarginal_eq_pushforward_snd] + funext y + rw [pushforwardMass_comp] + congr 1 + have hcoord (i : Fin n) : + pushforwardMass (secondMarginal μ') (fun y ↦ y i) = + pushforwardMass μ (fun y ↦ y i.succ) := by + rw [htailDist] + funext y + rw [pushforwardMass_comp] + congr 1 + calc + shannonEntropy μ = shannonEntropy μ' := by + exact (shannonEntropy_pushforward_equiv μ e).symm + _ ≤ shannonEntropy (firstMarginal μ') + + shannonEntropy (secondMarginal μ') := hpair + _ ≤ shannonEntropy (pushforwardMass μ fun y ↦ y 0) + + ∑ i, shannonEntropy + (pushforwardMass (secondMarginal μ') fun y ↦ y i) := by + rw [hhead] + linarith + _ = ∑ i, shannonEntropy (pushforwardMass μ fun y ↦ y i) := by + simp_rw [hcoord] + rw [Fin.sum_univ_succ] + +theorem entropy_on_finset_of_mass_le + {α : Type*} [Fintype α] [DecidableEq α] + (s : Finset α) (hs : s.Nonempty) {μ : α → ℝ} {ρ : ℝ} + (hμ : ∀ x, 0 ≤ μ x) (hρ : 0 < ρ) + (hsum : ∑ x ∈ s, μ x = ρ) : + (∑ x ∈ s, Real.negMulLog (μ x)) ≤ + ρ * Real.log ((s.card : ℝ) / ρ) := by + let q : s → ℝ := fun x ↦ μ x + letI : Nonempty s := ⟨⟨hs.choose, hs.choose_spec⟩⟩ + have hqsum : ∑ x, q x = ρ := by + calc + ∑ x, q x = ∑ x ∈ s.attach, μ x := by rfl + _ = ∑ x ∈ s, μ x := Finset.sum_attach s μ + _ = ρ := hsum + have hbound := shannonEntropy_of_mass_le + (α := q) (ρ := ρ) (fun x ↦ hμ x) hρ hqsum + have hcard : Fintype.card s = s.card := Fintype.card_coe s + rw [shannonEntropy, hcard] at hbound + change (∑ x ∈ s.attach, Real.negMulLog (μ x)) ≤ _ at hbound + rw [← Finset.sum_attach s (fun x ↦ Real.negMulLog (μ x))] + exact hbound + +/-- Entropy within one fiber of a deterministic map is bounded by the fiber +mass times the logarithm of the maximum fiber size. -/ +theorem fiber_entropy_bound + {α β : Type*} [Fintype α] [Fintype β] + [DecidableEq α] [DecidableEq β] + {μ : α → ℝ} (hμ : IsProbabilityVector μ) (f : α → β) + (K : ℕ) (hK : 1 ≤ K) + (hfiber : ∀ y, (Finset.univ.filter fun x ↦ f x = y).card ≤ K) + (y : β) : + (∑ x ∈ Finset.univ.filter (fun x ↦ f x = y), + Real.negMulLog (μ x)) ≤ + Real.negMulLog (pushforwardMass μ f y) + + pushforwardMass μ f y * Real.log K := by + let s := Finset.univ.filter fun x ↦ f x = y + change (∑ x ∈ s, Real.negMulLog (μ x)) ≤ _ + have hqnonneg := (pushforwardMass_isProbabilityVector μ hμ f).nonnegative y + by_cases hqzero : pushforwardMass μ f y = 0 + · have hsumzero : ∑ x ∈ s, μ x = 0 := by + rw [Finset.sum_filter] + simpa [s, pushforwardMass] using hqzero + have htermzero : ∀ x ∈ s, μ x = 0 := by + exact Finset.sum_eq_zero_iff_of_nonneg + (fun x _ ↦ hμ.nonnegative x) |>.mp hsumzero + simp only [hqzero, Real.negMulLog_zero, zero_mul, add_zero] + exact (Finset.sum_eq_zero (fun x hx ↦ by + rw [htermzero x hx, Real.negMulLog_zero])).le + · have hqpos : 0 < pushforwardMass μ f y := + lt_of_le_of_ne hqnonneg (Ne.symm hqzero) + have hs : s.Nonempty := by + by_contra hempty + have hzero : ∑ x ∈ s, μ x = 0 := by + rw [Finset.not_nonempty_iff_eq_empty.mp hempty] + simp + have : pushforwardMass μ f y = 0 := by + rw [← hzero] + unfold pushforwardMass + rw [← Finset.sum_filter] + exact hqzero this + have hsum : ∑ x ∈ s, μ x = pushforwardMass μ f y := by + rw [Finset.sum_filter] + simp [s, pushforwardMass] + have hscaled := entropy_on_finset_of_mass_le s hs + hμ.nonnegative hqpos hsum + have hcardpos : (0 : ℝ) < s.card := by + exact_mod_cast hs.card_pos + have hKpos : (0 : ℝ) < K := by + exact_mod_cast (lt_of_lt_of_le Nat.zero_lt_one hK) + have hcardle : (s.card : ℝ) ≤ K := by exact_mod_cast hfiber y + have hlogle : Real.log (s.card : ℝ) ≤ Real.log K := + Real.log_le_log hcardpos hcardle + have hmul := mul_le_mul_of_nonneg_left hlogle hqpos.le + rw [Real.log_div hcardpos.ne' hqpos.ne'] at hscaled + simp only [Real.negMulLog_def] + have hrewrite : + pushforwardMass μ f y * + (Real.log (s.card : ℝ) - Real.log (pushforwardMass μ f y)) = + -pushforwardMass μ f y * Real.log (pushforwardMass μ f y) + + pushforwardMass μ f y * Real.log (s.card : ℝ) := by ring + rw [hrewrite] at hscaled + exact hscaled.trans (by + simpa [add_comm] using + add_le_add_left hmul + (-pushforwardMass μ f y * Real.log (pushforwardMass μ f y))) + +/-- Generic finite-fiber encoding inequality. This is the entropy-theoretic +part of paper Lemma 9, independent of the cycle combinatorics used to bound +the fibers. -/ +theorem entropy_le_pushforward_add_log_fiberBound + {α β : Type*} [Fintype α] [Fintype β] + [DecidableEq α] [DecidableEq β] + {μ : α → ℝ} (hμ : IsProbabilityVector μ) (f : α → β) + (K : ℕ) (hK : 1 ≤ K) + (hfiber : ∀ y, (Finset.univ.filter fun x ↦ f x = y).card ≤ K) : + shannonEntropy μ ≤ + shannonEntropy (pushforwardMass μ f) + Real.log K := by + have hpoint := fun y ↦ fiber_entropy_bound hμ f K hK hfiber y + have hsum : + (∑ y, ∑ x ∈ Finset.univ.filter (fun x ↦ f x = y), + Real.negMulLog (μ x)) ≤ + ∑ y, (Real.negMulLog (pushforwardMass μ f y) + + pushforwardMass μ f y * Real.log K) := by + exact Finset.sum_le_sum (fun y _ ↦ hpoint y) + have hpartition : shannonEntropy μ = + ∑ y, ∑ x ∈ Finset.univ.filter (fun x ↦ f x = y), + Real.negMulLog (μ x) := by + rw [shannonEntropy] + calc + (∑ x, Real.negMulLog (μ x)) = + ∑ x, ∑ y, if f x = y then Real.negMulLog (μ x) else 0 := by + apply Finset.sum_congr rfl + intro x _ + simp + _ = ∑ y, ∑ x, if f x = y then Real.negMulLog (μ x) else 0 := + Finset.sum_comm + _ = ∑ y, ∑ x ∈ Finset.univ.filter (fun x ↦ f x = y), + Real.negMulLog (μ x) := by + apply Finset.sum_congr rfl + intro y _ + rw [Finset.sum_filter] + have hright : + (∑ y, (Real.negMulLog (pushforwardMass μ f y) + + pushforwardMass μ f y * Real.log K)) = + shannonEntropy (pushforwardMass μ f) + Real.log K := by + rw [Finset.sum_add_distrib, shannonEntropy, ← Finset.sum_mul, + (pushforwardMass_isProbabilityVector μ hμ f).sum_eq_one, one_mul] + rw [hpartition, ← hright] + exact hsum + +/-- Kullback--Leibler divergence on a finite type. -/ +noncomputable def finiteKL + {ι : Type*} [Fintype ι] (p q : ι → ℝ) : ℝ := + ∑ i, p i * Real.log (p i / q i) + +theorem finiteKL_nonneg + {ι : Type*} [Fintype ι] + {p q : ι → ℝ} + (hp : IsProbabilityVector p) (hq : IsProbabilityVector q) + (hppos : ∀ i, 0 < p i) (hqpos : ∀ i, 0 < q i) : + 0 ≤ finiteKL p q := by + have hterm : ∀ i, + p i * Real.log (q i / p i) ≤ q i - p i := by + intro i + have hratio : 0 < q i / p i := div_pos (hqpos i) (hppos i) + have hlog := Real.log_le_sub_one_of_pos hratio + have hmul := mul_le_mul_of_nonneg_left hlog (hp.nonnegative i) + have hsimplify : p i * (q i / p i - 1) = q i - p i := by + field_simp [(hppos i).ne'] + rw [hsimplify] at hmul + exact hmul + have hsum : (∑ i, p i * Real.log (q i / p i)) ≤ + ∑ i, (q i - p i) := + Finset.sum_le_sum fun i _ ↦ hterm i + rw [Finset.sum_sub_distrib, hq.sum_eq_one, hp.sum_eq_one, sub_self] at hsum + have hrewrite : finiteKL p q = -∑ i, p i * Real.log (q i / p i) := by + rw [finiteKL, ← Finset.sum_neg_distrib] + apply Finset.sum_congr rfl + intro i _ + rw [Real.log_div (hppos i).ne' (hqpos i).ne', + Real.log_div (hqpos i).ne' (hppos i).ne'] + ring + rw [hrewrite] + linarith + +theorem finiteKL_eq_neg_entropy_sub + {ι : Type*} [Fintype ι] + {p q : ι → ℝ} (hppos : ∀ i, 0 < p i) (hqpos : ∀ i, 0 < q i) : + finiteKL p q = + -shannonEntropy p - ∑ i, p i * Real.log (q i) := by + rw [finiteKL, shannonEntropy, ← Finset.sum_neg_distrib, + ← Finset.sum_sub_distrib] + apply Finset.sum_congr rfl + intro i _ + rw [Real.negMulLog_def, + Real.log_div (hppos i).ne' (hqpos i).ne'] + ring + +/-- Uniform average of a real-valued function on a finite type. -/ +noncomputable def uniformAverage + {ι : Type*} [Fintype ι] (f : ι → ℝ) : ℝ := + (∑ i, f i) / Fintype.card ι + +/-- Suffix mass seen by coordinate `j` in the ordering `π`. An ordering is a +permutation whose value at a position is the coordinate occupying it. -/ +noncomputable def suffixMass {m : ℕ} + (p : Fin m → ℝ) (π : Equiv.Perm (Fin m)) (j : Fin m) : ℝ := + ∑ k, if π.symm j ≤ π.symm k then p k else 0 + +theorem le_suffixMass {m : ℕ} {p : Fin m → ℝ} + (hp : IsProbabilityVector p) (π : Equiv.Perm (Fin m)) (j : Fin m) : + p j ≤ suffixMass p π j := by + rw [suffixMass] + have hterm : + p j = if π.symm j ≤ π.symm j then p j else 0 := by simp + rw [hterm] + exact Finset.single_le_sum + (f := fun k ↦ if π.symm j ≤ π.symm k then p k else 0) + (fun k _ ↦ by + by_cases h : π.symm j ≤ π.symm k + · simpa [h] using hp.nonnegative k + · simp [h]) + (Finset.mem_univ j) + +theorem suffixMass_le_one {m : ℕ} {p : Fin m → ℝ} + (hp : IsProbabilityVector p) (π : Equiv.Perm (Fin m)) (j : Fin m) : + suffixMass p π j ≤ 1 := by + rw [suffixMass, ← hp.sum_eq_one] + apply Finset.sum_le_sum + intro k _ + split_ifs + · rfl + · exact hp.nonnegative k + +theorem suffixMass_pos {m : ℕ} {p : Fin m → ℝ} + (hp : IsProbabilityVector p) {j : Fin m} (hj : 0 < p j) + (π : Equiv.Perm (Fin m)) : + 0 < suffixMass p π j := + hj.trans_le (le_suffixMass hp π j) + +/-- The averaged suffix score `T(p)` from paper (13). -/ +noncomputable def rowT {m : ℕ} (p : Fin m → ℝ) : ℝ := + uniformAverage fun π : Equiv.Perm (Fin m) ↦ + ∑ j, p j * Real.log (suffixMass p π j) + +/-- The one-row correction `g(p)` from paper (14). -/ +noncomputable def rowCorrection {m : ℕ} (p : Fin m → ℝ) : ℝ := + rowT p - ∑ j, (1 - p j) * Real.log (1 - p j) + +/-- Deficit from the sharp one-row inequality, paper (15). -/ +noncomputable def rowDeficit {m : ℕ} (p : Fin m → ℝ) : ℝ := + Real.log 2 / 2 - rowCorrection p + +/-- Exact source-level interface for the sharp one-row theorem of +Anari--Rezaei. It is a proposition passed as an argument, not a Lean axiom. -/ +def AnariRezaeiRowInequality : Prop := + ∀ {m : ℕ}, 2 ≤ m → ∀ p : Fin m → ℝ, + IsProbabilityVector p → 0 ≤ rowDeficit p + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/ExcursionTransfer.lean b/LeanPool/BeyondBethe/BeyondBethe/ExcursionTransfer.lean new file mode 100644 index 0000000000..79921ff9f9 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/ExcursionTransfer.lean @@ -0,0 +1,375 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.TransferIdentity +import Mathlib.Analysis.SpecialFunctions.BinaryEntropy +import Mathlib.Tactic + +/-! # Excursion Transfer -/ + +open scoped BigOperators + +namespace BeyondBethe + +/-- Mass of a vector on a designated set of outside coordinates. -/ +noncomputable def massOn + {ι : Type*} (s : Finset ι) (p : ι → ℝ) : ℝ := + ∑ i ∈ s, p i + +/-- The conditional-entropy term `rho H(p/rho)` written without division, +with its continuous value at `rho = 0`. -/ +noncomputable def scaledConditionalEntropyOn + {ι : Type*} (s : Finset ι) (p : ι → ℝ) : ℝ := + (∑ i ∈ s, Real.negMulLog (p i)) + + massOn s p * Real.log (massOn s p) + +/-- Transfer cost accumulated on a designated coordinate set. -/ +noncomputable def transferCostOn + {ι : Type*} (s : Finset ι) (p u : ι → ℝ) : ℝ := + ∑ i ∈ s, p i * Real.log (1 / u i) + +theorem massOn_pos_of_nonempty + {ι : Type*} {s : Finset ι} {p : ι → ℝ} + (hs : s.Nonempty) (hp : ∀ i, 0 < p i) : + 0 < massOn s p := by + rw [massOn] + exact Finset.sum_pos (fun i _ ↦ hp i) hs + +/-- Exact entropy/KL decomposition behind paper (40). -/ +theorem transferCostOn_eq_entropy_add_KL + {ι : Type*} [DecidableEq ι] + {s : Finset ι} (hs : s.Nonempty) + {p u : ι → ℝ} (hp : ∀ i, 0 < p i) (hu : ∀ i, 0 < u i) : + let ρ := massOn s p + let W := massOn s u + let pO : s → ℝ := fun i ↦ p i / ρ + let uO : s → ℝ := fun i ↦ u i / W + transferCostOn s p u = + scaledConditionalEntropyOn s p + ρ * finiteKL pO uO - ρ * Real.log W := by + dsimp only + have hρ : 0 < massOn s p := massOn_pos_of_nonempty hs hp + have hW : 0 < massOn s u := massOn_pos_of_nonempty hs hu + rw [transferCostOn, scaledConditionalEntropyOn, finiteKL, + Finset.mul_sum] + have hsub : + (∑ i : s, massOn s p * + ((p i / massOn s p) * + Real.log ((p i / massOn s p) / (u i / massOn s u)))) = + ∑ i ∈ s, massOn s p * + ((p i / massOn s p) * + Real.log ((p i / massOn s p) / (u i / massOn s u))) := + by + simpa using Finset.sum_coe_sort s (fun i ↦ massOn s p * + ((p i / massOn s p) * + Real.log ((p i / massOn s p) / (u i / massOn s u)))) + rw [hsub] + have hρlog : massOn s p * Real.log (massOn s p) = + ∑ i ∈ s, p i * Real.log (massOn s p) := by + rw [massOn, Finset.sum_mul] + have hWlog : massOn s p * Real.log (massOn s u) = + ∑ i ∈ s, p i * Real.log (massOn s u) := by + rw [massOn, Finset.sum_mul] + rw [hρlog, hWlog, ← Finset.sum_add_distrib, + ← Finset.sum_add_distrib, ← Finset.sum_sub_distrib] + apply Finset.sum_congr rfl + intro i hi + have hpρ : p i / massOn s p ≠ 0 := (div_pos (hp i) hρ).ne' + have huW : u i / massOn s u ≠ 0 := (div_pos (hu i) hW).ne' + rw [Real.negMulLog_def, + Real.log_div one_ne_zero (hu i).ne', Real.log_one, + Real.log_div hpρ huW, + Real.log_div (hp i).ne' hρ.ne', + Real.log_div (hu i).ne' hW.ne'] + field_simp [hρ.ne', hW.ne', (hp i).ne', (hu i).ne'] + ring + +theorem normalizedOutside_isProbabilityVector + {ι : Type*} [DecidableEq ι] + {s : Finset ι} (hs : s.Nonempty) + {p : ι → ℝ} (hp : ∀ i, 0 < p i) : + IsProbabilityVector (fun i : s ↦ p i / massOn s p) := by + have hρ : 0 < massOn s p := massOn_pos_of_nonempty hs hp + constructor + · intro i + exact div_nonneg (hp i).le hρ.le + · calc + (∑ i : s, p i / massOn s p) = + ∑ i ∈ s, p i / massOn s p := by + simpa using Finset.sum_coe_sort s + (fun i ↦ p i / massOn s p) + _ = 1 := by + rw [← Finset.sum_div] + exact div_self (by simpa only [massOn] using hρ.ne') + +/-- Paper tail-transfer inequality (41), before substituting the entropy of +the coarsened row. The theorem includes the empty-set/zero-mass case. -/ +theorem scaledConditionalEntropyOn_sub_mass_le_transferCostOn + {ι : Type*} [DecidableEq ι] + (s : Finset ι) {p u : ι → ℝ} + (hp : ∀ i, 0 < p i) (hu : ∀ i, 0 < u i) + (hUsum : massOn s u ≤ Real.exp 1) : + scaledConditionalEntropyOn s p - massOn s p ≤ + transferCostOn s p u := by + by_cases hs : s.Nonempty + · have hρ : 0 < massOn s p := massOn_pos_of_nonempty hs hp + have hW : 0 < massOn s u := massOn_pos_of_nonempty hs hu + let pO : s → ℝ := fun i ↦ p i / massOn s p + let uO : s → ℝ := fun i ↦ u i / massOn s u + have hpO : IsProbabilityVector pO := + normalizedOutside_isProbabilityVector hs hp + have huO : IsProbabilityVector uO := + normalizedOutside_isProbabilityVector hs hu + have hpOpos : ∀ i, 0 < pO i := fun i ↦ div_pos (hp i) hρ + have huOpos : ∀ i, 0 < uO i := fun i ↦ div_pos (hu i) hW + have hKL : 0 ≤ finiteKL pO uO := + finiteKL_nonneg hpO huO hpOpos huOpos + have hlogW : Real.log (massOn s u) ≤ 1 := by + have hlog := Real.log_le_log hW hUsum + simpa using hlog + rw [transferCostOn_eq_entropy_add_KL hs hp hu] + dsimp only [pO, uO] at hKL + nlinarith [mul_nonneg hρ.le hKL, + mul_le_mul_of_nonneg_left hlogW hρ.le] + · rw [Finset.not_nonempty_iff_eq_empty.mp hs] + simp [scaledConditionalEntropyOn, massOn, transferCostOn] + +/-- Entropy of the coarsening which merges the complement of a core set into +one atom, expressed as binary entropy plus conditional outside entropy. -/ +noncomputable def coarsenedRowEntropy + {ι : Type*} (outside : Finset ι) (p : ι → ℝ) : ℝ := + binaryEntropy (massOn outside p) + scaledConditionalEntropyOn outside p + +theorem coarsenedRowEntropy_sub_binary_sub_mass_le_transferCostOn + {ι : Type*} [DecidableEq ι] + (outside : Finset ι) {p u : ι → ℝ} + (hp : ∀ i, 0 < p i) (hu : ∀ i, 0 < u i) + (hUsum : massOn outside u ≤ Real.exp 1) : + coarsenedRowEntropy outside p - binaryEntropy (massOn outside p) - + massOn outside p ≤ transferCostOn outside p u := by + rw [coarsenedRowEntropy] + convert scaledConditionalEntropyOn_sub_mass_le_transferCostOn outside hp hu hUsum using 1 <;> + ring + +theorem binaryEntropy_eq_binEntropy (ρ : ℝ) : + binaryEntropy ρ = Real.binEntropy ρ := by + rw [binaryEntropy, Real.binEntropy_eq_negMulLog_add_negMulLog_one_sub] + +noncomputable def matrixTransferCost + {ι : Type*} [Fintype ι] + (P U : Matrix ι ι ℝ) : ℝ := + ∑ i, transferCostOn Finset.univ (P i) (U i) + +noncomputable def outsideTransferCost + {ι : Type*} [Fintype ι] + (outside : ι → Finset ι) (P U : Matrix ι ι ℝ) : ℝ := + ∑ i, transferCostOn (outside i) (P i) (U i) + +noncomputable def coreTransferCost + {ι : Type*} [Fintype ι] [DecidableEq ι] + (outside : ι → Finset ι) (P U : Matrix ι ι ℝ) : ℝ := + ∑ i, transferCostOn (Finset.univ \ outside i) (P i) (U i) + +/-- Equation (39) from the global transfer upper bound and the cycle-encoding +entropy estimate. This is the exact bridge between paper Lemmas 13, 16, and +17. -/ +theorem transfer_before_tail_of_global_and_encoding + {n : ℕ} {P U : Matrix (Fin n) (Fin n) ℝ} + (outside : Fin n → Finset (Fin n)) + {slack ξ gibbsEntropy : ℝ} + (hglobal : matrixTransferCost P U ≤ + slack + 2 * ξ * n + gibbsEntropy - n * (Real.log 2 / 2)) + (hencoding : gibbsEntropy ≤ + n * (Real.log 2 / 2) + + ∑ i, coarsenedRowEntropy (outside i) (P i)) : + matrixTransferCost P U ≤ + slack + 2 * ξ * n + + ∑ i, coarsenedRowEntropy (outside i) (P i) := by + linarith + +theorem matrixTransferCost_eq_core_add_outside + {ι : Type*} [Fintype ι] [DecidableEq ι] + (outside : ι → Finset ι) (P U : Matrix ι ι ℝ) : + matrixTransferCost P U = + coreTransferCost outside P U + outsideTransferCost outside P U := by + rw [matrixTransferCost, coreTransferCost, outsideTransferCost, + ← Finset.sum_add_distrib] + apply Finset.sum_congr rfl + intro i _ + rw [transferCostOn, transferCostOn, transferCostOn] + exact (Finset.sum_sdiff (Finset.subset_univ (outside i))).symm + +theorem massOn_le_sum_univ + {ι : Type*} [Fintype ι] + (s : Finset ι) {u : ι → ℝ} (hu : ∀ i, 0 ≤ u i) : + massOn s u ≤ ∑ i, u i := by + rw [massOn] + exact Finset.sum_le_sum_of_subset_of_nonneg (Finset.subset_univ _) + (fun i _ _ ↦ hu i) + +/-- Paper Lemma 17, first inequality, in its graph-independent form. The +encoding supplies `coarsenedRowEntropy`; this theorem performs the complete +excursion-entropy cancellation. -/ +theorem coreTransferCost_le_of_entropy_bound + {ι : Type*} [Fintype ι] [DecidableEq ι] + (outside : ι → Finset ι) {P U : Matrix ι ι ℝ} {B : ℝ} + (hPpos : ∀ i j, 0 < P i j) (hUpos : ∀ i j, 0 < U i j) + (hUrow : ∀ i, ∑ j, U i j ≤ Real.exp 1) + (hbefore : matrixTransferCost P U ≤ + B + ∑ i, coarsenedRowEntropy (outside i) (P i)) : + coreTransferCost outside P U ≤ + B + ∑ i, (binaryEntropy (massOn (outside i) (P i)) + + massOn (outside i) (P i)) := by + have htailRow : ∀ i, + coarsenedRowEntropy (outside i) (P i) - + (binaryEntropy (massOn (outside i) (P i)) + + massOn (outside i) (P i)) ≤ + transferCostOn (outside i) (P i) (U i) := by + intro i + have hUsum : massOn (outside i) (U i) ≤ Real.exp 1 := + (massOn_le_sum_univ (outside i) (fun j ↦ (hUpos i j).le)).trans + (hUrow i) + have htail := coarsenedRowEntropy_sub_binary_sub_mass_le_transferCostOn + (outside i) (hPpos i) (hUpos i) hUsum + linarith + have htailSum : + (∑ i, (coarsenedRowEntropy (outside i) (P i) - + (binaryEntropy (massOn (outside i) (P i)) + + massOn (outside i) (P i)))) ≤ + outsideTransferCost outside P U := by + rw [outsideTransferCost] + exact Finset.sum_le_sum (fun i _ ↦ htailRow i) + have hpartition := matrixTransferCost_eq_core_add_outside outside P U + simp only [Finset.sum_sub_distrib] at htailSum + linarith + +/-- The graph-independent cancellation specialized to the transfer matrix +`U` from paper (37). Thus the only remaining input from the cycle encoding +is the entropy bound `hbefore`. -/ +theorem coreTransferCost_le_for_transferU + {ι : Type*} [Fintype ι] [DecidableEq ι] + (outside : ι → Finset ι) {P X : Matrix ι ι ℝ} {τ B : ℝ} + (hτ : 0 ≤ τ) (hPpos : ∀ i j, 0 < P i j) + (hXint : ∀ i, IsInteriorProbabilityVector (X i)) + (hbefore : matrixTransferCost P (fun i j ↦ transferU τ (X i) j) ≤ + B + ∑ i, coarsenedRowEntropy (outside i) (P i)) : + coreTransferCost outside P (fun i j ↦ transferU τ (X i) j) ≤ + B + ∑ i, (binaryEntropy (massOn (outside i) (P i)) + + massOn (outside i) (P i)) := by + apply coreTransferCost_le_of_entropy_bound outside hPpos + (fun i j ↦ transferU_pos (hXint i) j) + (fun i ↦ sum_transferU_le_exp_one hτ (hXint i)) hbefore + +theorem binaryEntropy_nonneg_of_mem_Icc + {ρ : ℝ} (hρ : ρ ∈ Set.Icc (0 : ℝ) 1) : + 0 ≤ binaryEntropy ρ := by + rw [binaryEntropy_eq_binEntropy] + exact Real.binEntropy_nonneg hρ.1 hρ.2 + +theorem binaryEntropy_mono_to_half + {ρ η : ℝ} (hρ : ρ ∈ Set.Icc (0 : ℝ) (2 : ℝ)⁻¹) + (hη : η ∈ Set.Icc (0 : ℝ) (2 : ℝ)⁻¹) (hρη : ρ ≤ η) : + binaryEntropy ρ ≤ binaryEntropy η := by + rw [binaryEntropy_eq_binEntropy, binaryEntropy_eq_binEntropy] + exact Real.binEntropy_strictMonoOn.monotoneOn hρ hη hρη + +/-- The good-row/bad-row aggregation in the second conclusion of paper +Lemma 17. We deliberately retain the paper's slightly loose bad-row term: +every row receives the good-row allowance, and each bad row receives an +additional `1 + log 2`. -/ +theorem sum_binaryEntropy_add_mass_le_good_bad + {ι : Type*} [Fintype ι] [DecidableEq ι] + (good : Finset ι) (ρ : ι → ℝ) {η : ℝ} + (hη : η ∈ Set.Icc (0 : ℝ) (2 : ℝ)⁻¹) + (hρ : ∀ i, ρ i ∈ Set.Icc (0 : ℝ) 1) + (hgood : ∀ i ∈ good, ρ i ≤ η) : + ∑ i, (binaryEntropy (ρ i) + ρ i) ≤ + (Fintype.card ι : ℝ) * (binaryEntropy η + η) + + (1 + Real.log 2) * (Finset.card (Finset.univ \ good) : ℝ) := by + have hηone : η ∈ Set.Icc (0 : ℝ) 1 := by + constructor + · exact hη.1 + · exact hη.2.trans (by norm_num) + have hbase : 0 ≤ binaryEntropy η + η := + add_nonneg (binaryEntropy_nonneg_of_mem_Icc hηone) hη.1 + have hgoodSum : + (∑ i ∈ good, (binaryEntropy (ρ i) + ρ i)) ≤ + (Finset.card good : ℝ) * (binaryEntropy η + η) := by + calc + (∑ i ∈ good, (binaryEntropy (ρ i) + ρ i)) ≤ + ∑ _i ∈ good, (binaryEntropy η + η) := by + apply Finset.sum_le_sum + intro i hi + have hρhalf : ρ i ∈ Set.Icc (0 : ℝ) (2 : ℝ)⁻¹ := + ⟨(hρ i).1, (hgood i hi).trans hη.2⟩ + exact add_le_add + (binaryEntropy_mono_to_half hρhalf hη (hgood i hi)) + (hgood i hi) + _ = (Finset.card good : ℝ) * (binaryEntropy η + η) := by + simp + ring + have hbadSum : + (∑ i ∈ (Finset.univ \ good), + (binaryEntropy (ρ i) + ρ i)) ≤ + (Finset.card (Finset.univ \ good) : ℝ) * + (Real.log 2 + 1) := by + calc + (∑ i ∈ (Finset.univ \ good), + (binaryEntropy (ρ i) + ρ i)) ≤ + ∑ _i ∈ (Finset.univ \ good), (Real.log 2 + 1) := by + apply Finset.sum_le_sum + intro i _ + rw [binaryEntropy_eq_binEntropy] + exact add_le_add Real.binEntropy_le_log_two (hρ i).2 + _ = (Finset.card (Finset.univ \ good) : ℝ) * + (Real.log 2 + 1) := by + simp + ring + have hgoodCard : (Finset.card good : ℝ) ≤ Fintype.card ι := by + exact_mod_cast Finset.card_le_card (Finset.subset_univ good) + have hgoodBound : + (Finset.card good : ℝ) * (binaryEntropy η + η) ≤ + (Fintype.card ι : ℝ) * (binaryEntropy η + η) := + mul_le_mul_of_nonneg_right hgoodCard hbase + rw [← Finset.sum_sdiff (Finset.subset_univ good)] + linarith + +/-- Both conclusions of paper Lemma 17, specialized to the paper's transfer +matrix and normalized by the number of rows. The cycle encoding appears only +through `hbefore`, and the good-row geometry only through `hgood`. -/ +theorem coreTransferCost_normalized_le_for_transferU + {ι : Type*} [Fintype ι] [DecidableEq ι] [Nonempty ι] + (outside : ι → Finset ι) (good : Finset ι) + {P X : Matrix ι ι ℝ} {τ B η : ℝ} + (hτ : 0 ≤ τ) (hPpos : ∀ i j, 0 < P i j) + (hXint : ∀ i, IsInteriorProbabilityVector (X i)) + (hbefore : matrixTransferCost P (fun i j ↦ transferU τ (X i) j) ≤ + B + ∑ i, coarsenedRowEntropy (outside i) (P i)) + (hη : η ∈ Set.Icc (0 : ℝ) (2 : ℝ)⁻¹) + (hρ : ∀ i, massOn (outside i) (P i) ∈ Set.Icc (0 : ℝ) 1) + (hgood : ∀ i ∈ good, massOn (outside i) (P i) ≤ η) : + coreTransferCost outside P (fun i j ↦ transferU τ (X i) j) / + (Fintype.card ι : ℝ) ≤ + B / (Fintype.card ι : ℝ) + binaryEntropy η + η + + (1 + Real.log 2) * (Finset.card (Finset.univ \ good) : ℝ) / + (Fintype.card ι : ℝ) := by + have hcore := coreTransferCost_le_for_transferU outside hτ hPpos hXint hbefore + have hsum := sum_binaryEntropy_add_mass_le_good_bad good + (fun i ↦ massOn (outside i) (P i)) hη hρ hgood + have hn : 0 < (Fintype.card ι : ℝ) := by + exact_mod_cast Fintype.card_pos + apply (div_le_iff₀ hn).2 + calc + coreTransferCost outside P (fun i j ↦ transferU τ (X i) j) ≤ + B + (Fintype.card ι : ℝ) * (binaryEntropy η + η) + + (1 + Real.log 2) * (Finset.card (Finset.univ \ good) : ℝ) := by + linarith + _ = (B / (Fintype.card ι : ℝ) + binaryEntropy η + η + + (1 + Real.log 2) * (Finset.card (Finset.univ \ good) : ℝ) / + (Fintype.card ι : ℝ)) * (Fintype.card ι : ℝ) := by + field_simp [hn.ne'] + ring + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/ExecutableCertificate.lean b/LeanPool/BeyondBethe/BeyondBethe/ExecutableCertificate.lean new file mode 100644 index 0000000000..d819487d8e --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/ExecutableCertificate.lean @@ -0,0 +1,207 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.ExplicitScales +import LeanPool.BeyondBethe.BeyondBethe.NumericalNearby +import Mathlib.Tactic + +/-! # Executable Certificate -/ + +open scoped BigOperators + +namespace BeyondBethe + +/-! +# The executable structural certificate + +The regularized optimizer is represented by a rational doubly stochastic +matrix. Pair eligibility is decided by directed rational logarithm bounds, +and a deterministic maximal row matching collects the accepted fixed gains. +This file proves the complete positive-matrix dichotomy for that concrete +certificate; no pair-capacity optimizer or maximum-weight matching remains. +-/ + +/-- The hard-coded rational regularization scale in dimension `n`. -/ +def explicitRegularizationScale (n : ℕ) : ℚ := + explicitXi / (4 * n) + +theorem cast_explicitRegularizationScale (n : ℕ) : + ((explicitRegularizationScale n : ℚ) : ℝ) = + (explicitXi : ℝ) / (4 * (n : ℝ)) := by + simp [explicitRegularizationScale] + +theorem explicitRegularizationScale_pos {n : ℕ} (hn : 0 < n) : + 0 < explicitRegularizationScale n := by + rw [explicitRegularizationScale] + exact div_pos explicitXi_pos (by positivity) + +theorem explicitGamma_pos : 0 < explicitGamma := by + norm_num [explicitGamma] + +theorem explicitRegularizationScale_le_one {n : ℕ} (hn : 1 ≤ n) : + explicitRegularizationScale n ≤ 1 := by + have hxi : explicitXi ≤ 1 := by + norm_num [explicitXi, explicitDelta, explicitEta, explicitRowRatio] + rw [explicitRegularizationScale, div_le_one (by positivity)] + have hdenNat : 1 ≤ 4 * n := by omega + have hden : (1 : ℚ) ≤ 4 * n := by exact_mod_cast hdenNat + exact hxi.trans hden + +/-- The fixed-gain row-pair weights used by the algorithm. -/ +def explicitCertifiedRowWeight {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) : RowPair n → ℚ := + certifiedConstantRowWeight (explicitRegularizationScale n) X + explicitKappa explicitGamma (directedPairCostPrecision n) + +/-- The rational gain collected by the deterministic greedy matching. -/ +def explicitCertifiedMatchingGain {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) : ℚ := + greedyCertifiedMatchingGain (explicitCertifiedRowWeight X) explicitGamma + +theorem explicitCertifiedMatchingGain_nonneg {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) : + 0 ≤ explicitCertifiedMatchingGain X := by + rw [explicitCertifiedMatchingGain, greedyCertifiedMatchingGain] + exact Finset.sum_nonneg fun q _ ↦ + certifiedConstantRowWeight_nonneg _ _ _ _ _ q explicitGamma_pos.le + +/-- The complete structural certificate for a rational exact KKT point. +The structural clean-cycle test uses `0.9 * explicitKappa`; the executable +directed test uses `explicitKappa`, and their gap absorbs all logarithm +rounding error. -/ +theorem explicitCertified_certificate_of_logKKT + (stableCoefficient : AnariOveisGharanStableCoefficient.{0}) + {n : ℕ} (hn : 2 ≤ n) + {A : Matrix (Fin n) (Fin n) ℝ} + {Xq : Matrix (Fin n) (Fin n) ℚ} + (hA : Matrix.Positive A) + (hX : IsDoublyStochastic (fun i j ↦ ((Xq i j : ℚ) : ℝ))) + (hXint : ∀ i, IsInteriorProbabilityVector + (fun j ↦ ((Xq i j : ℚ) : ℝ))) + {R C : Fin n → ℝ} + (hKKT : HasLogKKT (explicitRegularizationScale n : ℝ) A + (fun i j ↦ ((Xq i j : ℚ) : ℝ)) R C) : + Real.exp (betheObjective A (fun i j ↦ ((Xq i j : ℚ) : ℝ)) + + (explicitCertifiedMatchingGain Xq : ℝ)) ≤ + Matrix.permanent A ∧ + Real.log (Matrix.permanent A) - + (betheObjective A (fun i j ↦ ((Xq i j : ℚ) : ℝ)) + + (explicitCertifiedMatchingGain Xq : ℝ)) ≤ + (Real.log 2 / 2 - + ((rationalEpsilonPlus explicitCertifiedCompletionScales : ℚ) : ℝ)) * n := by + let X : Matrix (Fin n) (Fin n) ℝ := + fun i j ↦ ((Xq i j : ℚ) : ℝ) + let τq : ℚ := explicitRegularizationScale n + let gain : ℝ := (explicitCertifiedMatchingGain Xq : ℝ) + let η : ℝ := (explicitEta : ℝ) + let δ : ℝ := (explicitDelta : ℝ) + let ξ : ℝ := (explicitXi : ℝ) + have hnpos : 0 < n := by omega + have hnreal : (1 : ℝ) ≤ n := by exact_mod_cast (show 1 ≤ n by omega) + have hlogn : Real.log n ≤ (n : ℝ) * Real.log 2 := + log_natCast_le_natCast_mul_log_two (show 1 ≤ n by omega) + have hξ : 0 < ξ := by + simpa only [ξ] using (show (0 : ℝ) < (explicitXi : ℝ) by + exact_mod_cast explicitXi_pos) + have hτscale : (τq : ℝ) = ξ / (4 * (n : ℝ)) := by + exact cast_explicitRegularizationScale n + have hτ0q : 0 ≤ τq := (explicitRegularizationScale_pos hnpos).le + have hτ1q : τq ≤ 1 := + explicitRegularizationScale_le_one (show 1 ≤ n by omega) + have hmax : ∀ Y, IsDoublyStochastic Y → + regularizedBetheObjective (τq : ℝ) A Y ≤ + regularizedBetheObjective (τq : ℝ) A X := by + exact regularizedBetheObjective_le_of_logKKT + (by simpa only [Fintype.card_fin] using (show 1 < n by omega)) + (by exact_mod_cast hτ0q) hX hXint hKKT + have hobjective : + Real.log (bethePermanent A) - ξ * n ≤ betheObjective A X := by + have hbudget := regularization_budget_of_paper_scale + (show (0 : ℝ) < n by positivity) hlogn hξ hτscale + have hvalue := betheLogValue_le_regularizedMaximizer + (show 1 < n by omega) (by exact_mod_cast hτ0q) hA hX hmax + have hmatch := positiveMatrix_hasPerfectMatching hA + have hlogBethe : Real.log (bethePermanent A) = betheLogValue A := by + rw [bethePermanent, if_pos hmatch, Real.log_exp] + rw [hlogBethe] + linarith + have hmatch := positiveMatrix_hasPerfectMatching hA + have hlogBethe : Real.log (bethePermanent A) = betheLogValue A := by + rw [bethePermanent, if_pos hmatch, Real.log_exp] + have hupper : Real.log (Matrix.permanent A) ≤ + Real.log (bethePermanent A) + n * (Real.log 2 / 2) := by + rw [hlogBethe] + exact log_permanent_le_betheLogValue_add_log_two_half hn A hA + let w : RowPair n → ℚ := explicitCertifiedRowWeight Xq + have hlower : ∀ q ∈ greedyThresholdRowMatching w explicitGamma, + (w q : ℝ) ≤ Real.log (pairGain A X + (rowPairRow q 0) (rowPairRow q 1)) := by + intro q hq + have hmaximal := greedyThresholdRowMatching_isMaximal w explicitGamma + have hthreshold : explicitGamma ≤ w q := by + have hmem := hmaximal.subset hq + simpa only [List.mem_toFinset, mem_thresholdRowPairsList_iff] using hmem + have hw : w q = explicitGamma := by + exact certifiedConstantRowWeight_eq_gamma_of_threshold + τq Xq explicitKappa explicitGamma (directedPairCostPrecision n) q + explicitGamma_pos hthreshold + have heligible : HasCertifiedCorePair τq Xq explicitKappa + (directedPairCostPrecision n) q := by + exact (certifiedConstantRowWeight_eq_gamma_iff + τq Xq explicitKappa explicitGamma (directedPairCostPrecision n) q + explicitGamma_pos.ne').1 hw + rw [hw] + exact certifiedConstantRowWeight_le_log_pairGain + explicit_cleanPairGain_constants hnreal hlogn hξ + (by + have hq := explicitCertifiedCompletionScales.ξ_le_source + have hr : ((explicitXi : ℚ) : ℝ) ≤ + ((explicitXiSource : ℚ) : ℝ) := by + exact_mod_cast hq + simpa only [ξ] using hr) + hτscale hA hX hXint hKKT (by norm_num) (by norm_num) + (directedPairCostPrecision n) q heligible + have hcertificate : Real.exp (betheObjective A X + gain) ≤ + Matrix.permanent A := by + exact exp_betheObjective_add_greedyCertifiedMatchingGain_le_permanent + stableCoefficient w explicitGamma_pos hlower hn hA hX + (fun i j ↦ (hXint i).2 j |>.1) + have hnearGain : betheSlack n (Real.log (bethePermanent A)) + (Real.log (Matrix.permanent A)) < δ * n → + 3 * (explicitCertifiedGamma : ℝ) / 8 * n ≤ gain := by + intro hnear + rw [hlogBethe] at hnear + have h := nearCase_greedyCertifiedMatchingGain_ge_threeSixteenths + anariRezaeiRowInequality hn + (by exact_mod_cast explicitCertifiedStructuralKappa_pos) + hnreal hlogn hξ hτscale hτ0q hτ1q explicitGamma_pos.le + (by exact_mod_cast explicitEta_pos) + explicitCertifiedCompletionScales.η_le_tenth + explicitCertifiedCompletionScales.row_small + explicitCertifiedCompletionScales.cycle_small + explicitCertifiedCompletionScales.transfer_small + hA hX hXint hKKT hnear (directedPairCostPrecision n) + (explicitCertifiedCostMargin n) + change 3 * (explicitCertifiedGamma : ℝ) / 8 * n ≤ + (explicitCertifiedMatchingGain Xq : ℝ) + norm_num [explicitCertifiedGamma, explicitGamma] at h ⊢ + exact h + have hcases := completionCaseDisjunction + (logPermanent := Real.log (Matrix.permanent A)) + (logBethe := Real.log (bethePermanent A)) + (objective := betheObjective A X) (gain := gain) + (δ := δ) (ξ := ξ) (γ := (explicitCertifiedGamma : ℝ)) + hobjective (by + change 0 ≤ (explicitCertifiedMatchingGain Xq : ℝ) + exact_mod_cast explicitCertifiedMatchingGain_nonneg Xq) + hupper hnearGain + have hgap := positiveDichotomy_exponent hcases + have hεcast := cast_rationalEpsilonPlus explicitCertifiedCompletionScales + constructor + · simpa only [X, gain] using hcertificate + · simpa only [X, gain, η, δ, ξ, hεcast] using hgap + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/ExecutableCertificateMagnitude.lean b/LeanPool/BeyondBethe/BeyondBethe/ExecutableCertificateMagnitude.lean new file mode 100644 index 0000000000..ff73f75953 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/ExecutableCertificateMagnitude.lean @@ -0,0 +1,45 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.CertificateMagnitude +import LeanPool.BeyondBethe.BeyondBethe.ExecutableScannedBetheOptimizer + +/-! +# Certificate magnitude for the row-major executable optimizer +-/ + +namespace BeyondBethe + +theorem executableOptimizerCertificateLog_abs_le + (m : ℕ) (B : Matrix (Fin (m + 2)) (Fin (m + 2)) ℚ) + (hBpos : ∀ i j, 0 < B i j) + (hBupper : ∀ i j, B i j ≤ 1) : + abs ((explicitDirectedCertificateLog + (executableScannedBetheOptimizerMatrix (m := m + 1) B) + (executableScannedBetheOptimizerRowPotential (m := m + 1) B) + (executableScannedBetheOptimizerColumnPotential (m := m + 1) B) : ℚ) : ℝ) ≤ + explicitCertificateMagnitudeBudget B := by + let X := executableScannedBetheOptimizerMatrix (m := m + 1) B + let R := executableScannedBetheOptimizerRowPotential (m := m + 1) B + let C := executableScannedBetheOptimizerColumnPotential (m := m + 1) B + have hpoint := executableScannedBetheOptimizerPoint_spec (m := m + 1) + (by omega) B hBpos hBupper + have hX : IsDoublyStochastic (fun i j ↦ ((X i j : ℚ) : ℝ)) := by + simpa only [X] using hpoint.2.1 + have hXlo : ∀ i j, (explicitOptimizerFloor B : ℝ) ≤ (X i j : ℝ) := by + simpa only [X] using hpoint.2.2.1 + have hfloor : 0 < (explicitOptimizerFloor B : ℝ) := + Rat.cast_pos.mpr (explicitOptimizerFloor_pos B) + have hXpos : ∀ i j, 0 < (X i j : ℝ) := fun i j ↦ + hfloor.trans_le (hXlo i j) + have happrox := executableScannedBetheOptimizer_hasApproximateLogKKT + (m := m + 1) (by omega) B hBpos hBupper + simpa only [X, R, C] using + certificateLog_abs_le_of_feasibleApproximateKKT + m B X R C hBpos hBupper hX hXpos + (by simpa only [X, R, C] using happrox) + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/ExecutableInterior.lean b/LeanPool/BeyondBethe/BeyondBethe/ExecutableInterior.lean new file mode 100644 index 0000000000..87cd524194 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/ExecutableInterior.lean @@ -0,0 +1,200 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.NumericalInterior +import LeanPool.BeyondBethe.BeyondBethe.NumericalScales +import LeanPool.BeyondBethe.BeyondBethe.DirectedElementary +import Mathlib.Tactic + +/-! # Executable Interior -/ + +namespace BeyondBethe + +/-! +# Executable interior floor from binary input size + +The analytic interior estimate is converted here into a rational dyadic floor +whose exponent is computed directly from the matrix encoding, the dimension, +and the rational regularization parameter. +-/ + +def numericalInteriorK0 (n B : ℕ) (τ : ℚ) : ℚ := + n * (n * B + 2 * n ^ 2) / τ + n ^ 3 + +def numericalInteriorExponent (n B : ℕ) (τ : ℚ) : ℕ := + rationalCeilNat (2 * numericalInteriorK0 n B τ) + +def numericalInteriorFloor (n B : ℕ) (τ : ℚ) : ℚ := + (1 / 2 : ℚ) ^ numericalInteriorExponent n B τ + +theorem numericalInteriorK0_nonneg + {n B : ℕ} {τ : ℚ} (hτ : 0 < τ) : + 0 ≤ numericalInteriorK0 n B τ := by + rw [numericalInteriorK0] + positivity + +theorem numericalInteriorFloor_pos (n B : ℕ) (τ : ℚ) : + 0 < numericalInteriorFloor n B τ := by + rw [numericalInteriorFloor] + positivity + +theorem numericalInteriorExponent_dominates + {n B : ℕ} {τ : ℚ} (hτ : 0 < τ) : + 2 * numericalInteriorK0 n B τ ≤ + numericalInteriorExponent n B τ := by + exact le_rationalCeilNat (mul_nonneg (by norm_num) + (numericalInteriorK0_nonneg hτ)) + +theorem log_inv_dyadic_cast (B : ℕ) : + Real.log (1 / ((((1 / 2 : ℚ) ^ B : ℚ)) : ℝ)) = + (B : ℝ) * Real.log 2 := by + norm_num only [Rat.cast_pow, Rat.cast_div, Rat.cast_one, Rat.cast_ofNat] + rw [show (1 / ((1 / 2 : ℝ) ^ B)) = (2 : ℝ) ^ B by + simp only [one_div, inv_pow, inv_inv]] + rw [Real.log_pow] + +theorem numericalObjectiveRange_dyadic_le + {n B : ℕ} (hn : 1 ≤ n) : + numericalObjectiveRange n + ((((1 / 2 : ℚ) ^ B : ℚ)) : ℝ) ≤ + (n : ℝ) * B + 2 * (n : ℝ) ^ 2 := by + have hlog2 : Real.log 2 ≤ 1 := by + have h := Real.log_le_sub_one_of_pos (x := (2 : ℝ)) (by norm_num) + norm_num at h + exact h + have hlogn0 := log_natCast_le_natCast_mul_log_two hn + have hlogn : Real.log n ≤ (n : ℝ) := by + have hnreal : 0 ≤ (n : ℝ) := by positivity + nlinarith + have hloginv := log_inv_dyadic_cast B + rw [numericalObjectiveRange, hloginv] + have hnreal : (1 : ℝ) ≤ n := by exact_mod_cast hn + have hBreal : 0 ≤ (B : ℝ) := by positivity + have hBlog : (B : ℝ) * Real.log 2 ≤ B := by + simpa using mul_le_mul_of_nonneg_left hlog2 hBreal + have hn0 : 0 ≤ (n : ℝ) := by positivity + have htermB := mul_le_mul_of_nonneg_left hBlog hn0 + have htermn := mul_le_mul_of_nonneg_left hlogn hn0 + have hnle : (n : ℝ) ≤ (n : ℝ) ^ 2 := by nlinarith + linarith + +theorem numericalInteriorK0_bounds_analytic + {n B : ℕ} (hn : 1 ≤ n) {τ : ℚ} (hτ : 0 < τ) : + (n : ℝ) * numericalObjectiveRange n + ((((1 / 2 : ℚ) ^ B : ℚ)) : ℝ) / (τ : ℝ) + + (n : ℝ) ^ 2 * Real.log n ≤ + (numericalInteriorK0 n B τ : ℝ) := by + have hrange := numericalObjectiveRange_dyadic_le (B := B) hn + have hτr : 0 < (τ : ℝ) := by exact_mod_cast hτ + have hnlog := log_natCast_le_natCast_mul_log_two hn + have hlog2 : Real.log 2 ≤ 1 := by + have h := Real.log_le_sub_one_of_pos (x := (2 : ℝ)) (by norm_num) + norm_num at h + exact h + have hlogn : Real.log n ≤ (n : ℝ) := by + have hnreal : 0 ≤ (n : ℝ) := by positivity + nlinarith + have hn0 : 0 ≤ (n : ℝ) := by positivity + have hscaled := (div_le_div_iff_of_pos_right hτr).2 + (mul_le_mul_of_nonneg_left hrange hn0) + have hlogterm := mul_le_mul_of_nonneg_left hlogn + (sq_nonneg (n : ℝ)) + rw [numericalInteriorK0] + push_cast + norm_num only [Rat.cast_pow, Rat.cast_div, Rat.cast_one, + Rat.cast_ofNat] at hscaled + nlinarith + +theorem numericalInteriorK0_le_exponent_mul_log_two + {n B : ℕ} {τ : ℚ} (hτ : 0 < τ) : + (numericalInteriorK0 n B τ : ℝ) ≤ + (numericalInteriorExponent n B τ : ℝ) * Real.log 2 := by + have hq := numericalInteriorExponent_dominates (n := n) (B := B) hτ + have hqR : 2 * (numericalInteriorK0 n B τ : ℝ) ≤ + (numericalInteriorExponent n B τ : ℝ) := by + exact_mod_cast hq + have hlog : (1 / 2 : ℝ) ≤ Real.log 2 := by + have h := Real.one_sub_inv_le_log_of_pos (by norm_num : (0 : ℝ) < 2) + norm_num at h ⊢ + exact h + have hK0 := numericalInteriorK0_nonneg (n := n) (B := B) hτ + have hqnonneg : 0 ≤ (numericalInteriorExponent n B τ : ℝ) := by positivity + nlinarith + +theorem lower_bound_of_log_inv_le_exponent + {x : ℝ} (hx : 0 < x) {q : ℕ} + (hlog : Real.log (1 / x) ≤ (q : ℝ) * Real.log 2) : + ((1 / 2 : ℚ) ^ q : ℚ) ≤ x := by + have hinvpos : 0 < 1 / x := one_div_pos.mpr hx + have hpowpos : 0 < (2 : ℝ) ^ q := pow_pos (by norm_num) q + have hlogpow : Real.log ((2 : ℝ) ^ q) = (q : ℝ) * Real.log 2 := by + rw [Real.log_pow] + have hinv : 1 / x ≤ (2 : ℝ) ^ q := by + rw [← Real.log_le_log_iff hinvpos hpowpos, hlogpow] + exact hlog + have hone : 1 ≤ (2 : ℝ) ^ q * x := by + exact (div_le_iff₀ hx).mp hinv + have hfloor : 1 / (2 : ℝ) ^ q ≤ x := by + exact (div_le_iff₀ hpowpos).2 (by simpa [mul_comm] using hone) + norm_num only [Rat.cast_pow, Rat.cast_div, Rat.cast_one, Rat.cast_ofNat] + simpa only [one_div, inv_pow] using hfloor + +/-- The exact regularized optimizer lies in the executable dyadic floor +body. -/ +theorem regularizedOptimizer_meets_executable_floor + {n : ℕ} (hn : 1 < n) {τ : ℚ} (hτ : 0 < τ) + {Aq : Matrix (Fin n) (Fin n) ℚ} + (hAq : ∀ i j, 0 < Aq i j) (hAupper : ∀ i j, Aq i j ≤ 1) + {X : Matrix (Fin n) (Fin n) ℝ} + (hX : IsDoublyStochastic X) + (hmax : ∀ Y, IsDoublyStochastic Y → + regularizedBetheObjective (τ : ℝ) + (fun i j ↦ (Aq i j : ℝ)) Y ≤ + regularizedBetheObjective (τ : ℝ) + (fun i j ↦ (Aq i j : ℝ)) X) : + ∀ i j, + (numericalInteriorFloor n (rationalMatrixEntryBitBound Aq) τ : ℝ) ≤ + X i j ∧ + (numericalInteriorFloor n (rationalMatrixEntryBitBound Aq) τ : ℝ) ≤ + 1 - X i j := by + let B := rationalMatrixEntryBitBound Aq + let m : ℚ := (1 / 2 : ℚ) ^ B + have hmQ : 0 < m := by positivity + have hm : 0 < (m : ℝ) := by exact_mod_cast hmQ + have hAlower : ∀ i j, (m : ℝ) ≤ (Aq i j : ℝ) := by + intro i j + exact_mod_cast (matrix_dyadic_bitBound_lt_entry hAq i j).le + have hApos : Matrix.Positive (fun i j ↦ (Aq i j : ℝ)) := by + intro i j + change 0 < ((Aq i j : ℚ) : ℝ) + exact Rat.cast_pos.mpr (hAq i j) + have hAupR : ∀ i j, (Aq i j : ℝ) ≤ 1 := by + intro i j + exact_mod_cast hAupper i j + have hτR : 0 < (τ : ℝ) := by exact_mod_cast hτ + have hanalytic := numericalInteriorK0_bounds_analytic + (B := B) (show 1 ≤ n by omega) hτ + have hexponent := numericalInteriorK0_le_exponent_mul_log_two + (n := n) (B := B) hτ + intro i j + have hentry := regularizedBetheMaximizer_log_inv_entry_le + hn hτR hm hApos hAlower hAupR hX hmax i j + have hcomp := regularizedBetheMaximizer_log_inv_one_sub_entry_le + hn hτR hm hApos hAlower hAupR hX hmax i j + have hXint := regularizedBetheMaximizer_interior hn hτR hApos hX hmax + have hbudget : + (n : ℝ) * numericalObjectiveRange n (m : ℝ) / (τ : ℝ) + + (n : ℝ) ^ 2 * Real.log n ≤ + (numericalInteriorExponent n B τ : ℝ) * Real.log 2 := + hanalytic.trans hexponent + have hfloorEntry := lower_bound_of_log_inv_le_exponent + ((hXint i).2 j |>.1) (hentry.trans hbudget) + have hfloorComp := lower_bound_of_log_inv_le_exponent + (sub_pos.mpr ((hXint i).2 j |>.2)) (hcomp.trans hbudget) + simpa only [m, B, numericalInteriorFloor] using + And.intro hfloorEntry hfloorComp + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/ExecutablePositiveRoutine.lean b/LeanPool/BeyondBethe/BeyondBethe/ExecutablePositiveRoutine.lean new file mode 100644 index 0000000000..b833fdd0bd --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/ExecutablePositiveRoutine.lean @@ -0,0 +1,155 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.ExecutableScannedBetheOptimizer +import LeanPool.BeyondBethe.BeyondBethe.FinalAssembly +import LeanPool.BeyondBethe.BeyondBethe.SourceStableReindex +import Mathlib.Tactic + +/-! +# The executable positive-matrix routine + +This is the mathematical function computed by the row-major finite-word +optimizer. Its proof uses the optimizer's proved feasibility and objective +gap, and therefore does not identify its tie-breaking choices with those of +the earlier semantic bisection runner. +-/ + +namespace BeyondBethe + +def executablePositiveAlgorithm : + ∀ n, Matrix (Fin n) (Fin n) ℚ → ℚ + | 0, A => Matrix.permanent A + | 1, A => Matrix.permanent A + | m + 2, A => + let B := normalizedRationalMatrix A + let X := executableScannedBetheOptimizerMatrix (m := m + 1) B + let R := executableScannedBetheOptimizerRowPotential (m := m + 1) B + let C := executableScannedBetheOptimizerColumnPotential (m := m + 1) B + rationalNormalizationScale A ^ (m + 2) * + explicitDirectedCertificateValue X R C + +@[simp] theorem executablePositiveAlgorithm_succ_succ + (m : ℕ) (A : Matrix (Fin (m + 2)) (Fin (m + 2)) ℚ) : + executablePositiveAlgorithm (m + 2) A = + rationalNormalizationScale A ^ (m + 2) * + explicitDirectedCertificateValue + (executableScannedBetheOptimizerMatrix (m := m + 1) + (normalizedRationalMatrix A)) + (executableScannedBetheOptimizerRowPotential (m := m + 1) + (normalizedRationalMatrix A)) + (executableScannedBetheOptimizerColumnPotential (m := m + 1) + (normalizedRationalMatrix A)) := by + rfl + +theorem executablePositiveAlgorithm_succ_succ_spec + (m : ℕ) (A : Matrix (Fin (m + 2)) (Fin (m + 2)) ℚ) + (hA : Matrix.Positive (fun i j ↦ (A i j : ℝ))) : + 0 < (executablePositiveAlgorithm (m + 2) A : ℝ) ∧ + (executablePositiveAlgorithm (m + 2) A : ℝ) ≤ + ((Matrix.permanent A : ℚ) : ℝ) ∧ + ((Matrix.permanent A : ℚ) : ℝ) ≤ + (preSmoothingBase (explicitCertifiedEpsilon : ℝ)) ^ (m + 2) * + (executablePositiveAlgorithm (m + 2) A : ℝ) := by + let B : Matrix (Fin (m + 2)) (Fin (m + 2)) ℚ := + normalizedRationalMatrix A + let X := executableScannedBetheOptimizerMatrix (m := m + 1) B + let R := executableScannedBetheOptimizerRowPotential (m := m + 1) B + let C := executableScannedBetheOptimizerColumnPotential (m := m + 1) B + let L : ℚ := explicitDirectedCertificateValue X R C + have hAq : ∀ i j, 0 < A i j := by + intro i j + exact positive_rational_of_positive_cast (hA i j) + have hAnonneg : Matrix.Nonnegative A := fun i j ↦ (hAq i j).le + have hBpos : ∀ i j, 0 < B i j := by + intro i j + change 0 < normalizedRationalMatrix A i j + rw [normalizedRationalMatrix] + exact div_pos (hAq i j) (rationalNormalizationScale_pos hAnonneg) + have hBupper : ∀ i j, B i j ≤ 1 := by + intro i j + exact normalizedRationalMatrix_le_one hAnonneg i j + have hpoint := executableScannedBetheOptimizerPoint_spec (m := m + 1) + (by omega) B hBpos hBupper + have hX : IsDoublyStochastic (fun i j ↦ ((X i j : ℚ) : ℝ)) := by + simpa only [X] using hpoint.2.1 + have hXlo : ∀ i j, (explicitOptimizerFloor B : ℝ) ≤ (X i j : ℝ) := by + simpa only [X] using hpoint.2.2.1 + have hdelta : 0 < (explicitOptimizerFloor B : ℝ) := + Rat.cast_pos.mpr (explicitOptimizerFloor_pos B) + have hXpos : ∀ i j, 0 < (X i j : ℝ) := by + intro i j + exact hdelta.trans_le (hXlo i j) + have hXint : ∀ i, IsInteriorProbabilityVector + (fun j ↦ ((X i j : ℚ) : ℝ)) := by + intro i + refine ⟨hX.row_probability i, fun j ↦ ⟨hXpos i j, ?_⟩⟩ + exact hX.entry_lt_one_of_positive hXpos (by simp) i j + have happrox := executableScannedBetheOptimizer_hasApproximateLogKKT + (m := m + 1) (by omega) B hBpos hBupper + have hBR : Matrix.Positive (fun i j ↦ (B i j : ℝ)) := by + intro i j + exact Rat.cast_pos.mpr (hBpos i j) + have hcert := explicitDirectedCertificate_twoSided + anariOveisGharanStableCoefficient (n := m + 2) (by omega) + hBR hX hXint (by simpa only [X, R, C, B] using happrox) + have hLpos : 0 < (L : ℝ) := by + simpa only [L] using explicitDirectedCertificateValue_pos + (n := m + 2) (by omega) X R C + have hscale : 0 < (rationalNormalizationScale A : ℝ) := by + exact_mod_cast rationalNormalizationScale_pos hAnonneg + have hper := cast_permanent_eq_scale_pow_mul_normalized A hAnonneg + have hout : + (executablePositiveAlgorithm (m + 2) A : ℝ) = + (rationalNormalizationScale A : ℝ) ^ (m + 2) * (L : ℝ) := by + simp only [executablePositiveAlgorithm_succ_succ, B, X, R, C, L, + Rat.cast_mul, Rat.cast_pow] + have hcert' : (L : ℝ) ≤ Matrix.permanent (fun i j ↦ (B i j : ℝ)) ∧ + Matrix.permanent (fun i j ↦ (B i j : ℝ)) ≤ + (preSmoothingBase (explicitCertifiedEpsilon : ℝ)) ^ (m + 2) * + (L : ℝ) := by + simpa only [L, X, R, C] using hcert + rw [hout] + refine ⟨mul_pos (pow_pos hscale _) hLpos, ?_, ?_⟩ + · rw [hper] + exact mul_le_mul_of_nonneg_left hcert'.1 (pow_nonneg hscale.le _) + · rw [hper] + have hmul := mul_le_mul_of_nonneg_left hcert'.2 + (pow_nonneg hscale.le (m + 2)) + nlinarith + +def executableCertifiedPositiveRoutine : + CertifiedPositiveRoutine (explicitCertifiedEpsilon : ℝ) where + alg := executablePositiveAlgorithm + positiveOutput := by + intro n hn A hA + cases n with + | zero => omega + | succ n => + cases n with + | zero => omega + | succ m => + exact (executablePositiveAlgorithm_succ_succ_spec m A hA).1 + lower := by + intro n hn A hA + cases n with + | zero => omega + | succ n => + cases n with + | zero => omega + | succ m => + exact (executablePositiveAlgorithm_succ_succ_spec m A hA).2.1 + upper := by + intro n hn A hA + cases n with + | zero => omega + | succ n => + cases n with + | zero => omega + | succ m => + exact (executablePositiveAlgorithm_succ_succ_spec m A hA).2.2 + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/ExecutableScannedBetheOptimizer.lean b/LeanPool/BeyondBethe/BeyondBethe/ExecutableScannedBetheOptimizer.lean new file mode 100644 index 0000000000..22cc79b103 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/ExecutableScannedBetheOptimizer.lean @@ -0,0 +1,332 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerBisectionSemantics +import LeanPool.BeyondBethe.BeyondBethe.ExplicitBetheOptimizer +import Mathlib.Tactic + +/-! +# Correctness of the executable row-major Bethe optimizer + +The finite-word optimizer uses the concrete unreduced dyadic floor emitted by +the scale machine and the row-major separation oracle. This file defines its +mathematical output, proves the same objective-gap specification as the +paper-level optimizer, and derives the approximate logarithmic KKT equations +without identifying its tie-breaking choices with those of any other runner. +-/ + +namespace BeyondBethe + +open Complexity + +def executableScannedBetheOptimizerFloor {m : ℕ} + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) : RawRat := + rawExplicitOptimizerFloor (m + 1) (rationalMatrixEntryBitBound A) + +def executableScannedBetheOptimizerInitialState {m : ℕ} + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) : + BetheBisectionState (m * m + 1) := + initialScannedBetheBisectionState + (explicitRegularizationScale (m + 1)) A + (explicitOptimizerPrecision A) + (executableScannedBetheOptimizerFloor A) + (explicitOptimizerMix A) (explicitOptimizerInnerRadius A) + +def executableScannedBetheOptimizerState {m : ℕ} + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) : + BetheBisectionState (m * m + 1) := + runScannedBetheBisection + (explicitRegularizationScale (m + 1)) A + (explicitOptimizerPrecision A) + (executableScannedBetheOptimizerFloor A) + (explicitOptimizerInnerRadius A) + (explicitOptimizerBisectionSteps A) + (executableScannedBetheOptimizerInitialState A) + +/-- The default branch makes the rational algorithm total. Correctness below +proves that it is never used on positive normalized inputs. -/ +def executableScannedBetheOptimizerPoint {m : ℕ} + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) : + Fin (m * m + 1) → ℚ := + (executableScannedBetheOptimizerState A).witness.getD 0 + +def executableScannedBetheOptimizerMatrix {m : ℕ} + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) : + Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ := + betheAffineMatrixQ (epigraphBase (executableScannedBetheOptimizerPoint A)) + +def executableScannedBetheOptimizerGradient {m : ℕ} + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) : + Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ := + directedNegativeGradientLowerMatrix + (explicitRegularizationScale (m + 1)) A + (executableScannedBetheOptimizerMatrix A) + (explicitOptimizerPrecision A) + +def executableScannedBetheOptimizerRowPotential {m : ℕ} + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) : Fin (m + 1) → ℚ := + fun i ↦ -executableScannedBetheOptimizerGradient A i 0 + + (2 + explicitRegularizationScale (m + 1)) + +def executableScannedBetheOptimizerColumnPotential {m : ℕ} + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) : Fin (m + 1) → ℚ := + fun j ↦ -(executableScannedBetheOptimizerGradient A 0 j - + executableScannedBetheOptimizerGradient A 0 0) + +@[simp] theorem executableScannedBetheOptimizerFloor_value {m : ℕ} + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) : + (executableScannedBetheOptimizerFloor A).value = + explicitOptimizerFloor A := by + exact (rawExplicitOptimizerScales_value A).1 + +theorem executableScannedBetheOptimizerPoint_spec {m : ℕ} (hm : 0 < m) + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (hApos : ∀ i j, 0 < A i j) (hAupper : ∀ i j, A i j ≤ 1) : + BetheEpigraphOracleAccepted (explicitRegularizationScale (m + 1)) A + (explicitOptimizerPrecision A) (explicitOptimizerFloor A) + (executableScannedBetheOptimizerState A).high + (executableScannedBetheOptimizerPoint A) ∧ + IsDoublyStochastic + (fun i j ↦ ((executableScannedBetheOptimizerMatrix A i j : ℚ) : ℝ)) ∧ + (∀ i j, (explicitOptimizerFloor A : ℝ) ≤ + (executableScannedBetheOptimizerMatrix A i j : ℝ)) ∧ + ∃ X : Matrix (Fin (m + 1)) (Fin (m + 1)) ℝ, + IsDoublyStochastic X ∧ + (∀ Y, IsDoublyStochastic Y → + regularizedBetheObjective + (explicitRegularizationScale (m + 1) : ℝ) + (fun i j ↦ (A i j : ℝ)) Y ≤ + regularizedBetheObjective + (explicitRegularizationScale (m + 1) : ℝ) + (fun i j ↦ (A i j : ℝ)) X) ∧ + regularizedBetheObjective + (explicitRegularizationScale (m + 1) : ℝ) + (fun i j ↦ (A i j : ℝ)) X - + regularizedBetheObjective + (explicitRegularizationScale (m + 1) : ℝ) + (fun i j ↦ (A i j : ℝ)) + (fun i j ↦ + ((executableScannedBetheOptimizerMatrix A i j : ℚ) : ℝ)) ≤ + (explicitOptimizerGap A : ℝ) := by + let tau : ℚ := explicitRegularizationScale (m + 1) + let delta := executableScannedBetheOptimizerFloor A + obtain ⟨X, hX, hmax⟩ := exists_regularizedBetheMaximizer + (tau : ℝ) (fun i j ↦ (A i j : ℝ)) + have htau0 : 0 < tau := explicitRegularizationScale_pos (by omega) + have htau1 : tau ≤ 1 := explicitRegularizationScale_le_one (by omega) + have hdelta : 0 < delta.value := by + change 0 < (executableScannedBetheOptimizerFloor A).value + rw [executableScannedBetheOptimizerFloor_value] + exact explicitOptimizerFloor_pos A + have hfloor : delta.value ≤ (1 - explicitOptimizerMix A) * + numericalInteriorFloor (m + 1) (rationalMatrixEntryBitBound A) tau := by + change (executableScannedBetheOptimizerFloor A).value ≤ + (1 - explicitOptimizerMix A) * + numericalInteriorFloor (m + 1) + (rationalMatrixEntryBitBound A) tau + rw [executableScannedBetheOptimizerFloor_value] + simpa only [tau] using explicitOptimizerFloor_le_smoothedFloor A + have hrun := runScannedBetheBisection_objective_gap hm htau0 htau1 + hApos hAupper hX hmax + (explicitOptimizerMix_pos A) (explicitOptimizerMix_le_one A) + hdelta (explicitOptimizerInnerRadius_pos A) + (explicitOptimizerInnerRadius_spike A) hfloor + (explicitOptimizerPrecision A) (explicitOptimizerBisectionSteps A) + have hrun' : ∃ q : Fin (m * m + 1) → ℚ, + (executableScannedBetheOptimizerState A).witness = some q ∧ + BetheEpigraphOracleAccepted tau A (explicitOptimizerPrecision A) + delta.value (executableScannedBetheOptimizerState A).high q ∧ + IsDoublyStochastic (acceptedBetheMatrix q) ∧ + (∀ i j, (delta.value : ℝ) ≤ acceptedBetheMatrix q i j) ∧ + regularizedBetheObjective (tau : ℝ) (fun i j ↦ (A i j : ℝ)) X - + regularizedBetheObjective (tau : ℝ) (fun i j ↦ (A i j : ℝ)) + (acceptedBetheMatrix q) ≤ + (betheSmoothingSlack A (explicitOptimizerMix A) + (explicitOptimizerInnerRadius A) : ℝ) + + (explicitOptimizerInitialWidth A / + 2 ^ explicitOptimizerBisectionSteps A : ℚ) + + (betheObjectiveEvaluationError m + (explicitOptimizerPrecision A) : ℝ) := by + simpa only [tau, delta, executableScannedBetheOptimizerState, + executableScannedBetheOptimizerInitialState, + explicitOptimizerInitialWidth] using hrun + obtain ⟨q, hq, haccepted, hqDS, hqfloor, hqgap⟩ := hrun' + have hpoint : executableScannedBetheOptimizerPoint A = q := by + rw [executableScannedBetheOptimizerPoint, hq] + rfl + have hmatrixCast : + (fun i j ↦ + ((executableScannedBetheOptimizerMatrix A i j : ℚ) : ℝ)) = + acceptedBetheMatrix q := by + ext i j + rw [executableScannedBetheOptimizerMatrix, hpoint] + exact cast_betheAffineMatrixQ (epigraphBase q) i j + have htotalQ := explicitOptimizerTotalObjectiveError_lt A + have htotal : + (betheSmoothingSlack A (explicitOptimizerMix A) + (explicitOptimizerInnerRadius A) : ℝ) + + (explicitOptimizerInitialWidth A / + 2 ^ explicitOptimizerBisectionSteps A : ℚ) + + (betheObjectiveEvaluationError m + (explicitOptimizerPrecision A) : ℝ) < + (explicitOptimizerGap A : ℝ) := by + exact_mod_cast htotalQ + refine ⟨?_, ?_, ?_, X, hX, hmax, ?_⟩ + · simpa only [tau, delta, + executableScannedBetheOptimizerFloor_value, hpoint] using haccepted + · simpa only [hmatrixCast] using hqDS + · intro i j + change (explicitOptimizerFloor A : ℝ) ≤ + (fun a b ↦ + ((executableScannedBetheOptimizerMatrix A a b : ℚ) : ℝ)) i j + rw [hmatrixCast] + simpa only [delta, executableScannedBetheOptimizerFloor_value] using + hqfloor i j + · rw [hmatrixCast] + exact hqgap.trans htotal.le + +theorem executableScannedBetheOptimizer_hasApproximateLogKKT + {m : ℕ} (hm : 0 < m) + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (hApos : ∀ i j, 0 < A i j) (hAupper : ∀ i j, A i j ≤ 1) : + HasApproximateLogKKT (explicitKKTError : ℝ) + (explicitRegularizationScale (m + 1) : ℝ) + (fun i j ↦ (A i j : ℝ)) + (fun i j ↦ + ((executableScannedBetheOptimizerMatrix A i j : ℚ) : ℝ)) + (fun i ↦ (executableScannedBetheOptimizerRowPotential A i : ℝ)) + (fun j ↦ + (executableScannedBetheOptimizerColumnPotential A j : ℝ)) := by + obtain ⟨_, hY, hYlo, X, hX, hmax, hgap⟩ := + executableScannedBetheOptimizerPoint_spec hm A hApos hAupper + simpa only [executableScannedBetheOptimizerGradient, + executableScannedBetheOptimizerRowPotential, + executableScannedBetheOptimizerColumnPotential] using + hasApproximateLogKKT_of_explicitOptimizerSpec hm A hApos hAupper + (executableScannedBetheOptimizerMatrix A) hY hYlo X hX hmax hgap + +/-! ## Exact agreement with the finite-word bisection output -/ + +theorem executableScannedBetheOptimizerState_indexAgrees {m : ℕ} + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) : + ScannedOptimizerIndexAgrees A + (executableScannedBetheOptimizerState A) + (runScannedOptimizerIndex A (explicitOptimizerBisectionSteps A) 0 0) + (explicitOptimizerBisectionSteps A) := by + simpa only [executableScannedBetheOptimizerState, + executableScannedBetheOptimizerInitialState, + executableScannedBetheOptimizerFloor, Nat.zero_add] using + runScannedOptimizerIndex_agrees A + (initialScannedOptimizerIndexAgrees A) + (explicitOptimizerBisectionSteps A) + +theorem executableScannedBetheOptimizer_witness_eq_some + {m : ℕ} (hm : 0 < m) + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (hApos : ∀ i j, 0 < A i j) (hAupper : ∀ i j, A i j ≤ 1) : + (executableScannedBetheOptimizerState A).witness = + some (executableScannedBetheOptimizerPoint A) := by + let tau : ℚ := explicitRegularizationScale (m + 1) + obtain ⟨X, hX, hmax⟩ := exists_regularizedBetheMaximizer + (tau : ℝ) (fun i j ↦ (A i j : ℝ)) + have htau0 : 0 < tau := explicitRegularizationScale_pos (by omega) + have htau1 : tau ≤ 1 := explicitRegularizationScale_le_one (by omega) + have hdelta : 0 < (executableScannedBetheOptimizerFloor A).value := by + rw [executableScannedBetheOptimizerFloor_value] + exact explicitOptimizerFloor_pos A + have hfloor : (executableScannedBetheOptimizerFloor A).value ≤ + (1 - explicitOptimizerMix A) * + numericalInteriorFloor (m + 1) + (rationalMatrixEntryBitBound A) tau := by + rw [executableScannedBetheOptimizerFloor_value] + simpa only [tau] using explicitOptimizerFloor_le_smoothedFloor A + have hsome0 := + initialScannedBetheBisectionState_has_witness_of_optimizer + hm htau0 htau1 hApos hAupper hX hmax + (explicitOptimizerMix_pos A) (explicitOptimizerMix_le_one A) + hdelta (explicitOptimizerInnerRadius_pos A) + (explicitOptimizerInnerRadius_spike A) hfloor + (explicitOptimizerPrecision A) + have hsome := runScannedBetheBisection_preserves_some + tau A (explicitOptimizerPrecision A) + (executableScannedBetheOptimizerFloor A) + (explicitOptimizerInnerRadius A) hsome0 + (explicitOptimizerBisectionSteps A) + obtain ⟨q, hq⟩ := hsome + have hq' : (executableScannedBetheOptimizerState A).witness = some q := by + simpa only [tau, executableScannedBetheOptimizerState, + executableScannedBetheOptimizerInitialState] using hq + rw [executableScannedBetheOptimizerPoint, hq'] + rfl + +theorem executableScannedBetheOptimizer_finalFeasibilityResult + {m : ℕ} (hm : 0 < m) + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (hApos : ∀ i j, 0 < A i j) (hAupper : ∀ i j, A i j ≤ 1) : + runExplicitScannedBetheThresholdFeasibility + (explicitRegularizationScale (m + 1)) A + (explicitOptimizerPrecision A) + (executableScannedBetheOptimizerFloor A) + (rawRatOfRat (executableScannedBetheOptimizerState A).high) + (explicitOptimizerInnerRadius A) = + .accepted (executableScannedBetheOptimizerPoint A) := by + have hvalid0 := initialScannedBetheBisectionState_witnessValid + (explicitRegularizationScale (m + 1)) A + (explicitOptimizerPrecision A) + (executableScannedBetheOptimizerFloor A) + (explicitOptimizerMix A) (explicitOptimizerInnerRadius A) + have hvalidN := runScannedBetheBisection_witnessValid + (explicitRegularizationScale (m + 1)) A + (explicitOptimizerPrecision A) + (executableScannedBetheOptimizerFloor A) + (explicitOptimizerInnerRadius A) hvalid0 + (explicitOptimizerBisectionSteps A) + exact (hvalidN (executableScannedBetheOptimizerPoint A) (by + simpa only [executableScannedBetheOptimizerState, + executableScannedBetheOptimizerInitialState] using + executableScannedBetheOptimizer_witness_eq_some + hm A hApos hAupper)).1 + +@[simp] theorem machineExplicitBetheOptimizerFeasibilityResultCode_encode + {m : ℕ} (hm : 0 < m) + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (hApos : ∀ i j, 0 < A i j) (hAupper : ∀ i j, A i j ≤ 1) : + machineExplicitBetheOptimizerFeasibilityResultCode + (rationalMatrixBinaryEncoding.encode ⟨m + 1, A⟩) = + rationalFeasibilityResultBinaryCode + (.accepted (executableScannedBetheOptimizerPoint A)) := by + let N := explicitOptimizerBisectionSteps A + let k := runScannedOptimizerIndex A N 0 0 + have hagree := executableScannedBetheOptimizerState_indexAgrees A + have hhigh : (executableScannedBetheOptimizerState A).high = + optimizerDyadicThreshold A (k + 1) N := by + simpa only [N, k] using hagree.2 + rw [machineExplicitBetheOptimizerFeasibilityResultCode, + machineOptimizerBisectionFinalState_encode hm A hApos, + machineOptimizerBisectionHighRawCode_encode] + rw [← hhigh] + change machineExplicitBetheThresholdFeasibilityCode + (optimizerFeasibilityCallCode A + (rawRatOfRat (executableScannedBetheOptimizerState A).high)) = _ + rw [machineExplicitBetheThresholdFeasibilityCode_encode hm A hApos] + apply congrArg rationalFeasibilityResultBinaryCode + simpa only [executableScannedBetheOptimizerFloor] using + executableScannedBetheOptimizer_finalFeasibilityResult + hm A hApos hAupper + +@[simp] theorem machineExplicitBetheOptimizerPointCode_encode + {m : ℕ} (hm : 0 < m) + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (hApos : ∀ i j, 0 < A i j) (hAupper : ∀ i j, A i j ≤ 1) : + machineExplicitBetheOptimizerPointCode + (rationalMatrixBinaryEncoding.encode ⟨m + 1, A⟩) = + rationalFiniteVectorCode (executableScannedBetheOptimizerPoint A) := by + rw [machineExplicitBetheOptimizerPointCode, + machineExplicitBetheOptimizerFeasibilityResultCode_encode + hm A hApos hAupper] + rfl + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/ExecutableTransfer.lean b/LeanPool/BeyondBethe/BeyondBethe/ExecutableTransfer.lean new file mode 100644 index 0000000000..23cad3fdaf --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/ExecutableTransfer.lean @@ -0,0 +1,144 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.ExecutableCertificate +import LeanPool.BeyondBethe.BeyondBethe.NumericalNearby + +/-! # Executable Transfer -/ + +namespace BeyondBethe + +/-! +# Transfer of the executable certificate + +An approximate logarithmic KKT point defines a nearby matrix for which the +rational point is an exact optimizer. The executable fixed-gain matching is +computed from that same rational point, so it transfers without any numerical +pair-gain approximation. +-/ + +/-- Logarithm of the executable lower certificate before its final directed +exponential evaluation. -/ +noncomputable def executableNearbyCertificateLog + {n : ℕ} (error : ℝ) + (Xq : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℝ) : ℝ := + let X : Matrix (Fin n) (Fin n) ℝ := + fun i j ↦ ((Xq i j : ℚ) : ℝ) + let A' := nearbyKKTMatrix (explicitRegularizationScale n : ℝ) X R C + betheObjective A' X + (explicitCertifiedMatchingGain Xq : ℝ) - error * n + +noncomputable def executableNearbyCertificateValue + {n : ℕ} (error : ℝ) + (Xq : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℝ) : ℝ := + Real.exp (executableNearbyCertificateLog error Xq R C) + +theorem executableNearbyCertificateValue_pos + {n : ℕ} (error : ℝ) + (Xq : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℝ) : + 0 < executableNearbyCertificateValue error Xq R C := + Real.exp_pos _ + +/-- Approximate KKT residual `error` costs exactly `2 * error` in the +logarithmic exponent: once in comparing permanents and once in shifting the +certificate downward to preserve its lower-bound direction. -/ +theorem executableNearbyCertificate_twoSided + (stableCoefficient : AnariOveisGharanStableCoefficient.{0}) + {n : ℕ} (hn : 2 ≤ n) + {A : Matrix (Fin n) (Fin n) ℝ} + {Xq : Matrix (Fin n) (Fin n) ℚ} + (hA : Matrix.Positive A) + (hX : IsDoublyStochastic + (fun i j ↦ ((Xq i j : ℚ) : ℝ))) + (hXint : ∀ i, IsInteriorProbabilityVector + (fun j ↦ ((Xq i j : ℚ) : ℝ))) + {error : ℝ} {R C : Fin n → ℝ} + (happrox : HasApproximateLogKKT error + (explicitRegularizationScale n : ℝ) A + (fun i j ↦ ((Xq i j : ℚ) : ℝ)) R C) : + executableNearbyCertificateValue error Xq R C ≤ + Matrix.permanent A ∧ + Matrix.permanent A ≤ + (Real.sqrt 2 * Real.exp + (-(((rationalEpsilonPlus + explicitCertifiedCompletionScales : ℚ) : ℝ) - + 2 * error))) ^ n * + executableNearbyCertificateValue error Xq R C := by + let X : Matrix (Fin n) (Fin n) ℝ := + fun i j ↦ ((Xq i j : ℚ) : ℝ) + let τ : ℝ := (explicitRegularizationScale n : ℝ) + let A' := nearbyKKTMatrix τ X R C + let F := betheObjective A' X + (explicitCertifiedMatchingGain Xq : ℝ) + let L := executableNearbyCertificateValue error Xq R C + have hXpos : ∀ i j, 0 < X i j := fun i j ↦ (hXint i).2 j |>.1 + have hXlt : ∀ i j, X i j < 1 := fun i j ↦ (hXint i).2 j |>.2 + have hA' : Matrix.Positive A' := nearbyKKTMatrix_positive hXpos hXlt + have hstruct := explicitCertified_certificate_of_logKKT + stableCoefficient hn hA' hX hXint + (nearbyKKTMatrix_hasLogKKT hXpos hXlt) + have hcompare := approximateLogKKT_permanent_comparison + hA (by simpa only [τ, X] using happrox) hXpos hXlt + have hcompare' : + (Real.exp (-error)) ^ n * Matrix.permanent A' ≤ + Matrix.permanent A ∧ + Matrix.permanent A ≤ + (Real.exp error) ^ n * Matrix.permanent A' := by + simpa only [A', τ, X, Fintype.card_fin] using hcompare + have hstructLower : Real.exp F ≤ Matrix.permanent A' := by + simpa only [F, A', X] using hstruct.1 + have hstructGap : Real.log (Matrix.permanent A') - F ≤ + (Real.log 2 / 2 - + ((rationalEpsilonPlus explicitCertifiedCompletionScales : ℚ) : ℝ)) * n := by + simpa only [F, A', X] using hstruct.2 + have hperA : 0 < Matrix.permanent A := permanent_pos_of_positive A hA + have hperA' : 0 < Matrix.permanent A' := permanent_pos_of_positive A' hA' + have hL : L = Real.exp (F - error * n) := by + simp only [L, executableNearbyCertificateValue, + executableNearbyCertificateLog, A', F, τ, X] + have hfactor : Real.exp (F - error * n) = + (Real.exp (-error)) ^ n * Real.exp F := by + calc + Real.exp (F - error * n) = + Real.exp F * Real.exp (-(error * n)) := by + rw [sub_eq_add_neg, Real.exp_add] + _ = Real.exp F * Real.exp ((n : ℝ) * (-error)) := by + congr 2 + ring + _ = Real.exp F * (Real.exp (-error)) ^ n := by + rw [Real.exp_nat_mul] + _ = (Real.exp (-error)) ^ n * Real.exp F := by ring + constructor + · change L ≤ Matrix.permanent A + rw [hL, hfactor] + exact (mul_le_mul_of_nonneg_left hstructLower + (pow_nonneg (Real.exp_pos (-error)).le n)).trans hcompare'.1 + · have hscalePos : 0 < (Real.exp error) ^ n * Matrix.permanent A' := + mul_pos (pow_pos (Real.exp_pos _) n) hperA' + have hlogCompare : Real.log (Matrix.permanent A) ≤ + Real.log ((Real.exp error) ^ n * Matrix.permanent A') := + Real.strictMonoOn_log.monotoneOn hperA hscalePos hcompare'.2 + have hlogScale : + Real.log ((Real.exp error) ^ n * Matrix.permanent A') = + error * n + Real.log (Matrix.permanent A') := by + rw [Real.log_mul (pow_ne_zero n (Real.exp_ne_zero error)) hperA'.ne', + Real.log_pow, Real.log_exp] + ring + have hgap : Real.log (Matrix.permanent A) - Real.log L ≤ + (Real.log 2 / 2 - + (((rationalEpsilonPlus + explicitCertifiedCompletionScales : ℚ) : ℝ) - + 2 * error)) * n := by + rw [hlogScale] at hlogCompare + rw [hL, Real.log_exp] + nlinarith [hstructGap] + change Matrix.permanent A ≤ + (Real.sqrt 2 * Real.exp + (-(((rationalEpsilonPlus + explicitCertifiedCompletionScales : ℚ) : ℝ) - + 2 * error))) ^ n * L + exact logGap_implies_positive_approximation + (by rw [hL]; exact Real.exp_pos _) hperA hgap + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/ExplicitBetheOptimizer.lean b/LeanPool/BeyondBethe/BeyondBethe/ExplicitBetheOptimizer.lean new file mode 100644 index 0000000000..e7c8a2c064 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/ExplicitBetheOptimizer.lean @@ -0,0 +1,353 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.ExplicitOptimizerScales +import Mathlib.Tactic + +/-! # Explicit Bethe Optimizer -/ + +namespace BeyondBethe + +/-! +# The concrete rational regularized-Bethe optimizer + +This file fixes every parameter of the rational threshold oracle and +bisection. The exact real maximizer below appears only in correctness +proofs; the state and returned point are executable rational data. +-/ + +def explicitBetheOptimizerInitialState {m : ℕ} + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) : + BetheBisectionState (m * m + 1) := + initialBetheBisectionState (explicitRegularizationScale (m + 1)) A + (explicitOptimizerPrecision A) (explicitOptimizerFloor A) + (explicitOptimizerMix A) (explicitOptimizerInnerRadius A) + +def explicitBetheOptimizerState {m : ℕ} + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) : + BetheBisectionState (m * m + 1) := + runBetheBisection (explicitRegularizationScale (m + 1)) A + (explicitOptimizerPrecision A) (explicitOptimizerFloor A) + (explicitOptimizerInnerRadius A) (explicitOptimizerBisectionSteps A) + (explicitBetheOptimizerInitialState A) + +/-- The default branch is unreachable on positive normalized inputs, but +keeps the algorithm total on every rational matrix. -/ +def explicitBetheOptimizerPoint {m : ℕ} + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) : + Fin (m * m + 1) → ℚ := + (explicitBetheOptimizerState A).witness.getD 0 + +def explicitBetheOptimizerMatrix {m : ℕ} + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) : + Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ := + betheAffineMatrixQ (epigraphBase (explicitBetheOptimizerPoint A)) + +def explicitBetheOptimizerGradient {m : ℕ} + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) : + Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ := + directedNegativeGradientLowerMatrix + (explicitRegularizationScale (m + 1)) A + (explicitBetheOptimizerMatrix A) (explicitOptimizerPrecision A) + +/-- Rational row potentials obtained by anchoring the directed negative +gradient at the first column. -/ +def explicitBetheOptimizerRowPotential {m : ℕ} + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) : Fin (m + 1) → ℚ := + fun i ↦ -explicitBetheOptimizerGradient A i 0 + + (2 + explicitRegularizationScale (m + 1)) + +/-- Rational column potentials, normalized to vanish at the first column. -/ +def explicitBetheOptimizerColumnPotential {m : ℕ} + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) : Fin (m + 1) → ℚ := + fun j ↦ -(explicitBetheOptimizerGradient A 0 j - + explicitBetheOptimizerGradient A 0 0) + +theorem HasApproximateLogKKT.mono + {ι : Type*} [Fintype ι] {ε ε' τ : ℝ} + {A X : Matrix ι ι ℝ} {R C : ι → ℝ} + (h : HasApproximateLogKKT ε τ A X R C) (hε : ε ≤ ε') : + HasApproximateLogKKT ε' τ A X R C := by + intro i j + exact (h i j).trans hε + +theorem explicitBetheOptimizerPoint_spec {m : ℕ} (hm : 0 < m) + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (hApos : ∀ i j, 0 < A i j) (hAupper : ∀ i j, A i j ≤ 1) : + BetheEpigraphOracleAccepted (explicitRegularizationScale (m + 1)) A + (explicitOptimizerPrecision A) (explicitOptimizerFloor A) + (explicitBetheOptimizerState A).high + (explicitBetheOptimizerPoint A) ∧ + IsDoublyStochastic + (fun i j ↦ ((explicitBetheOptimizerMatrix A i j : ℚ) : ℝ)) ∧ + (∀ i j, (explicitOptimizerFloor A : ℝ) ≤ + (explicitBetheOptimizerMatrix A i j : ℝ)) ∧ + ∃ X : Matrix (Fin (m + 1)) (Fin (m + 1)) ℝ, + IsDoublyStochastic X ∧ + (∀ Y, IsDoublyStochastic Y → + regularizedBetheObjective + (explicitRegularizationScale (m + 1) : ℝ) + (fun i j ↦ (A i j : ℝ)) Y ≤ + regularizedBetheObjective + (explicitRegularizationScale (m + 1) : ℝ) + (fun i j ↦ (A i j : ℝ)) X) ∧ + regularizedBetheObjective + (explicitRegularizationScale (m + 1) : ℝ) + (fun i j ↦ (A i j : ℝ)) X - + regularizedBetheObjective + (explicitRegularizationScale (m + 1) : ℝ) + (fun i j ↦ (A i j : ℝ)) + (fun i j ↦ ((explicitBetheOptimizerMatrix A i j : ℚ) : ℝ)) ≤ + (explicitOptimizerGap A : ℝ) := by + let τ : ℚ := explicitRegularizationScale (m + 1) + obtain ⟨X, hX, hmax⟩ := exists_regularizedBetheMaximizer + (τ : ℝ) (fun i j ↦ (A i j : ℝ)) + have hτ0 : 0 < τ := explicitRegularizationScale_pos (by omega) + have hτ1 : τ ≤ 1 := explicitRegularizationScale_le_one (by omega) + have hrun := runBetheBisection_objective_gap hm hτ0 hτ1 hApos hAupper + hX hmax (explicitOptimizerMix_pos A) (explicitOptimizerMix_le_one A) + (explicitOptimizerFloor_pos A) (explicitOptimizerInnerRadius_pos A) + (explicitOptimizerInnerRadius_spike A) + (explicitOptimizerFloor_le_smoothedFloor A) + (explicitOptimizerPrecision A) (explicitOptimizerBisectionSteps A) + have hrun' : ∃ q : Fin (m * m + 1) → ℚ, + (explicitBetheOptimizerState A).witness = some q ∧ + BetheEpigraphOracleAccepted τ A (explicitOptimizerPrecision A) + (explicitOptimizerFloor A) (explicitBetheOptimizerState A).high q ∧ + IsDoublyStochastic (acceptedBetheMatrix q) ∧ + (∀ i j, (explicitOptimizerFloor A : ℝ) ≤ acceptedBetheMatrix q i j) ∧ + regularizedBetheObjective (τ : ℝ) (fun i j ↦ (A i j : ℝ)) X - + regularizedBetheObjective (τ : ℝ) (fun i j ↦ (A i j : ℝ)) + (acceptedBetheMatrix q) ≤ + (betheSmoothingSlack A (explicitOptimizerMix A) + (explicitOptimizerInnerRadius A) : ℝ) + + (explicitOptimizerInitialWidth A / + 2 ^ explicitOptimizerBisectionSteps A : ℚ) + + (betheObjectiveEvaluationError m + (explicitOptimizerPrecision A) : ℝ) := by + simpa only [τ, explicitBetheOptimizerState, + explicitBetheOptimizerInitialState, explicitOptimizerInitialWidth] + using hrun + obtain ⟨q, hq, haccepted, hqDS, hqfloor, hqgap⟩ := hrun' + have hpoint : explicitBetheOptimizerPoint A = q := by + rw [explicitBetheOptimizerPoint, hq] + rfl + have hmatrixCast : + (fun i j ↦ ((explicitBetheOptimizerMatrix A i j : ℚ) : ℝ)) = + acceptedBetheMatrix q := by + ext i j + rw [explicitBetheOptimizerMatrix, hpoint] + exact cast_betheAffineMatrixQ (epigraphBase q) i j + have htotalQ := explicitOptimizerTotalObjectiveError_lt A + have htotal : + (betheSmoothingSlack A (explicitOptimizerMix A) + (explicitOptimizerInnerRadius A) : ℝ) + + (explicitOptimizerInitialWidth A / + 2 ^ explicitOptimizerBisectionSteps A : ℚ) + + (betheObjectiveEvaluationError m + (explicitOptimizerPrecision A) : ℝ) < + (explicitOptimizerGap A : ℝ) := by + exact_mod_cast htotalQ + refine ⟨?_, ?_, ?_, X, hX, hmax, ?_⟩ + · simpa only [τ, hpoint] using haccepted + · simpa only [hmatrixCast] using hqDS + · intro i j + change (explicitOptimizerFloor A : ℝ) ≤ + (fun a b ↦ ((explicitBetheOptimizerMatrix A a b : ℚ) : ℝ)) i j + rw [hmatrixCast] + exact hqfloor i j + · rw [hmatrixCast] + exact hqgap.trans htotal.le + +/-- Any rational matrix satisfying the concrete optimizer's feasibility and +objective-gap specification yields the same anchored approximate logarithmic +KKT certificate. This formulation separates the analytic argument from the +tie-breaking rule used by the executable separation oracle. -/ +theorem hasApproximateLogKKT_of_explicitOptimizerSpec {m : ℕ} (hm : 0 < m) + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (hApos : ∀ i j, 0 < A i j) (hAupper : ∀ i j, A i j ≤ 1) + (Xq : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (hY : IsDoublyStochastic (fun i j ↦ ((Xq i j : ℚ) : ℝ))) + (hYlo : ∀ i j, (explicitOptimizerFloor A : ℝ) ≤ (Xq i j : ℝ)) + (X : Matrix (Fin (m + 1)) (Fin (m + 1)) ℝ) + (hX : IsDoublyStochastic X) + (hmax : ∀ Y, IsDoublyStochastic Y → + regularizedBetheObjective + (explicitRegularizationScale (m + 1) : ℝ) + (fun i j ↦ (A i j : ℝ)) Y ≤ + regularizedBetheObjective + (explicitRegularizationScale (m + 1) : ℝ) + (fun i j ↦ (A i j : ℝ)) X) + (hgap : regularizedBetheObjective + (explicitRegularizationScale (m + 1) : ℝ) + (fun i j ↦ (A i j : ℝ)) X - + regularizedBetheObjective + (explicitRegularizationScale (m + 1) : ℝ) + (fun i j ↦ (A i j : ℝ)) + (fun i j ↦ ((Xq i j : ℚ) : ℝ)) ≤ + (explicitOptimizerGap A : ℝ)) : + HasApproximateLogKKT (explicitKKTError : ℝ) + (explicitRegularizationScale (m + 1) : ℝ) + (fun i j ↦ (A i j : ℝ)) + (fun i j ↦ ((Xq i j : ℚ) : ℝ)) + (fun i ↦ (-directedNegativeGradientLowerMatrix + (explicitRegularizationScale (m + 1)) A Xq + (explicitOptimizerPrecision A) i 0 + + (2 + explicitRegularizationScale (m + 1)) : ℚ)) + (fun j ↦ (-(directedNegativeGradientLowerMatrix + (explicitRegularizationScale (m + 1)) A Xq + (explicitOptimizerPrecision A) 0 j - + directedNegativeGradientLowerMatrix + (explicitRegularizationScale (m + 1)) A Xq + (explicitOptimizerPrecision A) 0 0) : ℚ)) := by + let τq : ℚ := explicitRegularizationScale (m + 1) + let Y : Matrix (Fin (m + 1)) (Fin (m + 1)) ℝ := + fun i j ↦ (Xq i j : ℝ) + let Gq := directedNegativeGradientLowerMatrix τq A Xq + (explicitOptimizerPrecision A) + let G : Matrix (Fin (m + 1)) (Fin (m + 1)) ℝ := + fun i j ↦ (Gq i j : ℝ) + have hτ0q : 0 < τq := explicitRegularizationScale_pos (by omega) + have hτ1q : τq ≤ 1 := explicitRegularizationScale_le_one (by omega) + have hτ0 : 0 < (τq : ℝ) := Rat.cast_pos.mpr hτ0q + have hτ1 : (τq : ℝ) ≤ 1 := by exact_mod_cast hτ1q + have hδq : 0 < explicitOptimizerFloor A := explicitOptimizerFloor_pos A + have hδ : 0 < (explicitOptimizerFloor A : ℝ) := Rat.cast_pos.mpr hδq + have hρ : 0 ≤ (explicitOptimizerRho A : ℝ) := by + exact_mod_cast (explicitOptimizerRho_pos A).le + have hY' : IsDoublyStochastic Y := by simpa only [Y] using hY + have hYlo' : ∀ i j, (explicitOptimizerFloor A : ℝ) ≤ Y i j := by + simpa only [Y] using hYlo + have hYpos : ∀ i j, 0 < Y i j := by + intro i j + exact hδ.trans_le (hYlo' i j) + have hYcomp : ∀ i j, (explicitOptimizerFloor A : ℝ) ≤ 1 - Y i j := by + exact one_sub_entry_ge_of_common_floor (by simp; omega) hY' hYlo' + have hYlt : ∀ i j, Y i j < 1 := + hY'.entry_lt_one_of_positive hYpos (by simp; omega) + let δ0q : ℚ := numericalInteriorFloor (m + 1) + (rationalMatrixEntryBitBound A) τq + have hδle : explicitOptimizerFloor A ≤ δ0q := by + rw [explicitOptimizerFloor] + have hδ0 : 0 < δ0q := numericalInteriorFloor_pos _ _ _ + dsimp only [δ0q, τq] at hδ0 ⊢ + linarith + have hoptimizerFloor : ∀ i j, + (δ0q : ℝ) ≤ X i j ∧ (δ0q : ℝ) ≤ 1 - X i j := by + exact regularizedOptimizer_meets_executable_floor (n := m + 1) + (by omega) hτ0q hApos hAupper hX hmax + have hδleR : (explicitOptimizerFloor A : ℝ) ≤ (δ0q : ℝ) := by + exact_mod_cast hδle + have hXlo : ∀ i j, (explicitOptimizerFloor A : ℝ) ≤ X i j := by + intro i j + exact hδleR.trans (hoptimizerFloor i j).1 + have hXcomp : ∀ i j, (explicitOptimizerFloor A : ℝ) ≤ 1 - X i j := by + intro i j + exact hδleR.trans (hoptimizerFloor i j).2 + have hAposR : Matrix.Positive (fun i j ↦ (A i j : ℝ)) := by + intro i j + exact Rat.cast_pos.mpr (hApos i j) + have hXint : ∀ i, IsInteriorProbabilityVector (X i) := + regularizedBetheMaximizer_interior (by omega) hτ0 hAposR hX hmax + have hXqpos : ∀ i j, 0 < Xq i j := by + intro i j + exact Rat.cast_pos.mp (by simpa only [Y] using hYpos i j) + have hXqlt : ∀ i j, Xq i j < 1 := by + intro i j + have hij : (Xq i j : ℝ) < (1 : ℝ) := by + simpa only [Y] using hYlt i j + exact_mod_cast hij + let evaluationError : ℝ := + (4 * (1 / 2 : ℚ) ^ explicitOptimizerPrecision A : ℚ) + have heval : ∀ i j, + abs (-regularizedBetheGradient (τq : ℝ) + (fun a b ↦ (A a b : ℝ)) Y i j - G i j) ≤ evaluationError := by + intro i j + have hb := directedNegativeGradient_bounds hτ0q.le hτ1q + (hApos i j) (hXqpos i j) (hXqlt i j) + (explicitOptimizerPrecision A) + have hexact : + negativeRegularizedBetheGradientCoordinate (τq : ℝ) + (A i j : ℝ) (Xq i j : ℝ) = + -regularizedBetheGradient (τq : ℝ) + (fun a b ↦ (A a b : ℝ)) Y i j := by + rw [negativeRegularizedBetheGradientCoordinate_eq_neg] + simp only [regularizedBetheGradient, Y] + have hlower : + (Gq i j : ℝ) ≤ + -regularizedBetheGradient (τq : ℝ) + (fun a b ↦ (A a b : ℝ)) Y i j := by + rw [← hexact] + simpa only [Gq, directedNegativeGradientLowerMatrix, τq] using hb.1 + have hupper : + -regularizedBetheGradient (τq : ℝ) + (fun a b ↦ (A a b : ℝ)) Y i j ≤ + (directedNegativeGradientUpper τq (A i j) (Xq i j) + (explicitOptimizerPrecision A) : ℝ) := by + rw [← hexact] + exact hb.2.1 + have hwidth : + (directedNegativeGradientUpper τq (A i j) (Xq i j) + (explicitOptimizerPrecision A) : ℝ) - (Gq i j : ℝ) ≤ + evaluationError := by + simpa only [Gq, directedNegativeGradientLowerMatrix, τq, evaluationError, + Rat.cast_mul, Rat.cast_pow, Rat.cast_div, Rat.cast_one, + Rat.cast_ofNat] using hb.2.2 + change abs (-regularizedBetheGradient (τq : ℝ) + (fun a b ↦ (A a b : ℝ)) Y i j - (Gq i j : ℝ)) ≤ evaluationError + rw [abs_of_nonneg (sub_nonneg.mpr hlower)] + linarith + have hscale : + 4 * (explicitOptimizerGap A : ℝ) ≤ + (τq : ℝ) * (explicitOptimizerRho A : ℝ) ^ 2 := by + have hscaleQ := explicitOptimizerGap_scale A + exact (by exact_mod_cast hscaleQ : + 4 * (explicitOptimizerGap A : ℝ) = + (τq : ℝ) * (explicitOptimizerRho A : ℝ) ^ 2).le + have hsmall := approximateLogKKT_of_objective_gap + (ι := Fin (m + 1)) (by simp; omega) + hτ0 hτ1 hρ hδ hscale hX hY' hmax + (by simpa only [τq, Y] using hgap) hXint hXlo hYlo' + hXcomp hYcomp heval (0 : Fin (m + 1)) (0 : Fin (m + 1)) + have hbudgetQ := explicitOptimizerKKTError_le A + have hbudget : + evaluationError + 4 * + (evaluationError + 3 * (explicitOptimizerRho A : ℝ) / + (explicitOptimizerFloor A : ℝ)) ≤ + (explicitKKTError : ℝ) := by + have hbudgetR := (Rat.cast_le (K := ℝ)).mpr hbudgetQ + norm_num only [Rat.cast_add, Rat.cast_mul, Rat.cast_div, Rat.cast_pow, + Rat.cast_one, Rat.cast_ofNat] at hbudgetR + dsimp only [evaluationError] + norm_num only [Rat.cast_mul, Rat.cast_pow, Rat.cast_div, Rat.cast_one, + Rat.cast_ofNat] + exact hbudgetR + have hlarge := hsmall.mono hbudget + simpa only [τq, Y, Gq, G, evaluationError, + anchoredRowPotential, + anchoredColumnPotential, Rat.cast_neg, Rat.cast_add, Rat.cast_sub, + Rat.cast_ofNat] using hlarge + +/-- The concrete rational matrix and anchored rational potentials satisfy the +fixed approximate logarithmic KKT equations. -/ +theorem explicitBetheOptimizer_hasApproximateLogKKT {m : ℕ} (hm : 0 < m) + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (hApos : ∀ i j, 0 < A i j) (hAupper : ∀ i j, A i j ≤ 1) : + HasApproximateLogKKT (explicitKKTError : ℝ) + (explicitRegularizationScale (m + 1) : ℝ) + (fun i j ↦ (A i j : ℝ)) + (fun i j ↦ ((explicitBetheOptimizerMatrix A i j : ℚ) : ℝ)) + (fun i ↦ (explicitBetheOptimizerRowPotential A i : ℝ)) + (fun j ↦ (explicitBetheOptimizerColumnPotential A j : ℝ)) := by + obtain ⟨_, hY, hYlo, X, hX, hmax, hgap⟩ := + explicitBetheOptimizerPoint_spec hm A hApos hAupper + simpa only [explicitBetheOptimizerGradient, + explicitBetheOptimizerRowPotential, + explicitBetheOptimizerColumnPotential] using + hasApproximateLogKKT_of_explicitOptimizerSpec hm A hApos hAupper + (explicitBetheOptimizerMatrix A) hY hYlo X hX hmax hgap + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/ExplicitBetheThresholdFeasibility.lean b/LeanPool/BeyondBethe/BeyondBethe/ExplicitBetheThresholdFeasibility.lean new file mode 100644 index 0000000000..f9ad625b3f --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/ExplicitBetheThresholdFeasibility.lean @@ -0,0 +1,161 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.BetheThresholdFeasibility +import LeanPool.BeyondBethe.BeyondBethe.ExplicitScheduledFeasibility +import Mathlib.Tactic + +/-! # Explicit Bethe Threshold Feasibility -/ + +namespace BeyondBethe + +/-! +# Bethe threshold feasibility with the explicit ball schedule + +This is the threshold runner implemented by the finite-word optimizer. It +uses the same rational oracle and iteration budget as +`runBetheThresholdFeasibility`, but its rounding precision is computed from +the two explicit zero-ball exponents rather than a matrix LCM. +-/ + +def runExplicitBetheThresholdFeasibility {m : ℕ} + (τ : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (p : ℕ) (δ upper r : ℚ) : + RationalFeasibilityResult (m * m + 1) := + let R := betheEpigraphOuterRadius m upper r + runExplicitBallRationalFeasibility + (betheBoundedEpigraphOracle τ A p δ upper) + (betheThresholdFeasibilityBudget m upper r) R + +theorem runExplicitBetheThresholdFeasibility_acceptsOnly {m : ℕ} + (τ : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (p : ℕ) (δ upper r : ℚ) {q : Fin (m * m + 1) → ℚ} + (hrun : runExplicitBetheThresholdFeasibility τ A p δ upper r = + .accepted q) : + BetheEpigraphOracleAccepted τ A p δ upper q := by + exact runExplicitBallRationalFeasibility_acceptsOnly + (betheBoundedEpigraphOracle_acceptsOnly τ A p δ upper) + (by simpa only [runExplicitBetheThresholdFeasibility, + betheThresholdFeasibilityBudget] using hrun) + +theorem runExplicitBetheThresholdFeasibility_accepts_of_slack + {m : ℕ} (hm : 0 < m) {τ : ℚ} (hτ0 : 0 < τ) (hτ1 : τ ≤ 1) + {A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ} + (hApos : ∀ i j, 0 < A i j) (hAupper : ∀ i j, A i j ≤ 1) + {X : Matrix (Fin (m + 1)) (Fin (m + 1)) ℝ} + (hX : IsDoublyStochastic X) + (hmax : ∀ Y, IsDoublyStochastic Y → + regularizedBetheObjective (τ : ℝ) + (fun i j ↦ (A i j : ℝ)) Y ≤ + regularizedBetheObjective (τ : ℝ) + (fun i j ↦ (A i j : ℝ)) X) + {mix δ upper r : ℚ} (hmix0 : 0 < mix) (hmix1 : mix ≤ 1) + (hδ : 0 < δ) (hr : 0 < r) + (hspike : r / mix ≤ 1 / (m + 1 : ℚ)) + (hfloor : δ ≤ (1 - mix) * + numericalInteriorFloor (m + 1) (rationalMatrixEntryBitBound A) τ) + (hslack : + -regularizedBetheObjective (τ : ℝ) + (fun i j ↦ (A i j : ℝ)) X + + (mix : ℝ) * (rationalRegularizedObjectiveRange A : ℝ) + + 2 * (r : ℝ) ≤ (upper : ℝ)) + (p : ℕ) : + ∃ q : Fin (m * m + 1) → ℚ, + runExplicitBetheThresholdFeasibility τ A p δ upper r = + .accepted q ∧ + BetheEpigraphOracleAccepted τ A p δ upper q := by + let δ0 : ℚ := numericalInteriorFloor (m + 1) + (rationalMatrixEntryBitBound A) τ + have hoptimizerFloor : ∀ i j, (δ0 : ℝ) ≤ X i j := by + intro i j + exact (regularizedOptimizer_meets_executable_floor + (n := m + 1) (by omega) hτ0 hApos hAupper hX hmax i j).1 + have hcross := BetheEpigraphTarget_smoothed_inner_cross hm hτ0.le hτ1 + hApos hAupper hX hoptimizerFloor + (Rat.cast_pos.mpr hmix0) (by exact_mod_cast hmix1) + (Rat.cast_nonneg.mpr hr.le) (by + have hs := (Rat.cast_le (K := ℝ)).mpr hspike + norm_num only [Rat.cast_div, Rat.cast_one, Rat.cast_natCast] at hs + simpa using hs) + (δ := (δ : ℝ)) (upper := (upper : ℝ)) (by + exact_mod_cast hfloor) hslack + let ycenter := squareMatrixToVector (smoothedUniformAffineBase X (mix : ℝ)) + let zcenter := epigraphPoint ycenter ((upper : ℝ) - (r : ℝ)) + have hcross' : + (∀ k, BetheEpigraphTarget (τ : ℝ) (fun i j ↦ (A i j : ℝ)) + (δ : ℝ) (upper : ℝ) + (fun i ↦ zcenter i + if i = k then (r : ℝ) else 0)) ∧ + (∀ k, BetheEpigraphTarget (τ : ℝ) (fun i j ↦ (A i j : ℝ)) + (δ : ℝ) (upper : ℝ) + (fun i ↦ zcenter i - if i = k then (r : ℝ) else 0)) := by + simpa only [ycenter, zcenter] using hcross + have houter := BetheEpigraphTarget_inner_cross_outer_zero hm + (Rat.cast_nonneg.mpr hδ.le) (Rat.cast_nonneg.mpr hr.le) ycenter + hcross'.1 hcross'.2 + have hR : 0 < betheEpigraphOuterRadius m upper r := + betheEpigraphOuterRadius_pos m hr.le + obtain ⟨q, hrun, hgood⟩ := + runExplicitBallRationalFeasibility_ball_accepts + (d := m * m + 1) (by omega) + (Target := BetheEpigraphTarget (τ : ℝ) (fun i j ↦ (A i j : ℝ)) + (δ : ℝ) (upper : ℝ)) + (Good := BetheEpigraphOracleAccepted τ A p δ upper) + (oracle := betheBoundedEpigraphOracle τ A p δ upper) + (betheBoundedEpigraphOracle_valid hm hτ0.le hτ1 hApos hδ p upper) + (betheBoundedEpigraphOracle_acceptsOnly τ A p δ upper) + hR hr hcross'.1 hcross'.2 + (by + intro k + have hk := houter.1 k + rw [cast_betheEpigraphOuterRadius] + simpa [zcenter, ycenter] using hk) + (by + intro k + have hk := houter.2 k + rw [cast_betheEpigraphOuterRadius] + simpa [zcenter, ycenter] using hk) + refine ⟨q, ?_, hgood⟩ + simpa only [runExplicitBetheThresholdFeasibility, + betheThresholdFeasibilityBudget] using hrun + +theorem runExplicitBetheThresholdFeasibility_exhausted_lt_optimum_add_slack + {m : ℕ} (hm : 0 < m) {τ : ℚ} (hτ0 : 0 < τ) (hτ1 : τ ≤ 1) + {A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ} + (hApos : ∀ i j, 0 < A i j) (hAupper : ∀ i j, A i j ≤ 1) + {X : Matrix (Fin (m + 1)) (Fin (m + 1)) ℝ} + (hX : IsDoublyStochastic X) + (hmax : ∀ Y, IsDoublyStochastic Y → + regularizedBetheObjective (τ : ℝ) + (fun i j ↦ (A i j : ℝ)) Y ≤ + regularizedBetheObjective (τ : ℝ) + (fun i j ↦ (A i j : ℝ)) X) + {mix δ upper r : ℚ} (hmix0 : 0 < mix) (hmix1 : mix ≤ 1) + (hδ : 0 < δ) (hr : 0 < r) + (hspike : r / mix ≤ 1 / (m + 1 : ℚ)) + (hfloor : δ ≤ (1 - mix) * + numericalInteriorFloor (m + 1) (rationalMatrixEntryBitBound A) τ) + (p : ℕ) {E : RationalEllipsoidState (m * m + 1)} + (hrun : runExplicitBetheThresholdFeasibility τ A p δ upper r = + .exhausted E) : + (upper : ℝ) < + -regularizedBetheObjective (τ : ℝ) + (fun i j ↦ (A i j : ℝ)) X + + (mix : ℝ) * (rationalRegularizedObjectiveRange A : ℝ) + + 2 * (r : ℝ) := by + by_contra hnot + have hslack : + -regularizedBetheObjective (τ : ℝ) + (fun i j ↦ (A i j : ℝ)) X + + (mix : ℝ) * (rationalRegularizedObjectiveRange A : ℝ) + + 2 * (r : ℝ) ≤ (upper : ℝ) := not_lt.mp hnot + obtain ⟨q, haccepted, _⟩ := + runExplicitBetheThresholdFeasibility_accepts_of_slack + hm hτ0 hτ1 hApos hAupper hX hmax hmix0 hmix1 hδ hr + hspike hfloor hslack p + rw [hrun] at haccepted + contradiction + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/ExplicitBounds.lean b/LeanPool/BeyondBethe/BeyondBethe/ExplicitBounds.lean new file mode 100644 index 0000000000..a1d7b87f8f --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/ExplicitBounds.lean @@ -0,0 +1,740 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.CleanConstants +import LeanPool.BeyondBethe.BeyondBethe.NumericalWitness +import LeanPool.BeyondBethe.BeyondBethe.GoodRowScore +import LeanPool.BeyondBethe.BeyondBethe.DirectedElementary +import Mathlib.Analysis.Complex.ExponentialBounds +import Mathlib.Tactic + +/-! # Explicit Bounds -/ + +open scoped Topology + +namespace BeyondBethe + +/-! +# Explicit analytic bounds for the structural constants + +The qualitative proof originally selected its absolute constants from +continuity neighborhoods. This file develops quantitative estimates instead. +They will be used to replace every such choice by fixed rational data. +-/ + +/-- The entropy singularity at zero has an explicit square-root modulus. -/ +theorem abs_negMulLog_lt_two_sqrt_abs {x : ℝ} (hx : abs x ≤ 1) : + abs (Real.negMulLog x) ≤ 2 * Real.sqrt (abs x) := by + by_cases hx0 : x = 0 + · subst x + simp + have hax : 0 < abs x := abs_pos.mpr hx0 + have hseries := Real.abs_log_mul_self_rpow_lt (abs x) (1 / 2 : ℝ) + hax hx (by norm_num) + rw [← Real.sqrt_eq_rpow] at hseries + have hsqrt : 0 ≤ Real.sqrt (abs x) := Real.sqrt_nonneg _ + have hsquare : Real.sqrt (abs x) * Real.sqrt (abs x) = abs x := by + nlinarith [Real.sq_sqrt (abs_nonneg x)] + have hfactor : + abs (Real.negMulLog x) = + Real.sqrt (abs x) * abs (Real.log (abs x) * Real.sqrt (abs x)) := by + calc + abs (Real.negMulLog x) = abs x * abs (Real.log x) := by + simp [Real.negMulLog_def] + _ = abs x * abs (Real.log (abs x)) := by rw [Real.log_abs] + _ = Real.sqrt (abs x) * + abs (Real.log (abs x) * Real.sqrt (abs x)) := by + rw [abs_mul, abs_of_nonneg hsqrt] + calc + abs x * abs (Real.log (abs x)) = + (Real.sqrt (abs x) * Real.sqrt (abs x)) * + abs (Real.log (abs x)) := by rw [hsquare] + _ = Real.sqrt (abs x) * + (abs (Real.log (abs x)) * Real.sqrt (abs x)) := by ring + rw [hfactor] + have htwo : abs (Real.log (abs x) * Real.sqrt (abs x)) < 2 := by + norm_num at hseries ⊢ + exact hseries + exact (mul_le_mul_of_nonneg_left htwo.le hsqrt).trans_eq (by ring) + +/-- On a positive interval bounded away from zero, logarithm has the expected +elementary Lipschitz bound. -/ +theorem abs_log_sub_log_le_div {a x y : ℝ} + (ha : 0 < a) (hax : a ≤ x) (hay : a ≤ y) : + abs (Real.log x - Real.log y) ≤ abs (x - y) / a := by + have hx : 0 < x := ha.trans_le hax + have hy : 0 < y := ha.trans_le hay + rcases le_total x y with hxy | hyx + · have hlogxy : Real.log x ≤ Real.log y := + Real.strictMonoOn_log.monotoneOn hx hy hxy + rw [abs_of_nonpos (sub_nonpos.mpr hlogxy), abs_of_nonpos (sub_nonpos.mpr hxy)] + rw [neg_sub, neg_sub, ← Real.log_div hy.ne' hx.ne'] + calc + Real.log (y / x) ≤ y / x - 1 := + Real.log_le_sub_one_of_pos (div_pos hy hx) + _ = (y - x) / x := by field_simp + _ ≤ (y - x) / a := by + exact div_le_div_of_nonneg_left (sub_nonneg.mpr hxy) ha hax + · have hlogyx : Real.log y ≤ Real.log x := + Real.strictMonoOn_log.monotoneOn hy hx hyx + rw [abs_of_nonneg (sub_nonneg.mpr hlogyx), abs_of_nonneg (sub_nonneg.mpr hyx)] + rw [← Real.log_div hx.ne' hy.ne'] + calc + Real.log (x / y) ≤ x / y - 1 := + Real.log_le_sub_one_of_pos (div_pos hx hy) + _ = (x - y) / y := by field_simp + _ ≤ (x - y) / a := by + exact div_le_div_of_nonneg_left (sub_nonneg.mpr hyx) ha hay + +/-- A coarse numerical log bound on the fixed interval used by the good-row +argument. Its slack is intentional: only an absolute modulus is needed. -/ +theorem abs_log_le_two_of_mem {x : ℝ} + (hxlo : (3 / 10 : ℝ) ≤ x) (hxhi : x ≤ 3 / 2) : + abs (Real.log x) ≤ 2 := by + have hx : 0 < x := (by norm_num : (0 : ℝ) < 3 / 10).trans_le hxlo + have he : Real.exp (-2) < (1 / 4 : ℝ) := by + rw [show (-2 : ℝ) = -1 + -1 by ring, Real.exp_add] + have h := Real.exp_neg_one_lt_half + have hp := Real.exp_pos (-1) + nlinarith + have hlow : -2 < Real.log x := by + rw [← Real.exp_lt_exp, Real.exp_log hx] + exact (he.trans_le (show (1 / 4 : ℝ) ≤ 3 / 10 by norm_num)).trans_le hxlo + have hupp : Real.log x ≤ 1 / 2 := by + exact (Real.log_le_sub_one_of_pos hx).trans (by linarith) + exact abs_le.mpr ⟨by linarith, by linarith⟩ + +/-- `negMulLog` is explicitly Lipschitz on `[3/10,6/5]`. -/ +theorem abs_negMulLog_sub_le_six_mul {x y : ℝ} + (hxlo : (3 / 10 : ℝ) ≤ x) (hxhi : x ≤ 6 / 5) + (hylo : (3 / 10 : ℝ) ≤ y) (hyhi : y ≤ 6 / 5) : + abs (Real.negMulLog x - Real.negMulLog y) ≤ 6 * abs (x - y) := by + have hlogx := abs_log_le_two_of_mem hxlo (hxhi.trans (by norm_num)) + have hlogdiff := abs_log_sub_log_le_div + (a := (3 / 10 : ℝ)) (by norm_num) hxlo hylo + have hy0 : 0 ≤ y := (by norm_num : (0 : ℝ) ≤ 3 / 10).trans hylo + rw [Real.negMulLog_def] + have hid : + -x * Real.log x - -y * Real.log y = + -(x - y) * Real.log x - y * (Real.log x - Real.log y) := by ring + rw [hid] + calc + abs (-(x - y) * Real.log x - y * (Real.log x - Real.log y)) ≤ + abs (-(x - y) * Real.log x) + + abs (y * (Real.log x - Real.log y)) := abs_sub _ _ + _ = abs (x - y) * abs (Real.log x) + + y * abs (Real.log x - Real.log y) := by + rw [abs_mul, abs_neg, abs_mul, abs_of_nonneg hy0] + _ ≤ abs (x - y) * 2 + y * (abs (x - y) / (3 / 10 : ℝ)) := by + gcongr + _ ≤ 6 * abs (x - y) := by + have hd : 0 ≤ abs (x - y) := abs_nonneg _ + have hycoef : (10 / 3 : ℝ) * y ≤ 4 := by nlinarith + have hterm : y * (abs (x - y) / (3 / 10 : ℝ)) ≤ + 4 * abs (x - y) := by + calc + y * (abs (x - y) / (3 / 10 : ℝ)) = + ((10 / 3 : ℝ) * y) * abs (x - y) := by ring + _ ≤ 4 * abs (x - y) := + mul_le_mul_of_nonneg_right hycoef hd + linarith + +/-- A product-log estimate on the same fixed interval. -/ +theorem abs_mul_log_sub_mul_log_le + {x y s t : ℝ} + (hx : abs x ≤ 6 / 5) (hy : abs y ≤ 6 / 5) + (hslo : (3 / 10 : ℝ) ≤ s) (hshi : s ≤ 3 / 2) + (htlo : (3 / 10 : ℝ) ≤ t) (hthi : t ≤ 3 / 2) : + abs (x * Real.log s - y * Real.log t) ≤ + 2 * abs (x - y) + 4 * abs (s - t) := by + have hlogs := abs_log_le_two_of_mem hslo hshi + have hlogdiff := abs_log_sub_log_le_div + (a := (3 / 10 : ℝ)) (by norm_num) hslo htlo + have hid : x * Real.log s - y * Real.log t = + (x - y) * Real.log s + y * (Real.log s - Real.log t) := by ring + rw [hid] + calc + abs ((x - y) * Real.log s + y * (Real.log s - Real.log t)) ≤ + abs ((x - y) * Real.log s) + + abs (y * (Real.log s - Real.log t)) := abs_add_le _ _ + _ = abs (x - y) * abs (Real.log s) + + abs y * abs (Real.log s - Real.log t) := by rw [abs_mul, abs_mul] + _ ≤ abs (x - y) * 2 + + (6 / 5 : ℝ) * (abs (s - t) / (3 / 10 : ℝ)) := by gcongr + _ = 2 * abs (x - y) + 4 * abs (s - t) := by ring + +/-- Binary entropy is explicitly Lipschitz on `[3/10,7/10]`. -/ +theorem abs_binaryEntropy_sub_half_le {p : ℝ} + (hp0 : (3 / 10 : ℝ) ≤ p) (hp1 : p ≤ 7 / 10) : + abs (binaryEntropy p - Real.log 2) ≤ 12 * abs (p - 1 / 2) := by + have h1p0 : (3 / 10 : ℝ) ≤ 1 - p := by linarith + have h1p1 : 1 - p ≤ 7 / 10 := by linarith + have hp := abs_negMulLog_sub_le_six_mul hp0 (hp1.trans (by norm_num)) + (show (3 / 10 : ℝ) ≤ 1 / 2 by norm_num) + (show (1 / 2 : ℝ) ≤ 6 / 5 by norm_num) + have h1p := abs_negMulLog_sub_le_six_mul h1p0 (h1p1.trans (by norm_num)) + (show (3 / 10 : ℝ) ≤ 1 / 2 by norm_num) + (show (1 / 2 : ℝ) ≤ 6 / 5 by norm_num) + rw [binaryEntropy, Real.negMulLog_def] + have hloghalf : Real.log (1 / 2 : ℝ) = -Real.log 2 := by + rw [show (1 / 2 : ℝ) = (2 : ℝ)⁻¹ by norm_num, Real.log_inv] + have hcenter : + -((1 / 2 : ℝ) * Real.log (1 / 2 : ℝ)) + + -((1 / 2 : ℝ) * Real.log (1 / 2 : ℝ)) = Real.log 2 := by + rw [hloghalf] + ring + rw [← hcenter] + have hid : + (-p * Real.log p + -(1 - p) * Real.log (1 - p)) - + (-((1 / 2 : ℝ) * Real.log (1 / 2 : ℝ)) + + -((1 / 2 : ℝ) * Real.log (1 / 2 : ℝ))) = + (Real.negMulLog p - Real.negMulLog (1 / 2 : ℝ)) + + (Real.negMulLog (1 - p) - Real.negMulLog (1 / 2 : ℝ)) := by + simp only [Real.negMulLog_def] + ring + rw [hid] + calc + abs ((Real.negMulLog p - Real.negMulLog (1 / 2 : ℝ)) + + (Real.negMulLog (1 - p) - Real.negMulLog (1 / 2 : ℝ))) ≤ + abs (Real.negMulLog p - Real.negMulLog (1 / 2 : ℝ)) + + abs (Real.negMulLog (1 - p) - Real.negMulLog (1 / 2 : ℝ)) := + abs_add_le _ _ + _ ≤ 6 * abs (p - 1 / 2) + + 6 * abs ((1 - p) - 1 / 2) := add_le_add hp h1p + _ = 12 * abs (p - 1 / 2) := by + congr 1 + rw [show (1 - p) - 1 / 2 = -(p - 1 / 2) by ring, abs_neg] + ring + +/-- The suffix error with a small suffix mass has an explicit square-root +modulus around `(1/2,0)`. -/ +theorem abs_continuousSuffixError_near_zero + {u q r : ℝ} (hr0 : 0 ≤ r) (hr1 : r ≤ 1 / 10) + (hu : abs (u - 1 / 2) ≤ r) (hq : abs q ≤ r) : + abs (continuousSuffixError u q - + continuousSuffixError (1 / 2) 0) ≤ + 11 * r + 2 * Real.sqrt r := by + have hu' := abs_le.mp hu + have hq' := abs_le.mp hq + have hu0 : (2 / 5 : ℝ) ≤ u := by linarith + have hu1 : u ≤ 3 / 5 := by linarith + have hq0 : -(1 / 10 : ℝ) ≤ q := by linarith + have hq1 : q ≤ 1 / 10 := by linarith + have hs0 : (3 / 10 : ℝ) ≤ u + q := by linarith + have hs1 : u + q ≤ 7 / 10 := by linarith + have hqabs : abs q ≤ 6 / 5 := hq.trans (hr1.trans (by norm_num)) + have hprod := abs_mul_log_sub_mul_log_le + hqabs (by norm_num : abs (0 : ℝ) ≤ 6 / 5) + hs0 (hs1.trans (by norm_num)) + (show (3 / 10 : ℝ) ≤ 1 / 2 by norm_num) + (show (1 / 2 : ℝ) ≤ 3 / 2 by norm_num) + have hsdev : abs ((u + q) - 1 / 2) ≤ 2 * r := by + calc + abs ((u + q) - 1 / 2) = abs ((u - 1 / 2) + q) := by ring + _ ≤ abs (u - 1 / 2) + abs q := abs_add_le _ _ + _ ≤ r + r := add_le_add hu hq + _ = 2 * r := by ring + have hprod' : abs (q * Real.log (u + q) - + 0 * Real.log (1 / 2)) ≤ 10 * r := by + calc + abs (q * Real.log (u + q) - 0 * Real.log (1 / 2)) ≤ + 2 * abs (q - 0) + 4 * abs ((u + q) - 1 / 2) := hprod + _ ≤ 2 * r + 4 * (2 * r) := by gcongr <;> simpa using hq + _ = 10 * r := by ring + have hnml := abs_negMulLog_lt_two_sqrt_abs + (x := q) (hq.trans (hr1.trans (by norm_num))) + have hsqrt : Real.sqrt (abs q) ≤ Real.sqrt r := + Real.sqrt_le_sqrt hq + have hnml' : abs (Real.negMulLog q - Real.negMulLog 0) ≤ + 2 * Real.sqrt r := by + simpa using hnml.trans (mul_le_mul_of_nonneg_left hsqrt (by norm_num)) + simp only [continuousSuffixError] + have hid : + (u - q * Real.log (u + q) - Real.negMulLog q) - + ((1 / 2 : ℝ) - 0 * Real.log (1 / 2 + 0) - Real.negMulLog 0) = + (u - 1 / 2) - + (q * Real.log (u + q) - 0 * Real.log (1 / 2)) - + (Real.negMulLog q - Real.negMulLog 0) := by ring + rw [hid] + calc + abs ((u - 1 / 2) - + (q * Real.log (u + q) - 0 * Real.log (1 / 2)) - + (Real.negMulLog q - Real.negMulLog 0)) ≤ + abs (u - 1 / 2) + + abs (q * Real.log (u + q) - 0 * Real.log (1 / 2)) + + abs (Real.negMulLog q - Real.negMulLog 0) := by + calc + abs (((u - 1 / 2) - + (q * Real.log (u + q) - 0 * Real.log (1 / 2))) - + (Real.negMulLog q - Real.negMulLog 0)) ≤ + abs ((u - 1 / 2) - + (q * Real.log (u + q) - 0 * Real.log (1 / 2))) + + abs (Real.negMulLog q - Real.negMulLog 0) := abs_sub _ _ + _ ≤ (abs (u - 1 / 2) + + abs (q * Real.log (u + q) - 0 * Real.log (1 / 2))) + + abs (Real.negMulLog q - Real.negMulLog 0) := + add_le_add (abs_sub _ _) le_rfl + _ ≤ r + 10 * r + 2 * Real.sqrt r := + add_le_add (add_le_add hu hprod') hnml' + _ = 11 * r + 2 * Real.sqrt r := by ring + +/-- The nonsingular suffix terms are uniformly Lipschitz around +`(1/2,1/2)`. -/ +theorem abs_continuousSuffixError_near_half + {u v q r : ℝ} (hr0 : 0 ≤ r) (hr1 : r ≤ 1 / 10) + (hu : abs (u - 1 / 2) ≤ r) + (hv : abs (v - 1 / 2) ≤ r) (hq : abs q ≤ r) : + abs (continuousSuffixError u (v + q) - + continuousSuffixError (1 / 2) (1 / 2)) ≤ 29 * r := by + have hu' := abs_le.mp hu + have hv' := abs_le.mp hv + have hq' := abs_le.mp hq + have hxdev : abs ((v + q) - 1 / 2) ≤ 2 * r := by + calc + abs ((v + q) - 1 / 2) = abs ((v - 1 / 2) + q) := by ring + _ ≤ abs (v - 1 / 2) + abs q := abs_add_le _ _ + _ ≤ r + r := add_le_add hv hq + _ = 2 * r := by ring + have hsdev : abs ((u + (v + q)) - 1) ≤ 3 * r := by + calc + abs ((u + (v + q)) - 1) = + abs ((u - 1 / 2) + (v - 1 / 2) + q) := by ring + _ ≤ abs ((u - 1 / 2) + (v - 1 / 2)) + abs q := abs_add_le _ _ + _ ≤ (abs (u - 1 / 2) + abs (v - 1 / 2)) + abs q := by + gcongr + exact abs_add_le _ _ + _ ≤ (r + r) + r := by gcongr + _ = 3 * r := by ring + have hx0 : (3 / 10 : ℝ) ≤ v + q := by linarith + have hx1 : v + q ≤ 7 / 10 := by linarith + have hs0 : (7 / 10 : ℝ) ≤ u + (v + q) := by linarith + have hs1 : u + (v + q) ≤ 13 / 10 := by linarith + have hprod := abs_mul_log_sub_mul_log_le + (show abs (v + q) ≤ 6 / 5 by rw [abs_le]; constructor <;> linarith) + (by norm_num : abs (1 / 2 : ℝ) ≤ 6 / 5) + (show (3 / 10 : ℝ) ≤ u + (v + q) from hs0.trans' (by norm_num)) + (show u + (v + q) ≤ (3 / 2 : ℝ) from hs1.trans (by norm_num)) + (show (3 / 10 : ℝ) ≤ 1 by norm_num) + (show (1 : ℝ) ≤ 3 / 2 by norm_num) + have hprod' : + abs ((v + q) * Real.log (u + (v + q)) - + (1 / 2) * Real.log 1) ≤ 16 * r := by + calc + abs ((v + q) * Real.log (u + (v + q)) - + (1 / 2) * Real.log 1) ≤ + 2 * abs ((v + q) - 1 / 2) + + 4 * abs ((u + (v + q)) - 1) := hprod + _ ≤ 2 * (2 * r) + 4 * (3 * r) := by gcongr + _ = 16 * r := by ring + have hnml := abs_negMulLog_sub_le_six_mul hx0 + (hx1.trans (by norm_num)) + (show (3 / 10 : ℝ) ≤ 1 / 2 by norm_num) + (show (1 / 2 : ℝ) ≤ 6 / 5 by norm_num) + have hnml' : + abs (Real.negMulLog (v + q) - Real.negMulLog (1 / 2)) ≤ + 12 * r := by + calc + abs (Real.negMulLog (v + q) - Real.negMulLog (1 / 2)) ≤ + 6 * abs ((v + q) - 1 / 2) := hnml + _ ≤ 6 * (2 * r) := mul_le_mul_of_nonneg_left hxdev (by norm_num) + _ = 12 * r := by ring + simp only [continuousSuffixError] + have hid : + (u - (v + q) * Real.log (u + (v + q)) - Real.negMulLog (v + q)) - + ((1 / 2 : ℝ) - (1 / 2) * Real.log ((1 / 2) + (1 / 2)) - + Real.negMulLog (1 / 2)) = + (u - 1 / 2) - + ((v + q) * Real.log (u + (v + q)) - (1 / 2) * Real.log 1) - + (Real.negMulLog (v + q) - Real.negMulLog (1 / 2)) := by ring + rw [hid] + calc + abs ((u - 1 / 2) - + ((v + q) * Real.log (u + (v + q)) - (1 / 2) * Real.log 1) - + (Real.negMulLog (v + q) - Real.negMulLog (1 / 2))) ≤ + abs (u - 1 / 2) + + abs ((v + q) * Real.log (u + (v + q)) - (1 / 2) * Real.log 1) + + abs (Real.negMulLog (v + q) - Real.negMulLog (1 / 2)) := by + calc + abs (((u - 1 / 2) - + ((v + q) * Real.log (u + (v + q)) - + (1 / 2) * Real.log 1)) - + (Real.negMulLog (v + q) - Real.negMulLog (1 / 2))) ≤ + abs ((u - 1 / 2) - + ((v + q) * Real.log (u + (v + q)) - + (1 / 2) * Real.log 1)) + + abs (Real.negMulLog (v + q) - Real.negMulLog (1 / 2)) := + abs_sub _ _ + _ ≤ (abs (u - 1 / 2) + + abs ((v + q) * Real.log (u + (v + q)) - + (1 / 2) * Real.log 1)) + + abs (Real.negMulLog (v + q) - Real.negMulLog (1 / 2)) := + add_le_add (abs_sub _ _) le_rfl + _ ≤ r + 16 * r + 12 * r := add_le_add (add_le_add hu hprod') hnml' + _ = 29 * r := by ring + +/-- An explicit modulus for the complete three-variable good-row expression. +The fixedValue `70` is deliberately loose; having a transparent computable +bound is more important than optimizing this one-time structural constant. -/ +theorem abs_continuousGoodRowPsi_sub_center_le + {u v q r : ℝ} (hr0 : 0 ≤ r) (hr1 : r ≤ 1 / 10) + (hu : abs (u - 1 / 2) ≤ r) + (hv : abs (v - 1 / 2) ≤ r) (hq : abs q ≤ r) : + abs (continuousGoodRowPsi u v q - + continuousGoodRowPsi (1 / 2) (1 / 2) 0) ≤ + 70 * Real.sqrt r := by + have hu' := abs_le.mp hu + have hv' := abs_le.mp hv + have hq' := abs_le.mp hq + have hden0 : 9 / 10 ≤ 1 - q := by linarith + have hden1 : 1 - q ≤ 11 / 10 := by linarith + have hdenpos : 0 < 1 - q := (by norm_num : (0 : ℝ) < 9 / 10).trans_le hden0 + let p : ℝ := u / (1 - q) + have hpdev : abs (p - 1 / 2) ≤ 2 * r := by + have hnum : abs ((u - 1 / 2) + q / 2) ≤ 3 * r / 2 := by + calc + abs ((u - 1 / 2) + q / 2) ≤ + abs (u - 1 / 2) + abs (q / 2) := abs_add_le _ _ + _ = abs (u - 1 / 2) + abs q / 2 := by + rw [abs_div, show abs (2 : ℝ) = 2 by norm_num] + _ ≤ r + r / 2 := by gcongr + _ = 3 * r / 2 := by ring + have hid : p - 1 / 2 = ((u - 1 / 2) + q / 2) / (1 - q) := by + dsimp only [p] + field_simp + ring + rw [hid, abs_div, abs_of_pos hdenpos] + rw [div_le_iff₀ hdenpos] + calc + abs ((u - 1 / 2) + q / 2) ≤ 3 * r / 2 := hnum + _ ≤ 2 * r * (1 - q) := by + have : (9 / 10 : ℝ) ≤ 1 - q := hden0 + nlinarith + have hp0 : (3 / 10 : ℝ) ≤ p := by + have := (abs_le.mp hpdev).1 + linarith + have hp1 : p ≤ 7 / 10 := by + have := (abs_le.mp hpdev).2 + linarith + have hH := abs_binaryEntropy_sub_half_le hp0 hp1 + have hH' : abs (Real.binEntropy p - Real.log 2) ≤ 24 * r := by + rw [← binaryEntropy_eq_realBinEntropy] + exact hH.trans (by + calc + 12 * abs (p - 1 / 2) ≤ 12 * (2 * r) := + mul_le_mul_of_nonneg_left hpdev (by norm_num) + _ = 24 * r := by ring) + have hlog2pos : 0 < Real.log 2 := Real.log_pos (by norm_num) + have hlog2one : abs (Real.log 2) ≤ 1 := by + rw [abs_of_pos hlog2pos] + exact Real.log_two_lt_d9.le.trans (by norm_num) + have hdenabs : abs (1 - q) ≤ 11 / 10 := by + rw [abs_of_pos hdenpos] + exact hden1 + have hmain : + abs ((1 - q) * Real.binEntropy p - Real.log 2) ≤ 28 * r := by + have hid : (1 - q) * Real.binEntropy p - Real.log 2 = + (1 - q) * (Real.binEntropy p - Real.log 2) - q * Real.log 2 := by ring + rw [hid] + calc + abs ((1 - q) * (Real.binEntropy p - Real.log 2) - q * Real.log 2) ≤ + abs ((1 - q) * (Real.binEntropy p - Real.log 2)) + + abs (q * Real.log 2) := abs_sub _ _ + _ = abs (1 - q) * abs (Real.binEntropy p - Real.log 2) + + abs q * abs (Real.log 2) := by rw [abs_mul, abs_mul] + _ ≤ (11 / 10 : ℝ) * (24 * r) + r * 1 := by gcongr + _ ≤ 28 * r := by nlinarith + have hU0 := abs_continuousSuffixError_near_zero hr0 hr1 hu hq + have hV0 := abs_continuousSuffixError_near_zero hr0 hr1 hv hq + have hUV := abs_continuousSuffixError_near_half hr0 hr1 hu hv hq + have hVU := abs_continuousSuffixError_near_half hr0 hr1 hv hu hq + let dU0 := continuousSuffixError u q - continuousSuffixError (1 / 2) 0 + let dUV := continuousSuffixError u (v + q) - + continuousSuffixError (1 / 2) (1 / 2) + let dV0 := continuousSuffixError v q - continuousSuffixError (1 / 2) 0 + let dVU := continuousSuffixError v (u + q) - + continuousSuffixError (1 / 2) (1 / 2) + have hsum : abs (dU0 + dUV + dV0 + dVU) ≤ + (11 * r + 2 * Real.sqrt r) + 29 * r + + (11 * r + 2 * Real.sqrt r) + 29 * r := by + calc + abs (dU0 + dUV + dV0 + dVU) ≤ + abs (dU0 + dUV + dV0) + abs dVU := abs_add_le _ _ + _ ≤ (abs (dU0 + dUV) + abs dV0) + abs dVU := + add_le_add (abs_add_le _ _) le_rfl + _ ≤ (abs dU0 + abs dUV + abs dV0) + abs dVU := + add_le_add (add_le_add (abs_add_le _ _) le_rfl) le_rfl + _ = abs dU0 + abs dUV + abs dV0 + abs dVU := by ring + _ ≤ (11 * r + 2 * Real.sqrt r) + 29 * r + + (11 * r + 2 * Real.sqrt r) + 29 * r := by + dsimp only [dU0, dUV, dV0, dVU] + gcongr + have hbin : Real.binEntropy (1 / 2 : ℝ) = Real.log 2 := by + rw [show (1 / 2 : ℝ) = 2⁻¹ by norm_num, Real.binEntropy_two_inv] + have hid : + continuousGoodRowPsi u v q - + continuousGoodRowPsi (1 / 2) (1 / 2) 0 = + ((1 - q) * Real.binEntropy p - Real.log 2) + + (1 / 2) * (dU0 + dUV + dV0 + dVU) := by + dsimp only [p, dU0, dUV, dV0, dVU] + simp only [continuousGoodRowPsi, sub_zero, div_one, add_zero, one_mul] + rw [hbin] + ring + rw [hid] + have hsqrt0 : 0 ≤ Real.sqrt r := Real.sqrt_nonneg _ + have hrleone : r ≤ 1 := hr1.trans (by norm_num) + have hrle : r ≤ Real.sqrt r := by + rw [Real.le_sqrt hr0 hr0] + nlinarith + calc + abs (((1 - q) * Real.binEntropy p - Real.log 2) + + (1 / 2) * (dU0 + dUV + dV0 + dVU)) ≤ + abs ((1 - q) * Real.binEntropy p - Real.log 2) + + abs ((1 / 2) * (dU0 + dUV + dV0 + dVU)) := abs_add_le _ _ + _ = abs ((1 - q) * Real.binEntropy p - Real.log 2) + + (1 / 2) * abs (dU0 + dUV + dV0 + dVU) := by + rw [abs_mul, abs_of_nonneg (by norm_num : (0 : ℝ) ≤ 1 / 2)] + _ ≤ 28 * r + (1 / 2) * + ((11 * r + 2 * Real.sqrt r) + 29 * r + + (11 * r + 2 * Real.sqrt r) + 29 * r) := by gcongr + _ = 68 * r + 2 * Real.sqrt r := by ring + _ ≤ 70 * Real.sqrt r := by nlinarith + +/-- The compact supremum used by the structural proof is bounded by the +explicit modulus above. -/ +theorem goodRowOmega_le_seventy_sqrt_radius (η : ℝ) : + goodRowOmega η ≤ 70 * Real.sqrt (goodRowRadius η) := by + unfold goodRowOmega + apply csSup_le ((goodRowBall_nonempty η).image goodRowDeviation) + intro y hy + obtain ⟨z, hz, rfl⟩ := hy + have hz' := hz + rw [Metric.mem_closedBall, Prod.dist_eq, max_le_iff, + Prod.dist_eq, max_le_iff, Real.dist_eq, Real.dist_eq, + Real.dist_eq] at hz' + rcases hz' with ⟨hu, hv, hq⟩ + simp only [goodRowCenter, Prod.fst, Prod.snd, sub_zero] at hu hv hq + have hbound := abs_continuousGoodRowPsi_sub_center_le + (goodRowRadius_nonneg η) (goodRowRadius_le_tenth η) hu hv hq + have hc : continuousGoodRowPsi (1 / 2) (1 / 2) 0 = Real.log 2 / 2 := by + simpa [goodRowCenter] using continuousGoodRowPsi_center + rw [goodRowDeviation, ← hc, abs_sub_comm] + exact hbound + +theorem goodRowOmega_le_seventy_sqrt + {η : ℝ} (hη0 : 0 ≤ η) (hη1 : η ≤ 1 / 10) : + goodRowOmega η ≤ 70 * Real.sqrt η := by + simpa [goodRowRadius_eq hη0 hη1] using + goodRowOmega_le_seventy_sqrt_radius η + +/-- An exact algebraic form of the clean core on its natural domain. -/ +theorem cleanCoreFunction_eq_expanded + {κ ρ : ℝ} (hρ : ρ < 1) : + cleanCoreFunction κ ρ = + Real.log 2 - ρ * Real.log 2 - 2 * κ + ρ * κ - + (1 - ρ) * Real.log (1 - ρ) - Real.negMulLog ρ - ρ := by + have hden : 0 < 1 - ρ := sub_pos.mpr hρ + have hexp : Real.exp (-κ) ≠ 0 := (Real.exp_pos _).ne' + rw [cleanCoreFunction, Real.log_div (mul_ne_zero (by norm_num) (pow_ne_zero 2 hexp)) + hden.ne', Real.log_mul (by norm_num : (2 : ℝ) ≠ 0) (pow_ne_zero 2 hexp), + Real.log_pow, Real.log_exp] + ring + +/-- A simple lower bound for the clean core. -/ +theorem cleanCoreFunction_lower + {κ ρ : ℝ} (hκ : 0 ≤ κ) (hρ0 : 0 ≤ ρ) (hρ1 : ρ < 1) : + Real.log 2 - ρ * Real.log 2 - 2 * κ - Real.negMulLog ρ - ρ ≤ + cleanCoreFunction κ ρ := by + rw [cleanCoreFunction_eq_expanded hρ1] + have hκρ : 0 ≤ ρ * κ := mul_nonneg hρ0 hκ + have hlog : Real.log (1 - ρ) ≤ 0 := + Real.log_nonpos (sub_nonneg.mpr hρ1.le) (by linarith) + have hden : 0 ≤ 1 - ρ := sub_nonneg.mpr hρ1.le + have hterm : 0 ≤ -(1 - ρ) * Real.log (1 - ρ) := + mul_nonneg_of_nonpos_of_nonpos (neg_nonpos.mpr hden) hlog + linarith + +/-- The fixed local-cost threshold used by the executable proof. -/ +def explicitKappa : ℚ := 1 / 1000 + +theorem explicitKappa_pos : 0 < explicitKappa := by + norm_num [explicitKappa] + +theorem leakageEnvelope_explicitKappa_le : + leakageEnvelope (explicitKappa : ℝ) ≤ 1 / 250 := by + have hkabs : abs ((explicitKappa : ℚ) : ℝ) ≤ 1 := by + norm_num [explicitKappa] + have hexp := Real.abs_exp_sub_one_le hkabs + have hnonneg : 0 ≤ Real.exp ((explicitKappa : ℚ) : ℝ) - 1 := by + rw [sub_nonneg, ← Real.exp_zero] + exact Real.exp_le_exp.mpr (by norm_num [explicitKappa]) + rw [abs_of_nonneg hnonneg] at hexp + rw [leakageEnvelope] + norm_num [explicitKappa] at hexp ⊢ + linarith + +theorem explicitKappa_cleanCore + {ρ : ℝ} (hρ0 : 0 ≤ ρ) + (hρbar : ρ ≤ leakageEnvelope (explicitKappa : ℝ)) : + Real.log 2 / 2 < cleanCoreFunction (explicitKappa : ℝ) ρ := by + have hρ250 : ρ ≤ 1 / 250 := + hρbar.trans leakageEnvelope_explicitKappa_le + have hρ1 : ρ < 1 := hρ250.trans_lt (by norm_num) + have hρabs : abs ρ ≤ 1 := by + rw [abs_of_nonneg hρ0] + exact hρ250.trans (by norm_num) + have hnmlabs := abs_negMulLog_lt_two_sqrt_abs hρabs + have hnml : Real.negMulLog ρ ≤ 2 / 15 := by + calc + Real.negMulLog ρ ≤ abs (Real.negMulLog ρ) := le_abs_self _ + _ ≤ 2 * Real.sqrt ρ := by simpa [abs_of_nonneg hρ0] using hnmlabs + _ ≤ 2 * (1 / 15 : ℝ) := by + gcongr + rw [Real.sqrt_le_iff] + constructor + · norm_num + · nlinarith + _ = 2 / 15 := by ring + have hcore := cleanCoreFunction_lower + (κ := ((explicitKappa : ℚ) : ℝ)) (ρ := ρ) + (by norm_num [explicitKappa]) hρ0 hρ1 + have hloglo := Real.log_two_gt_d9 + have hloghi := Real.log_two_lt_d9 + have hcore' : + Real.log 2 - ρ * Real.log 2 - 1 / 500 - Real.negMulLog ρ - ρ ≤ + cleanCoreFunction (explicitKappa : ℝ) ρ := by + convert hcore using 1 <;> norm_num [explicitKappa] + have hρlog : ρ * Real.log 2 ≤ (1 / 250 : ℝ) * 0.6931471808 := by + calc + ρ * Real.log 2 ≤ (1 / 250 : ℝ) * Real.log 2 := + mul_le_mul_of_nonneg_right hρ250 (Real.log_pos (by norm_num)).le + _ ≤ (1 / 250 : ℝ) * 0.6931471808 := + mul_le_mul_of_nonneg_left hloghi.le (by norm_num) + have hhalf : Real.log 2 / 2 < 1 / 2 := by + linarith + have hlower : (1 / 2 : ℝ) < + Real.log 2 - ρ * Real.log 2 - 1 / 500 - Real.negMulLog ρ - ρ := by + nlinarith + exact hhalf.trans (hlower.trans_le hcore') + +/-- The clean-pair constants are fixed data, rather than values selected from +an unspecified continuity neighborhood. -/ +def explicitXiSource : ℚ := 1 / 100 + +def explicitGamma : ℚ := 1 / 4 + +theorem explicit_cleanPairGain_constants : + CleanPairGainGuarantee (explicitKappa : ℝ) + (explicitXiSource : ℝ) (explicitGamma : ℝ) := by + intro n ell ξ τ A X rscale cscale hell hlogn hξ hξ₀ hτ + hApos hX hXint hrscale hcscale hKKT r s a b hrs hab hcost + have hellpos : 0 < ell := lt_of_lt_of_le (by norm_num) hell + have hτpos : 0 < τ := by rw [hτ]; positivity + let ρ := outsideMassTwo (pairAlpha X r s) a b + have hρnonneg : 0 ≤ ρ := by + dsimp only [ρ, outsideMassTwo] + exact Finset.sum_nonneg fun j _ ↦ pairAlpha_nonneg hX r s j + have hκposR : 0 < ((explicitKappa : ℚ) : ℝ) := by + exact_mod_cast explicitKappa_pos + by_cases hρzero : ρ = 0 + · have hbarNonneg : 0 ≤ leakageEnvelope ((explicitKappa : ℚ) : ℝ) := by + rw [leakageEnvelope] + have hexp : 1 ≤ Real.exp ((explicitKappa : ℚ) : ℝ) := by + rw [← Real.exp_zero] + exact Real.exp_le_exp.mpr hκposR.le + linarith + have hcoreZero := explicitKappa_cleanCore (ρ := 0) le_rfl hbarNonneg + have hcoreLog : Real.log 2 / 2 < + Real.log (2 * (Real.exp (-((explicitKappa : ℚ) : ℝ))) ^ 2) := by + simpa [cleanCoreFunction] using hcoreZero + have hgain := log_pairGain_ge_core_of_zeroLeakage + hτpos.le hApos hX hXint hrscale hcscale hKKT hrs hab hcost + (by simpa only [ρ] using hρzero) + have hgamma : ((explicitGamma : ℚ) : ℝ) < Real.log 2 / 2 := by + have := Real.log_two_gt_d9 + norm_num [explicitGamma] at * + linarith + exact le_of_lt (hgamma.trans (hcoreLog.trans_le hgain)) + · have hρpos : 0 < ρ := lt_of_le_of_ne hρnonneg (Ne.symm hρzero) + have hρbar : ρ ≤ leakageEnvelope ((explicitKappa : ℚ) : ℝ) := by + dsimp only [ρ, leakageEnvelope] + exact pairOutsideMass_le_exp hτpos.le hκposR.le hXint hab hcost + have hρsmall : ρ < 1 / 10 := + (hρbar.trans leakageEnvelope_explicitKappa_le).trans_lt (by norm_num) + have hρone : ρ < 1 := hρsmall.trans (by norm_num) + have hcoreRho := explicitKappa_cleanCore hρnonneg hρbar + have hentropy := outsideEntropyBracket_lt_four_scale hX hρpos + hρsmall hell hlogn + have hclean := cleanGainLowerBound_gt_of_core_and_entropy + hξ hellpos hτ hcoreRho hentropy + have hgain := log_pairGain_ge_cleanGainLowerBound_of_positiveLeakage + hτpos.le hApos hX hXint hrscale hcscale hKKT hrs hab hcost + hρpos hρone + have hgamma : ((explicitGamma : ℚ) : ℝ) < + Real.log 2 / 2 - ξ := by + have hlog := Real.log_two_gt_d9 + have hξbound : ξ ≤ 1 / 100 := by + simpa [explicitXiSource] using hξ₀ + norm_num [explicitGamma] at * + linarith + exact le_of_lt (hgamma.trans (hclean.trans_le hgain)) + +/-- The same hard-coded constants lower-bound the explicit finite witness +itself. Thus the clean-pair analysis needs no per-pair capacity optimizer. -/ +theorem explicit_cleanPairWitnessGain_constants : + ExplicitPairWitnessGainGuarantee (explicitKappa : ℝ) + (explicitXiSource : ℝ) (explicitGamma : ℝ) := by + intro n ell ξ τ X hell hlogn hξ hξ₀ hτ hX hXint + r s a b hrs hab hcost + have hellpos : 0 < ell := lt_of_lt_of_le (by norm_num) hell + have hτpos : 0 < τ := by rw [hτ]; positivity + let ρ := outsideMassTwo (pairAlpha X r s) a b + have hρnonneg : 0 ≤ ρ := by + dsimp only [ρ, outsideMassTwo] + exact Finset.sum_nonneg fun j _ ↦ pairAlpha_nonneg hX r s j + have hκposR : 0 < ((explicitKappa : ℚ) : ℝ) := by + exact_mod_cast explicitKappa_pos + by_cases hρzero : ρ = 0 + · have hbarNonneg : 0 ≤ leakageEnvelope ((explicitKappa : ℚ) : ℝ) := by + rw [leakageEnvelope] + have hexp : 1 ≤ Real.exp ((explicitKappa : ℚ) : ℝ) := by + rw [← Real.exp_zero] + exact Real.exp_le_exp.mpr hκposR.le + linarith + have hcoreZero := explicitKappa_cleanCore (ρ := 0) le_rfl hbarNonneg + have hcoreLog : Real.log 2 / 2 < + Real.log (2 * (Real.exp (-((explicitKappa : ℚ) : ℝ))) ^ 2) := by + simpa [cleanCoreFunction] using hcoreZero + have hgain := coreLowerBound_le_explicitPairWitnessLogGain_of_zeroLeakage + hτpos.le hX hXint hrs hab hcost (by simpa only [ρ] using hρzero) + have hgamma : ((explicitGamma : ℚ) : ℝ) < Real.log 2 / 2 := by + have := Real.log_two_gt_d9 + norm_num [explicitGamma] at * + linarith + exact le_of_lt (hgamma.trans (hcoreLog.trans_le hgain)) + · have hρpos : 0 < ρ := lt_of_le_of_ne hρnonneg (Ne.symm hρzero) + have hρbar : ρ ≤ leakageEnvelope ((explicitKappa : ℚ) : ℝ) := by + dsimp only [ρ, leakageEnvelope] + exact pairOutsideMass_le_exp hτpos.le hκposR.le hXint hab hcost + have hρsmall : ρ < 1 / 10 := + (hρbar.trans leakageEnvelope_explicitKappa_le).trans_lt (by norm_num) + have hρone : ρ < 1 := hρsmall.trans (by norm_num) + have hcoreRho := explicitKappa_cleanCore hρnonneg hρbar + have hentropy := outsideEntropyBracket_lt_four_scale hX hρpos + hρsmall hell hlogn + have hclean := cleanGainLowerBound_gt_of_core_and_entropy + hξ hellpos hτ hcoreRho hentropy + have hgain := cleanGainLowerBound_le_explicitPairWitnessLogGain + hτpos.le hX hXint hrs hab hcost hρpos hρone + have hgamma : ((explicitGamma : ℚ) : ℝ) < + Real.log 2 / 2 - ξ := by + have hlog := Real.log_two_gt_d9 + have hξbound : ξ ≤ 1 / 100 := by + simpa [explicitXiSource] using hξ₀ + norm_num [explicitGamma] at * + linarith + exact le_of_lt (hgamma.trans (hclean.trans_le hgain)) + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/ExplicitOptimizerScales.lean b/LeanPool/BeyondBethe/BeyondBethe/ExplicitOptimizerScales.lean new file mode 100644 index 0000000000..12d6baf21f --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/ExplicitOptimizerScales.lean @@ -0,0 +1,435 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.BetheBisection +import LeanPool.BeyondBethe.BeyondBethe.DirectedCertificateValue +import Mathlib.Tactic + +/-! # Explicit Optimizer Scales -/ + +namespace BeyondBethe + +/-! +# Explicit dyadic scales for the numerical optimizer + +All parameters are rational functions of the normalized positive input and +the fixed structural error budget. Their deliberately generous slack keeps +the later objective-to-KKT calculation transparent. +-/ + +def explicitOptimizerFloor {m : ℕ} + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) : ℚ := + numericalInteriorFloor (m + 1) (rationalMatrixEntryBitBound A) + (explicitRegularizationScale (m + 1)) / 2 + +def explicitOptimizerRho {m : ℕ} + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) : ℚ := + explicitOptimizerFloor A * explicitKKTError / 48 + +def explicitOptimizerGap {m : ℕ} + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) : ℚ := + explicitRegularizationScale (m + 1) * explicitOptimizerRho A ^ 2 / 4 + +def explicitOptimizerMix {m : ℕ} + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) : ℚ := + min (1 / 2) + (explicitOptimizerGap A / + (4 * (rationalRegularizedObjectiveRange A + 1))) + +def explicitOptimizerInnerRadius {m : ℕ} + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) : ℚ := + explicitOptimizerMix A / (2 * (m + 1)) + +def explicitOptimizerPrecision {m : ℕ} + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) : ℕ := + encodedBitLength ℚ (explicitOptimizerGap A) + + encodedBitLength ℚ explicitKKTError + 2 * (m + 1) + 10 + +def explicitOptimizerInitialWidth {m : ℕ} + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) : ℚ := + betheBisectionInitialHigh A (explicitOptimizerMix A) + (explicitOptimizerInnerRadius A) - + betheNegativeObjectiveLower m + +def explicitOptimizerBisectionSteps {m : ℕ} + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) : ℕ := + encodedBitLength ℚ (explicitOptimizerInitialWidth A) + + encodedBitLength ℚ (explicitOptimizerGap A) + 3 + +theorem explicitOptimizerFloor_pos {m : ℕ} + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) : + 0 < explicitOptimizerFloor A := by + rw [explicitOptimizerFloor] + exact div_pos (numericalInteriorFloor_pos _ _ _) (by norm_num) + +theorem explicitOptimizerRho_pos {m : ℕ} + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) : + 0 < explicitOptimizerRho A := by + rw [explicitOptimizerRho] + exact div_pos + (mul_pos (explicitOptimizerFloor_pos A) explicitKKTError_pos) + (by norm_num) + +theorem explicitOptimizerGap_pos {m : ℕ} + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) : + 0 < explicitOptimizerGap A := by + rw [explicitOptimizerGap] + exact div_pos + (mul_pos (explicitRegularizationScale_pos (by omega)) + (sq_pos_of_pos (explicitOptimizerRho_pos A))) (by norm_num) + +theorem explicitOptimizerMix_pos {m : ℕ} + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) : + 0 < explicitOptimizerMix A := by + rw [explicitOptimizerMix, lt_min_iff] + exact ⟨by norm_num, div_pos (explicitOptimizerGap_pos A) (by + have h := rationalRegularizedObjectiveRange_nonneg A + positivity)⟩ + +theorem explicitOptimizerMix_le_half {m : ℕ} + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) : + explicitOptimizerMix A ≤ 1 / 2 := by + rw [explicitOptimizerMix] + exact min_le_left _ _ + +theorem explicitOptimizerMix_le_one {m : ℕ} + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) : + explicitOptimizerMix A ≤ 1 := + (explicitOptimizerMix_le_half A).trans (by norm_num) + +theorem explicitOptimizerInnerRadius_pos {m : ℕ} + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) : + 0 < explicitOptimizerInnerRadius A := by + rw [explicitOptimizerInnerRadius] + exact div_pos (explicitOptimizerMix_pos A) (by positivity) + +theorem explicitOptimizerFloor_le_smoothedFloor {m : ℕ} + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) : + explicitOptimizerFloor A ≤ + (1 - explicitOptimizerMix A) * + numericalInteriorFloor (m + 1) (rationalMatrixEntryBitBound A) + (explicitRegularizationScale (m + 1)) := by + let δ0 := numericalInteriorFloor (m + 1) + (rationalMatrixEntryBitBound A) (explicitRegularizationScale (m + 1)) + have hδ0 : 0 ≤ δ0 := + (numericalInteriorFloor_pos _ _ _).le + have hmix := explicitOptimizerMix_le_half A + rw [explicitOptimizerFloor] + nlinarith + +theorem explicitOptimizerInnerRadius_div_mix {m : ℕ} + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) : + explicitOptimizerInnerRadius A / explicitOptimizerMix A = + 1 / (2 * (m + 1) : ℚ) := by + rw [explicitOptimizerInnerRadius] + field_simp [(explicitOptimizerMix_pos A).ne'] + +theorem explicitOptimizerInnerRadius_spike {m : ℕ} + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) : + explicitOptimizerInnerRadius A / explicitOptimizerMix A ≤ + 1 / (m + 1 : ℚ) := by + rw [explicitOptimizerInnerRadius_div_mix] + have hn : (0 : ℚ) < m + 1 := by positivity + exact one_div_le_one_div_of_le hn (by nlinarith) + +theorem explicitOptimizerRho_ratio {m : ℕ} + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) : + 12 * explicitOptimizerRho A / explicitOptimizerFloor A = + explicitKKTError / 4 := by + rw [explicitOptimizerRho] + field_simp [(explicitOptimizerFloor_pos A).ne'] + ring + +theorem explicitOptimizerGap_scale {m : ℕ} + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) : + 4 * explicitOptimizerGap A = + explicitRegularizationScale (m + 1) * explicitOptimizerRho A ^ 2 := by + rw [explicitOptimizerGap] + ring + +/-- The barycentric smoothing and inner-radius terms consume at most one +quarter of the objective-gap budget. -/ +theorem explicitOptimizerSmoothingSlack_le {m : ℕ} + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) : + betheSmoothingSlack A (explicitOptimizerMix A) + (explicitOptimizerInnerRadius A) ≤ + explicitOptimizerGap A / 4 := by + let range := rationalRegularizedObjectiveRange A + let mix := explicitOptimizerMix A + have hrange : 0 ≤ range := rationalRegularizedObjectiveRange_nonneg A + have hmix0 : 0 ≤ mix := (explicitOptimizerMix_pos A).le + have hmixBound : mix ≤ explicitOptimizerGap A / + (4 * (range + 1)) := by + dsimp only [mix, range] + rw [explicitOptimizerMix] + exact min_le_right _ _ + have hn : (1 : ℚ) ≤ m + 1 := by exact_mod_cast (show 1 ≤ m + 1 by omega) + have hradius : 2 * explicitOptimizerInnerRadius A ≤ mix := by + rw [explicitOptimizerInnerRadius] + have hden : (0 : ℚ) < 2 * (m + 1) := by positivity + rw [div_eq_mul_inv] + have hinv : (2 * (m + 1) : ℚ)⁻¹ ≤ 1 / 2 := by + rw [inv_le_comm₀ (by positivity) (by norm_num)] + nlinarith + nlinarith + have hcombine : mix * range + 2 * explicitOptimizerInnerRadius A ≤ + mix * (range + 1) := by + nlinarith + have hdenpos : 0 < 4 * (range + 1) := by positivity + have hscaled := mul_le_mul_of_nonneg_right hmixBound (by + positivity : (0 : ℚ) ≤ range + 1) + have hcancel : explicitOptimizerGap A / (4 * (range + 1)) * + (range + 1) = explicitOptimizerGap A / 4 := by + field_simp [show range + 1 ≠ 0 by positivity] + rw [hcancel] at hscaled + rw [betheSmoothingSlack] + simpa only [mix, range] using hcombine.trans hscaled + +theorem explicitOptimizerInitialWidth_pos {m : ℕ} + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) : + 0 < explicitOptimizerInitialWidth A := by + rw [explicitOptimizerInitialWidth, betheBisectionInitialHigh, + betheNegativeObjectiveUpper, betheNegativeObjectiveLower] + have hslack : 0 < betheSmoothingSlack A (explicitOptimizerMix A) + (explicitOptimizerInnerRadius A) := by + rw [betheSmoothingSlack] + exact add_pos_of_nonneg_of_pos + (mul_nonneg (explicitOptimizerMix_pos A).le + (rationalRegularizedObjectiveRange_nonneg A)) + (mul_pos (by norm_num) (explicitOptimizerInnerRadius_pos A)) + have hB : (0 : ℚ) ≤ rationalMatrixEntryBitBound A := by positivity + have hn : (0 : ℚ) < m + 1 := by positivity + push_cast + nlinarith + +/-- The precision exponent contains enough dyadic shift to absorb the +dimension factor in objective evaluation. -/ +theorem explicitOptimizerPrecision_scaled_lt_gap {m : ℕ} + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) : + (2 : ℚ) ^ (2 * (m + 1) + 10) * + (1 / 2 : ℚ) ^ explicitOptimizerPrecision A < + explicitOptimizerGap A := by + let Lg := encodedBitLength ℚ (explicitOptimizerGap A) + let Le := encodedBitLength ℚ explicitKKTError + let K := 2 * (m + 1) + 10 + have hgap := dyadic_encodedBitLength_lt_positive_rational + (explicitOptimizerGap_pos A) + have he : (1 / 2 : ℚ) ^ Le ≤ 1 := by + exact pow_le_one₀ (by norm_num) (by norm_num) + have hcancel : (2 : ℚ) ^ K * (1 / 2 : ℚ) ^ K = 1 := by + rw [← mul_pow] + norm_num + have hsplit : (1 / 2 : ℚ) ^ (Lg + Le + K) = + (1 / 2 : ℚ) ^ Lg * (1 / 2 : ℚ) ^ Le * + (1 / 2 : ℚ) ^ K := by + rw [pow_add, pow_add] + calc + (2 : ℚ) ^ (2 * (m + 1) + 10) * + (1 / 2 : ℚ) ^ explicitOptimizerPrecision A = + (1 / 2 : ℚ) ^ Lg * (1 / 2 : ℚ) ^ Le := by + rw [show 2 * (m + 1) + 10 = K by rfl] + rw [show explicitOptimizerPrecision A = Lg + Le + K by + simp only [explicitOptimizerPrecision, Lg, Le, K]; omega] + rw [hsplit] + rw [show + (2 : ℚ) ^ K * + ((1 / 2 : ℚ) ^ Lg * (1 / 2 : ℚ) ^ Le * + (1 / 2 : ℚ) ^ K) = + ((1 / 2 : ℚ) ^ Lg * (1 / 2 : ℚ) ^ Le) * + ((2 : ℚ) ^ K * (1 / 2 : ℚ) ^ K) by ring, + hcancel, mul_one] + _ ≤ (1 / 2 : ℚ) ^ Lg := + mul_le_of_le_one_right (by positivity) he + _ < explicitOptimizerGap A := by simpa only [Lg] using hgap + +/-- Independently, the same precision exponent absorbs the fixed KKT error +scale. -/ +theorem explicitOptimizerPrecision_scaled_lt_kktError {m : ℕ} + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) : + (2 : ℚ) ^ 10 * + (1 / 2 : ℚ) ^ explicitOptimizerPrecision A < + explicitKKTError := by + let Lg := encodedBitLength ℚ (explicitOptimizerGap A) + let Le := encodedBitLength ℚ explicitKKTError + let K := 2 * (m + 1) + have herr := dyadic_encodedBitLength_lt_positive_rational + explicitKKTError_pos + have hg : (1 / 2 : ℚ) ^ Lg ≤ 1 := + pow_le_one₀ (by norm_num) (by norm_num) + have hk : (1 / 2 : ℚ) ^ K ≤ 1 := + pow_le_one₀ (by norm_num) (by norm_num) + have hcancel : (2 : ℚ) ^ 10 * (1 / 2 : ℚ) ^ 10 = 1 := by + rw [← mul_pow] + norm_num + have hsplit : (1 / 2 : ℚ) ^ (Lg + Le + K + 10) = + ((1 / 2 : ℚ) ^ Lg * (1 / 2 : ℚ) ^ Le * + (1 / 2 : ℚ) ^ K) * (1 / 2 : ℚ) ^ 10 := by + rw [pow_add, pow_add, pow_add] + calc + (2 : ℚ) ^ 10 * + (1 / 2 : ℚ) ^ explicitOptimizerPrecision A = + (1 / 2 : ℚ) ^ Lg * (1 / 2 : ℚ) ^ Le * + (1 / 2 : ℚ) ^ K := by + rw [show explicitOptimizerPrecision A = Lg + Le + K + 10 by + simp only [explicitOptimizerPrecision, Lg, Le, K]] + rw [hsplit] + rw [show (2 : ℚ) ^ 10 * + (((1 / 2 : ℚ) ^ Lg * (1 / 2 : ℚ) ^ Le * + (1 / 2 : ℚ) ^ K) * (1 / 2 : ℚ) ^ 10) = + ((1 / 2 : ℚ) ^ Lg * (1 / 2 : ℚ) ^ Le * + (1 / 2 : ℚ) ^ K) * + ((2 : ℚ) ^ 10 * (1 / 2 : ℚ) ^ 10) by ring, + hcancel, mul_one] + _ ≤ (1 / 2 : ℚ) ^ Le := by + have hnonneg : 0 ≤ (1 / 2 : ℚ) ^ Le := by positivity + calc + (1 / 2 : ℚ) ^ Lg * (1 / 2 : ℚ) ^ Le * + (1 / 2 : ℚ) ^ K ≤ + 1 * (1 / 2 : ℚ) ^ Le * 1 := by gcongr + _ = (1 / 2 : ℚ) ^ Le := by ring + _ < explicitKKTError := by simpa only [Le] using herr + +theorem explicitOptimizerGradientEvaluationError_le {m : ℕ} + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) : + 4 * (1 / 2 : ℚ) ^ explicitOptimizerPrecision A ≤ + explicitKKTError / 256 := by + have hscaled := explicitOptimizerPrecision_scaled_lt_kktError A + norm_num at hscaled + linarith + +/-- The full one-sided objective-evaluation loss uses at most one quarter of +the objective-gap budget. -/ +theorem explicitOptimizerObjectiveEvaluationError_lt {m : ℕ} + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) : + betheObjectiveEvaluationError m (explicitOptimizerPrecision A) < + explicitOptimizerGap A / 4 := by + let n := m + 1 + let coeff : ℕ := 16 * m ^ 2 + 3 * n ^ 2 + have hmn : m ≤ n := by omega + have hnpow : n ≤ 2 ^ n := n.lt_two_pow_self.le + have hn2 : n ^ 2 ≤ 2 ^ (2 * n) := by + calc + n ^ 2 ≤ (2 ^ n) ^ 2 := Nat.pow_le_pow_left hnpow 2 + _ = 2 ^ (2 * n) := by + rw [← pow_mul] + congr 1 + omega + have hcoeff : 4 * coeff ≤ 2 ^ (2 * n + 10) := by + calc + 4 * coeff ≤ 76 * n ^ 2 := by + dsimp only [coeff, n] + nlinarith + _ ≤ 76 * 2 ^ (2 * n) := Nat.mul_le_mul_left 76 hn2 + _ ≤ 1024 * 2 ^ (2 * n) := Nat.mul_le_mul_right _ (by norm_num) + _ = 2 ^ (2 * n + 10) := by + rw [pow_add] + norm_num + ring + have hcoeffQ : (4 : ℚ) * coeff ≤ + (2 : ℚ) ^ (2 * (m + 1) + 10) := by + exact_mod_cast hcoeff + have hdyadic : 0 ≤ + (1 / 2 : ℚ) ^ explicitOptimizerPrecision A := by positivity + have hscaled := mul_le_mul_of_nonneg_right hcoeffQ hdyadic + have hgap := explicitOptimizerPrecision_scaled_lt_gap A + have hfour : 4 * betheObjectiveEvaluationError m + (explicitOptimizerPrecision A) < explicitOptimizerGap A := by + rw [betheObjectiveEvaluationError] + have hform : + 4 * (16 * (1 / 2 : ℚ) ^ explicitOptimizerPrecision A * + (m * m) + + 3 * (m + 1) ^ 2 * + (1 / 2 : ℚ) ^ explicitOptimizerPrecision A) = + (4 : ℚ) * coeff * + (1 / 2 : ℚ) ^ explicitOptimizerPrecision A := by + dsimp only [coeff, n] + push_cast + ring + rw [hform] + exact hscaled.trans_lt hgap + linarith + +/-- The encoded-length bisection depth leaves less than one eighth of the +objective-gap budget. -/ +theorem explicitOptimizerBisectionWidth_lt {m : ℕ} + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) : + explicitOptimizerInitialWidth A / + 2 ^ explicitOptimizerBisectionSteps A < + explicitOptimizerGap A / 8 := by + let W := explicitOptimizerInitialWidth A + let g := explicitOptimizerGap A + let LW := encodedBitLength ℚ W + let Lg := encodedBitLength ℚ g + have hW := positive_rational_lt_two_pow_encodedBitLength + (explicitOptimizerInitialWidth_pos A) + have hg := dyadic_encodedBitLength_lt_positive_rational + (explicitOptimizerGap_pos A) + have hdyadic : 0 < (1 / 2 : ℚ) ^ (Lg + 3) := by positivity + have hdirect : W / 2 ^ (LW + Lg + 3) < + (1 / 2 : ℚ) ^ Lg / 8 := by + have hcancelLW : (2 : ℚ) ^ LW * (1 / 2 : ℚ) ^ LW = 1 := by + rw [← mul_pow] + norm_num + calc + W / 2 ^ (LW + Lg + 3) = + W * (1 / 2 : ℚ) ^ (LW + Lg + 3) := by + simp [div_eq_mul_inv, one_div, inv_pow] + _ < (2 : ℚ) ^ LW * + (1 / 2 : ℚ) ^ (LW + Lg + 3) := by + exact mul_lt_mul_of_pos_right hW (by positivity) + _ = (1 / 2 : ℚ) ^ Lg / 8 := by + rw [show LW + Lg + 3 = LW + (Lg + 3) by omega, pow_add] + rw [show (2 : ℚ) ^ LW * + ((1 / 2 : ℚ) ^ LW * (1 / 2 : ℚ) ^ (Lg + 3)) = + ((2 : ℚ) ^ LW * (1 / 2 : ℚ) ^ LW) * + (1 / 2 : ℚ) ^ (Lg + 3) by ring, + hcancelLW, one_mul] + rw [pow_add] + norm_num + ring + rw [explicitOptimizerBisectionSteps] + simpa only [W, g, LW, Lg] using hdirect.trans + (div_lt_div_of_pos_right hg (by norm_num)) + +/-- Summing all three objective losses still stays below the chosen strong +concavity budget. -/ +theorem explicitOptimizerTotalObjectiveError_lt {m : ℕ} + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) : + betheSmoothingSlack A (explicitOptimizerMix A) + (explicitOptimizerInnerRadius A) + + explicitOptimizerInitialWidth A / + 2 ^ explicitOptimizerBisectionSteps A + + betheObjectiveEvaluationError m (explicitOptimizerPrecision A) < + explicitOptimizerGap A := by + have hs := explicitOptimizerSmoothingSlack_le A + have hw := explicitOptimizerBisectionWidth_lt A + have he := explicitOptimizerObjectiveEvaluationError_lt A + have hg := explicitOptimizerGap_pos A + linarith + +/-- The gradient-evaluation and objective-proximity losses fit inside the +fixed approximate-KKT allowance. -/ +theorem explicitOptimizerKKTError_le {m : ℕ} + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) : + 4 * (1 / 2 : ℚ) ^ explicitOptimizerPrecision A + + 4 * (4 * (1 / 2 : ℚ) ^ explicitOptimizerPrecision A + + 3 * explicitOptimizerRho A / explicitOptimizerFloor A) ≤ + explicitKKTError := by + have he := explicitOptimizerGradientEvaluationError_le A + have hratio := explicitOptimizerRho_ratio A + have hε := explicitKKTError_pos + calc + 4 * (1 / 2 : ℚ) ^ explicitOptimizerPrecision A + + 4 * (4 * (1 / 2 : ℚ) ^ explicitOptimizerPrecision A + + 3 * explicitOptimizerRho A / explicitOptimizerFloor A) = + 5 * (4 * (1 / 2 : ℚ) ^ explicitOptimizerPrecision A) + + 12 * explicitOptimizerRho A / explicitOptimizerFloor A := by ring + _ ≤ 5 * (explicitKKTError / 256) + explicitKKTError / 4 := by + rw [hratio] + gcongr + _ ≤ explicitKKTError := by nlinarith + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/ExplicitPositiveRoutine.lean b/LeanPool/BeyondBethe/BeyondBethe/ExplicitPositiveRoutine.lean new file mode 100644 index 0000000000..39dc1c4154 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/ExplicitPositiveRoutine.lean @@ -0,0 +1,160 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.FinalAssembly +import LeanPool.BeyondBethe.BeyondBethe.ExplicitBetheOptimizer +import LeanPool.BeyondBethe.BeyondBethe.SourceStableReindex +import Mathlib.Tactic + +/-! # Explicit Positive Routine -/ + +namespace BeyondBethe + +/-! +# The concrete positive-matrix routine + +The routine normalizes its positive rational input, runs the explicit +regularized-Bethe optimizer, evaluates the directed rational certificate, +and restores the degree-`n` normalization factor. +-/ + +def explicitPositiveAlgorithm : + ∀ n, Matrix (Fin n) (Fin n) ℚ → ℚ + | 0, A => Matrix.permanent A + | 1, A => Matrix.permanent A + | m + 2, A => + let B := normalizedRationalMatrix A + let X := explicitBetheOptimizerMatrix (m := m + 1) B + let R := explicitBetheOptimizerRowPotential (m := m + 1) B + let C := explicitBetheOptimizerColumnPotential (m := m + 1) B + rationalNormalizationScale A ^ (m + 2) * + explicitDirectedCertificateValue X R C + +@[simp] theorem explicitPositiveAlgorithm_succ_succ + (m : ℕ) (A : Matrix (Fin (m + 2)) (Fin (m + 2)) ℚ) : + explicitPositiveAlgorithm (m + 2) A = + rationalNormalizationScale A ^ (m + 2) * + explicitDirectedCertificateValue + (explicitBetheOptimizerMatrix (m := m + 1) + (normalizedRationalMatrix A)) + (explicitBetheOptimizerRowPotential (m := m + 1) + (normalizedRationalMatrix A)) + (explicitBetheOptimizerColumnPotential (m := m + 1) + (normalizedRationalMatrix A)) := by + rfl + +theorem positive_rational_of_positive_cast {q : ℚ} (hq : 0 < (q : ℝ)) : + 0 < q := Rat.cast_pos.mp hq + +theorem explicitPositiveAlgorithm_succ_succ_spec + (m : ℕ) (A : Matrix (Fin (m + 2)) (Fin (m + 2)) ℚ) + (hA : Matrix.Positive (fun i j ↦ (A i j : ℝ))) : + 0 < (explicitPositiveAlgorithm (m + 2) A : ℝ) ∧ + (explicitPositiveAlgorithm (m + 2) A : ℝ) ≤ + ((Matrix.permanent A : ℚ) : ℝ) ∧ + ((Matrix.permanent A : ℚ) : ℝ) ≤ + (preSmoothingBase (explicitCertifiedEpsilon : ℝ)) ^ (m + 2) * + (explicitPositiveAlgorithm (m + 2) A : ℝ) := by + let B : Matrix (Fin (m + 2)) (Fin (m + 2)) ℚ := + normalizedRationalMatrix A + let X := explicitBetheOptimizerMatrix (m := m + 1) B + let R := explicitBetheOptimizerRowPotential (m := m + 1) B + let C := explicitBetheOptimizerColumnPotential (m := m + 1) B + let L : ℚ := explicitDirectedCertificateValue X R C + have hAq : ∀ i j, 0 < A i j := by + intro i j + exact positive_rational_of_positive_cast (hA i j) + have hAnonneg : Matrix.Nonnegative A := fun i j ↦ (hAq i j).le + have hBpos : ∀ i j, 0 < B i j := by + intro i j + change 0 < normalizedRationalMatrix A i j + rw [normalizedRationalMatrix] + exact div_pos (hAq i j) (rationalNormalizationScale_pos hAnonneg) + have hBupper : ∀ i j, B i j ≤ 1 := by + intro i j + exact normalizedRationalMatrix_le_one hAnonneg i j + have hpoint := explicitBetheOptimizerPoint_spec (m := m + 1) + (by omega) B hBpos hBupper + have hX : IsDoublyStochastic (fun i j ↦ ((X i j : ℚ) : ℝ)) := by + simpa only [X] using hpoint.2.1 + have hXlo : ∀ i j, (explicitOptimizerFloor B : ℝ) ≤ (X i j : ℝ) := by + simpa only [X] using hpoint.2.2.1 + have hδ : 0 < (explicitOptimizerFloor B : ℝ) := + Rat.cast_pos.mpr (explicitOptimizerFloor_pos B) + have hXpos : ∀ i j, 0 < (X i j : ℝ) := by + intro i j + exact hδ.trans_le (hXlo i j) + have hXint : ∀ i, IsInteriorProbabilityVector + (fun j ↦ ((X i j : ℚ) : ℝ)) := by + intro i + refine ⟨hX.row_probability i, fun j ↦ ⟨hXpos i j, ?_⟩⟩ + exact hX.entry_lt_one_of_positive hXpos (by simp) i j + have happrox := explicitBetheOptimizer_hasApproximateLogKKT + (m := m + 1) (by omega) B hBpos hBupper + have hBR : Matrix.Positive (fun i j ↦ (B i j : ℝ)) := by + intro i j + exact Rat.cast_pos.mpr (hBpos i j) + have hcert := explicitDirectedCertificate_twoSided + anariOveisGharanStableCoefficient (n := m + 2) (by omega) + hBR hX hXint (by simpa only [X, R, C, B] using happrox) + have hLpos : 0 < (L : ℝ) := by + simpa only [L] using explicitDirectedCertificateValue_pos + (n := m + 2) (by omega) X R C + have hscale : 0 < (rationalNormalizationScale A : ℝ) := by + exact_mod_cast rationalNormalizationScale_pos hAnonneg + have hper := cast_permanent_eq_scale_pow_mul_normalized A hAnonneg + have hout : + (explicitPositiveAlgorithm (m + 2) A : ℝ) = + (rationalNormalizationScale A : ℝ) ^ (m + 2) * (L : ℝ) := by + simp only [explicitPositiveAlgorithm_succ_succ, B, X, R, C, L, + Rat.cast_mul, Rat.cast_pow] + have hcert' : (L : ℝ) ≤ Matrix.permanent (fun i j ↦ (B i j : ℝ)) ∧ + Matrix.permanent (fun i j ↦ (B i j : ℝ)) ≤ + (preSmoothingBase (explicitCertifiedEpsilon : ℝ)) ^ (m + 2) * + (L : ℝ) := by + simpa only [L, X, R, C] using hcert + rw [hout] + refine ⟨mul_pos (pow_pos hscale _) hLpos, ?_, ?_⟩ + · rw [hper] + exact mul_le_mul_of_nonneg_left hcert'.1 (pow_nonneg hscale.le _) + · rw [hper] + have hmul := mul_le_mul_of_nonneg_left hcert'.2 + (pow_nonneg hscale.le (m + 2)) + nlinarith + +/-- Unconditional certified routine for positive rational matrices. -/ +def explicitCertifiedPositiveRoutine : + CertifiedPositiveRoutine (explicitCertifiedEpsilon : ℝ) where + alg := explicitPositiveAlgorithm + positiveOutput := by + intro n hn A hA + cases n with + | zero => omega + | succ n => + cases n with + | zero => omega + | succ m => + exact (explicitPositiveAlgorithm_succ_succ_spec m A hA).1 + lower := by + intro n hn A hA + cases n with + | zero => omega + | succ n => + cases n with + | zero => omega + | succ m => + exact (explicitPositiveAlgorithm_succ_succ_spec m A hA).2.1 + upper := by + intro n hn A hA + cases n with + | zero => omega + | succ n => + cases n with + | zero => omega + | succ m => + exact (explicitPositiveAlgorithm_succ_succ_spec m A hA).2.2 + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/ExplicitScales.lean b/LeanPool/BeyondBethe/BeyondBethe/ExplicitScales.lean new file mode 100644 index 0000000000..1b1a60f31d --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/ExplicitScales.lean @@ -0,0 +1,403 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.ExplicitBounds +import LeanPool.BeyondBethe.BeyondBethe.CertifiedPairWeights +import LeanPool.BeyondBethe.BeyondBethe.NumericalScales +import Mathlib.Tactic + +/-! # Explicit Scales -/ + +namespace BeyondBethe + +/-! +# Hard-coded rational structural scales + +This file replaces the remaining density and continuity choices in the +structural proof by one fixed tuple of rationals. +-/ + +def explicitEta : ℚ := 1 / 10 ^ 12 + +def explicitRowRatio : ℚ := 1 / 200000 + +def explicitDelta : ℚ := + (explicitEta / 3074) ^ 4 * explicitRowRatio + +def explicitXi : ℚ := explicitDelta / 100 + +/-- The greedy threshold matching retains one quarter of the structural +matching gain: one half from directed thresholding and one half from +maximal-versus-maximum cardinality. -/ +def explicitGreedyGamma : ℚ := explicitGamma / 4 + +/-- The structural clean-cycle threshold leaves a fixed gap below the cost +threshold used by the directed rational certificate. -/ +def explicitCertifiedStructuralKappa : ℚ := 9 * explicitKappa / 10 + +/-- A maximal matching loses only a factor two because every accepted edge +receives the exact same certified gain. -/ +def explicitCertifiedGamma : ℚ := explicitGamma / 2 + +theorem explicitEta_pos : 0 < explicitEta := by + norm_num [explicitEta] + +theorem explicitRowRatio_pos : 0 < explicitRowRatio := by + norm_num [explicitRowRatio] + +theorem explicitDelta_pos : 0 < explicitDelta := by + rw [explicitDelta] + exact mul_pos (pow_pos (div_pos explicitEta_pos (by norm_num)) _) explicitRowRatio_pos + +theorem explicitXi_pos : 0 < explicitXi := by + rw [explicitXi] + exact div_pos explicitDelta_pos (by norm_num) + +theorem explicitCertifiedStructuralKappa_pos : + 0 < explicitCertifiedStructuralKappa := by + norm_num [explicitCertifiedStructuralKappa, explicitKappa] + +theorem explicitCertifiedGamma_pos : 0 < explicitCertifiedGamma := by + norm_num [explicitCertifiedGamma, explicitGamma] + +theorem sqrt_explicitEta : + Real.sqrt ((explicitEta : ℚ) : ℝ) = 1 / 10 ^ 6 := by + have heq : (((explicitEta : ℚ) : ℝ)) = (1 / 10 ^ 6 : ℝ) ^ 2 := by + norm_num [explicitEta] + rw [heq, Real.sqrt_sq (by positivity)] + +theorem explicitEta_entropy_bound : + binaryEntropy ((explicitEta : ℚ) : ℝ) + (explicitEta : ℝ) ≤ + 3 / 10 ^ 6 := by + let η : ℝ := (explicitEta : ℚ) + have hη0 : 0 ≤ η := by + change 0 ≤ ((explicitEta : ℚ) : ℝ) + exact_mod_cast explicitEta_pos.le + have hη1 : η ≤ 1 := by norm_num [η, explicitEta] + have hnmlηabs := abs_negMulLog_lt_two_sqrt_abs + (x := η) (by simpa [abs_of_nonneg hη0] using hη1) + have hnmlη : Real.negMulLog η ≤ 2 * Real.sqrt η := + (le_abs_self _).trans (by simpa [abs_of_nonneg hη0] using hnmlηabs) + have hnmlone : Real.negMulLog (1 - η) ≤ η := by + have := Real.negMulLog_le_one_sub_self (sub_nonneg.mpr hη1) + linarith + rw [binaryEntropy, Real.negMulLog_def] + change Real.negMulLog η + Real.negMulLog (1 - η) + η ≤ 3 / 10 ^ 6 + rw [show Real.sqrt η = 1 / 10 ^ 6 by + simpa only [η] using sqrt_explicitEta] at hnmlη + norm_num [η, explicitEta] at * + linarith + +theorem explicitOmega_bound : + goodRowOmega ((explicitEta : ℚ) : ℝ) ≤ 70 / 10 ^ 6 := by + have h := goodRowOmega_le_seventy_sqrt + (η := ((explicitEta : ℚ) : ℝ)) + (by exact_mod_cast explicitEta_pos.le) (by norm_num [explicitEta]) + rw [sqrt_explicitEta] at h + norm_num at h ⊢ + exact h + +theorem explicitDelta_ratio : + ((explicitDelta : ℚ) : ℝ) / + (((explicitEta : ℚ) : ℝ) / 3074) ^ 4 = + (explicitRowRatio : ℝ) := by + have hbase : (((explicitEta : ℚ) : ℝ) / 3074) ^ 4 ≠ 0 := by + exact pow_ne_zero _ (div_ne_zero (by exact_mod_cast explicitEta_pos.ne') (by norm_num)) + rw [explicitDelta] + norm_num only [Rat.cast_mul, Rat.cast_pow, Rat.cast_div, Rat.cast_ofNat] + exact mul_div_cancel_left₀ _ hbase + +theorem explicitDelta_le_rowRatio : + ((explicitDelta : ℚ) : ℝ) ≤ (explicitRowRatio : ℝ) := by + have heta : (((explicitEta : ℚ) : ℝ) / 3074) ^ 4 ≤ 1 := by + have hbase : (0 : ℝ) ≤ ((explicitEta : ℚ) : ℝ) / 3074 := by + exact div_nonneg (by exact_mod_cast explicitEta_pos.le) (by norm_num) + have hbase1 : ((explicitEta : ℚ) : ℝ) / 3074 ≤ 1 := by + norm_num [explicitEta] + exact pow_le_one₀ hbase hbase1 + rw [explicitDelta] + norm_num only [Rat.cast_mul, Rat.cast_pow, Rat.cast_div, Rat.cast_ofNat] + exact mul_le_of_le_one_left (by exact_mod_cast explicitRowRatio_pos.le) heta + +def explicit_completionScales : + RationalCompletionScales explicitKappa explicitXiSource explicitGamma := by + have hlog0 : 0 < Real.log 2 := Real.log_pos (by norm_num) + have hlog1 : Real.log 2 ≤ 1 := Real.log_two_lt_d9.le.trans (by norm_num) + have hcoef : 6 / Real.log 2 ≤ 10 := by + rw [div_le_iff₀ hlog0] + have := Real.log_two_gt_d9 + norm_num at * + linarith + have hδr := explicitDelta_le_rowRatio + have hω := explicitOmega_bound + have hηH := explicitEta_entropy_bound + have hr : ((explicitRowRatio : ℚ) : ℝ) = 1 / 200000 := by + norm_num [explicitRowRatio] + have hδsmall : ((explicitDelta : ℚ) : ℝ) ≤ 1 / 200000 := by + rw [← hr] + exact hδr + have hξδ : explicitXi < explicitDelta := by + rw [explicitXi] + have := explicitDelta_pos + norm_num at * + exact div_lt_self this (by norm_num) + refine { + η := explicitEta + δ := explicitDelta + ξ := explicitXi + η_pos := explicitEta_pos + η_le_tenth := by norm_num [explicitEta] + δ_pos := explicitDelta_pos + ξ_pos := explicitXi_pos + ξ_le_source := by + have hδcast : ((explicitDelta : ℚ) : ℝ) < 1 := + hδsmall.trans_lt (by norm_num) + have hδ : explicitDelta < 1 := by exact_mod_cast hδcast + rw [explicitXi, explicitXiSource] + exact (div_lt_div_of_pos_right hδ (by norm_num)).le + row_small := by + rw [explicitDelta_ratio] + norm_num [explicitRowRatio] + cycle_small := by + rw [explicitDelta_ratio] + have hmid : (1 + Real.log 2 / 2) * + ((explicitRowRatio : ℚ) : ℝ) ≤ + (3 / 2 : ℝ) * (1 / 200000) := by + rw [hr] + apply mul_le_mul_of_nonneg_right _ (by norm_num) + linarith + have hsum : + ((explicitDelta : ℚ) : ℝ) + + (1 + Real.log 2 / 2) * (explicitRowRatio : ℝ) + + goodRowOmega ((explicitEta : ℚ) : ℝ) ≤ + (1 / 200000 : ℝ) + (3 / 2) * (1 / 200000) + 70 / 10 ^ 6 := + add_le_add (add_le_add hδsmall hmid) hω + have hsum0 : 0 ≤ + ((explicitDelta : ℚ) : ℝ) + + (1 + Real.log 2 / 2) * (explicitRowRatio : ℝ) + + goodRowOmega ((explicitEta : ℚ) : ℝ) := by + exact add_nonneg + (add_nonneg (by exact_mod_cast explicitDelta_pos.le) + (mul_nonneg (by positivity) + (by exact_mod_cast explicitRowRatio_pos.le))) + (goodRowOmega_nonneg _) + calc + 6 / Real.log 2 * + (((explicitDelta : ℚ) : ℝ) + + (1 + Real.log 2 / 2) * (explicitRowRatio : ℝ) + + goodRowOmega ((explicitEta : ℚ) : ℝ)) ≤ + 10 * ((1 / 200000 : ℝ) + + (3 / 2) * (1 / 200000) + 70 / 10 ^ 6) := by + exact mul_le_mul hcoef hsum hsum0 (by positivity) + _ ≤ 1 / 16 := by norm_num + transfer_small := by + rw [explicitDelta_ratio] + have hxi : 2 * ((explicitXi : ℚ) : ℝ) ≤ 1 / 200000 := by + have hcast : ((explicitXi : ℚ) : ℝ) < ((explicitDelta : ℚ) : ℝ) := by + exact_mod_cast hξδ + have hδ0 : 0 ≤ ((explicitDelta : ℚ) : ℝ) := by + exact_mod_cast explicitDelta_pos.le + rw [explicitXi] + norm_num only [Rat.cast_div, Rat.cast_ofNat] + nlinarith + have hleft : + ((explicitDelta : ℚ) : ℝ) + 2 * ((explicitXi : ℚ) : ℝ) + + binaryEntropy ((explicitEta : ℚ) : ℝ) + + ((explicitEta : ℚ) : ℝ) + + (1 + Real.log 2) * ((explicitRowRatio : ℚ) : ℝ) ≤ + 23 / 10 ^ 6 := by + calc + _ ≤ (1 / 200000 : ℝ) + 1 / 200000 + 3 / 10 ^ 6 + + 2 * (1 / 200000) := by + have hlast : (1 + Real.log 2) * + ((explicitRowRatio : ℚ) : ℝ) ≤ 2 * (1 / 200000 : ℝ) := by + rw [hr] + gcongr + linarith + linarith + _ = 23 / 10 ^ 6 := by norm_num + have hright : (1 / 40000 : ℝ) ≤ + (1 / 16) * ((1 / 2 - ((explicitEta : ℚ) : ℝ)) * + ((explicitKappa : ℚ) : ℝ)) := by + norm_num [explicitEta, explicitKappa] + exact (hleft.trans (by norm_num : (23 / 10 ^ 6 : ℝ) ≤ 1 / 40000)).trans hright + ξ_lt_δ := hξδ + ξ_lt_gain := by + have hδsmallQ : explicitDelta ≤ 1 / 200000 := by + have hcast : ((explicitDelta : ℚ) : ℝ) ≤ (((1 / 200000 : ℚ)) : ℝ) := by + simpa using hδsmall + exact_mod_cast hcast + rw [explicitGamma] + calc + explicitXi < explicitDelta := hξδ + _ ≤ 1 / 200000 := hδsmallQ + _ < 3 * (1 / 4) / 8 := by norm_num } + +/-- Numerical upper bound on the left side of the transfer-smallness +condition. It is recorded separately so the same analytic estimate can be +used with the slightly smaller structural cost threshold. -/ +theorem explicitTransferExpression_le : + ((explicitDelta : ℚ) : ℝ) + 2 * ((explicitXi : ℚ) : ℝ) + + binaryEntropy ((explicitEta : ℚ) : ℝ) + + ((explicitEta : ℚ) : ℝ) + + (1 + Real.log 2) * + (((explicitDelta : ℚ) : ℝ) / + (((explicitEta : ℚ) : ℝ) / 3074) ^ 4) ≤ + 23 / 10 ^ 6 := by + rw [explicitDelta_ratio] + have hlog1 : Real.log 2 ≤ 1 := Real.log_two_lt_d9.le.trans (by norm_num) + have hδsmall := explicitDelta_le_rowRatio + have hηH := explicitEta_entropy_bound + have hr : ((explicitRowRatio : ℚ) : ℝ) = 1 / 200000 := by + norm_num [explicitRowRatio] + have hδ : ((explicitDelta : ℚ) : ℝ) ≤ 1 / 200000 := by + rw [← hr] + exact hδsmall + have hxi : 2 * ((explicitXi : ℚ) : ℝ) ≤ 1 / 200000 := by + rw [explicitXi] + norm_num only [Rat.cast_div, Rat.cast_ofNat] + have hδ0 : 0 ≤ ((explicitDelta : ℚ) : ℝ) := by + exact_mod_cast explicitDelta_pos.le + nlinarith + have hlast : (1 + Real.log 2) * + ((explicitRowRatio : ℚ) : ℝ) ≤ 2 * (1 / 200000 : ℝ) := by + rw [hr] + gcongr + linarith + linarith + +/-- Completion scales for the actual executable certificate. The clean +cycle analysis uses `0.9 κ`, the directed test uses `κ`, and the greedy +matching retains half of the uniform gain. -/ +def explicitCertifiedCompletionScales : + RationalCompletionScales explicitCertifiedStructuralKappa + explicitXiSource explicitCertifiedGamma := by + refine { explicit_completionScales with + transfer_small := ?_ + ξ_lt_gain := ?_ } + · have hleft := explicitTransferExpression_le + have hright : (23 / 10 ^ 6 : ℝ) ≤ + (1 / 16) * + ((1 / 2 - ((explicitEta : ℚ) : ℝ)) * + ((explicitCertifiedStructuralKappa : ℚ) : ℝ)) := by + norm_num [explicitEta, explicitCertifiedStructuralKappa, explicitKappa] + exact hleft.trans hright + · have hδsmall : explicitDelta ≤ 1 / 200000 := by + have hcast := explicitDelta_le_rowRatio + have hr : ((explicitRowRatio : ℚ) : ℝ) = 1 / 200000 := by + norm_num [explicitRowRatio] + rw [hr] at hcast + have hcast' : ((explicitDelta : ℚ) : ℝ) ≤ + (((1 / 200000 : ℚ)) : ℝ) := by + norm_num only [Rat.cast_div, Rat.cast_ofNat] + exact hcast + exact Rat.cast_le.mp hcast' + change explicitXi < 3 * explicitCertifiedGamma / 8 + rw [explicitXi, explicitCertifiedGamma, explicitGamma] + calc + explicitDelta / 100 < explicitDelta := by + exact div_lt_self explicitDelta_pos (by norm_num) + _ ≤ 1 / 200000 := hδsmall + _ < 3 * ((1 / 4) / 2) / 8 := by norm_num + +theorem explicitCertifiedCostMargin (n : ℕ) : + 4 * (n + 3 : ℝ) * + ((1 / 2 : ℚ) ^ directedPairCostPrecision n : ℚ) ≤ + (explicitKappa : ℝ) - + (explicitCertifiedStructuralKappa : ℝ) := by + have h := directedPairCostPrecision_error_le n + norm_num [explicitKappa, explicitCertifiedStructuralKappa] at h ⊢ + exact h + +/-- The far case is the active branch of the explicit improvement: the +near-case gain margin is vastly larger than the chosen slack scale. -/ +theorem explicitCertifiedEpsilon_eq : + rationalEpsilonPlus explicitCertifiedCompletionScales = + explicitDelta - explicitXi := by + rw [rationalEpsilonPlus] + change min (explicitDelta - explicitXi) + (3 * explicitCertifiedGamma / 8 - explicitXi) = + explicitDelta - explicitXi + rw [min_eq_left] + have hδsmall : explicitDelta ≤ 1 / 200000 := by + have hcast := explicitDelta_le_rowRatio + have hr : ((explicitRowRatio : ℚ) : ℝ) = 1 / 200000 := by + norm_num [explicitRowRatio] + rw [hr] at hcast + have hcast' : ((explicitDelta : ℚ) : ℝ) ≤ + (((1 / 200000 : ℚ)) : ℝ) := by + norm_num only [Rat.cast_div, Rat.cast_ofNat] + exact hcast + exact Rat.cast_le.mp hcast' + have hmain : explicitDelta ≤ 3 * explicitCertifiedGamma / 8 := by + exact hδsmall.trans (by + norm_num [explicitCertifiedGamma, explicitGamma]) + linarith + +def explicitCertifiedEpsilon : ℚ := + rationalEpsilonPlus explicitCertifiedCompletionScales + +theorem explicitCertifiedEpsilon_pos : 0 < explicitCertifiedEpsilon := by + exact rationalEpsilonPlus_pos explicitCertifiedCompletionScales + +def explicitStructuralScales : RationalStructuralScales where + κ₀ := explicitKappa + ξ₀ := explicitXiSource + γ₀ := explicitGamma + κ₀_pos := explicitKappa_pos + ξ₀_pos := by norm_num [explicitXiSource] + γ₀_pos := by norm_num [explicitGamma] + cleanGain := explicit_cleanPairGain_constants + completion := explicit_completionScales + +theorem cleanPairGainGuarantee_mono_gamma + {κ ξ γ γ' : ℝ} (h : CleanPairGainGuarantee κ ξ γ) + (hγ : γ' ≤ γ) : CleanPairGainGuarantee κ ξ γ' := by + intro n ell ξ' τ A X rscale cscale hell hlog hξ hξsource hτ hA hX + hXint hr hc hKKT r s a b hrs hab hcost + exact hγ.trans (h hell hlog hξ hξsource hτ hA hX hXint hr hc hKKT + hrs hab hcost) + +theorem explicitGreedyGamma_pos : 0 < explicitGreedyGamma := by + norm_num [explicitGreedyGamma, explicitGamma] + +def explicitGreedyCompletionScales : + RationalCompletionScales explicitKappa explicitXiSource + explicitGreedyGamma := + { explicit_completionScales with + ξ_lt_gain := by + have hδsmall : explicitDelta ≤ 1 / 200000 := by + have h := explicitDelta_le_rowRatio + have hr : ((explicitRowRatio : ℚ) : ℝ) = 1 / 200000 := by + norm_num [explicitRowRatio] + rw [hr] at h + have h' : ((explicitDelta : ℚ) : ℝ) ≤ (((1 / 200000 : ℚ)) : ℝ) := by + simpa using h + exact_mod_cast h' + change explicitXi < 3 * explicitGreedyGamma / 8 + rw [explicitXi, explicitGreedyGamma, explicitGamma] + calc + explicitDelta / 100 < explicitDelta := by + exact div_lt_self explicitDelta_pos (by norm_num) + _ ≤ 1 / 200000 := hδsmall + _ < 3 * ((1 / 4) / 4) / 8 := by norm_num } + +/-- Structural data weakened exactly by the fixedValue-factor loss of the +greedy implementation. All analytic inequalities and hard-coded scales are +unchanged. -/ +def explicitGreedyStructuralScales : RationalStructuralScales where + κ₀ := explicitKappa + ξ₀ := explicitXiSource + γ₀ := explicitGreedyGamma + κ₀_pos := explicitKappa_pos + ξ₀_pos := by norm_num [explicitXiSource] + γ₀_pos := explicitGreedyGamma_pos + cleanGain := cleanPairGainGuarantee_mono_gamma + explicit_cleanPairGain_constants (by + norm_num [explicitGreedyGamma, explicitGamma]) + completion := explicitGreedyCompletionScales + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/ExplicitScheduledFeasibility.lean b/LeanPool/BeyondBethe/BeyondBethe/ExplicitScheduledFeasibility.lean new file mode 100644 index 0000000000..cafa17d902 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/ExplicitScheduledFeasibility.lean @@ -0,0 +1,240 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.ScheduledFeasibility +import Mathlib.Tactic + +/-! # Explicit Scheduled Feasibility -/ + +open scoped BigOperators + +namespace BeyondBethe + +/-! +# An explicit schedule for a zero-centered rational ball + +Every Bethe feasibility call starts from a zero-centered diagonal ball. For +that special initial state there is no reason to compute a matrix common +denominator. The canonical bit length of the radius gives both a dyadic +lower bound on the initial determinant and a dyadic upper bound on the exact +initial state magnitude. This file packages those two exponents into the +fixed-precision feasibility runner used by the finite-word implementation. +-/ + +def explicitBallInitialDetExponent (d : ℕ) (R : ℚ) : ℕ := + encodedBitLength ℚ R * d + +def explicitBallInitialMagnitudeBound (d : ℕ) (R : ℚ) : ℚ := + 2 + d * R + +def explicitBallInitialMagnitudeExponent (d : ℕ) (R : ℚ) : ℕ := + encodedBitLength ℚ (explicitBallInitialMagnitudeBound d R) + +def explicitBallFeasibilityPrecision (d budget : ℕ) (R : ℚ) : ℕ := + roundedEllipsoidPrecisionSchedule d + (explicitBallInitialDetExponent d R) + (explicitBallInitialMagnitudeExponent d R) budget + +def runExplicitBallRationalFeasibility {d : ℕ} + (oracle : RationalCentralOracle d) (budget : ℕ) (R : ℚ) : + RationalFeasibilityResult d := + runFixedPrecisionRationalFeasibility + (explicitBallFeasibilityPrecision d budget R) oracle budget + (rationalBallEllipsoid d 0 R) + +theorem explicitBallInitialDetExponent_lower {d : ℕ} {R : ℚ} + (hR : 0 < R) : + dyadicMesh (explicitBallInitialDetExponent d R) ≤ R ^ d := by + let L := encodedBitLength ℚ R + have hlower : dyadicMesh L < R := by + rw [dyadicMesh_eq_half_pow] + simpa only [L] using dyadic_encodedBitLength_lt_positive_rational hR + have hlower' : dyadicMesh L ≤ R := hlower.le + have hpow : dyadicMesh L ^ d ≤ R ^ d := + pow_le_pow_left₀ (dyadicMesh_nonneg L) hlower' d + rw [explicitBallInitialDetExponent, dyadicMesh_eq_half_pow] + rw [show encodedBitLength ℚ R * d = L * d by rfl, pow_mul] + simpa only [dyadicMesh_eq_half_pow] using hpow + +theorem rationalStateAbsBound_zero_ball {d : ℕ} {R : ℚ} + (hR : 0 ≤ R) : + rationalStateAbsBound (rationalBallEllipsoid d 0 R) = + explicitBallInitialMagnitudeBound d R := by + classical + rw [rationalStateAbsBound, rationalCenterAbsBound, + rationalMatrixAbsBound, explicitBallInitialMagnitudeBound] + simp only [rationalBallEllipsoid, Pi.zero_apply, abs_zero, + Finset.sum_const_zero, zero_add] + have hinner (i : Fin d) : + (∑ j : Fin d, abs (if i = j then R else 0)) = R := by + calc + (∑ j : Fin d, abs (if i = j then R else 0)) = + ∑ j : Fin d, if i = j then R else 0 := by + apply Finset.sum_congr rfl + intro j _ + by_cases hij : i = j <;> simp [hij, abs_of_nonneg hR] + _ = R := by + simpa using Fintype.sum_ite_eq i (fun _ : Fin d ↦ R) + have hsum : + (∑ i : Fin d, ∑ j : Fin d, abs (if i = j then R else 0)) = + ∑ _i : Fin d, R := by + apply Finset.sum_congr rfl + intro i _ + exact hinner i + rw [hsum] + simp + ring + +theorem explicitBallInitialMagnitudeExponent_upper {d : ℕ} {R : ℚ} + (hR : 0 < R) : + rationalStateAbsBound (rationalBallEllipsoid d 0 R) ≤ + (2 : ℚ) ^ explicitBallInitialMagnitudeExponent d R := by + rw [rationalStateAbsBound_zero_ball hR.le] + have hbound : 0 < explicitBallInitialMagnitudeBound d R := by + rw [explicitBallInitialMagnitudeBound] + positivity + exact (positive_rational_lt_two_pow_encodedBitLength hbound).le + +theorem explicitBallInitialInvariant {d : ℕ} {R : ℚ} + (hR : 0 < R) : + ScheduledEllipsoidInvariant d + (explicitBallInitialDetExponent d R) + (explicitBallInitialMagnitudeExponent d R) 0 + (rationalBallEllipsoid d 0 R) := by + refine ⟨?_, ?_, ?_⟩ + · rw [det_rationalBallEllipsoid] + exact pow_ne_zero d hR.ne' + · rw [det_rationalBallEllipsoid, abs_of_pos (pow_pos hR d)] + simpa using explicitBallInitialDetExponent_lower hR + · simpa using explicitBallInitialMagnitudeExponent_upper hR + +theorem runExplicitBallRationalFeasibility_acceptsOnly {d : ℕ} + {Good : (Fin d → ℚ) → Prop} {oracle : RationalCentralOracle d} + (haccept : RationalCentralOracleAcceptsOnly Good oracle) + {budget : ℕ} {R : ℚ} {x : Fin d → ℚ} + (hrun : runExplicitBallRationalFeasibility oracle budget R = + .accepted x) : Good x := by + exact runFixedPrecisionRationalFeasibility_acceptsOnly haccept + (by simpa only [runExplicitBallRationalFeasibility] using hrun) + +theorem runExplicitBallRationalFeasibility_not_exhausted_of_inner_cross + {d M : ℕ} (hd : 0 < d) + {Target : (Fin d → ℝ) → Prop} {oracle : RationalCentralOracle d} + (hvalid : RationalCentralOracleValid Target oracle) + {R : ℚ} (hR : 0 < R) + {z : Fin d → ℝ} {r : ℝ} (hr : 0 ≤ r) + (hdyadic : d.factorial * (R : ℝ) ^ d * + (1 / 2 : ℝ) ^ M < r ^ d) + (hTargetPlus : ∀ k, Target + (fun i ↦ z i + if i = k then r else 0)) + (hTargetMinus : ∀ k, Target + (fun i ↦ z i - if i = k then r else 0)) + (hEplus : ∀ k, RationalEllipsoidContains + (rationalBallEllipsoid d 0 R) + (fun i ↦ z i + if i = k then r else 0)) + (hEminus : ∀ k, RationalEllipsoidContains + (rationalBallEllipsoid d 0 R) + (fun i ↦ z i - if i = k then r else 0)) + (E' : RationalEllipsoidState d) : + runExplicitBallRationalFeasibility oracle (32 * d ^ 3 * M) R ≠ + .exhausted E' := by + intro hrun + let L := explicitBallInitialDetExponent d R + let K := explicitBallInitialMagnitudeExponent d R + let T := 32 * d ^ 3 * M + let E := rationalBallEllipsoid d 0 R + have hInv : ScheduledEllipsoidInvariant d L K 0 E := by + simpa only [L, K, E] using explicitBallInitialInvariant hR + have hrun' : runFixedPrecisionRationalFeasibility + (roundedEllipsoidPrecisionSchedule d L K T) oracle T E = + .exhausted E' := by + simpa only [runExplicitBallRationalFeasibility, + explicitBallFeasibilityPrecision, L, K, T, E] using hrun + have hplus : ∀ k, RationalEllipsoidContains E' + (fun i ↦ z i + if i = k then r else 0) := by + intro k + exact runFixedPrecisionRationalFeasibility_preserves_target_of_exhausted + hd hvalid hInv (by omega) hrun' (hTargetPlus k) (hEplus k) + have hminus : ∀ k, RationalEllipsoidContains E' + (fun i ↦ z i - if i = k then r else 0) := by + intro k + exact runFixedPrecisionRationalFeasibility_preserves_target_of_exhausted + hd hvalid hInv (by omega) hrun' (hTargetMinus k) (hEminus k) + have hlower := rationalEllipsoid_storedDet_lower_of_ball_endpoints + E' hr (fun k ↦ hplus k) (fun k ↦ hminus k) + have hupper := runFixedPrecisionRationalFeasibility_det_upper_of_exhausted + hd hvalid hInv (by omega) hrun' + have hfactor := roundedContractionFactor_pow_budget_le_half_pow + (d := d) (M := M) hd + have hdetUpper : abs ((Matrix.det E'.basis : ℚ) : ℝ) ≤ + (1 / 2 : ℝ) ^ M * (R : ℝ) ^ d := by + rw [show abs ((Matrix.det E.basis : ℚ) : ℝ) = (R : ℝ) ^ d by + dsimp only [E] + rw [det_rationalBallEllipsoid, Rat.cast_pow, + abs_of_pos (pow_pos (Rat.cast_pos.mpr hR) d)]] at hupper + exact hupper.trans + (mul_le_mul_of_nonneg_right hfactor (by positivity)) + have hsandwich : r ^ d ≤ + d.factorial * (R : ℝ) ^ d * (1 / 2 : ℝ) ^ M := by + calc + r ^ d ≤ d.factorial * + abs ((Matrix.det E'.basis : ℚ) : ℝ) := hlower + _ ≤ d.factorial * ((1 / 2 : ℝ) ^ M * (R : ℝ) ^ d) := + mul_le_mul_of_nonneg_left hdetUpper (Nat.cast_nonneg _) + _ = d.factorial * (R : ℝ) ^ d * (1 / 2 : ℝ) ^ M := by ring + exact (not_lt_of_ge hsandwich) hdyadic + +theorem runExplicitBallRationalFeasibility_ball_accepts + {d : ℕ} (hd : 0 < d) + {Target : (Fin d → ℝ) → Prop} {Good : (Fin d → ℚ) → Prop} + {oracle : RationalCentralOracle d} + (hvalid : RationalCentralOracleValid Target oracle) + (haccept : RationalCentralOracleAcceptsOnly Good oracle) + {R r : ℚ} (hR : 0 < R) (hr : 0 < r) + {z : Fin d → ℝ} + (hTargetPlus : ∀ k, Target + (fun i ↦ z i + if i = k then (r : ℝ) else 0)) + (hTargetMinus : ∀ k, Target + (fun i ↦ z i - if i = k then (r : ℝ) else 0)) + (houterPlus : ∀ k, finiteNormSq + (fun i ↦ z i + if i = k then (r : ℝ) else 0) ≤ (R : ℝ) ^ 2) + (houterMinus : ∀ k, finiteNormSq + (fun i ↦ z i - if i = k then (r : ℝ) else 0) ≤ (R : ℝ) ^ 2) : + let M := rationalBallDyadicExponent d R r + let budget := 32 * d ^ 3 * M + ∃ x : Fin d → ℚ, + runExplicitBallRationalFeasibility oracle budget R = .accepted x ∧ + Good x := by + dsimp only + let M := rationalBallDyadicExponent d R r + let budget := 32 * d ^ 3 * M + let result := runExplicitBallRationalFeasibility oracle budget R + cases hresult : result with + | accepted x => + refine ⟨x, ?_, ?_⟩ + · simpa only [result, budget, M] using hresult + · exact runExplicitBallRationalFeasibility_acceptsOnly haccept + (by simpa only [result, budget, M] using hresult) + | exhausted E' => + exfalso + apply runExplicitBallRationalFeasibility_not_exhausted_of_inner_cross + hd hvalid hR (hr := Rat.cast_nonneg.mpr hr.le) + (by + have hbudget := rationalBallEllipsoid_dyadic_budget + hd (0 : Fin d → ℚ) hR hr + rw [det_rationalBallEllipsoid, Rat.cast_pow, + abs_of_pos (pow_pos (Rat.cast_pos.mpr hR) d)] at hbudget + simpa only [M] using hbudget) + hTargetPlus hTargetMinus + · intro k + apply rationalBallEllipsoid_contains 0 hR + simpa using houterPlus k + · intro k + apply rationalBallEllipsoid_contains 0 hR + simpa using houterMinus k + · simpa only [result, budget, M] using hresult + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/FinalAssembly.lean b/LeanPool/BeyondBethe/BeyondBethe/FinalAssembly.lean new file mode 100644 index 0000000000..cad8000089 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/FinalAssembly.lean @@ -0,0 +1,507 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.NumericalScales +import LeanPool.BeyondBethe.BeyondBethe.AlgorithmicSpec +import LeanPool.BeyondBethe.BeyondBethe.Smoothing +import LeanPool.BeyondBethe.BeyondBethe.KuhnMatching + +/-! # Final Assembly -/ + +open scoped BigOperators + +namespace BeyondBethe + +/-- A rational scaling factor that is positive on every nonnegative matrix +and dominates each entry. Using `1 + sum A` avoids a special case for the +largest entry while retaining polynomial bit complexity. -/ +def rationalNormalizationScale {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) : ℚ := + 1 + ∑ i, ∑ j, A i j + +/-- Entrywise normalization used before smoothing. -/ +def normalizedRationalMatrix {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) : Matrix (Fin n) (Fin n) ℚ := + fun i j ↦ A i j / rationalNormalizationScale A + +/-- The factor assigned to one matrix coordinate when forming the support +floor. -/ +def rationalSupportFactor {n : ℕ} + (B : Matrix (Fin n) (Fin n) ℚ) (p : Fin n × Fin n) : ℚ := + if B p.1 p.2 = 0 then 1 else B p.1 p.2 + +/-- A rational lower bound for every nonzero entry of a normalized matrix. +Zero entries contribute the neutral factor. -/ +def rationalSupportFloor {n : ℕ} + (B : Matrix (Fin n) (Fin n) ℚ) : ℚ := + ∏ p ∈ (Finset.univ.product Finset.univ), + rationalSupportFactor B p + +/-- The paper's rational smoothing level, applied after normalization. -/ +def rationalSmoothingDelta {n : ℕ} + (B : Matrix (Fin n) (Fin n) ℚ) (χ : ℚ) : ℚ := + min (1 / (2 * n)) + (χ * rationalSupportFloor B ^ n / (4 * Nat.factorial n)) + +/-- The canonical positive rational perturbation used by the final +algorithm. -/ +def smoothedRationalMatrix {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) (χ : ℚ) : + Matrix (Fin n) (Fin n) ℚ := + let B := normalizedRationalMatrix A + let δ := rationalSmoothingDelta B χ + fun i j ↦ B i j + δ + +/-- What the certified finite-precision routine must provide on positive +rational matrices. Its numerical loss is exactly the allowance in Lemma 24 +of the paper. -/ +structure CertifiedPositiveRoutine (ε : ℝ) where + alg : ∀ n, Matrix (Fin n) (Fin n) ℚ → ℚ + positiveOutput : ∀ {n : ℕ}, 2 ≤ n → + ∀ A : Matrix (Fin n) (Fin n) ℚ, + Matrix.Positive (fun i j ↦ (A i j : ℝ)) → + 0 < ((alg n A : ℚ) : ℝ) + lower : ∀ {n : ℕ}, 2 ≤ n → + ∀ A : Matrix (Fin n) (Fin n) ℚ, + Matrix.Positive (fun i j ↦ (A i j : ℝ)) → + ((alg n A : ℚ) : ℝ) ≤ ((Matrix.permanent A : ℚ) : ℝ) + upper : ∀ {n : ℕ}, 2 ≤ n → + ∀ A : Matrix (Fin n) (Fin n) ℚ, + Matrix.Positive (fun i j ↦ (A i j : ℝ)) → + ((Matrix.permanent A : ℚ) : ℝ) ≤ + (preSmoothingBase ε) ^ n * ((alg n A : ℚ) : ℝ) + +/-- Executable entrywise nonnegativity test. The outer algorithm uses this +guard to remain a polynomial-time total function on all rational matrices, +including inputs outside the approximation theorem's domain. -/ +def rationalMatrixNonnegativeDecision {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) : Bool := + decide (∀ i : Fin n, ∀ j : Fin n, 0 ≤ A i j) + +theorem rationalMatrixNonnegativeDecision_eq_true_iff {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) : + rationalMatrixNonnegativeDecision A = true ↔ Matrix.Nonnegative A := by + simp [rationalMatrixNonnegativeDecision, Matrix.Nonnegative] + +/-- Rational wrapper around the positive-matrix routine. Matrices of order +zero or one are evaluated exactly; a matrix with no support matching returns +zero; otherwise we normalize, smooth, call the positive routine, and undo the +normalization and smoothing factor. -/ +def completedAlgorithm + {ε : ℝ} (routine : CertifiedPositiveRoutine ε) (χ : ℚ) : + ∀ n, Matrix (Fin n) (Fin n) ℚ → ℚ := by + exact fun n A ↦ + if rationalMatrixNonnegativeDecision A then + if n < 2 then Matrix.permanent A + else if kuhnSupportMatchingDecision A then + let scale := rationalNormalizationScale A + let lowerSmooth := routine.alg n (smoothedRationalMatrix A χ) + scale ^ n * lowerSmooth / (1 + χ * n / 2) + else 0 + else 0 + +theorem rationalNormalizationScale_pos + {n : ℕ} {A : Matrix (Fin n) (Fin n) ℚ} + (hA : Matrix.Nonnegative A) : + 0 < rationalNormalizationScale A := by + have hsum : 0 ≤ ∑ i, ∑ j, A i j := + Finset.sum_nonneg fun i _ ↦ Finset.sum_nonneg fun j _ ↦ hA i j + simp only [rationalNormalizationScale] + linarith + +theorem entry_le_rationalNormalizationScale + {n : ℕ} {A : Matrix (Fin n) (Fin n) ℚ} + (hA : Matrix.Nonnegative A) (i j : Fin n) : + A i j ≤ rationalNormalizationScale A := by + have hrow : A i j ≤ ∑ k, A i k := + Finset.single_le_sum (fun k _ ↦ hA i k) (Finset.mem_univ j) + have htotal : (∑ k, A i k) ≤ ∑ r, ∑ k, A r k := + Finset.single_le_sum + (fun r _ ↦ Finset.sum_nonneg fun k _ ↦ hA r k) + (Finset.mem_univ i) + simp only [rationalNormalizationScale] + linarith + +theorem normalizedRationalMatrix_nonnegative + {n : ℕ} {A : Matrix (Fin n) (Fin n) ℚ} + (hA : Matrix.Nonnegative A) : + Matrix.Nonnegative (normalizedRationalMatrix A) := by + intro i j + exact div_nonneg (hA i j) (rationalNormalizationScale_pos hA).le + +theorem normalizedRationalMatrix_le_one + {n : ℕ} {A : Matrix (Fin n) (Fin n) ℚ} + (hA : Matrix.Nonnegative A) (i j : Fin n) : + normalizedRationalMatrix A i j ≤ 1 := by + rw [normalizedRationalMatrix, div_le_one + (rationalNormalizationScale_pos hA)] + exact entry_le_rationalNormalizationScale hA i j + +theorem normalizedRationalMatrix_ne_zero_iff + {n : ℕ} {A : Matrix (Fin n) (Fin n) ℚ} + (hA : Matrix.Nonnegative A) (i j : Fin n) : + normalizedRationalMatrix A i j ≠ 0 ↔ A i j ≠ 0 := by + rw [normalizedRationalMatrix, div_ne_zero_iff] + simp [ne_of_gt (rationalNormalizationScale_pos hA)] + +theorem normalizedRationalMatrix_hasPerfectMatching + {n : ℕ} {A : Matrix (Fin n) (Fin n) ℚ} + (hA : Matrix.Nonnegative A) + (hmatch : Matrix.HasPerfectMatching A) : + Matrix.HasPerfectMatching (normalizedRationalMatrix A) := by + obtain ⟨σ, hσ⟩ := hmatch + exact ⟨σ, fun i ↦ (normalizedRationalMatrix_ne_zero_iff hA _ _).2 (hσ i)⟩ + +theorem rationalSupportFactor_pos + {n : ℕ} {B : Matrix (Fin n) (Fin n) ℚ} + (hB : Matrix.Nonnegative B) (p : Fin n × Fin n) : + 0 < rationalSupportFactor B p := by + rw [rationalSupportFactor] + split_ifs with hp + · norm_num + · exact lt_of_le_of_ne (hB p.1 p.2) (Ne.symm hp) + +theorem rationalSupportFactor_le_one + {n : ℕ} {B : Matrix (Fin n) (Fin n) ℚ} + (hB1 : ∀ i j, B i j ≤ 1) (p : Fin n × Fin n) : + rationalSupportFactor B p ≤ 1 := by + rw [rationalSupportFactor] + split_ifs + · rfl + · exact hB1 p.1 p.2 + +theorem finset_prod_le_factor + {α : Type*} [DecidableEq α] + {s : Finset α} {f : α → ℚ} {p : α} + (hp : p ∈ s) (hpos : ∀ q ∈ s, 0 ≤ f q) + (hone : ∀ q ∈ s, f q ≤ 1) : + ∏ q ∈ s, f q ≤ f p := by + rw [← Finset.prod_erase_mul s f hp] + have herase : ∏ q ∈ s.erase p, f q ≤ 1 := + Finset.prod_le_one + (fun q hq ↦ hpos q (Finset.mem_of_mem_erase hq)) + (fun q hq ↦ hone q (Finset.mem_of_mem_erase hq)) + exact (mul_le_mul_of_nonneg_right herase (hpos p hp)).trans_eq (one_mul _) + +theorem rationalSupportFloor_pos + {n : ℕ} {B : Matrix (Fin n) (Fin n) ℚ} + (hB : Matrix.Nonnegative B) : + 0 < rationalSupportFloor B := by + rw [rationalSupportFloor] + exact Finset.prod_pos fun p _ ↦ rationalSupportFactor_pos hB p + +theorem rationalSupportFloor_le_entry + {n : ℕ} {B : Matrix (Fin n) (Fin n) ℚ} + (hB : Matrix.Nonnegative B) (hB1 : ∀ i j, B i j ≤ 1) + (i j : Fin n) (hij : B i j ≠ 0) : + rationalSupportFloor B ≤ B i j := by + let s : Finset (Fin n × Fin n) := Finset.univ.product Finset.univ + have hp : (i, j) ∈ s := by simp [s] + have hprod := finset_prod_le_factor hp + (fun p _ ↦ (rationalSupportFactor_pos hB p).le) + (fun p _ ↦ rationalSupportFactor_le_one hB1 p) + simpa [rationalSupportFloor, rationalSupportFactor, hij, s] using hprod + +theorem cast_rationalNormalizationScale + {n : ℕ} (A : Matrix (Fin n) (Fin n) ℚ) : + ((rationalNormalizationScale A : ℚ) : ℝ) = + 1 + ∑ i, ∑ j, (A i j : ℝ) := by + simp [rationalNormalizationScale] + +theorem cast_normalizedRationalMatrix + {n : ℕ} (A : Matrix (Fin n) (Fin n) ℚ) (i j : Fin n) : + ((normalizedRationalMatrix A i j : ℚ) : ℝ) = + (A i j : ℝ) / (1 + ∑ r, ∑ k, (A r k : ℝ)) := by + simp [normalizedRationalMatrix, cast_rationalNormalizationScale] + +theorem cast_rationalSupportFloor + {n : ℕ} (B : Matrix (Fin n) (Fin n) ℚ) : + ((rationalSupportFloor B : ℚ) : ℝ) = + ∏ p ∈ (Finset.univ.product Finset.univ), + if B p.1 p.2 = 0 then 1 else (B p.1 p.2 : ℝ) := by + classical + rw [rationalSupportFloor] + push_cast + apply Finset.prod_congr rfl + intro p _hp + by_cases h : B p.1 p.2 = 0 <;> + simp [rationalSupportFactor, h] + +theorem cast_rationalSmoothingDelta + {n : ℕ} (B : Matrix (Fin n) (Fin n) ℚ) (χ : ℚ) : + ((rationalSmoothingDelta B χ : ℚ) : ℝ) = + smoothingDelta n (rationalSupportFloor B : ℝ) (χ : ℝ) := by + simp [rationalSmoothingDelta, smoothingDelta] + +theorem cast_smoothedRationalMatrix + {n : ℕ} (A : Matrix (Fin n) (Fin n) ℚ) (χ : ℚ) + (i j : Fin n) : + ((smoothedRationalMatrix A χ i j : ℚ) : ℝ) = + (normalizedRationalMatrix A i j : ℝ) + + smoothingDelta n (rationalSupportFloor (normalizedRationalMatrix A) : ℝ) + (χ : ℝ) := by + simp [smoothedRationalMatrix, cast_rationalSmoothingDelta] + +theorem cast_normalizedRationalMatrix_nonnegative + {n : ℕ} {A : Matrix (Fin n) (Fin n) ℚ} + (hA : Matrix.Nonnegative A) : + Matrix.Nonnegative + (fun i j ↦ ((normalizedRationalMatrix A i j : ℚ) : ℝ)) := by + intro i j + change 0 ≤ ((normalizedRationalMatrix A i j : ℚ) : ℝ) + exact_mod_cast normalizedRationalMatrix_nonnegative hA i j + +theorem cast_normalizedRationalMatrix_le_one + {n : ℕ} {A : Matrix (Fin n) (Fin n) ℚ} + (hA : Matrix.Nonnegative A) (i j : Fin n) : + ((normalizedRationalMatrix A i j : ℚ) : ℝ) ≤ 1 := by + exact_mod_cast normalizedRationalMatrix_le_one hA i j + +theorem cast_rationalSupportFloor_pos + {n : ℕ} {B : Matrix (Fin n) (Fin n) ℚ} + (hB : Matrix.Nonnegative B) : + 0 < ((rationalSupportFloor B : ℚ) : ℝ) := by + exact_mod_cast rationalSupportFloor_pos hB + +theorem cast_rationalSupportFloor_le_entry + {n : ℕ} {B : Matrix (Fin n) (Fin n) ℚ} + (hB : Matrix.Nonnegative B) (hB1 : ∀ i j, B i j ≤ 1) + (i j : Fin n) + (hij : ((B i j : ℚ) : ℝ) ≠ 0) : + ((rationalSupportFloor B : ℚ) : ℝ) ≤ (B i j : ℝ) := by + have hijq : B i j ≠ 0 := by exact_mod_cast hij + exact_mod_cast rationalSupportFloor_le_entry hB hB1 i j hijq + +theorem cast_normalizedRationalMatrix_hasPerfectMatching + {n : ℕ} {A : Matrix (Fin n) (Fin n) ℚ} + (hA : Matrix.Nonnegative A) + (hmatch : Matrix.HasPerfectMatching A) : + Matrix.HasPerfectMatching + (fun i j ↦ ((normalizedRationalMatrix A i j : ℚ) : ℝ)) := by + obtain ⟨σ, hσ⟩ := normalizedRationalMatrix_hasPerfectMatching hA hmatch + refine ⟨σ, ?_⟩ + intro i + change ((normalizedRationalMatrix A (σ i) i : ℚ) : ℝ) ≠ 0 + exact_mod_cast hσ i + +/-- The explicit rational perturbation satisfies the real smoothing lemma. +This closes the zero-entry reduction independently of numerical convex +optimization. -/ +theorem canonical_smoothing_comparison + {n : ℕ} (hn : 0 < n) + (A : Matrix (Fin n) (Fin n) ℚ) (hA : Matrix.Nonnegative A) + (hmatch : Matrix.HasPerfectMatching A) + (χ : ℚ) (hχ : 0 < (χ : ℝ)) : + let B : Matrix (Fin n) (Fin n) ℝ := + fun i j ↦ ((normalizedRationalMatrix A i j : ℚ) : ℝ) + let Atilde : Matrix (Fin n) (Fin n) ℝ := + fun i j ↦ ((smoothedRationalMatrix A χ i j : ℚ) : ℝ) + Matrix.permanent B ≤ Matrix.permanent Atilde ∧ + Matrix.permanent Atilde ≤ + (1 + (χ : ℝ) * n / 2) * Matrix.permanent B := by + dsimp only + let Bq := normalizedRationalMatrix A + let m : ℝ := (rationalSupportFloor Bq : ℚ) + have hBq0 : Matrix.Nonnegative Bq := normalizedRationalMatrix_nonnegative hA + have hBq1 : ∀ i j, Bq i j ≤ 1 := normalizedRationalMatrix_le_one hA + have hm : 0 < m := cast_rationalSupportFloor_pos hBq0 + have hcomparison := smoothing_comparison_explicit + (fun i j ↦ ((Bq i j : ℚ) : ℝ)) + (m := m) (χ := (χ : ℝ)) (by simpa using hn) hm hχ + (cast_normalizedRationalMatrix_nonnegative hA) + (cast_normalizedRationalMatrix_le_one hA) + (fun i j hij ↦ cast_rationalSupportFloor_le_entry hBq0 hBq1 i j hij) + (cast_normalizedRationalMatrix_hasPerfectMatching hA hmatch) + simpa [Bq, m, cast_smoothedRationalMatrix] using hcomparison + +theorem cast_smoothedRationalMatrix_positive + {n : ℕ} (hn : 0 < n) + (A : Matrix (Fin n) (Fin n) ℚ) (hA : Matrix.Nonnegative A) + (χ : ℚ) (hχ : 0 < (χ : ℝ)) : + Matrix.Positive + (fun i j ↦ ((smoothedRationalMatrix A χ i j : ℚ) : ℝ)) := by + let Bq := normalizedRationalMatrix A + have hBq0 : Matrix.Nonnegative Bq := normalizedRationalMatrix_nonnegative hA + have hm : 0 < ((rationalSupportFloor Bq : ℚ) : ℝ) := + cast_rationalSupportFloor_pos hBq0 + have hδ : 0 < smoothingDelta n + ((rationalSupportFloor Bq : ℚ) : ℝ) (χ : ℝ) := + smoothingDelta_pos hn hm hχ + intro i j + change 0 < ((smoothedRationalMatrix A χ i j : ℚ) : ℝ) + rw [cast_smoothedRationalMatrix] + exact add_pos_of_nonneg_of_pos + (cast_normalizedRationalMatrix_nonnegative hA i j) hδ + +theorem cast_permanent_eq_scale_pow_mul_normalized + {n : ℕ} (A : Matrix (Fin n) (Fin n) ℚ) + (hA : Matrix.Nonnegative A) : + ((Matrix.permanent A : ℚ) : ℝ) = + ((rationalNormalizationScale A : ℚ) : ℝ) ^ n * + Matrix.permanent + (fun i j ↦ ((normalizedRationalMatrix A i j : ℚ) : ℝ)) := by + let scale : ℝ := (rationalNormalizationScale A : ℚ) + let B : Matrix (Fin n) (Fin n) ℝ := + fun i j ↦ ((normalizedRationalMatrix A i j : ℚ) : ℝ) + have hscale : 0 < scale := by + dsimp only [scale] + exact_mod_cast rationalNormalizationScale_pos hA + have hmatrix : (fun i j ↦ ((A i j : ℚ) : ℝ)) = scale • B := by + ext i j + change (A i j : ℝ) = scale * B i j + dsimp only [B, scale] + rw [cast_normalizedRationalMatrix] + rw [cast_rationalNormalizationScale] + have hden : 1 + ∑ r, ∑ k, (A r k : ℝ) ≠ 0 := by + simpa [scale, cast_rationalNormalizationScale] using hscale.ne' + field_simp [hden] + rw [Matrix.cast_permanent_rat, hmatrix, Matrix.permanent_scale_real] + simp [scale, B] + +theorem cast_completedAlgorithm_of_large_matching + {ε : ℝ} (routine : CertifiedPositiveRoutine ε) (χ : ℚ) + {n : ℕ} (hn : 2 ≤ n) (A : Matrix (Fin n) (Fin n) ℚ) + (hA : Matrix.Nonnegative A) + (hmatch : Matrix.HasPerfectMatching A) : + (((completedAlgorithm routine χ n A : ℚ) : ℝ)) = + ((rationalNormalizationScale A : ℚ) : ℝ) ^ n * + ((routine.alg n (smoothedRationalMatrix A χ) : ℚ) : ℝ) / + (1 + (χ : ℝ) * n / 2) := by + have hnot : ¬n < 2 := not_lt.mpr hn + have hdecision : kuhnSupportMatchingDecision A = true := + (kuhnSupportMatchingDecision_eq_true_iff A).2 hmatch + have hnonnegative : rationalMatrixNonnegativeDecision A = true := + (rationalMatrixNonnegativeDecision_eq_true_iff A).2 hA + simp [completedAlgorithm, hnonnegative, hnot, hdecision] + +/-- The explicit rational wrapper inherits the desired two-sided estimate on +the support-matching branch. -/ +theorem completedAlgorithm_guarantee_of_matching + {ε : ℝ} (hε : 0 < ε) + (routine : CertifiedPositiveRoutine ε) (χ : ℚ) + (hχ : 0 < (χ : ℝ)) (hχsmall : (χ : ℝ) ≤ ε / 2) + {n : ℕ} (hn : 2 ≤ n) (A : Matrix (Fin n) (Fin n) ℚ) + (hA : Matrix.Nonnegative A) + (hmatch : Matrix.HasPerfectMatching A) : + ((completedAlgorithm routine χ n A : ℚ) : ℝ) ≤ + ((Matrix.permanent A : ℚ) : ℝ) ∧ + ((Matrix.permanent A : ℚ) : ℝ) ≤ + (finalBase ε) ^ n * + ((completedAlgorithm routine χ n A : ℚ) : ℝ) := by + let Bq := normalizedRationalMatrix A + let Aq := smoothedRationalMatrix A χ + let lower : ℝ := (routine.alg n Aq : ℚ) + have hnpos : 0 < n := by omega + have hAqpos : Matrix.Positive (fun i j ↦ ((Aq i j : ℚ) : ℝ)) := by + simpa only [Aq] using cast_smoothedRationalMatrix_positive hnpos A hA χ hχ + have hlowerPos : 0 < lower := routine.positiveOutput hn Aq hAqpos + have hcertLower : lower ≤ Matrix.permanent + (fun i j ↦ ((Aq i j : ℚ) : ℝ)) := by + rw [← Matrix.cast_permanent_rat] + exact routine.lower hn Aq hAqpos + have hcertUpper : Matrix.permanent + (fun i j ↦ ((Aq i j : ℚ) : ℝ)) ≤ + (preSmoothingBase ε) ^ n * lower := by + rw [← Matrix.cast_permanent_rat] + exact routine.upper hn Aq hAqpos + obtain ⟨hsmoothLower, hsmoothUpper⟩ := + canonical_smoothing_comparison hnpos A hA hmatch χ hχ + have hassembly := assemble_smoothing_and_numerics hε hχ.le hχsmall + hlowerPos hsmoothLower hsmoothUpper hcertLower hcertUpper + have hscale : 0 < ((rationalNormalizationScale A : ℚ) : ℝ) := by + exact_mod_cast rationalNormalizationScale_pos hA + have houtput := cast_completedAlgorithm_of_large_matching routine χ hn A hA hmatch + have hper := cast_permanent_eq_scale_pow_mul_normalized A hA + constructor + · rw [houtput, hper] + have hmul := mul_le_mul_of_nonneg_left hassembly.1 + (pow_nonneg hscale.le n) + simpa [lower, Aq, div_eq_mul_inv, mul_assoc] using hmul + · rw [houtput, hper] + have hmul := mul_le_mul_of_nonneg_left hassembly.2 + (pow_nonneg hscale.le n) + simpa [lower, Aq, div_eq_mul_inv, mul_assoc, mul_left_comm, mul_comm] using hmul + +theorem exactPositiveCertificate_mono + {ε ε' : ℝ} (hε : ε' ≤ ε) + (hcert : ExactPositiveCertificate ε) : + ExactPositiveCertificate ε' := by + intro n hn A hA + obtain ⟨X, hX, hlower, hgap⟩ := hcert hn A hA + refine ⟨X, hX, hlower, hgap.trans ?_⟩ + exact mul_le_mul_of_nonneg_right (by linarith) (Nat.cast_nonneg n) + +theorem one_lt_finalBase_of_le_log_two_half + {ε : ℝ} (hε : 0 < ε) (hbound : ε ≤ Real.log 2 / 2) : + 1 < finalBase ε := by + have hsqrt : 0 < Real.sqrt 2 := Real.sqrt_pos.2 (by norm_num) + have hlog : 0 < Real.log 2 := Real.log_pos (by norm_num) + rw [finalBase, ← Real.exp_log hsqrt, ← Real.exp_add, + Real.log_sqrt (by norm_num : (0 : ℝ) ≤ 2), Real.one_lt_exp_iff] + nlinarith + +theorem cast_permanent_nonnegative + {n : ℕ} (A : Matrix (Fin n) (Fin n) ℚ) + (hA : Matrix.Nonnegative A) : + 0 ≤ ((Matrix.permanent A : ℚ) : ℝ) := by + rw [Matrix.cast_permanent_rat] + apply Matrix.permanent_nonneg_real + intro i j + change 0 ≤ ((A i j : ℚ) : ℝ) + exact_mod_cast hA i j + +/-- All nonnumerical branches of Theorem 1: exact treatment of orders zero +and one, the zero-support case, normalization, smoothing, and rescaling. -/ +theorem completedAlgorithm_guarantee + {ε : ℝ} (hε : 0 < ε) (hεbound : ε ≤ Real.log 2 / 2) + (routine : CertifiedPositiveRoutine ε) (χ : ℚ) + (hχ : 0 < (χ : ℝ)) (hχsmall : (χ : ℝ) ≤ ε / 2) : + ∀ n (A : Matrix (Fin n) (Fin n) ℚ), + Matrix.Nonnegative A → + ((completedAlgorithm routine χ n A : ℚ) : ℝ) ≤ + ((Matrix.permanent A : ℚ) : ℝ) ∧ + ((Matrix.permanent A : ℚ) : ℝ) ≤ + (finalBase ε) ^ n * + ((completedAlgorithm routine χ n A : ℚ) : ℝ) := by + intro n A hA + have hnonnegative : rationalMatrixNonnegativeDecision A = true := + (rationalMatrixNonnegativeDecision_eq_true_iff A).2 hA + by_cases hn : n < 2 + · have hout : completedAlgorithm routine χ n A = Matrix.permanent A := by + simp [completedAlgorithm, hnonnegative, hn] + rw [hout] + refine ⟨le_rfl, ?_⟩ + have hbase : 1 ≤ finalBase ε := + (one_lt_finalBase_of_le_log_two_half hε hεbound).le + have hpow : 1 ≤ (finalBase ε) ^ n := one_le_pow₀ hbase + simpa using mul_le_mul_of_nonneg_right hpow + (cast_permanent_nonnegative A hA) + · have hnlarge : 2 ≤ n := by omega + by_cases hmatch : Matrix.HasPerfectMatching A + · exact completedAlgorithm_guarantee_of_matching hε routine χ hχ + hχsmall hnlarge A hA hmatch + · have hper : Matrix.permanent A = 0 := + Matrix.permanent_eq_zero_of_noPerfectMatching A hmatch + have hdecision : kuhnSupportMatchingDecision A = false := + (kuhnSupportMatchingDecision_eq_false_iff A).2 hmatch + simp [completedAlgorithm, hnonnegative, hn, hdecision, hper] + +/-- The smoothing budget is a fixed rational function of the requested +improvement and is therefore explicit algorithmic data. -/ +def canonicalSmoothingParameter (ε : ℚ) : ℚ := ε / 4 + +theorem canonicalSmoothingParameter_pos {ε : ℚ} (hε : 0 < ε) : + 0 < (canonicalSmoothingParameter ε : ℝ) := by + rw [canonicalSmoothingParameter] + exact_mod_cast div_pos hε (by norm_num : (0 : ℚ) < 4) + +theorem canonicalSmoothingParameter_le_half {ε : ℚ} (hε : 0 < ε) : + (canonicalSmoothingParameter ε : ℝ) ≤ (ε : ℝ) / 2 := by + norm_num [canonicalSmoothingParameter] + have hεreal : 0 ≤ (ε : ℝ) := by exact_mod_cast hε.le + linarith + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/Gain.lean b/LeanPool/BeyondBethe/BeyondBethe/Gain.lean new file mode 100644 index 0000000000..d863282550 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/Gain.lean @@ -0,0 +1,432 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.Capacity +import LeanPool.BeyondBethe.BeyondBethe.Transfer +import Mathlib.Analysis.Convex.SpecificFunctions.Basic +import Mathlib.Tactic + +/-! # Gain -/ + +open scoped BigOperators + +namespace BeyondBethe + +/-- The row factor `ζ_i` from paper (47). -/ +noncomputable def rowZeta + {ι : Type*} [Fintype ι] (τ : ℝ) (p : ι → ℝ) : ℝ := + ∏ j, (p j) ^ (τ * p j) + +theorem rowZeta_pos + {ι : Type*} [Fintype ι] + {τ : ℝ} {p : ι → ℝ} (hp : ∀ j, 0 < p j) : + 0 < rowZeta τ p := by + rw [rowZeta] + exact Finset.prod_pos fun j _ ↦ Real.rpow_pos_of_pos (hp j) _ + +theorem rowZeta_le_one + {ι : Type*} [Fintype ι] [DecidableEq ι] + {τ : ℝ} (hτ : 0 ≤ τ) {p : ι → ℝ} + (hp : IsProbabilityVector p) : + rowZeta τ p ≤ 1 := by + rw [rowZeta] + apply Finset.prod_le_one + · intro j _ + exact Real.rpow_nonneg (hp.nonnegative j) _ + · intro j _ + exact Real.rpow_le_one (hp.nonnegative j) (hp.le_one j) + (mul_nonneg hτ (hp.nonnegative j)) + +noncomputable def outsideMassTwo + {ι : Type*} [Fintype ι] [DecidableEq ι] + (p : ι → ℝ) (a b : ι) : ℝ := + ∑ j ∈ (Finset.univ.erase a).erase b, p j + +theorem outsideMassTwo_comm + {ι : Type*} [Fintype ι] [DecidableEq ι] + (p : ι → ℝ) (a b : ι) : + outsideMassTwo p a b = outsideMassTwo p b a := by + rw [outsideMassTwo, outsideMassTwo] + congr 1 + ext j + simp only [Finset.mem_erase, Finset.mem_univ, and_true] + tauto + +theorem twoCore_add_outsideMassTwo + {ι : Type*} [Fintype ι] [DecidableEq ι] + {p : ι → ℝ} (hp : IsProbabilityVector p) + {a b : ι} (hab : a ≠ b) : + p a + p b + outsideMassTwo p a b = 1 := by + have ha : a ∈ (Finset.univ : Finset ι) := Finset.mem_univ a + have hb : b ∈ (Finset.univ.erase a) := by simp [hab.symm] + have htotal := hp.sum_eq_one + rw [← Finset.sum_erase_add _ _ ha] at htotal + rw [← Finset.sum_erase_add _ _ hb] at htotal + rw [outsideMassTwo] + linarith + +theorem twoCore_add_outsideMassTwo_eq_sum + {ι : Type*} [Fintype ι] [DecidableEq ι] + (p : ι → ℝ) {a b : ι} (hab : a ≠ b) : + p a + p b + outsideMassTwo p a b = ∑ j, p j := by + have ha : a ∈ (Finset.univ : Finset ι) := Finset.mem_univ a + have hb : b ∈ (Finset.univ.erase a) := by simp [hab.symm] + rw [← Finset.sum_erase_add _ _ ha, ← Finset.sum_erase_add _ _ hb, + outsideMassTwo] + ring + +theorem outsideMassTwo_nonneg + {ι : Type*} [Fintype ι] [DecidableEq ι] + {p : ι → ℝ} (hp : IsProbabilityVector p) (a b : ι) : + 0 ≤ outsideMassTwo p a b := by + rw [outsideMassTwo] + exact Finset.sum_nonneg fun j _ ↦ hp.nonnegative j + +theorem productExcept_eq_twoCore + {ι : Type*} [Fintype ι] [DecidableEq ι] + (p : ι → ℝ) {a b : ι} (hab : a ≠ b) : + productExcept p a = (1 - p b) * + ∏ j ∈ (Finset.univ.erase a).erase b, (1 - p j) := by + rw [productExcept] + exact (Finset.mul_prod_erase (Finset.univ.erase a) (fun j ↦ 1 - p j) + (by simp [hab.symm])).symm + +/-- The two upper bounds (45)--(46) used in the leakage argument. -/ +theorem transferU_le_twoCore_ratio + {ι : Type*} [Fintype ι] [DecidableEq ι] + {τ : ℝ} (hτ : 0 ≤ τ) {p : ι → ℝ} + (hp : IsInteriorProbabilityVector p) {a b : ι} (hab : a ≠ b) : + transferU τ p a ≤ + p a / (p a + outsideMassTwo p a b * p b) := by + let s : Finset ι := (Finset.univ.erase a).erase b + let t := outsideMassTwo p a b + have ht : 0 ≤ t := outsideMassTwo_nonneg hp.1 a b + have hsum := twoCore_add_outsideMassTwo hp.1 hab + have houtsideSum : ∑ j ∈ s, p j = t := rfl + have hprodOutside : 1 - t ≤ ∏ j ∈ s, (1 - p j) := by + apply one_sub_sum_le_prod_one_sub s p + · intro j _ + exact hp.1.nonnegative j + · rw [houtsideSum] + linarith [hp.1.nonnegative a, hp.1.nonnegative b] + have hbcomp : 0 < 1 - p b := sub_pos.mpr (hp.2 b).2 + have hdenIdentity : + (1 - p b) * (1 - t) = p a + t * p b := by + linarith + have hdenLower : p a + t * p b ≤ productExcept p a := by + rw [productExcept_eq_twoCore p hab, ← hdenIdentity] + exact mul_le_mul_of_nonneg_left hprodOutside hbcomp.le + have hdenPos : 0 < p a + t * p b := + add_pos_of_pos_of_nonneg (hp.2 a).1 (mul_nonneg ht (hp.1.nonnegative b)) + have hnum : (p a) ^ (1 + τ) ≤ p a := by + have h := Real.rpow_le_rpow_of_exponent_ge' + (hp.1.nonnegative a) (hp.2 a).2.le (by norm_num : (0 : ℝ) ≤ 1) + (by linarith : (1 : ℝ) ≤ 1 + τ) + simpa using h + rw [transferU] + exact div_le_div₀ (hp.1.nonnegative a) hnum hdenPos hdenLower + +/-- Scalar form of the leakage argument in paper (49)--(51). -/ +theorem leakage_le_inv_sub_one + {u xa xb t Ua Ub : ℝ} + (hu : 0 < u) (hu1 : u ≤ 1) + (hxa : 0 < xa) (hxb : 0 < xb) (ht : 0 ≤ t) + (hUa : u ≤ Ua) (hUb : u ≤ Ub) + (hUaUpper : Ua ≤ xa / (xa + t * xb)) + (hUbUpper : Ub ≤ xb / (xb + t * xa)) : + t ≤ u⁻¹ - 1 := by + have hdena : 0 < xa + t * xb := add_pos_of_pos_of_nonneg hxa (mul_nonneg ht hxb.le) + have hdenb : 0 < xb + t * xa := add_pos_of_pos_of_nonneg hxb (mul_nonneg ht hxa.le) + have ha := (hUa.trans hUaUpper) + have hb := (hUb.trans hUbUpper) + rw [le_div_iff₀ hdena] at ha + rw [le_div_iff₀ hdenb] at hb + have ha' : u * t * xb ≤ (1 - u) * xa := by nlinarith + have hb' : u * t * xa ≤ (1 - u) * xb := by nlinarith + have hleft0 : 0 ≤ u * t * xb := by positivity + have hright0 : 0 ≤ (1 - u) * xa := + mul_nonneg (sub_nonneg.mpr hu1) hxa.le + have hmul := mul_le_mul ha' hb' (by positivity) hright0 + have hsq : (u * t) ^ 2 ≤ (1 - u) ^ 2 := by + have hxy : 0 < xa * xb := mul_pos hxa hxb + apply le_of_mul_le_mul_right _ hxy + calc + (u * t) ^ 2 * (xa * xb) = + (u * t * xb) * (u * t * xa) := by ring + _ ≤ ((1 - u) * xa) * ((1 - u) * xb) := hmul + _ = (1 - u) ^ 2 * (xa * xb) := by ring + have hut : 0 ≤ u * t := mul_nonneg hu.le ht + have hone : 0 ≤ 1 - u := sub_nonneg.mpr hu1 + have hutle : u * t ≤ 1 - u := by nlinarith + calc + t ≤ (1 - u) / u := (le_div_iff₀ hu).2 (by simpa [mul_comm] using hutle) + _ = u⁻¹ - 1 := by field_simp + +/-- Paper (47): two large core transfer coordinates force small mass outside +the two core columns. -/ +theorem outsideMassTwo_le_inv_sub_one + {ι : Type*} [Fintype ι] [DecidableEq ι] + {τ u : ℝ} (hτ : 0 ≤ τ) (hu : 0 < u) (hu1 : u ≤ 1) + {p : ι → ℝ} (hp : IsInteriorProbabilityVector p) + {a b : ι} (hab : a ≠ b) + (hUa : u ≤ transferU τ p a) (hUb : u ≤ transferU τ p b) : + outsideMassTwo p a b ≤ u⁻¹ - 1 := by + apply leakage_le_inv_sub_one hu hu1 (hp.2 a).1 (hp.2 b).1 + (outsideMassTwo_nonneg hp.1 a b) hUa hUb + · exact transferU_le_twoCore_ratio hτ hp hab + · have h := transferU_le_twoCore_ratio hτ hp hab.symm + rw [outsideMassTwo_comm p b a] at h + simpa [mul_comm] using h + +theorem log_one_div_nonneg_of_pos_le_one + {u : ℝ} (hu : 0 < u) (hu1 : u ≤ 1) : + 0 ≤ Real.log (1 / u) := by + apply Real.log_nonneg + exact (le_div_iff₀ hu).2 (by simpa using hu1) + +theorem exp_neg_le_of_log_one_div_le + {u κ : ℝ} (hu : 0 < u) + (hcost : Real.log (1 / u) ≤ κ) : + Real.exp (-κ) ≤ u := by + have hlog : -κ ≤ Real.log u := by + rw [one_div, Real.log_inv] at hcost + linarith + have hexp := Real.exp_le_exp.mpr hlog + rw [Real.exp_log hu] at hexp + exact hexp + +noncomputable def fourCoreTransferCost + {ι : Type*} [Fintype ι] [DecidableEq ι] + (τ : ℝ) (X : Matrix ι ι ℝ) (r s a b : ι) : ℝ := + Real.log (1 / transferU τ (X r) a) + + Real.log (1 / transferU τ (X r) b) + + Real.log (1 / transferU τ (X s) a) + + Real.log (1 / transferU τ (X s) b) + +theorem fourCoreTransfer_lower + {ι : Type*} [Fintype ι] [DecidableEq ι] + {τ κ : ℝ} (hτ : 0 ≤ τ) + {X : Matrix ι ι ℝ} (hXint : ∀ i, IsInteriorProbabilityVector (X i)) + {r s a b : ι} + (hcost : fourCoreTransferCost τ X r s a b ≤ κ) : + Real.exp (-κ) ≤ transferU τ (X r) a ∧ + Real.exp (-κ) ≤ transferU τ (X r) b ∧ + Real.exp (-κ) ≤ transferU τ (X s) a ∧ + Real.exp (-κ) ≤ transferU τ (X s) b := by + have hpos : ∀ i j, 0 < transferU τ (X i) j := + fun i j ↦ transferU_pos (hXint i) j + have hle : ∀ i j, transferU τ (X i) j ≤ 1 := + fun i j ↦ transferU_le_one hτ (hXint i) j + have hnonneg : ∀ i j, + 0 ≤ Real.log (1 / transferU τ (X i) j) := + fun i j ↦ log_one_div_nonneg_of_pos_le_one (hpos i j) (hle i j) + rw [fourCoreTransferCost] at hcost + constructor + · apply exp_neg_le_of_log_one_div_le (hpos r a) + linarith [hnonneg r b, hnonneg s a, hnonneg s b] + constructor + · apply exp_neg_le_of_log_one_div_le (hpos r b) + linarith [hnonneg r a, hnonneg s a, hnonneg s b] + constructor + · apply exp_neg_le_of_log_one_div_le (hpos s a) + linarith [hnonneg r a, hnonneg r b, hnonneg s b] + · apply exp_neg_le_of_log_one_div_le (hpos s b) + linarith [hnonneg r a, hnonneg r b, hnonneg s a] + +theorem outsideMassTwo_pairAlpha + {ι : Type*} [Fintype ι] [DecidableEq ι] + (X : Matrix ι ι ℝ) (r s a b : ι) : + outsideMassTwo (pairAlpha X r s) a b = + outsideMassTwo (X r) a b + outsideMassTwo (X s) a b := by + rw [outsideMassTwo, outsideMassTwo, outsideMassTwo] + simp_rw [pairAlpha, Finset.sum_add_distrib] + +/-- Paper (48): a small four-entry transfer cost forces small two-row +leakage. -/ +theorem pairOutsideMass_le_exp + {ι : Type*} [Fintype ι] [DecidableEq ι] + {τ κ : ℝ} (hτ : 0 ≤ τ) (hκ : 0 ≤ κ) + {X : Matrix ι ι ℝ} (hXint : ∀ i, IsInteriorProbabilityVector (X i)) + {r s a b : ι} (hab : a ≠ b) + (hcost : fourCoreTransferCost τ X r s a b ≤ κ) : + outsideMassTwo (pairAlpha X r s) a b ≤ + 2 * (Real.exp κ - 1) := by + have hcore := fourCoreTransfer_lower hτ hXint hcost + have hu : 0 < Real.exp (-κ) := Real.exp_pos _ + have hu1 : Real.exp (-κ) ≤ 1 := by + rw [← Real.exp_zero] + exact Real.exp_le_exp.mpr (by linarith) + have hr := outsideMassTwo_le_inv_sub_one hτ hu hu1 (hXint r) + hab hcore.1 hcore.2.1 + have hs := outsideMassTwo_le_inv_sub_one hτ hu hu1 (hXint s) + hab hcore.2.2.1 hcore.2.2.2 + rw [outsideMassTwo_pairAlpha] + rw [show (Real.exp (-κ))⁻¹ = Real.exp κ by + rw [Real.exp_neg, inv_inv]] at hr hs + linarith + +theorem productExcept_le_one + {ι : Type*} [Fintype ι] [DecidableEq ι] + {p : ι → ℝ} (hp : IsProbabilityVector p) (j : ι) : + productExcept p j ≤ 1 := by + rw [productExcept] + apply Finset.prod_le_one + · intro k _ + exact sub_nonneg.mpr (hp.le_one k) + · intro k _ + linarith [hp.nonnegative k] + +/-- The denominator in `U_ij` is at most one, giving the first inequality in +paper (56). -/ +theorem coordinate_rpow_le_transferU + {ι : Type*} [Fintype ι] [DecidableEq ι] + {τ : ℝ} {p : ι → ℝ} (hp : IsInteriorProbabilityVector p) (j : ι) : + (p j) ^ (1 + τ) ≤ transferU τ p j := by + have hdenPos := productExcept_pos hp j + rw [transferU, le_div_iff₀ hdenPos] + exact mul_le_of_le_one_right (Real.rpow_nonneg (hp.1.nonnegative j) _) + (productExcept_le_one hp.1 j) + +/-- The three kinds of two-column sets used by the capacity witness in paper +(53): the core set, a set using `a` and an outside column, or a set using `b` +and an outside column. -/ +abbrev CapacityWitnessEdge (ι : Type*) := Unit ⊕ (ι ⊕ ι) + +noncomputable def capacityWitnessMass + {ι : Type*} (ρ δa δb : ℝ) (α : ι → ℝ) : + CapacityWitnessEdge ι → ℝ + | Sum.inl _ => 1 - ρ + | Sum.inr (Sum.inl l) => δb / ρ * α l + | Sum.inr (Sum.inr l) => δa / ρ * α l + +theorem capacityWitness_sum + {ι : Type*} [Fintype ι] + {ρ δa δb : ℝ} {α : ι → ℝ} + (hρ : 0 < ρ) (hδ : δa + δb = ρ) + (hαsum : ∑ l, α l = ρ) : + ∑ e, capacityWitnessMass ρ δa δb α e = 1 := by + simp only [capacityWitnessMass, Fintype.sum_sum_type, Fintype.sum_unique] + rw [← Finset.mul_sum, ← Finset.mul_sum, hαsum] + field_simp + linarith + +theorem capacityWitness_nonnegative + {ι : Type*} [Fintype ι] + {ρ δa δb : ℝ} {α : ι → ℝ} + (hρ : 0 < ρ) (hρ1 : ρ ≤ 1) + (hδa : 0 ≤ δa) (hδb : 0 ≤ δb) + (hα : ∀ l, 0 ≤ α l) : + ∀ e, 0 ≤ capacityWitnessMass ρ δa δb α e := by + intro e + rcases e with _ | e + · simp [capacityWitnessMass, sub_nonneg.mpr hρ1] + · rcases e with l | l + · exact mul_nonneg (div_nonneg hδb hρ.le) (hα l) + · exact mul_nonneg (div_nonneg hδa hρ.le) (hα l) + +/-- The witness has the prescribed marginal on every outside column. -/ +theorem capacityWitness_outside_marginal + {ι : Type*} {ρ δa δb : ℝ} {α : ι → ℝ} + (hρ : 0 < ρ) (hδ : δa + δb = ρ) (l : ι) : + capacityWitnessMass ρ δa δb α (Sum.inr (Sum.inl l)) + + capacityWitnessMass ρ δa δb α (Sum.inr (Sum.inr l)) = α l := by + simp only [capacityWitnessMass] + field_simp + rw [add_comm δb δa, hδ] + ring + +/-- The witness has the prescribed marginal on core column `a`. -/ +theorem capacityWitness_coreA_marginal + {ι : Type*} [Fintype ι] + {ρ δa δb αa : ℝ} {α : ι → ℝ} + (hρ : 0 < ρ) (hαsum : ∑ l, α l = ρ) + (hδa : δa + αa = 1) (hδsum : δa + δb = ρ) : + capacityWitnessMass ρ δa δb α (Sum.inl ()) + + ∑ l, capacityWitnessMass ρ δa δb α (Sum.inr (Sum.inl l)) = αa := by + simp only [capacityWitnessMass, ← Finset.mul_sum, hαsum] + field_simp + nlinarith + +/-- The witness has the prescribed marginal on core column `b`. -/ +theorem capacityWitness_coreB_marginal + {ι : Type*} [Fintype ι] + {ρ δa δb αb : ℝ} {α : ι → ℝ} + (hρ : 0 < ρ) (hαsum : ∑ l, α l = ρ) + (hδb : δb + αb = 1) (hδsum : δa + δb = ρ) : + capacityWitnessMass ρ δa δb α (Sum.inl ()) + + ∑ l, capacityWitnessMass ρ δa δb α (Sum.inr (Sum.inr l)) = αb := by + simp only [capacityWitnessMass, ← Finset.mul_sum, hαsum] + field_simp + nlinarith + +/-- Convexity estimate used in paper (56). -/ +theorem two_neg_tau_mul_add_rpow_le + {x y τ : ℝ} (hx : 0 ≤ x) (hy : 0 ≤ y) (hτ : 0 ≤ τ) : + (2 : ℝ) ^ (-τ) * (x + y) ^ (1 + τ) ≤ + x ^ (1 + τ) + y ^ (1 + τ) := by + have hconv := (convexOn_rpow (by linarith : (1 : ℝ) ≤ 1 + τ)).2 + (show x ∈ Set.Ici (0 : ℝ) from hx) + (show y ∈ Set.Ici (0 : ℝ) from hy) + (by norm_num : (0 : ℝ) ≤ 1 / 2) + (by norm_num : (0 : ℝ) ≤ 1 / 2) + (by norm_num : (1 / 2 : ℝ) + 1 / 2 = 1) + have hjensen : + ((x + y) / 2) ^ (1 + τ) ≤ + (x ^ (1 + τ) + y ^ (1 + τ)) / 2 := by + change + ((1 / 2 : ℝ) * x + (1 / 2 : ℝ) * y) ^ (1 + τ) ≤ + (1 / 2 : ℝ) * x ^ (1 + τ) + (1 / 2 : ℝ) * y ^ (1 + τ) at hconv + convert hconv using 1 <;> ring_nf + have hscaled := mul_le_mul_of_nonneg_left hjensen (by norm_num : (0 : ℝ) ≤ 2) + have hleft : + 2 * ((x + y) / 2) ^ (1 + τ) = + (2 : ℝ) ^ (-τ) * (x + y) ^ (1 + τ) := by + rw [Real.div_rpow (add_nonneg hx hy) (by norm_num : (0 : ℝ) ≤ 2)] + rw [Real.rpow_add (by norm_num : (0 : ℝ) < 2), Real.rpow_one] + rw [Real.rpow_neg (by norm_num : (0 : ℝ) ≤ 2)] + field_simp [(Real.rpow_pos_of_pos (by norm_num : (0 : ℝ) < 2) τ).ne'] + rw [hleft] at hscaled + nlinarith + +/-- Paper (56), including both the denominator estimate and the convexity +step. -/ +theorem pairTransferSum_lower + {ι : Type*} [Fintype ι] [DecidableEq ι] + {τ : ℝ} (hτ : 0 ≤ τ) + {p q : ι → ℝ} (hp : IsInteriorProbabilityVector p) + (hq : IsInteriorProbabilityVector q) (j : ι) : + (2 : ℝ) ^ (-τ) * (p j + q j) ^ (1 + τ) ≤ + transferU τ p j + transferU τ q j := by + exact (two_neg_tau_mul_add_rpow_le + (hp.1.nonnegative j) (hq.1.nonnegative j) hτ).trans + (add_le_add (coordinate_rpow_le_transferU hp j) + (coordinate_rpow_le_transferU hq j)) + +/-- Exact cancellation of the two core deficit terms in paper (59)--(61). -/ +theorem core_entropy_cancellation + {δa δb ρ : ℝ} (hδa : 0 < δa) (hδb : 0 < δb) + (hρ : 0 < ρ) (hsum : δa + δb = ρ) : + δa * Real.log δa + δb * Real.log δb - + δa * Real.log (δa / ρ) - δb * Real.log (δb / ρ) = + ρ * Real.log ρ := by + rw [Real.log_div hδa.ne' hρ.ne', Real.log_div hδb.ne' hρ.ne'] + rw [← hsum] + ring + +/-- Elementary outside-coordinate bound used below paper (61). -/ +theorem neg_alpha_le_one_sub_mul_log + {α : ℝ} (hα1 : α < 1) : + -α ≤ (1 - α) * Real.log (1 - α) := by + have hpos : 0 < 1 - α := sub_pos.mpr hα1 + have hlog := Real.one_sub_inv_le_log_of_pos hpos + have hmul := mul_le_mul_of_nonneg_left hlog hpos.le + have hsimplify : (1 - α) * (1 - (1 - α)⁻¹) = -α := by + field_simp + ring + rw [hsimplify] at hmul + exact hmul + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/Gibbs.lean b/LeanPool/BeyondBethe/BeyondBethe/Gibbs.lean new file mode 100644 index 0000000000..b996d04161 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/Gibbs.lean @@ -0,0 +1,265 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.Entropy +import Mathlib.Tactic + +/-! # Gibbs -/ + +open scoped BigOperators + +namespace BeyondBethe + +/-- Weight of a permutation in the permanent expansion. Mathlib's permanent +uses columns as the domain of the permutation and rows as its image. -/ +noncomputable def permutationWeight + {n : Type*} [Fintype n] [DecidableEq n] + (A : Matrix n n ℝ) (σ : Equiv.Perm n) : ℝ := + ∏ j, A (σ j) j + +theorem sum_permutationWeight_eq_permanent + {n : Type*} [Fintype n] [DecidableEq n] + (A : Matrix n n ℝ) : + ∑ σ : Equiv.Perm n, permutationWeight A σ = Matrix.permanent A := by + rfl + +/-- The unnormalized Gibbs marginal that row `i` is matched to column `j`. -/ +noncomputable def marginalNumerator + {n : Type*} [Fintype n] [DecidableEq n] + (A : Matrix n n ℝ) (i j : n) : ℝ := + ∑ σ : Equiv.Perm n, if σ j = i then permutationWeight A σ else 0 + +/-- Assignment marginals of the Gibbs law. -/ +noncomputable def assignmentMarginal + {n : Type*} [Fintype n] [DecidableEq n] + (A : Matrix n n ℝ) (i j : n) : ℝ := + marginalNumerator A i j / Matrix.permanent A + +theorem sum_marginalNumerator_col + {n : Type*} [Fintype n] [DecidableEq n] + (A : Matrix n n ℝ) (j : n) : + ∑ i, marginalNumerator A i j = Matrix.permanent A := by + classical + simp_rw [marginalNumerator] + rw [Finset.sum_comm] + calc + (∑ σ : Equiv.Perm n, + ∑ i : n, if σ j = i then permutationWeight A σ else 0) + = ∑ σ : Equiv.Perm n, permutationWeight A σ := by + apply Finset.sum_congr rfl + intro σ _ + simp + _ = Matrix.permanent A := sum_permutationWeight_eq_permanent A + +theorem sum_marginalNumerator_row + {n : Type*} [Fintype n] [DecidableEq n] + (A : Matrix n n ℝ) (i : n) : + ∑ j, marginalNumerator A i j = Matrix.permanent A := by + classical + simp_rw [marginalNumerator] + rw [Finset.sum_comm] + calc + (∑ σ : Equiv.Perm n, + ∑ j : n, if σ j = i then permutationWeight A σ else 0) + = ∑ σ : Equiv.Perm n, permutationWeight A σ := by + apply Finset.sum_congr rfl + intro σ _ + rw [Finset.sum_eq_single (σ.symm i)] + · simp + · intro j _ hj + have hne : σ j ≠ i := by + intro hji + apply hj + simpa using congrArg σ.symm hji + simp [hne] + · simp + _ = Matrix.permanent A := sum_permutationWeight_eq_permanent A + +theorem assignmentMarginal_nonneg + {n : Type*} [Fintype n] [DecidableEq n] + (A : Matrix n n ℝ) (hA : Matrix.Nonnegative A) + (i j : n) : + 0 ≤ assignmentMarginal A i j := by + unfold assignmentMarginal marginalNumerator + exact div_nonneg + (Finset.sum_nonneg fun σ _ ↦ by + split_ifs + · exact Finset.prod_nonneg fun k _ ↦ hA (σ k) k + · rfl) + (Matrix.permanent_nonneg_real A hA) + +theorem assignmentMarginal_row_sum + {n : Type*} [Fintype n] [DecidableEq n] + (A : Matrix n n ℝ) (hper : Matrix.permanent A ≠ 0) (i : n) : + ∑ j, assignmentMarginal A i j = 1 := by + simp_rw [assignmentMarginal] + rw [← Finset.sum_div, sum_marginalNumerator_row] + exact div_self hper + +theorem assignmentMarginal_col_sum + {n : Type*} [Fintype n] [DecidableEq n] + (A : Matrix n n ℝ) (hper : Matrix.permanent A ≠ 0) (j : n) : + ∑ i, assignmentMarginal A i j = 1 := by + simp_rw [assignmentMarginal] + rw [← Finset.sum_div, sum_marginalNumerator_col] + exact div_self hper + +theorem assignmentMarginal_doublyStochastic + {n : Type*} [Fintype n] [DecidableEq n] + (A : Matrix n n ℝ) (hA : Matrix.Nonnegative A) + (hper : Matrix.permanent A ≠ 0) : + IsDoublyStochastic (assignmentMarginal A) := by + exact ⟨assignmentMarginal_nonneg A hA, + assignmentMarginal_row_sum A hper, + assignmentMarginal_col_sum A hper⟩ + +/-- Gibbs probability of a permutation. -/ +noncomputable def gibbsProbability + {n : Type*} [Fintype n] [DecidableEq n] + (A : Matrix n n ℝ) (σ : Equiv.Perm n) : ℝ := + permutationWeight A σ / Matrix.permanent A + +theorem permutationWeight_pos + {n : Type*} [Fintype n] [DecidableEq n] + (A : Matrix n n ℝ) (hA : ∀ i j, 0 < A i j) + (σ : Equiv.Perm n) : + 0 < permutationWeight A σ := by + rw [permutationWeight] + exact Finset.prod_pos fun j _ ↦ hA (σ j) j + +theorem permanent_pos_of_positive + {n : Type*} [Fintype n] [DecidableEq n] + (A : Matrix n n ℝ) (hA : ∀ i j, 0 < A i j) : + 0 < Matrix.permanent A := by + rw [← sum_permutationWeight_eq_permanent A] + exact Finset.sum_pos (fun σ _ ↦ permutationWeight_pos A hA σ) + ⟨Equiv.refl n, Finset.mem_univ _⟩ + +theorem assignmentMarginal_pos + {n : Type*} [Fintype n] [DecidableEq n] + (A : Matrix n n ℝ) (hA : ∀ i j, 0 < A i j) + (i j : n) : + 0 < assignmentMarginal A i j := by + have hper := permanent_pos_of_positive A hA + apply div_pos _ hper + rw [marginalNumerator] + apply Finset.sum_pos' + · intro σ _ + split_ifs + · exact (permutationWeight_pos A hA σ).le + · rfl + · refine ⟨Equiv.swap j i, Finset.mem_univ _, ?_⟩ + simp only [Equiv.swap_apply_left, if_pos] + exact permutationWeight_pos A hA (Equiv.swap j i) + +theorem assignmentMarginal_strictProbabilityVector + {n : Type*} [Fintype n] [DecidableEq n] + (A : Matrix n n ℝ) (hA : ∀ i j, 0 < A i j) (i : n) : + IsStrictProbabilityVector (assignmentMarginal A i) := by + have hper := permanent_pos_of_positive A hA + exact ⟨ + (assignmentMarginal_doublyStochastic A + (fun r c ↦ (hA r c).le) hper.ne').row_probability i, + assignmentMarginal_pos A hA i⟩ + +theorem gibbsProbability_pos + {n : Type*} [Fintype n] [DecidableEq n] + (A : Matrix n n ℝ) (hA : ∀ i j, 0 < A i j) + (σ : Equiv.Perm n) : + 0 < gibbsProbability A σ := by + exact div_pos (permutationWeight_pos A hA σ) + (permanent_pos_of_positive A hA) + +theorem gibbsProbability_isProbabilityVector + {n : Type*} [Fintype n] [DecidableEq n] + (A : Matrix n n ℝ) (hA : ∀ i j, 0 < A i j) : + IsProbabilityVector (gibbsProbability A) := by + constructor + · intro σ + exact (gibbsProbability_pos A hA σ).le + · simp_rw [gibbsProbability] + rw [← Finset.sum_div, + sum_permutationWeight_eq_permanent, + div_self (permanent_pos_of_positive A hA).ne'] + +theorem assignmentMarginal_eq_gibbs_sum + {n : Type*} [Fintype n] [DecidableEq n] + (A : Matrix n n ℝ) (i j : n) : + assignmentMarginal A i j = + ∑ σ : Equiv.Perm n, + if σ j = i then gibbsProbability A σ else 0 := by + unfold assignmentMarginal marginalNumerator gibbsProbability + rw [Finset.sum_div] + apply Finset.sum_congr rfl + intro σ _ + split_ifs <;> simp + +/-- Expectation under a column marginal, written either over rows or over +permutations. -/ +theorem assignmentMarginal_expectation_col + {n : Type*} [Fintype n] [DecidableEq n] + (A : Matrix n n ℝ) (f : n → ℝ) (j : n) : + ∑ i, assignmentMarginal A i j * f i = + ∑ σ : Equiv.Perm n, gibbsProbability A σ * f (σ j) := by + classical + simp_rw [assignmentMarginal_eq_gibbs_sum] + simp_rw [Finset.sum_mul] + rw [Finset.sum_comm] + apply Finset.sum_congr rfl + intro σ _ + rw [Finset.sum_eq_single (σ j)] + · simp + · intro i _ hi + have hne : σ j ≠ i := Ne.symm hi + simp [hne] + · simp + +theorem log_permutationWeight + {n : Type*} [Fintype n] [DecidableEq n] + (A : Matrix n n ℝ) (hA : ∀ i j, 0 < A i j) + (σ : Equiv.Perm n) : + Real.log (permutationWeight A σ) = + ∑ j, Real.log (A (σ j) j) := by + rw [permutationWeight, Real.log_prod] + intro j _ + exact (hA (σ j) j).ne' + +/-- Entropy identity for the Gibbs law, used in paper Lemma 10. -/ +theorem gibbsEntropy_identity + {n : Type*} [Fintype n] [DecidableEq n] + (A : Matrix n n ℝ) (hA : ∀ i j, 0 < A i j) : + shannonEntropy (gibbsProbability A) = + Real.log (Matrix.permanent A) - + ∑ i, ∑ j, assignmentMarginal A i j * Real.log (A i j) := by + have hper : 0 < Matrix.permanent A := permanent_pos_of_positive A hA + have hμsum := (gibbsProbability_isProbabilityVector A hA).sum_eq_one + have hentry : ∀ σ : Equiv.Perm n, + Real.negMulLog (gibbsProbability A σ) = + gibbsProbability A σ * Real.log (Matrix.permanent A) - + gibbsProbability A σ * Real.log (permutationWeight A σ) := by + intro σ + have hw := permutationWeight_pos A hA σ + simp only [Real.negMulLog_def] + rw [gibbsProbability, Real.log_div hw.ne' hper.ne'] + ring + rw [shannonEntropy] + simp_rw [hentry] + rw [Finset.sum_sub_distrib, ← Finset.sum_mul, hμsum, one_mul] + simp_rw [log_permutationWeight A hA, Finset.mul_sum] + apply congrArg (fun x ↦ Real.log (Matrix.permanent A) - x) + calc + ∑ σ, ∑ j, gibbsProbability A σ * Real.log (A (σ j) j) = + ∑ j, ∑ σ, gibbsProbability A σ * Real.log (A (σ j) j) := + Finset.sum_comm + _ = ∑ j, ∑ i, assignmentMarginal A i j * Real.log (A i j) := by + apply Finset.sum_congr rfl + intro j _ + exact (assignmentMarginal_expectation_col A + (fun i ↦ Real.log (A i j)) j).symm + _ = ∑ i, ∑ j, assignmentMarginal A i j * Real.log (A i j) := + Finset.sum_comm + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/GoodRowScore.lean b/LeanPool/BeyondBethe/BeyondBethe/GoodRowScore.lean new file mode 100644 index 0000000000..3632a5b06d --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/GoodRowScore.lean @@ -0,0 +1,775 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.Cycles +import Mathlib.Analysis.SpecialFunctions.BinaryEntropy +import Mathlib.Tactic + +/-! # Good Row Score -/ + +open scoped BigOperators Topology +open Filter + +namespace BeyondBethe + +/-- A genuinely continuous formula for the suffix error near every point +`(a,x)` with `a+x != 0`. On the nonnegative quadrant it agrees with +`suffixError`; the rewrite removes the apparent singularity at `x=0`. -/ +noncomputable def continuousSuffixError (a x : ℝ) : ℝ := + a - x * Real.log (a + x) - Real.negMulLog x + +theorem suffixError_eq_continuousSuffixError + {a x : ℝ} (ha : 0 ≤ a) (hx : 0 ≤ x) : + suffixError a x = continuousSuffixError a x := by + by_cases hx0 : x = 0 + · subst x + simp [suffixError, continuousSuffixError] + · have hxpos : 0 < x := lt_of_le_of_ne hx (Ne.symm hx0) + have hsum : a + x ≠ 0 := (add_pos_of_nonneg_of_pos ha hxpos).ne' + have hratio : 1 + a / x = (a + x) / x := by + field_simp + ring + rw [suffixError, continuousSuffixError, hratio, + Real.log_div hsum hx0, Real.negMulLog_def] + ring + +theorem continuousAt_continuousSuffixError + {a x : ℝ} (hsum : a + x ≠ 0) : + ContinuousAt + (fun z : ℝ × ℝ ↦ continuousSuffixError z.1 z.2) (a, x) := by + unfold continuousSuffixError + fun_prop + +/-- The paper's assertion that `e(a,x)` is continuous is a statement on the +nonnegative quadrant. This is the exact domain-qualified version. -/ +theorem continuousWithinAt_suffixError_nonnegative + {a x : ℝ} (ha : 0 ≤ a) (hx : 0 ≤ x) (hsum : a + x ≠ 0) : + ContinuousWithinAt + (fun z : ℝ × ℝ ↦ suffixError z.1 z.2) + (Set.Ici 0 ×ˢ Set.Ici 0) (a, x) := by + apply (continuousAt_continuousSuffixError hsum).continuousWithinAt.congr_of_mem + · intro z hz + exact suffixError_eq_continuousSuffixError hz.1 hz.2 + · exact ⟨ha, hx⟩ + +theorem binaryEntropy_eq_realBinEntropy (t : ℝ) : + binaryEntropy t = Real.binEntropy t := by + rw [binaryEntropy, Real.binEntropy_eq_negMulLog_add_negMulLog_one_sub] + +theorem continuous_binaryEntropy : Continuous binaryEntropy := by + apply Continuous.congr Real.binEntropy_continuous + exact fun t ↦ (binaryEntropy_eq_realBinEntropy t).symm + +/-- The scalar lower bound `Psi` in paper (28). -/ +noncomputable def goodRowPsi (u v q : ℝ) : ℝ := + (1 - q) * binaryEntropy (u / (1 - q)) - 1 + + (1 / 2) * + (suffixError u q + suffixError u (v + q) + + suffixError v q + suffixError v (u + q)) + +/-- A continuous local representative of `goodRowPsi`. -/ +noncomputable def continuousGoodRowPsi (u v q : ℝ) : ℝ := + (1 - q) * Real.binEntropy (u / (1 - q)) - 1 + + (1 / 2) * + (continuousSuffixError u q + continuousSuffixError u (v + q) + + continuousSuffixError v q + continuousSuffixError v (u + q)) + +theorem goodRowPsi_eq_continuousGoodRowPsi + {u v q : ℝ} (hu : 0 ≤ u) (hv : 0 ≤ v) (hq : 0 ≤ q) : + goodRowPsi u v q = continuousGoodRowPsi u v q := by + rw [goodRowPsi, continuousGoodRowPsi, binaryEntropy_eq_realBinEntropy, + suffixError_eq_continuousSuffixError hu hq, + suffixError_eq_continuousSuffixError hu (add_nonneg hv hq), + suffixError_eq_continuousSuffixError hv hq, + suffixError_eq_continuousSuffixError hv (add_nonneg hu hq)] + +theorem continuousAt_continuousGoodRowPsi_half_half_zero : + ContinuousAt + (fun z : ℝ × (ℝ × ℝ) ↦ + continuousGoodRowPsi z.1 z.2.1 z.2.2) + (1 / 2, (1 / 2, 0)) := by + unfold continuousGoodRowPsi continuousSuffixError + fun_prop (disch := norm_num) + +/-- Exact domain-qualified continuity statement used in the compactness +argument for paper Lemma 12. -/ +theorem continuousWithinAt_goodRowPsi_half_half_zero : + ContinuousWithinAt + (fun z : ℝ × (ℝ × ℝ) ↦ goodRowPsi z.1 z.2.1 z.2.2) + (Set.Ici 0 ×ˢ (Set.Ici 0 ×ˢ Set.Ici 0)) + (1 / 2, (1 / 2, 0)) := by + apply continuousAt_continuousGoodRowPsi_half_half_zero.continuousWithinAt.congr_of_mem + · intro z hz + exact goodRowPsi_eq_continuousGoodRowPsi hz.1 hz.2.1 hz.2.2 + · norm_num + +/-- The half--half row produces exactly half a bit of score after paying for +the one ambiguity bit of its core component. -/ +theorem goodRowPsi_half_half_zero : + goodRowPsi (1 / 2) (1 / 2) 0 = Real.log 2 / 2 := by + rw [goodRowPsi, binaryEntropy_eq_realBinEntropy] + norm_num [suffixError] + rw [show (1 / 2 : ℝ) = 2⁻¹ by norm_num, Real.binEntropy_two_inv] + ring + +/-- Relative order of two coordinates in an ordering. -/ +def CoordinateBefore {n : ℕ} (a b : Fin n) (π : Equiv.Perm (Fin n)) : Prop := + π.symm a < π.symm b + +instance instDecidableCoordinateBefore + {n : ℕ} (a b : Fin n) (π : Equiv.Perm (Fin n)) : + Decidable (CoordinateBefore a b π) := by + unfold CoordinateBefore + infer_instance + +noncomputable def coordinateBeforeProbability + {n : ℕ} (a b : Fin n) : ℝ := + uniformAverage fun π : Equiv.Perm (Fin n) ↦ + if CoordinateBefore a b π then 1 else 0 + +theorem coordinateBefore_trans_swap + {n : ℕ} (a b : Fin n) (π : Equiv.Perm (Fin n)) : + CoordinateBefore a b (π.trans (Equiv.swap a b)) ↔ + CoordinateBefore b a π := by + simp [CoordinateBefore, Equiv.trans_apply, Equiv.swap_apply_def] + +theorem coordinateBeforeProbability_symm + {n : ℕ} (a b : Fin n) : + coordinateBeforeProbability a b = coordinateBeforeProbability b a := by + let f : Equiv.Perm (Fin n) → ℝ := fun π ↦ + if CoordinateBefore a b π then 1 else 0 + calc + coordinateBeforeProbability a b = uniformAverage f := rfl + _ = uniformAverage (fun π : Equiv.Perm (Fin n) ↦ + f (π.trans (Equiv.swap a b))) := + (uniformAverage_perm_trans f (Equiv.swap a b)).symm + _ = coordinateBeforeProbability b a := by + apply congrArg uniformAverage + funext π + exact if_congr (coordinateBefore_trans_swap a b π) rfl rfl + +theorem coordinateBeforeProbability_add_reverse + {n : ℕ} {a b : Fin n} (hab : a ≠ b) : + coordinateBeforeProbability a b + coordinateBeforeProbability b a = 1 := by + rw [coordinateBeforeProbability, coordinateBeforeProbability, + ← uniformAverage_add] + calc + uniformAverage (fun π : Equiv.Perm (Fin n) ↦ + (if CoordinateBefore a b π then (1 : ℝ) else 0) + + if CoordinateBefore b a π then 1 else 0) = + uniformAverage (fun _ : Equiv.Perm (Fin n) ↦ (1 : ℝ)) := by + apply congrArg uniformAverage + funext π + have hne : π.symm a ≠ π.symm b := π.symm.injective.ne hab + rcases lt_or_gt_of_ne hne with h | h <;> + simp [CoordinateBefore, h, not_lt_of_ge h.le] + _ = 1 := uniformAverage_const 1 + +theorem coordinateBeforeProbability_eq_half + {n : ℕ} {a b : Fin n} (hab : a ≠ b) : + coordinateBeforeProbability a b = 1 / 2 := by + have hsymm := coordinateBeforeProbability_symm a b + have hsum := coordinateBeforeProbability_add_reverse hab + linarith + +theorem strictRightMass_nonneg + {n : ℕ} {p : Fin n → ℝ} (hp : IsProbabilityVector p) + (π : Equiv.Perm (Fin n)) (a : Fin n) : + 0 ≤ strictRightMass p π a := by + unfold strictRightMass + exact Finset.sum_nonneg fun j _ ↦ by + split_ifs <;> simp_all [hp.nonnegative j] + +theorem strictRightMass_le_one_sub + {n : ℕ} {p : Fin n → ℝ} (hp : IsProbabilityVector p) + (π : Equiv.Perm (Fin n)) (a : Fin n) : + strictRightMass p π a ≤ 1 - p a := by + have hleft : 0 ≤ strictLeftMass p π a := by + unfold strictLeftMass + exact Finset.sum_nonneg fun j _ ↦ by + split_ifs <;> simp_all [hp.nonnegative j] + linarith [strictLeftMass_add_strictRightMass hp π a] + +/-- If `b` lies before `a`, the mass after `a` can contain only coordinates +outside the pair `{a,b}`. -/ +theorem strictRightMass_le_outside_of_before + {n : ℕ} {p : Fin n → ℝ} (hp : IsProbabilityVector p) + {π : Equiv.Perm (Fin n)} {a b : Fin n} (hab : a ≠ b) + (hbefore : CoordinateBefore b a π) : + strictRightMass p π a ≤ 1 - p a - p b := by + rw [← sum_away_from_two hp hab] + unfold strictRightMass + apply Finset.sum_le_sum + intro j _ + by_cases haj : a = j + · subst j + simp + by_cases hbj : b = j + · subst j + have hnot : ¬π.symm a < π.symm b := + not_lt_of_ge hbefore.le + simp [hnot] + · by_cases horder : π.symm a < π.symm j + · simp [haj, hbj, horder, hp.nonnegative j] + · simp [haj, hbj, horder, hp.nonnegative j] + +theorem uniformAverage_mono + {α : Type*} [Fintype α] {f g : α → ℝ} + (hfg : ∀ x, f x ≤ g x) : + uniformAverage f ≤ uniformAverage g := by + unfold uniformAverage + exact div_le_div_of_nonneg_right + (Finset.sum_le_sum fun x _ ↦ hfg x) (Nat.cast_nonneg _) + +theorem uniformAverage_ite_const + {α : Type*} [Fintype α] [Nonempty α] + (P : α → Prop) [DecidablePred P] (a b : ℝ) : + uniformAverage (fun x ↦ if P x then a else b) = + b + (a - b) * uniformAverage (fun x ↦ if P x then 1 else 0) := by + calc + uniformAverage (fun x ↦ if P x then a else b) = + uniformAverage (fun x ↦ + b + (a - b) * if P x then (1 : ℝ) else 0) := by + apply congrArg uniformAverage + funext x + by_cases hx : P x <;> simp [hx] + _ = uniformAverage (fun _ : α ↦ b) + + uniformAverage (fun x ↦ + (a - b) * if P x then (1 : ℝ) else 0) := + uniformAverage_add _ _ + _ = b + (a - b) * uniformAverage + (fun x ↦ if P x then (1 : ℝ) else 0) := by + rw [uniformAverage_const, uniformAverage_const_mul] + +theorem listSuffixErrorSum_ofFn + {n : ℕ} (f : Fin n → ℝ) : + listSuffixErrorSum (List.ofFn f) = + ∑ t, suffixError (f t) (∑ k, if t < k then f k else 0) := by + induction n with + | zero => simp [listSuffixErrorSum] + | succ n ih => + rw [List.ofFn_succ, listSuffixErrorSum, Fin.sum_univ_succ, + ih (fun k ↦ f k.succ)] + congr 1 + · congr 1 + rw [List.sum_ofFn, Fin.sum_univ_succ] + simp + · apply Finset.sum_congr rfl + intro t _ + congr 1 + rw [Fin.sum_univ_succ] + simp + +theorem orderedStrictRightMass_eq + {n : ℕ} (p : Fin n → ℝ) (π : Equiv.Perm (Fin n)) (t : Fin n) : + (∑ k, if t < k then p (π k) else 0) = + strictRightMass p π (π t) := by + unfold strictRightMass + calc + (∑ k, if t < k then p (π k) else 0) = + ∑ k, if π.symm (π t) < π.symm (π k) then p (π k) else 0 := by + simp + _ = ∑ j, if π.symm (π t) < π.symm j then p j else 0 := + Equiv.sum_comp π + (fun j ↦ if π.symm (π t) < π.symm j then p j else 0) + +theorem listSuffixErrorSum_ofFn_eq_ordered_errors + {n : ℕ} (p : Fin n → ℝ) (π : Equiv.Perm (Fin n)) : + listSuffixErrorSum (List.ofFn (fun t ↦ p (π t))) = + ∑ j, suffixError (p j) (strictRightMass p π j) := by + rw [listSuffixErrorSum_ofFn] + calc + (∑ t, suffixError (p (π t)) + (∑ k, if t < k then p (π k) else 0)) = + ∑ t, suffixError (p (π t)) (strictRightMass p π (π t)) := by + apply Finset.sum_congr rfl + intro t _ + rw [orderedStrictRightMass_eq] + _ = ∑ j, suffixError (p j) (strictRightMass p π j) := + Equiv.sum_comp π (fun j ↦ suffixError (p j) (strictRightMass p π j)) + +theorem fixed_order_suffixScore_eq_neg_one_add_errors + {n : ℕ} {p : Fin n → ℝ} + (hp : IsProbabilityVector p) (π : Equiv.Perm (Fin n)) : + (∑ j, p j * Real.log (suffixMass p π j)) = + -1 + ∑ j, suffixError (p j) (strictRightMass p π j) := by + rw [← listSuffixScore_ofFn_eq_ordered_score, + ← listSuffixErrorSum_ofFn_eq_ordered_errors] + apply listSuffixScore_eq_neg_one_add_errors + · intro x hx + simp only [List.mem_ofFn] at hx + obtain ⟨t, rfl⟩ := hx + exact hp.nonnegative (π t) + · rw [List.sum_ofFn] + exact (Equiv.sum_comp π p).trans hp.sum_eq_one + +theorem rowT_ge_core_errors + {n : ℕ} {p : Fin n → ℝ} (hp : IsProbabilityVector p) + {a b : Fin n} (hab : a ≠ b) : + -1 + uniformAverage (fun π : Equiv.Perm (Fin n) ↦ + suffixError (p a) (strictRightMass p π a) + + suffixError (p b) (strictRightMass p π b)) ≤ rowT p := by + rw [rowT] + calc + -1 + uniformAverage (fun π : Equiv.Perm (Fin n) ↦ + suffixError (p a) (strictRightMass p π a) + + suffixError (p b) (strictRightMass p π b)) ≤ + -1 + uniformAverage (fun π : Equiv.Perm (Fin n) ↦ + ∑ j, suffixError (p j) (strictRightMass p π j)) := by + gcongr + apply uniformAverage_mono + intro π + calc + suffixError (p a) (strictRightMass p π a) + + suffixError (p b) (strictRightMass p π b) = + ∑ j ∈ ({a, b} : Finset (Fin n)), + suffixError (p j) (strictRightMass p π j) := by + rw [Finset.sum_pair hab] + _ ≤ ∑ j, suffixError (p j) (strictRightMass p π j) := by + apply Finset.sum_le_sum_of_subset_of_nonneg (Finset.subset_univ _) + intro j _ _ + exact suffixError_nonneg (hp.nonnegative j) + (strictRightMass_nonneg hp π j) + _ = uniformAverage (fun π : Equiv.Perm (Fin n) ↦ + ∑ j, p j * Real.log (suffixMass p π j)) := by + rw [← uniformAverage_const + (α := Equiv.Perm (Fin n)) (-1), ← uniformAverage_add] + apply congrArg uniformAverage + funext π + exact (fixed_order_suffixScore_eq_neg_one_add_errors hp π).symm + +/-- Each core coordinate sees only outside mass when the other core +coordinate precedes it, an event of probability exactly one half. -/ +theorem average_suffixError_core_lower + {n : ℕ} {p : Fin n → ℝ} (hp : IsProbabilityVector p) + {a b : Fin n} (hab : a ≠ b) : + (1 / 2) * + (suffixError (p a) (1 - p a - p b) + + suffixError (p a) (p b + (1 - p a - p b))) ≤ + uniformAverage (fun π : Equiv.Perm (Fin n) ↦ + suffixError (p a) (strictRightMass p π a)) := by + let q : ℝ := 1 - p a - p b + have hq : 0 ≤ q := by + change 0 ≤ 1 - p a - p b + rw [← sum_away_from_two hp hab] + exact Finset.sum_nonneg fun j _ ↦ by + by_cases h : a ≠ j ∧ b ≠ j <;> simp [h, hp.nonnegative j] + have hpoint : ∀ π : Equiv.Perm (Fin n), + (if CoordinateBefore b a π then suffixError (p a) q + else suffixError (p a) (p b + q)) ≤ + suffixError (p a) (strictRightMass p π a) := by + intro π + have hright0 := strictRightMass_nonneg hp π a + by_cases hbefore : CoordinateBefore b a π + · rw [if_pos hbefore] + exact suffixError_anti (hp.nonnegative a) hright0 + (strictRightMass_le_outside_of_before hp hab hbefore) + · rw [if_neg hbefore] + have hright := strictRightMass_le_one_sub hp π a + have hmass : p b + q = 1 - p a := by + dsimp [q] + ring + rw [hmass] + exact suffixError_anti (hp.nonnegative a) hright0 hright + calc + (1 / 2) * + (suffixError (p a) (1 - p a - p b) + + suffixError (p a) (p b + (1 - p a - p b))) = + uniformAverage (fun π : Equiv.Perm (Fin n) ↦ + if CoordinateBefore b a π then suffixError (p a) q + else suffixError (p a) (p b + q)) := by + rw [uniformAverage_ite_const] + change _ = _ + _ * coordinateBeforeProbability b a + rw [coordinateBeforeProbability_eq_half (Ne.symm hab)] + dsimp [q] + ring + _ ≤ uniformAverage (fun π : Equiv.Perm (Fin n) ↦ + suffixError (p a) (strictRightMass p π a)) := + uniformAverage_mono hpoint + +/-- Averaged two-core suffix-error estimate in paper (28), separated from +the entropy coarsening identity. -/ +theorem rowT_ge_two_core_suffix_bound + {n : ℕ} {p : Fin n → ℝ} (hp : IsProbabilityVector p) + {a b : Fin n} (hab : a ≠ b) : + -1 + (1 / 2) * + (suffixError (p a) (1 - p a - p b) + + suffixError (p a) (p b + (1 - p a - p b)) + + suffixError (p b) (1 - p a - p b) + + suffixError (p b) (p a + (1 - p a - p b))) ≤ + rowT p := by + have ha := average_suffixError_core_lower hp hab + have hb0 := average_suffixError_core_lower hp (Ne.symm hab) + have hb : (1 / 2) * + (suffixError (p b) (1 - p a - p b) + + suffixError (p b) (p a + (1 - p a - p b))) ≤ + uniformAverage (fun π : Equiv.Perm (Fin n) ↦ + suffixError (p b) (strictRightMass p π b)) := by + convert hb0 using 1 <;> ring + have hcore := rowT_ge_core_errors hp hab + rw [uniformAverage_add] at hcore + nlinarith + +/-- Entropy after merging the two core outcomes into one atom while leaving +every outside outcome distinct. -/ +noncomputable def twoCoreCoarsenedEntropy + {n : ℕ} (p : Fin n → ℝ) (a b : Fin n) : ℝ := + Real.negMulLog (p a + p b) + + ∑ j, if a ≠ j ∧ b ≠ j then Real.negMulLog (p j) else 0 + +theorem sum_eq_two_add_away + {ι : Type*} [Fintype ι] [DecidableEq ι] + (f : ι → ℝ) {a b : ι} (hab : a ≠ b) : + (∑ j, f j) = f a + f b + + ∑ j, if a ≠ j ∧ b ≠ j then f j else 0 := by + calc + (∑ j, f j) = + ∑ j, ((if j = a then f j else 0) + + (if j = b then f j else 0) + + (if a ≠ j ∧ b ≠ j then f j else 0)) := by + apply Finset.sum_congr rfl + intro j _ + by_cases hja : j = a + · subst j + simp [hab] + · by_cases hjb : j = b + · subst j + simp [hja] + · simp [hja, hjb, Ne.symm hja, Ne.symm hjb] + _ = f a + f b + + ∑ j, if a ≠ j ∧ b ≠ j then f j else 0 := by + simp_rw [Finset.sum_add_distrib] + simp + +theorem entropy_sub_twoCoreCoarsenedEntropy + {n : ℕ} (p : Fin n → ℝ) {a b : Fin n} (hab : a ≠ b) : + shannonEntropy p - twoCoreCoarsenedEntropy p a b = + Real.negMulLog (p a) + Real.negMulLog (p b) - + Real.negMulLog (p a + p b) := by + rw [shannonEntropy, twoCoreCoarsenedEntropy, + sum_eq_two_add_away (fun j ↦ Real.negMulLog (p j)) hab] + ring + +/-- Exact entropy loss from the paper's two-core coarsening, in the +`(u,v,q)` coordinates used to define `Psi`. -/ +theorem entropy_sub_twoCoreCoarsenedEntropy_eq + {n : ℕ} {p : Fin n → ℝ} (hp : IsStrictProbabilityVector p) + {a b : Fin n} (hab : a ≠ b) : + shannonEntropy p - twoCoreCoarsenedEntropy p a b = + (1 - (1 - p a - p b)) * + binaryEntropy (p a / (1 - (1 - p a - p b))) := by + rw [entropy_sub_twoCoreCoarsenedEntropy p hab, + entropy_loss_merge_two (hp.positive a) (hp.positive b)] + ring_nf + +/-- Paper inequality (28), now including both the entropy-coarsening identity +and the exact permutation-pairing argument for the suffix score. -/ +theorem rowScore_sub_twoCoreCoarsenedEntropy_ge_Psi + {n : ℕ} {p : Fin n → ℝ} (hp : IsStrictProbabilityVector p) + {a b : Fin n} (hab : a ≠ b) : + goodRowPsi (p a) (p b) (1 - p a - p b) ≤ + rowScore p - twoCoreCoarsenedEntropy p a b := by + have hentropy := entropy_sub_twoCoreCoarsenedEntropy_eq hp hab + have hsuffix := rowT_ge_two_core_suffix_bound hp.probability hab + rw [rowScore, goodRowPsi] + linarith [hentropy] + +abbrev GoodRowTriple := ℝ × (ℝ × ℝ) + +noncomputable def goodRowCenter : GoodRowTriple := (1 / 2, (1 / 2, 0)) + +/-- Clamp the radius to the interval on which the paper uses the good-row +estimate. This makes the modulus defined on all real inputs without changing +it on `[0,1/10]`. -/ +noncomputable def goodRowRadius (η : ℝ) : ℝ := max 0 (min η (1 / 10)) + +theorem goodRowRadius_nonneg (η : ℝ) : 0 ≤ goodRowRadius η := by + simp [goodRowRadius] + +theorem goodRowRadius_le_tenth (η : ℝ) : goodRowRadius η ≤ 1 / 10 := by + rw [goodRowRadius, max_le_iff] + constructor + · norm_num + · exact min_le_right _ _ + +theorem goodRowRadius_le_abs (η : ℝ) : goodRowRadius η ≤ |η| := by + by_cases hη : 0 ≤ η + · rw [abs_of_nonneg hη, goodRowRadius, max_le_iff] + exact ⟨hη, min_le_left _ _⟩ + · have hη' : η ≤ 0 := le_of_not_ge hη + have hmin : min η (1 / 10) ≤ 0 := (min_le_left _ _).trans hη' + rw [goodRowRadius, max_eq_left hmin] + exact abs_nonneg η + +theorem goodRowRadius_eq { η : ℝ } (hη₀ : 0 ≤ η) (hη₁ : η ≤ 1 / 10) : + goodRowRadius η = η := by + unfold goodRowRadius + rw [min_eq_left hη₁, max_eq_right hη₀] + +theorem monotone_goodRowRadius : Monotone goodRowRadius := by + intro η θ hηθ + exact max_le_max le_rfl (min_le_min hηθ le_rfl) + +theorem goodRowTriple_bounds_of_mem_closedBall + {z : GoodRowTriple} + (hz : z ∈ Metric.closedBall goodRowCenter (1 / 10)) : + 2 / 5 ≤ z.1 ∧ z.1 ≤ 3 / 5 ∧ + 2 / 5 ≤ z.2.1 ∧ z.2.1 ≤ 3 / 5 ∧ + -(1 / 10) ≤ z.2.2 ∧ z.2.2 ≤ 1 / 10 := by + rw [Metric.mem_closedBall, Prod.dist_eq, max_le_iff, + Prod.dist_eq, max_le_iff, Real.dist_eq, Real.dist_eq, + Real.dist_eq] at hz + rcases hz with ⟨hu, hv, hq⟩ + have hu' := abs_le.mp hu + have hv' := abs_le.mp hv + have hq' := abs_le.mp hq + dsimp [goodRowCenter] at hu' hv' hq' + norm_num at hu' hv' hq' ⊢ + refine ⟨?_, ?_, ?_, ?_, ?_, ?_⟩ <;> + linarith [hu'.1, hu'.2, hv'.1, hv'.2, hq'.1, hq'.2] + +theorem continuousOn_continuousGoodRowPsi_closedBall : + ContinuousOn + (fun z : GoodRowTriple ↦ continuousGoodRowPsi z.1 z.2.1 z.2.2) + (Metric.closedBall goodRowCenter (1 / 10)) := by + intro z hz + have hb := goodRowTriple_bounds_of_mem_closedBall hz + have hden : 1 - z.2.2 ≠ 0 := by + have : 0 < 1 - z.2.2 := by linarith [hb.2.2.2.2.2] + exact this.ne' + have huq : z.1 + z.2.2 ≠ 0 := by + have : 0 < z.1 + z.2.2 := by linarith [hb.1, hb.2.2.2.2.1] + exact this.ne' + have hvq : z.2.1 + z.2.2 ≠ 0 := by + have : 0 < z.2.1 + z.2.2 := by linarith [hb.2.2.1, hb.2.2.2.2.1] + exact this.ne' + have huvq : z.1 + (z.2.1 + z.2.2) ≠ 0 := by + have : 0 < z.1 + (z.2.1 + z.2.2) := by + linarith [hb.1, hb.2.2.1, hb.2.2.2.2.1] + exact this.ne' + have hvuq : z.2.1 + (z.1 + z.2.2) ≠ 0 := by + have : 0 < z.2.1 + (z.1 + z.2.2) := by + linarith [hb.1, hb.2.2.1, hb.2.2.2.2.1] + exact this.ne' + let S := Metric.closedBall goodRowCenter (1 / 10) + have hu : ContinuousAt (fun w : GoodRowTriple ↦ w.1) z := continuousAt_fst + have htail : ContinuousAt (fun w : GoodRowTriple ↦ w.2) z := continuousAt_snd + have hv : ContinuousAt (fun w : GoodRowTriple ↦ w.2.1) z := + continuousAt_fst.comp' htail + have hq : ContinuousAt (fun w : GoodRowTriple ↦ w.2.2) z := + continuousAt_snd.comp' htail + have hdenC : ContinuousAt (fun w : GoodRowTriple ↦ 1 - w.2.2) z := + continuousAt_const.sub hq + have hentropy : ContinuousAt (fun w : GoodRowTriple ↦ + (1 - w.2.2) * Real.binEntropy (w.1 / (1 - w.2.2)) - 1) z := + (hdenC.mul (Real.binEntropy_continuous.continuousAt.comp' + (hu.div hdenC hden))).sub continuousAt_const + have hsUQ : ContinuousAt (fun w : GoodRowTriple ↦ + continuousSuffixError w.1 w.2.2) z := + ContinuousAt.comp' (f := fun w : GoodRowTriple ↦ (w.1, w.2.2)) + (continuousAt_continuousSuffixError huq) (hu.prodMk hq) + have hvqC : ContinuousAt (fun w : GoodRowTriple ↦ w.2.1 + w.2.2) z := + hv.add hq + have hsUVQ : ContinuousAt (fun w : GoodRowTriple ↦ + continuousSuffixError w.1 (w.2.1 + w.2.2)) z := + ContinuousAt.comp' + (f := fun w : GoodRowTriple ↦ (w.1, w.2.1 + w.2.2)) + (continuousAt_continuousSuffixError huvq) (hu.prodMk hvqC) + have hsVQ : ContinuousAt (fun w : GoodRowTriple ↦ + continuousSuffixError w.2.1 w.2.2) z := + ContinuousAt.comp' (f := fun w : GoodRowTriple ↦ (w.2.1, w.2.2)) + (continuousAt_continuousSuffixError hvq) (hv.prodMk hq) + have huqC : ContinuousAt (fun w : GoodRowTriple ↦ w.1 + w.2.2) z := + hu.add hq + have hsVUQ : ContinuousAt (fun w : GoodRowTriple ↦ + continuousSuffixError w.2.1 (w.1 + w.2.2)) z := + ContinuousAt.comp' + (f := fun w : GoodRowTriple ↦ (w.2.1, w.1 + w.2.2)) + (continuousAt_continuousSuffixError hvuq) (hv.prodMk huqC) + have hhalf : ContinuousAt (fun _w : GoodRowTriple ↦ (1 / 2 : ℝ)) z := + continuousAt_const + have htotal : ContinuousAt (fun w : GoodRowTriple ↦ + (1 - w.2.2) * Real.binEntropy (w.1 / (1 - w.2.2)) - 1 + + (1 / 2) * + (continuousSuffixError w.1 w.2.2 + + continuousSuffixError w.1 (w.2.1 + w.2.2) + + continuousSuffixError w.2.1 w.2.2 + + continuousSuffixError w.2.1 (w.1 + w.2.2))) z := + hentropy.add (hhalf.mul (((hsUQ.add hsUVQ).add hsVQ).add hsVUQ)) + simpa only [continuousGoodRowPsi] using htotal.continuousWithinAt + +noncomputable def goodRowDeviation (z : GoodRowTriple) : ℝ := + |Real.log 2 / 2 - continuousGoodRowPsi z.1 z.2.1 z.2.2| + +theorem continuousGoodRowPsi_center : + continuousGoodRowPsi goodRowCenter.1 goodRowCenter.2.1 goodRowCenter.2.2 = + Real.log 2 / 2 := by + rw [← goodRowPsi_eq_continuousGoodRowPsi + (by norm_num [goodRowCenter]) (by norm_num [goodRowCenter]) + (by norm_num [goodRowCenter])] + simpa [goodRowCenter] using goodRowPsi_half_half_zero + +theorem goodRowDeviation_center : goodRowDeviation goodRowCenter = 0 := by + rw [goodRowDeviation, continuousGoodRowPsi_center] + simp + +theorem continuousAt_goodRowDeviation_center : + ContinuousAt goodRowDeviation goodRowCenter := by + unfold goodRowDeviation + apply ContinuousAt.abs + apply continuousAt_const.sub + simpa [goodRowCenter] using + continuousAt_continuousGoodRowPsi_half_half_zero + +theorem continuousOn_goodRowDeviation_closedBall : + ContinuousOn goodRowDeviation + (Metric.closedBall goodRowCenter (1 / 10)) := by + unfold goodRowDeviation + exact (continuousOn_const.sub + continuousOn_continuousGoodRowPsi_closedBall).abs + +theorem goodRowBall_subset_tenth (η : ℝ) : + Metric.closedBall goodRowCenter (goodRowRadius η) ⊆ + Metric.closedBall goodRowCenter (1 / 10) := + Metric.closedBall_subset_closedBall (goodRowRadius_le_tenth η) + +theorem goodRowDeviation_image_bddAbove (η : ℝ) : + BddAbove (goodRowDeviation '' + Metric.closedBall goodRowCenter (goodRowRadius η)) := by + have hbig : BddAbove (goodRowDeviation '' + Metric.closedBall goodRowCenter (1 / 10)) := + (isCompact_closedBall goodRowCenter (1 / 10)).bddAbove_image + continuousOn_goodRowDeviation_closedBall + exact hbig.mono (Set.image_mono (goodRowBall_subset_tenth η)) + +theorem goodRowBall_nonempty (η : ℝ) : + (Metric.closedBall goodRowCenter (goodRowRadius η)).Nonempty := by + exact ⟨goodRowCenter, by + rw [Metric.mem_closedBall, dist_self] + exact goodRowRadius_nonneg η⟩ + +/-- A monotone modulus for the compactness step in paper Lemma 12. We use +absolute deviation rather than only its positive part; this is slightly +stronger and gives the same score bound. -/ +noncomputable def goodRowOmega (η : ℝ) : ℝ := + sSup (goodRowDeviation '' + Metric.closedBall goodRowCenter (goodRowRadius η)) + +theorem goodRowOmega_nonneg (η : ℝ) : 0 ≤ goodRowOmega η := by + rw [goodRowOmega, ← goodRowDeviation_center] + apply le_csSup (goodRowDeviation_image_bddAbove η) + exact ⟨goodRowCenter, by + rw [Metric.mem_closedBall, dist_self] + exact goodRowRadius_nonneg η, rfl⟩ + +theorem monotone_goodRowOmega : Monotone goodRowOmega := by + intro η θ hηθ + unfold goodRowOmega + apply csSup_le_csSup (goodRowDeviation_image_bddAbove θ) + ((goodRowBall_nonempty η).image goodRowDeviation) + exact Set.image_mono (Metric.closedBall_subset_closedBall + (monotone_goodRowRadius hηθ)) + +theorem goodRowDeviation_le_omega + {η : ℝ} {z : GoodRowTriple} + (hz : z ∈ Metric.closedBall goodRowCenter (goodRowRadius η)) : + goodRowDeviation z ≤ goodRowOmega η := by + apply le_csSup (goodRowDeviation_image_bddAbove η) + exact ⟨z, hz, rfl⟩ + +theorem goodRowPsi_ge_half_log_sub_omega + {η u v q : ℝ} (hu : 0 ≤ u) (hv : 0 ≤ v) (hq : 0 ≤ q) + (hz : (u, (v, q)) ∈ + Metric.closedBall goodRowCenter (goodRowRadius η)) : + Real.log 2 / 2 - goodRowOmega η ≤ goodRowPsi u v q := by + have hdev := goodRowDeviation_le_omega hz + rw [goodRowDeviation, ← goodRowPsi_eq_continuousGoodRowPsi hu hv hq] at hdev + exact le_of_sub_nonneg (by + have := le_trans (le_abs_self (Real.log 2 / 2 - goodRowPsi u v q)) hdev + linarith) + +/-- The compact-ball modulus tends to zero as its radius shrinks. -/ +theorem tendsto_goodRowOmega_zero : + Tendsto goodRowOmega (nhds 0) (nhds 0) := by + rw [Metric.tendsto_nhds_nhds] + intro ε hε + obtain ⟨δ, hδ, hcont⟩ := + (Metric.continuousAt_iff.mp continuousAt_goodRowDeviation_center) + (ε / 2) (half_pos hε) + refine ⟨δ, hδ, ?_⟩ + intro η hη + have hωle : goodRowOmega η ≤ ε / 2 := by + unfold goodRowOmega + apply csSup_le ((goodRowBall_nonempty η).image goodRowDeviation) + intro y hy + obtain ⟨z, hz, rfl⟩ := hy + have hzdist : dist z goodRowCenter < δ := by + have hzle : dist z goodRowCenter ≤ goodRowRadius η := + Metric.mem_closedBall.mp hz + have hrabs := goodRowRadius_le_abs η + have habs : |η| = dist η 0 := by rw [Real.dist_eq, sub_zero] + have habslt : |η| < δ := by rw [habs]; exact hη + exact hzle.trans_lt (hrabs.trans_lt habslt) + have hsmall := hcont hzdist + rw [goodRowDeviation_center, Real.dist_eq, sub_zero] at hsmall + have hdev0 : 0 ≤ goodRowDeviation z := by + unfold goodRowDeviation + exact abs_nonneg _ + rw [abs_of_nonneg hdev0] at hsmall + exact hsmall.le + rw [Real.dist_eq, sub_zero, abs_of_nonneg (goodRowOmega_nonneg η)] + exact hωle.trans_lt (half_lt_self hε) + +/-- Paper Lemma 12. A row within `η` in `L¹` of a half--half vector admits +two core coordinates such that its averaged sequential score exceeds the +entropy of the corresponding two-core coarsening by +`(log 2)/2 - goodRowOmega η`. The modulus is monotone and tends to zero by +`monotone_goodRowOmega` and `tendsto_goodRowOmega_zero`. -/ +theorem goodRow_score + {n : ℕ} {p : Fin n → ℝ} (hp : IsStrictProbabilityVector p) + {η : ℝ} (hη₀ : 0 ≤ η) (hη₁ : η ≤ 1 / 10) + (hgood : IsGoodRow η p) : + ∃ a b : Fin n, a ≠ b ∧ + halfHalfL1Distance p a b ≤ η ∧ + Real.log 2 / 2 - goodRowOmega η ≤ + rowScore p - twoCoreCoarsenedEntropy p a b := by + obtain ⟨a, b, hab, hdist⟩ := hgood + let q := 1 - p a - p b + have hq₀ : 0 ≤ q := by + have hsum : 0 ≤ + ∑ j, if a ≠ j ∧ b ≠ j then p j else 0 := by + apply Finset.sum_nonneg + intro j _ + split_ifs + · exact hp.probability.nonnegative j + · exact le_rfl + rw [sum_away_from_two hp.probability hab] at hsum + exact hsum + have hdist' : |p a - 1 / 2| + |p b - 1 / 2| + q ≤ η := by + rw [halfHalfL1Distance_eq hp.probability hab] at hdist + exact hdist + have haη : |p a - 1 / 2| ≤ η := by + linarith [abs_nonneg (p b - 1 / 2)] + have hbη : |p b - 1 / 2| ≤ η := by + linarith [abs_nonneg (p a - 1 / 2)] + have hqη : q ≤ η := by + linarith [abs_nonneg (p a - 1 / 2), abs_nonneg (p b - 1 / 2)] + have hz : (p a, (p b, q)) ∈ + Metric.closedBall goodRowCenter (goodRowRadius η) := by + rw [Metric.mem_closedBall, goodRowRadius_eq hη₀ hη₁, + Prod.dist_eq, Prod.dist_eq, max_le_iff, max_le_iff] + dsimp [goodRowCenter] + constructor + · simpa [Real.dist_eq] using haη + constructor + · simpa [Real.dist_eq] using hbη + · simpa [Real.dist_eq, abs_of_nonneg hq₀] using hqη + refine ⟨a, b, hab, hdist, ?_⟩ + exact (goodRowPsi_ge_half_log_sub_omega + (hp.probability.nonnegative a) (hp.probability.nonnegative b) hq₀ hz).trans + (rowScore_sub_twoCoreCoarsenedEntropy_ge_Psi hp hab) + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/GreedyRowMatching.lean b/LeanPool/BeyondBethe/BeyondBethe/GreedyRowMatching.lean new file mode 100644 index 0000000000..5f26ac82ac --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/GreedyRowMatching.lean @@ -0,0 +1,385 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.NearCase +import LeanPool.BeyondBethe.BeyondBethe.NumericalWitness +import Mathlib.Algebra.Order.BigOperators.Group.Finset + +/-! # Greedy Row Matching -/ + +namespace BeyondBethe + +/-! +# Greedy row matchings + +The algorithmic certificate does not need an exact maximum-weight matching. +After retaining all row pairs whose directed lower gain exceeds a fixed +threshold, it is enough to construct any maximal matching in that graph. +The elementary cardinality lemma below shows that such a matching has at +least half as many edges as every other matching in the retained graph. +-/ + +/-- Every successful clean factor already has a large explicit finite-witness +value. No optimized pair capacity and no input-matrix data enter this fact. -/ +theorem successfulCleanCycle_explicitWitnessGain + {n : ℕ} {κ₀ ξ₀ γ₀ ell ξ τ η : ℝ} + (hgain : ExplicitPairWitnessGainGuarantee κ₀ ξ₀ γ₀) + (hell : 1 ≤ ell) (hlogn : Real.log n ≤ ell * Real.log 2) + (hξ : 0 < ξ) (hξ₀ : ξ ≤ ξ₀) (hτscale : τ = ξ / (4 * ell)) + {P X : Matrix (Fin n) (Fin n) ℝ} + (hX : IsDoublyStochastic X) + (hXint : ∀ i, IsInteriorProbabilityVector (X i)) + (f g : Equiv.Perm (Fin n)) + (c : cleanCycleFactors η P (alternatingRowPerm f g)) + (hc : c ∈ successfulCleanCycles κ₀ τ η P X f g) : + γ₀ ≤ explicitPairWitnessLogGain τ X + (cleanCycleRow c 0) (cleanCycleRow c 1) + (f (cleanCycleRow c 0)) (g (cleanCycleRow c 0)) := by + have hcost : fourCoreTransferCost τ X + (cleanCycleRow c 0) (cleanCycleRow c 1) + (f (cleanCycleRow c 0)) (g (cleanCycleRow c 0)) ≤ κ₀ := by + have hnot : ¬ κ₀ < fourCoreTransferCost τ X + (cleanCycleRow c 0) (cleanCycleRow c 1) + (f (cleanCycleRow c 0)) (g (cleanCycleRow c 0)) := by + simpa [successfulCleanCycles, failedCleanCycles] using hc + exact le_of_not_gt hnot + have hcols := cleanCycle_core_columns c + exact hgain hell hlogn hξ hξ₀ hτscale hX hXint + hcols.1 hcols.2.1 hcost + +/-- `M` is a maximal matching relative to the available row pairs `E`. +The last field is the useful certificate form of maximality: every available +edge meets an edge already selected by `M`. -/ +structure IsMaximalRowMatching {n : ℕ} + (E M : Finset (RowPair n)) : Prop where + subset : M ⊆ E + matching : IsRowMatching M + covered : ∀ q ∈ E, ∃ r ∈ M, ¬Disjoint q.1 r.1 + +/-- The vertices covered by a row matching. -/ +def rowMatchingVertices {n : ℕ} (M : Finset (RowPair n)) : Finset (Fin n) := + M.biUnion fun q ↦ q.1 + +theorem rowMatchingVertices_card_le_two_mul {n : ℕ} + (M : Finset (RowPair n)) : + (rowMatchingVertices M).card ≤ 2 * M.card := by + rw [show 2 * M.card = M.card * 2 by omega] + exact Finset.card_biUnion_le_card_mul M (fun q ↦ q.1) 2 + (fun q _ ↦ q.2.le) + +/-- A maximal matching is a factor-two approximation to maximum cardinality. +This proof uses only the fact that the competing edges are disjoint: choose, +for each competing edge, a covered endpoint. Those choices are injective, +and the selected matching covers at most two vertices per edge. -/ +theorem card_le_two_mul_of_maximalRowMatching {n : ℕ} + {E M S : Finset (RowPair n)} + (hM : IsMaximalRowMatching E M) + (hS : IsRowMatching S) (hSE : S ⊆ E) : + S.card ≤ 2 * M.card := by + classical + let V := rowMatchingVertices M + have hinter : ∀ q : S, ∃ v : Fin n, v ∈ q.1.1 ∧ v ∈ V := by + intro q + obtain ⟨r, hrM, hqr⟩ := hM.covered q.1 (hSE q.2) + obtain ⟨v, hvq, hvr⟩ := Finset.not_disjoint_iff.mp hqr + refine ⟨v, hvq, ?_⟩ + exact Finset.mem_biUnion.mpr ⟨r, hrM, hvr⟩ + let chosen : S → Fin n := fun q ↦ (hinter q).choose + have hchosen_mem_edge (q : S) : chosen q ∈ q.1.1 := + (hinter q).choose_spec.1 + have hchosen_mem_V (q : S) : chosen q ∈ V := + (hinter q).choose_spec.2 + let intoV : S → V := fun q ↦ ⟨chosen q, hchosen_mem_V q⟩ + have hinjective : Function.Injective intoV := by + intro q q' heq + apply Subtype.ext + by_contra hqq' + have hdisj : Disjoint q.1.1 q'.1.1 := + hS q.2 q'.2 hqq' + have hval : chosen q = chosen q' := congrArg Subtype.val heq + exact (Finset.disjoint_left.mp hdisj) + (hchosen_mem_edge q) (hval ▸ hchosen_mem_edge q') + calc + S.card ≤ V.card := Finset.card_le_card_of_injective hinjective + _ ≤ 2 * M.card := rowMatchingVertices_card_le_two_mul M + +/-- Greedily scan a list of available row pairs. An edge is inserted exactly +when it is disjoint from all edges selected later in the list. (Thus the +recursion fixes a deterministic reverse-list scan.) -/ +def greedyRowMatchingList {n : ℕ} : + List (RowPair n) → Finset (RowPair n) + | [] => ∅ + | q :: qs => + let M := greedyRowMatchingList qs + if ∀ r ∈ M, Disjoint q.1 r.1 then insert q M else M + +theorem greedyRowMatchingList_isMaximal {n : ℕ} + (edges : List (RowPair n)) : + IsMaximalRowMatching edges.toFinset (greedyRowMatchingList edges) := by + induction edges with + | nil => + refine ⟨by simp [greedyRowMatchingList], by simp [greedyRowMatchingList, + IsRowMatching], ?_⟩ + simp + | cons q qs ih => + rw [greedyRowMatchingList] + split_ifs with hdisj + · refine ⟨?_, ?_, ?_⟩ + · intro r hr + simp only [List.toFinset_cons, Finset.mem_insert] at hr ⊢ + exact hr.elim Or.inl (fun hrM ↦ Or.inr (ih.subset hrM)) + · rw [IsRowMatching, Finset.coe_insert] + exact ih.matching.insert fun r hr _ ↦ hdisj r hr + · intro e he + simp only [List.toFinset_cons, Finset.mem_insert] at he + rcases he with heq | he + · have hecard := e.2 + have hepos : 0 < e.1.card := by omega + obtain ⟨v, hv⟩ := Finset.card_pos.mp hepos + exact ⟨e, by simpa [heq], + Finset.not_disjoint_iff.mpr ⟨v, hv, hv⟩⟩ + · obtain ⟨r, hr, her⟩ := ih.covered e he + exact ⟨r, Finset.mem_insert_of_mem hr, her⟩ + · refine ⟨?_, ih.matching, ?_⟩ + · exact ih.subset.trans (by simp) + · intro e he + simp only [List.toFinset_cons, Finset.mem_insert] at he + rcases he with heq | he + · subst e + push Not at hdisj + exact hdisj + · exact ih.covered e he + +/-- Gain form of the cardinality lemma. If every selected edge has gain at +least `a`, a maximal matching collects at least one half of `a` times the +cardinality of any competing matching in the threshold graph. -/ +theorem half_card_mul_le_sum_of_maximalRowMatching {n : ℕ} + {E M S : Finset (RowPair n)} (w : RowPair n → ℝ) {a : ℝ} + (ha : 0 ≤ a) (hM : IsMaximalRowMatching E M) + (hS : IsRowMatching S) (hSE : S ⊆ E) + (hweight : ∀ q ∈ M, a ≤ w q) : + ((S.card : ℝ) * a) / 2 ≤ ∑ q ∈ M, w q := by + have hcard : (S.card : ℝ) ≤ 2 * M.card := by + exact_mod_cast card_le_two_mul_of_maximalRowMatching hM hS hSE + have hcardGain : ((S.card : ℝ) * a) / 2 ≤ (M.card : ℝ) * a := by + have := mul_le_mul_of_nonneg_right hcard ha + norm_num at this ⊢ + linarith + refine hcardGain.trans ?_ + calc + (M.card : ℝ) * a = ∑ _q ∈ M, a := by simp + _ ≤ ∑ q ∈ M, w q := Finset.sum_le_sum hweight + +/-- The unordered row pair associated with two rows in increasing order. -/ +def rowPairOfLT {n : ℕ} (i j : Fin n) (hij : i < j) : RowPair n := + ⟨{i, j}, by simp [ne_of_lt hij]⟩ + +@[simp] theorem rowPairRow_rowPairOfLT_zero {n : ℕ} + (i j : Fin n) (hij : i < j) : + rowPairRow (rowPairOfLT i j hij) 0 = i := by + let q := rowPairOfLT i j hij + have hzero := rowPairRow_mem q 0 + have hone := rowPairRow_mem q 1 + have hlt : rowPairRow q 0 < rowPairRow q 1 := by + exact (q.1.orderIsoOfFin q.2).lt_iff_lt.mpr (by decide) + dsimp only [q] at hlt + change rowPairRow (rowPairOfLT i j hij) 0 ∈ ({i, j} : Finset (Fin n)) at hzero + change rowPairRow (rowPairOfLT i j hij) 1 ∈ ({i, j} : Finset (Fin n)) at hone + simp only [Finset.mem_insert, Finset.mem_singleton] at hzero hone + rcases hzero with hzero | hzero + · exact hzero + · rcases hone with hone | hone + · rw [hzero, hone] at hlt + exact False.elim ((not_lt_of_ge hij.le) hlt) + · rw [hzero, hone] at hlt + exact False.elim ((lt_irrefl j) hlt) + +@[simp] theorem rowPairRow_rowPairOfLT_one {n : ℕ} + (i j : Fin n) (hij : i < j) : + rowPairRow (rowPairOfLT i j hij) 1 = j := by + let q := rowPairOfLT i j hij + have hzero := rowPairRow_mem q 0 + have hone := rowPairRow_mem q 1 + have hlt : rowPairRow q 0 < rowPairRow q 1 := by + exact (q.1.orderIsoOfFin q.2).lt_iff_lt.mpr (by decide) + dsimp only [q] at hlt + change rowPairRow (rowPairOfLT i j hij) 0 ∈ ({i, j} : Finset (Fin n)) at hzero + change rowPairRow (rowPairOfLT i j hij) 1 ∈ ({i, j} : Finset (Fin n)) at hone + simp only [Finset.mem_insert, Finset.mem_singleton] at hzero hone + rcases hone with hone | hone + · rcases hzero with hzero | hzero + · rw [hzero, hone] at hlt + exact False.elim ((lt_irrefl i) hlt) + · rw [hzero, hone] at hlt + exact False.elim ((not_lt_of_ge hij.le) hlt) + · exact hone + +/-- Explicit lexicographic enumeration of every unordered row pair. Unlike +`Finset.toList`, this definition carries no classical choice and is executable. -/ +def allRowPairsList (n : ℕ) : List (RowPair n) := + (List.finRange n).flatMap fun i ↦ + (List.finRange n).filterMap fun j ↦ + if hij : i < j then some (rowPairOfLT i j hij) else none + +theorem rowPairOfLT_mem_allRowPairsList {n : ℕ} + (i j : Fin n) (hij : i < j) : + rowPairOfLT i j hij ∈ allRowPairsList n := by + rw [allRowPairsList, List.mem_flatMap] + refine ⟨i, List.mem_finRange i, ?_⟩ + rw [List.mem_filterMap] + refine ⟨j, List.mem_finRange j, ?_⟩ + simp [hij] + +theorem mem_allRowPairsList {n : ℕ} (q : RowPair n) : + q ∈ allRowPairsList n := by + obtain ⟨i, j, hij, hq⟩ := Finset.card_eq_two.mp q.2 + rcases lt_or_gt_of_ne hij with hlt | hgt + · have hmem := rowPairOfLT_mem_allRowPairsList i j hlt + have heq : q = rowPairOfLT i j hlt := by + apply Subtype.ext + simpa [rowPairOfLT] using hq + rwa [heq] + · have hmem := rowPairOfLT_mem_allRowPairsList j i hgt + have heq : q = rowPairOfLT j i hgt := by + apply Subtype.ext + simpa [rowPairOfLT, Finset.pair_comm] using hq + rwa [heq] + +/-- Retain exactly the row pairs whose rational certified weight reaches the +given rational threshold. -/ +def thresholdRowPairsList {n : ℕ} (w : RowPair n → ℚ) (a : ℚ) : + List (RowPair n) := + (allRowPairsList n).filter fun q ↦ decide (a ≤ w q) + +theorem mem_thresholdRowPairsList_iff {n : ℕ} + (w : RowPair n → ℚ) (a : ℚ) (q : RowPair n) : + q ∈ thresholdRowPairsList w a ↔ a ≤ w q := by + simp [thresholdRowPairsList, mem_allRowPairsList] + +/-- Executable threshold-and-greedy row matching. -/ +def greedyThresholdRowMatching {n : ℕ} + (w : RowPair n → ℚ) (a : ℚ) : Finset (RowPair n) := + greedyRowMatchingList (thresholdRowPairsList w a) + +theorem greedyThresholdRowMatching_isMaximal {n : ℕ} + (w : RowPair n → ℚ) (a : ℚ) : + IsMaximalRowMatching + (thresholdRowPairsList w a).toFinset + (greedyThresholdRowMatching w a) := by + exact greedyRowMatchingList_isMaximal _ + +theorem greedyThresholdRowMatching_weight {n : ℕ} + (w : RowPair n → ℚ) {a : ℚ} + {S : Finset (RowPair n)} (ha : 0 ≤ a) + (hS : IsRowMatching S) (hqualifies : ∀ q ∈ S, a ≤ w q) : + ((S.card : ℝ) * (a : ℝ)) / 2 ≤ + ∑ q ∈ greedyThresholdRowMatching w a, (w q : ℝ) := by + let E := (thresholdRowPairsList w a).toFinset + let M := greedyThresholdRowMatching w a + have hmax : IsMaximalRowMatching E M := + greedyThresholdRowMatching_isMaximal w a + have hSE : S ⊆ E := by + intro q hq + simp only [E, List.mem_toFinset, mem_thresholdRowPairsList_iff] + exact hqualifies q hq + have hweight : ∀ q ∈ M, (a : ℝ) ≤ (w q : ℝ) := by + intro q hq + have hqE := hmax.subset hq + have hqrat : a ≤ w q := by + simpa only [E, List.mem_toFinset, mem_thresholdRowPairsList_iff] using hqE + exact_mod_cast hqrat + exact half_card_mul_le_sum_of_maximalRowMatching + (fun q ↦ (w q : ℝ)) (by exact_mod_cast ha) hmax hS hSE hweight + +/-- Rational gain collected by the executable threshold matching. -/ +def greedyCertifiedMatchingGain {n : ℕ} + (w : RowPair n → ℚ) (a : ℚ) : ℚ := + ∑ q ∈ greedyThresholdRowMatching w a, w q + +theorem cast_greedyCertifiedMatchingGain {n : ℕ} + (w : RowPair n → ℚ) (a : ℚ) : + (greedyCertifiedMatchingGain w a : ℝ) = + ∑ q ∈ greedyThresholdRowMatching w a, (w q : ℝ) := by + simp [greedyCertifiedMatchingGain] + +theorem greedyCertifiedMatchingGain_structural_lower {n : ℕ} + (w : RowPair n → ℚ) {a : ℚ} + {S : Finset (RowPair n)} (ha : 0 ≤ a) + (hS : IsRowMatching S) (hqualifies : ∀ q ∈ S, a ≤ w q) : + ((S.card : ℝ) * (a : ℝ)) / 2 ≤ + (greedyCertifiedMatchingGain w a : ℝ) := by + rw [cast_greedyCertifiedMatchingGain] + exact greedyThresholdRowMatching_weight w ha hS hqualifies + +/-- The threshold-greedy routine captures half of the certified gain carried +by the disjoint successful clean pairs. This is the exact replacement for +the maximum-weight-matching domination used in the nonalgorithmic proof. -/ +theorem greedyCertifiedMatchingGain_ge_successfulCleanCycles + {n : ℕ} {κ τ η : ℝ} {P X : Matrix (Fin n) (Fin n) ℝ} + (f g : Equiv.Perm (Fin n)) (w : RowPair n → ℚ) {a : ℚ} + (ha : 0 ≤ a) + (hqualifies : ∀ c ∈ successfulCleanCycles κ τ η P X f g, + a ≤ w (cleanCycleRowPair c)) : + (((successfulCleanCycles κ τ η P X f g).card : ℝ) * (a : ℝ)) / 2 ≤ + (greedyCertifiedMatchingGain w a : ℝ) := by + let S := successfulRowPairs κ τ η P X f g + have hS : IsRowMatching S := successfulRowPairs_isRowMatching κ τ η P X f g + have hSq : ∀ q ∈ S, a ≤ w q := by + intro q hq + obtain ⟨c, hc, rfl⟩ := Finset.mem_image.mp hq + exact hqualifies c hc + have hcard : S.card = (successfulCleanCycles κ τ η P X f g).card := by + exact Finset.card_image_iff.mpr cleanCycleRowPair_injective.injOn + have h := greedyCertifiedMatchingGain_structural_lower w ha hS hSq + rwa [hcard] at h + +/-- Every directed lower estimate selected by the greedy routine remains a +valid permanent certificate. Exact maximum-weight matching is unnecessary: +the paired certificate applies to the selected matching itself, and +monotonicity of `exp` permits replacing its true gain by any rational lower +sum. -/ +theorem exp_betheObjective_add_greedyCertifiedMatchingGain_le_permanent + {n : ℕ} + (stableCoefficient : AnariOveisGharanStableCoefficient.{0}) + {A X : Matrix (Fin n) (Fin n) ℝ} + (w : RowPair n → ℚ) {a : ℚ} (ha : 0 < a) + (hlower : ∀ q ∈ greedyThresholdRowMatching w a, (w q : ℝ) ≤ + Real.log (pairGain A X (rowPairRow q 0) (rowPairRow q 1))) + (hcard : 2 ≤ n) (hA : Matrix.Positive A) + (hX : IsDoublyStochastic X) (hXpos : ∀ i j, 0 < X i j) : + Real.exp (betheObjective A X + + (greedyCertifiedMatchingGain w a : ℝ)) ≤ + Matrix.permanent A := by + let M := greedyThresholdRowMatching w a + have hmax : IsMaximalRowMatching + (thresholdRowPairsList w a).toFinset M := + greedyThresholdRowMatching_isMaximal w a + have hselected : ∀ q ∈ M, a ≤ w q := by + intro q hq + have hqE := hmax.subset hq + simpa only [List.mem_toFinset, mem_thresholdRowPairsList_iff] using hqE + have hpositive : ∀ q ∈ M, 0 < Real.log + (pairGain A X (rowPairRow q 0) (rowPairRow q 1)) := by + intro q hq + have hcast : (a : ℝ) ≤ (w q : ℝ) := by + exact_mod_cast hselected q hq + have hareal : 0 < (a : ℝ) := by exact_mod_cast ha + exact hareal.trans_le (hcast.trans (hlower q hq)) + have hsum : (greedyCertifiedMatchingGain w a : ℝ) ≤ + rowMatchingWeight A X M := by + rw [cast_greedyCertifiedMatchingGain, rowMatchingWeight] + exact Finset.sum_le_sum fun q hq ↦ by + rw [rowPairWeight, max_eq_right (le_of_lt (hpositive q hq))] + exact hlower q hq + have hexp : Real.exp (betheObjective A X + + (greedyCertifiedMatchingGain w a : ℝ)) ≤ + Real.exp (betheObjective A X + rowMatchingWeight A X M) := by + exact Real.exp_le_exp.mpr (by linarith) + exact hexp.trans + (exp_betheObjective_add_rowMatchingWeight_le_permanent + stableCoefficient hmax.matching hcard hA hX hXpos hpositive) + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/KuhnMatching.lean b/LeanPool/BeyondBethe/BeyondBethe/KuhnMatching.lean new file mode 100644 index 0000000000..bab005bc73 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/KuhnMatching.lean @@ -0,0 +1,929 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.Permanent +import Mathlib.Data.List.FinRange +import Mathlib.Tactic + +/-! # Kuhn Matching -/ + +namespace BeyondBethe + +/-! +# Executable augmenting-path matching + +This file implements the polynomial augmenting-path algorithm for the +positive support of a square rational matrix. A state maps each column to +its currently matched row. Failed recursive searches return the enlarged +set of visited columns, so a single root search examines each column at most +once; this detail is essential for the polynomial bound. +-/ + +abbrev ColumnMate (n : ℕ) := Fin n → Option (Fin n) + +def emptyColumnMate (n : ℕ) : ColumnMate n := fun _ ↦ none + +/-- A column-to-row table represents a partial matching in the positive +support of `A`. -/ +structure IsSupportColumnMate {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) (mate : ColumnMate n) : Prop where + support : ∀ {col row}, mate col = some row → A row col ≠ 0 + injective : ∀ {col col' row}, + mate col = some row → mate col' = some row → col = col' + +def RowUnmatched {n : ℕ} (mate : ColumnMate n) (row : Fin n) : Prop := + ∀ col, mate col ≠ some row + +def MatchesRow {n : ℕ} (mate : ColumnMate n) (row : Fin n) : Prop := + ∃ col, mate col = some row + +theorem rowUnmatched_iff_not_matchesRow {n : ℕ} + (mate : ColumnMate n) (row : Fin n) : + RowUnmatched mate row ↔ ¬MatchesRow mate row := by + simp [RowUnmatched, MatchesRow] + +theorem emptyColumnMate_support (n : ℕ) + (A : Matrix (Fin n) (Fin n) ℚ) : + IsSupportColumnMate A (emptyColumnMate n) := by + constructor <;> simp [emptyColumnMate] + +theorem rowUnmatched_emptyColumnMate (n : ℕ) (row : Fin n) : + RowUnmatched (emptyColumnMate n) row := by + simp [RowUnmatched, emptyColumnMate] + +theorem IsSupportColumnMate.update_none {n : ℕ} + {A : Matrix (Fin n) (Fin n) ℚ} {mate : ColumnMate n} + (h : IsSupportColumnMate A mate) (col : Fin n) : + IsSupportColumnMate A (Function.update mate col none) := by + constructor + · intro j row hj + by_cases hcol : j = col + · subst j + simp at hj + · simp [Function.update, hcol] at hj + exact h.support hj + · intro j j' row hj hj' + by_cases hjc : j = col + · subst j + simp at hj + · simp [Function.update, hjc] at hj + by_cases hjc' : j' = col + · subst j' + simp at hj' + · simp [Function.update, hjc'] at hj' + exact h.injective hj hj' + +theorem IsSupportColumnMate.update_some {n : ℕ} + {A : Matrix (Fin n) (Fin n) ℚ} {mate : ColumnMate n} + (h : IsSupportColumnMate A mate) {col row : Fin n} + (hrow : RowUnmatched mate row) (hedge : A row col ≠ 0) : + IsSupportColumnMate A (Function.update mate col (some row)) := by + constructor + · intro j r hj + by_cases hcol : j = col + · subst j + simp at hj + subst r + exact hedge + · simp [Function.update, hcol] at hj + exact h.support hj + · intro j j' r hj hj' + by_cases hjc : j = col + · subst j + simp at hj + subst r + by_cases hjc' : j' = col + · exact hjc'.symm + · simp [Function.update, hjc'] at hj' + exact (hrow j' hj').elim + · simp [Function.update, hjc] at hj + by_cases hjc' : j' = col + · subst j' + simp at hj' + subst r + exact (hrow j hj).elim + · simp [Function.update, hjc'] at hj' + exact h.injective hj hj' + +theorem matchesRow_update_none_iff {n : ℕ} + {mate : ColumnMate n} {col oldRow row : Fin n} + (hinj : ∀ {j j' r}, + mate j = some r → mate j' = some r → j = j') + (hmate : mate col = some oldRow) : + MatchesRow (Function.update mate col none) row ↔ + MatchesRow mate row ∧ row ≠ oldRow := by + constructor + · rintro ⟨j, hj⟩ + have hjne : j ≠ col := by + intro h + subst j + simp at hj + have hjold : mate j = some row := by + simpa [Function.update, hjne] using hj + refine ⟨⟨j, hjold⟩, ?_⟩ + intro hrow + subst row + exact hjne (hinj hjold hmate) + · rintro ⟨⟨j, hj⟩, hrow⟩ + refine ⟨j, ?_⟩ + have hjne : j ≠ col := by + intro h + subst j + rw [hmate] at hj + exact hrow (Option.some.inj hj).symm + simpa [Function.update, hjne] using hj + +theorem rowUnmatched_update_none_of_mate {n : ℕ} + {A : Matrix (Fin n) (Fin n) ℚ} {mate : ColumnMate n} + (h : IsSupportColumnMate A mate) {col oldRow : Fin n} + (hmate : mate col = some oldRow) : + RowUnmatched (Function.update mate col none) oldRow := by + rw [rowUnmatched_iff_not_matchesRow, matchesRow_update_none_iff h.injective hmate] + simp + +theorem matchesRow_update_some_iff {n : ℕ} + {mate : ColumnMate n} {col newRow row : Fin n} + (hcol : mate col = none) : + MatchesRow (Function.update mate col (some newRow)) row ↔ + MatchesRow mate row ∨ row = newRow := by + constructor + · rintro ⟨j, hj⟩ + by_cases h : j = col + · subst j + simp at hj + exact Or.inr hj.symm + · left + exact ⟨j, by simpa [Function.update, h] using hj⟩ + · rintro (⟨j, hj⟩ | rfl) + · have h : j ≠ col := by + intro heq + subst j + rw [hcol] at hj + contradiction + exact ⟨j, by simpa [Function.update, h] using hj⟩ + · exact ⟨col, by simp⟩ + +/-- Result of one augmenting-path search. `mate? = some m` records success; +either way, `seen` contains every column examined by the search. -/ +structure KuhnSearchResult (n : ℕ) where + mate? : Option (ColumnMate n) + seen : Finset (Fin n) + +/-- Depth-first augmenting-path search with a shared visited-column set. +The first natural-number argument bounds alternating-path depth; the column +list is the part of the current row that remains to be scanned. A failed +recursive call threads its enlarged visited set into the rest of the scan. +The lexicographic recursion makes both sources of progress explicit. -/ +def kuhnSearch {n : ℕ} (A : Matrix (Fin n) (Fin n) ℚ) : + (fuel : ℕ) → List (Fin n) → Fin n → Finset (Fin n) → + ColumnMate n → KuhnSearchResult n + | 0, _remaining, _row, seen, _mate => ⟨none, seen⟩ + | _fuel + 1, [], _row, seen, _mate => ⟨none, seen⟩ + | fuel + 1, col :: remaining, row, seen, mate => + if hskip : col ∈ seen ∨ A row col = 0 then + kuhnSearch A (fuel + 1) remaining row seen mate + else + let seen' := insert col seen + match hmate : mate col with + | none => ⟨some (Function.update mate col (some row)), seen'⟩ + | some oldRow => + let mateWithoutOld := Function.update mate col none + let recursive := + kuhnSearch A fuel (List.finRange n) oldRow seen' mateWithoutOld + match recursive.mate? with + | some mate' => + ⟨some (Function.update mate' col (some row)), recursive.seen⟩ + | none => + kuhnSearch A (fuel + 1) remaining row recursive.seen mate +termination_by fuel remaining _row _seen _mate => (fuel, remaining.length) + +/-- Number of column inspections made by `kuhnSearch`. Recursive work is +charged only on the branch actually taken by the executable search. -/ +def kuhnSearchWork {n : ℕ} (A : Matrix (Fin n) (Fin n) ℚ) : + (fuel : ℕ) → List (Fin n) → Fin n → Finset (Fin n) → ColumnMate n → ℕ + | 0, _remaining, _row, _seen, _mate => 0 + | _fuel + 1, [], _row, _seen, _mate => 0 + | fuel + 1, col :: remaining, row, seen, mate => + if col ∈ seen ∨ A row col = 0 then + 1 + kuhnSearchWork A (fuel + 1) remaining row seen mate + else + let seen' := insert col seen + match mate col with + | none => 1 + | some oldRow => + let mateWithoutOld := Function.update mate col none + let recursive := + kuhnSearch A fuel (List.finRange n) oldRow seen' mateWithoutOld + let recursiveWork := + kuhnSearchWork A fuel (List.finRange n) oldRow seen' mateWithoutOld + match recursive.mate? with + | some _ => 1 + recursiveWork + | none => 1 + recursiveWork + + kuhnSearchWork A (fuel + 1) remaining row recursive.seen mate +termination_by fuel remaining _row _seen _mate => (fuel, remaining.length) + +/-- Search all columns from scratch for an augmenting path rooted at `row`. -/ +def kuhnAugment {n : ℕ} (A : Matrix (Fin n) (Fin n) ℚ) + (fuel : ℕ) (row : Fin n) (seen : Finset (Fin n)) + (mate : ColumnMate n) : KuhnSearchResult n := + kuhnSearch A fuel (List.finRange n) row seen mate + +theorem kuhnSearch_seen_mono {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) (fuel : ℕ) + (remaining : List (Fin n)) (row : Fin n) + (seen : Finset (Fin n)) (mate : ColumnMate n) : + seen ⊆ (kuhnSearch A fuel remaining row seen mate).seen := by + fun_induction kuhnSearch <;> simp_all [Finset.subset_iff] <;> aesop + +/-- Amortized work bound. Scanning the current suffix is charged directly; +each newly visited column pays for at most one fresh full row scan. -/ +theorem kuhnSearchWork_le {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) (fuel : ℕ) + (remaining : List (Fin n)) (row : Fin n) + (seen : Finset (Fin n)) (mate : ColumnMate n) : + kuhnSearchWork A fuel remaining row seen mate ≤ + remaining.length + (n + 1) * + ((kuhnSearch A fuel remaining row seen mate).seen.card - seen.card) := by + fun_induction kuhnSearchWork with + | case1 => + rw [kuhnSearch.eq_def] + simp + | case2 => + rw [kuhnSearch.eq_def] + simp + | case3 fuel col remaining row seen mate hskip ih => + rw [kuhnSearch.eq_def] + dsimp only + rw [dif_pos hskip] + simp only [List.length_cons] + omega + | case4 fuel col remaining row seen mate hskip hmate => + rw [kuhnSearch.eq_def] + dsimp only + rw [dif_neg hskip, hmate] + simp only [List.length_cons] + have hnot : col ∉ seen := by aesop + rw [Finset.card_insert_of_notMem hnot] + omega + | case5 fuel col remaining row seen mate hskip seen' oldRow hmate + mateWithoutOld recursive recursiveWork mateRec hrec ih => + rw [kuhnSearch.eq_def] + dsimp only + rw [dif_neg hskip, hmate] + simp + rw [show (kuhnSearch A fuel (List.finRange n) oldRow + (insert col seen) (Function.update mate col none)).mate? = some mateRec by + simpa [recursive] using hrec] + change 1 + recursiveWork ≤ remaining.length + 1 + + (n + 1) * (recursive.seen.card - seen.card) + have hnot : col ∉ seen := by aesop + have hcardInsert : seen'.card = seen.card + 1 := by + simpa [seen'] using Finset.card_insert_of_notMem hnot + have hsubset : seen' ⊆ recursive.seen := by + simpa [recursive] using kuhnSearch_seen_mono A fuel + (List.finRange n) oldRow seen' mateWithoutOld + have hcard : seen'.card ≤ recursive.seen.card := + Finset.card_le_card hsubset + have hih : recursiveWork ≤ + n + (n + 1) * (recursive.seen.card - seen'.card) := by + simpa [recursiveWork, recursive] using ih + have hsubEq : recursive.seen.card - seen.card = + (recursive.seen.card - seen'.card) + 1 := by + omega + rw [hsubEq, Nat.mul_add] + omega + | case6 fuel col remaining row seen mate hskip seen' oldRow hmate + mateWithoutOld recursive recursiveWork hrec ihRec ihContinue => + rw [kuhnSearch.eq_def] + dsimp only + rw [dif_neg hskip, hmate] + simp + rw [show (kuhnSearch A fuel (List.finRange n) oldRow + (insert col seen) (Function.update mate col none)).mate? = none by + simpa [recursive] using hrec] + change 1 + recursiveWork + + kuhnSearchWork A (fuel + 1) remaining row recursive.seen mate ≤ + remaining.length + 1 + (n + 1) * + ((kuhnSearch A (fuel + 1) remaining row recursive.seen mate).seen.card - + seen.card) + have hnot : col ∉ seen := by aesop + have hcardInsert : seen'.card = seen.card + 1 := by + simpa [seen'] using Finset.card_insert_of_notMem hnot + have hsubsetRec : seen' ⊆ recursive.seen := by + simpa [recursive] using kuhnSearch_seen_mono A fuel + (List.finRange n) oldRow seen' mateWithoutOld + have hcardRec : seen'.card ≤ recursive.seen.card := + Finset.card_le_card hsubsetRec + have hsubsetFinal : recursive.seen ⊆ + (kuhnSearch A (fuel + 1) remaining row recursive.seen mate).seen := + kuhnSearch_seen_mono A (fuel + 1) remaining row recursive.seen mate + have hcardFinal : recursive.seen.card ≤ + (kuhnSearch A (fuel + 1) remaining row recursive.seen mate).seen.card := + Finset.card_le_card hsubsetFinal + have hihRec : recursiveWork ≤ + n + (n + 1) * (recursive.seen.card - seen'.card) := by + simpa [recursiveWork, recursive] using ihRec + let finalCard := + (kuhnSearch A (fuel + 1) remaining row recursive.seen mate).seen.card + have hihContinue : + kuhnSearchWork A (fuel + 1) remaining row recursive.seen mate ≤ + remaining.length + (n + 1) * + (finalCard - recursive.seen.card) := by + simpa [finalCard] using ihContinue + clear ihContinue + have hsplitOne : recursive.seen.card - seen.card = + (recursive.seen.card - seen'.card) + 1 := by + omega + have hsplitAll : finalCard - seen.card = + (finalCard - recursive.seen.card) + + (recursive.seen.card - seen.card) := by + dsimp only [finalCard] + omega + change 1 + recursiveWork + + kuhnSearchWork A (fuel + 1) remaining row recursive.seen mate ≤ + remaining.length + 1 + (n + 1) * (finalCard - seen.card) + rw [hsplitAll, hsplitOne, Nat.mul_add, Nat.mul_add] + omega + +def kuhnAugmentWork {n : ℕ} (A : Matrix (Fin n) (Fin n) ℚ) + (fuel : ℕ) (row : Fin n) (seen : Finset (Fin n)) + (mate : ColumnMate n) : ℕ := + kuhnSearchWork A fuel (List.finRange n) row seen mate + +/-- One augmentation makes at most `n + (n+1)n` column inspections. -/ +theorem kuhnAugmentWork_le {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) (fuel : ℕ) + (row : Fin n) (mate : ColumnMate n) : + kuhnAugmentWork A fuel row ∅ mate ≤ n + (n + 1) * n := by + have hwork := kuhnSearchWork_le A fuel (List.finRange n) row ∅ mate + have hcard := Finset.card_le_univ + (kuhnSearch A fuel (List.finRange n) row ∅ mate).seen + simp only [Fintype.card_fin] at hcard + simp only [List.length_finRange, Finset.card_empty, Nat.sub_zero] at hwork + exact hwork.trans + (Nat.add_le_add_left (Nat.mul_le_mul_left (n + 1) hcard) n) + +/-- A search never changes a column that was already marked as visited when +the search began. -/ +theorem kuhnSearch_preserves_seen {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) (fuel : ℕ) + (remaining : List (Fin n)) (row c : Fin n) + (seen : Finset (Fin n)) (mate mate' : ColumnMate n) + (hc : c ∈ seen) + (hresult : (kuhnSearch A fuel remaining row seen mate).mate? = some mate') : + mate' c = mate c := by + fun_induction kuhnSearch generalizing c mate' with + | case1 => simp_all + | case2 => simp_all + | case3 => simp_all + | case4 fuel col remaining row seen mate hskip seen' hmate => + have hnot : col ∉ seen := by + intro hmem + exact hskip (Or.inl hmem) + have hcne : c ≠ col := by + intro heq + subst c + exact hnot hc + change some (Function.update mate col (some row)) = some mate' at hresult + injection hresult with heq + subst mate' + simp [Function.update, hcne] + | case5 fuel col remaining row seen mate hskip seen' oldRow hmate + mateWithoutOld recursive mateRec hrec ih => + have hnot : col ∉ seen := by + intro hmem + exact hskip (Or.inl hmem) + have hcne : c ≠ col := by + intro heq + subst c + exact hnot hc + change some (Function.update mateRec col (some row)) = some mate' at hresult + injection hresult with heq + subst mate' + calc + Function.update mateRec col (some row) c = mateRec c := by + simp [Function.update, hcne] + _ = Function.update mate col none c := + ih c mateRec (by simp [seen', hc]) hrec + _ = mate c := by simp [Function.update, hcne] + | case6 fuel col remaining row seen mate hskip seen' oldRow hmate + mateWithoutOld recursive hrec ihRec ihRec' ihContinue => + apply ihContinue c mate' ?_ hresult + apply kuhnSearch_seen_mono A fuel (List.finRange n) oldRow seen' + mateWithoutOld + simp [seen', hc] + +/-- On success, augmenting adds exactly the root row to the set of matched +rows, and it preserves the support and injectivity invariants. -/ +theorem kuhnSearch_success {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) (fuel : ℕ) + (remaining : List (Fin n)) (row : Fin n) + (seen : Finset (Fin n)) (mate mate' : ColumnMate n) + (hsupport : IsSupportColumnMate A mate) + (hunmatched : RowUnmatched mate row) + (hresult : (kuhnSearch A fuel remaining row seen mate).mate? = some mate') : + IsSupportColumnMate A mate' ∧ + ∀ r, MatchesRow mate' r ↔ MatchesRow mate r ∨ r = row := by + fun_induction kuhnSearch generalizing mate' with + | case1 => simp_all + | case2 => simp_all + | case3 fuel col remaining row seen mate hskip ih => + exact ih mate' hsupport hunmatched hresult + | case4 fuel col remaining row seen mate hskip seen' hmate => + change some (Function.update mate col (some row)) = some mate' at hresult + injection hresult with heq + subst mate' + have hedge : A row col ≠ 0 := by aesop + exact ⟨hsupport.update_some hunmatched hedge, + fun r ↦ matchesRow_update_some_iff hmate⟩ + | case5 fuel col remaining row seen mate hskip seen' oldRow hmate + mateWithoutOld recursive mateRec hrec ih => + have hcleared : IsSupportColumnMate A mateWithoutOld := by + simpa [mateWithoutOld] using hsupport.update_none col + have holdUnmatched : RowUnmatched mateWithoutOld oldRow := by + simpa [mateWithoutOld] using + rowUnmatched_update_none_of_mate hsupport hmate + have hrecResult : + (kuhnSearch A fuel (List.finRange n) oldRow seen' mateWithoutOld).mate? = + some mateRec := by + simpa [recursive] using hrec + obtain ⟨hrecSupport, hrecRows⟩ := + ih mateRec hcleared holdUnmatched hrecResult + have hcolSeen : col ∈ seen' := by simp [seen'] + have hrecCol : mateRec col = none := by + calc + mateRec col = mateWithoutOld col := + kuhnSearch_preserves_seen A fuel (List.finRange n) oldRow col seen' + mateWithoutOld mateRec hcolSeen hrecResult + _ = none := by simp [mateWithoutOld] + have hrowNe : row ≠ oldRow := by + intro heq + subst oldRow + exact hunmatched col hmate + have hrootUnmatched : RowUnmatched mateRec row := by + rw [rowUnmatched_iff_not_matchesRow] + intro hroot + rw [hrecRows row] at hroot + rcases hroot with hroot | hroot + · rw [matchesRow_update_none_iff hsupport.injective hmate] at hroot + exact (rowUnmatched_iff_not_matchesRow mate row).mp hunmatched hroot.1 + · exact hrowNe hroot + have hedge : A row col ≠ 0 := by aesop + change some (Function.update mateRec col (some row)) = some mate' at hresult + injection hresult with heq + subst mate' + constructor + · exact hrecSupport.update_some hrootUnmatched hedge + · intro r + rw [matchesRow_update_some_iff hrecCol, hrecRows, + matchesRow_update_none_iff hsupport.injective hmate] + constructor + · rintro ((⟨hr, hrne⟩ | rfl) | rfl) + · exact Or.inl hr + · exact Or.inl ⟨col, hmate⟩ + · exact Or.inr rfl + · rintro (hr | rfl) + · by_cases hrold : r = oldRow + · exact Or.inl (Or.inr hrold) + · exact Or.inl (Or.inl ⟨hr, hrold⟩) + · exact Or.inr rfl + | case6 fuel col remaining row seen mate hskip seen' oldRow hmate + mateWithoutOld recursive hrec ihRec ihRec' ihContinue => + exact ihContinue mate' hsupport hunmatched hresult + +def AllSupportNeighborsIn {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) (row : Fin n) + (cols : Finset (Fin n)) : Prop := + ∀ col, A row col ≠ 0 → col ∈ cols + +/-- A failed search has explored every remaining support edge of its root. +Every newly explored column was occupied, and the old row at that column has +all of its support neighbors in the final explored set. -/ +structure KuhnFailureCertificate {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) (mate : ColumnMate n) + (row : Fin n) (initialSeen finalSeen : Finset (Fin n)) + (remaining : List (Fin n)) : Prop where + seen_subset : initialSeen ⊆ finalSeen + scanned : ∀ col, col ∈ remaining → A row col ≠ 0 → col ∈ finalSeen + occupied_closed : ∀ col, col ∈ finalSeen → col ∉ initialSeen → + ∃ oldRow, mate col = some oldRow ∧ AllSupportNeighborsIn A oldRow finalSeen + +/-- The precise failure certificate returned by the executable search. The +strict fuel-plus-visited inequality is preserved by every recursive descent; +at zero fuel it contradicts the fact that there are only `n` columns. -/ +theorem kuhnSearch_failure_certificate {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) (fuel : ℕ) + (remaining : List (Fin n)) (row : Fin n) + (seen : Finset (Fin n)) (mate : ColumnMate n) + (hroom : n < fuel + seen.card) + (hresult : (kuhnSearch A fuel remaining row seen mate).mate? = none) : + KuhnFailureCertificate A mate row seen + (kuhnSearch A fuel remaining row seen mate).seen remaining := by + fun_induction kuhnSearch with + | case1 remaining row seen mate => + have hcard := Finset.card_le_univ seen + simp [Fintype.card_fin] at hcard + omega + | case2 => + constructor + · exact fun _ h ↦ h + · simp + · intro col hmem hnot + exact (hnot hmem).elim + | case3 fuel col remaining row seen mate hskip ih => + have cert := ih hroom hresult + refine ⟨cert.seen_subset, ?_, cert.occupied_closed⟩ + intro c hc hedge + rcases (List.mem_cons.mp hc) with rfl | hc + · rcases hskip with hseen | hzero + · exact cert.seen_subset hseen + · exact (hedge hzero).elim + · exact cert.scanned c hc hedge + | case4 => simp_all + | case5 => simp_all + | case6 fuel col remaining row seen mate hskip seen' oldRow hmate + mateWithoutOld recursive hrec ihRec ihRec' ihContinue => + have hnotSeen : col ∉ seen := by aesop + have hseenCard : seen'.card = seen.card + 1 := by + simpa [seen'] using Finset.card_insert_of_notMem hnotSeen + have hroomRec : n < fuel + seen'.card := by omega + have certRec := ihRec' hroomRec hrec + have hcardMono : seen'.card ≤ recursive.seen.card := by + apply Finset.card_le_card + simpa [recursive] using certRec.seen_subset + have hroomContinue : n < (fuel + 1) + recursive.seen.card := by + omega + have certContinue := ihContinue hroomContinue hresult + have hrecSubset : recursive.seen ⊆ + (kuhnSearch A (fuel + 1) remaining row recursive.seen mate).seen := + certContinue.seen_subset + refine ⟨?_, ?_, ?_⟩ + · intro c hc + apply hrecSubset + apply certRec.seen_subset + simp [hc] + · intro c hc hedge + rcases (List.mem_cons.mp hc) with rfl | hc + · apply hrecSubset + exact certRec.seen_subset (by simp) + · exact certContinue.scanned c hc hedge + · intro c hcout hcnot + by_cases hcinRec : c ∈ recursive.seen + · by_cases hccol : c = col + · subst c + refine ⟨oldRow, hmate, ?_⟩ + intro d hd + apply hrecSubset + exact certRec.scanned d (List.mem_finRange d) hd + · have hcnotSeen' : c ∉ seen' := by + simp only [seen', Finset.mem_insert, not_or] + exact ⟨hccol, hcnot⟩ + obtain ⟨r, hrmate, hrclosed⟩ := + certRec.occupied_closed c hcinRec hcnotSeen' + refine ⟨r, ?_, ?_⟩ + · simpa [mateWithoutOld, Function.update, hccol] using hrmate + · intro d hd + exact hrecSubset (hrclosed d hd) + · exact certContinue.occupied_closed c hcout hcinRec + +/-- If a full search from an unmatched row fails, its alternating-closure +certificate contradicts any perfect matching. The contradiction is a finite +pigeonhole argument: the root together with the old rows at the explored +columns would inject into the explored columns. -/ +theorem noPerfectMatching_of_kuhnAugment_failure {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) (row : Fin n) + (mate : ColumnMate n) + (hsupport : IsSupportColumnMate A mate) + (hunmatched : RowUnmatched mate row) + (hfail : (kuhnAugment A (n + 1) row ∅ mate).mate? = none) : + ¬Matrix.HasPerfectMatching A := by + classical + intro hperfect + obtain ⟨σ, hσ⟩ := hperfect + have hroom : n < (n + 1) + (∅ : Finset (Fin n)).card := by simp + have cert := kuhnSearch_failure_certificate A (n + 1) + (List.finRange n) row ∅ mate hroom (by simpa [kuhnAugment] using hfail) + let finalSeen : Finset (Fin n) := + (kuhnSearch A (n + 1) (List.finRange n) row ∅ mate).seen + let SeenColumn := {c : Fin n // c ∈ finalSeen} + have occupied (c : SeenColumn) : + ∃ oldRow, mate c.1 = some oldRow ∧ + AllSupportNeighborsIn A oldRow finalSeen := by + apply cert.occupied_closed c.1 + · exact c.2 + · simp + let oldRow : SeenColumn → Fin n := fun c ↦ Classical.choose (occupied c) + have oldRow_mate (c : SeenColumn) : mate c.1 = some (oldRow c) := by + exact (Classical.choose_spec (occupied c)).1 + have oldRow_closed (c : SeenColumn) : + AllSupportNeighborsIn A (oldRow c) finalSeen := by + exact (Classical.choose_spec (occupied c)).2 + let sourceRow : Option SeenColumn → Fin n + | none => row + | some c => oldRow c + have sourceRow_injective : Function.Injective sourceRow := by + intro x y hxy + cases x with + | none => + cases y with + | none => rfl + | some c => + exfalso + have hr : row = oldRow c := by simpa [sourceRow] using hxy + apply hunmatched c.1 + simpa [hr] using oldRow_mate c + | some c => + cases y with + | none => + exfalso + have hr : oldRow c = row := by simpa [sourceRow] using hxy + apply hunmatched c.1 + simpa [← hr] using oldRow_mate c + | some d => + apply congrArg some + apply Subtype.ext + apply hsupport.injective (oldRow_mate c) + have hr : oldRow c = oldRow d := by simpa [sourceRow] using hxy + simpa [← hr] using oldRow_mate d + have target_mem (x : Option SeenColumn) : + σ.symm (sourceRow x) ∈ finalSeen := by + cases x with + | none => + apply cert.scanned (σ.symm row) (List.mem_finRange _) + simpa [sourceRow] using hσ (σ.symm row) + | some c => + apply oldRow_closed c (σ.symm (oldRow c)) + simpa using hσ (σ.symm (oldRow c)) + let targetColumn : Option SeenColumn → SeenColumn := fun x ↦ + ⟨σ.symm (sourceRow x), target_mem x⟩ + have targetColumn_injective : Function.Injective targetColumn := by + intro x y hxy + apply sourceRow_injective + apply σ.symm.injective + exact congrArg Subtype.val hxy + have hcard := Fintype.card_le_of_injective targetColumn targetColumn_injective + simp only [Fintype.card_option] at hcard + omega + +theorem kuhnAugment_succeeds_of_hasPerfectMatching {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) (row : Fin n) + (mate : ColumnMate n) + (hsupport : IsSupportColumnMate A mate) + (hunmatched : RowUnmatched mate row) + (hperfect : Matrix.HasPerfectMatching A) : + ∃ mate', (kuhnAugment A (n + 1) row ∅ mate).mate? = some mate' := by + cases hresult : (kuhnAugment A (n + 1) row ∅ mate).mate? with + | none => + exact (noPerfectMatching_of_kuhnAugment_failure A row mate hsupport + hunmatched hresult hperfect).elim + | some mate' => exact ⟨mate', rfl⟩ + +theorem kuhnAugment_success {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) (row : Fin n) + (mate mate' : ColumnMate n) + (hsupport : IsSupportColumnMate A mate) + (hunmatched : RowUnmatched mate row) + (hresult : (kuhnAugment A (n + 1) row ∅ mate).mate? = some mate') : + IsSupportColumnMate A mate' ∧ + ∀ r, MatchesRow mate' r ↔ MatchesRow mate r ∨ r = row := by + exact kuhnSearch_success A (n + 1) (List.finRange n) row ∅ mate mate' + hsupport hunmatched (by simpa [kuhnAugment] using hresult) + +/-- Insert the listed rows one at a time, augmenting whenever possible. -/ +def kuhnBuild {n : ℕ} (A : Matrix (Fin n) (Fin n) ℚ) : + List (Fin n) → ColumnMate n → ColumnMate n + | [], mate => mate + | row :: rows, mate => + let result := kuhnAugment A (n + 1) row ∅ mate + kuhnBuild A rows (result.mate?.getD mate) + +def kuhnBuildWork {n : ℕ} (A : Matrix (Fin n) (Fin n) ℚ) : + List (Fin n) → ColumnMate n → ℕ + | [], _mate => 0 + | row :: rows, mate => + let result := kuhnAugment A (n + 1) row ∅ mate + kuhnAugmentWork A (n + 1) row ∅ mate + + kuhnBuildWork A rows (result.mate?.getD mate) + +/-- The row-building phase has a cubic coordinate-inspection bound. -/ +theorem kuhnBuildWork_le {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) (rows : List (Fin n)) + (mate : ColumnMate n) : + kuhnBuildWork A rows mate ≤ rows.length * (n + (n + 1) * n) := by + induction rows generalizing mate with + | nil => simp [kuhnBuildWork] + | cons row rows ih => + rw [kuhnBuildWork] + calc + kuhnAugmentWork A (n + 1) row ∅ mate + + kuhnBuildWork A rows + ((kuhnAugment A (n + 1) row ∅ mate).mate?.getD mate) ≤ + (n + (n + 1) * n) + rows.length * (n + (n + 1) * n) := + Nat.add_le_add (kuhnAugmentWork_le A (n + 1) row mate) (ih _) + _ = (row :: rows).length * (n + (n + 1) * n) := by + simp [Nat.add_mul, Nat.add_comm] + +/-- If a perfect matching exists, inserting a duplicate-free list of +initially unmatched rows succeeds at every step and adds exactly those rows. -/ +theorem kuhnBuild_of_hasPerfectMatching {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) (rows : List (Fin n)) + (mate : ColumnMate n) + (hperfect : Matrix.HasPerfectMatching A) + (hnodup : rows.Nodup) + (hsupport : IsSupportColumnMate A mate) + (hunmatched : ∀ r, r ∈ rows → RowUnmatched mate r) : + IsSupportColumnMate A (kuhnBuild A rows mate) ∧ + ∀ r, MatchesRow (kuhnBuild A rows mate) r ↔ + MatchesRow mate r ∨ r ∈ rows := by + induction rows generalizing mate with + | nil => + simp [kuhnBuild, hsupport] + | cons row rows ih => + have hrowUnmatched : RowUnmatched mate row := + hunmatched row (by simp) + obtain ⟨mateOne, haugment⟩ := + kuhnAugment_succeeds_of_hasPerfectMatching A row mate hsupport + hrowUnmatched hperfect + obtain ⟨hsupportOne, hrowsOne⟩ := + kuhnAugment_success A row mate mateOne hsupport hrowUnmatched haugment + have htailNodup : rows.Nodup := hnodup.tail + have hheadNotMem : row ∉ rows := (List.nodup_cons.mp hnodup).1 + have htailUnmatched : ∀ r, r ∈ rows → RowUnmatched mateOne r := by + intro r hr + rw [rowUnmatched_iff_not_matchesRow] + intro hmatched + rw [hrowsOne r] at hmatched + rcases hmatched with hmatched | heq + · exact (rowUnmatched_iff_not_matchesRow mate r).mp + (hunmatched r (by simp [hr])) hmatched + · subst r + exact hheadNotMem hr + obtain ⟨hfinalSupport, hfinalRows⟩ := + ih mateOne htailNodup hsupportOne htailUnmatched + have hget : + ((kuhnAugment A (n + 1) row ∅ mate).mate?.getD mate) = mateOne := by + rw [haugment] + rfl + have hbuild : kuhnBuild A (row :: rows) mate = + kuhnBuild A rows mateOne := by + simp only [kuhnBuild] + rw [hget] + rw [hbuild] + refine ⟨hfinalSupport, ?_⟩ + intro r + rw [hfinalRows r, hrowsOne r] + simp only [List.mem_cons] + tauto + +/-- Support and injectivity are preserved even when some augmenting searches +fail. -/ +theorem kuhnBuild_support {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) (rows : List (Fin n)) + (mate : ColumnMate n) + (hnodup : rows.Nodup) + (hsupport : IsSupportColumnMate A mate) + (hunmatched : ∀ r, r ∈ rows → RowUnmatched mate r) : + IsSupportColumnMate A (kuhnBuild A rows mate) := by + induction rows generalizing mate with + | nil => simpa [kuhnBuild] using hsupport + | cons row rows ih => + have hrowUnmatched : RowUnmatched mate row := + hunmatched row (by simp) + cases hresult : (kuhnAugment A (n + 1) row ∅ mate).mate? with + | none => + have htailUnmatched : ∀ r, r ∈ rows → RowUnmatched mate r := by + intro r hr + exact hunmatched r (by simp [hr]) + simpa [kuhnBuild, hresult] using + ih mate hnodup.tail hsupport htailUnmatched + | some mateOne => + obtain ⟨hsupportOne, hrowsOne⟩ := + kuhnAugment_success A row mate mateOne hsupport hrowUnmatched hresult + have hheadNotMem : row ∉ rows := (List.nodup_cons.mp hnodup).1 + have htailUnmatched : ∀ r, r ∈ rows → RowUnmatched mateOne r := by + intro r hr + rw [rowUnmatched_iff_not_matchesRow] + intro hmatched + rw [hrowsOne r] at hmatched + rcases hmatched with hmatched | heq + · exact (rowUnmatched_iff_not_matchesRow mate r).mp + (hunmatched r (by simp [hr])) hmatched + · subst r + exact hheadNotMem hr + simpa [kuhnBuild, hresult] using + ih mateOne hnodup.tail hsupportOne htailUnmatched + +def kuhnColumnMate {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) : ColumnMate n := + kuhnBuild A (List.finRange n) (emptyColumnMate n) + +def matchedRowDecision {n : ℕ} (mate : ColumnMate n) (row : Fin n) : Bool := + (List.finRange n).any fun col ↦ mate col == some row + +theorem matchedRowDecision_eq_true_iff {n : ℕ} + (mate : ColumnMate n) (row : Fin n) : + matchedRowDecision mate row = true ↔ MatchesRow mate row := by + simp [matchedRowDecision, MatchesRow] + +/-- The executable support-perfect-matching decision. -/ +def kuhnSupportMatchingDecision {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) : Bool := + (List.finRange n).all fun row ↦ matchedRowDecision (kuhnColumnMate A) row + +/-- Coordinate inspections in matching construction plus the final `n` by +`n` row-coverage check. -/ +def kuhnSupportMatchingWork {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) : ℕ := + kuhnBuildWork A (List.finRange n) (emptyColumnMate n) + n * n + +theorem kuhnSupportMatchingWork_le {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) : + kuhnSupportMatchingWork A ≤ + n * (n + (n + 1) * n) + n * n := by + exact Nat.add_le_add_right + (by simpa using kuhnBuildWork_le A (List.finRange n) (emptyColumnMate n)) _ + +theorem kuhnColumnMate_support {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) : + IsSupportColumnMate A (kuhnColumnMate A) := by + apply kuhnBuild_support A (List.finRange n) (emptyColumnMate n) + · exact List.nodup_finRange n + · exact emptyColumnMate_support n A + · intro row _ + exact rowUnmatched_emptyColumnMate n row + +theorem hasPerfectMatching_of_all_rows_matched {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) (mate : ColumnMate n) + (hsupport : IsSupportColumnMate A mate) + (hallRows : ∀ row, MatchesRow mate row) : + Matrix.HasPerfectMatching A := by + classical + let colOfRow : Fin n → Fin n := fun row ↦ Classical.choose (hallRows row) + have colOfRow_spec (row : Fin n) : mate (colOfRow row) = some row := + Classical.choose_spec (hallRows row) + have colOfRow_injective : Function.Injective colOfRow := by + intro r s hrs + have hr := colOfRow_spec r + have hs := colOfRow_spec s + rw [hrs] at hr + rw [hr] at hs + exact Option.some.inj hs + have colOfRow_bijective : Function.Bijective colOfRow := + (Fintype.bijective_iff_injective_and_card colOfRow).2 + ⟨colOfRow_injective, rfl⟩ + let e : Fin n ≃ Fin n := Equiv.ofBijective colOfRow colOfRow_bijective + refine ⟨e.symm, ?_⟩ + intro col + have heq : colOfRow (e.symm col) = col := e.apply_symm_apply col + apply hsupport.support + calc + mate col = mate (colOfRow (e.symm col)) := congrArg mate heq.symm + _ = some (e.symm col) := colOfRow_spec (e.symm col) + +theorem kuhnColumnMate_all_rows_of_hasPerfectMatching {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) + (hperfect : Matrix.HasPerfectMatching A) : + ∀ row, MatchesRow (kuhnColumnMate A) row := by + obtain ⟨_, hrows⟩ := kuhnBuild_of_hasPerfectMatching A + (List.finRange n) (emptyColumnMate n) hperfect + (List.nodup_finRange n) (emptyColumnMate_support n A) + (fun row _ ↦ rowUnmatched_emptyColumnMate n row) + intro row + simpa [kuhnColumnMate] using + (hrows row).2 (Or.inr (List.mem_finRange row)) + +theorem kuhnSupportMatchingDecision_eq_true_iff {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) : + kuhnSupportMatchingDecision A = true ↔ Matrix.HasPerfectMatching A := by + constructor + · intro hdecision + apply hasPerfectMatching_of_all_rows_matched A (kuhnColumnMate A) + (kuhnColumnMate_support A) + intro row + have hrow := (List.all_eq_true.mp hdecision) row (List.mem_finRange row) + exact (matchedRowDecision_eq_true_iff _ _).mp hrow + · intro hperfect + apply List.all_eq_true.mpr + intro row _ + exact (matchedRowDecision_eq_true_iff _ _).mpr + (kuhnColumnMate_all_rows_of_hasPerfectMatching A hperfect row) + +theorem kuhnSupportMatchingDecision_eq_false_iff {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) : + kuhnSupportMatchingDecision A = false ↔ ¬Matrix.HasPerfectMatching A := by + rw [← kuhnSupportMatchingDecision_eq_true_iff] + exact Bool.eq_false_iff + +theorem emptyColumnMate_apply (n : ℕ) (j : Fin n) : + emptyColumnMate n j = none := rfl + +theorem kuhnAugment_zero {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) (row : Fin n) + (seen : Finset (Fin n)) (mate : ColumnMate n) : + kuhnAugment A 0 row seen mate = ⟨none, seen⟩ := by + simp [kuhnAugment, kuhnSearch] + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/KuhnSmallStep.lean b/LeanPool/BeyondBethe/BeyondBethe/KuhnSmallStep.lean new file mode 100644 index 0000000000..2673231b79 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/KuhnSmallStep.lean @@ -0,0 +1,377 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.KuhnMatching +import Mathlib.Tactic + +/-! +# A small-step evaluator for the Kuhn matching algorithm + +The recursive search in `KuhnMatching` is convenient for its mathematical +correctness proof. A Turing-machine implementation needs an explicit call +stack. This file gives that stack machine, proves that it returns exactly the +same result as `kuhnSearch`, and charges every transition to the already proved +coordinate-inspection counter. + +There is no encoding or complexity-class claim in this file. Its purpose is +to isolate the semantic compiler-correctness argument from the subsequent +finite-word implementation. +-/ + +namespace BeyondBethe + +/-- The information needed after a recursive alternating-path search returns. +On success the saved edge is installed. On failure the parent row resumes at +its saved column suffix with its original mate table. -/ +structure KuhnSearchFrame (n : ℕ) where + fuel : ℕ + remaining : List (Fin n) + row : Fin n + mate : ColumnMate n + column : Fin n + +/-- The outer frame remembers the rows not yet inserted and the mate table to +retain if the current root search fails. -/ +structure KuhnBuildFrame (n : ℕ) where + rows : List (Fin n) + fallback : ColumnMate n + +inductive KuhnFrame (n : ℕ) + | search : KuhnSearchFrame n → KuhnFrame n + | build : KuhnBuildFrame n → KuhnFrame n + +/-- A call state, a returned search result, or the final mate table. -/ +inductive KuhnEvalState (n : ℕ) + | call (fuel : ℕ) (remaining : List (Fin n)) (row : Fin n) + (seen : Finset (Fin n)) (mate : ColumnMate n) + (stack : List (KuhnFrame n)) + | ret (result : KuhnSearchResult n) (stack : List (KuhnFrame n)) + | done (mate : ColumnMate n) + +/-- One transition of the explicit-stack evaluator. -/ +def kuhnEvalStep {n : ℕ} (A : Matrix (Fin n) (Fin n) ℚ) : + KuhnEvalState n → KuhnEvalState n + | .done mate => .done mate + | .call 0 _remaining _row seen _mate stack => + .ret ⟨none, seen⟩ stack + | .call (_fuel + 1) [] _row seen _mate stack => + .ret ⟨none, seen⟩ stack + | .call (fuel + 1) (col :: remaining) row seen mate stack => + if col ∈ seen ∨ A row col = 0 then + .call (fuel + 1) remaining row seen mate stack + else + let seen' := insert col seen + match mate col with + | none => + .ret ⟨some (Function.update mate col (some row)), seen'⟩ stack + | some oldRow => + let frame : KuhnSearchFrame n := + ⟨fuel + 1, remaining, row, mate, col⟩ + .call fuel (List.finRange n) oldRow seen' + (Function.update mate col none) (.search frame :: stack) + | .ret result [] => .ret result [] + | .ret result (.search frame :: stack) => + match result.mate? with + | some mate' => + .ret + ⟨some (Function.update mate' frame.column (some frame.row)), + result.seen⟩ stack + | none => + .call frame.fuel frame.remaining frame.row result.seen + frame.mate stack + | .ret result (.build frame :: stack) => + let mate := result.mate?.getD frame.fallback + match frame.rows with + | [] => .done mate + | row :: rows => + .call (n + 1) (List.finRange n) row ∅ mate + (.build ⟨rows, mate⟩ :: stack) + +/-- Exact number of small steps used to evaluate one recursive search call and +return its result without consuming the pre-existing continuation stack. -/ +def kuhnSearchSteps {n : ℕ} (A : Matrix (Fin n) (Fin n) ℚ) : + (fuel : ℕ) → List (Fin n) → Fin n → Finset (Fin n) → + ColumnMate n → ℕ + | 0, _remaining, _row, _seen, _mate => 1 + | _fuel + 1, [], _row, _seen, _mate => 1 + | fuel + 1, col :: remaining, row, seen, mate => + if col ∈ seen ∨ A row col = 0 then + 1 + kuhnSearchSteps A (fuel + 1) remaining row seen mate + else + let seen' := insert col seen + match mate col with + | none => 1 + | some oldRow => + let mateWithoutOld := Function.update mate col none + let recursive := + kuhnSearch A fuel (List.finRange n) oldRow seen' mateWithoutOld + let recursiveSteps := + kuhnSearchSteps A fuel (List.finRange n) oldRow seen' + mateWithoutOld + match recursive.mate? with + | some _ => 2 + recursiveSteps + | none => 2 + recursiveSteps + + kuhnSearchSteps A (fuel + 1) remaining row recursive.seen mate +termination_by fuel remaining _row _seen _mate => (fuel, remaining.length) + +/-- The stack evaluator is a semantics-preserving compilation of one +`kuhnSearch` call. -/ +theorem kuhnEvalStep_iterate_call {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) (fuel : ℕ) + (remaining : List (Fin n)) (row : Fin n) + (seen : Finset (Fin n)) (mate : ColumnMate n) + (stack : List (KuhnFrame n)) : + (kuhnEvalStep A)^[kuhnSearchSteps A fuel remaining row seen mate] + (.call fuel remaining row seen mate stack) = + .ret (kuhnSearch A fuel remaining row seen mate) stack := by + fun_induction kuhnSearch generalizing stack with + | case1 => + simp [kuhnSearchSteps, Function.iterate_one, kuhnEvalStep.eq_def, + kuhnSearch] + | case2 => + simp [kuhnSearchSteps, Function.iterate_one, kuhnEvalStep.eq_def, + kuhnSearch] + | case3 fuel col remaining row seen mate hskip ih => + rw [kuhnSearchSteps] + simp only [hskip, ↓reduceIte] + rw [show 1 + kuhnSearchSteps A (fuel + 1) remaining row seen mate = + kuhnSearchSteps A (fuel + 1) remaining row seen mate + 1 by omega, + Function.iterate_succ_apply, kuhnEvalStep.eq_def] + simp only [hskip, ↓reduceIte] + simpa [kuhnSearch, hskip] using ih stack + | case4 fuel col remaining row seen mate hskip seen' hmate => + rw [kuhnSearchSteps] + simp only [hskip, ↓reduceIte, hmate] + simp [Function.iterate_one, kuhnEvalStep.eq_def, hskip, hmate, seen'] + | case5 fuel col remaining row seen mate hskip seen' oldRow hmate + mateWithoutOld recursive mateRec hrec ih => + rw [kuhnSearchSteps] + simp only [hskip, ↓reduceIte, hmate] + rw [show recursive.mate? = some mateRec by exact hrec] + simp only + let frame : KuhnSearchFrame n := + ⟨fuel + 1, remaining, row, mate, col⟩ + let steps := kuhnSearchSteps A fuel (List.finRange n) oldRow seen' + mateWithoutOld + change (kuhnEvalStep A)^[2 + steps] + (.call (fuel + 1) (col :: remaining) row seen mate stack) = + .ret ⟨some (Function.update mateRec col (some row)), recursive.seen⟩ + stack + calc + (kuhnEvalStep A)^[2 + steps] + (.call (fuel + 1) (col :: remaining) row seen mate stack) = + kuhnEvalStep A + ((kuhnEvalStep A)^[steps] + (kuhnEvalStep A + (.call (fuel + 1) (col :: remaining) row seen mate stack))) := by + rw [show 2 + steps = 1 + steps + 1 by omega, + Function.iterate_add_apply, Function.iterate_add_apply, + Function.iterate_one] + _ = kuhnEvalStep A + ((kuhnEvalStep A)^[steps] + (.call fuel (List.finRange n) oldRow seen' mateWithoutOld + (.search frame :: stack))) := by + simp [kuhnEvalStep.eq_def, hskip, hmate, seen', + mateWithoutOld, frame] + _ = kuhnEvalStep A (.ret recursive (.search frame :: stack)) := by + rw [show (kuhnEvalStep A)^[steps] + (.call fuel (List.finRange n) oldRow seen' mateWithoutOld + (.search frame :: stack)) = + .ret recursive (.search frame :: stack) by + simpa [steps, recursive] using + ih (.search frame :: stack)] + _ = .ret + ⟨some (Function.update mateRec col (some row)), recursive.seen⟩ + stack := by + simp [kuhnEvalStep.eq_def, frame, hrec] + | case6 fuel col remaining row seen mate hskip seen' oldRow hmate + mateWithoutOld recursive hrec ihRec ihRec' ihContinue => + rw [kuhnSearchSteps] + simp only [hskip, ↓reduceIte, hmate] + rw [show recursive.mate? = none by exact hrec] + simp only + let frame : KuhnSearchFrame n := + ⟨fuel + 1, remaining, row, mate, col⟩ + let recursiveSteps := kuhnSearchSteps A fuel (List.finRange n) oldRow + seen' mateWithoutOld + let continueSteps := kuhnSearchSteps A (fuel + 1) remaining row + recursive.seen mate + change (kuhnEvalStep A)^[2 + recursiveSteps + continueSteps] + (.call (fuel + 1) (col :: remaining) row seen mate stack) = + .ret (kuhnSearch A (fuel + 1) remaining row recursive.seen mate) stack + calc + (kuhnEvalStep A)^[2 + recursiveSteps + continueSteps] + (.call (fuel + 1) (col :: remaining) row seen mate stack) = + (kuhnEvalStep A)^[continueSteps] + (kuhnEvalStep A + ((kuhnEvalStep A)^[recursiveSteps] + (kuhnEvalStep A + (.call (fuel + 1) (col :: remaining) row seen mate + stack)))) := by + rw [show 2 + recursiveSteps + continueSteps = + continueSteps + 1 + recursiveSteps + 1 by omega, + Function.iterate_add_apply, Function.iterate_add_apply, + Function.iterate_add_apply, Function.iterate_one] + _ = (kuhnEvalStep A)^[continueSteps] + (kuhnEvalStep A + ((kuhnEvalStep A)^[recursiveSteps] + (.call fuel (List.finRange n) oldRow seen' mateWithoutOld + (.search frame :: stack)))) := by + simp [kuhnEvalStep.eq_def, hskip, hmate, seen', + mateWithoutOld, frame] + _ = (kuhnEvalStep A)^[continueSteps] + (kuhnEvalStep A (.ret recursive (.search frame :: stack))) := by + rw [show (kuhnEvalStep A)^[recursiveSteps] + (.call fuel (List.finRange n) oldRow seen' mateWithoutOld + (.search frame :: stack)) = + .ret recursive (.search frame :: stack) by + simpa [recursiveSteps, recursive] using + ihRec' (.search frame :: stack)] + _ = (kuhnEvalStep A)^[continueSteps] + (.call (fuel + 1) remaining row recursive.seen mate stack) := by + simp [kuhnEvalStep.eq_def, frame, hrec] + _ = .ret (kuhnSearch A (fuel + 1) remaining row recursive.seen mate) + stack := by + simpa [continueSteps] using ihContinue stack + +/-- Each evaluator transition is charged to at most three coordinate +inspections, with one terminal transition left over. -/ +theorem kuhnSearchSteps_le {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) (fuel : ℕ) + (remaining : List (Fin n)) (row : Fin n) + (seen : Finset (Fin n)) (mate : ColumnMate n) : + kuhnSearchSteps A fuel remaining row seen mate ≤ + 3 * kuhnSearchWork A fuel remaining row seen mate + 1 := by + fun_induction kuhnSearchSteps with + | case1 => simp [kuhnSearchWork] + | case2 => simp [kuhnSearchWork] + | case3 fuel col remaining row seen mate hskip ih => + simp only [kuhnSearchWork, hskip, ↓reduceIte] + omega + | case4 fuel col remaining row seen mate hskip hmate => + simp [kuhnSearchWork, hskip, hmate] + | case5 fuel col remaining row seen mate hskip seen' oldRow hmate + mateWithoutOld recursive recursiveSteps mateRec hrec ih => + simp only [kuhnSearchWork, hskip, ↓reduceIte, hmate] + rw [show recursive.mate? = some mateRec by exact hrec] + change 2 + recursiveSteps ≤ + 3 * (1 + kuhnSearchWork A fuel (List.finRange n) oldRow seen' + mateWithoutOld) + 1 + omega + | case6 fuel col remaining row seen mate hskip seen' oldRow hmate + mateWithoutOld recursive recursiveSteps hrec ihRec ihContinue => + simp only [kuhnSearchWork, hskip, ↓reduceIte, hmate] + rw [show recursive.mate? = none by exact hrec] + change 2 + recursiveSteps + + kuhnSearchSteps A (fuel + 1) remaining row recursive.seen mate ≤ + 3 * (1 + kuhnSearchWork A fuel (List.finRange n) oldRow seen' + mateWithoutOld + + kuhnSearchWork A (fuel + 1) remaining row recursive.seen mate) + 1 + omega + +/-- Start (or finish) the explicit evaluator on a remaining row list. -/ +def kuhnBuildEvalState {n : ℕ} (A : Matrix (Fin n) (Fin n) ℚ) + (rows : List (Fin n)) (mate : ColumnMate n) : KuhnEvalState n := + match rows with + | [] => .done mate + | row :: rows => + .call (n + 1) (List.finRange n) row ∅ mate + [.build ⟨rows, mate⟩] + +/-- Exact number of transitions used by the explicit evaluator for the row +building phase. -/ +def kuhnBuildSteps {n : ℕ} (A : Matrix (Fin n) (Fin n) ℚ) : + List (Fin n) → ColumnMate n → ℕ + | [], _mate => 0 + | row :: rows, mate => + let result := kuhnAugment A (n + 1) row ∅ mate + kuhnSearchSteps A (n + 1) (List.finRange n) row ∅ mate + 1 + + kuhnBuildSteps A rows (result.mate?.getD mate) + +@[simp] theorem kuhnEvalStep_return_build {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) (rows : List (Fin n)) + (fallback : ColumnMate n) (result : KuhnSearchResult n) : + kuhnEvalStep A + (.ret result [.build ⟨rows, fallback⟩]) = + kuhnBuildEvalState A rows (result.mate?.getD fallback) := by + cases rows <;> rfl + +/-- The complete small-step evaluator returns exactly `kuhnBuild`. -/ +theorem kuhnBuildEvalState_iterate {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) (rows : List (Fin n)) + (mate : ColumnMate n) : + (kuhnEvalStep A)^[kuhnBuildSteps A rows mate] + (kuhnBuildEvalState A rows mate) = + .done (kuhnBuild A rows mate) := by + induction rows generalizing mate with + | nil => simp [kuhnBuildSteps, kuhnBuildEvalState, kuhnBuild] + | cons row rows ih => + let result := kuhnAugment A (n + 1) row ∅ mate + let oneSteps := + kuhnSearchSteps A (n + 1) (List.finRange n) row ∅ mate + let nextMate := result.mate?.getD mate + rw [kuhnBuildSteps] + change (kuhnEvalStep A)^[oneSteps + 1 + kuhnBuildSteps A rows nextMate] + (KuhnEvalState.call (n + 1) (List.finRange n) row ∅ mate + [.build ⟨rows, mate⟩]) = _ + rw [show oneSteps + 1 + kuhnBuildSteps A rows nextMate = + kuhnBuildSteps A rows nextMate + 1 + oneSteps by omega, + Function.iterate_add_apply, Function.iterate_add_apply, + Function.iterate_one] + rw [kuhnEvalStep_iterate_call] + change (kuhnEvalStep A)^[kuhnBuildSteps A rows nextMate] + (kuhnEvalStep A (.ret result [.build ⟨rows, mate⟩])) = _ + rw [kuhnEvalStep_return_build, ih] + simp [kuhnBuild, result, nextMate] + +/-- The whole build uses a cubic number of explicit-stack transitions. -/ +theorem kuhnBuildSteps_le {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) (rows : List (Fin n)) + (mate : ColumnMate n) : + kuhnBuildSteps A rows mate ≤ + 3 * kuhnBuildWork A rows mate + 2 * rows.length := by + induction rows generalizing mate with + | nil => simp [kuhnBuildSteps, kuhnBuildWork] + | cons row rows ih => + let result := kuhnAugment A (n + 1) row ∅ mate + have hone := kuhnSearchSteps_le A (n + 1) (List.finRange n) + row ∅ mate + have htail := ih (result.mate?.getD mate) + change kuhnSearchSteps A (n + 1) (List.finRange n) row ∅ mate + 1 + + kuhnBuildSteps A rows (result.mate?.getD mate) ≤ + 3 * (kuhnSearchWork A (n + 1) (List.finRange n) row ∅ mate + + kuhnBuildWork A rows (result.mate?.getD mate)) + + 2 * (rows.length + 1) + omega + +/-- Starting from the empty mate table and all rows, the evaluator returns the +same column mate used by the proved support-matching decision. -/ +theorem kuhnFullBuildEvalState_iterate {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) : + (kuhnEvalStep A)^[kuhnBuildSteps A (List.finRange n) + (emptyColumnMate n)] + (kuhnBuildEvalState A (List.finRange n) (emptyColumnMate n)) = + .done (kuhnColumnMate A) := by + simpa [kuhnColumnMate] using + kuhnBuildEvalState_iterate A (List.finRange n) (emptyColumnMate n) + +theorem kuhnFullBuildSteps_le {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) : + kuhnBuildSteps A (List.finRange n) (emptyColumnMate n) ≤ + 3 * (n * (n + (n + 1) * n)) + 2 * n := by + calc + kuhnBuildSteps A (List.finRange n) (emptyColumnMate n) ≤ + 3 * kuhnBuildWork A (List.finRange n) (emptyColumnMate n) + + 2 * (List.finRange n).length := + kuhnBuildSteps_le A _ _ + _ ≤ 3 * (n * (n + (n + 1) * n)) + 2 * n := by + simp only [List.length_finRange] + have hwork := kuhnBuildWork_le A (List.finRange n) + (emptyColumnMate n) + simp only [List.length_finRange] at hwork + omega + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineArithmeticTests.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineArithmeticTests.lean new file mode 100644 index 0000000000..d2885abb52 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineArithmeticTests.lean @@ -0,0 +1,291 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.RawRational +import LeanPool.BeyondBethe.BeyondBethe.MachineBinaryMul +import LeanPool.BeyondBethe.BeyondBethe.MachineBinaryCompare +import LeanPool.BeyondBethe.BeyondBethe.MachineBinaryDivision +import LeanPool.BeyondBethe.BeyondBethe.MachineBinaryGCD +import LeanPool.BeyondBethe.BeyondBethe.MachineIntegerArithmetic +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalNormalization +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalArithmetic +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalUnary +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalCompare +import LeanPool.BeyondBethe.BeyondBethe.MachineDyadicFloor +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalFloor +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalLogSeries +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalExp +import LeanPool.BeyondBethe.BeyondBethe.MachineDirectedLog +import LeanPool.BeyondBethe.BeyondBethe.MachineMatrixNonnegative +import LeanPool.BeyondBethe.BeyondBethe.MachineMatrixSum +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalMin +import LeanPool.BeyondBethe.BeyondBethe.MachineFactorial +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalRowAdd +import LeanPool.BeyondBethe.BeyondBethe.MachineNearbyCoordinate + +/-! # Machine Arithmetic Tests -/ + +namespace BeyondBethe + +/-! Exhaustive executable smoke tests for the machine-arithmetic core. -/ + +theorem binaryLongDiv_exhaustive_256_by_64 : + ∀ a : Fin 256, ∀ b : Fin 64, + binaryLongDiv a.val b.val = (a.val / b.val, a.val % b.val) := by + native_decide + +theorem binaryEuclidBounded_exhaustive_128_by_128 : + ∀ a : Fin 128, ∀ b : Fin 128, + binaryEuclidBounded a.val b.val = Nat.gcd a.val b.val := by + native_decide + +theorem machineBinaryMul_exhaustive_64_by_64 : + ∀ a : Fin 64, ∀ b : Fin 64, + machineBinaryMulBits (Complexity.pair a.val.bits b.val.bits) = + (a.val * b.val).bits := by + native_decide + +theorem machineBinarySub_exhaustive_64_by_64 : + ∀ a : Fin 64, ∀ b : Fin 64, + machineBinarySubBits (Complexity.pair a.val.bits b.val.bits) = + (a.val - b.val).bits := by + native_decide + +theorem machineBinaryCompare_exhaustive_64_by_64 : + ∀ a : Fin 64, ∀ b : Fin 64, + machineBinaryNatLeBit (Complexity.pair a.val.bits b.val.bits) = + [decide (a.val ≤ b.val)] ∧ + machineBinaryNatLtBit (Complexity.pair a.val.bits b.val.bits) = + [decide (a.val < b.val)] ∧ + machineBinaryNatEqBit (Complexity.pair a.val.bits b.val.bits) = + [decide (a.val = b.val)] := by + native_decide + +theorem machineBinaryDivision_exhaustive_64_by_32 : + ∀ a : Fin 64, ∀ b : Fin 32, + machineBinaryDivModBits (Complexity.pair a.val.bits b.val.bits) = + Complexity.pair (a.val / b.val).bits (a.val % b.val).bits := by + native_decide + +theorem machineBinaryGcd_exhaustive_32_by_32 : + ∀ a : Fin 32, ∀ b : Fin 32, + machineBinaryGcdBits (Complexity.pair a.val.bits b.val.bits) = + (Nat.gcd a.val b.val).bits := by + native_decide + +def signedIntegerTest (negative : Bool) (n : ℕ) : ℤ := + if negative then Int.negSucc n else Int.ofNat n + +theorem machineIntegerArithmetic_exhaustive_signed_16 : + ∀ leftNegative rightNegative : Bool, ∀ a b : Fin 16, + machineIntegerAddCode + (Complexity.pair + (integerBinaryCode (signedIntegerTest leftNegative a.val)) + (integerBinaryCode (signedIntegerTest rightNegative b.val))) = + integerBinaryCode + (signedIntegerTest leftNegative a.val + + signedIntegerTest rightNegative b.val) ∧ + machineIntegerMulCode + (Complexity.pair + (integerBinaryCode (signedIntegerTest leftNegative a.val)) + (integerBinaryCode (signedIntegerTest rightNegative b.val))) = + integerBinaryCode + (signedIntegerTest leftNegative a.val * + signedIntegerTest rightNegative b.val) ∧ + machineIntegerNegCode + (integerBinaryCode (signedIntegerTest leftNegative a.val)) = + integerBinaryCode (-signedIntegerTest leftNegative a.val) := by + native_decide + +def positiveRawRatTest (n d : ℕ) : RawRat := + ⟨Int.ofNat n, d + 1, by omega⟩ + +def negativeRawRatTest (n d : ℕ) : RawRat := + ⟨Int.negSucc n, d + 1, by omega⟩ + +def signedRawRatTest (negative : Bool) (n d : ℕ) : RawRat := + if negative then negativeRawRatTest n d else positiveRawRatTest n d + +theorem machineRationalNormalization_exhaustive_signed_8_by_8 : + ∀ n : Fin 8, ∀ d : Fin 8, + machineNormalizeRawRatBinaryCode + (rawRatBinaryCode (positiveRawRatTest n.val d.val)) = + rationalBinaryCode + (binaryNormalizeRawRat (positiveRawRatTest n.val d.val)) ∧ + machineNormalizeRawRatBinaryCode + (rawRatBinaryCode (negativeRawRatTest n.val d.val)) = + rationalBinaryCode + (binaryNormalizeRawRat (negativeRawRatTest n.val d.val)) := by + native_decide + +theorem machineRationalArithmetic_exhaustive_signed_3 : + ∀ leftNegative rightNegative : Bool, + ∀ leftNum leftDen rightNum rightDen : Fin 3, + let q := signedRawRatTest leftNegative leftNum.val leftDen.val + let r := signedRawRatTest rightNegative rightNum.val rightDen.val + machineRationalAddCode + (Complexity.pair (rawRatBinaryCode q) (rawRatBinaryCode r)) = + rationalBinaryCode (binaryNormalizeRawRat (q.add r)) ∧ + machineRationalMulCode + (Complexity.pair (rawRatBinaryCode q) (rawRatBinaryCode r)) = + rationalBinaryCode (binaryNormalizeRawRat (q.mul r)) := by + native_decide + +theorem machineRationalComparison_exhaustive_signed_4 : + ∀ leftNegative rightNegative : Bool, + ∀ leftNum leftDen rightNum rightDen : Fin 4, + let q := signedRawRatTest leftNegative leftNum.val leftDen.val + let r := signedRawRatTest rightNegative rightNum.val rightDen.val + machineRawRatLeBit + (Complexity.pair (rawRatBinaryCode q) (rawRatBinaryCode r)) = + [decide (q.value ≤ r.value)] := by + native_decide + +theorem machineRationalUnary_exhaustive_signed_3 : + ∀ leftNegative rightNegative : Bool, + ∀ leftNum leftDen rightNum rightDen : Fin 3, + let q := signedRawRatTest leftNegative leftNum.val leftDen.val + let r := signedRawRatTest rightNegative rightNum.val rightDen.val + machineRationalNegCode (rawRatBinaryCode q) = + rationalBinaryCode (binaryNormalizeRawRat q.neg) ∧ + machineRationalInvCode (rawRatBinaryCode q) = + rationalBinaryCode (binaryNormalizeRawRat q.inv) ∧ + machineRationalDivCode + (Complexity.pair (rawRatBinaryCode q) (rawRatBinaryCode r)) = + rationalBinaryCode (binaryNormalizeRawRat (q.div r)) := by + native_decide + +theorem machineDyadicFloor_exhaustive_signed_4 : + ∀ negative : Bool, ∀ p n d : Fin 4, + let q := signedRawRatTest negative n.val d.val + machineDyadicFloorCode + (Complexity.pair (List.replicate p.val true) + (rawRatBinaryCode q)) = + rationalBinaryCode (binaryDyadicFloor p.val q.value) := by + native_decide + +theorem machineRationalFloorCeil_exhaustive_signed_8 : + ∀ negative : Bool, ∀ n : Fin 8, ∀ d : Fin 8, + let q := signedRawRatTest negative n.val d.val + machineRationalFloorIntegerCode (rawRatBinaryCode q) = + integerBinaryCode (binaryRatFloor q.value) ∧ + machineRationalCeilIntegerCode (rawRatBinaryCode q) = + integerBinaryCode (binaryRatCeil q.value) ∧ + machineRationalCeilNatBits (rawRatBinaryCode q) = + (Int.toNat (binaryRatCeil q.value)).bits := by + native_decide + +theorem machineRationalLogSeriesSum_exhaustive_signed_3 : + ∀ negative : Bool, ∀ n : Fin 3, ∀ d : Fin 3, ∀ N : Fin 3, + let q := signedRawRatTest negative n.val d.val + machineRationalLogSeriesSumCode + (Complexity.pair (List.replicate N.val true) + (rawRatBinaryCode q)) = + rationalBinaryCode (binaryRationalLogSeriesSum q.value N.val) := by + native_decide + +theorem machineBoundedUnary_exhaustive_8 : + ∀ guard n : Fin 8, + machineBoundedUnary + (Complexity.pair (List.replicate guard.val true) n.val.bits) = + List.replicate (min guard.val n.val) true := by + native_decide + +theorem machineBoundedRationalExpLower_small_signed : + ∀ negative : Bool, ∀ n d : Fin 2, + let s := signedRawRatTest negative n.val d.val + let M := RawRat.expApproxSteps s RawRat.one + machineBoundedRationalExpLowerCode + (Complexity.pair (List.replicate M true) + (Complexity.pair (rawRatBinaryCode s) + (rawRatBinaryCode RawRat.one))) = + rationalBinaryCode + (binaryRationalExpLower s.value RawRat.one.value) := by + native_decide + +theorem machineLengthBits_exhaustive_16 : + ∀ n : Fin 16, + machineLengthBits (List.replicate n.val true) = n.val.bits := by + native_decide + +def positiveNonzeroRawRatTest (n d : ℕ) : RawRat := + ⟨Int.ofNat (n + 1), d + 1, by omega⟩ + +theorem machineDirectedLog_small_positive : + ∀ n d N : Fin 2, + let q := (positiveNonzeroRawRatTest n.val d.val).value + machineDirectedLogLowerCode + (Complexity.pair (List.replicate N.val true) + (rawRatBinaryCode (rawRatOfRat q))) = + rationalBinaryCode (binaryDirectedLogLower q N.val) ∧ + machineDirectedLogUpperCode + (Complexity.pair (List.replicate N.val true) + (rawRatBinaryCode (rawRatOfRat q))) = + rationalBinaryCode (binaryDirectedLogUpper q N.val) := by + intro n d N + dsimp only + exact ⟨machineDirectedLogLowerCode_encode _ _, + machineDirectedLogUpperCode_encode _ _⟩ + +theorem machineMatrixNonnegative_two_by_two : + ∀ negative : Bool, + let A : Matrix (Fin 2) (Fin 2) ℚ := fun i j ↦ + if negative && decide (i = 0) && decide (j = 0) then -1 else 1 + machineMatrixNonnegativeBit + (rationalMatrixBinaryEncoding.encode ⟨2, A⟩) = + [!negative] := by + native_decide + +theorem machineMatrixSum_two_by_two_constant : + ∀ q : Fin 3, + let A : Matrix (Fin 2) (Fin 2) ℚ := fun _ _ ↦ q.val + machineMatrixSumOutputCode + (rationalMatrixBinaryEncoding.encode ⟨2, A⟩) = + rationalBinaryCode (4 * q.val) := by + native_decide + +theorem machineRationalMin_exhaustive_positive_3 : + ∀ leftNum leftDen rightNum rightDen : Fin 3, + let q := positiveRawRatTest leftNum.val leftDen.val + let r := positiveRawRatTest rightNum.val rightDen.val + machineRationalMinCode + (Complexity.pair (rawRatBinaryCode q) (rawRatBinaryCode r)) = + rationalBinaryCode (min q.value r.value) := by + native_decide + +theorem machineFactorial_exhaustive_8 : + ∀ n : Fin 8, + machineFactorialRawRatCode (List.replicate n.val true) = + rawRatBinaryCode (RawRat.ofNat n.val.factorial) := by + native_decide + +theorem machineRationalRowAdd_exhaustive_2 : + ∀ deltaNum deltaDen left right : Fin 2, + let delta := positiveRawRatTest deltaNum.val deltaDen.val + let row : List ℚ := [left.val, right.val] + machineRationalRowAdd + (machineRationalRowAddCanonicalInput delta row) = + binaryListCode rationalEntryBinaryCode + (rationalRowAddValues delta row) := by + native_decide + +theorem machineScheduledLogTermsRuler_three_halves : + machineScheduledLogTermsRuler + (Complexity.pair (List.replicate 3 true) + (rawRatBinaryCode (rawRatOfRat (3 / 2 : ℚ)))) = + List.replicate (directedLogTerms (3 / 2 : ℚ) 3) true := by + native_decide + +theorem machineNearbyCoordinate_one_third : + let tau := rawRatOfRat (1 / 4 : ℚ) + machineNearbyCoordinateLowerRawCode + (Complexity.pair (List.replicate 3 true) + (Complexity.pair (rawRatBinaryCode tau) + (rationalEntryBinaryCode (1 / 3 : ℚ)))) = + rawRatBinaryCode (rawNearbyCoordinateLower tau (1 / 3 : ℚ) 3) := by + exact machineNearbyCoordinateLowerRawCode_encode _ _ _ + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineBetheAffineEntry.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineBetheAffineEntry.lean new file mode 100644 index 0000000000..99fada37cb --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineBetheAffineEntry.lean @@ -0,0 +1,526 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineBetheAffineLineSum +import LeanPool.BeyondBethe.BeyondBethe.MachineRowPairDisjoint +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalUnary + +/-! +# Exact finite-word entries of the Birkhoff affine recovery + +From a flattened `m`-by-`m` rational block, the recovered matrix of order +`m+1` has four kinds of entries: a stored upper-left coordinate, one minus a +row sum, one minus a column sum, and the total sum minus `m-1`. This file +assembles those four cases as one uniform polynomial-time word machine. +-/ + +namespace BeyondBethe + +open Complexity + +def machineBetheAffineEntryDimension (word : List Bool) : List Bool := + machinePairFirst word + +def machineBetheAffineEntryRest (word : List Bool) : List Bool := + machinePairSecond word + +def machineBetheAffineEntryRow (word : List Bool) : List Bool := + machinePairFirst (machineBetheAffineEntryRest word) + +def machineBetheAffineEntryColumn (word : List Bool) : List Bool := + machinePairFirst (machinePairSecond (machineBetheAffineEntryRest word)) + +def machineBetheAffineEntryVector (word : List Bool) : List Bool := + machinePairSecond (machinePairSecond (machineBetheAffineEntryRest word)) + +def machineBetheAffineEntryLastRowBit (word : List Bool) : List Bool := + machineUnaryRulersEqualBit (machineBetheAffineEntryRow word) + (machineBetheAffineEntryDimension word) + +def machineBetheAffineEntryLastColumnBit (word : List Bool) : List Bool := + machineUnaryRulersEqualBit (machineBetheAffineEntryColumn word) + (machineBetheAffineEntryDimension word) + +def machineBetheAffineEntryFlatInput (word : List Bool) : List Bool := + pair [true] + (pair (machineBetheAffineEntryDimension word) + (pair (machineBetheAffineEntryRow word) + (pair (machineBetheAffineEntryColumn word) + (machineBetheAffineEntryVector word)))) + +def machineBetheAffineEntryUpperLeft (word : List Bool) : List Bool := + machineBetheFlatEntryRawCode (machineBetheAffineEntryFlatInput word) + +def machineBetheAffineEntryRowSumInput (word : List Bool) : List Bool := + pair [true] + (pair (machineBetheAffineEntryDimension word) + (pair (machineBetheAffineEntryRow word) + (machineBetheAffineEntryVector word))) + +def machineBetheAffineEntryColumnSumInput (word : List Bool) : List Bool := + pair [false] + (pair (machineBetheAffineEntryDimension word) + (pair (machineBetheAffineEntryColumn word) + (machineBetheAffineEntryVector word))) + +def machineBetheAffineEntryRowSum (word : List Bool) : List Bool := + machineBetheLineSumRawCode (machineBetheAffineEntryRowSumInput word) + +def machineBetheAffineEntryColumnSum (word : List Bool) : List Bool := + machineBetheLineSumRawCode (machineBetheAffineEntryColumnSumInput word) + +def machineRawRatSubCode (word : List Bool) : List Bool := + machineRawRatAddCode + (pair (machinePairFirst word) + (machineRawRatNegCode (machinePairSecond word))) + +def machineBetheAffineEntryLastColumn (word : List Bool) : List Bool := + machineRawRatSubCode + (pair (rawRatBinaryCode RawRat.one) + (machineBetheAffineEntryRowSum word)) + +def machineBetheAffineEntryLastRow (word : List Bool) : List Bool := + machineRawRatSubCode + (pair (rawRatBinaryCode RawRat.one) + (machineBetheAffineEntryColumnSum word)) + +def machineBetheAffineEntryTotal (word : List Bool) : List Bool := + machineRationalVectorRawSumCode (machineBetheAffineEntryVector word) + +def machineBetheAffineEntryDimensionBits (word : List Bool) : List Bool := + machineLengthBits (machineBetheAffineEntryDimension word) + +def machineBetheAffineEntryDimensionMinusOneInteger + (word : List Bool) : List Bool := + machineIntegerAddCode + (pair (machineNaturalIntegerCode + (machineBetheAffineEntryDimensionBits word)) + (integerBinaryCode (-1))) + +def machineBetheAffineEntryDimensionMinusOneRaw + (word : List Bool) : List Bool := + pair (machineBetheAffineEntryDimensionMinusOneInteger word) + (1 : ℕ).bits + +def machineBetheAffineEntryCorner (word : List Bool) : List Bool := + machineRawRatSubCode + (pair (machineBetheAffineEntryTotal word) + (machineBetheAffineEntryDimensionMinusOneRaw word)) + +def machineBetheAffineEntryRawCode (word : List Bool) : List Bool := + machineIfHead (machineBetheAffineEntryLastRowBit word) + (machineIfHead (machineBetheAffineEntryLastColumnBit word) + (machineBetheAffineEntryCorner word) + (machineBetheAffineEntryLastRow word)) + (machineIfHead (machineBetheAffineEntryLastColumnBit word) + (machineBetheAffineEntryLastColumn word) + (machineBetheAffineEntryUpperLeft word)) + +theorem machineBetheAffineEntryDimension_mem_FP : + machineBetheAffineEntryDimension ∈ FP := machinePairFirst_mem_FP + +theorem machineBetheAffineEntryRest_mem_FP : + machineBetheAffineEntryRest ∈ FP := machinePairSecond_mem_FP + +theorem machineBetheAffineEntryRow_mem_FP : + machineBetheAffineEntryRow ∈ FP := by + simpa only [machineBetheAffineEntryRow] using + machineCompose_mem_FP machineBetheAffineEntryRest_mem_FP + machinePairFirst_mem_FP + +theorem machineBetheAffineEntryColumn_mem_FP : + machineBetheAffineEntryColumn ∈ FP := by + have htail := machineCompose_mem_FP machineBetheAffineEntryRest_mem_FP + machinePairSecond_mem_FP + simpa only [machineBetheAffineEntryColumn] using + machineCompose_mem_FP htail machinePairFirst_mem_FP + +theorem machineBetheAffineEntryVector_mem_FP : + machineBetheAffineEntryVector ∈ FP := by + have htail := machineCompose_mem_FP machineBetheAffineEntryRest_mem_FP + machinePairSecond_mem_FP + simpa only [machineBetheAffineEntryVector] using + machineCompose_mem_FP htail machinePairSecond_mem_FP + +theorem machineBetheAffineEntryLastRowBit_mem_FP : + machineBetheAffineEntryLastRowBit ∈ FP := by + exact machineUnaryRulersEqualBit_mem_FP + machineBetheAffineEntryRow_mem_FP machineBetheAffineEntryDimension_mem_FP + +theorem machineBetheAffineEntryLastColumnBit_mem_FP : + machineBetheAffineEntryLastColumnBit ∈ FP := by + exact machineUnaryRulersEqualBit_mem_FP + machineBetheAffineEntryColumn_mem_FP + machineBetheAffineEntryDimension_mem_FP + +theorem machineBetheAffineEntryFlatInput_mem_FP : + machineBetheAffineEntryFlatInput ∈ FP := by + exact machinePair_mem_FP (machineConst_mem_FP [true]) + (machinePair_mem_FP machineBetheAffineEntryDimension_mem_FP + (machinePair_mem_FP machineBetheAffineEntryRow_mem_FP + (machinePair_mem_FP machineBetheAffineEntryColumn_mem_FP + machineBetheAffineEntryVector_mem_FP))) + +theorem machineBetheAffineEntryUpperLeft_mem_FP : + machineBetheAffineEntryUpperLeft ∈ FP := by + simpa only [machineBetheAffineEntryUpperLeft] using + machineCompose_mem_FP machineBetheAffineEntryFlatInput_mem_FP + machineBetheFlatEntryRawCode_mem_FP + +theorem machineBetheAffineEntryRowSumInput_mem_FP : + machineBetheAffineEntryRowSumInput ∈ FP := by + exact machinePair_mem_FP (machineConst_mem_FP [true]) + (machinePair_mem_FP machineBetheAffineEntryDimension_mem_FP + (machinePair_mem_FP machineBetheAffineEntryRow_mem_FP + machineBetheAffineEntryVector_mem_FP)) + +theorem machineBetheAffineEntryColumnSumInput_mem_FP : + machineBetheAffineEntryColumnSumInput ∈ FP := by + exact machinePair_mem_FP (machineConst_mem_FP [false]) + (machinePair_mem_FP machineBetheAffineEntryDimension_mem_FP + (machinePair_mem_FP machineBetheAffineEntryColumn_mem_FP + machineBetheAffineEntryVector_mem_FP)) + +theorem machineBetheAffineEntryRowSum_mem_FP : + machineBetheAffineEntryRowSum ∈ FP := by + simpa only [machineBetheAffineEntryRowSum] using + machineCompose_mem_FP machineBetheAffineEntryRowSumInput_mem_FP + machineBetheLineSumRawCode_mem_FP + +theorem machineBetheAffineEntryColumnSum_mem_FP : + machineBetheAffineEntryColumnSum ∈ FP := by + simpa only [machineBetheAffineEntryColumnSum] using + machineCompose_mem_FP machineBetheAffineEntryColumnSumInput_mem_FP + machineBetheLineSumRawCode_mem_FP + +theorem machineRawRatSubCode_mem_FP : machineRawRatSubCode ∈ FP := by + have hneg := machineCompose_mem_FP machinePairSecond_mem_FP + machineRawRatNegCode_mem_FP + have hinput := machinePair_mem_FP machinePairFirst_mem_FP hneg + simpa only [machineRawRatSubCode] using + machineCompose_mem_FP hinput machineRawRatAddCode_mem_FP + +theorem machineBetheAffineEntryLastColumn_mem_FP : + machineBetheAffineEntryLastColumn ∈ FP := by + have hinput := machinePair_mem_FP + (machineConst_mem_FP (rawRatBinaryCode RawRat.one)) + machineBetheAffineEntryRowSum_mem_FP + simpa only [machineBetheAffineEntryLastColumn] using + machineCompose_mem_FP hinput machineRawRatSubCode_mem_FP + +theorem machineBetheAffineEntryLastRow_mem_FP : + machineBetheAffineEntryLastRow ∈ FP := by + have hinput := machinePair_mem_FP + (machineConst_mem_FP (rawRatBinaryCode RawRat.one)) + machineBetheAffineEntryColumnSum_mem_FP + simpa only [machineBetheAffineEntryLastRow] using + machineCompose_mem_FP hinput machineRawRatSubCode_mem_FP + +theorem machineBetheAffineEntryTotal_mem_FP : + machineBetheAffineEntryTotal ∈ FP := by + simpa only [machineBetheAffineEntryTotal] using + machineCompose_mem_FP machineBetheAffineEntryVector_mem_FP + machineRationalVectorRawSumCode_mem_FP + +theorem machineBetheAffineEntryDimensionBits_mem_FP : + machineBetheAffineEntryDimensionBits ∈ FP := by + simpa only [machineBetheAffineEntryDimensionBits] using + machineCompose_mem_FP machineBetheAffineEntryDimension_mem_FP + machineLengthBits_mem_FP + +theorem machineBetheAffineEntryDimensionMinusOneInteger_mem_FP : + machineBetheAffineEntryDimensionMinusOneInteger ∈ FP := by + have hnat := machineCompose_mem_FP + machineBetheAffineEntryDimensionBits_mem_FP + machineNaturalIntegerCode_mem_FP + have hinput := machinePair_mem_FP hnat + (machineConst_mem_FP (integerBinaryCode (-1))) + simpa only [machineBetheAffineEntryDimensionMinusOneInteger] using + machineCompose_mem_FP hinput machineIntegerAddCode_mem_FP + +theorem machineBetheAffineEntryDimensionMinusOneRaw_mem_FP : + machineBetheAffineEntryDimensionMinusOneRaw ∈ FP := by + exact machinePair_mem_FP + machineBetheAffineEntryDimensionMinusOneInteger_mem_FP + (machineConst_mem_FP (1 : ℕ).bits) + +theorem machineBetheAffineEntryCorner_mem_FP : + machineBetheAffineEntryCorner ∈ FP := by + have hinput := machinePair_mem_FP machineBetheAffineEntryTotal_mem_FP + machineBetheAffineEntryDimensionMinusOneRaw_mem_FP + simpa only [machineBetheAffineEntryCorner] using + machineCompose_mem_FP hinput machineRawRatSubCode_mem_FP + +theorem machineBetheAffineEntryRawCode_mem_FP : + machineBetheAffineEntryRawCode ∈ FP := by + have hlastRow := machineIfHead_mem_FP + machineBetheAffineEntryLastColumnBit_mem_FP + machineBetheAffineEntryCorner_mem_FP + machineBetheAffineEntryLastRow_mem_FP + have hnotLastRow := machineIfHead_mem_FP + machineBetheAffineEntryLastColumnBit_mem_FP + machineBetheAffineEntryLastColumn_mem_FP + machineBetheAffineEntryUpperLeft_mem_FP + exact machineIfHead_mem_FP machineBetheAffineEntryLastRowBit_mem_FP + hlastRow hnotLastRow + +/-! ## Exact semantics -/ + +def machineBetheAffineEntryCanonicalWord {m : ℕ} + (i j : Fin (m + 1)) (y : Fin (m * m) → ℚ) : List Bool := + pair (List.replicate m true) + (pair (List.replicate i.1 true) + (pair (List.replicate j.1 true) (rationalFiniteVectorCode y))) + +def rawBetheDimensionMinusOne (m : ℕ) : RawRat := + ⟨(m : ℤ) - 1, 1, by norm_num⟩ + +def rawBetheAffineEntry {m : ℕ} (y : Fin (m * m) → ℚ) + (i j : Fin (m + 1)) : RawRat := + Fin.lastCases + (Fin.lastCases + ((rawRatListSum RawRat.zero (List.ofFn y)).sub + (rawBetheDimensionMinusOne m)) + (fun j ↦ RawRat.one.sub (rawBetheAffineLineSum false j y)) j) + (fun i ↦ Fin.lastCases + (RawRat.one.sub (rawBetheAffineLineSum true i y)) + (fun j ↦ rawRatOfRat (y (finProdFinEquiv (i, j)))) j) i + +@[simp] theorem machineUnaryRulersEqualBit_replicate (a b : ℕ) : + machineUnaryRulersEqualBit (List.replicate a true) + (List.replicate b true) = [decide (a = b)] := by + rw [machineUnaryRulersEqualBit] + simp only [machineLengthBits_encode, List.length_replicate, + machineBinaryNatEqBit_pair_natBits] + +@[simp] theorem rawBetheDimensionMinusOne_value (m : ℕ) : + (rawBetheDimensionMinusOne m).value = (m : ℚ) - 1 := by + simp [rawBetheDimensionMinusOne, RawRat.value] + +@[simp] theorem machineBetheAffineEntryLastRowBit_encode {m : ℕ} + (i j : Fin (m + 1)) (y : Fin (m * m) → ℚ) : + machineBetheAffineEntryLastRowBit + (machineBetheAffineEntryCanonicalWord i j y) = + [decide (i = Fin.last m)] := by + rw [machineBetheAffineEntryLastRowBit] + simp only [machineBetheAffineEntryRow, machineBetheAffineEntryDimension, + machineBetheAffineEntryRest, machineBetheAffineEntryCanonicalWord, + machinePairFirst_pair, machinePairSecond_pair, + machineUnaryRulersEqualBit_replicate] + by_cases hi : i = Fin.last m + · subst i + simp + · have hval : i.1 ≠ m := by + intro h + apply hi + apply Fin.ext + simpa using h + simp [hi, hval] + +@[simp] theorem machineBetheAffineEntryLastColumnBit_encode {m : ℕ} + (i j : Fin (m + 1)) (y : Fin (m * m) → ℚ) : + machineBetheAffineEntryLastColumnBit + (machineBetheAffineEntryCanonicalWord i j y) = + [decide (j = Fin.last m)] := by + rw [machineBetheAffineEntryLastColumnBit] + simp only [machineBetheAffineEntryColumn, + machineBetheAffineEntryDimension, + machineBetheAffineEntryRest, machineBetheAffineEntryCanonicalWord, + machinePairFirst_pair, machinePairSecond_pair, + machineUnaryRulersEqualBit_replicate] + by_cases hj : j = Fin.last m + · subst j + simp + · have hval : j.1 ≠ m := by + intro h + apply hj + apply Fin.ext + simpa using h + simp [hj, hval] + +@[simp] theorem machineRawRatSubCode_encode (q r : RawRat) : + machineRawRatSubCode + (pair (rawRatBinaryCode q) (rawRatBinaryCode r)) = + rawRatBinaryCode (q.sub r) := by + rw [machineRawRatSubCode] + simp only [machinePairFirst_pair, machinePairSecond_pair, + machineRawRatNegCode_encode, machineRawRatAddCode_encode] + rfl + +@[simp] theorem machineBetheAffineEntryDimensionMinusOneRaw_encode {m : ℕ} + (i j : Fin (m + 1)) (y : Fin (m * m) → ℚ) : + machineBetheAffineEntryDimensionMinusOneRaw + (machineBetheAffineEntryCanonicalWord i j y) = + rawRatBinaryCode (rawBetheDimensionMinusOne m) := by + rw [machineBetheAffineEntryDimensionMinusOneRaw, + machineBetheAffineEntryDimensionMinusOneInteger, + machineBetheAffineEntryDimensionBits, + machineBetheAffineEntryDimension, + machineBetheAffineEntryCanonicalWord] + simp only [machinePairFirst_pair, machineLengthBits_encode, + List.length_replicate, machineNaturalIntegerCode_natBits, + machineIntegerAddCode_encode] + rfl + +@[simp] theorem machineBetheAffineEntryDimension_encode {m : ℕ} + (i j : Fin (m + 1)) (y : Fin (m * m) → ℚ) : + machineBetheAffineEntryDimension + (machineBetheAffineEntryCanonicalWord i j y) = + List.replicate m true := by + simp [machineBetheAffineEntryDimension, + machineBetheAffineEntryCanonicalWord] + +@[simp] theorem machineBetheAffineEntryRow_encode {m : ℕ} + (i j : Fin (m + 1)) (y : Fin (m * m) → ℚ) : + machineBetheAffineEntryRow + (machineBetheAffineEntryCanonicalWord i j y) = + List.replicate i.1 true := by + simp [machineBetheAffineEntryRow, machineBetheAffineEntryRest, + machineBetheAffineEntryCanonicalWord] + +@[simp] theorem machineBetheAffineEntryColumn_encode {m : ℕ} + (i j : Fin (m + 1)) (y : Fin (m * m) → ℚ) : + machineBetheAffineEntryColumn + (machineBetheAffineEntryCanonicalWord i j y) = + List.replicate j.1 true := by + simp [machineBetheAffineEntryColumn, machineBetheAffineEntryRest, + machineBetheAffineEntryCanonicalWord] + +@[simp] theorem machineBetheAffineEntryVector_encode {m : ℕ} + (i j : Fin (m + 1)) (y : Fin (m * m) → ℚ) : + machineBetheAffineEntryVector + (machineBetheAffineEntryCanonicalWord i j y) = + rationalFiniteVectorCode y := by + simp [machineBetheAffineEntryVector, machineBetheAffineEntryRest, + machineBetheAffineEntryCanonicalWord] + +@[simp] theorem machineBetheAffineEntryFlatInput_encode {m : ℕ} + (i j : Fin m) (y : Fin (m * m) → ℚ) : + machineBetheAffineEntryFlatInput + (machineBetheAffineEntryCanonicalWord i.castSucc j.castSucc y) = + betheFlatIndexCanonicalWord true i j y := by + simp [machineBetheAffineEntryFlatInput, betheFlatIndexCanonicalWord] + +@[simp] theorem machineBetheAffineEntryRowSumInput_encode {m : ℕ} + (i : Fin m) (j : Fin (m + 1)) (y : Fin (m * m) → ℚ) : + machineBetheAffineEntryRowSumInput + (machineBetheAffineEntryCanonicalWord i.castSucc j y) = + machineBetheLineSumCanonicalWord true i y := by + simp [machineBetheAffineEntryRowSumInput, + machineBetheLineSumCanonicalWord] + +@[simp] theorem machineBetheAffineEntryColumnSumInput_encode {m : ℕ} + (i : Fin (m + 1)) (j : Fin m) (y : Fin (m * m) → ℚ) : + machineBetheAffineEntryColumnSumInput + (machineBetheAffineEntryCanonicalWord i j.castSucc y) = + machineBetheLineSumCanonicalWord false j y := by + simp [machineBetheAffineEntryColumnSumInput, + machineBetheLineSumCanonicalWord] + +@[simp] theorem machineBetheAffineEntryTotal_encode {m : ℕ} + (i j : Fin (m + 1)) (y : Fin (m * m) → ℚ) : + machineBetheAffineEntryTotal + (machineBetheAffineEntryCanonicalWord i j y) = + rawRatBinaryCode (rawRatListSum RawRat.zero (List.ofFn y)) := by + rw [machineBetheAffineEntryTotal, + machineBetheAffineEntryVector_encode] + simpa only [rationalFiniteVectorCode, rationalVectorBinaryCode] using + machineRationalVectorRawSumCode_encode y + +@[simp] theorem machineBetheAffineEntryCorner_encode {m : ℕ} + (y : Fin (m * m) → ℚ) : + machineBetheAffineEntryCorner + (machineBetheAffineEntryCanonicalWord + (Fin.last m) (Fin.last m) y) = + rawRatBinaryCode + ((rawRatListSum RawRat.zero (List.ofFn y)).sub + (rawBetheDimensionMinusOne m)) := by + rw [machineBetheAffineEntryCorner] + rw [machineBetheAffineEntryTotal_encode, + machineBetheAffineEntryDimensionMinusOneRaw_encode, + machineRawRatSubCode_encode] + +@[simp] theorem machineBetheAffineEntryLastRow_encode {m : ℕ} + (j : Fin m) (y : Fin (m * m) → ℚ) : + machineBetheAffineEntryLastRow + (machineBetheAffineEntryCanonicalWord + (Fin.last m) j.castSucc y) = + rawRatBinaryCode + (RawRat.one.sub (rawBetheAffineLineSum false j y)) := by + rw [machineBetheAffineEntryLastRow] + rw [machineBetheAffineEntryColumnSum, + machineBetheAffineEntryColumnSumInput_encode, + machineBetheLineSumRawCode_encode, + machineRawRatSubCode_encode] + +@[simp] theorem machineBetheAffineEntryLastColumn_encode {m : ℕ} + (i : Fin m) (y : Fin (m * m) → ℚ) : + machineBetheAffineEntryLastColumn + (machineBetheAffineEntryCanonicalWord + i.castSucc (Fin.last m) y) = + rawRatBinaryCode + (RawRat.one.sub (rawBetheAffineLineSum true i y)) := by + rw [machineBetheAffineEntryLastColumn] + rw [machineBetheAffineEntryRowSum, + machineBetheAffineEntryRowSumInput_encode, + machineBetheLineSumRawCode_encode, + machineRawRatSubCode_encode] + +@[simp] theorem machineBetheAffineEntryUpperLeft_encode {m : ℕ} + (i j : Fin m) (y : Fin (m * m) → ℚ) : + machineBetheAffineEntryUpperLeft + (machineBetheAffineEntryCanonicalWord i.castSucc j.castSucc y) = + rawRatBinaryCode (rawRatOfRat (y (finProdFinEquiv (i, j)))) := by + rw [machineBetheAffineEntryUpperLeft] + rw [machineBetheAffineEntryFlatInput_encode, + machineBetheFlatEntryRawCode_encode] + simp + +@[simp] theorem machineBetheAffineEntryRawCode_encode {m : ℕ} + (i j : Fin (m + 1)) (y : Fin (m * m) → ℚ) : + machineBetheAffineEntryRawCode + (machineBetheAffineEntryCanonicalWord i j y) = + rawRatBinaryCode (rawBetheAffineEntry y i j) := by + refine Fin.lastCases ?_ (fun i ↦ ?_) i <;> + refine Fin.lastCases ?_ (fun j ↦ ?_) j + · simp [machineBetheAffineEntryRawCode, rawBetheAffineEntry] + · have hj : j.castSucc ≠ Fin.last m := Fin.castSucc_ne_last j + simp [machineBetheAffineEntryRawCode, rawBetheAffineEntry, hj] + · have hi : i.castSucc ≠ Fin.last m := Fin.castSucc_ne_last i + simp [machineBetheAffineEntryRawCode, rawBetheAffineEntry, hi] + · have hi : i.castSucc ≠ Fin.last m := Fin.castSucc_ne_last i + have hj : j.castSucc ≠ Fin.last m := Fin.castSucc_ne_last j + simp [machineBetheAffineEntryRawCode, rawBetheAffineEntry, hi, hj] + +theorem rawBetheAffineEntry_value {m : ℕ} (y : Fin (m * m) → ℚ) + (i j : Fin (m + 1)) : + (rawBetheAffineEntry y i j).value = betheAffineMatrixQ y i j := by + refine Fin.lastCases ?_ (fun i ↦ ?_) i <;> + refine Fin.lastCases ?_ (fun j ↦ ?_) j + · simp only [rawBetheAffineEntry, Fin.lastCases_last] + rw [betheAffineMatrixQ, + birkhoffAffineMap_last_last, RawRat.value_sub, + rawBetheDimensionMinusOne_value] + have hsum := sum_squareMatrixToVector (vectorToSquareMatrix y) + simp only [squareMatrixToVector_vectorToSquareMatrix] at hsum + rw [rawRatListSum_ofFn_value, hsum] + · simp only [rawBetheAffineEntry, Fin.lastCases_last, + Fin.lastCases_castSucc] + rw [betheAffineMatrixQ, + birkhoffAffineMap_last_castSucc, RawRat.value_sub, + RawRat.value_one, rawBetheAffineLineSum_value] + simp [vectorToSquareMatrix] + · simp only [rawBetheAffineEntry, Fin.lastCases_last, + Fin.lastCases_castSucc] + rw [betheAffineMatrixQ, + birkhoffAffineMap_castSucc_last, RawRat.value_sub, + RawRat.value_one, rawBetheAffineLineSum_value] + simp [vectorToSquareMatrix] + · simp [rawBetheAffineEntry, Fin.lastCases_castSucc, + betheAffineMatrixQ, + vectorToSquareMatrix, rawRatOfRat_value] + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineBetheAffineLineSum.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineBetheAffineLineSum.lean new file mode 100644 index 0000000000..2f66d8db1f --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineBetheAffineLineSum.lean @@ -0,0 +1,1017 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.BetheEpigraph +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalVectorSum +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalTransposeMulVector + +/-! +# Finite-word row and column sums for Birkhoff affine coordinates + +The Bethe epigraph stores only the upper-left `m`-by-`m` affine block as a +flat rational vector. This file supplies the first reusable machine needed +by the separation oracle: exact row and column sums of that block. A Boolean +tag selects a row (`true`) or a column (`false`). Every index manipulated by +the machine is unary and is obtained from verified binary multiplication and +addition under the complete input word as a guard. +-/ + +namespace BeyondBethe + +open Complexity + +/-! ## A verified flattened-coordinate lookup -/ + +def machineBetheFlatIndexMode (word : List Bool) : List Bool := + machinePairFirst word + +def machineBetheFlatIndexRest (word : List Bool) : List Bool := + machinePairSecond word + +def machineBetheFlatIndexDimension (word : List Bool) : List Bool := + machinePairFirst (machineBetheFlatIndexRest word) + +def machineBetheFlatIndexFixed (word : List Bool) : List Bool := + machinePairFirst (machinePairSecond (machineBetheFlatIndexRest word)) + +def machineBetheFlatIndexCurrent (word : List Bool) : List Bool := + machinePairFirst + (machinePairSecond (machinePairSecond (machineBetheFlatIndexRest word))) + +def machineBetheFlatIndexVector (word : List Bool) : List Bool := + machinePairSecond + (machinePairSecond (machinePairSecond (machineBetheFlatIndexRest word))) + +def machineBetheFlatIndexDimensionBits (word : List Bool) : List Bool := + machineLengthBits (machineBetheFlatIndexDimension word) + +def machineBetheFlatIndexFixedBits (word : List Bool) : List Bool := + machineLengthBits (machineBetheFlatIndexFixed word) + +def machineBetheFlatIndexCurrentBits (word : List Bool) : List Bool := + machineLengthBits (machineBetheFlatIndexCurrent word) + +def machineBetheFlatIndexRowBits (word : List Bool) : List Bool := + machineBinaryAddBits + (pair + (machineBinaryMulBits + (pair (machineBetheFlatIndexFixedBits word) + (machineBetheFlatIndexDimensionBits word))) + (machineBetheFlatIndexCurrentBits word)) + +def machineBetheFlatIndexColumnBits (word : List Bool) : List Bool := + machineBinaryAddBits + (pair + (machineBinaryMulBits + (pair (machineBetheFlatIndexCurrentBits word) + (machineBetheFlatIndexDimensionBits word))) + (machineBetheFlatIndexFixedBits word)) + +def machineBetheFlatIndexBits (word : List Bool) : List Bool := + machineIfHead (machineBetheFlatIndexMode word) + (machineBetheFlatIndexRowBits word) + (machineBetheFlatIndexColumnBits word) + +def machineBetheFlatIndexRuler (word : List Bool) : List Bool := + machineBoundedUnary (pair word (machineBetheFlatIndexBits word)) + +/-- Return the selected canonical rational entry. Canonical rational-entry +codes and `RawRat` codes coincide, so the result may be fed directly to the +unreduced rational arithmetic machines. -/ +def machineBetheFlatEntryRawCode (word : List Bool) : List Bool := + machineListIndex + (pair (machineBetheFlatIndexRuler word) + (machineBetheFlatIndexVector word)) + +theorem machineBetheFlatIndexMode_mem_FP : + machineBetheFlatIndexMode ∈ FP := machinePairFirst_mem_FP + +theorem machineBetheFlatIndexRest_mem_FP : + machineBetheFlatIndexRest ∈ FP := machinePairSecond_mem_FP + +theorem machineBetheFlatIndexDimension_mem_FP : + machineBetheFlatIndexDimension ∈ FP := by + simpa only [machineBetheFlatIndexDimension] using + machineCompose_mem_FP machineBetheFlatIndexRest_mem_FP + machinePairFirst_mem_FP + +theorem machineBetheFlatIndexFixed_mem_FP : + machineBetheFlatIndexFixed ∈ FP := by + have htail := machineCompose_mem_FP machineBetheFlatIndexRest_mem_FP + machinePairSecond_mem_FP + simpa only [machineBetheFlatIndexFixed] using + machineCompose_mem_FP htail machinePairFirst_mem_FP + +theorem machineBetheFlatIndexCurrent_mem_FP : + machineBetheFlatIndexCurrent ∈ FP := by + have htail₁ := machineCompose_mem_FP machineBetheFlatIndexRest_mem_FP + machinePairSecond_mem_FP + have htail₂ := machineCompose_mem_FP htail₁ machinePairSecond_mem_FP + simpa only [machineBetheFlatIndexCurrent] using + machineCompose_mem_FP htail₂ machinePairFirst_mem_FP + +theorem machineBetheFlatIndexVector_mem_FP : + machineBetheFlatIndexVector ∈ FP := by + have htail₁ := machineCompose_mem_FP machineBetheFlatIndexRest_mem_FP + machinePairSecond_mem_FP + have htail₂ := machineCompose_mem_FP htail₁ machinePairSecond_mem_FP + simpa only [machineBetheFlatIndexVector] using + machineCompose_mem_FP htail₂ machinePairSecond_mem_FP + +theorem machineBetheFlatIndexDimensionBits_mem_FP : + machineBetheFlatIndexDimensionBits ∈ FP := by + simpa only [machineBetheFlatIndexDimensionBits] using + machineCompose_mem_FP machineBetheFlatIndexDimension_mem_FP + machineLengthBits_mem_FP + +theorem machineBetheFlatIndexFixedBits_mem_FP : + machineBetheFlatIndexFixedBits ∈ FP := by + simpa only [machineBetheFlatIndexFixedBits] using + machineCompose_mem_FP machineBetheFlatIndexFixed_mem_FP + machineLengthBits_mem_FP + +theorem machineBetheFlatIndexCurrentBits_mem_FP : + machineBetheFlatIndexCurrentBits ∈ FP := by + simpa only [machineBetheFlatIndexCurrentBits] using + machineCompose_mem_FP machineBetheFlatIndexCurrent_mem_FP + machineLengthBits_mem_FP + +theorem machineBetheFlatIndexRowBits_mem_FP : + machineBetheFlatIndexRowBits ∈ FP := by + have hmulInput := machinePair_mem_FP + machineBetheFlatIndexFixedBits_mem_FP + machineBetheFlatIndexDimensionBits_mem_FP + have hmul := machineCompose_mem_FP hmulInput + machineBinaryMulBits_mem_FP + have haddInput := machinePair_mem_FP hmul + machineBetheFlatIndexCurrentBits_mem_FP + simpa only [machineBetheFlatIndexRowBits] using + machineCompose_mem_FP haddInput machineBinaryAddBits_mem_FP + +theorem machineBetheFlatIndexColumnBits_mem_FP : + machineBetheFlatIndexColumnBits ∈ FP := by + have hmulInput := machinePair_mem_FP + machineBetheFlatIndexCurrentBits_mem_FP + machineBetheFlatIndexDimensionBits_mem_FP + have hmul := machineCompose_mem_FP hmulInput + machineBinaryMulBits_mem_FP + have haddInput := machinePair_mem_FP hmul + machineBetheFlatIndexFixedBits_mem_FP + simpa only [machineBetheFlatIndexColumnBits] using + machineCompose_mem_FP haddInput machineBinaryAddBits_mem_FP + +theorem machineBetheFlatIndexBits_mem_FP : + machineBetheFlatIndexBits ∈ FP := by + exact machineIfHead_mem_FP machineBetheFlatIndexMode_mem_FP + machineBetheFlatIndexRowBits_mem_FP + machineBetheFlatIndexColumnBits_mem_FP + +theorem machineBetheFlatIndexRuler_mem_FP : + machineBetheFlatIndexRuler ∈ FP := by + have hinput := machinePair_mem_FP id_mem_FP + machineBetheFlatIndexBits_mem_FP + simpa only [machineBetheFlatIndexRuler] using + machineCompose_mem_FP hinput machineBoundedUnary_mem_FP + +theorem machineBetheFlatEntryRawCode_mem_FP : + machineBetheFlatEntryRawCode ∈ FP := by + have hinput := machinePair_mem_FP machineBetheFlatIndexRuler_mem_FP + machineBetheFlatIndexVector_mem_FP + simpa only [machineBetheFlatEntryRawCode] using + machineCompose_mem_FP hinput machineListIndex_mem_FP + +def betheFlatIndexCanonicalWord {m : ℕ} (rowMode : Bool) + (fixed current : Fin m) (y : Fin (m * m) → ℚ) : List Bool := + pair [rowMode] + (pair (List.replicate m true) + (pair (List.replicate fixed.1 true) + (pair (List.replicate current.1 true) + (rationalFiniteVectorCode y)))) + +@[simp] theorem machineBetheFlatIndexRowBits_encode {m : ℕ} + (fixed current : Fin m) (y : Fin (m * m) → ℚ) : + machineBetheFlatIndexRowBits + (betheFlatIndexCanonicalWord true fixed current y) = + (fixed.1 * m + current.1).bits := by + simp [machineBetheFlatIndexRowBits, machineBetheFlatIndexFixedBits, + machineBetheFlatIndexCurrentBits, machineBetheFlatIndexDimensionBits, + machineBetheFlatIndexFixed, machineBetheFlatIndexCurrent, + machineBetheFlatIndexDimension, machineBetheFlatIndexRest, + betheFlatIndexCanonicalWord, machineBinaryMulBits_pair_natBits, + machineBinaryAddBits_pair_natBits] + +@[simp] theorem machineBetheFlatIndexColumnBits_encode {m : ℕ} + (fixed current : Fin m) (y : Fin (m * m) → ℚ) : + machineBetheFlatIndexColumnBits + (betheFlatIndexCanonicalWord false fixed current y) = + (current.1 * m + fixed.1).bits := by + simp [machineBetheFlatIndexColumnBits, machineBetheFlatIndexFixedBits, + machineBetheFlatIndexCurrentBits, machineBetheFlatIndexDimensionBits, + machineBetheFlatIndexFixed, machineBetheFlatIndexCurrent, + machineBetheFlatIndexDimension, machineBetheFlatIndexRest, + betheFlatIndexCanonicalWord, machineBinaryMulBits_pair_natBits, + machineBinaryAddBits_pair_natBits] + +theorem bethe_flat_index_lt_word_length {m : ℕ} (rowMode : Bool) + (fixed current : Fin m) (y : Fin (m * m) → ℚ) : + (if rowMode then fixed.1 * m + current.1 + else current.1 * m + fixed.1) ≤ + (betheFlatIndexCanonicalWord rowMode fixed current y).length := by + have hidx : (if rowMode then fixed.1 * m + current.1 + else current.1 * m + fixed.1) < m * m := by + cases rowMode with + | false => + simp only [Bool.false_eq_true, if_false] + calc + current.1 * m + fixed.1 < current.1 * m + m := + Nat.add_lt_add_left fixed.isLt _ + _ = (current.1 + 1) * m := (Nat.succ_mul current.1 m).symm + _ ≤ m * m := Nat.mul_le_mul_right m + (Nat.succ_le_iff.mpr current.isLt) + | true => + simp only [if_true] + calc + fixed.1 * m + current.1 < fixed.1 * m + m := + Nat.add_lt_add_left current.isLt _ + _ = (fixed.1 + 1) * m := (Nat.succ_mul fixed.1 m).symm + _ ≤ m * m := Nat.mul_le_mul_right m + (Nat.succ_le_iff.mpr fixed.isLt) + have hvector : m * m ≤ (rationalFiniteVectorCode y).length := by + simpa only [rationalFiniteVectorCode, List.length_ofFn] using + list_length_le_binaryListCode_length rationalEntryBinaryCode + (List.ofFn y) + have hcode : (rationalFiniteVectorCode y).length ≤ + (betheFlatIndexCanonicalWord rowMode fixed current y).length := by + simp [betheFlatIndexCanonicalWord] + omega + exact hidx.le.trans (hvector.trans hcode) + +@[simp] theorem machineBetheFlatIndexRuler_encode {m : ℕ} + (rowMode : Bool) (fixed current : Fin m) + (y : Fin (m * m) → ℚ) : + machineBetheFlatIndexRuler + (betheFlatIndexCanonicalWord rowMode fixed current y) = + List.replicate + (if rowMode then fixed.1 * m + current.1 + else current.1 * m + fixed.1) true := by + rw [machineBetheFlatIndexRuler] + cases rowMode with + | false => + simp only [machineBetheFlatIndexBits, machineBetheFlatIndexMode, + betheFlatIndexCanonicalWord, machinePairFirst_pair, + machineIfHead_false, Bool.false_eq_true, if_false] + change machineBoundedUnary + (pair (betheFlatIndexCanonicalWord false fixed current y) + (machineBetheFlatIndexColumnBits + (betheFlatIndexCanonicalWord false fixed current y))) = _ + rw [machineBetheFlatIndexColumnBits_encode] + rw [machineBoundedUnary_encode_of_le] + exact bethe_flat_index_lt_word_length false fixed current y + | true => + simp only [machineBetheFlatIndexBits, machineBetheFlatIndexMode, + betheFlatIndexCanonicalWord, machinePairFirst_pair, + machineIfHead_true, if_true] + change machineBoundedUnary + (pair (betheFlatIndexCanonicalWord true fixed current y) + (machineBetheFlatIndexRowBits + (betheFlatIndexCanonicalWord true fixed current y))) = _ + rw [machineBetheFlatIndexRowBits_encode] + rw [machineBoundedUnary_encode_of_le] + exact bethe_flat_index_lt_word_length true fixed current y + +@[simp] theorem machineBetheFlatIndexVector_encode {m : ℕ} + (rowMode : Bool) (fixed current : Fin m) + (y : Fin (m * m) → ℚ) : + machineBetheFlatIndexVector + (betheFlatIndexCanonicalWord rowMode fixed current y) = + rationalFiniteVectorCode y := by + simp [machineBetheFlatIndexVector, machineBetheFlatIndexRest, + betheFlatIndexCanonicalWord] + +@[simp] theorem machineBetheFlatEntryRawCode_encode {m : ℕ} + (rowMode : Bool) (fixed current : Fin m) + (y : Fin (m * m) → ℚ) : + machineBetheFlatEntryRawCode + (betheFlatIndexCanonicalWord rowMode fixed current y) = + rawRatBinaryCode + (rawRatOfRat + (if rowMode then y (finProdFinEquiv (fixed, current)) + else y (finProdFinEquiv (current, fixed)))) := by + rw [machineBetheFlatEntryRawCode, + machineBetheFlatIndexRuler_encode, + machineBetheFlatIndexVector_encode] + cases rowMode with + | false => + simp only [Bool.false_eq_true, if_false, rationalFiniteVectorCode] + have hk : current.1 * m + fixed.1 < (List.ofFn y).length := by + simp only [List.length_ofFn] + calc + current.1 * m + fixed.1 < current.1 * m + m := + Nat.add_lt_add_left fixed.isLt _ + _ = (current.1 + 1) * m := (Nat.succ_mul current.1 m).symm + _ ≤ m * m := Nat.mul_le_mul_right m + (Nat.succ_le_iff.mpr current.isLt) + rw [machineListIndex_binaryListCode rationalEntryBinaryCode + (List.ofFn y) (current.1 * m + fixed.1) hk, + rawRatBinaryCode_rawRatOfRat] + apply congrArg rationalEntryBinaryCode + rw [List.getElem_ofFn] + apply congrArg y + apply Fin.ext + simp only [finProdFinEquiv, Equiv.coe_fn_mk] + rw [Nat.mul_comm current.1 m] + omega + | true => + simp only [if_true, rationalFiniteVectorCode] + have hk : fixed.1 * m + current.1 < (List.ofFn y).length := by + simp only [List.length_ofFn] + calc + fixed.1 * m + current.1 < fixed.1 * m + m := + Nat.add_lt_add_left current.isLt _ + _ = (fixed.1 + 1) * m := (Nat.succ_mul fixed.1 m).symm + _ ≤ m * m := Nat.mul_le_mul_right m + (Nat.succ_le_iff.mpr fixed.isLt) + rw [machineListIndex_binaryListCode rationalEntryBinaryCode + (List.ofFn y) (fixed.1 * m + current.1) hk, + rawRatBinaryCode_rawRatOfRat] + apply congrArg rationalEntryBinaryCode + rw [List.getElem_ofFn] + apply congrArg y + apply Fin.ext + simp only [finProdFinEquiv, Equiv.coe_fn_mk] + rw [Nat.mul_comm fixed.1 m] + omega + +/-! ## A bounded exact line-sum iteration -/ + +def machineBetheLineSumMode (word : List Bool) : List Bool := + machinePairFirst word + +def machineBetheLineSumRest (word : List Bool) : List Bool := + machinePairSecond word + +def machineBetheLineSumDimension (word : List Bool) : List Bool := + machinePairFirst (machineBetheLineSumRest word) + +def machineBetheLineSumFixed (word : List Bool) : List Bool := + machinePairFirst (machinePairSecond (machineBetheLineSumRest word)) + +def machineBetheLineSumVector (word : List Bool) : List Bool := + machinePairSecond (machinePairSecond (machineBetheLineSumRest word)) + +def machineBetheLineSumPack (remaining current acc payload bound : List Bool) : + List Bool := + pair remaining (pair current (pair acc (pair payload bound))) + +def machineBetheLineSumRemaining (state : List Bool) : List Bool := + machinePairFirst state + +def machineBetheLineSumCurrent (state : List Bool) : List Bool := + machinePairFirst (machinePairSecond state) + +def machineBetheLineSumAccumulator (state : List Bool) : List Bool := + machinePairFirst (machinePairSecond (machinePairSecond state)) + +def machineBetheLineSumPayload (state : List Bool) : List Bool := + machinePairFirst + (machinePairSecond (machinePairSecond (machinePairSecond state))) + +def machineBetheLineSumBound (state : List Bool) : List Bool := + machinePairSecond + (machinePairSecond (machinePairSecond (machinePairSecond state))) + +def machineBetheLineSumEntryInput (state : List Bool) : List Bool := + let payload := machineBetheLineSumPayload state + pair (machineBetheLineSumMode payload) + (pair (machineBetheLineSumDimension payload) + (pair (machineBetheLineSumFixed payload) + (pair (machineBetheLineSumCurrent state) + (machineBetheLineSumVector payload)))) + +def machineBetheLineSumEntry (state : List Bool) : List Bool := + machineBetheFlatEntryRawCode (machineBetheLineSumEntryInput state) + +def machineBetheLineSumCandidate (state : List Bool) : List Bool := + machineRawRatAddCode + (pair (machineBetheLineSumAccumulator state) + (machineBetheLineSumEntry state)) + +def machineBetheLineSumNextAccumulator (state : List Bool) : List Bool := + (machineBetheLineSumCandidate state).take + (machineBetheLineSumBound state).length + +def machineBetheLineSumAdvance (state : List Bool) : List Bool := + machineBetheLineSumPack + (machineBetheLineSumRemaining state).tail + (true :: machineBetheLineSumCurrent state) + (machineBetheLineSumNextAccumulator state) + (machineBetheLineSumPayload state) + (machineBetheLineSumBound state) + +def machineBetheLineSumStep (state : List Bool) : List Bool := + machineIfEmpty (machineBetheLineSumRemaining state) state + (machineBetheLineSumAdvance state) + +def machineBetheLineSumInputBound (word : List Bool) : List Bool := + machineBinaryMulWidth (machineBinaryMulWidth word) + +def machineBetheLineSumInit (word : List Bool) : List Bool := + machineBetheLineSumPack (machineBetheLineSumDimension word) [] + (rawRatBinaryCode RawRat.zero) word + (machineBetheLineSumInputBound word) + +def machineBetheLineSumWidth (word : List Bool) : List Bool := + let bound := machineBetheLineSumInputBound word + machineBetheLineSumPack bound bound bound bound bound + +def machineBetheLineSumFinalState (word : List Bool) : List Bool := + (machineBetheLineSumStep)^[(machineBetheLineSumDimension word).length] + (machineBetheLineSumInit word) + +def machineBetheLineSumRawCode (word : List Bool) : List Bool := + machineBetheLineSumAccumulator (machineBetheLineSumFinalState word) + +theorem machineBetheLineSumMode_mem_FP : machineBetheLineSumMode ∈ FP := + machinePairFirst_mem_FP + +theorem machineBetheLineSumRest_mem_FP : machineBetheLineSumRest ∈ FP := + machinePairSecond_mem_FP + +theorem machineBetheLineSumDimension_mem_FP : + machineBetheLineSumDimension ∈ FP := by + simpa only [machineBetheLineSumDimension] using + machineCompose_mem_FP machineBetheLineSumRest_mem_FP + machinePairFirst_mem_FP + +theorem machineBetheLineSumFixed_mem_FP : + machineBetheLineSumFixed ∈ FP := by + have htail := machineCompose_mem_FP machineBetheLineSumRest_mem_FP + machinePairSecond_mem_FP + simpa only [machineBetheLineSumFixed] using + machineCompose_mem_FP htail machinePairFirst_mem_FP + +theorem machineBetheLineSumVector_mem_FP : + machineBetheLineSumVector ∈ FP := by + have htail := machineCompose_mem_FP machineBetheLineSumRest_mem_FP + machinePairSecond_mem_FP + simpa only [machineBetheLineSumVector] using + machineCompose_mem_FP htail machinePairSecond_mem_FP + +theorem machineBetheLineSumRemaining_mem_FP : + machineBetheLineSumRemaining ∈ FP := machinePairFirst_mem_FP + +theorem machineBetheLineSumCurrent_mem_FP : + machineBetheLineSumCurrent ∈ FP := by + simpa only [machineBetheLineSumCurrent] using + machineCompose_mem_FP machinePairSecond_mem_FP machinePairFirst_mem_FP + +theorem machineBetheLineSumAccumulator_mem_FP : + machineBetheLineSumAccumulator ∈ FP := by + have htail := machineCompose_mem_FP machinePairSecond_mem_FP + machinePairSecond_mem_FP + simpa only [machineBetheLineSumAccumulator] using + machineCompose_mem_FP htail machinePairFirst_mem_FP + +theorem machineBetheLineSumPayload_mem_FP : + machineBetheLineSumPayload ∈ FP := by + have htail₁ := machineCompose_mem_FP machinePairSecond_mem_FP + machinePairSecond_mem_FP + have htail₂ := machineCompose_mem_FP htail₁ machinePairSecond_mem_FP + simpa only [machineBetheLineSumPayload] using + machineCompose_mem_FP htail₂ machinePairFirst_mem_FP + +theorem machineBetheLineSumBound_mem_FP : + machineBetheLineSumBound ∈ FP := by + have htail₁ := machineCompose_mem_FP machinePairSecond_mem_FP + machinePairSecond_mem_FP + have htail₂ := machineCompose_mem_FP htail₁ machinePairSecond_mem_FP + simpa only [machineBetheLineSumBound] using + machineCompose_mem_FP htail₂ machinePairSecond_mem_FP + +theorem machineBetheLineSumEntryInput_mem_FP : + machineBetheLineSumEntryInput ∈ FP := by + have hmode := machineCompose_mem_FP machineBetheLineSumPayload_mem_FP + machineBetheLineSumMode_mem_FP + have hdim := machineCompose_mem_FP machineBetheLineSumPayload_mem_FP + machineBetheLineSumDimension_mem_FP + have hfixed := machineCompose_mem_FP machineBetheLineSumPayload_mem_FP + machineBetheLineSumFixed_mem_FP + have hvector := machineCompose_mem_FP machineBetheLineSumPayload_mem_FP + machineBetheLineSumVector_mem_FP + exact machinePair_mem_FP hmode + (machinePair_mem_FP hdim + (machinePair_mem_FP hfixed + (machinePair_mem_FP machineBetheLineSumCurrent_mem_FP hvector))) + +theorem machineBetheLineSumEntry_mem_FP : machineBetheLineSumEntry ∈ FP := by + simpa only [machineBetheLineSumEntry] using + machineCompose_mem_FP machineBetheLineSumEntryInput_mem_FP + machineBetheFlatEntryRawCode_mem_FP + +theorem machineBetheLineSumCandidate_mem_FP : + machineBetheLineSumCandidate ∈ FP := by + have hinput := machinePair_mem_FP machineBetheLineSumAccumulator_mem_FP + machineBetheLineSumEntry_mem_FP + simpa only [machineBetheLineSumCandidate] using + machineCompose_mem_FP hinput machineRawRatAddCode_mem_FP + +theorem machineBetheLineSumNextAccumulator_mem_FP : + machineBetheLineSumNextAccumulator ∈ FP := by + simpa only [machineBetheLineSumNextAccumulator] using + machineTake_mem_FP machineBetheLineSumBound_mem_FP + machineBetheLineSumCandidate_mem_FP + +theorem machineBetheLineSumAdvance_mem_FP : + machineBetheLineSumAdvance ∈ FP := by + have hremaining := machineCompose_mem_FP + machineBetheLineSumRemaining_mem_FP machineTail_mem_FP + have hcurrent := machineCompose_mem_FP machineBetheLineSumCurrent_mem_FP + (machinePrepend_mem_FP true) + exact machinePair_mem_FP hremaining + (machinePair_mem_FP hcurrent + (machinePair_mem_FP machineBetheLineSumNextAccumulator_mem_FP + (machinePair_mem_FP machineBetheLineSumPayload_mem_FP + machineBetheLineSumBound_mem_FP))) + +theorem machineBetheLineSumStep_mem_FP : machineBetheLineSumStep ∈ FP := by + exact machineIfEmpty_mem_FP machineBetheLineSumRemaining_mem_FP + id_mem_FP machineBetheLineSumAdvance_mem_FP + +theorem machineBetheLineSumInputBound_mem_FP : + machineBetheLineSumInputBound ∈ FP := by + simpa only [machineBetheLineSumInputBound] using + machineCompose_mem_FP machineBinaryMulWidth_mem_FP + machineBinaryMulWidth_mem_FP + +theorem machineBetheLineSumInit_mem_FP : machineBetheLineSumInit ∈ FP := by + exact machinePair_mem_FP machineBetheLineSumDimension_mem_FP + (machinePair_mem_FP (machineConst_mem_FP []) + (machinePair_mem_FP (machineConst_mem_FP + (rawRatBinaryCode RawRat.zero)) + (machinePair_mem_FP id_mem_FP + machineBetheLineSumInputBound_mem_FP))) + +theorem machineBetheLineSumWidth_mem_FP : machineBetheLineSumWidth ∈ FP := by + have h := machineBetheLineSumInputBound_mem_FP + exact machinePair_mem_FP h + (machinePair_mem_FP h (machinePair_mem_FP h (machinePair_mem_FP h h))) + +@[simp] theorem machineBetheLineSumRemaining_pack (a b c d e) : + machineBetheLineSumRemaining (machineBetheLineSumPack a b c d e) = a := by + simp [machineBetheLineSumRemaining, machineBetheLineSumPack] + +@[simp] theorem machineBetheLineSumCurrent_pack (a b c d e) : + machineBetheLineSumCurrent (machineBetheLineSumPack a b c d e) = b := by + simp [machineBetheLineSumCurrent, machineBetheLineSumPack] + +@[simp] theorem machineBetheLineSumAccumulator_pack (a b c d e) : + machineBetheLineSumAccumulator (machineBetheLineSumPack a b c d e) = c := by + simp [machineBetheLineSumAccumulator, machineBetheLineSumPack] + +@[simp] theorem machineBetheLineSumPayload_pack (a b c d e) : + machineBetheLineSumPayload (machineBetheLineSumPack a b c d e) = d := by + simp [machineBetheLineSumPayload, machineBetheLineSumPack] + +@[simp] theorem machineBetheLineSumBound_pack (a b c d e) : + machineBetheLineSumBound (machineBetheLineSumPack a b c d e) = e := by + simp [machineBetheLineSumBound, machineBetheLineSumPack] + +def MachineBetheLineSumStateBound (word state : List Bool) : Prop := + let B := (machineBetheLineSumInputBound word).length + state = machineBetheLineSumPack + (machineBetheLineSumRemaining state) + (machineBetheLineSumCurrent state) + (machineBetheLineSumAccumulator state) + (machineBetheLineSumPayload state) + (machineBetheLineSumBound state) ∧ + (machineBetheLineSumRemaining state).length + + (machineBetheLineSumCurrent state).length ≤ B ∧ + (machineBetheLineSumAccumulator state).length ≤ B ∧ + (machineBetheLineSumPayload state).length ≤ B ∧ + machineBetheLineSumBound state = machineBetheLineSumInputBound word + +theorem machineBetheLineSum_word_le_bound (word : List Bool) : + word.length ≤ (machineBetheLineSumInputBound word).length := by + simp only [machineBetheLineSumInputBound, machineBinaryMulWidth, + List.length_replicate, List.length_append] + nlinarith [sq_nonneg (word.length + 16)] + +theorem machineBetheLineSumInit_bound (word : List Bool) : + MachineBetheLineSumStateBound word (machineBetheLineSumInit word) := by + dsimp only [MachineBetheLineSumStateBound] + refine ⟨?_, ?_, ?_, ?_, ?_⟩ + · simp only [machineBetheLineSumInit, + machineBetheLineSumRemaining_pack, + machineBetheLineSumCurrent_pack, + machineBetheLineSumAccumulator_pack, + machineBetheLineSumPayload_pack, + machineBetheLineSumBound_pack] + · simp only [machineBetheLineSumInit, + machineBetheLineSumRemaining_pack, + machineBetheLineSumCurrent_pack, List.length_nil, Nat.add_zero] + exact (machinePairFirst_length_le (machineBetheLineSumRest word)).trans + ((machinePairSecond_length_le word).trans + (machineBetheLineSum_word_le_bound word)) + · simp only [machineBetheLineSumInit, + machineBetheLineSumAccumulator_pack] + exact (rawRatBinaryCode_length_le_width RawRat.zero).trans + (by + simp only [rawRatWidth_zero, machineBetheLineSumInputBound, + machineBinaryMulWidth, List.length_replicate, + List.length_append] + nlinarith [sq_nonneg (word.length + 16)]) + · simpa only [machineBetheLineSumInit, + machineBetheLineSumPayload_pack] using + machineBetheLineSum_word_le_bound word + · simp only [machineBetheLineSumInit, machineBetheLineSumBound_pack] + +theorem machineBetheLineSumStep_bound {word state : List Bool} + (hs : MachineBetheLineSumStateBound word state) : + MachineBetheLineSumStateBound word (machineBetheLineSumStep state) := by + dsimp only [MachineBetheLineSumStateBound] at hs ⊢ + rcases hs with ⟨hdecomp, hindices, hacc, hpayload, hbound⟩ + by_cases hempty : machineBetheLineSumRemaining state = [] + · rw [machineBetheLineSumStep, hempty, machineIfEmpty_nil] + exact ⟨hdecomp, hindices, hacc, hpayload, hbound⟩ + · cases hremaining : machineBetheLineSumRemaining state with + | nil => exact False.elim (hempty hremaining) + | cons bit tail => + rw [machineBetheLineSumStep, hremaining, machineIfEmpty_cons, + machineBetheLineSumAdvance] + simp only [machineBetheLineSumRemaining_pack, + machineBetheLineSumCurrent_pack, + machineBetheLineSumAccumulator_pack, + machineBetheLineSumPayload_pack, machineBetheLineSumBound_pack] + refine ⟨trivial, ?_, ?_, hpayload, hbound⟩ + · have hsame : + (machineBetheLineSumRemaining state).tail.length + + (true :: machineBetheLineSumCurrent state).length = + (machineBetheLineSumRemaining state).length + + (machineBetheLineSumCurrent state).length := by + rw [hremaining] + simp only [List.tail_cons, List.length_cons] + omega + rw [hsame] + exact hindices + · rw [machineBetheLineSumNextAccumulator, hbound] + exact List.length_take_le _ _ + +theorem machineBetheLineSumIterate_bound (word : List Bool) : ∀ k, + MachineBetheLineSumStateBound word + ((machineBetheLineSumStep)^[k] (machineBetheLineSumInit word)) := by + intro k + induction k with + | zero => exact machineBetheLineSumInit_bound word + | succ k ih => + rw [Function.iterate_succ_apply'] + exact machineBetheLineSumStep_bound ih + +theorem machineBetheLineSumIterate_length_le_width + (word : List Bool) (iterations : ℕ) + (_ : iterations ≤ (machineBetheLineSumDimension word).length) : + ((machineBetheLineSumStep)^[iterations] + (machineBetheLineSumInit word)).length ≤ + (machineBetheLineSumWidth word).length := by + rcases machineBetheLineSumIterate_bound word iterations with + ⟨hdecomp, hindices, hacc, hpayload, hbound⟩ + rw [hdecomp, hbound] + simp only [machineBetheLineSumPack, machineBetheLineSumWidth, pair_length] + omega + +theorem machineBetheLineSumFinalState_mem_FP : + machineBetheLineSumFinalState ∈ FP := by + exact Cobham.iterate_mem_FP machineBetheLineSumStep_mem_FP + machineBetheLineSumInit_mem_FP machineBetheLineSumDimension_mem_FP + machineBetheLineSumWidth_mem_FP + machineBetheLineSumIterate_length_le_width + +theorem machineBetheLineSumRawCode_mem_FP : + machineBetheLineSumRawCode ∈ FP := by + simpa only [machineBetheLineSumRawCode] using + machineCompose_mem_FP machineBetheLineSumFinalState_mem_FP + machineBetheLineSumAccumulator_mem_FP + +/-! ## Exactness and absence of truncation on canonical inputs -/ + +def machineBetheLineSumCanonicalWord {m : ℕ} (rowMode : Bool) + (fixed : Fin m) (y : Fin (m * m) → ℚ) : List Bool := + pair [rowMode] + (pair (List.replicate m true) + (pair (List.replicate fixed.1 true) + (rationalFiniteVectorCode y))) + +def betheAffineLineValues {m : ℕ} (rowMode : Bool) + (fixed : Fin m) (y : Fin (m * m) → ℚ) : List ℚ := + List.ofFn fun current : Fin m ↦ + if rowMode then y (finProdFinEquiv (fixed, current)) + else y (finProdFinEquiv (current, fixed)) + +def rawBetheAffineLineSum {m : ℕ} (rowMode : Bool) + (fixed : Fin m) (y : Fin (m * m) → ℚ) : RawRat := + rawRatListSum RawRat.zero (betheAffineLineValues rowMode fixed y) + +@[simp] theorem betheAffineLineValues_length {m : ℕ} (rowMode : Bool) + (fixed : Fin m) (y : Fin (m * m) → ℚ) : + (betheAffineLineValues rowMode fixed y).length = m := by + simp [betheAffineLineValues] + +theorem betheLineSum_dimension_le_word {m : ℕ} (rowMode : Bool) + (fixed : Fin m) (y : Fin (m * m) → ℚ) : + m ≤ (machineBetheLineSumCanonicalWord rowMode fixed y).length := by + simp [machineBetheLineSumCanonicalWord] + omega + +theorem betheLineSum_vector_code_le_word {m : ℕ} (rowMode : Bool) + (fixed : Fin m) (y : Fin (m * m) → ℚ) : + (rationalFiniteVectorCode y).length ≤ + (machineBetheLineSumCanonicalWord rowMode fixed y).length := by + simp [machineBetheLineSumCanonicalWord] + omega + +theorem betheAffineLineValue_cost_le_word {m : ℕ} (rowMode : Bool) + (fixed : Fin m) (y : Fin (m * m) → ℚ) + {q : ℚ} (hq : q ∈ betheAffineLineValues rowMode fixed y) : + rawRatWidth (rawRatOfRat q) + 1 ≤ + (machineBetheLineSumCanonicalWord rowMode fixed y).length + 1 := by + obtain ⟨current, rfl⟩ := List.mem_ofFn.mp hq + let z : ℚ := if rowMode then y (finProdFinEquiv (fixed, current)) + else y (finProdFinEquiv (current, fixed)) + have hzmem : z ∈ List.ofFn y := by + cases rowMode with + | false => + simp only [z, Bool.false_eq_true, if_false] + exact (List.mem_ofFn).2 ⟨finProdFinEquiv (current, fixed), rfl⟩ + | true => + simp only [z, if_true] + exact (List.mem_ofFn).2 ⟨finProdFinEquiv (fixed, current), rfl⟩ + have hentry := binaryListCode_element_length_le + rationalEntryBinaryCode hzmem + have hentry' : (rationalEntryBinaryCode z).length ≤ + (rationalFiniteVectorCode y).length := by + simpa only [rationalFiniteVectorCode] using hentry + have hraw := rawRatWidth_le_binaryCode_length (rawRatOfRat z) + rw [rawRatBinaryCode_rawRatOfRat] at hraw + have hword := betheLineSum_vector_code_le_word rowMode fixed y + change rawRatWidth (rawRatOfRat z) + 1 ≤ _ + omega + +theorem rawRatListCost_betheLine_take_le {m : ℕ} (rowMode : Bool) + (fixed : Fin m) (y : Fin (m * m) → ℚ) (k : ℕ) : + rawRatListCost ((betheAffineLineValues rowMode fixed y).take k) ≤ + (machineBetheLineSumCanonicalWord rowMode fixed y).length * + ((machineBetheLineSumCanonicalWord rowMode fixed y).length + 1) := by + let values := betheAffineLineValues rowMode fixed y + let W := (machineBetheLineSumCanonicalWord rowMode fixed y).length + have heach : ∀ q ∈ values.take k, + rawRatWidth (rawRatOfRat q) + 1 ≤ W + 1 := by + intro q hq + exact betheAffineLineValue_cost_le_word rowMode fixed y + (List.mem_of_mem_take hq) + have hsum := List.sum_le_card_nsmul + ((values.take k).map fun q ↦ rawRatWidth (rawRatOfRat q) + 1) + (W + 1) (by + intro cost hcost + rw [List.mem_map] at hcost + obtain ⟨q, hq, rfl⟩ := hcost + exact heach q hq) + have hlength : (values.take k).length ≤ W := by + have htake : (values.take k).length ≤ values.length := by + rw [List.length_take] + exact Nat.min_le_right _ _ + exact htake.trans + (by simpa only [values, betheAffineLineValues_length, W] using + betheLineSum_dimension_le_word rowMode fixed y) + have hlengthMap : + ((values.take k).map + fun q ↦ rawRatWidth (rawRatOfRat q) + 1).length ≤ W := by + simpa only [List.length_map] using hlength + simp only [rawRatListCost] + exact hsum.trans (Nat.mul_le_mul_right (W + 1) hlengthMap) + +theorem rawBetheAffineLinePrefix_code_le_bound {m : ℕ} + (rowMode : Bool) (fixed : Fin m) (y : Fin (m * m) → ℚ) (k : ℕ) : + (rawRatBinaryCode + (rawRatListSum RawRat.zero + ((betheAffineLineValues rowMode fixed y).take k))).length ≤ + (machineBetheLineSumInputBound + (machineBetheLineSumCanonicalWord rowMode fixed y)).length := by + let word := machineBetheLineSumCanonicalWord rowMode fixed y + let W := word.length + let segment := (betheAffineLineValues rowMode fixed y).take k + have hwidth := rawRatWidth_listSum_le RawRat.zero segment + have hcost := rawRatListCost_betheLine_take_le rowMode fixed y k + have hraw := rawRatBinaryCode_length_le_width + (rawRatListSum RawRat.zero segment) + have hwidth' : rawRatWidth (rawRatListSum RawRat.zero segment) ≤ + 1 + W * (W + 1) := by + simp only [rawRatWidth_zero] at hwidth + simpa only [word, W, segment] using hwidth.trans + (Nat.add_le_add_left hcost 1) + apply hraw.trans + apply (Nat.add_le_add_left (Nat.mul_le_mul_left 3 hwidth') 4).trans + have hfirst : 4 + 3 * (1 + W * (W + 1)) ≤ + 4 * (16 + W) ^ 2 := by nlinarith + have hsecond : 4 * (16 + W) ^ 2 ≤ + (16 + (16 + W) ^ 2) ^ 2 := by + nlinarith [sq_nonneg ((16 + W) ^ 2)] + apply hfirst.trans hsecond |>.trans_eq + simp only [machineBetheLineSumInputBound, machineBinaryMulWidth, + List.length_replicate, List.length_append, word, W, pow_two] + +theorem rawRatListSum_append (acc : RawRat) : ∀ xs ys : List ℚ, + rawRatListSum acc (xs ++ ys) = + rawRatListSum (rawRatListSum acc xs) ys := by + intro xs ys + induction xs generalizing acc with + | nil => rfl + | cons q qs ih => + simp only [List.cons_append, rawRatListSum] + exact ih (acc.add (rawRatOfRat q)) + +theorem rawBetheAffineLinePrefix_succ {m : ℕ} (rowMode : Bool) + (fixed : Fin m) (y : Fin (m * m) → ℚ) (k : ℕ) (hk : k < m) : + rawRatListSum RawRat.zero + ((betheAffineLineValues rowMode fixed y).take (k + 1)) = + (rawRatListSum RawRat.zero + ((betheAffineLineValues rowMode fixed y).take k)).add + (rawRatOfRat + (if rowMode then + y (finProdFinEquiv (fixed, ⟨k, hk⟩)) + else y (finProdFinEquiv (⟨k, hk⟩, fixed)))) := by + let values := betheAffineLineValues rowMode fixed y + have hk' : k < values.length := by simpa only [values, + betheAffineLineValues_length] using hk + have htake : values.take (k + 1) = + values.take k ++ [values[k]] := by + simpa only [List.concat_eq_append] using (List.take_concat_get hk').symm + rw [show (betheAffineLineValues rowMode fixed y).take (k + 1) = + values.take (k + 1) by rfl, htake, rawRatListSum_append] + simp only [rawRatListSum, List.getElem_ofFn, values, + betheAffineLineValues] + +def machineBetheLineSumSemanticState {m : ℕ} (rowMode : Bool) + (fixed : Fin m) (y : Fin (m * m) → ℚ) (k : ℕ) : List Bool := + let word := machineBetheLineSumCanonicalWord rowMode fixed y + machineBetheLineSumPack (List.replicate (m - k) true) + (List.replicate k true) + (rawRatBinaryCode + (rawRatListSum RawRat.zero + ((betheAffineLineValues rowMode fixed y).take k))) + word (machineBetheLineSumInputBound word) + +@[simp] theorem machineBetheLineSumMode_canonical {m : ℕ} + (rowMode : Bool) (fixed : Fin m) (y : Fin (m * m) → ℚ) : + machineBetheLineSumMode + (machineBetheLineSumCanonicalWord rowMode fixed y) = [rowMode] := by + simp [machineBetheLineSumMode, machineBetheLineSumCanonicalWord] + +@[simp] theorem machineBetheLineSumDimension_canonical {m : ℕ} + (rowMode : Bool) (fixed : Fin m) (y : Fin (m * m) → ℚ) : + machineBetheLineSumDimension + (machineBetheLineSumCanonicalWord rowMode fixed y) = + List.replicate m true := by + simp [machineBetheLineSumDimension, machineBetheLineSumRest, + machineBetheLineSumCanonicalWord] + +@[simp] theorem machineBetheLineSumFixed_canonical {m : ℕ} + (rowMode : Bool) (fixed : Fin m) (y : Fin (m * m) → ℚ) : + machineBetheLineSumFixed + (machineBetheLineSumCanonicalWord rowMode fixed y) = + List.replicate fixed.1 true := by + simp [machineBetheLineSumFixed, machineBetheLineSumRest, + machineBetheLineSumCanonicalWord] + +@[simp] theorem machineBetheLineSumVector_canonical {m : ℕ} + (rowMode : Bool) (fixed : Fin m) (y : Fin (m * m) → ℚ) : + machineBetheLineSumVector + (machineBetheLineSumCanonicalWord rowMode fixed y) = + rationalFiniteVectorCode y := by + simp [machineBetheLineSumVector, machineBetheLineSumRest, + machineBetheLineSumCanonicalWord] + +theorem machineBetheLineSumInit_semantics {m : ℕ} (rowMode : Bool) + (fixed : Fin m) (y : Fin (m * m) → ℚ) : + machineBetheLineSumInit + (machineBetheLineSumCanonicalWord rowMode fixed y) = + machineBetheLineSumSemanticState rowMode fixed y 0 := by + simp [machineBetheLineSumInit, machineBetheLineSumSemanticState, + rawRatListSum] + +theorem machineBetheLineSumEntryInput_semantics {m : ℕ} + (rowMode : Bool) (fixed : Fin m) (y : Fin (m * m) → ℚ) + (k : ℕ) (hk : k < m) : + machineBetheLineSumEntryInput + (machineBetheLineSumSemanticState rowMode fixed y k) = + betheFlatIndexCanonicalWord rowMode fixed ⟨k, hk⟩ y := by + simp [machineBetheLineSumEntryInput, machineBetheLineSumSemanticState, + betheFlatIndexCanonicalWord] + +theorem machineBetheLineSumStep_semantics {m : ℕ} (rowMode : Bool) + (fixed : Fin m) (y : Fin (m * m) → ℚ) + (k : ℕ) (hk : k < m) : + machineBetheLineSumStep + (machineBetheLineSumSemanticState rowMode fixed y k) = + machineBetheLineSumSemanticState rowMode fixed y (k + 1) := by + let word := machineBetheLineSumCanonicalWord rowMode fixed y + let segment := rawRatListSum RawRat.zero + ((betheAffineLineValues rowMode fixed y).take k) + let term := rawRatOfRat + (if rowMode then y (finProdFinEquiv (fixed, ⟨k, hk⟩)) + else y (finProdFinEquiv (⟨k, hk⟩, fixed))) + have hremaining : List.replicate (m - k) true = + true :: List.replicate (m - (k + 1)) true := by + have hsub : m - k = (m - (k + 1)) + 1 := by omega + rw [hsub, List.replicate_succ] + have hentryInput := machineBetheLineSumEntryInput_semantics + rowMode fixed y k hk + have hentry : machineBetheLineSumEntry + (machineBetheLineSumSemanticState rowMode fixed y k) = + rawRatBinaryCode term := by + rw [machineBetheLineSumEntry, hentryInput, + machineBetheFlatEntryRawCode_encode] + have hentryPack : machineBetheLineSumEntry + (machineBetheLineSumPack + (true :: List.replicate (m - (k + 1)) true) + (List.replicate k true) (rawRatBinaryCode segment) word + (machineBetheLineSumInputBound word)) = + rawRatBinaryCode term := by + rw [← hremaining] + simpa only [machineBetheLineSumSemanticState, word, segment] using hentry + have hprefix := rawBetheAffineLinePrefix_succ rowMode fixed y k hk + have hcode : (rawRatBinaryCode (segment.add term)).length ≤ + (machineBetheLineSumInputBound word).length := by + rw [show segment.add term = rawRatListSum RawRat.zero + ((betheAffineLineValues rowMode fixed y).take (k + 1)) by + exact hprefix.symm] + exact rawBetheAffineLinePrefix_code_le_bound rowMode fixed y (k + 1) + rw [machineBetheLineSumStep, machineBetheLineSumSemanticState, + hremaining] + simp only [machineBetheLineSumRemaining_pack, machineIfEmpty_cons, + machineBetheLineSumAdvance, List.tail_cons, + machineBetheLineSumCurrent_pack, + machineBetheLineSumAccumulator_pack, + machineBetheLineSumPayload_pack, machineBetheLineSumBound_pack, + machineBetheLineSumNextAccumulator, + machineBetheLineSumCandidate] + change machineBetheLineSumPack + (List.replicate (m - (k + 1)) true) + (true :: List.replicate k true) + ((machineRawRatAddCode + (pair (rawRatBinaryCode segment) + (machineBetheLineSumEntry + (machineBetheLineSumPack + (true :: List.replicate (m - (k + 1)) true) + (List.replicate k true) (rawRatBinaryCode segment) word + (machineBetheLineSumInputBound word))))).take + (machineBetheLineSumInputBound word).length) + word (machineBetheLineSumInputBound word) = + machineBetheLineSumSemanticState rowMode fixed y (k + 1) + rw [hentryPack, machineRawRatAddCode_encode] + rw [(List.take_eq_self_iff _).mpr hcode] + rw [show segment.add term = rawRatListSum RawRat.zero + ((betheAffineLineValues rowMode fixed y).take (k + 1)) by + exact hprefix.symm] + simp only [machineBetheLineSumSemanticState, word, + List.replicate_succ] + +theorem machineBetheLineSumIterate_semantics {m : ℕ} (rowMode : Bool) + (fixed : Fin m) (y : Fin (m * m) → ℚ) : ∀ k ≤ m, + (machineBetheLineSumStep)^[k] + (machineBetheLineSumInit + (machineBetheLineSumCanonicalWord rowMode fixed y)) = + machineBetheLineSumSemanticState rowMode fixed y k := by + intro k hk + induction k with + | zero => exact machineBetheLineSumInit_semantics rowMode fixed y + | succ k ih => + rw [Function.iterate_succ_apply', ih (by omega)] + exact machineBetheLineSumStep_semantics rowMode fixed y k (by omega) + +@[simp] theorem machineBetheLineSumRawCode_encode {m : ℕ} + (rowMode : Bool) (fixed : Fin m) (y : Fin (m * m) → ℚ) : + machineBetheLineSumRawCode + (machineBetheLineSumCanonicalWord rowMode fixed y) = + rawRatBinaryCode (rawBetheAffineLineSum rowMode fixed y) := by + have hstate := congrArg machineBetheLineSumAccumulator + (machineBetheLineSumIterate_semantics rowMode fixed y m le_rfl) + have htake : (betheAffineLineValues rowMode fixed y).take m = + betheAffineLineValues rowMode fixed y := by + apply List.take_of_length_le + simp + simpa [machineBetheLineSumRawCode, machineBetheLineSumFinalState, + machineBetheLineSumDimension_canonical, + machineBetheLineSumSemanticState, rawBetheAffineLineSum, htake] using hstate + +theorem rawBetheAffineLineSum_value {m : ℕ} (rowMode : Bool) + (fixed : Fin m) (y : Fin (m * m) → ℚ) : + (rawBetheAffineLineSum rowMode fixed y).value = + if rowMode then ∑ j : Fin m, y (finProdFinEquiv (fixed, j)) + else ∑ i : Fin m, y (finProdFinEquiv (i, fixed)) := by + rw [rawBetheAffineLineSum, rawRatListSum_value, + RawRat.value_zero, zero_add] + cases rowMode <;> simp [betheAffineLineValues, List.sum_ofFn] + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineBetheEpigraphOracle.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineBetheEpigraphOracle.lean new file mode 100644 index 0000000000..cae42e5039 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineBetheEpigraphOracle.lean @@ -0,0 +1,1018 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineBinaryListInit +import LeanPool.BeyondBethe.BeyondBethe.MachineBetheFloorCutVector +import LeanPool.BeyondBethe.BeyondBethe.MachineBetheHeightNormal +import LeanPool.BeyondBethe.BeyondBethe.MachineDirectedEpigraphNormal +import LeanPool.BeyondBethe.BeyondBethe.MachineBetheHeightCap +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalEllipsoidEncoding +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalPower +import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerInteriorScale +import LeanPool.BeyondBethe.BeyondBethe.BetheEpigraphFeasibility + +/-! +# A finite-word oracle for the bounded Bethe epigraph + +The input contains the unary reduced dimension and precision, the rational +regularization parameter, floor and height cap, the input matrix, and a +rational ellipsoid state. The machine performs the three oracle branches in +their mathematical order: an exact floor scan, the exact height-cap test, and +the directed nonlinear objective test. +-/ + +namespace BeyondBethe + +open Complexity + +/-! ## Public input layout and accessors -/ + +/-- Input layout: +`pair mUnary (pair pUnary (pair tauRaw (pair deltaRaw + (pair upperRaw (pair matrixCode ellipsoidCode)))))`. -/ +def machineBetheOracleDimension (word : List Bool) : List Bool := + machinePairFirst word + +def machineBetheOracleRest (word : List Bool) : List Bool := + machinePairSecond word + +def machineBetheOraclePrecision (word : List Bool) : List Bool := + machinePairFirst (machineBetheOracleRest word) + +def machineBetheOracleAfterPrecision (word : List Bool) : List Bool := + machinePairSecond (machineBetheOracleRest word) + +def machineBetheOracleTau (word : List Bool) : List Bool := + machinePairFirst (machineBetheOracleAfterPrecision word) + +def machineBetheOracleAfterTau (word : List Bool) : List Bool := + machinePairSecond (machineBetheOracleAfterPrecision word) + +def machineBetheOracleDelta (word : List Bool) : List Bool := + machinePairFirst (machineBetheOracleAfterTau word) + +def machineBetheOracleAfterDelta (word : List Bool) : List Bool := + machinePairSecond (machineBetheOracleAfterTau word) + +def machineBetheOracleUpper (word : List Bool) : List Bool := + machinePairFirst (machineBetheOracleAfterDelta word) + +def machineBetheOracleAfterUpper (word : List Bool) : List Bool := + machinePairSecond (machineBetheOracleAfterDelta word) + +def machineBetheOracleMatrix (word : List Bool) : List Bool := + machinePairFirst (machineBetheOracleAfterUpper word) + +def machineBetheOracleEllipsoid (word : List Bool) : List Bool := + machinePairSecond (machineBetheOracleAfterUpper word) + +def machineBetheOracleCenter (word : List Bool) : List Bool := + machineRationalEllipsoidCenterWord (machineBetheOracleEllipsoid word) + +def machineBetheOracleBase (word : List Bool) : List Bool := + machineBinaryListInit (machineBetheOracleCenter word) + +theorem machineBetheOracleDimension_mem_FP : + machineBetheOracleDimension ∈ FP := machinePairFirst_mem_FP + +theorem machineBetheOracleRest_mem_FP : + machineBetheOracleRest ∈ FP := machinePairSecond_mem_FP + +theorem machineBetheOraclePrecision_mem_FP : + machineBetheOraclePrecision ∈ FP := by + simpa only [machineBetheOraclePrecision] using + machineCompose_mem_FP machineBetheOracleRest_mem_FP + machinePairFirst_mem_FP + +theorem machineBetheOracleAfterPrecision_mem_FP : + machineBetheOracleAfterPrecision ∈ FP := by + simpa only [machineBetheOracleAfterPrecision] using + machineCompose_mem_FP machineBetheOracleRest_mem_FP + machinePairSecond_mem_FP + +theorem machineBetheOracleTau_mem_FP : machineBetheOracleTau ∈ FP := by + simpa only [machineBetheOracleTau] using + machineCompose_mem_FP machineBetheOracleAfterPrecision_mem_FP + machinePairFirst_mem_FP + +theorem machineBetheOracleAfterTau_mem_FP : + machineBetheOracleAfterTau ∈ FP := by + simpa only [machineBetheOracleAfterTau] using + machineCompose_mem_FP machineBetheOracleAfterPrecision_mem_FP + machinePairSecond_mem_FP + +theorem machineBetheOracleDelta_mem_FP : machineBetheOracleDelta ∈ FP := by + simpa only [machineBetheOracleDelta] using + machineCompose_mem_FP machineBetheOracleAfterTau_mem_FP + machinePairFirst_mem_FP + +theorem machineBetheOracleAfterDelta_mem_FP : + machineBetheOracleAfterDelta ∈ FP := by + simpa only [machineBetheOracleAfterDelta] using + machineCompose_mem_FP machineBetheOracleAfterTau_mem_FP + machinePairSecond_mem_FP + +theorem machineBetheOracleUpper_mem_FP : machineBetheOracleUpper ∈ FP := by + simpa only [machineBetheOracleUpper] using + machineCompose_mem_FP machineBetheOracleAfterDelta_mem_FP + machinePairFirst_mem_FP + +theorem machineBetheOracleAfterUpper_mem_FP : + machineBetheOracleAfterUpper ∈ FP := by + simpa only [machineBetheOracleAfterUpper] using + machineCompose_mem_FP machineBetheOracleAfterDelta_mem_FP + machinePairSecond_mem_FP + +theorem machineBetheOracleMatrix_mem_FP : machineBetheOracleMatrix ∈ FP := by + simpa only [machineBetheOracleMatrix] using + machineCompose_mem_FP machineBetheOracleAfterUpper_mem_FP + machinePairFirst_mem_FP + +theorem machineBetheOracleEllipsoid_mem_FP : + machineBetheOracleEllipsoid ∈ FP := by + simpa only [machineBetheOracleEllipsoid] using + machineCompose_mem_FP machineBetheOracleAfterUpper_mem_FP + machinePairSecond_mem_FP + +theorem machineBetheOracleCenter_mem_FP : machineBetheOracleCenter ∈ FP := by + simpa only [machineBetheOracleCenter] using + machineCompose_mem_FP machineBetheOracleEllipsoid_mem_FP + machineRationalEllipsoidCenterWord_mem_FP + +theorem machineBetheOracleBase_mem_FP : machineBetheOracleBase ∈ FP := by + simpa only [machineBetheOracleBase] using + machineCompose_mem_FP machineBetheOracleCenter_mem_FP + machineBinaryListInit_mem_FP + +/-! ## Derived dimension and the three branch tests -/ + +def machineBetheOracleDimensionBits (word : List Bool) : List Bool := + machineLengthBits (machineBetheOracleDimension word) + +def machineBetheOracleBaseDimensionBits (word : List Bool) : List Bool := + machineBinaryMulBits + (pair (machineBetheOracleDimensionBits word) + (machineBetheOracleDimensionBits word)) + +def machineBetheOracleBaseDimensionUnary (word : List Bool) : List Bool := + machineBoundedUnary + (pair (machineBetheOracleBase word) + (machineBetheOracleBaseDimensionBits word)) + +def machineBetheOracleBaseDimensionRawCode (word : List Bool) : List Bool := + pair (machineNaturalIntegerCode + (machineBetheOracleBaseDimensionBits word)) [true] + +def machineBetheOracleFloorScanInput (word : List Bool) : List Bool := + pair (machineBetheOracleDimension word) + (pair (machineBetheOracleDelta word) (machineBetheOracleBase word)) + +def machineBetheOracleFloorScanResult (word : List Bool) : List Bool := + machineBetheFloorScanResultCode (machineBetheOracleFloorScanInput word) + +def machineBetheOracleFloorFoundBit (word : List Bool) : List Bool := + machineHeadBit (machinePairFirst (machineBetheOracleFloorScanResult word)) + +def machineBetheOracleFloorRow (word : List Bool) : List Bool := + machinePairFirst (machinePairSecond (machineBetheOracleFloorScanResult word)) + +def machineBetheOracleFloorColumn (word : List Bool) : List Bool := + machinePairSecond (machinePairSecond (machineBetheOracleFloorScanResult word)) + +def machineBetheOracleHeightInput (word : List Bool) : List Bool := + pair (machineBetheOracleBaseDimensionUnary word) + (pair (machineBetheOracleUpper word) (machineBetheOracleCenter word)) + +def machineBetheOracleHeightViolationBit (word : List Bool) : List Bool := + machineBetheHeightCapViolationBit (machineBetheOracleHeightInput word) + +def machineBetheOracleHeightRawCode (word : List Bool) : List Bool := + machineBetheHeightCapEntryCode (machineBetheOracleHeightInput word) + +def rawBetheOracleSixteen : RawRat := RawRat.ofNat 16 + +def machineBetheOracleHalfPowerRawCode (word : List Bool) : List Bool := + machineRawRatPowerCode + (pair (machineBetheOraclePrecision word) + (rawRatBinaryCode rawOptimizerHalf)) + +def machineBetheOracleScaledErrorRawCode (word : List Bool) : List Bool := + machineRawRatMulCode + (pair (rawRatBinaryCode rawBetheOracleSixteen) + (machineBetheOracleHalfPowerRawCode word)) + +def machineBetheOracleMarginRawCode (word : List Bool) : List Bool := + machineRawRatMulCode + (pair (machineBetheOracleScaledErrorRawCode word) + (machineBetheOracleBaseDimensionRawCode word)) + +def machineBetheOracleObjectiveInput (word : List Bool) : List Bool := + pair (machineBetheOracleDimension word) + (pair (machineBetheOraclePrecision word) + (pair (machineBetheOracleTau word) + (pair (machineBetheOracleMatrix word) (machineBetheOracleBase word)))) + +def machineBetheOracleLowerRawCode (word : List Bool) : List Bool := + machineDirectedNegativeObjectiveSumRawCode + (machineBetheOracleObjectiveInput word) + +def machineBetheOracleHeightPlusMarginRawCode + (word : List Bool) : List Bool := + machineRawRatAddCode + (pair (machineBetheOracleHeightRawCode word) + (machineBetheOracleMarginRawCode word)) + +def machineBetheOracleNonlinearViolationBit + (word : List Bool) : List Bool := + machineNotBit + (machineRawRatLeBit + (pair (machineBetheOracleLowerRawCode word) + (machineBetheOracleHeightPlusMarginRawCode word))) + +theorem machineBetheOracleDimensionBits_mem_FP : + machineBetheOracleDimensionBits ∈ FP := by + simpa only [machineBetheOracleDimensionBits] using + machineCompose_mem_FP machineBetheOracleDimension_mem_FP + machineLengthBits_mem_FP + +theorem machineBetheOracleBaseDimensionBits_mem_FP : + machineBetheOracleBaseDimensionBits ∈ FP := by + have hpair := machinePair_mem_FP machineBetheOracleDimensionBits_mem_FP + machineBetheOracleDimensionBits_mem_FP + simpa only [machineBetheOracleBaseDimensionBits] using + machineCompose_mem_FP hpair machineBinaryMulBits_mem_FP + +theorem machineBetheOracleBaseDimensionUnary_mem_FP : + machineBetheOracleBaseDimensionUnary ∈ FP := by + have hpair := machinePair_mem_FP machineBetheOracleBase_mem_FP + machineBetheOracleBaseDimensionBits_mem_FP + simpa only [machineBetheOracleBaseDimensionUnary] using + machineCompose_mem_FP hpair machineBoundedUnary_mem_FP + +theorem machineBetheOracleBaseDimensionRawCode_mem_FP : + machineBetheOracleBaseDimensionRawCode ∈ FP := by + have hnum := machineCompose_mem_FP + machineBetheOracleBaseDimensionBits_mem_FP + machineNaturalIntegerCode_mem_FP + exact machinePair_mem_FP hnum (machineConst_mem_FP [true]) + +theorem machineBetheOracleFloorScanInput_mem_FP : + machineBetheOracleFloorScanInput ∈ FP := + machinePair_mem_FP machineBetheOracleDimension_mem_FP + (machinePair_mem_FP machineBetheOracleDelta_mem_FP + machineBetheOracleBase_mem_FP) + +theorem machineBetheOracleFloorScanResult_mem_FP : + machineBetheOracleFloorScanResult ∈ FP := by + simpa only [machineBetheOracleFloorScanResult] using + machineCompose_mem_FP machineBetheOracleFloorScanInput_mem_FP + machineBetheFloorScanResultCode_mem_FP + +theorem machineBetheOracleFloorFoundBit_mem_FP : + machineBetheOracleFloorFoundBit ∈ FP := by + have htag := machineCompose_mem_FP machineBetheOracleFloorScanResult_mem_FP + machinePairFirst_mem_FP + simpa only [machineBetheOracleFloorFoundBit] using + machineCompose_mem_FP htag machineHeadBit_mem_FP + +theorem machineBetheOracleFloorRow_mem_FP : + machineBetheOracleFloorRow ∈ FP := by + have hpayload := machineCompose_mem_FP + machineBetheOracleFloorScanResult_mem_FP machinePairSecond_mem_FP + simpa only [machineBetheOracleFloorRow] using + machineCompose_mem_FP hpayload machinePairFirst_mem_FP + +theorem machineBetheOracleFloorColumn_mem_FP : + machineBetheOracleFloorColumn ∈ FP := by + have hpayload := machineCompose_mem_FP + machineBetheOracleFloorScanResult_mem_FP machinePairSecond_mem_FP + simpa only [machineBetheOracleFloorColumn] using + machineCompose_mem_FP hpayload machinePairSecond_mem_FP + +theorem machineBetheOracleHeightInput_mem_FP : + machineBetheOracleHeightInput ∈ FP := + machinePair_mem_FP machineBetheOracleBaseDimensionUnary_mem_FP + (machinePair_mem_FP machineBetheOracleUpper_mem_FP + machineBetheOracleCenter_mem_FP) + +theorem machineBetheOracleHeightViolationBit_mem_FP : + machineBetheOracleHeightViolationBit ∈ FP := by + simpa only [machineBetheOracleHeightViolationBit] using + machineCompose_mem_FP machineBetheOracleHeightInput_mem_FP + machineBetheHeightCapViolationBit_mem_FP + +theorem machineBetheOracleHeightRawCode_mem_FP : + machineBetheOracleHeightRawCode ∈ FP := by + simpa only [machineBetheOracleHeightRawCode] using + machineCompose_mem_FP machineBetheOracleHeightInput_mem_FP + machineBetheHeightCapEntryCode_mem_FP + +theorem machineBetheOracleHalfPowerRawCode_mem_FP : + machineBetheOracleHalfPowerRawCode ∈ FP := by + have hpair := machinePair_mem_FP machineBetheOraclePrecision_mem_FP + (machineConst_mem_FP (rawRatBinaryCode rawOptimizerHalf)) + simpa only [machineBetheOracleHalfPowerRawCode] using + machineCompose_mem_FP hpair machineRawRatPowerCode_mem_FP + +theorem machineBetheOracleScaledErrorRawCode_mem_FP : + machineBetheOracleScaledErrorRawCode ∈ FP := by + have hpair := machinePair_mem_FP + (machineConst_mem_FP (rawRatBinaryCode rawBetheOracleSixteen)) + machineBetheOracleHalfPowerRawCode_mem_FP + simpa only [machineBetheOracleScaledErrorRawCode] using + machineCompose_mem_FP hpair machineRawRatMulCode_mem_FP + +theorem machineBetheOracleMarginRawCode_mem_FP : + machineBetheOracleMarginRawCode ∈ FP := by + have hpair := machinePair_mem_FP + machineBetheOracleScaledErrorRawCode_mem_FP + machineBetheOracleBaseDimensionRawCode_mem_FP + simpa only [machineBetheOracleMarginRawCode] using + machineCompose_mem_FP hpair machineRawRatMulCode_mem_FP + +theorem machineBetheOracleObjectiveInput_mem_FP : + machineBetheOracleObjectiveInput ∈ FP := + machinePair_mem_FP machineBetheOracleDimension_mem_FP + (machinePair_mem_FP machineBetheOraclePrecision_mem_FP + (machinePair_mem_FP machineBetheOracleTau_mem_FP + (machinePair_mem_FP machineBetheOracleMatrix_mem_FP + machineBetheOracleBase_mem_FP))) + +theorem machineBetheOracleLowerRawCode_mem_FP : + machineBetheOracleLowerRawCode ∈ FP := by + simpa only [machineBetheOracleLowerRawCode] using + machineCompose_mem_FP machineBetheOracleObjectiveInput_mem_FP + machineDirectedNegativeObjectiveSumRawCode_mem_FP + +theorem machineBetheOracleHeightPlusMarginRawCode_mem_FP : + machineBetheOracleHeightPlusMarginRawCode ∈ FP := by + have hpair := machinePair_mem_FP machineBetheOracleHeightRawCode_mem_FP + machineBetheOracleMarginRawCode_mem_FP + simpa only [machineBetheOracleHeightPlusMarginRawCode] using + machineCompose_mem_FP hpair machineRawRatAddCode_mem_FP + +theorem machineBetheOracleNonlinearViolationBit_mem_FP : + machineBetheOracleNonlinearViolationBit ∈ FP := by + have hpair := machinePair_mem_FP machineBetheOracleLowerRawCode_mem_FP + machineBetheOracleHeightPlusMarginRawCode_mem_FP + have hle := machineCompose_mem_FP hpair machineRawRatLeBit_mem_FP + simpa only [machineBetheOracleNonlinearViolationBit] using + machineNotBit_mem_FP hle + +/-! ## Cut construction and final response -/ + +def machineBetheOracleFloorNormalInput (word : List Bool) : List Bool := + pair (machineBetheOracleDimension word) + (pair (machineBetheOracleFloorRow word) + (machineBetheOracleFloorColumn word)) + +def machineBetheOracleFloorResponse (word : List Bool) : List Bool := + pair [true] + (machineBetheFloorCutVectorCode (machineBetheOracleFloorNormalInput word)) + +def machineBetheOracleHeightResponse (word : List Bool) : List Bool := + pair [true] + (machineBetheHeightNormalVectorCode (machineBetheOracleDimension word)) + +def machineBetheOracleNonlinearResponse (word : List Bool) : List Bool := + pair [true] + (machineDirectedEpigraphNormalVectorCode + (machineBetheOracleObjectiveInput word)) + +def machineBetheOracleAcceptResponse (_word : List Bool) : List Bool := + pair [false] [] + +def machineBetheEpigraphOracleResponseCode (word : List Bool) : List Bool := + machineIfHead (machineBetheOracleFloorFoundBit word) + (machineBetheOracleFloorResponse word) + (machineIfHead (machineBetheOracleHeightViolationBit word) + (machineBetheOracleHeightResponse word) + (machineIfHead (machineBetheOracleNonlinearViolationBit word) + (machineBetheOracleNonlinearResponse word) + (machineBetheOracleAcceptResponse word))) + +theorem machineBetheOracleFloorNormalInput_mem_FP : + machineBetheOracleFloorNormalInput ∈ FP := + machinePair_mem_FP machineBetheOracleDimension_mem_FP + (machinePair_mem_FP machineBetheOracleFloorRow_mem_FP + machineBetheOracleFloorColumn_mem_FP) + +theorem machineBetheOracleFloorResponse_mem_FP : + machineBetheOracleFloorResponse ∈ FP := by + have hnormal := machineCompose_mem_FP + machineBetheOracleFloorNormalInput_mem_FP + machineBetheFloorCutVectorCode_mem_FP + exact machinePair_mem_FP (machineConst_mem_FP [true]) hnormal + +theorem machineBetheOracleHeightResponse_mem_FP : + machineBetheOracleHeightResponse ∈ FP := by + have hnormal := machineCompose_mem_FP machineBetheOracleDimension_mem_FP + machineBetheHeightNormalVectorCode_mem_FP + exact machinePair_mem_FP (machineConst_mem_FP [true]) hnormal + +theorem machineBetheOracleNonlinearResponse_mem_FP : + machineBetheOracleNonlinearResponse ∈ FP := by + have hnormal := machineCompose_mem_FP machineBetheOracleObjectiveInput_mem_FP + machineDirectedEpigraphNormalVectorCode_mem_FP + exact machinePair_mem_FP (machineConst_mem_FP [true]) hnormal + +theorem machineBetheOracleAcceptResponse_mem_FP : + machineBetheOracleAcceptResponse ∈ FP := + machineConst_mem_FP (pair [false] []) + +theorem machineBetheEpigraphOracleResponseCode_mem_FP : + machineBetheEpigraphOracleResponseCode ∈ FP := by + have hnonlinear := machineIfHead_mem_FP + machineBetheOracleNonlinearViolationBit_mem_FP + machineBetheOracleNonlinearResponse_mem_FP + machineBetheOracleAcceptResponse_mem_FP + have hheight := machineIfHead_mem_FP + machineBetheOracleHeightViolationBit_mem_FP + machineBetheOracleHeightResponse_mem_FP hnonlinear + simpa only [machineBetheEpigraphOracleResponseCode] using + machineIfHead_mem_FP machineBetheOracleFloorFoundBit_mem_FP + machineBetheOracleFloorResponse_mem_FP hheight + +/-! ## Canonical semantics -/ + +def machineBetheOracleCanonicalWord {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (p : ℕ) (delta upper : RawRat) + (E : RationalEllipsoidState (m * m + 1)) : List Bool := + pair (List.replicate m true) + (pair (List.replicate p true) + (pair (rawRatBinaryCode (rawRatOfRat tau)) + (pair (rawRatBinaryCode delta) + (pair (rawRatBinaryCode upper) + (pair (rationalMatrixBinaryEncoding.encode ⟨m + 1, A⟩) + (rationalEllipsoidStateBinaryCode E)))))) + +theorem ofFn_epigraph_center_split {d : ℕ} + (q : Fin (d + 1) → ℚ) : + List.ofFn q = List.ofFn (epigraphBase q) ++ [epigraphHeight q] := by + rw [List.ofFn_succ', List.concat_eq_append] + congr 2 + +@[simp] theorem machineBetheOracleDimension_encode {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (p : ℕ) (delta upper : RawRat) + (E : RationalEllipsoidState (m * m + 1)) : + machineBetheOracleDimension + (machineBetheOracleCanonicalWord tau A p delta upper E) = + List.replicate m true := by + simp [machineBetheOracleDimension, machineBetheOracleCanonicalWord] + +@[simp] theorem machineBetheOraclePrecision_encode {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (p : ℕ) (delta upper : RawRat) + (E : RationalEllipsoidState (m * m + 1)) : + machineBetheOraclePrecision + (machineBetheOracleCanonicalWord tau A p delta upper E) = + List.replicate p true := by + simp [machineBetheOraclePrecision, machineBetheOracleRest, + machineBetheOracleCanonicalWord] + +@[simp] theorem machineBetheOracleTau_encode {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (p : ℕ) (delta upper : RawRat) + (E : RationalEllipsoidState (m * m + 1)) : + machineBetheOracleTau + (machineBetheOracleCanonicalWord tau A p delta upper E) = + rawRatBinaryCode (rawRatOfRat tau) := by + simp [machineBetheOracleTau, machineBetheOracleAfterPrecision, + machineBetheOracleRest, machineBetheOracleCanonicalWord] + +@[simp] theorem machineBetheOracleDelta_encode {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (p : ℕ) (delta upper : RawRat) + (E : RationalEllipsoidState (m * m + 1)) : + machineBetheOracleDelta + (machineBetheOracleCanonicalWord tau A p delta upper E) = + rawRatBinaryCode delta := by + simp [machineBetheOracleDelta, machineBetheOracleAfterTau, + machineBetheOracleAfterPrecision, machineBetheOracleRest, + machineBetheOracleCanonicalWord] + +@[simp] theorem machineBetheOracleUpper_encode {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (p : ℕ) (delta upper : RawRat) + (E : RationalEllipsoidState (m * m + 1)) : + machineBetheOracleUpper + (machineBetheOracleCanonicalWord tau A p delta upper E) = + rawRatBinaryCode upper := by + simp [machineBetheOracleUpper, machineBetheOracleAfterDelta, + machineBetheOracleAfterTau, machineBetheOracleAfterPrecision, + machineBetheOracleRest, machineBetheOracleCanonicalWord] + +@[simp] theorem machineBetheOracleMatrix_encode {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (p : ℕ) (delta upper : RawRat) + (E : RationalEllipsoidState (m * m + 1)) : + machineBetheOracleMatrix + (machineBetheOracleCanonicalWord tau A p delta upper E) = + rationalMatrixBinaryEncoding.encode ⟨m + 1, A⟩ := by + simp [machineBetheOracleMatrix, machineBetheOracleAfterUpper, + machineBetheOracleAfterDelta, machineBetheOracleAfterTau, + machineBetheOracleAfterPrecision, machineBetheOracleRest, + machineBetheOracleCanonicalWord] + +@[simp] theorem machineBetheOracleEllipsoid_encode {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (p : ℕ) (delta upper : RawRat) + (E : RationalEllipsoidState (m * m + 1)) : + machineBetheOracleEllipsoid + (machineBetheOracleCanonicalWord tau A p delta upper E) = + rationalEllipsoidStateBinaryCode E := by + simp [machineBetheOracleEllipsoid, machineBetheOracleAfterUpper, + machineBetheOracleAfterDelta, machineBetheOracleAfterTau, + machineBetheOracleAfterPrecision, machineBetheOracleRest, + machineBetheOracleCanonicalWord] + +@[simp] theorem machineBetheOracleCenter_encode {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (p : ℕ) (delta upper : RawRat) + (E : RationalEllipsoidState (m * m + 1)) : + machineBetheOracleCenter + (machineBetheOracleCanonicalWord tau A p delta upper E) = + rationalFiniteVectorCode E.center := by + rw [machineBetheOracleCenter, machineBetheOracleEllipsoid_encode, + machineRationalEllipsoidCenterWord_encode] + +@[simp] theorem machineBetheOracleBase_encode {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (p : ℕ) (delta upper : RawRat) + (E : RationalEllipsoidState (m * m + 1)) : + machineBetheOracleBase + (machineBetheOracleCanonicalWord tau A p delta upper E) = + rationalFiniteVectorCode (epigraphBase E.center) := by + rw [machineBetheOracleBase, machineBetheOracleCenter_encode, + rationalFiniteVectorCode, ofFn_epigraph_center_split, + machineBinaryListInit_encode] + rfl + +@[simp] theorem machineBetheOracleBaseDimensionBits_encode {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (p : ℕ) (delta upper : RawRat) + (E : RationalEllipsoidState (m * m + 1)) : + machineBetheOracleBaseDimensionBits + (machineBetheOracleCanonicalWord tau A p delta upper E) = + (m * m).bits := by + rw [machineBetheOracleBaseDimensionBits, + machineBetheOracleDimensionBits, machineBetheOracleDimension_encode, + machineLengthBits_encode, List.length_replicate, + machineBinaryMulBits_pair_natBits] + +theorem betheOracle_baseDimension_le_baseCodeLength {m : ℕ} + (q : Fin (m * m) → ℚ) : + m * m ≤ (rationalFiniteVectorCode q).length := by + simpa only [rationalFiniteVectorCode, List.length_ofFn] using + binaryListCode_listLength_le rationalEntryBinaryCode (List.ofFn q) + +@[simp] theorem machineBetheOracleBaseDimensionUnary_encode {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (p : ℕ) (delta upper : RawRat) + (E : RationalEllipsoidState (m * m + 1)) : + machineBetheOracleBaseDimensionUnary + (machineBetheOracleCanonicalWord tau A p delta upper E) = + List.replicate (m * m) true := by + rw [machineBetheOracleBaseDimensionUnary, + machineBetheOracleBase_encode, + machineBetheOracleBaseDimensionBits_encode] + exact machineBoundedUnary_encode_of_le _ _ + (betheOracle_baseDimension_le_baseCodeLength (epigraphBase E.center)) + +@[simp] theorem machineBetheOracleBaseDimensionRawCode_encode {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (p : ℕ) (delta upper : RawRat) + (E : RationalEllipsoidState (m * m + 1)) : + machineBetheOracleBaseDimensionRawCode + (machineBetheOracleCanonicalWord tau A p delta upper E) = + rawRatBinaryCode (RawRat.ofNat (m * m)) := by + rw [machineBetheOracleBaseDimensionRawCode, + machineBetheOracleBaseDimensionBits_encode, + machineNaturalIntegerCode_natBits] + simp [rawRatBinaryCode, RawRat.ofNat] + +@[simp] theorem machineBetheOracleFloorScanInput_encode {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (p : ℕ) (delta upper : RawRat) + (E : RationalEllipsoidState (m * m + 1)) : + machineBetheOracleFloorScanInput + (machineBetheOracleCanonicalWord tau A p delta upper E) = + machineBetheFloorScanCanonicalWord delta (epigraphBase E.center) := by + simp [machineBetheOracleFloorScanInput, + machineBetheFloorScanCanonicalWord] + +@[simp] theorem machineBetheOracleFloorScanResult_encode {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (p : ℕ) (delta upper : RawRat) + (E : RationalEllipsoidState (m * m + 1)) : + machineBetheOracleFloorScanResult + (machineBetheOracleCanonicalWord tau A p delta upper E) = + betheFloorScanSemanticResultCode + (finalBetheFloorScanSemanticState delta (epigraphBase E.center)) := by + rw [machineBetheOracleFloorScanResult, + machineBetheOracleFloorScanInput_encode, + machineBetheFloorScanResultCode_encode] + +@[simp] theorem machineBetheOracleFloorFoundBit_encode {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (p : ℕ) (delta upper : RawRat) + (E : RationalEllipsoidState (m * m + 1)) : + machineBetheOracleFloorFoundBit + (machineBetheOracleCanonicalWord tau A p delta upper E) = + [(finalBetheFloorScanSemanticState delta + (epigraphBase E.center)).found] := by + rw [machineBetheOracleFloorFoundBit, + machineBetheOracleFloorScanResult_encode] + simp [betheFloorScanSemanticResultCode] + +@[simp] theorem machineBetheOracleFloorRow_encode {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (p : ℕ) (delta upper : RawRat) + (E : RationalEllipsoidState (m * m + 1)) : + machineBetheOracleFloorRow + (machineBetheOracleCanonicalWord tau A p delta upper E) = + List.replicate + (finalBetheFloorScanSemanticState delta + (epigraphBase E.center)).row.1 true := by + rw [machineBetheOracleFloorRow, + machineBetheOracleFloorScanResult_encode] + simp [betheFloorScanSemanticResultCode] + +@[simp] theorem machineBetheOracleFloorColumn_encode {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (p : ℕ) (delta upper : RawRat) + (E : RationalEllipsoidState (m * m + 1)) : + machineBetheOracleFloorColumn + (machineBetheOracleCanonicalWord tau A p delta upper E) = + List.replicate + (finalBetheFloorScanSemanticState delta + (epigraphBase E.center)).column.1 true := by + rw [machineBetheOracleFloorColumn, + machineBetheOracleFloorScanResult_encode] + simp [betheFloorScanSemanticResultCode] + +@[simp] theorem machineBetheOracleHeightInput_encode {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (p : ℕ) (delta upper : RawRat) + (E : RationalEllipsoidState (m * m + 1)) : + machineBetheOracleHeightInput + (machineBetheOracleCanonicalWord tau A p delta upper E) = + machineBetheHeightCapCanonicalWord upper E.center := by + simp [machineBetheOracleHeightInput, + machineBetheHeightCapCanonicalWord] + +@[simp] theorem machineBetheOracleHeightViolationBit_encode {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (p : ℕ) (delta upper : RawRat) + (E : RationalEllipsoidState (m * m + 1)) : + machineBetheOracleHeightViolationBit + (machineBetheOracleCanonicalWord tau A p delta upper E) = + [decide (upper.value < epigraphHeight E.center)] := by + rw [machineBetheOracleHeightViolationBit, + machineBetheOracleHeightInput_encode, + machineBetheHeightCapViolationBit_encode] + rfl + +@[simp] theorem machineBetheOracleHeightRawCode_encode {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (p : ℕ) (delta upper : RawRat) + (E : RationalEllipsoidState (m * m + 1)) : + machineBetheOracleHeightRawCode + (machineBetheOracleCanonicalWord tau A p delta upper E) = + rawRatBinaryCode (rawRatOfRat (epigraphHeight E.center)) := by + rw [machineBetheOracleHeightRawCode, + machineBetheOracleHeightInput_encode, + machineBetheHeightCapEntryCode_encode] + rfl + +def rawBetheOracleMargin (m p : ℕ) : RawRat := + (rawBetheOracleSixteen.mul (rawOptimizerHalf.pow p)).mul + (RawRat.ofNat (m * m)) + +@[simp] theorem machineBetheOracleHalfPowerRawCode_encode {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (p : ℕ) (delta upper : RawRat) + (E : RationalEllipsoidState (m * m + 1)) : + machineBetheOracleHalfPowerRawCode + (machineBetheOracleCanonicalWord tau A p delta upper E) = + rawRatBinaryCode (rawOptimizerHalf.pow p) := by + rw [machineBetheOracleHalfPowerRawCode, + machineBetheOraclePrecision_encode, + machineRawRatPowerCode_encode] + +@[simp] theorem machineBetheOracleScaledErrorRawCode_encode {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (p : ℕ) (delta upper : RawRat) + (E : RationalEllipsoidState (m * m + 1)) : + machineBetheOracleScaledErrorRawCode + (machineBetheOracleCanonicalWord tau A p delta upper E) = + rawRatBinaryCode + (rawBetheOracleSixteen.mul (rawOptimizerHalf.pow p)) := by + rw [machineBetheOracleScaledErrorRawCode, + machineBetheOracleHalfPowerRawCode_encode, + machineRawRatMulCode_encode] + +@[simp] theorem machineBetheOracleMarginRawCode_encode {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (p : ℕ) (delta upper : RawRat) + (E : RationalEllipsoidState (m * m + 1)) : + machineBetheOracleMarginRawCode + (machineBetheOracleCanonicalWord tau A p delta upper E) = + rawRatBinaryCode (rawBetheOracleMargin m p) := by + rw [machineBetheOracleMarginRawCode, + machineBetheOracleScaledErrorRawCode_encode, + machineBetheOracleBaseDimensionRawCode_encode, + machineRawRatMulCode_encode] + rfl + +@[simp] theorem rawBetheOracleMargin_value (m p : ℕ) : + (rawBetheOracleMargin m p).value = + 16 * (1 / 2 : ℚ) ^ p * (m * m) := by + simp [rawBetheOracleMargin, rawBetheOracleSixteen, + RawRat.value_mul, RawRat.value_pow, rawOptimizerHalf_value] + +@[simp] theorem machineBetheOracleObjectiveInput_encode {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (p : ℕ) (delta upper : RawRat) + (E : RationalEllipsoidState (m * m + 1)) : + machineBetheOracleObjectiveInput + (machineBetheOracleCanonicalWord tau A p delta upper E) = + machineDirectedObjectiveSumCanonicalWord tau A + (epigraphBase E.center) p := by + simp [machineBetheOracleObjectiveInput, + machineDirectedObjectiveSumCanonicalWord] + +@[simp] theorem machineBetheOracleLowerRawCode_encode {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (p : ℕ) (delta upper : RawRat) + (E : RationalEllipsoidState (m * m + 1)) : + machineBetheOracleLowerRawCode + (machineBetheOracleCanonicalWord tau A p delta upper E) = + rawRatBinaryCode + (rawDirectedNegativeObjectiveSum tau A (epigraphBase E.center) p) := by + rw [machineBetheOracleLowerRawCode, + machineBetheOracleObjectiveInput_encode, + machineDirectedNegativeObjectiveSumRawCode_encode] + +@[simp] theorem machineBetheOracleHeightPlusMarginRawCode_encode {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (p : ℕ) (delta upper : RawRat) + (E : RationalEllipsoidState (m * m + 1)) : + machineBetheOracleHeightPlusMarginRawCode + (machineBetheOracleCanonicalWord tau A p delta upper E) = + rawRatBinaryCode + ((rawRatOfRat (epigraphHeight E.center)).add + (rawBetheOracleMargin m p)) := by + rw [machineBetheOracleHeightPlusMarginRawCode, + machineBetheOracleHeightRawCode_encode, + machineBetheOracleMarginRawCode_encode, + machineRawRatAddCode_encode] + +@[simp] theorem machineBetheOracleNonlinearViolationBit_encode {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (p : ℕ) (delta upper : RawRat) + (E : RationalEllipsoidState (m * m + 1)) : + machineBetheOracleNonlinearViolationBit + (machineBetheOracleCanonicalWord tau A p delta upper E) = + [decide + (epigraphHeight E.center + + 16 * (1 / 2 : ℚ) ^ p * (m * m) < + directedNegativeObjectiveLower tau A + (betheAffineMatrixQ (epigraphBase E.center)) p)] := by + rw [machineBetheOracleNonlinearViolationBit, + machineBetheOracleLowerRawCode_encode, + machineBetheOracleHeightPlusMarginRawCode_encode, + machineRawRatLeBit_encode, machineNotBit_one] + rw [rawDirectedNegativeObjectiveSum_value, RawRat.value_add, + rawRatOfRat_value, rawBetheOracleMargin_value] + rw [← decide_not] + simp only [not_le] + +@[simp] theorem machineBetheOracleFloorNormalInput_encode {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (p : ℕ) (delta upper : RawRat) + (E : RationalEllipsoidState (m * m + 1)) : + machineBetheOracleFloorNormalInput + (machineBetheOracleCanonicalWord tau A p delta upper E) = + machineBetheFloorCutVectorCanonicalWord + (finalBetheFloorScanSemanticState delta + (epigraphBase E.center)).row + (finalBetheFloorScanSemanticState delta + (epigraphBase E.center)).column := by + simp [machineBetheOracleFloorNormalInput, + machineBetheFloorCutVectorCanonicalWord] + +@[simp] theorem machineBetheOracleFloorResponse_encode {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (p : ℕ) (delta upper : RawRat) + (E : RationalEllipsoidState (m * m + 1)) : + machineBetheOracleFloorResponse + (machineBetheOracleCanonicalWord tau A p delta upper E) = + rationalCentralOracleResponseBinaryCode + (.cut (betheFloorCutNormal + (finalBetheFloorScanSemanticState delta + (epigraphBase E.center)).row + (finalBetheFloorScanSemanticState delta + (epigraphBase E.center)).column)) := by + rw [machineBetheOracleFloorResponse, + machineBetheOracleFloorNormalInput_encode, + machineBetheFloorCutVectorCode_encode_oracleNormal] + rfl + +@[simp] theorem machineBetheOracleHeightResponse_encode {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (p : ℕ) (delta upper : RawRat) + (E : RationalEllipsoidState (m * m + 1)) : + machineBetheOracleHeightResponse + (machineBetheOracleCanonicalWord tau A p delta upper E) = + rationalCentralOracleResponseBinaryCode + (.cut (epigraphUpperNormal (m * m))) := by + rw [machineBetheOracleHeightResponse, + machineBetheOracleDimension_encode, + machineBetheHeightNormalVectorCode_encode] + rfl + +@[simp] theorem machineBetheOracleNonlinearResponse_encode {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (p : ℕ) (delta upper : RawRat) + (E : RationalEllipsoidState (m * m + 1)) : + machineBetheOracleNonlinearResponse + (machineBetheOracleCanonicalWord tau A p delta upper E) = + rationalCentralOracleResponseBinaryCode + (.cut (epigraphNormal + ((betheDirectedEpigraphData tau A p).gradient + (epigraphBase E.center)))) := by + rw [machineBetheOracleNonlinearResponse, + machineBetheOracleObjectiveInput_encode, + machineDirectedEpigraphNormalVectorCode_encode_oracleNormal] + rfl + +@[simp] theorem machineBetheOracleAcceptResponse_encode {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (p : ℕ) (delta upper : RawRat) + (E : RationalEllipsoidState (m * m + 1)) : + machineBetheOracleAcceptResponse + (machineBetheOracleCanonicalWord tau A p delta upper E) = + rationalCentralOracleResponseBinaryCode + (RationalCentralOracleResponse.accept : + RationalCentralOracleResponse (m * m + 1)) := by + rfl + +/-- Semantic oracle implemented by the row-major machine scan. The scan +state is exposed here only to state the exact program-correctness theorem; +the validity proof below uses its established first-violation invariant. -/ +def scannedBetheBoundedEpigraphOracle {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (p : ℕ) (delta upper : RawRat) : + RationalCentralOracle (m * m + 1) := + fun E ↦ + let state := finalBetheFloorScanSemanticState delta + (epigraphBase E.center) + if state.found then + .cut (betheFloorCutNormal state.row state.column) + else if upper.value < epigraphHeight E.center then + .cut (epigraphUpperNormal (m * m)) + else + directedEpigraphOracle + (betheDirectedEpigraphData tau A p) + (16 * (1 / 2 : ℚ) ^ p) (m * m) E + +@[simp] theorem machineBetheEpigraphOracleResponseCode_encode {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (p : ℕ) (delta upper : RawRat) + (E : RationalEllipsoidState (m * m + 1)) : + machineBetheEpigraphOracleResponseCode + (machineBetheOracleCanonicalWord tau A p delta upper E) = + rationalCentralOracleResponseBinaryCode + (scannedBetheBoundedEpigraphOracle tau A p delta upper E) := by + let state := finalBetheFloorScanSemanticState delta + (epigraphBase E.center) + rw [machineBetheEpigraphOracleResponseCode, + machineBetheOracleFloorFoundBit_encode] + change machineIfHead [state.found] + (machineBetheOracleFloorResponse + (machineBetheOracleCanonicalWord tau A p delta upper E)) + _ = _ + cases hfound : state.found + · rw [machineIfHead_false] + by_cases hheight : upper.value < epigraphHeight E.center + · rw [machineBetheOracleHeightViolationBit_encode] + simp only [hheight, decide_true, machineIfHead_true] + rw [machineBetheOracleHeightResponse_encode] + simp [scannedBetheBoundedEpigraphOracle, state, hfound, hheight] + · rw [machineBetheOracleHeightViolationBit_encode] + simp only [hheight, decide_false, machineIfHead_false] + by_cases hnonlinear : epigraphHeight E.center + + 16 * (1 / 2 : ℚ) ^ p * (m * m) < + directedNegativeObjectiveLower tau A + (betheAffineMatrixQ (epigraphBase E.center)) p + · rw [machineBetheOracleNonlinearViolationBit_encode] + simp only [hnonlinear, decide_true, machineIfHead_true] + rw [machineBetheOracleNonlinearResponse_encode] + have hnonlinear' : epigraphHeight E.center + + 16 * (2 ^ p : ℚ)⁻¹ * (m * m) < + directedNegativeObjectiveLower tau A + (betheAffineMatrixQ (epigraphBase E.center)) p := by + simpa [one_div, div_pow] using hnonlinear + simp [scannedBetheBoundedEpigraphOracle, state, hfound, hheight, + directedEpigraphOracle, betheDirectedEpigraphData, hnonlinear'] + · rw [machineBetheOracleNonlinearViolationBit_encode] + simp only [hnonlinear, decide_false, machineIfHead_false] + rw [machineBetheOracleAcceptResponse_encode] + have hnonlinear' : ¬(epigraphHeight E.center + + 16 * (2 ^ p : ℚ)⁻¹ * (m * m) < + directedNegativeObjectiveLower tau A + (betheAffineMatrixQ (epigraphBase E.center)) p) := by + simpa [one_div, div_pow] using hnonlinear + simp [scannedBetheBoundedEpigraphOracle, state, hfound, hheight, + directedEpigraphOracle, betheDirectedEpigraphData, hnonlinear'] + · rw [machineIfHead_true, + machineBetheOracleFloorResponse_encode] + simp [scannedBetheBoundedEpigraphOracle, state, hfound] + +/-! ## Mathematical validity of the implemented scan oracle -/ + +theorem scannedBetheBoundedEpigraphOracle_valid {m : ℕ} (hm : 0 < m) + {tau : ℚ} {A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ} + (htau0 : 0 ≤ tau) (htau1 : tau ≤ 1) (hA : ∀ i j, 0 < A i j) + {delta : RawRat} (hdelta : 0 < delta.value) + (p : ℕ) (upper : RawRat) : + RationalCentralOracleValid + (BetheEpigraphTarget (tau : ℝ) (fun i j ↦ (A i j : ℝ)) + (delta.value : ℝ) (upper.value : ℝ)) + (scannedBetheBoundedEpigraphOracle tau A p delta upper) := by + intro E a hresponse + rw [scannedBetheBoundedEpigraphOracle] at hresponse + split at hresponse <;> rename_i hfloor + · let state := finalBetheFloorScanSemanticState delta + (epigraphBase E.center) + have hfloor' : state.found = true := by simpa only [state] using hfloor + cases hresponse + refine ⟨betheFloorCutNormal_ne_zero hm state.row state.column, ?_⟩ + intro z hz + have hbelow : betheAffineMatrixQ (epigraphBase E.center) + state.row state.column < delta.value := by + exact finalBetheFloorScanSemanticState_found_is_below + delta (epigraphBase E.center) hfloor' + have htargetFloor : (delta.value : ℝ) ≤ + birkhoffAffineMap (vectorToSquareMatrix (epigraphBase z)) + state.row state.column := by + simpa only [BetheEpigraphTarget] using hz.1 state.row state.column + have hcut := betheFloorCut_valid hbelow htargetFloor + rw [finiteDot, Fin.sum_univ_castSucc] at hcut ⊢ + simpa [rationalCenterReal, epigraphBase] using hcut.le + · split at hresponse <;> rename_i hheight + · cases hresponse + refine ⟨epigraphUpperNormal_ne_zero (m * m), ?_⟩ + intro z hz + have hdot := epigraphUpperNormal_dot_displacement z E.center + rw [show finiteDot + (fun i ↦ (epigraphUpperNormal (m * m) i : ℝ)) + (fun i ↦ z i - rationalCenterReal E i) = + epigraphHeight z - (epigraphHeight E.center : ℚ) by + simpa only [rationalCenterReal] using hdot] + have hzUpper : epigraphHeight z ≤ (upper.value : ℝ) := by + simpa only [BetheEpigraphTarget] using hz.2.2 + have hheightReal : (upper.value : ℝ) < + ((epigraphHeight E.center : ℚ) : ℝ) := by + exact_mod_cast hheight + linarith + · have hqueryFloor : ∀ i j, delta.value ≤ + betheAffineMatrixQ (epigraphBase E.center) i j := by + apply finalBetheFloorScanSemanticState_notFound_all_above + simpa using hfloor + refine ⟨directedEpigraphOracle_cut_ne_zero + (betheDirectedEpigraphData tau A p) + (16 * (1 / 2 : ℚ) ^ p) (m * m) E hresponse, ?_⟩ + intro z hz + exact (betheDirectedEpigraphOracle_cut_valid hm htau0 htau1 hA + hdelta (upper := (upper.value : ℝ)) p E hqueryFloor + hresponse hz).2.le + +theorem scannedBetheBoundedEpigraphOracle_acceptsOnly {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (p : ℕ) (delta upper : RawRat) : + RationalCentralOracleAcceptsOnly + (BetheEpigraphOracleAccepted tau A p delta.value upper.value) + (scannedBetheBoundedEpigraphOracle tau A p delta upper) := by + intro E hresponse + rw [scannedBetheBoundedEpigraphOracle] at hresponse + split at hresponse <;> rename_i hfloor + · contradiction + · split at hresponse <;> rename_i hheight + · contradiction + · rw [directedEpigraphOracle] at hresponse + split at hresponse <;> rename_i hnonlinear + · contradiction + · cases hresponse + refine ⟨?_, not_lt.mp hheight, ?_⟩ + · apply finalBetheFloorScanSemanticState_notFound_all_above + simpa using hfloor + · exact not_lt.mp hnonlinear + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineBetheFeasibilityFit.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineBetheFeasibilityFit.lean new file mode 100644 index 0000000000..bb24551240 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineBetheFeasibilityFit.lean @@ -0,0 +1,142 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineScheduledStateEncodingBound +import Mathlib.Tactic + +/-! +# The canonical Bethe feasibility run always fits its finite-word ruler + +The determinant and magnitude invariants of the fixed schedule imply a single +ordinary-binary bound for every state reachable during the bounded run. This +discharges the last side condition in the program-correctness theorem for the +feasibility machine. +-/ + +namespace BeyondBethe + +def scheduledFeasibilityStateCodeBound (d L K T : ℕ) : ℕ := + rationalEllipsoidMachineCodeBound d + (K + T * (6 + 3 * d)) + (roundedEllipsoidPrecisionSchedule d L K T + 10 + 4 * d) + +def explicitBallFeasibilityStateCodeBound (d T : ℕ) (R : ℚ) : ℕ := + scheduledFeasibilityStateCodeBound d + (explicitBallInitialDetExponent d R) + (explicitBallInitialMagnitudeExponent d R) T + +theorem MachineBetheFeasibilityFits.of_invariant + {m L K T t iterations : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (oraclePrecision : ℕ) (delta upper : RawRat) + {Target : (Fin (m * m + 1) → ℝ) → Prop} + (hvalid : RationalCentralOracleValid Target + (scannedBetheBoundedEpigraphOracle + tau A oraclePrecision delta upper)) + (E : RationalEllipsoidState (m * m + 1)) + (hE : ScheduledEllipsoidInvariant (m * m + 1) L K t E) + (hbudget : t + iterations ≤ T) : + MachineBetheFeasibilityFits tau A oraclePrecision delta upper + (roundedEllipsoidPrecisionSchedule (m * m + 1) L K T) + (scheduledFeasibilityStateCodeBound (m * m + 1) L K T) + iterations E := by + let d := m * m + 1 + have hd : 0 < d := by + dsimp only [d] + omega + induction iterations generalizing t E with + | zero => trivial + | succ iterations ih => + rw [MachineBetheFeasibilityFits] + cases hresponse : scannedBetheBoundedEpigraphOracle + tau A oraclePrecision delta upper E with + | accept => trivial + | cut a => + have ha : a ≠ 0 := (hvalid E a hresponse).1 + have hpulled : rationalPulledBackNormal E a ≠ 0 := + rationalPulledBackNormal_ne_zero_of_det_ne_zero + E a hE.det_ne_zero ha + have htT : t ≤ T := by omega + let p := roundedEllipsoidPrecisionSchedule d L K T + let E₁ := scheduledRoundedEllipsoidCentralUpdate p E a + have hadvance := hE.advance hd a hpulled htT + have hE₁ : ScheduledEllipsoidInvariant d L K (t + 1) E₁ := by + simpa only [d, p, E₁] using hadvance.2 + constructor + · have hexponent : K + (t + 1) * (6 + 3 * d) ≤ + K + T * (6 + 3 * d) := by + gcongr + omega + have hpow : (2 : ℚ) ^ (K + (t + 1) * (6 + 3 * d)) ≤ + (2 : ℚ) ^ (K + T * (6 + 3 * d)) := by + exact pow_le_pow_right₀ (by norm_num) hexponent + have hM : rationalStateAbsBound E₁ ≤ + (2 : ℚ) ^ (K + T * (6 + 3 * d)) := + hE₁.magnitude.trans hpow + have hcode := + scheduledRoundedEllipsoidCentralUpdate_stateCode_length_le + hd E a hM + simpa only [d, p, E₁, + scheduledFeasibilityStateCodeBound] using hcode + · have hbudget' : (t + 1) + iterations ≤ T := by omega + exact ih (t := t + 1) (E := E₁) hE₁ hbudget' + +theorem explicitBallMachineBetheFeasibilityFits + {m : ℕ} (hm : 0 < m) + {tau : ℚ} (htau0 : 0 ≤ tau) (htau1 : tau ≤ 1) + {A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ} + (hA : ∀ i j, 0 < A i j) + (oraclePrecision : ℕ) {delta : RawRat} + (hdelta : 0 < delta.value) (upper : RawRat) + (budget : ℕ) {R : ℚ} (hR : 0 < R) : + MachineBetheFeasibilityFits tau A oraclePrecision delta upper + (explicitBallFeasibilityPrecision (m * m + 1) budget R) + (explicitBallFeasibilityStateCodeBound (m * m + 1) budget R) + budget (rationalBallEllipsoid (m * m + 1) 0 R) := by + let d := m * m + 1 + let L := explicitBallInitialDetExponent d R + let K := explicitBallInitialMagnitudeExponent d R + have hInv : ScheduledEllipsoidInvariant d L K 0 + (rationalBallEllipsoid d 0 R) := by + simpa only [d, L, K] using explicitBallInitialInvariant hR + have hvalid := scannedBetheBoundedEpigraphOracle_valid + hm htau0 htau1 hA hdelta oraclePrecision upper + have hfit := MachineBetheFeasibilityFits.of_invariant + (L := L) (K := K) (T := budget) (t := 0) (iterations := budget) + tau A oraclePrecision delta upper hvalid + (rationalBallEllipsoid d 0 R) hInv (by omega) + simpa only [d, L, K, explicitBallFeasibilityPrecision, + explicitBallFeasibilityStateCodeBound] using hfit + +theorem machineExplicitBallBetheFeasibilityResultCode_encode + {m : ℕ} (hm : 0 < m) + {tau : ℚ} (htau0 : 0 ≤ tau) (htau1 : tau ≤ 1) + {A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ} + (hA : ∀ i j, 0 < A i j) + (oraclePrecision : ℕ) {delta : RawRat} + (hdelta : 0 < delta.value) (upper : RawRat) + (budget : ℕ) {R : ℚ} (hR : 0 < R) : + machineBetheFeasibilityResultCode + (machineBetheFeasibilityCanonicalWord tau A oraclePrecision + delta upper + (explicitBallFeasibilityPrecision (m * m + 1) budget R) + budget + (explicitBallFeasibilityStateCodeBound (m * m + 1) budget R) + (rationalBallEllipsoid (m * m + 1) 0 R)) = + rationalFeasibilityResultBinaryCode + (runExplicitBallRationalFeasibility + (scannedBetheBoundedEpigraphOracle + tau A oraclePrecision delta upper) budget R) := by + rw [runExplicitBallRationalFeasibility] + exact machineBetheFeasibilityResultCode_encode tau A oraclePrecision + delta upper + (explicitBallFeasibilityPrecision (m * m + 1) budget R) + budget (explicitBallFeasibilityStateCodeBound (m * m + 1) budget R) + (rationalBallEllipsoid (m * m + 1) 0 R) + (explicitBallMachineBetheFeasibilityFits hm htau0 htau1 hA + oraclePrecision hdelta upper budget hR) + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineBetheFeasibilityLoop.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineBetheFeasibilityLoop.lean new file mode 100644 index 0000000000..da2b679693 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineBetheFeasibilityLoop.lean @@ -0,0 +1,641 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineBetheEpigraphOracle +import LeanPool.BeyondBethe.BeyondBethe.MachineScheduledRoundedEllipsoid +import LeanPool.BeyondBethe.BeyondBethe.ScannedBetheThresholdFeasibility +import Mathlib.Tactic + +/-! +# A finite-word fixed-precision Bethe feasibility loop + +The loop stores the immutable call word beside the current ellipsoid. Every +new ellipsoid word is clamped to an explicit ruler stored in the call. This +makes the iteration polynomial-time on every malformed input. A separate +semantic predicate records that the clamp is inactive on the canonical run. +-/ + +namespace BeyondBethe + +open Complexity + +/-! ## Call layout -/ + +/-- Call layout: +`pair budgetUnary (pair stateBound (pair roundingPrecisionUnary + (pair oracleStatic initialEllipsoid)))`. + +The oracle-static word has layout +`pair mUnary (pair oraclePrecisionUnary (pair tauRaw + (pair deltaRaw (pair upperRaw matrixCode))))`. -/ +def machineBetheFeasibilityBudget (word : List Bool) : List Bool := + machinePairFirst word + +def machineBetheFeasibilityAfterBudget (word : List Bool) : List Bool := + machinePairSecond word + +def machineBetheFeasibilityBound (word : List Bool) : List Bool := + machinePairFirst (machineBetheFeasibilityAfterBudget word) + +def machineBetheFeasibilityAfterBound (word : List Bool) : List Bool := + machinePairSecond (machineBetheFeasibilityAfterBudget word) + +def machineBetheFeasibilityRoundingPrecision + (word : List Bool) : List Bool := + machinePairFirst (machineBetheFeasibilityAfterBound word) + +def machineBetheFeasibilityStaticAndInitial + (word : List Bool) : List Bool := + machinePairSecond (machineBetheFeasibilityAfterBound word) + +def machineBetheFeasibilityOracleStatic + (word : List Bool) : List Bool := + machinePairFirst (machineBetheFeasibilityStaticAndInitial word) + +def machineBetheFeasibilityInitialEllipsoid + (word : List Bool) : List Bool := + machinePairSecond (machineBetheFeasibilityStaticAndInitial word) + +/-! ## Iteration state -/ + +def machineBetheFeasibilityStatePack + (accepted source ellipsoid bound : List Bool) : List Bool := + pair accepted (pair source (pair ellipsoid bound)) + +def machineBetheFeasibilityStateAccepted + (state : List Bool) : List Bool := + machinePairFirst state + +def machineBetheFeasibilityStateSource + (state : List Bool) : List Bool := + machinePairFirst (machinePairSecond state) + +def machineBetheFeasibilityStateEllipsoid + (state : List Bool) : List Bool := + machinePairFirst (machinePairSecond (machinePairSecond state)) + +def machineBetheFeasibilityStateBound + (state : List Bool) : List Bool := + machinePairSecond (machinePairSecond (machinePairSecond state)) + +def machineBetheFeasibilityInit (word : List Bool) : List Bool := + machineBetheFeasibilityStatePack [false] word + (machineBetheFeasibilityInitialEllipsoid word) + (machineBetheFeasibilityBound word) + +/-! ## One oracle/update step -/ + +def machineBetheFeasibilityStaticDimension + (state : List Bool) : List Bool := + machinePairFirst + (machineBetheFeasibilityOracleStatic + (machineBetheFeasibilityStateSource state)) + +def machineBetheFeasibilityStaticRest + (state : List Bool) : List Bool := + machinePairSecond + (machineBetheFeasibilityOracleStatic + (machineBetheFeasibilityStateSource state)) + +def machineBetheFeasibilityStaticOraclePrecision + (state : List Bool) : List Bool := + machinePairFirst (machineBetheFeasibilityStaticRest state) + +def machineBetheFeasibilityStaticAfterPrecision + (state : List Bool) : List Bool := + machinePairSecond (machineBetheFeasibilityStaticRest state) + +def machineBetheFeasibilityStaticTau + (state : List Bool) : List Bool := + machinePairFirst (machineBetheFeasibilityStaticAfterPrecision state) + +def machineBetheFeasibilityStaticAfterTau + (state : List Bool) : List Bool := + machinePairSecond (machineBetheFeasibilityStaticAfterPrecision state) + +def machineBetheFeasibilityStaticDelta + (state : List Bool) : List Bool := + machinePairFirst (machineBetheFeasibilityStaticAfterTau state) + +def machineBetheFeasibilityStaticAfterDelta + (state : List Bool) : List Bool := + machinePairSecond (machineBetheFeasibilityStaticAfterTau state) + +def machineBetheFeasibilityStaticUpper + (state : List Bool) : List Bool := + machinePairFirst (machineBetheFeasibilityStaticAfterDelta state) + +def machineBetheFeasibilityStaticMatrix + (state : List Bool) : List Bool := + machinePairSecond (machineBetheFeasibilityStaticAfterDelta state) + +def machineBetheFeasibilityOracleInput + (state : List Bool) : List Bool := + pair (machineBetheFeasibilityStaticDimension state) + (pair (machineBetheFeasibilityStaticOraclePrecision state) + (pair (machineBetheFeasibilityStaticTau state) + (pair (machineBetheFeasibilityStaticDelta state) + (pair (machineBetheFeasibilityStaticUpper state) + (pair (machineBetheFeasibilityStaticMatrix state) + (machineBetheFeasibilityStateEllipsoid state)))))) + +def machineBetheFeasibilityOracleResponse + (state : List Bool) : List Bool := + machineBetheEpigraphOracleResponseCode + (machineBetheFeasibilityOracleInput state) + +def machineBetheFeasibilityResponseTag + (state : List Bool) : List Bool := + machineHeadBit (machineRationalTaggedResultTag + (machineBetheFeasibilityOracleResponse state)) + +def machineBetheFeasibilityResponsePayload + (state : List Bool) : List Bool := + machineRationalTaggedResultPayload + (machineBetheFeasibilityOracleResponse state) + +def machineBetheFeasibilityScheduledUpdateInput + (state : List Bool) : List Bool := + pair (machineBetheFeasibilityRoundingPrecision + (machineBetheFeasibilityStateSource state)) + (pair (machineBetheFeasibilityStateEllipsoid state) + (machineBetheFeasibilityResponsePayload state)) + +def machineBetheFeasibilityUpdatedEllipsoidCandidate + (state : List Bool) : List Bool := + machineScheduledRoundedEllipsoidCentralUpdateCode + (machineBetheFeasibilityScheduledUpdateInput state) + +def machineBetheFeasibilityUpdatedEllipsoid + (state : List Bool) : List Bool := + (machineBetheFeasibilityUpdatedEllipsoidCandidate state).take + (machineBetheFeasibilityStateBound state).length + +def machineBetheFeasibilityCutState + (state : List Bool) : List Bool := + machineBetheFeasibilityStatePack [false] + (machineBetheFeasibilityStateSource state) + (machineBetheFeasibilityUpdatedEllipsoid state) + (machineBetheFeasibilityStateBound state) + +def machineBetheFeasibilityAcceptState + (state : List Bool) : List Bool := + machineBetheFeasibilityStatePack [true] + (machineBetheFeasibilityStateSource state) + (machineBetheFeasibilityStateEllipsoid state) + (machineBetheFeasibilityStateBound state) + +def machineBetheFeasibilityStep (state : List Bool) : List Bool := + machineIfHead (machineHeadBit + (machineBetheFeasibilityStateAccepted state)) state + (machineIfHead (machineBetheFeasibilityResponseTag state) + (machineBetheFeasibilityCutState state) + (machineBetheFeasibilityAcceptState state)) + +/-! ## Final result -/ + +def machineBetheFeasibilityFinalState (word : List Bool) : List Bool := + (machineBetheFeasibilityStep)^[(machineBetheFeasibilityBudget word).length] + (machineBetheFeasibilityInit word) + +def machineBetheFeasibilityStateResultCode + (state : List Bool) : List Bool := + machineIfHead (machineHeadBit + (machineBetheFeasibilityStateAccepted state)) + (pair [false] + (machineRationalEllipsoidCenterWord + (machineBetheFeasibilityStateEllipsoid state))) + (pair [true] (machineBetheFeasibilityStateEllipsoid state)) + +def machineBetheFeasibilityResultCode (word : List Bool) : List Bool := + machineBetheFeasibilityStateResultCode + (machineBetheFeasibilityFinalState word) + +/-! ## Polynomial-time closure of accessors and one step -/ + +theorem machineBetheFeasibilityBudget_mem_FP : + machineBetheFeasibilityBudget ∈ FP := machinePairFirst_mem_FP + +theorem machineBetheFeasibilityAfterBudget_mem_FP : + machineBetheFeasibilityAfterBudget ∈ FP := machinePairSecond_mem_FP + +theorem machineBetheFeasibilityBound_mem_FP : + machineBetheFeasibilityBound ∈ FP := by + simpa only [machineBetheFeasibilityBound] using + machineCompose_mem_FP machineBetheFeasibilityAfterBudget_mem_FP + machinePairFirst_mem_FP + +theorem machineBetheFeasibilityAfterBound_mem_FP : + machineBetheFeasibilityAfterBound ∈ FP := by + simpa only [machineBetheFeasibilityAfterBound] using + machineCompose_mem_FP machineBetheFeasibilityAfterBudget_mem_FP + machinePairSecond_mem_FP + +theorem machineBetheFeasibilityRoundingPrecision_mem_FP : + machineBetheFeasibilityRoundingPrecision ∈ FP := by + simpa only [machineBetheFeasibilityRoundingPrecision] using + machineCompose_mem_FP machineBetheFeasibilityAfterBound_mem_FP + machinePairFirst_mem_FP + +theorem machineBetheFeasibilityStaticAndInitial_mem_FP : + machineBetheFeasibilityStaticAndInitial ∈ FP := by + simpa only [machineBetheFeasibilityStaticAndInitial] using + machineCompose_mem_FP machineBetheFeasibilityAfterBound_mem_FP + machinePairSecond_mem_FP + +theorem machineBetheFeasibilityOracleStatic_mem_FP : + machineBetheFeasibilityOracleStatic ∈ FP := by + simpa only [machineBetheFeasibilityOracleStatic] using + machineCompose_mem_FP machineBetheFeasibilityStaticAndInitial_mem_FP + machinePairFirst_mem_FP + +theorem machineBetheFeasibilityInitialEllipsoid_mem_FP : + machineBetheFeasibilityInitialEllipsoid ∈ FP := by + simpa only [machineBetheFeasibilityInitialEllipsoid] using + machineCompose_mem_FP machineBetheFeasibilityStaticAndInitial_mem_FP + machinePairSecond_mem_FP + +theorem machineBetheFeasibilityStateAccepted_mem_FP : + machineBetheFeasibilityStateAccepted ∈ FP := machinePairFirst_mem_FP + +theorem machineBetheFeasibilityStateSource_mem_FP : + machineBetheFeasibilityStateSource ∈ FP := by + simpa only [machineBetheFeasibilityStateSource] using + machineCompose_mem_FP machinePairSecond_mem_FP machinePairFirst_mem_FP + +theorem machineBetheFeasibilityStateEllipsoid_mem_FP : + machineBetheFeasibilityStateEllipsoid ∈ FP := by + have htail := machineCompose_mem_FP machinePairSecond_mem_FP + machinePairSecond_mem_FP + simpa only [machineBetheFeasibilityStateEllipsoid] using + machineCompose_mem_FP htail machinePairFirst_mem_FP + +theorem machineBetheFeasibilityStateBound_mem_FP : + machineBetheFeasibilityStateBound ∈ FP := by + have htail := machineCompose_mem_FP machinePairSecond_mem_FP + machinePairSecond_mem_FP + simpa only [machineBetheFeasibilityStateBound] using + machineCompose_mem_FP htail machinePairSecond_mem_FP + +theorem machineBetheFeasibilityInit_mem_FP : + machineBetheFeasibilityInit ∈ FP := + machinePair_mem_FP (machineConst_mem_FP [false]) + (machinePair_mem_FP id_mem_FP + (machinePair_mem_FP machineBetheFeasibilityInitialEllipsoid_mem_FP + machineBetheFeasibilityBound_mem_FP)) + +theorem machineBetheFeasibilityStaticDimension_mem_FP : + machineBetheFeasibilityStaticDimension ∈ FP := by + have hstatic := machineCompose_mem_FP + machineBetheFeasibilityStateSource_mem_FP + machineBetheFeasibilityOracleStatic_mem_FP + simpa only [machineBetheFeasibilityStaticDimension] using + machineCompose_mem_FP hstatic machinePairFirst_mem_FP + +theorem machineBetheFeasibilityStaticRest_mem_FP : + machineBetheFeasibilityStaticRest ∈ FP := by + have hstatic := machineCompose_mem_FP + machineBetheFeasibilityStateSource_mem_FP + machineBetheFeasibilityOracleStatic_mem_FP + simpa only [machineBetheFeasibilityStaticRest] using + machineCompose_mem_FP hstatic machinePairSecond_mem_FP + +theorem machineBetheFeasibilityStaticOraclePrecision_mem_FP : + machineBetheFeasibilityStaticOraclePrecision ∈ FP := by + simpa only [machineBetheFeasibilityStaticOraclePrecision] using + machineCompose_mem_FP machineBetheFeasibilityStaticRest_mem_FP + machinePairFirst_mem_FP + +theorem machineBetheFeasibilityStaticAfterPrecision_mem_FP : + machineBetheFeasibilityStaticAfterPrecision ∈ FP := by + simpa only [machineBetheFeasibilityStaticAfterPrecision] using + machineCompose_mem_FP machineBetheFeasibilityStaticRest_mem_FP + machinePairSecond_mem_FP + +theorem machineBetheFeasibilityStaticTau_mem_FP : + machineBetheFeasibilityStaticTau ∈ FP := by + simpa only [machineBetheFeasibilityStaticTau] using + machineCompose_mem_FP machineBetheFeasibilityStaticAfterPrecision_mem_FP + machinePairFirst_mem_FP + +theorem machineBetheFeasibilityStaticAfterTau_mem_FP : + machineBetheFeasibilityStaticAfterTau ∈ FP := by + simpa only [machineBetheFeasibilityStaticAfterTau] using + machineCompose_mem_FP machineBetheFeasibilityStaticAfterPrecision_mem_FP + machinePairSecond_mem_FP + +theorem machineBetheFeasibilityStaticDelta_mem_FP : + machineBetheFeasibilityStaticDelta ∈ FP := by + simpa only [machineBetheFeasibilityStaticDelta] using + machineCompose_mem_FP machineBetheFeasibilityStaticAfterTau_mem_FP + machinePairFirst_mem_FP + +theorem machineBetheFeasibilityStaticAfterDelta_mem_FP : + machineBetheFeasibilityStaticAfterDelta ∈ FP := by + simpa only [machineBetheFeasibilityStaticAfterDelta] using + machineCompose_mem_FP machineBetheFeasibilityStaticAfterTau_mem_FP + machinePairSecond_mem_FP + +theorem machineBetheFeasibilityStaticUpper_mem_FP : + machineBetheFeasibilityStaticUpper ∈ FP := by + simpa only [machineBetheFeasibilityStaticUpper] using + machineCompose_mem_FP machineBetheFeasibilityStaticAfterDelta_mem_FP + machinePairFirst_mem_FP + +theorem machineBetheFeasibilityStaticMatrix_mem_FP : + machineBetheFeasibilityStaticMatrix ∈ FP := by + simpa only [machineBetheFeasibilityStaticMatrix] using + machineCompose_mem_FP machineBetheFeasibilityStaticAfterDelta_mem_FP + machinePairSecond_mem_FP + +theorem machineBetheFeasibilityOracleInput_mem_FP : + machineBetheFeasibilityOracleInput ∈ FP := + machinePair_mem_FP machineBetheFeasibilityStaticDimension_mem_FP + (machinePair_mem_FP + machineBetheFeasibilityStaticOraclePrecision_mem_FP + (machinePair_mem_FP machineBetheFeasibilityStaticTau_mem_FP + (machinePair_mem_FP machineBetheFeasibilityStaticDelta_mem_FP + (machinePair_mem_FP machineBetheFeasibilityStaticUpper_mem_FP + (machinePair_mem_FP machineBetheFeasibilityStaticMatrix_mem_FP + machineBetheFeasibilityStateEllipsoid_mem_FP))))) + +theorem machineBetheFeasibilityOracleResponse_mem_FP : + machineBetheFeasibilityOracleResponse ∈ FP := by + simpa only [machineBetheFeasibilityOracleResponse] using + machineCompose_mem_FP machineBetheFeasibilityOracleInput_mem_FP + machineBetheEpigraphOracleResponseCode_mem_FP + +theorem machineBetheFeasibilityResponseTag_mem_FP : + machineBetheFeasibilityResponseTag ∈ FP := by + have htag := machineCompose_mem_FP + machineBetheFeasibilityOracleResponse_mem_FP + machineRationalTaggedResultTag_mem_FP + simpa only [machineBetheFeasibilityResponseTag] using + machineCompose_mem_FP htag machineHeadBit_mem_FP + +theorem machineBetheFeasibilityResponsePayload_mem_FP : + machineBetheFeasibilityResponsePayload ∈ FP := by + simpa only [machineBetheFeasibilityResponsePayload] using + machineCompose_mem_FP machineBetheFeasibilityOracleResponse_mem_FP + machineRationalTaggedResultPayload_mem_FP + +theorem machineBetheFeasibilityScheduledUpdateInput_mem_FP : + machineBetheFeasibilityScheduledUpdateInput ∈ FP := by + have hp := machineCompose_mem_FP + machineBetheFeasibilityStateSource_mem_FP + machineBetheFeasibilityRoundingPrecision_mem_FP + exact machinePair_mem_FP hp + (machinePair_mem_FP machineBetheFeasibilityStateEllipsoid_mem_FP + machineBetheFeasibilityResponsePayload_mem_FP) + +theorem machineBetheFeasibilityUpdatedEllipsoidCandidate_mem_FP : + machineBetheFeasibilityUpdatedEllipsoidCandidate ∈ FP := by + simpa only [machineBetheFeasibilityUpdatedEllipsoidCandidate] using + machineCompose_mem_FP + machineBetheFeasibilityScheduledUpdateInput_mem_FP + machineScheduledRoundedEllipsoidCentralUpdateCode_mem_FP + +theorem machineBetheFeasibilityUpdatedEllipsoid_mem_FP : + machineBetheFeasibilityUpdatedEllipsoid ∈ FP := by + simpa only [machineBetheFeasibilityUpdatedEllipsoid] using + machineTake_mem_FP machineBetheFeasibilityStateBound_mem_FP + machineBetheFeasibilityUpdatedEllipsoidCandidate_mem_FP + +theorem machineBetheFeasibilityCutState_mem_FP : + machineBetheFeasibilityCutState ∈ FP := + machinePair_mem_FP (machineConst_mem_FP [false]) + (machinePair_mem_FP machineBetheFeasibilityStateSource_mem_FP + (machinePair_mem_FP machineBetheFeasibilityUpdatedEllipsoid_mem_FP + machineBetheFeasibilityStateBound_mem_FP)) + +theorem machineBetheFeasibilityAcceptState_mem_FP : + machineBetheFeasibilityAcceptState ∈ FP := + machinePair_mem_FP (machineConst_mem_FP [true]) + (machinePair_mem_FP machineBetheFeasibilityStateSource_mem_FP + (machinePair_mem_FP machineBetheFeasibilityStateEllipsoid_mem_FP + machineBetheFeasibilityStateBound_mem_FP)) + +theorem machineBetheFeasibilityStep_mem_FP : + machineBetheFeasibilityStep ∈ FP := by + have haccepted := machineCompose_mem_FP + machineBetheFeasibilityStateAccepted_mem_FP machineHeadBit_mem_FP + have hbranch := machineIfHead_mem_FP + machineBetheFeasibilityResponseTag_mem_FP + machineBetheFeasibilityCutState_mem_FP + machineBetheFeasibilityAcceptState_mem_FP + simpa only [machineBetheFeasibilityStep] using + machineIfHead_mem_FP haccepted id_mem_FP hbranch + +theorem machineBetheFeasibilityStateResultCode_mem_FP : + machineBetheFeasibilityStateResultCode ∈ FP := by + have htest := machineCompose_mem_FP + machineBetheFeasibilityStateAccepted_mem_FP machineHeadBit_mem_FP + have hcenter := machineCompose_mem_FP + machineBetheFeasibilityStateEllipsoid_mem_FP + machineRationalEllipsoidCenterWord_mem_FP + exact machineIfHead_mem_FP htest + (machinePair_mem_FP (machineConst_mem_FP [false]) hcenter) + (machinePair_mem_FP (machineConst_mem_FP [true]) + machineBetheFeasibilityStateEllipsoid_mem_FP) + +/-! ## Global state envelope and polynomial iteration -/ + +@[simp] theorem machineBetheFeasibilityStateAccepted_pack + (accepted source ellipsoid bound : List Bool) : + machineBetheFeasibilityStateAccepted + (machineBetheFeasibilityStatePack accepted source ellipsoid bound) = + accepted := by + simp [machineBetheFeasibilityStateAccepted, + machineBetheFeasibilityStatePack] + +@[simp] theorem machineBetheFeasibilityStateSource_pack + (accepted source ellipsoid bound : List Bool) : + machineBetheFeasibilityStateSource + (machineBetheFeasibilityStatePack accepted source ellipsoid bound) = + source := by + simp [machineBetheFeasibilityStateSource, + machineBetheFeasibilityStatePack] + +@[simp] theorem machineBetheFeasibilityStateEllipsoid_pack + (accepted source ellipsoid bound : List Bool) : + machineBetheFeasibilityStateEllipsoid + (machineBetheFeasibilityStatePack accepted source ellipsoid bound) = + ellipsoid := by + simp [machineBetheFeasibilityStateEllipsoid, + machineBetheFeasibilityStatePack] + +@[simp] theorem machineBetheFeasibilityStateBound_pack + (accepted source ellipsoid bound : List Bool) : + machineBetheFeasibilityStateBound + (machineBetheFeasibilityStatePack accepted source ellipsoid bound) = + bound := by + simp [machineBetheFeasibilityStateBound, + machineBetheFeasibilityStatePack] + +def MachineBetheFeasibilityStateBound + (word state : List Bool) : Prop := + state = machineBetheFeasibilityStatePack + (machineBetheFeasibilityStateAccepted state) + (machineBetheFeasibilityStateSource state) + (machineBetheFeasibilityStateEllipsoid state) + (machineBetheFeasibilityStateBound state) ∧ + (machineBetheFeasibilityStateAccepted state).length ≤ 1 ∧ + (machineBetheFeasibilityStateSource state).length ≤ word.length ∧ + (machineBetheFeasibilityStateEllipsoid state).length ≤ word.length ∧ + (machineBetheFeasibilityStateBound state).length ≤ word.length + +theorem machineBetheFeasibilityBound_length_le (word : List Bool) : + (machineBetheFeasibilityBound word).length ≤ word.length := by + exact (machinePairFirst_length_le + (machineBetheFeasibilityAfterBudget word)).trans + (machinePairSecond_length_le word) + +theorem machineBetheFeasibilityInitialEllipsoid_length_le + (word : List Bool) : + (machineBetheFeasibilityInitialEllipsoid word).length ≤ word.length := by + exact (machinePairSecond_length_le + (machineBetheFeasibilityStaticAndInitial word)).trans + ((machinePairSecond_length_le + (machineBetheFeasibilityAfterBound word)).trans + ((machinePairSecond_length_le + (machineBetheFeasibilityAfterBudget word)).trans + (machinePairSecond_length_le word))) + +theorem machineBetheFeasibilityInit_bound (word : List Bool) : + MachineBetheFeasibilityStateBound word + (machineBetheFeasibilityInit word) := by + simp only [machineBetheFeasibilityInit, + MachineBetheFeasibilityStateBound, + machineBetheFeasibilityStateAccepted_pack, + machineBetheFeasibilityStateSource_pack, + machineBetheFeasibilityStateEllipsoid_pack, + machineBetheFeasibilityStateBound_pack, List.length_singleton] + exact ⟨trivial, by simp, le_rfl, + machineBetheFeasibilityInitialEllipsoid_length_le word, + machineBetheFeasibilityBound_length_le word⟩ + +theorem machineBetheFeasibilityCutState_bound {word state : List Bool} + (hs : MachineBetheFeasibilityStateBound word state) : + MachineBetheFeasibilityStateBound word + (machineBetheFeasibilityCutState state) := by + rcases hs with ⟨hdecomp, haccepted, hsource, hellipsoid, hbound⟩ + simp only [machineBetheFeasibilityCutState, + MachineBetheFeasibilityStateBound, + machineBetheFeasibilityStateAccepted_pack, + machineBetheFeasibilityStateSource_pack, + machineBetheFeasibilityStateEllipsoid_pack, + machineBetheFeasibilityStateBound_pack, List.length_singleton] + refine ⟨trivial, by simp, hsource, ?_, hbound⟩ + exact (List.length_take_le _ _).trans hbound + +theorem machineBetheFeasibilityAcceptState_bound {word state : List Bool} + (hs : MachineBetheFeasibilityStateBound word state) : + MachineBetheFeasibilityStateBound word + (machineBetheFeasibilityAcceptState state) := by + rcases hs with ⟨hdecomp, haccepted, hsource, hellipsoid, hbound⟩ + simp only [machineBetheFeasibilityAcceptState, + MachineBetheFeasibilityStateBound, + machineBetheFeasibilityStateAccepted_pack, + machineBetheFeasibilityStateSource_pack, + machineBetheFeasibilityStateEllipsoid_pack, + machineBetheFeasibilityStateBound_pack, List.length_singleton] + exact ⟨trivial, by simp, hsource, hellipsoid, hbound⟩ + +theorem machineBetheFeasibilityStep_bound {word state : List Bool} + (hs : MachineBetheFeasibilityStateBound word state) : + MachineBetheFeasibilityStateBound word + (machineBetheFeasibilityStep state) := by + rw [machineBetheFeasibilityStep] + cases ha : machineBetheFeasibilityStateAccepted state with + | nil => + rw [machineHeadBit_nil, machineIfHead_false] + rw [machineBetheFeasibilityResponseTag] + cases hr : machineRationalTaggedResultTag + (machineBetheFeasibilityOracleResponse state) with + | nil => + rw [machineHeadBit_nil, machineIfHead_false] + exact machineBetheFeasibilityAcceptState_bound hs + | cons responseBit responseTail => + rw [machineHeadBit_cons] + cases responseBit + · rw [machineIfHead_false] + exact machineBetheFeasibilityAcceptState_bound hs + · rw [machineIfHead_true] + exact machineBetheFeasibilityCutState_bound hs + | cons acceptedBit acceptedTail => + rw [machineHeadBit_cons] + cases acceptedBit + · rw [machineIfHead_false] + rw [machineBetheFeasibilityResponseTag] + cases hr : machineRationalTaggedResultTag + (machineBetheFeasibilityOracleResponse state) with + | nil => + rw [machineHeadBit_nil, machineIfHead_false] + exact machineBetheFeasibilityAcceptState_bound hs + | cons responseBit responseTail => + rw [machineHeadBit_cons] + cases responseBit + · rw [machineIfHead_false] + exact machineBetheFeasibilityAcceptState_bound hs + · rw [machineIfHead_true] + exact machineBetheFeasibilityCutState_bound hs + · rw [machineIfHead_true] + exact hs + +theorem machineBetheFeasibilityIterate_bound (word : List Bool) : ∀ k, + MachineBetheFeasibilityStateBound word + ((machineBetheFeasibilityStep)^[k] + (machineBetheFeasibilityInit word)) := by + intro k + induction k with + | zero => exact machineBetheFeasibilityInit_bound word + | succ k ih => + rw [Function.iterate_succ_apply'] + exact machineBetheFeasibilityStep_bound ih + +def machineBetheFeasibilityWidth (word : List Bool) : List Bool := + let envelope := [false] ++ word + machineBetheFeasibilityStatePack envelope envelope envelope envelope + +theorem machineBetheFeasibilityWidth_mem_FP : + machineBetheFeasibilityWidth ∈ FP := by + have henvelope : (fun word : List Bool ↦ false :: word) ∈ FP := + by simpa only [List.singleton_append] using + machineAppend_mem_FP (machineConst_mem_FP [false]) id_mem_FP + simpa only [machineBetheFeasibilityWidth] using + machinePair_mem_FP henvelope + (machinePair_mem_FP henvelope + (machinePair_mem_FP henvelope henvelope)) + +theorem machineBetheFeasibilityIterate_length_le_width + (word : List Bool) (iterations : ℕ) + (_hiterations : iterations ≤ + (machineBetheFeasibilityBudget word).length) : + ((machineBetheFeasibilityStep)^[iterations] + (machineBetheFeasibilityInit word)).length ≤ + (machineBetheFeasibilityWidth word).length := by + rcases machineBetheFeasibilityIterate_bound word iterations with + ⟨hdecomp, haccepted, hsource, hellipsoid, hbound⟩ + rw [hdecomp] + simp only [machineBetheFeasibilityStatePack, + machineBetheFeasibilityWidth, pair_length, List.length_append, + List.length_singleton] + omega + +theorem machineBetheFeasibilityFinalState_mem_FP : + machineBetheFeasibilityFinalState ∈ FP := by + exact Cobham.iterate_mem_FP machineBetheFeasibilityStep_mem_FP + machineBetheFeasibilityInit_mem_FP machineBetheFeasibilityBudget_mem_FP + machineBetheFeasibilityWidth_mem_FP + machineBetheFeasibilityIterate_length_le_width + +theorem machineBetheFeasibilityResultCode_mem_FP : + machineBetheFeasibilityResultCode ∈ FP := by + simpa only [machineBetheFeasibilityResultCode] using + machineCompose_mem_FP machineBetheFeasibilityFinalState_mem_FP + machineBetheFeasibilityStateResultCode_mem_FP + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineBetheFeasibilitySemantics.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineBetheFeasibilitySemantics.lean new file mode 100644 index 0000000000..dd9b55ebbd --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineBetheFeasibilitySemantics.lean @@ -0,0 +1,528 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineBetheFeasibilityLoop +import Mathlib.Tactic + +/-! +# Semantics of the finite-word Bethe feasibility loop + +This file connects the finite-word iterator to the recursive rational +feasibility algorithm. The only intermediate side condition is the explicit +statement that every canonical updated ellipsoid fits the ruler carried by the +call word. A later encoding-bound theorem discharges that condition for the +public schedule. +-/ + +namespace BeyondBethe + +open Complexity + +/-! ## Canonical calls and states -/ + +def machineBetheFeasibilityCanonicalStaticWord {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (oraclePrecision : ℕ) (delta upper : RawRat) : List Bool := + pair (List.replicate m true) + (pair (List.replicate oraclePrecision true) + (pair (rawRatBinaryCode (rawRatOfRat tau)) + (pair (rawRatBinaryCode delta) + (pair (rawRatBinaryCode upper) + (rationalMatrixBinaryEncoding.encode ⟨m + 1, A⟩))))) + +def machineBetheFeasibilityCanonicalWord {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (oraclePrecision : ℕ) (delta upper : RawRat) + (roundingPrecision budget stateBound : ℕ) + (initial : RationalEllipsoidState (m * m + 1)) : List Bool := + pair (List.replicate budget true) + (pair (List.replicate stateBound true) + (pair (List.replicate roundingPrecision true) + (pair + (machineBetheFeasibilityCanonicalStaticWord + tau A oraclePrecision delta upper) + (rationalEllipsoidStateBinaryCode initial)))) + +def machineBetheFeasibilityCanonicalState {m : ℕ} + (accepted : Bool) + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (oraclePrecision : ℕ) (delta upper : RawRat) + (roundingPrecision budget stateBound : ℕ) + (initial current : RationalEllipsoidState (m * m + 1)) : List Bool := + machineBetheFeasibilityStatePack [accepted] + (machineBetheFeasibilityCanonicalWord tau A oraclePrecision delta upper + roundingPrecision budget stateBound initial) + (rationalEllipsoidStateBinaryCode current) + (List.replicate stateBound true) + +@[simp] theorem machineBetheFeasibilityBudget_encode {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (oraclePrecision : ℕ) (delta upper : RawRat) + (roundingPrecision budget stateBound : ℕ) + (initial : RationalEllipsoidState (m * m + 1)) : + machineBetheFeasibilityBudget + (machineBetheFeasibilityCanonicalWord tau A oraclePrecision + delta upper roundingPrecision budget stateBound initial) = + List.replicate budget true := by + rw [machineBetheFeasibilityBudget, + machineBetheFeasibilityCanonicalWord, machinePairFirst_pair] + +@[simp] theorem machineBetheFeasibilityBound_encode {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (oraclePrecision : ℕ) (delta upper : RawRat) + (roundingPrecision budget stateBound : ℕ) + (initial : RationalEllipsoidState (m * m + 1)) : + machineBetheFeasibilityBound + (machineBetheFeasibilityCanonicalWord tau A oraclePrecision + delta upper roundingPrecision budget stateBound initial) = + List.replicate stateBound true := by + rw [machineBetheFeasibilityBound, machineBetheFeasibilityAfterBudget, + machineBetheFeasibilityCanonicalWord, machinePairSecond_pair, + machinePairFirst_pair] + +@[simp] theorem machineBetheFeasibilityRoundingPrecision_encode {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (oraclePrecision : ℕ) (delta upper : RawRat) + (roundingPrecision budget stateBound : ℕ) + (initial : RationalEllipsoidState (m * m + 1)) : + machineBetheFeasibilityRoundingPrecision + (machineBetheFeasibilityCanonicalWord tau A oraclePrecision + delta upper roundingPrecision budget stateBound initial) = + List.replicate roundingPrecision true := by + rw [machineBetheFeasibilityRoundingPrecision, + machineBetheFeasibilityAfterBound, + machineBetheFeasibilityAfterBudget, + machineBetheFeasibilityCanonicalWord] + simp only [machinePairSecond_pair, machinePairFirst_pair] + +@[simp] theorem machineBetheFeasibilityOracleStatic_encode {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (oraclePrecision : ℕ) (delta upper : RawRat) + (roundingPrecision budget stateBound : ℕ) + (initial : RationalEllipsoidState (m * m + 1)) : + machineBetheFeasibilityOracleStatic + (machineBetheFeasibilityCanonicalWord tau A oraclePrecision + delta upper roundingPrecision budget stateBound initial) = + machineBetheFeasibilityCanonicalStaticWord + tau A oraclePrecision delta upper := by + rw [machineBetheFeasibilityOracleStatic, + machineBetheFeasibilityStaticAndInitial, + machineBetheFeasibilityAfterBound, + machineBetheFeasibilityAfterBudget, + machineBetheFeasibilityCanonicalWord] + simp only [machinePairSecond_pair, machinePairFirst_pair] + +@[simp] theorem machineBetheFeasibilityInitialEllipsoid_encode {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (oraclePrecision : ℕ) (delta upper : RawRat) + (roundingPrecision budget stateBound : ℕ) + (initial : RationalEllipsoidState (m * m + 1)) : + machineBetheFeasibilityInitialEllipsoid + (machineBetheFeasibilityCanonicalWord tau A oraclePrecision + delta upper roundingPrecision budget stateBound initial) = + rationalEllipsoidStateBinaryCode initial := by + rw [machineBetheFeasibilityInitialEllipsoid, + machineBetheFeasibilityStaticAndInitial, + machineBetheFeasibilityAfterBound, + machineBetheFeasibilityAfterBudget, + machineBetheFeasibilityCanonicalWord] + simp only [machinePairSecond_pair] + +@[simp] theorem machineBetheFeasibilityInit_encode {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (oraclePrecision : ℕ) (delta upper : RawRat) + (roundingPrecision budget stateBound : ℕ) + (initial : RationalEllipsoidState (m * m + 1)) : + machineBetheFeasibilityInit + (machineBetheFeasibilityCanonicalWord tau A oraclePrecision + delta upper roundingPrecision budget stateBound initial) = + machineBetheFeasibilityCanonicalState false tau A oraclePrecision + delta upper roundingPrecision budget stateBound initial initial := by + rw [machineBetheFeasibilityInit, + machineBetheFeasibilityInitialEllipsoid_encode, + machineBetheFeasibilityBound_encode] + rfl + +@[simp] theorem machineBetheFeasibilityStateAccepted_encode {m : ℕ} + (accepted : Bool) + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (oraclePrecision : ℕ) (delta upper : RawRat) + (roundingPrecision budget stateBound : ℕ) + (initial current : RationalEllipsoidState (m * m + 1)) : + machineBetheFeasibilityStateAccepted + (machineBetheFeasibilityCanonicalState accepted tau A oraclePrecision + delta upper roundingPrecision budget stateBound initial current) = + [accepted] := by + rw [machineBetheFeasibilityCanonicalState, + machineBetheFeasibilityStateAccepted_pack] + +@[simp] theorem machineBetheFeasibilityStateSource_encode {m : ℕ} + (accepted : Bool) + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (oraclePrecision : ℕ) (delta upper : RawRat) + (roundingPrecision budget stateBound : ℕ) + (initial current : RationalEllipsoidState (m * m + 1)) : + machineBetheFeasibilityStateSource + (machineBetheFeasibilityCanonicalState accepted tau A oraclePrecision + delta upper roundingPrecision budget stateBound initial current) = + machineBetheFeasibilityCanonicalWord tau A oraclePrecision delta upper + roundingPrecision budget stateBound initial := by + rw [machineBetheFeasibilityCanonicalState, + machineBetheFeasibilityStateSource_pack] + +@[simp] theorem machineBetheFeasibilityStateEllipsoid_encode {m : ℕ} + (accepted : Bool) + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (oraclePrecision : ℕ) (delta upper : RawRat) + (roundingPrecision budget stateBound : ℕ) + (initial current : RationalEllipsoidState (m * m + 1)) : + machineBetheFeasibilityStateEllipsoid + (machineBetheFeasibilityCanonicalState accepted tau A oraclePrecision + delta upper roundingPrecision budget stateBound initial current) = + rationalEllipsoidStateBinaryCode current := by + rw [machineBetheFeasibilityCanonicalState, + machineBetheFeasibilityStateEllipsoid_pack] + +@[simp] theorem machineBetheFeasibilityStateBound_encode {m : ℕ} + (accepted : Bool) + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (oraclePrecision : ℕ) (delta upper : RawRat) + (roundingPrecision budget stateBound : ℕ) + (initial current : RationalEllipsoidState (m * m + 1)) : + machineBetheFeasibilityStateBound + (machineBetheFeasibilityCanonicalState accepted tau A oraclePrecision + delta upper roundingPrecision budget stateBound initial current) = + List.replicate stateBound true := by + rw [machineBetheFeasibilityCanonicalState, + machineBetheFeasibilityStateBound_pack] + +@[simp] theorem machineBetheFeasibilityOracleInput_encode {m : ℕ} + (accepted : Bool) + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (oraclePrecision : ℕ) (delta upper : RawRat) + (roundingPrecision budget stateBound : ℕ) + (initial current : RationalEllipsoidState (m * m + 1)) : + machineBetheFeasibilityOracleInput + (machineBetheFeasibilityCanonicalState accepted tau A oraclePrecision + delta upper roundingPrecision budget stateBound initial current) = + machineBetheOracleCanonicalWord + tau A oraclePrecision delta upper current := by + simp only [machineBetheFeasibilityOracleInput, + machineBetheFeasibilityStaticDimension, + machineBetheFeasibilityStaticRest, + machineBetheFeasibilityStaticOraclePrecision, + machineBetheFeasibilityStaticAfterPrecision, + machineBetheFeasibilityStaticTau, + machineBetheFeasibilityStaticAfterTau, + machineBetheFeasibilityStaticDelta, + machineBetheFeasibilityStaticAfterDelta, + machineBetheFeasibilityStaticUpper, + machineBetheFeasibilityStaticMatrix, + machineBetheFeasibilityStateSource_encode, + machineBetheFeasibilityOracleStatic_encode, + machineBetheFeasibilityStateEllipsoid_encode, + machineBetheFeasibilityCanonicalStaticWord, + machineBetheOracleCanonicalWord, machinePairFirst_pair, + machinePairSecond_pair] + +@[simp] theorem machineBetheFeasibilityOracleResponse_encode {m : ℕ} + (accepted : Bool) + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (oraclePrecision : ℕ) (delta upper : RawRat) + (roundingPrecision budget stateBound : ℕ) + (initial current : RationalEllipsoidState (m * m + 1)) : + machineBetheFeasibilityOracleResponse + (machineBetheFeasibilityCanonicalState accepted tau A oraclePrecision + delta upper roundingPrecision budget stateBound initial current) = + rationalCentralOracleResponseBinaryCode + (scannedBetheBoundedEpigraphOracle + tau A oraclePrecision delta upper current) := by + rw [machineBetheFeasibilityOracleResponse, + machineBetheFeasibilityOracleInput_encode, + machineBetheEpigraphOracleResponseCode_encode] + +/-! ## Exact one-step behavior -/ + +@[simp] theorem machineBetheFeasibilityStep_accepted_encode {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (oraclePrecision : ℕ) (delta upper : RawRat) + (roundingPrecision budget stateBound : ℕ) + (initial current : RationalEllipsoidState (m * m + 1)) : + machineBetheFeasibilityStep + (machineBetheFeasibilityCanonicalState true tau A oraclePrecision + delta upper roundingPrecision budget stateBound initial current) = + machineBetheFeasibilityCanonicalState true tau A oraclePrecision + delta upper roundingPrecision budget stateBound initial current := by + rw [machineBetheFeasibilityStep] + simp only [machineBetheFeasibilityStateAccepted_encode, + machineHeadBit_cons, machineIfHead_true] + +theorem machineBetheFeasibilityResponseTag_accept_encode {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (oraclePrecision : ℕ) (delta upper : RawRat) + (roundingPrecision budget stateBound : ℕ) + (initial current : RationalEllipsoidState (m * m + 1)) + (hresponse : scannedBetheBoundedEpigraphOracle + tau A oraclePrecision delta upper current = .accept) : + machineBetheFeasibilityResponseTag + (machineBetheFeasibilityCanonicalState false tau A oraclePrecision + delta upper roundingPrecision budget stateBound initial current) = + [false] := by + rw [machineBetheFeasibilityResponseTag, + machineBetheFeasibilityOracleResponse_encode, hresponse] + rfl + +theorem machineBetheFeasibilityStep_accept_encode {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (oraclePrecision : ℕ) (delta upper : RawRat) + (roundingPrecision budget stateBound : ℕ) + (initial current : RationalEllipsoidState (m * m + 1)) + (hresponse : scannedBetheBoundedEpigraphOracle + tau A oraclePrecision delta upper current = .accept) : + machineBetheFeasibilityStep + (machineBetheFeasibilityCanonicalState false tau A oraclePrecision + delta upper roundingPrecision budget stateBound initial current) = + machineBetheFeasibilityCanonicalState true tau A oraclePrecision + delta upper roundingPrecision budget stateBound initial current := by + rw [machineBetheFeasibilityStep] + simp only [machineBetheFeasibilityStateAccepted_encode, + machineHeadBit_cons, machineIfHead_false] + rw [machineBetheFeasibilityResponseTag_accept_encode tau A + oraclePrecision delta upper roundingPrecision budget stateBound + initial current hresponse] + rw [machineIfHead_false, machineBetheFeasibilityAcceptState, + machineBetheFeasibilityStateSource_encode, + machineBetheFeasibilityStateEllipsoid_encode, + machineBetheFeasibilityStateBound_encode] + rfl + +theorem machineBetheFeasibilityResponseTag_cut_encode {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (oraclePrecision : ℕ) (delta upper : RawRat) + (roundingPrecision budget stateBound : ℕ) + (initial current : RationalEllipsoidState (m * m + 1)) + (a : Fin (m * m + 1) → ℚ) + (hresponse : scannedBetheBoundedEpigraphOracle + tau A oraclePrecision delta upper current = .cut a) : + machineBetheFeasibilityResponseTag + (machineBetheFeasibilityCanonicalState false tau A oraclePrecision + delta upper roundingPrecision budget stateBound initial current) = + [true] := by + rw [machineBetheFeasibilityResponseTag, + machineBetheFeasibilityOracleResponse_encode, hresponse] + rfl + +theorem machineBetheFeasibilityResponsePayload_cut_encode {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (oraclePrecision : ℕ) (delta upper : RawRat) + (roundingPrecision budget stateBound : ℕ) + (initial current : RationalEllipsoidState (m * m + 1)) + (a : Fin (m * m + 1) → ℚ) + (hresponse : scannedBetheBoundedEpigraphOracle + tau A oraclePrecision delta upper current = .cut a) : + machineBetheFeasibilityResponsePayload + (machineBetheFeasibilityCanonicalState false tau A oraclePrecision + delta upper roundingPrecision budget stateBound initial current) = + rationalFiniteVectorCode a := by + rw [machineBetheFeasibilityResponsePayload, + machineBetheFeasibilityOracleResponse_encode, hresponse] + rfl + +theorem machineBetheFeasibilityUpdatedCandidate_cut_encode {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (oraclePrecision : ℕ) (delta upper : RawRat) + (roundingPrecision budget stateBound : ℕ) + (initial current : RationalEllipsoidState (m * m + 1)) + (a : Fin (m * m + 1) → ℚ) + (hresponse : scannedBetheBoundedEpigraphOracle + tau A oraclePrecision delta upper current = .cut a) : + machineBetheFeasibilityUpdatedEllipsoidCandidate + (machineBetheFeasibilityCanonicalState false tau A oraclePrecision + delta upper roundingPrecision budget stateBound initial current) = + rationalEllipsoidStateBinaryCode + (scheduledRoundedEllipsoidCentralUpdate + roundingPrecision current a) := by + rw [machineBetheFeasibilityUpdatedEllipsoidCandidate, + machineBetheFeasibilityScheduledUpdateInput] + rw [machineBetheFeasibilityStateSource_encode, + machineBetheFeasibilityRoundingPrecision_encode, + machineBetheFeasibilityStateEllipsoid_encode, + machineBetheFeasibilityResponsePayload_cut_encode tau A + oraclePrecision delta upper roundingPrecision budget stateBound + initial current a hresponse] + exact machineScheduledRoundedEllipsoidCentralUpdateCode_encode + roundingPrecision current a + +theorem machineBetheFeasibilityStep_cut_encode {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (oraclePrecision : ℕ) (delta upper : RawRat) + (roundingPrecision budget stateBound : ℕ) + (initial current : RationalEllipsoidState (m * m + 1)) + (a : Fin (m * m + 1) → ℚ) + (hresponse : scannedBetheBoundedEpigraphOracle + tau A oraclePrecision delta upper current = .cut a) + (hfit : (rationalEllipsoidStateBinaryCode + (scheduledRoundedEllipsoidCentralUpdate + roundingPrecision current a)).length ≤ stateBound) : + machineBetheFeasibilityStep + (machineBetheFeasibilityCanonicalState false tau A oraclePrecision + delta upper roundingPrecision budget stateBound initial current) = + machineBetheFeasibilityCanonicalState false tau A oraclePrecision + delta upper roundingPrecision budget stateBound initial + (scheduledRoundedEllipsoidCentralUpdate + roundingPrecision current a) := by + have htag := machineBetheFeasibilityResponseTag_cut_encode tau A + oraclePrecision delta upper roundingPrecision budget stateBound + initial current a hresponse + rw [machineBetheFeasibilityStep] + rw [show machineHeadBit + (machineBetheFeasibilityStateAccepted + (machineBetheFeasibilityCanonicalState false tau A oraclePrecision + delta upper roundingPrecision budget stateBound initial current)) = + [false] by + rw [machineBetheFeasibilityStateAccepted_encode] + rfl] + rw [machineIfHead_false, htag] + rw [machineIfHead_true, machineBetheFeasibilityCutState] + rw [machineBetheFeasibilityStateSource_encode, + machineBetheFeasibilityStateBound_encode, + machineBetheFeasibilityUpdatedEllipsoid, + machineBetheFeasibilityUpdatedCandidate_cut_encode tau A + oraclePrecision delta upper roundingPrecision budget stateBound + initial current a hresponse] + rw [machineBetheFeasibilityStateBound_encode, List.length_replicate] + rw [List.take_of_length_le hfit] + rfl + +/-! ## The ruler condition and complete recursive semantics -/ + +def MachineBetheFeasibilityFits {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (oraclePrecision : ℕ) (delta upper : RawRat) + (roundingPrecision stateBound : ℕ) : + ℕ → RationalEllipsoidState (m * m + 1) → Prop + | 0, _ => True + | iterations + 1, E => + match scannedBetheBoundedEpigraphOracle + tau A oraclePrecision delta upper E with + | .accept => True + | .cut a => + (rationalEllipsoidStateBinaryCode + (scheduledRoundedEllipsoidCentralUpdate + roundingPrecision E a)).length ≤ stateBound ∧ + MachineBetheFeasibilityFits tau A oraclePrecision delta upper + roundingPrecision stateBound iterations + (scheduledRoundedEllipsoidCentralUpdate + roundingPrecision E a) + +theorem machineBetheFeasibilityIterate_accepted_encode {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (oraclePrecision : ℕ) (delta upper : RawRat) + (roundingPrecision budget stateBound iterations : ℕ) + (initial current : RationalEllipsoidState (m * m + 1)) : + (machineBetheFeasibilityStep^[iterations]) + (machineBetheFeasibilityCanonicalState true tau A oraclePrecision + delta upper roundingPrecision budget stateBound initial current) = + machineBetheFeasibilityCanonicalState true tau A oraclePrecision + delta upper roundingPrecision budget stateBound initial current := by + induction iterations with + | zero => rfl + | succ iterations ih => + rw [Function.iterate_succ_apply] + rw [machineBetheFeasibilityStep_accepted_encode] + exact ih + +theorem machineBetheFeasibilityStateResult_accepted_encode {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (oraclePrecision : ℕ) (delta upper : RawRat) + (roundingPrecision budget stateBound : ℕ) + (initial current : RationalEllipsoidState (m * m + 1)) : + machineBetheFeasibilityStateResultCode + (machineBetheFeasibilityCanonicalState true tau A oraclePrecision + delta upper roundingPrecision budget stateBound initial current) = + rationalFeasibilityResultBinaryCode (.accepted current.center) := by + simp [machineBetheFeasibilityStateResultCode, + machineBetheFeasibilityCanonicalState, + rationalFeasibilityResultBinaryCode] + +theorem machineBetheFeasibilityStateResult_exhausted_encode {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (oraclePrecision : ℕ) (delta upper : RawRat) + (roundingPrecision budget stateBound : ℕ) + (initial current : RationalEllipsoidState (m * m + 1)) : + machineBetheFeasibilityStateResultCode + (machineBetheFeasibilityCanonicalState false tau A oraclePrecision + delta upper roundingPrecision budget stateBound initial current) = + rationalFeasibilityResultBinaryCode (.exhausted current) := by + simp [machineBetheFeasibilityStateResultCode, + machineBetheFeasibilityCanonicalState, + rationalFeasibilityResultBinaryCode] + +theorem machineBetheFeasibilityIterateResult_encode {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (oraclePrecision : ℕ) (delta upper : RawRat) + (roundingPrecision budget stateBound iterations : ℕ) + (initial current : RationalEllipsoidState (m * m + 1)) + (hfit : MachineBetheFeasibilityFits tau A oraclePrecision delta upper + roundingPrecision stateBound iterations current) : + machineBetheFeasibilityStateResultCode + ((machineBetheFeasibilityStep^[iterations]) + (machineBetheFeasibilityCanonicalState false tau A oraclePrecision + delta upper roundingPrecision budget stateBound initial current)) = + rationalFeasibilityResultBinaryCode + (runFixedPrecisionRationalFeasibility roundingPrecision + (scannedBetheBoundedEpigraphOracle + tau A oraclePrecision delta upper) iterations current) := by + induction iterations generalizing current with + | zero => + simpa [runFixedPrecisionRationalFeasibility] using + machineBetheFeasibilityStateResult_exhausted_encode tau A + oraclePrecision delta upper roundingPrecision budget stateBound + initial current + | succ iterations ih => + rw [Function.iterate_succ_apply] + rw [runFixedPrecisionRationalFeasibility] + cases hresponse : scannedBetheBoundedEpigraphOracle + tau A oraclePrecision delta upper current with + | accept => + rw [machineBetheFeasibilityStep_accept_encode tau A + oraclePrecision delta upper roundingPrecision budget stateBound + initial current hresponse] + rw [machineBetheFeasibilityIterate_accepted_encode] + exact machineBetheFeasibilityStateResult_accepted_encode tau A + oraclePrecision delta upper roundingPrecision budget stateBound + initial current + | cut a => + have hfit' := hfit + simp only [MachineBetheFeasibilityFits, hresponse] at hfit' + rw [machineBetheFeasibilityStep_cut_encode tau A + oraclePrecision delta upper roundingPrecision budget stateBound + initial current a hresponse hfit'.1] + exact ih _ hfit'.2 + +theorem machineBetheFeasibilityResultCode_encode {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (oraclePrecision : ℕ) (delta upper : RawRat) + (roundingPrecision budget stateBound : ℕ) + (initial : RationalEllipsoidState (m * m + 1)) + (hfit : MachineBetheFeasibilityFits tau A oraclePrecision delta upper + roundingPrecision stateBound budget initial) : + machineBetheFeasibilityResultCode + (machineBetheFeasibilityCanonicalWord tau A oraclePrecision + delta upper roundingPrecision budget stateBound initial) = + rationalFeasibilityResultBinaryCode + (runFixedPrecisionRationalFeasibility roundingPrecision + (scannedBetheBoundedEpigraphOracle + tau A oraclePrecision delta upper) budget initial) := by + rw [machineBetheFeasibilityResultCode, + machineBetheFeasibilityFinalState, + machineBetheFeasibilityBudget_encode, + List.length_replicate, + machineBetheFeasibilityInit_encode] + exact machineBetheFeasibilityIterateResult_encode tau A oraclePrecision + delta upper roundingPrecision budget stateBound budget initial initial hfit + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineBetheFloorCutEntry.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineBetheFloorCutEntry.lean new file mode 100644 index 0000000000..e7cee43cc1 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineBetheFloorCutEntry.lean @@ -0,0 +1,387 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.BetheFloorCutFormula +import LeanPool.BeyondBethe.BeyondBethe.MachineBetheHeightCap + +/-! +# Finite-word coefficients of Bethe floor cuts + +For a queried recovered entry and a current base coordinate, this machine +returns the canonical rational code of the corresponding cut coefficient. +The four cases are a negative unit vector, a positive row, a positive column, +and the fixedValue negative-one vector. A supplied height-coordinate bit +overrides all four cases with zero. +-/ + +namespace BeyondBethe + +open Complexity + +def machineBetheFloorCutEntryDimension (word : List Bool) : List Bool := + machinePairFirst word + +def machineBetheFloorCutEntryRest (word : List Bool) : List Bool := + machinePairSecond word + +def machineBetheFloorCutEntryQueryRow (word : List Bool) : List Bool := + machinePairFirst (machineBetheFloorCutEntryRest word) + +def machineBetheFloorCutEntryQueryColumn (word : List Bool) : List Bool := + machinePairFirst (machinePairSecond (machineBetheFloorCutEntryRest word)) + +def machineBetheFloorCutEntryBaseRow (word : List Bool) : List Bool := + machinePairFirst + (machinePairSecond (machinePairSecond + (machineBetheFloorCutEntryRest word))) + +def machineBetheFloorCutEntryBaseColumn (word : List Bool) : List Bool := + machinePairFirst + (machinePairSecond (machinePairSecond (machinePairSecond + (machineBetheFloorCutEntryRest word)))) + +def machineBetheFloorCutEntryHeightBit (word : List Bool) : List Bool := + machinePairSecond + (machinePairSecond (machinePairSecond (machinePairSecond + (machineBetheFloorCutEntryRest word)))) + +def machineBetheFloorCutEntryQueryLastRowBit + (word : List Bool) : List Bool := + machineHeadBit (machineUnaryRulersEqualBit + (machineBetheFloorCutEntryQueryRow word) + (machineBetheFloorCutEntryDimension word)) + +def machineBetheFloorCutEntryQueryLastColumnBit + (word : List Bool) : List Bool := + machineHeadBit (machineUnaryRulersEqualBit + (machineBetheFloorCutEntryQueryColumn word) + (machineBetheFloorCutEntryDimension word)) + +def machineBetheFloorCutEntryBaseRowEqBit + (word : List Bool) : List Bool := + machineHeadBit (machineUnaryRulersEqualBit + (machineBetheFloorCutEntryBaseRow word) + (machineBetheFloorCutEntryQueryRow word)) + +def machineBetheFloorCutEntryBaseColumnEqBit + (word : List Bool) : List Bool := + machineHeadBit (machineUnaryRulersEqualBit + (machineBetheFloorCutEntryBaseColumn word) + (machineBetheFloorCutEntryQueryColumn word)) + +def machineBetheFloorCutEntryBothBaseEqBit + (word : List Bool) : List Bool := + machineAndBit (machineBetheFloorCutEntryBaseRowEqBit word) + (machineBetheFloorCutEntryBaseColumnEqBit word) + +def machineBetheFloorCutEntryZeroCode : List Bool := + rationalEntryBinaryCode 0 + +def machineBetheFloorCutEntryOneCode : List Bool := + rationalEntryBinaryCode 1 + +def machineBetheFloorCutEntryNegOneCode : List Bool := + rationalEntryBinaryCode (-1) + +def machineBetheFloorCutEntryBaseCode (word : List Bool) : List Bool := + machineIfHead (machineBetheFloorCutEntryQueryLastRowBit word) + (machineIfHead (machineBetheFloorCutEntryQueryLastColumnBit word) + machineBetheFloorCutEntryNegOneCode + (machineIfHead (machineBetheFloorCutEntryBaseColumnEqBit word) + machineBetheFloorCutEntryOneCode machineBetheFloorCutEntryZeroCode)) + (machineIfHead (machineBetheFloorCutEntryQueryLastColumnBit word) + (machineIfHead (machineBetheFloorCutEntryBaseRowEqBit word) + machineBetheFloorCutEntryOneCode machineBetheFloorCutEntryZeroCode) + (machineIfHead (machineBetheFloorCutEntryBothBaseEqBit word) + machineBetheFloorCutEntryNegOneCode machineBetheFloorCutEntryZeroCode)) + +def machineBetheFloorCutEntryCode (word : List Bool) : List Bool := + machineIfHead (machineHeadBit (machineBetheFloorCutEntryHeightBit word)) + machineBetheFloorCutEntryZeroCode + (machineBetheFloorCutEntryBaseCode word) + +theorem machineBetheFloorCutEntryDimension_mem_FP : + machineBetheFloorCutEntryDimension ∈ FP := machinePairFirst_mem_FP + +theorem machineBetheFloorCutEntryRest_mem_FP : + machineBetheFloorCutEntryRest ∈ FP := machinePairSecond_mem_FP + +theorem machineBetheFloorCutEntryQueryRow_mem_FP : + machineBetheFloorCutEntryQueryRow ∈ FP := by + simpa only [machineBetheFloorCutEntryQueryRow] using + machineCompose_mem_FP machineBetheFloorCutEntryRest_mem_FP + machinePairFirst_mem_FP + +theorem machineBetheFloorCutEntryQueryColumn_mem_FP : + machineBetheFloorCutEntryQueryColumn ∈ FP := by + have htail := machineCompose_mem_FP machineBetheFloorCutEntryRest_mem_FP + machinePairSecond_mem_FP + simpa only [machineBetheFloorCutEntryQueryColumn] using + machineCompose_mem_FP htail machinePairFirst_mem_FP + +theorem machineBetheFloorCutEntryBaseRow_mem_FP : + machineBetheFloorCutEntryBaseRow ∈ FP := by + have htailOne := machineCompose_mem_FP + machineBetheFloorCutEntryRest_mem_FP machinePairSecond_mem_FP + have htailTwo := machineCompose_mem_FP htailOne machinePairSecond_mem_FP + simpa only [machineBetheFloorCutEntryBaseRow] using + machineCompose_mem_FP htailTwo machinePairFirst_mem_FP + +theorem machineBetheFloorCutEntryBaseColumn_mem_FP : + machineBetheFloorCutEntryBaseColumn ∈ FP := by + have htailOne := machineCompose_mem_FP + machineBetheFloorCutEntryRest_mem_FP machinePairSecond_mem_FP + have htailTwo := machineCompose_mem_FP htailOne machinePairSecond_mem_FP + have htailThree := machineCompose_mem_FP htailTwo machinePairSecond_mem_FP + simpa only [machineBetheFloorCutEntryBaseColumn] using + machineCompose_mem_FP htailThree machinePairFirst_mem_FP + +theorem machineBetheFloorCutEntryHeightBit_mem_FP : + machineBetheFloorCutEntryHeightBit ∈ FP := by + have htailOne := machineCompose_mem_FP + machineBetheFloorCutEntryRest_mem_FP machinePairSecond_mem_FP + have htailTwo := machineCompose_mem_FP htailOne machinePairSecond_mem_FP + have htailThree := machineCompose_mem_FP htailTwo machinePairSecond_mem_FP + simpa only [machineBetheFloorCutEntryHeightBit] using + machineCompose_mem_FP htailThree machinePairSecond_mem_FP + +theorem machineBetheFloorCutEntryQueryLastRowBit_mem_FP : + machineBetheFloorCutEntryQueryLastRowBit ∈ FP := by + have heq := machineUnaryRulersEqualBit_mem_FP + machineBetheFloorCutEntryQueryRow_mem_FP + machineBetheFloorCutEntryDimension_mem_FP + simpa only [machineBetheFloorCutEntryQueryLastRowBit] using + machineCompose_mem_FP heq machineHeadBit_mem_FP + +theorem machineBetheFloorCutEntryQueryLastColumnBit_mem_FP : + machineBetheFloorCutEntryQueryLastColumnBit ∈ FP := by + have heq := machineUnaryRulersEqualBit_mem_FP + machineBetheFloorCutEntryQueryColumn_mem_FP + machineBetheFloorCutEntryDimension_mem_FP + simpa only [machineBetheFloorCutEntryQueryLastColumnBit] using + machineCompose_mem_FP heq machineHeadBit_mem_FP + +theorem machineBetheFloorCutEntryBaseRowEqBit_mem_FP : + machineBetheFloorCutEntryBaseRowEqBit ∈ FP := by + have heq := machineUnaryRulersEqualBit_mem_FP + machineBetheFloorCutEntryBaseRow_mem_FP + machineBetheFloorCutEntryQueryRow_mem_FP + simpa only [machineBetheFloorCutEntryBaseRowEqBit] using + machineCompose_mem_FP heq machineHeadBit_mem_FP + +theorem machineBetheFloorCutEntryBaseColumnEqBit_mem_FP : + machineBetheFloorCutEntryBaseColumnEqBit ∈ FP := by + have heq := machineUnaryRulersEqualBit_mem_FP + machineBetheFloorCutEntryBaseColumn_mem_FP + machineBetheFloorCutEntryQueryColumn_mem_FP + simpa only [machineBetheFloorCutEntryBaseColumnEqBit] using + machineCompose_mem_FP heq machineHeadBit_mem_FP + +theorem machineBetheFloorCutEntryBothBaseEqBit_mem_FP : + machineBetheFloorCutEntryBothBaseEqBit ∈ FP := + machineAndBit_mem_FP machineBetheFloorCutEntryBaseRowEqBit_mem_FP + machineBetheFloorCutEntryBaseColumnEqBit_mem_FP + +theorem machineBetheFloorCutEntryBaseCode_mem_FP : + machineBetheFloorCutEntryBaseCode ∈ FP := by + let hzero : (fun _ : List Bool ↦ machineBetheFloorCutEntryZeroCode) ∈ FP := + machineConst_mem_FP _ + let hone : (fun _ : List Bool ↦ machineBetheFloorCutEntryOneCode) ∈ FP := + machineConst_mem_FP _ + let hnegOne : (fun _ : List Bool ↦ machineBetheFloorCutEntryNegOneCode) ∈ FP := + machineConst_mem_FP _ + have hcolumn := machineIfHead_mem_FP + machineBetheFloorCutEntryBaseColumnEqBit_mem_FP hone hzero + have hlastRow := machineIfHead_mem_FP + machineBetheFloorCutEntryQueryLastColumnBit_mem_FP hnegOne hcolumn + have hrow := machineIfHead_mem_FP + machineBetheFloorCutEntryBaseRowEqBit_mem_FP hone hzero + have hnotUpperLeft := machineIfHead_mem_FP + machineBetheFloorCutEntryBothBaseEqBit_mem_FP hnegOne hzero + have hnotLastRow := machineIfHead_mem_FP + machineBetheFloorCutEntryQueryLastColumnBit_mem_FP hrow hnotUpperLeft + exact machineIfHead_mem_FP machineBetheFloorCutEntryQueryLastRowBit_mem_FP + hlastRow hnotLastRow + +theorem machineBetheFloorCutEntryCode_mem_FP : + machineBetheFloorCutEntryCode ∈ FP := by + have hheight := machineCompose_mem_FP + machineBetheFloorCutEntryHeightBit_mem_FP machineHeadBit_mem_FP + exact machineIfHead_mem_FP hheight + (machineConst_mem_FP machineBetheFloorCutEntryZeroCode) + machineBetheFloorCutEntryBaseCode_mem_FP + +def machineBetheFloorCutEntryCanonicalWord {m : ℕ} + (i j : Fin (m + 1)) (a b : Fin m) (isHeight : Bool) : List Bool := + pair (List.replicate m true) + (pair (List.replicate i.1 true) + (pair (List.replicate j.1 true) + (pair (List.replicate a.1 true) + (pair (List.replicate b.1 true) [isHeight])))) + +@[simp] theorem machineBetheFloorCutEntryQueryLastRowBit_encode {m : ℕ} + (i j : Fin (m + 1)) (a b : Fin m) (isHeight : Bool) : + machineBetheFloorCutEntryQueryLastRowBit + (machineBetheFloorCutEntryCanonicalWord i j a b isHeight) = + [decide (i = Fin.last m)] := by + simp only [machineBetheFloorCutEntryQueryLastRowBit, + machineBetheFloorCutEntryQueryRow, machineBetheFloorCutEntryRest, + machineBetheFloorCutEntryDimension, + machineBetheFloorCutEntryCanonicalWord, machinePairFirst_pair, + machinePairSecond_pair, machineUnaryRulersEqualBit_replicate, + machineHeadBit_cons] + by_cases hi : i = Fin.last m + · simp [hi] + · have hval : i.1 ≠ m := by + intro h + apply hi + apply Fin.ext + simpa using h + simp [hi, hval] + +@[simp] theorem machineBetheFloorCutEntryQueryLastColumnBit_encode {m : ℕ} + (i j : Fin (m + 1)) (a b : Fin m) (isHeight : Bool) : + machineBetheFloorCutEntryQueryLastColumnBit + (machineBetheFloorCutEntryCanonicalWord i j a b isHeight) = + [decide (j = Fin.last m)] := by + simp only [machineBetheFloorCutEntryQueryLastColumnBit, + machineBetheFloorCutEntryQueryColumn, machineBetheFloorCutEntryRest, + machineBetheFloorCutEntryDimension, + machineBetheFloorCutEntryCanonicalWord, machinePairFirst_pair, + machinePairSecond_pair, machineUnaryRulersEqualBit_replicate, + machineHeadBit_cons] + by_cases hj : j = Fin.last m + · simp [hj] + · have hval : j.1 ≠ m := by + intro h + apply hj + apply Fin.ext + simpa using h + simp [hj, hval] + +@[simp] theorem machineBetheFloorCutEntryBaseRowEqBit_encode {m : ℕ} + (i j : Fin (m + 1)) (a b : Fin m) (isHeight : Bool) : + machineBetheFloorCutEntryBaseRowEqBit + (machineBetheFloorCutEntryCanonicalWord i j a b isHeight) = + [decide (a.castSucc = i)] := by + simp only [machineBetheFloorCutEntryBaseRowEqBit, + machineBetheFloorCutEntryBaseRow, + machineBetheFloorCutEntryQueryRow, machineBetheFloorCutEntryRest, + machineBetheFloorCutEntryCanonicalWord, machinePairFirst_pair, + machinePairSecond_pair, machineUnaryRulersEqualBit_replicate, + machineHeadBit_cons] + by_cases hai : a.castSucc = i + · subst i + simp + · have hval : a.1 ≠ i.1 := by + intro h + apply hai + apply Fin.ext + simpa using h + simp [hai, hval] + +@[simp] theorem machineBetheFloorCutEntryBaseColumnEqBit_encode {m : ℕ} + (i j : Fin (m + 1)) (a b : Fin m) (isHeight : Bool) : + machineBetheFloorCutEntryBaseColumnEqBit + (machineBetheFloorCutEntryCanonicalWord i j a b isHeight) = + [decide (b.castSucc = j)] := by + simp only [machineBetheFloorCutEntryBaseColumnEqBit, + machineBetheFloorCutEntryBaseColumn, + machineBetheFloorCutEntryQueryColumn, machineBetheFloorCutEntryRest, + machineBetheFloorCutEntryCanonicalWord, machinePairFirst_pair, + machinePairSecond_pair, machineUnaryRulersEqualBit_replicate, + machineHeadBit_cons] + by_cases hbj : b.castSucc = j + · subst j + simp + · have hval : b.1 ≠ j.1 := by + intro h + apply hbj + apply Fin.ext + simpa using h + simp [hbj, hval] + +@[simp] theorem machineBetheFloorCutEntryHeightBit_encode {m : ℕ} + (i j : Fin (m + 1)) (a b : Fin m) (isHeight : Bool) : + machineBetheFloorCutEntryHeightBit + (machineBetheFloorCutEntryCanonicalWord i j a b isHeight) = + [isHeight] := by + simp [machineBetheFloorCutEntryHeightBit, + machineBetheFloorCutEntryRest, + machineBetheFloorCutEntryCanonicalWord] + +@[simp] theorem machineBetheFloorCutEntryBaseCode_encode {m : ℕ} + (i j : Fin (m + 1)) (a b : Fin m) : + machineBetheFloorCutEntryBaseCode + (machineBetheFloorCutEntryCanonicalWord i j a b false) = + rationalEntryBinaryCode (explicitBetheFloorCutBaseEntry i j a b) := by + refine Fin.lastCases ?_ (fun i ↦ ?_) i <;> + refine Fin.lastCases ?_ (fun j ↦ ?_) j + · simp [machineBetheFloorCutEntryBaseCode, + machineBetheFloorCutEntryBothBaseEqBit, + machineBetheFloorCutEntryNegOneCode, + machineBetheFloorCutEntryZeroCode, + machineBetheFloorCutEntryOneCode] + · by_cases hbj : b = j + · subst b + simp [machineBetheFloorCutEntryBaseCode, + machineBetheFloorCutEntryBothBaseEqBit, + machineBetheFloorCutEntryNegOneCode, + machineBetheFloorCutEntryZeroCode, + machineBetheFloorCutEntryOneCode] + · simp [machineBetheFloorCutEntryBaseCode, + machineBetheFloorCutEntryBothBaseEqBit, + machineBetheFloorCutEntryNegOneCode, + machineBetheFloorCutEntryZeroCode, + machineBetheFloorCutEntryOneCode, hbj] + · by_cases hai : a = i + · subst a + simp [machineBetheFloorCutEntryBaseCode, + machineBetheFloorCutEntryBothBaseEqBit, + machineBetheFloorCutEntryNegOneCode, + machineBetheFloorCutEntryZeroCode, + machineBetheFloorCutEntryOneCode] + · simp [machineBetheFloorCutEntryBaseCode, + machineBetheFloorCutEntryBothBaseEqBit, + machineBetheFloorCutEntryNegOneCode, + machineBetheFloorCutEntryZeroCode, + machineBetheFloorCutEntryOneCode, hai] + · by_cases hai : a = i <;> by_cases hbj : b = j + · subst a + subst b + simp [machineBetheFloorCutEntryBaseCode, + machineBetheFloorCutEntryBothBaseEqBit, + machineBetheFloorCutEntryNegOneCode, + machineBetheFloorCutEntryZeroCode, + machineBetheFloorCutEntryOneCode] + · simp [machineBetheFloorCutEntryBaseCode, + machineBetheFloorCutEntryBothBaseEqBit, + machineBetheFloorCutEntryNegOneCode, + machineBetheFloorCutEntryZeroCode, + machineBetheFloorCutEntryOneCode, hai, hbj] + · simp [machineBetheFloorCutEntryBaseCode, + machineBetheFloorCutEntryBothBaseEqBit, + machineBetheFloorCutEntryNegOneCode, + machineBetheFloorCutEntryZeroCode, + machineBetheFloorCutEntryOneCode, hai, hbj] + · simp [machineBetheFloorCutEntryBaseCode, + machineBetheFloorCutEntryBothBaseEqBit, + machineBetheFloorCutEntryNegOneCode, + machineBetheFloorCutEntryZeroCode, + machineBetheFloorCutEntryOneCode, hai, hbj] + +@[simp] theorem machineBetheFloorCutEntryCode_encode {m : ℕ} + (i j : Fin (m + 1)) (a b : Fin m) (isHeight : Bool) : + machineBetheFloorCutEntryCode + (machineBetheFloorCutEntryCanonicalWord i j a b isHeight) = + rationalEntryBinaryCode + (if isHeight then 0 else explicitBetheFloorCutBaseEntry i j a b) := by + cases isHeight + · simp [machineBetheFloorCutEntryCode] + · simp [machineBetheFloorCutEntryCode, + machineBetheFloorCutEntryZeroCode] + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineBetheFloorCutVector.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineBetheFloorCutVector.lean new file mode 100644 index 0000000000..78f421774c --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineBetheFloorCutVector.lean @@ -0,0 +1,329 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineBetheFloorCutEntry +import LeanPool.BeyondBethe.BeyondBethe.MachineUnaryGridGenerator +import LeanPool.BeyondBethe.BeyondBethe.MachineBinaryListSnoc + +/-! +# Finite-word Bethe floor-cut vectors + +The floor scan identifies a recovered matrix coordinate `(i,j)`. This file +uses the common row-major grid generator to construct all `m^2` coefficients +of its affine pullback, then appends the zero epigraph-height coefficient. +-/ + +namespace BeyondBethe + +open Complexity + +/-! ## Adapter from grid-entry inputs to floor-cut-entry inputs -/ + +def machineBetheFloorCutGridBaseRow (word : List Bool) : List Bool := + machinePairFirst word + +def machineBetheFloorCutGridRest (word : List Bool) : List Bool := + machinePairSecond word + +def machineBetheFloorCutGridBaseColumn (word : List Bool) : List Bool := + machinePairFirst (machineBetheFloorCutGridRest word) + +def machineBetheFloorCutGridPayload (word : List Bool) : List Bool := + machinePairSecond (machineBetheFloorCutGridRest word) + +def machineBetheFloorCutVectorDimension (word : List Bool) : List Bool := + machinePairFirst word + +def machineBetheFloorCutVectorRest (word : List Bool) : List Bool := + machinePairSecond word + +def machineBetheFloorCutVectorQueryRow (word : List Bool) : List Bool := + machinePairFirst (machineBetheFloorCutVectorRest word) + +def machineBetheFloorCutVectorQueryColumn (word : List Bool) : List Bool := + machinePairSecond (machineBetheFloorCutVectorRest word) + +def machineBetheFloorCutGridEntryInput (word : List Bool) : List Bool := + let payload := machineBetheFloorCutGridPayload word + pair (machineBetheFloorCutVectorDimension payload) + (pair (machineBetheFloorCutVectorQueryRow payload) + (pair (machineBetheFloorCutVectorQueryColumn payload) + (pair (machineBetheFloorCutGridBaseRow word) + (pair (machineBetheFloorCutGridBaseColumn word) [false])))) + +def machineBetheFloorCutGridEntryCode (word : List Bool) : List Bool := + machineBetheFloorCutEntryCode (machineBetheFloorCutGridEntryInput word) + +theorem machineBetheFloorCutGridBaseRow_mem_FP : + machineBetheFloorCutGridBaseRow ∈ FP := machinePairFirst_mem_FP + +theorem machineBetheFloorCutGridRest_mem_FP : + machineBetheFloorCutGridRest ∈ FP := machinePairSecond_mem_FP + +theorem machineBetheFloorCutGridBaseColumn_mem_FP : + machineBetheFloorCutGridBaseColumn ∈ FP := by + simpa only [machineBetheFloorCutGridBaseColumn] using + machineCompose_mem_FP machineBetheFloorCutGridRest_mem_FP + machinePairFirst_mem_FP + +theorem machineBetheFloorCutGridPayload_mem_FP : + machineBetheFloorCutGridPayload ∈ FP := by + simpa only [machineBetheFloorCutGridPayload] using + machineCompose_mem_FP machineBetheFloorCutGridRest_mem_FP + machinePairSecond_mem_FP + +theorem machineBetheFloorCutVectorDimension_mem_FP : + machineBetheFloorCutVectorDimension ∈ FP := machinePairFirst_mem_FP + +theorem machineBetheFloorCutVectorRest_mem_FP : + machineBetheFloorCutVectorRest ∈ FP := machinePairSecond_mem_FP + +theorem machineBetheFloorCutVectorQueryRow_mem_FP : + machineBetheFloorCutVectorQueryRow ∈ FP := by + simpa only [machineBetheFloorCutVectorQueryRow] using + machineCompose_mem_FP machineBetheFloorCutVectorRest_mem_FP + machinePairFirst_mem_FP + +theorem machineBetheFloorCutVectorQueryColumn_mem_FP : + machineBetheFloorCutVectorQueryColumn ∈ FP := by + simpa only [machineBetheFloorCutVectorQueryColumn] using + machineCompose_mem_FP machineBetheFloorCutVectorRest_mem_FP + machinePairSecond_mem_FP + +theorem machineBetheFloorCutGridEntryInput_mem_FP : + machineBetheFloorCutGridEntryInput ∈ FP := by + have hdimension := machineCompose_mem_FP + machineBetheFloorCutGridPayload_mem_FP + machineBetheFloorCutVectorDimension_mem_FP + have hqueryRow := machineCompose_mem_FP + machineBetheFloorCutGridPayload_mem_FP + machineBetheFloorCutVectorQueryRow_mem_FP + have hqueryColumn := machineCompose_mem_FP + machineBetheFloorCutGridPayload_mem_FP + machineBetheFloorCutVectorQueryColumn_mem_FP + exact machinePair_mem_FP hdimension + (machinePair_mem_FP hqueryRow + (machinePair_mem_FP hqueryColumn + (machinePair_mem_FP machineBetheFloorCutGridBaseRow_mem_FP + (machinePair_mem_FP machineBetheFloorCutGridBaseColumn_mem_FP + (machineConst_mem_FP [false]))))) + +theorem machineBetheFloorCutGridEntryCode_mem_FP : + machineBetheFloorCutGridEntryCode ∈ FP := by + simpa only [machineBetheFloorCutGridEntryCode] using + machineCompose_mem_FP machineBetheFloorCutGridEntryInput_mem_FP + machineBetheFloorCutEntryCode_mem_FP + +/-! ## Complete vector machine -/ + +def machineBetheFloorCutVectorBound (word : List Bool) : List Bool := + machineIteratedBinaryWidth 2 word + +def machineBetheFloorCutVectorGeneratorInput + (word : List Bool) : List Bool := + pair (machineBetheFloorCutVectorDimension word) + (pair (machineBetheFloorCutVectorBound word) word) + +def machineBetheFloorCutVectorBaseCode (word : List Bool) : List Bool := + machineUnaryGridGeneratorCode machineBetheFloorCutGridEntryCode + (machineBetheFloorCutVectorGeneratorInput word) + +def machineBetheFloorCutVectorSnocInput (word : List Bool) : List Bool := + pair (rationalEntryBinaryCode 0) + (machineBetheFloorCutVectorBaseCode word) + +def machineBetheFloorCutVectorCode (word : List Bool) : List Bool := + machineBinaryListSnoc (machineBetheFloorCutVectorSnocInput word) + +theorem machineBetheFloorCutVectorBound_mem_FP : + machineBetheFloorCutVectorBound ∈ FP := + machineIteratedBinaryWidth_mem_FP 2 + +theorem machineBetheFloorCutVectorGeneratorInput_mem_FP : + machineBetheFloorCutVectorGeneratorInput ∈ FP := + machinePair_mem_FP machineBetheFloorCutVectorDimension_mem_FP + (machinePair_mem_FP machineBetheFloorCutVectorBound_mem_FP id_mem_FP) + +theorem machineBetheFloorCutVectorBaseCode_mem_FP : + machineBetheFloorCutVectorBaseCode ∈ FP := by + have hgenerator := machineUnaryGridGeneratorCode_mem_FP + machineBetheFloorCutGridEntryCode_mem_FP + simpa only [machineBetheFloorCutVectorBaseCode] using + machineCompose_mem_FP machineBetheFloorCutVectorGeneratorInput_mem_FP + hgenerator + +theorem machineBetheFloorCutVectorSnocInput_mem_FP : + machineBetheFloorCutVectorSnocInput ∈ FP := + machinePair_mem_FP (machineConst_mem_FP (rationalEntryBinaryCode 0)) + machineBetheFloorCutVectorBaseCode_mem_FP + +theorem machineBetheFloorCutVectorCode_mem_FP : + machineBetheFloorCutVectorCode ∈ FP := by + simpa only [machineBetheFloorCutVectorCode] using + machineCompose_mem_FP machineBetheFloorCutVectorSnocInput_mem_FP + machineBinaryListSnoc_mem_FP + +def machineBetheFloorCutVectorCanonicalWord {m : ℕ} + (i j : Fin (m + 1)) : List Bool := + pair (List.replicate m true) + (pair (List.replicate i.1 true) (List.replicate j.1 true)) + +@[simp] theorem machineBetheFloorCutGridEntryInput_encode {m : ℕ} + (i j : Fin (m + 1)) (a b : Fin m) : + machineBetheFloorCutGridEntryInput + (pair (List.replicate a.1 true) + (pair (List.replicate b.1 true) + (machineBetheFloorCutVectorCanonicalWord i j))) = + machineBetheFloorCutEntryCanonicalWord i j a b false := by + simp [machineBetheFloorCutGridEntryInput, + machineBetheFloorCutGridPayload, machineBetheFloorCutGridRest, + machineBetheFloorCutGridBaseRow, + machineBetheFloorCutGridBaseColumn, + machineBetheFloorCutVectorDimension, + machineBetheFloorCutVectorQueryRow, + machineBetheFloorCutVectorQueryColumn, + machineBetheFloorCutVectorRest, + machineBetheFloorCutVectorCanonicalWord, + machineBetheFloorCutEntryCanonicalWord] + +@[simp] theorem machineBetheFloorCutGridEntryCode_encode {m : ℕ} + (i j : Fin (m + 1)) (a b : Fin m) : + machineBetheFloorCutGridEntryCode + (pair (List.replicate a.1 true) + (pair (List.replicate b.1 true) + (machineBetheFloorCutVectorCanonicalWord i j))) = + rationalEntryBinaryCode (explicitBetheFloorCutBaseEntry i j a b) := by + rw [machineBetheFloorCutGridEntryCode, + machineBetheFloorCutGridEntryInput_encode, + machineBetheFloorCutEntryCode_encode] + simp + +theorem betheFloorCut_entry_code_length_le {m : ℕ} + (i j : Fin (m + 1)) (a b : Fin m) : + (rationalEntryBinaryCode + (explicitBetheFloorCutBaseEntry i j a b)).length ≤ 16 := by + refine Fin.lastCases ?_ (fun i ↦ ?_) i <;> + refine Fin.lastCases ?_ (fun j ↦ ?_) j + · norm_num [rationalEntryBinaryCode, integerBinaryCode] <;> decide + · by_cases hb : b = j <;> + simp [hb, rationalEntryBinaryCode, integerBinaryCode] <;> decide + · by_cases ha : a = i <;> + simp [ha, rationalEntryBinaryCode, integerBinaryCode] <;> decide + · by_cases ha : a = i <;> by_cases hb : b = j <;> + simp [ha, hb, rationalEntryBinaryCode, integerBinaryCode] <;> decide + +theorem betheFloorCut_base_code_length_le_bound {m : ℕ} + (i j : Fin (m + 1)) : + (binaryListCode rationalEntryBinaryCode + (unaryGridValues (explicitBetheFloorCutBaseEntry i j))).length ≤ + (machineBetheFloorCutVectorBound + (machineBetheFloorCutVectorCanonicalWord i j)).length := by + let word := machineBetheFloorCutVectorCanonicalWord i j + let L := word.length + let T := L + 16 + have hmL : m ≤ L := by + simp only [L, word, machineBetheFloorCutVectorCanonicalWord, + pair_length, List.length_replicate] + omega + have heach : ∀ q ∈ + unaryGridValues (explicitBetheFloorCutBaseEntry i j), + (rationalEntryBinaryCode q).length ≤ 16 := by + intro q hq + rw [unaryGridValues] at hq + obtain ⟨k, rfl⟩ := List.mem_ofFn.mp hq + exact betheFloorCut_entry_code_length_le i j _ _ + have hsum := List.sum_le_card_nsmul + ((unaryGridValues (explicitBetheFloorCutBaseEntry i j)).map + fun q ↦ 2 * (rationalEntryBinaryCode q).length + 2) + 34 (by + intro value hvalue + rw [List.mem_map] at hvalue + obtain ⟨q, hq, rfl⟩ := hvalue + have hq' := heach q hq + omega) + have hmT : m ≤ T := hmL.trans (by simp [T]) + have hmm := Nat.mul_le_mul hmT hmT + have hbase : 16 ≤ T := by simp [T] + have hcoefficient : 34 ≤ T ^ 2 := by + have hpow := Nat.pow_le_pow_left hbase 2 + exact (by norm_num : 34 ≤ 16 ^ 2).trans hpow + have hmul := Nat.mul_le_mul hmm hcoefficient + have hcode : + (binaryListCode rationalEntryBinaryCode + (unaryGridValues (explicitBetheFloorCutBaseEntry i j))).length ≤ + T ^ 4 := by + rw [binaryListCode_length_eq_sum] + simp only [List.length_map, unaryGridValues_length, + Nat.nsmul_eq_mul] at hsum + calc + _ ≤ m * m * 34 := hsum + _ ≤ T * T * T ^ 2 := hmul + _ = T ^ 4 := by ring + rw [machineBetheFloorCutVectorBound, + machineIteratedBinaryWidth_length] + exact hcode.trans (by + simpa only [T, L, word] using + certificateExpGuardWidth_pow_lower 1 + (machineBetheFloorCutVectorCanonicalWord i j).length) + +@[simp] theorem machineBetheFloorCutVectorGeneratorInput_encode {m : ℕ} + (i j : Fin (m + 1)) : + machineBetheFloorCutVectorGeneratorInput + (machineBetheFloorCutVectorCanonicalWord i j) = + machineUnaryGridGeneratorCanonicalWord m + (machineBetheFloorCutVectorBound + (machineBetheFloorCutVectorCanonicalWord i j)) + (machineBetheFloorCutVectorCanonicalWord i j) := by + simp [machineBetheFloorCutVectorGeneratorInput, + machineBetheFloorCutVectorDimension, + machineBetheFloorCutVectorCanonicalWord, + machineUnaryGridGeneratorCanonicalWord] + +@[simp] theorem machineBetheFloorCutVectorBaseCode_encode {m : ℕ} + (i j : Fin (m + 1)) : + machineBetheFloorCutVectorBaseCode + (machineBetheFloorCutVectorCanonicalWord i j) = + binaryListCode rationalEntryBinaryCode + (unaryGridValues (explicitBetheFloorCutBaseEntry i j)) := by + rw [machineBetheFloorCutVectorBaseCode, + machineBetheFloorCutVectorGeneratorInput_encode] + exact machineUnaryGridGeneratorCode_encode_of_bound + machineBetheFloorCutGridEntryCode + (explicitBetheFloorCutBaseEntry i j) + (machineBetheFloorCutVectorBound + (machineBetheFloorCutVectorCanonicalWord i j)) + (machineBetheFloorCutVectorCanonicalWord i j) + (machineBetheFloorCutGridEntryCode_encode i j) + (betheFloorCut_base_code_length_le_bound i j) + +theorem ofFn_explicitBetheFloorCutNormal {m : ℕ} + (i j : Fin (m + 1)) : + List.ofFn (explicitBetheFloorCutNormal i j) = + unaryGridValues (explicitBetheFloorCutBaseEntry i j) ++ [0] := by + rw [List.ofFn_succ'] + simp only [explicitBetheFloorCutNormal, Fin.snoc_castSucc, + Fin.snoc_last, List.concat_eq_append, unaryGridValues] + +@[simp] theorem machineBetheFloorCutVectorCode_encode {m : ℕ} + (i j : Fin (m + 1)) : + machineBetheFloorCutVectorCode + (machineBetheFloorCutVectorCanonicalWord i j) = + rationalFiniteVectorCode (explicitBetheFloorCutNormal i j) := by + rw [machineBetheFloorCutVectorCode, + machineBetheFloorCutVectorSnocInput, + machineBetheFloorCutVectorBaseCode_encode, + machineBinaryListSnoc_encode, + rationalFiniteVectorCode, ofFn_explicitBetheFloorCutNormal] + +@[simp] theorem machineBetheFloorCutVectorCode_encode_oracleNormal {m : ℕ} + (i j : Fin (m + 1)) : + machineBetheFloorCutVectorCode + (machineBetheFloorCutVectorCanonicalWord i j) = + rationalFiniteVectorCode (betheFloorCutNormal i j) := by + rw [machineBetheFloorCutVectorCode_encode, + explicitBetheFloorCutNormal_eq] + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineBetheFloorScan.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineBetheFloorScan.lean new file mode 100644 index 0000000000..1fa11809b8 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineBetheFloorScan.lean @@ -0,0 +1,1485 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineBetheFloorTest +import LeanPool.BeyondBethe.BeyondBethe.MachineBoundedUnary + +/-! +# Finite-word row-major scan of all Bethe floor constraints + +The scan keeps unary row and column counters, a one-bit found flag, a one-bit +done flag, and the immutable input payload. It examines the recovered +`(m+1)`-by-`(m+1)` matrix in row-major order and freezes at the first strict +floor violation. Its iteration ruler is constructed, in polynomial time, +as exactly `(m+1)^2` unary bits on canonical inputs. +-/ + +namespace BeyondBethe + +open Complexity + +/-! ## Input and state layout -/ + +def machineBetheFloorScanDimension (word : List Bool) : List Bool := + machinePairFirst word + +def machineBetheFloorScanRest (word : List Bool) : List Bool := + machinePairSecond word + +def machineBetheFloorScanThreshold (word : List Bool) : List Bool := + machinePairFirst (machineBetheFloorScanRest word) + +def machineBetheFloorScanVector (word : List Bool) : List Bool := + machinePairSecond (machineBetheFloorScanRest word) + +def machineBetheFloorScanPack (row column found done payload : List Bool) : + List Bool := + pair row (pair column (pair found (pair done payload))) + +def machineBetheFloorScanRow (state : List Bool) : List Bool := + machinePairFirst state + +def machineBetheFloorScanColumn (state : List Bool) : List Bool := + machinePairFirst (machinePairSecond state) + +def machineBetheFloorScanFound (state : List Bool) : List Bool := + machinePairFirst (machinePairSecond (machinePairSecond state)) + +def machineBetheFloorScanDone (state : List Bool) : List Bool := + machinePairFirst + (machinePairSecond (machinePairSecond (machinePairSecond state))) + +def machineBetheFloorScanPayload (state : List Bool) : List Bool := + machinePairSecond + (machinePairSecond (machinePairSecond (machinePairSecond state))) + +def machineBetheFloorScanStateDimension (state : List Bool) : List Bool := + machineBetheFloorScanDimension (machineBetheFloorScanPayload state) + +def machineBetheFloorScanStateThreshold (state : List Bool) : List Bool := + machineBetheFloorScanThreshold (machineBetheFloorScanPayload state) + +def machineBetheFloorScanStateVector (state : List Bool) : List Bool := + machineBetheFloorScanVector (machineBetheFloorScanPayload state) + +def machineBetheFloorScanLastRowBit (state : List Bool) : List Bool := + machineUnaryRulersEqualBit (machineBetheFloorScanRow state) + (machineBetheFloorScanStateDimension state) + +def machineBetheFloorScanLastColumnBit (state : List Bool) : List Bool := + machineUnaryRulersEqualBit (machineBetheFloorScanColumn state) + (machineBetheFloorScanStateDimension state) + +def machineBetheFloorScanEntryWord (state : List Bool) : List Bool := + pair (machineBetheFloorScanStateDimension state) + (pair (machineBetheFloorScanRow state) + (pair (machineBetheFloorScanColumn state) + (machineBetheFloorScanStateVector state))) + +def machineBetheFloorScanTestWord (state : List Bool) : List Bool := + pair (machineBetheFloorScanStateThreshold state) + (machineBetheFloorScanEntryWord state) + +def machineBetheFloorScanViolationBit (state : List Bool) : List Bool := + machineBetheFloorViolationBit (machineBetheFloorScanTestWord state) + +def machineBetheFloorScanNextRow (state : List Bool) : List Bool := + machineBetheFloorScanRow state ++ [true] + +def machineBetheFloorScanNextColumn (state : List Bool) : List Bool := + machineBetheFloorScanColumn state ++ [true] + +def machineBetheFloorScanMarkFound (state : List Bool) : List Bool := + machineBetheFloorScanPack (machineBetheFloorScanRow state) + (machineBetheFloorScanColumn state) [true] + (machineBetheFloorScanDone state) + (machineBetheFloorScanPayload state) + +def machineBetheFloorScanFinish (state : List Bool) : List Bool := + machineBetheFloorScanPack (machineBetheFloorScanRow state) + (machineBetheFloorScanColumn state) + (machineBetheFloorScanFound state) [true] + (machineBetheFloorScanPayload state) + +def machineBetheFloorScanAdvanceRow (state : List Bool) : List Bool := + machineBetheFloorScanPack (machineBetheFloorScanNextRow state) [] + (machineBetheFloorScanFound state) (machineBetheFloorScanDone state) + (machineBetheFloorScanPayload state) + +def machineBetheFloorScanAdvanceColumn (state : List Bool) : List Bool := + machineBetheFloorScanPack (machineBetheFloorScanRow state) + (machineBetheFloorScanNextColumn state) + (machineBetheFloorScanFound state) (machineBetheFloorScanDone state) + (machineBetheFloorScanPayload state) + +def machineBetheFloorScanAdvance (state : List Bool) : List Bool := + machineIfHead (machineHeadBit (machineBetheFloorScanLastColumnBit state)) + (machineIfHead (machineHeadBit (machineBetheFloorScanLastRowBit state)) + (machineBetheFloorScanFinish state) + (machineBetheFloorScanAdvanceRow state)) + (machineBetheFloorScanAdvanceColumn state) + +def machineBetheFloorScanProcess (state : List Bool) : List Bool := + machineIfHead (machineHeadBit (machineBetheFloorScanViolationBit state)) + (machineBetheFloorScanMarkFound state) + (machineBetheFloorScanAdvance state) + +def machineBetheFloorScanStep (state : List Bool) : List Bool := + machineIfHead (machineHeadBit (machineBetheFloorScanFound state)) state + (machineIfHead (machineHeadBit (machineBetheFloorScanDone state)) state + (machineBetheFloorScanProcess state)) + +def machineBetheFloorScanInit (word : List Bool) : List Bool := + machineBetheFloorScanPack [] [] [false] [false] word + +/-! ## Exact polynomial iteration ruler -/ + +def machineBetheFloorScanDimensionBits (word : List Bool) : List Bool := + machineLengthBits (machineBetheFloorScanDimension word) + +def machineBetheFloorScanOrderBits (word : List Bool) : List Bool := + machineBinaryAddBits + (pair (machineBetheFloorScanDimensionBits word) [true]) + +def machineBetheFloorScanWorkBits (word : List Bool) : List Bool := + machineBinaryMulBits + (pair (machineBetheFloorScanOrderBits word) + (machineBetheFloorScanOrderBits word)) + +def machineBetheFloorScanGuard (word : List Bool) : List Bool := + machineBinaryMulWidth word + +def machineBetheFloorScanRuler (word : List Bool) : List Bool := + machineBoundedUnary + (pair (machineBetheFloorScanGuard word) + (machineBetheFloorScanWorkBits word)) + +def machineBetheFloorScanStateEnvelope (word : List Bool) : List Bool := + machineBinaryMulWidth (machineBinaryMulWidth word) + +def machineBetheFloorScanWidth (word : List Bool) : List Bool := + let bound := machineBetheFloorScanStateEnvelope word + machineBetheFloorScanPack bound bound bound bound bound + +def machineBetheFloorScanFinalState (word : List Bool) : List Bool := + (machineBetheFloorScanStep)^[(machineBetheFloorScanRuler word).length] + (machineBetheFloorScanInit word) + +/-- The public result is a found bit followed by the unary row and column of +the first violation. When the bit is false the two counters are ignored. -/ +def machineBetheFloorScanResultCode (word : List Bool) : List Bool := + pair (machineBetheFloorScanFound (machineBetheFloorScanFinalState word)) + (pair (machineBetheFloorScanRow (machineBetheFloorScanFinalState word)) + (machineBetheFloorScanColumn + (machineBetheFloorScanFinalState word))) + +/-! ## Polynomial-time closure -/ + +theorem machineBetheFloorScanDimension_mem_FP : + machineBetheFloorScanDimension ∈ FP := machinePairFirst_mem_FP + +theorem machineBetheFloorScanRest_mem_FP : + machineBetheFloorScanRest ∈ FP := machinePairSecond_mem_FP + +theorem machineBetheFloorScanThreshold_mem_FP : + machineBetheFloorScanThreshold ∈ FP := by + simpa only [machineBetheFloorScanThreshold] using + machineCompose_mem_FP machineBetheFloorScanRest_mem_FP + machinePairFirst_mem_FP + +theorem machineBetheFloorScanVector_mem_FP : + machineBetheFloorScanVector ∈ FP := by + simpa only [machineBetheFloorScanVector] using + machineCompose_mem_FP machineBetheFloorScanRest_mem_FP + machinePairSecond_mem_FP + +theorem machineBetheFloorScanRow_mem_FP : + machineBetheFloorScanRow ∈ FP := machinePairFirst_mem_FP + +theorem machineBetheFloorScanColumn_mem_FP : + machineBetheFloorScanColumn ∈ FP := by + simpa only [machineBetheFloorScanColumn] using + machineCompose_mem_FP machinePairSecond_mem_FP machinePairFirst_mem_FP + +theorem machineBetheFloorScanFound_mem_FP : + machineBetheFloorScanFound ∈ FP := by + have htail := machineCompose_mem_FP machinePairSecond_mem_FP + machinePairSecond_mem_FP + simpa only [machineBetheFloorScanFound] using + machineCompose_mem_FP htail machinePairFirst_mem_FP + +theorem machineBetheFloorScanDone_mem_FP : + machineBetheFloorScanDone ∈ FP := by + have htailTwo := machineCompose_mem_FP machinePairSecond_mem_FP + machinePairSecond_mem_FP + have htailThree := machineCompose_mem_FP htailTwo machinePairSecond_mem_FP + simpa only [machineBetheFloorScanDone] using + machineCompose_mem_FP htailThree machinePairFirst_mem_FP + +theorem machineBetheFloorScanPayload_mem_FP : + machineBetheFloorScanPayload ∈ FP := by + have htailTwo := machineCompose_mem_FP machinePairSecond_mem_FP + machinePairSecond_mem_FP + have htailThree := machineCompose_mem_FP htailTwo machinePairSecond_mem_FP + simpa only [machineBetheFloorScanPayload] using + machineCompose_mem_FP htailThree machinePairSecond_mem_FP + +theorem machineBetheFloorScanStateDimension_mem_FP : + machineBetheFloorScanStateDimension ∈ FP := by + simpa only [machineBetheFloorScanStateDimension] using + machineCompose_mem_FP machineBetheFloorScanPayload_mem_FP + machineBetheFloorScanDimension_mem_FP + +theorem machineBetheFloorScanStateThreshold_mem_FP : + machineBetheFloorScanStateThreshold ∈ FP := by + simpa only [machineBetheFloorScanStateThreshold] using + machineCompose_mem_FP machineBetheFloorScanPayload_mem_FP + machineBetheFloorScanThreshold_mem_FP + +theorem machineBetheFloorScanStateVector_mem_FP : + machineBetheFloorScanStateVector ∈ FP := by + simpa only [machineBetheFloorScanStateVector] using + machineCompose_mem_FP machineBetheFloorScanPayload_mem_FP + machineBetheFloorScanVector_mem_FP + +theorem machineBetheFloorScanLastRowBit_mem_FP : + machineBetheFloorScanLastRowBit ∈ FP := + machineUnaryRulersEqualBit_mem_FP machineBetheFloorScanRow_mem_FP + machineBetheFloorScanStateDimension_mem_FP + +theorem machineBetheFloorScanLastColumnBit_mem_FP : + machineBetheFloorScanLastColumnBit ∈ FP := + machineUnaryRulersEqualBit_mem_FP machineBetheFloorScanColumn_mem_FP + machineBetheFloorScanStateDimension_mem_FP + +theorem machineBetheFloorScanEntryWord_mem_FP : + machineBetheFloorScanEntryWord ∈ FP := + machinePair_mem_FP machineBetheFloorScanStateDimension_mem_FP + (machinePair_mem_FP machineBetheFloorScanRow_mem_FP + (machinePair_mem_FP machineBetheFloorScanColumn_mem_FP + machineBetheFloorScanStateVector_mem_FP)) + +theorem machineBetheFloorScanTestWord_mem_FP : + machineBetheFloorScanTestWord ∈ FP := + machinePair_mem_FP machineBetheFloorScanStateThreshold_mem_FP + machineBetheFloorScanEntryWord_mem_FP + +theorem machineBetheFloorScanViolationBit_mem_FP : + machineBetheFloorScanViolationBit ∈ FP := by + simpa only [machineBetheFloorScanViolationBit] using + machineCompose_mem_FP machineBetheFloorScanTestWord_mem_FP + machineBetheFloorViolationBit_mem_FP + +theorem machineBetheFloorScanNextRow_mem_FP : + machineBetheFloorScanNextRow ∈ FP := + machineAppend_mem_FP machineBetheFloorScanRow_mem_FP + (machineConst_mem_FP [true]) + +theorem machineBetheFloorScanNextColumn_mem_FP : + machineBetheFloorScanNextColumn ∈ FP := + machineAppend_mem_FP machineBetheFloorScanColumn_mem_FP + (machineConst_mem_FP [true]) + +theorem machineBetheFloorScanMarkFound_mem_FP : + machineBetheFloorScanMarkFound ∈ FP := + machinePair_mem_FP machineBetheFloorScanRow_mem_FP + (machinePair_mem_FP machineBetheFloorScanColumn_mem_FP + (machinePair_mem_FP (machineConst_mem_FP [true]) + (machinePair_mem_FP machineBetheFloorScanDone_mem_FP + machineBetheFloorScanPayload_mem_FP))) + +theorem machineBetheFloorScanFinish_mem_FP : + machineBetheFloorScanFinish ∈ FP := + machinePair_mem_FP machineBetheFloorScanRow_mem_FP + (machinePair_mem_FP machineBetheFloorScanColumn_mem_FP + (machinePair_mem_FP machineBetheFloorScanFound_mem_FP + (machinePair_mem_FP (machineConst_mem_FP [true]) + machineBetheFloorScanPayload_mem_FP))) + +theorem machineBetheFloorScanAdvanceRow_mem_FP : + machineBetheFloorScanAdvanceRow ∈ FP := + machinePair_mem_FP machineBetheFloorScanNextRow_mem_FP + (machinePair_mem_FP (machineConst_mem_FP []) + (machinePair_mem_FP machineBetheFloorScanFound_mem_FP + (machinePair_mem_FP machineBetheFloorScanDone_mem_FP + machineBetheFloorScanPayload_mem_FP))) + +theorem machineBetheFloorScanAdvanceColumn_mem_FP : + machineBetheFloorScanAdvanceColumn ∈ FP := + machinePair_mem_FP machineBetheFloorScanRow_mem_FP + (machinePair_mem_FP machineBetheFloorScanNextColumn_mem_FP + (machinePair_mem_FP machineBetheFloorScanFound_mem_FP + (machinePair_mem_FP machineBetheFloorScanDone_mem_FP + machineBetheFloorScanPayload_mem_FP))) + +theorem machineBetheFloorScanAdvance_mem_FP : + machineBetheFloorScanAdvance ∈ FP := by + have hlastRowHead := machineCompose_mem_FP + machineBetheFloorScanLastRowBit_mem_FP machineHeadBit_mem_FP + have hlastColumnHead := machineCompose_mem_FP + machineBetheFloorScanLastColumnBit_mem_FP machineHeadBit_mem_FP + have hlast := machineIfHead_mem_FP + hlastRowHead + machineBetheFloorScanFinish_mem_FP + machineBetheFloorScanAdvanceRow_mem_FP + exact machineIfHead_mem_FP hlastColumnHead + hlast machineBetheFloorScanAdvanceColumn_mem_FP + +theorem machineBetheFloorScanProcess_mem_FP : + machineBetheFloorScanProcess ∈ FP := by + have hhead := machineCompose_mem_FP + machineBetheFloorScanViolationBit_mem_FP machineHeadBit_mem_FP + exact machineIfHead_mem_FP hhead machineBetheFloorScanMarkFound_mem_FP + machineBetheFloorScanAdvance_mem_FP + +theorem machineBetheFloorScanStep_mem_FP : + machineBetheFloorScanStep ∈ FP := by + have hfoundHead := machineCompose_mem_FP + machineBetheFloorScanFound_mem_FP machineHeadBit_mem_FP + have hdoneHead := machineCompose_mem_FP + machineBetheFloorScanDone_mem_FP machineHeadBit_mem_FP + have hnotFound := machineIfHead_mem_FP + hdoneHead id_mem_FP + machineBetheFloorScanProcess_mem_FP + exact machineIfHead_mem_FP hfoundHead id_mem_FP + hnotFound + +theorem machineBetheFloorScanInit_mem_FP : + machineBetheFloorScanInit ∈ FP := + machinePair_mem_FP (machineConst_mem_FP []) + (machinePair_mem_FP (machineConst_mem_FP []) + (machinePair_mem_FP (machineConst_mem_FP [false]) + (machinePair_mem_FP (machineConst_mem_FP [false]) id_mem_FP))) + +theorem machineBetheFloorScanDimensionBits_mem_FP : + machineBetheFloorScanDimensionBits ∈ FP := by + simpa only [machineBetheFloorScanDimensionBits] using + machineCompose_mem_FP machineBetheFloorScanDimension_mem_FP + machineLengthBits_mem_FP + +theorem machineBetheFloorScanOrderBits_mem_FP : + machineBetheFloorScanOrderBits ∈ FP := by + have hinput := machinePair_mem_FP + machineBetheFloorScanDimensionBits_mem_FP + (machineConst_mem_FP [true]) + simpa only [machineBetheFloorScanOrderBits] using + machineCompose_mem_FP hinput machineBinaryAddBits_mem_FP + +theorem machineBetheFloorScanWorkBits_mem_FP : + machineBetheFloorScanWorkBits ∈ FP := by + have hinput := machinePair_mem_FP machineBetheFloorScanOrderBits_mem_FP + machineBetheFloorScanOrderBits_mem_FP + simpa only [machineBetheFloorScanWorkBits] using + machineCompose_mem_FP hinput machineBinaryMulBits_mem_FP + +theorem machineBetheFloorScanGuard_mem_FP : + machineBetheFloorScanGuard ∈ FP := machineBinaryMulWidth_mem_FP + +theorem machineBetheFloorScanRuler_mem_FP : + machineBetheFloorScanRuler ∈ FP := by + have hinput := machinePair_mem_FP machineBetheFloorScanGuard_mem_FP + machineBetheFloorScanWorkBits_mem_FP + simpa only [machineBetheFloorScanRuler] using + machineCompose_mem_FP hinput machineBoundedUnary_mem_FP + +theorem machineBetheFloorScanStateEnvelope_mem_FP : + machineBetheFloorScanStateEnvelope ∈ FP := by + simpa only [machineBetheFloorScanStateEnvelope] using + machineCompose_mem_FP machineBinaryMulWidth_mem_FP + machineBinaryMulWidth_mem_FP + +theorem machineBetheFloorScanWidth_mem_FP : + machineBetheFloorScanWidth ∈ FP := by + have hbound := machineBetheFloorScanStateEnvelope_mem_FP + exact machinePair_mem_FP hbound + (machinePair_mem_FP hbound + (machinePair_mem_FP hbound (machinePair_mem_FP hbound hbound))) + +/-! ## A global state envelope for the Cobham iteration -/ + +@[simp] theorem machineBetheFloorScanRow_pack + (row column found done payload) : + machineBetheFloorScanRow + (machineBetheFloorScanPack row column found done payload) = row := by + simp [machineBetheFloorScanRow, machineBetheFloorScanPack] + +@[simp] theorem machineBetheFloorScanColumn_pack + (row column found done payload) : + machineBetheFloorScanColumn + (machineBetheFloorScanPack row column found done payload) = column := by + simp [machineBetheFloorScanColumn, machineBetheFloorScanPack] + +@[simp] theorem machineBetheFloorScanFound_pack + (row column found done payload) : + machineBetheFloorScanFound + (machineBetheFloorScanPack row column found done payload) = found := by + simp [machineBetheFloorScanFound, machineBetheFloorScanPack] + +@[simp] theorem machineBetheFloorScanDone_pack + (row column found done payload) : + machineBetheFloorScanDone + (machineBetheFloorScanPack row column found done payload) = done := by + simp [machineBetheFloorScanDone, machineBetheFloorScanPack] + +@[simp] theorem machineBetheFloorScanPayload_pack + (row column found done payload) : + machineBetheFloorScanPayload + (machineBetheFloorScanPack row column found done payload) = payload := by + simp [machineBetheFloorScanPayload, machineBetheFloorScanPack] + +def MachineBetheFloorScanStateBound + (word : List Bool) (iterations : ℕ) (state : List Bool) : Prop := + state = machineBetheFloorScanPack + (machineBetheFloorScanRow state) + (machineBetheFloorScanColumn state) + (machineBetheFloorScanFound state) + (machineBetheFloorScanDone state) + (machineBetheFloorScanPayload state) ∧ + (machineBetheFloorScanRow state).length ≤ word.length + iterations ∧ + (machineBetheFloorScanColumn state).length ≤ word.length + iterations ∧ + (machineBetheFloorScanFound state).length ≤ 1 ∧ + (machineBetheFloorScanDone state).length ≤ 1 ∧ + (machineBetheFloorScanPayload state).length ≤ word.length + +theorem machineBetheFloorScanInit_bound (word : List Bool) : + MachineBetheFloorScanStateBound word 0 + (machineBetheFloorScanInit word) := by + simp [MachineBetheFloorScanStateBound, machineBetheFloorScanInit] + +@[simp] theorem machineIfHead_nil_floorScan + (whenTrue whenFalse : List Bool) : + machineIfHead [] whenTrue whenFalse = [] := by + simp [machineIfHead, Cobham.selectHead] + +theorem machineBetheFloorScanMarkFound_bound {word state : List Bool} + {iterations : ℕ} + (hs : MachineBetheFloorScanStateBound word iterations state) : + MachineBetheFloorScanStateBound word (iterations + 1) + (machineBetheFloorScanMarkFound state) := by + rcases hs with ⟨hdecomp, hrow, hcolumn, hfound, hdone, hpayload⟩ + simp only [machineBetheFloorScanMarkFound, + MachineBetheFloorScanStateBound, + machineBetheFloorScanRow_pack, machineBetheFloorScanColumn_pack, + machineBetheFloorScanFound_pack, machineBetheFloorScanDone_pack, + machineBetheFloorScanPayload_pack, List.length_singleton] + exact ⟨trivial, hrow.trans (by omega), hcolumn.trans (by omega), + by simp, hdone, hpayload⟩ + +theorem machineBetheFloorScanFinish_bound {word state : List Bool} + {iterations : ℕ} + (hs : MachineBetheFloorScanStateBound word iterations state) : + MachineBetheFloorScanStateBound word (iterations + 1) + (machineBetheFloorScanFinish state) := by + rcases hs with ⟨hdecomp, hrow, hcolumn, hfound, hdone, hpayload⟩ + simp only [machineBetheFloorScanFinish, + MachineBetheFloorScanStateBound, + machineBetheFloorScanRow_pack, machineBetheFloorScanColumn_pack, + machineBetheFloorScanFound_pack, machineBetheFloorScanDone_pack, + machineBetheFloorScanPayload_pack, List.length_singleton] + exact ⟨trivial, hrow.trans (by omega), hcolumn.trans (by omega), + hfound, by simp, hpayload⟩ + +theorem machineBetheFloorScanAdvanceRow_bound {word state : List Bool} + {iterations : ℕ} + (hs : MachineBetheFloorScanStateBound word iterations state) : + MachineBetheFloorScanStateBound word (iterations + 1) + (machineBetheFloorScanAdvanceRow state) := by + rcases hs with ⟨hdecomp, hrow, hcolumn, hfound, hdone, hpayload⟩ + simp only [machineBetheFloorScanAdvanceRow, + MachineBetheFloorScanStateBound, + machineBetheFloorScanRow_pack, machineBetheFloorScanColumn_pack, + machineBetheFloorScanFound_pack, machineBetheFloorScanDone_pack, + machineBetheFloorScanPayload_pack, machineBetheFloorScanNextRow, + List.length_append, List.length_singleton, List.length_nil] + exact ⟨trivial, by omega, by omega, hfound, hdone, hpayload⟩ + +theorem machineBetheFloorScanAdvanceColumn_bound {word state : List Bool} + {iterations : ℕ} + (hs : MachineBetheFloorScanStateBound word iterations state) : + MachineBetheFloorScanStateBound word (iterations + 1) + (machineBetheFloorScanAdvanceColumn state) := by + rcases hs with ⟨hdecomp, hrow, hcolumn, hfound, hdone, hpayload⟩ + simp only [machineBetheFloorScanAdvanceColumn, + MachineBetheFloorScanStateBound, + machineBetheFloorScanRow_pack, machineBetheFloorScanColumn_pack, + machineBetheFloorScanFound_pack, machineBetheFloorScanDone_pack, + machineBetheFloorScanPayload_pack, machineBetheFloorScanNextColumn, + List.length_append, List.length_singleton] + exact ⟨trivial, hrow.trans (by omega), by omega, hfound, hdone, hpayload⟩ + +theorem machineBetheFloorScanAdvance_bound {word state : List Bool} + {iterations : ℕ} + (hs : MachineBetheFloorScanStateBound word iterations state) : + MachineBetheFloorScanStateBound word (iterations + 1) + (machineBetheFloorScanAdvance state) := by + rw [machineBetheFloorScanAdvance] + cases hc : machineBetheFloorScanLastColumnBit state with + | nil => + rw [machineHeadBit_nil, machineIfHead_false] + exact machineBetheFloorScanAdvanceColumn_bound hs + | cons columnBit columnTail => + rw [machineHeadBit_cons] + cases columnBit + · rw [machineIfHead_false] + exact machineBetheFloorScanAdvanceColumn_bound hs + · rw [machineIfHead_true] + cases hr : machineBetheFloorScanLastRowBit state with + | nil => + rw [machineHeadBit_nil, machineIfHead_false] + exact machineBetheFloorScanAdvanceRow_bound hs + | cons rowBit rowTail => + rw [machineHeadBit_cons] + cases rowBit + · rw [machineIfHead_false] + exact machineBetheFloorScanAdvanceRow_bound hs + · rw [machineIfHead_true] + exact machineBetheFloorScanFinish_bound hs + +theorem machineBetheFloorScanProcess_bound {word state : List Bool} + {iterations : ℕ} + (hs : MachineBetheFloorScanStateBound word iterations state) : + MachineBetheFloorScanStateBound word (iterations + 1) + (machineBetheFloorScanProcess state) := by + rw [machineBetheFloorScanProcess] + cases hv : machineBetheFloorScanViolationBit state with + | nil => + rw [machineHeadBit_nil, machineIfHead_false] + exact machineBetheFloorScanAdvance_bound hs + | cons violationBit violationTail => + rw [machineHeadBit_cons] + cases violationBit + · rw [machineIfHead_false] + exact machineBetheFloorScanAdvance_bound hs + · rw [machineIfHead_true] + exact machineBetheFloorScanMarkFound_bound hs + +theorem machineBetheFloorScanStep_bound {word state : List Bool} + {iterations : ℕ} + (hs : MachineBetheFloorScanStateBound word iterations state) : + MachineBetheFloorScanStateBound word (iterations + 1) + (machineBetheFloorScanStep state) := by + rw [machineBetheFloorScanStep] + cases hf : machineBetheFloorScanFound state with + | nil => + rw [machineHeadBit_nil, machineIfHead_false] + cases hd : machineBetheFloorScanDone state with + | nil => + rw [machineHeadBit_nil, machineIfHead_false] + exact machineBetheFloorScanProcess_bound hs + | cons doneBit doneTail => + rw [machineHeadBit_cons] + cases doneBit + · rw [machineIfHead_false] + exact machineBetheFloorScanProcess_bound hs + · rw [machineIfHead_true] + rcases hs with ⟨hdecomp, hrow, hcolumn, hfound, hdone, hpayload⟩ + exact ⟨hdecomp, hrow.trans (by omega), + hcolumn.trans (by omega), hfound, hdone, hpayload⟩ + | cons foundBit foundTail => + rw [machineHeadBit_cons] + cases foundBit + · rw [machineIfHead_false] + cases hd : machineBetheFloorScanDone state with + | nil => + rw [machineHeadBit_nil, machineIfHead_false] + exact machineBetheFloorScanProcess_bound hs + | cons doneBit doneTail => + rw [machineHeadBit_cons] + cases doneBit + · rw [machineIfHead_false] + exact machineBetheFloorScanProcess_bound hs + · rw [machineIfHead_true] + rcases hs with + ⟨hdecomp, hrow, hcolumn, hfound, hdone, hpayload⟩ + exact ⟨hdecomp, hrow.trans (by omega), + hcolumn.trans (by omega), hfound, hdone, hpayload⟩ + · rw [machineIfHead_true] + rcases hs with ⟨hdecomp, hrow, hcolumn, hfound, hdone, hpayload⟩ + exact ⟨hdecomp, hrow.trans (by omega), + hcolumn.trans (by omega), hfound, hdone, hpayload⟩ + +theorem machineBetheFloorScanIterate_bound (word : List Bool) : ∀ k, + MachineBetheFloorScanStateBound word k + ((machineBetheFloorScanStep)^[k] + (machineBetheFloorScanInit word)) := by + intro k + induction k with + | zero => exact machineBetheFloorScanInit_bound word + | succ k ih => + rw [Function.iterate_succ_apply'] + exact machineBetheFloorScanStep_bound ih + +theorem machineBetheFloorScanRuler_length_le_envelope (word : List Bool) : + (machineBetheFloorScanRuler word).length ≤ + (machineBinaryMulWidth word).length := by + let input := pair (machineBetheFloorScanGuard word) + (machineBetheFloorScanWorkBits word) + have hbound := machineBoundedUnaryIterate_bound input + (machineBetheFloorScanGuard word).length + have hacc := hbound.2.2 + simpa only [machineBetheFloorScanRuler, machineBoundedUnary, + machineBoundedUnaryFinalState, machineBoundedUnaryRuler, + input, machinePairFirst_pair, machineBetheFloorScanGuard] using hacc + +theorem machineBetheFloorScanIterate_length_le_width + (word : List Bool) (iterations : ℕ) + (hiterations : iterations ≤ (machineBetheFloorScanRuler word).length) : + ((machineBetheFloorScanStep)^[iterations] + (machineBetheFloorScanInit word)).length ≤ + (machineBetheFloorScanWidth word).length := by + rcases machineBetheFloorScanIterate_bound word iterations with + ⟨hdecomp, hrow, hcolumn, hfound, hdone, hpayload⟩ + have hk : iterations ≤ (machineBinaryMulWidth word).length := + hiterations.trans (machineBetheFloorScanRuler_length_le_envelope word) + rw [hdecomp] + simp only [machineBetheFloorScanPack, machineBetheFloorScanWidth, + machineBetheFloorScanStateEnvelope, pair_length, + machineBinaryMulWidth, List.length_replicate, List.length_append] + simp only [machineBinaryMulWidth, List.length_replicate, + List.length_append] at hk + nlinarith [sq_nonneg word.length] + +theorem machineBetheFloorScanFinalState_mem_FP : + machineBetheFloorScanFinalState ∈ FP := by + exact Cobham.iterate_mem_FP machineBetheFloorScanStep_mem_FP + machineBetheFloorScanInit_mem_FP machineBetheFloorScanRuler_mem_FP + machineBetheFloorScanWidth_mem_FP + machineBetheFloorScanIterate_length_le_width + +theorem machineBetheFloorScanResultCode_mem_FP : + machineBetheFloorScanResultCode ∈ FP := by + have hfound := machineCompose_mem_FP + machineBetheFloorScanFinalState_mem_FP machineBetheFloorScanFound_mem_FP + have hrow := machineCompose_mem_FP + machineBetheFloorScanFinalState_mem_FP machineBetheFloorScanRow_mem_FP + have hcolumn := machineCompose_mem_FP + machineBetheFloorScanFinalState_mem_FP machineBetheFloorScanColumn_mem_FP + exact machinePair_mem_FP hfound (machinePair_mem_FP hrow hcolumn) + +/-! ## Canonical ruler semantics -/ + +def machineBetheFloorScanCanonicalWord {m : ℕ} + (delta : RawRat) (y : Fin (m * m) → ℚ) : List Bool := + pair (List.replicate m true) + (pair (rawRatBinaryCode delta) (rationalFiniteVectorCode y)) + +@[simp] theorem machineBetheFloorScanDimension_encode {m : ℕ} + (delta : RawRat) (y : Fin (m * m) → ℚ) : + machineBetheFloorScanDimension + (machineBetheFloorScanCanonicalWord delta y) = + List.replicate m true := by + simp [machineBetheFloorScanDimension, + machineBetheFloorScanCanonicalWord] + +@[simp] theorem machineBetheFloorScanThreshold_encode {m : ℕ} + (delta : RawRat) (y : Fin (m * m) → ℚ) : + machineBetheFloorScanThreshold + (machineBetheFloorScanCanonicalWord delta y) = + rawRatBinaryCode delta := by + simp [machineBetheFloorScanThreshold, machineBetheFloorScanRest, + machineBetheFloorScanCanonicalWord] + +@[simp] theorem machineBetheFloorScanVector_encode {m : ℕ} + (delta : RawRat) (y : Fin (m * m) → ℚ) : + machineBetheFloorScanVector + (machineBetheFloorScanCanonicalWord delta y) = + rationalFiniteVectorCode y := by + simp [machineBetheFloorScanVector, machineBetheFloorScanRest, + machineBetheFloorScanCanonicalWord] + +@[simp] theorem machineBetheFloorScanWorkBits_encode {m : ℕ} + (delta : RawRat) (y : Fin (m * m) → ℚ) : + machineBetheFloorScanWorkBits + (machineBetheFloorScanCanonicalWord delta y) = + ((m + 1) * (m + 1)).bits := by + rw [machineBetheFloorScanWorkBits, machineBetheFloorScanOrderBits, + machineBetheFloorScanDimensionBits, + machineBetheFloorScanDimension_encode, machineLengthBits_encode, + List.length_replicate] + have hone : ([true] : List Bool) = (1 : ℕ).bits := rfl + rw [hone, machineBinaryAddBits_pair_natBits, + machineBinaryMulBits_pair_natBits] + +theorem machineBetheFloorScanWork_le_guard {m : ℕ} + (delta : RawRat) (y : Fin (m * m) → ℚ) : + (m + 1) * (m + 1) ≤ + (machineBetheFloorScanGuard + (machineBetheFloorScanCanonicalWord delta y)).length := by + have hm : m ≤ (machineBetheFloorScanCanonicalWord delta y).length := by + simp only [machineBetheFloorScanCanonicalWord, pair_length, + List.length_replicate] + omega + simp only [machineBetheFloorScanGuard, machineBinaryMulWidth, + List.length_replicate, List.length_append] + nlinarith + +@[simp] theorem machineBetheFloorScanRuler_encode {m : ℕ} + (delta : RawRat) (y : Fin (m * m) → ℚ) : + machineBetheFloorScanRuler + (machineBetheFloorScanCanonicalWord delta y) = + List.replicate ((m + 1) * (m + 1)) true := by + rw [machineBetheFloorScanRuler, + machineBetheFloorScanWorkBits_encode, + machineBoundedUnary_encode_of_le] + exact machineBetheFloorScanWork_le_guard delta y + +/-! ## Exact state semantics on canonical inputs -/ + +/-- Successor inside `Fin (m+1)`, fixing the last element. The scan invokes +this operation only away from the last element. -/ +def betheFloorScanNextFin {m : ℕ} (i : Fin (m + 1)) : Fin (m + 1) := + if h : i.1 < m then ⟨i.1 + 1, by omega⟩ else i + +@[simp] theorem betheFloorScanNextFin_val {m : ℕ} + (i : Fin (m + 1)) (hi : i ≠ Fin.last m) : + (betheFloorScanNextFin i).1 = i.1 + 1 := by + have hlt : i.1 < m := by + have hle : i.1 ≤ m := by omega + have hne : i.1 ≠ m := by + intro h + apply hi + apply Fin.ext + simpa using h + omega + simp [betheFloorScanNextFin, hlt] + +/-- Typed semantic state mirrored by the finite-word scan. -/ +structure BetheFloorScanSemanticState (m : ℕ) where + row : Fin (m + 1) + column : Fin (m + 1) + found : Bool + done : Bool + +def betheFloorScanSemanticInit (m : ℕ) : + BetheFloorScanSemanticState m where + row := ⟨0, by omega⟩ + column := ⟨0, by omega⟩ + found := false + done := false + +def betheFloorScanSemanticStep {m : ℕ} (delta : RawRat) + (y : Fin (m * m) → ℚ) (state : BetheFloorScanSemanticState m) : + BetheFloorScanSemanticState m := + if state.found then state + else if state.done then state + else if betheAffineMatrixQ y state.row state.column < delta.value then + { state with found := true } + else if hcolumn : state.column = Fin.last m then + if hrow : state.row = Fin.last m then + { state with done := true } + else + { state with + row := betheFloorScanNextFin state.row + column := ⟨0, by omega⟩ } + else + { state with column := betheFloorScanNextFin state.column } + +def machineBetheFloorScanCanonicalState {m : ℕ} + (delta : RawRat) (y : Fin (m * m) → ℚ) + (state : BetheFloorScanSemanticState m) : List Bool := + machineBetheFloorScanPack + (List.replicate state.row.1 true) + (List.replicate state.column.1 true) + [state.found] [state.done] + (machineBetheFloorScanCanonicalWord delta y) + +@[simp] theorem machineBetheFloorScanRow_canonicalState {m : ℕ} + (delta : RawRat) (y : Fin (m * m) → ℚ) + (state : BetheFloorScanSemanticState m) : + machineBetheFloorScanRow + (machineBetheFloorScanCanonicalState delta y state) = + List.replicate state.row.1 true := by + simp [machineBetheFloorScanCanonicalState] + +@[simp] theorem machineBetheFloorScanColumn_canonicalState {m : ℕ} + (delta : RawRat) (y : Fin (m * m) → ℚ) + (state : BetheFloorScanSemanticState m) : + machineBetheFloorScanColumn + (machineBetheFloorScanCanonicalState delta y state) = + List.replicate state.column.1 true := by + simp [machineBetheFloorScanCanonicalState] + +@[simp] theorem machineBetheFloorScanFound_canonicalState {m : ℕ} + (delta : RawRat) (y : Fin (m * m) → ℚ) + (state : BetheFloorScanSemanticState m) : + machineBetheFloorScanFound + (machineBetheFloorScanCanonicalState delta y state) = + [state.found] := by + simp [machineBetheFloorScanCanonicalState] + +@[simp] theorem machineBetheFloorScanDone_canonicalState {m : ℕ} + (delta : RawRat) (y : Fin (m * m) → ℚ) + (state : BetheFloorScanSemanticState m) : + machineBetheFloorScanDone + (machineBetheFloorScanCanonicalState delta y state) = + [state.done] := by + simp [machineBetheFloorScanCanonicalState] + +@[simp] theorem machineBetheFloorScanPayload_canonicalState {m : ℕ} + (delta : RawRat) (y : Fin (m * m) → ℚ) + (state : BetheFloorScanSemanticState m) : + machineBetheFloorScanPayload + (machineBetheFloorScanCanonicalState delta y state) = + machineBetheFloorScanCanonicalWord delta y := by + simp [machineBetheFloorScanCanonicalState] + +@[simp] theorem machineBetheFloorScanStateDimension_canonicalState {m : ℕ} + (delta : RawRat) (y : Fin (m * m) → ℚ) + (state : BetheFloorScanSemanticState m) : + machineBetheFloorScanStateDimension + (machineBetheFloorScanCanonicalState delta y state) = + List.replicate m true := by + rw [machineBetheFloorScanStateDimension, + machineBetheFloorScanPayload_canonicalState, + machineBetheFloorScanDimension_encode] + +@[simp] theorem machineBetheFloorScanStateThreshold_canonicalState {m : ℕ} + (delta : RawRat) (y : Fin (m * m) → ℚ) + (state : BetheFloorScanSemanticState m) : + machineBetheFloorScanStateThreshold + (machineBetheFloorScanCanonicalState delta y state) = + rawRatBinaryCode delta := by + rw [machineBetheFloorScanStateThreshold, + machineBetheFloorScanPayload_canonicalState, + machineBetheFloorScanThreshold_encode] + +@[simp] theorem machineBetheFloorScanStateVector_canonicalState {m : ℕ} + (delta : RawRat) (y : Fin (m * m) → ℚ) + (state : BetheFloorScanSemanticState m) : + machineBetheFloorScanStateVector + (machineBetheFloorScanCanonicalState delta y state) = + rationalFiniteVectorCode y := by + rw [machineBetheFloorScanStateVector, + machineBetheFloorScanPayload_canonicalState, + machineBetheFloorScanVector_encode] + +@[simp] theorem machineBetheFloorScanLastRowBit_canonicalState {m : ℕ} + (delta : RawRat) (y : Fin (m * m) → ℚ) + (state : BetheFloorScanSemanticState m) : + machineBetheFloorScanLastRowBit + (machineBetheFloorScanCanonicalState delta y state) = + [decide (state.row = Fin.last m)] := by + rw [machineBetheFloorScanLastRowBit, + machineBetheFloorScanRow_canonicalState, + machineBetheFloorScanStateDimension_canonicalState, + machineUnaryRulersEqualBit_replicate] + by_cases hi : state.row = Fin.last m + · simp [hi] + · have hval : state.row.1 ≠ m := by + intro h + apply hi + apply Fin.ext + simpa using h + simp [hi, hval] + +@[simp] theorem machineBetheFloorScanLastColumnBit_canonicalState {m : ℕ} + (delta : RawRat) (y : Fin (m * m) → ℚ) + (state : BetheFloorScanSemanticState m) : + machineBetheFloorScanLastColumnBit + (machineBetheFloorScanCanonicalState delta y state) = + [decide (state.column = Fin.last m)] := by + rw [machineBetheFloorScanLastColumnBit, + machineBetheFloorScanColumn_canonicalState, + machineBetheFloorScanStateDimension_canonicalState, + machineUnaryRulersEqualBit_replicate] + by_cases hj : state.column = Fin.last m + · simp [hj] + · have hval : state.column.1 ≠ m := by + intro h + apply hj + apply Fin.ext + simpa using h + simp [hj, hval] + +@[simp] theorem machineBetheFloorScanEntryWord_canonicalState {m : ℕ} + (delta : RawRat) (y : Fin (m * m) → ℚ) + (state : BetheFloorScanSemanticState m) : + machineBetheFloorScanEntryWord + (machineBetheFloorScanCanonicalState delta y state) = + machineBetheAffineEntryCanonicalWord state.row state.column y := by + simp [machineBetheFloorScanEntryWord, + machineBetheAffineEntryCanonicalWord] + +@[simp] theorem machineBetheFloorScanTestWord_canonicalState {m : ℕ} + (delta : RawRat) (y : Fin (m * m) → ℚ) + (state : BetheFloorScanSemanticState m) : + machineBetheFloorScanTestWord + (machineBetheFloorScanCanonicalState delta y state) = + machineBetheFloorTestCanonicalWord delta state.row state.column y := by + simp [machineBetheFloorScanTestWord, + machineBetheFloorTestCanonicalWord] + +@[simp] theorem machineBetheFloorScanViolationBit_canonicalState {m : ℕ} + (delta : RawRat) (y : Fin (m * m) → ℚ) + (state : BetheFloorScanSemanticState m) : + machineBetheFloorScanViolationBit + (machineBetheFloorScanCanonicalState delta y state) = + [decide (betheAffineMatrixQ y state.row state.column < delta.value)] := by + rw [machineBetheFloorScanViolationBit, + machineBetheFloorScanTestWord_canonicalState, + machineBetheFloorViolationBit_encode] + +@[simp] theorem machineBetheFloorScanNextRow_canonicalState {m : ℕ} + (delta : RawRat) (y : Fin (m * m) → ℚ) + (state : BetheFloorScanSemanticState m) + (hrow : state.row ≠ Fin.last m) : + machineBetheFloorScanNextRow + (machineBetheFloorScanCanonicalState delta y state) = + List.replicate (betheFloorScanNextFin state.row).1 true := by + rw [machineBetheFloorScanNextRow, + machineBetheFloorScanRow_canonicalState, + betheFloorScanNextFin_val state.row hrow, + List.replicate_succ'] + +@[simp] theorem machineBetheFloorScanNextColumn_canonicalState {m : ℕ} + (delta : RawRat) (y : Fin (m * m) → ℚ) + (state : BetheFloorScanSemanticState m) + (hcolumn : state.column ≠ Fin.last m) : + machineBetheFloorScanNextColumn + (machineBetheFloorScanCanonicalState delta y state) = + List.replicate (betheFloorScanNextFin state.column).1 true := by + rw [machineBetheFloorScanNextColumn, + machineBetheFloorScanColumn_canonicalState, + betheFloorScanNextFin_val state.column hcolumn, + List.replicate_succ'] + +@[simp] theorem machineBetheFloorScanMarkFound_canonicalState {m : ℕ} + (delta : RawRat) (y : Fin (m * m) → ℚ) + (state : BetheFloorScanSemanticState m) : + machineBetheFloorScanMarkFound + (machineBetheFloorScanCanonicalState delta y state) = + machineBetheFloorScanCanonicalState delta y + { state with found := true } := by + simp [machineBetheFloorScanMarkFound, + machineBetheFloorScanCanonicalState] + +@[simp] theorem machineBetheFloorScanFinish_canonicalState {m : ℕ} + (delta : RawRat) (y : Fin (m * m) → ℚ) + (state : BetheFloorScanSemanticState m) : + machineBetheFloorScanFinish + (machineBetheFloorScanCanonicalState delta y state) = + machineBetheFloorScanCanonicalState delta y + { state with done := true } := by + simp [machineBetheFloorScanFinish, + machineBetheFloorScanCanonicalState] + +@[simp] theorem machineBetheFloorScanAdvanceRow_canonicalState {m : ℕ} + (delta : RawRat) (y : Fin (m * m) → ℚ) + (state : BetheFloorScanSemanticState m) + (hrow : state.row ≠ Fin.last m) : + machineBetheFloorScanAdvanceRow + (machineBetheFloorScanCanonicalState delta y state) = + machineBetheFloorScanCanonicalState delta y + { state with + row := betheFloorScanNextFin state.row + column := ⟨0, by omega⟩ } := by + rw [machineBetheFloorScanAdvanceRow] + simp only [machineBetheFloorScanNextRow_canonicalState delta y state hrow, + machineBetheFloorScanFound_canonicalState, + machineBetheFloorScanDone_canonicalState, + machineBetheFloorScanPayload_canonicalState] + rfl + +@[simp] theorem machineBetheFloorScanAdvanceColumn_canonicalState {m : ℕ} + (delta : RawRat) (y : Fin (m * m) → ℚ) + (state : BetheFloorScanSemanticState m) + (hcolumn : state.column ≠ Fin.last m) : + machineBetheFloorScanAdvanceColumn + (machineBetheFloorScanCanonicalState delta y state) = + machineBetheFloorScanCanonicalState delta y + { state with column := betheFloorScanNextFin state.column } := by + rw [machineBetheFloorScanAdvanceColumn] + simp only [machineBetheFloorScanRow_canonicalState, + machineBetheFloorScanNextColumn_canonicalState delta y state hcolumn, + machineBetheFloorScanFound_canonicalState, + machineBetheFloorScanDone_canonicalState, + machineBetheFloorScanPayload_canonicalState] + rfl + +@[simp] theorem machineBetheFloorScanStep_canonicalState {m : ℕ} + (delta : RawRat) (y : Fin (m * m) → ℚ) + (state : BetheFloorScanSemanticState m) : + machineBetheFloorScanStep + (machineBetheFloorScanCanonicalState delta y state) = + machineBetheFloorScanCanonicalState delta y + (betheFloorScanSemanticStep delta y state) := by + cases hfound : state.found + · cases hdone : state.done + · by_cases hbelow : + betheAffineMatrixQ y state.row state.column < delta.value + · rw [machineBetheFloorScanStep, + machineBetheFloorScanFound_canonicalState, + machineHeadBit_cons, hfound, machineIfHead_false, + machineBetheFloorScanDone_canonicalState, + machineHeadBit_cons, hdone, machineIfHead_false, + machineBetheFloorScanProcess, + machineBetheFloorScanViolationBit_canonicalState, + machineHeadBit_cons] + have hdecBelow : decide + (betheAffineMatrixQ y state.row state.column < delta.value) = + true := by simp [hbelow] + rw [hdecBelow, machineIfHead_true, + machineBetheFloorScanMarkFound_canonicalState] + simp [betheFloorScanSemanticStep, hfound, hdone, hbelow] + · by_cases hcolumn : state.column = Fin.last m + · by_cases hrow : state.row = Fin.last m + · rw [machineBetheFloorScanStep, + machineBetheFloorScanFound_canonicalState, + machineHeadBit_cons, hfound, machineIfHead_false, + machineBetheFloorScanDone_canonicalState, + machineHeadBit_cons, hdone, machineIfHead_false, + machineBetheFloorScanProcess, + machineBetheFloorScanViolationBit_canonicalState, + machineHeadBit_cons] + have hdecBelow : decide + (betheAffineMatrixQ y state.row state.column < delta.value) = + false := by simp [hbelow] + have hdecColumn : decide + (state.column = Fin.last m) = true := by simp [hcolumn] + have hdecRow : decide + (state.row = Fin.last m) = true := by simp [hrow] + have hbelowLast : ¬betheAffineMatrixQ y + (Fin.last m) (Fin.last m) < delta.value := by + simpa [hrow, hcolumn] using hbelow + rw [hdecBelow, machineIfHead_false, + machineBetheFloorScanAdvance, + machineBetheFloorScanLastColumnBit_canonicalState, + machineHeadBit_cons, hdecColumn, machineIfHead_true, + machineBetheFloorScanLastRowBit_canonicalState, + machineHeadBit_cons, hdecRow, machineIfHead_true, + machineBetheFloorScanFinish_canonicalState] + simp [betheFloorScanSemanticStep, hfound, hdone, hbelowLast, + hcolumn, hrow] + · rw [machineBetheFloorScanStep, + machineBetheFloorScanFound_canonicalState, + machineHeadBit_cons, hfound, machineIfHead_false, + machineBetheFloorScanDone_canonicalState, + machineHeadBit_cons, hdone, machineIfHead_false, + machineBetheFloorScanProcess, + machineBetheFloorScanViolationBit_canonicalState, + machineHeadBit_cons] + have hdecBelow : decide + (betheAffineMatrixQ y state.row state.column < delta.value) = + false := by simp [hbelow] + have hdecColumn : decide + (state.column = Fin.last m) = true := by simp [hcolumn] + have hdecRow : decide + (state.row = Fin.last m) = false := by simp [hrow] + have hbelowLastColumn : ¬betheAffineMatrixQ y + state.row (Fin.last m) < delta.value := by + simpa [hcolumn] using hbelow + rw [hdecBelow, machineIfHead_false, + machineBetheFloorScanAdvance, + machineBetheFloorScanLastColumnBit_canonicalState, + machineHeadBit_cons, hdecColumn, machineIfHead_true, + machineBetheFloorScanLastRowBit_canonicalState, + machineHeadBit_cons, hdecRow, machineIfHead_false, + machineBetheFloorScanAdvanceRow_canonicalState delta y state hrow] + simp [betheFloorScanSemanticStep, hfound, hdone, + hbelowLastColumn, hcolumn, hrow] + · rw [machineBetheFloorScanStep, + machineBetheFloorScanFound_canonicalState, + machineHeadBit_cons, hfound, machineIfHead_false, + machineBetheFloorScanDone_canonicalState, + machineHeadBit_cons, hdone, machineIfHead_false, + machineBetheFloorScanProcess, + machineBetheFloorScanViolationBit_canonicalState, + machineHeadBit_cons] + have hdecBelow : decide + (betheAffineMatrixQ y state.row state.column < delta.value) = + false := by simp [hbelow] + have hdecColumn : decide + (state.column = Fin.last m) = false := by simp [hcolumn] + rw [hdecBelow, machineIfHead_false, + machineBetheFloorScanAdvance, + machineBetheFloorScanLastColumnBit_canonicalState, + machineHeadBit_cons, hdecColumn, machineIfHead_false, + machineBetheFloorScanAdvanceColumn_canonicalState + delta y state hcolumn] + simp [betheFloorScanSemanticStep, hfound, hdone, hbelow, + hcolumn] + · rw [machineBetheFloorScanStep, + machineBetheFloorScanFound_canonicalState, + machineHeadBit_cons, hfound, machineIfHead_false, + machineBetheFloorScanDone_canonicalState, + machineHeadBit_cons, hdone, machineIfHead_true] + simp [betheFloorScanSemanticStep, hfound, hdone] + · rw [machineBetheFloorScanStep, + machineBetheFloorScanFound_canonicalState, + machineHeadBit_cons, hfound, machineIfHead_true] + simp [betheFloorScanSemanticStep, hfound] + +theorem machineBetheFloorScanIterate_canonicalState {m : ℕ} + (delta : RawRat) (y : Fin (m * m) → ℚ) + (state : BetheFloorScanSemanticState m) : ∀ k, + (machineBetheFloorScanStep)^[k] + (machineBetheFloorScanCanonicalState delta y state) = + machineBetheFloorScanCanonicalState delta y + ((betheFloorScanSemanticStep delta y)^[k] state) := by + intro k + induction k with + | zero => rfl + | succ k ih => + rw [Function.iterate_succ_apply', Function.iterate_succ_apply', ih, + machineBetheFloorScanStep_canonicalState] + +@[simp] theorem machineBetheFloorScanInit_encode {m : ℕ} + (delta : RawRat) (y : Fin (m * m) → ℚ) : + machineBetheFloorScanInit + (machineBetheFloorScanCanonicalWord delta y) = + machineBetheFloorScanCanonicalState delta y + (betheFloorScanSemanticInit m) := by + simp [machineBetheFloorScanInit, machineBetheFloorScanCanonicalState, + betheFloorScanSemanticInit] + +def finalBetheFloorScanSemanticState {m : ℕ} (delta : RawRat) + (y : Fin (m * m) → ℚ) : BetheFloorScanSemanticState m := + (betheFloorScanSemanticStep delta y)^[(m + 1) * (m + 1)] + (betheFloorScanSemanticInit m) + +@[simp] theorem machineBetheFloorScanFinalState_encode {m : ℕ} + (delta : RawRat) (y : Fin (m * m) → ℚ) : + machineBetheFloorScanFinalState + (machineBetheFloorScanCanonicalWord delta y) = + machineBetheFloorScanCanonicalState delta y + (finalBetheFloorScanSemanticState delta y) := by + rw [machineBetheFloorScanFinalState, machineBetheFloorScanRuler_encode, + List.length_replicate, machineBetheFloorScanInit_encode, + machineBetheFloorScanIterate_canonicalState] + rfl + +def betheFloorScanSemanticResultCode {m : ℕ} + (state : BetheFloorScanSemanticState m) : List Bool := + pair [state.found] + (pair (List.replicate state.row.1 true) + (List.replicate state.column.1 true)) + +@[simp] theorem machineBetheFloorScanResultCode_encode {m : ℕ} + (delta : RawRat) (y : Fin (m * m) → ℚ) : + machineBetheFloorScanResultCode + (machineBetheFloorScanCanonicalWord delta y) = + betheFloorScanSemanticResultCode + (finalBetheFloorScanSemanticState delta y) := by + rw [machineBetheFloorScanResultCode, + machineBetheFloorScanFinalState_encode] + simp [betheFloorScanSemanticResultCode] + +/-! ## Mathematical correctness of the row-major semantic scan -/ + +def betheFloorScanOrdinal {m : ℕ} + (i j : Fin (m + 1)) : ℕ := i.1 * (m + 1) + j.1 + +theorem betheFloorScanOrdinal_lt_square {m : ℕ} + (i j : Fin (m + 1)) : + betheFloorScanOrdinal i j < (m + 1) * (m + 1) := by + rw [betheFloorScanOrdinal] + calc + i.1 * (m + 1) + j.1 < i.1 * (m + 1) + (m + 1) := + Nat.add_lt_add_left j.isLt _ + _ = (i.1 + 1) * (m + 1) := by ring + _ ≤ (m + 1) * (m + 1) := + Nat.mul_le_mul_right (m + 1) (by omega) + +theorem betheFloorScanOrdinal_injective (m : ℕ) : + Function.Injective + (fun ij : Fin (m + 1) × Fin (m + 1) ↦ + betheFloorScanOrdinal ij.1 ij.2) := by + intro a b hab + have hmod := congrArg (fun q : ℕ ↦ q % (m + 1)) hab + have hmodA : betheFloorScanOrdinal a.1 a.2 % (m + 1) = a.2.1 := by + simp [betheFloorScanOrdinal, Nat.add_mod, + Nat.mod_eq_of_lt a.2.isLt] + have hmodB : betheFloorScanOrdinal b.1 b.2 % (m + 1) = b.2.1 := by + simp [betheFloorScanOrdinal, Nat.add_mod, + Nat.mod_eq_of_lt b.2.isLt] + have hcolumn : a.2.1 = b.2.1 := by + calc + a.2.1 = betheFloorScanOrdinal a.1 a.2 % (m + 1) := hmodA.symm + _ = betheFloorScanOrdinal b.1 b.2 % (m + 1) := hmod + _ = b.2.1 := hmodB + have hrowMul : a.1.1 * (m + 1) = b.1.1 * (m + 1) := by + have hab' := hab + simp only [betheFloorScanOrdinal] at hab' + rw [hcolumn] at hab' + exact Nat.add_right_cancel hab' + have hrow : a.1.1 = b.1.1 := + Nat.mul_right_cancel (by omega : 0 < m + 1) hrowMul + exact Prod.ext (Fin.ext hrow) (Fin.ext hcolumn) + +theorem betheFloorScanOrdinal_nextColumn {m : ℕ} + (i j : Fin (m + 1)) (hj : j ≠ Fin.last m) : + betheFloorScanOrdinal i (betheFloorScanNextFin j) = + betheFloorScanOrdinal i j + 1 := by + simp [betheFloorScanOrdinal, betheFloorScanNextFin_val j hj] + omega + +theorem betheFloorScanOrdinal_nextRow {m : ℕ} + (i : Fin (m + 1)) (hi : i ≠ Fin.last m) : + betheFloorScanOrdinal (betheFloorScanNextFin i) ⟨0, by omega⟩ = + betheFloorScanOrdinal i (Fin.last m) + 1 := by + rw [betheFloorScanOrdinal, betheFloorScanOrdinal, + betheFloorScanNextFin_val i hi] + simp + ring + +@[simp] theorem betheFloorScanOrdinal_last_last (m : ℕ) : + betheFloorScanOrdinal (Fin.last m) (Fin.last m) + 1 = + (m + 1) * (m + 1) := by + simp [betheFloorScanOrdinal] + ring + +theorem betheFloorScanOrdinal_lt_last_of_ne {m : ℕ} + (i j : Fin (m + 1)) + (hij : (i, j) ≠ (Fin.last m, Fin.last m)) : + betheFloorScanOrdinal i j < + betheFloorScanOrdinal (Fin.last m) (Fin.last m) := by + by_cases hi : i = Fin.last m + · have hj : j ≠ Fin.last m := by + intro hj + exact hij (by simp [hi, hj]) + have hjlt : j.1 < m := by + have hjle : j.1 ≤ m := by omega + have hjne : j.1 ≠ m := by + intro h + apply hj + apply Fin.ext + simpa using h + omega + subst i + simp only [betheFloorScanOrdinal, Fin.val_last] + omega + · have hilt : i.1 < m := by + have hile : i.1 ≤ m := by omega + have hine : i.1 ≠ m := by + intro h + apply hi + apply Fin.ext + simpa using h + omega + calc + betheFloorScanOrdinal i j < + (i.1 + 1) * (m + 1) := by + rw [betheFloorScanOrdinal] + calc + i.1 * (m + 1) + j.1 < + i.1 * (m + 1) + (m + 1) := + Nat.add_lt_add_left j.isLt _ + _ = (i.1 + 1) * (m + 1) := by ring + _ ≤ m * (m + 1) := + Nat.mul_le_mul_right (m + 1) (by omega) + _ ≤ betheFloorScanOrdinal (Fin.last m) (Fin.last m) := by + simp [betheFloorScanOrdinal] + +def BetheFloorScanInvariant {m : ℕ} (delta : RawRat) + (y : Fin (m * m) → ℚ) (k : ℕ) + (state : BetheFloorScanSemanticState m) : Prop := + (state.found = true ∧ + betheAffineMatrixQ y state.row state.column < delta.value ∧ + betheFloorScanOrdinal state.row state.column < k ∧ + ∀ i j, + betheFloorScanOrdinal i j < + betheFloorScanOrdinal state.row state.column → + delta.value ≤ betheAffineMatrixQ y i j) ∨ + (state.found = false ∧ state.done = true ∧ + (m + 1) * (m + 1) ≤ k ∧ + ∀ i j, delta.value ≤ betheAffineMatrixQ y i j) ∨ + (state.found = false ∧ state.done = false ∧ + betheFloorScanOrdinal state.row state.column = k ∧ + ∀ i j, betheFloorScanOrdinal i j < k → + delta.value ≤ betheAffineMatrixQ y i j) + +theorem betheFloorScanExtendPrior {m k : ℕ} {delta : RawRat} + {y : Fin (m * m) → ℚ} + {row column : Fin (m + 1)} + (hordinal : betheFloorScanOrdinal row column = k) + (hprior : ∀ i j, betheFloorScanOrdinal i j < k → + delta.value ≤ betheAffineMatrixQ y i j) + (hcurrent : delta.value ≤ betheAffineMatrixQ y row column) : + ∀ i j, betheFloorScanOrdinal i j < k + 1 → + delta.value ≤ betheAffineMatrixQ y i j := by + intro i j hij + by_cases hlt : betheFloorScanOrdinal i j < k + · exact hprior i j hlt + · have heqOrdinal : betheFloorScanOrdinal i j = + betheFloorScanOrdinal row column := by omega + have hpairs : (i, j) = (row, column) := + betheFloorScanOrdinal_injective m heqOrdinal + cases hpairs + exact hcurrent + +theorem betheFloorScanSemanticInit_invariant {m : ℕ} + (delta : RawRat) (y : Fin (m * m) → ℚ) : + BetheFloorScanInvariant delta y 0 + (betheFloorScanSemanticInit m) := by + right + right + simp [betheFloorScanSemanticInit, betheFloorScanOrdinal] + +theorem betheFloorScanSemanticStep_invariant {m k : ℕ} + (delta : RawRat) (y : Fin (m * m) → ℚ) + (state : BetheFloorScanSemanticState m) + (hinvariant : BetheFloorScanInvariant delta y k state) : + BetheFloorScanInvariant delta y (k + 1) + (betheFloorScanSemanticStep delta y state) := by + rcases hinvariant with hfound | hrest + · rcases hfound with ⟨hfound, hbelow, hord, hprior⟩ + have hstep : betheFloorScanSemanticStep delta y state = state := by + simp [betheFloorScanSemanticStep, hfound] + rw [hstep] + left + exact ⟨hfound, hbelow, by omega, hprior⟩ + · rcases hrest with hdone | hactive + · rcases hdone with ⟨hfound, hdone, hwork, hall⟩ + have hstep : betheFloorScanSemanticStep delta y state = state := by + simp [betheFloorScanSemanticStep, hfound, hdone] + rw [hstep] + right + left + exact ⟨hfound, hdone, hwork.trans (by omega), hall⟩ + · rcases hactive with ⟨hfound, hdone, hord, hprior⟩ + by_cases hbelow : + betheAffineMatrixQ y state.row state.column < delta.value + · have hstep : betheFloorScanSemanticStep delta y state = + { state with found := true } := by + simp [betheFloorScanSemanticStep, hfound, hdone, hbelow] + rw [hstep] + left + refine ⟨rfl, hbelow, ?_, ?_⟩ + · change betheFloorScanOrdinal state.row state.column < k + 1 + omega + intro i j hij + apply hprior i j + rwa [hord] at hij + · have hcurrent : delta.value ≤ + betheAffineMatrixQ y state.row state.column := not_lt.mp hbelow + have hextend := betheFloorScanExtendPrior hord hprior hcurrent + by_cases hcolumn : state.column = Fin.last m + · by_cases hrow : state.row = Fin.last m + · have hbelowLast : ¬betheAffineMatrixQ y + (Fin.last m) (Fin.last m) < delta.value := by + simpa [hrow, hcolumn] using hbelow + have hcurrentLast : delta.value ≤ betheAffineMatrixQ y + (Fin.last m) (Fin.last m) := not_lt.mp hbelowLast + have hstep : betheFloorScanSemanticStep delta y state = + { state with done := true } := by + simp [betheFloorScanSemanticStep, hfound, hdone, hbelowLast, + hcolumn, hrow] + rw [hstep] + right + left + refine ⟨hfound, rfl, ?_, ?_⟩ + · calc + (m + 1) * (m + 1) = + betheFloorScanOrdinal (Fin.last m) (Fin.last m) + 1 := + (betheFloorScanOrdinal_last_last m).symm + _ = betheFloorScanOrdinal state.row state.column + 1 := by + rw [hrow, hcolumn] + _ = k + 1 := congrArg (· + 1) hord + _ ≤ k + 1 := le_rfl + · intro i j + by_cases hij : (i, j) = (Fin.last m, Fin.last m) + · cases hij + exact hcurrentLast + · apply hprior i j + rw [← hord, hrow, hcolumn] + exact betheFloorScanOrdinal_lt_last_of_ne i j hij + · have hbelowLastColumn : ¬betheAffineMatrixQ y + state.row (Fin.last m) < delta.value := by + simpa [hcolumn] using hbelow + have hstep : betheFloorScanSemanticStep delta y state = + { state with + row := betheFloorScanNextFin state.row + column := ⟨0, by omega⟩ } := by + simp [betheFloorScanSemanticStep, hfound, hdone, + hbelowLastColumn, hcolumn, hrow] + rw [hstep] + right + right + refine ⟨hfound, hdone, ?_, hextend⟩ + rw [betheFloorScanOrdinal_nextRow state.row hrow, + ← hcolumn, hord] + · have hstep : betheFloorScanSemanticStep delta y state = + { state with + column := betheFloorScanNextFin state.column } := by + simp [betheFloorScanSemanticStep, hfound, hdone, hbelow, + hcolumn] + rw [hstep] + right + right + refine ⟨hfound, hdone, ?_, hextend⟩ + rw [betheFloorScanOrdinal_nextColumn state.row state.column hcolumn, + hord] + +theorem betheFloorScanSemanticIterate_invariant {m : ℕ} + (delta : RawRat) (y : Fin (m * m) → ℚ) : ∀ k, + BetheFloorScanInvariant delta y k + ((betheFloorScanSemanticStep delta y)^[k] + (betheFloorScanSemanticInit m)) := by + intro k + induction k with + | zero => exact betheFloorScanSemanticInit_invariant delta y + | succ k ih => + rw [Function.iterate_succ_apply'] + exact betheFloorScanSemanticStep_invariant delta y _ ih + +theorem finalBetheFloorScanSemanticState_invariant {m : ℕ} + (delta : RawRat) (y : Fin (m * m) → ℚ) : + BetheFloorScanInvariant delta y ((m + 1) * (m + 1)) + (finalBetheFloorScanSemanticState delta y) := by + simpa only [finalBetheFloorScanSemanticState] using + betheFloorScanSemanticIterate_invariant delta y + ((m + 1) * (m + 1)) + +theorem finalBetheFloorScanSemanticState_found_is_below {m : ℕ} + (delta : RawRat) (y : Fin (m * m) → ℚ) + (hfound : (finalBetheFloorScanSemanticState delta y).found = true) : + betheAffineMatrixQ y + (finalBetheFloorScanSemanticState delta y).row + (finalBetheFloorScanSemanticState delta y).column < delta.value := by + rcases finalBetheFloorScanSemanticState_invariant delta y with + hfoundCase | hrest + · exact hfoundCase.2.1 + · rcases hrest with hdoneCase | hactiveCase + · rw [hfound] at hdoneCase + simp at hdoneCase + · rw [hfound] at hactiveCase + simp at hactiveCase + +theorem finalBetheFloorScanSemanticState_notFound_all_above {m : ℕ} + (delta : RawRat) (y : Fin (m * m) → ℚ) + (hnotFound : + (finalBetheFloorScanSemanticState delta y).found = false) : + ∀ i j, delta.value ≤ betheAffineMatrixQ y i j := by + rcases finalBetheFloorScanSemanticState_invariant delta y with + hfoundCase | hrest + · rw [hnotFound] at hfoundCase + simp at hfoundCase + · rcases hrest with hdoneCase | hactiveCase + · exact hdoneCase.2.2.2 + · exfalso + have heq := hactiveCase.2.2.1 + have hlt := betheFloorScanOrdinal_lt_square + (finalBetheFloorScanSemanticState delta y).row + (finalBetheFloorScanSemanticState delta y).column + omega + +theorem finalBetheFloorScanSemanticState_found_iff_exists_below {m : ℕ} + (delta : RawRat) (y : Fin (m * m) → ℚ) : + (finalBetheFloorScanSemanticState delta y).found = true ↔ + ∃ i j, betheAffineMatrixQ y i j < delta.value := by + constructor + · intro hfound + exact ⟨(finalBetheFloorScanSemanticState delta y).row, + (finalBetheFloorScanSemanticState delta y).column, + finalBetheFloorScanSemanticState_found_is_below delta y hfound⟩ + · rintro ⟨i, j, hij⟩ + cases hfound : (finalBetheFloorScanSemanticState delta y).found + · have hall := finalBetheFloorScanSemanticState_notFound_all_above + delta y hfound i j + exact (not_lt_of_ge hall hij).elim + · rfl + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineBetheFloorTest.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineBetheFloorTest.lean new file mode 100644 index 0000000000..45a19302c1 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineBetheFloorTest.lean @@ -0,0 +1,133 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineBetheAffineEntry +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalCompare +import LeanPool.BeyondBethe.BeyondBethe.MachineBool + +/-! +# Exact finite-word test for a violated Bethe floor constraint + +The floor oracle must distinguish the strict inequality +`betheAffineMatrixQ y i j < delta` from the permitted boundary case. We do +this without normalization or approximate arithmetic: compute the recovered +entry as an unreduced rational and negate the exact comparison +`delta <= entry`. +-/ + +namespace BeyondBethe + +open Complexity + +def machineBetheFloorTestThreshold (word : List Bool) : List Bool := + machinePairFirst word + +def machineBetheFloorTestEntryWord (word : List Bool) : List Bool := + machinePairSecond word + +def machineBetheFloorTestEntryRawCode (word : List Bool) : List Bool := + machineBetheAffineEntryRawCode (machineBetheFloorTestEntryWord word) + +def machineBetheFloorTestThresholdLeEntryBit + (word : List Bool) : List Bool := + machineRawRatLeBit + (pair (machineBetheFloorTestThreshold word) + (machineBetheFloorTestEntryRawCode word)) + +/-- One-bit answer, true exactly when the recovered entry is strictly below +the supplied rational floor on canonical inputs. -/ +def machineBetheFloorViolationBit (word : List Bool) : List Bool := + machineNotBit (machineBetheFloorTestThresholdLeEntryBit word) + +theorem machineBetheFloorTestThreshold_mem_FP : + machineBetheFloorTestThreshold ∈ FP := machinePairFirst_mem_FP + +theorem machineBetheFloorTestEntryWord_mem_FP : + machineBetheFloorTestEntryWord ∈ FP := machinePairSecond_mem_FP + +theorem machineBetheFloorTestEntryRawCode_mem_FP : + machineBetheFloorTestEntryRawCode ∈ FP := by + simpa only [machineBetheFloorTestEntryRawCode] using + machineCompose_mem_FP machineBetheFloorTestEntryWord_mem_FP + machineBetheAffineEntryRawCode_mem_FP + +theorem machineBetheFloorTestThresholdLeEntryBit_mem_FP : + machineBetheFloorTestThresholdLeEntryBit ∈ FP := by + have hinput := machinePair_mem_FP + machineBetheFloorTestThreshold_mem_FP + machineBetheFloorTestEntryRawCode_mem_FP + simpa only [machineBetheFloorTestThresholdLeEntryBit] using + machineCompose_mem_FP hinput machineRawRatLeBit_mem_FP + +theorem machineBetheFloorViolationBit_mem_FP : + machineBetheFloorViolationBit ∈ FP := by + simpa only [machineBetheFloorViolationBit] using + machineNotBit_mem_FP + machineBetheFloorTestThresholdLeEntryBit_mem_FP + +def machineBetheFloorTestCanonicalWord {m : ℕ} + (delta : RawRat) (i j : Fin (m + 1)) + (y : Fin (m * m) → ℚ) : List Bool := + pair (rawRatBinaryCode delta) + (machineBetheAffineEntryCanonicalWord i j y) + +@[simp] theorem machineBetheFloorTestThreshold_encode {m : ℕ} + (delta : RawRat) (i j : Fin (m + 1)) + (y : Fin (m * m) → ℚ) : + machineBetheFloorTestThreshold + (machineBetheFloorTestCanonicalWord delta i j y) = + rawRatBinaryCode delta := by + simp [machineBetheFloorTestThreshold, + machineBetheFloorTestCanonicalWord] + +@[simp] theorem machineBetheFloorTestEntryWord_encode {m : ℕ} + (delta : RawRat) (i j : Fin (m + 1)) + (y : Fin (m * m) → ℚ) : + machineBetheFloorTestEntryWord + (machineBetheFloorTestCanonicalWord delta i j y) = + machineBetheAffineEntryCanonicalWord i j y := by + simp [machineBetheFloorTestEntryWord, + machineBetheFloorTestCanonicalWord] + +@[simp] theorem machineBetheFloorTestEntryRawCode_encode {m : ℕ} + (delta : RawRat) (i j : Fin (m + 1)) + (y : Fin (m * m) → ℚ) : + machineBetheFloorTestEntryRawCode + (machineBetheFloorTestCanonicalWord delta i j y) = + rawRatBinaryCode (rawBetheAffineEntry y i j) := by + rw [machineBetheFloorTestEntryRawCode, + machineBetheFloorTestEntryWord_encode, + machineBetheAffineEntryRawCode_encode] + +@[simp] theorem machineBetheFloorTestThresholdLeEntryBit_encode {m : ℕ} + (delta : RawRat) (i j : Fin (m + 1)) + (y : Fin (m * m) → ℚ) : + machineBetheFloorTestThresholdLeEntryBit + (machineBetheFloorTestCanonicalWord delta i j y) = + [decide (delta.value ≤ betheAffineMatrixQ y i j)] := by + rw [machineBetheFloorTestThresholdLeEntryBit, + machineBetheFloorTestThreshold_encode, + machineBetheFloorTestEntryRawCode_encode, + machineRawRatLeBit_encode, + rawBetheAffineEntry_value] + +@[simp] theorem machineBetheFloorViolationBit_encode {m : ℕ} + (delta : RawRat) (i j : Fin (m + 1)) + (y : Fin (m * m) → ℚ) : + machineBetheFloorViolationBit + (machineBetheFloorTestCanonicalWord delta i j y) = + [decide (betheAffineMatrixQ y i j < delta.value)] := by + rw [machineBetheFloorViolationBit, + machineBetheFloorTestThresholdLeEntryBit_encode, + machineNotBit_one] + by_cases h : delta.value ≤ betheAffineMatrixQ y i j + · have hnot : ¬betheAffineMatrixQ y i j < delta.value := + not_lt_of_ge h + simp [h, hnot] + · have hlt : betheAffineMatrixQ y i j < delta.value := lt_of_not_ge h + simp [h, hlt] + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineBetheHeightCap.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineBetheHeightCap.lean new file mode 100644 index 0000000000..ef66d9036c --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineBetheHeightCap.lean @@ -0,0 +1,167 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineBetheFloorScan +import LeanPool.BeyondBethe.BeyondBethe.MachineListIndex + +/-! +# Exact finite-word test for the Bethe epigraph height cap + +The last coordinate of a rational epigraph point is its height. Given a +unary ruler for the number of base coordinates, this machine retrieves that +last entry and tests the strict violation `upper < height` by exact rational +cross multiplication. +-/ + +namespace BeyondBethe + +open Complexity + +def machineBetheHeightCapDimension (word : List Bool) : List Bool := + machinePairFirst word + +def machineBetheHeightCapRest (word : List Bool) : List Bool := + machinePairSecond word + +def machineBetheHeightCapUpper (word : List Bool) : List Bool := + machinePairFirst (machineBetheHeightCapRest word) + +def machineBetheHeightCapVector (word : List Bool) : List Bool := + machinePairSecond (machineBetheHeightCapRest word) + +def machineBetheHeightCapIndexInput (word : List Bool) : List Bool := + pair (machineBetheHeightCapDimension word) + (machineBetheHeightCapVector word) + +def machineBetheHeightCapEntryCode (word : List Bool) : List Bool := + machineListIndex (machineBetheHeightCapIndexInput word) + +def machineBetheHeightLeUpperBit (word : List Bool) : List Bool := + machineRawRatLeBit + (pair (machineBetheHeightCapEntryCode word) + (machineBetheHeightCapUpper word)) + +/-- One-bit answer, true exactly when the height is strictly above the cap on +canonical inputs. -/ +def machineBetheHeightCapViolationBit (word : List Bool) : List Bool := + machineNotBit (machineBetheHeightLeUpperBit word) + +theorem machineBetheHeightCapDimension_mem_FP : + machineBetheHeightCapDimension ∈ FP := machinePairFirst_mem_FP + +theorem machineBetheHeightCapRest_mem_FP : + machineBetheHeightCapRest ∈ FP := machinePairSecond_mem_FP + +theorem machineBetheHeightCapUpper_mem_FP : + machineBetheHeightCapUpper ∈ FP := by + simpa only [machineBetheHeightCapUpper] using + machineCompose_mem_FP machineBetheHeightCapRest_mem_FP + machinePairFirst_mem_FP + +theorem machineBetheHeightCapVector_mem_FP : + machineBetheHeightCapVector ∈ FP := by + simpa only [machineBetheHeightCapVector] using + machineCompose_mem_FP machineBetheHeightCapRest_mem_FP + machinePairSecond_mem_FP + +theorem machineBetheHeightCapIndexInput_mem_FP : + machineBetheHeightCapIndexInput ∈ FP := + machinePair_mem_FP machineBetheHeightCapDimension_mem_FP + machineBetheHeightCapVector_mem_FP + +theorem machineBetheHeightCapEntryCode_mem_FP : + machineBetheHeightCapEntryCode ∈ FP := by + simpa only [machineBetheHeightCapEntryCode] using + machineCompose_mem_FP machineBetheHeightCapIndexInput_mem_FP + machineListIndex_mem_FP + +theorem machineBetheHeightLeUpperBit_mem_FP : + machineBetheHeightLeUpperBit ∈ FP := by + have hinput := machinePair_mem_FP machineBetheHeightCapEntryCode_mem_FP + machineBetheHeightCapUpper_mem_FP + simpa only [machineBetheHeightLeUpperBit] using + machineCompose_mem_FP hinput machineRawRatLeBit_mem_FP + +theorem machineBetheHeightCapViolationBit_mem_FP : + machineBetheHeightCapViolationBit ∈ FP := by + simpa only [machineBetheHeightCapViolationBit] using + machineNotBit_mem_FP machineBetheHeightLeUpperBit_mem_FP + +def machineBetheHeightCapCanonicalWord {d : ℕ} + (upper : RawRat) (q : Fin (d + 1) → ℚ) : List Bool := + pair (List.replicate d true) + (pair (rawRatBinaryCode upper) (rationalFiniteVectorCode q)) + +@[simp] theorem machineBetheHeightCapDimension_encode {d : ℕ} + (upper : RawRat) (q : Fin (d + 1) → ℚ) : + machineBetheHeightCapDimension + (machineBetheHeightCapCanonicalWord upper q) = + List.replicate d true := by + simp [machineBetheHeightCapDimension, + machineBetheHeightCapCanonicalWord] + +@[simp] theorem machineBetheHeightCapUpper_encode {d : ℕ} + (upper : RawRat) (q : Fin (d + 1) → ℚ) : + machineBetheHeightCapUpper + (machineBetheHeightCapCanonicalWord upper q) = + rawRatBinaryCode upper := by + simp [machineBetheHeightCapUpper, machineBetheHeightCapRest, + machineBetheHeightCapCanonicalWord] + +@[simp] theorem machineBetheHeightCapVector_encode {d : ℕ} + (upper : RawRat) (q : Fin (d + 1) → ℚ) : + machineBetheHeightCapVector + (machineBetheHeightCapCanonicalWord upper q) = + rationalFiniteVectorCode q := by + simp [machineBetheHeightCapVector, machineBetheHeightCapRest, + machineBetheHeightCapCanonicalWord] + +@[simp] theorem machineBetheHeightCapEntryCode_encode {d : ℕ} + (upper : RawRat) (q : Fin (d + 1) → ℚ) : + machineBetheHeightCapEntryCode + (machineBetheHeightCapCanonicalWord upper q) = + rawRatBinaryCode (rawRatOfRat (q (Fin.last d))) := by + rw [machineBetheHeightCapEntryCode, + machineBetheHeightCapIndexInput, + machineBetheHeightCapDimension_encode, + machineBetheHeightCapVector_encode, + rationalFiniteVectorCode, + machineListIndex_binaryListCode rationalEntryBinaryCode + (List.ofFn q) d] + · rw [rawRatBinaryCode_rawRatOfRat] + congr 1 + change (List.ofFn q)[d] = q (Fin.last d) + simp only [List.getElem_ofFn] + apply congrArg q + apply Fin.ext + rfl + +@[simp] theorem machineBetheHeightLeUpperBit_encode {d : ℕ} + (upper : RawRat) (q : Fin (d + 1) → ℚ) : + machineBetheHeightLeUpperBit + (machineBetheHeightCapCanonicalWord upper q) = + [decide (q (Fin.last d) ≤ upper.value)] := by + rw [machineBetheHeightLeUpperBit, + machineBetheHeightCapEntryCode_encode, + machineBetheHeightCapUpper_encode, + machineRawRatLeBit_encode, + rawRatOfRat_value] + +@[simp] theorem machineBetheHeightCapViolationBit_encode {d : ℕ} + (upper : RawRat) (q : Fin (d + 1) → ℚ) : + machineBetheHeightCapViolationBit + (machineBetheHeightCapCanonicalWord upper q) = + [decide (upper.value < q (Fin.last d))] := by + rw [machineBetheHeightCapViolationBit, + machineBetheHeightLeUpperBit_encode, + machineNotBit_one] + by_cases h : q (Fin.last d) ≤ upper.value + · have hnot : ¬upper.value < q (Fin.last d) := not_lt_of_ge h + simp [h, hnot] + · have hlt : upper.value < q (Fin.last d) := lt_of_not_ge h + simp [h, hlt] + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineBetheHeightNormal.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineBetheHeightNormal.lean new file mode 100644 index 0000000000..7a4390bc95 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineBetheHeightNormal.lean @@ -0,0 +1,158 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineBetheFloorCutVector + +/-! +# Finite-word height-cap normals + +The upper-height constraint has normal `(0,...,0,1)`. We construct its +`m^2` zero base coordinates with the common grid generator and append the +single positive height coordinate with the verified list-snoc machine. +-/ + +namespace BeyondBethe + +open Complexity + +def machineBetheHeightNormalEntryCode (_word : List Bool) : List Bool := + rationalEntryBinaryCode 0 + +def machineBetheHeightNormalBound (word : List Bool) : List Bool := + machineIteratedBinaryWidth 2 word + +def machineBetheHeightNormalGeneratorInput + (word : List Bool) : List Bool := + pair word (pair (machineBetheHeightNormalBound word) word) + +def machineBetheHeightNormalBaseCode (word : List Bool) : List Bool := + machineUnaryGridGeneratorCode machineBetheHeightNormalEntryCode + (machineBetheHeightNormalGeneratorInput word) + +def machineBetheHeightNormalSnocInput (word : List Bool) : List Bool := + pair (rationalEntryBinaryCode 1) + (machineBetheHeightNormalBaseCode word) + +def machineBetheHeightNormalVectorCode (word : List Bool) : List Bool := + machineBinaryListSnoc (machineBetheHeightNormalSnocInput word) + +theorem machineBetheHeightNormalEntryCode_mem_FP : + machineBetheHeightNormalEntryCode ∈ FP := + machineConst_mem_FP (rationalEntryBinaryCode 0) + +theorem machineBetheHeightNormalBound_mem_FP : + machineBetheHeightNormalBound ∈ FP := + machineIteratedBinaryWidth_mem_FP 2 + +theorem machineBetheHeightNormalGeneratorInput_mem_FP : + machineBetheHeightNormalGeneratorInput ∈ FP := + machinePair_mem_FP id_mem_FP + (machinePair_mem_FP machineBetheHeightNormalBound_mem_FP id_mem_FP) + +theorem machineBetheHeightNormalBaseCode_mem_FP : + machineBetheHeightNormalBaseCode ∈ FP := by + have hgenerator := machineUnaryGridGeneratorCode_mem_FP + machineBetheHeightNormalEntryCode_mem_FP + simpa only [machineBetheHeightNormalBaseCode] using + machineCompose_mem_FP machineBetheHeightNormalGeneratorInput_mem_FP + hgenerator + +theorem machineBetheHeightNormalSnocInput_mem_FP : + machineBetheHeightNormalSnocInput ∈ FP := + machinePair_mem_FP (machineConst_mem_FP (rationalEntryBinaryCode 1)) + machineBetheHeightNormalBaseCode_mem_FP + +theorem machineBetheHeightNormalVectorCode_mem_FP : + machineBetheHeightNormalVectorCode ∈ FP := by + simpa only [machineBetheHeightNormalVectorCode] using + machineCompose_mem_FP machineBetheHeightNormalSnocInput_mem_FP + machineBinaryListSnoc_mem_FP + +theorem rationalEntryBinaryCode_zero_length_le : + (rationalEntryBinaryCode 0).length ≤ 16 := by + norm_num [rationalEntryBinaryCode, integerBinaryCode] + +theorem betheHeightNormal_base_code_length_le_bound (m : ℕ) : + (binaryListCode rationalEntryBinaryCode + (unaryGridValues (fun _ _ : Fin m ↦ (0 : ℚ)))).length ≤ + (machineBetheHeightNormalBound + (List.replicate m true)).length := by + let word := List.replicate m true + let L := word.length + let T := L + 16 + have hmL : m ≤ L := by simp [L, word] + have hsum := List.sum_le_card_nsmul + ((unaryGridValues (fun _ _ : Fin m ↦ (0 : ℚ))).map + fun q ↦ 2 * (rationalEntryBinaryCode q).length + 2) + 34 (by + intro value hvalue + rw [List.mem_map] at hvalue + obtain ⟨q, hq, rfl⟩ := hvalue + rw [unaryGridValues] at hq + obtain ⟨k, rfl⟩ := List.mem_ofFn.mp hq + have hzero := rationalEntryBinaryCode_zero_length_le + omega) + have hmT : m ≤ T := hmL.trans (by simp [T]) + have hmm := Nat.mul_le_mul hmT hmT + have hbase : 16 ≤ T := by simp [T] + have hcoefficient : 34 ≤ T ^ 2 := by + have hpow := Nat.pow_le_pow_left hbase 2 + exact (by norm_num : 34 ≤ 16 ^ 2).trans hpow + have hmul := Nat.mul_le_mul hmm hcoefficient + have hcode : + (binaryListCode rationalEntryBinaryCode + (unaryGridValues (fun _ _ : Fin m ↦ (0 : ℚ)))).length ≤ + T ^ 4 := by + rw [binaryListCode_length_eq_sum] + simp only [List.length_map, unaryGridValues_length, + Nat.nsmul_eq_mul] at hsum + calc + _ ≤ m * m * 34 := hsum + _ ≤ T * T * T ^ 2 := hmul + _ = T ^ 4 := by ring + rw [machineBetheHeightNormalBound, + machineIteratedBinaryWidth_length] + exact hcode.trans (by + simpa only [T, L, word] using + certificateExpGuardWidth_pow_lower 1 + (List.replicate m true).length) + +@[simp] theorem machineBetheHeightNormalGeneratorInput_encode (m : ℕ) : + machineBetheHeightNormalGeneratorInput (List.replicate m true) = + machineUnaryGridGeneratorCanonicalWord m + (machineBetheHeightNormalBound (List.replicate m true)) + (List.replicate m true) := by + simp [machineBetheHeightNormalGeneratorInput, + machineUnaryGridGeneratorCanonicalWord] + +@[simp] theorem machineBetheHeightNormalBaseCode_encode (m : ℕ) : + machineBetheHeightNormalBaseCode (List.replicate m true) = + binaryListCode rationalEntryBinaryCode + (unaryGridValues (fun _ _ : Fin m ↦ (0 : ℚ))) := by + rw [machineBetheHeightNormalBaseCode, + machineBetheHeightNormalGeneratorInput_encode] + exact machineUnaryGridGeneratorCode_encode_of_bound + machineBetheHeightNormalEntryCode (fun _ _ : Fin m ↦ (0 : ℚ)) + (machineBetheHeightNormalBound (List.replicate m true)) + (List.replicate m true) (by intro i j; rfl) + (betheHeightNormal_base_code_length_le_bound m) + +theorem ofFn_epigraphUpperNormal_square (m : ℕ) : + List.ofFn (epigraphUpperNormal (m * m)) = + unaryGridValues (fun _ _ : Fin m ↦ (0 : ℚ)) ++ [1] := by + rw [List.ofFn_succ'] + simp [epigraphUpperNormal, unaryGridValues] + +@[simp] theorem machineBetheHeightNormalVectorCode_encode (m : ℕ) : + machineBetheHeightNormalVectorCode (List.replicate m true) = + rationalFiniteVectorCode (epigraphUpperNormal (m * m)) := by + rw [machineBetheHeightNormalVectorCode, + machineBetheHeightNormalSnocInput, + machineBetheHeightNormalBaseCode_encode, + machineBinaryListSnoc_encode, + rationalFiniteVectorCode, ofFn_epigraphUpperNormal_square] + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryAdd.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryAdd.lean new file mode 100644 index 0000000000..580569038c --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryAdd.lean @@ -0,0 +1,385 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineBool + +/-! +# A composed polynomial-time binary adder + +The adder uses little-endian words, matching `Nat.bits`. Its state is +`pair x (pair y (pair carry accRev))`. One verified `FP` step consumes at +most one bit from each operand and prepends one result bit to `accRev`. +Complexitylib's proved bounded-iteration machine runs this step for the +length of a linear ruler; the final reversal restores little-endian order. +-/ + +namespace BeyondBethe + +open Complexity + +def machineBinaryAddPack + (x y carry accRev : List Bool) : List Bool := + pair x (pair y (pair carry accRev)) + +def machineBinaryAddX (state : List Bool) : List Bool := + machinePairFirst state + +def machineBinaryAddY (state : List Bool) : List Bool := + machinePairFirst (machinePairSecond state) + +def machineBinaryAddCarry (state : List Bool) : List Bool := + machinePairFirst (machinePairSecond (machinePairSecond state)) + +def machineBinaryAddAccRev (state : List Bool) : List Bool := + machinePairSecond (machinePairSecond (machinePairSecond state)) + +theorem machineBinaryAddPack_mem_FP + {x y carry accRev : List Bool → List Bool} + (hx : x ∈ Complexity.FP) (hy : y ∈ Complexity.FP) + (hcarry : carry ∈ Complexity.FP) (hacc : accRev ∈ Complexity.FP) : + (fun word => machineBinaryAddPack (x word) (y word) + (carry word) (accRev word)) ∈ Complexity.FP := by + exact machinePair_mem_FP hx + (machinePair_mem_FP hy (machinePair_mem_FP hcarry hacc)) + +theorem machineBinaryAddX_mem_FP : machineBinaryAddX ∈ Complexity.FP := by + simpa only [machineBinaryAddX] using machinePairFirst_mem_FP + +theorem machineBinaryAddY_mem_FP : machineBinaryAddY ∈ Complexity.FP := by + simpa only [machineBinaryAddY] using + (machineCompose_mem_FP (f := machinePairSecond) (g := machinePairFirst) + machinePairSecond_mem_FP machinePairFirst_mem_FP) + +theorem machineBinaryAddCarry_mem_FP : + machineBinaryAddCarry ∈ Complexity.FP := by + have hsecond : + (fun word => machinePairSecond (machinePairSecond word)) ∈ + Complexity.FP := + machineCompose_mem_FP (f := machinePairSecond) (g := machinePairSecond) + machinePairSecond_mem_FP machinePairSecond_mem_FP + simpa only [machineBinaryAddCarry] using + (machineCompose_mem_FP (f := fun word => + machinePairSecond (machinePairSecond word)) + (g := machinePairFirst) hsecond machinePairFirst_mem_FP) + +theorem machineBinaryAddAccRev_mem_FP : + machineBinaryAddAccRev ∈ Complexity.FP := by + have hsecond : + (fun word => machinePairSecond (machinePairSecond word)) ∈ + Complexity.FP := + machineCompose_mem_FP (f := machinePairSecond) (g := machinePairSecond) + machinePairSecond_mem_FP machinePairSecond_mem_FP + simpa only [machineBinaryAddAccRev] using + (machineCompose_mem_FP (f := fun word => + machinePairSecond (machinePairSecond word)) + (g := machinePairSecond) hsecond machinePairSecond_mem_FP) + +@[simp] theorem machineBinaryAddX_pack (x y carry accRev : List Bool) : + machineBinaryAddX (machineBinaryAddPack x y carry accRev) = x := by + simp [machineBinaryAddX, machineBinaryAddPack] + +@[simp] theorem machineBinaryAddY_pack (x y carry accRev : List Bool) : + machineBinaryAddY (machineBinaryAddPack x y carry accRev) = y := by + simp [machineBinaryAddY, machineBinaryAddPack] + +@[simp] theorem machineBinaryAddCarry_pack (x y carry accRev : List Bool) : + machineBinaryAddCarry (machineBinaryAddPack x y carry accRev) = carry := by + simp [machineBinaryAddCarry, machineBinaryAddPack] + +@[simp] theorem machineBinaryAddAccRev_pack (x y carry accRev : List Bool) : + machineBinaryAddAccRev (machineBinaryAddPack x y carry accRev) = accRev := by + simp [machineBinaryAddAccRev, machineBinaryAddPack] + +/-- One-bit flag saying that an addition step remains: an operand is +nonempty, or both operands are empty and the carry is true. -/ +def machineBinaryAddActive (state : List Bool) : List Bool := + machineIfEmpty (machineBinaryAddX state) + (machineIfEmpty (machineBinaryAddY state) + (machineBinaryAddCarry state) [true]) + [true] + +def machineBinaryAddSumBit (state : List Bool) : List Bool := + machineFullAdderSum + (machineHeadBit (machineBinaryAddX state)) + (machineHeadBit (machineBinaryAddY state)) + (machineBinaryAddCarry state) + +def machineBinaryAddNextCarry (state : List Bool) : List Bool := + machineFullAdderCarry + (machineHeadBit (machineBinaryAddX state)) + (machineHeadBit (machineBinaryAddY state)) + (machineBinaryAddCarry state) + +def machineBinaryAddAdvanced (state : List Bool) : List Bool := + machineBinaryAddPack + (machineBinaryAddX state).tail + (machineBinaryAddY state).tail + (machineBinaryAddNextCarry state) + (machineBinaryAddSumBit state ++ machineBinaryAddAccRev state) + +/-- Total addition transition. A completed state is a fixed point. -/ +def machineBinaryAddStep (state : List Bool) : List Bool := + machineIfHead (machineBinaryAddActive state) + (machineBinaryAddAdvanced state) state + +theorem machineBinaryAddActive_mem_FP : + machineBinaryAddActive ∈ Complexity.FP := by + apply machineIfEmpty_mem_FP machineBinaryAddX_mem_FP + · apply machineIfEmpty_mem_FP machineBinaryAddY_mem_FP + · exact machineBinaryAddCarry_mem_FP + · exact machineConst_mem_FP [true] + · exact machineConst_mem_FP [true] + +theorem machineBinaryAddSumBit_mem_FP : + machineBinaryAddSumBit ∈ Complexity.FP := by + apply machineFullAdderSum_mem_FP + · exact machineCompose_mem_FP machineBinaryAddX_mem_FP machineHeadBit_mem_FP + · exact machineCompose_mem_FP machineBinaryAddY_mem_FP machineHeadBit_mem_FP + · exact machineBinaryAddCarry_mem_FP + +theorem machineBinaryAddNextCarry_mem_FP : + machineBinaryAddNextCarry ∈ Complexity.FP := by + apply machineFullAdderCarry_mem_FP + · exact machineCompose_mem_FP machineBinaryAddX_mem_FP machineHeadBit_mem_FP + · exact machineCompose_mem_FP machineBinaryAddY_mem_FP machineHeadBit_mem_FP + · exact machineBinaryAddCarry_mem_FP + +theorem machineBinaryAddAdvanced_mem_FP : + machineBinaryAddAdvanced ∈ Complexity.FP := by + apply machineBinaryAddPack_mem_FP + · exact machineCompose_mem_FP machineBinaryAddX_mem_FP machineTail_mem_FP + · exact machineCompose_mem_FP machineBinaryAddY_mem_FP machineTail_mem_FP + · exact machineBinaryAddNextCarry_mem_FP + · exact machineAppend_mem_FP machineBinaryAddSumBit_mem_FP + machineBinaryAddAccRev_mem_FP + +theorem machineBinaryAddStep_mem_FP : + machineBinaryAddStep ∈ Complexity.FP := by + exact machineIfHead_mem_FP machineBinaryAddActive_mem_FP + machineBinaryAddAdvanced_mem_FP id_mem_FP + +/-- Initial state from a paired pair of operand words. -/ +def machineBinaryAddInit (word : List Bool) : List Bool := + machineBinaryAddPack (machinePairFirst word) (machinePairSecond word) + [false] [] + +/-- A linear-length iteration ruler. -/ +def machineBinaryAddRuler (word : List Bool) : List Bool := + machinePairFirst word ++ machinePairSecond word ++ [false] + +/-- A quadratic-width zero word. This is intentionally generous and makes +the bounded-iteration proof independent of fine fixedValue accounting. -/ +def machineBinaryAddWidth (word : List Bool) : List Bool := + let padded := List.replicate 8 false ++ word + List.replicate (padded.length * padded.length) false + +theorem machineBinaryAddInit_mem_FP : + machineBinaryAddInit ∈ Complexity.FP := by + exact machineBinaryAddPack_mem_FP machinePairFirst_mem_FP + machinePairSecond_mem_FP (machineConst_mem_FP [false]) + (machineConst_mem_FP []) + +theorem machineBinaryAddRuler_mem_FP : + machineBinaryAddRuler ∈ Complexity.FP := by + apply machineAppend_mem_FP + · exact machineAppend_mem_FP machinePairFirst_mem_FP machinePairSecond_mem_FP + · exact machineConst_mem_FP [false] + +theorem machineBinaryAddWidth_mem_FP : + machineBinaryAddWidth ∈ Complexity.FP := by + let padded : List Bool → List Bool := + fun word => List.replicate 8 false ++ word + have hpadded : padded ∈ Complexity.FP := by + exact machineAppend_mem_FP (machineConst_mem_FP (List.replicate 8 false)) + id_mem_FP + simpa only [machineBinaryAddWidth, padded] using + Cobham.mulLenFn_mem_FP hpadded hpadded + +@[simp] theorem machineBinaryAddStep_pack + (x y accRev : List Bool) (carry : Bool) : + machineBinaryAddStep (machineBinaryAddPack x y [carry] accRev) = + if x = [] ∧ y = [] ∧ carry = false then + machineBinaryAddPack x y [carry] accRev + else + machineBinaryAddPack x.tail y.tail + [((x.head?.getD false && y.head?.getD false) || + (x.head?.getD false && carry) || + (y.head?.getD false && carry))] + (xor (xor (x.head?.getD false) (y.head?.getD false)) carry :: + accRev) := by + cases x with + | nil => + cases y with + | nil => cases carry <;> rfl + | cons y ys => + cases y <;> cases carry <;> + simp [machineBinaryAddStep, machineBinaryAddActive, + machineBinaryAddAdvanced, machineBinaryAddSumBit, + machineBinaryAddNextCarry, machineFullAdderSum, + machineFullAdderCarry, machineMajorityBit, machineXorBit, + machineAndBit, machineOrBit, machineNotBit] + | cons x xs => + cases x <;> cases y with + | nil => + cases carry <;> + simp [machineBinaryAddStep, machineBinaryAddActive, + machineBinaryAddAdvanced, machineBinaryAddSumBit, + machineBinaryAddNextCarry, machineFullAdderSum, + machineFullAdderCarry, machineMajorityBit, machineXorBit, + machineAndBit, machineOrBit, machineNotBit] + | cons y ys => + cases y <;> cases carry <;> + simp [machineBinaryAddStep, machineBinaryAddActive, + machineBinaryAddAdvanced, machineBinaryAddSumBit, + machineBinaryAddNextCarry, machineFullAdderSum, + machineFullAdderCarry, machineMajorityBit, machineXorBit, + machineAndBit, machineOrBit, machineNotBit] + +theorem machineBinaryAddStep_pack_length_le + (x y accRev : List Bool) (carry : Bool) : + (machineBinaryAddStep (machineBinaryAddPack x y [carry] accRev)).length ≤ + (machineBinaryAddPack x y [carry] accRev).length + 1 := by + rw [machineBinaryAddStep_pack] + split + · omega + · simp only [machineBinaryAddPack, pair_length, List.length_cons] + simp only [List.length_tail] + omega + +theorem machinePairFirst_length_le (word : List Bool) : + (machinePairFirst word).length ≤ word.length := by + change (Cobham.fstBlock word).length ≤ word.length + have hstrong : ∀ n : ℕ, ∀ word : List Bool, word.length = n → + (Cobham.fstBlock word).length ≤ word.length := by + intro n + induction n using Nat.strongRecOn with + | ind n ih => + intro word hlength + cases word with + | nil => rfl + | cons a word => + cases word with + | nil => simp [Cobham.fstBlock] + | cons b word => + have hrest := ih word.length (by simp at hlength; omega) + word rfl + cases a <;> cases b <;> + simp [Cobham.fstBlock, hrest] <;> omega + exact hstrong word.length word rfl + +theorem machinePairSecond_length_le (word : List Bool) : + (machinePairSecond word).length ≤ word.length := by + unfold machinePairSecond Cobham.sndBlock + cases hpair : unpair? word with + | none => simp + | some components => + obtain ⟨left, right⟩ := components + have hword : word = pair left right := + eq_pair_of_unpair?_eq_some hpair + subst word + simp + +/-- States reachable from the canonical pack retain a one-bit carry. -/ +def MachineBinaryAddWellFormed (state : List Bool) : Prop := + ∃ x y accRev : List Bool, ∃ carry : Bool, + state = machineBinaryAddPack x y [carry] accRev + +theorem machineBinaryAddInit_wellFormed (word : List Bool) : + MachineBinaryAddWellFormed (machineBinaryAddInit word) := by + exact ⟨machinePairFirst word, machinePairSecond word, [], false, rfl⟩ + +theorem machineBinaryAddStep_wellFormed {state : List Bool} + (hstate : MachineBinaryAddWellFormed state) : + MachineBinaryAddWellFormed (machineBinaryAddStep state) := by + obtain ⟨x, y, accRev, carry, rfl⟩ := hstate + rw [machineBinaryAddStep_pack] + split + · exact ⟨x, y, accRev, carry, rfl⟩ + · exact ⟨x.tail, y.tail, + xor (xor (x.head?.getD false) (y.head?.getD false)) carry :: accRev, + ((x.head?.getD false && y.head?.getD false) || + (x.head?.getD false && carry) || + (y.head?.getD false && carry)), rfl⟩ + +theorem machineBinaryAddIterate_wellFormed_length_le + {state : List Bool} (hstate : MachineBinaryAddWellFormed state) : + ∀ iterations : ℕ, + MachineBinaryAddWellFormed (machineBinaryAddStep^[iterations] state) ∧ + (machineBinaryAddStep^[iterations] state).length ≤ + state.length + iterations := by + intro iterations + induction iterations with + | zero => simpa using And.intro hstate (Nat.le_refl state.length) + | succ iterations ih => + rw [Function.iterate_succ_apply'] + obtain ⟨hwell, hlength⟩ := ih + have hnext := machineBinaryAddStep_wellFormed hwell + obtain ⟨x, y, accRev, carry, hrepr⟩ := hwell + have hstep := machineBinaryAddStep_pack_length_le x y accRev carry + rw [← hrepr] at hstep + refine ⟨hnext, ?_⟩ + omega + +theorem machineBinaryAddInit_length_le (word : List Bool) : + (machineBinaryAddInit word).length ≤ 4 * word.length + 8 := by + simp only [machineBinaryAddInit, machineBinaryAddPack, pair_length, + List.length_cons, List.length_nil] + have hfirst := machinePairFirst_length_le word + have hsecond := machinePairSecond_length_le word + omega + +theorem machineBinaryAddRuler_length_le (word : List Bool) : + (machineBinaryAddRuler word).length ≤ 2 * word.length + 1 := by + simp only [machineBinaryAddRuler, List.length_append, List.length_cons, + List.length_nil] + have hfirst := machinePairFirst_length_le word + have hsecond := machinePairSecond_length_le word + omega + +theorem machineBinaryAddWidth_length (word : List Bool) : + (machineBinaryAddWidth word).length = (word.length + 8) ^ 2 := by + simp [machineBinaryAddWidth, pow_two] + +theorem machineBinaryAddIterate_length_le_width + (word : List Bool) (iterations : ℕ) + (hiterations : iterations ≤ (machineBinaryAddRuler word).length) : + (machineBinaryAddStep^[iterations] (machineBinaryAddInit word)).length ≤ + (machineBinaryAddWidth word).length := by + have hiter := + (machineBinaryAddIterate_wellFormed_length_le + (machineBinaryAddInit_wellFormed word) iterations).2 + have hinit := machineBinaryAddInit_length_le word + have hruler := machineBinaryAddRuler_length_le word + rw [machineBinaryAddWidth_length] + nlinarith [sq_nonneg (word.length : ℤ)] + +/-- Final bounded-iteration state. -/ +def machineBinaryAddFinalState (word : List Bool) : List Bool := + machineBinaryAddStep^[(machineBinaryAddRuler word).length] + (machineBinaryAddInit word) + +/-- Machine-level binary addition. The final accumulator is reversed from +the transition-friendly most-recent-bit-first representation. -/ +def machineBinaryAddBits (word : List Bool) : List Bool := + (machineBinaryAddAccRev (machineBinaryAddFinalState word)).reverse + +theorem machineBinaryAddFinalState_mem_FP : + machineBinaryAddFinalState ∈ Complexity.FP := by + exact Cobham.iterate_mem_FP machineBinaryAddStep_mem_FP + machineBinaryAddInit_mem_FP machineBinaryAddRuler_mem_FP + machineBinaryAddWidth_mem_FP machineBinaryAddIterate_length_le_width + +theorem machineBinaryAddBits_mem_FP : + machineBinaryAddBits ∈ Complexity.FP := by + have hacc : + (fun word => machineBinaryAddAccRev + (machineBinaryAddFinalState word)) ∈ Complexity.FP := + machineCompose_mem_FP machineBinaryAddFinalState_mem_FP + machineBinaryAddAccRev_mem_FP + simpa only [machineBinaryAddBits] using + (machineCompose_mem_FP hacc machineReverse_mem_FP) + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryAddSemantics.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryAddSemantics.lean new file mode 100644 index 0000000000..6d0e75fa7e --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryAddSemantics.lean @@ -0,0 +1,210 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineBinaryAdd +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleAdd + +/-! +# Correctness of the composed polynomial-time binary adder + +The bounded Cobham loop in `MachineBinaryAdd` is proved here to implement the +same ripple-carry recurrence as Complexitylib's canonical binary adder. This +connects the concrete `FP` construction to arithmetic addition. +-/ + +namespace BeyondBethe + +open Complexity + +private theorem machineBinaryAddIterate_max + (x y accRev : List Bool) (carry : Bool) : + machineBinaryAddStep^[max x.length y.length + 1] + (machineBinaryAddPack x y [carry] accRev) = + machineBinaryAddPack [] [] [false] + ((BinaryRippleAdd.ripple carry x y).reverse ++ accRev) := by + induction hmeasure : x.length + y.length using Nat.strongRecOn + generalizing x y carry accRev with + | ind measure ih => + cases x with + | nil => + cases y with + | nil => + cases carry <;> + simp [machineBinaryAddStep_pack, BinaryRippleAdd.ripple, + Function.iterate_succ_apply] + | cons y ys => + simp only [List.length_nil, List.length_cons, Nat.zero_add] + at hmeasure + have hrec := ih ys.length (by omega) [] ys + (BinaryRippleAdd.sumBit carry false y :: accRev) + (BinaryRippleAdd.carryBit carry false y) (by simp) + have hrec' := hrec + simp only [List.length_nil] at hrec' + simp only [List.length_nil, List.length_cons] + rw [show max 0 (ys.length + 1) + 1 = + (max 0 ys.length + 1).succ by omega, + Function.iterate_succ_apply, machineBinaryAddStep_pack] + simp only [List.nil_eq, List.cons_ne_nil, and_false, + ↓reduceIte, List.tail_cons, List.tail_nil, List.head?_nil, + Option.getD_none, List.head?_cons, Option.getD_some] + simp only [true_and, false_and, ↓reduceIte] + rw [show + ((false && y) || (false && carry) || (y && carry)) = + BinaryRippleAdd.carryBit carry false y by + cases carry <;> cases y <;> rfl, + show xor (xor false y) carry = + BinaryRippleAdd.sumBit carry false y by + cases carry <;> cases y <;> rfl, + hrec'] + simp [BinaryRippleAdd.ripple, List.reverse_cons, + List.append_assoc] + | cons x xs => + cases y with + | nil => + simp only [List.length_nil, List.length_cons, Nat.add_zero] + at hmeasure + have hrec := ih xs.length (by omega) xs [] + (BinaryRippleAdd.sumBit carry x false :: accRev) + (BinaryRippleAdd.carryBit carry x false) (by simp) + have hrec' := hrec + simp only [List.length_nil] at hrec' + simp only [List.length_nil, List.length_cons] + rw [show max (xs.length + 1) 0 + 1 = + (max xs.length 0 + 1).succ by omega, + Function.iterate_succ_apply, machineBinaryAddStep_pack] + simp only [List.cons_ne_nil, List.nil_eq, and_false, + ↓reduceIte, List.tail_cons, List.tail_nil, List.head?_cons, + Option.getD_some, List.head?_nil, Option.getD_none] + simp only [false_and, ↓reduceIte] + rw [show + ((x && false) || (x && carry) || (false && carry)) = + BinaryRippleAdd.carryBit carry x false by + cases carry <;> cases x <;> rfl, + show xor (xor x false) carry = + BinaryRippleAdd.sumBit carry x false by + cases carry <;> cases x <;> rfl, + hrec'] + simp [BinaryRippleAdd.ripple, List.reverse_cons, + List.append_assoc] + | cons y ys => + simp only [List.length_cons] at hmeasure + have hrec := ih (xs.length + ys.length) (by omega) + xs ys + (BinaryRippleAdd.sumBit carry x y :: accRev) + (BinaryRippleAdd.carryBit carry x y) rfl + simp only [List.length_cons] + rw [show max (xs.length + 1) (ys.length + 1) + 1 = + (max xs.length ys.length + 1).succ by omega, + Function.iterate_succ_apply, machineBinaryAddStep_pack] + simp only [List.cons_ne_nil, and_false, ↓reduceIte, + List.tail_cons, List.head?_cons, Option.getD_some] + simp only [false_and, ↓reduceIte] + rw [show + ((x && y) || (x && carry) || (y && carry)) = + BinaryRippleAdd.carryBit carry x y by + cases carry <;> cases x <;> cases y <;> rfl, + show xor (xor x y) carry = + BinaryRippleAdd.sumBit carry x y by + cases carry <;> cases x <;> cases y <;> rfl, + hrec] + simp [BinaryRippleAdd.ripple, List.reverse_cons, + List.append_assoc] + +private theorem machineBinaryAddStep_done (accRev : List Bool) : + machineBinaryAddStep (machineBinaryAddPack [] [] [false] accRev) = + machineBinaryAddPack [] [] [false] accRev := by + rw [machineBinaryAddStep_pack] + simp + +private theorem machineBinaryAddIterate_done (accRev : List Bool) (k : ℕ) : + machineBinaryAddStep^[k] + (machineBinaryAddPack [] [] [false] accRev) = + machineBinaryAddPack [] [] [false] accRev := by + induction k with + | zero => rfl + | succ k ih => + rw [Function.iterate_succ_apply, machineBinaryAddStep_done, ih] + +/-- The composed adder agrees with ripple carry on arbitrary operand words. +This stronger total-input statement is what later arithmetic machines use for +their size bounds; canonicality is needed only when interpreting the answer as +`Nat.bits`. -/ +theorem machineBinaryAddBits_pair_lists (x y : List Bool) : + machineBinaryAddBits (pair x y) = + BinaryRippleAdd.ripple false x y := by + simp only [machineBinaryAddBits, machineBinaryAddFinalState, + machineBinaryAddRuler, machineBinaryAddInit, machinePairFirst_pair, + machinePairSecond_pair, List.length_append, List.length_cons, + List.length_nil] + rw [show x.length + y.length + 1 = + min x.length y.length + (max x.length y.length + 1) by + have hminmax := min_add_max x.length y.length + omega, + Function.iterate_add_apply, machineBinaryAddIterate_max, + machineBinaryAddIterate_done] + simp [machineBinaryAddAccRev, machineBinaryAddPack] + +/-- Ripple carry emits at most one bit beyond the longer input word. -/ +theorem binaryRippleAdd_length_le : ∀ (carry : Bool) (x y : List Bool), + (BinaryRippleAdd.ripple carry x y).length ≤ + max x.length y.length + 1 := by + intro carry x y + induction x generalizing carry y with + | nil => + induction y generalizing carry with + | nil => cases carry <;> simp [BinaryRippleAdd.ripple] + | cons bit rest ih => + simp only [BinaryRippleAdd.ripple, List.length_cons, + List.length_nil] + have hrec := ih (BinaryRippleAdd.carryBit carry false bit) + have hrec' : + (BinaryRippleAdd.ripple + (BinaryRippleAdd.carryBit carry false bit) [] rest).length ≤ + rest.length + 1 := by + simpa using hrec + omega + | cons bit rest ih => + cases y with + | nil => + simp only [BinaryRippleAdd.ripple, List.length_cons, + List.length_nil] + have hrec := ih (BinaryRippleAdd.carryBit carry bit false) [] + have hrec' : + (BinaryRippleAdd.ripple + (BinaryRippleAdd.carryBit carry bit false) rest []).length ≤ + rest.length + 1 := by + simpa using hrec + omega + | cons other tail => + simp only [BinaryRippleAdd.ripple, List.length_cons] + have hrec := ih (BinaryRippleAdd.carryBit carry bit other) tail + omega + +theorem machineBinaryAddBits_pair_length_le (x y : List Bool) : + (machineBinaryAddBits (pair x y)).length ≤ + max x.length y.length + 1 := by + rw [machineBinaryAddBits_pair_lists] + exact binaryRippleAdd_length_le false x y + +/-- The composed bounded-loop machine returns the canonical binary expansion +of the sum of canonically encoded natural-number inputs. -/ +theorem machineBinaryAddBits_pair_natBits (x y : ℕ) : + machineBinaryAddBits (pair x.bits y.bits) = (x + y).bits := by + simp only [machineBinaryAddBits, machineBinaryAddFinalState, + machineBinaryAddRuler, machineBinaryAddInit, machinePairFirst_pair, + machinePairSecond_pair, List.length_append, List.length_cons, + List.length_nil] + rw [show x.bits.length + y.bits.length + 1 = + min x.bits.length y.bits.length + + (max x.bits.length y.bits.length + 1) by + have hminmax := min_add_max x.bits.length y.bits.length + omega, + Function.iterate_add_apply, machineBinaryAddIterate_max, + machineBinaryAddIterate_done] + simp [machineBinaryAddAccRev, machineBinaryAddPack, + BinaryRippleAdd.ripple_natBits] + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryCompare.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryCompare.lean new file mode 100644 index 0000000000..1c0b89c275 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryCompare.lean @@ -0,0 +1,106 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineBinarySub + +/-! +# Polynomial-time comparison of canonical binary naturals + +Truncated subtraction is zero exactly when the left operand is at most the +right. This gives compact comparison machines while reusing the fully +verified borrow scan. +-/ + +namespace BeyondBethe + +open Complexity + +def machineBinaryNatLeBit (word : List Bool) : List Bool := + machineIfEmpty (machineBinarySubBits word) [true] [false] + +def machineBinaryNatLtBit (word : List Bool) : List Bool := + let swapped := pair (machinePairSecond word) (machinePairFirst word) + machineIfEmpty (machineBinarySubBits swapped) [false] [true] + +def machineBinaryNatEqBit (word : List Bool) : List Bool := + machineAndBit (machineBinaryNatLeBit word) + (machineBinaryNatLeBit + (pair (machinePairSecond word) (machinePairFirst word))) + +theorem machineBinaryNatLeBit_mem_FP : + machineBinaryNatLeBit ∈ Complexity.FP := by + simpa only [machineBinaryNatLeBit] using + machineIfEmpty_mem_FP machineBinarySubBits_mem_FP + (machineConst_mem_FP [true]) (machineConst_mem_FP [false]) + +theorem machineBinaryNatLtBit_mem_FP : + machineBinaryNatLtBit ∈ Complexity.FP := by + have hswap : (fun word => pair (machinePairSecond word) + (machinePairFirst word)) ∈ Complexity.FP := + machinePair_mem_FP machinePairSecond_mem_FP machinePairFirst_mem_FP + have hsub := machineCompose_mem_FP hswap machineBinarySubBits_mem_FP + simpa only [machineBinaryNatLtBit] using + machineIfEmpty_mem_FP hsub (machineConst_mem_FP [false]) + (machineConst_mem_FP [true]) + +theorem machineBinaryNatEqBit_mem_FP : + machineBinaryNatEqBit ∈ Complexity.FP := by + have hswap : (fun word => pair (machinePairSecond word) + (machinePairFirst word)) ∈ Complexity.FP := + machinePair_mem_FP machinePairSecond_mem_FP machinePairFirst_mem_FP + have hswappedLe := machineCompose_mem_FP hswap machineBinaryNatLeBit_mem_FP + simpa only [machineBinaryNatEqBit] using + machineAndBit_mem_FP machineBinaryNatLeBit_mem_FP hswappedLe + +theorem machineBinaryNatLeBit_pair_natBits (lhs rhs : ℕ) : + machineBinaryNatLeBit (pair lhs.bits rhs.bits) = [decide (lhs ≤ rhs)] := by + rw [machineBinaryNatLeBit, machineBinarySubBits_pair_natBits] + by_cases h : lhs ≤ rhs + · have hzero : lhs - rhs = 0 := Nat.sub_eq_zero_of_le h + rw [hzero] + simp [h] + · have hpos : 0 < lhs - rhs := Nat.sub_pos_of_lt (Nat.lt_of_not_ge h) + cases hbits : (lhs - rhs).bits with + | nil => + have hlen : (lhs - rhs).bits.length = 0 := by rw [hbits]; rfl + have hsize : (lhs - rhs).size = 0 := by + simpa only [Nat.size_eq_bits_len] using hlen + have := Nat.size_eq_zero.mp hsize + omega + | cons bit rest => simp [hbits, h] + +theorem machineBinaryNatLtBit_pair_natBits (lhs rhs : ℕ) : + machineBinaryNatLtBit (pair lhs.bits rhs.bits) = [decide (lhs < rhs)] := by + simp only [machineBinaryNatLtBit, machinePairFirst_pair, + machinePairSecond_pair, machineBinarySubBits_pair_natBits] + by_cases h : lhs < rhs + · have hpos : 0 < rhs - lhs := Nat.sub_pos_of_lt h + cases hbits : (rhs - lhs).bits with + | nil => + have hlen : (rhs - lhs).bits.length = 0 := by rw [hbits]; rfl + have hsize : (rhs - lhs).size = 0 := by + simpa only [Nat.size_eq_bits_len] using hlen + have := Nat.size_eq_zero.mp hsize + omega + | cons bit rest => simp [hbits, h] + · have hzero : rhs - lhs = 0 := Nat.sub_eq_zero_of_le (Nat.le_of_not_gt h) + rw [hzero] + simp [h] + +theorem machineBinaryNatEqBit_pair_natBits (lhs rhs : ℕ) : + machineBinaryNatEqBit (pair lhs.bits rhs.bits) = [decide (lhs = rhs)] := by + simp only [machineBinaryNatEqBit, machinePairFirst_pair, + machinePairSecond_pair, machineBinaryNatLeBit_pair_natBits] + by_cases h : lhs = rhs + · subst rhs + simp + · have hnotboth : ¬ (lhs ≤ rhs ∧ rhs ≤ lhs) := by + exact fun hboth => h (Nat.le_antisymm hboth.1 hboth.2) + rcases not_and_or.mp hnotboth with hleft | hright + · simp [h, hleft] + · simp [h, hright] + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryDivision.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryDivision.lean new file mode 100644 index 0000000000..da111a540e --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryDivision.lean @@ -0,0 +1,675 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineBinaryCompare +import LeanPool.BeyondBethe.BeyondBethe.BinaryLongDivision + +/-! +# Polynomial-time binary long division + +The machine reverses the little-endian dividend and performs the usual +most-significant-bit-first long-division recurrence. Its state stores the +unread bits, the fixed divisor, quotient, and remainder. All arithmetic and +tests are the previously verified `FP` bitstring routines. +-/ + +namespace BeyondBethe + +open Complexity + +def machineBinaryDivPack + (remaining divisor quotient remainder : List Bool) : List Bool := + pair remaining (pair divisor (pair quotient remainder)) + +def machineBinaryDivRemaining (state : List Bool) : List Bool := + machinePairFirst state + +def machineBinaryDivDivisor (state : List Bool) : List Bool := + machinePairFirst (machinePairSecond state) + +def machineBinaryDivQuotient (state : List Bool) : List Bool := + machinePairFirst (machinePairSecond (machinePairSecond state)) + +def machineBinaryDivRemainder (state : List Bool) : List Bool := + machinePairSecond (machinePairSecond (machinePairSecond state)) + +def machineBinaryDivDoubleQuotient (state : List Bool) : List Bool := + machineBinaryAddBits + (pair (machineBinaryDivQuotient state) + (machineBinaryDivQuotient state)) + +def machineBinaryDivDoubleRemainder (state : List Bool) : List Bool := + machineBinaryAddBits + (pair (machineBinaryDivRemainder state) + (machineBinaryDivRemainder state)) + +def machineBinaryDivTrial (state : List Bool) : List Bool := + machineIfHead (machineHeadBit (machineBinaryDivRemaining state)) + (machineBinaryAddBits + (pair (machineBinaryDivDoubleRemainder state) [true])) + (machineBinaryDivDoubleRemainder state) + +def machineBinaryDivTake (state : List Bool) : List Bool := + machineIfEmpty (machineBinaryDivDivisor state) [false] + (machineBinaryNatLeBit + (pair (machineBinaryDivDivisor state) (machineBinaryDivTrial state))) + +def machineBinaryDivIncrementedQuotient (state : List Bool) : List Bool := + machineBinaryAddBits + (pair (machineBinaryDivDoubleQuotient state) [true]) + +def machineBinaryDivNextQuotient (state : List Bool) : List Bool := + machineIfEmpty (machineBinaryDivDivisor state) [] + (machineIfHead (machineBinaryDivTake state) + (machineBinaryDivIncrementedQuotient state) + (machineBinaryDivDoubleQuotient state)) + +def machineBinaryDivNextRemainder (state : List Bool) : List Bool := + machineIfHead (machineBinaryDivTake state) + (machineBinarySubBits + (pair (machineBinaryDivTrial state) (machineBinaryDivDivisor state))) + (machineBinaryDivTrial state) + +def machineBinaryDivStep (state : List Bool) : List Bool := + machineBinaryDivPack (machineBinaryDivRemaining state).tail + (machineBinaryDivDivisor state) + (machineBinaryDivNextQuotient state) + (machineBinaryDivNextRemainder state) + +def machineBinaryDivInit (word : List Bool) : List Bool := + machineBinaryDivPack (machinePairFirst word).reverse + (machinePairSecond word) [] [] + +def machineBinaryDivRuler (word : List Bool) : List Bool := + machinePairFirst word + +def machineBinaryDivWidth (word : List Bool) : List Bool := + let padded := List.replicate 16 false ++ word + List.replicate (padded.length * padded.length) false + +def machineBinaryDivFinalState (word : List Bool) : List Bool := + machineBinaryDivStep^[(machineBinaryDivRuler word).length] + (machineBinaryDivInit word) + +/-- Paired canonical quotient and remainder words. -/ +def machineBinaryDivModBits (word : List Bool) : List Bool := + pair (machineBinaryDivQuotient (machineBinaryDivFinalState word)) + (machineBinaryDivRemainder (machineBinaryDivFinalState word)) + +theorem machineBinaryDivRemaining_mem_FP : + machineBinaryDivRemaining ∈ Complexity.FP := by + simpa only [machineBinaryDivRemaining] using machinePairFirst_mem_FP + +theorem machineBinaryDivDivisor_mem_FP : + machineBinaryDivDivisor ∈ Complexity.FP := by + simpa only [machineBinaryDivDivisor] using + machineCompose_mem_FP machinePairSecond_mem_FP machinePairFirst_mem_FP + +theorem machineBinaryDivQuotient_mem_FP : + machineBinaryDivQuotient ∈ Complexity.FP := by + have hsecond2 : (fun word => machinePairSecond (machinePairSecond word)) ∈ + Complexity.FP := + machineCompose_mem_FP machinePairSecond_mem_FP machinePairSecond_mem_FP + simpa only [machineBinaryDivQuotient] using + machineCompose_mem_FP hsecond2 machinePairFirst_mem_FP + +theorem machineBinaryDivRemainder_mem_FP : + machineBinaryDivRemainder ∈ Complexity.FP := by + have hsecond2 : (fun word => machinePairSecond (machinePairSecond word)) ∈ + Complexity.FP := + machineCompose_mem_FP machinePairSecond_mem_FP machinePairSecond_mem_FP + simpa only [machineBinaryDivRemainder] using + machineCompose_mem_FP hsecond2 machinePairSecond_mem_FP + +theorem machineBinaryDivPack_mem_FP + {remaining divisor quotient remainder : List Bool → List Bool} + (hremaining : remaining ∈ Complexity.FP) + (hdivisor : divisor ∈ Complexity.FP) + (hquotient : quotient ∈ Complexity.FP) + (hremainder : remainder ∈ Complexity.FP) : + (fun word => machineBinaryDivPack (remaining word) (divisor word) + (quotient word) (remainder word)) ∈ Complexity.FP := by + exact machinePair_mem_FP hremaining + (machinePair_mem_FP hdivisor + (machinePair_mem_FP hquotient hremainder)) + +theorem machineBinaryDivDoubleQuotient_mem_FP : + machineBinaryDivDoubleQuotient ∈ Complexity.FP := by + have hpair : (fun state => pair (machineBinaryDivQuotient state) + (machineBinaryDivQuotient state)) ∈ Complexity.FP := + machinePair_mem_FP machineBinaryDivQuotient_mem_FP + machineBinaryDivQuotient_mem_FP + simpa only [machineBinaryDivDoubleQuotient] using + machineCompose_mem_FP hpair machineBinaryAddBits_mem_FP + +theorem machineBinaryDivDoubleRemainder_mem_FP : + machineBinaryDivDoubleRemainder ∈ Complexity.FP := by + have hpair : (fun state => pair (machineBinaryDivRemainder state) + (machineBinaryDivRemainder state)) ∈ Complexity.FP := + machinePair_mem_FP machineBinaryDivRemainder_mem_FP + machineBinaryDivRemainder_mem_FP + simpa only [machineBinaryDivDoubleRemainder] using + machineCompose_mem_FP hpair machineBinaryAddBits_mem_FP + +theorem machineBinaryDivTrial_mem_FP : + machineBinaryDivTrial ∈ Complexity.FP := by + have hflag : (fun state => machineHeadBit + (machineBinaryDivRemaining state)) ∈ Complexity.FP := + machineCompose_mem_FP machineBinaryDivRemaining_mem_FP + machineHeadBit_mem_FP + have hpair : (fun state => pair + (machineBinaryDivDoubleRemainder state) [true]) ∈ Complexity.FP := + machinePair_mem_FP machineBinaryDivDoubleRemainder_mem_FP + (machineConst_mem_FP [true]) + have hone := machineCompose_mem_FP hpair machineBinaryAddBits_mem_FP + simpa only [machineBinaryDivTrial] using + machineIfHead_mem_FP hflag hone machineBinaryDivDoubleRemainder_mem_FP + +theorem machineBinaryDivTake_mem_FP : + machineBinaryDivTake ∈ Complexity.FP := by + have hpair : (fun state => pair (machineBinaryDivDivisor state) + (machineBinaryDivTrial state)) ∈ Complexity.FP := + machinePair_mem_FP machineBinaryDivDivisor_mem_FP + machineBinaryDivTrial_mem_FP + have hle := machineCompose_mem_FP hpair machineBinaryNatLeBit_mem_FP + simpa only [machineBinaryDivTake] using + machineIfEmpty_mem_FP machineBinaryDivDivisor_mem_FP + (machineConst_mem_FP [false]) hle + +theorem machineBinaryDivIncrementedQuotient_mem_FP : + machineBinaryDivIncrementedQuotient ∈ Complexity.FP := by + have hpair : (fun state => pair + (machineBinaryDivDoubleQuotient state) [true]) ∈ Complexity.FP := + machinePair_mem_FP machineBinaryDivDoubleQuotient_mem_FP + (machineConst_mem_FP [true]) + simpa only [machineBinaryDivIncrementedQuotient] using + machineCompose_mem_FP hpair machineBinaryAddBits_mem_FP + +theorem machineBinaryDivNextQuotient_mem_FP : + machineBinaryDivNextQuotient ∈ Complexity.FP := by + have hnonzero := machineIfHead_mem_FP machineBinaryDivTake_mem_FP + machineBinaryDivIncrementedQuotient_mem_FP + machineBinaryDivDoubleQuotient_mem_FP + simpa only [machineBinaryDivNextQuotient] using + machineIfEmpty_mem_FP machineBinaryDivDivisor_mem_FP + (machineConst_mem_FP []) hnonzero + +theorem machineBinaryDivNextRemainder_mem_FP : + machineBinaryDivNextRemainder ∈ Complexity.FP := by + have hpair : (fun state => pair (machineBinaryDivTrial state) + (machineBinaryDivDivisor state)) ∈ Complexity.FP := + machinePair_mem_FP machineBinaryDivTrial_mem_FP + machineBinaryDivDivisor_mem_FP + have hsub := machineCompose_mem_FP hpair machineBinarySubBits_mem_FP + simpa only [machineBinaryDivNextRemainder] using + machineIfHead_mem_FP machineBinaryDivTake_mem_FP hsub + machineBinaryDivTrial_mem_FP + +theorem machineBinaryDivStep_mem_FP : + machineBinaryDivStep ∈ Complexity.FP := by + exact machineBinaryDivPack_mem_FP + (machineCompose_mem_FP machineBinaryDivRemaining_mem_FP machineTail_mem_FP) + machineBinaryDivDivisor_mem_FP machineBinaryDivNextQuotient_mem_FP + machineBinaryDivNextRemainder_mem_FP + +theorem machineBinaryDivInit_mem_FP : + machineBinaryDivInit ∈ Complexity.FP := by + have hreverse := machineCompose_mem_FP machinePairFirst_mem_FP + machineReverse_mem_FP + exact machineBinaryDivPack_mem_FP hreverse machinePairSecond_mem_FP + (machineConst_mem_FP []) (machineConst_mem_FP []) + +theorem machineBinaryDivRuler_mem_FP : + machineBinaryDivRuler ∈ Complexity.FP := by + simpa only [machineBinaryDivRuler] using machinePairFirst_mem_FP + +theorem machineBinaryDivWidth_mem_FP : + machineBinaryDivWidth ∈ Complexity.FP := by + let padded : List Bool → List Bool := + fun word => List.replicate 16 false ++ word + have hpadded : padded ∈ Complexity.FP := + machineAppend_mem_FP (machineConst_mem_FP (List.replicate 16 false)) + id_mem_FP + simpa only [machineBinaryDivWidth, padded] using + Cobham.mulLenFn_mem_FP hpadded hpadded + +@[simp] theorem machineBinaryDivRemaining_pack (remaining divisor quotient remainder) : + machineBinaryDivRemaining + (machineBinaryDivPack remaining divisor quotient remainder) = + remaining := by simp [machineBinaryDivRemaining, machineBinaryDivPack] + +@[simp] theorem machineBinaryDivDivisor_pack (remaining divisor quotient remainder) : + machineBinaryDivDivisor + (machineBinaryDivPack remaining divisor quotient remainder) = + divisor := by simp [machineBinaryDivDivisor, machineBinaryDivPack] + +@[simp] theorem machineBinaryDivQuotient_pack (remaining divisor quotient remainder) : + machineBinaryDivQuotient + (machineBinaryDivPack remaining divisor quotient remainder) = + quotient := by simp [machineBinaryDivQuotient, machineBinaryDivPack] + +@[simp] theorem machineBinaryDivRemainder_pack (remaining divisor quotient remainder) : + machineBinaryDivRemainder + (machineBinaryDivPack remaining divisor quotient remainder) = + remainder := by simp [machineBinaryDivRemainder, machineBinaryDivPack] + +def MachineBinaryDivReachable + (dividend divisor : List Bool) (iterations : ℕ) + (state : List Bool) : Prop := + ∃ remaining quotient remainder, + state = machineBinaryDivPack remaining divisor quotient remainder ∧ + remaining.length ≤ dividend.length ∧ + quotient.length ≤ 2 * iterations ∧ + remainder.length ≤ divisor.length + 2 * iterations + +theorem machineIfEmpty_length_le_max (test whenEmpty whenNonempty : List Bool) : + (machineIfEmpty test whenEmpty whenNonempty).length ≤ + max whenEmpty.length whenNonempty.length := by + cases test with + | nil => simp + | cons bit tail => simp + +theorem machineIfEmpty_of_ne_nil (test whenEmpty whenNonempty : List Bool) + (htest : test ≠ []) : + machineIfEmpty test whenEmpty whenNonempty = whenNonempty := by + cases test with + | nil => exact False.elim (htest rfl) + | cons bit tail => simp + +theorem machineIfHead_length_le_max (flag whenTrue whenFalse : List Bool) : + (machineIfHead flag whenTrue whenFalse).length ≤ + max whenTrue.length whenFalse.length := by + cases flag with + | nil => simp [machineIfHead, Cobham.selectHead] + | cons bit tail => cases bit <;> simp + +theorem machineBinaryDivInit_reachable (word : List Bool) : + MachineBinaryDivReachable (machinePairFirst word) + (machinePairSecond word) 0 (machineBinaryDivInit word) := by + refine ⟨(machinePairFirst word).reverse, [], [], rfl, ?_, by simp, by simp⟩ + simp + +theorem machineBinaryDivDoubleQuotient_length_le + (remaining divisor quotient remainder : List Bool) : + (machineBinaryDivDoubleQuotient + (machineBinaryDivPack remaining divisor quotient remainder)).length ≤ + quotient.length + 1 := by + simp only [machineBinaryDivDoubleQuotient, machineBinaryDivQuotient_pack] + simpa using machineBinaryAddBits_pair_length_le quotient quotient + +theorem machineBinaryDivDoubleRemainder_length_le + (remaining divisor quotient remainder : List Bool) : + (machineBinaryDivDoubleRemainder + (machineBinaryDivPack remaining divisor quotient remainder)).length ≤ + remainder.length + 1 := by + simp only [machineBinaryDivDoubleRemainder, machineBinaryDivRemainder_pack] + simpa using machineBinaryAddBits_pair_length_le remainder remainder + +theorem machineBinaryDivTrial_length_le + (remaining divisor quotient remainder : List Bool) : + (machineBinaryDivTrial + (machineBinaryDivPack remaining divisor quotient remainder)).length ≤ + remainder.length + 2 := by + cases remaining with + | nil => + simp [machineBinaryDivTrial] + have h := machineBinaryDivDoubleRemainder_length_le + [] divisor quotient remainder + omega + | cons bit remaining => + cases bit with + | false => + simp [machineBinaryDivTrial] + have h := machineBinaryDivDoubleRemainder_length_le + (false :: remaining) divisor quotient remainder + omega + | true => + simp only [machineBinaryDivTrial, machineBinaryDivRemaining_pack, + machineHeadBit_cons, machineIfHead_true] + have hdouble := machineBinaryDivDoubleRemainder_length_le + (true :: remaining) divisor quotient remainder + have hadd := machineBinaryAddBits_pair_length_le + (machineBinaryDivDoubleRemainder + (machineBinaryDivPack (true :: remaining) divisor quotient remainder)) + [true] + have hmax : max + (machineBinaryDivDoubleRemainder + (machineBinaryDivPack (true :: remaining) divisor quotient remainder)).length + [true].length ≤ remainder.length + 1 := by + apply max_le + · exact hdouble + · simp + omega + +theorem machineBinaryDivStep_reachable + {dividend divisor : List Bool} {iterations : ℕ} {state : List Bool} + (hstate : MachineBinaryDivReachable dividend divisor iterations state) : + MachineBinaryDivReachable dividend divisor (iterations + 1) + (machineBinaryDivStep state) := by + obtain ⟨remaining, quotient, remainder, rfl, hremaining, hquotient, + hremainder⟩ := hstate + simp only [machineBinaryDivStep, machineBinaryDivRemaining_pack, + machineBinaryDivDivisor_pack] + refine ⟨remaining.tail, + machineBinaryDivNextQuotient + (machineBinaryDivPack remaining divisor quotient remainder), + machineBinaryDivNextRemainder + (machineBinaryDivPack remaining divisor quotient remainder), + rfl, ?_, ?_, ?_⟩ + · have htail : remaining.tail.length ≤ remaining.length := by + cases remaining <;> simp + exact htail.trans hremaining + · simp only [machineBinaryDivNextQuotient, machineBinaryDivDivisor_pack] + have hdouble := machineBinaryDivDoubleQuotient_length_le + remaining divisor quotient remainder + have hinc := machineBinaryAddBits_pair_length_le + (machineBinaryDivDoubleQuotient + (machineBinaryDivPack remaining divisor quotient remainder)) [true] + have hmaxDouble : max + (machineBinaryDivDoubleQuotient + (machineBinaryDivPack remaining divisor quotient remainder)).length + [true].length ≤ quotient.length + 1 := by + apply max_le + · exact hdouble + · simp + have hinc' : + (machineBinaryDivIncrementedQuotient + (machineBinaryDivPack remaining divisor quotient remainder)).length ≤ + quotient.length + 2 := by + simpa only [machineBinaryDivIncrementedQuotient] using + hinc.trans (Nat.add_le_add_right hmaxDouble 1) + have hnonzero := machineIfHead_length_le_max + (machineBinaryDivTake + (machineBinaryDivPack remaining divisor quotient remainder)) + (machineBinaryDivIncrementedQuotient + (machineBinaryDivPack remaining divisor quotient remainder)) + (machineBinaryDivDoubleQuotient + (machineBinaryDivPack remaining divisor quotient remainder)) + have houter := machineIfEmpty_length_le_max divisor [] + (machineIfHead + (machineBinaryDivTake + (machineBinaryDivPack remaining divisor quotient remainder)) + (machineBinaryDivIncrementedQuotient + (machineBinaryDivPack remaining divisor quotient remainder)) + (machineBinaryDivDoubleQuotient + (machineBinaryDivPack remaining divisor quotient remainder))) + simp only [List.length_nil, zero_le, max_eq_right] at houter + omega + · simp only [machineBinaryDivNextRemainder, machineBinaryDivDivisor_pack] + have htrial := machineBinaryDivTrial_length_le + remaining divisor quotient remainder + have hsub := machineBinarySubBits_pair_length_le + (machineBinaryDivTrial + (machineBinaryDivPack remaining divisor quotient remainder)) divisor + have hsub' : + (machineBinarySubBits + (pair (machineBinaryDivTrial + (machineBinaryDivPack remaining divisor quotient remainder)) + divisor)).length ≤ divisor.length + 2 * (iterations + 1) := by + apply hsub.trans + apply max_le + · omega + · omega + have hselect := machineIfHead_length_le_max + (machineBinaryDivTake + (machineBinaryDivPack remaining divisor quotient remainder)) + (machineBinarySubBits + (pair (machineBinaryDivTrial + (machineBinaryDivPack remaining divisor quotient remainder)) divisor)) + (machineBinaryDivTrial + (machineBinaryDivPack remaining divisor quotient remainder)) + have htrial' : + (machineBinaryDivTrial + (machineBinaryDivPack remaining divisor quotient remainder)).length ≤ + divisor.length + 2 * (iterations + 1) := by omega + exact hselect.trans (max_le hsub' htrial') + +theorem machineBinaryDivIterate_reachable (word : List Bool) : + ∀ iterations, + MachineBinaryDivReachable (machinePairFirst word) + (machinePairSecond word) iterations + (machineBinaryDivStep^[iterations] (machineBinaryDivInit word)) := by + intro iterations + induction iterations with + | zero => exact machineBinaryDivInit_reachable word + | succ iterations ih => + rw [Function.iterate_succ_apply'] + simpa [Nat.succ_eq_add_one] using machineBinaryDivStep_reachable ih + +theorem machineBinaryDivIterate_length_le_width + (word : List Bool) (iterations : ℕ) + (hiterations : iterations ≤ (machineBinaryDivRuler word).length) : + (machineBinaryDivStep^[iterations] + (machineBinaryDivInit word)).length ≤ + (machineBinaryDivWidth word).length := by + obtain ⟨remaining, quotient, remainder, hstate, hremaining, + hquotient, hremainder⟩ := machineBinaryDivIterate_reachable word iterations + rw [hstate] + have hdividend := machinePairFirst_length_le word + have hdivisor := machinePairSecond_length_le word + have hit : iterations ≤ word.length := hiterations.trans hdividend + simp only [machineBinaryDivPack, pair_length, machineBinaryDivWidth, + List.length_replicate, List.length_append] + nlinarith + +theorem machineBinaryDivFinalState_mem_FP : + machineBinaryDivFinalState ∈ Complexity.FP := by + exact Cobham.iterate_mem_FP machineBinaryDivStep_mem_FP + machineBinaryDivInit_mem_FP machineBinaryDivRuler_mem_FP + machineBinaryDivWidth_mem_FP machineBinaryDivIterate_length_le_width + +theorem machineBinaryDivModBits_mem_FP : + machineBinaryDivModBits ∈ Complexity.FP := by + have hquotient := machineCompose_mem_FP machineBinaryDivFinalState_mem_FP + machineBinaryDivQuotient_mem_FP + have hremainder := machineCompose_mem_FP machineBinaryDivFinalState_mem_FP + machineBinaryDivRemainder_mem_FP + simpa only [machineBinaryDivModBits] using + machinePair_mem_FP hquotient hremainder + +/-- Forward form of the semantic recurrence, on most-significant-first bits. -/ +def binaryLongDivForward (divisor : ℕ) : + List Bool → ℕ × ℕ → ℕ × ℕ + | [], qr => qr + | bit :: remaining, qr => + binaryLongDivForward divisor remaining + (binaryLongDivStep divisor bit qr) + +theorem binaryLongDivForward_append (divisor : ℕ) + (first second : List Bool) (qr : ℕ × ℕ) : + binaryLongDivForward divisor (first ++ second) qr = + binaryLongDivForward divisor second + (binaryLongDivForward divisor first qr) := by + induction first generalizing qr with + | nil => rfl + | cons bit remaining ih => + simp only [List.cons_append, binaryLongDivForward] + exact ih (binaryLongDivStep divisor bit qr) + +theorem binaryLongDivForward_reverse (divisor : ℕ) (bits : List Bool) : + binaryLongDivForward divisor bits.reverse (0, 0) = + binaryLongDivBits divisor bits := by + induction bits with + | nil => rfl + | cons bit remaining ih => + rw [List.reverse_cons, binaryLongDivForward_append] + simp only [binaryLongDivForward] + rw [ih] + rfl + +theorem natBits_ne_nil_of_ne_zero {n : ℕ} (hn : n ≠ 0) : n.bits ≠ [] := by + intro hbits + have hlen : n.bits.length = 0 := by simp [hbits] + have hsize : n.size = 0 := by + simpa only [Nat.size_eq_bits_len] using hlen + exact hn (Nat.size_eq_zero.mp hsize) + +@[simp] theorem machineBinaryDivDoubleQuotient_pack_natBits + (remaining : List Bool) (divisor quotient remainder : ℕ) : + machineBinaryDivDoubleQuotient + (machineBinaryDivPack remaining divisor.bits quotient.bits remainder.bits) = + (quotient + quotient).bits := by + simp only [machineBinaryDivDoubleQuotient, machineBinaryDivQuotient_pack] + exact machineBinaryAddBits_pair_natBits quotient quotient + +@[simp] theorem machineBinaryDivDoubleRemainder_pack_natBits + (remaining : List Bool) (divisor quotient remainder : ℕ) : + machineBinaryDivDoubleRemainder + (machineBinaryDivPack remaining divisor.bits quotient.bits remainder.bits) = + (remainder + remainder).bits := by + simp only [machineBinaryDivDoubleRemainder, machineBinaryDivRemainder_pack] + exact machineBinaryAddBits_pair_natBits remainder remainder + +@[simp] theorem machineBinaryDivTrial_pack_natBits + (bit : Bool) (remaining : List Bool) (divisor quotient remainder : ℕ) : + machineBinaryDivTrial + (machineBinaryDivPack (bit :: remaining) divisor.bits + quotient.bits remainder.bits) = + (remainder + remainder + bitValue bit).bits := by + cases bit with + | false => simp [machineBinaryDivTrial, bitValue] + | true => + simp only [machineBinaryDivTrial, machineBinaryDivRemaining_pack, + machineHeadBit_cons, machineIfHead_true, + machineBinaryDivDoubleRemainder_pack_natBits, bitValue] + simpa using machineBinaryAddBits_pair_natBits (remainder + remainder) 1 + +@[simp] theorem machineBinaryDivTake_pack_natBits + (bit : Bool) (remaining : List Bool) (divisor quotient remainder : ℕ) : + machineBinaryDivTake + (machineBinaryDivPack (bit :: remaining) divisor.bits + quotient.bits remainder.bits) = + if divisor = 0 then [false] + else [(divisor ≤ remainder + remainder + bitValue bit)] := by + by_cases hdivisor : divisor = 0 + · subst divisor + simp [machineBinaryDivTake] + · simp only [machineBinaryDivTake, machineBinaryDivDivisor_pack, + machineBinaryDivTrial_pack_natBits] + rw [machineIfEmpty_of_ne_nil divisor.bits [false] + (machineBinaryNatLeBit + (pair divisor.bits + (remainder + remainder + bitValue bit).bits)) + (natBits_ne_nil_of_ne_zero hdivisor)] + rw [machineBinaryNatLeBit_pair_natBits] + simp [hdivisor] + +@[simp] theorem machineBinaryDivIncrementedQuotient_pack_natBits + (bit : Bool) (remaining : List Bool) (divisor quotient remainder : ℕ) : + machineBinaryDivIncrementedQuotient + (machineBinaryDivPack (bit :: remaining) divisor.bits + quotient.bits remainder.bits) = + (quotient + quotient + 1).bits := by + simp only [machineBinaryDivIncrementedQuotient, + machineBinaryDivDoubleQuotient_pack_natBits] + simpa using machineBinaryAddBits_pair_natBits (quotient + quotient) 1 + +@[simp] theorem machineBinaryDivNextQuotient_pack_natBits + (bit : Bool) (remaining : List Bool) (divisor quotient remainder : ℕ) : + machineBinaryDivNextQuotient + (machineBinaryDivPack (bit :: remaining) divisor.bits + quotient.bits remainder.bits) = + if divisor = 0 then [] + else if divisor ≤ remainder + remainder + bitValue bit then + (quotient + quotient + 1).bits + else (quotient + quotient).bits := by + by_cases hdivisor : divisor = 0 + · subst divisor + simp [machineBinaryDivNextQuotient] + · simp only [machineBinaryDivNextQuotient, machineBinaryDivDivisor_pack] + rw [machineIfEmpty_of_ne_nil divisor.bits [] + (machineIfHead + (machineBinaryDivTake + (machineBinaryDivPack (bit :: remaining) divisor.bits + quotient.bits remainder.bits)) + (machineBinaryDivIncrementedQuotient + (machineBinaryDivPack (bit :: remaining) divisor.bits + quotient.bits remainder.bits)) + (machineBinaryDivDoubleQuotient + (machineBinaryDivPack (bit :: remaining) divisor.bits + quotient.bits remainder.bits))) + (natBits_ne_nil_of_ne_zero hdivisor)] + by_cases htake : divisor ≤ remainder + remainder + bitValue bit + · simp [hdivisor, htake] + · simp [hdivisor, htake] + +@[simp] theorem machineBinaryDivNextRemainder_pack_natBits + (bit : Bool) (remaining : List Bool) (divisor quotient remainder : ℕ) : + machineBinaryDivNextRemainder + (machineBinaryDivPack (bit :: remaining) divisor.bits + quotient.bits remainder.bits) = + if divisor = 0 then + (remainder + remainder + bitValue bit).bits + else if divisor ≤ remainder + remainder + bitValue bit then + (remainder + remainder + bitValue bit - divisor).bits + else (remainder + remainder + bitValue bit).bits := by + rw [machineBinaryDivNextRemainder, + machineBinaryDivTake_pack_natBits, + machineBinaryDivTrial_pack_natBits] + by_cases hdivisor : divisor = 0 + · simp [hdivisor] + · by_cases htake : divisor ≤ remainder + remainder + bitValue bit + · simp only [hdivisor, if_false] + simp only [htake, decide_true, machineIfHead_true, + machineBinaryDivDivisor_pack, if_true] + rw [machineBinarySubBits_pair_natBits] + · simp [hdivisor, htake] + +theorem machineBinaryDivStep_pack_natBits + (bit : Bool) (remaining : List Bool) (divisor quotient remainder : ℕ) : + machineBinaryDivStep + (machineBinaryDivPack (bit :: remaining) divisor.bits + quotient.bits remainder.bits) = + let next := binaryLongDivStep divisor bit (quotient, remainder) + machineBinaryDivPack remaining divisor.bits next.1.bits next.2.bits := by + simp only [machineBinaryDivStep, machineBinaryDivRemaining_pack, + machineBinaryDivDivisor_pack, List.tail_cons, + machineBinaryDivNextQuotient_pack_natBits, + machineBinaryDivNextRemainder_pack_natBits] + by_cases hdivisor : divisor = 0 + · simp [binaryLongDivStep, hdivisor, two_mul] + · by_cases htake : divisor ≤ remainder + remainder + bitValue bit + · simp [binaryLongDivStep, hdivisor, htake, two_mul] + · simp [binaryLongDivStep, hdivisor, htake, two_mul] + +theorem machineBinaryDivIterate_natBits + (bits : List Bool) (divisor quotient remainder : ℕ) : + machineBinaryDivStep^[bits.length] + (machineBinaryDivPack bits divisor.bits quotient.bits remainder.bits) = + let final := binaryLongDivForward divisor bits (quotient, remainder) + machineBinaryDivPack [] divisor.bits final.1.bits final.2.bits := by + induction bits generalizing quotient remainder with + | nil => rfl + | cons bit remaining ih => + rw [List.length_cons, Function.iterate_succ_apply, + machineBinaryDivStep_pack_natBits] + let next := binaryLongDivStep divisor bit (quotient, remainder) + simpa only [binaryLongDivForward] using ih next.1 next.2 + +/-- Exact quotient/remainder correctness, including the zero-divisor +convention inherited from `Nat.div` and `Nat.mod`. -/ +theorem machineBinaryDivModBits_pair_natBits (dividend divisor : ℕ) : + machineBinaryDivModBits (pair dividend.bits divisor.bits) = + pair (dividend / divisor).bits (dividend % divisor).bits := by + simp only [machineBinaryDivModBits, machineBinaryDivFinalState, + machineBinaryDivRuler, machineBinaryDivInit, machinePairFirst_pair, + machinePairSecond_pair] + rw [← @List.length_reverse Bool dividend.bits] + change pair + (machineBinaryDivQuotient + (machineBinaryDivStep^[dividend.bits.reverse.length] + (machineBinaryDivPack dividend.bits.reverse divisor.bits + (0 : ℕ).bits (0 : ℕ).bits))) + (machineBinaryDivRemainder + (machineBinaryDivStep^[dividend.bits.reverse.length] + (machineBinaryDivPack dividend.bits.reverse divisor.bits + (0 : ℕ).bits (0 : ℕ).bits))) = _ + rw [machineBinaryDivIterate_natBits dividend.bits.reverse divisor 0 0] + simp only [machineBinaryDivQuotient_pack, machineBinaryDivRemainder_pack] + rw [binaryLongDivForward_reverse, binaryLongDivBits_eq_div_mod] + simp only [Prod.fst, Prod.snd, Nat.fromBitsLE_bits] + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryGCD.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryGCD.lean new file mode 100644 index 0000000000..4de71415ae --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryGCD.lean @@ -0,0 +1,211 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineBinaryDivision +import LeanPool.BeyondBethe.BeyondBethe.MachineTrimHighZeros + +/-! +# Polynomial-time binary gcd + +This is a fixed-budget Euclidean algorithm on canonical little-endian words. +The input components are canonicalized first. Each step obtains its remainder +from the verified long-division machine, and two iterations per bit of the +initial second component suffice by the previously proved Euclid bound. +-/ + +namespace BeyondBethe + +open Complexity + +def machineBinaryRemainderBits (word : List Bool) : List Bool := + machinePairSecond (machineBinaryDivModBits word) + +def machineBinaryGcdStep (state : List Bool) : List Bool := + machineIfEmpty (machinePairSecond state) state + (pair (machinePairSecond state) (machineBinaryRemainderBits state)) + +def machineBinaryGcdInit (word : List Bool) : List Bool := + pair (machineTrimHighZeros (machinePairFirst word)) + (machineTrimHighZeros (machinePairSecond word)) + +def machineBinaryGcdRuler (word : List Bool) : List Bool := + let second := machineTrimHighZeros (machinePairSecond word) + second ++ second + +def machineBinaryGcdWidth (word : List Bool) : List Bool := + let padded := List.replicate 16 false ++ word + List.replicate (padded.length * padded.length) false + +def machineBinaryGcdFinalState (word : List Bool) : List Bool := + machineBinaryGcdStep^[(machineBinaryGcdRuler word).length] + (machineBinaryGcdInit word) + +def machineBinaryGcdBits (word : List Bool) : List Bool := + machinePairFirst (machineBinaryGcdFinalState word) + +theorem machineBinaryRemainderBits_mem_FP : + machineBinaryRemainderBits ∈ Complexity.FP := by + simpa only [machineBinaryRemainderBits] using + machineCompose_mem_FP machineBinaryDivModBits_mem_FP + machinePairSecond_mem_FP + +theorem machineBinaryGcdStep_mem_FP : + machineBinaryGcdStep ∈ Complexity.FP := by + have hpair : (fun state => pair (machinePairSecond state) + (machineBinaryRemainderBits state)) ∈ Complexity.FP := + machinePair_mem_FP machinePairSecond_mem_FP + machineBinaryRemainderBits_mem_FP + simpa only [machineBinaryGcdStep] using + machineIfEmpty_mem_FP machinePairSecond_mem_FP id_mem_FP hpair + +theorem machineBinaryGcdInit_mem_FP : + machineBinaryGcdInit ∈ Complexity.FP := by + have hfirst := machineCompose_mem_FP machinePairFirst_mem_FP + machineTrimHighZeros_mem_FP + have hsecond := machineCompose_mem_FP machinePairSecond_mem_FP + machineTrimHighZeros_mem_FP + simpa only [machineBinaryGcdInit] using machinePair_mem_FP hfirst hsecond + +theorem machineBinaryGcdRuler_mem_FP : + machineBinaryGcdRuler ∈ Complexity.FP := by + have hsecond := machineCompose_mem_FP machinePairSecond_mem_FP + machineTrimHighZeros_mem_FP + simpa only [machineBinaryGcdRuler] using machineAppend_mem_FP hsecond hsecond + +theorem machineBinaryGcdWidth_mem_FP : + machineBinaryGcdWidth ∈ Complexity.FP := by + let padded : List Bool → List Bool := + fun word => List.replicate 16 false ++ word + have hpadded : padded ∈ Complexity.FP := + machineAppend_mem_FP (machineConst_mem_FP (List.replicate 16 false)) + id_mem_FP + simpa only [machineBinaryGcdWidth, padded] using + Cobham.mulLenFn_mem_FP hpadded hpadded + +theorem machineBinaryGcdStep_pair_natBits (a b : ℕ) : + machineBinaryGcdStep (pair a.bits b.bits) = + pair (binaryEuclidStep (a, b)).1.bits + (binaryEuclidStep (a, b)).2.bits := by + rw [binaryEuclidStep_eq] + by_cases hb : b = 0 + · subst b + simp [machineBinaryGcdStep] + · simp only [machineBinaryGcdStep, machinePairSecond_pair] + rw [machineIfEmpty_of_ne_nil b.bits (pair a.bits b.bits) + (pair b.bits (machineBinaryRemainderBits (pair a.bits b.bits))) + (natBits_ne_nil_of_ne_zero hb)] + simp only [machineBinaryRemainderBits, + machineBinaryDivModBits_pair_natBits, machinePairSecond_pair, + hb, if_false, Prod.fst, Prod.snd] + +def MachineBinaryGcdReachable (word state : List Bool) : Prop := + ∃ a b : ℕ, + state = pair a.bits b.bits ∧ + a.bits.length ≤ word.length ∧ b.bits.length ≤ word.length + +theorem machineBinaryGcdInit_reachable (word : List Bool) : + MachineBinaryGcdReachable word (machineBinaryGcdInit word) := by + let a := Nat.fromBitsLE (machinePairFirst word) + let b := Nat.fromBitsLE (machinePairSecond word) + refine ⟨a, b, ?_, ?_, ?_⟩ + · simp only [machineBinaryGcdInit, machineTrimHighZeros_eq, + BinaryRippleSub.trimHighZeros_eq_natBits_internal, a, b] + · have htrim := binaryTrimHighZeros_length_le (machinePairFirst word) + rw [BinaryRippleSub.trimHighZeros_eq_natBits_internal] at htrim + exact htrim.trans (machinePairFirst_length_le word) + · have htrim := binaryTrimHighZeros_length_le (machinePairSecond word) + rw [BinaryRippleSub.trimHighZeros_eq_natBits_internal] at htrim + exact htrim.trans (machinePairSecond_length_le word) + +theorem machineBinaryGcdStep_reachable {word state : List Bool} + (hstate : MachineBinaryGcdReachable word state) : + MachineBinaryGcdReachable word (machineBinaryGcdStep state) := by + obtain ⟨a, b, rfl, ha, hb⟩ := hstate + rw [machineBinaryGcdStep_pair_natBits] + by_cases hbzero : b = 0 + · subst b + refine ⟨a, 0, ?_, ha, by simp⟩ + simp [binaryEuclidStep] + · refine ⟨b, a % b, ?_, hb, ?_⟩ + · simp [binaryEuclidStep, hbzero, binaryLongDiv_eq_div_mod] + · have hsize := Nat.size_le_size (Nat.mod_le a b) + have hbits : (a % b).bits.length ≤ a.bits.length := by + simpa only [Nat.size_eq_bits_len] using hsize + exact hbits.trans ha + +theorem machineBinaryGcdIterate_reachable (word : List Bool) : + ∀ steps : ℕ, + MachineBinaryGcdReachable word + (machineBinaryGcdStep^[steps] (machineBinaryGcdInit word)) := by + intro steps + induction steps with + | zero => exact machineBinaryGcdInit_reachable word + | succ steps ih => + rw [Function.iterate_succ_apply'] + exact machineBinaryGcdStep_reachable ih + +theorem machineBinaryGcdIterate_length_le_width + (word : List Bool) (steps : ℕ) + (_hsteps : steps ≤ (machineBinaryGcdRuler word).length) : + (machineBinaryGcdStep^[steps] (machineBinaryGcdInit word)).length ≤ + (machineBinaryGcdWidth word).length := by + obtain ⟨a, b, hstate, ha, hb⟩ := + machineBinaryGcdIterate_reachable word steps + rw [hstate] + simp only [pair_length, machineBinaryGcdWidth, List.length_replicate, + List.length_append] + nlinarith + +theorem machineBinaryGcdFinalState_mem_FP : + machineBinaryGcdFinalState ∈ Complexity.FP := by + exact Cobham.iterate_mem_FP machineBinaryGcdStep_mem_FP + machineBinaryGcdInit_mem_FP machineBinaryGcdRuler_mem_FP + machineBinaryGcdWidth_mem_FP machineBinaryGcdIterate_length_le_width + +theorem machineBinaryGcdBits_mem_FP : + machineBinaryGcdBits ∈ Complexity.FP := by + simpa only [machineBinaryGcdBits] using + machineCompose_mem_FP machineBinaryGcdFinalState_mem_FP + machinePairFirst_mem_FP + +theorem machineBinaryGcdIterate_pair_natBits (steps a b : ℕ) : + machineBinaryGcdStep^[steps] (pair a.bits b.bits) = + let final := binaryEuclidIterate steps (a, b) + pair final.1.bits final.2.bits := by + induction steps generalizing a b with + | zero => rfl + | succ steps ih => + rw [Function.iterate_succ_apply, machineBinaryGcdStep_pair_natBits] + simpa only [binaryEuclidIterate] using + ih (binaryEuclidStep (a, b)).1 (binaryEuclidStep (a, b)).2 + +theorem machineBinaryGcdBits_eq (word : List Bool) : + machineBinaryGcdBits word = + (Nat.gcd (Nat.fromBitsLE (machinePairFirst word)) + (Nat.fromBitsLE (machinePairSecond word))).bits := by + let a := Nat.fromBitsLE (machinePairFirst word) + let b := Nat.fromBitsLE (machinePairSecond word) + simp only [machineBinaryGcdBits, machineBinaryGcdFinalState, + machineBinaryGcdRuler, machineBinaryGcdInit, + machineTrimHighZeros_eq, + BinaryRippleSub.trimHighZeros_eq_natBits_internal, + List.length_append, a, b] + rw [show b.bits.length + b.bits.length = 2 * b.size by + simp [Nat.size_eq_bits_len, two_mul]] + rw [machineBinaryGcdIterate_pair_natBits] + simp only [machinePairFirst_pair] + change (binaryEuclidBounded + (Nat.fromBitsLE (machinePairFirst word)) + (Nat.fromBitsLE (machinePairSecond word))).bits = _ + rw [binaryEuclidBounded_eq_gcd] + +theorem machineBinaryGcdBits_pair_natBits (a b : ℕ) : + machineBinaryGcdBits (pair a.bits b.bits) = (Nat.gcd a b).bits := by + rw [machineBinaryGcdBits_eq] + simp only [machinePairFirst_pair, machinePairSecond_pair, + Nat.fromBitsLE_bits] + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryListInit.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryListInit.lean new file mode 100644 index 0000000000..e2bf755e49 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryListInit.lean @@ -0,0 +1,59 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineListReverse + +/-! +# Removing the last entry of a finite-word list + +The center of an epigraph ellipsoid is stored as a right-nested list. The +base point consists of every coordinate except the final height coordinate. +This machine reverses the list, removes its first encoded entry, and reverses +again. It is total and polynomial-time on arbitrary finite words. +-/ + +namespace BeyondBethe + +open Complexity + +def machineBinaryListInitReversed (word : List Bool) : List Bool := + machineListReverse word + +def machineBinaryListInitReversedTail (word : List Bool) : List Bool := + machineListTail (machineBinaryListInitReversed word) + +def machineBinaryListInit (word : List Bool) : List Bool := + machineListReverse (machineBinaryListInitReversedTail word) + +theorem machineBinaryListInitReversed_mem_FP : + machineBinaryListInitReversed ∈ FP := by + simpa only [machineBinaryListInitReversed] using + machineListReverse_mem_FP + +theorem machineBinaryListInitReversedTail_mem_FP : + machineBinaryListInitReversedTail ∈ FP := by + simpa only [machineBinaryListInitReversedTail] using + machineCompose_mem_FP machineBinaryListInitReversed_mem_FP + machineListTail_mem_FP + +theorem machineBinaryListInit_mem_FP : machineBinaryListInit ∈ FP := by + simpa only [machineBinaryListInit] using + machineCompose_mem_FP machineBinaryListInitReversedTail_mem_FP + machineListReverse_mem_FP + +@[simp] theorem machineBinaryListInit_encode + {alpha : Type*} (encode : alpha → List Bool) + (xs : List alpha) (x : alpha) : + machineBinaryListInit (binaryListCode encode (xs ++ [x])) = + binaryListCode encode xs := by + rw [machineBinaryListInit, machineBinaryListInitReversedTail, + machineBinaryListInitReversed, machineListReverse_encode] + rw [List.reverse_append] + simp only [List.reverse_singleton, List.singleton_append] + rw [machineListTail_cons, machineListReverse_encode] + simp + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryListSnoc.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryListSnoc.lean new file mode 100644 index 0000000000..878221fe0b --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryListSnoc.lean @@ -0,0 +1,77 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineListReverse + +/-! +# Appending one entry to a finite-word list + +The canonical list representation is right-nested, so appending an entry is +not a fixedValue-time constructor operation. This machine reverses the encoded +list, prepends the supplied encoded entry, and reverses once more. The two +uses of the verified list-reversal machine make the construction total and +polynomial-time on arbitrary finite words. +-/ + +namespace BeyondBethe + +open Complexity + +/-- Input layout: `pair encodedEntry encodedList`. -/ +def machineBinaryListSnocEntry (word : List Bool) : List Bool := + machinePairFirst word + +def machineBinaryListSnocList (word : List Bool) : List Bool := + machinePairSecond word + +def machineBinaryListSnocReversedList (word : List Bool) : List Bool := + machineListReverse (machineBinaryListSnocList word) + +def machineBinaryListSnocPrependInput (word : List Bool) : List Bool := + pair (machineBinaryListSnocEntry word) + (machineBinaryListSnocReversedList word) + +def machineBinaryListSnoc (word : List Bool) : List Bool := + machineListReverse (machineBinaryListSnocPrependInput word) + +theorem machineBinaryListSnocEntry_mem_FP : + machineBinaryListSnocEntry ∈ FP := machinePairFirst_mem_FP + +theorem machineBinaryListSnocList_mem_FP : + machineBinaryListSnocList ∈ FP := machinePairSecond_mem_FP + +theorem machineBinaryListSnocReversedList_mem_FP : + machineBinaryListSnocReversedList ∈ FP := by + simpa only [machineBinaryListSnocReversedList] using + machineCompose_mem_FP machineBinaryListSnocList_mem_FP + machineListReverse_mem_FP + +theorem machineBinaryListSnocPrependInput_mem_FP : + machineBinaryListSnocPrependInput ∈ FP := + machinePair_mem_FP machineBinaryListSnocEntry_mem_FP + machineBinaryListSnocReversedList_mem_FP + +theorem machineBinaryListSnoc_mem_FP : machineBinaryListSnoc ∈ FP := by + simpa only [machineBinaryListSnoc] using + machineCompose_mem_FP machineBinaryListSnocPrependInput_mem_FP + machineListReverse_mem_FP + +@[simp] theorem machineBinaryListSnoc_encode + {alpha : Type*} (encode : alpha → List Bool) + (xs : List alpha) (x : alpha) : + machineBinaryListSnoc + (pair (encode x) (binaryListCode encode xs)) = + binaryListCode encode (xs ++ [x]) := by + rw [machineBinaryListSnoc, machineBinaryListSnocPrependInput, + machineBinaryListSnocEntry, machineBinaryListSnocReversedList, + machineBinaryListSnocList, machinePairFirst_pair, + machinePairSecond_pair, machineListReverse_encode] + change machineListReverse + (binaryListCode encode (x :: xs.reverse)) = _ + rw [machineListReverse_encode] + simp + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryMul.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryMul.lean new file mode 100644 index 0000000000..30106dd448 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryMul.lean @@ -0,0 +1,321 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineBinaryAddSemantics +import LeanPool.BeyondBethe.Complexitylib.Mathlib.NatBits + +/-! +# A composed polynomial-time binary multiplier + +The multiplier scans the little-endian multiplier. Its state contains the +unread multiplier, the current doubled multiplicand, and the accumulated +partial product. Each iteration uses the already verified binary adder. A +quadratic Cobham width bound is proved for every input string, while exact +arithmetic correctness is proved on canonical `Nat.bits` operands. +-/ + +namespace BeyondBethe + +open Complexity + +def machineBinaryMulPack + (remaining shift acc : List Bool) : List Bool := + pair remaining (pair shift acc) + +def machineBinaryMulRemaining (state : List Bool) : List Bool := + machinePairFirst state + +def machineBinaryMulShift (state : List Bool) : List Bool := + machinePairFirst (machinePairSecond state) + +def machineBinaryMulAcc (state : List Bool) : List Bool := + machinePairSecond (machinePairSecond state) + +def machineBinaryMulNextShift (state : List Bool) : List Bool := + machineBinaryAddBits + (pair (machineBinaryMulShift state) (machineBinaryMulShift state)) + +def machineBinaryMulNextAcc (state : List Bool) : List Bool := + machineIfHead (machineHeadBit (machineBinaryMulRemaining state)) + (machineBinaryAddBits + (pair (machineBinaryMulAcc state) (machineBinaryMulShift state))) + (machineBinaryMulAcc state) + +def machineBinaryMulStep (state : List Bool) : List Bool := + machineBinaryMulPack + (machineBinaryMulRemaining state).tail + (machineBinaryMulNextShift state) + (machineBinaryMulNextAcc state) + +def machineBinaryMulInit (word : List Bool) : List Bool := + machineBinaryMulPack (machinePairSecond word) (machinePairFirst word) [] + +def machineBinaryMulRuler (word : List Bool) : List Bool := + machinePairSecond word + +/-- A deliberately generous quadratic state envelope. -/ +def machineBinaryMulWidth (word : List Bool) : List Bool := + let padded := List.replicate 16 false ++ word + List.replicate (padded.length * padded.length) false + +def machineBinaryMulFinalState (word : List Bool) : List Bool := + machineBinaryMulStep^[(machineBinaryMulRuler word).length] + (machineBinaryMulInit word) + +def machineBinaryMulBits (word : List Bool) : List Bool := + machineBinaryMulAcc (machineBinaryMulFinalState word) + +theorem machineBinaryMulRemaining_mem_FP : + machineBinaryMulRemaining ∈ Complexity.FP := by + simpa only [machineBinaryMulRemaining] using machinePairFirst_mem_FP + +theorem machineBinaryMulShift_mem_FP : + machineBinaryMulShift ∈ Complexity.FP := by + simpa only [machineBinaryMulShift] using + machineCompose_mem_FP machinePairSecond_mem_FP machinePairFirst_mem_FP + +theorem machineBinaryMulAcc_mem_FP : + machineBinaryMulAcc ∈ Complexity.FP := by + simpa only [machineBinaryMulAcc] using + machineCompose_mem_FP machinePairSecond_mem_FP machinePairSecond_mem_FP + +theorem machineBinaryMulPack_mem_FP + {remaining shift acc : List Bool → List Bool} + (hremaining : remaining ∈ Complexity.FP) + (hshift : shift ∈ Complexity.FP) (hacc : acc ∈ Complexity.FP) : + (fun word => machineBinaryMulPack (remaining word) (shift word) + (acc word)) ∈ Complexity.FP := by + exact machinePair_mem_FP hremaining (machinePair_mem_FP hshift hacc) + +theorem machineBinaryMulNextShift_mem_FP : + machineBinaryMulNextShift ∈ Complexity.FP := by + have hpair : (fun state => pair (machineBinaryMulShift state) + (machineBinaryMulShift state)) ∈ Complexity.FP := + machinePair_mem_FP machineBinaryMulShift_mem_FP + machineBinaryMulShift_mem_FP + simpa only [machineBinaryMulNextShift] using + machineCompose_mem_FP hpair machineBinaryAddBits_mem_FP + +theorem machineBinaryMulNextAcc_mem_FP : + machineBinaryMulNextAcc ∈ Complexity.FP := by + have hflag : (fun state => + machineHeadBit (machineBinaryMulRemaining state)) ∈ Complexity.FP := + machineCompose_mem_FP machineBinaryMulRemaining_mem_FP + machineHeadBit_mem_FP + have hpair : (fun state => pair (machineBinaryMulAcc state) + (machineBinaryMulShift state)) ∈ Complexity.FP := + machinePair_mem_FP machineBinaryMulAcc_mem_FP + machineBinaryMulShift_mem_FP + have hadd : (fun state => machineBinaryAddBits + (pair (machineBinaryMulAcc state) (machineBinaryMulShift state))) ∈ + Complexity.FP := + machineCompose_mem_FP hpair machineBinaryAddBits_mem_FP + exact machineIfHead_mem_FP hflag hadd machineBinaryMulAcc_mem_FP + +theorem machineBinaryMulStep_mem_FP : + machineBinaryMulStep ∈ Complexity.FP := by + apply machineBinaryMulPack_mem_FP + · exact machineCompose_mem_FP machineBinaryMulRemaining_mem_FP + machineTail_mem_FP + · exact machineBinaryMulNextShift_mem_FP + · exact machineBinaryMulNextAcc_mem_FP + +theorem machineBinaryMulInit_mem_FP : + machineBinaryMulInit ∈ Complexity.FP := by + exact machineBinaryMulPack_mem_FP machinePairSecond_mem_FP + machinePairFirst_mem_FP (machineConst_mem_FP []) + +theorem machineBinaryMulRuler_mem_FP : + machineBinaryMulRuler ∈ Complexity.FP := by + simpa only [machineBinaryMulRuler] using machinePairSecond_mem_FP + +theorem machineBinaryMulWidth_mem_FP : + machineBinaryMulWidth ∈ Complexity.FP := by + let padded : List Bool → List Bool := + fun word => List.replicate 16 false ++ word + have hpadded : padded ∈ Complexity.FP := + machineAppend_mem_FP (machineConst_mem_FP (List.replicate 16 false)) + id_mem_FP + simpa only [machineBinaryMulWidth, padded] using + Cobham.mulLenFn_mem_FP hpadded hpadded + +@[simp] theorem machineBinaryMulRemaining_pack (remaining shift acc) : + machineBinaryMulRemaining (machineBinaryMulPack remaining shift acc) = + remaining := by + simp [machineBinaryMulRemaining, machineBinaryMulPack] + +@[simp] theorem machineBinaryMulShift_pack (remaining shift acc) : + machineBinaryMulShift (machineBinaryMulPack remaining shift acc) = + shift := by + simp [machineBinaryMulShift, machineBinaryMulPack] + +@[simp] theorem machineBinaryMulAcc_pack (remaining shift acc) : + machineBinaryMulAcc (machineBinaryMulPack remaining shift acc) = acc := by + simp [machineBinaryMulAcc, machineBinaryMulPack] + +@[simp] theorem machineBinaryMulStep_pack + (bit : Bool) (remaining shift acc : List Bool) : + machineBinaryMulStep + (machineBinaryMulPack (bit :: remaining) shift acc) = + machineBinaryMulPack remaining + (machineBinaryAddBits (pair shift shift)) + (if bit then machineBinaryAddBits (pair acc shift) else acc) := by + cases bit <;> + simp [machineBinaryMulStep, machineBinaryMulNextShift, + machineBinaryMulNextAcc] + +/-- Pure list-level fold mirrored by the bounded machine loop. -/ +def binaryMulFold : List Bool → List Bool → List Bool → + List Bool × List Bool + | [], shift, acc => (shift, acc) + | bit :: remaining, shift, acc => + binaryMulFold remaining + (machineBinaryAddBits (pair shift shift)) + (if bit then machineBinaryAddBits (pair acc shift) else acc) + +theorem machineBinaryMulIterate_length + (bits shift acc : List Bool) : + machineBinaryMulStep^[bits.length] + (machineBinaryMulPack bits shift acc) = + machineBinaryMulPack [] + (binaryMulFold bits shift acc).1 + (binaryMulFold bits shift acc).2 := by + induction bits generalizing shift acc with + | nil => rfl + | cons bit remaining ih => + rw [List.length_cons, Function.iterate_succ_apply, + machineBinaryMulStep_pack, ih] + rfl + +def MachineBinaryMulReachable + (lhs rhs : List Bool) (iterations : ℕ) (state : List Bool) : Prop := + ∃ remaining shift acc, + state = machineBinaryMulPack remaining shift acc ∧ + remaining.length ≤ rhs.length ∧ + shift.length ≤ lhs.length + iterations ∧ + acc.length ≤ lhs.length + iterations + 1 + +theorem machineBinaryMulInit_reachable (word : List Bool) : + MachineBinaryMulReachable (machinePairFirst word) + (machinePairSecond word) 0 (machineBinaryMulInit word) := by + refine ⟨machinePairSecond word, machinePairFirst word, [], rfl, + le_rfl, ?_, ?_⟩ <;> simp + +theorem machineBinaryMulStep_reachable + {lhs rhs : List Bool} {iterations : ℕ} {state : List Bool} + (hstate : MachineBinaryMulReachable lhs rhs iterations state) : + MachineBinaryMulReachable lhs rhs (iterations + 1) + (machineBinaryMulStep state) := by + obtain ⟨remaining, shift, acc, rfl, hremaining, hshift, hacc⟩ := hstate + cases remaining with + | nil => + refine ⟨[], machineBinaryAddBits (pair shift shift), + machineBinaryMulNextAcc (machineBinaryMulPack [] shift acc), + ?_, by simp, ?_, ?_⟩ + · simp [machineBinaryMulStep, machineBinaryMulNextShift] + · have hadd := machineBinaryAddBits_pair_length_le shift shift + omega + · simp [machineBinaryMulNextAcc] + omega + | cons bit remaining => + refine ⟨remaining, machineBinaryAddBits (pair shift shift), + (if bit then machineBinaryAddBits (pair acc shift) else acc), + machineBinaryMulStep_pack bit remaining shift acc, + ?_, ?_, ?_⟩ + · simp only [List.length_cons] at hremaining + omega + · have hadd := machineBinaryAddBits_pair_length_le shift shift + omega + · cases bit with + | false => simp; omega + | true => + simp only [Bool.true_eq, if_true] + have hadd := machineBinaryAddBits_pair_length_le acc shift + omega + +theorem machineBinaryMulIterate_reachable (word : List Bool) : + ∀ iterations, + MachineBinaryMulReachable (machinePairFirst word) + (machinePairSecond word) iterations + (machineBinaryMulStep^[iterations] (machineBinaryMulInit word)) := by + intro iterations + induction iterations with + | zero => exact machineBinaryMulInit_reachable word + | succ iterations ih => + rw [Function.iterate_succ_apply'] + simpa [Nat.succ_eq_add_one] using machineBinaryMulStep_reachable ih + +theorem machineBinaryMulIterate_length_le_width + (word : List Bool) (iterations : ℕ) + (hiterations : iterations ≤ (machineBinaryMulRuler word).length) : + (machineBinaryMulStep^[iterations] + (machineBinaryMulInit word)).length ≤ + (machineBinaryMulWidth word).length := by + obtain ⟨remaining, shift, acc, hstate, hremaining, hshift, hacc⟩ := + machineBinaryMulIterate_reachable word iterations + rw [hstate] + have hlhs := machinePairFirst_length_le word + have hrhs := machinePairSecond_length_le word + have hit : iterations ≤ word.length := by + exact hiterations.trans hrhs + simp only [machineBinaryMulPack, pair_length, machineBinaryMulWidth, + List.length_replicate, List.length_append] + nlinarith + +theorem machineBinaryMulFinalState_mem_FP : + machineBinaryMulFinalState ∈ Complexity.FP := by + exact Cobham.iterate_mem_FP machineBinaryMulStep_mem_FP + machineBinaryMulInit_mem_FP machineBinaryMulRuler_mem_FP + machineBinaryMulWidth_mem_FP machineBinaryMulIterate_length_le_width + +theorem machineBinaryMulBits_mem_FP : + machineBinaryMulBits ∈ Complexity.FP := by + simpa only [machineBinaryMulBits] using + machineCompose_mem_FP machineBinaryMulFinalState_mem_FP + machineBinaryMulAcc_mem_FP + +theorem binaryMulFold_natBits (bits : List Bool) (shift acc : ℕ) : + (binaryMulFold bits shift.bits acc.bits).2 = + (acc + shift * Nat.fromBitsLE bits).bits := by + induction bits generalizing shift acc with + | nil => + have hempty : Nat.fromBitsLE [] = 0 := rfl + simp [binaryMulFold, hempty] + | cons bit remaining ih => + cases bit with + | false => + simp only [binaryMulFold, machineBinaryAddBits_pair_natBits] + simp only [Bool.false_eq_true, ↓reduceIte] + rw [ih (shift + shift) acc] + simp only [Nat.fromBitsLE_cons] + congr 1 + simp only [Bool.false_eq_true, if_false] + ring + | true => + simp only [binaryMulFold, machineBinaryAddBits_pair_natBits] + simp only [↓reduceIte] + rw [ih (shift + shift) (acc + shift)] + simp only [Nat.fromBitsLE_cons] + congr 1 + simp only [eq_self, if_true] + ring + +/-- The concrete multiplier returns the canonical binary expansion of the +product of two canonically encoded natural numbers. -/ +theorem machineBinaryMulBits_pair_natBits (lhs rhs : ℕ) : + machineBinaryMulBits (pair lhs.bits rhs.bits) = (lhs * rhs).bits := by + simp only [machineBinaryMulBits, machineBinaryMulFinalState, + machineBinaryMulRuler, machineBinaryMulInit, machinePairFirst_pair, + machinePairSecond_pair] + rw [machineBinaryMulIterate_length] + simp only [machineBinaryMulAcc_pack] + have hfold := binaryMulFold_natBits rhs.bits lhs 0 + calc + (binaryMulFold rhs.bits lhs.bits []).2 = + (lhs * Nat.fromBitsLE rhs.bits).bits := by simpa using hfold + _ = (lhs * rhs).bits := by rw [Nat.fromBitsLE_bits] + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineBinarySub.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineBinarySub.lean new file mode 100644 index 0000000000..d9f911c3d4 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineBinarySub.lean @@ -0,0 +1,510 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineTrimHighZeros +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleSub + +/-! +# A composed polynomial-time binary subtractor + +The state is `pair x (pair y (pair borrow accRev))`. A bounded ripple-borrow +scan produces a fixed-width difference; a verified final branch maps +underflow to zero and otherwise removes redundant high zeroes. Thus the +machine implements truncated subtraction on canonical natural words. +-/ + +namespace BeyondBethe + +open Complexity + +def machineBinarySubPack + (x y borrow accRev : List Bool) : List Bool := + pair x (pair y (pair borrow accRev)) + +def machineBinarySubX (state : List Bool) : List Bool := + machinePairFirst state + +def machineBinarySubY (state : List Bool) : List Bool := + machinePairFirst (machinePairSecond state) + +def machineBinarySubBorrow (state : List Bool) : List Bool := + machinePairFirst (machinePairSecond (machinePairSecond state)) + +def machineBinarySubAccRev (state : List Bool) : List Bool := + machinePairSecond (machinePairSecond (machinePairSecond state)) + +def machineBinarySubActive (state : List Bool) : List Bool := + machineIfEmpty (machineBinarySubX state) + (machineIfEmpty (machineBinarySubY state) [false] [true]) [true] + +def machineBinarySubDiffBit (state : List Bool) : List Bool := + machineFullAdderSum + (machineHeadBit (machineBinarySubX state)) + (machineHeadBit (machineBinarySubY state)) + (machineBinarySubBorrow state) + +def machineBinarySubNextBorrow (state : List Bool) : List Bool := + let lhs := machineHeadBit (machineBinarySubX state) + let rhs := machineHeadBit (machineBinarySubY state) + let borrow := machineBinarySubBorrow state + machineOrBit (machineAndBit (machineNotBit lhs) rhs) + (machineOrBit (machineAndBit (machineNotBit lhs) borrow) + (machineAndBit rhs borrow)) + +def machineBinarySubAdvanced (state : List Bool) : List Bool := + machineBinarySubPack + (machineBinarySubX state).tail + (machineBinarySubY state).tail + (machineBinarySubNextBorrow state) + (machineBinarySubDiffBit state ++ machineBinarySubAccRev state) + +def machineBinarySubStep (state : List Bool) : List Bool := + machineIfHead (machineBinarySubActive state) + (machineBinarySubAdvanced state) state + +def machineBinarySubInit (word : List Bool) : List Bool := + machineBinarySubPack (machinePairFirst word) (machinePairSecond word) + [false] [] + +def machineBinarySubRuler (word : List Bool) : List Bool := + machinePairFirst word ++ machinePairSecond word + +def machineBinarySubWidth (word : List Bool) : List Bool := + let padded := List.replicate 8 false ++ word + List.replicate (padded.length * padded.length) false + +def machineBinarySubFinalState (word : List Bool) : List Bool := + machineBinarySubStep^[(machineBinarySubRuler word).length] + (machineBinarySubInit word) + +def machineBinarySubBits (word : List Bool) : List Bool := + let state := machineBinarySubFinalState word + machineIfHead (machineBinarySubBorrow state) [] + (machineTrimHighZeros (machineBinarySubAccRev state).reverse) + +theorem machineBinarySubX_mem_FP : machineBinarySubX ∈ Complexity.FP := by + simpa only [machineBinarySubX] using machinePairFirst_mem_FP + +theorem machineBinarySubY_mem_FP : machineBinarySubY ∈ Complexity.FP := by + simpa only [machineBinarySubY] using + machineCompose_mem_FP machinePairSecond_mem_FP machinePairFirst_mem_FP + +theorem machineBinarySubBorrow_mem_FP : + machineBinarySubBorrow ∈ Complexity.FP := by + have hsecond2 : (fun word => + machinePairSecond (machinePairSecond word)) ∈ Complexity.FP := + machineCompose_mem_FP machinePairSecond_mem_FP machinePairSecond_mem_FP + simpa only [machineBinarySubBorrow] using + machineCompose_mem_FP hsecond2 machinePairFirst_mem_FP + +theorem machineBinarySubAccRev_mem_FP : + machineBinarySubAccRev ∈ Complexity.FP := by + have hsecond2 : (fun word => + machinePairSecond (machinePairSecond word)) ∈ Complexity.FP := + machineCompose_mem_FP machinePairSecond_mem_FP machinePairSecond_mem_FP + simpa only [machineBinarySubAccRev] using + machineCompose_mem_FP hsecond2 machinePairSecond_mem_FP + +theorem machineBinarySubPack_mem_FP + {x y borrow accRev : List Bool → List Bool} + (hx : x ∈ Complexity.FP) (hy : y ∈ Complexity.FP) + (hborrow : borrow ∈ Complexity.FP) (hacc : accRev ∈ Complexity.FP) : + (fun word => machineBinarySubPack (x word) (y word) + (borrow word) (accRev word)) ∈ Complexity.FP := by + exact machinePair_mem_FP hx + (machinePair_mem_FP hy (machinePair_mem_FP hborrow hacc)) + +theorem machineBinarySubActive_mem_FP : + machineBinarySubActive ∈ Complexity.FP := by + apply machineIfEmpty_mem_FP machineBinarySubX_mem_FP + · exact machineIfEmpty_mem_FP machineBinarySubY_mem_FP + (machineConst_mem_FP [false]) (machineConst_mem_FP [true]) + · exact machineConst_mem_FP [true] + +theorem machineBinarySubDiffBit_mem_FP : + machineBinarySubDiffBit ∈ Complexity.FP := by + apply machineFullAdderSum_mem_FP + · exact machineCompose_mem_FP machineBinarySubX_mem_FP + machineHeadBit_mem_FP + · exact machineCompose_mem_FP machineBinarySubY_mem_FP + machineHeadBit_mem_FP + · exact machineBinarySubBorrow_mem_FP + +theorem machineBinarySubNextBorrow_mem_FP : + machineBinarySubNextBorrow ∈ Complexity.FP := by + have hlhs : (fun state => machineHeadBit (machineBinarySubX state)) ∈ + Complexity.FP := + machineCompose_mem_FP machineBinarySubX_mem_FP machineHeadBit_mem_FP + have hrhs : (fun state => machineHeadBit (machineBinarySubY state)) ∈ + Complexity.FP := + machineCompose_mem_FP machineBinarySubY_mem_FP machineHeadBit_mem_FP + apply machineOrBit_mem_FP + · exact machineAndBit_mem_FP (machineNotBit_mem_FP hlhs) hrhs + · apply machineOrBit_mem_FP + · exact machineAndBit_mem_FP (machineNotBit_mem_FP hlhs) + machineBinarySubBorrow_mem_FP + · exact machineAndBit_mem_FP hrhs machineBinarySubBorrow_mem_FP + +theorem machineBinarySubAdvanced_mem_FP : + machineBinarySubAdvanced ∈ Complexity.FP := by + apply machineBinarySubPack_mem_FP + · exact machineCompose_mem_FP machineBinarySubX_mem_FP machineTail_mem_FP + · exact machineCompose_mem_FP machineBinarySubY_mem_FP machineTail_mem_FP + · exact machineBinarySubNextBorrow_mem_FP + · exact machineAppend_mem_FP machineBinarySubDiffBit_mem_FP + machineBinarySubAccRev_mem_FP + +theorem machineBinarySubStep_mem_FP : + machineBinarySubStep ∈ Complexity.FP := by + exact machineIfHead_mem_FP machineBinarySubActive_mem_FP + machineBinarySubAdvanced_mem_FP id_mem_FP + +theorem machineBinarySubInit_mem_FP : + machineBinarySubInit ∈ Complexity.FP := by + exact machineBinarySubPack_mem_FP machinePairFirst_mem_FP + machinePairSecond_mem_FP (machineConst_mem_FP [false]) + (machineConst_mem_FP []) + +theorem machineBinarySubRuler_mem_FP : + machineBinarySubRuler ∈ Complexity.FP := by + exact machineAppend_mem_FP machinePairFirst_mem_FP machinePairSecond_mem_FP + +theorem machineBinarySubWidth_mem_FP : + machineBinarySubWidth ∈ Complexity.FP := by + let padded : List Bool → List Bool := + fun word => List.replicate 8 false ++ word + have hpadded : padded ∈ Complexity.FP := + machineAppend_mem_FP (machineConst_mem_FP (List.replicate 8 false)) + id_mem_FP + simpa only [machineBinarySubWidth, padded] using + Cobham.mulLenFn_mem_FP hpadded hpadded + +@[simp] theorem machineBinarySubX_pack (x y borrow accRev) : + machineBinarySubX (machineBinarySubPack x y borrow accRev) = x := by + simp [machineBinarySubX, machineBinarySubPack] + +@[simp] theorem machineBinarySubY_pack (x y borrow accRev) : + machineBinarySubY (machineBinarySubPack x y borrow accRev) = y := by + simp [machineBinarySubY, machineBinarySubPack] + +@[simp] theorem machineBinarySubBorrow_pack (x y borrow accRev) : + machineBinarySubBorrow (machineBinarySubPack x y borrow accRev) = + borrow := by + simp [machineBinarySubBorrow, machineBinarySubPack] + +@[simp] theorem machineBinarySubAccRev_pack (x y borrow accRev) : + machineBinarySubAccRev (machineBinarySubPack x y borrow accRev) = + accRev := by + simp [machineBinarySubAccRev, machineBinarySubPack] + +@[simp] theorem machineBinarySubStep_pack + (x y accRev : List Bool) (borrow : Bool) : + machineBinarySubStep (machineBinarySubPack x y [borrow] accRev) = + if x = [] ∧ y = [] then + machineBinarySubPack x y [borrow] accRev + else + machineBinarySubPack x.tail y.tail + [BinaryRippleSub.borrowBit borrow + (x.head?.getD false) (y.head?.getD false)] + (BinaryRippleSub.diffBit borrow + (x.head?.getD false) (y.head?.getD false) :: accRev) := by + cases x with + | nil => + cases y with + | nil => cases borrow <;> rfl + | cons y ys => + cases y <;> cases borrow <;> + simp [machineBinarySubStep, machineBinarySubActive, + machineBinarySubAdvanced, machineBinarySubDiffBit, + machineBinarySubNextBorrow, BinaryRippleSub.diffBit, + BinaryRippleSub.borrowBit, machineFullAdderSum, + machineXorBit, machineOrBit, machineAndBit, machineNotBit] + | cons x xs => + cases x <;> cases y with + | nil => + cases borrow <;> + simp [machineBinarySubStep, machineBinarySubActive, + machineBinarySubAdvanced, machineBinarySubDiffBit, + machineBinarySubNextBorrow, BinaryRippleSub.diffBit, + BinaryRippleSub.borrowBit, machineFullAdderSum, + machineXorBit, machineOrBit, machineAndBit, machineNotBit] + | cons y ys => + cases y <;> cases borrow <;> + simp [machineBinarySubStep, machineBinarySubActive, + machineBinarySubAdvanced, machineBinarySubDiffBit, + machineBinarySubNextBorrow, BinaryRippleSub.diffBit, + BinaryRippleSub.borrowBit, machineFullAdderSum, + machineXorBit, machineOrBit, machineAndBit, machineNotBit] + +theorem machineBinarySubStep_pack_length_le + (x y accRev : List Bool) (borrow : Bool) : + (machineBinarySubStep + (machineBinarySubPack x y [borrow] accRev)).length ≤ + (machineBinarySubPack x y [borrow] accRev).length + 1 := by + rw [machineBinarySubStep_pack] + split + · omega + · simp only [machineBinarySubPack, pair_length, List.length_cons, + List.length_tail] + omega + +def MachineBinarySubWellFormed (state : List Bool) : Prop := + ∃ x y accRev : List Bool, ∃ borrow : Bool, + state = machineBinarySubPack x y [borrow] accRev + +theorem machineBinarySubInit_wellFormed (word : List Bool) : + MachineBinarySubWellFormed (machineBinarySubInit word) := by + exact ⟨machinePairFirst word, machinePairSecond word, [], false, rfl⟩ + +theorem machineBinarySubStep_wellFormed {state : List Bool} + (hstate : MachineBinarySubWellFormed state) : + MachineBinarySubWellFormed (machineBinarySubStep state) := by + obtain ⟨x, y, accRev, borrow, rfl⟩ := hstate + rw [machineBinarySubStep_pack] + split + · exact ⟨x, y, accRev, borrow, rfl⟩ + · exact ⟨x.tail, y.tail, + BinaryRippleSub.diffBit borrow (x.head?.getD false) + (y.head?.getD false) :: accRev, + BinaryRippleSub.borrowBit borrow (x.head?.getD false) + (y.head?.getD false), rfl⟩ + +theorem machineBinarySubIterate_wellFormed_length_le + {state : List Bool} (hstate : MachineBinarySubWellFormed state) : + ∀ iterations, + MachineBinarySubWellFormed (machineBinarySubStep^[iterations] state) ∧ + (machineBinarySubStep^[iterations] state).length ≤ + state.length + iterations := by + intro iterations + induction iterations with + | zero => simpa using And.intro hstate (Nat.le_refl state.length) + | succ iterations ih => + rw [Function.iterate_succ_apply'] + obtain ⟨hwell, hlength⟩ := ih + have hnext := machineBinarySubStep_wellFormed hwell + obtain ⟨x, y, accRev, borrow, hrepr⟩ := hwell + have hstep := machineBinarySubStep_pack_length_le x y accRev borrow + rw [← hrepr] at hstep + exact ⟨hnext, by omega⟩ + +theorem machineBinarySubInit_length_le (word : List Bool) : + (machineBinarySubInit word).length ≤ 4 * word.length + 8 := by + simp only [machineBinarySubInit, machineBinarySubPack, pair_length, + List.length_cons, List.length_nil] + have hfirst := machinePairFirst_length_le word + have hsecond := machinePairSecond_length_le word + omega + +theorem machineBinarySubRuler_length_le (word : List Bool) : + (machineBinarySubRuler word).length ≤ 2 * word.length := by + simp only [machineBinarySubRuler, List.length_append] + have hfirst := machinePairFirst_length_le word + have hsecond := machinePairSecond_length_le word + omega + +@[simp] theorem machineBinarySubWidth_length (word : List Bool) : + (machineBinarySubWidth word).length = (word.length + 8) ^ 2 := by + simp [machineBinarySubWidth, pow_two] + +theorem machineBinarySubIterate_length_le_width + (word : List Bool) (iterations : ℕ) + (hiterations : iterations ≤ (machineBinarySubRuler word).length) : + (machineBinarySubStep^[iterations] + (machineBinarySubInit word)).length ≤ + (machineBinarySubWidth word).length := by + have hrun := (machineBinarySubIterate_wellFormed_length_le + (machineBinarySubInit_wellFormed word) iterations).2 + have hinit := machineBinarySubInit_length_le word + have hruler := machineBinarySubRuler_length_le word + rw [machineBinarySubWidth_length] + nlinarith + +theorem machineBinarySubFinalState_mem_FP : + machineBinarySubFinalState ∈ Complexity.FP := by + exact Cobham.iterate_mem_FP machineBinarySubStep_mem_FP + machineBinarySubInit_mem_FP machineBinarySubRuler_mem_FP + machineBinarySubWidth_mem_FP machineBinarySubIterate_length_le_width + +theorem machineBinarySubBits_mem_FP : + machineBinarySubBits ∈ Complexity.FP := by + have hborrow : (fun word => machineBinarySubBorrow + (machineBinarySubFinalState word)) ∈ Complexity.FP := + machineCompose_mem_FP machineBinarySubFinalState_mem_FP + machineBinarySubBorrow_mem_FP + have hacc : (fun word => machineBinarySubAccRev + (machineBinarySubFinalState word)) ∈ Complexity.FP := + machineCompose_mem_FP machineBinarySubFinalState_mem_FP + machineBinarySubAccRev_mem_FP + have hrev := machineCompose_mem_FP hacc machineReverse_mem_FP + have htrim := machineCompose_mem_FP hrev machineTrimHighZeros_mem_FP + simpa only [machineBinarySubBits] using machineIfHead_mem_FP hborrow + (machineConst_mem_FP []) htrim + +private theorem machineBinarySubStep_done (borrow : Bool) + (accRev : List Bool) : + machineBinarySubStep + (machineBinarySubPack [] [] [borrow] accRev) = + machineBinarySubPack [] [] [borrow] accRev := by + rw [machineBinarySubStep_pack] + simp + +private theorem machineBinarySubIterate_done (borrow : Bool) + (accRev : List Bool) (k : ℕ) : + machineBinarySubStep^[k] + (machineBinarySubPack [] [] [borrow] accRev) = + machineBinarySubPack [] [] [borrow] accRev := by + induction k with + | zero => rfl + | succ k ih => + rw [Function.iterate_succ_apply, machineBinarySubStep_done, ih] + +private theorem machineBinarySubIterate_max + (x y accRev : List Bool) (borrow : Bool) : + machineBinarySubStep^[max x.length y.length] + (machineBinarySubPack x y [borrow] accRev) = + let raw := BinaryRippleSub.scan borrow x y + machineBinarySubPack [] [] [raw.borrow] + (raw.bits.reverse ++ accRev) := by + induction hmeasure : x.length + y.length using Nat.strongRecOn + generalizing x y borrow accRev with + | ind measure ih => + cases x with + | nil => + cases y with + | nil => + simp [BinaryRippleSub.scan] + | cons y ys => + simp only [List.length_nil, List.length_cons, Nat.zero_add] + at hmeasure + have hrec := ih ys.length (by omega) [] ys + (BinaryRippleSub.diffBit borrow false y :: accRev) + (BinaryRippleSub.borrowBit borrow false y) (by simp) + have hrec' := hrec + simp only [List.length_nil] at hrec' + simp only [List.length_nil, List.length_cons] + rw [show max 0 (ys.length + 1) = + (max 0 ys.length).succ by omega, + Function.iterate_succ_apply, machineBinarySubStep_pack] + simp only [List.nil_eq, List.cons_ne_nil, and_false, + ↓reduceIte, List.tail_nil, List.tail_cons, List.head?_nil, + Option.getD_none, List.head?_cons, Option.getD_some] + rw [hrec'] + simp [BinaryRippleSub.scan, List.reverse_cons, + List.append_assoc] + | cons x xs => + cases y with + | nil => + simp only [List.length_nil, List.length_cons, Nat.add_zero] + at hmeasure + have hrec := ih xs.length (by omega) xs [] + (BinaryRippleSub.diffBit borrow x false :: accRev) + (BinaryRippleSub.borrowBit borrow x false) (by simp) + have hrec' := hrec + simp only [List.length_nil] at hrec' + simp only [List.length_nil, List.length_cons] + rw [show max (xs.length + 1) 0 = + (max xs.length 0).succ by omega, + Function.iterate_succ_apply, machineBinarySubStep_pack] + simp only [List.cons_ne_nil, List.nil_eq, and_false, + ↓reduceIte, List.tail_cons, List.tail_nil, List.head?_cons, + Option.getD_some, List.head?_nil, Option.getD_none] + simp only [false_and, if_false] + rw [hrec'] + simp [BinaryRippleSub.scan, List.reverse_cons, + List.append_assoc] + | cons y ys => + simp only [List.length_cons] at hmeasure + have hrec := ih (xs.length + ys.length) (by omega) xs ys + (BinaryRippleSub.diffBit borrow x y :: accRev) + (BinaryRippleSub.borrowBit borrow x y) rfl + simp only [List.length_cons] + rw [show max (xs.length + 1) (ys.length + 1) = + (max xs.length ys.length).succ by omega, + Function.iterate_succ_apply, machineBinarySubStep_pack] + simp only [List.cons_ne_nil, and_false, ↓reduceIte, + List.tail_cons, List.head?_cons, Option.getD_some] + rw [hrec] + simp [BinaryRippleSub.scan, List.reverse_cons, + List.append_assoc] + +/-- The machine agrees with the library's canonical ripple-borrow semantics +on arbitrary operand words. -/ +theorem machineBinarySubBits_pair_lists (x y : List Bool) : + machineBinarySubBits (pair x y) = BinaryRippleSub.subtract x y := by + simp only [machineBinarySubBits, machineBinarySubFinalState, + machineBinarySubRuler, machineBinarySubInit, machinePairFirst_pair, + machinePairSecond_pair, List.length_append] + rw [show x.length + y.length = + min x.length y.length + max x.length y.length by + have hminmax := min_add_max x.length y.length + exact hminmax.symm, + Function.iterate_add_apply, machineBinarySubIterate_max, + machineBinarySubIterate_done] + simp only [machineBinarySubBorrow_pack, machineBinarySubAccRev_pack] + let raw := BinaryRippleSub.scan false x y + change machineIfHead [raw.borrow] [] + (machineTrimHighZeros (raw.bits.reverse ++ []).reverse) = _ + simp only [List.append_nil, List.reverse_reverse] + rw [machineTrimHighZeros_eq] + cases hborrow : raw.borrow with + | false => + rw [machineIfHead_false] + simp [BinaryRippleSub.subtract, raw, hborrow] + | true => + rw [machineIfHead_true] + simp [BinaryRippleSub.subtract, raw, hborrow] + +theorem binaryRippleSub_scan_bits_length : + ∀ (borrow : Bool) (x y : List Bool), + (BinaryRippleSub.scan borrow x y).bits.length = + max x.length y.length := by + intro borrow x y + induction x generalizing borrow y with + | nil => + induction y generalizing borrow with + | nil => simp [BinaryRippleSub.scan] + | cons bit rest ih => + simp [BinaryRippleSub.scan, ih] + | cons bit rest ih => + cases y with + | nil => + simp [BinaryRippleSub.scan, ih] + | cons other tail => + simp [BinaryRippleSub.scan, ih] + +theorem binaryRippleSub_trimHighZeros_length_le : ∀ bits : List Bool, + (BinaryRippleSub.trimHighZeros bits).length ≤ bits.length := by + intro bits + induction bits with + | nil => rfl + | cons bit rest ih => + simp only [BinaryRippleSub.trimHighZeros] + cases htrim : BinaryRippleSub.trimHighZeros rest with + | nil => cases bit <;> simp + | cons high tail => + simp only [htrim, List.length_cons] at ih ⊢ + omega + +theorem binaryRippleSub_subtract_length_le (x y : List Bool) : + (BinaryRippleSub.subtract x y).length ≤ max x.length y.length := by + rw [BinaryRippleSub.subtract] + let raw := BinaryRippleSub.scan false x y + cases raw.borrow + · exact (binaryRippleSub_trimHighZeros_length_le raw.bits).trans_eq + (binaryRippleSub_scan_bits_length false x y) + · simp + +theorem machineBinarySubBits_pair_length_le (x y : List Bool) : + (machineBinarySubBits (pair x y)).length ≤ max x.length y.length := by + rw [machineBinarySubBits_pair_lists] + exact binaryRippleSub_subtract_length_le x y + +theorem machineBinarySubBits_pair_natBits (lhs rhs : ℕ) : + machineBinarySubBits (pair lhs.bits rhs.bits) = (lhs - rhs).bits := by + rw [machineBinarySubBits_pair_lists, + BinaryRippleSub.subtract_natBits] + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineBitAssembly.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineBitAssembly.lean new file mode 100644 index 0000000000..41552afa9a --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineBitAssembly.lean @@ -0,0 +1,318 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineBinaryAddSemantics +import LeanPool.BeyondBethe.BeyondBethe.MachineRAMBridge + +/-! +# Assembling a polynomial number of queried output bits + +This file turns any one-bit `FP` query routine into a full output routine. At +iteration `k`, the state stores `k.bits`, the first `k` queried bits, and the +unchanged original input. A verified binary addition increments the counter. +-/ + +namespace BeyondBethe + +open Complexity + +/-- Query bit `k`, represented by the canonical paired input +`pair k.bits word`. Truncating to `machineHeadBit` guarantees one output bit +even on malformed inputs or for a total query function with arbitrary output. -/ +def machineQueriedBit (query : List Bool → List Bool) + (counter word : List Bool) : List Bool := + machineHeadBit (query (pair counter word)) + +def machineBitAssemblyPack + (counter acc word : List Bool) : List Bool := + pair counter (pair acc word) + +def machineBitAssemblyCounter (state : List Bool) : List Bool := + machinePairFirst state + +def machineBitAssemblyAcc (state : List Bool) : List Bool := + machinePairFirst (machinePairSecond state) + +def machineBitAssemblyInput (state : List Bool) : List Bool := + machinePairSecond (machinePairSecond state) + +def machineBitAssemblyNextCounter (state : List Bool) : List Bool := + machineBinaryAddBits + (pair (machineBitAssemblyCounter state) [true]) + +def machineBitAssemblyStep (query : List Bool → List Bool) + (state : List Bool) : List Bool := + machineBitAssemblyPack + (machineBitAssemblyNextCounter state) + (machineBitAssemblyAcc state ++ + machineQueriedBit query (machineBitAssemblyCounter state) + (machineBitAssemblyInput state)) + (machineBitAssemblyInput state) + +def machineBitAssemblyInit (word : List Bool) : List Bool := + machineBitAssemblyPack [] [] word + +/-- A state with two ruler-sized fields is an exact length envelope for every +semantic assembly state before the ruler is exhausted. -/ +def machineBitAssemblyWidth (ruler : List Bool → List Bool) + (word : List Bool) : List Bool := + machineBitAssemblyPack (ruler word) (ruler word) word + +def machineBitAssemblyFinalState + (query ruler : List Bool → List Bool) (word : List Bool) : List Bool := + (machineBitAssemblyStep query)^[(ruler word).length] + (machineBitAssemblyInit word) + +def machineAssembleBits + (query ruler : List Bool → List Bool) (word : List Bool) : List Bool := + machineBitAssemblyAcc (machineBitAssemblyFinalState query ruler word) + +theorem machineBitAssemblyCounter_mem_FP : + machineBitAssemblyCounter ∈ Complexity.FP := by + simpa only [machineBitAssemblyCounter] using machinePairFirst_mem_FP + +theorem machineBitAssemblyAcc_mem_FP : + machineBitAssemblyAcc ∈ Complexity.FP := by + simpa only [machineBitAssemblyAcc] using + machineCompose_mem_FP machinePairSecond_mem_FP machinePairFirst_mem_FP + +theorem machineBitAssemblyInput_mem_FP : + machineBitAssemblyInput ∈ Complexity.FP := by + simpa only [machineBitAssemblyInput] using + machineCompose_mem_FP machinePairSecond_mem_FP machinePairSecond_mem_FP + +theorem machineQueriedBit_mem_FP + {query counter word : List Bool → List Bool} + (hquery : query ∈ Complexity.FP) + (hcounter : counter ∈ Complexity.FP) + (hword : word ∈ Complexity.FP) : + (fun input => machineQueriedBit query (counter input) (word input)) ∈ + Complexity.FP := by + have hpayload : + (fun input => pair (counter input) (word input)) ∈ Complexity.FP := + machinePair_mem_FP hcounter hword + exact machineCompose_mem_FP + (machineCompose_mem_FP hpayload hquery) machineHeadBit_mem_FP + +theorem machineBitAssemblyNextCounter_mem_FP : + machineBitAssemblyNextCounter ∈ Complexity.FP := by + have hpayload : + (fun state => pair (machineBitAssemblyCounter state) [true]) ∈ + Complexity.FP := + machinePair_mem_FP machineBitAssemblyCounter_mem_FP + (machineConst_mem_FP [true]) + simpa only [machineBitAssemblyNextCounter] using + machineCompose_mem_FP hpayload machineBinaryAddBits_mem_FP + +theorem machineBitAssemblyStep_mem_FP + {query : List Bool → List Bool} (hquery : query ∈ Complexity.FP) : + machineBitAssemblyStep query ∈ Complexity.FP := by + have hbit : + (fun state => machineQueriedBit query + (machineBitAssemblyCounter state) + (machineBitAssemblyInput state)) ∈ Complexity.FP := + machineQueriedBit_mem_FP hquery machineBitAssemblyCounter_mem_FP + machineBitAssemblyInput_mem_FP + have hacc : + (fun state => machineBitAssemblyAcc state ++ + machineQueriedBit query (machineBitAssemblyCounter state) + (machineBitAssemblyInput state)) ∈ Complexity.FP := + machineAppend_mem_FP machineBitAssemblyAcc_mem_FP hbit + exact machinePair_mem_FP machineBitAssemblyNextCounter_mem_FP + (machinePair_mem_FP hacc machineBitAssemblyInput_mem_FP) + +theorem machineBitAssemblyInit_mem_FP : + machineBitAssemblyInit ∈ Complexity.FP := by + exact machinePair_mem_FP (machineConst_mem_FP []) + (machinePair_mem_FP (machineConst_mem_FP []) id_mem_FP) + +theorem machineBitAssemblyWidth_mem_FP + {ruler : List Bool → List Bool} (hruler : ruler ∈ Complexity.FP) : + machineBitAssemblyWidth ruler ∈ Complexity.FP := by + exact machinePair_mem_FP hruler (machinePair_mem_FP hruler id_mem_FP) + +@[simp] theorem machineBitAssemblyCounter_pack (counter acc word) : + machineBitAssemblyCounter (machineBitAssemblyPack counter acc word) = + counter := by + simp [machineBitAssemblyCounter, machineBitAssemblyPack] + +@[simp] theorem machineBitAssemblyAcc_pack (counter acc word) : + machineBitAssemblyAcc (machineBitAssemblyPack counter acc word) = acc := by + simp [machineBitAssemblyAcc, machineBitAssemblyPack] + +@[simp] theorem machineBitAssemblyInput_pack (counter acc word) : + machineBitAssemblyInput (machineBitAssemblyPack counter acc word) = word := by + simp [machineBitAssemblyInput, machineBitAssemblyPack] + +/-- The semantic list of the first `iterations` queried bits. -/ +def assembledQueryBits (query : List Bool → List Bool) + (word : List Bool) : ℕ → List Bool + | 0 => [] + | k + 1 => assembledQueryBits query word k ++ + machineHeadBit (query (pair k.bits word)) + +@[simp] theorem assembledQueryBits_length + (query : List Bool → List Bool) (word : List Bool) : + ∀ k, (assembledQueryBits query word k).length = k := by + intro k + induction k with + | zero => rfl + | succ k ih => + simp [assembledQueryBits, ih] + +theorem natBits_length_le_self (k : ℕ) : k.bits.length ≤ k := by + rw [Nat.size_eq_bits_len] + exact Nat.size_le.mpr k.lt_two_pow_self + +@[simp] theorem machineBitAssemblyStep_semantics + (query : List Bool → List Bool) (word : List Bool) (k : ℕ) : + machineBitAssemblyStep query + (machineBitAssemblyPack k.bits + (assembledQueryBits query word k) word) = + machineBitAssemblyPack (k + 1).bits + (assembledQueryBits query word (k + 1)) word := by + simp only [machineBitAssemblyStep, machineBitAssemblyNextCounter, + machineBitAssemblyCounter_pack, machineBitAssemblyAcc_pack, + machineQueriedBit, machineBitAssemblyInput_pack, assembledQueryBits] + rw [show ([true] : List Bool) = (1 : ℕ).bits by decide, + machineBinaryAddBits_pair_natBits] + +theorem machineBitAssemblyIterate_semantics + (query : List Bool → List Bool) (word : List Bool) : + ∀ k, + (machineBitAssemblyStep query)^[k] (machineBitAssemblyInit word) = + machineBitAssemblyPack k.bits + (assembledQueryBits query word k) word := by + intro k + induction k with + | zero => rfl + | succ k ih => + rw [Function.iterate_succ_apply', ih, + machineBitAssemblyStep_semantics] + +theorem machineBitAssemblyIterate_length_le_width + (query ruler : List Bool → List Bool) (word : List Bool) + (iterations : ℕ) (hiterations : iterations ≤ (ruler word).length) : + ((machineBitAssemblyStep query)^[iterations] + (machineBitAssemblyInit word)).length ≤ + (machineBitAssemblyWidth ruler word).length := by + rw [machineBitAssemblyIterate_semantics] + simp only [machineBitAssemblyPack, pair_length] + have hcounter := natBits_length_le_self iterations + have hacc := assembledQueryBits_length query word iterations + simp only [machineBitAssemblyWidth, machineBitAssemblyPack, pair_length] + omega + +theorem machineBitAssemblyFinalState_mem_FP + {query ruler : List Bool → List Bool} + (hquery : query ∈ Complexity.FP) (hruler : ruler ∈ Complexity.FP) : + machineBitAssemblyFinalState query ruler ∈ Complexity.FP := by + exact Cobham.iterate_mem_FP (machineBitAssemblyStep_mem_FP hquery) + machineBitAssemblyInit_mem_FP hruler + (machineBitAssemblyWidth_mem_FP hruler) + (machineBitAssemblyIterate_length_le_width query ruler) + +theorem machineAssembleBits_mem_FP + {query ruler : List Bool → List Bool} + (hquery : query ∈ Complexity.FP) (hruler : ruler ∈ Complexity.FP) : + machineAssembleBits query ruler ∈ Complexity.FP := by + simpa only [machineAssembleBits] using + machineCompose_mem_FP + (machineBitAssemblyFinalState_mem_FP hquery hruler) + machineBitAssemblyAcc_mem_FP + +theorem machineAssembleBits_eq + (query ruler : List Bool → List Bool) (word : List Bool) : + machineAssembleBits query ruler word = + assembledQueryBits query word (ruler word).length := by + simp [machineAssembleBits, machineBitAssemblyFinalState, + machineBitAssemblyIterate_semantics] + +theorem assembledQueryBits_eq_take + (query target : List Bool → List Bool) + (hquery : ∀ word k, k < (target word).length → + query (pair k.bits word) = [(target word)[k]?.getD false]) : + ∀ word k, k ≤ (target word).length → + assembledQueryBits query word k = (target word).take k := by + intro word k hk + induction k with + | zero => rfl + | succ k ih => + have hklt : k < (target word).length := by omega + rw [assembledQueryBits, ih (by omega), hquery word k hklt] + simp only [machineHeadBit_cons] + rw [List.getElem?_eq_getElem hklt] + simp only [Option.getD_some] + exact (List.take_succ_eq_append_getElem hklt).symm + +/-- Exact bit queries assembled for exactly the target length reproduce the +target word, including internal and trailing zero bits. -/ +theorem machineAssembleBits_realizes + (query ruler target : List Bool → List Bool) + (hruler : ∀ word, (ruler word).length = (target word).length) + (hquery : ∀ word k, k < (target word).length → + query (pair k.bits word) = [(target word)[k]?.getD false]) : + machineAssembleBits query ruler = target := by + funext word + rw [machineAssembleBits_eq, hruler, + assembledQueryBits_eq_take query target hquery word + (target word).length le_rfl, + List.take_length] + +/-- The bit graph of a total string function, expressed using canonical +pairing and little-endian natural indices. -/ +def outputBitLanguage (target : List Bool → List Bool) : Language := + {payload | (target (machinePairSecond payload))[ + Nat.fromBitsLE (machinePairFirst payload)]?.getD false = true} + +instance outputBitLanguage_decidable (target : List Bool → List Bool) : + DecidablePred (fun word => word ∈ outputBitLanguage target) := by + intro word + change Decidable + ((target (machinePairSecond word))[ + Nat.fromBitsLE (machinePairFirst word)]?.getD false = true) + infer_instance + +theorem outputBitLanguage_flag_pair_all + (target : List Bool → List Bool) (word : List Bool) (k : ℕ) : + MachineRAMBridge.languageFlag (outputBitLanguage target) + (pair k.bits word) = [(target word)[k]?.getD false] := by + simp only [MachineRAMBridge.languageFlag, outputBitLanguage, + machinePairFirst_pair, machinePairSecond_pair, Nat.fromBitsLE_bits, + Set.mem_setOf_eq] + cases hbit : (target word)[k]? with + | none => simp [hbit] + | some bit => cases bit <;> simp [hbit] + +theorem outputBitLanguage_flag_pair + (target : List Bool → List Bool) (word : List Bool) (k : ℕ) + (_hk : k < (target word).length) : + MachineRAMBridge.languageFlag (outputBitLanguage target) + (pair k.bits word) = [(target word)[k]?.getD false] := + outputBitLanguage_flag_pair_all target word k + +/-- A polynomial-time RAM decider for the bit graph, together with an `FP` +ruler of the exact output length, yields an unconditional `FP` implementation +of the whole string function. -/ +theorem target_mem_FP_of_ramBitProgram + (target ruler : List Bool → List Bool) + (program : RAM.Program) (p : Polynomial ℕ) + (hdecides : program.DecidesInTime (outputBitLanguage target) p.eval) + (hrulerFP : ruler ∈ Complexity.FP) + (hrulerLength : ∀ word, + (ruler word).length = (target word).length) : + target ∈ Complexity.FP := by + let query := MachineRAMBridge.languageFlag (outputBitLanguage target) + have hqueryFP : query ∈ Complexity.FP := + MachineRAMBridge.languageFlag_mem_FP_of_ramProgram program p hdecides + have hassembly : machineAssembleBits query ruler ∈ Complexity.FP := + machineAssembleBits_mem_FP hqueryFP hrulerFP + have heq : machineAssembleBits query ruler = target := + machineAssembleBits_realizes query ruler target hrulerLength + (outputBitLanguage_flag_pair target) + rwa [heq] at hassembly + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineBool.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineBool.lean new file mode 100644 index 0000000000..3cbd1d5a6b --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineBool.lean @@ -0,0 +1,120 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineFPBasics + +/-! +# Verified one-bit machine logic + +Boolean values are represented by the one-bit words `[false]` and `[true]`. +The definitions remain total on arbitrary bitstrings by inspecting only the +leading bit through the verified selector machine. +-/ + +namespace BeyondBethe + +open Complexity + +def machineNotBit (a : List Bool) : List Bool := + machineIfHead a [false] [true] + +def machineXorBit (a b : List Bool) : List Bool := + machineIfHead a (machineNotBit b) b + +def machineAndBit (a b : List Bool) : List Bool := + machineIfHead a b [false] + +def machineOrBit (a b : List Bool) : List Bool := + machineIfHead a [true] b + +def machineMajorityBit (a b c : List Bool) : List Bool := + machineOrBit (machineAndBit a b) + (machineOrBit (machineAndBit a c) (machineAndBit b c)) + +def machineFullAdderSum (a b carry : List Bool) : List Bool := + machineXorBit (machineXorBit a b) carry + +def machineFullAdderCarry (a b carry : List Bool) : List Bool := + machineMajorityBit a b carry + +theorem machineNotBit_mem_FP {a : List Bool → List Bool} + (ha : a ∈ Complexity.FP) : + (fun word => machineNotBit (a word)) ∈ Complexity.FP := by + exact machineIfHead_mem_FP ha (machineConst_mem_FP [false]) + (machineConst_mem_FP [true]) + +theorem machineXorBit_mem_FP + {a b : List Bool → List Bool} + (ha : a ∈ Complexity.FP) (hb : b ∈ Complexity.FP) : + (fun word => machineXorBit (a word) (b word)) ∈ Complexity.FP := by + exact machineIfHead_mem_FP ha (machineNotBit_mem_FP hb) hb + +theorem machineAndBit_mem_FP + {a b : List Bool → List Bool} + (ha : a ∈ Complexity.FP) (hb : b ∈ Complexity.FP) : + (fun word => machineAndBit (a word) (b word)) ∈ Complexity.FP := by + exact machineIfHead_mem_FP ha hb (machineConst_mem_FP [false]) + +theorem machineOrBit_mem_FP + {a b : List Bool → List Bool} + (ha : a ∈ Complexity.FP) (hb : b ∈ Complexity.FP) : + (fun word => machineOrBit (a word) (b word)) ∈ Complexity.FP := by + exact machineIfHead_mem_FP ha (machineConst_mem_FP [true]) hb + +theorem machineMajorityBit_mem_FP + {a b c : List Bool → List Bool} + (ha : a ∈ Complexity.FP) (hb : b ∈ Complexity.FP) + (hc : c ∈ Complexity.FP) : + (fun word => machineMajorityBit (a word) (b word) (c word)) ∈ + Complexity.FP := by + apply machineOrBit_mem_FP + · exact machineAndBit_mem_FP ha hb + · apply machineOrBit_mem_FP + · exact machineAndBit_mem_FP ha hc + · exact machineAndBit_mem_FP hb hc + +theorem machineFullAdderSum_mem_FP + {a b carry : List Bool → List Bool} + (ha : a ∈ Complexity.FP) (hb : b ∈ Complexity.FP) + (hcarry : carry ∈ Complexity.FP) : + (fun word => machineFullAdderSum (a word) (b word) (carry word)) ∈ + Complexity.FP := by + exact machineXorBit_mem_FP (machineXorBit_mem_FP ha hb) hcarry + +theorem machineFullAdderCarry_mem_FP + {a b carry : List Bool → List Bool} + (ha : a ∈ Complexity.FP) (hb : b ∈ Complexity.FP) + (hcarry : carry ∈ Complexity.FP) : + (fun word => machineFullAdderCarry (a word) (b word) (carry word)) ∈ + Complexity.FP := by + exact machineMajorityBit_mem_FP ha hb hcarry + +@[simp] theorem machineNotBit_one (a : Bool) : + machineNotBit [a] = [!a] := by + cases a <;> rfl + +@[simp] theorem machineXorBit_one (a b : Bool) : + machineXorBit [a] [b] = [xor a b] := by + cases a <;> cases b <;> rfl + +@[simp] theorem machineAndBit_one (a b : Bool) : + machineAndBit [a] [b] = [a && b] := by + cases a <;> cases b <;> rfl + +@[simp] theorem machineOrBit_one (a b : Bool) : + machineOrBit [a] [b] = [a || b] := by + cases a <;> cases b <;> rfl + +@[simp] theorem machineFullAdderSum_one (a b carry : Bool) : + machineFullAdderSum [a] [b] [carry] = [xor (xor a b) carry] := by + simp [machineFullAdderSum] + +@[simp] theorem machineFullAdderCarry_one (a b carry : Bool) : + machineFullAdderCarry [a] [b] [carry] = + [(a && b) || (a && carry) || (b && carry)] := by + cases a <;> cases b <;> cases carry <;> rfl + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineBooleanInit.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineBooleanInit.lean new file mode 100644 index 0000000000..1ab5738df3 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineBooleanInit.lean @@ -0,0 +1,399 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineBooleanMemory + +/-! +# Polynomially bounded Boolean storage initialization + +The matching machine needs all-false vectors and square Boolean matrices. +Both constructors use unary dimension rulers. Their state is clamped by a +quadratic word computed from the original input; the exact semantic bounds +show that this clamp is inactive on canonical dimension rulers. +-/ + +namespace BeyondBethe + +open Complexity + +/-! ## False vectors -/ + +def machineFalseVectorStep (acc : List Bool) : List Bool := + pair [false] acc + +def machineFalseVectorWidth (ruler : List Bool) : List Bool := + machineBinaryMulWidth ruler + +def machineFalseVectorCode (ruler : List Bool) : List Bool := + (machineFalseVectorStep)^[ruler.length] [] + +theorem machineFalseVectorStep_mem_FP : + machineFalseVectorStep ∈ Complexity.FP := by + exact machinePair_mem_FP (machineConst_mem_FP [false]) id_mem_FP + +theorem machineFalseVectorWidth_mem_FP : + machineFalseVectorWidth ∈ Complexity.FP := + machineBinaryMulWidth_mem_FP + +theorem machineFalseVectorIterate_semantics : ∀ k, + (machineFalseVectorStep)^[k] [] = + boolVectorCode (List.replicate k false) := by + intro k + induction k with + | zero => rfl + | succ k ih => + rw [Function.iterate_succ_apply', ih] + simp [machineFalseVectorStep, boolVectorCode, binaryListCode, + boolElementCode, List.replicate_succ] + +theorem machineFalseVectorIterate_length_le_width + (ruler : List Bool) (iterations : ℕ) + (hiterations : iterations ≤ ruler.length) : + ((machineFalseVectorStep)^[iterations] []).length ≤ + (machineFalseVectorWidth ruler).length := by + rw [machineFalseVectorIterate_semantics] + simp only [boolVectorCode, binaryListCode_length_eq_sum, + List.map_replicate, List.sum_replicate, boolElementCode, + List.length_singleton, machineFalseVectorWidth, + machineBinaryMulWidth, List.length_replicate, List.length_append, + Nat.nsmul_eq_mul] + nlinarith + +theorem machineFalseVectorCode_mem_FP : + machineFalseVectorCode ∈ Complexity.FP := by + simpa only [machineFalseVectorCode] using + Cobham.iterate_mem_FP machineFalseVectorStep_mem_FP + (machineConst_mem_FP []) id_mem_FP machineFalseVectorWidth_mem_FP + machineFalseVectorIterate_length_le_width + +@[simp] theorem machineFalseVectorCode_encode (n : ℕ) : + machineFalseVectorCode (List.replicate n true) = + boolVectorCode (List.replicate n false) := by + rw [machineFalseVectorCode, List.length_replicate, + machineFalseVectorIterate_semantics] + +/-! ## Repeated-row matrices -/ + +def machineRepeatedRowMatrixRuler (word : List Bool) : List Bool := + machinePairFirst word + +def machineRepeatedRowMatrixRow (word : List Bool) : List Bool := + machinePairSecond word + +def machineRepeatedRowMatrixBound (word : List Bool) : List Bool := + machineBinaryMulWidth word + +def machineRepeatedRowMatrixPack + (row acc bound : List Bool) : List Bool := + pair row (pair acc bound) + +def machineRepeatedRowMatrixStateRow (state : List Bool) : List Bool := + machinePairFirst state + +def machineRepeatedRowMatrixStateAcc (state : List Bool) : List Bool := + machinePairFirst (machinePairSecond state) + +def machineRepeatedRowMatrixStateBound (state : List Bool) : List Bool := + machinePairSecond (machinePairSecond state) + +def machineRepeatedRowMatrixCandidate (state : List Bool) : List Bool := + pair (machineRepeatedRowMatrixStateRow state) + (machineRepeatedRowMatrixStateAcc state) + +def machineRepeatedRowMatrixNextAcc (state : List Bool) : List Bool := + (machineRepeatedRowMatrixCandidate state).take + (machineRepeatedRowMatrixStateBound state).length + +def machineRepeatedRowMatrixStep (state : List Bool) : List Bool := + machineRepeatedRowMatrixPack (machineRepeatedRowMatrixStateRow state) + (machineRepeatedRowMatrixNextAcc state) + (machineRepeatedRowMatrixStateBound state) + +def machineRepeatedRowMatrixInit (word : List Bool) : List Bool := + machineRepeatedRowMatrixPack (machineRepeatedRowMatrixRow word) [] + (machineRepeatedRowMatrixBound word) + +def machineRepeatedRowMatrixWidth (word : List Bool) : List Bool := + machineRepeatedRowMatrixPack (machineRepeatedRowMatrixBound word) + (machineRepeatedRowMatrixBound word) + (machineRepeatedRowMatrixBound word) + +def machineRepeatedRowMatrixFinalState (word : List Bool) : List Bool := + (machineRepeatedRowMatrixStep)^[(machineRepeatedRowMatrixRuler word).length] + (machineRepeatedRowMatrixInit word) + +def machineRepeatedRowMatrixCode (word : List Bool) : List Bool := + machineRepeatedRowMatrixStateAcc + (machineRepeatedRowMatrixFinalState word) + +theorem machineRepeatedRowMatrixRuler_mem_FP : + machineRepeatedRowMatrixRuler ∈ Complexity.FP := + machinePairFirst_mem_FP + +theorem machineRepeatedRowMatrixRow_mem_FP : + machineRepeatedRowMatrixRow ∈ Complexity.FP := + machinePairSecond_mem_FP + +theorem machineRepeatedRowMatrixBound_mem_FP : + machineRepeatedRowMatrixBound ∈ Complexity.FP := + machineBinaryMulWidth_mem_FP + +theorem machineRepeatedRowMatrixStateRow_mem_FP : + machineRepeatedRowMatrixStateRow ∈ Complexity.FP := + machinePairFirst_mem_FP + +theorem machineRepeatedRowMatrixStateAcc_mem_FP : + machineRepeatedRowMatrixStateAcc ∈ Complexity.FP := by + simpa only [machineRepeatedRowMatrixStateAcc] using + machineCompose_mem_FP machinePairSecond_mem_FP machinePairFirst_mem_FP + +theorem machineRepeatedRowMatrixStateBound_mem_FP : + machineRepeatedRowMatrixStateBound ∈ Complexity.FP := by + simpa only [machineRepeatedRowMatrixStateBound] using + machineCompose_mem_FP machinePairSecond_mem_FP machinePairSecond_mem_FP + +theorem machineRepeatedRowMatrixCandidate_mem_FP : + machineRepeatedRowMatrixCandidate ∈ Complexity.FP := by + exact machinePair_mem_FP machineRepeatedRowMatrixStateRow_mem_FP + machineRepeatedRowMatrixStateAcc_mem_FP + +theorem machineRepeatedRowMatrixNextAcc_mem_FP : + machineRepeatedRowMatrixNextAcc ∈ Complexity.FP := by + simpa only [machineRepeatedRowMatrixNextAcc] using + machineTake_mem_FP machineRepeatedRowMatrixStateBound_mem_FP + machineRepeatedRowMatrixCandidate_mem_FP + +theorem machineRepeatedRowMatrixStep_mem_FP : + machineRepeatedRowMatrixStep ∈ Complexity.FP := by + exact machinePair_mem_FP machineRepeatedRowMatrixStateRow_mem_FP + (machinePair_mem_FP machineRepeatedRowMatrixNextAcc_mem_FP + machineRepeatedRowMatrixStateBound_mem_FP) + +theorem machineRepeatedRowMatrixInit_mem_FP : + machineRepeatedRowMatrixInit ∈ Complexity.FP := by + exact machinePair_mem_FP machineRepeatedRowMatrixRow_mem_FP + (machinePair_mem_FP (machineConst_mem_FP []) + machineRepeatedRowMatrixBound_mem_FP) + +theorem machineRepeatedRowMatrixWidth_mem_FP : + machineRepeatedRowMatrixWidth ∈ Complexity.FP := by + exact machinePair_mem_FP machineRepeatedRowMatrixBound_mem_FP + (machinePair_mem_FP machineRepeatedRowMatrixBound_mem_FP + machineRepeatedRowMatrixBound_mem_FP) + +@[simp] theorem machineRepeatedRowMatrixStateRow_pack (a b c) : + machineRepeatedRowMatrixStateRow + (machineRepeatedRowMatrixPack a b c) = a := by + simp [machineRepeatedRowMatrixStateRow, machineRepeatedRowMatrixPack] + +@[simp] theorem machineRepeatedRowMatrixStateAcc_pack (a b c) : + machineRepeatedRowMatrixStateAcc + (machineRepeatedRowMatrixPack a b c) = b := by + simp [machineRepeatedRowMatrixStateAcc, machineRepeatedRowMatrixPack] + +@[simp] theorem machineRepeatedRowMatrixStateBound_pack (a b c) : + machineRepeatedRowMatrixStateBound + (machineRepeatedRowMatrixPack a b c) = c := by + simp [machineRepeatedRowMatrixStateBound, machineRepeatedRowMatrixPack] + +def MachineRepeatedRowMatrixStateBound + (word state : List Bool) : Prop := + let B := (machineRepeatedRowMatrixBound word).length + state = machineRepeatedRowMatrixPack + (machineRepeatedRowMatrixStateRow state) + (machineRepeatedRowMatrixStateAcc state) + (machineRepeatedRowMatrixStateBound state) ∧ + (machineRepeatedRowMatrixStateRow state).length ≤ B ∧ + (machineRepeatedRowMatrixStateAcc state).length ≤ B ∧ + (machineRepeatedRowMatrixStateBound state).length ≤ B + +theorem machineRepeatedRowMatrix_word_length_le_bound (word : List Bool) : + word.length ≤ (machineRepeatedRowMatrixBound word).length := by + simp only [machineRepeatedRowMatrixBound, machineBinaryMulWidth, + List.length_replicate, List.length_append] + nlinarith + +theorem machineRepeatedRowMatrixInit_bound (word : List Bool) : + MachineRepeatedRowMatrixStateBound word + (machineRepeatedRowMatrixInit word) := by + simp only [MachineRepeatedRowMatrixStateBound, + machineRepeatedRowMatrixInit, + machineRepeatedRowMatrixStateRow_pack, + machineRepeatedRowMatrixStateAcc_pack, + machineRepeatedRowMatrixStateBound_pack] + refine ⟨trivial, ?_, by simp, le_rfl⟩ + exact (machinePairSecond_length_le word).trans + (machineRepeatedRowMatrix_word_length_le_bound word) + +theorem machineRepeatedRowMatrixStep_bound + {word state : List Bool} + (hstate : MachineRepeatedRowMatrixStateBound word state) : + MachineRepeatedRowMatrixStateBound word + (machineRepeatedRowMatrixStep state) := by + dsimp only [MachineRepeatedRowMatrixStateBound] at hstate ⊢ + rcases hstate with ⟨_, hrow, _hacc, hbound⟩ + simp only [machineRepeatedRowMatrixStep, + machineRepeatedRowMatrixStateRow_pack, + machineRepeatedRowMatrixStateAcc_pack, + machineRepeatedRowMatrixStateBound_pack] + refine ⟨trivial, hrow, ?_, hbound⟩ + exact (List.length_take_le _ _).trans hbound + +theorem machineRepeatedRowMatrixIterate_bound (word : List Bool) : ∀ k, + MachineRepeatedRowMatrixStateBound word + ((machineRepeatedRowMatrixStep)^[k] + (machineRepeatedRowMatrixInit word)) := by + intro k + induction k with + | zero => exact machineRepeatedRowMatrixInit_bound word + | succ k ih => + rw [Function.iterate_succ_apply'] + exact machineRepeatedRowMatrixStep_bound ih + +theorem machineRepeatedRowMatrixIterate_length_le_width + (word : List Bool) (iterations : ℕ) + (_ : iterations ≤ (machineRepeatedRowMatrixRuler word).length) : + ((machineRepeatedRowMatrixStep)^[iterations] + (machineRepeatedRowMatrixInit word)).length ≤ + (machineRepeatedRowMatrixWidth word).length := by + rcases machineRepeatedRowMatrixIterate_bound word iterations with + ⟨hdecomp, hrow, hacc, hbound⟩ + rw [hdecomp] + simp only [machineRepeatedRowMatrixPack, + machineRepeatedRowMatrixWidth, pair_length] + omega + +theorem machineRepeatedRowMatrixFinalState_mem_FP : + machineRepeatedRowMatrixFinalState ∈ Complexity.FP := by + exact Cobham.iterate_mem_FP machineRepeatedRowMatrixStep_mem_FP + machineRepeatedRowMatrixInit_mem_FP + machineRepeatedRowMatrixRuler_mem_FP + machineRepeatedRowMatrixWidth_mem_FP + machineRepeatedRowMatrixIterate_length_le_width + +theorem machineRepeatedRowMatrixCode_mem_FP : + machineRepeatedRowMatrixCode ∈ Complexity.FP := by + simpa only [machineRepeatedRowMatrixCode] using + machineCompose_mem_FP machineRepeatedRowMatrixFinalState_mem_FP + machineRepeatedRowMatrixStateAcc_mem_FP + +/-! ## Exact all-false square matrices -/ + +def machineFalseSquareBuilderInput (n : ℕ) : List Bool := + pair (List.replicate n true) + (boolVectorCode (List.replicate n false)) + +def machineFalseSquareBuilderState (n k : ℕ) : List Bool := + let word := machineFalseSquareBuilderInput n + let row := List.replicate n false + machineRepeatedRowMatrixPack (boolVectorCode row) + (boolMatrixCode (List.replicate k row)) + (machineRepeatedRowMatrixBound word) + +theorem machineFalseSquareBuilderInit_semantics (n : ℕ) : + machineRepeatedRowMatrixInit (machineFalseSquareBuilderInput n) = + machineFalseSquareBuilderState n 0 := by + simp [machineRepeatedRowMatrixInit, machineFalseSquareBuilderInput, + machineFalseSquareBuilderState, machineRepeatedRowMatrixRow, + boolMatrixCode, binaryListCode] + +theorem machineFalseSquareBuilderStep_semantics + (n k : ℕ) (hk : k < n) : + machineRepeatedRowMatrixStep (machineFalseSquareBuilderState n k) = + machineFalseSquareBuilderState n (k + 1) := by + let word := machineFalseSquareBuilderInput n + let row := List.replicate n false + have hrowLength : (boolVectorCode row).length = 4 * n := by + simp [boolVectorCode, binaryListCode_length_eq_sum, row, + boolElementCode, Nat.nsmul_eq_mul] + omega + have hmatrixLength : + (boolMatrixCode (List.replicate (k + 1) row)).length = + (k + 1) * (2 * (boolVectorCode row).length + 2) := by + simp [boolMatrixCode, binaryListCode_length_eq_sum, + Nat.nsmul_eq_mul] + have hbound : + (boolMatrixCode (List.replicate (k + 1) row)).length ≤ + (machineRepeatedRowMatrixBound word).length := by + rw [hmatrixLength, hrowLength] + simp only [machineRepeatedRowMatrixBound, machineBinaryMulWidth, + word, machineFalseSquareBuilderInput, pair_length, + List.length_replicate, List.length_append] + have hrowCode : + (boolVectorCode (List.replicate n false)).length = 4 * n := by + simpa only [row] using hrowLength + rw [hrowCode] + nlinarith + have htake : + (boolMatrixCode (List.replicate (k + 1) row)).take + (machineRepeatedRowMatrixBound word).length = + boolMatrixCode (List.replicate (k + 1) row) := + List.take_of_length_le hbound + simp only [machineRepeatedRowMatrixStep, + machineFalseSquareBuilderState, + machineRepeatedRowMatrixStateRow_pack, + machineRepeatedRowMatrixStateAcc_pack, + machineRepeatedRowMatrixStateBound_pack, + machineRepeatedRowMatrixNextAcc, + machineRepeatedRowMatrixCandidate] + change machineRepeatedRowMatrixPack (boolVectorCode row) + ((boolMatrixCode (List.replicate (k + 1) row)).take + (machineRepeatedRowMatrixBound word).length) + (machineRepeatedRowMatrixBound word) = _ + rw [htake] + +theorem machineFalseSquareBuilderIterate_semantics (n : ℕ) : ∀ k ≤ n, + (machineRepeatedRowMatrixStep)^[k] + (machineRepeatedRowMatrixInit (machineFalseSquareBuilderInput n)) = + machineFalseSquareBuilderState n k := by + intro k hk + induction k with + | zero => exact machineFalseSquareBuilderInit_semantics n + | succ k ih => + rw [Function.iterate_succ_apply', ih (by omega)] + exact machineFalseSquareBuilderStep_semantics n k (by omega) + +@[simp] theorem machineRepeatedRowMatrixCode_falseSquare (n : ℕ) : + machineRepeatedRowMatrixCode (machineFalseSquareBuilderInput n) = + boolMatrixCode + (List.replicate n (List.replicate n false)) := by + rw [machineRepeatedRowMatrixCode, machineRepeatedRowMatrixFinalState] + simp only [machineRepeatedRowMatrixRuler, + machineFalseSquareBuilderInput, machinePairFirst_pair, + List.length_replicate] + change machineRepeatedRowMatrixStateAcc + ((machineRepeatedRowMatrixStep)^[n] + (machineRepeatedRowMatrixInit + (machineFalseSquareBuilderInput n))) = _ + rw [machineFalseSquareBuilderIterate_semantics n n le_rfl] + simp [machineFalseSquareBuilderState] + +/-- Build all-false `n` by `n` Boolean storage from a canonical rational +matrix input of dimension `n`. -/ +def machineFalseSquareMatrixCode (word : List Bool) : List Bool := + let ruler := machineMatrixDimensionUnary word + let row := machineFalseVectorCode ruler + machineRepeatedRowMatrixCode (pair ruler row) + +theorem machineFalseSquareMatrixCode_mem_FP : + machineFalseSquareMatrixCode ∈ Complexity.FP := by + have hruler := machineMatrixDimensionUnary_mem_FP + have hrow := machineCompose_mem_FP hruler machineFalseVectorCode_mem_FP + have hpayload := machinePair_mem_FP hruler hrow + simpa only [machineFalseSquareMatrixCode] using + machineCompose_mem_FP hpayload machineRepeatedRowMatrixCode_mem_FP + +@[simp] theorem machineFalseSquareMatrixCode_encode {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) : + machineFalseSquareMatrixCode + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩) = + boolMatrixCode + (List.replicate n (List.replicate n false)) := by + rw [machineFalseSquareMatrixCode, machineMatrixDimensionUnary_encode, + machineFalseVectorCode_encode] + exact machineRepeatedRowMatrixCode_falseSquare n + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineBooleanMemory.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineBooleanMemory.lean new file mode 100644 index 0000000000..467fa8431f --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineBooleanMemory.lean @@ -0,0 +1,244 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineListUpdate +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalCompare + +/-! +# Boolean vector and matrix memory + +Matching states use canonical right-nested lists of one-bit Boolean values. +The access and update routines below are compositions of the verified unary +list primitives. The final routine queries the support graph of a rational +matrix without decoding the matrix into a Lean object. +-/ + +namespace BeyondBethe + +open Complexity + +def boolElementCode (b : Bool) : List Bool := [b] + +def boolVectorCode (v : List Bool) : List Bool := + binaryListCode boolElementCode v + +def boolMatrixCode (M : List (List Bool)) : List Bool := + binaryListCode boolVectorCode M + +/-- Input: `pair indexUnary boolVectorCode`. -/ +def machineBoolVectorEntryAtUnary (word : List Bool) : List Bool := + machineListIndex word + +/-- Input: `pair indexUnary (pair replacementBit boolVectorCode)`. -/ +def machineBoolVectorUpdateAtUnary (word : List Bool) : List Bool := + machineListUpdate word + +theorem machineBoolVectorEntryAtUnary_mem_FP : + machineBoolVectorEntryAtUnary ∈ Complexity.FP := + machineListIndex_mem_FP + +theorem machineBoolVectorUpdateAtUnary_mem_FP : + machineBoolVectorUpdateAtUnary ∈ Complexity.FP := + machineListUpdate_mem_FP + +@[simp] theorem machineBoolVectorEntryAtUnary_encode + (v : List Bool) (i : ℕ) (hi : i < v.length) : + machineBoolVectorEntryAtUnary + (pair (List.replicate i true) (boolVectorCode v)) = [v[i]] := by + exact machineListIndex_binaryListCode boolElementCode v i hi + +@[simp] theorem machineBoolVectorUpdateAtUnary_encode + (v : List Bool) (i : ℕ) (replacement : Bool) + (hi : i < v.length) : + machineBoolVectorUpdateAtUnary + (pair (List.replicate i true) + (pair [replacement] (boolVectorCode v))) = + boolVectorCode (v.set i replacement) := by + exact machineListUpdate_binaryListCode boolElementCode v replacement i hi + +/-- Input: `pair rowUnary (pair columnUnary boolMatrixCode)`. -/ +def machineBoolMatrixEntryAtUnary (word : List Bool) : List Bool := + let rowUnary := machinePairFirst word + let rest := machinePairSecond word + let columnUnary := machinePairFirst rest + let matrixCode := machinePairSecond rest + let rowCode := machineListIndex (pair rowUnary matrixCode) + machineListIndex (pair columnUnary rowCode) + +theorem machineBoolMatrixEntryAtUnary_mem_FP : + machineBoolMatrixEntryAtUnary ∈ Complexity.FP := by + have hrow : (fun word : List Bool => machinePairFirst word) ∈ + Complexity.FP := machinePairFirst_mem_FP + have hrest : (fun word : List Bool => machinePairSecond word) ∈ + Complexity.FP := machinePairSecond_mem_FP + have hcolumn : + (fun word : List Bool => machinePairFirst (machinePairSecond word)) ∈ + Complexity.FP := + machineCompose_mem_FP hrest machinePairFirst_mem_FP + have hmatrix : + (fun word : List Bool => machinePairSecond (machinePairSecond word)) ∈ + Complexity.FP := + machineCompose_mem_FP hrest machinePairSecond_mem_FP + have hrowPayload := machinePair_mem_FP hrow hmatrix + have hrowCode := machineCompose_mem_FP hrowPayload machineListIndex_mem_FP + have hentryPayload := machinePair_mem_FP hcolumn hrowCode + simpa only [machineBoolMatrixEntryAtUnary] using + machineCompose_mem_FP hentryPayload machineListIndex_mem_FP + +@[simp] theorem machineBoolMatrixEntryAtUnary_encode + (M : List (List Bool)) (i j : ℕ) + (hi : i < M.length) (hj : j < M[i].length) : + machineBoolMatrixEntryAtUnary + (pair (List.replicate i true) + (pair (List.replicate j true) (boolMatrixCode M))) = + [M[i][j]] := by + rw [machineBoolMatrixEntryAtUnary] + simp only [machinePairFirst_pair, machinePairSecond_pair, boolMatrixCode] + rw [machineListIndex_binaryListCode boolVectorCode M i hi] + simp only [boolVectorCode] + exact machineListIndex_binaryListCode boolElementCode M[i] j hj + +/-- Input: +`pair rowUnary (pair columnUnary (pair replacementBit boolMatrixCode))`. -/ +def machineBoolMatrixUpdateAtUnary (word : List Bool) : List Bool := + let rowUnary := machinePairFirst word + let restOne := machinePairSecond word + let columnUnary := machinePairFirst restOne + let restTwo := machinePairSecond restOne + let replacement := machinePairFirst restTwo + let matrixCode := machinePairSecond restTwo + let rowCode := machineListIndex (pair rowUnary matrixCode) + let updatedRow := machineListUpdate + (pair columnUnary (pair replacement rowCode)) + machineListUpdate (pair rowUnary (pair updatedRow matrixCode)) + +theorem machineBoolMatrixUpdateAtUnary_mem_FP : + machineBoolMatrixUpdateAtUnary ∈ Complexity.FP := by + have hrow : (fun word : List Bool => machinePairFirst word) ∈ + Complexity.FP := machinePairFirst_mem_FP + have hrestOne : (fun word : List Bool => machinePairSecond word) ∈ + Complexity.FP := machinePairSecond_mem_FP + have hcolumn : + (fun word : List Bool => machinePairFirst (machinePairSecond word)) ∈ + Complexity.FP := + machineCompose_mem_FP hrestOne machinePairFirst_mem_FP + have hrestTwo : + (fun word : List Bool => machinePairSecond (machinePairSecond word)) ∈ + Complexity.FP := + machineCompose_mem_FP hrestOne machinePairSecond_mem_FP + have hreplacement : + (fun word : List Bool => + machinePairFirst (machinePairSecond (machinePairSecond word))) ∈ + Complexity.FP := + machineCompose_mem_FP hrestTwo machinePairFirst_mem_FP + have hmatrix : + (fun word : List Bool => + machinePairSecond (machinePairSecond (machinePairSecond word))) ∈ + Complexity.FP := + machineCompose_mem_FP hrestTwo machinePairSecond_mem_FP + have hrowPayload := machinePair_mem_FP hrow hmatrix + have hrowCode := machineCompose_mem_FP hrowPayload machineListIndex_mem_FP + have hupdateRowPayload := machinePair_mem_FP hcolumn + (machinePair_mem_FP hreplacement hrowCode) + have hupdatedRow := machineCompose_mem_FP hupdateRowPayload + machineListUpdate_mem_FP + have hupdateMatrixPayload := machinePair_mem_FP hrow + (machinePair_mem_FP hupdatedRow hmatrix) + simpa only [machineBoolMatrixUpdateAtUnary] using + machineCompose_mem_FP hupdateMatrixPayload machineListUpdate_mem_FP + +@[simp] theorem machineBoolMatrixUpdateAtUnary_encode + (M : List (List Bool)) (i j : ℕ) (replacement : Bool) + (hi : i < M.length) (hj : j < M[i].length) : + machineBoolMatrixUpdateAtUnary + (pair (List.replicate i true) + (pair (List.replicate j true) + (pair [replacement] (boolMatrixCode M)))) = + boolMatrixCode (M.set i (M[i].set j replacement)) := by + rw [machineBoolMatrixUpdateAtUnary] + simp only [machinePairFirst_pair, machinePairSecond_pair, boolMatrixCode] + rw [machineListIndex_binaryListCode boolVectorCode M i hi] + change machineListUpdate + (pair (List.replicate i true) + (pair + (machineListUpdate + (machineListUpdateCanonicalInput boolElementCode M[i] + replacement j)) + (binaryListCode boolVectorCode M))) = _ + rw [machineListUpdate_binaryListCode boolElementCode M[i] + replacement j hj] + change machineListUpdate + (machineListUpdateCanonicalInput boolVectorCode M + (M[i].set j replacement) i) = _ + exact machineListUpdate_binaryListCode boolVectorCode M + (M[i].set j replacement) i hi + +/-! ## Rational support queries -/ + +def machineRawRatEqBit (word : List Bool) : List Bool := + machineAndBit (machineRawRatLeBit word) + (machineRawRatLeBit (pair (machinePairSecond word) + (machinePairFirst word))) + +def machineRawRatNeBit (word : List Bool) : List Bool := + machineNotBit (machineRawRatEqBit word) + +theorem machineRawRatEqBit_mem_FP : + machineRawRatEqBit ∈ Complexity.FP := by + have hswap := machinePair_mem_FP machinePairSecond_mem_FP + machinePairFirst_mem_FP + have hright := machineCompose_mem_FP hswap machineRawRatLeBit_mem_FP + exact machineAndBit_mem_FP machineRawRatLeBit_mem_FP hright + +theorem machineRawRatNeBit_mem_FP : + machineRawRatNeBit ∈ Complexity.FP := by + simpa only [machineRawRatNeBit] using + machineNotBit_mem_FP machineRawRatEqBit_mem_FP + +@[simp] theorem machineRawRatEqBit_encode (q r : RawRat) : + machineRawRatEqBit + (pair (rawRatBinaryCode q) (rawRatBinaryCode r)) = + [decide (q.value = r.value)] := by + rw [machineRawRatEqBit, machineRawRatLeBit_encode] + simp only [machinePairSecond_pair, machinePairFirst_pair, + machineRawRatLeBit_encode, machineAndBit_one] + apply congrArg singleton + apply Bool.eq_iff_iff.mpr + simp [le_antisymm_iff] + +@[simp] theorem machineRawRatNeBit_encode (q r : RawRat) : + machineRawRatNeBit + (pair (rawRatBinaryCode q) (rawRatBinaryCode r)) = + [decide (q.value ≠ r.value)] := by + rw [machineRawRatNeBit, machineRawRatEqBit_encode, machineNotBit_one] + by_cases h : q.value = r.value <;> simp [h] + +/-- Input: `pair rowUnary (pair columnUnary rationalMatrixWord)`. -/ +def machineRationalSupportBitAtUnary (word : List Bool) : List Bool := + let entry := machineMatrixEntryAtUnary word + machineRawRatNeBit + (pair entry (rawRatBinaryCode RawRat.zero)) + +theorem machineRationalSupportBitAtUnary_mem_FP : + machineRationalSupportBitAtUnary ∈ Complexity.FP := by + have hpair := machinePair_mem_FP machineMatrixEntryAtUnary_mem_FP + (machineConst_mem_FP (rawRatBinaryCode RawRat.zero)) + simpa only [machineRationalSupportBitAtUnary] using + machineCompose_mem_FP hpair machineRawRatNeBit_mem_FP + +@[simp] theorem machineRationalSupportBitAtUnary_encode {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) (i j : Fin n) : + machineRationalSupportBitAtUnary + (pair (List.replicate i.1 true) + (pair (List.replicate j.1 true) + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩))) = + [decide (A i j ≠ 0)] := by + rw [machineRationalSupportBitAtUnary, + machineMatrixEntryAtUnary_encode] + rw [← rawRatBinaryCode_rawRatOfRat, machineRawRatNeBit_encode] + simp only [rawRatOfRat_value, RawRat.value_zero] + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineBoundedUnary.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineBoundedUnary.lean new file mode 100644 index 0000000000..b7a1d3b1e3 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineBoundedUnary.lean @@ -0,0 +1,267 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineBinarySub + +/-! +# Bounded conversion from binary to unary + +An unrestricted binary integer can describe an exponentially long unary word, +so binary-to-unary conversion is not polynomial-time in general. This machine +therefore receives an explicit unary guard. It returns exactly `n` true bits +when the encoded natural `n` is at most the guard length, and otherwise returns +only the guarded prefix. The guard is what later permits paper-specific +polynomial schedules without making a false global complexity claim. +-/ + +namespace BeyondBethe + +open Complexity + +def machineBoundedUnaryPack (remaining acc : List Bool) : List Bool := + pair remaining acc + +def machineBoundedUnaryRemaining (state : List Bool) : List Bool := + machinePairFirst state + +def machineBoundedUnaryAcc (state : List Bool) : List Bool := + machinePairSecond state + +def machineBoundedUnaryDecrement (state : List Bool) : List Bool := + machineBinarySubBits + (pair (machineBoundedUnaryRemaining state) [true]) + +def machineBoundedUnaryContinue (state : List Bool) : List Bool := + machineBoundedUnaryPack (machineBoundedUnaryDecrement state) + (true :: machineBoundedUnaryAcc state) + +def machineBoundedUnaryStep (state : List Bool) : List Bool := + machineIfEmpty (machineBoundedUnaryRemaining state) state + (machineBoundedUnaryContinue state) + +def machineBoundedUnaryRuler (word : List Bool) : List Bool := + machinePairFirst word + +def machineBoundedUnaryBits (word : List Bool) : List Bool := + machinePairSecond word + +def machineBoundedUnaryInit (word : List Bool) : List Bool := + machineBoundedUnaryPack (machineBoundedUnaryBits word) [] + +def machineBoundedUnaryWidth (word : List Bool) : List Bool := + pair word word + +def machineBoundedUnaryFinalState (word : List Bool) : List Bool := + (machineBoundedUnaryStep)^[(machineBoundedUnaryRuler word).length] + (machineBoundedUnaryInit word) + +/-- Expand the encoded natural into true bits, stopping at the unary guard. -/ +def machineBoundedUnary (word : List Bool) : List Bool := + machineBoundedUnaryAcc (machineBoundedUnaryFinalState word) + +private theorem machineIfEmpty_of_ne_nil_local + (test whenEmpty whenNonempty : List Bool) (h : test ≠ []) : + machineIfEmpty test whenEmpty whenNonempty = whenNonempty := by + cases test with + | nil => exact False.elim (h rfl) + | cons bit tail => simp + +theorem machineBoundedUnaryRemaining_mem_FP : + machineBoundedUnaryRemaining ∈ Complexity.FP := machinePairFirst_mem_FP + +theorem machineBoundedUnaryAcc_mem_FP : + machineBoundedUnaryAcc ∈ Complexity.FP := machinePairSecond_mem_FP + +theorem machineBoundedUnaryDecrement_mem_FP : + machineBoundedUnaryDecrement ∈ Complexity.FP := by + have hpair := machinePair_mem_FP machineBoundedUnaryRemaining_mem_FP + (machineConst_mem_FP [true]) + simpa only [machineBoundedUnaryDecrement] using + machineCompose_mem_FP hpair machineBinarySubBits_mem_FP + +theorem machineBoundedUnaryContinue_mem_FP : + machineBoundedUnaryContinue ∈ Complexity.FP := by + exact machinePair_mem_FP machineBoundedUnaryDecrement_mem_FP + (machineCompose_mem_FP machineBoundedUnaryAcc_mem_FP + (machinePrepend_mem_FP true)) + +theorem machineBoundedUnaryStep_mem_FP : + machineBoundedUnaryStep ∈ Complexity.FP := by + simpa only [machineBoundedUnaryStep] using + machineIfEmpty_mem_FP machineBoundedUnaryRemaining_mem_FP + id_mem_FP machineBoundedUnaryContinue_mem_FP + +theorem machineBoundedUnaryRuler_mem_FP : + machineBoundedUnaryRuler ∈ Complexity.FP := machinePairFirst_mem_FP + +theorem machineBoundedUnaryBits_mem_FP : + machineBoundedUnaryBits ∈ Complexity.FP := machinePairSecond_mem_FP + +theorem machineBoundedUnaryInit_mem_FP : + machineBoundedUnaryInit ∈ Complexity.FP := by + exact machinePair_mem_FP machineBoundedUnaryBits_mem_FP + (machineConst_mem_FP []) + +theorem machineBoundedUnaryWidth_mem_FP : + machineBoundedUnaryWidth ∈ Complexity.FP := by + exact machinePair_mem_FP id_mem_FP id_mem_FP + +@[simp] theorem machineBoundedUnaryRemaining_pack (remaining acc) : + machineBoundedUnaryRemaining (machineBoundedUnaryPack remaining acc) = + remaining := by + simp [machineBoundedUnaryRemaining, machineBoundedUnaryPack] + +@[simp] theorem machineBoundedUnaryAcc_pack (remaining acc) : + machineBoundedUnaryAcc (machineBoundedUnaryPack remaining acc) = acc := by + simp [machineBoundedUnaryAcc, machineBoundedUnaryPack] + +def MachineBoundedUnaryStateBound + (word : List Bool) (iterations : ℕ) (state : List Bool) : Prop := + state = machineBoundedUnaryPack + (machineBoundedUnaryRemaining state) (machineBoundedUnaryAcc state) ∧ + (machineBoundedUnaryRemaining state).length ≤ word.length ∧ + (machineBoundedUnaryAcc state).length ≤ iterations + +theorem machineBoundedUnaryInit_bound (word : List Bool) : + MachineBoundedUnaryStateBound word 0 (machineBoundedUnaryInit word) := by + simp only [MachineBoundedUnaryStateBound, machineBoundedUnaryInit, + machineBoundedUnaryRemaining_pack, machineBoundedUnaryAcc_pack] + constructor + · trivial + constructor + · exact machinePairSecond_length_le word + · simp + +theorem machineBoundedUnaryStep_bound + {word state : List Bool} {iterations : ℕ} + (hstate : MachineBoundedUnaryStateBound word iterations state) : + MachineBoundedUnaryStateBound word (iterations + 1) + (machineBoundedUnaryStep state) := by + rcases hstate with ⟨hdecomp, hremaining, hacc⟩ + by_cases hempty : machineBoundedUnaryRemaining state = [] + · rw [machineBoundedUnaryStep, hempty, machineIfEmpty_nil] + exact ⟨hdecomp, hremaining, hacc.trans (by omega)⟩ + · rw [machineBoundedUnaryStep, + machineIfEmpty_of_ne_nil_local _ _ _ hempty, + machineBoundedUnaryContinue] + simp only [MachineBoundedUnaryStateBound, + machineBoundedUnaryRemaining_pack, machineBoundedUnaryAcc_pack] + constructor + · trivial + constructor + · have hsub := machineBinarySubBits_pair_length_le + (machineBoundedUnaryRemaining state) [true] + simp only [machineBoundedUnaryDecrement] + have hnonzero : 1 ≤ (machineBoundedUnaryRemaining state).length := by + have hlength : (machineBoundedUnaryRemaining state).length ≠ 0 := by + intro hzero + exact hempty (List.length_eq_zero_iff.mp hzero) + omega + rw [show [true].length = 1 by rfl, max_eq_left hnonzero] at hsub + exact hsub.trans hremaining + · simp only [List.length_cons] + omega + +theorem machineBoundedUnaryIterate_bound (word : List Bool) : ∀ k, + MachineBoundedUnaryStateBound word k + ((machineBoundedUnaryStep)^[k] (machineBoundedUnaryInit word)) := by + intro k + induction k with + | zero => exact machineBoundedUnaryInit_bound word + | succ k ih => + rw [Function.iterate_succ_apply'] + exact machineBoundedUnaryStep_bound ih + +theorem machineBoundedUnaryIterate_length_le_width + (word : List Bool) (iterations : ℕ) + (hiterations : iterations ≤ (machineBoundedUnaryRuler word).length) : + ((machineBoundedUnaryStep)^[iterations] + (machineBoundedUnaryInit word)).length ≤ + (machineBoundedUnaryWidth word).length := by + rcases machineBoundedUnaryIterate_bound word iterations with + ⟨hdecomp, hremaining, hacc⟩ + rw [hdecomp] + simp only [machineBoundedUnaryPack, machineBoundedUnaryWidth, pair_length] + have hruler := machinePairFirst_length_le word + simp only [machineBoundedUnaryRuler] at hiterations + omega + +theorem machineBoundedUnaryFinalState_mem_FP : + machineBoundedUnaryFinalState ∈ Complexity.FP := by + exact Cobham.iterate_mem_FP machineBoundedUnaryStep_mem_FP + machineBoundedUnaryInit_mem_FP machineBoundedUnaryRuler_mem_FP + machineBoundedUnaryWidth_mem_FP + machineBoundedUnaryIterate_length_le_width + +theorem machineBoundedUnary_mem_FP : + machineBoundedUnary ∈ Complexity.FP := by + simpa only [machineBoundedUnary] using + machineCompose_mem_FP machineBoundedUnaryFinalState_mem_FP + machineBoundedUnaryAcc_mem_FP + +/-! ## Exact semantics -/ + +def boundedUnaryState (n k : ℕ) : List Bool := + machineBoundedUnaryPack (n - k).bits + (List.replicate (min k n) true) + +theorem machineBoundedUnaryStep_encode (n k : ℕ) : + machineBoundedUnaryStep (boundedUnaryState n k) = + boundedUnaryState n (k + 1) := by + by_cases hkn : k < n + · have hpos : 0 < n - k := Nat.sub_pos_of_lt hkn + have hbits : (n - k).bits ≠ [] := by + intro hnil + have hzero : n - k = 0 := by + have h := congrArg Nat.fromBitsLE hnil + simpa only [Nat.fromBitsLE_bits] using h + omega + rw [machineBoundedUnaryStep] + simp only [boundedUnaryState, machineBoundedUnaryRemaining_pack] + rw [machineIfEmpty_of_ne_nil_local _ _ _ hbits] + rw [machineBoundedUnaryContinue] + simp only [machineBoundedUnaryDecrement, + machineBoundedUnaryRemaining_pack, machineBoundedUnaryAcc_pack] + have hone : ([true] : List Bool) = (1 : ℕ).bits := by rfl + rw [hone, machineBinarySubBits_pair_natBits] + apply congrArg₂ machineBoundedUnaryPack + · congr 1 + · rw [min_eq_left (Nat.le_of_lt hkn), + min_eq_left (by omega : k + 1 ≤ n)] + simp [List.replicate_succ] + · have hnk : n ≤ k := Nat.le_of_not_gt hkn + rw [machineBoundedUnaryStep] + simp [boundedUnaryState, Nat.sub_eq_zero_of_le hnk, + Nat.sub_eq_zero_of_le (hnk.trans (Nat.le_succ k)), + min_eq_right hnk, min_eq_right (hnk.trans (Nat.le_succ k))] + +theorem machineBoundedUnaryIterate_encode (n : ℕ) : ∀ k, + (machineBoundedUnaryStep)^[k] + (machineBoundedUnaryPack n.bits []) = boundedUnaryState n k := by + intro k + induction k with + | zero => simp [boundedUnaryState] + | succ k ih => + rw [Function.iterate_succ_apply', ih, + machineBoundedUnaryStep_encode] + +theorem machineBoundedUnary_encode (guard : List Bool) (n : ℕ) : + machineBoundedUnary (pair guard n.bits) = + List.replicate (min guard.length n) true := by + rw [machineBoundedUnary, machineBoundedUnaryFinalState] + simp only [machineBoundedUnaryRuler, machinePairFirst_pair, + machineBoundedUnaryInit, machineBoundedUnaryBits, + machinePairSecond_pair] + rw [machineBoundedUnaryIterate_encode] + simp [boundedUnaryState] + +theorem machineBoundedUnary_encode_of_le + (guard : List Bool) (n : ℕ) (hn : n ≤ guard.length) : + machineBoundedUnary (pair guard n.bits) = + List.replicate n true := by + rw [machineBoundedUnary_encode, min_eq_right hn] + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineCertificateAssembly.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineCertificateAssembly.lean new file mode 100644 index 0000000000..10f61660fb --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineCertificateAssembly.lean @@ -0,0 +1,327 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineNearbyMatrixSum +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalExp + +/-! +# Assembly of the directed certificate from its matching gain + +This module isolates the remaining combinatorial and exponential-size +obligations. Given a finite-word machine for the fixed greedy matching gain, +it forms the complete rational certificate logarithm. Given in addition a +unary exponential guard, it returns the final canonical raw rational entry. +All composition and rational-format conversions are explicit. +-/ + +namespace BeyondBethe + +open Complexity + +/-- The source matrix word retained by the certificate interface. -/ +def machineCertificateSourceWord (word : List Bool) : List Bool := + machinePairFirst word + +/-- The optimizer-output word consumed by the arithmetic subroutines. -/ +def machineCertificateOptimizerWord (word : List Bool) : List Bool := + machinePairSecond word + +theorem machineCertificateSourceWord_mem_FP : + machineCertificateSourceWord ∈ Complexity.FP := + machinePairFirst_mem_FP + +theorem machineCertificateOptimizerWord_mem_FP : + machineCertificateOptimizerWord ∈ Complexity.FP := + machinePairSecond_mem_FP + +@[simp] theorem machineCertificateSourceWord_pair + (source optimizer : List Bool) : + machineCertificateSourceWord (pair source optimizer) = source := + machinePairFirst_pair source optimizer + +@[simp] theorem machineCertificateOptimizerWord_pair + (source optimizer : List Bool) : + machineCertificateOptimizerWord (pair source optimizer) = optimizer := + machinePairSecond_pair source optimizer + +def rawCertificateLogAssembly {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℚ) + (gain : ℚ) : RawRat := + (((rawCertificatePotentialSum R C).add + (rawNearbyRowsSum (rawCertificateRegularizationScale n) + (directedCertificatePrecision n) RawRat.zero + (rationalMatrixRows X))).add + (rawRatOfRat gain)).add (rawCertificateKKTPenalty n).neg + +theorem rawCertificateLogAssembly_value {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℚ) + (gain : ℚ) : + (rawCertificateLogAssembly X R C gain).value = + directedNearbyBetheLower (explicitRegularizationScale n) X R C + (directedCertificatePrecision n) + + gain - explicitKKTError * n := by + rw [rawCertificateLogAssembly, RawRat.value_add, RawRat.value_add, + RawRat.value_add, RawRat.value_neg, + rawCertificatePotentialSum_value, + rawNearbyRowsSum_certificate_value, + rawRatOfRat_value, rawCertificateKKTPenalty_value] + rw [directedNearbyBetheLower] + ring + +def machineCertificateNearbyRawCode (word : List Bool) : List Bool := + machineRawRatAddCode + (pair + (machineCertificatePotentialRawSumCode + (machineCertificateOptimizerWord word)) + (machineNearbyMatrixRawSumCode + (machineCertificateOptimizerWord word))) + +def machineCertificateLogBeforePenaltyRawCode + (gainMachine : List Bool → List Bool) (word : List Bool) : List Bool := + machineRawRatAddCode + (pair (machineCertificateNearbyRawCode word) (gainMachine word)) + +def machineCertificateLogUnnormalizedRawCode + (gainMachine : List Bool → List Bool) (word : List Bool) : List Bool := + machineRawRatAddCode + (pair (machineCertificateLogBeforePenaltyRawCode gainMachine word) + (machineRawRatNegCode + (machineCertificateKKTPenaltyRawCode + (machineCertificateOptimizerWord word)))) + +/-- Canonical raw-entry encoding of the complete certificate logarithm. -/ +def machineCertificateLogRawCode + (gainMachine : List Bool → List Bool) (word : List Bool) : List Bool := + machineNormalizeRawRatEntryCode + (machineCertificateLogUnnormalizedRawCode gainMachine word) + +theorem machineCertificateNearbyRawCode_mem_FP : + machineCertificateNearbyRawCode ∈ Complexity.FP := by + have hpotential := machineCompose_mem_FP + machineCertificateOptimizerWord_mem_FP + machineCertificatePotentialRawSumCode_mem_FP + have hnearby := machineCompose_mem_FP + machineCertificateOptimizerWord_mem_FP + machineNearbyMatrixRawSumCode_mem_FP + have hpair := machinePair_mem_FP + hpotential hnearby + simpa only [machineCertificateNearbyRawCode] using + machineCompose_mem_FP hpair machineRawRatAddCode_mem_FP + +theorem machineCertificateLogBeforePenaltyRawCode_mem_FP + {gainMachine : List Bool → List Bool} + (hgain : gainMachine ∈ Complexity.FP) : + machineCertificateLogBeforePenaltyRawCode gainMachine ∈ Complexity.FP := by + have hpair := machinePair_mem_FP machineCertificateNearbyRawCode_mem_FP hgain + simpa only [machineCertificateLogBeforePenaltyRawCode] using + machineCompose_mem_FP hpair machineRawRatAddCode_mem_FP + +theorem machineCertificateLogUnnormalizedRawCode_mem_FP + {gainMachine : List Bool → List Bool} + (hgain : gainMachine ∈ Complexity.FP) : + machineCertificateLogUnnormalizedRawCode gainMachine ∈ Complexity.FP := by + have hpenalty := machineCompose_mem_FP + machineCertificateOptimizerWord_mem_FP + machineCertificateKKTPenaltyRawCode_mem_FP + have hneg := machineCompose_mem_FP hpenalty machineRawRatNegCode_mem_FP + have hpair := machinePair_mem_FP + (machineCertificateLogBeforePenaltyRawCode_mem_FP hgain) hneg + simpa only [machineCertificateLogUnnormalizedRawCode] using + machineCompose_mem_FP hpair machineRawRatAddCode_mem_FP + +theorem machineCertificateLogRawCode_mem_FP + {gainMachine : List Bool → List Bool} + (hgain : gainMachine ∈ Complexity.FP) : + machineCertificateLogRawCode gainMachine ∈ Complexity.FP := by + simpa only [machineCertificateLogRawCode] using + machineCompose_mem_FP + (machineCertificateLogUnnormalizedRawCode_mem_FP hgain) + machineNormalizeRawRatEntryCode_mem_FP + +theorem machineCertificateLogUnnormalizedRawCode_encode + {gainMachine : List Bool → List Bool} + (source : List Bool) + {n : ℕ} (X : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℚ) + (hgain : gainMachine + (pair source (rationalOptimizerOutputCode ⟨X, R, C⟩)) = + rawRatBinaryCode (rawRatOfRat (explicitCertifiedMatchingGain X))) : + machineCertificateLogUnnormalizedRawCode gainMachine + (pair source (rationalOptimizerOutputCode ⟨X, R, C⟩)) = + rawRatBinaryCode + (rawCertificateLogAssembly X R C + (explicitCertifiedMatchingGain X)) := by + rw [machineCertificateLogUnnormalizedRawCode, + machineCertificateLogBeforePenaltyRawCode, + machineCertificateNearbyRawCode, + machineCertificateOptimizerWord_pair, + machineCertificatePotentialRawSumCode_encode, + machineNearbyMatrixRawSumCode_encode, + hgain, machineCertificateKKTPenaltyRawCode_encode, + machineRawRatNegCode_encode, machineRawRatAddCode_encode, + machineRawRatAddCode_encode, machineRawRatAddCode_encode] + rfl + +theorem machineCertificateLogRawCode_encode + {gainMachine : List Bool → List Bool} + (source : List Bool) + {n : ℕ} (X : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℚ) + (hgain : gainMachine + (pair source (rationalOptimizerOutputCode ⟨X, R, C⟩)) = + rawRatBinaryCode (rawRatOfRat (explicitCertifiedMatchingGain X))) : + machineCertificateLogRawCode gainMachine + (pair source (rationalOptimizerOutputCode ⟨X, R, C⟩)) = + rawRatBinaryCode + (rawRatOfRat (explicitDirectedCertificateLog X R C)) := by + rw [machineCertificateLogRawCode, + machineCertificateLogUnnormalizedRawCode_encode + (gainMachine := gainMachine) source X R C hgain, + machineNormalizeRawRatEntryCode_encode, + rawRatBinaryCode_rawRatOfRat] + apply congrArg rationalEntryBinaryCode + rw [binaryNormalizeRawRat_eq_value, + rawCertificateLogAssembly_value, + explicitDirectedCertificateLog] + +def machineCertificateExpInput + (gainMachine guardMachine : List Bool → List Bool) + (word : List Bool) : List Bool := + pair (guardMachine word) + (pair (machineCertificateLogRawCode gainMachine word) + (machineCertificateExpLossRawCode + (machineCertificateOptimizerWord word))) + +def machineCertificateValueRawCode + (gainMachine guardMachine : List Bool → List Bool) + (word : List Bool) : List Bool := + machineBoundedRationalExpLowerRawEntryCode + (machineCertificateExpInput gainMachine guardMachine word) + +theorem machineCertificateExpInput_mem_FP + {gainMachine guardMachine : List Bool → List Bool} + (hgain : gainMachine ∈ Complexity.FP) + (hguard : guardMachine ∈ Complexity.FP) : + machineCertificateExpInput gainMachine guardMachine ∈ Complexity.FP := by + exact machinePair_mem_FP hguard + (machinePair_mem_FP (machineCertificateLogRawCode_mem_FP hgain) + (machineCompose_mem_FP machineCertificateOptimizerWord_mem_FP + machineCertificateExpLossRawCode_mem_FP)) + +theorem machineCertificateValueRawCode_mem_FP + {gainMachine guardMachine : List Bool → List Bool} + (hgain : gainMachine ∈ Complexity.FP) + (hguard : guardMachine ∈ Complexity.FP) : + machineCertificateValueRawCode gainMachine guardMachine ∈ Complexity.FP := by + simpa only [machineCertificateValueRawCode] using + machineCompose_mem_FP (machineCertificateExpInput_mem_FP hgain hguard) + machineBoundedRationalExpLowerRawEntryCode_mem_FP + +theorem machineCertificateValueRawCode_encode + {gainMachine guardMachine : List Bool → List Bool} + (source : List Bool) + {n : ℕ} (X : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℚ) + (hgain : gainMachine + (pair source (rationalOptimizerOutputCode ⟨X, R, C⟩)) = + rawRatBinaryCode (rawRatOfRat (explicitCertifiedMatchingGain X))) + (hsteps : RawRat.expApproxSteps + (rawRatOfRat (explicitDirectedCertificateLog X R C)) + (rawCertificateExpLoss n) ≤ + (guardMachine + (pair source (rationalOptimizerOutputCode ⟨X, R, C⟩))).length) : + machineCertificateValueRawCode gainMachine guardMachine + (pair source (rationalOptimizerOutputCode ⟨X, R, C⟩)) = + rawRatBinaryCode + (rawRatOfRat (explicitDirectedCertificateValue X R C)) := by + rw [machineCertificateValueRawCode, machineCertificateExpInput, + machineCertificateLogRawCode_encode + (gainMachine := gainMachine) source X R C hgain, + machineCertificateOptimizerWord_pair, + machineCertificateExpLossRawCode_encode, + machineBoundedRationalExpLowerRawEntryCode_encode _ _ _ hsteps, + rawRatOfRat_value, rawCertificateExpLoss_value, + binaryRationalExpLower_eq, explicitDirectedCertificateValue] + +/-- Correctness required of the remaining fixed-gain matching transducer. -/ +def OptimizerMatchingGainStringRealizes + (gainMachine : List Bool → List Bool) : Prop := + ∀ (m : ℕ) (B : Matrix (Fin (m + 2)) (Fin (m + 2)) ℚ), + gainMachine + (pair (rationalMatrixBinaryEncoding.encode ⟨m + 2, B⟩) + (rationalOptimizerOutputCode (explicitLargeOptimizerOutput m B))) = + rawRatBinaryCode + (rawRatOfRat + (explicitCertifiedMatchingGain + (explicitBetheOptimizerMatrix (m := m + 1) B))) + +/-- The optimizer-dependent magnitude statement still needed by the guarded +exponential. It is separated from machine composition so that no universal +claim about arbitrary rational potentials is hidden in the evaluator. -/ +def OptimizerCertificateExpGuardFits + (guardMachine : List Bool → List Bool) : Prop := + ∀ (m : ℕ) (B : Matrix (Fin (m + 2)) (Fin (m + 2)) ℚ), + RawRat.expApproxSteps + (rawRatOfRat + (explicitDirectedCertificateLog + (explicitBetheOptimizerMatrix (m := m + 1) B) + (explicitBetheOptimizerRowPotential (m := m + 1) B) + (explicitBetheOptimizerColumnPotential (m := m + 1) B))) + (rawCertificateExpLoss (m + 2)) ≤ + (guardMachine + (pair (rationalMatrixBinaryEncoding.encode ⟨m + 2, B⟩) + (rationalOptimizerOutputCode + (explicitLargeOptimizerOutput m B)))).length + +/-- The guarded exponential needs to fit only on the positive normalized +matrices on which the certificate theorem and the outer algorithm use it. -/ +def OptimizerCertificateExpGuardFitsOnPositiveNormalized + (guardMachine : List Bool → List Bool) : Prop := + ∀ (m : ℕ) (B : Matrix (Fin (m + 2)) (Fin (m + 2)) ℚ), + (∀ i j, 0 < B i j) → (∀ i j, B i j ≤ 1) → + RawRat.expApproxSteps + (rawRatOfRat + (explicitDirectedCertificateLog + (explicitBetheOptimizerMatrix (m := m + 1) B) + (explicitBetheOptimizerRowPotential (m := m + 1) B) + (explicitBetheOptimizerColumnPotential (m := m + 1) B))) + (rawCertificateExpLoss (m + 2)) ≤ + (guardMachine + (pair (rationalMatrixBinaryEncoding.encode ⟨m + 2, B⟩) + (rationalOptimizerOutputCode + (explicitLargeOptimizerOutput m B)))).length + +theorem machineCertificateValueRawCode_realizes + {gainMachine guardMachine : List Bool → List Bool} + (hgain : OptimizerMatchingGainStringRealizes gainMachine) + (hguard : OptimizerCertificateExpGuardFits guardMachine) : + CertificateEvaluatorStringRealizes + (machineCertificateValueRawCode gainMachine guardMachine) := by + intro m B + simpa only [explicitLargeOptimizerOutput] using + machineCertificateValueRawCode_encode + (gainMachine := gainMachine) (guardMachine := guardMachine) + (rationalMatrixBinaryEncoding.encode ⟨m + 2, B⟩) + (explicitBetheOptimizerMatrix (m := m + 1) B) + (explicitBetheOptimizerRowPotential (m := m + 1) B) + (explicitBetheOptimizerColumnPotential (m := m + 1) B) + (hgain m B) (hguard m B) + +theorem machineCertificateValueRawCode_realizes_onPositive + {gainMachine guardMachine : List Bool → List Bool} + (hgain : OptimizerMatchingGainStringRealizes gainMachine) + (hguard : + OptimizerCertificateExpGuardFitsOnPositiveNormalized guardMachine) : + CertificateEvaluatorStringRealizesOnPositiveNormalized + (machineCertificateValueRawCode gainMachine guardMachine) := by + intro m B hBpos hBupper + simpa only [explicitLargeOptimizerOutput] using + machineCertificateValueRawCode_encode + (gainMachine := gainMachine) (guardMachine := guardMachine) + (rationalMatrixBinaryEncoding.encode ⟨m + 2, B⟩) + (explicitBetheOptimizerMatrix (m := m + 1) B) + (explicitBetheOptimizerRowPotential (m := m + 1) B) + (explicitBetheOptimizerColumnPotential (m := m + 1) B) + (hgain m B) (hguard m B hBpos hBupper) + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineCertificateExpGuard.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineCertificateExpGuard.lean new file mode 100644 index 0000000000..706a9f3efc --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineCertificateExpGuard.lean @@ -0,0 +1,298 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.CertificateMagnitude +import LeanPool.BeyondBethe.BeyondBethe.MachineCertificateAssembly + +/-! +# The polynomial exponential guard for the optimizer certificate + +The exponential evaluator expands its binary step count to unary. Six fixed +applications of the verified quadratic-width constructor provide a degree-64 +guard. On positive normalized source matrices this dominates the exact +magnitude-sensitive exponential schedule. +-/ + +namespace BeyondBethe + +open Complexity + +def explicitExpReciprocalCeil : ℕ := + rationalCeilNat (1 / explicitExpEvaluationLoss) + +def explicitCertificateExpStepBound (sourceLength : ℕ) : ℕ := + let K := 34 * sourceLength ^ 2 + 2 * (K + K ^ 2 * explicitExpReciprocalCeil) + 1 + +theorem rationalCeilNat_le_of_le_nat {q : ℚ} {N : ℕ} + (hq : q ≤ N) : rationalCeilNat q ≤ N := by + rw [rationalCeilNat, Int.toNat_le] + exact Int.ceil_le.mpr hq + +@[simp] theorem RawRat.expMagnitude_value (q : RawRat) : + (RawRat.expMagnitude q).value = abs q.value := by + rcases q with ⟨num, den, hden⟩ + cases num with + | ofNat a => + have hnonneg : 0 ≤ ((⟨Int.ofNat a, den, hden⟩ : RawRat).value) := by + rw [RawRat.value] + norm_num only [Int.cast_ofNat] + exact div_nonneg (Nat.cast_nonneg a) (by exact_mod_cast hden.le) + change ((⟨Int.ofNat a, den, hden⟩ : RawRat).value) = + abs ((⟨Int.ofNat a, den, hden⟩ : RawRat).value) + rw [abs_of_nonneg hnonneg] + | negSucc a => + have hnonpos : ((⟨Int.negSucc a, den, hden⟩ : RawRat).value) ≤ 0 := by + rw [RawRat.value] + have hnum : (((Int.negSucc a : ℤ) : ℚ)) < 0 := by + norm_num only [Int.cast_negSucc, Nat.cast_add, Nat.cast_one] + linarith + exact div_nonpos_of_nonpos_of_nonneg hnum.le + (by exact_mod_cast hden.le) + change ((⟨Int.negSucc a, den, hden⟩ : RawRat).neg.value) = + abs ((⟨Int.negSucc a, den, hden⟩ : RawRat).value) + rw [RawRat.value_neg, abs_of_nonpos hnonpos] + +theorem inverse_certificate_loss_le_reciprocalCeil + {n : ℕ} (hn : 1 ≤ n) : + 1 / (explicitExpEvaluationLoss * n) ≤ + (explicitExpReciprocalCeil : ℚ) := by + have hc : 0 < explicitExpEvaluationLoss := explicitExpEvaluationLoss_pos + have hnQ : (1 : ℚ) ≤ n := by exact_mod_cast hn + have hden : explicitExpEvaluationLoss ≤ + explicitExpEvaluationLoss * n := by + simpa only [mul_one] using mul_le_mul_of_nonneg_left hnQ hc.le + have hinv : 1 / (explicitExpEvaluationLoss * n) ≤ + 1 / explicitExpEvaluationLoss := + one_div_le_one_div_of_le hc hden + have hceil := le_rationalCeilNat + (show (0 : ℚ) ≤ 1 / explicitExpEvaluationLoss by positivity) + exact hinv.trans hceil + +/-- The source-length guard depends only on an a priori magnitude bound for +the rational logarithm. It is intentionally independent of the optimizer +that produced that logarithm. -/ +theorem certificate_expApproxSteps_le_sourceBound_of_abs_le + (m : ℕ) (B : Matrix (Fin (m + 2)) (Fin (m + 2)) ℚ) (q : ℚ) + (habsR : abs (q : ℝ) ≤ explicitCertificateMagnitudeBudget B) : + RawRat.expApproxSteps (rawRatOfRat q) + (rawCertificateExpLoss (m + 2)) ≤ + explicitCertificateExpStepBound + (rationalMatrixBinaryEncoding.encode ⟨m + 2, B⟩).length := by + let source := rationalMatrixBinaryEncoding.encode ⟨m + 2, B⟩ + let S := source.length + let t : ℚ := abs q + let K := explicitCertificateMagnitudeBudget B + let K₀ := 34 * S ^ 2 + have ht : t ≤ (K : ℚ) := by + exact_mod_cast habsR + have ht0 : 0 ≤ t := abs_nonneg q + have hnSource : m + 2 ≤ S := by + simpa only [S, source] using matrix_dimension_le_code_length B + have hBSource : rationalMatrixEntryBitBound B ≤ 32 * S := by + simpa only [S, source] using + rationalMatrixEntryBitBound_le_machineCode (by omega) B + have hS : 1 ≤ S := by omega + have hK : K ≤ K₀ := by + simp only [K, K₀, explicitCertificateMagnitudeBudget] + nlinarith + have htK₀ : t ≤ (K₀ : ℚ) := ht.trans (by exact_mod_cast hK) + have hinv := inverse_certificate_loss_le_reciprocalCeil + (n := m + 2) (by omega) + have hlossValue : (rawCertificateExpLoss (m + 2)).value = + explicitExpEvaluationLoss * ((m + 2 : ℕ) : ℚ) := + rawCertificateExpLoss_value (m + 2) + have hsq : t ^ 2 ≤ (K₀ : ℚ) ^ 2 := + pow_le_pow_left₀ ht0 htK₀ 2 + have hinv0 : 0 ≤ + 1 / (explicitExpEvaluationLoss * ((m + 2 : ℕ) : ℚ)) := by + exact div_nonneg (by norm_num) + (mul_nonneg explicitExpEvaluationLoss_pos.le (by positivity)) + have hC0 : (0 : ℚ) ≤ explicitExpReciprocalCeil := by positivity + have hdiv : t ^ 2 / + (explicitExpEvaluationLoss * ((m + 2 : ℕ) : ℚ)) ≤ + (K₀ : ℚ) ^ 2 * explicitExpReciprocalCeil := by + calc + t ^ 2 / (explicitExpEvaluationLoss * ((m + 2 : ℕ) : ℚ)) = + t ^ 2 * + (1 / (explicitExpEvaluationLoss * ((m + 2 : ℕ) : ℚ))) := by ring + _ ≤ (K₀ : ℚ) ^ 2 * + (1 / (explicitExpEvaluationLoss * ((m + 2 : ℕ) : ℚ))) := + mul_le_mul_of_nonneg_right hsq hinv0 + _ ≤ (K₀ : ℚ) ^ 2 * explicitExpReciprocalCeil := + mul_le_mul_of_nonneg_left hinv (sq_nonneg (K₀ : ℚ)) + have hu : t + t ^ 2 / + (explicitExpEvaluationLoss * ((m + 2 : ℕ) : ℚ)) ≤ + (K₀ + K₀ ^ 2 * explicitExpReciprocalCeil : ℕ) := by + norm_num only [Nat.cast_add, Nat.cast_mul, Nat.cast_pow, + Nat.cast_ofNat] at hdiv ⊢ + exact add_le_add htK₀ hdiv + have hceil : rationalCeilNat + (t + t ^ 2 / + (explicitExpEvaluationLoss * ((m + 2 : ℕ) : ℚ))) ≤ + K₀ + K₀ ^ 2 * explicitExpReciprocalCeil := + rationalCeilNat_le_of_le_nat hu + rw [RawRat.expApproxSteps, binaryRationalExpApproxSteps_eq, + rationalExpApproxSteps, RawRat.expMagnitude_value, + rawRatOfRat_value, hlossValue] + simpa only [t, K₀, S, source, explicitCertificateExpStepBound] using + Nat.add_le_add_right (Nat.mul_le_mul_left 2 hceil) 1 + +theorem optimizerCertificate_expApproxSteps_le_sourceBound + (m : ℕ) (B : Matrix (Fin (m + 2)) (Fin (m + 2)) ℚ) + (hBpos : ∀ i j, 0 < B i j) + (hBupper : ∀ i j, B i j ≤ 1) : + RawRat.expApproxSteps + (rawRatOfRat + (explicitDirectedCertificateLog + (explicitBetheOptimizerMatrix (m := m + 1) B) + (explicitBetheOptimizerRowPotential (m := m + 1) B) + (explicitBetheOptimizerColumnPotential (m := m + 1) B))) + (rawCertificateExpLoss (m + 2)) ≤ + explicitCertificateExpStepBound + (rationalMatrixBinaryEncoding.encode ⟨m + 2, B⟩).length := by + let q := explicitDirectedCertificateLog + (explicitBetheOptimizerMatrix (m := m + 1) B) + (explicitBetheOptimizerRowPotential (m := m + 1) B) + (explicitBetheOptimizerColumnPotential (m := m + 1) B) + have habsR := explicitOptimizerCertificateLog_abs_le m B hBpos hBupper + exact certificate_expApproxSteps_le_sourceBound_of_abs_le m B q + (by simpa only [q] using habsR) + +def machineIteratedBinaryWidth : ℕ → List Bool → List Bool + | 0, word => word + | k + 1, word => machineBinaryMulWidth (machineIteratedBinaryWidth k word) + +def certificateExpGuardWidth : ℕ → ℕ → ℕ + | 0, L => L + | k + 1, L => (certificateExpGuardWidth k L + 16) ^ 2 + +theorem machineIteratedBinaryWidth_mem_FP (k : ℕ) : + machineIteratedBinaryWidth k ∈ Complexity.FP := by + induction k with + | zero => simpa only [machineIteratedBinaryWidth] using id_mem_FP + | succ k ih => + simpa only [machineIteratedBinaryWidth] using + machineCompose_mem_FP ih machineBinaryMulWidth_mem_FP + +@[simp] theorem machineIteratedBinaryWidth_length (k : ℕ) + (word : List Bool) : + (machineIteratedBinaryWidth k word).length = + certificateExpGuardWidth k word.length := by + induction k with + | zero => rfl + | succ k ih => + rw [machineIteratedBinaryWidth, machineBinaryMulWidth] + simp only [List.length_replicate, List.length_append, ih, + List.length_cons, List.length_nil, zero_add] + simp only [certificateExpGuardWidth] + ring + +theorem certificateExpGuardWidth_pow_lower (k S : ℕ) : + (S + 16) ^ (2 ^ (k + 1)) ≤ certificateExpGuardWidth (k + 1) S := by + induction k with + | zero => simp [certificateExpGuardWidth] + | succ k ih => + rw [certificateExpGuardWidth] + have hmono : certificateExpGuardWidth (k + 1) S ^ 2 ≤ + (certificateExpGuardWidth (k + 1) S + 16) ^ 2 := by + exact Nat.pow_le_pow_left (Nat.le_add_right _ _) 2 + calc + (S + 16) ^ (2 ^ (k + 1 + 1)) = + ((S + 16) ^ (2 ^ (k + 1))) ^ 2 := by + rw [show 2 ^ (k + 1 + 1) = 2 ^ (k + 1) * 2 by + rw [pow_succ]] + rw [pow_mul] + _ ≤ certificateExpGuardWidth (k + 1) S ^ 2 := + Nat.pow_le_pow_left ih 2 + _ ≤ (certificateExpGuardWidth (k + 1) S + 16) ^ 2 := hmono + +def explicitCertificateExpCoefficient : ℕ := + 2312 * explicitExpReciprocalCeil + 69 + +theorem explicitCertificateExpCoefficient_le : + explicitCertificateExpCoefficient ≤ 18 ^ 60 := by + have hrecip : explicitExpReciprocalCeil ≤ 10 ^ 69 := by + rw [explicitExpReciprocalCeil] + apply rationalCeilNat_le_of_le_nat + rw [explicitExpEvaluationLoss, explicitCertifiedEpsilon, + explicitCertifiedEpsilon_eq] + norm_num [explicitXi, explicitDelta, explicitEta, explicitRowRatio] + rw [explicitCertificateExpCoefficient] + calc + 2312 * explicitExpReciprocalCeil + 69 ≤ + 2312 * 10 ^ 69 + 69 := + Nat.add_le_add_right (Nat.mul_le_mul_left 2312 hrecip) 69 + _ ≤ 18 ^ 60 := by norm_num + +theorem explicitCertificateExpStepBound_le_guardWidth + {S : ℕ} (hS : 2 ≤ S) : + explicitCertificateExpStepBound S ≤ certificateExpGuardWidth 6 S := by + let K₀ := 34 * S ^ 2 + have hSsq : S ^ 2 ≤ S ^ 4 := + Nat.pow_le_pow_right (by omega) (by omega) + have hSfour : 1 ≤ S ^ 4 := Nat.one_le_pow 4 S (by omega) + have hstepCoeff : explicitCertificateExpStepBound S ≤ + explicitCertificateExpCoefficient * S ^ 4 := by + simp only [explicitCertificateExpStepBound, K₀, + explicitCertificateExpCoefficient] + nlinarith + have hbase : 18 ≤ S + 16 := by omega + have hpow60 : 18 ^ 60 ≤ (S + 16) ^ 60 := + Nat.pow_le_pow_left hbase 60 + have hpow4 : S ^ 4 ≤ (S + 16) ^ 4 := + Nat.pow_le_pow_left (Nat.le_add_right S 16) 4 + have hguardPolynomial : explicitCertificateExpCoefficient * S ^ 4 ≤ + (S + 16) ^ 64 := by + calc + explicitCertificateExpCoefficient * S ^ 4 ≤ 18 ^ 60 * S ^ 4 := + Nat.mul_le_mul explicitCertificateExpCoefficient_le (le_refl _) + _ ≤ (S + 16) ^ 60 * (S + 16) ^ 4 := + Nat.mul_le_mul hpow60 hpow4 + _ = (S + 16) ^ 64 := by rw [← pow_add] + exact hstepCoeff.trans <| hguardPolynomial.trans <| + (by simpa using certificateExpGuardWidth_pow_lower 5 S) + +def machineOptimizerCertificateExpGuard (word : List Bool) : List Bool := + machineIteratedBinaryWidth 6 (machineCertificateSourceWord word) + +theorem machineOptimizerCertificateExpGuard_mem_FP : + machineOptimizerCertificateExpGuard ∈ Complexity.FP := by + simpa only [machineOptimizerCertificateExpGuard] using + machineCompose_mem_FP machineCertificateSourceWord_mem_FP + (machineIteratedBinaryWidth_mem_FP 6) + +theorem machineOptimizerCertificateExpGuard_fits + (m : ℕ) (B : Matrix (Fin (m + 2)) (Fin (m + 2)) ℚ) + (hBpos : ∀ i j, 0 < B i j) + (hBupper : ∀ i j, B i j ≤ 1) : + RawRat.expApproxSteps + (rawRatOfRat + (explicitDirectedCertificateLog + (explicitBetheOptimizerMatrix (m := m + 1) B) + (explicitBetheOptimizerRowPotential (m := m + 1) B) + (explicitBetheOptimizerColumnPotential (m := m + 1) B))) + (rawCertificateExpLoss (m + 2)) ≤ + (machineOptimizerCertificateExpGuard + (pair (rationalMatrixBinaryEncoding.encode ⟨m + 2, B⟩) + (rationalOptimizerOutputCode + (explicitLargeOptimizerOutput m B)))).length := by + let source := rationalMatrixBinaryEncoding.encode ⟨m + 2, B⟩ + have hsource : 2 ≤ source.length := + (show 2 ≤ m + 2 by omega).trans (matrix_dimension_le_code_length B) + exact (optimizerCertificate_expApproxSteps_le_sourceBound m B hBpos hBupper).trans + (by simpa only [machineOptimizerCertificateExpGuard, + machineCertificateSourceWord_pair, + machineIteratedBinaryWidth_length, source] using + explicitCertificateExpStepBound_le_guardWidth hsource) + +theorem machineOptimizerCertificateExpGuard_fits_onPositiveNormalized : + OptimizerCertificateExpGuardFitsOnPositiveNormalized + machineOptimizerCertificateExpGuard := by + intro m B hBpos hBupper + exact machineOptimizerCertificateExpGuard_fits m B hBpos hBupper + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineCertificatePotentials.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineCertificatePotentials.lean new file mode 100644 index 0000000000..5880da4ff0 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineCertificatePotentials.lean @@ -0,0 +1,137 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalVectorSum + +/-! +# Finite-word access and summation for certificate potentials + +This is the first component of the directed certificate evaluator. It parses +the canonical optimizer-output word and forms the unreduced rational sum of +all row and column potentials. +-/ + +namespace BeyondBethe + +open Complexity + +def machineOptimizerMatrixWord (word : List Bool) : List Bool := + machinePairFirst word + +def machineOptimizerPotentialsWord (word : List Bool) : List Bool := + machinePairSecond word + +def machineOptimizerRowPotentialWord (word : List Bool) : List Bool := + machinePairFirst (machineOptimizerPotentialsWord word) + +def machineOptimizerColumnPotentialWord (word : List Bool) : List Bool := + machinePairSecond (machineOptimizerPotentialsWord word) + +theorem machineOptimizerMatrixWord_mem_FP : + machineOptimizerMatrixWord ∈ Complexity.FP := + machinePairFirst_mem_FP + +theorem machineOptimizerPotentialsWord_mem_FP : + machineOptimizerPotentialsWord ∈ Complexity.FP := + machinePairSecond_mem_FP + +theorem machineOptimizerRowPotentialWord_mem_FP : + machineOptimizerRowPotentialWord ∈ Complexity.FP := by + simpa only [machineOptimizerRowPotentialWord] using + machineCompose_mem_FP machineOptimizerPotentialsWord_mem_FP + machinePairFirst_mem_FP + +theorem machineOptimizerColumnPotentialWord_mem_FP : + machineOptimizerColumnPotentialWord ∈ Complexity.FP := by + simpa only [machineOptimizerColumnPotentialWord] using + machineCompose_mem_FP machineOptimizerPotentialsWord_mem_FP + machinePairSecond_mem_FP + +@[simp] theorem machineOptimizerMatrixWord_encode {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℚ) : + machineOptimizerMatrixWord + (rationalOptimizerOutputCode ⟨X, R, C⟩) = + rationalMatrixBinaryEncoding.encode ⟨n, X⟩ := by + simp [machineOptimizerMatrixWord, rationalOptimizerOutputCode] + +@[simp] theorem machineOptimizerRowPotentialWord_encode {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℚ) : + machineOptimizerRowPotentialWord + (rationalOptimizerOutputCode ⟨X, R, C⟩) = + rationalVectorBinaryCode R := by + simp [machineOptimizerRowPotentialWord, machineOptimizerPotentialsWord, + rationalOptimizerOutputCode] + +@[simp] theorem machineOptimizerColumnPotentialWord_encode {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℚ) : + machineOptimizerColumnPotentialWord + (rationalOptimizerOutputCode ⟨X, R, C⟩) = + rationalVectorBinaryCode C := by + simp [machineOptimizerColumnPotentialWord, machineOptimizerPotentialsWord, + rationalOptimizerOutputCode] + +def machineCertificateRowPotentialRawSumCode + (word : List Bool) : List Bool := + machineRationalVectorRawSumCode + (machineOptimizerRowPotentialWord word) + +def machineCertificateColumnPotentialRawSumCode + (word : List Bool) : List Bool := + machineRationalVectorRawSumCode + (machineOptimizerColumnPotentialWord word) + +def machineCertificatePotentialRawSumCode + (word : List Bool) : List Bool := + machineRawRatAddCode + (pair (machineCertificateRowPotentialRawSumCode word) + (machineCertificateColumnPotentialRawSumCode word)) + +theorem machineCertificateRowPotentialRawSumCode_mem_FP : + machineCertificateRowPotentialRawSumCode ∈ Complexity.FP := by + simpa only [machineCertificateRowPotentialRawSumCode] using + machineCompose_mem_FP machineOptimizerRowPotentialWord_mem_FP + machineRationalVectorRawSumCode_mem_FP + +theorem machineCertificateColumnPotentialRawSumCode_mem_FP : + machineCertificateColumnPotentialRawSumCode ∈ Complexity.FP := by + simpa only [machineCertificateColumnPotentialRawSumCode] using + machineCompose_mem_FP machineOptimizerColumnPotentialWord_mem_FP + machineRationalVectorRawSumCode_mem_FP + +theorem machineCertificatePotentialRawSumCode_mem_FP : + machineCertificatePotentialRawSumCode ∈ Complexity.FP := by + have hpair := machinePair_mem_FP + machineCertificateRowPotentialRawSumCode_mem_FP + machineCertificateColumnPotentialRawSumCode_mem_FP + simpa only [machineCertificatePotentialRawSumCode] using + machineCompose_mem_FP hpair machineRawRatAddCode_mem_FP + +def rawCertificatePotentialSum {n : ℕ} + (R C : Fin n → ℚ) : RawRat := + (rawRatListSum RawRat.zero (List.ofFn R)).add + (rawRatListSum RawRat.zero (List.ofFn C)) + +@[simp] theorem machineCertificatePotentialRawSumCode_encode {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℚ) : + machineCertificatePotentialRawSumCode + (rationalOptimizerOutputCode ⟨X, R, C⟩) = + rawRatBinaryCode (rawCertificatePotentialSum R C) := by + simp only [machineCertificatePotentialRawSumCode, + machineCertificateRowPotentialRawSumCode, + machineCertificateColumnPotentialRawSumCode, + machineOptimizerRowPotentialWord_encode, + machineOptimizerColumnPotentialWord_encode, + machineRationalVectorRawSumCode_encode, + machineRawRatAddCode_encode, rawCertificatePotentialSum] + +theorem rawCertificatePotentialSum_value {n : ℕ} + (R C : Fin n → ℚ) : + (rawCertificatePotentialSum R C).value = + (∑ i, R i) + ∑ j, C j := by + rw [rawCertificatePotentialSum, RawRat.value_add, + rawRatListSum_ofFn_value, rawRatListSum_ofFn_value] + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineCertificateScales.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineCertificateScales.lean new file mode 100644 index 0000000000..9bdb94d3e1 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineCertificateScales.lean @@ -0,0 +1,234 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineCertificatePotentials +import LeanPool.BeyondBethe.BeyondBethe.MachineMatrixDimension +import LeanPool.BeyondBethe.BeyondBethe.MachineDirectedLog + +/-! +# Dimension-dependent certificate scales as finite-word functions + +The directed certificate uses three dimension-dependent quantities: the +regularization scale, the logarithm precision, and the linear KKT and +exponential losses. This file constructs all of them directly from the +dimension prefix of the optimizer's matrix word. +-/ + +namespace BeyondBethe + +open Complexity + +def machineCertificateDimensionBits (word : List Bool) : List Bool := + machineMatrixDimensionWord (machineOptimizerMatrixWord word) + +def machineCertificateDimensionUnary (word : List Bool) : List Bool := + machineMatrixDimensionUnary (machineOptimizerMatrixWord word) + +/-- Unary ruler of exact length `n + 400`. -/ +def machineCertificateLogPrecisionRuler (word : List Bool) : List Bool := + machineCertificateDimensionUnary word ++ List.replicate 400 true + +def machineCertificateDimensionRawCode (word : List Bool) : List Bool := + pair (machineNaturalIntegerCode (machineCertificateDimensionBits word)) + [true] + +def rawCertificateFour : RawRat := RawRat.ofNat 4 + +def machineCertificateFourDimensionRawCode + (word : List Bool) : List Bool := + machineRawRatMulCode + (pair (rawRatBinaryCode rawCertificateFour) + (machineCertificateDimensionRawCode word)) + +def rawExplicitXi : RawRat := rawRatOfRat explicitXi + +def machineCertificateRegularizationScaleRawCode + (word : List Bool) : List Bool := + machineRawRatDivCode + (pair (rawRatBinaryCode rawExplicitXi) + (machineCertificateFourDimensionRawCode word)) + +def rawExplicitKKTError : RawRat := rawRatOfRat explicitKKTError + +def machineCertificateKKTPenaltyRawCode + (word : List Bool) : List Bool := + machineRawRatMulCode + (pair (rawRatBinaryCode rawExplicitKKTError) + (machineCertificateDimensionRawCode word)) + +def rawExplicitExpEvaluationLoss : RawRat := + rawRatOfRat explicitExpEvaluationLoss + +def machineCertificateExpLossRawCode + (word : List Bool) : List Bool := + machineRawRatMulCode + (pair (rawRatBinaryCode rawExplicitExpEvaluationLoss) + (machineCertificateDimensionRawCode word)) + +theorem machineCertificateDimensionBits_mem_FP : + machineCertificateDimensionBits ∈ Complexity.FP := by + simpa only [machineCertificateDimensionBits] using + machineCompose_mem_FP machineOptimizerMatrixWord_mem_FP + machineMatrixDimensionWord_mem_FP + +theorem machineCertificateDimensionUnary_mem_FP : + machineCertificateDimensionUnary ∈ Complexity.FP := by + simpa only [machineCertificateDimensionUnary] using + machineCompose_mem_FP machineOptimizerMatrixWord_mem_FP + machineMatrixDimensionUnary_mem_FP + +theorem machineCertificateLogPrecisionRuler_mem_FP : + machineCertificateLogPrecisionRuler ∈ Complexity.FP := by + exact machineAppend_mem_FP machineCertificateDimensionUnary_mem_FP + (machineConst_mem_FP (List.replicate 400 true)) + +theorem machineCertificateDimensionRawCode_mem_FP : + machineCertificateDimensionRawCode ∈ Complexity.FP := by + have hnum := machineCompose_mem_FP machineCertificateDimensionBits_mem_FP + machineNaturalIntegerCode_mem_FP + exact machinePair_mem_FP hnum (machineConst_mem_FP [true]) + +theorem machineCertificateFourDimensionRawCode_mem_FP : + machineCertificateFourDimensionRawCode ∈ Complexity.FP := by + have hpair := machinePair_mem_FP + (machineConst_mem_FP (rawRatBinaryCode rawCertificateFour)) + machineCertificateDimensionRawCode_mem_FP + simpa only [machineCertificateFourDimensionRawCode] using + machineCompose_mem_FP hpair machineRawRatMulCode_mem_FP + +theorem machineCertificateRegularizationScaleRawCode_mem_FP : + machineCertificateRegularizationScaleRawCode ∈ Complexity.FP := by + have hpair := machinePair_mem_FP + (machineConst_mem_FP (rawRatBinaryCode rawExplicitXi)) + machineCertificateFourDimensionRawCode_mem_FP + simpa only [machineCertificateRegularizationScaleRawCode] using + machineCompose_mem_FP hpair machineRawRatDivCode_mem_FP + +theorem machineCertificateKKTPenaltyRawCode_mem_FP : + machineCertificateKKTPenaltyRawCode ∈ Complexity.FP := by + have hpair := machinePair_mem_FP + (machineConst_mem_FP (rawRatBinaryCode rawExplicitKKTError)) + machineCertificateDimensionRawCode_mem_FP + simpa only [machineCertificateKKTPenaltyRawCode] using + machineCompose_mem_FP hpair machineRawRatMulCode_mem_FP + +theorem machineCertificateExpLossRawCode_mem_FP : + machineCertificateExpLossRawCode ∈ Complexity.FP := by + have hpair := machinePair_mem_FP + (machineConst_mem_FP + (rawRatBinaryCode rawExplicitExpEvaluationLoss)) + machineCertificateDimensionRawCode_mem_FP + simpa only [machineCertificateExpLossRawCode] using + machineCompose_mem_FP hpair machineRawRatMulCode_mem_FP + +@[simp] theorem machineCertificateDimensionBits_encode {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℚ) : + machineCertificateDimensionBits + (rationalOptimizerOutputCode ⟨X, R, C⟩) = n.bits := by + simp [machineCertificateDimensionBits] + +@[simp] theorem machineCertificateDimensionUnary_encode {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℚ) : + machineCertificateDimensionUnary + (rationalOptimizerOutputCode ⟨X, R, C⟩) = + List.replicate n true := by + simp [machineCertificateDimensionUnary] + +@[simp] theorem machineCertificateLogPrecisionRuler_encode {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℚ) : + machineCertificateLogPrecisionRuler + (rationalOptimizerOutputCode ⟨X, R, C⟩) = + List.replicate (directedCertificatePrecision n) true := by + rw [machineCertificateLogPrecisionRuler, + machineCertificateDimensionUnary_encode] + change List.replicate n true ++ List.replicate 400 true = + List.replicate (n + 400) true + exact (List.replicate_add n 400 true).symm + +@[simp] theorem machineCertificateDimensionRawCode_encode {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℚ) : + machineCertificateDimensionRawCode + (rationalOptimizerOutputCode ⟨X, R, C⟩) = + rawRatBinaryCode (RawRat.ofNat n) := by + rw [machineCertificateDimensionRawCode, + machineCertificateDimensionBits_encode, + machineNaturalIntegerCode_natBits] + simp [RawRat.ofNat, rawRatBinaryCode] + +def rawCertificateFourDimension (n : ℕ) : RawRat := + rawCertificateFour.mul (RawRat.ofNat n) + +def rawCertificateRegularizationScale (n : ℕ) : RawRat := + rawExplicitXi.div (rawCertificateFourDimension n) + +def rawCertificateKKTPenalty (n : ℕ) : RawRat := + rawExplicitKKTError.mul (RawRat.ofNat n) + +def rawCertificateExpLoss (n : ℕ) : RawRat := + rawExplicitExpEvaluationLoss.mul (RawRat.ofNat n) + +@[simp] theorem machineCertificateFourDimensionRawCode_encode {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℚ) : + machineCertificateFourDimensionRawCode + (rationalOptimizerOutputCode ⟨X, R, C⟩) = + rawRatBinaryCode (rawCertificateFourDimension n) := by + rw [machineCertificateFourDimensionRawCode, + machineCertificateDimensionRawCode_encode, + machineRawRatMulCode_encode] + rfl + +@[simp] theorem machineCertificateRegularizationScaleRawCode_encode + {n : ℕ} (X : Matrix (Fin n) (Fin n) ℚ) + (R C : Fin n → ℚ) : + machineCertificateRegularizationScaleRawCode + (rationalOptimizerOutputCode ⟨X, R, C⟩) = + rawRatBinaryCode (rawCertificateRegularizationScale n) := by + rw [machineCertificateRegularizationScaleRawCode, + machineCertificateFourDimensionRawCode_encode, + machineRawRatDivCode_encode] + rfl + +@[simp] theorem machineCertificateKKTPenaltyRawCode_encode {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℚ) : + machineCertificateKKTPenaltyRawCode + (rationalOptimizerOutputCode ⟨X, R, C⟩) = + rawRatBinaryCode (rawCertificateKKTPenalty n) := by + rw [machineCertificateKKTPenaltyRawCode, + machineCertificateDimensionRawCode_encode, + machineRawRatMulCode_encode] + rfl + +@[simp] theorem machineCertificateExpLossRawCode_encode {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℚ) : + machineCertificateExpLossRawCode + (rationalOptimizerOutputCode ⟨X, R, C⟩) = + rawRatBinaryCode (rawCertificateExpLoss n) := by + rw [machineCertificateExpLossRawCode, + machineCertificateDimensionRawCode_encode, + machineRawRatMulCode_encode] + rfl + +@[simp] theorem rawCertificateFour_value : rawCertificateFour.value = 4 := by + simp [rawCertificateFour] + +theorem rawCertificateRegularizationScale_value (n : ℕ) : + (rawCertificateRegularizationScale n).value = + explicitRegularizationScale n := by + simp [rawCertificateRegularizationScale, rawCertificateFourDimension, + rawExplicitXi, explicitRegularizationScale, + binaryRatDiv_eq_div, binaryRatMul_eq_mul] + +theorem rawCertificateKKTPenalty_value (n : ℕ) : + (rawCertificateKKTPenalty n).value = explicitKKTError * n := by + simp [rawCertificateKKTPenalty, rawExplicitKKTError, + binaryRatMul_eq_mul] + +theorem rawCertificateExpLoss_value (n : ℕ) : + (rawCertificateExpLoss n).value = explicitExpEvaluationLoss * n := by + simp [rawCertificateExpLoss, rawExplicitExpEvaluationLoss, + binaryRatMul_eq_mul] + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineCertifiedPairEligibility.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineCertifiedPairEligibility.lean new file mode 100644 index 0000000000..ca595d0b1f --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineCertifiedPairEligibility.lean @@ -0,0 +1,977 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineFourCoreCost +import LeanPool.BeyondBethe.BeyondBethe.MachineUnaryRange +import LeanPool.BeyondBethe.BeyondBethe.MachineLengthBits + +/-! +# Executable column-pair eligibility + +For a fixed row pair, the certificate asks whether two distinct columns pass +the directed four-core test. This file implements the two bounded scans: +first over the second column for a fixed first column, and then over the first +column. Both loops are driven by the unary matrix dimension, and all state is +clamped on arbitrary bitstrings. +-/ + +namespace BeyondBethe + +open Complexity + +def rawExplicitKappa : RawRat := rawRatOfRat explicitKappa + +def machineExplicitKappaRawCode (_word : List Bool) : List Bool := + rawRatBinaryCode rawExplicitKappa + +theorem machineExplicitKappaRawCode_mem_FP : + machineExplicitKappaRawCode ∈ FP := + machineConst_mem_FP (rawRatBinaryCode rawExplicitKappa) + +/-! ## The inner scan: second columns for a fixed first column -/ + +def machineFixedAFirstRowRuler (word : List Bool) : List Bool := + machinePairFirst word + +def machineFixedARest₁ (word : List Bool) : List Bool := + machinePairSecond word + +def machineFixedASecondRowRuler (word : List Bool) : List Bool := + machinePairFirst (machineFixedARest₁ word) + +def machineFixedARest₂ (word : List Bool) : List Bool := + machinePairSecond (machineFixedARest₁ word) + +def machineFixedAFirstColumnRuler (word : List Bool) : List Bool := + machinePairFirst (machineFixedARest₂ word) + +def machineFixedAOptimizerWord (word : List Bool) : List Bool := + machinePairSecond (machineFixedARest₂ word) + +def machineFixedADimensionRuler (word : List Bool) : List Bool := + machineCertificateDimensionUnary (machineFixedAOptimizerWord word) + +def machineFixedAColumnRange (word : List Bool) : List Bool := + machineUnaryRangeCode (machineFixedADimensionRuler word) + +def machineFixedAPack + (remaining found source : List Bool) : List Bool := + pair remaining (pair found source) + +def machineFixedARemaining (state : List Bool) : List Bool := + machinePairFirst state + +def machineFixedAFound (state : List Bool) : List Bool := + machinePairFirst (machinePairSecond state) + +def machineFixedASource (state : List Bool) : List Bool := + machinePairSecond (machinePairSecond state) + +def machineFixedACurrentSecondColumn (state : List Bool) : List Bool := + machineListHead (machineFixedARemaining state) + +def machineFixedAColumnsEqualBit (state : List Bool) : List Bool := + machineBinaryNatEqBit + (pair (machineLengthBits + (machineFixedAFirstColumnRuler (machineFixedASource state))) + (machineLengthBits (machineFixedACurrentSecondColumn state))) + +def machineFixedAColumnsDistinctBit (state : List Bool) : List Bool := + machineNotBit (machineFixedAColumnsEqualBit state) + +def machineFixedAFourCoreInput (state : List Bool) : List Bool := + pair (machineFixedAFirstRowRuler (machineFixedASource state)) + (pair (machineFixedASecondRowRuler (machineFixedASource state)) + (pair (machineFixedAFirstColumnRuler (machineFixedASource state)) + (pair (machineFixedACurrentSecondColumn state) + (machineFixedAOptimizerWord (machineFixedASource state))))) + +def machineFixedAFourCoreRawCode (state : List Bool) : List Bool := + machineDirectedFourCoreCostUpperRawCode + (machineFixedAFourCoreInput state) + +def machineFixedACostPassesBit (state : List Bool) : List Bool := + machineRawRatLeBit + (pair (machineFixedAFourCoreRawCode state) + (rawRatBinaryCode rawExplicitKappa)) + +def machineFixedACandidateBit (state : List Bool) : List Bool := + machineAndBit (machineFixedAColumnsDistinctBit state) + (machineFixedACostPassesBit state) + +def machineFixedAInputBound (word : List Bool) : List Bool := + pair word (machineFixedAColumnRange word) + +def machineFixedANextFound (state : List Bool) : List Bool := + (machineOrBit (machineFixedAFound state) + (machineFixedACandidateBit state)).take + (machineFixedAInputBound (machineFixedASource state)).length + +def machineFixedAProcess (state : List Bool) : List Bool := + machineFixedAPack (machineListTail (machineFixedARemaining state)) + (machineFixedANextFound state) (machineFixedASource state) + +def machineFixedAStep (state : List Bool) : List Bool := + machineIfEmpty (machineFixedARemaining state) state + (machineFixedAProcess state) + +def machineFixedAInit (word : List Bool) : List Bool := + machineFixedAPack (machineFixedAColumnRange word) [false] word + +def machineFixedAWidth (word : List Bool) : List Bool := + let bound := machineFixedAInputBound word + machineFixedAPack bound bound bound + +def machineFixedAFinalState (word : List Bool) : List Bool := + (machineFixedAStep)^[(machineFixedADimensionRuler word).length] + (machineFixedAInit word) + +/-- One bit indicating whether some second column completes a certified pair +with the fixed first column. -/ +def machineFixedAEligibilityBit (word : List Bool) : List Bool := + machineFixedAFound (machineFixedAFinalState word) + +theorem machineFixedAFirstRowRuler_mem_FP : + machineFixedAFirstRowRuler ∈ FP := machinePairFirst_mem_FP + +theorem machineFixedARest₁_mem_FP : machineFixedARest₁ ∈ FP := + machinePairSecond_mem_FP + +theorem machineFixedASecondRowRuler_mem_FP : + machineFixedASecondRowRuler ∈ FP := by + simpa only [machineFixedASecondRowRuler] using machineCompose_mem_FP + machineFixedARest₁_mem_FP machinePairFirst_mem_FP + +theorem machineFixedARest₂_mem_FP : machineFixedARest₂ ∈ FP := by + simpa only [machineFixedARest₂] using machineCompose_mem_FP + machineFixedARest₁_mem_FP machinePairSecond_mem_FP + +theorem machineFixedAFirstColumnRuler_mem_FP : + machineFixedAFirstColumnRuler ∈ FP := by + simpa only [machineFixedAFirstColumnRuler] using machineCompose_mem_FP + machineFixedARest₂_mem_FP machinePairFirst_mem_FP + +theorem machineFixedAOptimizerWord_mem_FP : + machineFixedAOptimizerWord ∈ FP := by + simpa only [machineFixedAOptimizerWord] using machineCompose_mem_FP + machineFixedARest₂_mem_FP machinePairSecond_mem_FP + +theorem machineFixedADimensionRuler_mem_FP : + machineFixedADimensionRuler ∈ FP := by + simpa only [machineFixedADimensionRuler] using machineCompose_mem_FP + machineFixedAOptimizerWord_mem_FP machineCertificateDimensionUnary_mem_FP + +theorem machineFixedAColumnRange_mem_FP : machineFixedAColumnRange ∈ FP := by + simpa only [machineFixedAColumnRange] using machineCompose_mem_FP + machineFixedADimensionRuler_mem_FP machineUnaryRangeCode_mem_FP + +theorem machineFixedARemaining_mem_FP : machineFixedARemaining ∈ FP := + machinePairFirst_mem_FP + +theorem machineFixedAFound_mem_FP : machineFixedAFound ∈ FP := by + simpa only [machineFixedAFound] using machineCompose_mem_FP + machinePairSecond_mem_FP machinePairFirst_mem_FP + +theorem machineFixedASource_mem_FP : machineFixedASource ∈ FP := by + simpa only [machineFixedASource] using machineCompose_mem_FP + machinePairSecond_mem_FP machinePairSecond_mem_FP + +theorem machineFixedACurrentSecondColumn_mem_FP : + machineFixedACurrentSecondColumn ∈ FP := by + simpa only [machineFixedACurrentSecondColumn] using machineCompose_mem_FP + machineFixedARemaining_mem_FP machineListHead_mem_FP + +theorem machineFixedAColumnsEqualBit_mem_FP : + machineFixedAColumnsEqualBit ∈ FP := by + have hfirst := machineCompose_mem_FP + (machineCompose_mem_FP machineFixedASource_mem_FP + machineFixedAFirstColumnRuler_mem_FP) machineLengthBits_mem_FP + have hsecond := machineCompose_mem_FP + machineFixedACurrentSecondColumn_mem_FP machineLengthBits_mem_FP + have hinput := machinePair_mem_FP hfirst hsecond + simpa only [machineFixedAColumnsEqualBit] using machineCompose_mem_FP hinput + machineBinaryNatEqBit_mem_FP + +theorem machineFixedAColumnsDistinctBit_mem_FP : + machineFixedAColumnsDistinctBit ∈ FP := by + exact machineNotBit_mem_FP machineFixedAColumnsEqualBit_mem_FP + +theorem machineFixedAFourCoreInput_mem_FP : + machineFixedAFourCoreInput ∈ FP := by + have hsourceFirst := machineCompose_mem_FP machineFixedASource_mem_FP + machineFixedAFirstRowRuler_mem_FP + have hsourceSecond := machineCompose_mem_FP machineFixedASource_mem_FP + machineFixedASecondRowRuler_mem_FP + have hsourceA := machineCompose_mem_FP machineFixedASource_mem_FP + machineFixedAFirstColumnRuler_mem_FP + have hsourceOptimizer := machineCompose_mem_FP machineFixedASource_mem_FP + machineFixedAOptimizerWord_mem_FP + exact machinePair_mem_FP hsourceFirst + (machinePair_mem_FP hsourceSecond + (machinePair_mem_FP hsourceA + (machinePair_mem_FP machineFixedACurrentSecondColumn_mem_FP + hsourceOptimizer))) + +theorem machineFixedAFourCoreRawCode_mem_FP : + machineFixedAFourCoreRawCode ∈ FP := by + simpa only [machineFixedAFourCoreRawCode] using machineCompose_mem_FP + machineFixedAFourCoreInput_mem_FP + machineDirectedFourCoreCostUpperRawCode_mem_FP + +theorem machineFixedACostPassesBit_mem_FP : + machineFixedACostPassesBit ∈ FP := by + have hinput := machinePair_mem_FP machineFixedAFourCoreRawCode_mem_FP + (machineConst_mem_FP (rawRatBinaryCode rawExplicitKappa)) + simpa only [machineFixedACostPassesBit] using machineCompose_mem_FP hinput + machineRawRatLeBit_mem_FP + +theorem machineFixedACandidateBit_mem_FP : + machineFixedACandidateBit ∈ FP := + machineAndBit_mem_FP machineFixedAColumnsDistinctBit_mem_FP + machineFixedACostPassesBit_mem_FP + +theorem machineFixedAInputBound_mem_FP : machineFixedAInputBound ∈ FP := + machinePair_mem_FP id_mem_FP machineFixedAColumnRange_mem_FP + +theorem machineFixedANextFound_mem_FP : machineFixedANextFound ∈ FP := by + have hdata := machineOrBit_mem_FP machineFixedAFound_mem_FP + machineFixedACandidateBit_mem_FP + have hbound := machineCompose_mem_FP machineFixedASource_mem_FP + machineFixedAInputBound_mem_FP + simpa only [machineFixedANextFound] using machineTake_mem_FP hbound hdata + +theorem machineFixedAProcess_mem_FP : machineFixedAProcess ∈ FP := by + have htail := machineCompose_mem_FP machineFixedARemaining_mem_FP + machineListTail_mem_FP + exact machinePair_mem_FP htail + (machinePair_mem_FP machineFixedANextFound_mem_FP + machineFixedASource_mem_FP) + +theorem machineFixedAStep_mem_FP : machineFixedAStep ∈ FP := by + simpa only [machineFixedAStep] using machineIfEmpty_mem_FP + machineFixedARemaining_mem_FP id_mem_FP machineFixedAProcess_mem_FP + +theorem machineFixedAInit_mem_FP : machineFixedAInit ∈ FP := + machinePair_mem_FP machineFixedAColumnRange_mem_FP + (machinePair_mem_FP (machineConst_mem_FP [false]) id_mem_FP) + +theorem machineFixedAWidth_mem_FP : machineFixedAWidth ∈ FP := by + exact machinePair_mem_FP machineFixedAInputBound_mem_FP + (machinePair_mem_FP machineFixedAInputBound_mem_FP + machineFixedAInputBound_mem_FP) + +@[simp] theorem machineFixedARemaining_pack (remaining found source) : + machineFixedARemaining (machineFixedAPack remaining found source) = + remaining := by simp [machineFixedARemaining, machineFixedAPack] + +@[simp] theorem machineFixedAFound_pack (remaining found source) : + machineFixedAFound (machineFixedAPack remaining found source) = found := by + simp [machineFixedAFound, machineFixedAPack] + +@[simp] theorem machineFixedASource_pack (remaining found source) : + machineFixedASource (machineFixedAPack remaining found source) = source := by + simp [machineFixedASource, machineFixedAPack] + +def MachineFixedAStateBound (word state : List Bool) : Prop := + let B := (machineFixedAInputBound word).length + state = machineFixedAPack (machineFixedARemaining state) + (machineFixedAFound state) (machineFixedASource state) ∧ + (machineFixedARemaining state).length ≤ B ∧ + (machineFixedAFound state).length ≤ B ∧ + machineFixedASource state = word + +theorem machineFixedAInput_le_bound (word : List Bool) : + word.length ≤ (machineFixedAInputBound word).length := by + simpa only [machineFixedAInputBound, machinePairFirst_pair] using + machinePairFirst_length_le (pair word (machineFixedAColumnRange word)) + +theorem machineFixedARange_le_bound (word : List Bool) : + (machineFixedAColumnRange word).length ≤ + (machineFixedAInputBound word).length := by + simpa only [machineFixedAInputBound, machinePairSecond_pair] using + machinePairSecond_length_le (pair word (machineFixedAColumnRange word)) + +theorem machineFixedA_one_le_bound (word : List Bool) : + 1 ≤ (machineFixedAInputBound word).length := by + simp only [machineFixedAInputBound, pair_length] + omega + +theorem machineFixedAInit_bound (word : List Bool) : + MachineFixedAStateBound word (machineFixedAInit word) := by + simp only [MachineFixedAStateBound, machineFixedAInit, + machineFixedARemaining_pack, machineFixedAFound_pack, + machineFixedASource_pack] + exact ⟨trivial, machineFixedARange_le_bound word, + machineFixedA_one_le_bound word, trivial⟩ + +theorem machineFixedAStep_bound {word state : List Bool} + (hstate : MachineFixedAStateBound word state) : + MachineFixedAStateBound word (machineFixedAStep state) := by + rcases hstate with ⟨hpack, hremaining, hfound, hsource⟩ + by_cases hrem : machineFixedARemaining state = [] + · rw [machineFixedAStep, hrem, machineIfEmpty_nil] + exact ⟨hpack, hremaining, hfound, hsource⟩ + · rw [machineFixedAStep] + cases hcode : machineFixedARemaining state with + | nil => exact False.elim (hrem hcode) + | cons bit tail => + rw [machineIfEmpty_cons, machineFixedAProcess] + simp only [MachineFixedAStateBound, machineFixedARemaining_pack, + machineFixedAFound_pack, machineFixedASource_pack] + refine ⟨trivial, ?_, ?_, hsource⟩ + · exact (machinePairSecond_length_le + (machineFixedARemaining state)).trans hremaining + · simp only [machineFixedANextFound, List.length_take] + rw [hsource] + exact Nat.min_le_left _ _ + +theorem machineFixedAIterate_bound (word : List Bool) : ∀ k, + MachineFixedAStateBound word + ((machineFixedAStep)^[k] (machineFixedAInit word)) := by + intro k + induction k with + | zero => exact machineFixedAInit_bound word + | succ k ih => + rw [Function.iterate_succ_apply'] + exact machineFixedAStep_bound ih + +theorem machineFixedAIterate_length_le_width + (word : List Bool) (iterations : ℕ) + (_ : iterations ≤ (machineFixedADimensionRuler word).length) : + ((machineFixedAStep)^[iterations] (machineFixedAInit word)).length ≤ + (machineFixedAWidth word).length := by + have h := machineFixedAIterate_bound word iterations + rcases h with ⟨hpack, hremaining, hfound, hsource⟩ + rw [hpack] + simp only [machineFixedAPack, machineFixedAWidth, pair_length] + have hsourceLength : (machineFixedASource + ((machineFixedAStep)^[iterations] (machineFixedAInit word))).length ≤ + (machineFixedAInputBound word).length := by + rw [hsource] + exact machineFixedAInput_le_bound word + omega + +theorem machineFixedAFinalState_mem_FP : machineFixedAFinalState ∈ FP := by + exact Cobham.iterate_mem_FP machineFixedAStep_mem_FP + machineFixedAInit_mem_FP machineFixedADimensionRuler_mem_FP + machineFixedAWidth_mem_FP machineFixedAIterate_length_le_width + +theorem machineFixedAEligibilityBit_mem_FP : + machineFixedAEligibilityBit ∈ FP := by + simpa only [machineFixedAEligibilityBit] using machineCompose_mem_FP + machineFixedAFinalState_mem_FP machineFixedAFound_mem_FP + +/-! ## Exact inner-scan semantics -/ + +def fixedAMachineInput {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℚ) + (r s a : Fin n) : List Bool := + pair (finUnaryCode r) + (pair (finUnaryCode s) + (pair (finUnaryCode a) (rationalOptimizerOutputCode ⟨X, R, C⟩))) + +def certifiedColumnPairTest {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) (r s a b : Fin n) : Bool := + decide (a ≠ b ∧ + directedFourCoreCostUpper (explicitRegularizationScale n) X r s a b + (directedPairCostPrecision n) ≤ explicitKappa) + +@[simp] theorem machineFixedAColumnsDistinctBit_encode {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℚ) + (r s a b : Fin n) (found : Bool) (bs : List (Fin n)) : + machineFixedAColumnsDistinctBit + (machineFixedAPack (binaryListCode finUnaryCode (b :: bs)) [found] + (fixedAMachineInput X R C r s a)) = + [decide (a ≠ b)] := by + rw [machineFixedAColumnsDistinctBit, machineFixedAColumnsEqualBit] + simp only [machineFixedASource_pack, machineFixedARemaining_pack, + machineFixedACurrentSecondColumn, machineListHead_cons, + machineFixedAFirstColumnRuler, fixedAMachineInput, + machineFixedARest₁, machineFixedARest₂, + machinePairFirst_pair, machinePairSecond_pair, + machineLengthBits_encode, finUnaryCode, List.length_replicate, + machineBinaryNatEqBit_pair_natBits, machineNotBit_one] + by_cases hval : a.1 = b.1 + · have hab : a = b := Fin.ext hval + simp [hval, hab] + · have hab : a ≠ b := fun h ↦ hval (congrArg Fin.val h) + simp [hval, hab] + +@[simp] theorem machineFixedAFourCoreRawCode_encode {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℚ) + (r s a b : Fin n) (found : Bool) (bs : List (Fin n)) : + machineFixedAFourCoreRawCode + (machineFixedAPack (binaryListCode finUnaryCode (b :: bs)) [found] + (fixedAMachineInput X R C r s a)) = + rawRatBinaryCode (rawDirectedFourCoreCostUpper X r s a b) := by + simp [machineFixedAFourCoreRawCode, machineFixedAFourCoreInput, + machineFixedASource, machineFixedARemaining, + machineFixedACurrentSecondColumn, machineFixedAFirstRowRuler, + machineFixedASecondRowRuler, machineFixedAFirstColumnRuler, + machineFixedAOptimizerWord, machineFixedARest₁, machineFixedARest₂, + machineFixedAPack, fixedAMachineInput] + change machineDirectedFourCoreCostUpperRawCode + (fourCoreMachineInput X R C r s a b) = _ + exact machineDirectedFourCoreCostUpperRawCode_encode X R C r s a b + +@[simp] theorem machineFixedACostPassesBit_encode {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℚ) + (r s a b : Fin n) (found : Bool) (bs : List (Fin n)) : + machineFixedACostPassesBit + (machineFixedAPack (binaryListCode finUnaryCode (b :: bs)) [found] + (fixedAMachineInput X R C r s a)) = + [decide (directedFourCoreCostUpper (explicitRegularizationScale n) X + r s a b (directedPairCostPrecision n) ≤ explicitKappa)] := by + rw [machineFixedACostPassesBit, + machineFixedAFourCoreRawCode_encode] + change machineRawRatLeBit + (pair (rawRatBinaryCode (rawDirectedFourCoreCostUpper X r s a b)) + (rawRatBinaryCode rawExplicitKappa)) = _ + rw [machineRawRatLeBit_encode, rawDirectedFourCoreCostUpper_value] + simp only [rawExplicitKappa, rawRatOfRat_value] + +@[simp] theorem machineFixedADimensionRuler_encode {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℚ) + (r s a : Fin n) : + machineFixedADimensionRuler (fixedAMachineInput X R C r s a) = + List.replicate n true := by + simp [machineFixedADimensionRuler, fixedAMachineInput, + machineFixedAOptimizerWord, machineFixedARest₁, machineFixedARest₂] + +@[simp] theorem machineFixedAColumnRange_encode {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℚ) + (r s a : Fin n) : + machineFixedAColumnRange (fixedAMachineInput X R C r s a) = + finRangeUnaryCode n := by + rw [machineFixedAColumnRange, machineFixedADimensionRuler_encode, + machineUnaryRangeCode_encode] + +@[simp] theorem machineFixedACandidateBit_encode {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℚ) + (r s a b : Fin n) (found : Bool) (bs : List (Fin n)) : + machineFixedACandidateBit + (machineFixedAPack (binaryListCode finUnaryCode (b :: bs)) [found] + (fixedAMachineInput X R C r s a)) = + [certifiedColumnPairTest X r s a b] := by + rw [machineFixedACandidateBit, machineFixedAColumnsDistinctBit_encode, + machineFixedACostPassesBit_encode, machineAndBit_one] + simp only [certifiedColumnPairTest] + by_cases hdistinct : a ≠ b <;> + by_cases hcost : directedFourCoreCostUpper (explicitRegularizationScale n) + X r s a b (directedPairCostPrecision n) ≤ explicitKappa <;> + simp [hdistinct, hcost] + +def fixedAScanFound {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) (r s a : Fin n) (k : ℕ) : Bool := + ((List.finRange n).take k).any (certifiedColumnPairTest X r s a) + +def machineFixedASemanticState {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℚ) + (r s a : Fin n) (k : ℕ) : List Bool := + machineFixedAPack + (binaryListCode finUnaryCode ((List.finRange n).drop k)) + [fixedAScanFound X r s a k] (fixedAMachineInput X R C r s a) + +@[simp] theorem machineFixedASemanticState_zero {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℚ) + (r s a : Fin n) : + machineFixedASemanticState X R C r s a 0 = + machineFixedAInit (fixedAMachineInput X R C r s a) := by + simp [machineFixedASemanticState, machineFixedAInit, fixedAScanFound, + machineFixedAColumnRange_encode, finRangeUnaryCode] + +theorem machineFixedASemanticState_step {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℚ) + (r s a : Fin n) (k : ℕ) (hk : k < n) : + machineFixedAStep (machineFixedASemanticState X R C r s a k) = + machineFixedASemanticState X R C r s a (k + 1) := by + have hklen : k < (List.finRange n).length := by simpa using hk + rw [machineFixedASemanticState, + List.drop_eq_getElem_cons hklen] + rw [machineFixedAStep] + simp only [machineFixedARemaining_pack] + rw [machineIfEmpty_of_ne_nil_matrix _ _ _ + (binaryListCode_cons_ne_nil finUnaryCode (List.finRange n)[k] + ((List.finRange n).drop (k + 1)))] + rw [machineFixedAProcess] + simp only [machineFixedARemaining_pack, machineListTail_cons, + machineFixedASource_pack, machineFixedANextFound, + machineFixedAFound_pack, machineFixedACandidateBit_encode, + machineOrBit_one] + have hbound : 1 ≤ + (machineFixedAInputBound (fixedAMachineInput X R C r s a)).length := + machineFixedA_one_le_bound _ + rw [(List.take_eq_self_iff _).2 (by simpa using hbound)] + rw [machineFixedASemanticState] + apply congrArg (fun z : Bool ↦ + machineFixedAPack + (binaryListCode finUnaryCode ((List.finRange n).drop (k + 1))) [z] + (fixedAMachineInput X R C r s a)) + rw [fixedAScanFound, fixedAScanFound, + ← List.take_concat_get hklen, List.concat_eq_append, List.any_append] + simp + +theorem machineFixedAIterate_semantics {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℚ) + (r s a : Fin n) (k : ℕ) (hk : k ≤ n) : + (machineFixedAStep)^[k] (machineFixedAInit + (fixedAMachineInput X R C r s a)) = + machineFixedASemanticState X R C r s a k := by + induction k with + | zero => exact (machineFixedASemanticState_zero X R C r s a).symm + | succ k ih => + rw [Function.iterate_succ_apply', ih (by omega), + machineFixedASemanticState_step X R C r s a k (by omega)] + +@[simp] theorem machineFixedAEligibilityBit_encode {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℚ) + (r s a : Fin n) : + machineFixedAEligibilityBit (fixedAMachineInput X R C r s a) = + [(List.finRange n).any (certifiedColumnPairTest X r s a)] := by + rw [machineFixedAEligibilityBit, machineFixedAFinalState, + machineFixedADimensionRuler_encode, List.length_replicate, + machineFixedAIterate_semantics X R C r s a n le_rfl, + machineFixedASemanticState, machineFixedAFound_pack, fixedAScanFound] + rw [(List.take_eq_self_iff _).2 (by simp)] + +/-! ## The outer scan: first columns for a fixed row pair -/ + +def machineRowPairFirstRowRuler (word : List Bool) : List Bool := + machinePairFirst word + +def machineRowPairRest (word : List Bool) : List Bool := + machinePairSecond word + +def machineRowPairSecondRowRuler (word : List Bool) : List Bool := + machinePairFirst (machineRowPairRest word) + +def machineRowPairOptimizerWord (word : List Bool) : List Bool := + machinePairSecond (machineRowPairRest word) + +def machineRowPairDimensionRuler (word : List Bool) : List Bool := + machineCertificateDimensionUnary (machineRowPairOptimizerWord word) + +def machineRowPairColumnRange (word : List Bool) : List Bool := + machineUnaryRangeCode (machineRowPairDimensionRuler word) + +def machineRowPairScanPack + (remaining found source : List Bool) : List Bool := + pair remaining (pair found source) + +def machineRowPairScanRemaining (state : List Bool) : List Bool := + machinePairFirst state + +def machineRowPairScanFound (state : List Bool) : List Bool := + machinePairFirst (machinePairSecond state) + +def machineRowPairScanSource (state : List Bool) : List Bool := + machinePairSecond (machinePairSecond state) + +def machineRowPairCurrentFirstColumn (state : List Bool) : List Bool := + machineListHead (machineRowPairScanRemaining state) + +def machineRowPairFixedAInput (state : List Bool) : List Bool := + pair (machineRowPairFirstRowRuler (machineRowPairScanSource state)) + (pair (machineRowPairSecondRowRuler (machineRowPairScanSource state)) + (pair (machineRowPairCurrentFirstColumn state) + (machineRowPairOptimizerWord (machineRowPairScanSource state)))) + +def machineRowPairCandidateBit (state : List Bool) : List Bool := + machineFixedAEligibilityBit (machineRowPairFixedAInput state) + +def machineRowPairInputBound (word : List Bool) : List Bool := + pair word (machineRowPairColumnRange word) + +def machineRowPairNextFound (state : List Bool) : List Bool := + (machineOrBit (machineRowPairScanFound state) + (machineRowPairCandidateBit state)).take + (machineRowPairInputBound (machineRowPairScanSource state)).length + +def machineRowPairProcess (state : List Bool) : List Bool := + machineRowPairScanPack + (machineListTail (machineRowPairScanRemaining state)) + (machineRowPairNextFound state) (machineRowPairScanSource state) + +def machineRowPairScanStep (state : List Bool) : List Bool := + machineIfEmpty (machineRowPairScanRemaining state) state + (machineRowPairProcess state) + +def machineRowPairScanInit (word : List Bool) : List Bool := + machineRowPairScanPack (machineRowPairColumnRange word) [false] word + +def machineRowPairScanWidth (word : List Bool) : List Bool := + let bound := machineRowPairInputBound word + machineRowPairScanPack bound bound bound + +def machineRowPairScanFinalState (word : List Bool) : List Bool := + (machineRowPairScanStep)^[(machineRowPairDimensionRuler word).length] + (machineRowPairScanInit word) + +/-- One-bit result of the complete existential column-pair scan. -/ +def machineCertifiedRowPairEligibilityBit (word : List Bool) : List Bool := + machineRowPairScanFound (machineRowPairScanFinalState word) + +theorem machineRowPairFirstRowRuler_mem_FP : + machineRowPairFirstRowRuler ∈ FP := machinePairFirst_mem_FP + +theorem machineRowPairRest_mem_FP : machineRowPairRest ∈ FP := + machinePairSecond_mem_FP + +theorem machineRowPairSecondRowRuler_mem_FP : + machineRowPairSecondRowRuler ∈ FP := by + simpa only [machineRowPairSecondRowRuler] using machineCompose_mem_FP + machineRowPairRest_mem_FP machinePairFirst_mem_FP + +theorem machineRowPairOptimizerWord_mem_FP : + machineRowPairOptimizerWord ∈ FP := by + simpa only [machineRowPairOptimizerWord] using machineCompose_mem_FP + machineRowPairRest_mem_FP machinePairSecond_mem_FP + +theorem machineRowPairDimensionRuler_mem_FP : + machineRowPairDimensionRuler ∈ FP := by + simpa only [machineRowPairDimensionRuler] using machineCompose_mem_FP + machineRowPairOptimizerWord_mem_FP machineCertificateDimensionUnary_mem_FP + +theorem machineRowPairColumnRange_mem_FP : machineRowPairColumnRange ∈ FP := by + simpa only [machineRowPairColumnRange] using machineCompose_mem_FP + machineRowPairDimensionRuler_mem_FP machineUnaryRangeCode_mem_FP + +theorem machineRowPairScanRemaining_mem_FP : + machineRowPairScanRemaining ∈ FP := machinePairFirst_mem_FP + +theorem machineRowPairScanFound_mem_FP : machineRowPairScanFound ∈ FP := by + simpa only [machineRowPairScanFound] using machineCompose_mem_FP + machinePairSecond_mem_FP machinePairFirst_mem_FP + +theorem machineRowPairScanSource_mem_FP : machineRowPairScanSource ∈ FP := by + simpa only [machineRowPairScanSource] using machineCompose_mem_FP + machinePairSecond_mem_FP machinePairSecond_mem_FP + +theorem machineRowPairCurrentFirstColumn_mem_FP : + machineRowPairCurrentFirstColumn ∈ FP := by + simpa only [machineRowPairCurrentFirstColumn] using machineCompose_mem_FP + machineRowPairScanRemaining_mem_FP machineListHead_mem_FP + +theorem machineRowPairFixedAInput_mem_FP : + machineRowPairFixedAInput ∈ FP := by + have hfirst := machineCompose_mem_FP machineRowPairScanSource_mem_FP + machineRowPairFirstRowRuler_mem_FP + have hsecond := machineCompose_mem_FP machineRowPairScanSource_mem_FP + machineRowPairSecondRowRuler_mem_FP + have hoptimizer := machineCompose_mem_FP machineRowPairScanSource_mem_FP + machineRowPairOptimizerWord_mem_FP + exact machinePair_mem_FP hfirst + (machinePair_mem_FP hsecond + (machinePair_mem_FP machineRowPairCurrentFirstColumn_mem_FP hoptimizer)) + +theorem machineRowPairCandidateBit_mem_FP : + machineRowPairCandidateBit ∈ FP := by + simpa only [machineRowPairCandidateBit] using machineCompose_mem_FP + machineRowPairFixedAInput_mem_FP machineFixedAEligibilityBit_mem_FP + +theorem machineRowPairInputBound_mem_FP : machineRowPairInputBound ∈ FP := + machinePair_mem_FP id_mem_FP machineRowPairColumnRange_mem_FP + +theorem machineRowPairNextFound_mem_FP : machineRowPairNextFound ∈ FP := by + have hdata := machineOrBit_mem_FP machineRowPairScanFound_mem_FP + machineRowPairCandidateBit_mem_FP + have hbound := machineCompose_mem_FP machineRowPairScanSource_mem_FP + machineRowPairInputBound_mem_FP + simpa only [machineRowPairNextFound] using machineTake_mem_FP hbound hdata + +theorem machineRowPairProcess_mem_FP : machineRowPairProcess ∈ FP := by + have htail := machineCompose_mem_FP machineRowPairScanRemaining_mem_FP + machineListTail_mem_FP + exact machinePair_mem_FP htail + (machinePair_mem_FP machineRowPairNextFound_mem_FP + machineRowPairScanSource_mem_FP) + +theorem machineRowPairScanStep_mem_FP : machineRowPairScanStep ∈ FP := by + simpa only [machineRowPairScanStep] using machineIfEmpty_mem_FP + machineRowPairScanRemaining_mem_FP id_mem_FP machineRowPairProcess_mem_FP + +theorem machineRowPairScanInit_mem_FP : machineRowPairScanInit ∈ FP := + machinePair_mem_FP machineRowPairColumnRange_mem_FP + (machinePair_mem_FP (machineConst_mem_FP [false]) id_mem_FP) + +theorem machineRowPairScanWidth_mem_FP : machineRowPairScanWidth ∈ FP := + machinePair_mem_FP machineRowPairInputBound_mem_FP + (machinePair_mem_FP machineRowPairInputBound_mem_FP + machineRowPairInputBound_mem_FP) + +@[simp] theorem machineRowPairScanRemaining_pack (remaining found source) : + machineRowPairScanRemaining + (machineRowPairScanPack remaining found source) = remaining := by + simp [machineRowPairScanRemaining, machineRowPairScanPack] + +@[simp] theorem machineRowPairScanFound_pack (remaining found source) : + machineRowPairScanFound + (machineRowPairScanPack remaining found source) = found := by + simp [machineRowPairScanFound, machineRowPairScanPack] + +@[simp] theorem machineRowPairScanSource_pack (remaining found source) : + machineRowPairScanSource + (machineRowPairScanPack remaining found source) = source := by + simp [machineRowPairScanSource, machineRowPairScanPack] + +def MachineRowPairScanStateBound (word state : List Bool) : Prop := + let B := (machineRowPairInputBound word).length + state = machineRowPairScanPack (machineRowPairScanRemaining state) + (machineRowPairScanFound state) (machineRowPairScanSource state) ∧ + (machineRowPairScanRemaining state).length ≤ B ∧ + (machineRowPairScanFound state).length ≤ B ∧ + machineRowPairScanSource state = word + +theorem machineRowPairInput_le_bound (word : List Bool) : + word.length ≤ (machineRowPairInputBound word).length := by + simpa only [machineRowPairInputBound, machinePairFirst_pair] using + machinePairFirst_length_le (pair word (machineRowPairColumnRange word)) + +theorem machineRowPairRange_le_bound (word : List Bool) : + (machineRowPairColumnRange word).length ≤ + (machineRowPairInputBound word).length := by + simpa only [machineRowPairInputBound, machinePairSecond_pair] using + machinePairSecond_length_le (pair word (machineRowPairColumnRange word)) + +theorem machineRowPair_one_le_bound (word : List Bool) : + 1 ≤ (machineRowPairInputBound word).length := by + simp only [machineRowPairInputBound, pair_length] + omega + +theorem machineRowPairScanInit_bound (word : List Bool) : + MachineRowPairScanStateBound word (machineRowPairScanInit word) := by + simp only [MachineRowPairScanStateBound, machineRowPairScanInit, + machineRowPairScanRemaining_pack, machineRowPairScanFound_pack, + machineRowPairScanSource_pack] + exact ⟨trivial, machineRowPairRange_le_bound word, + machineRowPair_one_le_bound word, trivial⟩ + +theorem machineRowPairScanStep_bound {word state : List Bool} + (hstate : MachineRowPairScanStateBound word state) : + MachineRowPairScanStateBound word (machineRowPairScanStep state) := by + rcases hstate with ⟨hpack, hremaining, hfound, hsource⟩ + by_cases hrem : machineRowPairScanRemaining state = [] + · rw [machineRowPairScanStep, hrem, machineIfEmpty_nil] + exact ⟨hpack, hremaining, hfound, hsource⟩ + · rw [machineRowPairScanStep] + cases hcode : machineRowPairScanRemaining state with + | nil => exact False.elim (hrem hcode) + | cons bit tail => + rw [machineIfEmpty_cons, machineRowPairProcess] + simp only [MachineRowPairScanStateBound, + machineRowPairScanRemaining_pack, machineRowPairScanFound_pack, + machineRowPairScanSource_pack] + refine ⟨trivial, ?_, ?_, hsource⟩ + · exact (machinePairSecond_length_le + (machineRowPairScanRemaining state)).trans hremaining + · simp only [machineRowPairNextFound, List.length_take] + rw [hsource] + exact Nat.min_le_left _ _ + +theorem machineRowPairScanIterate_bound (word : List Bool) : ∀ k, + MachineRowPairScanStateBound word + ((machineRowPairScanStep)^[k] (machineRowPairScanInit word)) := by + intro k + induction k with + | zero => exact machineRowPairScanInit_bound word + | succ k ih => + rw [Function.iterate_succ_apply'] + exact machineRowPairScanStep_bound ih + +theorem machineRowPairScanIterate_length_le_width + (word : List Bool) (iterations : ℕ) + (_ : iterations ≤ (machineRowPairDimensionRuler word).length) : + ((machineRowPairScanStep)^[iterations] + (machineRowPairScanInit word)).length ≤ + (machineRowPairScanWidth word).length := by + have h := machineRowPairScanIterate_bound word iterations + rcases h with ⟨hpack, hremaining, hfound, hsource⟩ + have hsourceLength : (machineRowPairScanSource + ((machineRowPairScanStep)^[iterations] + (machineRowPairScanInit word))).length ≤ + (machineRowPairInputBound word).length := by + rw [hsource] + exact machineRowPairInput_le_bound word + rw [hpack] + simp only [machineRowPairScanPack, machineRowPairScanWidth, pair_length] + omega + +theorem machineRowPairScanFinalState_mem_FP : + machineRowPairScanFinalState ∈ FP := by + exact Cobham.iterate_mem_FP machineRowPairScanStep_mem_FP + machineRowPairScanInit_mem_FP machineRowPairDimensionRuler_mem_FP + machineRowPairScanWidth_mem_FP + machineRowPairScanIterate_length_le_width + +theorem machineCertifiedRowPairEligibilityBit_mem_FP : + machineCertifiedRowPairEligibilityBit ∈ FP := by + simpa only [machineCertifiedRowPairEligibilityBit] using + machineCompose_mem_FP machineRowPairScanFinalState_mem_FP + machineRowPairScanFound_mem_FP + +/-! ## Exact outer-scan semantics -/ + +def certifiedRowPairMachineInput {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℚ) + (r s : Fin n) : List Bool := + pair (finUnaryCode r) + (pair (finUnaryCode s) (rationalOptimizerOutputCode ⟨X, R, C⟩)) + +def certifiedFirstColumnTest {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) (r s a : Fin n) : Bool := + (List.finRange n).any (certifiedColumnPairTest X r s a) + +def certifiedRowPairEligibilityTest {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) (r s : Fin n) : Bool := + (List.finRange n).any (certifiedFirstColumnTest X r s) + +@[simp] theorem machineRowPairDimensionRuler_encode {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℚ) + (r s : Fin n) : + machineRowPairDimensionRuler (certifiedRowPairMachineInput X R C r s) = + List.replicate n true := by + simp [machineRowPairDimensionRuler, machineRowPairOptimizerWord, + machineRowPairRest, certifiedRowPairMachineInput] + +@[simp] theorem machineRowPairColumnRange_encode {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℚ) + (r s : Fin n) : + machineRowPairColumnRange (certifiedRowPairMachineInput X R C r s) = + finRangeUnaryCode n := by + rw [machineRowPairColumnRange, machineRowPairDimensionRuler_encode, + machineUnaryRangeCode_encode] + +@[simp] theorem machineRowPairCandidateBit_encode {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℚ) + (r s a : Fin n) (found : Bool) (as : List (Fin n)) : + machineRowPairCandidateBit + (machineRowPairScanPack + (binaryListCode finUnaryCode (a :: as)) [found] + (certifiedRowPairMachineInput X R C r s)) = + [certifiedFirstColumnTest X r s a] := by + simp [machineRowPairCandidateBit, machineRowPairFixedAInput, + machineRowPairScanSource, machineRowPairScanRemaining, + machineRowPairCurrentFirstColumn, machineRowPairFirstRowRuler, + machineRowPairSecondRowRuler, machineRowPairOptimizerWord, + machineRowPairRest, machineRowPairScanPack, + certifiedRowPairMachineInput, + certifiedFirstColumnTest] + change machineFixedAEligibilityBit (fixedAMachineInput X R C r s a) = _ + exact machineFixedAEligibilityBit_encode X R C r s a + +def outerScanFound {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) (r s : Fin n) (k : ℕ) : Bool := + ((List.finRange n).take k).any (certifiedFirstColumnTest X r s) + +def machineRowPairSemanticState {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℚ) + (r s : Fin n) (k : ℕ) : List Bool := + machineRowPairScanPack + (binaryListCode finUnaryCode ((List.finRange n).drop k)) + [outerScanFound X r s k] (certifiedRowPairMachineInput X R C r s) + +@[simp] theorem machineRowPairSemanticState_zero {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℚ) + (r s : Fin n) : + machineRowPairSemanticState X R C r s 0 = + machineRowPairScanInit (certifiedRowPairMachineInput X R C r s) := by + simp [machineRowPairSemanticState, machineRowPairScanInit, outerScanFound, + machineRowPairColumnRange_encode, finRangeUnaryCode] + +theorem machineRowPairSemanticState_step {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℚ) + (r s : Fin n) (k : ℕ) (hk : k < n) : + machineRowPairScanStep (machineRowPairSemanticState X R C r s k) = + machineRowPairSemanticState X R C r s (k + 1) := by + have hklen : k < (List.finRange n).length := by simpa using hk + rw [machineRowPairSemanticState, List.drop_eq_getElem_cons hklen, + machineRowPairScanStep] + simp only [machineRowPairScanRemaining_pack] + rw [machineIfEmpty_of_ne_nil_matrix _ _ _ + (binaryListCode_cons_ne_nil finUnaryCode (List.finRange n)[k] + ((List.finRange n).drop (k + 1)))] + rw [machineRowPairProcess] + simp only [machineRowPairScanRemaining_pack, machineListTail_cons, + machineRowPairScanSource_pack, machineRowPairNextFound, + machineRowPairScanFound_pack, machineRowPairCandidateBit_encode, + machineOrBit_one] + have hbound : 1 ≤ (machineRowPairInputBound + (certifiedRowPairMachineInput X R C r s)).length := + machineRowPair_one_le_bound _ + rw [(List.take_eq_self_iff _).2 (by simpa using hbound), + machineRowPairSemanticState] + apply congrArg (fun z : Bool ↦ + machineRowPairScanPack + (binaryListCode finUnaryCode ((List.finRange n).drop (k + 1))) [z] + (certifiedRowPairMachineInput X R C r s)) + rw [outerScanFound, outerScanFound, + ← List.take_concat_get hklen, List.concat_eq_append, List.any_append] + simp + +theorem machineRowPairScanIterate_semantics {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℚ) + (r s : Fin n) (k : ℕ) (hk : k ≤ n) : + (machineRowPairScanStep)^[k] (machineRowPairScanInit + (certifiedRowPairMachineInput X R C r s)) = + machineRowPairSemanticState X R C r s k := by + induction k with + | zero => exact (machineRowPairSemanticState_zero X R C r s).symm + | succ k ih => + rw [Function.iterate_succ_apply', ih (by omega), + machineRowPairSemanticState_step X R C r s k (by omega)] + +@[simp] theorem machineCertifiedRowPairEligibilityBit_rows_encode {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℚ) + (r s : Fin n) : + machineCertifiedRowPairEligibilityBit + (certifiedRowPairMachineInput X R C r s) = + [certifiedRowPairEligibilityTest X r s] := by + rw [machineCertifiedRowPairEligibilityBit, machineRowPairScanFinalState, + machineRowPairDimensionRuler_encode, List.length_replicate, + machineRowPairScanIterate_semantics X R C r s n le_rfl, + machineRowPairSemanticState, machineRowPairScanFound_pack, outerScanFound, + (List.take_eq_self_iff _).2 (by simp)] + rfl + +theorem certifiedRowPairEligibilityTest_eq_true_iff {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) (r s : Fin n) : + certifiedRowPairEligibilityTest X r s = true ↔ + ∃ a b : Fin n, a ≠ b ∧ + directedFourCoreCostUpper (explicitRegularizationScale n) X r s a b + (directedPairCostPrecision n) ≤ explicitKappa := by + rw [certifiedRowPairEligibilityTest, List.any_eq_true] + constructor + · rintro ⟨a, ha, hinner⟩ + rw [certifiedFirstColumnTest, List.any_eq_true] at hinner + obtain ⟨b, hb, htest⟩ := hinner + refine ⟨a, b, ?_⟩ + simpa only [certifiedColumnPairTest, decide_eq_true_eq] using htest + · rintro ⟨a, b, hab, hcost⟩ + refine ⟨a, by simp, ?_⟩ + rw [certifiedFirstColumnTest, List.any_eq_true] + refine ⟨b, by simp, ?_⟩ + simp [certifiedColumnPairTest, hab, hcost] + +def certifiedRowPairEligibilityMachineInput {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℚ) + (q : RowPair n) : List Bool := + certifiedRowPairMachineInput X R C (rowPairRow q 0) (rowPairRow q 1) + +@[simp] theorem machineCertifiedRowPairEligibilityBit_encode {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℚ) + (q : RowPair n) : + machineCertifiedRowPairEligibilityBit + (certifiedRowPairEligibilityMachineInput X R C q) = + [decide (HasCertifiedCorePair (explicitRegularizationScale n) X + explicitKappa (directedPairCostPrecision n) q)] := by + rw [certifiedRowPairEligibilityMachineInput, + machineCertifiedRowPairEligibilityBit_rows_encode] + apply congrArg List.singleton + apply (Bool.eq_iff_iff).2 + rw [certifiedRowPairEligibilityTest_eq_true_iff, decide_eq_true_eq] + rfl + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineCompletedAlgorithm.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineCompletedAlgorithm.lean new file mode 100644 index 0000000000..7b6113b600 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineCompletedAlgorithm.lean @@ -0,0 +1,455 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineFinalScalars +import LeanPool.BeyondBethe.BeyondBethe.MachinePerfectMatching +import LeanPool.BeyondBethe.BeyondBethe.MachineSmoothedMatrix +import LeanPool.BeyondBethe.BeyondBethe.ExplicitScales + +/-! +# Finite-word outer wrapper for the completed permanent algorithm + +This module closes every branch and final scalar operation in +`completedAlgorithm`. It is parameterized by one internal machine for the +positive-matrix routine. That internal machine returns an unreduced rational +word, allowing the verified rational arithmetic layer to consume its result. +The executable development later supplies this parameter with the concrete +regularized-Bethe optimizer and certificate machine. +-/ + +namespace BeyondBethe + +open Complexity + +/-- Internal realization relation for a rational-matrix algorithm whose +machine output is a raw numerator/denominator pair rather than the public +one-natural rational encoding. -/ +def RawStringRealizes + (F : List Bool → List Bool) + (alg : ∀ n, Matrix (Fin n) (Fin n) ℚ → ℚ) : Prop := + ∀ x : RationalMatrixInput, + F (rationalMatrixBinaryEncoding.encode x) = + rawRatBinaryCode (rawRatOfRat (bundledAlgorithm alg x)) + +/-- Correctness relation needed of an internal positive-matrix routine. The +outer smoothing wrapper calls it only on strictly positive matrices, so no +semantic requirement is imposed on its totalized behavior elsewhere. -/ +def PositiveRawStringRealizes + (F : List Bool → List Bool) + (alg : ∀ n, Matrix (Fin n) (Fin n) ℚ → ℚ) : Prop := + ∀ (n : ℕ) (A : Matrix (Fin n) (Fin n) ℚ), + Matrix.Positive (fun i j ↦ (A i j : ℝ)) → + F (rationalMatrixBinaryEncoding.encode ⟨n, A⟩) = + rawRatBinaryCode (rawRatOfRat (alg n A)) + +def machineCompletedDimensionLtTwoBit (word : List Bool) : List Bool := + machineBinaryNatLtBit + (pair (machineMatrixDimensionWord word) (2 : ℕ).bits) + +def machineCompletedSmoothedMatrixCode (χ : ℚ) + (word : List Bool) : List Bool := + machineSmoothedMatrixCode + (pair (rawRatBinaryCode (rawRatOfRat χ)) word) + +def machineCompletedPositiveRawCode + (positiveMachine : List Bool → List Bool) (χ : ℚ) + (word : List Bool) : List Bool := + positiveMachine (machineCompletedSmoothedMatrixCode χ word) + +def machineCompletedDimensionRawCode (χ : ℚ) + (word : List Bool) : List Bool := + machineSmoothingDimensionRawCode + (pair (rawRatBinaryCode (rawRatOfRat χ)) word) + +def machineCompletedChiTimesDimensionRawCode (χ : ℚ) + (word : List Bool) : List Bool := + machineRawRatMulCode + (pair (rawRatBinaryCode (rawRatOfRat χ)) + (machineCompletedDimensionRawCode χ word)) + +def machineCompletedHalfChiDimensionRawCode (χ : ℚ) + (word : List Bool) : List Bool := + machineRawRatDivCode + (pair (machineCompletedChiTimesDimensionRawCode χ word) + (rawRatBinaryCode (RawRat.ofNat 2))) + +def machineCompletedCorrectionRawCode (χ : ℚ) + (word : List Bool) : List Bool := + machineRawRatAddCode + (pair (rawRatBinaryCode RawRat.one) + (machineCompletedHalfChiDimensionRawCode χ word)) + +def machineCompletedLargeNumeratorRawCode + (positiveMachine : List Bool → List Bool) (χ : ℚ) + (word : List Bool) : List Bool := + machineRawRatMulCode + (pair (machineMatrixNormalizationScalePowerRawCode word) + (machineCompletedPositiveRawCode positiveMachine χ word)) + +def machineCompletedLargeRawCode + (positiveMachine : List Bool → List Bool) (χ : ℚ) + (word : List Bool) : List Bool := + machineRawRatDivCode + (pair (machineCompletedLargeNumeratorRawCode positiveMachine χ word) + (machineCompletedCorrectionRawCode χ word)) + +def machineCompletedLargeCode + (positiveMachine : List Bool → List Bool) (χ : ℚ) + (word : List Bool) : List Bool := + machineNormalizeRawRatBinaryCode + (machineCompletedLargeRawCode positiveMachine χ word) + +def machineCompletedMatchingBranchCode + (positiveMachine : List Bool → List Bool) (χ : ℚ) + (word : List Bool) : List Bool := + machineIfHead (machineKuhnPerfectMatchingBit word) + (machineCompletedLargeCode positiveMachine χ word) + (rationalBinaryCode 0) + +def machineCompletedNonnegativeBranchCode + (positiveMachine : List Bool → List Bool) (χ : ℚ) + (word : List Bool) : List Bool := + machineIfHead (machineCompletedDimensionLtTwoBit word) + (machineSmallDimensionPermanentCode word) + (machineCompletedMatchingBranchCode positiveMachine χ word) + +def machineCompletedAlgorithmCode + (positiveMachine : List Bool → List Bool) (χ : ℚ) + (word : List Bool) : List Bool := + machineIfHead (machineMatrixNonnegativeBit word) + (machineCompletedNonnegativeBranchCode positiveMachine χ word) + (rationalBinaryCode 0) + +theorem machineCompletedDimensionLtTwoBit_mem_FP : + machineCompletedDimensionLtTwoBit ∈ Complexity.FP := by + have hpair := machinePair_mem_FP machineMatrixDimensionWord_mem_FP + (machineConst_mem_FP (2 : ℕ).bits) + simpa only [machineCompletedDimensionLtTwoBit] using + machineCompose_mem_FP hpair machineBinaryNatLtBit_mem_FP + +theorem machineCompletedSmoothedMatrixCode_mem_FP (χ : ℚ) : + machineCompletedSmoothedMatrixCode χ ∈ Complexity.FP := by + have hpair := machinePair_mem_FP + (machineConst_mem_FP (rawRatBinaryCode (rawRatOfRat χ))) id_mem_FP + simpa only [machineCompletedSmoothedMatrixCode] using + machineCompose_mem_FP hpair machineSmoothedMatrixCode_mem_FP + +theorem machineCompletedPositiveRawCode_mem_FP + {positiveMachine : List Bool → List Bool} + (hpositive : positiveMachine ∈ Complexity.FP) (χ : ℚ) : + machineCompletedPositiveRawCode positiveMachine χ ∈ Complexity.FP := by + simpa only [machineCompletedPositiveRawCode] using + machineCompose_mem_FP (machineCompletedSmoothedMatrixCode_mem_FP χ) + hpositive + +theorem machineCompletedDimensionRawCode_mem_FP (χ : ℚ) : + machineCompletedDimensionRawCode χ ∈ Complexity.FP := by + have hpair := machinePair_mem_FP + (machineConst_mem_FP (rawRatBinaryCode (rawRatOfRat χ))) id_mem_FP + simpa only [machineCompletedDimensionRawCode] using + machineCompose_mem_FP hpair machineSmoothingDimensionRawCode_mem_FP + +theorem machineCompletedChiTimesDimensionRawCode_mem_FP (χ : ℚ) : + machineCompletedChiTimesDimensionRawCode χ ∈ Complexity.FP := by + have hpair := machinePair_mem_FP + (machineConst_mem_FP (rawRatBinaryCode (rawRatOfRat χ))) + (machineCompletedDimensionRawCode_mem_FP χ) + simpa only [machineCompletedChiTimesDimensionRawCode] using + machineCompose_mem_FP hpair machineRawRatMulCode_mem_FP + +theorem machineCompletedHalfChiDimensionRawCode_mem_FP (χ : ℚ) : + machineCompletedHalfChiDimensionRawCode χ ∈ Complexity.FP := by + have hpair := machinePair_mem_FP + (machineCompletedChiTimesDimensionRawCode_mem_FP χ) + (machineConst_mem_FP (rawRatBinaryCode (RawRat.ofNat 2))) + simpa only [machineCompletedHalfChiDimensionRawCode] using + machineCompose_mem_FP hpair machineRawRatDivCode_mem_FP + +theorem machineCompletedCorrectionRawCode_mem_FP (χ : ℚ) : + machineCompletedCorrectionRawCode χ ∈ Complexity.FP := by + have hpair := machinePair_mem_FP + (machineConst_mem_FP (rawRatBinaryCode RawRat.one)) + (machineCompletedHalfChiDimensionRawCode_mem_FP χ) + simpa only [machineCompletedCorrectionRawCode] using + machineCompose_mem_FP hpair machineRawRatAddCode_mem_FP + +theorem machineCompletedLargeNumeratorRawCode_mem_FP + {positiveMachine : List Bool → List Bool} + (hpositive : positiveMachine ∈ Complexity.FP) (χ : ℚ) : + machineCompletedLargeNumeratorRawCode positiveMachine χ ∈ + Complexity.FP := by + have hpair := machinePair_mem_FP + machineMatrixNormalizationScalePowerRawCode_mem_FP + (machineCompletedPositiveRawCode_mem_FP hpositive χ) + simpa only [machineCompletedLargeNumeratorRawCode] using + machineCompose_mem_FP hpair machineRawRatMulCode_mem_FP + +theorem machineCompletedLargeRawCode_mem_FP + {positiveMachine : List Bool → List Bool} + (hpositive : positiveMachine ∈ Complexity.FP) (χ : ℚ) : + machineCompletedLargeRawCode positiveMachine χ ∈ Complexity.FP := by + have hpair := machinePair_mem_FP + (machineCompletedLargeNumeratorRawCode_mem_FP hpositive χ) + (machineCompletedCorrectionRawCode_mem_FP χ) + simpa only [machineCompletedLargeRawCode] using + machineCompose_mem_FP hpair machineRawRatDivCode_mem_FP + +theorem machineCompletedLargeCode_mem_FP + {positiveMachine : List Bool → List Bool} + (hpositive : positiveMachine ∈ Complexity.FP) (χ : ℚ) : + machineCompletedLargeCode positiveMachine χ ∈ Complexity.FP := by + simpa only [machineCompletedLargeCode] using + machineCompose_mem_FP + (machineCompletedLargeRawCode_mem_FP hpositive χ) + machineNormalizeRawRatBinaryCode_mem_FP + +theorem machineCompletedMatchingBranchCode_mem_FP + {positiveMachine : List Bool → List Bool} + (hpositive : positiveMachine ∈ Complexity.FP) (χ : ℚ) : + machineCompletedMatchingBranchCode positiveMachine χ ∈ Complexity.FP := by + exact machineIfHead_mem_FP machineKuhnPerfectMatchingBit_mem_FP + (machineCompletedLargeCode_mem_FP hpositive χ) + (machineConst_mem_FP (rationalBinaryCode 0)) + +theorem machineCompletedNonnegativeBranchCode_mem_FP + {positiveMachine : List Bool → List Bool} + (hpositive : positiveMachine ∈ Complexity.FP) (χ : ℚ) : + machineCompletedNonnegativeBranchCode positiveMachine χ ∈ + Complexity.FP := by + exact machineIfHead_mem_FP machineCompletedDimensionLtTwoBit_mem_FP + machineSmallDimensionPermanentCode_mem_FP + (machineCompletedMatchingBranchCode_mem_FP hpositive χ) + +theorem machineCompletedAlgorithmCode_mem_FP + {positiveMachine : List Bool → List Bool} + (hpositive : positiveMachine ∈ Complexity.FP) (χ : ℚ) : + machineCompletedAlgorithmCode positiveMachine χ ∈ Complexity.FP := by + exact machineIfHead_mem_FP machineMatrixNonnegativeBit_mem_FP + (machineCompletedNonnegativeBranchCode_mem_FP hpositive χ) + (machineConst_mem_FP (rationalBinaryCode 0)) + +/-! ## Exact semantics -/ + +@[simp] theorem machineCompletedDimensionLtTwoBit_encode {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) : + machineCompletedDimensionLtTwoBit + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩) = + [decide (n < 2)] := by + rw [machineCompletedDimensionLtTwoBit, + machineMatrixDimensionWord_encode, + machineBinaryNatLtBit_pair_natBits] + +@[simp] theorem machineCompletedCorrectionRawCode_encode {n : ℕ} + (χ : ℚ) (A : Matrix (Fin n) (Fin n) ℚ) : + machineCompletedCorrectionRawCode χ + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩) = + rawRatBinaryCode + (RawRat.one.add + (((rawRatOfRat χ).mul (RawRat.ofNat n)).div + (RawRat.ofNat 2))) := by + simp only [machineCompletedCorrectionRawCode, + machineCompletedHalfChiDimensionRawCode, + machineCompletedChiTimesDimensionRawCode, + machineCompletedDimensionRawCode] + rw [machineSmoothingDimensionRawCode_encode A (rawRatOfRat χ), + machineRawRatMulCode_encode, machineRawRatDivCode_encode, + machineRawRatAddCode_encode] + +theorem machineKuhnPerfectMatchingBit_finalDecision {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) : + machineKuhnPerfectMatchingBit + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩) = + [kuhnSupportMatchingDecision A] := by + rw [machineKuhnPerfectMatchingBit_encode] + apply congrArg singleton + apply Bool.eq_iff_iff.mpr + rw [kuhnColumnMate_all_isSome_eq_true_iff, + kuhnSupportMatchingDecision_eq_true_iff] + +theorem machineCompletedLargeCode_encode + {positiveMachine : List Bool → List Bool} + {positiveAlg : ∀ n, Matrix (Fin n) (Fin n) ℚ → ℚ} + (hrealizes : RawStringRealizes positiveMachine positiveAlg) + (χ : ℚ) {n : ℕ} (A : Matrix (Fin n) (Fin n) ℚ) : + machineCompletedLargeCode positiveMachine χ + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩) = + rationalBinaryCode + (rationalNormalizationScale A ^ n * + positiveAlg n (smoothedRationalMatrix A χ) / + (1 + χ * n / 2)) := by + have hpositive := hrealizes + ⟨n, smoothedRationalMatrix A χ⟩ + change positiveMachine + (rationalMatrixBinaryEncoding.encode + ⟨n, smoothedRationalMatrix A χ⟩) = + rawRatBinaryCode + (rawRatOfRat (positiveAlg n (smoothedRationalMatrix A χ))) at hpositive + simp only [machineCompletedLargeCode, + machineCompletedLargeRawCode, + machineCompletedLargeNumeratorRawCode, + machineCompletedPositiveRawCode, + machineCompletedSmoothedMatrixCode, + machineSmoothedMatrixCode_rational, + hpositive, + machineMatrixNormalizationScalePowerRawCode_encode, + machineCompletedCorrectionRawCode_encode, + machineRawRatMulCode_encode, machineRawRatDivCode_encode, + machineNormalizeRawRatBinaryCode_encode, + binaryNormalizeRawRat_eq_value, RawRat.value_div, RawRat.value_pow, + RawRat.value_mul, RawRat.value_add, RawRat.value_one, + RawRat.value_ofNat, rawRatOfRat_value, + rawRatRowsSum_value, RawRat.value_zero, zero_add, + rationalMatrixRows_sum, rationalNormalizationScale] + congr 1 + +/-- The large branch only invokes the internal routine on the strictly +positive smoothed matrix. This version records precisely that domain instead +of requiring arbitrary behavior from the internal machine away from it. -/ +theorem machineCompletedLargeCode_encode_onPositive + {positiveMachine : List Bool → List Bool} + {positiveAlg : ∀ n, Matrix (Fin n) (Fin n) ℚ → ℚ} + (hrealizes : PositiveRawStringRealizes positiveMachine positiveAlg) + (χ : ℚ) (hχ : 0 < (χ : ℝ)) {n : ℕ} (hn : 0 < n) + (A : Matrix (Fin n) (Fin n) ℚ) (hA : Matrix.Nonnegative A) : + machineCompletedLargeCode positiveMachine χ + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩) = + rationalBinaryCode + (rationalNormalizationScale A ^ n * + positiveAlg n (smoothedRationalMatrix A χ) / + (1 + χ * n / 2)) := by + have hpositive := hrealizes n (smoothedRationalMatrix A χ) + (cast_smoothedRationalMatrix_positive hn A hA χ hχ) + simp only [machineCompletedLargeCode, + machineCompletedLargeRawCode, + machineCompletedLargeNumeratorRawCode, + machineCompletedPositiveRawCode, + machineCompletedSmoothedMatrixCode, + machineSmoothedMatrixCode_rational, + hpositive, + machineMatrixNormalizationScalePowerRawCode_encode, + machineCompletedCorrectionRawCode_encode, + machineRawRatMulCode_encode, machineRawRatDivCode_encode, + machineNormalizeRawRatBinaryCode_encode, + binaryNormalizeRawRat_eq_value, RawRat.value_div, RawRat.value_pow, + RawRat.value_mul, RawRat.value_add, RawRat.value_one, + RawRat.value_ofNat, rawRatOfRat_value, + rawRatRowsSum_value, RawRat.value_zero, zero_add, + rationalMatrixRows_sum, rationalNormalizationScale] + congr 1 + +theorem machineCompletedAlgorithmCode_encode + {ε : ℝ} (routine : CertifiedPositiveRoutine ε) + {positiveMachine : List Bool → List Bool} + (hrealizes : RawStringRealizes positiveMachine routine.alg) + (χ : ℚ) {n : ℕ} (A : Matrix (Fin n) (Fin n) ℚ) : + machineCompletedAlgorithmCode positiveMachine χ + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩) = + rationalBinaryCode (completedAlgorithm routine χ n A) := by + rw [machineCompletedAlgorithmCode, + machineMatrixNonnegativeBit_finalDecision] + by_cases hnonnegative : rationalMatrixNonnegativeDecision A = true + · rw [show [rationalMatrixNonnegativeDecision A] = [true] by simp [hnonnegative], + machineIfHead_true] + rw [machineCompletedNonnegativeBranchCode, + machineCompletedDimensionLtTwoBit_encode] + by_cases hsmall : n < 2 + · rw [show [decide (n < 2)] = [true] by simp [hsmall], + machineIfHead_true, + machineSmallDimensionPermanentCode_encode hsmall] + simp [completedAlgorithm, hnonnegative, hsmall] + · rw [show [decide (n < 2)] = [false] by simp [hsmall], + machineIfHead_false, + machineCompletedMatchingBranchCode, + machineKuhnPerfectMatchingBit_finalDecision] + by_cases hmatching : kuhnSupportMatchingDecision A = true + · rw [show [kuhnSupportMatchingDecision A] = [true] by simp [hmatching], + machineIfHead_true, + machineCompletedLargeCode_encode hrealizes] + simp [completedAlgorithm, hnonnegative, hsmall, hmatching] + · rw [show [kuhnSupportMatchingDecision A] = [false] by + simp [Bool.eq_false_iff.mpr hmatching], + machineIfHead_false] + simp [completedAlgorithm, hnonnegative, hsmall, hmatching] + · rw [show [rationalMatrixNonnegativeDecision A] = [false] by + simp [Bool.eq_false_iff.mpr hnonnegative], + machineIfHead_false] + simp [completedAlgorithm, hnonnegative] + +/-- Exact semantics of the total outer machine from correctness of its +internal routine only on positive matrices. Positivity is discharged by the +verified smoothing step at the unique call site. -/ +theorem machineCompletedAlgorithmCode_encode_onPositive + {ε : ℝ} (routine : CertifiedPositiveRoutine ε) + {positiveMachine : List Bool → List Bool} + (hrealizes : PositiveRawStringRealizes positiveMachine routine.alg) + (χ : ℚ) (hχ : 0 < (χ : ℝ)) {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) : + machineCompletedAlgorithmCode positiveMachine χ + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩) = + rationalBinaryCode (completedAlgorithm routine χ n A) := by + rw [machineCompletedAlgorithmCode, + machineMatrixNonnegativeBit_finalDecision] + by_cases hnonnegative : rationalMatrixNonnegativeDecision A = true + · have hA : Matrix.Nonnegative A := + (rationalMatrixNonnegativeDecision_eq_true_iff A).1 hnonnegative + rw [show [rationalMatrixNonnegativeDecision A] = [true] by simp [hnonnegative], + machineIfHead_true] + rw [machineCompletedNonnegativeBranchCode, + machineCompletedDimensionLtTwoBit_encode] + by_cases hsmall : n < 2 + · rw [show [decide (n < 2)] = [true] by simp [hsmall], + machineIfHead_true, + machineSmallDimensionPermanentCode_encode hsmall] + simp [completedAlgorithm, hnonnegative, hsmall] + · have hn : 0 < n := by omega + rw [show [decide (n < 2)] = [false] by simp [hsmall], + machineIfHead_false, + machineCompletedMatchingBranchCode, + machineKuhnPerfectMatchingBit_finalDecision] + by_cases hmatching : kuhnSupportMatchingDecision A = true + · rw [show [kuhnSupportMatchingDecision A] = [true] by simp [hmatching], + machineIfHead_true, + machineCompletedLargeCode_encode_onPositive hrealizes χ hχ hn A hA] + simp [completedAlgorithm, hnonnegative, hsmall, hmatching] + · rw [show [kuhnSupportMatchingDecision A] = [false] by + simp [Bool.eq_false_iff.mpr hmatching], + machineIfHead_false] + simp [completedAlgorithm, hnonnegative, hsmall, hmatching] + · rw [show [rationalMatrixNonnegativeDecision A] = [false] by + simp [Bool.eq_false_iff.mpr hnonnegative], + machineIfHead_false] + simp [completedAlgorithm, hnonnegative] + +theorem completedAlgorithm_runsInPolynomialTime_of_rawMachine + {ε : ℝ} (routine : CertifiedPositiveRoutine ε) + {positiveMachine : List Bool → List Bool} + (hpositiveFP : positiveMachine ∈ Complexity.FP) + (hrealizes : RawStringRealizes positiveMachine routine.alg) + (χ : ℚ) : + RunsInPolynomialTime (completedAlgorithm routine χ) := by + refine ⟨machineCompletedAlgorithmCode positiveMachine χ, + machineCompletedAlgorithmCode_mem_FP hpositiveFP χ, ?_⟩ + intro x + obtain ⟨n, A⟩ := x + exact machineCompletedAlgorithmCode_encode routine hrealizes χ A + +/-- Polynomial time of the completed algorithm from a total polynomial-time +internal machine whose semantic contract is restricted to positive inputs. -/ +theorem completedAlgorithm_runsInPolynomialTime_of_positive_rawMachine + {ε : ℝ} (routine : CertifiedPositiveRoutine ε) + {positiveMachine : List Bool → List Bool} + (hpositiveFP : positiveMachine ∈ Complexity.FP) + (hrealizes : PositiveRawStringRealizes positiveMachine routine.alg) + (χ : ℚ) (hχ : 0 < (χ : ℝ)) : + RunsInPolynomialTime (completedAlgorithm routine χ) := by + refine ⟨machineCompletedAlgorithmCode positiveMachine χ, + machineCompletedAlgorithmCode_mem_FP hpositiveFP χ, ?_⟩ + intro x + obtain ⟨n, A⟩ := x + exact machineCompletedAlgorithmCode_encode_onPositive + routine hrealizes χ hχ A + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedAffineGradientEntry.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedAffineGradientEntry.lean new file mode 100644 index 0000000000..e72c718282 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedAffineGradientEntry.lean @@ -0,0 +1,359 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineDirectedNegativeGradientEntry + +/-! +# Finite-word entries of the directed affine gradient + +For an upper-left base coordinate `(a,b)`, the affine pullback is the signed +four-corner combination + +`G(a,b) - G(a,last) - G(last,b) + G(last,last)`. + +This file evaluates those four full-gradient entries with the common verified +entry machine and performs the three exact rational operations explicitly. +-/ + +namespace BeyondBethe + +open Complexity + +def machineDirectedAffineGradientEntryRow + (word : List Bool) : List Bool := machinePairFirst word + +def machineDirectedAffineGradientEntryRest + (word : List Bool) : List Bool := machinePairSecond word + +def machineDirectedAffineGradientEntryColumn + (word : List Bool) : List Bool := + machinePairFirst (machineDirectedAffineGradientEntryRest word) + +def machineDirectedAffineGradientEntryPayload + (word : List Bool) : List Bool := + machinePairSecond (machineDirectedAffineGradientEntryRest word) + +def machineDirectedAffineGradientEntryDimension + (word : List Bool) : List Bool := + machineDirectedObjectiveSumDimension + (machineDirectedAffineGradientEntryPayload word) + +def machineDirectedAffineGradientUpperLeftInput + (word : List Bool) : List Bool := word + +def machineDirectedAffineGradientUpperRightInput + (word : List Bool) : List Bool := + pair (machineDirectedAffineGradientEntryRow word) + (pair (machineDirectedAffineGradientEntryDimension word) + (machineDirectedAffineGradientEntryPayload word)) + +def machineDirectedAffineGradientLowerLeftInput + (word : List Bool) : List Bool := + pair (machineDirectedAffineGradientEntryDimension word) + (pair (machineDirectedAffineGradientEntryColumn word) + (machineDirectedAffineGradientEntryPayload word)) + +def machineDirectedAffineGradientLowerRightInput + (word : List Bool) : List Bool := + pair (machineDirectedAffineGradientEntryDimension word) + (pair (machineDirectedAffineGradientEntryDimension word) + (machineDirectedAffineGradientEntryPayload word)) + +def machineDirectedAffineGradientUpperLeftRaw + (word : List Bool) : List Bool := + machineDirectedNegativeGradientEntryRawCode + (machineDirectedAffineGradientUpperLeftInput word) + +def machineDirectedAffineGradientUpperRightRaw + (word : List Bool) : List Bool := + machineDirectedNegativeGradientEntryRawCode + (machineDirectedAffineGradientUpperRightInput word) + +def machineDirectedAffineGradientLowerLeftRaw + (word : List Bool) : List Bool := + machineDirectedNegativeGradientEntryRawCode + (machineDirectedAffineGradientLowerLeftInput word) + +def machineDirectedAffineGradientLowerRightRaw + (word : List Bool) : List Bool := + machineDirectedNegativeGradientEntryRawCode + (machineDirectedAffineGradientLowerRightInput word) + +def machineDirectedAffineGradientFirstDifference + (word : List Bool) : List Bool := + machineRawRatSubCode + (pair (machineDirectedAffineGradientUpperLeftRaw word) + (machineDirectedAffineGradientUpperRightRaw word)) + +def machineDirectedAffineGradientSecondDifference + (word : List Bool) : List Bool := + machineRawRatSubCode + (pair (machineDirectedAffineGradientFirstDifference word) + (machineDirectedAffineGradientLowerLeftRaw word)) + +def machineDirectedAffineGradientEntryRawCode + (word : List Bool) : List Bool := + machineRawRatAddCode + (pair (machineDirectedAffineGradientSecondDifference word) + (machineDirectedAffineGradientLowerRightRaw word)) + +theorem machineDirectedAffineGradientEntryRow_mem_FP : + machineDirectedAffineGradientEntryRow ∈ FP := machinePairFirst_mem_FP + +theorem machineDirectedAffineGradientEntryRest_mem_FP : + machineDirectedAffineGradientEntryRest ∈ FP := machinePairSecond_mem_FP + +theorem machineDirectedAffineGradientEntryColumn_mem_FP : + machineDirectedAffineGradientEntryColumn ∈ FP := by + simpa only [machineDirectedAffineGradientEntryColumn] using + machineCompose_mem_FP machineDirectedAffineGradientEntryRest_mem_FP + machinePairFirst_mem_FP + +theorem machineDirectedAffineGradientEntryPayload_mem_FP : + machineDirectedAffineGradientEntryPayload ∈ FP := by + simpa only [machineDirectedAffineGradientEntryPayload] using + machineCompose_mem_FP machineDirectedAffineGradientEntryRest_mem_FP + machinePairSecond_mem_FP + +theorem machineDirectedAffineGradientEntryDimension_mem_FP : + machineDirectedAffineGradientEntryDimension ∈ FP := by + simpa only [machineDirectedAffineGradientEntryDimension] using + machineCompose_mem_FP machineDirectedAffineGradientEntryPayload_mem_FP + machineDirectedObjectiveSumDimension_mem_FP + +theorem machineDirectedAffineGradientUpperLeftInput_mem_FP : + machineDirectedAffineGradientUpperLeftInput ∈ FP := by + simpa only [machineDirectedAffineGradientUpperLeftInput] using + (Complexity.id_mem_FP : (fun x : List Bool => x) ∈ FP) + +theorem machineDirectedAffineGradientUpperRightInput_mem_FP : + machineDirectedAffineGradientUpperRightInput ∈ FP := + machinePair_mem_FP machineDirectedAffineGradientEntryRow_mem_FP + (machinePair_mem_FP machineDirectedAffineGradientEntryDimension_mem_FP + machineDirectedAffineGradientEntryPayload_mem_FP) + +theorem machineDirectedAffineGradientLowerLeftInput_mem_FP : + machineDirectedAffineGradientLowerLeftInput ∈ FP := + machinePair_mem_FP machineDirectedAffineGradientEntryDimension_mem_FP + (machinePair_mem_FP machineDirectedAffineGradientEntryColumn_mem_FP + machineDirectedAffineGradientEntryPayload_mem_FP) + +theorem machineDirectedAffineGradientLowerRightInput_mem_FP : + machineDirectedAffineGradientLowerRightInput ∈ FP := + machinePair_mem_FP machineDirectedAffineGradientEntryDimension_mem_FP + (machinePair_mem_FP machineDirectedAffineGradientEntryDimension_mem_FP + machineDirectedAffineGradientEntryPayload_mem_FP) + +theorem machineDirectedAffineGradientUpperLeftRaw_mem_FP : + machineDirectedAffineGradientUpperLeftRaw ∈ FP := by + simpa only [machineDirectedAffineGradientUpperLeftRaw] using + machineCompose_mem_FP machineDirectedAffineGradientUpperLeftInput_mem_FP + machineDirectedNegativeGradientEntryRawCode_mem_FP + +theorem machineDirectedAffineGradientUpperRightRaw_mem_FP : + machineDirectedAffineGradientUpperRightRaw ∈ FP := by + simpa only [machineDirectedAffineGradientUpperRightRaw] using + machineCompose_mem_FP machineDirectedAffineGradientUpperRightInput_mem_FP + machineDirectedNegativeGradientEntryRawCode_mem_FP + +theorem machineDirectedAffineGradientLowerLeftRaw_mem_FP : + machineDirectedAffineGradientLowerLeftRaw ∈ FP := by + simpa only [machineDirectedAffineGradientLowerLeftRaw] using + machineCompose_mem_FP machineDirectedAffineGradientLowerLeftInput_mem_FP + machineDirectedNegativeGradientEntryRawCode_mem_FP + +theorem machineDirectedAffineGradientLowerRightRaw_mem_FP : + machineDirectedAffineGradientLowerRightRaw ∈ FP := by + simpa only [machineDirectedAffineGradientLowerRightRaw] using + machineCompose_mem_FP machineDirectedAffineGradientLowerRightInput_mem_FP + machineDirectedNegativeGradientEntryRawCode_mem_FP + +theorem machineDirectedAffineGradientFirstDifference_mem_FP : + machineDirectedAffineGradientFirstDifference ∈ FP := by + have hinput := machinePair_mem_FP + machineDirectedAffineGradientUpperLeftRaw_mem_FP + machineDirectedAffineGradientUpperRightRaw_mem_FP + simpa only [machineDirectedAffineGradientFirstDifference] using + machineCompose_mem_FP hinput machineRawRatSubCode_mem_FP + +theorem machineDirectedAffineGradientSecondDifference_mem_FP : + machineDirectedAffineGradientSecondDifference ∈ FP := by + have hinput := machinePair_mem_FP + machineDirectedAffineGradientFirstDifference_mem_FP + machineDirectedAffineGradientLowerLeftRaw_mem_FP + simpa only [machineDirectedAffineGradientSecondDifference] using + machineCompose_mem_FP hinput machineRawRatSubCode_mem_FP + +theorem machineDirectedAffineGradientEntryRawCode_mem_FP : + machineDirectedAffineGradientEntryRawCode ∈ FP := by + have hinput := machinePair_mem_FP + machineDirectedAffineGradientSecondDifference_mem_FP + machineDirectedAffineGradientLowerRightRaw_mem_FP + simpa only [machineDirectedAffineGradientEntryRawCode] using + machineCompose_mem_FP hinput machineRawRatAddCode_mem_FP + +def machineDirectedAffineGradientEntryCanonicalWord {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p : ℕ) (a b : Fin m) : List Bool := + pair (List.replicate a.1 true) + (pair (List.replicate b.1 true) + (machineDirectedObjectiveSumCanonicalWord tau A y p)) + +def rawDirectedAffineGradientEntry {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p : ℕ) (a b : Fin m) : RawRat := + let G := fun i j => rawDirectedNegativeGradientLower tau (A i j) + (betheAffineMatrixQ y i j) p + ((G a.castSucc b.castSucc).sub (G a.castSucc (Fin.last m))).sub + (G (Fin.last m) b.castSucc) |>.add + (G (Fin.last m) (Fin.last m)) + +@[simp] theorem machineDirectedAffineGradientEntryDimension_encode {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p : ℕ) (a b : Fin m) : + machineDirectedAffineGradientEntryDimension + (machineDirectedAffineGradientEntryCanonicalWord tau A y p a b) = + List.replicate m true := by + simp [machineDirectedAffineGradientEntryDimension, + machineDirectedAffineGradientEntryPayload, + machineDirectedAffineGradientEntryRest, + machineDirectedAffineGradientEntryCanonicalWord] + +@[simp] theorem machineDirectedAffineGradientUpperLeftInput_encode {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p : ℕ) (a b : Fin m) : + machineDirectedAffineGradientUpperLeftInput + (machineDirectedAffineGradientEntryCanonicalWord tau A y p a b) = + machineDirectedGradientEntryCanonicalWord tau A y p + a.castSucc b.castSucc := by + rfl + +@[simp] theorem machineDirectedAffineGradientUpperRightInput_encode {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p : ℕ) (a b : Fin m) : + machineDirectedAffineGradientUpperRightInput + (machineDirectedAffineGradientEntryCanonicalWord tau A y p a b) = + machineDirectedGradientEntryCanonicalWord tau A y p + a.castSucc (Fin.last m) := by + rw [machineDirectedAffineGradientUpperRightInput, + machineDirectedAffineGradientEntryDimension_encode] + simp [ + machineDirectedAffineGradientEntryRow, + machineDirectedAffineGradientEntryRest, + machineDirectedAffineGradientEntryPayload, + machineDirectedAffineGradientEntryCanonicalWord, + machineDirectedGradientEntryCanonicalWord] + +@[simp] theorem machineDirectedAffineGradientLowerLeftInput_encode {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p : ℕ) (a b : Fin m) : + machineDirectedAffineGradientLowerLeftInput + (machineDirectedAffineGradientEntryCanonicalWord tau A y p a b) = + machineDirectedGradientEntryCanonicalWord tau A y p + (Fin.last m) b.castSucc := by + rw [machineDirectedAffineGradientLowerLeftInput, + machineDirectedAffineGradientEntryDimension_encode] + simp [ + machineDirectedAffineGradientEntryColumn, + machineDirectedAffineGradientEntryRest, + machineDirectedAffineGradientEntryPayload, + machineDirectedAffineGradientEntryCanonicalWord, + machineDirectedGradientEntryCanonicalWord] + +@[simp] theorem machineDirectedAffineGradientLowerRightInput_encode {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p : ℕ) (a b : Fin m) : + machineDirectedAffineGradientLowerRightInput + (machineDirectedAffineGradientEntryCanonicalWord tau A y p a b) = + machineDirectedGradientEntryCanonicalWord tau A y p + (Fin.last m) (Fin.last m) := by + rw [machineDirectedAffineGradientLowerRightInput, + machineDirectedAffineGradientEntryDimension_encode] + simp [ + machineDirectedAffineGradientEntryRest, + machineDirectedAffineGradientEntryPayload, + machineDirectedAffineGradientEntryCanonicalWord, + machineDirectedGradientEntryCanonicalWord] + +@[simp] theorem machineDirectedAffineGradientUpperLeftRaw_encode {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p : ℕ) (a b : Fin m) : + machineDirectedAffineGradientUpperLeftRaw + (machineDirectedAffineGradientEntryCanonicalWord tau A y p a b) = + rawRatBinaryCode + (rawDirectedNegativeGradientLower tau (A a.castSucc b.castSucc) + (betheAffineMatrixQ y a.castSucc b.castSucc) p) := by + rw [machineDirectedAffineGradientUpperLeftRaw, + machineDirectedAffineGradientUpperLeftInput_encode, + machineDirectedNegativeGradientEntryRawCode_encode] + +@[simp] theorem machineDirectedAffineGradientUpperRightRaw_encode {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p : ℕ) (a b : Fin m) : + machineDirectedAffineGradientUpperRightRaw + (machineDirectedAffineGradientEntryCanonicalWord tau A y p a b) = + rawRatBinaryCode + (rawDirectedNegativeGradientLower tau (A a.castSucc (Fin.last m)) + (betheAffineMatrixQ y a.castSucc (Fin.last m)) p) := by + rw [machineDirectedAffineGradientUpperRightRaw, + machineDirectedAffineGradientUpperRightInput_encode, + machineDirectedNegativeGradientEntryRawCode_encode] + +@[simp] theorem machineDirectedAffineGradientLowerLeftRaw_encode {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p : ℕ) (a b : Fin m) : + machineDirectedAffineGradientLowerLeftRaw + (machineDirectedAffineGradientEntryCanonicalWord tau A y p a b) = + rawRatBinaryCode + (rawDirectedNegativeGradientLower tau (A (Fin.last m) b.castSucc) + (betheAffineMatrixQ y (Fin.last m) b.castSucc) p) := by + rw [machineDirectedAffineGradientLowerLeftRaw, + machineDirectedAffineGradientLowerLeftInput_encode, + machineDirectedNegativeGradientEntryRawCode_encode] + +@[simp] theorem machineDirectedAffineGradientLowerRightRaw_encode {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p : ℕ) (a b : Fin m) : + machineDirectedAffineGradientLowerRightRaw + (machineDirectedAffineGradientEntryCanonicalWord tau A y p a b) = + rawRatBinaryCode + (rawDirectedNegativeGradientLower tau (A (Fin.last m) (Fin.last m)) + (betheAffineMatrixQ y (Fin.last m) (Fin.last m)) p) := by + rw [machineDirectedAffineGradientLowerRightRaw, + machineDirectedAffineGradientLowerRightInput_encode, + machineDirectedNegativeGradientEntryRawCode_encode] + +@[simp] theorem machineDirectedAffineGradientEntryRawCode_encode {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p : ℕ) (a b : Fin m) : + machineDirectedAffineGradientEntryRawCode + (machineDirectedAffineGradientEntryCanonicalWord tau A y p a b) = + rawRatBinaryCode (rawDirectedAffineGradientEntry tau A y p a b) := by + simp only [machineDirectedAffineGradientEntryRawCode, + machineDirectedAffineGradientSecondDifference, + machineDirectedAffineGradientFirstDifference, + machineDirectedAffineGradientUpperLeftRaw_encode, + machineDirectedAffineGradientUpperRightRaw_encode, + machineDirectedAffineGradientLowerLeftRaw_encode, + machineDirectedAffineGradientLowerRightRaw_encode] + rw [ + machineRawRatSubCode_encode, machineRawRatSubCode_encode, + machineRawRatAddCode_encode] + rfl + +theorem rawDirectedAffineGradientEntry_value {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p : ℕ) (a b : Fin m) : + (rawDirectedAffineGradientEntry tau A y p a b).value = + affinePullbackGradient + (directedNegativeGradientLowerMatrix tau A + (betheAffineMatrixQ y) p) a b := by + simp [rawDirectedAffineGradientEntry, affinePullbackGradient, + directedNegativeGradientLowerMatrix, + RawRat.value_add, RawRat.value_sub, + rawDirectedNegativeGradientLower_value] + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedAffineGradientVector.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedAffineGradientVector.lean new file mode 100644 index 0000000000..74eaa381c1 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedAffineGradientVector.lean @@ -0,0 +1,374 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineDirectedAffineGradientEntry +import LeanPool.BeyondBethe.BeyondBethe.MachineUnaryGridGenerator + +/-! +# Finite-word directed affine-gradient vectors + +This file instantiates the reusable unary grid generator with the verified +four-corner gradient entry. It also proves an explicit ordinary-binary size +bound for the complete `m^2`-coordinate vector, so the generator's totalizing +accumulator clamp is inactive on every canonical input. +-/ + +namespace BeyondBethe + +open Complexity + +def machineDirectedAffineGradientEntryCode (word : List Bool) : List Bool := + machineNormalizeRawRatEntryCode + (machineDirectedAffineGradientEntryRawCode word) + +theorem machineDirectedAffineGradientEntryCode_mem_FP : + machineDirectedAffineGradientEntryCode ∈ FP := by + simpa only [machineDirectedAffineGradientEntryCode] using + machineCompose_mem_FP machineDirectedAffineGradientEntryRawCode_mem_FP + machineNormalizeRawRatEntryCode_mem_FP + +@[simp] theorem machineDirectedAffineGradientEntryCode_encode {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p : ℕ) (a b : Fin m) : + machineDirectedAffineGradientEntryCode + (machineDirectedAffineGradientEntryCanonicalWord tau A y p a b) = + rationalEntryBinaryCode + (affinePullbackGradient + (directedNegativeGradientLowerMatrix tau A + (betheAffineMatrixQ y) p) a b) := by + rw [machineDirectedAffineGradientEntryCode, + machineDirectedAffineGradientEntryRawCode_encode, + machineNormalizeRawRatEntryCode_encode, + binaryNormalizeRawRat_eq_value, + rawDirectedAffineGradientEntry_value] + +def machineDirectedAffineGradientVectorBound (word : List Bool) : List Bool := + machineIteratedBinaryWidth 6 word + +def machineDirectedAffineGradientVectorGeneratorInput + (word : List Bool) : List Bool := + pair (machineDirectedObjectiveSumDimension word) + (pair (machineDirectedAffineGradientVectorBound word) word) + +def machineDirectedAffineGradientVectorCode (word : List Bool) : List Bool := + machineUnaryGridGeneratorCode machineDirectedAffineGradientEntryCode + (machineDirectedAffineGradientVectorGeneratorInput word) + +theorem machineDirectedAffineGradientVectorBound_mem_FP : + machineDirectedAffineGradientVectorBound ∈ FP := + machineIteratedBinaryWidth_mem_FP 6 + +theorem machineDirectedAffineGradientVectorGeneratorInput_mem_FP : + machineDirectedAffineGradientVectorGeneratorInput ∈ FP := + machinePair_mem_FP machineDirectedObjectiveSumDimension_mem_FP + (machinePair_mem_FP machineDirectedAffineGradientVectorBound_mem_FP + id_mem_FP) + +theorem machineDirectedAffineGradientVectorCode_mem_FP : + machineDirectedAffineGradientVectorCode ∈ FP := by + have hgenerator := machineUnaryGridGeneratorCode_mem_FP + machineDirectedAffineGradientEntryCode_mem_FP + simpa only [machineDirectedAffineGradientVectorCode] using + machineCompose_mem_FP + machineDirectedAffineGradientVectorGeneratorInput_mem_FP hgenerator + +def directedAffineGradientVector {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p : ℕ) : Fin (m * m) → ℚ := + squareMatrixToVector + (affinePullbackGradient + (directedNegativeGradientLowerMatrix tau A + (betheAffineMatrixQ y) p)) + +def rawDirectedGradientCoordinateWidthBudget + (tau a x : ℚ) (p : ℕ) : ℕ := + 2 * rawRatWidth (rawRatOfRat tau) + + rawRatWidth (rawScheduledLogUpper a p) + + rawRatWidth (rawScheduledLogLower x p) + + rawRatWidth (rawScheduledLogLower (1 - x) p) + 9 + +theorem rawDirectedNegativeGradientLower_width_le + (tau a x : ℚ) (p : ℕ) : + rawRatWidth (rawDirectedNegativeGradientLower tau a x p) ≤ + rawDirectedGradientCoordinateWidthBudget tau a x p := by + let rawTau := rawRatOfRat tau + let logA := rawScheduledLogUpper a p + let logX := rawScheduledLogLower x p + let logComplement := rawScheduledLogLower (1 - x) p + have hone : rawRatWidth RawRat.one = 1 := rawRatWidth_one + have honeTau := rawRatWidth_add_le RawRat.one rawTau + rw [hone] at honeTau + have hscaled := rawRatWidth_mul_le (RawRat.one.add rawTau) logX + have hnegA : rawRatWidth logA.neg = rawRatWidth logA := + rawRatWidth_neg logA + have hfirst := rawRatWidth_add_le logA.neg + ((RawRat.one.add rawTau).mul logX) + rw [hnegA] at hfirst + have hthree := rawRatWidth_add_le + (logA.neg.add ((RawRat.one.add rawTau).mul logX)) logComplement + have htwoTauInner := rawRatWidth_add_le RawRat.one rawTau + rw [hone] at htwoTauInner + have htwoTau := rawRatWidth_add_le RawRat.one + (RawRat.one.add rawTau) + rw [hone] at htwoTau + have htotal := rawRatWidth_add_le + ((logA.neg.add ((RawRat.one.add rawTau).mul logX)).add logComplement) + (RawRat.one.add (RawRat.one.add rawTau)) + have honeTau' : rawRatWidth (RawRat.one.add rawTau) ≤ + rawRatWidth rawTau + 2 := by omega + have hscaled' : + rawRatWidth ((RawRat.one.add rawTau).mul logX) ≤ + rawRatWidth rawTau + rawRatWidth logX + 2 := by omega + have hfirst' : + rawRatWidth (logA.neg.add + ((RawRat.one.add rawTau).mul logX)) ≤ + rawRatWidth logA + rawRatWidth rawTau + + rawRatWidth logX + 3 := by omega + have hthree' : + rawRatWidth + ((logA.neg.add ((RawRat.one.add rawTau).mul logX)).add + logComplement) ≤ + rawRatWidth logA + rawRatWidth rawTau + + rawRatWidth logX + rawRatWidth logComplement + 4 := by + omega + have htwoTau' : + rawRatWidth (RawRat.one.add (RawRat.one.add rawTau)) ≤ + rawRatWidth rawTau + 4 := by omega + have htotal' : + rawRatWidth + (((logA.neg.add ((RawRat.one.add rawTau).mul logX)).add + logComplement).add + (RawRat.one.add (RawRat.one.add rawTau))) ≤ + 2 * rawRatWidth rawTau + rawRatWidth logA + + rawRatWidth logX + rawRatWidth logComplement + 9 := by + omega + simp only [rawDirectedGradientCoordinateWidthBudget] + simpa only [rawDirectedNegativeGradientLower, rawTau, logA, logX, + logComplement] using htotal' + +theorem rawDirectedNegativeGradientEntry_width_le_word_budget {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p : ℕ) + (i j : Fin (m + 1)) : + rawRatWidth + (rawDirectedNegativeGradientLower tau (A i j) + (betheAffineMatrixQ y i j) p) ≤ + rawDirectedObjectiveCoordinateWordBudget m + (machineDirectedObjectiveSumCanonicalWord tau A y p).length := by + let L := (machineDirectedObjectiveSumCanonicalWord tau A y p).length + let x := betheAffineMatrixQ y i j + let WX := rawDirectedObjectiveCoordinateWordXBudget m L + let WC := rawDirectedObjectiveCoordinateWordComplementBudget m L + have hp : p ≤ L := directedObjectiveSum_precision_le_word tau A y p + have htau : rawRatWidth (rawRatOfRat tau) ≤ L := + rawDirectedObjectiveSum_tau_width_le_word tau A y p + have ha : rawRatWidth (rawRatOfRat (A i j)) ≤ L := + rawDirectedObjectiveSum_A_width_le_word tau A y p i j + have hx : rawRatWidth (rawRatOfRat x) ≤ WX := by + simpa only [x, WX, L, + rawDirectedObjectiveCoordinateWordXBudget] using + rawBetheAffineMatrixQ_width_le_word tau A y p i j + have hc0 := rawRatWidth_complement_le x + have hc : rawRatWidth (rawRatOfRat (1 - x)) ≤ WC := by + simp only [WC, rawDirectedObjectiveCoordinateWordComplementBudget] + omega + have hlogA := rawRatWidth_scheduledLogUpper_of_bounds_le + (A i j) hp ha + have hlogX := rawRatWidth_scheduledLogLower_of_bounds_le x hp hx + have hlogC := rawRatWidth_scheduledLogLower_of_bounds_le (1 - x) hp hc + have hraw := rawDirectedNegativeGradientLower_width_le tau (A i j) x p + simp only [rawDirectedGradientCoordinateWidthBudget] at hraw + have hLX : L + 116 ≤ WX := by + simp only [WX, rawDirectedObjectiveCoordinateWordXBudget, + rawBetheAffineEntryWidthBudget] + omega + have hfinal : + rawRatWidth + (rawDirectedNegativeGradientLower tau (A i j) x p) ≤ + 2 * WX + L + WC + + rawScheduledLogWordBudget L L + + rawScheduledLogWordBudget L WX + + rawScheduledLogWordBudget L WC + 4 := by + simp only [rawScheduledLogWordBudget] + omega + simp only [rawDirectedObjectiveCoordinateWordBudget] + exact hfinal + +theorem rawDirectedAffineGradientEntry_width_le_word_budget {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p : ℕ) (a b : Fin m) : + rawRatWidth (rawDirectedAffineGradientEntry tau A y p a b) ≤ + 4 * rawDirectedObjectiveCoordinateWordBudget m + (machineDirectedObjectiveSumCanonicalWord tau A y p).length + 3 := by + let G := fun i j => rawDirectedNegativeGradientLower tau (A i j) + (betheAffineMatrixQ y i j) p + let B := rawDirectedObjectiveCoordinateWordBudget m + (machineDirectedObjectiveSumCanonicalWord tau A y p).length + have h₁ : rawRatWidth (G a.castSucc b.castSucc) ≤ B := + rawDirectedNegativeGradientEntry_width_le_word_budget tau A y p _ _ + have h₂ : rawRatWidth (G a.castSucc (Fin.last m)) ≤ B := + rawDirectedNegativeGradientEntry_width_le_word_budget tau A y p _ _ + have h₃ : rawRatWidth (G (Fin.last m) b.castSucc) ≤ B := + rawDirectedNegativeGradientEntry_width_le_word_budget tau A y p _ _ + have h₄ : rawRatWidth (G (Fin.last m) (Fin.last m)) ≤ B := + rawDirectedNegativeGradientEntry_width_le_word_budget tau A y p _ _ + have hsubOne := rawRatWidth_sub_le + (G a.castSucc b.castSucc) (G a.castSucc (Fin.last m)) + have hsubTwo := rawRatWidth_sub_le + ((G a.castSucc b.castSucc).sub (G a.castSucc (Fin.last m))) + (G (Fin.last m) b.castSucc) + have hadd := rawRatWidth_add_le + (((G a.castSucc b.castSucc).sub (G a.castSucc (Fin.last m))).sub + (G (Fin.last m) b.castSucc)) + (G (Fin.last m) (Fin.last m)) + simpa only [rawDirectedAffineGradientEntry, G, B] using hadd.trans (by omega) + +theorem directedAffineGradient_entry_code_length_le {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p : ℕ) (a b : Fin m) : + (rationalEntryBinaryCode + (affinePullbackGradient + (directedNegativeGradientLowerMatrix tau A + (betheAffineMatrixQ y) p) a b)).length ≤ + 172 + 144 * rawDirectedObjectiveCoordinateWordBudget m + (machineDirectedObjectiveSumCanonicalWord tau A y p).length := by + let raw := rawDirectedAffineGradientEntry tau A y p a b + have hcanonical := rationalEntryBinaryCode_binaryNormalizeRawRat_length_le raw + rw [binaryNormalizeRawRat_eq_value, + rawDirectedAffineGradientEntry_value] at hcanonical + have hraw := rawDirectedAffineGradientEntry_width_le_word_budget + tau A y p a b + calc + _ ≤ 64 + 36 * rawRatWidth raw := hcanonical + _ ≤ 64 + 36 * + (4 * rawDirectedObjectiveCoordinateWordBudget m + (machineDirectedObjectiveSumCanonicalWord tau A y p).length + 3) := + Nat.add_le_add_left (Nat.mul_le_mul_left 36 hraw) 64 + _ = 172 + 144 * rawDirectedObjectiveCoordinateWordBudget m + (machineDirectedObjectiveSumCanonicalWord tau A y p).length := by ring + +theorem directedAffineGradient_vector_code_length_le_bound {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p : ℕ) : + (rationalFiniteVectorCode + (directedAffineGradientVector tau A y p)).length ≤ + (machineDirectedAffineGradientVectorBound + (machineDirectedObjectiveSumCanonicalWord tau A y p)).length := by + let word := machineDirectedObjectiveSumCanonicalWord tau A y p + let L := word.length + let T := L + 16 + let B := rawDirectedObjectiveCoordinateWordBudget m L + let E := 172 + 144 * B + have hmL : m ≤ L := by + simp only [L, word, machineDirectedObjectiveSumCanonicalWord, + pair_length, List.length_replicate] + omega + have hB : B ≤ T ^ 20 := by + simpa only [B, T] using + rawDirectedObjectiveCoordinateWordBudget_le_pow hmL + have hE : E ≤ 316 * T ^ 20 := by + have hpow : 1 ≤ T ^ 20 := one_le_pow₀ (by simp [T]) + dsimp only [E] + omega + have heach : ∀ q ∈ List.ofFn (directedAffineGradientVector tau A y p), + (rationalEntryBinaryCode q).length ≤ E := by + intro q hq + obtain ⟨k, rfl⟩ := List.mem_ofFn.mp hq + let ij := finProdFinEquiv.symm k + simpa only [directedAffineGradientVector, squareMatrixToVector, ij, E, + B, L, word] using + directedAffineGradient_entry_code_length_le tau A y p ij.1 ij.2 + have hsum := List.sum_le_card_nsmul + ((List.ofFn (directedAffineGradientVector tau A y p)).map + fun q => 2 * (rationalEntryBinaryCode q).length + 2) + (2 * E + 2) (by + intro value hvalue + rw [List.mem_map] at hvalue + obtain ⟨q, hq, rfl⟩ := hvalue + have hq' := heach q hq + omega) + have hmT : m ≤ T := hmL.trans (by simp [T]) + have hlenCoarse : + (rationalFiniteVectorCode + (directedAffineGradientVector tau A y p)).length ≤ + 634 * T ^ 22 := by + rw [rationalFiniteVectorCode, binaryListCode_length_eq_sum] + simp only [List.length_map, List.length_ofFn, Nat.nsmul_eq_mul] at hsum + have hmm := Nat.mul_le_mul hmT hmT + have hfactor : 2 * E + 2 ≤ 634 * T ^ 20 := by + have hpow : 1 ≤ T ^ 20 := one_le_pow₀ (by simp [T]) + omega + have hmul := Nat.mul_le_mul hmm hfactor + calc + _ ≤ m * m * (2 * E + 2) := hsum + _ ≤ T * T * (634 * T ^ 20) := hmul + _ = 634 * T ^ 22 := by ring + have hcoeff : 634 ≤ T ^ 42 := by + have hbase : 16 ≤ T := by simp [T] + have hpow := Nat.pow_le_pow_left hbase 42 + exact (by norm_num : 634 ≤ 16 ^ 42).trans hpow + have hmul := Nat.mul_le_mul_right (T ^ 22) hcoeff + have hpower : + (rationalFiniteVectorCode + (directedAffineGradientVector tau A y p)).length ≤ T ^ 64 := by + calc + _ ≤ 634 * T ^ 22 := hlenCoarse + _ ≤ T ^ 42 * T ^ 22 := hmul + _ = T ^ 64 := by ring + rw [machineDirectedAffineGradientVectorBound, + machineIteratedBinaryWidth_length] + exact hpower.trans (by + simpa only [T, L, word] using + certificateExpGuardWidth_pow_lower 5 + (machineDirectedObjectiveSumCanonicalWord tau A y p).length) + +theorem unaryGridValues_directedAffineGradient {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p : ℕ) : + unaryGridValues + (fun a b => affinePullbackGradient + (directedNegativeGradientLowerMatrix tau A + (betheAffineMatrixQ y) p) a b) = + List.ofFn (directedAffineGradientVector tau A y p) := by + rfl + +@[simp] theorem machineDirectedAffineGradientVectorCode_encode {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p : ℕ) : + machineDirectedAffineGradientVectorCode + (machineDirectedObjectiveSumCanonicalWord tau A y p) = + rationalFiniteVectorCode (directedAffineGradientVector tau A y p) := by + let payload := machineDirectedObjectiveSumCanonicalWord tau A y p + let bound := machineDirectedAffineGradientVectorBound payload + let f := fun a b => affinePullbackGradient + (directedNegativeGradientLowerMatrix tau A + (betheAffineMatrixQ y) p) a b + have hinput : machineDirectedAffineGradientVectorGeneratorInput payload = + machineUnaryGridGeneratorCanonicalWord m bound payload := by + simp [machineDirectedAffineGradientVectorGeneratorInput, payload, bound, + machineUnaryGridGeneratorCanonicalWord] + rw [machineDirectedAffineGradientVectorCode, hinput] + have hentry : ∀ a b, + machineDirectedAffineGradientEntryCode + (pair (List.replicate a.1 true) + (pair (List.replicate b.1 true) payload)) = + rationalEntryBinaryCode (f a b) := by + intro a b + simpa only [payload, f, + machineDirectedAffineGradientEntryCanonicalWord] using + machineDirectedAffineGradientEntryCode_encode tau A y p a b + have hbound : + (binaryListCode rationalEntryBinaryCode (unaryGridValues f)).length ≤ + bound.length := by + rw [unaryGridValues_directedAffineGradient] + simpa only [rationalFiniteVectorCode, f, bound, payload] using + directedAffineGradient_vector_code_length_le_bound tau A y p + rw [machineUnaryGridGeneratorCode_encode_of_bound + machineDirectedAffineGradientEntryCode f bound payload hentry hbound, + unaryGridValues_directedAffineGradient] + rfl + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedEpigraphNormal.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedEpigraphNormal.lean new file mode 100644 index 0000000000..dc86a665b8 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedEpigraphNormal.lean @@ -0,0 +1,81 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineDirectedAffineGradientVector +import LeanPool.BeyondBethe.BeyondBethe.MachineBinaryListSnoc + +/-! +# Finite-word directed epigraph normals + +The nonlinear oracle returns the affine-gradient vector followed by the +height coefficient `-1`. This file performs that final append explicitly +and identifies the result with the canonical code of `epigraphNormal`. +-/ + +namespace BeyondBethe + +open Complexity + +def machineDirectedEpigraphNormalSnocInput + (word : List Bool) : List Bool := + pair (rationalEntryBinaryCode (-1)) + (machineDirectedAffineGradientVectorCode word) + +def machineDirectedEpigraphNormalVectorCode + (word : List Bool) : List Bool := + machineBinaryListSnoc (machineDirectedEpigraphNormalSnocInput word) + +theorem machineDirectedEpigraphNormalSnocInput_mem_FP : + machineDirectedEpigraphNormalSnocInput ∈ FP := + machinePair_mem_FP (machineConst_mem_FP (rationalEntryBinaryCode (-1))) + machineDirectedAffineGradientVectorCode_mem_FP + +theorem machineDirectedEpigraphNormalVectorCode_mem_FP : + machineDirectedEpigraphNormalVectorCode ∈ FP := by + simpa only [machineDirectedEpigraphNormalVectorCode] using + machineCompose_mem_FP machineDirectedEpigraphNormalSnocInput_mem_FP + machineBinaryListSnoc_mem_FP + +theorem ofFn_directedEpigraphNormal {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p : ℕ) : + List.ofFn + (epigraphNormal (directedAffineGradientVector tau A y p)) = + List.ofFn (directedAffineGradientVector tau A y p) ++ [-1] := by + rw [List.ofFn_succ'] + simp [epigraphNormal] + +@[simp] theorem machineDirectedEpigraphNormalVectorCode_encode {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p : ℕ) : + machineDirectedEpigraphNormalVectorCode + (machineDirectedObjectiveSumCanonicalWord tau A y p) = + rationalFiniteVectorCode + (epigraphNormal (directedAffineGradientVector tau A y p)) := by + rw [machineDirectedEpigraphNormalVectorCode, + machineDirectedEpigraphNormalSnocInput, + machineDirectedAffineGradientVectorCode_encode] + change machineBinaryListSnoc + (pair (rationalEntryBinaryCode (-1)) + (binaryListCode rationalEntryBinaryCode + (List.ofFn (directedAffineGradientVector tau A y p)))) = + binaryListCode rationalEntryBinaryCode + (List.ofFn + (epigraphNormal (directedAffineGradientVector tau A y p))) + rw [machineBinaryListSnoc_encode, ofFn_directedEpigraphNormal] + +@[simp] theorem machineDirectedEpigraphNormalVectorCode_encode_oracleNormal + {m : ℕ} (tau : ℚ) + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p : ℕ) : + machineDirectedEpigraphNormalVectorCode + (machineDirectedObjectiveSumCanonicalWord tau A y p) = + rationalFiniteVectorCode + (epigraphNormal ((betheDirectedEpigraphData tau A p).gradient y)) := by + simpa only [betheDirectedEpigraphData, directedAffineGradientVector] using + machineDirectedEpigraphNormalVectorCode_encode tau A y p + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedLog.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedLog.lean new file mode 100644 index 0000000000..9fe7033c2d --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedLog.lean @@ -0,0 +1,1011 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineLengthBits +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalLogSeries +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalCompare + +/-! +# Polynomial-time directed rational logarithm + +This file assembles the exact odd-series loop into the full dyadically +range-reduced lower and upper logarithms. The precision is supplied as a +unary ruler. Leading binary positions are read from word lengths, powers of +two are constructed directly as bitstrings, and all rational arithmetic is +performed by the verified unreduced-rational machines. +-/ + +namespace BeyondBethe + +open Complexity + +def rawRatTwoCode : List Bool := rawRatBinaryCode (RawRat.ofNat 2) + +def machineDirectedLogRuler (word : List Bool) : List Bool := + machinePairFirst word + +def machineDirectedLogArgumentCode (word : List Bool) : List Bool := + machinePairSecond word + +def machineDirectedLogParameterNumeratorCode (word : List Bool) : List Bool := + machineRawRatAddCode + (pair (machineDirectedLogArgumentCode word) + (machineRawRatNegCode rawRatOneCode)) + +def machineDirectedLogParameterDenominatorCode (word : List Bool) : List Bool := + machineRawRatAddCode + (pair (machineDirectedLogArgumentCode word) rawRatOneCode) + +def machineDirectedLogParameterCode (word : List Bool) : List Bool := + machineRawRatDivCode + (pair (machineDirectedLogParameterNumeratorCode word) + (machineDirectedLogParameterDenominatorCode word)) + +def machineDirectedLogSeriesSumCode (word : List Bool) : List Bool := + machineRawRationalLogSeriesSumCode + (pair (machineDirectedLogRuler word) + (machineDirectedLogParameterCode word)) + +def machineDirectedLogUnitLowerRawCode (word : List Bool) : List Bool := + machineRawRatMulCode (pair rawRatTwoCode + (machineDirectedLogSeriesSumCode word)) + +def machineDirectedLogOddPowerRuler (word : List Bool) : List Bool := + true :: (machineDirectedLogRuler word ++ machineDirectedLogRuler word) + +def machineDirectedLogOddPowerCode (word : List Bool) : List Bool := + machineRawRatPowerCode + (pair (machineDirectedLogOddPowerRuler word) + (machineDirectedLogParameterCode word)) + +def machineDirectedLogParameterSquareCode (word : List Bool) : List Bool := + machineRawRatMulCode + (pair (machineDirectedLogParameterCode word) + (machineDirectedLogParameterCode word)) + +def machineDirectedLogErrorDenominatorCode (word : List Bool) : List Bool := + machineRawRatAddCode + (pair rawRatOneCode + (machineRawRatNegCode (machineDirectedLogParameterSquareCode word))) + +def machineDirectedLogSeriesErrorCode (word : List Bool) : List Bool := + machineRawRatMulCode + (pair rawRatTwoCode + (machineRawRatDivCode + (pair (machineDirectedLogOddPowerCode word) + (machineDirectedLogErrorDenominatorCode word)))) + +def machineDirectedLogUnitUpperRawCode (word : List Bool) : List Bool := + machineRawRatAddCode + (pair (machineDirectedLogUnitLowerRawCode word) + (machineDirectedLogSeriesErrorCode word)) + +theorem machineDirectedLogRuler_mem_FP : + machineDirectedLogRuler ∈ Complexity.FP := machinePairFirst_mem_FP + +theorem machineDirectedLogArgumentCode_mem_FP : + machineDirectedLogArgumentCode ∈ Complexity.FP := machinePairSecond_mem_FP + +theorem machineDirectedLogParameterNumeratorCode_mem_FP : + machineDirectedLogParameterNumeratorCode ∈ Complexity.FP := by + have hnegOne : (fun _ : List Bool => machineRawRatNegCode rawRatOneCode) ∈ + Complexity.FP := machineConst_mem_FP _ + have hpair := machinePair_mem_FP machineDirectedLogArgumentCode_mem_FP hnegOne + simpa only [machineDirectedLogParameterNumeratorCode] using + machineCompose_mem_FP hpair machineRawRatAddCode_mem_FP + +theorem machineDirectedLogParameterDenominatorCode_mem_FP : + machineDirectedLogParameterDenominatorCode ∈ Complexity.FP := by + have hpair := machinePair_mem_FP machineDirectedLogArgumentCode_mem_FP + (machineConst_mem_FP rawRatOneCode) + simpa only [machineDirectedLogParameterDenominatorCode] using + machineCompose_mem_FP hpair machineRawRatAddCode_mem_FP + +theorem machineDirectedLogParameterCode_mem_FP : + machineDirectedLogParameterCode ∈ Complexity.FP := by + have hpair := machinePair_mem_FP + machineDirectedLogParameterNumeratorCode_mem_FP + machineDirectedLogParameterDenominatorCode_mem_FP + simpa only [machineDirectedLogParameterCode] using + machineCompose_mem_FP hpair machineRawRatDivCode_mem_FP + +theorem machineDirectedLogSeriesSumCode_mem_FP : + machineDirectedLogSeriesSumCode ∈ Complexity.FP := by + have hpair := machinePair_mem_FP machineDirectedLogRuler_mem_FP + machineDirectedLogParameterCode_mem_FP + simpa only [machineDirectedLogSeriesSumCode] using + machineCompose_mem_FP hpair machineRawRationalLogSeriesSumCode_mem_FP + +theorem machineDirectedLogUnitLowerRawCode_mem_FP : + machineDirectedLogUnitLowerRawCode ∈ Complexity.FP := by + have hpair := machinePair_mem_FP (machineConst_mem_FP rawRatTwoCode) + machineDirectedLogSeriesSumCode_mem_FP + simpa only [machineDirectedLogUnitLowerRawCode] using + machineCompose_mem_FP hpair machineRawRatMulCode_mem_FP + +theorem machineDirectedLogOddPowerRuler_mem_FP : + machineDirectedLogOddPowerRuler ∈ Complexity.FP := by + have hdouble := machineAppend_mem_FP machineDirectedLogRuler_mem_FP + machineDirectedLogRuler_mem_FP + simpa only [machineDirectedLogOddPowerRuler] using + machineCompose_mem_FP hdouble (machinePrepend_mem_FP true) + +theorem machineDirectedLogOddPowerCode_mem_FP : + machineDirectedLogOddPowerCode ∈ Complexity.FP := by + have hpair := machinePair_mem_FP machineDirectedLogOddPowerRuler_mem_FP + machineDirectedLogParameterCode_mem_FP + simpa only [machineDirectedLogOddPowerCode] using + machineCompose_mem_FP hpair machineRawRatPowerCode_mem_FP + +theorem machineDirectedLogParameterSquareCode_mem_FP : + machineDirectedLogParameterSquareCode ∈ Complexity.FP := by + have hpair := machinePair_mem_FP machineDirectedLogParameterCode_mem_FP + machineDirectedLogParameterCode_mem_FP + simpa only [machineDirectedLogParameterSquareCode] using + machineCompose_mem_FP hpair machineRawRatMulCode_mem_FP + +theorem machineDirectedLogErrorDenominatorCode_mem_FP : + machineDirectedLogErrorDenominatorCode ∈ Complexity.FP := by + have hneg := machineCompose_mem_FP + machineDirectedLogParameterSquareCode_mem_FP machineRawRatNegCode_mem_FP + have hpair := machinePair_mem_FP (machineConst_mem_FP rawRatOneCode) hneg + simpa only [machineDirectedLogErrorDenominatorCode] using + machineCompose_mem_FP hpair machineRawRatAddCode_mem_FP + +theorem machineDirectedLogSeriesErrorCode_mem_FP : + machineDirectedLogSeriesErrorCode ∈ Complexity.FP := by + have hratioPair := machinePair_mem_FP machineDirectedLogOddPowerCode_mem_FP + machineDirectedLogErrorDenominatorCode_mem_FP + have hratio := machineCompose_mem_FP hratioPair machineRawRatDivCode_mem_FP + have hpair := machinePair_mem_FP (machineConst_mem_FP rawRatTwoCode) hratio + simpa only [machineDirectedLogSeriesErrorCode] using + machineCompose_mem_FP hpair machineRawRatMulCode_mem_FP + +theorem machineDirectedLogUnitUpperRawCode_mem_FP : + machineDirectedLogUnitUpperRawCode ∈ Complexity.FP := by + have hpair := machinePair_mem_FP machineDirectedLogUnitLowerRawCode_mem_FP + machineDirectedLogSeriesErrorCode_mem_FP + simpa only [machineDirectedLogUnitUpperRawCode] using + machineCompose_mem_FP hpair machineRawRatAddCode_mem_FP + +/-! ## Dyadic range reduction -/ + +def machineDirectedLogNumeratorAbsBits (word : List Bool) : List Bool := + machineIntegerNatAbsBits (machinePairFirst (machineDirectedLogArgumentCode word)) + +def machineDirectedLogDenominatorBits (word : List Bool) : List Bool := + machinePairSecond (machineDirectedLogArgumentCode word) + +def machineDirectedLogNumeratorLogRuler (word : List Bool) : List Bool := + (machineDirectedLogNumeratorAbsBits word).tail + +def machineDirectedLogDenominatorLogRuler (word : List Bool) : List Bool := + (machineDirectedLogDenominatorBits word).tail + +def machineDirectedLogNumeratorLogBits (word : List Bool) : List Bool := + machineLengthBits (machineDirectedLogNumeratorLogRuler word) + +def machineDirectedLogDenominatorLogBits (word : List Bool) : List Bool := + machineLengthBits (machineDirectedLogDenominatorLogRuler word) + +def machineDirectedLogExponentIntegerCode (word : List Bool) : List Bool := + machineIntegerAddCode + (pair (machineNaturalIntegerCode (machineDirectedLogNumeratorLogBits word)) + (machineIntegerNegCode + (machineNaturalIntegerCode (machineDirectedLogDenominatorLogBits word)))) + +def machineDirectedLogPowerTwoBits (ruler : List Bool) : List Bool := + List.replicate ruler.length false ++ [true] + +def machineDirectedLogScaleCode (word : List Bool) : List Bool := + pair + (machineNaturalIntegerCode + (machineDirectedLogPowerTwoBits + (machineDirectedLogNumeratorLogRuler word))) + (machineDirectedLogPowerTwoBits + (machineDirectedLogDenominatorLogRuler word)) + +def machineDirectedLogResidualCode (word : List Bool) : List Bool := + machineRawRatDivCode + (pair (machineDirectedLogArgumentCode word) + (machineDirectedLogScaleCode word)) + +def machineDirectedLogResidualAtLeastOne (word : List Bool) : List Bool := + machineRawRatLeBit (pair rawRatOneCode (machineDirectedLogResidualCode word)) + +def machineDirectedLogUnitCode (word : List Bool) : List Bool := + machineIfHead (machineDirectedLogResidualAtLeastOne word) + (machineDirectedLogResidualCode word) + (machineRawRatInvCode (machineDirectedLogResidualCode word)) + +def machineDirectedLogTwoInput (word : List Bool) : List Bool := + pair (machineDirectedLogRuler word) rawRatTwoCode + +def machineDirectedLogUnitInput (word : List Bool) : List Bool := + pair (machineDirectedLogRuler word) (machineDirectedLogUnitCode word) + +def machineDirectedLogExponentRawRatCode (word : List Bool) : List Bool := + pair (machineDirectedLogExponentIntegerCode word) [true] + +def machineDirectedLogIntegerLowerCode (word : List Bool) : List Bool := + let lo := machineDirectedLogUnitLowerRawCode (machineDirectedLogTwoInput word) + let hi := machineDirectedLogUnitUpperRawCode (machineDirectedLogTwoInput word) + let factor := machineIfHead (machineHeadBit + (machineDirectedLogExponentIntegerCode word)) hi lo + machineRawRatMulCode + (pair (machineDirectedLogExponentRawRatCode word) factor) + +def machineDirectedLogIntegerUpperCode (word : List Bool) : List Bool := + let lo := machineDirectedLogUnitLowerRawCode (machineDirectedLogTwoInput word) + let hi := machineDirectedLogUnitUpperRawCode (machineDirectedLogTwoInput word) + let factor := machineIfHead (machineHeadBit + (machineDirectedLogExponentIntegerCode word)) lo hi + machineRawRatMulCode + (pair (machineDirectedLogExponentRawRatCode word) factor) + +def machineDirectedLogResidualLowerCode (word : List Bool) : List Bool := + let lo := machineDirectedLogUnitLowerRawCode (machineDirectedLogUnitInput word) + let hi := machineDirectedLogUnitUpperRawCode (machineDirectedLogUnitInput word) + machineIfHead (machineDirectedLogResidualAtLeastOne word) lo + (machineRawRatNegCode hi) + +def machineDirectedLogResidualUpperCode (word : List Bool) : List Bool := + let lo := machineDirectedLogUnitLowerRawCode (machineDirectedLogUnitInput word) + let hi := machineDirectedLogUnitUpperRawCode (machineDirectedLogUnitInput word) + machineIfHead (machineDirectedLogResidualAtLeastOne word) hi + (machineRawRatNegCode lo) + +def machineDirectedLogLowerRawCode (word : List Bool) : List Bool := + machineRawRatAddCode + (pair (machineDirectedLogIntegerLowerCode word) + (machineDirectedLogResidualLowerCode word)) + +def machineDirectedLogUpperRawCode (word : List Bool) : List Bool := + machineRawRatAddCode + (pair (machineDirectedLogIntegerUpperCode word) + (machineDirectedLogResidualUpperCode word)) + +def machineDirectedLogLowerCode (word : List Bool) : List Bool := + machineNormalizeRawRatBinaryCode (machineDirectedLogLowerRawCode word) + +def machineDirectedLogUpperCode (word : List Bool) : List Bool := + machineNormalizeRawRatBinaryCode (machineDirectedLogUpperRawCode word) + +theorem machineDirectedLogNumeratorAbsBits_mem_FP : + machineDirectedLogNumeratorAbsBits ∈ Complexity.FP := by + have hnum := machineCompose_mem_FP machineDirectedLogArgumentCode_mem_FP + machinePairFirst_mem_FP + simpa only [machineDirectedLogNumeratorAbsBits] using + machineCompose_mem_FP hnum machineIntegerNatAbsBits_mem_FP + +theorem machineDirectedLogDenominatorBits_mem_FP : + machineDirectedLogDenominatorBits ∈ Complexity.FP := by + simpa only [machineDirectedLogDenominatorBits] using + machineCompose_mem_FP machineDirectedLogArgumentCode_mem_FP + machinePairSecond_mem_FP + +theorem machineDirectedLogNumeratorLogRuler_mem_FP : + machineDirectedLogNumeratorLogRuler ∈ Complexity.FP := by + simpa only [machineDirectedLogNumeratorLogRuler] using + machineCompose_mem_FP machineDirectedLogNumeratorAbsBits_mem_FP + machineTail_mem_FP + +theorem machineDirectedLogDenominatorLogRuler_mem_FP : + machineDirectedLogDenominatorLogRuler ∈ Complexity.FP := by + simpa only [machineDirectedLogDenominatorLogRuler] using + machineCompose_mem_FP machineDirectedLogDenominatorBits_mem_FP + machineTail_mem_FP + +theorem machineDirectedLogNumeratorLogBits_mem_FP : + machineDirectedLogNumeratorLogBits ∈ Complexity.FP := by + simpa only [machineDirectedLogNumeratorLogBits] using + machineCompose_mem_FP machineDirectedLogNumeratorLogRuler_mem_FP + machineLengthBits_mem_FP + +theorem machineDirectedLogDenominatorLogBits_mem_FP : + machineDirectedLogDenominatorLogBits ∈ Complexity.FP := by + simpa only [machineDirectedLogDenominatorLogBits] using + machineCompose_mem_FP machineDirectedLogDenominatorLogRuler_mem_FP + machineLengthBits_mem_FP + +theorem machineDirectedLogExponentIntegerCode_mem_FP : + machineDirectedLogExponentIntegerCode ∈ Complexity.FP := by + have hnum := machineCompose_mem_FP machineDirectedLogNumeratorLogBits_mem_FP + (machinePrepend_mem_FP false) + have hdenNat := machineCompose_mem_FP + machineDirectedLogDenominatorLogBits_mem_FP (machinePrepend_mem_FP false) + have hden := machineCompose_mem_FP hdenNat machineIntegerNegCode_mem_FP + have hpair := machinePair_mem_FP hnum hden + simpa only [machineDirectedLogExponentIntegerCode] using + machineCompose_mem_FP hpair machineIntegerAddCode_mem_FP + +theorem machineDirectedLogPowerTwoBits_mem_FP : + machineDirectedLogPowerTwoBits ∈ Complexity.FP := by + have hzero := machineZeroBlock_mem_FP + have hone : (fun _ : List Bool => [true]) ∈ Complexity.FP := + machineConst_mem_FP [true] + simpa only [machineDirectedLogPowerTwoBits] using + machineAppend_mem_FP hzero hone + +theorem machineDirectedLogScaleCode_mem_FP : + machineDirectedLogScaleCode ∈ Complexity.FP := by + have hnumBits := machineCompose_mem_FP + machineDirectedLogNumeratorLogRuler_mem_FP + machineDirectedLogPowerTwoBits_mem_FP + have hnum := machineCompose_mem_FP hnumBits (machinePrepend_mem_FP false) + have hden := machineCompose_mem_FP + machineDirectedLogDenominatorLogRuler_mem_FP + machineDirectedLogPowerTwoBits_mem_FP + exact machinePair_mem_FP hnum hden + +theorem machineDirectedLogResidualCode_mem_FP : + machineDirectedLogResidualCode ∈ Complexity.FP := by + have hpair := machinePair_mem_FP machineDirectedLogArgumentCode_mem_FP + machineDirectedLogScaleCode_mem_FP + simpa only [machineDirectedLogResidualCode] using + machineCompose_mem_FP hpair machineRawRatDivCode_mem_FP + +theorem machineDirectedLogResidualAtLeastOne_mem_FP : + machineDirectedLogResidualAtLeastOne ∈ Complexity.FP := by + have hpair := machinePair_mem_FP (machineConst_mem_FP rawRatOneCode) + machineDirectedLogResidualCode_mem_FP + simpa only [machineDirectedLogResidualAtLeastOne] using + machineCompose_mem_FP hpair machineRawRatLeBit_mem_FP + +theorem machineDirectedLogUnitCode_mem_FP : + machineDirectedLogUnitCode ∈ Complexity.FP := by + have hinv := machineCompose_mem_FP machineDirectedLogResidualCode_mem_FP + machineRawRatInvCode_mem_FP + simpa only [machineDirectedLogUnitCode] using + machineIfHead_mem_FP machineDirectedLogResidualAtLeastOne_mem_FP + machineDirectedLogResidualCode_mem_FP hinv + +theorem machineDirectedLogTwoInput_mem_FP : + machineDirectedLogTwoInput ∈ Complexity.FP := + machinePair_mem_FP machineDirectedLogRuler_mem_FP + (machineConst_mem_FP rawRatTwoCode) + +theorem machineDirectedLogUnitInput_mem_FP : + machineDirectedLogUnitInput ∈ Complexity.FP := + machinePair_mem_FP machineDirectedLogRuler_mem_FP + machineDirectedLogUnitCode_mem_FP + +theorem machineDirectedLogExponentRawRatCode_mem_FP : + machineDirectedLogExponentRawRatCode ∈ Complexity.FP := + machinePair_mem_FP machineDirectedLogExponentIntegerCode_mem_FP + (machineConst_mem_FP [true]) + +theorem machineDirectedLogIntegerLowerCode_mem_FP : + machineDirectedLogIntegerLowerCode ∈ Complexity.FP := by + have hlo := machineCompose_mem_FP machineDirectedLogTwoInput_mem_FP + machineDirectedLogUnitLowerRawCode_mem_FP + have hhi := machineCompose_mem_FP machineDirectedLogTwoInput_mem_FP + machineDirectedLogUnitUpperRawCode_mem_FP + have hsign := machineCompose_mem_FP + machineDirectedLogExponentIntegerCode_mem_FP machineHeadBit_mem_FP + have hfactor := machineIfHead_mem_FP hsign hhi hlo + have hpair := machinePair_mem_FP + machineDirectedLogExponentRawRatCode_mem_FP hfactor + simpa only [machineDirectedLogIntegerLowerCode] using + machineCompose_mem_FP hpair machineRawRatMulCode_mem_FP + +theorem machineDirectedLogIntegerUpperCode_mem_FP : + machineDirectedLogIntegerUpperCode ∈ Complexity.FP := by + have hlo := machineCompose_mem_FP machineDirectedLogTwoInput_mem_FP + machineDirectedLogUnitLowerRawCode_mem_FP + have hhi := machineCompose_mem_FP machineDirectedLogTwoInput_mem_FP + machineDirectedLogUnitUpperRawCode_mem_FP + have hsign := machineCompose_mem_FP + machineDirectedLogExponentIntegerCode_mem_FP machineHeadBit_mem_FP + have hfactor := machineIfHead_mem_FP hsign hlo hhi + have hpair := machinePair_mem_FP + machineDirectedLogExponentRawRatCode_mem_FP hfactor + simpa only [machineDirectedLogIntegerUpperCode] using + machineCompose_mem_FP hpair machineRawRatMulCode_mem_FP + +theorem machineDirectedLogResidualLowerCode_mem_FP : + machineDirectedLogResidualLowerCode ∈ Complexity.FP := by + have hlo := machineCompose_mem_FP machineDirectedLogUnitInput_mem_FP + machineDirectedLogUnitLowerRawCode_mem_FP + have hhi := machineCompose_mem_FP machineDirectedLogUnitInput_mem_FP + machineDirectedLogUnitUpperRawCode_mem_FP + have hnegHi := machineCompose_mem_FP hhi machineRawRatNegCode_mem_FP + simpa only [machineDirectedLogResidualLowerCode] using + machineIfHead_mem_FP machineDirectedLogResidualAtLeastOne_mem_FP + hlo hnegHi + +theorem machineDirectedLogResidualUpperCode_mem_FP : + machineDirectedLogResidualUpperCode ∈ Complexity.FP := by + have hlo := machineCompose_mem_FP machineDirectedLogUnitInput_mem_FP + machineDirectedLogUnitLowerRawCode_mem_FP + have hhi := machineCompose_mem_FP machineDirectedLogUnitInput_mem_FP + machineDirectedLogUnitUpperRawCode_mem_FP + have hnegLo := machineCompose_mem_FP hlo machineRawRatNegCode_mem_FP + simpa only [machineDirectedLogResidualUpperCode] using + machineIfHead_mem_FP machineDirectedLogResidualAtLeastOne_mem_FP + hhi hnegLo + +theorem machineDirectedLogLowerRawCode_mem_FP : + machineDirectedLogLowerRawCode ∈ Complexity.FP := by + have hpair := machinePair_mem_FP machineDirectedLogIntegerLowerCode_mem_FP + machineDirectedLogResidualLowerCode_mem_FP + simpa only [machineDirectedLogLowerRawCode] using + machineCompose_mem_FP hpair machineRawRatAddCode_mem_FP + +theorem machineDirectedLogUpperRawCode_mem_FP : + machineDirectedLogUpperRawCode ∈ Complexity.FP := by + have hpair := machinePair_mem_FP machineDirectedLogIntegerUpperCode_mem_FP + machineDirectedLogResidualUpperCode_mem_FP + simpa only [machineDirectedLogUpperRawCode] using + machineCompose_mem_FP hpair machineRawRatAddCode_mem_FP + +theorem machineDirectedLogLowerCode_mem_FP : + machineDirectedLogLowerCode ∈ Complexity.FP := by + simpa only [machineDirectedLogLowerCode] using + machineCompose_mem_FP machineDirectedLogLowerRawCode_mem_FP + machineNormalizeRawRatBinaryCode_mem_FP + +theorem machineDirectedLogUpperCode_mem_FP : + machineDirectedLogUpperCode ∈ Complexity.FP := by + simpa only [machineDirectedLogUpperCode] using + machineCompose_mem_FP machineDirectedLogUpperRawCode_mem_FP + machineNormalizeRawRatBinaryCode_mem_FP + +/-! ## Exact unit-interval semantics -/ + +namespace RawRat + +def logUnitParameter (y : RawRat) : RawRat := + (y.add one.neg).div (y.add one) + +def logUnitLower (y : RawRat) (N : ℕ) : RawRat := + (ofNat 2).mul (logSeriesSum (logUnitParameter y) N) + +def logSeriesError (y : RawRat) (N : ℕ) : RawRat := + let x := logUnitParameter y + (ofNat 2).mul ((x.pow (2 * N + 1)).div (one.add (x.mul x).neg)) + +def logUnitUpper (y : RawRat) (N : ℕ) : RawRat := + (logUnitLower y N).add (logSeriesError y N) + +@[simp] theorem value_logUnitParameter (y : RawRat) : + (logUnitParameter y).value = binaryRationalLogUnitParameter y.value := by + simp [logUnitParameter, binaryRationalLogUnitParameter, + binaryRatDiv_eq_div, binaryRatSub_eq_sub, binaryRatAdd_eq_add, + sub_eq_add_neg] + +@[simp] theorem value_logUnitLower (y : RawRat) (N : ℕ) : + (logUnitLower y N).value = binaryDirectedLogUnitLower y.value N := by + simp [logUnitLower, binaryDirectedLogUnitLower, + binaryRationalLogSeries, binaryRatMul_eq_mul, + RawRat.value_logSeriesSum] + +@[simp] theorem value_logSeriesError (y : RawRat) (N : ℕ) : + (logSeriesError y N).value = + binaryRationalLogSeriesError (binaryRationalLogUnitParameter y.value) N := by + simp [logSeriesError, binaryRationalLogSeriesError, + binaryRatMul_eq_mul, binaryRatDiv_eq_div, binaryRatSub_eq_sub, + binaryRatPow_eq_pow] + ring + +@[simp] theorem value_logUnitUpper (y : RawRat) (N : ℕ) : + (logUnitUpper y N).value = binaryDirectedLogUnitUpper y.value N := by + simp [logUnitUpper, binaryDirectedLogUnitUpper, + binaryDirectedLogUnitLower, binaryRatAdd_eq_add] + +end RawRat + +@[simp] theorem machineDirectedLogParameterCode_encode + (ruler : List Bool) (y : RawRat) : + machineDirectedLogParameterCode (pair ruler (rawRatBinaryCode y)) = + rawRatBinaryCode (RawRat.logUnitParameter y) := by + rw [machineDirectedLogParameterCode, + machineDirectedLogParameterNumeratorCode, + machineDirectedLogParameterDenominatorCode] + simp only [machineDirectedLogArgumentCode, machinePairSecond_pair, + rawRatOneCode, machineRawRatNegCode_encode, + machineRawRatAddCode_encode, machineRawRatDivCode_encode, + RawRat.logUnitParameter] + +@[simp] theorem machineDirectedLogSeriesSumCode_encode + (y : RawRat) (N : ℕ) : + machineDirectedLogSeriesSumCode + (pair (List.replicate N true) (rawRatBinaryCode y)) = + rawRatBinaryCode + (RawRat.logSeriesSum (RawRat.logUnitParameter y) N) := by + rw [machineDirectedLogSeriesSumCode] + simp only [machineDirectedLogRuler, machinePairFirst_pair, + machineDirectedLogParameterCode_encode, + machineRawRationalLogSeriesSumCode_encode] + +@[simp] theorem machineDirectedLogUnitLowerRawCode_encode + (y : RawRat) (N : ℕ) : + machineDirectedLogUnitLowerRawCode + (pair (List.replicate N true) (rawRatBinaryCode y)) = + rawRatBinaryCode (RawRat.logUnitLower y N) := by + rw [machineDirectedLogUnitLowerRawCode] + simp only [rawRatTwoCode, machineDirectedLogSeriesSumCode_encode, + machineRawRatMulCode_encode, RawRat.logUnitLower] + +theorem machineDirectedLogOddPowerRuler_encode + (y : RawRat) (N : ℕ) : + machineDirectedLogOddPowerRuler + (pair (List.replicate N true) (rawRatBinaryCode y)) = + List.replicate (2 * N + 1) true := by + rw [machineDirectedLogOddPowerRuler] + simp only [machineDirectedLogRuler, machinePairFirst_pair] + rw [← List.replicate_add] + rw [show 2 * N + 1 = (N + N) + 1 by omega, List.replicate_succ] + +@[simp] theorem machineDirectedLogOddPowerCode_encode + (y : RawRat) (N : ℕ) : + machineDirectedLogOddPowerCode + (pair (List.replicate N true) (rawRatBinaryCode y)) = + rawRatBinaryCode + ((RawRat.logUnitParameter y).pow (2 * N + 1)) := by + rw [machineDirectedLogOddPowerCode, + machineDirectedLogOddPowerRuler_encode, + machineDirectedLogParameterCode_encode, + machineRawRatPowerCode_encode] + +@[simp] theorem machineDirectedLogParameterSquareCode_encode + (ruler : List Bool) (y : RawRat) : + machineDirectedLogParameterSquareCode + (pair ruler (rawRatBinaryCode y)) = + rawRatBinaryCode + ((RawRat.logUnitParameter y).mul (RawRat.logUnitParameter y)) := by + rw [machineDirectedLogParameterSquareCode] + simp only [machineDirectedLogParameterCode_encode, + machineRawRatMulCode_encode] + +@[simp] theorem machineDirectedLogErrorDenominatorCode_encode + (ruler : List Bool) (y : RawRat) : + machineDirectedLogErrorDenominatorCode + (pair ruler (rawRatBinaryCode y)) = + rawRatBinaryCode + (RawRat.one.add + ((RawRat.logUnitParameter y).mul + (RawRat.logUnitParameter y)).neg) := by + rw [machineDirectedLogErrorDenominatorCode] + simp only [rawRatOneCode, machineDirectedLogParameterSquareCode_encode, + machineRawRatNegCode_encode, machineRawRatAddCode_encode] + +@[simp] theorem machineDirectedLogSeriesErrorCode_encode + (y : RawRat) (N : ℕ) : + machineDirectedLogSeriesErrorCode + (pair (List.replicate N true) (rawRatBinaryCode y)) = + rawRatBinaryCode (RawRat.logSeriesError y N) := by + rw [machineDirectedLogSeriesErrorCode] + simp only [rawRatTwoCode, machineDirectedLogOddPowerCode_encode, + machineDirectedLogErrorDenominatorCode_encode, + machineRawRatDivCode_encode, machineRawRatMulCode_encode, + RawRat.logSeriesError] + +@[simp] theorem machineDirectedLogUnitUpperRawCode_encode + (y : RawRat) (N : ℕ) : + machineDirectedLogUnitUpperRawCode + (pair (List.replicate N true) (rawRatBinaryCode y)) = + rawRatBinaryCode (RawRat.logUnitUpper y N) := by + rw [machineDirectedLogUnitUpperRawCode] + simp only [machineDirectedLogUnitLowerRawCode_encode, + machineDirectedLogSeriesErrorCode_encode, + machineRawRatAddCode_encode, RawRat.logUnitUpper] + +@[simp] theorem machineDirectedLogTwoLowerRawCode_encode (N : ℕ) : + machineDirectedLogUnitLowerRawCode + (pair (List.replicate N true) rawRatTwoCode) = + rawRatBinaryCode (RawRat.logUnitLower (RawRat.ofNat 2) N) := by + simpa only [rawRatTwoCode] using + machineDirectedLogUnitLowerRawCode_encode (RawRat.ofNat 2) N + +@[simp] theorem machineDirectedLogTwoUpperRawCode_encode (N : ℕ) : + machineDirectedLogUnitUpperRawCode + (pair (List.replicate N true) rawRatTwoCode) = + rawRatBinaryCode (RawRat.logUnitUpper (RawRat.ofNat 2) N) := by + simpa only [rawRatTwoCode] using + machineDirectedLogUnitUpperRawCode_encode (RawRat.ofNat 2) N + +private theorem directedLogPowerTwoBits_value : ∀ k : ℕ, + Nat.fromBitsLE (List.replicate k false ++ [true]) = 2 ^ k := by + intro k + induction k with + | zero => rfl + | succ k ih => + simp only [List.replicate_succ, List.cons_append, + Nat.fromBitsLE_cons, Bool.false_eq, ih, + pow_succ] + norm_num + ring + +@[simp] theorem machineDirectedLogPowerTwoBits_encode (ruler : List Bool) : + machineDirectedLogPowerTwoBits ruler = (2 ^ ruler.length).bits := by + apply Nat.fromBitsLE_inj_of_length_eq + · simp [machineDirectedLogPowerTwoBits, Nat.size_eq_bits_len, + Nat.size_pow] + · rw [machineDirectedLogPowerTwoBits, directedLogPowerTwoBits_value, + Nat.fromBitsLE_bits] + +@[simp] theorem machineDirectedLogNumeratorAbsBits_encode + (ruler : List Bool) (q : ℚ) : + machineDirectedLogNumeratorAbsBits + (pair ruler (rawRatBinaryCode (rawRatOfRat q))) = q.num.natAbs.bits := by + rw [machineDirectedLogNumeratorAbsBits] + simp only [machineDirectedLogArgumentCode, machinePairSecond_pair, + rawRatBinaryCode, machinePairFirst_pair, + machineIntegerNatAbsBits_encode, rawRatOfRat] + +@[simp] theorem machineDirectedLogDenominatorBits_encode + (ruler : List Bool) (q : ℚ) : + machineDirectedLogDenominatorBits + (pair ruler (rawRatBinaryCode (rawRatOfRat q))) = q.den.bits := by + simp [machineDirectedLogDenominatorBits, machineDirectedLogArgumentCode, + rawRatBinaryCode, rawRatOfRat] + +theorem machineDirectedLogNumeratorLogRuler_length + (ruler : List Bool) (q : ℚ) : + (machineDirectedLogNumeratorLogRuler + (pair ruler (rawRatBinaryCode (rawRatOfRat q)))).length = + binaryNatLog2 q.num.natAbs := by + rw [machineDirectedLogNumeratorLogRuler, + machineDirectedLogNumeratorAbsBits_encode] + simp [binaryNatLog2, Nat.size_eq_bits_len] + +theorem machineDirectedLogDenominatorLogRuler_length + (ruler : List Bool) (q : ℚ) : + (machineDirectedLogDenominatorLogRuler + (pair ruler (rawRatBinaryCode (rawRatOfRat q)))).length = + binaryNatLog2 q.den := by + rw [machineDirectedLogDenominatorLogRuler, + machineDirectedLogDenominatorBits_encode] + simp [binaryNatLog2, Nat.size_eq_bits_len] + +@[simp] theorem machineDirectedLogNumeratorLogBits_encode + (ruler : List Bool) (q : ℚ) : + machineDirectedLogNumeratorLogBits + (pair ruler (rawRatBinaryCode (rawRatOfRat q))) = + (binaryNatLog2 q.num.natAbs).bits := by + rw [machineDirectedLogNumeratorLogBits, machineLengthBits_encode, + machineDirectedLogNumeratorLogRuler_length] + +@[simp] theorem machineDirectedLogDenominatorLogBits_encode + (ruler : List Bool) (q : ℚ) : + machineDirectedLogDenominatorLogBits + (pair ruler (rawRatBinaryCode (rawRatOfRat q))) = + (binaryNatLog2 q.den).bits := by + rw [machineDirectedLogDenominatorLogBits, machineLengthBits_encode, + machineDirectedLogDenominatorLogRuler_length] + +@[simp] theorem machineDirectedLogExponentIntegerCode_encode + (ruler : List Bool) (q : ℚ) : + machineDirectedLogExponentIntegerCode + (pair ruler (rawRatBinaryCode (rawRatOfRat q))) = + integerBinaryCode (binaryRationalBinaryExponent q) := by + rw [machineDirectedLogExponentIntegerCode] + simp only [machineDirectedLogNumeratorLogBits_encode, + machineDirectedLogDenominatorLogBits_encode, + machineNaturalIntegerCode_natBits, machineIntegerNegCode_encode, + machineIntegerAddCode_encode, binaryRationalBinaryExponent] + congr 1 + +namespace RawRat + +def logScale (q : ℚ) : RawRat := + ⟨(2 ^ binaryNatLog2 q.num.natAbs : ℕ), + 2 ^ binaryNatLog2 q.den, by positivity⟩ + +def logResidual (q : ℚ) : RawRat := + (rawRatOfRat q).div (logScale q) + +def logUnit (q : ℚ) : RawRat := + if 1 ≤ (logResidual q).value then logResidual q else (logResidual q).inv + +@[simp] theorem value_logScale (q : ℚ) : + (logScale q).value = binaryRationalBinaryScale q := by + simp [logScale, binaryRationalBinaryScale, binaryRatDiv_eq_div, + binaryRatPow_eq_pow, value] + +@[simp] theorem value_logResidual (q : ℚ) : + (logResidual q).value = binaryRationalBinaryResidual q := by + simp [logResidual, binaryRationalBinaryResidual, + binaryRatDiv_eq_div] + +@[simp] theorem value_logUnit (q : ℚ) : + (logUnit q).value = binaryRationalLogUnit q := by + rw [logUnit, binaryRationalLogUnit] + by_cases h : binaryRationalBinaryResidual q < 1 + · have hnot : ¬ 1 ≤ (logResidual q).value := by simpa using h + rw [if_pos ((binaryRatLt_eq_true_iff _ _).2 h), if_neg hnot] + simp [binaryRatInv_eq_inv] + · have hle : 1 ≤ (logResidual q).value := by + simpa using (le_of_not_gt h) + have hflag : ¬ binaryRatLt (binaryRationalBinaryResidual q) 1 = true := + fun htrue => h ((binaryRatLt_eq_true_iff _ _).1 htrue) + rw [if_neg hflag, if_pos hle] + exact RawRat.value_logResidual q + +end RawRat + +@[simp] theorem machineDirectedLogScaleCode_encode + (ruler : List Bool) (q : ℚ) : + machineDirectedLogScaleCode + (pair ruler (rawRatBinaryCode (rawRatOfRat q))) = + rawRatBinaryCode (RawRat.logScale q) := by + rw [machineDirectedLogScaleCode] + rw [machineDirectedLogPowerTwoBits_encode, + machineDirectedLogPowerTwoBits_encode, + machineDirectedLogNumeratorLogRuler_length, + machineDirectedLogDenominatorLogRuler_length, + machineNaturalIntegerCode_natBits] + rfl + +@[simp] theorem machineDirectedLogResidualCode_encode + (ruler : List Bool) (q : ℚ) : + machineDirectedLogResidualCode + (pair ruler (rawRatBinaryCode (rawRatOfRat q))) = + rawRatBinaryCode (RawRat.logResidual q) := by + rw [machineDirectedLogResidualCode] + simp only [machineDirectedLogArgumentCode, machinePairSecond_pair, + machineDirectedLogScaleCode_encode, + machineRawRatDivCode_encode, RawRat.logResidual] + +@[simp] theorem machineDirectedLogResidualAtLeastOne_encode + (ruler : List Bool) (q : ℚ) : + machineDirectedLogResidualAtLeastOne + (pair ruler (rawRatBinaryCode (rawRatOfRat q))) = + [decide (1 ≤ binaryRationalBinaryResidual q)] := by + rw [machineDirectedLogResidualAtLeastOne] + simp only [rawRatOneCode, machineDirectedLogResidualCode_encode, + machineRawRatLeBit_encode, RawRat.value_one, + RawRat.value_logResidual] + +@[simp] theorem machineDirectedLogUnitCode_encode + (ruler : List Bool) (q : ℚ) : + machineDirectedLogUnitCode + (pair ruler (rawRatBinaryCode (rawRatOfRat q))) = + rawRatBinaryCode (RawRat.logUnit q) := by + rw [machineDirectedLogUnitCode] + simp only [machineDirectedLogResidualAtLeastOne_encode, + machineDirectedLogResidualCode_encode] + by_cases h : 1 ≤ binaryRationalBinaryResidual q + · simp [h, RawRat.logUnit] + · rw [show decide (1 ≤ binaryRationalBinaryResidual q) = false by simp [h]] + simp only [machineIfHead_false, machineRawRatInvCode_encode] + simp [RawRat.logUnit, h] + +namespace RawRat + +def ofInt (z : ℤ) : RawRat := ⟨z, 1, by omega⟩ + +@[simp] theorem value_ofInt (z : ℤ) : (ofInt z).value = z := by + simp [ofInt, value] + +def logIntegerLower (q : ℚ) (N : ℕ) : RawRat := + let k := binaryRationalBinaryExponent q + (ofInt k).mul + (if 0 ≤ k then logUnitLower (ofNat 2) N + else logUnitUpper (ofNat 2) N) + +def logIntegerUpper (q : ℚ) (N : ℕ) : RawRat := + let k := binaryRationalBinaryExponent q + (ofInt k).mul + (if 0 ≤ k then logUnitUpper (ofNat 2) N + else logUnitLower (ofNat 2) N) + +def logResidualLower (q : ℚ) (N : ℕ) : RawRat := + if 1 ≤ (logResidual q).value then logUnitLower (logUnit q) N + else (logUnitUpper (logUnit q) N).neg + +def logResidualUpper (q : ℚ) (N : ℕ) : RawRat := + if 1 ≤ (logResidual q).value then logUnitUpper (logUnit q) N + else (logUnitLower (logUnit q) N).neg + +def logLower (q : ℚ) (N : ℕ) : RawRat := + (logIntegerLower q N).add (logResidualLower q N) + +def logUpper (q : ℚ) (N : ℕ) : RawRat := + (logIntegerUpper q N).add (logResidualUpper q N) + +@[simp] theorem value_logIntegerLower (q : ℚ) (N : ℕ) : + (logIntegerLower q N).value = + binaryDirectedIntMulLower (binaryRationalBinaryExponent q) + (binaryDirectedLogUnitLower 2 N) + (binaryDirectedLogUnitUpper 2 N) := by + rw [logIntegerLower, value_mul, value_ofInt, + binaryDirectedIntMulLower] + split_ifs <;> simp [binaryRatMul_eq_mul] + +@[simp] theorem value_logIntegerUpper (q : ℚ) (N : ℕ) : + (logIntegerUpper q N).value = + binaryDirectedIntMulUpper (binaryRationalBinaryExponent q) + (binaryDirectedLogUnitLower 2 N) + (binaryDirectedLogUnitUpper 2 N) := by + rw [logIntegerUpper, value_mul, value_ofInt, + binaryDirectedIntMulUpper] + split_ifs <;> simp [binaryRatMul_eq_mul] + +@[simp] theorem value_logResidualLower (q : ℚ) (N : ℕ) : + (logResidualLower q N).value = + if binaryRatLt (binaryRationalBinaryResidual q) 1 then + binaryRatNeg (binaryDirectedLogUnitUpper (binaryRationalLogUnit q) N) + else binaryDirectedLogUnitLower (binaryRationalLogUnit q) N := by + rw [logResidualLower] + by_cases h : binaryRationalBinaryResidual q < 1 + · have hnot : ¬ 1 ≤ (logResidual q).value := by simpa using h + rw [if_neg hnot, + if_pos ((binaryRatLt_eq_true_iff _ _).2 h)] + simp [binaryRatNeg_eq_neg] + · have hle : 1 ≤ (logResidual q).value := by + simpa using (le_of_not_gt h) + have hflag : ¬ binaryRatLt (binaryRationalBinaryResidual q) 1 = true := + fun htrue => h ((binaryRatLt_eq_true_iff _ _).1 htrue) + rw [if_pos hle, if_neg hflag] + simpa only [value_logUnit] using value_logUnitLower (logUnit q) N + +@[simp] theorem value_logResidualUpper (q : ℚ) (N : ℕ) : + (logResidualUpper q N).value = + if binaryRatLt (binaryRationalBinaryResidual q) 1 then + binaryRatNeg (binaryDirectedLogUnitLower (binaryRationalLogUnit q) N) + else binaryDirectedLogUnitUpper (binaryRationalLogUnit q) N := by + rw [logResidualUpper] + by_cases h : binaryRationalBinaryResidual q < 1 + · have hnot : ¬ 1 ≤ (logResidual q).value := by simpa using h + rw [if_neg hnot, + if_pos ((binaryRatLt_eq_true_iff _ _).2 h)] + simp [binaryRatNeg_eq_neg] + · have hle : 1 ≤ (logResidual q).value := by + simpa using (le_of_not_gt h) + have hflag : ¬ binaryRatLt (binaryRationalBinaryResidual q) 1 = true := + fun htrue => h ((binaryRatLt_eq_true_iff _ _).1 htrue) + rw [if_pos hle, if_neg hflag] + simpa only [value_logUnit] using value_logUnitUpper (logUnit q) N + +@[simp] theorem value_logLower (q : ℚ) (N : ℕ) : + (logLower q N).value = binaryDirectedLogLower q N := by + simp [logLower, binaryDirectedLogLower, binaryRatAdd_eq_add] + +@[simp] theorem value_logUpper (q : ℚ) (N : ℕ) : + (logUpper q N).value = binaryDirectedLogUpper q N := by + simp [logUpper, binaryDirectedLogUpper, binaryRatAdd_eq_add] + +end RawRat + +@[simp] theorem machineDirectedLogExponentRawRatCode_encode + (ruler : List Bool) (q : ℚ) : + machineDirectedLogExponentRawRatCode + (pair ruler (rawRatBinaryCode (rawRatOfRat q))) = + rawRatBinaryCode + (RawRat.ofInt (binaryRationalBinaryExponent q)) := by + rw [machineDirectedLogExponentRawRatCode, + machineDirectedLogExponentIntegerCode_encode] + simp [rawRatBinaryCode, RawRat.ofInt] + +@[simp] theorem machineDirectedLogTwoInput_encode (q : ℚ) (N : ℕ) : + machineDirectedLogTwoInput + (pair (List.replicate N true) (rawRatBinaryCode (rawRatOfRat q))) = + pair (List.replicate N true) rawRatTwoCode := by + simp [machineDirectedLogTwoInput, machineDirectedLogRuler] + +@[simp] theorem machineDirectedLogUnitInput_encode (q : ℚ) (N : ℕ) : + machineDirectedLogUnitInput + (pair (List.replicate N true) (rawRatBinaryCode (rawRatOfRat q))) = + pair (List.replicate N true) (rawRatBinaryCode (RawRat.logUnit q)) := by + simp [machineDirectedLogUnitInput, machineDirectedLogRuler] + +@[simp] theorem machineDirectedLogIntegerLowerCode_encode (q : ℚ) (N : ℕ) : + machineDirectedLogIntegerLowerCode + (pair (List.replicate N true) (rawRatBinaryCode (rawRatOfRat q))) = + rawRatBinaryCode (RawRat.logIntegerLower q N) := by + cases hk : binaryRationalBinaryExponent q with + | ofNat k => + simp [machineDirectedLogIntegerLowerCode, + machineDirectedLogTwoInput_encode, + machineDirectedLogExponentIntegerCode_encode, + machineDirectedLogExponentRawRatCode_encode, + machineDirectedLogTwoLowerRawCode_encode, + machineDirectedLogTwoUpperRawCode_encode, + machineRawRatMulCode_encode, RawRat.logIntegerLower, hk, + integerBinaryCode] + | negSucc k => + simp [machineDirectedLogIntegerLowerCode, + machineDirectedLogTwoInput_encode, + machineDirectedLogExponentIntegerCode_encode, + machineDirectedLogExponentRawRatCode_encode, + machineDirectedLogTwoLowerRawCode_encode, + machineDirectedLogTwoUpperRawCode_encode, + machineRawRatMulCode_encode, RawRat.logIntegerLower, hk, + integerBinaryCode] + +@[simp] theorem machineDirectedLogIntegerUpperCode_encode (q : ℚ) (N : ℕ) : + machineDirectedLogIntegerUpperCode + (pair (List.replicate N true) (rawRatBinaryCode (rawRatOfRat q))) = + rawRatBinaryCode (RawRat.logIntegerUpper q N) := by + cases hk : binaryRationalBinaryExponent q with + | ofNat k => + simp [machineDirectedLogIntegerUpperCode, + machineDirectedLogTwoInput_encode, + machineDirectedLogExponentIntegerCode_encode, + machineDirectedLogExponentRawRatCode_encode, + machineDirectedLogTwoLowerRawCode_encode, + machineDirectedLogTwoUpperRawCode_encode, + machineRawRatMulCode_encode, RawRat.logIntegerUpper, hk, + integerBinaryCode] + | negSucc k => + simp [machineDirectedLogIntegerUpperCode, + machineDirectedLogTwoInput_encode, + machineDirectedLogExponentIntegerCode_encode, + machineDirectedLogExponentRawRatCode_encode, + machineDirectedLogTwoLowerRawCode_encode, + machineDirectedLogTwoUpperRawCode_encode, + machineRawRatMulCode_encode, RawRat.logIntegerUpper, hk, + integerBinaryCode] + +@[simp] theorem machineDirectedLogResidualLowerCode_encode (q : ℚ) (N : ℕ) : + machineDirectedLogResidualLowerCode + (pair (List.replicate N true) (rawRatBinaryCode (rawRatOfRat q))) = + rawRatBinaryCode (RawRat.logResidualLower q N) := by + rw [machineDirectedLogResidualLowerCode] + simp only [machineDirectedLogUnitInput_encode, + machineDirectedLogUnitLowerRawCode_encode, + machineDirectedLogUnitUpperRawCode_encode, + machineDirectedLogResidualAtLeastOne_encode] + by_cases h : 1 ≤ binaryRationalBinaryResidual q + · simp [h, RawRat.logResidualLower] + · rw [show decide (1 ≤ binaryRationalBinaryResidual q) = false by simp [h]] + simp only [machineIfHead_false, machineRawRatNegCode_encode] + simp [RawRat.logResidualLower, h] + +@[simp] theorem machineDirectedLogResidualUpperCode_encode (q : ℚ) (N : ℕ) : + machineDirectedLogResidualUpperCode + (pair (List.replicate N true) (rawRatBinaryCode (rawRatOfRat q))) = + rawRatBinaryCode (RawRat.logResidualUpper q N) := by + rw [machineDirectedLogResidualUpperCode] + simp only [machineDirectedLogUnitInput_encode, + machineDirectedLogUnitLowerRawCode_encode, + machineDirectedLogUnitUpperRawCode_encode, + machineDirectedLogResidualAtLeastOne_encode] + by_cases h : 1 ≤ binaryRationalBinaryResidual q + · simp [h, RawRat.logResidualUpper] + · rw [show decide (1 ≤ binaryRationalBinaryResidual q) = false by simp [h]] + simp only [machineIfHead_false, machineRawRatNegCode_encode] + simp [RawRat.logResidualUpper, h] + +@[simp] theorem machineDirectedLogLowerRawCode_encode (q : ℚ) (N : ℕ) : + machineDirectedLogLowerRawCode + (pair (List.replicate N true) (rawRatBinaryCode (rawRatOfRat q))) = + rawRatBinaryCode (RawRat.logLower q N) := by + rw [machineDirectedLogLowerRawCode] + simp only [machineDirectedLogIntegerLowerCode_encode, + machineDirectedLogResidualLowerCode_encode, + machineRawRatAddCode_encode, RawRat.logLower] + +@[simp] theorem machineDirectedLogUpperRawCode_encode (q : ℚ) (N : ℕ) : + machineDirectedLogUpperRawCode + (pair (List.replicate N true) (rawRatBinaryCode (rawRatOfRat q))) = + rawRatBinaryCode (RawRat.logUpper q N) := by + rw [machineDirectedLogUpperRawCode] + simp only [machineDirectedLogIntegerUpperCode_encode, + machineDirectedLogResidualUpperCode_encode, + machineRawRatAddCode_encode, RawRat.logUpper] + +theorem machineDirectedLogLowerCode_encode (q : ℚ) (N : ℕ) : + machineDirectedLogLowerCode + (pair (List.replicate N true) (rawRatBinaryCode (rawRatOfRat q))) = + rationalBinaryCode (binaryDirectedLogLower q N) := by + rw [machineDirectedLogLowerCode, + machineDirectedLogLowerRawCode_encode, + machineNormalizeRawRatBinaryCode_encode, + binaryNormalizeRawRat_eq_value, RawRat.value_logLower] + +theorem machineDirectedLogUpperCode_encode (q : ℚ) (N : ℕ) : + machineDirectedLogUpperCode + (pair (List.replicate N true) (rawRatBinaryCode (rawRatOfRat q))) = + rationalBinaryCode (binaryDirectedLogUpper q N) := by + rw [machineDirectedLogUpperCode, + machineDirectedLogUpperRawCode_encode, + machineNormalizeRawRatBinaryCode_encode, + binaryNormalizeRawRat_eq_value, RawRat.value_logUpper] + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedNegativeGradientCoordinate.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedNegativeGradientCoordinate.lean new file mode 100644 index 0000000000..17087ec235 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedNegativeGradientCoordinate.lean @@ -0,0 +1,219 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineDirectedNegativeObjectiveCoordinate + +/-! +# Finite-word lower endpoint for one directed Bethe gradient coordinate + +This file compiles the lower endpoint + +`-logUpper(a) + (1+tau) logLower(x) + logLower(1-x) + (2+tau)` + +into an ordinary finite-word machine. It deliberately reuses the canonical +input parser and normalized complement from the objective-coordinate machine, +so the two implementations cannot silently disagree about input layout or +about the representation of `1-x`. +-/ + +namespace BeyondBethe + +open Complexity + +def machineDirectedGradientCoordinateNegLogA + (word : List Bool) : List Bool := + machineRawRatNegCode + (machineDirectedObjectiveCoordinateLogAUpper word) + +def machineDirectedGradientCoordinateScaledLogX + (word : List Bool) : List Bool := + machineRawRatMulCode + (pair (machineDirectedObjectiveCoordinateOnePlusTau word) + (machineDirectedObjectiveCoordinateLogXLower word)) + +def machineDirectedGradientCoordinateLogComplementLower + (word : List Bool) : List Bool := + machineScheduledLogLowerRawCode + (machineDirectedObjectiveCoordinateLogComplementInput word) + +def machineDirectedGradientCoordinateFirstTwo + (word : List Bool) : List Bool := + machineRawRatAddCode + (pair (machineDirectedGradientCoordinateNegLogA word) + (machineDirectedGradientCoordinateScaledLogX word)) + +def machineDirectedGradientCoordinateFirstThree + (word : List Bool) : List Bool := + machineRawRatAddCode + (pair (machineDirectedGradientCoordinateFirstTwo word) + (machineDirectedGradientCoordinateLogComplementLower word)) + +def machineDirectedGradientCoordinateTwoPlusTau + (word : List Bool) : List Bool := + machineRawRatAddCode + (pair (rawRatBinaryCode RawRat.one) + (machineDirectedObjectiveCoordinateOnePlusTau word)) + +def machineDirectedNegativeGradientLowerRawCode + (word : List Bool) : List Bool := + machineRawRatAddCode + (pair (machineDirectedGradientCoordinateFirstThree word) + (machineDirectedGradientCoordinateTwoPlusTau word)) + +theorem machineDirectedGradientCoordinateNegLogA_mem_FP : + machineDirectedGradientCoordinateNegLogA ∈ FP := by + simpa only [machineDirectedGradientCoordinateNegLogA] using + machineCompose_mem_FP machineDirectedObjectiveCoordinateLogAUpper_mem_FP + machineRawRatNegCode_mem_FP + +theorem machineDirectedGradientCoordinateScaledLogX_mem_FP : + machineDirectedGradientCoordinateScaledLogX ∈ FP := by + have hinput := machinePair_mem_FP + machineDirectedObjectiveCoordinateOnePlusTau_mem_FP + machineDirectedObjectiveCoordinateLogXLower_mem_FP + simpa only [machineDirectedGradientCoordinateScaledLogX] using + machineCompose_mem_FP hinput machineRawRatMulCode_mem_FP + +theorem machineDirectedGradientCoordinateLogComplementLower_mem_FP : + machineDirectedGradientCoordinateLogComplementLower ∈ FP := by + simpa only [machineDirectedGradientCoordinateLogComplementLower] using + machineCompose_mem_FP + machineDirectedObjectiveCoordinateLogComplementInput_mem_FP + machineScheduledLogLowerRawCode_mem_FP + +theorem machineDirectedGradientCoordinateFirstTwo_mem_FP : + machineDirectedGradientCoordinateFirstTwo ∈ FP := by + have hinput := machinePair_mem_FP + machineDirectedGradientCoordinateNegLogA_mem_FP + machineDirectedGradientCoordinateScaledLogX_mem_FP + simpa only [machineDirectedGradientCoordinateFirstTwo] using + machineCompose_mem_FP hinput machineRawRatAddCode_mem_FP + +theorem machineDirectedGradientCoordinateFirstThree_mem_FP : + machineDirectedGradientCoordinateFirstThree ∈ FP := by + have hinput := machinePair_mem_FP + machineDirectedGradientCoordinateFirstTwo_mem_FP + machineDirectedGradientCoordinateLogComplementLower_mem_FP + simpa only [machineDirectedGradientCoordinateFirstThree] using + machineCompose_mem_FP hinput machineRawRatAddCode_mem_FP + +theorem machineDirectedGradientCoordinateTwoPlusTau_mem_FP : + machineDirectedGradientCoordinateTwoPlusTau ∈ FP := by + have hinput := machinePair_mem_FP + (machineConst_mem_FP (rawRatBinaryCode RawRat.one)) + machineDirectedObjectiveCoordinateOnePlusTau_mem_FP + simpa only [machineDirectedGradientCoordinateTwoPlusTau] using + machineCompose_mem_FP hinput machineRawRatAddCode_mem_FP + +theorem machineDirectedNegativeGradientLowerRawCode_mem_FP : + machineDirectedNegativeGradientLowerRawCode ∈ FP := by + have hinput := machinePair_mem_FP + machineDirectedGradientCoordinateFirstThree_mem_FP + machineDirectedGradientCoordinateTwoPlusTau_mem_FP + simpa only [machineDirectedNegativeGradientLowerRawCode] using + machineCompose_mem_FP hinput machineRawRatAddCode_mem_FP + +def rawDirectedNegativeGradientLower + (tau a x : ℚ) (p : ℕ) : RawRat := + let rawTau := rawRatOfRat tau + let negLogA := (rawScheduledLogUpper a p).neg + let scaledLogX := (RawRat.one.add rawTau).mul + (rawScheduledLogLower x p) + let logComplement := rawScheduledLogLower (1 - x) p + let twoPlusTau := RawRat.one.add (RawRat.one.add rawTau) + ((negLogA.add scaledLogX).add logComplement).add twoPlusTau + +@[simp] theorem machineDirectedGradientCoordinateNegLogA_encode + (tau a x : ℚ) (p : ℕ) : + machineDirectedGradientCoordinateNegLogA + (machineDirectedObjectiveCoordinateCanonicalWord tau a x p) = + rawRatBinaryCode (rawScheduledLogUpper a p).neg := by + rw [machineDirectedGradientCoordinateNegLogA, + machineDirectedObjectiveCoordinateLogAUpper_encode, + machineRawRatNegCode_encode] + +@[simp] theorem machineDirectedGradientCoordinateScaledLogX_encode + (tau a x : ℚ) (p : ℕ) : + machineDirectedGradientCoordinateScaledLogX + (machineDirectedObjectiveCoordinateCanonicalWord tau a x p) = + rawRatBinaryCode + ((RawRat.one.add (rawRatOfRat tau)).mul + (rawScheduledLogLower x p)) := by + rw [machineDirectedGradientCoordinateScaledLogX, + machineDirectedObjectiveCoordinateOnePlusTau_encode, + machineDirectedObjectiveCoordinateLogXLower_encode, + machineRawRatMulCode_encode] + +@[simp] theorem machineDirectedGradientCoordinateLogComplementLower_encode + (tau a x : ℚ) (p : ℕ) : + machineDirectedGradientCoordinateLogComplementLower + (machineDirectedObjectiveCoordinateCanonicalWord tau a x p) = + rawRatBinaryCode (rawScheduledLogLower (1 - x) p) := by + rw [machineDirectedGradientCoordinateLogComplementLower, + machineDirectedObjectiveCoordinateLogComplementInput, + machineDirectedObjectiveCoordinatePrecision_encode, + machineDirectedObjectiveCoordinateComplement_encode, + machineScheduledLogLowerRawCode_encode] + +@[simp] theorem machineDirectedGradientCoordinateFirstTwo_encode + (tau a x : ℚ) (p : ℕ) : + machineDirectedGradientCoordinateFirstTwo + (machineDirectedObjectiveCoordinateCanonicalWord tau a x p) = + rawRatBinaryCode + ((rawScheduledLogUpper a p).neg.add + ((RawRat.one.add (rawRatOfRat tau)).mul + (rawScheduledLogLower x p))) := by + rw [machineDirectedGradientCoordinateFirstTwo, + machineDirectedGradientCoordinateNegLogA_encode, + machineDirectedGradientCoordinateScaledLogX_encode, + machineRawRatAddCode_encode] + +@[simp] theorem machineDirectedGradientCoordinateFirstThree_encode + (tau a x : ℚ) (p : ℕ) : + machineDirectedGradientCoordinateFirstThree + (machineDirectedObjectiveCoordinateCanonicalWord tau a x p) = + rawRatBinaryCode + (((rawScheduledLogUpper a p).neg.add + ((RawRat.one.add (rawRatOfRat tau)).mul + (rawScheduledLogLower x p))).add + (rawScheduledLogLower (1 - x) p)) := by + rw [machineDirectedGradientCoordinateFirstThree, + machineDirectedGradientCoordinateFirstTwo_encode, + machineDirectedGradientCoordinateLogComplementLower_encode, + machineRawRatAddCode_encode] + +@[simp] theorem machineDirectedGradientCoordinateTwoPlusTau_encode + (tau a x : ℚ) (p : ℕ) : + machineDirectedGradientCoordinateTwoPlusTau + (machineDirectedObjectiveCoordinateCanonicalWord tau a x p) = + rawRatBinaryCode + (RawRat.one.add (RawRat.one.add (rawRatOfRat tau))) := by + rw [machineDirectedGradientCoordinateTwoPlusTau, + machineDirectedObjectiveCoordinateOnePlusTau_encode, + machineRawRatAddCode_encode] + +@[simp] theorem machineDirectedNegativeGradientLowerRawCode_encode + (tau a x : ℚ) (p : ℕ) : + machineDirectedNegativeGradientLowerRawCode + (machineDirectedObjectiveCoordinateCanonicalWord tau a x p) = + rawRatBinaryCode (rawDirectedNegativeGradientLower tau a x p) := by + rw [machineDirectedNegativeGradientLowerRawCode, + machineDirectedGradientCoordinateFirstThree_encode, + machineDirectedGradientCoordinateTwoPlusTau_encode, + machineRawRatAddCode_encode] + rfl + +theorem rawDirectedNegativeGradientLower_value + (tau a x : ℚ) (p : ℕ) : + (rawDirectedNegativeGradientLower tau a x p).value = + directedNegativeGradientLower tau a x p := by + simp [rawDirectedNegativeGradientLower, + directedNegativeGradientLower, RawRat.value_add, RawRat.value_mul, + RawRat.value_neg, RawRat.value_one, rawRatOfRat_value, + rawScheduledLogLower_value, rawScheduledLogUpper_value] + ring + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedNegativeGradientEntry.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedNegativeGradientEntry.lean new file mode 100644 index 0000000000..b3da4857b5 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedNegativeGradientEntry.lean @@ -0,0 +1,164 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineDirectedNegativeGradientCoordinate +import LeanPool.BeyondBethe.BeyondBethe.MachineDirectedNegativeObjectiveSum + +/-! +# Finite-word entries of the directed full gradient + +The adapter in this file adds a queried row and column to the canonical +directed-objective payload. It then reuses the already verified matrix-entry +and affine-entry recovery path of the row-major objective machine and sends +the resulting scalar input to the directed gradient machine. This keeps the +objective and gradient implementations on one common interpretation of `A` +and of the recovered Birkhoff matrix. +-/ + +namespace BeyondBethe + +open Complexity + +def machineDirectedGradientEntryRow (word : List Bool) : List Bool := + machinePairFirst word + +def machineDirectedGradientEntryRest (word : List Bool) : List Bool := + machinePairSecond word + +def machineDirectedGradientEntryColumn (word : List Bool) : List Bool := + machinePairFirst (machineDirectedGradientEntryRest word) + +def machineDirectedGradientEntryPayload (word : List Bool) : List Bool := + machinePairSecond (machineDirectedGradientEntryRest word) + +def machineDirectedGradientEntryAsObjectiveState + (word : List Bool) : List Bool := + machineDirectedObjectiveSumPack + (machineDirectedGradientEntryRow word) + (machineDirectedGradientEntryColumn word) + (rawRatBinaryCode RawRat.zero) [] [false] + (machineDirectedGradientEntryPayload word) + +def machineDirectedGradientEntryScalarInput + (word : List Bool) : List Bool := + machineDirectedObjectiveSumCoordinateInput + (machineDirectedGradientEntryAsObjectiveState word) + +def machineDirectedNegativeGradientEntryRawCode + (word : List Bool) : List Bool := + machineDirectedNegativeGradientLowerRawCode + (machineDirectedGradientEntryScalarInput word) + +theorem machineDirectedGradientEntryRow_mem_FP : + machineDirectedGradientEntryRow ∈ FP := machinePairFirst_mem_FP + +theorem machineDirectedGradientEntryRest_mem_FP : + machineDirectedGradientEntryRest ∈ FP := machinePairSecond_mem_FP + +theorem machineDirectedGradientEntryColumn_mem_FP : + machineDirectedGradientEntryColumn ∈ FP := by + simpa only [machineDirectedGradientEntryColumn] using + machineCompose_mem_FP machineDirectedGradientEntryRest_mem_FP + machinePairFirst_mem_FP + +theorem machineDirectedGradientEntryPayload_mem_FP : + machineDirectedGradientEntryPayload ∈ FP := by + simpa only [machineDirectedGradientEntryPayload] using + machineCompose_mem_FP machineDirectedGradientEntryRest_mem_FP + machinePairSecond_mem_FP + +theorem machineDirectedGradientEntryAsObjectiveState_mem_FP : + machineDirectedGradientEntryAsObjectiveState ∈ FP := by + have hacc : (fun _ : List Bool => rawRatBinaryCode RawRat.zero) ∈ FP := + machineConst_mem_FP _ + have hbound : (fun _ : List Bool => ([] : List Bool)) ∈ FP := + machineConst_mem_FP _ + have hdone : (fun _ : List Bool => [false]) ∈ FP := + machineConst_mem_FP _ + have htail := machinePair_mem_FP hdone + machineDirectedGradientEntryPayload_mem_FP + have hwithBound := machinePair_mem_FP hbound htail + have hwithAcc := machinePair_mem_FP hacc hwithBound + have hwithColumn := machinePair_mem_FP + machineDirectedGradientEntryColumn_mem_FP hwithAcc + simpa only [machineDirectedGradientEntryAsObjectiveState, + machineDirectedObjectiveSumPack] using + machinePair_mem_FP machineDirectedGradientEntryRow_mem_FP hwithColumn + +theorem machineDirectedGradientEntryScalarInput_mem_FP : + machineDirectedGradientEntryScalarInput ∈ FP := by + simpa only [machineDirectedGradientEntryScalarInput] using + machineCompose_mem_FP + machineDirectedGradientEntryAsObjectiveState_mem_FP + machineDirectedObjectiveSumCoordinateInput_mem_FP + +theorem machineDirectedNegativeGradientEntryRawCode_mem_FP : + machineDirectedNegativeGradientEntryRawCode ∈ FP := by + simpa only [machineDirectedNegativeGradientEntryRawCode] using + machineCompose_mem_FP machineDirectedGradientEntryScalarInput_mem_FP + machineDirectedNegativeGradientLowerRawCode_mem_FP + +def machineDirectedGradientEntryCanonicalWord {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p : ℕ) + (i j : Fin (m + 1)) : List Bool := + pair (List.replicate i.1 true) + (pair (List.replicate j.1 true) + (machineDirectedObjectiveSumCanonicalWord tau A y p)) + +@[simp] theorem machineDirectedGradientEntryAsObjectiveState_encode {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p : ℕ) + (i j : Fin (m + 1)) : + machineDirectedGradientEntryAsObjectiveState + (machineDirectedGradientEntryCanonicalWord tau A y p i j) = + machineDirectedObjectiveSumCanonicalState tau A y p i j + RawRat.zero false [] := by + simp [machineDirectedGradientEntryAsObjectiveState, + machineDirectedGradientEntryCanonicalWord, + machineDirectedGradientEntryRow, + machineDirectedGradientEntryColumn, + machineDirectedGradientEntryRest, + machineDirectedGradientEntryPayload, + machineDirectedObjectiveSumCanonicalState] + +@[simp] theorem machineDirectedGradientEntryScalarInput_encode {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p : ℕ) + (i j : Fin (m + 1)) : + machineDirectedGradientEntryScalarInput + (machineDirectedGradientEntryCanonicalWord tau A y p i j) = + machineDirectedObjectiveCoordinateCanonicalWord tau (A i j) + (betheAffineMatrixQ y i j) p := by + rw [machineDirectedGradientEntryScalarInput, + machineDirectedGradientEntryAsObjectiveState_encode, + machineDirectedObjectiveSumCoordinateInput_canonicalState] + +@[simp] theorem machineDirectedNegativeGradientEntryRawCode_encode {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p : ℕ) + (i j : Fin (m + 1)) : + machineDirectedNegativeGradientEntryRawCode + (machineDirectedGradientEntryCanonicalWord tau A y p i j) = + rawRatBinaryCode + (rawDirectedNegativeGradientLower tau (A i j) + (betheAffineMatrixQ y i j) p) := by + rw [machineDirectedNegativeGradientEntryRawCode, + machineDirectedGradientEntryScalarInput_encode, + machineDirectedNegativeGradientLowerRawCode_encode] + +theorem machineDirectedNegativeGradientEntry_value {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p : ℕ) + (i j : Fin (m + 1)) : + (rawDirectedNegativeGradientLower tau (A i j) + (betheAffineMatrixQ y i j) p).value = + directedNegativeGradientLowerMatrix tau A + (betheAffineMatrixQ y) p i j := by + rw [rawDirectedNegativeGradientLower_value] + rfl + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedNegativeObjectiveCoordinate.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedNegativeObjectiveCoordinate.lean new file mode 100644 index 0000000000..d078502a8c --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedNegativeObjectiveCoordinate.lean @@ -0,0 +1,497 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineBetheFloorCutEntry +import LeanPool.BeyondBethe.BeyondBethe.MachineScheduledLog +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalNormalization + +/-! +# Finite-word lower endpoint for one directed Bethe objective coordinate + +This file compiles the three scheduled logarithms and the exact rational +arithmetic in `directedNegativeObjectiveCoordinateLower` into one ordinary +bitstring machine. The complement `1-x` is normalized before it is passed +to the logarithm routine, so the scheduled-log correctness theorem applies +to the canonical reduced rational rather than an unreduced subtraction. +-/ + +namespace BeyondBethe + +open Complexity + +def machineDirectedObjectiveCoordinatePrecision + (word : List Bool) : List Bool := machinePairFirst word + +def machineDirectedObjectiveCoordinateRest + (word : List Bool) : List Bool := machinePairSecond word + +def machineDirectedObjectiveCoordinateTau + (word : List Bool) : List Bool := + machinePairFirst (machineDirectedObjectiveCoordinateRest word) + +def machineDirectedObjectiveCoordinateA + (word : List Bool) : List Bool := + machinePairFirst (machinePairSecond + (machineDirectedObjectiveCoordinateRest word)) + +def machineDirectedObjectiveCoordinateX + (word : List Bool) : List Bool := + machinePairSecond (machinePairSecond + (machineDirectedObjectiveCoordinateRest word)) + +def machineDirectedObjectiveCoordinateComplementRaw + (word : List Bool) : List Bool := + machineRawRatSubCode + (pair (rawRatBinaryCode RawRat.one) + (machineDirectedObjectiveCoordinateX word)) + +def machineDirectedObjectiveCoordinateComplement + (word : List Bool) : List Bool := + machineNormalizeRawRatEntryCode + (machineDirectedObjectiveCoordinateComplementRaw word) + +def machineDirectedObjectiveCoordinateLogAInput + (word : List Bool) : List Bool := + pair (machineDirectedObjectiveCoordinatePrecision word) + (machineDirectedObjectiveCoordinateA word) + +def machineDirectedObjectiveCoordinateLogXInput + (word : List Bool) : List Bool := + pair (machineDirectedObjectiveCoordinatePrecision word) + (machineDirectedObjectiveCoordinateX word) + +def machineDirectedObjectiveCoordinateLogComplementInput + (word : List Bool) : List Bool := + pair (machineDirectedObjectiveCoordinatePrecision word) + (machineDirectedObjectiveCoordinateComplement word) + +def machineDirectedObjectiveCoordinateLogAUpper + (word : List Bool) : List Bool := + machineScheduledLogUpperRawCode + (machineDirectedObjectiveCoordinateLogAInput word) + +def machineDirectedObjectiveCoordinateLogXLower + (word : List Bool) : List Bool := + machineScheduledLogLowerRawCode + (machineDirectedObjectiveCoordinateLogXInput word) + +def machineDirectedObjectiveCoordinateLogComplementUpper + (word : List Bool) : List Bool := + machineScheduledLogUpperRawCode + (machineDirectedObjectiveCoordinateLogComplementInput word) + +def machineDirectedObjectiveCoordinateNegX + (word : List Bool) : List Bool := + machineRawRatNegCode (machineDirectedObjectiveCoordinateX word) + +def machineDirectedObjectiveCoordinateFirstTerm + (word : List Bool) : List Bool := + machineRawRatMulCode + (pair (machineDirectedObjectiveCoordinateNegX word) + (machineDirectedObjectiveCoordinateLogAUpper word)) + +def machineDirectedObjectiveCoordinateOnePlusTau + (word : List Bool) : List Bool := + machineRawRatAddCode + (pair (rawRatBinaryCode RawRat.one) + (machineDirectedObjectiveCoordinateTau word)) + +def machineDirectedObjectiveCoordinateMiddleScale + (word : List Bool) : List Bool := + machineRawRatMulCode + (pair (machineDirectedObjectiveCoordinateOnePlusTau word) + (machineDirectedObjectiveCoordinateX word)) + +def machineDirectedObjectiveCoordinateMiddleTerm + (word : List Bool) : List Bool := + machineRawRatMulCode + (pair (machineDirectedObjectiveCoordinateMiddleScale word) + (machineDirectedObjectiveCoordinateLogXLower word)) + +def machineDirectedObjectiveCoordinateComplementProduct + (word : List Bool) : List Bool := + machineRawRatMulCode + (pair (machineDirectedObjectiveCoordinateComplement word) + (machineDirectedObjectiveCoordinateLogComplementUpper word)) + +def machineDirectedObjectiveCoordinateLastTerm + (word : List Bool) : List Bool := + machineRawRatNegCode + (machineDirectedObjectiveCoordinateComplementProduct word) + +def machineDirectedObjectiveCoordinateFirstTwo + (word : List Bool) : List Bool := + machineRawRatAddCode + (pair (machineDirectedObjectiveCoordinateFirstTerm word) + (machineDirectedObjectiveCoordinateMiddleTerm word)) + +def machineDirectedNegativeObjectiveCoordinateLowerRawCode + (word : List Bool) : List Bool := + machineRawRatAddCode + (pair (machineDirectedObjectiveCoordinateFirstTwo word) + (machineDirectedObjectiveCoordinateLastTerm word)) + +theorem machineDirectedObjectiveCoordinatePrecision_mem_FP : + machineDirectedObjectiveCoordinatePrecision ∈ FP := machinePairFirst_mem_FP + +theorem machineDirectedObjectiveCoordinateRest_mem_FP : + machineDirectedObjectiveCoordinateRest ∈ FP := machinePairSecond_mem_FP + +theorem machineDirectedObjectiveCoordinateTau_mem_FP : + machineDirectedObjectiveCoordinateTau ∈ FP := by + simpa only [machineDirectedObjectiveCoordinateTau] using + machineCompose_mem_FP machineDirectedObjectiveCoordinateRest_mem_FP + machinePairFirst_mem_FP + +theorem machineDirectedObjectiveCoordinateA_mem_FP : + machineDirectedObjectiveCoordinateA ∈ FP := by + have htail := machineCompose_mem_FP + machineDirectedObjectiveCoordinateRest_mem_FP machinePairSecond_mem_FP + simpa only [machineDirectedObjectiveCoordinateA] using + machineCompose_mem_FP htail machinePairFirst_mem_FP + +theorem machineDirectedObjectiveCoordinateX_mem_FP : + machineDirectedObjectiveCoordinateX ∈ FP := by + have htail := machineCompose_mem_FP + machineDirectedObjectiveCoordinateRest_mem_FP machinePairSecond_mem_FP + simpa only [machineDirectedObjectiveCoordinateX] using + machineCompose_mem_FP htail machinePairSecond_mem_FP + +theorem machineDirectedObjectiveCoordinateComplementRaw_mem_FP : + machineDirectedObjectiveCoordinateComplementRaw ∈ FP := by + have hinput := machinePair_mem_FP + (machineConst_mem_FP (rawRatBinaryCode RawRat.one)) + machineDirectedObjectiveCoordinateX_mem_FP + simpa only [machineDirectedObjectiveCoordinateComplementRaw] using + machineCompose_mem_FP hinput machineRawRatSubCode_mem_FP + +theorem machineDirectedObjectiveCoordinateComplement_mem_FP : + machineDirectedObjectiveCoordinateComplement ∈ FP := by + simpa only [machineDirectedObjectiveCoordinateComplement] using + machineCompose_mem_FP + machineDirectedObjectiveCoordinateComplementRaw_mem_FP + machineNormalizeRawRatEntryCode_mem_FP + +theorem machineDirectedObjectiveCoordinateLogAInput_mem_FP : + machineDirectedObjectiveCoordinateLogAInput ∈ FP := + machinePair_mem_FP machineDirectedObjectiveCoordinatePrecision_mem_FP + machineDirectedObjectiveCoordinateA_mem_FP + +theorem machineDirectedObjectiveCoordinateLogXInput_mem_FP : + machineDirectedObjectiveCoordinateLogXInput ∈ FP := + machinePair_mem_FP machineDirectedObjectiveCoordinatePrecision_mem_FP + machineDirectedObjectiveCoordinateX_mem_FP + +theorem machineDirectedObjectiveCoordinateLogComplementInput_mem_FP : + machineDirectedObjectiveCoordinateLogComplementInput ∈ FP := + machinePair_mem_FP machineDirectedObjectiveCoordinatePrecision_mem_FP + machineDirectedObjectiveCoordinateComplement_mem_FP + +theorem machineDirectedObjectiveCoordinateLogAUpper_mem_FP : + machineDirectedObjectiveCoordinateLogAUpper ∈ FP := by + simpa only [machineDirectedObjectiveCoordinateLogAUpper] using + machineCompose_mem_FP machineDirectedObjectiveCoordinateLogAInput_mem_FP + machineScheduledLogUpperRawCode_mem_FP + +theorem machineDirectedObjectiveCoordinateLogXLower_mem_FP : + machineDirectedObjectiveCoordinateLogXLower ∈ FP := by + simpa only [machineDirectedObjectiveCoordinateLogXLower] using + machineCompose_mem_FP machineDirectedObjectiveCoordinateLogXInput_mem_FP + machineScheduledLogLowerRawCode_mem_FP + +theorem machineDirectedObjectiveCoordinateLogComplementUpper_mem_FP : + machineDirectedObjectiveCoordinateLogComplementUpper ∈ FP := by + simpa only [machineDirectedObjectiveCoordinateLogComplementUpper] using + machineCompose_mem_FP + machineDirectedObjectiveCoordinateLogComplementInput_mem_FP + machineScheduledLogUpperRawCode_mem_FP + +theorem machineDirectedObjectiveCoordinateNegX_mem_FP : + machineDirectedObjectiveCoordinateNegX ∈ FP := by + simpa only [machineDirectedObjectiveCoordinateNegX] using + machineCompose_mem_FP machineDirectedObjectiveCoordinateX_mem_FP + machineRawRatNegCode_mem_FP + +theorem machineDirectedObjectiveCoordinateFirstTerm_mem_FP : + machineDirectedObjectiveCoordinateFirstTerm ∈ FP := by + have hinput := machinePair_mem_FP + machineDirectedObjectiveCoordinateNegX_mem_FP + machineDirectedObjectiveCoordinateLogAUpper_mem_FP + simpa only [machineDirectedObjectiveCoordinateFirstTerm] using + machineCompose_mem_FP hinput machineRawRatMulCode_mem_FP + +theorem machineDirectedObjectiveCoordinateOnePlusTau_mem_FP : + machineDirectedObjectiveCoordinateOnePlusTau ∈ FP := by + have hinput := machinePair_mem_FP + (machineConst_mem_FP (rawRatBinaryCode RawRat.one)) + machineDirectedObjectiveCoordinateTau_mem_FP + simpa only [machineDirectedObjectiveCoordinateOnePlusTau] using + machineCompose_mem_FP hinput machineRawRatAddCode_mem_FP + +theorem machineDirectedObjectiveCoordinateMiddleScale_mem_FP : + machineDirectedObjectiveCoordinateMiddleScale ∈ FP := by + have hinput := machinePair_mem_FP + machineDirectedObjectiveCoordinateOnePlusTau_mem_FP + machineDirectedObjectiveCoordinateX_mem_FP + simpa only [machineDirectedObjectiveCoordinateMiddleScale] using + machineCompose_mem_FP hinput machineRawRatMulCode_mem_FP + +theorem machineDirectedObjectiveCoordinateMiddleTerm_mem_FP : + machineDirectedObjectiveCoordinateMiddleTerm ∈ FP := by + have hinput := machinePair_mem_FP + machineDirectedObjectiveCoordinateMiddleScale_mem_FP + machineDirectedObjectiveCoordinateLogXLower_mem_FP + simpa only [machineDirectedObjectiveCoordinateMiddleTerm] using + machineCompose_mem_FP hinput machineRawRatMulCode_mem_FP + +theorem machineDirectedObjectiveCoordinateComplementProduct_mem_FP : + machineDirectedObjectiveCoordinateComplementProduct ∈ FP := by + have hinput := machinePair_mem_FP + machineDirectedObjectiveCoordinateComplement_mem_FP + machineDirectedObjectiveCoordinateLogComplementUpper_mem_FP + simpa only [machineDirectedObjectiveCoordinateComplementProduct] using + machineCompose_mem_FP hinput machineRawRatMulCode_mem_FP + +theorem machineDirectedObjectiveCoordinateLastTerm_mem_FP : + machineDirectedObjectiveCoordinateLastTerm ∈ FP := by + simpa only [machineDirectedObjectiveCoordinateLastTerm] using + machineCompose_mem_FP + machineDirectedObjectiveCoordinateComplementProduct_mem_FP + machineRawRatNegCode_mem_FP + +theorem machineDirectedObjectiveCoordinateFirstTwo_mem_FP : + machineDirectedObjectiveCoordinateFirstTwo ∈ FP := by + have hinput := machinePair_mem_FP + machineDirectedObjectiveCoordinateFirstTerm_mem_FP + machineDirectedObjectiveCoordinateMiddleTerm_mem_FP + simpa only [machineDirectedObjectiveCoordinateFirstTwo] using + machineCompose_mem_FP hinput machineRawRatAddCode_mem_FP + +theorem machineDirectedNegativeObjectiveCoordinateLowerRawCode_mem_FP : + machineDirectedNegativeObjectiveCoordinateLowerRawCode ∈ FP := by + have hinput := machinePair_mem_FP + machineDirectedObjectiveCoordinateFirstTwo_mem_FP + machineDirectedObjectiveCoordinateLastTerm_mem_FP + simpa only [machineDirectedNegativeObjectiveCoordinateLowerRawCode] using + machineCompose_mem_FP hinput machineRawRatAddCode_mem_FP + +def machineDirectedObjectiveCoordinateCanonicalWord + (tau a x : ℚ) (p : ℕ) : List Bool := + pair (List.replicate p true) + (pair (rawRatBinaryCode (rawRatOfRat tau)) + (pair (rawRatBinaryCode (rawRatOfRat a)) + (rawRatBinaryCode (rawRatOfRat x)))) + +def rawDirectedNegativeObjectiveCoordinateLower + (tau a x : ℚ) (p : ℕ) : RawRat := + let rawTau := rawRatOfRat tau + let rawX := rawRatOfRat x + let rawComplement := rawRatOfRat (1 - x) + let first := rawX.neg.mul (rawScheduledLogUpper a p) + let middle := (RawRat.one.add rawTau).mul rawX |>.mul + (rawScheduledLogLower x p) + let last := (rawComplement.mul + (rawScheduledLogUpper (1 - x) p)).neg + (first.add middle).add last + +@[simp] theorem machineDirectedObjectiveCoordinatePrecision_encode + (tau a x : ℚ) (p : ℕ) : + machineDirectedObjectiveCoordinatePrecision + (machineDirectedObjectiveCoordinateCanonicalWord tau a x p) = + List.replicate p true := by + simp [machineDirectedObjectiveCoordinatePrecision, + machineDirectedObjectiveCoordinateCanonicalWord] + +@[simp] theorem machineDirectedObjectiveCoordinateTau_encode + (tau a x : ℚ) (p : ℕ) : + machineDirectedObjectiveCoordinateTau + (machineDirectedObjectiveCoordinateCanonicalWord tau a x p) = + rawRatBinaryCode (rawRatOfRat tau) := by + simp [machineDirectedObjectiveCoordinateTau, + machineDirectedObjectiveCoordinateRest, + machineDirectedObjectiveCoordinateCanonicalWord] + +@[simp] theorem machineDirectedObjectiveCoordinateA_encode + (tau a x : ℚ) (p : ℕ) : + machineDirectedObjectiveCoordinateA + (machineDirectedObjectiveCoordinateCanonicalWord tau a x p) = + rawRatBinaryCode (rawRatOfRat a) := by + simp [machineDirectedObjectiveCoordinateA, + machineDirectedObjectiveCoordinateRest, + machineDirectedObjectiveCoordinateCanonicalWord] + +@[simp] theorem machineDirectedObjectiveCoordinateX_encode + (tau a x : ℚ) (p : ℕ) : + machineDirectedObjectiveCoordinateX + (machineDirectedObjectiveCoordinateCanonicalWord tau a x p) = + rawRatBinaryCode (rawRatOfRat x) := by + simp [machineDirectedObjectiveCoordinateX, + machineDirectedObjectiveCoordinateRest, + machineDirectedObjectiveCoordinateCanonicalWord] + +@[simp] theorem machineDirectedObjectiveCoordinateComplement_encode + (tau a x : ℚ) (p : ℕ) : + machineDirectedObjectiveCoordinateComplement + (machineDirectedObjectiveCoordinateCanonicalWord tau a x p) = + rawRatBinaryCode (rawRatOfRat (1 - x)) := by + rw [machineDirectedObjectiveCoordinateComplement, + machineDirectedObjectiveCoordinateComplementRaw, + machineDirectedObjectiveCoordinateX, + machineDirectedObjectiveCoordinateRest, + machineDirectedObjectiveCoordinateCanonicalWord] + simp only [machinePairSecond_pair, + machineRawRatSubCode_encode, + machineNormalizeRawRatEntryCode_encode] + rw [rawRatBinaryCode_rawRatOfRat] + congr 1 + simp [binaryNormalizeRawRat_eq_value, RawRat.value_sub, + rawRatOfRat_value] + +@[simp] theorem machineDirectedObjectiveCoordinateLogAUpper_encode + (tau a x : ℚ) (p : ℕ) : + machineDirectedObjectiveCoordinateLogAUpper + (machineDirectedObjectiveCoordinateCanonicalWord tau a x p) = + rawRatBinaryCode (rawScheduledLogUpper a p) := by + rw [machineDirectedObjectiveCoordinateLogAUpper, + machineDirectedObjectiveCoordinateLogAInput, + machineDirectedObjectiveCoordinatePrecision_encode, + machineDirectedObjectiveCoordinateA_encode, + machineScheduledLogUpperRawCode_encode] + +@[simp] theorem machineDirectedObjectiveCoordinateLogXLower_encode + (tau a x : ℚ) (p : ℕ) : + machineDirectedObjectiveCoordinateLogXLower + (machineDirectedObjectiveCoordinateCanonicalWord tau a x p) = + rawRatBinaryCode (rawScheduledLogLower x p) := by + rw [machineDirectedObjectiveCoordinateLogXLower, + machineDirectedObjectiveCoordinateLogXInput, + machineDirectedObjectiveCoordinatePrecision_encode, + machineDirectedObjectiveCoordinateX_encode, + machineScheduledLogLowerRawCode_encode] + +@[simp] theorem machineDirectedObjectiveCoordinateLogComplementUpper_encode + (tau a x : ℚ) (p : ℕ) : + machineDirectedObjectiveCoordinateLogComplementUpper + (machineDirectedObjectiveCoordinateCanonicalWord tau a x p) = + rawRatBinaryCode (rawScheduledLogUpper (1 - x) p) := by + rw [machineDirectedObjectiveCoordinateLogComplementUpper, + machineDirectedObjectiveCoordinateLogComplementInput, + machineDirectedObjectiveCoordinatePrecision_encode, + machineDirectedObjectiveCoordinateComplement_encode, + machineScheduledLogUpperRawCode_encode] + +@[simp] theorem machineDirectedObjectiveCoordinateNegX_encode + (tau a x : ℚ) (p : ℕ) : + machineDirectedObjectiveCoordinateNegX + (machineDirectedObjectiveCoordinateCanonicalWord tau a x p) = + rawRatBinaryCode (rawRatOfRat x).neg := by + rw [machineDirectedObjectiveCoordinateNegX, + machineDirectedObjectiveCoordinateX_encode, + machineRawRatNegCode_encode] + +@[simp] theorem machineDirectedObjectiveCoordinateFirstTerm_encode + (tau a x : ℚ) (p : ℕ) : + machineDirectedObjectiveCoordinateFirstTerm + (machineDirectedObjectiveCoordinateCanonicalWord tau a x p) = + rawRatBinaryCode + ((rawRatOfRat x).neg.mul (rawScheduledLogUpper a p)) := by + rw [machineDirectedObjectiveCoordinateFirstTerm, + machineDirectedObjectiveCoordinateNegX_encode, + machineDirectedObjectiveCoordinateLogAUpper_encode, + machineRawRatMulCode_encode] + +@[simp] theorem machineDirectedObjectiveCoordinateOnePlusTau_encode + (tau a x : ℚ) (p : ℕ) : + machineDirectedObjectiveCoordinateOnePlusTau + (machineDirectedObjectiveCoordinateCanonicalWord tau a x p) = + rawRatBinaryCode (RawRat.one.add (rawRatOfRat tau)) := by + rw [machineDirectedObjectiveCoordinateOnePlusTau, + machineDirectedObjectiveCoordinateTau_encode, + machineRawRatAddCode_encode] + +@[simp] theorem machineDirectedObjectiveCoordinateMiddleScale_encode + (tau a x : ℚ) (p : ℕ) : + machineDirectedObjectiveCoordinateMiddleScale + (machineDirectedObjectiveCoordinateCanonicalWord tau a x p) = + rawRatBinaryCode + ((RawRat.one.add (rawRatOfRat tau)).mul (rawRatOfRat x)) := by + rw [machineDirectedObjectiveCoordinateMiddleScale, + machineDirectedObjectiveCoordinateOnePlusTau_encode, + machineDirectedObjectiveCoordinateX_encode, + machineRawRatMulCode_encode] + +@[simp] theorem machineDirectedObjectiveCoordinateMiddleTerm_encode + (tau a x : ℚ) (p : ℕ) : + machineDirectedObjectiveCoordinateMiddleTerm + (machineDirectedObjectiveCoordinateCanonicalWord tau a x p) = + rawRatBinaryCode + (((RawRat.one.add (rawRatOfRat tau)).mul (rawRatOfRat x)).mul + (rawScheduledLogLower x p)) := by + rw [machineDirectedObjectiveCoordinateMiddleTerm, + machineDirectedObjectiveCoordinateMiddleScale_encode, + machineDirectedObjectiveCoordinateLogXLower_encode, + machineRawRatMulCode_encode] + +@[simp] theorem machineDirectedObjectiveCoordinateComplementProduct_encode + (tau a x : ℚ) (p : ℕ) : + machineDirectedObjectiveCoordinateComplementProduct + (machineDirectedObjectiveCoordinateCanonicalWord tau a x p) = + rawRatBinaryCode + ((rawRatOfRat (1 - x)).mul + (rawScheduledLogUpper (1 - x) p)) := by + rw [machineDirectedObjectiveCoordinateComplementProduct, + machineDirectedObjectiveCoordinateComplement_encode, + machineDirectedObjectiveCoordinateLogComplementUpper_encode, + machineRawRatMulCode_encode] + +@[simp] theorem machineDirectedObjectiveCoordinateLastTerm_encode + (tau a x : ℚ) (p : ℕ) : + machineDirectedObjectiveCoordinateLastTerm + (machineDirectedObjectiveCoordinateCanonicalWord tau a x p) = + rawRatBinaryCode + ((rawRatOfRat (1 - x)).mul + (rawScheduledLogUpper (1 - x) p)).neg := by + rw [machineDirectedObjectiveCoordinateLastTerm, + machineDirectedObjectiveCoordinateComplementProduct_encode, + machineRawRatNegCode_encode] + +@[simp] theorem machineDirectedObjectiveCoordinateFirstTwo_encode + (tau a x : ℚ) (p : ℕ) : + machineDirectedObjectiveCoordinateFirstTwo + (machineDirectedObjectiveCoordinateCanonicalWord tau a x p) = + rawRatBinaryCode + (((rawRatOfRat x).neg.mul (rawScheduledLogUpper a p)).add + (((RawRat.one.add (rawRatOfRat tau)).mul (rawRatOfRat x)).mul + (rawScheduledLogLower x p))) := by + rw [machineDirectedObjectiveCoordinateFirstTwo, + machineDirectedObjectiveCoordinateFirstTerm_encode, + machineDirectedObjectiveCoordinateMiddleTerm_encode, + machineRawRatAddCode_encode] + +@[simp] theorem machineDirectedNegativeObjectiveCoordinateLowerRawCode_encode + (tau a x : ℚ) (p : ℕ) : + machineDirectedNegativeObjectiveCoordinateLowerRawCode + (machineDirectedObjectiveCoordinateCanonicalWord tau a x p) = + rawRatBinaryCode + (rawDirectedNegativeObjectiveCoordinateLower tau a x p) := by + rw [machineDirectedNegativeObjectiveCoordinateLowerRawCode, + machineDirectedObjectiveCoordinateFirstTwo_encode, + machineDirectedObjectiveCoordinateLastTerm_encode, + machineRawRatAddCode_encode] + rfl + +theorem rawDirectedNegativeObjectiveCoordinateLower_value + (tau a x : ℚ) (p : ℕ) : + (rawDirectedNegativeObjectiveCoordinateLower tau a x p).value = + directedNegativeObjectiveCoordinateLower tau a x p := by + simp [rawDirectedNegativeObjectiveCoordinateLower, + directedNegativeObjectiveCoordinateLower, + RawRat.value_add, RawRat.value_mul, RawRat.value_neg, + RawRat.value_one, rawRatOfRat_value, + rawScheduledLogLower_value, rawScheduledLogUpper_value] + ring + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedNegativeObjectiveSum.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedNegativeObjectiveSum.lean new file mode 100644 index 0000000000..c5508d1adc --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedNegativeObjectiveSum.lean @@ -0,0 +1,2472 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineDirectedNegativeObjectiveCoordinate +import LeanPool.BeyondBethe.BeyondBethe.MachineBetheFloorScan +import LeanPool.BeyondBethe.BeyondBethe.MachineListIndex +import LeanPool.BeyondBethe.BeyondBethe.MachineScheduledLogWidth +import LeanPool.BeyondBethe.BeyondBethe.MachineCertificateExpGuard + +/-! +# Finite-word evaluation of the complete directed Bethe objective + +This module scans all `(m+1)^2` recovered Birkhoff entries in row-major +order. At each entry it reads the corresponding input-matrix coordinate, +recovers and normalizes the affine Birkhoff coordinate, invokes the directed +coordinate evaluator, and adds its rational lower endpoint to an unreduced +accumulator. + +The concrete state machine is total on arbitrary bitstrings. Its counters +and accumulator are clamped by an explicit polynomial word. The semantic +proof below is kept separate from this global finite-word bound; on canonical +inputs the clamp is proved inactive. +-/ + +namespace BeyondBethe + +open Complexity + +/-! ## Public input layout -/ + +/-- Input layout: +`pair mUnary (pair precisionUnary (pair tauRaw (pair matrixCode yCode)))`. -/ +def machineDirectedObjectiveSumDimension (word : List Bool) : List Bool := + machinePairFirst word + +def machineDirectedObjectiveSumRest (word : List Bool) : List Bool := + machinePairSecond word + +def machineDirectedObjectiveSumPrecision (word : List Bool) : List Bool := + machinePairFirst (machineDirectedObjectiveSumRest word) + +def machineDirectedObjectiveSumAfterPrecision (word : List Bool) : List Bool := + machinePairSecond (machineDirectedObjectiveSumRest word) + +def machineDirectedObjectiveSumTau (word : List Bool) : List Bool := + machinePairFirst (machineDirectedObjectiveSumAfterPrecision word) + +def machineDirectedObjectiveSumAfterTau (word : List Bool) : List Bool := + machinePairSecond (machineDirectedObjectiveSumAfterPrecision word) + +def machineDirectedObjectiveSumMatrix (word : List Bool) : List Bool := + machinePairFirst (machineDirectedObjectiveSumAfterTau word) + +def machineDirectedObjectiveSumVector (word : List Bool) : List Bool := + machinePairSecond (machineDirectedObjectiveSumAfterTau word) + +/-! ## Row-major state and one coordinate evaluation -/ + +def machineDirectedObjectiveSumPack + (row column acc bound done payload : List Bool) : List Bool := + pair row (pair column (pair acc (pair bound (pair done payload)))) + +def machineDirectedObjectiveSumRow (state : List Bool) : List Bool := + machinePairFirst state + +def machineDirectedObjectiveSumColumn (state : List Bool) : List Bool := + machinePairFirst (machinePairSecond state) + +def machineDirectedObjectiveSumAcc (state : List Bool) : List Bool := + machinePairFirst (machinePairSecond (machinePairSecond state)) + +def machineDirectedObjectiveSumBound (state : List Bool) : List Bool := + machinePairFirst + (machinePairSecond (machinePairSecond (machinePairSecond state))) + +def machineDirectedObjectiveSumDone (state : List Bool) : List Bool := + machinePairFirst + (machinePairSecond + (machinePairSecond (machinePairSecond (machinePairSecond state)))) + +def machineDirectedObjectiveSumPayload (state : List Bool) : List Bool := + machinePairSecond + (machinePairSecond + (machinePairSecond (machinePairSecond (machinePairSecond state)))) + +def machineDirectedObjectiveSumStateDimension + (state : List Bool) : List Bool := + machineDirectedObjectiveSumDimension + (machineDirectedObjectiveSumPayload state) + +def machineDirectedObjectiveSumStatePrecision + (state : List Bool) : List Bool := + machineDirectedObjectiveSumPrecision + (machineDirectedObjectiveSumPayload state) + +def machineDirectedObjectiveSumStateTau + (state : List Bool) : List Bool := + machineDirectedObjectiveSumTau + (machineDirectedObjectiveSumPayload state) + +def machineDirectedObjectiveSumStateMatrix + (state : List Bool) : List Bool := + machineDirectedObjectiveSumMatrix + (machineDirectedObjectiveSumPayload state) + +def machineDirectedObjectiveSumStateVector + (state : List Bool) : List Bool := + machineDirectedObjectiveSumVector + (machineDirectedObjectiveSumPayload state) + +def machineDirectedObjectiveSumLastRowBit (state : List Bool) : List Bool := + machineUnaryRulersEqualBit (machineDirectedObjectiveSumRow state) + (machineDirectedObjectiveSumStateDimension state) + +def machineDirectedObjectiveSumLastColumnBit + (state : List Bool) : List Bool := + machineUnaryRulersEqualBit (machineDirectedObjectiveSumColumn state) + (machineDirectedObjectiveSumStateDimension state) + +def machineDirectedObjectiveSumMatrixEntryInput + (state : List Bool) : List Bool := + pair (machineDirectedObjectiveSumRow state) + (pair (machineDirectedObjectiveSumColumn state) + (machineDirectedObjectiveSumStateMatrix state)) + +def machineDirectedObjectiveSumMatrixEntryRaw + (state : List Bool) : List Bool := + machineNormalizeRawRatEntryCode + (machineMatrixEntryAtUnary + (machineDirectedObjectiveSumMatrixEntryInput state)) + +def machineDirectedObjectiveSumAffineEntryInput + (state : List Bool) : List Bool := + pair (machineDirectedObjectiveSumStateDimension state) + (pair (machineDirectedObjectiveSumRow state) + (pair (machineDirectedObjectiveSumColumn state) + (machineDirectedObjectiveSumStateVector state))) + +def machineDirectedObjectiveSumAffineEntryRaw + (state : List Bool) : List Bool := + machineNormalizeRawRatEntryCode + (machineBetheAffineEntryRawCode + (machineDirectedObjectiveSumAffineEntryInput state)) + +def machineDirectedObjectiveSumCoordinateInput + (state : List Bool) : List Bool := + pair (machineDirectedObjectiveSumStatePrecision state) + (pair (machineDirectedObjectiveSumStateTau state) + (pair (machineDirectedObjectiveSumMatrixEntryRaw state) + (machineDirectedObjectiveSumAffineEntryRaw state))) + +def machineDirectedObjectiveSumCoordinateRawCode + (state : List Bool) : List Bool := + machineDirectedNegativeObjectiveCoordinateLowerRawCode + (machineDirectedObjectiveSumCoordinateInput state) + +def machineDirectedObjectiveSumCandidate (state : List Bool) : List Bool := + machineRawRatAddCode + (pair (machineDirectedObjectiveSumAcc state) + (machineDirectedObjectiveSumCoordinateRawCode state)) + +def machineDirectedObjectiveSumNextAcc (state : List Bool) : List Bool := + (machineDirectedObjectiveSumCandidate state).take + (machineDirectedObjectiveSumBound state).length + +def machineDirectedObjectiveSumNextRow (state : List Bool) : List Bool := + (machineDirectedObjectiveSumRow state ++ [true]).take + (machineDirectedObjectiveSumBound state).length + +def machineDirectedObjectiveSumNextColumn (state : List Bool) : List Bool := + (machineDirectedObjectiveSumColumn state ++ [true]).take + (machineDirectedObjectiveSumBound state).length + +def machineDirectedObjectiveSumFinish (state : List Bool) : List Bool := + machineDirectedObjectiveSumPack + (machineDirectedObjectiveSumRow state) + (machineDirectedObjectiveSumColumn state) + (machineDirectedObjectiveSumNextAcc state) + (machineDirectedObjectiveSumBound state) [true] + (machineDirectedObjectiveSumPayload state) + +def machineDirectedObjectiveSumAdvanceRow (state : List Bool) : List Bool := + machineDirectedObjectiveSumPack + (machineDirectedObjectiveSumNextRow state) [] + (machineDirectedObjectiveSumNextAcc state) + (machineDirectedObjectiveSumBound state) + (machineDirectedObjectiveSumDone state) + (machineDirectedObjectiveSumPayload state) + +def machineDirectedObjectiveSumAdvanceColumn + (state : List Bool) : List Bool := + machineDirectedObjectiveSumPack + (machineDirectedObjectiveSumRow state) + (machineDirectedObjectiveSumNextColumn state) + (machineDirectedObjectiveSumNextAcc state) + (machineDirectedObjectiveSumBound state) + (machineDirectedObjectiveSumDone state) + (machineDirectedObjectiveSumPayload state) + +def machineDirectedObjectiveSumProcess (state : List Bool) : List Bool := + machineIfHead (machineHeadBit + (machineDirectedObjectiveSumLastColumnBit state)) + (machineIfHead (machineHeadBit + (machineDirectedObjectiveSumLastRowBit state)) + (machineDirectedObjectiveSumFinish state) + (machineDirectedObjectiveSumAdvanceRow state)) + (machineDirectedObjectiveSumAdvanceColumn state) + +def machineDirectedObjectiveSumStep (state : List Bool) : List Bool := + machineIfHead (machineHeadBit (machineDirectedObjectiveSumDone state)) + state (machineDirectedObjectiveSumProcess state) + +/-! ## Explicit iteration and state bounds -/ + +def machineDirectedObjectiveSumAccumulatorBound + (word : List Bool) : List Bool := + machineIteratedBinaryWidth 6 word + +def machineDirectedObjectiveSumStateEnvelope + (word : List Bool) : List Bool := + machineIteratedBinaryWidth 7 word + +def machineDirectedObjectiveSumInit (word : List Bool) : List Bool := + machineDirectedObjectiveSumPack [] [] + (rawRatBinaryCode RawRat.zero) + (machineDirectedObjectiveSumAccumulatorBound word) [false] word + +/-- The floor scanner already provides the exact bounded-unary construction +for `(m+1)^2`; it depends only on the first component of the word. -/ +def machineDirectedObjectiveSumRuler (word : List Bool) : List Bool := + machineBetheFloorScanRuler word + +def machineDirectedObjectiveSumWidth (word : List Bool) : List Bool := + let envelope := machineDirectedObjectiveSumStateEnvelope word + machineDirectedObjectiveSumPack envelope envelope envelope envelope + envelope envelope + +def machineDirectedObjectiveSumFinalState (word : List Bool) : List Bool := + (machineDirectedObjectiveSumStep)^[(machineDirectedObjectiveSumRuler word).length] + (machineDirectedObjectiveSumInit word) + +def machineDirectedNegativeObjectiveSumRawCode + (word : List Bool) : List Bool := + machineDirectedObjectiveSumAcc + (machineDirectedObjectiveSumFinalState word) + +/-! ## Polynomial-time closure -/ + +theorem machineDirectedObjectiveSumDimension_mem_FP : + machineDirectedObjectiveSumDimension ∈ FP := machinePairFirst_mem_FP + +theorem machineDirectedObjectiveSumRest_mem_FP : + machineDirectedObjectiveSumRest ∈ FP := machinePairSecond_mem_FP + +theorem machineDirectedObjectiveSumPrecision_mem_FP : + machineDirectedObjectiveSumPrecision ∈ FP := by + simpa only [machineDirectedObjectiveSumPrecision] using + machineCompose_mem_FP machineDirectedObjectiveSumRest_mem_FP + machinePairFirst_mem_FP + +theorem machineDirectedObjectiveSumAfterPrecision_mem_FP : + machineDirectedObjectiveSumAfterPrecision ∈ FP := by + simpa only [machineDirectedObjectiveSumAfterPrecision] using + machineCompose_mem_FP machineDirectedObjectiveSumRest_mem_FP + machinePairSecond_mem_FP + +theorem machineDirectedObjectiveSumTau_mem_FP : + machineDirectedObjectiveSumTau ∈ FP := by + simpa only [machineDirectedObjectiveSumTau] using + machineCompose_mem_FP machineDirectedObjectiveSumAfterPrecision_mem_FP + machinePairFirst_mem_FP + +theorem machineDirectedObjectiveSumAfterTau_mem_FP : + machineDirectedObjectiveSumAfterTau ∈ FP := by + simpa only [machineDirectedObjectiveSumAfterTau] using + machineCompose_mem_FP machineDirectedObjectiveSumAfterPrecision_mem_FP + machinePairSecond_mem_FP + +theorem machineDirectedObjectiveSumMatrix_mem_FP : + machineDirectedObjectiveSumMatrix ∈ FP := by + simpa only [machineDirectedObjectiveSumMatrix] using + machineCompose_mem_FP machineDirectedObjectiveSumAfterTau_mem_FP + machinePairFirst_mem_FP + +theorem machineDirectedObjectiveSumVector_mem_FP : + machineDirectedObjectiveSumVector ∈ FP := by + simpa only [machineDirectedObjectiveSumVector] using + machineCompose_mem_FP machineDirectedObjectiveSumAfterTau_mem_FP + machinePairSecond_mem_FP + +theorem machineDirectedObjectiveSumRow_mem_FP : + machineDirectedObjectiveSumRow ∈ FP := machinePairFirst_mem_FP + +theorem machineDirectedObjectiveSumColumn_mem_FP : + machineDirectedObjectiveSumColumn ∈ FP := by + simpa only [machineDirectedObjectiveSumColumn] using + machineCompose_mem_FP machinePairSecond_mem_FP machinePairFirst_mem_FP + +theorem machineDirectedObjectiveSumAcc_mem_FP : + machineDirectedObjectiveSumAcc ∈ FP := by + have htail := machineCompose_mem_FP machinePairSecond_mem_FP + machinePairSecond_mem_FP + simpa only [machineDirectedObjectiveSumAcc] using + machineCompose_mem_FP htail machinePairFirst_mem_FP + +theorem machineDirectedObjectiveSumBound_mem_FP : + machineDirectedObjectiveSumBound ∈ FP := by + have htailTwo := machineCompose_mem_FP machinePairSecond_mem_FP + machinePairSecond_mem_FP + have htailThree := machineCompose_mem_FP htailTwo machinePairSecond_mem_FP + simpa only [machineDirectedObjectiveSumBound] using + machineCompose_mem_FP htailThree machinePairFirst_mem_FP + +theorem machineDirectedObjectiveSumDone_mem_FP : + machineDirectedObjectiveSumDone ∈ FP := by + have htailTwo := machineCompose_mem_FP machinePairSecond_mem_FP + machinePairSecond_mem_FP + have htailThree := machineCompose_mem_FP htailTwo machinePairSecond_mem_FP + have htailFour := machineCompose_mem_FP htailThree machinePairSecond_mem_FP + simpa only [machineDirectedObjectiveSumDone] using + machineCompose_mem_FP htailFour machinePairFirst_mem_FP + +theorem machineDirectedObjectiveSumPayload_mem_FP : + machineDirectedObjectiveSumPayload ∈ FP := by + have htailTwo := machineCompose_mem_FP machinePairSecond_mem_FP + machinePairSecond_mem_FP + have htailThree := machineCompose_mem_FP htailTwo machinePairSecond_mem_FP + have htailFour := machineCompose_mem_FP htailThree machinePairSecond_mem_FP + simpa only [machineDirectedObjectiveSumPayload] using + machineCompose_mem_FP htailFour machinePairSecond_mem_FP + +theorem machineDirectedObjectiveSumStateDimension_mem_FP : + machineDirectedObjectiveSumStateDimension ∈ FP := by + simpa only [machineDirectedObjectiveSumStateDimension] using + machineCompose_mem_FP machineDirectedObjectiveSumPayload_mem_FP + machineDirectedObjectiveSumDimension_mem_FP + +theorem machineDirectedObjectiveSumStatePrecision_mem_FP : + machineDirectedObjectiveSumStatePrecision ∈ FP := by + simpa only [machineDirectedObjectiveSumStatePrecision] using + machineCompose_mem_FP machineDirectedObjectiveSumPayload_mem_FP + machineDirectedObjectiveSumPrecision_mem_FP + +theorem machineDirectedObjectiveSumStateTau_mem_FP : + machineDirectedObjectiveSumStateTau ∈ FP := by + simpa only [machineDirectedObjectiveSumStateTau] using + machineCompose_mem_FP machineDirectedObjectiveSumPayload_mem_FP + machineDirectedObjectiveSumTau_mem_FP + +theorem machineDirectedObjectiveSumStateMatrix_mem_FP : + machineDirectedObjectiveSumStateMatrix ∈ FP := by + simpa only [machineDirectedObjectiveSumStateMatrix] using + machineCompose_mem_FP machineDirectedObjectiveSumPayload_mem_FP + machineDirectedObjectiveSumMatrix_mem_FP + +theorem machineDirectedObjectiveSumStateVector_mem_FP : + machineDirectedObjectiveSumStateVector ∈ FP := by + simpa only [machineDirectedObjectiveSumStateVector] using + machineCompose_mem_FP machineDirectedObjectiveSumPayload_mem_FP + machineDirectedObjectiveSumVector_mem_FP + +theorem machineDirectedObjectiveSumLastRowBit_mem_FP : + machineDirectedObjectiveSumLastRowBit ∈ FP := + machineUnaryRulersEqualBit_mem_FP machineDirectedObjectiveSumRow_mem_FP + machineDirectedObjectiveSumStateDimension_mem_FP + +theorem machineDirectedObjectiveSumLastColumnBit_mem_FP : + machineDirectedObjectiveSumLastColumnBit ∈ FP := + machineUnaryRulersEqualBit_mem_FP machineDirectedObjectiveSumColumn_mem_FP + machineDirectedObjectiveSumStateDimension_mem_FP + +theorem machineDirectedObjectiveSumMatrixEntryInput_mem_FP : + machineDirectedObjectiveSumMatrixEntryInput ∈ FP := + machinePair_mem_FP machineDirectedObjectiveSumRow_mem_FP + (machinePair_mem_FP machineDirectedObjectiveSumColumn_mem_FP + machineDirectedObjectiveSumStateMatrix_mem_FP) + +theorem machineDirectedObjectiveSumMatrixEntryRaw_mem_FP : + machineDirectedObjectiveSumMatrixEntryRaw ∈ FP := by + have hentry := machineCompose_mem_FP + machineDirectedObjectiveSumMatrixEntryInput_mem_FP + machineMatrixEntryAtUnary_mem_FP + simpa only [machineDirectedObjectiveSumMatrixEntryRaw] using + machineCompose_mem_FP hentry machineNormalizeRawRatEntryCode_mem_FP + +theorem machineDirectedObjectiveSumAffineEntryInput_mem_FP : + machineDirectedObjectiveSumAffineEntryInput ∈ FP := + machinePair_mem_FP machineDirectedObjectiveSumStateDimension_mem_FP + (machinePair_mem_FP machineDirectedObjectiveSumRow_mem_FP + (machinePair_mem_FP machineDirectedObjectiveSumColumn_mem_FP + machineDirectedObjectiveSumStateVector_mem_FP)) + +theorem machineDirectedObjectiveSumAffineEntryRaw_mem_FP : + machineDirectedObjectiveSumAffineEntryRaw ∈ FP := by + have hentry := machineCompose_mem_FP + machineDirectedObjectiveSumAffineEntryInput_mem_FP + machineBetheAffineEntryRawCode_mem_FP + simpa only [machineDirectedObjectiveSumAffineEntryRaw] using + machineCompose_mem_FP hentry machineNormalizeRawRatEntryCode_mem_FP + +theorem machineDirectedObjectiveSumCoordinateInput_mem_FP : + machineDirectedObjectiveSumCoordinateInput ∈ FP := + machinePair_mem_FP machineDirectedObjectiveSumStatePrecision_mem_FP + (machinePair_mem_FP machineDirectedObjectiveSumStateTau_mem_FP + (machinePair_mem_FP machineDirectedObjectiveSumMatrixEntryRaw_mem_FP + machineDirectedObjectiveSumAffineEntryRaw_mem_FP)) + +theorem machineDirectedObjectiveSumCoordinateRawCode_mem_FP : + machineDirectedObjectiveSumCoordinateRawCode ∈ FP := by + simpa only [machineDirectedObjectiveSumCoordinateRawCode] using + machineCompose_mem_FP machineDirectedObjectiveSumCoordinateInput_mem_FP + machineDirectedNegativeObjectiveCoordinateLowerRawCode_mem_FP + +theorem machineDirectedObjectiveSumCandidate_mem_FP : + machineDirectedObjectiveSumCandidate ∈ FP := by + have hinput := machinePair_mem_FP machineDirectedObjectiveSumAcc_mem_FP + machineDirectedObjectiveSumCoordinateRawCode_mem_FP + simpa only [machineDirectedObjectiveSumCandidate] using + machineCompose_mem_FP hinput machineRawRatAddCode_mem_FP + +theorem machineDirectedObjectiveSumNextAcc_mem_FP : + machineDirectedObjectiveSumNextAcc ∈ FP := by + simpa only [machineDirectedObjectiveSumNextAcc] using + machineTake_mem_FP machineDirectedObjectiveSumBound_mem_FP + machineDirectedObjectiveSumCandidate_mem_FP + +theorem machineDirectedObjectiveSumNextRow_mem_FP : + machineDirectedObjectiveSumNextRow ∈ FP := by + have happend := machineAppend_mem_FP machineDirectedObjectiveSumRow_mem_FP + (machineConst_mem_FP [true]) + simpa only [machineDirectedObjectiveSumNextRow] using + machineTake_mem_FP machineDirectedObjectiveSumBound_mem_FP happend + +theorem machineDirectedObjectiveSumNextColumn_mem_FP : + machineDirectedObjectiveSumNextColumn ∈ FP := by + have happend := machineAppend_mem_FP + machineDirectedObjectiveSumColumn_mem_FP + (machineConst_mem_FP [true]) + simpa only [machineDirectedObjectiveSumNextColumn] using + machineTake_mem_FP machineDirectedObjectiveSumBound_mem_FP happend + +theorem machineDirectedObjectiveSumFinish_mem_FP : + machineDirectedObjectiveSumFinish ∈ FP := + machinePair_mem_FP machineDirectedObjectiveSumRow_mem_FP + (machinePair_mem_FP machineDirectedObjectiveSumColumn_mem_FP + (machinePair_mem_FP machineDirectedObjectiveSumNextAcc_mem_FP + (machinePair_mem_FP machineDirectedObjectiveSumBound_mem_FP + (machinePair_mem_FP (machineConst_mem_FP [true]) + machineDirectedObjectiveSumPayload_mem_FP)))) + +theorem machineDirectedObjectiveSumAdvanceRow_mem_FP : + machineDirectedObjectiveSumAdvanceRow ∈ FP := + machinePair_mem_FP machineDirectedObjectiveSumNextRow_mem_FP + (machinePair_mem_FP (machineConst_mem_FP []) + (machinePair_mem_FP machineDirectedObjectiveSumNextAcc_mem_FP + (machinePair_mem_FP machineDirectedObjectiveSumBound_mem_FP + (machinePair_mem_FP machineDirectedObjectiveSumDone_mem_FP + machineDirectedObjectiveSumPayload_mem_FP)))) + +theorem machineDirectedObjectiveSumAdvanceColumn_mem_FP : + machineDirectedObjectiveSumAdvanceColumn ∈ FP := + machinePair_mem_FP machineDirectedObjectiveSumRow_mem_FP + (machinePair_mem_FP machineDirectedObjectiveSumNextColumn_mem_FP + (machinePair_mem_FP machineDirectedObjectiveSumNextAcc_mem_FP + (machinePair_mem_FP machineDirectedObjectiveSumBound_mem_FP + (machinePair_mem_FP machineDirectedObjectiveSumDone_mem_FP + machineDirectedObjectiveSumPayload_mem_FP)))) + +theorem machineDirectedObjectiveSumProcess_mem_FP : + machineDirectedObjectiveSumProcess ∈ FP := by + have hlastColumn := machineCompose_mem_FP + machineDirectedObjectiveSumLastColumnBit_mem_FP machineHeadBit_mem_FP + have hlastRow := machineCompose_mem_FP + machineDirectedObjectiveSumLastRowBit_mem_FP machineHeadBit_mem_FP + have hlast := machineIfHead_mem_FP hlastRow + machineDirectedObjectiveSumFinish_mem_FP + machineDirectedObjectiveSumAdvanceRow_mem_FP + exact machineIfHead_mem_FP hlastColumn hlast + machineDirectedObjectiveSumAdvanceColumn_mem_FP + +theorem machineDirectedObjectiveSumStep_mem_FP : + machineDirectedObjectiveSumStep ∈ FP := by + have hdone := machineCompose_mem_FP machineDirectedObjectiveSumDone_mem_FP + machineHeadBit_mem_FP + exact machineIfHead_mem_FP hdone id_mem_FP + machineDirectedObjectiveSumProcess_mem_FP + +theorem machineDirectedObjectiveSumAccumulatorBound_mem_FP : + machineDirectedObjectiveSumAccumulatorBound ∈ FP := by + simpa only [machineDirectedObjectiveSumAccumulatorBound] using + machineIteratedBinaryWidth_mem_FP 6 + +theorem machineDirectedObjectiveSumStateEnvelope_mem_FP : + machineDirectedObjectiveSumStateEnvelope ∈ FP := by + simpa only [machineDirectedObjectiveSumStateEnvelope] using + machineIteratedBinaryWidth_mem_FP 7 + +theorem machineDirectedObjectiveSumInit_mem_FP : + machineDirectedObjectiveSumInit ∈ FP := + machinePair_mem_FP (machineConst_mem_FP []) + (machinePair_mem_FP (machineConst_mem_FP []) + (machinePair_mem_FP + (machineConst_mem_FP (rawRatBinaryCode RawRat.zero)) + (machinePair_mem_FP + machineDirectedObjectiveSumAccumulatorBound_mem_FP + (machinePair_mem_FP (machineConst_mem_FP [false]) id_mem_FP)))) + +theorem machineDirectedObjectiveSumRuler_mem_FP : + machineDirectedObjectiveSumRuler ∈ FP := by + simpa only [machineDirectedObjectiveSumRuler] using + machineBetheFloorScanRuler_mem_FP + +theorem machineDirectedObjectiveSumWidth_mem_FP : + machineDirectedObjectiveSumWidth ∈ FP := by + have h := machineDirectedObjectiveSumStateEnvelope_mem_FP + exact machinePair_mem_FP h + (machinePair_mem_FP h + (machinePair_mem_FP h + (machinePair_mem_FP h (machinePair_mem_FP h h)))) + +/-! ## A global state envelope for the bounded iteration -/ + +@[simp] theorem machineDirectedObjectiveSumRow_pack + (row column acc bound done payload) : + machineDirectedObjectiveSumRow + (machineDirectedObjectiveSumPack row column acc bound done payload) = + row := by + simp [machineDirectedObjectiveSumRow, machineDirectedObjectiveSumPack] + +@[simp] theorem machineDirectedObjectiveSumColumn_pack + (row column acc bound done payload) : + machineDirectedObjectiveSumColumn + (machineDirectedObjectiveSumPack row column acc bound done payload) = + column := by + simp [machineDirectedObjectiveSumColumn, machineDirectedObjectiveSumPack] + +@[simp] theorem machineDirectedObjectiveSumAcc_pack + (row column acc bound done payload) : + machineDirectedObjectiveSumAcc + (machineDirectedObjectiveSumPack row column acc bound done payload) = + acc := by + simp [machineDirectedObjectiveSumAcc, machineDirectedObjectiveSumPack] + +@[simp] theorem machineDirectedObjectiveSumBound_pack + (row column acc bound done payload) : + machineDirectedObjectiveSumBound + (machineDirectedObjectiveSumPack row column acc bound done payload) = + bound := by + simp [machineDirectedObjectiveSumBound, machineDirectedObjectiveSumPack] + +@[simp] theorem machineDirectedObjectiveSumDone_pack + (row column acc bound done payload) : + machineDirectedObjectiveSumDone + (machineDirectedObjectiveSumPack row column acc bound done payload) = + done := by + simp [machineDirectedObjectiveSumDone, machineDirectedObjectiveSumPack] + +@[simp] theorem machineDirectedObjectiveSumPayload_pack + (row column acc bound done payload) : + machineDirectedObjectiveSumPayload + (machineDirectedObjectiveSumPack row column acc bound done payload) = + payload := by + simp [machineDirectedObjectiveSumPayload, machineDirectedObjectiveSumPack] + +def MachineDirectedObjectiveSumStateBound + (word state : List Bool) : Prop := + state = machineDirectedObjectiveSumPack + (machineDirectedObjectiveSumRow state) + (machineDirectedObjectiveSumColumn state) + (machineDirectedObjectiveSumAcc state) + (machineDirectedObjectiveSumBound state) + (machineDirectedObjectiveSumDone state) + (machineDirectedObjectiveSumPayload state) ∧ + (machineDirectedObjectiveSumRow state).length ≤ + (machineDirectedObjectiveSumAccumulatorBound word).length ∧ + (machineDirectedObjectiveSumColumn state).length ≤ + (machineDirectedObjectiveSumAccumulatorBound word).length ∧ + (machineDirectedObjectiveSumAcc state).length ≤ + (machineDirectedObjectiveSumAccumulatorBound word).length ∧ + machineDirectedObjectiveSumBound state = + machineDirectedObjectiveSumAccumulatorBound word ∧ + (machineDirectedObjectiveSumDone state).length ≤ 1 ∧ + machineDirectedObjectiveSumPayload state = word + +theorem machineDirectedObjectiveSumInit_bound (word : List Bool) : + MachineDirectedObjectiveSumStateBound word + (machineDirectedObjectiveSumInit word) := by + simp only [MachineDirectedObjectiveSumStateBound, + machineDirectedObjectiveSumInit, + machineDirectedObjectiveSumRow_pack, + machineDirectedObjectiveSumColumn_pack, + machineDirectedObjectiveSumAcc_pack, + machineDirectedObjectiveSumBound_pack, + machineDirectedObjectiveSumDone_pack, + machineDirectedObjectiveSumPayload_pack] + refine ⟨trivial, by simp, by simp, ?_, trivial, by simp, trivial⟩ + have hzero : (rawRatBinaryCode RawRat.zero).length = 5 := by decide + rw [hzero] + rw [machineDirectedObjectiveSumAccumulatorBound, + machineIteratedBinaryWidth_length] + have hbase : 16 ≤ word.length + 16 := by omega + have hpow : 16 ^ (2 ^ (5 + 1)) ≤ + (word.length + 16) ^ (2 ^ (5 + 1)) := + Nat.pow_le_pow_left hbase _ + exact (by norm_num : 5 ≤ 16 ^ (2 ^ (5 + 1))).trans + (hpow.trans (certificateExpGuardWidth_pow_lower 5 word.length)) + +theorem machineDirectedObjectiveSumStep_bound {word state : List Bool} + (hstate : MachineDirectedObjectiveSumStateBound word state) : + MachineDirectedObjectiveSumStateBound word + (machineDirectedObjectiveSumStep state) := by + rcases hstate with + ⟨hdecomp, hrow, hcolumn, hacc, hbound, hdone, hpayload⟩ + have hfinish : MachineDirectedObjectiveSumStateBound word + (machineDirectedObjectiveSumFinish state) := by + rw [machineDirectedObjectiveSumFinish] + simp only [MachineDirectedObjectiveSumStateBound, + machineDirectedObjectiveSumRow_pack, + machineDirectedObjectiveSumColumn_pack, + machineDirectedObjectiveSumAcc_pack, + machineDirectedObjectiveSumBound_pack, + machineDirectedObjectiveSumDone_pack, + machineDirectedObjectiveSumPayload_pack] + refine ⟨trivial, hrow, hcolumn, ?_, hbound, by simp, hpayload⟩ + rw [machineDirectedObjectiveSumNextAcc, hbound] + exact List.length_take_le _ _ + have hadvanceRow : MachineDirectedObjectiveSumStateBound word + (machineDirectedObjectiveSumAdvanceRow state) := by + rw [machineDirectedObjectiveSumAdvanceRow] + simp only [MachineDirectedObjectiveSumStateBound, + machineDirectedObjectiveSumRow_pack, + machineDirectedObjectiveSumColumn_pack, + machineDirectedObjectiveSumAcc_pack, + machineDirectedObjectiveSumBound_pack, + machineDirectedObjectiveSumDone_pack, + machineDirectedObjectiveSumPayload_pack] + refine ⟨trivial, ?_, by simp, ?_, hbound, hdone, hpayload⟩ + · rw [machineDirectedObjectiveSumNextRow, hbound] + exact List.length_take_le _ _ + · rw [machineDirectedObjectiveSumNextAcc, hbound] + exact List.length_take_le _ _ + have hadvanceColumn : MachineDirectedObjectiveSumStateBound word + (machineDirectedObjectiveSumAdvanceColumn state) := by + rw [machineDirectedObjectiveSumAdvanceColumn] + simp only [MachineDirectedObjectiveSumStateBound, + machineDirectedObjectiveSumRow_pack, + machineDirectedObjectiveSumColumn_pack, + machineDirectedObjectiveSumAcc_pack, + machineDirectedObjectiveSumBound_pack, + machineDirectedObjectiveSumDone_pack, + machineDirectedObjectiveSumPayload_pack] + refine ⟨trivial, hrow, ?_, ?_, hbound, hdone, hpayload⟩ + · rw [machineDirectedObjectiveSumNextColumn, hbound] + exact List.length_take_le _ _ + · rw [machineDirectedObjectiveSumNextAcc, hbound] + exact List.length_take_le _ _ + have hprocess : MachineDirectedObjectiveSumStateBound word + (machineDirectedObjectiveSumProcess state) := by + cases hcolumnCode : machineDirectedObjectiveSumLastColumnBit state with + | nil => + rw [machineDirectedObjectiveSumProcess, hcolumnCode, + machineHeadBit_nil, machineIfHead_false] + exact hadvanceColumn + | cons columnBit columnTail => + cases columnBit with + | false => + rw [machineDirectedObjectiveSumProcess, hcolumnCode, + machineHeadBit_cons, machineIfHead_false] + exact hadvanceColumn + | true => + cases hrowCode : machineDirectedObjectiveSumLastRowBit state with + | nil => + rw [machineDirectedObjectiveSumProcess, hcolumnCode, + machineHeadBit_cons, machineIfHead_true, hrowCode, + machineHeadBit_nil, machineIfHead_false] + exact hadvanceRow + | cons rowBit rowTail => + cases rowBit with + | false => + rw [machineDirectedObjectiveSumProcess, hcolumnCode, + machineHeadBit_cons, machineIfHead_true, hrowCode, + machineHeadBit_cons, machineIfHead_false] + exact hadvanceRow + | true => + rw [machineDirectedObjectiveSumProcess, hcolumnCode, + machineHeadBit_cons, machineIfHead_true, hrowCode, + machineHeadBit_cons, machineIfHead_true] + exact hfinish + cases hdoneCode : machineDirectedObjectiveSumDone state with + | nil => + rw [machineDirectedObjectiveSumStep, hdoneCode, + machineHeadBit_nil, machineIfHead_false] + exact hprocess + | cons doneBit doneTail => + cases doneBit with + | false => + rw [machineDirectedObjectiveSumStep, hdoneCode, + machineHeadBit_cons, machineIfHead_false] + exact hprocess + | true => + rw [machineDirectedObjectiveSumStep, hdoneCode, + machineHeadBit_cons, machineIfHead_true] + exact ⟨hdecomp, hrow, hcolumn, hacc, hbound, hdone, hpayload⟩ + +theorem machineDirectedObjectiveSumIterate_bound (word : List Bool) : ∀ k, + MachineDirectedObjectiveSumStateBound word + ((machineDirectedObjectiveSumStep)^[k] + (machineDirectedObjectiveSumInit word)) := by + intro k + induction k with + | zero => exact machineDirectedObjectiveSumInit_bound word + | succ k ih => + rw [Function.iterate_succ_apply'] + exact machineDirectedObjectiveSumStep_bound ih + +theorem certificateExpGuardWidth_self_le (k L : ℕ) : + L ≤ certificateExpGuardWidth k L := by + induction k with + | zero => rfl + | succ k ih => + rw [certificateExpGuardWidth] + exact ih.trans (by + nlinarith [sq_nonneg (certificateExpGuardWidth k L)]) + +theorem machineDirectedObjectiveSumAccumulatorBound_le_envelope + (word : List Bool) : + (machineDirectedObjectiveSumAccumulatorBound word).length ≤ + (machineDirectedObjectiveSumStateEnvelope word).length := by + rw [machineDirectedObjectiveSumAccumulatorBound, + machineDirectedObjectiveSumStateEnvelope, + machineIteratedBinaryWidth_length, + machineIteratedBinaryWidth_length] + change certificateExpGuardWidth 6 word.length ≤ + (certificateExpGuardWidth 6 word.length + 16) ^ 2 + nlinarith [sq_nonneg (certificateExpGuardWidth 6 word.length)] + +theorem machineDirectedObjectiveSumWord_le_envelope (word : List Bool) : + word.length ≤ + (machineDirectedObjectiveSumStateEnvelope word).length := by + rw [machineDirectedObjectiveSumStateEnvelope, + machineIteratedBinaryWidth_length] + exact certificateExpGuardWidth_self_le 7 word.length + +theorem machineDirectedObjectiveSumEnvelope_pos (word : List Bool) : + 1 ≤ (machineDirectedObjectiveSumStateEnvelope word).length := by + rw [machineDirectedObjectiveSumStateEnvelope, + machineIteratedBinaryWidth_length] + have hbase : 16 ≤ word.length + 16 := by omega + have hpow : 16 ^ (2 ^ (6 + 1)) ≤ + (word.length + 16) ^ (2 ^ (6 + 1)) := + Nat.pow_le_pow_left hbase _ + exact (by norm_num : 1 ≤ 16 ^ (2 ^ (6 + 1))).trans + (hpow.trans (certificateExpGuardWidth_pow_lower 6 word.length)) + +theorem machineDirectedObjectiveSumIterate_length_le_width + (word : List Bool) (iterations : ℕ) + (_ : iterations ≤ (machineDirectedObjectiveSumRuler word).length) : + ((machineDirectedObjectiveSumStep)^[iterations] + (machineDirectedObjectiveSumInit word)).length ≤ + (machineDirectedObjectiveSumWidth word).length := by + rcases machineDirectedObjectiveSumIterate_bound word iterations with + ⟨hdecomp, hrow, hcolumn, hacc, hbound, hdone, hpayload⟩ + have hbe := machineDirectedObjectiveSumAccumulatorBound_le_envelope word + have hwe := machineDirectedObjectiveSumWord_le_envelope word + have hepos := machineDirectedObjectiveSumEnvelope_pos word + rw [hdecomp, hbound, hpayload] + simp only [machineDirectedObjectiveSumPack, + machineDirectedObjectiveSumWidth, pair_length] + omega + +theorem machineDirectedObjectiveSumFinalState_mem_FP : + machineDirectedObjectiveSumFinalState ∈ FP := by + exact Cobham.iterate_mem_FP machineDirectedObjectiveSumStep_mem_FP + machineDirectedObjectiveSumInit_mem_FP + machineDirectedObjectiveSumRuler_mem_FP + machineDirectedObjectiveSumWidth_mem_FP + machineDirectedObjectiveSumIterate_length_le_width + +theorem machineDirectedNegativeObjectiveSumRawCode_mem_FP : + machineDirectedNegativeObjectiveSumRawCode ∈ FP := by + simpa only [machineDirectedNegativeObjectiveSumRawCode] using + machineCompose_mem_FP machineDirectedObjectiveSumFinalState_mem_FP + machineDirectedObjectiveSumAcc_mem_FP + +/-! ## Canonical inputs and exact coordinate semantics -/ + +def machineDirectedObjectiveSumCanonicalWord {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p : ℕ) : List Bool := + pair (List.replicate m true) + (pair (List.replicate p true) + (pair (rawRatBinaryCode (rawRatOfRat tau)) + (pair (rationalMatrixBinaryEncoding.encode ⟨m + 1, A⟩) + (rationalFiniteVectorCode y)))) + +@[simp] theorem machineDirectedObjectiveSumDimension_encode {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p : ℕ) : + machineDirectedObjectiveSumDimension + (machineDirectedObjectiveSumCanonicalWord tau A y p) = + List.replicate m true := by + simp [machineDirectedObjectiveSumDimension, + machineDirectedObjectiveSumCanonicalWord] + +@[simp] theorem machineDirectedObjectiveSumPrecision_encode {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p : ℕ) : + machineDirectedObjectiveSumPrecision + (machineDirectedObjectiveSumCanonicalWord tau A y p) = + List.replicate p true := by + simp [machineDirectedObjectiveSumPrecision, + machineDirectedObjectiveSumRest, + machineDirectedObjectiveSumCanonicalWord] + +@[simp] theorem machineDirectedObjectiveSumTau_encode {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p : ℕ) : + machineDirectedObjectiveSumTau + (machineDirectedObjectiveSumCanonicalWord tau A y p) = + rawRatBinaryCode (rawRatOfRat tau) := by + simp [machineDirectedObjectiveSumTau, + machineDirectedObjectiveSumAfterPrecision, + machineDirectedObjectiveSumRest, + machineDirectedObjectiveSumCanonicalWord] + +@[simp] theorem machineDirectedObjectiveSumMatrix_encode {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p : ℕ) : + machineDirectedObjectiveSumMatrix + (machineDirectedObjectiveSumCanonicalWord tau A y p) = + rationalMatrixBinaryEncoding.encode ⟨m + 1, A⟩ := by + simp [machineDirectedObjectiveSumMatrix, + machineDirectedObjectiveSumAfterTau, + machineDirectedObjectiveSumAfterPrecision, + machineDirectedObjectiveSumRest, + machineDirectedObjectiveSumCanonicalWord] + +@[simp] theorem machineDirectedObjectiveSumVector_encode {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p : ℕ) : + machineDirectedObjectiveSumVector + (machineDirectedObjectiveSumCanonicalWord tau A y p) = + rationalFiniteVectorCode y := by + simp [machineDirectedObjectiveSumVector, + machineDirectedObjectiveSumAfterTau, + machineDirectedObjectiveSumAfterPrecision, + machineDirectedObjectiveSumRest, + machineDirectedObjectiveSumCanonicalWord] + +def machineDirectedObjectiveSumCanonicalState {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p : ℕ) + (i j : Fin (m + 1)) (acc : RawRat) (done : Bool) + (bound : List Bool) : List Bool := + machineDirectedObjectiveSumPack + (List.replicate i.1 true) (List.replicate j.1 true) + (rawRatBinaryCode acc) bound [done] + (machineDirectedObjectiveSumCanonicalWord tau A y p) + +@[simp] theorem machineDirectedObjectiveSumRow_canonicalState {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p : ℕ) + (i j : Fin (m + 1)) (acc : RawRat) (done : Bool) + (bound : List Bool) : + machineDirectedObjectiveSumRow + (machineDirectedObjectiveSumCanonicalState + tau A y p i j acc done bound) = + List.replicate i.1 true := by + simp [machineDirectedObjectiveSumCanonicalState] + +@[simp] theorem machineDirectedObjectiveSumColumn_canonicalState {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p : ℕ) + (i j : Fin (m + 1)) (acc : RawRat) (done : Bool) + (bound : List Bool) : + machineDirectedObjectiveSumColumn + (machineDirectedObjectiveSumCanonicalState + tau A y p i j acc done bound) = + List.replicate j.1 true := by + simp [machineDirectedObjectiveSumCanonicalState] + +@[simp] theorem machineDirectedObjectiveSumAcc_canonicalState {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p : ℕ) + (i j : Fin (m + 1)) (acc : RawRat) (done : Bool) + (bound : List Bool) : + machineDirectedObjectiveSumAcc + (machineDirectedObjectiveSumCanonicalState + tau A y p i j acc done bound) = + rawRatBinaryCode acc := by + simp [machineDirectedObjectiveSumCanonicalState] + +@[simp] theorem machineDirectedObjectiveSumBound_canonicalState {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p : ℕ) + (i j : Fin (m + 1)) (acc : RawRat) (done : Bool) + (bound : List Bool) : + machineDirectedObjectiveSumBound + (machineDirectedObjectiveSumCanonicalState + tau A y p i j acc done bound) = bound := by + simp [machineDirectedObjectiveSumCanonicalState] + +@[simp] theorem machineDirectedObjectiveSumDone_canonicalState {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p : ℕ) + (i j : Fin (m + 1)) (acc : RawRat) (done : Bool) + (bound : List Bool) : + machineDirectedObjectiveSumDone + (machineDirectedObjectiveSumCanonicalState + tau A y p i j acc done bound) = [done] := by + simp [machineDirectedObjectiveSumCanonicalState] + +@[simp] theorem machineDirectedObjectiveSumPayload_canonicalState {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p : ℕ) + (i j : Fin (m + 1)) (acc : RawRat) (done : Bool) + (bound : List Bool) : + machineDirectedObjectiveSumPayload + (machineDirectedObjectiveSumCanonicalState + tau A y p i j acc done bound) = + machineDirectedObjectiveSumCanonicalWord tau A y p := by + simp [machineDirectedObjectiveSumCanonicalState] + +@[simp] theorem machineDirectedObjectiveSumStateDimension_canonicalState + {m : ℕ} (tau : ℚ) + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p : ℕ) + (i j : Fin (m + 1)) (acc : RawRat) (done : Bool) + (bound : List Bool) : + machineDirectedObjectiveSumStateDimension + (machineDirectedObjectiveSumCanonicalState + tau A y p i j acc done bound) = + List.replicate m true := by + rw [machineDirectedObjectiveSumStateDimension, + machineDirectedObjectiveSumPayload_canonicalState, + machineDirectedObjectiveSumDimension_encode] + +@[simp] theorem machineDirectedObjectiveSumStatePrecision_canonicalState + {m : ℕ} (tau : ℚ) + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p : ℕ) + (i j : Fin (m + 1)) (acc : RawRat) (done : Bool) + (bound : List Bool) : + machineDirectedObjectiveSumStatePrecision + (machineDirectedObjectiveSumCanonicalState + tau A y p i j acc done bound) = + List.replicate p true := by + rw [machineDirectedObjectiveSumStatePrecision, + machineDirectedObjectiveSumPayload_canonicalState, + machineDirectedObjectiveSumPrecision_encode] + +@[simp] theorem machineDirectedObjectiveSumStateTau_canonicalState {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p : ℕ) + (i j : Fin (m + 1)) (acc : RawRat) (done : Bool) + (bound : List Bool) : + machineDirectedObjectiveSumStateTau + (machineDirectedObjectiveSumCanonicalState + tau A y p i j acc done bound) = + rawRatBinaryCode (rawRatOfRat tau) := by + rw [machineDirectedObjectiveSumStateTau, + machineDirectedObjectiveSumPayload_canonicalState, + machineDirectedObjectiveSumTau_encode] + +@[simp] theorem machineDirectedObjectiveSumStateMatrix_canonicalState + {m : ℕ} (tau : ℚ) + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p : ℕ) + (i j : Fin (m + 1)) (acc : RawRat) (done : Bool) + (bound : List Bool) : + machineDirectedObjectiveSumStateMatrix + (machineDirectedObjectiveSumCanonicalState + tau A y p i j acc done bound) = + rationalMatrixBinaryEncoding.encode ⟨m + 1, A⟩ := by + rw [machineDirectedObjectiveSumStateMatrix, + machineDirectedObjectiveSumPayload_canonicalState, + machineDirectedObjectiveSumMatrix_encode] + +@[simp] theorem machineDirectedObjectiveSumStateVector_canonicalState + {m : ℕ} (tau : ℚ) + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p : ℕ) + (i j : Fin (m + 1)) (acc : RawRat) (done : Bool) + (bound : List Bool) : + machineDirectedObjectiveSumStateVector + (machineDirectedObjectiveSumCanonicalState + tau A y p i j acc done bound) = + rationalFiniteVectorCode y := by + rw [machineDirectedObjectiveSumStateVector, + machineDirectedObjectiveSumPayload_canonicalState, + machineDirectedObjectiveSumVector_encode] + +@[simp] theorem machineDirectedObjectiveSumMatrixEntryInput_canonicalState + {m : ℕ} (tau : ℚ) + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p : ℕ) + (i j : Fin (m + 1)) (acc : RawRat) (done : Bool) + (bound : List Bool) : + machineDirectedObjectiveSumMatrixEntryInput + (machineDirectedObjectiveSumCanonicalState + tau A y p i j acc done bound) = + pair (List.replicate i.1 true) + (pair (List.replicate j.1 true) + (rationalMatrixBinaryEncoding.encode ⟨m + 1, A⟩)) := by + simp [machineDirectedObjectiveSumMatrixEntryInput] + +@[simp] theorem machineDirectedObjectiveSumMatrixEntryRaw_canonicalState + {m : ℕ} (tau : ℚ) + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p : ℕ) + (i j : Fin (m + 1)) (acc : RawRat) (done : Bool) + (bound : List Bool) : + machineDirectedObjectiveSumMatrixEntryRaw + (machineDirectedObjectiveSumCanonicalState + tau A y p i j acc done bound) = + rawRatBinaryCode (rawRatOfRat (A i j)) := by + rw [machineDirectedObjectiveSumMatrixEntryRaw, + machineDirectedObjectiveSumMatrixEntryInput_canonicalState, + machineMatrixEntryAtUnary_encode] + rw [← rawRatBinaryCode_rawRatOfRat, + machineNormalizeRawRatEntryCode_encode, + rawRatBinaryCode_rawRatOfRat] + congr 1 + simp [binaryNormalizeRawRat_eq_value, rawRatOfRat_value] + +@[simp] theorem machineDirectedObjectiveSumAffineEntryInput_canonicalState + {m : ℕ} (tau : ℚ) + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p : ℕ) + (i j : Fin (m + 1)) (acc : RawRat) (done : Bool) + (bound : List Bool) : + machineDirectedObjectiveSumAffineEntryInput + (machineDirectedObjectiveSumCanonicalState + tau A y p i j acc done bound) = + machineBetheAffineEntryCanonicalWord i j y := by + simp [machineDirectedObjectiveSumAffineEntryInput, + machineBetheAffineEntryCanonicalWord] + +@[simp] theorem machineDirectedObjectiveSumAffineEntryRaw_canonicalState + {m : ℕ} (tau : ℚ) + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p : ℕ) + (i j : Fin (m + 1)) (acc : RawRat) (done : Bool) + (bound : List Bool) : + machineDirectedObjectiveSumAffineEntryRaw + (machineDirectedObjectiveSumCanonicalState + tau A y p i j acc done bound) = + rawRatBinaryCode (rawRatOfRat (betheAffineMatrixQ y i j)) := by + rw [machineDirectedObjectiveSumAffineEntryRaw, + machineDirectedObjectiveSumAffineEntryInput_canonicalState, + machineBetheAffineEntryRawCode_encode, + machineNormalizeRawRatEntryCode_encode, + rawRatBinaryCode_rawRatOfRat] + congr 1 + rw [binaryNormalizeRawRat_eq_value, + rawBetheAffineEntry_value] + +@[simp] theorem machineDirectedObjectiveSumCoordinateInput_canonicalState + {m : ℕ} (tau : ℚ) + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p : ℕ) + (i j : Fin (m + 1)) (acc : RawRat) (done : Bool) + (bound : List Bool) : + machineDirectedObjectiveSumCoordinateInput + (machineDirectedObjectiveSumCanonicalState + tau A y p i j acc done bound) = + machineDirectedObjectiveCoordinateCanonicalWord tau (A i j) + (betheAffineMatrixQ y i j) p := by + simp [machineDirectedObjectiveSumCoordinateInput, + machineDirectedObjectiveCoordinateCanonicalWord] + +@[simp] theorem machineDirectedObjectiveSumCoordinateRawCode_canonicalState + {m : ℕ} (tau : ℚ) + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p : ℕ) + (i j : Fin (m + 1)) (acc : RawRat) (done : Bool) + (bound : List Bool) : + machineDirectedObjectiveSumCoordinateRawCode + (machineDirectedObjectiveSumCanonicalState + tau A y p i j acc done bound) = + rawRatBinaryCode + (rawDirectedNegativeObjectiveCoordinateLower tau (A i j) + (betheAffineMatrixQ y i j) p) := by + rw [machineDirectedObjectiveSumCoordinateRawCode, + machineDirectedObjectiveSumCoordinateInput_canonicalState, + machineDirectedNegativeObjectiveCoordinateLowerRawCode_encode] + +/-! ## Exact `(m+1)^2` iteration ruler on canonical inputs -/ + +@[simp] theorem machineDirectedObjectiveSumWorkBits_encode {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p : ℕ) : + machineBetheFloorScanWorkBits + (machineDirectedObjectiveSumCanonicalWord tau A y p) = + ((m + 1) * (m + 1)).bits := by + rw [machineBetheFloorScanWorkBits, machineBetheFloorScanOrderBits, + machineBetheFloorScanDimensionBits, + machineBetheFloorScanDimension, + machineDirectedObjectiveSumCanonicalWord, machinePairFirst_pair, + machineLengthBits_encode, List.length_replicate] + have hone : ([true] : List Bool) = (1 : ℕ).bits := rfl + rw [hone, machineBinaryAddBits_pair_natBits, + machineBinaryMulBits_pair_natBits] + +theorem machineDirectedObjectiveSumWork_le_guard {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p : ℕ) : + (m + 1) * (m + 1) ≤ + (machineBetheFloorScanGuard + (machineDirectedObjectiveSumCanonicalWord tau A y p)).length := by + have hm : m ≤ + (machineDirectedObjectiveSumCanonicalWord tau A y p).length := by + simp only [machineDirectedObjectiveSumCanonicalWord, pair_length, + List.length_replicate] + omega + simp only [machineBetheFloorScanGuard, machineBinaryMulWidth, + List.length_replicate, List.length_append] + nlinarith + +@[simp] theorem machineDirectedObjectiveSumRuler_encode {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p : ℕ) : + machineDirectedObjectiveSumRuler + (machineDirectedObjectiveSumCanonicalWord tau A y p) = + List.replicate ((m + 1) * (m + 1)) true := by + rw [machineDirectedObjectiveSumRuler, + machineBetheFloorScanRuler, + machineDirectedObjectiveSumWorkBits_encode, + machineBoundedUnary_encode_of_le] + exact machineDirectedObjectiveSumWork_le_guard tau A y p + +/-! ## Typed row-major semantics -/ + +def rawDirectedBetheObjectiveCoordinate {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p : ℕ) + (i j : Fin (m + 1)) : RawRat := + rawDirectedNegativeObjectiveCoordinateLower tau (A i j) + (betheAffineMatrixQ y i j) p + +def rawDirectedNegativeObjectiveCoordinateWidthBudget + (tau a x : ℚ) (p : ℕ) : ℕ := + 2 * rawRatWidth (rawRatOfRat x) + + rawRatWidth (rawRatOfRat tau) + + rawRatWidth (rawRatOfRat (1 - x)) + + rawRatWidth (rawScheduledLogUpper a p) + + rawRatWidth (rawScheduledLogLower x p) + + rawRatWidth (rawScheduledLogUpper (1 - x) p) + 4 + +theorem rawDirectedNegativeObjectiveCoordinateLower_width_le + (tau a x : ℚ) (p : ℕ) : + rawRatWidth + (rawDirectedNegativeObjectiveCoordinateLower tau a x p) ≤ + rawDirectedNegativeObjectiveCoordinateWidthBudget tau a x p := by + let rawTau := rawRatOfRat tau + let rawX := rawRatOfRat x + let rawComplement := rawRatOfRat (1 - x) + let logA := rawScheduledLogUpper a p + let logX := rawScheduledLogLower x p + let logComplement := rawScheduledLogUpper (1 - x) p + have hone : rawRatWidth RawRat.one = 1 := rawRatWidth_one + have hfirst := rawRatWidth_mul_le rawX.neg logA + rw [rawRatWidth_neg] at hfirst + have honeTau := rawRatWidth_add_le RawRat.one rawTau + rw [hone] at honeTau + have hmiddleScale := rawRatWidth_mul_le + (RawRat.one.add rawTau) rawX + have hmiddle := rawRatWidth_mul_le + ((RawRat.one.add rawTau).mul rawX) logX + have hlastProduct := rawRatWidth_mul_le rawComplement logComplement + have hfirstMiddle := rawRatWidth_add_le + (rawX.neg.mul logA) + (((RawRat.one.add rawTau).mul rawX).mul logX) + have htotal := rawRatWidth_add_le + ((rawX.neg.mul logA).add + (((RawRat.one.add rawTau).mul rawX).mul logX)) + (rawComplement.mul logComplement).neg + rw [rawRatWidth_neg] at htotal + have honeTauBound : + rawRatWidth (RawRat.one.add rawTau) ≤ + rawRatWidth rawTau + 2 := by omega + have hmiddleScaleBound : + rawRatWidth ((RawRat.one.add rawTau).mul rawX) ≤ + rawRatWidth rawTau + rawRatWidth rawX + 2 := by omega + have hmiddleBound : + rawRatWidth (((RawRat.one.add rawTau).mul rawX).mul logX) ≤ + rawRatWidth rawTau + rawRatWidth rawX + + rawRatWidth logX + 2 := by omega + have hfirstMiddleBound : + rawRatWidth + ((rawX.neg.mul logA).add + (((RawRat.one.add rawTau).mul rawX).mul logX)) ≤ + 2 * rawRatWidth rawX + rawRatWidth rawTau + + rawRatWidth logA + rawRatWidth logX + 3 := by omega + have htotalBound : + rawRatWidth + (((rawX.neg.mul logA).add + (((RawRat.one.add rawTau).mul rawX).mul logX)).add + (rawComplement.mul logComplement).neg) ≤ + 2 * rawRatWidth rawX + rawRatWidth rawTau + + rawRatWidth rawComplement + rawRatWidth logA + + rawRatWidth logX + rawRatWidth logComplement + 4 := by omega + simpa [rawDirectedNegativeObjectiveCoordinateLower, + rawDirectedNegativeObjectiveCoordinateWidthBudget, + rawTau, rawX, rawComplement, logA, logX, logComplement] using + htotalBound + +theorem rawRatListCost_le_uniform_width {W : ℕ} : ∀ xs : List ℚ, + (∀ q ∈ xs, rawRatWidth (rawRatOfRat q) ≤ W) → + rawRatListCost xs ≤ xs.length * (W + 1) := by + intro xs hwidth + induction xs with + | nil => simp [rawRatListCost] + | cons q qs ih => + have hq := hwidth q (by simp) + have hqs : ∀ r ∈ qs, rawRatWidth (rawRatOfRat r) ≤ W := by + intro r hr + exact hwidth r (by simp [hr]) + have ih' := ih hqs + simp only [rawRatListCost] at ih' + simp only [rawRatListCost, List.map_cons, List.sum_cons, + List.length_cons] + rw [Nat.succ_mul] + omega + +theorem rawDirectedObjectiveSum_y_width_le_word {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p : ℕ) (k : Fin (m * m)) : + rawRatWidth (rawRatOfRat (y k)) ≤ + (machineDirectedObjectiveSumCanonicalWord tau A y p).length := by + let word := machineDirectedObjectiveSumCanonicalWord tau A y p + have hk : y k ∈ List.ofFn y := by + rw [List.mem_ofFn'] + exact ⟨k, rfl⟩ + have hentry := binaryListCode_element_length_le + rationalEntryBinaryCode hk + have hvector : (rationalFiniteVectorCode y).length ≤ word.length := by + simp only [word, machineDirectedObjectiveSumCanonicalWord, + rationalFiniteVectorCode, pair_length, List.length_replicate] + omega + have hcode : (rawRatBinaryCode (rawRatOfRat (y k))).length ≤ + word.length := by + rw [rawRatBinaryCode_rawRatOfRat] + exact hentry.trans hvector + exact (rawRatWidth_le_binaryCode_length _).trans hcode + +theorem rawDirectedObjectiveSum_A_width_le_word {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p : ℕ) + (i j : Fin (m + 1)) : + rawRatWidth (rawRatOfRat (A i j)) ≤ + (machineDirectedObjectiveSumCanonicalWord tau A y p).length := by + let rows := rationalMatrixRows A + let matrixWord := rationalMatrixBinaryEncoding.encode ⟨m + 1, A⟩ + let word := machineDirectedObjectiveSumCanonicalWord tau A y p + have hrow : List.ofFn (A i) ∈ rows := by + change List.ofFn (A i) ∈ rationalMatrixRows A + rw [rationalMatrixRows, List.mem_ofFn'] + exact ⟨i, rfl⟩ + have hentryMem : A i j ∈ List.ofFn (A i) := by + rw [List.mem_ofFn'] + exact ⟨j, rfl⟩ + have hentry := binaryListCode_element_length_le + rationalEntryBinaryCode hentryMem + have hrowCode := binaryListCode_element_length_le + (binaryListCode rationalEntryBinaryCode) hrow + have hrowsMatrix : + (binaryListCode (binaryListCode rationalEntryBinaryCode) rows).length ≤ + matrixWord.length := by + calc + _ = (machineMatrixRowsWord matrixWord).length := by + simpa only [rows, matrixWord] using congrArg List.length + (machineMatrixRowsWord_encode A).symm + _ ≤ matrixWord.length := by + simpa only [machineMatrixRowsWord] using + machinePairSecond_length_le matrixWord + have hmatrixWord : matrixWord.length ≤ word.length := by + simp only [matrixWord, word, machineDirectedObjectiveSumCanonicalWord, + pair_length, List.length_replicate] + omega + have hcode : (rawRatBinaryCode (rawRatOfRat (A i j))).length ≤ + word.length := by + rw [rawRatBinaryCode_rawRatOfRat] + exact hentry.trans (hrowCode.trans (hrowsMatrix.trans hmatrixWord)) + exact (rawRatWidth_le_binaryCode_length _).trans hcode + +theorem rawDirectedObjectiveSum_tau_width_le_word {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p : ℕ) : + rawRatWidth (rawRatOfRat tau) ≤ + (machineDirectedObjectiveSumCanonicalWord tau A y p).length := by + have hcode : (rawRatBinaryCode (rawRatOfRat tau)).length ≤ + (machineDirectedObjectiveSumCanonicalWord tau A y p).length := by + simp only [machineDirectedObjectiveSumCanonicalWord, pair_length, + List.length_replicate] + omega + exact (rawRatWidth_le_binaryCode_length _).trans hcode + +theorem rawBetheDimensionMinusOne_width_le (m : ℕ) : + rawRatWidth (rawBetheDimensionMinusOne m) ≤ m + 2 := by + rw [rawBetheDimensionMinusOne, rawRatWidth] + cases m with + | zero => norm_num + | succ k => + norm_num only [Int.natCast_add, Int.natCast_one, + add_sub_cancel_right, Nat.size_one] + have hsize : k.size ≤ k + 1 := by + rw [Nat.size_le] + exact (Nat.lt_two_pow_self (n := k)).trans_le + (Nat.pow_le_pow_right (by decide) (Nat.le_succ _)) + exact max_le (hsize.trans (by omega)) (by omega) + +theorem rawBetheAffineLineSum_width_le_word {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p : ℕ) + (rowMode : Bool) (fixed : Fin m) : + rawRatWidth (rawBetheAffineLineSum rowMode fixed y) ≤ + 1 + m * + ((machineDirectedObjectiveSumCanonicalWord tau A y p).length + 1) := by + let values := betheAffineLineValues rowMode fixed y + let L := (machineDirectedObjectiveSumCanonicalWord tau A y p).length + have hvalueWidth : ∀ q ∈ values, + rawRatWidth (rawRatOfRat q) ≤ L := by + intro q hq + simp only [values, betheAffineLineValues, List.mem_ofFn'] at hq + rcases hq with ⟨k, rfl⟩ + split + · exact rawDirectedObjectiveSum_y_width_le_word tau A y p _ + · exact rawDirectedObjectiveSum_y_width_le_word tau A y p _ + have hcost := rawRatListCost_le_uniform_width values hvalueWidth + have hsum := rawRatWidth_listSum_le RawRat.zero values + have hzero : rawRatWidth RawRat.zero = 1 := rawRatWidth_zero + rw [hzero] at hsum + have hlen : values.length = m := by + simp [values] + rw [hlen] at hcost + have hfinal : rawRatWidth (rawRatListSum RawRat.zero values) ≤ + 1 + m * (L + 1) := hsum.trans (by omega) + simpa only [rawBetheAffineLineSum, values, L] using hfinal + +theorem rawBetheAffineTotal_width_le_word {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p : ℕ) : + rawRatWidth (rawRatListSum RawRat.zero (List.ofFn y)) ≤ + 1 + m * m * + ((machineDirectedObjectiveSumCanonicalWord tau A y p).length + 1) := by + let values := List.ofFn y + let L := (machineDirectedObjectiveSumCanonicalWord tau A y p).length + have hvalueWidth : ∀ q ∈ values, + rawRatWidth (rawRatOfRat q) ≤ L := by + intro q hq + simp only [values, List.mem_ofFn'] at hq + rcases hq with ⟨k, rfl⟩ + exact rawDirectedObjectiveSum_y_width_le_word tau A y p k + have hcost := rawRatListCost_le_uniform_width values hvalueWidth + have hsum := rawRatWidth_listSum_le RawRat.zero values + have hzero : rawRatWidth RawRat.zero = 1 := rawRatWidth_zero + rw [hzero] at hsum + have hlen : values.length = m * m := by simp [values] + rw [hlen] at hcost + have hfinal : rawRatWidth (rawRatListSum RawRat.zero values) ≤ + 1 + m * m * (L + 1) := hsum.trans (by omega) + simpa only [values, L] using hfinal + +def rawBetheAffineEntryWidthBudget (m L : ℕ) : ℕ := + m * m * (L + 1) + m + L + 8 + +theorem rawBetheAffineEntry_width_le_word {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p : ℕ) + (i j : Fin (m + 1)) : + rawRatWidth (rawBetheAffineEntry y i j) ≤ + rawBetheAffineEntryWidthBudget m + (machineDirectedObjectiveSumCanonicalWord tau A y p).length := by + let L := (machineDirectedObjectiveSumCanonicalWord tau A y p).length + have hlineRow := fun fixed : Fin m ↦ + rawBetheAffineLineSum_width_le_word tau A y p true fixed + have hlineColumn := fun fixed : Fin m ↦ + rawBetheAffineLineSum_width_le_word tau A y p false fixed + have htotal := rawBetheAffineTotal_width_le_word tau A y p + have hdimension := rawBetheDimensionMinusOne_width_le m + refine Fin.lastCases ?_ (fun i ↦ ?_) i <;> + refine Fin.lastCases ?_ (fun j ↦ ?_) j + · simp only [rawBetheAffineEntry, Fin.lastCases_last] + have hsub := rawRatWidth_sub_le + (rawRatListSum RawRat.zero (List.ofFn y)) + (rawBetheDimensionMinusOne m) + simp only [rawBetheAffineEntryWidthBudget] + change m * m * + ((machineDirectedObjectiveSumCanonicalWord tau A y p).length + 1) + + m + (machineDirectedObjectiveSumCanonicalWord tau A y p).length + 8 ≥ + rawRatWidth + ((rawRatListSum RawRat.zero (List.ofFn y)).sub + (rawBetheDimensionMinusOne m)) + omega + · simp only [rawBetheAffineEntry, Fin.lastCases_last, + Fin.lastCases_castSucc] + have hsub := rawRatWidth_sub_le RawRat.one + (rawBetheAffineLineSum false j y) + rw [rawRatWidth_one] at hsub + have hline := hlineColumn j + have hmpos : 0 < m := Nat.zero_lt_of_lt j.isLt + have hmm : m ≤ m * m := Nat.le_mul_of_pos_left m hmpos + have hquad := Nat.mul_le_mul_right + ((machineDirectedObjectiveSumCanonicalWord tau A y p).length + 1) hmm + simp only [rawBetheAffineEntryWidthBudget] + omega + · simp only [rawBetheAffineEntry, Fin.lastCases_last, + Fin.lastCases_castSucc] + have hsub := rawRatWidth_sub_le RawRat.one + (rawBetheAffineLineSum true i y) + rw [rawRatWidth_one] at hsub + have hline := hlineRow i + have hmpos : 0 < m := Nat.zero_lt_of_lt i.isLt + have hmm : m ≤ m * m := Nat.le_mul_of_pos_left m hmpos + have hquad := Nat.mul_le_mul_right + ((machineDirectedObjectiveSumCanonicalWord tau A y p).length + 1) hmm + simp only [rawBetheAffineEntryWidthBudget] + omega + · simp only [rawBetheAffineEntry, Fin.lastCases_castSucc] + have hy := rawDirectedObjectiveSum_y_width_le_word tau A y p + (finProdFinEquiv (i, j)) + simp only [rawBetheAffineEntryWidthBudget] + omega + +theorem rawBetheAffineMatrixQ_width_le_word {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p : ℕ) + (i j : Fin (m + 1)) : + rawRatWidth (rawRatOfRat (betheAffineMatrixQ y i j)) ≤ + 20 + 12 * rawBetheAffineEntryWidthBudget m + (machineDirectedObjectiveSumCanonicalWord tau A y p).length := by + let raw := rawBetheAffineEntry y i j + have hvalue : binaryNormalizeRawRat raw = betheAffineMatrixQ y i j := by + rw [binaryNormalizeRawRat_eq_value, rawBetheAffineEntry_value] + have hcanonical := rawRatOfRat_width_le_encodedBitLength + (binaryNormalizeRawRat raw) + have hnormalize := binaryNormalizeRawRat_encodedBitLength_le raw + have hraw := rawBetheAffineEntry_width_le_word tau A y p i j + have hraw' : rawRatWidth raw ≤ rawBetheAffineEntryWidthBudget m + (machineDirectedObjectiveSumCanonicalWord tau A y p).length := by + simpa only [raw] using hraw + have hscaled := Nat.mul_le_mul_left 12 hraw' + calc + rawRatWidth (rawRatOfRat (betheAffineMatrixQ y i j)) = + rawRatWidth (rawRatOfRat (binaryNormalizeRawRat raw)) := by rw [hvalue] + _ ≤ encodedBitLength ℚ (binaryNormalizeRawRat raw) := hcanonical + _ ≤ 20 + 12 * rawRatWidth raw := hnormalize + _ ≤ 20 + 12 * rawBetheAffineEntryWidthBudget m + (machineDirectedObjectiveSumCanonicalWord tau A y p).length := by + omega + +def rawDirectedObjectiveCoordinateWordXBudget (m L : ℕ) : ℕ := + 20 + 12 * rawBetheAffineEntryWidthBudget m L + +def rawDirectedObjectiveCoordinateWordComplementBudget + (m L : ℕ) : ℕ := + 44 + 12 * rawDirectedObjectiveCoordinateWordXBudget m L + +def rawScheduledLogWordBudget (L W : ℕ) : ℕ := + 64 * (L + 2 * W + 4) ^ 2 * (W + 2) + +def rawDirectedObjectiveCoordinateWordBudget (m L : ℕ) : ℕ := + let WX := rawDirectedObjectiveCoordinateWordXBudget m L + let WC := rawDirectedObjectiveCoordinateWordComplementBudget m L + 2 * WX + L + WC + + rawScheduledLogWordBudget L L + + rawScheduledLogWordBudget L WX + + rawScheduledLogWordBudget L WC + 4 + +theorem directedObjectiveSum_precision_le_word {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p : ℕ) : + p ≤ (machineDirectedObjectiveSumCanonicalWord tau A y p).length := by + simp only [machineDirectedObjectiveSumCanonicalWord, pair_length, + List.length_replicate] + omega + +theorem rawDirectedBetheObjectiveCoordinate_width_le_word_budget {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p : ℕ) + (i j : Fin (m + 1)) : + rawRatWidth (rawDirectedBetheObjectiveCoordinate tau A y p i j) ≤ + rawDirectedObjectiveCoordinateWordBudget m + (machineDirectedObjectiveSumCanonicalWord tau A y p).length := by + let L := (machineDirectedObjectiveSumCanonicalWord tau A y p).length + let x := betheAffineMatrixQ y i j + let WX := rawDirectedObjectiveCoordinateWordXBudget m L + let WC := rawDirectedObjectiveCoordinateWordComplementBudget m L + have hp : p ≤ L := directedObjectiveSum_precision_le_word tau A y p + have htau : rawRatWidth (rawRatOfRat tau) ≤ L := + rawDirectedObjectiveSum_tau_width_le_word tau A y p + have ha : rawRatWidth (rawRatOfRat (A i j)) ≤ L := + rawDirectedObjectiveSum_A_width_le_word tau A y p i j + have hx : rawRatWidth (rawRatOfRat x) ≤ WX := by + simpa only [x, WX, L, + rawDirectedObjectiveCoordinateWordXBudget] using + rawBetheAffineMatrixQ_width_le_word tau A y p i j + have hc0 := rawRatWidth_complement_le x + have hc : rawRatWidth (rawRatOfRat (1 - x)) ≤ WC := by + simp only [WC, rawDirectedObjectiveCoordinateWordComplementBudget] + omega + have hlogA := rawRatWidth_scheduledLogUpper_of_bounds_le + (A i j) hp ha + have hlogX := rawRatWidth_scheduledLogLower_of_bounds_le x hp hx + have hlogC := rawRatWidth_scheduledLogUpper_of_bounds_le (1 - x) hp hc + have hraw := rawDirectedNegativeObjectiveCoordinateLower_width_le + tau (A i j) x p + have hfinal : + rawRatWidth + (rawDirectedNegativeObjectiveCoordinateLower tau (A i j) x p) ≤ + 2 * WX + L + WC + + 64 * (L + 2 * L + 4) ^ 2 * (L + 2) + + 64 * (L + 2 * WX + 4) ^ 2 * (WX + 2) + + 64 * (L + 2 * WC + 4) ^ 2 * (WC + 2) + 4 := by + simp only [rawDirectedNegativeObjectiveCoordinateWidthBudget] at hraw + omega + simpa only [rawDirectedBetheObjectiveCoordinate, + rawDirectedObjectiveCoordinateWordBudget, rawScheduledLogWordBudget, + WX, WC, L, x] using hfinal + +structure DirectedObjectiveSumSemanticState (m : ℕ) where + row : Fin (m + 1) + column : Fin (m + 1) + acc : RawRat + done : Bool + +def directedObjectiveSumSemanticInit (m : ℕ) : + DirectedObjectiveSumSemanticState m where + row := ⟨0, by omega⟩ + column := ⟨0, by omega⟩ + acc := RawRat.zero + done := false + +def directedObjectiveSumSemanticStep {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p : ℕ) + (state : DirectedObjectiveSumSemanticState m) : + DirectedObjectiveSumSemanticState m := + if state.done then state + else + let nextAcc := state.acc.add + (rawDirectedBetheObjectiveCoordinate tau A y p + state.row state.column) + if hcolumn : state.column = Fin.last m then + if hrow : state.row = Fin.last m then + { state with acc := nextAcc, done := true } + else + { state with + row := betheFloorScanNextFin state.row + column := ⟨0, by omega⟩ + acc := nextAcc } + else + { state with + column := betheFloorScanNextFin state.column + acc := nextAcc } + +theorem directedObjectiveSumSemanticStep_acc_width {m B C : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p : ℕ) + (state : DirectedObjectiveSumSemanticState m) + (hacc : rawRatWidth state.acc ≤ C) + (hcoordinate : rawRatWidth + (rawDirectedBetheObjectiveCoordinate tau A y p + state.row state.column) ≤ B) : + rawRatWidth (directedObjectiveSumSemanticStep tau A y p state).acc ≤ + C + B + 1 := by + rcases state with ⟨i, j, acc, done⟩ + dsimp only [DirectedObjectiveSumSemanticState.acc, + DirectedObjectiveSumSemanticState.row, + DirectedObjectiveSumSemanticState.column] at hacc hcoordinate ⊢ + cases done + · have hadd := rawRatWidth_add_le acc + (rawDirectedBetheObjectiveCoordinate tau A y p i j) + by_cases hcolumn : j = Fin.last m + · by_cases hrow : i = Fin.last m + · simpa [directedObjectiveSumSemanticStep, hcolumn, hrow] using + hadd.trans (by omega) + · simpa [directedObjectiveSumSemanticStep, hcolumn, hrow] using + hadd.trans (by omega) + · simpa [directedObjectiveSumSemanticStep, hcolumn] using + hadd.trans (by omega) + · simpa [directedObjectiveSumSemanticStep] using + hacc.trans (by omega) + +def machineDirectedObjectiveSumSemanticCode {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p : ℕ) (bound : List Bool) + (state : DirectedObjectiveSumSemanticState m) : List Bool := + machineDirectedObjectiveSumCanonicalState tau A y p + state.row state.column state.acc state.done bound + +@[simp] theorem machineDirectedObjectiveSumLastRowBit_canonicalState + {m : ℕ} (tau : ℚ) + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p : ℕ) + (i j : Fin (m + 1)) (acc : RawRat) (done : Bool) + (bound : List Bool) : + machineDirectedObjectiveSumLastRowBit + (machineDirectedObjectiveSumCanonicalState + tau A y p i j acc done bound) = + [decide (i = Fin.last m)] := by + rw [machineDirectedObjectiveSumLastRowBit, + machineDirectedObjectiveSumRow_canonicalState, + machineDirectedObjectiveSumStateDimension_canonicalState, + machineUnaryRulersEqualBit_replicate] + by_cases hi : i = Fin.last m + · simp [hi] + · have hval : i.1 ≠ m := by + intro h + apply hi + apply Fin.ext + simpa using h + simp [hi, hval] + +@[simp] theorem machineDirectedObjectiveSumLastColumnBit_canonicalState + {m : ℕ} (tau : ℚ) + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p : ℕ) + (i j : Fin (m + 1)) (acc : RawRat) (done : Bool) + (bound : List Bool) : + machineDirectedObjectiveSumLastColumnBit + (machineDirectedObjectiveSumCanonicalState + tau A y p i j acc done bound) = + [decide (j = Fin.last m)] := by + rw [machineDirectedObjectiveSumLastColumnBit, + machineDirectedObjectiveSumColumn_canonicalState, + machineDirectedObjectiveSumStateDimension_canonicalState, + machineUnaryRulersEqualBit_replicate] + by_cases hj : j = Fin.last m + · simp [hj] + · have hval : j.1 ≠ m := by + intro h + apply hj + apply Fin.ext + simpa using h + simp [hj, hval] + +@[simp] theorem machineDirectedObjectiveSumCandidate_canonicalState + {m : ℕ} (tau : ℚ) + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p : ℕ) + (i j : Fin (m + 1)) (acc : RawRat) (done : Bool) + (bound : List Bool) : + machineDirectedObjectiveSumCandidate + (machineDirectedObjectiveSumCanonicalState + tau A y p i j acc done bound) = + rawRatBinaryCode + (acc.add (rawDirectedBetheObjectiveCoordinate tau A y p i j)) := by + rw [machineDirectedObjectiveSumCandidate, + machineDirectedObjectiveSumAcc_canonicalState, + machineDirectedObjectiveSumCoordinateRawCode_canonicalState, + machineRawRatAddCode_encode] + rfl + +theorem machineDirectedObjectiveSumNextAcc_canonicalState + {m : ℕ} (tau : ℚ) + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p : ℕ) + (i j : Fin (m + 1)) (acc : RawRat) (done : Bool) + (bound : List Bool) + (hlarge : + (rawRatBinaryCode + (acc.add (rawDirectedBetheObjectiveCoordinate tau A y p i j))).length + ≤ bound.length) : + machineDirectedObjectiveSumNextAcc + (machineDirectedObjectiveSumCanonicalState + tau A y p i j acc done bound) = + rawRatBinaryCode + (acc.add (rawDirectedBetheObjectiveCoordinate tau A y p i j)) := by + rw [machineDirectedObjectiveSumNextAcc, + machineDirectedObjectiveSumCandidate_canonicalState, + machineDirectedObjectiveSumBound_canonicalState] + exact (List.take_eq_self_iff _).mpr hlarge + +theorem machineDirectedObjectiveSumNextRow_canonicalState + {m : ℕ} (tau : ℚ) + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p : ℕ) + (i j : Fin (m + 1)) (acc : RawRat) (done : Bool) + (bound : List Bool) (hi : i ≠ Fin.last m) + (hbound : m ≤ bound.length) : + machineDirectedObjectiveSumNextRow + (machineDirectedObjectiveSumCanonicalState + tau A y p i j acc done bound) = + List.replicate (betheFloorScanNextFin i).1 true := by + rw [machineDirectedObjectiveSumNextRow, + machineDirectedObjectiveSumRow_canonicalState, + machineDirectedObjectiveSumBound_canonicalState, + betheFloorScanNextFin_val i hi, + List.replicate_succ'] + apply (List.take_eq_self_iff _).mpr + simp only [List.length_append, List.length_replicate, + List.length_singleton] + have hval : i.1 ≠ m := by + intro h + apply hi + apply Fin.ext + simpa using h + have : i.1 + 1 ≤ m := by omega + omega + +theorem machineDirectedObjectiveSumNextColumn_canonicalState + {m : ℕ} (tau : ℚ) + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p : ℕ) + (i j : Fin (m + 1)) (acc : RawRat) (done : Bool) + (bound : List Bool) (hj : j ≠ Fin.last m) + (hbound : m ≤ bound.length) : + machineDirectedObjectiveSumNextColumn + (machineDirectedObjectiveSumCanonicalState + tau A y p i j acc done bound) = + List.replicate (betheFloorScanNextFin j).1 true := by + rw [machineDirectedObjectiveSumNextColumn, + machineDirectedObjectiveSumColumn_canonicalState, + machineDirectedObjectiveSumBound_canonicalState, + betheFloorScanNextFin_val j hj, + List.replicate_succ'] + apply (List.take_eq_self_iff _).mpr + simp only [List.length_append, List.length_replicate, + List.length_singleton] + have hval : j.1 ≠ m := by + intro h + apply hj + apply Fin.ext + simpa using h + have : j.1 + 1 ≤ m := by omega + omega + +theorem machineDirectedObjectiveSumFinish_canonicalState + {m : ℕ} (tau : ℚ) + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p : ℕ) + (i j : Fin (m + 1)) (acc : RawRat) (done : Bool) + (bound : List Bool) + (hlarge : + (rawRatBinaryCode + (acc.add (rawDirectedBetheObjectiveCoordinate tau A y p i j))).length + ≤ bound.length) : + machineDirectedObjectiveSumFinish + (machineDirectedObjectiveSumCanonicalState + tau A y p i j acc done bound) = + machineDirectedObjectiveSumCanonicalState tau A y p i j + (acc.add (rawDirectedBetheObjectiveCoordinate tau A y p i j)) + true bound := by + rw [machineDirectedObjectiveSumFinish] + simp only [machineDirectedObjectiveSumRow_canonicalState, + machineDirectedObjectiveSumColumn_canonicalState, + machineDirectedObjectiveSumNextAcc_canonicalState + tau A y p i j acc done bound hlarge, + machineDirectedObjectiveSumBound_canonicalState, + machineDirectedObjectiveSumPayload_canonicalState] + rfl + +theorem machineDirectedObjectiveSumAdvanceRow_canonicalState + {m : ℕ} (tau : ℚ) + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p : ℕ) + (i j : Fin (m + 1)) (acc : RawRat) (done : Bool) + (bound : List Bool) (hi : i ≠ Fin.last m) + (hbound : m ≤ bound.length) + (hlarge : + (rawRatBinaryCode + (acc.add (rawDirectedBetheObjectiveCoordinate tau A y p i j))).length + ≤ bound.length) : + machineDirectedObjectiveSumAdvanceRow + (machineDirectedObjectiveSumCanonicalState + tau A y p i j acc done bound) = + machineDirectedObjectiveSumCanonicalState tau A y p + (betheFloorScanNextFin i) ⟨0, by omega⟩ + (acc.add (rawDirectedBetheObjectiveCoordinate tau A y p i j)) + done bound := by + rw [machineDirectedObjectiveSumAdvanceRow] + simp only [machineDirectedObjectiveSumNextRow_canonicalState + tau A y p i j acc done bound hi hbound, + machineDirectedObjectiveSumNextAcc_canonicalState + tau A y p i j acc done bound hlarge, + machineDirectedObjectiveSumBound_canonicalState, + machineDirectedObjectiveSumDone_canonicalState, + machineDirectedObjectiveSumPayload_canonicalState] + rfl + +theorem machineDirectedObjectiveSumAdvanceColumn_canonicalState + {m : ℕ} (tau : ℚ) + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p : ℕ) + (i j : Fin (m + 1)) (acc : RawRat) (done : Bool) + (bound : List Bool) (hj : j ≠ Fin.last m) + (hbound : m ≤ bound.length) + (hlarge : + (rawRatBinaryCode + (acc.add (rawDirectedBetheObjectiveCoordinate tau A y p i j))).length + ≤ bound.length) : + machineDirectedObjectiveSumAdvanceColumn + (machineDirectedObjectiveSumCanonicalState + tau A y p i j acc done bound) = + machineDirectedObjectiveSumCanonicalState tau A y p i + (betheFloorScanNextFin j) + (acc.add (rawDirectedBetheObjectiveCoordinate tau A y p i j)) + done bound := by + rw [machineDirectedObjectiveSumAdvanceColumn] + simp only [machineDirectedObjectiveSumRow_canonicalState, + machineDirectedObjectiveSumNextColumn_canonicalState + tau A y p i j acc done bound hj hbound, + machineDirectedObjectiveSumNextAcc_canonicalState + tau A y p i j acc done bound hlarge, + machineDirectedObjectiveSumBound_canonicalState, + machineDirectedObjectiveSumDone_canonicalState, + machineDirectedObjectiveSumPayload_canonicalState] + rfl + +theorem machineDirectedObjectiveSumStep_semanticCode {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p : ℕ) (bound : List Bool) + (state : DirectedObjectiveSumSemanticState m) + (hbound : m ≤ bound.length) + (hlarge : + (rawRatBinaryCode + (state.acc.add (rawDirectedBetheObjectiveCoordinate tau A y p + state.row state.column))).length ≤ bound.length) : + machineDirectedObjectiveSumStep + (machineDirectedObjectiveSumSemanticCode tau A y p bound state) = + machineDirectedObjectiveSumSemanticCode tau A y p bound + (directedObjectiveSumSemanticStep tau A y p state) := by + rcases state with ⟨i, j, acc, done⟩ + cases done + · dsimp only [DirectedObjectiveSumSemanticState.row, + DirectedObjectiveSumSemanticState.column, + DirectedObjectiveSumSemanticState.acc, + DirectedObjectiveSumSemanticState.done] at hlarge ⊢ + by_cases hcolumn : j = Fin.last m + · by_cases hrow : i = Fin.last m + · rw [machineDirectedObjectiveSumStep, + machineDirectedObjectiveSumSemanticCode, + machineDirectedObjectiveSumDone_canonicalState, + machineHeadBit_cons, machineIfHead_false, + machineDirectedObjectiveSumProcess, + machineDirectedObjectiveSumLastColumnBit_canonicalState, + machineHeadBit_cons] + have hc : decide (j = Fin.last m) = true := by simp [hcolumn] + have hr : decide (i = Fin.last m) = true := by simp [hrow] + rw [hc, machineIfHead_true, + machineDirectedObjectiveSumLastRowBit_canonicalState, + machineHeadBit_cons, hr, machineIfHead_true, + machineDirectedObjectiveSumFinish_canonicalState + tau A y p i j acc false bound hlarge] + simp [machineDirectedObjectiveSumSemanticCode, + directedObjectiveSumSemanticStep, hcolumn, hrow] + · rw [machineDirectedObjectiveSumStep, + machineDirectedObjectiveSumSemanticCode, + machineDirectedObjectiveSumDone_canonicalState, + machineHeadBit_cons, machineIfHead_false, + machineDirectedObjectiveSumProcess, + machineDirectedObjectiveSumLastColumnBit_canonicalState, + machineHeadBit_cons] + have hc : decide (j = Fin.last m) = true := by simp [hcolumn] + have hr : decide (i = Fin.last m) = false := by simp [hrow] + rw [hc, machineIfHead_true, + machineDirectedObjectiveSumLastRowBit_canonicalState, + machineHeadBit_cons, hr, machineIfHead_false, + machineDirectedObjectiveSumAdvanceRow_canonicalState + tau A y p i j acc false bound hrow hbound hlarge] + simp [machineDirectedObjectiveSumSemanticCode, + directedObjectiveSumSemanticStep, hcolumn, hrow] + · rw [machineDirectedObjectiveSumStep, + machineDirectedObjectiveSumSemanticCode, + machineDirectedObjectiveSumDone_canonicalState, + machineHeadBit_cons, machineIfHead_false, + machineDirectedObjectiveSumProcess, + machineDirectedObjectiveSumLastColumnBit_canonicalState, + machineHeadBit_cons] + have hc : decide (j = Fin.last m) = false := by simp [hcolumn] + rw [hc, machineIfHead_false, + machineDirectedObjectiveSumAdvanceColumn_canonicalState + tau A y p i j acc false bound hcolumn hbound hlarge] + simp [machineDirectedObjectiveSumSemanticCode, + directedObjectiveSumSemanticStep, hcolumn] + · dsimp only [DirectedObjectiveSumSemanticState.row, + DirectedObjectiveSumSemanticState.column, + DirectedObjectiveSumSemanticState.acc, + DirectedObjectiveSumSemanticState.done] at hlarge ⊢ + rw [machineDirectedObjectiveSumStep, + machineDirectedObjectiveSumSemanticCode, + machineDirectedObjectiveSumDone_canonicalState, + machineHeadBit_cons, machineIfHead_true] + simp [machineDirectedObjectiveSumSemanticCode, + directedObjectiveSumSemanticStep] + +@[simp] theorem machineDirectedObjectiveSumInit_encode {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p : ℕ) : + machineDirectedObjectiveSumInit + (machineDirectedObjectiveSumCanonicalWord tau A y p) = + machineDirectedObjectiveSumSemanticCode tau A y p + (machineDirectedObjectiveSumAccumulatorBound + (machineDirectedObjectiveSumCanonicalWord tau A y p)) + (directedObjectiveSumSemanticInit m) := by + simp [machineDirectedObjectiveSumInit, + machineDirectedObjectiveSumSemanticCode, + machineDirectedObjectiveSumCanonicalState, + directedObjectiveSumSemanticInit] + +def finalDirectedObjectiveSumSemanticState {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p : ℕ) : + DirectedObjectiveSumSemanticState m := + (directedObjectiveSumSemanticStep tau A y p)^[(m + 1) * (m + 1)] + (directedObjectiveSumSemanticInit m) + +def directedObjectiveSumSemanticStateAt {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p k : ℕ) : + DirectedObjectiveSumSemanticState m := + (directedObjectiveSumSemanticStep tau A y p)^[k] + (directedObjectiveSumSemanticInit m) + +@[simp] theorem directedObjectiveSumSemanticStateAt_zero {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p : ℕ) : + directedObjectiveSumSemanticStateAt tau A y p 0 = + directedObjectiveSumSemanticInit m := rfl + +theorem directedObjectiveSumSemanticStateAt_succ {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p k : ℕ) : + directedObjectiveSumSemanticStateAt tau A y p (k + 1) = + directedObjectiveSumSemanticStep tau A y p + (directedObjectiveSumSemanticStateAt tau A y p k) := by + simp only [directedObjectiveSumSemanticStateAt, + Function.iterate_succ_apply'] + +theorem directedObjectiveSumSemanticStateAt_acc_width {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p k : ℕ) : + let B := rawDirectedObjectiveCoordinateWordBudget m + (machineDirectedObjectiveSumCanonicalWord tau A y p).length + rawRatWidth + (directedObjectiveSumSemanticStateAt tau A y p k).acc ≤ + 1 + k * (B + 1) := by + let B := rawDirectedObjectiveCoordinateWordBudget m + (machineDirectedObjectiveSumCanonicalWord tau A y p).length + induction k with + | zero => + simp [directedObjectiveSumSemanticStateAt, + directedObjectiveSumSemanticInit, rawRatWidth_zero] + | succ k ih => + let state := directedObjectiveSumSemanticStateAt tau A y p k + have ih' : rawRatWidth state.acc ≤ 1 + k * (B + 1) := by + simpa only [state, B] using ih + have hcoordinate : rawRatWidth + (rawDirectedBetheObjectiveCoordinate tau A y p + state.row state.column) ≤ B := by + simpa only [B] using + rawDirectedBetheObjectiveCoordinate_width_le_word_budget + tau A y p state.row state.column + have hstep := directedObjectiveSumSemanticStep_acc_width + (B := B) (C := 1 + k * (B + 1)) tau A y p state ih' hcoordinate + rw [directedObjectiveSumSemanticStateAt_succ] + change rawRatWidth + (directedObjectiveSumSemanticStep tau A y p state).acc ≤ + 1 + (k + 1) * (B + 1) + simpa only [Nat.succ_eq_add_one] using hstep.trans (by + ring_nf + omega) + +theorem rawDirectedObjectiveCoordinateWordBudget_le_pow + {m L : ℕ} (hm : m ≤ L) : + rawDirectedObjectiveCoordinateWordBudget m L ≤ (L + 16) ^ 20 := by + let T := L + 16 + have hT16 : 16 ≤ T := by simp [T] + have hTpos : 0 < T := by omega + have hmT : m ≤ T := hm.trans (by simp [T]) + have hLT : L ≤ T := by simp [T] + have hL1T : L + 1 ≤ T := by simp [T] + have hmm := Nat.mul_le_mul hmT hmT + have hcube0 := Nat.mul_le_mul hmm hL1T + have hcube : m * m * (L + 1) ≤ T ^ 3 := by + simpa [pow_succ, mul_assoc] using hcube0 + have haff : rawBetheAffineEntryWidthBudget m L ≤ 2 * T ^ 3 := by + simp only [rawBetheAffineEntryWidthBudget] + nlinarith [sq_nonneg T] + have hX : rawDirectedObjectiveCoordinateWordXBudget m L ≤ + 26 * T ^ 3 := by + simp only [rawDirectedObjectiveCoordinateWordXBudget] + nlinarith [sq_nonneg T] + have hC : rawDirectedObjectiveCoordinateWordComplementBudget m L ≤ + 315 * T ^ 3 := by + simp only [rawDirectedObjectiveCoordinateWordComplementBudget] + nlinarith [sq_nonneg T] + have hlogA : rawScheduledLogWordBudget L L ≤ 2048 * T ^ 3 := by + have hinner : L + 2 * L + 4 ≤ 4 * T := by omega + have hsquare := Nat.pow_le_pow_left hinner 2 + have hlast : L + 2 ≤ 2 * T := by omega + have hmul := Nat.mul_le_mul (Nat.mul_le_mul_left 64 hsquare) hlast + calc + rawScheduledLogWordBudget L L = + 64 * (L + 2 * L + 4) ^ 2 * (L + 2) := rfl + _ ≤ 64 * (4 * T) ^ 2 * (2 * T) := hmul + _ = 2048 * T ^ 3 := by ring + have hinnerX : L + + 2 * rawDirectedObjectiveCoordinateWordXBudget m L + 4 ≤ + 54 * T ^ 3 := by + nlinarith [sq_nonneg T] + have hlastX : rawDirectedObjectiveCoordinateWordXBudget m L + 2 ≤ + 28 * T ^ 3 := by + nlinarith [sq_nonneg T] + have hlogX : rawScheduledLogWordBudget L + (rawDirectedObjectiveCoordinateWordXBudget m L) ≤ + 5225472 * T ^ 9 := by + have hsquare := Nat.pow_le_pow_left hinnerX 2 + have hmul := Nat.mul_le_mul (Nat.mul_le_mul_left 64 hsquare) hlastX + calc + rawScheduledLogWordBudget L + (rawDirectedObjectiveCoordinateWordXBudget m L) = + 64 * (L + + 2 * rawDirectedObjectiveCoordinateWordXBudget m L + 4) ^ 2 * + (rawDirectedObjectiveCoordinateWordXBudget m L + 2) := rfl + _ ≤ 64 * (54 * T ^ 3) ^ 2 * (28 * T ^ 3) := hmul + _ = 5225472 * T ^ 9 := by ring + have hinnerC : L + + 2 * rawDirectedObjectiveCoordinateWordComplementBudget m L + 4 ≤ + 632 * T ^ 3 := by + nlinarith [sq_nonneg T] + have hlastC : rawDirectedObjectiveCoordinateWordComplementBudget m L + 2 ≤ + 317 * T ^ 3 := by + nlinarith [sq_nonneg T] + have hlogC : rawScheduledLogWordBudget L + (rawDirectedObjectiveCoordinateWordComplementBudget m L) ≤ + 8103514112 * T ^ 9 := by + have hsquare := Nat.pow_le_pow_left hinnerC 2 + have hmul := Nat.mul_le_mul (Nat.mul_le_mul_left 64 hsquare) hlastC + calc + rawScheduledLogWordBudget L + (rawDirectedObjectiveCoordinateWordComplementBudget m L) = + 64 * (L + + 2 * rawDirectedObjectiveCoordinateWordComplementBudget m L + 4) ^ 2 * + (rawDirectedObjectiveCoordinateWordComplementBudget m L + 2) := rfl + _ ≤ 64 * (632 * T ^ 3) ^ 2 * (317 * T ^ 3) := hmul + _ = 8103514112 * T ^ 9 := by ring + have hpow39 : T ^ 3 ≤ T ^ 9 := + Nat.pow_le_pow_right hTpos (by omega) + have hbudget : rawDirectedObjectiveCoordinateWordBudget m L ≤ + 8200000000 * T ^ 9 := by + simp only [rawDirectedObjectiveCoordinateWordBudget] + nlinarith + have hconstant : 8200000000 ≤ 16 ^ 11 := by norm_num + have hbasePow : 16 ^ 11 ≤ T ^ 11 := Nat.pow_le_pow_left hT16 11 + have hcoeff : 8200000000 ≤ T ^ 11 := hconstant.trans hbasePow + have hmul := Nat.mul_le_mul_right (T ^ 9) hcoeff + calc + rawDirectedObjectiveCoordinateWordBudget m L ≤ + 8200000000 * T ^ 9 := hbudget + _ ≤ T ^ 11 * T ^ 9 := hmul + _ = (L + 16) ^ 20 := by simp only [T]; ring + +theorem machineDirectedObjectiveSumDimension_le_accumulatorBound {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p : ℕ) : + m ≤ (machineDirectedObjectiveSumAccumulatorBound + (machineDirectedObjectiveSumCanonicalWord tau A y p)).length := by + have hm : m ≤ + (machineDirectedObjectiveSumCanonicalWord tau A y p).length := by + simp only [machineDirectedObjectiveSumCanonicalWord, pair_length, + List.length_replicate] + omega + rw [machineDirectedObjectiveSumAccumulatorBound, + machineIteratedBinaryWidth_length] + exact hm.trans (certificateExpGuardWidth_self_le 6 _) + +theorem machineDirectedObjectiveSumAccumulatorBound_dominates_next {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p k : ℕ) + (hk : k < (m + 1) * (m + 1)) : + let state := directedObjectiveSumSemanticStateAt tau A y p k + (rawRatBinaryCode + (state.acc.add (rawDirectedBetheObjectiveCoordinate tau A y p + state.row state.column))).length ≤ + (machineDirectedObjectiveSumAccumulatorBound + (machineDirectedObjectiveSumCanonicalWord tau A y p)).length := by + let word := machineDirectedObjectiveSumCanonicalWord tau A y p + let L := word.length + let T := L + 16 + let B := rawDirectedObjectiveCoordinateWordBudget m L + let state := directedObjectiveSumSemanticStateAt tau A y p k + have hmL : m ≤ L := by + simp only [L, word, machineDirectedObjectiveSumCanonicalWord, + pair_length, List.length_replicate] + omega + have hT16 : 16 ≤ T := by simp [T] + have hTpos : 0 < T := by omega + have hm1T : m + 1 ≤ T := by + dsimp only [T] + omega + have hworkSquare := Nat.mul_le_mul hm1T hm1T + have hkT : k + 1 ≤ T ^ 2 := by + have hk' : k + 1 ≤ (m + 1) * (m + 1) := by omega + exact hk'.trans (by simpa only [pow_two] using hworkSquare) + have hB : B ≤ T ^ 20 := by + simpa only [B, T] using + rawDirectedObjectiveCoordinateWordBudget_le_pow hmL + have hacc : rawRatWidth state.acc ≤ 1 + k * (B + 1) := by + simpa only [state, B, L, word] using + directedObjectiveSumSemanticStateAt_acc_width tau A y p k + have hcoordinate : rawRatWidth + (rawDirectedBetheObjectiveCoordinate tau A y p + state.row state.column) ≤ B := by + simpa only [state, B, L, word] using + rawDirectedBetheObjectiveCoordinate_width_le_word_budget + tau A y p state.row state.column + have hadd := rawRatWidth_add_le state.acc + (rawDirectedBetheObjectiveCoordinate tau A y p + state.row state.column) + have hnext : rawRatWidth + (state.acc.add (rawDirectedBetheObjectiveCoordinate tau A y p + state.row state.column)) ≤ 1 + (k + 1) * (B + 1) := by + calc + _ ≤ rawRatWidth state.acc + + rawRatWidth (rawDirectedBetheObjectiveCoordinate tau A y p + state.row state.column) + 1 := hadd + _ ≤ (1 + k * (B + 1)) + B + 1 := + Nat.add_le_add_right (Nat.add_le_add hacc hcoordinate) 1 + _ = 1 + (k + 1) * (B + 1) := by ring + have hpow20pos : 1 ≤ T ^ 20 := by + have hbase : 1 ≤ T := by omega + exact one_le_pow₀ hbase + have hB1 : B + 1 ≤ 2 * T ^ 20 := by omega + have hproduct := Nat.mul_le_mul hkT hB1 + have hproductEq : T ^ 2 * (2 * T ^ 20) = 2 * T ^ 22 := by ring + have hwidthMajor : rawRatWidth + (state.acc.add (rawDirectedBetheObjectiveCoordinate tau A y p + state.row state.column)) ≤ 3 * T ^ 22 := by + calc + _ ≤ 1 + (k + 1) * (B + 1) := hnext + _ ≤ 1 + T ^ 2 * (2 * T ^ 20) := + Nat.add_le_add_left hproduct 1 + _ = 1 + 2 * T ^ 22 := by rw [hproductEq] + _ ≤ 3 * T ^ 22 := by + have hpow22 : 1 ≤ T ^ 22 := one_le_pow₀ (by omega) + omega + have hcode := rawRatBinaryCode_length_le_width + (state.acc.add (rawDirectedBetheObjectiveCoordinate tau A y p + state.row state.column)) + have hcodeMajor : + (rawRatBinaryCode + (state.acc.add (rawDirectedBetheObjectiveCoordinate tau A y p + state.row state.column))).length ≤ 10 * T ^ 22 := by + have hpow22 : 4 ≤ T ^ 22 := by + have hbasePow := Nat.pow_le_pow_left hT16 22 + exact (by norm_num : 4 ≤ 16 ^ 22).trans hbasePow + omega + have hten : 10 ≤ T ^ 42 := by + have hbasePow := Nat.pow_le_pow_left hT16 42 + exact (by norm_num : 10 ≤ 16 ^ 42).trans hbasePow + have hmul := Nat.mul_le_mul_right (T ^ 22) hten + have hcodePower : + (rawRatBinaryCode + (state.acc.add (rawDirectedBetheObjectiveCoordinate tau A y p + state.row state.column))).length ≤ T ^ 64 := by + calc + _ ≤ 10 * T ^ 22 := hcodeMajor + _ ≤ T ^ 42 * T ^ 22 := hmul + _ = T ^ 64 := by ring + rw [machineDirectedObjectiveSumAccumulatorBound, + machineIteratedBinaryWidth_length] + exact hcodePower.trans (by + simpa only [T, L, word] using + certificateExpGuardWidth_pow_lower 5 + (machineDirectedObjectiveSumCanonicalWord tau A y p).length) + +theorem machineDirectedObjectiveSumIterate_semanticCode_of_large {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p : ℕ) (bound : List Bool) + (hbound : m ≤ bound.length) + (hlarge : ∀ k, k < (m + 1) * (m + 1) → + let state := directedObjectiveSumSemanticStateAt tau A y p k + (rawRatBinaryCode + (state.acc.add (rawDirectedBetheObjectiveCoordinate tau A y p + state.row state.column))).length ≤ bound.length) : + ∀ k, k ≤ (m + 1) * (m + 1) → + (machineDirectedObjectiveSumStep)^[k] + (machineDirectedObjectiveSumSemanticCode tau A y p bound + (directedObjectiveSumSemanticInit m)) = + machineDirectedObjectiveSumSemanticCode tau A y p bound + (directedObjectiveSumSemanticStateAt tau A y p k) := by + intro k hk + induction k with + | zero => rfl + | succ k ih => + have hklt : k < (m + 1) * (m + 1) := by omega + rw [Function.iterate_succ_apply', ih (by omega)] + have hstep := machineDirectedObjectiveSumStep_semanticCode tau A y p bound + (directedObjectiveSumSemanticStateAt tau A y p k) hbound + (hlarge k hklt) + simpa only [directedObjectiveSumSemanticStateAt, + Function.iterate_succ_apply'] using hstep + +theorem machineDirectedObjectiveSumFinalState_encode_of_large {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p : ℕ) + (hlarge : ∀ k, k < (m + 1) * (m + 1) → + let state := directedObjectiveSumSemanticStateAt tau A y p k + (rawRatBinaryCode + (state.acc.add (rawDirectedBetheObjectiveCoordinate tau A y p + state.row state.column))).length ≤ + (machineDirectedObjectiveSumAccumulatorBound + (machineDirectedObjectiveSumCanonicalWord tau A y p)).length) : + machineDirectedObjectiveSumFinalState + (machineDirectedObjectiveSumCanonicalWord tau A y p) = + machineDirectedObjectiveSumSemanticCode tau A y p + (machineDirectedObjectiveSumAccumulatorBound + (machineDirectedObjectiveSumCanonicalWord tau A y p)) + (finalDirectedObjectiveSumSemanticState tau A y p) := by + rw [machineDirectedObjectiveSumFinalState, + machineDirectedObjectiveSumRuler_encode, List.length_replicate, + machineDirectedObjectiveSumInit_encode] + have hiterate := machineDirectedObjectiveSumIterate_semanticCode_of_large + tau A y p + (machineDirectedObjectiveSumAccumulatorBound + (machineDirectedObjectiveSumCanonicalWord tau A y p)) + (machineDirectedObjectiveSumDimension_le_accumulatorBound tau A y p) + hlarge ((m + 1) * (m + 1)) (by omega) + simpa only [directedObjectiveSumSemanticStateAt, + finalDirectedObjectiveSumSemanticState] using hiterate + +def rawDirectedNegativeObjectiveSum {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p : ℕ) : RawRat := + (finalDirectedObjectiveSumSemanticState tau A y p).acc + +theorem machineDirectedNegativeObjectiveSumRawCode_encode_of_large {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p : ℕ) + (hlarge : ∀ k, k < (m + 1) * (m + 1) → + let state := directedObjectiveSumSemanticStateAt tau A y p k + (rawRatBinaryCode + (state.acc.add (rawDirectedBetheObjectiveCoordinate tau A y p + state.row state.column))).length ≤ + (machineDirectedObjectiveSumAccumulatorBound + (machineDirectedObjectiveSumCanonicalWord tau A y p)).length) : + machineDirectedNegativeObjectiveSumRawCode + (machineDirectedObjectiveSumCanonicalWord tau A y p) = + rawRatBinaryCode (rawDirectedNegativeObjectiveSum tau A y p) := by + rw [machineDirectedNegativeObjectiveSumRawCode, + machineDirectedObjectiveSumFinalState_encode_of_large tau A y p hlarge] + simp [machineDirectedObjectiveSumSemanticCode, + rawDirectedNegativeObjectiveSum] + +@[simp] theorem machineDirectedNegativeObjectiveSumRawCode_encode {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p : ℕ) : + machineDirectedNegativeObjectiveSumRawCode + (machineDirectedObjectiveSumCanonicalWord tau A y p) = + rawRatBinaryCode (rawDirectedNegativeObjectiveSum tau A y p) := by + apply machineDirectedNegativeObjectiveSumRawCode_encode_of_large + intro k hk + exact machineDirectedObjectiveSumAccumulatorBound_dominates_next + tau A y p k hk + +/-! ## Mathematical value of the row-major sum -/ + +def directedNegativeObjectivePairValue {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p : ℕ) + (ij : Fin (m + 1) × Fin (m + 1)) : ℚ := + directedNegativeObjectiveCoordinateLower tau (A ij.1 ij.2) + (betheAffineMatrixQ y ij.1 ij.2) p + +def directedNegativeObjectivePrefix {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p k : ℕ) : ℚ := + ∑ ij ∈ Finset.univ.filter + (fun ij : Fin (m + 1) × Fin (m + 1) => + betheFloorScanOrdinal ij.1 ij.2 < k), + directedNegativeObjectivePairValue tau A y p ij + +theorem directedNegativeObjectivePrefix_succ_of_ordinal {m k : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p : ℕ) + (row column : Fin (m + 1)) + (hordinal : betheFloorScanOrdinal row column = k) : + directedNegativeObjectivePrefix tau A y p (k + 1) = + directedNegativeObjectivePrefix tau A y p k + + directedNegativeObjectiveCoordinateLower tau (A row column) + (betheAffineMatrixQ y row column) p := by + classical + let current : Fin (m + 1) × Fin (m + 1) := (row, column) + let prior := Finset.univ.filter + (fun ij : Fin (m + 1) × Fin (m + 1) => + betheFloorScanOrdinal ij.1 ij.2 < k) + have hcurrentNotMem : current ∉ prior := by + simp only [current, prior, Finset.mem_filter, Finset.mem_univ, + true_and, not_lt] + omega + have hfilter : + Finset.univ.filter + (fun ij : Fin (m + 1) × Fin (m + 1) => + betheFloorScanOrdinal ij.1 ij.2 < k + 1) = + insert current prior := by + ext ij + simp only [Finset.mem_filter, Finset.mem_univ, true_and, + Finset.mem_insert, current, prior] + constructor + · intro hlt + by_cases hprior : betheFloorScanOrdinal ij.1 ij.2 < k + · exact Or.inr hprior + · left + apply betheFloorScanOrdinal_injective m + have heq : betheFloorScanOrdinal ij.1 ij.2 = k := by omega + exact heq.trans hordinal.symm + · intro hmem + rcases hmem with hij | hprior + · subst ij + simpa only [Prod.fst, Prod.snd, hordinal] using Nat.lt_succ_self k + · omega + rw [directedNegativeObjectivePrefix, hfilter, + Finset.sum_insert hcurrentNotMem] + simp only [directedNegativeObjectivePrefix, prior, + directedNegativeObjectivePairValue] + ring + +theorem directedNegativeObjectivePrefix_zero {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p : ℕ) : + directedNegativeObjectivePrefix tau A y p 0 = 0 := by + simp [directedNegativeObjectivePrefix] + +theorem directedNegativeObjectivePrefix_full {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p : ℕ) : + directedNegativeObjectivePrefix tau A y p + ((m + 1) * (m + 1)) = + directedNegativeObjectiveLower tau A (betheAffineMatrixQ y) p := by + classical + have hfilter : + Finset.univ.filter + (fun ij : Fin (m + 1) × Fin (m + 1) => + betheFloorScanOrdinal ij.1 ij.2 < (m + 1) * (m + 1)) = + Finset.univ := by + ext ij + simp [betheFloorScanOrdinal_lt_square] + rw [directedNegativeObjectivePrefix, hfilter, + Fintype.sum_prod_type] + rfl + +def DirectedObjectiveSumValueInvariant {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p k : ℕ) + (state : DirectedObjectiveSumSemanticState m) : Prop := + (state.done = true ∧ (m + 1) * (m + 1) ≤ k ∧ + state.acc.value = + directedNegativeObjectiveLower tau A (betheAffineMatrixQ y) p) ∨ + (state.done = false ∧ + betheFloorScanOrdinal state.row state.column = k ∧ + state.acc.value = directedNegativeObjectivePrefix tau A y p k) + +theorem directedObjectiveSumSemanticInit_valueInvariant {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p : ℕ) : + DirectedObjectiveSumValueInvariant tau A y p 0 + (directedObjectiveSumSemanticInit m) := by + right + refine ⟨rfl, ?_, ?_⟩ + · simp [directedObjectiveSumSemanticInit, betheFloorScanOrdinal] + · rw [directedNegativeObjectivePrefix_zero] + simp [directedObjectiveSumSemanticInit] + +theorem directedObjectiveSumSemanticStep_valueInvariant {m k : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p : ℕ) + (state : DirectedObjectiveSumSemanticState m) + (hinvariant : DirectedObjectiveSumValueInvariant tau A y p k state) : + DirectedObjectiveSumValueInvariant tau A y p (k + 1) + (directedObjectiveSumSemanticStep tau A y p state) := by + rcases hinvariant with hdone | hactive + · rcases hdone with ⟨hdone, hwork, hvalue⟩ + have hstep : directedObjectiveSumSemanticStep tau A y p state = state := by + simp [directedObjectiveSumSemanticStep, hdone] + rw [hstep] + left + exact ⟨hdone, hwork.trans (by omega), hvalue⟩ + · rcases hactive with ⟨hdone, hordinal, hvalue⟩ + have hnextValue : + (state.acc.add (rawDirectedBetheObjectiveCoordinate tau A y p + state.row state.column)).value = + directedNegativeObjectivePrefix tau A y p (k + 1) := by + rw [RawRat.value_add, hvalue, + rawDirectedBetheObjectiveCoordinate, + rawDirectedNegativeObjectiveCoordinateLower_value] + exact (directedNegativeObjectivePrefix_succ_of_ordinal + tau A y p state.row state.column hordinal).symm + by_cases hcolumn : state.column = Fin.last m + · by_cases hrow : state.row = Fin.last m + · have hstep : directedObjectiveSumSemanticStep tau A y p state = + { state with + acc := state.acc.add + (rawDirectedBetheObjectiveCoordinate tau A y p + state.row state.column) + done := true } := by + simp [directedObjectiveSumSemanticStep, hdone, hcolumn, hrow] + rw [hstep] + left + refine ⟨rfl, ?_, ?_⟩ + · rw [hrow, hcolumn] at hordinal + rw [← hordinal, betheFloorScanOrdinal_last_last] + · change + (state.acc.add (rawDirectedBetheObjectiveCoordinate tau A y p + state.row state.column)).value = _ + rw [hnextValue] + have htotal : k + 1 = (m + 1) * (m + 1) := by + rw [← hordinal, hrow, hcolumn, + betheFloorScanOrdinal_last_last] + rw [htotal, directedNegativeObjectivePrefix_full] + · have hstep : directedObjectiveSumSemanticStep tau A y p state = + { state with + row := betheFloorScanNextFin state.row + column := ⟨0, by omega⟩ + acc := state.acc.add + (rawDirectedBetheObjectiveCoordinate tau A y p + state.row state.column) } := by + simp [directedObjectiveSumSemanticStep, hdone, hcolumn, hrow] + rw [hstep] + right + refine ⟨hdone, ?_, hnextValue⟩ + rw [betheFloorScanOrdinal_nextRow state.row hrow, + ← hcolumn, hordinal] + · have hstep : directedObjectiveSumSemanticStep tau A y p state = + { state with + column := betheFloorScanNextFin state.column + acc := state.acc.add + (rawDirectedBetheObjectiveCoordinate tau A y p + state.row state.column) } := by + simp [directedObjectiveSumSemanticStep, hdone, hcolumn] + rw [hstep] + right + refine ⟨hdone, ?_, hnextValue⟩ + rw [betheFloorScanOrdinal_nextColumn state.row state.column hcolumn, + hordinal] + +theorem directedObjectiveSumSemanticStateAt_valueInvariant {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p : ℕ) : ∀ k, + DirectedObjectiveSumValueInvariant tau A y p k + (directedObjectiveSumSemanticStateAt tau A y p k) := by + intro k + induction k with + | zero => exact directedObjectiveSumSemanticInit_valueInvariant tau A y p + | succ k ih => + rw [directedObjectiveSumSemanticStateAt, + Function.iterate_succ_apply'] + exact directedObjectiveSumSemanticStep_valueInvariant tau A y p _ ih + +theorem rawDirectedNegativeObjectiveSum_value {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p : ℕ) : + (rawDirectedNegativeObjectiveSum tau A y p).value = + directedNegativeObjectiveLower tau A (betheAffineMatrixQ y) p := by + have hinvariant := directedObjectiveSumSemanticStateAt_valueInvariant + tau A y p ((m + 1) * (m + 1)) + rcases hinvariant with hdone | hactive + · exact hdone.2.2 + · have hord := hactive.2.1 + have hlt := betheFloorScanOrdinal_lt_square + (directedObjectiveSumSemanticStateAt tau A y p + ((m + 1) * (m + 1))).row + (directedObjectiveSumSemanticStateAt tau A y p + ((m + 1) * (m + 1))).column + omega + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedTransferCost.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedTransferCost.lean new file mode 100644 index 0000000000..45a16de1f0 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedTransferCost.lean @@ -0,0 +1,308 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineRowComplementUpperSum + +/-! +# One directed transfer-cost endpoint as a finite-word function + +The input is `pair rowUnary (pair columnUnary optimizerWord)`. The output is +the unreduced rational endpoint `directedTransferCostUpper` at the fixed +certificate precision and regularization scale. The only row traversal is +the separately verified complement-log upper sum. +-/ + +namespace BeyondBethe + +open Complexity + +def machineTransferRowRuler (word : List Bool) : List Bool := + machinePairFirst word + +def machineTransferRest (word : List Bool) : List Bool := + machinePairSecond word + +def machineTransferColumnRuler (word : List Bool) : List Bool := + machinePairFirst (machineTransferRest word) + +def machineTransferOptimizerWord (word : List Bool) : List Bool := + machinePairSecond (machineTransferRest word) + +def machineTransferMatrixWord (word : List Bool) : List Bool := + machineOptimizerMatrixWord (machineTransferOptimizerWord word) + +def machineTransferEntryCode (word : List Bool) : List Bool := + machineMatrixEntryAtUnary + (pair (machineTransferRowRuler word) + (pair (machineTransferColumnRuler word) + (machineTransferMatrixWord word))) + +def machineTransferComplementInput (word : List Bool) : List Bool := + pair (machineCertificateLogPrecisionRuler + (machineTransferOptimizerWord word)) + (pair (rawRatBinaryCode RawRat.zero) (machineTransferEntryCode word)) + +def machineTransferComplementCode (word : List Bool) : List Bool := + machineNearbyCoordinateComplementCode (machineTransferComplementInput word) + +def machineTransferLogXRawCode (word : List Bool) : List Bool := + machineScheduledLogLowerRawCode + (pair (machineCertificateLogPrecisionRuler + (machineTransferOptimizerWord word)) + (machineTransferEntryCode word)) + +def machineTransferLogComplementRawCode (word : List Bool) : List Bool := + machineScheduledLogLowerRawCode + (pair (machineCertificateLogPrecisionRuler + (machineTransferOptimizerWord word)) + (machineTransferComplementCode word)) + +def machineTransferOnePlusTauRawCode (word : List Bool) : List Bool := + machineRawRatAddCode + (pair rawRatOneCode + (machineCertificateRegularizationScaleRawCode + (machineTransferOptimizerWord word))) + +def machineTransferWeightedLogXRawCode (word : List Bool) : List Bool := + machineRawRatMulCode + (pair (machineTransferOnePlusTauRawCode word) + (machineTransferLogXRawCode word)) + +def machineTransferNegativeDistinguishedRawCode + (word : List Bool) : List Bool := + machineRawRatAddCode + (pair (machineRawRatNegCode (machineTransferWeightedLogXRawCode word)) + (machineRawRatNegCode (machineTransferLogComplementRawCode word))) + +def machineTransferRowUpperRawCode (word : List Bool) : List Bool := + machineRowComplementUpperSumRawCode + (pair (machineTransferRowRuler word) + (machineTransferOptimizerWord word)) + +/-- Unreduced raw-rational code for one directed transfer cost. -/ +def machineDirectedTransferCostUpperRawCode (word : List Bool) : List Bool := + machineRawRatAddCode + (pair (machineTransferNegativeDistinguishedRawCode word) + (machineTransferRowUpperRawCode word)) + +theorem machineTransferRowRuler_mem_FP : machineTransferRowRuler ∈ FP := + machinePairFirst_mem_FP + +theorem machineTransferRest_mem_FP : machineTransferRest ∈ FP := + machinePairSecond_mem_FP + +theorem machineTransferColumnRuler_mem_FP : + machineTransferColumnRuler ∈ FP := by + simpa only [machineTransferColumnRuler] using machineCompose_mem_FP + machineTransferRest_mem_FP machinePairFirst_mem_FP + +theorem machineTransferOptimizerWord_mem_FP : + machineTransferOptimizerWord ∈ FP := by + simpa only [machineTransferOptimizerWord] using machineCompose_mem_FP + machineTransferRest_mem_FP machinePairSecond_mem_FP + +theorem machineTransferMatrixWord_mem_FP : machineTransferMatrixWord ∈ FP := by + simpa only [machineTransferMatrixWord] using machineCompose_mem_FP + machineTransferOptimizerWord_mem_FP machineOptimizerMatrixWord_mem_FP + +theorem machineTransferEntryCode_mem_FP : machineTransferEntryCode ∈ FP := by + have hinput := machinePair_mem_FP machineTransferRowRuler_mem_FP + (machinePair_mem_FP machineTransferColumnRuler_mem_FP + machineTransferMatrixWord_mem_FP) + simpa only [machineTransferEntryCode] using machineCompose_mem_FP hinput + machineMatrixEntryAtUnary_mem_FP + +theorem machineTransferComplementInput_mem_FP : + machineTransferComplementInput ∈ FP := by + have hp := machineCompose_mem_FP machineTransferOptimizerWord_mem_FP + machineCertificateLogPrecisionRuler_mem_FP + exact machinePair_mem_FP hp + (machinePair_mem_FP (machineConst_mem_FP (rawRatBinaryCode RawRat.zero)) + machineTransferEntryCode_mem_FP) + +theorem machineTransferComplementCode_mem_FP : + machineTransferComplementCode ∈ FP := by + simpa only [machineTransferComplementCode] using machineCompose_mem_FP + machineTransferComplementInput_mem_FP + machineNearbyCoordinateComplementCode_mem_FP + +theorem machineTransferLogXRawCode_mem_FP : + machineTransferLogXRawCode ∈ FP := by + have hp := machineCompose_mem_FP machineTransferOptimizerWord_mem_FP + machineCertificateLogPrecisionRuler_mem_FP + have hinput := machinePair_mem_FP hp machineTransferEntryCode_mem_FP + simpa only [machineTransferLogXRawCode] using machineCompose_mem_FP hinput + machineScheduledLogLowerRawCode_mem_FP + +theorem machineTransferLogComplementRawCode_mem_FP : + machineTransferLogComplementRawCode ∈ FP := by + have hp := machineCompose_mem_FP machineTransferOptimizerWord_mem_FP + machineCertificateLogPrecisionRuler_mem_FP + have hinput := machinePair_mem_FP hp machineTransferComplementCode_mem_FP + simpa only [machineTransferLogComplementRawCode] using + machineCompose_mem_FP hinput machineScheduledLogLowerRawCode_mem_FP + +theorem machineTransferOnePlusTauRawCode_mem_FP : + machineTransferOnePlusTauRawCode ∈ FP := by + have htau := machineCompose_mem_FP machineTransferOptimizerWord_mem_FP + machineCertificateRegularizationScaleRawCode_mem_FP + have hinput := machinePair_mem_FP (machineConst_mem_FP rawRatOneCode) htau + simpa only [machineTransferOnePlusTauRawCode] using + machineCompose_mem_FP hinput machineRawRatAddCode_mem_FP + +theorem machineTransferWeightedLogXRawCode_mem_FP : + machineTransferWeightedLogXRawCode ∈ FP := by + have hinput := machinePair_mem_FP + machineTransferOnePlusTauRawCode_mem_FP + machineTransferLogXRawCode_mem_FP + simpa only [machineTransferWeightedLogXRawCode] using + machineCompose_mem_FP hinput machineRawRatMulCode_mem_FP + +theorem machineTransferNegativeDistinguishedRawCode_mem_FP : + machineTransferNegativeDistinguishedRawCode ∈ FP := by + have hfirst := machineCompose_mem_FP + machineTransferWeightedLogXRawCode_mem_FP machineRawRatNegCode_mem_FP + have hsecond := machineCompose_mem_FP + machineTransferLogComplementRawCode_mem_FP machineRawRatNegCode_mem_FP + have hinput := machinePair_mem_FP hfirst hsecond + simpa only [machineTransferNegativeDistinguishedRawCode] using + machineCompose_mem_FP hinput machineRawRatAddCode_mem_FP + +theorem machineTransferRowUpperRawCode_mem_FP : + machineTransferRowUpperRawCode ∈ FP := by + have hinput := machinePair_mem_FP machineTransferRowRuler_mem_FP + machineTransferOptimizerWord_mem_FP + simpa only [machineTransferRowUpperRawCode] using machineCompose_mem_FP hinput + machineRowComplementUpperSumRawCode_mem_FP + +theorem machineDirectedTransferCostUpperRawCode_mem_FP : + machineDirectedTransferCostUpperRawCode ∈ FP := by + have hinput := machinePair_mem_FP + machineTransferNegativeDistinguishedRawCode_mem_FP + machineTransferRowUpperRawCode_mem_FP + simpa only [machineDirectedTransferCostUpperRawCode] using + machineCompose_mem_FP hinput machineRawRatAddCode_mem_FP + +def rawDirectedTransferCostUpper {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) (i j : Fin n) : RawRat := + let p := directedCertificatePrecision n + let tau := rawCertificateRegularizationScale n + let x := X i j + (((RawRat.one.add tau).mul (rawScheduledLogLower x p)).neg.add + (rawScheduledLogLower (1 - x) p).neg).add + (rawRowComplementUpperSum p RawRat.zero (List.ofFn (X i))) + +@[simp] theorem machineTransferEntryCode_encode {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℚ) (i j : Fin n) : + machineTransferEntryCode + (pair (List.replicate i.1 true) + (pair (List.replicate j.1 true) + (rationalOptimizerOutputCode ⟨X, R, C⟩))) = + rationalEntryBinaryCode (X i j) := by + simp [machineTransferEntryCode, machineTransferRowRuler, + machineTransferColumnRuler, machineTransferRest, + machineTransferMatrixWord, machineTransferOptimizerWord] + +@[simp] theorem machineTransferComplementCode_encode {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℚ) (i j : Fin n) : + machineTransferComplementCode + (pair (List.replicate i.1 true) + (pair (List.replicate j.1 true) + (rationalOptimizerOutputCode ⟨X, R, C⟩))) = + rawRatBinaryCode (rawRatOfRat (1 - X i j)) := by + rw [machineTransferComplementCode, machineTransferComplementInput] + simp only [machineTransferOptimizerWord, machineTransferRest, + machinePairSecond_pair, machineCertificateLogPrecisionRuler_encode, + machineTransferEntryCode_encode, + machineNearbyCoordinateComplementCode_encode] + +@[simp] theorem machineTransferLogXRawCode_encode {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℚ) (i j : Fin n) : + machineTransferLogXRawCode + (pair (List.replicate i.1 true) + (pair (List.replicate j.1 true) + (rationalOptimizerOutputCode ⟨X, R, C⟩))) = + rawRatBinaryCode + (rawScheduledLogLower (X i j) (directedCertificatePrecision n)) := by + rw [machineTransferLogXRawCode] + simp only [machineTransferOptimizerWord, machineTransferRest, + machinePairSecond_pair, machineCertificateLogPrecisionRuler_encode, + machineTransferEntryCode_encode, ← rawRatBinaryCode_rawRatOfRat, + machineScheduledLogLowerRawCode_encode] + +@[simp] theorem machineTransferLogComplementRawCode_encode {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℚ) (i j : Fin n) : + machineTransferLogComplementRawCode + (pair (List.replicate i.1 true) + (pair (List.replicate j.1 true) + (rationalOptimizerOutputCode ⟨X, R, C⟩))) = + rawRatBinaryCode + (rawScheduledLogLower (1 - X i j) + (directedCertificatePrecision n)) := by + rw [machineTransferLogComplementRawCode] + simp only [machineTransferOptimizerWord, machineTransferRest, + machinePairSecond_pair, machineCertificateLogPrecisionRuler_encode, + machineTransferComplementCode_encode, + machineScheduledLogLowerRawCode_encode] + +@[simp] theorem machineTransferOnePlusTauRawCode_encode {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℚ) (i j : Fin n) : + machineTransferOnePlusTauRawCode + (pair (List.replicate i.1 true) + (pair (List.replicate j.1 true) + (rationalOptimizerOutputCode ⟨X, R, C⟩))) = + rawRatBinaryCode + (RawRat.one.add (rawCertificateRegularizationScale n)) := by + rw [machineTransferOnePlusTauRawCode] + simp only [machineTransferOptimizerWord, machineTransferRest, + machinePairSecond_pair, + machineCertificateRegularizationScaleRawCode_encode, rawRatOneCode, + machineRawRatAddCode_encode] + +@[simp] theorem machineTransferRowUpperRawCode_encode {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℚ) (i j : Fin n) : + machineTransferRowUpperRawCode + (pair (List.replicate i.1 true) + (pair (List.replicate j.1 true) + (rationalOptimizerOutputCode ⟨X, R, C⟩))) = + rawRatBinaryCode + (rawRowComplementUpperSum (directedCertificatePrecision n) + RawRat.zero (List.ofFn (X i))) := by + simp [machineTransferRowUpperRawCode, machineTransferRowRuler, + machineTransferOptimizerWord, machineTransferRest] + +@[simp] theorem machineDirectedTransferCostUpperRawCode_encode {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℚ) (i j : Fin n) : + machineDirectedTransferCostUpperRawCode + (pair (List.replicate i.1 true) + (pair (List.replicate j.1 true) + (rationalOptimizerOutputCode ⟨X, R, C⟩))) = + rawRatBinaryCode (rawDirectedTransferCostUpper X i j) := by + rw [machineDirectedTransferCostUpperRawCode, + machineTransferNegativeDistinguishedRawCode, + machineTransferWeightedLogXRawCode, + machineTransferOnePlusTauRawCode_encode, + machineTransferLogXRawCode_encode, machineRawRatMulCode_encode, + machineRawRatNegCode_encode, + machineTransferLogComplementRawCode_encode, + machineRawRatNegCode_encode, machineRawRatAddCode_encode, + machineTransferRowUpperRawCode_encode, machineRawRatAddCode_encode] + rfl + +theorem rawDirectedTransferCostUpper_value {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) (i j : Fin n) : + (rawDirectedTransferCostUpper X i j).value = + directedTransferCostUpper (explicitRegularizationScale n) X i j + (directedCertificatePrecision n) := by + rw [rawDirectedTransferCostUpper, directedTransferCostUpper, + RawRat.value_add, RawRat.value_add, RawRat.value_neg, + RawRat.value_neg, RawRat.value_mul, RawRat.value_add, + RawRat.value_one, rawCertificateRegularizationScale_value, + rawScheduledLogLower_value, rawScheduledLogLower_value, + rawRowComplementUpperSum_matrix_value] + ring + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineDyadicFloor.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineDyadicFloor.lean new file mode 100644 index 0000000000..d6f20d5c8c --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineDyadicFloor.lean @@ -0,0 +1,397 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.BinaryRationalFloor +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalArithmetic + +/-! +# Polynomial-time dyadic floor + +The precision is represented by a unary ruler: its value is the ruler's +length. This is essential for an honest `FP` statement, since a dyadic output +with denominator `2^p` has `p + 1` denominator bits. The machine shifts the +absolute numerator by the ruler length, performs verified long division, and +implements Euclidean flooring explicitly for negative inputs. +-/ + +namespace BeyondBethe + +open Complexity + +def machineDyadicPrecisionRuler (word : List Bool) : List Bool := + machinePairFirst word + +def machineDyadicRawCode (word : List Bool) : List Bool := + machinePairSecond word + +def machineDyadicNumeratorCode (word : List Bool) : List Bool := + machinePairFirst (machineDyadicRawCode word) + +def machineDyadicDenominatorBits (word : List Bool) : List Bool := + machinePairSecond (machineDyadicRawCode word) + +def machineDyadicNumeratorSign (word : List Bool) : List Bool := + machineHeadBit (machineDyadicNumeratorCode word) + +def machineDyadicNumeratorAbsBits (word : List Bool) : List Bool := + machineIntegerNatAbsBits (machineDyadicNumeratorCode word) + +def machineDyadicPrecisionZeroBits (word : List Bool) : List Bool := + List.replicate (machineDyadicPrecisionRuler word).length false + +def machineDyadicScaledAbsBits (word : List Bool) : List Bool := + machineIfEmpty (machineDyadicNumeratorAbsBits word) [] + (machineDyadicPrecisionZeroBits word ++ + machineDyadicNumeratorAbsBits word) + +def machineDyadicDivModBits (word : List Bool) : List Bool := + machineBinaryDivModBits + (pair (machineDyadicScaledAbsBits word) + (machineDyadicDenominatorBits word)) + +def machineDyadicQuotientBits (word : List Bool) : List Bool := + machinePairFirst (machineDyadicDivModBits word) + +def machineDyadicRemainderBits (word : List Bool) : List Bool := + machinePairSecond (machineDyadicDivModBits word) + +def machineDyadicQuotientSuccBits (word : List Bool) : List Bool := + machineBinaryAddBits (pair (machineDyadicQuotientBits word) [true]) + +def machineDyadicNegativeFloorAbsBits (word : List Bool) : List Bool := + machineIfEmpty (machineDyadicRemainderBits word) + (machineDyadicQuotientBits word) + (machineDyadicQuotientSuccBits word) + +def machineDyadicFloorAbsBits (word : List Bool) : List Bool := + machineIfHead (machineDyadicNumeratorSign word) + (machineDyadicNegativeFloorAbsBits word) + (machineDyadicQuotientBits word) + +def machineDyadicFloorIntegerCode (word : List Bool) : List Bool := + machineCanonicalIntegerFromSignedAbs + (pair (machineDyadicNumeratorSign word) + (machineDyadicFloorAbsBits word)) + +def machineDyadicPowerDenominatorBits (word : List Bool) : List Bool := + machineDyadicPrecisionZeroBits word ++ [true] + +/-- Unreduced dyadic-floor output, with denominator `2^p`. -/ +def machineRawDyadicFloorCode (word : List Bool) : List Bool := + pair (machineDyadicFloorIntegerCode word) + (machineDyadicPowerDenominatorBits word) + +/-- Canonical public rational encoding of the dyadic floor. -/ +def machineDyadicFloorCode (word : List Bool) : List Bool := + machineNormalizeRawRatBinaryCode (machineRawDyadicFloorCode word) + +theorem machineDyadicPrecisionRuler_mem_FP : + machineDyadicPrecisionRuler ∈ Complexity.FP := machinePairFirst_mem_FP + +theorem machineDyadicRawCode_mem_FP : + machineDyadicRawCode ∈ Complexity.FP := machinePairSecond_mem_FP + +theorem machineDyadicNumeratorCode_mem_FP : + machineDyadicNumeratorCode ∈ Complexity.FP := by + simpa only [machineDyadicNumeratorCode] using + machineCompose_mem_FP machineDyadicRawCode_mem_FP machinePairFirst_mem_FP + +theorem machineDyadicDenominatorBits_mem_FP : + machineDyadicDenominatorBits ∈ Complexity.FP := by + simpa only [machineDyadicDenominatorBits] using + machineCompose_mem_FP machineDyadicRawCode_mem_FP machinePairSecond_mem_FP + +theorem machineDyadicNumeratorSign_mem_FP : + machineDyadicNumeratorSign ∈ Complexity.FP := by + simpa only [machineDyadicNumeratorSign] using + machineCompose_mem_FP machineDyadicNumeratorCode_mem_FP + machineHeadBit_mem_FP + +theorem machineDyadicNumeratorAbsBits_mem_FP : + machineDyadicNumeratorAbsBits ∈ Complexity.FP := by + simpa only [machineDyadicNumeratorAbsBits] using + machineCompose_mem_FP machineDyadicNumeratorCode_mem_FP + machineIntegerNatAbsBits_mem_FP + +theorem machineDyadicPrecisionZeroBits_mem_FP : + machineDyadicPrecisionZeroBits ∈ Complexity.FP := by + simpa only [machineDyadicPrecisionZeroBits, + machineDyadicPrecisionRuler] using + machineCompose_mem_FP machinePairFirst_mem_FP machineZeroBlock_mem_FP + +theorem machineDyadicScaledAbsBits_mem_FP : + machineDyadicScaledAbsBits ∈ Complexity.FP := by + have happend := machineAppend_mem_FP machineDyadicPrecisionZeroBits_mem_FP + machineDyadicNumeratorAbsBits_mem_FP + exact machineIfEmpty_mem_FP machineDyadicNumeratorAbsBits_mem_FP + (machineConst_mem_FP []) happend + +theorem machineDyadicDivModBits_mem_FP : + machineDyadicDivModBits ∈ Complexity.FP := by + have hpair := machinePair_mem_FP machineDyadicScaledAbsBits_mem_FP + machineDyadicDenominatorBits_mem_FP + simpa only [machineDyadicDivModBits] using + machineCompose_mem_FP hpair machineBinaryDivModBits_mem_FP + +theorem machineDyadicQuotientBits_mem_FP : + machineDyadicQuotientBits ∈ Complexity.FP := by + simpa only [machineDyadicQuotientBits] using + machineCompose_mem_FP machineDyadicDivModBits_mem_FP + machinePairFirst_mem_FP + +theorem machineDyadicRemainderBits_mem_FP : + machineDyadicRemainderBits ∈ Complexity.FP := by + simpa only [machineDyadicRemainderBits] using + machineCompose_mem_FP machineDyadicDivModBits_mem_FP + machinePairSecond_mem_FP + +theorem machineDyadicQuotientSuccBits_mem_FP : + machineDyadicQuotientSuccBits ∈ Complexity.FP := by + have hpair := machinePair_mem_FP machineDyadicQuotientBits_mem_FP + (machineConst_mem_FP [true]) + simpa only [machineDyadicQuotientSuccBits] using + machineCompose_mem_FP hpair machineBinaryAddBits_mem_FP + +theorem machineDyadicNegativeFloorAbsBits_mem_FP : + machineDyadicNegativeFloorAbsBits ∈ Complexity.FP := by + exact machineIfEmpty_mem_FP machineDyadicRemainderBits_mem_FP + machineDyadicQuotientBits_mem_FP machineDyadicQuotientSuccBits_mem_FP + +theorem machineDyadicFloorAbsBits_mem_FP : + machineDyadicFloorAbsBits ∈ Complexity.FP := by + exact machineIfHead_mem_FP machineDyadicNumeratorSign_mem_FP + machineDyadicNegativeFloorAbsBits_mem_FP + machineDyadicQuotientBits_mem_FP + +theorem machineDyadicFloorIntegerCode_mem_FP : + machineDyadicFloorIntegerCode ∈ Complexity.FP := by + have hpair := machinePair_mem_FP machineDyadicNumeratorSign_mem_FP + machineDyadicFloorAbsBits_mem_FP + simpa only [machineDyadicFloorIntegerCode] using + machineCompose_mem_FP hpair machineCanonicalIntegerFromSignedAbs_mem_FP + +theorem machineDyadicPowerDenominatorBits_mem_FP : + machineDyadicPowerDenominatorBits ∈ Complexity.FP := by + exact machineAppend_mem_FP machineDyadicPrecisionZeroBits_mem_FP + (machineConst_mem_FP [true]) + +theorem machineRawDyadicFloorCode_mem_FP : + machineRawDyadicFloorCode ∈ Complexity.FP := by + exact machinePair_mem_FP machineDyadicFloorIntegerCode_mem_FP + machineDyadicPowerDenominatorBits_mem_FP + +theorem machineDyadicFloorCode_mem_FP : machineDyadicFloorCode ∈ Complexity.FP := by + simpa only [machineDyadicFloorCode] using + machineCompose_mem_FP machineRawDyadicFloorCode_mem_FP + machineNormalizeRawRatBinaryCode_mem_FP + +private theorem natBits_mul_pow_two_of_ne_zero (n p : ℕ) (hn : n ≠ 0) : + (n * 2 ^ p).bits = List.replicate p false ++ n.bits := by + induction p with + | zero => simp + | succ p ih => + have hproduct : n * 2 ^ p ≠ 0 := mul_ne_zero hn (pow_ne_zero _ (by decide)) + have hrearrange : n * 2 ^ (p + 1) = 2 * (n * 2 ^ p) := by ring + rw [hrearrange, Nat.bit0_bits _ hproduct, ih] + simp [List.replicate_succ] + +private theorem shiftedNatBits (n p : ℕ) : + (if n.bits = [] then [] else List.replicate p false ++ n.bits) = + (n * 2 ^ p).bits := by + by_cases hn : n = 0 + · subst n + simp + · rw [if_neg (natBits_ne_nil_of_ne_zero hn), + natBits_mul_pow_two_of_ne_zero n p hn] + +def binaryRawDyadicFloorInt (p : ℕ) (q : RawRat) : ℤ := + let qr := binaryLongDiv (q.num.natAbs * 2 ^ p) q.den + match q.num with + | .ofNat _ => (qr.1 : ℤ) + | .negSucc _ => + if qr.2 = 0 then -(qr.1 : ℤ) + else -((qr.1 + 1 : ℕ) : ℤ) + +def binaryRawDyadicFloor (p : ℕ) (q : RawRat) : RawRat := + ⟨binaryRawDyadicFloorInt p q, 2 ^ p, by positivity⟩ + +theorem binaryRawDyadicFloorInt_eq_ediv (p : ℕ) (q : RawRat) : + binaryRawDyadicFloorInt p q = + (q.num * (2 ^ p : ℕ)) / (q.den : ℤ) := by + rw [binaryRawDyadicFloorInt, binaryLongDiv_eq_div_mod] + simp only [Prod.fst, Prod.snd] + cases hnum : q.num with + | ofNat n => + simp [hnum, Int.ediv] + | negSucc n => + have hden : 0 < q.den := q.den_pos + let a := (n + 1) * 2 ^ p + have hrepr : Int.negSucc n * (2 ^ p : ℕ) = -((a : ℕ) : ℤ) := by + have hnrepr : Int.negSucc n = -((n + 1 : ℕ) : ℤ) := by omega + rw [hnrepr] + simp only [a] + push_cast + ring + by_cases hrem : a % q.den = 0 + · simp only [hnum, Int.natAbs_negSucc] + change (if a % q.den = 0 then -((a / q.den : ℕ) : ℤ) + else -(((a / q.den : ℕ) + 1 : ℕ) : ℤ)) = _ + rw [if_pos hrem, hrepr] + have hdvdNat : q.den ∣ a := Nat.dvd_of_mod_eq_zero hrem + have hdvdInt : (q.den : ℤ) ∣ (a : ℤ) := by + exact_mod_cast hdvdNat + rw [Int.neg_ediv_of_dvd hdvdInt] + norm_num + · simp only [hnum, Int.natAbs_negSucc] + change (if a % q.den = 0 then -((a / q.den : ℕ) : ℤ) + else -(((a / q.den : ℕ) + 1 : ℕ) : ℤ)) = _ + rw [if_neg hrem, hrepr] + have hndvdNat : ¬ q.den ∣ a := by + rwa [Nat.dvd_iff_mod_eq_zero] + have hndvdInt : ¬ (q.den : ℤ) ∣ (a : ℤ) := by + exact_mod_cast hndvdNat + rw [Int.neg_ediv, if_neg hndvdInt, + Int.sign_eq_one_of_pos (by exact_mod_cast hden)] + norm_num [Nat.add_comm] + ring + +theorem binaryRawDyadicFloorInt_eq_floor (p : ℕ) (q : RawRat) : + binaryRawDyadicFloorInt p q = Int.floor (q.value * (2 : ℚ) ^ p) := by + rw [binaryRawDyadicFloorInt_eq_ediv] + have hvalue : q.value * (2 : ℚ) ^ p = + ((q.num * (2 ^ p : ℕ) : ℤ) : ℚ) / (q.den : ℚ) := by + rw [RawRat.value] + push_cast + ring + rw [hvalue, Rat.floor_intCast_div_natCast] + +theorem binaryRawDyadicFloor_value (p : ℕ) (q : RawRat) : + (binaryRawDyadicFloor p q).value = binaryDyadicFloor p q.value := by + simp only [binaryRawDyadicFloor, RawRat.value] + rw [binaryDyadicFloor, binaryRatFloor_eq_floor] + have hfloor := binaryRawDyadicFloorInt_eq_floor p q + simp only [RawRat.value] at hfloor + rw [← hfloor] + norm_num + +theorem machineDyadicScaledAbsBits_encode (p : ℕ) (q : RawRat) : + machineDyadicScaledAbsBits + (pair (List.replicate p true) (rawRatBinaryCode q)) = + (q.num.natAbs * 2 ^ p).bits := by + simp only [machineDyadicScaledAbsBits, machineDyadicNumeratorAbsBits, + machineDyadicNumeratorCode, machineDyadicRawCode, + machineDyadicPrecisionZeroBits, machineDyadicPrecisionRuler, + machinePairFirst_pair, machinePairSecond_pair, rawRatBinaryCode, + machineIntegerNatAbsBits_encode, List.length_replicate] + cases hbits : q.num.natAbs.bits with + | nil => simpa [hbits] using shiftedNatBits q.num.natAbs p + | cons bit rest => simpa [hbits] using shiftedNatBits q.num.natAbs p + +theorem machineDyadicDivModBits_encode (p : ℕ) (q : RawRat) : + machineDyadicDivModBits + (pair (List.replicate p true) (rawRatBinaryCode q)) = + pair + ((q.num.natAbs * 2 ^ p) / q.den).bits + ((q.num.natAbs * 2 ^ p) % q.den).bits := by + rw [machineDyadicDivModBits, machineDyadicScaledAbsBits_encode] + simp only [machineDyadicDenominatorBits, machineDyadicRawCode, + machinePairSecond_pair, rawRatBinaryCode] + rw [machineBinaryDivModBits_pair_natBits] + +theorem machineDyadicFloorIntegerCode_encode (p : ℕ) (q : RawRat) : + machineDyadicFloorIntegerCode + (pair (List.replicate p true) (rawRatBinaryCode q)) = + integerBinaryCode (binaryRawDyadicFloorInt p q) := by + have hsign : machineDyadicNumeratorSign + (pair (List.replicate p true) (rawRatBinaryCode q)) = + match q.num with + | .ofNat _ => [false] + | .negSucc _ => [true] := by + simp only [machineDyadicNumeratorSign, machineDyadicNumeratorCode, + machineDyadicRawCode, machinePairFirst_pair, machinePairSecond_pair, + rawRatBinaryCode] + cases q.num <;> simp [integerBinaryCode] + have hquot : machineDyadicQuotientBits + (pair (List.replicate p true) (rawRatBinaryCode q)) = + ((q.num.natAbs * 2 ^ p) / q.den).bits := by + rw [machineDyadicQuotientBits, machineDyadicDivModBits_encode] + simp only [machinePairFirst_pair] + have hrembits : machineDyadicRemainderBits + (pair (List.replicate p true) (rawRatBinaryCode q)) = + ((q.num.natAbs * 2 ^ p) % q.den).bits := by + rw [machineDyadicRemainderBits, machineDyadicDivModBits_encode] + simp only [machinePairSecond_pair] + have hsucc : machineDyadicQuotientSuccBits + (pair (List.replicate p true) (rawRatBinaryCode q)) = + (((q.num.natAbs * 2 ^ p) / q.den) + 1).bits := by + rw [machineDyadicQuotientSuccBits, hquot] + simpa using machineBinaryAddBits_pair_natBits + ((q.num.natAbs * 2 ^ p) / q.den) 1 + rw [machineDyadicFloorIntegerCode] + cases hnum : q.num with + | ofNat n => + have hsignFalse : machineDyadicNumeratorSign + (pair (List.replicate p true) (rawRatBinaryCode q)) = [false] := by + simpa [hnum] using hsign + simp only [machineDyadicFloorAbsBits, hsignFalse, + machineIfHead_false, hquot] + rw [machineCanonicalIntegerFromSignedAbs_pair] + simp [binaryRawDyadicFloorInt, hnum, binaryLongDiv_eq_div_mod, + signedMagnitudeValue] + | negSucc n => + have hsignTrue : machineDyadicNumeratorSign + (pair (List.replicate p true) (rawRatBinaryCode q)) = [true] := by + simpa [hnum] using hsign + simp only [machineDyadicFloorAbsBits, hsignTrue, machineIfHead_true, + machineDyadicNegativeFloorAbsBits, hrembits, hquot, hsucc, + hnum, Int.natAbs_negSucc] + by_cases hrem : (n + 1) * 2 ^ p % q.den = 0 + · rw [show ((n + 1) * 2 ^ p % q.den).bits = [] by simp [hrem]] + simp only [machineIfEmpty_nil] + rw [machineCanonicalIntegerFromSignedAbs_pair] + simp [binaryRawDyadicFloorInt, hnum, binaryLongDiv_eq_div_mod, + hrem, signedMagnitudeValue] + · rw [machineIfEmpty_of_ne_nil + (((n + 1) * 2 ^ p % q.den).bits) + (((n + 1) * 2 ^ p / q.den).bits) + ((((n + 1) * 2 ^ p / q.den) + 1).bits) + (natBits_ne_nil_of_ne_zero hrem)] + rw [machineCanonicalIntegerFromSignedAbs_pair] + simp [binaryRawDyadicFloorInt, hnum, binaryLongDiv_eq_div_mod, + hrem, signedMagnitudeValue] + +theorem machineDyadicPowerDenominatorBits_encode (p : ℕ) (q : RawRat) : + machineDyadicPowerDenominatorBits + (pair (List.replicate p true) (rawRatBinaryCode q)) = + (2 ^ p).bits := by + simp [machineDyadicPowerDenominatorBits, + machineDyadicPrecisionZeroBits, machineDyadicPrecisionRuler, + show List.replicate p false ++ [true] = (2 ^ p).bits by + simpa using (natBits_mul_pow_two_of_ne_zero 1 p (by decide)).symm] + +theorem machineRawDyadicFloorCode_encode (p : ℕ) (q : RawRat) : + machineRawDyadicFloorCode + (pair (List.replicate p true) (rawRatBinaryCode q)) = + rawRatBinaryCode (binaryRawDyadicFloor p q) := by + rw [machineRawDyadicFloorCode, machineDyadicFloorIntegerCode_encode, + machineDyadicPowerDenominatorBits_encode] + rfl + +theorem machineDyadicFloorCode_encode (p : ℕ) (q : RawRat) : + machineDyadicFloorCode + (pair (List.replicate p true) (rawRatBinaryCode q)) = + rationalBinaryCode (binaryNormalizeRawRat (binaryRawDyadicFloor p q)) := by + rw [machineDyadicFloorCode, machineRawDyadicFloorCode_encode, + machineNormalizeRawRatBinaryCode_encode] + +theorem machineDyadicFloorCode_binaryDyadicFloor (p : ℕ) (q : RawRat) : + machineDyadicFloorCode + (pair (List.replicate p true) (rawRatBinaryCode q)) = + rationalBinaryCode (binaryDyadicFloor p q.value) := by + rw [machineDyadicFloorCode_encode, + binaryNormalizeRawRat_eq_value, binaryRawDyadicFloor_value] + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineDyadicFloorMatrix.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineDyadicFloorMatrix.lean new file mode 100644 index 0000000000..e16192ac73 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineDyadicFloorMatrix.lean @@ -0,0 +1,564 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineDyadicFloorVector + +/-! +# Polynomial-time coordinatewise matrix dyadic floor + +The outer scan maps the verified vector-floor machine over the encoded rows +of a square rational matrix. +-/ + +namespace BeyondBethe + +open Complexity + +def dyadicFloorMatrixCanonicalWord {d : ℕ} + (p : ℕ) (A : Matrix (Fin d) (Fin d) ℚ) : List Bool := + pair (List.replicate p true) (rationalSquareMatrixRowsCode A) + +theorem dyadicFloorMatrix_entry_code_length_le {d : ℕ} + (p : ℕ) (A : Matrix (Fin d) (Fin d) ℚ) (i j : Fin d) : + (rationalEntryBinaryCode (dyadicFloorMatrix p A i j)).length ≤ + 100 + 72 * (dyadicFloorMatrixCanonicalWord p A).length := by + let word := dyadicFloorMatrixCanonicalWord p A + let q := rawRatOfRat (A i j) + have hq0 := rawRatWidth_le_binaryCode_length q + rw [rawRatBinaryCode_rawRatOfRat] at hq0 + let row := List.ofFn fun k : Fin d ↦ A i k + have hentry := binaryListCode_element_length_le rationalEntryBinaryCode + (show A i j ∈ row by simp [row]) + have hrow := binaryListCode_element_length_le + (binaryListCode rationalEntryBinaryCode) + (show row ∈ rationalMatrixRows A by + simp [rationalMatrixRows, row]) + have hq : rawRatWidth q ≤ word.length := by + apply hq0.trans + apply hentry.trans + apply hrow.trans + simp only [word, dyadicFloorMatrixCanonicalWord, + rationalSquareMatrixRowsCode, pair_length, List.length_replicate] + omega + have hp : p ≤ word.length := by + simp only [word, dyadicFloorMatrixCanonicalWord, pair_length, + List.length_replicate] + omega + have hraw := binaryRawDyadicFloor_width_le p q + have hcanonical := + rationalEntryBinaryCode_binaryNormalizeRawRat_length_le + (binaryRawDyadicFloor p q) + rw [binaryNormalizeRawRat_eq_value, binaryRawDyadicFloor_value, + binaryDyadicFloor_eq_dyadicFloor, rawRatOfRat_value] at hcanonical + exact hcanonical.trans (by nlinarith) + +def machineDyadicFloorMatrixInputBound (word : List Bool) : List Bool := + machineRationalTransposeMulVectorInputBound word + +theorem machineDyadicFloorMatrixInputBound_mem_FP : + machineDyadicFloorMatrixInputBound ∈ FP := + machineRationalTransposeMulVectorInputBound_mem_FP + +theorem dyadicFloorMatrix_code_length_le_cubic {d : ℕ} + (p : ℕ) (A : Matrix (Fin d) (Fin d) ℚ) : + (rationalSquareMatrixRowsCode (dyadicFloorMatrix p A)).length ≤ + d * (2 * (d * + (2 * (100 + 72 * (dyadicFloorMatrixCanonicalWord p A).length) + + 2)) + 2) := by + let L := 100 + 72 * (dyadicFloorMatrixCanonicalWord p A).length + have hentry : ∀ i j : Fin d, + (rationalEntryBinaryCode (dyadicFloorMatrix p A i j)).length ≤ L := by + intro i j + exact dyadicFloorMatrix_entry_code_length_le p A i j + rw [rationalSquareMatrixRowsCode, binaryListCode_length_eq_sum] + simp only [rationalMatrixRows, List.map_ofFn, List.sum_ofFn, + Function.comp_apply] + calc + (∑ i : Fin d, + (2 * (binaryListCode rationalEntryBinaryCode + (List.ofFn fun j ↦ dyadicFloorMatrix p A i j)).length + 2)) ≤ + ∑ _i : Fin d, (2 * (d * (2 * L + 2)) + 2) := by + apply Finset.sum_le_sum + intro i _ + gcongr + rw [binaryListCode_length_eq_sum] + simp only [List.map_ofFn, List.sum_ofFn, Function.comp_apply] + calc + (∑ j : Fin d, + (2 * (rationalEntryBinaryCode + (dyadicFloorMatrix p A i j)).length + 2)) ≤ + ∑ _j : Fin d, (2 * L + 2) := by + apply Finset.sum_le_sum + intro j _ + have h := hentry i j + omega + _ = d * (2 * L + 2) := by simp + _ = d * (2 * (d * (2 * L + 2)) + 2) := by simp + +theorem dyadicFloorMatrix_code_length_le_bound {d : ℕ} + (p : ℕ) (A : Matrix (Fin d) (Fin d) ℚ) : + (rationalSquareMatrixRowsCode (dyadicFloorMatrix p A)).length ≤ + (machineDyadicFloorMatrixInputBound + (dyadicFloorMatrixCanonicalWord p A)).length := by + let word := dyadicFloorMatrixCanonicalWord p A + let n := word.length + let x := 16 + n + let y := 16 + x ^ 2 + let z := 16 + y ^ 2 + have hd : d ≤ word.length := by + have hrows := binaryListCode_listLength_le + (binaryListCode rationalEntryBinaryCode) (rationalMatrixRows A) + have hmatrix : (rationalSquareMatrixRowsCode A).length ≤ word.length := by + simp only [word, dyadicFloorMatrixCanonicalWord, pair_length, + List.length_replicate] + omega + simpa only [rationalSquareMatrixRowsCode, rationalMatrixRows, + List.length_ofFn] using hrows.trans hmatrix + have hn2 : 2 ≤ n := by + simp only [n, word, dyadicFloorMatrixCanonicalWord, pair_length, + List.length_replicate] + omega + have hcubic := dyadicFloorMatrix_code_length_le_cubic p A + have hd' : d ≤ n := by simpa only [n] using hd + have hdd : d * d ≤ n * n := Nat.mul_le_mul hd' hd' + have hddn : (d * d) * n ≤ (n * n) * n := + Nat.mul_le_mul hdd le_rfl + have hpoly : + d * (2 * (d * (2 * (100 + 72 * n) + 2)) + 2) ≤ + 1000 * n ^ 3 := by + nlinarith + have hout : + (rationalSquareMatrixRowsCode (dyadicFloorMatrix p A)).length ≤ + 1000 * n ^ 3 := by + apply hcubic.trans + simpa only [n, word] using hpoly + have hnx : n ≤ x := by simp [x] + have hxpos : 0 < x := by omega + have h1000 : 1000 ≤ x ^ 3 := by + dsimp only [x] + nlinarith + have hnx3 : n ^ 3 ≤ x ^ 3 := Nat.pow_le_pow_left hnx 3 + have hto6 : 1000 * n ^ 3 ≤ x ^ 6 := by + have h := Nat.mul_le_mul h1000 hnx3 + simpa only [← pow_add] using h + have hto8 : x ^ 6 ≤ x ^ 8 := + Nat.pow_le_pow_right hxpos (by omega) + have hxy : x ^ 2 ≤ y := by simp [y] + have hx4y2 : x ^ 4 ≤ y ^ 2 := by + have h := Nat.pow_le_pow_left hxy 2 + simpa only [← pow_mul] using h + have hyz : y ^ 2 ≤ z := by simp [z] + have hx4z : x ^ 4 ≤ z := hx4y2.trans hyz + have hx8z2 : x ^ 8 ≤ z ^ 2 := by + have h := Nat.pow_le_pow_left hx4z 2 + simpa only [← pow_mul] using h + apply hout.trans + apply hto6.trans + apply hto8.trans + apply hx8z2.trans_eq + simp only [machineDyadicFloorMatrixInputBound, + machineRationalTransposeMulVectorInputBound, + machineBinaryMulWidth, List.length_replicate, + List.length_append, n, x, y, z, word, pow_two] + +/-! ## Bounded outer row scan -/ + +def machineDyadicFloorMatrixPrecision (word : List Bool) : List Bool := + machinePairFirst word + +def machineDyadicFloorMatrixRows (word : List Bool) : List Bool := + machinePairSecond word + +def machineDyadicFloorMatrixCurrentRow (state : List Bool) : List Bool := + machineDyadicFloorVectorCode + (pair (machineRationalTransposeMulVectorStatePayload state) + (machineListHead + (machineRationalTransposeMulVectorRemaining state))) + +def machineDyadicFloorMatrixCandidate (state : List Bool) : List Bool := + pair (machineDyadicFloorMatrixCurrentRow state) + (machineRationalTransposeMulVectorAccumulator state) + +def machineDyadicFloorMatrixNextAccumulator + (state : List Bool) : List Bool := + (machineDyadicFloorMatrixCandidate state).take + (machineRationalTransposeMulVectorBound state).length + +def machineDyadicFloorMatrixAdvance (state : List Bool) : List Bool := + machineRationalTransposeMulVectorPack + (machineListTail (machineRationalTransposeMulVectorRemaining state)) + (machineDyadicFloorMatrixNextAccumulator state) + (machineRationalTransposeMulVectorStatePayload state) + (machineRationalTransposeMulVectorBound state) + +def machineDyadicFloorMatrixStep (state : List Bool) : List Bool := + machineIfEmpty (machineRationalTransposeMulVectorRemaining state) state + (machineDyadicFloorMatrixAdvance state) + +def machineDyadicFloorMatrixInit (word : List Bool) : List Bool := + machineRationalTransposeMulVectorPack + (machineDyadicFloorMatrixRows word) [] + (machineDyadicFloorMatrixPrecision word) + (machineDyadicFloorMatrixInputBound word) + +def machineDyadicFloorMatrixWidth (word : List Bool) : List Bool := + let bound := machineDyadicFloorMatrixInputBound word + machineRationalTransposeMulVectorPack bound bound bound bound + +def machineDyadicFloorMatrixFinalState (word : List Bool) : List Bool := + (machineDyadicFloorMatrixStep)^[word.length] + (machineDyadicFloorMatrixInit word) + +def machineDyadicFloorMatrixReversedCode (word : List Bool) : List Bool := + machineRationalTransposeMulVectorAccumulator + (machineDyadicFloorMatrixFinalState word) + +def machineDyadicFloorMatrixCode (word : List Bool) : List Bool := + machineListReverse (machineDyadicFloorMatrixReversedCode word) + +theorem machineDyadicFloorMatrixPrecision_mem_FP : + machineDyadicFloorMatrixPrecision ∈ FP := machinePairFirst_mem_FP + +theorem machineDyadicFloorMatrixRows_mem_FP : + machineDyadicFloorMatrixRows ∈ FP := machinePairSecond_mem_FP + +theorem machineDyadicFloorMatrixCurrentRow_mem_FP : + machineDyadicFloorMatrixCurrentRow ∈ FP := by + have hhead := machineCompose_mem_FP + machineRationalTransposeMulVectorRemaining_mem_FP machineListHead_mem_FP + have hinput := machinePair_mem_FP + machineRationalTransposeMulVectorStatePayload_mem_FP hhead + simpa only [machineDyadicFloorMatrixCurrentRow] using + machineCompose_mem_FP hinput machineDyadicFloorVectorCode_mem_FP + +theorem machineDyadicFloorMatrixCandidate_mem_FP : + machineDyadicFloorMatrixCandidate ∈ FP := + machinePair_mem_FP machineDyadicFloorMatrixCurrentRow_mem_FP + machineRationalTransposeMulVectorAccumulator_mem_FP + +theorem machineDyadicFloorMatrixNextAccumulator_mem_FP : + machineDyadicFloorMatrixNextAccumulator ∈ FP := by + simpa only [machineDyadicFloorMatrixNextAccumulator] using + machineTake_mem_FP machineRationalTransposeMulVectorBound_mem_FP + machineDyadicFloorMatrixCandidate_mem_FP + +theorem machineDyadicFloorMatrixAdvance_mem_FP : + machineDyadicFloorMatrixAdvance ∈ FP := by + have htail := machineCompose_mem_FP + machineRationalTransposeMulVectorRemaining_mem_FP machineListTail_mem_FP + exact machinePair_mem_FP htail + (machinePair_mem_FP machineDyadicFloorMatrixNextAccumulator_mem_FP + (machinePair_mem_FP + machineRationalTransposeMulVectorStatePayload_mem_FP + machineRationalTransposeMulVectorBound_mem_FP)) + +theorem machineDyadicFloorMatrixStep_mem_FP : + machineDyadicFloorMatrixStep ∈ FP := + machineIfEmpty_mem_FP machineRationalTransposeMulVectorRemaining_mem_FP + id_mem_FP machineDyadicFloorMatrixAdvance_mem_FP + +theorem machineDyadicFloorMatrixInit_mem_FP : + machineDyadicFloorMatrixInit ∈ FP := + machinePair_mem_FP machineDyadicFloorMatrixRows_mem_FP + (machinePair_mem_FP (machineConst_mem_FP []) + (machinePair_mem_FP machineDyadicFloorMatrixPrecision_mem_FP + machineDyadicFloorMatrixInputBound_mem_FP)) + +theorem machineDyadicFloorMatrixWidth_mem_FP : + machineDyadicFloorMatrixWidth ∈ FP := by + have hbound := machineDyadicFloorMatrixInputBound_mem_FP + exact machinePair_mem_FP hbound + (machinePair_mem_FP hbound (machinePair_mem_FP hbound hbound)) + +theorem machineDyadicFloorMatrixInit_bound (word : List Bool) : + MachineRationalTransposeMulVectorStateBound word + (machineDyadicFloorMatrixInit word) := by + simp only [MachineRationalTransposeMulVectorStateBound, + machineDyadicFloorMatrixInit, + machineRationalTransposeMulVectorRemaining_pack, + machineRationalTransposeMulVectorAccumulator_pack, + machineRationalTransposeMulVectorStatePayload_pack, + machineRationalTransposeMulVectorBound_pack, + machineDyadicFloorMatrixInputBound] + refine ⟨trivial, ?_, by simp, ?_, trivial⟩ + · exact (machinePairSecond_length_le word).trans + (machineRationalTransposeMulVector_word_le_bound word) + · exact (machinePairFirst_length_le word).trans + (machineRationalTransposeMulVector_word_le_bound word) + +theorem machineDyadicFloorMatrixStep_bound {word state : List Bool} + (hs : MachineRationalTransposeMulVectorStateBound word state) : + MachineRationalTransposeMulVectorStateBound word + (machineDyadicFloorMatrixStep state) := by + dsimp only [MachineRationalTransposeMulVectorStateBound] at hs ⊢ + rcases hs with ⟨hdecomp, hremaining, hacc, hpayload, hbound⟩ + by_cases hnil : machineRationalTransposeMulVectorRemaining state = [] + · rw [machineDyadicFloorMatrixStep, hnil, machineIfEmpty_nil] + exact ⟨hdecomp, hremaining, hacc, hpayload, hbound⟩ + · cases hcode : machineRationalTransposeMulVectorRemaining state with + | nil => exact False.elim (hnil hcode) + | cons bit tail => + rw [machineDyadicFloorMatrixStep, hcode, machineIfEmpty_cons, + machineDyadicFloorMatrixAdvance] + simp only [machineRationalTransposeMulVectorRemaining_pack, + machineRationalTransposeMulVectorAccumulator_pack, + machineRationalTransposeMulVectorStatePayload_pack, + machineRationalTransposeMulVectorBound_pack] + refine ⟨trivial, ?_, ?_, hpayload, hbound⟩ + · exact (machineListTail_length_le + (machineRationalTransposeMulVectorRemaining state)).trans + hremaining + · rw [machineDyadicFloorMatrixNextAccumulator, hbound] + exact List.length_take_le _ _ + +theorem machineDyadicFloorMatrixIterate_bound (word : List Bool) : ∀ k, + MachineRationalTransposeMulVectorStateBound word + ((machineDyadicFloorMatrixStep)^[k] + (machineDyadicFloorMatrixInit word)) := by + intro k + induction k with + | zero => exact machineDyadicFloorMatrixInit_bound word + | succ k ih => + rw [Function.iterate_succ_apply'] + exact machineDyadicFloorMatrixStep_bound ih + +theorem machineDyadicFloorMatrixIterate_length_le_width + (word : List Bool) (iterations : ℕ) + (_ : iterations ≤ word.length) : + ((machineDyadicFloorMatrixStep)^[iterations] + (machineDyadicFloorMatrixInit word)).length ≤ + (machineDyadicFloorMatrixWidth word).length := by + rcases machineDyadicFloorMatrixIterate_bound word iterations with + ⟨hdecomp, hremaining, hacc, hpayload, hbound⟩ + rw [hdecomp, hbound] + simp only [machineRationalTransposeMulVectorPack, + machineDyadicFloorMatrixWidth, machineDyadicFloorMatrixInputBound, + pair_length] + omega + +theorem machineDyadicFloorMatrixFinalState_mem_FP : + machineDyadicFloorMatrixFinalState ∈ FP := by + exact Cobham.iterate_mem_FP machineDyadicFloorMatrixStep_mem_FP + machineDyadicFloorMatrixInit_mem_FP id_mem_FP + machineDyadicFloorMatrixWidth_mem_FP + machineDyadicFloorMatrixIterate_length_le_width + +theorem machineDyadicFloorMatrixReversedCode_mem_FP : + machineDyadicFloorMatrixReversedCode ∈ FP := by + simpa only [machineDyadicFloorMatrixReversedCode] using + machineCompose_mem_FP machineDyadicFloorMatrixFinalState_mem_FP + machineRationalTransposeMulVectorAccumulator_mem_FP + +theorem machineDyadicFloorMatrixCode_mem_FP : + machineDyadicFloorMatrixCode ∈ FP := by + simpa only [machineDyadicFloorMatrixCode] using + machineCompose_mem_FP machineDyadicFloorMatrixReversedCode_mem_FP + machineListReverse_mem_FP + +/-! ## Exact scan semantics -/ + +def dyadicFloorMatrixRowsPrefix {d : ℕ} + (p : ℕ) (A : Matrix (Fin d) (Fin d) ℚ) (k : ℕ) : List (List ℚ) := + (rationalMatrixRows A).take k |>.map + (List.map (dyadicFloor p)) + +def machineDyadicFloorMatrixSemanticState {d : ℕ} + (p : ℕ) (A : Matrix (Fin d) (Fin d) ℚ) (k : ℕ) : List Bool := + let word := dyadicFloorMatrixCanonicalWord p A + machineRationalTransposeMulVectorPack + (binaryListCode (binaryListCode rationalEntryBinaryCode) + ((rationalMatrixRows A).drop k)) + (binaryListCode (binaryListCode rationalEntryBinaryCode) + (dyadicFloorMatrixRowsPrefix p A k).reverse) + (List.replicate p true) (machineDyadicFloorMatrixInputBound word) + +theorem machineDyadicFloorMatrixInit_semantics {d : ℕ} + (p : ℕ) (A : Matrix (Fin d) (Fin d) ℚ) : + machineDyadicFloorMatrixInit (dyadicFloorMatrixCanonicalWord p A) = + machineDyadicFloorMatrixSemanticState p A 0 := by + simp [machineDyadicFloorMatrixInit, + machineDyadicFloorMatrixSemanticState, machineDyadicFloorMatrixRows, + machineDyadicFloorMatrixPrecision, dyadicFloorMatrixCanonicalWord, + rationalSquareMatrixRowsCode, dyadicFloorMatrixRowsPrefix, + binaryListCode] + +theorem dyadicFloorMatrixRowsPrefix_succ {d : ℕ} + (p : ℕ) (A : Matrix (Fin d) (Fin d) ℚ) + (k : ℕ) (hk : k < d) : + dyadicFloorMatrixRowsPrefix p A (k + 1) = + dyadicFloorMatrixRowsPrefix p A k ++ + [List.ofFn fun j ↦ dyadicFloor p (A ⟨k, hk⟩ j)] := by + simp only [dyadicFloorMatrixRowsPrefix, List.map_take] + have hkm : k < (rationalMatrixRows A).length := by + simp [rationalMatrixRows, hk] + simpa [rationalMatrixRows, List.map_ofFn] using + congrArg (List.map (List.map (dyadicFloor p))) + (List.take_concat_get hkm).symm + +theorem machineDyadicFloorMatrixStep_semantics {d : ℕ} + (p : ℕ) (A : Matrix (Fin d) (Fin d) ℚ) + (k : ℕ) (hk : k < d) : + machineDyadicFloorMatrixStep + (machineDyadicFloorMatrixSemanticState p A k) = + machineDyadicFloorMatrixSemanticState p A (k + 1) := by + let word := dyadicFloorMatrixCanonicalWord p A + let row := List.ofFn fun j : Fin d ↦ A ⟨k, hk⟩ j + have hdrop : (rationalMatrixRows A).drop k = + row :: (rationalMatrixRows A).drop (k + 1) := by + convert List.drop_eq_getElem_cons + (show k < (rationalMatrixRows A).length by + simp [rationalMatrixRows, hk]) using 1 + simp [rationalMatrixRows, row] + have hprefix := dyadicFloorMatrixRowsPrefix_succ p A k hk + let roundedRow := List.ofFn fun j : Fin d ↦ dyadicFloor p (A ⟨k, hk⟩ j) + have hreverse : (dyadicFloorMatrixRowsPrefix p A (k + 1)).reverse = + roundedRow :: (dyadicFloorMatrixRowsPrefix p A k).reverse := by + rw [hprefix, List.reverse_append] + simp [roundedRow] + have hcand : + (binaryListCode (binaryListCode rationalEntryBinaryCode) + (dyadicFloorMatrixRowsPrefix p A (k + 1)).reverse).length ≤ + (machineDyadicFloorMatrixInputBound word).length := by + have hprefixBound := binaryListCode_take_reverse_length_le + (binaryListCode rationalEntryBinaryCode) + (rationalMatrixRows (dyadicFloorMatrix p A)) (k + 1) + have hprefixEq : dyadicFloorMatrixRowsPrefix p A (k + 1) = + (rationalMatrixRows (dyadicFloorMatrix p A)).take (k + 1) := by + apply List.ext_getElem + · simp [dyadicFloorMatrixRowsPrefix, rationalMatrixRows] + · intro r hrLeft hrRight + simp [dyadicFloorMatrixRowsPrefix, rationalMatrixRows, + List.map_ofFn] + funext j + rfl + rw [hprefixEq] + exact hprefixBound.trans (dyadicFloorMatrix_code_length_le_bound p A) + have hcandPair : + (pair (binaryListCode rationalEntryBinaryCode roundedRow) + (binaryListCode (binaryListCode rationalEntryBinaryCode) + (dyadicFloorMatrixRowsPrefix p A k).reverse)).length ≤ + (machineDyadicFloorMatrixInputBound word).length := by + simpa only [hreverse, binaryListCode] using hcand + have hnonempty : + binaryListCode (binaryListCode rationalEntryBinaryCode) + ((rationalMatrixRows A).drop k) ≠ [] := by + rw [hdrop] + exact binaryListCode_cons_ne_nil + (binaryListCode rationalEntryBinaryCode) row + ((rationalMatrixRows A).drop (k + 1)) + rw [machineDyadicFloorMatrixStep] + simp only [machineDyadicFloorMatrixSemanticState, + machineRationalTransposeMulVectorRemaining_pack] + rw [machineIfEmpty_of_ne_nil_matrix _ _ _ hnonempty, + machineDyadicFloorMatrixAdvance] + simp only [machineRationalTransposeMulVectorRemaining_pack, + machineRationalTransposeMulVectorAccumulator_pack, + machineRationalTransposeMulVectorStatePayload_pack, + machineRationalTransposeMulVectorBound_pack, + machineDyadicFloorMatrixNextAccumulator, + machineDyadicFloorMatrixCandidate, + machineDyadicFloorMatrixCurrentRow] + rw [hdrop, machineListHead_cons, machineListTail_cons] + change machineRationalTransposeMulVectorPack _ + ((pair (machineDyadicFloorVectorCode + (pair (List.replicate p true) + (binaryListCode rationalEntryBinaryCode row))) + (binaryListCode (binaryListCode rationalEntryBinaryCode) + (dyadicFloorMatrixRowsPrefix p A k).reverse)).take + (machineDyadicFloorMatrixInputBound word).length) _ _ = _ + let rowFn : Fin d → ℚ := fun j ↦ A ⟨k, hk⟩ j + change machineRationalTransposeMulVectorPack _ + ((pair (machineDyadicFloorVectorCode + (dyadicFloorVectorCanonicalWord p rowFn)) + (binaryListCode (binaryListCode rationalEntryBinaryCode) + (dyadicFloorMatrixRowsPrefix p A k).reverse)).take + (machineDyadicFloorMatrixInputBound word).length) _ _ = _ + rw [machineDyadicFloorVectorCode_encode] + change machineRationalTransposeMulVectorPack _ + ((pair (binaryListCode rationalEntryBinaryCode roundedRow) + (binaryListCode (binaryListCode rationalEntryBinaryCode) + (dyadicFloorMatrixRowsPrefix p A k).reverse)).take + (machineDyadicFloorMatrixInputBound word).length) _ _ = _ + rw [List.take_of_length_le hcandPair, hreverse] + rfl + +theorem machineDyadicFloorMatrixIterate_semantics {d : ℕ} + (p : ℕ) (A : Matrix (Fin d) (Fin d) ℚ) : ∀ k ≤ d, + (machineDyadicFloorMatrixStep)^[k] + (machineDyadicFloorMatrixInit + (dyadicFloorMatrixCanonicalWord p A)) = + machineDyadicFloorMatrixSemanticState p A k := by + intro k hk + induction k with + | zero => exact machineDyadicFloorMatrixInit_semantics p A + | succ k ih => + rw [Function.iterate_succ_apply', ih (by omega)] + exact machineDyadicFloorMatrixStep_semantics p A k (by omega) + +theorem machineDyadicFloorMatrix_done_iterate + (extra : ℕ) (accumulator payload bound : List Bool) : + (machineDyadicFloorMatrixStep)^[extra] + (machineRationalTransposeMulVectorPack [] accumulator payload bound) = + machineRationalTransposeMulVectorPack [] accumulator payload bound := by + induction extra with + | zero => rfl + | succ k ih => + rw [Function.iterate_succ_apply', ih] + simp [machineDyadicFloorMatrixStep] + +theorem dyadicFloorMatrixRowsPrefix_all {d : ℕ} + (p : ℕ) (A : Matrix (Fin d) (Fin d) ℚ) : + dyadicFloorMatrixRowsPrefix p A d = + rationalMatrixRows (dyadicFloorMatrix p A) := by + apply List.ext_getElem + · simp [dyadicFloorMatrixRowsPrefix, rationalMatrixRows] + · intro i hiLeft hiRight + simp [dyadicFloorMatrixRowsPrefix, rationalMatrixRows, List.map_ofFn] + funext j + rfl + +theorem machineDyadicFloorMatrixReversedCode_encode {d : ℕ} + (p : ℕ) (A : Matrix (Fin d) (Fin d) ℚ) : + machineDyadicFloorMatrixReversedCode + (dyadicFloorMatrixCanonicalWord p A) = + binaryListCode (binaryListCode rationalEntryBinaryCode) + (rationalMatrixRows (dyadicFloorMatrix p A)).reverse := by + let word := dyadicFloorMatrixCanonicalWord p A + have hd : d ≤ word.length := by + have hrows := binaryListCode_listLength_le + (binaryListCode rationalEntryBinaryCode) (rationalMatrixRows A) + have hmatrix : (rationalSquareMatrixRowsCode A).length ≤ word.length := by + simp only [word, dyadicFloorMatrixCanonicalWord, pair_length, + List.length_replicate] + omega + simpa only [rationalSquareMatrixRowsCode, rationalMatrixRows, + List.length_ofFn] using hrows.trans hmatrix + have hsplit : word.length = (word.length - d) + d := by omega + change machineDyadicFloorMatrixReversedCode word = _ + rw [machineDyadicFloorMatrixReversedCode, + machineDyadicFloorMatrixFinalState, hsplit, + Function.iterate_add_apply, + machineDyadicFloorMatrixIterate_semantics p A d le_rfl] + simp only [machineDyadicFloorMatrixSemanticState] + rw [show binaryListCode (binaryListCode rationalEntryBinaryCode) + ((rationalMatrixRows A).drop d) = [] by + rw [List.drop_eq_nil_of_le (by simp [rationalMatrixRows])] + rfl] + rw [machineDyadicFloorMatrix_done_iterate] + simp only [machineRationalTransposeMulVectorAccumulator_pack] + rw [dyadicFloorMatrixRowsPrefix_all] + +@[simp] theorem machineDyadicFloorMatrixCode_encode {d : ℕ} + (p : ℕ) (A : Matrix (Fin d) (Fin d) ℚ) : + machineDyadicFloorMatrixCode + (dyadicFloorMatrixCanonicalWord p A) = + rationalSquareMatrixRowsCode (dyadicFloorMatrix p A) := by + rw [machineDyadicFloorMatrixCode, + machineDyadicFloorMatrixReversedCode_encode, + machineListReverse_encode, List.reverse_reverse] + rfl + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineDyadicFloorVector.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineDyadicFloorVector.lean new file mode 100644 index 0000000000..ec93ed05c7 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineDyadicFloorVector.lean @@ -0,0 +1,535 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineDyadicFloor +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalEllipsoidUpdate + +/-! +# Polynomial-time coordinatewise dyadic floor + +The scalar dyadic-floor machine returns the public one-natural rational code. +Ellipsoid memory instead uses the self-delimiting numerator--denominator entry +code. We therefore normalize the same raw result into entry format and map +that exact operation over a bounded encoded vector. +-/ + +namespace BeyondBethe + +open Complexity + +def machineDyadicFloorEntryCode (word : List Bool) : List Bool := + machineNormalizeRawRatEntryCode (machineRawDyadicFloorCode word) + +theorem machineDyadicFloorEntryCode_mem_FP : + machineDyadicFloorEntryCode ∈ FP := by + simpa only [machineDyadicFloorEntryCode] using + machineCompose_mem_FP machineRawDyadicFloorCode_mem_FP + machineNormalizeRawRatEntryCode_mem_FP + +@[simp] theorem machineDyadicFloorEntryCode_encode + (p : ℕ) (q : RawRat) : + machineDyadicFloorEntryCode + (pair (List.replicate p true) (rawRatBinaryCode q)) = + rationalEntryBinaryCode (dyadicFloor p q.value) := by + rw [machineDyadicFloorEntryCode, machineRawDyadicFloorCode_encode, + machineNormalizeRawRatEntryCode_encode, + binaryNormalizeRawRat_eq_value, binaryRawDyadicFloor_value, + binaryDyadicFloor_eq_dyadicFloor] + +theorem binaryRawDyadicFloorInt_natAbs_le + (p : ℕ) (q : RawRat) : + (binaryRawDyadicFloorInt p q).natAbs ≤ + q.num.natAbs * 2 ^ p + 1 := by + rw [binaryRawDyadicFloorInt, binaryLongDiv_eq_div_mod] + simp only [Prod.fst, Prod.snd] + cases hnum : q.num with + | ofNat n => + simp only [hnum, Int.natAbs_ofNat'] + exact (Nat.div_le_self _ _).trans (by omega) + | negSucc n => + simp only [hnum, Int.natAbs_negSucc] + split + · simp only [Int.natAbs_neg] + exact (Nat.div_le_self _ _).trans (by omega) + · simp only [Int.natAbs_neg] + have hdiv := Nat.div_le_self ((n + 1) * 2 ^ p) q.den + simpa only [Nat.succ_eq_add_one] using Nat.add_le_add_right hdiv 1 + +theorem binaryRawDyadicFloor_width_le + (p : ℕ) (q : RawRat) : + rawRatWidth (binaryRawDyadicFloor p q) ≤ + rawRatWidth q + p + 1 := by + let w := rawRatWidth q + have hnumLt := rawRat_num_lt_two_pow_width q + have hmulLt : q.num.natAbs * 2 ^ p < 2 ^ (w + p) := by + rw [pow_add] + exact Nat.mul_lt_mul_of_pos_right hnumLt (by positivity) + have hfloor := binaryRawDyadicFloorInt_natAbs_le p q + have hfloorPow : (binaryRawDyadicFloorInt p q).natAbs ≤ + 2 ^ (w + p) := by omega + have hfloorSize := nat_size_le_succ_of_le_two_pow hfloorPow + have hdenSize : (2 ^ p).size = p + 1 := Nat.size_pow + simp only [binaryRawDyadicFloor, rawRatWidth] + rw [hdenSize] + refine max_le (by simpa only [w] using hfloorSize) ?_ + omega + +def dyadicFloorVectorCanonicalWord {d : ℕ} + (p : ℕ) (v : Fin d → ℚ) : List Bool := + pair (List.replicate p true) (rationalFiniteVectorCode v) + +theorem dyadicFloorVector_entry_code_length_le {d : ℕ} + (p : ℕ) (v : Fin d → ℚ) (i : Fin d) : + (rationalEntryBinaryCode (dyadicFloor p (v i))).length ≤ + 100 + 72 * (dyadicFloorVectorCanonicalWord p v).length := by + let word := dyadicFloorVectorCanonicalWord p v + let q := rawRatOfRat (v i) + have hq0 := rawRatWidth_le_binaryCode_length q + rw [rawRatBinaryCode_rawRatOfRat] at hq0 + have helem := binaryListCode_element_length_le rationalEntryBinaryCode + (show v i ∈ List.ofFn v by simp) + have hq : rawRatWidth q ≤ word.length := by + have helem' : (rationalEntryBinaryCode (v i)).length ≤ + (rationalFiniteVectorCode v).length := by + simpa only [rationalFiniteVectorCode] using helem + apply hq0.trans + apply helem'.trans + simp only [word, dyadicFloorVectorCanonicalWord, pair_length, + List.length_replicate] + omega + have hp : p ≤ word.length := by + simp only [word, dyadicFloorVectorCanonicalWord, pair_length, + List.length_replicate] + omega + have hraw := binaryRawDyadicFloor_width_le p q + have hcanonical := + rationalEntryBinaryCode_binaryNormalizeRawRat_length_le + (binaryRawDyadicFloor p q) + rw [binaryNormalizeRawRat_eq_value, binaryRawDyadicFloor_value, + binaryDyadicFloor_eq_dyadicFloor, rawRatOfRat_value] at hcanonical + exact hcanonical.trans (by nlinarith) + +def machineDyadicFloorVectorInputBound (word : List Bool) : List Bool := + machineRationalTransposeMulVectorInputBound word + +theorem machineDyadicFloorVectorInputBound_mem_FP : + machineDyadicFloorVectorInputBound ∈ FP := + machineRationalTransposeMulVectorInputBound_mem_FP + +theorem dyadicFloorVector_code_length_le_bound {d : ℕ} + (p : ℕ) (v : Fin d → ℚ) : + (rationalFiniteVectorCode (dyadicFloorVector p v)).length ≤ + (machineDyadicFloorVectorInputBound + (dyadicFloorVectorCanonicalWord p v)).length := by + let word := dyadicFloorVectorCanonicalWord p v + let L := 100 + 72 * word.length + have hd : d ≤ word.length := by + have hlist := binaryListCode_listLength_le rationalEntryBinaryCode + (List.ofFn v) + have hvector : (rationalFiniteVectorCode v).length ≤ word.length := by + simp only [word, dyadicFloorVectorCanonicalWord, pair_length, + List.length_replicate] + omega + simpa only [rationalFiniteVectorCode, List.length_ofFn] using + hlist.trans hvector + have heach : ∀ q ∈ List.ofFn (dyadicFloorVector p v), + (rationalEntryBinaryCode q).length ≤ L := by + intro q hq + obtain ⟨i, rfl⟩ := List.mem_ofFn.mp hq + exact dyadicFloorVector_entry_code_length_le p v i + have hsum := List.sum_le_card_nsmul + ((List.ofFn (dyadicFloorVector p v)).map + fun q ↦ 2 * (rationalEntryBinaryCode q).length + 2) + (2 * L + 2) (by + intro value hvalue + rw [List.mem_map] at hvalue + obtain ⟨q, hq, rfl⟩ := hvalue + have hq' := heach q hq + omega) + rw [rationalFiniteVectorCode, binaryListCode_length_eq_sum] + simp only [machineDyadicFloorVectorInputBound, + machineRationalTransposeMulVectorInputBound, + machineBinaryMulWidth, List.length_replicate, + List.length_append, List.length_map, List.length_ofFn, + Nat.nsmul_eq_mul] at hsum ⊢ + dsimp only [L, word] at hsum hd ⊢ + nlinarith [sq_nonneg (dyadicFloorVectorCanonicalWord p v).length] + +/-! ## Bounded encoded-list scan -/ + +def machineDyadicFloorVectorPrecision (word : List Bool) : List Bool := + machinePairFirst word + +def machineDyadicFloorVectorEntries (word : List Bool) : List Bool := + machinePairSecond word + +def machineDyadicFloorVectorCurrentEntry + (state : List Bool) : List Bool := + machineDyadicFloorEntryCode + (pair (machineRationalTransposeMulVectorStatePayload state) + (machineListHead + (machineRationalTransposeMulVectorRemaining state))) + +def machineDyadicFloorVectorCandidate (state : List Bool) : List Bool := + pair (machineDyadicFloorVectorCurrentEntry state) + (machineRationalTransposeMulVectorAccumulator state) + +def machineDyadicFloorVectorNextAccumulator + (state : List Bool) : List Bool := + (machineDyadicFloorVectorCandidate state).take + (machineRationalTransposeMulVectorBound state).length + +def machineDyadicFloorVectorAdvance (state : List Bool) : List Bool := + machineRationalTransposeMulVectorPack + (machineListTail (machineRationalTransposeMulVectorRemaining state)) + (machineDyadicFloorVectorNextAccumulator state) + (machineRationalTransposeMulVectorStatePayload state) + (machineRationalTransposeMulVectorBound state) + +def machineDyadicFloorVectorStep (state : List Bool) : List Bool := + machineIfEmpty (machineRationalTransposeMulVectorRemaining state) state + (machineDyadicFloorVectorAdvance state) + +def machineDyadicFloorVectorInit (word : List Bool) : List Bool := + machineRationalTransposeMulVectorPack + (machineDyadicFloorVectorEntries word) [] + (machineDyadicFloorVectorPrecision word) + (machineDyadicFloorVectorInputBound word) + +def machineDyadicFloorVectorWidth (word : List Bool) : List Bool := + let bound := machineDyadicFloorVectorInputBound word + machineRationalTransposeMulVectorPack bound bound bound bound + +def machineDyadicFloorVectorFinalState (word : List Bool) : List Bool := + (machineDyadicFloorVectorStep)^[word.length] + (machineDyadicFloorVectorInit word) + +def machineDyadicFloorVectorReversedCode (word : List Bool) : List Bool := + machineRationalTransposeMulVectorAccumulator + (machineDyadicFloorVectorFinalState word) + +def machineDyadicFloorVectorCode (word : List Bool) : List Bool := + machineListReverse (machineDyadicFloorVectorReversedCode word) + +theorem machineDyadicFloorVectorPrecision_mem_FP : + machineDyadicFloorVectorPrecision ∈ FP := machinePairFirst_mem_FP + +theorem machineDyadicFloorVectorEntries_mem_FP : + machineDyadicFloorVectorEntries ∈ FP := machinePairSecond_mem_FP + +theorem machineDyadicFloorVectorCurrentEntry_mem_FP : + machineDyadicFloorVectorCurrentEntry ∈ FP := by + have hhead := machineCompose_mem_FP + machineRationalTransposeMulVectorRemaining_mem_FP machineListHead_mem_FP + have hinput := machinePair_mem_FP + machineRationalTransposeMulVectorStatePayload_mem_FP hhead + simpa only [machineDyadicFloorVectorCurrentEntry] using + machineCompose_mem_FP hinput machineDyadicFloorEntryCode_mem_FP + +theorem machineDyadicFloorVectorCandidate_mem_FP : + machineDyadicFloorVectorCandidate ∈ FP := + machinePair_mem_FP machineDyadicFloorVectorCurrentEntry_mem_FP + machineRationalTransposeMulVectorAccumulator_mem_FP + +theorem machineDyadicFloorVectorNextAccumulator_mem_FP : + machineDyadicFloorVectorNextAccumulator ∈ FP := by + simpa only [machineDyadicFloorVectorNextAccumulator] using + machineTake_mem_FP machineRationalTransposeMulVectorBound_mem_FP + machineDyadicFloorVectorCandidate_mem_FP + +theorem machineDyadicFloorVectorAdvance_mem_FP : + machineDyadicFloorVectorAdvance ∈ FP := by + have htail := machineCompose_mem_FP + machineRationalTransposeMulVectorRemaining_mem_FP machineListTail_mem_FP + exact machinePair_mem_FP htail + (machinePair_mem_FP machineDyadicFloorVectorNextAccumulator_mem_FP + (machinePair_mem_FP + machineRationalTransposeMulVectorStatePayload_mem_FP + machineRationalTransposeMulVectorBound_mem_FP)) + +theorem machineDyadicFloorVectorStep_mem_FP : + machineDyadicFloorVectorStep ∈ FP := + machineIfEmpty_mem_FP machineRationalTransposeMulVectorRemaining_mem_FP + id_mem_FP machineDyadicFloorVectorAdvance_mem_FP + +theorem machineDyadicFloorVectorInit_mem_FP : + machineDyadicFloorVectorInit ∈ FP := + machinePair_mem_FP machineDyadicFloorVectorEntries_mem_FP + (machinePair_mem_FP (machineConst_mem_FP []) + (machinePair_mem_FP machineDyadicFloorVectorPrecision_mem_FP + machineDyadicFloorVectorInputBound_mem_FP)) + +theorem machineDyadicFloorVectorWidth_mem_FP : + machineDyadicFloorVectorWidth ∈ FP := by + have hbound := machineDyadicFloorVectorInputBound_mem_FP + exact machinePair_mem_FP hbound + (machinePair_mem_FP hbound (machinePair_mem_FP hbound hbound)) + +theorem machineDyadicFloorVectorInit_bound (word : List Bool) : + MachineRationalTransposeMulVectorStateBound word + (machineDyadicFloorVectorInit word) := by + simp only [MachineRationalTransposeMulVectorStateBound, + machineDyadicFloorVectorInit, + machineRationalTransposeMulVectorRemaining_pack, + machineRationalTransposeMulVectorAccumulator_pack, + machineRationalTransposeMulVectorStatePayload_pack, + machineRationalTransposeMulVectorBound_pack, + machineDyadicFloorVectorInputBound] + refine ⟨trivial, ?_, by simp, ?_, trivial⟩ + · exact (machinePairSecond_length_le word).trans + (machineRationalTransposeMulVector_word_le_bound word) + · exact (machinePairFirst_length_le word).trans + (machineRationalTransposeMulVector_word_le_bound word) + +theorem machineDyadicFloorVectorStep_bound {word state : List Bool} + (hs : MachineRationalTransposeMulVectorStateBound word state) : + MachineRationalTransposeMulVectorStateBound word + (machineDyadicFloorVectorStep state) := by + dsimp only [MachineRationalTransposeMulVectorStateBound] at hs ⊢ + rcases hs with ⟨hdecomp, hremaining, hacc, hpayload, hbound⟩ + by_cases hnil : machineRationalTransposeMulVectorRemaining state = [] + · rw [machineDyadicFloorVectorStep, hnil, machineIfEmpty_nil] + exact ⟨hdecomp, hremaining, hacc, hpayload, hbound⟩ + · cases hcode : machineRationalTransposeMulVectorRemaining state with + | nil => exact False.elim (hnil hcode) + | cons bit tail => + rw [machineDyadicFloorVectorStep, hcode, machineIfEmpty_cons, + machineDyadicFloorVectorAdvance] + simp only [machineRationalTransposeMulVectorRemaining_pack, + machineRationalTransposeMulVectorAccumulator_pack, + machineRationalTransposeMulVectorStatePayload_pack, + machineRationalTransposeMulVectorBound_pack] + refine ⟨trivial, ?_, ?_, hpayload, hbound⟩ + · exact (machineListTail_length_le + (machineRationalTransposeMulVectorRemaining state)).trans + hremaining + · rw [machineDyadicFloorVectorNextAccumulator, hbound] + exact List.length_take_le _ _ + +theorem machineDyadicFloorVectorIterate_bound (word : List Bool) : ∀ k, + MachineRationalTransposeMulVectorStateBound word + ((machineDyadicFloorVectorStep)^[k] + (machineDyadicFloorVectorInit word)) := by + intro k + induction k with + | zero => exact machineDyadicFloorVectorInit_bound word + | succ k ih => + rw [Function.iterate_succ_apply'] + exact machineDyadicFloorVectorStep_bound ih + +theorem machineDyadicFloorVectorIterate_length_le_width + (word : List Bool) (iterations : ℕ) + (_ : iterations ≤ word.length) : + ((machineDyadicFloorVectorStep)^[iterations] + (machineDyadicFloorVectorInit word)).length ≤ + (machineDyadicFloorVectorWidth word).length := by + rcases machineDyadicFloorVectorIterate_bound word iterations with + ⟨hdecomp, hremaining, hacc, hpayload, hbound⟩ + rw [hdecomp, hbound] + simp only [machineRationalTransposeMulVectorPack, + machineDyadicFloorVectorWidth, machineDyadicFloorVectorInputBound, + pair_length] + omega + +theorem machineDyadicFloorVectorFinalState_mem_FP : + machineDyadicFloorVectorFinalState ∈ FP := by + exact Cobham.iterate_mem_FP machineDyadicFloorVectorStep_mem_FP + machineDyadicFloorVectorInit_mem_FP id_mem_FP + machineDyadicFloorVectorWidth_mem_FP + machineDyadicFloorVectorIterate_length_le_width + +theorem machineDyadicFloorVectorReversedCode_mem_FP : + machineDyadicFloorVectorReversedCode ∈ FP := by + simpa only [machineDyadicFloorVectorReversedCode] using + machineCompose_mem_FP machineDyadicFloorVectorFinalState_mem_FP + machineRationalTransposeMulVectorAccumulator_mem_FP + +theorem machineDyadicFloorVectorCode_mem_FP : + machineDyadicFloorVectorCode ∈ FP := by + simpa only [machineDyadicFloorVectorCode] using + machineCompose_mem_FP machineDyadicFloorVectorReversedCode_mem_FP + machineListReverse_mem_FP + +/-! ## Exact scan semantics -/ + +def dyadicFloorVectorPrefix {d : ℕ} + (p : ℕ) (v : Fin d → ℚ) (k : ℕ) : List ℚ := + (List.ofFn v).take k |>.map (dyadicFloor p) + +def machineDyadicFloorVectorSemanticState {d : ℕ} + (p : ℕ) (v : Fin d → ℚ) (k : ℕ) : List Bool := + let word := dyadicFloorVectorCanonicalWord p v + machineRationalTransposeMulVectorPack + (binaryListCode rationalEntryBinaryCode ((List.ofFn v).drop k)) + (binaryListCode rationalEntryBinaryCode + (dyadicFloorVectorPrefix p v k).reverse) + (List.replicate p true) (machineDyadicFloorVectorInputBound word) + +theorem machineDyadicFloorVectorInit_semantics {d : ℕ} + (p : ℕ) (v : Fin d → ℚ) : + machineDyadicFloorVectorInit (dyadicFloorVectorCanonicalWord p v) = + machineDyadicFloorVectorSemanticState p v 0 := by + simp [machineDyadicFloorVectorInit, + machineDyadicFloorVectorSemanticState, + machineDyadicFloorVectorEntries, + machineDyadicFloorVectorPrecision, + dyadicFloorVectorCanonicalWord, + rationalFiniteVectorCode, dyadicFloorVectorPrefix, binaryListCode] + +theorem dyadicFloorVectorPrefix_succ {d : ℕ} + (p : ℕ) (v : Fin d → ℚ) (k : ℕ) (hk : k < d) : + dyadicFloorVectorPrefix p v (k + 1) = + dyadicFloorVectorPrefix p v k ++ + [dyadicFloor p (v ⟨k, hk⟩)] := by + simp only [dyadicFloorVectorPrefix, List.map_take] + have hkm : k < (List.ofFn v).length := by simpa + simpa using congrArg (List.map (dyadicFloor p)) + (List.take_concat_get hkm).symm + +theorem machineDyadicFloorVectorStep_semantics {d : ℕ} + (p : ℕ) (v : Fin d → ℚ) (k : ℕ) (hk : k < d) : + machineDyadicFloorVectorStep + (machineDyadicFloorVectorSemanticState p v k) = + machineDyadicFloorVectorSemanticState p v (k + 1) := by + let word := dyadicFloorVectorCanonicalWord p v + let i : Fin d := ⟨k, hk⟩ + have hdrop : (List.ofFn v).drop k = + v i :: (List.ofFn v).drop (k + 1) := by + convert List.drop_eq_getElem_cons + (show k < (List.ofFn v).length by simpa) using 1 + simp [i] + have hprefix := dyadicFloorVectorPrefix_succ p v k hk + have hreverse : (dyadicFloorVectorPrefix p v (k + 1)).reverse = + dyadicFloor p (v i) :: (dyadicFloorVectorPrefix p v k).reverse := by + rw [hprefix, List.reverse_append] + simp [i] + have hcand : + (binaryListCode rationalEntryBinaryCode + (dyadicFloorVectorPrefix p v (k + 1)).reverse).length ≤ + (machineDyadicFloorVectorInputBound word).length := by + have hprefixBound := binaryListCode_take_reverse_length_le + rationalEntryBinaryCode (List.ofFn (dyadicFloorVector p v)) (k + 1) + have hprefixEq : dyadicFloorVectorPrefix p v (k + 1) = + (List.ofFn (dyadicFloorVector p v)).take (k + 1) := by + rw [dyadicFloorVectorPrefix, List.map_take, List.map_ofFn] + rfl + rw [hprefixEq] + exact hprefixBound.trans (dyadicFloorVector_code_length_le_bound p v) + have hcandPair : + (pair (rationalEntryBinaryCode (dyadicFloor p (v i))) + (binaryListCode rationalEntryBinaryCode + (dyadicFloorVectorPrefix p v k).reverse)).length ≤ + (machineDyadicFloorVectorInputBound word).length := by + simpa only [hreverse, binaryListCode] using hcand + have hnonempty : + binaryListCode rationalEntryBinaryCode ((List.ofFn v).drop k) ≠ [] := by + rw [hdrop] + exact binaryListCode_cons_ne_nil rationalEntryBinaryCode (v i) + ((List.ofFn v).drop (k + 1)) + rw [machineDyadicFloorVectorStep] + simp only [machineDyadicFloorVectorSemanticState, + machineRationalTransposeMulVectorRemaining_pack] + rw [machineIfEmpty_of_ne_nil_matrix _ _ _ hnonempty, + machineDyadicFloorVectorAdvance] + simp only [machineRationalTransposeMulVectorRemaining_pack, + machineRationalTransposeMulVectorAccumulator_pack, + machineRationalTransposeMulVectorStatePayload_pack, + machineRationalTransposeMulVectorBound_pack, + machineDyadicFloorVectorNextAccumulator, + machineDyadicFloorVectorCandidate, + machineDyadicFloorVectorCurrentEntry] + rw [hdrop, machineListHead_cons, machineListTail_cons] + change machineRationalTransposeMulVectorPack _ + ((pair (machineDyadicFloorEntryCode + (pair (List.replicate p true) + (rationalEntryBinaryCode (v i)))) + (binaryListCode rationalEntryBinaryCode + (dyadicFloorVectorPrefix p v k).reverse)).take + (machineDyadicFloorVectorInputBound word).length) _ _ = _ + rw [← rawRatBinaryCode_rawRatOfRat, + machineDyadicFloorEntryCode_encode, rawRatOfRat_value] + change machineRationalTransposeMulVectorPack _ + ((pair (rationalEntryBinaryCode (dyadicFloor p (v i))) + (binaryListCode rationalEntryBinaryCode + (dyadicFloorVectorPrefix p v k).reverse)).take + (machineDyadicFloorVectorInputBound word).length) _ _ = _ + rw [List.take_of_length_le hcandPair, hreverse] + rfl + +theorem machineDyadicFloorVectorIterate_semantics {d : ℕ} + (p : ℕ) (v : Fin d → ℚ) : ∀ k ≤ d, + (machineDyadicFloorVectorStep)^[k] + (machineDyadicFloorVectorInit + (dyadicFloorVectorCanonicalWord p v)) = + machineDyadicFloorVectorSemanticState p v k := by + intro k hk + induction k with + | zero => exact machineDyadicFloorVectorInit_semantics p v + | succ k ih => + rw [Function.iterate_succ_apply', ih (by omega)] + exact machineDyadicFloorVectorStep_semantics p v k (by omega) + +theorem machineDyadicFloorVector_done_iterate + (extra : ℕ) (accumulator payload bound : List Bool) : + (machineDyadicFloorVectorStep)^[extra] + (machineRationalTransposeMulVectorPack [] accumulator payload bound) = + machineRationalTransposeMulVectorPack [] accumulator payload bound := by + induction extra with + | zero => rfl + | succ k ih => + rw [Function.iterate_succ_apply', ih] + simp [machineDyadicFloorVectorStep] + +theorem dyadicFloorVectorPrefix_all {d : ℕ} + (p : ℕ) (v : Fin d → ℚ) : + dyadicFloorVectorPrefix p v d = + List.ofFn (dyadicFloorVector p v) := by + rw [dyadicFloorVectorPrefix, + List.take_of_length_le (by simp), List.map_ofFn] + rfl + +theorem machineDyadicFloorVectorReversedCode_encode {d : ℕ} + (p : ℕ) (v : Fin d → ℚ) : + machineDyadicFloorVectorReversedCode + (dyadicFloorVectorCanonicalWord p v) = + binaryListCode rationalEntryBinaryCode + (List.ofFn (dyadicFloorVector p v)).reverse := by + let word := dyadicFloorVectorCanonicalWord p v + have hd : d ≤ word.length := by + have hlist := binaryListCode_listLength_le rationalEntryBinaryCode + (List.ofFn v) + have hvector : (rationalFiniteVectorCode v).length ≤ word.length := by + simp only [word, dyadicFloorVectorCanonicalWord, pair_length, + List.length_replicate] + omega + simpa only [rationalFiniteVectorCode, List.length_ofFn] using + hlist.trans hvector + have hsplit : word.length = (word.length - d) + d := by omega + change machineDyadicFloorVectorReversedCode word = _ + rw [machineDyadicFloorVectorReversedCode, + machineDyadicFloorVectorFinalState, hsplit, + Function.iterate_add_apply, + machineDyadicFloorVectorIterate_semantics p v d le_rfl] + simp only [machineDyadicFloorVectorSemanticState] + rw [show binaryListCode rationalEntryBinaryCode + ((List.ofFn v).drop d) = [] by + rw [List.drop_eq_nil_of_le (by simp)] + rfl] + rw [machineDyadicFloorVector_done_iterate] + simp only [machineRationalTransposeMulVectorAccumulator_pack] + rw [dyadicFloorVectorPrefix_all] + +@[simp] theorem machineDyadicFloorVectorCode_encode {d : ℕ} + (p : ℕ) (v : Fin d → ℚ) : + machineDyadicFloorVectorCode + (dyadicFloorVectorCanonicalWord p v) = + rationalFiniteVectorCode (dyadicFloorVector p v) := by + rw [machineDyadicFloorVectorCode, + machineDyadicFloorVectorReversedCode_encode, + machineListReverse_encode, List.reverse_reverse] + rfl + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineEncoding.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineEncoding.lean new file mode 100644 index 0000000000..21eb478f25 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineEncoding.lean @@ -0,0 +1,125 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.AlgorithmicSpec +import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal + +/-! +# Machine access to the canonical binary encodings + +The public theorem uses right-nested `Complexity.pair` codes. This file +records both their exact behavior on well-formed inputs and the already +verified Complexitylib machines that split them in polynomial time. No +semantic decoder or choice function occurs in these accessors. +-/ + +namespace BeyondBethe + +open Complexity + +/-- First component of a machine pair. On a matrix code this is `n.bits`. -/ +def machinePairFirst (word : List Bool) : List Bool := Cobham.fstBlock word + +/-- Second component of a machine pair. On a matrix code this is the encoded +row list. -/ +def machinePairSecond (word : List Bool) : List Bool := Cobham.sndBlock word + +theorem machinePairFirst_mem_FP : machinePairFirst ∈ Complexity.FP := by + simpa only [machinePairFirst] using Cobham.fstBlock_mem_FP + +theorem machinePairSecond_mem_FP : machinePairSecond ∈ Complexity.FP := by + simpa only [machinePairSecond] using Cobham.sndBlock_mem_FP + +@[simp] theorem machinePairFirst_pair (left right : List Bool) : + machinePairFirst (pair left right) = left := by + simp [machinePairFirst] + +@[simp] theorem machinePairSecond_pair (left right : List Bool) : + machinePairSecond (pair left right) = right := by + simp [machinePairSecond] + +/-- The dimension word extracted from a canonical matrix input. -/ +def machineMatrixDimensionWord (word : List Bool) : List Bool := + machinePairFirst word + +/-- The nested row-list word extracted from a canonical matrix input. -/ +def machineMatrixRowsWord (word : List Bool) : List Bool := + machinePairSecond word + +theorem machineMatrixDimensionWord_mem_FP : + machineMatrixDimensionWord ∈ Complexity.FP := by + simpa only [machineMatrixDimensionWord] using machinePairFirst_mem_FP + +theorem machineMatrixRowsWord_mem_FP : + machineMatrixRowsWord ∈ Complexity.FP := by + simpa only [machineMatrixRowsWord] using machinePairSecond_mem_FP + +@[simp] theorem machineMatrixDimensionWord_encode {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) : + machineMatrixDimensionWord + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩) = n.bits := by + simp [rationalMatrixBinaryEncoding, rationalMatrixBinaryCode, + machineMatrixDimensionWord] + +@[simp] theorem machineMatrixRowsWord_encode {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) : + machineMatrixRowsWord + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩) = + binaryListCode (binaryListCode rationalEntryBinaryCode) + (rationalMatrixRows A) := by + simp [rationalMatrixBinaryEncoding, rationalMatrixBinaryCode, + machineMatrixRowsWord] + +/-- A nonempty right-nested list exposes its head through `fstBlock`. -/ +def machineListHead (word : List Bool) : List Bool := machinePairFirst word + +/-- A nonempty right-nested list exposes its tail through `sndBlock`. -/ +def machineListTail (word : List Bool) : List Bool := machinePairSecond word + +theorem machineListHead_mem_FP : machineListHead ∈ Complexity.FP := by + simpa only [machineListHead] using machinePairFirst_mem_FP + +theorem machineListTail_mem_FP : machineListTail ∈ Complexity.FP := by + simpa only [machineListTail] using machinePairSecond_mem_FP + +@[simp] theorem machineListHead_cons {α : Type*} + (encode : α → List Bool) (x : α) (xs : List α) : + machineListHead (binaryListCode encode (x :: xs)) = encode x := by + simp [machineListHead, binaryListCode] + +@[simp] theorem machineListTail_cons {α : Type*} + (encode : α → List Bool) (x : α) (xs : List α) : + machineListTail (binaryListCode encode (x :: xs)) = + binaryListCode encode xs := by + simp [machineListTail, binaryListCode] + +/-- Signed numerator word of a canonical matrix-entry code. -/ +def machineRationalEntryNumeratorWord (word : List Bool) : List Bool := + machinePairFirst word + +/-- Positive denominator word of a canonical matrix-entry code. -/ +def machineRationalEntryDenominatorWord (word : List Bool) : List Bool := + machinePairSecond word + +theorem machineRationalEntryNumeratorWord_mem_FP : + machineRationalEntryNumeratorWord ∈ Complexity.FP := by + simpa only [machineRationalEntryNumeratorWord] using machinePairFirst_mem_FP + +theorem machineRationalEntryDenominatorWord_mem_FP : + machineRationalEntryDenominatorWord ∈ Complexity.FP := by + simpa only [machineRationalEntryDenominatorWord] using machinePairSecond_mem_FP + +@[simp] theorem machineRationalEntryNumeratorWord_encode (q : ℚ) : + machineRationalEntryNumeratorWord (rationalEntryBinaryCode q) = + integerBinaryCode q.num := by + simp [rationalEntryBinaryCode, machineRationalEntryNumeratorWord] + +@[simp] theorem machineRationalEntryDenominatorWord_encode (q : ℚ) : + machineRationalEntryDenominatorWord (rationalEntryBinaryCode q) = + q.den.bits := by + simp [rationalEntryBinaryCode, machineRationalEntryDenominatorWord] + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineExecutableCertificate.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineExecutableCertificate.lean new file mode 100644 index 0000000000..62cdde6eeb --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineExecutableCertificate.lean @@ -0,0 +1,115 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.ExecutableCertificateMagnitude +import LeanPool.BeyondBethe.BeyondBethe.MachineCertificateExpGuard +import LeanPool.BeyondBethe.BeyondBethe.MachineExecutableScannedOptimizerOutput +import LeanPool.BeyondBethe.BeyondBethe.MachineMatchingGain + +/-! +# The certificate evaluator for the executable row-major optimizer + +The arithmetic transducer is the same verified directed-certificate machine +used elsewhere. This file proves its contract for the concrete row-major +optimizer output, using only the executable optimizer's proved certificate-log +magnitude bound. +-/ + +namespace BeyondBethe + +open Complexity + +theorem executableOptimizerCertificate_expApproxSteps_le_sourceBound + (m : ℕ) (B : Matrix (Fin (m + 2)) (Fin (m + 2)) ℚ) + (hBpos : ∀ i j, 0 < B i j) + (hBupper : ∀ i j, B i j ≤ 1) : + RawRat.expApproxSteps + (rawRatOfRat + (explicitDirectedCertificateLog + (executableScannedBetheOptimizerMatrix (m := m + 1) B) + (executableScannedBetheOptimizerRowPotential (m := m + 1) B) + (executableScannedBetheOptimizerColumnPotential (m := m + 1) B))) + (rawCertificateExpLoss (m + 2)) ≤ + explicitCertificateExpStepBound + (rationalMatrixBinaryEncoding.encode ⟨m + 2, B⟩).length := by + exact certificate_expApproxSteps_le_sourceBound_of_abs_le m B _ + (executableOptimizerCertificateLog_abs_le m B hBpos hBupper) + +theorem machineExecutableOptimizerCertificateExpGuard_fits + (m : ℕ) (B : Matrix (Fin (m + 2)) (Fin (m + 2)) ℚ) + (hBpos : ∀ i j, 0 < B i j) + (hBupper : ∀ i j, B i j ≤ 1) : + RawRat.expApproxSteps + (rawRatOfRat + (explicitDirectedCertificateLog + (executableScannedBetheOptimizerMatrix (m := m + 1) B) + (executableScannedBetheOptimizerRowPotential (m := m + 1) B) + (executableScannedBetheOptimizerColumnPotential (m := m + 1) B))) + (rawCertificateExpLoss (m + 2)) ≤ + (machineOptimizerCertificateExpGuard + (pair (rationalMatrixBinaryEncoding.encode ⟨m + 2, B⟩) + (rationalOptimizerOutputCode + (executableLargeOptimizerOutput m B)))).length := by + let source := rationalMatrixBinaryEncoding.encode ⟨m + 2, B⟩ + have hsource : 2 ≤ source.length := + (show 2 ≤ m + 2 by omega).trans (matrix_dimension_le_code_length B) + exact + (executableOptimizerCertificate_expApproxSteps_le_sourceBound + m B hBpos hBupper).trans + (by simpa only [machineOptimizerCertificateExpGuard, + machineCertificateSourceWord_pair, + machineIteratedBinaryWidth_length, source] using + explicitCertificateExpStepBound_le_guardWidth hsource) + +/-- Correctness of a raw certificate transducer on the concrete outputs of +the executable row-major optimizer. -/ +def ExecutableCertificateEvaluatorStringRealizesOnPositiveNormalized + (F : List Bool → List Bool) : Prop := + ∀ (m : ℕ) (B : Matrix (Fin (m + 2)) (Fin (m + 2)) ℚ), + (∀ i j, 0 < B i j) → (∀ i j, B i j ≤ 1) → + F (pair (rationalMatrixBinaryEncoding.encode ⟨m + 2, B⟩) + (rationalOptimizerOutputCode (executableLargeOptimizerOutput m B))) = + rawRatBinaryCode + (rawRatOfRat + (explicitDirectedCertificateValue + (executableScannedBetheOptimizerMatrix (m := m + 1) B) + (executableScannedBetheOptimizerRowPotential (m := m + 1) B) + (executableScannedBetheOptimizerColumnPotential (m := m + 1) B))) + +def machineExecutableCertificateValueRawCode : List Bool → List Bool := + machineCertificateValueRawCode machineExplicitMatchingGainRawCode + machineOptimizerCertificateExpGuard + +theorem machineExecutableCertificateValueRawCode_mem_FP : + machineExecutableCertificateValueRawCode ∈ FP := by + simpa only [machineExecutableCertificateValueRawCode] using + machineCertificateValueRawCode_mem_FP + machineExplicitMatchingGainRawCode_mem_FP + machineOptimizerCertificateExpGuard_mem_FP + +theorem machineExecutableCertificateValueRawCode_realizes_onPositive : + ExecutableCertificateEvaluatorStringRealizesOnPositiveNormalized + machineExecutableCertificateValueRawCode := by + intro m B hBpos hBupper + simpa only [machineExecutableCertificateValueRawCode, + executableLargeOptimizerOutput, executableScannedOptimizerOutput, + Nat.add_assoc, Nat.add_comm, Nat.add_left_comm] using + machineCertificateValueRawCode_encode + (gainMachine := machineExplicitMatchingGainRawCode) + (guardMachine := machineOptimizerCertificateExpGuard) + (rationalMatrixBinaryEncoding.encode ⟨m + 2, B⟩) + (executableScannedBetheOptimizerMatrix (m := m + 1) B) + (executableScannedBetheOptimizerRowPotential (m := m + 1) B) + (executableScannedBetheOptimizerColumnPotential (m := m + 1) B) + (machineExplicitMatchingGainRawCode_encode + (rationalMatrixBinaryEncoding.encode ⟨m + 2, B⟩) + (executableScannedBetheOptimizerMatrix (m := m + 1) B) + (executableScannedBetheOptimizerRowPotential (m := m + 1) B) + (executableScannedBetheOptimizerColumnPotential (m := m + 1) B)) + (machineExecutableOptimizerCertificateExpGuard_fits + m B hBpos hBupper) + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineExecutablePositiveAlgorithm.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineExecutablePositiveAlgorithm.lean new file mode 100644 index 0000000000..3efe652583 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineExecutablePositiveAlgorithm.lean @@ -0,0 +1,160 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.ExecutablePositiveRoutine +import LeanPool.BeyondBethe.BeyondBethe.MachineExecutableCertificate +import LeanPool.BeyondBethe.BeyondBethe.MachinePositiveAlgorithm + +/-! +# Finite-word realization of the executable positive-matrix routine + +This file composes the concrete row-major optimizer, the concrete certificate +evaluator, normalization, and scale restoration. Correctness is required only +on positive inputs, exactly the domain used by the smoothing reduction. +-/ + +namespace BeyondBethe + +open Complexity + +def executableNormalizedCertificateAlgorithm : + ∀ n, Matrix (Fin n) (Fin n) ℚ → ℚ + | 0, _ => 0 + | 1, _ => 0 + | m + 2, B => + explicitDirectedCertificateValue + (executableScannedBetheOptimizerMatrix (m := m + 1) B) + (executableScannedBetheOptimizerRowPotential (m := m + 1) B) + (executableScannedBetheOptimizerColumnPotential (m := m + 1) B) + +def ExecutableNormalizedCertificateStringRealizesOnPositive + (F : List Bool → List Bool) : Prop := + ∀ (m : ℕ) (B : Matrix (Fin (m + 2)) (Fin (m + 2)) ℚ), + (∀ i j, 0 < B i j) → (∀ i j, B i j ≤ 1) → + F (rationalMatrixBinaryEncoding.encode ⟨m + 2, B⟩) = + rawRatBinaryCode + (rawRatOfRat (executableNormalizedCertificateAlgorithm (m + 2) B)) + +def machineExecutableNormalizedCertificateRawCode : List Bool → List Bool := + machineNormalizedCertificateFromParts + machineExecutableScannedOptimizerOutputCode + machineExecutableCertificateValueRawCode + +theorem machineExecutableNormalizedCertificateRawCode_mem_FP : + machineExecutableNormalizedCertificateRawCode ∈ FP := by + simpa only [machineExecutableNormalizedCertificateRawCode] using + machineNormalizedCertificateFromParts_mem_FP + machineExecutableScannedOptimizerOutputCode_mem_FP + machineExecutableCertificateValueRawCode_mem_FP + +theorem machineExecutableNormalizedCertificateRawCode_realizes_onPositive : + ExecutableNormalizedCertificateStringRealizesOnPositive + machineExecutableNormalizedCertificateRawCode := by + intro m B hBpos hBupper + rw [machineExecutableNormalizedCertificateRawCode, + machineNormalizedCertificateFromParts, + machineCompletedDimensionLtTwoBit_encode, + show [decide (m + 2 < 2)] = [false] by simp, + machineIfHead_false, + machineExecutableScannedOptimizerOutputCode_realizes m B hBpos hBupper, + machineExecutableCertificateValueRawCode_realizes_onPositive + m B hBpos hBupper] + rfl + +theorem machineExecutablePositiveLargeRawCode_encode_onPositive + {certificateMachine : List Bool → List Bool} + (hrealizes : + ExecutableNormalizedCertificateStringRealizesOnPositive + certificateMachine) + (m : ℕ) (A : Matrix (Fin (m + 2)) (Fin (m + 2)) ℚ) + (hA : Matrix.Positive (fun i j ↦ (A i j : ℝ))) : + machinePositiveLargeRawCode certificateMachine + (rationalMatrixBinaryEncoding.encode ⟨m + 2, A⟩) = + rawRatBinaryCode + (rawRatOfRat (executablePositiveAlgorithm (m + 2) A)) := by + have hAq : ∀ i j, 0 < A i j := fun i j ↦ Rat.cast_pos.mp (hA i j) + have hA0 : Matrix.Nonnegative A := fun i j ↦ (hAq i j).le + have hBpos : ∀ i j, 0 < normalizedRationalMatrix A i j := by + intro i j + rw [normalizedRationalMatrix] + exact div_pos (hAq i j) (rationalNormalizationScale_pos hA0) + have hBupper : ∀ i j, normalizedRationalMatrix A i j ≤ 1 := + normalizedRationalMatrix_le_one hA0 + have hcertificate := hrealizes m (normalizedRationalMatrix A) + hBpos hBupper + change certificateMachine + (rationalMatrixBinaryEncoding.encode + ⟨m + 2, normalizedRationalMatrix A⟩) = + rawRatBinaryCode + (rawRatOfRat + (explicitDirectedCertificateValue + (executableScannedBetheOptimizerMatrix (m := m + 1) + (normalizedRationalMatrix A)) + (executableScannedBetheOptimizerRowPotential (m := m + 1) + (normalizedRationalMatrix A)) + (executableScannedBetheOptimizerColumnPotential (m := m + 1) + (normalizedRationalMatrix A)))) at hcertificate + simp only [machinePositiveLargeRawCode, + machinePositiveLargeProductRawCode, + machinePositiveCertificateRawCode, + machinePositiveNormalizedMatrixCode, + machineMatrixNormalizeEntries_encode, + hcertificate, + machineMatrixNormalizationScalePowerRawCode_encode, + machineRawRatMulCode_encode, + machineNormalizeRawRatEntryCode_encode, + ← rawRatBinaryCode_rawRatOfRat] + apply congrArg rawRatBinaryCode + apply congrArg rawRatOfRat + rw [binaryNormalizeRawRat_eq_value, RawRat.value_mul, + RawRat.value_pow, RawRat.value_add, RawRat.value_one, + rawRatRowsSum_value, RawRat.value_zero, zero_add, + rationalMatrixRows_sum, rawRatOfRat_value] + rfl + +theorem machinePositiveAlgorithmRawCode_realizes_executable_onPositive + {certificateMachine : List Bool → List Bool} + (hrealizes : + ExecutableNormalizedCertificateStringRealizesOnPositive + certificateMachine) : + PositiveRawStringRealizes + (machinePositiveAlgorithmRawCode certificateMachine) + executablePositiveAlgorithm := by + intro n A hA + rw [machinePositiveAlgorithmRawCode, + machineCompletedDimensionLtTwoBit_encode] + by_cases hsmall : n < 2 + · rw [show [decide (n < 2)] = [true] by simp [hsmall], + machineIfHead_true, + machinePositiveSmallRawCode_encode hsmall] + interval_cases n <;> rfl + · rw [show [decide (n < 2)] = [false] by simp [hsmall], + machineIfHead_false] + obtain ⟨m, rfl⟩ : ∃ m, n = m + 2 := by + use n - 2 + omega + exact machineExecutablePositiveLargeRawCode_encode_onPositive + hrealizes m A hA + +def machineExecutablePositiveAlgorithmRawCode : List Bool → List Bool := + machinePositiveAlgorithmRawCode + machineExecutableNormalizedCertificateRawCode + +theorem machineExecutablePositiveAlgorithmRawCode_mem_FP : + machineExecutablePositiveAlgorithmRawCode ∈ FP := by + simpa only [machineExecutablePositiveAlgorithmRawCode] using + machinePositiveAlgorithmRawCode_mem_FP + machineExecutableNormalizedCertificateRawCode_mem_FP + +theorem machineExecutablePositiveAlgorithmRawCode_realizes_onPositive : + PositiveRawStringRealizes + machineExecutablePositiveAlgorithmRawCode + executablePositiveAlgorithm := by + simpa only [machineExecutablePositiveAlgorithmRawCode] using + machinePositiveAlgorithmRawCode_realizes_executable_onPositive + machineExecutableNormalizedCertificateRawCode_realizes_onPositive + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineExecutableScannedOptimizerOutput.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineExecutableScannedOptimizerOutput.lean new file mode 100644 index 0000000000..e540314ac4 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineExecutableScannedOptimizerOutput.lean @@ -0,0 +1,1267 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.ExecutableScannedBetheOptimizer +import LeanPool.BeyondBethe.BeyondBethe.MachineUnaryMatrixGenerator +import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerMatrixBitBound +import LeanPool.BeyondBethe.BeyondBethe.OptimizerOutputEncoding + +/-! +# Finite-word output of the executable scanned optimizer + +This file turns the accepted epigraph point into the canonical matrix and +potential words consumed by the certificate evaluator. The first stage is +the complete recovered Birkhoff matrix. Its entries are generated directly +in row-major order and normalized before being inserted into the nested row +encoding. +-/ + +namespace BeyondBethe + +open Complexity + +/-! ## A normalized recovered-matrix entry -/ + +def machineExecutableMatrixEntryRow (word : List Bool) : List Bool := + machinePairFirst word + +def machineExecutableMatrixEntryRest (word : List Bool) : List Bool := + machinePairSecond word + +def machineExecutableMatrixEntryColumn (word : List Bool) : List Bool := + machinePairFirst (machineExecutableMatrixEntryRest word) + +def machineExecutableMatrixEntryPayload (word : List Bool) : List Bool := + machinePairSecond (machineExecutableMatrixEntryRest word) + +def machineExecutableMatrixEntryBaseDimension + (word : List Bool) : List Bool := + machinePairFirst (machineExecutableMatrixEntryPayload word) + +def machineExecutableMatrixEntryPoint (word : List Bool) : List Bool := + machinePairSecond (machineExecutableMatrixEntryPayload word) + +def machineExecutableMatrixEntryRawInput (word : List Bool) : List Bool := + pair (machineExecutableMatrixEntryBaseDimension word) + (pair (machineExecutableMatrixEntryRow word) + (pair (machineExecutableMatrixEntryColumn word) + (machineExecutableMatrixEntryPoint word))) + +def machineExecutableMatrixEntryCode (word : List Bool) : List Bool := + machineNormalizeRawRatEntryCode + (machineBetheAffineEntryRawCode + (machineExecutableMatrixEntryRawInput word)) + +theorem machineExecutableMatrixEntryRow_mem_FP : + machineExecutableMatrixEntryRow ∈ FP := machinePairFirst_mem_FP + +theorem machineExecutableMatrixEntryRest_mem_FP : + machineExecutableMatrixEntryRest ∈ FP := machinePairSecond_mem_FP + +theorem machineExecutableMatrixEntryColumn_mem_FP : + machineExecutableMatrixEntryColumn ∈ FP := by + simpa only [machineExecutableMatrixEntryColumn] using + machineCompose_mem_FP machineExecutableMatrixEntryRest_mem_FP + machinePairFirst_mem_FP + +theorem machineExecutableMatrixEntryPayload_mem_FP : + machineExecutableMatrixEntryPayload ∈ FP := by + simpa only [machineExecutableMatrixEntryPayload] using + machineCompose_mem_FP machineExecutableMatrixEntryRest_mem_FP + machinePairSecond_mem_FP + +theorem machineExecutableMatrixEntryBaseDimension_mem_FP : + machineExecutableMatrixEntryBaseDimension ∈ FP := by + simpa only [machineExecutableMatrixEntryBaseDimension] using + machineCompose_mem_FP machineExecutableMatrixEntryPayload_mem_FP + machinePairFirst_mem_FP + +theorem machineExecutableMatrixEntryPoint_mem_FP : + machineExecutableMatrixEntryPoint ∈ FP := by + simpa only [machineExecutableMatrixEntryPoint] using + machineCompose_mem_FP machineExecutableMatrixEntryPayload_mem_FP + machinePairSecond_mem_FP + +theorem machineExecutableMatrixEntryRawInput_mem_FP : + machineExecutableMatrixEntryRawInput ∈ FP := + machinePair_mem_FP machineExecutableMatrixEntryBaseDimension_mem_FP + (machinePair_mem_FP machineExecutableMatrixEntryRow_mem_FP + (machinePair_mem_FP machineExecutableMatrixEntryColumn_mem_FP + machineExecutableMatrixEntryPoint_mem_FP)) + +theorem machineExecutableMatrixEntryCode_mem_FP : + machineExecutableMatrixEntryCode ∈ FP := by + have hraw := machineCompose_mem_FP + machineExecutableMatrixEntryRawInput_mem_FP + machineBetheAffineEntryRawCode_mem_FP + simpa only [machineExecutableMatrixEntryCode] using + machineCompose_mem_FP hraw machineNormalizeRawRatEntryCode_mem_FP + +@[simp] theorem machineExecutableMatrixEntryCode_encode {m : ℕ} + (y : Fin (m * m) → ℚ) (i j : Fin (m + 1)) : + machineExecutableMatrixEntryCode + (pair (List.replicate i.1 true) + (pair (List.replicate j.1 true) + (pair (List.replicate m true) + (rationalFiniteVectorCode y)))) = + rationalEntryBinaryCode (betheAffineMatrixQ y i j) := by + rw [machineExecutableMatrixEntryCode, + machineExecutableMatrixEntryRawInput] + simp only [machineExecutableMatrixEntryBaseDimension, + machineExecutableMatrixEntryPoint, + machineExecutableMatrixEntryPayload, + machineExecutableMatrixEntryRow, + machineExecutableMatrixEntryColumn, + machineExecutableMatrixEntryRest, + machinePairFirst_pair, machinePairSecond_pair] + change machineNormalizeRawRatEntryCode + (machineBetheAffineEntryRawCode + (machineBetheAffineEntryCanonicalWord i j y)) = _ + rw [machineBetheAffineEntryRawCode_encode, + machineNormalizeRawRatEntryCode_encode] + apply congrArg rationalEntryBinaryCode + rw [binaryNormalizeRawRat_eq_value, rawBetheAffineEntry_value] + +/-! ## Uniform matrix-output program -/ + +def machineExecutableOptimizerBaseDimensionUnary + (word : List Bool) : List Bool := + (machineMatrixDimensionUnary word).tail + +def machineExecutableOptimizerPointCode + (word : List Bool) : List Bool := + machineExplicitBetheOptimizerPointCode word + +def machineExecutableOptimizerBasePointCode + (word : List Bool) : List Bool := + machineBinaryListInit (machineExecutableOptimizerPointCode word) + +def machineExecutableOptimizerMatrixPayload + (word : List Bool) : List Bool := + pair (machineExecutableOptimizerBaseDimensionUnary word) + (machineExecutableOptimizerBasePointCode word) + +/-- The seed is exactly the canonical directed-objective word at `tau = 0` +and precision zero. Reusing that word lets the existing raw-entry width proof +serve as the matrix generator's bit analysis. -/ +def machineExecutableOptimizerMatrixSeed + (word : List Bool) : List Bool := + pair (machineExecutableOptimizerBaseDimensionUnary word) + (pair [] (pair (rawRatBinaryCode (rawRatOfRat 0)) + (pair word (machineExecutableOptimizerBasePointCode word)))) + +def machineExecutableOptimizerMatrixBound + (word : List Bool) : List Bool := + machineIteratedBinaryWidth 2 + (machineExecutableOptimizerMatrixSeed word ++ + List.replicate 1024 false) + +def machineExecutableOptimizerMatrixGeneratorInput + (word : List Bool) : List Bool := + pair (machineMatrixDimensionUnary word) + (pair (machineExecutableOptimizerMatrixBound word) + (machineExecutableOptimizerMatrixPayload word)) + +def machineExecutableOptimizerMatrixRowsCode + (word : List Bool) : List Bool := + machineUnaryMatrixGeneratorRowsCode machineExecutableMatrixEntryCode + (machineExecutableOptimizerMatrixGeneratorInput word) + +def machineExecutableOptimizerMatrixCode + (word : List Bool) : List Bool := + pair (machineMatrixDimensionWord word) + (machineExecutableOptimizerMatrixRowsCode word) + +theorem machineExecutableOptimizerBaseDimensionUnary_mem_FP : + machineExecutableOptimizerBaseDimensionUnary ∈ FP := by + simpa only [machineExecutableOptimizerBaseDimensionUnary] using + machineCompose_mem_FP machineMatrixDimensionUnary_mem_FP + machineTail_mem_FP + +theorem machineExecutableOptimizerPointCode_mem_FP : + machineExecutableOptimizerPointCode ∈ FP := by + simpa only [machineExecutableOptimizerPointCode] using + machineExplicitBetheOptimizerPointCode_mem_FP + +theorem machineExecutableOptimizerBasePointCode_mem_FP : + machineExecutableOptimizerBasePointCode ∈ FP := by + simpa only [machineExecutableOptimizerBasePointCode] using + machineCompose_mem_FP machineExecutableOptimizerPointCode_mem_FP + machineBinaryListInit_mem_FP + +theorem machineExecutableOptimizerMatrixPayload_mem_FP : + machineExecutableOptimizerMatrixPayload ∈ FP := + machinePair_mem_FP machineExecutableOptimizerBaseDimensionUnary_mem_FP + machineExecutableOptimizerBasePointCode_mem_FP + +theorem machineExecutableOptimizerMatrixSeed_mem_FP : + machineExecutableOptimizerMatrixSeed ∈ FP := + machinePair_mem_FP machineExecutableOptimizerBaseDimensionUnary_mem_FP + (machinePair_mem_FP (machineConst_mem_FP []) + (machinePair_mem_FP + (machineConst_mem_FP (rawRatBinaryCode (rawRatOfRat 0))) + (machinePair_mem_FP id_mem_FP + machineExecutableOptimizerBasePointCode_mem_FP))) + +theorem machineExecutableOptimizerMatrixBound_mem_FP : + machineExecutableOptimizerMatrixBound ∈ FP := by + have hpadded := machineAppend_mem_FP + machineExecutableOptimizerMatrixSeed_mem_FP + (machineConst_mem_FP (List.replicate 1024 false)) + simpa only [machineExecutableOptimizerMatrixBound] using + machineCompose_mem_FP hpadded (machineIteratedBinaryWidth_mem_FP 2) + +theorem machineExecutableOptimizerMatrixGeneratorInput_mem_FP : + machineExecutableOptimizerMatrixGeneratorInput ∈ FP := + machinePair_mem_FP machineMatrixDimensionUnary_mem_FP + (machinePair_mem_FP machineExecutableOptimizerMatrixBound_mem_FP + machineExecutableOptimizerMatrixPayload_mem_FP) + +theorem machineExecutableOptimizerMatrixRowsCode_mem_FP : + machineExecutableOptimizerMatrixRowsCode ∈ FP := by + have hgenerator := machineUnaryMatrixGeneratorRowsCode_mem_FP + machineExecutableMatrixEntryCode_mem_FP + simpa only [machineExecutableOptimizerMatrixRowsCode] using + machineCompose_mem_FP + machineExecutableOptimizerMatrixGeneratorInput_mem_FP hgenerator + +theorem machineExecutableOptimizerMatrixCode_mem_FP : + machineExecutableOptimizerMatrixCode ∈ FP := + machinePair_mem_FP machineMatrixDimensionWord_mem_FP + machineExecutableOptimizerMatrixRowsCode_mem_FP + +/-! ## Canonical semantics and the explicit output bound -/ + +@[simp] theorem machineExecutableOptimizerBaseDimensionUnary_encode {m : ℕ} + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) : + machineExecutableOptimizerBaseDimensionUnary + (rationalMatrixBinaryEncoding.encode ⟨m + 1, A⟩) = + List.replicate m true := by + rw [machineExecutableOptimizerBaseDimensionUnary, + machineMatrixDimensionUnary_encode] + simp + +@[simp] theorem machineExecutableOptimizerMatrixSeed_encode + {m : ℕ} (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) + (hpoint : machineExecutableOptimizerBasePointCode + (rationalMatrixBinaryEncoding.encode ⟨m + 1, A⟩) = + rationalFiniteVectorCode y) : + machineExecutableOptimizerMatrixSeed + (rationalMatrixBinaryEncoding.encode ⟨m + 1, A⟩) = + machineDirectedObjectiveSumCanonicalWord 0 A y 0 := by + simp [machineExecutableOptimizerMatrixSeed, hpoint, + machineDirectedObjectiveSumCanonicalWord] + +theorem unaryMatrixCode_length_le_of_entry_bound {n E : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) + (hentry : ∀ i j, (rationalEntryBinaryCode (X i j)).length ≤ E) : + (binaryListCode (binaryListCode rationalEntryBinaryCode) + (rationalMatrixRows X)).length ≤ + n * (2 * (n * (2 * E + 2)) + 2) := by + rw [binaryListCode_length_eq_sum] + simp only [rationalMatrixRows, List.map_ofFn, List.sum_ofFn, + Function.comp_apply] + calc + ∑ i : Fin n, + (2 * (binaryListCode rationalEntryBinaryCode + (List.ofFn fun j => X i j)).length + 2) ≤ + ∑ _i : Fin n, (2 * (n * (2 * E + 2)) + 2) := by + apply Finset.sum_le_sum + intro i _hi + rw [binaryListCode_length_eq_sum] + simp only [List.map_ofFn, List.sum_ofFn, Function.comp_apply] + have hrow : + ∑ j : Fin n, + (2 * (rationalEntryBinaryCode (X i j)).length + 2) ≤ + ∑ _j : Fin n, (2 * E + 2) := by + apply Finset.sum_le_sum + intro j _hj + have hij := hentry i j + omega + have hrow' : + ∑ j : Fin n, + (2 * (rationalEntryBinaryCode (X i j)).length + 2) ≤ + n * (2 * E + 2) := by simpa using hrow + omega + _ = n * (2 * (n * (2 * E + 2)) + 2) := by simp + +theorem executableOptimizerMatrix_entryCode_length_le {m : ℕ} + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (i j : Fin (m + 1)) : + let L := (machineDirectedObjectiveSumCanonicalWord 0 A y 0).length + (rationalEntryBinaryCode (betheAffineMatrixQ y i j)).length ≤ + 64 + 36 * rawBetheAffineEntryWidthBudget m L := by + intro L + rw [← rawRatBinaryCode_rawRatOfRat] + have hcode := rawRatBinaryCode_length_le_width + (rawRatOfRat (betheAffineMatrixQ y i j)) + have hwidth := rawBetheAffineMatrixQ_width_le_word + (tau := (0 : ℚ)) A y 0 i j + exact hcode.trans (by + simp only [L] + omega) + +theorem executableOptimizerMatrix_rowsCode_fits_bound {m : ℕ} + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) : + let seed := machineDirectedObjectiveSumCanonicalWord 0 A y 0 + (binaryListCode (binaryListCode rationalEntryBinaryCode) + (rationalMatrixRows (betheAffineMatrixQ y))).length ≤ + (machineIteratedBinaryWidth 2 + (seed ++ List.replicate 1024 false)).length := by + intro seed + let L := seed.length + let E := 64 + 36 * rawBetheAffineEntryWidthBudget m L + have hentry : ∀ i j, + (rationalEntryBinaryCode (betheAffineMatrixQ y i j)).length ≤ E := by + intro i j + simpa only [E, L, seed] using + executableOptimizerMatrix_entryCode_length_le A y i j + have hmatrix := unaryMatrixCode_length_le_of_entry_bound + (betheAffineMatrixQ y) hentry + have hsource : + (rationalMatrixBinaryEncoding.encode ⟨m + 1, A⟩).length ≤ L := by + simp [L, seed, machineDirectedObjectiveSumCanonicalWord] + omega + have hsquare : (m + 1) ^ 2 ≤ L := by + have hcount : + ((rationalMatrixRows A).map List.length).sum = (m + 1) ^ 2 := by + simp only [rationalMatrixRows, List.map_ofFn, List.sum_ofFn, + Function.comp_apply, List.length_ofFn] + simp + ring + rw [← hcount] + apply (rationalRowsEntryCount_le_codeLength + (rationalMatrixRows A)).trans + have hrows : + (binaryListCode (binaryListCode rationalEntryBinaryCode) + (rationalMatrixRows A)).length ≤ + (rationalMatrixBinaryEncoding.encode ⟨m + 1, A⟩).length := by + change _ ≤ (pair (m + 1).bits + (binaryListCode (binaryListCode rationalEntryBinaryCode) + (rationalMatrixRows A))).length + simpa only [machinePairSecond_pair] using + machinePairSecond_length_le + (pair (m + 1).bits + (binaryListCode (binaryListCode rationalEntryBinaryCode) + (rationalMatrixRows A))) + exact hrows.trans hsource + have hm2 : m * m ≤ L := by nlinarith + have hm : m ≤ L := by nlinarith + have hE : E ≤ 512 * (L + 16) ^ 2 := by + simp only [E, rawBetheAffineEntryWidthBudget] + nlinarith [sq_nonneg (L + 16)] + have hmatrix' : + (binaryListCode (binaryListCode rationalEntryBinaryCode) + (rationalMatrixRows (betheAffineMatrixQ y))).length ≤ + 4096 * (L + 16) ^ 3 := by + apply hmatrix.trans + have hn2 : (m + 1) * (m + 1) ≤ L := by + simpa [pow_two] using hsquare + have hbase : 1 ≤ L + 16 := by omega + nlinarith [Nat.mul_le_mul_left (4 * L) hE, + sq_nonneg (L + 16)] + have hpow : 4096 * (L + 16) ^ 3 ≤ + (L + 1024 + 16) ^ 4 := by + nlinarith [sq_nonneg (L + 16), sq_nonneg (L + 1040)] + calc + _ ≤ 4096 * (L + 16) ^ 3 := hmatrix' + _ ≤ (L + 1024 + 16) ^ 4 := hpow + _ ≤ certificateExpGuardWidth 2 (L + 1024) := by + simpa only [show 2 ^ (1 + 1) = 4 by norm_num] using + certificateExpGuardWidth_pow_lower 1 (L + 1024) + _ = _ := by + rw [machineIteratedBinaryWidth_length] + simp only [List.length_append, List.length_replicate, L] + +@[simp] theorem machineExecutableOptimizerMatrixRowsCode_encode + {m : ℕ} (hm : 0 < m) + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (hApos : ∀ i j, 0 < A i j) (hAupper : ∀ i j, A i j ≤ 1) : + machineExecutableOptimizerMatrixRowsCode + (rationalMatrixBinaryEncoding.encode ⟨m + 1, A⟩) = + binaryListCode (binaryListCode rationalEntryBinaryCode) + (rationalMatrixRows + (executableScannedBetheOptimizerMatrix A)) := by + let word := rationalMatrixBinaryEncoding.encode ⟨m + 1, A⟩ + let q := executableScannedBetheOptimizerPoint A + let y := epigraphBase q + have hpointFull : machineExecutableOptimizerPointCode word = + rationalFiniteVectorCode q := by + simpa only [machineExecutableOptimizerPointCode, word, q] using + machineExplicitBetheOptimizerPointCode_encode hm A hApos hAupper + have hpoint : machineExecutableOptimizerBasePointCode word = + rationalFiniteVectorCode y := by + rw [machineExecutableOptimizerBasePointCode, hpointFull, + rationalFiniteVectorCode, ofFn_epigraph_center_split, + machineBinaryListInit_encode] + rfl + have hseed := machineExecutableOptimizerMatrixSeed_encode A y hpoint + rw [machineExecutableOptimizerMatrixRowsCode, + machineExecutableOptimizerMatrixGeneratorInput] + have hdimension : machineMatrixDimensionUnary word = + List.replicate (m + 1) true := machineMatrixDimensionUnary_encode A + have hpayload : machineExecutableOptimizerMatrixPayload word = + pair (List.replicate m true) (rationalFiniteVectorCode y) := by + simp [machineExecutableOptimizerMatrixPayload, hpoint, word] + have hbound : machineExecutableOptimizerMatrixBound word = + machineIteratedBinaryWidth 2 + (machineDirectedObjectiveSumCanonicalWord 0 A y 0 ++ + List.replicate 1024 false) := by + rw [machineExecutableOptimizerMatrixBound] + rw [show machineExecutableOptimizerMatrixSeed word = + machineDirectedObjectiveSumCanonicalWord 0 A y 0 by + simpa only [word] using hseed] + rw [hdimension, hpayload, hbound] + change machineUnaryMatrixGeneratorRowsCode machineExecutableMatrixEntryCode + (machineUnaryMatrixGeneratorCanonicalWord (m + 1) + (machineIteratedBinaryWidth 2 + (machineDirectedObjectiveSumCanonicalWord 0 A y 0 ++ + List.replicate 1024 false)) + (pair (List.replicate m true) (rationalFiniteVectorCode y))) = _ + rw [machineUnaryMatrixGeneratorRowsCode_encode_of_bound + machineExecutableMatrixEntryCode (betheAffineMatrixQ y) + (machineIteratedBinaryWidth 2 + (machineDirectedObjectiveSumCanonicalWord 0 A y 0 ++ + List.replicate 1024 false)) + (pair (List.replicate m true) (rationalFiniteVectorCode y))] + · rfl + · intro i j + exact machineExecutableMatrixEntryCode_encode y i j + · simpa only [unaryMatrixRows, rationalMatrixRows] using + executableOptimizerMatrix_rowsCode_fits_bound A y + +@[simp] theorem machineExecutableOptimizerMatrixCode_encode + {m : ℕ} (hm : 0 < m) + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (hApos : ∀ i j, 0 < A i j) (hAupper : ∀ i j, A i j ≤ 1) : + machineExecutableOptimizerMatrixCode + (rationalMatrixBinaryEncoding.encode ⟨m + 1, A⟩) = + rationalMatrixBinaryEncoding.encode + ⟨m + 1, executableScannedBetheOptimizerMatrix A⟩ := by + rw [machineExecutableOptimizerMatrixCode, + machineMatrixDimensionWord_encode, + machineExecutableOptimizerMatrixRowsCode_encode hm A hApos hAupper] + rfl + +/-! ## Normalized potential entries -/ + +/-- The matrix generator supplies a dummy row, the vector coordinate as its +column, and then the immutable directed-objective seed. -/ +def machineExecutablePotentialIndex (word : List Bool) : List Bool := + machinePairFirst (machinePairSecond word) + +def machineExecutablePotentialPayload (word : List Bool) : List Bool := + machinePairSecond (machinePairSecond word) + +def machineExecutablePotentialGradientInput + (row column : List Bool → List Bool) (word : List Bool) : List Bool := + pair (row word) + (pair (column word) (machineExecutablePotentialPayload word)) + +def machineExecutableRowPotentialGradientInput + (word : List Bool) : List Bool := + machineExecutablePotentialGradientInput machineExecutablePotentialIndex + (fun _ => []) word + +def machineExecutableColumnPotentialGradientInput + (word : List Bool) : List Bool := + machineExecutablePotentialGradientInput (fun _ => []) + machineExecutablePotentialIndex word + +def machineExecutableOriginGradientInput + (word : List Bool) : List Bool := + machineExecutablePotentialGradientInput (fun _ => []) (fun _ => []) word + +def machineExecutableTwoPlusTauRawCode (word : List Bool) : List Bool := + machineRawRatAddCode + (pair (rawRatBinaryCode rawOptimizerTwo) + (machineDirectedObjectiveSumTau + (machineExecutablePotentialPayload word))) + +def machineExecutableRowPotentialRawCode (word : List Bool) : List Bool := + machineRawRatAddCode + (pair + (machineRawRatNegCode + (machineDirectedNegativeGradientEntryRawCode + (machineExecutableRowPotentialGradientInput word))) + (machineExecutableTwoPlusTauRawCode word)) + +def machineExecutableColumnPotentialRawCode (word : List Bool) : List Bool := + machineRawRatSubCode + (pair + (machineDirectedNegativeGradientEntryRawCode + (machineExecutableOriginGradientInput word)) + (machineDirectedNegativeGradientEntryRawCode + (machineExecutableColumnPotentialGradientInput word))) + +def machineExecutableRowPotentialEntryCode (word : List Bool) : List Bool := + machineNormalizeRawRatEntryCode + (machineExecutableRowPotentialRawCode word) + +def machineExecutableColumnPotentialEntryCode (word : List Bool) : List Bool := + machineNormalizeRawRatEntryCode + (machineExecutableColumnPotentialRawCode word) + +theorem machineExecutablePotentialIndex_mem_FP : + machineExecutablePotentialIndex ∈ FP := by + simpa only [machineExecutablePotentialIndex] using + machineCompose_mem_FP machinePairSecond_mem_FP machinePairFirst_mem_FP + +theorem machineExecutablePotentialPayload_mem_FP : + machineExecutablePotentialPayload ∈ FP := by + simpa only [machineExecutablePotentialPayload] using + machineCompose_mem_FP machinePairSecond_mem_FP machinePairSecond_mem_FP + +theorem machineExecutablePotentialGradientInput_mem_FP + {row column : List Bool → List Bool} + (hrow : row ∈ FP) (hcolumn : column ∈ FP) : + machineExecutablePotentialGradientInput row column ∈ FP := + machinePair_mem_FP hrow + (machinePair_mem_FP hcolumn machineExecutablePotentialPayload_mem_FP) + +theorem machineExecutableRowPotentialGradientInput_mem_FP : + machineExecutableRowPotentialGradientInput ∈ FP := by + simpa only [machineExecutableRowPotentialGradientInput] using + machineExecutablePotentialGradientInput_mem_FP + machineExecutablePotentialIndex_mem_FP (machineConst_mem_FP []) + +theorem machineExecutableColumnPotentialGradientInput_mem_FP : + machineExecutableColumnPotentialGradientInput ∈ FP := by + simpa only [machineExecutableColumnPotentialGradientInput] using + machineExecutablePotentialGradientInput_mem_FP (machineConst_mem_FP []) + machineExecutablePotentialIndex_mem_FP + +theorem machineExecutableOriginGradientInput_mem_FP : + machineExecutableOriginGradientInput ∈ FP := by + simpa only [machineExecutableOriginGradientInput] using + machineExecutablePotentialGradientInput_mem_FP + (machineConst_mem_FP []) (machineConst_mem_FP []) + +theorem machineExecutableTwoPlusTauRawCode_mem_FP : + machineExecutableTwoPlusTauRawCode ∈ FP := by + have htau := machineCompose_mem_FP + machineExecutablePotentialPayload_mem_FP + machineDirectedObjectiveSumTau_mem_FP + have hpair := machinePair_mem_FP + (machineConst_mem_FP (rawRatBinaryCode rawOptimizerTwo)) htau + simpa only [machineExecutableTwoPlusTauRawCode] using + machineCompose_mem_FP hpair machineRawRatAddCode_mem_FP + +theorem machineExecutableRowPotentialRawCode_mem_FP : + machineExecutableRowPotentialRawCode ∈ FP := by + have hgradient := machineCompose_mem_FP + machineExecutableRowPotentialGradientInput_mem_FP + machineDirectedNegativeGradientEntryRawCode_mem_FP + have hneg := machineCompose_mem_FP hgradient machineRawRatNegCode_mem_FP + have hpair := machinePair_mem_FP hneg + machineExecutableTwoPlusTauRawCode_mem_FP + simpa only [machineExecutableRowPotentialRawCode] using + machineCompose_mem_FP hpair machineRawRatAddCode_mem_FP + +theorem machineExecutableColumnPotentialRawCode_mem_FP : + machineExecutableColumnPotentialRawCode ∈ FP := by + have horigin := machineCompose_mem_FP + machineExecutableOriginGradientInput_mem_FP + machineDirectedNegativeGradientEntryRawCode_mem_FP + have hcolumn := machineCompose_mem_FP + machineExecutableColumnPotentialGradientInput_mem_FP + machineDirectedNegativeGradientEntryRawCode_mem_FP + have hpair := machinePair_mem_FP horigin hcolumn + simpa only [machineExecutableColumnPotentialRawCode] using + machineCompose_mem_FP hpair machineRawRatSubCode_mem_FP + +theorem machineExecutableRowPotentialEntryCode_mem_FP : + machineExecutableRowPotentialEntryCode ∈ FP := by + simpa only [machineExecutableRowPotentialEntryCode] using + machineCompose_mem_FP machineExecutableRowPotentialRawCode_mem_FP + machineNormalizeRawRatEntryCode_mem_FP + +theorem machineExecutableColumnPotentialEntryCode_mem_FP : + machineExecutableColumnPotentialEntryCode ∈ FP := by + simpa only [machineExecutableColumnPotentialEntryCode] using + machineCompose_mem_FP machineExecutableColumnPotentialRawCode_mem_FP + machineNormalizeRawRatEntryCode_mem_FP + +@[simp] theorem machineExecutableRowPotentialGradientInput_encode {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p : ℕ) + (dummy i : Fin (m + 1)) : + machineExecutableRowPotentialGradientInput + (pair (List.replicate dummy.1 true) + (pair (List.replicate i.1 true) + (machineDirectedObjectiveSumCanonicalWord tau A y p))) = + machineDirectedGradientEntryCanonicalWord tau A y p i 0 := by + simp [machineExecutableRowPotentialGradientInput, + machineExecutablePotentialGradientInput, + machineExecutablePotentialIndex, machineExecutablePotentialPayload, + machineDirectedGradientEntryCanonicalWord] + +@[simp] theorem machineExecutableColumnPotentialGradientInput_encode {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p : ℕ) + (dummy j : Fin (m + 1)) : + machineExecutableColumnPotentialGradientInput + (pair (List.replicate dummy.1 true) + (pair (List.replicate j.1 true) + (machineDirectedObjectiveSumCanonicalWord tau A y p))) = + machineDirectedGradientEntryCanonicalWord tau A y p 0 j := by + simp [machineExecutableColumnPotentialGradientInput, + machineExecutablePotentialGradientInput, + machineExecutablePotentialIndex, machineExecutablePotentialPayload, + machineDirectedGradientEntryCanonicalWord] + +@[simp] theorem machineExecutableOriginGradientInput_encode {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p : ℕ) + (dummy j : Fin (m + 1)) : + machineExecutableOriginGradientInput + (pair (List.replicate dummy.1 true) + (pair (List.replicate j.1 true) + (machineDirectedObjectiveSumCanonicalWord tau A y p))) = + machineDirectedGradientEntryCanonicalWord tau A y p 0 0 := by + simp [machineExecutableOriginGradientInput, + machineExecutablePotentialGradientInput, + machineExecutablePotentialPayload, + machineDirectedGradientEntryCanonicalWord] + +@[simp] theorem machineExecutableTwoPlusTauRawCode_encode {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p : ℕ) + (dummy i : Fin (m + 1)) : + machineExecutableTwoPlusTauRawCode + (pair (List.replicate dummy.1 true) + (pair (List.replicate i.1 true) + (machineDirectedObjectiveSumCanonicalWord tau A y p))) = + rawRatBinaryCode + (rawOptimizerTwo.add (rawRatOfRat tau)) := by + rw [machineExecutableTwoPlusTauRawCode] + simp only [machineExecutablePotentialPayload, machinePairSecond_pair, + machineDirectedObjectiveSumTau_encode, machineRawRatAddCode_encode] + +@[simp] theorem machineExecutableRowPotentialEntryCode_encode {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p : ℕ) + (dummy i : Fin (m + 1)) : + machineExecutableRowPotentialEntryCode + (pair (List.replicate dummy.1 true) + (pair (List.replicate i.1 true) + (machineDirectedObjectiveSumCanonicalWord tau A y p))) = + rationalEntryBinaryCode + (-directedNegativeGradientLowerMatrix tau A + (betheAffineMatrixQ y) p i 0 + (2 + tau)) := by + rw [machineExecutableRowPotentialEntryCode, + machineExecutableRowPotentialRawCode, + machineExecutableRowPotentialGradientInput_encode, + machineExecutableTwoPlusTauRawCode_encode, + machineDirectedNegativeGradientEntryRawCode_encode, + machineRawRatNegCode_encode, machineRawRatAddCode_encode, + machineNormalizeRawRatEntryCode_encode] + apply congrArg rationalEntryBinaryCode + rw [binaryNormalizeRawRat_eq_value, RawRat.value_add, + RawRat.value_neg, machineDirectedNegativeGradientEntry_value, + RawRat.value_add, rawRatOfRat_value] + norm_num [rawOptimizerTwo, RawRat.ofNat, RawRat.value] + +@[simp] theorem machineExecutableColumnPotentialEntryCode_encode {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p : ℕ) + (dummy j : Fin (m + 1)) : + machineExecutableColumnPotentialEntryCode + (pair (List.replicate dummy.1 true) + (pair (List.replicate j.1 true) + (machineDirectedObjectiveSumCanonicalWord tau A y p))) = + rationalEntryBinaryCode + (-(directedNegativeGradientLowerMatrix tau A + (betheAffineMatrixQ y) p 0 j - + directedNegativeGradientLowerMatrix tau A + (betheAffineMatrixQ y) p 0 0)) := by + rw [machineExecutableColumnPotentialEntryCode, + machineExecutableColumnPotentialRawCode, + machineExecutableOriginGradientInput_encode, + machineExecutableColumnPotentialGradientInput_encode, + machineDirectedNegativeGradientEntryRawCode_encode, + machineDirectedNegativeGradientEntryRawCode_encode, + machineRawRatSubCode_encode, machineNormalizeRawRatEntryCode_encode] + apply congrArg rationalEntryBinaryCode + rw [binaryNormalizeRawRat_eq_value, RawRat.value_sub, + machineDirectedNegativeGradientEntry_value, + machineDirectedNegativeGradientEntry_value] + ring + +/-! ## Canonical directed-gradient seed -/ + +def machineExecutableOptimizerTauCanonicalCode + (word : List Bool) : List Bool := + machineNormalizeRawRatEntryCode (machineOptimizerTauRawCode word) + +def machineExecutableOptimizerGradientSeed + (word : List Bool) : List Bool := + pair (machineExecutableOptimizerBaseDimensionUnary word) + (pair (machineExplicitOptimizerPrecisionRuler word) + (pair (machineExecutableOptimizerTauCanonicalCode word) + (pair word (machineExecutableOptimizerBasePointCode word)))) + +theorem machineExecutableOptimizerTauCanonicalCode_mem_FP : + machineExecutableOptimizerTauCanonicalCode ∈ FP := by + simpa only [machineExecutableOptimizerTauCanonicalCode] using + machineCompose_mem_FP machineOptimizerTauRawCode_mem_FP + machineNormalizeRawRatEntryCode_mem_FP + +theorem machineExecutableOptimizerGradientSeed_mem_FP : + machineExecutableOptimizerGradientSeed ∈ FP := + machinePair_mem_FP machineExecutableOptimizerBaseDimensionUnary_mem_FP + (machinePair_mem_FP machineExplicitOptimizerPrecisionRuler_mem_FP + (machinePair_mem_FP + machineExecutableOptimizerTauCanonicalCode_mem_FP + (machinePair_mem_FP id_mem_FP + machineExecutableOptimizerBasePointCode_mem_FP))) + +@[simp] theorem machineExecutableOptimizerTauCanonicalCode_encode {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) : + machineExecutableOptimizerTauCanonicalCode + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩) = + rawRatBinaryCode (rawRatOfRat (explicitRegularizationScale n)) := by + rw [machineExecutableOptimizerTauCanonicalCode, + machineOptimizerTauRawCode_encode, + machineNormalizeRawRatEntryCode_encode, + rawRatBinaryCode_rawRatOfRat] + apply congrArg rationalEntryBinaryCode + rw [binaryNormalizeRawRat_eq_value, rawOptimizerTau_value] + +@[simp] theorem machineExecutableOptimizerBasePointCode_encode {m : ℕ} + (hm : 0 < m) + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (hApos : ∀ i j, 0 < A i j) (hAupper : ∀ i j, A i j ≤ 1) : + machineExecutableOptimizerBasePointCode + (rationalMatrixBinaryEncoding.encode ⟨m + 1, A⟩) = + rationalFiniteVectorCode + (epigraphBase (executableScannedBetheOptimizerPoint A)) := by + let q := executableScannedBetheOptimizerPoint A + have hpointFull : machineExecutableOptimizerPointCode + (rationalMatrixBinaryEncoding.encode ⟨m + 1, A⟩) = + rationalFiniteVectorCode q := by + simpa only [machineExecutableOptimizerPointCode, q] using + machineExplicitBetheOptimizerPointCode_encode hm A hApos hAupper + rw [machineExecutableOptimizerBasePointCode, hpointFull, + rationalFiniteVectorCode, ofFn_epigraph_center_split, + machineBinaryListInit_encode] + rfl + +@[simp] theorem machineExecutableOptimizerGradientSeed_encode {m : ℕ} + (hm : 0 < m) + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (hApos : ∀ i j, 0 < A i j) (hAupper : ∀ i j, A i j ≤ 1) : + machineExecutableOptimizerGradientSeed + (rationalMatrixBinaryEncoding.encode ⟨m + 1, A⟩) = + machineDirectedObjectiveSumCanonicalWord + (explicitRegularizationScale (m + 1)) A + (epigraphBase (executableScannedBetheOptimizerPoint A)) + (explicitOptimizerPrecision A) := by + simp [machineExecutableOptimizerGradientSeed, + machineDirectedObjectiveSumCanonicalWord, + machineExecutableOptimizerBasePointCode_encode hm A hApos hAupper] + +/-! ## Bounded repeated-row generators for the potential vectors -/ + +def machineExecutableOptimizerPotentialBound + (word : List Bool) : List Bool := + machineIteratedBinaryWidth 6 + (machineExecutableOptimizerGradientSeed word ++ + List.replicate 4096 false) + +def machineExecutableOptimizerPotentialGeneratorInput + (word : List Bool) : List Bool := + pair (machineMatrixDimensionUnary word) + (pair (machineExecutableOptimizerPotentialBound word) + (machineExecutableOptimizerGradientSeed word)) + +def machineExecutableOptimizerRowPotentialRowsCode + (word : List Bool) : List Bool := + machineUnaryMatrixGeneratorRowsCode + machineExecutableRowPotentialEntryCode + (machineExecutableOptimizerPotentialGeneratorInput word) + +def machineExecutableOptimizerColumnPotentialRowsCode + (word : List Bool) : List Bool := + machineUnaryMatrixGeneratorRowsCode + machineExecutableColumnPotentialEntryCode + (machineExecutableOptimizerPotentialGeneratorInput word) + +def machineExecutableOptimizerRowPotentialCode + (word : List Bool) : List Bool := + machineListHead (machineExecutableOptimizerRowPotentialRowsCode word) + +def machineExecutableOptimizerColumnPotentialCode + (word : List Bool) : List Bool := + machineListHead (machineExecutableOptimizerColumnPotentialRowsCode word) + +theorem machineExecutableOptimizerPotentialBound_mem_FP : + machineExecutableOptimizerPotentialBound ∈ FP := by + have hpadded := machineAppend_mem_FP + machineExecutableOptimizerGradientSeed_mem_FP + (machineConst_mem_FP (List.replicate 4096 false)) + simpa only [machineExecutableOptimizerPotentialBound] using + machineCompose_mem_FP hpadded (machineIteratedBinaryWidth_mem_FP 6) + +theorem machineExecutableOptimizerPotentialGeneratorInput_mem_FP : + machineExecutableOptimizerPotentialGeneratorInput ∈ FP := + machinePair_mem_FP machineMatrixDimensionUnary_mem_FP + (machinePair_mem_FP machineExecutableOptimizerPotentialBound_mem_FP + machineExecutableOptimizerGradientSeed_mem_FP) + +theorem machineExecutableOptimizerRowPotentialRowsCode_mem_FP : + machineExecutableOptimizerRowPotentialRowsCode ∈ FP := by + have hgenerator := machineUnaryMatrixGeneratorRowsCode_mem_FP + machineExecutableRowPotentialEntryCode_mem_FP + simpa only [machineExecutableOptimizerRowPotentialRowsCode] using + machineCompose_mem_FP + machineExecutableOptimizerPotentialGeneratorInput_mem_FP hgenerator + +theorem machineExecutableOptimizerColumnPotentialRowsCode_mem_FP : + machineExecutableOptimizerColumnPotentialRowsCode ∈ FP := by + have hgenerator := machineUnaryMatrixGeneratorRowsCode_mem_FP + machineExecutableColumnPotentialEntryCode_mem_FP + simpa only [machineExecutableOptimizerColumnPotentialRowsCode] using + machineCompose_mem_FP + machineExecutableOptimizerPotentialGeneratorInput_mem_FP hgenerator + +theorem machineExecutableOptimizerRowPotentialCode_mem_FP : + machineExecutableOptimizerRowPotentialCode ∈ FP := by + simpa only [machineExecutableOptimizerRowPotentialCode] using + machineCompose_mem_FP + machineExecutableOptimizerRowPotentialRowsCode_mem_FP + machineListHead_mem_FP + +theorem machineExecutableOptimizerColumnPotentialCode_mem_FP : + machineExecutableOptimizerColumnPotentialCode ∈ FP := by + simpa only [machineExecutableOptimizerColumnPotentialCode] using + machineCompose_mem_FP + machineExecutableOptimizerColumnPotentialRowsCode_mem_FP + machineListHead_mem_FP + +/-! ## Ordinary bit bounds for the potential output -/ + +def rawExecutableRowPotential {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p : ℕ) (i : Fin (m + 1)) : RawRat := + (rawDirectedNegativeGradientLower tau (A i 0) + (betheAffineMatrixQ y i 0) p).neg.add + (rawOptimizerTwo.add (rawRatOfRat tau)) + +def rawExecutableColumnPotential {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p : ℕ) (j : Fin (m + 1)) : RawRat := + (rawDirectedNegativeGradientLower tau (A 0 0) + (betheAffineMatrixQ y 0 0) p).sub + (rawDirectedNegativeGradientLower tau (A 0 j) + (betheAffineMatrixQ y 0 j) p) + +@[simp] theorem rawExecutableRowPotential_value {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p : ℕ) (i : Fin (m + 1)) : + (rawExecutableRowPotential tau A y p i).value = + -directedNegativeGradientLowerMatrix tau A + (betheAffineMatrixQ y) p i 0 + (2 + tau) := by + rw [rawExecutableRowPotential, RawRat.value_add, RawRat.value_neg, + machineDirectedNegativeGradientEntry_value, RawRat.value_add, + rawRatOfRat_value] + norm_num [rawOptimizerTwo, RawRat.ofNat, RawRat.value] + +@[simp] theorem rawExecutableColumnPotential_value {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p : ℕ) (j : Fin (m + 1)) : + (rawExecutableColumnPotential tau A y p j).value = + -(directedNegativeGradientLowerMatrix tau A + (betheAffineMatrixQ y) p 0 j - + directedNegativeGradientLowerMatrix tau A + (betheAffineMatrixQ y) p 0 0) := by + rw [rawExecutableColumnPotential, RawRat.value_sub, + machineDirectedNegativeGradientEntry_value, + machineDirectedNegativeGradientEntry_value] + ring + +theorem rawExecutableRowPotential_width_le_word_budget {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p : ℕ) (i : Fin (m + 1)) : + let L := (machineDirectedObjectiveSumCanonicalWord tau A y p).length + let B := rawDirectedObjectiveCoordinateWordBudget m L + rawRatWidth (rawExecutableRowPotential tau A y p i) ≤ + B + L + 4 := by + intro L B + have hgradient := rawDirectedNegativeGradientEntry_width_le_word_budget + tau A y p i 0 + have htau := rawDirectedObjectiveSum_tau_width_le_word tau A y p + have htwo : rawRatWidth rawOptimizerTwo = 2 := by + decide + have htwoTau := rawRatWidth_add_le rawOptimizerTwo (rawRatOfRat tau) + rw [htwo] at htwoTau + have hsum := rawRatWidth_add_le + (rawDirectedNegativeGradientLower tau (A i 0) + (betheAffineMatrixQ y i 0) p).neg + (rawOptimizerTwo.add (rawRatOfRat tau)) + rw [rawRatWidth_neg] at hsum + simpa only [rawExecutableRowPotential, L, B] using hsum.trans (by omega) + +theorem rawExecutableColumnPotential_width_le_word_budget {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p : ℕ) (j : Fin (m + 1)) : + let L := (machineDirectedObjectiveSumCanonicalWord tau A y p).length + let B := rawDirectedObjectiveCoordinateWordBudget m L + rawRatWidth (rawExecutableColumnPotential tau A y p j) ≤ + 2 * B + 1 := by + intro L B + have horigin := rawDirectedNegativeGradientEntry_width_le_word_budget + tau A y p 0 0 + have hcolumn := rawDirectedNegativeGradientEntry_width_le_word_budget + tau A y p 0 j + have hsub := rawRatWidth_sub_le + (rawDirectedNegativeGradientLower tau (A 0 0) + (betheAffineMatrixQ y 0 0) p) + (rawDirectedNegativeGradientLower tau (A 0 j) + (betheAffineMatrixQ y 0 j) p) + simpa only [rawExecutableColumnPotential, L, B] using hsub.trans (by omega) + +theorem executableRowPotential_entryCode_length_le {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p : ℕ) (i : Fin (m + 1)) : + let L := (machineDirectedObjectiveSumCanonicalWord tau A y p).length + let B := rawDirectedObjectiveCoordinateWordBudget m L + (rationalEntryBinaryCode + (-directedNegativeGradientLowerMatrix tau A + (betheAffineMatrixQ y) p i 0 + (2 + tau))).length ≤ + 208 + 36 * B + 36 * L := by + intro L B + let raw := rawExecutableRowPotential tau A y p i + have hcanonical := rationalEntryBinaryCode_binaryNormalizeRawRat_length_le raw + rw [binaryNormalizeRawRat_eq_value, + rawExecutableRowPotential_value] at hcanonical + have hraw := rawExecutableRowPotential_width_le_word_budget tau A y p i + calc + _ ≤ 64 + 36 * rawRatWidth raw := hcanonical + _ ≤ 64 + 36 * (B + L + 4) := + Nat.add_le_add_left (Nat.mul_le_mul_left 36 hraw) 64 + _ = 208 + 36 * B + 36 * L := by ring + +theorem executableColumnPotential_entryCode_length_le {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p : ℕ) (j : Fin (m + 1)) : + let L := (machineDirectedObjectiveSumCanonicalWord tau A y p).length + let B := rawDirectedObjectiveCoordinateWordBudget m L + (rationalEntryBinaryCode + (-(directedNegativeGradientLowerMatrix tau A + (betheAffineMatrixQ y) p 0 j - + directedNegativeGradientLowerMatrix tau A + (betheAffineMatrixQ y) p 0 0))).length ≤ + 100 + 72 * B := by + intro L B + let raw := rawExecutableColumnPotential tau A y p j + have hcanonical := rationalEntryBinaryCode_binaryNormalizeRawRat_length_le raw + rw [binaryNormalizeRawRat_eq_value, + rawExecutableColumnPotential_value] at hcanonical + have hraw := rawExecutableColumnPotential_width_le_word_budget tau A y p j + calc + _ ≤ 64 + 36 * rawRatWidth raw := hcanonical + _ ≤ 64 + 36 * (2 * B + 1) := + Nat.add_le_add_left (Nat.mul_le_mul_left 36 hraw) 64 + _ = 100 + 72 * B := by ring + +theorem executableRepeatedPotential_rowsCode_fits_bound {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p : ℕ) + (v : Fin (m + 1) → ℚ) + (hentry : ∀ j, + let L := (machineDirectedObjectiveSumCanonicalWord tau A y p).length + let B := rawDirectedObjectiveCoordinateWordBudget m L + (rationalEntryBinaryCode (v j)).length ≤ + 208 + 72 * B + 36 * L) : + let seed := machineDirectedObjectiveSumCanonicalWord tau A y p + (binaryListCode (binaryListCode rationalEntryBinaryCode) + (unaryMatrixRows (fun _ j ↦ v j))).length ≤ + (machineIteratedBinaryWidth 6 + (seed ++ List.replicate 4096 false)).length := by + intro seed + let L := seed.length + let T := L + 16 + let B := rawDirectedObjectiveCoordinateWordBudget m L + let E := 208 + 72 * B + 36 * L + have hmL : m ≤ L := by + simp only [L, seed, machineDirectedObjectiveSumCanonicalWord, + pair_length, List.length_replicate] + omega + have hnL : m + 1 ≤ L := by + simp only [L, seed, machineDirectedObjectiveSumCanonicalWord, + pair_length, List.length_replicate] + omega + have hB : B ≤ T ^ 20 := by + simpa only [B, T] using + rawDirectedObjectiveCoordinateWordBudget_le_pow hmL + have hTpos : 0 < T := by simp [T] + have hpow19 : 1 ≤ T ^ 19 := one_le_pow₀ (by omega) + have hTpow20 : T ≤ T ^ 20 := by + rw [show 20 = 19 + 1 by omega, pow_succ] + nlinarith + have hLpow20 : L ≤ T ^ 20 := + (by simp [T] : L ≤ T).trans hTpow20 + have hpow20 : 1 ≤ T ^ 20 := one_le_pow₀ (by omega) + have hE : E ≤ 128 * T ^ 20 := by + dsimp only [E] + omega + have hmatrix := unaryMatrixCode_length_le_of_entry_bound + (X := fun _ j ↦ v j) (E := E) (by + intro i j + simpa only [E, B, L, seed] using hentry j) + have hnT : m + 1 ≤ T := hnL.trans (by simp [T]) + have hfactor : 2 * E + 2 ≤ 258 * T ^ 20 := by omega + have hn2 := Nat.mul_le_mul hnT hnT + have hmain := Nat.mul_le_mul hn2 hfactor + have hTpow22 : T ≤ T ^ 22 := by + have hpow21 : 1 ≤ T ^ 21 := one_le_pow₀ (by omega) + rw [show 22 = 21 + 1 by omega, pow_succ] + nlinarith + have hcoarse : + (binaryListCode (binaryListCode rationalEntryBinaryCode) + (unaryMatrixRows (fun _ j ↦ v j))).length ≤ + 518 * T ^ 22 := by + apply hmatrix.trans + have hmain' : + (m + 1) * (m + 1) * (2 * E + 2) ≤ + 258 * T ^ 22 := by + calc + _ ≤ T * T * (258 * T ^ 20) := hmain + _ = 258 * T ^ 22 := by ring + calc + (m + 1) * (2 * ((m + 1) * (2 * E + 2)) + 2) = + 2 * ((m + 1) * (m + 1) * (2 * E + 2)) + + 2 * (m + 1) := by ring + _ ≤ 2 * (258 * T ^ 22) + 2 * T ^ 22 := by omega + _ = 518 * T ^ 22 := by ring + have hcoeff : 518 ≤ T ^ 3 := by + have hbase : 16 ≤ T := by simp [T] + have hpow := Nat.pow_le_pow_left hbase 3 + exact (by norm_num : 518 ≤ 16 ^ 3).trans hpow + have hpower25 : + (binaryListCode (binaryListCode rationalEntryBinaryCode) + (unaryMatrixRows (fun _ j ↦ v j))).length ≤ T ^ 25 := by + calc + _ ≤ 518 * T ^ 22 := hcoarse + _ ≤ T ^ 3 * T ^ 22 := Nat.mul_le_mul_right _ hcoeff + _ = T ^ 25 := by ring + have hpower : + (binaryListCode (binaryListCode rationalEntryBinaryCode) + (unaryMatrixRows (fun _ j ↦ v j))).length ≤ T ^ 64 := + hpower25.trans (Nat.pow_le_pow_right hTpos (by omega)) + rw [machineIteratedBinaryWidth_length] + apply hpower.trans + have hbase : L + 16 ≤ L + 4096 + 16 := by omega + have hpowBase := Nat.pow_le_pow_left hbase 64 + exact hpowBase.trans (by + simpa only [show 2 ^ (5 + 1) = 64 by norm_num, + List.length_append, List.length_replicate, T, L, seed] using + certificateExpGuardWidth_pow_lower 5 (L + 4096)) + +theorem executableRowPotential_rowsCode_fits_bound {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p : ℕ) : + let seed := machineDirectedObjectiveSumCanonicalWord tau A y p + (binaryListCode (binaryListCode rationalEntryBinaryCode) + (unaryMatrixRows + (fun _ i ↦ -directedNegativeGradientLowerMatrix tau A + (betheAffineMatrixQ y) p i 0 + (2 + tau)))).length ≤ + (machineIteratedBinaryWidth 6 + (seed ++ List.replicate 4096 false)).length := by + apply executableRepeatedPotential_rowsCode_fits_bound + intro i L B + have h := executableRowPotential_entryCode_length_le tau A y p i + simpa only [L, B] using h.trans (by omega) + +theorem executableColumnPotential_rowsCode_fits_bound {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (y : Fin (m * m) → ℚ) (p : ℕ) : + let seed := machineDirectedObjectiveSumCanonicalWord tau A y p + (binaryListCode (binaryListCode rationalEntryBinaryCode) + (unaryMatrixRows + (fun _ j ↦ -(directedNegativeGradientLowerMatrix tau A + (betheAffineMatrixQ y) p 0 j - + directedNegativeGradientLowerMatrix tau A + (betheAffineMatrixQ y) p 0 0)))).length ≤ + (machineIteratedBinaryWidth 6 + (seed ++ List.replicate 4096 false)).length := by + apply executableRepeatedPotential_rowsCode_fits_bound + intro j L B + have h := executableColumnPotential_entryCode_length_le tau A y p j + simpa only [L, B] using h.trans (by omega) + +@[simp] theorem machineListHead_unaryMatrixRows_repeated {n : ℕ} + (hn : 0 < n) (v : Fin n → ℚ) : + machineListHead + (binaryListCode (binaryListCode rationalEntryBinaryCode) + (unaryMatrixRows (fun _ j ↦ v j))) = + rationalVectorBinaryCode v := by + cases n with + | zero => omega + | succ n => + simp [unaryMatrixRows, rationalVectorBinaryCode, + List.ofFn_succ, machineListHead_cons] + +@[simp] theorem machineExecutableOptimizerRowPotentialCode_encode + {m : ℕ} (hm : 0 < m) + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (hApos : ∀ i j, 0 < A i j) (hAupper : ∀ i j, A i j ≤ 1) : + machineExecutableOptimizerRowPotentialCode + (rationalMatrixBinaryEncoding.encode ⟨m + 1, A⟩) = + rationalVectorBinaryCode + (executableScannedBetheOptimizerRowPotential A) := by + let word := rationalMatrixBinaryEncoding.encode ⟨m + 1, A⟩ + let tau := explicitRegularizationScale (m + 1) + let p := explicitOptimizerPrecision A + let y := epigraphBase (executableScannedBetheOptimizerPoint A) + let seed := machineDirectedObjectiveSumCanonicalWord tau A y p + let bound := machineIteratedBinaryWidth 6 + (seed ++ List.replicate 4096 false) + let f : Fin (m + 1) → Fin (m + 1) → ℚ := + fun _ i ↦ -directedNegativeGradientLowerMatrix tau A + (betheAffineMatrixQ y) p i 0 + (2 + tau) + have hseed : machineExecutableOptimizerGradientSeed word = seed := by + simpa only [word, seed, tau, y, p] using + machineExecutableOptimizerGradientSeed_encode hm A hApos hAupper + have hinput : machineExecutableOptimizerPotentialGeneratorInput word = + machineUnaryMatrixGeneratorCanonicalWord (m + 1) bound seed := by + rw [machineExecutableOptimizerPotentialGeneratorInput] + rw [show machineMatrixDimensionUnary word = + List.replicate (m + 1) true by + simpa only [word] using machineMatrixDimensionUnary_encode A] + rw [machineExecutableOptimizerPotentialBound, hseed] + rfl + have hentry : ∀ i j, + machineExecutableRowPotentialEntryCode + (pair (List.replicate i.1 true) + (pair (List.replicate j.1 true) seed)) = + rationalEntryBinaryCode (f i j) := by + intro i j + simpa only [seed, tau, y, p, f] using + machineExecutableRowPotentialEntryCode_encode tau A y p i j + have hbound : + (binaryListCode (binaryListCode rationalEntryBinaryCode) + (unaryMatrixRows f)).length ≤ bound.length := by + simpa only [f, bound, seed] using + executableRowPotential_rowsCode_fits_bound tau A y p + rw [machineExecutableOptimizerRowPotentialCode, + machineExecutableOptimizerRowPotentialRowsCode, hinput, + machineUnaryMatrixGeneratorRowsCode_encode_of_bound + machineExecutableRowPotentialEntryCode f bound seed hentry hbound, + machineListHead_unaryMatrixRows_repeated (by omega)] + rfl + +@[simp] theorem machineExecutableOptimizerColumnPotentialCode_encode + {m : ℕ} (hm : 0 < m) + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (hApos : ∀ i j, 0 < A i j) (hAupper : ∀ i j, A i j ≤ 1) : + machineExecutableOptimizerColumnPotentialCode + (rationalMatrixBinaryEncoding.encode ⟨m + 1, A⟩) = + rationalVectorBinaryCode + (executableScannedBetheOptimizerColumnPotential A) := by + let word := rationalMatrixBinaryEncoding.encode ⟨m + 1, A⟩ + let tau := explicitRegularizationScale (m + 1) + let p := explicitOptimizerPrecision A + let y := epigraphBase (executableScannedBetheOptimizerPoint A) + let seed := machineDirectedObjectiveSumCanonicalWord tau A y p + let bound := machineIteratedBinaryWidth 6 + (seed ++ List.replicate 4096 false) + let f : Fin (m + 1) → Fin (m + 1) → ℚ := + fun _ j ↦ -(directedNegativeGradientLowerMatrix tau A + (betheAffineMatrixQ y) p 0 j - + directedNegativeGradientLowerMatrix tau A + (betheAffineMatrixQ y) p 0 0) + have hseed : machineExecutableOptimizerGradientSeed word = seed := by + simpa only [word, seed, tau, y, p] using + machineExecutableOptimizerGradientSeed_encode hm A hApos hAupper + have hinput : machineExecutableOptimizerPotentialGeneratorInput word = + machineUnaryMatrixGeneratorCanonicalWord (m + 1) bound seed := by + rw [machineExecutableOptimizerPotentialGeneratorInput] + rw [show machineMatrixDimensionUnary word = + List.replicate (m + 1) true by + simpa only [word] using machineMatrixDimensionUnary_encode A] + rw [machineExecutableOptimizerPotentialBound, hseed] + rfl + have hentry : ∀ i j, + machineExecutableColumnPotentialEntryCode + (pair (List.replicate i.1 true) + (pair (List.replicate j.1 true) seed)) = + rationalEntryBinaryCode (f i j) := by + intro i j + simpa only [seed, tau, y, p, f] using + machineExecutableColumnPotentialEntryCode_encode tau A y p i j + have hbound : + (binaryListCode (binaryListCode rationalEntryBinaryCode) + (unaryMatrixRows f)).length ≤ bound.length := by + simpa only [f, bound, seed] using + executableColumnPotential_rowsCode_fits_bound tau A y p + rw [machineExecutableOptimizerColumnPotentialCode, + machineExecutableOptimizerColumnPotentialRowsCode, hinput, + machineUnaryMatrixGeneratorRowsCode_encode_of_bound + machineExecutableColumnPotentialEntryCode f bound seed hentry hbound, + machineListHead_unaryMatrixRows_repeated (by omega)] + rfl + +/-! ## Complete optimizer output word -/ + +def executableScannedOptimizerOutput {m : ℕ} + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) : + RationalOptimizerOutput (m + 1) where + matrix := executableScannedBetheOptimizerMatrix A + rowPotential := executableScannedBetheOptimizerRowPotential A + columnPotential := executableScannedBetheOptimizerColumnPotential A + +def machineExecutableScannedOptimizerOutputCode + (word : List Bool) : List Bool := + pair (machineExecutableOptimizerMatrixCode word) + (pair (machineExecutableOptimizerRowPotentialCode word) + (machineExecutableOptimizerColumnPotentialCode word)) + +theorem machineExecutableScannedOptimizerOutputCode_mem_FP : + machineExecutableScannedOptimizerOutputCode ∈ FP := + machinePair_mem_FP machineExecutableOptimizerMatrixCode_mem_FP + (machinePair_mem_FP machineExecutableOptimizerRowPotentialCode_mem_FP + machineExecutableOptimizerColumnPotentialCode_mem_FP) + +@[simp] theorem machineExecutableScannedOptimizerOutputCode_encode + {m : ℕ} (hm : 0 < m) + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (hApos : ∀ i j, 0 < A i j) (hAupper : ∀ i j, A i j ≤ 1) : + machineExecutableScannedOptimizerOutputCode + (rationalMatrixBinaryEncoding.encode ⟨m + 1, A⟩) = + rationalOptimizerOutputCode (executableScannedOptimizerOutput A) := by + rw [machineExecutableScannedOptimizerOutputCode, + machineExecutableOptimizerMatrixCode_encode hm A hApos hAupper, + machineExecutableOptimizerRowPotentialCode_encode hm A hApos hAupper, + machineExecutableOptimizerColumnPotentialCode_encode hm A hApos hAupper] + rfl + +/-- Dimension-at-least-two specialization used by the positive routine. -/ +def executableLargeOptimizerOutput (m : ℕ) + (B : Matrix (Fin (m + 2)) (Fin (m + 2)) ℚ) : + RationalOptimizerOutput (m + 2) := + executableScannedOptimizerOutput (m := m + 1) B + +def ExecutableLargeOptimizerStringRealizes + (F : List Bool → List Bool) : Prop := + ∀ (m : ℕ) (B : Matrix (Fin (m + 2)) (Fin (m + 2)) ℚ), + (∀ i j, 0 < B i j) → (∀ i j, B i j ≤ 1) → + F (rationalMatrixBinaryEncoding.encode ⟨m + 2, B⟩) = + rationalOptimizerOutputCode (executableLargeOptimizerOutput m B) + +theorem machineExecutableScannedOptimizerOutputCode_realizes : + ExecutableLargeOptimizerStringRealizes + machineExecutableScannedOptimizerOutputCode := by + intro m B hBpos hBupper + simpa only [executableLargeOptimizerOutput, Nat.add_assoc, + Nat.add_comm, Nat.add_left_comm] using + machineExecutableScannedOptimizerOutputCode_encode + (m := m + 1) (by omega) B hBpos hBupper + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineExplicitCertificate.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineExplicitCertificate.lean new file mode 100644 index 0000000000..498e768685 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineExplicitCertificate.lean @@ -0,0 +1,39 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineCertificateExpGuard +import LeanPool.BeyondBethe.BeyondBethe.MachineMatchingGain + +/-! +# The complete finite-word certificate evaluator + +This module composes the verified fixed-gain greedy matching transducer, the +directed logarithmic certificate arithmetic, and the polynomial exponential +guard. +-/ + +namespace BeyondBethe + +def machineExplicitCertificateValueRawCode : List Bool → List Bool := + machineCertificateValueRawCode machineExplicitMatchingGainRawCode + machineOptimizerCertificateExpGuard + +theorem machineExplicitCertificateValueRawCode_mem_FP : + machineExplicitCertificateValueRawCode ∈ Complexity.FP := by + simpa only [machineExplicitCertificateValueRawCode] using + machineCertificateValueRawCode_mem_FP + machineExplicitMatchingGainRawCode_mem_FP + machineOptimizerCertificateExpGuard_mem_FP + +theorem machineExplicitCertificateValueRawCode_realizes_onPositive : + CertificateEvaluatorStringRealizesOnPositiveNormalized + machineExplicitCertificateValueRawCode := by + simpa only [machineExplicitCertificateValueRawCode] using + machineCertificateValueRawCode_realizes_onPositive + machineExplicitMatchingGainRawCode_realizes + machineOptimizerCertificateExpGuard_fits_onPositiveNormalized + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineFPBasics.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineFPBasics.lean new file mode 100644 index 0000000000..047e3c1789 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineFPBasics.lean @@ -0,0 +1,134 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineEncoding +import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.Algebra +import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.Reverse + +/-! +# Small verified polynomial-time bitstring combinators + +These lemmas are a thin project-local surface over Complexitylib's concrete +Turing machines and Cobham soundness theorem. They are used to assemble the +arithmetic and dynamic-state machines below without appealing to a semantic +"all Lean programs are efficient" principle. +-/ + +namespace BeyondBethe + +open Complexity + +theorem machineConst_mem_FP (word : List Bool) : + (fun _ : List Bool => word) ∈ Complexity.FP := by + exact CobhamFP_subset_FP (Cobham.const word) + +theorem machinePrepend_mem_FP (bit : Bool) : + (fun word : List Bool => bit :: word) ∈ Complexity.FP := by + exact Cobham.cons_mem_FP bit + +theorem machineTail_mem_FP : + (fun word : List Bool => word.tail) ∈ Complexity.FP := by + exact CobhamFP_subset_FP Cobham.tail + +theorem machineReverse_mem_FP : + List.reverse ∈ Complexity.FP := by + exact reverse_mem_FP + +/-- Replace every input bit by zero while preserving the input length. -/ +theorem machineZeroBlock_mem_FP : + (fun word : List Bool => List.replicate word.length false) ∈ + Complexity.FP := by + exact CobhamFP_subset_FP Cobham.lengthPad + +theorem machineCompose_mem_FP {f g : List Bool → List Bool} + (hf : f ∈ Complexity.FP) (hg : g ∈ Complexity.FP) : + (fun word => g (f word)) ∈ Complexity.FP := by + simpa only [Function.comp_apply] using mem_FP_comp hf hg + +theorem machinePair_mem_FP {left right : List Bool → List Bool} + (hleft : left ∈ Complexity.FP) (hright : right ∈ Complexity.FP) : + (fun word => pair (left word) (right word)) ∈ Complexity.FP := by + exact Cobham.pairFn_mem_FP hleft hright + +theorem machineAppend_mem_FP {left right : List Bool → List Bool} + (hleft : left ∈ Complexity.FP) (hright : right ∈ Complexity.FP) : + (fun word => left word ++ right word) ∈ Complexity.FP := by + exact Cobham.appendFn_mem_FP hleft hright + +/-- Take a prefix of one computed word whose length is another computed word. -/ +theorem machineTake_mem_FP {ruler data : List Bool → List Bool} + (hruler : ruler ∈ Complexity.FP) (hdata : data ∈ Complexity.FP) : + (fun word => (data word).take (ruler word).length) ∈ Complexity.FP := by + exact CobhamFP_subset_FP + (Cobham.takeFn (FP_subset_CobhamFP hruler) (FP_subset_CobhamFP hdata)) + +/-- Select by the leading bit of a verified bitstring computation. -/ +def machineIfHead (flag whenTrue whenFalse : List Bool) : List Bool := + Cobham.selectHead flag whenTrue whenFalse + +theorem machineIfHead_mem_FP + {flag whenTrue whenFalse : List Bool → List Bool} + (hflag : flag ∈ Complexity.FP) + (htrue : whenTrue ∈ Complexity.FP) + (hfalse : whenFalse ∈ Complexity.FP) : + (fun word => machineIfHead (flag word) + (whenTrue word) (whenFalse word)) ∈ Complexity.FP := by + exact Cobham.selectHeadFn_mem_FP hflag htrue hfalse + +@[simp] theorem machineIfHead_true (tail whenTrue whenFalse : List Bool) : + machineIfHead (true :: tail) whenTrue whenFalse = whenTrue := by + simp [machineIfHead, Cobham.selectHead] + +@[simp] theorem machineIfHead_false (tail whenTrue whenFalse : List Bool) : + machineIfHead (false :: tail) whenTrue whenFalse = whenFalse := by + simp [machineIfHead, Cobham.selectHead] + +/-- Select the first branch exactly when `test` is empty. -/ +def machineIfEmpty (test whenEmpty whenNonempty : List Bool) : List Bool := + Cobham.selectHead (Cobham.emptyFlag test) whenEmpty whenNonempty + +theorem machineIfEmpty_mem_FP + {test whenEmpty whenNonempty : List Bool → List Bool} + (htest : test ∈ Complexity.FP) + (hempty : whenEmpty ∈ Complexity.FP) + (hnonempty : whenNonempty ∈ Complexity.FP) : + (fun word => machineIfEmpty (test word) + (whenEmpty word) (whenNonempty word)) ∈ Complexity.FP := by + exact Cobham.selectHeadFn_mem_FP (Cobham.emptyFlag_mem_FP htest) + hempty hnonempty + +@[simp] theorem machineIfEmpty_nil (whenEmpty whenNonempty : List Bool) : + machineIfEmpty [] whenEmpty whenNonempty = whenEmpty := by + exact Cobham.selectHead_emptyFlag_nil _ _ + +@[simp] theorem machineIfEmpty_cons (bit : Bool) (tail whenEmpty whenNonempty : List Bool) : + machineIfEmpty (bit :: tail) whenEmpty whenNonempty = whenNonempty := by + exact Cobham.selectHead_emptyFlag_cons bit tail _ _ + +/-- One-bit word equal to the head of `word`, defaulting to `false` on the +empty word. -/ +def machineHeadBit (word : List Bool) : List Bool := + machineIfEmpty word [false] + (machineIfHead word [true] [false]) + +theorem machineHeadBit_mem_FP : machineHeadBit ∈ Complexity.FP := by + apply machineIfEmpty_mem_FP id_mem_FP + (machineConst_mem_FP [false]) + exact machineIfHead_mem_FP id_mem_FP + (machineConst_mem_FP [true]) (machineConst_mem_FP [false]) + +@[simp] theorem machineHeadBit_nil : machineHeadBit [] = [false] := by + rfl + +@[simp] theorem machineHeadBit_cons (bit : Bool) (tail : List Bool) : + machineHeadBit (bit :: tail) = [bit] := by + cases bit <;> simp [machineHeadBit] + +@[simp] theorem machineHeadBit_length (word : List Bool) : + (machineHeadBit word).length = 1 := by + cases word <;> simp + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineFactorial.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineFactorial.lean new file mode 100644 index 0000000000..4e0d814fbc --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineFactorial.lean @@ -0,0 +1,307 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalLogSeries + +/-! +# Unary-input factorial in the finite-word machine model + +The input length is the natural number whose factorial is required. The +state stores the current factorial, the next multiplier, and a quadratic +clamp. Both evolving fields are clamped on malformed inputs; the ordinary +binary-size proof shows that neither clamp fires on a unary ruler. +-/ + +namespace BeyondBethe + +open Complexity + +def machineFactorialPack (acc next bound : List Bool) : List Bool := + pair acc (pair next bound) + +def machineFactorialAcc (state : List Bool) : List Bool := + machinePairFirst state + +def machineFactorialNext (state : List Bool) : List Bool := + machinePairFirst (machinePairSecond state) + +def machineFactorialBound (state : List Bool) : List Bool := + machinePairSecond (machinePairSecond state) + +def machineFactorialSuccessor (state : List Bool) : List Bool := + machineBinaryAddBits + (pair (machineFactorialNext state) (1 : ℕ).bits) + +def machineFactorialCandidate (state : List Bool) : List Bool := + machineBinaryMulBits + (pair (machineFactorialAcc state) (machineFactorialNext state)) + +def machineFactorialNextAcc (state : List Bool) : List Bool := + (machineFactorialCandidate state).take (machineFactorialBound state).length + +def machineFactorialNextCounter (state : List Bool) : List Bool := + (machineFactorialSuccessor state).take (machineFactorialBound state).length + +def machineFactorialStep (state : List Bool) : List Bool := + machineFactorialPack (machineFactorialNextAcc state) + (machineFactorialNextCounter state) (machineFactorialBound state) + +def machineFactorialInputBound (ruler : List Bool) : List Bool := + machineBinaryMulWidth ruler + +def machineFactorialInit (ruler : List Bool) : List Bool := + machineFactorialPack (1 : ℕ).bits (1 : ℕ).bits + (machineFactorialInputBound ruler) + +def machineFactorialWidth (ruler : List Bool) : List Bool := + let bound := machineFactorialInputBound ruler + machineFactorialPack bound bound bound + +def machineFactorialFinalState (ruler : List Bool) : List Bool := + (machineFactorialStep)^[ruler.length] (machineFactorialInit ruler) + +def machineFactorialBits (ruler : List Bool) : List Bool := + machineFactorialAcc (machineFactorialFinalState ruler) + +def machineFactorialRawRatCode (ruler : List Bool) : List Bool := + pair (false :: machineFactorialBits ruler) (1 : ℕ).bits + +theorem machineFactorialAcc_mem_FP : + machineFactorialAcc ∈ Complexity.FP := machinePairFirst_mem_FP + +theorem machineFactorialNext_mem_FP : + machineFactorialNext ∈ Complexity.FP := by + simpa only [machineFactorialNext] using + machineCompose_mem_FP machinePairSecond_mem_FP machinePairFirst_mem_FP + +theorem machineFactorialBound_mem_FP : + machineFactorialBound ∈ Complexity.FP := by + simpa only [machineFactorialBound] using + machineCompose_mem_FP machinePairSecond_mem_FP machinePairSecond_mem_FP + +theorem machineFactorialSuccessor_mem_FP : + machineFactorialSuccessor ∈ Complexity.FP := by + have hpair := machinePair_mem_FP machineFactorialNext_mem_FP + (machineConst_mem_FP (1 : ℕ).bits) + simpa only [machineFactorialSuccessor] using + machineCompose_mem_FP hpair machineBinaryAddBits_mem_FP + +theorem machineFactorialCandidate_mem_FP : + machineFactorialCandidate ∈ Complexity.FP := by + have hpair := machinePair_mem_FP machineFactorialAcc_mem_FP + machineFactorialNext_mem_FP + simpa only [machineFactorialCandidate] using + machineCompose_mem_FP hpair machineBinaryMulBits_mem_FP + +theorem machineFactorialNextAcc_mem_FP : + machineFactorialNextAcc ∈ Complexity.FP := by + simpa only [machineFactorialNextAcc] using + machineTake_mem_FP machineFactorialBound_mem_FP + machineFactorialCandidate_mem_FP + +theorem machineFactorialNextCounter_mem_FP : + machineFactorialNextCounter ∈ Complexity.FP := by + simpa only [machineFactorialNextCounter] using + machineTake_mem_FP machineFactorialBound_mem_FP + machineFactorialSuccessor_mem_FP + +theorem machineFactorialStep_mem_FP : + machineFactorialStep ∈ Complexity.FP := by + exact machinePair_mem_FP machineFactorialNextAcc_mem_FP + (machinePair_mem_FP machineFactorialNextCounter_mem_FP + machineFactorialBound_mem_FP) + +theorem machineFactorialInputBound_mem_FP : + machineFactorialInputBound ∈ Complexity.FP := + machineBinaryMulWidth_mem_FP + +theorem machineFactorialInit_mem_FP : + machineFactorialInit ∈ Complexity.FP := by + exact machinePair_mem_FP (machineConst_mem_FP (1 : ℕ).bits) + (machinePair_mem_FP (machineConst_mem_FP (1 : ℕ).bits) + machineFactorialInputBound_mem_FP) + +theorem machineFactorialWidth_mem_FP : + machineFactorialWidth ∈ Complexity.FP := by + exact machinePair_mem_FP machineFactorialInputBound_mem_FP + (machinePair_mem_FP machineFactorialInputBound_mem_FP + machineFactorialInputBound_mem_FP) + +@[simp] theorem machineFactorialAcc_pack (acc next bound) : + machineFactorialAcc (machineFactorialPack acc next bound) = acc := by + simp [machineFactorialAcc, machineFactorialPack] + +@[simp] theorem machineFactorialNext_pack (acc next bound) : + machineFactorialNext (machineFactorialPack acc next bound) = next := by + simp [machineFactorialNext, machineFactorialPack] + +@[simp] theorem machineFactorialBound_pack (acc next bound) : + machineFactorialBound (machineFactorialPack acc next bound) = bound := by + simp [machineFactorialBound, machineFactorialPack] + +def MachineFactorialStateBound (ruler state : List Bool) : Prop := + let B := (machineFactorialInputBound ruler).length + state = machineFactorialPack (machineFactorialAcc state) + (machineFactorialNext state) (machineFactorialBound state) ∧ + (machineFactorialAcc state).length ≤ B ∧ + (machineFactorialNext state).length ≤ B ∧ + (machineFactorialBound state).length ≤ B + +theorem machineFactorial_one_le_bound (ruler : List Bool) : + (1 : ℕ).bits.length ≤ (machineFactorialInputBound ruler).length := by + simp [machineFactorialInputBound, machineBinaryMulWidth] + +theorem machineFactorialInit_bound (ruler : List Bool) : + MachineFactorialStateBound ruler (machineFactorialInit ruler) := by + simp only [MachineFactorialStateBound, machineFactorialInit, + machineFactorialAcc_pack, machineFactorialNext_pack, + machineFactorialBound_pack] + exact ⟨trivial, machineFactorial_one_le_bound ruler, + machineFactorial_one_le_bound ruler, le_rfl⟩ + +theorem machineFactorialStep_bound {ruler state : List Bool} + (hstate : MachineFactorialStateBound ruler state) : + MachineFactorialStateBound ruler (machineFactorialStep state) := by + dsimp only [MachineFactorialStateBound] at hstate ⊢ + rcases hstate with ⟨hpack, hacc, hnext, hbound⟩ + simp only [machineFactorialStep, machineFactorialAcc_pack, + machineFactorialNext_pack, machineFactorialBound_pack] + refine ⟨trivial, ?_, ?_, hbound⟩ + · exact (List.length_take_le _ _).trans hbound + · exact (List.length_take_le _ _).trans hbound + +theorem machineFactorialIterate_bound (ruler : List Bool) : ∀ k, + MachineFactorialStateBound ruler + ((machineFactorialStep)^[k] (machineFactorialInit ruler)) := by + intro k + induction k with + | zero => exact machineFactorialInit_bound ruler + | succ k ih => + rw [Function.iterate_succ_apply'] + exact machineFactorialStep_bound ih + +theorem machineFactorialIterate_length_le_width + (ruler : List Bool) (iterations : ℕ) (_ : iterations ≤ ruler.length) : + ((machineFactorialStep)^[iterations] + (machineFactorialInit ruler)).length ≤ + (machineFactorialWidth ruler).length := by + have hstate := machineFactorialIterate_bound ruler iterations + dsimp only [MachineFactorialStateBound] at hstate + rcases hstate with ⟨hpack, hacc, hnext, hbound⟩ + rw [hpack] + simp only [machineFactorialPack, machineFactorialWidth, pair_length] + omega + +theorem machineFactorialFinalState_mem_FP : + machineFactorialFinalState ∈ Complexity.FP := by + exact Cobham.iterate_mem_FP machineFactorialStep_mem_FP + machineFactorialInit_mem_FP id_mem_FP machineFactorialWidth_mem_FP + machineFactorialIterate_length_le_width + +theorem machineFactorialBits_mem_FP : + machineFactorialBits ∈ Complexity.FP := by + simpa only [machineFactorialBits] using + machineCompose_mem_FP machineFactorialFinalState_mem_FP + machineFactorialAcc_mem_FP + +theorem machineFactorialRawRatCode_mem_FP : + machineFactorialRawRatCode ∈ Complexity.FP := by + have hnum := machineCompose_mem_FP machineFactorialBits_mem_FP + (machinePrepend_mem_FP false) + exact machinePair_mem_FP hnum (machineConst_mem_FP (1 : ℕ).bits) + +/-! ## Exact semantics on unary rulers -/ + +theorem factorial_bits_length_le_bound {n k : ℕ} (hk : k ≤ n) : + k.factorial.bits.length ≤ + (machineFactorialInputBound (List.replicate n true)).length := by + rw [Nat.size_eq_bits_len, Nat.size_le] + have hfac : k.factorial ≤ 2 ^ (k ^ 2) := by + calc + k.factorial ≤ k ^ k := Nat.factorial_le_pow k + _ ≤ (2 ^ k) ^ k := Nat.pow_le_pow_left k.lt_two_pow_self.le k + _ = 2 ^ (k ^ 2) := by simp [pow_mul, pow_two] + have hsq : k ^ 2 ≤ n ^ 2 := Nat.pow_le_pow_left hk 2 + have hpow : 2 ^ (k ^ 2) ≤ 2 ^ (n ^ 2) := + Nat.pow_le_pow_right (by decide) hsq + have hexponent : n ^ 2 < (16 + n) * (16 + n) := by + nlinarith + have hstrict : 2 ^ (n ^ 2) < 2 ^ ((16 + n) * (16 + n)) := + (Nat.pow_lt_pow_iff_right (by omega)).2 hexponent + have hlength : + (machineFactorialInputBound (List.replicate n true)).length = + (16 + n) * (16 + n) := by + simp only [machineFactorialInputBound, machineBinaryMulWidth, + List.length_replicate, List.length_append] + rw [hlength] + exact hfac.trans_lt (hpow.trans_lt hstrict) + +theorem factorial_counter_bits_length_le_bound {n k : ℕ} + (hk : k ≤ n + 1) : + k.bits.length ≤ + (machineFactorialInputBound (List.replicate n true)).length := by + have hbits : k.bits.length ≤ k := by + rw [Nat.size_eq_bits_len, Nat.size_le] + exact k.lt_two_pow_self + have hlength : + (machineFactorialInputBound (List.replicate n true)).length = + (16 + n) * (16 + n) := by + simp only [machineFactorialInputBound, machineBinaryMulWidth, + List.length_replicate, List.length_append] + rw [hlength] + exact hbits.trans <| by nlinarith + +def machineFactorialSemanticState (n k : ℕ) : List Bool := + machineFactorialPack k.factorial.bits (k + 1).bits + (machineFactorialInputBound (List.replicate n true)) + +@[simp] theorem machineFactorialSemanticState_zero (n : ℕ) : + machineFactorialSemanticState n 0 = + machineFactorialInit (List.replicate n true) := by + simp [machineFactorialSemanticState, machineFactorialInit] + +theorem machineFactorialSemanticState_step (n k : ℕ) (hk : k < n) : + machineFactorialStep (machineFactorialSemanticState n k) = + machineFactorialSemanticState n (k + 1) := by + have hfac := factorial_bits_length_le_bound (show k + 1 ≤ n by omega) + have hcounter := factorial_counter_bits_length_le_bound + (show k + 2 ≤ n + 1 by omega) + simp only [machineFactorialStep, machineFactorialSemanticState, + machineFactorialNextAcc, machineFactorialCandidate, + machineFactorialAcc_pack, machineFactorialNext_pack, + machineFactorialBound_pack, machineBinaryMulBits_pair_natBits, + machineFactorialNextCounter, machineFactorialSuccessor, + machineBinaryAddBits_pair_natBits] + rw [(List.take_eq_self_iff _).2 (by + simpa [Nat.factorial_succ, Nat.mul_comm] using hfac), + (List.take_eq_self_iff _).2 hcounter] + simp [Nat.factorial_succ, Nat.mul_comm, Nat.add_assoc] + +theorem machineFactorialIterate_semantics (n : ℕ) : ∀ k ≤ n, + (machineFactorialStep)^[k] + (machineFactorialInit (List.replicate n true)) = + machineFactorialSemanticState n k := by + intro k hk + induction k with + | zero => exact (machineFactorialSemanticState_zero n).symm + | succ k ih => + rw [Function.iterate_succ_apply', ih (by omega)] + exact machineFactorialSemanticState_step n k (by omega) + +@[simp] theorem machineFactorialBits_encode (n : ℕ) : + machineFactorialBits (List.replicate n true) = n.factorial.bits := by + rw [machineFactorialBits, machineFactorialFinalState] + simp only [List.length_replicate] + rw [machineFactorialIterate_semantics n n le_rfl] + simp [machineFactorialSemanticState] + +@[simp] theorem machineFactorialRawRatCode_encode (n : ℕ) : + machineFactorialRawRatCode (List.replicate n true) = + rawRatBinaryCode (RawRat.ofNat n.factorial) := by + simp [machineFactorialRawRatCode, rawRatBinaryCode, RawRat.ofNat, + integerBinaryCode] + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineFinalScalars.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineFinalScalars.lean new file mode 100644 index 0000000000..81b1f809ce --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineFinalScalars.lean @@ -0,0 +1,43 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineMatrixNormalization +import LeanPool.BeyondBethe.BeyondBethe.MachineSmallDimension +import LeanPool.BeyondBethe.BeyondBethe.FinalAssembly + +/-! +# Connections between scalar machines and the completed algorithm +-/ + +namespace BeyondBethe + +@[simp] theorem machineMatrixNonnegativeBit_finalDecision {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) : + machineMatrixNonnegativeBit + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩) = + [rationalMatrixNonnegativeDecision A] := by + rw [machineMatrixNonnegativeBit_encode] + apply congrArg singleton + apply Bool.eq_iff_iff.mpr + simp [rationalMatrixNonnegativeDecision, Matrix.Nonnegative] + +@[simp] theorem machineMatrixNormalizationScaleOutputCode_final {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) : + machineMatrixNormalizationScaleOutputCode + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩) = + rationalBinaryCode (rationalNormalizationScale A) := by + simpa only [rationalNormalizationScale] using + machineMatrixNormalizationScaleOutputCode_encode A + +@[simp] theorem machineMatrixNormalizationScalePowerOutputCode_final {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) : + machineMatrixNormalizationScalePowerOutputCode + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩) = + rationalBinaryCode (rationalNormalizationScale A ^ n) := by + simpa only [rationalNormalizationScale] using + machineMatrixNormalizationScalePowerOutputCode_encode A + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineFourCoreCost.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineFourCoreCost.lean new file mode 100644 index 0000000000..e8a2dfdfe7 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineFourCoreCost.lean @@ -0,0 +1,269 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineDirectedTransferCost + +/-! +# The four-core directed cost as a finite-word function + +The input is +`pair rUnary (pair sUnary (pair aUnary (pair bUnary optimizerWord)))`. +The output is the unreduced rational sum of the four directed transfer-cost +endpoints used by the executable row-pair certificate. +-/ + +namespace BeyondBethe + +open Complexity + +def machineFourCoreFirstRowRuler (word : List Bool) : List Bool := + machinePairFirst word + +def machineFourCoreRest₁ (word : List Bool) : List Bool := + machinePairSecond word + +def machineFourCoreSecondRowRuler (word : List Bool) : List Bool := + machinePairFirst (machineFourCoreRest₁ word) + +def machineFourCoreRest₂ (word : List Bool) : List Bool := + machinePairSecond (machineFourCoreRest₁ word) + +def machineFourCoreFirstColumnRuler (word : List Bool) : List Bool := + machinePairFirst (machineFourCoreRest₂ word) + +def machineFourCoreRest₃ (word : List Bool) : List Bool := + machinePairSecond (machineFourCoreRest₂ word) + +def machineFourCoreSecondColumnRuler (word : List Bool) : List Bool := + machinePairFirst (machineFourCoreRest₃ word) + +def machineFourCoreOptimizerWord (word : List Bool) : List Bool := + machinePairSecond (machineFourCoreRest₃ word) + +def machineFourCoreTransferInput + (row column optimizer : List Bool) : List Bool := + pair row (pair column optimizer) + +def machineFourCoreRACostRawCode (word : List Bool) : List Bool := + machineDirectedTransferCostUpperRawCode + (machineFourCoreTransferInput + (machineFourCoreFirstRowRuler word) + (machineFourCoreFirstColumnRuler word) + (machineFourCoreOptimizerWord word)) + +def machineFourCoreRBCostRawCode (word : List Bool) : List Bool := + machineDirectedTransferCostUpperRawCode + (machineFourCoreTransferInput + (machineFourCoreFirstRowRuler word) + (machineFourCoreSecondColumnRuler word) + (machineFourCoreOptimizerWord word)) + +def machineFourCoreSACostRawCode (word : List Bool) : List Bool := + machineDirectedTransferCostUpperRawCode + (machineFourCoreTransferInput + (machineFourCoreSecondRowRuler word) + (machineFourCoreFirstColumnRuler word) + (machineFourCoreOptimizerWord word)) + +def machineFourCoreSBCostRawCode (word : List Bool) : List Bool := + machineDirectedTransferCostUpperRawCode + (machineFourCoreTransferInput + (machineFourCoreSecondRowRuler word) + (machineFourCoreSecondColumnRuler word) + (machineFourCoreOptimizerWord word)) + +def machineFourCoreFirstRowSumRawCode (word : List Bool) : List Bool := + machineRawRatAddCode + (pair (machineFourCoreRACostRawCode word) + (machineFourCoreRBCostRawCode word)) + +def machineFourCoreSecondRowSumRawCode (word : List Bool) : List Bool := + machineRawRatAddCode + (pair (machineFourCoreSACostRawCode word) + (machineFourCoreSBCostRawCode word)) + +/-- Unreduced raw-rational code for the directed four-core cost. -/ +def machineDirectedFourCoreCostUpperRawCode (word : List Bool) : List Bool := + machineRawRatAddCode + (pair (machineFourCoreFirstRowSumRawCode word) + (machineFourCoreSecondRowSumRawCode word)) + +theorem machineFourCoreFirstRowRuler_mem_FP : + machineFourCoreFirstRowRuler ∈ FP := machinePairFirst_mem_FP + +theorem machineFourCoreRest₁_mem_FP : machineFourCoreRest₁ ∈ FP := + machinePairSecond_mem_FP + +theorem machineFourCoreSecondRowRuler_mem_FP : + machineFourCoreSecondRowRuler ∈ FP := by + simpa only [machineFourCoreSecondRowRuler] using machineCompose_mem_FP + machineFourCoreRest₁_mem_FP machinePairFirst_mem_FP + +theorem machineFourCoreRest₂_mem_FP : machineFourCoreRest₂ ∈ FP := by + simpa only [machineFourCoreRest₂] using machineCompose_mem_FP + machineFourCoreRest₁_mem_FP machinePairSecond_mem_FP + +theorem machineFourCoreFirstColumnRuler_mem_FP : + machineFourCoreFirstColumnRuler ∈ FP := by + simpa only [machineFourCoreFirstColumnRuler] using machineCompose_mem_FP + machineFourCoreRest₂_mem_FP machinePairFirst_mem_FP + +theorem machineFourCoreRest₃_mem_FP : machineFourCoreRest₃ ∈ FP := by + simpa only [machineFourCoreRest₃] using machineCompose_mem_FP + machineFourCoreRest₂_mem_FP machinePairSecond_mem_FP + +theorem machineFourCoreSecondColumnRuler_mem_FP : + machineFourCoreSecondColumnRuler ∈ FP := by + simpa only [machineFourCoreSecondColumnRuler] using machineCompose_mem_FP + machineFourCoreRest₃_mem_FP machinePairFirst_mem_FP + +theorem machineFourCoreOptimizerWord_mem_FP : + machineFourCoreOptimizerWord ∈ FP := by + simpa only [machineFourCoreOptimizerWord] using machineCompose_mem_FP + machineFourCoreRest₃_mem_FP machinePairSecond_mem_FP + +theorem machineFourCoreTransferInput_mem_FP + {row column optimizer : List Bool → List Bool} + (hrow : row ∈ FP) (hcolumn : column ∈ FP) (hoptimizer : optimizer ∈ FP) : + (fun word ↦ machineFourCoreTransferInput + (row word) (column word) (optimizer word)) ∈ FP := by + exact machinePair_mem_FP hrow (machinePair_mem_FP hcolumn hoptimizer) + +theorem machineFourCoreRACostRawCode_mem_FP : + machineFourCoreRACostRawCode ∈ FP := by + have hinput := machineFourCoreTransferInput_mem_FP + machineFourCoreFirstRowRuler_mem_FP machineFourCoreFirstColumnRuler_mem_FP + machineFourCoreOptimizerWord_mem_FP + simpa only [machineFourCoreRACostRawCode] using machineCompose_mem_FP hinput + machineDirectedTransferCostUpperRawCode_mem_FP + +theorem machineFourCoreRBCostRawCode_mem_FP : + machineFourCoreRBCostRawCode ∈ FP := by + have hinput := machineFourCoreTransferInput_mem_FP + machineFourCoreFirstRowRuler_mem_FP machineFourCoreSecondColumnRuler_mem_FP + machineFourCoreOptimizerWord_mem_FP + simpa only [machineFourCoreRBCostRawCode] using machineCompose_mem_FP hinput + machineDirectedTransferCostUpperRawCode_mem_FP + +theorem machineFourCoreSACostRawCode_mem_FP : + machineFourCoreSACostRawCode ∈ FP := by + have hinput := machineFourCoreTransferInput_mem_FP + machineFourCoreSecondRowRuler_mem_FP machineFourCoreFirstColumnRuler_mem_FP + machineFourCoreOptimizerWord_mem_FP + simpa only [machineFourCoreSACostRawCode] using machineCompose_mem_FP hinput + machineDirectedTransferCostUpperRawCode_mem_FP + +theorem machineFourCoreSBCostRawCode_mem_FP : + machineFourCoreSBCostRawCode ∈ FP := by + have hinput := machineFourCoreTransferInput_mem_FP + machineFourCoreSecondRowRuler_mem_FP machineFourCoreSecondColumnRuler_mem_FP + machineFourCoreOptimizerWord_mem_FP + simpa only [machineFourCoreSBCostRawCode] using machineCompose_mem_FP hinput + machineDirectedTransferCostUpperRawCode_mem_FP + +theorem machineFourCoreFirstRowSumRawCode_mem_FP : + machineFourCoreFirstRowSumRawCode ∈ FP := by + have hinput := machinePair_mem_FP machineFourCoreRACostRawCode_mem_FP + machineFourCoreRBCostRawCode_mem_FP + simpa only [machineFourCoreFirstRowSumRawCode] using machineCompose_mem_FP + hinput machineRawRatAddCode_mem_FP + +theorem machineFourCoreSecondRowSumRawCode_mem_FP : + machineFourCoreSecondRowSumRawCode ∈ FP := by + have hinput := machinePair_mem_FP machineFourCoreSACostRawCode_mem_FP + machineFourCoreSBCostRawCode_mem_FP + simpa only [machineFourCoreSecondRowSumRawCode] using machineCompose_mem_FP + hinput machineRawRatAddCode_mem_FP + +theorem machineDirectedFourCoreCostUpperRawCode_mem_FP : + machineDirectedFourCoreCostUpperRawCode ∈ FP := by + have hinput := machinePair_mem_FP + machineFourCoreFirstRowSumRawCode_mem_FP + machineFourCoreSecondRowSumRawCode_mem_FP + simpa only [machineDirectedFourCoreCostUpperRawCode] using + machineCompose_mem_FP hinput machineRawRatAddCode_mem_FP + +def rawDirectedFourCoreCostUpper {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) (r s a b : Fin n) : RawRat := + ((rawDirectedTransferCostUpper X r a).add + (rawDirectedTransferCostUpper X r b)).add + ((rawDirectedTransferCostUpper X s a).add + (rawDirectedTransferCostUpper X s b)) + +def fourCoreMachineInput {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℚ) + (r s a b : Fin n) : List Bool := + pair (List.replicate r.1 true) + (pair (List.replicate s.1 true) + (pair (List.replicate a.1 true) + (pair (List.replicate b.1 true) + (rationalOptimizerOutputCode ⟨X, R, C⟩)))) + +@[simp] theorem machineFourCoreRACostRawCode_encode {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℚ) + (r s a b : Fin n) : + machineFourCoreRACostRawCode (fourCoreMachineInput X R C r s a b) = + rawRatBinaryCode (rawDirectedTransferCostUpper X r a) := by + simp [machineFourCoreRACostRawCode, machineFourCoreTransferInput, + fourCoreMachineInput, machineFourCoreFirstRowRuler, + machineFourCoreFirstColumnRuler, machineFourCoreOptimizerWord, + machineFourCoreRest₁, machineFourCoreRest₂, machineFourCoreRest₃] + +@[simp] theorem machineFourCoreRBCostRawCode_encode {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℚ) + (r s a b : Fin n) : + machineFourCoreRBCostRawCode (fourCoreMachineInput X R C r s a b) = + rawRatBinaryCode (rawDirectedTransferCostUpper X r b) := by + simp [machineFourCoreRBCostRawCode, machineFourCoreTransferInput, + fourCoreMachineInput, machineFourCoreFirstRowRuler, + machineFourCoreSecondColumnRuler, machineFourCoreOptimizerWord, + machineFourCoreRest₁, machineFourCoreRest₂, machineFourCoreRest₃] + +@[simp] theorem machineFourCoreSACostRawCode_encode {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℚ) + (r s a b : Fin n) : + machineFourCoreSACostRawCode (fourCoreMachineInput X R C r s a b) = + rawRatBinaryCode (rawDirectedTransferCostUpper X s a) := by + simp [machineFourCoreSACostRawCode, machineFourCoreTransferInput, + fourCoreMachineInput, machineFourCoreSecondRowRuler, + machineFourCoreFirstColumnRuler, machineFourCoreOptimizerWord, + machineFourCoreRest₁, machineFourCoreRest₂, machineFourCoreRest₃] + +@[simp] theorem machineFourCoreSBCostRawCode_encode {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℚ) + (r s a b : Fin n) : + machineFourCoreSBCostRawCode (fourCoreMachineInput X R C r s a b) = + rawRatBinaryCode (rawDirectedTransferCostUpper X s b) := by + simp [machineFourCoreSBCostRawCode, machineFourCoreTransferInput, + fourCoreMachineInput, machineFourCoreSecondRowRuler, + machineFourCoreSecondColumnRuler, machineFourCoreOptimizerWord, + machineFourCoreRest₁, machineFourCoreRest₂, machineFourCoreRest₃] + +@[simp] theorem machineDirectedFourCoreCostUpperRawCode_encode {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℚ) + (r s a b : Fin n) : + machineDirectedFourCoreCostUpperRawCode + (fourCoreMachineInput X R C r s a b) = + rawRatBinaryCode (rawDirectedFourCoreCostUpper X r s a b) := by + rw [machineDirectedFourCoreCostUpperRawCode, + machineFourCoreFirstRowSumRawCode, machineFourCoreSecondRowSumRawCode, + machineFourCoreRACostRawCode_encode, machineFourCoreRBCostRawCode_encode, + machineRawRatAddCode_encode, machineFourCoreSACostRawCode_encode, + machineFourCoreSBCostRawCode_encode, machineRawRatAddCode_encode, + machineRawRatAddCode_encode] + rfl + +theorem rawDirectedFourCoreCostUpper_value {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) (r s a b : Fin n) : + (rawDirectedFourCoreCostUpper X r s a b).value = + directedFourCoreCostUpper (explicitRegularizationScale n) X r s a b + (directedPairCostPrecision n) := by + simp only [rawDirectedFourCoreCostUpper, directedFourCoreCostUpper, + RawRat.value_add, rawDirectedTransferCostUpper_value, + directedCertificatePrecision_eq_pairCostPrecision] + ring + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineGreedyRowMatching.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineGreedyRowMatching.lean new file mode 100644 index 0000000000..543f2c5a0a --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineGreedyRowMatching.lean @@ -0,0 +1,1841 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineRowPairDisjoint + +/-! +# The deterministic greedy row matcher as a finite-word function + +The matcher scans rows and columns in reverse lexicographic order, exactly the +order induced by `greedyRowMatchingList`. Its state stores the selected +ordered row pairs as a self-delimiting list. Disjointness is delegated to the +verified list scanner, avoiding a separate mutable-memory invariant. +-/ + +namespace BeyondBethe + +open Complexity + +def machineMatchingDimensionRuler (optimizer : List Bool) : List Bool := + machineCertificateDimensionUnary optimizer + +def machineMatchingForwardRange (optimizer : List Bool) : List Bool := + machineUnaryRangeCode (machineMatchingDimensionRuler optimizer) + +def machineMatchingReverseRange (optimizer : List Bool) : List Bool := + machineListReverse (machineMatchingForwardRange optimizer) + +theorem machineMatchingDimensionRuler_mem_FP : + machineMatchingDimensionRuler ∈ FP := + machineCertificateDimensionUnary_mem_FP + +theorem machineMatchingForwardRange_mem_FP : + machineMatchingForwardRange ∈ FP := by + simpa only [machineMatchingForwardRange] using machineCompose_mem_FP + machineMatchingDimensionRuler_mem_FP machineUnaryRangeCode_mem_FP + +theorem machineMatchingReverseRange_mem_FP : + machineMatchingReverseRange ∈ FP := by + simpa only [machineMatchingReverseRange] using machineCompose_mem_FP + machineMatchingForwardRange_mem_FP machineListReverse_mem_FP + +@[simp] theorem machineMatchingDimensionRuler_encode {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℚ) : + machineMatchingDimensionRuler (rationalOptimizerOutputCode ⟨X, R, C⟩) = + List.replicate n true := by + exact machineCertificateDimensionUnary_encode X R C + +@[simp] theorem machineMatchingForwardRange_encode {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℚ) : + machineMatchingForwardRange (rationalOptimizerOutputCode ⟨X, R, C⟩) = + finRangeUnaryCode n := by + rw [machineMatchingForwardRange, machineMatchingDimensionRuler_encode, + machineUnaryRangeCode_encode] + +@[simp] theorem machineMatchingReverseRange_encode {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℚ) : + machineMatchingReverseRange (rationalOptimizerOutputCode ⟨X, R, C⟩) = + binaryListCode finUnaryCode (List.finRange n).reverse := by + rw [machineMatchingReverseRange, machineMatchingForwardRange_encode] + exact machineListReverse_encode finUnaryCode (List.finRange n) + +/-! ## The inner scan over second rows -/ + +/-- Inner input: `pair iUnary (pair selectedList optimizerWord)`. -/ +def machineMatchingInnerFirstRow (word : List Bool) : List Bool := + machinePairFirst word + +def machineMatchingInnerRest (word : List Bool) : List Bool := + machinePairSecond word + +def machineMatchingInnerSelectedInput (word : List Bool) : List Bool := + machinePairFirst (machineMatchingInnerRest word) + +def machineMatchingInnerOptimizer (word : List Bool) : List Bool := + machinePairSecond (machineMatchingInnerRest word) + +def machineMatchingInnerPack + (remaining selected source : List Bool) : List Bool := + pair remaining (pair selected source) + +def machineMatchingInnerRemaining (state : List Bool) : List Bool := + machinePairFirst state + +def machineMatchingInnerSelected (state : List Bool) : List Bool := + machinePairFirst (machinePairSecond state) + +def machineMatchingInnerSource (state : List Bool) : List Bool := + machinePairSecond (machinePairSecond state) + +def machineMatchingInnerCurrentSecondRow (state : List Bool) : List Bool := + machineListHead (machineMatchingInnerRemaining state) + +def machineMatchingInnerFirstLessSecondBit (state : List Bool) : List Bool := + machineBinaryNatLtBit + (pair (machineLengthBits + (machineMatchingInnerFirstRow (machineMatchingInnerSource state))) + (machineLengthBits (machineMatchingInnerCurrentSecondRow state))) + +def machineMatchingInnerEligibilityInput (state : List Bool) : List Bool := + pair (machineMatchingInnerFirstRow (machineMatchingInnerSource state)) + (pair (machineMatchingInnerCurrentSecondRow state) + (machineMatchingInnerOptimizer (machineMatchingInnerSource state))) + +def machineMatchingInnerEligibleBit (state : List Bool) : List Bool := + machineCertifiedRowPairEligibilityBit + (machineMatchingInnerEligibilityInput state) + +def machineMatchingInnerDisjointInput (state : List Bool) : List Bool := + pair (machineMatchingInnerFirstRow (machineMatchingInnerSource state)) + (pair (machineMatchingInnerCurrentSecondRow state) + (machineMatchingInnerSelected state)) + +def machineMatchingInnerDisjointBit (state : List Bool) : List Bool := + machineRowPairDisjointBit (machineMatchingInnerDisjointInput state) + +def machineMatchingInnerSelectBit (state : List Bool) : List Bool := + machineAndBit (machineMatchingInnerFirstLessSecondBit state) + (machineAndBit (machineMatchingInnerEligibleBit state) + (machineMatchingInnerDisjointBit state)) + +def machineMatchingInnerSelectedCandidate (state : List Bool) : List Bool := + pair (pair (machineMatchingInnerFirstRow (machineMatchingInnerSource state)) + (machineMatchingInnerCurrentSecondRow state)) + (machineMatchingInnerSelected state) + +def machineMatchingInnerInputBound (word : List Bool) : List Bool := + machineBinaryMulWidth (machineBinaryMulWidth + (pair word (machineMatchingReverseRange + (machineMatchingInnerOptimizer word)))) + +def machineMatchingInnerBound (state : List Bool) : List Bool := + machineMatchingInnerInputBound (machineMatchingInnerSource state) + +def machineMatchingInnerSelectedCandidateClamped + (state : List Bool) : List Bool := + (machineMatchingInnerSelectedCandidate state).take + (machineMatchingInnerBound state).length + +def machineMatchingInnerNextSelected (state : List Bool) : List Bool := + machineIfHead (machineMatchingInnerSelectBit state) + (machineMatchingInnerSelectedCandidateClamped state) + (machineMatchingInnerSelected state) + +def machineMatchingInnerProcess (state : List Bool) : List Bool := + machineMatchingInnerPack + (machineListTail (machineMatchingInnerRemaining state)) + (machineMatchingInnerNextSelected state) + (machineMatchingInnerSource state) + +def machineMatchingInnerStep (state : List Bool) : List Bool := + machineIfEmpty (machineMatchingInnerRemaining state) state + (machineMatchingInnerProcess state) + +def machineMatchingInnerInit (word : List Bool) : List Bool := + machineMatchingInnerPack + (machineMatchingReverseRange (machineMatchingInnerOptimizer word)) + (machineMatchingInnerSelectedInput word) word + +def machineMatchingInnerWidth (word : List Bool) : List Bool := + let bound := machineMatchingInnerInputBound word + machineMatchingInnerPack bound bound bound + +def machineMatchingInnerFinalState (word : List Bool) : List Bool := + (machineMatchingInnerStep)^[(machineMatchingDimensionRuler + (machineMatchingInnerOptimizer word)).length] + (machineMatchingInnerInit word) + +def machineMatchingInnerOutputSelected (word : List Bool) : List Bool := + machineMatchingInnerSelected (machineMatchingInnerFinalState word) + +theorem machineMatchingInnerFirstRow_mem_FP : + machineMatchingInnerFirstRow ∈ FP := machinePairFirst_mem_FP + +theorem machineMatchingInnerRest_mem_FP : machineMatchingInnerRest ∈ FP := + machinePairSecond_mem_FP + +theorem machineMatchingInnerSelectedInput_mem_FP : + machineMatchingInnerSelectedInput ∈ FP := by + simpa only [machineMatchingInnerSelectedInput] using machineCompose_mem_FP + machineMatchingInnerRest_mem_FP machinePairFirst_mem_FP + +theorem machineMatchingInnerOptimizer_mem_FP : + machineMatchingInnerOptimizer ∈ FP := by + simpa only [machineMatchingInnerOptimizer] using machineCompose_mem_FP + machineMatchingInnerRest_mem_FP machinePairSecond_mem_FP + +theorem machineMatchingInnerRemaining_mem_FP : + machineMatchingInnerRemaining ∈ FP := machinePairFirst_mem_FP + +theorem machineMatchingInnerSelected_mem_FP : + machineMatchingInnerSelected ∈ FP := by + simpa only [machineMatchingInnerSelected] using machineCompose_mem_FP + machinePairSecond_mem_FP machinePairFirst_mem_FP + +theorem machineMatchingInnerSource_mem_FP : machineMatchingInnerSource ∈ FP := by + simpa only [machineMatchingInnerSource] using machineCompose_mem_FP + machinePairSecond_mem_FP machinePairSecond_mem_FP + +theorem machineMatchingInnerCurrentSecondRow_mem_FP : + machineMatchingInnerCurrentSecondRow ∈ FP := by + simpa only [machineMatchingInnerCurrentSecondRow] using machineCompose_mem_FP + machineMatchingInnerRemaining_mem_FP machineListHead_mem_FP + +theorem machineMatchingInnerFirstLessSecondBit_mem_FP : + machineMatchingInnerFirstLessSecondBit ∈ FP := by + have hfirst := machineCompose_mem_FP + (machineCompose_mem_FP machineMatchingInnerSource_mem_FP + machineMatchingInnerFirstRow_mem_FP) machineLengthBits_mem_FP + have hsecond := machineCompose_mem_FP + machineMatchingInnerCurrentSecondRow_mem_FP machineLengthBits_mem_FP + have hinput := machinePair_mem_FP hfirst hsecond + simpa only [machineMatchingInnerFirstLessSecondBit] using + machineCompose_mem_FP hinput machineBinaryNatLtBit_mem_FP + +theorem machineMatchingInnerEligibilityInput_mem_FP : + machineMatchingInnerEligibilityInput ∈ FP := by + have hfirst := machineCompose_mem_FP machineMatchingInnerSource_mem_FP + machineMatchingInnerFirstRow_mem_FP + have hoptimizer := machineCompose_mem_FP machineMatchingInnerSource_mem_FP + machineMatchingInnerOptimizer_mem_FP + exact machinePair_mem_FP hfirst + (machinePair_mem_FP machineMatchingInnerCurrentSecondRow_mem_FP hoptimizer) + +theorem machineMatchingInnerEligibleBit_mem_FP : + machineMatchingInnerEligibleBit ∈ FP := by + simpa only [machineMatchingInnerEligibleBit] using machineCompose_mem_FP + machineMatchingInnerEligibilityInput_mem_FP + machineCertifiedRowPairEligibilityBit_mem_FP + +theorem machineMatchingInnerDisjointInput_mem_FP : + machineMatchingInnerDisjointInput ∈ FP := by + have hfirst := machineCompose_mem_FP machineMatchingInnerSource_mem_FP + machineMatchingInnerFirstRow_mem_FP + exact machinePair_mem_FP hfirst + (machinePair_mem_FP machineMatchingInnerCurrentSecondRow_mem_FP + machineMatchingInnerSelected_mem_FP) + +theorem machineMatchingInnerDisjointBit_mem_FP : + machineMatchingInnerDisjointBit ∈ FP := by + simpa only [machineMatchingInnerDisjointBit] using machineCompose_mem_FP + machineMatchingInnerDisjointInput_mem_FP machineRowPairDisjointBit_mem_FP + +theorem machineMatchingInnerSelectBit_mem_FP : + machineMatchingInnerSelectBit ∈ FP := + machineAndBit_mem_FP machineMatchingInnerFirstLessSecondBit_mem_FP + (machineAndBit_mem_FP machineMatchingInnerEligibleBit_mem_FP + machineMatchingInnerDisjointBit_mem_FP) + +theorem machineMatchingInnerSelectedCandidate_mem_FP : + machineMatchingInnerSelectedCandidate ∈ FP := by + have hfirst := machineCompose_mem_FP machineMatchingInnerSource_mem_FP + machineMatchingInnerFirstRow_mem_FP + exact machinePair_mem_FP + (machinePair_mem_FP hfirst machineMatchingInnerCurrentSecondRow_mem_FP) + machineMatchingInnerSelected_mem_FP + +theorem machineMatchingInnerInputBound_mem_FP : + machineMatchingInnerInputBound ∈ FP := by + have hoptimizerRange := machineCompose_mem_FP + machineMatchingInnerOptimizer_mem_FP machineMatchingReverseRange_mem_FP + have hbase := machinePair_mem_FP id_mem_FP hoptimizerRange + have hfirstWidth : + (fun word => machineBinaryMulWidth + (pair word (machineMatchingReverseRange + (machineMatchingInnerOptimizer word)))) ∈ FP := + machineCompose_mem_FP hbase machineBinaryMulWidth_mem_FP + simpa only [machineMatchingInnerInputBound] using + machineCompose_mem_FP hfirstWidth machineBinaryMulWidth_mem_FP + +theorem machineMatchingInnerBound_mem_FP : machineMatchingInnerBound ∈ FP := by + simpa only [machineMatchingInnerBound] using machineCompose_mem_FP + machineMatchingInnerSource_mem_FP machineMatchingInnerInputBound_mem_FP + +theorem machineMatchingInnerSelectedCandidateClamped_mem_FP : + machineMatchingInnerSelectedCandidateClamped ∈ FP := by + simpa only [machineMatchingInnerSelectedCandidateClamped] using + machineTake_mem_FP machineMatchingInnerBound_mem_FP + machineMatchingInnerSelectedCandidate_mem_FP + +theorem machineMatchingInnerNextSelected_mem_FP : + machineMatchingInnerNextSelected ∈ FP := by + exact machineIfHead_mem_FP machineMatchingInnerSelectBit_mem_FP + machineMatchingInnerSelectedCandidateClamped_mem_FP + machineMatchingInnerSelected_mem_FP + +theorem machineMatchingInnerProcess_mem_FP : + machineMatchingInnerProcess ∈ FP := by + have htail := machineCompose_mem_FP machineMatchingInnerRemaining_mem_FP + machineListTail_mem_FP + exact machinePair_mem_FP htail + (machinePair_mem_FP machineMatchingInnerNextSelected_mem_FP + machineMatchingInnerSource_mem_FP) + +theorem machineMatchingInnerStep_mem_FP : machineMatchingInnerStep ∈ FP := by + simpa only [machineMatchingInnerStep] using machineIfEmpty_mem_FP + machineMatchingInnerRemaining_mem_FP id_mem_FP + machineMatchingInnerProcess_mem_FP + +theorem machineMatchingInnerInit_mem_FP : machineMatchingInnerInit ∈ FP := by + have hrange := machineCompose_mem_FP machineMatchingInnerOptimizer_mem_FP + machineMatchingReverseRange_mem_FP + exact machinePair_mem_FP hrange + (machinePair_mem_FP machineMatchingInnerSelectedInput_mem_FP id_mem_FP) + +theorem machineMatchingInnerWidth_mem_FP : machineMatchingInnerWidth ∈ FP := + machinePair_mem_FP machineMatchingInnerInputBound_mem_FP + (machinePair_mem_FP machineMatchingInnerInputBound_mem_FP + machineMatchingInnerInputBound_mem_FP) + +@[simp] theorem machineMatchingInnerRemaining_pack (remaining selected source) : + machineMatchingInnerRemaining + (machineMatchingInnerPack remaining selected source) = remaining := by + simp [machineMatchingInnerRemaining, machineMatchingInnerPack] + +@[simp] theorem machineMatchingInnerSelected_pack (remaining selected source) : + machineMatchingInnerSelected + (machineMatchingInnerPack remaining selected source) = selected := by + simp [machineMatchingInnerSelected, machineMatchingInnerPack] + +@[simp] theorem machineMatchingInnerSource_pack (remaining selected source) : + machineMatchingInnerSource + (machineMatchingInnerPack remaining selected source) = source := by + simp [machineMatchingInnerSource, machineMatchingInnerPack] + +def MachineMatchingInnerStateBound (word state : List Bool) : Prop := + let B := (machineMatchingInnerInputBound word).length + state = machineMatchingInnerPack (machineMatchingInnerRemaining state) + (machineMatchingInnerSelected state) (machineMatchingInnerSource state) ∧ + (machineMatchingInnerRemaining state).length ≤ B ∧ + (machineMatchingInnerSelected state).length ≤ B ∧ + machineMatchingInnerSource state = word + +theorem machineMatchingInner_base_le_bound (word : List Bool) : + (pair word (machineMatchingReverseRange + (machineMatchingInnerOptimizer word))).length ≤ + (machineMatchingInnerInputBound word).length := by + simp only [machineMatchingInnerInputBound, machineBinaryMulWidth, + List.length_replicate, List.length_append] + nlinarith + +theorem machineMatchingInner_word_le_bound (word : List Bool) : + word.length ≤ (machineMatchingInnerInputBound word).length := by + simpa only [machinePairFirst_pair] using (machinePairFirst_length_le + (pair word (machineMatchingReverseRange + (machineMatchingInnerOptimizer word)))).trans + (machineMatchingInner_base_le_bound word) + +theorem machineMatchingInner_range_le_bound (word : List Bool) : + (machineMatchingReverseRange + (machineMatchingInnerOptimizer word)).length ≤ + (machineMatchingInnerInputBound word).length := by + simpa only [machinePairSecond_pair] using (machinePairSecond_length_le + (pair word (machineMatchingReverseRange + (machineMatchingInnerOptimizer word)))).trans + (machineMatchingInner_base_le_bound word) + +theorem machineMatchingInner_selectedInput_le_bound (word : List Bool) : + (machineMatchingInnerSelectedInput word).length ≤ + (machineMatchingInnerInputBound word).length := by + exact ((machinePairFirst_length_le (machineMatchingInnerRest word)).trans + (machinePairSecond_length_le word)).trans + (machineMatchingInner_word_le_bound word) + +theorem machineMatchingInnerInit_bound (word : List Bool) : + MachineMatchingInnerStateBound word (machineMatchingInnerInit word) := by + simp only [MachineMatchingInnerStateBound, machineMatchingInnerInit, + machineMatchingInnerRemaining_pack, machineMatchingInnerSelected_pack, + machineMatchingInnerSource_pack] + exact ⟨trivial, machineMatchingInner_range_le_bound word, + machineMatchingInner_selectedInput_le_bound word, trivial⟩ + +theorem machineMatchingInnerStep_bound {word state : List Bool} + (hstate : MachineMatchingInnerStateBound word state) : + MachineMatchingInnerStateBound word (machineMatchingInnerStep state) := by + rcases hstate with ⟨hpack, hremaining, hselected, hsource⟩ + by_cases hrem : machineMatchingInnerRemaining state = [] + · rw [machineMatchingInnerStep, hrem, machineIfEmpty_nil] + exact ⟨hpack, hremaining, hselected, hsource⟩ + · rw [machineMatchingInnerStep] + cases hcode : machineMatchingInnerRemaining state with + | nil => exact False.elim (hrem hcode) + | cons bit tail => + rw [machineIfEmpty_cons, machineMatchingInnerProcess] + simp only [MachineMatchingInnerStateBound, + machineMatchingInnerRemaining_pack, machineMatchingInnerSelected_pack, + machineMatchingInnerSource_pack] + refine ⟨trivial, ?_, ?_, hsource⟩ + · exact (machinePairSecond_length_le + (machineMatchingInnerRemaining state)).trans hremaining + · rw [machineMatchingInnerNextSelected] + cases hs : machineMatchingInnerSelectBit state with + | nil => + simpa [machineIfHead, Cobham.selectHead] using hselected + | cons select rest => + cases select with + | false => + simpa using hselected + | true => + simp only [machineIfHead_true, + machineMatchingInnerSelectedCandidateClamped, + List.length_take] + rw [machineMatchingInnerBound, hsource] + exact Nat.min_le_left _ _ + +theorem machineMatchingInnerIterate_bound (word : List Bool) : ∀ k, + MachineMatchingInnerStateBound word + ((machineMatchingInnerStep)^[k] (machineMatchingInnerInit word)) := by + intro k + induction k with + | zero => exact machineMatchingInnerInit_bound word + | succ k ih => + rw [Function.iterate_succ_apply'] + exact machineMatchingInnerStep_bound ih + +theorem machineMatchingInnerIterate_length_le_width + (word : List Bool) (iterations : ℕ) + (_ : iterations ≤ (machineMatchingDimensionRuler + (machineMatchingInnerOptimizer word)).length) : + ((machineMatchingInnerStep)^[iterations] + (machineMatchingInnerInit word)).length ≤ + (machineMatchingInnerWidth word).length := by + rcases machineMatchingInnerIterate_bound word iterations with + ⟨hpack, hremaining, hselected, hsource⟩ + have hsourceLength : (machineMatchingInnerSource + ((machineMatchingInnerStep)^[iterations] + (machineMatchingInnerInit word))).length ≤ + (machineMatchingInnerInputBound word).length := by + rw [hsource] + exact machineMatchingInner_word_le_bound word + rw [hpack] + simp only [machineMatchingInnerPack, machineMatchingInnerWidth, pair_length] + omega + +theorem machineMatchingInnerFinalState_mem_FP : + machineMatchingInnerFinalState ∈ FP := by + have hruler := machineCompose_mem_FP machineMatchingInnerOptimizer_mem_FP + machineMatchingDimensionRuler_mem_FP + exact Cobham.iterate_mem_FP machineMatchingInnerStep_mem_FP + machineMatchingInnerInit_mem_FP hruler machineMatchingInnerWidth_mem_FP + machineMatchingInnerIterate_length_le_width + +theorem machineMatchingInnerOutputSelected_mem_FP : + machineMatchingInnerOutputSelected ∈ FP := by + simpa only [machineMatchingInnerOutputSelected] using machineCompose_mem_FP + machineMatchingInnerFinalState_mem_FP machineMatchingInnerSelected_mem_FP + +/-! ## Canonical one-step facts -/ + +def matchingInnerMachineInput {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℚ) + (i : Fin n) (selected : List (Fin n × Fin n)) : List Bool := + pair (finUnaryCode i) + (pair (binaryListCode orderedRowPairCode selected) + (rationalOptimizerOutputCode ⟨X, R, C⟩)) + +@[simp] theorem machineMatchingInnerOptimizer_matchingInput {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℚ) + (i : Fin n) (selected : List (Fin n × Fin n)) : + machineMatchingInnerOptimizer + (matchingInnerMachineInput X R C i selected) = + rationalOptimizerOutputCode ⟨X, R, C⟩ := by + simp [machineMatchingInnerOptimizer, machineMatchingInnerRest, + matchingInnerMachineInput] + +@[simp] theorem machineMatchingInnerSelectedInput_matchingInput {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℚ) + (i : Fin n) (selected : List (Fin n × Fin n)) : + machineMatchingInnerSelectedInput + (matchingInnerMachineInput X R C i selected) = + binaryListCode orderedRowPairCode selected := by + simp [machineMatchingInnerSelectedInput, machineMatchingInnerRest, + matchingInnerMachineInput] + +@[simp] theorem machineMatchingInnerFirstRow_canonical {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℚ) + (i : Fin n) (sourceSelected : List (Fin n × Fin n)) + (remaining stateSelected : List Bool) : + machineMatchingInnerFirstRow (machineMatchingInnerSource + (machineMatchingInnerPack remaining + stateSelected + (matchingInnerMachineInput X R C i sourceSelected))) = + finUnaryCode i := by + simp [machineMatchingInnerFirstRow, machineMatchingInnerSource, + machineMatchingInnerPack, matchingInnerMachineInput] + +@[simp] theorem machineMatchingInnerOptimizer_canonical {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℚ) + (i : Fin n) (sourceSelected : List (Fin n × Fin n)) + (remaining stateSelected : List Bool) : + machineMatchingInnerOptimizer (machineMatchingInnerSource + (machineMatchingInnerPack remaining + stateSelected + (matchingInnerMachineInput X R C i sourceSelected))) = + rationalOptimizerOutputCode ⟨X, R, C⟩ := by + simp [machineMatchingInnerOptimizer, machineMatchingInnerRest, + machineMatchingInnerSource, machineMatchingInnerPack, + matchingInnerMachineInput] + +@[simp] theorem machineMatchingInnerCurrentSecondRow_canonical {n : ℕ} + (j : Fin n) (js : List (Fin n)) (selected source : List Bool) : + machineMatchingInnerCurrentSecondRow + (machineMatchingInnerPack (binaryListCode finUnaryCode (j :: js)) + selected source) = finUnaryCode j := by + simp [machineMatchingInnerCurrentSecondRow, + machineMatchingInnerRemaining, machineMatchingInnerPack] + +@[simp] theorem machineMatchingInnerSelected_canonical {n : ℕ} + (j : Fin n) (js : List (Fin n)) + (selected : List (Fin n × Fin n)) (source : List Bool) : + machineMatchingInnerSelected + (machineMatchingInnerPack (binaryListCode finUnaryCode (j :: js)) + (binaryListCode orderedRowPairCode selected) source) = + binaryListCode orderedRowPairCode selected := by + simp [machineMatchingInnerSelected, machineMatchingInnerPack] + +@[simp] theorem machineMatchingInnerFirstLessSecondBit_encode {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℚ) + (i j : Fin n) (sourceSelected selected : List (Fin n × Fin n)) + (js : List (Fin n)) : + machineMatchingInnerFirstLessSecondBit + (machineMatchingInnerPack (binaryListCode finUnaryCode (j :: js)) + (binaryListCode orderedRowPairCode selected) + (matchingInnerMachineInput X R C i sourceSelected)) = + [decide (i < j)] := by + rw [machineMatchingInnerFirstLessSecondBit] + simp only [machineMatchingInnerFirstRow_canonical, + machineMatchingInnerCurrentSecondRow_canonical, + machineLengthBits_encode, finUnaryCode, List.length_replicate] + exact machineBinaryNatLtBit_pair_natBits i.val j.val + +@[simp] theorem machineMatchingInnerEligibilityInput_encode {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℚ) + (i j : Fin n) (sourceSelected selected : List (Fin n × Fin n)) + (js : List (Fin n)) : + machineMatchingInnerEligibilityInput + (machineMatchingInnerPack (binaryListCode finUnaryCode (j :: js)) + (binaryListCode orderedRowPairCode selected) + (matchingInnerMachineInput X R C i sourceSelected)) = + certifiedRowPairMachineInput X R C i j := by + simp only [machineMatchingInnerEligibilityInput, + machineMatchingInnerFirstRow_canonical, + machineMatchingInnerCurrentSecondRow_canonical, + machineMatchingInnerOptimizer_canonical, + certifiedRowPairMachineInput] + +@[simp] theorem machineMatchingInnerEligibleBit_encode {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℚ) + (i j : Fin n) (sourceSelected selected : List (Fin n × Fin n)) + (js : List (Fin n)) + (hij : i < j) : + machineMatchingInnerEligibleBit + (machineMatchingInnerPack (binaryListCode finUnaryCode (j :: js)) + (binaryListCode orderedRowPairCode selected) + (matchingInnerMachineInput X R C i sourceSelected)) = + [decide (HasCertifiedCorePair (explicitRegularizationScale n) X + explicitKappa (directedPairCostPrecision n) + (rowPairOfLT i j hij))] := by + rw [machineMatchingInnerEligibleBit, + machineMatchingInnerEligibilityInput_encode] + have hinput : certifiedRowPairMachineInput X R C i j = + certifiedRowPairEligibilityMachineInput X R C + (rowPairOfLT i j hij) := by + simp [certifiedRowPairEligibilityMachineInput, + rowPairRow_rowPairOfLT_zero, rowPairRow_rowPairOfLT_one] + rw [hinput, machineCertifiedRowPairEligibilityBit_encode] + +@[simp] theorem machineMatchingInnerDisjointInput_encode {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℚ) + (i j : Fin n) (sourceSelected selected : List (Fin n × Fin n)) + (js : List (Fin n)) : + machineMatchingInnerDisjointInput + (machineMatchingInnerPack (binaryListCode finUnaryCode (j :: js)) + (binaryListCode orderedRowPairCode selected) + (matchingInnerMachineInput X R C i sourceSelected)) = + machineDisjointInput i j selected := by + simp only [machineMatchingInnerDisjointInput, + machineMatchingInnerFirstRow_canonical, + machineMatchingInnerCurrentSecondRow_canonical, + machineMatchingInnerSelected_canonical, machineDisjointInput] + +@[simp] theorem machineMatchingInnerDisjointBit_encode {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℚ) + (i j : Fin n) (sourceSelected selected : List (Fin n × Fin n)) + (js : List (Fin n)) : + machineMatchingInnerDisjointBit + (machineMatchingInnerPack (binaryListCode finUnaryCode (j :: js)) + (binaryListCode orderedRowPairCode selected) + (matchingInnerMachineInput X R C i sourceSelected)) = + [!orderedPairsConflict i j selected] := by + rw [machineMatchingInnerDisjointBit, + machineMatchingInnerDisjointInput_encode] + exact machineRowPairDisjointBit_encode i j selected + +/-! ## Pure semantics of one inner pass -/ + +/-- The mathematical update performed on one ordered candidate. The first +test fixes the canonical orientation, the second is the certified four-core +test, and the third says that neither endpoint has already been selected. -/ +def certifiedGreedyOrderedStep {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) (i : Fin n) + (selected : List (Fin n × Fin n)) (j : Fin n) : + List (Fin n × Fin n) := + if hij : i < j then + if HasCertifiedCorePair (explicitRegularizationScale n) X explicitKappa + (directedPairCostPrecision n) (rowPairOfLT i j hij) ∧ + orderedPairsConflict i j selected = false then + (i, j) :: selected + else selected + else selected + +@[simp] theorem machineMatchingInnerSelectBit_encode {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℚ) + (i j : Fin n) (sourceSelected selected : List (Fin n × Fin n)) + (js : List (Fin n)) : + machineMatchingInnerSelectBit + (machineMatchingInnerPack (binaryListCode finUnaryCode (j :: js)) + (binaryListCode orderedRowPairCode selected) + (matchingInnerMachineInput X R C i sourceSelected)) = + [if hij : i < j then + decide (HasCertifiedCorePair (explicitRegularizationScale n) X + explicitKappa (directedPairCostPrecision n) + (rowPairOfLT i j hij) ∧ + orderedPairsConflict i j selected = false) + else false] := by + by_cases hij : i < j + · rw [machineMatchingInnerSelectBit, + machineMatchingInnerFirstLessSecondBit_encode, + machineMatchingInnerEligibleBit_encode X R C i j sourceSelected + selected js hij, + machineMatchingInnerDisjointBit_encode, + machineAndBit_one, machineAndBit_one] + simp [hij] + · rw [machineMatchingInnerSelectBit, + machineMatchingInnerFirstLessSecondBit_encode] + simp [hij, machineAndBit, machineIfHead, Cobham.selectHead] + +theorem orderedRowPairCode_length_lt_three_mul {n : ℕ} + (i j : Fin n) : + (orderedRowPairCode (i, j)).length < 3 * n := by + simp only [orderedRowPairCode, pair_length, finUnaryCode, + List.length_replicate] + omega + +theorem binaryListCode_ordered_cons_length_le {n : ℕ} + (i j : Fin n) (selected : List (Fin n × Fin n)) : + (binaryListCode orderedRowPairCode ((i, j) :: selected)).length ≤ + (binaryListCode orderedRowPairCode selected).length + 6 * n := by + rw [binaryListCode, pair_length] + have h := orderedRowPairCode_length_lt_three_mul i j + omega + +/-- Fold the one-candidate update over a list of possible second rows. -/ +def certifiedGreedyOrderedScan {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) (i : Fin n) + (selected : List (Fin n × Fin n)) (js : List (Fin n)) : + List (Fin n × Fin n) := + js.foldl (certifiedGreedyOrderedStep X i) selected + +theorem certifiedGreedyOrderedScan_code_length_le {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) (i : Fin n) + (selected : List (Fin n × Fin n)) (js : List (Fin n)) : + (binaryListCode orderedRowPairCode + (certifiedGreedyOrderedScan X i selected js)).length ≤ + (binaryListCode orderedRowPairCode selected).length + + js.length * (6 * n) := by + induction js generalizing selected with + | nil => simp [certifiedGreedyOrderedScan] + | cons j js ih => + rw [certifiedGreedyOrderedScan, List.foldl_cons] + change (binaryListCode orderedRowPairCode + (certifiedGreedyOrderedScan X i + (certifiedGreedyOrderedStep X i selected j) js)).length ≤ _ + have htail := ih (certifiedGreedyOrderedStep X i selected j) + have hstep : (binaryListCode orderedRowPairCode + (certifiedGreedyOrderedStep X i selected j)).length ≤ + (binaryListCode orderedRowPairCode selected).length + 6 * n := by + simp only [certifiedGreedyOrderedStep] + split_ifs + · exact binaryListCode_ordered_cons_length_le i j selected + · omega + · omega + simp only [List.length_cons] + calc + _ ≤ (binaryListCode orderedRowPairCode + (certifiedGreedyOrderedStep X i selected j)).length + + js.length * (6 * n) := htail + _ ≤ ((binaryListCode orderedRowPairCode selected).length + 6 * n) + + js.length * (6 * n) := Nat.add_le_add_right hstep _ + _ = (binaryListCode orderedRowPairCode selected).length + + (js.length + 1) * (6 * n) := by ring + +@[simp] theorem machineMatchingInnerSelectedCandidate_encode {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℚ) + (i j : Fin n) (sourceSelected selected : List (Fin n × Fin n)) + (js : List (Fin n)) : + machineMatchingInnerSelectedCandidate + (machineMatchingInnerPack (binaryListCode finUnaryCode (j :: js)) + (binaryListCode orderedRowPairCode selected) + (matchingInnerMachineInput X R C i sourceSelected)) = + binaryListCode orderedRowPairCode ((i, j) :: selected) := by + rw [machineMatchingInnerSelectedCandidate, + machineMatchingInnerFirstRow_canonical, + machineMatchingInnerCurrentSecondRow_canonical, + machineMatchingInnerSelected_canonical] + rfl + +/-- The quadratic-of-quadratic clamp is inactive throughout a canonical inner +pass. The hypothesis allows at most `n` preceding insertions, each of encoded +length at most `6n`; this is the only size invariant used by the semantic +proof. -/ +theorem canonical_inner_candidate_length_le_bound {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℚ) + (i j : Fin n) (sourceSelected selected : List (Fin n × Fin n)) + (hselected : (binaryListCode orderedRowPairCode selected).length ≤ + (binaryListCode orderedRowPairCode sourceSelected).length + + n * (6 * n)) : + (binaryListCode orderedRowPairCode ((i, j) :: selected)).length ≤ + (machineMatchingInnerInputBound + (matchingInnerMachineInput X R C i sourceSelected)).length := by + let source := matchingInnerMachineInput X R C i sourceSelected + let range := machineMatchingReverseRange + (machineMatchingInnerOptimizer source) + let base := pair source range + let P := base.length + have hinitialSource : + (binaryListCode orderedRowPairCode sourceSelected).length ≤ + source.length := by + dsimp only [source, matchingInnerMachineInput] + simp only [pair_length] + omega + have hsourceP : source.length ≤ P := by + simpa only [P, base, machinePairFirst_pair] using + machinePairFirst_length_le base + have hrangeP : range.length ≤ P := by + simpa only [P, base, machinePairSecond_pair] using + machinePairSecond_length_le base + have hnrange : n ≤ range.length := by + have hop : machineMatchingInnerOptimizer source = + rationalOptimizerOutputCode ⟨X, R, C⟩ := by + simp [source, matchingInnerMachineInput, + machineMatchingInnerOptimizer, machineMatchingInnerRest] + dsimp only [range] + rw [hop, machineMatchingReverseRange_encode] + simpa using binaryListCode_listLength_le finUnaryCode + (List.finRange n).reverse + have hnP : n ≤ P := hnrange.trans hrangeP + have hinitialP : + (binaryListCode orderedRowPairCode sourceSelected).length ≤ P := + hinitialSource.trans hsourceP + have hcandidate := binaryListCode_ordered_cons_length_le i j selected + have hnpos : 0 < n := by + have := i.isLt + omega + have hPpos : 0 < P := lt_of_lt_of_le hnpos hnP + have hcoarse : + (binaryListCode orderedRowPairCode ((i, j) :: selected)).length ≤ + 6 * P * P + 7 * P := by + calc + _ ≤ (binaryListCode orderedRowPairCode selected).length + 6 * n := + hcandidate + _ ≤ ((binaryListCode orderedRowPairCode sourceSelected).length + + n * (6 * n)) + 6 * n := Nat.add_le_add_right hselected _ + _ ≤ (P + P * (6 * P)) + 6 * P := by + exact Nat.add_le_add + (Nat.add_le_add hinitialP + (Nat.mul_le_mul hnP (Nat.mul_le_mul_left 6 hnP))) + (Nat.mul_le_mul_left 6 hnP) + _ = 6 * P * P + 7 * P := by ring + change (binaryListCode orderedRowPairCode ((i, j) :: selected)).length ≤ + (machineBinaryMulWidth (machineBinaryMulWidth base)).length + simp only [machineBinaryMulWidth, List.length_replicate, + List.length_append] + let W := (16 + P) * (16 + P) + have hPone : 1 ≤ P := hPpos + have hfirst : 6 * P * P + 7 * P ≤ 13 * P * P := by + nlinarith + have hPW : P * P ≤ W := by + dsimp only [W] + nlinarith + have hsecond : 13 * P * P ≤ 16 * W := by + nlinarith + have hthird : 16 * W ≤ (16 + W) * (16 + W) := by + nlinarith + exact hcoarse.trans (hfirst.trans (hsecond.trans hthird)) + +theorem machineMatchingInnerNextSelected_encode {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℚ) + (i j : Fin n) (sourceSelected selected : List (Fin n × Fin n)) + (js : List (Fin n)) + (hcandidate : + (binaryListCode orderedRowPairCode ((i, j) :: selected)).length ≤ + (machineMatchingInnerInputBound + (matchingInnerMachineInput X R C i sourceSelected)).length) : + machineMatchingInnerNextSelected + (machineMatchingInnerPack (binaryListCode finUnaryCode (j :: js)) + (binaryListCode orderedRowPairCode selected) + (matchingInnerMachineInput X R C i sourceSelected)) = + binaryListCode orderedRowPairCode + (certifiedGreedyOrderedStep X i selected j) := by + rw [machineMatchingInnerNextSelected, + machineMatchingInnerSelectBit_encode] + by_cases hij : i < j + · by_cases haccept : + HasCertifiedCorePair (explicitRegularizationScale n) X explicitKappa + (directedPairCostPrecision n) (rowPairOfLT i j hij) ∧ + orderedPairsConflict i j selected = false + · have hclamp : machineMatchingInnerSelectedCandidateClamped + (machineMatchingInnerPack (binaryListCode finUnaryCode (j :: js)) + (binaryListCode orderedRowPairCode selected) + (matchingInnerMachineInput X R C i sourceSelected)) = + binaryListCode orderedRowPairCode ((i, j) :: selected) := by + rw [machineMatchingInnerSelectedCandidateClamped, + machineMatchingInnerSelectedCandidate_encode, + machineMatchingInnerBound, + machineMatchingInnerSource_pack, + (List.take_eq_self_iff _).2 hcandidate] + rw [hclamp] + simp [certifiedGreedyOrderedStep, hij, haccept] + · simp [certifiedGreedyOrderedStep, hij, haccept] + · simp only [dif_neg hij, machineIfHead_false, + certifiedGreedyOrderedStep, machineMatchingInnerSelected_pack] + +theorem certifiedGreedyOrderedScan_take_succ {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) (i : Fin n) + (selected : List (Fin n × Fin n)) (js : List (Fin n)) + (k : ℕ) (hk : k < js.length) : + certifiedGreedyOrderedScan X i selected (js.take (k + 1)) = + certifiedGreedyOrderedStep X i + (certifiedGreedyOrderedScan X i selected (js.take k)) js[k] := by + have htake : js.take (k + 1) = js.take k ++ [js[k]] := by + simpa only [List.concat_eq_append] using (List.take_concat_get hk).symm + unfold certifiedGreedyOrderedScan + calc + List.foldl (certifiedGreedyOrderedStep X i) selected (js.take (k + 1)) = + List.foldl (certifiedGreedyOrderedStep X i) selected + (js.take k ++ [js[k]]) := congrArg _ htake + _ = _ := by rw [List.foldl_append]; rfl + +/-- Canonical state after consuming the first `k` second-row candidates. -/ +def machineMatchingInnerSemanticState {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℚ) + (i : Fin n) (sourceSelected : List (Fin n × Fin n)) + (js : List (Fin n)) (k : ℕ) : List Bool := + machineMatchingInnerPack + (binaryListCode finUnaryCode (js.drop k)) + (binaryListCode orderedRowPairCode + (certifiedGreedyOrderedScan X i sourceSelected (js.take k))) + (matchingInnerMachineInput X R C i sourceSelected) + +theorem machineMatchingInnerSemanticState_step {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℚ) + (i : Fin n) (sourceSelected : List (Fin n × Fin n)) + (js : List (Fin n)) (hjs : js.length ≤ n) + (k : ℕ) (hk : k < js.length) : + machineMatchingInnerStep + (machineMatchingInnerSemanticState X R C i sourceSelected js k) = + machineMatchingInnerSemanticState X R C i sourceSelected js (k + 1) := by + rw [machineMatchingInnerSemanticState, List.drop_eq_getElem_cons hk, + machineMatchingInnerStep] + simp only [machineMatchingInnerRemaining_pack] + rw [machineIfEmpty_of_ne_nil_matrix _ _ _ + (binaryListCode_cons_ne_nil finUnaryCode js[k] (js.drop (k + 1))), + machineMatchingInnerProcess] + simp only [machineMatchingInnerRemaining_pack, machineListTail_cons, + machineMatchingInnerSource_pack] + let selected := certifiedGreedyOrderedScan X i sourceSelected (js.take k) + have hscan := certifiedGreedyOrderedScan_code_length_le + X i sourceSelected (js.take k) + have htake : (js.take k).length ≤ n := + by rw [List.length_take]; omega + have hselected : + (binaryListCode orderedRowPairCode selected).length ≤ + (binaryListCode orderedRowPairCode sourceSelected).length + + n * (6 * n) := by + dsimp only [selected] + exact hscan.trans (Nat.add_le_add_left + (Nat.mul_le_mul_right (6 * n) htake) _) + have hcandidate := canonical_inner_candidate_length_le_bound + X R C i js[k] sourceSelected selected hselected + rw [machineMatchingInnerNextSelected_encode + X R C i js[k] sourceSelected selected (js.drop (k + 1)) hcandidate] + rw [machineMatchingInnerSemanticState] + apply congrArg (fun chosen : List (Fin n × Fin n) ↦ + machineMatchingInnerPack + (binaryListCode finUnaryCode (js.drop (k + 1))) + (binaryListCode orderedRowPairCode chosen) + (matchingInnerMachineInput X R C i sourceSelected)) + exact (certifiedGreedyOrderedScan_take_succ + X i sourceSelected js k hk).symm + +@[simp] theorem machineMatchingInnerSemanticState_zero {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℚ) + (i : Fin n) (sourceSelected : List (Fin n × Fin n)) : + machineMatchingInnerSemanticState X R C i sourceSelected + (List.finRange n).reverse 0 = + machineMatchingInnerInit + (matchingInnerMachineInput X R C i sourceSelected) := by + simp [machineMatchingInnerSemanticState, machineMatchingInnerInit, + certifiedGreedyOrderedScan, machineMatchingReverseRange_encode] + +theorem machineMatchingInnerIterate_semantics {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℚ) + (i : Fin n) (sourceSelected : List (Fin n × Fin n)) : ∀ k ≤ n, + (machineMatchingInnerStep)^[k] + (machineMatchingInnerInit + (matchingInnerMachineInput X R C i sourceSelected)) = + machineMatchingInnerSemanticState X R C i sourceSelected + (List.finRange n).reverse k := by + intro k hk + induction k with + | zero => exact (machineMatchingInnerSemanticState_zero + X R C i sourceSelected).symm + | succ k ih => + rw [Function.iterate_succ_apply', ih (by omega)] + exact machineMatchingInnerSemanticState_step X R C i sourceSelected + (List.finRange n).reverse (by simp) k (by simp; omega) + +@[simp] theorem machineMatchingInnerOutputSelected_encode {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℚ) + (i : Fin n) (sourceSelected : List (Fin n × Fin n)) : + machineMatchingInnerOutputSelected + (matchingInnerMachineInput X R C i sourceSelected) = + binaryListCode orderedRowPairCode + (certifiedGreedyOrderedScan X i sourceSelected + (List.finRange n).reverse) := by + rw [machineMatchingInnerOutputSelected, + machineMatchingInnerFinalState, + machineMatchingInnerOptimizer_matchingInput, + machineMatchingDimensionRuler_encode, List.length_replicate, + machineMatchingInnerIterate_semantics X R C i sourceSelected n le_rfl] + simp only [machineMatchingInnerSemanticState, + machineMatchingInnerSelected_pack] + rw [(List.take_eq_self_iff _).2 (by simp)] + +/-! ## The outer scan over first rows -/ + +def machineMatchingOuterPack + (remaining selected source : List Bool) : List Bool := + pair remaining (pair selected source) + +def machineMatchingOuterRemaining (state : List Bool) : List Bool := + machinePairFirst state + +def machineMatchingOuterSelected (state : List Bool) : List Bool := + machinePairFirst (machinePairSecond state) + +def machineMatchingOuterSource (state : List Bool) : List Bool := + machinePairSecond (machinePairSecond state) + +def machineMatchingOuterCurrentFirstRow (state : List Bool) : List Bool := + machineListHead (machineMatchingOuterRemaining state) + +def machineMatchingOuterInnerInput (state : List Bool) : List Bool := + pair (machineMatchingOuterCurrentFirstRow state) + (pair (machineMatchingOuterSelected state) + (machineMatchingOuterSource state)) + +def machineMatchingOuterNextSelectedRaw (state : List Bool) : List Bool := + machineMatchingInnerOutputSelected (machineMatchingOuterInnerInput state) + +def machineMatchingOuterInputBound (optimizer : List Bool) : List Bool := + machineBinaryMulWidth (machineBinaryMulWidth (machineBinaryMulWidth + (pair optimizer (machineMatchingReverseRange optimizer)))) + +def machineMatchingOuterBound (state : List Bool) : List Bool := + machineMatchingOuterInputBound (machineMatchingOuterSource state) + +def machineMatchingOuterNextSelected (state : List Bool) : List Bool := + (machineMatchingOuterNextSelectedRaw state).take + (machineMatchingOuterBound state).length + +def machineMatchingOuterProcess (state : List Bool) : List Bool := + machineMatchingOuterPack + (machineListTail (machineMatchingOuterRemaining state)) + (machineMatchingOuterNextSelected state) + (machineMatchingOuterSource state) + +def machineMatchingOuterStep (state : List Bool) : List Bool := + machineIfEmpty (machineMatchingOuterRemaining state) state + (machineMatchingOuterProcess state) + +def machineMatchingOuterInit (optimizer : List Bool) : List Bool := + machineMatchingOuterPack (machineMatchingReverseRange optimizer) [] optimizer + +def machineMatchingOuterWidth (optimizer : List Bool) : List Bool := + let bound := machineMatchingOuterInputBound optimizer + machineMatchingOuterPack bound bound bound + +def machineMatchingOuterFinalState (optimizer : List Bool) : List Bool := + (machineMatchingOuterStep)^[(machineMatchingDimensionRuler optimizer).length] + (machineMatchingOuterInit optimizer) + +/-- Encoded selected ordered row pairs produced by the complete matcher. -/ +def machineGreedyMatchingSelected (optimizer : List Bool) : List Bool := + machineMatchingOuterSelected (machineMatchingOuterFinalState optimizer) + +theorem machineMatchingOuterRemaining_mem_FP : + machineMatchingOuterRemaining ∈ FP := machinePairFirst_mem_FP + +theorem machineMatchingOuterSelected_mem_FP : + machineMatchingOuterSelected ∈ FP := by + simpa only [machineMatchingOuterSelected] using machineCompose_mem_FP + machinePairSecond_mem_FP machinePairFirst_mem_FP + +theorem machineMatchingOuterSource_mem_FP : + machineMatchingOuterSource ∈ FP := by + simpa only [machineMatchingOuterSource] using machineCompose_mem_FP + machinePairSecond_mem_FP machinePairSecond_mem_FP + +theorem machineMatchingOuterCurrentFirstRow_mem_FP : + machineMatchingOuterCurrentFirstRow ∈ FP := by + simpa only [machineMatchingOuterCurrentFirstRow] using machineCompose_mem_FP + machineMatchingOuterRemaining_mem_FP machineListHead_mem_FP + +theorem machineMatchingOuterInnerInput_mem_FP : + machineMatchingOuterInnerInput ∈ FP := + machinePair_mem_FP machineMatchingOuterCurrentFirstRow_mem_FP + (machinePair_mem_FP machineMatchingOuterSelected_mem_FP + machineMatchingOuterSource_mem_FP) + +theorem machineMatchingOuterNextSelectedRaw_mem_FP : + machineMatchingOuterNextSelectedRaw ∈ FP := by + simpa only [machineMatchingOuterNextSelectedRaw] using machineCompose_mem_FP + machineMatchingOuterInnerInput_mem_FP + machineMatchingInnerOutputSelected_mem_FP + +theorem machineMatchingOuterInputBound_mem_FP : + machineMatchingOuterInputBound ∈ FP := by + have hrange := machineCompose_mem_FP id_mem_FP + machineMatchingReverseRange_mem_FP + have hbase := machinePair_mem_FP id_mem_FP hrange + have h1 := machineCompose_mem_FP hbase machineBinaryMulWidth_mem_FP + have h2 := machineCompose_mem_FP h1 machineBinaryMulWidth_mem_FP + simpa only [machineMatchingOuterInputBound] using + machineCompose_mem_FP h2 machineBinaryMulWidth_mem_FP + +theorem machineMatchingOuterBound_mem_FP : + machineMatchingOuterBound ∈ FP := by + simpa only [machineMatchingOuterBound] using machineCompose_mem_FP + machineMatchingOuterSource_mem_FP machineMatchingOuterInputBound_mem_FP + +theorem machineMatchingOuterNextSelected_mem_FP : + machineMatchingOuterNextSelected ∈ FP := by + simpa only [machineMatchingOuterNextSelected] using + machineTake_mem_FP machineMatchingOuterBound_mem_FP + machineMatchingOuterNextSelectedRaw_mem_FP + +theorem machineMatchingOuterProcess_mem_FP : + machineMatchingOuterProcess ∈ FP := by + have htail := machineCompose_mem_FP machineMatchingOuterRemaining_mem_FP + machineListTail_mem_FP + exact machinePair_mem_FP htail + (machinePair_mem_FP machineMatchingOuterNextSelected_mem_FP + machineMatchingOuterSource_mem_FP) + +theorem machineMatchingOuterStep_mem_FP : + machineMatchingOuterStep ∈ FP := by + simpa only [machineMatchingOuterStep] using machineIfEmpty_mem_FP + machineMatchingOuterRemaining_mem_FP id_mem_FP + machineMatchingOuterProcess_mem_FP + +theorem machineMatchingOuterInit_mem_FP : + machineMatchingOuterInit ∈ FP := + machinePair_mem_FP machineMatchingReverseRange_mem_FP + (machinePair_mem_FP (machineConst_mem_FP []) id_mem_FP) + +theorem machineMatchingOuterWidth_mem_FP : + machineMatchingOuterWidth ∈ FP := + machinePair_mem_FP machineMatchingOuterInputBound_mem_FP + (machinePair_mem_FP machineMatchingOuterInputBound_mem_FP + machineMatchingOuterInputBound_mem_FP) + +@[simp] theorem machineMatchingOuterRemaining_pack (remaining selected source) : + machineMatchingOuterRemaining + (machineMatchingOuterPack remaining selected source) = remaining := by + simp [machineMatchingOuterRemaining, machineMatchingOuterPack] + +@[simp] theorem machineMatchingOuterSelected_pack (remaining selected source) : + machineMatchingOuterSelected + (machineMatchingOuterPack remaining selected source) = selected := by + simp [machineMatchingOuterSelected, machineMatchingOuterPack] + +@[simp] theorem machineMatchingOuterSource_pack (remaining selected source) : + machineMatchingOuterSource + (machineMatchingOuterPack remaining selected source) = source := by + simp [machineMatchingOuterSource, machineMatchingOuterPack] + +def MachineMatchingOuterStateBound (optimizer state : List Bool) : Prop := + let B := (machineMatchingOuterInputBound optimizer).length + state = machineMatchingOuterPack (machineMatchingOuterRemaining state) + (machineMatchingOuterSelected state) (machineMatchingOuterSource state) ∧ + (machineMatchingOuterRemaining state).length ≤ B ∧ + (machineMatchingOuterSelected state).length ≤ B ∧ + machineMatchingOuterSource state = optimizer + +theorem machineMatchingOuter_base_le_bound (optimizer : List Bool) : + (pair optimizer (machineMatchingReverseRange optimizer)).length ≤ + (machineMatchingOuterInputBound optimizer).length := by + simp only [machineMatchingOuterInputBound, machineBinaryMulWidth, + List.length_replicate, List.length_append] + nlinarith + +theorem machineMatchingOuter_optimizer_le_bound (optimizer : List Bool) : + optimizer.length ≤ (machineMatchingOuterInputBound optimizer).length := by + simpa only [machinePairFirst_pair] using + (machinePairFirst_length_le + (pair optimizer (machineMatchingReverseRange optimizer))).trans + (machineMatchingOuter_base_le_bound optimizer) + +theorem machineMatchingOuter_range_le_bound (optimizer : List Bool) : + (machineMatchingReverseRange optimizer).length ≤ + (machineMatchingOuterInputBound optimizer).length := by + simpa only [machinePairSecond_pair] using + (machinePairSecond_length_le + (pair optimizer (machineMatchingReverseRange optimizer))).trans + (machineMatchingOuter_base_le_bound optimizer) + +theorem machineMatchingOuterInit_bound (optimizer : List Bool) : + MachineMatchingOuterStateBound optimizer + (machineMatchingOuterInit optimizer) := by + simp only [MachineMatchingOuterStateBound, machineMatchingOuterInit, + machineMatchingOuterRemaining_pack, machineMatchingOuterSelected_pack, + machineMatchingOuterSource_pack, List.length_nil] + exact ⟨trivial, machineMatchingOuter_range_le_bound optimizer, + Nat.zero_le _, trivial⟩ + +theorem machineMatchingOuterStep_bound {optimizer state : List Bool} + (hstate : MachineMatchingOuterStateBound optimizer state) : + MachineMatchingOuterStateBound optimizer + (machineMatchingOuterStep state) := by + rcases hstate with ⟨hpack, hremaining, hselected, hsource⟩ + by_cases hrem : machineMatchingOuterRemaining state = [] + · rw [machineMatchingOuterStep, hrem, machineIfEmpty_nil] + exact ⟨hpack, hremaining, hselected, hsource⟩ + · rw [machineMatchingOuterStep] + cases hcode : machineMatchingOuterRemaining state with + | nil => exact False.elim (hrem hcode) + | cons bit tail => + rw [machineIfEmpty_cons, machineMatchingOuterProcess] + simp only [MachineMatchingOuterStateBound, + machineMatchingOuterRemaining_pack, + machineMatchingOuterSelected_pack, + machineMatchingOuterSource_pack] + refine ⟨trivial, ?_, ?_, hsource⟩ + · exact (machinePairSecond_length_le + (machineMatchingOuterRemaining state)).trans hremaining + · simp only [machineMatchingOuterNextSelected, + List.length_take, machineMatchingOuterBound, hsource] + exact Nat.min_le_left _ _ + +theorem machineMatchingOuterIterate_bound (optimizer : List Bool) : ∀ k, + MachineMatchingOuterStateBound optimizer + ((machineMatchingOuterStep)^[k] + (machineMatchingOuterInit optimizer)) := by + intro k + induction k with + | zero => exact machineMatchingOuterInit_bound optimizer + | succ k ih => + rw [Function.iterate_succ_apply'] + exact machineMatchingOuterStep_bound ih + +theorem machineMatchingOuterIterate_length_le_width + (optimizer : List Bool) (iterations : ℕ) + (_ : iterations ≤ (machineMatchingDimensionRuler optimizer).length) : + ((machineMatchingOuterStep)^[iterations] + (machineMatchingOuterInit optimizer)).length ≤ + (machineMatchingOuterWidth optimizer).length := by + rcases machineMatchingOuterIterate_bound optimizer iterations with + ⟨hpack, hremaining, hselected, hsource⟩ + have hsourceLength : (machineMatchingOuterSource + ((machineMatchingOuterStep)^[iterations] + (machineMatchingOuterInit optimizer))).length ≤ + (machineMatchingOuterInputBound optimizer).length := by + rw [hsource] + exact machineMatchingOuter_optimizer_le_bound optimizer + rw [hpack] + simp only [machineMatchingOuterPack, machineMatchingOuterWidth, pair_length] + omega + +theorem machineMatchingOuterFinalState_mem_FP : + machineMatchingOuterFinalState ∈ FP := by + exact Cobham.iterate_mem_FP machineMatchingOuterStep_mem_FP + machineMatchingOuterInit_mem_FP machineMatchingDimensionRuler_mem_FP + machineMatchingOuterWidth_mem_FP + machineMatchingOuterIterate_length_le_width + +theorem machineGreedyMatchingSelected_mem_FP : + machineGreedyMatchingSelected ∈ FP := by + simpa only [machineGreedyMatchingSelected] using machineCompose_mem_FP + machineMatchingOuterFinalState_mem_FP + machineMatchingOuterSelected_mem_FP + +/-! ## Exact outer-scan semantics -/ + +def certifiedGreedyOuterStep {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) + (selected : List (Fin n × Fin n)) (i : Fin n) : + List (Fin n × Fin n) := + certifiedGreedyOrderedScan X i selected (List.finRange n).reverse + +def certifiedGreedyOuterScan {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) + (selected : List (Fin n × Fin n)) (is : List (Fin n)) : + List (Fin n × Fin n) := + is.foldl (certifiedGreedyOuterStep X) selected + +theorem certifiedGreedyOuterStep_code_length_le {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) + (selected : List (Fin n × Fin n)) (i : Fin n) : + (binaryListCode orderedRowPairCode + (certifiedGreedyOuterStep X selected i)).length ≤ + (binaryListCode orderedRowPairCode selected).length + n * (6 * n) := by + simpa [certifiedGreedyOuterStep] using + certifiedGreedyOrderedScan_code_length_le X i selected + (List.finRange n).reverse + +theorem certifiedGreedyOuterScan_code_length_le {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) + (selected : List (Fin n × Fin n)) (is : List (Fin n)) : + (binaryListCode orderedRowPairCode + (certifiedGreedyOuterScan X selected is)).length ≤ + (binaryListCode orderedRowPairCode selected).length + + is.length * (n * (6 * n)) := by + induction is generalizing selected with + | nil => simp [certifiedGreedyOuterScan] + | cons i is ih => + rw [certifiedGreedyOuterScan, List.foldl_cons] + change (binaryListCode orderedRowPairCode + (certifiedGreedyOuterScan X + (certifiedGreedyOuterStep X selected i) is)).length ≤ _ + have htail := ih (certifiedGreedyOuterStep X selected i) + have hstep := certifiedGreedyOuterStep_code_length_le X selected i + simp only [List.length_cons] + calc + _ ≤ (binaryListCode orderedRowPairCode + (certifiedGreedyOuterStep X selected i)).length + + is.length * (n * (6 * n)) := htail + _ ≤ ((binaryListCode orderedRowPairCode selected).length + + n * (6 * n)) + is.length * (n * (6 * n)) := + Nat.add_le_add_right hstep _ + _ = (binaryListCode orderedRowPairCode selected).length + + (is.length + 1) * (n * (6 * n)) := by ring + +@[simp] theorem machineMatchingOuterInnerInput_encode {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℚ) + (i : Fin n) (is : List (Fin n)) + (selected : List (Fin n × Fin n)) : + machineMatchingOuterInnerInput + (machineMatchingOuterPack (binaryListCode finUnaryCode (i :: is)) + (binaryListCode orderedRowPairCode selected) + (rationalOptimizerOutputCode ⟨X, R, C⟩)) = + matchingInnerMachineInput X R C i selected := by + simp [machineMatchingOuterInnerInput, + machineMatchingOuterCurrentFirstRow, + machineMatchingOuterRemaining, machineMatchingOuterSelected, + machineMatchingOuterSource, machineMatchingOuterPack, + matchingInnerMachineInput] + +@[simp] theorem machineMatchingOuterNextSelectedRaw_encode {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℚ) + (i : Fin n) (is : List (Fin n)) + (selected : List (Fin n × Fin n)) : + machineMatchingOuterNextSelectedRaw + (machineMatchingOuterPack (binaryListCode finUnaryCode (i :: is)) + (binaryListCode orderedRowPairCode selected) + (rationalOptimizerOutputCode ⟨X, R, C⟩)) = + binaryListCode orderedRowPairCode + (certifiedGreedyOuterStep X selected i) := by + rw [machineMatchingOuterNextSelectedRaw, + machineMatchingOuterInnerInput_encode, + machineMatchingInnerOutputSelected_encode] + rfl + +theorem canonical_outer_selected_length_le_bound {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℚ) + (selected : List (Fin n × Fin n)) + (hselected : (binaryListCode orderedRowPairCode selected).length ≤ + n * (n * (6 * n))) : + (binaryListCode orderedRowPairCode selected).length ≤ + (machineMatchingOuterInputBound + (rationalOptimizerOutputCode ⟨X, R, C⟩)).length := by + let optimizer := rationalOptimizerOutputCode ⟨X, R, C⟩ + let range := machineMatchingReverseRange optimizer + let base := pair optimizer range + let P := base.length + have hrangeP : range.length ≤ P := by + simpa only [P, base, machinePairSecond_pair] using + machinePairSecond_length_le base + have hnrange : n ≤ range.length := by + dsimp only [range, optimizer] + rw [machineMatchingReverseRange_encode] + simpa using binaryListCode_listLength_le finUnaryCode + (List.finRange n).reverse + have hnP : n ≤ P := hnrange.trans hrangeP + have hcoarse : (binaryListCode orderedRowPairCode selected).length ≤ + P * (P * (6 * P)) := + hselected.trans (Nat.mul_le_mul hnP + (Nat.mul_le_mul hnP (Nat.mul_le_mul_left 6 hnP))) + change (binaryListCode orderedRowPairCode selected).length ≤ + (machineBinaryMulWidth + (machineBinaryMulWidth (machineBinaryMulWidth base))).length + simp only [machineBinaryMulWidth, List.length_replicate, + List.length_append] + let W₁ := (16 + P) * (16 + P) + let W₂ := (16 + W₁) * (16 + W₁) + have hPone : 1 ≤ P := by + dsimp only [P, base] + simp only [pair_length] + omega + have hPP : P * P ≤ W₁ := by + dsimp only [W₁] + nlinarith + have hfour : (P * P) * (P * P) ≤ W₁ * W₁ := + Nat.mul_le_mul hPP hPP + have hcube : P * (P * (6 * P)) ≤ + 6 * ((P * P) * (P * P)) := by + nlinarith + have hW₁sq : W₁ * W₁ ≤ W₂ := by + dsimp only [W₂] + nlinarith + have htoW₂ : P * (P * (6 * P)) ≤ 16 * W₂ := by + calc + _ ≤ 6 * ((P * P) * (P * P)) := hcube + _ ≤ 6 * (W₁ * W₁) := Nat.mul_le_mul_left 6 hfour + _ ≤ 6 * W₂ := Nat.mul_le_mul_left 6 hW₁sq + _ ≤ 16 * W₂ := Nat.mul_le_mul_right W₂ (by omega) + have hfinal : 16 * W₂ ≤ (16 + W₂) * (16 + W₂) := by + nlinarith + exact hcoarse.trans (htoW₂.trans hfinal) + +theorem machineMatchingOuterNextSelected_encode {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℚ) + (i : Fin n) (is : List (Fin n)) + (selected : List (Fin n × Fin n)) + (hselected : (binaryListCode orderedRowPairCode + (certifiedGreedyOuterStep X selected i)).length ≤ + n * (n * (6 * n))) : + machineMatchingOuterNextSelected + (machineMatchingOuterPack (binaryListCode finUnaryCode (i :: is)) + (binaryListCode orderedRowPairCode selected) + (rationalOptimizerOutputCode ⟨X, R, C⟩)) = + binaryListCode orderedRowPairCode + (certifiedGreedyOuterStep X selected i) := by + rw [machineMatchingOuterNextSelected, + machineMatchingOuterNextSelectedRaw_encode, + machineMatchingOuterBound, machineMatchingOuterSource_pack, + (List.take_eq_self_iff _).2 + (canonical_outer_selected_length_le_bound X R C _ hselected)] + +theorem certifiedGreedyOuterScan_take_succ {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) + (selected : List (Fin n × Fin n)) (is : List (Fin n)) + (k : ℕ) (hk : k < is.length) : + certifiedGreedyOuterScan X selected (is.take (k + 1)) = + certifiedGreedyOuterStep X + (certifiedGreedyOuterScan X selected (is.take k)) is[k] := by + have htake : is.take (k + 1) = is.take k ++ [is[k]] := by + simpa only [List.concat_eq_append] using (List.take_concat_get hk).symm + unfold certifiedGreedyOuterScan + calc + List.foldl (certifiedGreedyOuterStep X) selected (is.take (k + 1)) = + List.foldl (certifiedGreedyOuterStep X) selected + (is.take k ++ [is[k]]) := congrArg _ htake + _ = _ := by rw [List.foldl_append]; rfl + +def machineMatchingOuterSemanticState {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℚ) + (is : List (Fin n)) (k : ℕ) : List Bool := + machineMatchingOuterPack + (binaryListCode finUnaryCode (is.drop k)) + (binaryListCode orderedRowPairCode + (certifiedGreedyOuterScan X [] (is.take k))) + (rationalOptimizerOutputCode ⟨X, R, C⟩) + +theorem machineMatchingOuterSemanticState_step {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℚ) + (is : List (Fin n)) (his : is.length ≤ n) + (k : ℕ) (hk : k < is.length) : + machineMatchingOuterStep (machineMatchingOuterSemanticState X R C is k) = + machineMatchingOuterSemanticState X R C is (k + 1) := by + rw [machineMatchingOuterSemanticState, List.drop_eq_getElem_cons hk, + machineMatchingOuterStep] + simp only [machineMatchingOuterRemaining_pack] + rw [machineIfEmpty_of_ne_nil_matrix _ _ _ + (binaryListCode_cons_ne_nil finUnaryCode is[k] (is.drop (k + 1))), + machineMatchingOuterProcess] + simp only [machineMatchingOuterRemaining_pack, machineListTail_cons, + machineMatchingOuterSource_pack] + let selected := certifiedGreedyOuterScan X [] (is.take k) + have hscan := certifiedGreedyOuterScan_code_length_le X [] (is.take k) + have htake : (is.take k).length ≤ k := List.length_take_le _ _ + have hklt : k < n := lt_of_lt_of_le hk his + have hselectedCode : + (binaryListCode orderedRowPairCode selected).length ≤ + k * (n * (6 * n)) := by + dsimp only [selected] + simpa [binaryListCode] using hscan.trans (Nat.add_le_add_left + (Nat.mul_le_mul_right (n * (6 * n)) htake) _) + have hstep := certifiedGreedyOuterStep_code_length_le X selected is[k] + have hcandidate : + (binaryListCode orderedRowPairCode + (certifiedGreedyOuterStep X selected is[k])).length ≤ + n * (n * (6 * n)) := by + calc + _ ≤ (binaryListCode orderedRowPairCode selected).length + + n * (6 * n) := hstep + _ ≤ k * (n * (6 * n)) + n * (6 * n) := + Nat.add_le_add_right hselectedCode _ + _ = (k + 1) * (n * (6 * n)) := by ring + _ ≤ n * (n * (6 * n)) := + Nat.mul_le_mul_right (n * (6 * n)) (by omega) + rw [machineMatchingOuterNextSelected_encode + X R C is[k] (is.drop (k + 1)) selected hcandidate] + rw [machineMatchingOuterSemanticState] + apply congrArg (fun chosen : List (Fin n × Fin n) ↦ + machineMatchingOuterPack + (binaryListCode finUnaryCode (is.drop (k + 1))) + (binaryListCode orderedRowPairCode chosen) + (rationalOptimizerOutputCode ⟨X, R, C⟩)) + exact (certifiedGreedyOuterScan_take_succ X [] is k hk).symm + +@[simp] theorem machineMatchingOuterSemanticState_zero {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℚ) : + machineMatchingOuterSemanticState X R C (List.finRange n).reverse 0 = + machineMatchingOuterInit (rationalOptimizerOutputCode ⟨X, R, C⟩) := by + simp [machineMatchingOuterSemanticState, machineMatchingOuterInit, + certifiedGreedyOuterScan, machineMatchingReverseRange_encode, + binaryListCode] + +theorem machineMatchingOuterIterate_semantics {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℚ) : ∀ k ≤ n, + (machineMatchingOuterStep)^[k] + (machineMatchingOuterInit (rationalOptimizerOutputCode ⟨X, R, C⟩)) = + machineMatchingOuterSemanticState X R C + (List.finRange n).reverse k := by + intro k hk + induction k with + | zero => exact (machineMatchingOuterSemanticState_zero X R C).symm + | succ k ih => + rw [Function.iterate_succ_apply', ih (by omega)] + exact machineMatchingOuterSemanticState_step X R C + (List.finRange n).reverse (by simp) k (by simp; omega) + +@[simp] theorem machineGreedyMatchingSelected_encode {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℚ) : + machineGreedyMatchingSelected (rationalOptimizerOutputCode ⟨X, R, C⟩) = + binaryListCode orderedRowPairCode + (certifiedGreedyOuterScan X [] (List.finRange n).reverse) := by + rw [machineGreedyMatchingSelected, machineMatchingOuterFinalState, + machineMatchingDimensionRuler_encode, List.length_replicate, + machineMatchingOuterIterate_semantics X R C n le_rfl] + simp only [machineMatchingOuterSemanticState, + machineMatchingOuterSelected_pack] + rw [(List.take_eq_self_iff _).2 (by simp)] + +/-! ## Identification with the mathematical greedy matching -/ + +def rowPairEndpoints {n : ℕ} (q : RowPair n) : Fin n × Fin n := + (rowPairRow q 0, rowPairRow q 1) + +theorem rowPair_eq_pair_rows {n : ℕ} (q : RowPair n) : + q.1 = {rowPairRow q 0, rowPairRow q 1} := by + apply Finset.eq_of_subset_of_card_le + · intro x hx + obtain ⟨k, hk⟩ := (q.1.orderIsoOfFin q.2).surjective ⟨x, hx⟩ + have hxrow : x = rowPairRow q k := by + exact congrArg Subtype.val hk.symm + fin_cases k <;> simp [hxrow] + · simp [q.2, rowPairRow_ne q] + +@[simp] theorem rowPairEndpoints_rowPairOfLT {n : ℕ} + (i j : Fin n) (hij : i < j) : + rowPairEndpoints (rowPairOfLT i j hij) = (i, j) := by + simp [rowPairEndpoints] + +theorem orderedPairsConflict_map_endpoints_eq_false_iff {n : ℕ} + (i j : Fin n) (hij : i < j) (selected : List (RowPair n)) : + orderedPairsConflict i j (selected.map rowPairEndpoints) = false ↔ + ∀ q ∈ selected, Disjoint (rowPairOfLT i j hij).1 q.1 := by + induction selected with + | nil => simp [orderedPairsConflict] + | cons q selected ih => + rw [List.map_cons] + change (decide (i = (rowPairEndpoints q).1 ∨ + i = (rowPairEndpoints q).2 ∨ + j = (rowPairEndpoints q).1 ∨ j = (rowPairEndpoints q).2) || + orderedPairsConflict i j (selected.map rowPairEndpoints)) = false ↔ _ + rw [Bool.or_eq_false_iff, ih] + constructor + · rintro ⟨hhead, htail⟩ r hr + simp only [List.mem_cons] at hr + rcases hr with rfl | hr + · rw [rowPair_eq_pair_rows (rowPairOfLT i j hij), + rowPair_eq_pair_rows r, + rowPairRow_rowPairOfLT_zero, + rowPairRow_rowPairOfLT_one] + simpa [rowPairEndpoints, Finset.disjoint_left, and_assoc] using hhead + · exact htail r hr + · intro hall + refine ⟨?_, fun r hr ↦ hall r (List.mem_cons_of_mem _ hr)⟩ + have hdisj := hall q (by simp) + rw [rowPair_eq_pair_rows (rowPairOfLT i j hij), + rowPair_eq_pair_rows q, + rowPairRow_rowPairOfLT_zero, + rowPairRow_rowPairOfLT_one] at hdisj + simpa [rowPairEndpoints, rowPairOfLT, + Finset.disjoint_left, and_assoc] using hdisj + +/-- The same greedy update, now retaining the proof-carrying unordered row +pair. This is the bridge from the machine's endpoint representation to the +mathematical matching. -/ +def certifiedGreedyTypedStep {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) (i : Fin n) + (selected : List (RowPair n)) (j : Fin n) : List (RowPair n) := + if hij : i < j then + let q := rowPairOfLT i j hij + if HasCertifiedCorePair (explicitRegularizationScale n) X explicitKappa + (directedPairCostPrecision n) q ∧ + ∀ r ∈ selected, Disjoint q.1 r.1 then + q :: selected + else selected + else selected + +theorem certifiedGreedyOrderedStep_map_endpoints {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) (i j : Fin n) + (selected : List (RowPair n)) : + certifiedGreedyOrderedStep X i (selected.map rowPairEndpoints) j = + (certifiedGreedyTypedStep X i selected j).map rowPairEndpoints := by + by_cases hij : i < j + · rw [certifiedGreedyOrderedStep, dif_pos hij, + certifiedGreedyTypedStep, dif_pos hij] + have hiff := orderedPairsConflict_map_endpoints_eq_false_iff + i j hij selected + by_cases h : HasCertifiedCorePair (explicitRegularizationScale n) X + explicitKappa (directedPairCostPrecision n) (rowPairOfLT i j hij) ∧ + orderedPairsConflict i j (selected.map rowPairEndpoints) = false + · have htyped : HasCertifiedCorePair (explicitRegularizationScale n) X + explicitKappa (directedPairCostPrecision n) (rowPairOfLT i j hij) ∧ + ∀ r ∈ selected, Disjoint (rowPairOfLT i j hij).1 r.1 := + ⟨h.1, hiff.mp h.2⟩ + rw [if_pos h, if_pos htyped, List.map_cons, + rowPairEndpoints_rowPairOfLT] + · have htyped : ¬(HasCertifiedCorePair + (explicitRegularizationScale n) X explicitKappa + (directedPairCostPrecision n) (rowPairOfLT i j hij) ∧ + ∀ r ∈ selected, Disjoint (rowPairOfLT i j hij).1 r.1) := by + intro ht + exact h ⟨ht.1, hiff.mpr ht.2⟩ + rw [if_neg h, if_neg htyped] + · simp [certifiedGreedyOrderedStep, certifiedGreedyTypedStep, hij] + +def certifiedGreedyTypedInnerScan {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) (i : Fin n) + (selected : List (RowPair n)) (js : List (Fin n)) : List (RowPair n) := + js.foldl (certifiedGreedyTypedStep X i) selected + +theorem certifiedGreedyOrderedScan_map_endpoints {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) (i : Fin n) + (selected : List (RowPair n)) (js : List (Fin n)) : + certifiedGreedyOrderedScan X i (selected.map rowPairEndpoints) js = + (certifiedGreedyTypedInnerScan X i selected js).map + rowPairEndpoints := by + induction js generalizing selected with + | nil => rfl + | cons j js ih => + rw [certifiedGreedyOrderedScan, certifiedGreedyTypedInnerScan, + List.foldl_cons, List.foldl_cons, + certifiedGreedyOrderedStep_map_endpoints] + exact ih (certifiedGreedyTypedStep X i selected j) + +def certifiedGreedyTypedOuterStep {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) + (selected : List (RowPair n)) (i : Fin n) : List (RowPair n) := + certifiedGreedyTypedInnerScan X i selected (List.finRange n).reverse + +def certifiedGreedyTypedOuterScan {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) + (selected : List (RowPair n)) (is : List (Fin n)) : List (RowPair n) := + is.foldl (certifiedGreedyTypedOuterStep X) selected + +theorem certifiedGreedyOuterScan_map_endpoints {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) + (selected : List (RowPair n)) (is : List (Fin n)) : + certifiedGreedyOuterScan X (selected.map rowPairEndpoints) is = + (certifiedGreedyTypedOuterScan X selected is).map + rowPairEndpoints := by + induction is generalizing selected with + | nil => rfl + | cons i is ih => + rw [certifiedGreedyOuterScan, certifiedGreedyTypedOuterScan, + List.foldl_cons, List.foldl_cons] + change certifiedGreedyOuterScan X + (certifiedGreedyOrderedScan X i + (selected.map rowPairEndpoints) (List.finRange n).reverse) is = _ + rw [certifiedGreedyOrderedScan_map_endpoints] + exact ih (certifiedGreedyTypedOuterStep X selected i) + +def canonicalRowPairCandidate {n : ℕ} (i j : Fin n) : Option (RowPair n) := + if hij : i < j then some (rowPairOfLT i j hij) else none + +def certifiedRowPairEligibleBit {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) (q : RowPair n) : Bool := + decide (HasCertifiedCorePair (explicitRegularizationScale n) X + explicitKappa (directedPairCostPrecision n) q) + +def greedyRowListStep {n : ℕ} + (selected : List (RowPair n)) (q : RowPair n) : List (RowPair n) := + if ∀ r ∈ selected, Disjoint q.1 r.1 then q :: selected else selected + +def certifiedGreedyEdgeStep {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) + (selected : List (RowPair n)) (q : RowPair n) : List (RowPair n) := + if certifiedRowPairEligibleBit X q then greedyRowListStep selected q + else selected + +theorem certifiedGreedyTypedStep_eq_candidate {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) (i j : Fin n) + (selected : List (RowPair n)) : + certifiedGreedyTypedStep X i selected j = + match canonicalRowPairCandidate i j with + | some q => certifiedGreedyEdgeStep X selected q + | none => selected := by + by_cases hij : i < j + · simp only [certifiedGreedyTypedStep, canonicalRowPairCandidate, + dif_pos hij, certifiedGreedyEdgeStep, certifiedRowPairEligibleBit, + greedyRowListStep] + by_cases heligible : HasCertifiedCorePair (explicitRegularizationScale n) X + explicitKappa (directedPairCostPrecision n) (rowPairOfLT i j hij) + · simp [heligible] + · simp [heligible] + · simp [certifiedGreedyTypedStep, canonicalRowPairCandidate, hij] + +theorem certifiedGreedyTypedInnerScan_eq_filterMap_fold {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) (i : Fin n) + (selected : List (RowPair n)) (js : List (Fin n)) : + certifiedGreedyTypedInnerScan X i selected js = + (js.filterMap (canonicalRowPairCandidate i)).foldl + (certifiedGreedyEdgeStep X) selected := by + rw [List.foldl_filterMap] + unfold certifiedGreedyTypedInnerScan + congr 1 + funext acc j + by_cases hij : i < j + · by_cases heligible : HasCertifiedCorePair + (explicitRegularizationScale n) X explicitKappa + (directedPairCostPrecision n) (rowPairOfLT i j hij) + · by_cases hdisjoint : ∀ r ∈ acc, + Disjoint (rowPairOfLT i j hij).1 r.1 + · simp [certifiedGreedyTypedStep, canonicalRowPairCandidate, + certifiedGreedyEdgeStep, certifiedRowPairEligibleBit, + greedyRowListStep, hij, heligible, hdisjoint] + · simp [certifiedGreedyTypedStep, canonicalRowPairCandidate, + certifiedGreedyEdgeStep, certifiedRowPairEligibleBit, + greedyRowListStep, hij, heligible, hdisjoint] + · simp [certifiedGreedyTypedStep, canonicalRowPairCandidate, + certifiedGreedyEdgeStep, certifiedRowPairEligibleBit, + greedyRowListStep, hij, heligible] + · simp [certifiedGreedyTypedStep, canonicalRowPairCandidate, hij] + +theorem reverse_allRowPairsList {n : ℕ} : + (allRowPairsList n).reverse = + (List.finRange n).reverse.flatMap fun i ↦ + (List.finRange n).reverse.filterMap + (canonicalRowPairCandidate i) := by + rw [allRowPairsList, List.reverse_flatMap] + apply congrArg (fun f ↦ (List.finRange n).reverse.flatMap f) + funext i + change ((List.finRange n).filterMap + (canonicalRowPairCandidate i)).reverse = + (List.finRange n).reverse.filterMap (canonicalRowPairCandidate i) + exact (List.filterMap_reverse).symm + +theorem certifiedGreedyTypedOuterScan_eq_edgeFold {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) + (selected : List (RowPair n)) (is : List (Fin n)) : + certifiedGreedyTypedOuterScan X selected is = + (is.flatMap fun i ↦ (List.finRange n).reverse.filterMap + (canonicalRowPairCandidate i)).foldl + (certifiedGreedyEdgeStep X) selected := by + rw [List.foldl_flatMap] + unfold certifiedGreedyTypedOuterScan + congr 1 + funext acc i + exact certifiedGreedyTypedInnerScan_eq_filterMap_fold + X i acc (List.finRange n).reverse + +theorem certifiedGreedyTypedOuterScan_full_eq_edgeFold {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) : + certifiedGreedyTypedOuterScan X [] (List.finRange n).reverse = + (allRowPairsList n).reverse.foldl (certifiedGreedyEdgeStep X) [] := by + rw [certifiedGreedyTypedOuterScan_eq_edgeFold, + ← reverse_allRowPairsList] + +theorem certifiedGreedyEdgeFold_eq_filter {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) + (selected : List (RowPair n)) (edges : List (RowPair n)) : + edges.foldl (certifiedGreedyEdgeStep X) selected = + (edges.filter (certifiedRowPairEligibleBit X)).foldl + greedyRowListStep selected := by + rw [List.foldl_filter] + congr 1 + +theorem explicitThresholdRowPairsList_eq_certifiedFilter {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) : + thresholdRowPairsList (explicitCertifiedRowWeight X) explicitGamma = + (allRowPairsList n).filter (certifiedRowPairEligibleBit X) := by + rw [thresholdRowPairsList] + apply List.filter_congr + intro q _ + by_cases h : HasCertifiedCorePair (explicitRegularizationScale n) X + explicitKappa (directedPairCostPrecision n) q + · simp [explicitCertifiedRowWeight, certifiedConstantRowWeight, + certifiedRowPairEligibleBit, h] + · simp [explicitCertifiedRowWeight, certifiedConstantRowWeight, + certifiedRowPairEligibleBit, explicitGamma, h] + +def greedyRowFinsetStep {n : ℕ} + (selected : Finset (RowPair n)) (q : RowPair n) : Finset (RowPair n) := + if ∀ r ∈ selected, Disjoint q.1 r.1 then insert q selected else selected + +@[simp] theorem greedyRowListStep_toFinset {n : ℕ} + (selected : List (RowPair n)) (q : RowPair n) : + (greedyRowListStep selected q).toFinset = + greedyRowFinsetStep selected.toFinset q := by + by_cases h : ∀ r ∈ selected, Disjoint q.1 r.1 + · have hfin : ∀ r ∈ selected.toFinset, Disjoint q.1 r.1 := by + simpa using h + rw [greedyRowListStep, if_pos h, + greedyRowFinsetStep, if_pos hfin] + simp + · have hfin : ¬(∀ r ∈ selected.toFinset, Disjoint q.1 r.1) := by + simpa using h + rw [greedyRowListStep, if_neg h, + greedyRowFinsetStep, if_neg hfin] + +theorem greedyRowListFold_toFinset {n : ℕ} + (selected : List (RowPair n)) (edges : List (RowPair n)) : + (edges.foldl greedyRowListStep selected).toFinset = + edges.foldl greedyRowFinsetStep selected.toFinset := by + induction edges generalizing selected with + | nil => rfl + | cons q edges ih => + rw [List.foldl_cons, List.foldl_cons, ih, + greedyRowListStep_toFinset] + +theorem greedyRowMatchingList_eq_finsetFoldReverse {n : ℕ} + (edges : List (RowPair n)) : + greedyRowMatchingList edges = + edges.reverse.foldl greedyRowFinsetStep ∅ := by + induction edges with + | nil => rfl + | cons q edges ih => + rw [greedyRowMatchingList, List.reverse_cons, + List.foldl_append, ih] + simp [greedyRowFinsetStep] + +theorem certifiedGreedyTypedOuterScan_toFinset {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) : + (certifiedGreedyTypedOuterScan X [] + (List.finRange n).reverse).toFinset = + greedyThresholdRowMatching (explicitCertifiedRowWeight X) + explicitGamma := by + rw [certifiedGreedyTypedOuterScan_full_eq_edgeFold, + certifiedGreedyEdgeFold_eq_filter, + List.filter_reverse, + ← explicitThresholdRowPairsList_eq_certifiedFilter, + greedyRowListFold_toFinset] + simp only [List.toFinset_nil] + rw [← greedyRowMatchingList_eq_finsetFoldReverse] + rfl + +theorem rowPair_not_disjoint_self {n : ℕ} (q : RowPair n) : + ¬Disjoint q.1 q.1 := by + apply Finset.not_disjoint_iff.mpr + exact ⟨rowPairRow q 0, rowPairRow_mem q 0, rowPairRow_mem q 0⟩ + +theorem certifiedGreedyTypedStep_nodup {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) (i j : Fin n) + {selected : List (RowPair n)} (hselected : selected.Nodup) : + (certifiedGreedyTypedStep X i selected j).Nodup := by + by_cases hij : i < j + · rw [certifiedGreedyTypedStep, dif_pos hij] + dsimp only + split_ifs with haccept + · rw [List.nodup_cons] + refine ⟨?_, hselected⟩ + intro hmem + exact rowPair_not_disjoint_self _ (haccept.2 _ hmem) + · exact hselected + · rw [certifiedGreedyTypedStep, dif_neg hij] + exact hselected + +theorem certifiedGreedyTypedInnerScan_nodup {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) (i : Fin n) + {selected : List (RowPair n)} (hselected : selected.Nodup) + (js : List (Fin n)) : + (certifiedGreedyTypedInnerScan X i selected js).Nodup := by + induction js generalizing selected with + | nil => exact hselected + | cons j js ih => + rw [certifiedGreedyTypedInnerScan, List.foldl_cons] + exact ih (certifiedGreedyTypedStep_nodup X i j hselected) + +theorem certifiedGreedyTypedOuterStep_nodup {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) + {selected : List (RowPair n)} (hselected : selected.Nodup) (i : Fin n) : + (certifiedGreedyTypedOuterStep X selected i).Nodup := by + exact certifiedGreedyTypedInnerScan_nodup X i hselected _ + +theorem certifiedGreedyTypedOuterScan_nodup {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) + {selected : List (RowPair n)} (hselected : selected.Nodup) + (is : List (Fin n)) : + (certifiedGreedyTypedOuterScan X selected is).Nodup := by + induction is generalizing selected with + | nil => exact hselected + | cons i is ih => + rw [certifiedGreedyTypedOuterScan, List.foldl_cons] + exact ih (certifiedGreedyTypedOuterStep_nodup X hselected i) + +theorem certifiedGreedyTypedOuterScan_full_nodup {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) : + (certifiedGreedyTypedOuterScan X [] + (List.finRange n).reverse).Nodup := + certifiedGreedyTypedOuterScan_nodup X (by simp) _ + +@[simp] theorem machineGreedyMatchingSelected_typed_encode {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℚ) : + machineGreedyMatchingSelected (rationalOptimizerOutputCode ⟨X, R, C⟩) = + binaryListCode orderedRowPairCode + ((certifiedGreedyTypedOuterScan X [] + (List.finRange n).reverse).map rowPairEndpoints) := by + rw [machineGreedyMatchingSelected_encode, + ← certifiedGreedyOuterScan_map_endpoints X [] + (List.finRange n).reverse] + rfl + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineIntegerArithmetic.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineIntegerArithmetic.lean new file mode 100644 index 0000000000..9fbf017dd6 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineIntegerArithmetic.lean @@ -0,0 +1,414 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalNormalization + +/-! +# Polynomial-time signed integer arithmetic + +The arithmetic core uses a pair `(sign, absolute value)`, with a one-bit sign. +Conversion back to `integerBinaryCode` forces the sign to be nonnegative when +the magnitude is zero, avoiding the `Int.negSucc` negative-zero pitfall. +-/ + +namespace BeyondBethe + +open Complexity + +def signedMagnitudeValue (negative : Bool) (magnitude : ℕ) : ℤ := + if negative then -(magnitude : ℤ) else magnitude + +def machineCanonicalIntegerFromSignedAbs (word : List Bool) : List Bool := + machineIfEmpty (machinePairSecond word) [false] + (machineIntegerCodeFromSignedAbs word) + +def machineIntegerSignedMagnitude (word : List Bool) : List Bool := + pair (machineHeadBit word) (machineIntegerNatAbsBits word) + +def machineSignedLeftSign (word : List Bool) : List Bool := + machinePairFirst (machinePairFirst word) + +def machineSignedLeftAbs (word : List Bool) : List Bool := + machinePairSecond (machinePairFirst word) + +def machineSignedRightSign (word : List Bool) : List Bool := + machinePairFirst (machinePairSecond word) + +def machineSignedRightAbs (word : List Bool) : List Bool := + machinePairSecond (machinePairSecond word) + +def machineSignedSameSign (word : List Bool) : List Bool := + machineNotBit + (machineXorBit (machineSignedLeftSign word) (machineSignedRightSign word)) + +def machineSignedAbsSum (word : List Bool) : List Bool := + machineBinaryAddBits + (pair (machineSignedLeftAbs word) (machineSignedRightAbs word)) + +def machineSignedLeftAbsGe (word : List Bool) : List Bool := + machineBinaryNatLeBit + (pair (machineSignedRightAbs word) (machineSignedLeftAbs word)) + +def machineSignedAbsLeftDiff (word : List Bool) : List Bool := + machineBinarySubBits + (pair (machineSignedLeftAbs word) (machineSignedRightAbs word)) + +def machineSignedAbsRightDiff (word : List Bool) : List Bool := + machineBinarySubBits + (pair (machineSignedRightAbs word) (machineSignedLeftAbs word)) + +def machineSignedDifferentAbs (word : List Bool) : List Bool := + machineIfHead (machineSignedLeftAbsGe word) + (machineSignedAbsLeftDiff word) (machineSignedAbsRightDiff word) + +def machineSignedDifferentSign (word : List Bool) : List Bool := + machineIfHead (machineSignedLeftAbsGe word) + (machineSignedLeftSign word) (machineSignedRightSign word) + +/-- Addition on two signed-magnitude pairs. -/ +def machineSignedMagnitudeAdd (word : List Bool) : List Bool := + let sign := machineIfHead (machineSignedSameSign word) + (machineSignedLeftSign word) (machineSignedDifferentSign word) + let magnitude := machineIfHead (machineSignedSameSign word) + (machineSignedAbsSum word) (machineSignedDifferentAbs word) + machineCanonicalIntegerFromSignedAbs (pair sign magnitude) + +/-- Addition on a pair of canonical `integerBinaryCode`s. -/ +def machineIntegerAddCode (word : List Bool) : List Bool := + machineSignedMagnitudeAdd + (pair (machineIntegerSignedMagnitude (machinePairFirst word)) + (machineIntegerSignedMagnitude (machinePairSecond word))) + +def machineSignedAbsProduct (word : List Bool) : List Bool := + machineBinaryMulBits + (pair (machineSignedLeftAbs word) (machineSignedRightAbs word)) + +def machineSignedProductSign (word : List Bool) : List Bool := + machineXorBit (machineSignedLeftSign word) (machineSignedRightSign word) + +def machineSignedMagnitudeMul (word : List Bool) : List Bool := + machineCanonicalIntegerFromSignedAbs + (pair (machineSignedProductSign word) (machineSignedAbsProduct word)) + +/-- Multiplication on a pair of canonical `integerBinaryCode`s. -/ +def machineIntegerMulCode (word : List Bool) : List Bool := + machineSignedMagnitudeMul + (pair (machineIntegerSignedMagnitude (machinePairFirst word)) + (machineIntegerSignedMagnitude (machinePairSecond word))) + +/-- Negation of one canonical `integerBinaryCode`. -/ +def machineIntegerNegCode (word : List Bool) : List Bool := + let signed := machineIntegerSignedMagnitude word + machineCanonicalIntegerFromSignedAbs + (pair (machineNotBit (machinePairFirst signed)) + (machinePairSecond signed)) + +theorem machineCanonicalIntegerFromSignedAbs_mem_FP : + machineCanonicalIntegerFromSignedAbs ∈ Complexity.FP := by + simpa only [machineCanonicalIntegerFromSignedAbs] using + machineIfEmpty_mem_FP machinePairSecond_mem_FP + (machineConst_mem_FP [false]) machineIntegerCodeFromSignedAbs_mem_FP + +theorem machineIntegerSignedMagnitude_mem_FP : + machineIntegerSignedMagnitude ∈ Complexity.FP := by + simpa only [machineIntegerSignedMagnitude] using + machinePair_mem_FP machineHeadBit_mem_FP machineIntegerNatAbsBits_mem_FP + +theorem machineSignedLeftSign_mem_FP : machineSignedLeftSign ∈ Complexity.FP := by + simpa only [machineSignedLeftSign] using + machineCompose_mem_FP machinePairFirst_mem_FP machinePairFirst_mem_FP + +theorem machineSignedLeftAbs_mem_FP : machineSignedLeftAbs ∈ Complexity.FP := by + simpa only [machineSignedLeftAbs] using + machineCompose_mem_FP machinePairFirst_mem_FP machinePairSecond_mem_FP + +theorem machineSignedRightSign_mem_FP : machineSignedRightSign ∈ Complexity.FP := by + simpa only [machineSignedRightSign] using + machineCompose_mem_FP machinePairSecond_mem_FP machinePairFirst_mem_FP + +theorem machineSignedRightAbs_mem_FP : machineSignedRightAbs ∈ Complexity.FP := by + simpa only [machineSignedRightAbs] using + machineCompose_mem_FP machinePairSecond_mem_FP machinePairSecond_mem_FP + +theorem machineSignedSameSign_mem_FP : machineSignedSameSign ∈ Complexity.FP := by + exact machineNotBit_mem_FP + (machineXorBit_mem_FP machineSignedLeftSign_mem_FP + machineSignedRightSign_mem_FP) + +theorem machineSignedAbsSum_mem_FP : machineSignedAbsSum ∈ Complexity.FP := by + have hpair := machinePair_mem_FP machineSignedLeftAbs_mem_FP + machineSignedRightAbs_mem_FP + simpa only [machineSignedAbsSum] using + machineCompose_mem_FP hpair machineBinaryAddBits_mem_FP + +theorem machineSignedLeftAbsGe_mem_FP : machineSignedLeftAbsGe ∈ Complexity.FP := by + have hpair := machinePair_mem_FP machineSignedRightAbs_mem_FP + machineSignedLeftAbs_mem_FP + simpa only [machineSignedLeftAbsGe] using + machineCompose_mem_FP hpair machineBinaryNatLeBit_mem_FP + +theorem machineSignedAbsLeftDiff_mem_FP : + machineSignedAbsLeftDiff ∈ Complexity.FP := by + have hpair := machinePair_mem_FP machineSignedLeftAbs_mem_FP + machineSignedRightAbs_mem_FP + simpa only [machineSignedAbsLeftDiff] using + machineCompose_mem_FP hpair machineBinarySubBits_mem_FP + +theorem machineSignedAbsRightDiff_mem_FP : + machineSignedAbsRightDiff ∈ Complexity.FP := by + have hpair := machinePair_mem_FP machineSignedRightAbs_mem_FP + machineSignedLeftAbs_mem_FP + simpa only [machineSignedAbsRightDiff] using + machineCompose_mem_FP hpair machineBinarySubBits_mem_FP + +theorem machineSignedDifferentAbs_mem_FP : + machineSignedDifferentAbs ∈ Complexity.FP := by + exact machineIfHead_mem_FP machineSignedLeftAbsGe_mem_FP + machineSignedAbsLeftDiff_mem_FP machineSignedAbsRightDiff_mem_FP + +theorem machineSignedDifferentSign_mem_FP : + machineSignedDifferentSign ∈ Complexity.FP := by + exact machineIfHead_mem_FP machineSignedLeftAbsGe_mem_FP + machineSignedLeftSign_mem_FP machineSignedRightSign_mem_FP + +theorem machineSignedMagnitudeAdd_mem_FP : + machineSignedMagnitudeAdd ∈ Complexity.FP := by + have hsign := machineIfHead_mem_FP machineSignedSameSign_mem_FP + machineSignedLeftSign_mem_FP machineSignedDifferentSign_mem_FP + have hmagnitude := machineIfHead_mem_FP machineSignedSameSign_mem_FP + machineSignedAbsSum_mem_FP machineSignedDifferentAbs_mem_FP + have hpair := machinePair_mem_FP hsign hmagnitude + simpa only [machineSignedMagnitudeAdd] using + machineCompose_mem_FP hpair machineCanonicalIntegerFromSignedAbs_mem_FP + +theorem machineIntegerAddCode_mem_FP : machineIntegerAddCode ∈ Complexity.FP := by + have hleft := machineCompose_mem_FP machinePairFirst_mem_FP + machineIntegerSignedMagnitude_mem_FP + have hright := machineCompose_mem_FP machinePairSecond_mem_FP + machineIntegerSignedMagnitude_mem_FP + have hpair := machinePair_mem_FP hleft hright + simpa only [machineIntegerAddCode] using + machineCompose_mem_FP hpair machineSignedMagnitudeAdd_mem_FP + +theorem machineSignedAbsProduct_mem_FP : + machineSignedAbsProduct ∈ Complexity.FP := by + have hpair := machinePair_mem_FP machineSignedLeftAbs_mem_FP + machineSignedRightAbs_mem_FP + simpa only [machineSignedAbsProduct] using + machineCompose_mem_FP hpair machineBinaryMulBits_mem_FP + +theorem machineSignedProductSign_mem_FP : + machineSignedProductSign ∈ Complexity.FP := by + exact machineXorBit_mem_FP machineSignedLeftSign_mem_FP + machineSignedRightSign_mem_FP + +theorem machineSignedMagnitudeMul_mem_FP : + machineSignedMagnitudeMul ∈ Complexity.FP := by + have hpair := machinePair_mem_FP machineSignedProductSign_mem_FP + machineSignedAbsProduct_mem_FP + simpa only [machineSignedMagnitudeMul] using + machineCompose_mem_FP hpair machineCanonicalIntegerFromSignedAbs_mem_FP + +theorem machineIntegerMulCode_mem_FP : machineIntegerMulCode ∈ Complexity.FP := by + have hleft := machineCompose_mem_FP machinePairFirst_mem_FP + machineIntegerSignedMagnitude_mem_FP + have hright := machineCompose_mem_FP machinePairSecond_mem_FP + machineIntegerSignedMagnitude_mem_FP + have hpair := machinePair_mem_FP hleft hright + simpa only [machineIntegerMulCode] using + machineCompose_mem_FP hpair machineSignedMagnitudeMul_mem_FP + +theorem machineIntegerNegCode_mem_FP : machineIntegerNegCode ∈ Complexity.FP := by + have hsigned := machineIntegerSignedMagnitude_mem_FP + have hsignProjection := machineCompose_mem_FP hsigned machinePairFirst_mem_FP + have hsign := machineNotBit_mem_FP hsignProjection + have habs := machineCompose_mem_FP hsigned machinePairSecond_mem_FP + have hpair := machinePair_mem_FP hsign habs + simpa only [machineIntegerNegCode] using + machineCompose_mem_FP hpair machineCanonicalIntegerFromSignedAbs_mem_FP + +@[simp] theorem machineCanonicalIntegerFromSignedAbs_pair + (negative : Bool) (magnitude : ℕ) : + machineCanonicalIntegerFromSignedAbs (pair [negative] magnitude.bits) = + integerBinaryCode (signedMagnitudeValue negative magnitude) := by + cases negative with + | false => + cases magnitude with + | zero => + rfl + | succ k => + rw [machineCanonicalIntegerFromSignedAbs] + simp only [machinePairSecond_pair] + rw [machineIfEmpty_of_ne_nil (k + 1).bits [false] + (machineIntegerCodeFromSignedAbs (pair [false] (k + 1).bits)) + (natBits_ne_nil_of_ne_zero (by omega))] + simp only [machineIntegerCodeFromSignedAbs, machinePairFirst_pair, + machinePairSecond_pair, machineIfHead_false, + signedMagnitudeValue] + change false :: (k + 1).bits = + integerBinaryCode (Int.ofNat (k + 1)) + rfl + | true => + cases magnitude with + | zero => + rfl + | succ k => + rw [machineCanonicalIntegerFromSignedAbs] + simp only [machinePairSecond_pair] + rw [machineIfEmpty_of_ne_nil (k + 1).bits [false] + (machineIntegerCodeFromSignedAbs (pair [true] (k + 1).bits)) + (natBits_ne_nil_of_ne_zero (by omega))] + simp only [signedMagnitudeValue, if_true] + simpa only [show ([true] : List Bool) = + integerBinaryCode (Int.negSucc 0) by rfl] using + machineIntegerCodeFromSignedAbs_negSucc 0 (k + 1) (by omega) + +theorem machineIntegerSignedMagnitude_encode (z : ℤ) : + machineIntegerSignedMagnitude (integerBinaryCode z) = + match z with + | .ofNat n => pair [false] n.bits + | .negSucc n => pair [true] (n + 1).bits := by + rw [machineIntegerSignedMagnitude] + cases z with + | ofNat n => + rw [machineIntegerNatAbsBits_encode] + simp [integerBinaryCode] + | negSucc n => + rw [machineIntegerNatAbsBits_encode] + simp [integerBinaryCode] + +theorem machineSignedMagnitudeAdd_pair + (leftNegative rightNegative : Bool) (leftAbs rightAbs : ℕ) : + machineSignedMagnitudeAdd + (pair (pair [leftNegative] leftAbs.bits) + (pair [rightNegative] rightAbs.bits)) = + integerBinaryCode + (signedMagnitudeValue leftNegative leftAbs + + signedMagnitudeValue rightNegative rightAbs) := by + cases leftNegative <;> cases rightNegative + · simp [machineSignedMagnitudeAdd, machineSignedSameSign, + machineSignedLeftSign, machineSignedRightSign, + machineSignedLeftAbs, machineSignedRightAbs, + machineSignedAbsSum, machineBinaryAddBits_pair_natBits, + signedMagnitudeValue] + · by_cases h : rightAbs ≤ leftAbs + · simp [machineSignedMagnitudeAdd, machineSignedSameSign, + machineSignedLeftSign, machineSignedRightSign, + machineSignedLeftAbs, machineSignedRightAbs, + machineSignedLeftAbsGe, machineSignedAbsLeftDiff, + machineSignedAbsRightDiff, machineSignedDifferentAbs, + machineSignedDifferentSign, machineBinaryNatLeBit_pair_natBits, + machineBinarySubBits_pair_natBits, signedMagnitudeValue, h] + congr 1 + · have hlt : leftAbs < rightAbs := Nat.lt_of_not_ge h + simp [machineSignedMagnitudeAdd, machineSignedSameSign, + machineSignedLeftSign, machineSignedRightSign, + machineSignedLeftAbs, machineSignedRightAbs, + machineSignedLeftAbsGe, machineSignedAbsLeftDiff, + machineSignedAbsRightDiff, machineSignedDifferentAbs, + machineSignedDifferentSign, machineBinaryNatLeBit_pair_natBits, + machineBinarySubBits_pair_natBits, signedMagnitudeValue, h] + congr 1 + omega + · by_cases h : rightAbs ≤ leftAbs + · simp [machineSignedMagnitudeAdd, machineSignedSameSign, + machineSignedLeftSign, machineSignedRightSign, + machineSignedLeftAbs, machineSignedRightAbs, + machineSignedLeftAbsGe, machineSignedAbsLeftDiff, + machineSignedAbsRightDiff, machineSignedDifferentAbs, + machineSignedDifferentSign, machineBinaryNatLeBit_pair_natBits, + machineBinarySubBits_pair_natBits, signedMagnitudeValue, h] + congr 1 + omega + · have hlt : leftAbs < rightAbs := Nat.lt_of_not_ge h + simp [machineSignedMagnitudeAdd, machineSignedSameSign, + machineSignedLeftSign, machineSignedRightSign, + machineSignedLeftAbs, machineSignedRightAbs, + machineSignedLeftAbsGe, machineSignedAbsLeftDiff, + machineSignedAbsRightDiff, machineSignedDifferentAbs, + machineSignedDifferentSign, machineBinaryNatLeBit_pair_natBits, + machineBinarySubBits_pair_natBits, signedMagnitudeValue, h] + congr 1 + omega + · simp [machineSignedMagnitudeAdd, machineSignedSameSign, + machineSignedLeftSign, machineSignedRightSign, + machineSignedLeftAbs, machineSignedRightAbs, + machineSignedAbsSum, machineBinaryAddBits_pair_natBits, + signedMagnitudeValue] + congr 1 + omega + +theorem machineIntegerAddCode_encode (z w : ℤ) : + machineIntegerAddCode (pair (integerBinaryCode z) (integerBinaryCode w)) = + integerBinaryCode (z + w) := by + cases z with + | ofNat n => + cases w with + | ofNat m => + simp [machineIntegerAddCode, machineIntegerSignedMagnitude_encode, + machineSignedMagnitudeAdd_pair, signedMagnitudeValue] + | negSucc m => + rw [machineIntegerAddCode] + simp only [machinePairFirst_pair, machinePairSecond_pair, + machineIntegerSignedMagnitude_encode, + machineSignedMagnitudeAdd_pair, signedMagnitudeValue] + congr 1 + | negSucc n => + cases w with + | ofNat m => + rw [machineIntegerAddCode] + simp only [machinePairFirst_pair, machinePairSecond_pair, + machineIntegerSignedMagnitude_encode, + machineSignedMagnitudeAdd_pair, signedMagnitudeValue] + congr 1 + | negSucc m => + rw [machineIntegerAddCode] + simp only [machinePairFirst_pair, machinePairSecond_pair, + machineIntegerSignedMagnitude_encode, + machineSignedMagnitudeAdd_pair, signedMagnitudeValue] + congr 1 + +theorem machineSignedMagnitudeMul_pair + (leftNegative rightNegative : Bool) (leftAbs rightAbs : ℕ) : + machineSignedMagnitudeMul + (pair (pair [leftNegative] leftAbs.bits) + (pair [rightNegative] rightAbs.bits)) = + integerBinaryCode + (signedMagnitudeValue leftNegative leftAbs * + signedMagnitudeValue rightNegative rightAbs) := by + cases leftNegative <;> cases rightNegative <;> + simp [machineSignedMagnitudeMul, machineSignedProductSign, + machineSignedLeftSign, machineSignedRightSign, + machineSignedLeftAbs, machineSignedRightAbs, + machineSignedAbsProduct, machineBinaryMulBits_pair_natBits, + signedMagnitudeValue] <;> + congr 1 <;> ring + +theorem machineIntegerMulCode_encode (z w : ℤ) : + machineIntegerMulCode (pair (integerBinaryCode z) (integerBinaryCode w)) = + integerBinaryCode (z * w) := by + cases z <;> cases w <;> + rw [machineIntegerMulCode] <;> + simp only [machinePairFirst_pair, machinePairSecond_pair, + machineIntegerSignedMagnitude_encode, + machineSignedMagnitudeMul_pair, signedMagnitudeValue] <;> + congr 1 <;> ring + +theorem machineIntegerNegCode_encode (z : ℤ) : + machineIntegerNegCode (integerBinaryCode z) = integerBinaryCode (-z) := by + cases z with + | ofNat n => + simp [machineIntegerNegCode, machineIntegerSignedMagnitude_encode, + signedMagnitudeValue] + | negSucc n => + rw [Int.neg_negSucc] + rw [machineIntegerNegCode, machineIntegerSignedMagnitude_encode] + simp only [machinePairFirst_pair, machinePairSecond_pair, + machineNotBit_one, Bool.not_true] + simpa only [signedMagnitudeValue, if_false] using + machineCanonicalIntegerFromSignedAbs_pair false (n + 1) + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineIntegerCompare.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineIntegerCompare.lean new file mode 100644 index 0000000000..dca65002f9 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineIntegerCompare.lean @@ -0,0 +1,107 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineIntegerArithmetic + +/-! +# Polynomial-time signed-integer comparison + +Canonical integer codes carry one sign bit followed by the `Int.negSucc` +payload. We first convert both operands to true absolute values. Equal-sign +comparisons then reduce to natural comparison; for two negative operands the +order of the magnitudes is reversed. +-/ + +namespace BeyondBethe + +open Complexity + +def machineIntegerLeftSign (word : List Bool) : List Bool := + machineHeadBit (machinePairFirst word) + +def machineIntegerRightSign (word : List Bool) : List Bool := + machineHeadBit (machinePairSecond word) + +def machineIntegerLeftAbsBits (word : List Bool) : List Bool := + machineIntegerNatAbsBits (machinePairFirst word) + +def machineIntegerRightAbsBits (word : List Bool) : List Bool := + machineIntegerNatAbsBits (machinePairSecond word) + +def machineIntegerPositiveLeBit (word : List Bool) : List Bool := + machineBinaryNatLeBit + (pair (machineIntegerLeftAbsBits word) (machineIntegerRightAbsBits word)) + +def machineIntegerNegativeLeBit (word : List Bool) : List Bool := + machineBinaryNatLeBit + (pair (machineIntegerRightAbsBits word) (machineIntegerLeftAbsBits word)) + +/-- One-bit test for `z ≤ w` on a pair of canonical integer encodings. -/ +def machineIntegerLeCode (word : List Bool) : List Bool := + machineIfHead (machineIntegerLeftSign word) + (machineIfHead (machineIntegerRightSign word) + (machineIntegerNegativeLeBit word) [true]) + (machineIfHead (machineIntegerRightSign word) + [false] (machineIntegerPositiveLeBit word)) + +theorem machineIntegerLeftSign_mem_FP : + machineIntegerLeftSign ∈ Complexity.FP := by + simpa only [machineIntegerLeftSign] using + machineCompose_mem_FP machinePairFirst_mem_FP machineHeadBit_mem_FP + +theorem machineIntegerRightSign_mem_FP : + machineIntegerRightSign ∈ Complexity.FP := by + simpa only [machineIntegerRightSign] using + machineCompose_mem_FP machinePairSecond_mem_FP machineHeadBit_mem_FP + +theorem machineIntegerLeftAbsBits_mem_FP : + machineIntegerLeftAbsBits ∈ Complexity.FP := by + simpa only [machineIntegerLeftAbsBits] using + machineCompose_mem_FP machinePairFirst_mem_FP + machineIntegerNatAbsBits_mem_FP + +theorem machineIntegerRightAbsBits_mem_FP : + machineIntegerRightAbsBits ∈ Complexity.FP := by + simpa only [machineIntegerRightAbsBits] using + machineCompose_mem_FP machinePairSecond_mem_FP + machineIntegerNatAbsBits_mem_FP + +theorem machineIntegerPositiveLeBit_mem_FP : + machineIntegerPositiveLeBit ∈ Complexity.FP := by + have hpair := machinePair_mem_FP machineIntegerLeftAbsBits_mem_FP + machineIntegerRightAbsBits_mem_FP + simpa only [machineIntegerPositiveLeBit] using + machineCompose_mem_FP hpair machineBinaryNatLeBit_mem_FP + +theorem machineIntegerNegativeLeBit_mem_FP : + machineIntegerNegativeLeBit ∈ Complexity.FP := by + have hpair := machinePair_mem_FP machineIntegerRightAbsBits_mem_FP + machineIntegerLeftAbsBits_mem_FP + simpa only [machineIntegerNegativeLeBit] using + machineCompose_mem_FP hpair machineBinaryNatLeBit_mem_FP + +theorem machineIntegerLeCode_mem_FP : machineIntegerLeCode ∈ Complexity.FP := by + have hnegativeLeft := machineIfHead_mem_FP machineIntegerRightSign_mem_FP + machineIntegerNegativeLeBit_mem_FP (machineConst_mem_FP [true]) + have hpositiveLeft := machineIfHead_mem_FP machineIntegerRightSign_mem_FP + (machineConst_mem_FP [false]) machineIntegerPositiveLeBit_mem_FP + exact machineIfHead_mem_FP machineIntegerLeftSign_mem_FP + hnegativeLeft hpositiveLeft + +theorem machineIntegerLeCode_encode (z w : ℤ) : + machineIntegerLeCode + (pair (integerBinaryCode z) (integerBinaryCode w)) = + [decide (z ≤ w)] := by + cases z <;> cases w <;> + simp only [machineIntegerLeCode, machineIntegerLeftSign, + machineIntegerRightSign, machineIntegerPositiveLeBit, + machineIntegerNegativeLeBit, machineIntegerLeftAbsBits, + machineIntegerRightAbsBits, machinePairFirst_pair, + machinePairSecond_pair, machineIntegerNatAbsBits_encode] <;> + simp [integerBinaryCode, machineBinaryNatLeBit_pair_natBits] <;> + omega + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineIntegerSignedMagnitude.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineIntegerSignedMagnitude.lean new file mode 100644 index 0000000000..6f5ed206c0 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineIntegerSignedMagnitude.lean @@ -0,0 +1,129 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineBinaryGCD +import LeanPool.BeyondBethe.BeyondBethe.MachineOutputEncoding +import LeanPool.BeyondBethe.BeyondBethe.RawRational + +/-! +# Signed integers at the rational-arithmetic boundary + +The project encoding follows Lean's constructors: `Int.ofNat n` is +`false :: n.bits`, whereas `Int.negSucc n` is `true :: n.bits`. Thus the +payload of a negative integer is one less than its absolute value. The +machines below perform the required conversion explicitly. +-/ + +namespace BeyondBethe + +open Complexity + +def machineIntegerNegativeAbsBits (word : List Bool) : List Bool := + machineBinaryAddBits (pair word.tail [true]) + +/-- Canonical absolute-value bits from an `integerBinaryCode`. -/ +def machineIntegerNatAbsBits (word : List Bool) : List Bool := + machineIfHead word (machineIntegerNegativeAbsBits word) word.tail + +def machineIntegerNegativePayloadBits (absBits : List Bool) : List Bool := + machineBinarySubBits (pair absBits [true]) + +/-- Input is `pair originalIntegerCode absoluteValueBits`. The output has the +sign of the original integer and the supplied absolute value. -/ +def machineIntegerCodeFromSignedAbs (word : List Bool) : List Bool := + let signCode := machinePairFirst word + let absBits := machinePairSecond word + machineIfHead signCode + (true :: machineIntegerNegativePayloadBits absBits) + (false :: absBits) + +theorem machineIntegerNegativeAbsBits_mem_FP : + machineIntegerNegativeAbsBits ∈ Complexity.FP := by + have hpair : (fun word : List Bool => pair word.tail [true]) ∈ + Complexity.FP := + machinePair_mem_FP machineTail_mem_FP (machineConst_mem_FP [true]) + simpa only [machineIntegerNegativeAbsBits] using + machineCompose_mem_FP hpair machineBinaryAddBits_mem_FP + +theorem machineIntegerNatAbsBits_mem_FP : + machineIntegerNatAbsBits ∈ Complexity.FP := by + simpa only [machineIntegerNatAbsBits] using + machineIfHead_mem_FP id_mem_FP machineIntegerNegativeAbsBits_mem_FP + machineTail_mem_FP + +theorem machineIntegerNegativePayloadBits_mem_FP : + machineIntegerNegativePayloadBits ∈ Complexity.FP := by + have hpair : (fun absBits : List Bool => pair absBits [true]) ∈ + Complexity.FP := + machinePair_mem_FP id_mem_FP (machineConst_mem_FP [true]) + simpa only [machineIntegerNegativePayloadBits] using + machineCompose_mem_FP hpair machineBinarySubBits_mem_FP + +theorem machineIntegerCodeFromSignedAbs_mem_FP : + machineIntegerCodeFromSignedAbs ∈ Complexity.FP := by + have hnegativePayload := machineCompose_mem_FP machinePairSecond_mem_FP + machineIntegerNegativePayloadBits_mem_FP + have hnegative := machineCompose_mem_FP hnegativePayload + (machinePrepend_mem_FP true) + have hpositive := machineCompose_mem_FP machinePairSecond_mem_FP + (machinePrepend_mem_FP false) + simpa only [machineIntegerCodeFromSignedAbs] using + machineIfHead_mem_FP machinePairFirst_mem_FP hnegative hpositive + +theorem machineIntegerNatAbsBits_encode (z : ℤ) : + machineIntegerNatAbsBits (integerBinaryCode z) = z.natAbs.bits := by + cases z with + | ofNat n => simp [machineIntegerNatAbsBits, integerBinaryCode] + | negSucc n => + simp only [machineIntegerNatAbsBits, integerBinaryCode, + machineIfHead_true, machineIntegerNegativeAbsBits, List.tail_cons] + simpa using machineBinaryAddBits_pair_natBits n 1 + +theorem machineIntegerCodeFromSignedAbs_ofNat (n magnitude : ℕ) : + machineIntegerCodeFromSignedAbs + (pair (integerBinaryCode (Int.ofNat n)) magnitude.bits) = + integerBinaryCode (Int.ofNat magnitude) := by + simp [machineIntegerCodeFromSignedAbs, integerBinaryCode] + +theorem machineIntegerCodeFromSignedAbs_negSucc (n magnitude : ℕ) + (hmagnitude : 0 < magnitude) : + machineIntegerCodeFromSignedAbs + (pair (integerBinaryCode (Int.negSucc n)) magnitude.bits) = + integerBinaryCode (-(magnitude : ℤ)) := by + obtain ⟨k, rfl⟩ := Nat.exists_eq_succ_of_ne_zero hmagnitude.ne' + simp only [machineIntegerCodeFromSignedAbs, machinePairFirst_pair, + machinePairSecond_pair, integerBinaryCode, machineIfHead_true, + machineIntegerNegativePayloadBits] + rw [show ([true] : List Bool) = (1 : ℕ).bits by rfl] + rw [machineBinarySubBits_pair_natBits] + have hneg : -((k + 1 : ℕ) : ℤ) = Int.negSucc k := by omega + rw [hneg] + rfl + +/-- Restoring the sign after exact division agrees with the semantic signed +division routine used by `binaryNormalizeRawRat`. -/ +theorem machineIntegerCodeFromSignedAbs_div (z : ℤ) (d : ℕ) + (hd : 0 < d) (hdvd : d ∣ z.natAbs) : + machineIntegerCodeFromSignedAbs + (pair (integerBinaryCode z) (z.natAbs / d).bits) = + integerBinaryCode (binaryIntDivNat z d) := by + cases z with + | ofNat n => + rw [machineIntegerCodeFromSignedAbs_ofNat] + by_cases hn : n = 0 + · subst n + simp [binaryIntDivNat, binaryLongDiv_eq_div_mod] + · obtain ⟨k, rfl⟩ := Nat.exists_eq_succ_of_ne_zero hn + simp [binaryIntDivNat, binaryLongDiv_eq_div_mod] + | negSucc n => + have hle : d ≤ n + 1 := Nat.le_of_dvd (by omega) hdvd + have hquotPos : 0 < (n + 1) / d := Nat.div_pos hle hd + change machineIntegerCodeFromSignedAbs + (pair (integerBinaryCode (Int.negSucc n)) ((n + 1) / d).bits) = _ + rw [machineIntegerCodeFromSignedAbs_negSucc n ((n + 1) / d) hquotPos] + simp [binaryIntDivNat, binaryLongDiv_eq_div_mod] + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineKuhnEncoding.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineKuhnEncoding.lean new file mode 100644 index 0000000000..5931202d93 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineKuhnEncoding.lean @@ -0,0 +1,636 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineUnaryRange + +/-! +# Finite-word encoding of the explicit Kuhn evaluator + +Every natural index is unary. Boolean visited sets and column-mate tables are +right-nested lists, and the recursive continuation is an explicit +right-nested stack. The rational matrix and the dimension-derived fixedValue +words are carried unchanged beside the control word. +-/ + +namespace BeyondBethe + +open Complexity + +/-! ## Semantic tables -/ + +def seenBoolList {n : ℕ} (seen : Finset (Fin n)) : List Bool := + List.ofFn fun i ↦ decide (i ∈ seen) + +def columnMateList {n : ℕ} (mate : ColumnMate n) : List (Option ℕ) := + List.ofFn fun j ↦ (mate j).map Fin.val + +def finListUnaryCode {n : ℕ} (xs : List (Fin n)) : List Bool := + binaryListCode finUnaryCode xs + +@[simp] theorem seenBoolList_length {n : ℕ} (seen : Finset (Fin n)) : + (seenBoolList seen).length = n := by + simp [seenBoolList] + +@[simp] theorem columnMateList_length {n : ℕ} (mate : ColumnMate n) : + (columnMateList mate).length = n := by + simp [columnMateList] + +@[simp] theorem seenBoolList_getElem {n : ℕ} (seen : Finset (Fin n)) + (i : ℕ) (hi : i < (seenBoolList seen).length) : + (seenBoolList seen)[i] = decide (⟨i, by simpa using hi⟩ ∈ seen) := by + simp [seenBoolList] + +@[simp] theorem columnMateList_getElem {n : ℕ} (mate : ColumnMate n) + (i : ℕ) (hi : i < (columnMateList mate).length) : + (columnMateList mate)[i] = + (mate ⟨i, by simpa using hi⟩).map Fin.val := by + simp [columnMateList] + +theorem seenBoolList_insert {n : ℕ} (seen : Finset (Fin n)) (col : Fin n) : + seenBoolList (insert col seen) = + (seenBoolList seen).set col.1 true := by + apply List.ext_get + · simp + · intro i hi hi' + simp only [seenBoolList_length] at hi hi' + by_cases h : i = col.1 + · subst i + simp [seenBoolList] + · have hfin : (⟨i, hi⟩ : Fin n) ≠ col := by + intro heq + exact h (congrArg Fin.val heq) + have hrev : col.1 ≠ i := by exact fun heq ↦ h heq.symm + simp [seenBoolList, List.getElem_set, h, hrev, hfin] + +theorem columnMateList_update {n : ℕ} (mate : ColumnMate n) + (col : Fin n) (value : Option (Fin n)) : + columnMateList (Function.update mate col value) = + (columnMateList mate).set col.1 (value.map Fin.val) := by + apply List.ext_get + · simp + · intro i hi hi' + simp only [columnMateList_length] at hi hi' + by_cases h : i = col.1 + · subst i + simp [columnMateList, Function.update] + · have hfin : (⟨i, hi⟩ : Fin n) ≠ col := by + intro heq + exact h (congrArg Fin.val heq) + have hrev : col.1 ≠ i := by exact fun heq ↦ h heq.symm + simp [columnMateList, Function.update, List.getElem_set, h, hrev, hfin] + +/-! ## Frame codes -/ + +def machineKuhnSearchFramePack + (fuel remaining row mate column : List Bool) : List Bool := + pair fuel (pair remaining (pair row (pair mate column))) + +def machineKuhnBuildFramePack (rows fallback : List Bool) : List Bool := + pair rows fallback + +def kuhnSearchFrameCode {n : ℕ} (frame : KuhnSearchFrame n) : List Bool := + machineKuhnSearchFramePack (List.replicate frame.fuel true) + (finListUnaryCode frame.remaining) (finUnaryCode frame.row) + (mateVectorCode (columnMateList frame.mate)) + (finUnaryCode frame.column) + +def kuhnBuildFrameCode {n : ℕ} (frame : KuhnBuildFrame n) : List Bool := + machineKuhnBuildFramePack (finListUnaryCode frame.rows) + (mateVectorCode (columnMateList frame.fallback)) + +def kuhnFrameCode {n : ℕ} : KuhnFrame n → List Bool + | .search frame => pair [false] (kuhnSearchFrameCode frame) + | .build frame => pair [true] (kuhnBuildFrameCode frame) + +def kuhnStackCode {n : ℕ} (stack : List (KuhnFrame n)) : List Bool := + binaryListCode kuhnFrameCode stack + +def machineKuhnFrameTag (frame : List Bool) : List Bool := + machinePairFirst frame + +def machineKuhnFramePayload (frame : List Bool) : List Bool := + machinePairSecond frame + +def machineKuhnSearchFrameFuel (frame : List Bool) : List Bool := + machinePairFirst (machineKuhnFramePayload frame) + +def machineKuhnSearchFrameRemaining (frame : List Bool) : List Bool := + machinePairFirst (machinePairSecond (machineKuhnFramePayload frame)) + +def machineKuhnSearchFrameRow (frame : List Bool) : List Bool := + machinePairFirst + (machinePairSecond (machinePairSecond (machineKuhnFramePayload frame))) + +def machineKuhnSearchFrameMate (frame : List Bool) : List Bool := + machinePairFirst (machinePairSecond + (machinePairSecond (machinePairSecond (machineKuhnFramePayload frame)))) + +def machineKuhnSearchFrameColumn (frame : List Bool) : List Bool := + machinePairSecond (machinePairSecond + (machinePairSecond (machinePairSecond (machineKuhnFramePayload frame)))) + +def machineKuhnBuildFrameRows (frame : List Bool) : List Bool := + machinePairFirst (machineKuhnFramePayload frame) + +def machineKuhnBuildFrameFallback (frame : List Bool) : List Bool := + machinePairSecond (machineKuhnFramePayload frame) + +def machineKuhnStackHead (stack : List Bool) : List Bool := + machineListHead stack + +def machineKuhnStackTail (stack : List Bool) : List Bool := + machineListTail stack + +def machineKuhnStackPush (frame stack : List Bool) : List Bool := + pair frame stack + +/-! ## Control codes -/ + +def machineKuhnCallPack (fuel remaining row seen mate stack : List Bool) : + List Bool := + pair fuel (pair remaining (pair row (pair seen (pair mate stack)))) + +def machineKuhnReturnPack (success seen mate stack : List Bool) : List Bool := + pair success (pair seen (pair mate stack)) + +def machineKuhnControlCall + (fuel remaining row seen mate stack : List Bool) : List Bool := + pair [false] (machineKuhnCallPack fuel remaining row seen mate stack) + +def machineKuhnControlReturn + (success seen mate stack : List Bool) : List Bool := + pair [true, false] (machineKuhnReturnPack success seen mate stack) + +def machineKuhnControlDone (mate : List Bool) : List Bool := + pair [true, true] mate + +def machineKuhnControlTag (control : List Bool) : List Bool := + machinePairFirst control + +def machineKuhnControlPayload (control : List Bool) : List Bool := + machinePairSecond control + +def machineKuhnControlIsDoneBit (control : List Bool) : List Bool := + machineHeadBit (machineKuhnControlTag control).tail + +def machineKuhnCallFuel (control : List Bool) : List Bool := + machinePairFirst (machineKuhnControlPayload control) + +def machineKuhnCallRemaining (control : List Bool) : List Bool := + machinePairFirst (machinePairSecond (machineKuhnControlPayload control)) + +def machineKuhnCallRow (control : List Bool) : List Bool := + machinePairFirst + (machinePairSecond (machinePairSecond (machineKuhnControlPayload control))) + +def machineKuhnCallSeen (control : List Bool) : List Bool := + machinePairFirst (machinePairSecond + (machinePairSecond (machinePairSecond (machineKuhnControlPayload control)))) + +def machineKuhnCallMate (control : List Bool) : List Bool := + machinePairFirst + (machinePairSecond + (machinePairSecond + (machinePairSecond + (machinePairSecond (machineKuhnControlPayload control))))) + +def machineKuhnCallStack (control : List Bool) : List Bool := + machinePairSecond + (machinePairSecond + (machinePairSecond + (machinePairSecond + (machinePairSecond (machineKuhnControlPayload control))))) + +def machineKuhnReturnSuccess (control : List Bool) : List Bool := + machinePairFirst (machineKuhnControlPayload control) + +def machineKuhnReturnSeen (control : List Bool) : List Bool := + machinePairFirst (machinePairSecond (machineKuhnControlPayload control)) + +def machineKuhnReturnMate (control : List Bool) : List Bool := + machinePairFirst + (machinePairSecond (machinePairSecond (machineKuhnControlPayload control))) + +def machineKuhnReturnStack (control : List Bool) : List Bool := + machinePairSecond + (machinePairSecond (machinePairSecond (machineKuhnControlPayload control))) + +def machineKuhnDoneMate (control : List Bool) : List Bool := + machineKuhnControlPayload control + +def kuhnSearchResultMateCode {n : ℕ} (result : KuhnSearchResult n) : List Bool := + match result.mate? with + | none => [] + | some mate => mateVectorCode (columnMateList mate) + +def kuhnControlCode {n : ℕ} : KuhnEvalState n → List Bool + | .call fuel remaining row seen mate stack => + machineKuhnControlCall (List.replicate fuel true) + (finListUnaryCode remaining) (finUnaryCode row) + (boolVectorCode (seenBoolList seen)) + (mateVectorCode (columnMateList mate)) (kuhnStackCode stack) + | .ret result stack => + machineKuhnControlReturn [result.mate?.isSome] + (boolVectorCode (seenBoolList result.seen)) + (kuhnSearchResultMateCode result) (kuhnStackCode stack) + | .done mate => + machineKuhnControlDone (mateVectorCode (columnMateList mate)) + +/-! ## Whole-state code and projections -/ + +def machineKuhnStatePack + (control matrix dimension columns falseSeen bound : List Bool) : List Bool := + pair control + (pair matrix (pair dimension (pair columns (pair falseSeen bound)))) + +def machineKuhnStateControl (state : List Bool) : List Bool := + machinePairFirst state + +def machineKuhnStateMatrix (state : List Bool) : List Bool := + machinePairFirst (machinePairSecond state) + +def machineKuhnStateDimension (state : List Bool) : List Bool := + machinePairFirst (machinePairSecond (machinePairSecond state)) + +def machineKuhnStateColumns (state : List Bool) : List Bool := + machinePairFirst + (machinePairSecond (machinePairSecond (machinePairSecond state))) + +def machineKuhnStateFalseSeen (state : List Bool) : List Bool := + machinePairFirst (machinePairSecond + (machinePairSecond (machinePairSecond (machinePairSecond state)))) + +def machineKuhnStateBound (state : List Bool) : List Bool := + machinePairSecond (machinePairSecond + (machinePairSecond (machinePairSecond (machinePairSecond state)))) + +def machineKuhnInputBound (matrix : List Bool) : List Bool := + machineBinaryMulWidth (machineListUpdateInputBound matrix) + +def kuhnMachineStateCode {n : ℕ} (A : Matrix (Fin n) (Fin n) ℚ) + (state : KuhnEvalState n) : List Bool := + let matrix := rationalMatrixBinaryEncoding.encode ⟨n, A⟩ + let dimension := List.replicate n true + machineKuhnStatePack (kuhnControlCode state) matrix dimension + (finRangeUnaryCode n) + (boolVectorCode (List.replicate n false)) + (machineKuhnInputBound matrix) + +@[simp] theorem machineKuhnStateControl_pack (a b c d e f) : + machineKuhnStateControl (machineKuhnStatePack a b c d e f) = a := by + simp [machineKuhnStateControl, machineKuhnStatePack] + +@[simp] theorem machineKuhnStateMatrix_pack (a b c d e f) : + machineKuhnStateMatrix (machineKuhnStatePack a b c d e f) = b := by + simp [machineKuhnStateMatrix, machineKuhnStatePack] + +@[simp] theorem machineKuhnStateDimension_pack (a b c d e f) : + machineKuhnStateDimension (machineKuhnStatePack a b c d e f) = c := by + simp [machineKuhnStateDimension, machineKuhnStatePack] + +@[simp] theorem machineKuhnStateColumns_pack (a b c d e f) : + machineKuhnStateColumns (machineKuhnStatePack a b c d e f) = d := by + simp [machineKuhnStateColumns, machineKuhnStatePack] + +@[simp] theorem machineKuhnStateFalseSeen_pack (a b c d e f) : + machineKuhnStateFalseSeen (machineKuhnStatePack a b c d e f) = e := by + simp [machineKuhnStateFalseSeen, machineKuhnStatePack] + +@[simp] theorem machineKuhnStateBound_pack (a b c d e f) : + machineKuhnStateBound (machineKuhnStatePack a b c d e f) = f := by + simp [machineKuhnStateBound, machineKuhnStatePack] + +@[simp] theorem machineKuhnControlTag_call (a b c d e f) : + machineKuhnControlTag (machineKuhnControlCall a b c d e f) = [false] := by + simp [machineKuhnControlTag, machineKuhnControlCall] + +@[simp] theorem machineKuhnControlTag_return (a b c d) : + machineKuhnControlTag (machineKuhnControlReturn a b c d) = + [true, false] := by + simp [machineKuhnControlTag, machineKuhnControlReturn] + +@[simp] theorem machineKuhnControlTag_done (a) : + machineKuhnControlTag (machineKuhnControlDone a) = [true, true] := by + simp [machineKuhnControlTag, machineKuhnControlDone] + +@[simp] theorem machineKuhnControlIsDoneBit_call (a b c d e f) : + machineKuhnControlIsDoneBit (machineKuhnControlCall a b c d e f) = + [false] := by + simp [machineKuhnControlIsDoneBit] + +@[simp] theorem machineKuhnControlIsDoneBit_return (a b c d) : + machineKuhnControlIsDoneBit (machineKuhnControlReturn a b c d) = + [false] := by + simp [machineKuhnControlIsDoneBit] + +@[simp] theorem machineKuhnControlIsDoneBit_done (a) : + machineKuhnControlIsDoneBit (machineKuhnControlDone a) = [true] := by + simp [machineKuhnControlIsDoneBit] + +@[simp] theorem machineKuhnCallFuel_pack (a b c d e f) : + machineKuhnCallFuel (machineKuhnControlCall a b c d e f) = a := by + simp [machineKuhnCallFuel, machineKuhnControlCall, + machineKuhnControlPayload, machineKuhnCallPack] + +@[simp] theorem machineKuhnCallRemaining_pack (a b c d e f) : + machineKuhnCallRemaining (machineKuhnControlCall a b c d e f) = b := by + simp [machineKuhnCallRemaining, machineKuhnControlCall, + machineKuhnControlPayload, machineKuhnCallPack] + +@[simp] theorem machineKuhnCallRow_pack (a b c d e f) : + machineKuhnCallRow (machineKuhnControlCall a b c d e f) = c := by + simp [machineKuhnCallRow, machineKuhnControlCall, + machineKuhnControlPayload, machineKuhnCallPack] + +@[simp] theorem machineKuhnCallSeen_pack (a b c d e f) : + machineKuhnCallSeen (machineKuhnControlCall a b c d e f) = d := by + simp [machineKuhnCallSeen, machineKuhnControlCall, + machineKuhnControlPayload, machineKuhnCallPack] + +@[simp] theorem machineKuhnCallMate_pack (a b c d e f) : + machineKuhnCallMate (machineKuhnControlCall a b c d e f) = e := by + simp [machineKuhnCallMate, machineKuhnControlCall, + machineKuhnControlPayload, machineKuhnCallPack] + +@[simp] theorem machineKuhnCallStack_pack (a b c d e f) : + machineKuhnCallStack (machineKuhnControlCall a b c d e f) = f := by + simp [machineKuhnCallStack, machineKuhnControlCall, + machineKuhnControlPayload, machineKuhnCallPack] + +@[simp] theorem machineKuhnReturnSuccess_pack (a b c d) : + machineKuhnReturnSuccess (machineKuhnControlReturn a b c d) = a := by + simp [machineKuhnReturnSuccess, machineKuhnControlReturn, + machineKuhnControlPayload, machineKuhnReturnPack] + +@[simp] theorem machineKuhnReturnSeen_pack (a b c d) : + machineKuhnReturnSeen (machineKuhnControlReturn a b c d) = b := by + simp [machineKuhnReturnSeen, machineKuhnControlReturn, + machineKuhnControlPayload, machineKuhnReturnPack] + +@[simp] theorem machineKuhnReturnMate_pack (a b c d) : + machineKuhnReturnMate (machineKuhnControlReturn a b c d) = c := by + simp [machineKuhnReturnMate, machineKuhnControlReturn, + machineKuhnControlPayload, machineKuhnReturnPack] + +@[simp] theorem machineKuhnReturnStack_pack (a b c d) : + machineKuhnReturnStack (machineKuhnControlReturn a b c d) = d := by + simp [machineKuhnReturnStack, machineKuhnControlReturn, + machineKuhnControlPayload, machineKuhnReturnPack] + +@[simp] theorem machineKuhnDoneMate_pack (a) : + machineKuhnDoneMate (machineKuhnControlDone a) = a := by + simp [machineKuhnDoneMate, machineKuhnControlDone, + machineKuhnControlPayload] + +@[simp] theorem machineKuhnFrameTag_search (a b c d e) : + machineKuhnFrameTag + (pair [false] (machineKuhnSearchFramePack a b c d e)) = [false] := by + simp [machineKuhnFrameTag] + +@[simp] theorem machineKuhnFrameTag_build (a b) : + machineKuhnFrameTag + (pair [true] (machineKuhnBuildFramePack a b)) = [true] := by + simp [machineKuhnFrameTag] + +@[simp] theorem machineKuhnSearchFrameFuel_pack (a b c d e) : + machineKuhnSearchFrameFuel + (pair [false] (machineKuhnSearchFramePack a b c d e)) = a := by + simp [machineKuhnSearchFrameFuel, machineKuhnFramePayload, + machineKuhnSearchFramePack] + +@[simp] theorem machineKuhnSearchFrameRemaining_pack (a b c d e) : + machineKuhnSearchFrameRemaining + (pair [false] (machineKuhnSearchFramePack a b c d e)) = b := by + simp [machineKuhnSearchFrameRemaining, machineKuhnFramePayload, + machineKuhnSearchFramePack] + +@[simp] theorem machineKuhnSearchFrameRow_pack (a b c d e) : + machineKuhnSearchFrameRow + (pair [false] (machineKuhnSearchFramePack a b c d e)) = c := by + simp [machineKuhnSearchFrameRow, machineKuhnFramePayload, + machineKuhnSearchFramePack] + +@[simp] theorem machineKuhnSearchFrameMate_pack (a b c d e) : + machineKuhnSearchFrameMate + (pair [false] (machineKuhnSearchFramePack a b c d e)) = d := by + simp [machineKuhnSearchFrameMate, machineKuhnFramePayload, + machineKuhnSearchFramePack] + +@[simp] theorem machineKuhnSearchFrameColumn_pack (a b c d e) : + machineKuhnSearchFrameColumn + (pair [false] (machineKuhnSearchFramePack a b c d e)) = e := by + simp [machineKuhnSearchFrameColumn, machineKuhnFramePayload, + machineKuhnSearchFramePack] + +@[simp] theorem machineKuhnBuildFrameRows_pack (a b) : + machineKuhnBuildFrameRows + (pair [true] (machineKuhnBuildFramePack a b)) = a := by + simp [machineKuhnBuildFrameRows, machineKuhnFramePayload, + machineKuhnBuildFramePack] + +@[simp] theorem machineKuhnBuildFrameFallback_pack (a b) : + machineKuhnBuildFrameFallback + (pair [true] (machineKuhnBuildFramePack a b)) = b := by + simp [machineKuhnBuildFrameFallback, machineKuhnFramePayload, + machineKuhnBuildFramePack] + +@[simp] theorem machineKuhnStackHead_cons {n : ℕ} + (frame : KuhnFrame n) (stack : List (KuhnFrame n)) : + machineKuhnStackHead (kuhnStackCode (frame :: stack)) = + kuhnFrameCode frame := by + exact machineListHead_cons kuhnFrameCode frame stack + +@[simp] theorem machineKuhnStackTail_cons {n : ℕ} + (frame : KuhnFrame n) (stack : List (KuhnFrame n)) : + machineKuhnStackTail (kuhnStackCode (frame :: stack)) = + kuhnStackCode stack := by + exact machineListTail_cons kuhnFrameCode frame stack + +/-! The projections below are all fixedValue-depth pairing operations. -/ + +theorem machineKuhnStateControl_mem_FP : + machineKuhnStateControl ∈ Complexity.FP := machinePairFirst_mem_FP +theorem machineKuhnStateMatrix_mem_FP : + machineKuhnStateMatrix ∈ Complexity.FP := by + simpa only [machineKuhnStateMatrix] using + machineCompose_mem_FP machinePairSecond_mem_FP machinePairFirst_mem_FP +theorem machineKuhnStateDimension_mem_FP : + machineKuhnStateDimension ∈ Complexity.FP := by + have h := machineCompose_mem_FP machinePairSecond_mem_FP + machinePairSecond_mem_FP + simpa only [machineKuhnStateDimension] using + machineCompose_mem_FP h machinePairFirst_mem_FP +theorem machineKuhnStateColumns_mem_FP : + machineKuhnStateColumns ∈ Complexity.FP := by + have h2 := machineCompose_mem_FP machinePairSecond_mem_FP + machinePairSecond_mem_FP + have h3 := machineCompose_mem_FP h2 machinePairSecond_mem_FP + simpa only [machineKuhnStateColumns] using + machineCompose_mem_FP h3 machinePairFirst_mem_FP +theorem machineKuhnStateFalseSeen_mem_FP : + machineKuhnStateFalseSeen ∈ Complexity.FP := by + have h2 := machineCompose_mem_FP machinePairSecond_mem_FP + machinePairSecond_mem_FP + have h3 := machineCompose_mem_FP h2 machinePairSecond_mem_FP + have h4 := machineCompose_mem_FP h3 machinePairSecond_mem_FP + simpa only [machineKuhnStateFalseSeen] using + machineCompose_mem_FP h4 machinePairFirst_mem_FP +theorem machineKuhnStateBound_mem_FP : + machineKuhnStateBound ∈ Complexity.FP := by + have h2 := machineCompose_mem_FP machinePairSecond_mem_FP + machinePairSecond_mem_FP + have h3 := machineCompose_mem_FP h2 machinePairSecond_mem_FP + have h4 := machineCompose_mem_FP h3 machinePairSecond_mem_FP + simpa only [machineKuhnStateBound] using + machineCompose_mem_FP h4 machinePairSecond_mem_FP +theorem machineKuhnFrameTag_mem_FP : + machineKuhnFrameTag ∈ Complexity.FP := machinePairFirst_mem_FP +theorem machineKuhnFramePayload_mem_FP : + machineKuhnFramePayload ∈ Complexity.FP := machinePairSecond_mem_FP +theorem machineKuhnStackHead_mem_FP : + machineKuhnStackHead ∈ Complexity.FP := machineListHead_mem_FP +theorem machineKuhnStackTail_mem_FP : + machineKuhnStackTail ∈ Complexity.FP := machineListTail_mem_FP +theorem machineKuhnControlTag_mem_FP : + machineKuhnControlTag ∈ Complexity.FP := machinePairFirst_mem_FP +theorem machineKuhnControlPayload_mem_FP : + machineKuhnControlPayload ∈ Complexity.FP := machinePairSecond_mem_FP + +def machinePairSecondN (depth : ℕ) (word : List Bool) : List Bool := + (machinePairSecond)^[depth] word + +theorem machinePairSecondN_mem_FP (depth : ℕ) : + machinePairSecondN depth ∈ Complexity.FP := by + induction depth with + | zero => simpa [machinePairSecondN] using id_mem_FP + | succ depth ih => + simpa [machinePairSecondN, Function.iterate_succ_apply] using + machineCompose_mem_FP machinePairSecond_mem_FP ih + +theorem machineKuhnControlIsDoneBit_mem_FP : + machineKuhnControlIsDoneBit ∈ Complexity.FP := by + have htagTail := machineCompose_mem_FP + (machineCompose_mem_FP machineKuhnControlTag_mem_FP machineTail_mem_FP) + machineHeadBit_mem_FP + simpa only [machineKuhnControlIsDoneBit] using htagTail + +theorem machineKuhnCallFuel_mem_FP : + machineKuhnCallFuel ∈ Complexity.FP := by + have h := machineCompose_mem_FP (machinePairSecondN_mem_FP 1) + machinePairFirst_mem_FP + simpa [machineKuhnCallFuel, machineKuhnControlPayload, + machinePairSecondN, Function.iterate_succ_apply'] using h + +theorem machineKuhnCallRemaining_mem_FP : + machineKuhnCallRemaining ∈ Complexity.FP := by + have h := machineCompose_mem_FP (machinePairSecondN_mem_FP 2) + machinePairFirst_mem_FP + simpa [machineKuhnCallRemaining, machineKuhnControlPayload, + machinePairSecondN, Function.iterate_succ_apply'] using h + +theorem machineKuhnCallRow_mem_FP : + machineKuhnCallRow ∈ Complexity.FP := by + have h := machineCompose_mem_FP (machinePairSecondN_mem_FP 3) + machinePairFirst_mem_FP + simpa [machineKuhnCallRow, machineKuhnControlPayload, + machinePairSecondN, Function.iterate_succ_apply'] using h + +theorem machineKuhnCallSeen_mem_FP : + machineKuhnCallSeen ∈ Complexity.FP := by + have h := machineCompose_mem_FP (machinePairSecondN_mem_FP 4) + machinePairFirst_mem_FP + simpa [machineKuhnCallSeen, machineKuhnControlPayload, + machinePairSecondN, Function.iterate_succ_apply'] using h + +theorem machineKuhnCallMate_mem_FP : + machineKuhnCallMate ∈ Complexity.FP := by + have h := machineCompose_mem_FP (machinePairSecondN_mem_FP 5) + machinePairFirst_mem_FP + simpa [machineKuhnCallMate, machineKuhnControlPayload, + machinePairSecondN, Function.iterate_succ_apply'] using h + +theorem machineKuhnCallStack_mem_FP : + machineKuhnCallStack ∈ Complexity.FP := by + simpa [machineKuhnCallStack, machineKuhnControlPayload, + machinePairSecondN, Function.iterate_succ_apply'] using + machinePairSecondN_mem_FP 6 + +theorem machineKuhnReturnSuccess_mem_FP : + machineKuhnReturnSuccess ∈ Complexity.FP := by + have h := machineCompose_mem_FP (machinePairSecondN_mem_FP 1) + machinePairFirst_mem_FP + simpa [machineKuhnReturnSuccess, machineKuhnControlPayload, + machinePairSecondN, Function.iterate_succ_apply'] using h + +theorem machineKuhnReturnSeen_mem_FP : + machineKuhnReturnSeen ∈ Complexity.FP := by + have h := machineCompose_mem_FP (machinePairSecondN_mem_FP 2) + machinePairFirst_mem_FP + simpa [machineKuhnReturnSeen, machineKuhnControlPayload, + machinePairSecondN, Function.iterate_succ_apply'] using h + +theorem machineKuhnReturnMate_mem_FP : + machineKuhnReturnMate ∈ Complexity.FP := by + have h := machineCompose_mem_FP (machinePairSecondN_mem_FP 3) + machinePairFirst_mem_FP + simpa [machineKuhnReturnMate, machineKuhnControlPayload, + machinePairSecondN, Function.iterate_succ_apply'] using h + +theorem machineKuhnReturnStack_mem_FP : + machineKuhnReturnStack ∈ Complexity.FP := by + simpa [machineKuhnReturnStack, machineKuhnControlPayload, + machinePairSecondN, Function.iterate_succ_apply'] using + machinePairSecondN_mem_FP 4 + +theorem machineKuhnDoneMate_mem_FP : + machineKuhnDoneMate ∈ Complexity.FP := machinePairSecond_mem_FP + +theorem machineKuhnSearchFrameFuel_mem_FP : + machineKuhnSearchFrameFuel ∈ Complexity.FP := by + have h := machineCompose_mem_FP (machinePairSecondN_mem_FP 1) + machinePairFirst_mem_FP + simpa [machineKuhnSearchFrameFuel, machineKuhnFramePayload, + machinePairSecondN, Function.iterate_succ_apply'] using h + +theorem machineKuhnSearchFrameRemaining_mem_FP : + machineKuhnSearchFrameRemaining ∈ Complexity.FP := by + have h := machineCompose_mem_FP (machinePairSecondN_mem_FP 2) + machinePairFirst_mem_FP + simpa [machineKuhnSearchFrameRemaining, machineKuhnFramePayload, + machinePairSecondN, Function.iterate_succ_apply'] using h + +theorem machineKuhnSearchFrameRow_mem_FP : + machineKuhnSearchFrameRow ∈ Complexity.FP := by + have h := machineCompose_mem_FP (machinePairSecondN_mem_FP 3) + machinePairFirst_mem_FP + simpa [machineKuhnSearchFrameRow, machineKuhnFramePayload, + machinePairSecondN, Function.iterate_succ_apply'] using h + +theorem machineKuhnSearchFrameMate_mem_FP : + machineKuhnSearchFrameMate ∈ Complexity.FP := by + have h := machineCompose_mem_FP (machinePairSecondN_mem_FP 4) + machinePairFirst_mem_FP + simpa [machineKuhnSearchFrameMate, machineKuhnFramePayload, + machinePairSecondN, Function.iterate_succ_apply'] using h + +theorem machineKuhnSearchFrameColumn_mem_FP : + machineKuhnSearchFrameColumn ∈ Complexity.FP := by + simpa [machineKuhnSearchFrameColumn, machineKuhnFramePayload, + machinePairSecondN, Function.iterate_succ_apply'] using + machinePairSecondN_mem_FP 5 + +theorem machineKuhnBuildFrameRows_mem_FP : + machineKuhnBuildFrameRows ∈ Complexity.FP := by + have h := machineCompose_mem_FP machinePairSecond_mem_FP + machinePairFirst_mem_FP + simpa [machineKuhnBuildFrameRows, machineKuhnFramePayload] using h + +theorem machineKuhnBuildFrameFallback_mem_FP : + machineKuhnBuildFrameFallback ∈ Complexity.FP := by + simpa [machineKuhnBuildFrameFallback, machineKuhnFramePayload] using + machineCompose_mem_FP machinePairSecond_mem_FP machinePairSecond_mem_FP + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineKuhnInvariant.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineKuhnInvariant.lean new file mode 100644 index 0000000000..33e11c9f81 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineKuhnInvariant.lean @@ -0,0 +1,589 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineKuhnSemantics +import LeanPool.BeyondBethe.BeyondBethe.MachineMatrixDimension +import Mathlib.Tactic + +/-! +# Reachable-state bounds for the encoded Kuhn evaluator + +The finite-word transition clamps every dynamic field to one fixed word. This +file proves that the clamp is inactive along the canonical execution. We use +a deliberately generous octic envelope; its only purpose is to make the +polynomial-space estimate transparent. +-/ + +namespace BeyondBethe + +open Complexity + +/-! ## A semantic invariant -/ + +def KuhnFrameDataBound (n : ℕ) : KuhnFrame n → Prop + | .search frame => frame.fuel ≤ n + 1 ∧ frame.remaining.length ≤ n + | .build frame => frame.rows.length ≤ n + +def KuhnStackDataBound {n : ℕ} (stack : List (KuhnFrame n)) : Prop := + ∀ frame ∈ stack, KuhnFrameDataBound n frame + +def KuhnEvalReachableBound {n : ℕ} (steps : ℕ) : + KuhnEvalState n → Prop + | .call fuel remaining _row _seen _mate stack => + fuel ≤ n + 1 ∧ remaining.length ≤ n ∧ + KuhnStackDataBound stack ∧ stack.length ≤ steps + 1 + | .ret _result stack => + KuhnStackDataBound stack ∧ stack.length ≤ steps + 1 + | .done _mate => True + +theorem kuhnStackDataBound_tail {n : ℕ} {frame : KuhnFrame n} + {stack : List (KuhnFrame n)} + (h : KuhnStackDataBound (frame :: stack)) : + KuhnStackDataBound stack := by + intro next hnext + exact h next (by simp [hnext]) + +theorem kuhnEvalStep_reachableBound {n steps : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) (state : KuhnEvalState n) + (hstate : KuhnEvalReachableBound steps state) : + KuhnEvalReachableBound (steps + 1) (kuhnEvalStep A state) := by + cases state with + | done mate => trivial + | call fuel remaining row seen mate stack => + rcases hstate with ⟨hfuel, hremaining, hstack, hlength⟩ + cases fuel with + | zero => + exact ⟨hstack, by omega⟩ + | succ fuel => + cases remaining with + | nil => + exact ⟨hstack, by omega⟩ + | cons col remaining => + simp only [List.length_cons] at hremaining + by_cases hskip : col ∈ seen ∨ A row col = 0 + · simp only [kuhnEvalStep, hskip, ↓reduceIte] + exact ⟨hfuel, by omega, hstack, by omega⟩ + · simp only [kuhnEvalStep, hskip, ↓reduceIte] + cases hmate : mate col with + | none => + exact ⟨hstack, by omega⟩ + | some oldRow => + refine ⟨by omega, by simp, ?_, by simp; omega⟩ + intro frame hframe + simp only [List.mem_cons] at hframe + rcases hframe with rfl | hframe + · change fuel + 1 ≤ n + 1 ∧ remaining.length ≤ n + exact ⟨hfuel, by omega⟩ + · exact hstack frame hframe + | ret result stack => + rcases hstate with ⟨hstack, hlength⟩ + cases stack with + | nil => exact ⟨by simp [KuhnStackDataBound], by omega⟩ + | cons frame stack => + have htail := kuhnStackDataBound_tail hstack + have hframe := hstack frame (by simp) + cases frame with + | search frame => + rcases hframe with ⟨hfuel, hremaining⟩ + cases hmate : result.mate? with + | none => + simp only [kuhnEvalStep, hmate] + exact ⟨hfuel, hremaining, htail, by simp at hlength ⊢; omega⟩ + | some mate => + simp only [kuhnEvalStep, hmate] + exact ⟨htail, by simp at hlength ⊢; omega⟩ + | build frame => + rcases frame with ⟨rows, fallback⟩ + change rows.length ≤ n at hframe + cases hmate : result.mate? with + | none => + cases rows with + | nil => simp [kuhnEvalStep, hmate, KuhnEvalReachableBound] + | cons row rows => + simp only [List.length_cons] at hframe + simp only [kuhnEvalStep, hmate] + refine ⟨by omega, by simp, ?_, by simp at hlength ⊢; omega⟩ + intro next hnext + simp only [List.mem_cons] at hnext + rcases hnext with rfl | hnext + · change rows.length ≤ n + omega + · exact htail next hnext + | some mate => + cases rows with + | nil => simp [kuhnEvalStep, hmate, KuhnEvalReachableBound] + | cons row rows => + simp only [List.length_cons] at hframe + simp only [kuhnEvalStep, hmate] + refine ⟨by omega, by simp, ?_, by simp at hlength ⊢; omega⟩ + intro next hnext + simp only [List.mem_cons] at hnext + rcases hnext with rfl | hnext + · change rows.length ≤ n + omega + · exact htail next hnext + +theorem kuhnBuildEvalState_reachableBound {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) (rows : List (Fin n)) + (mate : ColumnMate n) (hrows : rows.length ≤ n) : + KuhnEvalReachableBound 0 (kuhnBuildEvalState A rows mate) := by + cases rows with + | nil => trivial + | cons row rows => + simp only [List.length_cons] at hrows + refine ⟨by omega, by simp, ?_, by simp⟩ + intro frame hframe + simp only [List.mem_singleton] at hframe + subst frame + change rows.length ≤ n + omega + +theorem kuhnFullBuildEvalState_reachableBound {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) : + KuhnEvalReachableBound 0 + (kuhnBuildEvalState A (List.finRange n) (emptyColumnMate n)) := by + exact kuhnBuildEvalState_reachableBound A _ _ (by simp) + +theorem kuhnEvalIterate_reachableBound {n steps : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) (state : KuhnEvalState n) + (hstate : KuhnEvalReachableBound 0 state) : + KuhnEvalReachableBound steps ((kuhnEvalStep A)^[steps] state) := by + induction steps with + | zero => simpa using hstate + | succ steps ih => + rw [Function.iterate_succ_apply'] + simpa [Nat.succ_eq_add_one] using + kuhnEvalStep_reachableBound A _ ih + +/-! ## Length of canonical control words -/ + +theorem finUnaryCode_length_le {n : ℕ} (i : Fin n) : + (finUnaryCode i).length ≤ n := by + simp [finUnaryCode] + +theorem finListUnaryCode_length_le {n : ℕ} (xs : List (Fin n)) : + (finListUnaryCode xs).length ≤ xs.length * (2 * n + 2) := by + induction xs with + | nil => simp [finListUnaryCode, binaryListCode] + | cons i xs ih => + simp only [finListUnaryCode, binaryListCode, pair_length, + List.length_cons] + have hi := finUnaryCode_length_le i + change 2 * (finUnaryCode i).length + 2 + + (binaryListCode finUnaryCode xs).length ≤ + (xs.length + 1) * (2 * n + 2) + change (binaryListCode finUnaryCode xs).length ≤ + xs.length * (2 * n + 2) at ih + nlinarith + +@[simp] theorem boolVectorCode_length (v : List Bool) : + (boolVectorCode v).length = 4 * v.length := by + induction v with + | nil => simp [boolVectorCode, binaryListCode] + | cons bit v ih => + change (binaryListCode boolElementCode v).length = 4 * v.length at ih + simp [boolVectorCode, binaryListCode, boolElementCode, ih] + omega + +theorem mateVectorCode_columnMate_length_le {n : ℕ} + (mate : ColumnMate n) : + (mateVectorCode (columnMateList mate)).length ≤ n * (2 * n + 4) := by + rw [mateVectorCode, binaryListCode_length_eq_sum] + have heach : ∀ value ∈ columnMateList mate, + 2 * (mateValueCode value).length + 2 ≤ 2 * n + 4 := by + intro value hvalue + rw [columnMateList] at hvalue + obtain ⟨j, rfl⟩ := List.mem_ofFn.mp hvalue + cases hmate : mate j with + | none => simp [mateValueCode, hmate] + | some row => + simp [mateValueCode, hmate] + omega + calc + ((columnMateList mate).map + (fun value ↦ 2 * (mateValueCode value).length + 2)).sum ≤ + (columnMateList mate).length * (2 * n + 4) := by + simpa [Nat.nsmul_eq_mul] using + List.sum_le_card_nsmul + ((columnMateList mate).map + (fun value ↦ 2 * (mateValueCode value).length + 2)) + (2 * n + 4) (by + intro value hvalue + obtain ⟨source, hsource, rfl⟩ := List.mem_map.mp hvalue + exact heach source hsource) + _ = n * (2 * n + 4) := by simp + +theorem kuhnFrameCode_length_le {n : ℕ} (frame : KuhnFrame n) + (hframe : KuhnFrameDataBound n frame) : + (kuhnFrameCode frame).length ≤ 16 * (n + 1) ^ 2 := by + cases frame with + | search frame => + rcases hframe with ⟨hfuel, hremaining⟩ + have hrem := finListUnaryCode_length_le frame.remaining + have hrem' : (finListUnaryCode frame.remaining).length ≤ + n * (2 * n + 2) := by + exact hrem.trans (Nat.mul_le_mul_right (2 * n + 2) hremaining) + have hrow := finUnaryCode_length_le frame.row + have hcol := finUnaryCode_length_le frame.column + have hmate := mateVectorCode_columnMate_length_le frame.mate + simp only [kuhnFrameCode, kuhnSearchFrameCode, + machineKuhnSearchFramePack, pair_length] + simp only [List.length_singleton, List.length_replicate] + nlinarith [sq_nonneg (n : ℤ)] + | build frame => + have hrem := finListUnaryCode_length_le frame.rows + have hrem' : (finListUnaryCode frame.rows).length ≤ + n * (2 * n + 2) := by + exact hrem.trans (Nat.mul_le_mul_right (2 * n + 2) hframe) + have hmate := mateVectorCode_columnMate_length_le frame.fallback + simp only [kuhnFrameCode, kuhnBuildFrameCode, + machineKuhnBuildFramePack, pair_length, List.length_singleton] + nlinarith [sq_nonneg (n : ℤ)] + +theorem kuhnStackCode_length_le {n : ℕ} (stack : List (KuhnFrame n)) + (hstack : KuhnStackDataBound stack) : + (kuhnStackCode stack).length ≤ + 34 * (n + 1) ^ 2 * stack.length := by + induction stack with + | nil => simp [kuhnStackCode, binaryListCode] + | cons frame stack ih => + have hframe := kuhnFrameCode_length_le frame (hstack frame (by simp)) + have htail : KuhnStackDataBound stack := + kuhnStackDataBound_tail hstack + have ih' := ih htail + simp only [kuhnStackCode, binaryListCode, pair_length, + List.length_cons] + change 2 * (kuhnFrameCode frame).length + 2 + + (binaryListCode kuhnFrameCode stack).length ≤ + 34 * (n + 1) ^ 2 * (stack.length + 1) + change (binaryListCode kuhnFrameCode stack).length ≤ + 34 * (n + 1) ^ 2 * stack.length at ih' + have hone : 1 ≤ (n + 1) ^ 2 := + Nat.one_le_pow 2 (n + 1) (by omega) + have hframeContribution : + 2 * (kuhnFrameCode frame).length + 2 ≤ + 34 * (n + 1) ^ 2 := by nlinarith + calc + 2 * (kuhnFrameCode frame).length + 2 + + (binaryListCode kuhnFrameCode stack).length ≤ + 34 * (n + 1) ^ 2 + + 34 * (n + 1) ^ 2 * stack.length := by omega + _ = 34 * (n + 1) ^ 2 * (stack.length + 1) := by ring + +theorem kuhnControlCode_length_le {n steps : ℕ} + (state : KuhnEvalState n) + (hstate : KuhnEvalReachableBound steps state) : + (kuhnControlCode state).length ≤ + 50 * (steps + 1) * (n + 1) ^ 2 := by + cases state with + | call fuel remaining row seen mate stack => + rcases hstate with ⟨hfuel, hremaining, hstack, hstackLength⟩ + have hrem := finListUnaryCode_length_le remaining + have hrem' : (finListUnaryCode remaining).length ≤ + n * (2 * n + 2) := + hrem.trans (Nat.mul_le_mul_right (2 * n + 2) hremaining) + have hrow := finUnaryCode_length_le row + have hseen : (boolVectorCode (seenBoolList seen)).length = 4 * n := by + simp + have hmate := mateVectorCode_columnMate_length_le mate + have hstackCode := kuhnStackCode_length_le stack hstack + have hstackCode' : (kuhnStackCode stack).length ≤ + 34 * (n + 1) ^ 2 * (steps + 1) := + hstackCode.trans + (Nat.mul_le_mul_left (34 * (n + 1) ^ 2) hstackLength) + simp only [kuhnControlCode, machineKuhnControlCall, + machineKuhnCallPack, pair_length, List.length_singleton, + List.length_replicate] + nlinarith [sq_nonneg (n : ℤ)] + | ret result stack => + rcases hstate with ⟨hstack, hstackLength⟩ + have hseen : (boolVectorCode (seenBoolList result.seen)).length = + 4 * n := by simp + have hmate : (kuhnSearchResultMateCode result).length ≤ + n * (2 * n + 4) := by + cases hmateEq : result.mate? with + | none => simp [kuhnSearchResultMateCode, hmateEq] + | some mate => simpa [kuhnSearchResultMateCode, hmateEq] using + mateVectorCode_columnMate_length_le mate + have hstackCode := kuhnStackCode_length_le stack hstack + have hstackCode' : (kuhnStackCode stack).length ≤ + 34 * (n + 1) ^ 2 * (steps + 1) := + hstackCode.trans + (Nat.mul_le_mul_left (34 * (n + 1) ^ 2) hstackLength) + simp only [kuhnControlCode, machineKuhnControlReturn, + machineKuhnReturnPack, pair_length, List.length_cons, + List.length_nil] + nlinarith [sq_nonneg (n : ℤ)] + | done mate => + have hmate := mateVectorCode_columnMate_length_le mate + simp only [kuhnControlCode, machineKuhnControlDone, pair_length, + List.length_cons, List.length_nil] + nlinarith [sq_nonneg (n : ℤ)] + +/-! ## The fixed octic envelope -/ + +def kuhnMachineStepBudget (n : ℕ) : ℕ := + 3 * (n * (n + (n + 1) * n)) + 2 * n + +theorem kuhnFullBuildSteps_le_budget {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) : + kuhnBuildSteps A (List.finRange n) (emptyColumnMate n) ≤ + kuhnMachineStepBudget n := by + exact kuhnFullBuildSteps_le A + +theorem kuhnMachineInputBound_eighthPower (word : List Bool) : + (word.length + 16) ^ 8 ≤ (machineKuhnInputBound word).length := by + simp only [machineKuhnInputBound, machineListUpdateInputBound, + machineBinaryMulWidth, List.length_replicate, List.length_append] + ring_nf + omega + +theorem kuhnControlPolynomial_le_eighthPower (n : ℕ) : + 50 * (kuhnMachineStepBudget n + 1) * (n + 1) ^ 2 ≤ + (n + 16) ^ 8 := by + simp only [kuhnMachineStepBudget] + ring_nf + omega + +theorem kuhnQuadraticContext_le_eighthPower (n : ℕ) : + n * (2 * n + 2) ≤ (n + 16) ^ 8 := by + ring_nf + omega + +theorem kuhnLinearContext_le_eighthPower (n : ℕ) : + 4 * n ≤ (n + 16) ^ 8 := by + ring_nf + omega + +theorem kuhnMatrixLength_le_eighthPower (length : ℕ) : + length ≤ (length + 16) ^ 8 := by + ring_nf + omega + +theorem kuhnControlCode_length_le_inputBound {n steps : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) (state : KuhnEvalState n) + (hstate : KuhnEvalReachableBound steps state) + (hsteps : steps ≤ kuhnMachineStepBudget n) : + (kuhnControlCode state).length ≤ + (machineKuhnInputBound + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩)).length := by + let matrix := rationalMatrixBinaryEncoding.encode ⟨n, A⟩ + have hcontrol := kuhnControlCode_length_le state hstate + have hstepFactor : + 50 * (steps + 1) * (n + 1) ^ 2 ≤ + 50 * (kuhnMachineStepBudget n + 1) * (n + 1) ^ 2 := by + have := Nat.mul_le_mul_left 50 (Nat.add_le_add_right hsteps 1) + exact Nat.mul_le_mul_right ((n + 1) ^ 2) this + have hn : n + 16 ≤ matrix.length + 16 := by + exact Nat.add_le_add_right (matrix_dimension_le_code_length A) 16 + exact hcontrol.trans <| hstepFactor.trans <| + (kuhnControlPolynomial_le_eighthPower n).trans <| + (Nat.pow_le_pow_left hn 8).trans <| + kuhnMachineInputBound_eighthPower matrix + +theorem kuhnMatrixCode_length_le_inputBound {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) : + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩).length ≤ + (machineKuhnInputBound + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩)).length := by + let matrix := rationalMatrixBinaryEncoding.encode ⟨n, A⟩ + exact (kuhnMatrixLength_le_eighthPower matrix.length).trans + (kuhnMachineInputBound_eighthPower matrix) + +theorem kuhnDimensionCode_length_le_inputBound {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) : + (List.replicate n true).length ≤ + (machineKuhnInputBound + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩)).length := by + have hn := matrix_dimension_le_code_length A + simpa using hn.trans (kuhnMatrixCode_length_le_inputBound A) + +theorem kuhnColumnsCode_length_le_inputBound {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) : + (finRangeUnaryCode n).length ≤ + (machineKuhnInputBound + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩)).length := by + let matrix := rationalMatrixBinaryEncoding.encode ⟨n, A⟩ + have hcolumns : (finRangeUnaryCode n).length ≤ n * (2 * n + 2) := by + simpa [finRangeUnaryCode, finListUnaryCode] using + finListUnaryCode_length_le (List.finRange n) + have hn : n + 16 ≤ matrix.length + 16 := by + exact Nat.add_le_add_right (matrix_dimension_le_code_length A) 16 + exact hcolumns.trans <| (kuhnQuadraticContext_le_eighthPower n).trans <| + (Nat.pow_le_pow_left hn 8).trans <| + kuhnMachineInputBound_eighthPower matrix + +theorem kuhnFalseSeenCode_length_le_inputBound {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) : + (boolVectorCode (List.replicate n false)).length ≤ + (machineKuhnInputBound + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩)).length := by + let matrix := rationalMatrixBinaryEncoding.encode ⟨n, A⟩ + have hfalse : (boolVectorCode (List.replicate n false)).length = 4 * n := by + simp + have hn : n + 16 ≤ matrix.length + 16 := by + exact Nat.add_le_add_right (matrix_dimension_le_code_length A) 16 + rw [hfalse] + exact (kuhnLinearContext_le_eighthPower n).trans <| + (Nat.pow_le_pow_left hn 8).trans <| + kuhnMachineInputBound_eighthPower matrix + +theorem machineKuhnClamp_stateCode_eq {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) (state : KuhnEvalState n) + (candidate : List Bool) + (hcandidate : candidate.length ≤ + (machineKuhnInputBound + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩)).length) : + machineKuhnClamp (kuhnMachineStateCode A state) candidate = candidate := by + simp only [machineKuhnClamp, machineKuhnBound_stateCode] + exact List.take_of_length_le hcandidate + +theorem machineKuhnStep_encode {n steps : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) (state : KuhnEvalState n) + (hstate : KuhnEvalReachableBound steps state) + (hnextSteps : steps + 1 ≤ kuhnMachineStepBudget n) : + machineKuhnStep (kuhnMachineStateCode A state) = + kuhnMachineStateCode A (kuhnEvalStep A state) := by + have hnext := kuhnEvalStep_reachableBound A state hstate + have hcontrol := kuhnControlCode_length_le_inputBound A + (kuhnEvalStep A state) hnext hnextSteps + rw [machineKuhnStep, machineKuhnNextControl_encode] + simp only [machineKuhnWithControl] + rw [machineKuhnClamp_stateCode_eq A state _ hcontrol] + simp only [machineKuhnMatrix_stateCode, machineKuhnDimension_stateCode, + machineKuhnColumns_stateCode, machineKuhnFalseSeen_stateCode, + machineKuhnBound_stateCode] + rw [machineKuhnClamp_stateCode_eq A state _ + (kuhnMatrixCode_length_le_inputBound A)] + rw [machineKuhnClamp_stateCode_eq A state _ + (kuhnDimensionCode_length_le_inputBound A)] + rw [machineKuhnClamp_stateCode_eq A state _ + (kuhnColumnsCode_length_le_inputBound A)] + rw [machineKuhnClamp_stateCode_eq A state _ + (kuhnFalseSeenCode_length_le_inputBound A)] + simp [kuhnMachineStateCode] + +/-! ## Exact bounded execution -/ + +theorem machineKuhnIterate_encode {n iterations : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) (initial : KuhnEvalState n) + (hinitial : KuhnEvalReachableBound 0 initial) + (hiterations : iterations ≤ kuhnMachineStepBudget n) : + (machineKuhnStep^[iterations]) (kuhnMachineStateCode A initial) = + kuhnMachineStateCode A ((kuhnEvalStep A)^[iterations] initial) := by + induction iterations with + | zero => simp + | succ iterations ih => + have hprefix : iterations ≤ kuhnMachineStepBudget n := by omega + rw [Function.iterate_succ_apply', Function.iterate_succ_apply', + ih hprefix] + apply machineKuhnStep_encode A + · exact kuhnEvalIterate_reachableBound A initial hinitial + · simpa [Nat.succ_eq_add_one] using hiterations + +@[simp] theorem kuhnEvalIterate_done {n iterations : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) (mate : ColumnMate n) : + (kuhnEvalStep A)^[iterations] (.done mate) = .done mate := by + induction iterations with + | zero => rfl + | succ iterations ih => + rw [Function.iterate_succ_apply', ih] + rfl + +theorem kuhnFullEval_budget {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) : + (kuhnEvalStep A)^[kuhnMachineStepBudget n] + (kuhnBuildEvalState A (List.finRange n) (emptyColumnMate n)) = + .done (kuhnColumnMate A) := by + let exactSteps := + kuhnBuildSteps A (List.finRange n) (emptyColumnMate n) + have hexact : exactSteps ≤ kuhnMachineStepBudget n := + kuhnFullBuildSteps_le_budget A + rw [show kuhnMachineStepBudget n = + (kuhnMachineStepBudget n - exactSteps) + exactSteps by omega, + Function.iterate_add_apply] + rw [show (kuhnEvalStep A)^[exactSteps] + (kuhnBuildEvalState A (List.finRange n) (emptyColumnMate n)) = + .done (kuhnColumnMate A) by + simpa [exactSteps] using kuhnFullBuildEvalState_iterate A] + simp + +theorem machineKuhnFullIterate_encode {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) : + (machineKuhnStep^[kuhnMachineStepBudget n]) + (kuhnMachineStateCode A + (kuhnBuildEvalState A (List.finRange n) (emptyColumnMate n))) = + kuhnMachineStateCode A (.done (kuhnColumnMate A)) := by + rw [machineKuhnIterate_encode A _ + (kuhnFullBuildEvalState_reachableBound A) (le_rfl), + kuhnFullEval_budget] + +theorem machineKuhnStep_done_encode {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) (mate : ColumnMate n) : + machineKuhnStep (kuhnMachineStateCode A (.done mate)) = + kuhnMachineStateCode A (.done mate) := by + have hcontrol := kuhnControlCode_length_le_inputBound A (.done mate) + (by trivial) (Nat.zero_le _) + rw [machineKuhnStep, machineKuhnNextControl_encode] + simp only [kuhnEvalStep, machineKuhnWithControl] + rw [machineKuhnClamp_stateCode_eq A (.done mate) _ hcontrol] + simp only [machineKuhnMatrix_stateCode, machineKuhnDimension_stateCode, + machineKuhnColumns_stateCode, machineKuhnFalseSeen_stateCode, + machineKuhnBound_stateCode] + rw [machineKuhnClamp_stateCode_eq A (.done mate) _ + (kuhnMatrixCode_length_le_inputBound A)] + rw [machineKuhnClamp_stateCode_eq A (.done mate) _ + (kuhnDimensionCode_length_le_inputBound A)] + rw [machineKuhnClamp_stateCode_eq A (.done mate) _ + (kuhnColumnsCode_length_le_inputBound A)] + rw [machineKuhnClamp_stateCode_eq A (.done mate) _ + (kuhnFalseSeenCode_length_le_inputBound A)] + simp [kuhnMachineStateCode] + +theorem kuhnMachineStepBudget_le_inputBound {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) : + kuhnMachineStepBudget n ≤ + (machineKuhnInputBound + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩)).length := by + let matrix := rationalMatrixBinaryEncoding.encode ⟨n, A⟩ + have hsmall : kuhnMachineStepBudget n ≤ + 50 * (kuhnMachineStepBudget n + 1) * (n + 1) ^ 2 := by + have hone : 1 ≤ (n + 1) ^ 2 := + Nat.one_le_pow 2 (n + 1) (by omega) + nlinarith + have hn : n + 16 ≤ matrix.length + 16 := by + exact Nat.add_le_add_right (matrix_dimension_le_code_length A) 16 + exact hsmall.trans <| (kuhnControlPolynomial_le_eighthPower n).trans <| + (Nat.pow_le_pow_left hn 8).trans <| + kuhnMachineInputBound_eighthPower matrix + +theorem machineKuhnFullBoundIterate_encode {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) : + let iterations := (machineKuhnInputBound + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩)).length + (machineKuhnStep^[iterations]) + (kuhnMachineStateCode A + (kuhnBuildEvalState A (List.finRange n) (emptyColumnMate n))) = + kuhnMachineStateCode A (.done (kuhnColumnMate A)) := by + dsimp only + let iterations := (machineKuhnInputBound + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩)).length + have hbudget : kuhnMachineStepBudget n ≤ iterations := + kuhnMachineStepBudget_le_inputBound A + change (machineKuhnStep^[iterations]) + (kuhnMachineStateCode A + (kuhnBuildEvalState A (List.finRange n) (emptyColumnMate n))) = + kuhnMachineStateCode A (.done (kuhnColumnMate A)) + rw [show iterations = + (iterations - kuhnMachineStepBudget n) + kuhnMachineStepBudget n by + omega, + Function.iterate_add_apply, machineKuhnFullIterate_encode] + induction (iterations - kuhnMachineStepBudget n) with + | zero => rfl + | succ remaining ih => + rw [Function.iterate_succ_apply', ih, machineKuhnStep_done_encode] + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineKuhnRunner.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineKuhnRunner.lean new file mode 100644 index 0000000000..b12a2f70bb --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineKuhnRunner.lean @@ -0,0 +1,445 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineKuhnInvariant +import Mathlib.Tactic + +/-! +# A complete finite-word perfect-matching runner + +This file constructs the initial Kuhn state directly from a rational-matrix +word and iterates the verified transition for the length of its fixed octic +envelope. All definitions are total on malformed words; the correctness +theorems concern canonical matrix encodings. +-/ + +namespace BeyondBethe + +open Complexity + +/-! ## Initializer -/ + +def machineKuhnInitDimension (matrix : List Bool) : List Bool := + machineMatrixDimensionUnary matrix + +def machineKuhnInitColumns (matrix : List Bool) : List Bool := + machineUnaryRangeCode (machineKuhnInitDimension matrix) + +def machineKuhnInitFalseSeen (matrix : List Bool) : List Bool := + machineFalseVectorCode (machineKuhnInitDimension matrix) + +def machineKuhnInitEmptyMate (matrix : List Bool) : List Bool := + machineEmptyMateVectorCode (machineKuhnInitDimension matrix) + +def machineKuhnInitBuildFrame (matrix : List Bool) : List Bool := + pair [true] + (machineKuhnBuildFramePack (machineListTail (machineKuhnInitColumns matrix)) + (machineKuhnInitEmptyMate matrix)) + +def machineKuhnInitStack (matrix : List Bool) : List Bool := + machineKuhnStackPush (machineKuhnInitBuildFrame matrix) [] + +def machineKuhnInitNonemptyControl (matrix : List Bool) : List Bool := + machineKuhnControlCall (true :: machineKuhnInitDimension matrix) + (machineKuhnInitColumns matrix) + (machineListHead (machineKuhnInitColumns matrix)) + (machineKuhnInitFalseSeen matrix) (machineKuhnInitEmptyMate matrix) + (machineKuhnInitStack matrix) + +def machineKuhnInitControl (matrix : List Bool) : List Bool := + machineIfEmpty (machineKuhnInitDimension matrix) + (machineKuhnControlDone (machineKuhnInitEmptyMate matrix)) + (machineKuhnInitNonemptyControl matrix) + +def machineKuhnInputClamp (matrix candidate : List Bool) : List Bool := + candidate.take (machineKuhnInputBound matrix).length + +def machineKuhnInit (matrix : List Bool) : List Bool := + machineKuhnStatePack + (machineKuhnInputClamp matrix (machineKuhnInitControl matrix)) + (machineKuhnInputClamp matrix matrix) + (machineKuhnInputClamp matrix (machineKuhnInitDimension matrix)) + (machineKuhnInputClamp matrix (machineKuhnInitColumns matrix)) + (machineKuhnInputClamp matrix (machineKuhnInitFalseSeen matrix)) + (machineKuhnInputBound matrix) + +theorem machineKuhnInitDimension_mem_FP : + machineKuhnInitDimension ∈ Complexity.FP := + machineMatrixDimensionUnary_mem_FP + +theorem machineKuhnInitColumns_mem_FP : + machineKuhnInitColumns ∈ Complexity.FP := by + simpa only [machineKuhnInitColumns] using + machineCompose_mem_FP machineKuhnInitDimension_mem_FP + machineUnaryRangeCode_mem_FP + +theorem machineKuhnInitFalseSeen_mem_FP : + machineKuhnInitFalseSeen ∈ Complexity.FP := by + simpa only [machineKuhnInitFalseSeen] using + machineCompose_mem_FP machineKuhnInitDimension_mem_FP + machineFalseVectorCode_mem_FP + +theorem machineKuhnInitEmptyMate_mem_FP : + machineKuhnInitEmptyMate ∈ Complexity.FP := by + simpa only [machineKuhnInitEmptyMate] using + machineCompose_mem_FP machineKuhnInitDimension_mem_FP + machineEmptyMateVectorCode_mem_FP + +theorem machineKuhnInitBuildFrame_mem_FP : + machineKuhnInitBuildFrame ∈ Complexity.FP := by + have htail := machineCompose_mem_FP machineKuhnInitColumns_mem_FP + machineListTail_mem_FP + have hpayload := machinePair_mem_FP htail machineKuhnInitEmptyMate_mem_FP + exact machinePair_mem_FP (machineConst_mem_FP [true]) hpayload + +theorem machineKuhnInitStack_mem_FP : + machineKuhnInitStack ∈ Complexity.FP := by + exact machinePair_mem_FP machineKuhnInitBuildFrame_mem_FP + (machineConst_mem_FP []) + +theorem machineKuhnInitNonemptyControl_mem_FP : + machineKuhnInitNonemptyControl ∈ Complexity.FP := by + have hfuel := machineCompose_mem_FP machineKuhnInitDimension_mem_FP + (machinePrepend_mem_FP true) + have hrow := machineCompose_mem_FP machineKuhnInitColumns_mem_FP + machineListHead_mem_FP + exact machinePair_mem_FP (machineConst_mem_FP [false]) + (machinePair_mem_FP hfuel + (machinePair_mem_FP machineKuhnInitColumns_mem_FP + (machinePair_mem_FP hrow + (machinePair_mem_FP machineKuhnInitFalseSeen_mem_FP + (machinePair_mem_FP machineKuhnInitEmptyMate_mem_FP + machineKuhnInitStack_mem_FP))))) + +theorem machineKuhnInitControl_mem_FP : + machineKuhnInitControl ∈ Complexity.FP := by + have hdone := machinePair_mem_FP (machineConst_mem_FP [true, true]) + machineKuhnInitEmptyMate_mem_FP + exact machineIfEmpty_mem_FP machineKuhnInitDimension_mem_FP hdone + machineKuhnInitNonemptyControl_mem_FP + +theorem machineKuhnInputBound_mem_FP : + machineKuhnInputBound ∈ Complexity.FP := by + simpa only [machineKuhnInputBound] using + machineCompose_mem_FP machineListUpdateInputBound_mem_FP + machineBinaryMulWidth_mem_FP + +theorem machineKuhnInputClamp_mem_FP + {candidate : List Bool → List Bool} (hcandidate : candidate ∈ Complexity.FP) : + (fun matrix ↦ machineKuhnInputClamp matrix (candidate matrix)) ∈ + Complexity.FP := by + simpa only [machineKuhnInputClamp] using + machineTake_mem_FP machineKuhnInputBound_mem_FP hcandidate + +theorem machineKuhnInit_mem_FP : machineKuhnInit ∈ Complexity.FP := by + exact machinePair_mem_FP + (machineKuhnInputClamp_mem_FP machineKuhnInitControl_mem_FP) + (machinePair_mem_FP (machineKuhnInputClamp_mem_FP id_mem_FP) + (machinePair_mem_FP + (machineKuhnInputClamp_mem_FP machineKuhnInitDimension_mem_FP) + (machinePair_mem_FP + (machineKuhnInputClamp_mem_FP machineKuhnInitColumns_mem_FP) + (machinePair_mem_FP + (machineKuhnInputClamp_mem_FP machineKuhnInitFalseSeen_mem_FP) + machineKuhnInputBound_mem_FP)))) + +/-! ## Generic length bounds needed by bounded iteration -/ + +theorem machineKuhnInitDimension_length_le (matrix : List Bool) : + (machineKuhnInitDimension matrix).length ≤ matrix.length := by + let word := pair matrix (machineMatrixDimensionWord matrix) + have hbound := machineBoundedUnaryIterate_bound word matrix.length + rcases hbound with ⟨_hpack, _hremaining, hacc⟩ + change (machineBoundedUnaryAcc + ((machineBoundedUnaryStep)^[matrix.length] + (machineBoundedUnaryInit word))).length ≤ matrix.length at hacc + simpa [machineKuhnInitDimension, machineMatrixDimensionUnary, + machineBoundedUnary, machineBoundedUnaryFinalState, + machineBoundedUnaryRuler, word] using hacc + +theorem machineUnaryRangeCode_length_le_inputBound (ruler : List Bool) : + (machineUnaryRangeCode ruler).length ≤ + (machineUnaryRangeInputBound ruler).length := by + have hbound := machineUnaryRangeIterate_bound ruler ruler.length + dsimp only [MachineUnaryRangeStateBound] at hbound + rcases hbound with ⟨_hpack, _hremaining, hacc, _hbound⟩ + simpa [machineUnaryRangeCode, machineUnaryRangeFinalState] using hacc + +@[simp] theorem machineFalseVectorCode_length (ruler : List Bool) : + (machineFalseVectorCode ruler).length = 4 * ruler.length := by + rw [machineFalseVectorCode, machineFalseVectorIterate_semantics] + simp + +@[simp] theorem machineEmptyMateVectorCode_length (ruler : List Bool) : + (machineEmptyMateVectorCode ruler).length = 4 * ruler.length := by + simp [machineEmptyMateVectorCode] + +theorem machineListUpdateInputBound_length_le_kuhnBound + (matrix : List Bool) : + (machineListUpdateInputBound matrix).length ≤ + (machineKuhnInputBound matrix).length := by + simp only [machineKuhnInputBound, machineBinaryMulWidth, + List.length_replicate, List.length_append] + nlinarith + +theorem machineKuhn_matrix_length_le_bound (matrix : List Bool) : + matrix.length ≤ (machineKuhnInputBound matrix).length := by + exact (machineListUpdate_word_length_le_bound matrix).trans + (machineListUpdateInputBound_length_le_kuhnBound matrix) + +theorem machineKuhnInitColumns_length_le_bound (matrix : List Bool) : + (machineKuhnInitColumns matrix).length ≤ + (machineKuhnInputBound matrix).length := by + have hdimension := machineKuhnInitDimension_length_le matrix + have hrange := machineUnaryRangeCode_length_le_inputBound + (machineKuhnInitDimension matrix) + have hmono := machineListUpdateInputBound_length_mono hdimension + exact hrange.trans <| hmono.trans <| + machineListUpdateInputBound_length_le_kuhnBound matrix + +theorem machineKuhnInitColumns_length_le_base (matrix : List Bool) : + (machineKuhnInitColumns matrix).length ≤ + (machineListUpdateInputBound matrix).length := by + have hdimension := machineKuhnInitDimension_length_le matrix + exact (machineUnaryRangeCode_length_le_inputBound + (machineKuhnInitDimension matrix)).trans + (machineListUpdateInputBound_length_mono hdimension) + +theorem machineKuhnInitFalseSeen_length_le_bound (matrix : List Bool) : + (machineKuhnInitFalseSeen matrix).length ≤ + (machineKuhnInputBound matrix).length := by + rw [machineKuhnInitFalseSeen, machineFalseVectorCode_length] + have hdimension := machineKuhnInitDimension_length_le matrix + have hlinear : 4 * matrix.length ≤ + (machineKuhnInputBound matrix).length := by + simp only [machineKuhnInputBound, machineListUpdateInputBound, + machineBinaryMulWidth, List.length_replicate, List.length_append] + ring_nf + omega + exact (Nat.mul_le_mul_left 4 hdimension).trans hlinear + +theorem machineKuhnInitEmptyMate_length_le_bound (matrix : List Bool) : + (machineKuhnInitEmptyMate matrix).length ≤ + (machineKuhnInputBound matrix).length := by + simpa [machineKuhnInitEmptyMate, machineKuhnInitFalseSeen, + machineEmptyMateVectorCode] using + machineKuhnInitFalseSeen_length_le_bound matrix + +/-! ## A generic invariant for the outer bounded iteration -/ + +def MachineKuhnRunStateBound (matrix state : List Bool) : Prop := + let B := (machineKuhnInputBound matrix).length + state = machineKuhnStatePack (machineKuhnStateControl state) + (machineKuhnStateMatrix state) (machineKuhnStateDimension state) + (machineKuhnStateColumns state) (machineKuhnStateFalseSeen state) + (machineKuhnStateBound state) ∧ + (machineKuhnStateControl state).length ≤ B ∧ + (machineKuhnStateMatrix state).length ≤ B ∧ + (machineKuhnStateDimension state).length ≤ B ∧ + (machineKuhnStateColumns state).length ≤ B ∧ + (machineKuhnStateFalseSeen state).length ≤ B ∧ + machineKuhnStateBound state = machineKuhnInputBound matrix + +theorem machineKuhnInit_bound (matrix : List Bool) : + MachineKuhnRunStateBound matrix (machineKuhnInit matrix) := by + dsimp only [MachineKuhnRunStateBound] + refine ⟨?_, ?_, ?_, ?_, ?_, ?_, ?_⟩ + · simp [machineKuhnInit] + · simp [machineKuhnInit, machineKuhnInputClamp] + · simp [machineKuhnInit, machineKuhnInputClamp] + · simp [machineKuhnInit, machineKuhnInputClamp] + · simp [machineKuhnInit, machineKuhnInputClamp] + · simp [machineKuhnInit, machineKuhnInputClamp] + · simp [machineKuhnInit] + +theorem machineKuhnStep_bound {matrix state : List Bool} + (hstate : MachineKuhnRunStateBound matrix state) : + MachineKuhnRunStateBound matrix (machineKuhnStep state) := by + dsimp only [MachineKuhnRunStateBound] at hstate ⊢ + rcases hstate with + ⟨hpack, hcontrol, hmatrix, hdimension, hcolumns, hfalse, hbound⟩ + rw [machineKuhnStep, machineKuhnWithControl] + refine ⟨by simp, ?_, ?_, ?_, ?_, ?_, ?_⟩ + · simp only [machineKuhnStateControl_pack, machineKuhnClamp, + List.length_take, hbound] + exact Nat.min_le_left _ _ + · simp only [machineKuhnStateMatrix_pack, machineKuhnClamp, + List.length_take, hbound] + exact Nat.min_le_left _ _ + · simp only [machineKuhnStateDimension_pack, machineKuhnClamp, + List.length_take, hbound] + exact Nat.min_le_left _ _ + · simp only [machineKuhnStateColumns_pack, machineKuhnClamp, + List.length_take, hbound] + exact Nat.min_le_left _ _ + · simp only [machineKuhnStateFalseSeen_pack, machineKuhnClamp, + List.length_take, hbound] + exact Nat.min_le_left _ _ + · simp [hbound] + +theorem machineKuhnIterate_bound (matrix : List Bool) : ∀ iterations, + MachineKuhnRunStateBound matrix + ((machineKuhnStep^[iterations]) (machineKuhnInit matrix)) := by + intro iterations + induction iterations with + | zero => simpa using machineKuhnInit_bound matrix + | succ iterations ih => + rw [Function.iterate_succ_apply'] + exact machineKuhnStep_bound ih + +def machineKuhnRunWidth (matrix : List Bool) : List Bool := + machineBinaryMulWidth (machineKuhnInputBound matrix) + +theorem machineKuhnRunWidth_mem_FP : + machineKuhnRunWidth ∈ Complexity.FP := by + simpa only [machineKuhnRunWidth] using + machineCompose_mem_FP machineKuhnInputBound_mem_FP + machineBinaryMulWidth_mem_FP + +theorem machineKuhnIterate_length_le_width + (matrix : List Bool) (iterations : ℕ) + (_hiterations : iterations ≤ (machineKuhnInputBound matrix).length) : + ((machineKuhnStep^[iterations]) (machineKuhnInit matrix)).length ≤ + (machineKuhnRunWidth matrix).length := by + have hstate := machineKuhnIterate_bound matrix iterations + dsimp only [MachineKuhnRunStateBound] at hstate + rcases hstate with + ⟨hpack, hcontrol, hmatrix, hdimension, hcolumns, hfalse, hbound⟩ + rw [hpack] + simp only [machineKuhnStatePack, pair_length] + have hlinear : + 2 * (machineKuhnStateControl + ((machineKuhnStep^[iterations]) (machineKuhnInit matrix))).length + 2 + + 2 * (machineKuhnStateMatrix + ((machineKuhnStep^[iterations]) (machineKuhnInit matrix))).length + 2 + + 2 * (machineKuhnStateDimension + ((machineKuhnStep^[iterations]) (machineKuhnInit matrix))).length + 2 + + 2 * (machineKuhnStateColumns + ((machineKuhnStep^[iterations]) (machineKuhnInit matrix))).length + 2 + + 2 * (machineKuhnStateFalseSeen + ((machineKuhnStep^[iterations]) (machineKuhnInit matrix))).length + 2 + + (machineKuhnStateBound + ((machineKuhnStep^[iterations]) (machineKuhnInit matrix))).length ≤ + 11 * (machineKuhnInputBound matrix).length + 10 := by + rw [hbound] + omega + have hwidth : 11 * (machineKuhnInputBound matrix).length + 10 ≤ + (machineKuhnRunWidth matrix).length := by + simp only [machineKuhnRunWidth, machineBinaryMulWidth, + List.length_replicate, List.length_append] + nlinarith + omega + +def machineKuhnFinalState (matrix : List Bool) : List Bool := + (machineKuhnStep^[(machineKuhnInputBound matrix).length]) + (machineKuhnInit matrix) + +theorem machineKuhnFinalState_mem_FP : + machineKuhnFinalState ∈ Complexity.FP := by + simpa only [machineKuhnFinalState] using + Cobham.iterate_mem_FP machineKuhnStep_mem_FP machineKuhnInit_mem_FP + machineKuhnInputBound_mem_FP machineKuhnRunWidth_mem_FP + machineKuhnIterate_length_le_width + +/-! ## Exact semantics on canonical matrix words -/ + +@[simp] theorem columnMateList_emptyColumnMate (n : ℕ) : + columnMateList (emptyColumnMate n) = List.replicate n none := by + apply List.ext_get + · simp + · intro i hi hi' + simp [columnMateList, emptyColumnMate] + +@[simp] theorem machineKuhnInitDimension_encode {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) : + machineKuhnInitDimension + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩) = + List.replicate n true := by + exact machineMatrixDimensionUnary_encode A + +@[simp] theorem machineKuhnInitColumns_encode {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) : + machineKuhnInitColumns + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩) = + finRangeUnaryCode n := by + simp [machineKuhnInitColumns] + +@[simp] theorem machineKuhnInitFalseSeen_encode {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) : + machineKuhnInitFalseSeen + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩) = + boolVectorCode (List.replicate n false) := by + simp [machineKuhnInitFalseSeen] + +@[simp] theorem machineKuhnInitEmptyMate_encode {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) : + machineKuhnInitEmptyMate + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩) = + mateVectorCode (columnMateList (emptyColumnMate n)) := by + simp [machineKuhnInitEmptyMate] + +theorem machineKuhnInitControl_encode {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) : + machineKuhnInitControl + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩) = + kuhnControlCode + (kuhnBuildEvalState A (List.finRange n) (emptyColumnMate n)) := by + cases n with + | zero => + simp [machineKuhnInitControl, machineKuhnInitNonemptyControl, + kuhnBuildEvalState, kuhnControlCode, finRangeUnaryCode, + finListUnaryCode, binaryListCode] + | succ n => + simp [machineKuhnInitControl, machineKuhnInitNonemptyControl, + machineKuhnInitStack, machineKuhnInitBuildFrame, + kuhnBuildEvalState, kuhnControlCode, kuhnStackCode, + kuhnFrameCode, kuhnBuildFrameCode, finRangeUnaryCode, + finListUnaryCode, binaryListCode, machineKuhnStackPush, + List.finRange_succ, machineListHead, machineListTail, + finUnaryCode, List.replicate_succ] + +theorem machineKuhnInputClamp_eq (matrix candidate : List Bool) + (hcandidate : candidate.length ≤ (machineKuhnInputBound matrix).length) : + machineKuhnInputClamp matrix candidate = candidate := by + exact List.take_of_length_le hcandidate + +@[simp] theorem machineKuhnInit_encode {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) : + machineKuhnInit (rationalMatrixBinaryEncoding.encode ⟨n, A⟩) = + kuhnMachineStateCode A + (kuhnBuildEvalState A (List.finRange n) (emptyColumnMate n)) := by + let matrix := rationalMatrixBinaryEncoding.encode ⟨n, A⟩ + let initial := kuhnBuildEvalState A (List.finRange n) (emptyColumnMate n) + have hinitial := kuhnFullBuildEvalState_reachableBound A + have hcontrol : (machineKuhnInitControl matrix).length ≤ + (machineKuhnInputBound matrix).length := by + rw [machineKuhnInitControl_encode] + exact kuhnControlCode_length_le_inputBound A initial hinitial + (Nat.zero_le _) + rw [machineKuhnInit] + rw [machineKuhnInputClamp_eq matrix _ hcontrol] + rw [machineKuhnInputClamp_eq matrix _ + (kuhnMatrixCode_length_le_inputBound A)] + simp only [machineKuhnInitDimension_encode, + machineKuhnInitColumns_encode, machineKuhnInitFalseSeen_encode] + rw [machineKuhnInputClamp_eq matrix _ + (kuhnDimensionCode_length_le_inputBound A)] + rw [machineKuhnInputClamp_eq matrix _ + (kuhnColumnsCode_length_le_inputBound A)] + rw [machineKuhnInputClamp_eq matrix _ + (kuhnFalseSeenCode_length_le_inputBound A)] + simp [kuhnMachineStateCode, machineKuhnInitControl_encode, + matrix, initial] + +@[simp] theorem machineKuhnFinalState_encode {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) : + machineKuhnFinalState + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩) = + kuhnMachineStateCode A (.done (kuhnColumnMate A)) := by + rw [machineKuhnFinalState, machineKuhnInit_encode] + exact machineKuhnFullBoundIterate_encode A + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineKuhnSemantics.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineKuhnSemantics.lean new file mode 100644 index 0000000000..d5b4cb8df8 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineKuhnSemantics.lean @@ -0,0 +1,431 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineKuhnStep +import Mathlib.Tactic + +/-! +# Correctness of one encoded Kuhn transition + +The main theorem in this file shows that the un-clamped control computation is +exactly `kuhnEvalStep`. Clamp inactivity and the bounded full run are proved +after the semantic size invariant. +-/ + +namespace BeyondBethe + +open Complexity + +@[simp] theorem machineIfEmpty_binaryListCode_cons {α : Type*} + (encode : α → List Bool) (x : α) (xs : List α) + (whenEmpty whenNonempty : List Bool) : + machineIfEmpty (binaryListCode encode (x :: xs)) + whenEmpty whenNonempty = whenNonempty := by + exact machineIfEmpty_of_ne_nil _ _ _ + (binaryListCode_cons_ne_nil encode x xs) + +@[simp] theorem machineIfEmpty_replicate_succ + (n : ℕ) (bit : Bool) (whenEmpty whenNonempty : List Bool) : + machineIfEmpty (List.replicate (n + 1) bit) + whenEmpty whenNonempty = whenNonempty := by + rw [show n + 1 = Nat.succ n by omega, List.replicate_succ] + simp + +@[simp] theorem machineIfEmpty_pair + (left right whenEmpty whenNonempty : List Bool) : + machineIfEmpty (pair left right) whenEmpty whenNonempty = + whenNonempty := by + apply machineIfEmpty_of_ne_nil + intro h + have hlen := congrArg List.length h + simp at hlen + +@[simp] theorem machineMateVectorUpdateSomeAtUnary_encode + (mate : List (Option ℕ)) (column row : ℕ) + (hcolumn : column < mate.length) : + machineMateVectorUpdateAtUnary + (pair (List.replicate column true) + (pair (true :: List.replicate row true) (mateVectorCode mate))) = + mateVectorCode (mate.set column (some row)) := by + simpa [mateValueCode] using + machineMateVectorUpdateAtUnary_encode mate column (some row) hcolumn + +@[simp] theorem seenBoolList_empty {n : ℕ} : + seenBoolList (∅ : Finset (Fin n)) = List.replicate n false := by + apply List.ext_get + · simp + · intro i hi hi' + simp [seenBoolList] + +/-! ## Exact projections from semantic state codes -/ + +@[simp] theorem machineKuhnControl_stateCode {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) (state : KuhnEvalState n) : + machineKuhnControl (kuhnMachineStateCode A state) = + kuhnControlCode state := by + simp [machineKuhnControl, kuhnMachineStateCode] + +@[simp] theorem machineKuhnMatrix_stateCode {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) (state : KuhnEvalState n) : + machineKuhnStateMatrix (kuhnMachineStateCode A state) = + rationalMatrixBinaryEncoding.encode ⟨n, A⟩ := by + simp [kuhnMachineStateCode] + +@[simp] theorem machineKuhnDimension_stateCode {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) (state : KuhnEvalState n) : + machineKuhnStateDimension (kuhnMachineStateCode A state) = + List.replicate n true := by + simp [kuhnMachineStateCode] + +@[simp] theorem machineKuhnColumns_stateCode {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) (state : KuhnEvalState n) : + machineKuhnStateColumns (kuhnMachineStateCode A state) = + finRangeUnaryCode n := by + simp [kuhnMachineStateCode] + +@[simp] theorem machineKuhnFalseSeen_stateCode {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) (state : KuhnEvalState n) : + machineKuhnStateFalseSeen (kuhnMachineStateCode A state) = + boolVectorCode (List.replicate n false) := by + simp [kuhnMachineStateCode] + +@[simp] theorem machineKuhnBound_stateCode {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) (state : KuhnEvalState n) : + machineKuhnStateBound (kuhnMachineStateCode A state) = + machineKuhnInputBound (rationalMatrixBinaryEncoding.encode ⟨n, A⟩) := by + simp [kuhnMachineStateCode] + +@[simp] theorem machineKuhnFuel_encode_call {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) (fuel : ℕ) + (remaining : List (Fin n)) (row : Fin n) (seen : Finset (Fin n)) + (mate : ColumnMate n) (stack : List (KuhnFrame n)) : + machineKuhnFuel (kuhnMachineStateCode A + (.call fuel remaining row seen mate stack)) = + List.replicate fuel true := by + simp [machineKuhnFuel, kuhnControlCode] + +@[simp] theorem machineKuhnRemaining_encode_call {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) (fuel : ℕ) + (remaining : List (Fin n)) (row : Fin n) (seen : Finset (Fin n)) + (mate : ColumnMate n) (stack : List (KuhnFrame n)) : + machineKuhnRemaining (kuhnMachineStateCode A + (.call fuel remaining row seen mate stack)) = + finListUnaryCode remaining := by + simp [machineKuhnRemaining, kuhnControlCode] + +@[simp] theorem machineKuhnRow_encode_call {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) (fuel : ℕ) + (remaining : List (Fin n)) (row : Fin n) (seen : Finset (Fin n)) + (mate : ColumnMate n) (stack : List (KuhnFrame n)) : + machineKuhnRow (kuhnMachineStateCode A + (.call fuel remaining row seen mate stack)) = finUnaryCode row := by + simp [machineKuhnRow, kuhnControlCode] + +@[simp] theorem machineKuhnSeen_encode_call {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) (fuel : ℕ) + (remaining : List (Fin n)) (row : Fin n) (seen : Finset (Fin n)) + (mate : ColumnMate n) (stack : List (KuhnFrame n)) : + machineKuhnSeen (kuhnMachineStateCode A + (.call fuel remaining row seen mate stack)) = + boolVectorCode (seenBoolList seen) := by + simp [machineKuhnSeen, kuhnControlCode] + +@[simp] theorem machineKuhnMate_encode_call {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) (fuel : ℕ) + (remaining : List (Fin n)) (row : Fin n) (seen : Finset (Fin n)) + (mate : ColumnMate n) (stack : List (KuhnFrame n)) : + machineKuhnMate (kuhnMachineStateCode A + (.call fuel remaining row seen mate stack)) = + mateVectorCode (columnMateList mate) := by + simp [machineKuhnMate, kuhnControlCode] + +@[simp] theorem machineKuhnStack_encode_call {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) (fuel : ℕ) + (remaining : List (Fin n)) (row : Fin n) (seen : Finset (Fin n)) + (mate : ColumnMate n) (stack : List (KuhnFrame n)) : + machineKuhnStack (kuhnMachineStateCode A + (.call fuel remaining row seen mate stack)) = kuhnStackCode stack := by + simp [machineKuhnStack, kuhnControlCode] + +@[simp] theorem machineKuhnReturnFields_encode {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) (result : KuhnSearchResult n) + (stack : List (KuhnFrame n)) : + machineKuhnRetSuccess (kuhnMachineStateCode A (.ret result stack)) = + [result.mate?.isSome] ∧ + machineKuhnRetSeen (kuhnMachineStateCode A (.ret result stack)) = + boolVectorCode (seenBoolList result.seen) ∧ + machineKuhnRetMate (kuhnMachineStateCode A (.ret result stack)) = + kuhnSearchResultMateCode result ∧ + machineKuhnRetStack (kuhnMachineStateCode A (.ret result stack)) = + kuhnStackCode stack := by + simp [machineKuhnRetSuccess, machineKuhnRetSeen, machineKuhnRetMate, + machineKuhnRetStack, kuhnControlCode] + +@[simp] theorem machineKuhnTopFrame_encode_ret_cons {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) (result : KuhnSearchResult n) + (frame : KuhnFrame n) (stack : List (KuhnFrame n)) : + machineKuhnTopFrame + (kuhnMachineStateCode A (.ret result (frame :: stack))) = + kuhnFrameCode frame := by + simp [machineKuhnTopFrame] + +@[simp] theorem machineKuhnRestStack_encode_ret_cons {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) (result : KuhnSearchResult n) + (frame : KuhnFrame n) (stack : List (KuhnFrame n)) : + machineKuhnRestStack + (kuhnMachineStateCode A (.ret result (frame :: stack))) = + kuhnStackCode stack := by + simp [machineKuhnRestStack] + +@[simp] theorem machineKuhnCurrentColumn_encode {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) (fuel : ℕ) (col : Fin n) + (remaining : List (Fin n)) (row : Fin n) (seen : Finset (Fin n)) + (mate : ColumnMate n) (stack : List (KuhnFrame n)) : + machineKuhnCurrentColumn (kuhnMachineStateCode A + (.call fuel (col :: remaining) row seen mate stack)) = + finUnaryCode col := by + simp [machineKuhnCurrentColumn, finListUnaryCode] + +@[simp] theorem machineKuhnRemainingTail_encode {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) (fuel : ℕ) (col : Fin n) + (remaining : List (Fin n)) (row : Fin n) (seen : Finset (Fin n)) + (mate : ColumnMate n) (stack : List (KuhnFrame n)) : + machineKuhnRemainingTail (kuhnMachineStateCode A + (.call fuel (col :: remaining) row seen mate stack)) = + finListUnaryCode remaining := by + simp [machineKuhnRemainingTail, finListUnaryCode] + +/-! ## Exact memory operations -/ + +@[simp] theorem machineKuhnSeenBit_encode {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) (fuel : ℕ) (col : Fin n) + (remaining : List (Fin n)) (row : Fin n) (seen : Finset (Fin n)) + (mate : ColumnMate n) (stack : List (KuhnFrame n)) : + machineKuhnSeenBit (kuhnMachineStateCode A + (.call fuel (col :: remaining) row seen mate stack)) = + [decide (col ∈ seen)] := by + rw [machineKuhnSeenBit, machineKuhnCurrentColumn_encode, + machineKuhnSeen_encode_call, finUnaryCode, + machineBoolVectorEntryAtUnary_encode (seenBoolList seen) col.1 + (by simp)] + congr 2 + exact seenBoolList_getElem seen col.1 (by simp) + +@[simp] theorem machineKuhnSupportBit_encode {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) (fuel : ℕ) (col : Fin n) + (remaining : List (Fin n)) (row : Fin n) (seen : Finset (Fin n)) + (mate : ColumnMate n) (stack : List (KuhnFrame n)) : + machineKuhnSupportBit (kuhnMachineStateCode A + (.call fuel (col :: remaining) row seen mate stack)) = + [decide (A row col ≠ 0)] := by + rw [machineKuhnSupportBit, machineKuhnRow_encode_call, + machineKuhnCurrentColumn_encode, machineKuhnMatrix_stateCode] + simp only [finUnaryCode] + rw [machineRationalSupportBitAtUnary_encode] + +@[simp] theorem machineKuhnSeenUpdated_encode {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) (fuel : ℕ) (col : Fin n) + (remaining : List (Fin n)) (row : Fin n) (seen : Finset (Fin n)) + (mate : ColumnMate n) (stack : List (KuhnFrame n)) : + machineKuhnSeenUpdated (kuhnMachineStateCode A + (.call fuel (col :: remaining) row seen mate stack)) = + boolVectorCode (seenBoolList (insert col seen)) := by + rw [machineKuhnSeenUpdated, machineKuhnCurrentColumn_encode, + machineKuhnSeen_encode_call, finUnaryCode, + machineBoolVectorUpdateAtUnary_encode (seenBoolList seen) col.1 true + (by simp), ← seenBoolList_insert] + +@[simp] theorem machineKuhnMateValue_encode {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) (fuel : ℕ) (col : Fin n) + (remaining : List (Fin n)) (row : Fin n) (seen : Finset (Fin n)) + (mate : ColumnMate n) (stack : List (KuhnFrame n)) : + machineKuhnMateValue (kuhnMachineStateCode A + (.call fuel (col :: remaining) row seen mate stack)) = + mateValueCode ((mate col).map Fin.val) := by + rw [machineKuhnMateValue, machineKuhnCurrentColumn_encode, + machineKuhnMate_encode_call, finUnaryCode, + machineMateVectorGetAtUnary_encode (columnMateList mate) col.1 (by simp)] + congr 1 + exact columnMateList_getElem mate col.1 (by simp) + +@[simp] theorem machineKuhnMateSetCurrent_encode {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) (fuel : ℕ) (col : Fin n) + (remaining : List (Fin n)) (row : Fin n) (seen : Finset (Fin n)) + (mate : ColumnMate n) (stack : List (KuhnFrame n)) : + machineKuhnMateSetCurrent (kuhnMachineStateCode A + (.call fuel (col :: remaining) row seen mate stack)) = + mateVectorCode + (columnMateList (Function.update mate col (some row))) := by + rw [machineKuhnMateSetCurrent, machineKuhnCurrentColumn_encode, + machineKuhnSomeCurrentRow, machineKuhnRow_encode_call, + machineKuhnMate_encode_call] + simp only [finUnaryCode] + change machineMateVectorUpdateAtUnary + (pair (List.replicate col.1 true) + (pair (mateValueCode (some row.1)) + (mateVectorCode (columnMateList mate)))) = _ + rw [machineMateVectorUpdateAtUnary_encode (columnMateList mate) col.1 + (some row.1) (by simp), columnMateList_update] + simp + +@[simp] theorem machineKuhnMateClearCurrent_encode {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) (fuel : ℕ) (col : Fin n) + (remaining : List (Fin n)) (row : Fin n) (seen : Finset (Fin n)) + (mate : ColumnMate n) (stack : List (KuhnFrame n)) : + machineKuhnMateClearCurrent (kuhnMachineStateCode A + (.call fuel (col :: remaining) row seen mate stack)) = + mateVectorCode (columnMateList (Function.update mate col none)) := by + rw [machineKuhnMateClearCurrent, machineKuhnCurrentColumn_encode, + machineKuhnMate_encode_call] + simp only [finUnaryCode] + change machineMateVectorUpdateAtUnary + (pair (List.replicate col.1 true) + (pair (mateValueCode none) (mateVectorCode (columnMateList mate)))) = _ + rw [machineMateVectorUpdateAtUnary_encode (columnMateList mate) col.1 none + (by simp), columnMateList_update] + simp + +/-! ## Un-clamped transition correctness -/ + +theorem machineKuhnNextControl_encode {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) (state : KuhnEvalState n) : + machineKuhnNextControl (kuhnMachineStateCode A state) = + kuhnControlCode (kuhnEvalStep A state) := by + cases state with + | done mate => + simp [machineKuhnNextControl, machineKuhnDoneControl, + kuhnControlCode, kuhnEvalStep] + | call fuel remaining row seen mate stack => + cases fuel with + | zero => + simp [machineKuhnNextControl, machineKuhnCallControl, + machineKuhnFailureControl, kuhnControlCode, kuhnEvalStep, + kuhnSearchResultMateCode] + | succ fuel => + cases remaining with + | nil => + simp [machineKuhnNextControl, machineKuhnCallControl, + machineKuhnFailureControl, kuhnControlCode, + kuhnEvalStep, kuhnSearchResultMateCode, + finListUnaryCode, binaryListCode] + | cons col remaining => + by_cases hskip : col ∈ seen ∨ A row col = 0 + · rcases hskip with hseen | hzero + · simp [machineKuhnNextControl, machineKuhnCallControl, + machineKuhnNonterminalCallControl, machineKuhnSkipBit, + machineKuhnSkipControl, kuhnControlCode, + kuhnEvalStep, hseen, finListUnaryCode, binaryListCode] + · have hsupport : decide (A row col ≠ 0) = false := by + simp [hzero] + simp [machineKuhnNextControl, machineKuhnCallControl, + machineKuhnNonterminalCallControl, machineKuhnSkipBit, + machineKuhnSkipControl, kuhnControlCode, + kuhnEvalStep, hzero, + finListUnaryCode, binaryListCode] + · have hnotSeen : col ∉ seen := by aesop + have hsupport : A row col ≠ 0 := by aesop + cases hmate : mate col with + | none => + simp [machineKuhnNextControl, machineKuhnCallControl, + machineKuhnNonterminalCallControl, machineKuhnSkipBit, + machineKuhnProceedControl, machineKuhnMateIsNoneBit, + machineKuhnFreeColumnControl, kuhnControlCode, + kuhnEvalStep, kuhnSearchResultMateCode, + hnotSeen, hsupport, hmate, + finListUnaryCode, binaryListCode] + | some oldRow => + simp [machineKuhnNextControl, machineKuhnCallControl, + machineKuhnNonterminalCallControl, machineKuhnSkipBit, + machineKuhnProceedControl, machineKuhnMateIsNoneBit, + machineKuhnOccupiedColumnControl, + machineKuhnPushedSearchStack, + machineKuhnSearchFrameCurrent, kuhnControlCode, + kuhnEvalStep, + kuhnStackCode, hnotSeen, hsupport, hmate, + finRangeUnaryCode, finListUnaryCode, finUnaryCode, + machineKuhnStackPush, binaryListCode] + rfl + | ret result stack => + cases stack with + | nil => + simp [machineKuhnNextControl, machineKuhnReturnControl, + kuhnControlCode, kuhnEvalStep, kuhnStackCode, binaryListCode] + | cons frame stack => + cases frame with + | search frame => + cases hmate : result.mate? with + | none => + simp [machineKuhnNextControl, machineKuhnReturnControl, + machineKuhnNonemptyReturnControl, + machineKuhnSearchReturnControl, + machineKuhnSearchReturnFailureControl, + kuhnControlCode, kuhnSearchResultMateCode, + kuhnFrameCode, kuhnStackCode, kuhnSearchFrameCode, + kuhnEvalStep, hmate, finListUnaryCode, + binaryListCode] + | some mate' => + simp [machineKuhnNextControl, machineKuhnReturnControl, + machineKuhnNonemptyReturnControl, + machineKuhnSearchReturnControl, + machineKuhnSearchReturnSuccessControl, + kuhnControlCode, kuhnSearchResultMateCode, + kuhnFrameCode, kuhnStackCode, kuhnSearchFrameCode, + kuhnEvalStep, hmate, columnMateList_update, + finUnaryCode, binaryListCode] + | build frame => + rcases frame with ⟨rows, fallback⟩ + cases hmate : result.mate? with + | none => + cases rows with + | nil => + simp [machineKuhnNextControl, machineKuhnReturnControl, + machineKuhnNonemptyReturnControl, + machineKuhnBuildReturnControl, + machineKuhnBuildRows, machineKuhnBuildChosenMate, + kuhnControlCode, kuhnSearchResultMateCode, + kuhnFrameCode, kuhnStackCode, kuhnBuildFrameCode, + kuhnEvalStep, hmate, finListUnaryCode, + binaryListCode] + | cons row rows => + simp [machineKuhnNextControl, machineKuhnReturnControl, + machineKuhnNonemptyReturnControl, + machineKuhnBuildReturnControl, + machineKuhnBuildContinueControl, + machineKuhnBuildNextStack, + machineKuhnBuildNextFrame, machineKuhnBuildRows, + machineKuhnBuildChosenMate, kuhnControlCode, + kuhnSearchResultMateCode, kuhnFrameCode, + kuhnStackCode, kuhnBuildFrameCode, + kuhnEvalStep, hmate, finRangeUnaryCode, + finListUnaryCode, machineListHead, machineListTail, + machineKuhnStackPush, List.replicate_succ, + binaryListCode] + | some mate' => + cases rows with + | nil => + simp [machineKuhnNextControl, machineKuhnReturnControl, + machineKuhnNonemptyReturnControl, + machineKuhnBuildReturnControl, + machineKuhnBuildRows, machineKuhnBuildChosenMate, + kuhnControlCode, kuhnSearchResultMateCode, + kuhnFrameCode, kuhnStackCode, kuhnBuildFrameCode, + kuhnEvalStep, hmate, finListUnaryCode, + binaryListCode] + | cons row rows => + simp [machineKuhnNextControl, machineKuhnReturnControl, + machineKuhnNonemptyReturnControl, + machineKuhnBuildReturnControl, + machineKuhnBuildContinueControl, + machineKuhnBuildNextStack, + machineKuhnBuildNextFrame, machineKuhnBuildRows, + machineKuhnBuildChosenMate, kuhnControlCode, + kuhnSearchResultMateCode, kuhnFrameCode, + kuhnStackCode, kuhnBuildFrameCode, + kuhnEvalStep, hmate, finRangeUnaryCode, + finListUnaryCode, machineListHead, machineListTail, + machineKuhnStackPush, List.replicate_succ, + binaryListCode] +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineKuhnStep.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineKuhnStep.lean new file mode 100644 index 0000000000..2a7ec777ac --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineKuhnStep.lean @@ -0,0 +1,560 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineKuhnEncoding + +/-! +# One finite-word transition of the Kuhn evaluator + +This is the bit-level implementation of `kuhnEvalStep`. Every branch uses +only pairing, list access/update, Boolean gates, and the rational support +query already shown to lie in `FP`. +-/ + +namespace BeyondBethe + +open Complexity + +/-! ## State-level field access -/ + +def machineKuhnControl (state : List Bool) : List Bool := + machineKuhnStateControl state + +def machineKuhnFuel (state : List Bool) : List Bool := + machineKuhnCallFuel (machineKuhnControl state) + +def machineKuhnRemaining (state : List Bool) : List Bool := + machineKuhnCallRemaining (machineKuhnControl state) + +def machineKuhnRow (state : List Bool) : List Bool := + machineKuhnCallRow (machineKuhnControl state) + +def machineKuhnSeen (state : List Bool) : List Bool := + machineKuhnCallSeen (machineKuhnControl state) + +def machineKuhnMate (state : List Bool) : List Bool := + machineKuhnCallMate (machineKuhnControl state) + +def machineKuhnStack (state : List Bool) : List Bool := + machineKuhnCallStack (machineKuhnControl state) + +def machineKuhnRetSuccess (state : List Bool) : List Bool := + machineKuhnReturnSuccess (machineKuhnControl state) + +def machineKuhnRetSeen (state : List Bool) : List Bool := + machineKuhnReturnSeen (machineKuhnControl state) + +def machineKuhnRetMate (state : List Bool) : List Bool := + machineKuhnReturnMate (machineKuhnControl state) + +def machineKuhnRetStack (state : List Bool) : List Bool := + machineKuhnReturnStack (machineKuhnControl state) + +def machineKuhnTopFrame (state : List Bool) : List Bool := + machineKuhnStackHead (machineKuhnRetStack state) + +def machineKuhnRestStack (state : List Bool) : List Bool := + machineKuhnStackTail (machineKuhnRetStack state) + +theorem machineKuhnControl_mem_FP : machineKuhnControl ∈ Complexity.FP := + machineKuhnStateControl_mem_FP + +theorem machineKuhnFuel_mem_FP : machineKuhnFuel ∈ Complexity.FP := by + simpa only [machineKuhnFuel] using + machineCompose_mem_FP machineKuhnControl_mem_FP machineKuhnCallFuel_mem_FP +theorem machineKuhnRemaining_mem_FP : machineKuhnRemaining ∈ Complexity.FP := by + simpa only [machineKuhnRemaining] using + machineCompose_mem_FP machineKuhnControl_mem_FP + machineKuhnCallRemaining_mem_FP +theorem machineKuhnRow_mem_FP : machineKuhnRow ∈ Complexity.FP := by + simpa only [machineKuhnRow] using + machineCompose_mem_FP machineKuhnControl_mem_FP machineKuhnCallRow_mem_FP +theorem machineKuhnSeen_mem_FP : machineKuhnSeen ∈ Complexity.FP := by + simpa only [machineKuhnSeen] using + machineCompose_mem_FP machineKuhnControl_mem_FP machineKuhnCallSeen_mem_FP +theorem machineKuhnMate_mem_FP : machineKuhnMate ∈ Complexity.FP := by + simpa only [machineKuhnMate] using + machineCompose_mem_FP machineKuhnControl_mem_FP machineKuhnCallMate_mem_FP +theorem machineKuhnStack_mem_FP : machineKuhnStack ∈ Complexity.FP := by + simpa only [machineKuhnStack] using + machineCompose_mem_FP machineKuhnControl_mem_FP machineKuhnCallStack_mem_FP +theorem machineKuhnRetSuccess_mem_FP : machineKuhnRetSuccess ∈ Complexity.FP := by + simpa only [machineKuhnRetSuccess] using + machineCompose_mem_FP machineKuhnControl_mem_FP + machineKuhnReturnSuccess_mem_FP +theorem machineKuhnRetSeen_mem_FP : machineKuhnRetSeen ∈ Complexity.FP := by + simpa only [machineKuhnRetSeen] using + machineCompose_mem_FP machineKuhnControl_mem_FP machineKuhnReturnSeen_mem_FP +theorem machineKuhnRetMate_mem_FP : machineKuhnRetMate ∈ Complexity.FP := by + simpa only [machineKuhnRetMate] using + machineCompose_mem_FP machineKuhnControl_mem_FP machineKuhnReturnMate_mem_FP +theorem machineKuhnRetStack_mem_FP : machineKuhnRetStack ∈ Complexity.FP := by + simpa only [machineKuhnRetStack] using + machineCompose_mem_FP machineKuhnControl_mem_FP + machineKuhnReturnStack_mem_FP +theorem machineKuhnTopFrame_mem_FP : machineKuhnTopFrame ∈ Complexity.FP := by + simpa only [machineKuhnTopFrame] using + machineCompose_mem_FP machineKuhnRetStack_mem_FP + machineKuhnStackHead_mem_FP +theorem machineKuhnRestStack_mem_FP : machineKuhnRestStack ∈ Complexity.FP := by + simpa only [machineKuhnRestStack] using + machineCompose_mem_FP machineKuhnRetStack_mem_FP + machineKuhnStackTail_mem_FP + +/-! ## Repacking with a fixed global clamp -/ + +def machineKuhnClamp (state candidate : List Bool) : List Bool := + candidate.take (machineKuhnStateBound state).length + +def machineKuhnWithControl (state control : List Bool) : List Bool := + machineKuhnStatePack (machineKuhnClamp state control) + (machineKuhnClamp state (machineKuhnStateMatrix state)) + (machineKuhnClamp state (machineKuhnStateDimension state)) + (machineKuhnClamp state (machineKuhnStateColumns state)) + (machineKuhnClamp state (machineKuhnStateFalseSeen state)) + (machineKuhnStateBound state) + +theorem machineKuhnClamp_mem_FP + {candidate : List Bool → List Bool} (hcandidate : candidate ∈ Complexity.FP) : + (fun state ↦ machineKuhnClamp state (candidate state)) ∈ Complexity.FP := by + simpa only [machineKuhnClamp] using + machineTake_mem_FP machineKuhnStateBound_mem_FP hcandidate + +theorem machineKuhnWithControl_mem_FP + {control : List Bool → List Bool} (hcontrol : control ∈ Complexity.FP) : + (fun state ↦ machineKuhnWithControl state (control state)) ∈ + Complexity.FP := by + have hc := machineKuhnClamp_mem_FP hcontrol + have hm := machineKuhnClamp_mem_FP machineKuhnStateMatrix_mem_FP + have hd := machineKuhnClamp_mem_FP machineKuhnStateDimension_mem_FP + have hcols := machineKuhnClamp_mem_FP machineKuhnStateColumns_mem_FP + have hfalse := machineKuhnClamp_mem_FP machineKuhnStateFalseSeen_mem_FP + exact machinePair_mem_FP hc + (machinePair_mem_FP hm + (machinePair_mem_FP hd + (machinePair_mem_FP hcols + (machinePair_mem_FP hfalse machineKuhnStateBound_mem_FP)))) + +/-! ## Call transition -/ + +def machineKuhnCurrentColumn (state : List Bool) : List Bool := + machineListHead (machineKuhnRemaining state) + +def machineKuhnRemainingTail (state : List Bool) : List Bool := + machineListTail (machineKuhnRemaining state) + +def machineKuhnSeenBit (state : List Bool) : List Bool := + machineBoolVectorEntryAtUnary + (pair (machineKuhnCurrentColumn state) (machineKuhnSeen state)) + +def machineKuhnSupportBit (state : List Bool) : List Bool := + machineRationalSupportBitAtUnary + (pair (machineKuhnRow state) + (pair (machineKuhnCurrentColumn state) + (machineKuhnStateMatrix state))) + +def machineKuhnSkipBit (state : List Bool) : List Bool := + machineOrBit (machineKuhnSeenBit state) + (machineNotBit (machineKuhnSupportBit state)) + +def machineKuhnSeenUpdated (state : List Bool) : List Bool := + machineBoolVectorUpdateAtUnary + (pair (machineKuhnCurrentColumn state) + (pair [true] (machineKuhnSeen state))) + +def machineKuhnMateValue (state : List Bool) : List Bool := + machineMateVectorGetAtUnary + (pair (machineKuhnCurrentColumn state) (machineKuhnMate state)) + +def machineKuhnMateIsNoneBit (state : List Bool) : List Bool := + machineMateValueIsNoneBit (machineKuhnMateValue state) + +def machineKuhnSomeCurrentRow (state : List Bool) : List Bool := + true :: machineKuhnRow state + +def machineKuhnMateSetCurrent (state : List Bool) : List Bool := + machineMateVectorUpdateAtUnary + (pair (machineKuhnCurrentColumn state) + (pair (machineKuhnSomeCurrentRow state) (machineKuhnMate state))) + +def machineKuhnMateClearCurrent (state : List Bool) : List Bool := + machineMateVectorUpdateAtUnary + (pair (machineKuhnCurrentColumn state) + (pair [false] (machineKuhnMate state))) + +def machineKuhnFailureControl (state : List Bool) : List Bool := + machineKuhnControlReturn [false] (machineKuhnSeen state) [] + (machineKuhnStack state) + +def machineKuhnSkipControl (state : List Bool) : List Bool := + machineKuhnControlCall (machineKuhnFuel state) + (machineKuhnRemainingTail state) (machineKuhnRow state) + (machineKuhnSeen state) (machineKuhnMate state) (machineKuhnStack state) + +def machineKuhnFreeColumnControl (state : List Bool) : List Bool := + machineKuhnControlReturn [true] (machineKuhnSeenUpdated state) + (machineKuhnMateSetCurrent state) (machineKuhnStack state) + +def machineKuhnSearchFrameCurrent (state : List Bool) : List Bool := + pair [false] + (machineKuhnSearchFramePack (machineKuhnFuel state) + (machineKuhnRemainingTail state) (machineKuhnRow state) + (machineKuhnMate state) (machineKuhnCurrentColumn state)) + +def machineKuhnPushedSearchStack (state : List Bool) : List Bool := + machineKuhnStackPush (machineKuhnSearchFrameCurrent state) + (machineKuhnStack state) + +def machineKuhnOccupiedColumnControl (state : List Bool) : List Bool := + machineKuhnControlCall (machineKuhnFuel state).tail + (machineKuhnStateColumns state) + (machineMateValueRowUnary (machineKuhnMateValue state)) + (machineKuhnSeenUpdated state) (machineKuhnMateClearCurrent state) + (machineKuhnPushedSearchStack state) + +def machineKuhnProceedControl (state : List Bool) : List Bool := + machineIfHead (machineKuhnMateIsNoneBit state) + (machineKuhnFreeColumnControl state) + (machineKuhnOccupiedColumnControl state) + +def machineKuhnNonterminalCallControl (state : List Bool) : List Bool := + machineIfHead (machineKuhnSkipBit state) + (machineKuhnSkipControl state) (machineKuhnProceedControl state) + +def machineKuhnCallControl (state : List Bool) : List Bool := + machineIfEmpty (machineKuhnFuel state) (machineKuhnFailureControl state) + (machineIfEmpty (machineKuhnRemaining state) + (machineKuhnFailureControl state) + (machineKuhnNonterminalCallControl state)) + +/-! ## Return transition -/ + +def machineKuhnSearchReturnSuccessControl (state : List Bool) : List Bool := + let frame := machineKuhnTopFrame state + let mate := machineMateVectorUpdateAtUnary + (pair (machineKuhnSearchFrameColumn frame) + (pair (true :: machineKuhnSearchFrameRow frame) + (machineKuhnRetMate state))) + machineKuhnControlReturn [true] (machineKuhnRetSeen state) mate + (machineKuhnRestStack state) + +def machineKuhnSearchReturnFailureControl (state : List Bool) : List Bool := + let frame := machineKuhnTopFrame state + machineKuhnControlCall (machineKuhnSearchFrameFuel frame) + (machineKuhnSearchFrameRemaining frame) + (machineKuhnSearchFrameRow frame) (machineKuhnRetSeen state) + (machineKuhnSearchFrameMate frame) (machineKuhnRestStack state) + +def machineKuhnSearchReturnControl (state : List Bool) : List Bool := + machineIfHead (machineKuhnRetSuccess state) + (machineKuhnSearchReturnSuccessControl state) + (machineKuhnSearchReturnFailureControl state) + +def machineKuhnBuildChosenMate (state : List Bool) : List Bool := + let frame := machineKuhnTopFrame state + machineIfHead (machineKuhnRetSuccess state) (machineKuhnRetMate state) + (machineKuhnBuildFrameFallback frame) + +def machineKuhnBuildRows (state : List Bool) : List Bool := + machineKuhnBuildFrameRows (machineKuhnTopFrame state) + +def machineKuhnBuildNextFrame (state : List Bool) : List Bool := + pair [true] + (machineKuhnBuildFramePack (machineListTail (machineKuhnBuildRows state)) + (machineKuhnBuildChosenMate state)) + +def machineKuhnBuildNextStack (state : List Bool) : List Bool := + machineKuhnStackPush (machineKuhnBuildNextFrame state) + (machineKuhnRestStack state) + +def machineKuhnBuildContinueControl (state : List Bool) : List Bool := + machineKuhnControlCall (true :: machineKuhnStateDimension state) + (machineKuhnStateColumns state) + (machineListHead (machineKuhnBuildRows state)) + (machineKuhnStateFalseSeen state) (machineKuhnBuildChosenMate state) + (machineKuhnBuildNextStack state) + +def machineKuhnBuildReturnControl (state : List Bool) : List Bool := + machineIfEmpty (machineKuhnBuildRows state) + (machineKuhnControlDone (machineKuhnBuildChosenMate state)) + (machineKuhnBuildContinueControl state) + +def machineKuhnNonemptyReturnControl (state : List Bool) : List Bool := + machineIfHead (machineKuhnFrameTag (machineKuhnTopFrame state)) + (machineKuhnBuildReturnControl state) + (machineKuhnSearchReturnControl state) + +def machineKuhnReturnControl (state : List Bool) : List Bool := + machineIfEmpty (machineKuhnRetStack state) (machineKuhnControl state) + (machineKuhnNonemptyReturnControl state) + +def machineKuhnDoneControl (state : List Bool) : List Bool := + machineKuhnControl state + +/-- The un-clamped next control word. -/ +def machineKuhnNextControl (state : List Bool) : List Bool := + machineIfHead (machineKuhnControlTag (machineKuhnControl state)) + (machineIfHead (machineKuhnControlIsDoneBit (machineKuhnControl state)) + (machineKuhnDoneControl state) (machineKuhnReturnControl state)) + (machineKuhnCallControl state) + +/-- One total finite-word transition. Every variable field is clamped to the +fixed bound carried by the input state. -/ +def machineKuhnStep (state : List Bool) : List Bool := + machineKuhnWithControl state (machineKuhnNextControl state) + +/-! ## Polynomial-time closure proof -/ + +theorem machineKuhnCurrentColumn_mem_FP : + machineKuhnCurrentColumn ∈ Complexity.FP := by + simpa only [machineKuhnCurrentColumn] using + machineCompose_mem_FP machineKuhnRemaining_mem_FP machineListHead_mem_FP + +theorem machineKuhnRemainingTail_mem_FP : + machineKuhnRemainingTail ∈ Complexity.FP := by + simpa only [machineKuhnRemainingTail] using + machineCompose_mem_FP machineKuhnRemaining_mem_FP machineListTail_mem_FP + +theorem machineKuhnSeenBit_mem_FP : machineKuhnSeenBit ∈ Complexity.FP := by + have hp := machinePair_mem_FP machineKuhnCurrentColumn_mem_FP + machineKuhnSeen_mem_FP + simpa only [machineKuhnSeenBit] using + machineCompose_mem_FP hp machineBoolVectorEntryAtUnary_mem_FP + +theorem machineKuhnSupportBit_mem_FP : + machineKuhnSupportBit ∈ Complexity.FP := by + have hp := machinePair_mem_FP machineKuhnRow_mem_FP + (machinePair_mem_FP machineKuhnCurrentColumn_mem_FP + machineKuhnStateMatrix_mem_FP) + simpa only [machineKuhnSupportBit] using + machineCompose_mem_FP hp machineRationalSupportBitAtUnary_mem_FP + +theorem machineKuhnSkipBit_mem_FP : machineKuhnSkipBit ∈ Complexity.FP := by + have hnot := machineNotBit_mem_FP machineKuhnSupportBit_mem_FP + exact machineOrBit_mem_FP machineKuhnSeenBit_mem_FP hnot + +theorem machineKuhnSeenUpdated_mem_FP : + machineKuhnSeenUpdated ∈ Complexity.FP := by + have hp := machinePair_mem_FP machineKuhnCurrentColumn_mem_FP + (machinePair_mem_FP (machineConst_mem_FP [true]) machineKuhnSeen_mem_FP) + simpa only [machineKuhnSeenUpdated] using + machineCompose_mem_FP hp machineBoolVectorUpdateAtUnary_mem_FP + +theorem machineKuhnMateValue_mem_FP : machineKuhnMateValue ∈ Complexity.FP := by + have hp := machinePair_mem_FP machineKuhnCurrentColumn_mem_FP + machineKuhnMate_mem_FP + simpa only [machineKuhnMateValue] using + machineCompose_mem_FP hp machineMateVectorGetAtUnary_mem_FP + +theorem machineKuhnMateIsNoneBit_mem_FP : + machineKuhnMateIsNoneBit ∈ Complexity.FP := by + simpa only [machineKuhnMateIsNoneBit] using + machineCompose_mem_FP machineKuhnMateValue_mem_FP + machineMateValueIsNoneBit_mem_FP + +theorem machineKuhnSomeCurrentRow_mem_FP : + machineKuhnSomeCurrentRow ∈ Complexity.FP := by + simpa only [machineKuhnSomeCurrentRow] using + machineCompose_mem_FP machineKuhnRow_mem_FP (machinePrepend_mem_FP true) + +theorem machineKuhnMateSetCurrent_mem_FP : + machineKuhnMateSetCurrent ∈ Complexity.FP := by + have hp := machinePair_mem_FP machineKuhnCurrentColumn_mem_FP + (machinePair_mem_FP machineKuhnSomeCurrentRow_mem_FP machineKuhnMate_mem_FP) + simpa only [machineKuhnMateSetCurrent] using + machineCompose_mem_FP hp machineMateVectorUpdateAtUnary_mem_FP + +theorem machineKuhnMateClearCurrent_mem_FP : + machineKuhnMateClearCurrent ∈ Complexity.FP := by + have hp := machinePair_mem_FP machineKuhnCurrentColumn_mem_FP + (machinePair_mem_FP (machineConst_mem_FP [false]) machineKuhnMate_mem_FP) + simpa only [machineKuhnMateClearCurrent] using + machineCompose_mem_FP hp machineMateVectorUpdateAtUnary_mem_FP + +theorem machineKuhnFailureControl_mem_FP : + machineKuhnFailureControl ∈ Complexity.FP := by + exact machinePair_mem_FP (machineConst_mem_FP [true, false]) + (machinePair_mem_FP (machineConst_mem_FP [false]) + (machinePair_mem_FP machineKuhnSeen_mem_FP + (machinePair_mem_FP (machineConst_mem_FP []) machineKuhnStack_mem_FP))) + +theorem machineKuhnSkipControl_mem_FP : machineKuhnSkipControl ∈ Complexity.FP := by + exact machinePair_mem_FP (machineConst_mem_FP [false]) + (machinePair_mem_FP machineKuhnFuel_mem_FP + (machinePair_mem_FP machineKuhnRemainingTail_mem_FP + (machinePair_mem_FP machineKuhnRow_mem_FP + (machinePair_mem_FP machineKuhnSeen_mem_FP + (machinePair_mem_FP machineKuhnMate_mem_FP + machineKuhnStack_mem_FP))))) + +theorem machineKuhnFreeColumnControl_mem_FP : + machineKuhnFreeColumnControl ∈ Complexity.FP := by + exact machinePair_mem_FP (machineConst_mem_FP [true, false]) + (machinePair_mem_FP (machineConst_mem_FP [true]) + (machinePair_mem_FP machineKuhnSeenUpdated_mem_FP + (machinePair_mem_FP machineKuhnMateSetCurrent_mem_FP + machineKuhnStack_mem_FP))) + +theorem machineKuhnSearchFrameCurrent_mem_FP : + machineKuhnSearchFrameCurrent ∈ Complexity.FP := by + exact machinePair_mem_FP (machineConst_mem_FP [false]) + (machinePair_mem_FP machineKuhnFuel_mem_FP + (machinePair_mem_FP machineKuhnRemainingTail_mem_FP + (machinePair_mem_FP machineKuhnRow_mem_FP + (machinePair_mem_FP machineKuhnMate_mem_FP + machineKuhnCurrentColumn_mem_FP)))) + +theorem machineKuhnPushedSearchStack_mem_FP : + machineKuhnPushedSearchStack ∈ Complexity.FP := + machinePair_mem_FP machineKuhnSearchFrameCurrent_mem_FP + machineKuhnStack_mem_FP + +theorem machineKuhnOccupiedColumnControl_mem_FP : + machineKuhnOccupiedColumnControl ∈ Complexity.FP := by + have hfuelTail := machineCompose_mem_FP machineKuhnFuel_mem_FP + machineTail_mem_FP + have holdRow := machineCompose_mem_FP machineKuhnMateValue_mem_FP + machineMateValueRowUnary_mem_FP + exact machinePair_mem_FP (machineConst_mem_FP [false]) + (machinePair_mem_FP hfuelTail + (machinePair_mem_FP machineKuhnStateColumns_mem_FP + (machinePair_mem_FP holdRow + (machinePair_mem_FP machineKuhnSeenUpdated_mem_FP + (machinePair_mem_FP machineKuhnMateClearCurrent_mem_FP + machineKuhnPushedSearchStack_mem_FP))))) + +theorem machineKuhnProceedControl_mem_FP : + machineKuhnProceedControl ∈ Complexity.FP := + machineIfHead_mem_FP machineKuhnMateIsNoneBit_mem_FP + machineKuhnFreeColumnControl_mem_FP machineKuhnOccupiedColumnControl_mem_FP + +theorem machineKuhnNonterminalCallControl_mem_FP : + machineKuhnNonterminalCallControl ∈ Complexity.FP := + machineIfHead_mem_FP machineKuhnSkipBit_mem_FP machineKuhnSkipControl_mem_FP + machineKuhnProceedControl_mem_FP + +theorem machineKuhnCallControl_mem_FP : machineKuhnCallControl ∈ Complexity.FP := by + have hinner := machineIfEmpty_mem_FP machineKuhnRemaining_mem_FP + machineKuhnFailureControl_mem_FP machineKuhnNonterminalCallControl_mem_FP + exact machineIfEmpty_mem_FP machineKuhnFuel_mem_FP + machineKuhnFailureControl_mem_FP hinner + +theorem machineKuhnSearchReturnSuccessControl_mem_FP : + machineKuhnSearchReturnSuccessControl ∈ Complexity.FP := by + have hcol := machineCompose_mem_FP machineKuhnTopFrame_mem_FP + machineKuhnSearchFrameColumn_mem_FP + have hrow := machineCompose_mem_FP machineKuhnTopFrame_mem_FP + machineKuhnSearchFrameRow_mem_FP + have hsome := machineCompose_mem_FP hrow (machinePrepend_mem_FP true) + have hp := machinePair_mem_FP hcol + (machinePair_mem_FP hsome machineKuhnRetMate_mem_FP) + have hmate := machineCompose_mem_FP hp machineMateVectorUpdateAtUnary_mem_FP + exact machinePair_mem_FP (machineConst_mem_FP [true, false]) + (machinePair_mem_FP (machineConst_mem_FP [true]) + (machinePair_mem_FP machineKuhnRetSeen_mem_FP + (machinePair_mem_FP hmate machineKuhnRestStack_mem_FP))) + +theorem machineKuhnSearchReturnFailureControl_mem_FP : + machineKuhnSearchReturnFailureControl ∈ Complexity.FP := by + have hfield (f : List Bool → List Bool) (hf : f ∈ Complexity.FP) : + (fun state ↦ f (machineKuhnTopFrame state)) ∈ Complexity.FP := + by simpa only using + machineCompose_mem_FP machineKuhnTopFrame_mem_FP hf + exact machinePair_mem_FP (machineConst_mem_FP [false]) + (machinePair_mem_FP + (hfield machineKuhnSearchFrameFuel machineKuhnSearchFrameFuel_mem_FP) + (machinePair_mem_FP + (hfield machineKuhnSearchFrameRemaining + machineKuhnSearchFrameRemaining_mem_FP) + (machinePair_mem_FP + (hfield machineKuhnSearchFrameRow machineKuhnSearchFrameRow_mem_FP) + (machinePair_mem_FP machineKuhnRetSeen_mem_FP + (machinePair_mem_FP + (hfield machineKuhnSearchFrameMate + machineKuhnSearchFrameMate_mem_FP) + machineKuhnRestStack_mem_FP))))) + +theorem machineKuhnSearchReturnControl_mem_FP : + machineKuhnSearchReturnControl ∈ Complexity.FP := + machineIfHead_mem_FP machineKuhnRetSuccess_mem_FP + machineKuhnSearchReturnSuccessControl_mem_FP + machineKuhnSearchReturnFailureControl_mem_FP + +theorem machineKuhnBuildChosenMate_mem_FP : + machineKuhnBuildChosenMate ∈ Complexity.FP := by + have hfallback := machineCompose_mem_FP machineKuhnTopFrame_mem_FP + machineKuhnBuildFrameFallback_mem_FP + exact machineIfHead_mem_FP machineKuhnRetSuccess_mem_FP + machineKuhnRetMate_mem_FP hfallback + +theorem machineKuhnBuildRows_mem_FP : machineKuhnBuildRows ∈ Complexity.FP := by + simpa only [machineKuhnBuildRows] using + machineCompose_mem_FP machineKuhnTopFrame_mem_FP + machineKuhnBuildFrameRows_mem_FP + +theorem machineKuhnBuildNextFrame_mem_FP : + machineKuhnBuildNextFrame ∈ Complexity.FP := by + have htail := machineCompose_mem_FP machineKuhnBuildRows_mem_FP + machineListTail_mem_FP + exact machinePair_mem_FP (machineConst_mem_FP [true]) + (machinePair_mem_FP htail machineKuhnBuildChosenMate_mem_FP) + +theorem machineKuhnBuildNextStack_mem_FP : + machineKuhnBuildNextStack ∈ Complexity.FP := + machinePair_mem_FP machineKuhnBuildNextFrame_mem_FP + machineKuhnRestStack_mem_FP + +theorem machineKuhnBuildContinueControl_mem_FP : + machineKuhnBuildContinueControl ∈ Complexity.FP := by + have hfuel := machineCompose_mem_FP machineKuhnStateDimension_mem_FP + (machinePrepend_mem_FP true) + have hrow := machineCompose_mem_FP machineKuhnBuildRows_mem_FP + machineListHead_mem_FP + exact machinePair_mem_FP (machineConst_mem_FP [false]) + (machinePair_mem_FP hfuel + (machinePair_mem_FP machineKuhnStateColumns_mem_FP + (machinePair_mem_FP hrow + (machinePair_mem_FP machineKuhnStateFalseSeen_mem_FP + (machinePair_mem_FP machineKuhnBuildChosenMate_mem_FP + machineKuhnBuildNextStack_mem_FP))))) + +theorem machineKuhnBuildReturnControl_mem_FP : + machineKuhnBuildReturnControl ∈ Complexity.FP := by + have hdone := machinePair_mem_FP (machineConst_mem_FP [true, true]) + machineKuhnBuildChosenMate_mem_FP + exact machineIfEmpty_mem_FP machineKuhnBuildRows_mem_FP hdone + machineKuhnBuildContinueControl_mem_FP + +theorem machineKuhnNonemptyReturnControl_mem_FP : + machineKuhnNonemptyReturnControl ∈ Complexity.FP := by + have htag := machineCompose_mem_FP machineKuhnTopFrame_mem_FP + machineKuhnFrameTag_mem_FP + exact machineIfHead_mem_FP htag machineKuhnBuildReturnControl_mem_FP + machineKuhnSearchReturnControl_mem_FP + +theorem machineKuhnReturnControl_mem_FP : + machineKuhnReturnControl ∈ Complexity.FP := + machineIfEmpty_mem_FP machineKuhnRetStack_mem_FP machineKuhnControl_mem_FP + machineKuhnNonemptyReturnControl_mem_FP + +theorem machineKuhnDoneControl_mem_FP : + machineKuhnDoneControl ∈ Complexity.FP := machineKuhnControl_mem_FP + +theorem machineKuhnNextControl_mem_FP : + machineKuhnNextControl ∈ Complexity.FP := by + have htag := machineCompose_mem_FP machineKuhnControl_mem_FP + machineKuhnControlTag_mem_FP + have hdoneBit := machineCompose_mem_FP machineKuhnControl_mem_FP + machineKuhnControlIsDoneBit_mem_FP + have hretOrDone := machineIfHead_mem_FP hdoneBit + machineKuhnDoneControl_mem_FP machineKuhnReturnControl_mem_FP + exact machineIfHead_mem_FP htag hretOrDone machineKuhnCallControl_mem_FP + +theorem machineKuhnStep_mem_FP : machineKuhnStep ∈ Complexity.FP := by + simpa only [machineKuhnStep] using + machineKuhnWithControl_mem_FP machineKuhnNextControl_mem_FP + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineLengthBits.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineLengthBits.lean new file mode 100644 index 0000000000..c3e16d073f --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineLengthBits.lean @@ -0,0 +1,70 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineBinaryAddSemantics + +/-! +# Binary encoding of an input length + +This bounded counter converts the length of a bitstring to ordinary +little-endian binary. It is useful whenever a later machine needs the value +of a unary ruler without expanding an unrestricted binary integer. +-/ + +namespace BeyondBethe + +open Complexity + +def machineLengthBitsStep (acc : List Bool) : List Bool := + machineBinaryAddBits (pair acc [true]) + +def machineLengthBitsWidth (word : List Bool) : List Bool := word + +def machineLengthBits (word : List Bool) : List Bool := + (machineLengthBitsStep)^[word.length] [] + +theorem machineLengthBitsStep_mem_FP : + machineLengthBitsStep ∈ Complexity.FP := by + have hpair := machinePair_mem_FP id_mem_FP (machineConst_mem_FP [true]) + simpa only [machineLengthBitsStep] using + machineCompose_mem_FP hpair machineBinaryAddBits_mem_FP + +theorem machineLengthBitsWidth_mem_FP : + machineLengthBitsWidth ∈ Complexity.FP := id_mem_FP + +theorem machineLengthBitsIterate_encode : ∀ k, + (machineLengthBitsStep)^[k] [] = k.bits := by + intro k + induction k with + | zero => rfl + | succ k ih => + rw [Function.iterate_succ_apply', ih, machineLengthBitsStep] + have hone : ([true] : List Bool) = (1 : ℕ).bits := by rfl + rw [hone, machineBinaryAddBits_pair_natBits] + +private theorem lengthBits_natBits_length_le_self (k : ℕ) : + k.bits.length ≤ k := by + rw [Nat.size_eq_bits_len] + exact Nat.size_le.mpr k.lt_two_pow_self + +theorem machineLengthBitsIterate_length_le_width + (word : List Bool) (iterations : ℕ) (hiterations : iterations ≤ word.length) : + ((machineLengthBitsStep)^[iterations] []).length ≤ + (machineLengthBitsWidth word).length := by + rw [machineLengthBitsIterate_encode] + exact (lengthBits_natBits_length_le_self iterations).trans hiterations + +theorem machineLengthBits_mem_FP : machineLengthBits ∈ Complexity.FP := by + simpa only [machineLengthBits] using + Cobham.iterate_mem_FP machineLengthBitsStep_mem_FP + (machineConst_mem_FP []) id_mem_FP machineLengthBitsWidth_mem_FP + machineLengthBitsIterate_length_le_width + +@[simp] theorem machineLengthBits_encode (word : List Bool) : + machineLengthBits word = word.length.bits := by + rw [machineLengthBits, machineLengthBitsIterate_encode] + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineListIndex.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineListIndex.lean new file mode 100644 index 0000000000..3b7b25ecfd --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineListIndex.lean @@ -0,0 +1,172 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineMatrixDimension + +/-! +# Indexed access to right-nested machine lists + +The index is supplied in unary. This is the representation used by all +bounded row, column, and coordinate loops below: its length is the number of +list tails to take. The routine is total on arbitrary strings and its state +only shrinks, so its global polynomial-time bound does not depend on the input +being a well-formed list code. +-/ + +namespace BeyondBethe + +open Complexity + +def machineListIndexRuler (word : List Bool) : List Bool := + machinePairFirst word + +def machineListIndexData (word : List Bool) : List Bool := + machinePairSecond word + +def machineListIndexFinalState (word : List Bool) : List Bool := + (machineListTail)^[(machineListIndexRuler word).length] + (machineListIndexData word) + +/-- Return the code of the element at the unary index, or the empty word if +the index is outside the encoded list. -/ +def machineListIndex (word : List Bool) : List Bool := + machineListHead (machineListIndexFinalState word) + +theorem machineListIndexRuler_mem_FP : + machineListIndexRuler ∈ Complexity.FP := + machinePairFirst_mem_FP + +theorem machineListIndexData_mem_FP : + machineListIndexData ∈ Complexity.FP := + machinePairSecond_mem_FP + +theorem machineListTail_length_le (word : List Bool) : + (machineListTail word).length ≤ word.length := by + simpa only [machineListTail] using machinePairSecond_length_le word + +theorem machineListTail_iterate_length_le (word : List Bool) : ∀ k, + ((machineListTail)^[k] word).length ≤ word.length := by + intro k + induction k with + | zero => simp + | succ k ih => + rw [Function.iterate_succ_apply'] + exact (machineListTail_length_le _).trans ih + +theorem machineListIndexIterate_length_le_width + (word : List Bool) (iterations : ℕ) + (_ : iterations ≤ (machineListIndexRuler word).length) : + ((machineListTail)^[iterations] + (machineListIndexData word)).length ≤ word.length := by + exact (machineListTail_iterate_length_le + (machineListIndexData word) iterations).trans + (machinePairSecond_length_le word) + +theorem machineListIndexFinalState_mem_FP : + machineListIndexFinalState ∈ Complexity.FP := by + exact Cobham.iterate_mem_FP machineListTail_mem_FP + machineListIndexData_mem_FP machineListIndexRuler_mem_FP id_mem_FP + machineListIndexIterate_length_le_width + +theorem machineListIndex_mem_FP : + machineListIndex ∈ Complexity.FP := by + simpa only [machineListIndex] using + machineCompose_mem_FP machineListIndexFinalState_mem_FP + machineListHead_mem_FP + +theorem machineListIndex_length_le_data (word : List Bool) : + (machineListIndex word).length ≤ (machineListIndexData word).length := by + rw [machineListIndex] + exact (machinePairFirst_length_le (machineListIndexFinalState word)).trans + (machineListTail_iterate_length_le (machineListIndexData word) + (machineListIndexRuler word).length) + +/-! ## Exact semantics -/ + +theorem machineListTail_iterate_binaryListCode + {α : Type*} (encode : α → List Bool) : ∀ (xs : List α) (k : ℕ), + (machineListTail)^[k] (binaryListCode encode xs) = + binaryListCode encode (xs.drop k) := by + intro xs k + induction k generalizing xs with + | zero => simp + | succ k ih => + rw [Function.iterate_succ_apply] + cases xs with + | nil => + have htail : machineListTail [] = [] := by + rfl + simpa [binaryListCode] using ih ([] : List α) + | cons x xs => + rw [machineListTail_cons, ih] + rfl + +theorem machineListIndex_binaryListCode + {α : Type*} (encode : α → List Bool) + (xs : List α) (k : ℕ) (hk : k < xs.length) : + machineListIndex + (pair (List.replicate k true) (binaryListCode encode xs)) = + encode xs[k] := by + rw [machineListIndex, machineListIndexFinalState, + machineListIndexRuler, machinePairFirst_pair, List.length_replicate, + machineListIndexData, machinePairSecond_pair, + machineListTail_iterate_binaryListCode] + rw [List.drop_eq_getElem_cons hk] + exact machineListHead_cons encode xs[k] (xs.drop (k + 1)) + +/-- Read a matrix entry using unary row and column indices. The input is +`pair rowUnary (pair columnUnary matrixCode)`. -/ +def machineMatrixEntryAtUnary (word : List Bool) : List Bool := + let rowUnary := machinePairFirst word + let rest := machinePairSecond word + let columnUnary := machinePairFirst rest + let matrixWord := machinePairSecond rest + let rowCode := machineListIndex + (pair rowUnary (machineMatrixRowsWord matrixWord)) + machineListIndex (pair columnUnary rowCode) + +theorem machineMatrixEntryAtUnary_mem_FP : + machineMatrixEntryAtUnary ∈ Complexity.FP := by + have hrowUnary : (fun word : List Bool => machinePairFirst word) ∈ + Complexity.FP := machinePairFirst_mem_FP + have hrest : (fun word : List Bool => machinePairSecond word) ∈ + Complexity.FP := machinePairSecond_mem_FP + have hcolumnUnary : + (fun word : List Bool => machinePairFirst (machinePairSecond word)) ∈ + Complexity.FP := + machineCompose_mem_FP hrest machinePairFirst_mem_FP + have hmatrixWord : + (fun word : List Bool => machinePairSecond (machinePairSecond word)) ∈ + Complexity.FP := + machineCompose_mem_FP hrest machinePairSecond_mem_FP + have hrows : + (fun word : List Bool => + machineMatrixRowsWord (machinePairSecond (machinePairSecond word))) ∈ + Complexity.FP := + machineCompose_mem_FP hmatrixWord machineMatrixRowsWord_mem_FP + have hrowPayload := machinePair_mem_FP hrowUnary hrows + have hrowCode := machineCompose_mem_FP hrowPayload machineListIndex_mem_FP + have hentryPayload := machinePair_mem_FP hcolumnUnary hrowCode + simpa only [machineMatrixEntryAtUnary] using + machineCompose_mem_FP hentryPayload machineListIndex_mem_FP + +@[simp] theorem machineMatrixEntryAtUnary_encode {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) (i j : Fin n) : + machineMatrixEntryAtUnary + (pair (List.replicate i.1 true) + (pair (List.replicate j.1 true) + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩))) = + rationalEntryBinaryCode (A i j) := by + rw [machineMatrixEntryAtUnary] + simp only [machinePairFirst_pair, machinePairSecond_pair, + machineMatrixRowsWord_encode] + rw [machineListIndex_binaryListCode] + · rw [machineListIndex_binaryListCode] + · simp [rationalMatrixRows, List.getElem_ofFn] + · simp [rationalMatrixRows] + · simp [rationalMatrixRows] + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineListReverse.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineListReverse.lean new file mode 100644 index 0000000000..c6b8c853f4 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineListReverse.lean @@ -0,0 +1,314 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineListUpdate +import Mathlib.Tactic + +/-! +# Reversal of a self-delimiting machine list + +The machine scans a right-nested list code and pushes each decoded head onto +an accumulator. The accumulator is clamped to the input-word length on +arbitrary malformed strings. On canonical list codes its length never +exceeds the input length, so the semantic proof below shows that the clamp is +inactive. +-/ + +namespace BeyondBethe + +open Complexity + +def machineListReversePack + (remaining accumulator bound : List Bool) : List Bool := + pair remaining (pair accumulator bound) + +def machineListReverseRemaining (state : List Bool) : List Bool := + machinePairFirst state + +def machineListReverseAccumulator (state : List Bool) : List Bool := + machinePairFirst (machinePairSecond state) + +def machineListReverseBound (state : List Bool) : List Bool := + machinePairSecond (machinePairSecond state) + +def machineListReverseCandidate (state : List Bool) : List Bool := + pair (machineListHead (machineListReverseRemaining state)) + (machineListReverseAccumulator state) + +def machineListReverseNextAccumulator (state : List Bool) : List Bool := + (machineListReverseCandidate state).take + (machineListReverseBound state).length + +def machineListReverseAdvance (state : List Bool) : List Bool := + machineListReversePack + (machineListTail (machineListReverseRemaining state)) + (machineListReverseNextAccumulator state) + (machineListReverseBound state) + +def machineListReverseStep (state : List Bool) : List Bool := + machineIfEmpty (machineListReverseRemaining state) state + (machineListReverseAdvance state) + +def machineListReverseInit (word : List Bool) : List Bool := + machineListReversePack word [] word + +def machineListReverseWidth (word : List Bool) : List Bool := + machineListReversePack word word word + +def machineListReverseFinalState (word : List Bool) : List Bool := + (machineListReverseStep)^[word.length] (machineListReverseInit word) + +def machineListReverse (word : List Bool) : List Bool := + machineListReverseAccumulator (machineListReverseFinalState word) + +theorem machineListReverseRemaining_mem_FP : + machineListReverseRemaining ∈ Complexity.FP := + machinePairFirst_mem_FP + +theorem machineListReverseAccumulator_mem_FP : + machineListReverseAccumulator ∈ Complexity.FP := by + simpa only [machineListReverseAccumulator] using + machineCompose_mem_FP machinePairSecond_mem_FP machinePairFirst_mem_FP + +theorem machineListReverseBound_mem_FP : + machineListReverseBound ∈ Complexity.FP := by + simpa only [machineListReverseBound] using + machineCompose_mem_FP machinePairSecond_mem_FP machinePairSecond_mem_FP + +theorem machineListReverseCandidate_mem_FP : + machineListReverseCandidate ∈ Complexity.FP := by + have hhead := machineCompose_mem_FP machineListReverseRemaining_mem_FP + machineListHead_mem_FP + exact machinePair_mem_FP hhead machineListReverseAccumulator_mem_FP + +theorem machineListReverseNextAccumulator_mem_FP : + machineListReverseNextAccumulator ∈ Complexity.FP := by + simpa only [machineListReverseNextAccumulator] using + machineTake_mem_FP machineListReverseBound_mem_FP + machineListReverseCandidate_mem_FP + +theorem machineListReverseAdvance_mem_FP : + machineListReverseAdvance ∈ Complexity.FP := by + have htail := machineCompose_mem_FP machineListReverseRemaining_mem_FP + machineListTail_mem_FP + exact machinePair_mem_FP htail + (machinePair_mem_FP machineListReverseNextAccumulator_mem_FP + machineListReverseBound_mem_FP) + +theorem machineListReverseStep_mem_FP : + machineListReverseStep ∈ Complexity.FP := by + exact machineIfEmpty_mem_FP machineListReverseRemaining_mem_FP id_mem_FP + machineListReverseAdvance_mem_FP + +theorem machineListReverseInit_mem_FP : + machineListReverseInit ∈ Complexity.FP := by + exact machinePair_mem_FP id_mem_FP + (machinePair_mem_FP (machineConst_mem_FP []) id_mem_FP) + +theorem machineListReverseWidth_mem_FP : + machineListReverseWidth ∈ Complexity.FP := by + exact machinePair_mem_FP id_mem_FP + (machinePair_mem_FP id_mem_FP id_mem_FP) + +@[simp] theorem machineListReverseRemaining_pack (a b c) : + machineListReverseRemaining (machineListReversePack a b c) = a := by + simp [machineListReverseRemaining, machineListReversePack] + +@[simp] theorem machineListReverseAccumulator_pack (a b c) : + machineListReverseAccumulator (machineListReversePack a b c) = b := by + simp [machineListReverseAccumulator, machineListReversePack] + +@[simp] theorem machineListReverseBound_pack (a b c) : + machineListReverseBound (machineListReversePack a b c) = c := by + simp [machineListReverseBound, machineListReversePack] + +def MachineListReverseStateBound (word state : List Bool) : Prop := + state = machineListReversePack + (machineListReverseRemaining state) + (machineListReverseAccumulator state) + (machineListReverseBound state) ∧ + (machineListReverseRemaining state).length ≤ word.length ∧ + (machineListReverseAccumulator state).length ≤ word.length ∧ + machineListReverseBound state = word + +theorem machineListReverseInit_bound (word : List Bool) : + MachineListReverseStateBound word (machineListReverseInit word) := by + simp [MachineListReverseStateBound, machineListReverseInit] + +theorem machineListReverseStep_bound {word state : List Bool} + (hstate : MachineListReverseStateBound word state) : + MachineListReverseStateBound word (machineListReverseStep state) := by + rcases hstate with ⟨hdecomp, hremaining, haccumulator, hbound⟩ + by_cases hnil : machineListReverseRemaining state = [] + · rw [machineListReverseStep, hnil, machineIfEmpty_nil] + exact ⟨hdecomp, hremaining, haccumulator, hbound⟩ + · rw [machineListReverseStep] + cases hremainingCode : machineListReverseRemaining state with + | nil => exact False.elim (hnil hremainingCode) + | cons bit tail => + rw [machineIfEmpty_cons, machineListReverseAdvance] + simp only [MachineListReverseStateBound, + machineListReverseRemaining_pack, + machineListReverseAccumulator_pack, + machineListReverseBound_pack] + refine ⟨trivial, ?_, ?_, hbound⟩ + · exact (machineListTail_length_le + (machineListReverseRemaining state)).trans hremaining + · rw [machineListReverseNextAccumulator, hbound] + exact List.length_take_le _ _ + +theorem machineListReverseIterate_bound (word : List Bool) : ∀ k, + MachineListReverseStateBound word + ((machineListReverseStep)^[k] (machineListReverseInit word)) := by + intro k + induction k with + | zero => exact machineListReverseInit_bound word + | succ k ih => + rw [Function.iterate_succ_apply'] + exact machineListReverseStep_bound ih + +theorem machineListReverseIterate_length_le_width + (word : List Bool) (iterations : ℕ) (_ : iterations ≤ word.length) : + ((machineListReverseStep)^[iterations] + (machineListReverseInit word)).length ≤ + (machineListReverseWidth word).length := by + rcases machineListReverseIterate_bound word iterations with + ⟨hdecomp, hremaining, haccumulator, hbound⟩ + rw [hdecomp, hbound] + simp only [machineListReversePack, machineListReverseWidth, pair_length] + omega + +theorem machineListReverseFinalState_mem_FP : + machineListReverseFinalState ∈ Complexity.FP := by + exact Cobham.iterate_mem_FP machineListReverseStep_mem_FP + machineListReverseInit_mem_FP id_mem_FP machineListReverseWidth_mem_FP + machineListReverseIterate_length_le_width + +theorem machineListReverse_mem_FP : machineListReverse ∈ Complexity.FP := by + simpa only [machineListReverse] using + machineCompose_mem_FP machineListReverseFinalState_mem_FP + machineListReverseAccumulator_mem_FP + +/-! ## Exact semantics on canonical list codes -/ + +def machineListReverseSemanticState + {alpha : Type*} (encode : alpha → List Bool) + (xs : List alpha) (k : ℕ) : List Bool := + machineListReversePack + (binaryListCode encode (xs.drop k)) + (binaryListCode encode (xs.take k).reverse) + (binaryListCode encode xs) + +theorem machineListReverseInit_semantics + {alpha : Type*} (encode : alpha → List Bool) (xs : List alpha) : + machineListReverseInit (binaryListCode encode xs) = + machineListReverseSemanticState encode xs 0 := by + simp [machineListReverseInit, machineListReverseSemanticState, + binaryListCode] + +theorem machineListReverseStep_semantics + {alpha : Type*} (encode : alpha → List Bool) + (xs : List alpha) (k : ℕ) (hk : k < xs.length) : + machineListReverseStep + (machineListReverseSemanticState encode xs k) = + machineListReverseSemanticState encode xs (k + 1) := by + have hdrop := List.drop_eq_getElem_cons hk + have htake := List.take_concat_get hk + have hprefix : (xs.take (k + 1)).reverse = + xs[k] :: (xs.take k).reverse := by + rw [← htake] + simpa only [List.concat_eq_append] using + (List.reverse_concat (l := xs.take k) (a := xs[k])) + have hprefixLength : + (binaryListCode encode (xs.take (k + 1)).reverse).length ≤ + (binaryListCode encode xs).length := + binaryListCode_take_reverse_length_le encode xs (k + 1) + have htakeBound : + (binaryListCode encode (xs.take (k + 1)).reverse).take + (binaryListCode encode xs).length = + binaryListCode encode (xs.take (k + 1)).reverse := + List.take_of_length_le hprefixLength + have hnonempty : binaryListCode encode (xs.drop k) ≠ [] := by + rw [hdrop] + intro hnil + have hlen := congrArg List.length hnil + simp [binaryListCode] at hlen + rw [machineListReverseStep] + simp only [machineListReverseSemanticState, + machineListReverseRemaining_pack] + rw [machineIfEmpty_of_ne_nil _ _ _ hnonempty, + machineListReverseAdvance] + simp only [machineListReverseRemaining_pack, + machineListReverseAccumulator_pack, machineListReverseBound_pack, + machineListReverseNextAccumulator, machineListReverseCandidate] + rw [hdrop, machineListHead_cons, machineListTail_cons] + change machineListReversePack (binaryListCode encode (xs.drop (k + 1))) + ((binaryListCode encode + (xs[k] :: (xs.take k).reverse)).take + (binaryListCode encode xs).length) + (binaryListCode encode xs) = _ + rw [← hprefix, htakeBound] + +theorem machineListReverseIterate_semantics + {alpha : Type*} (encode : alpha → List Bool) + (xs : List alpha) : ∀ k ≤ xs.length, + (machineListReverseStep)^[k] + (machineListReverseInit (binaryListCode encode xs)) = + machineListReverseSemanticState encode xs k := by + intro k hk + induction k with + | zero => exact machineListReverseInit_semantics encode xs + | succ k ih => + rw [Function.iterate_succ_apply', ih (by omega)] + exact machineListReverseStep_semantics encode xs k (by omega) + +theorem binaryListCode_listLength_le + {alpha : Type*} (encode : alpha → List Bool) : ∀ xs : List alpha, + xs.length ≤ (binaryListCode encode xs).length := by + intro xs + induction xs with + | nil => simp [binaryListCode] + | cons x xs ih => + simp only [List.length_cons, binaryListCode, pair_length] + omega + +theorem machineListReverse_done_iterate + (extra : ℕ) (accumulator bound : List Bool) : + (machineListReverseStep)^[extra] + (machineListReversePack [] accumulator bound) = + machineListReversePack [] accumulator bound := by + induction extra with + | zero => rfl + | succ k ih => + rw [Function.iterate_succ_apply', ih] + simp [machineListReverseStep] + +theorem machineListReverseFinalState_encode + {alpha : Type*} (encode : alpha → List Bool) (xs : List alpha) : + machineListReverseFinalState (binaryListCode encode xs) = + machineListReversePack [] (binaryListCode encode xs.reverse) + (binaryListCode encode xs) := by + let word := binaryListCode encode xs + have hlength : xs.length ≤ word.length := + binaryListCode_listLength_le encode xs + have hsplit : word.length = + (word.length - xs.length) + xs.length := by omega + change (machineListReverseStep)^[word.length] + (machineListReverseInit word) = _ + rw [hsplit, Function.iterate_add_apply, + machineListReverseIterate_semantics encode xs xs.length le_rfl] + simp only [machineListReverseSemanticState, List.drop_length, + List.take_length, binaryListCode, word] + rw [machineListReverse_done_iterate] + +@[simp] theorem machineListReverse_encode + {alpha : Type*} (encode : alpha → List Bool) (xs : List alpha) : + machineListReverse (binaryListCode encode xs) = + binaryListCode encode xs.reverse := by + rw [machineListReverse, machineListReverseFinalState_encode] + simp + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineListUpdate.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineListUpdate.lean new file mode 100644 index 0000000000..d30c0f24fb --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineListUpdate.lean @@ -0,0 +1,1004 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineListIndex + +/-! +# Indexed update of right-nested machine lists + +This file supplies the mutable-array primitive used by the matching and +ellipsoid machines. The input is +`pair indexUnary (pair replacement listCode)`. A first bounded pass removes +the indexed prefix while storing it in reverse order. A second bounded pass +rebuilds the prefix around the replacement. Both passes clamp their growing +field to an explicit quadratic word. The semantic invariant proves that the +clamps are inactive on every canonical in-range list update. +-/ + +namespace BeyondBethe + +open Complexity + +/-! ## Forward scan -/ + +def machineListUpdateRuler (word : List Bool) : List Bool := + machinePairFirst word + +def machineListUpdatePayload (word : List Bool) : List Bool := + machinePairSecond word + +def machineListUpdateReplacement (word : List Bool) : List Bool := + machinePairFirst (machineListUpdatePayload word) + +def machineListUpdateData (word : List Bool) : List Bool := + machinePairSecond (machineListUpdatePayload word) + +def machineListUpdateInputBound (word : List Bool) : List Bool := + machineBinaryMulWidth (machineBinaryMulWidth word) + +def machineListUpdateScanPack + (remaining pref current replacement bound : List Bool) : List Bool := + pair remaining (pair pref (pair current (pair replacement bound))) + +def machineListUpdateScanRemaining (state : List Bool) : List Bool := + machinePairFirst state + +def machineListUpdateScanPrefix (state : List Bool) : List Bool := + machinePairFirst (machinePairSecond state) + +def machineListUpdateScanCurrent (state : List Bool) : List Bool := + machinePairFirst (machinePairSecond (machinePairSecond state)) + +def machineListUpdateScanReplacement (state : List Bool) : List Bool := + machinePairFirst + (machinePairSecond (machinePairSecond (machinePairSecond state))) + +def machineListUpdateScanBound (state : List Bool) : List Bool := + machinePairSecond + (machinePairSecond (machinePairSecond (machinePairSecond state))) + +def machineListUpdateScanPrefixCandidate (state : List Bool) : List Bool := + pair (machineListHead (machineListUpdateScanCurrent state)) + (machineListUpdateScanPrefix state) + +def machineListUpdateScanNextPrefix (state : List Bool) : List Bool := + (machineListUpdateScanPrefixCandidate state).take + (machineListUpdateScanBound state).length + +def machineListUpdateScanAdvance (state : List Bool) : List Bool := + machineListUpdateScanPack + (machineListUpdateScanRemaining state).tail + (machineListUpdateScanNextPrefix state) + (machineListTail (machineListUpdateScanCurrent state)) + (machineListUpdateScanReplacement state) + (machineListUpdateScanBound state) + +def machineListUpdateScanStep (state : List Bool) : List Bool := + machineIfEmpty (machineListUpdateScanRemaining state) state + (machineIfEmpty (machineListUpdateScanCurrent state) state + (machineListUpdateScanAdvance state)) + +def machineListUpdateScanInit (word : List Bool) : List Bool := + machineListUpdateScanPack (machineListUpdateRuler word) [] + (machineListUpdateData word) (machineListUpdateReplacement word) + (machineListUpdateInputBound word) + +def machineListUpdateScanWidth (word : List Bool) : List Bool := + let bound := machineListUpdateInputBound word + machineListUpdateScanPack bound bound bound bound bound + +def machineListUpdateScanFinalState (word : List Bool) : List Bool := + (machineListUpdateScanStep)^[(machineListUpdateRuler word).length] + (machineListUpdateScanInit word) + +theorem machineListUpdateRuler_mem_FP : + machineListUpdateRuler ∈ Complexity.FP := machinePairFirst_mem_FP + +theorem machineListUpdatePayload_mem_FP : + machineListUpdatePayload ∈ Complexity.FP := machinePairSecond_mem_FP + +theorem machineListUpdateReplacement_mem_FP : + machineListUpdateReplacement ∈ Complexity.FP := by + simpa only [machineListUpdateReplacement] using + machineCompose_mem_FP machineListUpdatePayload_mem_FP + machinePairFirst_mem_FP + +theorem machineListUpdateData_mem_FP : + machineListUpdateData ∈ Complexity.FP := by + simpa only [machineListUpdateData] using + machineCompose_mem_FP machineListUpdatePayload_mem_FP + machinePairSecond_mem_FP + +theorem machineListUpdateInputBound_mem_FP : + machineListUpdateInputBound ∈ Complexity.FP := by + simpa only [machineListUpdateInputBound] using + machineCompose_mem_FP machineBinaryMulWidth_mem_FP + machineBinaryMulWidth_mem_FP + +theorem machineBinaryMulWidth_length_mono {left right : List Bool} + (h : left.length ≤ right.length) : + (machineBinaryMulWidth left).length ≤ + (machineBinaryMulWidth right).length := by + simp only [machineBinaryMulWidth, List.length_replicate, + List.length_append] + simpa [pow_two] using + Nat.pow_le_pow_left (Nat.add_le_add_left h 16) 2 + +theorem machineListUpdateInputBound_length_mono {left right : List Bool} + (h : left.length ≤ right.length) : + (machineListUpdateInputBound left).length ≤ + (machineListUpdateInputBound right).length := by + exact machineBinaryMulWidth_length_mono + (machineBinaryMulWidth_length_mono h) + +theorem machineListUpdateScanRemaining_mem_FP : + machineListUpdateScanRemaining ∈ Complexity.FP := + machinePairFirst_mem_FP + +theorem machineListUpdateScanPrefix_mem_FP : + machineListUpdateScanPrefix ∈ Complexity.FP := by + simpa only [machineListUpdateScanPrefix] using + machineCompose_mem_FP machinePairSecond_mem_FP machinePairFirst_mem_FP + +theorem machineListUpdateScanCurrent_mem_FP : + machineListUpdateScanCurrent ∈ Complexity.FP := by + have htail := machineCompose_mem_FP machinePairSecond_mem_FP + machinePairSecond_mem_FP + simpa only [machineListUpdateScanCurrent] using + machineCompose_mem_FP htail machinePairFirst_mem_FP + +theorem machineListUpdateScanReplacement_mem_FP : + machineListUpdateScanReplacement ∈ Complexity.FP := by + have htailTwo := machineCompose_mem_FP machinePairSecond_mem_FP + machinePairSecond_mem_FP + have htailThree := machineCompose_mem_FP htailTwo machinePairSecond_mem_FP + simpa only [machineListUpdateScanReplacement] using + machineCompose_mem_FP htailThree machinePairFirst_mem_FP + +theorem machineListUpdateScanBound_mem_FP : + machineListUpdateScanBound ∈ Complexity.FP := by + have htailTwo := machineCompose_mem_FP machinePairSecond_mem_FP + machinePairSecond_mem_FP + have htailThree := machineCompose_mem_FP htailTwo machinePairSecond_mem_FP + simpa only [machineListUpdateScanBound] using + machineCompose_mem_FP htailThree machinePairSecond_mem_FP + +theorem machineListUpdateScanPrefixCandidate_mem_FP : + machineListUpdateScanPrefixCandidate ∈ Complexity.FP := by + have hhead := machineCompose_mem_FP + machineListUpdateScanCurrent_mem_FP machineListHead_mem_FP + exact machinePair_mem_FP hhead machineListUpdateScanPrefix_mem_FP + +theorem machineListUpdateScanNextPrefix_mem_FP : + machineListUpdateScanNextPrefix ∈ Complexity.FP := by + simpa only [machineListUpdateScanNextPrefix] using + machineTake_mem_FP machineListUpdateScanBound_mem_FP + machineListUpdateScanPrefixCandidate_mem_FP + +theorem machineListUpdateScanAdvance_mem_FP : + machineListUpdateScanAdvance ∈ Complexity.FP := by + have hremaining := machineCompose_mem_FP + machineListUpdateScanRemaining_mem_FP machineTail_mem_FP + have hcurrent := machineCompose_mem_FP + machineListUpdateScanCurrent_mem_FP machineListTail_mem_FP + exact machinePair_mem_FP hremaining + (machinePair_mem_FP machineListUpdateScanNextPrefix_mem_FP + (machinePair_mem_FP hcurrent + (machinePair_mem_FP machineListUpdateScanReplacement_mem_FP + machineListUpdateScanBound_mem_FP))) + +theorem machineListUpdateScanStep_mem_FP : + machineListUpdateScanStep ∈ Complexity.FP := by + have hinner := machineIfEmpty_mem_FP + machineListUpdateScanCurrent_mem_FP id_mem_FP + machineListUpdateScanAdvance_mem_FP + simpa only [machineListUpdateScanStep] using + machineIfEmpty_mem_FP machineListUpdateScanRemaining_mem_FP + id_mem_FP hinner + +theorem machineListUpdateScanInit_mem_FP : + machineListUpdateScanInit ∈ Complexity.FP := by + exact machinePair_mem_FP machineListUpdateRuler_mem_FP + (machinePair_mem_FP (machineConst_mem_FP []) + (machinePair_mem_FP machineListUpdateData_mem_FP + (machinePair_mem_FP machineListUpdateReplacement_mem_FP + machineListUpdateInputBound_mem_FP))) + +theorem machineListUpdateScanWidth_mem_FP : + machineListUpdateScanWidth ∈ Complexity.FP := by + exact machinePair_mem_FP machineListUpdateInputBound_mem_FP + (machinePair_mem_FP machineListUpdateInputBound_mem_FP + (machinePair_mem_FP machineListUpdateInputBound_mem_FP + (machinePair_mem_FP machineListUpdateInputBound_mem_FP + machineListUpdateInputBound_mem_FP))) + +@[simp] theorem machineListUpdateScanRemaining_pack (a b c d e) : + machineListUpdateScanRemaining + (machineListUpdateScanPack a b c d e) = a := by + simp [machineListUpdateScanRemaining, machineListUpdateScanPack] + +@[simp] theorem machineListUpdateScanPrefix_pack (a b c d e) : + machineListUpdateScanPrefix + (machineListUpdateScanPack a b c d e) = b := by + simp [machineListUpdateScanPrefix, machineListUpdateScanPack] + +@[simp] theorem machineListUpdateScanCurrent_pack (a b c d e) : + machineListUpdateScanCurrent + (machineListUpdateScanPack a b c d e) = c := by + simp [machineListUpdateScanCurrent, machineListUpdateScanPack] + +@[simp] theorem machineListUpdateScanReplacement_pack (a b c d e) : + machineListUpdateScanReplacement + (machineListUpdateScanPack a b c d e) = d := by + simp [machineListUpdateScanReplacement, machineListUpdateScanPack] + +@[simp] theorem machineListUpdateScanBound_pack (a b c d e) : + machineListUpdateScanBound + (machineListUpdateScanPack a b c d e) = e := by + simp [machineListUpdateScanBound, machineListUpdateScanPack] + +theorem machineListUpdate_word_length_le_bound (word : List Bool) : + word.length ≤ (machineListUpdateInputBound word).length := by + simp only [machineListUpdateInputBound, machineBinaryMulWidth, + List.length_replicate, List.length_append] + nlinarith + +def MachineListUpdateScanStateBound + (word state : List Bool) : Prop := + let B := (machineListUpdateInputBound word).length + state = machineListUpdateScanPack + (machineListUpdateScanRemaining state) + (machineListUpdateScanPrefix state) + (machineListUpdateScanCurrent state) + (machineListUpdateScanReplacement state) + (machineListUpdateScanBound state) ∧ + (machineListUpdateScanRemaining state).length ≤ B ∧ + (machineListUpdateScanPrefix state).length ≤ B ∧ + (machineListUpdateScanCurrent state).length ≤ B ∧ + (machineListUpdateScanReplacement state).length ≤ B ∧ + (machineListUpdateScanBound state).length ≤ B + +theorem machineListUpdateScanInit_bound (word : List Bool) : + MachineListUpdateScanStateBound word + (machineListUpdateScanInit word) := by + simp only [MachineListUpdateScanStateBound, machineListUpdateScanInit, + machineListUpdateScanRemaining_pack, machineListUpdateScanPrefix_pack, + machineListUpdateScanCurrent_pack, + machineListUpdateScanReplacement_pack, + machineListUpdateScanBound_pack] + have hword := machineListUpdate_word_length_le_bound word + refine ⟨trivial, ?_, by simp, ?_, ?_, le_rfl⟩ + · exact (machinePairFirst_length_le word).trans hword + · exact (machinePairSecond_length_le + (machineListUpdatePayload word)).trans + ((machinePairSecond_length_le word).trans hword) + · exact (machinePairFirst_length_le + (machineListUpdatePayload word)).trans + ((machinePairSecond_length_le word).trans hword) + +theorem machineListUpdateScanStep_bound + {word state : List Bool} + (hstate : MachineListUpdateScanStateBound word state) : + MachineListUpdateScanStateBound word + (machineListUpdateScanStep state) := by + dsimp only [MachineListUpdateScanStateBound] at hstate ⊢ + rcases hstate with ⟨hdecomp, hrem, hprefix, hcurrent, hrepl, hbound⟩ + by_cases hr : machineListUpdateScanRemaining state = [] + · rw [machineListUpdateScanStep, hr, machineIfEmpty_nil] + exact ⟨hdecomp, hrem, hprefix, hcurrent, hrepl, hbound⟩ + · cases hremCode : machineListUpdateScanRemaining state with + | nil => exact False.elim (hr hremCode) + | cons rb rt => + rw [machineListUpdateScanStep, hremCode, machineIfEmpty_cons] + by_cases hc : machineListUpdateScanCurrent state = [] + · rw [hc, machineIfEmpty_nil] + exact ⟨hdecomp, hrem, hprefix, hcurrent, hrepl, hbound⟩ + · cases hcurrentCode : machineListUpdateScanCurrent state with + | nil => exact False.elim (hc hcurrentCode) + | cons cb ct => + rw [machineIfEmpty_cons, machineListUpdateScanAdvance] + simp only [machineListUpdateScanRemaining_pack, + machineListUpdateScanPrefix_pack, + machineListUpdateScanCurrent_pack, + machineListUpdateScanReplacement_pack, + machineListUpdateScanBound_pack] + refine ⟨trivial, ?_, ?_, ?_, hrepl, hbound⟩ + · rw [List.length_tail] + omega + · exact (List.length_take_le _ _).trans hbound + · exact (machineListTail_length_le _).trans hcurrent + +theorem machineListUpdateScanIterate_bound (word : List Bool) : ∀ k, + MachineListUpdateScanStateBound word + ((machineListUpdateScanStep)^[k] + (machineListUpdateScanInit word)) := by + intro k + induction k with + | zero => exact machineListUpdateScanInit_bound word + | succ k ih => + rw [Function.iterate_succ_apply'] + exact machineListUpdateScanStep_bound ih + +theorem machineListUpdateScanIterate_length_le_width + (word : List Bool) (iterations : ℕ) + (_ : iterations ≤ (machineListUpdateRuler word).length) : + ((machineListUpdateScanStep)^[iterations] + (machineListUpdateScanInit word)).length ≤ + (machineListUpdateScanWidth word).length := by + rcases machineListUpdateScanIterate_bound word iterations with + ⟨hdecomp, hrem, hprefix, hcurrent, hrepl, hbound⟩ + rw [hdecomp] + simp only [machineListUpdateScanPack, machineListUpdateScanWidth, + pair_length] + omega + +theorem machineListUpdateScanFinalState_mem_FP : + machineListUpdateScanFinalState ∈ Complexity.FP := by + exact Cobham.iterate_mem_FP machineListUpdateScanStep_mem_FP + machineListUpdateScanInit_mem_FP machineListUpdateRuler_mem_FP + machineListUpdateScanWidth_mem_FP + machineListUpdateScanIterate_length_le_width + +/-! ## Reverse-prefix rebuild -/ + +def machineListUpdateSeed (word : List Bool) : List Bool := + let scan := machineListUpdateScanFinalState word + machineIfEmpty (machineListUpdateScanCurrent scan) [] + ((pair (machineListUpdateScanReplacement scan) + (machineListTail (machineListUpdateScanCurrent scan))).take + (machineListUpdateScanBound scan).length) + +def machineListUpdateRebuildPack + (pref output bound : List Bool) : List Bool := + pair pref (pair output bound) + +def machineListUpdateRebuildPrefix (state : List Bool) : List Bool := + machinePairFirst state + +def machineListUpdateRebuildOutput (state : List Bool) : List Bool := + machinePairFirst (machinePairSecond state) + +def machineListUpdateRebuildBound (state : List Bool) : List Bool := + machinePairSecond (machinePairSecond state) + +def machineListUpdateRebuildCandidate (state : List Bool) : List Bool := + pair (machineListHead (machineListUpdateRebuildPrefix state)) + (machineListUpdateRebuildOutput state) + +def machineListUpdateRebuildNextOutput (state : List Bool) : List Bool := + (machineListUpdateRebuildCandidate state).take + (machineListUpdateRebuildBound state).length + +def machineListUpdateRebuildAdvance (state : List Bool) : List Bool := + machineListUpdateRebuildPack + (machineListTail (machineListUpdateRebuildPrefix state)) + (machineListUpdateRebuildNextOutput state) + (machineListUpdateRebuildBound state) + +def machineListUpdateRebuildStep (state : List Bool) : List Bool := + machineIfEmpty (machineListUpdateRebuildPrefix state) state + (machineListUpdateRebuildAdvance state) + +def machineListUpdateRebuildInit (word : List Bool) : List Bool := + let scan := machineListUpdateScanFinalState word + machineListUpdateRebuildPack (machineListUpdateScanPrefix scan) + (machineListUpdateSeed word) (machineListUpdateScanBound scan) + +def machineListUpdateRebuildWidth (word : List Bool) : List Bool := + let bound := machineListUpdateInputBound word + machineListUpdateRebuildPack bound bound bound + +def machineListUpdateRebuildFinalState (word : List Bool) : List Bool := + (machineListUpdateRebuildStep)^[(machineListUpdateRuler word).length] + (machineListUpdateRebuildInit word) + +/-- Replace the element at the unary index. Out-of-range and malformed +inputs return a total, polynomially bounded default determined above. -/ +def machineListUpdate (word : List Bool) : List Bool := + machineListUpdateRebuildOutput + (machineListUpdateRebuildFinalState word) + +theorem machineListUpdateSeed_mem_FP : + machineListUpdateSeed ∈ Complexity.FP := by + let scan : List Bool → List Bool := machineListUpdateScanFinalState + have hscan : scan ∈ Complexity.FP := + machineListUpdateScanFinalState_mem_FP + have hcurrent := machineCompose_mem_FP hscan + machineListUpdateScanCurrent_mem_FP + have hrepl := machineCompose_mem_FP hscan + machineListUpdateScanReplacement_mem_FP + have htailCurrent := machineCompose_mem_FP hcurrent machineListTail_mem_FP + have hcandidate := machinePair_mem_FP hrepl htailCurrent + have hbound := machineCompose_mem_FP hscan + machineListUpdateScanBound_mem_FP + have htaken := machineTake_mem_FP hbound hcandidate + simpa only [machineListUpdateSeed, scan] using + machineIfEmpty_mem_FP hcurrent (machineConst_mem_FP []) htaken + +theorem machineListUpdateRebuildPrefix_mem_FP : + machineListUpdateRebuildPrefix ∈ Complexity.FP := + machinePairFirst_mem_FP + +theorem machineListUpdateRebuildOutput_mem_FP : + machineListUpdateRebuildOutput ∈ Complexity.FP := by + simpa only [machineListUpdateRebuildOutput] using + machineCompose_mem_FP machinePairSecond_mem_FP machinePairFirst_mem_FP + +theorem machineListUpdateRebuildBound_mem_FP : + machineListUpdateRebuildBound ∈ Complexity.FP := by + simpa only [machineListUpdateRebuildBound] using + machineCompose_mem_FP machinePairSecond_mem_FP machinePairSecond_mem_FP + +theorem machineListUpdateRebuildCandidate_mem_FP : + machineListUpdateRebuildCandidate ∈ Complexity.FP := by + have hhead := machineCompose_mem_FP + machineListUpdateRebuildPrefix_mem_FP machineListHead_mem_FP + exact machinePair_mem_FP hhead machineListUpdateRebuildOutput_mem_FP + +theorem machineListUpdateRebuildNextOutput_mem_FP : + machineListUpdateRebuildNextOutput ∈ Complexity.FP := by + simpa only [machineListUpdateRebuildNextOutput] using + machineTake_mem_FP machineListUpdateRebuildBound_mem_FP + machineListUpdateRebuildCandidate_mem_FP + +theorem machineListUpdateRebuildAdvance_mem_FP : + machineListUpdateRebuildAdvance ∈ Complexity.FP := by + have htail := machineCompose_mem_FP + machineListUpdateRebuildPrefix_mem_FP machineListTail_mem_FP + exact machinePair_mem_FP htail + (machinePair_mem_FP machineListUpdateRebuildNextOutput_mem_FP + machineListUpdateRebuildBound_mem_FP) + +theorem machineListUpdateRebuildStep_mem_FP : + machineListUpdateRebuildStep ∈ Complexity.FP := by + simpa only [machineListUpdateRebuildStep] using + machineIfEmpty_mem_FP machineListUpdateRebuildPrefix_mem_FP + id_mem_FP machineListUpdateRebuildAdvance_mem_FP + +theorem machineListUpdateRebuildInit_mem_FP : + machineListUpdateRebuildInit ∈ Complexity.FP := by + have hprefix := machineCompose_mem_FP + machineListUpdateScanFinalState_mem_FP machineListUpdateScanPrefix_mem_FP + have hbound := machineCompose_mem_FP + machineListUpdateScanFinalState_mem_FP machineListUpdateScanBound_mem_FP + exact machinePair_mem_FP hprefix + (machinePair_mem_FP machineListUpdateSeed_mem_FP hbound) + +theorem machineListUpdateRebuildWidth_mem_FP : + machineListUpdateRebuildWidth ∈ Complexity.FP := by + exact machinePair_mem_FP machineListUpdateInputBound_mem_FP + (machinePair_mem_FP machineListUpdateInputBound_mem_FP + machineListUpdateInputBound_mem_FP) + +@[simp] theorem machineListUpdateRebuildPrefix_pack (a b c) : + machineListUpdateRebuildPrefix + (machineListUpdateRebuildPack a b c) = a := by + simp [machineListUpdateRebuildPrefix, machineListUpdateRebuildPack] + +@[simp] theorem machineListUpdateRebuildOutput_pack (a b c) : + machineListUpdateRebuildOutput + (machineListUpdateRebuildPack a b c) = b := by + simp [machineListUpdateRebuildOutput, machineListUpdateRebuildPack] + +@[simp] theorem machineListUpdateRebuildBound_pack (a b c) : + machineListUpdateRebuildBound + (machineListUpdateRebuildPack a b c) = c := by + simp [machineListUpdateRebuildBound, machineListUpdateRebuildPack] + +def MachineListUpdateRebuildStateBound + (word state : List Bool) : Prop := + let B := (machineListUpdateInputBound word).length + state = machineListUpdateRebuildPack + (machineListUpdateRebuildPrefix state) + (machineListUpdateRebuildOutput state) + (machineListUpdateRebuildBound state) ∧ + (machineListUpdateRebuildPrefix state).length ≤ B ∧ + (machineListUpdateRebuildOutput state).length ≤ B ∧ + (machineListUpdateRebuildBound state).length ≤ B + +theorem machineListUpdateRebuildInit_bound (word : List Bool) : + MachineListUpdateRebuildStateBound word + (machineListUpdateRebuildInit word) := by + have hscan := machineListUpdateScanIterate_bound word + (machineListUpdateRuler word).length + change MachineListUpdateScanStateBound word + (machineListUpdateScanFinalState word) at hscan + dsimp only [MachineListUpdateScanStateBound] at hscan + rcases hscan with ⟨_, _, hprefix, _, _, hbound⟩ + simp only [MachineListUpdateRebuildStateBound, + machineListUpdateRebuildInit, + machineListUpdateRebuildPrefix_pack, + machineListUpdateRebuildOutput_pack, + machineListUpdateRebuildBound_pack] + refine ⟨trivial, hprefix, ?_, hbound⟩ + simp only [machineListUpdateSeed] + exact (machineIfEmpty_length_le_max _ _ _).trans (by + apply max_le + · simp + · exact (List.length_take_le _ _).trans hbound) + +theorem machineListUpdateRebuildStep_bound + {word state : List Bool} + (hstate : MachineListUpdateRebuildStateBound word state) : + MachineListUpdateRebuildStateBound word + (machineListUpdateRebuildStep state) := by + dsimp only [MachineListUpdateRebuildStateBound] at hstate ⊢ + rcases hstate with ⟨hdecomp, hprefix, houtput, hbound⟩ + by_cases hp : machineListUpdateRebuildPrefix state = [] + · rw [machineListUpdateRebuildStep, hp, machineIfEmpty_nil] + exact ⟨hdecomp, hprefix, houtput, hbound⟩ + · cases hprefixCode : machineListUpdateRebuildPrefix state with + | nil => exact False.elim (hp hprefixCode) + | cons pb pt => + rw [machineListUpdateRebuildStep, hprefixCode] + rw [machineIfEmpty_cons, + machineListUpdateRebuildAdvance] + simp only [machineListUpdateRebuildPrefix_pack, + machineListUpdateRebuildOutput_pack, + machineListUpdateRebuildBound_pack] + refine ⟨trivial, ?_, ?_, hbound⟩ + · exact (machineListTail_length_le _).trans hprefix + · exact (List.length_take_le _ _).trans hbound + +theorem machineListUpdateRebuildIterate_bound (word : List Bool) : ∀ k, + MachineListUpdateRebuildStateBound word + ((machineListUpdateRebuildStep)^[k] + (machineListUpdateRebuildInit word)) := by + intro k + induction k with + | zero => exact machineListUpdateRebuildInit_bound word + | succ k ih => + rw [Function.iterate_succ_apply'] + exact machineListUpdateRebuildStep_bound ih + +theorem machineListUpdateRebuildIterate_length_le_width + (word : List Bool) (iterations : ℕ) + (_ : iterations ≤ (machineListUpdateRuler word).length) : + ((machineListUpdateRebuildStep)^[iterations] + (machineListUpdateRebuildInit word)).length ≤ + (machineListUpdateRebuildWidth word).length := by + rcases machineListUpdateRebuildIterate_bound word iterations with + ⟨hdecomp, hprefix, houtput, hbound⟩ + rw [hdecomp] + simp only [machineListUpdateRebuildPack, machineListUpdateRebuildWidth, + pair_length] + omega + +theorem machineListUpdateRebuildFinalState_mem_FP : + machineListUpdateRebuildFinalState ∈ Complexity.FP := by + exact Cobham.iterate_mem_FP machineListUpdateRebuildStep_mem_FP + machineListUpdateRebuildInit_mem_FP machineListUpdateRuler_mem_FP + machineListUpdateRebuildWidth_mem_FP + machineListUpdateRebuildIterate_length_le_width + +theorem machineListUpdate_mem_FP : + machineListUpdate ∈ Complexity.FP := by + simpa only [machineListUpdate] using + machineCompose_mem_FP machineListUpdateRebuildFinalState_mem_FP + machineListUpdateRebuildOutput_mem_FP + +/-! ## Exact semantics on canonical list codes -/ + +theorem binaryListCode_length_eq_sum + {α : Type*} (encode : α → List Bool) : ∀ xs : List α, + (binaryListCode encode xs).length = + (xs.map fun x ↦ 2 * (encode x).length + 2).sum := by + intro xs + induction xs with + | nil => simp [binaryListCode] + | cons x xs ih => + simp only [binaryListCode, pair_length, List.map_cons, List.sum_cons, ih] + +private theorem natList_sum_take_le_sum : ∀ (xs : List ℕ) (k : ℕ), + (xs.take k).sum ≤ xs.sum := by + intro xs k + induction xs generalizing k with + | nil => simp + | cons x xs ih => + cases k with + | zero => simp + | succ k => + simp only [List.take_succ_cons, List.sum_cons] + exact Nat.add_le_add_left (ih k) x + +theorem binaryListCode_take_reverse_length_le + {α : Type*} (encode : α → List Bool) (xs : List α) (k : ℕ) : + (binaryListCode encode (xs.take k).reverse).length ≤ + (binaryListCode encode xs).length := by + rw [binaryListCode_length_eq_sum, binaryListCode_length_eq_sum, + List.map_reverse, List.sum_reverse, List.map_take] + exact natList_sum_take_le_sum _ _ + +theorem binaryListCode_drop_length_le + {α : Type*} (encode : α → List Bool) (xs : List α) (k : ℕ) : + (binaryListCode encode (xs.drop k)).length ≤ + (binaryListCode encode xs).length := by + rw [binaryListCode_length_eq_sum, binaryListCode_length_eq_sum, + List.map_drop] + have h := congrArg List.sum + (show (xs.map fun x ↦ 2 * (encode x).length + 2).take k ++ + (xs.map fun x ↦ 2 * (encode x).length + 2).drop k = + xs.map fun x ↦ 2 * (encode x).length + 2 by + exact List.take_append_drop _ _) + simp only [List.sum_append] at h + omega + +theorem binaryListCode_element_length_le + {α : Type*} (encode : α → List Bool) + {x : α} {xs : List α} (hx : x ∈ xs) : + (encode x).length ≤ (binaryListCode encode xs).length := by + induction xs with + | nil => simp at hx + | cons y ys ih => + simp only [List.mem_cons] at hx + rcases hx with rfl | hx + · simp only [binaryListCode, pair_length] + omega + · exact (ih hx).trans (by simp [binaryListCode]) + +def machineListUpdateCanonicalInput + {α : Type*} (encode : α → List Bool) + (xs : List α) (replacement : α) (index : ℕ) : List Bool := + pair (List.replicate index true) + (pair (encode replacement) (binaryListCode encode xs)) + +def machineListUpdateScanSemanticState + {α : Type*} (encode : α → List Bool) + (xs : List α) (replacement : α) (index k : ℕ) : List Bool := + let word := machineListUpdateCanonicalInput encode xs replacement index + machineListUpdateScanPack (List.replicate (index - k) true) + (binaryListCode encode (xs.take k).reverse) + (binaryListCode encode (xs.drop k)) (encode replacement) + (machineListUpdateInputBound word) + +theorem machineListUpdateScanInit_semantics + {α : Type*} (encode : α → List Bool) + (xs : List α) (replacement : α) (index : ℕ) : + machineListUpdateScanInit + (machineListUpdateCanonicalInput encode xs replacement index) = + machineListUpdateScanSemanticState encode xs replacement index 0 := by + simp [machineListUpdateScanInit, machineListUpdateScanSemanticState, + machineListUpdateCanonicalInput, machineListUpdateRuler, + machineListUpdateData, machineListUpdatePayload, + machineListUpdateReplacement, binaryListCode] + +theorem machineListUpdateScanStep_semantics + {α : Type*} (encode : α → List Bool) + (xs : List α) (replacement : α) (index k : ℕ) + (hk : k < index) (hindex : index < xs.length) : + machineListUpdateScanStep + (machineListUpdateScanSemanticState + encode xs replacement index k) = + machineListUpdateScanSemanticState + encode xs replacement index (k + 1) := by + let word := machineListUpdateCanonicalInput encode xs replacement index + have hkxs : k < xs.length := hk.trans hindex + have hremain : index - k = (index - (k + 1)) + 1 := by omega + have hdrop := List.drop_eq_getElem_cons hkxs + have htake := List.take_concat_get hkxs + have hprefix : (xs.take (k + 1)).reverse = + xs[k] :: (xs.take k).reverse := by + rw [← htake] + simpa only [List.concat_eq_append] using + (List.reverse_concat (l := xs.take k) (a := xs[k])) + have hprefixLength : + (binaryListCode encode (xs.take (k + 1)).reverse).length ≤ + (machineListUpdateInputBound word).length := by + exact (binaryListCode_take_reverse_length_le encode xs (k + 1)).trans + ((show (binaryListCode encode xs).length ≤ word.length by + simp only [word, machineListUpdateCanonicalInput, pair_length] + omega).trans + (machineListUpdate_word_length_le_bound word)) + have htakeBound : + (binaryListCode encode (xs.take (k + 1)).reverse).take + (machineListUpdateInputBound word).length = + binaryListCode encode (xs.take (k + 1)).reverse := + List.take_of_length_le hprefixLength + have hcurrentNonempty : + binaryListCode encode (xs.drop k) ≠ [] := by + rw [hdrop] + intro hnil + have hlen := congrArg List.length hnil + simp [binaryListCode] at hlen + have hhead : + machineListHead (binaryListCode encode (xs.drop k)) = encode xs[k] := by + rw [hdrop] + exact machineListHead_cons encode xs[k] (xs.drop (k + 1)) + have htail : + machineListTail (binaryListCode encode (xs.drop k)) = + binaryListCode encode (xs.drop (k + 1)) := by + rw [hdrop] + exact machineListTail_cons encode xs[k] (xs.drop (k + 1)) + have hnextPrefix : + (pair (machineListHead (binaryListCode encode (xs.drop k))) + (binaryListCode encode (xs.take k).reverse)).take + (machineListUpdateInputBound word).length = + binaryListCode encode (xs.take (k + 1)).reverse := by + rw [hhead] + change (binaryListCode encode + (xs[k] :: (xs.take k).reverse)).take + (machineListUpdateInputBound word).length = _ + rw [← hprefix] + exact htakeBound + rw [machineListUpdateScanStep] + simp only [machineListUpdateScanSemanticState, + machineListUpdateScanRemaining_pack, hremain, List.replicate_succ, + machineIfEmpty_cons, machineListUpdateScanCurrent_pack] + rw [machineIfEmpty_of_ne_nil _ _ _ hcurrentNonempty] + simp only [machineListUpdateScanAdvance, + machineListUpdateScanRemaining_pack, List.tail_cons, + machineListUpdateScanCurrent_pack, + machineListUpdateScanReplacement_pack, + machineListUpdateScanBound_pack, + machineListUpdateScanNextPrefix, + machineListUpdateScanPrefixCandidate, + machineListUpdateScanPrefix_pack] + rw [hnextPrefix, htail] + +theorem machineListUpdateScanIterate_semantics + {α : Type*} (encode : α → List Bool) + (xs : List α) (replacement : α) (index : ℕ) + (hindex : index < xs.length) : ∀ k ≤ index, + (machineListUpdateScanStep)^[k] + (machineListUpdateScanInit + (machineListUpdateCanonicalInput encode xs replacement index)) = + machineListUpdateScanSemanticState + encode xs replacement index k := by + intro k hk + induction k with + | zero => exact machineListUpdateScanInit_semantics _ _ _ _ + | succ k ih => + rw [Function.iterate_succ_apply', ih (by omega)] + exact machineListUpdateScanStep_semantics + encode xs replacement index k (by omega) hindex + +theorem machineListUpdateScanFinalState_semantics + {α : Type*} (encode : α → List Bool) + (xs : List α) (replacement : α) (index : ℕ) + (hindex : index < xs.length) : + machineListUpdateScanFinalState + (machineListUpdateCanonicalInput encode xs replacement index) = + machineListUpdateScanSemanticState + encode xs replacement index index := by + rw [machineListUpdateScanFinalState] + simp only [machineListUpdateRuler, machineListUpdateCanonicalInput, + machinePairFirst_pair, List.length_replicate] + exact machineListUpdateScanIterate_semantics + encode xs replacement index hindex index le_rfl + +theorem binaryListCode_append_length + {α : Type*} (encode : α → List Bool) : ∀ xs ys : List α, + (binaryListCode encode (xs ++ ys)).length = + (binaryListCode encode xs).length + + (binaryListCode encode ys).length := by + intro xs ys + induction xs with + | nil => simp [binaryListCode] + | cons x xs ih => + simp only [List.cons_append, binaryListCode, pair_length, ih] + omega + +theorem machineListUpdate_double_word_length_le_bound (word : List Bool) : + 2 * word.length ≤ (machineListUpdateInputBound word).length := by + simp only [machineListUpdateInputBound, machineBinaryMulWidth, + List.length_replicate, List.length_append] + nlinarith + +theorem machineListUpdateSeed_semantics + {α : Type*} (encode : α → List Bool) + (xs : List α) (replacement : α) (index : ℕ) + (hindex : index < xs.length) : + machineListUpdateSeed + (machineListUpdateCanonicalInput encode xs replacement index) = + binaryListCode encode (replacement :: xs.drop (index + 1)) := by + let word := machineListUpdateCanonicalInput encode xs replacement index + have hdrop := List.drop_eq_getElem_cons hindex + have hseedLength : + (binaryListCode encode (replacement :: xs.drop (index + 1))).length ≤ + (machineListUpdateInputBound word).length := by + have hdropLength := binaryListCode_drop_length_le + encode xs (index + 1) + have hword : + (binaryListCode encode + (replacement :: xs.drop (index + 1))).length ≤ word.length := by + simp only [binaryListCode, pair_length, word, + machineListUpdateCanonicalInput] + omega + exact hword.trans (machineListUpdate_word_length_le_bound word) + rw [machineListUpdateSeed, machineListUpdateScanFinalState_semantics + encode xs replacement index hindex] + simp only [machineListUpdateScanSemanticState, + machineListUpdateScanCurrent_pack, + machineListUpdateScanReplacement_pack, + machineListUpdateScanBound_pack, Nat.sub_self, + List.replicate_zero] + rw [hdrop] + rw [machineIfEmpty_of_ne_nil] + · rw [machineListTail_cons] + change (binaryListCode encode + (replacement :: xs.drop (index + 1))).take + (machineListUpdateInputBound word).length = _ + exact List.take_of_length_le hseedLength + · intro hnil + have hlen := congrArg List.length hnil + simp [binaryListCode] at hlen + +def machineListUpdateRebuildSemanticState + {α : Type*} (encode : α → List Bool) + (xs : List α) (replacement : α) (index k : ℕ) : List Bool := + let word := machineListUpdateCanonicalInput encode xs replacement index + let pref := (xs.take index).reverse + let suffix := replacement :: xs.drop (index + 1) + machineListUpdateRebuildPack (binaryListCode encode (pref.drop k)) + (binaryListCode encode ((pref.take k).reverse ++ suffix)) + (machineListUpdateInputBound word) + +theorem machineListUpdateRebuildInit_semantics + {α : Type*} (encode : α → List Bool) + (xs : List α) (replacement : α) (index : ℕ) + (hindex : index < xs.length) : + machineListUpdateRebuildInit + (machineListUpdateCanonicalInput encode xs replacement index) = + machineListUpdateRebuildSemanticState + encode xs replacement index 0 := by + rw [machineListUpdateRebuildInit, + machineListUpdateScanFinalState_semantics + encode xs replacement index hindex, + machineListUpdateSeed_semantics encode xs replacement index hindex] + simp [machineListUpdateRebuildSemanticState, + machineListUpdateScanSemanticState, binaryListCode] + +theorem machineListUpdateRebuildStep_semantics + {α : Type*} (encode : α → List Bool) + (xs : List α) (replacement : α) (index k : ℕ) + (hk : k < index) (hindex : index < xs.length) : + machineListUpdateRebuildStep + (machineListUpdateRebuildSemanticState + encode xs replacement index k) = + machineListUpdateRebuildSemanticState + encode xs replacement index (k + 1) := by + let word := machineListUpdateCanonicalInput encode xs replacement index + let pref := (xs.take index).reverse + let suffix := replacement :: xs.drop (index + 1) + have hindexLe : index ≤ xs.length := hindex.le + have hprefLength : pref.length = index := by + simp [pref, List.length_take_of_le hindexLe] + have hkPref : k < pref.length := by omega + have hdrop := List.drop_eq_getElem_cons hkPref + have htake := List.take_concat_get hkPref + have hpart : (pref.take (k + 1)).reverse = + pref[k] :: (pref.take k).reverse := by + rw [← htake] + simpa only [List.concat_eq_append] using + (List.reverse_concat (l := pref.take k) (a := pref[k])) + have hprefCodeLength : + (binaryListCode encode pref).length ≤ + (binaryListCode encode xs).length := by + simpa only [pref] using + binaryListCode_take_reverse_length_le encode xs index + have hpartCodeLength : + (binaryListCode encode (pref.take (k + 1)).reverse).length ≤ + word.length := by + exact (binaryListCode_take_reverse_length_le encode pref (k + 1)).trans + (hprefCodeLength.trans (by + simp only [word, machineListUpdateCanonicalInput, pair_length] + omega)) + have hsuffixCodeLength : + (binaryListCode encode suffix).length ≤ word.length := by + have hdropLength := binaryListCode_drop_length_le + encode xs (index + 1) + simp only [suffix, binaryListCode, pair_length, word, + machineListUpdateCanonicalInput] + omega + have hnextLength : + (binaryListCode encode + ((pref.take (k + 1)).reverse ++ suffix)).length ≤ + (machineListUpdateInputBound word).length := by + rw [binaryListCode_append_length] + exact (Nat.add_le_add hpartCodeLength hsuffixCodeLength).trans + (by simpa [two_mul] using + machineListUpdate_double_word_length_le_bound word) + have htakeBound : + (binaryListCode encode + ((pref.take (k + 1)).reverse ++ suffix)).take + (machineListUpdateInputBound word).length = + binaryListCode encode + ((pref.take (k + 1)).reverse ++ suffix) := + List.take_of_length_le hnextLength + have hprefNonempty : binaryListCode encode (pref.drop k) ≠ [] := by + rw [hdrop] + intro hnil + have hlen := congrArg List.length hnil + simp [binaryListCode] at hlen + have hhead : + machineListHead (binaryListCode encode (pref.drop k)) = + encode pref[k] := by + rw [hdrop] + exact machineListHead_cons encode pref[k] (pref.drop (k + 1)) + have htail : + machineListTail (binaryListCode encode (pref.drop k)) = + binaryListCode encode (pref.drop (k + 1)) := by + rw [hdrop] + exact machineListTail_cons encode pref[k] (pref.drop (k + 1)) + have hnextOutput : + (pair (machineListHead (binaryListCode encode (pref.drop k))) + (binaryListCode encode ((pref.take k).reverse ++ suffix))).take + (machineListUpdateInputBound word).length = + binaryListCode encode + ((pref.take (k + 1)).reverse ++ suffix) := by + rw [hhead] + change (binaryListCode encode + (pref[k] :: (pref.take k).reverse ++ suffix)).take + (machineListUpdateInputBound word).length = _ + rw [← hpart] + exact htakeBound + rw [machineListUpdateRebuildStep] + simp only [machineListUpdateRebuildSemanticState, + machineListUpdateRebuildPrefix_pack] + rw [machineIfEmpty_of_ne_nil _ _ _ hprefNonempty] + simp only [machineListUpdateRebuildAdvance, + machineListUpdateRebuildPrefix_pack, + machineListUpdateRebuildOutput_pack, + machineListUpdateRebuildBound_pack, + machineListUpdateRebuildNextOutput, + machineListUpdateRebuildCandidate] + rw [htail, hnextOutput] + +theorem machineListUpdateRebuildIterate_semantics + {α : Type*} (encode : α → List Bool) + (xs : List α) (replacement : α) (index : ℕ) + (hindex : index < xs.length) : ∀ k ≤ index, + (machineListUpdateRebuildStep)^[k] + (machineListUpdateRebuildInit + (machineListUpdateCanonicalInput encode xs replacement index)) = + machineListUpdateRebuildSemanticState + encode xs replacement index k := by + intro k hk + induction k with + | zero => + simpa using (machineListUpdateRebuildInit_semantics + encode xs replacement index hindex) + | succ k ih => + rw [Function.iterate_succ_apply', ih (by omega)] + exact machineListUpdateRebuildStep_semantics + encode xs replacement index k (by omega) hindex + +theorem machineListUpdateRebuildFinalState_semantics + {α : Type*} (encode : α → List Bool) + (xs : List α) (replacement : α) (index : ℕ) + (hindex : index < xs.length) : + machineListUpdateRebuildFinalState + (machineListUpdateCanonicalInput encode xs replacement index) = + machineListUpdateRebuildSemanticState + encode xs replacement index index := by + rw [machineListUpdateRebuildFinalState] + simp only [machineListUpdateRuler, machineListUpdateCanonicalInput, + machinePairFirst_pair, List.length_replicate] + exact machineListUpdateRebuildIterate_semantics + encode xs replacement index hindex index le_rfl + +@[simp] theorem machineListUpdate_binaryListCode + {α : Type*} (encode : α → List Bool) + (xs : List α) (replacement : α) (index : ℕ) + (hindex : index < xs.length) : + machineListUpdate + (machineListUpdateCanonicalInput encode xs replacement index) = + binaryListCode encode (xs.set index replacement) := by + rw [machineListUpdate, machineListUpdateRebuildFinalState_semantics + encode xs replacement index hindex] + simp only [machineListUpdateRebuildSemanticState, + machineListUpdateRebuildOutput_pack] + have htakeLength : (xs.take index).length = index := + List.length_take_of_le hindex.le + have hprefLength : (xs.take index).reverse.length = index := by + simp [htakeLength] + have htakePref : + List.take index (xs.take index).reverse = (xs.take index).reverse := by + exact List.take_of_length_le hprefLength.le + rw [htakePref, List.reverse_reverse] + rw [List.set_eq_take_cons_drop replacement hindex] + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineMatchingGain.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineMatchingGain.lean new file mode 100644 index 0000000000..2c11115f83 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineMatchingGain.lean @@ -0,0 +1,428 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineGreedyRowMatching +import LeanPool.BeyondBethe.BeyondBethe.MachineCertificateAssembly + +/-! +# Counting the selected pairs and assembling the fixed matching gain + +The matching machine returns a self-delimiting list of ordered endpoint pairs. +This module counts that list with a verified binary counter and multiplies the +count by the fixed rational gain. The counter iterates for the bit-length of +the input word and stutters after the encoded list is exhausted, so it is a +total polynomial-time string function even on malformed inputs. +-/ + +namespace BeyondBethe + +open Complexity + +def machineListCountPack + (remaining counter source : List Bool) : List Bool := + pair remaining (pair counter source) + +def machineListCountRemaining (state : List Bool) : List Bool := + machinePairFirst state + +def machineListCountCounter (state : List Bool) : List Bool := + machinePairFirst (machinePairSecond state) + +def machineListCountSource (state : List Bool) : List Bool := + machinePairSecond (machinePairSecond state) + +def machineListCountInputBound (word : List Bool) : List Bool := + pair [false] word + +def machineListCountBound (state : List Bool) : List Bool := + machineListCountInputBound (machineListCountSource state) + +def machineListCountNextCounter (state : List Bool) : List Bool := + (machineBinaryAddBits + (pair (machineListCountCounter state) [true])).take + (machineListCountBound state).length + +def machineListCountProcess (state : List Bool) : List Bool := + machineListCountPack + (machineListTail (machineListCountRemaining state)) + (machineListCountNextCounter state) + (machineListCountSource state) + +def machineListCountStep (state : List Bool) : List Bool := + machineIfEmpty (machineListCountRemaining state) state + (machineListCountProcess state) + +def machineListCountInit (word : List Bool) : List Bool := + machineListCountPack word [] word + +def machineListCountWidth (word : List Bool) : List Bool := + let bound := machineListCountInputBound word + machineListCountPack bound bound bound + +def machineEncodedListLengthBits (word : List Bool) : List Bool := + machineListCountCounter + ((machineListCountStep)^[word.length] (machineListCountInit word)) + +theorem machineListCountRemaining_mem_FP : + machineListCountRemaining ∈ FP := machinePairFirst_mem_FP + +theorem machineListCountCounter_mem_FP : + machineListCountCounter ∈ FP := by + simpa only [machineListCountCounter] using machineCompose_mem_FP + machinePairSecond_mem_FP machinePairFirst_mem_FP + +theorem machineListCountSource_mem_FP : + machineListCountSource ∈ FP := by + simpa only [machineListCountSource] using machineCompose_mem_FP + machinePairSecond_mem_FP machinePairSecond_mem_FP + +theorem machineListCountInputBound_mem_FP : + machineListCountInputBound ∈ FP := + machinePair_mem_FP (machineConst_mem_FP [false]) id_mem_FP + +theorem machineListCountBound_mem_FP : + machineListCountBound ∈ FP := by + simpa only [machineListCountBound] using machineCompose_mem_FP + machineListCountSource_mem_FP machineListCountInputBound_mem_FP + +theorem machineListCountNextCounter_mem_FP : + machineListCountNextCounter ∈ FP := by + have hinput := machinePair_mem_FP machineListCountCounter_mem_FP + (machineConst_mem_FP [true]) + have hadd := machineCompose_mem_FP hinput machineBinaryAddBits_mem_FP + simpa only [machineListCountNextCounter] using + machineTake_mem_FP machineListCountBound_mem_FP hadd + +theorem machineListCountProcess_mem_FP : + machineListCountProcess ∈ FP := by + have htail := machineCompose_mem_FP machineListCountRemaining_mem_FP + machineListTail_mem_FP + exact machinePair_mem_FP htail + (machinePair_mem_FP machineListCountNextCounter_mem_FP + machineListCountSource_mem_FP) + +theorem machineListCountStep_mem_FP : + machineListCountStep ∈ FP := by + simpa only [machineListCountStep] using machineIfEmpty_mem_FP + machineListCountRemaining_mem_FP id_mem_FP machineListCountProcess_mem_FP + +theorem machineListCountInit_mem_FP : + machineListCountInit ∈ FP := + machinePair_mem_FP id_mem_FP + (machinePair_mem_FP (machineConst_mem_FP []) id_mem_FP) + +theorem machineListCountWidth_mem_FP : + machineListCountWidth ∈ FP := + machinePair_mem_FP machineListCountInputBound_mem_FP + (machinePair_mem_FP machineListCountInputBound_mem_FP + machineListCountInputBound_mem_FP) + +@[simp] theorem machineListCountRemaining_pack (remaining counter source) : + machineListCountRemaining + (machineListCountPack remaining counter source) = remaining := by + simp [machineListCountRemaining, machineListCountPack] + +@[simp] theorem machineListCountCounter_pack (remaining counter source) : + machineListCountCounter + (machineListCountPack remaining counter source) = counter := by + simp [machineListCountCounter, machineListCountPack] + +@[simp] theorem machineListCountSource_pack (remaining counter source) : + machineListCountSource + (machineListCountPack remaining counter source) = source := by + simp [machineListCountSource, machineListCountPack] + +def MachineListCountStateBound (word state : List Bool) : Prop := + let B := (machineListCountInputBound word).length + state = machineListCountPack (machineListCountRemaining state) + (machineListCountCounter state) (machineListCountSource state) ∧ + (machineListCountRemaining state).length ≤ B ∧ + (machineListCountCounter state).length ≤ B ∧ + machineListCountSource state = word + +theorem machineListCount_word_le_bound (word : List Bool) : + word.length ≤ (machineListCountInputBound word).length := by + simp [machineListCountInputBound, pair_length] + +theorem machineListCountInit_bound (word : List Bool) : + MachineListCountStateBound word (machineListCountInit word) := by + simp only [MachineListCountStateBound, machineListCountInit, + machineListCountRemaining_pack, machineListCountCounter_pack, + machineListCountSource_pack, List.length_nil] + exact ⟨trivial, machineListCount_word_le_bound word, + Nat.zero_le _, trivial⟩ + +theorem machineListCountStep_bound {word state : List Bool} + (hstate : MachineListCountStateBound word state) : + MachineListCountStateBound word (machineListCountStep state) := by + rcases hstate with ⟨hpack, hremaining, hcounter, hsource⟩ + by_cases hrem : machineListCountRemaining state = [] + · rw [machineListCountStep, hrem, machineIfEmpty_nil] + exact ⟨hpack, hremaining, hcounter, hsource⟩ + · rw [machineListCountStep] + cases hcode : machineListCountRemaining state with + | nil => exact False.elim (hrem hcode) + | cons bit tail => + rw [machineIfEmpty_cons, machineListCountProcess] + simp only [MachineListCountStateBound, + machineListCountRemaining_pack, machineListCountCounter_pack, + machineListCountSource_pack] + refine ⟨trivial, ?_, ?_, hsource⟩ + · exact (machinePairSecond_length_le + (machineListCountRemaining state)).trans hremaining + · simp only [machineListCountNextCounter, List.length_take, + machineListCountBound, hsource] + exact Nat.min_le_left _ _ + +theorem machineListCountIterate_bound (word : List Bool) : ∀ k, + MachineListCountStateBound word + ((machineListCountStep)^[k] (machineListCountInit word)) := by + intro k + induction k with + | zero => exact machineListCountInit_bound word + | succ k ih => + rw [Function.iterate_succ_apply'] + exact machineListCountStep_bound ih + +theorem machineListCountIterate_length_le_width + (word : List Bool) (iterations : ℕ) (_ : iterations ≤ word.length) : + ((machineListCountStep)^[iterations] + (machineListCountInit word)).length ≤ + (machineListCountWidth word).length := by + rcases machineListCountIterate_bound word iterations with + ⟨hpack, hremaining, hcounter, hsource⟩ + have hsourceLength : (machineListCountSource + ((machineListCountStep)^[iterations] + (machineListCountInit word))).length ≤ + (machineListCountInputBound word).length := by + rw [hsource] + exact machineListCount_word_le_bound word + rw [hpack] + simp only [machineListCountPack, machineListCountWidth, pair_length] + omega + +theorem machineEncodedListLengthBits_mem_FP : + machineEncodedListLengthBits ∈ FP := by + have hfinal : (fun word => + (machineListCountStep)^[word.length] + (machineListCountInit word)) ∈ FP := + Cobham.iterate_mem_FP machineListCountStep_mem_FP + machineListCountInit_mem_FP id_mem_FP machineListCountWidth_mem_FP + machineListCountIterate_length_le_width + simpa only [machineEncodedListLengthBits] using machineCompose_mem_FP + hfinal machineListCountCounter_mem_FP + +/-! ## Exact counting semantics -/ + +def machineListCountSemanticState {alpha : Type*} + (encode : alpha → List Bool) (xs : List alpha) (k : ℕ) : List Bool := + machineListCountPack (binaryListCode encode (xs.drop k)) k.bits + (binaryListCode encode xs) + +@[simp] theorem machineListCountSemanticState_zero {alpha : Type*} + (encode : alpha → List Bool) (xs : List alpha) : + machineListCountSemanticState encode xs 0 = + machineListCountInit (binaryListCode encode xs) := by + simp [machineListCountSemanticState, machineListCountInit, + binaryListCode] + +theorem nat_succ_bits_length_le_succ (k : ℕ) : + (k + 1).bits.length ≤ k + 1 := by + rw [Nat.size_eq_bits_len, Nat.size_le] + exact Nat.lt_two_pow_self + +theorem machineListCountSemanticState_step {alpha : Type*} + (encode : alpha → List Bool) (xs : List alpha) + (k : ℕ) (hk : k < xs.length) : + machineListCountStep (machineListCountSemanticState encode xs k) = + machineListCountSemanticState encode xs (k + 1) := by + rw [machineListCountSemanticState, List.drop_eq_getElem_cons hk, + machineListCountStep] + simp only [machineListCountRemaining_pack] + rw [machineIfEmpty_of_ne_nil_matrix _ _ _ + (binaryListCode_cons_ne_nil encode xs[k] (xs.drop (k + 1))), + machineListCountProcess] + simp only [machineListCountRemaining_pack, machineListTail_cons, + machineListCountSource_pack, machineListCountNextCounter, + machineListCountCounter_pack] + have hadd : machineBinaryAddBits (pair k.bits [true]) = (k + 1).bits := by + simpa using machineBinaryAddBits_pair_natBits k 1 + rw [hadd] + have hbits : (k + 1).bits.length ≤ + (machineListCountInputBound (binaryListCode encode xs)).length := by + calc + _ ≤ k + 1 := nat_succ_bits_length_le_succ k + _ ≤ xs.length := by omega + _ ≤ (binaryListCode encode xs).length := + binaryListCode_listLength_le encode xs + _ ≤ _ := machineListCount_word_le_bound _ + rw [machineListCountBound, machineListCountSource_pack, + (List.take_eq_self_iff _).2 hbits] + rw [machineListCountSemanticState] + +theorem machineListCountIterate_semantics {alpha : Type*} + (encode : alpha → List Bool) (xs : List alpha) : ∀ k ≤ xs.length, + (machineListCountStep)^[k] + (machineListCountInit (binaryListCode encode xs)) = + machineListCountSemanticState encode xs k := by + intro k hk + induction k with + | zero => exact (machineListCountSemanticState_zero encode xs).symm + | succ k ih => + rw [Function.iterate_succ_apply', ih (by omega)] + exact machineListCountSemanticState_step encode xs k (by omega) + +theorem machineListCount_done_iterate + (extra : ℕ) (counter source : List Bool) : + (machineListCountStep)^[extra] + (machineListCountPack [] counter source) = + machineListCountPack [] counter source := by + induction extra with + | zero => rfl + | succ k ih => + rw [Function.iterate_succ_apply', ih] + simp [machineListCountStep] + +@[simp] theorem machineEncodedListLengthBits_encode {alpha : Type*} + (encode : alpha → List Bool) (xs : List alpha) : + machineEncodedListLengthBits (binaryListCode encode xs) = xs.length.bits := by + rw [machineEncodedListLengthBits] + let word := binaryListCode encode xs + have hle : xs.length ≤ word.length := + binaryListCode_listLength_le encode xs + have hsplit : word.length = (word.length - xs.length) + xs.length := by + omega + rw [hsplit, Function.iterate_add_apply, + machineListCountIterate_semantics encode xs xs.length le_rfl] + simp only [machineListCountSemanticState, List.drop_length] + change machineListCountCounter + ((machineListCountStep)^[word.length - xs.length] + (machineListCountPack [] xs.length.bits + (binaryListCode encode xs))) = xs.length.bits + rw [machineListCount_done_iterate] + simp only [machineListCountCounter_pack] + +/-! ## Fixed-gain assembly -/ + +def machineListCountRawNatCode (word : List Bool) : List Bool := + pair (machineNaturalIntegerCode (machineEncodedListLengthBits word)) [true] + +def rawExplicitGamma : RawRat := rawRatOfRat explicitGamma + +def machineMatchingGainFromSelected (selectedWord : List Bool) : List Bool := + machineNormalizeRawRatEntryCode + (machineRawRatMulCode + (pair (rawRatBinaryCode rawExplicitGamma) + (machineListCountRawNatCode selectedWord))) + +def machineExplicitMatchingGainRawCode (word : List Bool) : List Bool := + machineMatchingGainFromSelected + (machineGreedyMatchingSelected (machinePairSecond word)) + +theorem machineListCountRawNatCode_mem_FP : + machineListCountRawNatCode ∈ FP := by + have hnum := machineCompose_mem_FP machineEncodedListLengthBits_mem_FP + machineNaturalIntegerCode_mem_FP + exact machinePair_mem_FP hnum (machineConst_mem_FP [true]) + +theorem machineMatchingGainFromSelected_mem_FP : + machineMatchingGainFromSelected ∈ FP := by + have hinput := machinePair_mem_FP + (machineConst_mem_FP (rawRatBinaryCode rawExplicitGamma)) + machineListCountRawNatCode_mem_FP + have hmul := machineCompose_mem_FP hinput machineRawRatMulCode_mem_FP + simpa only [machineMatchingGainFromSelected] using + machineCompose_mem_FP hmul machineNormalizeRawRatEntryCode_mem_FP + +theorem machineExplicitMatchingGainRawCode_mem_FP : + machineExplicitMatchingGainRawCode ∈ FP := by + have hselected := machineCompose_mem_FP machinePairSecond_mem_FP + machineGreedyMatchingSelected_mem_FP + simpa only [machineExplicitMatchingGainRawCode] using machineCompose_mem_FP + hselected machineMatchingGainFromSelected_mem_FP + +@[simp] theorem machineListCountRawNatCode_encode {alpha : Type*} + (encode : alpha → List Bool) (xs : List alpha) : + machineListCountRawNatCode (binaryListCode encode xs) = + rawRatBinaryCode (RawRat.ofNat xs.length) := by + rw [machineListCountRawNatCode, + machineEncodedListLengthBits_encode, + machineNaturalIntegerCode_natBits] + simp [rawRatBinaryCode, RawRat.ofNat] + +@[simp] theorem machineMatchingGainFromSelected_encode {alpha : Type*} + (encode : alpha → List Bool) (xs : List alpha) : + machineMatchingGainFromSelected (binaryListCode encode xs) = + rawRatBinaryCode (rawRatOfRat + (explicitGamma * (xs.length : ℚ))) := by + rw [machineMatchingGainFromSelected, + machineListCountRawNatCode_encode, machineRawRatMulCode_encode, + machineNormalizeRawRatEntryCode_encode, + ← rawRatBinaryCode_rawRatOfRat] + apply congrArg rawRatBinaryCode + apply congrArg rawRatOfRat + rw [binaryNormalizeRawRat_eq_value, RawRat.value_mul, + rawExplicitGamma, rawRatOfRat_value, RawRat.value_ofNat] + +theorem explicitCertifiedMatchingGain_eq_typed_length {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) : + explicitCertifiedMatchingGain X = + explicitGamma * + (certifiedGreedyTypedOuterScan X [] + (List.finRange n).reverse).length := by + let selected := certifiedGreedyTypedOuterScan X [] + (List.finRange n).reverse + have hfin := certifiedGreedyTypedOuterScan_toFinset X + have hnodup := certifiedGreedyTypedOuterScan_full_nodup X + rw [explicitCertifiedMatchingGain, greedyCertifiedMatchingGain] + rw [← hfin] + have hweight : ∀ q ∈ selected.toFinset, + explicitCertifiedRowWeight X q = explicitGamma := by + intro q hq + have hqmatching : q ∈ greedyThresholdRowMatching + (explicitCertifiedRowWeight X) explicitGamma := by + rw [← hfin] + exact hq + have hmax := greedyThresholdRowMatching_isMaximal + (explicitCertifiedRowWeight X) explicitGamma + have hthreshold : explicitGamma ≤ explicitCertifiedRowWeight X q := by + have hmem := hmax.subset hqmatching + simpa only [List.mem_toFinset, mem_thresholdRowPairsList_iff] using hmem + exact certifiedConstantRowWeight_eq_gamma_of_threshold + (explicitRegularizationScale n) X explicitKappa explicitGamma + (directedPairCostPrecision n) q explicitGamma_pos hthreshold + calc + ∑ q ∈ selected.toFinset, explicitCertifiedRowWeight X q = + ∑ _q ∈ selected.toFinset, explicitGamma := by + exact Finset.sum_congr rfl hweight + _ = selected.toFinset.card * explicitGamma := by simp + _ = explicitGamma * selected.length := by + rw [List.toFinset_card_of_nodup hnodup] + ring + +@[simp] theorem machineExplicitMatchingGainRawCode_encode + (source : List Bool) {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℚ) : + machineExplicitMatchingGainRawCode + (pair source (rationalOptimizerOutputCode ⟨X, R, C⟩)) = + rawRatBinaryCode (rawRatOfRat (explicitCertifiedMatchingGain X)) := by + rw [machineExplicitMatchingGainRawCode, machinePairSecond_pair, + machineGreedyMatchingSelected_typed_encode, + machineMatchingGainFromSelected_encode] + simp only [List.length_map] + rw [explicitCertifiedMatchingGain_eq_typed_length] + +theorem machineExplicitMatchingGainRawCode_realizes : + OptimizerMatchingGainStringRealizes machineExplicitMatchingGainRawCode := by + intro m B + simpa only [explicitLargeOptimizerOutput] using + machineExplicitMatchingGainRawCode_encode + (rationalMatrixBinaryEncoding.encode ⟨m + 2, B⟩) + (explicitBetheOptimizerMatrix (m := m + 1) B) + (explicitBetheOptimizerRowPotential (m := m + 1) B) + (explicitBetheOptimizerColumnPotential (m := m + 1) B) + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineMateAllSome.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineMateAllSome.lean new file mode 100644 index 0000000000..239642fb7e --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineMateAllSome.lean @@ -0,0 +1,297 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineKuhnRunner +import Mathlib.Tactic + +/-! +# Testing whether the final mate table is total + +The Kuhn machine returns a column-to-row mate table. This module scans its +self-delimiting encoding and returns one bit indicating whether every column +contains a row. +-/ + +namespace BeyondBethe + +open Complexity + +def machineMateAllSomePack + (remaining ruler ok : List Bool) : List Bool := + pair remaining (pair ruler ok) + +def machineMateAllSomeRemaining (state : List Bool) : List Bool := + machinePairFirst state + +def machineMateAllSomeRulerState (state : List Bool) : List Bool := + machinePairFirst (machinePairSecond state) + +def machineMateAllSomeOk (state : List Bool) : List Bool := + machinePairSecond (machinePairSecond state) + +def machineMateAllSomeCurrentBit (state : List Bool) : List Bool := + machineHeadBit (machineListHead (machineMateAllSomeRemaining state)) + +def machineMateAllSomeAdvance (state : List Bool) : List Bool := + machineMateAllSomePack (machineListTail (machineMateAllSomeRemaining state)) + (machineMateAllSomeRulerState state).tail + (machineAndBit (machineMateAllSomeOk state) + (machineMateAllSomeCurrentBit state)) + +def machineMateAllSomeStep (state : List Bool) : List Bool := + machineIfEmpty (machineMateAllSomeRulerState state) state + (machineMateAllSomeAdvance state) + +def machineMateAllSomeInputRuler (word : List Bool) : List Bool := + machinePairFirst word + +def machineMateAllSomeInputMate (word : List Bool) : List Bool := + machinePairSecond word + +def machineMateAllSomeInit (word : List Bool) : List Bool := + machineMateAllSomePack (machineMateAllSomeInputMate word) + (machineMateAllSomeInputRuler word) [true] + +def machineMateAllSomeWidth (word : List Bool) : List Bool := + machineBinaryMulWidth word + +def machineMateAllSomeFinalState (word : List Bool) : List Bool := + (machineMateAllSomeStep^[(machineMateAllSomeInputRuler word).length]) + (machineMateAllSomeInit word) + +def machineMateAllSomeBit (word : List Bool) : List Bool := + machineMateAllSomeOk (machineMateAllSomeFinalState word) + +theorem machineMateAllSomeRemaining_mem_FP : + machineMateAllSomeRemaining ∈ Complexity.FP := machinePairFirst_mem_FP + +theorem machineMateAllSomeRulerState_mem_FP : + machineMateAllSomeRulerState ∈ Complexity.FP := by + simpa only [machineMateAllSomeRulerState] using + machineCompose_mem_FP machinePairSecond_mem_FP machinePairFirst_mem_FP + +theorem machineMateAllSomeOk_mem_FP : + machineMateAllSomeOk ∈ Complexity.FP := by + simpa only [machineMateAllSomeOk] using + machineCompose_mem_FP machinePairSecond_mem_FP machinePairSecond_mem_FP + +theorem machineMateAllSomeCurrentBit_mem_FP : + machineMateAllSomeCurrentBit ∈ Complexity.FP := by + have hhead := machineCompose_mem_FP machineMateAllSomeRemaining_mem_FP + machineListHead_mem_FP + simpa only [machineMateAllSomeCurrentBit] using + machineCompose_mem_FP hhead machineHeadBit_mem_FP + +theorem machineMateAllSomeAdvance_mem_FP : + machineMateAllSomeAdvance ∈ Complexity.FP := by + have hremainingTail := machineCompose_mem_FP + machineMateAllSomeRemaining_mem_FP machineListTail_mem_FP + have hrulerTail := machineCompose_mem_FP + machineMateAllSomeRulerState_mem_FP machineTail_mem_FP + have hok := machineAndBit_mem_FP machineMateAllSomeOk_mem_FP + machineMateAllSomeCurrentBit_mem_FP + exact machinePair_mem_FP hremainingTail + (machinePair_mem_FP hrulerTail hok) + +theorem machineMateAllSomeStep_mem_FP : + machineMateAllSomeStep ∈ Complexity.FP := by + exact machineIfEmpty_mem_FP machineMateAllSomeRulerState_mem_FP id_mem_FP + machineMateAllSomeAdvance_mem_FP + +theorem machineMateAllSomeInputRuler_mem_FP : + machineMateAllSomeInputRuler ∈ Complexity.FP := machinePairFirst_mem_FP + +theorem machineMateAllSomeInputMate_mem_FP : + machineMateAllSomeInputMate ∈ Complexity.FP := machinePairSecond_mem_FP + +theorem machineMateAllSomeInit_mem_FP : + machineMateAllSomeInit ∈ Complexity.FP := by + exact machinePair_mem_FP machineMateAllSomeInputMate_mem_FP + (machinePair_mem_FP machineMateAllSomeInputRuler_mem_FP + (machineConst_mem_FP [true])) + +theorem machineMateAllSomeWidth_mem_FP : + machineMateAllSomeWidth ∈ Complexity.FP := + machineBinaryMulWidth_mem_FP + +@[simp] theorem machineMateAllSomeRemaining_pack (a b c) : + machineMateAllSomeRemaining (machineMateAllSomePack a b c) = a := by + simp [machineMateAllSomeRemaining, machineMateAllSomePack] + +@[simp] theorem machineMateAllSomeRulerState_pack (a b c) : + machineMateAllSomeRulerState (machineMateAllSomePack a b c) = b := by + simp [machineMateAllSomeRulerState, machineMateAllSomePack] + +@[simp] theorem machineMateAllSomeOk_pack (a b c) : + machineMateAllSomeOk (machineMateAllSomePack a b c) = c := by + simp [machineMateAllSomeOk, machineMateAllSomePack] + +@[simp] theorem machineMateAllSomeCurrentBit_pack (a b c) : + machineMateAllSomeCurrentBit (machineMateAllSomePack a b c) = + machineHeadBit (machineListHead a) := by + simp [machineMateAllSomeCurrentBit] + +@[simp] theorem machineMateAllSomeCurrentBit_length (state) : + (machineMateAllSomeCurrentBit state).length = 1 := by + exact machineHeadBit_length _ + +def MachineMateAllSomeStateBound (word state : List Bool) : Prop := + state = machineMateAllSomePack (machineMateAllSomeRemaining state) + (machineMateAllSomeRulerState state) (machineMateAllSomeOk state) ∧ + (machineMateAllSomeRemaining state).length ≤ word.length ∧ + (machineMateAllSomeRulerState state).length ≤ word.length ∧ + (machineMateAllSomeOk state).length ≤ word.length + 1 + +theorem machineMateAllSomeInit_bound (word : List Bool) : + MachineMateAllSomeStateBound word (machineMateAllSomeInit word) := by + dsimp only [MachineMateAllSomeStateBound] + refine ⟨?_, ?_, ?_, ?_⟩ + · simp [machineMateAllSomeInit] + · simpa [machineMateAllSomeInit] using machinePairSecond_length_le word + · simpa [machineMateAllSomeInit] using machinePairFirst_length_le word + · simp [machineMateAllSomeInit] + +theorem machineMateAllSomeStep_bound {word state : List Bool} + (hstate : MachineMateAllSomeStateBound word state) : + MachineMateAllSomeStateBound word (machineMateAllSomeStep state) := by + rcases hstate with ⟨hpack, hremaining, hruler, hok⟩ + cases hrulerEq : machineMateAllSomeRulerState state with + | nil => + rw [machineMateAllSomeStep, hrulerEq, machineIfEmpty_nil] + exact ⟨hpack, hremaining, hruler, hok⟩ + | cons bit tail => + rw [machineMateAllSomeStep, hrulerEq, machineIfEmpty_cons, + machineMateAllSomeAdvance] + dsimp only [MachineMateAllSomeStateBound] + refine ⟨?_, ?_, ?_, ?_⟩ + · simp + · simpa only [machineMateAllSomeRemaining_pack] using + (machinePairSecond_length_le + (machineMateAllSomeRemaining state)).trans hremaining + · rw [hrulerEq] at hruler + simp only [List.length_cons] at hruler + simp only [machineMateAllSomeRulerState_pack] + rw [hrulerEq] + simp only [List.tail_cons] + omega + · have hbit : + (machineAndBit (machineMateAllSomeOk state) + (machineMateAllSomeCurrentBit state)).length ≤ 1 := by + simpa only [machineAndBit, machineMateAllSomeCurrentBit_length, + List.length_cons, List.length_nil, Nat.zero_add, max_self] using + machineIfHead_length_le_max (machineMateAllSomeOk state) + (machineMateAllSomeCurrentBit state) [false] + simpa only [machineMateAllSomeOk_pack] using + hbit.trans (by omega : 1 ≤ word.length + 1) + +theorem machineMateAllSomeIterate_bound (word : List Bool) : ∀ iterations, + MachineMateAllSomeStateBound word + ((machineMateAllSomeStep^[iterations]) + (machineMateAllSomeInit word)) := by + intro iterations + induction iterations with + | zero => simpa using machineMateAllSomeInit_bound word + | succ iterations ih => + rw [Function.iterate_succ_apply'] + exact machineMateAllSomeStep_bound ih + +theorem machineMateAllSomeIterate_length_le_width + (word : List Bool) (iterations : ℕ) + (_hiterations : iterations ≤ (machineMateAllSomeInputRuler word).length) : + ((machineMateAllSomeStep^[iterations]) + (machineMateAllSomeInit word)).length ≤ + (machineMateAllSomeWidth word).length := by + rcases machineMateAllSomeIterate_bound word iterations with + ⟨hpack, hremaining, hruler, hok⟩ + rw [hpack] + simp only [machineMateAllSomePack, pair_length] + simp only [machineMateAllSomeWidth, machineBinaryMulWidth, + List.length_replicate, List.length_append] + nlinarith + +theorem machineMateAllSomeFinalState_mem_FP : + machineMateAllSomeFinalState ∈ Complexity.FP := by + simpa only [machineMateAllSomeFinalState] using + Cobham.iterate_mem_FP machineMateAllSomeStep_mem_FP + machineMateAllSomeInit_mem_FP machineMateAllSomeInputRuler_mem_FP + machineMateAllSomeWidth_mem_FP + machineMateAllSomeIterate_length_le_width + +theorem machineMateAllSomeBit_mem_FP : + machineMateAllSomeBit ∈ Complexity.FP := by + simpa only [machineMateAllSomeBit] using + machineCompose_mem_FP machineMateAllSomeFinalState_mem_FP + machineMateAllSomeOk_mem_FP + +/-! ## Exact scan semantics -/ + +@[simp] theorem machineHeadBit_mateValueCode (value : Option ℕ) : + machineHeadBit (mateValueCode value) = [value.isSome] := by + cases value <;> simp [machineHeadBit, mateValueCode] + +def mateAllSomeSemanticState (mate : List (Option ℕ)) (k : ℕ) : List Bool := + machineMateAllSomePack (mateVectorCode (mate.drop k)) + (List.replicate (mate.length - k) true) + [(mate.take k).all Option.isSome] + +theorem machineMateAllSomeStep_semantics + (mate : List (Option ℕ)) (k : ℕ) (hk : k < mate.length) : + machineMateAllSomeStep (mateAllSomeSemanticState mate k) = + mateAllSomeSemanticState mate (k + 1) := by + have hdrop := List.drop_eq_getElem_cons hk + have htake := List.take_concat_get hk + rw [mateAllSomeSemanticState, machineMateAllSomeStep] + simp only [machineMateAllSomeRulerState_pack] + have hremain : mate.length - k = (mate.length - (k + 1)) + 1 := by omega + rw [hremain, List.replicate_succ, machineIfEmpty_cons, + machineMateAllSomeAdvance] + simp only [machineMateAllSomeRemaining_pack, + machineMateAllSomeRulerState_pack, machineMateAllSomeOk_pack, + List.tail_cons, mateVectorCode] + rw [hdrop] + simp only [machineListTail_cons, machineMateAllSomeCurrentBit_pack, + machineListHead_cons, + machineHeadBit_mateValueCode] + rw [mateAllSomeSemanticState] + have hall : + (mate.take (k + 1)).all Option.isSome = + ((mate.take k).all Option.isSome && mate[k].isSome) := by + rw [← htake] + simp only [List.concat_eq_append, List.all_append, List.all_cons, + List.all_nil, Bool.and_true] + rw [hall] + cases (mate.take k).all Option.isSome <;> + cases mate[k].isSome <;> + simp [machineAndBit, mateVectorCode] + +theorem machineMateAllSomeIterate_semantics + (mate : List (Option ℕ)) : ∀ k, k ≤ mate.length → + (machineMateAllSomeStep^[k]) + (mateAllSomeSemanticState mate 0) = + mateAllSomeSemanticState mate k := by + intro k hk + induction k with + | zero => rfl + | succ k ih => + rw [Function.iterate_succ_apply', ih (by omega), + machineMateAllSomeStep_semantics mate k (by omega)] + +@[simp] theorem machineMateAllSomeBit_encode + (mate : List (Option ℕ)) : + machineMateAllSomeBit + (pair (List.replicate mate.length true) (mateVectorCode mate)) = + [mate.all Option.isSome] := by + rw [machineMateAllSomeBit, machineMateAllSomeFinalState] + simp only [machineMateAllSomeInputRuler, machinePairFirst_pair, + List.length_replicate, machineMateAllSomeInit, + machineMateAllSomeInputMate, machinePairSecond_pair] + change machineMateAllSomeOk + ((machineMateAllSomeStep^[mate.length]) + (mateAllSomeSemanticState mate 0)) = _ + rw [machineMateAllSomeIterate_semantics mate mate.length (le_rfl)] + simp [mateAllSomeSemanticState] + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineMateMemory.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineMateMemory.lean new file mode 100644 index 0000000000..1e58f8f7fa --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineMateMemory.lean @@ -0,0 +1,108 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineBooleanInit + +/-! +# Column-mate memory for augmenting-path matching + +One column stores either `[false]` for `none` or `true :: rowUnary` for a +matched row. The enclosing right-nested list delimits these variable-length +elements. This representation makes the old row immediately available to a +recursive augmenting-path search while retaining exact polynomial-time list +lookup and update. +-/ + +namespace BeyondBethe + +open Complexity + +def mateValueCode : Option ℕ → List Bool + | none => [false] + | some row => true :: List.replicate row true + +def mateVectorCode (mate : List (Option ℕ)) : List Bool := + binaryListCode mateValueCode mate + +def machineMateValueIsNoneBit (value : List Bool) : List Bool := + machineNotBit (machineHeadBit value) + +def machineMateValueRowUnary (value : List Bool) : List Bool := + value.tail + +def machineMateVectorGetAtUnary (word : List Bool) : List Bool := + machineListIndex word + +/-- Input: `pair columnUnary (pair mateValue mateVectorCode)`. -/ +def machineMateVectorUpdateAtUnary (word : List Bool) : List Bool := + machineListUpdate word + +theorem machineMateValueIsNoneBit_mem_FP : + machineMateValueIsNoneBit ∈ Complexity.FP := by + simpa only [machineMateValueIsNoneBit] using + machineNotBit_mem_FP machineHeadBit_mem_FP + +theorem machineMateValueRowUnary_mem_FP : + machineMateValueRowUnary ∈ Complexity.FP := + machineTail_mem_FP + +theorem machineMateVectorGetAtUnary_mem_FP : + machineMateVectorGetAtUnary ∈ Complexity.FP := + machineListIndex_mem_FP + +theorem machineMateVectorUpdateAtUnary_mem_FP : + machineMateVectorUpdateAtUnary ∈ Complexity.FP := + machineListUpdate_mem_FP + +@[simp] theorem machineMateValueIsNoneBit_encode (value : Option ℕ) : + machineMateValueIsNoneBit (mateValueCode value) = + [decide value.isNone] := by + cases value <;> simp [machineMateValueIsNoneBit, mateValueCode] + +@[simp] theorem machineMateValueRowUnary_some (row : ℕ) : + machineMateValueRowUnary (mateValueCode (some row)) = + List.replicate row true := by + simp [machineMateValueRowUnary, mateValueCode] + +@[simp] theorem machineMateVectorGetAtUnary_encode + (mate : List (Option ℕ)) (column : ℕ) + (hcolumn : column < mate.length) : + machineMateVectorGetAtUnary + (pair (List.replicate column true) (mateVectorCode mate)) = + mateValueCode mate[column] := by + exact machineListIndex_binaryListCode mateValueCode mate column hcolumn + +@[simp] theorem machineMateVectorUpdateAtUnary_encode + (mate : List (Option ℕ)) (column : ℕ) (value : Option ℕ) + (hcolumn : column < mate.length) : + machineMateVectorUpdateAtUnary + (pair (List.replicate column true) + (pair (mateValueCode value) (mateVectorCode mate))) = + mateVectorCode (mate.set column value) := by + exact machineListUpdate_binaryListCode mateValueCode mate value column hcolumn + +/-- The all-`none` mate vector is exactly the already verified false-vector +constructor. -/ +def machineEmptyMateVectorCode (ruler : List Bool) : List Bool := + machineFalseVectorCode ruler + +theorem machineEmptyMateVectorCode_mem_FP : + machineEmptyMateVectorCode ∈ Complexity.FP := + machineFalseVectorCode_mem_FP + +@[simp] theorem machineEmptyMateVectorCode_encode (n : ℕ) : + machineEmptyMateVectorCode (List.replicate n true) = + mateVectorCode (List.replicate n none) := by + rw [machineEmptyMateVectorCode, machineFalseVectorCode_encode] + change binaryListCode boolElementCode (List.replicate n false) = + binaryListCode mateValueCode (List.replicate n none) + induction n with + | zero => rfl + | succ n ih => + simp only [List.replicate_succ, binaryListCode, boolElementCode, + mateValueCode, ih] + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineMatrixAddDelta.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineMatrixAddDelta.lean new file mode 100644 index 0000000000..906c93e448 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineMatrixAddDelta.lean @@ -0,0 +1,800 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalRowAdd +import LeanPool.BeyondBethe.BeyondBethe.FinalAssembly +import Mathlib.Tactic + +/-! +# Entrywise addition of a rational matrix + +The input is `pair deltaRawCode matrixCode`. The machine adds `delta` to +every entry, preserves the matrix dimension prefix, and maps the +self-delimiting row list with the verified row-addition machine. A +polynomial clamp is present on malformed inputs and is proved inactive on +every canonical pair of a raw rational and a rational matrix. +-/ + +namespace BeyondBethe + +open Complexity + +def machineMatrixAddDeltaInputDelta (word : List Bool) : List Bool := + machinePairFirst word + +def machineMatrixAddDeltaInputMatrix (word : List Bool) : List Bool := + machinePairSecond word + +def machineMatrixAddDeltaPadTwenty (word : List Bool) : List Bool := + machineRationalRowAddPadSixteen word ++ + machineRationalRowAddPadFour word + +/-- A direct quadratic envelope in the original matrix-word length. Using +twenty copies before squaring avoids materializing the much larger nested +row-machine envelope used in the first implementation. -/ +def machineMatrixAddDeltaInputBound (word : List Bool) : List Bool := + machineBinaryMulWidth (machineMatrixAddDeltaPadTwenty word) + +def machineMatrixAddDeltaPack + (remaining accumulator delta dimension bound : List Bool) : List Bool := + pair remaining (pair accumulator (pair delta (pair dimension bound))) + +def machineMatrixAddDeltaRemaining (state : List Bool) : List Bool := + machinePairFirst state + +def machineMatrixAddDeltaAccumulator (state : List Bool) : List Bool := + machinePairFirst (machinePairSecond state) + +def machineMatrixAddDeltaDelta (state : List Bool) : List Bool := + machinePairFirst (machinePairSecond (machinePairSecond state)) + +def machineMatrixAddDeltaDimension (state : List Bool) : List Bool := + machinePairFirst + (machinePairSecond (machinePairSecond (machinePairSecond state))) + +def machineMatrixAddDeltaBound (state : List Bool) : List Bool := + machinePairSecond + (machinePairSecond (machinePairSecond (machinePairSecond state))) + +def machineMatrixAddDeltaCurrentRow (state : List Bool) : List Bool := + machineListHead (machineMatrixAddDeltaRemaining state) + +def machineMatrixAddDeltaOutputRow (state : List Bool) : List Bool := + machineRationalRowAdd + (pair (machineMatrixAddDeltaDelta state) + (machineMatrixAddDeltaCurrentRow state)) + +def machineMatrixAddDeltaCandidate (state : List Bool) : List Bool := + pair (machineMatrixAddDeltaOutputRow state) + (machineMatrixAddDeltaAccumulator state) + +def machineMatrixAddDeltaNextAccumulator (state : List Bool) : List Bool := + (machineMatrixAddDeltaCandidate state).take + (machineMatrixAddDeltaBound state).length + +def machineMatrixAddDeltaAdvance (state : List Bool) : List Bool := + machineMatrixAddDeltaPack + (machineListTail (machineMatrixAddDeltaRemaining state)) + (machineMatrixAddDeltaNextAccumulator state) + (machineMatrixAddDeltaDelta state) + (machineMatrixAddDeltaDimension state) + (machineMatrixAddDeltaBound state) + +def machineMatrixAddDeltaStep (state : List Bool) : List Bool := + machineIfEmpty (machineMatrixAddDeltaRemaining state) state + (machineMatrixAddDeltaAdvance state) + +def machineMatrixAddDeltaInit (word : List Bool) : List Bool := + machineMatrixAddDeltaPack + (machineMatrixRowsWord (machineMatrixAddDeltaInputMatrix word)) [] + (machineMatrixAddDeltaInputDelta word) + (machineMatrixDimensionWord (machineMatrixAddDeltaInputMatrix word)) + (machineMatrixAddDeltaInputBound word) + +def machineMatrixAddDeltaWidth (word : List Bool) : List Bool := + machineMatrixAddDeltaPack word (machineMatrixAddDeltaInputBound word) + (machineMatrixAddDeltaInputDelta word) word + (machineMatrixAddDeltaInputBound word) + +def machineMatrixAddDeltaFinalState (word : List Bool) : List Bool := + (machineMatrixAddDeltaStep)^[word.length] + (machineMatrixAddDeltaInit word) + +def machineMatrixAddDeltaEntries (word : List Bool) : List Bool := + let state := machineMatrixAddDeltaFinalState word + pair (machineMatrixAddDeltaDimension state) + (machineListReverse (machineMatrixAddDeltaAccumulator state)) + +theorem machineMatrixAddDeltaPadTwenty_mem_FP : + machineMatrixAddDeltaPadTwenty ∈ Complexity.FP := + machineAppend_mem_FP machineRationalRowAddPadSixteen_mem_FP + machineRationalRowAddPadFour_mem_FP + +theorem machineMatrixAddDeltaPadTwenty_length (word : List Bool) : + (machineMatrixAddDeltaPadTwenty word).length = 20 * word.length := by + simp only [machineMatrixAddDeltaPadTwenty, List.length_append, + machineRationalRowAddPadSixteen_length, + machineRationalRowAddPadFour, + machineRationalRowAddPadTwo, List.length_append] + omega + +theorem machineMatrixAddDeltaInputBound_mem_FP : + machineMatrixAddDeltaInputBound ∈ Complexity.FP := by + simpa only [machineMatrixAddDeltaInputBound] using + machineCompose_mem_FP machineMatrixAddDeltaPadTwenty_mem_FP + machineBinaryMulWidth_mem_FP + +theorem machineMatrixAddDeltaInputDelta_mem_FP : + machineMatrixAddDeltaInputDelta ∈ Complexity.FP := machinePairFirst_mem_FP + +theorem machineMatrixAddDeltaInputMatrix_mem_FP : + machineMatrixAddDeltaInputMatrix ∈ Complexity.FP := machinePairSecond_mem_FP + +theorem machineMatrixAddDeltaInputRows_mem_FP : + (fun word ↦ machineMatrixRowsWord + (machineMatrixAddDeltaInputMatrix word)) ∈ Complexity.FP := by + exact machineCompose_mem_FP machineMatrixAddDeltaInputMatrix_mem_FP + machineMatrixRowsWord_mem_FP + +theorem machineMatrixAddDeltaInputDimension_mem_FP : + (fun word ↦ machineMatrixDimensionWord + (machineMatrixAddDeltaInputMatrix word)) ∈ Complexity.FP := by + exact machineCompose_mem_FP machineMatrixAddDeltaInputMatrix_mem_FP + machineMatrixDimensionWord_mem_FP + +theorem machineMatrixAddDeltaRemaining_mem_FP : + machineMatrixAddDeltaRemaining ∈ Complexity.FP := + machinePairFirst_mem_FP + +theorem machineMatrixAddDeltaAccumulator_mem_FP : + machineMatrixAddDeltaAccumulator ∈ Complexity.FP := by + simpa only [machineMatrixAddDeltaAccumulator] using + machineCompose_mem_FP machinePairSecond_mem_FP machinePairFirst_mem_FP + +theorem machineMatrixAddDeltaDelta_mem_FP : + machineMatrixAddDeltaDelta ∈ Complexity.FP := by + have htail := machineCompose_mem_FP machinePairSecond_mem_FP + machinePairSecond_mem_FP + simpa only [machineMatrixAddDeltaDelta] using + machineCompose_mem_FP htail machinePairFirst_mem_FP + +theorem machineMatrixAddDeltaDimension_mem_FP : + machineMatrixAddDeltaDimension ∈ Complexity.FP := by + have htailTwo := machineCompose_mem_FP machinePairSecond_mem_FP + machinePairSecond_mem_FP + have htailThree := machineCompose_mem_FP htailTwo machinePairSecond_mem_FP + simpa only [machineMatrixAddDeltaDimension] using + machineCompose_mem_FP htailThree machinePairFirst_mem_FP + +theorem machineMatrixAddDeltaBound_mem_FP : + machineMatrixAddDeltaBound ∈ Complexity.FP := by + have htailTwo := machineCompose_mem_FP machinePairSecond_mem_FP + machinePairSecond_mem_FP + have htailThree := machineCompose_mem_FP htailTwo machinePairSecond_mem_FP + simpa only [machineMatrixAddDeltaBound] using + machineCompose_mem_FP htailThree machinePairSecond_mem_FP + +theorem machineMatrixAddDeltaCurrentRow_mem_FP : + machineMatrixAddDeltaCurrentRow ∈ Complexity.FP := by + simpa only [machineMatrixAddDeltaCurrentRow] using + machineCompose_mem_FP machineMatrixAddDeltaRemaining_mem_FP + machineListHead_mem_FP + +theorem machineMatrixAddDeltaOutputRow_mem_FP : + machineMatrixAddDeltaOutputRow ∈ Complexity.FP := by + have hinput := machinePair_mem_FP machineMatrixAddDeltaDelta_mem_FP + machineMatrixAddDeltaCurrentRow_mem_FP + simpa only [machineMatrixAddDeltaOutputRow] using + machineCompose_mem_FP hinput machineRationalRowAdd_mem_FP + +theorem machineMatrixAddDeltaCandidate_mem_FP : + machineMatrixAddDeltaCandidate ∈ Complexity.FP := + machinePair_mem_FP machineMatrixAddDeltaOutputRow_mem_FP + machineMatrixAddDeltaAccumulator_mem_FP + +theorem machineMatrixAddDeltaNextAccumulator_mem_FP : + machineMatrixAddDeltaNextAccumulator ∈ Complexity.FP := by + simpa only [machineMatrixAddDeltaNextAccumulator] using + machineTake_mem_FP machineMatrixAddDeltaBound_mem_FP + machineMatrixAddDeltaCandidate_mem_FP + +theorem machineMatrixAddDeltaAdvance_mem_FP : + machineMatrixAddDeltaAdvance ∈ Complexity.FP := by + have htail := machineCompose_mem_FP machineMatrixAddDeltaRemaining_mem_FP + machineListTail_mem_FP + exact machinePair_mem_FP htail + (machinePair_mem_FP machineMatrixAddDeltaNextAccumulator_mem_FP + (machinePair_mem_FP machineMatrixAddDeltaDelta_mem_FP + (machinePair_mem_FP machineMatrixAddDeltaDimension_mem_FP + machineMatrixAddDeltaBound_mem_FP))) + +theorem machineMatrixAddDeltaStep_mem_FP : + machineMatrixAddDeltaStep ∈ Complexity.FP := by + exact machineIfEmpty_mem_FP machineMatrixAddDeltaRemaining_mem_FP + id_mem_FP machineMatrixAddDeltaAdvance_mem_FP + +theorem machineMatrixAddDeltaInit_mem_FP : + machineMatrixAddDeltaInit ∈ Complexity.FP := by + exact machinePair_mem_FP machineMatrixAddDeltaInputRows_mem_FP + (machinePair_mem_FP (machineConst_mem_FP []) + (machinePair_mem_FP machineMatrixAddDeltaInputDelta_mem_FP + (machinePair_mem_FP machineMatrixAddDeltaInputDimension_mem_FP + machineMatrixAddDeltaInputBound_mem_FP))) + +theorem machineMatrixAddDeltaWidth_mem_FP : + machineMatrixAddDeltaWidth ∈ Complexity.FP := by + exact machinePair_mem_FP id_mem_FP + (machinePair_mem_FP machineMatrixAddDeltaInputBound_mem_FP + (machinePair_mem_FP machineMatrixAddDeltaInputDelta_mem_FP + (machinePair_mem_FP id_mem_FP + machineMatrixAddDeltaInputBound_mem_FP))) + +@[simp] theorem machineMatrixAddDeltaRemaining_pack (a b c d e) : + machineMatrixAddDeltaRemaining + (machineMatrixAddDeltaPack a b c d e) = a := by + simp [machineMatrixAddDeltaRemaining, machineMatrixAddDeltaPack] + +@[simp] theorem machineMatrixAddDeltaAccumulator_pack (a b c d e) : + machineMatrixAddDeltaAccumulator + (machineMatrixAddDeltaPack a b c d e) = b := by + simp [machineMatrixAddDeltaAccumulator, machineMatrixAddDeltaPack] + +@[simp] theorem machineMatrixAddDeltaDelta_pack (a b c d e) : + machineMatrixAddDeltaDelta + (machineMatrixAddDeltaPack a b c d e) = c := by + simp [machineMatrixAddDeltaDelta, machineMatrixAddDeltaPack] + +@[simp] theorem machineMatrixAddDeltaDimension_pack (a b c d e) : + machineMatrixAddDeltaDimension + (machineMatrixAddDeltaPack a b c d e) = d := by + simp [machineMatrixAddDeltaDimension, machineMatrixAddDeltaPack] + +@[simp] theorem machineMatrixAddDeltaBound_pack (a b c d e) : + machineMatrixAddDeltaBound + (machineMatrixAddDeltaPack a b c d e) = e := by + simp [machineMatrixAddDeltaBound, machineMatrixAddDeltaPack] + +def MachineMatrixAddDeltaStateBound (word state : List Bool) : Prop := + state = machineMatrixAddDeltaPack + (machineMatrixAddDeltaRemaining state) + (machineMatrixAddDeltaAccumulator state) + (machineMatrixAddDeltaDelta state) + (machineMatrixAddDeltaDimension state) + (machineMatrixAddDeltaBound state) ∧ + (machineMatrixAddDeltaRemaining state).length ≤ word.length ∧ + (machineMatrixAddDeltaAccumulator state).length ≤ + (machineMatrixAddDeltaInputBound word).length ∧ + machineMatrixAddDeltaDelta state = + machineMatrixAddDeltaInputDelta word ∧ + (machineMatrixAddDeltaDimension state).length ≤ word.length ∧ + machineMatrixAddDeltaBound state = machineMatrixAddDeltaInputBound word + +theorem machineMatrixAddDeltaInit_bound (word : List Bool) : + MachineMatrixAddDeltaStateBound word (machineMatrixAddDeltaInit word) := by + simp only [MachineMatrixAddDeltaStateBound, machineMatrixAddDeltaInit, + machineMatrixAddDeltaRemaining_pack, + machineMatrixAddDeltaAccumulator_pack, + machineMatrixAddDeltaDelta_pack, + machineMatrixAddDeltaDimension_pack, + machineMatrixAddDeltaBound_pack] + refine ⟨trivial, ?_, by simp, trivial, ?_, trivial⟩ + · exact (machinePairSecond_length_le + (machineMatrixAddDeltaInputMatrix word)).trans + (machinePairSecond_length_le word) + · exact (machinePairFirst_length_le + (machineMatrixAddDeltaInputMatrix word)).trans + (machinePairSecond_length_le word) + +theorem machineMatrixAddDeltaStep_bound {word state : List Bool} + (hstate : MachineMatrixAddDeltaStateBound word state) : + MachineMatrixAddDeltaStateBound word + (machineMatrixAddDeltaStep state) := by + rcases hstate with + ⟨hdecomp, hremaining, haccumulator, hdelta, hdimension, hbound⟩ + by_cases hnil : machineMatrixAddDeltaRemaining state = [] + · rw [machineMatrixAddDeltaStep, hnil, machineIfEmpty_nil] + exact ⟨hdecomp, hremaining, haccumulator, hdelta, hdimension, hbound⟩ + · rw [machineMatrixAddDeltaStep] + cases hremainingCode : machineMatrixAddDeltaRemaining state with + | nil => exact False.elim (hnil hremainingCode) + | cons bit tail => + rw [machineIfEmpty_cons, machineMatrixAddDeltaAdvance] + simp only [MachineMatrixAddDeltaStateBound, + machineMatrixAddDeltaRemaining_pack, + machineMatrixAddDeltaAccumulator_pack, + machineMatrixAddDeltaDelta_pack, + machineMatrixAddDeltaDimension_pack, + machineMatrixAddDeltaBound_pack] + refine ⟨trivial, ?_, ?_, hdelta, hdimension, hbound⟩ + · exact (machineListTail_length_le + (machineMatrixAddDeltaRemaining state)).trans hremaining + · rw [machineMatrixAddDeltaNextAccumulator, hbound] + exact List.length_take_le _ _ + +theorem machineMatrixAddDeltaIterate_bound (word : List Bool) : ∀ k, + MachineMatrixAddDeltaStateBound word + ((machineMatrixAddDeltaStep)^[k] + (machineMatrixAddDeltaInit word)) := by + intro k + induction k with + | zero => exact machineMatrixAddDeltaInit_bound word + | succ k ih => + rw [Function.iterate_succ_apply'] + exact machineMatrixAddDeltaStep_bound ih + +theorem machineMatrixAddDeltaIterate_length_le_width + (word : List Bool) (iterations : ℕ) (_ : iterations ≤ word.length) : + ((machineMatrixAddDeltaStep)^[iterations] + (machineMatrixAddDeltaInit word)).length ≤ + (machineMatrixAddDeltaWidth word).length := by + rcases machineMatrixAddDeltaIterate_bound word iterations with + ⟨hdecomp, hremaining, haccumulator, hdelta, hdimension, hbound⟩ + rw [hdecomp, hdelta, hbound] + simp only [machineMatrixAddDeltaPack, machineMatrixAddDeltaWidth, + pair_length] + omega + +theorem machineMatrixAddDeltaFinalState_mem_FP : + machineMatrixAddDeltaFinalState ∈ Complexity.FP := by + exact Cobham.iterate_mem_FP machineMatrixAddDeltaStep_mem_FP + machineMatrixAddDeltaInit_mem_FP id_mem_FP + machineMatrixAddDeltaWidth_mem_FP + machineMatrixAddDeltaIterate_length_le_width + +theorem machineMatrixAddDeltaEntries_mem_FP : + machineMatrixAddDeltaEntries ∈ Complexity.FP := by + have hdimension := machineCompose_mem_FP + machineMatrixAddDeltaFinalState_mem_FP + machineMatrixAddDeltaDimension_mem_FP + have hacc := machineCompose_mem_FP + machineMatrixAddDeltaFinalState_mem_FP + machineMatrixAddDeltaAccumulator_mem_FP + have hrows := machineCompose_mem_FP hacc machineListReverse_mem_FP + simpa only [machineMatrixAddDeltaEntries] using + machinePair_mem_FP hdimension hrows + +/-! ## Output-size bound on canonical matrices -/ + +private theorem matrixAddDelta_natList_sum_le_length_mul + {values : List ℕ} {bound : ℕ} + (h : ∀ value ∈ values, value ≤ bound) : + values.sum ≤ values.length * bound := by + induction values with + | nil => simp + | cons value values ih => + simp only [List.sum_cons, List.length_cons] + have hvalue := h value (by simp) + have htail : ∀ x ∈ values, x ≤ bound := by + intro x hx + exact h x (by simp [hx]) + have hi := ih htail + calc + value + values.sum ≤ bound + values.length * bound := + Nat.add_le_add hvalue hi + _ = (values.length + 1) * bound := by ring + +private theorem matrixNonnegativeRowsWork_eq_length_add_entries : + ∀ rows : List (List ℚ), + matrixNonnegativeRowsWork rows = + rows.length + (rows.map List.length).sum := by + intro rows + induction rows with + | nil => simp [matrixNonnegativeRowsWork] + | cons row rows ih => + simp [matrixNonnegativeRowsWork, ih] + omega + +private theorem matrixAddDelta_outputCode_length_le + (delta : RawRat) (budget : ℕ) : ∀ rows : List (List ℚ), + (∀ row ∈ rows, ∀ q ∈ row, + (rationalEntryBinaryCode + (binaryNormalizeRawRat ((rawRatOfRat q).add delta))).length ≤ + 172 + 72 * budget) → + (binaryListCode (binaryListCode rationalEntryBinaryCode) + (rows.map (rationalRowAddValues delta))).length ≤ + (rows.map List.length).sum * (692 + 288 * budget) + + 2 * rows.length := by + intro rows hentry + induction rows with + | nil => simp [binaryListCode] + | cons row rows ih => + have hrowEntry : ∀ q ∈ row, + (rationalEntryBinaryCode + (binaryNormalizeRawRat ((rawRatOfRat q).add delta))).length ≤ + 172 + 72 * budget := by + intro q hq + exact hentry row (by simp) q hq + have htailEntry : ∀ tailRow ∈ rows, ∀ q ∈ tailRow, + (rationalEntryBinaryCode + (binaryNormalizeRawRat ((rawRatOfRat q).add delta))).length ≤ + 172 + 72 * budget := by + intro tailRow htailRow q hq + exact hentry tailRow (by simp [htailRow]) q hq + have hinner : + (binaryListCode rationalEntryBinaryCode + (rationalRowAddValues delta row)).length ≤ + row.length * (346 + 144 * budget) := by + rw [binaryListCode_length_eq_sum] + have hterm : ∀ value ∈ + ((rationalRowAddValues delta row).map + fun q ↦ 2 * (rationalEntryBinaryCode q).length + 2), + value ≤ 346 + 144 * budget := by + simp only [rationalRowAddValues, List.map_map] + intro value hvalue + rw [List.mem_map] at hvalue + rcases hvalue with ⟨q, hq, rfl⟩ + have hqBound := hrowEntry q hq + simp only [Function.comp_apply] + omega + have hsum := matrixAddDelta_natList_sum_le_length_mul hterm + simpa only [rationalRowAddValues, List.length_map] using hsum + have htail := ih htailEntry + simp only [List.map_cons, binaryListCode, pair_length, + List.map_map, List.sum_cons, List.length_cons] at htail ⊢ + nlinarith + +theorem machineMatrixAddDelta_outputRows_length_le_bound {n : ℕ} + (delta : RawRat) (A : Matrix (Fin n) (Fin n) ℚ) : + let matrixWord := rationalMatrixBinaryEncoding.encode ⟨n, A⟩ + let word := pair (rawRatBinaryCode delta) matrixWord + let output := (rationalMatrixRows A).map + (rationalRowAddValues delta) + (binaryListCode (binaryListCode rationalEntryBinaryCode) output).length ≤ + (machineMatrixAddDeltaInputBound word).length := by + dsimp only + let matrixWord := rationalMatrixBinaryEncoding.encode ⟨n, A⟩ + let word := pair (rawRatBinaryCode delta) matrixWord + let rows := rationalMatrixRows A + have hrowsMatrixCode : + (binaryListCode (binaryListCode rationalEntryBinaryCode) rows).length ≤ + matrixWord.length := by + calc + _ = (machineMatrixRowsWord matrixWord).length := by + simpa only [matrixWord, rows] using congrArg List.length + (machineMatrixRowsWord_encode A).symm + _ ≤ matrixWord.length := by + simpa only [machineMatrixRowsWord] using + machinePairSecond_length_le matrixWord + have hmatrixWord : matrixWord.length ≤ word.length := by + simpa only [word, machinePairSecond_pair] using + machinePairSecond_length_le word + have hrowsCode : + (binaryListCode (binaryListCode rationalEntryBinaryCode) rows).length ≤ + word.length := hrowsMatrixCode.trans hmatrixWord + have hdeltaWidth : rawRatWidth delta ≤ word.length := by + have hdeltaCode : (rawRatBinaryCode delta).length ≤ word.length := by + simpa only [word, machinePairFirst_pair] using + machinePairFirst_length_le word + exact (rawRatWidth_le_binaryCode_length delta).trans hdeltaCode + have hentry : ∀ row ∈ rows, ∀ q ∈ row, + (rationalEntryBinaryCode + (binaryNormalizeRawRat ((rawRatOfRat q).add delta))).length ≤ + 172 + 72 * word.length := by + intro row hrow q hq + have hqCode := binaryListCode_element_length_le + rationalEntryBinaryCode hq + have hrowCode := binaryListCode_element_length_le + (binaryListCode rationalEntryBinaryCode) hrow + have hqWidth : rawRatWidth (rawRatOfRat q) ≤ word.length := by + have hentryCode : + (rawRatBinaryCode (rawRatOfRat q)).length ≤ word.length := by + rw [rawRatBinaryCode_rawRatOfRat] + exact hqCode.trans (hrowCode.trans hrowsCode) + exact (rawRatWidth_le_binaryCode_length (rawRatOfRat q)).trans + hentryCode + have hadd := rawRatWidth_add_le (rawRatOfRat q) delta + have hnormalize := + rationalEntryBinaryCode_binaryNormalizeRawRat_length_le + ((rawRatOfRat q).add delta) + omega + have houtput := matrixAddDelta_outputCode_length_le + delta word.length rows hentry + have hwork : matrixNonnegativeRowsWork rows ≤ word.length := + (binaryListCode_length_ge_work rows).trans hrowsCode + rw [matrixNonnegativeRowsWork_eq_length_add_entries] at hwork + have hquadratic : + (rows.map List.length).sum * (692 + 288 * word.length) + + 2 * rows.length ≤ + (machineMatrixAddDeltaInputBound word).length := by + rw [machineMatrixAddDeltaInputBound] + simp only [machineBinaryMulWidth, List.length_replicate, + List.length_append] + rw [machineMatrixAddDeltaPadTwenty_length] + have hcombined : + (rows.map List.length).sum * (692 + 288 * word.length) + + 2 * rows.length ≤ + (rows.length + (rows.map List.length).sum) * + (694 + 288 * word.length) := by + have hentries := Nat.mul_le_mul_left + (rows.map List.length).sum + (show 692 + 288 * word.length ≤ 694 + 288 * word.length by omega) + have hrows := Nat.mul_le_mul_left rows.length + (show 2 ≤ 694 + 288 * word.length by omega) + calc + (rows.map List.length).sum * (692 + 288 * word.length) + + 2 * rows.length ≤ + (rows.map List.length).sum * (694 + 288 * word.length) + + rows.length * (694 + 288 * word.length) := by + exact Nat.add_le_add hentries (by simpa [Nat.mul_comm] using hrows) + _ = (rows.length + (rows.map List.length).sum) * + (694 + 288 * word.length) := by ring + have hlinear := Nat.mul_le_mul_right (694 + 288 * word.length) hwork + have hsquare : + word.length * (694 + 288 * word.length) ≤ + (16 + 20 * word.length) * (16 + 20 * word.length) := by + cases hword : word.length with + | zero => simp + | succ length => + have hsquareDominates : length + 1 ≤ (length + 1) * (length + 1) := by + nlinarith + nlinarith + exact hcombined.trans (hlinear.trans hsquare) + exact houtput.trans hquadratic + +/-! ## Exact semantics -/ + +def rationalMatrixAddRows (delta : RawRat) + (rows : List (List ℚ)) : List (List ℚ) := + rows.map (rationalRowAddValues delta) + +def machineMatrixAddDeltaCanonicalInput {n : ℕ} + (delta : RawRat) (A : Matrix (Fin n) (Fin n) ℚ) : List Bool := + pair (rawRatBinaryCode delta) + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩) + +def machineMatrixAddDeltaSemanticState + (word dimension : List Bool) (delta : RawRat) + (rows : List (List ℚ)) (k : ℕ) : List Bool := + let output := rationalMatrixAddRows delta rows + machineMatrixAddDeltaPack + (binaryListCode (binaryListCode rationalEntryBinaryCode) (rows.drop k)) + (binaryListCode (binaryListCode rationalEntryBinaryCode) + (output.take k).reverse) + (rawRatBinaryCode delta) dimension + (machineMatrixAddDeltaInputBound word) + +theorem machineMatrixAddDeltaInit_encode {n : ℕ} + (delta : RawRat) (A : Matrix (Fin n) (Fin n) ℚ) : + let word := machineMatrixAddDeltaCanonicalInput delta A + machineMatrixAddDeltaInit word = + machineMatrixAddDeltaSemanticState word n.bits delta + (rationalMatrixRows A) 0 := by + dsimp only + simp only [machineMatrixAddDeltaInit, + machineMatrixAddDeltaCanonicalInput, + machineMatrixAddDeltaInputMatrix, machinePairSecond_pair, + machineMatrixAddDeltaInputDelta, machinePairFirst_pair, + machineMatrixRowsWord_encode, + machineMatrixDimensionWord_encode, + machineMatrixAddDeltaSemanticState, List.drop_zero, + List.take_zero, List.reverse_nil, binaryListCode] + +theorem machineMatrixAddDeltaOutputRow_semantics + (word dimension : List Bool) (delta : RawRat) + (rows : List (List ℚ)) (k : ℕ) (hk : k < rows.length) : + machineMatrixAddDeltaOutputRow + (machineMatrixAddDeltaSemanticState word dimension delta rows k) = + binaryListCode rationalEntryBinaryCode + (rationalRowAddValues delta rows[k]) := by + have hdrop := List.drop_eq_getElem_cons hk + rw [machineMatrixAddDeltaOutputRow] + simp only [machineMatrixAddDeltaSemanticState, + machineMatrixAddDeltaDelta_pack, + machineMatrixAddDeltaCurrentRow, + machineMatrixAddDeltaRemaining_pack, hdrop, + machineListHead_cons] + change machineRationalRowAdd + (machineRationalRowAddCanonicalInput delta rows[k]) = _ + exact machineRationalRowAdd_encode delta rows[k] + +theorem machineMatrixAddDeltaStep_semantics + (word dimension : List Bool) (delta : RawRat) + (rows : List (List ℚ)) (k : ℕ) (hk : k < rows.length) + (hfullBound : + (binaryListCode (binaryListCode rationalEntryBinaryCode) + (rationalMatrixAddRows delta rows)).length ≤ + (machineMatrixAddDeltaInputBound word).length) : + machineMatrixAddDeltaStep + (machineMatrixAddDeltaSemanticState word dimension delta rows k) = + machineMatrixAddDeltaSemanticState word dimension delta rows (k + 1) := by + let output := rationalMatrixAddRows delta rows + have houtputLength : output.length = rows.length := by + simp [output, rationalMatrixAddRows] + have hkoutput : k < output.length := by omega + have houtputGet : output[k] = + rationalRowAddValues delta rows[k] := by + simp [output, rationalMatrixAddRows, List.getElem_map] + have hdrop := List.drop_eq_getElem_cons hk + have htake := List.take_concat_get hkoutput + have hprefix : (output.take (k + 1)).reverse = + output[k] :: (output.take k).reverse := by + rw [← htake] + simpa only [List.concat_eq_append] using + (List.reverse_concat (l := output.take k) (a := output[k])) + have hprefixLength : + (binaryListCode (binaryListCode rationalEntryBinaryCode) + (output.take (k + 1)).reverse).length ≤ + (machineMatrixAddDeltaInputBound word).length := + (binaryListCode_take_reverse_length_le + (binaryListCode rationalEntryBinaryCode) output (k + 1)).trans + (by simpa only [output] using hfullBound) + have htakeBound : + (binaryListCode (binaryListCode rationalEntryBinaryCode) + (output.take (k + 1)).reverse).take + (machineMatrixAddDeltaInputBound word).length = + binaryListCode (binaryListCode rationalEntryBinaryCode) + (output.take (k + 1)).reverse := + List.take_of_length_le hprefixLength + have hnonempty : + binaryListCode (binaryListCode rationalEntryBinaryCode) + (rows.drop k) ≠ [] := by + rw [hdrop] + exact binaryListCode_cons_ne_nil _ _ _ + rw [machineMatrixAddDeltaStep] + simp only [machineMatrixAddDeltaSemanticState, + machineMatrixAddDeltaRemaining_pack] + rw [machineIfEmpty_of_ne_nil _ _ _ hnonempty, + machineMatrixAddDeltaAdvance] + simp only [machineMatrixAddDeltaRemaining_pack, + machineMatrixAddDeltaAccumulator_pack, + machineMatrixAddDeltaDelta_pack, + machineMatrixAddDeltaDimension_pack, + machineMatrixAddDeltaBound_pack, + machineMatrixAddDeltaNextAccumulator, + machineMatrixAddDeltaCandidate] + have hrow : + machineMatrixAddDeltaOutputRow + (machineMatrixAddDeltaPack + (binaryListCode (binaryListCode rationalEntryBinaryCode) + (rows.drop k)) + (binaryListCode (binaryListCode rationalEntryBinaryCode) + (output.take k).reverse) + (rawRatBinaryCode delta) dimension + (machineMatrixAddDeltaInputBound word)) = + binaryListCode rationalEntryBinaryCode output[k] := by + rw [houtputGet] + simpa only [machineMatrixAddDeltaSemanticState, output] using + machineMatrixAddDeltaOutputRow_semantics + word dimension delta rows k hk + rw [hrow, hdrop, machineListTail_cons] + change machineMatrixAddDeltaPack + (binaryListCode (binaryListCode rationalEntryBinaryCode) + (rows.drop (k + 1))) + ((binaryListCode (binaryListCode rationalEntryBinaryCode) + (output[k] :: (output.take k).reverse)).take + (machineMatrixAddDeltaInputBound word).length) + (rawRatBinaryCode delta) dimension + (machineMatrixAddDeltaInputBound word) = _ + rw [← hprefix, htakeBound] + +theorem machineMatrixAddDeltaIterate_semantics + (word dimension : List Bool) (delta : RawRat) + (rows : List (List ℚ)) + (hfullBound : + (binaryListCode (binaryListCode rationalEntryBinaryCode) + (rationalMatrixAddRows delta rows)).length ≤ + (machineMatrixAddDeltaInputBound word).length) : ∀ k ≤ rows.length, + (machineMatrixAddDeltaStep)^[k] + (machineMatrixAddDeltaSemanticState word dimension delta rows 0) = + machineMatrixAddDeltaSemanticState word dimension delta rows k := by + intro k hk + induction k with + | zero => rfl + | succ k ih => + rw [Function.iterate_succ_apply', ih (by omega)] + exact machineMatrixAddDeltaStep_semantics word dimension delta rows k + (by omega) hfullBound + +theorem machineMatrixAddDelta_done_iterate + (extra : ℕ) (accumulator delta dimension bound : List Bool) : + (machineMatrixAddDeltaStep)^[extra] + (machineMatrixAddDeltaPack [] accumulator delta dimension bound) = + machineMatrixAddDeltaPack [] accumulator delta dimension bound := by + induction extra with + | zero => rfl + | succ k ih => + rw [Function.iterate_succ_apply', ih] + simp [machineMatrixAddDeltaStep] + +theorem machineMatrixAddDeltaFinalState_encode {n : ℕ} + (delta : RawRat) (A : Matrix (Fin n) (Fin n) ℚ) : + let word := machineMatrixAddDeltaCanonicalInput delta A + let rows := rationalMatrixRows A + machineMatrixAddDeltaFinalState word = + machineMatrixAddDeltaPack [] + (binaryListCode (binaryListCode rationalEntryBinaryCode) + (rationalMatrixAddRows delta rows).reverse) + (rawRatBinaryCode delta) n.bits + (machineMatrixAddDeltaInputBound word) := by + dsimp only + let word := machineMatrixAddDeltaCanonicalInput delta A + let matrixWord := rationalMatrixBinaryEncoding.encode ⟨n, A⟩ + let rows := rationalMatrixRows A + have hrowsLength : rows.length ≤ word.length := by + have hn : rows.length ≤ matrixWord.length := by + simpa only [rows, matrixWord, rationalMatrixRows, List.length_ofFn] using + matrix_dimension_le_code_length A + have hm : matrixWord.length ≤ word.length := by + simpa only [word, machineMatrixAddDeltaCanonicalInput, + machinePairSecond_pair] using machinePairSecond_length_le word + exact hn.trans hm + have hfullBound : + (binaryListCode (binaryListCode rationalEntryBinaryCode) + (rationalMatrixAddRows delta rows)).length ≤ + (machineMatrixAddDeltaInputBound word).length := by + simpa only [word, rows, machineMatrixAddDeltaCanonicalInput, + rationalMatrixAddRows] using + machineMatrixAddDelta_outputRows_length_le_bound delta A + have hsplit : word.length = + (word.length - rows.length) + rows.length := by omega + have htakeAll : + (rationalMatrixAddRows delta rows).take rows.length = + rationalMatrixAddRows delta rows := by + have hlength : (rationalMatrixAddRows delta rows).length = + rows.length := by simp [rationalMatrixAddRows] + rw [← hlength, List.take_length] + change (machineMatrixAddDeltaStep)^[word.length] + (machineMatrixAddDeltaInit word) = _ + rw [hsplit, Function.iterate_add_apply, + machineMatrixAddDeltaInit_encode delta A, + machineMatrixAddDeltaIterate_semantics word n.bits delta rows + hfullBound rows.length le_rfl] + simp only [machineMatrixAddDeltaSemanticState, List.drop_length, + binaryListCode] + rw [htakeAll, machineMatrixAddDelta_done_iterate] + +def rationalMatrixAddDeltaSemantic {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) (delta : RawRat) : + Matrix (Fin n) (Fin n) ℚ := + fun i j ↦ A i j + delta.value + +theorem rationalMatrixAddRows_semantics {n : ℕ} + (delta : RawRat) (A : Matrix (Fin n) (Fin n) ℚ) : + rationalMatrixAddRows delta (rationalMatrixRows A) = + rationalMatrixRows (rationalMatrixAddDeltaSemantic A delta) := by + apply List.ext_get + · simp [rationalMatrixAddRows, rationalMatrixRows] + · intro i hi hi' + apply List.ext_get + · simp [rationalMatrixAddRows, rationalRowAddValues, + rationalMatrixRows] + · intro j hj hj' + simp [rationalMatrixAddRows, rationalRowAddValues, + rationalMatrixRows, rationalMatrixAddDeltaSemantic, + binaryNormalizeRawRat_eq_value, RawRat.value_add, + rawRatOfRat_value] + +@[simp] theorem machineMatrixAddDeltaEntries_encode {n : ℕ} + (delta : RawRat) (A : Matrix (Fin n) (Fin n) ℚ) : + machineMatrixAddDeltaEntries + (machineMatrixAddDeltaCanonicalInput delta A) = + rationalMatrixBinaryEncoding.encode + ⟨n, rationalMatrixAddDeltaSemantic A delta⟩ := by + let rows := rationalMatrixRows A + rw [machineMatrixAddDeltaEntries, + machineMatrixAddDeltaFinalState_encode delta A] + simp only [machineMatrixAddDeltaDimension_pack, + machineMatrixAddDeltaAccumulator_pack, + machineListReverse_encode, List.reverse_reverse] + rw [rationalMatrixAddRows_semantics delta A] + rfl + +@[simp] theorem machineMatrixAddDeltaEntries_rational {n : ℕ} + (delta : ℚ) (A : Matrix (Fin n) (Fin n) ℚ) : + machineMatrixAddDeltaEntries + (pair (rawRatBinaryCode (rawRatOfRat delta)) + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩)) = + rationalMatrixBinaryEncoding.encode + ⟨n, fun i j ↦ A i j + delta⟩ := by + rw [show pair (rawRatBinaryCode (rawRatOfRat delta)) + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩) = + machineMatrixAddDeltaCanonicalInput (rawRatOfRat delta) A from rfl, + machineMatrixAddDeltaEntries_encode] + congr 2 + funext i j + simp [rationalMatrixAddDeltaSemantic] + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineMatrixDimension.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineMatrixDimension.lean new file mode 100644 index 0000000000..b38f8ca6fa --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineMatrixDimension.lean @@ -0,0 +1,73 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineMatrixSum +import LeanPool.BeyondBethe.BeyondBethe.MachineBoundedUnary + +/-! +# A guarded unary dimension ruler + +Several bounded loops execute once per row or column. The binary dimension +cannot be expanded to unary on arbitrary strings, so the entire matrix word is +used as an explicit guard. Canonical square-matrix encodings are long enough +to make this guard inactive. +-/ + +namespace BeyondBethe + +open Complexity + +def machineMatrixDimensionUnary (word : List Bool) : List Bool := + machineBoundedUnary (pair word (machineMatrixDimensionWord word)) + +theorem machineMatrixDimensionUnary_mem_FP : + machineMatrixDimensionUnary ∈ Complexity.FP := by + have hpair := machinePair_mem_FP id_mem_FP + machineMatrixDimensionWord_mem_FP + simpa only [machineMatrixDimensionUnary] using + machineCompose_mem_FP hpair machineBoundedUnary_mem_FP + +theorem list_length_le_binaryListCode_length {α : Type*} + (encode : α → List Bool) : ∀ xs : List α, + xs.length ≤ (binaryListCode encode xs).length := by + intro xs + induction xs with + | nil => simp [binaryListCode] + | cons x xs ih => + simp only [List.length_cons, binaryListCode, pair_length] + omega + +theorem matrix_dimension_le_code_length {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) : + n ≤ (rationalMatrixBinaryEncoding.encode ⟨n, A⟩).length := by + have hlist : n ≤ (rationalMatrixRows A).length := by + simp [rationalMatrixRows] + have hrows := list_length_le_binaryListCode_length + (binaryListCode rationalEntryBinaryCode) (rationalMatrixRows A) + have hcode : + (binaryListCode (binaryListCode rationalEntryBinaryCode) + (rationalMatrixRows A)).length ≤ + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩).length := by + calc + _ = (machineMatrixRowsWord + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩)).length := by + simpa using congrArg List.length + (machineMatrixRowsWord_encode A).symm + _ ≤ _ := by + simpa only [machineMatrixRowsWord] using machinePairSecond_length_le + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩) + exact hlist.trans (hrows.trans hcode) + +@[simp] theorem machineMatrixDimensionUnary_encode {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) : + machineMatrixDimensionUnary + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩) = + List.replicate n true := by + rw [machineMatrixDimensionUnary, machineMatrixDimensionWord_encode, + machineBoundedUnary_encode_of_le] + exact matrix_dimension_le_code_length A + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineMatrixNonnegative.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineMatrixNonnegative.lean new file mode 100644 index 0000000000..3020a81a5e --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineMatrixNonnegative.lean @@ -0,0 +1,476 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalCompare +import LeanPool.BeyondBethe.BeyondBethe.RawRationalBitBounds + +/-! +# Polynomial-time matrix nonnegativity guard + +The public matrix encoding is a pair containing a right-nested list of rows, +each itself a right-nested list of rational entries. This file scans that +encoding directly. The scan never decodes a binary dimension into unary and +never invokes Lean's decision procedure on the typed matrix. +-/ + +namespace BeyondBethe + +open Complexity + +def machineMatrixNonnegativePack + (rows current ok : List Bool) : List Bool := + pair rows (pair current ok) + +def machineMatrixNonnegativeRows (state : List Bool) : List Bool := + machinePairFirst state + +def machineMatrixNonnegativeCurrent (state : List Bool) : List Bool := + machinePairFirst (machinePairSecond state) + +def machineMatrixNonnegativeOk (state : List Bool) : List Bool := + machinePairSecond (machinePairSecond state) + +def machineMatrixNonnegativeEntry (state : List Bool) : List Bool := + machineListHead (machineMatrixNonnegativeCurrent state) + +def machineMatrixNonnegativeEntryBit (state : List Bool) : List Bool := + machineHeadBit + (machineRawRatLeBit + (pair (rawRatBinaryCode RawRat.zero) + (machineMatrixNonnegativeEntry state))) + +def machineMatrixNonnegativeProcessEntry (state : List Bool) : List Bool := + machineMatrixNonnegativePack + (machineMatrixNonnegativeRows state) + (machineListTail (machineMatrixNonnegativeCurrent state)) + (machineAndBit (machineMatrixNonnegativeOk state) + (machineMatrixNonnegativeEntryBit state)) + +def machineMatrixNonnegativeLoadRow (state : List Bool) : List Bool := + machineMatrixNonnegativePack + (machineListTail (machineMatrixNonnegativeRows state)) + (machineListHead (machineMatrixNonnegativeRows state)) + (machineMatrixNonnegativeOk state) + +def machineMatrixNonnegativeAfterRow (state : List Bool) : List Bool := + machineIfEmpty (machineMatrixNonnegativeRows state) state + (machineMatrixNonnegativeLoadRow state) + +def machineMatrixNonnegativeStep (state : List Bool) : List Bool := + machineIfEmpty (machineMatrixNonnegativeCurrent state) + (machineMatrixNonnegativeAfterRow state) + (machineMatrixNonnegativeProcessEntry state) + +def machineMatrixNonnegativeInit (word : List Bool) : List Bool := + machineMatrixNonnegativePack (machineMatrixRowsWord word) [] [true] + +def machineMatrixNonnegativeWidth (word : List Bool) : List Bool := + machineMatrixNonnegativePack word word [true] + +def machineMatrixNonnegativeFinalState (word : List Bool) : List Bool := + (machineMatrixNonnegativeStep)^[word.length] + (machineMatrixNonnegativeInit word) + +/-- One-bit result of the direct nested-list scan. -/ +def machineMatrixNonnegativeBit (word : List Bool) : List Bool := + machineMatrixNonnegativeOk (machineMatrixNonnegativeFinalState word) + +theorem machineMatrixNonnegativeRows_mem_FP : + machineMatrixNonnegativeRows ∈ Complexity.FP := + machinePairFirst_mem_FP + +theorem machineMatrixNonnegativeCurrent_mem_FP : + machineMatrixNonnegativeCurrent ∈ Complexity.FP := by + simpa only [machineMatrixNonnegativeCurrent] using + machineCompose_mem_FP machinePairSecond_mem_FP machinePairFirst_mem_FP + +theorem machineMatrixNonnegativeOk_mem_FP : + machineMatrixNonnegativeOk ∈ Complexity.FP := by + simpa only [machineMatrixNonnegativeOk] using + machineCompose_mem_FP machinePairSecond_mem_FP machinePairSecond_mem_FP + +theorem machineMatrixNonnegativeEntry_mem_FP : + machineMatrixNonnegativeEntry ∈ Complexity.FP := by + simpa only [machineMatrixNonnegativeEntry, machineListHead] using + machineCompose_mem_FP machineMatrixNonnegativeCurrent_mem_FP + machinePairFirst_mem_FP + +theorem machineMatrixNonnegativeEntryBit_mem_FP : + machineMatrixNonnegativeEntryBit ∈ Complexity.FP := by + have hpair := machinePair_mem_FP + (machineConst_mem_FP (rawRatBinaryCode RawRat.zero)) + machineMatrixNonnegativeEntry_mem_FP + simpa only [machineMatrixNonnegativeEntryBit] using + machineCompose_mem_FP + (machineCompose_mem_FP hpair machineRawRatLeBit_mem_FP) + machineHeadBit_mem_FP + +theorem machineMatrixNonnegativeProcessEntry_mem_FP : + machineMatrixNonnegativeProcessEntry ∈ Complexity.FP := by + have htail := machineCompose_mem_FP + machineMatrixNonnegativeCurrent_mem_FP machineListTail_mem_FP + exact machinePair_mem_FP machineMatrixNonnegativeRows_mem_FP + (machinePair_mem_FP htail + (machineAndBit_mem_FP machineMatrixNonnegativeOk_mem_FP + machineMatrixNonnegativeEntryBit_mem_FP)) + +theorem machineMatrixNonnegativeLoadRow_mem_FP : + machineMatrixNonnegativeLoadRow ∈ Complexity.FP := by + have htail := machineCompose_mem_FP + machineMatrixNonnegativeRows_mem_FP machineListTail_mem_FP + have hhead := machineCompose_mem_FP + machineMatrixNonnegativeRows_mem_FP machineListHead_mem_FP + exact machinePair_mem_FP htail + (machinePair_mem_FP hhead machineMatrixNonnegativeOk_mem_FP) + +theorem machineMatrixNonnegativeAfterRow_mem_FP : + machineMatrixNonnegativeAfterRow ∈ Complexity.FP := by + simpa only [machineMatrixNonnegativeAfterRow] using + machineIfEmpty_mem_FP machineMatrixNonnegativeRows_mem_FP id_mem_FP + machineMatrixNonnegativeLoadRow_mem_FP + +theorem machineMatrixNonnegativeStep_mem_FP : + machineMatrixNonnegativeStep ∈ Complexity.FP := by + simpa only [machineMatrixNonnegativeStep] using + machineIfEmpty_mem_FP machineMatrixNonnegativeCurrent_mem_FP + machineMatrixNonnegativeAfterRow_mem_FP + machineMatrixNonnegativeProcessEntry_mem_FP + +theorem machineMatrixNonnegativeInit_mem_FP : + machineMatrixNonnegativeInit ∈ Complexity.FP := by + exact machinePair_mem_FP machineMatrixRowsWord_mem_FP + (machinePair_mem_FP (machineConst_mem_FP []) + (machineConst_mem_FP [true])) + +theorem machineMatrixNonnegativeWidth_mem_FP : + machineMatrixNonnegativeWidth ∈ Complexity.FP := by + exact machinePair_mem_FP id_mem_FP + (machinePair_mem_FP id_mem_FP (machineConst_mem_FP [true])) + +@[simp] theorem machineMatrixNonnegativeRows_pack (rows current ok) : + machineMatrixNonnegativeRows + (machineMatrixNonnegativePack rows current ok) = rows := by + simp [machineMatrixNonnegativeRows, machineMatrixNonnegativePack] + +@[simp] theorem machineMatrixNonnegativeCurrent_pack (rows current ok) : + machineMatrixNonnegativeCurrent + (machineMatrixNonnegativePack rows current ok) = current := by + simp [machineMatrixNonnegativeCurrent, machineMatrixNonnegativePack] + +@[simp] theorem machineMatrixNonnegativeOk_pack (rows current ok) : + machineMatrixNonnegativeOk + (machineMatrixNonnegativePack rows current ok) = ok := by + simp [machineMatrixNonnegativeOk, machineMatrixNonnegativePack] + +def MachineMatrixNonnegativeStateBound + (word state : List Bool) : Prop := + state = machineMatrixNonnegativePack + (machineMatrixNonnegativeRows state) + (machineMatrixNonnegativeCurrent state) + (machineMatrixNonnegativeOk state) ∧ + (machineMatrixNonnegativeRows state).length ≤ word.length ∧ + (machineMatrixNonnegativeCurrent state).length ≤ word.length ∧ + (machineMatrixNonnegativeOk state).length ≤ 1 + +theorem machineMatrixNonnegativeInit_bound (word : List Bool) : + MachineMatrixNonnegativeStateBound word + (machineMatrixNonnegativeInit word) := by + simp only [MachineMatrixNonnegativeStateBound, + machineMatrixNonnegativeInit, machineMatrixNonnegativeRows_pack, + machineMatrixNonnegativeCurrent_pack, machineMatrixNonnegativeOk_pack] + refine ⟨trivial, ?_, by simp, by simp⟩ + simpa only [machineMatrixRowsWord] using machinePairSecond_length_le word + +theorem machineMatrixNonnegativeStep_bound + {word state : List Bool} + (hstate : MachineMatrixNonnegativeStateBound word state) : + MachineMatrixNonnegativeStateBound word + (machineMatrixNonnegativeStep state) := by + rcases hstate with ⟨hdecomp, hrows, hcurrent, hok⟩ + by_cases hc : machineMatrixNonnegativeCurrent state = [] + · rw [machineMatrixNonnegativeStep, hc, machineIfEmpty_nil] + by_cases hr : machineMatrixNonnegativeRows state = [] + · rw [machineMatrixNonnegativeAfterRow, hr, machineIfEmpty_nil] + exact ⟨hdecomp, hrows, hcurrent, hok⟩ + · rw [machineMatrixNonnegativeAfterRow] + cases hrowsCode : machineMatrixNonnegativeRows state with + | nil => exact False.elim (hr hrowsCode) + | cons bit tail => + rw [machineIfEmpty_cons, machineMatrixNonnegativeLoadRow] + simp only [MachineMatrixNonnegativeStateBound, + machineMatrixNonnegativeRows_pack, + machineMatrixNonnegativeCurrent_pack, + machineMatrixNonnegativeOk_pack] + refine ⟨trivial, ?_, ?_, hok⟩ + · exact (machinePairSecond_length_le + (machineMatrixNonnegativeRows state)).trans hrows + · exact (machinePairFirst_length_le + (machineMatrixNonnegativeRows state)).trans hrows + · rw [machineMatrixNonnegativeStep] + cases hcurrentCode : machineMatrixNonnegativeCurrent state with + | nil => exact False.elim (hc hcurrentCode) + | cons bit tail => + rw [machineIfEmpty_cons, machineMatrixNonnegativeProcessEntry] + simp only [MachineMatrixNonnegativeStateBound, + machineMatrixNonnegativeRows_pack, + machineMatrixNonnegativeCurrent_pack, + machineMatrixNonnegativeOk_pack] + refine ⟨trivial, hrows, ?_, ?_⟩ + · exact (machinePairSecond_length_le + (machineMatrixNonnegativeCurrent state)).trans hcurrent + · change (machineIfHead (machineMatrixNonnegativeOk state) + (machineMatrixNonnegativeEntryBit state) [false]).length ≤ 1 + cases hokCode : machineMatrixNonnegativeOk state with + | nil => simp [machineIfHead, Cobham.selectHead] + | cons bit tail => + cases bit <;> + simp [machineIfHead, Cobham.selectHead, + machineMatrixNonnegativeEntryBit] + +theorem machineMatrixNonnegativeIterate_bound (word : List Bool) : ∀ k, + MachineMatrixNonnegativeStateBound word + ((machineMatrixNonnegativeStep)^[k] + (machineMatrixNonnegativeInit word)) := by + intro k + induction k with + | zero => exact machineMatrixNonnegativeInit_bound word + | succ k ih => + rw [Function.iterate_succ_apply'] + exact machineMatrixNonnegativeStep_bound ih + +theorem machineMatrixNonnegativeIterate_length_le_width + (word : List Bool) (iterations : ℕ) + (_ : iterations ≤ word.length) : + ((machineMatrixNonnegativeStep)^[iterations] + (machineMatrixNonnegativeInit word)).length ≤ + (machineMatrixNonnegativeWidth word).length := by + rcases machineMatrixNonnegativeIterate_bound word iterations with + ⟨hdecomp, hrows, hcurrent, hok⟩ + rw [hdecomp] + simp only [machineMatrixNonnegativePack, + machineMatrixNonnegativeWidth, pair_length, List.length_cons, + List.length_nil] + omega + +theorem machineMatrixNonnegativeFinalState_mem_FP : + machineMatrixNonnegativeFinalState ∈ Complexity.FP := by + exact Cobham.iterate_mem_FP machineMatrixNonnegativeStep_mem_FP + machineMatrixNonnegativeInit_mem_FP id_mem_FP + machineMatrixNonnegativeWidth_mem_FP + machineMatrixNonnegativeIterate_length_le_width + +theorem machineMatrixNonnegativeBit_mem_FP : + machineMatrixNonnegativeBit ∈ Complexity.FP := by + simpa only [machineMatrixNonnegativeBit] using + machineCompose_mem_FP machineMatrixNonnegativeFinalState_mem_FP + machineMatrixNonnegativeOk_mem_FP + +/-! ## Exact semantics on canonical nested-list encodings -/ + +def rationalNonnegativeBit (q : ℚ) : Bool := decide (0 ≤ q) + +theorem machineIfEmpty_of_ne_nil_matrix + (test whenEmpty whenNonempty : List Bool) (h : test ≠ []) : + machineIfEmpty test whenEmpty whenNonempty = whenNonempty := by + cases test with + | nil => exact False.elim (h rfl) + | cons bit tail => simp + +theorem binaryListCode_cons_ne_nil {α : Type*} + (encode : α → List Bool) (x : α) (xs : List α) : + binaryListCode encode (x :: xs) ≠ [] := by + intro h + have hlen := congrArg List.length h + simp [binaryListCode] at hlen + +@[simp] theorem rawRatBinaryCode_rawRatOfRat (q : ℚ) : + rawRatBinaryCode (rawRatOfRat q) = rationalEntryBinaryCode q := by + simp [rawRatBinaryCode, rawRatOfRat, rationalEntryBinaryCode] + +@[simp] theorem machineMatrixNonnegativeEntryBit_encode + (rows : List (List ℚ)) (current : List ℚ) (ok : Bool) (q : ℚ) : + machineMatrixNonnegativeEntryBit + (machineMatrixNonnegativePack + (binaryListCode (binaryListCode rationalEntryBinaryCode) rows) + (binaryListCode rationalEntryBinaryCode (q :: current)) [ok]) = + [rationalNonnegativeBit q] := by + rw [machineMatrixNonnegativeEntryBit, + machineMatrixNonnegativeEntry] + simp only [machineMatrixNonnegativeCurrent_pack, + machineListHead_cons, ← rawRatBinaryCode_rawRatOfRat] + rw [machineRawRatLeBit_encode, machineHeadBit_cons] + simp [rationalNonnegativeBit] + +@[simp] theorem machineMatrixNonnegativeStep_entry_encode + (rows : List (List ℚ)) (q : ℚ) (current : List ℚ) (ok : Bool) : + machineMatrixNonnegativeStep + (machineMatrixNonnegativePack + (binaryListCode (binaryListCode rationalEntryBinaryCode) rows) + (binaryListCode rationalEntryBinaryCode (q :: current)) [ok]) = + machineMatrixNonnegativePack + (binaryListCode (binaryListCode rationalEntryBinaryCode) rows) + (binaryListCode rationalEntryBinaryCode current) + [ok && rationalNonnegativeBit q] := by + rw [machineMatrixNonnegativeStep] + simp only [machineMatrixNonnegativeCurrent_pack] + rw [machineIfEmpty_of_ne_nil_matrix _ _ _ + (binaryListCode_cons_ne_nil rationalEntryBinaryCode q current)] + simp [machineMatrixNonnegativeProcessEntry] + +@[simp] theorem machineMatrixNonnegativeStep_row_encode + (row : List ℚ) (rows : List (List ℚ)) (ok : Bool) : + machineMatrixNonnegativeStep + (machineMatrixNonnegativePack + (binaryListCode (binaryListCode rationalEntryBinaryCode) + (row :: rows)) [] [ok]) = + machineMatrixNonnegativePack + (binaryListCode (binaryListCode rationalEntryBinaryCode) rows) + (binaryListCode rationalEntryBinaryCode row) [ok] := by + rw [machineMatrixNonnegativeStep] + simp only [machineMatrixNonnegativeCurrent_pack] + rw [machineIfEmpty_nil, machineMatrixNonnegativeAfterRow] + simp only [machineMatrixNonnegativeRows_pack] + rw [machineIfEmpty_of_ne_nil_matrix _ _ _ + (binaryListCode_cons_ne_nil + (binaryListCode rationalEntryBinaryCode) row rows)] + simp [machineMatrixNonnegativeLoadRow] + +@[simp] theorem machineMatrixNonnegativeStep_done_encode (ok : Bool) : + machineMatrixNonnegativeStep + (machineMatrixNonnegativePack [] [] [ok]) = + machineMatrixNonnegativePack [] [] [ok] := by + simp [machineMatrixNonnegativeStep, machineMatrixNonnegativeAfterRow] + +def matrixNonnegativeRowBit (row : List ℚ) : Bool := + row.all rationalNonnegativeBit + +def matrixNonnegativeRowsBit (rows : List (List ℚ)) : Bool := + rows.all matrixNonnegativeRowBit + +theorem machineMatrixNonnegativeProcessRow_encode + (rows : List (List ℚ)) (row : List ℚ) (ok : Bool) : + (machineMatrixNonnegativeStep)^[row.length] + (machineMatrixNonnegativePack + (binaryListCode (binaryListCode rationalEntryBinaryCode) rows) + (binaryListCode rationalEntryBinaryCode row) [ok]) = + machineMatrixNonnegativePack + (binaryListCode (binaryListCode rationalEntryBinaryCode) rows) [] + [ok && matrixNonnegativeRowBit row] := by + induction row generalizing ok with + | nil => simp [matrixNonnegativeRowBit, binaryListCode] + | cons q row ih => + rw [List.length_cons, Function.iterate_succ_apply, + machineMatrixNonnegativeStep_entry_encode, ih] + simp [matrixNonnegativeRowBit, Bool.and_assoc] + +def matrixNonnegativeRowsWork : List (List ℚ) → ℕ + | [] => 0 + | row :: rows => 1 + row.length + matrixNonnegativeRowsWork rows + +theorem machineMatrixNonnegativeProcessRows_encode + (rows : List (List ℚ)) (ok : Bool) : + (machineMatrixNonnegativeStep)^[matrixNonnegativeRowsWork rows] + (machineMatrixNonnegativePack + (binaryListCode (binaryListCode rationalEntryBinaryCode) rows) + [] [ok]) = + machineMatrixNonnegativePack [] [] + [ok && matrixNonnegativeRowsBit rows] := by + induction rows generalizing ok with + | nil => + simp [matrixNonnegativeRowsWork, matrixNonnegativeRowsBit, + binaryListCode] + | cons row rows ih => + rw [matrixNonnegativeRowsWork, show 1 + row.length + + matrixNonnegativeRowsWork rows = + matrixNonnegativeRowsWork rows + row.length + 1 by omega, + Function.iterate_add_apply, Function.iterate_add_apply, + Function.iterate_one, machineMatrixNonnegativeStep_row_encode, + machineMatrixNonnegativeProcessRow_encode, ih] + simp [matrixNonnegativeRowsBit, Bool.and_assoc] + +theorem binaryListCode_length_ge_work (rows : List (List ℚ)) : + matrixNonnegativeRowsWork rows ≤ + (binaryListCode (binaryListCode rationalEntryBinaryCode) rows).length := by + induction rows with + | nil => simp [matrixNonnegativeRowsWork, binaryListCode] + | cons row rows ih => + simp only [matrixNonnegativeRowsWork, binaryListCode, pair_length] + have hrow : row.length ≤ + (binaryListCode rationalEntryBinaryCode row).length := by + induction row with + | nil => simp [binaryListCode] + | cons q row ihrow => + simp only [binaryListCode, pair_length, List.length_cons] + omega + omega + +theorem machineMatrixNonnegativeDone_iterate (extra : ℕ) (ok : Bool) : + (machineMatrixNonnegativeStep)^[extra] + (machineMatrixNonnegativePack [] [] [ok]) = + machineMatrixNonnegativePack [] [] [ok] := by + induction extra with + | zero => rfl + | succ k ih => + rw [Function.iterate_succ_apply', ih, + machineMatrixNonnegativeStep_done_encode] + +theorem machineMatrixNonnegativeFinalState_encode {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) : + machineMatrixNonnegativeFinalState + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩) = + machineMatrixNonnegativePack [] [] + [matrixNonnegativeRowsBit (rationalMatrixRows A)] := by + let rows := rationalMatrixRows A + let word := rationalMatrixBinaryEncoding.encode ⟨n, A⟩ + have hwork : matrixNonnegativeRowsWork rows ≤ word.length := by + have hcode := binaryListCode_length_ge_work rows + have hrows : + (binaryListCode (binaryListCode rationalEntryBinaryCode) rows).length ≤ + word.length := by + calc + (binaryListCode (binaryListCode rationalEntryBinaryCode) rows).length = + (machineMatrixRowsWord word).length := by + simpa only [word, rows] using congrArg List.length + (machineMatrixRowsWord_encode A).symm + _ ≤ word.length := by + simpa only [machineMatrixRowsWord] using + machinePairSecond_length_le word + exact hcode.trans hrows + have hsplit : word.length = + (word.length - matrixNonnegativeRowsWork rows) + + matrixNonnegativeRowsWork rows := by omega + change machineMatrixNonnegativeFinalState word = _ + rw [machineMatrixNonnegativeFinalState, hsplit, + Function.iterate_add_apply] + have hinit : machineMatrixNonnegativeInit word = + machineMatrixNonnegativePack + (binaryListCode (binaryListCode rationalEntryBinaryCode) rows) + [] [true] := by + simp [machineMatrixNonnegativeInit, word, rows] + rw [hinit, machineMatrixNonnegativeProcessRows_encode, + machineMatrixNonnegativeDone_iterate] + simp [rows] + +theorem matrixNonnegativeRowsBit_iff {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) : + matrixNonnegativeRowsBit (rationalMatrixRows A) = true ↔ + Matrix.Nonnegative A := by + simp [matrixNonnegativeRowsBit, matrixNonnegativeRowBit, + rationalNonnegativeBit, rationalMatrixRows, Matrix.Nonnegative] + +@[simp] theorem machineMatrixNonnegativeBit_encode {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) : + machineMatrixNonnegativeBit + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩) = + [decide (∀ i : Fin n, ∀ j : Fin n, 0 ≤ A i j)] := by + rw [machineMatrixNonnegativeBit, + machineMatrixNonnegativeFinalState_encode] + simp only [machineMatrixNonnegativeOk_pack] + apply congrArg singleton + apply Bool.eq_iff_iff.mpr + simpa [Matrix.Nonnegative] using matrixNonnegativeRowsBit_iff A + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineMatrixNormalization.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineMatrixNormalization.lean new file mode 100644 index 0000000000..58c166fd5d --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineMatrixNormalization.lean @@ -0,0 +1,67 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineMatrixDimension +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalPower + +/-! +# Machine normalization scale and its dimension power +-/ + +namespace BeyondBethe + +open Complexity + +def machineMatrixNormalizationScalePowerRawCode + (word : List Bool) : List Bool := + machineRawRatPowerCode + (pair (machineMatrixDimensionUnary word) + (machineMatrixNormalizationScaleRawCode word)) + +def machineMatrixNormalizationScalePowerOutputCode + (word : List Bool) : List Bool := + machineNormalizeRawRatBinaryCode + (machineMatrixNormalizationScalePowerRawCode word) + +theorem machineMatrixNormalizationScalePowerRawCode_mem_FP : + machineMatrixNormalizationScalePowerRawCode ∈ Complexity.FP := by + have hpair := machinePair_mem_FP machineMatrixDimensionUnary_mem_FP + machineMatrixNormalizationScaleRawCode_mem_FP + simpa only [machineMatrixNormalizationScalePowerRawCode] using + machineCompose_mem_FP hpair machineRawRatPowerCode_mem_FP + +theorem machineMatrixNormalizationScalePowerOutputCode_mem_FP : + machineMatrixNormalizationScalePowerOutputCode ∈ Complexity.FP := by + simpa only [machineMatrixNormalizationScalePowerOutputCode] using + machineCompose_mem_FP + machineMatrixNormalizationScalePowerRawCode_mem_FP + machineNormalizeRawRatBinaryCode_mem_FP + +@[simp] theorem machineMatrixNormalizationScalePowerRawCode_encode {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) : + machineMatrixNormalizationScalePowerRawCode + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩) = + rawRatBinaryCode + ((RawRat.one.add + (rawRatRowsSum RawRat.zero (rationalMatrixRows A))).pow n) := by + rw [machineMatrixNormalizationScalePowerRawCode, + machineMatrixDimensionUnary_encode, + machineMatrixNormalizationScaleRawCode_encode, + machineRawRatPowerCode_encode] + +@[simp] theorem machineMatrixNormalizationScalePowerOutputCode_encode + {n : ℕ} (A : Matrix (Fin n) (Fin n) ℚ) : + machineMatrixNormalizationScalePowerOutputCode + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩) = + rationalBinaryCode ((1 + ∑ i, ∑ j, A i j) ^ n) := by + rw [machineMatrixNormalizationScalePowerOutputCode, + machineMatrixNormalizationScalePowerRawCode_encode, + machineNormalizeRawRatBinaryCode_encode, + binaryNormalizeRawRat_eq_value, RawRat.value_pow, + RawRat.value_add, RawRat.value_one, rawRatRowsSum_value, + RawRat.value_zero, zero_add, rationalMatrixRows_sum] + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineMatrixNormalizeEntries.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineMatrixNormalizeEntries.lean new file mode 100644 index 0000000000..5e013968b1 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineMatrixNormalizeEntries.lean @@ -0,0 +1,761 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalRowDivide +import LeanPool.BeyondBethe.BeyondBethe.FinalAssembly +import Mathlib.Tactic + +/-! +# Entrywise normalization of a rational matrix + +This machine computes `A / (1 + sum A)` entry by entry. It preserves the +binary dimension prefix and maps the self-delimiting row list with the +verified row-division machine. A polynomial clamp is present on malformed +inputs and is proved inactive on every canonical rational matrix. +-/ + +namespace BeyondBethe + +open Complexity + +def machineMatrixNormalizePadTwenty (word : List Bool) : List Bool := + machineRationalRowDividePadSixteen word ++ + machineRationalRowDividePadFour word + +/-- A direct quadratic envelope in the original matrix-word length. Using +twenty copies before squaring avoids materializing the much larger nested +row-machine envelope used in the first implementation. -/ +def machineMatrixNormalizeInputBound (word : List Bool) : List Bool := + machineBinaryMulWidth (machineMatrixNormalizePadTwenty word) + +def machineMatrixNormalizePack + (remaining accumulator scale dimension bound : List Bool) : List Bool := + pair remaining (pair accumulator (pair scale (pair dimension bound))) + +def machineMatrixNormalizeRemaining (state : List Bool) : List Bool := + machinePairFirst state + +def machineMatrixNormalizeAccumulator (state : List Bool) : List Bool := + machinePairFirst (machinePairSecond state) + +def machineMatrixNormalizeScale (state : List Bool) : List Bool := + machinePairFirst (machinePairSecond (machinePairSecond state)) + +def machineMatrixNormalizeDimension (state : List Bool) : List Bool := + machinePairFirst + (machinePairSecond (machinePairSecond (machinePairSecond state))) + +def machineMatrixNormalizeBound (state : List Bool) : List Bool := + machinePairSecond + (machinePairSecond (machinePairSecond (machinePairSecond state))) + +def machineMatrixNormalizeCurrentRow (state : List Bool) : List Bool := + machineListHead (machineMatrixNormalizeRemaining state) + +def machineMatrixNormalizeOutputRow (state : List Bool) : List Bool := + machineRationalRowDivide + (pair (machineMatrixNormalizeScale state) + (machineMatrixNormalizeCurrentRow state)) + +def machineMatrixNormalizeCandidate (state : List Bool) : List Bool := + pair (machineMatrixNormalizeOutputRow state) + (machineMatrixNormalizeAccumulator state) + +def machineMatrixNormalizeNextAccumulator (state : List Bool) : List Bool := + (machineMatrixNormalizeCandidate state).take + (machineMatrixNormalizeBound state).length + +def machineMatrixNormalizeAdvance (state : List Bool) : List Bool := + machineMatrixNormalizePack + (machineListTail (machineMatrixNormalizeRemaining state)) + (machineMatrixNormalizeNextAccumulator state) + (machineMatrixNormalizeScale state) + (machineMatrixNormalizeDimension state) + (machineMatrixNormalizeBound state) + +def machineMatrixNormalizeStep (state : List Bool) : List Bool := + machineIfEmpty (machineMatrixNormalizeRemaining state) state + (machineMatrixNormalizeAdvance state) + +def machineMatrixNormalizeInit (word : List Bool) : List Bool := + machineMatrixNormalizePack (machineMatrixRowsWord word) [] + (machineMatrixNormalizationScaleRawCode word) + (machineMatrixDimensionWord word) + (machineMatrixNormalizeInputBound word) + +def machineMatrixNormalizeWidth (word : List Bool) : List Bool := + machineMatrixNormalizePack word (machineMatrixNormalizeInputBound word) + (machineMatrixNormalizationScaleRawCode word) word + (machineMatrixNormalizeInputBound word) + +def machineMatrixNormalizeFinalState (word : List Bool) : List Bool := + (machineMatrixNormalizeStep)^[word.length] + (machineMatrixNormalizeInit word) + +def machineMatrixNormalizeEntries (word : List Bool) : List Bool := + let state := machineMatrixNormalizeFinalState word + pair (machineMatrixNormalizeDimension state) + (machineListReverse (machineMatrixNormalizeAccumulator state)) + +theorem machineMatrixNormalizePadTwenty_mem_FP : + machineMatrixNormalizePadTwenty ∈ Complexity.FP := + machineAppend_mem_FP machineRationalRowDividePadSixteen_mem_FP + machineRationalRowDividePadFour_mem_FP + +theorem machineMatrixNormalizePadTwenty_length (word : List Bool) : + (machineMatrixNormalizePadTwenty word).length = 20 * word.length := by + simp only [machineMatrixNormalizePadTwenty, List.length_append, + machineRationalRowDividePadSixteen_length, + machineRationalRowDividePadFour, + machineRationalRowDividePadTwo, List.length_append] + omega + +theorem machineMatrixNormalizeInputBound_mem_FP : + machineMatrixNormalizeInputBound ∈ Complexity.FP := by + simpa only [machineMatrixNormalizeInputBound] using + machineCompose_mem_FP machineMatrixNormalizePadTwenty_mem_FP + machineBinaryMulWidth_mem_FP + +theorem machineMatrixNormalizeRemaining_mem_FP : + machineMatrixNormalizeRemaining ∈ Complexity.FP := + machinePairFirst_mem_FP + +theorem machineMatrixNormalizeAccumulator_mem_FP : + machineMatrixNormalizeAccumulator ∈ Complexity.FP := by + simpa only [machineMatrixNormalizeAccumulator] using + machineCompose_mem_FP machinePairSecond_mem_FP machinePairFirst_mem_FP + +theorem machineMatrixNormalizeScale_mem_FP : + machineMatrixNormalizeScale ∈ Complexity.FP := by + have htail := machineCompose_mem_FP machinePairSecond_mem_FP + machinePairSecond_mem_FP + simpa only [machineMatrixNormalizeScale] using + machineCompose_mem_FP htail machinePairFirst_mem_FP + +theorem machineMatrixNormalizeDimension_mem_FP : + machineMatrixNormalizeDimension ∈ Complexity.FP := by + have htailTwo := machineCompose_mem_FP machinePairSecond_mem_FP + machinePairSecond_mem_FP + have htailThree := machineCompose_mem_FP htailTwo machinePairSecond_mem_FP + simpa only [machineMatrixNormalizeDimension] using + machineCompose_mem_FP htailThree machinePairFirst_mem_FP + +theorem machineMatrixNormalizeBound_mem_FP : + machineMatrixNormalizeBound ∈ Complexity.FP := by + have htailTwo := machineCompose_mem_FP machinePairSecond_mem_FP + machinePairSecond_mem_FP + have htailThree := machineCompose_mem_FP htailTwo machinePairSecond_mem_FP + simpa only [machineMatrixNormalizeBound] using + machineCompose_mem_FP htailThree machinePairSecond_mem_FP + +theorem machineMatrixNormalizeCurrentRow_mem_FP : + machineMatrixNormalizeCurrentRow ∈ Complexity.FP := by + simpa only [machineMatrixNormalizeCurrentRow] using + machineCompose_mem_FP machineMatrixNormalizeRemaining_mem_FP + machineListHead_mem_FP + +theorem machineMatrixNormalizeOutputRow_mem_FP : + machineMatrixNormalizeOutputRow ∈ Complexity.FP := by + have hinput := machinePair_mem_FP machineMatrixNormalizeScale_mem_FP + machineMatrixNormalizeCurrentRow_mem_FP + simpa only [machineMatrixNormalizeOutputRow] using + machineCompose_mem_FP hinput machineRationalRowDivide_mem_FP + +theorem machineMatrixNormalizeCandidate_mem_FP : + machineMatrixNormalizeCandidate ∈ Complexity.FP := + machinePair_mem_FP machineMatrixNormalizeOutputRow_mem_FP + machineMatrixNormalizeAccumulator_mem_FP + +theorem machineMatrixNormalizeNextAccumulator_mem_FP : + machineMatrixNormalizeNextAccumulator ∈ Complexity.FP := by + simpa only [machineMatrixNormalizeNextAccumulator] using + machineTake_mem_FP machineMatrixNormalizeBound_mem_FP + machineMatrixNormalizeCandidate_mem_FP + +theorem machineMatrixNormalizeAdvance_mem_FP : + machineMatrixNormalizeAdvance ∈ Complexity.FP := by + have htail := machineCompose_mem_FP machineMatrixNormalizeRemaining_mem_FP + machineListTail_mem_FP + exact machinePair_mem_FP htail + (machinePair_mem_FP machineMatrixNormalizeNextAccumulator_mem_FP + (machinePair_mem_FP machineMatrixNormalizeScale_mem_FP + (machinePair_mem_FP machineMatrixNormalizeDimension_mem_FP + machineMatrixNormalizeBound_mem_FP))) + +theorem machineMatrixNormalizeStep_mem_FP : + machineMatrixNormalizeStep ∈ Complexity.FP := by + exact machineIfEmpty_mem_FP machineMatrixNormalizeRemaining_mem_FP + id_mem_FP machineMatrixNormalizeAdvance_mem_FP + +theorem machineMatrixNormalizeInit_mem_FP : + machineMatrixNormalizeInit ∈ Complexity.FP := by + exact machinePair_mem_FP machineMatrixRowsWord_mem_FP + (machinePair_mem_FP (machineConst_mem_FP []) + (machinePair_mem_FP machineMatrixNormalizationScaleRawCode_mem_FP + (machinePair_mem_FP machineMatrixDimensionWord_mem_FP + machineMatrixNormalizeInputBound_mem_FP))) + +theorem machineMatrixNormalizeWidth_mem_FP : + machineMatrixNormalizeWidth ∈ Complexity.FP := by + exact machinePair_mem_FP id_mem_FP + (machinePair_mem_FP machineMatrixNormalizeInputBound_mem_FP + (machinePair_mem_FP machineMatrixNormalizationScaleRawCode_mem_FP + (machinePair_mem_FP id_mem_FP + machineMatrixNormalizeInputBound_mem_FP))) + +@[simp] theorem machineMatrixNormalizeRemaining_pack (a b c d e) : + machineMatrixNormalizeRemaining + (machineMatrixNormalizePack a b c d e) = a := by + simp [machineMatrixNormalizeRemaining, machineMatrixNormalizePack] + +@[simp] theorem machineMatrixNormalizeAccumulator_pack (a b c d e) : + machineMatrixNormalizeAccumulator + (machineMatrixNormalizePack a b c d e) = b := by + simp [machineMatrixNormalizeAccumulator, machineMatrixNormalizePack] + +@[simp] theorem machineMatrixNormalizeScale_pack (a b c d e) : + machineMatrixNormalizeScale + (machineMatrixNormalizePack a b c d e) = c := by + simp [machineMatrixNormalizeScale, machineMatrixNormalizePack] + +@[simp] theorem machineMatrixNormalizeDimension_pack (a b c d e) : + machineMatrixNormalizeDimension + (machineMatrixNormalizePack a b c d e) = d := by + simp [machineMatrixNormalizeDimension, machineMatrixNormalizePack] + +@[simp] theorem machineMatrixNormalizeBound_pack (a b c d e) : + machineMatrixNormalizeBound + (machineMatrixNormalizePack a b c d e) = e := by + simp [machineMatrixNormalizeBound, machineMatrixNormalizePack] + +def MachineMatrixNormalizeStateBound (word state : List Bool) : Prop := + state = machineMatrixNormalizePack + (machineMatrixNormalizeRemaining state) + (machineMatrixNormalizeAccumulator state) + (machineMatrixNormalizeScale state) + (machineMatrixNormalizeDimension state) + (machineMatrixNormalizeBound state) ∧ + (machineMatrixNormalizeRemaining state).length ≤ word.length ∧ + (machineMatrixNormalizeAccumulator state).length ≤ + (machineMatrixNormalizeInputBound word).length ∧ + machineMatrixNormalizeScale state = + machineMatrixNormalizationScaleRawCode word ∧ + (machineMatrixNormalizeDimension state).length ≤ word.length ∧ + machineMatrixNormalizeBound state = machineMatrixNormalizeInputBound word + +theorem machineMatrixNormalizeInit_bound (word : List Bool) : + MachineMatrixNormalizeStateBound word (machineMatrixNormalizeInit word) := by + simp only [MachineMatrixNormalizeStateBound, machineMatrixNormalizeInit, + machineMatrixNormalizeRemaining_pack, + machineMatrixNormalizeAccumulator_pack, + machineMatrixNormalizeScale_pack, + machineMatrixNormalizeDimension_pack, + machineMatrixNormalizeBound_pack] + refine ⟨trivial, ?_, by simp, trivial, ?_, trivial⟩ + · simpa only [machineMatrixRowsWord] using machinePairSecond_length_le word + · simpa only [machineMatrixDimensionWord] using + machinePairFirst_length_le word + +theorem machineMatrixNormalizeStep_bound {word state : List Bool} + (hstate : MachineMatrixNormalizeStateBound word state) : + MachineMatrixNormalizeStateBound word + (machineMatrixNormalizeStep state) := by + rcases hstate with + ⟨hdecomp, hremaining, haccumulator, hscale, hdimension, hbound⟩ + by_cases hnil : machineMatrixNormalizeRemaining state = [] + · rw [machineMatrixNormalizeStep, hnil, machineIfEmpty_nil] + exact ⟨hdecomp, hremaining, haccumulator, hscale, hdimension, hbound⟩ + · rw [machineMatrixNormalizeStep] + cases hremainingCode : machineMatrixNormalizeRemaining state with + | nil => exact False.elim (hnil hremainingCode) + | cons bit tail => + rw [machineIfEmpty_cons, machineMatrixNormalizeAdvance] + simp only [MachineMatrixNormalizeStateBound, + machineMatrixNormalizeRemaining_pack, + machineMatrixNormalizeAccumulator_pack, + machineMatrixNormalizeScale_pack, + machineMatrixNormalizeDimension_pack, + machineMatrixNormalizeBound_pack] + refine ⟨trivial, ?_, ?_, hscale, hdimension, hbound⟩ + · exact (machineListTail_length_le + (machineMatrixNormalizeRemaining state)).trans hremaining + · rw [machineMatrixNormalizeNextAccumulator, hbound] + exact List.length_take_le _ _ + +theorem machineMatrixNormalizeIterate_bound (word : List Bool) : ∀ k, + MachineMatrixNormalizeStateBound word + ((machineMatrixNormalizeStep)^[k] + (machineMatrixNormalizeInit word)) := by + intro k + induction k with + | zero => exact machineMatrixNormalizeInit_bound word + | succ k ih => + rw [Function.iterate_succ_apply'] + exact machineMatrixNormalizeStep_bound ih + +theorem machineMatrixNormalizeIterate_length_le_width + (word : List Bool) (iterations : ℕ) (_ : iterations ≤ word.length) : + ((machineMatrixNormalizeStep)^[iterations] + (machineMatrixNormalizeInit word)).length ≤ + (machineMatrixNormalizeWidth word).length := by + rcases machineMatrixNormalizeIterate_bound word iterations with + ⟨hdecomp, hremaining, haccumulator, hscale, hdimension, hbound⟩ + rw [hdecomp, hscale, hbound] + simp only [machineMatrixNormalizePack, machineMatrixNormalizeWidth, + pair_length] + omega + +theorem machineMatrixNormalizeFinalState_mem_FP : + machineMatrixNormalizeFinalState ∈ Complexity.FP := by + exact Cobham.iterate_mem_FP machineMatrixNormalizeStep_mem_FP + machineMatrixNormalizeInit_mem_FP id_mem_FP + machineMatrixNormalizeWidth_mem_FP + machineMatrixNormalizeIterate_length_le_width + +theorem machineMatrixNormalizeEntries_mem_FP : + machineMatrixNormalizeEntries ∈ Complexity.FP := by + have hdimension := machineCompose_mem_FP + machineMatrixNormalizeFinalState_mem_FP + machineMatrixNormalizeDimension_mem_FP + have hacc := machineCompose_mem_FP + machineMatrixNormalizeFinalState_mem_FP + machineMatrixNormalizeAccumulator_mem_FP + have hrows := machineCompose_mem_FP hacc machineListReverse_mem_FP + simpa only [machineMatrixNormalizeEntries] using + machinePair_mem_FP hdimension hrows + +/-! ## Output-size bound on canonical matrices -/ + +private theorem matrixNormalize_natList_sum_le_length_mul + {values : List ℕ} {bound : ℕ} + (h : ∀ value ∈ values, value ≤ bound) : + values.sum ≤ values.length * bound := by + induction values with + | nil => simp + | cons value values ih => + simp only [List.sum_cons, List.length_cons] + have hvalue := h value (by simp) + have htail : ∀ x ∈ values, x ≤ bound := by + intro x hx + exact h x (by simp [hx]) + have hi := ih htail + calc + value + values.sum ≤ bound + values.length * bound := + Nat.add_le_add hvalue hi + _ = (values.length + 1) * bound := by ring + +private theorem matrixNonnegativeRowsWork_eq_length_add_entries : + ∀ rows : List (List ℚ), + matrixNonnegativeRowsWork rows = + rows.length + (rows.map List.length).sum := by + intro rows + induction rows with + | nil => simp [matrixNonnegativeRowsWork] + | cons row rows ih => + simp [matrixNonnegativeRowsWork, ih] + omega + +private theorem matrixNormalize_outputCode_length_le + (scale : RawRat) (budget : ℕ) : ∀ rows : List (List ℚ), + (∀ row ∈ rows, ∀ q ∈ row, + (rationalEntryBinaryCode + (binaryNormalizeRawRat ((rawRatOfRat q).div scale))).length ≤ + 172 + 72 * budget) → + (binaryListCode (binaryListCode rationalEntryBinaryCode) + (rows.map (rationalRowDivideValues scale))).length ≤ + (rows.map List.length).sum * (692 + 288 * budget) + + 2 * rows.length := by + intro rows hentry + induction rows with + | nil => simp [binaryListCode] + | cons row rows ih => + have hrowEntry : ∀ q ∈ row, + (rationalEntryBinaryCode + (binaryNormalizeRawRat ((rawRatOfRat q).div scale))).length ≤ + 172 + 72 * budget := by + intro q hq + exact hentry row (by simp) q hq + have htailEntry : ∀ tailRow ∈ rows, ∀ q ∈ tailRow, + (rationalEntryBinaryCode + (binaryNormalizeRawRat ((rawRatOfRat q).div scale))).length ≤ + 172 + 72 * budget := by + intro tailRow htailRow q hq + exact hentry tailRow (by simp [htailRow]) q hq + have hinner : + (binaryListCode rationalEntryBinaryCode + (rationalRowDivideValues scale row)).length ≤ + row.length * (346 + 144 * budget) := by + rw [binaryListCode_length_eq_sum] + have hterm : ∀ value ∈ + ((rationalRowDivideValues scale row).map + fun q ↦ 2 * (rationalEntryBinaryCode q).length + 2), + value ≤ 346 + 144 * budget := by + simp only [rationalRowDivideValues, List.map_map] + intro value hvalue + rw [List.mem_map] at hvalue + rcases hvalue with ⟨q, hq, rfl⟩ + have hqBound := hrowEntry q hq + simp only [Function.comp_apply] + omega + have hsum := matrixNormalize_natList_sum_le_length_mul hterm + simpa only [rationalRowDivideValues, List.length_map] using hsum + have htail := ih htailEntry + simp only [List.map_cons, binaryListCode, pair_length, + List.map_map, List.sum_cons, List.length_cons] at htail ⊢ + nlinarith + +theorem machineMatrixNormalize_outputRows_length_le_bound {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) : + let word := rationalMatrixBinaryEncoding.encode ⟨n, A⟩ + let scale := RawRat.one.add + (rawRatRowsSum RawRat.zero (rationalMatrixRows A)) + let output := (rationalMatrixRows A).map + (rationalRowDivideValues scale) + (binaryListCode (binaryListCode rationalEntryBinaryCode) output).length ≤ + (machineMatrixNormalizeInputBound word).length := by + dsimp only + let word := rationalMatrixBinaryEncoding.encode ⟨n, A⟩ + let rows := rationalMatrixRows A + let scale := RawRat.one.add (rawRatRowsSum RawRat.zero rows) + have hrowsCode : + (binaryListCode (binaryListCode rationalEntryBinaryCode) rows).length ≤ + word.length := by + calc + _ = (machineMatrixRowsWord word).length := by + simpa only [word, rows] using congrArg List.length + (machineMatrixRowsWord_encode A).symm + _ ≤ word.length := by + simpa only [machineMatrixRowsWord] using + machinePairSecond_length_le word + have hcost : rawRatRowsCost rows ≤ word.length := + (rawRatRowsCost_le_codeLength rows).trans hrowsCode + have hsumWidth : + rawRatWidth (rawRatRowsSum RawRat.zero rows) ≤ 1 + word.length := by + have h := rawRatWidth_rowsSum_le RawRat.zero rows + simpa only [rawRatWidth_zero] using h.trans + (Nat.add_le_add_left hcost 1) + have hscaleWidth : rawRatWidth scale ≤ word.length + 3 := by + have h := rawRatWidth_add_le RawRat.one + (rawRatRowsSum RawRat.zero rows) + simp only [rawRatWidth_one] at h + have hraw : + rawRatWidth + (RawRat.one.add (rawRatRowsSum RawRat.zero rows)) ≤ + word.length + 3 := by + omega + simpa only [scale] using hraw + have hentry : ∀ row ∈ rows, ∀ q ∈ row, + (rationalEntryBinaryCode + (binaryNormalizeRawRat ((rawRatOfRat q).div scale))).length ≤ + 172 + 72 * word.length := by + intro row hrow q hq + have hqCode := binaryListCode_element_length_le + rationalEntryBinaryCode hq + have hrowCode := binaryListCode_element_length_le + (binaryListCode rationalEntryBinaryCode) hrow + have hqWidth : rawRatWidth (rawRatOfRat q) ≤ word.length := by + have hentryCode : + (rawRatBinaryCode (rawRatOfRat q)).length ≤ word.length := by + rw [rawRatBinaryCode_rawRatOfRat] + exact hqCode.trans (hrowCode.trans hrowsCode) + exact (rawRatWidth_le_binaryCode_length (rawRatOfRat q)).trans + hentryCode + have hdiv := rawRatWidth_div_le (rawRatOfRat q) scale + have hnormalize := + rationalEntryBinaryCode_binaryNormalizeRawRat_length_le + ((rawRatOfRat q).div scale) + omega + have houtput := matrixNormalize_outputCode_length_le + scale word.length rows hentry + have hwork : matrixNonnegativeRowsWork rows ≤ word.length := + (binaryListCode_length_ge_work rows).trans hrowsCode + rw [matrixNonnegativeRowsWork_eq_length_add_entries] at hwork + have hquadratic : + (rows.map List.length).sum * (692 + 288 * word.length) + + 2 * rows.length ≤ + (machineMatrixNormalizeInputBound word).length := by + rw [machineMatrixNormalizeInputBound] + simp only [machineBinaryMulWidth, List.length_replicate, + List.length_append] + rw [machineMatrixNormalizePadTwenty_length] + have hcombined : + (rows.map List.length).sum * (692 + 288 * word.length) + + 2 * rows.length ≤ + (rows.length + (rows.map List.length).sum) * + (694 + 288 * word.length) := by + have hentries := Nat.mul_le_mul_left + (rows.map List.length).sum + (show 692 + 288 * word.length ≤ 694 + 288 * word.length by omega) + have hrows := Nat.mul_le_mul_left rows.length + (show 2 ≤ 694 + 288 * word.length by omega) + calc + (rows.map List.length).sum * (692 + 288 * word.length) + + 2 * rows.length ≤ + (rows.map List.length).sum * (694 + 288 * word.length) + + rows.length * (694 + 288 * word.length) := by + exact Nat.add_le_add hentries (by simpa [Nat.mul_comm] using hrows) + _ = (rows.length + (rows.map List.length).sum) * + (694 + 288 * word.length) := by ring + have hlinear := Nat.mul_le_mul_right (694 + 288 * word.length) hwork + have hsquare : + word.length * (694 + 288 * word.length) ≤ + (16 + 20 * word.length) * (16 + 20 * word.length) := by + cases hword : word.length with + | zero => simp + | succ length => + have hsquareDominates : length + 1 ≤ (length + 1) * (length + 1) := by + nlinarith + nlinarith + exact hcombined.trans (hlinear.trans hsquare) + exact houtput.trans hquadratic + +/-! ## Exact semantics -/ + +def rationalMatrixDivideRows (scale : RawRat) + (rows : List (List ℚ)) : List (List ℚ) := + rows.map (rationalRowDivideValues scale) + +def machineMatrixNormalizeSemanticState + (word dimension : List Bool) (scale : RawRat) + (rows : List (List ℚ)) (k : ℕ) : List Bool := + let output := rationalMatrixDivideRows scale rows + machineMatrixNormalizePack + (binaryListCode (binaryListCode rationalEntryBinaryCode) (rows.drop k)) + (binaryListCode (binaryListCode rationalEntryBinaryCode) + (output.take k).reverse) + (rawRatBinaryCode scale) dimension + (machineMatrixNormalizeInputBound word) + +theorem machineMatrixNormalizeInit_encode {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) : + let word := rationalMatrixBinaryEncoding.encode ⟨n, A⟩ + let scale := RawRat.one.add + (rawRatRowsSum RawRat.zero (rationalMatrixRows A)) + machineMatrixNormalizeInit word = + machineMatrixNormalizeSemanticState word n.bits scale + (rationalMatrixRows A) 0 := by + dsimp only + rw [machineMatrixNormalizeInit] + simp only [machineMatrixRowsWord_encode, + machineMatrixNormalizationScaleRawCode_encode, + machineMatrixDimensionWord_encode, + machineMatrixNormalizeSemanticState, List.drop_zero, + List.take_zero, List.reverse_nil, binaryListCode] + +theorem machineMatrixNormalizeOutputRow_semantics + (word dimension : List Bool) (scale : RawRat) + (rows : List (List ℚ)) (k : ℕ) (hk : k < rows.length) : + machineMatrixNormalizeOutputRow + (machineMatrixNormalizeSemanticState word dimension scale rows k) = + binaryListCode rationalEntryBinaryCode + (rationalRowDivideValues scale rows[k]) := by + have hdrop := List.drop_eq_getElem_cons hk + rw [machineMatrixNormalizeOutputRow] + simp only [machineMatrixNormalizeSemanticState, + machineMatrixNormalizeScale_pack, + machineMatrixNormalizeCurrentRow, + machineMatrixNormalizeRemaining_pack, hdrop, + machineListHead_cons] + change machineRationalRowDivide + (machineRationalRowDivideCanonicalInput scale rows[k]) = _ + exact machineRationalRowDivide_encode scale rows[k] + +theorem machineMatrixNormalizeStep_semantics + (word dimension : List Bool) (scale : RawRat) + (rows : List (List ℚ)) (k : ℕ) (hk : k < rows.length) + (hfullBound : + (binaryListCode (binaryListCode rationalEntryBinaryCode) + (rationalMatrixDivideRows scale rows)).length ≤ + (machineMatrixNormalizeInputBound word).length) : + machineMatrixNormalizeStep + (machineMatrixNormalizeSemanticState word dimension scale rows k) = + machineMatrixNormalizeSemanticState word dimension scale rows (k + 1) := by + let output := rationalMatrixDivideRows scale rows + have houtputLength : output.length = rows.length := by + simp [output, rationalMatrixDivideRows] + have hkoutput : k < output.length := by omega + have houtputGet : output[k] = + rationalRowDivideValues scale rows[k] := by + simp [output, rationalMatrixDivideRows, List.getElem_map] + have hdrop := List.drop_eq_getElem_cons hk + have htake := List.take_concat_get hkoutput + have hprefix : (output.take (k + 1)).reverse = + output[k] :: (output.take k).reverse := by + rw [← htake] + simpa only [List.concat_eq_append] using + (List.reverse_concat (l := output.take k) (a := output[k])) + have hprefixLength : + (binaryListCode (binaryListCode rationalEntryBinaryCode) + (output.take (k + 1)).reverse).length ≤ + (machineMatrixNormalizeInputBound word).length := + (binaryListCode_take_reverse_length_le + (binaryListCode rationalEntryBinaryCode) output (k + 1)).trans + (by simpa only [output] using hfullBound) + have htakeBound : + (binaryListCode (binaryListCode rationalEntryBinaryCode) + (output.take (k + 1)).reverse).take + (machineMatrixNormalizeInputBound word).length = + binaryListCode (binaryListCode rationalEntryBinaryCode) + (output.take (k + 1)).reverse := + List.take_of_length_le hprefixLength + have hnonempty : + binaryListCode (binaryListCode rationalEntryBinaryCode) + (rows.drop k) ≠ [] := by + rw [hdrop] + exact binaryListCode_cons_ne_nil _ _ _ + rw [machineMatrixNormalizeStep] + simp only [machineMatrixNormalizeSemanticState, + machineMatrixNormalizeRemaining_pack] + rw [machineIfEmpty_of_ne_nil _ _ _ hnonempty, + machineMatrixNormalizeAdvance] + simp only [machineMatrixNormalizeRemaining_pack, + machineMatrixNormalizeAccumulator_pack, + machineMatrixNormalizeScale_pack, + machineMatrixNormalizeDimension_pack, + machineMatrixNormalizeBound_pack, + machineMatrixNormalizeNextAccumulator, + machineMatrixNormalizeCandidate] + have hrow : + machineMatrixNormalizeOutputRow + (machineMatrixNormalizePack + (binaryListCode (binaryListCode rationalEntryBinaryCode) + (rows.drop k)) + (binaryListCode (binaryListCode rationalEntryBinaryCode) + (output.take k).reverse) + (rawRatBinaryCode scale) dimension + (machineMatrixNormalizeInputBound word)) = + binaryListCode rationalEntryBinaryCode output[k] := by + rw [houtputGet] + simpa only [machineMatrixNormalizeSemanticState, output] using + machineMatrixNormalizeOutputRow_semantics + word dimension scale rows k hk + rw [hrow, hdrop, machineListTail_cons] + change machineMatrixNormalizePack + (binaryListCode (binaryListCode rationalEntryBinaryCode) + (rows.drop (k + 1))) + ((binaryListCode (binaryListCode rationalEntryBinaryCode) + (output[k] :: (output.take k).reverse)).take + (machineMatrixNormalizeInputBound word).length) + (rawRatBinaryCode scale) dimension + (machineMatrixNormalizeInputBound word) = _ + rw [← hprefix, htakeBound] + +theorem machineMatrixNormalizeIterate_semantics + (word dimension : List Bool) (scale : RawRat) + (rows : List (List ℚ)) + (hfullBound : + (binaryListCode (binaryListCode rationalEntryBinaryCode) + (rationalMatrixDivideRows scale rows)).length ≤ + (machineMatrixNormalizeInputBound word).length) : ∀ k ≤ rows.length, + (machineMatrixNormalizeStep)^[k] + (machineMatrixNormalizeSemanticState word dimension scale rows 0) = + machineMatrixNormalizeSemanticState word dimension scale rows k := by + intro k hk + induction k with + | zero => rfl + | succ k ih => + rw [Function.iterate_succ_apply', ih (by omega)] + exact machineMatrixNormalizeStep_semantics word dimension scale rows k + (by omega) hfullBound + +theorem machineMatrixNormalize_done_iterate + (extra : ℕ) (accumulator scale dimension bound : List Bool) : + (machineMatrixNormalizeStep)^[extra] + (machineMatrixNormalizePack [] accumulator scale dimension bound) = + machineMatrixNormalizePack [] accumulator scale dimension bound := by + induction extra with + | zero => rfl + | succ k ih => + rw [Function.iterate_succ_apply', ih] + simp [machineMatrixNormalizeStep] + +theorem machineMatrixNormalizeFinalState_encode {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) : + let word := rationalMatrixBinaryEncoding.encode ⟨n, A⟩ + let rows := rationalMatrixRows A + let scale := RawRat.one.add (rawRatRowsSum RawRat.zero rows) + machineMatrixNormalizeFinalState word = + machineMatrixNormalizePack [] + (binaryListCode (binaryListCode rationalEntryBinaryCode) + (rationalMatrixDivideRows scale rows).reverse) + (rawRatBinaryCode scale) n.bits + (machineMatrixNormalizeInputBound word) := by + dsimp only + let word := rationalMatrixBinaryEncoding.encode ⟨n, A⟩ + let rows := rationalMatrixRows A + let scale := RawRat.one.add (rawRatRowsSum RawRat.zero rows) + have hrowsLength : rows.length ≤ word.length := by + simpa only [rows, word, rationalMatrixRows, List.length_ofFn] using + matrix_dimension_le_code_length A + have hfullBound : + (binaryListCode (binaryListCode rationalEntryBinaryCode) + (rationalMatrixDivideRows scale rows)).length ≤ + (machineMatrixNormalizeInputBound word).length := by + simpa only [word, rows, scale, rationalMatrixDivideRows] using + machineMatrixNormalize_outputRows_length_le_bound A + have hsplit : word.length = + (word.length - rows.length) + rows.length := by omega + have htakeAll : + (rationalMatrixDivideRows scale rows).take rows.length = + rationalMatrixDivideRows scale rows := by + have hlength : (rationalMatrixDivideRows scale rows).length = + rows.length := by simp [rationalMatrixDivideRows] + rw [← hlength, List.take_length] + change (machineMatrixNormalizeStep)^[word.length] + (machineMatrixNormalizeInit word) = _ + rw [hsplit, Function.iterate_add_apply, + machineMatrixNormalizeInit_encode A, + machineMatrixNormalizeIterate_semantics word n.bits scale rows + hfullBound rows.length le_rfl] + simp only [machineMatrixNormalizeSemanticState, List.drop_length, + binaryListCode] + rw [htakeAll, machineMatrixNormalize_done_iterate] + +theorem rationalMatrixDivideRows_normalized {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) : + let rows := rationalMatrixRows A + let scale := RawRat.one.add (rawRatRowsSum RawRat.zero rows) + rationalMatrixDivideRows scale rows = + rationalMatrixRows (normalizedRationalMatrix A) := by + dsimp only + have hscale : + (RawRat.one.add + (rawRatRowsSum RawRat.zero (rationalMatrixRows A))).value = + rationalNormalizationScale A := by + rw [RawRat.value_add, RawRat.value_one, rawRatRowsSum_value, + RawRat.value_zero, zero_add, rationalMatrixRows_sum] + rfl + have hscaleRows := hscale + simp only [rationalMatrixRows] at hscaleRows + apply List.ext_get + · simp [rationalMatrixDivideRows, rationalMatrixRows] + · intro i hi hi' + apply List.ext_get + · simp [rationalMatrixDivideRows, rationalRowDivideValues, + rationalMatrixRows] + · intro j hj hj' + simp [rationalMatrixDivideRows, rationalRowDivideValues, + rationalMatrixRows, normalizedRationalMatrix, + binaryNormalizeRawRat_eq_value, RawRat.value_div, + rawRatOfRat_value, hscaleRows] + +@[simp] theorem machineMatrixNormalizeEntries_encode {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) : + machineMatrixNormalizeEntries + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩) = + rationalMatrixBinaryEncoding.encode + ⟨n, normalizedRationalMatrix A⟩ := by + let rows := rationalMatrixRows A + let scale := RawRat.one.add (rawRatRowsSum RawRat.zero rows) + rw [machineMatrixNormalizeEntries, + machineMatrixNormalizeFinalState_encode A] + simp only [machineMatrixNormalizeDimension_pack, + machineMatrixNormalizeAccumulator_pack, + machineListReverse_encode, List.reverse_reverse] + rw [rationalMatrixDivideRows_normalized A] + rfl + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineMatrixSum.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineMatrixSum.lean new file mode 100644 index 0000000000..fa3fcd345b --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineMatrixSum.lean @@ -0,0 +1,747 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineMatrixNonnegative + +/-! +# Polynomial-time row-major rational matrix sum + +The normalization scale starts with the sum of all matrix entries. We scan +the canonical nested row code and accumulate an unreduced fraction. A +quadratic clamp gives a global state envelope on malformed strings. The +semantic width invariant below proves that the clamp is inactive on every +canonical matrix input. +-/ + +namespace BeyondBethe + +open Complexity + +def machineMatrixRawSumPack + (rows current acc bound : List Bool) : List Bool := + pair rows (pair current (pair acc bound)) + +def machineMatrixRawSumRows (state : List Bool) : List Bool := + machinePairFirst state + +def machineMatrixRawSumCurrent (state : List Bool) : List Bool := + machinePairFirst (machinePairSecond state) + +def machineMatrixRawSumAcc (state : List Bool) : List Bool := + machinePairFirst (machinePairSecond (machinePairSecond state)) + +def machineMatrixRawSumBound (state : List Bool) : List Bool := + machinePairSecond (machinePairSecond (machinePairSecond state)) + +def machineMatrixRawSumEntry (state : List Bool) : List Bool := + machineListHead (machineMatrixRawSumCurrent state) + +def machineMatrixRawSumCandidate (state : List Bool) : List Bool := + machineRawRatAddCode + (pair (machineMatrixRawSumAcc state) + (machineMatrixRawSumEntry state)) + +def machineMatrixRawSumNextAcc (state : List Bool) : List Bool := + (machineMatrixRawSumCandidate state).take + (machineMatrixRawSumBound state).length + +def machineMatrixRawSumProcessEntry (state : List Bool) : List Bool := + machineMatrixRawSumPack + (machineMatrixRawSumRows state) + (machineListTail (machineMatrixRawSumCurrent state)) + (machineMatrixRawSumNextAcc state) + (machineMatrixRawSumBound state) + +def machineMatrixRawSumLoadRow (state : List Bool) : List Bool := + machineMatrixRawSumPack + (machineListTail (machineMatrixRawSumRows state)) + (machineListHead (machineMatrixRawSumRows state)) + (machineMatrixRawSumAcc state) + (machineMatrixRawSumBound state) + +def machineMatrixRawSumAfterRow (state : List Bool) : List Bool := + machineIfEmpty (machineMatrixRawSumRows state) state + (machineMatrixRawSumLoadRow state) + +def machineMatrixRawSumStep (state : List Bool) : List Bool := + machineIfEmpty (machineMatrixRawSumCurrent state) + (machineMatrixRawSumAfterRow state) + (machineMatrixRawSumProcessEntry state) + +/-- A quadratic word used both as an accumulator clamp and a state envelope. -/ +def machineMatrixRawSumInputBound (word : List Bool) : List Bool := + machineBinaryMulWidth word + +def machineMatrixRawSumInit (word : List Bool) : List Bool := + machineMatrixRawSumPack (machineMatrixRowsWord word) [] + (rawRatBinaryCode RawRat.zero) (machineMatrixRawSumInputBound word) + +def machineMatrixRawSumWidth (word : List Bool) : List Bool := + let bound := machineMatrixRawSumInputBound word + machineMatrixRawSumPack word word bound bound + +def machineMatrixRawSumFinalState (word : List Bool) : List Bool := + (machineMatrixRawSumStep)^[word.length] (machineMatrixRawSumInit word) + +def machineMatrixRawSumCode (word : List Bool) : List Bool := + machineMatrixRawSumAcc (machineMatrixRawSumFinalState word) + +def machineMatrixSumOutputCode (word : List Bool) : List Bool := + machineNormalizeRawRatBinaryCode (machineMatrixRawSumCode word) + +/-- Unreduced code of `1 + sum A`, the normalization scale used later. -/ +def machineMatrixNormalizationScaleRawCode (word : List Bool) : List Bool := + machineRawRatAddCode + (pair (rawRatBinaryCode RawRat.one) (machineMatrixRawSumCode word)) + +def machineMatrixNormalizationScaleOutputCode + (word : List Bool) : List Bool := + machineNormalizeRawRatBinaryCode + (machineMatrixNormalizationScaleRawCode word) + +theorem machineMatrixRawSumRows_mem_FP : + machineMatrixRawSumRows ∈ Complexity.FP := machinePairFirst_mem_FP + +theorem machineMatrixRawSumCurrent_mem_FP : + machineMatrixRawSumCurrent ∈ Complexity.FP := by + simpa only [machineMatrixRawSumCurrent] using + machineCompose_mem_FP machinePairSecond_mem_FP machinePairFirst_mem_FP + +theorem machineMatrixRawSumAcc_mem_FP : + machineMatrixRawSumAcc ∈ Complexity.FP := by + simpa only [machineMatrixRawSumAcc] using + machineCompose_mem_FP + (machineCompose_mem_FP machinePairSecond_mem_FP machinePairSecond_mem_FP) + machinePairFirst_mem_FP + +theorem machineMatrixRawSumBound_mem_FP : + machineMatrixRawSumBound ∈ Complexity.FP := by + simpa only [machineMatrixRawSumBound] using + machineCompose_mem_FP + (machineCompose_mem_FP machinePairSecond_mem_FP machinePairSecond_mem_FP) + machinePairSecond_mem_FP + +theorem machineMatrixRawSumEntry_mem_FP : + machineMatrixRawSumEntry ∈ Complexity.FP := by + simpa only [machineMatrixRawSumEntry] using + machineCompose_mem_FP machineMatrixRawSumCurrent_mem_FP + machineListHead_mem_FP + +theorem machineMatrixRawSumCandidate_mem_FP : + machineMatrixRawSumCandidate ∈ Complexity.FP := by + have hpair := machinePair_mem_FP machineMatrixRawSumAcc_mem_FP + machineMatrixRawSumEntry_mem_FP + simpa only [machineMatrixRawSumCandidate] using + machineCompose_mem_FP hpair machineRawRatAddCode_mem_FP + +theorem machineMatrixRawSumNextAcc_mem_FP : + machineMatrixRawSumNextAcc ∈ Complexity.FP := by + simpa only [machineMatrixRawSumNextAcc] using + machineTake_mem_FP machineMatrixRawSumBound_mem_FP + machineMatrixRawSumCandidate_mem_FP + +theorem machineMatrixRawSumProcessEntry_mem_FP : + machineMatrixRawSumProcessEntry ∈ Complexity.FP := by + have htail := machineCompose_mem_FP machineMatrixRawSumCurrent_mem_FP + machineListTail_mem_FP + exact machinePair_mem_FP machineMatrixRawSumRows_mem_FP + (machinePair_mem_FP htail + (machinePair_mem_FP machineMatrixRawSumNextAcc_mem_FP + machineMatrixRawSumBound_mem_FP)) + +theorem machineMatrixRawSumLoadRow_mem_FP : + machineMatrixRawSumLoadRow ∈ Complexity.FP := by + have htail := machineCompose_mem_FP machineMatrixRawSumRows_mem_FP + machineListTail_mem_FP + have hhead := machineCompose_mem_FP machineMatrixRawSumRows_mem_FP + machineListHead_mem_FP + exact machinePair_mem_FP htail + (machinePair_mem_FP hhead + (machinePair_mem_FP machineMatrixRawSumAcc_mem_FP + machineMatrixRawSumBound_mem_FP)) + +theorem machineMatrixRawSumAfterRow_mem_FP : + machineMatrixRawSumAfterRow ∈ Complexity.FP := by + exact machineIfEmpty_mem_FP machineMatrixRawSumRows_mem_FP id_mem_FP + machineMatrixRawSumLoadRow_mem_FP + +theorem machineMatrixRawSumStep_mem_FP : + machineMatrixRawSumStep ∈ Complexity.FP := by + exact machineIfEmpty_mem_FP machineMatrixRawSumCurrent_mem_FP + machineMatrixRawSumAfterRow_mem_FP machineMatrixRawSumProcessEntry_mem_FP + +theorem machineMatrixRawSumInputBound_mem_FP : + machineMatrixRawSumInputBound ∈ Complexity.FP := + machineBinaryMulWidth_mem_FP + +theorem machineMatrixRawSumInit_mem_FP : + machineMatrixRawSumInit ∈ Complexity.FP := by + exact machinePair_mem_FP machineMatrixRowsWord_mem_FP + (machinePair_mem_FP (machineConst_mem_FP []) + (machinePair_mem_FP (machineConst_mem_FP (rawRatBinaryCode RawRat.zero)) + machineMatrixRawSumInputBound_mem_FP)) + +theorem machineMatrixRawSumWidth_mem_FP : + machineMatrixRawSumWidth ∈ Complexity.FP := by + exact machinePair_mem_FP id_mem_FP + (machinePair_mem_FP id_mem_FP + (machinePair_mem_FP machineMatrixRawSumInputBound_mem_FP + machineMatrixRawSumInputBound_mem_FP)) + +@[simp] theorem machineMatrixRawSumRows_pack (rows current acc bound) : + machineMatrixRawSumRows + (machineMatrixRawSumPack rows current acc bound) = rows := by + simp [machineMatrixRawSumRows, machineMatrixRawSumPack] + +@[simp] theorem machineMatrixRawSumCurrent_pack (rows current acc bound) : + machineMatrixRawSumCurrent + (machineMatrixRawSumPack rows current acc bound) = current := by + simp [machineMatrixRawSumCurrent, machineMatrixRawSumPack] + +@[simp] theorem machineMatrixRawSumAcc_pack (rows current acc bound) : + machineMatrixRawSumAcc + (machineMatrixRawSumPack rows current acc bound) = acc := by + simp [machineMatrixRawSumAcc, machineMatrixRawSumPack] + +@[simp] theorem machineMatrixRawSumBound_pack (rows current acc bound) : + machineMatrixRawSumBound + (machineMatrixRawSumPack rows current acc bound) = bound := by + simp [machineMatrixRawSumBound, machineMatrixRawSumPack] + +def MachineMatrixRawSumStateBound (word state : List Bool) : Prop := + state = machineMatrixRawSumPack + (machineMatrixRawSumRows state) (machineMatrixRawSumCurrent state) + (machineMatrixRawSumAcc state) (machineMatrixRawSumBound state) ∧ + (machineMatrixRawSumRows state).length ≤ word.length ∧ + (machineMatrixRawSumCurrent state).length ≤ word.length ∧ + (machineMatrixRawSumAcc state).length ≤ + (machineMatrixRawSumInputBound word).length ∧ + machineMatrixRawSumBound state = machineMatrixRawSumInputBound word + +theorem machineMatrixRawSumInit_bound (word : List Bool) : + MachineMatrixRawSumStateBound word (machineMatrixRawSumInit word) := by + simp only [MachineMatrixRawSumStateBound, machineMatrixRawSumInit, + machineMatrixRawSumRows_pack, machineMatrixRawSumCurrent_pack, + machineMatrixRawSumAcc_pack, machineMatrixRawSumBound_pack] + refine ⟨trivial, ?_, by simp, ?_, trivial⟩ + · simpa only [machineMatrixRowsWord] using machinePairSecond_length_le word + · simp [machineMatrixRawSumInputBound, machineBinaryMulWidth, + rawRatBinaryCode, RawRat.zero, integerBinaryCode] + nlinarith [sq_nonneg (word.length + 16)] + +theorem machineMatrixRawSumStep_bound {word state : List Bool} + (hstate : MachineMatrixRawSumStateBound word state) : + MachineMatrixRawSumStateBound word (machineMatrixRawSumStep state) := by + rcases hstate with ⟨hdecomp, hrows, hcurrent, hacc, hbound⟩ + by_cases hc : machineMatrixRawSumCurrent state = [] + · rw [machineMatrixRawSumStep, hc, machineIfEmpty_nil] + by_cases hr : machineMatrixRawSumRows state = [] + · rw [machineMatrixRawSumAfterRow, hr, machineIfEmpty_nil] + exact ⟨hdecomp, hrows, hcurrent, hacc, hbound⟩ + · rw [machineMatrixRawSumAfterRow] + cases hrowsCode : machineMatrixRawSumRows state with + | nil => exact False.elim (hr hrowsCode) + | cons bit tail => + rw [machineIfEmpty_cons, machineMatrixRawSumLoadRow] + simp only [MachineMatrixRawSumStateBound, + machineMatrixRawSumRows_pack, machineMatrixRawSumCurrent_pack, + machineMatrixRawSumAcc_pack, machineMatrixRawSumBound_pack] + refine ⟨trivial, ?_, ?_, hacc, hbound⟩ + · exact (machinePairSecond_length_le + (machineMatrixRawSumRows state)).trans hrows + · exact (machinePairFirst_length_le + (machineMatrixRawSumRows state)).trans hrows + · rw [machineMatrixRawSumStep] + cases hcurrentCode : machineMatrixRawSumCurrent state with + | nil => exact False.elim (hc hcurrentCode) + | cons bit tail => + rw [machineIfEmpty_cons, machineMatrixRawSumProcessEntry] + simp only [MachineMatrixRawSumStateBound, + machineMatrixRawSumRows_pack, machineMatrixRawSumCurrent_pack, + machineMatrixRawSumAcc_pack, machineMatrixRawSumBound_pack] + refine ⟨trivial, hrows, ?_, ?_, hbound⟩ + · exact (machinePairSecond_length_le + (machineMatrixRawSumCurrent state)).trans hcurrent + · rw [machineMatrixRawSumNextAcc, hbound] + exact List.length_take_le _ _ + +theorem machineMatrixRawSumIterate_bound (word : List Bool) : ∀ k, + MachineMatrixRawSumStateBound word + ((machineMatrixRawSumStep)^[k] (machineMatrixRawSumInit word)) := by + intro k + induction k with + | zero => exact machineMatrixRawSumInit_bound word + | succ k ih => + rw [Function.iterate_succ_apply'] + exact machineMatrixRawSumStep_bound ih + +theorem machineMatrixRawSumIterate_length_le_width + (word : List Bool) (iterations : ℕ) (_ : iterations ≤ word.length) : + ((machineMatrixRawSumStep)^[iterations] + (machineMatrixRawSumInit word)).length ≤ + (machineMatrixRawSumWidth word).length := by + rcases machineMatrixRawSumIterate_bound word iterations with + ⟨hdecomp, hrows, hcurrent, hacc, hbound⟩ + rw [hdecomp, hbound] + simp only [machineMatrixRawSumPack, machineMatrixRawSumWidth, pair_length] + omega + +theorem machineMatrixRawSumFinalState_mem_FP : + machineMatrixRawSumFinalState ∈ Complexity.FP := by + exact Cobham.iterate_mem_FP machineMatrixRawSumStep_mem_FP + machineMatrixRawSumInit_mem_FP id_mem_FP machineMatrixRawSumWidth_mem_FP + machineMatrixRawSumIterate_length_le_width + +theorem machineMatrixRawSumCode_mem_FP : + machineMatrixRawSumCode ∈ Complexity.FP := by + simpa only [machineMatrixRawSumCode] using + machineCompose_mem_FP machineMatrixRawSumFinalState_mem_FP + machineMatrixRawSumAcc_mem_FP + +theorem machineMatrixSumOutputCode_mem_FP : + machineMatrixSumOutputCode ∈ Complexity.FP := by + simpa only [machineMatrixSumOutputCode] using + machineCompose_mem_FP machineMatrixRawSumCode_mem_FP + machineNormalizeRawRatBinaryCode_mem_FP + +theorem machineMatrixNormalizationScaleRawCode_mem_FP : + machineMatrixNormalizationScaleRawCode ∈ Complexity.FP := by + have hpair := machinePair_mem_FP + (machineConst_mem_FP (rawRatBinaryCode RawRat.one)) + machineMatrixRawSumCode_mem_FP + simpa only [machineMatrixNormalizationScaleRawCode] using + machineCompose_mem_FP hpair machineRawRatAddCode_mem_FP + +theorem machineMatrixNormalizationScaleOutputCode_mem_FP : + machineMatrixNormalizationScaleOutputCode ∈ Complexity.FP := by + simpa only [machineMatrixNormalizationScaleOutputCode] using + machineCompose_mem_FP machineMatrixNormalizationScaleRawCode_mem_FP + machineNormalizeRawRatBinaryCode_mem_FP + +/-! ## Semantic invariant and exactness -/ + +def rawRatListCost (xs : List ℚ) : ℕ := + (xs.map fun q => rawRatWidth (rawRatOfRat q) + 1).sum + +def rawRatRowsCost (rows : List (List ℚ)) : ℕ := + (rows.map rawRatListCost).sum + +def rawRatListSum : RawRat → List ℚ → RawRat + | acc, [] => acc + | acc, q :: qs => rawRatListSum (acc.add (rawRatOfRat q)) qs + +def rawRatRowsSum : RawRat → List (List ℚ) → RawRat + | acc, [] => acc + | acc, row :: rows => rawRatRowsSum (rawRatListSum acc row) rows + +theorem rawRatWidth_listSum_le (acc : RawRat) : ∀ xs : List ℚ, + rawRatWidth (rawRatListSum acc xs) ≤ rawRatWidth acc + rawRatListCost xs := by + intro xs + induction xs generalizing acc with + | nil => simp [rawRatListSum, rawRatListCost] + | cons q qs ih => + rw [rawRatListSum] + have hadd := rawRatWidth_add_le acc (rawRatOfRat q) + have htail := ih (acc.add (rawRatOfRat q)) + simp only [rawRatListCost, List.map_cons, List.sum_cons] at htail ⊢ + omega + +theorem rawRatWidth_rowsSum_le (acc : RawRat) : ∀ rows : List (List ℚ), + rawRatWidth (rawRatRowsSum acc rows) ≤ + rawRatWidth acc + rawRatRowsCost rows := by + intro rows + induction rows generalizing acc with + | nil => simp [rawRatRowsSum, rawRatRowsCost] + | cons row rows ih => + rw [rawRatRowsSum] + have hrow := rawRatWidth_listSum_le acc row + have htail := ih (rawRatListSum acc row) + simp only [rawRatRowsCost, List.map_cons, List.sum_cons] at htail ⊢ + omega + +theorem integerNatAbs_size_le_binaryCode_length (z : ℤ) : + z.natAbs.size ≤ (integerBinaryCode z).length := by + cases z with + | ofNat n => + simp [integerBinaryCode, Nat.size_eq_bits_len] + | negSucc n => + have hs : (n + 1).size ≤ n.size + 1 := by + rw [Nat.size_le] + have hle : n + 1 ≤ 2 ^ n.size := + Nat.succ_le_iff.mpr (Nat.lt_size_self n) + have hlt : 2 ^ n.size < 2 ^ (n.size + 1) := by + rw [pow_succ] + have hpos : 0 < 2 ^ n.size := by positivity + omega + exact hle.trans_lt hlt + simpa [integerBinaryCode, Nat.size_eq_bits_len, + Nat.add_comm] using hs + +theorem rawRatWidth_le_binaryCode_length (q : RawRat) : + rawRatWidth q ≤ (rawRatBinaryCode q).length := by + rw [rawRatWidth, rawRatBinaryCode, pair_length] + apply max_le + · have h := integerNatAbs_size_le_binaryCode_length q.num + omega + · rw [Nat.size_eq_bits_len] + omega + +theorem rawRatBinaryCode_length_le_width (q : RawRat) : + (rawRatBinaryCode q).length ≤ 4 + 3 * rawRatWidth q := by + rw [rawRatBinaryCode, pair_length] + have hnum : (integerBinaryCode q.num).length ≤ 1 + rawRatWidth q := by + cases hqnum : q.num with + | ofNat n => + simp only [integerBinaryCode, List.length_cons, + Nat.size_eq_bits_len] + have habs := rawRat_num_size_le_width q + simp only [hqnum, Int.natAbs_ofNat'] at habs + omega + | negSucc n => + simp only [integerBinaryCode, List.length_cons, + Nat.size_eq_bits_len] + have hsize : n.size ≤ (n + 1).size := + Nat.size_le_size (Nat.le_succ n) + have habs : (n + 1).size ≤ rawRatWidth q := by + simpa only [hqnum, Int.natAbs_negSucc] using + rawRat_num_size_le_width q + omega + have hden := rawRat_den_size_le_width q + have hdenBits : q.den.bits.length ≤ rawRatWidth q := by + rw [Nat.size_eq_bits_len] + exact hden + omega + +/-- The ordinary finite-word encoding of an explicitly normalized rational +has length linear in the width of the unreduced input. This is the bridge +between the exact `DataEncode` estimate used by the arithmetic analysis and +the concrete binary words carried by the machine implementation. -/ +theorem rationalEntryBinaryCode_binaryNormalizeRawRat_length_le + (q : RawRat) : + (rationalEntryBinaryCode (binaryNormalizeRawRat q)).length ≤ + 64 + 36 * rawRatWidth q := by + rw [← rawRatBinaryCode_rawRatOfRat] + have hcode := rawRatBinaryCode_length_le_width + (rawRatOfRat (binaryNormalizeRawRat q)) + have hwidth := rawRatOfRat_width_le_encodedBitLength + (binaryNormalizeRawRat q) + have hnormalize := binaryNormalizeRawRat_encodedBitLength_le q + omega + +theorem rawRatListCost_le_codeLength (xs : List ℚ) : + rawRatListCost xs ≤ (binaryListCode rationalEntryBinaryCode xs).length := by + induction xs with + | nil => simp [rawRatListCost, binaryListCode] + | cons q qs ih => + rw [rawRatListCost, List.map_cons, List.sum_cons, + binaryListCode, pair_length] + have ih' : (qs.map fun q => rawRatWidth (rawRatOfRat q) + 1).sum ≤ + (binaryListCode rationalEntryBinaryCode qs).length := by + simpa only [rawRatListCost] using ih + have hq : rawRatWidth (rawRatOfRat q) ≤ + (rationalEntryBinaryCode q).length := by + rw [← rawRatBinaryCode_rawRatOfRat] + exact rawRatWidth_le_binaryCode_length _ + omega + +theorem rawRatRowsCost_le_codeLength (rows : List (List ℚ)) : + rawRatRowsCost rows ≤ + (binaryListCode (binaryListCode rationalEntryBinaryCode) rows).length := by + induction rows with + | nil => simp [rawRatRowsCost, binaryListCode] + | cons row rows ih => + rw [rawRatRowsCost, List.map_cons, List.sum_cons, + binaryListCode, pair_length] + have ih' : (rows.map rawRatListCost).sum ≤ + (binaryListCode (binaryListCode rationalEntryBinaryCode) rows).length := by + simpa only [rawRatRowsCost] using ih + have hrow := rawRatListCost_le_codeLength row + omega + +structure MatrixRawSumSemState where + rows : List (List ℚ) + current : List ℚ + acc : RawRat + +def matrixRawSumSemStep (s : MatrixRawSumSemState) : MatrixRawSumSemState := + match s.current with + | q :: qs => ⟨s.rows, qs, s.acc.add (rawRatOfRat q)⟩ + | [] => + match s.rows with + | row :: rows => ⟨rows, row, s.acc⟩ + | [] => s + +def matrixRawSumSemCode (bound : List Bool) + (s : MatrixRawSumSemState) : List Bool := + machineMatrixRawSumPack + (binaryListCode (binaryListCode rationalEntryBinaryCode) s.rows) + (binaryListCode rationalEntryBinaryCode s.current) + (rawRatBinaryCode s.acc) bound + +def MatrixRawSumSemInvariant (budget : ℕ) + (s : MatrixRawSumSemState) : Prop := + rawRatWidth s.acc + rawRatListCost s.current + rawRatRowsCost s.rows ≤ budget + +theorem matrixRawSumSemStep_invariant {budget : ℕ} + {s : MatrixRawSumSemState} (hs : MatrixRawSumSemInvariant budget s) : + MatrixRawSumSemInvariant budget (matrixRawSumSemStep s) := by + rcases s with ⟨rows, current, acc⟩ + cases current with + | nil => + cases rows with + | nil => exact hs + | cons row rows => + simp [MatrixRawSumSemInvariant, matrixRawSumSemStep, + rawRatRowsCost, rawRatListCost] at hs ⊢ + omega + | cons q qs => + have hadd := rawRatWidth_add_le acc (rawRatOfRat q) + simp only [MatrixRawSumSemInvariant, matrixRawSumSemStep, + rawRatListCost, List.map_cons, List.sum_cons] at hs ⊢ + omega + +theorem matrixRawSumBound_large (word : List Bool) : + 4 + 3 * (1 + word.length) ≤ + (machineMatrixRawSumInputBound word).length := by + simp only [machineMatrixRawSumInputBound, machineBinaryMulWidth, + List.length_replicate, List.length_append] + nlinarith + +theorem machineMatrixRawSumStep_semantics + (word : List Bool) (s : MatrixRawSumSemState) + (hs : MatrixRawSumSemInvariant (1 + word.length) s) : + machineMatrixRawSumStep + (matrixRawSumSemCode (machineMatrixRawSumInputBound word) s) = + matrixRawSumSemCode (machineMatrixRawSumInputBound word) + (matrixRawSumSemStep s) := by + rcases s with ⟨rows, current, acc⟩ + cases current with + | nil => + cases rows with + | nil => + simp [matrixRawSumSemCode, matrixRawSumSemStep, + machineMatrixRawSumStep, machineMatrixRawSumAfterRow, + binaryListCode] + | cons row rows => + rw [matrixRawSumSemCode, matrixRawSumSemStep, + machineMatrixRawSumStep] + simp only [machineMatrixRawSumCurrent_pack, binaryListCode, + machineIfEmpty_nil, machineMatrixRawSumAfterRow, + machineMatrixRawSumRows_pack] + have hpair : pair (binaryListCode rationalEntryBinaryCode row) + (binaryListCode (binaryListCode rationalEntryBinaryCode) rows) ≠ [] := by + intro h + have hlen := congrArg List.length h + simp at hlen + rw [machineIfEmpty_of_ne_nil_matrix _ _ _ hpair] + simp [machineMatrixRawSumLoadRow, matrixRawSumSemCode, + machineListHead, machineListTail] + | cons q qs => + have hnext : rawRatWidth (acc.add (rawRatOfRat q)) ≤ 1 + word.length := by + have hinv := matrixRawSumSemStep_invariant hs + have hinv' : rawRatWidth (acc.add (rawRatOfRat q)) + + rawRatListCost qs + rawRatRowsCost rows ≤ 1 + word.length := by + simpa only [MatrixRawSumSemInvariant, matrixRawSumSemStep] using hinv + omega + have hcode : + (rawRatBinaryCode (acc.add (rawRatOfRat q))).length ≤ + (machineMatrixRawSumInputBound word).length := + (rawRatBinaryCode_length_le_width _).trans + ((Nat.add_le_add_left (Nat.mul_le_mul_left 3 hnext) 4).trans + (matrixRawSumBound_large word)) + rw [matrixRawSumSemCode, matrixRawSumSemStep, + machineMatrixRawSumStep] + simp only [machineMatrixRawSumCurrent_pack] + rw [machineIfEmpty_of_ne_nil_matrix _ _ _ + (binaryListCode_cons_ne_nil rationalEntryBinaryCode q qs)] + simp only [machineMatrixRawSumProcessEntry, + machineMatrixRawSumRows_pack, machineMatrixRawSumCurrent_pack, + machineMatrixRawSumAcc_pack, machineMatrixRawSumBound_pack, + machineListTail_cons, machineMatrixRawSumNextAcc, + machineMatrixRawSumCandidate, machineMatrixRawSumEntry, + machineListHead_cons] + rw [← rawRatBinaryCode_rawRatOfRat q, + machineRawRatAddCode_encode] + rw [(List.take_eq_self_iff _).mpr hcode] + rfl + +theorem machineMatrixRawSumIterate_semantics + (word : List Bool) (s : MatrixRawSumSemState) + (hs : MatrixRawSumSemInvariant (1 + word.length) s) : ∀ k, + (machineMatrixRawSumStep)^[k] + (matrixRawSumSemCode (machineMatrixRawSumInputBound word) s) = + matrixRawSumSemCode (machineMatrixRawSumInputBound word) + ((matrixRawSumSemStep)^[k] s) := by + intro k + have hinv : ∀ t : ℕ, + MatrixRawSumSemInvariant (1 + word.length) + ((matrixRawSumSemStep)^[t] s) := by + intro t + induction t with + | zero => exact hs + | succ t iht => + rw [Function.iterate_succ_apply'] + exact matrixRawSumSemStep_invariant iht + induction k with + | zero => rfl + | succ k ih => + rw [Function.iterate_succ_apply', Function.iterate_succ_apply', ih] + exact machineMatrixRawSumStep_semantics word _ (hinv k) + +theorem matrixRawSumSem_processRow + (rows : List (List ℚ)) (row : List ℚ) (acc : RawRat) : + (matrixRawSumSemStep)^[row.length] + ⟨rows, row, acc⟩ = ⟨rows, [], rawRatListSum acc row⟩ := by + induction row generalizing acc with + | nil => rfl + | cons q qs ih => + rw [List.length_cons, Function.iterate_succ_apply, + matrixRawSumSemStep, ih] + rfl + +theorem matrixRawSumSem_processRows + (rows : List (List ℚ)) (acc : RawRat) : + (matrixRawSumSemStep)^[matrixNonnegativeRowsWork rows] + ⟨rows, [], acc⟩ = ⟨[], [], rawRatRowsSum acc rows⟩ := by + induction rows generalizing acc with + | nil => rfl + | cons row rows ih => + rw [matrixNonnegativeRowsWork, show 1 + row.length + + matrixNonnegativeRowsWork rows = + matrixNonnegativeRowsWork rows + row.length + 1 by omega, + Function.iterate_add_apply, Function.iterate_add_apply, + Function.iterate_one, matrixRawSumSemStep, + matrixRawSumSem_processRow, ih, rawRatRowsSum] + +theorem matrixRawSumSem_done_iterate (extra : ℕ) (acc : RawRat) : + (matrixRawSumSemStep)^[extra] ⟨[], [], acc⟩ = ⟨[], [], acc⟩ := by + induction extra with + | zero => rfl + | succ k ih => + rw [Function.iterate_succ_apply', ih] + rfl + +theorem machineMatrixRawSum_done_iterate + (extra : ℕ) (acc : RawRat) (bound : List Bool) : + (machineMatrixRawSumStep)^[extra] + (machineMatrixRawSumPack [] [] (rawRatBinaryCode acc) bound) = + machineMatrixRawSumPack [] [] (rawRatBinaryCode acc) bound := by + induction extra with + | zero => rfl + | succ k ih => + rw [Function.iterate_succ_apply', ih] + simp [machineMatrixRawSumStep, machineMatrixRawSumAfterRow] + +theorem machineMatrixRawSumFinalState_encode {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) : + machineMatrixRawSumFinalState + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩) = + machineMatrixRawSumPack [] [] + (rawRatBinaryCode + (rawRatRowsSum RawRat.zero (rationalMatrixRows A))) + (machineMatrixRawSumInputBound + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩)) := by + let rows := rationalMatrixRows A + let word := rationalMatrixBinaryEncoding.encode ⟨n, A⟩ + let s : MatrixRawSumSemState := ⟨rows, [], RawRat.zero⟩ + have hrowsLength : + (binaryListCode (binaryListCode rationalEntryBinaryCode) rows).length ≤ + word.length := by + calc + _ = (machineMatrixRowsWord word).length := by + simpa only [word, rows] using congrArg List.length + (machineMatrixRowsWord_encode A).symm + _ ≤ word.length := by + simpa only [machineMatrixRowsWord] using + machinePairSecond_length_le word + have hinv : MatrixRawSumSemInvariant (1 + word.length) s := by + simp only [MatrixRawSumSemInvariant, s, rawRatListCost, + List.map_nil, List.sum_nil, rawRatWidth_zero, Nat.add_zero] + exact Nat.add_le_add_left + ((rawRatRowsCost_le_codeLength rows).trans hrowsLength) 1 + have hwork : matrixNonnegativeRowsWork rows ≤ word.length := + (binaryListCode_length_ge_work rows).trans hrowsLength + have hsplit : word.length = + (word.length - matrixNonnegativeRowsWork rows) + + matrixNonnegativeRowsWork rows := by omega + have hinit : machineMatrixRawSumInit word = + matrixRawSumSemCode (machineMatrixRawSumInputBound word) s := by + simp [machineMatrixRawSumInit, matrixRawSumSemCode, s, word, rows, + binaryListCode] + change machineMatrixRawSumFinalState word = _ + rw [machineMatrixRawSumFinalState, hsplit, Function.iterate_add_apply, + hinit, machineMatrixRawSumIterate_semantics word s hinv, + matrixRawSumSem_processRows] + simp only [matrixRawSumSemCode, binaryListCode] + rw [machineMatrixRawSum_done_iterate] + +@[simp] theorem machineMatrixRawSumCode_encode {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) : + machineMatrixRawSumCode + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩) = + rawRatBinaryCode + (rawRatRowsSum RawRat.zero (rationalMatrixRows A)) := by + rw [machineMatrixRawSumCode, machineMatrixRawSumFinalState_encode] + simp + +theorem rawRatListSum_value (acc : RawRat) : ∀ xs : List ℚ, + (rawRatListSum acc xs).value = acc.value + xs.sum := by + intro xs + induction xs generalizing acc with + | nil => simp [rawRatListSum] + | cons q qs ih => + rw [rawRatListSum, ih] + simp [rawRatOfRat_value, add_assoc] + +theorem rawRatRowsSum_value (acc : RawRat) : ∀ rows : List (List ℚ), + (rawRatRowsSum acc rows).value = + acc.value + (rows.map List.sum).sum := by + intro rows + induction rows generalizing acc with + | nil => simp [rawRatRowsSum] + | cons row rows ih => + rw [rawRatRowsSum, ih, rawRatListSum_value] + simp [add_assoc] + +theorem rationalMatrixRows_sum {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) : + ((rationalMatrixRows A).map List.sum).sum = + ∑ i, ∑ j, A i j := by + simp [rationalMatrixRows, List.sum_ofFn] + +@[simp] theorem machineMatrixSumOutputCode_encode {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) : + machineMatrixSumOutputCode + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩) = + rationalBinaryCode (∑ i, ∑ j, A i j) := by + rw [machineMatrixSumOutputCode, machineMatrixRawSumCode_encode, + machineNormalizeRawRatBinaryCode_encode, binaryNormalizeRawRat_eq_value, + rawRatRowsSum_value, RawRat.value_zero, zero_add, + rationalMatrixRows_sum] + +@[simp] theorem machineMatrixNormalizationScaleRawCode_encode {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) : + machineMatrixNormalizationScaleRawCode + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩) = + rawRatBinaryCode + (RawRat.one.add + (rawRatRowsSum RawRat.zero (rationalMatrixRows A))) := by + rw [machineMatrixNormalizationScaleRawCode, + machineMatrixRawSumCode_encode, machineRawRatAddCode_encode] + +@[simp] theorem machineMatrixNormalizationScaleOutputCode_encode {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) : + machineMatrixNormalizationScaleOutputCode + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩) = + rationalBinaryCode (1 + ∑ i, ∑ j, A i j) := by + rw [machineMatrixNormalizationScaleOutputCode, + machineMatrixNormalizationScaleRawCode_encode, + machineNormalizeRawRatBinaryCode_encode, + binaryNormalizeRawRat_eq_value, RawRat.value_add, + RawRat.value_one, rawRatRowsSum_value, RawRat.value_zero, + zero_add, rationalMatrixRows_sum] + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineMatrixSupportProduct.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineMatrixSupportProduct.lean new file mode 100644 index 0000000000..cce5cb5cee --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineMatrixSupportProduct.lean @@ -0,0 +1,585 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineMatrixSum +import LeanPool.BeyondBethe.BeyondBethe.MachineBooleanMemory +import LeanPool.BeyondBethe.BeyondBethe.FinalAssembly + +/-! +# Row-major support product of a rational matrix + +The support floor multiplies every nonzero matrix entry while letting a zero +entry contribute the neutral factor one. This file implements that scan on +the concrete nested binary matrix encoding. The accumulator is an unreduced +rational; a quadratic clamp is total on malformed inputs and is proved +inactive on canonical matrices. +-/ + +namespace BeyondBethe + +open Complexity + +def machineMatrixSupportNonzeroFlag (state : List Bool) : List Bool := + machineRawRatNeBit + (pair (machineMatrixRawSumEntry state) + (rawRatBinaryCode RawRat.zero)) + +def machineMatrixSupportFactorCode (state : List Bool) : List Bool := + machineIfHead (machineMatrixSupportNonzeroFlag state) + (machineMatrixRawSumEntry state) (rawRatBinaryCode RawRat.one) + +def machineMatrixSupportCandidate (state : List Bool) : List Bool := + machineRawRatMulCode + (pair (machineMatrixRawSumAcc state) + (machineMatrixSupportFactorCode state)) + +def machineMatrixSupportNextAcc (state : List Bool) : List Bool := + (machineMatrixSupportCandidate state).take + (machineMatrixRawSumBound state).length + +def machineMatrixSupportProcessEntry (state : List Bool) : List Bool := + machineMatrixRawSumPack + (machineMatrixRawSumRows state) + (machineListTail (machineMatrixRawSumCurrent state)) + (machineMatrixSupportNextAcc state) + (machineMatrixRawSumBound state) + +def machineMatrixSupportLoadRow (state : List Bool) : List Bool := + machineMatrixRawSumLoadRow state + +def machineMatrixSupportAfterRow (state : List Bool) : List Bool := + machineIfEmpty (machineMatrixRawSumRows state) state + (machineMatrixSupportLoadRow state) + +def machineMatrixSupportStep (state : List Bool) : List Bool := + machineIfEmpty (machineMatrixRawSumCurrent state) + (machineMatrixSupportAfterRow state) + (machineMatrixSupportProcessEntry state) + +def machineMatrixSupportInputBound (word : List Bool) : List Bool := + machineBinaryMulWidth word + +def machineMatrixSupportInit (word : List Bool) : List Bool := + machineMatrixRawSumPack (machineMatrixRowsWord word) [] + (rawRatBinaryCode RawRat.one) (machineMatrixSupportInputBound word) + +def machineMatrixSupportWidth (word : List Bool) : List Bool := + let bound := machineMatrixSupportInputBound word + machineMatrixRawSumPack word word bound bound + +def machineMatrixSupportFinalState (word : List Bool) : List Bool := + (machineMatrixSupportStep)^[word.length] (machineMatrixSupportInit word) + +def machineMatrixSupportRawCode (word : List Bool) : List Bool := + machineMatrixRawSumAcc (machineMatrixSupportFinalState word) + +def machineMatrixSupportProductCode (word : List Bool) : List Bool := + machineNormalizeRawRatBinaryCode (machineMatrixSupportRawCode word) + +theorem machineMatrixSupportNonzeroFlag_mem_FP : + machineMatrixSupportNonzeroFlag ∈ Complexity.FP := by + have hpair := machinePair_mem_FP machineMatrixRawSumEntry_mem_FP + (machineConst_mem_FP (rawRatBinaryCode RawRat.zero)) + simpa only [machineMatrixSupportNonzeroFlag] using + machineCompose_mem_FP hpair machineRawRatNeBit_mem_FP + +theorem machineMatrixSupportFactorCode_mem_FP : + machineMatrixSupportFactorCode ∈ Complexity.FP := by + exact machineIfHead_mem_FP machineMatrixSupportNonzeroFlag_mem_FP + machineMatrixRawSumEntry_mem_FP + (machineConst_mem_FP (rawRatBinaryCode RawRat.one)) + +theorem machineMatrixSupportCandidate_mem_FP : + machineMatrixSupportCandidate ∈ Complexity.FP := by + have hpair := machinePair_mem_FP machineMatrixRawSumAcc_mem_FP + machineMatrixSupportFactorCode_mem_FP + simpa only [machineMatrixSupportCandidate] using + machineCompose_mem_FP hpair machineRawRatMulCode_mem_FP + +theorem machineMatrixSupportNextAcc_mem_FP : + machineMatrixSupportNextAcc ∈ Complexity.FP := by + simpa only [machineMatrixSupportNextAcc] using + machineTake_mem_FP machineMatrixRawSumBound_mem_FP + machineMatrixSupportCandidate_mem_FP + +theorem machineMatrixSupportProcessEntry_mem_FP : + machineMatrixSupportProcessEntry ∈ Complexity.FP := by + have htail := machineCompose_mem_FP machineMatrixRawSumCurrent_mem_FP + machineListTail_mem_FP + exact machinePair_mem_FP machineMatrixRawSumRows_mem_FP + (machinePair_mem_FP htail + (machinePair_mem_FP machineMatrixSupportNextAcc_mem_FP + machineMatrixRawSumBound_mem_FP)) + +theorem machineMatrixSupportLoadRow_mem_FP : + machineMatrixSupportLoadRow ∈ Complexity.FP := by + simpa only [machineMatrixSupportLoadRow] using + machineMatrixRawSumLoadRow_mem_FP + +theorem machineMatrixSupportAfterRow_mem_FP : + machineMatrixSupportAfterRow ∈ Complexity.FP := by + exact machineIfEmpty_mem_FP machineMatrixRawSumRows_mem_FP id_mem_FP + machineMatrixSupportLoadRow_mem_FP + +theorem machineMatrixSupportStep_mem_FP : + machineMatrixSupportStep ∈ Complexity.FP := by + exact machineIfEmpty_mem_FP machineMatrixRawSumCurrent_mem_FP + machineMatrixSupportAfterRow_mem_FP + machineMatrixSupportProcessEntry_mem_FP + +theorem machineMatrixSupportInputBound_mem_FP : + machineMatrixSupportInputBound ∈ Complexity.FP := + machineBinaryMulWidth_mem_FP + +theorem machineMatrixSupportInit_mem_FP : + machineMatrixSupportInit ∈ Complexity.FP := by + exact machinePair_mem_FP machineMatrixRowsWord_mem_FP + (machinePair_mem_FP (machineConst_mem_FP []) + (machinePair_mem_FP + (machineConst_mem_FP (rawRatBinaryCode RawRat.one)) + machineMatrixSupportInputBound_mem_FP)) + +theorem machineMatrixSupportWidth_mem_FP : + machineMatrixSupportWidth ∈ Complexity.FP := by + exact machinePair_mem_FP id_mem_FP + (machinePair_mem_FP id_mem_FP + (machinePair_mem_FP machineMatrixSupportInputBound_mem_FP + machineMatrixSupportInputBound_mem_FP)) + +theorem machineMatrixSupportInit_bound (word : List Bool) : + MachineMatrixRawSumStateBound word (machineMatrixSupportInit word) := by + simp only [MachineMatrixRawSumStateBound, machineMatrixSupportInit, + machineMatrixRawSumRows_pack, machineMatrixRawSumCurrent_pack, + machineMatrixRawSumAcc_pack, machineMatrixRawSumBound_pack] + refine ⟨trivial, ?_, by simp, ?_, rfl⟩ + · simpa only [machineMatrixRowsWord] using machinePairSecond_length_le word + · simp [machineMatrixRawSumInputBound, machineBinaryMulWidth, + rawRatBinaryCode, RawRat.one, integerBinaryCode] + nlinarith [sq_nonneg (word.length + 16)] + +theorem machineMatrixSupportStep_bound {word state : List Bool} + (hstate : MachineMatrixRawSumStateBound word state) : + MachineMatrixRawSumStateBound word (machineMatrixSupportStep state) := by + rcases hstate with ⟨hdecomp, hrows, hcurrent, hacc, hbound⟩ + by_cases hc : machineMatrixRawSumCurrent state = [] + · rw [machineMatrixSupportStep, hc, machineIfEmpty_nil] + by_cases hr : machineMatrixRawSumRows state = [] + · rw [machineMatrixSupportAfterRow, hr, machineIfEmpty_nil] + exact ⟨hdecomp, hrows, hcurrent, hacc, hbound⟩ + · rw [machineMatrixSupportAfterRow] + cases hrowsCode : machineMatrixRawSumRows state with + | nil => exact False.elim (hr hrowsCode) + | cons bit tail => + rw [machineIfEmpty_cons, machineMatrixSupportLoadRow] + rw [machineMatrixRawSumLoadRow] + simp only [MachineMatrixRawSumStateBound, + machineMatrixRawSumRows_pack, machineMatrixRawSumCurrent_pack, + machineMatrixRawSumAcc_pack, machineMatrixRawSumBound_pack] + refine ⟨trivial, ?_, ?_, hacc, hbound⟩ + · exact (machinePairSecond_length_le + (machineMatrixRawSumRows state)).trans hrows + · exact (machinePairFirst_length_le + (machineMatrixRawSumRows state)).trans hrows + · rw [machineMatrixSupportStep] + cases hcurrentCode : machineMatrixRawSumCurrent state with + | nil => exact False.elim (hc hcurrentCode) + | cons bit tail => + rw [machineIfEmpty_cons, machineMatrixSupportProcessEntry] + simp only [MachineMatrixRawSumStateBound, + machineMatrixRawSumRows_pack, machineMatrixRawSumCurrent_pack, + machineMatrixRawSumAcc_pack, machineMatrixRawSumBound_pack] + refine ⟨trivial, hrows, ?_, ?_, hbound⟩ + · exact (machinePairSecond_length_le + (machineMatrixRawSumCurrent state)).trans hcurrent + · rw [machineMatrixSupportNextAcc, hbound] + exact List.length_take_le _ _ + +theorem machineMatrixSupportIterate_bound (word : List Bool) : ∀ k, + MachineMatrixRawSumStateBound word + ((machineMatrixSupportStep)^[k] (machineMatrixSupportInit word)) := by + intro k + induction k with + | zero => exact machineMatrixSupportInit_bound word + | succ k ih => + rw [Function.iterate_succ_apply'] + exact machineMatrixSupportStep_bound ih + +theorem machineMatrixSupportIterate_length_le_width + (word : List Bool) (iterations : ℕ) (_ : iterations ≤ word.length) : + ((machineMatrixSupportStep)^[iterations] + (machineMatrixSupportInit word)).length ≤ + (machineMatrixSupportWidth word).length := by + rcases machineMatrixSupportIterate_bound word iterations with + ⟨hdecomp, hrows, hcurrent, hacc, hbound⟩ + have hbound' : + machineMatrixRawSumBound + ((machineMatrixSupportStep)^[iterations] + (machineMatrixSupportInit word)) = + machineMatrixSupportInputBound word := by + simpa only [machineMatrixSupportInputBound, + machineMatrixRawSumInputBound] using hbound + have hacc' : + (machineMatrixRawSumAcc + ((machineMatrixSupportStep)^[iterations] + (machineMatrixSupportInit word))).length ≤ + (machineMatrixSupportInputBound word).length := by + simpa only [machineMatrixSupportInputBound, + machineMatrixRawSumInputBound] using hacc + rw [hdecomp, hbound'] + simp only [machineMatrixRawSumPack, machineMatrixSupportWidth, pair_length] + omega + +theorem machineMatrixSupportFinalState_mem_FP : + machineMatrixSupportFinalState ∈ Complexity.FP := by + exact Cobham.iterate_mem_FP machineMatrixSupportStep_mem_FP + machineMatrixSupportInit_mem_FP id_mem_FP + machineMatrixSupportWidth_mem_FP + machineMatrixSupportIterate_length_le_width + +theorem machineMatrixSupportRawCode_mem_FP : + machineMatrixSupportRawCode ∈ Complexity.FP := by + simpa only [machineMatrixSupportRawCode] using + machineCompose_mem_FP machineMatrixSupportFinalState_mem_FP + machineMatrixRawSumAcc_mem_FP + +theorem machineMatrixSupportProductCode_mem_FP : + machineMatrixSupportProductCode ∈ Complexity.FP := by + simpa only [machineMatrixSupportProductCode] using + machineCompose_mem_FP machineMatrixSupportRawCode_mem_FP + machineNormalizeRawRatBinaryCode_mem_FP + +/-! ## Exact semantics -/ + +def rawRatSupportFactor (q : ℚ) : RawRat := + if q = 0 then RawRat.one else rawRatOfRat q + +def rawRatListSupportProduct : RawRat → List ℚ → RawRat + | acc, [] => acc + | acc, q :: qs => + rawRatListSupportProduct (acc.mul (rawRatSupportFactor q)) qs + +def rawRatRowsSupportProduct : RawRat → List (List ℚ) → RawRat + | acc, [] => acc + | acc, row :: rows => + rawRatRowsSupportProduct (rawRatListSupportProduct acc row) rows + +def matrixSupportSemStep (s : MatrixRawSumSemState) : MatrixRawSumSemState := + match s.current with + | q :: qs => ⟨s.rows, qs, s.acc.mul (rawRatSupportFactor q)⟩ + | [] => + match s.rows with + | row :: rows => ⟨rows, row, s.acc⟩ + | [] => s + +def MatrixSupportSemInvariant (budget : ℕ) + (s : MatrixRawSumSemState) : Prop := + rawRatWidth s.acc + rawRatListCost s.current + rawRatRowsCost s.rows ≤ budget + +theorem rawRatWidth_supportFactor_le (q : ℚ) : + rawRatWidth (rawRatSupportFactor q) ≤ + rawRatWidth (rawRatOfRat q) + 1 := by + by_cases hq : q = 0 + · simp [rawRatSupportFactor, hq, rawRatWidth_one] + · simp [rawRatSupportFactor, hq] + +theorem matrixSupportSemStep_invariant {budget : ℕ} + {s : MatrixRawSumSemState} (hs : MatrixSupportSemInvariant budget s) : + MatrixSupportSemInvariant budget (matrixSupportSemStep s) := by + rcases s with ⟨rows, current, acc⟩ + cases current with + | nil => + cases rows with + | nil => exact hs + | cons row rows => + simp [MatrixSupportSemInvariant, matrixSupportSemStep, + rawRatRowsCost, rawRatListCost] at hs ⊢ + omega + | cons q qs => + have hmul := rawRatWidth_mul_le acc (rawRatSupportFactor q) + have hfactor := rawRatWidth_supportFactor_le q + simp only [MatrixSupportSemInvariant, matrixSupportSemStep, + rawRatListCost, List.map_cons, List.sum_cons] at hs ⊢ + omega + +theorem matrixSupportBound_large (word : List Bool) : + 4 + 3 * (1 + word.length) ≤ + (machineMatrixSupportInputBound word).length := by + simp only [machineMatrixSupportInputBound, machineBinaryMulWidth, + List.length_replicate, List.length_append] + nlinarith + +@[simp] theorem machineMatrixSupportFactorCode_semantics + (rows : List (List ℚ)) (q : ℚ) (qs : List ℚ) + (acc : RawRat) (bound : List Bool) : + machineMatrixSupportFactorCode + (matrixRawSumSemCode bound ⟨rows, q :: qs, acc⟩) = + rawRatBinaryCode (rawRatSupportFactor q) := by + rw [machineMatrixSupportFactorCode, machineMatrixSupportNonzeroFlag] + simp only [matrixRawSumSemCode, machineMatrixRawSumEntry, + machineMatrixRawSumCurrent_pack, machineListHead_cons, + ← rawRatBinaryCode_rawRatOfRat, machineRawRatNeBit_encode, + RawRat.value_zero, rawRatOfRat_value] + by_cases hq : q = 0 + · simp [hq, rawRatSupportFactor] + · simp [hq, rawRatSupportFactor] + +theorem machineMatrixSupportStep_semantics + (word : List Bool) (s : MatrixRawSumSemState) + (hs : MatrixSupportSemInvariant (1 + word.length) s) : + machineMatrixSupportStep + (matrixRawSumSemCode (machineMatrixSupportInputBound word) s) = + matrixRawSumSemCode (machineMatrixSupportInputBound word) + (matrixSupportSemStep s) := by + rcases s with ⟨rows, current, acc⟩ + cases current with + | nil => + cases rows with + | nil => + simp [matrixRawSumSemCode, matrixSupportSemStep, + machineMatrixSupportStep, machineMatrixSupportAfterRow, + binaryListCode] + | cons row rows => + rw [matrixRawSumSemCode, matrixSupportSemStep, + machineMatrixSupportStep] + simp only [machineMatrixRawSumCurrent_pack, binaryListCode, + machineIfEmpty_nil, machineMatrixSupportAfterRow, + machineMatrixRawSumRows_pack] + have hpair : pair (binaryListCode rationalEntryBinaryCode row) + (binaryListCode (binaryListCode rationalEntryBinaryCode) rows) ≠ [] := by + intro h + have hlen := congrArg List.length h + simp at hlen + rw [machineIfEmpty_of_ne_nil_matrix _ _ _ hpair] + simp [machineMatrixSupportLoadRow, machineMatrixRawSumLoadRow, + matrixRawSumSemCode, machineListHead, machineListTail] + | cons q qs => + have hnext : + rawRatWidth (acc.mul (rawRatSupportFactor q)) ≤ + 1 + word.length := by + have hinv := matrixSupportSemStep_invariant hs + have hinv' : rawRatWidth (acc.mul (rawRatSupportFactor q)) + + rawRatListCost qs + rawRatRowsCost rows ≤ 1 + word.length := by + simpa only [MatrixSupportSemInvariant, + matrixSupportSemStep] using hinv + omega + have hcode : + (rawRatBinaryCode (acc.mul (rawRatSupportFactor q))).length ≤ + (machineMatrixSupportInputBound word).length := + (rawRatBinaryCode_length_le_width _).trans + ((Nat.add_le_add_left (Nat.mul_le_mul_left 3 hnext) 4).trans + (matrixSupportBound_large word)) + have hfactor : + machineMatrixSupportFactorCode + (machineMatrixRawSumPack + (binaryListCode (binaryListCode rationalEntryBinaryCode) rows) + (binaryListCode rationalEntryBinaryCode (q :: qs)) + (rawRatBinaryCode acc) + (machineMatrixSupportInputBound word)) = + rawRatBinaryCode (rawRatSupportFactor q) := by + simpa only [matrixRawSumSemCode] using + machineMatrixSupportFactorCode_semantics rows q qs acc + (machineMatrixSupportInputBound word) + rw [matrixRawSumSemCode, matrixSupportSemStep, + machineMatrixSupportStep] + simp only [machineMatrixRawSumCurrent_pack] + rw [machineIfEmpty_of_ne_nil_matrix _ _ _ + (binaryListCode_cons_ne_nil rationalEntryBinaryCode q qs)] + simp only [machineMatrixSupportProcessEntry, + machineMatrixRawSumRows_pack, machineMatrixRawSumCurrent_pack, + machineMatrixRawSumAcc_pack, machineMatrixRawSumBound_pack, + machineListTail_cons, machineMatrixSupportNextAcc, + machineMatrixSupportCandidate] + rw [hfactor, machineRawRatMulCode_encode] + rw [(List.take_eq_self_iff _).mpr hcode] + rfl + +theorem machineMatrixSupportIterate_semantics + (word : List Bool) (s : MatrixRawSumSemState) + (hs : MatrixSupportSemInvariant (1 + word.length) s) : ∀ k, + (machineMatrixSupportStep)^[k] + (matrixRawSumSemCode (machineMatrixSupportInputBound word) s) = + matrixRawSumSemCode (machineMatrixSupportInputBound word) + ((matrixSupportSemStep)^[k] s) := by + intro k + have hinv : ∀ t : ℕ, + MatrixSupportSemInvariant (1 + word.length) + ((matrixSupportSemStep)^[t] s) := by + intro t + induction t with + | zero => exact hs + | succ t iht => + rw [Function.iterate_succ_apply'] + exact matrixSupportSemStep_invariant iht + induction k with + | zero => rfl + | succ k ih => + rw [Function.iterate_succ_apply', Function.iterate_succ_apply', ih] + exact machineMatrixSupportStep_semantics word _ (hinv k) + +theorem matrixSupportSem_processRow + (rows : List (List ℚ)) (row : List ℚ) (acc : RawRat) : + (matrixSupportSemStep)^[row.length] ⟨rows, row, acc⟩ = + ⟨rows, [], rawRatListSupportProduct acc row⟩ := by + induction row generalizing acc with + | nil => rfl + | cons q qs ih => + rw [List.length_cons, Function.iterate_succ_apply, + matrixSupportSemStep, ih] + rfl + +theorem matrixSupportSem_processRows + (rows : List (List ℚ)) (acc : RawRat) : + (matrixSupportSemStep)^[matrixNonnegativeRowsWork rows] + ⟨rows, [], acc⟩ = + ⟨[], [], rawRatRowsSupportProduct acc rows⟩ := by + induction rows generalizing acc with + | nil => rfl + | cons row rows ih => + rw [matrixNonnegativeRowsWork, show 1 + row.length + + matrixNonnegativeRowsWork rows = + matrixNonnegativeRowsWork rows + row.length + 1 by omega, + Function.iterate_add_apply, Function.iterate_add_apply, + Function.iterate_one, matrixSupportSemStep, + matrixSupportSem_processRow, ih, rawRatRowsSupportProduct] + +theorem machineMatrixSupport_done_iterate + (extra : ℕ) (acc : RawRat) (bound : List Bool) : + (machineMatrixSupportStep)^[extra] + (machineMatrixRawSumPack [] [] (rawRatBinaryCode acc) bound) = + machineMatrixRawSumPack [] [] (rawRatBinaryCode acc) bound := by + induction extra with + | zero => rfl + | succ k ih => + rw [Function.iterate_succ_apply', ih] + simp [machineMatrixSupportStep, machineMatrixSupportAfterRow] + +theorem machineMatrixSupportFinalState_encode {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) : + machineMatrixSupportFinalState + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩) = + machineMatrixRawSumPack [] [] + (rawRatBinaryCode + (rawRatRowsSupportProduct RawRat.one (rationalMatrixRows A))) + (machineMatrixSupportInputBound + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩)) := by + let rows := rationalMatrixRows A + let word := rationalMatrixBinaryEncoding.encode ⟨n, A⟩ + let s : MatrixRawSumSemState := ⟨rows, [], RawRat.one⟩ + have hrowsLength : + (binaryListCode (binaryListCode rationalEntryBinaryCode) rows).length ≤ + word.length := by + calc + _ = (machineMatrixRowsWord word).length := by + simpa only [word, rows] using congrArg List.length + (machineMatrixRowsWord_encode A).symm + _ ≤ word.length := by + simpa only [machineMatrixRowsWord] using + machinePairSecond_length_le word + have hinv : MatrixSupportSemInvariant (1 + word.length) s := by + simp only [MatrixSupportSemInvariant, s, rawRatListCost, + List.map_nil, List.sum_nil, rawRatWidth_one, Nat.add_zero] + exact Nat.add_le_add_left + ((rawRatRowsCost_le_codeLength rows).trans hrowsLength) 1 + have hwork : matrixNonnegativeRowsWork rows ≤ word.length := + (binaryListCode_length_ge_work rows).trans hrowsLength + have hsplit : word.length = + (word.length - matrixNonnegativeRowsWork rows) + + matrixNonnegativeRowsWork rows := by omega + have hinit : machineMatrixSupportInit word = + matrixRawSumSemCode (machineMatrixSupportInputBound word) s := by + simp [machineMatrixSupportInit, matrixRawSumSemCode, s, word, rows, + binaryListCode] + change machineMatrixSupportFinalState word = _ + rw [machineMatrixSupportFinalState, hsplit, Function.iterate_add_apply, + hinit, machineMatrixSupportIterate_semantics word s hinv, + matrixSupportSem_processRows] + simp only [matrixRawSumSemCode, binaryListCode] + rw [machineMatrixSupport_done_iterate] + +@[simp] theorem machineMatrixSupportRawCode_encode {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) : + machineMatrixSupportRawCode + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩) = + rawRatBinaryCode + (rawRatRowsSupportProduct RawRat.one (rationalMatrixRows A)) := by + rw [machineMatrixSupportRawCode, machineMatrixSupportFinalState_encode] + simp + +@[simp] theorem machineMatrixSupportProductCode_encode {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) : + machineMatrixSupportProductCode + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩) = + rationalBinaryCode + (binaryNormalizeRawRat + (rawRatRowsSupportProduct RawRat.one (rationalMatrixRows A))) := by + rw [machineMatrixSupportProductCode, + machineMatrixSupportRawCode_encode, + machineNormalizeRawRatBinaryCode_encode] + +theorem rawRatSupportFactor_value (q : ℚ) : + (rawRatSupportFactor q).value = if q = 0 then 1 else q := by + by_cases hq : q = 0 + · simp [rawRatSupportFactor, hq, RawRat.value_one] + · simp [rawRatSupportFactor, hq, rawRatOfRat_value] + +theorem rawRatListSupportProduct_value (acc : RawRat) : ∀ xs : List ℚ, + (rawRatListSupportProduct acc xs).value = + acc.value * (xs.map fun q ↦ if q = 0 then 1 else q).prod := by + intro xs + induction xs generalizing acc with + | nil => simp [rawRatListSupportProduct] + | cons q qs ih => + rw [rawRatListSupportProduct, ih, RawRat.value_mul, + rawRatSupportFactor_value] + simp only [List.map_cons, List.prod_cons] + ring + +theorem rawRatRowsSupportProduct_value (acc : RawRat) : + ∀ rows : List (List ℚ), + (rawRatRowsSupportProduct acc rows).value = + acc.value * + (rows.map fun row ↦ + (row.map fun q ↦ if q = 0 then 1 else q).prod).prod := by + intro rows + induction rows generalizing acc with + | nil => simp [rawRatRowsSupportProduct] + | cons row rows ih => + rw [rawRatRowsSupportProduct, ih, + rawRatListSupportProduct_value] + simp only [List.map_cons, List.prod_cons] + ring + +theorem rawRatRowsSupportProduct_eq_rationalSupportFloor {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) : + (rawRatRowsSupportProduct RawRat.one + (rationalMatrixRows A)).value = rationalSupportFloor A := by + rw [rawRatRowsSupportProduct_value] + simp only [RawRat.value_one, one_mul, rationalMatrixRows, List.map_ofFn, + List.prod_ofFn, Function.comp_apply] + have hproduct : + (∏ i : Fin n, ∏ j : Fin n, + if A i j = 0 then 1 else A i j) = + ∏ p ∈ (Finset.univ.product Finset.univ), + if A p.1 p.2 = 0 then 1 else A p.1 p.2 := by + simpa using + (Finset.prod_product' (Finset.univ : Finset (Fin n)) + (Finset.univ : Finset (Fin n)) + (fun i j ↦ if A i j = 0 then 1 else A i j)).symm + rw [hproduct, rationalSupportFloor] + apply Finset.prod_congr rfl + intro p hp + simp only [rationalSupportFactor] + +@[simp] theorem machineMatrixSupportProductCode_rationalSupportFloor {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) : + machineMatrixSupportProductCode + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩) = + rationalBinaryCode (rationalSupportFloor A) := by + rw [machineMatrixSupportProductCode_encode, + binaryNormalizeRawRat_eq_value, + rawRatRowsSupportProduct_eq_rationalSupportFloor] + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineNaturalCombinators.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineNaturalCombinators.lean new file mode 100644 index 0000000000..7ebec78f6d --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineNaturalCombinators.lean @@ -0,0 +1,63 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineBinaryMul + +/-! # Machine Natural Combinators -/ + +namespace BeyondBethe + +open Complexity + +/-! +# Combinators for binary-natural word machines + +These wrappers keep later arithmetic schedules readable. They do not add a +new computational primitive: each is just pairing followed by the verified +binary addition or multiplication machine. +-/ + +def machineBinaryAddOf (f g : List Bool → List Bool) + (word : List Bool) : List Bool := + machineBinaryAddBits (pair (f word) (g word)) + +def machineBinaryMulOf (f g : List Bool → List Bool) + (word : List Bool) : List Bool := + machineBinaryMulBits (pair (f word) (g word)) + +def machineBinaryConst (k : ℕ) (_word : List Bool) : List Bool := k.bits + +theorem machineBinaryAddOf_mem_FP {f g : List Bool → List Bool} + (hf : f ∈ FP) (hg : g ∈ FP) : machineBinaryAddOf f g ∈ FP := by + simpa only [machineBinaryAddOf] using + machineCompose_mem_FP (machinePair_mem_FP hf hg) + machineBinaryAddBits_mem_FP + +theorem machineBinaryMulOf_mem_FP {f g : List Bool → List Bool} + (hf : f ∈ FP) (hg : g ∈ FP) : machineBinaryMulOf f g ∈ FP := by + simpa only [machineBinaryMulOf] using + machineCompose_mem_FP (machinePair_mem_FP hf hg) + machineBinaryMulBits_mem_FP + +theorem machineBinaryConst_mem_FP (k : ℕ) : machineBinaryConst k ∈ FP := by + simpa only [machineBinaryConst] using machineConst_mem_FP k.bits + +@[simp] theorem machineBinaryAddOf_natBits + (f g : List Bool → List Bool) (word : List Bool) (a b : ℕ) + (hf : f word = a.bits) (hg : g word = b.bits) : + machineBinaryAddOf f g word = (a + b).bits := by + rw [machineBinaryAddOf, hf, hg, machineBinaryAddBits_pair_natBits] + +@[simp] theorem machineBinaryMulOf_natBits + (f g : List Bool → List Bool) (word : List Bool) (a b : ℕ) + (hf : f word = a.bits) (hg : g word = b.bits) : + machineBinaryMulOf f g word = (a * b).bits := by + rw [machineBinaryMulOf, hf, hg, machineBinaryMulBits_pair_natBits] + +@[simp] theorem machineBinaryConst_apply (k : ℕ) (word : List Bool) : + machineBinaryConst k word = k.bits := rfl + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineNearbyCoordinate.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineNearbyCoordinate.lean new file mode 100644 index 0000000000..9a4f97015d --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineNearbyCoordinate.lean @@ -0,0 +1,252 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineScheduledLog +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalNormalization + +/-! +# One directed nearby-Bethe coordinate as a finite-word function + +The input is `pair precision (pair tau x)`, where precision is unary, `tau` is +an arbitrary raw rational, and `x` is a canonical rational-entry word. The +output is the unreduced rational + +`scheduledLogLower (1-x) p + tau*x*scheduledLogLower x p`. +-/ + +namespace BeyondBethe + +open Complexity + +def machineNearbyCoordinatePrecisionRuler (word : List Bool) : List Bool := + machinePairFirst word + +def machineNearbyCoordinatePayload (word : List Bool) : List Bool := + machinePairSecond word + +def machineNearbyCoordinateTauRawCode (word : List Bool) : List Bool := + machinePairFirst (machineNearbyCoordinatePayload word) + +def machineNearbyCoordinateXCode (word : List Bool) : List Bool := + machinePairSecond (machineNearbyCoordinatePayload word) + +def machineNearbyCoordinateNegXRawCode (word : List Bool) : List Bool := + machineRawRatNegCode (machineNearbyCoordinateXCode word) + +def machineNearbyCoordinateComplementUnnormalizedRawCode + (word : List Bool) : List Bool := + machineRawRatAddCode + (pair rawRatOneCode (machineNearbyCoordinateNegXRawCode word)) + +/-- Normalize before logarithm scheduling so that range reduction reads the +canonical numerator and denominator lengths of `1-x`. -/ +def machineNearbyCoordinateComplementCode (word : List Bool) : List Bool := + machineNormalizeRawRatEntryCode + (machineNearbyCoordinateComplementUnnormalizedRawCode word) + +def machineNearbyCoordinateLogComplementRawCode + (word : List Bool) : List Bool := + machineScheduledLogLowerRawCode + (pair (machineNearbyCoordinatePrecisionRuler word) + (machineNearbyCoordinateComplementCode word)) + +def machineNearbyCoordinateLogXRawCode (word : List Bool) : List Bool := + machineScheduledLogLowerRawCode + (pair (machineNearbyCoordinatePrecisionRuler word) + (machineNearbyCoordinateXCode word)) + +def machineNearbyCoordinateTauTimesXRawCode + (word : List Bool) : List Bool := + machineRawRatMulCode + (pair (machineNearbyCoordinateTauRawCode word) + (machineNearbyCoordinateXCode word)) + +def machineNearbyCoordinateWeightedLogXRawCode + (word : List Bool) : List Bool := + machineRawRatMulCode + (pair (machineNearbyCoordinateTauTimesXRawCode word) + (machineNearbyCoordinateLogXRawCode word)) + +def machineNearbyCoordinateLowerRawCode (word : List Bool) : List Bool := + machineRawRatAddCode + (pair (machineNearbyCoordinateLogComplementRawCode word) + (machineNearbyCoordinateWeightedLogXRawCode word)) + +theorem machineNearbyCoordinatePrecisionRuler_mem_FP : + machineNearbyCoordinatePrecisionRuler ∈ Complexity.FP := + machinePairFirst_mem_FP + +theorem machineNearbyCoordinatePayload_mem_FP : + machineNearbyCoordinatePayload ∈ Complexity.FP := + machinePairSecond_mem_FP + +theorem machineNearbyCoordinateTauRawCode_mem_FP : + machineNearbyCoordinateTauRawCode ∈ Complexity.FP := by + simpa only [machineNearbyCoordinateTauRawCode] using + machineCompose_mem_FP machineNearbyCoordinatePayload_mem_FP + machinePairFirst_mem_FP + +theorem machineNearbyCoordinateXCode_mem_FP : + machineNearbyCoordinateXCode ∈ Complexity.FP := by + simpa only [machineNearbyCoordinateXCode] using + machineCompose_mem_FP machineNearbyCoordinatePayload_mem_FP + machinePairSecond_mem_FP + +theorem machineNearbyCoordinateNegXRawCode_mem_FP : + machineNearbyCoordinateNegXRawCode ∈ Complexity.FP := by + simpa only [machineNearbyCoordinateNegXRawCode] using + machineCompose_mem_FP machineNearbyCoordinateXCode_mem_FP + machineRawRatNegCode_mem_FP + +theorem machineNearbyCoordinateComplementUnnormalizedRawCode_mem_FP : + machineNearbyCoordinateComplementUnnormalizedRawCode ∈ Complexity.FP := by + have hpair := machinePair_mem_FP (machineConst_mem_FP rawRatOneCode) + machineNearbyCoordinateNegXRawCode_mem_FP + simpa only [machineNearbyCoordinateComplementUnnormalizedRawCode] using + machineCompose_mem_FP hpair machineRawRatAddCode_mem_FP + +theorem machineNearbyCoordinateComplementCode_mem_FP : + machineNearbyCoordinateComplementCode ∈ Complexity.FP := by + simpa only [machineNearbyCoordinateComplementCode] using + machineCompose_mem_FP + machineNearbyCoordinateComplementUnnormalizedRawCode_mem_FP + machineNormalizeRawRatEntryCode_mem_FP + +theorem machineNearbyCoordinateLogComplementRawCode_mem_FP : + machineNearbyCoordinateLogComplementRawCode ∈ Complexity.FP := by + have hpair := machinePair_mem_FP + machineNearbyCoordinatePrecisionRuler_mem_FP + machineNearbyCoordinateComplementCode_mem_FP + simpa only [machineNearbyCoordinateLogComplementRawCode] using + machineCompose_mem_FP hpair machineScheduledLogLowerRawCode_mem_FP + +theorem machineNearbyCoordinateLogXRawCode_mem_FP : + machineNearbyCoordinateLogXRawCode ∈ Complexity.FP := by + have hpair := machinePair_mem_FP + machineNearbyCoordinatePrecisionRuler_mem_FP + machineNearbyCoordinateXCode_mem_FP + simpa only [machineNearbyCoordinateLogXRawCode] using + machineCompose_mem_FP hpair machineScheduledLogLowerRawCode_mem_FP + +theorem machineNearbyCoordinateTauTimesXRawCode_mem_FP : + machineNearbyCoordinateTauTimesXRawCode ∈ Complexity.FP := by + have hpair := machinePair_mem_FP machineNearbyCoordinateTauRawCode_mem_FP + machineNearbyCoordinateXCode_mem_FP + simpa only [machineNearbyCoordinateTauTimesXRawCode] using + machineCompose_mem_FP hpair machineRawRatMulCode_mem_FP + +theorem machineNearbyCoordinateWeightedLogXRawCode_mem_FP : + machineNearbyCoordinateWeightedLogXRawCode ∈ Complexity.FP := by + have hpair := machinePair_mem_FP + machineNearbyCoordinateTauTimesXRawCode_mem_FP + machineNearbyCoordinateLogXRawCode_mem_FP + simpa only [machineNearbyCoordinateWeightedLogXRawCode] using + machineCompose_mem_FP hpair machineRawRatMulCode_mem_FP + +theorem machineNearbyCoordinateLowerRawCode_mem_FP : + machineNearbyCoordinateLowerRawCode ∈ Complexity.FP := by + have hpair := machinePair_mem_FP + machineNearbyCoordinateLogComplementRawCode_mem_FP + machineNearbyCoordinateWeightedLogXRawCode_mem_FP + simpa only [machineNearbyCoordinateLowerRawCode] using + machineCompose_mem_FP hpair machineRawRatAddCode_mem_FP + +def rawNearbyCoordinateComplement (x : ℚ) : RawRat := + RawRat.one.add (rawRatOfRat x).neg + +def rawNearbyCoordinateLower (tau : RawRat) (x : ℚ) (p : ℕ) : RawRat := + (rawScheduledLogLower (1 - x) p).add + ((tau.mul (rawRatOfRat x)).mul (rawScheduledLogLower x p)) + +@[simp] theorem machineNearbyCoordinateComplementUnnormalizedRawCode_encode + (tau : RawRat) (x : ℚ) (p : ℕ) : + machineNearbyCoordinateComplementUnnormalizedRawCode + (pair (List.replicate p true) + (pair (rawRatBinaryCode tau) (rationalEntryBinaryCode x))) = + rawRatBinaryCode (rawNearbyCoordinateComplement x) := by + rw [machineNearbyCoordinateComplementUnnormalizedRawCode, + machineNearbyCoordinateNegXRawCode, + machineNearbyCoordinateXCode, machineNearbyCoordinatePayload] + simp only [machinePairSecond_pair, machineRawRatNegCode_encode, + ← rawRatBinaryCode_rawRatOfRat, rawRatOneCode] + rw [machineRawRatAddCode_encode] + rfl + +@[simp] theorem machineNearbyCoordinateComplementCode_encode + (tau : RawRat) (x : ℚ) (p : ℕ) : + machineNearbyCoordinateComplementCode + (pair (List.replicate p true) + (pair (rawRatBinaryCode tau) (rationalEntryBinaryCode x))) = + rawRatBinaryCode (rawRatOfRat (1 - x)) := by + rw [machineNearbyCoordinateComplementCode, + machineNearbyCoordinateComplementUnnormalizedRawCode_encode, + machineNormalizeRawRatEntryCode_encode, + rawRatBinaryCode_rawRatOfRat] + apply congrArg rationalEntryBinaryCode + rw [binaryNormalizeRawRat_eq_value] + simp [rawNearbyCoordinateComplement, RawRat.value_add, + RawRat.value_one, RawRat.value_neg, rawRatOfRat_value] + ring + +@[simp] theorem machineNearbyCoordinateLogComplementRawCode_encode + (tau : RawRat) (x : ℚ) (p : ℕ) : + machineNearbyCoordinateLogComplementRawCode + (pair (List.replicate p true) + (pair (rawRatBinaryCode tau) (rationalEntryBinaryCode x))) = + rawRatBinaryCode (rawScheduledLogLower (1 - x) p) := by + rw [machineNearbyCoordinateLogComplementRawCode] + simp only [machineNearbyCoordinatePrecisionRuler, + machinePairFirst_pair, machineNearbyCoordinateComplementCode_encode, + machineScheduledLogLowerRawCode_encode] + +@[simp] theorem machineNearbyCoordinateLogXRawCode_encode + (tau : RawRat) (x : ℚ) (p : ℕ) : + machineNearbyCoordinateLogXRawCode + (pair (List.replicate p true) + (pair (rawRatBinaryCode tau) (rationalEntryBinaryCode x))) = + rawRatBinaryCode (rawScheduledLogLower x p) := by + rw [machineNearbyCoordinateLogXRawCode] + simp only [machineNearbyCoordinatePrecisionRuler, + machinePairFirst_pair, machineNearbyCoordinateXCode, + machineNearbyCoordinatePayload, machinePairSecond_pair, + ← rawRatBinaryCode_rawRatOfRat, + machineScheduledLogLowerRawCode_encode] + +@[simp] theorem machineNearbyCoordinateTauTimesXRawCode_encode + (tau : RawRat) (x : ℚ) (p : ℕ) : + machineNearbyCoordinateTauTimesXRawCode + (pair (List.replicate p true) + (pair (rawRatBinaryCode tau) (rationalEntryBinaryCode x))) = + rawRatBinaryCode (tau.mul (rawRatOfRat x)) := by + rw [machineNearbyCoordinateTauTimesXRawCode] + simp only [machineNearbyCoordinateTauRawCode, + machineNearbyCoordinateXCode, machineNearbyCoordinatePayload, + machinePairSecond_pair, machinePairFirst_pair, + ← rawRatBinaryCode_rawRatOfRat, machineRawRatMulCode_encode] + +@[simp] theorem machineNearbyCoordinateLowerRawCode_encode + (tau : RawRat) (x : ℚ) (p : ℕ) : + machineNearbyCoordinateLowerRawCode + (pair (List.replicate p true) + (pair (rawRatBinaryCode tau) (rationalEntryBinaryCode x))) = + rawRatBinaryCode (rawNearbyCoordinateLower tau x p) := by + rw [machineNearbyCoordinateLowerRawCode, + machineNearbyCoordinateLogComplementRawCode_encode, + machineNearbyCoordinateWeightedLogXRawCode, + machineNearbyCoordinateTauTimesXRawCode_encode, + machineNearbyCoordinateLogXRawCode_encode, + machineRawRatMulCode_encode, machineRawRatAddCode_encode] + rfl + +theorem rawNearbyCoordinateLower_value + (tau : RawRat) (x : ℚ) (p : ℕ) : + (rawNearbyCoordinateLower tau x p).value = + directedNearbyCoordinateLower tau.value x p := by + simp [rawNearbyCoordinateLower, directedNearbyCoordinateLower, + RawRat.value_add, RawRat.value_mul, rawRatOfRat_value, + rawScheduledLogLower_value] + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineNearbyMatrixSum.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineNearbyMatrixSum.lean new file mode 100644 index 0000000000..a879c7a23e --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineNearbyMatrixSum.lean @@ -0,0 +1,989 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineScheduledLogWidth + +/-! +# Row-major evaluation of the nearby-Bethe coordinate sum + +This module scans the matrix carried by a canonical optimizer-output word and +accumulates + +`sum_ij directedNearbyCoordinateLower tau X_ij p`. + +The concrete transducer is total on arbitrary bitstrings. Its raw rational +accumulator is clamped by an explicit iterated-quadratic word; the semantic +section proves separately that this clamp is inactive on canonical inputs. +-/ + +namespace BeyondBethe + +open Complexity + +def machineNearbyMatrixPack + (source rows current acc bound : List Bool) : List Bool := + pair source (pair rows (pair current (pair acc bound))) + +def machineNearbyMatrixSource (state : List Bool) : List Bool := + machinePairFirst state + +def machineNearbyMatrixRows (state : List Bool) : List Bool := + machinePairFirst (machinePairSecond state) + +def machineNearbyMatrixCurrent (state : List Bool) : List Bool := + machinePairFirst (machinePairSecond (machinePairSecond state)) + +def machineNearbyMatrixAcc (state : List Bool) : List Bool := + machinePairFirst + (machinePairSecond (machinePairSecond (machinePairSecond state))) + +def machineNearbyMatrixBound (state : List Bool) : List Bool := + machinePairSecond + (machinePairSecond (machinePairSecond (machinePairSecond state))) + +def machineNearbyMatrixEntry (state : List Bool) : List Bool := + machineListHead (machineNearbyMatrixCurrent state) + +def machineNearbyMatrixCoordinateInput (state : List Bool) : List Bool := + pair + (machineCertificateLogPrecisionRuler (machineNearbyMatrixSource state)) + (pair + (machineCertificateRegularizationScaleRawCode + (machineNearbyMatrixSource state)) + (machineNearbyMatrixEntry state)) + +def machineNearbyMatrixCoordinateRawCode (state : List Bool) : List Bool := + machineNearbyCoordinateLowerRawCode + (machineNearbyMatrixCoordinateInput state) + +def machineNearbyMatrixCandidate (state : List Bool) : List Bool := + machineRawRatAddCode + (pair (machineNearbyMatrixAcc state) + (machineNearbyMatrixCoordinateRawCode state)) + +def machineNearbyMatrixNextAcc (state : List Bool) : List Bool := + (machineNearbyMatrixCandidate state).take + (machineNearbyMatrixBound state).length + +def machineNearbyMatrixProcessEntry (state : List Bool) : List Bool := + machineNearbyMatrixPack + (machineNearbyMatrixSource state) + (machineNearbyMatrixRows state) + (machineListTail (machineNearbyMatrixCurrent state)) + (machineNearbyMatrixNextAcc state) + (machineNearbyMatrixBound state) + +def machineNearbyMatrixLoadRow (state : List Bool) : List Bool := + machineNearbyMatrixPack + (machineNearbyMatrixSource state) + (machineListTail (machineNearbyMatrixRows state)) + (machineListHead (machineNearbyMatrixRows state)) + (machineNearbyMatrixAcc state) + (machineNearbyMatrixBound state) + +def machineNearbyMatrixAfterRow (state : List Bool) : List Bool := + machineIfEmpty (machineNearbyMatrixRows state) state + (machineNearbyMatrixLoadRow state) + +def machineNearbyMatrixStep (state : List Bool) : List Bool := + machineIfEmpty (machineNearbyMatrixCurrent state) + (machineNearbyMatrixAfterRow state) + (machineNearbyMatrixProcessEntry state) + +/-- An explicit degree-eight accumulator envelope. Repeated application of +`machineBinaryMulWidth` is a concrete finite-word construction, not an +existential polynomial ruler. -/ +def machineNearbyMatrixInputBound (word : List Bool) : List Bool := + machineBinaryMulWidth + (machineBinaryMulWidth (machineBinaryMulWidth word)) + +def machineNearbyMatrixRowsWord (word : List Bool) : List Bool := + machineMatrixRowsWord (machineOptimizerMatrixWord word) + +def machineNearbyMatrixInit (word : List Bool) : List Bool := + machineNearbyMatrixPack word (machineNearbyMatrixRowsWord word) [] + (rawRatBinaryCode RawRat.zero) (machineNearbyMatrixInputBound word) + +def machineNearbyMatrixWidth (word : List Bool) : List Bool := + let bound := machineNearbyMatrixInputBound word + machineNearbyMatrixPack word word word bound bound + +def machineNearbyMatrixFinalState (word : List Bool) : List Bool := + (machineNearbyMatrixStep)^[word.length] (machineNearbyMatrixInit word) + +def machineNearbyMatrixRawSumCode (word : List Bool) : List Bool := + machineNearbyMatrixAcc (machineNearbyMatrixFinalState word) + +theorem machineNearbyMatrixSource_mem_FP : + machineNearbyMatrixSource ∈ Complexity.FP := + machinePairFirst_mem_FP + +theorem machineNearbyMatrixRows_mem_FP : + machineNearbyMatrixRows ∈ Complexity.FP := by + simpa only [machineNearbyMatrixRows] using + machineCompose_mem_FP machinePairSecond_mem_FP machinePairFirst_mem_FP + +theorem machineNearbyMatrixCurrent_mem_FP : + machineNearbyMatrixCurrent ∈ Complexity.FP := by + simpa only [machineNearbyMatrixCurrent] using + machineCompose_mem_FP + (machineCompose_mem_FP machinePairSecond_mem_FP machinePairSecond_mem_FP) + machinePairFirst_mem_FP + +theorem machineNearbyMatrixAcc_mem_FP : + machineNearbyMatrixAcc ∈ Complexity.FP := by + simpa only [machineNearbyMatrixAcc] using + machineCompose_mem_FP + (machineCompose_mem_FP + (machineCompose_mem_FP machinePairSecond_mem_FP + machinePairSecond_mem_FP) + machinePairSecond_mem_FP) + machinePairFirst_mem_FP + +theorem machineNearbyMatrixBound_mem_FP : + machineNearbyMatrixBound ∈ Complexity.FP := by + simpa only [machineNearbyMatrixBound] using + machineCompose_mem_FP + (machineCompose_mem_FP + (machineCompose_mem_FP machinePairSecond_mem_FP + machinePairSecond_mem_FP) + machinePairSecond_mem_FP) + machinePairSecond_mem_FP + +theorem machineNearbyMatrixEntry_mem_FP : + machineNearbyMatrixEntry ∈ Complexity.FP := by + simpa only [machineNearbyMatrixEntry] using + machineCompose_mem_FP machineNearbyMatrixCurrent_mem_FP + machineListHead_mem_FP + +theorem machineNearbyMatrixCoordinateInput_mem_FP : + machineNearbyMatrixCoordinateInput ∈ Complexity.FP := by + have hp := machineCompose_mem_FP machineNearbyMatrixSource_mem_FP + machineCertificateLogPrecisionRuler_mem_FP + have htau := machineCompose_mem_FP machineNearbyMatrixSource_mem_FP + machineCertificateRegularizationScaleRawCode_mem_FP + exact machinePair_mem_FP hp + (machinePair_mem_FP htau machineNearbyMatrixEntry_mem_FP) + +theorem machineNearbyMatrixCoordinateRawCode_mem_FP : + machineNearbyMatrixCoordinateRawCode ∈ Complexity.FP := by + simpa only [machineNearbyMatrixCoordinateRawCode] using + machineCompose_mem_FP machineNearbyMatrixCoordinateInput_mem_FP + machineNearbyCoordinateLowerRawCode_mem_FP + +theorem machineNearbyMatrixCandidate_mem_FP : + machineNearbyMatrixCandidate ∈ Complexity.FP := by + have hpair := machinePair_mem_FP machineNearbyMatrixAcc_mem_FP + machineNearbyMatrixCoordinateRawCode_mem_FP + simpa only [machineNearbyMatrixCandidate] using + machineCompose_mem_FP hpair machineRawRatAddCode_mem_FP + +theorem machineNearbyMatrixNextAcc_mem_FP : + machineNearbyMatrixNextAcc ∈ Complexity.FP := by + simpa only [machineNearbyMatrixNextAcc] using + machineTake_mem_FP machineNearbyMatrixBound_mem_FP + machineNearbyMatrixCandidate_mem_FP + +theorem machineNearbyMatrixProcessEntry_mem_FP : + machineNearbyMatrixProcessEntry ∈ Complexity.FP := by + have htail := machineCompose_mem_FP machineNearbyMatrixCurrent_mem_FP + machineListTail_mem_FP + exact machinePair_mem_FP machineNearbyMatrixSource_mem_FP + (machinePair_mem_FP machineNearbyMatrixRows_mem_FP + (machinePair_mem_FP htail + (machinePair_mem_FP machineNearbyMatrixNextAcc_mem_FP + machineNearbyMatrixBound_mem_FP))) + +theorem machineNearbyMatrixLoadRow_mem_FP : + machineNearbyMatrixLoadRow ∈ Complexity.FP := by + have htail := machineCompose_mem_FP machineNearbyMatrixRows_mem_FP + machineListTail_mem_FP + have hhead := machineCompose_mem_FP machineNearbyMatrixRows_mem_FP + machineListHead_mem_FP + exact machinePair_mem_FP machineNearbyMatrixSource_mem_FP + (machinePair_mem_FP htail + (machinePair_mem_FP hhead + (machinePair_mem_FP machineNearbyMatrixAcc_mem_FP + machineNearbyMatrixBound_mem_FP))) + +theorem machineNearbyMatrixAfterRow_mem_FP : + machineNearbyMatrixAfterRow ∈ Complexity.FP := by + exact machineIfEmpty_mem_FP machineNearbyMatrixRows_mem_FP id_mem_FP + machineNearbyMatrixLoadRow_mem_FP + +theorem machineNearbyMatrixStep_mem_FP : + machineNearbyMatrixStep ∈ Complexity.FP := by + exact machineIfEmpty_mem_FP machineNearbyMatrixCurrent_mem_FP + machineNearbyMatrixAfterRow_mem_FP machineNearbyMatrixProcessEntry_mem_FP + +theorem machineNearbyMatrixInputBound_mem_FP : + machineNearbyMatrixInputBound ∈ Complexity.FP := by + have h1 := machineBinaryMulWidth_mem_FP + have h2 := machineCompose_mem_FP h1 machineBinaryMulWidth_mem_FP + simpa only [machineNearbyMatrixInputBound] using + machineCompose_mem_FP h2 machineBinaryMulWidth_mem_FP + +theorem machineNearbyMatrixRowsWord_mem_FP : + machineNearbyMatrixRowsWord ∈ Complexity.FP := by + simpa only [machineNearbyMatrixRowsWord] using + machineCompose_mem_FP machineOptimizerMatrixWord_mem_FP + machineMatrixRowsWord_mem_FP + +theorem machineNearbyMatrixInit_mem_FP : + machineNearbyMatrixInit ∈ Complexity.FP := by + exact machinePair_mem_FP id_mem_FP + (machinePair_mem_FP machineNearbyMatrixRowsWord_mem_FP + (machinePair_mem_FP (machineConst_mem_FP []) + (machinePair_mem_FP + (machineConst_mem_FP (rawRatBinaryCode RawRat.zero)) + machineNearbyMatrixInputBound_mem_FP))) + +theorem machineNearbyMatrixWidth_mem_FP : + machineNearbyMatrixWidth ∈ Complexity.FP := by + exact machinePair_mem_FP id_mem_FP + (machinePair_mem_FP id_mem_FP + (machinePair_mem_FP id_mem_FP + (machinePair_mem_FP machineNearbyMatrixInputBound_mem_FP + machineNearbyMatrixInputBound_mem_FP))) + +@[simp] theorem machineNearbyMatrixSource_pack (source rows current acc bound) : + machineNearbyMatrixSource + (machineNearbyMatrixPack source rows current acc bound) = source := by + simp [machineNearbyMatrixSource, machineNearbyMatrixPack] + +@[simp] theorem machineNearbyMatrixRows_pack (source rows current acc bound) : + machineNearbyMatrixRows + (machineNearbyMatrixPack source rows current acc bound) = rows := by + simp [machineNearbyMatrixRows, machineNearbyMatrixPack] + +@[simp] theorem machineNearbyMatrixCurrent_pack + (source rows current acc bound) : + machineNearbyMatrixCurrent + (machineNearbyMatrixPack source rows current acc bound) = current := by + simp [machineNearbyMatrixCurrent, machineNearbyMatrixPack] + +@[simp] theorem machineNearbyMatrixAcc_pack (source rows current acc bound) : + machineNearbyMatrixAcc + (machineNearbyMatrixPack source rows current acc bound) = acc := by + simp [machineNearbyMatrixAcc, machineNearbyMatrixPack] + +@[simp] theorem machineNearbyMatrixBound_pack (source rows current acc bound) : + machineNearbyMatrixBound + (machineNearbyMatrixPack source rows current acc bound) = bound := by + simp [machineNearbyMatrixBound, machineNearbyMatrixPack] + +def MachineNearbyMatrixStateBound (word state : List Bool) : Prop := + state = machineNearbyMatrixPack + (machineNearbyMatrixSource state) (machineNearbyMatrixRows state) + (machineNearbyMatrixCurrent state) (machineNearbyMatrixAcc state) + (machineNearbyMatrixBound state) ∧ + machineNearbyMatrixSource state = word ∧ + (machineNearbyMatrixRows state).length ≤ word.length ∧ + (machineNearbyMatrixCurrent state).length ≤ word.length ∧ + (machineNearbyMatrixAcc state).length ≤ + (machineNearbyMatrixInputBound word).length ∧ + machineNearbyMatrixBound state = machineNearbyMatrixInputBound word + +theorem machineNearbyMatrixInit_bound (word : List Bool) : + MachineNearbyMatrixStateBound word (machineNearbyMatrixInit word) := by + simp only [MachineNearbyMatrixStateBound, machineNearbyMatrixInit, + machineNearbyMatrixSource_pack, machineNearbyMatrixRows_pack, + machineNearbyMatrixCurrent_pack, machineNearbyMatrixAcc_pack, + machineNearbyMatrixBound_pack] + refine ⟨trivial, trivial, ?_, by simp, ?_, trivial⟩ + · exact (machinePairSecond_length_le + (machineOptimizerMatrixWord word)).trans + ((machinePairFirst_length_le word)) + · simp [machineNearbyMatrixInputBound, machineBinaryMulWidth, + rawRatBinaryCode, RawRat.zero, integerBinaryCode] + nlinarith [sq_nonneg (word.length + 16)] + +theorem machineNearbyMatrixStep_bound {word state : List Bool} + (hstate : MachineNearbyMatrixStateBound word state) : + MachineNearbyMatrixStateBound word (machineNearbyMatrixStep state) := by + rcases hstate with + ⟨hdecomp, hsource, hrows, hcurrent, hacc, hbound⟩ + by_cases hc : machineNearbyMatrixCurrent state = [] + · rw [machineNearbyMatrixStep, hc, machineIfEmpty_nil] + by_cases hr : machineNearbyMatrixRows state = [] + · rw [machineNearbyMatrixAfterRow, hr, machineIfEmpty_nil] + exact ⟨hdecomp, hsource, hrows, hcurrent, hacc, hbound⟩ + · rw [machineNearbyMatrixAfterRow] + cases hrowsCode : machineNearbyMatrixRows state with + | nil => exact False.elim (hr hrowsCode) + | cons bit tail => + rw [machineIfEmpty_cons, machineNearbyMatrixLoadRow] + simp only [MachineNearbyMatrixStateBound, + machineNearbyMatrixSource_pack, machineNearbyMatrixRows_pack, + machineNearbyMatrixCurrent_pack, machineNearbyMatrixAcc_pack, + machineNearbyMatrixBound_pack] + refine ⟨trivial, hsource, ?_, ?_, hacc, hbound⟩ + · exact (machinePairSecond_length_le + (machineNearbyMatrixRows state)).trans hrows + · exact (machinePairFirst_length_le + (machineNearbyMatrixRows state)).trans hrows + · rw [machineNearbyMatrixStep] + cases hcurrentCode : machineNearbyMatrixCurrent state with + | nil => exact False.elim (hc hcurrentCode) + | cons bit tail => + rw [machineIfEmpty_cons, machineNearbyMatrixProcessEntry] + simp only [MachineNearbyMatrixStateBound, + machineNearbyMatrixSource_pack, machineNearbyMatrixRows_pack, + machineNearbyMatrixCurrent_pack, machineNearbyMatrixAcc_pack, + machineNearbyMatrixBound_pack] + refine ⟨trivial, hsource, hrows, ?_, ?_, hbound⟩ + · exact (machinePairSecond_length_le + (machineNearbyMatrixCurrent state)).trans hcurrent + · rw [machineNearbyMatrixNextAcc, hbound] + exact List.length_take_le _ _ + +theorem machineNearbyMatrixIterate_bound (word : List Bool) : ∀ k, + MachineNearbyMatrixStateBound word + ((machineNearbyMatrixStep)^[k] (machineNearbyMatrixInit word)) := by + intro k + induction k with + | zero => exact machineNearbyMatrixInit_bound word + | succ k ih => + rw [Function.iterate_succ_apply'] + exact machineNearbyMatrixStep_bound ih + +theorem machineNearbyMatrixIterate_length_le_width + (word : List Bool) (iterations : ℕ) (_ : iterations ≤ word.length) : + ((machineNearbyMatrixStep)^[iterations] + (machineNearbyMatrixInit word)).length ≤ + (machineNearbyMatrixWidth word).length := by + rcases machineNearbyMatrixIterate_bound word iterations with + ⟨hdecomp, hsource, hrows, hcurrent, hacc, hbound⟩ + rw [hdecomp, hsource, hbound] + simp only [machineNearbyMatrixPack, machineNearbyMatrixWidth, pair_length] + omega + +theorem machineNearbyMatrixFinalState_mem_FP : + machineNearbyMatrixFinalState ∈ Complexity.FP := by + exact Cobham.iterate_mem_FP machineNearbyMatrixStep_mem_FP + machineNearbyMatrixInit_mem_FP id_mem_FP machineNearbyMatrixWidth_mem_FP + machineNearbyMatrixIterate_length_le_width + +theorem machineNearbyMatrixRawSumCode_mem_FP : + machineNearbyMatrixRawSumCode ∈ Complexity.FP := by + simpa only [machineNearbyMatrixRawSumCode] using + machineCompose_mem_FP machineNearbyMatrixFinalState_mem_FP + machineNearbyMatrixAcc_mem_FP + +/-! ## Semantic invariant and exactness before discharging the size bound -/ + +def rawNearbyListCost (tau : RawRat) (p : ℕ) (xs : List ℚ) : ℕ := + (xs.map fun q => rawRatWidth (rawNearbyCoordinateLower tau q p) + 1).sum + +def rawNearbyRowsCost (tau : RawRat) (p : ℕ) + (rows : List (List ℚ)) : ℕ := + (rows.map (rawNearbyListCost tau p)).sum + +/-- Uniform raw-width budget for one coordinate whose canonical matrix entry, +matrix dimension, and requested precision are all controlled by a word of +length `L`. The constants come directly from the normalized complement, +the `n + 400` schedule, and the fixed regularization constant. -/ +def rawNearbyCoordinateInputWidthBudget (L : ℕ) : ℕ := + 64 * ((L + 400) + 2 * (44 + 12 * L) + 4) ^ 2 * + ((44 + 12 * L) + 2) + + (L + 235) + L + + 64 * ((L + 400) + 2 * L + 4) ^ 2 * (L + 2) + 1 + +theorem rawCertificateRegularizationScale_width_le_optimizer_word + {n : ℕ} (X : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℚ) : + rawRatWidth (rawCertificateRegularizationScale n) ≤ + (rationalOptimizerOutputCode ⟨X, R, C⟩).length + 235 := by + let word := rationalOptimizerOutputCode ⟨X, R, C⟩ + have hxi : rawRatWidth rawExplicitXi = 231 := by + rw [rawExplicitXi, explicitXi, explicitDelta, explicitEta, + explicitRowRatio] + norm_num [rawRatOfRat, rawRatWidth] + apply Nat.le_antisymm + · apply max_le + · norm_num + · rw [Nat.size_le] + norm_num + · apply le_max_of_le_right + have hsize : 230 < Nat.size + 1785851933491520000000000000000000000000000000000000000000000000000000 := by + rw [Nat.lt_size] + norm_num + omega + have hfour : rawRatWidth rawCertificateFour = 3 := by + decide + have hnraw := RawRat.width_ofNat_le n + have hfourN := rawRatWidth_mul_le rawCertificateFour (RawRat.ofNat n) + have htau := rawRatWidth_div_le rawExplicitXi + (rawCertificateFourDimension n) + have hnMatrix := matrix_dimension_le_code_length X + have hmatrixWord : + (rationalMatrixBinaryEncoding.encode ⟨n, X⟩).length ≤ word.length := by + simpa only [word, rationalOptimizerOutputCode, + machinePairFirst_pair] using machinePairFirst_length_le word + have hnWord : n ≤ word.length := hnMatrix.trans hmatrixWord + simp only [rawCertificateRegularizationScale, + rawCertificateFourDimension] at htau + rw [hxi] at htau + rw [hfour] at hfourN + rw [rawCertificateRegularizationScale, + rawCertificateFourDimension] + dsimp only [word] at hnWord ⊢ + omega + +theorem rawNearbyCoordinateLower_width_le_optimizer_word + {n : ℕ} (X : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℚ) + {row : List ℚ} (hrow : row ∈ rationalMatrixRows X) + {q : ℚ} (hq : q ∈ row) : + rawRatWidth + (rawNearbyCoordinateLower (rawCertificateRegularizationScale n) q + (directedCertificatePrecision n)) ≤ + rawNearbyCoordinateInputWidthBudget + (rationalOptimizerOutputCode ⟨X, R, C⟩).length := by + let word := rationalOptimizerOutputCode ⟨X, R, C⟩ + let L := word.length + have hrowsCode : + (binaryListCode (binaryListCode rationalEntryBinaryCode) + (rationalMatrixRows X)).length ≤ L := by + calc + _ = (machineMatrixRowsWord + (rationalMatrixBinaryEncoding.encode ⟨n, X⟩)).length := by + simpa using congrArg List.length + (machineMatrixRowsWord_encode X).symm + _ ≤ (rationalMatrixBinaryEncoding.encode ⟨n, X⟩).length := by + simpa only [machineMatrixRowsWord] using machinePairSecond_length_le + (rationalMatrixBinaryEncoding.encode ⟨n, X⟩) + _ ≤ word.length := by + simpa only [word, rationalOptimizerOutputCode, + machinePairFirst_pair] using machinePairFirst_length_le word + _ = L := rfl + have hqCode := binaryListCode_element_length_le + rationalEntryBinaryCode hq + have hrowCode := binaryListCode_element_length_le + (binaryListCode rationalEntryBinaryCode) hrow + have hqWidth : rawRatWidth (rawRatOfRat q) ≤ L := by + have hentryCode : + (rawRatBinaryCode (rawRatOfRat q)).length ≤ L := by + rw [rawRatBinaryCode_rawRatOfRat] + exact hqCode.trans (hrowCode.trans hrowsCode) + exact (rawRatWidth_le_binaryCode_length _).trans hentryCode + have hnMatrix := matrix_dimension_le_code_length X + have hmatrixWord : + (rationalMatrixBinaryEncoding.encode ⟨n, X⟩).length ≤ L := by + simpa only [L, word, rationalOptimizerOutputCode, + machinePairFirst_pair] using machinePairFirst_length_le word + have hnWord : n ≤ L := hnMatrix.trans hmatrixWord + have hp : directedCertificatePrecision n ≤ L + 400 := by + simp only [directedCertificatePrecision] + omega + have hcompWidth0 := rawRatWidth_complement_le q + have hcompWidth : rawRatWidth (rawRatOfRat (1 - q)) ≤ 44 + 12 * L := by + omega + have hcompLog := rawRatWidth_scheduledLogLower_of_bounds_le + (1 - q) hp hcompWidth + have hqLog := rawRatWidth_scheduledLogLower_of_bounds_le q hp hqWidth + have htau := rawCertificateRegularizationScale_width_le_optimizer_word + X R C + have htx := rawRatWidth_mul_le + (rawCertificateRegularizationScale n) (rawRatOfRat q) + have hweighted := rawRatWidth_mul_le + ((rawCertificateRegularizationScale n).mul (rawRatOfRat q)) + (rawScheduledLogLower q (directedCertificatePrecision n)) + have hadd := rawRatWidth_add_le + (rawScheduledLogLower (1 - q) (directedCertificatePrecision n)) + (((rawCertificateRegularizationScale n).mul (rawRatOfRat q)).mul + (rawScheduledLogLower q (directedCertificatePrecision n))) + rw [rawNearbyCoordinateLower] + simp only [rawNearbyCoordinateInputWidthBudget] + dsimp only [L, word] at hqWidth hcompLog hqLog htx hweighted hadd + exact hadd.trans (by omega) + +theorem rawNearbyListCost_le_uniform {tau : RawRat} {p budget : ℕ} : + ∀ xs : List ℚ, + (∀ q ∈ xs, + rawRatWidth (rawNearbyCoordinateLower tau q p) ≤ budget) → + rawNearbyListCost tau p xs ≤ xs.length * (budget + 1) := by + intro xs hwidth + induction xs with + | nil => simp [rawNearbyListCost] + | cons q qs ih => + have hq := hwidth q (by simp) + have hqs : ∀ r ∈ qs, + rawRatWidth (rawNearbyCoordinateLower tau r p) ≤ budget := by + intro r hr + exact hwidth r (by simp [hr]) + have ih' := ih hqs + simp only [rawNearbyListCost] at ih' + simp only [rawNearbyListCost, List.map_cons, List.sum_cons, + List.length_cons] + rw [Nat.succ_mul] + omega + +theorem rawNearbyRowsCost_le_uniform {tau : RawRat} {p budget : ℕ} : + ∀ rows : List (List ℚ), + (∀ row ∈ rows, ∀ q ∈ row, + rawRatWidth (rawNearbyCoordinateLower tau q p) ≤ budget) → + rawNearbyRowsCost tau p rows ≤ + (rows.map List.length).sum * (budget + 1) := by + intro rows hwidth + induction rows with + | nil => simp [rawNearbyRowsCost] + | cons row rows ih => + have hrow := rawNearbyListCost_le_uniform row (by + intro q hq + exact hwidth row (by simp) q hq) + have hrows : ∀ tailRow ∈ rows, ∀ q ∈ tailRow, + rawRatWidth (rawNearbyCoordinateLower tau q p) ≤ budget := by + intro tailRow htail q hq + exact hwidth tailRow (by simp [htail]) q hq + have ih' := ih hrows + simp only [rawNearbyRowsCost] at ih' + simp only [rawNearbyRowsCost, List.map_cons, List.sum_cons, + List.length_cons] + rw [Nat.add_mul] + omega + +theorem rawNearbyRowsCost_le_optimizer_word + {n : ℕ} (X : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℚ) : + rawNearbyRowsCost (rawCertificateRegularizationScale n) + (directedCertificatePrecision n) (rationalMatrixRows X) ≤ + (rationalOptimizerOutputCode ⟨X, R, C⟩).length * + (rawNearbyCoordinateInputWidthBudget + (rationalOptimizerOutputCode ⟨X, R, C⟩).length + 1) := by + let rows := rationalMatrixRows X + let word := rationalOptimizerOutputCode ⟨X, R, C⟩ + let budget := rawNearbyCoordinateInputWidthBudget word.length + have hcoordinate : ∀ row ∈ rows, ∀ q ∈ row, + rawRatWidth + (rawNearbyCoordinateLower (rawCertificateRegularizationScale n) q + (directedCertificatePrecision n)) ≤ budget := by + intro row hrow q hq + simpa only [rows, word, budget] using + rawNearbyCoordinateLower_width_le_optimizer_word X R C hrow hq + have hcost := rawNearbyRowsCost_le_uniform rows hcoordinate + have hrowsCode : + (binaryListCode (binaryListCode rationalEntryBinaryCode) rows).length ≤ + word.length := by + calc + _ = (machineMatrixRowsWord + (rationalMatrixBinaryEncoding.encode ⟨n, X⟩)).length := by + simpa only [rows] using congrArg List.length + (machineMatrixRowsWord_encode X).symm + _ ≤ (rationalMatrixBinaryEncoding.encode ⟨n, X⟩).length := by + simpa only [machineMatrixRowsWord] using machinePairSecond_length_le + (rationalMatrixBinaryEncoding.encode ⟨n, X⟩) + _ ≤ word.length := by + simpa only [word, rationalOptimizerOutputCode, + machinePairFirst_pair] using machinePairFirst_length_le word + have hwork : matrixNonnegativeRowsWork rows ≤ word.length := + (binaryListCode_length_ge_work rows).trans hrowsCode + have hentries : (rows.map List.length).sum ≤ word.length := by + have hentriesWork : ∀ rs : List (List ℚ), + (rs.map List.length).sum ≤ matrixNonnegativeRowsWork rs := by + intro rs + induction rs with + | nil => simp [matrixNonnegativeRowsWork] + | cons row rs ih => + simp only [List.map_cons, List.sum_cons, + matrixNonnegativeRowsWork] + omega + exact (hentriesWork rows).trans hwork + have hmul := Nat.mul_le_mul_right (budget + 1) hentries + exact hcost.trans (by simpa only [rows, word, budget] using hmul) + +theorem machineNearbyMatrixInputBound_length_dominates (word : List Bool) : + 4 + 3 * (1 + word.length * + (rawNearbyCoordinateInputWidthBudget word.length + 1)) ≤ + (machineNearbyMatrixInputBound word).length := by + simp only [rawNearbyCoordinateInputWidthBudget, + machineNearbyMatrixInputBound, machineBinaryMulWidth, + List.length_replicate, List.length_append] + by_cases hsmall : word.length < 9 + · interval_cases word.length <;> norm_num + · have h9 : 9 ≤ word.length := by omega + have hsq : 81 ≤ word.length ^ 2 := by + exact_mod_cast Nat.pow_le_pow_left h9 2 + have hcoef : 272148486 ≤ 3393120 * 81 := by norm_num + have hcover : + 272148486 * word.length ^ 2 ≤ 3393120 * word.length ^ 4 := by + calc + 272148486 * word.length ^ 2 ≤ + (3393120 * 81) * word.length ^ 2 := + Nat.mul_le_mul_right (word.length ^ 2) hcoef + _ ≤ (3393120 * word.length ^ 2) * word.length ^ 2 := by + exact Nat.mul_le_mul_right (word.length ^ 2) + (Nat.mul_le_mul_left 3393120 hsq) + _ = 3393120 * word.length ^ 4 := by ring + ring_nf at hcover ⊢ + omega + +def rawNearbyListSum (tau : RawRat) (p : ℕ) : + RawRat → List ℚ → RawRat + | acc, [] => acc + | acc, q :: qs => + rawNearbyListSum tau p + (acc.add (rawNearbyCoordinateLower tau q p)) qs + +def rawNearbyRowsSum (tau : RawRat) (p : ℕ) : + RawRat → List (List ℚ) → RawRat + | acc, [] => acc + | acc, row :: rows => + rawNearbyRowsSum tau p (rawNearbyListSum tau p acc row) rows + +structure NearbyMatrixSemState where + rows : List (List ℚ) + current : List ℚ + acc : RawRat + +def nearbyMatrixSemStep (tau : RawRat) (p : ℕ) + (s : NearbyMatrixSemState) : NearbyMatrixSemState := + match s.current with + | q :: qs => + ⟨s.rows, qs, s.acc.add (rawNearbyCoordinateLower tau q p)⟩ + | [] => + match s.rows with + | row :: rows => ⟨rows, row, s.acc⟩ + | [] => s + +def nearbyMatrixSemCode (source bound : List Bool) + (s : NearbyMatrixSemState) : List Bool := + machineNearbyMatrixPack source + (binaryListCode (binaryListCode rationalEntryBinaryCode) s.rows) + (binaryListCode rationalEntryBinaryCode s.current) + (rawRatBinaryCode s.acc) bound + +def NearbyMatrixSemInvariant (tau : RawRat) (p budget : ℕ) + (s : NearbyMatrixSemState) : Prop := + rawRatWidth s.acc + rawNearbyListCost tau p s.current + + rawNearbyRowsCost tau p s.rows ≤ budget + +theorem nearbyMatrixSemStep_invariant {tau : RawRat} {p budget : ℕ} + {s : NearbyMatrixSemState} + (hs : NearbyMatrixSemInvariant tau p budget s) : + NearbyMatrixSemInvariant tau p budget (nearbyMatrixSemStep tau p s) := by + rcases s with ⟨rows, current, acc⟩ + cases current with + | nil => + cases rows with + | nil => exact hs + | cons row rows => + simp [NearbyMatrixSemInvariant, nearbyMatrixSemStep, + rawNearbyRowsCost, rawNearbyListCost] at hs ⊢ + omega + | cons q qs => + have hadd := rawRatWidth_add_le acc + (rawNearbyCoordinateLower tau q p) + simp only [NearbyMatrixSemInvariant, nearbyMatrixSemStep, + rawNearbyListCost, List.map_cons, List.sum_cons] at hs ⊢ + omega + +@[simp] theorem machineNearbyMatrixRowsWord_encode {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℚ) : + machineNearbyMatrixRowsWord + (rationalOptimizerOutputCode ⟨X, R, C⟩) = + binaryListCode (binaryListCode rationalEntryBinaryCode) + (rationalMatrixRows X) := by + simp [machineNearbyMatrixRowsWord] + +@[simp] theorem machineNearbyMatrixCoordinateRawCode_semCode + {n : ℕ} (X : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℚ) + (rows : List (List ℚ)) (q : ℚ) (qs : List ℚ) + (acc : RawRat) (bound : List Bool) : + machineNearbyMatrixCoordinateRawCode + (nearbyMatrixSemCode (rationalOptimizerOutputCode ⟨X, R, C⟩) + bound ⟨rows, q :: qs, acc⟩) = + rawRatBinaryCode + (rawNearbyCoordinateLower + (rawCertificateRegularizationScale n) q + (directedCertificatePrecision n)) := by + rw [machineNearbyMatrixCoordinateRawCode, + machineNearbyMatrixCoordinateInput] + simp only [nearbyMatrixSemCode, machineNearbyMatrixSource_pack, + machineNearbyMatrixEntry, machineNearbyMatrixCurrent_pack, + machineListHead_cons, machineCertificateLogPrecisionRuler_encode, + machineCertificateRegularizationScaleRawCode_encode, + machineNearbyCoordinateLowerRawCode_encode] + +@[simp] theorem machineNearbyMatrixCoordinateRawCode_pack + {n : ℕ} (X : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℚ) + (rows : List (List ℚ)) (q : ℚ) (qs : List ℚ) + (acc : RawRat) (bound : List Bool) : + machineNearbyMatrixCoordinateRawCode + (machineNearbyMatrixPack + (rationalOptimizerOutputCode ⟨X, R, C⟩) + (binaryListCode (binaryListCode rationalEntryBinaryCode) rows) + (binaryListCode rationalEntryBinaryCode (q :: qs)) + (rawRatBinaryCode acc) bound) = + rawRatBinaryCode + (rawNearbyCoordinateLower + (rawCertificateRegularizationScale n) q + (directedCertificatePrecision n)) := by + simpa only [nearbyMatrixSemCode] using + machineNearbyMatrixCoordinateRawCode_semCode X R C rows q qs acc bound + +theorem machineNearbyMatrixStep_semantics + {n : ℕ} (X : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℚ) + (bound : List Bool) (s : NearbyMatrixSemState) (budget : ℕ) + (hs : NearbyMatrixSemInvariant + (rawCertificateRegularizationScale n) + (directedCertificatePrecision n) budget s) + (hlarge : 4 + 3 * budget ≤ bound.length) : + machineNearbyMatrixStep + (nearbyMatrixSemCode (rationalOptimizerOutputCode ⟨X, R, C⟩) + bound s) = + nearbyMatrixSemCode (rationalOptimizerOutputCode ⟨X, R, C⟩) + bound (nearbyMatrixSemStep + (rawCertificateRegularizationScale n) + (directedCertificatePrecision n) s) := by + rcases s with ⟨rows, current, acc⟩ + cases current with + | nil => + cases rows with + | nil => + simp [nearbyMatrixSemCode, nearbyMatrixSemStep, + machineNearbyMatrixStep, machineNearbyMatrixAfterRow, + binaryListCode] + | cons row rows => + rw [nearbyMatrixSemCode, nearbyMatrixSemStep, + machineNearbyMatrixStep] + simp only [machineNearbyMatrixCurrent_pack, binaryListCode, + machineIfEmpty_nil, machineNearbyMatrixAfterRow, + machineNearbyMatrixRows_pack] + have hpair : pair (binaryListCode rationalEntryBinaryCode row) + (binaryListCode (binaryListCode rationalEntryBinaryCode) rows) ≠ + [] := by + intro h + have hlen := congrArg List.length h + simp at hlen + rw [machineIfEmpty_of_ne_nil_matrix _ _ _ hpair] + simp [machineNearbyMatrixLoadRow, nearbyMatrixSemCode, + machineListHead, machineListTail] + | cons q qs => + have hnext : + rawRatWidth + (acc.add (rawNearbyCoordinateLower + (rawCertificateRegularizationScale n) q + (directedCertificatePrecision n))) ≤ budget := by + have hinv := nearbyMatrixSemStep_invariant hs + have hinv' : + rawRatWidth + (acc.add (rawNearbyCoordinateLower + (rawCertificateRegularizationScale n) q + (directedCertificatePrecision n))) + + rawNearbyListCost (rawCertificateRegularizationScale n) + (directedCertificatePrecision n) qs + + rawNearbyRowsCost (rawCertificateRegularizationScale n) + (directedCertificatePrecision n) rows ≤ budget := by + simpa only [NearbyMatrixSemInvariant, nearbyMatrixSemStep] using hinv + omega + have hcode : + (rawRatBinaryCode + (acc.add (rawNearbyCoordinateLower + (rawCertificateRegularizationScale n) q + (directedCertificatePrecision n)))).length ≤ bound.length := + (rawRatBinaryCode_length_le_width _).trans + ((Nat.add_le_add_left (Nat.mul_le_mul_left 3 hnext) 4).trans + hlarge) + rw [nearbyMatrixSemCode, nearbyMatrixSemStep, + machineNearbyMatrixStep] + simp only [machineNearbyMatrixCurrent_pack] + rw [machineIfEmpty_of_ne_nil_matrix _ _ _ + (binaryListCode_cons_ne_nil rationalEntryBinaryCode q qs)] + simp only [machineNearbyMatrixProcessEntry, + machineNearbyMatrixSource_pack, machineNearbyMatrixRows_pack, + machineNearbyMatrixCurrent_pack, machineNearbyMatrixAcc_pack, + machineNearbyMatrixBound_pack, machineListTail_cons, + machineNearbyMatrixNextAcc, machineNearbyMatrixCandidate, + machineNearbyMatrixCoordinateRawCode_pack] + rw [machineRawRatAddCode_encode] + rw [(List.take_eq_self_iff _).mpr hcode] + rfl + +theorem machineNearbyMatrixIterate_semantics + {n : ℕ} (X : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℚ) + (bound : List Bool) (s : NearbyMatrixSemState) (budget : ℕ) + (hs : NearbyMatrixSemInvariant + (rawCertificateRegularizationScale n) + (directedCertificatePrecision n) budget s) + (hlarge : 4 + 3 * budget ≤ bound.length) : ∀ k, + (machineNearbyMatrixStep)^[k] + (nearbyMatrixSemCode (rationalOptimizerOutputCode ⟨X, R, C⟩) + bound s) = + nearbyMatrixSemCode (rationalOptimizerOutputCode ⟨X, R, C⟩) + bound + ((nearbyMatrixSemStep (rawCertificateRegularizationScale n) + (directedCertificatePrecision n))^[k] s) := by + intro k + have hinv : ∀ t : ℕ, + NearbyMatrixSemInvariant (rawCertificateRegularizationScale n) + (directedCertificatePrecision n) budget + ((nearbyMatrixSemStep (rawCertificateRegularizationScale n) + (directedCertificatePrecision n))^[t] s) := by + intro t + induction t with + | zero => exact hs + | succ t iht => + rw [Function.iterate_succ_apply'] + exact nearbyMatrixSemStep_invariant iht + induction k with + | zero => rfl + | succ k ih => + rw [Function.iterate_succ_apply', Function.iterate_succ_apply', ih] + exact machineNearbyMatrixStep_semantics X R C bound _ budget + (hinv k) hlarge + +theorem nearbyMatrixSem_processRow + (tau : RawRat) (p : ℕ) (rows : List (List ℚ)) + (row : List ℚ) (acc : RawRat) : + (nearbyMatrixSemStep tau p)^[row.length] + ⟨rows, row, acc⟩ = + ⟨rows, [], rawNearbyListSum tau p acc row⟩ := by + induction row generalizing acc with + | nil => rfl + | cons q qs ih => + rw [List.length_cons, Function.iterate_succ_apply, + nearbyMatrixSemStep, ih] + rfl + +theorem nearbyMatrixSem_processRows + (tau : RawRat) (p : ℕ) (rows : List (List ℚ)) (acc : RawRat) : + (nearbyMatrixSemStep tau p)^[matrixNonnegativeRowsWork rows] + ⟨rows, [], acc⟩ = + ⟨[], [], rawNearbyRowsSum tau p acc rows⟩ := by + induction rows generalizing acc with + | nil => rfl + | cons row rows ih => + rw [matrixNonnegativeRowsWork, show 1 + row.length + + matrixNonnegativeRowsWork rows = + matrixNonnegativeRowsWork rows + row.length + 1 by omega, + Function.iterate_add_apply, Function.iterate_add_apply, + Function.iterate_one, nearbyMatrixSemStep, + nearbyMatrixSem_processRow, ih, rawNearbyRowsSum] + +theorem machineNearbyMatrix_done_iterate + (extra : ℕ) (source : List Bool) (acc : RawRat) (bound : List Bool) : + (machineNearbyMatrixStep)^[extra] + (machineNearbyMatrixPack source [] [] (rawRatBinaryCode acc) bound) = + machineNearbyMatrixPack source [] [] (rawRatBinaryCode acc) bound := by + induction extra with + | zero => rfl + | succ k ih => + rw [Function.iterate_succ_apply', ih] + simp [machineNearbyMatrixStep, machineNearbyMatrixAfterRow] + +theorem machineNearbyMatrixRawSumCode_encode_of_large + {n : ℕ} (X : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℚ) + (hlarge : + 4 + 3 * (1 + rawNearbyRowsCost + (rawCertificateRegularizationScale n) + (directedCertificatePrecision n) (rationalMatrixRows X)) ≤ + (machineNearbyMatrixInputBound + (rationalOptimizerOutputCode ⟨X, R, C⟩)).length) : + machineNearbyMatrixRawSumCode + (rationalOptimizerOutputCode ⟨X, R, C⟩) = + rawRatBinaryCode + (rawNearbyRowsSum (rawCertificateRegularizationScale n) + (directedCertificatePrecision n) RawRat.zero + (rationalMatrixRows X)) := by + let rows := rationalMatrixRows X + let word := rationalOptimizerOutputCode ⟨X, R, C⟩ + let tau := rawCertificateRegularizationScale n + let p := directedCertificatePrecision n + let s : NearbyMatrixSemState := ⟨rows, [], RawRat.zero⟩ + let budget := 1 + rawNearbyRowsCost tau p rows + have hrowsLength : + (binaryListCode (binaryListCode rationalEntryBinaryCode) rows).length ≤ + word.length := by + calc + _ = (machineNearbyMatrixRowsWord word).length := by + simpa only [word, rows] using congrArg List.length + (machineNearbyMatrixRowsWord_encode X R C).symm + _ ≤ word.length := by + exact (machinePairSecond_length_le + (machineOptimizerMatrixWord word)).trans + (machinePairFirst_length_le word) + have hinv : NearbyMatrixSemInvariant tau p budget s := by + simp [NearbyMatrixSemInvariant, s, budget, rawNearbyListCost, + rawRatWidth_zero] + have hwork : matrixNonnegativeRowsWork rows ≤ word.length := + (binaryListCode_length_ge_work rows).trans hrowsLength + have hsplit : word.length = + (word.length - matrixNonnegativeRowsWork rows) + + matrixNonnegativeRowsWork rows := by omega + have hinit : machineNearbyMatrixInit word = + nearbyMatrixSemCode word (machineNearbyMatrixInputBound word) s := by + simp [machineNearbyMatrixInit, nearbyMatrixSemCode, s, word, rows, + binaryListCode, machineNearbyMatrixRowsWord] + have hlarge' : + 4 + 3 * budget ≤ (machineNearbyMatrixInputBound word).length := by + simpa only [budget, tau, p, rows, word] using hlarge + rw [machineNearbyMatrixRawSumCode, machineNearbyMatrixFinalState, + hsplit, Function.iterate_add_apply, hinit, + machineNearbyMatrixIterate_semantics X R C + (machineNearbyMatrixInputBound word) s budget hinv hlarge', + nearbyMatrixSem_processRows] + simp only [nearbyMatrixSemCode, binaryListCode] + rw [machineNearbyMatrix_done_iterate] + simp [rows] + +@[simp] theorem machineNearbyMatrixRawSumCode_encode + {n : ℕ} (X : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℚ) : + machineNearbyMatrixRawSumCode + (rationalOptimizerOutputCode ⟨X, R, C⟩) = + rawRatBinaryCode + (rawNearbyRowsSum (rawCertificateRegularizationScale n) + (directedCertificatePrecision n) RawRat.zero + (rationalMatrixRows X)) := by + apply machineNearbyMatrixRawSumCode_encode_of_large X R C + let word := rationalOptimizerOutputCode ⟨X, R, C⟩ + have hcost := rawNearbyRowsCost_le_optimizer_word X R C + have hruler := machineNearbyMatrixInputBound_length_dominates word + dsimp only [word] at hruler + omega + +theorem rawNearbyListSum_value (tau : RawRat) (p : ℕ) + (acc : RawRat) : ∀ xs : List ℚ, + (rawNearbyListSum tau p acc xs).value = + acc.value + (xs.map (directedNearbyCoordinateLower tau.value · p)).sum := by + intro xs + induction xs generalizing acc with + | nil => simp [rawNearbyListSum] + | cons q qs ih => + rw [rawNearbyListSum, ih] + simp [rawNearbyCoordinateLower_value, add_assoc] + +theorem rawNearbyRowsSum_value (tau : RawRat) (p : ℕ) + (acc : RawRat) : ∀ rows : List (List ℚ), + (rawNearbyRowsSum tau p acc rows).value = + acc.value + + (rows.map fun row => + (row.map (directedNearbyCoordinateLower tau.value · p)).sum).sum := by + intro rows + induction rows generalizing acc with + | nil => simp [rawNearbyRowsSum] + | cons row rows ih => + rw [rawNearbyRowsSum, ih, rawNearbyListSum_value] + simp [add_assoc] + +theorem rationalMatrixRows_nearby_sum {n : ℕ} + (tau : ℚ) (X : Matrix (Fin n) (Fin n) ℚ) (p : ℕ) : + ((rationalMatrixRows X).map fun row => + (row.map (directedNearbyCoordinateLower tau · p)).sum).sum = + ∑ i, ∑ j, directedNearbyCoordinateLower tau (X i j) p := by + simp [rationalMatrixRows, List.sum_ofFn] + +theorem rawNearbyRowsSum_certificate_value {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) : + (rawNearbyRowsSum (rawCertificateRegularizationScale n) + (directedCertificatePrecision n) RawRat.zero + (rationalMatrixRows X)).value = + ∑ i, ∑ j, directedNearbyCoordinateLower + (explicitRegularizationScale n) (X i j) + (directedCertificatePrecision n) := by + rw [rawNearbyRowsSum_value, rawCertificateRegularizationScale_value, + rationalMatrixRows_nearby_sum] + simp + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineNestedMatrixMemory.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineNestedMatrixMemory.lean new file mode 100644 index 0000000000..9c1fff4cd2 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineNestedMatrixMemory.lean @@ -0,0 +1,118 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineListIndex +import LeanPool.BeyondBethe.BeyondBethe.MachineListUpdate + +/-! # Machine Nested Matrix Memory -/ + +namespace BeyondBethe + +open Complexity + +/-! +# Generic finite-word memory for nested matrices + +These accessors operate on a bare `binaryListCode (binaryListCode encode) M`. +They are independent of the element type and will be used for rational +ellipsoid bases as well as intermediate matrices. +-/ + +/-- Input: `pair rowUnary (pair columnUnary nestedMatrixCode)`. -/ +def machineNestedMatrixEntryAtUnary (word : List Bool) : List Bool := + let rowUnary := machinePairFirst word + let rest := machinePairSecond word + let columnUnary := machinePairFirst rest + let matrixCode := machinePairSecond rest + let rowCode := machineListIndex (pair rowUnary matrixCode) + machineListIndex (pair columnUnary rowCode) + +/-- Input: +`pair rowUnary (pair columnUnary (pair replacement nestedMatrixCode))`. -/ +def machineNestedMatrixUpdateAtUnary (word : List Bool) : List Bool := + let rowUnary := machinePairFirst word + let restOne := machinePairSecond word + let columnUnary := machinePairFirst restOne + let restTwo := machinePairSecond restOne + let replacement := machinePairFirst restTwo + let matrixCode := machinePairSecond restTwo + let rowCode := machineListIndex (pair rowUnary matrixCode) + let updatedRow := machineListUpdate + (pair columnUnary (pair replacement rowCode)) + machineListUpdate (pair rowUnary (pair updatedRow matrixCode)) + +theorem machineNestedMatrixEntryAtUnary_mem_FP : + machineNestedMatrixEntryAtUnary ∈ FP := by + have hrow := machinePairFirst_mem_FP + have hrest := machinePairSecond_mem_FP + have hcolumn := machineCompose_mem_FP hrest machinePairFirst_mem_FP + have hmatrix := machineCompose_mem_FP hrest machinePairSecond_mem_FP + have hrowPayload := machinePair_mem_FP hrow hmatrix + have hrowCode := machineCompose_mem_FP hrowPayload machineListIndex_mem_FP + have hentryPayload := machinePair_mem_FP hcolumn hrowCode + simpa only [machineNestedMatrixEntryAtUnary] using + machineCompose_mem_FP hentryPayload machineListIndex_mem_FP + +theorem machineNestedMatrixUpdateAtUnary_mem_FP : + machineNestedMatrixUpdateAtUnary ∈ FP := by + have hrow := machinePairFirst_mem_FP + have hrestOne := machinePairSecond_mem_FP + have hcolumn := machineCompose_mem_FP hrestOne machinePairFirst_mem_FP + have hrestTwo := machineCompose_mem_FP hrestOne machinePairSecond_mem_FP + have hreplacement := machineCompose_mem_FP hrestTwo machinePairFirst_mem_FP + have hmatrix := machineCompose_mem_FP hrestTwo machinePairSecond_mem_FP + have hrowPayload := machinePair_mem_FP hrow hmatrix + have hrowCode := machineCompose_mem_FP hrowPayload machineListIndex_mem_FP + have hupdateRowPayload := machinePair_mem_FP hcolumn + (machinePair_mem_FP hreplacement hrowCode) + have hupdatedRow := machineCompose_mem_FP hupdateRowPayload + machineListUpdate_mem_FP + have hupdateMatrixPayload := machinePair_mem_FP hrow + (machinePair_mem_FP hupdatedRow hmatrix) + simpa only [machineNestedMatrixUpdateAtUnary] using + machineCompose_mem_FP hupdateMatrixPayload machineListUpdate_mem_FP + +@[simp] theorem machineNestedMatrixEntryAtUnary_encode + {α : Type*} (encode : α → List Bool) (M : List (List α)) + (i j : ℕ) (hi : i < M.length) (hj : j < M[i].length) : + machineNestedMatrixEntryAtUnary + (pair (List.replicate i true) + (pair (List.replicate j true) + (binaryListCode (binaryListCode encode) M))) = + encode M[i][j] := by + rw [machineNestedMatrixEntryAtUnary] + simp only [machinePairFirst_pair, machinePairSecond_pair] + rw [machineListIndex_binaryListCode (binaryListCode encode) M i hi] + exact machineListIndex_binaryListCode encode M[i] j hj + +@[simp] theorem machineNestedMatrixUpdateAtUnary_encode + {α : Type*} (encode : α → List Bool) (M : List (List α)) + (i j : ℕ) (replacement : α) + (hi : i < M.length) (hj : j < M[i].length) : + machineNestedMatrixUpdateAtUnary + (pair (List.replicate i true) + (pair (List.replicate j true) + (pair (encode replacement) + (binaryListCode (binaryListCode encode) M)))) = + binaryListCode (binaryListCode encode) + (M.set i (M[i].set j replacement)) := by + rw [machineNestedMatrixUpdateAtUnary] + simp only [machinePairFirst_pair, machinePairSecond_pair] + rw [machineListIndex_binaryListCode (binaryListCode encode) M i hi] + change machineListUpdate + (pair (List.replicate i true) + (pair + (machineListUpdate + (machineListUpdateCanonicalInput encode M[i] replacement j)) + (binaryListCode (binaryListCode encode) M))) = _ + rw [machineListUpdate_binaryListCode encode M[i] replacement j hj] + change machineListUpdate + (machineListUpdateCanonicalInput (binaryListCode encode) M + (M[i].set j replacement) i) = _ + exact machineListUpdate_binaryListCode (binaryListCode encode) M + (M[i].set j replacement) i hi + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerBisectionLoop.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerBisectionLoop.lean new file mode 100644 index 0000000000..c07731293d --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerBisectionLoop.lean @@ -0,0 +1,583 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerFeasibilityCall +import LeanPool.BeyondBethe.BeyondBethe.ScannedBetheBisection +import Mathlib.Tactic + +/-! +# A finite-word dyadic bisection loop for the Bethe optimizer + +Rather than storing two rational endpoints whose concrete representations +change at every step, the machine stores a natural interval index `k` and a +unary depth `t`. They represent the adjacent dyadic endpoints + +`L + k (H - L) / 2^t` and `L + (k + 1) (H - L) / 2^t`. + +An exhausted midpoint appends a one bit to the branch index; an accepted +midpoint appends a zero bit. Consequently the persistent state grows by at +most one bit in each of its two mutable fields. This gives a direct global +polynomial state envelope for the bounded iteration. +-/ + +namespace BeyondBethe + +open Complexity + +/-! ## Exact dyadic thresholds -/ + +def rawOptimizerInitialLow (n : ℕ) : RawRat := + (rawOptimizerTwiceNSquare n).neg + +def optimizerDyadicThreshold {m : ℕ} + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (k t : ℕ) : ℚ := + betheNegativeObjectiveLower m + + (k : ℚ) / 2 ^ t * explicitOptimizerInitialWidth A + +def machineOptimizerInitialLowEntryCode + (word : List Bool) : List Bool := + machineNormalizeRawRatEntryCode + (machineRawRatNegCode + (machineOptimizerTwiceNSquareForWidthRawCode word)) + +def machineOptimizerInitialWidthEntryCodeForBisection + (word : List Bool) : List Bool := + machineNormalizeRawRatEntryCode + (machineExplicitOptimizerInitialWidthRawCode word) + +/-! ## Persistent state -/ + +def machineOptimizerBisectionStatePack + (source ruler index depth : List Bool) : List Bool := + pair source (pair ruler (pair index depth)) + +def machineOptimizerBisectionStateSource + (state : List Bool) : List Bool := + machinePairFirst state + +def machineOptimizerBisectionStateRuler + (state : List Bool) : List Bool := + machinePairFirst (machinePairSecond state) + +def machineOptimizerBisectionStateIndex + (state : List Bool) : List Bool := + machinePairFirst (machinePairSecond (machinePairSecond state)) + +def machineOptimizerBisectionStateDepth + (state : List Bool) : List Bool := + machinePairSecond (machinePairSecond (machinePairSecond state)) + +def machineOptimizerBisectionInit (word : List Bool) : List Bool := + machineOptimizerBisectionStatePack word + (machineExplicitOptimizerBisectionStepsRuler word) [] [] + +/-! ## Reconstruct the queried midpoint -/ + +def machineOptimizerBisectionEvenIndexBits + (state : List Bool) : List Bool := + machineBinaryMulBits + (pair (machineOptimizerBisectionStateIndex state) [false, true]) + +def machineOptimizerBisectionOddIndexBits + (state : List Bool) : List Bool := + machineBinaryAddBits + (pair (machineOptimizerBisectionEvenIndexBits state) [true]) + +def machineOptimizerBisectionNextDepth + (state : List Bool) : List Bool := + true :: machineOptimizerBisectionStateDepth state + +def machineOptimizerBisectionDenominatorBits + (state : List Bool) : List Bool := + machineDirectedLogPowerTwoBits + (machineOptimizerBisectionNextDepth state) + +def machineOptimizerBisectionFractionRawCode + (state : List Bool) : List Bool := + pair + (machineNaturalIntegerCode + (machineOptimizerBisectionOddIndexBits state)) + (machineOptimizerBisectionDenominatorBits state) + +def machineOptimizerBisectionScaledFractionRawCode + (state : List Bool) : List Bool := + machineRawRatMulCode + (pair (machineOptimizerBisectionFractionRawCode state) + (machineOptimizerInitialWidthEntryCodeForBisection + (machineOptimizerBisectionStateSource state))) + +def machineOptimizerBisectionMidpointUnnormalizedRawCode + (state : List Bool) : List Bool := + machineRawRatAddCode + (pair + (machineOptimizerInitialLowEntryCode + (machineOptimizerBisectionStateSource state)) + (machineOptimizerBisectionScaledFractionRawCode state)) + +def machineOptimizerBisectionMidpointRawCode + (state : List Bool) : List Bool := + machineNormalizeRawRatEntryCode + (machineOptimizerBisectionMidpointUnnormalizedRawCode state) + +def machineOptimizerBisectionFeasibilityCall + (state : List Bool) : List Bool := + pair (machineOptimizerBisectionStateSource state) + (machineOptimizerBisectionMidpointRawCode state) + +def machineOptimizerBisectionFeasibilityResult + (state : List Bool) : List Bool := + machineExplicitBetheThresholdFeasibilityCode + (machineOptimizerBisectionFeasibilityCall state) + +def machineOptimizerBisectionExhaustedBit + (state : List Bool) : List Bool := + machineHeadBit + (machinePairFirst + (machineOptimizerBisectionFeasibilityResult state)) + +/-! ## One branch and the bounded iteration -/ + +def machineOptimizerBisectionNextIndexBits + (state : List Bool) : List Bool := + machineIfHead (machineOptimizerBisectionExhaustedBit state) + (machineOptimizerBisectionOddIndexBits state) + (machineOptimizerBisectionEvenIndexBits state) + +def machineOptimizerBisectionStep (state : List Bool) : List Bool := + machineOptimizerBisectionStatePack + (machineOptimizerBisectionStateSource state) + (machineOptimizerBisectionStateRuler state) + (machineOptimizerBisectionNextIndexBits state) + (machineOptimizerBisectionNextDepth state) + +def machineOptimizerBisectionFinalState + (word : List Bool) : List Bool := + (machineOptimizerBisectionStep)^[( + machineExplicitOptimizerBisectionStepsRuler word).length] + (machineOptimizerBisectionInit word) + +/-! ## Re-query the certified upper endpoint -/ + +def machineOptimizerBisectionHighIndexBits + (state : List Bool) : List Bool := + machineBinaryAddBits + (pair (machineOptimizerBisectionStateIndex state) [true]) + +def machineOptimizerBisectionHighFractionRawCode + (state : List Bool) : List Bool := + pair + (machineNaturalIntegerCode + (machineOptimizerBisectionHighIndexBits state)) + (machineDirectedLogPowerTwoBits + (machineOptimizerBisectionStateDepth state)) + +def machineOptimizerBisectionHighScaledRawCode + (state : List Bool) : List Bool := + machineRawRatMulCode + (pair (machineOptimizerBisectionHighFractionRawCode state) + (machineOptimizerInitialWidthEntryCodeForBisection + (machineOptimizerBisectionStateSource state))) + +def machineOptimizerBisectionHighUnnormalizedRawCode + (state : List Bool) : List Bool := + machineRawRatAddCode + (pair + (machineOptimizerInitialLowEntryCode + (machineOptimizerBisectionStateSource state)) + (machineOptimizerBisectionHighScaledRawCode state)) + +def machineOptimizerBisectionHighRawCode + (state : List Bool) : List Bool := + machineNormalizeRawRatEntryCode + (machineOptimizerBisectionHighUnnormalizedRawCode state) + +def machineExplicitBetheOptimizerFeasibilityResultCode + (word : List Bool) : List Bool := + let state := machineOptimizerBisectionFinalState word + machineExplicitBetheThresholdFeasibilityCode + (pair word (machineOptimizerBisectionHighRawCode state)) + +def machineExplicitBetheOptimizerPointCode + (word : List Bool) : List Bool := + machinePairSecond + (machineExplicitBetheOptimizerFeasibilityResultCode word) + +/-! ## Polynomial-time closure -/ + +theorem machineOptimizerInitialLowEntryCode_mem_FP : + machineOptimizerInitialLowEntryCode ∈ FP := by + have hneg := machineCompose_mem_FP + machineOptimizerTwiceNSquareForWidthRawCode_mem_FP + machineRawRatNegCode_mem_FP + simpa only [machineOptimizerInitialLowEntryCode] using + machineCompose_mem_FP hneg machineNormalizeRawRatEntryCode_mem_FP + +theorem machineOptimizerInitialWidthEntryCodeForBisection_mem_FP : + machineOptimizerInitialWidthEntryCodeForBisection ∈ FP := by + simpa only [machineOptimizerInitialWidthEntryCodeForBisection] using + machineCompose_mem_FP machineExplicitOptimizerInitialWidthRawCode_mem_FP + machineNormalizeRawRatEntryCode_mem_FP + +theorem machineOptimizerBisectionStateSource_mem_FP : + machineOptimizerBisectionStateSource ∈ FP := machinePairFirst_mem_FP + +theorem machineOptimizerBisectionStateRuler_mem_FP : + machineOptimizerBisectionStateRuler ∈ FP := by + simpa only [machineOptimizerBisectionStateRuler] using + machineCompose_mem_FP machinePairSecond_mem_FP machinePairFirst_mem_FP + +theorem machineOptimizerBisectionStateIndex_mem_FP : + machineOptimizerBisectionStateIndex ∈ FP := by + have htail := machineCompose_mem_FP machinePairSecond_mem_FP + machinePairSecond_mem_FP + simpa only [machineOptimizerBisectionStateIndex] using + machineCompose_mem_FP htail machinePairFirst_mem_FP + +theorem machineOptimizerBisectionStateDepth_mem_FP : + machineOptimizerBisectionStateDepth ∈ FP := by + have htail := machineCompose_mem_FP machinePairSecond_mem_FP + machinePairSecond_mem_FP + simpa only [machineOptimizerBisectionStateDepth] using + machineCompose_mem_FP htail machinePairSecond_mem_FP + +theorem machineOptimizerBisectionInit_mem_FP : + machineOptimizerBisectionInit ∈ FP := by + simpa only [machineOptimizerBisectionInit] using + machinePair_mem_FP id_mem_FP + (machinePair_mem_FP machineExplicitOptimizerBisectionStepsRuler_mem_FP + (machinePair_mem_FP (machineConst_mem_FP []) + (machineConst_mem_FP []))) + +theorem machineOptimizerBisectionEvenIndexBits_mem_FP : + machineOptimizerBisectionEvenIndexBits ∈ FP := by + simpa only [machineOptimizerBisectionEvenIndexBits] using + machineCompose_mem_FP + (machinePair_mem_FP machineOptimizerBisectionStateIndex_mem_FP + (machineConst_mem_FP [false, true])) + machineBinaryMulBits_mem_FP + +theorem machineOptimizerBisectionOddIndexBits_mem_FP : + machineOptimizerBisectionOddIndexBits ∈ FP := by + simpa only [machineOptimizerBisectionOddIndexBits] using + machineCompose_mem_FP + (machinePair_mem_FP machineOptimizerBisectionEvenIndexBits_mem_FP + (machineConst_mem_FP [true])) + machineBinaryAddBits_mem_FP + +theorem machineOptimizerBisectionNextDepth_mem_FP : + machineOptimizerBisectionNextDepth ∈ FP := by + simpa only [machineOptimizerBisectionNextDepth] using + machineCompose_mem_FP machineOptimizerBisectionStateDepth_mem_FP + (machinePrepend_mem_FP true) + +theorem machineOptimizerBisectionDenominatorBits_mem_FP : + machineOptimizerBisectionDenominatorBits ∈ FP := by + simpa only [machineOptimizerBisectionDenominatorBits] using + machineCompose_mem_FP machineOptimizerBisectionNextDepth_mem_FP + machineDirectedLogPowerTwoBits_mem_FP + +theorem machineOptimizerBisectionFractionRawCode_mem_FP : + machineOptimizerBisectionFractionRawCode ∈ FP := by + have hnum := machineCompose_mem_FP + machineOptimizerBisectionOddIndexBits_mem_FP + machineNaturalIntegerCode_mem_FP + exact machinePair_mem_FP hnum + machineOptimizerBisectionDenominatorBits_mem_FP + +theorem machineOptimizerBisectionScaledFractionRawCode_mem_FP : + machineOptimizerBisectionScaledFractionRawCode ∈ FP := by + have hwidth := machineCompose_mem_FP + machineOptimizerBisectionStateSource_mem_FP + machineOptimizerInitialWidthEntryCodeForBisection_mem_FP + simpa only [machineOptimizerBisectionScaledFractionRawCode] using + machineCompose_mem_FP + (machinePair_mem_FP + machineOptimizerBisectionFractionRawCode_mem_FP hwidth) + machineRawRatMulCode_mem_FP + +theorem machineOptimizerBisectionMidpointUnnormalizedRawCode_mem_FP : + machineOptimizerBisectionMidpointUnnormalizedRawCode ∈ FP := by + have hlow := machineCompose_mem_FP + machineOptimizerBisectionStateSource_mem_FP + machineOptimizerInitialLowEntryCode_mem_FP + simpa only [machineOptimizerBisectionMidpointUnnormalizedRawCode] using + machineCompose_mem_FP + (machinePair_mem_FP hlow + machineOptimizerBisectionScaledFractionRawCode_mem_FP) + machineRawRatAddCode_mem_FP + +theorem machineOptimizerBisectionMidpointRawCode_mem_FP : + machineOptimizerBisectionMidpointRawCode ∈ FP := by + simpa only [machineOptimizerBisectionMidpointRawCode] using + machineCompose_mem_FP + machineOptimizerBisectionMidpointUnnormalizedRawCode_mem_FP + machineNormalizeRawRatEntryCode_mem_FP + +theorem machineOptimizerBisectionFeasibilityCall_mem_FP : + machineOptimizerBisectionFeasibilityCall ∈ FP := + machinePair_mem_FP machineOptimizerBisectionStateSource_mem_FP + machineOptimizerBisectionMidpointRawCode_mem_FP + +theorem machineOptimizerBisectionFeasibilityResult_mem_FP : + machineOptimizerBisectionFeasibilityResult ∈ FP := by + simpa only [machineOptimizerBisectionFeasibilityResult] using + machineCompose_mem_FP machineOptimizerBisectionFeasibilityCall_mem_FP + machineExplicitBetheThresholdFeasibilityCode_mem_FP + +theorem machineOptimizerBisectionExhaustedBit_mem_FP : + machineOptimizerBisectionExhaustedBit ∈ FP := by + have htag := machineCompose_mem_FP + machineOptimizerBisectionFeasibilityResult_mem_FP + machinePairFirst_mem_FP + simpa only [machineOptimizerBisectionExhaustedBit] using + machineCompose_mem_FP htag machineHeadBit_mem_FP + +theorem machineOptimizerBisectionNextIndexBits_mem_FP : + machineOptimizerBisectionNextIndexBits ∈ FP := by + exact machineIfHead_mem_FP machineOptimizerBisectionExhaustedBit_mem_FP + machineOptimizerBisectionOddIndexBits_mem_FP + machineOptimizerBisectionEvenIndexBits_mem_FP + +theorem machineOptimizerBisectionStep_mem_FP : + machineOptimizerBisectionStep ∈ FP := by + exact machinePair_mem_FP machineOptimizerBisectionStateSource_mem_FP + (machinePair_mem_FP machineOptimizerBisectionStateRuler_mem_FP + (machinePair_mem_FP machineOptimizerBisectionNextIndexBits_mem_FP + machineOptimizerBisectionNextDepth_mem_FP)) + +/-! ## A global state envelope for Cobham iteration -/ + +@[simp] theorem machineOptimizerBisectionStateSource_pack + (source ruler index depth : List Bool) : + machineOptimizerBisectionStateSource + (machineOptimizerBisectionStatePack source ruler index depth) = + source := by + simp [machineOptimizerBisectionStateSource, + machineOptimizerBisectionStatePack] + +@[simp] theorem machineOptimizerBisectionStateRuler_pack + (source ruler index depth : List Bool) : + machineOptimizerBisectionStateRuler + (machineOptimizerBisectionStatePack source ruler index depth) = + ruler := by + simp [machineOptimizerBisectionStateRuler, + machineOptimizerBisectionStatePack] + +@[simp] theorem machineOptimizerBisectionStateIndex_pack + (source ruler index depth : List Bool) : + machineOptimizerBisectionStateIndex + (machineOptimizerBisectionStatePack source ruler index depth) = + index := by + simp [machineOptimizerBisectionStateIndex, + machineOptimizerBisectionStatePack] + +@[simp] theorem machineOptimizerBisectionStateDepth_pack + (source ruler index depth : List Bool) : + machineOptimizerBisectionStateDepth + (machineOptimizerBisectionStatePack source ruler index depth) = + depth := by + simp [machineOptimizerBisectionStateDepth, + machineOptimizerBisectionStatePack] + +def MachineOptimizerBisectionStateBound + (word : List Bool) (iterations : ℕ) (state : List Bool) : Prop := + state = machineOptimizerBisectionStatePack + (machineOptimizerBisectionStateSource state) + (machineOptimizerBisectionStateRuler state) + (machineOptimizerBisectionStateIndex state) + (machineOptimizerBisectionStateDepth state) ∧ + machineOptimizerBisectionStateSource state = word ∧ + machineOptimizerBisectionStateRuler state = + machineExplicitOptimizerBisectionStepsRuler word ∧ + (∃ k : ℕ, + machineOptimizerBisectionStateIndex state = k.bits ∧ + k < 2 ^ iterations) ∧ + (machineOptimizerBisectionStateDepth state).length = iterations + +theorem machineOptimizerBisectionInit_bound (word : List Bool) : + MachineOptimizerBisectionStateBound word 0 + (machineOptimizerBisectionInit word) := by + simp only [MachineOptimizerBisectionStateBound, + machineOptimizerBisectionInit, + machineOptimizerBisectionStateSource_pack, + machineOptimizerBisectionStateRuler_pack, + machineOptimizerBisectionStateIndex_pack, + machineOptimizerBisectionStateDepth_pack, List.length_nil] + exact ⟨trivial, trivial, trivial, ⟨0, rfl, by norm_num⟩, trivial⟩ + +theorem machineOptimizerBisectionStep_bound + {word state : List Bool} {iterations : ℕ} + (hs : MachineOptimizerBisectionStateBound word iterations state) : + MachineOptimizerBisectionStateBound word (iterations + 1) + (machineOptimizerBisectionStep state) := by + rcases hs with ⟨hdecomp, hsource, hruler, + ⟨k, hindex, hk⟩, hdepth⟩ + have heven : machineOptimizerBisectionEvenIndexBits state = + (2 * k).bits := by + rw [machineOptimizerBisectionEvenIndexBits, hindex] + change machineBinaryMulBits (pair k.bits (2 : ℕ).bits) = _ + rw [machineBinaryMulBits_pair_natBits] + congr 1 + omega + have hodd : machineOptimizerBisectionOddIndexBits state = + (2 * k + 1).bits := by + rw [machineOptimizerBisectionOddIndexBits, heven] + change machineBinaryAddBits (pair (2 * k).bits (1 : ℕ).bits) = _ + rw [machineBinaryAddBits_pair_natBits] + simp only [machineOptimizerBisectionStep, + MachineOptimizerBisectionStateBound, + machineOptimizerBisectionStateSource_pack, + machineOptimizerBisectionStateRuler_pack, + machineOptimizerBisectionStateIndex_pack, + machineOptimizerBisectionStateDepth_pack] + refine ⟨by trivial, hsource, hruler, ?_, ?_⟩ + · rw [machineOptimizerBisectionNextIndexBits, + machineOptimizerBisectionExhaustedBit] + cases hflag : machinePairFirst + (machineOptimizerBisectionFeasibilityResult state) with + | nil => + rw [machineHeadBit_nil, machineIfHead_false] + refine ⟨2 * k, heven, ?_⟩ + rw [pow_succ] + omega + | cons bit tail => + cases bit with + | false => + rw [machineHeadBit_cons, machineIfHead_false] + refine ⟨2 * k, heven, ?_⟩ + rw [pow_succ] + omega + | true => + rw [machineHeadBit_cons, machineIfHead_true] + refine ⟨2 * k + 1, hodd, ?_⟩ + rw [pow_succ] + omega + · simp [machineOptimizerBisectionNextDepth, hdepth] + +theorem machineOptimizerBisectionIterate_bound (word : List Bool) : ∀ k, + MachineOptimizerBisectionStateBound word k + ((machineOptimizerBisectionStep)^[k] + (machineOptimizerBisectionInit word)) := by + intro k + induction k with + | zero => exact machineOptimizerBisectionInit_bound word + | succ k ih => + rw [Function.iterate_succ_apply'] + simpa only [Nat.succ_eq_add_one] using + machineOptimizerBisectionStep_bound ih + +def machineOptimizerBisectionWidth (word : List Bool) : List Bool := + let envelope := false :: + (word ++ machineExplicitOptimizerBisectionStepsRuler word) + machineOptimizerBisectionStatePack envelope envelope envelope envelope + +theorem machineOptimizerBisectionWidth_mem_FP : + machineOptimizerBisectionWidth ∈ FP := by + have happend := machineAppend_mem_FP id_mem_FP + machineExplicitOptimizerBisectionStepsRuler_mem_FP + have henvelope : (fun word : List Bool ↦ + false :: (word ++ machineExplicitOptimizerBisectionStepsRuler word)) + ∈ FP := machineCompose_mem_FP happend (machinePrepend_mem_FP false) + simpa only [machineOptimizerBisectionWidth] using + machinePair_mem_FP henvelope + (machinePair_mem_FP henvelope + (machinePair_mem_FP henvelope henvelope)) + +theorem machineOptimizerBisectionIterate_length_le_width + (word : List Bool) (iterations : ℕ) + (hiterations : iterations ≤ + (machineExplicitOptimizerBisectionStepsRuler word).length) : + ((machineOptimizerBisectionStep)^[iterations] + (machineOptimizerBisectionInit word)).length ≤ + (machineOptimizerBisectionWidth word).length := by + rcases machineOptimizerBisectionIterate_bound word iterations with + ⟨hdecomp, hsource, hruler, ⟨k, hindex, hk⟩, hdepth⟩ + have hkbits : k.bits.length ≤ iterations := by + rw [Nat.size_eq_bits_len, Nat.size_le] + exact hk + rw [hdecomp] + simp only [machineOptimizerBisectionStatePack, + machineOptimizerBisectionWidth, pair_length, List.length_cons, + List.length_append] + rw [hsource, hruler, hindex, hdepth] + omega + +theorem machineOptimizerBisectionFinalState_mem_FP : + machineOptimizerBisectionFinalState ∈ FP := by + exact Cobham.iterate_mem_FP machineOptimizerBisectionStep_mem_FP + machineOptimizerBisectionInit_mem_FP + machineExplicitOptimizerBisectionStepsRuler_mem_FP + machineOptimizerBisectionWidth_mem_FP + machineOptimizerBisectionIterate_length_le_width + +/-! ## Polynomial-time closure of the final upper-endpoint query -/ + +theorem machineOptimizerBisectionHighIndexBits_mem_FP : + machineOptimizerBisectionHighIndexBits ∈ FP := by + simpa only [machineOptimizerBisectionHighIndexBits] using + machineCompose_mem_FP + (machinePair_mem_FP machineOptimizerBisectionStateIndex_mem_FP + (machineConst_mem_FP [true])) + machineBinaryAddBits_mem_FP + +theorem machineOptimizerBisectionHighFractionRawCode_mem_FP : + machineOptimizerBisectionHighFractionRawCode ∈ FP := by + have hnum := machineCompose_mem_FP + machineOptimizerBisectionHighIndexBits_mem_FP + machineNaturalIntegerCode_mem_FP + have hden := machineCompose_mem_FP + machineOptimizerBisectionStateDepth_mem_FP + machineDirectedLogPowerTwoBits_mem_FP + exact machinePair_mem_FP hnum hden + +theorem machineOptimizerBisectionHighScaledRawCode_mem_FP : + machineOptimizerBisectionHighScaledRawCode ∈ FP := by + have hwidth := machineCompose_mem_FP + machineOptimizerBisectionStateSource_mem_FP + machineOptimizerInitialWidthEntryCodeForBisection_mem_FP + simpa only [machineOptimizerBisectionHighScaledRawCode] using + machineCompose_mem_FP + (machinePair_mem_FP + machineOptimizerBisectionHighFractionRawCode_mem_FP hwidth) + machineRawRatMulCode_mem_FP + +theorem machineOptimizerBisectionHighUnnormalizedRawCode_mem_FP : + machineOptimizerBisectionHighUnnormalizedRawCode ∈ FP := by + have hlow := machineCompose_mem_FP + machineOptimizerBisectionStateSource_mem_FP + machineOptimizerInitialLowEntryCode_mem_FP + simpa only [machineOptimizerBisectionHighUnnormalizedRawCode] using + machineCompose_mem_FP + (machinePair_mem_FP hlow + machineOptimizerBisectionHighScaledRawCode_mem_FP) + machineRawRatAddCode_mem_FP + +theorem machineOptimizerBisectionHighRawCode_mem_FP : + machineOptimizerBisectionHighRawCode ∈ FP := by + simpa only [machineOptimizerBisectionHighRawCode] using + machineCompose_mem_FP + machineOptimizerBisectionHighUnnormalizedRawCode_mem_FP + machineNormalizeRawRatEntryCode_mem_FP + +theorem machineExplicitBetheOptimizerFeasibilityResultCode_mem_FP : + machineExplicitBetheOptimizerFeasibilityResultCode ∈ FP := by + have hhigh := machineCompose_mem_FP + machineOptimizerBisectionFinalState_mem_FP + machineOptimizerBisectionHighRawCode_mem_FP + have hcall := machinePair_mem_FP id_mem_FP hhigh + simpa only [machineExplicitBetheOptimizerFeasibilityResultCode] using + machineCompose_mem_FP hcall + machineExplicitBetheThresholdFeasibilityCode_mem_FP + +theorem machineExplicitBetheOptimizerPointCode_mem_FP : + machineExplicitBetheOptimizerPointCode ∈ FP := by + simpa only [machineExplicitBetheOptimizerPointCode] using + machineCompose_mem_FP + machineExplicitBetheOptimizerFeasibilityResultCode_mem_FP + machinePairSecond_mem_FP + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerBisectionSchedule.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerBisectionSchedule.lean new file mode 100644 index 0000000000..eb629e8e36 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerBisectionSchedule.lean @@ -0,0 +1,338 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerDerivedScales + +/-! +# Initial interval and bisection schedule as finite-word functions + +The initial objective width is assembled by exact rational arithmetic. The +number of bisection calls is then the sum of the canonical encoding lengths +of that width and of the optimizer gap, plus three. Both schedules are +returned in unary, so later bounded iterations can consume them directly. +-/ + +namespace BeyondBethe + +open Complexity + +def rawOptimizerObjectiveUpper (n B : ℕ) : RawRat := + ((rawOptimizerDimension n).mul (rawOptimizerBitBound B)).add + (rawOptimizerDimension n) + +def rawOptimizerTwiceInnerRadius (n B : ℕ) : RawRat := + rawOptimizerTwo.mul (rawExplicitOptimizerInnerRadius n B) + +def rawOptimizerSmoothingSlack (n B : ℕ) : RawRat := + ((rawExplicitOptimizerMix n B).mul + (rawOptimizerObjectiveRange n B)).add + (rawOptimizerTwiceInnerRadius n B) + +def rawOptimizerInitialHigh (n B : ℕ) : RawRat := + (rawOptimizerObjectiveUpper n B).add + (rawOptimizerSmoothingSlack n B) + +def rawOptimizerTwiceNSquare (n : ℕ) : RawRat := + rawOptimizerTwo.mul (rawOptimizerNSquare n) + +def rawExplicitOptimizerInitialWidth (n B : ℕ) : RawRat := + (rawOptimizerInitialHigh n B).add (rawOptimizerTwiceNSquare n) + +def machineOptimizerObjectiveUpperRawCode (word : List Bool) : List Bool := + machineRawRatAddCode + (pair (machineOptimizerNBProductRawCode word) + (machineOptimizerDimensionRawCode word)) + +def machineOptimizerTwiceInnerRadiusRawCode + (word : List Bool) : List Bool := + machineRawRatMulCode + (pair (rawRatBinaryCode rawOptimizerTwo) + (machineExplicitOptimizerInnerRadiusRawCode word)) + +def machineOptimizerMixRangeRawCode (word : List Bool) : List Bool := + machineRawRatMulCode + (pair (machineExplicitOptimizerMixRawCode word) + (machineOptimizerObjectiveRangeRawCode word)) + +def machineOptimizerSmoothingSlackRawCode + (word : List Bool) : List Bool := + machineRawRatAddCode + (pair (machineOptimizerMixRangeRawCode word) + (machineOptimizerTwiceInnerRadiusRawCode word)) + +def machineOptimizerInitialHighRawCode (word : List Bool) : List Bool := + machineRawRatAddCode + (pair (machineOptimizerObjectiveUpperRawCode word) + (machineOptimizerSmoothingSlackRawCode word)) + +def machineOptimizerTwiceNSquareForWidthRawCode + (word : List Bool) : List Bool := + machineRawRatMulCode + (pair (rawRatBinaryCode rawOptimizerTwo) + (machineOptimizerNSquareRawCode word)) + +def machineExplicitOptimizerInitialWidthRawCode + (word : List Bool) : List Bool := + machineRawRatAddCode + (pair (machineOptimizerInitialHighRawCode word) + (machineOptimizerTwiceNSquareForWidthRawCode word)) + +theorem machineOptimizerObjectiveUpperRawCode_mem_FP : + machineOptimizerObjectiveUpperRawCode ∈ FP := by + simpa only [machineOptimizerObjectiveUpperRawCode] using + machineCompose_mem_FP + (machinePair_mem_FP machineOptimizerNBProductRawCode_mem_FP + machineOptimizerDimensionRawCode_mem_FP) + machineRawRatAddCode_mem_FP + +theorem machineOptimizerTwiceInnerRadiusRawCode_mem_FP : + machineOptimizerTwiceInnerRadiusRawCode ∈ FP := by + simpa only [machineOptimizerTwiceInnerRadiusRawCode] using + machineCompose_mem_FP + (machinePair_mem_FP + (machineConst_mem_FP (rawRatBinaryCode rawOptimizerTwo)) + machineExplicitOptimizerInnerRadiusRawCode_mem_FP) + machineRawRatMulCode_mem_FP + +theorem machineOptimizerMixRangeRawCode_mem_FP : + machineOptimizerMixRangeRawCode ∈ FP := by + simpa only [machineOptimizerMixRangeRawCode] using machineCompose_mem_FP + (machinePair_mem_FP machineExplicitOptimizerMixRawCode_mem_FP + machineOptimizerObjectiveRangeRawCode_mem_FP) + machineRawRatMulCode_mem_FP + +theorem machineOptimizerSmoothingSlackRawCode_mem_FP : + machineOptimizerSmoothingSlackRawCode ∈ FP := by + simpa only [machineOptimizerSmoothingSlackRawCode] using + machineCompose_mem_FP + (machinePair_mem_FP machineOptimizerMixRangeRawCode_mem_FP + machineOptimizerTwiceInnerRadiusRawCode_mem_FP) + machineRawRatAddCode_mem_FP + +theorem machineOptimizerInitialHighRawCode_mem_FP : + machineOptimizerInitialHighRawCode ∈ FP := by + simpa only [machineOptimizerInitialHighRawCode] using machineCompose_mem_FP + (machinePair_mem_FP machineOptimizerObjectiveUpperRawCode_mem_FP + machineOptimizerSmoothingSlackRawCode_mem_FP) + machineRawRatAddCode_mem_FP + +theorem machineOptimizerTwiceNSquareForWidthRawCode_mem_FP : + machineOptimizerTwiceNSquareForWidthRawCode ∈ FP := by + simpa only [machineOptimizerTwiceNSquareForWidthRawCode] using + machineCompose_mem_FP + (machinePair_mem_FP + (machineConst_mem_FP (rawRatBinaryCode rawOptimizerTwo)) + machineOptimizerNSquareRawCode_mem_FP) + machineRawRatMulCode_mem_FP + +theorem machineExplicitOptimizerInitialWidthRawCode_mem_FP : + machineExplicitOptimizerInitialWidthRawCode ∈ FP := by + simpa only [machineExplicitOptimizerInitialWidthRawCode] using + machineCompose_mem_FP + (machinePair_mem_FP machineOptimizerInitialHighRawCode_mem_FP + machineOptimizerTwiceNSquareForWidthRawCode_mem_FP) + machineRawRatAddCode_mem_FP + +@[simp] theorem machineOptimizerObjectiveUpperRawCode_encode + {n : ℕ} (A : Matrix (Fin n) (Fin n) ℚ) : + machineOptimizerObjectiveUpperRawCode + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩) = + rawRatBinaryCode + (rawOptimizerObjectiveUpper n (rationalMatrixEntryBitBound A)) := by + rw [machineOptimizerObjectiveUpperRawCode, + machineOptimizerNBProductRawCode_encode, + machineOptimizerDimensionRawCode_encode, + machineRawRatAddCode_encode] + rfl + +@[simp] theorem machineOptimizerTwiceInnerRadiusRawCode_encode + {n : ℕ} (hn : 1 ≤ n) (A : Matrix (Fin n) (Fin n) ℚ) : + machineOptimizerTwiceInnerRadiusRawCode + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩) = + rawRatBinaryCode + (rawOptimizerTwiceInnerRadius n + (rationalMatrixEntryBitBound A)) := by + rw [machineOptimizerTwiceInnerRadiusRawCode, + machineExplicitOptimizerInnerRadiusRawCode_encode hn, + machineRawRatMulCode_encode] + rfl + +@[simp] theorem machineOptimizerMixRangeRawCode_encode + {n : ℕ} (hn : 1 ≤ n) (A : Matrix (Fin n) (Fin n) ℚ) : + machineOptimizerMixRangeRawCode + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩) = + rawRatBinaryCode + ((rawExplicitOptimizerMix n (rationalMatrixEntryBitBound A)).mul + (rawOptimizerObjectiveRange n + (rationalMatrixEntryBitBound A))) := by + rw [machineOptimizerMixRangeRawCode, + machineExplicitOptimizerMixRawCode_encode hn, + machineOptimizerObjectiveRangeRawCode_encode, + machineRawRatMulCode_encode] + +@[simp] theorem machineOptimizerSmoothingSlackRawCode_encode + {n : ℕ} (hn : 1 ≤ n) (A : Matrix (Fin n) (Fin n) ℚ) : + machineOptimizerSmoothingSlackRawCode + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩) = + rawRatBinaryCode + (rawOptimizerSmoothingSlack n + (rationalMatrixEntryBitBound A)) := by + rw [machineOptimizerSmoothingSlackRawCode, + machineOptimizerMixRangeRawCode_encode hn, + machineOptimizerTwiceInnerRadiusRawCode_encode hn, + machineRawRatAddCode_encode] + rfl + +@[simp] theorem machineOptimizerInitialHighRawCode_encode + {n : ℕ} (hn : 1 ≤ n) (A : Matrix (Fin n) (Fin n) ℚ) : + machineOptimizerInitialHighRawCode + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩) = + rawRatBinaryCode + (rawOptimizerInitialHigh n (rationalMatrixEntryBitBound A)) := by + rw [machineOptimizerInitialHighRawCode, + machineOptimizerObjectiveUpperRawCode_encode, + machineOptimizerSmoothingSlackRawCode_encode hn, + machineRawRatAddCode_encode] + rfl + +@[simp] theorem machineOptimizerTwiceNSquareForWidthRawCode_encode + {n : ℕ} (A : Matrix (Fin n) (Fin n) ℚ) : + machineOptimizerTwiceNSquareForWidthRawCode + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩) = + rawRatBinaryCode (rawOptimizerTwiceNSquare n) := by + rw [machineOptimizerTwiceNSquareForWidthRawCode, + machineOptimizerNSquareRawCode_encode, + machineRawRatMulCode_encode] + rfl + +@[simp] theorem machineExplicitOptimizerInitialWidthRawCode_encode + {n : ℕ} (hn : 1 ≤ n) (A : Matrix (Fin n) (Fin n) ℚ) : + machineExplicitOptimizerInitialWidthRawCode + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩) = + rawRatBinaryCode + (rawExplicitOptimizerInitialWidth n + (rationalMatrixEntryBitBound A)) := by + rw [machineExplicitOptimizerInitialWidthRawCode, + machineOptimizerInitialHighRawCode_encode hn, + machineOptimizerTwiceNSquareForWidthRawCode_encode, + machineRawRatAddCode_encode] + rfl + +@[simp] theorem rawOptimizerObjectiveUpper_value (n B : ℕ) : + (rawOptimizerObjectiveUpper n B).value = n * B + n := by + simp [rawOptimizerObjectiveUpper] + +@[simp] theorem rawOptimizerSmoothingSlack_value (n B : ℕ) : + (rawOptimizerSmoothingSlack n B).value = + (rawExplicitOptimizerMix n B).value * + (rawOptimizerObjectiveRange n B).value + + 2 * (rawExplicitOptimizerInnerRadius n B).value := by + simp [rawOptimizerSmoothingSlack, rawOptimizerTwiceInnerRadius, + rawOptimizerTwo] + +@[simp] theorem rawExplicitOptimizerInitialWidth_value (n B : ℕ) : + (rawExplicitOptimizerInitialWidth n B).value = + n * B + n + + ((rawExplicitOptimizerMix n B).value * + (rawOptimizerObjectiveRange n B).value + + 2 * (rawExplicitOptimizerInnerRadius n B).value) + + 2 * n ^ 2 := by + simp [rawExplicitOptimizerInitialWidth, rawOptimizerInitialHigh, + rawOptimizerTwiceNSquare, rawOptimizerNSquare, + rawOptimizerDimension, rawOptimizerTwo] + ring + +theorem rawExplicitOptimizerInitialWidth_eq {m : ℕ} + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) : + (rawExplicitOptimizerInitialWidth (m + 1) + (rationalMatrixEntryBitBound A)).value = + explicitOptimizerInitialWidth A := by + rcases rawExplicitOptimizerScales_value A with + ⟨_, _, _, hmix, hradius⟩ + rw [rawExplicitOptimizerInitialWidth_value, hmix, hradius, + rawOptimizerObjectiveRange_value] + simp [explicitOptimizerInitialWidth, betheBisectionInitialHigh, + betheNegativeObjectiveUpper, betheSmoothingSlack, + betheNegativeObjectiveLower, rationalRegularizedObjectiveRange] + +/-! ## Exact unary bisection count -/ + +def machineExplicitOptimizerInitialWidthEntryCode + (word : List Bool) : List Bool := + machineNormalizeRawRatEntryCode + (machineExplicitOptimizerInitialWidthRawCode word) + +def machineExplicitOptimizerInitialWidthLengthRuler + (word : List Bool) : List Bool := + machineOptimizerEntryLengthRuler + (machineExplicitOptimizerInitialWidthEntryCode word) + +def machineExplicitOptimizerBisectionStepsRuler + (word : List Bool) : List Bool := + machineExplicitOptimizerInitialWidthLengthRuler word ++ + (machineExplicitOptimizerGapLengthRuler word ++ + List.replicate 3 true) + +theorem machineExplicitOptimizerInitialWidthEntryCode_mem_FP : + machineExplicitOptimizerInitialWidthEntryCode ∈ FP := by + simpa only [machineExplicitOptimizerInitialWidthEntryCode] using + machineCompose_mem_FP machineExplicitOptimizerInitialWidthRawCode_mem_FP + machineNormalizeRawRatEntryCode_mem_FP + +theorem machineExplicitOptimizerInitialWidthLengthRuler_mem_FP : + machineExplicitOptimizerInitialWidthLengthRuler ∈ FP := by + simpa only [machineExplicitOptimizerInitialWidthLengthRuler] using + machineCompose_mem_FP + machineExplicitOptimizerInitialWidthEntryCode_mem_FP + machineOptimizerEntryLengthRuler_mem_FP + +theorem machineExplicitOptimizerBisectionStepsRuler_mem_FP : + machineExplicitOptimizerBisectionStepsRuler ∈ FP := by + simpa only [machineExplicitOptimizerBisectionStepsRuler] using + machineAppend_mem_FP + machineExplicitOptimizerInitialWidthLengthRuler_mem_FP + (machineAppend_mem_FP machineExplicitOptimizerGapLengthRuler_mem_FP + (machineConst_mem_FP (List.replicate 3 true))) + +@[simp] theorem machineExplicitOptimizerInitialWidthEntryCode_encode + {n : ℕ} (hn : 1 ≤ n) (A : Matrix (Fin n) (Fin n) ℚ) : + machineExplicitOptimizerInitialWidthEntryCode + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩) = + rationalEntryBinaryCode + ((rawExplicitOptimizerInitialWidth n + (rationalMatrixEntryBitBound A)).value) := by + rw [machineExplicitOptimizerInitialWidthEntryCode, + machineExplicitOptimizerInitialWidthRawCode_encode hn, + machineNormalizeRawRatEntryCode_encode, + binaryNormalizeRawRat_eq_value] + +@[simp] theorem machineExplicitOptimizerInitialWidthLengthRuler_encode + {n : ℕ} (hn : 1 ≤ n) (A : Matrix (Fin n) (Fin n) ℚ) : + machineExplicitOptimizerInitialWidthLengthRuler + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩) = + List.replicate + (encodedBitLength ℚ + ((rawExplicitOptimizerInitialWidth n + (rationalMatrixEntryBitBound A)).value)) true := by + rw [machineExplicitOptimizerInitialWidthLengthRuler, + machineExplicitOptimizerInitialWidthEntryCode_encode hn, + machineOptimizerEntryLengthRuler_encode] + +@[simp] theorem machineExplicitOptimizerBisectionStepsRuler_encode + {m : ℕ} (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) : + machineExplicitOptimizerBisectionStepsRuler + (rationalMatrixBinaryEncoding.encode ⟨m + 1, A⟩) = + List.replicate (explicitOptimizerBisectionSteps A) true := by + rw [machineExplicitOptimizerBisectionStepsRuler, + machineExplicitOptimizerInitialWidthLengthRuler_encode (by omega), + machineExplicitOptimizerGapLengthRuler_encode (by omega), + rawExplicitOptimizerInitialWidth_eq] + have hgap := (rawExplicitOptimizerScales_value A).2.2.1 + rw [hgap] + simp only [← List.replicate_add, explicitOptimizerBisectionSteps] + congr 1 + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerBisectionSemantics.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerBisectionSemantics.lean new file mode 100644 index 0000000000..e7422dd12a --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerBisectionSemantics.lean @@ -0,0 +1,475 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerBisectionLoop +import Mathlib.Tactic + +/-! +# Exact semantics of the dyadic optimizer bisection machine + +This file proves that the finite-word loop queries exactly the rational +midpoints of the row-major semantic bisection. No numerical interpretation +is inferred from a decoder: every intermediate word is reduced to the +canonical project encoding of its stated rational value. +-/ + +namespace BeyondBethe + +open Complexity + +@[simp] theorem rawOptimizerInitialLow_value (n : ℕ) : + (rawOptimizerInitialLow n).value = -(2 * n ^ 2 : ℚ) := by + simp [rawOptimizerInitialLow, rawOptimizerTwiceNSquare, + rawOptimizerTwo, rawOptimizerNSquare, rawOptimizerDimension] + ring + +theorem explicitOptimizerInitialWidth_eq_interval {m : ℕ} + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) : + explicitOptimizerInitialWidth A = + betheBisectionInitialHigh A (explicitOptimizerMix A) + (explicitOptimizerInnerRadius A) - + betheNegativeObjectiveLower m := by + rfl + +@[simp] theorem optimizerDyadicThreshold_zero {m : ℕ} + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) : + optimizerDyadicThreshold A 0 0 = betheNegativeObjectiveLower m := by + simp [optimizerDyadicThreshold] + +@[simp] theorem optimizerDyadicThreshold_one_zero {m : ℕ} + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) : + optimizerDyadicThreshold A 1 0 = + betheBisectionInitialHigh A (explicitOptimizerMix A) + (explicitOptimizerInnerRadius A) := by + rw [optimizerDyadicThreshold, pow_zero, div_one, + explicitOptimizerInitialWidth_eq_interval] + norm_num + +def rawDyadicFraction (k t : ℕ) : RawRat := + ⟨k, 2 ^ t, pow_pos (by omega) _⟩ + +@[simp] theorem rawDyadicFraction_value (k t : ℕ) : + (rawDyadicFraction k t).value = (k : ℚ) / 2 ^ t := by + simp [rawDyadicFraction, RawRat.value] + +def machineOptimizerBisectionCanonicalState {m : ℕ} + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (k t : ℕ) : List Bool := + machineOptimizerBisectionStatePack + (rationalMatrixBinaryEncoding.encode ⟨m + 1, A⟩) + (List.replicate (explicitOptimizerBisectionSteps A) true) + k.bits (List.replicate t true) + +@[simp] theorem machineOptimizerBisectionCanonicalState_source {m : ℕ} + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) (k t : ℕ) : + machineOptimizerBisectionStateSource + (machineOptimizerBisectionCanonicalState A k t) = + rationalMatrixBinaryEncoding.encode ⟨m + 1, A⟩ := by + simp [machineOptimizerBisectionCanonicalState] + +@[simp] theorem machineOptimizerBisectionCanonicalState_ruler {m : ℕ} + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) (k t : ℕ) : + machineOptimizerBisectionStateRuler + (machineOptimizerBisectionCanonicalState A k t) = + List.replicate (explicitOptimizerBisectionSteps A) true := by + simp [machineOptimizerBisectionCanonicalState] + +@[simp] theorem machineOptimizerBisectionCanonicalState_index {m : ℕ} + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) (k t : ℕ) : + machineOptimizerBisectionStateIndex + (machineOptimizerBisectionCanonicalState A k t) = k.bits := by + simp [machineOptimizerBisectionCanonicalState] + +@[simp] theorem machineOptimizerBisectionCanonicalState_depth {m : ℕ} + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) (k t : ℕ) : + machineOptimizerBisectionStateDepth + (machineOptimizerBisectionCanonicalState A k t) = + List.replicate t true := by + simp [machineOptimizerBisectionCanonicalState] + +@[simp] theorem machineOptimizerInitialLowEntryCode_encode {m : ℕ} + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) : + machineOptimizerInitialLowEntryCode + (rationalMatrixBinaryEncoding.encode ⟨m + 1, A⟩) = + rawRatBinaryCode + (rawRatOfRat (betheNegativeObjectiveLower m)) := by + rw [machineOptimizerInitialLowEntryCode, + machineOptimizerTwiceNSquareForWidthRawCode_encode, + machineRawRatNegCode_encode, + machineNormalizeRawRatEntryCode_encode, + rawRatBinaryCode_rawRatOfRat] + apply congrArg rationalEntryBinaryCode + rw [binaryNormalizeRawRat_eq_value, + RawRat.value_neg, rawOptimizerTwiceNSquare, RawRat.value_mul] + simp [rawOptimizerTwo, rawOptimizerNSquare, + rawOptimizerDimension, betheNegativeObjectiveLower] + ring + +@[simp] theorem machineOptimizerInitialWidthEntryCodeForBisection_encode + {m : ℕ} + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) : + machineOptimizerInitialWidthEntryCodeForBisection + (rationalMatrixBinaryEncoding.encode ⟨m + 1, A⟩) = + rawRatBinaryCode (rawRatOfRat (explicitOptimizerInitialWidth A)) := by + rw [machineOptimizerInitialWidthEntryCodeForBisection, + machineExplicitOptimizerInitialWidthRawCode_encode (by omega), + machineNormalizeRawRatEntryCode_encode, + rawRatBinaryCode_rawRatOfRat] + apply congrArg rationalEntryBinaryCode + rw [binaryNormalizeRawRat_eq_value, + rawExplicitOptimizerInitialWidth_eq] + +@[simp] theorem machineOptimizerBisectionEvenIndexBits_encode {m : ℕ} + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) (k t : ℕ) : + machineOptimizerBisectionEvenIndexBits + (machineOptimizerBisectionCanonicalState A k t) = + (2 * k).bits := by + rw [machineOptimizerBisectionEvenIndexBits, + machineOptimizerBisectionCanonicalState_index] + change machineBinaryMulBits (pair k.bits (2 : ℕ).bits) = _ + rw [machineBinaryMulBits_pair_natBits] + congr 1 + omega + +@[simp] theorem machineOptimizerBisectionOddIndexBits_encode {m : ℕ} + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) (k t : ℕ) : + machineOptimizerBisectionOddIndexBits + (machineOptimizerBisectionCanonicalState A k t) = + (2 * k + 1).bits := by + rw [machineOptimizerBisectionOddIndexBits, + machineOptimizerBisectionEvenIndexBits_encode] + change machineBinaryAddBits (pair (2 * k).bits (1 : ℕ).bits) = _ + rw [machineBinaryAddBits_pair_natBits] + +@[simp] theorem machineOptimizerBisectionNextDepth_encode {m : ℕ} + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) (k t : ℕ) : + machineOptimizerBisectionNextDepth + (machineOptimizerBisectionCanonicalState A k t) = + List.replicate (t + 1) true := by + rw [machineOptimizerBisectionNextDepth, + machineOptimizerBisectionCanonicalState_depth, + List.replicate_succ] + +@[simp] theorem machineOptimizerBisectionDenominatorBits_encode {m : ℕ} + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) (k t : ℕ) : + machineOptimizerBisectionDenominatorBits + (machineOptimizerBisectionCanonicalState A k t) = + (2 ^ (t + 1)).bits := by + rw [machineOptimizerBisectionDenominatorBits, + machineOptimizerBisectionNextDepth_encode, + machineDirectedLogPowerTwoBits_encode, List.length_replicate] + +@[simp] theorem machineOptimizerBisectionFractionRawCode_encode {m : ℕ} + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) (k t : ℕ) : + machineOptimizerBisectionFractionRawCode + (machineOptimizerBisectionCanonicalState A k t) = + rawRatBinaryCode (rawDyadicFraction (2 * k + 1) (t + 1)) := by + rw [machineOptimizerBisectionFractionRawCode, + machineOptimizerBisectionOddIndexBits_encode, + machineOptimizerBisectionDenominatorBits_encode, + machineNaturalIntegerCode_natBits] + rfl + +@[simp] theorem machineOptimizerBisectionMidpointRawCode_encode {m : ℕ} + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) (k t : ℕ) : + machineOptimizerBisectionMidpointRawCode + (machineOptimizerBisectionCanonicalState A k t) = + rawRatBinaryCode + (rawRatOfRat (optimizerDyadicThreshold A (2 * k + 1) (t + 1))) := by + rw [machineOptimizerBisectionMidpointRawCode, + machineOptimizerBisectionMidpointUnnormalizedRawCode, + machineOptimizerBisectionScaledFractionRawCode, + machineOptimizerBisectionCanonicalState_source, + machineOptimizerBisectionFractionRawCode_encode, + machineOptimizerInitialWidthEntryCodeForBisection_encode, + machineRawRatMulCode_encode, + machineOptimizerInitialLowEntryCode_encode, + machineRawRatAddCode_encode, + machineNormalizeRawRatEntryCode_encode, + rawRatBinaryCode_rawRatOfRat] + apply congrArg rationalEntryBinaryCode + rw [binaryNormalizeRawRat_eq_value, + RawRat.value_add, RawRat.value_mul, rawRatOfRat_value, + rawRatOfRat_value, rawDyadicFraction_value] + rfl + +@[simp] theorem machineOptimizerBisectionFeasibilityResult_encode {m : ℕ} + (hm : 0 < m) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (hA : ∀ i j, 0 < A i j) (k t : ℕ) : + machineOptimizerBisectionFeasibilityResult + (machineOptimizerBisectionCanonicalState A k t) = + rationalFeasibilityResultBinaryCode + (runExplicitScannedBetheThresholdFeasibility + (explicitRegularizationScale (m + 1)) A + (explicitOptimizerPrecision A) + (rawExplicitOptimizerFloor (m + 1) + (rationalMatrixEntryBitBound A)) + (rawRatOfRat + (optimizerDyadicThreshold A (2 * k + 1) (t + 1))) + (explicitOptimizerInnerRadius A)) := by + rw [machineOptimizerBisectionFeasibilityResult, + machineOptimizerBisectionFeasibilityCall, + machineOptimizerBisectionCanonicalState_source, + machineOptimizerBisectionMidpointRawCode_encode] + exact machineExplicitBetheThresholdFeasibilityCode_encode hm A hA _ + +/-! ## Indexed semantic loop and exact step simulation -/ + +def scannedOptimizerIndexStep {m : ℕ} + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (k t : ℕ) : ℕ := + match runExplicitScannedBetheThresholdFeasibility + (explicitRegularizationScale (m + 1)) A + (explicitOptimizerPrecision A) + (rawExplicitOptimizerFloor (m + 1) + (rationalMatrixEntryBitBound A)) + (rawRatOfRat + (optimizerDyadicThreshold A (2 * k + 1) (t + 1))) + (explicitOptimizerInnerRadius A) with + | .accepted _ => 2 * k + | .exhausted _ => 2 * k + 1 + +def runScannedOptimizerIndex {m : ℕ} + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) : + ℕ → ℕ → ℕ → ℕ + | 0, _t, k => k + | N + 1, t, k => + runScannedOptimizerIndex A N (t + 1) + (scannedOptimizerIndexStep A k t) + +theorem machineOptimizerBisectionStep_encode {m : ℕ} + (hm : 0 < m) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (hA : ∀ i j, 0 < A i j) (k t : ℕ) : + machineOptimizerBisectionStep + (machineOptimizerBisectionCanonicalState A k t) = + machineOptimizerBisectionCanonicalState A + (scannedOptimizerIndexStep A k t) (t + 1) := by + rw [machineOptimizerBisectionStep, + machineOptimizerBisectionCanonicalState_source, + machineOptimizerBisectionCanonicalState_ruler, + machineOptimizerBisectionNextDepth_encode, + machineOptimizerBisectionNextIndexBits, + machineOptimizerBisectionExhaustedBit, + machineOptimizerBisectionFeasibilityResult_encode hm A hA] + cases hrun : runExplicitScannedBetheThresholdFeasibility + (explicitRegularizationScale (m + 1)) A + (explicitOptimizerPrecision A) + (rawExplicitOptimizerFloor (m + 1) + (rationalMatrixEntryBitBound A)) + (rawRatOfRat + (optimizerDyadicThreshold A (2 * k + 1) (t + 1))) + (explicitOptimizerInnerRadius A) with + | accepted q => + simp only [rationalFeasibilityResultBinaryCode, + scannedOptimizerIndexStep, hrun, + machinePairFirst_pair, machineHeadBit_cons, + machineIfHead_false] + rw [machineOptimizerBisectionEvenIndexBits_encode] + rfl + | exhausted E => + simp only [rationalFeasibilityResultBinaryCode, + scannedOptimizerIndexStep, hrun, + machinePairFirst_pair, machineHeadBit_cons, + machineIfHead_true] + rw [machineOptimizerBisectionOddIndexBits_encode] + rfl + +theorem machineOptimizerBisectionIterate_encode {m : ℕ} + (hm : 0 < m) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (hA : ∀ i j, 0 < A i j) (k t : ℕ) : ∀ N : ℕ, + (machineOptimizerBisectionStep)^[N] + (machineOptimizerBisectionCanonicalState A k t) = + machineOptimizerBisectionCanonicalState A + (runScannedOptimizerIndex A N t k) (t + N) := by + intro N + induction N generalizing k t with + | zero => simp [runScannedOptimizerIndex] + | succ N ih => + rw [Function.iterate_succ_apply, + machineOptimizerBisectionStep_encode hm A hA, + ih, runScannedOptimizerIndex] + have ht : t + 1 + N = t + (N + 1) := by omega + rw [ht] + +@[simp] theorem machineOptimizerBisectionInit_encode {m : ℕ} + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) : + machineOptimizerBisectionInit + (rationalMatrixBinaryEncoding.encode ⟨m + 1, A⟩) = + machineOptimizerBisectionCanonicalState A 0 0 := by + rw [machineOptimizerBisectionInit, + machineExplicitOptimizerBisectionStepsRuler_encode] + rfl + +@[simp] theorem machineOptimizerBisectionFinalState_encode {m : ℕ} + (hm : 0 < m) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (hA : ∀ i j, 0 < A i j) : + machineOptimizerBisectionFinalState + (rationalMatrixBinaryEncoding.encode ⟨m + 1, A⟩) = + machineOptimizerBisectionCanonicalState A + (runScannedOptimizerIndex A (explicitOptimizerBisectionSteps A) 0 0) + (explicitOptimizerBisectionSteps A) := by + rw [machineOptimizerBisectionFinalState, + machineExplicitOptimizerBisectionStepsRuler_encode, + List.length_replicate, machineOptimizerBisectionInit_encode, + machineOptimizerBisectionIterate_encode hm A hA] + simp + +@[simp] theorem machineOptimizerBisectionHighIndexBits_encode {m : ℕ} + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) (k t : ℕ) : + machineOptimizerBisectionHighIndexBits + (machineOptimizerBisectionCanonicalState A k t) = + (k + 1).bits := by + rw [machineOptimizerBisectionHighIndexBits, + machineOptimizerBisectionCanonicalState_index] + change machineBinaryAddBits (pair k.bits (1 : ℕ).bits) = _ + rw [machineBinaryAddBits_pair_natBits] + +@[simp] theorem machineOptimizerBisectionHighFractionRawCode_encode + {m : ℕ} (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (k t : ℕ) : + machineOptimizerBisectionHighFractionRawCode + (machineOptimizerBisectionCanonicalState A k t) = + rawRatBinaryCode (rawDyadicFraction (k + 1) t) := by + rw [machineOptimizerBisectionHighFractionRawCode, + machineOptimizerBisectionHighIndexBits_encode, + machineOptimizerBisectionCanonicalState_depth, + machineNaturalIntegerCode_natBits, + machineDirectedLogPowerTwoBits_encode, List.length_replicate] + rfl + +@[simp] theorem machineOptimizerBisectionHighRawCode_encode {m : ℕ} + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) (k t : ℕ) : + machineOptimizerBisectionHighRawCode + (machineOptimizerBisectionCanonicalState A k t) = + rawRatBinaryCode + (rawRatOfRat (optimizerDyadicThreshold A (k + 1) t)) := by + rw [machineOptimizerBisectionHighRawCode, + machineOptimizerBisectionHighUnnormalizedRawCode, + machineOptimizerBisectionHighScaledRawCode, + machineOptimizerBisectionCanonicalState_source, + machineOptimizerBisectionHighFractionRawCode_encode, + machineOptimizerInitialWidthEntryCodeForBisection_encode, + machineRawRatMulCode_encode, + machineOptimizerInitialLowEntryCode_encode, + machineRawRatAddCode_encode, + machineNormalizeRawRatEntryCode_encode, + rawRatBinaryCode_rawRatOfRat] + apply congrArg rationalEntryBinaryCode + rw [binaryNormalizeRawRat_eq_value, + RawRat.value_add, RawRat.value_mul, rawRatOfRat_value, + rawRatOfRat_value, rawDyadicFraction_value] + rfl + +/-! ## Equivalence with ordinary midpoint bisection -/ + +theorem optimizerDyadicThreshold_even {m : ℕ} + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) (k t : ℕ) : + optimizerDyadicThreshold A (2 * k) (t + 1) = + optimizerDyadicThreshold A k t := by + simp only [optimizerDyadicThreshold] + push_cast + rw [pow_succ] + ring + +theorem optimizerDyadicThreshold_odd_midpoint {m : ℕ} + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) (k t : ℕ) : + optimizerDyadicThreshold A (2 * k + 1) (t + 1) = + (optimizerDyadicThreshold A k t + + optimizerDyadicThreshold A (k + 1) t) / 2 := by + simp only [optimizerDyadicThreshold] + push_cast + rw [pow_succ] + ring + +theorem optimizerDyadicThreshold_odd_high {m : ℕ} + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) (k t : ℕ) : + optimizerDyadicThreshold A (2 * k + 1 + 1) (t + 1) = + optimizerDyadicThreshold A (k + 1) t := by + simp only [optimizerDyadicThreshold] + push_cast + rw [pow_succ] + ring + +def ScannedOptimizerIndexAgrees {m : ℕ} + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (s : BetheBisectionState (m * m + 1)) (k t : ℕ) : Prop := + s.low = optimizerDyadicThreshold A k t ∧ + s.high = optimizerDyadicThreshold A (k + 1) t + +theorem initialScannedOptimizerIndexAgrees {m : ℕ} + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) : + ScannedOptimizerIndexAgrees A + (initialScannedBetheBisectionState + (explicitRegularizationScale (m + 1)) A + (explicitOptimizerPrecision A) + (rawExplicitOptimizerFloor (m + 1) + (rationalMatrixEntryBitBound A)) + (explicitOptimizerMix A) (explicitOptimizerInnerRadius A)) 0 0 := by + constructor + · rw [initialScannedBetheBisectionState_low, + optimizerDyadicThreshold_zero] + · rw [initialScannedBetheBisectionState_high, + optimizerDyadicThreshold_one_zero] + +theorem scannedOptimizerIndexStep_agrees {m : ℕ} + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + {s : BetheBisectionState (m * m + 1)} {k t : ℕ} + (hs : ScannedOptimizerIndexAgrees A s k t) : + ScannedOptimizerIndexAgrees A + (scannedBetheBisectionStep + (explicitRegularizationScale (m + 1)) A + (explicitOptimizerPrecision A) + (rawExplicitOptimizerFloor (m + 1) + (rationalMatrixEntryBitBound A)) + (explicitOptimizerInnerRadius A) s) + (scannedOptimizerIndexStep A k t) (t + 1) := by + rcases hs with ⟨hlow, hhigh⟩ + rw [scannedBetheBisectionStep] + have hmid : (s.low + s.high) / 2 = + optimizerDyadicThreshold A (2 * k + 1) (t + 1) := by + rw [hlow, hhigh, optimizerDyadicThreshold_odd_midpoint] + rw [hmid] + cases hrun : runExplicitScannedBetheThresholdFeasibility + (explicitRegularizationScale (m + 1)) A + (explicitOptimizerPrecision A) + (rawExplicitOptimizerFloor (m + 1) + (rationalMatrixEntryBitBound A)) + (rawRatOfRat + (optimizerDyadicThreshold A (2 * k + 1) (t + 1))) + (explicitOptimizerInnerRadius A) with + | accepted q => + simp only [scannedOptimizerIndexStep, hrun] + constructor + · simpa only [optimizerDyadicThreshold_even] using hlow + · rfl + | exhausted E => + simp only [scannedOptimizerIndexStep, hrun] + constructor + · rfl + · simpa only [optimizerDyadicThreshold_odd_high] using hhigh + +theorem runScannedOptimizerIndex_agrees {m : ℕ} + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + {s : BetheBisectionState (m * m + 1)} {k t : ℕ} + (hs : ScannedOptimizerIndexAgrees A s k t) : ∀ N : ℕ, + ScannedOptimizerIndexAgrees A + (runScannedBetheBisection + (explicitRegularizationScale (m + 1)) A + (explicitOptimizerPrecision A) + (rawExplicitOptimizerFloor (m + 1) + (rationalMatrixEntryBitBound A)) + (explicitOptimizerInnerRadius A) N s) + (runScannedOptimizerIndex A N t k) (t + N) := by + intro N + induction N generalizing s k t with + | zero => simpa [runScannedBetheBisection, + runScannedOptimizerIndex] using hs + | succ N ih => + rw [runScannedBetheBisection, runScannedOptimizerIndex] + have hstep := scannedOptimizerIndexStep_agrees A hs + simpa only [Nat.add_assoc, Nat.add_comm 1 N] using ih hstep + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerCertificateBoundary.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerCertificateBoundary.lean new file mode 100644 index 0000000000..cace734b3b --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerCertificateBoundary.lean @@ -0,0 +1,154 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachinePositiveAlgorithm +import LeanPool.BeyondBethe.BeyondBethe.OptimizerOutputEncoding + +/-! +# The finite-word interface between optimization and certification + +The normalized positive routine has two logically distinct executable parts: +the regularized-Bethe optimizer returns a rational matrix and two rational +potential vectors, and the certificate evaluator consumes exactly those three +objects. This file fixes their finite-word interface and proves that +polynomial-time machines realizing the two parts compose to a raw-output +machine for `explicitNormalizedCertificateAlgorithm`. + +There is deliberately no decoder or noncomputable choice in this interface. +Every well-formed optimizer output is a right-nested word built from the +already fixed matrix and rational-entry encodings. +-/ + +namespace BeyondBethe + +open Complexity + +/-- The exact optimizer output used by the paper in dimensions at least two. -/ +def explicitLargeOptimizerOutput (m : ℕ) + (B : Matrix (Fin (m + 2)) (Fin (m + 2)) ℚ) : + RationalOptimizerOutput (m + 2) where + matrix := explicitBetheOptimizerMatrix (m := m + 1) B + rowPotential := explicitBetheOptimizerRowPotential (m := m + 1) B + columnPotential := explicitBetheOptimizerColumnPotential (m := m + 1) B + +/-- A raw string function realizes the optimizer on every canonical input of +dimension at least two. -/ +def LargeOptimizerStringRealizes (F : List Bool → List Bool) : Prop := + ∀ (m : ℕ) (B : Matrix (Fin (m + 2)) (Fin (m + 2)) ℚ), + F (rationalMatrixBinaryEncoding.encode ⟨m + 2, B⟩) = + rationalOptimizerOutputCode (explicitLargeOptimizerOutput m B) + +/-- A raw string function realizes the directed certificate evaluator on the +canonical words actually emitted by the fixed optimizer. Its input retains +the original normalized matrix word as the first component and the optimizer +output as the second. This source guard is necessary: optimizer potentials +of numerical size `W` can have only `O(log W)` encoded bits, while the final +exponential output can require `Theta(W)` bits. -/ +def CertificateEvaluatorStringRealizes + (F : List Bool → List Bool) : Prop := + ∀ (m : ℕ) (B : Matrix (Fin (m + 2)) (Fin (m + 2)) ℚ), + F (pair (rationalMatrixBinaryEncoding.encode ⟨m + 2, B⟩) + (rationalOptimizerOutputCode (explicitLargeOptimizerOutput m B))) = + rawRatBinaryCode + (rawRatOfRat + (explicitDirectedCertificateValue + (explicitBetheOptimizerMatrix (m := m + 1) B) + (explicitBetheOptimizerRowPotential (m := m + 1) B) + (explicitBetheOptimizerColumnPotential (m := m + 1) B))) + +/-- The certificate evaluator is used only on positive matrices whose entries +are at most one. These are exactly the normalized matrices supplied by the +positive routine. Requiring correctness outside this domain would impose an +irrelevant numerical-magnitude claim on the totalized optimizer. -/ +def CertificateEvaluatorStringRealizesOnPositiveNormalized + (F : List Bool → List Bool) : Prop := + ∀ (m : ℕ) (B : Matrix (Fin (m + 2)) (Fin (m + 2)) ℚ), + (∀ i j, 0 < B i j) → (∀ i j, B i j ≤ 1) → + F (pair (rationalMatrixBinaryEncoding.encode ⟨m + 2, B⟩) + (rationalOptimizerOutputCode (explicitLargeOptimizerOutput m B))) = + rawRatBinaryCode + (rawRatOfRat + (explicitDirectedCertificateValue + (explicitBetheOptimizerMatrix (m := m + 1) B) + (explicitBetheOptimizerRowPotential (m := m + 1) B) + (explicitBetheOptimizerColumnPotential (m := m + 1) B))) + +/-- Compose optimizer and certificate machines, retaining the exact zero +branches in dimensions zero and one. -/ +def machineNormalizedCertificateFromParts + (optimizerMachine certificateMachine : List Bool → List Bool) + (word : List Bool) : List Bool := + machineIfHead (machineCompletedDimensionLtTwoBit word) + (rawRatBinaryCode RawRat.zero) + (certificateMachine (pair word (optimizerMachine word))) + +theorem machineNormalizedCertificateFromParts_mem_FP + {optimizerMachine certificateMachine : List Bool → List Bool} + (hoptimizer : optimizerMachine ∈ Complexity.FP) + (hcertificate : certificateMachine ∈ Complexity.FP) : + machineNormalizedCertificateFromParts + optimizerMachine certificateMachine ∈ Complexity.FP := by + have hpair := machinePair_mem_FP id_mem_FP hoptimizer + have hcompose := machineCompose_mem_FP hpair hcertificate + exact machineIfHead_mem_FP machineCompletedDimensionLtTwoBit_mem_FP + (machineConst_mem_FP (rawRatBinaryCode RawRat.zero)) hcompose + +theorem machineNormalizedCertificateFromParts_realizes + {optimizerMachine certificateMachine : List Bool → List Bool} + (hoptimizer : LargeOptimizerStringRealizes optimizerMachine) + (hcertificate : CertificateEvaluatorStringRealizes certificateMachine) : + RawStringRealizes + (machineNormalizedCertificateFromParts + optimizerMachine certificateMachine) + explicitNormalizedCertificateAlgorithm := by + intro x + obtain ⟨n, B⟩ := x + rw [machineNormalizedCertificateFromParts, + machineCompletedDimensionLtTwoBit_encode] + by_cases hsmall : n < 2 + · rw [show [decide (n < 2)] = [true] by simp [hsmall], + machineIfHead_true] + interval_cases n <;> rfl + · rw [show [decide (n < 2)] = [false] by simp [hsmall], + machineIfHead_false] + obtain ⟨m, rfl⟩ : ∃ m, n = m + 2 := by + use n - 2 + omega + rw [hoptimizer m B] + exact hcertificate m B + +theorem machineNormalizedCertificateFromParts_realizes_onPositive + {optimizerMachine certificateMachine : List Bool → List Bool} + (hoptimizer : LargeOptimizerStringRealizes optimizerMachine) + (hcertificate : + CertificateEvaluatorStringRealizesOnPositiveNormalized certificateMachine) : + NormalizedCertificateStringRealizesOnPositive + (machineNormalizedCertificateFromParts + optimizerMachine certificateMachine) := by + intro m B hBpos hBupper + rw [machineNormalizedCertificateFromParts, + machineCompletedDimensionLtTwoBit_encode, + show [decide (m + 2 < 2)] = [false] by simp, + machineIfHead_false, hoptimizer m B] + exact hcertificate m B hBpos hBupper + +theorem normalizedCertificate_rawMachine_of_parts + {optimizerMachine certificateMachine : List Bool → List Bool} + (hoptimizerFP : optimizerMachine ∈ Complexity.FP) + (hoptimizer : LargeOptimizerStringRealizes optimizerMachine) + (hcertificateFP : certificateMachine ∈ Complexity.FP) + (hcertificate : CertificateEvaluatorStringRealizes certificateMachine) : + ∃ F : List Bool → List Bool, + F ∈ Complexity.FP ∧ + RawStringRealizes F explicitNormalizedCertificateAlgorithm := by + exact ⟨machineNormalizedCertificateFromParts + optimizerMachine certificateMachine, + machineNormalizedCertificateFromParts_mem_FP + hoptimizerFP hcertificateFP, + machineNormalizedCertificateFromParts_realizes + hoptimizer hcertificate⟩ + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerDerivedScales.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerDerivedScales.lean new file mode 100644 index 0000000000..e91c2127ab --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerDerivedScales.lean @@ -0,0 +1,512 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerInteriorScale +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalMin + +/-! +# Remaining rational scales and precision ruler for the optimizer + +Starting from the guarded dyadic interior floor, all remaining scales are +formed by exact unreduced rational arithmetic. The precision is emitted +directly as a unary ruler assembled from the exact canonical encoding length +of the objective gap and fixed dimension-dependent summands. +-/ + +namespace BeyondBethe + +open Complexity + +def rawOptimizerOne : RawRat := RawRat.ofNat 1 + +def rawOptimizerThree : RawRat := RawRat.ofNat 3 + +def rawOptimizerTen : RawRat := RawRat.ofNat 10 + +def rawOptimizerFortyEight : RawRat := RawRat.ofNat 48 + +def rawOptimizerKKTError : RawRat := rawRatOfRat explicitKKTError + +def rawExplicitOptimizerFloor (n B : ℕ) : RawRat := + (rawOptimizerHalf.pow + (numericalInteriorExponent n B (explicitRegularizationScale n))).div + rawOptimizerTwo + +def rawExplicitOptimizerRho (n B : ℕ) : RawRat := + ((rawExplicitOptimizerFloor n B).mul rawOptimizerKKTError).div + rawOptimizerFortyEight + +def rawExplicitOptimizerGap (n B : ℕ) : RawRat := + ((rawOptimizerTau n).mul + ((rawExplicitOptimizerRho n B).mul (rawExplicitOptimizerRho n B))).div + rawOptimizerFour + +def rawOptimizerObjectiveRange (n B : ℕ) : RawRat := + ((rawOptimizerDimension n).mul (rawOptimizerBitBound B)).add + (rawOptimizerThree.mul (rawOptimizerNSquare n)) + +def rawOptimizerMixDenominator (n B : ℕ) : RawRat := + rawOptimizerFour.mul ((rawOptimizerObjectiveRange n B).add rawOptimizerOne) + +def rawOptimizerMixCandidate (n B : ℕ) : RawRat := + (rawExplicitOptimizerGap n B).div (rawOptimizerMixDenominator n B) + +def rawExplicitOptimizerMix (n B : ℕ) : RawRat := + if rawOptimizerHalf.value ≤ (rawOptimizerMixCandidate n B).value then + rawOptimizerHalf + else rawOptimizerMixCandidate n B + +def rawOptimizerTwiceDimension (n : ℕ) : RawRat := + rawOptimizerTwo.mul (rawOptimizerDimension n) + +def rawExplicitOptimizerInnerRadius (n B : ℕ) : RawRat := + (rawExplicitOptimizerMix n B).div (rawOptimizerTwiceDimension n) + +/-! ## Finite-word scale machines -/ + +def machineExplicitOptimizerRhoRawCode (word : List Bool) : List Bool := + machineRawRatDivCode + (pair + (machineRawRatMulCode + (pair (machineExplicitOptimizerFloorRawCode word) + (rawRatBinaryCode rawOptimizerKKTError))) + (rawRatBinaryCode rawOptimizerFortyEight)) + +def machineExplicitOptimizerRhoSquareRawCode + (word : List Bool) : List Bool := + machineRawRatMulCode + (pair (machineExplicitOptimizerRhoRawCode word) + (machineExplicitOptimizerRhoRawCode word)) + +def machineExplicitOptimizerGapNumeratorRawCode + (word : List Bool) : List Bool := + machineRawRatMulCode + (pair (machineOptimizerTauRawCode word) + (machineExplicitOptimizerRhoSquareRawCode word)) + +def machineExplicitOptimizerGapRawCode (word : List Bool) : List Bool := + machineRawRatDivCode + (pair (machineExplicitOptimizerGapNumeratorRawCode word) + (rawRatBinaryCode rawOptimizerFour)) + +def machineOptimizerThreeNSquareRawCode (word : List Bool) : List Bool := + machineRawRatMulCode + (pair (rawRatBinaryCode rawOptimizerThree) + (machineOptimizerNSquareRawCode word)) + +def machineOptimizerObjectiveRangeRawCode (word : List Bool) : List Bool := + machineRawRatAddCode + (pair (machineOptimizerNBProductRawCode word) + (machineOptimizerThreeNSquareRawCode word)) + +def machineOptimizerRangePlusOneRawCode (word : List Bool) : List Bool := + machineRawRatAddCode + (pair (machineOptimizerObjectiveRangeRawCode word) + (rawRatBinaryCode rawOptimizerOne)) + +def machineOptimizerMixDenominatorRawCode (word : List Bool) : List Bool := + machineRawRatMulCode + (pair (rawRatBinaryCode rawOptimizerFour) + (machineOptimizerRangePlusOneRawCode word)) + +def machineOptimizerMixCandidateRawCode (word : List Bool) : List Bool := + machineRawRatDivCode + (pair (machineExplicitOptimizerGapRawCode word) + (machineOptimizerMixDenominatorRawCode word)) + +def machineExplicitOptimizerMixRawCode (word : List Bool) : List Bool := + machineRawRatMinCode + (pair (rawRatBinaryCode rawOptimizerHalf) + (machineOptimizerMixCandidateRawCode word)) + +def machineOptimizerTwiceDimensionRawCode (word : List Bool) : List Bool := + machineRawRatMulCode + (pair (rawRatBinaryCode rawOptimizerTwo) + (machineOptimizerDimensionRawCode word)) + +def machineExplicitOptimizerInnerRadiusRawCode + (word : List Bool) : List Bool := + machineRawRatDivCode + (pair (machineExplicitOptimizerMixRawCode word) + (machineOptimizerTwiceDimensionRawCode word)) + +/-! ## Polynomial-time closure -/ + +theorem machineExplicitOptimizerRhoRawCode_mem_FP : + machineExplicitOptimizerRhoRawCode ∈ FP := by + have hproduct := machineCompose_mem_FP + (machinePair_mem_FP machineExplicitOptimizerFloorRawCode_mem_FP + (machineConst_mem_FP (rawRatBinaryCode rawOptimizerKKTError))) + machineRawRatMulCode_mem_FP + simpa only [machineExplicitOptimizerRhoRawCode] using machineCompose_mem_FP + (machinePair_mem_FP hproduct + (machineConst_mem_FP (rawRatBinaryCode rawOptimizerFortyEight))) + machineRawRatDivCode_mem_FP + +theorem machineExplicitOptimizerRhoSquareRawCode_mem_FP : + machineExplicitOptimizerRhoSquareRawCode ∈ FP := by + simpa only [machineExplicitOptimizerRhoSquareRawCode] using + machineCompose_mem_FP + (machinePair_mem_FP machineExplicitOptimizerRhoRawCode_mem_FP + machineExplicitOptimizerRhoRawCode_mem_FP) + machineRawRatMulCode_mem_FP + +theorem machineExplicitOptimizerGapNumeratorRawCode_mem_FP : + machineExplicitOptimizerGapNumeratorRawCode ∈ FP := by + simpa only [machineExplicitOptimizerGapNumeratorRawCode] using + machineCompose_mem_FP + (machinePair_mem_FP machineOptimizerTauRawCode_mem_FP + machineExplicitOptimizerRhoSquareRawCode_mem_FP) + machineRawRatMulCode_mem_FP + +theorem machineExplicitOptimizerGapRawCode_mem_FP : + machineExplicitOptimizerGapRawCode ∈ FP := by + simpa only [machineExplicitOptimizerGapRawCode] using machineCompose_mem_FP + (machinePair_mem_FP machineExplicitOptimizerGapNumeratorRawCode_mem_FP + (machineConst_mem_FP (rawRatBinaryCode rawOptimizerFour))) + machineRawRatDivCode_mem_FP + +theorem machineOptimizerThreeNSquareRawCode_mem_FP : + machineOptimizerThreeNSquareRawCode ∈ FP := by + simpa only [machineOptimizerThreeNSquareRawCode] using machineCompose_mem_FP + (machinePair_mem_FP + (machineConst_mem_FP (rawRatBinaryCode rawOptimizerThree)) + machineOptimizerNSquareRawCode_mem_FP) + machineRawRatMulCode_mem_FP + +theorem machineOptimizerObjectiveRangeRawCode_mem_FP : + machineOptimizerObjectiveRangeRawCode ∈ FP := by + simpa only [machineOptimizerObjectiveRangeRawCode] using machineCompose_mem_FP + (machinePair_mem_FP machineOptimizerNBProductRawCode_mem_FP + machineOptimizerThreeNSquareRawCode_mem_FP) + machineRawRatAddCode_mem_FP + +theorem machineOptimizerRangePlusOneRawCode_mem_FP : + machineOptimizerRangePlusOneRawCode ∈ FP := by + simpa only [machineOptimizerRangePlusOneRawCode] using machineCompose_mem_FP + (machinePair_mem_FP machineOptimizerObjectiveRangeRawCode_mem_FP + (machineConst_mem_FP (rawRatBinaryCode rawOptimizerOne))) + machineRawRatAddCode_mem_FP + +theorem machineOptimizerMixDenominatorRawCode_mem_FP : + machineOptimizerMixDenominatorRawCode ∈ FP := by + simpa only [machineOptimizerMixDenominatorRawCode] using machineCompose_mem_FP + (machinePair_mem_FP + (machineConst_mem_FP (rawRatBinaryCode rawOptimizerFour)) + machineOptimizerRangePlusOneRawCode_mem_FP) + machineRawRatMulCode_mem_FP + +theorem machineOptimizerMixCandidateRawCode_mem_FP : + machineOptimizerMixCandidateRawCode ∈ FP := by + simpa only [machineOptimizerMixCandidateRawCode] using machineCompose_mem_FP + (machinePair_mem_FP machineExplicitOptimizerGapRawCode_mem_FP + machineOptimizerMixDenominatorRawCode_mem_FP) + machineRawRatDivCode_mem_FP + +theorem machineExplicitOptimizerMixRawCode_mem_FP : + machineExplicitOptimizerMixRawCode ∈ FP := by + simpa only [machineExplicitOptimizerMixRawCode] using machineCompose_mem_FP + (machinePair_mem_FP + (machineConst_mem_FP (rawRatBinaryCode rawOptimizerHalf)) + machineOptimizerMixCandidateRawCode_mem_FP) + machineRawRatMinCode_mem_FP + +theorem machineOptimizerTwiceDimensionRawCode_mem_FP : + machineOptimizerTwiceDimensionRawCode ∈ FP := by + simpa only [machineOptimizerTwiceDimensionRawCode] using machineCompose_mem_FP + (machinePair_mem_FP + (machineConst_mem_FP (rawRatBinaryCode rawOptimizerTwo)) + machineOptimizerDimensionRawCode_mem_FP) + machineRawRatMulCode_mem_FP + +theorem machineExplicitOptimizerInnerRadiusRawCode_mem_FP : + machineExplicitOptimizerInnerRadiusRawCode ∈ FP := by + simpa only [machineExplicitOptimizerInnerRadiusRawCode] using + machineCompose_mem_FP + (machinePair_mem_FP machineExplicitOptimizerMixRawCode_mem_FP + machineOptimizerTwiceDimensionRawCode_mem_FP) + machineRawRatDivCode_mem_FP + +/-! ## Exact semantics -/ + +@[simp] theorem machineExplicitOptimizerRhoRawCode_encode + {n : ℕ} (hn : 1 ≤ n) (A : Matrix (Fin n) (Fin n) ℚ) : + machineExplicitOptimizerRhoRawCode + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩) = + rawRatBinaryCode + (rawExplicitOptimizerRho n (rationalMatrixEntryBitBound A)) := by + rw [machineExplicitOptimizerRhoRawCode, + machineExplicitOptimizerFloorRawCode_encode hn, + machineRawRatMulCode_encode, machineRawRatDivCode_encode] + rfl + +@[simp] theorem machineExplicitOptimizerRhoSquareRawCode_encode + {n : ℕ} (hn : 1 ≤ n) (A : Matrix (Fin n) (Fin n) ℚ) : + machineExplicitOptimizerRhoSquareRawCode + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩) = + rawRatBinaryCode + ((rawExplicitOptimizerRho n + (rationalMatrixEntryBitBound A)).mul + (rawExplicitOptimizerRho n + (rationalMatrixEntryBitBound A))) := by + rw [machineExplicitOptimizerRhoSquareRawCode, + machineExplicitOptimizerRhoRawCode_encode hn, + machineRawRatMulCode_encode] + +@[simp] theorem machineExplicitOptimizerGapRawCode_encode + {n : ℕ} (hn : 1 ≤ n) (A : Matrix (Fin n) (Fin n) ℚ) : + machineExplicitOptimizerGapRawCode + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩) = + rawRatBinaryCode + (rawExplicitOptimizerGap n (rationalMatrixEntryBitBound A)) := by + rw [machineExplicitOptimizerGapRawCode, + machineExplicitOptimizerGapNumeratorRawCode, + machineOptimizerTauRawCode_encode, + machineExplicitOptimizerRhoSquareRawCode_encode hn, + machineRawRatMulCode_encode, machineRawRatDivCode_encode] + rfl + +@[simp] theorem machineOptimizerThreeNSquareRawCode_encode + {n : ℕ} (A : Matrix (Fin n) (Fin n) ℚ) : + machineOptimizerThreeNSquareRawCode + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩) = + rawRatBinaryCode (rawOptimizerThree.mul (rawOptimizerNSquare n)) := by + rw [machineOptimizerThreeNSquareRawCode, + machineOptimizerNSquareRawCode_encode, + machineRawRatMulCode_encode] + +@[simp] theorem machineOptimizerObjectiveRangeRawCode_encode + {n : ℕ} (A : Matrix (Fin n) (Fin n) ℚ) : + machineOptimizerObjectiveRangeRawCode + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩) = + rawRatBinaryCode + (rawOptimizerObjectiveRange n (rationalMatrixEntryBitBound A)) := by + rw [machineOptimizerObjectiveRangeRawCode, + machineOptimizerNBProductRawCode_encode, + machineOptimizerThreeNSquareRawCode_encode, + machineRawRatAddCode_encode] + rfl + +@[simp] theorem machineOptimizerRangePlusOneRawCode_encode + {n : ℕ} (A : Matrix (Fin n) (Fin n) ℚ) : + machineOptimizerRangePlusOneRawCode + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩) = + rawRatBinaryCode + ((rawOptimizerObjectiveRange n + (rationalMatrixEntryBitBound A)).add rawOptimizerOne) := by + rw [machineOptimizerRangePlusOneRawCode, + machineOptimizerObjectiveRangeRawCode_encode, + machineRawRatAddCode_encode] + +@[simp] theorem machineOptimizerMixDenominatorRawCode_encode + {n : ℕ} (A : Matrix (Fin n) (Fin n) ℚ) : + machineOptimizerMixDenominatorRawCode + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩) = + rawRatBinaryCode + (rawOptimizerMixDenominator n (rationalMatrixEntryBitBound A)) := by + rw [machineOptimizerMixDenominatorRawCode, + machineOptimizerRangePlusOneRawCode_encode, + machineRawRatMulCode_encode] + rfl + +@[simp] theorem machineOptimizerMixCandidateRawCode_encode + {n : ℕ} (hn : 1 ≤ n) (A : Matrix (Fin n) (Fin n) ℚ) : + machineOptimizerMixCandidateRawCode + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩) = + rawRatBinaryCode + (rawOptimizerMixCandidate n (rationalMatrixEntryBitBound A)) := by + rw [machineOptimizerMixCandidateRawCode, + machineExplicitOptimizerGapRawCode_encode hn, + machineOptimizerMixDenominatorRawCode_encode, + machineRawRatDivCode_encode] + rfl + +@[simp] theorem machineExplicitOptimizerMixRawCode_encode + {n : ℕ} (hn : 1 ≤ n) (A : Matrix (Fin n) (Fin n) ℚ) : + machineExplicitOptimizerMixRawCode + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩) = + rawRatBinaryCode + (rawExplicitOptimizerMix n (rationalMatrixEntryBitBound A)) := by + rw [machineExplicitOptimizerMixRawCode, + machineOptimizerMixCandidateRawCode_encode hn, + machineRawRatMinCode_encode] + rfl + +@[simp] theorem machineOptimizerTwiceDimensionRawCode_encode + {n : ℕ} (A : Matrix (Fin n) (Fin n) ℚ) : + machineOptimizerTwiceDimensionRawCode + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩) = + rawRatBinaryCode (rawOptimizerTwiceDimension n) := by + rw [machineOptimizerTwiceDimensionRawCode, + machineOptimizerDimensionRawCode_encode, + machineRawRatMulCode_encode] + rfl + +@[simp] theorem machineExplicitOptimizerInnerRadiusRawCode_encode + {n : ℕ} (hn : 1 ≤ n) (A : Matrix (Fin n) (Fin n) ℚ) : + machineExplicitOptimizerInnerRadiusRawCode + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩) = + rawRatBinaryCode + (rawExplicitOptimizerInnerRadius n + (rationalMatrixEntryBitBound A)) := by + rw [machineExplicitOptimizerInnerRadiusRawCode, + machineExplicitOptimizerMixRawCode_encode hn, + machineOptimizerTwiceDimensionRawCode_encode, + machineRawRatDivCode_encode] + rfl + +@[simp] theorem rawExplicitOptimizerFloor_value (n B : ℕ) : + (rawExplicitOptimizerFloor n B).value = + numericalInteriorFloor n B (explicitRegularizationScale n) / 2 := by + simp [rawExplicitOptimizerFloor, numericalInteriorFloor, + rawOptimizerHalf, rawOptimizerTwo] + +@[simp] theorem rawExplicitOptimizerRho_value (n B : ℕ) : + (rawExplicitOptimizerRho n B).value = + numericalInteriorFloor n B (explicitRegularizationScale n) / 2 * + explicitKKTError / 48 := by + simp [rawExplicitOptimizerRho, rawOptimizerKKTError, + rawOptimizerFortyEight] + +@[simp] theorem rawExplicitOptimizerGap_value (n B : ℕ) : + (rawExplicitOptimizerGap n B).value = + explicitRegularizationScale n * + (numericalInteriorFloor n B (explicitRegularizationScale n) / 2 * + explicitKKTError / 48) ^ 2 / 4 := by + simp [rawExplicitOptimizerGap, rawOptimizerFour, pow_two] + +@[simp] theorem rawOptimizerObjectiveRange_value (n B : ℕ) : + (rawOptimizerObjectiveRange n B).value = n * B + 3 * n ^ 2 := by + simp [rawOptimizerObjectiveRange, rawOptimizerThree, + rawOptimizerNSquare] + ring + +@[simp] theorem rawOptimizerMixDenominator_value (n B : ℕ) : + (rawOptimizerMixDenominator n B).value = + 4 * ((rawOptimizerObjectiveRange n B).value + 1) := by + simp [rawOptimizerMixDenominator, rawOptimizerFour, rawOptimizerOne] + +@[simp] theorem rawOptimizerMixCandidate_value (n B : ℕ) : + (rawOptimizerMixCandidate n B).value = + (rawExplicitOptimizerGap n B).value / + (4 * ((rawOptimizerObjectiveRange n B).value + 1)) := by + simp [rawOptimizerMixCandidate] + +@[simp] theorem rawExplicitOptimizerMix_value (n B : ℕ) : + (rawExplicitOptimizerMix n B).value = + min (1 / 2) + ((rawExplicitOptimizerGap n B).value / + (4 * ((rawOptimizerObjectiveRange n B).value + 1))) := by + rw [← rawOptimizerHalf_value, + ← rawOptimizerMixCandidate_value] + rw [rawExplicitOptimizerMix] + by_cases h : rawOptimizerHalf.value ≤ + (rawOptimizerMixCandidate n B).value + · rw [if_pos h, min_eq_left h] + · rw [if_neg h, min_eq_right (le_of_not_ge h)] + +@[simp] theorem rawExplicitOptimizerInnerRadius_value (n B : ℕ) : + (rawExplicitOptimizerInnerRadius n B).value = + (rawExplicitOptimizerMix n B).value / (2 * n) := by + simp [rawExplicitOptimizerInnerRadius, rawOptimizerTwiceDimension, + rawOptimizerTwo] + +theorem rawExplicitOptimizerScales_value {m : ℕ} + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) : + (rawExplicitOptimizerFloor (m + 1) + (rationalMatrixEntryBitBound A)).value = explicitOptimizerFloor A ∧ + (rawExplicitOptimizerRho (m + 1) + (rationalMatrixEntryBitBound A)).value = explicitOptimizerRho A ∧ + (rawExplicitOptimizerGap (m + 1) + (rationalMatrixEntryBitBound A)).value = explicitOptimizerGap A ∧ + (rawExplicitOptimizerMix (m + 1) + (rationalMatrixEntryBitBound A)).value = explicitOptimizerMix A ∧ + (rawExplicitOptimizerInnerRadius (m + 1) + (rationalMatrixEntryBitBound A)).value = + explicitOptimizerInnerRadius A := by + simp [explicitOptimizerFloor, explicitOptimizerRho, explicitOptimizerGap, + explicitOptimizerMix, explicitOptimizerInnerRadius, + rationalRegularizedObjectiveRange] + +/-! ## Exact unary precision ruler -/ + +def machineExplicitOptimizerGapEntryCode (word : List Bool) : List Bool := + machineNormalizeRawRatEntryCode (machineExplicitOptimizerGapRawCode word) + +def machineExplicitOptimizerGapLengthRuler + (word : List Bool) : List Bool := + machineOptimizerEntryLengthRuler + (machineExplicitOptimizerGapEntryCode word) + +def machineExplicitOptimizerPrecisionRuler + (word : List Bool) : List Bool := + machineExplicitOptimizerGapLengthRuler word ++ + (List.replicate (encodedBitLength ℚ explicitKKTError) true ++ + (machineOptimizerDimensionUnary word ++ + (machineOptimizerDimensionUnary word ++ List.replicate 10 true))) + +theorem machineExplicitOptimizerGapEntryCode_mem_FP : + machineExplicitOptimizerGapEntryCode ∈ FP := by + simpa only [machineExplicitOptimizerGapEntryCode] using + machineCompose_mem_FP machineExplicitOptimizerGapRawCode_mem_FP + machineNormalizeRawRatEntryCode_mem_FP + +theorem machineExplicitOptimizerGapLengthRuler_mem_FP : + machineExplicitOptimizerGapLengthRuler ∈ FP := by + simpa only [machineExplicitOptimizerGapLengthRuler] using + machineCompose_mem_FP machineExplicitOptimizerGapEntryCode_mem_FP + machineOptimizerEntryLengthRuler_mem_FP + +theorem machineExplicitOptimizerPrecisionRuler_mem_FP : + machineExplicitOptimizerPrecisionRuler ∈ FP := by + have hdim2 := machineAppend_mem_FP machineOptimizerDimensionUnary_mem_FP + (machineAppend_mem_FP machineOptimizerDimensionUnary_mem_FP + (machineConst_mem_FP (List.replicate 10 true))) + have htail := machineAppend_mem_FP + (machineConst_mem_FP + (List.replicate (encodedBitLength ℚ explicitKKTError) true)) hdim2 + simpa only [machineExplicitOptimizerPrecisionRuler] using + machineAppend_mem_FP machineExplicitOptimizerGapLengthRuler_mem_FP htail + +@[simp] theorem machineExplicitOptimizerGapEntryCode_encode + {n : ℕ} (hn : 1 ≤ n) (A : Matrix (Fin n) (Fin n) ℚ) : + machineExplicitOptimizerGapEntryCode + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩) = + rationalEntryBinaryCode + ((rawExplicitOptimizerGap n + (rationalMatrixEntryBitBound A)).value) := by + rw [machineExplicitOptimizerGapEntryCode, + machineExplicitOptimizerGapRawCode_encode hn, + machineNormalizeRawRatEntryCode_encode, + binaryNormalizeRawRat_eq_value] + +@[simp] theorem machineExplicitOptimizerGapLengthRuler_encode + {n : ℕ} (hn : 1 ≤ n) (A : Matrix (Fin n) (Fin n) ℚ) : + machineExplicitOptimizerGapLengthRuler + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩) = + List.replicate + (encodedBitLength ℚ + ((rawExplicitOptimizerGap n + (rationalMatrixEntryBitBound A)).value)) true := by + rw [machineExplicitOptimizerGapLengthRuler, + machineExplicitOptimizerGapEntryCode_encode hn, + machineOptimizerEntryLengthRuler_encode] + +@[simp] theorem machineExplicitOptimizerPrecisionRuler_encode + {m : ℕ} (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) : + machineExplicitOptimizerPrecisionRuler + (rationalMatrixBinaryEncoding.encode ⟨m + 1, A⟩) = + List.replicate (explicitOptimizerPrecision A) true := by + rw [machineExplicitOptimizerPrecisionRuler, + machineExplicitOptimizerGapLengthRuler_encode (by omega), + machineOptimizerDimensionUnary_encode] + have hgap := (rawExplicitOptimizerScales_value A).2.2.1 + rw [hgap] + simp only [← List.replicate_add, explicitOptimizerPrecision] + congr 1 + omega + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerEntryLength.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerEntryLength.lean new file mode 100644 index 0000000000..c502f65fc2 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerEntryLength.lean @@ -0,0 +1,400 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineIntegerSignedMagnitude +import LeanPool.BeyondBethe.BeyondBethe.MachineLengthBits +import LeanPool.BeyondBethe.BeyondBethe.RationalEncodingBounds + +/-! +# Exact unary lengths for optimizer matrix entries + +The optimizer schedules use `encodedBitLength ℚ q`, not merely the length of +the machine-facing rational-entry word. This module computes that quantity +exactly from the numerator and denominator subwords. Producing a unary ruler +is the useful form: every later precision loop consumes its schedule in unary. +-/ + +namespace BeyondBethe + +open Complexity + +def boolDataSize : Bool → ℕ + | false => 2 + | true => 4 + +def boolDataLength (word : List Bool) : ℕ := + (word.map boolDataSize).sum + +def boolDataRuler (word : List Bool) : List Bool := + word.flatMap fun bit ↦ List.replicate (boolDataSize bit) true + +@[simp] theorem boolDataRuler_length (word : List Bool) : + (boolDataRuler word).length = boolDataLength word := by + simp [boolDataRuler, boolDataLength] + +theorem boolDataRuler_eq_replicate (word : List Bool) : + boolDataRuler word = List.replicate (boolDataLength word) true := by + induction word with + | nil => simp [boolDataRuler, boolDataLength] + | cons bit word ih => + change List.replicate (boolDataSize bit) true ++ boolDataRuler word = _ + rw [ih, ← List.replicate_add] + congr 1 + +theorem boolDataLength_le_four_mul_length (word : List Bool) : + boolDataLength word ≤ 4 * word.length := by + induction word with + | nil => simp [boolDataLength] + | cons bit word ih => + change boolDataSize bit + boolDataLength word ≤ + 4 * (word.length + 1) + cases bit <;> simp [boolDataSize] <;> omega + +theorem bool_dataEncode_size_eq (b : Bool) : + (DataEncode.encode b).size = boolDataSize b := by + cases b <;> norm_num [DataEncode.encode, Data.size, boolDataSize] + +theorem nat_encodedBitLength_eq_boolDataLength (n : ℕ) : + encodedBitLength ℕ n = 2 + boolDataLength n.bits := by + rw [encodedBitLength_eq_dataSize] + change (Data.l (n.bits.map fun b ↦ DataEncode.encode b)).size = _ + rw [Data.size] + unfold boolDataLength + congr 1 + simp only [List.map_map] + apply congrArg List.sum + apply List.map_congr_left + intro b _ + exact bool_dataEncode_size_eq b + +theorem integer_encodedBitLength_eq_boolDataLength (z : ℤ) : + encodedBitLength ℤ z = + 4 + boolDataSize (integerPayload z).1 + + boolDataLength z.natAbs.bits := by + rw [encodedBitLength_eq_dataSize] + change (DataEncode.encode (integerPayload z)).size = _ + rw [show DataEncode.encode (integerPayload z) = + Data.l [DataEncode.encode (integerPayload z).1, + DataEncode.encode (integerPayload z).2] by + exact DataEncode_pair _ _] + simp only [Data.size, List.map_cons, List.map_nil, List.sum_cons, + List.sum_nil, add_zero, bool_dataEncode_size_eq] + rw [← encodedBitLength_eq_dataSize, + nat_encodedBitLength_eq_boolDataLength, integerPayload_snd] + omega + +theorem rational_encodedBitLength_eq_boolDataLength (q : ℚ) : + encodedBitLength ℚ q = + 8 + boolDataSize (integerPayload q.num).1 + + boolDataLength q.num.natAbs.bits + boolDataLength q.den.bits := by + rw [encodedBitLength_eq_dataSize] + change (DataEncode.encode (rationalPayload q)).size = _ + rw [show DataEncode.encode (rationalPayload q) = + Data.l [DataEncode.encode q.num, DataEncode.encode q.den] by + simpa only [rationalPayload] using DataEncode_pair q.num q.den] + simp only [Data.size, List.map_cons, List.map_nil, List.sum_cons, + List.sum_nil, add_zero] + rw [← encodedBitLength_eq_dataSize, + ← encodedBitLength_eq_dataSize, + integer_encodedBitLength_eq_boolDataLength, + nat_encodedBitLength_eq_boolDataLength] + omega + +/-! ## A finite-word transducer for `boolDataRuler` -/ + +def machineBoolDataPack (remaining acc : List Bool) : List Bool := + pair remaining acc + +def machineBoolDataRemaining (state : List Bool) : List Bool := + machinePairFirst state + +def machineBoolDataAcc (state : List Bool) : List Bool := + machinePairSecond state + +def machineBoolDataBitRuler (state : List Bool) : List Bool := + machineIfHead (machineBoolDataRemaining state) + (List.replicate 4 true) (List.replicate 2 true) + +def machineBoolDataContinue (state : List Bool) : List Bool := + machineBoolDataPack (machineBoolDataRemaining state).tail + (machineBoolDataAcc state ++ machineBoolDataBitRuler state) + +def machineBoolDataStep (state : List Bool) : List Bool := + machineIfEmpty (machineBoolDataRemaining state) state + (machineBoolDataContinue state) + +def machineBoolDataInit (word : List Bool) : List Bool := + machineBoolDataPack word [] + +def machineBoolDataBound (word : List Bool) : List Bool := + List.replicate 4 true ++ + (word ++ (word ++ (word ++ word))) + +def machineBoolDataWidth (word : List Bool) : List Bool := + machineBoolDataPack (machineBoolDataBound word) + (machineBoolDataBound word) + +def machineBoolDataFinalState (word : List Bool) : List Bool := + (machineBoolDataStep)^[word.length] (machineBoolDataInit word) + +def machineBoolDataLengthRuler (word : List Bool) : List Bool := + machineBoolDataAcc (machineBoolDataFinalState word) + +theorem machineBoolDataRemaining_mem_FP : + machineBoolDataRemaining ∈ Complexity.FP := machinePairFirst_mem_FP + +theorem machineBoolDataAcc_mem_FP : + machineBoolDataAcc ∈ Complexity.FP := machinePairSecond_mem_FP + +theorem machineBoolDataBitRuler_mem_FP : + machineBoolDataBitRuler ∈ Complexity.FP := by + exact machineIfHead_mem_FP machineBoolDataRemaining_mem_FP + (machineConst_mem_FP (List.replicate 4 true)) + (machineConst_mem_FP (List.replicate 2 true)) + +theorem machineBoolDataContinue_mem_FP : + machineBoolDataContinue ∈ Complexity.FP := by + have hremaining := machineCompose_mem_FP + machineBoolDataRemaining_mem_FP machineTail_mem_FP + have hacc := machineAppend_mem_FP machineBoolDataAcc_mem_FP + machineBoolDataBitRuler_mem_FP + exact machinePair_mem_FP hremaining hacc + +theorem machineBoolDataStep_mem_FP : + machineBoolDataStep ∈ Complexity.FP := by + simpa only [machineBoolDataStep] using + machineIfEmpty_mem_FP machineBoolDataRemaining_mem_FP + id_mem_FP machineBoolDataContinue_mem_FP + +theorem machineBoolDataInit_mem_FP : + machineBoolDataInit ∈ Complexity.FP := by + exact machinePair_mem_FP id_mem_FP (machineConst_mem_FP []) + +theorem machineBoolDataBound_mem_FP : + machineBoolDataBound ∈ Complexity.FP := by + have hdouble := machineAppend_mem_FP id_mem_FP id_mem_FP + have htriple := machineAppend_mem_FP id_mem_FP hdouble + have hquadruple := machineAppend_mem_FP id_mem_FP htriple + simpa only [machineBoolDataBound] using + machineAppend_mem_FP + (machineConst_mem_FP (List.replicate 4 true)) hquadruple + +theorem machineBoolDataWidth_mem_FP : + machineBoolDataWidth ∈ Complexity.FP := by + exact machinePair_mem_FP machineBoolDataBound_mem_FP + machineBoolDataBound_mem_FP + +@[simp] theorem machineBoolDataRemaining_pack (remaining acc) : + machineBoolDataRemaining (machineBoolDataPack remaining acc) = + remaining := by + simp [machineBoolDataRemaining, machineBoolDataPack] + +@[simp] theorem machineBoolDataAcc_pack (remaining acc) : + machineBoolDataAcc (machineBoolDataPack remaining acc) = acc := by + simp [machineBoolDataAcc, machineBoolDataPack] + +def MachineBoolDataStateBound + (word : List Bool) (iterations : ℕ) (state : List Bool) : Prop := + state = machineBoolDataPack + (machineBoolDataRemaining state) (machineBoolDataAcc state) ∧ + (machineBoolDataRemaining state).length ≤ word.length ∧ + (machineBoolDataAcc state).length ≤ 4 * iterations + +theorem machineBoolDataInit_bound (word : List Bool) : + MachineBoolDataStateBound word 0 (machineBoolDataInit word) := by + simp [MachineBoolDataStateBound, machineBoolDataInit] + +theorem machineBoolDataStep_bound + {word state : List Bool} {iterations : ℕ} + (hstate : MachineBoolDataStateBound word iterations state) : + MachineBoolDataStateBound word (iterations + 1) + (machineBoolDataStep state) := by + rcases hstate with ⟨hdecomp, hremaining, hacc⟩ + cases hrem : machineBoolDataRemaining state with + | nil => + rw [machineBoolDataStep, hrem, machineIfEmpty_nil] + exact ⟨hdecomp, hremaining, hacc.trans (by omega)⟩ + | cons bit tail => + rw [machineBoolDataStep, hrem, machineIfEmpty_cons, + machineBoolDataContinue] + simp only [MachineBoolDataStateBound, + machineBoolDataRemaining_pack, machineBoolDataAcc_pack, + List.length_append, List.length_tail] + refine ⟨trivial, ?_, ?_⟩ + · omega + · have hbit : (machineBoolDataBitRuler state).length ≤ 4 := by + rw [machineBoolDataBitRuler, hrem] + cases bit <;> simp + omega + +theorem machineBoolDataIterate_bound (word : List Bool) : ∀ k, + MachineBoolDataStateBound word k + ((machineBoolDataStep)^[k] (machineBoolDataInit word)) := by + intro k + induction k with + | zero => exact machineBoolDataInit_bound word + | succ k ih => + rw [Function.iterate_succ_apply'] + exact machineBoolDataStep_bound ih + +theorem machineBoolDataIterate_length_le_width + (word : List Bool) (iterations : ℕ) + (hiterations : iterations ≤ word.length) : + ((machineBoolDataStep)^[iterations] + (machineBoolDataInit word)).length ≤ + (machineBoolDataWidth word).length := by + rcases machineBoolDataIterate_bound word iterations with + ⟨hdecomp, hremaining, hacc⟩ + rw [hdecomp] + simp only [machineBoolDataPack, machineBoolDataWidth, pair_length, + machineBoolDataBound, List.length_append, List.length_replicate] + omega + +theorem machineBoolDataFinalState_mem_FP : + machineBoolDataFinalState ∈ Complexity.FP := by + exact Cobham.iterate_mem_FP machineBoolDataStep_mem_FP + machineBoolDataInit_mem_FP id_mem_FP machineBoolDataWidth_mem_FP + machineBoolDataIterate_length_le_width + +theorem machineBoolDataLengthRuler_mem_FP : + machineBoolDataLengthRuler ∈ Complexity.FP := by + simpa only [machineBoolDataLengthRuler] using + machineCompose_mem_FP machineBoolDataFinalState_mem_FP + machineBoolDataAcc_mem_FP + +theorem machineBoolDataIterate_complete (word acc : List Bool) : + (machineBoolDataStep)^[word.length] + (machineBoolDataPack word acc) = + machineBoolDataPack [] (acc ++ boolDataRuler word) := by + induction word generalizing acc with + | nil => simp [boolDataRuler] + | cons bit word ih => + rw [List.length_cons, Function.iterate_succ_apply] + simp only [machineBoolDataStep, machineBoolDataRemaining_pack, + machineIfEmpty_cons, machineBoolDataContinue, + machineBoolDataAcc_pack, List.tail_cons] + have hbit : machineBoolDataBitRuler + (machineBoolDataPack (bit :: word) acc) = + List.replicate (boolDataSize bit) true := by + cases bit <;> simp [machineBoolDataBitRuler, boolDataSize] + rw [hbit, ih] + simp [boolDataRuler, List.append_assoc] + +@[simp] theorem machineBoolDataLengthRuler_encode (word : List Bool) : + machineBoolDataLengthRuler word = boolDataRuler word := by + rw [machineBoolDataLengthRuler, machineBoolDataFinalState, + machineBoolDataInit, machineBoolDataIterate_complete] + simp + +/-! ## One rational entry -/ + +def machineOptimizerEntryNumeratorCode (word : List Bool) : List Bool := + machineRationalEntryNumeratorWord word + +def machineOptimizerEntryNatAbsBits (word : List Bool) : List Bool := + machineIntegerNatAbsBits (machineOptimizerEntryNumeratorCode word) + +def machineOptimizerEntrySignRuler (word : List Bool) : List Bool := + machineIfHead (machineOptimizerEntryNumeratorCode word) + (List.replicate 4 true) (List.replicate 2 true) + +def machineOptimizerEntryNumeratorRuler (word : List Bool) : List Bool := + machineBoolDataLengthRuler (machineOptimizerEntryNatAbsBits word) + +def machineOptimizerEntryDenominatorRuler (word : List Bool) : List Bool := + machineBoolDataLengthRuler + (machineRationalEntryDenominatorWord word) + +/-- A unary word of length exactly `encodedBitLength ℚ q` on a canonical +rational-entry input. -/ +def machineOptimizerEntryLengthRuler (word : List Bool) : List Bool := + List.replicate 8 true ++ + (machineOptimizerEntrySignRuler word ++ + (machineOptimizerEntryNumeratorRuler word ++ + machineOptimizerEntryDenominatorRuler word)) + +theorem machineOptimizerEntryNumeratorCode_mem_FP : + machineOptimizerEntryNumeratorCode ∈ Complexity.FP := + machineRationalEntryNumeratorWord_mem_FP + +theorem machineOptimizerEntryNatAbsBits_mem_FP : + machineOptimizerEntryNatAbsBits ∈ Complexity.FP := by + simpa only [machineOptimizerEntryNatAbsBits] using + machineCompose_mem_FP machineOptimizerEntryNumeratorCode_mem_FP + machineIntegerNatAbsBits_mem_FP + +theorem machineOptimizerEntrySignRuler_mem_FP : + machineOptimizerEntrySignRuler ∈ Complexity.FP := by + exact machineIfHead_mem_FP machineOptimizerEntryNumeratorCode_mem_FP + (machineConst_mem_FP (List.replicate 4 true)) + (machineConst_mem_FP (List.replicate 2 true)) + +theorem machineOptimizerEntryNumeratorRuler_mem_FP : + machineOptimizerEntryNumeratorRuler ∈ Complexity.FP := by + simpa only [machineOptimizerEntryNumeratorRuler] using + machineCompose_mem_FP machineOptimizerEntryNatAbsBits_mem_FP + machineBoolDataLengthRuler_mem_FP + +theorem machineOptimizerEntryDenominatorRuler_mem_FP : + machineOptimizerEntryDenominatorRuler ∈ Complexity.FP := by + simpa only [machineOptimizerEntryDenominatorRuler] using + machineCompose_mem_FP machineRationalEntryDenominatorWord_mem_FP + machineBoolDataLengthRuler_mem_FP + +theorem machineOptimizerEntryLengthRuler_mem_FP : + machineOptimizerEntryLengthRuler ∈ Complexity.FP := by + have htail := machineAppend_mem_FP + machineOptimizerEntryNumeratorRuler_mem_FP + machineOptimizerEntryDenominatorRuler_mem_FP + have hpayload := machineAppend_mem_FP + machineOptimizerEntrySignRuler_mem_FP htail + simpa only [machineOptimizerEntryLengthRuler] using + machineAppend_mem_FP + (machineConst_mem_FP (List.replicate 8 true)) hpayload + +@[simp] theorem machineOptimizerEntryNumeratorCode_encode (q : ℚ) : + machineOptimizerEntryNumeratorCode (rationalEntryBinaryCode q) = + integerBinaryCode q.num := by + exact machineRationalEntryNumeratorWord_encode q + +@[simp] theorem machineOptimizerEntryNatAbsBits_encode (q : ℚ) : + machineOptimizerEntryNatAbsBits (rationalEntryBinaryCode q) = + q.num.natAbs.bits := by + rw [machineOptimizerEntryNatAbsBits, + machineOptimizerEntryNumeratorCode_encode, + machineIntegerNatAbsBits_encode] + +@[simp] theorem machineOptimizerEntrySignRuler_encode (q : ℚ) : + machineOptimizerEntrySignRuler (rationalEntryBinaryCode q) = + List.replicate (boolDataSize (integerPayload q.num).1) true := by + rw [machineOptimizerEntrySignRuler, + machineOptimizerEntryNumeratorCode_encode] + cases q.num <;> simp [integerBinaryCode, integerPayload, boolDataSize] + +@[simp] theorem machineOptimizerEntryNumeratorRuler_encode (q : ℚ) : + machineOptimizerEntryNumeratorRuler (rationalEntryBinaryCode q) = + boolDataRuler q.num.natAbs.bits := by + simp [machineOptimizerEntryNumeratorRuler] + +@[simp] theorem machineOptimizerEntryDenominatorRuler_encode (q : ℚ) : + machineOptimizerEntryDenominatorRuler (rationalEntryBinaryCode q) = + boolDataRuler q.den.bits := by + simp [machineOptimizerEntryDenominatorRuler] + +@[simp] theorem machineOptimizerEntryLengthRuler_encode (q : ℚ) : + machineOptimizerEntryLengthRuler (rationalEntryBinaryCode q) = + List.replicate (encodedBitLength ℚ q) true := by + rw [machineOptimizerEntryLengthRuler, + machineOptimizerEntrySignRuler_encode, + machineOptimizerEntryNumeratorRuler_encode, + machineOptimizerEntryDenominatorRuler_encode, + rational_encodedBitLength_eq_boolDataLength] + rw [boolDataRuler_eq_replicate, boolDataRuler_eq_replicate] + simp only [← List.replicate_add] + congr 1 + omega + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerFeasibilityCall.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerFeasibilityCall.lean new file mode 100644 index 0000000000..82a7903aed --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerFeasibilityCall.lean @@ -0,0 +1,285 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerStateBound +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalBallInit + +/-! +# A complete finite-word Bethe threshold call + +This module assembles one canonical threshold-feasibility input directly from +the matrix word and a raw rational threshold. Every numerical parameter, +the initial ball, and the state-size ruler are produced by verified +finite-word machines. +-/ + +namespace BeyondBethe + +open Complexity + +def machineOptimizerFeasibilityReducedDimensionUnary + (word : List Bool) : List Bool := + machineBoundedUnary + (pair (machineOptimizerFeasibilitySource word) + (machineOptimizerFeasibilityReducedDimensionBits word)) + +def machineOptimizerFeasibilityTauCode + (word : List Bool) : List Bool := + machineNormalizeRawRatEntryCode + (machineOptimizerTauRawCode (machineOptimizerFeasibilitySource word)) + +def machineOptimizerFeasibilityDeltaRawCode + (word : List Bool) : List Bool := + machineExplicitOptimizerFloorRawCode + (machineOptimizerFeasibilitySource word) + +def machineOptimizerFeasibilityOracleStaticCode + (word : List Bool) : List Bool := + pair (machineOptimizerFeasibilityReducedDimensionUnary word) + (pair + (machineExplicitOptimizerPrecisionRuler + (machineOptimizerFeasibilitySource word)) + (pair (machineOptimizerFeasibilityTauCode word) + (pair (machineOptimizerFeasibilityDeltaRawCode word) + (pair (machineOptimizerFeasibilityUpperRawCode word) + (machineOptimizerFeasibilitySource word))))) + +def machineOptimizerFeasibilityInitialBallCode + (word : List Bool) : List Bool := + machineRationalBallStateCode + (pair (machineOptimizerFeasibilityEllipsoidDimensionUnary word) + (machineOptimizerFeasibilityOuterRadiusEntryCode word)) + +def machineOptimizerFeasibilityLoopWord + (word : List Bool) : List Bool := + pair (machineOptimizerFeasibilityBudgetUnary word) + (pair (machineOptimizerFeasibilityStateBoundUnary word) + (pair (machineOptimizerFeasibilityRoundingPrecisionUnary word) + (pair (machineOptimizerFeasibilityOracleStaticCode word) + (machineOptimizerFeasibilityInitialBallCode word)))) + +def machineExplicitBetheThresholdFeasibilityCode + (word : List Bool) : List Bool := + machineBetheFeasibilityResultCode + (machineOptimizerFeasibilityLoopWord word) + +/-! ## Polynomial-time closure -/ + +theorem machineOptimizerFeasibilityReducedDimensionUnary_mem_FP : + machineOptimizerFeasibilityReducedDimensionUnary ∈ FP := by + simpa only [machineOptimizerFeasibilityReducedDimensionUnary] using + machineCompose_mem_FP + (machinePair_mem_FP machineOptimizerFeasibilitySource_mem_FP + machineOptimizerFeasibilityReducedDimensionBits_mem_FP) + machineBoundedUnary_mem_FP + +theorem machineOptimizerFeasibilityTauCode_mem_FP : + machineOptimizerFeasibilityTauCode ∈ FP := by + have htau := machineCompose_mem_FP + machineOptimizerFeasibilitySource_mem_FP + machineOptimizerTauRawCode_mem_FP + simpa only [machineOptimizerFeasibilityTauCode] using + machineCompose_mem_FP htau machineNormalizeRawRatEntryCode_mem_FP + +theorem machineOptimizerFeasibilityDeltaRawCode_mem_FP : + machineOptimizerFeasibilityDeltaRawCode ∈ FP := by + simpa only [machineOptimizerFeasibilityDeltaRawCode] using + machineCompose_mem_FP machineOptimizerFeasibilitySource_mem_FP + machineExplicitOptimizerFloorRawCode_mem_FP + +theorem machineOptimizerFeasibilityOracleStaticCode_mem_FP : + machineOptimizerFeasibilityOracleStaticCode ∈ FP := by + exact machinePair_mem_FP + machineOptimizerFeasibilityReducedDimensionUnary_mem_FP + (machinePair_mem_FP + (machineCompose_mem_FP machineOptimizerFeasibilitySource_mem_FP + machineExplicitOptimizerPrecisionRuler_mem_FP) + (machinePair_mem_FP machineOptimizerFeasibilityTauCode_mem_FP + (machinePair_mem_FP + machineOptimizerFeasibilityDeltaRawCode_mem_FP + (machinePair_mem_FP + machineOptimizerFeasibilityUpperRawCode_mem_FP + machineOptimizerFeasibilitySource_mem_FP)))) + +theorem machineOptimizerFeasibilityInitialBallCode_mem_FP : + machineOptimizerFeasibilityInitialBallCode ∈ FP := by + simpa only [machineOptimizerFeasibilityInitialBallCode] using + machineCompose_mem_FP + (machinePair_mem_FP + machineOptimizerFeasibilityEllipsoidDimensionUnary_mem_FP + machineOptimizerFeasibilityOuterRadiusEntryCode_mem_FP) + machineRationalBallStateCode_mem_FP + +theorem machineOptimizerFeasibilityLoopWord_mem_FP : + machineOptimizerFeasibilityLoopWord ∈ FP := by + exact machinePair_mem_FP machineOptimizerFeasibilityBudgetUnary_mem_FP + (machinePair_mem_FP machineOptimizerFeasibilityStateBoundUnary_mem_FP + (machinePair_mem_FP + machineOptimizerFeasibilityRoundingPrecisionUnary_mem_FP + (machinePair_mem_FP + machineOptimizerFeasibilityOracleStaticCode_mem_FP + machineOptimizerFeasibilityInitialBallCode_mem_FP))) + +theorem machineExplicitBetheThresholdFeasibilityCode_mem_FP : + machineExplicitBetheThresholdFeasibilityCode ∈ FP := by + simpa only [machineExplicitBetheThresholdFeasibilityCode] using + machineCompose_mem_FP machineOptimizerFeasibilityLoopWord_mem_FP + machineBetheFeasibilityResultCode_mem_FP + +/-! ## Exact canonical semantics -/ + +@[simp] theorem machineOptimizerFeasibilityReducedDimensionUnary_encode + {n : ℕ} (hn : 2 ≤ n) (A : Matrix (Fin n) (Fin n) ℚ) + (upper : RawRat) : + machineOptimizerFeasibilityReducedDimensionUnary + (optimizerFeasibilityCallCode A upper) = + List.replicate (n - 1) true := by + rw [machineOptimizerFeasibilityReducedDimensionUnary, + machineOptimizerFeasibilitySource_encode, + machineOptimizerFeasibilityReducedDimensionBits_encode] + apply machineBoundedUnary_encode_of_le + exact (show n - 1 ≤ (n - 1) ^ 2 + 1 by nlinarith).trans + (optimizerEllipsoidDimension_le_sourceLength hn A) + +@[simp] theorem machineOptimizerFeasibilityTauCode_encode + {n : ℕ} (A : Matrix (Fin n) (Fin n) ℚ) (upper : RawRat) : + machineOptimizerFeasibilityTauCode + (optimizerFeasibilityCallCode A upper) = + rawRatBinaryCode (rawRatOfRat (explicitRegularizationScale n)) := by + rw [machineOptimizerFeasibilityTauCode, + machineOptimizerFeasibilitySource_encode, + machineOptimizerTauRawCode_encode, + machineNormalizeRawRatEntryCode_encode, + binaryNormalizeRawRat_eq_value, rawOptimizerTau_value, + rawRatBinaryCode_rawRatOfRat] + +@[simp] theorem machineOptimizerFeasibilityDeltaRawCode_encode + {n : ℕ} (hn : 1 ≤ n) (A : Matrix (Fin n) (Fin n) ℚ) + (upper : RawRat) : + machineOptimizerFeasibilityDeltaRawCode + (optimizerFeasibilityCallCode A upper) = + rawRatBinaryCode + (rawExplicitOptimizerFloor n (rationalMatrixEntryBitBound A)) := by + rw [machineOptimizerFeasibilityDeltaRawCode, + machineOptimizerFeasibilitySource_encode, + machineExplicitOptimizerFloorRawCode_encode hn] + rfl + +@[simp] theorem machineOptimizerFeasibilityOracleStaticCode_encode + {m : ℕ} (hm : 0 < m) + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (upper : RawRat) : + machineOptimizerFeasibilityOracleStaticCode + (optimizerFeasibilityCallCode A upper) = + machineBetheFeasibilityCanonicalStaticWord + (explicitRegularizationScale (m + 1)) A + (explicitOptimizerPrecision A) + (rawExplicitOptimizerFloor (m + 1) + (rationalMatrixEntryBitBound A)) upper := by + rw [machineOptimizerFeasibilityOracleStaticCode, + machineOptimizerFeasibilityReducedDimensionUnary_encode (by omega), + machineOptimizerFeasibilitySource_encode, + machineExplicitOptimizerPrecisionRuler_encode, + machineOptimizerFeasibilityTauCode_encode, + machineOptimizerFeasibilityDeltaRawCode_encode (by omega), + machineOptimizerFeasibilityUpperRawCode_encode, + machineBetheFeasibilityCanonicalStaticWord] + have hm1 : m + 1 - 1 = m := by omega + rw [hm1] + +@[simp] theorem machineOptimizerFeasibilityInitialBallCode_encode + {n : ℕ} (hn : 2 ≤ n) (A : Matrix (Fin n) (Fin n) ℚ) + (upper : RawRat) : + machineOptimizerFeasibilityInitialBallCode + (optimizerFeasibilityCallCode A upper) = + rationalEllipsoidStateBinaryCode + (rationalBallEllipsoid ((n - 1) ^ 2 + 1) 0 + (rawOptimizerFeasibilityOuterRadius n + (rationalMatrixEntryBitBound A) upper).value) := by + rw [machineOptimizerFeasibilityInitialBallCode, + machineOptimizerFeasibilityEllipsoidDimensionUnary_encode hn, + machineOptimizerFeasibilityOuterRadiusEntryCode_encode (by omega)] + change machineRationalBallStateCode + (machineDiagonalBasisCanonicalInput ((n - 1) ^ 2 + 1) + (rawOptimizerFeasibilityOuterRadius n + (rationalMatrixEntryBitBound A) upper).value) = _ + exact machineRationalBallStateCode_encode _ _ + +@[simp] theorem machineOptimizerFeasibilityLoopWord_encode + {m : ℕ} (hm : 0 < m) + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (upper : RawRat) : + machineOptimizerFeasibilityLoopWord + (optimizerFeasibilityCallCode A upper) = + machineBetheFeasibilityCanonicalWord + (explicitRegularizationScale (m + 1)) A + (explicitOptimizerPrecision A) + (rawExplicitOptimizerFloor (m + 1) + (rationalMatrixEntryBitBound A)) upper + (explicitBallFeasibilityPrecision (m * m + 1) + (betheThresholdFeasibilityBudget m upper.value + (explicitOptimizerInnerRadius A)) + (betheEpigraphOuterRadius m upper.value + (explicitOptimizerInnerRadius A))) + (betheThresholdFeasibilityBudget m upper.value + (explicitOptimizerInnerRadius A)) + (explicitBallFeasibilityStateCodeBound (m * m + 1) + (betheThresholdFeasibilityBudget m upper.value + (explicitOptimizerInnerRadius A)) + (betheEpigraphOuterRadius m upper.value + (explicitOptimizerInnerRadius A))) + (rationalBallEllipsoid (m * m + 1) 0 + (betheEpigraphOuterRadius m upper.value + (explicitOptimizerInnerRadius A))) := by + have hR := rawOptimizerFeasibilityOuterRadius_eq A upper + have hr := (rawExplicitOptimizerScales_value A).2.2.2.2 + rw [machineOptimizerFeasibilityLoopWord, + machineOptimizerFeasibilityBudgetUnary_eq_thresholdBudget hm, + machineOptimizerFeasibilityStateBoundUnary_encode (by omega), + machineOptimizerFeasibilityRoundingPrecisionUnary_encode (by omega), + machineOptimizerFeasibilityOracleStaticCode_encode hm, + machineOptimizerFeasibilityInitialBallCode_encode (by omega), + hR, hr] + have hd : (m + 1 - 1) ^ 2 + 1 = m * m + 1 := by + have hm1 : m + 1 - 1 = m := by omega + rw [hm1, pow_two] + rw [hd] + rfl + +theorem machineExplicitBetheThresholdFeasibilityCode_encode + {m : ℕ} (hm : 0 < m) + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (hA : ∀ i j, 0 < A i j) (upper : RawRat) : + machineExplicitBetheThresholdFeasibilityCode + (optimizerFeasibilityCallCode A upper) = + rationalFeasibilityResultBinaryCode + (runExplicitScannedBetheThresholdFeasibility + (explicitRegularizationScale (m + 1)) A + (explicitOptimizerPrecision A) + (rawExplicitOptimizerFloor (m + 1) + (rationalMatrixEntryBitBound A)) upper + (explicitOptimizerInnerRadius A)) := by + let tau := explicitRegularizationScale (m + 1) + let delta := rawExplicitOptimizerFloor (m + 1) + (rationalMatrixEntryBitBound A) + let r := explicitOptimizerInnerRadius A + let R := betheEpigraphOuterRadius m upper.value r + let T := betheThresholdFeasibilityBudget m upper.value r + have htau0 : 0 ≤ tau := (explicitRegularizationScale_pos (by omega)).le + have htau1 : tau ≤ 1 := explicitRegularizationScale_le_one (by omega) + have hdelta : 0 < delta.value := by + simpa only [delta, (rawExplicitOptimizerScales_value A).1] using + explicitOptimizerFloor_pos A + have hr : 0 < r := explicitOptimizerInnerRadius_pos A + have hR : 0 < R := betheEpigraphOuterRadius_pos m hr.le + rw [machineExplicitBetheThresholdFeasibilityCode, + machineOptimizerFeasibilityLoopWord_encode hm] + have hmachine := machineExplicitBallBetheFeasibilityResultCode_encode + hm htau0 htau1 hA (explicitOptimizerPrecision A) hdelta upper T hR + simpa only [tau, delta, r, R, T, + runExplicitScannedBetheThresholdFeasibility] using hmachine + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerFeasibilitySchedule.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerFeasibilitySchedule.lean new file mode 100644 index 0000000000..2b7fa307ff --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerFeasibilitySchedule.lean @@ -0,0 +1,864 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerBisectionSchedule + +/-! +# Finite-word budget for one Bethe feasibility call + +A feasibility-call word pairs the original matrix word with a raw rational +objective threshold. This file computes the ellipsoid dimension, the exact +outer radius, and the exact call budget. The final binary budget is expanded +to unary only behind a degree-eight guard built from the exact unary +dimension and the exact canonical bit lengths of both radii. +-/ + +namespace BeyondBethe + +open Complexity + +def optimizerFeasibilityCallCode {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) (upper : RawRat) : List Bool := + pair (rationalMatrixBinaryEncoding.encode ⟨n, A⟩) + (rawRatBinaryCode upper) + +def machineOptimizerFeasibilitySource (word : List Bool) : List Bool := + machinePairFirst word + +def machineOptimizerFeasibilityUpperRawCode + (word : List Bool) : List Bool := + machinePairSecond word + +def machineRawRatAbsCode (word : List Bool) : List Bool := + pair (machineNaturalIntegerCode + (machineIntegerNatAbsBits (machinePairFirst word))) + (machinePairSecond word) + +def rawRatAbs (q : RawRat) : RawRat := + ⟨q.num.natAbs, q.den, q.den_pos⟩ + +def machineOptimizerFeasibilityDimensionBits + (word : List Bool) : List Bool := + machineOptimizerDimensionBits (machineOptimizerFeasibilitySource word) + +def machineOptimizerFeasibilityReducedDimensionBits + (word : List Bool) : List Bool := + machineBinarySubBits + (pair (machineOptimizerFeasibilityDimensionBits word) [true]) + +def machineOptimizerFeasibilityReducedDimensionSquareBits + (word : List Bool) : List Bool := + machineBinaryMulBits + (pair (machineOptimizerFeasibilityReducedDimensionBits word) + (machineOptimizerFeasibilityReducedDimensionBits word)) + +def machineOptimizerFeasibilityEllipsoidDimensionBits + (word : List Bool) : List Bool := + machineBinaryAddBits + (pair (machineOptimizerFeasibilityReducedDimensionSquareBits word) [true]) + +def machineOptimizerFeasibilityEllipsoidDimensionUnary + (word : List Bool) : List Bool := + machineBoundedUnary + (pair (machineOptimizerFeasibilitySource word) + (machineOptimizerFeasibilityEllipsoidDimensionBits word)) + +def machineOptimizerFeasibilityEllipsoidDimensionRawCode + (word : List Bool) : List Bool := + pair (machineNaturalIntegerCode + (machineOptimizerFeasibilityEllipsoidDimensionBits word)) [true] + +def machineOptimizerFeasibilityInnerRadiusRawCode + (word : List Bool) : List Bool := + machineExplicitOptimizerInnerRadiusRawCode + (machineOptimizerFeasibilitySource word) + +def machineOptimizerFeasibilityTwiceInnerRadiusRawCode + (word : List Bool) : List Bool := + machineRawRatMulCode + (pair (rawRatBinaryCode rawOptimizerTwo) + (machineOptimizerFeasibilityInnerRadiusRawCode word)) + +def machineOptimizerFeasibilityOnePlusAbsUpperRawCode + (word : List Bool) : List Bool := + machineRawRatAddCode + (pair (rawRatBinaryCode rawOptimizerOne) + (machineRawRatAbsCode + (machineOptimizerFeasibilityUpperRawCode word))) + +def machineOptimizerFeasibilityRadiusFactorRawCode + (word : List Bool) : List Bool := + machineRawRatAddCode + (pair (machineOptimizerFeasibilityOnePlusAbsUpperRawCode word) + (machineOptimizerFeasibilityTwiceInnerRadiusRawCode word)) + +def machineOptimizerFeasibilityOuterRadiusRawCode + (word : List Bool) : List Bool := + machineRawRatMulCode + (pair (machineOptimizerFeasibilityEllipsoidDimensionRawCode word) + (machineOptimizerFeasibilityRadiusFactorRawCode word)) + +/-! ## Polynomial-time closure of the radius computation -/ + +theorem machineOptimizerFeasibilitySource_mem_FP : + machineOptimizerFeasibilitySource ∈ FP := machinePairFirst_mem_FP + +theorem machineOptimizerFeasibilityUpperRawCode_mem_FP : + machineOptimizerFeasibilityUpperRawCode ∈ FP := machinePairSecond_mem_FP + +theorem machineRawRatAbsCode_mem_FP : machineRawRatAbsCode ∈ FP := by + have habs := machineCompose_mem_FP machinePairFirst_mem_FP + machineIntegerNatAbsBits_mem_FP + have hnum := machineCompose_mem_FP habs machineNaturalIntegerCode_mem_FP + simpa only [machineRawRatAbsCode] using + machinePair_mem_FP hnum machinePairSecond_mem_FP + +theorem machineOptimizerFeasibilityDimensionBits_mem_FP : + machineOptimizerFeasibilityDimensionBits ∈ FP := by + simpa only [machineOptimizerFeasibilityDimensionBits] using + machineCompose_mem_FP machineOptimizerFeasibilitySource_mem_FP + machineOptimizerDimensionBits_mem_FP + +theorem machineOptimizerFeasibilityReducedDimensionBits_mem_FP : + machineOptimizerFeasibilityReducedDimensionBits ∈ FP := by + simpa only [machineOptimizerFeasibilityReducedDimensionBits] using + machineCompose_mem_FP + (machinePair_mem_FP machineOptimizerFeasibilityDimensionBits_mem_FP + (machineConst_mem_FP [true])) + machineBinarySubBits_mem_FP + +theorem machineOptimizerFeasibilityReducedDimensionSquareBits_mem_FP : + machineOptimizerFeasibilityReducedDimensionSquareBits ∈ FP := by + simpa only [machineOptimizerFeasibilityReducedDimensionSquareBits] using + machineCompose_mem_FP + (machinePair_mem_FP + machineOptimizerFeasibilityReducedDimensionBits_mem_FP + machineOptimizerFeasibilityReducedDimensionBits_mem_FP) + machineBinaryMulBits_mem_FP + +theorem machineOptimizerFeasibilityEllipsoidDimensionBits_mem_FP : + machineOptimizerFeasibilityEllipsoidDimensionBits ∈ FP := by + simpa only [machineOptimizerFeasibilityEllipsoidDimensionBits] using + machineCompose_mem_FP + (machinePair_mem_FP + machineOptimizerFeasibilityReducedDimensionSquareBits_mem_FP + (machineConst_mem_FP [true])) + machineBinaryAddBits_mem_FP + +theorem machineOptimizerFeasibilityEllipsoidDimensionUnary_mem_FP : + machineOptimizerFeasibilityEllipsoidDimensionUnary ∈ FP := by + simpa only [machineOptimizerFeasibilityEllipsoidDimensionUnary] using + machineCompose_mem_FP + (machinePair_mem_FP machineOptimizerFeasibilitySource_mem_FP + machineOptimizerFeasibilityEllipsoidDimensionBits_mem_FP) + machineBoundedUnary_mem_FP + +theorem machineOptimizerFeasibilityEllipsoidDimensionRawCode_mem_FP : + machineOptimizerFeasibilityEllipsoidDimensionRawCode ∈ FP := by + simpa only [machineOptimizerFeasibilityEllipsoidDimensionRawCode] using + machinePair_mem_FP + (machineCompose_mem_FP + machineOptimizerFeasibilityEllipsoidDimensionBits_mem_FP + machineNaturalIntegerCode_mem_FP) + (machineConst_mem_FP [true]) + +theorem machineOptimizerFeasibilityInnerRadiusRawCode_mem_FP : + machineOptimizerFeasibilityInnerRadiusRawCode ∈ FP := by + simpa only [machineOptimizerFeasibilityInnerRadiusRawCode] using + machineCompose_mem_FP machineOptimizerFeasibilitySource_mem_FP + machineExplicitOptimizerInnerRadiusRawCode_mem_FP + +theorem machineOptimizerFeasibilityTwiceInnerRadiusRawCode_mem_FP : + machineOptimizerFeasibilityTwiceInnerRadiusRawCode ∈ FP := by + simpa only [machineOptimizerFeasibilityTwiceInnerRadiusRawCode] using + machineCompose_mem_FP + (machinePair_mem_FP + (machineConst_mem_FP (rawRatBinaryCode rawOptimizerTwo)) + machineOptimizerFeasibilityInnerRadiusRawCode_mem_FP) + machineRawRatMulCode_mem_FP + +theorem machineOptimizerFeasibilityOnePlusAbsUpperRawCode_mem_FP : + machineOptimizerFeasibilityOnePlusAbsUpperRawCode ∈ FP := by + have habs := machineCompose_mem_FP + machineOptimizerFeasibilityUpperRawCode_mem_FP machineRawRatAbsCode_mem_FP + simpa only [machineOptimizerFeasibilityOnePlusAbsUpperRawCode] using + machineCompose_mem_FP + (machinePair_mem_FP + (machineConst_mem_FP (rawRatBinaryCode rawOptimizerOne)) habs) + machineRawRatAddCode_mem_FP + +theorem machineOptimizerFeasibilityRadiusFactorRawCode_mem_FP : + machineOptimizerFeasibilityRadiusFactorRawCode ∈ FP := by + simpa only [machineOptimizerFeasibilityRadiusFactorRawCode] using + machineCompose_mem_FP + (machinePair_mem_FP + machineOptimizerFeasibilityOnePlusAbsUpperRawCode_mem_FP + machineOptimizerFeasibilityTwiceInnerRadiusRawCode_mem_FP) + machineRawRatAddCode_mem_FP + +theorem machineOptimizerFeasibilityOuterRadiusRawCode_mem_FP : + machineOptimizerFeasibilityOuterRadiusRawCode ∈ FP := by + simpa only [machineOptimizerFeasibilityOuterRadiusRawCode] using + machineCompose_mem_FP + (machinePair_mem_FP + machineOptimizerFeasibilityEllipsoidDimensionRawCode_mem_FP + machineOptimizerFeasibilityRadiusFactorRawCode_mem_FP) + machineRawRatMulCode_mem_FP + +/-! ## Exact radius semantics -/ + +@[simp] theorem machineOptimizerFeasibilitySource_encode {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) (upper : RawRat) : + machineOptimizerFeasibilitySource + (optimizerFeasibilityCallCode A upper) = + rationalMatrixBinaryEncoding.encode ⟨n, A⟩ := by + simp [machineOptimizerFeasibilitySource, optimizerFeasibilityCallCode] + +@[simp] theorem machineOptimizerFeasibilityUpperRawCode_encode {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) (upper : RawRat) : + machineOptimizerFeasibilityUpperRawCode + (optimizerFeasibilityCallCode A upper) = + rawRatBinaryCode upper := by + simp [machineOptimizerFeasibilityUpperRawCode, + optimizerFeasibilityCallCode] + +@[simp] theorem machineRawRatAbsCode_encode (q : RawRat) : + machineRawRatAbsCode (rawRatBinaryCode q) = + rawRatBinaryCode (rawRatAbs q) := by + rw [machineRawRatAbsCode, rawRatBinaryCode, + machinePairFirst_pair, machineIntegerNatAbsBits_encode, + machineNaturalIntegerCode_natBits, machinePairSecond_pair] + rfl + +@[simp] theorem rawRatAbs_value (q : RawRat) : + (rawRatAbs q).value = abs q.value := by + rw [rawRatAbs, RawRat.value, RawRat.value] + rw [abs_div, abs_of_pos (by exact_mod_cast q.den_pos : (0 : ℚ) < q.den)] + norm_cast + +@[simp] theorem machineOptimizerFeasibilityDimensionBits_encode {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) (upper : RawRat) : + machineOptimizerFeasibilityDimensionBits + (optimizerFeasibilityCallCode A upper) = n.bits := by + simp [machineOptimizerFeasibilityDimensionBits] + +@[simp] theorem machineOptimizerFeasibilityReducedDimensionBits_encode + {n : ℕ} (A : Matrix (Fin n) (Fin n) ℚ) (upper : RawRat) : + machineOptimizerFeasibilityReducedDimensionBits + (optimizerFeasibilityCallCode A upper) = (n - 1).bits := by + rw [machineOptimizerFeasibilityReducedDimensionBits, + machineOptimizerFeasibilityDimensionBits_encode] + exact machineBinarySubBits_pair_natBits n 1 + +@[simp] theorem + machineOptimizerFeasibilityReducedDimensionSquareBits_encode + {n : ℕ} (A : Matrix (Fin n) (Fin n) ℚ) (upper : RawRat) : + machineOptimizerFeasibilityReducedDimensionSquareBits + (optimizerFeasibilityCallCode A upper) = ((n - 1) ^ 2).bits := by + rw [machineOptimizerFeasibilityReducedDimensionSquareBits, + machineOptimizerFeasibilityReducedDimensionBits_encode, + machineBinaryMulBits_pair_natBits] + congr 1 + ring + +@[simp] theorem machineOptimizerFeasibilityEllipsoidDimensionBits_encode + {n : ℕ} (A : Matrix (Fin n) (Fin n) ℚ) (upper : RawRat) : + machineOptimizerFeasibilityEllipsoidDimensionBits + (optimizerFeasibilityCallCode A upper) = + ((n - 1) ^ 2 + 1).bits := by + have hone : ([true] : List Bool) = (1 : ℕ).bits := rfl + rw [machineOptimizerFeasibilityEllipsoidDimensionBits, + machineOptimizerFeasibilityReducedDimensionSquareBits_encode, + hone, + machineBinaryAddBits_pair_natBits] + +theorem optimizerEllipsoidDimension_le_sourceLength {n : ℕ} + (hn : 2 ≤ n) (A : Matrix (Fin n) (Fin n) ℚ) : + (n - 1) ^ 2 + 1 ≤ + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩).length := by + have hsq : n ^ 2 ≤ + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩).length := by + let rows := rationalMatrixRows A + let rowsCode := binaryListCode + (binaryListCode rationalEntryBinaryCode) rows + let word := rationalMatrixBinaryEncoding.encode ⟨n, A⟩ + have hrowsCode : + (binaryListCode (binaryListCode rationalEntryBinaryCode) rows).length ≤ + word.length := by + change rowsCode.length ≤ (pair n.bits rowsCode).length + simpa using machinePairSecond_length_le (pair n.bits rowsCode) + have hcount : n ^ 2 = (rows.map List.length).sum := by + simp only [rows, rationalMatrixRows, List.map_ofFn, List.sum_ofFn, + Function.comp_apply, List.length_ofFn] + simp + ring + rw [hcount] + exact (rationalRowsEntryCount_le_codeLength rows).trans hrowsCode + have hsmall : (n - 1) ^ 2 + 1 ≤ n ^ 2 := by + have hnform : n - 1 + 1 = n := Nat.sub_add_cancel (by omega) + calc + (n - 1) ^ 2 + 1 ≤ (n - 1 + 1) ^ 2 := by nlinarith + _ = n ^ 2 := by rw [hnform] + exact hsmall.trans hsq + +@[simp] theorem machineOptimizerFeasibilityEllipsoidDimensionUnary_encode + {n : ℕ} (hn : 2 ≤ n) (A : Matrix (Fin n) (Fin n) ℚ) + (upper : RawRat) : + machineOptimizerFeasibilityEllipsoidDimensionUnary + (optimizerFeasibilityCallCode A upper) = + List.replicate ((n - 1) ^ 2 + 1) true := by + rw [machineOptimizerFeasibilityEllipsoidDimensionUnary, + machineOptimizerFeasibilitySource_encode, + machineOptimizerFeasibilityEllipsoidDimensionBits_encode] + exact machineBoundedUnary_encode_of_le _ _ + (optimizerEllipsoidDimension_le_sourceLength hn A) + +@[simp] theorem + machineOptimizerFeasibilityEllipsoidDimensionRawCode_encode + {n : ℕ} (A : Matrix (Fin n) (Fin n) ℚ) (upper : RawRat) : + machineOptimizerFeasibilityEllipsoidDimensionRawCode + (optimizerFeasibilityCallCode A upper) = + rawRatBinaryCode (RawRat.ofNat ((n - 1) ^ 2 + 1)) := by + rw [machineOptimizerFeasibilityEllipsoidDimensionRawCode, + machineOptimizerFeasibilityEllipsoidDimensionBits_encode, + machineNaturalIntegerCode_natBits] + simp [RawRat.ofNat, rawRatBinaryCode] + +@[simp] theorem machineOptimizerFeasibilityInnerRadiusRawCode_encode + {n : ℕ} (hn : 1 ≤ n) (A : Matrix (Fin n) (Fin n) ℚ) + (upper : RawRat) : + machineOptimizerFeasibilityInnerRadiusRawCode + (optimizerFeasibilityCallCode A upper) = + rawRatBinaryCode + (rawExplicitOptimizerInnerRadius n + (rationalMatrixEntryBitBound A)) := by + simp [machineOptimizerFeasibilityInnerRadiusRawCode, + machineExplicitOptimizerInnerRadiusRawCode_encode hn] + +@[simp] theorem machineOptimizerFeasibilityOuterRadiusRawCode_encode + {n : ℕ} (hn : 1 ≤ n) (A : Matrix (Fin n) (Fin n) ℚ) + (upper : RawRat) : + machineOptimizerFeasibilityOuterRadiusRawCode + (optimizerFeasibilityCallCode A upper) = + rawRatBinaryCode + ((RawRat.ofNat ((n - 1) ^ 2 + 1)).mul + ((rawOptimizerOne.add (rawRatAbs upper)).add + (rawOptimizerTwo.mul + (rawExplicitOptimizerInnerRadius n + (rationalMatrixEntryBitBound A))))) := by + rw [machineOptimizerFeasibilityOuterRadiusRawCode, + machineOptimizerFeasibilityEllipsoidDimensionRawCode_encode, + machineOptimizerFeasibilityRadiusFactorRawCode, + machineOptimizerFeasibilityOnePlusAbsUpperRawCode, + machineOptimizerFeasibilityUpperRawCode_encode, + machineRawRatAbsCode_encode, machineRawRatAddCode_encode, + machineOptimizerFeasibilityTwiceInnerRadiusRawCode, + machineOptimizerFeasibilityInnerRadiusRawCode_encode hn, + machineRawRatMulCode_encode, machineRawRatAddCode_encode, + machineRawRatMulCode_encode] + +def rawOptimizerFeasibilityOuterRadius + (n B : ℕ) (upper : RawRat) : RawRat := + (RawRat.ofNat ((n - 1) ^ 2 + 1)).mul + ((rawOptimizerOne.add (rawRatAbs upper)).add + (rawOptimizerTwo.mul (rawExplicitOptimizerInnerRadius n B))) + +@[simp] theorem rawOptimizerFeasibilityOuterRadius_value + (n B : ℕ) (upper : RawRat) : + (rawOptimizerFeasibilityOuterRadius n B upper).value = + (((n - 1) ^ 2 + 1 : ℕ) : ℚ) * + (1 + abs upper.value + + 2 * (rawExplicitOptimizerInnerRadius n B).value) := by + simp only [rawOptimizerFeasibilityOuterRadius, RawRat.value_mul, + RawRat.value_add, RawRat.value_ofNat, rawRatAbs_value] + norm_num [rawOptimizerOne, rawOptimizerTwo] + +theorem rawOptimizerFeasibilityOuterRadius_eq {m : ℕ} + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (upper : RawRat) : + (rawOptimizerFeasibilityOuterRadius (m + 1) + (rationalMatrixEntryBitBound A) upper).value = + betheEpigraphOuterRadius m upper.value + (explicitOptimizerInnerRadius A) := by + rw [rawOptimizerFeasibilityOuterRadius_value] + have hradius := (rawExplicitOptimizerScales_value A).2.2.2.2 + rw [hradius] + have hm : (m + 1 - 1) ^ 2 + 1 = m * m + 1 := by + have : m + 1 - 1 = m := by omega + rw [this, pow_two] + rw [hm] + simp only [betheEpigraphOuterRadius] + push_cast + rfl + +/-! ## Exact encoded lengths and guarded budget -/ + +def machineOptimizerFeasibilityOuterRadiusEntryCode + (word : List Bool) : List Bool := + machineNormalizeRawRatEntryCode + (machineOptimizerFeasibilityOuterRadiusRawCode word) + +def machineOptimizerFeasibilityOuterRadiusLengthRuler + (word : List Bool) : List Bool := + machineOptimizerEntryLengthRuler + (machineOptimizerFeasibilityOuterRadiusEntryCode word) + +def machineOptimizerFeasibilityInnerRadiusEntryCode + (word : List Bool) : List Bool := + machineNormalizeRawRatEntryCode + (machineOptimizerFeasibilityInnerRadiusRawCode word) + +def machineOptimizerFeasibilityInnerRadiusLengthRuler + (word : List Bool) : List Bool := + machineOptimizerEntryLengthRuler + (machineOptimizerFeasibilityInnerRadiusEntryCode word) + +def machineOptimizerFeasibilityBudgetGuardSource + (word : List Bool) : List Bool := + machineOptimizerFeasibilityEllipsoidDimensionUnary word ++ + (machineOptimizerFeasibilityOuterRadiusLengthRuler word ++ + machineOptimizerFeasibilityInnerRadiusLengthRuler word) + +def machineOptimizerFeasibilityDBits (word : List Bool) : List Bool := + machineOptimizerFeasibilityEllipsoidDimensionBits word + +def machineOptimizerFeasibilityDSquareBits + (word : List Bool) : List Bool := + machineBinaryMulBits + (pair (machineOptimizerFeasibilityDBits word) + (machineOptimizerFeasibilityDBits word)) + +def machineOptimizerFeasibilityDCubeBits + (word : List Bool) : List Bool := + machineBinaryMulBits + (pair (machineOptimizerFeasibilityDSquareBits word) + (machineOptimizerFeasibilityDBits word)) + +def machineOptimizerFeasibilityOuterLengthBits + (word : List Bool) : List Bool := + machineLengthBits + (machineOptimizerFeasibilityOuterRadiusLengthRuler word) + +def machineOptimizerFeasibilityInnerLengthBits + (word : List Bool) : List Bool := + machineLengthBits + (machineOptimizerFeasibilityInnerRadiusLengthRuler word) + +def machineOptimizerFeasibilityOuterLengthTimesDBits + (word : List Bool) : List Bool := + machineBinaryMulBits + (pair (machineOptimizerFeasibilityOuterLengthBits word) + (machineOptimizerFeasibilityDBits word)) + +def machineOptimizerFeasibilityInnerLengthTimesDBits + (word : List Bool) : List Bool := + machineBinaryMulBits + (pair (machineOptimizerFeasibilityInnerLengthBits word) + (machineOptimizerFeasibilityDBits word)) + +def machineOptimizerFeasibilityMFirstBits (word : List Bool) : List Bool := + machineBinaryAddBits + (pair (machineOptimizerFeasibilityDSquareBits word) + (machineOptimizerFeasibilityOuterLengthTimesDBits word)) + +def machineOptimizerFeasibilityMSecondBits (word : List Bool) : List Bool := + machineBinaryAddBits + (pair (machineOptimizerFeasibilityMFirstBits word) + (machineOptimizerFeasibilityInnerLengthTimesDBits word)) + +def machineOptimizerFeasibilityMBits (word : List Bool) : List Bool := + machineBinaryAddBits + (pair (machineOptimizerFeasibilityMSecondBits word) [true]) + +def machineOptimizerFeasibilityThirtyTwoDCubeBits + (word : List Bool) : List Bool := + machineBinaryMulBits + (pair (32 : ℕ).bits (machineOptimizerFeasibilityDCubeBits word)) + +def machineOptimizerFeasibilityBudgetBits + (word : List Bool) : List Bool := + machineBinaryMulBits + (pair (machineOptimizerFeasibilityThirtyTwoDCubeBits word) + (machineOptimizerFeasibilityMBits word)) + +def machineOptimizerFeasibilityBudgetGuard + (word : List Bool) : List Bool := + machineIteratedBinaryWidth 3 + (machineOptimizerFeasibilityBudgetGuardSource word) + +def machineOptimizerFeasibilityBudgetUnary + (word : List Bool) : List Bool := + machineBoundedUnary + (pair (machineOptimizerFeasibilityBudgetGuard word) + (machineOptimizerFeasibilityBudgetBits word)) + +/-! All components above are fixed compositions of verified `FP` machines. -/ + +theorem machineOptimizerFeasibilityOuterRadiusEntryCode_mem_FP : + machineOptimizerFeasibilityOuterRadiusEntryCode ∈ FP := by + simpa only [machineOptimizerFeasibilityOuterRadiusEntryCode] using + machineCompose_mem_FP machineOptimizerFeasibilityOuterRadiusRawCode_mem_FP + machineNormalizeRawRatEntryCode_mem_FP + +theorem machineOptimizerFeasibilityOuterRadiusLengthRuler_mem_FP : + machineOptimizerFeasibilityOuterRadiusLengthRuler ∈ FP := by + simpa only [machineOptimizerFeasibilityOuterRadiusLengthRuler] using + machineCompose_mem_FP + machineOptimizerFeasibilityOuterRadiusEntryCode_mem_FP + machineOptimizerEntryLengthRuler_mem_FP + +theorem machineOptimizerFeasibilityInnerRadiusEntryCode_mem_FP : + machineOptimizerFeasibilityInnerRadiusEntryCode ∈ FP := by + simpa only [machineOptimizerFeasibilityInnerRadiusEntryCode] using + machineCompose_mem_FP machineOptimizerFeasibilityInnerRadiusRawCode_mem_FP + machineNormalizeRawRatEntryCode_mem_FP + +theorem machineOptimizerFeasibilityInnerRadiusLengthRuler_mem_FP : + machineOptimizerFeasibilityInnerRadiusLengthRuler ∈ FP := by + simpa only [machineOptimizerFeasibilityInnerRadiusLengthRuler] using + machineCompose_mem_FP + machineOptimizerFeasibilityInnerRadiusEntryCode_mem_FP + machineOptimizerEntryLengthRuler_mem_FP + +theorem machineOptimizerFeasibilityBudgetGuardSource_mem_FP : + machineOptimizerFeasibilityBudgetGuardSource ∈ FP := by + simpa only [machineOptimizerFeasibilityBudgetGuardSource] using + machineAppend_mem_FP + machineOptimizerFeasibilityEllipsoidDimensionUnary_mem_FP + (machineAppend_mem_FP + machineOptimizerFeasibilityOuterRadiusLengthRuler_mem_FP + machineOptimizerFeasibilityInnerRadiusLengthRuler_mem_FP) + +theorem machineOptimizerFeasibilityDBits_mem_FP : + machineOptimizerFeasibilityDBits ∈ FP := + machineOptimizerFeasibilityEllipsoidDimensionBits_mem_FP + +theorem machineOptimizerFeasibilityDSquareBits_mem_FP : + machineOptimizerFeasibilityDSquareBits ∈ FP := by + simpa only [machineOptimizerFeasibilityDSquareBits] using + machineCompose_mem_FP + (machinePair_mem_FP machineOptimizerFeasibilityDBits_mem_FP + machineOptimizerFeasibilityDBits_mem_FP) + machineBinaryMulBits_mem_FP + +theorem machineOptimizerFeasibilityDCubeBits_mem_FP : + machineOptimizerFeasibilityDCubeBits ∈ FP := by + simpa only [machineOptimizerFeasibilityDCubeBits] using + machineCompose_mem_FP + (machinePair_mem_FP machineOptimizerFeasibilityDSquareBits_mem_FP + machineOptimizerFeasibilityDBits_mem_FP) + machineBinaryMulBits_mem_FP + +theorem machineOptimizerFeasibilityOuterLengthBits_mem_FP : + machineOptimizerFeasibilityOuterLengthBits ∈ FP := by + simpa only [machineOptimizerFeasibilityOuterLengthBits] using + machineCompose_mem_FP + machineOptimizerFeasibilityOuterRadiusLengthRuler_mem_FP + machineLengthBits_mem_FP + +theorem machineOptimizerFeasibilityInnerLengthBits_mem_FP : + machineOptimizerFeasibilityInnerLengthBits ∈ FP := by + simpa only [machineOptimizerFeasibilityInnerLengthBits] using + machineCompose_mem_FP + machineOptimizerFeasibilityInnerRadiusLengthRuler_mem_FP + machineLengthBits_mem_FP + +theorem machineOptimizerFeasibilityOuterLengthTimesDBits_mem_FP : + machineOptimizerFeasibilityOuterLengthTimesDBits ∈ FP := by + simpa only [machineOptimizerFeasibilityOuterLengthTimesDBits] using + machineCompose_mem_FP + (machinePair_mem_FP machineOptimizerFeasibilityOuterLengthBits_mem_FP + machineOptimizerFeasibilityDBits_mem_FP) + machineBinaryMulBits_mem_FP + +theorem machineOptimizerFeasibilityInnerLengthTimesDBits_mem_FP : + machineOptimizerFeasibilityInnerLengthTimesDBits ∈ FP := by + simpa only [machineOptimizerFeasibilityInnerLengthTimesDBits] using + machineCompose_mem_FP + (machinePair_mem_FP machineOptimizerFeasibilityInnerLengthBits_mem_FP + machineOptimizerFeasibilityDBits_mem_FP) + machineBinaryMulBits_mem_FP + +theorem machineOptimizerFeasibilityMFirstBits_mem_FP : + machineOptimizerFeasibilityMFirstBits ∈ FP := by + simpa only [machineOptimizerFeasibilityMFirstBits] using + machineCompose_mem_FP + (machinePair_mem_FP machineOptimizerFeasibilityDSquareBits_mem_FP + machineOptimizerFeasibilityOuterLengthTimesDBits_mem_FP) + machineBinaryAddBits_mem_FP + +theorem machineOptimizerFeasibilityMSecondBits_mem_FP : + machineOptimizerFeasibilityMSecondBits ∈ FP := by + simpa only [machineOptimizerFeasibilityMSecondBits] using + machineCompose_mem_FP + (machinePair_mem_FP machineOptimizerFeasibilityMFirstBits_mem_FP + machineOptimizerFeasibilityInnerLengthTimesDBits_mem_FP) + machineBinaryAddBits_mem_FP + +theorem machineOptimizerFeasibilityMBits_mem_FP : + machineOptimizerFeasibilityMBits ∈ FP := by + simpa only [machineOptimizerFeasibilityMBits] using machineCompose_mem_FP + (machinePair_mem_FP machineOptimizerFeasibilityMSecondBits_mem_FP + (machineConst_mem_FP [true])) + machineBinaryAddBits_mem_FP + +theorem machineOptimizerFeasibilityThirtyTwoDCubeBits_mem_FP : + machineOptimizerFeasibilityThirtyTwoDCubeBits ∈ FP := by + simpa only [machineOptimizerFeasibilityThirtyTwoDCubeBits] using + machineCompose_mem_FP + (machinePair_mem_FP (machineConst_mem_FP (32 : ℕ).bits) + machineOptimizerFeasibilityDCubeBits_mem_FP) + machineBinaryMulBits_mem_FP + +theorem machineOptimizerFeasibilityBudgetBits_mem_FP : + machineOptimizerFeasibilityBudgetBits ∈ FP := by + simpa only [machineOptimizerFeasibilityBudgetBits] using + machineCompose_mem_FP + (machinePair_mem_FP + machineOptimizerFeasibilityThirtyTwoDCubeBits_mem_FP + machineOptimizerFeasibilityMBits_mem_FP) + machineBinaryMulBits_mem_FP + +theorem machineOptimizerFeasibilityBudgetGuard_mem_FP : + machineOptimizerFeasibilityBudgetGuard ∈ FP := by + simpa only [machineOptimizerFeasibilityBudgetGuard] using + machineCompose_mem_FP machineOptimizerFeasibilityBudgetGuardSource_mem_FP + (machineIteratedBinaryWidth_mem_FP 3) + +theorem machineOptimizerFeasibilityBudgetUnary_mem_FP : + machineOptimizerFeasibilityBudgetUnary ∈ FP := by + simpa only [machineOptimizerFeasibilityBudgetUnary] using + machineCompose_mem_FP + (machinePair_mem_FP machineOptimizerFeasibilityBudgetGuard_mem_FP + machineOptimizerFeasibilityBudgetBits_mem_FP) + machineBoundedUnary_mem_FP + +/-! ## Exact budget semantics and proof that the guard is inactive -/ + +@[simp] theorem machineOptimizerFeasibilityOuterRadiusEntryCode_encode + {n : ℕ} (hn : 1 ≤ n) (A : Matrix (Fin n) (Fin n) ℚ) + (upper : RawRat) : + machineOptimizerFeasibilityOuterRadiusEntryCode + (optimizerFeasibilityCallCode A upper) = + rationalEntryBinaryCode + ((rawOptimizerFeasibilityOuterRadius n + (rationalMatrixEntryBitBound A) upper).value) := by + rw [machineOptimizerFeasibilityOuterRadiusEntryCode, + machineOptimizerFeasibilityOuterRadiusRawCode_encode hn, + machineNormalizeRawRatEntryCode_encode, + binaryNormalizeRawRat_eq_value] + rfl + +@[simp] theorem machineOptimizerFeasibilityOuterRadiusLengthRuler_encode + {n : ℕ} (hn : 1 ≤ n) (A : Matrix (Fin n) (Fin n) ℚ) + (upper : RawRat) : + machineOptimizerFeasibilityOuterRadiusLengthRuler + (optimizerFeasibilityCallCode A upper) = + List.replicate + (encodedBitLength ℚ + ((rawOptimizerFeasibilityOuterRadius n + (rationalMatrixEntryBitBound A) upper).value)) true := by + rw [machineOptimizerFeasibilityOuterRadiusLengthRuler, + machineOptimizerFeasibilityOuterRadiusEntryCode_encode hn, + machineOptimizerEntryLengthRuler_encode] + +@[simp] theorem machineOptimizerFeasibilityInnerRadiusEntryCode_encode + {n : ℕ} (hn : 1 ≤ n) (A : Matrix (Fin n) (Fin n) ℚ) + (upper : RawRat) : + machineOptimizerFeasibilityInnerRadiusEntryCode + (optimizerFeasibilityCallCode A upper) = + rationalEntryBinaryCode + ((rawExplicitOptimizerInnerRadius n + (rationalMatrixEntryBitBound A)).value) := by + rw [machineOptimizerFeasibilityInnerRadiusEntryCode, + machineOptimizerFeasibilityInnerRadiusRawCode_encode hn, + machineNormalizeRawRatEntryCode_encode, + binaryNormalizeRawRat_eq_value] + +@[simp] theorem machineOptimizerFeasibilityInnerRadiusLengthRuler_encode + {n : ℕ} (hn : 1 ≤ n) (A : Matrix (Fin n) (Fin n) ℚ) + (upper : RawRat) : + machineOptimizerFeasibilityInnerRadiusLengthRuler + (optimizerFeasibilityCallCode A upper) = + List.replicate + (encodedBitLength ℚ + ((rawExplicitOptimizerInnerRadius n + (rationalMatrixEntryBitBound A)).value)) true := by + rw [machineOptimizerFeasibilityInnerRadiusLengthRuler, + machineOptimizerFeasibilityInnerRadiusEntryCode_encode hn, + machineOptimizerEntryLengthRuler_encode] + +@[simp] theorem machineOptimizerFeasibilityBudgetGuardSource_length_encode + {n : ℕ} (hn : 2 ≤ n) (A : Matrix (Fin n) (Fin n) ℚ) + (upper : RawRat) : + (machineOptimizerFeasibilityBudgetGuardSource + (optimizerFeasibilityCallCode A upper)).length = + ((n - 1) ^ 2 + 1) + + encodedBitLength ℚ + ((rawOptimizerFeasibilityOuterRadius n + (rationalMatrixEntryBitBound A) upper).value) + + encodedBitLength ℚ + ((rawExplicitOptimizerInnerRadius n + (rationalMatrixEntryBitBound A)).value) := by + have hn1 : 1 ≤ n := by omega + rw [machineOptimizerFeasibilityBudgetGuardSource, + machineOptimizerFeasibilityEllipsoidDimensionUnary_encode hn, + machineOptimizerFeasibilityOuterRadiusLengthRuler_encode hn1, + machineOptimizerFeasibilityInnerRadiusLengthRuler_encode hn1] + simp only [List.length_append, List.length_replicate] + omega + +@[simp] theorem machineOptimizerFeasibilityBudgetBits_encode + {n : ℕ} (hn : 1 ≤ n) (A : Matrix (Fin n) (Fin n) ℚ) + (upper : RawRat) : + machineOptimizerFeasibilityBudgetBits + (optimizerFeasibilityCallCode A upper) = + (32 * (((n - 1) ^ 2 + 1) ^ 3) * + rationalBallDyadicExponent ((n - 1) ^ 2 + 1) + ((rawOptimizerFeasibilityOuterRadius n + (rationalMatrixEntryBitBound A) upper).value) + ((rawExplicitOptimizerInnerRadius n + (rationalMatrixEntryBitBound A)).value)).bits := by + let word := optimizerFeasibilityCallCode A upper + let d := (n - 1) ^ 2 + 1 + let LR := encodedBitLength ℚ + ((rawOptimizerFeasibilityOuterRadius n + (rationalMatrixEntryBitBound A) upper).value) + let Lr := encodedBitLength ℚ + ((rawExplicitOptimizerInnerRadius n + (rationalMatrixEntryBitBound A)).value) + have hd : machineOptimizerFeasibilityDBits word = d.bits := by + simpa only [machineOptimizerFeasibilityDBits, word, d] using + machineOptimizerFeasibilityEllipsoidDimensionBits_encode A upper + have hd2 : machineOptimizerFeasibilityDSquareBits word = (d ^ 2).bits := by + rw [machineOptimizerFeasibilityDSquareBits, hd, + machineBinaryMulBits_pair_natBits] + simp only [pow_two] + have hd3 : machineOptimizerFeasibilityDCubeBits word = (d ^ 3).bits := by + rw [machineOptimizerFeasibilityDCubeBits, hd2, hd, + machineBinaryMulBits_pair_natBits] + simp only [pow_succ] + have hLR : machineOptimizerFeasibilityOuterLengthBits word = LR.bits := by + have hRuler : machineOptimizerFeasibilityOuterRadiusLengthRuler word = + List.replicate LR true := by + simpa only [word, LR] using + machineOptimizerFeasibilityOuterRadiusLengthRuler_encode hn A upper + rw [machineOptimizerFeasibilityOuterLengthBits, hRuler, + machineLengthBits_encode, List.length_replicate] + have hLr : machineOptimizerFeasibilityInnerLengthBits word = Lr.bits := by + have hRuler : machineOptimizerFeasibilityInnerRadiusLengthRuler word = + List.replicate Lr true := by + simpa only [word, Lr] using + machineOptimizerFeasibilityInnerRadiusLengthRuler_encode hn A upper + rw [machineOptimizerFeasibilityInnerLengthBits, hRuler, + machineLengthBits_encode, List.length_replicate] + have hLRd : machineOptimizerFeasibilityOuterLengthTimesDBits word = + (LR * d).bits := by + rw [machineOptimizerFeasibilityOuterLengthTimesDBits, hLR, hd, + machineBinaryMulBits_pair_natBits] + have hLrd : machineOptimizerFeasibilityInnerLengthTimesDBits word = + (Lr * d).bits := by + rw [machineOptimizerFeasibilityInnerLengthTimesDBits, hLr, hd, + machineBinaryMulBits_pair_natBits] + have hM1 : machineOptimizerFeasibilityMFirstBits word = + (d ^ 2 + LR * d).bits := by + rw [machineOptimizerFeasibilityMFirstBits, hd2, hLRd, + machineBinaryAddBits_pair_natBits] + have hM2 : machineOptimizerFeasibilityMSecondBits word = + (d ^ 2 + LR * d + Lr * d).bits := by + rw [machineOptimizerFeasibilityMSecondBits, hM1, hLrd, + machineBinaryAddBits_pair_natBits] + have hone : ([true] : List Bool) = (1 : ℕ).bits := rfl + have hM : machineOptimizerFeasibilityMBits word = + (d ^ 2 + LR * d + Lr * d + 1).bits := by + rw [machineOptimizerFeasibilityMBits, hM2, hone, + machineBinaryAddBits_pair_natBits] + have h32d3 : machineOptimizerFeasibilityThirtyTwoDCubeBits word = + (32 * d ^ 3).bits := by + rw [machineOptimizerFeasibilityThirtyTwoDCubeBits, hd3, + machineBinaryMulBits_pair_natBits] + rw [machineOptimizerFeasibilityBudgetBits, h32d3, hM, + machineBinaryMulBits_pair_natBits] + rfl + +theorem optimizerFeasibilityBudget_le_guardPolynomial + (d LR Lr : ℕ) : + 32 * d ^ 3 * (d ^ 2 + LR * d + Lr * d + 1) ≤ + certificateExpGuardWidth 3 (d + LR + Lr) := by + let Q := d + LR + Lr + have hd : d ≤ Q := by omega + have hLR : LR ≤ Q := by omega + have hLr : Lr ≤ Q := by omega + have hM : d ^ 2 + LR * d + Lr * d + 1 ≤ 3 * Q ^ 2 + 1 := by + nlinarith [Nat.mul_le_mul hd hd, Nat.mul_le_mul hLR hd, + Nat.mul_le_mul hLr hd] + have hbudget : + 32 * d ^ 3 * (d ^ 2 + LR * d + Lr * d + 1) ≤ + 128 * (Q + 1) ^ 5 := by + have hd3 : d ^ 3 ≤ (Q + 1) ^ 3 := + Nat.pow_le_pow_left (by omega) 3 + have hM' : 3 * Q ^ 2 + 1 ≤ 4 * (Q + 1) ^ 2 := by nlinarith + nlinarith [Nat.mul_le_mul hd3 (hM.trans hM')] + have hconst : 128 ≤ (Q + 16) ^ 3 := by + have : 8 ≤ Q + 16 := by omega + nlinarith [Nat.pow_le_pow_left this 3] + have hq5 : (Q + 1) ^ 5 ≤ (Q + 16) ^ 5 := + Nat.pow_le_pow_left (by omega) 5 + have hpow : 128 * (Q + 1) ^ 5 ≤ (Q + 16) ^ 8 := by + calc + 128 * (Q + 1) ^ 5 ≤ (Q + 16) ^ 3 * (Q + 16) ^ 5 := + Nat.mul_le_mul hconst hq5 + _ = (Q + 16) ^ 8 := by rw [← pow_add] + exact hbudget.trans <| hpow.trans <| by + simpa only [Q] using certificateExpGuardWidth_pow_lower 2 Q + +@[simp] theorem machineOptimizerFeasibilityBudgetUnary_encode + {n : ℕ} (hn : 2 ≤ n) (A : Matrix (Fin n) (Fin n) ℚ) + (upper : RawRat) : + machineOptimizerFeasibilityBudgetUnary + (optimizerFeasibilityCallCode A upper) = + List.replicate + (32 * (((n - 1) ^ 2 + 1) ^ 3) * + rationalBallDyadicExponent ((n - 1) ^ 2 + 1) + ((rawOptimizerFeasibilityOuterRadius n + (rationalMatrixEntryBitBound A) upper).value) + ((rawExplicitOptimizerInnerRadius n + (rationalMatrixEntryBitBound A)).value)) true := by + let d := (n - 1) ^ 2 + 1 + let LR := encodedBitLength ℚ + ((rawOptimizerFeasibilityOuterRadius n + (rationalMatrixEntryBitBound A) upper).value) + let Lr := encodedBitLength ℚ + ((rawExplicitOptimizerInnerRadius n + (rationalMatrixEntryBitBound A)).value) + rw [machineOptimizerFeasibilityBudgetUnary, + machineOptimizerFeasibilityBudgetBits_encode (by omega)] + apply machineBoundedUnary_encode_of_le + rw [machineOptimizerFeasibilityBudgetGuard, + machineIteratedBinaryWidth_length, + machineOptimizerFeasibilityBudgetGuardSource_length_encode hn] + simpa only [d, LR, Lr, rationalBallDyadicExponent] using + optimizerFeasibilityBudget_le_guardPolynomial d LR Lr + +theorem machineOptimizerFeasibilityBudgetUnary_eq_thresholdBudget + {m : ℕ} (hm : 0 < m) + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (upper : RawRat) : + machineOptimizerFeasibilityBudgetUnary + (optimizerFeasibilityCallCode A upper) = + List.replicate + (betheThresholdFeasibilityBudget m upper.value + (explicitOptimizerInnerRadius A)) true := by + rw [machineOptimizerFeasibilityBudgetUnary_encode (by omega)] + have hR := rawOptimizerFeasibilityOuterRadius_eq A upper + have hr := (rawExplicitOptimizerScales_value A).2.2.2.2 + have hd : (m + 1 - 1) ^ 2 + 1 = m * m + 1 := by + have : m + 1 - 1 = m := by omega + rw [this, pow_two] + simp only [betheThresholdFeasibilityBudget] + rw [hd, hR, hr] + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerInteriorScale.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerInteriorScale.lean new file mode 100644 index 0000000000..96ea17cf8d --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerInteriorScale.lean @@ -0,0 +1,639 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerMatrixBitBound +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalPower +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalFloor +import LeanPool.BeyondBethe.BeyondBethe.MachineCertificateExpGuard +import LeanPool.BeyondBethe.BeyondBethe.ExplicitOptimizerScales + +/-! +# Finite-word interior scale for the Bethe optimizer + +The optimizer uses a dyadic lower bound on every matrix coordinate. Its +exponent is computed in binary and expanded to unary only behind an explicit +degree-64 guard in the source matrix length. Thus this file does not hide an +unrestricted binary-to-unary conversion. +-/ + +namespace BeyondBethe + +open Complexity + +/-! ## Raw rational expression computed by the machine -/ + +def rawOptimizerTwo : RawRat := RawRat.ofNat 2 + +def rawOptimizerFour : RawRat := RawRat.ofNat 4 + +def rawOptimizerHalf : RawRat := + (RawRat.ofNat 1).div rawOptimizerTwo + +def rawOptimizerXi : RawRat := rawRatOfRat explicitXi + +def rawOptimizerDimension (n : ℕ) : RawRat := RawRat.ofNat n + +def rawOptimizerBitBound (B : ℕ) : RawRat := RawRat.ofNat B + +def rawOptimizerTau (n : ℕ) : RawRat := + rawOptimizerXi.div (rawOptimizerFour.mul (rawOptimizerDimension n)) + +def rawOptimizerNSquare (n : ℕ) : RawRat := + (rawOptimizerDimension n).mul (rawOptimizerDimension n) + +def rawOptimizerNCube (n : ℕ) : RawRat := + (rawOptimizerNSquare n).mul (rawOptimizerDimension n) + +def rawOptimizerInteriorSum (n B : ℕ) : RawRat := + ((rawOptimizerDimension n).mul (rawOptimizerBitBound B)).add + (rawOptimizerTwo.mul (rawOptimizerNSquare n)) + +def rawOptimizerInteriorK0 (n B : ℕ) : RawRat := + ((rawOptimizerDimension n).mul (rawOptimizerInteriorSum n B)).div + (rawOptimizerTau n) |>.add (rawOptimizerNCube n) + +def rawOptimizerTwiceInteriorK0 (n B : ℕ) : RawRat := + rawOptimizerTwo.mul (rawOptimizerInteriorK0 n B) + +/-! ## Binary machines for the expression -/ + +def machineOptimizerDimensionBits (word : List Bool) : List Bool := + machineMatrixDimensionWord word + +def machineOptimizerDimensionUnary (word : List Bool) : List Bool := + machineMatrixDimensionUnary word + +def machineOptimizerDimensionRawCode (word : List Bool) : List Bool := + pair (machineNaturalIntegerCode (machineOptimizerDimensionBits word)) [true] + +def machineOptimizerBitBoundBits (word : List Bool) : List Bool := + machineLengthBits (machineMatrixEntryBitBoundRuler word) + +def machineOptimizerBitBoundRawCode (word : List Bool) : List Bool := + pair (machineNaturalIntegerCode (machineOptimizerBitBoundBits word)) [true] + +def machineOptimizerFourDimensionRawCode (word : List Bool) : List Bool := + machineRawRatMulCode + (pair (rawRatBinaryCode rawOptimizerFour) + (machineOptimizerDimensionRawCode word)) + +def machineOptimizerTauRawCode (word : List Bool) : List Bool := + machineRawRatDivCode + (pair (rawRatBinaryCode rawOptimizerXi) + (machineOptimizerFourDimensionRawCode word)) + +def machineOptimizerNSquareRawCode (word : List Bool) : List Bool := + machineRawRatMulCode + (pair (machineOptimizerDimensionRawCode word) + (machineOptimizerDimensionRawCode word)) + +def machineOptimizerNCubeRawCode (word : List Bool) : List Bool := + machineRawRatMulCode + (pair (machineOptimizerNSquareRawCode word) + (machineOptimizerDimensionRawCode word)) + +def machineOptimizerNBProductRawCode (word : List Bool) : List Bool := + machineRawRatMulCode + (pair (machineOptimizerDimensionRawCode word) + (machineOptimizerBitBoundRawCode word)) + +def machineOptimizerTwiceNSquareRawCode (word : List Bool) : List Bool := + machineRawRatMulCode + (pair (rawRatBinaryCode rawOptimizerTwo) + (machineOptimizerNSquareRawCode word)) + +def machineOptimizerInteriorSumRawCode (word : List Bool) : List Bool := + machineRawRatAddCode + (pair (machineOptimizerNBProductRawCode word) + (machineOptimizerTwiceNSquareRawCode word)) + +def machineOptimizerNTimesInteriorSumRawCode + (word : List Bool) : List Bool := + machineRawRatMulCode + (pair (machineOptimizerDimensionRawCode word) + (machineOptimizerInteriorSumRawCode word)) + +def machineOptimizerInteriorQuotientRawCode + (word : List Bool) : List Bool := + machineRawRatDivCode + (pair (machineOptimizerNTimesInteriorSumRawCode word) + (machineOptimizerTauRawCode word)) + +def machineOptimizerInteriorK0RawCode (word : List Bool) : List Bool := + machineRawRatAddCode + (pair (machineOptimizerInteriorQuotientRawCode word) + (machineOptimizerNCubeRawCode word)) + +def machineOptimizerTwiceInteriorK0RawCode + (word : List Bool) : List Bool := + machineRawRatMulCode + (pair (rawRatBinaryCode rawOptimizerTwo) + (machineOptimizerInteriorK0RawCode word)) + +def machineOptimizerInteriorExponentBits (word : List Bool) : List Bool := + machineRationalCeilNatBits + (machineOptimizerTwiceInteriorK0RawCode word) + +/-! ## Polynomial-time closure -/ + +theorem machineOptimizerDimensionBits_mem_FP : + machineOptimizerDimensionBits ∈ FP := + machineMatrixDimensionWord_mem_FP + +theorem machineOptimizerDimensionUnary_mem_FP : + machineOptimizerDimensionUnary ∈ FP := + machineMatrixDimensionUnary_mem_FP + +theorem machineOptimizerDimensionRawCode_mem_FP : + machineOptimizerDimensionRawCode ∈ FP := by + exact machinePair_mem_FP + (machineCompose_mem_FP machineOptimizerDimensionBits_mem_FP + machineNaturalIntegerCode_mem_FP) + (machineConst_mem_FP [true]) + +theorem machineOptimizerBitBoundBits_mem_FP : + machineOptimizerBitBoundBits ∈ FP := by + simpa only [machineOptimizerBitBoundBits] using + machineCompose_mem_FP machineMatrixEntryBitBoundRuler_mem_FP + machineLengthBits_mem_FP + +theorem machineOptimizerBitBoundRawCode_mem_FP : + machineOptimizerBitBoundRawCode ∈ FP := by + exact machinePair_mem_FP + (machineCompose_mem_FP machineOptimizerBitBoundBits_mem_FP + machineNaturalIntegerCode_mem_FP) + (machineConst_mem_FP [true]) + +theorem machineOptimizerFourDimensionRawCode_mem_FP : + machineOptimizerFourDimensionRawCode ∈ FP := by + simpa only [machineOptimizerFourDimensionRawCode] using machineCompose_mem_FP + (machinePair_mem_FP + (machineConst_mem_FP (rawRatBinaryCode rawOptimizerFour)) + machineOptimizerDimensionRawCode_mem_FP) + machineRawRatMulCode_mem_FP + +theorem machineOptimizerTauRawCode_mem_FP : + machineOptimizerTauRawCode ∈ FP := by + simpa only [machineOptimizerTauRawCode] using machineCompose_mem_FP + (machinePair_mem_FP + (machineConst_mem_FP (rawRatBinaryCode rawOptimizerXi)) + machineOptimizerFourDimensionRawCode_mem_FP) + machineRawRatDivCode_mem_FP + +theorem machineOptimizerNSquareRawCode_mem_FP : + machineOptimizerNSquareRawCode ∈ FP := by + simpa only [machineOptimizerNSquareRawCode] using machineCompose_mem_FP + (machinePair_mem_FP machineOptimizerDimensionRawCode_mem_FP + machineOptimizerDimensionRawCode_mem_FP) + machineRawRatMulCode_mem_FP + +theorem machineOptimizerNCubeRawCode_mem_FP : + machineOptimizerNCubeRawCode ∈ FP := by + simpa only [machineOptimizerNCubeRawCode] using machineCompose_mem_FP + (machinePair_mem_FP machineOptimizerNSquareRawCode_mem_FP + machineOptimizerDimensionRawCode_mem_FP) + machineRawRatMulCode_mem_FP + +theorem machineOptimizerNBProductRawCode_mem_FP : + machineOptimizerNBProductRawCode ∈ FP := by + simpa only [machineOptimizerNBProductRawCode] using machineCompose_mem_FP + (machinePair_mem_FP machineOptimizerDimensionRawCode_mem_FP + machineOptimizerBitBoundRawCode_mem_FP) + machineRawRatMulCode_mem_FP + +theorem machineOptimizerTwiceNSquareRawCode_mem_FP : + machineOptimizerTwiceNSquareRawCode ∈ FP := by + simpa only [machineOptimizerTwiceNSquareRawCode] using machineCompose_mem_FP + (machinePair_mem_FP + (machineConst_mem_FP (rawRatBinaryCode rawOptimizerTwo)) + machineOptimizerNSquareRawCode_mem_FP) + machineRawRatMulCode_mem_FP + +theorem machineOptimizerInteriorSumRawCode_mem_FP : + machineOptimizerInteriorSumRawCode ∈ FP := by + simpa only [machineOptimizerInteriorSumRawCode] using machineCompose_mem_FP + (machinePair_mem_FP machineOptimizerNBProductRawCode_mem_FP + machineOptimizerTwiceNSquareRawCode_mem_FP) + machineRawRatAddCode_mem_FP + +theorem machineOptimizerNTimesInteriorSumRawCode_mem_FP : + machineOptimizerNTimesInteriorSumRawCode ∈ FP := by + simpa only [machineOptimizerNTimesInteriorSumRawCode] using machineCompose_mem_FP + (machinePair_mem_FP machineOptimizerDimensionRawCode_mem_FP + machineOptimizerInteriorSumRawCode_mem_FP) + machineRawRatMulCode_mem_FP + +theorem machineOptimizerInteriorQuotientRawCode_mem_FP : + machineOptimizerInteriorQuotientRawCode ∈ FP := by + simpa only [machineOptimizerInteriorQuotientRawCode] using machineCompose_mem_FP + (machinePair_mem_FP machineOptimizerNTimesInteriorSumRawCode_mem_FP + machineOptimizerTauRawCode_mem_FP) + machineRawRatDivCode_mem_FP + +theorem machineOptimizerInteriorK0RawCode_mem_FP : + machineOptimizerInteriorK0RawCode ∈ FP := by + simpa only [machineOptimizerInteriorK0RawCode] using machineCompose_mem_FP + (machinePair_mem_FP machineOptimizerInteriorQuotientRawCode_mem_FP + machineOptimizerNCubeRawCode_mem_FP) + machineRawRatAddCode_mem_FP + +theorem machineOptimizerTwiceInteriorK0RawCode_mem_FP : + machineOptimizerTwiceInteriorK0RawCode ∈ FP := by + simpa only [machineOptimizerTwiceInteriorK0RawCode] using machineCompose_mem_FP + (machinePair_mem_FP + (machineConst_mem_FP (rawRatBinaryCode rawOptimizerTwo)) + machineOptimizerInteriorK0RawCode_mem_FP) + machineRawRatMulCode_mem_FP + +theorem machineOptimizerInteriorExponentBits_mem_FP : + machineOptimizerInteriorExponentBits ∈ FP := by + simpa only [machineOptimizerInteriorExponentBits] using + machineCompose_mem_FP machineOptimizerTwiceInteriorK0RawCode_mem_FP + machineRationalCeilNatBits_mem_FP + +/-! ## Exact semantics on canonical matrix words -/ + +@[simp] theorem machineOptimizerDimensionBits_encode {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) : + machineOptimizerDimensionBits + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩) = n.bits := by + simp [machineOptimizerDimensionBits] + +@[simp] theorem machineOptimizerDimensionUnary_encode {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) : + machineOptimizerDimensionUnary + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩) = + List.replicate n true := by + simp [machineOptimizerDimensionUnary] + +@[simp] theorem machineOptimizerDimensionRawCode_encode {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) : + machineOptimizerDimensionRawCode + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩) = + rawRatBinaryCode (rawOptimizerDimension n) := by + rw [machineOptimizerDimensionRawCode, + machineOptimizerDimensionBits_encode, + machineNaturalIntegerCode_natBits] + simp [rawOptimizerDimension, RawRat.ofNat, rawRatBinaryCode] + +@[simp] theorem machineOptimizerBitBoundBits_encode {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) : + machineOptimizerBitBoundBits + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩) = + (rationalMatrixEntryBitBound A).bits := by + simp [machineOptimizerBitBoundBits] + +@[simp] theorem machineOptimizerBitBoundRawCode_encode {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) : + machineOptimizerBitBoundRawCode + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩) = + rawRatBinaryCode (rawOptimizerBitBound + (rationalMatrixEntryBitBound A)) := by + rw [machineOptimizerBitBoundRawCode, + machineOptimizerBitBoundBits_encode, + machineNaturalIntegerCode_natBits] + simp [rawOptimizerBitBound, RawRat.ofNat, rawRatBinaryCode] + +@[simp] theorem machineOptimizerFourDimensionRawCode_encode {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) : + machineOptimizerFourDimensionRawCode + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩) = + rawRatBinaryCode + (rawOptimizerFour.mul (rawOptimizerDimension n)) := by + rw [machineOptimizerFourDimensionRawCode, + machineOptimizerDimensionRawCode_encode, + machineRawRatMulCode_encode] + +@[simp] theorem machineOptimizerTauRawCode_encode {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) : + machineOptimizerTauRawCode + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩) = + rawRatBinaryCode (rawOptimizerTau n) := by + rw [machineOptimizerTauRawCode, + machineOptimizerFourDimensionRawCode_encode, + machineRawRatDivCode_encode] + rfl + +@[simp] theorem machineOptimizerNSquareRawCode_encode {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) : + machineOptimizerNSquareRawCode + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩) = + rawRatBinaryCode (rawOptimizerNSquare n) := by + rw [machineOptimizerNSquareRawCode, + machineOptimizerDimensionRawCode_encode, + machineRawRatMulCode_encode] + rfl + +@[simp] theorem machineOptimizerNCubeRawCode_encode {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) : + machineOptimizerNCubeRawCode + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩) = + rawRatBinaryCode (rawOptimizerNCube n) := by + rw [machineOptimizerNCubeRawCode, + machineOptimizerNSquareRawCode_encode, + machineOptimizerDimensionRawCode_encode, + machineRawRatMulCode_encode] + rfl + +@[simp] theorem machineOptimizerNBProductRawCode_encode {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) : + machineOptimizerNBProductRawCode + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩) = + rawRatBinaryCode ((rawOptimizerDimension n).mul + (rawOptimizerBitBound (rationalMatrixEntryBitBound A))) := by + rw [machineOptimizerNBProductRawCode, + machineOptimizerDimensionRawCode_encode, + machineOptimizerBitBoundRawCode_encode, + machineRawRatMulCode_encode] + +@[simp] theorem machineOptimizerTwiceNSquareRawCode_encode {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) : + machineOptimizerTwiceNSquareRawCode + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩) = + rawRatBinaryCode (rawOptimizerTwo.mul (rawOptimizerNSquare n)) := by + rw [machineOptimizerTwiceNSquareRawCode, + machineOptimizerNSquareRawCode_encode, + machineRawRatMulCode_encode] + +@[simp] theorem machineOptimizerInteriorSumRawCode_encode {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) : + machineOptimizerInteriorSumRawCode + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩) = + rawRatBinaryCode + (rawOptimizerInteriorSum n (rationalMatrixEntryBitBound A)) := by + rw [machineOptimizerInteriorSumRawCode, + machineOptimizerNBProductRawCode_encode, + machineOptimizerTwiceNSquareRawCode_encode, + machineRawRatAddCode_encode] + rfl + +@[simp] theorem machineOptimizerNTimesInteriorSumRawCode_encode {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) : + machineOptimizerNTimesInteriorSumRawCode + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩) = + rawRatBinaryCode ((rawOptimizerDimension n).mul + (rawOptimizerInteriorSum n (rationalMatrixEntryBitBound A))) := by + rw [machineOptimizerNTimesInteriorSumRawCode, + machineOptimizerDimensionRawCode_encode, + machineOptimizerInteriorSumRawCode_encode, + machineRawRatMulCode_encode] + +@[simp] theorem machineOptimizerInteriorQuotientRawCode_encode {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) : + machineOptimizerInteriorQuotientRawCode + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩) = + rawRatBinaryCode (((rawOptimizerDimension n).mul + (rawOptimizerInteriorSum n (rationalMatrixEntryBitBound A))).div + (rawOptimizerTau n)) := by + rw [machineOptimizerInteriorQuotientRawCode, + machineOptimizerNTimesInteriorSumRawCode_encode, + machineOptimizerTauRawCode_encode, + machineRawRatDivCode_encode] + +@[simp] theorem machineOptimizerInteriorK0RawCode_encode {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) : + machineOptimizerInteriorK0RawCode + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩) = + rawRatBinaryCode + (rawOptimizerInteriorK0 n (rationalMatrixEntryBitBound A)) := by + rw [machineOptimizerInteriorK0RawCode, + machineOptimizerInteriorQuotientRawCode_encode, + machineOptimizerNCubeRawCode_encode, + machineRawRatAddCode_encode] + rfl + +@[simp] theorem machineOptimizerTwiceInteriorK0RawCode_encode {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) : + machineOptimizerTwiceInteriorK0RawCode + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩) = + rawRatBinaryCode + (rawOptimizerTwiceInteriorK0 n + (rationalMatrixEntryBitBound A)) := by + rw [machineOptimizerTwiceInteriorK0RawCode, + machineOptimizerInteriorK0RawCode_encode, + machineRawRatMulCode_encode] + rfl + +@[simp] theorem rawOptimizerDimension_value (n : ℕ) : + (rawOptimizerDimension n).value = n := by + simp [rawOptimizerDimension] + +@[simp] theorem rawOptimizerBitBound_value (B : ℕ) : + (rawOptimizerBitBound B).value = B := by + simp [rawOptimizerBitBound] + +@[simp] theorem rawOptimizerTau_value (n : ℕ) : + (rawOptimizerTau n).value = explicitRegularizationScale n := by + simp [rawOptimizerTau, rawOptimizerXi, rawOptimizerFour, + rawOptimizerDimension, explicitRegularizationScale] + +@[simp] theorem rawOptimizerInteriorK0_value (n B : ℕ) : + (rawOptimizerInteriorK0 n B).value = numericalInteriorK0 n B + (explicitRegularizationScale n) := by + simp [rawOptimizerInteriorK0, rawOptimizerInteriorSum, + rawOptimizerNSquare, rawOptimizerNCube, numericalInteriorK0, + rawOptimizerTwo] + ring + +@[simp] theorem rawOptimizerTwiceInteriorK0_value (n B : ℕ) : + (rawOptimizerTwiceInteriorK0 n B).value = + 2 * numericalInteriorK0 n B (explicitRegularizationScale n) := by + simp [rawOptimizerTwiceInteriorK0, rawOptimizerTwo] + +@[simp] theorem machineOptimizerInteriorExponentBits_encode + {n : ℕ} (A : Matrix (Fin n) (Fin n) ℚ) : + machineOptimizerInteriorExponentBits + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩) = + (numericalInteriorExponent n (rationalMatrixEntryBitBound A) + (explicitRegularizationScale n)).bits := by + rw [machineOptimizerInteriorExponentBits, + machineOptimizerTwiceInteriorK0RawCode_encode, + machineRationalCeilNatBits_encode, + rawOptimizerTwiceInteriorK0_value] + rw [numericalInteriorExponent] + simp [rationalCeilNat, binaryRatCeil_eq_ceil] + +/-! ## Guarded unary exponent and dyadic floor -/ + +def explicitOptimizerInteriorExponentCoefficient : ℕ := + 34 * rationalCeilNat (8 / explicitXi) + 2 + +theorem explicitOptimizerInteriorExponentCoefficient_le : + explicitOptimizerInteriorExponentCoefficient ≤ 17 ^ 60 := by + norm_num [explicitOptimizerInteriorExponentCoefficient, + rationalCeilNat, explicitXi, explicitDelta, explicitEta, + explicitRowRatio] + change 34 * + (14286815467932160000000000000000000000000000000000000000000000000000000 : ℕ) + + 2 ≤ 17 ^ 60 + norm_num + +theorem numericalInteriorExponent_le_sourcePolynomial + {n B S : ℕ} (hn : 1 ≤ n) (hnS : n ≤ S) (hBS : B ≤ 32 * S) : + numericalInteriorExponent n B (explicitRegularizationScale n) ≤ + explicitOptimizerInteriorExponentCoefficient * S ^ 4 := by + have hxi : 0 < explicitXi := explicitXi_pos + have hnQ : (0 : ℚ) < n := by exact_mod_cast hn + have htau : explicitRegularizationScale n = explicitXi / (4 * n) := rfl + have hrewrite : + 2 * numericalInteriorK0 n B (explicitRegularizationScale n) = + (8 / explicitXi) * (n ^ 3 * B + 2 * n ^ 4) + 2 * n ^ 3 := by + rw [numericalInteriorK0, htau] + field_simp [hxi.ne', hnQ.ne'] + ring + let C := rationalCeilNat (8 / explicitXi) + have hC : (8 / explicitXi : ℚ) ≤ C := by + exact le_rationalCeilNat (by positivity) + have hnonneg : (0 : ℚ) ≤ n ^ 3 * B + 2 * n ^ 4 := by positivity + have hmain : + (8 / explicitXi : ℚ) * (n ^ 3 * B + 2 * n ^ 4) + 2 * n ^ 3 ≤ + C * (n ^ 3 * B + 2 * n ^ 4) + 2 * n ^ 3 := by + gcongr + have hn3 : n ^ 3 ≤ S ^ 3 := Nat.pow_le_pow_left hnS 3 + have hn4 : n ^ 4 ≤ S ^ 4 := Nat.pow_le_pow_left hnS 4 + have hS1 : 1 ≤ S := hn.trans hnS + have hS3S : S ^ 3 ≤ S ^ 4 := by + rw [pow_succ] + exact Nat.le_mul_of_pos_right _ hS1 + have hpolyNat : + C * (n ^ 3 * B + 2 * n ^ 4) + 2 * n ^ 3 ≤ + (34 * C + 2) * S ^ 4 := by + nlinarith [Nat.mul_le_mul hn3 hBS, hn4, hn3.trans hS3S] + have hpoly : + (C : ℚ) * (n ^ 3 * B + 2 * n ^ 4) + 2 * n ^ 3 ≤ + ((34 * C + 2) * S ^ 4 : ℕ) := by + exact_mod_cast hpolyNat + apply rationalCeilNat_le_of_le_nat + rw [hrewrite] + exact hmain.trans hpoly + +def machineOptimizerInteriorExponentGuard (word : List Bool) : List Bool := + machineIteratedBinaryWidth 6 word + +def machineOptimizerInteriorExponentUnary (word : List Bool) : List Bool := + machineBoundedUnary + (pair (machineOptimizerInteriorExponentGuard word) + (machineOptimizerInteriorExponentBits word)) + +def machineOptimizerInteriorFloorRawCode (word : List Bool) : List Bool := + machineRawRatPowerCode + (pair (machineOptimizerInteriorExponentUnary word) + (rawRatBinaryCode rawOptimizerHalf)) + +def machineExplicitOptimizerFloorRawCode (word : List Bool) : List Bool := + machineRawRatDivCode + (pair (machineOptimizerInteriorFloorRawCode word) + (rawRatBinaryCode rawOptimizerTwo)) + +theorem machineOptimizerInteriorExponentGuard_mem_FP : + machineOptimizerInteriorExponentGuard ∈ FP := by + simpa only [machineOptimizerInteriorExponentGuard] using + machineIteratedBinaryWidth_mem_FP 6 + +theorem machineOptimizerInteriorExponentUnary_mem_FP : + machineOptimizerInteriorExponentUnary ∈ FP := by + simpa only [machineOptimizerInteriorExponentUnary] using machineCompose_mem_FP + (machinePair_mem_FP machineOptimizerInteriorExponentGuard_mem_FP + machineOptimizerInteriorExponentBits_mem_FP) + machineBoundedUnary_mem_FP + +theorem machineOptimizerInteriorFloorRawCode_mem_FP : + machineOptimizerInteriorFloorRawCode ∈ FP := by + simpa only [machineOptimizerInteriorFloorRawCode] using machineCompose_mem_FP + (machinePair_mem_FP machineOptimizerInteriorExponentUnary_mem_FP + (machineConst_mem_FP (rawRatBinaryCode rawOptimizerHalf))) + machineRawRatPowerCode_mem_FP + +theorem machineExplicitOptimizerFloorRawCode_mem_FP : + machineExplicitOptimizerFloorRawCode ∈ FP := by + simpa only [machineExplicitOptimizerFloorRawCode] using machineCompose_mem_FP + (machinePair_mem_FP machineOptimizerInteriorFloorRawCode_mem_FP + (machineConst_mem_FP (rawRatBinaryCode rawOptimizerTwo))) + machineRawRatDivCode_mem_FP + +theorem optimizerInteriorExponent_le_guard {n : ℕ} (hn : 1 ≤ n) + (A : Matrix (Fin n) (Fin n) ℚ) : + numericalInteriorExponent n (rationalMatrixEntryBitBound A) + (explicitRegularizationScale n) ≤ + (machineOptimizerInteriorExponentGuard + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩)).length := by + let word := rationalMatrixBinaryEncoding.encode ⟨n, A⟩ + let S := word.length + have hnS : n ≤ S := by + simpa only [S, word] using matrix_dimension_le_code_length A + have hBS : rationalMatrixEntryBitBound A ≤ 32 * S := by + simpa only [S, word] using rationalMatrixEntryBitBound_le_machineCode hn A + have hpoly := numericalInteriorExponent_le_sourcePolynomial hn hnS hBS + have hcoeff : + explicitOptimizerInteriorExponentCoefficient * S ^ 4 ≤ + (S + 16) ^ 64 := by + calc + explicitOptimizerInteriorExponentCoefficient * S ^ 4 ≤ + 17 ^ 60 * S ^ 4 := + Nat.mul_le_mul explicitOptimizerInteriorExponentCoefficient_le + (le_refl _) + _ ≤ (S + 16) ^ 60 * (S + 16) ^ 4 := by + exact Nat.mul_le_mul + (Nat.pow_le_pow_left (by omega) 60) + (Nat.pow_le_pow_left (by omega) 4) + _ = (S + 16) ^ 64 := by rw [← pow_add] + calc + numericalInteriorExponent n (rationalMatrixEntryBitBound A) + (explicitRegularizationScale n) ≤ + explicitOptimizerInteriorExponentCoefficient * S ^ 4 := hpoly + _ ≤ (S + 16) ^ 64 := hcoeff + _ ≤ certificateExpGuardWidth 6 S := by + simpa using certificateExpGuardWidth_pow_lower 5 S + _ = (machineOptimizerInteriorExponentGuard word).length := by + simp [machineOptimizerInteriorExponentGuard, S] + +@[simp] theorem machineOptimizerInteriorExponentUnary_encode + {n : ℕ} (hn : 1 ≤ n) (A : Matrix (Fin n) (Fin n) ℚ) : + machineOptimizerInteriorExponentUnary + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩) = + List.replicate + (numericalInteriorExponent n (rationalMatrixEntryBitBound A) + (explicitRegularizationScale n)) true := by + rw [machineOptimizerInteriorExponentUnary, + machineOptimizerInteriorExponentBits_encode] + exact machineBoundedUnary_encode_of_le _ _ + (optimizerInteriorExponent_le_guard hn A) + +@[simp] theorem rawOptimizerHalf_value : rawOptimizerHalf.value = 1 / 2 := by + simp [rawOptimizerHalf, rawOptimizerTwo] + +@[simp] theorem machineOptimizerInteriorFloorRawCode_encode + {n : ℕ} (hn : 1 ≤ n) (A : Matrix (Fin n) (Fin n) ℚ) : + machineOptimizerInteriorFloorRawCode + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩) = + rawRatBinaryCode (rawOptimizerHalf.pow + (numericalInteriorExponent n (rationalMatrixEntryBitBound A) + (explicitRegularizationScale n))) := by + rw [machineOptimizerInteriorFloorRawCode, + machineOptimizerInteriorExponentUnary_encode hn, + machineRawRatPowerCode_encode] + +@[simp] theorem machineExplicitOptimizerFloorRawCode_encode + {n : ℕ} (hn : 1 ≤ n) (A : Matrix (Fin n) (Fin n) ℚ) : + machineExplicitOptimizerFloorRawCode + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩) = + rawRatBinaryCode ((rawOptimizerHalf.pow + (numericalInteriorExponent n (rationalMatrixEntryBitBound A) + (explicitRegularizationScale n))).div rawOptimizerTwo) := by + rw [machineExplicitOptimizerFloorRawCode, + machineOptimizerInteriorFloorRawCode_encode hn, + machineRawRatDivCode_encode] + +theorem machineExplicitOptimizerFloorRawValue {m : ℕ} + (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) : + ((rawOptimizerHalf.pow + (numericalInteriorExponent (m + 1) (rationalMatrixEntryBitBound A) + (explicitRegularizationScale (m + 1)))).div rawOptimizerTwo).value = + explicitOptimizerFloor A := by + simp [explicitOptimizerFloor, numericalInteriorFloor, + rawOptimizerHalf_value, rawOptimizerTwo] + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerMatrixBitBound.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerMatrixBitBound.lean new file mode 100644 index 0000000000..9c0b3254de --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerMatrixBitBound.lean @@ -0,0 +1,573 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerEntryLength +import LeanPool.BeyondBethe.BeyondBethe.MachineMatrixSum +import LeanPool.BeyondBethe.BeyondBethe.CertificateMagnitude + +/-! +# Exact matrix entry-bit bound for the optimizer + +This row-major transducer returns a unary ruler of length +`rationalMatrixEntryBitBound A`. Its clamp and state envelope are explicit +on arbitrary bitstrings; the clamp is proved inactive on every canonical +matrix input. +-/ + +namespace BeyondBethe + +open Complexity + +def machineMatrixEntryLengthPack + (rows current acc bound : List Bool) : List Bool := + pair rows (pair current (pair acc bound)) + +def machineMatrixEntryLengthRows (state : List Bool) : List Bool := + machinePairFirst state + +def machineMatrixEntryLengthCurrent (state : List Bool) : List Bool := + machinePairFirst (machinePairSecond state) + +def machineMatrixEntryLengthAcc (state : List Bool) : List Bool := + machinePairFirst (machinePairSecond (machinePairSecond state)) + +def machineMatrixEntryLengthBound (state : List Bool) : List Bool := + machinePairSecond (machinePairSecond (machinePairSecond state)) + +def machineMatrixEntryLengthEntry (state : List Bool) : List Bool := + machineListHead (machineMatrixEntryLengthCurrent state) + +def machineMatrixEntryLengthCandidate (state : List Bool) : List Bool := + machineMatrixEntryLengthAcc state ++ + machineOptimizerEntryLengthRuler (machineMatrixEntryLengthEntry state) + +def machineMatrixEntryLengthNextAcc (state : List Bool) : List Bool := + (machineMatrixEntryLengthCandidate state).take + (machineMatrixEntryLengthBound state).length + +def machineMatrixEntryLengthProcessEntry (state : List Bool) : List Bool := + machineMatrixEntryLengthPack + (machineMatrixEntryLengthRows state) + (machineListTail (machineMatrixEntryLengthCurrent state)) + (machineMatrixEntryLengthNextAcc state) + (machineMatrixEntryLengthBound state) + +def machineMatrixEntryLengthLoadRow (state : List Bool) : List Bool := + machineMatrixEntryLengthPack + (machineListTail (machineMatrixEntryLengthRows state)) + (machineListHead (machineMatrixEntryLengthRows state)) + (machineMatrixEntryLengthAcc state) + (machineMatrixEntryLengthBound state) + +def machineMatrixEntryLengthAfterRow (state : List Bool) : List Bool := + machineIfEmpty (machineMatrixEntryLengthRows state) state + (machineMatrixEntryLengthLoadRow state) + +def machineMatrixEntryLengthStep (state : List Bool) : List Bool := + machineIfEmpty (machineMatrixEntryLengthCurrent state) + (machineMatrixEntryLengthAfterRow state) + (machineMatrixEntryLengthProcessEntry state) + +def machineMatrixEntryLengthInputBound (word : List Bool) : List Bool := + let w2 := word ++ word + let w4 := w2 ++ w2 + let w8 := w4 ++ w4 + let w16 := w8 ++ w8 + let w32 := w16 ++ w16 + let w64 := w32 ++ w32 + List.replicate 8 false ++ w64 + +def machineMatrixEntryLengthInit (word : List Bool) : List Bool := + machineMatrixEntryLengthPack (machineMatrixRowsWord word) [] [true] + (machineMatrixEntryLengthInputBound word) + +def machineMatrixEntryLengthWidth (word : List Bool) : List Bool := + let bound := machineMatrixEntryLengthInputBound word + machineMatrixEntryLengthPack bound bound bound bound + +def machineMatrixEntryLengthFinalState (word : List Bool) : List Bool := + (machineMatrixEntryLengthStep)^[word.length] + (machineMatrixEntryLengthInit word) + +/-- Exact unary matrix-entry bit bound on canonical inputs. -/ +def machineMatrixEntryBitBoundRuler (word : List Bool) : List Bool := + machineMatrixEntryLengthAcc (machineMatrixEntryLengthFinalState word) + +/-! ## Polynomial-time envelope -/ + +theorem machineMatrixEntryLengthRows_mem_FP : + machineMatrixEntryLengthRows ∈ Complexity.FP := machinePairFirst_mem_FP + +theorem machineMatrixEntryLengthCurrent_mem_FP : + machineMatrixEntryLengthCurrent ∈ Complexity.FP := by + simpa only [machineMatrixEntryLengthCurrent] using + machineCompose_mem_FP machinePairSecond_mem_FP machinePairFirst_mem_FP + +theorem machineMatrixEntryLengthAcc_mem_FP : + machineMatrixEntryLengthAcc ∈ Complexity.FP := by + simpa only [machineMatrixEntryLengthAcc] using + machineCompose_mem_FP + (machineCompose_mem_FP machinePairSecond_mem_FP machinePairSecond_mem_FP) + machinePairFirst_mem_FP + +theorem machineMatrixEntryLengthBound_mem_FP : + machineMatrixEntryLengthBound ∈ Complexity.FP := by + simpa only [machineMatrixEntryLengthBound] using + machineCompose_mem_FP + (machineCompose_mem_FP machinePairSecond_mem_FP machinePairSecond_mem_FP) + machinePairSecond_mem_FP + +theorem machineMatrixEntryLengthEntry_mem_FP : + machineMatrixEntryLengthEntry ∈ Complexity.FP := by + simpa only [machineMatrixEntryLengthEntry] using + machineCompose_mem_FP machineMatrixEntryLengthCurrent_mem_FP + machineListHead_mem_FP + +theorem machineMatrixEntryLengthCandidate_mem_FP : + machineMatrixEntryLengthCandidate ∈ Complexity.FP := by + have hcost := machineCompose_mem_FP machineMatrixEntryLengthEntry_mem_FP + machineOptimizerEntryLengthRuler_mem_FP + exact machineAppend_mem_FP machineMatrixEntryLengthAcc_mem_FP hcost + +theorem machineMatrixEntryLengthNextAcc_mem_FP : + machineMatrixEntryLengthNextAcc ∈ Complexity.FP := by + simpa only [machineMatrixEntryLengthNextAcc] using + machineTake_mem_FP machineMatrixEntryLengthBound_mem_FP + machineMatrixEntryLengthCandidate_mem_FP + +theorem machineMatrixEntryLengthProcessEntry_mem_FP : + machineMatrixEntryLengthProcessEntry ∈ Complexity.FP := by + have htail := machineCompose_mem_FP machineMatrixEntryLengthCurrent_mem_FP + machineListTail_mem_FP + exact machinePair_mem_FP machineMatrixEntryLengthRows_mem_FP + (machinePair_mem_FP htail + (machinePair_mem_FP machineMatrixEntryLengthNextAcc_mem_FP + machineMatrixEntryLengthBound_mem_FP)) + +theorem machineMatrixEntryLengthLoadRow_mem_FP : + machineMatrixEntryLengthLoadRow ∈ Complexity.FP := by + have htail := machineCompose_mem_FP machineMatrixEntryLengthRows_mem_FP + machineListTail_mem_FP + have hhead := machineCompose_mem_FP machineMatrixEntryLengthRows_mem_FP + machineListHead_mem_FP + exact machinePair_mem_FP htail + (machinePair_mem_FP hhead + (machinePair_mem_FP machineMatrixEntryLengthAcc_mem_FP + machineMatrixEntryLengthBound_mem_FP)) + +theorem machineMatrixEntryLengthAfterRow_mem_FP : + machineMatrixEntryLengthAfterRow ∈ Complexity.FP := by + exact machineIfEmpty_mem_FP machineMatrixEntryLengthRows_mem_FP id_mem_FP + machineMatrixEntryLengthLoadRow_mem_FP + +theorem machineMatrixEntryLengthStep_mem_FP : + machineMatrixEntryLengthStep ∈ Complexity.FP := by + exact machineIfEmpty_mem_FP machineMatrixEntryLengthCurrent_mem_FP + machineMatrixEntryLengthAfterRow_mem_FP + machineMatrixEntryLengthProcessEntry_mem_FP + +theorem machineMatrixEntryLengthInputBound_mem_FP : + machineMatrixEntryLengthInputBound ∈ Complexity.FP := by + have h2 := machineAppend_mem_FP id_mem_FP id_mem_FP + have h4 := machineAppend_mem_FP h2 h2 + have h8 := machineAppend_mem_FP h4 h4 + have h16 := machineAppend_mem_FP h8 h8 + have h32 := machineAppend_mem_FP h16 h16 + have h64 := machineAppend_mem_FP h32 h32 + simpa only [machineMatrixEntryLengthInputBound] using + machineAppend_mem_FP + (machineConst_mem_FP (List.replicate 8 false)) h64 + +theorem machineMatrixEntryLengthInit_mem_FP : + machineMatrixEntryLengthInit ∈ Complexity.FP := by + exact machinePair_mem_FP machineMatrixRowsWord_mem_FP + (machinePair_mem_FP (machineConst_mem_FP []) + (machinePair_mem_FP (machineConst_mem_FP [true]) + machineMatrixEntryLengthInputBound_mem_FP)) + +theorem machineMatrixEntryLengthWidth_mem_FP : + machineMatrixEntryLengthWidth ∈ Complexity.FP := by + exact machinePair_mem_FP machineMatrixEntryLengthInputBound_mem_FP + (machinePair_mem_FP machineMatrixEntryLengthInputBound_mem_FP + (machinePair_mem_FP machineMatrixEntryLengthInputBound_mem_FP + machineMatrixEntryLengthInputBound_mem_FP)) + +@[simp] theorem machineMatrixEntryLengthRows_pack (rows current acc bound) : + machineMatrixEntryLengthRows + (machineMatrixEntryLengthPack rows current acc bound) = rows := by + simp [machineMatrixEntryLengthRows, machineMatrixEntryLengthPack] + +@[simp] theorem machineMatrixEntryLengthCurrent_pack (rows current acc bound) : + machineMatrixEntryLengthCurrent + (machineMatrixEntryLengthPack rows current acc bound) = current := by + simp [machineMatrixEntryLengthCurrent, machineMatrixEntryLengthPack] + +@[simp] theorem machineMatrixEntryLengthAcc_pack (rows current acc bound) : + machineMatrixEntryLengthAcc + (machineMatrixEntryLengthPack rows current acc bound) = acc := by + simp [machineMatrixEntryLengthAcc, machineMatrixEntryLengthPack] + +@[simp] theorem machineMatrixEntryLengthBound_pack (rows current acc bound) : + machineMatrixEntryLengthBound + (machineMatrixEntryLengthPack rows current acc bound) = bound := by + simp [machineMatrixEntryLengthBound, machineMatrixEntryLengthPack] + +@[simp] theorem machineMatrixEntryLengthInputBound_length (word : List Bool) : + (machineMatrixEntryLengthInputBound word).length = + 8 + 64 * word.length := by + simp [machineMatrixEntryLengthInputBound] + omega + +def MachineMatrixEntryLengthStateBound (word state : List Bool) : Prop := + state = machineMatrixEntryLengthPack + (machineMatrixEntryLengthRows state) + (machineMatrixEntryLengthCurrent state) + (machineMatrixEntryLengthAcc state) + (machineMatrixEntryLengthBound state) ∧ + (machineMatrixEntryLengthRows state).length ≤ word.length ∧ + (machineMatrixEntryLengthCurrent state).length ≤ word.length ∧ + (machineMatrixEntryLengthAcc state).length ≤ + (machineMatrixEntryLengthInputBound word).length ∧ + machineMatrixEntryLengthBound state = + machineMatrixEntryLengthInputBound word + +theorem machineMatrixEntryLengthInit_bound (word : List Bool) : + MachineMatrixEntryLengthStateBound word + (machineMatrixEntryLengthInit word) := by + simp only [MachineMatrixEntryLengthStateBound, + machineMatrixEntryLengthInit, machineMatrixEntryLengthRows_pack, + machineMatrixEntryLengthCurrent_pack, machineMatrixEntryLengthAcc_pack, + machineMatrixEntryLengthBound_pack] + refine ⟨trivial, ?_, by simp, ?_, trivial⟩ + · simpa only [machineMatrixRowsWord] using machinePairSecond_length_le word + · simp only [machineMatrixEntryLengthInputBound_length, + List.length_singleton] + omega + +theorem machineMatrixEntryLengthStep_bound {word state : List Bool} + (hstate : MachineMatrixEntryLengthStateBound word state) : + MachineMatrixEntryLengthStateBound word + (machineMatrixEntryLengthStep state) := by + rcases hstate with ⟨hdecomp, hrows, hcurrent, hacc, hbound⟩ + by_cases hc : machineMatrixEntryLengthCurrent state = [] + · rw [machineMatrixEntryLengthStep, hc, machineIfEmpty_nil] + by_cases hr : machineMatrixEntryLengthRows state = [] + · rw [machineMatrixEntryLengthAfterRow, hr, machineIfEmpty_nil] + exact ⟨hdecomp, hrows, hcurrent, hacc, hbound⟩ + · rw [machineMatrixEntryLengthAfterRow] + cases hrowsCode : machineMatrixEntryLengthRows state with + | nil => exact False.elim (hr hrowsCode) + | cons bit tail => + rw [machineIfEmpty_cons, machineMatrixEntryLengthLoadRow] + simp only [MachineMatrixEntryLengthStateBound, + machineMatrixEntryLengthRows_pack, + machineMatrixEntryLengthCurrent_pack, + machineMatrixEntryLengthAcc_pack, + machineMatrixEntryLengthBound_pack] + refine ⟨trivial, ?_, ?_, hacc, hbound⟩ + · exact (machinePairSecond_length_le + (machineMatrixEntryLengthRows state)).trans hrows + · exact (machinePairFirst_length_le + (machineMatrixEntryLengthRows state)).trans hrows + · rw [machineMatrixEntryLengthStep] + cases hcurrentCode : machineMatrixEntryLengthCurrent state with + | nil => exact False.elim (hc hcurrentCode) + | cons bit tail => + rw [machineIfEmpty_cons, machineMatrixEntryLengthProcessEntry] + simp only [MachineMatrixEntryLengthStateBound, + machineMatrixEntryLengthRows_pack, + machineMatrixEntryLengthCurrent_pack, + machineMatrixEntryLengthAcc_pack, + machineMatrixEntryLengthBound_pack] + refine ⟨trivial, hrows, ?_, ?_, hbound⟩ + · exact (machinePairSecond_length_le + (machineMatrixEntryLengthCurrent state)).trans hcurrent + · rw [machineMatrixEntryLengthNextAcc, hbound] + exact List.length_take_le _ _ + +theorem machineMatrixEntryLengthIterate_bound (word : List Bool) : ∀ k, + MachineMatrixEntryLengthStateBound word + ((machineMatrixEntryLengthStep)^[k] + (machineMatrixEntryLengthInit word)) := by + intro k + induction k with + | zero => exact machineMatrixEntryLengthInit_bound word + | succ k ih => + rw [Function.iterate_succ_apply'] + exact machineMatrixEntryLengthStep_bound ih + +theorem machineMatrixEntryLengthIterate_length_le_width + (word : List Bool) (iterations : ℕ) (_ : iterations ≤ word.length) : + ((machineMatrixEntryLengthStep)^[iterations] + (machineMatrixEntryLengthInit word)).length ≤ + (machineMatrixEntryLengthWidth word).length := by + rcases machineMatrixEntryLengthIterate_bound word iterations with + ⟨hdecomp, hrows, hcurrent, hacc, hbound⟩ + rw [hdecomp, hbound] + simp only [machineMatrixEntryLengthPack, + machineMatrixEntryLengthWidth, pair_length] + have hword : word.length ≤ + (machineMatrixEntryLengthInputBound word).length := by + simp only [machineMatrixEntryLengthInputBound_length] + omega + omega + +theorem machineMatrixEntryLengthFinalState_mem_FP : + machineMatrixEntryLengthFinalState ∈ Complexity.FP := by + exact Cobham.iterate_mem_FP machineMatrixEntryLengthStep_mem_FP + machineMatrixEntryLengthInit_mem_FP id_mem_FP + machineMatrixEntryLengthWidth_mem_FP + machineMatrixEntryLengthIterate_length_le_width + +theorem machineMatrixEntryBitBoundRuler_mem_FP : + machineMatrixEntryBitBoundRuler ∈ Complexity.FP := by + simpa only [machineMatrixEntryBitBoundRuler] using + machineCompose_mem_FP machineMatrixEntryLengthFinalState_mem_FP + machineMatrixEntryLengthAcc_mem_FP + +/-! ## Exact semantics -/ + +def matrixEntryLengthListCost (xs : List ℚ) : ℕ := + (xs.map fun q ↦ encodedBitLength ℚ q).sum + +def matrixEntryLengthRowsCost (rows : List (List ℚ)) : ℕ := + (rows.map matrixEntryLengthListCost).sum + +structure MatrixEntryLengthSemState where + rows : List (List ℚ) + current : List ℚ + acc : ℕ + +def matrixEntryLengthSemCode (bound : List Bool) + (s : MatrixEntryLengthSemState) : List Bool := + machineMatrixEntryLengthPack + (binaryListCode (binaryListCode rationalEntryBinaryCode) s.rows) + (binaryListCode rationalEntryBinaryCode s.current) + (List.replicate s.acc true) bound + +def matrixEntryLengthSemStep : + MatrixEntryLengthSemState → MatrixEntryLengthSemState + | ⟨[], [], acc⟩ => ⟨[], [], acc⟩ + | ⟨row :: rows, [], acc⟩ => ⟨rows, row, acc⟩ + | ⟨rows, q :: qs, acc⟩ => + ⟨rows, qs, acc + encodedBitLength ℚ q⟩ + +def MatrixEntryLengthSemInvariant + (boundLength : ℕ) (s : MatrixEntryLengthSemState) : Prop := + s.acc + matrixEntryLengthListCost s.current + + matrixEntryLengthRowsCost s.rows ≤ boundLength + +theorem matrixEntryLengthSemStep_invariant {L : ℕ} + {s : MatrixEntryLengthSemState} + (hs : MatrixEntryLengthSemInvariant L s) : + MatrixEntryLengthSemInvariant L (matrixEntryLengthSemStep s) := by + rcases s with ⟨rows, current, acc⟩ + cases current with + | cons q qs => + simpa [MatrixEntryLengthSemInvariant, matrixEntryLengthSemStep, + matrixEntryLengthListCost, Nat.add_assoc] using hs + | nil => + cases rows with + | nil => simpa [MatrixEntryLengthSemInvariant, + matrixEntryLengthSemStep] using hs + | cons row rows => + simpa [MatrixEntryLengthSemInvariant, matrixEntryLengthSemStep, + matrixEntryLengthListCost, matrixEntryLengthRowsCost, + Nat.add_assoc] using hs + +theorem machineMatrixEntryLengthStep_semantics + (bound : List Bool) (s : MatrixEntryLengthSemState) + (hs : MatrixEntryLengthSemInvariant bound.length s) : + machineMatrixEntryLengthStep (matrixEntryLengthSemCode bound s) = + matrixEntryLengthSemCode bound (matrixEntryLengthSemStep s) := by + rcases s with ⟨rows, current, acc⟩ + cases current with + | nil => + cases rows with + | nil => + simp [machineMatrixEntryLengthStep, + machineMatrixEntryLengthAfterRow, matrixEntryLengthSemCode, + matrixEntryLengthSemStep, binaryListCode] + | cons row rows => + rw [matrixEntryLengthSemCode, matrixEntryLengthSemStep, + machineMatrixEntryLengthStep] + simp only [machineMatrixEntryLengthCurrent_pack, binaryListCode, + machineIfEmpty_nil, machineMatrixEntryLengthAfterRow, + machineMatrixEntryLengthRows_pack] + have hpair : pair (binaryListCode rationalEntryBinaryCode row) + (binaryListCode (binaryListCode rationalEntryBinaryCode) rows) ≠ + [] := by + intro h + have hlen := congrArg List.length h + simp at hlen + rw [machineIfEmpty_of_ne_nil_matrix _ _ _ hpair] + simp [machineMatrixEntryLengthLoadRow, + matrixEntryLengthSemCode, machineListHead, machineListTail] + | cons q qs => + have hfit : acc + encodedBitLength ℚ q ≤ bound.length := by + simp [MatrixEntryLengthSemInvariant, + matrixEntryLengthListCost] at hs + omega + rw [matrixEntryLengthSemCode, matrixEntryLengthSemStep, + machineMatrixEntryLengthStep] + simp only [machineMatrixEntryLengthCurrent_pack] + rw [machineIfEmpty_of_ne_nil_matrix _ _ _ + (binaryListCode_cons_ne_nil rationalEntryBinaryCode q qs)] + simp only [machineMatrixEntryLengthProcessEntry, + machineMatrixEntryLengthRows_pack, + machineMatrixEntryLengthCurrent_pack, + machineMatrixEntryLengthAcc_pack, + machineMatrixEntryLengthBound_pack, + machineListTail_cons, machineMatrixEntryLengthNextAcc, + machineMatrixEntryLengthCandidate, + machineMatrixEntryLengthEntry, machineListHead_cons, + machineOptimizerEntryLengthRuler_encode] + rw [show List.replicate acc true ++ + List.replicate (encodedBitLength ℚ q) true = + List.replicate (acc + encodedBitLength ℚ q) true by + exact (List.replicate_add _ _ _).symm, + (List.take_eq_self_iff _).mpr (by simpa using hfit)] + rfl + +theorem machineMatrixEntryLengthIterate_semantics + (bound : List Bool) (s : MatrixEntryLengthSemState) + (hs : MatrixEntryLengthSemInvariant bound.length s) : ∀ k, + (machineMatrixEntryLengthStep)^[k] + (matrixEntryLengthSemCode bound s) = + matrixEntryLengthSemCode bound ((matrixEntryLengthSemStep)^[k] s) := by + intro k + have hinv : ∀ t, + MatrixEntryLengthSemInvariant bound.length + ((matrixEntryLengthSemStep)^[t] s) := by + intro t + induction t with + | zero => exact hs + | succ t iht => + rw [Function.iterate_succ_apply'] + exact matrixEntryLengthSemStep_invariant iht + induction k with + | zero => rfl + | succ k ih => + rw [Function.iterate_succ_apply', Function.iterate_succ_apply', ih] + exact machineMatrixEntryLengthStep_semantics bound _ (hinv k) + +theorem matrixEntryLengthSem_processRow + (rows : List (List ℚ)) (row : List ℚ) (acc : ℕ) : + (matrixEntryLengthSemStep)^[row.length] + ⟨rows, row, acc⟩ = + ⟨rows, [], acc + matrixEntryLengthListCost row⟩ := by + induction row generalizing acc with + | nil => simp [matrixEntryLengthListCost] + | cons q qs ih => + rw [List.length_cons, Function.iterate_succ_apply, + matrixEntryLengthSemStep, ih] + simp [matrixEntryLengthListCost, Nat.add_assoc] + +theorem matrixEntryLengthSem_processRows + (rows : List (List ℚ)) (acc : ℕ) : + (matrixEntryLengthSemStep)^[matrixNonnegativeRowsWork rows] + ⟨rows, [], acc⟩ = + ⟨[], [], acc + matrixEntryLengthRowsCost rows⟩ := by + induction rows generalizing acc with + | nil => simp [matrixNonnegativeRowsWork, matrixEntryLengthRowsCost] + | cons row rows ih => + rw [matrixNonnegativeRowsWork, show 1 + row.length + + matrixNonnegativeRowsWork rows = + matrixNonnegativeRowsWork rows + row.length + 1 by omega, + Function.iterate_add_apply, Function.iterate_add_apply, + Function.iterate_one, matrixEntryLengthSemStep, + matrixEntryLengthSem_processRow, ih] + simp [matrixEntryLengthRowsCost, Nat.add_assoc] + +theorem machineMatrixEntryLength_done_iterate + (extra : ℕ) (acc : ℕ) (bound : List Bool) : + (machineMatrixEntryLengthStep)^[extra] + (machineMatrixEntryLengthPack [] [] + (List.replicate acc true) bound) = + machineMatrixEntryLengthPack [] [] + (List.replicate acc true) bound := by + induction extra with + | zero => rfl + | succ k ih => + rw [Function.iterate_succ_apply', ih] + simp [machineMatrixEntryLengthStep, machineMatrixEntryLengthAfterRow] + +theorem matrixEntryLengthRowsCost_eq_matrixBound {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) : + 1 + matrixEntryLengthRowsCost (rationalMatrixRows A) = + rationalMatrixEntryBitBound A := by + simp only [matrixEntryLengthRowsCost, matrixEntryLengthListCost, + rationalMatrixRows, rationalMatrixEntryBitBound, + List.map_ofFn, List.sum_ofFn, Function.comp_apply] + +theorem machineMatrixEntryLengthFinalState_encode {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) : + machineMatrixEntryLengthFinalState + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩) = + machineMatrixEntryLengthPack [] [] + (List.replicate (rationalMatrixEntryBitBound A) true) + (machineMatrixEntryLengthInputBound + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩)) := by + let rows := rationalMatrixRows A + let word := rationalMatrixBinaryEncoding.encode ⟨n, A⟩ + let bound := machineMatrixEntryLengthInputBound word + let s : MatrixEntryLengthSemState := ⟨rows, [], 1⟩ + have hrowsLength : + (binaryListCode (binaryListCode rationalEntryBinaryCode) rows).length ≤ + word.length := by + calc + _ = (machineMatrixRowsWord word).length := by + simpa only [word, rows] using congrArg List.length + (machineMatrixRowsWord_encode A).symm + _ ≤ word.length := by + simpa only [machineMatrixRowsWord] using + machinePairSecond_length_le word + have hcost : rationalMatrixEntryBitBound A ≤ bound.length := by + by_cases hn : n = 0 + · subst n + simp only [rationalMatrixEntryBitBound, rationalMatrixRows, + Finset.univ_eq_empty, Finset.sum_empty, Nat.add_zero, bound, + machineMatrixEntryLengthInputBound_length] + omega + · have hmachine := rationalMatrixEntryBitBound_le_machineCode + (Nat.pos_of_ne_zero hn) A + have hmachine' : rationalMatrixEntryBitBound A ≤ 32 * word.length := by + simpa only [word] using hmachine + simp only [bound, machineMatrixEntryLengthInputBound_length] + omega + have hinv : MatrixEntryLengthSemInvariant bound.length s := by + simpa only [MatrixEntryLengthSemInvariant, s, + matrixEntryLengthListCost, List.map_nil, List.sum_nil, Nat.add_zero, + rows, matrixEntryLengthRowsCost_eq_matrixBound] using hcost + have hwork : matrixNonnegativeRowsWork rows ≤ word.length := + (binaryListCode_length_ge_work rows).trans hrowsLength + have hsplit : word.length = + (word.length - matrixNonnegativeRowsWork rows) + + matrixNonnegativeRowsWork rows := by omega + have hinit : machineMatrixEntryLengthInit word = + matrixEntryLengthSemCode bound s := by + simp [machineMatrixEntryLengthInit, matrixEntryLengthSemCode, + s, rows, word, bound, binaryListCode] + change machineMatrixEntryLengthFinalState word = _ + rw [machineMatrixEntryLengthFinalState, hsplit, + Function.iterate_add_apply, hinit, + machineMatrixEntryLengthIterate_semantics bound s hinv, + matrixEntryLengthSem_processRows] + simp only [matrixEntryLengthSemCode, binaryListCode] + rw [machineMatrixEntryLength_done_iterate] + congr 2 + rw [matrixEntryLengthRowsCost_eq_matrixBound] + +@[simp] theorem machineMatrixEntryBitBoundRuler_encode {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) : + machineMatrixEntryBitBoundRuler + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩) = + List.replicate (rationalMatrixEntryBitBound A) true := by + rw [machineMatrixEntryBitBoundRuler, + machineMatrixEntryLengthFinalState_encode] + simp + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerRoundingSchedule.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerRoundingSchedule.lean new file mode 100644 index 0000000000..97fc10a27c --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerRoundingSchedule.lean @@ -0,0 +1,573 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerFeasibilitySchedule +import LeanPool.BeyondBethe.BeyondBethe.MachineNaturalCombinators +import LeanPool.BeyondBethe.BeyondBethe.ExplicitBetheThresholdFeasibility + +/-! # Machine Optimizer Rounding Schedule -/ + +namespace BeyondBethe + +open Complexity + +/-! +# Finite-word rounding precision for Bethe feasibility + +The precision is the explicit zero-ball schedule proved in +`ExplicitScheduledFeasibility`. Its inputs are the exact ellipsoid dimension, +the exact iteration budget, and canonical bit lengths of the outer radius and +of the initial state-magnitude bound. +-/ + +def rawOptimizerFeasibilityInitialMagnitude + (d : ℕ) (R : RawRat) : RawRat := + rawOptimizerTwo.add ((RawRat.ofNat d).mul R) + +def machineOptimizerFeasibilityInitialMagnitudeRawCode + (word : List Bool) : List Bool := + machineRawRatAddCode + (pair (rawRatBinaryCode rawOptimizerTwo) + (machineRawRatMulCode + (pair (machineOptimizerFeasibilityEllipsoidDimensionRawCode word) + (machineOptimizerFeasibilityOuterRadiusRawCode word)))) + +def machineOptimizerFeasibilityInitialMagnitudeEntryCode + (word : List Bool) : List Bool := + machineNormalizeRawRatEntryCode + (machineOptimizerFeasibilityInitialMagnitudeRawCode word) + +def machineOptimizerFeasibilityInitialMagnitudeLengthRuler + (word : List Bool) : List Bool := + machineOptimizerEntryLengthRuler + (machineOptimizerFeasibilityInitialMagnitudeEntryCode word) + +def machineOptimizerFeasibilityKBits (word : List Bool) : List Bool := + machineLengthBits + (machineOptimizerFeasibilityInitialMagnitudeLengthRuler word) + +def machineOptimizerFeasibilityLBits (word : List Bool) : List Bool := + machineBinaryMulOf machineOptimizerFeasibilityOuterLengthBits + machineOptimizerFeasibilityDBits word + +def machineOptimizerFeasibilityTwoTBits (word : List Bool) : List Bool := + machineBinaryMulOf (machineBinaryConst 2) + machineOptimizerFeasibilityBudgetBits word + +def machineOptimizerFeasibilityFirstBaseBits (word : List Bool) : List Bool := + machineBinaryAddOf machineOptimizerFeasibilityLBits + machineOptimizerFeasibilityTwoTBits word + +def machineOptimizerFeasibilityFirstBits (word : List Bool) : List Bool := + machineBinaryAddOf machineOptimizerFeasibilityFirstBaseBits + (machineBinaryConst 1) word + +def machineOptimizerFeasibilityThreeDBits (word : List Bool) : List Bool := + machineBinaryMulOf (machineBinaryConst 3) + machineOptimizerFeasibilityDBits word + +def machineOptimizerFeasibilitySixPlusThreeDBits + (word : List Bool) : List Bool := + machineBinaryAddOf (machineBinaryConst 6) + machineOptimizerFeasibilityThreeDBits word + +def machineOptimizerFeasibilityTTimesGrowthBits + (word : List Bool) : List Bool := + machineBinaryMulOf machineOptimizerFeasibilityBudgetBits + machineOptimizerFeasibilitySixPlusThreeDBits word + +def machineOptimizerFeasibilityKPlusGrowthBits + (word : List Bool) : List Bool := + machineBinaryAddOf machineOptimizerFeasibilityKBits + machineOptimizerFeasibilityTTimesGrowthBits word + +def machineOptimizerFeasibilityKPlusGrowthPlusThreeBits + (word : List Bool) : List Bool := + machineBinaryAddOf machineOptimizerFeasibilityKPlusGrowthBits + (machineBinaryConst 3) word + +def machineOptimizerFeasibilityInnerMagnitudeBits + (word : List Bool) : List Bool := + machineBinaryAddOf machineOptimizerFeasibilityKPlusGrowthPlusThreeBits + machineOptimizerFeasibilityDBits word + +def machineOptimizerFeasibilityDInnerMagnitudeBits + (word : List Bool) : List Bool := + machineBinaryMulOf machineOptimizerFeasibilityDBits + machineOptimizerFeasibilityInnerMagnitudeBits word + +def machineOptimizerFeasibilityEightDBits (word : List Bool) : List Bool := + machineBinaryMulOf (machineBinaryConst 8) + machineOptimizerFeasibilityDBits word + +def machineOptimizerFeasibilityDenomFirstBits + (word : List Bool) : List Bool := + machineBinaryAddOf (machineBinaryConst 12) + machineOptimizerFeasibilityEightDBits word + +def machineOptimizerFeasibilityDenomSecondBits + (word : List Bool) : List Bool := + machineBinaryAddOf machineOptimizerFeasibilityDenomFirstBits + machineOptimizerFeasibilityDSquareBits word + +def machineOptimizerFeasibilityDenominatorExponentBits + (word : List Bool) : List Bool := + machineBinaryAddOf machineOptimizerFeasibilityDenomSecondBits + machineOptimizerFeasibilityDInnerMagnitudeBits word + +def machineOptimizerFeasibilityPrecisionBaseBits + (word : List Bool) : List Bool := + machineBinaryAddOf machineOptimizerFeasibilityFirstBits + machineOptimizerFeasibilityDenominatorExponentBits word + +def machineOptimizerFeasibilityRoundingPrecisionBits + (word : List Bool) : List Bool := + machineBinaryAddOf machineOptimizerFeasibilityPrecisionBaseBits + (machineBinaryConst 2) word + +def machineOptimizerFeasibilityRoundingGuardSource + (word : List Bool) : List Bool := + machineOptimizerFeasibilityBudgetUnary word ++ + (machineOptimizerFeasibilityEllipsoidDimensionUnary word ++ + (machineOptimizerFeasibilityInitialMagnitudeLengthRuler word ++ + machineOptimizerFeasibilityOuterRadiusLengthRuler word)) + +def machineOptimizerFeasibilityRoundingGuard + (word : List Bool) : List Bool := + machineIteratedBinaryWidth 2 + (machineOptimizerFeasibilityRoundingGuardSource word) + +def machineOptimizerFeasibilityRoundingPrecisionUnary + (word : List Bool) : List Bool := + machineBoundedUnary + (pair (machineOptimizerFeasibilityRoundingGuard word) + (machineOptimizerFeasibilityRoundingPrecisionBits word)) + +/-! ## Polynomial-time closure -/ + +theorem machineOptimizerFeasibilityInitialMagnitudeRawCode_mem_FP : + machineOptimizerFeasibilityInitialMagnitudeRawCode ∈ FP := by + have hproduct := machineCompose_mem_FP + (machinePair_mem_FP + machineOptimizerFeasibilityEllipsoidDimensionRawCode_mem_FP + machineOptimizerFeasibilityOuterRadiusRawCode_mem_FP) + machineRawRatMulCode_mem_FP + simpa only [machineOptimizerFeasibilityInitialMagnitudeRawCode] using + machineCompose_mem_FP + (machinePair_mem_FP + (machineConst_mem_FP (rawRatBinaryCode rawOptimizerTwo)) hproduct) + machineRawRatAddCode_mem_FP + +theorem machineOptimizerFeasibilityInitialMagnitudeEntryCode_mem_FP : + machineOptimizerFeasibilityInitialMagnitudeEntryCode ∈ FP := by + simpa only [machineOptimizerFeasibilityInitialMagnitudeEntryCode] using + machineCompose_mem_FP + machineOptimizerFeasibilityInitialMagnitudeRawCode_mem_FP + machineNormalizeRawRatEntryCode_mem_FP + +theorem machineOptimizerFeasibilityInitialMagnitudeLengthRuler_mem_FP : + machineOptimizerFeasibilityInitialMagnitudeLengthRuler ∈ FP := by + simpa only [machineOptimizerFeasibilityInitialMagnitudeLengthRuler] using + machineCompose_mem_FP + machineOptimizerFeasibilityInitialMagnitudeEntryCode_mem_FP + machineOptimizerEntryLengthRuler_mem_FP + +theorem machineOptimizerFeasibilityKBits_mem_FP : + machineOptimizerFeasibilityKBits ∈ FP := by + simpa only [machineOptimizerFeasibilityKBits] using + machineCompose_mem_FP + machineOptimizerFeasibilityInitialMagnitudeLengthRuler_mem_FP + machineLengthBits_mem_FP + +theorem machineOptimizerFeasibilityLBits_mem_FP : + machineOptimizerFeasibilityLBits ∈ FP := + machineBinaryMulOf_mem_FP + machineOptimizerFeasibilityOuterLengthBits_mem_FP + machineOptimizerFeasibilityDBits_mem_FP + +theorem machineOptimizerFeasibilityTwoTBits_mem_FP : + machineOptimizerFeasibilityTwoTBits ∈ FP := + machineBinaryMulOf_mem_FP (machineBinaryConst_mem_FP 2) + machineOptimizerFeasibilityBudgetBits_mem_FP + +theorem machineOptimizerFeasibilityFirstBaseBits_mem_FP : + machineOptimizerFeasibilityFirstBaseBits ∈ FP := + machineBinaryAddOf_mem_FP machineOptimizerFeasibilityLBits_mem_FP + machineOptimizerFeasibilityTwoTBits_mem_FP + +theorem machineOptimizerFeasibilityFirstBits_mem_FP : + machineOptimizerFeasibilityFirstBits ∈ FP := + machineBinaryAddOf_mem_FP machineOptimizerFeasibilityFirstBaseBits_mem_FP + (machineBinaryConst_mem_FP 1) + +theorem machineOptimizerFeasibilityThreeDBits_mem_FP : + machineOptimizerFeasibilityThreeDBits ∈ FP := + machineBinaryMulOf_mem_FP (machineBinaryConst_mem_FP 3) + machineOptimizerFeasibilityDBits_mem_FP + +theorem machineOptimizerFeasibilitySixPlusThreeDBits_mem_FP : + machineOptimizerFeasibilitySixPlusThreeDBits ∈ FP := + machineBinaryAddOf_mem_FP (machineBinaryConst_mem_FP 6) + machineOptimizerFeasibilityThreeDBits_mem_FP + +theorem machineOptimizerFeasibilityTTimesGrowthBits_mem_FP : + machineOptimizerFeasibilityTTimesGrowthBits ∈ FP := + machineBinaryMulOf_mem_FP machineOptimizerFeasibilityBudgetBits_mem_FP + machineOptimizerFeasibilitySixPlusThreeDBits_mem_FP + +theorem machineOptimizerFeasibilityKPlusGrowthBits_mem_FP : + machineOptimizerFeasibilityKPlusGrowthBits ∈ FP := + machineBinaryAddOf_mem_FP machineOptimizerFeasibilityKBits_mem_FP + machineOptimizerFeasibilityTTimesGrowthBits_mem_FP + +theorem machineOptimizerFeasibilityKPlusGrowthPlusThreeBits_mem_FP : + machineOptimizerFeasibilityKPlusGrowthPlusThreeBits ∈ FP := + machineBinaryAddOf_mem_FP machineOptimizerFeasibilityKPlusGrowthBits_mem_FP + (machineBinaryConst_mem_FP 3) + +theorem machineOptimizerFeasibilityInnerMagnitudeBits_mem_FP : + machineOptimizerFeasibilityInnerMagnitudeBits ∈ FP := + machineBinaryAddOf_mem_FP + machineOptimizerFeasibilityKPlusGrowthPlusThreeBits_mem_FP + machineOptimizerFeasibilityDBits_mem_FP + +theorem machineOptimizerFeasibilityDInnerMagnitudeBits_mem_FP : + machineOptimizerFeasibilityDInnerMagnitudeBits ∈ FP := + machineBinaryMulOf_mem_FP machineOptimizerFeasibilityDBits_mem_FP + machineOptimizerFeasibilityInnerMagnitudeBits_mem_FP + +theorem machineOptimizerFeasibilityEightDBits_mem_FP : + machineOptimizerFeasibilityEightDBits ∈ FP := + machineBinaryMulOf_mem_FP (machineBinaryConst_mem_FP 8) + machineOptimizerFeasibilityDBits_mem_FP + +theorem machineOptimizerFeasibilityDenomFirstBits_mem_FP : + machineOptimizerFeasibilityDenomFirstBits ∈ FP := + machineBinaryAddOf_mem_FP (machineBinaryConst_mem_FP 12) + machineOptimizerFeasibilityEightDBits_mem_FP + +theorem machineOptimizerFeasibilityDenomSecondBits_mem_FP : + machineOptimizerFeasibilityDenomSecondBits ∈ FP := + machineBinaryAddOf_mem_FP machineOptimizerFeasibilityDenomFirstBits_mem_FP + machineOptimizerFeasibilityDSquareBits_mem_FP + +theorem machineOptimizerFeasibilityDenominatorExponentBits_mem_FP : + machineOptimizerFeasibilityDenominatorExponentBits ∈ FP := + machineBinaryAddOf_mem_FP machineOptimizerFeasibilityDenomSecondBits_mem_FP + machineOptimizerFeasibilityDInnerMagnitudeBits_mem_FP + +theorem machineOptimizerFeasibilityPrecisionBaseBits_mem_FP : + machineOptimizerFeasibilityPrecisionBaseBits ∈ FP := + machineBinaryAddOf_mem_FP machineOptimizerFeasibilityFirstBits_mem_FP + machineOptimizerFeasibilityDenominatorExponentBits_mem_FP + +theorem machineOptimizerFeasibilityRoundingPrecisionBits_mem_FP : + machineOptimizerFeasibilityRoundingPrecisionBits ∈ FP := + machineBinaryAddOf_mem_FP machineOptimizerFeasibilityPrecisionBaseBits_mem_FP + (machineBinaryConst_mem_FP 2) + +theorem machineOptimizerFeasibilityRoundingGuardSource_mem_FP : + machineOptimizerFeasibilityRoundingGuardSource ∈ FP := by + simpa only [machineOptimizerFeasibilityRoundingGuardSource] using + machineAppend_mem_FP machineOptimizerFeasibilityBudgetUnary_mem_FP + (machineAppend_mem_FP + machineOptimizerFeasibilityEllipsoidDimensionUnary_mem_FP + (machineAppend_mem_FP + machineOptimizerFeasibilityInitialMagnitudeLengthRuler_mem_FP + machineOptimizerFeasibilityOuterRadiusLengthRuler_mem_FP)) + +theorem machineOptimizerFeasibilityRoundingGuard_mem_FP : + machineOptimizerFeasibilityRoundingGuard ∈ FP := by + simpa only [machineOptimizerFeasibilityRoundingGuard] using + machineCompose_mem_FP + machineOptimizerFeasibilityRoundingGuardSource_mem_FP + (machineIteratedBinaryWidth_mem_FP 2) + +theorem machineOptimizerFeasibilityRoundingPrecisionUnary_mem_FP : + machineOptimizerFeasibilityRoundingPrecisionUnary ∈ FP := by + simpa only [machineOptimizerFeasibilityRoundingPrecisionUnary] using + machineCompose_mem_FP + (machinePair_mem_FP machineOptimizerFeasibilityRoundingGuard_mem_FP + machineOptimizerFeasibilityRoundingPrecisionBits_mem_FP) + machineBoundedUnary_mem_FP + +/-! ## Exact semantics -/ + +@[simp] theorem machineOptimizerFeasibilityInitialMagnitudeRawCode_encode + {n : ℕ} (hn : 1 ≤ n) (A : Matrix (Fin n) (Fin n) ℚ) + (upper : RawRat) : + machineOptimizerFeasibilityInitialMagnitudeRawCode + (optimizerFeasibilityCallCode A upper) = + rawRatBinaryCode + (rawOptimizerFeasibilityInitialMagnitude ((n - 1) ^ 2 + 1) + (rawOptimizerFeasibilityOuterRadius n + (rationalMatrixEntryBitBound A) upper)) := by + rw [machineOptimizerFeasibilityInitialMagnitudeRawCode, + machineOptimizerFeasibilityEllipsoidDimensionRawCode_encode, + machineOptimizerFeasibilityOuterRadiusRawCode_encode hn, + machineRawRatMulCode_encode, machineRawRatAddCode_encode] + rfl + +@[simp] theorem rawOptimizerFeasibilityInitialMagnitude_value + (d : ℕ) (R : RawRat) : + (rawOptimizerFeasibilityInitialMagnitude d R).value = + explicitBallInitialMagnitudeBound d R.value := by + simp [rawOptimizerFeasibilityInitialMagnitude, + explicitBallInitialMagnitudeBound, rawOptimizerTwo] + +@[simp] theorem machineOptimizerFeasibilityInitialMagnitudeLengthRuler_encode + {n : ℕ} (hn : 1 ≤ n) (A : Matrix (Fin n) (Fin n) ℚ) + (upper : RawRat) : + machineOptimizerFeasibilityInitialMagnitudeLengthRuler + (optimizerFeasibilityCallCode A upper) = + List.replicate + (explicitBallInitialMagnitudeExponent ((n - 1) ^ 2 + 1) + ((rawOptimizerFeasibilityOuterRadius n + (rationalMatrixEntryBitBound A) upper).value)) true := by + rw [machineOptimizerFeasibilityInitialMagnitudeLengthRuler, + machineOptimizerFeasibilityInitialMagnitudeEntryCode, + machineOptimizerFeasibilityInitialMagnitudeRawCode_encode hn, + machineNormalizeRawRatEntryCode_encode, + binaryNormalizeRawRat_eq_value, + machineOptimizerEntryLengthRuler_encode] + rw [rawOptimizerFeasibilityInitialMagnitude_value] + rfl + +def optimizerFeasibilityRoundingPrecision + (d LR K T : ℕ) : ℕ := + (LR * d + 2 * T + 1) + + (12 + 8 * d + d ^ 2 + + d * (K + T * (6 + 3 * d) + 3 + d)) + 2 + +theorem optimizerFeasibilityRoundingPrecision_eq_explicit + (d T : ℕ) (R : ℚ) : + optimizerFeasibilityRoundingPrecision d (encodedBitLength ℚ R) + (explicitBallInitialMagnitudeExponent d R) T = + explicitBallFeasibilityPrecision d T R := by + rw [optimizerFeasibilityRoundingPrecision, + explicitBallFeasibilityPrecision, explicitBallInitialDetExponent, + roundedEllipsoidPrecisionSchedule, + roundedEllipsoidNextPrecisionBound, + roundedEllipsoidDenominatorExponent] + +@[simp] theorem machineOptimizerFeasibilityRoundingPrecisionBits_encode + {n : ℕ} (hn : 1 ≤ n) (A : Matrix (Fin n) (Fin n) ℚ) + (upper : RawRat) : + machineOptimizerFeasibilityRoundingPrecisionBits + (optimizerFeasibilityCallCode A upper) = + (explicitBallFeasibilityPrecision ((n - 1) ^ 2 + 1) + (betheThresholdFeasibilityBudget (n - 1) upper.value + (rawExplicitOptimizerInnerRadius n + (rationalMatrixEntryBitBound A)).value) + (rawOptimizerFeasibilityOuterRadius n + (rationalMatrixEntryBitBound A) upper).value).bits := by + let word := optimizerFeasibilityCallCode A upper + let d := (n - 1) ^ 2 + 1 + let R := (rawOptimizerFeasibilityOuterRadius n + (rationalMatrixEntryBitBound A) upper).value + let LR := encodedBitLength ℚ R + let K := explicitBallInitialMagnitudeExponent d R + let T := 32 * d ^ 3 * rationalBallDyadicExponent d R + (rawExplicitOptimizerInnerRadius n + (rationalMatrixEntryBitBound A)).value + have hd : machineOptimizerFeasibilityDBits word = d.bits := by + simpa only [machineOptimizerFeasibilityDBits, word, d] using + machineOptimizerFeasibilityEllipsoidDimensionBits_encode A upper + have hLR : machineOptimizerFeasibilityOuterLengthBits word = LR.bits := by + have hRuler : machineOptimizerFeasibilityOuterRadiusLengthRuler word = + List.replicate LR true := by + simpa only [word, LR, R] using + machineOptimizerFeasibilityOuterRadiusLengthRuler_encode hn A upper + rw [machineOptimizerFeasibilityOuterLengthBits, hRuler, + machineLengthBits_encode, List.length_replicate] + have hK : machineOptimizerFeasibilityKBits word = K.bits := by + have hRuler : + machineOptimizerFeasibilityInitialMagnitudeLengthRuler word = + List.replicate K true := by + simpa only [word, K, d, R] using + machineOptimizerFeasibilityInitialMagnitudeLengthRuler_encode hn A upper + rw [machineOptimizerFeasibilityKBits, hRuler, + machineLengthBits_encode, List.length_replicate] + have hT : machineOptimizerFeasibilityBudgetBits word = T.bits := by + simpa only [word, T, d, R] using + machineOptimizerFeasibilityBudgetBits_encode hn A upper + have hL : machineOptimizerFeasibilityLBits word = (LR * d).bits := + machineBinaryMulOf_natBits _ _ _ _ _ hLR hd + have h2T : machineOptimizerFeasibilityTwoTBits word = (2 * T).bits := + machineBinaryMulOf_natBits _ _ _ _ _ rfl hT + have hfirstBase : machineOptimizerFeasibilityFirstBaseBits word = + (LR * d + 2 * T).bits := + machineBinaryAddOf_natBits _ _ _ _ _ hL h2T + have hfirst : machineOptimizerFeasibilityFirstBits word = + (LR * d + 2 * T + 1).bits := + machineBinaryAddOf_natBits _ _ _ _ _ hfirstBase rfl + have h3d : machineOptimizerFeasibilityThreeDBits word = (3 * d).bits := + machineBinaryMulOf_natBits _ _ _ _ _ rfl hd + have hgrowth : machineOptimizerFeasibilitySixPlusThreeDBits word = + (6 + 3 * d).bits := + machineBinaryAddOf_natBits _ _ _ _ _ rfl h3d + have hTgrowth : machineOptimizerFeasibilityTTimesGrowthBits word = + (T * (6 + 3 * d)).bits := + machineBinaryMulOf_natBits _ _ _ _ _ hT hgrowth + have hKgrowth : machineOptimizerFeasibilityKPlusGrowthBits word = + (K + T * (6 + 3 * d)).bits := + machineBinaryAddOf_natBits _ _ _ _ _ hK hTgrowth + have hKgrowth3 : + machineOptimizerFeasibilityKPlusGrowthPlusThreeBits word = + (K + T * (6 + 3 * d) + 3).bits := + machineBinaryAddOf_natBits _ _ _ _ _ hKgrowth rfl + have hinner : machineOptimizerFeasibilityInnerMagnitudeBits word = + (K + T * (6 + 3 * d) + 3 + d).bits := + machineBinaryAddOf_natBits _ _ _ _ _ hKgrowth3 hd + have hdinner : machineOptimizerFeasibilityDInnerMagnitudeBits word = + (d * (K + T * (6 + 3 * d) + 3 + d)).bits := + machineBinaryMulOf_natBits _ _ _ _ _ hd hinner + have h8d : machineOptimizerFeasibilityEightDBits word = (8 * d).bits := + machineBinaryMulOf_natBits _ _ _ _ _ rfl hd + have hden1 : machineOptimizerFeasibilityDenomFirstBits word = + (12 + 8 * d).bits := + machineBinaryAddOf_natBits _ _ _ _ _ rfl h8d + have hd2 : machineOptimizerFeasibilityDSquareBits word = (d ^ 2).bits := by + rw [machineOptimizerFeasibilityDSquareBits, hd, + machineBinaryMulBits_pair_natBits] + simp only [pow_two] + have hden2 : machineOptimizerFeasibilityDenomSecondBits word = + (12 + 8 * d + d ^ 2).bits := + machineBinaryAddOf_natBits _ _ _ _ _ hden1 hd2 + have hden : machineOptimizerFeasibilityDenominatorExponentBits word = + (12 + 8 * d + d ^ 2 + + d * (K + T * (6 + 3 * d) + 3 + d)).bits := + machineBinaryAddOf_natBits _ _ _ _ _ hden2 hdinner + have hbase : machineOptimizerFeasibilityPrecisionBaseBits word = + ((LR * d + 2 * T + 1) + + (12 + 8 * d + d ^ 2 + + d * (K + T * (6 + 3 * d) + 3 + d))).bits := + machineBinaryAddOf_natBits _ _ _ _ _ hfirst hden + have hp : machineOptimizerFeasibilityRoundingPrecisionBits word = + (optimizerFeasibilityRoundingPrecision d LR K T).bits := by + rw [machineOptimizerFeasibilityRoundingPrecisionBits] + exact machineBinaryAddOf_natBits _ _ _ _ _ hbase rfl + have hRthreshold : + R = betheEpigraphOuterRadius (n - 1) upper.value + (rawExplicitOptimizerInnerRadius n + (rationalMatrixEntryBitBound A)).value := by + dsimp [R] + rw [rawOptimizerFeasibilityOuterRadius_value, + betheEpigraphOuterRadius] + push_cast + rw [pow_two] + have hTthreshold : + T = betheThresholdFeasibilityBudget (n - 1) upper.value + (rawExplicitOptimizerInnerRadius n + (rationalMatrixEntryBitBound A)).value := by + dsimp [T, d] + rw [betheThresholdFeasibilityBudget, hRthreshold, pow_two] + rw [hp, optimizerFeasibilityRoundingPrecision_eq_explicit, hTthreshold] + +theorem optimizerFeasibilityRoundingPrecision_le_guardPolynomial + (d LR K T : ℕ) : + optimizerFeasibilityRoundingPrecision d LR K T ≤ + certificateExpGuardWidth 2 (T + d + K + LR) := by + let Q := T + d + K + LR + have hd : d ≤ Q := by omega + have hLR : LR ≤ Q := by omega + have hK : K ≤ Q := by omega + have hT : T ≤ Q := by omega + have hLRd : LR * d ≤ Q ^ 2 := by + simpa only [pow_two] using Nat.mul_le_mul hLR hd + have hd2 : d ^ 2 ≤ Q ^ 2 := Nat.pow_le_pow_left hd 2 + have hdK : d * K ≤ Q ^ 2 := by + simpa only [pow_two] using Nat.mul_le_mul hd hK + have hdT : d * T ≤ Q ^ 2 := by + simpa only [pow_two] using Nat.mul_le_mul hd hT + have hd2T : d ^ 2 * T ≤ Q ^ 3 := by + simpa only [pow_two, pow_succ, pow_zero, one_mul] using + Nat.mul_le_mul (Nat.mul_le_mul hd hd) hT + have hcoarse : optimizerFeasibilityRoundingPrecision d LR K T ≤ + 3 * Q ^ 3 + 10 * Q ^ 2 + 13 * Q + 15 := by + rw [optimizerFeasibilityRoundingPrecision] + nlinarith + have hcubic : + 3 * Q ^ 3 + 10 * Q ^ 2 + 13 * Q + 15 ≤ + 8 * (Q + 4) ^ 3 := by nlinarith + have h8 : 8 ≤ Q + 16 := by omega + have hshift : (Q + 4) ^ 3 ≤ (Q + 16) ^ 3 := + Nat.pow_le_pow_left (by omega) 3 + calc + optimizerFeasibilityRoundingPrecision d LR K T ≤ + 3 * Q ^ 3 + 10 * Q ^ 2 + 13 * Q + 15 := hcoarse + _ ≤ 8 * (Q + 4) ^ 3 := hcubic + _ ≤ (Q + 16) * (Q + 16) ^ 3 := Nat.mul_le_mul h8 hshift + _ = (Q + 16) ^ 4 := by ring + _ ≤ certificateExpGuardWidth 2 Q := by + simpa using certificateExpGuardWidth_pow_lower 1 Q + +@[simp] theorem machineOptimizerFeasibilityRoundingGuardSource_length_encode + {n : ℕ} (hn : 2 ≤ n) (A : Matrix (Fin n) (Fin n) ℚ) + (upper : RawRat) : + (machineOptimizerFeasibilityRoundingGuardSource + (optimizerFeasibilityCallCode A upper)).length = + betheThresholdFeasibilityBudget (n - 1) upper.value + (rawExplicitOptimizerInnerRadius n + (rationalMatrixEntryBitBound A)).value + + ((n - 1) ^ 2 + 1) + + explicitBallInitialMagnitudeExponent ((n - 1) ^ 2 + 1) + (rawOptimizerFeasibilityOuterRadius n + (rationalMatrixEntryBitBound A) upper).value + + encodedBitLength ℚ + (rawOptimizerFeasibilityOuterRadius n + (rationalMatrixEntryBitBound A) upper).value := by + have hn1 : 1 ≤ n := by omega + have hRthreshold : + (rawOptimizerFeasibilityOuterRadius n + (rationalMatrixEntryBitBound A) upper).value = + betheEpigraphOuterRadius (n - 1) upper.value + (rawExplicitOptimizerInnerRadius n + (rationalMatrixEntryBitBound A)).value := by + rw [rawOptimizerFeasibilityOuterRadius_value, + betheEpigraphOuterRadius] + push_cast + rw [pow_two] + rw [machineOptimizerFeasibilityRoundingGuardSource, + machineOptimizerFeasibilityBudgetUnary_encode hn, + machineOptimizerFeasibilityEllipsoidDimensionUnary_encode hn, + machineOptimizerFeasibilityInitialMagnitudeLengthRuler_encode hn1, + machineOptimizerFeasibilityOuterRadiusLengthRuler_encode hn1] + simp only [List.length_append, List.length_replicate] + rw [betheThresholdFeasibilityBudget, hRthreshold, pow_two] + omega + +@[simp] theorem machineOptimizerFeasibilityRoundingPrecisionUnary_encode + {n : ℕ} (hn : 2 ≤ n) (A : Matrix (Fin n) (Fin n) ℚ) + (upper : RawRat) : + machineOptimizerFeasibilityRoundingPrecisionUnary + (optimizerFeasibilityCallCode A upper) = + List.replicate + (explicitBallFeasibilityPrecision ((n - 1) ^ 2 + 1) + (betheThresholdFeasibilityBudget (n - 1) upper.value + (rawExplicitOptimizerInnerRadius n + (rationalMatrixEntryBitBound A)).value) + (rawOptimizerFeasibilityOuterRadius n + (rationalMatrixEntryBitBound A) upper).value) true := by + let d := (n - 1) ^ 2 + 1 + let R := (rawOptimizerFeasibilityOuterRadius n + (rationalMatrixEntryBitBound A) upper).value + let LR := encodedBitLength ℚ R + let K := explicitBallInitialMagnitudeExponent d R + let T := betheThresholdFeasibilityBudget (n - 1) upper.value + (rawExplicitOptimizerInnerRadius n + (rationalMatrixEntryBitBound A)).value + rw [machineOptimizerFeasibilityRoundingPrecisionUnary, + machineOptimizerFeasibilityRoundingPrecisionBits_encode (by omega)] + apply machineBoundedUnary_encode_of_le + rw [machineOptimizerFeasibilityRoundingGuard, + machineIteratedBinaryWidth_length, + machineOptimizerFeasibilityRoundingGuardSource_length_encode hn] + rw [← optimizerFeasibilityRoundingPrecision_eq_explicit d T R] + simpa only [d, R, LR, K, T] using + optimizerFeasibilityRoundingPrecision_le_guardPolynomial d LR K T + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerStateBound.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerStateBound.lean new file mode 100644 index 0000000000..4873f91da1 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerStateBound.lean @@ -0,0 +1,490 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineBetheFeasibilityFit +import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerRoundingSchedule + +/-! +# Finite-word state ruler for one optimizer feasibility call + +The feasibility loop truncates every updated ellipsoid to a stored unary +ruler in order to remain polynomial-time on malformed words. This file +computes the proved ordinary-binary state bound from the same finite-word +dimension, budget, magnitude, and precision schedules used by the call. +-/ + +namespace BeyondBethe + +open Complexity + +def machineOptimizerFeasibilityStateDenominatorBits + (word : List Bool) : List Bool := + machineBinaryAddOf machineOptimizerFeasibilityRoundingPrecisionBits + (machineBinaryAddOf (machineBinaryConst 10) + (machineBinaryMulOf (machineBinaryConst 4) + machineOptimizerFeasibilityDBits)) word + +def machineOptimizerFeasibilityStateTwiceMagnitudeBits + (word : List Bool) : List Bool := + machineBinaryMulOf (machineBinaryConst 2) + machineOptimizerFeasibilityKPlusGrowthBits word + +def machineOptimizerFeasibilityStateFourDenominatorBits + (word : List Bool) : List Bool := + machineBinaryMulOf (machineBinaryConst 4) + machineOptimizerFeasibilityStateDenominatorBits word + +def machineOptimizerFeasibilityStateEntryFirstBits + (word : List Bool) : List Bool := + machineBinaryAddOf (machineBinaryConst 8) + machineOptimizerFeasibilityStateTwiceMagnitudeBits word + +def machineOptimizerFeasibilityStateEntryBits + (word : List Bool) : List Bool := + machineBinaryAddOf machineOptimizerFeasibilityStateEntryFirstBits + machineOptimizerFeasibilityStateFourDenominatorBits word + +def machineOptimizerFeasibilityStateTwiceEntryPlusTwoBits + (word : List Bool) : List Bool := + machineBinaryAddOf + (machineBinaryMulOf (machineBinaryConst 2) + machineOptimizerFeasibilityStateEntryBits) + (machineBinaryConst 2) word + +def machineOptimizerFeasibilityStateVectorBits + (word : List Bool) : List Bool := + machineBinaryMulOf machineOptimizerFeasibilityDBits + machineOptimizerFeasibilityStateTwiceEntryPlusTwoBits word + +def machineOptimizerFeasibilityStateTwiceVectorPlusTwoBits + (word : List Bool) : List Bool := + machineBinaryAddOf + (machineBinaryMulOf (machineBinaryConst 2) + machineOptimizerFeasibilityStateVectorBits) + (machineBinaryConst 2) word + +def machineOptimizerFeasibilityStateMatrixBits + (word : List Bool) : List Bool := + machineBinaryMulOf machineOptimizerFeasibilityDBits + machineOptimizerFeasibilityStateTwiceVectorPlusTwoBits word + +def machineOptimizerFeasibilityStateDimensionTermBits + (word : List Bool) : List Bool := + machineBinaryMulOf (machineBinaryConst 2) + (machineBinaryAddOf machineOptimizerFeasibilityDBits + (machineBinaryConst 1)) word + +def machineOptimizerFeasibilityStateInnerFirstBits + (word : List Bool) : List Bool := + machineBinaryAddOf + (machineBinaryMulOf (machineBinaryConst 2) + machineOptimizerFeasibilityStateVectorBits) + (machineBinaryMulOf (machineBinaryConst 2) + machineOptimizerFeasibilityStateMatrixBits) word + +def machineOptimizerFeasibilityStateInnerBits + (word : List Bool) : List Bool := + machineBinaryAddOf machineOptimizerFeasibilityStateInnerFirstBits + (machineBinaryConst 2) word + +def machineOptimizerFeasibilityStateTwiceInnerBits + (word : List Bool) : List Bool := + machineBinaryMulOf (machineBinaryConst 2) + machineOptimizerFeasibilityStateInnerBits word + +def machineOptimizerFeasibilityStateBoundFirstBits + (word : List Bool) : List Bool := + machineBinaryAddOf machineOptimizerFeasibilityStateDimensionTermBits + machineOptimizerFeasibilityStateTwiceInnerBits word + +def machineOptimizerFeasibilityStateBoundBits + (word : List Bool) : List Bool := + machineBinaryAddOf machineOptimizerFeasibilityStateBoundFirstBits + (machineBinaryConst 2) word + +def machineOptimizerFeasibilityStateGuardSource + (word : List Bool) : List Bool := + machineOptimizerFeasibilityEllipsoidDimensionUnary word ++ + (machineOptimizerFeasibilityInitialMagnitudeLengthRuler word ++ + (machineOptimizerFeasibilityBudgetUnary word ++ + machineOptimizerFeasibilityRoundingPrecisionUnary word)) + +def machineOptimizerFeasibilityStateGuard + (word : List Bool) : List Bool := + machineIteratedBinaryWidth 3 + (machineOptimizerFeasibilityStateGuardSource word) + +def machineOptimizerFeasibilityStateBoundUnary + (word : List Bool) : List Bool := + machineBoundedUnary + (pair (machineOptimizerFeasibilityStateGuard word) + (machineOptimizerFeasibilityStateBoundBits word)) + +/-! ## Polynomial-time closure -/ + +theorem machineOptimizerFeasibilityStateDenominatorBits_mem_FP : + machineOptimizerFeasibilityStateDenominatorBits ∈ FP := by + exact machineBinaryAddOf_mem_FP + machineOptimizerFeasibilityRoundingPrecisionBits_mem_FP + (machineBinaryAddOf_mem_FP (machineBinaryConst_mem_FP 10) + (machineBinaryMulOf_mem_FP (machineBinaryConst_mem_FP 4) + machineOptimizerFeasibilityDBits_mem_FP)) + +theorem machineOptimizerFeasibilityStateTwiceMagnitudeBits_mem_FP : + machineOptimizerFeasibilityStateTwiceMagnitudeBits ∈ FP := by + exact machineBinaryMulOf_mem_FP (machineBinaryConst_mem_FP 2) + machineOptimizerFeasibilityKPlusGrowthBits_mem_FP + +theorem machineOptimizerFeasibilityStateFourDenominatorBits_mem_FP : + machineOptimizerFeasibilityStateFourDenominatorBits ∈ FP := by + exact machineBinaryMulOf_mem_FP (machineBinaryConst_mem_FP 4) + machineOptimizerFeasibilityStateDenominatorBits_mem_FP + +theorem machineOptimizerFeasibilityStateEntryFirstBits_mem_FP : + machineOptimizerFeasibilityStateEntryFirstBits ∈ FP := by + exact machineBinaryAddOf_mem_FP (machineBinaryConst_mem_FP 8) + machineOptimizerFeasibilityStateTwiceMagnitudeBits_mem_FP + +theorem machineOptimizerFeasibilityStateEntryBits_mem_FP : + machineOptimizerFeasibilityStateEntryBits ∈ FP := by + exact machineBinaryAddOf_mem_FP + machineOptimizerFeasibilityStateEntryFirstBits_mem_FP + machineOptimizerFeasibilityStateFourDenominatorBits_mem_FP + +theorem machineOptimizerFeasibilityStateTwiceEntryPlusTwoBits_mem_FP : + machineOptimizerFeasibilityStateTwiceEntryPlusTwoBits ∈ FP := by + exact machineBinaryAddOf_mem_FP + (machineBinaryMulOf_mem_FP (machineBinaryConst_mem_FP 2) + machineOptimizerFeasibilityStateEntryBits_mem_FP) + (machineBinaryConst_mem_FP 2) + +theorem machineOptimizerFeasibilityStateVectorBits_mem_FP : + machineOptimizerFeasibilityStateVectorBits ∈ FP := by + exact machineBinaryMulOf_mem_FP machineOptimizerFeasibilityDBits_mem_FP + machineOptimizerFeasibilityStateTwiceEntryPlusTwoBits_mem_FP + +theorem machineOptimizerFeasibilityStateTwiceVectorPlusTwoBits_mem_FP : + machineOptimizerFeasibilityStateTwiceVectorPlusTwoBits ∈ FP := by + exact machineBinaryAddOf_mem_FP + (machineBinaryMulOf_mem_FP (machineBinaryConst_mem_FP 2) + machineOptimizerFeasibilityStateVectorBits_mem_FP) + (machineBinaryConst_mem_FP 2) + +theorem machineOptimizerFeasibilityStateMatrixBits_mem_FP : + machineOptimizerFeasibilityStateMatrixBits ∈ FP := by + exact machineBinaryMulOf_mem_FP machineOptimizerFeasibilityDBits_mem_FP + machineOptimizerFeasibilityStateTwiceVectorPlusTwoBits_mem_FP + +theorem machineOptimizerFeasibilityStateDimensionTermBits_mem_FP : + machineOptimizerFeasibilityStateDimensionTermBits ∈ FP := by + exact machineBinaryMulOf_mem_FP (machineBinaryConst_mem_FP 2) + (machineBinaryAddOf_mem_FP machineOptimizerFeasibilityDBits_mem_FP + (machineBinaryConst_mem_FP 1)) + +theorem machineOptimizerFeasibilityStateInnerFirstBits_mem_FP : + machineOptimizerFeasibilityStateInnerFirstBits ∈ FP := by + exact machineBinaryAddOf_mem_FP + (machineBinaryMulOf_mem_FP (machineBinaryConst_mem_FP 2) + machineOptimizerFeasibilityStateVectorBits_mem_FP) + (machineBinaryMulOf_mem_FP (machineBinaryConst_mem_FP 2) + machineOptimizerFeasibilityStateMatrixBits_mem_FP) + +theorem machineOptimizerFeasibilityStateInnerBits_mem_FP : + machineOptimizerFeasibilityStateInnerBits ∈ FP := by + exact machineBinaryAddOf_mem_FP + machineOptimizerFeasibilityStateInnerFirstBits_mem_FP + (machineBinaryConst_mem_FP 2) + +theorem machineOptimizerFeasibilityStateTwiceInnerBits_mem_FP : + machineOptimizerFeasibilityStateTwiceInnerBits ∈ FP := by + exact machineBinaryMulOf_mem_FP (machineBinaryConst_mem_FP 2) + machineOptimizerFeasibilityStateInnerBits_mem_FP + +theorem machineOptimizerFeasibilityStateBoundFirstBits_mem_FP : + machineOptimizerFeasibilityStateBoundFirstBits ∈ FP := by + exact machineBinaryAddOf_mem_FP + machineOptimizerFeasibilityStateDimensionTermBits_mem_FP + machineOptimizerFeasibilityStateTwiceInnerBits_mem_FP + +theorem machineOptimizerFeasibilityStateBoundBits_mem_FP : + machineOptimizerFeasibilityStateBoundBits ∈ FP := by + exact machineBinaryAddOf_mem_FP + machineOptimizerFeasibilityStateBoundFirstBits_mem_FP + (machineBinaryConst_mem_FP 2) + +theorem machineOptimizerFeasibilityStateGuardSource_mem_FP : + machineOptimizerFeasibilityStateGuardSource ∈ FP := by + exact machineAppend_mem_FP + machineOptimizerFeasibilityEllipsoidDimensionUnary_mem_FP + (machineAppend_mem_FP + machineOptimizerFeasibilityInitialMagnitudeLengthRuler_mem_FP + (machineAppend_mem_FP machineOptimizerFeasibilityBudgetUnary_mem_FP + machineOptimizerFeasibilityRoundingPrecisionUnary_mem_FP)) + +theorem machineOptimizerFeasibilityStateGuard_mem_FP : + machineOptimizerFeasibilityStateGuard ∈ FP := by + simpa only [machineOptimizerFeasibilityStateGuard] using + machineCompose_mem_FP + machineOptimizerFeasibilityStateGuardSource_mem_FP + (machineIteratedBinaryWidth_mem_FP 3) + +theorem machineOptimizerFeasibilityStateBoundUnary_mem_FP : + machineOptimizerFeasibilityStateBoundUnary ∈ FP := by + simpa only [machineOptimizerFeasibilityStateBoundUnary] using + machineCompose_mem_FP + (machinePair_mem_FP machineOptimizerFeasibilityStateGuard_mem_FP + machineOptimizerFeasibilityStateBoundBits_mem_FP) + machineBoundedUnary_mem_FP + +/-! ## Exact semantics -/ + +theorem machineOptimizerFeasibilityStateBoundBits_encode + {n : ℕ} (hn : 1 ≤ n) (A : Matrix (Fin n) (Fin n) ℚ) + (upper : RawRat) : + machineOptimizerFeasibilityStateBoundBits + (optimizerFeasibilityCallCode A upper) = + (explicitBallFeasibilityStateCodeBound + ((n - 1) ^ 2 + 1) + (betheThresholdFeasibilityBudget (n - 1) upper.value + (rawExplicitOptimizerInnerRadius n + (rationalMatrixEntryBitBound A)).value) + (rawOptimizerFeasibilityOuterRadius n + (rationalMatrixEntryBitBound A) upper).value).bits := by + let word := optimizerFeasibilityCallCode A upper + let d := (n - 1) ^ 2 + 1 + let T := betheThresholdFeasibilityBudget (n - 1) upper.value + (rawExplicitOptimizerInnerRadius n + (rationalMatrixEntryBitBound A)).value + let R := (rawOptimizerFeasibilityOuterRadius n + (rationalMatrixEntryBitBound A) upper).value + let K := explicitBallInitialMagnitudeExponent d R + let p := explicitBallFeasibilityPrecision d T R + let KS := K + T * (6 + 3 * d) + let P := p + 10 + 4 * d + let e := rationalEntryMachineCodeBound KS P + let v := rationalVectorMachineCodeBound d KS P + let M := rationalMatrixMachineCodeBound d KS P + have hRthreshold : + (rawOptimizerFeasibilityOuterRadius n + (rationalMatrixEntryBitBound A) upper).value = + betheEpigraphOuterRadius (n - 1) upper.value + (rawExplicitOptimizerInnerRadius n + (rationalMatrixEntryBitBound A)).value := by + rw [rawOptimizerFeasibilityOuterRadius_value, + betheEpigraphOuterRadius] + push_cast + rw [pow_two] + have hd : machineOptimizerFeasibilityDBits word = d.bits := by + simpa only [machineOptimizerFeasibilityDBits, word, d] using + machineOptimizerFeasibilityEllipsoidDimensionBits_encode A upper + have hT : machineOptimizerFeasibilityBudgetBits word = T.bits := by + have h := machineOptimizerFeasibilityBudgetBits_encode hn A upper + rw [hRthreshold] at h + simpa only [word, T, betheThresholdFeasibilityBudget, pow_two] using h + have hK : machineOptimizerFeasibilityKBits word = K.bits := by + have hruler : + machineOptimizerFeasibilityInitialMagnitudeLengthRuler word = + List.replicate K true := by + simpa only [word, K, d, R] using + machineOptimizerFeasibilityInitialMagnitudeLengthRuler_encode hn A upper + rw [machineOptimizerFeasibilityKBits, hruler, + machineLengthBits_encode, List.length_replicate] + have hp : machineOptimizerFeasibilityRoundingPrecisionBits word = p.bits := by + simpa only [word, p, d, T, R] using + machineOptimizerFeasibilityRoundingPrecisionBits_encode hn A upper + have h3d : machineOptimizerFeasibilityThreeDBits word = (3 * d).bits := + machineBinaryMulOf_natBits _ _ _ _ _ rfl hd + have hgrowth : machineOptimizerFeasibilitySixPlusThreeDBits word = + (6 + 3 * d).bits := + machineBinaryAddOf_natBits _ _ _ _ _ rfl h3d + have hTgrowth : machineOptimizerFeasibilityTTimesGrowthBits word = + (T * (6 + 3 * d)).bits := + machineBinaryMulOf_natBits _ _ _ _ _ hT hgrowth + have hKS : machineOptimizerFeasibilityKPlusGrowthBits word = KS.bits := by + simpa only [KS] using + machineBinaryAddOf_natBits _ _ _ _ _ hK hTgrowth + have h4d : machineBinaryMulOf (machineBinaryConst 4) + machineOptimizerFeasibilityDBits word = (4 * d).bits := + machineBinaryMulOf_natBits _ _ _ _ _ rfl hd + have h10plus4d : machineBinaryAddOf (machineBinaryConst 10) + (machineBinaryMulOf (machineBinaryConst 4) + machineOptimizerFeasibilityDBits) word = (10 + 4 * d).bits := + machineBinaryAddOf_natBits _ _ _ _ _ rfl h4d + have hP : machineOptimizerFeasibilityStateDenominatorBits word = P.bits := by + simpa only [machineOptimizerFeasibilityStateDenominatorBits, P, + Nat.add_assoc] using + machineBinaryAddOf_natBits _ _ _ _ _ hp h10plus4d + have h2KS : machineOptimizerFeasibilityStateTwiceMagnitudeBits word = + (2 * KS).bits := + machineBinaryMulOf_natBits _ _ _ _ _ rfl hKS + have h4P : machineOptimizerFeasibilityStateFourDenominatorBits word = + (4 * P).bits := + machineBinaryMulOf_natBits _ _ _ _ _ rfl hP + have h8plus2KS : machineOptimizerFeasibilityStateEntryFirstBits word = + (8 + 2 * KS).bits := + machineBinaryAddOf_natBits _ _ _ _ _ rfl h2KS + have he : machineOptimizerFeasibilityStateEntryBits word = e.bits := by + simpa only [e, rationalEntryMachineCodeBound] using + machineBinaryAddOf_natBits _ _ _ _ _ h8plus2KS h4P + have h2e : machineBinaryMulOf (machineBinaryConst 2) + machineOptimizerFeasibilityStateEntryBits word = (2 * e).bits := + machineBinaryMulOf_natBits _ _ _ _ _ rfl he + have h2e2 : machineOptimizerFeasibilityStateTwiceEntryPlusTwoBits word = + (2 * e + 2).bits := + machineBinaryAddOf_natBits _ _ _ _ _ h2e rfl + have hv : machineOptimizerFeasibilityStateVectorBits word = v.bits := by + simpa only [v, rationalVectorMachineCodeBound] using + machineBinaryMulOf_natBits _ _ _ _ _ hd h2e2 + have h2v : machineBinaryMulOf (machineBinaryConst 2) + machineOptimizerFeasibilityStateVectorBits word = (2 * v).bits := + machineBinaryMulOf_natBits _ _ _ _ _ rfl hv + have h2v2 : machineOptimizerFeasibilityStateTwiceVectorPlusTwoBits word = + (2 * v + 2).bits := + machineBinaryAddOf_natBits _ _ _ _ _ h2v rfl + have hM : machineOptimizerFeasibilityStateMatrixBits word = M.bits := by + simpa only [M, rationalMatrixMachineCodeBound] using + machineBinaryMulOf_natBits _ _ _ _ _ hd h2v2 + have hd1 : machineBinaryAddOf machineOptimizerFeasibilityDBits + (machineBinaryConst 1) word = (d + 1).bits := + machineBinaryAddOf_natBits _ _ _ _ _ hd rfl + have hdim : machineOptimizerFeasibilityStateDimensionTermBits word = + (2 * (d + 1)).bits := + machineBinaryMulOf_natBits _ _ _ _ _ rfl hd1 + have h2v' : machineBinaryMulOf (machineBinaryConst 2) + machineOptimizerFeasibilityStateVectorBits word = (2 * v).bits := h2v + have h2M : machineBinaryMulOf (machineBinaryConst 2) + machineOptimizerFeasibilityStateMatrixBits word = (2 * M).bits := + machineBinaryMulOf_natBits _ _ _ _ _ rfl hM + have hinnerFirst : machineOptimizerFeasibilityStateInnerFirstBits word = + (2 * v + 2 * M).bits := + machineBinaryAddOf_natBits _ _ _ _ _ h2v' h2M + have hinner : machineOptimizerFeasibilityStateInnerBits word = + (2 * v + 2 * M + 2).bits := + machineBinaryAddOf_natBits _ _ _ _ _ hinnerFirst rfl + have htwiceInner : machineOptimizerFeasibilityStateTwiceInnerBits word = + (2 * (2 * v + 2 * M + 2)).bits := + machineBinaryMulOf_natBits _ _ _ _ _ rfl hinner + have hfirst : machineOptimizerFeasibilityStateBoundFirstBits word = + (2 * (d + 1) + 2 * (2 * v + 2 * M + 2)).bits := + machineBinaryAddOf_natBits _ _ _ _ _ hdim htwiceInner + rw [machineOptimizerFeasibilityStateBoundBits] + rw [machineBinaryAddOf_natBits _ _ word _ _ hfirst rfl] + simp only [explicitBallFeasibilityStateCodeBound, + scheduledFeasibilityStateCodeBound, rationalEllipsoidMachineCodeBound, + rationalVectorMachineCodeBound, rationalMatrixMachineCodeBound, + rationalEntryMachineCodeBound, explicitBallFeasibilityPrecision, + d, T, R, K, p, KS, P, e, v, M] + +theorem optimizerFeasibilityStateBound_le_guardPolynomial + (d K T p : ℕ) : + rationalEllipsoidMachineCodeBound d + (K + T * (6 + 3 * d)) (p + 10 + 4 * d) ≤ + certificateExpGuardWidth 3 (d + K + T + p) := by + let Q := d + K + T + p + have hd : d ≤ Q := by omega + have hK : K ≤ Q := by omega + have hT : T ≤ Q := by omega + have hp : p ≤ Q := by omega + have hcoarse : + rationalEllipsoidMachineCodeBound d + (K + T * (6 + 3 * d)) (p + 10 + 4 * d) ≤ + 256 * (Q + 1) ^ 4 + 256 := by + simp only [rationalEllipsoidMachineCodeBound, + rationalMatrixMachineCodeBound, rationalVectorMachineCodeBound, + rationalEntryMachineCodeBound] + nlinarith [Nat.mul_le_mul hd hd, Nat.mul_le_mul hT hd, + Nat.mul_le_mul hK hd, Nat.mul_le_mul hp hd, + Nat.pow_le_pow_left (Nat.le_add_right Q 1) 2, + Nat.pow_le_pow_left (Nat.le_add_right Q 1) 3, + Nat.pow_le_pow_left (Nat.le_add_right Q 1) 4] + have hmain : 256 * (Q + 1) ^ 4 + 256 ≤ (Q + 16) ^ 8 := by + nlinarith [Nat.pow_le_pow_left (by omega : 4 ≤ Q + 16) 4, + Nat.pow_le_pow_left (by omega : Q + 1 ≤ Q + 16) 4] + exact hcoarse.trans <| hmain.trans <| by + simpa only [Q] using certificateExpGuardWidth_pow_lower 2 Q + +@[simp] theorem machineOptimizerFeasibilityStateGuardSource_length_encode + {n : ℕ} (hn : 2 ≤ n) (A : Matrix (Fin n) (Fin n) ℚ) + (upper : RawRat) : + (machineOptimizerFeasibilityStateGuardSource + (optimizerFeasibilityCallCode A upper)).length = + ((n - 1) ^ 2 + 1) + + explicitBallInitialMagnitudeExponent ((n - 1) ^ 2 + 1) + (rawOptimizerFeasibilityOuterRadius n + (rationalMatrixEntryBitBound A) upper).value + + betheThresholdFeasibilityBudget (n - 1) upper.value + (rawExplicitOptimizerInnerRadius n + (rationalMatrixEntryBitBound A)).value + + explicitBallFeasibilityPrecision ((n - 1) ^ 2 + 1) + (betheThresholdFeasibilityBudget (n - 1) upper.value + (rawExplicitOptimizerInnerRadius n + (rationalMatrixEntryBitBound A)).value) + (rawOptimizerFeasibilityOuterRadius n + (rationalMatrixEntryBitBound A) upper).value := by + have hRthreshold : + (rawOptimizerFeasibilityOuterRadius n + (rationalMatrixEntryBitBound A) upper).value = + betheEpigraphOuterRadius (n - 1) upper.value + (rawExplicitOptimizerInnerRadius n + (rationalMatrixEntryBitBound A)).value := by + rw [rawOptimizerFeasibilityOuterRadius_value, + betheEpigraphOuterRadius] + push_cast + rw [pow_two] + have hbudget : + 32 * (((n - 1) ^ 2 + 1) ^ 3) * + rationalBallDyadicExponent ((n - 1) ^ 2 + 1) + (rawOptimizerFeasibilityOuterRadius n + (rationalMatrixEntryBitBound A) upper).value + (rawExplicitOptimizerInnerRadius n + (rationalMatrixEntryBitBound A)).value = + betheThresholdFeasibilityBudget (n - 1) upper.value + (rawExplicitOptimizerInnerRadius n + (rationalMatrixEntryBitBound A)).value := by + rw [betheThresholdFeasibilityBudget, hRthreshold] + simp only [pow_two] + rw [machineOptimizerFeasibilityStateGuardSource, + machineOptimizerFeasibilityEllipsoidDimensionUnary_encode hn, + machineOptimizerFeasibilityInitialMagnitudeLengthRuler_encode (by omega), + machineOptimizerFeasibilityBudgetUnary_encode hn, + machineOptimizerFeasibilityRoundingPrecisionUnary_encode hn] + simp only [List.length_append, List.length_replicate] + rw [hbudget] + omega + +@[simp] theorem machineOptimizerFeasibilityStateBoundUnary_encode + {n : ℕ} (hn : 2 ≤ n) (A : Matrix (Fin n) (Fin n) ℚ) + (upper : RawRat) : + machineOptimizerFeasibilityStateBoundUnary + (optimizerFeasibilityCallCode A upper) = + List.replicate + (explicitBallFeasibilityStateCodeBound ((n - 1) ^ 2 + 1) + (betheThresholdFeasibilityBudget (n - 1) upper.value + (rawExplicitOptimizerInnerRadius n + (rationalMatrixEntryBitBound A)).value) + (rawOptimizerFeasibilityOuterRadius n + (rationalMatrixEntryBitBound A) upper).value) true := by + let d := (n - 1) ^ 2 + 1 + let K := explicitBallInitialMagnitudeExponent d + (rawOptimizerFeasibilityOuterRadius n + (rationalMatrixEntryBitBound A) upper).value + let T := betheThresholdFeasibilityBudget (n - 1) upper.value + (rawExplicitOptimizerInnerRadius n + (rationalMatrixEntryBitBound A)).value + let p := explicitBallFeasibilityPrecision d T + (rawOptimizerFeasibilityOuterRadius n + (rationalMatrixEntryBitBound A) upper).value + rw [machineOptimizerFeasibilityStateBoundUnary, + machineOptimizerFeasibilityStateBoundBits_encode (by omega)] + apply machineBoundedUnary_encode_of_le + rw [machineOptimizerFeasibilityStateGuard, + machineIteratedBinaryWidth_length, + machineOptimizerFeasibilityStateGuardSource_length_encode hn] + simpa only [d, K, T, p, explicitBallFeasibilityStateCodeBound, + scheduledFeasibilityStateCodeBound, explicitBallInitialDetExponent] using + optimizerFeasibilityStateBound_le_guardPolynomial d K T p + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerTests.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerTests.lean new file mode 100644 index 0000000000..a403e8677e --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerTests.lean @@ -0,0 +1,109 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineBetheFloorScan +import LeanPool.BeyondBethe.BeyondBethe.MachineExecutableScannedOptimizerOutput +import LeanPool.BeyondBethe.BeyondBethe.MachineMatchingGain + +/-! +# Exhaustive small tests for the optimizer and certificate boundary + +These tests are deliberately separate from the production dependency graph. +They execute the finite-word programs on small finite families; correctness of +the public theorem itself continues to use the symbolic proofs. +-/ + +namespace BeyondBethe + +open Complexity + +def optimizerTestAffinePoint {N : ℕ} (a : Fin N) : Fin 1 → ℚ := + fun _ ↦ a.val / 4 + +def optimizerTestFloor {N : ℕ} (d : Fin N) : RawRat := + rawRatOfRat (d.val / 4 : ℚ) + +theorem machineBetheFloorViolation_exhaustive_two_by_two_quarters : + ∀ a d : Fin 2, ∀ i j : Fin 2, + machineBetheFloorViolationBit + (machineBetheFloorTestCanonicalWord + (optimizerTestFloor d) i j (optimizerTestAffinePoint a)) = + [decide (betheAffineMatrixQ (optimizerTestAffinePoint a) i j < + (optimizerTestFloor d).value)] := by + native_decide + +theorem machineBetheFloorScan_exhaustive_two_by_two_quarters : + ∀ a d : Fin 3, + machineBetheFloorScanResultCode + (machineBetheFloorScanCanonicalWord (m := 1) + (optimizerTestFloor d) (optimizerTestAffinePoint a)) = + betheFloorScanSemanticResultCode + (finalBetheFloorScanSemanticState (m := 1) + (optimizerTestFloor d) (optimizerTestAffinePoint a)) := by + native_decide + +theorem machineExecutableMatrixEntry_exhaustive_two_by_two_quarters : + ∀ a : Fin 3, ∀ i j : Fin 2, + let y : Fin 1 → ℚ := fun _ ↦ a.val / 4 + machineExecutableMatrixEntryCode + (pair (List.replicate i.1 true) + (pair (List.replicate j.1 true) + (pair [true] (rationalFiniteVectorCode y)))) = + rationalEntryBinaryCode (betheAffineMatrixQ y i j) := by + native_decide + +theorem machineExecutablePotentialEntries_two_by_two_half : + let A : Matrix (Fin 2) (Fin 2) ℚ := fun _ _ ↦ 1 + let y : Fin 1 → ℚ := fun _ ↦ 1 / 2 + ∀ dummy i : Fin 2, + machineExecutableRowPotentialEntryCode + (pair (List.replicate dummy.1 true) + (pair (List.replicate i.1 true) + (machineDirectedObjectiveSumCanonicalWord (1 / 8) A y 1))) = + rationalEntryBinaryCode + (-directedNegativeGradientLowerMatrix (1 / 8) A + (betheAffineMatrixQ y) 1 i 0 + (2 + 1 / 8)) ∧ + machineExecutableColumnPotentialEntryCode + (pair (List.replicate dummy.1 true) + (pair (List.replicate i.1 true) + (machineDirectedObjectiveSumCanonicalWord (1 / 8) A y 1))) = + rationalEntryBinaryCode + (-(directedNegativeGradientLowerMatrix (1 / 8) A + (betheAffineMatrixQ y) 1 0 i - + directedNegativeGradientLowerMatrix (1 / 8) A + (betheAffineMatrixQ y) 1 0 0)) := by + dsimp only + intro dummy i + exact ⟨ + machineExecutableRowPotentialEntryCode_encode + (1 / 8) (fun _ _ ↦ 1) (fun _ ↦ 1 / 2) 1 dummy i, + machineExecutableColumnPotentialEntryCode_encode + (1 / 8) (fun _ _ ↦ 1) (fun _ ↦ 1 / 2) 1 dummy i⟩ + +def optimizerTestEntry (bit : Bool) : ℚ := + if bit then 3 / 4 else 1 / 4 + +theorem machineMatchingGain_exhaustive_two_by_two_binary_entries : + ∀ a b c d : Bool, + let X : Matrix (Fin 2) (Fin 2) ℚ := fun i j ↦ + if i = 0 then + if j = 0 then optimizerTestEntry a else optimizerTestEntry b + else if j = 0 then optimizerTestEntry c else optimizerTestEntry d + let R : Fin 2 → ℚ := fun _ ↦ 0 + let C : Fin 2 → ℚ := fun _ ↦ 0 + machineExplicitMatchingGainRawCode + (pair [] (rationalOptimizerOutputCode ⟨X, R, C⟩)) = + rawRatBinaryCode (rawRatOfRat (explicitCertifiedMatchingGain X)) := by + intro a b c d + dsimp only + exact machineExplicitMatchingGainRawCode_encode [] + (fun i j ↦ + if i = 0 then + if j = 0 then optimizerTestEntry a else optimizerTestEntry b + else if j = 0 then optimizerTestEntry c else optimizerTestEntry d) + (fun _ ↦ 0) (fun _ ↦ 0) + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineOutputEncoding.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineOutputEncoding.lean new file mode 100644 index 0000000000..dc4d19483a --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineOutputEncoding.lean @@ -0,0 +1,208 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineBinaryCompare +import LeanPool.BeyondBethe.BeyondBethe.MachineBinaryMul + +/-! +# Polynomial-time canonical output encodings + +The public rational output is the canonical bit expansion of a natural pairing +of the signed numerator code and positive denominator. This file realizes +that pairing formula from the verified arithmetic primitives, and then proves +the complete rational encoder correct. +-/ + +namespace BeyondBethe + +open Complexity + +def machineNatPairLeftSquare (word : List Bool) : List Bool := + machineBinaryMulBits + (pair (machinePairFirst word) (machinePairFirst word)) + +def machineNatPairRightSquare (word : List Bool) : List Bool := + machineBinaryMulBits + (pair (machinePairSecond word) (machinePairSecond word)) + +def machineNatPairLeftBranch (word : List Bool) : List Bool := + machineBinaryAddBits + (pair (machineNatPairRightSquare word) (machinePairFirst word)) + +def machineNatPairRightBranchFirst (word : List Bool) : List Bool := + machineBinaryAddBits + (pair (machineNatPairLeftSquare word) (machinePairFirst word)) + +def machineNatPairRightBranch (word : List Bool) : List Bool := + machineBinaryAddBits + (pair (machineNatPairRightBranchFirst word) (machinePairSecond word)) + +/-- Canonical bits of Mathlib's monotone natural pairing function. -/ +def machineNatPairBits (word : List Bool) : List Bool := + machineIfHead (machineBinaryNatLtBit word) + (machineNatPairLeftBranch word) (machineNatPairRightBranch word) + +theorem machineNatPairLeftSquare_mem_FP : + machineNatPairLeftSquare ∈ Complexity.FP := by + have hpair : (fun word => pair (machinePairFirst word) + (machinePairFirst word)) ∈ Complexity.FP := + machinePair_mem_FP machinePairFirst_mem_FP machinePairFirst_mem_FP + simpa only [machineNatPairLeftSquare] using + machineCompose_mem_FP hpair machineBinaryMulBits_mem_FP + +theorem machineNatPairRightSquare_mem_FP : + machineNatPairRightSquare ∈ Complexity.FP := by + have hpair : (fun word => pair (machinePairSecond word) + (machinePairSecond word)) ∈ Complexity.FP := + machinePair_mem_FP machinePairSecond_mem_FP machinePairSecond_mem_FP + simpa only [machineNatPairRightSquare] using + machineCompose_mem_FP hpair machineBinaryMulBits_mem_FP + +theorem machineNatPairLeftBranch_mem_FP : + machineNatPairLeftBranch ∈ Complexity.FP := by + have hpair : (fun word => pair (machineNatPairRightSquare word) + (machinePairFirst word)) ∈ Complexity.FP := + machinePair_mem_FP machineNatPairRightSquare_mem_FP + machinePairFirst_mem_FP + simpa only [machineNatPairLeftBranch] using + machineCompose_mem_FP hpair machineBinaryAddBits_mem_FP + +theorem machineNatPairRightBranchFirst_mem_FP : + machineNatPairRightBranchFirst ∈ Complexity.FP := by + have hpair : (fun word => pair (machineNatPairLeftSquare word) + (machinePairFirst word)) ∈ Complexity.FP := + machinePair_mem_FP machineNatPairLeftSquare_mem_FP + machinePairFirst_mem_FP + simpa only [machineNatPairRightBranchFirst] using + machineCompose_mem_FP hpair machineBinaryAddBits_mem_FP + +theorem machineNatPairRightBranch_mem_FP : + machineNatPairRightBranch ∈ Complexity.FP := by + have hpair : (fun word => pair (machineNatPairRightBranchFirst word) + (machinePairSecond word)) ∈ Complexity.FP := + machinePair_mem_FP machineNatPairRightBranchFirst_mem_FP + machinePairSecond_mem_FP + simpa only [machineNatPairRightBranch] using + machineCompose_mem_FP hpair machineBinaryAddBits_mem_FP + +theorem machineNatPairBits_mem_FP : + machineNatPairBits ∈ Complexity.FP := by + simpa only [machineNatPairBits] using + machineIfHead_mem_FP machineBinaryNatLtBit_mem_FP + machineNatPairLeftBranch_mem_FP machineNatPairRightBranch_mem_FP + +theorem machineNatPairBits_pair_natBits (a b : ℕ) : + machineNatPairBits (pair a.bits b.bits) = (Nat.pair a b).bits := by + simp only [machineNatPairBits, machineBinaryNatLtBit_pair_natBits] + by_cases h : a < b + · simp only [h, decide_true, machineIfHead_true, + machineNatPairLeftBranch, machineNatPairRightSquare, + machinePairFirst_pair, machinePairSecond_pair, + machineBinaryMulBits_pair_natBits, + machineBinaryAddBits_pair_natBits] + simp [Nat.pair, h] + · simp only [h, decide_false, machineIfHead_false, + machineNatPairRightBranch, machineNatPairRightBranchFirst, + machineNatPairLeftSquare, machinePairFirst_pair, + machinePairSecond_pair, machineBinaryMulBits_pair_natBits, + machineBinaryAddBits_pair_natBits] + simp [Nat.pair, h, Nat.add_assoc] + +def machineIntegerMagnitudeWord (word : List Bool) : List Bool := word.tail + +def machineIntegerEvenCodeBits (word : List Bool) : List Bool := + machineBinaryAddBits + (pair (machineIntegerMagnitudeWord word) + (machineIntegerMagnitudeWord word)) + +def machineIntegerOddCodeBits (word : List Bool) : List Bool := + machineBinaryAddBits (pair (machineIntegerEvenCodeBits word) [true]) + +/-- Convert the sign-and-magnitude `integerBinaryCode` to the natural code +used by the public rational output. -/ +def machineIntegerNatCodeBits (word : List Bool) : List Bool := + machineIfHead word (machineIntegerOddCodeBits word) + (machineIntegerEvenCodeBits word) + +theorem machineIntegerMagnitudeWord_mem_FP : + machineIntegerMagnitudeWord ∈ Complexity.FP := by + simpa only [machineIntegerMagnitudeWord] using machineTail_mem_FP + +theorem machineIntegerEvenCodeBits_mem_FP : + machineIntegerEvenCodeBits ∈ Complexity.FP := by + have hpair : (fun word => pair (machineIntegerMagnitudeWord word) + (machineIntegerMagnitudeWord word)) ∈ Complexity.FP := + machinePair_mem_FP machineIntegerMagnitudeWord_mem_FP + machineIntegerMagnitudeWord_mem_FP + simpa only [machineIntegerEvenCodeBits] using + machineCompose_mem_FP hpair machineBinaryAddBits_mem_FP + +theorem machineIntegerOddCodeBits_mem_FP : + machineIntegerOddCodeBits ∈ Complexity.FP := by + have hpair : (fun word => pair (machineIntegerEvenCodeBits word) [true]) ∈ + Complexity.FP := + machinePair_mem_FP machineIntegerEvenCodeBits_mem_FP + (machineConst_mem_FP [true]) + simpa only [machineIntegerOddCodeBits] using + machineCompose_mem_FP hpair machineBinaryAddBits_mem_FP + +theorem machineIntegerNatCodeBits_mem_FP : + machineIntegerNatCodeBits ∈ Complexity.FP := by + simpa only [machineIntegerNatCodeBits] using + machineIfHead_mem_FP id_mem_FP machineIntegerOddCodeBits_mem_FP + machineIntegerEvenCodeBits_mem_FP + +theorem machineIntegerNatCodeBits_encode (z : ℤ) : + machineIntegerNatCodeBits (integerBinaryCode z) = + (integerNatCode z).bits := by + cases z with + | ofNat n => + simp [machineIntegerNatCodeBits, integerBinaryCode, + machineIntegerEvenCodeBits, machineIntegerMagnitudeWord, + integerNatCode, machineBinaryAddBits_pair_natBits, + two_mul] + | negSucc n => + simp [machineIntegerNatCodeBits, integerBinaryCode, + machineIntegerOddCodeBits, machineIntegerEvenCodeBits, + machineIntegerMagnitudeWord, integerNatCode, + machineBinaryAddBits_pair_natBits, two_mul] + rw [show ([true] : List Bool) = (1 : ℕ).bits by rfl, + machineBinaryAddBits_pair_natBits] + +/-- Complete public rational output encoder, from the entry representation +used inside the matrix input to canonical `rationalBinaryCode`. -/ +def machineRationalBinaryCode (word : List Bool) : List Bool := + machineNatPairBits + (pair + (machineIntegerNatCodeBits + (machineRationalEntryNumeratorWord word)) + (machineRationalEntryDenominatorWord word)) + +theorem machineRationalBinaryCode_mem_FP : + machineRationalBinaryCode ∈ Complexity.FP := by + have hnum : (fun word => machineIntegerNatCodeBits + (machineRationalEntryNumeratorWord word)) ∈ Complexity.FP := + machineCompose_mem_FP machineRationalEntryNumeratorWord_mem_FP + machineIntegerNatCodeBits_mem_FP + have hpair : (fun word => pair + (machineIntegerNatCodeBits + (machineRationalEntryNumeratorWord word)) + (machineRationalEntryDenominatorWord word)) ∈ Complexity.FP := + machinePair_mem_FP hnum machineRationalEntryDenominatorWord_mem_FP + simpa only [machineRationalBinaryCode] using + machineCompose_mem_FP hpair machineNatPairBits_mem_FP + +theorem machineRationalBinaryCode_encode (q : ℚ) : + machineRationalBinaryCode (rationalEntryBinaryCode q) = + rationalBinaryCode q := by + simp only [machineRationalBinaryCode, + machineRationalEntryNumeratorWord_encode, + machineRationalEntryDenominatorWord_encode, + machineIntegerNatCodeBits_encode, + machineNatPairBits_pair_natBits] + rfl + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachinePerfectMatching.lean b/LeanPool/BeyondBethe/BeyondBethe/MachinePerfectMatching.lean new file mode 100644 index 0000000000..f62d4a5459 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachinePerfectMatching.lean @@ -0,0 +1,181 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineMateAllSome +import Mathlib.Tactic + +/-! +# A finite-word perfect-matching decision procedure + +This module composes the complete Kuhn runner with the exact mate-table scan. +The result is an actual polynomial-time function on bitstrings. On the +canonical encoding of a square rational matrix it returns `[true]` exactly +when the positive support contains a perfect matching. +-/ + +namespace BeyondBethe + +open Complexity + +/-! ## The finite-word program -/ + +def machineKuhnFinalMate (matrix : List Bool) : List Bool := + machineKuhnDoneMate (machineKuhnControl (machineKuhnFinalState matrix)) + +def machineKuhnPerfectMatchingInput (matrix : List Bool) : List Bool := + pair (machineKuhnInitDimension matrix) (machineKuhnFinalMate matrix) + +def machineKuhnPerfectMatchingBit (matrix : List Bool) : List Bool := + machineMateAllSomeBit (machineKuhnPerfectMatchingInput matrix) + +theorem machineKuhnFinalMate_mem_FP : + machineKuhnFinalMate ∈ Complexity.FP := by + have hcontrol := machineCompose_mem_FP machineKuhnFinalState_mem_FP + machineKuhnControl_mem_FP + simpa only [machineKuhnFinalMate] using + machineCompose_mem_FP hcontrol machineKuhnDoneMate_mem_FP + +theorem machineKuhnPerfectMatchingInput_mem_FP : + machineKuhnPerfectMatchingInput ∈ Complexity.FP := by + exact machinePair_mem_FP machineKuhnInitDimension_mem_FP + machineKuhnFinalMate_mem_FP + +theorem machineKuhnPerfectMatchingBit_mem_FP : + machineKuhnPerfectMatchingBit ∈ Complexity.FP := by + simpa only [machineKuhnPerfectMatchingBit] using + machineCompose_mem_FP machineKuhnPerfectMatchingInput_mem_FP + machineMateAllSomeBit_mem_FP + +/-! ## The column-totality criterion -/ + +def AllColumnsMatched {n : ℕ} (mate : ColumnMate n) : Prop := + ∀ col, ∃ row, mate col = some row + +theorem hasPerfectMatching_of_all_columns_matched {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) (mate : ColumnMate n) + (hsupport : IsSupportColumnMate A mate) + (hallColumns : AllColumnsMatched mate) : + Matrix.HasPerfectMatching A := by + classical + let rowOfColumn : Fin n → Fin n := + fun col ↦ Classical.choose (hallColumns col) + have rowOfColumn_spec (col : Fin n) : + mate col = some (rowOfColumn col) := + Classical.choose_spec (hallColumns col) + have rowOfColumn_injective : Function.Injective rowOfColumn := by + intro col col' hrows + apply hsupport.injective (rowOfColumn_spec col) + simpa only [hrows] using rowOfColumn_spec col' + have rowOfColumn_bijective : Function.Bijective rowOfColumn := + (Fintype.bijective_iff_injective_and_card rowOfColumn).2 + ⟨rowOfColumn_injective, rfl⟩ + let matching : Fin n ≃ Fin n := + Equiv.ofBijective rowOfColumn rowOfColumn_bijective + refine ⟨matching, ?_⟩ + intro col + exact hsupport.support (rowOfColumn_spec col) + +theorem all_columns_matched_of_all_rows_matched {n : ℕ} + (mate : ColumnMate n) + (hallRows : ∀ row, MatchesRow mate row) : + AllColumnsMatched mate := by + classical + let colOfRow : Fin n → Fin n := + fun row ↦ Classical.choose (hallRows row) + have colOfRow_spec (row : Fin n) : mate (colOfRow row) = some row := + Classical.choose_spec (hallRows row) + have colOfRow_injective : Function.Injective colOfRow := by + intro row row' hcols + have hrow := colOfRow_spec row + have hrow' := colOfRow_spec row' + rw [hcols, hrow'] at hrow + exact Option.some.inj hrow.symm + have colOfRow_surjective : Function.Surjective colOfRow := + ((Fintype.bijective_iff_injective_and_card colOfRow).2 + ⟨colOfRow_injective, rfl⟩).2 + intro col + obtain ⟨row, hrow⟩ := colOfRow_surjective col + refine ⟨row, ?_⟩ + simpa only [hrow] using colOfRow_spec row + +theorem columnMateList_all_isSome_eq_true_iff {n : ℕ} + (mate : ColumnMate n) : + (columnMateList mate).all Option.isSome = true ↔ + AllColumnsMatched mate := by + constructor + · intro hall col + have hi : col.1 < (columnMateList mate).length := by simp + have hvalue := (List.all_eq_true.mp hall) + (columnMateList mate)[col.1] (List.getElem_mem hi) + rw [columnMateList_getElem] at hvalue + cases hmate : mate col with + | none => simp [hmate] at hvalue + | some row => exact ⟨row, rfl⟩ + · intro hall + apply List.all_eq_true.mpr + intro value hvalue + obtain ⟨i, hi, rfl⟩ := List.mem_iff_getElem.mp hvalue + have hin : i < n := by simpa using hi + obtain ⟨row, hrow⟩ := hall ⟨i, hin⟩ + rw [columnMateList_getElem, hrow] + rfl + +theorem kuhnColumnMate_all_isSome_eq_true_iff {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) : + (columnMateList (kuhnColumnMate A)).all Option.isSome = true ↔ + Matrix.HasPerfectMatching A := by + rw [columnMateList_all_isSome_eq_true_iff] + constructor + · exact hasPerfectMatching_of_all_columns_matched A (kuhnColumnMate A) + (kuhnColumnMate_support A) + · intro hperfect + exact all_columns_matched_of_all_rows_matched (kuhnColumnMate A) + (kuhnColumnMate_all_rows_of_hasPerfectMatching A hperfect) + +/-! ## Exact machine semantics -/ + +@[simp] theorem machineKuhnFinalMate_encode {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) : + machineKuhnFinalMate (rationalMatrixBinaryEncoding.encode ⟨n, A⟩) = + mateVectorCode (columnMateList (kuhnColumnMate A)) := by + simp [machineKuhnFinalMate, kuhnControlCode] + +@[simp] theorem machineKuhnPerfectMatchingInput_encode {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) : + machineKuhnPerfectMatchingInput + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩) = + pair (List.replicate n true) + (mateVectorCode (columnMateList (kuhnColumnMate A))) := by + simp [machineKuhnPerfectMatchingInput] + +@[simp] theorem machineKuhnPerfectMatchingBit_encode {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) : + machineKuhnPerfectMatchingBit + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩) = + [(columnMateList (kuhnColumnMate A)).all Option.isSome] := by + rw [machineKuhnPerfectMatchingBit, + machineKuhnPerfectMatchingInput_encode] + simpa only [columnMateList_length] using + machineMateAllSomeBit_encode (columnMateList (kuhnColumnMate A)) + +theorem machineKuhnPerfectMatchingBit_eq_true_iff {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) : + machineKuhnPerfectMatchingBit + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩) = [true] ↔ + Matrix.HasPerfectMatching A := by + rw [machineKuhnPerfectMatchingBit_encode, List.cons.injEq, + and_iff_left rfl, kuhnColumnMate_all_isSome_eq_true_iff] + +theorem machineKuhnPerfectMatchingBit_eq_false_iff {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) : + machineKuhnPerfectMatchingBit + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩) = [false] ↔ + ¬Matrix.HasPerfectMatching A := by + rw [machineKuhnPerfectMatchingBit_encode, List.cons.injEq, + and_iff_left rfl, ← kuhnColumnMate_all_isSome_eq_true_iff] + exact Bool.eq_false_iff + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachinePositiveAlgorithm.lean b/LeanPool/BeyondBethe/BeyondBethe/MachinePositiveAlgorithm.lean new file mode 100644 index 0000000000..caf375e219 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachinePositiveAlgorithm.lean @@ -0,0 +1,305 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineCompletedAlgorithm +import LeanPool.BeyondBethe.BeyondBethe.ExplicitPositiveRoutine + +/-! +# Finite-word wrapper for the positive-matrix routine + +This module removes normalization, scale restoration, and the exact small +dimensions from the remaining positive-routine boundary. The only parameter +is a raw-output machine for the normalized optimizer-plus-certificate value. +-/ + +namespace BeyondBethe + +open Complexity + +def explicitNormalizedCertificateAlgorithm : + ∀ n, Matrix (Fin n) (Fin n) ℚ → ℚ + | 0, _ => 0 + | 1, _ => 0 + | m + 2, B => + explicitDirectedCertificateValue + (explicitBetheOptimizerMatrix (m := m + 1) B) + (explicitBetheOptimizerRowPotential (m := m + 1) B) + (explicitBetheOptimizerColumnPotential (m := m + 1) B) + +/-- Conditional realization of the normalized optimizer-certificate value on +the positive, entrywise-at-most-one matrices supplied by normalization. -/ +def NormalizedCertificateStringRealizesOnPositive + (F : List Bool → List Bool) : Prop := + ∀ (m : ℕ) (B : Matrix (Fin (m + 2)) (Fin (m + 2)) ℚ), + (∀ i j, 0 < B i j) → (∀ i j, B i j ≤ 1) → + F (rationalMatrixBinaryEncoding.encode ⟨m + 2, B⟩) = + rawRatBinaryCode + (rawRatOfRat (explicitNormalizedCertificateAlgorithm (m + 2) B)) + +def machinePositiveSmallRawCode (word : List Bool) : List Bool := + machineIfHead (machineMatrixDimensionZeroBit word) + (rawRatBinaryCode RawRat.one) + (machineMatrixFirstEntryCode word) + +def machinePositiveNormalizedMatrixCode (word : List Bool) : List Bool := + machineMatrixNormalizeEntries word + +def machinePositiveCertificateRawCode + (certificateMachine : List Bool → List Bool) + (word : List Bool) : List Bool := + certificateMachine (machinePositiveNormalizedMatrixCode word) + +def machinePositiveLargeProductRawCode + (certificateMachine : List Bool → List Bool) + (word : List Bool) : List Bool := + machineRawRatMulCode + (pair (machineMatrixNormalizationScalePowerRawCode word) + (machinePositiveCertificateRawCode certificateMachine word)) + +def machinePositiveLargeRawCode + (certificateMachine : List Bool → List Bool) + (word : List Bool) : List Bool := + machineNormalizeRawRatEntryCode + (machinePositiveLargeProductRawCode certificateMachine word) + +def machinePositiveAlgorithmRawCode + (certificateMachine : List Bool → List Bool) + (word : List Bool) : List Bool := + machineIfHead (machineCompletedDimensionLtTwoBit word) + (machinePositiveSmallRawCode word) + (machinePositiveLargeRawCode certificateMachine word) + +theorem machinePositiveSmallRawCode_mem_FP : + machinePositiveSmallRawCode ∈ Complexity.FP := by + exact machineIfHead_mem_FP machineMatrixDimensionZeroBit_mem_FP + (machineConst_mem_FP (rawRatBinaryCode RawRat.one)) + machineMatrixFirstEntryCode_mem_FP + +theorem machinePositiveNormalizedMatrixCode_mem_FP : + machinePositiveNormalizedMatrixCode ∈ Complexity.FP := + machineMatrixNormalizeEntries_mem_FP + +theorem machinePositiveCertificateRawCode_mem_FP + {certificateMachine : List Bool → List Bool} + (hcertificate : certificateMachine ∈ Complexity.FP) : + machinePositiveCertificateRawCode certificateMachine ∈ Complexity.FP := by + simpa only [machinePositiveCertificateRawCode] using + machineCompose_mem_FP machinePositiveNormalizedMatrixCode_mem_FP + hcertificate + +theorem machinePositiveLargeProductRawCode_mem_FP + {certificateMachine : List Bool → List Bool} + (hcertificate : certificateMachine ∈ Complexity.FP) : + machinePositiveLargeProductRawCode certificateMachine ∈ Complexity.FP := by + have hpair := machinePair_mem_FP + machineMatrixNormalizationScalePowerRawCode_mem_FP + (machinePositiveCertificateRawCode_mem_FP hcertificate) + simpa only [machinePositiveLargeProductRawCode] using + machineCompose_mem_FP hpair machineRawRatMulCode_mem_FP + +theorem machinePositiveLargeRawCode_mem_FP + {certificateMachine : List Bool → List Bool} + (hcertificate : certificateMachine ∈ Complexity.FP) : + machinePositiveLargeRawCode certificateMachine ∈ Complexity.FP := by + simpa only [machinePositiveLargeRawCode] using + machineCompose_mem_FP + (machinePositiveLargeProductRawCode_mem_FP hcertificate) + machineNormalizeRawRatEntryCode_mem_FP + +theorem machinePositiveAlgorithmRawCode_mem_FP + {certificateMachine : List Bool → List Bool} + (hcertificate : certificateMachine ∈ Complexity.FP) : + machinePositiveAlgorithmRawCode certificateMachine ∈ Complexity.FP := by + exact machineIfHead_mem_FP machineCompletedDimensionLtTwoBit_mem_FP + machinePositiveSmallRawCode_mem_FP + (machinePositiveLargeRawCode_mem_FP hcertificate) + +@[simp] theorem machinePositiveSmallRawCode_zero + (A : Matrix (Fin 0) (Fin 0) ℚ) : + machinePositiveSmallRawCode + (rationalMatrixBinaryEncoding.encode ⟨0, A⟩) = + rawRatBinaryCode (rawRatOfRat (Matrix.permanent A)) := by + simp [machinePositiveSmallRawCode, Matrix.permanent, + rawRatBinaryCode, rawRatOfRat, integerBinaryCode, RawRat.one] + +@[simp] theorem machinePositiveSmallRawCode_one + (A : Matrix (Fin 1) (Fin 1) ℚ) : + machinePositiveSmallRawCode + (rationalMatrixBinaryEncoding.encode ⟨1, A⟩) = + rawRatBinaryCode (rawRatOfRat (Matrix.permanent A)) := by + simp [machinePositiveSmallRawCode, Matrix.permanent_fin_one, + rawRatBinaryCode_rawRatOfRat] + +theorem machinePositiveSmallRawCode_encode {n : ℕ} + (hn : n < 2) (A : Matrix (Fin n) (Fin n) ℚ) : + machinePositiveSmallRawCode + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩) = + rawRatBinaryCode (rawRatOfRat (Matrix.permanent A)) := by + interval_cases n + · exact machinePositiveSmallRawCode_zero A + · exact machinePositiveSmallRawCode_one A + +theorem machinePositiveLargeRawCode_encode + {certificateMachine : List Bool → List Bool} + (hrealizes : RawStringRealizes certificateMachine + explicitNormalizedCertificateAlgorithm) + (m : ℕ) (A : Matrix (Fin (m + 2)) (Fin (m + 2)) ℚ) : + machinePositiveLargeRawCode certificateMachine + (rationalMatrixBinaryEncoding.encode ⟨m + 2, A⟩) = + rawRatBinaryCode + (rawRatOfRat (explicitPositiveAlgorithm (m + 2) A)) := by + have hcertificate := hrealizes + ⟨m + 2, normalizedRationalMatrix A⟩ + change certificateMachine + (rationalMatrixBinaryEncoding.encode + ⟨m + 2, normalizedRationalMatrix A⟩) = + rawRatBinaryCode + (rawRatOfRat + (explicitDirectedCertificateValue + (explicitBetheOptimizerMatrix (m := m + 1) + (normalizedRationalMatrix A)) + (explicitBetheOptimizerRowPotential (m := m + 1) + (normalizedRationalMatrix A)) + (explicitBetheOptimizerColumnPotential (m := m + 1) + (normalizedRationalMatrix A)))) at hcertificate + simp only [machinePositiveLargeRawCode, + machinePositiveLargeProductRawCode, + machinePositiveCertificateRawCode, + machinePositiveNormalizedMatrixCode, + machineMatrixNormalizeEntries_encode, + hcertificate, + machineMatrixNormalizationScalePowerRawCode_encode, + machineRawRatMulCode_encode, + machineNormalizeRawRatEntryCode_encode, + ← rawRatBinaryCode_rawRatOfRat] + apply congrArg rawRatBinaryCode + apply congrArg rawRatOfRat + rw [binaryNormalizeRawRat_eq_value, RawRat.value_mul, + RawRat.value_pow, RawRat.value_add, RawRat.value_one, + rawRatRowsSum_value, RawRat.value_zero, zero_add, + rationalMatrixRows_sum, rawRatOfRat_value] + rfl + +theorem machinePositiveLargeRawCode_encode_onPositive + {certificateMachine : List Bool → List Bool} + (hrealizes : + NormalizedCertificateStringRealizesOnPositive certificateMachine) + (m : ℕ) (A : Matrix (Fin (m + 2)) (Fin (m + 2)) ℚ) + (hA : Matrix.Positive (fun i j ↦ (A i j : ℝ))) : + machinePositiveLargeRawCode certificateMachine + (rationalMatrixBinaryEncoding.encode ⟨m + 2, A⟩) = + rawRatBinaryCode + (rawRatOfRat (explicitPositiveAlgorithm (m + 2) A)) := by + have hAq : ∀ i j, 0 < A i j := fun i j ↦ Rat.cast_pos.mp (hA i j) + have hA0 : Matrix.Nonnegative A := fun i j ↦ (hAq i j).le + have hBpos : ∀ i j, 0 < normalizedRationalMatrix A i j := by + intro i j + rw [normalizedRationalMatrix] + exact div_pos (hAq i j) (rationalNormalizationScale_pos hA0) + have hBupper : ∀ i j, normalizedRationalMatrix A i j ≤ 1 := + normalizedRationalMatrix_le_one hA0 + have hcertificate := hrealizes m (normalizedRationalMatrix A) + hBpos hBupper + change certificateMachine + (rationalMatrixBinaryEncoding.encode + ⟨m + 2, normalizedRationalMatrix A⟩) = + rawRatBinaryCode + (rawRatOfRat + (explicitDirectedCertificateValue + (explicitBetheOptimizerMatrix (m := m + 1) + (normalizedRationalMatrix A)) + (explicitBetheOptimizerRowPotential (m := m + 1) + (normalizedRationalMatrix A)) + (explicitBetheOptimizerColumnPotential (m := m + 1) + (normalizedRationalMatrix A)))) at hcertificate + simp only [machinePositiveLargeRawCode, + machinePositiveLargeProductRawCode, + machinePositiveCertificateRawCode, + machinePositiveNormalizedMatrixCode, + machineMatrixNormalizeEntries_encode, + hcertificate, + machineMatrixNormalizationScalePowerRawCode_encode, + machineRawRatMulCode_encode, + machineNormalizeRawRatEntryCode_encode, + ← rawRatBinaryCode_rawRatOfRat] + apply congrArg rawRatBinaryCode + apply congrArg rawRatOfRat + rw [binaryNormalizeRawRat_eq_value, RawRat.value_mul, + RawRat.value_pow, RawRat.value_add, RawRat.value_one, + rawRatRowsSum_value, RawRat.value_zero, zero_add, + rationalMatrixRows_sum, rawRatOfRat_value] + rfl + +theorem machinePositiveAlgorithmRawCode_realizes + {certificateMachine : List Bool → List Bool} + (hrealizes : RawStringRealizes certificateMachine + explicitNormalizedCertificateAlgorithm) : + RawStringRealizes + (machinePositiveAlgorithmRawCode certificateMachine) + explicitPositiveAlgorithm := by + intro x + obtain ⟨n, A⟩ := x + rw [machinePositiveAlgorithmRawCode, + machineCompletedDimensionLtTwoBit_encode] + by_cases hsmall : n < 2 + · rw [show [decide (n < 2)] = [true] by simp [hsmall], + machineIfHead_true, + machinePositiveSmallRawCode_encode hsmall] + interval_cases n <;> rfl + · rw [show [decide (n < 2)] = [false] by simp [hsmall], + machineIfHead_false] + obtain ⟨m, rfl⟩ : ∃ m, n = m + 2 := by + use n - 2 + omega + exact machinePositiveLargeRawCode_encode hrealizes m A + +theorem machinePositiveAlgorithmRawCode_realizes_onPositive + {certificateMachine : List Bool → List Bool} + (hrealizes : + NormalizedCertificateStringRealizesOnPositive certificateMachine) : + PositiveRawStringRealizes + (machinePositiveAlgorithmRawCode certificateMachine) + explicitPositiveAlgorithm := by + intro n A hA + rw [machinePositiveAlgorithmRawCode, + machineCompletedDimensionLtTwoBit_encode] + by_cases hsmall : n < 2 + · rw [show [decide (n < 2)] = [true] by simp [hsmall], + machineIfHead_true, + machinePositiveSmallRawCode_encode hsmall] + interval_cases n <;> rfl + · rw [show [decide (n < 2)] = [false] by simp [hsmall], + machineIfHead_false] + obtain ⟨m, rfl⟩ : ∃ m, n = m + 2 := by + use n - 2 + omega + exact machinePositiveLargeRawCode_encode_onPositive hrealizes m A hA + +theorem explicitPositiveAlgorithm_rawMachine_of_certificateMachine + {certificateMachine : List Bool → List Bool} + (hcertificateFP : certificateMachine ∈ Complexity.FP) + (hrealizes : RawStringRealizes certificateMachine + explicitNormalizedCertificateAlgorithm) : + ∃ positiveMachine : List Bool → List Bool, + positiveMachine ∈ Complexity.FP ∧ + RawStringRealizes positiveMachine explicitPositiveAlgorithm := by + exact ⟨machinePositiveAlgorithmRawCode certificateMachine, + machinePositiveAlgorithmRawCode_mem_FP hcertificateFP, + machinePositiveAlgorithmRawCode_realizes hrealizes⟩ + +theorem explicitPositiveAlgorithm_positive_rawMachine_of_certificateMachine + {certificateMachine : List Bool → List Bool} + (hcertificateFP : certificateMachine ∈ Complexity.FP) + (hrealizes : + NormalizedCertificateStringRealizesOnPositive certificateMachine) : + ∃ positiveMachine : List Bool → List Bool, + positiveMachine ∈ Complexity.FP ∧ + PositiveRawStringRealizes positiveMachine explicitPositiveAlgorithm := by + exact ⟨machinePositiveAlgorithmRawCode certificateMachine, + machinePositiveAlgorithmRawCode_mem_FP hcertificateFP, + machinePositiveAlgorithmRawCode_realizes_onPositive hrealizes⟩ + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRAMBridge.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRAMBridge.lean new file mode 100644 index 0000000000..799ca447ac --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRAMBridge.lean @@ -0,0 +1,176 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineFPBasics +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Containment + +/-! +# From logarithmic-cost RAM deciders to one-bit `FP` functions + +Complexitylib's RAM simulator is stated for languages. The executable +permanent approximation will use it as a bit graph: a RAM program answers one +requested output bit, and an outer bounded `FP` loop assembles those answers. +This file proves the first, generic bridge without introducing a machine-time +assumption. +-/ + +namespace BeyondBethe + +open Complexity + +namespace MachineRAMBridge + +open RAM.RegisterStore.Machine + +/-- The clean verdict tape emitted by the RAM simulator contains exactly one +Boolean output symbol and then a blank. -/ +theorem registerVerdictOutput_hasOutput (value : ℕ) : + (registerVerdictOutput value).HasOutput [decide (value ≠ 0)] := by + by_cases h : value = 0 <;> + simp [h, Tape.HasOutput, registerVerdictOutput, registerVerdictSymbol, + TM.idleDir, Tape.writeAndMove, Tape.move, Tape.write, Tape.read, + Tape.init] + all_goals rfl + +/-- The ordinary one-bit characteristic string of a decidable language. -/ +def languageFlag (L : Language) + [DecidablePred (fun word => word ∈ L)] (word : List Bool) : List Bool := + [decide (word ∈ L)] + +/-- A logarithmic-cost RAM decider computes the corresponding one-bit string +on the verified sparse simulator, with the simulator's explicit envelope. -/ +theorem programDecision_computesLanguageFlagInTime + {L : Language} {T : ℕ → ℕ} + [DecidablePred (fun word => word ∈ L)] + (program : RAM.Program) (hdecides : program.DecidesInTime L T) : + (programDecisionTM standardControlInstructionTapes program).ComputesInTime + (languageFlag L) + (fun inputLength => + programDecisionEnvelope program inputLength (T inputLength)) := by + intro input + obtain ⟨fuel, hhalted, hcost, hyes, hno⟩ := hdecides input + let haltWitness : ∃ candidate, + RAM.Halted program + (RAM.run program candidate (RAM.initCfg input)) := ⟨fuel, hhalted⟩ + let firstFuel := Nat.find haltWitness + have hfirstHalted : RAM.Halted program + (RAM.run program firstFuel (RAM.initCfg input)) := + Nat.find_spec haltWitness + have hfirstLe : firstFuel ≤ fuel := Nat.find_min' haltWitness hhalted + have hnotHalted : ∀ candidate < firstFuel, + ¬ RAM.Halted program + (RAM.run program candidate (RAM.initCfg input)) := by + intro candidate hcandidate + exact Nat.find_min haltWitness hcandidate + have hunit : RAM.unitTimeUpto program firstFuel (RAM.initCfg input) = + firstFuel := + RAM.unitTimeUpto_eq_of_not_halted program (RAM.initCfg input) firstFuel + hnotHalted + have hfuelCost : firstFuel ≤ + RAM.logTimeUpto program firstFuel (RAM.initCfg input) := by + calc + firstFuel = RAM.unitTimeUpto program firstFuel (RAM.initCfg input) := + hunit.symm + _ ≤ RAM.logTimeUpto program firstFuel (RAM.initCfg input) := + RAM.unitTimeUpto_le_logTimeUpto program firstFuel (RAM.initCfg input) + have hcostMono := RAM.logTimeUpto_mono program + (c := RAM.initCfg input) hfirstLe + have hfirstCost : RAM.logTimeUpto program firstFuel (RAM.initCfg input) ≤ + T input.length := le_trans hcostMono hcost + have hrunEq : RAM.run program fuel (RAM.initCfg input) = + RAM.run program firstFuel (RAM.initCfg input) := + RAM.run_eq_of_halted_le program hfirstLe hfirstHalted + have hmachine := programDecisionTM_hoareTime_ramRun + standardControlInstructionTapes program input firstFuel hfirstHalted + obtain ⟨final, time, htime, hreach, hfinalHalted, houtput⟩ := + hmachine (Tape.init (input.map Γ.ofBool)) + (fun _ => Tape.init []) (Tape.init []) ⟨rfl, rfl, rfl⟩ + have hresource := programDecisionTime_le_envelope + standardControlInstructionTapes program input firstFuel hfirstHalted + hfuelCost + have henvelope := programDecisionEnvelope_mono_cost program input.length + (RAM.logTimeUpto program firstFuel (RAM.initCfg input)) + (T input.length) hfirstCost + refine ⟨final, time, le_trans htime (le_trans hresource henvelope), + hreach, hfinalHalted, ?_⟩ + by_cases hmember : input ∈ L + · have hverdict : + (RAM.run program firstFuel (RAM.initCfg input)).verdict = 1 := by + rw [← hrunEq] + exact hyes hmember + rw [houtput, hverdict] + simpa [languageFlag, hmember] using registerVerdictOutput_hasOutput 1 + · have hverdict : + (RAM.run program firstFuel (RAM.initCfg input)).verdict = 0 := by + rw [← hrunEq] + exact hno hmember + rw [houtput, hverdict] + simpa [languageFlag, hmember] using registerVerdictOutput_hasOutput 0 + +/-- If the RAM time bound is a polynomial evaluation, its one-bit answer is a +genuine deterministic Turing-machine `FP` function. -/ +theorem languageFlag_mem_FP_of_ramProgram + {L : Language} [DecidablePred (fun word => word ∈ L)] + (program : RAM.Program) (p : Polynomial ℕ) + (hdecides : program.DecidesInTime L p.eval) : + languageFlag L ∈ Complexity.FP := by + apply mem_FP_iff_computesInTime_polynomial.mpr + refine ⟨20, programDecisionTM standardControlInstructionTapes program, + programDecisionPolynomial program p, ?_⟩ + simpa only [programDecisionPolynomial_eval] using + programDecision_computesLanguageFlagInTime program hdecides + +/-- Reserve a fixed prefix of zero input registers for a RAM program's direct +scratch registers. The semantic payload begins immediately after it. -/ +def prefixZeroRegisters (count : ℕ) (word : List Bool) : List Bool := + List.replicate count false ++ word + +theorem prefixZeroRegisters_mem_FP (count : ℕ) : + prefixZeroRegisters count ∈ Complexity.FP := by + simpa only [prefixZeroRegisters] using + machineAppend_mem_FP (machineConst_mem_FP (List.replicate count false)) + id_mem_FP + +/-- Language seen through a fixed zero-register prefix. -/ +def paddedLanguage (count : ℕ) (L : Language) : Language := + {word | word.drop count ∈ L} + +instance paddedLanguage_decidable (count : ℕ) (L : Language) + [DecidablePred (fun word => word ∈ L)] : + DecidablePred (fun word => word ∈ paddedLanguage count L) := by + intro word + change Decidable (word.drop count ∈ L) + infer_instance + +theorem languageFlag_padded_prefix (count : ℕ) (L : Language) + [DecidablePred (fun word => word ∈ L)] (word : List Bool) : + languageFlag (paddedLanguage count L) (prefixZeroRegisters count word) = + languageFlag L word := by + simp [languageFlag, paddedLanguage, prefixZeroRegisters] + +/-- A RAM decider may safely use a fixed direct-register prefix: preprocessing +that prefix and composing the verified one-bit simulator remains in `FP`. -/ +theorem languageFlag_mem_FP_of_paddedRamProgram + (count : ℕ) {L : Language} + [DecidablePred (fun word => word ∈ L)] + (program : RAM.Program) (p : Polynomial ℕ) + (hdecides : program.DecidesInTime (paddedLanguage count L) p.eval) : + languageFlag L ∈ Complexity.FP := by + have hpadded : languageFlag (paddedLanguage count L) ∈ Complexity.FP := + languageFlag_mem_FP_of_ramProgram program p hdecides + have hcomposed : + (fun word => languageFlag (paddedLanguage count L) + (prefixZeroRegisters count word)) ∈ Complexity.FP := + machineCompose_mem_FP (prefixZeroRegisters_mem_FP count) hpadded + have heq : (fun word => languageFlag (paddedLanguage count L) + (prefixZeroRegisters count word)) = languageFlag L := by + funext word + exact languageFlag_padded_prefix count L word + rwa [heq] at hcomposed + +end MachineRAMBridge + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRAMSmoke.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRAMSmoke.lean new file mode 100644 index 0000000000..38445aabf3 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRAMSmoke.lean @@ -0,0 +1,57 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineTrimHighZeros +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine + +/-! +# End-to-end smoke test for the RAM bit-graph bridge + +This file instantiates every layer of the bridge on the canonical empty +output. Although the computed function is deliberately trivial, the theorem +checks the complete interface: padded RAM input, logarithmic-cost decision, +simulation by a deterministic Turing machine, bounded bit assembly, and +canonical high-zero trimming. +-/ + +namespace BeyondBethe + +open Complexity + +def emptyMachineTarget (_ : List Bool) : List Bool := [] + +theorem outputBitLanguage_emptyMachineTarget : + outputBitLanguage emptyMachineTarget = (∅ : Language) := by + ext payload + simp [outputBitLanguage, emptyMachineTarget] + +theorem paddedOutputBitLanguage_emptyMachineTarget (count : ℕ) : + MachineRAMBridge.paddedLanguage count + (outputBitLanguage emptyMachineTarget) = (∅ : Language) := by + rw [outputBitLanguage_emptyMachineTarget] + ext payload + simp [MachineRAMBridge.paddedLanguage] + +/-- A concrete theorem exercising the complete padded-RAM-to-`FP` reduction. +No machine-time premise is accepted from the caller. -/ +theorem emptyMachineTarget_mem_FP_from_paddedRAM (count : ℕ) : + emptyMachineTarget ∈ Complexity.FP := by + let ruler : List Bool → List Bool := fun _ => [] + have hdecides : RAM.rejectProg.DecidesInTime + (MachineRAMBridge.paddedLanguage count + (outputBitLanguage emptyMachineTarget)) + (2 : Polynomial ℕ).eval := by + rw [paddedOutputBitLanguage_emptyMachineTarget] + simpa using RAM.rejectProg_decides + apply canonicalTarget_mem_FP_of_paddedRamBitProgram count + emptyMachineTarget ruler RAM.rejectProg (2 : Polynomial ℕ) hdecides + · exact machineConst_mem_FP [] + · intro word + simp [emptyMachineTarget, ruler] + · intro word + rfl + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalArithmetic.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalArithmetic.lean new file mode 100644 index 0000000000..2cb67d035b --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalArithmetic.lean @@ -0,0 +1,254 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineIntegerArithmetic + +/-! +# Polynomial-time rational addition and multiplication + +The input is a pair of unreduced rational encodings. Addition forms the two +cross-products and multiplication forms the two direct products. Both public +operations then invoke the separately verified gcd normalizer, so no use of +Lean's built-in rational arithmetic is hidden in the machine implementation. +-/ + +namespace BeyondBethe + +open Complexity + +def machineRawLeftNumeratorCode (word : List Bool) : List Bool := + machinePairFirst (machinePairFirst word) + +def machineRawLeftDenominatorBits (word : List Bool) : List Bool := + machinePairSecond (machinePairFirst word) + +def machineRawRightNumeratorCode (word : List Bool) : List Bool := + machinePairFirst (machinePairSecond word) + +def machineRawRightDenominatorBits (word : List Bool) : List Bool := + machinePairSecond (machinePairSecond word) + +/-- Regard canonical natural-number bits as a nonnegative integer code. -/ +def machineNaturalIntegerCode (word : List Bool) : List Bool := + false :: word + +def machineRawAddLeftScaledNumerator (word : List Bool) : List Bool := + machineIntegerMulCode + (pair (machineRawLeftNumeratorCode word) + (machineNaturalIntegerCode (machineRawRightDenominatorBits word))) + +def machineRawAddRightScaledNumerator (word : List Bool) : List Bool := + machineIntegerMulCode + (pair (machineRawRightNumeratorCode word) + (machineNaturalIntegerCode (machineRawLeftDenominatorBits word))) + +def machineRawAddNumeratorCode (word : List Bool) : List Bool := + machineIntegerAddCode + (pair (machineRawAddLeftScaledNumerator word) + (machineRawAddRightScaledNumerator word)) + +def machineRawProductNumeratorCode (word : List Bool) : List Bool := + machineIntegerMulCode + (pair (machineRawLeftNumeratorCode word) + (machineRawRightNumeratorCode word)) + +def machineRawProductDenominatorBits (word : List Bool) : List Bool := + machineBinaryMulBits + (pair (machineRawLeftDenominatorBits word) + (machineRawRightDenominatorBits word)) + +/-- Unreduced output encoding for rational addition. -/ +def machineRawRatAddCode (word : List Bool) : List Bool := + pair (machineRawAddNumeratorCode word) + (machineRawProductDenominatorBits word) + +/-- Unreduced output encoding for rational multiplication. -/ +def machineRawRatMulCode (word : List Bool) : List Bool := + pair (machineRawProductNumeratorCode word) + (machineRawProductDenominatorBits word) + +/-- Canonical public rational encoding of the sum. -/ +def machineRationalAddCode (word : List Bool) : List Bool := + machineNormalizeRawRatBinaryCode (machineRawRatAddCode word) + +/-- Canonical public rational encoding of the product. -/ +def machineRationalMulCode (word : List Bool) : List Bool := + machineNormalizeRawRatBinaryCode (machineRawRatMulCode word) + +theorem machineRawLeftNumeratorCode_mem_FP : + machineRawLeftNumeratorCode ∈ Complexity.FP := by + simpa only [machineRawLeftNumeratorCode] using + machineCompose_mem_FP machinePairFirst_mem_FP machinePairFirst_mem_FP + +theorem machineRawLeftDenominatorBits_mem_FP : + machineRawLeftDenominatorBits ∈ Complexity.FP := by + simpa only [machineRawLeftDenominatorBits] using + machineCompose_mem_FP machinePairFirst_mem_FP machinePairSecond_mem_FP + +theorem machineRawRightNumeratorCode_mem_FP : + machineRawRightNumeratorCode ∈ Complexity.FP := by + simpa only [machineRawRightNumeratorCode] using + machineCompose_mem_FP machinePairSecond_mem_FP machinePairFirst_mem_FP + +theorem machineRawRightDenominatorBits_mem_FP : + machineRawRightDenominatorBits ∈ Complexity.FP := by + simpa only [machineRawRightDenominatorBits] using + machineCompose_mem_FP machinePairSecond_mem_FP machinePairSecond_mem_FP + +theorem machineNaturalIntegerCode_mem_FP : + machineNaturalIntegerCode ∈ Complexity.FP := by + exact machinePrepend_mem_FP false + +theorem machineRawAddLeftScaledNumerator_mem_FP : + machineRawAddLeftScaledNumerator ∈ Complexity.FP := by + have hden := machineCompose_mem_FP + machineRawRightDenominatorBits_mem_FP machineNaturalIntegerCode_mem_FP + have hpair := machinePair_mem_FP machineRawLeftNumeratorCode_mem_FP hden + simpa only [machineRawAddLeftScaledNumerator] using + machineCompose_mem_FP hpair machineIntegerMulCode_mem_FP + +theorem machineRawAddRightScaledNumerator_mem_FP : + machineRawAddRightScaledNumerator ∈ Complexity.FP := by + have hden := machineCompose_mem_FP + machineRawLeftDenominatorBits_mem_FP machineNaturalIntegerCode_mem_FP + have hpair := machinePair_mem_FP machineRawRightNumeratorCode_mem_FP hden + simpa only [machineRawAddRightScaledNumerator] using + machineCompose_mem_FP hpair machineIntegerMulCode_mem_FP + +theorem machineRawAddNumeratorCode_mem_FP : + machineRawAddNumeratorCode ∈ Complexity.FP := by + have hpair := machinePair_mem_FP + machineRawAddLeftScaledNumerator_mem_FP + machineRawAddRightScaledNumerator_mem_FP + simpa only [machineRawAddNumeratorCode] using + machineCompose_mem_FP hpair machineIntegerAddCode_mem_FP + +theorem machineRawProductNumeratorCode_mem_FP : + machineRawProductNumeratorCode ∈ Complexity.FP := by + have hpair := machinePair_mem_FP machineRawLeftNumeratorCode_mem_FP + machineRawRightNumeratorCode_mem_FP + simpa only [machineRawProductNumeratorCode] using + machineCompose_mem_FP hpair machineIntegerMulCode_mem_FP + +theorem machineRawProductDenominatorBits_mem_FP : + machineRawProductDenominatorBits ∈ Complexity.FP := by + have hpair := machinePair_mem_FP machineRawLeftDenominatorBits_mem_FP + machineRawRightDenominatorBits_mem_FP + simpa only [machineRawProductDenominatorBits] using + machineCompose_mem_FP hpair machineBinaryMulBits_mem_FP + +theorem machineRawRatAddCode_mem_FP : machineRawRatAddCode ∈ Complexity.FP := by + exact machinePair_mem_FP machineRawAddNumeratorCode_mem_FP + machineRawProductDenominatorBits_mem_FP + +theorem machineRawRatMulCode_mem_FP : machineRawRatMulCode ∈ Complexity.FP := by + exact machinePair_mem_FP machineRawProductNumeratorCode_mem_FP + machineRawProductDenominatorBits_mem_FP + +theorem machineRationalAddCode_mem_FP : machineRationalAddCode ∈ Complexity.FP := by + simpa only [machineRationalAddCode] using + machineCompose_mem_FP machineRawRatAddCode_mem_FP + machineNormalizeRawRatBinaryCode_mem_FP + +theorem machineRationalMulCode_mem_FP : machineRationalMulCode ∈ Complexity.FP := by + simpa only [machineRationalMulCode] using + machineCompose_mem_FP machineRawRatMulCode_mem_FP + machineNormalizeRawRatBinaryCode_mem_FP + +@[simp] theorem machineNaturalIntegerCode_natBits (n : ℕ) : + machineNaturalIntegerCode n.bits = integerBinaryCode (Int.ofNat n) := by + rfl + +@[simp] theorem machineRawLeftNumeratorCode_encode (q r : RawRat) : + machineRawLeftNumeratorCode + (pair (rawRatBinaryCode q) (rawRatBinaryCode r)) = + integerBinaryCode q.num := by + simp [machineRawLeftNumeratorCode, rawRatBinaryCode] + +@[simp] theorem machineRawLeftDenominatorBits_encode (q r : RawRat) : + machineRawLeftDenominatorBits + (pair (rawRatBinaryCode q) (rawRatBinaryCode r)) = q.den.bits := by + simp [machineRawLeftDenominatorBits, rawRatBinaryCode] + +@[simp] theorem machineRawRightNumeratorCode_encode (q r : RawRat) : + machineRawRightNumeratorCode + (pair (rawRatBinaryCode q) (rawRatBinaryCode r)) = + integerBinaryCode r.num := by + simp [machineRawRightNumeratorCode, rawRatBinaryCode] + +@[simp] theorem machineRawRightDenominatorBits_encode (q r : RawRat) : + machineRawRightDenominatorBits + (pair (rawRatBinaryCode q) (rawRatBinaryCode r)) = r.den.bits := by + simp [machineRawRightDenominatorBits, rawRatBinaryCode] + +theorem machineRawAddLeftScaledNumerator_encode (q r : RawRat) : + machineRawAddLeftScaledNumerator + (pair (rawRatBinaryCode q) (rawRatBinaryCode r)) = + integerBinaryCode (q.num * (r.den : ℤ)) := by + simp [machineRawAddLeftScaledNumerator, + machineIntegerMulCode_encode] + +theorem machineRawAddRightScaledNumerator_encode (q r : RawRat) : + machineRawAddRightScaledNumerator + (pair (rawRatBinaryCode q) (rawRatBinaryCode r)) = + integerBinaryCode (r.num * (q.den : ℤ)) := by + simp [machineRawAddRightScaledNumerator, + machineIntegerMulCode_encode] + +theorem machineRawAddNumeratorCode_encode (q r : RawRat) : + machineRawAddNumeratorCode + (pair (rawRatBinaryCode q) (rawRatBinaryCode r)) = + integerBinaryCode + (q.num * (r.den : ℤ) + r.num * (q.den : ℤ)) := by + rw [machineRawAddNumeratorCode, + machineRawAddLeftScaledNumerator_encode, + machineRawAddRightScaledNumerator_encode, + machineIntegerAddCode_encode] + +theorem machineRawProductNumeratorCode_encode (q r : RawRat) : + machineRawProductNumeratorCode + (pair (rawRatBinaryCode q) (rawRatBinaryCode r)) = + integerBinaryCode (q.num * r.num) := by + simp [machineRawProductNumeratorCode, machineIntegerMulCode_encode] + +theorem machineRawProductDenominatorBits_encode (q r : RawRat) : + machineRawProductDenominatorBits + (pair (rawRatBinaryCode q) (rawRatBinaryCode r)) = + (q.den * r.den).bits := by + simp [machineRawProductDenominatorBits, + machineBinaryMulBits_pair_natBits] + +theorem machineRawRatAddCode_encode (q r : RawRat) : + machineRawRatAddCode + (pair (rawRatBinaryCode q) (rawRatBinaryCode r)) = + rawRatBinaryCode (q.add r) := by + rw [machineRawRatAddCode, machineRawAddNumeratorCode_encode, + machineRawProductDenominatorBits_encode] + rfl + +theorem machineRawRatMulCode_encode (q r : RawRat) : + machineRawRatMulCode + (pair (rawRatBinaryCode q) (rawRatBinaryCode r)) = + rawRatBinaryCode (q.mul r) := by + rw [machineRawRatMulCode, machineRawProductNumeratorCode_encode, + machineRawProductDenominatorBits_encode] + rfl + +theorem machineRationalAddCode_encode (q r : RawRat) : + machineRationalAddCode + (pair (rawRatBinaryCode q) (rawRatBinaryCode r)) = + rationalBinaryCode (binaryNormalizeRawRat (q.add r)) := by + rw [machineRationalAddCode, machineRawRatAddCode_encode, + machineNormalizeRawRatBinaryCode_encode] + +theorem machineRationalMulCode_encode (q r : RawRat) : + machineRationalMulCode + (pair (rawRatBinaryCode q) (rawRatBinaryCode r)) = + rationalBinaryCode (binaryNormalizeRawRat (q.mul r)) := by + rw [machineRationalMulCode, machineRawRatMulCode_encode, + machineNormalizeRawRatBinaryCode_encode] + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalBallInit.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalBallInit.lean new file mode 100644 index 0000000000..fec46d29ce --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalBallInit.lean @@ -0,0 +1,679 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalEllipsoidEncoding +import LeanPool.BeyondBethe.BeyondBethe.MachineRepeatPair +import LeanPool.BeyondBethe.BeyondBethe.MachineNestedMatrixMemory +import LeanPool.BeyondBethe.BeyondBethe.MachineLengthBits + +/-! # Machine Rational Ball Init -/ + +namespace BeyondBethe + +open Complexity + +/-! +# Finite-word construction of rational ball states + +This module begins the concrete state constructor used by every feasibility +call. It first builds the zero center and all-zero square basis from a unary +dimension ruler. The following section will replace the diagonal entries by +the encoded radius and package the result as a complete ellipsoid state. +-/ + +def machineRationalZeroEntry : List Bool := + rationalEntryBinaryCode 0 + +/-- Input: a unary dimension ruler. -/ +def machineRationalZeroVectorCode (ruler : List Bool) : List Bool := + machineRepeatPairCode + (pair ruler (pair machineRationalZeroEntry [])) + +/-- Input: a unary dimension ruler. -/ +def machineRationalZeroMatrixRowsCode (ruler : List Bool) : List Bool := + let row := machineRationalZeroVectorCode ruler + machineRepeatPairCode (pair ruler (pair row [])) + +theorem machineRationalZeroVectorCode_mem_FP : + machineRationalZeroVectorCode ∈ FP := by + have hpayload := machinePair_mem_FP id_mem_FP + (machinePair_mem_FP (machineConst_mem_FP machineRationalZeroEntry) + (machineConst_mem_FP [])) + simpa only [machineRationalZeroVectorCode] using + machineCompose_mem_FP hpayload machineRepeatPairCode_mem_FP + +theorem machineRationalZeroMatrixRowsCode_mem_FP : + machineRationalZeroMatrixRowsCode ∈ FP := by + have hpayload := machinePair_mem_FP id_mem_FP + (machinePair_mem_FP machineRationalZeroVectorCode_mem_FP + (machineConst_mem_FP [])) + simpa only [machineRationalZeroMatrixRowsCode] using + machineCompose_mem_FP hpayload machineRepeatPairCode_mem_FP + +@[simp] theorem machineRationalZeroVectorCode_encode (d : ℕ) : + machineRationalZeroVectorCode (List.replicate d true) = + rationalFiniteVectorCode (fun _ : Fin d ↦ (0 : ℚ)) := by + rw [machineRationalZeroVectorCode] + change machineRepeatPairCode + (machineRepeatPairCanonicalInput d machineRationalZeroEntry []) = _ + rw [machineRepeatPairCode_encode] + change repeatPairCode d (rationalEntryBinaryCode 0) + (binaryListCode rationalEntryBinaryCode []) = _ + rw [repeatPairCode_binaryListCode] + simp [rationalFiniteVectorCode] + +theorem rationalMatrixRows_zero (d : ℕ) : + rationalMatrixRows (0 : Matrix (Fin d) (Fin d) ℚ) = + List.replicate d (List.replicate d 0) := by + simp [rationalMatrixRows] + +@[simp] theorem machineRationalZeroMatrixRowsCode_encode (d : ℕ) : + machineRationalZeroMatrixRowsCode (List.replicate d true) = + rationalSquareMatrixRowsCode + (0 : Matrix (Fin d) (Fin d) ℚ) := by + rw [machineRationalZeroMatrixRowsCode, + machineRationalZeroVectorCode_encode] + change machineRepeatPairCode + (machineRepeatPairCanonicalInput d + (rationalFiniteVectorCode (fun _ : Fin d ↦ (0 : ℚ))) []) = _ + rw [machineRepeatPairCode_encode] + change repeatPairCode d + (binaryListCode rationalEntryBinaryCode + (List.ofFn (fun _ : Fin d ↦ (0 : ℚ)))) + (binaryListCode (binaryListCode rationalEntryBinaryCode) []) = _ + rw [repeatPairCode_binaryListCode] + rw [rationalSquareMatrixRowsCode, rationalMatrixRows_zero] + simp + +/-! ## Diagonal prefixes -/ + +/-- The first `k` diagonal entries have been replaced by `R`; all other +entries are zero. -/ +def rationalDiagonalPrefixMatrix (d k : ℕ) (R : ℚ) : + Matrix (Fin d) (Fin d) ℚ := + fun i j ↦ if i = j ∧ i.1 < k then R else 0 + +@[simp] theorem rationalDiagonalPrefixMatrix_zero + (d : ℕ) (R : ℚ) : + rationalDiagonalPrefixMatrix d 0 R = 0 := by + ext i j + simp [rationalDiagonalPrefixMatrix] + +theorem rationalDiagonalPrefixMatrix_all + (d : ℕ) (R : ℚ) : + rationalDiagonalPrefixMatrix d d R = + (rationalBallEllipsoid d 0 R).basis := by + ext i j + simp [rationalDiagonalPrefixMatrix, rationalBallEllipsoid] + +theorem rationalMatrixRows_diagonalPrefix_set + {d k : ℕ} (R : ℚ) (hk : k < d) : + let rows := rationalMatrixRows (rationalDiagonalPrefixMatrix d k R) + rows.set k + ((rows[k]'(by simpa [rows, rationalMatrixRows] using hk)).set k R) = + rationalMatrixRows (rationalDiagonalPrefixMatrix d (k + 1) R) := by + dsimp only + apply List.ext_getElem + · simp [rationalMatrixRows] + · intro i hiLeft hiRight + have hi : i < d := by + simpa [rationalMatrixRows] using hiRight + by_cases hik : i = k + · subst i + simp only [List.getElem_set, ↓reduceIte] + apply List.ext_getElem + · simp [rationalMatrixRows] + · intro j hjLeft hjRight + have hj : j < d := by + simpa [rationalMatrixRows] using hjRight + by_cases hjk : j = k + · subst j + simp [rationalMatrixRows, rationalDiagonalPrefixMatrix] + · rw [List.getElem_set_of_ne (Ne.symm hjk)] + simp [rationalMatrixRows, rationalDiagonalPrefixMatrix, + Ne.symm hjk] + · rw [List.getElem_set_of_ne (Ne.symm hik)] + simp only [rationalMatrixRows, List.getElem_ofFn] + apply List.ext_getElem + · simp + · intro j hjLeft hjRight + have hj : j < d := by simpa using hjRight + simp only [List.getElem_ofFn] + by_cases hij : i = j + · subst j + simp only [rationalDiagonalPrefixMatrix, Nat.lt_succ_iff] + by_cases hlt : i < k + · have hnki : ¬k < i := by omega + simp [hlt, hnki] + · have hgt : k < i := by omega + simp [hlt, Nat.not_le.mpr hgt] + · simp [rationalDiagonalPrefixMatrix, hij] + +/-! ## Diagonal-basis machine -/ + +def machineDiagonalBasisRuler (word : List Bool) : List Bool := + machinePairFirst word + +def machineDiagonalBasisRadiusEntry (word : List Bool) : List Bool := + machinePairSecond word + +/-- A quartic envelope for the nested matrix under diagonal updates. -/ +def machineDiagonalBasisBound (word : List Bool) : List Bool := + machineBinaryMulWidth (machineBinaryMulWidth word) + +def machineDiagonalBasisPack + (index matrix radius bound : List Bool) : List Bool := + pair index (pair matrix (pair radius bound)) + +def machineDiagonalBasisIndex (state : List Bool) : List Bool := + machinePairFirst state + +def machineDiagonalBasisMatrix (state : List Bool) : List Bool := + machinePairFirst (machinePairSecond state) + +def machineDiagonalBasisRadius (state : List Bool) : List Bool := + machinePairFirst (machinePairSecond (machinePairSecond state)) + +def machineDiagonalBasisStateBound (state : List Bool) : List Bool := + machinePairSecond (machinePairSecond (machinePairSecond state)) + +def machineDiagonalBasisNextIndexCandidate + (state : List Bool) : List Bool := + true :: machineDiagonalBasisIndex state + +def machineDiagonalBasisNextIndex (state : List Bool) : List Bool := + (machineDiagonalBasisNextIndexCandidate state).take + (machineDiagonalBasisStateBound state).length + +def machineDiagonalBasisMatrixCandidate (state : List Bool) : List Bool := + machineNestedMatrixUpdateAtUnary + (pair (machineDiagonalBasisIndex state) + (pair (machineDiagonalBasisIndex state) + (pair (machineDiagonalBasisRadius state) + (machineDiagonalBasisMatrix state)))) + +def machineDiagonalBasisNextMatrix (state : List Bool) : List Bool := + (machineDiagonalBasisMatrixCandidate state).take + (machineDiagonalBasisStateBound state).length + +def machineDiagonalBasisStep (state : List Bool) : List Bool := + machineDiagonalBasisPack (machineDiagonalBasisNextIndex state) + (machineDiagonalBasisNextMatrix state) + (machineDiagonalBasisRadius state) + (machineDiagonalBasisStateBound state) + +def machineDiagonalBasisInitialMatrix (word : List Bool) : List Bool := + (machineRationalZeroMatrixRowsCode (machineDiagonalBasisRuler word)).take + (machineDiagonalBasisBound word).length + +def machineDiagonalBasisInit (word : List Bool) : List Bool := + machineDiagonalBasisPack [] (machineDiagonalBasisInitialMatrix word) + (machineDiagonalBasisRadiusEntry word) + (machineDiagonalBasisBound word) + +def machineDiagonalBasisWidth (word : List Bool) : List Bool := + machineDiagonalBasisPack (machineDiagonalBasisBound word) + (machineDiagonalBasisBound word) (machineDiagonalBasisBound word) + (machineDiagonalBasisBound word) + +def machineDiagonalBasisFinalState (word : List Bool) : List Bool := + (machineDiagonalBasisStep)^[(machineDiagonalBasisRuler word).length] + (machineDiagonalBasisInit word) + +def machineDiagonalBasisRowsCode (word : List Bool) : List Bool := + machineDiagonalBasisMatrix (machineDiagonalBasisFinalState word) + +/-! ### Polynomial-time closure -/ + +theorem machineDiagonalBasisRuler_mem_FP : + machineDiagonalBasisRuler ∈ FP := machinePairFirst_mem_FP + +theorem machineDiagonalBasisRadiusEntry_mem_FP : + machineDiagonalBasisRadiusEntry ∈ FP := machinePairSecond_mem_FP + +theorem machineDiagonalBasisBound_mem_FP : + machineDiagonalBasisBound ∈ FP := by + simpa only [machineDiagonalBasisBound] using + machineCompose_mem_FP machineBinaryMulWidth_mem_FP + machineBinaryMulWidth_mem_FP + +theorem machineDiagonalBasisIndex_mem_FP : + machineDiagonalBasisIndex ∈ FP := machinePairFirst_mem_FP + +theorem machineDiagonalBasisMatrix_mem_FP : + machineDiagonalBasisMatrix ∈ FP := by + simpa only [machineDiagonalBasisMatrix] using + machineCompose_mem_FP machinePairSecond_mem_FP machinePairFirst_mem_FP + +theorem machineDiagonalBasisRadius_mem_FP : + machineDiagonalBasisRadius ∈ FP := by + have hsecondTwo := machineCompose_mem_FP machinePairSecond_mem_FP + machinePairSecond_mem_FP + simpa only [machineDiagonalBasisRadius] using + machineCompose_mem_FP hsecondTwo machinePairFirst_mem_FP + +theorem machineDiagonalBasisStateBound_mem_FP : + machineDiagonalBasisStateBound ∈ FP := by + have hsecondTwo := machineCompose_mem_FP machinePairSecond_mem_FP + machinePairSecond_mem_FP + simpa only [machineDiagonalBasisStateBound] using + machineCompose_mem_FP hsecondTwo machinePairSecond_mem_FP + +theorem machineDiagonalBasisNextIndexCandidate_mem_FP : + machineDiagonalBasisNextIndexCandidate ∈ FP := by + simpa only [machineDiagonalBasisNextIndexCandidate] using + machineAppend_mem_FP (machineConst_mem_FP [true]) + machineDiagonalBasisIndex_mem_FP + +theorem machineDiagonalBasisNextIndex_mem_FP : + machineDiagonalBasisNextIndex ∈ FP := by + simpa only [machineDiagonalBasisNextIndex] using + machineTake_mem_FP machineDiagonalBasisStateBound_mem_FP + machineDiagonalBasisNextIndexCandidate_mem_FP + +theorem machineDiagonalBasisMatrixCandidate_mem_FP : + machineDiagonalBasisMatrixCandidate ∈ FP := by + have hpayload := machinePair_mem_FP machineDiagonalBasisIndex_mem_FP + (machinePair_mem_FP machineDiagonalBasisIndex_mem_FP + (machinePair_mem_FP machineDiagonalBasisRadius_mem_FP + machineDiagonalBasisMatrix_mem_FP)) + simpa only [machineDiagonalBasisMatrixCandidate] using + machineCompose_mem_FP hpayload machineNestedMatrixUpdateAtUnary_mem_FP + +theorem machineDiagonalBasisNextMatrix_mem_FP : + machineDiagonalBasisNextMatrix ∈ FP := by + simpa only [machineDiagonalBasisNextMatrix] using + machineTake_mem_FP machineDiagonalBasisStateBound_mem_FP + machineDiagonalBasisMatrixCandidate_mem_FP + +theorem machineDiagonalBasisStep_mem_FP : machineDiagonalBasisStep ∈ FP := + machinePair_mem_FP machineDiagonalBasisNextIndex_mem_FP + (machinePair_mem_FP machineDiagonalBasisNextMatrix_mem_FP + (machinePair_mem_FP machineDiagonalBasisRadius_mem_FP + machineDiagonalBasisStateBound_mem_FP)) + +theorem machineDiagonalBasisInitialMatrix_mem_FP : + machineDiagonalBasisInitialMatrix ∈ FP := by + have hzero := machineCompose_mem_FP machineDiagonalBasisRuler_mem_FP + machineRationalZeroMatrixRowsCode_mem_FP + simpa only [machineDiagonalBasisInitialMatrix] using + machineTake_mem_FP machineDiagonalBasisBound_mem_FP hzero + +theorem machineDiagonalBasisInit_mem_FP : machineDiagonalBasisInit ∈ FP := + machinePair_mem_FP (machineConst_mem_FP []) + (machinePair_mem_FP machineDiagonalBasisInitialMatrix_mem_FP + (machinePair_mem_FP machineDiagonalBasisRadiusEntry_mem_FP + machineDiagonalBasisBound_mem_FP)) + +theorem machineDiagonalBasisWidth_mem_FP : machineDiagonalBasisWidth ∈ FP := + machinePair_mem_FP machineDiagonalBasisBound_mem_FP + (machinePair_mem_FP machineDiagonalBasisBound_mem_FP + (machinePair_mem_FP machineDiagonalBasisBound_mem_FP + machineDiagonalBasisBound_mem_FP)) + +@[simp] theorem machineDiagonalBasisIndex_pack (a b c e) : + machineDiagonalBasisIndex (machineDiagonalBasisPack a b c e) = a := by + simp [machineDiagonalBasisIndex, machineDiagonalBasisPack] + +@[simp] theorem machineDiagonalBasisMatrix_pack (a b c e) : + machineDiagonalBasisMatrix (machineDiagonalBasisPack a b c e) = b := by + simp [machineDiagonalBasisMatrix, machineDiagonalBasisPack] + +@[simp] theorem machineDiagonalBasisRadius_pack (a b c e) : + machineDiagonalBasisRadius (machineDiagonalBasisPack a b c e) = c := by + simp [machineDiagonalBasisRadius, machineDiagonalBasisPack] + +@[simp] theorem machineDiagonalBasisStateBound_pack (a b c e) : + machineDiagonalBasisStateBound (machineDiagonalBasisPack a b c e) = e := by + simp [machineDiagonalBasisStateBound, machineDiagonalBasisPack] + +def MachineDiagonalBasisStateBound (word state : List Bool) : Prop := + let B := (machineDiagonalBasisBound word).length + state = machineDiagonalBasisPack + (machineDiagonalBasisIndex state) + (machineDiagonalBasisMatrix state) + (machineDiagonalBasisRadius state) + (machineDiagonalBasisStateBound state) ∧ + (machineDiagonalBasisIndex state).length ≤ B ∧ + (machineDiagonalBasisMatrix state).length ≤ B ∧ + (machineDiagonalBasisRadius state).length ≤ B ∧ + (machineDiagonalBasisStateBound state).length ≤ B + +theorem machineDiagonalBasis_word_length_le_bound (word : List Bool) : + word.length ≤ (machineDiagonalBasisBound word).length := by + simp only [machineDiagonalBasisBound, machineBinaryMulWidth, + List.length_replicate, List.length_append] + nlinarith + +theorem machineDiagonalBasisInit_bound (word : List Bool) : + MachineDiagonalBasisStateBound word (machineDiagonalBasisInit word) := by + simp only [MachineDiagonalBasisStateBound, machineDiagonalBasisInit, + machineDiagonalBasisIndex_pack, machineDiagonalBasisMatrix_pack, + machineDiagonalBasisRadius_pack, machineDiagonalBasisStateBound_pack] + refine ⟨trivial, by simp, ?_, ?_, le_rfl⟩ + · exact (List.length_take_le _ _).trans le_rfl + · exact (machinePairSecond_length_le word).trans + (machineDiagonalBasis_word_length_le_bound word) + +theorem machineDiagonalBasisStep_bound {word state : List Bool} + (hstate : MachineDiagonalBasisStateBound word state) : + MachineDiagonalBasisStateBound word (machineDiagonalBasisStep state) := by + dsimp only [MachineDiagonalBasisStateBound] at hstate ⊢ + rcases hstate with ⟨_, _hindex, _hmatrix, hradius, hbound⟩ + simp only [machineDiagonalBasisStep, machineDiagonalBasisIndex_pack, + machineDiagonalBasisMatrix_pack, machineDiagonalBasisRadius_pack, + machineDiagonalBasisStateBound_pack] + refine ⟨trivial, ?_, ?_, hradius, hbound⟩ + · exact (List.length_take_le _ _).trans hbound + · exact (List.length_take_le _ _).trans hbound + +theorem machineDiagonalBasisIterate_bound (word : List Bool) : ∀ k, + MachineDiagonalBasisStateBound word + ((machineDiagonalBasisStep)^[k] (machineDiagonalBasisInit word)) := by + intro k + induction k with + | zero => exact machineDiagonalBasisInit_bound word + | succ k ih => + rw [Function.iterate_succ_apply'] + exact machineDiagonalBasisStep_bound ih + +theorem machineDiagonalBasisIterate_length_le_width + (word : List Bool) (iterations : ℕ) + (_ : iterations ≤ (machineDiagonalBasisRuler word).length) : + ((machineDiagonalBasisStep)^[iterations] + (machineDiagonalBasisInit word)).length ≤ + (machineDiagonalBasisWidth word).length := by + rcases machineDiagonalBasisIterate_bound word iterations with + ⟨hdecomp, hindex, hmatrix, hradius, hbound⟩ + rw [hdecomp] + simp only [machineDiagonalBasisPack, machineDiagonalBasisWidth, pair_length] + omega + +theorem machineDiagonalBasisFinalState_mem_FP : + machineDiagonalBasisFinalState ∈ FP := + Cobham.iterate_mem_FP machineDiagonalBasisStep_mem_FP + machineDiagonalBasisInit_mem_FP machineDiagonalBasisRuler_mem_FP + machineDiagonalBasisWidth_mem_FP + machineDiagonalBasisIterate_length_le_width + +theorem machineDiagonalBasisRowsCode_mem_FP : + machineDiagonalBasisRowsCode ∈ FP := by + simpa only [machineDiagonalBasisRowsCode] using + machineCompose_mem_FP machineDiagonalBasisFinalState_mem_FP + machineDiagonalBasisMatrix_mem_FP + +/-! ### Exact canonical semantics -/ + +def machineDiagonalBasisCanonicalInput (d : ℕ) (R : ℚ) : List Bool := + pair (List.replicate d true) (rationalEntryBinaryCode R) + +def machineDiagonalBasisCanonicalState + (d : ℕ) (R : ℚ) (k : ℕ) : List Bool := + let word := machineDiagonalBasisCanonicalInput d R + machineDiagonalBasisPack (List.replicate k true) + (rationalSquareMatrixRowsCode (rationalDiagonalPrefixMatrix d k R)) + (rationalEntryBinaryCode R) (machineDiagonalBasisBound word) + +theorem rationalSquareMatrixRowsCode_diagonalPrefix_length_le + (d k : ℕ) (R : ℚ) : + (rationalSquareMatrixRowsCode + (rationalDiagonalPrefixMatrix d k R)).length ≤ + d * (2 * (d * + (2 * (machineRationalZeroEntry.length + + (rationalEntryBinaryCode R).length) + 2)) + 2) := by + let M := machineRationalZeroEntry.length + + (rationalEntryBinaryCode R).length + have hentry : ∀ i j : Fin d, + (rationalEntryBinaryCode + (rationalDiagonalPrefixMatrix d k R i j)).length ≤ M := by + intro i j + simp only [rationalDiagonalPrefixMatrix] + split + · omega + · change machineRationalZeroEntry.length ≤ M + omega + rw [rationalSquareMatrixRowsCode, binaryListCode_length_eq_sum] + simp only [rationalMatrixRows, List.map_ofFn, List.sum_ofFn, + Function.comp_apply] + calc + (∑ i : Fin d, + (2 * (binaryListCode rationalEntryBinaryCode + (List.ofFn fun j ↦ rationalDiagonalPrefixMatrix d k R i j)).length + + 2)) ≤ + ∑ _i : Fin d, (2 * (d * (2 * M + 2)) + 2) := by + apply Finset.sum_le_sum + intro i _ + gcongr + rw [binaryListCode_length_eq_sum] + simp only [List.map_ofFn, List.sum_ofFn, Function.comp_apply] + calc + (∑ j : Fin d, + (2 * (rationalEntryBinaryCode + (rationalDiagonalPrefixMatrix d k R i j)).length + 2)) ≤ + ∑ _j : Fin d, (2 * M + 2) := by + apply Finset.sum_le_sum + intro j _ + have he := hentry i j + omega + _ = d * (2 * M + 2) := by simp [mul_comm] + _ = d * (2 * (d * (2 * M + 2)) + 2) := by simp [mul_comm] + +theorem machineDiagonalBasis_prefix_fits + (d k : ℕ) (R : ℚ) : + (rationalSquareMatrixRowsCode + (rationalDiagonalPrefixMatrix d k R)).length ≤ + (machineDiagonalBasisBound + (machineDiagonalBasisCanonicalInput d R)).length := by + let W := (machineDiagonalBasisCanonicalInput d R).length + let Z := machineRationalZeroEntry.length + let L := (rationalEntryBinaryCode R).length + have hZ : Z = 5 := by + decide + have hW : W = 2 * d + 2 + L := by + simp [W, L, machineDiagonalBasisCanonicalInput] + have hL : 4 ≤ L := by + dsimp only [L, rationalEntryBinaryCode] + cases R.num <;> simp [integerBinaryCode] <;> omega + have hdW : d ≤ W := by omega + have hLW : L ≤ W := by omega + have hZW : Z ≤ W := by omega + have hM : Z + L ≤ 2 * W := by omega + have hinner : d * (2 * (Z + L) + 2) ≤ 6 * W ^ 2 := by + have hfactor : 2 * (Z + L) + 2 ≤ 6 * W := by + have hWpos : 1 ≤ W := by omega + omega + have hmul := Nat.mul_le_mul hdW hfactor + nlinarith + have hrow : 2 * (d * (2 * (Z + L) + 2)) + 2 ≤ + 14 * W ^ 2 := by + have hWpos : 1 ≤ W := by omega + nlinarith + have hcode : d * (2 * (d * (2 * (Z + L) + 2)) + 2) ≤ + 14 * W ^ 3 := by + have hmul := Nat.mul_le_mul hdW hrow + nlinarith + have hshift : W ≤ 16 + W := by omega + have hpow3 : W ^ 3 ≤ (16 + W) ^ 3 := + Nat.pow_le_pow_left hshift 3 + have h14 : 14 ≤ 16 + W := by omega + have hcubic : 14 * W ^ 3 ≤ (16 + W) ^ 4 := by + calc + 14 * W ^ 3 ≤ (16 + W) * (16 + W) ^ 3 := + Nat.mul_le_mul h14 hpow3 + _ = (16 + W) ^ 4 := by ring + have hbase : (16 + W) ^ 2 ≤ 16 + (16 + W) ^ 2 := by omega + have hquartic : (16 + W) ^ 4 ≤ + (16 + (16 + W) ^ 2) ^ 2 := by + rw [show (16 + W) ^ 4 = ((16 + W) ^ 2) ^ 2 by ring] + exact Nat.pow_le_pow_left hbase 2 + have hpref := rationalSquareMatrixRowsCode_diagonalPrefix_length_le + d k R + dsimp only [Z, L] at hpref hcode + calc + (rationalSquareMatrixRowsCode + (rationalDiagonalPrefixMatrix d k R)).length ≤ + d * (2 * (d * + (2 * (machineRationalZeroEntry.length + + (rationalEntryBinaryCode R).length) + 2)) + 2) := hpref + _ ≤ 14 * W ^ 3 := hcode + _ ≤ (16 + W) ^ 4 := hcubic + _ ≤ (16 + (16 + W) ^ 2) ^ 2 := hquartic + _ = (machineDiagonalBasisBound + (machineDiagonalBasisCanonicalInput d R)).length := by + simp only [machineDiagonalBasisBound, machineBinaryMulWidth, + List.length_replicate, List.length_append] + rw [show (machineDiagonalBasisCanonicalInput d R).length = W by rfl] + ring + +theorem machineDiagonalBasisInit_semantics (d : ℕ) (R : ℚ) : + machineDiagonalBasisInit (machineDiagonalBasisCanonicalInput d R) = + machineDiagonalBasisCanonicalState d R 0 := by + have hfit := machineDiagonalBasis_prefix_fits d 0 R + have hzero : rationalSquareMatrixRowsCode + (rationalDiagonalPrefixMatrix d 0 R) = + rationalSquareMatrixRowsCode (0 : Matrix (Fin d) (Fin d) ℚ) := by + rw [rationalDiagonalPrefixMatrix_zero] + have htake : + (machineRationalZeroMatrixRowsCode (List.replicate d true)).take + (machineDiagonalBasisBound + (machineDiagonalBasisCanonicalInput d R)).length = + rationalSquareMatrixRowsCode + (rationalDiagonalPrefixMatrix d 0 R) := by + rw [machineRationalZeroMatrixRowsCode_encode, ← hzero] + exact List.take_of_length_le hfit + simp only [machineDiagonalBasisInit, machineDiagonalBasisCanonicalInput, + machineDiagonalBasisCanonicalState, machineDiagonalBasisRuler, + machineDiagonalBasisRadiusEntry, machinePairFirst_pair, + machinePairSecond_pair, machineDiagonalBasisInitialMatrix] + have htake' := htake + simp only [machineDiagonalBasisCanonicalInput] at htake' + rw [htake'] + simp + +theorem machineDiagonalBasisStep_semantics + (d k : ℕ) (R : ℚ) (hk : k < d) : + machineDiagonalBasisStep + (machineDiagonalBasisCanonicalState d R k) = + machineDiagonalBasisCanonicalState d R (k + 1) := by + let M := rationalMatrixRows (rationalDiagonalPrefixMatrix d k R) + have hrow : k < M.length := by simp [M, rationalMatrixRows, hk] + have hcol : k < M[k].length := by simp [M, rationalMatrixRows, hk] + have hupdate := machineNestedMatrixUpdateAtUnary_encode + rationalEntryBinaryCode M k k R hrow hcol + rw [rationalMatrixRows_diagonalPrefix_set R hk] at hupdate + have hmatrixFit := machineDiagonalBasis_prefix_fits d (k + 1) R + have hmatrixTake : + (machineDiagonalBasisMatrixCandidate + (machineDiagonalBasisCanonicalState d R k)).take + (machineDiagonalBasisBound + (machineDiagonalBasisCanonicalInput d R)).length = + rationalSquareMatrixRowsCode + (rationalDiagonalPrefixMatrix d (k + 1) R) := by + rw [machineDiagonalBasisMatrixCandidate, + machineDiagonalBasisCanonicalState, + machineDiagonalBasisIndex_pack, machineDiagonalBasisMatrix_pack, + machineDiagonalBasisRadius_pack] + simpa only [rationalSquareMatrixRowsCode] using + congrArg (fun word ↦ word.take + (machineDiagonalBasisBound + (machineDiagonalBasisCanonicalInput d R)).length) hupdate |>.trans + (List.take_of_length_le hmatrixFit) + have hindexFit : k + 1 ≤ + (machineDiagonalBasisBound + (machineDiagonalBasisCanonicalInput d R)).length := by + have hword := machineDiagonalBasis_word_length_le_bound + (machineDiagonalBasisCanonicalInput d R) + have hdim : d ≤ (machineDiagonalBasisCanonicalInput d R).length := by + simp only [machineDiagonalBasisCanonicalInput, pair_length, + List.length_replicate] + omega + exact (show k + 1 ≤ d by omega).trans (hdim.trans hword) + have hindexTake : + (true :: List.replicate k true).take + (machineDiagonalBasisBound + (machineDiagonalBasisCanonicalInput d R)).length = + List.replicate (k + 1) true := by + have hrep : List.replicate (k + 1) true = + true :: List.replicate k true := by + rw [List.replicate_succ] + rw [← hrep] + exact List.take_of_length_le (by simpa using hindexFit) + simp only [machineDiagonalBasisStep, machineDiagonalBasisCanonicalState, + machineDiagonalBasisNextIndex, machineDiagonalBasisNextIndexCandidate, + machineDiagonalBasisIndex_pack, machineDiagonalBasisNextMatrix, + machineDiagonalBasisStateBound_pack, machineDiagonalBasisRadius_pack] + rw [hindexTake] + have hmatrixTake' := hmatrixTake + simp only [machineDiagonalBasisCanonicalState] at hmatrixTake' + rw [hmatrixTake'] + +theorem machineDiagonalBasisIterate_semantics + (d : ℕ) (R : ℚ) : ∀ k ≤ d, + (machineDiagonalBasisStep)^[k] + (machineDiagonalBasisInit + (machineDiagonalBasisCanonicalInput d R)) = + machineDiagonalBasisCanonicalState d R k := by + intro k hk + induction k with + | zero => exact machineDiagonalBasisInit_semantics d R + | succ k ih => + rw [Function.iterate_succ_apply', ih (by omega)] + exact machineDiagonalBasisStep_semantics d k R (by omega) + +@[simp] theorem machineDiagonalBasisRowsCode_encode (d : ℕ) (R : ℚ) : + machineDiagonalBasisRowsCode (machineDiagonalBasisCanonicalInput d R) = + rationalSquareMatrixRowsCode + (rationalBallEllipsoid d 0 R).basis := by + have hstate := congrArg machineDiagonalBasisMatrix + (machineDiagonalBasisIterate_semantics d R d le_rfl) + rw [machineDiagonalBasisRowsCode, machineDiagonalBasisFinalState] + have hruler : + (machineDiagonalBasisRuler + (machineDiagonalBasisCanonicalInput d R)).length = d := by + simp [machineDiagonalBasisRuler, machineDiagonalBasisCanonicalInput] + rw [hruler] + rw [hstate] + simp only [machineDiagonalBasisCanonicalState, + machineDiagonalBasisMatrix_pack] + rw [rationalDiagonalPrefixMatrix_all] + +/-! ## Complete ball state -/ + +/-- Input: `pair dimensionUnary radiusEntryCode`. -/ +def machineRationalBallStateCode (word : List Bool) : List Bool := + pair (machineLengthBits (machineDiagonalBasisRuler word)) + (pair + (machineRationalZeroVectorCode (machineDiagonalBasisRuler word)) + (machineDiagonalBasisRowsCode word)) + +theorem machineRationalBallStateCode_mem_FP : + machineRationalBallStateCode ∈ FP := by + have hdim := machineCompose_mem_FP machineDiagonalBasisRuler_mem_FP + machineLengthBits_mem_FP + have hcenter := machineCompose_mem_FP machineDiagonalBasisRuler_mem_FP + machineRationalZeroVectorCode_mem_FP + simpa only [machineRationalBallStateCode] using + machinePair_mem_FP hdim + (machinePair_mem_FP hcenter machineDiagonalBasisRowsCode_mem_FP) + +@[simp] theorem machineRationalBallStateCode_encode (d : ℕ) (R : ℚ) : + machineRationalBallStateCode (machineDiagonalBasisCanonicalInput d R) = + rationalEllipsoidStateBinaryCode + (rationalBallEllipsoid d 0 R) := by + rw [machineRationalBallStateCode] + simp only [machineDiagonalBasisRuler, + machineDiagonalBasisCanonicalInput, machinePairFirst_pair, + machineLengthBits_encode, List.length_replicate, + machineRationalZeroVectorCode_encode, + rationalEllipsoidStateBinaryCode, rationalBallEllipsoid_center] + change pair d.bits + (pair (rationalFiniteVectorCode (fun _ : Fin d ↦ (0 : ℚ))) + (machineDiagonalBasisRowsCode + (machineDiagonalBasisCanonicalInput d R))) = _ + rw [machineDiagonalBasisRowsCode_encode] + rfl + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalCompare.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalCompare.lean new file mode 100644 index 0000000000..5fc99faa7a --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalCompare.lean @@ -0,0 +1,77 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineIntegerCompare +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalArithmetic + +/-! +# Polynomial-time comparison of unreduced rationals + +Positive denominators allow comparison by signed cross multiplication. The +two cross-products are exactly the products already used by rational addition; +the final comparison is the verified signed-integer machine. +-/ + +namespace BeyondBethe + +open Complexity + +def machineRawRatLeBit (word : List Bool) : List Bool := + machineIntegerLeCode + (pair (machineRawAddLeftScaledNumerator word) + (machineRawAddRightScaledNumerator word)) + +theorem machineRawRatLeBit_mem_FP : machineRawRatLeBit ∈ Complexity.FP := by + have hpair := machinePair_mem_FP + machineRawAddLeftScaledNumerator_mem_FP + machineRawAddRightScaledNumerator_mem_FP + simpa only [machineRawRatLeBit] using + machineCompose_mem_FP hpair machineIntegerLeCode_mem_FP + +theorem machineRawRatLeBit_cross_encode (q r : RawRat) : + machineRawRatLeBit + (pair (rawRatBinaryCode q) (rawRatBinaryCode r)) = + [decide + (q.num * (r.den : ℤ) ≤ r.num * (q.den : ℤ))] := by + rw [machineRawRatLeBit, machineRawAddLeftScaledNumerator_encode, + machineRawAddRightScaledNumerator_encode, + machineIntegerLeCode_encode] + +theorem rawRat_value_le_iff_cross (q r : RawRat) : + q.value ≤ r.value ↔ + q.num * (r.den : ℤ) ≤ r.num * (q.den : ℤ) := by + constructor + · intro h + have hdiv : (q.num : ℚ) / (q.den : ℚ) ≤ + (r.num : ℚ) / (r.den : ℚ) := by + simpa only [RawRat.value] using h + have hcross := + (div_le_div_iff₀ (by exact_mod_cast q.den_pos : (0 : ℚ) < q.den) + (by exact_mod_cast r.den_pos : (0 : ℚ) < r.den)).1 hdiv + exact_mod_cast hcross + · intro h + have hcross : (q.num : ℚ) * (r.den : ℚ) ≤ + (r.num : ℚ) * (q.den : ℚ) := by + exact_mod_cast h + have hdiv : (q.num : ℚ) / (q.den : ℚ) ≤ + (r.num : ℚ) / (r.den : ℚ) := + (div_le_div_iff₀ (by exact_mod_cast q.den_pos : (0 : ℚ) < q.den) + (by exact_mod_cast r.den_pos : (0 : ℚ) < r.den)).2 hcross + simpa only [RawRat.value] using hdiv + +theorem machineRawRatLeBit_encode (q r : RawRat) : + machineRawRatLeBit + (pair (rawRatBinaryCode q) (rawRatBinaryCode r)) = + [decide (q.value ≤ r.value)] := by + rw [machineRawRatLeBit_cross_encode] + by_cases hcross : q.num * (r.den : ℤ) ≤ r.num * (q.den : ℤ) + · have hvalue := (rawRat_value_le_iff_cross q r).2 hcross + simp [hcross, hvalue] + · have hvalue : ¬ q.value ≤ r.value := by + exact fun h => hcross ((rawRat_value_le_iff_cross q r).1 h) + simp [hcross, hvalue] + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalDirectionUpdateMatrix.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalDirectionUpdateMatrix.lean new file mode 100644 index 0000000000..afed7388f4 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalDirectionUpdateMatrix.lean @@ -0,0 +1,811 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalDirectionUpdateRow +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalMatrixMul + +/-! +# Polynomial-time direction-update matrices + +This module maps the verified row constructor over all row indices. The +result is the full rational matrix used to update an ellipsoid basis. +-/ + +namespace BeyondBethe + +open Complexity + +def rationalDirectionUpdateMatrix {d : ℕ} (b : Fin d → ℚ) : + Matrix (Fin d) (Fin d) ℚ := + directionUpdateMatrix (rationalEllipsoidPerpScale d) + (rationalEllipsoidParallelScale d) b + +def rationalDirectionUpdateCanonicalWord {d : ℕ} + (b : Fin d → ℚ) : List Bool := + pair (List.replicate d true) + (pair d.bits (rationalFiniteVectorCode b)) + +def rawDirectionDiagonalEntry {d : ℕ} (i j : Fin d) : RawRat := + if i = j then rawEllipsoidPerpScale d else RawRat.zero + +def rawDirectionMatrixEntry {d : ℕ} + (b : Fin d → ℚ) (i j : Fin d) : RawRat := + (rawDirectionDiagonalEntry i j).sub + ((rawDirectionRowScale b i).mul (rawRatOfRat (b j))) + +@[simp] theorem rawDirectionDiagonalEntry_value {d : ℕ} + (i j : Fin d) : + (rawDirectionDiagonalEntry i j).value = + if i = j then rationalEllipsoidPerpScale d else 0 := by + by_cases h : i = j + · simp [rawDirectionDiagonalEntry, h] + · simp [rawDirectionDiagonalEntry, h] + +@[simp] theorem rawDirectionMatrixEntry_value {d : ℕ} + (b : Fin d → ℚ) (i j : Fin d) : + (rawDirectionMatrixEntry b i j).value = + rationalDirectionUpdateMatrix b i j := by + simp [rawDirectionMatrixEntry, rationalDirectionUpdateMatrix, + directionUpdateMatrix, sub_eq_add_neg] + +theorem rawEllipsoidDimension_width_le_direction_word {d : ℕ} + (b : Fin d → ℚ) : + rawRatWidth (rawEllipsoidDimension d) ≤ + (rationalDirectionUpdateCanonicalWord b).length := by + have hsmall : rawRatWidth (rawEllipsoidDimension d) ≤ d + 1 := by + simp [rawEllipsoidDimension, RawRat.ofNat, rawRatWidth] + rw [Nat.size_le] + have h := @Nat.lt_two_pow_self (d + 1) + omega + simp only [rationalDirectionUpdateCanonicalWord, pair_length, + List.length_replicate] at hsmall ⊢ + omega + +theorem rawDirection_b_width_le_word {d : ℕ} + (b : Fin d → ℚ) (i : Fin d) : + rawRatWidth (rawRatOfRat (b i)) ≤ + (rationalDirectionUpdateCanonicalWord b).length := by + have hcanonical := rawRatWidth_le_binaryCode_length (rawRatOfRat (b i)) + have helem := binaryListCode_element_length_le rationalEntryBinaryCode + (show b i ∈ List.ofFn b by simp) + have hvector : + (rationalEntryBinaryCode (b i)).length ≤ + (rationalFiniteVectorCode b).length := by + simpa only [rationalFiniteVectorCode] using helem + rw [rawRatBinaryCode_rawRatOfRat] at hcanonical + exact hcanonical.trans (hvector.trans (by + change (rationalFiniteVectorCode b).length ≤ + (pair (List.replicate d true) + (pair d.bits (rationalFiniteVectorCode b))).length + rw [pair_length, pair_length] + omega)) + +theorem rawDirectionNormSq_width_le_word {d : ℕ} + (b : Fin d → ℚ) : + rawRatWidth (rawDirectionNormSq b) ≤ + 1 + 2 * (rationalDirectionUpdateCanonicalWord b).length := by + let xs := List.ofFn b + have hwidth := rawRatWidth_listDot_le RawRat.zero xs xs + have hcost := rawRatListDotCost_le_codeLength xs xs + have hcode : + (binaryListCode rationalEntryBinaryCode xs).length ≤ + (rationalDirectionUpdateCanonicalWord b).length := by + simp only [xs, rationalFiniteVectorCode, + rationalDirectionUpdateCanonicalWord, pair_length, + List.length_replicate] + omega + change rawRatWidth (rawRatListDot RawRat.zero xs xs) ≤ _ + rw [rawRatWidth_zero] at hwidth + omega + +theorem rawEllipsoidPerpScale_width_le_direction_word {d : ℕ} + (b : Fin d → ℚ) : + rawRatWidth (rawEllipsoidPerpScale d) ≤ + 12 + 4 * (rationalDirectionUpdateCanonicalWord b).length := by + let W := (rationalDirectionUpdateCanonicalWord b).length + have hd := rawEllipsoidDimension_width_le_direction_word b + have hdsq := rawRatWidth_mul_le + (rawEllipsoidDimension d) (rawEllipsoidDimension d) + have hfour := rawRatWidth_mul_le rawEllipsoidFour + (rawEllipsoidDimensionSquare d) + have halpha := rawRatWidth_div_le rawEllipsoidOne + (rawEllipsoidFourDimensionSquare d) + have halphaSq := rawRatWidth_mul_le + (rawEllipsoidAlpha d) (rawEllipsoidAlpha d) + have htwice := rawRatWidth_mul_le rawEllipsoidTwo + (rawEllipsoidAlphaSquare d) + have hperp := rawRatWidth_add_le rawEllipsoidOne + (rawEllipsoidTwiceAlphaSquare d) + have hone : rawRatWidth rawEllipsoidOne = 1 := by rfl + have htwo : rawRatWidth rawEllipsoidTwo = 2 := by rfl + have hfourWidth : rawRatWidth rawEllipsoidFour = 3 := by rfl + have hd' : rawRatWidth (rawEllipsoidDimension d) ≤ W := by + simpa only [W] using hd + have hdsq0 : rawRatWidth (rawEllipsoidDimensionSquare d) ≤ + rawRatWidth (rawEllipsoidDimension d) + + rawRatWidth (rawEllipsoidDimension d) := by + simpa only [rawEllipsoidDimensionSquare] using hdsq + have hdsq' : rawRatWidth (rawEllipsoidDimensionSquare d) ≤ 2 * W := by + omega + have hfour' : rawRatWidth (rawEllipsoidFourDimensionSquare d) ≤ + 3 + 2 * W := by + have hfour0 : rawRatWidth (rawEllipsoidFourDimensionSquare d) ≤ + rawRatWidth rawEllipsoidFour + + rawRatWidth (rawEllipsoidDimensionSquare d) := by + simpa only [rawEllipsoidFourDimensionSquare] using hfour + omega + have halpha' : rawRatWidth (rawEllipsoidAlpha d) ≤ 4 + 2 * W := by + have halpha0 : rawRatWidth (rawEllipsoidAlpha d) ≤ + rawRatWidth rawEllipsoidOne + + rawRatWidth (rawEllipsoidFourDimensionSquare d) := by + simpa only [rawEllipsoidAlpha] using halpha + omega + have halphaSq' : rawRatWidth (rawEllipsoidAlphaSquare d) ≤ + 8 + 4 * W := by + have halphaSq0 : rawRatWidth (rawEllipsoidAlphaSquare d) ≤ + rawRatWidth (rawEllipsoidAlpha d) + + rawRatWidth (rawEllipsoidAlpha d) := by + simpa only [rawEllipsoidAlphaSquare] using halphaSq + omega + have htwice' : rawRatWidth (rawEllipsoidTwiceAlphaSquare d) ≤ + 10 + 4 * W := by + have htwice0 : rawRatWidth (rawEllipsoidTwiceAlphaSquare d) ≤ + rawRatWidth rawEllipsoidTwo + + rawRatWidth (rawEllipsoidAlphaSquare d) := by + simpa only [rawEllipsoidTwiceAlphaSquare] using htwice + omega + have hperp' : rawRatWidth (rawEllipsoidPerpScale d) ≤ 12 + 4 * W := by + have hperp0 : rawRatWidth (rawEllipsoidPerpScale d) ≤ + rawRatWidth rawEllipsoidOne + + rawRatWidth (rawEllipsoidTwiceAlphaSquare d) + 1 := by + simpa only [rawEllipsoidPerpScale] using hperp + omega + simpa only [W] using hperp' + +theorem rawEllipsoidParallelScale_width_le_direction_word {d : ℕ} + (b : Fin d → ℚ) : + rawRatWidth (rawEllipsoidParallelScale d) ≤ + 6 + 3 * (rationalDirectionUpdateCanonicalWord b).length := by + let W := (rationalDirectionUpdateCanonicalWord b).length + have hd := rawEllipsoidDimension_width_le_direction_word b + have hdsq := rawRatWidth_mul_le + (rawEllipsoidDimension d) (rawEllipsoidDimension d) + have hfour := rawRatWidth_mul_le rawEllipsoidFour + (rawEllipsoidDimensionSquare d) + have halpha := rawRatWidth_div_le rawEllipsoidOne + (rawEllipsoidFourDimensionSquare d) + have hover := rawRatWidth_div_le (rawEllipsoidAlpha d) + (rawEllipsoidDimension d) + have hparallel := rawRatWidth_sub_le rawEllipsoidOne + (rawEllipsoidAlphaOverDimension d) + have hone : rawRatWidth rawEllipsoidOne = 1 := by rfl + have hfourWidth : rawRatWidth rawEllipsoidFour = 3 := by rfl + have hd' : rawRatWidth (rawEllipsoidDimension d) ≤ W := by + simpa only [W] using hd + have hdsq0 : rawRatWidth (rawEllipsoidDimensionSquare d) ≤ + rawRatWidth (rawEllipsoidDimension d) + + rawRatWidth (rawEllipsoidDimension d) := by + simpa only [rawEllipsoidDimensionSquare] using hdsq + have hdsq' : rawRatWidth (rawEllipsoidDimensionSquare d) ≤ 2 * W := by + omega + have hfour' : rawRatWidth (rawEllipsoidFourDimensionSquare d) ≤ + 3 + 2 * W := by + have hfour0 : rawRatWidth (rawEllipsoidFourDimensionSquare d) ≤ + rawRatWidth rawEllipsoidFour + + rawRatWidth (rawEllipsoidDimensionSquare d) := by + simpa only [rawEllipsoidFourDimensionSquare] using hfour + omega + have halpha' : rawRatWidth (rawEllipsoidAlpha d) ≤ 4 + 2 * W := by + have halpha0 : rawRatWidth (rawEllipsoidAlpha d) ≤ + rawRatWidth rawEllipsoidOne + + rawRatWidth (rawEllipsoidFourDimensionSquare d) := by + simpa only [rawEllipsoidAlpha] using halpha + omega + have hover' : rawRatWidth (rawEllipsoidAlphaOverDimension d) ≤ + 4 + 3 * W := by + have hover0 : rawRatWidth (rawEllipsoidAlphaOverDimension d) ≤ + rawRatWidth (rawEllipsoidAlpha d) + + rawRatWidth (rawEllipsoidDimension d) := by + simpa only [rawEllipsoidAlphaOverDimension] using hover + omega + have hparallel' : rawRatWidth (rawEllipsoidParallelScale d) ≤ + 6 + 3 * W := by + have hparallel0 : rawRatWidth (rawEllipsoidParallelScale d) ≤ + rawRatWidth rawEllipsoidOne + + rawRatWidth (rawEllipsoidAlphaOverDimension d) + 1 := by + simpa only [rawEllipsoidParallelScale] using hparallel + omega + simpa only [W] using hparallel' + +theorem rawDirectionMatrixEntry_width_le_word {d : ℕ} + (b : Fin d → ℚ) (i j : Fin d) : + rawRatWidth (rawDirectionMatrixEntry b i j) ≤ + 33 + 15 * (rationalDirectionUpdateCanonicalWord b).length := by + let W := (rationalDirectionUpdateCanonicalWord b).length + have hperp := rawEllipsoidPerpScale_width_le_direction_word b + have hparallel := rawEllipsoidParallelScale_width_le_direction_word b + have hnorm := rawDirectionNormSq_width_le_word b + have hbi := rawDirection_b_width_le_word b i + have hbj := rawDirection_b_width_le_word b j + have hperp' : rawRatWidth (rawEllipsoidPerpScale d) ≤ 12 + 4 * W := by + simpa only [W] using hperp + have hparallel' : rawRatWidth (rawEllipsoidParallelScale d) ≤ + 6 + 3 * W := by simpa only [W] using hparallel + have hnorm' : rawRatWidth (rawDirectionNormSq b) ≤ 1 + 2 * W := by + simpa only [W] using hnorm + have hbi' : rawRatWidth (rawRatOfRat (b i)) ≤ W := by + simpa only [W] using hbi + have hbj' : rawRatWidth (rawRatOfRat (b j)) ≤ W := by + simpa only [W] using hbj + have hgap' : rawRatWidth (rawDirectionGap d) ≤ 19 + 7 * W := by + calc + _ = rawRatWidth ((rawEllipsoidPerpScale d).sub + (rawEllipsoidParallelScale d)) := rfl + _ ≤ rawRatWidth (rawEllipsoidPerpScale d) + + rawRatWidth (rawEllipsoidParallelScale d) + 1 := + rawRatWidth_sub_le _ _ + _ ≤ 19 + 7 * W := by omega + have hcoeff' : rawRatWidth (rawDirectionCoefficient b) ≤ + 20 + 9 * W := by + calc + _ = rawRatWidth ((rawDirectionGap d).div + (rawDirectionNormSq b)) := rfl + _ ≤ rawRatWidth (rawDirectionGap d) + + rawRatWidth (rawDirectionNormSq b) := rawRatWidth_div_le _ _ + _ ≤ 20 + 9 * W := by omega + have hrowScale' : rawRatWidth (rawDirectionRowScale b i) ≤ + 20 + 10 * W := by + calc + _ = rawRatWidth ((rawDirectionCoefficient b).mul + (rawRatOfRat (b i))) := rfl + _ ≤ rawRatWidth (rawDirectionCoefficient b) + + rawRatWidth (rawRatOfRat (b i)) := rawRatWidth_mul_le _ _ + _ ≤ 20 + 10 * W := by omega + have hproduct' : rawRatWidth + ((rawDirectionRowScale b i).mul (rawRatOfRat (b j))) ≤ + 20 + 11 * W := by + exact (rawRatWidth_mul_le _ _).trans (by omega) + have hdiag : rawRatWidth (rawDirectionDiagonalEntry i j) ≤ + 12 + 4 * W := by + by_cases hij : i = j + · simpa only [rawDirectionDiagonalEntry, hij, if_true] using hperp + · simp only [rawDirectionDiagonalEntry, hij, if_false, rawRatWidth_zero] + omega + calc + _ = rawRatWidth ((rawDirectionDiagonalEntry i j).sub + ((rawDirectionRowScale b i).mul (rawRatOfRat (b j)))) := rfl + _ ≤ rawRatWidth (rawDirectionDiagonalEntry i j) + + rawRatWidth ((rawDirectionRowScale b i).mul + (rawRatOfRat (b j))) + 1 := rawRatWidth_sub_le _ _ + _ ≤ 33 + 15 * W := by omega + +theorem rationalDirectionMatrix_entry_code_length_le {d : ℕ} + (b : Fin d → ℚ) (i j : Fin d) : + (rationalEntryBinaryCode (rationalDirectionUpdateMatrix b i j)).length ≤ + 1252 + 540 * (rationalDirectionUpdateCanonicalWord b).length := by + have hcanonical := + rationalEntryBinaryCode_binaryNormalizeRawRat_length_le + (rawDirectionMatrixEntry b i j) + rw [binaryNormalizeRawRat_eq_value, + rawDirectionMatrixEntry_value] at hcanonical + have hwidth := rawDirectionMatrixEntry_width_le_word b i j + exact hcanonical.trans (by nlinarith) + +def machineRationalDirectionUpdateMatrixInputBound + (word : List Bool) : List Bool := + machineRationalTransposeMulVectorInputBound word + +theorem machineRationalDirectionUpdateMatrixInputBound_mem_FP : + machineRationalDirectionUpdateMatrixInputBound ∈ FP := + machineRationalTransposeMulVectorInputBound_mem_FP + +theorem rationalDirectionUpdateMatrix_code_length_le_cubic {d : ℕ} + (b : Fin d → ℚ) : + (rationalSquareMatrixRowsCode + (rationalDirectionUpdateMatrix b)).length ≤ + d * (2 * (d * + (2 * (1252 + 540 * + (rationalDirectionUpdateCanonicalWord b).length) + 2)) + 2) := by + let L := 1252 + 540 * (rationalDirectionUpdateCanonicalWord b).length + have hentry : ∀ i j : Fin d, + (rationalEntryBinaryCode + (rationalDirectionUpdateMatrix b i j)).length ≤ L := by + intro i j + exact rationalDirectionMatrix_entry_code_length_le b i j + rw [rationalSquareMatrixRowsCode, binaryListCode_length_eq_sum] + simp only [rationalMatrixRows, List.map_ofFn, List.sum_ofFn, + Function.comp_apply] + calc + (∑ i : Fin d, + (2 * (binaryListCode rationalEntryBinaryCode + (List.ofFn fun j ↦ rationalDirectionUpdateMatrix b i j)).length + + 2)) ≤ + ∑ _i : Fin d, (2 * (d * (2 * L + 2)) + 2) := by + apply Finset.sum_le_sum + intro i _ + gcongr + rw [binaryListCode_length_eq_sum] + simp only [List.map_ofFn, List.sum_ofFn, Function.comp_apply] + calc + (∑ j : Fin d, + (2 * (rationalEntryBinaryCode + (rationalDirectionUpdateMatrix b i j)).length + 2)) ≤ + ∑ _j : Fin d, (2 * L + 2) := by + apply Finset.sum_le_sum + intro j _ + have h := hentry i j + omega + _ = d * (2 * L + 2) := by simp + _ = d * (2 * (d * (2 * L + 2)) + 2) := by simp + +theorem rationalDirectionUpdateMatrix_code_length_le_bound {d : ℕ} + (b : Fin d → ℚ) : + (rationalSquareMatrixRowsCode + (rationalDirectionUpdateMatrix b)).length ≤ + (machineRationalDirectionUpdateMatrixInputBound + (rationalDirectionUpdateCanonicalWord b)).length := by + let word := rationalDirectionUpdateCanonicalWord b + let n := word.length + let x := 16 + n + let y := 16 + x ^ 2 + let z := 16 + y ^ 2 + have hd : d ≤ word.length := by + have h := machinePairFirst_length_le word + simpa only [word, rationalDirectionUpdateCanonicalWord, + machinePairFirst_pair, List.length_replicate] using h + have hn4 : 4 ≤ n := by + simp only [n, word, rationalDirectionUpdateCanonicalWord, + pair_length, List.length_replicate] + omega + have hcubic := rationalDirectionUpdateMatrix_code_length_le_cubic b + have hd' : d ≤ n := by simpa only [n] using hd + have hdn : d * n ≤ n * n := Nat.mul_le_mul hd' le_rfl + have hdd : d * d ≤ n * n := Nat.mul_le_mul hd' hd' + have hddn : (d * d) * n ≤ (n * n) * n := + Nat.mul_le_mul hdd le_rfl + have hpoly : + d * (2 * (d * (2 * (1252 + 540 * n) + 2)) + 2) ≤ + 4000 * n ^ 3 := by + nlinarith + have hout : + (rationalSquareMatrixRowsCode + (rationalDirectionUpdateMatrix b)).length ≤ 4000 * n ^ 3 := by + apply hcubic.trans + simpa only [n, word] using hpoly + have hnx : n ≤ x := by simp [x] + have hxpos : 0 < x := by omega + have h4000 : 4000 ≤ x ^ 3 := by + dsimp only [x] + nlinarith + have hnx3 : n ^ 3 ≤ x ^ 3 := Nat.pow_le_pow_left hnx 3 + have hto6 : 4000 * n ^ 3 ≤ x ^ 6 := by + have h := Nat.mul_le_mul h4000 hnx3 + simpa only [← pow_add] using h + have hto8 : x ^ 6 ≤ x ^ 8 := + Nat.pow_le_pow_right hxpos (by omega) + have hxy : x ^ 2 ≤ y := by simp [y] + have hx4y2 : x ^ 4 ≤ y ^ 2 := by + have h := Nat.pow_le_pow_left hxy 2 + simpa only [← pow_mul] using h + have hyz : y ^ 2 ≤ z := by simp [z] + have hx4z : x ^ 4 ≤ z := hx4y2.trans hyz + have hx8z2 : x ^ 8 ≤ z ^ 2 := by + have h := Nat.pow_le_pow_left hx4z 2 + simpa only [← pow_mul] using h + apply hout.trans + apply hto6.trans + apply hto8.trans + apply hx8z2.trans_eq + simp only [machineRationalDirectionUpdateMatrixInputBound, + machineRationalTransposeMulVectorInputBound, + machineBinaryMulWidth, List.length_replicate, + List.length_append, n, x, y, z, word, pow_two] + +/-! ## Bounded outer row scan -/ + +def machineRationalDirectionUpdateMatrixIndices + (word : List Bool) : List Bool := + machineUnaryRangeCode (machinePairFirst word) + +def machineRationalDirectionUpdateMatrixCurrentRow + (state : List Bool) : List Bool := + machineRationalDirectionUpdateRowCode + (pair (machineRationalTransposeMulVectorCurrentIndex state) + (machineRationalTransposeMulVectorStatePayload state)) + +def machineRationalDirectionUpdateMatrixCandidate + (state : List Bool) : List Bool := + pair (machineRationalDirectionUpdateMatrixCurrentRow state) + (machineRationalTransposeMulVectorAccumulator state) + +def machineRationalDirectionUpdateMatrixNextAccumulator + (state : List Bool) : List Bool := + (machineRationalDirectionUpdateMatrixCandidate state).take + (machineRationalTransposeMulVectorBound state).length + +def machineRationalDirectionUpdateMatrixAdvance + (state : List Bool) : List Bool := + machineRationalTransposeMulVectorPack + (machineListTail (machineRationalTransposeMulVectorRemaining state)) + (machineRationalDirectionUpdateMatrixNextAccumulator state) + (machineRationalTransposeMulVectorStatePayload state) + (machineRationalTransposeMulVectorBound state) + +def machineRationalDirectionUpdateMatrixStep + (state : List Bool) : List Bool := + machineIfEmpty (machineRationalTransposeMulVectorRemaining state) state + (machineRationalDirectionUpdateMatrixAdvance state) + +def machineRationalDirectionUpdateMatrixInit + (word : List Bool) : List Bool := + machineRationalTransposeMulVectorPack + (machineRationalDirectionUpdateMatrixIndices word) [] word + (machineRationalDirectionUpdateMatrixInputBound word) + +def machineRationalDirectionUpdateMatrixWidth + (word : List Bool) : List Bool := + let bound := machineRationalDirectionUpdateMatrixInputBound word + machineRationalTransposeMulVectorPack bound bound bound bound + +def machineRationalDirectionUpdateMatrixFinalState + (word : List Bool) : List Bool := + (machineRationalDirectionUpdateMatrixStep)^[word.length] + (machineRationalDirectionUpdateMatrixInit word) + +def machineRationalDirectionUpdateMatrixReversedCode + (word : List Bool) : List Bool := + machineRationalTransposeMulVectorAccumulator + (machineRationalDirectionUpdateMatrixFinalState word) + +/-- Input: `pair dimensionUnary (pair dimensionBits vectorCode)`. -/ +def machineRationalDirectionUpdateMatrixCode + (word : List Bool) : List Bool := + machineListReverse + (machineRationalDirectionUpdateMatrixReversedCode word) + +theorem machineRationalDirectionUpdateMatrixIndices_mem_FP : + machineRationalDirectionUpdateMatrixIndices ∈ FP := by + simpa only [machineRationalDirectionUpdateMatrixIndices] using + machineCompose_mem_FP machinePairFirst_mem_FP + machineUnaryRangeCode_mem_FP + +theorem machineRationalDirectionUpdateMatrixCurrentRow_mem_FP : + machineRationalDirectionUpdateMatrixCurrentRow ∈ FP := by + have hinput := machinePair_mem_FP + machineRationalTransposeMulVectorCurrentIndex_mem_FP + machineRationalTransposeMulVectorStatePayload_mem_FP + simpa only [machineRationalDirectionUpdateMatrixCurrentRow] using + machineCompose_mem_FP hinput + machineRationalDirectionUpdateRowCode_mem_FP + +theorem machineRationalDirectionUpdateMatrixCandidate_mem_FP : + machineRationalDirectionUpdateMatrixCandidate ∈ FP := + machinePair_mem_FP machineRationalDirectionUpdateMatrixCurrentRow_mem_FP + machineRationalTransposeMulVectorAccumulator_mem_FP + +theorem machineRationalDirectionUpdateMatrixNextAccumulator_mem_FP : + machineRationalDirectionUpdateMatrixNextAccumulator ∈ FP := by + simpa only [machineRationalDirectionUpdateMatrixNextAccumulator] using + machineTake_mem_FP machineRationalTransposeMulVectorBound_mem_FP + machineRationalDirectionUpdateMatrixCandidate_mem_FP + +theorem machineRationalDirectionUpdateMatrixAdvance_mem_FP : + machineRationalDirectionUpdateMatrixAdvance ∈ FP := by + have htail := machineCompose_mem_FP + machineRationalTransposeMulVectorRemaining_mem_FP machineListTail_mem_FP + exact machinePair_mem_FP htail + (machinePair_mem_FP + machineRationalDirectionUpdateMatrixNextAccumulator_mem_FP + (machinePair_mem_FP + machineRationalTransposeMulVectorStatePayload_mem_FP + machineRationalTransposeMulVectorBound_mem_FP)) + +theorem machineRationalDirectionUpdateMatrixStep_mem_FP : + machineRationalDirectionUpdateMatrixStep ∈ FP := + machineIfEmpty_mem_FP machineRationalTransposeMulVectorRemaining_mem_FP + id_mem_FP machineRationalDirectionUpdateMatrixAdvance_mem_FP + +theorem machineRationalDirectionUpdateMatrixInit_mem_FP : + machineRationalDirectionUpdateMatrixInit ∈ FP := by + exact machinePair_mem_FP + machineRationalDirectionUpdateMatrixIndices_mem_FP + (machinePair_mem_FP (machineConst_mem_FP []) + (machinePair_mem_FP id_mem_FP + machineRationalDirectionUpdateMatrixInputBound_mem_FP)) + +theorem machineRationalDirectionUpdateMatrixWidth_mem_FP : + machineRationalDirectionUpdateMatrixWidth ∈ FP := by + have hbound := machineRationalDirectionUpdateMatrixInputBound_mem_FP + exact machinePair_mem_FP hbound + (machinePair_mem_FP hbound (machinePair_mem_FP hbound hbound)) + +theorem machineRationalDirectionUpdateMatrixInit_bound + (word : List Bool) : + MachineRationalTransposeMulVectorStateBound word + (machineRationalDirectionUpdateMatrixInit word) := by + simp only [MachineRationalTransposeMulVectorStateBound, + machineRationalDirectionUpdateMatrixInit, + machineRationalTransposeMulVectorRemaining_pack, + machineRationalTransposeMulVectorAccumulator_pack, + machineRationalTransposeMulVectorStatePayload_pack, + machineRationalTransposeMulVectorBound_pack, + machineRationalDirectionUpdateMatrixInputBound] + refine ⟨trivial, ?_, by simp, ?_, trivial⟩ + · simpa only [machineRationalDirectionUpdateMatrixIndices, + machineRationalTransposeMulVectorIndices, + machineRationalTransposeMulVectorDimension] using + machineRationalTransposeMulVector_indices_le_bound word + · exact machineRationalTransposeMulVector_word_le_bound word + +theorem machineRationalDirectionUpdateMatrixStep_bound + {word state : List Bool} + (hs : MachineRationalTransposeMulVectorStateBound word state) : + MachineRationalTransposeMulVectorStateBound word + (machineRationalDirectionUpdateMatrixStep state) := by + dsimp only [MachineRationalTransposeMulVectorStateBound] at hs ⊢ + rcases hs with ⟨hdecomp, hremaining, hacc, hpayload, hbound⟩ + by_cases hnil : machineRationalTransposeMulVectorRemaining state = [] + · rw [machineRationalDirectionUpdateMatrixStep, hnil, + machineIfEmpty_nil] + exact ⟨hdecomp, hremaining, hacc, hpayload, hbound⟩ + · cases hcode : machineRationalTransposeMulVectorRemaining state with + | nil => exact False.elim (hnil hcode) + | cons bit tail => + rw [machineRationalDirectionUpdateMatrixStep, hcode, + machineIfEmpty_cons, + machineRationalDirectionUpdateMatrixAdvance] + simp only [machineRationalTransposeMulVectorRemaining_pack, + machineRationalTransposeMulVectorAccumulator_pack, + machineRationalTransposeMulVectorStatePayload_pack, + machineRationalTransposeMulVectorBound_pack] + refine ⟨trivial, ?_, ?_, hpayload, hbound⟩ + · exact (machineListTail_length_le + (machineRationalTransposeMulVectorRemaining state)).trans + hremaining + · rw [machineRationalDirectionUpdateMatrixNextAccumulator, hbound] + exact List.length_take_le _ _ + +theorem machineRationalDirectionUpdateMatrixIterate_bound + (word : List Bool) : ∀ k, + MachineRationalTransposeMulVectorStateBound word + ((machineRationalDirectionUpdateMatrixStep)^[k] + (machineRationalDirectionUpdateMatrixInit word)) := by + intro k + induction k with + | zero => exact machineRationalDirectionUpdateMatrixInit_bound word + | succ k ih => + rw [Function.iterate_succ_apply'] + exact machineRationalDirectionUpdateMatrixStep_bound ih + +theorem machineRationalDirectionUpdateMatrixIterate_length_le_width + (word : List Bool) (iterations : ℕ) + (_ : iterations ≤ word.length) : + ((machineRationalDirectionUpdateMatrixStep)^[iterations] + (machineRationalDirectionUpdateMatrixInit word)).length ≤ + (machineRationalDirectionUpdateMatrixWidth word).length := by + rcases machineRationalDirectionUpdateMatrixIterate_bound word iterations with + ⟨hdecomp, hremaining, hacc, hpayload, hbound⟩ + rw [hdecomp, hbound] + simp only [machineRationalTransposeMulVectorPack, + machineRationalDirectionUpdateMatrixWidth, + machineRationalDirectionUpdateMatrixInputBound, pair_length] + omega + +theorem machineRationalDirectionUpdateMatrixFinalState_mem_FP : + machineRationalDirectionUpdateMatrixFinalState ∈ FP := by + exact Cobham.iterate_mem_FP + machineRationalDirectionUpdateMatrixStep_mem_FP + machineRationalDirectionUpdateMatrixInit_mem_FP id_mem_FP + machineRationalDirectionUpdateMatrixWidth_mem_FP + machineRationalDirectionUpdateMatrixIterate_length_le_width + +theorem machineRationalDirectionUpdateMatrixReversedCode_mem_FP : + machineRationalDirectionUpdateMatrixReversedCode ∈ FP := by + simpa only [machineRationalDirectionUpdateMatrixReversedCode] using + machineCompose_mem_FP + machineRationalDirectionUpdateMatrixFinalState_mem_FP + machineRationalTransposeMulVectorAccumulator_mem_FP + +theorem machineRationalDirectionUpdateMatrixCode_mem_FP : + machineRationalDirectionUpdateMatrixCode ∈ FP := by + simpa only [machineRationalDirectionUpdateMatrixCode] using + machineCompose_mem_FP + machineRationalDirectionUpdateMatrixReversedCode_mem_FP + machineListReverse_mem_FP + +/-! ## Exact scan semantics -/ + +def rationalDirectionUpdateRowsPrefix {d : ℕ} + (b : Fin d → ℚ) (k : ℕ) : List (List ℚ) := + ((List.finRange d).take k).map + fun i ↦ List.ofFn fun j ↦ rationalDirectionUpdateMatrix b i j + +def machineRationalDirectionUpdateMatrixSemanticState {d : ℕ} + (b : Fin d → ℚ) (k : ℕ) : List Bool := + let word := rationalDirectionUpdateCanonicalWord b + machineRationalTransposeMulVectorPack + (binaryListCode finUnaryCode ((List.finRange d).drop k)) + (binaryListCode (binaryListCode rationalEntryBinaryCode) + (rationalDirectionUpdateRowsPrefix b k).reverse) + word (machineRationalDirectionUpdateMatrixInputBound word) + +theorem machineRationalDirectionUpdateMatrixInit_semantics {d : ℕ} + (b : Fin d → ℚ) : + machineRationalDirectionUpdateMatrixInit + (rationalDirectionUpdateCanonicalWord b) = + machineRationalDirectionUpdateMatrixSemanticState b 0 := by + simp [machineRationalDirectionUpdateMatrixInit, + machineRationalDirectionUpdateMatrixSemanticState, + machineRationalDirectionUpdateMatrixIndices, + rationalDirectionUpdateCanonicalWord, + machineUnaryRangeCode_encode, finRangeUnaryCode, + rationalDirectionUpdateRowsPrefix, binaryListCode] + +theorem rationalDirectionUpdateRowsPrefix_succ {d : ℕ} + (b : Fin d → ℚ) (k : ℕ) (hk : k < d) : + rationalDirectionUpdateRowsPrefix b (k + 1) = + rationalDirectionUpdateRowsPrefix b k ++ + [List.ofFn fun j ↦ rationalDirectionUpdateMatrix b ⟨k, hk⟩ j] := by + simp only [rationalDirectionUpdateRowsPrefix, List.map_take] + have hkm : k < (List.finRange d).length := by simpa + simpa [List.getElem_finRange] using + congrArg (List.map fun i ↦ + List.ofFn fun j ↦ rationalDirectionUpdateMatrix b i j) + (List.take_concat_get hkm).symm + +theorem machineRationalDirectionUpdateMatrixStep_semantics {d : ℕ} + (b : Fin d → ℚ) (k : ℕ) (hk : k < d) : + machineRationalDirectionUpdateMatrixStep + (machineRationalDirectionUpdateMatrixSemanticState b k) = + machineRationalDirectionUpdateMatrixSemanticState b (k + 1) := by + let word := rationalDirectionUpdateCanonicalWord b + let i : Fin d := ⟨k, hk⟩ + have hdrop : + (List.finRange d).drop k = + i :: (List.finRange d).drop (k + 1) := by + convert List.drop_eq_getElem_cons + (show k < (List.finRange d).length by simpa) using 1 + simp [i, List.getElem_finRange] + have hprefix := rationalDirectionUpdateRowsPrefix_succ b k hk + have hreverse : + (rationalDirectionUpdateRowsPrefix b (k + 1)).reverse = + (List.ofFn fun j ↦ rationalDirectionUpdateMatrix b i j) :: + (rationalDirectionUpdateRowsPrefix b k).reverse := by + rw [hprefix, List.reverse_append] + simp [i] + have hcand : + (binaryListCode (binaryListCode rationalEntryBinaryCode) + (rationalDirectionUpdateRowsPrefix b (k + 1)).reverse).length ≤ + (machineRationalDirectionUpdateMatrixInputBound word).length := by + have hprefixBound := binaryListCode_take_reverse_length_le + (binaryListCode rationalEntryBinaryCode) + (rationalMatrixRows (rationalDirectionUpdateMatrix b)) (k + 1) + have hprefixEq : rationalDirectionUpdateRowsPrefix b (k + 1) = + (rationalMatrixRows + (rationalDirectionUpdateMatrix b)).take (k + 1) := by + apply List.ext_getElem + · simp [rationalDirectionUpdateRowsPrefix, rationalMatrixRows] + · intro r hrLeft hrRight + simp [rationalDirectionUpdateRowsPrefix, rationalMatrixRows, + List.getElem_finRange] + rw [hprefixEq] + exact hprefixBound.trans + (rationalDirectionUpdateMatrix_code_length_le_bound b) + have hcandPair : + (pair + (binaryListCode rationalEntryBinaryCode + (List.ofFn fun j ↦ rationalDirectionUpdateMatrix b i j)) + (binaryListCode (binaryListCode rationalEntryBinaryCode) + (rationalDirectionUpdateRowsPrefix b k).reverse)).length ≤ + (machineRationalDirectionUpdateMatrixInputBound word).length := by + simpa only [hreverse, binaryListCode] using hcand + have hnonempty : + binaryListCode finUnaryCode ((List.finRange d).drop k) ≠ [] := by + rw [hdrop] + exact binaryListCode_cons_ne_nil finUnaryCode i + ((List.finRange d).drop (k + 1)) + rw [machineRationalDirectionUpdateMatrixStep] + simp only [machineRationalDirectionUpdateMatrixSemanticState, + machineRationalTransposeMulVectorRemaining_pack] + rw [machineIfEmpty_of_ne_nil_matrix _ _ _ hnonempty, + machineRationalDirectionUpdateMatrixAdvance] + simp only [machineRationalTransposeMulVectorRemaining_pack, + machineRationalTransposeMulVectorAccumulator_pack, + machineRationalTransposeMulVectorStatePayload_pack, + machineRationalTransposeMulVectorBound_pack, + machineRationalDirectionUpdateMatrixNextAccumulator, + machineRationalDirectionUpdateMatrixCandidate, + machineRationalDirectionUpdateMatrixCurrentRow, + machineRationalTransposeMulVectorCurrentIndex] + rw [hdrop, machineListHead_cons, machineListTail_cons] + change machineRationalTransposeMulVectorPack _ + ((pair (machineRationalDirectionUpdateRowCode + (pair (finUnaryCode i) word)) + (binaryListCode (binaryListCode rationalEntryBinaryCode) + (rationalDirectionUpdateRowsPrefix b k).reverse)).take + (machineRationalDirectionUpdateMatrixInputBound word).length) _ _ = _ + dsimp only [word, rationalDirectionUpdateCanonicalWord] + rw [show finUnaryCode i = List.replicate i.1 true by rfl, + machineRationalDirectionUpdateRowCode_encode] + change machineRationalTransposeMulVectorPack _ + ((pair (binaryListCode rationalEntryBinaryCode + (List.ofFn fun j ↦ rationalDirectionUpdateMatrix b i j)) + (binaryListCode (binaryListCode rationalEntryBinaryCode) + (rationalDirectionUpdateRowsPrefix b k).reverse)).take + (machineRationalDirectionUpdateMatrixInputBound word).length) _ _ = _ + rw [List.take_of_length_le hcandPair, hreverse] + rfl + +theorem machineRationalDirectionUpdateMatrixIterate_semantics {d : ℕ} + (b : Fin d → ℚ) : ∀ k ≤ d, + (machineRationalDirectionUpdateMatrixStep)^[k] + (machineRationalDirectionUpdateMatrixInit + (rationalDirectionUpdateCanonicalWord b)) = + machineRationalDirectionUpdateMatrixSemanticState b k := by + intro k hk + induction k with + | zero => exact machineRationalDirectionUpdateMatrixInit_semantics b + | succ k ih => + rw [Function.iterate_succ_apply', ih (by omega)] + exact machineRationalDirectionUpdateMatrixStep_semantics b k (by omega) + +theorem machineRationalDirectionUpdateMatrix_done_iterate + (extra : ℕ) (accumulator payload bound : List Bool) : + (machineRationalDirectionUpdateMatrixStep)^[extra] + (machineRationalTransposeMulVectorPack [] accumulator payload bound) = + machineRationalTransposeMulVectorPack [] accumulator payload bound := by + induction extra with + | zero => rfl + | succ k ih => + rw [Function.iterate_succ_apply', ih] + simp [machineRationalDirectionUpdateMatrixStep] + +theorem rationalDirectionUpdateRowsPrefix_all {d : ℕ} + (b : Fin d → ℚ) : + rationalDirectionUpdateRowsPrefix b d = + rationalMatrixRows (rationalDirectionUpdateMatrix b) := by + apply List.ext_getElem + · simp [rationalDirectionUpdateRowsPrefix, rationalMatrixRows] + · intro i hiLeft hiRight + simp [rationalDirectionUpdateRowsPrefix, rationalMatrixRows, + List.getElem_finRange] + +theorem machineRationalDirectionUpdateMatrixReversedCode_encode {d : ℕ} + (b : Fin d → ℚ) : + machineRationalDirectionUpdateMatrixReversedCode + (rationalDirectionUpdateCanonicalWord b) = + binaryListCode (binaryListCode rationalEntryBinaryCode) + (rationalMatrixRows (rationalDirectionUpdateMatrix b)).reverse := by + let word := rationalDirectionUpdateCanonicalWord b + have hd : d ≤ word.length := by + have h := machinePairFirst_length_le word + simpa only [word, rationalDirectionUpdateCanonicalWord, + machinePairFirst_pair, List.length_replicate] using h + have hsplit : word.length = (word.length - d) + d := by omega + change machineRationalDirectionUpdateMatrixReversedCode word = _ + rw [machineRationalDirectionUpdateMatrixReversedCode, + machineRationalDirectionUpdateMatrixFinalState, hsplit, + Function.iterate_add_apply, + machineRationalDirectionUpdateMatrixIterate_semantics b d le_rfl] + simp only [machineRationalDirectionUpdateMatrixSemanticState] + rw [show binaryListCode finUnaryCode ((List.finRange d).drop d) = [] by + rw [List.drop_eq_nil_of_le (by simp)] + rfl] + rw [machineRationalDirectionUpdateMatrix_done_iterate] + simp only [machineRationalTransposeMulVectorAccumulator_pack] + rw [rationalDirectionUpdateRowsPrefix_all] + +@[simp] theorem machineRationalDirectionUpdateMatrixCode_encode {d : ℕ} + (b : Fin d → ℚ) : + machineRationalDirectionUpdateMatrixCode + (rationalDirectionUpdateCanonicalWord b) = + rationalSquareMatrixRowsCode (rationalDirectionUpdateMatrix b) := by + rw [machineRationalDirectionUpdateMatrixCode, + machineRationalDirectionUpdateMatrixReversedCode_encode, + machineListReverse_encode, List.reverse_reverse] + rfl + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalDirectionUpdateRow.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalDirectionUpdateRow.lean new file mode 100644 index 0000000000..985af2aeae --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalDirectionUpdateRow.lean @@ -0,0 +1,414 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalBallInit +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalEllipsoidCenterUpdate + +/-! +# Polynomial-time rows of the ellipsoid direction update + +For a unary row index `i`, dimension, and cut-direction vector `b`, this +module constructs the `i`th row of the rank-one matrix + +`A I - ((A-p) / ||b||^2) b b^T`. + +The diagonal row is built by updating an encoded zero vector, while the +rank-one row is produced by one scalar-vector multiplication. +-/ + +namespace BeyondBethe + +open Complexity + +def rationalDirectionDiagonalRow {d : ℕ} + (A : ℚ) (i : Fin d) : Fin d → ℚ := + fun j ↦ if i = j then A else 0 + +def rawDirectionNormSq {d : ℕ} (b : Fin d → ℚ) : RawRat := + rawRatListDot RawRat.zero (List.ofFn b) (List.ofFn b) + +def rawDirectionGap (d : ℕ) : RawRat := + (rawEllipsoidPerpScale d).sub (rawEllipsoidParallelScale d) + +def rawDirectionCoefficient {d : ℕ} (b : Fin d → ℚ) : RawRat := + (rawDirectionGap d).div (rawDirectionNormSq b) + +def rawDirectionRowScale {d : ℕ} + (b : Fin d → ℚ) (i : Fin d) : RawRat := + (rawDirectionCoefficient b).mul (rawRatOfRat (b i)) + +def machineDirectionRowIndex (word : List Bool) : List Bool := + machinePairFirst word + +def machineDirectionRowPayload (word : List Bool) : List Bool := + machinePairSecond word + +def machineDirectionRowDimensionUnary + (word : List Bool) : List Bool := + machinePairFirst (machineDirectionRowPayload word) + +def machineDirectionRowDimensionAndVector + (word : List Bool) : List Bool := + machinePairSecond (machineDirectionRowPayload word) + +def machineDirectionRowDimensionBits + (word : List Bool) : List Bool := + machinePairFirst (machineDirectionRowDimensionAndVector word) + +def machineDirectionRowVectorCode + (word : List Bool) : List Bool := + machinePairSecond (machineDirectionRowDimensionAndVector word) + +def machineDirectionRowNormSqRawCode + (word : List Bool) : List Bool := + machineRationalVectorDotRawCode + (pair (machineDirectionRowVectorCode word) + (machineDirectionRowVectorCode word)) + +def machineDirectionRowGapRawCode + (word : List Bool) : List Bool := + machineRawRatAddCode + (pair + (machineEllipsoidPerpScaleRawCode + (machineDirectionRowDimensionBits word)) + (machineRawRatNegCode + (machineEllipsoidParallelScaleRawCode + (machineDirectionRowDimensionBits word)))) + +def machineDirectionRowCoefficientRawCode + (word : List Bool) : List Bool := + machineRawRatDivCode + (pair (machineDirectionRowGapRawCode word) + (machineDirectionRowNormSqRawCode word)) + +def machineDirectionRowBEntry + (word : List Bool) : List Bool := + machineListIndex + (pair (machineDirectionRowIndex word) + (machineDirectionRowVectorCode word)) + +def machineDirectionRowScaleRawCode + (word : List Bool) : List Bool := + machineRawRatMulCode + (pair (machineDirectionRowCoefficientRawCode word) + (machineDirectionRowBEntry word)) + +def machineDirectionRowScaledVectorCode + (word : List Bool) : List Bool := + machineRationalVectorScaleCode + (pair (machineDirectionRowScaleRawCode word) + (machineDirectionRowVectorCode word)) + +def machineDirectionRowZeroVectorCode + (word : List Bool) : List Bool := + machineRationalZeroVectorCode + (machineDirectionRowDimensionUnary word) + +def machineDirectionRowDiagonalCode + (word : List Bool) : List Bool := + machineListUpdate + (pair (machineDirectionRowIndex word) + (pair + (machineEllipsoidPerpScaleEntryCode + (machineDirectionRowDimensionBits word)) + (machineDirectionRowZeroVectorCode word))) + +def machineRationalDirectionUpdateRowCode + (word : List Bool) : List Bool := + machineRationalVectorSubCode + (pair (machineDirectionRowDimensionUnary word) + (pair (machineDirectionRowDiagonalCode word) + (machineDirectionRowScaledVectorCode word))) + +/-! ## Polynomial-time closure -/ + +theorem machineDirectionRowIndex_mem_FP : + machineDirectionRowIndex ∈ FP := machinePairFirst_mem_FP + +theorem machineDirectionRowPayload_mem_FP : + machineDirectionRowPayload ∈ FP := machinePairSecond_mem_FP + +theorem machineDirectionRowDimensionUnary_mem_FP : + machineDirectionRowDimensionUnary ∈ FP := by + simpa only [machineDirectionRowDimensionUnary] using + machineCompose_mem_FP machineDirectionRowPayload_mem_FP + machinePairFirst_mem_FP + +theorem machineDirectionRowDimensionAndVector_mem_FP : + machineDirectionRowDimensionAndVector ∈ FP := by + simpa only [machineDirectionRowDimensionAndVector] using + machineCompose_mem_FP machineDirectionRowPayload_mem_FP + machinePairSecond_mem_FP + +theorem machineDirectionRowDimensionBits_mem_FP : + machineDirectionRowDimensionBits ∈ FP := by + simpa only [machineDirectionRowDimensionBits] using + machineCompose_mem_FP machineDirectionRowDimensionAndVector_mem_FP + machinePairFirst_mem_FP + +theorem machineDirectionRowVectorCode_mem_FP : + machineDirectionRowVectorCode ∈ FP := by + simpa only [machineDirectionRowVectorCode] using + machineCompose_mem_FP machineDirectionRowDimensionAndVector_mem_FP + machinePairSecond_mem_FP + +theorem machineDirectionRowNormSqRawCode_mem_FP : + machineDirectionRowNormSqRawCode ∈ FP := by + have hinput := machinePair_mem_FP machineDirectionRowVectorCode_mem_FP + machineDirectionRowVectorCode_mem_FP + simpa only [machineDirectionRowNormSqRawCode] using + machineCompose_mem_FP hinput machineRationalVectorDotRawCode_mem_FP + +theorem machineDirectionRowGapRawCode_mem_FP : + machineDirectionRowGapRawCode ∈ FP := by + have hperp := machineCompose_mem_FP machineDirectionRowDimensionBits_mem_FP + machineEllipsoidPerpScaleRawCode_mem_FP + have hparallel := machineCompose_mem_FP + machineDirectionRowDimensionBits_mem_FP + machineEllipsoidParallelScaleRawCode_mem_FP + have hneg := machineCompose_mem_FP hparallel machineRawRatNegCode_mem_FP + simpa only [machineDirectionRowGapRawCode] using + machineCompose_mem_FP (machinePair_mem_FP hperp hneg) + machineRawRatAddCode_mem_FP + +theorem machineDirectionRowCoefficientRawCode_mem_FP : + machineDirectionRowCoefficientRawCode ∈ FP := by + have hinput := machinePair_mem_FP machineDirectionRowGapRawCode_mem_FP + machineDirectionRowNormSqRawCode_mem_FP + simpa only [machineDirectionRowCoefficientRawCode] using + machineCompose_mem_FP hinput machineRawRatDivCode_mem_FP + +theorem machineDirectionRowBEntry_mem_FP : + machineDirectionRowBEntry ∈ FP := by + have hinput := machinePair_mem_FP machineDirectionRowIndex_mem_FP + machineDirectionRowVectorCode_mem_FP + simpa only [machineDirectionRowBEntry] using + machineCompose_mem_FP hinput machineListIndex_mem_FP + +theorem machineDirectionRowScaleRawCode_mem_FP : + machineDirectionRowScaleRawCode ∈ FP := by + have hinput := machinePair_mem_FP + machineDirectionRowCoefficientRawCode_mem_FP + machineDirectionRowBEntry_mem_FP + simpa only [machineDirectionRowScaleRawCode] using + machineCompose_mem_FP hinput machineRawRatMulCode_mem_FP + +theorem machineDirectionRowScaledVectorCode_mem_FP : + machineDirectionRowScaledVectorCode ∈ FP := by + have hinput := machinePair_mem_FP machineDirectionRowScaleRawCode_mem_FP + machineDirectionRowVectorCode_mem_FP + simpa only [machineDirectionRowScaledVectorCode] using + machineCompose_mem_FP hinput machineRationalVectorScaleCode_mem_FP + +theorem machineDirectionRowZeroVectorCode_mem_FP : + machineDirectionRowZeroVectorCode ∈ FP := by + simpa only [machineDirectionRowZeroVectorCode] using + machineCompose_mem_FP machineDirectionRowDimensionUnary_mem_FP + machineRationalZeroVectorCode_mem_FP + +theorem machineDirectionRowDiagonalCode_mem_FP : + machineDirectionRowDiagonalCode ∈ FP := by + have hperp := machineCompose_mem_FP machineDirectionRowDimensionBits_mem_FP + machineEllipsoidPerpScaleEntryCode_mem_FP + have hpayload := machinePair_mem_FP hperp + machineDirectionRowZeroVectorCode_mem_FP + have hinput := machinePair_mem_FP machineDirectionRowIndex_mem_FP hpayload + simpa only [machineDirectionRowDiagonalCode] using + machineCompose_mem_FP hinput machineListUpdate_mem_FP + +theorem machineRationalDirectionUpdateRowCode_mem_FP : + machineRationalDirectionUpdateRowCode ∈ FP := by + have hpayload := machinePair_mem_FP machineDirectionRowDiagonalCode_mem_FP + machineDirectionRowScaledVectorCode_mem_FP + have hinput := machinePair_mem_FP machineDirectionRowDimensionUnary_mem_FP + hpayload + simpa only [machineRationalDirectionUpdateRowCode] using + machineCompose_mem_FP hinput machineRationalVectorSubCode_mem_FP + +/-! ## Exact semantics -/ + +@[simp] theorem rawDirectionNormSq_value {d : ℕ} (b : Fin d → ℚ) : + (rawDirectionNormSq b).value = finiteNormSq b := by + rw [rawDirectionNormSq, rawRatListDot_ofFn_value] + rfl + +@[simp] theorem rawDirectionGap_value (d : ℕ) : + (rawDirectionGap d).value = + rationalEllipsoidPerpScale d - rationalEllipsoidParallelScale d := by + simp [rawDirectionGap, RawRat.sub, RawRat.value_add, + RawRat.value_neg, sub_eq_add_neg] + +@[simp] theorem rawDirectionCoefficient_value {d : ℕ} + (b : Fin d → ℚ) : + (rawDirectionCoefficient b).value = + (rationalEllipsoidPerpScale d - + rationalEllipsoidParallelScale d) / finiteNormSq b := by + simp [rawDirectionCoefficient] + +@[simp] theorem rawDirectionRowScale_value {d : ℕ} + (b : Fin d → ℚ) (i : Fin d) : + (rawDirectionRowScale b i).value = + ((rationalEllipsoidPerpScale d - + rationalEllipsoidParallelScale d) / finiteNormSq b) * b i := by + simp [rawDirectionRowScale] + +@[simp] theorem machineDirectionRowNormSqRawCode_encode {d : ℕ} + (b : Fin d → ℚ) (i : Fin d) : + machineDirectionRowNormSqRawCode + (pair (List.replicate i.1 true) + (pair (List.replicate d true) (pair d.bits + (rationalFiniteVectorCode b)))) = + rawRatBinaryCode (rawDirectionNormSq b) := by + rw [machineDirectionRowNormSqRawCode] + simp only [machineDirectionRowVectorCode, + machineDirectionRowDimensionAndVector, machineDirectionRowPayload, + machinePairSecond_pair, machineRationalVectorDotRawCode_encode, + rawDirectionNormSq] + +@[simp] theorem machineDirectionRowGapRawCode_encode {d : ℕ} + (b : Fin d → ℚ) (i : Fin d) : + machineDirectionRowGapRawCode + (pair (List.replicate i.1 true) + (pair (List.replicate d true) + (pair d.bits (rationalFiniteVectorCode b)))) = + rawRatBinaryCode (rawDirectionGap d) := by + rw [machineDirectionRowGapRawCode] + simp only [machineDirectionRowDimensionBits, + machineDirectionRowDimensionAndVector, machineDirectionRowPayload, + machinePairSecond_pair, machinePairFirst_pair, + machineEllipsoidPerpScaleRawCode_encode, + machineEllipsoidParallelScaleRawCode_encode, + machineRawRatNegCode_encode, machineRawRatAddCode_encode, + rawDirectionGap, RawRat.sub] + +@[simp] theorem machineDirectionRowCoefficientRawCode_encode {d : ℕ} + (b : Fin d → ℚ) (i : Fin d) : + machineDirectionRowCoefficientRawCode + (pair (List.replicate i.1 true) + (pair (List.replicate d true) + (pair d.bits (rationalFiniteVectorCode b)))) = + rawRatBinaryCode (rawDirectionCoefficient b) := by + rw [machineDirectionRowCoefficientRawCode] + simp only [machineDirectionRowGapRawCode_encode, + machineDirectionRowNormSqRawCode_encode, + machineRawRatDivCode_encode] + rfl + +@[simp] theorem machineDirectionRowBEntry_encode {d : ℕ} + (b : Fin d → ℚ) (i : Fin d) : + machineDirectionRowBEntry + (pair (List.replicate i.1 true) + (pair (List.replicate d true) + (pair d.bits (rationalFiniteVectorCode b)))) = + rationalEntryBinaryCode (b i) := by + rw [machineDirectionRowBEntry] + simp only [machineDirectionRowIndex, machinePairFirst_pair, + machineDirectionRowVectorCode, machineDirectionRowDimensionAndVector, + machineDirectionRowPayload, machinePairSecond_pair, + rationalFiniteVectorCode] + rw [machineListIndex_binaryListCode] + · simp + · simp + +@[simp] theorem machineDirectionRowScaleRawCode_encode {d : ℕ} + (b : Fin d → ℚ) (i : Fin d) : + machineDirectionRowScaleRawCode + (pair (List.replicate i.1 true) + (pair (List.replicate d true) + (pair d.bits (rationalFiniteVectorCode b)))) = + rawRatBinaryCode (rawDirectionRowScale b i) := by + rw [machineDirectionRowScaleRawCode] + simp only [machineDirectionRowCoefficientRawCode_encode, + machineDirectionRowBEntry_encode, + ← rawRatBinaryCode_rawRatOfRat, machineRawRatMulCode_encode, + rawDirectionRowScale] + +@[simp] theorem machineDirectionRowScaledVectorCode_encode {d : ℕ} + (b : Fin d → ℚ) (i : Fin d) : + machineDirectionRowScaledVectorCode + (pair (List.replicate i.1 true) + (pair (List.replicate d true) + (pair d.bits (rationalFiniteVectorCode b)))) = + rationalFiniteVectorCode + (rationalVectorScale (rawDirectionRowScale b i).value b) := by + rw [machineDirectionRowScaledVectorCode] + simp only [machineDirectionRowScaleRawCode_encode, + machineDirectionRowVectorCode, machineDirectionRowDimensionAndVector, + machineDirectionRowPayload, machinePairSecond_pair] + rw [machineRationalVectorScaleCode_encode] + +@[simp] theorem machineDirectionRowDiagonalCode_encode {d : ℕ} + (b : Fin d → ℚ) (i : Fin d) : + machineDirectionRowDiagonalCode + (pair (List.replicate i.1 true) + (pair (List.replicate d true) + (pair d.bits (rationalFiniteVectorCode b)))) = + rationalFiniteVectorCode + (rationalDirectionDiagonalRow (rationalEllipsoidPerpScale d) i) := by + rw [machineDirectionRowDiagonalCode] + simp only [machineDirectionRowIndex, machinePairFirst_pair, + machineDirectionRowDimensionBits, + machineDirectionRowDimensionAndVector, machineDirectionRowPayload, + machinePairSecond_pair, machineEllipsoidPerpScaleEntryCode_encode, + machineDirectionRowZeroVectorCode, + machineDirectionRowDimensionUnary, machinePairFirst_pair, + machineRationalZeroVectorCode_encode] + change machineListUpdate + (machineListUpdateCanonicalInput rationalEntryBinaryCode + (List.ofFn (fun _ : Fin d ↦ (0 : ℚ))) + (rationalEllipsoidPerpScale d) i.1) = _ + rw [machineListUpdate_binaryListCode] + · rw [rationalFiniteVectorCode] + congr 1 + apply List.ext_getElem + · simp + · intro j hjLeft hjRight + by_cases hji : j = i.1 + · subst j + simp [rationalDirectionDiagonalRow] + · have hfin : i ≠ ⟨j, by simpa using hjRight⟩ := by + intro h + apply hji + exact (congrArg Fin.val h).symm + have hij : i.1 ≠ j := Ne.symm hji + simp [List.getElem_set, hij, rationalDirectionDiagonalRow, hfin] + · simpa using i.isLt + +theorem rationalDirectionUpdateRow_eq {d : ℕ} + (b : Fin d → ℚ) (i : Fin d) : + rationalVectorSub + (rationalDirectionDiagonalRow (rationalEllipsoidPerpScale d) i) + (rationalVectorScale (rawDirectionRowScale b i).value b) = + fun j ↦ directionUpdateMatrix + (rationalEllipsoidPerpScale d) + (rationalEllipsoidParallelScale d) b i j := by + funext j + simp [rationalVectorSub, rationalDirectionDiagonalRow, + rationalVectorScale, directionUpdateMatrix] + +@[simp] theorem machineRationalDirectionUpdateRowCode_encode {d : ℕ} + (b : Fin d → ℚ) (i : Fin d) : + machineRationalDirectionUpdateRowCode + (pair (List.replicate i.1 true) + (pair (List.replicate d true) + (pair d.bits (rationalFiniteVectorCode b)))) = + rationalFiniteVectorCode + (fun j ↦ directionUpdateMatrix + (rationalEllipsoidPerpScale d) + (rationalEllipsoidParallelScale d) b i j) := by + rw [machineRationalDirectionUpdateRowCode] + simp only [machineDirectionRowDimensionUnary, + machineDirectionRowPayload, machinePairSecond_pair, + machinePairFirst_pair, machineDirectionRowDiagonalCode_encode, + machineDirectionRowScaledVectorCode_encode] + change machineRationalVectorSubCode + (rationalVectorSubCanonicalWord + (rationalDirectionDiagonalRow (rationalEllipsoidPerpScale d) i) + (rationalVectorScale (rawDirectionRowScale b i).value b)) = _ + rw [machineRationalVectorSubCode_encode, + rationalDirectionUpdateRow_eq] + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalEllipsoidCenterUpdate.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalEllipsoidCenterUpdate.lean new file mode 100644 index 0000000000..0fa33c0334 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalEllipsoidCenterUpdate.lean @@ -0,0 +1,298 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineBoundedUnary +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalVectorSub + +/-! +# Polynomial-time center part of the rational ellipsoid update + +The input is a canonical ellipsoid-state word followed by a canonical cut +normal. Every intermediate remains a finite word: the program pulls the cut +back through the transposed basis, normalizes by its `ℓ1` norm, multiplies by +the basis, scales by `alpha`, and subtracts from the stored center. +-/ + +namespace BeyondBethe + +open Complexity + +def machineRationalCenterUpdateStateWord + (word : List Bool) : List Bool := machinePairFirst word + +def machineRationalCenterUpdateCutWord + (word : List Bool) : List Bool := machinePairSecond word + +def machineRationalCenterUpdateDimensionBits + (word : List Bool) : List Bool := + machineRationalEllipsoidDimensionWord + (machineRationalCenterUpdateStateWord word) + +/-- The complete state word is a unary guard for its own dimension. -/ +def machineRationalCenterUpdateDimensionUnary + (word : List Bool) : List Bool := + machineBoundedUnary + (pair (machineRationalCenterUpdateStateWord word) + (machineRationalCenterUpdateDimensionBits word)) + +def machineRationalCenterUpdateCenterWord + (word : List Bool) : List Bool := + machineRationalEllipsoidCenterWord + (machineRationalCenterUpdateStateWord word) + +def machineRationalCenterUpdateBasisWord + (word : List Bool) : List Bool := + machineRationalEllipsoidBasisWord + (machineRationalCenterUpdateStateWord word) + +def machineRationalCenterUpdatePulledBackCode + (word : List Bool) : List Bool := + machineRationalTransposeMulVectorCode + (pair (machineRationalCenterUpdateDimensionUnary word) + (pair (machineRationalCenterUpdateBasisWord word) + (machineRationalCenterUpdateCutWord word))) + +def machineRationalCenterUpdateNormalizedCode + (word : List Bool) : List Bool := + machineRationalNormalizedDirectionCode + (machineRationalCenterUpdatePulledBackCode word) + +def machineRationalCenterUpdateDisplacementCode + (word : List Bool) : List Bool := + machineRationalMatrixMulVectorCode + (pair (machineRationalCenterUpdateDimensionUnary word) + (pair (machineRationalCenterUpdateBasisWord word) + (machineRationalCenterUpdateNormalizedCode word))) + +def machineRationalCenterUpdateScaledDisplacementCode + (word : List Bool) : List Bool := + machineRationalVectorScaleCode + (pair + (machineEllipsoidAlphaRawCode + (machineRationalCenterUpdateDimensionBits word)) + (machineRationalCenterUpdateDisplacementCode word)) + +def machineRationalEllipsoidCenterUpdateCode + (word : List Bool) : List Bool := + machineRationalVectorSubCode + (pair (machineRationalCenterUpdateDimensionUnary word) + (pair (machineRationalCenterUpdateCenterWord word) + (machineRationalCenterUpdateScaledDisplacementCode word))) + +theorem machineRationalCenterUpdateStateWord_mem_FP : + machineRationalCenterUpdateStateWord ∈ FP := machinePairFirst_mem_FP + +theorem machineRationalCenterUpdateCutWord_mem_FP : + machineRationalCenterUpdateCutWord ∈ FP := machinePairSecond_mem_FP + +theorem machineRationalCenterUpdateDimensionBits_mem_FP : + machineRationalCenterUpdateDimensionBits ∈ FP := by + simpa only [machineRationalCenterUpdateDimensionBits] using + machineCompose_mem_FP machineRationalCenterUpdateStateWord_mem_FP + machineRationalEllipsoidDimensionWord_mem_FP + +theorem machineRationalCenterUpdateDimensionUnary_mem_FP : + machineRationalCenterUpdateDimensionUnary ∈ FP := by + have hinput := machinePair_mem_FP + machineRationalCenterUpdateStateWord_mem_FP + machineRationalCenterUpdateDimensionBits_mem_FP + simpa only [machineRationalCenterUpdateDimensionUnary] using + machineCompose_mem_FP hinput machineBoundedUnary_mem_FP + +theorem machineRationalCenterUpdateCenterWord_mem_FP : + machineRationalCenterUpdateCenterWord ∈ FP := by + simpa only [machineRationalCenterUpdateCenterWord] using + machineCompose_mem_FP machineRationalCenterUpdateStateWord_mem_FP + machineRationalEllipsoidCenterWord_mem_FP + +theorem machineRationalCenterUpdateBasisWord_mem_FP : + machineRationalCenterUpdateBasisWord ∈ FP := by + simpa only [machineRationalCenterUpdateBasisWord] using + machineCompose_mem_FP machineRationalCenterUpdateStateWord_mem_FP + machineRationalEllipsoidBasisWord_mem_FP + +theorem machineRationalCenterUpdatePulledBackCode_mem_FP : + machineRationalCenterUpdatePulledBackCode ∈ FP := by + have hpayload := machinePair_mem_FP + machineRationalCenterUpdateBasisWord_mem_FP + machineRationalCenterUpdateCutWord_mem_FP + have hinput := machinePair_mem_FP + machineRationalCenterUpdateDimensionUnary_mem_FP hpayload + simpa only [machineRationalCenterUpdatePulledBackCode] using + machineCompose_mem_FP hinput machineRationalTransposeMulVectorCode_mem_FP + +theorem machineRationalCenterUpdateNormalizedCode_mem_FP : + machineRationalCenterUpdateNormalizedCode ∈ FP := by + simpa only [machineRationalCenterUpdateNormalizedCode] using + machineCompose_mem_FP machineRationalCenterUpdatePulledBackCode_mem_FP + machineRationalNormalizedDirectionCode_mem_FP + +theorem machineRationalCenterUpdateDisplacementCode_mem_FP : + machineRationalCenterUpdateDisplacementCode ∈ FP := by + have hpayload := machinePair_mem_FP + machineRationalCenterUpdateBasisWord_mem_FP + machineRationalCenterUpdateNormalizedCode_mem_FP + have hinput := machinePair_mem_FP + machineRationalCenterUpdateDimensionUnary_mem_FP hpayload + simpa only [machineRationalCenterUpdateDisplacementCode] using + machineCompose_mem_FP hinput machineRationalMatrixMulVectorCode_mem_FP + +theorem machineRationalCenterUpdateScaledDisplacementCode_mem_FP : + machineRationalCenterUpdateScaledDisplacementCode ∈ FP := by + have halpha := machineCompose_mem_FP + machineRationalCenterUpdateDimensionBits_mem_FP + machineEllipsoidAlphaRawCode_mem_FP + have hinput := machinePair_mem_FP halpha + machineRationalCenterUpdateDisplacementCode_mem_FP + simpa only [machineRationalCenterUpdateScaledDisplacementCode] using + machineCompose_mem_FP hinput machineRationalVectorScaleCode_mem_FP + +theorem machineRationalEllipsoidCenterUpdateCode_mem_FP : + machineRationalEllipsoidCenterUpdateCode ∈ FP := by + have hpayload := machinePair_mem_FP + machineRationalCenterUpdateCenterWord_mem_FP + machineRationalCenterUpdateScaledDisplacementCode_mem_FP + have hinput := machinePair_mem_FP + machineRationalCenterUpdateDimensionUnary_mem_FP hpayload + simpa only [machineRationalEllipsoidCenterUpdateCode] using + machineCompose_mem_FP hinput machineRationalVectorSubCode_mem_FP + +/-! ## Exact semantics -/ + +theorem rationalEllipsoid_dimension_le_state_code_length {d : ℕ} + (E : RationalEllipsoidState d) : + d ≤ (rationalEllipsoidStateBinaryCode E).length := by + have hlist := binaryListCode_listLength_le rationalEntryBinaryCode + (List.ofFn E.center) + have hcenter : + (rationalFiniteVectorCode E.center).length ≤ + (rationalEllipsoidStateBinaryCode E).length := by + let payload := pair (rationalFiniteVectorCode E.center) + (rationalSquareMatrixRowsCode E.basis) + have hfirst := machinePairFirst_length_le payload + have hsecond : payload.length ≤ + (rationalEllipsoidStateBinaryCode E).length := by + simpa only [payload, rationalEllipsoidStateBinaryCode, + machinePairSecond_pair] using machinePairSecond_length_le + (rationalEllipsoidStateBinaryCode E) + simpa only [payload, machinePairFirst_pair] using hfirst.trans hsecond + simpa only [rationalFiniteVectorCode, List.length_ofFn] using + hlist.trans hcenter + +@[simp] theorem machineRationalCenterUpdateDimensionUnary_encode {d : ℕ} + (E : RationalEllipsoidState d) (a : Fin d → ℚ) : + machineRationalCenterUpdateDimensionUnary + (pair (rationalEllipsoidStateBinaryCode E) + (rationalFiniteVectorCode a)) = + List.replicate d true := by + rw [machineRationalCenterUpdateDimensionUnary] + simp only [machineRationalCenterUpdateStateWord, + machineRationalCenterUpdateDimensionBits, + machinePairFirst_pair, machineRationalEllipsoidDimensionWord_encode] + exact machineBoundedUnary_encode_of_le + (rationalEllipsoidStateBinaryCode E) d + (rationalEllipsoid_dimension_le_state_code_length E) + +@[simp] theorem machineRationalCenterUpdatePulledBackCode_encode {d : ℕ} + (E : RationalEllipsoidState d) (a : Fin d → ℚ) : + machineRationalCenterUpdatePulledBackCode + (pair (rationalEllipsoidStateBinaryCode E) + (rationalFiniteVectorCode a)) = + rationalFiniteVectorCode (rationalPulledBackNormal E a) := by + rw [machineRationalCenterUpdatePulledBackCode] + simp only [machineRationalCenterUpdateDimensionUnary_encode, + machineRationalCenterUpdateBasisWord, + machineRationalCenterUpdateStateWord, machinePairFirst_pair, + machineRationalEllipsoidBasisWord_encode, + machineRationalCenterUpdateCutWord, machinePairSecond_pair] + change machineRationalTransposeMulVectorCode + (rationalTransposeMulVectorCanonicalWord E.basis a) = _ + rw [machineRationalTransposeMulVectorCode_encode, + rationalTransposeMulVector_eq_pulledBack] + +@[simp] theorem machineRationalCenterUpdateNormalizedCode_encode {d : ℕ} + (E : RationalEllipsoidState d) (a : Fin d → ℚ) : + machineRationalCenterUpdateNormalizedCode + (pair (rationalEllipsoidStateBinaryCode E) + (rationalFiniteVectorCode a)) = + rationalFiniteVectorCode + (rationalNormalizedDirection (rationalPulledBackNormal E a)) := by + rw [machineRationalCenterUpdateNormalizedCode, + machineRationalCenterUpdatePulledBackCode_encode, + machineRationalNormalizedDirectionCode_encode] + +@[simp] theorem machineRationalCenterUpdateDisplacementCode_encode {d : ℕ} + (E : RationalEllipsoidState d) (a : Fin d → ℚ) : + machineRationalCenterUpdateDisplacementCode + (pair (rationalEllipsoidStateBinaryCode E) + (rationalFiniteVectorCode a)) = + rationalFiniteVectorCode + (rationalMatrixMulVector E.basis + (rationalNormalizedDirection (rationalPulledBackNormal E a))) := by + rw [machineRationalCenterUpdateDisplacementCode] + simp only [machineRationalCenterUpdateDimensionUnary_encode, + machineRationalCenterUpdateBasisWord, + machineRationalCenterUpdateStateWord, machinePairFirst_pair, + machineRationalEllipsoidBasisWord_encode, + machineRationalCenterUpdateNormalizedCode_encode] + change machineRationalMatrixMulVectorCode + (rationalMatrixMulVectorCanonicalWord E.basis + (rationalNormalizedDirection (rationalPulledBackNormal E a))) = _ + rw [machineRationalMatrixMulVectorCode_encode] + +@[simp] theorem machineRationalCenterUpdateScaledDisplacementCode_encode + {d : ℕ} (E : RationalEllipsoidState d) (a : Fin d → ℚ) : + machineRationalCenterUpdateScaledDisplacementCode + (pair (rationalEllipsoidStateBinaryCode E) + (rationalFiniteVectorCode a)) = + rationalFiniteVectorCode + (rationalVectorScale (rationalEllipsoidAlpha d) + (rationalMatrixMulVector E.basis + (rationalNormalizedDirection + (rationalPulledBackNormal E a)))) := by + rw [machineRationalCenterUpdateScaledDisplacementCode] + simp only [machineRationalCenterUpdateDimensionBits, + machineRationalCenterUpdateStateWord, machinePairFirst_pair, + machineRationalEllipsoidDimensionWord_encode, + machineEllipsoidAlphaRawCode_encode, + machineRationalCenterUpdateDisplacementCode_encode, + machineRationalVectorScaleCode_encode, rawEllipsoidAlpha_value] + +theorem rationalEllipsoidCentralUpdate_center_eq {d : ℕ} + (E : RationalEllipsoidState d) (a : Fin d → ℚ) : + (rationalEllipsoidCentralUpdate E a).center = + rationalVectorSub E.center + (rationalVectorScale (rationalEllipsoidAlpha d) + (rationalMatrixMulVector E.basis + (rationalNormalizedDirection + (rationalPulledBackNormal E a)))) := by + funext i + simp [rationalEllipsoidCentralUpdate, rationalVectorSub, + rationalVectorScale, rationalMatrixMulVector, + rationalNormalizedDirection, cutL1Scale] + +@[simp] theorem machineRationalEllipsoidCenterUpdateCode_encode {d : ℕ} + (E : RationalEllipsoidState d) (a : Fin d → ℚ) : + machineRationalEllipsoidCenterUpdateCode + (pair (rationalEllipsoidStateBinaryCode E) + (rationalFiniteVectorCode a)) = + rationalFiniteVectorCode (rationalEllipsoidCentralUpdate E a).center := by + rw [machineRationalEllipsoidCenterUpdateCode] + simp only [machineRationalCenterUpdateDimensionUnary_encode, + machineRationalCenterUpdateCenterWord, + machineRationalCenterUpdateStateWord, machinePairFirst_pair, + machineRationalEllipsoidCenterWord_encode, + machineRationalCenterUpdateScaledDisplacementCode_encode] + change machineRationalVectorSubCode + (rationalVectorSubCanonicalWord E.center + (rationalVectorScale (rationalEllipsoidAlpha d) + (rationalMatrixMulVector E.basis + (rationalNormalizedDirection + (rationalPulledBackNormal E a))))) = _ + rw [machineRationalVectorSubCode_encode, + ← rationalEllipsoidCentralUpdate_center_eq] + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalEllipsoidEncoding.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalEllipsoidEncoding.lean new file mode 100644 index 0000000000..23a3ea18f7 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalEllipsoidEncoding.lean @@ -0,0 +1,238 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineEncoding +import LeanPool.BeyondBethe.BeyondBethe.MachineFPBasics +import LeanPool.BeyondBethe.BeyondBethe.RationalFeasibility + +/-! # Machine Rational Ellipsoid Encoding -/ + +namespace BeyondBethe + +open Complexity + +/-! +# Canonical finite-word encodings for rational ellipsoid feasibility + +The optimizer stores a center vector and a square basis matrix. This file +fixes their ordinary binary representation before any update or oracle +machine is introduced. Every list is right-nested with `binaryListCode`, and +every rational entry is in the unique reduced representation +`rationalEntryBinaryCode`. +-/ + +/-- Canonical word for a fixed-length rational vector. -/ +def rationalFiniteVectorCode {d : ℕ} (v : Fin d → ℚ) : List Bool := + binaryListCode rationalEntryBinaryCode (List.ofFn v) + +theorem rationalFiniteVectorCode_injective {d : ℕ} : + Function.Injective (@rationalFiniteVectorCode d) := by + intro v w h + have hlists : List.ofFn v = List.ofFn w := + (binaryListCode_injective rationalEntryBinaryCode_injective) h + exact List.ofFn_injective hlists + +/-- Canonical word for a fixed-size rational square matrix, without a second +copy of the dimension. -/ +def rationalSquareMatrixRowsCode {d : ℕ} + (A : Matrix (Fin d) (Fin d) ℚ) : List Bool := + binaryListCode (binaryListCode rationalEntryBinaryCode) + (rationalMatrixRows A) + +theorem rationalSquareMatrixRowsCode_injective {d : ℕ} : + Function.Injective (@rationalSquareMatrixRowsCode d) := by + intro A B h + apply rationalMatrixRows_injective + exact (binaryListCode_injective + (binaryListCode_injective rationalEntryBinaryCode_injective)) h + +/-- Dimension followed by center and basis. Keeping the dimension in the +word makes the representation self-contained for a single uniform machine. -/ +def rationalEllipsoidStateBinaryCode {d : ℕ} + (E : RationalEllipsoidState d) : List Bool := + pair d.bits + (pair (rationalFiniteVectorCode E.center) + (rationalSquareMatrixRowsCode E.basis)) + +theorem rationalEllipsoidStateBinaryCode_injective_fixed {d : ℕ} : + Function.Injective (@rationalEllipsoidStateBinaryCode d) := by + intro E F h + obtain ⟨_hd, hpayload⟩ := pair_inj h + obtain ⟨hcenter, hbasis⟩ := pair_inj hpayload + cases E with + | mk Ec Eb => + cases F with + | mk Fc Fb => + simp only at hcenter hbasis ⊢ + have hc : Ec = Fc := rationalFiniteVectorCode_injective hcenter + have hb : Eb = Fb := + rationalSquareMatrixRowsCode_injective hbasis + cases hc + cases hb + rfl + +/-- A dimension-indexed ellipsoid state, used only to state global +injectivity of the self-contained word representation. -/ +abbrev RationalEllipsoidInput := Σ d : ℕ, RationalEllipsoidState d + +def rationalEllipsoidInputBinaryCode : + RationalEllipsoidInput → List Bool + | ⟨_d, E⟩ => rationalEllipsoidStateBinaryCode E + +theorem rationalEllipsoidInputBinaryCode_injective : + Function.Injective rationalEllipsoidInputBinaryCode := by + intro x y h + obtain ⟨d, E⟩ := x + obtain ⟨e, F⟩ := y + simp only [rationalEllipsoidInputBinaryCode, + rationalEllipsoidStateBinaryCode] at h + obtain ⟨hde, hpayload⟩ := pair_inj h + have hde' : d = e := natBits_injective hde + subst e + have hcode : rationalEllipsoidStateBinaryCode E = + rationalEllipsoidStateBinaryCode F := by + simp only [rationalEllipsoidStateBinaryCode] + exact congrArg (pair d.bits) hpayload + have hEF : E = F := + rationalEllipsoidStateBinaryCode_injective_fixed hcode + subst F + rfl + +/-- Tag and payload encoding of an oracle response. -/ +def rationalCentralOracleResponseBinaryCode {d : ℕ} : + RationalCentralOracleResponse d → List Bool + | .accept => pair [false] [] + | .cut a => pair [true] (rationalFiniteVectorCode a) + +theorem rationalCentralOracleResponseBinaryCode_injective {d : ℕ} : + Function.Injective (@rationalCentralOracleResponseBinaryCode d) := by + intro r s h + cases r with + | accept => + cases s with + | accept => rfl + | cut a => + have htag := congrArg machinePairFirst h + simp [rationalCentralOracleResponseBinaryCode] at htag + | cut a => + cases s with + | accept => + have htag := congrArg machinePairFirst h + simp [rationalCentralOracleResponseBinaryCode] at htag + | cut b => + have hpayload := congrArg machinePairSecond h + simp only [rationalCentralOracleResponseBinaryCode, + machinePairSecond_pair] at hpayload + exact congrArg RationalCentralOracleResponse.cut + (rationalFiniteVectorCode_injective hpayload) + +/-- Tag and payload encoding of a bounded feasibility result. -/ +def rationalFeasibilityResultBinaryCode {d : ℕ} : + RationalFeasibilityResult d → List Bool + | .accepted q => pair [false] (rationalFiniteVectorCode q) + | .exhausted E => pair [true] (rationalEllipsoidStateBinaryCode E) + +theorem rationalFeasibilityResultBinaryCode_injective {d : ℕ} : + Function.Injective (@rationalFeasibilityResultBinaryCode d) := by + intro r s h + cases r with + | accepted q => + cases s with + | accepted z => + have hpayload := congrArg machinePairSecond h + simp only [rationalFeasibilityResultBinaryCode, + machinePairSecond_pair] at hpayload + exact congrArg RationalFeasibilityResult.accepted + (rationalFiniteVectorCode_injective hpayload) + | exhausted E => + have htag := congrArg machinePairFirst h + simp [rationalFeasibilityResultBinaryCode] at htag + | exhausted E => + cases s with + | accepted q => + have htag := congrArg machinePairFirst h + simp [rationalFeasibilityResultBinaryCode] at htag + | exhausted F => + have hpayload := congrArg machinePairSecond h + simp only [rationalFeasibilityResultBinaryCode, + machinePairSecond_pair] at hpayload + exact congrArg RationalFeasibilityResult.exhausted + (rationalEllipsoidStateBinaryCode_injective_fixed hpayload) + +/-! ## Polynomial-time field accessors -/ + +def machineRationalEllipsoidDimensionWord (word : List Bool) : List Bool := + machinePairFirst word + +def machineRationalEllipsoidPayloadWord (word : List Bool) : List Bool := + machinePairSecond word + +def machineRationalEllipsoidCenterWord (word : List Bool) : List Bool := + machinePairFirst (machineRationalEllipsoidPayloadWord word) + +def machineRationalEllipsoidBasisWord (word : List Bool) : List Bool := + machinePairSecond (machineRationalEllipsoidPayloadWord word) + +theorem machineRationalEllipsoidDimensionWord_mem_FP : + machineRationalEllipsoidDimensionWord ∈ FP := + machinePairFirst_mem_FP + +theorem machineRationalEllipsoidPayloadWord_mem_FP : + machineRationalEllipsoidPayloadWord ∈ FP := + machinePairSecond_mem_FP + +theorem machineRationalEllipsoidCenterWord_mem_FP : + machineRationalEllipsoidCenterWord ∈ FP := by + simpa only [machineRationalEllipsoidCenterWord] using + machineCompose_mem_FP machineRationalEllipsoidPayloadWord_mem_FP + machinePairFirst_mem_FP + +theorem machineRationalEllipsoidBasisWord_mem_FP : + machineRationalEllipsoidBasisWord ∈ FP := by + simpa only [machineRationalEllipsoidBasisWord] using + machineCompose_mem_FP machineRationalEllipsoidPayloadWord_mem_FP + machinePairSecond_mem_FP + +@[simp] theorem machineRationalEllipsoidDimensionWord_encode {d : ℕ} + (E : RationalEllipsoidState d) : + machineRationalEllipsoidDimensionWord + (rationalEllipsoidStateBinaryCode E) = d.bits := by + simp [machineRationalEllipsoidDimensionWord, + rationalEllipsoidStateBinaryCode] + +@[simp] theorem machineRationalEllipsoidCenterWord_encode {d : ℕ} + (E : RationalEllipsoidState d) : + machineRationalEllipsoidCenterWord + (rationalEllipsoidStateBinaryCode E) = + rationalFiniteVectorCode E.center := by + simp [machineRationalEllipsoidCenterWord, + machineRationalEllipsoidPayloadWord, + rationalEllipsoidStateBinaryCode] + +@[simp] theorem machineRationalEllipsoidBasisWord_encode {d : ℕ} + (E : RationalEllipsoidState d) : + machineRationalEllipsoidBasisWord + (rationalEllipsoidStateBinaryCode E) = + rationalSquareMatrixRowsCode E.basis := by + simp [machineRationalEllipsoidBasisWord, + machineRationalEllipsoidPayloadWord, + rationalEllipsoidStateBinaryCode] + +def machineRationalTaggedResultTag (word : List Bool) : List Bool := + machinePairFirst word + +def machineRationalTaggedResultPayload (word : List Bool) : List Bool := + machinePairSecond word + +theorem machineRationalTaggedResultTag_mem_FP : + machineRationalTaggedResultTag ∈ FP := + machinePairFirst_mem_FP + +theorem machineRationalTaggedResultPayload_mem_FP : + machineRationalTaggedResultPayload ∈ FP := + machinePairSecond_mem_FP + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalEllipsoidScalars.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalEllipsoidScalars.lean new file mode 100644 index 0000000000..ccee2a6cd9 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalEllipsoidScalars.lean @@ -0,0 +1,341 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalVectorL1 + +/-! +# Polynomial-time coefficients for the rational ellipsoid update + +The square-root-free central update uses three dimension-dependent rational +coefficients. This module constructs them from the ordinary little-endian +binary word for the dimension, using only the verified unreduced rational +arithmetic machines. The raw formulas are kept explicit so that no field +operation is hidden in the executable layer. +-/ + +namespace BeyondBethe + +open Complexity + +def rawEllipsoidOne : RawRat := RawRat.ofNat 1 +def rawEllipsoidTwo : RawRat := RawRat.ofNat 2 +def rawEllipsoidFour : RawRat := RawRat.ofNat 4 + +def rawEllipsoidDimension (d : ℕ) : RawRat := RawRat.ofNat d + +def rawEllipsoidDimensionSquare (d : ℕ) : RawRat := + (rawEllipsoidDimension d).mul (rawEllipsoidDimension d) + +def rawEllipsoidFourDimensionSquare (d : ℕ) : RawRat := + rawEllipsoidFour.mul (rawEllipsoidDimensionSquare d) + +def rawEllipsoidAlpha (d : ℕ) : RawRat := + rawEllipsoidOne.div (rawEllipsoidFourDimensionSquare d) + +def rawEllipsoidAlphaSquare (d : ℕ) : RawRat := + (rawEllipsoidAlpha d).mul (rawEllipsoidAlpha d) + +def rawEllipsoidTwiceAlphaSquare (d : ℕ) : RawRat := + rawEllipsoidTwo.mul (rawEllipsoidAlphaSquare d) + +def rawEllipsoidPerpScale (d : ℕ) : RawRat := + rawEllipsoidOne.add (rawEllipsoidTwiceAlphaSquare d) + +def rawEllipsoidAlphaOverDimension (d : ℕ) : RawRat := + (rawEllipsoidAlpha d).div (rawEllipsoidDimension d) + +def rawEllipsoidParallelScale (d : ℕ) : RawRat := + rawEllipsoidOne.sub (rawEllipsoidAlphaOverDimension d) + +/-! ## Finite-word formulas -/ + +def machineEllipsoidDimensionRawCode (word : List Bool) : List Bool := + pair (machineNaturalIntegerCode word) [true] + +def machineEllipsoidDimensionSquareRawCode + (word : List Bool) : List Bool := + machineRawRatMulCode + (pair (machineEllipsoidDimensionRawCode word) + (machineEllipsoidDimensionRawCode word)) + +def machineEllipsoidFourDimensionSquareRawCode + (word : List Bool) : List Bool := + machineRawRatMulCode + (pair (rawRatBinaryCode rawEllipsoidFour) + (machineEllipsoidDimensionSquareRawCode word)) + +def machineEllipsoidAlphaRawCode (word : List Bool) : List Bool := + machineRawRatDivCode + (pair (rawRatBinaryCode rawEllipsoidOne) + (machineEllipsoidFourDimensionSquareRawCode word)) + +def machineEllipsoidAlphaSquareRawCode + (word : List Bool) : List Bool := + machineRawRatMulCode + (pair (machineEllipsoidAlphaRawCode word) + (machineEllipsoidAlphaRawCode word)) + +def machineEllipsoidTwiceAlphaSquareRawCode + (word : List Bool) : List Bool := + machineRawRatMulCode + (pair (rawRatBinaryCode rawEllipsoidTwo) + (machineEllipsoidAlphaSquareRawCode word)) + +def machineEllipsoidPerpScaleRawCode + (word : List Bool) : List Bool := + machineRawRatAddCode + (pair (rawRatBinaryCode rawEllipsoidOne) + (machineEllipsoidTwiceAlphaSquareRawCode word)) + +def machineEllipsoidAlphaOverDimensionRawCode + (word : List Bool) : List Bool := + machineRawRatDivCode + (pair (machineEllipsoidAlphaRawCode word) + (machineEllipsoidDimensionRawCode word)) + +def machineEllipsoidParallelScaleRawCode + (word : List Bool) : List Bool := + machineRawRatAddCode + (pair (rawRatBinaryCode rawEllipsoidOne) + (machineRawRatNegCode + (machineEllipsoidAlphaOverDimensionRawCode word))) + +def machineEllipsoidAlphaEntryCode (word : List Bool) : List Bool := + machineNormalizeRawRatEntryCode (machineEllipsoidAlphaRawCode word) + +def machineEllipsoidPerpScaleEntryCode + (word : List Bool) : List Bool := + machineNormalizeRawRatEntryCode (machineEllipsoidPerpScaleRawCode word) + +def machineEllipsoidParallelScaleEntryCode + (word : List Bool) : List Bool := + machineNormalizeRawRatEntryCode + (machineEllipsoidParallelScaleRawCode word) + +/-! ## Polynomial-time closure -/ + +theorem machineEllipsoidDimensionRawCode_mem_FP : + machineEllipsoidDimensionRawCode ∈ FP := by + exact machinePair_mem_FP + (machineCompose_mem_FP id_mem_FP machineNaturalIntegerCode_mem_FP) + (machineConst_mem_FP [true]) + +theorem machineEllipsoidDimensionSquareRawCode_mem_FP : + machineEllipsoidDimensionSquareRawCode ∈ FP := by + simpa only [machineEllipsoidDimensionSquareRawCode] using + machineCompose_mem_FP + (machinePair_mem_FP machineEllipsoidDimensionRawCode_mem_FP + machineEllipsoidDimensionRawCode_mem_FP) + machineRawRatMulCode_mem_FP + +theorem machineEllipsoidFourDimensionSquareRawCode_mem_FP : + machineEllipsoidFourDimensionSquareRawCode ∈ FP := by + simpa only [machineEllipsoidFourDimensionSquareRawCode] using + machineCompose_mem_FP + (machinePair_mem_FP + (machineConst_mem_FP (rawRatBinaryCode rawEllipsoidFour)) + machineEllipsoidDimensionSquareRawCode_mem_FP) + machineRawRatMulCode_mem_FP + +theorem machineEllipsoidAlphaRawCode_mem_FP : + machineEllipsoidAlphaRawCode ∈ FP := by + simpa only [machineEllipsoidAlphaRawCode] using + machineCompose_mem_FP + (machinePair_mem_FP + (machineConst_mem_FP (rawRatBinaryCode rawEllipsoidOne)) + machineEllipsoidFourDimensionSquareRawCode_mem_FP) + machineRawRatDivCode_mem_FP + +theorem machineEllipsoidAlphaSquareRawCode_mem_FP : + machineEllipsoidAlphaSquareRawCode ∈ FP := by + simpa only [machineEllipsoidAlphaSquareRawCode] using + machineCompose_mem_FP + (machinePair_mem_FP machineEllipsoidAlphaRawCode_mem_FP + machineEllipsoidAlphaRawCode_mem_FP) + machineRawRatMulCode_mem_FP + +theorem machineEllipsoidTwiceAlphaSquareRawCode_mem_FP : + machineEllipsoidTwiceAlphaSquareRawCode ∈ FP := by + simpa only [machineEllipsoidTwiceAlphaSquareRawCode] using + machineCompose_mem_FP + (machinePair_mem_FP + (machineConst_mem_FP (rawRatBinaryCode rawEllipsoidTwo)) + machineEllipsoidAlphaSquareRawCode_mem_FP) + machineRawRatMulCode_mem_FP + +theorem machineEllipsoidPerpScaleRawCode_mem_FP : + machineEllipsoidPerpScaleRawCode ∈ FP := by + simpa only [machineEllipsoidPerpScaleRawCode] using + machineCompose_mem_FP + (machinePair_mem_FP + (machineConst_mem_FP (rawRatBinaryCode rawEllipsoidOne)) + machineEllipsoidTwiceAlphaSquareRawCode_mem_FP) + machineRawRatAddCode_mem_FP + +theorem machineEllipsoidAlphaOverDimensionRawCode_mem_FP : + machineEllipsoidAlphaOverDimensionRawCode ∈ FP := by + simpa only [machineEllipsoidAlphaOverDimensionRawCode] using + machineCompose_mem_FP + (machinePair_mem_FP machineEllipsoidAlphaRawCode_mem_FP + machineEllipsoidDimensionRawCode_mem_FP) + machineRawRatDivCode_mem_FP + +theorem machineEllipsoidParallelScaleRawCode_mem_FP : + machineEllipsoidParallelScaleRawCode ∈ FP := by + have hneg := machineCompose_mem_FP + machineEllipsoidAlphaOverDimensionRawCode_mem_FP + machineRawRatNegCode_mem_FP + simpa only [machineEllipsoidParallelScaleRawCode] using + machineCompose_mem_FP + (machinePair_mem_FP + (machineConst_mem_FP (rawRatBinaryCode rawEllipsoidOne)) + hneg) + machineRawRatAddCode_mem_FP + +theorem machineEllipsoidAlphaEntryCode_mem_FP : + machineEllipsoidAlphaEntryCode ∈ FP := by + simpa only [machineEllipsoidAlphaEntryCode] using + machineCompose_mem_FP machineEllipsoidAlphaRawCode_mem_FP + machineNormalizeRawRatEntryCode_mem_FP + +theorem machineEllipsoidPerpScaleEntryCode_mem_FP : + machineEllipsoidPerpScaleEntryCode ∈ FP := by + simpa only [machineEllipsoidPerpScaleEntryCode] using + machineCompose_mem_FP machineEllipsoidPerpScaleRawCode_mem_FP + machineNormalizeRawRatEntryCode_mem_FP + +theorem machineEllipsoidParallelScaleEntryCode_mem_FP : + machineEllipsoidParallelScaleEntryCode ∈ FP := by + simpa only [machineEllipsoidParallelScaleEntryCode] using + machineCompose_mem_FP machineEllipsoidParallelScaleRawCode_mem_FP + machineNormalizeRawRatEntryCode_mem_FP + +/-! ## Exact semantics -/ + +@[simp] theorem machineEllipsoidDimensionRawCode_encode (d : ℕ) : + machineEllipsoidDimensionRawCode d.bits = + rawRatBinaryCode (rawEllipsoidDimension d) := by + rw [machineEllipsoidDimensionRawCode, + machineNaturalIntegerCode_natBits] + simp [rawEllipsoidDimension, RawRat.ofNat, rawRatBinaryCode] + +@[simp] theorem machineEllipsoidDimensionSquareRawCode_encode (d : ℕ) : + machineEllipsoidDimensionSquareRawCode d.bits = + rawRatBinaryCode (rawEllipsoidDimensionSquare d) := by + rw [machineEllipsoidDimensionSquareRawCode, + machineEllipsoidDimensionRawCode_encode, + machineRawRatMulCode_encode] + rfl + +@[simp] theorem machineEllipsoidFourDimensionSquareRawCode_encode (d : ℕ) : + machineEllipsoidFourDimensionSquareRawCode d.bits = + rawRatBinaryCode (rawEllipsoidFourDimensionSquare d) := by + rw [machineEllipsoidFourDimensionSquareRawCode, + machineEllipsoidDimensionSquareRawCode_encode, + machineRawRatMulCode_encode] + rfl + +@[simp] theorem machineEllipsoidAlphaRawCode_encode (d : ℕ) : + machineEllipsoidAlphaRawCode d.bits = + rawRatBinaryCode (rawEllipsoidAlpha d) := by + rw [machineEllipsoidAlphaRawCode, + machineEllipsoidFourDimensionSquareRawCode_encode, + machineRawRatDivCode_encode] + rfl + +@[simp] theorem machineEllipsoidAlphaSquareRawCode_encode (d : ℕ) : + machineEllipsoidAlphaSquareRawCode d.bits = + rawRatBinaryCode (rawEllipsoidAlphaSquare d) := by + rw [machineEllipsoidAlphaSquareRawCode, + machineEllipsoidAlphaRawCode_encode, + machineRawRatMulCode_encode] + rfl + +@[simp] theorem machineEllipsoidTwiceAlphaSquareRawCode_encode (d : ℕ) : + machineEllipsoidTwiceAlphaSquareRawCode d.bits = + rawRatBinaryCode (rawEllipsoidTwiceAlphaSquare d) := by + rw [machineEllipsoidTwiceAlphaSquareRawCode, + machineEllipsoidAlphaSquareRawCode_encode, + machineRawRatMulCode_encode] + rfl + +@[simp] theorem machineEllipsoidPerpScaleRawCode_encode (d : ℕ) : + machineEllipsoidPerpScaleRawCode d.bits = + rawRatBinaryCode (rawEllipsoidPerpScale d) := by + rw [machineEllipsoidPerpScaleRawCode, + machineEllipsoidTwiceAlphaSquareRawCode_encode, + machineRawRatAddCode_encode] + rfl + +@[simp] theorem machineEllipsoidAlphaOverDimensionRawCode_encode (d : ℕ) : + machineEllipsoidAlphaOverDimensionRawCode d.bits = + rawRatBinaryCode (rawEllipsoidAlphaOverDimension d) := by + rw [machineEllipsoidAlphaOverDimensionRawCode, + machineEllipsoidAlphaRawCode_encode, + machineEllipsoidDimensionRawCode_encode, + machineRawRatDivCode_encode] + rfl + +@[simp] theorem machineEllipsoidParallelScaleRawCode_encode (d : ℕ) : + machineEllipsoidParallelScaleRawCode d.bits = + rawRatBinaryCode (rawEllipsoidParallelScale d) := by + rw [machineEllipsoidParallelScaleRawCode, + machineEllipsoidAlphaOverDimensionRawCode_encode, + machineRawRatNegCode_encode, + machineRawRatAddCode_encode] + rfl + +@[simp] theorem rawEllipsoidDimension_value (d : ℕ) : + (rawEllipsoidDimension d).value = d := by + simp [rawEllipsoidDimension] + +@[simp] theorem rawEllipsoidAlpha_value (d : ℕ) : + (rawEllipsoidAlpha d).value = rationalEllipsoidAlpha d := by + simp [rawEllipsoidAlpha, rawEllipsoidFourDimensionSquare, + rawEllipsoidDimensionSquare, rawEllipsoidFour, rawEllipsoidOne, + rationalEllipsoidAlpha] + ring + +@[simp] theorem rawEllipsoidPerpScale_value (d : ℕ) : + (rawEllipsoidPerpScale d).value = rationalEllipsoidPerpScale d := by + simp [rawEllipsoidPerpScale, rawEllipsoidTwiceAlphaSquare, + rawEllipsoidAlphaSquare, rawEllipsoidTwo, rawEllipsoidOne, + rationalEllipsoidPerpScale, pow_two] + +@[simp] theorem rawEllipsoidParallelScale_value (d : ℕ) : + (rawEllipsoidParallelScale d).value = + rationalEllipsoidParallelScale d := by + simp [rawEllipsoidParallelScale, rawEllipsoidAlphaOverDimension, + rawEllipsoidOne, rationalEllipsoidParallelScale] + +@[simp] theorem machineEllipsoidAlphaEntryCode_encode (d : ℕ) : + machineEllipsoidAlphaEntryCode d.bits = + rationalEntryBinaryCode (rationalEllipsoidAlpha d) := by + rw [machineEllipsoidAlphaEntryCode, + machineEllipsoidAlphaRawCode_encode, + machineNormalizeRawRatEntryCode_encode, + binaryNormalizeRawRat_eq_value, + rawEllipsoidAlpha_value] + +@[simp] theorem machineEllipsoidPerpScaleEntryCode_encode (d : ℕ) : + machineEllipsoidPerpScaleEntryCode d.bits = + rationalEntryBinaryCode (rationalEllipsoidPerpScale d) := by + rw [machineEllipsoidPerpScaleEntryCode, + machineEllipsoidPerpScaleRawCode_encode, + machineNormalizeRawRatEntryCode_encode, + binaryNormalizeRawRat_eq_value, + rawEllipsoidPerpScale_value] + +@[simp] theorem machineEllipsoidParallelScaleEntryCode_encode (d : ℕ) : + machineEllipsoidParallelScaleEntryCode d.bits = + rationalEntryBinaryCode (rationalEllipsoidParallelScale d) := by + rw [machineEllipsoidParallelScaleEntryCode, + machineEllipsoidParallelScaleRawCode_encode, + machineNormalizeRawRatEntryCode_encode, + binaryNormalizeRawRat_eq_value, + rawEllipsoidParallelScale_value] + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalEllipsoidUpdate.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalEllipsoidUpdate.lean new file mode 100644 index 0000000000..01a2057462 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalEllipsoidUpdate.lean @@ -0,0 +1,127 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalDirectionUpdateMatrix + +/-! +# Polynomial-time rational central ellipsoid update + +This module combines the verified center computation, the full rank-one +direction matrix, and exact matrix multiplication into the canonical code of +one complete rational ellipsoid state. +-/ + +namespace BeyondBethe + +open Complexity + +def machineRationalEllipsoidUpdateDirectionMatrixCode + (word : List Bool) : List Bool := + machineRationalDirectionUpdateMatrixCode + (pair (machineRationalCenterUpdateDimensionUnary word) + (pair (machineRationalCenterUpdateDimensionBits word) + (machineRationalCenterUpdatePulledBackCode word))) + +def machineRationalEllipsoidUpdateBasisCode + (word : List Bool) : List Bool := + machineRationalMatrixMulCode + (pair (machineRationalCenterUpdateDimensionUnary word) + (pair (machineRationalCenterUpdateBasisWord word) + (machineRationalEllipsoidUpdateDirectionMatrixCode word))) + +/-- Input: `pair rationalEllipsoidStateBinaryCode cutVectorCode`. -/ +def machineRationalEllipsoidCentralUpdateCode + (word : List Bool) : List Bool := + pair (machineRationalCenterUpdateDimensionBits word) + (pair (machineRationalEllipsoidCenterUpdateCode word) + (machineRationalEllipsoidUpdateBasisCode word)) + +theorem machineRationalEllipsoidUpdateDirectionMatrixCode_mem_FP : + machineRationalEllipsoidUpdateDirectionMatrixCode ∈ FP := by + have hinput := machinePair_mem_FP + machineRationalCenterUpdateDimensionUnary_mem_FP + (machinePair_mem_FP machineRationalCenterUpdateDimensionBits_mem_FP + machineRationalCenterUpdatePulledBackCode_mem_FP) + simpa only [machineRationalEllipsoidUpdateDirectionMatrixCode] using + machineCompose_mem_FP hinput + machineRationalDirectionUpdateMatrixCode_mem_FP + +theorem machineRationalEllipsoidUpdateBasisCode_mem_FP : + machineRationalEllipsoidUpdateBasisCode ∈ FP := by + have hinput := machinePair_mem_FP + machineRationalCenterUpdateDimensionUnary_mem_FP + (machinePair_mem_FP machineRationalCenterUpdateBasisWord_mem_FP + machineRationalEllipsoidUpdateDirectionMatrixCode_mem_FP) + simpa only [machineRationalEllipsoidUpdateBasisCode] using + machineCompose_mem_FP hinput machineRationalMatrixMulCode_mem_FP + +theorem machineRationalEllipsoidCentralUpdateCode_mem_FP : + machineRationalEllipsoidCentralUpdateCode ∈ FP := by + exact machinePair_mem_FP machineRationalCenterUpdateDimensionBits_mem_FP + (machinePair_mem_FP machineRationalEllipsoidCenterUpdateCode_mem_FP + machineRationalEllipsoidUpdateBasisCode_mem_FP) + +@[simp] theorem machineRationalEllipsoidUpdateDirectionMatrixCode_encode + {d : ℕ} (E : RationalEllipsoidState d) (a : Fin d → ℚ) : + machineRationalEllipsoidUpdateDirectionMatrixCode + (pair (rationalEllipsoidStateBinaryCode E) + (rationalFiniteVectorCode a)) = + rationalSquareMatrixRowsCode + (rationalDirectionUpdateMatrix (rationalPulledBackNormal E a)) := by + rw [machineRationalEllipsoidUpdateDirectionMatrixCode] + simp only [machineRationalCenterUpdateDimensionUnary_encode, + machineRationalCenterUpdateDimensionBits, + machineRationalCenterUpdateStateWord, machinePairFirst_pair, + machineRationalEllipsoidDimensionWord_encode, + machineRationalCenterUpdatePulledBackCode_encode] + change machineRationalDirectionUpdateMatrixCode + (rationalDirectionUpdateCanonicalWord + (rationalPulledBackNormal E a)) = _ + rw [machineRationalDirectionUpdateMatrixCode_encode] + +theorem rationalEllipsoidCentralUpdate_basis_eq {d : ℕ} + (E : RationalEllipsoidState d) (a : Fin d → ℚ) : + (rationalEllipsoidCentralUpdate E a).basis = + rationalMatrixMul E.basis + (rationalDirectionUpdateMatrix (rationalPulledBackNormal E a)) := by + simp only [rationalEllipsoidCentralUpdate, + rationalDirectionUpdateMatrix, rationalMatrixMul_eq_matrix_mul] + +@[simp] theorem machineRationalEllipsoidUpdateBasisCode_encode + {d : ℕ} (E : RationalEllipsoidState d) (a : Fin d → ℚ) : + machineRationalEllipsoidUpdateBasisCode + (pair (rationalEllipsoidStateBinaryCode E) + (rationalFiniteVectorCode a)) = + rationalSquareMatrixRowsCode + (rationalEllipsoidCentralUpdate E a).basis := by + rw [machineRationalEllipsoidUpdateBasisCode] + simp only [machineRationalCenterUpdateDimensionUnary_encode, + machineRationalCenterUpdateBasisWord, + machineRationalCenterUpdateStateWord, machinePairFirst_pair, + machineRationalEllipsoidBasisWord_encode, + machineRationalEllipsoidUpdateDirectionMatrixCode_encode] + change machineRationalMatrixMulCode + (rationalMatrixMulCanonicalWord E.basis + (rationalDirectionUpdateMatrix (rationalPulledBackNormal E a))) = _ + rw [machineRationalMatrixMulCode_encode, + ← rationalEllipsoidCentralUpdate_basis_eq] + +@[simp] theorem machineRationalEllipsoidCentralUpdateCode_encode + {d : ℕ} (E : RationalEllipsoidState d) (a : Fin d → ℚ) : + machineRationalEllipsoidCentralUpdateCode + (pair (rationalEllipsoidStateBinaryCode E) + (rationalFiniteVectorCode a)) = + rationalEllipsoidStateBinaryCode + (rationalEllipsoidCentralUpdate E a) := by + rw [machineRationalEllipsoidCentralUpdateCode, + machineRationalEllipsoidCenterUpdateCode_encode, + machineRationalEllipsoidUpdateBasisCode_encode] + simp only [machineRationalCenterUpdateDimensionBits, + machineRationalCenterUpdateStateWord, machinePairFirst_pair, + machineRationalEllipsoidDimensionWord, + rationalEllipsoidStateBinaryCode] + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalExp.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalExp.lean new file mode 100644 index 0000000000..bf9ef0ab7d --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalExp.lean @@ -0,0 +1,426 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineBoundedUnary +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalLogSeries + +/-! +# Guarded polynomial-time directed rational exponential + +The mathematical exponential routine uses + +`M = 2 * ceil (|s| + |s|^2 / loss) + 1` + +and returns `(1 + s/M)^M`. The binary code of `M` is always inexpensive to +compute, but a unary power ruler of length `M` is polynomial only on the +paper-specific domain where `M` has an a priori polynomial bound. Accordingly +this machine takes an explicit unary guard. It is polynomial-time on every +string and agrees exactly with the directed rational exponential whenever the +guard has length at least `M`. +-/ + +namespace BeyondBethe + +open Complexity + +def machineExpGuard (word : List Bool) : List Bool := + machinePairFirst word + +def machineExpPayload (word : List Bool) : List Bool := + machinePairSecond word + +def machineExpArgumentCode (word : List Bool) : List Bool := + machinePairFirst (machineExpPayload word) + +def machineExpLossCode (word : List Bool) : List Bool := + machinePairSecond (machineExpPayload word) + +def machineExpArgumentSign (word : List Bool) : List Bool := + machineHeadBit (machinePairFirst (machineExpArgumentCode word)) + +def machineExpMagnitudeCode (word : List Bool) : List Bool := + machineIfHead (machineExpArgumentSign word) + (machineRawRatNegCode (machineExpArgumentCode word)) + (machineExpArgumentCode word) + +def machineExpSquareCode (word : List Bool) : List Bool := + machineRawRatMulCode + (pair (machineExpMagnitudeCode word) (machineExpMagnitudeCode word)) + +def machineExpSquareOverLossCode (word : List Bool) : List Bool := + machineRawRatDivCode + (pair (machineExpSquareCode word) (machineExpLossCode word)) + +def machineExpScheduleArgumentCode (word : List Bool) : List Bool := + machineRawRatAddCode + (pair (machineExpMagnitudeCode word) + (machineExpSquareOverLossCode word)) + +def machineExpCeilBits (word : List Bool) : List Bool := + machineRationalCeilNatBits (machineExpScheduleArgumentCode word) + +/-- Little-endian binary code of `2 * ceil(...) + 1`. -/ +def machineExpStepsBits (word : List Bool) : List Bool := + true :: machineExpCeilBits word + +def machineExpStepsRuler (word : List Bool) : List Bool := + machineBoundedUnary (pair (machineExpGuard word) (machineExpStepsBits word)) + +def machineExpStepsRawRatCode (word : List Bool) : List Bool := + pair (machineNaturalIntegerCode (machineExpStepsBits word)) [true] + +def machineExpScaledArgumentCode (word : List Bool) : List Bool := + machineRawRatDivCode + (pair (machineExpArgumentCode word) (machineExpStepsRawRatCode word)) + +def machineExpBaseCode (word : List Bool) : List Bool := + machineRawRatAddCode + (pair rawRatOneCode (machineExpScaledArgumentCode word)) + +/-- Total guarded machine for the directed rational lower exponential. -/ +def machineBoundedRationalExpLowerCode (word : List Bool) : List Bool := + machineRationalPowerCode + (pair (machineExpStepsRuler word) (machineExpBaseCode word)) + +/-- Raw-entry variant used by certificate composition. It avoids decoding the +public one-natural-number rational output before the next rational operation. -/ +def machineBoundedRationalExpLowerRawPowerCode + (word : List Bool) : List Bool := + machineRawRatPowerCode + (pair (machineExpStepsRuler word) (machineExpBaseCode word)) + +def machineBoundedRationalExpLowerRawEntryCode + (word : List Bool) : List Bool := + machineNormalizeRawRatEntryCode + (machineBoundedRationalExpLowerRawPowerCode word) + +theorem machineExpGuard_mem_FP : machineExpGuard ∈ Complexity.FP := + machinePairFirst_mem_FP + +theorem machineExpPayload_mem_FP : machineExpPayload ∈ Complexity.FP := + machinePairSecond_mem_FP + +theorem machineExpArgumentCode_mem_FP : + machineExpArgumentCode ∈ Complexity.FP := by + simpa only [machineExpArgumentCode] using + machineCompose_mem_FP machineExpPayload_mem_FP machinePairFirst_mem_FP + +theorem machineExpLossCode_mem_FP : machineExpLossCode ∈ Complexity.FP := by + simpa only [machineExpLossCode] using + machineCompose_mem_FP machineExpPayload_mem_FP machinePairSecond_mem_FP + +theorem machineExpArgumentSign_mem_FP : + machineExpArgumentSign ∈ Complexity.FP := by + have hnum := machineCompose_mem_FP machineExpArgumentCode_mem_FP + machinePairFirst_mem_FP + simpa only [machineExpArgumentSign] using + machineCompose_mem_FP hnum machineHeadBit_mem_FP + +theorem machineExpMagnitudeCode_mem_FP : + machineExpMagnitudeCode ∈ Complexity.FP := by + have hneg := machineCompose_mem_FP machineExpArgumentCode_mem_FP + machineRawRatNegCode_mem_FP + simpa only [machineExpMagnitudeCode] using + machineIfHead_mem_FP machineExpArgumentSign_mem_FP hneg + machineExpArgumentCode_mem_FP + +theorem machineExpSquareCode_mem_FP : machineExpSquareCode ∈ Complexity.FP := by + have hpair := machinePair_mem_FP machineExpMagnitudeCode_mem_FP + machineExpMagnitudeCode_mem_FP + simpa only [machineExpSquareCode] using + machineCompose_mem_FP hpair machineRawRatMulCode_mem_FP + +theorem machineExpSquareOverLossCode_mem_FP : + machineExpSquareOverLossCode ∈ Complexity.FP := by + have hpair := machinePair_mem_FP machineExpSquareCode_mem_FP + machineExpLossCode_mem_FP + simpa only [machineExpSquareOverLossCode] using + machineCompose_mem_FP hpair machineRawRatDivCode_mem_FP + +theorem machineExpScheduleArgumentCode_mem_FP : + machineExpScheduleArgumentCode ∈ Complexity.FP := by + have hpair := machinePair_mem_FP machineExpMagnitudeCode_mem_FP + machineExpSquareOverLossCode_mem_FP + simpa only [machineExpScheduleArgumentCode] using + machineCompose_mem_FP hpair machineRawRatAddCode_mem_FP + +theorem machineExpCeilBits_mem_FP : machineExpCeilBits ∈ Complexity.FP := by + simpa only [machineExpCeilBits] using + machineCompose_mem_FP machineExpScheduleArgumentCode_mem_FP + machineRationalCeilNatBits_mem_FP + +theorem machineExpStepsBits_mem_FP : machineExpStepsBits ∈ Complexity.FP := by + simpa only [machineExpStepsBits] using + machineCompose_mem_FP machineExpCeilBits_mem_FP + (machinePrepend_mem_FP true) + +theorem machineExpStepsRuler_mem_FP : + machineExpStepsRuler ∈ Complexity.FP := by + have hpair := machinePair_mem_FP machineExpGuard_mem_FP + machineExpStepsBits_mem_FP + simpa only [machineExpStepsRuler] using + machineCompose_mem_FP hpair machineBoundedUnary_mem_FP + +theorem machineExpStepsRawRatCode_mem_FP : + machineExpStepsRawRatCode ∈ Complexity.FP := by + have hnum := machineCompose_mem_FP machineExpStepsBits_mem_FP + (machinePrepend_mem_FP false) + exact machinePair_mem_FP hnum (machineConst_mem_FP [true]) + +theorem machineExpScaledArgumentCode_mem_FP : + machineExpScaledArgumentCode ∈ Complexity.FP := by + have hpair := machinePair_mem_FP machineExpArgumentCode_mem_FP + machineExpStepsRawRatCode_mem_FP + simpa only [machineExpScaledArgumentCode] using + machineCompose_mem_FP hpair machineRawRatDivCode_mem_FP + +theorem machineExpBaseCode_mem_FP : machineExpBaseCode ∈ Complexity.FP := by + have hpair := machinePair_mem_FP (machineConst_mem_FP rawRatOneCode) + machineExpScaledArgumentCode_mem_FP + simpa only [machineExpBaseCode] using + machineCompose_mem_FP hpair machineRawRatAddCode_mem_FP + +theorem machineBoundedRationalExpLowerCode_mem_FP : + machineBoundedRationalExpLowerCode ∈ Complexity.FP := by + have hpair := machinePair_mem_FP machineExpStepsRuler_mem_FP + machineExpBaseCode_mem_FP + simpa only [machineBoundedRationalExpLowerCode] using + machineCompose_mem_FP hpair machineRationalPowerCode_mem_FP + +theorem machineBoundedRationalExpLowerRawPowerCode_mem_FP : + machineBoundedRationalExpLowerRawPowerCode ∈ Complexity.FP := by + have hpair := machinePair_mem_FP machineExpStepsRuler_mem_FP + machineExpBaseCode_mem_FP + simpa only [machineBoundedRationalExpLowerRawPowerCode] using + machineCompose_mem_FP hpair machineRawRatPowerCode_mem_FP + +theorem machineBoundedRationalExpLowerRawEntryCode_mem_FP : + machineBoundedRationalExpLowerRawEntryCode ∈ Complexity.FP := by + simpa only [machineBoundedRationalExpLowerRawEntryCode] using + machineCompose_mem_FP + machineBoundedRationalExpLowerRawPowerCode_mem_FP + machineNormalizeRawRatEntryCode_mem_FP + +/-! ## Exact semantics when the schedule fits the guard -/ + +namespace RawRat + +/-- Magnitude used only to choose the exponential schedule. -/ +def expMagnitude (q : RawRat) : RawRat := + match q.num with + | .ofNat _ => q + | .negSucc _ => q.neg + +def expApproxSteps (s loss : RawRat) : ℕ := + binaryRationalExpApproxSteps (expMagnitude s).value loss.value + +end RawRat + +@[simp] theorem machineExpGuard_encode + (guard : List Bool) (s loss : RawRat) : + machineExpGuard + (pair guard (pair (rawRatBinaryCode s) (rawRatBinaryCode loss))) = + guard := by + simp [machineExpGuard] + +@[simp] theorem machineExpArgumentCode_encode + (guard : List Bool) (s loss : RawRat) : + machineExpArgumentCode + (pair guard (pair (rawRatBinaryCode s) (rawRatBinaryCode loss))) = + rawRatBinaryCode s := by + simp [machineExpArgumentCode, machineExpPayload] + +@[simp] theorem machineExpLossCode_encode + (guard : List Bool) (s loss : RawRat) : + machineExpLossCode + (pair guard (pair (rawRatBinaryCode s) (rawRatBinaryCode loss))) = + rawRatBinaryCode loss := by + simp [machineExpLossCode, machineExpPayload] + +@[simp] theorem machineExpMagnitudeCode_encode + (guard : List Bool) (s loss : RawRat) : + machineExpMagnitudeCode + (pair guard (pair (rawRatBinaryCode s) (rawRatBinaryCode loss))) = + rawRatBinaryCode (RawRat.expMagnitude s) := by + rcases s with ⟨num, den, hden⟩ + cases num with + | ofNat n => + simp [machineExpMagnitudeCode, machineExpArgumentSign, + machineExpArgumentCode, machineExpPayload, rawRatBinaryCode, + integerBinaryCode, RawRat.expMagnitude] + | negSucc n => + simp only [machineExpMagnitudeCode, machineExpArgumentSign, + machineExpArgumentCode, machineExpPayload, rawRatBinaryCode, + integerBinaryCode, machinePairSecond_pair, machinePairFirst_pair, + machineHeadBit_cons, machineIfHead_true, RawRat.expMagnitude] + simpa only [rawRatBinaryCode] using + (machineRawRatNegCode_encode + (⟨Int.negSucc n, den, hden⟩ : RawRat)) + +@[simp] theorem machineExpSquareCode_encode + (guard : List Bool) (s loss : RawRat) : + machineExpSquareCode + (pair guard (pair (rawRatBinaryCode s) (rawRatBinaryCode loss))) = + rawRatBinaryCode + ((RawRat.expMagnitude s).mul (RawRat.expMagnitude s)) := by + rw [machineExpSquareCode] + simp only [machineExpMagnitudeCode_encode, machineRawRatMulCode_encode] + +@[simp] theorem machineExpSquareOverLossCode_encode + (guard : List Bool) (s loss : RawRat) : + machineExpSquareOverLossCode + (pair guard (pair (rawRatBinaryCode s) (rawRatBinaryCode loss))) = + rawRatBinaryCode + (((RawRat.expMagnitude s).mul (RawRat.expMagnitude s)).div loss) := by + rw [machineExpSquareOverLossCode] + simp only [machineExpSquareCode_encode, machineExpLossCode_encode, + machineRawRatDivCode_encode] + +@[simp] theorem machineExpScheduleArgumentCode_encode + (guard : List Bool) (s loss : RawRat) : + machineExpScheduleArgumentCode + (pair guard (pair (rawRatBinaryCode s) (rawRatBinaryCode loss))) = + rawRatBinaryCode + ((RawRat.expMagnitude s).add + (((RawRat.expMagnitude s).mul (RawRat.expMagnitude s)).div loss)) := by + rw [machineExpScheduleArgumentCode] + simp only [machineExpMagnitudeCode_encode, + machineExpSquareOverLossCode_encode, machineRawRatAddCode_encode] + +@[simp] theorem machineExpCeilBits_encode + (guard : List Bool) (s loss : RawRat) : + machineExpCeilBits + (pair guard (pair (rawRatBinaryCode s) (rawRatBinaryCode loss))) = + (Int.toNat (binaryRatCeil + ((RawRat.expMagnitude s).value + + (RawRat.expMagnitude s).value ^ 2 / loss.value))).bits := by + rw [machineExpCeilBits, machineExpScheduleArgumentCode_encode, + machineRationalCeilNatBits_encode] + congr 2 + rw [RawRat.value_add, RawRat.value_div, RawRat.value_mul] + ring + +@[simp] theorem machineExpStepsBits_encode + (guard : List Bool) (s loss : RawRat) : + machineExpStepsBits + (pair guard (pair (rawRatBinaryCode s) (rawRatBinaryCode loss))) = + (RawRat.expApproxSteps s loss).bits := by + rw [machineExpStepsBits, machineExpCeilBits_encode] + simp [RawRat.expApproxSteps, binaryRationalExpApproxSteps, + binaryRationalCeilNat, binaryRatAdd_eq_add, + binaryRatDiv_eq_div, binaryRatPow_eq_pow] + +@[simp] theorem machineExpStepsRawRatCode_encode + (guard : List Bool) (s loss : RawRat) : + machineExpStepsRawRatCode + (pair guard (pair (rawRatBinaryCode s) (rawRatBinaryCode loss))) = + rawRatBinaryCode (RawRat.ofNat (RawRat.expApproxSteps s loss)) := by + rw [machineExpStepsRawRatCode, machineExpStepsBits_encode, + machineNaturalIntegerCode_natBits] + simp [rawRatBinaryCode, RawRat.ofNat] + +@[simp] theorem machineExpStepsRuler_encode + (guard : List Bool) (s loss : RawRat) + (hsteps : RawRat.expApproxSteps s loss ≤ guard.length) : + machineExpStepsRuler + (pair guard (pair (rawRatBinaryCode s) (rawRatBinaryCode loss))) = + List.replicate (RawRat.expApproxSteps s loss) true := by + rw [machineExpStepsRuler] + simp only [machineExpGuard_encode, machineExpStepsBits_encode] + exact machineBoundedUnary_encode_of_le guard _ hsteps + +@[simp] theorem machineExpScaledArgumentCode_encode + (guard : List Bool) (s loss : RawRat) : + machineExpScaledArgumentCode + (pair guard (pair (rawRatBinaryCode s) (rawRatBinaryCode loss))) = + rawRatBinaryCode (s.div (RawRat.ofNat (RawRat.expApproxSteps s loss))) := by + rw [machineExpScaledArgumentCode] + simp only [machineExpArgumentCode_encode, + machineExpStepsRawRatCode_encode, machineRawRatDivCode_encode] + +@[simp] theorem machineExpBaseCode_encode + (guard : List Bool) (s loss : RawRat) : + machineExpBaseCode + (pair guard (pair (rawRatBinaryCode s) (rawRatBinaryCode loss))) = + rawRatBinaryCode + (RawRat.one.add + (s.div (RawRat.ofNat (RawRat.expApproxSteps s loss)))) := by + rw [machineExpBaseCode] + simp only [rawRatOneCode, machineExpScaledArgumentCode_encode, + machineRawRatAddCode_encode] + +theorem binaryNormalizeRawRat_expBasePow_eq + (s loss : RawRat) : + binaryNormalizeRawRat + ((RawRat.one.add + (s.div (RawRat.ofNat (RawRat.expApproxSteps s loss)))).pow + (RawRat.expApproxSteps s loss)) = + binaryRationalExpLower s.value loss.value := by + rw [binaryNormalizeRawRat_eq_value, RawRat.value_pow, + RawRat.value_add, RawRat.value_one, RawRat.value_div, + RawRat.value_ofNat] + rcases s with ⟨num, den, hden⟩ + cases num with + | ofNat n => + have hs : 0 ≤ ((⟨Int.ofNat n, den, hden⟩ : RawRat).value) := by + change (0 : ℚ) ≤ (n : ℚ) / (den : ℚ) + exact div_nonneg (Nat.cast_nonneg n) (Nat.cast_nonneg den) + rw [binaryRationalExpLower, + if_pos ((binaryRatNonnegative_eq_true_iff _).2 hs), + binaryRationalPositiveExpLower] + simp [RawRat.expApproxSteps, RawRat.expMagnitude, + binaryRatAdd_eq_add, binaryRatDiv_eq_div, + binaryRatPow_eq_pow] + | negSucc n => + have hs : ¬ 0 ≤ ((⟨Int.negSucc n, den, hden⟩ : RawRat).value) := by + rw [RawRat.value] + have hn : (0 : ℚ) ≤ n := by positivity + have hnum : (((Int.negSucc n : ℤ) : ℚ)) < 0 := by + norm_num only [Int.cast_negSucc, Nat.cast_add, Nat.cast_one] + linarith + have hdenQ : (0 : ℚ) < den := by exact_mod_cast hden + exact not_le_of_gt (div_neg_of_neg_of_pos hnum hdenQ) + have hflag : ¬ binaryRatNonnegative + ((⟨Int.negSucc n, den, hden⟩ : RawRat).value) = true := + fun h => hs ((binaryRatNonnegative_eq_true_iff _).1 h) + rw [binaryRationalExpLower, if_neg hflag, + binaryRationalNegativeExpLower] + simp [RawRat.expApproxSteps, RawRat.expMagnitude, + binaryRatNeg_eq_neg, binaryRatSub_eq_sub, + binaryRatDiv_eq_div, binaryRatPow_eq_pow, + RawRat.value_neg] + ring + +theorem machineBoundedRationalExpLowerCode_encode + (guard : List Bool) (s loss : RawRat) + (hsteps : RawRat.expApproxSteps s loss ≤ guard.length) : + machineBoundedRationalExpLowerCode + (pair guard (pair (rawRatBinaryCode s) (rawRatBinaryCode loss))) = + rationalBinaryCode (binaryRationalExpLower s.value loss.value) := by + rw [machineBoundedRationalExpLowerCode, + machineExpStepsRuler_encode guard s loss hsteps, + machineExpBaseCode_encode, + machineRationalPowerCode_encode] + exact congrArg rationalBinaryCode + (binaryNormalizeRawRat_expBasePow_eq s loss) + +theorem machineBoundedRationalExpLowerRawEntryCode_encode + (guard : List Bool) (s loss : RawRat) + (hsteps : RawRat.expApproxSteps s loss ≤ guard.length) : + machineBoundedRationalExpLowerRawEntryCode + (pair guard (pair (rawRatBinaryCode s) (rawRatBinaryCode loss))) = + rawRatBinaryCode + (rawRatOfRat (binaryRationalExpLower s.value loss.value)) := by + rw [machineBoundedRationalExpLowerRawEntryCode, + machineBoundedRationalExpLowerRawPowerCode, + machineExpStepsRuler_encode guard s loss hsteps, + machineExpBaseCode_encode, + machineRawRatPowerCode_encode, + machineNormalizeRawRatEntryCode_encode, + binaryNormalizeRawRat_expBasePow_eq] + simp [rawRatBinaryCode, rawRatOfRat, rationalEntryBinaryCode] + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalFloor.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalFloor.lean new file mode 100644 index 0000000000..a30095be0b --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalFloor.lean @@ -0,0 +1,100 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineDyadicFloor +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalUnary + +/-! +# Polynomial-time rational floor and ceiling + +This file specializes the verified dyadic-floor machine at precision zero. +Floor and ceiling are returned as canonical signed binary integers. The +natural ceiling used by later schedules is returned in ordinary binary, not +unary: converting an unrestricted binary integer to a word of that length +would not be a polynomial-time operation. +-/ + +namespace BeyondBethe + +open Complexity + +/-- Canonical signed binary code of the floor of an unreduced rational. -/ +def machineRationalFloorIntegerCode (word : List Bool) : List Bool := + machineDyadicFloorIntegerCode (pair [] word) + +/-- Canonical signed binary code of the ceiling of an unreduced rational. -/ +def machineRationalCeilIntegerCode (word : List Bool) : List Bool := + machineIntegerNegCode + (machineRationalFloorIntegerCode (machineRawRatNegCode word)) + +/-- Convert the project's canonical signed-integer code to ordinary natural +bits using `Int.toNat` semantics. -/ +def machineIntegerToNatBits (word : List Bool) : List Bool := + machineIfHead word [] word.tail + +/-- Ordinary binary bits of the nonnegative natural ceiling. -/ +def machineRationalCeilNatBits (word : List Bool) : List Bool := + machineIntegerToNatBits (machineRationalCeilIntegerCode word) + +theorem machineRationalFloorIntegerCode_mem_FP : + machineRationalFloorIntegerCode ∈ Complexity.FP := by + have hpair := machinePair_mem_FP (machineConst_mem_FP []) id_mem_FP + simpa only [machineRationalFloorIntegerCode] using + machineCompose_mem_FP hpair machineDyadicFloorIntegerCode_mem_FP + +theorem machineRationalCeilIntegerCode_mem_FP : + machineRationalCeilIntegerCode ∈ Complexity.FP := by + have hneg := machineCompose_mem_FP machineRawRatNegCode_mem_FP + machineRationalFloorIntegerCode_mem_FP + simpa only [machineRationalCeilIntegerCode] using + machineCompose_mem_FP hneg machineIntegerNegCode_mem_FP + +theorem machineIntegerToNatBits_mem_FP : + machineIntegerToNatBits ∈ Complexity.FP := by + simpa only [machineIntegerToNatBits] using + machineIfHead_mem_FP id_mem_FP (machineConst_mem_FP []) + machineTail_mem_FP + +theorem machineRationalCeilNatBits_mem_FP : + machineRationalCeilNatBits ∈ Complexity.FP := by + simpa only [machineRationalCeilNatBits] using + machineCompose_mem_FP machineRationalCeilIntegerCode_mem_FP + machineIntegerToNatBits_mem_FP + +theorem binaryRawFloorInt_eq_binaryRatFloor (q : RawRat) : + binaryRawDyadicFloorInt 0 q = binaryRatFloor q.value := by + rw [binaryRatFloor_eq_floor, binaryRawDyadicFloorInt_eq_floor] + norm_num + +theorem machineRationalFloorIntegerCode_encode (q : RawRat) : + machineRationalFloorIntegerCode (rawRatBinaryCode q) = + integerBinaryCode (binaryRatFloor q.value) := by + rw [machineRationalFloorIntegerCode] + simpa only [List.replicate_zero] using + (machineDyadicFloorIntegerCode_encode 0 q).trans + (congrArg integerBinaryCode (binaryRawFloorInt_eq_binaryRatFloor q)) + +theorem machineRationalCeilIntegerCode_encode (q : RawRat) : + machineRationalCeilIntegerCode (rawRatBinaryCode q) = + integerBinaryCode (binaryRatCeil q.value) := by + rw [machineRationalCeilIntegerCode, machineRawRatNegCode_encode, + machineRationalFloorIntegerCode_encode, machineIntegerNegCode_encode] + congr 1 + simp [binaryRatCeil, binaryRatFloor_eq_floor] + +@[simp] theorem machineIntegerToNatBits_encode (z : ℤ) : + machineIntegerToNatBits (integerBinaryCode z) = z.toNat.bits := by + cases z with + | ofNat n => simp [machineIntegerToNatBits, integerBinaryCode] + | negSucc n => simp [machineIntegerToNatBits, integerBinaryCode] + +theorem machineRationalCeilNatBits_encode (q : RawRat) : + machineRationalCeilNatBits (rawRatBinaryCode q) = + (Int.toNat (binaryRatCeil q.value)).bits := by + rw [machineRationalCeilNatBits, machineRationalCeilIntegerCode_encode, + machineIntegerToNatBits_encode] + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalLogSeries.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalLogSeries.lean new file mode 100644 index 0000000000..6fe087f38a --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalLogSeries.lean @@ -0,0 +1,734 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalFloor +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalPower +import LeanPool.BeyondBethe.BeyondBethe.BinaryDirectedElementary + +/-! +# Polynomial-time rational logarithm-series loop + +The iteration count is a unary ruler. A state stores the partial sum, the +current odd power, the fixed square of the input, the current odd denominator, +and a quartic-width guard. The guard makes the function polynomial-time on +arbitrary strings. The semantic part below proves that none of the three +guarded updates is truncated on a well-formed input. +-/ + +namespace BeyondBethe + +open Complexity + +def rawRatZeroCode : List Bool := rawRatBinaryCode RawRat.zero + +def machineLogSeriesPack + (sum power square odd bound : List Bool) : List Bool := + pair sum (pair power (pair square (pair odd bound))) + +def machineLogSeriesSumField (state : List Bool) : List Bool := + machinePairFirst state + +def machineLogSeriesPowerField (state : List Bool) : List Bool := + machinePairFirst (machinePairSecond state) + +def machineLogSeriesSquareField (state : List Bool) : List Bool := + machinePairFirst (machinePairSecond (machinePairSecond state)) + +def machineLogSeriesOddField (state : List Bool) : List Bool := + machinePairFirst + (machinePairSecond (machinePairSecond (machinePairSecond state))) + +def machineLogSeriesBoundField (state : List Bool) : List Bool := + machinePairSecond + (machinePairSecond (machinePairSecond (machinePairSecond state))) + +def machineLogSeriesOddRawRatCode (state : List Bool) : List Bool := + pair (machineNaturalIntegerCode (machineLogSeriesOddField state)) [true] + +def machineLogSeriesTermCandidate (state : List Bool) : List Bool := + machineRawRatDivCode + (pair (machineLogSeriesPowerField state) + (machineLogSeriesOddRawRatCode state)) + +def machineLogSeriesSumCandidate (state : List Bool) : List Bool := + machineRawRatAddCode + (pair (machineLogSeriesSumField state) + (machineLogSeriesTermCandidate state)) + +def machineLogSeriesPowerCandidate (state : List Bool) : List Bool := + machineRawRatMulCode + (pair (machineLogSeriesPowerField state) + (machineLogSeriesSquareField state)) + +def machineLogSeriesOddCandidate (state : List Bool) : List Bool := + machineBinaryAddBits + (pair (machineLogSeriesOddField state) [false, true]) + +def machineLogSeriesClamp + (candidate : List Bool → List Bool) (state : List Bool) : List Bool := + (candidate state).take (machineLogSeriesBoundField state).length + +def machineLogSeriesStep (state : List Bool) : List Bool := + machineLogSeriesPack + (machineLogSeriesClamp machineLogSeriesSumCandidate state) + (machineLogSeriesClamp machineLogSeriesPowerCandidate state) + (machineLogSeriesSquareField state) + (machineLogSeriesClamp machineLogSeriesOddCandidate state) + (machineLogSeriesBoundField state) + +def machineLogSeriesInputRuler (word : List Bool) : List Bool := + machinePairFirst word + +def machineLogSeriesInputBase (word : List Bool) : List Bool := + machinePairSecond word + +/-- A quartic guard. Its length dominates the cubic bit growth of every +well-formed partial sum while remaining polynomial on arbitrary inputs. -/ +def machineLogSeriesInputBound (word : List Bool) : List Bool := + machineBinaryMulWidth (machineBinaryMulWidth word) + +def machineLogSeriesInitialSquareCandidate (word : List Bool) : List Bool := + machineRawRatMulCode + (pair (machineLogSeriesInputBase word) + (machineLogSeriesInputBase word)) + +def machineLogSeriesInit (word : List Bool) : List Bool := + let bound := machineLogSeriesInputBound word + machineLogSeriesPack rawRatZeroCode + (List.take bound.length (machineLogSeriesInputBase word)) + (List.take bound.length (machineLogSeriesInitialSquareCandidate word)) + [true] bound + +def machineLogSeriesWidth (word : List Bool) : List Bool := + let bound := machineLogSeriesInputBound word + machineLogSeriesPack bound bound bound bound bound + +def machineLogSeriesFinalState (word : List Bool) : List Bool := + (machineLogSeriesStep)^[(machineLogSeriesInputRuler word).length] + (machineLogSeriesInit word) + +def machineRawRationalLogSeriesSumCode (word : List Bool) : List Bool := + machineLogSeriesSumField (machineLogSeriesFinalState word) + +def machineRationalLogSeriesSumCode (word : List Bool) : List Bool := + machineNormalizeRawRatBinaryCode (machineRawRationalLogSeriesSumCode word) + +theorem machineLogSeriesSumField_mem_FP : + machineLogSeriesSumField ∈ Complexity.FP := machinePairFirst_mem_FP + +theorem machineLogSeriesPowerField_mem_FP : + machineLogSeriesPowerField ∈ Complexity.FP := by + simpa only [machineLogSeriesPowerField] using + machineCompose_mem_FP machinePairSecond_mem_FP machinePairFirst_mem_FP + +theorem machineLogSeriesSquareField_mem_FP : + machineLogSeriesSquareField ∈ Complexity.FP := by + have hrest := machineCompose_mem_FP machinePairSecond_mem_FP + machinePairSecond_mem_FP + simpa only [machineLogSeriesSquareField] using + machineCompose_mem_FP hrest machinePairFirst_mem_FP + +theorem machineLogSeriesOddField_mem_FP : + machineLogSeriesOddField ∈ Complexity.FP := by + have hrest2 := machineCompose_mem_FP machinePairSecond_mem_FP + machinePairSecond_mem_FP + have hrest3 := machineCompose_mem_FP hrest2 machinePairSecond_mem_FP + simpa only [machineLogSeriesOddField] using + machineCompose_mem_FP hrest3 machinePairFirst_mem_FP + +theorem machineLogSeriesBoundField_mem_FP : + machineLogSeriesBoundField ∈ Complexity.FP := by + have hrest2 := machineCompose_mem_FP machinePairSecond_mem_FP + machinePairSecond_mem_FP + have hrest3 := machineCompose_mem_FP hrest2 machinePairSecond_mem_FP + simpa only [machineLogSeriesBoundField] using + machineCompose_mem_FP hrest3 machinePairSecond_mem_FP + +theorem machineLogSeriesOddRawRatCode_mem_FP : + machineLogSeriesOddRawRatCode ∈ Complexity.FP := by + have hnum := machineCompose_mem_FP machineLogSeriesOddField_mem_FP + (machinePrepend_mem_FP false) + exact machinePair_mem_FP hnum (machineConst_mem_FP [true]) + +theorem machineLogSeriesTermCandidate_mem_FP : + machineLogSeriesTermCandidate ∈ Complexity.FP := by + have hpair := machinePair_mem_FP machineLogSeriesPowerField_mem_FP + machineLogSeriesOddRawRatCode_mem_FP + simpa only [machineLogSeriesTermCandidate] using + machineCompose_mem_FP hpair machineRawRatDivCode_mem_FP + +theorem machineLogSeriesSumCandidate_mem_FP : + machineLogSeriesSumCandidate ∈ Complexity.FP := by + have hpair := machinePair_mem_FP machineLogSeriesSumField_mem_FP + machineLogSeriesTermCandidate_mem_FP + simpa only [machineLogSeriesSumCandidate] using + machineCompose_mem_FP hpair machineRawRatAddCode_mem_FP + +theorem machineLogSeriesPowerCandidate_mem_FP : + machineLogSeriesPowerCandidate ∈ Complexity.FP := by + have hpair := machinePair_mem_FP machineLogSeriesPowerField_mem_FP + machineLogSeriesSquareField_mem_FP + simpa only [machineLogSeriesPowerCandidate] using + machineCompose_mem_FP hpair machineRawRatMulCode_mem_FP + +theorem machineLogSeriesOddCandidate_mem_FP : + machineLogSeriesOddCandidate ∈ Complexity.FP := by + have hpair := machinePair_mem_FP machineLogSeriesOddField_mem_FP + (machineConst_mem_FP [false, true]) + simpa only [machineLogSeriesOddCandidate] using + machineCompose_mem_FP hpair machineBinaryAddBits_mem_FP + +theorem machineLogSeriesClamp_mem_FP + {candidate : List Bool → List Bool} (hcandidate : candidate ∈ Complexity.FP) : + (fun state => machineLogSeriesClamp candidate state) ∈ Complexity.FP := by + simpa only [machineLogSeriesClamp] using + machineTake_mem_FP machineLogSeriesBoundField_mem_FP hcandidate + +theorem machineLogSeriesStep_mem_FP : + machineLogSeriesStep ∈ Complexity.FP := by + exact machinePair_mem_FP + (machineLogSeriesClamp_mem_FP machineLogSeriesSumCandidate_mem_FP) + (machinePair_mem_FP + (machineLogSeriesClamp_mem_FP machineLogSeriesPowerCandidate_mem_FP) + (machinePair_mem_FP machineLogSeriesSquareField_mem_FP + (machinePair_mem_FP + (machineLogSeriesClamp_mem_FP machineLogSeriesOddCandidate_mem_FP) + machineLogSeriesBoundField_mem_FP))) + +theorem machineLogSeriesInputRuler_mem_FP : + machineLogSeriesInputRuler ∈ Complexity.FP := machinePairFirst_mem_FP + +theorem machineLogSeriesInputBase_mem_FP : + machineLogSeriesInputBase ∈ Complexity.FP := machinePairSecond_mem_FP + +theorem machineLogSeriesInputBound_mem_FP : + machineLogSeriesInputBound ∈ Complexity.FP := by + simpa only [machineLogSeriesInputBound] using + machineCompose_mem_FP machineBinaryMulWidth_mem_FP + machineBinaryMulWidth_mem_FP + +theorem machineLogSeriesInitialSquareCandidate_mem_FP : + machineLogSeriesInitialSquareCandidate ∈ Complexity.FP := by + have hpair := machinePair_mem_FP machineLogSeriesInputBase_mem_FP + machineLogSeriesInputBase_mem_FP + simpa only [machineLogSeriesInitialSquareCandidate] using + machineCompose_mem_FP hpair machineRawRatMulCode_mem_FP + +theorem machineLogSeriesInit_mem_FP : machineLogSeriesInit ∈ Complexity.FP := by + have hbase := machineTake_mem_FP machineLogSeriesInputBound_mem_FP + machineLogSeriesInputBase_mem_FP + have hsquare := machineTake_mem_FP machineLogSeriesInputBound_mem_FP + machineLogSeriesInitialSquareCandidate_mem_FP + simpa only [machineLogSeriesInit, machineLogSeriesPack] using + machinePair_mem_FP (machineConst_mem_FP rawRatZeroCode) + (machinePair_mem_FP hbase + (machinePair_mem_FP hsquare + (machinePair_mem_FP (machineConst_mem_FP [true]) + machineLogSeriesInputBound_mem_FP))) + +theorem machineLogSeriesWidth_mem_FP : + machineLogSeriesWidth ∈ Complexity.FP := by + exact machinePair_mem_FP machineLogSeriesInputBound_mem_FP + (machinePair_mem_FP machineLogSeriesInputBound_mem_FP + (machinePair_mem_FP machineLogSeriesInputBound_mem_FP + (machinePair_mem_FP machineLogSeriesInputBound_mem_FP + machineLogSeriesInputBound_mem_FP))) + +def MachineLogSeriesStateBound (word state : List Bool) : Prop := + state = machineLogSeriesPack + (machineLogSeriesSumField state) + (machineLogSeriesPowerField state) + (machineLogSeriesSquareField state) + (machineLogSeriesOddField state) + (machineLogSeriesBoundField state) ∧ + (machineLogSeriesSumField state).length ≤ + (machineLogSeriesInputBound word).length ∧ + (machineLogSeriesPowerField state).length ≤ + (machineLogSeriesInputBound word).length ∧ + (machineLogSeriesSquareField state).length ≤ + (machineLogSeriesInputBound word).length ∧ + (machineLogSeriesOddField state).length ≤ + (machineLogSeriesInputBound word).length ∧ + (machineLogSeriesBoundField state).length ≤ + (machineLogSeriesInputBound word).length + +@[simp] theorem machineLogSeriesFields_pack + (sum power square odd bound : List Bool) : + machineLogSeriesSumField + (machineLogSeriesPack sum power square odd bound) = sum ∧ + machineLogSeriesPowerField + (machineLogSeriesPack sum power square odd bound) = power ∧ + machineLogSeriesSquareField + (machineLogSeriesPack sum power square odd bound) = square ∧ + machineLogSeriesOddField + (machineLogSeriesPack sum power square odd bound) = odd ∧ + machineLogSeriesBoundField + (machineLogSeriesPack sum power square odd bound) = bound := by + simp [machineLogSeriesPack, machineLogSeriesSumField, + machineLogSeriesPowerField, machineLogSeriesSquareField, + machineLogSeriesOddField, machineLogSeriesBoundField] + +theorem machineLogSeriesInputBound_nontrivial (word : List Bool) : + 5 ≤ (machineLogSeriesInputBound word).length := by + simp [machineLogSeriesInputBound, machineBinaryMulWidth] + nlinarith + +theorem machineLogSeriesInit_bound (word : List Bool) : + MachineLogSeriesStateBound word (machineLogSeriesInit word) := by + simp only [MachineLogSeriesStateBound, machineLogSeriesInit, + machineLogSeriesFields_pack] + have hbound := machineLogSeriesInputBound_nontrivial word + constructor + · trivial + constructor + · simp [rawRatZeroCode, rawRatBinaryCode, RawRat.zero, + integerBinaryCode] + omega + constructor + · exact List.length_take_le _ _ + constructor + · exact List.length_take_le _ _ + constructor + · simp + omega + · exact le_rfl + +theorem machineLogSeriesStep_bound {word state : List Bool} + (hstate : MachineLogSeriesStateBound word state) : + MachineLogSeriesStateBound word (machineLogSeriesStep state) := by + rcases hstate with ⟨_, hsum, hpower, hsquare, hodd, hbound⟩ + simp only [MachineLogSeriesStateBound, machineLogSeriesStep, + machineLogSeriesFields_pack] + constructor + · trivial + constructor + · exact (List.length_take_le _ _).trans hbound + constructor + · exact (List.length_take_le _ _).trans hbound + constructor + · exact hsquare + constructor + · exact (List.length_take_le _ _).trans hbound + · exact hbound + +theorem machineLogSeriesIterate_bound (word : List Bool) : ∀ k, + MachineLogSeriesStateBound word + ((machineLogSeriesStep)^[k] (machineLogSeriesInit word)) := by + intro k + induction k with + | zero => exact machineLogSeriesInit_bound word + | succ k ih => + rw [Function.iterate_succ_apply'] + exact machineLogSeriesStep_bound ih + +theorem machineLogSeriesPack_length_le_width + (word state : List Bool) (hstate : MachineLogSeriesStateBound word state) : + state.length ≤ (machineLogSeriesWidth word).length := by + rcases hstate with ⟨hdecomp, hsum, hpower, hsquare, hodd, hbound⟩ + rw [hdecomp] + simp only [machineLogSeriesPack, machineLogSeriesWidth, pair_length] + omega + +theorem machineLogSeriesIterate_length_le_width + (word : List Bool) (iterations : ℕ) + (_ : iterations ≤ (machineLogSeriesInputRuler word).length) : + ((machineLogSeriesStep)^[iterations] + (machineLogSeriesInit word)).length ≤ + (machineLogSeriesWidth word).length := + machineLogSeriesPack_length_le_width word _ + (machineLogSeriesIterate_bound word iterations) + +theorem machineLogSeriesFinalState_mem_FP : + machineLogSeriesFinalState ∈ Complexity.FP := by + exact Cobham.iterate_mem_FP machineLogSeriesStep_mem_FP + machineLogSeriesInit_mem_FP machineLogSeriesInputRuler_mem_FP + machineLogSeriesWidth_mem_FP machineLogSeriesIterate_length_le_width + +theorem machineRawRationalLogSeriesSumCode_mem_FP : + machineRawRationalLogSeriesSumCode ∈ Complexity.FP := by + simpa only [machineRawRationalLogSeriesSumCode] using + machineCompose_mem_FP machineLogSeriesFinalState_mem_FP + machineLogSeriesSumField_mem_FP + +theorem machineRationalLogSeriesSumCode_mem_FP : + machineRationalLogSeriesSumCode ∈ Complexity.FP := by + simpa only [machineRationalLogSeriesSumCode] using + machineCompose_mem_FP machineRawRationalLogSeriesSumCode_mem_FP + machineNormalizeRawRatBinaryCode_mem_FP + +/-! ## Exact semantics on well-formed inputs -/ + +namespace RawRat + +def ofNat (n : ℕ) : RawRat := ⟨n, 1, by omega⟩ + +@[simp] theorem value_ofNat (n : ℕ) : (ofNat n).value = n := by + simp [ofNat, value] + +/-- The odd powers `x, x^3, x^5, ...`, maintained by multiplication by the +fixed square. -/ +def logOddPower (x : RawRat) : ℕ → RawRat + | 0 => x + | k + 1 => (logOddPower x k).mul (x.mul x) + +/-- Unreduced partial sums of the odd logarithm series. -/ +def logSeriesSum (x : RawRat) : ℕ → RawRat + | 0 => zero + | k + 1 => + (logSeriesSum x k).add + ((logOddPower x k).div (ofNat (2 * k + 1))) + +@[simp] theorem value_logOddPower (x : RawRat) : ∀ k, + (logOddPower x k).value = x.value ^ (2 * k + 1) := by + intro k + induction k with + | zero => simp [logOddPower] + | succ k ih => + rw [logOddPower, value_mul, ih, value_mul] + calc + x.value ^ (2 * k + 1) * (x.value * x.value) = + x.value ^ (2 * k + 1) * x.value ^ 2 := by rw [pow_two] + _ = x.value ^ ((2 * k + 1) + 2) := (pow_add _ _ _).symm + _ = x.value ^ (2 * (k + 1) + 1) := by congr 1 <;> omega + +@[simp] theorem value_logSeriesSum (x : RawRat) : ∀ k, + (logSeriesSum x k).value = binaryRationalLogSeriesSum x.value k := by + intro k + induction k with + | zero => simp [logSeriesSum, binaryRationalLogSeriesSum] + | succ k ih => + rw [logSeriesSum, value_add, value_div, value_logOddPower, + value_ofNat, binaryRationalLogSeriesSum, binaryRatAdd_eq_add, + binaryRatDiv_eq_div, binaryRatPow_eq_pow, ih] + push_cast + rfl + +theorem width_ofNat_le (n : ℕ) : rawRatWidth (ofNat n) ≤ n + 1 := by + have hpow : n < 2 ^ (n + 1) := by + induction n with + | zero => norm_num + | succ n ih => + rw [pow_succ] + have hpos : 0 < 2 ^ (n + 1) := by positivity + omega + rw [rawRatWidth, ofNat] + simp only [Int.natAbs_ofNat', Nat.size_one] + exact max_le (Nat.size_le.mpr hpow) (by omega) + +theorem width_logOddPower_le (x : RawRat) : ∀ k, + rawRatWidth (logOddPower x k) ≤ (2 * k + 1) * rawRatWidth x := by + intro k + induction k with + | zero => simp [logOddPower] + | succ k ih => + rw [logOddPower] + have hsquare := rawRatWidth_mul_le x x + exact (rawRatWidth_mul_le _ _).trans (by nlinarith) + +theorem width_logSeriesSum_le (x : RawRat) : ∀ k, + rawRatWidth (logSeriesSum x k) ≤ + 1 + k * ((2 * k + 1) * rawRatWidth x + 2 * k + 4) := by + intro k + induction k with + | zero => simp [logSeriesSum, rawRatWidth_zero] + | succ k ih => + rw [logSeriesSum] + have hp := width_logOddPower_le x k + have hn := width_ofNat_le (2 * k + 1) + have ht := rawRatWidth_div_le (logOddPower x k) + (ofNat (2 * k + 1)) + have ha := rawRatWidth_add_le (logSeriesSum x k) + ((logOddPower x k).div (ofNat (2 * k + 1))) + nlinarith + +end RawRat + +private theorem logSeriesIntegerNatAbs_size_le_code_length (z : ℤ) : + z.natAbs.size ≤ (integerBinaryCode z).length := by + cases z with + | ofNat n => simp [integerBinaryCode, Nat.size_eq_bits_len] + | negSucc n => + have hs : (n + 1).size ≤ n.size + 1 := by + rw [Nat.size_le] + have hle : n + 1 ≤ 2 ^ n.size := + Nat.succ_le_iff.mpr (Nat.lt_size_self n) + have hlt : 2 ^ n.size < 2 ^ (n.size + 1) := by + rw [pow_succ] + have hpos : 0 < 2 ^ n.size := by positivity + omega + exact hle.trans_lt hlt + simpa [integerBinaryCode, Nat.size_eq_bits_len, + Nat.add_comm] using hs + +private theorem logSeriesRawRatWidth_le_code_length (q : RawRat) : + rawRatWidth q ≤ (rawRatBinaryCode q).length := by + rw [rawRatWidth, rawRatBinaryCode, pair_length] + apply max_le + · have h := logSeriesIntegerNatAbs_size_le_code_length q.num + omega + · rw [Nat.size_eq_bits_len] + omega + +private theorem logSeriesRawRatCode_length_le_width (q : RawRat) : + (rawRatBinaryCode q).length ≤ 4 + 3 * rawRatWidth q := by + rw [rawRatBinaryCode, pair_length] + have hnum : (integerBinaryCode q.num).length ≤ 1 + rawRatWidth q := by + cases hqnum : q.num with + | ofNat n => + simp only [integerBinaryCode, List.length_cons, + Nat.size_eq_bits_len] + have habs := rawRat_num_size_le_width q + simp only [hqnum, Int.natAbs_ofNat'] at habs + omega + | negSucc n => + simp only [integerBinaryCode, List.length_cons, + Nat.size_eq_bits_len] + have hsize : n.size ≤ (n + 1).size := + Nat.size_le_size (Nat.le_succ n) + have habs : (n + 1).size ≤ rawRatWidth q := by + simpa only [hqnum, Int.natAbs_negSucc] using + rawRat_num_size_le_width q + omega + have hden := rawRat_den_size_le_width q + have hdenbits : q.den.bits.length ≤ rawRatWidth q := by + simpa only [Nat.size_eq_bits_len] using hden + omega + +private theorem logSeriesCode_length_le_inputBound + (q r : RawRat) (total k : ℕ) (hk : k ≤ total) + (hr : rawRatWidth r ≤ + 1 + (k + 1) * + ((2 * (k + 1) + 1) * rawRatWidth q + 2 * (k + 1) + 4)) : + (rawRatBinaryCode r).length ≤ + (machineLogSeriesInputBound + (pair (List.replicate total true) (rawRatBinaryCode q))).length := by + let word := pair (List.replicate total true) (rawRatBinaryCode q) + have hcode := logSeriesRawRatCode_length_le_width r + have htotal : total ≤ word.length := by + simp only [word, pair_length, List.length_replicate] + omega + have hqcode : (rawRatBinaryCode q).length ≤ word.length := by + simp only [word, pair_length, List.length_replicate] + omega + have hqwidth := (logSeriesRawRatWidth_le_code_length q).trans hqcode + have hkword : k ≤ word.length := hk.trans htotal + have hrword : rawRatWidth r ≤ + 1 + (word.length + 1) * + ((2 * (word.length + 1) + 1) * word.length + + 2 * (word.length + 1) + 4) := by + have hk1 : k + 1 ≤ word.length + 1 := by omega + have hfirst : 2 * (k + 1) + 1 ≤ 2 * (word.length + 1) + 1 := by omega + have hmul : (2 * (k + 1) + 1) * rawRatWidth q ≤ + (2 * (word.length + 1) + 1) * word.length := + Nat.mul_le_mul hfirst hqwidth + have hinner : + (2 * (k + 1) + 1) * rawRatWidth q + 2 * (k + 1) + 4 ≤ + (2 * (word.length + 1) + 1) * word.length + + 2 * (word.length + 1) + 4 := by omega + have hproduct := Nat.mul_le_mul hk1 hinner + exact hr.trans (Nat.add_le_add_left hproduct 1) + calc + (rawRatBinaryCode r).length ≤ 4 + 3 * rawRatWidth r := hcode + _ ≤ 4 + 3 * (1 + (word.length + 1) * + ((2 * (word.length + 1) + 1) * word.length + + 2 * (word.length + 1) + 4)) := by omega + _ ≤ (machineLogSeriesInputBound word).length := by + simp [machineLogSeriesInputBound, machineBinaryMulWidth] + nlinarith [sq_nonneg (word.length * word.length * + (word.length + 1))] + +private theorem logSeriesSumCode_length_le_inputBound + (q : RawRat) (total k : ℕ) (hk : k ≤ total) : + (rawRatBinaryCode (RawRat.logSeriesSum q k)).length ≤ + (machineLogSeriesInputBound + (pair (List.replicate total true) (rawRatBinaryCode q))).length := + logSeriesCode_length_le_inputBound q _ total k hk + ((RawRat.width_logSeriesSum_le q k).trans (by nlinarith)) + +private theorem logSeriesPowerCode_length_le_inputBound + (q : RawRat) (total k : ℕ) (hk : k ≤ total) : + (rawRatBinaryCode (RawRat.logOddPower q k)).length ≤ + (machineLogSeriesInputBound + (pair (List.replicate total true) (rawRatBinaryCode q))).length := by + apply logSeriesCode_length_le_inputBound q _ total k hk + have hp := RawRat.width_logOddPower_le q k + exact hp.trans (by nlinarith) + +private theorem logSeriesSquareCode_length_le_inputBound + (q : RawRat) (total : ℕ) : + (rawRatBinaryCode (q.mul q)).length ≤ + (machineLogSeriesInputBound + (pair (List.replicate total true) (rawRatBinaryCode q))).length := by + apply logSeriesCode_length_le_inputBound q _ total 0 (by omega) + have hsquare := rawRatWidth_mul_le q q + exact hsquare.trans (by nlinarith) + +private theorem logSeriesOddBits_length_le_inputBound + (q : RawRat) (total k : ℕ) (hk : k ≤ total) : + (2 * k + 1).bits.length ≤ + (machineLogSeriesInputBound + (pair (List.replicate total true) (rawRatBinaryCode q))).length := by + have hsize : (2 * k + 1).bits.length ≤ 2 * k + 2 := by + have hw := RawRat.width_ofNat_le (2 * k + 1) + rw [rawRatWidth, RawRat.ofNat] at hw + simp only [Int.natAbs_ofNat', Nat.size_one] at hw + have hs := (le_max_left (2 * k + 1).size 1).trans hw + simpa only [Nat.size_eq_bits_len] using hs + let word := pair (List.replicate total true) (rawRatBinaryCode q) + have htotal : total ≤ word.length := by + simp only [word, pair_length, List.length_replicate] + omega + have hkword : k ≤ word.length := hk.trans htotal + have hlarge : 2 * word.length + 2 ≤ + (machineLogSeriesInputBound word).length := by + simp [machineLogSeriesInputBound, machineBinaryMulWidth] + nlinarith + exact hsize.trans ((by omega : 2 * k + 2 ≤ 2 * word.length + 2).trans hlarge) + +def rawLogSeriesMachineState (q : RawRat) (total k : ℕ) : List Bool := + let word := pair (List.replicate total true) (rawRatBinaryCode q) + machineLogSeriesPack + (rawRatBinaryCode (RawRat.logSeriesSum q k)) + (rawRatBinaryCode (RawRat.logOddPower q k)) + (rawRatBinaryCode (q.mul q)) + (2 * k + 1).bits + (machineLogSeriesInputBound word) + +theorem machineLogSeriesInit_encode (q : RawRat) (total : ℕ) : + machineLogSeriesInit + (pair (List.replicate total true) (rawRatBinaryCode q)) = + rawLogSeriesMachineState q total 0 := by + let word := pair (List.replicate total true) (rawRatBinaryCode q) + have hbase : (rawRatBinaryCode q).length ≤ + (machineLogSeriesInputBound word).length := by + simpa only [RawRat.logOddPower] using + logSeriesPowerCode_length_le_inputBound q total 0 (by omega) + have hsquare := logSeriesSquareCode_length_le_inputBound q total + rw [machineLogSeriesInit] + simp only [machineLogSeriesInputBase, machinePairSecond_pair, + machineLogSeriesInitialSquareCandidate, + machineRawRatMulCode_encode] + rw [(List.take_eq_self_iff _).2 hbase, + (List.take_eq_self_iff _).2 hsquare] + simp [rawLogSeriesMachineState, rawRatZeroCode, + RawRat.logSeriesSum, RawRat.logOddPower] + +@[simp] theorem machineLogSeriesOddRawRatCode_encode + (q : RawRat) (total k : ℕ) : + machineLogSeriesOddRawRatCode (rawLogSeriesMachineState q total k) = + rawRatBinaryCode (RawRat.ofNat (2 * k + 1)) := by + rw [machineLogSeriesOddRawRatCode] + simp only [rawLogSeriesMachineState, machineLogSeriesFields_pack] + rw [machineNaturalIntegerCode_natBits] + simp [rawRatBinaryCode, RawRat.ofNat] + +@[simp] theorem machineLogSeriesTermCandidate_encode + (q : RawRat) (total k : ℕ) : + machineLogSeriesTermCandidate (rawLogSeriesMachineState q total k) = + rawRatBinaryCode + ((RawRat.logOddPower q k).div (RawRat.ofNat (2 * k + 1))) := by + rw [machineLogSeriesTermCandidate, + machineLogSeriesOddRawRatCode_encode] + simp only [rawLogSeriesMachineState, machineLogSeriesFields_pack] + rw [machineRawRatDivCode_encode] + +@[simp] theorem machineLogSeriesSumCandidate_encode + (q : RawRat) (total k : ℕ) : + machineLogSeriesSumCandidate (rawLogSeriesMachineState q total k) = + rawRatBinaryCode (RawRat.logSeriesSum q (k + 1)) := by + rw [machineLogSeriesSumCandidate, + machineLogSeriesTermCandidate_encode] + simp only [rawLogSeriesMachineState, machineLogSeriesFields_pack] + rw [machineRawRatAddCode_encode] + rfl + +@[simp] theorem machineLogSeriesPowerCandidate_encode + (q : RawRat) (total k : ℕ) : + machineLogSeriesPowerCandidate (rawLogSeriesMachineState q total k) = + rawRatBinaryCode (RawRat.logOddPower q (k + 1)) := by + rw [machineLogSeriesPowerCandidate] + simp only [rawLogSeriesMachineState, machineLogSeriesFields_pack, + machineRawRatMulCode_encode] + rw [RawRat.logOddPower] + +@[simp] theorem machineLogSeriesOddCandidate_encode + (q : RawRat) (total k : ℕ) : + machineLogSeriesOddCandidate (rawLogSeriesMachineState q total k) = + (2 * (k + 1) + 1).bits := by + rw [machineLogSeriesOddCandidate] + simp only [rawLogSeriesMachineState, machineLogSeriesFields_pack] + have htwo : ([false, true] : List Bool) = (2 : ℕ).bits := by rfl + rw [htwo, machineBinaryAddBits_pair_natBits] + congr 1 + +theorem machineLogSeriesStep_encode + (q : RawRat) (total k : ℕ) (hk : k + 1 ≤ total) : + machineLogSeriesStep (rawLogSeriesMachineState q total k) = + rawLogSeriesMachineState q total (k + 1) := by + let word := pair (List.replicate total true) (rawRatBinaryCode q) + have hsum := logSeriesSumCode_length_le_inputBound q total (k + 1) hk + have hpower := logSeriesPowerCode_length_le_inputBound q total (k + 1) hk + have hodd := logSeriesOddBits_length_le_inputBound q total (k + 1) hk + have hsumClamp : + machineLogSeriesClamp machineLogSeriesSumCandidate + (rawLogSeriesMachineState q total k) = + rawRatBinaryCode (RawRat.logSeriesSum q (k + 1)) := by + rw [machineLogSeriesClamp, machineLogSeriesSumCandidate_encode] + simp only [rawLogSeriesMachineState, machineLogSeriesFields_pack] + exact (List.take_eq_self_iff _).2 hsum + have hpowerClamp : + machineLogSeriesClamp machineLogSeriesPowerCandidate + (rawLogSeriesMachineState q total k) = + rawRatBinaryCode (RawRat.logOddPower q (k + 1)) := by + rw [machineLogSeriesClamp, machineLogSeriesPowerCandidate_encode] + simp only [rawLogSeriesMachineState, machineLogSeriesFields_pack] + exact (List.take_eq_self_iff _).2 hpower + have hoddClamp : + machineLogSeriesClamp machineLogSeriesOddCandidate + (rawLogSeriesMachineState q total k) = + (2 * (k + 1) + 1).bits := by + rw [machineLogSeriesClamp, machineLogSeriesOddCandidate_encode] + simp only [rawLogSeriesMachineState, machineLogSeriesFields_pack] + exact (List.take_eq_self_iff _).2 hodd + rw [machineLogSeriesStep, hsumClamp, hpowerClamp, hoddClamp] + simp only [rawLogSeriesMachineState, machineLogSeriesFields_pack] + +theorem machineLogSeriesIterate_encode (q : RawRat) (total : ℕ) : + ∀ k ≤ total, + (machineLogSeriesStep)^[k] + (machineLogSeriesInit + (pair (List.replicate total true) (rawRatBinaryCode q))) = + rawLogSeriesMachineState q total k := by + intro k hk + induction k with + | zero => exact machineLogSeriesInit_encode q total + | succ k ih => + rw [Function.iterate_succ_apply', ih (by omega)] + exact machineLogSeriesStep_encode q total k hk + +theorem machineRawRationalLogSeriesSumCode_encode + (q : RawRat) (N : ℕ) : + machineRawRationalLogSeriesSumCode + (pair (List.replicate N true) (rawRatBinaryCode q)) = + rawRatBinaryCode (RawRat.logSeriesSum q N) := by + rw [machineRawRationalLogSeriesSumCode, + machineLogSeriesFinalState] + simp only [machineLogSeriesInputRuler, machinePairFirst_pair, + List.length_replicate] + rw [machineLogSeriesIterate_encode q N N le_rfl] + simp [rawLogSeriesMachineState] + +theorem machineRationalLogSeriesSumCode_encode + (q : RawRat) (N : ℕ) : + machineRationalLogSeriesSumCode + (pair (List.replicate N true) (rawRatBinaryCode q)) = + rationalBinaryCode (binaryRationalLogSeriesSum q.value N) := by + rw [machineRationalLogSeriesSumCode, + machineRawRationalLogSeriesSumCode_encode, + machineNormalizeRawRatBinaryCode_encode, + binaryNormalizeRawRat_eq_value, RawRat.value_logSeriesSum] + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalMatrixColumn.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalMatrixColumn.lean new file mode 100644 index 0000000000..283bdef1fc --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalMatrixColumn.lean @@ -0,0 +1,620 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalVectorDot +import Mathlib.Data.List.GetD + +/-! +# Polynomial-time extraction of rational matrix columns + +Rational ellipsoid bases are stored row by row. This transducer scans those +rows, reads one unary-indexed entry from each row, and returns the resulting +column as a canonical rational-vector word. It is total on arbitrary words; +the exactness theorem only assumes that the selected column exists in every +row. +-/ + +namespace BeyondBethe + +open Complexity + +def machineRationalMatrixColumnIndex (word : List Bool) : List Bool := + machinePairFirst word + +def machineRationalMatrixColumnRows (word : List Bool) : List Bool := + machinePairSecond word + +def machineRationalMatrixColumnPack + (remaining accumulator column bound : List Bool) : List Bool := + pair remaining (pair accumulator (pair column bound)) + +def machineRationalMatrixColumnRemaining + (state : List Bool) : List Bool := + machinePairFirst state + +def machineRationalMatrixColumnAccumulator + (state : List Bool) : List Bool := + machinePairFirst (machinePairSecond state) + +def machineRationalMatrixColumnColumn + (state : List Bool) : List Bool := + machinePairFirst (machinePairSecond (machinePairSecond state)) + +def machineRationalMatrixColumnBound + (state : List Bool) : List Bool := + machinePairSecond (machinePairSecond (machinePairSecond state)) + +def machineRationalMatrixColumnCurrentRow + (state : List Bool) : List Bool := + machineListHead (machineRationalMatrixColumnRemaining state) + +def machineRationalMatrixColumnCurrentEntry + (state : List Bool) : List Bool := + machineListIndex + (pair (machineRationalMatrixColumnColumn state) + (machineRationalMatrixColumnCurrentRow state)) + +def machineRationalMatrixColumnCandidate + (state : List Bool) : List Bool := + pair (machineRationalMatrixColumnCurrentEntry state) + (machineRationalMatrixColumnAccumulator state) + +def machineRationalMatrixColumnNextAccumulator + (state : List Bool) : List Bool := + (machineRationalMatrixColumnCandidate state).take + (machineRationalMatrixColumnBound state).length + +def machineRationalMatrixColumnAdvance + (state : List Bool) : List Bool := + machineRationalMatrixColumnPack + (machineListTail (machineRationalMatrixColumnRemaining state)) + (machineRationalMatrixColumnNextAccumulator state) + (machineRationalMatrixColumnColumn state) + (machineRationalMatrixColumnBound state) + +def machineRationalMatrixColumnStep + (state : List Bool) : List Bool := + machineIfEmpty (machineRationalMatrixColumnRemaining state) state + (machineRationalMatrixColumnAdvance state) + +def machineRationalMatrixColumnInit (word : List Bool) : List Bool := + machineRationalMatrixColumnPack + (machineRationalMatrixColumnRows word) [] + (machineRationalMatrixColumnIndex word) word + +def machineRationalMatrixColumnWidth (word : List Bool) : List Bool := + machineRationalMatrixColumnPack word word word word + +def machineRationalMatrixColumnFinalState + (word : List Bool) : List Bool := + (machineRationalMatrixColumnStep)^[word.length] + (machineRationalMatrixColumnInit word) + +def machineRationalMatrixColumnReversedCode + (word : List Bool) : List Bool := + machineRationalMatrixColumnAccumulator + (machineRationalMatrixColumnFinalState word) + +/-- Input: `pair columnUnary nestedRowsCode`. -/ +def machineRationalMatrixColumnCode (word : List Bool) : List Bool := + machineListReverse (machineRationalMatrixColumnReversedCode word) + +theorem machineRationalMatrixColumnIndex_mem_FP : + machineRationalMatrixColumnIndex ∈ FP := machinePairFirst_mem_FP + +theorem machineRationalMatrixColumnRows_mem_FP : + machineRationalMatrixColumnRows ∈ FP := machinePairSecond_mem_FP + +theorem machineRationalMatrixColumnRemaining_mem_FP : + machineRationalMatrixColumnRemaining ∈ FP := machinePairFirst_mem_FP + +theorem machineRationalMatrixColumnAccumulator_mem_FP : + machineRationalMatrixColumnAccumulator ∈ FP := by + simpa only [machineRationalMatrixColumnAccumulator] using + machineCompose_mem_FP machinePairSecond_mem_FP machinePairFirst_mem_FP + +theorem machineRationalMatrixColumnColumn_mem_FP : + machineRationalMatrixColumnColumn ∈ FP := by + simpa only [machineRationalMatrixColumnColumn] using + machineCompose_mem_FP + (machineCompose_mem_FP machinePairSecond_mem_FP + machinePairSecond_mem_FP) + machinePairFirst_mem_FP + +theorem machineRationalMatrixColumnBound_mem_FP : + machineRationalMatrixColumnBound ∈ FP := by + simpa only [machineRationalMatrixColumnBound] using + machineCompose_mem_FP + (machineCompose_mem_FP machinePairSecond_mem_FP + machinePairSecond_mem_FP) + machinePairSecond_mem_FP + +theorem machineRationalMatrixColumnCurrentRow_mem_FP : + machineRationalMatrixColumnCurrentRow ∈ FP := by + simpa only [machineRationalMatrixColumnCurrentRow] using + machineCompose_mem_FP machineRationalMatrixColumnRemaining_mem_FP + machineListHead_mem_FP + +theorem machineRationalMatrixColumnCurrentEntry_mem_FP : + machineRationalMatrixColumnCurrentEntry ∈ FP := by + have hp := machinePair_mem_FP machineRationalMatrixColumnColumn_mem_FP + machineRationalMatrixColumnCurrentRow_mem_FP + simpa only [machineRationalMatrixColumnCurrentEntry] using + machineCompose_mem_FP hp machineListIndex_mem_FP + +theorem machineRationalMatrixColumnCandidate_mem_FP : + machineRationalMatrixColumnCandidate ∈ FP := + machinePair_mem_FP machineRationalMatrixColumnCurrentEntry_mem_FP + machineRationalMatrixColumnAccumulator_mem_FP + +theorem machineRationalMatrixColumnNextAccumulator_mem_FP : + machineRationalMatrixColumnNextAccumulator ∈ FP := by + simpa only [machineRationalMatrixColumnNextAccumulator] using + machineTake_mem_FP machineRationalMatrixColumnBound_mem_FP + machineRationalMatrixColumnCandidate_mem_FP + +theorem machineRationalMatrixColumnAdvance_mem_FP : + machineRationalMatrixColumnAdvance ∈ FP := by + have htail := machineCompose_mem_FP + machineRationalMatrixColumnRemaining_mem_FP machineListTail_mem_FP + exact machinePair_mem_FP htail + (machinePair_mem_FP machineRationalMatrixColumnNextAccumulator_mem_FP + (machinePair_mem_FP machineRationalMatrixColumnColumn_mem_FP + machineRationalMatrixColumnBound_mem_FP)) + +theorem machineRationalMatrixColumnStep_mem_FP : + machineRationalMatrixColumnStep ∈ FP := + machineIfEmpty_mem_FP machineRationalMatrixColumnRemaining_mem_FP + id_mem_FP machineRationalMatrixColumnAdvance_mem_FP + +theorem machineRationalMatrixColumnInit_mem_FP : + machineRationalMatrixColumnInit ∈ FP := by + exact machinePair_mem_FP machineRationalMatrixColumnRows_mem_FP + (machinePair_mem_FP (machineConst_mem_FP []) + (machinePair_mem_FP machineRationalMatrixColumnIndex_mem_FP id_mem_FP)) + +theorem machineRationalMatrixColumnWidth_mem_FP : + machineRationalMatrixColumnWidth ∈ FP := by + exact machinePair_mem_FP id_mem_FP + (machinePair_mem_FP id_mem_FP + (machinePair_mem_FP id_mem_FP id_mem_FP)) + +@[simp] theorem machineRationalMatrixColumnRemaining_pack (a b c d) : + machineRationalMatrixColumnRemaining + (machineRationalMatrixColumnPack a b c d) = a := by + simp [machineRationalMatrixColumnRemaining, + machineRationalMatrixColumnPack] + +@[simp] theorem machineRationalMatrixColumnAccumulator_pack (a b c d) : + machineRationalMatrixColumnAccumulator + (machineRationalMatrixColumnPack a b c d) = b := by + simp [machineRationalMatrixColumnAccumulator, + machineRationalMatrixColumnPack] + +@[simp] theorem machineRationalMatrixColumnColumn_pack (a b c d) : + machineRationalMatrixColumnColumn + (machineRationalMatrixColumnPack a b c d) = c := by + simp [machineRationalMatrixColumnColumn, + machineRationalMatrixColumnPack] + +@[simp] theorem machineRationalMatrixColumnBound_pack (a b c d) : + machineRationalMatrixColumnBound + (machineRationalMatrixColumnPack a b c d) = d := by + simp [machineRationalMatrixColumnBound, + machineRationalMatrixColumnPack] + +def MachineRationalMatrixColumnStateBound + (word state : List Bool) : Prop := + state = machineRationalMatrixColumnPack + (machineRationalMatrixColumnRemaining state) + (machineRationalMatrixColumnAccumulator state) + (machineRationalMatrixColumnColumn state) + (machineRationalMatrixColumnBound state) ∧ + (machineRationalMatrixColumnRemaining state).length ≤ word.length ∧ + (machineRationalMatrixColumnAccumulator state).length ≤ word.length ∧ + (machineRationalMatrixColumnColumn state).length ≤ word.length ∧ + machineRationalMatrixColumnBound state = word + +theorem machineRationalMatrixColumnInit_bound (word : List Bool) : + MachineRationalMatrixColumnStateBound word + (machineRationalMatrixColumnInit word) := by + simp only [MachineRationalMatrixColumnStateBound, + machineRationalMatrixColumnInit, + machineRationalMatrixColumnRemaining_pack, + machineRationalMatrixColumnAccumulator_pack, + machineRationalMatrixColumnColumn_pack, + machineRationalMatrixColumnBound_pack] + exact ⟨trivial, machinePairSecond_length_le word, by simp, + machinePairFirst_length_le word, trivial⟩ + +theorem machineRationalMatrixColumnStep_bound {word state : List Bool} + (hs : MachineRationalMatrixColumnStateBound word state) : + MachineRationalMatrixColumnStateBound word + (machineRationalMatrixColumnStep state) := by + rcases hs with ⟨hdecomp, hremaining, hacc, hcolumn, hbound⟩ + by_cases hnil : machineRationalMatrixColumnRemaining state = [] + · rw [machineRationalMatrixColumnStep, hnil, machineIfEmpty_nil] + exact ⟨hdecomp, hremaining, hacc, hcolumn, hbound⟩ + · rw [machineRationalMatrixColumnStep] + cases hcode : machineRationalMatrixColumnRemaining state with + | nil => exact False.elim (hnil hcode) + | cons bit tail => + rw [machineIfEmpty_cons, machineRationalMatrixColumnAdvance] + simp only [MachineRationalMatrixColumnStateBound, + machineRationalMatrixColumnRemaining_pack, + machineRationalMatrixColumnAccumulator_pack, + machineRationalMatrixColumnColumn_pack, + machineRationalMatrixColumnBound_pack] + refine ⟨trivial, ?_, ?_, hcolumn, hbound⟩ + · exact (machineListTail_length_le + (machineRationalMatrixColumnRemaining state)).trans hremaining + · rw [machineRationalMatrixColumnNextAccumulator, hbound] + exact List.length_take_le _ _ + +theorem machineRationalMatrixColumnIterate_bound + (word : List Bool) : ∀ k, + MachineRationalMatrixColumnStateBound word + ((machineRationalMatrixColumnStep)^[k] + (machineRationalMatrixColumnInit word)) := by + intro k + induction k with + | zero => exact machineRationalMatrixColumnInit_bound word + | succ k ih => + rw [Function.iterate_succ_apply'] + exact machineRationalMatrixColumnStep_bound ih + +theorem machineRationalMatrixColumnIterate_length_le_width + (word : List Bool) (iterations : ℕ) + (_ : iterations ≤ word.length) : + ((machineRationalMatrixColumnStep)^[iterations] + (machineRationalMatrixColumnInit word)).length ≤ + (machineRationalMatrixColumnWidth word).length := by + rcases machineRationalMatrixColumnIterate_bound word iterations with + ⟨hdecomp, hremaining, hacc, hcolumn, hbound⟩ + rw [hdecomp, hbound] + simp only [machineRationalMatrixColumnPack, + machineRationalMatrixColumnWidth, pair_length] + omega + +theorem machineRationalMatrixColumnFinalState_mem_FP : + machineRationalMatrixColumnFinalState ∈ FP := by + exact Cobham.iterate_mem_FP machineRationalMatrixColumnStep_mem_FP + machineRationalMatrixColumnInit_mem_FP id_mem_FP + machineRationalMatrixColumnWidth_mem_FP + machineRationalMatrixColumnIterate_length_le_width + +theorem machineRationalMatrixColumnReversedCode_mem_FP : + machineRationalMatrixColumnReversedCode ∈ FP := by + simpa only [machineRationalMatrixColumnReversedCode] using + machineCompose_mem_FP machineRationalMatrixColumnFinalState_mem_FP + machineRationalMatrixColumnAccumulator_mem_FP + +theorem machineRationalMatrixColumnCode_mem_FP : + machineRationalMatrixColumnCode ∈ FP := by + simpa only [machineRationalMatrixColumnCode] using + machineCompose_mem_FP machineRationalMatrixColumnReversedCode_mem_FP + machineListReverse_mem_FP + +/-! ## Exact semantics -/ + +def rationalColumnOfRows (rows : List (List ℚ)) (j : ℕ) : List ℚ := + rows.map fun row => row.getD j 0 + +def RationalRowsHaveColumn (rows : List (List ℚ)) (j : ℕ) : Prop := + ∀ row ∈ rows, j < row.length + +theorem rationalEntryCode_getD_length_le + (row : List ℚ) (j : ℕ) (hj : j < row.length) : + (rationalEntryBinaryCode (row.getD j 0)).length ≤ + (binaryListCode rationalEntryBinaryCode row).length := by + have hlength := machineListIndex_length_le_data + (pair (List.replicate j true) + (binaryListCode rationalEntryBinaryCode row)) + have hencode := machineListIndex_binaryListCode + rationalEntryBinaryCode row j hj + rw [hencode, machineListIndexData, machinePairSecond_pair] at hlength + simpa only [List.getD_eq_getElem row 0 hj] using hlength + +theorem rationalColumnOfRows_code_length_le + (j : ℕ) : ∀ rows : List (List ℚ), + RationalRowsHaveColumn rows j → + (binaryListCode rationalEntryBinaryCode + (rationalColumnOfRows rows j)).length ≤ + (binaryListCode (binaryListCode rationalEntryBinaryCode) rows).length := by + intro rows + induction rows with + | nil => intro h; simp [rationalColumnOfRows, binaryListCode] + | cons row rows ih => + intro hvalid + have hrow : j < row.length := hvalid row (by simp) + have htail : RationalRowsHaveColumn rows j := by + intro r hr + exact hvalid r (by simp [hr]) + have hentry := rationalEntryCode_getD_length_le row j hrow + have hrec := ih htail + have hrec' : + (binaryListCode rationalEntryBinaryCode + ((rows.map fun r => r.getD j 0))).length ≤ + (binaryListCode (binaryListCode rationalEntryBinaryCode) + rows).length := by + simpa only [rationalColumnOfRows] using hrec + change + (pair (rationalEntryBinaryCode (row.getD j 0)) + (binaryListCode rationalEntryBinaryCode + (rows.map fun r => r.getD j 0))).length ≤ + (pair (binaryListCode rationalEntryBinaryCode row) + (binaryListCode (binaryListCode rationalEntryBinaryCode) + rows)).length + simp only [pair_length] + omega + +theorem rationalColumnOfRows_take_reverse_code_length_le + (rows : List (List ℚ)) (j k : ℕ) + (hvalid : RationalRowsHaveColumn rows j) : + (binaryListCode rationalEntryBinaryCode + (rationalColumnOfRows (rows.take k) j).reverse).length ≤ + (binaryListCode (binaryListCode rationalEntryBinaryCode) rows).length := by + have hmap : rationalColumnOfRows (rows.take k) j = + (rationalColumnOfRows rows j).take k := by + simp [rationalColumnOfRows, List.map_take] + rw [hmap] + exact (binaryListCode_take_reverse_length_le + rationalEntryBinaryCode (rationalColumnOfRows rows j) k).trans + (rationalColumnOfRows_code_length_le j rows hvalid) + +def machineRationalMatrixColumnSemanticState + (rows : List (List ℚ)) (j k : ℕ) + (bound : List Bool) : List Bool := + machineRationalMatrixColumnPack + (binaryListCode (binaryListCode rationalEntryBinaryCode) (rows.drop k)) + (binaryListCode rationalEntryBinaryCode + (rationalColumnOfRows (rows.take k) j).reverse) + (List.replicate j true) bound + +theorem machineRationalMatrixColumnInit_semantics + (rows : List (List ℚ)) (j : ℕ) : + let word := pair (List.replicate j true) + (binaryListCode (binaryListCode rationalEntryBinaryCode) rows) + machineRationalMatrixColumnInit word = + machineRationalMatrixColumnSemanticState rows j 0 word := by + simp [machineRationalMatrixColumnInit, + machineRationalMatrixColumnSemanticState, + machineRationalMatrixColumnRows, + machineRationalMatrixColumnIndex, rationalColumnOfRows, + binaryListCode] + +theorem machineRationalMatrixColumnStep_semantics + (rows : List (List ℚ)) (j k : ℕ) (bound : List Bool) + (hk : k < rows.length) + (hvalid : RationalRowsHaveColumn rows j) + (hbound : + (binaryListCode (binaryListCode rationalEntryBinaryCode) rows).length ≤ + bound.length) : + machineRationalMatrixColumnStep + (machineRationalMatrixColumnSemanticState rows j k bound) = + machineRationalMatrixColumnSemanticState rows j (k + 1) bound := by + have hdrop := List.drop_eq_getElem_cons hk + have hrow : j < rows[k].length := + hvalid rows[k] (List.getElem_mem hk) + have hprefix : + rationalColumnOfRows (rows.take (k + 1)) j = + rationalColumnOfRows (rows.take k) j ++ [rows[k].getD j 0] := by + simp only [rationalColumnOfRows, List.map_take] + have hkm : k < + (rows.map fun row => row.getD j 0).length := by + simpa using hk + simpa using + (List.take_concat_get + (l := rows.map fun row => row.getD j 0) hkm).symm + have hreverse : + (rationalColumnOfRows (rows.take (k + 1)) j).reverse = + rows[k].getD j 0 :: + (rationalColumnOfRows (rows.take k) j).reverse := by + rw [hprefix, List.reverse_append] + simp + have hcand : + (binaryListCode rationalEntryBinaryCode + (rationalColumnOfRows (rows.take (k + 1)) j).reverse).length ≤ + bound.length := + (rationalColumnOfRows_take_reverse_code_length_le + rows j (k + 1) hvalid).trans hbound + have hnonempty : + binaryListCode (binaryListCode rationalEntryBinaryCode) + (rows.drop k) ≠ [] := by + rw [hdrop] + exact binaryListCode_cons_ne_nil + (binaryListCode rationalEntryBinaryCode) rows[k] + (rows.drop (k + 1)) + have hcandPair : + (pair (rationalEntryBinaryCode (rows[k].getD j 0)) + (binaryListCode rationalEntryBinaryCode + (rationalColumnOfRows (rows.take k) j).reverse)).length ≤ + bound.length := by + simpa only [hreverse, binaryListCode] using hcand + rw [machineRationalMatrixColumnStep] + simp only [machineRationalMatrixColumnSemanticState, + machineRationalMatrixColumnRemaining_pack] + rw [machineIfEmpty_of_ne_nil_matrix _ _ _ hnonempty, + machineRationalMatrixColumnAdvance] + simp only [machineRationalMatrixColumnRemaining_pack, + machineRationalMatrixColumnAccumulator_pack, + machineRationalMatrixColumnColumn_pack, + machineRationalMatrixColumnBound_pack, + machineRationalMatrixColumnNextAccumulator, + machineRationalMatrixColumnCandidate, + machineRationalMatrixColumnCurrentEntry, + machineRationalMatrixColumnCurrentRow] + rw [hdrop, machineListHead_cons, machineListTail_cons, + machineListIndex_binaryListCode rationalEntryBinaryCode rows[k] j hrow] + rw [← List.getD_eq_getElem rows[k] 0 hrow] + rw [List.take_of_length_le hcandPair] + rw [hreverse] + rfl + +theorem machineRationalMatrixColumnIterate_semantics + (rows : List (List ℚ)) (j : ℕ) + (hvalid : RationalRowsHaveColumn rows j) : ∀ k ≤ rows.length, + let word := pair (List.replicate j true) + (binaryListCode (binaryListCode rationalEntryBinaryCode) rows) + (machineRationalMatrixColumnStep)^[k] + (machineRationalMatrixColumnInit word) = + machineRationalMatrixColumnSemanticState rows j k word := by + intro k hk + let word := pair (List.replicate j true) + (binaryListCode (binaryListCode rationalEntryBinaryCode) rows) + change (machineRationalMatrixColumnStep)^[k] + (machineRationalMatrixColumnInit word) = + machineRationalMatrixColumnSemanticState rows j k word + have hrowsBound : + (binaryListCode (binaryListCode rationalEntryBinaryCode) rows).length ≤ + word.length := by + calc + _ = (machinePairSecond word).length := by simp [word] + _ ≤ word.length := machinePairSecond_length_le word + induction k with + | zero => + simpa only [word] using + (machineRationalMatrixColumnInit_semantics rows j) + | succ k ih => + rw [Function.iterate_succ_apply', ih (by omega)] + exact machineRationalMatrixColumnStep_semantics + rows j k word (by omega) hvalid hrowsBound + +theorem machineRationalMatrixColumn_done_iterate + (extra : ℕ) (accumulator column bound : List Bool) : + (machineRationalMatrixColumnStep)^[extra] + (machineRationalMatrixColumnPack [] accumulator column bound) = + machineRationalMatrixColumnPack [] accumulator column bound := by + induction extra with + | zero => rfl + | succ k ih => + rw [Function.iterate_succ_apply', ih] + simp [machineRationalMatrixColumnStep] + +theorem machineRationalMatrixColumnReversedCode_encode + (rows : List (List ℚ)) (j : ℕ) + (hvalid : RationalRowsHaveColumn rows j) : + let word := pair (List.replicate j true) + (binaryListCode (binaryListCode rationalEntryBinaryCode) rows) + machineRationalMatrixColumnReversedCode word = + binaryListCode rationalEntryBinaryCode + (rationalColumnOfRows rows j).reverse := by + let word := pair (List.replicate j true) + (binaryListCode (binaryListCode rationalEntryBinaryCode) rows) + change machineRationalMatrixColumnReversedCode word = _ + have hrowsCode : + (binaryListCode (binaryListCode rationalEntryBinaryCode) rows).length ≤ + word.length := by + calc + _ = (machinePairSecond word).length := by simp [word] + _ ≤ word.length := machinePairSecond_length_le word + have hwork : rows.length ≤ word.length := + (list_length_le_binaryListCode_length + (binaryListCode rationalEntryBinaryCode) rows).trans hrowsCode + have hsplit : word.length = (word.length - rows.length) + rows.length := by + omega + rw [machineRationalMatrixColumnReversedCode, + machineRationalMatrixColumnFinalState, hsplit, + Function.iterate_add_apply, + machineRationalMatrixColumnIterate_semantics rows j hvalid + rows.length le_rfl] + simp only [machineRationalMatrixColumnSemanticState, + List.drop_length, List.take_length, + binaryListCode] + rw [machineRationalMatrixColumn_done_iterate] + simp + +@[simp] theorem machineRationalMatrixColumnCode_rows_encode + (rows : List (List ℚ)) (j : ℕ) + (hvalid : RationalRowsHaveColumn rows j) : + machineRationalMatrixColumnCode + (pair (List.replicate j true) + (binaryListCode (binaryListCode rationalEntryBinaryCode) rows)) = + binaryListCode rationalEntryBinaryCode + (rationalColumnOfRows rows j) := by + rw [machineRationalMatrixColumnCode, + machineRationalMatrixColumnReversedCode_encode rows j hvalid, + machineListReverse_encode, List.reverse_reverse] + +theorem rationalMatrixRows_haveColumn {d : ℕ} + (A : Matrix (Fin d) (Fin d) ℚ) (j : Fin d) : + RationalRowsHaveColumn (rationalMatrixRows A) j.1 := by + intro row hrow + rw [rationalMatrixRows] at hrow + obtain ⟨i, hi⟩ := List.mem_ofFn.mp hrow + subst row + simp + +theorem rationalColumnOfRows_matrix {d : ℕ} + (A : Matrix (Fin d) (Fin d) ℚ) (j : Fin d) : + rationalColumnOfRows (rationalMatrixRows A) j.1 = + List.ofFn (fun i : Fin d => A i j) := by + apply List.ext_getElem + · simp [rationalColumnOfRows, rationalMatrixRows] + · intro i hiLeft hiRight + simp only [rationalColumnOfRows, rationalMatrixRows, + List.getElem_map, List.getElem_ofFn] + have hj : j.1 < + (List.ofFn fun j' : Fin d => A ⟨i, by simpa using hiRight⟩ j').length := by + simp + rw [List.getD_eq_getElem _ _ hj] + simp + +@[simp] theorem machineRationalMatrixColumnCode_encode {d : ℕ} + (A : Matrix (Fin d) (Fin d) ℚ) (j : Fin d) : + machineRationalMatrixColumnCode + (pair (List.replicate j.1 true) + (rationalSquareMatrixRowsCode A)) = + rationalFiniteVectorCode (fun i : Fin d => A i j) := by + rw [rationalSquareMatrixRowsCode, + machineRationalMatrixColumnCode_rows_encode + (rationalMatrixRows A) j.1 (rationalMatrixRows_haveColumn A j), + rationalColumnOfRows_matrix] + rfl + +/-! ## One coordinate of a transpose--vector product -/ + +/-- Input: +`pair columnUnary (pair nestedMatrixRowsCode rationalVectorCode)`. -/ +def machineRationalMatrixTransposeMulVectorEntryCode + (word : List Bool) : List Bool := + let column := machinePairFirst word + let payload := machinePairSecond word + let matrixRows := machinePairFirst payload + let vector := machinePairSecond payload + machineRationalVectorDotEntryCode + (pair + (machineRationalMatrixColumnCode (pair column matrixRows)) + vector) + +theorem machineRationalMatrixTransposeMulVectorEntryCode_mem_FP : + machineRationalMatrixTransposeMulVectorEntryCode ∈ FP := by + have hcolumn := machinePairFirst_mem_FP + have hpayload := machinePairSecond_mem_FP + have hmatrix := machineCompose_mem_FP hpayload machinePairFirst_mem_FP + have hvector := machineCompose_mem_FP hpayload machinePairSecond_mem_FP + have hcolumnInput := machinePair_mem_FP hcolumn hmatrix + have hcolumnCode := machineCompose_mem_FP hcolumnInput + machineRationalMatrixColumnCode_mem_FP + have hdotInput := machinePair_mem_FP hcolumnCode hvector + simpa only [machineRationalMatrixTransposeMulVectorEntryCode] using + machineCompose_mem_FP hdotInput + machineRationalVectorDotEntryCode_mem_FP + +@[simp] theorem + machineRationalMatrixTransposeMulVectorEntryCode_encode {d : ℕ} + (A : Matrix (Fin d) (Fin d) ℚ) (v : Fin d → ℚ) (j : Fin d) : + machineRationalMatrixTransposeMulVectorEntryCode + (pair (List.replicate j.1 true) + (pair (rationalSquareMatrixRowsCode A) + (rationalFiniteVectorCode v))) = + rationalEntryBinaryCode (∑ i, A i j * v i) := by + rw [machineRationalMatrixTransposeMulVectorEntryCode] + simp only [machinePairFirst_pair, machinePairSecond_pair] + rw [machineRationalMatrixColumnCode_encode, + machineRationalVectorDotEntryCode_encode] + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalMatrixMul.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalMatrixMul.lean new file mode 100644 index 0000000000..b9976f0955 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalMatrixMul.lean @@ -0,0 +1,676 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalMatrixMulVector + +/-! +# Polynomial-time rational matrix multiplication + +This module gives an ordinary finite-word implementation of exact square +matrix multiplication. A row of `A * B` is obtained as `Bᵀ` times the +corresponding row of `A`; the already verified transpose--vector machine +therefore supplies the arithmetic kernel. A bounded outer scan assembles +the rows. +-/ + +namespace BeyondBethe + +open Complexity + +def rationalMatrixMul {d : ℕ} + (A B : Matrix (Fin d) (Fin d) ℚ) : Matrix (Fin d) (Fin d) ℚ := + fun i j ↦ ∑ k, A i k * B k j + +theorem rationalMatrixMul_eq_matrix_mul {d : ℕ} + (A B : Matrix (Fin d) (Fin d) ℚ) : + rationalMatrixMul A B = A * B := by + rfl + +def rationalMatrixMulCanonicalWord {d : ℕ} + (A B : Matrix (Fin d) (Fin d) ℚ) : List Bool := + pair (List.replicate d true) + (pair (rationalSquareMatrixRowsCode A) + (rationalSquareMatrixRowsCode B)) + +def machineRationalMatrixMulDimensionUnary + (word : List Bool) : List Bool := machinePairFirst word + +def machineRationalMatrixMulMatrices + (word : List Bool) : List Bool := machinePairSecond word + +def machineRationalMatrixMulLeftRows + (word : List Bool) : List Bool := + machinePairFirst (machineRationalMatrixMulMatrices word) + +def machineRationalMatrixMulRightRows + (word : List Bool) : List Bool := + machinePairSecond (machineRationalMatrixMulMatrices word) + +/-- Input: `pair rowUnary canonicalMatrixMulWord`. -/ +def machineRationalMatrixMulRowCode + (word : List Bool) : List Bool := + let rowUnary := machinePairFirst word + let payload := machinePairSecond word + let leftRow := machineListIndex + (pair rowUnary (machineRationalMatrixMulLeftRows payload)) + machineRationalTransposeMulVectorCode + (pair (machineRationalMatrixMulDimensionUnary payload) + (pair (machineRationalMatrixMulRightRows payload) leftRow)) + +theorem machineRationalMatrixMulDimensionUnary_mem_FP : + machineRationalMatrixMulDimensionUnary ∈ FP := machinePairFirst_mem_FP + +theorem machineRationalMatrixMulMatrices_mem_FP : + machineRationalMatrixMulMatrices ∈ FP := machinePairSecond_mem_FP + +theorem machineRationalMatrixMulLeftRows_mem_FP : + machineRationalMatrixMulLeftRows ∈ FP := by + simpa only [machineRationalMatrixMulLeftRows] using + machineCompose_mem_FP machineRationalMatrixMulMatrices_mem_FP + machinePairFirst_mem_FP + +theorem machineRationalMatrixMulRightRows_mem_FP : + machineRationalMatrixMulRightRows ∈ FP := by + simpa only [machineRationalMatrixMulRightRows] using + machineCompose_mem_FP machineRationalMatrixMulMatrices_mem_FP + machinePairSecond_mem_FP + +theorem machineRationalMatrixMulRowCode_mem_FP : + machineRationalMatrixMulRowCode ∈ FP := by + have hrow := machinePairFirst_mem_FP + have hpayload := machinePairSecond_mem_FP + have hleftRows := machineCompose_mem_FP hpayload + machineRationalMatrixMulLeftRows_mem_FP + have hleftRow := machineCompose_mem_FP + (machinePair_mem_FP hrow hleftRows) machineListIndex_mem_FP + have hdim := machineCompose_mem_FP hpayload + machineRationalMatrixMulDimensionUnary_mem_FP + have hrightRows := machineCompose_mem_FP hpayload + machineRationalMatrixMulRightRows_mem_FP + have hinput := machinePair_mem_FP hdim + (machinePair_mem_FP hrightRows hleftRow) + simpa only [machineRationalMatrixMulRowCode] using + machineCompose_mem_FP hinput machineRationalTransposeMulVectorCode_mem_FP + +theorem rationalTransposeMulVector_row_eq_matrixMul {d : ℕ} + (A B : Matrix (Fin d) (Fin d) ℚ) (i : Fin d) : + rationalTransposeMulVector B (fun k ↦ A i k) = + fun j ↦ rationalMatrixMul A B i j := by + funext j + simp only [rationalTransposeMulVector, rationalMatrixMul] + apply Finset.sum_congr rfl + intro k _ + exact mul_comm _ _ + +@[simp] theorem machineRationalMatrixMulRowCode_encode {d : ℕ} + (A B : Matrix (Fin d) (Fin d) ℚ) (i : Fin d) : + machineRationalMatrixMulRowCode + (pair (List.replicate i.1 true) + (rationalMatrixMulCanonicalWord A B)) = + rationalFiniteVectorCode (fun j ↦ rationalMatrixMul A B i j) := by + rw [machineRationalMatrixMulRowCode] + simp only [machinePairFirst_pair, machinePairSecond_pair, + machineRationalMatrixMulLeftRows, + machineRationalMatrixMulRightRows, + machineRationalMatrixMulMatrices, + machineRationalMatrixMulDimensionUnary, + rationalMatrixMulCanonicalWord, + rationalSquareMatrixRowsCode] + rw [machineListIndex_binaryListCode] + · simp only [rationalMatrixRows, List.getElem_ofFn] + change machineRationalTransposeMulVectorCode + (rationalTransposeMulVectorCanonicalWord B (fun k ↦ A i k)) = _ + rw [machineRationalTransposeMulVectorCode_encode, + rationalTransposeMulVector_row_eq_matrixMul] + · simp [rationalMatrixRows] + +/-! ## A global ordinary-binary output bound -/ + +def rawRationalMatrixMulCoordinate {d : ℕ} + (A B : Matrix (Fin d) (Fin d) ℚ) (i j : Fin d) : RawRat := + rawRatListDot RawRat.zero (List.ofFn fun k ↦ A i k) + (rationalColumnOfRows (rationalMatrixRows B) j.1) + +theorem rawRationalMatrixMulCoordinate_value {d : ℕ} + (A B : Matrix (Fin d) (Fin d) ℚ) (i j : Fin d) : + (rawRationalMatrixMulCoordinate A B i j).value = + rationalMatrixMul A B i j := by + rw [rawRationalMatrixMulCoordinate, + rationalColumnOfRows_matrix, rawRatListDot_ofFn_value] + rfl + +theorem rawRationalMatrixMulCoordinate_width_le_word {d : ℕ} + (A B : Matrix (Fin d) (Fin d) ℚ) (i j : Fin d) : + rawRatWidth (rawRationalMatrixMulCoordinate A B i j) ≤ + (rationalMatrixMulCanonicalWord A B).length := by + let row := List.ofFn fun k : Fin d ↦ A i k + let column := rationalColumnOfRows (rationalMatrixRows B) j.1 + have hwidth := rawRatWidth_listDot_le RawRat.zero row column + simp only [rawRatWidth_zero] at hwidth + have hcost := rawRatListDotCost_le_codeLength row column + have hrow : + (binaryListCode rationalEntryBinaryCode row).length ≤ + (rationalSquareMatrixRowsCode A).length := by + have helem := binaryListCode_element_length_le + (binaryListCode rationalEntryBinaryCode) + (show row ∈ rationalMatrixRows A by + simp [rationalMatrixRows, row]) + simpa only [rationalSquareMatrixRowsCode] using helem + have hcolumn : + (binaryListCode rationalEntryBinaryCode column).length ≤ + (rationalSquareMatrixRowsCode B).length := by + simpa only [column, rationalSquareMatrixRowsCode] using + rationalColumnOfRows_code_length_le j.1 + (rationalMatrixRows B) (rationalMatrixRows_haveColumn B j) + have hcombined : + 1 + (binaryListCode rationalEntryBinaryCode row).length + + (binaryListCode rationalEntryBinaryCode column).length ≤ + (rationalMatrixMulCanonicalWord A B).length := by + simp only [rationalMatrixMulCanonicalWord, pair_length, + List.length_replicate] + omega + change rawRatWidth (rawRatListDot RawRat.zero row column) ≤ _ + omega + +theorem rationalMatrixMul_entry_code_length_le {d : ℕ} + (A B : Matrix (Fin d) (Fin d) ℚ) (i j : Fin d) : + (rationalEntryBinaryCode (rationalMatrixMul A B i j)).length ≤ + 64 + 36 * (rationalMatrixMulCanonicalWord A B).length := by + have hcanonical := + rationalEntryBinaryCode_binaryNormalizeRawRat_length_le + (rawRationalMatrixMulCoordinate A B i j) + rw [binaryNormalizeRawRat_eq_value, + rawRationalMatrixMulCoordinate_value] at hcanonical + exact hcanonical.trans (Nat.add_le_add_left + (Nat.mul_le_mul_left 36 + (rawRationalMatrixMulCoordinate_width_le_word A B i j)) 64) + +def machineRationalMatrixMulInputBound (word : List Bool) : List Bool := + machineRationalTransposeMulVectorInputBound word + +theorem machineRationalMatrixMulInputBound_mem_FP : + machineRationalMatrixMulInputBound ∈ FP := + machineRationalTransposeMulVectorInputBound_mem_FP + +theorem rationalMatrixMul_code_length_le_cubic {d : ℕ} + (A B : Matrix (Fin d) (Fin d) ℚ) : + (rationalSquareMatrixRowsCode (rationalMatrixMul A B)).length ≤ + d * (2 * (d * + (2 * (64 + 36 * (rationalMatrixMulCanonicalWord A B).length) + 2)) + + 2) := by + let L := 64 + 36 * (rationalMatrixMulCanonicalWord A B).length + have hentry : ∀ i j : Fin d, + (rationalEntryBinaryCode (rationalMatrixMul A B i j)).length ≤ L := by + intro i j + exact rationalMatrixMul_entry_code_length_le A B i j + rw [rationalSquareMatrixRowsCode, binaryListCode_length_eq_sum] + simp only [rationalMatrixRows, List.map_ofFn, List.sum_ofFn, + Function.comp_apply] + calc + (∑ i : Fin d, + (2 * (binaryListCode rationalEntryBinaryCode + (List.ofFn fun j ↦ rationalMatrixMul A B i j)).length + 2)) ≤ + ∑ _i : Fin d, (2 * (d * (2 * L + 2)) + 2) := by + apply Finset.sum_le_sum + intro i _ + gcongr + rw [binaryListCode_length_eq_sum] + simp only [List.map_ofFn, List.sum_ofFn, Function.comp_apply] + calc + (∑ j : Fin d, + (2 * (rationalEntryBinaryCode + (rationalMatrixMul A B i j)).length + 2)) ≤ + ∑ _j : Fin d, (2 * L + 2) := by + apply Finset.sum_le_sum + intro j _ + have h := hentry i j + omega + _ = d * (2 * L + 2) := by simp [mul_comm] + _ = d * (2 * (d * (2 * L + 2)) + 2) := by simp [mul_comm] + +theorem rationalMatrixMul_code_length_le_bound {d : ℕ} + (A B : Matrix (Fin d) (Fin d) ℚ) : + (rationalSquareMatrixRowsCode (rationalMatrixMul A B)).length ≤ + (machineRationalMatrixMulInputBound + (rationalMatrixMulCanonicalWord A B)).length := by + let word := rationalMatrixMulCanonicalWord A B + let n := word.length + let x := 16 + n + let y := 16 + x ^ 2 + let z := 16 + y ^ 2 + have hd : d ≤ word.length := by + have h := machinePairFirst_length_le word + simpa only [word, rationalMatrixMulCanonicalWord, + machinePairFirst_pair, List.length_replicate] using h + have hn4 : 4 ≤ n := by + simp only [n, word, rationalMatrixMulCanonicalWord, pair_length, + List.length_replicate] + omega + have hcubic := rationalMatrixMul_code_length_le_cubic A B + have hd' : d ≤ n := by simpa only [n] using hd + have hdn : d * n ≤ n * n := Nat.mul_le_mul hd' le_rfl + have hdd : d * d ≤ n * n := Nat.mul_le_mul hd' hd' + have hddn : (d * d) * n ≤ (n * n) * n := + Nat.mul_le_mul hdd le_rfl + have hpoly : + d * (2 * (d * (2 * (64 + 36 * n) + 2)) + 2) ≤ + 211 * n ^ 3 := by + nlinarith + have hout : + (rationalSquareMatrixRowsCode (rationalMatrixMul A B)).length ≤ + 211 * n ^ 3 := by + apply hcubic.trans + simpa only [n, word] using hpoly + have hnx : n ≤ x := by simp [x] + have hxpos : 0 < x := by omega + have h211 : 211 ≤ x ^ 2 := by + dsimp only [x] + nlinarith + have hnx3 : n ^ 3 ≤ x ^ 3 := Nat.pow_le_pow_left hnx 3 + have hto5 : 211 * n ^ 3 ≤ x ^ 5 := by + have h := Nat.mul_le_mul h211 hnx3 + simpa only [pow_succ, pow_two, mul_assoc, mul_left_comm, + mul_comm] using h + have hto8 : x ^ 5 ≤ x ^ 8 := + Nat.pow_le_pow_right hxpos (by omega) + have hxy : x ^ 2 ≤ y := by simp [y] + have hx4y2 : x ^ 4 ≤ y ^ 2 := by + have h := Nat.pow_le_pow_left hxy 2 + simpa only [← pow_mul] using h + have hyz : y ^ 2 ≤ z := by simp [z] + have hx4z : x ^ 4 ≤ z := hx4y2.trans hyz + have hx8z2 : x ^ 8 ≤ z ^ 2 := by + have h := Nat.pow_le_pow_left hx4z 2 + simpa only [← pow_mul] using h + apply hout.trans + apply hto5.trans + apply hto8.trans + apply hx8z2.trans_eq + simp only [machineRationalMatrixMulInputBound, + machineRationalTransposeMulVectorInputBound, + machineBinaryMulWidth, List.length_replicate, + List.length_append, n, x, y, z, word, pow_two] + +/-! ## Bounded outer row scan -/ + +def machineRationalMatrixMulIndices (word : List Bool) : List Bool := + machineUnaryRangeCode (machineRationalMatrixMulDimensionUnary word) + +def machineRationalMatrixMulCurrentRow (state : List Bool) : List Bool := + machineRationalMatrixMulRowCode + (pair (machineRationalTransposeMulVectorCurrentIndex state) + (machineRationalTransposeMulVectorStatePayload state)) + +def machineRationalMatrixMulCandidate (state : List Bool) : List Bool := + pair (machineRationalMatrixMulCurrentRow state) + (machineRationalTransposeMulVectorAccumulator state) + +def machineRationalMatrixMulNextAccumulator + (state : List Bool) : List Bool := + (machineRationalMatrixMulCandidate state).take + (machineRationalTransposeMulVectorBound state).length + +def machineRationalMatrixMulAdvance (state : List Bool) : List Bool := + machineRationalTransposeMulVectorPack + (machineListTail (machineRationalTransposeMulVectorRemaining state)) + (machineRationalMatrixMulNextAccumulator state) + (machineRationalTransposeMulVectorStatePayload state) + (machineRationalTransposeMulVectorBound state) + +def machineRationalMatrixMulStep (state : List Bool) : List Bool := + machineIfEmpty (machineRationalTransposeMulVectorRemaining state) state + (machineRationalMatrixMulAdvance state) + +def machineRationalMatrixMulInit (word : List Bool) : List Bool := + machineRationalTransposeMulVectorPack + (machineRationalMatrixMulIndices word) [] word + (machineRationalMatrixMulInputBound word) + +def machineRationalMatrixMulWidth (word : List Bool) : List Bool := + let bound := machineRationalMatrixMulInputBound word + machineRationalTransposeMulVectorPack bound bound bound bound + +def machineRationalMatrixMulFinalState (word : List Bool) : List Bool := + (machineRationalMatrixMulStep)^[word.length] + (machineRationalMatrixMulInit word) + +def machineRationalMatrixMulReversedCode (word : List Bool) : List Bool := + machineRationalTransposeMulVectorAccumulator + (machineRationalMatrixMulFinalState word) + +/-- Input: `pair dimensionUnary (pair leftRowsCode rightRowsCode)`. -/ +def machineRationalMatrixMulCode (word : List Bool) : List Bool := + machineListReverse (machineRationalMatrixMulReversedCode word) + +theorem machineRationalMatrixMulIndices_mem_FP : + machineRationalMatrixMulIndices ∈ FP := by + simpa only [machineRationalMatrixMulIndices] using + machineCompose_mem_FP machineRationalMatrixMulDimensionUnary_mem_FP + machineUnaryRangeCode_mem_FP + +theorem machineRationalMatrixMulCurrentRow_mem_FP : + machineRationalMatrixMulCurrentRow ∈ FP := by + have hinput := machinePair_mem_FP + machineRationalTransposeMulVectorCurrentIndex_mem_FP + machineRationalTransposeMulVectorStatePayload_mem_FP + simpa only [machineRationalMatrixMulCurrentRow] using + machineCompose_mem_FP hinput machineRationalMatrixMulRowCode_mem_FP + +theorem machineRationalMatrixMulCandidate_mem_FP : + machineRationalMatrixMulCandidate ∈ FP := + machinePair_mem_FP machineRationalMatrixMulCurrentRow_mem_FP + machineRationalTransposeMulVectorAccumulator_mem_FP + +theorem machineRationalMatrixMulNextAccumulator_mem_FP : + machineRationalMatrixMulNextAccumulator ∈ FP := by + simpa only [machineRationalMatrixMulNextAccumulator] using + machineTake_mem_FP machineRationalTransposeMulVectorBound_mem_FP + machineRationalMatrixMulCandidate_mem_FP + +theorem machineRationalMatrixMulAdvance_mem_FP : + machineRationalMatrixMulAdvance ∈ FP := by + have htail := machineCompose_mem_FP + machineRationalTransposeMulVectorRemaining_mem_FP machineListTail_mem_FP + exact machinePair_mem_FP htail + (machinePair_mem_FP machineRationalMatrixMulNextAccumulator_mem_FP + (machinePair_mem_FP + machineRationalTransposeMulVectorStatePayload_mem_FP + machineRationalTransposeMulVectorBound_mem_FP)) + +theorem machineRationalMatrixMulStep_mem_FP : + machineRationalMatrixMulStep ∈ FP := + machineIfEmpty_mem_FP machineRationalTransposeMulVectorRemaining_mem_FP + id_mem_FP machineRationalMatrixMulAdvance_mem_FP + +theorem machineRationalMatrixMulInit_mem_FP : + machineRationalMatrixMulInit ∈ FP := by + exact machinePair_mem_FP machineRationalMatrixMulIndices_mem_FP + (machinePair_mem_FP (machineConst_mem_FP []) + (machinePair_mem_FP id_mem_FP + machineRationalMatrixMulInputBound_mem_FP)) + +theorem machineRationalMatrixMulWidth_mem_FP : + machineRationalMatrixMulWidth ∈ FP := by + have hbound := machineRationalMatrixMulInputBound_mem_FP + exact machinePair_mem_FP hbound + (machinePair_mem_FP hbound (machinePair_mem_FP hbound hbound)) + +theorem machineRationalMatrixMulInit_bound (word : List Bool) : + MachineRationalTransposeMulVectorStateBound word + (machineRationalMatrixMulInit word) := by + simp only [MachineRationalTransposeMulVectorStateBound, + machineRationalMatrixMulInit, + machineRationalTransposeMulVectorRemaining_pack, + machineRationalTransposeMulVectorAccumulator_pack, + machineRationalTransposeMulVectorStatePayload_pack, + machineRationalTransposeMulVectorBound_pack, + machineRationalMatrixMulInputBound] + refine ⟨trivial, ?_, by simp, ?_, trivial⟩ + · simpa only [machineRationalMatrixMulIndices, + machineRationalMatrixMulDimensionUnary, + machineRationalTransposeMulVectorIndices, + machineRationalTransposeMulVectorDimension] using + machineRationalTransposeMulVector_indices_le_bound word + · exact machineRationalTransposeMulVector_word_le_bound word + +theorem machineRationalMatrixMulStep_bound {word state : List Bool} + (hs : MachineRationalTransposeMulVectorStateBound word state) : + MachineRationalTransposeMulVectorStateBound word + (machineRationalMatrixMulStep state) := by + dsimp only [MachineRationalTransposeMulVectorStateBound] at hs ⊢ + rcases hs with ⟨hdecomp, hremaining, hacc, hpayload, hbound⟩ + by_cases hnil : machineRationalTransposeMulVectorRemaining state = [] + · rw [machineRationalMatrixMulStep, hnil, machineIfEmpty_nil] + exact ⟨hdecomp, hremaining, hacc, hpayload, hbound⟩ + · cases hcode : machineRationalTransposeMulVectorRemaining state with + | nil => exact False.elim (hnil hcode) + | cons bit tail => + rw [machineRationalMatrixMulStep, hcode, machineIfEmpty_cons, + machineRationalMatrixMulAdvance] + simp only [machineRationalTransposeMulVectorRemaining_pack, + machineRationalTransposeMulVectorAccumulator_pack, + machineRationalTransposeMulVectorStatePayload_pack, + machineRationalTransposeMulVectorBound_pack] + refine ⟨trivial, ?_, ?_, hpayload, hbound⟩ + · exact (machineListTail_length_le + (machineRationalTransposeMulVectorRemaining state)).trans + hremaining + · rw [machineRationalMatrixMulNextAccumulator, hbound] + exact List.length_take_le _ _ + +theorem machineRationalMatrixMulIterate_bound (word : List Bool) : ∀ k, + MachineRationalTransposeMulVectorStateBound word + ((machineRationalMatrixMulStep)^[k] + (machineRationalMatrixMulInit word)) := by + intro k + induction k with + | zero => exact machineRationalMatrixMulInit_bound word + | succ k ih => + rw [Function.iterate_succ_apply'] + exact machineRationalMatrixMulStep_bound ih + +theorem machineRationalMatrixMulIterate_length_le_width + (word : List Bool) (iterations : ℕ) + (_ : iterations ≤ word.length) : + ((machineRationalMatrixMulStep)^[iterations] + (machineRationalMatrixMulInit word)).length ≤ + (machineRationalMatrixMulWidth word).length := by + rcases machineRationalMatrixMulIterate_bound word iterations with + ⟨hdecomp, hremaining, hacc, hpayload, hbound⟩ + rw [hdecomp] + change (machineRationalTransposeMulVectorPack _ _ _ _).length ≤ _ + rw [hbound] + simp only [machineRationalTransposeMulVectorPack, + machineRationalMatrixMulWidth, machineRationalMatrixMulInputBound, + pair_length] + omega + +theorem machineRationalMatrixMulFinalState_mem_FP : + machineRationalMatrixMulFinalState ∈ FP := by + exact Cobham.iterate_mem_FP machineRationalMatrixMulStep_mem_FP + machineRationalMatrixMulInit_mem_FP id_mem_FP + machineRationalMatrixMulWidth_mem_FP + machineRationalMatrixMulIterate_length_le_width + +theorem machineRationalMatrixMulReversedCode_mem_FP : + machineRationalMatrixMulReversedCode ∈ FP := by + simpa only [machineRationalMatrixMulReversedCode] using + machineCompose_mem_FP machineRationalMatrixMulFinalState_mem_FP + machineRationalTransposeMulVectorAccumulator_mem_FP + +theorem machineRationalMatrixMulCode_mem_FP : + machineRationalMatrixMulCode ∈ FP := by + simpa only [machineRationalMatrixMulCode] using + machineCompose_mem_FP machineRationalMatrixMulReversedCode_mem_FP + machineListReverse_mem_FP + +/-! ## Exact scan semantics -/ + +def rationalMatrixMulRowsPrefix {d : ℕ} + (A B : Matrix (Fin d) (Fin d) ℚ) (k : ℕ) : List (List ℚ) := + ((List.finRange d).take k).map + fun i ↦ List.ofFn fun j ↦ rationalMatrixMul A B i j + +def machineRationalMatrixMulSemanticState {d : ℕ} + (A B : Matrix (Fin d) (Fin d) ℚ) (k : ℕ) : List Bool := + let word := rationalMatrixMulCanonicalWord A B + machineRationalTransposeMulVectorPack + (binaryListCode finUnaryCode ((List.finRange d).drop k)) + (binaryListCode (binaryListCode rationalEntryBinaryCode) + (rationalMatrixMulRowsPrefix A B k).reverse) + word (machineRationalMatrixMulInputBound word) + +theorem machineRationalMatrixMulInit_semantics {d : ℕ} + (A B : Matrix (Fin d) (Fin d) ℚ) : + machineRationalMatrixMulInit (rationalMatrixMulCanonicalWord A B) = + machineRationalMatrixMulSemanticState A B 0 := by + simp [machineRationalMatrixMulInit, + machineRationalMatrixMulSemanticState, + machineRationalMatrixMulIndices, + machineRationalMatrixMulDimensionUnary, + rationalMatrixMulCanonicalWord, machineUnaryRangeCode_encode, + finRangeUnaryCode, rationalMatrixMulRowsPrefix, binaryListCode] + +theorem rationalMatrixMulRowsPrefix_succ {d : ℕ} + (A B : Matrix (Fin d) (Fin d) ℚ) (k : ℕ) (hk : k < d) : + rationalMatrixMulRowsPrefix A B (k + 1) = + rationalMatrixMulRowsPrefix A B k ++ + [List.ofFn fun j ↦ rationalMatrixMul A B ⟨k, hk⟩ j] := by + simp only [rationalMatrixMulRowsPrefix, List.map_take] + have hkm : k < (List.finRange d).length := by simpa + simpa [List.getElem_finRange] using + congrArg (List.map fun i ↦ + List.ofFn fun j ↦ rationalMatrixMul A B i j) + (List.take_concat_get hkm).symm + +theorem machineRationalMatrixMulStep_semantics {d : ℕ} + (A B : Matrix (Fin d) (Fin d) ℚ) (k : ℕ) (hk : k < d) : + machineRationalMatrixMulStep + (machineRationalMatrixMulSemanticState A B k) = + machineRationalMatrixMulSemanticState A B (k + 1) := by + let word := rationalMatrixMulCanonicalWord A B + let i : Fin d := ⟨k, hk⟩ + have hdrop : + (List.finRange d).drop k = + i :: (List.finRange d).drop (k + 1) := by + convert List.drop_eq_getElem_cons + (show k < (List.finRange d).length by simpa) using 1 + simp [i, List.getElem_finRange] + have hprefix := rationalMatrixMulRowsPrefix_succ A B k hk + have hreverse : + (rationalMatrixMulRowsPrefix A B (k + 1)).reverse = + (List.ofFn fun j ↦ rationalMatrixMul A B i j) :: + (rationalMatrixMulRowsPrefix A B k).reverse := by + rw [hprefix, List.reverse_append] + simp [i] + have hcand : + (binaryListCode (binaryListCode rationalEntryBinaryCode) + (rationalMatrixMulRowsPrefix A B (k + 1)).reverse).length ≤ + (machineRationalMatrixMulInputBound word).length := by + have hprefixBound := binaryListCode_take_reverse_length_le + (binaryListCode rationalEntryBinaryCode) + (rationalMatrixRows (rationalMatrixMul A B)) (k + 1) + have hprefixEq : rationalMatrixMulRowsPrefix A B (k + 1) = + (rationalMatrixRows (rationalMatrixMul A B)).take (k + 1) := by + apply List.ext_getElem + · simp [rationalMatrixMulRowsPrefix, rationalMatrixRows] + · intro r hrLeft hrRight + simp [rationalMatrixMulRowsPrefix, rationalMatrixRows, + List.getElem_finRange] + rw [hprefixEq] + exact hprefixBound.trans (rationalMatrixMul_code_length_le_bound A B) + have hcandPair : + (pair + (binaryListCode rationalEntryBinaryCode + (List.ofFn fun j ↦ rationalMatrixMul A B i j)) + (binaryListCode (binaryListCode rationalEntryBinaryCode) + (rationalMatrixMulRowsPrefix A B k).reverse)).length ≤ + (machineRationalMatrixMulInputBound word).length := by + simpa only [hreverse, binaryListCode] using hcand + have hnonempty : + binaryListCode finUnaryCode ((List.finRange d).drop k) ≠ [] := by + rw [hdrop] + exact binaryListCode_cons_ne_nil finUnaryCode i + ((List.finRange d).drop (k + 1)) + rw [machineRationalMatrixMulStep] + simp only [machineRationalMatrixMulSemanticState, + machineRationalTransposeMulVectorRemaining_pack] + rw [machineIfEmpty_of_ne_nil_matrix _ _ _ hnonempty, + machineRationalMatrixMulAdvance] + simp only [machineRationalTransposeMulVectorRemaining_pack, + machineRationalTransposeMulVectorAccumulator_pack, + machineRationalTransposeMulVectorStatePayload_pack, + machineRationalTransposeMulVectorBound_pack, + machineRationalMatrixMulNextAccumulator, + machineRationalMatrixMulCandidate, + machineRationalMatrixMulCurrentRow, + machineRationalTransposeMulVectorCurrentIndex] + rw [hdrop, machineListHead_cons, machineListTail_cons] + change machineRationalTransposeMulVectorPack _ + ((pair (machineRationalMatrixMulRowCode + (pair (finUnaryCode i) word)) + (binaryListCode (binaryListCode rationalEntryBinaryCode) + (rationalMatrixMulRowsPrefix A B k).reverse)).take + (machineRationalMatrixMulInputBound word).length) _ _ = _ + rw [show finUnaryCode i = List.replicate i.1 true by rfl, + machineRationalMatrixMulRowCode_encode] + change machineRationalTransposeMulVectorPack _ + ((pair (binaryListCode rationalEntryBinaryCode + (List.ofFn fun j ↦ rationalMatrixMul A B i j)) + (binaryListCode (binaryListCode rationalEntryBinaryCode) + (rationalMatrixMulRowsPrefix A B k).reverse)).take + (machineRationalMatrixMulInputBound word).length) _ _ = _ + rw [List.take_of_length_le hcandPair, hreverse] + rfl + +theorem machineRationalMatrixMulIterate_semantics {d : ℕ} + (A B : Matrix (Fin d) (Fin d) ℚ) : ∀ k ≤ d, + (machineRationalMatrixMulStep)^[k] + (machineRationalMatrixMulInit (rationalMatrixMulCanonicalWord A B)) = + machineRationalMatrixMulSemanticState A B k := by + intro k hk + induction k with + | zero => exact machineRationalMatrixMulInit_semantics A B + | succ k ih => + rw [Function.iterate_succ_apply', ih (by omega)] + exact machineRationalMatrixMulStep_semantics A B k (by omega) + +theorem machineRationalMatrixMul_done_iterate + (extra : ℕ) (accumulator payload bound : List Bool) : + (machineRationalMatrixMulStep)^[extra] + (machineRationalTransposeMulVectorPack [] accumulator payload bound) = + machineRationalTransposeMulVectorPack [] accumulator payload bound := by + induction extra with + | zero => rfl + | succ k ih => + rw [Function.iterate_succ_apply', ih] + simp [machineRationalMatrixMulStep] + +theorem rationalMatrixMulRowsPrefix_all {d : ℕ} + (A B : Matrix (Fin d) (Fin d) ℚ) : + rationalMatrixMulRowsPrefix A B d = + rationalMatrixRows (rationalMatrixMul A B) := by + apply List.ext_getElem + · simp [rationalMatrixMulRowsPrefix, rationalMatrixRows] + · intro i hiLeft hiRight + simp [rationalMatrixMulRowsPrefix, rationalMatrixRows, + List.getElem_finRange] + +theorem machineRationalMatrixMulReversedCode_encode {d : ℕ} + (A B : Matrix (Fin d) (Fin d) ℚ) : + machineRationalMatrixMulReversedCode + (rationalMatrixMulCanonicalWord A B) = + binaryListCode (binaryListCode rationalEntryBinaryCode) + (rationalMatrixRows (rationalMatrixMul A B)).reverse := by + let word := rationalMatrixMulCanonicalWord A B + have hd : d ≤ word.length := by + have h := machinePairFirst_length_le word + simpa only [word, rationalMatrixMulCanonicalWord, + machinePairFirst_pair, List.length_replicate] using h + have hsplit : word.length = (word.length - d) + d := by omega + change machineRationalMatrixMulReversedCode word = _ + rw [machineRationalMatrixMulReversedCode, + machineRationalMatrixMulFinalState, hsplit, + Function.iterate_add_apply, + machineRationalMatrixMulIterate_semantics A B d le_rfl] + simp only [machineRationalMatrixMulSemanticState] + rw [show binaryListCode finUnaryCode ((List.finRange d).drop d) = [] by + rw [List.drop_eq_nil_of_le (by simp)] + rfl] + rw [machineRationalMatrixMul_done_iterate] + simp only [machineRationalTransposeMulVectorAccumulator_pack] + rw [rationalMatrixMulRowsPrefix_all] + +@[simp] theorem machineRationalMatrixMulCode_encode {d : ℕ} + (A B : Matrix (Fin d) (Fin d) ℚ) : + machineRationalMatrixMulCode (rationalMatrixMulCanonicalWord A B) = + rationalSquareMatrixRowsCode (rationalMatrixMul A B) := by + rw [machineRationalMatrixMulCode, + machineRationalMatrixMulReversedCode_encode, + machineListReverse_encode, List.reverse_reverse] + rfl + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalMatrixMulVector.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalMatrixMulVector.lean new file mode 100644 index 0000000000..aa66a527a0 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalMatrixMulVector.lean @@ -0,0 +1,547 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalNormalizedDirection +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalTransposeMulVector + +/-! +# Polynomial-time rational matrix--vector multiplication + +The center update requires `E.basis * v`, whereas the pulled-back cut uses +`E.basisᵀ * a`. This module begins with the row-coordinate primitive. Its +input is a unary row index followed by the nested row code and the rational +vector code; it extracts that row and invokes the already verified exact dot +product machine. +-/ + +namespace BeyondBethe + +open Complexity + +def rationalMatrixMulVector {d : ℕ} + (A : Matrix (Fin d) (Fin d) ℚ) (v : Fin d → ℚ) : Fin d → ℚ := + fun i ↦ ∑ j, A i j * v j + +/-- Input: `pair rowUnary (pair nestedMatrixRowsCode rationalVectorCode)`. -/ +def machineRationalMatrixMulVectorEntryCode + (word : List Bool) : List Bool := + let row := machinePairFirst word + let payload := machinePairSecond word + let matrixRows := machinePairFirst payload + let vector := machinePairSecond payload + let rowCode := machineListIndex (pair row matrixRows) + machineRationalVectorDotEntryCode (pair rowCode vector) + +theorem machineRationalMatrixMulVectorEntryCode_mem_FP : + machineRationalMatrixMulVectorEntryCode ∈ FP := by + have hrow := machinePairFirst_mem_FP + have hpayload := machinePairSecond_mem_FP + have hmatrix := machineCompose_mem_FP hpayload machinePairFirst_mem_FP + have hvector := machineCompose_mem_FP hpayload machinePairSecond_mem_FP + have hrowInput := machinePair_mem_FP hrow hmatrix + have hrowCode := machineCompose_mem_FP hrowInput machineListIndex_mem_FP + have hdotInput := machinePair_mem_FP hrowCode hvector + simpa only [machineRationalMatrixMulVectorEntryCode] using + machineCompose_mem_FP hdotInput + machineRationalVectorDotEntryCode_mem_FP + +@[simp] theorem machineRationalMatrixMulVectorEntryCode_encode {d : ℕ} + (A : Matrix (Fin d) (Fin d) ℚ) (v : Fin d → ℚ) (i : Fin d) : + machineRationalMatrixMulVectorEntryCode + (pair (List.replicate i.1 true) + (pair (rationalSquareMatrixRowsCode A) + (rationalFiniteVectorCode v))) = + rationalEntryBinaryCode (rationalMatrixMulVector A v i) := by + rw [machineRationalMatrixMulVectorEntryCode] + simp only [machinePairFirst_pair, machinePairSecond_pair, + rationalSquareMatrixRowsCode] + rw [machineListIndex_binaryListCode] + · simp only [rationalMatrixRows, List.getElem_ofFn, + rationalFiniteVectorCode] + change machineRationalVectorDotEntryCode + (pair + (rationalFiniteVectorCode (fun j : Fin d ↦ A i j)) + (rationalFiniteVectorCode v)) = _ + rw [machineRationalVectorDotEntryCode_encode] + rfl + · simp [rationalMatrixRows] + +/-! ## The full vector -/ + +def rawRationalMatrixCoordinate {d : ℕ} + (A : Matrix (Fin d) (Fin d) ℚ) (v : Fin d → ℚ) + (i : Fin d) : RawRat := + rawRatListDot RawRat.zero (List.ofFn fun j ↦ A i j) (List.ofFn v) + +theorem rawRationalMatrixCoordinate_value {d : ℕ} + (A : Matrix (Fin d) (Fin d) ℚ) (v : Fin d → ℚ) + (i : Fin d) : + (rawRationalMatrixCoordinate A v i).value = + rationalMatrixMulVector A v i := by + exact rawRatListDot_ofFn_value (fun j ↦ A i j) v + +def rationalMatrixMulVectorCanonicalWord {d : ℕ} + (A : Matrix (Fin d) (Fin d) ℚ) (v : Fin d → ℚ) : List Bool := + pair (List.replicate d true) + (pair (rationalSquareMatrixRowsCode A) + (rationalFiniteVectorCode v)) + +theorem rawRationalMatrixCoordinate_width_le_word {d : ℕ} + (A : Matrix (Fin d) (Fin d) ℚ) (v : Fin d → ℚ) + (i : Fin d) : + rawRatWidth (rawRationalMatrixCoordinate A v i) ≤ + (rationalMatrixMulVectorCanonicalWord A v).length := by + let row := List.ofFn fun j : Fin d ↦ A i j + let vector := List.ofFn v + have hwidth := rawRatWidth_listDot_le RawRat.zero row vector + simp only [rawRatWidth_zero] at hwidth + have hcost := rawRatListDotCost_le_codeLength row vector + have hrow : + (binaryListCode rationalEntryBinaryCode row).length ≤ + (binaryListCode (binaryListCode rationalEntryBinaryCode) + (rationalMatrixRows A)).length := by + have helem := binaryListCode_element_length_le + (binaryListCode rationalEntryBinaryCode) + (show row ∈ rationalMatrixRows A by + simp [rationalMatrixRows, row]) + simpa only [rationalMatrixRows, List.getElem_ofFn, row] using helem + have hcombined : + 1 + (binaryListCode (binaryListCode rationalEntryBinaryCode) + (rationalMatrixRows A)).length + + (binaryListCode rationalEntryBinaryCode vector).length ≤ + (rationalMatrixMulVectorCanonicalWord A v).length := by + simp only [rationalMatrixMulVectorCanonicalWord, + rationalSquareMatrixRowsCode, rationalFiniteVectorCode, + vector, pair_length, List.length_replicate] + omega + change rawRatWidth (rawRatListDot RawRat.zero row vector) ≤ _ + omega + +theorem rationalMatrixMulVector_entry_code_length_le {d : ℕ} + (A : Matrix (Fin d) (Fin d) ℚ) (v : Fin d → ℚ) + (i : Fin d) : + (rationalEntryBinaryCode + (rationalMatrixMulVector A v i)).length ≤ + 64 + 36 * (rationalMatrixMulVectorCanonicalWord A v).length := by + have hcanonical := + rationalEntryBinaryCode_binaryNormalizeRawRat_length_le + (rawRationalMatrixCoordinate A v i) + rw [binaryNormalizeRawRat_eq_value, + rawRationalMatrixCoordinate_value] at hcanonical + exact hcanonical.trans (Nat.add_le_add_left + (Nat.mul_le_mul_left 36 + (rawRationalMatrixCoordinate_width_le_word A v i)) 64) + +def machineRationalMatrixMulVectorInputBound + (word : List Bool) : List Bool := + machineRationalTransposeMulVectorInputBound word + +theorem machineRationalMatrixMulVectorInputBound_mem_FP : + machineRationalMatrixMulVectorInputBound ∈ FP := + machineRationalTransposeMulVectorInputBound_mem_FP + +theorem rationalMatrixMulVector_code_length_le_bound {d : ℕ} + (A : Matrix (Fin d) (Fin d) ℚ) (v : Fin d → ℚ) : + (rationalFiniteVectorCode (rationalMatrixMulVector A v)).length ≤ + (machineRationalMatrixMulVectorInputBound + (rationalMatrixMulVectorCanonicalWord A v)).length := by + let word := rationalMatrixMulVectorCanonicalWord A v + let B := 64 + 36 * word.length + have hdim : d ≤ word.length := by + have hfirst := machinePairFirst_length_le word + simpa only [word, rationalMatrixMulVectorCanonicalWord, + machinePairFirst_pair, List.length_replicate] using hfirst + have heach : ∀ q ∈ List.ofFn (rationalMatrixMulVector A v), + (rationalEntryBinaryCode q).length ≤ B := by + intro q hq + obtain ⟨i, rfl⟩ := List.mem_ofFn.mp hq + exact rationalMatrixMulVector_entry_code_length_le A v i + have hsum := List.sum_le_card_nsmul + ((List.ofFn (rationalMatrixMulVector A v)).map + fun q ↦ 2 * (rationalEntryBinaryCode q).length + 2) + (2 * B + 2) (by + intro value hvalue + rw [List.mem_map] at hvalue + obtain ⟨q, hq, rfl⟩ := hvalue + have hq' := heach q hq + omega) + rw [rationalFiniteVectorCode, binaryListCode_length_eq_sum] + simp only [machineRationalMatrixMulVectorInputBound, + machineRationalTransposeMulVectorInputBound, + machineBinaryMulWidth, List.length_replicate, + List.length_append, List.length_map, List.length_ofFn, + Nat.nsmul_eq_mul] at hsum ⊢ + dsimp only [B, word] at hsum ⊢ + nlinarith [sq_nonneg + (rationalMatrixMulVectorCanonicalWord A v).length] + +/-! The state layout and the degree-eight envelope are shared with the +transpose--vector machine; only the one-coordinate routine changes. -/ + +def machineRationalMatrixMulVectorCurrentEntry + (state : List Bool) : List Bool := + machineRationalMatrixMulVectorEntryCode + (pair (machineRationalTransposeMulVectorCurrentIndex state) + (machineRationalTransposeMulVectorStatePayload state)) + +def machineRationalMatrixMulVectorCandidate + (state : List Bool) : List Bool := + pair (machineRationalMatrixMulVectorCurrentEntry state) + (machineRationalTransposeMulVectorAccumulator state) + +def machineRationalMatrixMulVectorNextAccumulator + (state : List Bool) : List Bool := + (machineRationalMatrixMulVectorCandidate state).take + (machineRationalTransposeMulVectorBound state).length + +def machineRationalMatrixMulVectorAdvance + (state : List Bool) : List Bool := + machineRationalTransposeMulVectorPack + (machineListTail (machineRationalTransposeMulVectorRemaining state)) + (machineRationalMatrixMulVectorNextAccumulator state) + (machineRationalTransposeMulVectorStatePayload state) + (machineRationalTransposeMulVectorBound state) + +def machineRationalMatrixMulVectorStep + (state : List Bool) : List Bool := + machineIfEmpty (machineRationalTransposeMulVectorRemaining state) state + (machineRationalMatrixMulVectorAdvance state) + +def machineRationalMatrixMulVectorInit (word : List Bool) : List Bool := + machineRationalTransposeMulVectorInit word + +def machineRationalMatrixMulVectorWidth (word : List Bool) : List Bool := + machineRationalTransposeMulVectorWidth word + +def machineRationalMatrixMulVectorFinalState + (word : List Bool) : List Bool := + (machineRationalMatrixMulVectorStep)^[word.length] + (machineRationalMatrixMulVectorInit word) + +def machineRationalMatrixMulVectorReversedCode + (word : List Bool) : List Bool := + machineRationalTransposeMulVectorAccumulator + (machineRationalMatrixMulVectorFinalState word) + +def machineRationalMatrixMulVectorCode + (word : List Bool) : List Bool := + machineListReverse (machineRationalMatrixMulVectorReversedCode word) + +theorem machineRationalMatrixMulVectorCurrentEntry_mem_FP : + machineRationalMatrixMulVectorCurrentEntry ∈ FP := by + have hp := machinePair_mem_FP + machineRationalTransposeMulVectorCurrentIndex_mem_FP + machineRationalTransposeMulVectorStatePayload_mem_FP + simpa only [machineRationalMatrixMulVectorCurrentEntry] using + machineCompose_mem_FP hp + machineRationalMatrixMulVectorEntryCode_mem_FP + +theorem machineRationalMatrixMulVectorCandidate_mem_FP : + machineRationalMatrixMulVectorCandidate ∈ FP := + machinePair_mem_FP machineRationalMatrixMulVectorCurrentEntry_mem_FP + machineRationalTransposeMulVectorAccumulator_mem_FP + +theorem machineRationalMatrixMulVectorNextAccumulator_mem_FP : + machineRationalMatrixMulVectorNextAccumulator ∈ FP := by + simpa only [machineRationalMatrixMulVectorNextAccumulator] using + machineTake_mem_FP machineRationalTransposeMulVectorBound_mem_FP + machineRationalMatrixMulVectorCandidate_mem_FP + +theorem machineRationalMatrixMulVectorAdvance_mem_FP : + machineRationalMatrixMulVectorAdvance ∈ FP := by + have htail := machineCompose_mem_FP + machineRationalTransposeMulVectorRemaining_mem_FP machineListTail_mem_FP + exact machinePair_mem_FP htail + (machinePair_mem_FP machineRationalMatrixMulVectorNextAccumulator_mem_FP + (machinePair_mem_FP + machineRationalTransposeMulVectorStatePayload_mem_FP + machineRationalTransposeMulVectorBound_mem_FP)) + +theorem machineRationalMatrixMulVectorStep_mem_FP : + machineRationalMatrixMulVectorStep ∈ FP := + machineIfEmpty_mem_FP machineRationalTransposeMulVectorRemaining_mem_FP + id_mem_FP machineRationalMatrixMulVectorAdvance_mem_FP + +theorem machineRationalMatrixMulVectorInit_mem_FP : + machineRationalMatrixMulVectorInit ∈ FP := + machineRationalTransposeMulVectorInit_mem_FP + +theorem machineRationalMatrixMulVectorWidth_mem_FP : + machineRationalMatrixMulVectorWidth ∈ FP := + machineRationalTransposeMulVectorWidth_mem_FP + +theorem machineRationalMatrixMulVectorStep_bound {word state : List Bool} + (hs : MachineRationalTransposeMulVectorStateBound word state) : + MachineRationalTransposeMulVectorStateBound word + (machineRationalMatrixMulVectorStep state) := by + dsimp only [MachineRationalTransposeMulVectorStateBound] at hs ⊢ + rcases hs with ⟨hdecomp, hremaining, hacc, hpayload, hbound⟩ + by_cases hnil : machineRationalTransposeMulVectorRemaining state = [] + · rw [machineRationalMatrixMulVectorStep, hnil, machineIfEmpty_nil] + exact ⟨hdecomp, hremaining, hacc, hpayload, hbound⟩ + · cases hcode : machineRationalTransposeMulVectorRemaining state with + | nil => exact False.elim (hnil hcode) + | cons bit tail => + rw [machineRationalMatrixMulVectorStep, hcode, + machineIfEmpty_cons, machineRationalMatrixMulVectorAdvance] + simp only [machineRationalTransposeMulVectorRemaining_pack, + machineRationalTransposeMulVectorAccumulator_pack, + machineRationalTransposeMulVectorStatePayload_pack, + machineRationalTransposeMulVectorBound_pack] + refine ⟨trivial, ?_, ?_, hpayload, hbound⟩ + · exact (machineListTail_length_le + (machineRationalTransposeMulVectorRemaining state)).trans + hremaining + · rw [machineRationalMatrixMulVectorNextAccumulator, hbound] + exact List.length_take_le _ _ + +theorem machineRationalMatrixMulVectorIterate_bound + (word : List Bool) : ∀ k, + MachineRationalTransposeMulVectorStateBound word + ((machineRationalMatrixMulVectorStep)^[k] + (machineRationalMatrixMulVectorInit word)) := by + intro k + induction k with + | zero => + simpa only [machineRationalMatrixMulVectorInit] using + machineRationalTransposeMulVectorInit_bound word + | succ k ih => + rw [Function.iterate_succ_apply'] + exact machineRationalMatrixMulVectorStep_bound ih + +theorem machineRationalMatrixMulVectorIterate_length_le_width + (word : List Bool) (iterations : ℕ) + (_ : iterations ≤ word.length) : + ((machineRationalMatrixMulVectorStep)^[iterations] + (machineRationalMatrixMulVectorInit word)).length ≤ + (machineRationalMatrixMulVectorWidth word).length := by + rcases machineRationalMatrixMulVectorIterate_bound word iterations with + ⟨hdecomp, hremaining, hacc, hpayload, hbound⟩ + rw [hdecomp, hbound] + simp only [machineRationalTransposeMulVectorPack, + machineRationalMatrixMulVectorWidth, + machineRationalTransposeMulVectorWidth, pair_length] + omega + +theorem machineRationalMatrixMulVectorFinalState_mem_FP : + machineRationalMatrixMulVectorFinalState ∈ FP := by + exact Cobham.iterate_mem_FP machineRationalMatrixMulVectorStep_mem_FP + machineRationalMatrixMulVectorInit_mem_FP id_mem_FP + machineRationalMatrixMulVectorWidth_mem_FP + machineRationalMatrixMulVectorIterate_length_le_width + +theorem machineRationalMatrixMulVectorReversedCode_mem_FP : + machineRationalMatrixMulVectorReversedCode ∈ FP := by + simpa only [machineRationalMatrixMulVectorReversedCode] using + machineCompose_mem_FP machineRationalMatrixMulVectorFinalState_mem_FP + machineRationalTransposeMulVectorAccumulator_mem_FP + +theorem machineRationalMatrixMulVectorCode_mem_FP : + machineRationalMatrixMulVectorCode ∈ FP := by + simpa only [machineRationalMatrixMulVectorCode] using + machineCompose_mem_FP + machineRationalMatrixMulVectorReversedCode_mem_FP + machineListReverse_mem_FP + +/-! ## Exact iteration semantics -/ + +def rationalMatrixMulVectorPrefix {d : ℕ} + (A : Matrix (Fin d) (Fin d) ℚ) (v : Fin d → ℚ) + (k : ℕ) : List ℚ := + ((List.finRange d).take k).map + fun i ↦ rationalMatrixMulVector A v i + +def machineRationalMatrixMulVectorSemanticState {d : ℕ} + (A : Matrix (Fin d) (Fin d) ℚ) (v : Fin d → ℚ) + (k : ℕ) : List Bool := + let word := rationalMatrixMulVectorCanonicalWord A v + machineRationalTransposeMulVectorPack + (binaryListCode finUnaryCode ((List.finRange d).drop k)) + (binaryListCode rationalEntryBinaryCode + (rationalMatrixMulVectorPrefix A v k).reverse) + (pair (rationalSquareMatrixRowsCode A) + (rationalFiniteVectorCode v)) + (machineRationalMatrixMulVectorInputBound word) + +theorem machineRationalMatrixMulVectorInit_semantics {d : ℕ} + (A : Matrix (Fin d) (Fin d) ℚ) (v : Fin d → ℚ) : + machineRationalMatrixMulVectorInit + (rationalMatrixMulVectorCanonicalWord A v) = + machineRationalMatrixMulVectorSemanticState A v 0 := by + simp [machineRationalMatrixMulVectorInit, + machineRationalTransposeMulVectorInit, + machineRationalMatrixMulVectorSemanticState, + machineRationalTransposeMulVectorIndices, + machineRationalTransposeMulVectorDimension, + machineRationalTransposeMulVectorPayload, + rationalMatrixMulVectorCanonicalWord, + machineUnaryRangeCode_encode, finRangeUnaryCode, + rationalMatrixMulVectorPrefix, binaryListCode, + machineRationalMatrixMulVectorInputBound] + +theorem rationalMatrixMulVectorPrefix_succ {d : ℕ} + (A : Matrix (Fin d) (Fin d) ℚ) (v : Fin d → ℚ) + (k : ℕ) (hk : k < d) : + rationalMatrixMulVectorPrefix A v (k + 1) = + rationalMatrixMulVectorPrefix A v k ++ + [rationalMatrixMulVector A v ⟨k, hk⟩] := by + simp only [rationalMatrixMulVectorPrefix, List.map_take] + have hkm : k < (List.finRange d).length := by simpa + simpa [List.getElem_finRange] using + congrArg (List.map fun i ↦ rationalMatrixMulVector A v i) + (List.take_concat_get hkm).symm + +theorem machineRationalMatrixMulVectorStep_semantics {d : ℕ} + (A : Matrix (Fin d) (Fin d) ℚ) (v : Fin d → ℚ) + (k : ℕ) (hk : k < d) : + machineRationalMatrixMulVectorStep + (machineRationalMatrixMulVectorSemanticState A v k) = + machineRationalMatrixMulVectorSemanticState A v (k + 1) := by + let word := rationalMatrixMulVectorCanonicalWord A v + let i : Fin d := ⟨k, hk⟩ + have hdrop : + (List.finRange d).drop k = + i :: (List.finRange d).drop (k + 1) := by + convert List.drop_eq_getElem_cons + (show k < (List.finRange d).length by simpa) using 1 + simp [i, List.getElem_finRange] + have hprefix := rationalMatrixMulVectorPrefix_succ A v k hk + have hreverse : + (rationalMatrixMulVectorPrefix A v (k + 1)).reverse = + rationalMatrixMulVector A v i :: + (rationalMatrixMulVectorPrefix A v k).reverse := by + rw [hprefix, List.reverse_append] + simp [i] + have hcand : + (binaryListCode rationalEntryBinaryCode + (rationalMatrixMulVectorPrefix A v (k + 1)).reverse).length ≤ + (machineRationalMatrixMulVectorInputBound word).length := by + have hprefixBound := binaryListCode_take_reverse_length_le + rationalEntryBinaryCode + (List.ofFn (rationalMatrixMulVector A v)) (k + 1) + have hprefixEq : rationalMatrixMulVectorPrefix A v (k + 1) = + (List.ofFn (rationalMatrixMulVector A v)).take (k + 1) := by + apply List.ext_getElem + · simp [rationalMatrixMulVectorPrefix] + · intro r hrLeft hrRight + simp [rationalMatrixMulVectorPrefix, List.getElem_finRange] + rw [hprefixEq] + exact hprefixBound.trans + (rationalMatrixMulVector_code_length_le_bound A v) + have hcandPair : + (pair (rationalEntryBinaryCode + (rationalMatrixMulVector A v i)) + (binaryListCode rationalEntryBinaryCode + (rationalMatrixMulVectorPrefix A v k).reverse)).length ≤ + (machineRationalMatrixMulVectorInputBound word).length := by + simpa only [hreverse, binaryListCode] using hcand + have hnonempty : + binaryListCode finUnaryCode ((List.finRange d).drop k) ≠ [] := by + rw [hdrop] + exact binaryListCode_cons_ne_nil finUnaryCode i + ((List.finRange d).drop (k + 1)) + rw [machineRationalMatrixMulVectorStep] + simp only [machineRationalMatrixMulVectorSemanticState, + machineRationalTransposeMulVectorRemaining_pack] + rw [machineIfEmpty_of_ne_nil_matrix _ _ _ hnonempty, + machineRationalMatrixMulVectorAdvance] + simp only [machineRationalTransposeMulVectorRemaining_pack, + machineRationalTransposeMulVectorAccumulator_pack, + machineRationalTransposeMulVectorStatePayload_pack, + machineRationalTransposeMulVectorBound_pack, + machineRationalMatrixMulVectorNextAccumulator, + machineRationalMatrixMulVectorCandidate, + machineRationalMatrixMulVectorCurrentEntry, + machineRationalTransposeMulVectorCurrentIndex] + rw [hdrop, machineListHead_cons, machineListTail_cons] + change machineRationalTransposeMulVectorPack _ + ((pair (machineRationalMatrixMulVectorEntryCode + (pair (finUnaryCode i) + (pair (rationalSquareMatrixRowsCode A) + (rationalFiniteVectorCode v)))) + (binaryListCode rationalEntryBinaryCode + (rationalMatrixMulVectorPrefix A v k).reverse)).take + (machineRationalMatrixMulVectorInputBound word).length) _ _ = _ + rw [show finUnaryCode i = List.replicate i.1 true by rfl, + machineRationalMatrixMulVectorEntryCode_encode] + change machineRationalTransposeMulVectorPack _ + ((pair (rationalEntryBinaryCode + (rationalMatrixMulVector A v i)) + (binaryListCode rationalEntryBinaryCode + (rationalMatrixMulVectorPrefix A v k).reverse)).take + (machineRationalMatrixMulVectorInputBound word).length) _ _ = _ + rw [List.take_of_length_le hcandPair, hreverse] + rfl + +theorem machineRationalMatrixMulVectorIterate_semantics {d : ℕ} + (A : Matrix (Fin d) (Fin d) ℚ) (v : Fin d → ℚ) : ∀ k ≤ d, + (machineRationalMatrixMulVectorStep)^[k] + (machineRationalMatrixMulVectorInit + (rationalMatrixMulVectorCanonicalWord A v)) = + machineRationalMatrixMulVectorSemanticState A v k := by + intro k hk + induction k with + | zero => exact machineRationalMatrixMulVectorInit_semantics A v + | succ k ih => + rw [Function.iterate_succ_apply', ih (by omega)] + exact machineRationalMatrixMulVectorStep_semantics A v k (by omega) + +theorem machineRationalMatrixMulVector_done_iterate + (extra : ℕ) (accumulator payload bound : List Bool) : + (machineRationalMatrixMulVectorStep)^[extra] + (machineRationalTransposeMulVectorPack [] accumulator payload bound) = + machineRationalTransposeMulVectorPack [] accumulator payload bound := by + induction extra with + | zero => rfl + | succ k ih => + rw [Function.iterate_succ_apply', ih] + simp [machineRationalMatrixMulVectorStep] + +theorem rationalMatrixMulVectorPrefix_all {d : ℕ} + (A : Matrix (Fin d) (Fin d) ℚ) (v : Fin d → ℚ) : + rationalMatrixMulVectorPrefix A v d = + List.ofFn (rationalMatrixMulVector A v) := by + apply List.ext_getElem + · simp [rationalMatrixMulVectorPrefix] + · intro i hiLeft hiRight + simp [rationalMatrixMulVectorPrefix, List.getElem_finRange] + +theorem machineRationalMatrixMulVectorReversedCode_encode {d : ℕ} + (A : Matrix (Fin d) (Fin d) ℚ) (v : Fin d → ℚ) : + machineRationalMatrixMulVectorReversedCode + (rationalMatrixMulVectorCanonicalWord A v) = + binaryListCode rationalEntryBinaryCode + (List.ofFn (rationalMatrixMulVector A v)).reverse := by + let word := rationalMatrixMulVectorCanonicalWord A v + have hd : d ≤ word.length := by + have h := machinePairFirst_length_le word + simpa only [word, rationalMatrixMulVectorCanonicalWord, + machinePairFirst_pair, List.length_replicate] using h + have hsplit : word.length = (word.length - d) + d := by omega + change machineRationalMatrixMulVectorReversedCode word = _ + rw [machineRationalMatrixMulVectorReversedCode, + machineRationalMatrixMulVectorFinalState, hsplit, + Function.iterate_add_apply, + machineRationalMatrixMulVectorIterate_semantics A v d le_rfl] + simp only [machineRationalMatrixMulVectorSemanticState] + rw [show binaryListCode finUnaryCode ((List.finRange d).drop d) = [] by + rw [List.drop_eq_nil_of_le (by simp)] + rfl] + rw [machineRationalMatrixMulVector_done_iterate] + simp only [machineRationalTransposeMulVectorAccumulator_pack] + rw [rationalMatrixMulVectorPrefix_all] + +@[simp] theorem machineRationalMatrixMulVectorCode_encode {d : ℕ} + (A : Matrix (Fin d) (Fin d) ℚ) (v : Fin d → ℚ) : + machineRationalMatrixMulVectorCode + (rationalMatrixMulVectorCanonicalWord A v) = + rationalFiniteVectorCode (rationalMatrixMulVector A v) := by + rw [machineRationalMatrixMulVectorCode, + machineRationalMatrixMulVectorReversedCode_encode, + machineListReverse_encode, List.reverse_reverse] + rfl + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalMatrixUpdate.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalMatrixUpdate.lean new file mode 100644 index 0000000000..6f4c6acd0d --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalMatrixUpdate.lean @@ -0,0 +1,220 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineListUpdate +import Mathlib.Tactic + +/-! +# Mutable rational-matrix memory + +The input is `pair rowUnary (pair columnUnary (pair replacement matrixWord))`. +The replacement is already a canonical rational-entry code. The routine +updates the selected entry of the right-nested row-major matrix encoding and +preserves the original binary dimension word. +-/ + +namespace BeyondBethe + +open Complexity + +def machineRationalMatrixUpdateRow (word : List Bool) : List Bool := + machinePairFirst word + +def machineRationalMatrixUpdateRest (word : List Bool) : List Bool := + machinePairSecond word + +def machineRationalMatrixUpdateColumn (word : List Bool) : List Bool := + machinePairFirst (machineRationalMatrixUpdateRest word) + +def machineRationalMatrixUpdatePayload (word : List Bool) : List Bool := + machinePairSecond (machineRationalMatrixUpdateRest word) + +def machineRationalMatrixUpdateReplacement (word : List Bool) : List Bool := + machinePairFirst (machineRationalMatrixUpdatePayload word) + +def machineRationalMatrixUpdateMatrix (word : List Bool) : List Bool := + machinePairSecond (machineRationalMatrixUpdatePayload word) + +def machineRationalMatrixUpdateRows (word : List Bool) : List Bool := + machineMatrixRowsWord (machineRationalMatrixUpdateMatrix word) + +def machineRationalMatrixUpdateCurrentRow (word : List Bool) : List Bool := + machineListIndex + (pair (machineRationalMatrixUpdateRow word) + (machineRationalMatrixUpdateRows word)) + +def machineRationalMatrixUpdateNewRow (word : List Bool) : List Bool := + machineListUpdate + (pair (machineRationalMatrixUpdateColumn word) + (pair (machineRationalMatrixUpdateReplacement word) + (machineRationalMatrixUpdateCurrentRow word))) + +def machineRationalMatrixUpdateNewRows (word : List Bool) : List Bool := + machineListUpdate + (pair (machineRationalMatrixUpdateRow word) + (pair (machineRationalMatrixUpdateNewRow word) + (machineRationalMatrixUpdateRows word))) + +def machineRationalMatrixUpdateAtUnary (word : List Bool) : List Bool := + pair (machineMatrixDimensionWord (machineRationalMatrixUpdateMatrix word)) + (machineRationalMatrixUpdateNewRows word) + +theorem machineRationalMatrixUpdateRow_mem_FP : + machineRationalMatrixUpdateRow ∈ Complexity.FP := + machinePairFirst_mem_FP + +theorem machineRationalMatrixUpdateRest_mem_FP : + machineRationalMatrixUpdateRest ∈ Complexity.FP := + machinePairSecond_mem_FP + +theorem machineRationalMatrixUpdateColumn_mem_FP : + machineRationalMatrixUpdateColumn ∈ Complexity.FP := by + simpa only [machineRationalMatrixUpdateColumn] using + machineCompose_mem_FP machineRationalMatrixUpdateRest_mem_FP + machinePairFirst_mem_FP + +theorem machineRationalMatrixUpdatePayload_mem_FP : + machineRationalMatrixUpdatePayload ∈ Complexity.FP := by + simpa only [machineRationalMatrixUpdatePayload] using + machineCompose_mem_FP machineRationalMatrixUpdateRest_mem_FP + machinePairSecond_mem_FP + +theorem machineRationalMatrixUpdateReplacement_mem_FP : + machineRationalMatrixUpdateReplacement ∈ Complexity.FP := by + simpa only [machineRationalMatrixUpdateReplacement] using + machineCompose_mem_FP machineRationalMatrixUpdatePayload_mem_FP + machinePairFirst_mem_FP + +theorem machineRationalMatrixUpdateMatrix_mem_FP : + machineRationalMatrixUpdateMatrix ∈ Complexity.FP := by + simpa only [machineRationalMatrixUpdateMatrix] using + machineCompose_mem_FP machineRationalMatrixUpdatePayload_mem_FP + machinePairSecond_mem_FP + +theorem machineRationalMatrixUpdateRows_mem_FP : + machineRationalMatrixUpdateRows ∈ Complexity.FP := by + simpa only [machineRationalMatrixUpdateRows] using + machineCompose_mem_FP machineRationalMatrixUpdateMatrix_mem_FP + machineMatrixRowsWord_mem_FP + +theorem machineRationalMatrixUpdateCurrentRow_mem_FP : + machineRationalMatrixUpdateCurrentRow ∈ Complexity.FP := by + have hinput := machinePair_mem_FP machineRationalMatrixUpdateRow_mem_FP + machineRationalMatrixUpdateRows_mem_FP + simpa only [machineRationalMatrixUpdateCurrentRow] using + machineCompose_mem_FP hinput machineListIndex_mem_FP + +theorem machineRationalMatrixUpdateNewRow_mem_FP : + machineRationalMatrixUpdateNewRow ∈ Complexity.FP := by + have hpayload := machinePair_mem_FP + machineRationalMatrixUpdateReplacement_mem_FP + machineRationalMatrixUpdateCurrentRow_mem_FP + have hinput := machinePair_mem_FP machineRationalMatrixUpdateColumn_mem_FP + hpayload + simpa only [machineRationalMatrixUpdateNewRow] using + machineCompose_mem_FP hinput machineListUpdate_mem_FP + +theorem machineRationalMatrixUpdateNewRows_mem_FP : + machineRationalMatrixUpdateNewRows ∈ Complexity.FP := by + have hpayload := machinePair_mem_FP machineRationalMatrixUpdateNewRow_mem_FP + machineRationalMatrixUpdateRows_mem_FP + have hinput := machinePair_mem_FP machineRationalMatrixUpdateRow_mem_FP + hpayload + simpa only [machineRationalMatrixUpdateNewRows] using + machineCompose_mem_FP hinput machineListUpdate_mem_FP + +theorem machineRationalMatrixUpdateAtUnary_mem_FP : + machineRationalMatrixUpdateAtUnary ∈ Complexity.FP := by + have hdimension := machineCompose_mem_FP + machineRationalMatrixUpdateMatrix_mem_FP machineMatrixDimensionWord_mem_FP + exact machinePair_mem_FP hdimension + machineRationalMatrixUpdateNewRows_mem_FP + +/-! ## Exact semantics -/ + +def rationalRowsWord (dimension : List Bool) + (rows : List (List ℚ)) : List Bool := + pair dimension + (binaryListCode (binaryListCode rationalEntryBinaryCode) rows) + +@[simp] theorem machineMatrixDimensionWord_rationalRowsWord + (dimension : List Bool) (rows : List (List ℚ)) : + machineMatrixDimensionWord (rationalRowsWord dimension rows) = + dimension := by + simp [machineMatrixDimensionWord, rationalRowsWord] + +@[simp] theorem machineMatrixRowsWord_rationalRowsWord + (dimension : List Bool) (rows : List (List ℚ)) : + machineMatrixRowsWord (rationalRowsWord dimension rows) = + binaryListCode (binaryListCode rationalEntryBinaryCode) rows := by + simp [machineMatrixRowsWord, rationalRowsWord] + +@[simp] theorem machineRationalMatrixUpdateAtUnary_rows + (dimension : List Bool) (rows : List (List ℚ)) + (replacement : ℚ) (i j : ℕ) + (hi : i < rows.length) (hj : j < rows[i].length) : + machineRationalMatrixUpdateAtUnary + (pair (List.replicate i true) + (pair (List.replicate j true) + (pair (rationalEntryBinaryCode replacement) + (rationalRowsWord dimension rows)))) = + rationalRowsWord dimension + (rows.set i (rows[i].set j replacement)) := by + rw [machineRationalMatrixUpdateAtUnary] + simp only [machineRationalMatrixUpdateMatrix, + machineRationalMatrixUpdatePayload, machineRationalMatrixUpdateRest, + machineRationalMatrixUpdateRow, machineRationalMatrixUpdateColumn, + machineRationalMatrixUpdateReplacement, machinePairFirst_pair, + machinePairSecond_pair, machineMatrixDimensionWord_rationalRowsWord, + machineRationalMatrixUpdateNewRows, + machineRationalMatrixUpdateRows, + machineMatrixRowsWord_rationalRowsWord, + machineRationalMatrixUpdateNewRow, + machineRationalMatrixUpdateCurrentRow] + rw [machineListIndex_binaryListCode + (binaryListCode rationalEntryBinaryCode) rows i hi] + change pair dimension + (machineListUpdate + (pair (List.replicate i true) + (pair + (machineListUpdate + (machineListUpdateCanonicalInput rationalEntryBinaryCode + rows[i] replacement j)) + (binaryListCode (binaryListCode rationalEntryBinaryCode) rows)))) = _ + rw [machineListUpdate_binaryListCode rationalEntryBinaryCode rows[i] + replacement j hj] + change pair dimension + (machineListUpdate + (machineListUpdateCanonicalInput + (binaryListCode rationalEntryBinaryCode) rows + (rows[i].set j replacement) i)) = _ + rw [machineListUpdate_binaryListCode + (binaryListCode rationalEntryBinaryCode) rows + (rows[i].set j replacement) i hi] + rfl + +@[simp] theorem machineRationalMatrixUpdateAtUnary_encode {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) (i j : Fin n) + (replacement : ℚ) : + machineRationalMatrixUpdateAtUnary + (pair (List.replicate i.1 true) + (pair (List.replicate j.1 true) + (pair (rationalEntryBinaryCode replacement) + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩)))) = + rationalRowsWord n.bits + ((rationalMatrixRows A).set i.1 + (((rationalMatrixRows A)[i.1]'(by simp [rationalMatrixRows])).set + j.1 replacement)) := by + change machineRationalMatrixUpdateAtUnary + (pair (List.replicate i.1 true) + (pair (List.replicate j.1 true) + (pair (rationalEntryBinaryCode replacement) + (rationalRowsWord n.bits (rationalMatrixRows A))))) = _ + exact machineRationalMatrixUpdateAtUnary_rows n.bits + (rationalMatrixRows A) replacement i.1 j.1 + (by simp [rationalMatrixRows]) (by simp [rationalMatrixRows]) + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalMin.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalMin.lean new file mode 100644 index 0000000000..3e712e20f7 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalMin.lean @@ -0,0 +1,60 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalCompare +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalNormalization + +/-! +# Exact finite-word minimum of two rationals + +The input is the pair of two raw-rational words. We compare their values and +return one of the original words; the public version then normalizes the +selected fraction. This is the minimum operation used in the rational +smoothing level. +-/ + +namespace BeyondBethe + +open Complexity + +def machineRawRatMinCode (word : List Bool) : List Bool := + machineIfHead (machineRawRatLeBit word) + (machinePairFirst word) (machinePairSecond word) + +def machineRationalMinCode (word : List Bool) : List Bool := + machineNormalizeRawRatBinaryCode (machineRawRatMinCode word) + +theorem machineRawRatMinCode_mem_FP : + machineRawRatMinCode ∈ Complexity.FP := by + exact machineIfHead_mem_FP machineRawRatLeBit_mem_FP + machinePairFirst_mem_FP machinePairSecond_mem_FP + +theorem machineRationalMinCode_mem_FP : + machineRationalMinCode ∈ Complexity.FP := by + simpa only [machineRationalMinCode] using + machineCompose_mem_FP machineRawRatMinCode_mem_FP + machineNormalizeRawRatBinaryCode_mem_FP + +@[simp] theorem machineRawRatMinCode_encode (q r : RawRat) : + machineRawRatMinCode + (pair (rawRatBinaryCode q) (rawRatBinaryCode r)) = + rawRatBinaryCode (if q.value ≤ r.value then q else r) := by + rw [machineRawRatMinCode, machineRawRatLeBit_encode] + by_cases h : q.value ≤ r.value <;> simp [h] + +@[simp] theorem machineRationalMinCode_encode (q r : RawRat) : + machineRationalMinCode + (pair (rawRatBinaryCode q) (rawRatBinaryCode r)) = + rationalBinaryCode (min q.value r.value) := by + rw [machineRationalMinCode, machineRawRatMinCode_encode] + by_cases h : q.value ≤ r.value + · rw [if_pos h, machineNormalizeRawRatBinaryCode_encode, + binaryNormalizeRawRat_eq_value, min_eq_left h] + · have hrq : r.value ≤ q.value := le_of_not_ge h + rw [if_neg h, machineNormalizeRawRatBinaryCode_encode, + binaryNormalizeRawRat_eq_value, min_eq_right hrq] + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalNormalization.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalNormalization.lean new file mode 100644 index 0000000000..52832fd7fc --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalNormalization.lean @@ -0,0 +1,173 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineIntegerSignedMagnitude + +/-! +# Polynomial-time normalization of unreduced rationals + +An unreduced signed fraction is encoded as the pair of its +`integerBinaryCode` numerator and ordinary denominator bits. The machine +computes the absolute numerator, their gcd, both exact quotients, restores the +integer sign, and finally applies the public rational encoder. +-/ + +namespace BeyondBethe + +open Complexity + +def rawRatBinaryCode (q : RawRat) : List Bool := + pair (integerBinaryCode q.num) q.den.bits + +def machineRawRatNatAbsBits (word : List Bool) : List Bool := + machineIntegerNatAbsBits (machinePairFirst word) + +def machineRawRatGcdBits (word : List Bool) : List Bool := + machineBinaryGcdBits + (pair (machineRawRatNatAbsBits word) (machinePairSecond word)) + +def machineRawRatAbsQuotientBits (word : List Bool) : List Bool := + machinePairFirst + (machineBinaryDivModBits + (pair (machineRawRatNatAbsBits word) (machineRawRatGcdBits word))) + +def machineRawRatDenQuotientBits (word : List Bool) : List Bool := + machinePairFirst + (machineBinaryDivModBits + (pair (machinePairSecond word) (machineRawRatGcdBits word))) + +def machineNormalizeRawRatEntryCode (word : List Bool) : List Bool := + pair + (machineIntegerCodeFromSignedAbs + (pair (machinePairFirst word) (machineRawRatAbsQuotientBits word))) + (machineRawRatDenQuotientBits word) + +/-- Public canonical rational output bits. -/ +def machineNormalizeRawRatBinaryCode (word : List Bool) : List Bool := + machineRationalBinaryCode (machineNormalizeRawRatEntryCode word) + +theorem machineRawRatNatAbsBits_mem_FP : + machineRawRatNatAbsBits ∈ Complexity.FP := by + simpa only [machineRawRatNatAbsBits] using + machineCompose_mem_FP machinePairFirst_mem_FP + machineIntegerNatAbsBits_mem_FP + +theorem machineRawRatGcdBits_mem_FP : + machineRawRatGcdBits ∈ Complexity.FP := by + have hpair : (fun word => pair (machineRawRatNatAbsBits word) + (machinePairSecond word)) ∈ Complexity.FP := + machinePair_mem_FP machineRawRatNatAbsBits_mem_FP + machinePairSecond_mem_FP + simpa only [machineRawRatGcdBits] using + machineCompose_mem_FP hpair machineBinaryGcdBits_mem_FP + +theorem machineRawRatAbsQuotientBits_mem_FP : + machineRawRatAbsQuotientBits ∈ Complexity.FP := by + have hpair : (fun word => pair (machineRawRatNatAbsBits word) + (machineRawRatGcdBits word)) ∈ Complexity.FP := + machinePair_mem_FP machineRawRatNatAbsBits_mem_FP + machineRawRatGcdBits_mem_FP + have hdiv := machineCompose_mem_FP hpair machineBinaryDivModBits_mem_FP + simpa only [machineRawRatAbsQuotientBits] using + machineCompose_mem_FP hdiv machinePairFirst_mem_FP + +theorem machineRawRatDenQuotientBits_mem_FP : + machineRawRatDenQuotientBits ∈ Complexity.FP := by + have hpair : (fun word => pair (machinePairSecond word) + (machineRawRatGcdBits word)) ∈ Complexity.FP := + machinePair_mem_FP machinePairSecond_mem_FP machineRawRatGcdBits_mem_FP + have hdiv := machineCompose_mem_FP hpair machineBinaryDivModBits_mem_FP + simpa only [machineRawRatDenQuotientBits] using + machineCompose_mem_FP hdiv machinePairFirst_mem_FP + +theorem machineNormalizeRawRatEntryCode_mem_FP : + machineNormalizeRawRatEntryCode ∈ Complexity.FP := by + have hsignedPair : (fun word => pair (machinePairFirst word) + (machineRawRatAbsQuotientBits word)) ∈ Complexity.FP := + machinePair_mem_FP machinePairFirst_mem_FP + machineRawRatAbsQuotientBits_mem_FP + have hsigned := machineCompose_mem_FP hsignedPair + machineIntegerCodeFromSignedAbs_mem_FP + simpa only [machineNormalizeRawRatEntryCode] using + machinePair_mem_FP hsigned machineRawRatDenQuotientBits_mem_FP + +theorem machineNormalizeRawRatBinaryCode_mem_FP : + machineNormalizeRawRatBinaryCode ∈ Complexity.FP := by + simpa only [machineNormalizeRawRatBinaryCode] using + machineCompose_mem_FP machineNormalizeRawRatEntryCode_mem_FP + machineRationalBinaryCode_mem_FP + +theorem machineRawRatNatAbsBits_encode (q : RawRat) : + machineRawRatNatAbsBits (rawRatBinaryCode q) = q.num.natAbs.bits := by + simp [machineRawRatNatAbsBits, rawRatBinaryCode, + machineIntegerNatAbsBits_encode] + +theorem machineRawRatGcdBits_encode (q : RawRat) : + machineRawRatGcdBits (rawRatBinaryCode q) = + (Nat.gcd q.num.natAbs q.den).bits := by + rw [machineRawRatGcdBits, machineRawRatNatAbsBits_encode] + simp only [rawRatBinaryCode, machinePairSecond_pair] + rw [machineBinaryGcdBits_pair_natBits] + +theorem machineRawRatAbsQuotientBits_encode (q : RawRat) : + machineRawRatAbsQuotientBits (rawRatBinaryCode q) = + (q.num.natAbs / Nat.gcd q.num.natAbs q.den).bits := by + rw [machineRawRatAbsQuotientBits] + rw [machineRawRatNatAbsBits_encode, machineRawRatGcdBits_encode, + machineBinaryDivModBits_pair_natBits] + simp only [machinePairFirst_pair] + +theorem machineRawRatDenQuotientBits_encode (q : RawRat) : + machineRawRatDenQuotientBits (rawRatBinaryCode q) = + (q.den / Nat.gcd q.num.natAbs q.den).bits := by + rw [machineRawRatDenQuotientBits] + simp only [rawRatBinaryCode, machinePairSecond_pair] + have hg : machineRawRatGcdBits + (pair (integerBinaryCode q.num) q.den.bits) = + (Nat.gcd q.num.natAbs q.den).bits := by + simpa only [rawRatBinaryCode] using machineRawRatGcdBits_encode q + rw [hg, machineBinaryDivModBits_pair_natBits] + simp only [machinePairFirst_pair] + +theorem machineNormalizeRawRatEntryCode_encode (q : RawRat) : + machineNormalizeRawRatEntryCode (rawRatBinaryCode q) = + rationalEntryBinaryCode (binaryNormalizeRawRat q) := by + let g := Nat.gcd q.num.natAbs q.den + have hgpos : 0 < g := Nat.gcd_pos_of_pos_right _ q.den_pos + have hgdvd : g ∣ q.num.natAbs := Nat.gcd_dvd_left _ _ + have hnum := machineIntegerCodeFromSignedAbs_div q.num g hgpos hgdvd + have hden : (binaryLongDiv q.den g).1 = q.den / g := by + simp [binaryLongDiv_eq_div_mod] + rw [machineNormalizeRawRatEntryCode] + simp only [rawRatBinaryCode, machinePairFirst_pair] + have habs : machineRawRatAbsQuotientBits + (pair (integerBinaryCode q.num) q.den.bits) = + (q.num.natAbs / Nat.gcd q.num.natAbs q.den).bits := by + simpa only [rawRatBinaryCode] using + machineRawRatAbsQuotientBits_encode q + have hdenq : machineRawRatDenQuotientBits + (pair (integerBinaryCode q.num) q.den.bits) = + (q.den / Nat.gcd q.num.natAbs q.den).bits := by + simpa only [rawRatBinaryCode] using + machineRawRatDenQuotientBits_encode q + rw [habs, hdenq] + change pair + (machineIntegerCodeFromSignedAbs + (pair (integerBinaryCode q.num) (q.num.natAbs / g).bits)) + (q.den / g).bits = _ + rw [hnum] + rw [← hden] + simp only [rationalEntryBinaryCode, binaryNormalizeRawRat] + rw [binaryEuclidBounded_eq_gcd] + +theorem machineNormalizeRawRatBinaryCode_encode (q : RawRat) : + machineNormalizeRawRatBinaryCode (rawRatBinaryCode q) = + rationalBinaryCode (binaryNormalizeRawRat q) := by + rw [machineNormalizeRawRatBinaryCode, + machineNormalizeRawRatEntryCode_encode, + machineRationalBinaryCode_encode] + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalNormalizedDirection.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalNormalizedDirection.lean new file mode 100644 index 0000000000..993731a221 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalNormalizedDirection.lean @@ -0,0 +1,68 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalEllipsoidScalars +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalRowDivide + +/-! +# Polynomial-time rational normalization of a cut direction + +The center update uses the vector `b / sum_i |b_i|`. The scalar is computed +by the verified `ℓ1` fold and is passed, still as an unreduced rational word, +to the verified row-division fold. Thus the composition performs no decoding +and no hidden field arithmetic. +-/ + +namespace BeyondBethe + +open Complexity + +def rationalNormalizedDirection {d : ℕ} + (b : Fin d → ℚ) : Fin d → ℚ := + fun i ↦ b i / cutL1Scale b + +def machineRationalNormalizedDirectionCode + (word : List Bool) : List Bool := + machineRationalRowDivide + (pair (machineRationalVectorL1RawCode word) word) + +theorem machineRationalNormalizedDirectionCode_mem_FP : + machineRationalNormalizedDirectionCode ∈ FP := by + have hinput := machinePair_mem_FP + machineRationalVectorL1RawCode_mem_FP id_mem_FP + simpa only [machineRationalNormalizedDirectionCode] using + machineCompose_mem_FP hinput machineRationalRowDivide_mem_FP + +theorem rationalRowDivideValues_l1_ofFn {d : ℕ} + (b : Fin d → ℚ) : + rationalRowDivideValues + (rawRatListL1Sum RawRat.zero (List.ofFn b)) (List.ofFn b) = + List.ofFn (rationalNormalizedDirection b) := by + rw [rationalRowDivideValues, List.map_ofFn] + apply congrArg List.ofFn + funext i + simp [rationalNormalizedDirection, binaryNormalizeRawRat_eq_value, + RawRat.value_div, rawRatOfRat_value, rawRatListL1Sum_ofFn_value, + cutL1Scale] + +@[simp] theorem machineRationalNormalizedDirectionCode_encode {d : ℕ} + (b : Fin d → ℚ) : + machineRationalNormalizedDirectionCode (rationalFiniteVectorCode b) = + rationalFiniteVectorCode (rationalNormalizedDirection b) := by + rw [machineRationalNormalizedDirectionCode, + machineRationalVectorL1RawCode_encode] + change machineRationalRowDivide + (machineRationalRowDivideCanonicalInput + (rawRatListL1Sum RawRat.zero (List.ofFn b)) (List.ofFn b)) = _ + rw [machineRationalRowDivide_encode, + rationalRowDivideValues_l1_ofFn] + rfl + +theorem rationalNormalizedDirection_apply {d : ℕ} + (b : Fin d → ℚ) (i : Fin d) : + rationalNormalizedDirection b i = b i / cutL1Scale b := rfl + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalPower.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalPower.lean new file mode 100644 index 0000000000..0cbd2e1992 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalPower.lean @@ -0,0 +1,350 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalUnary + +/-! +# A bounded polynomial-time rational power loop + +The exponent is a unary ruler. Each state also retains a quadratic-width +clamp computed from the original input. The clamp makes the total machine +polynomial-time even on malformed strings; a separate bit-growth proof shows +that it never truncates a well-formed unreduced power. +-/ + +namespace BeyondBethe + +open Complexity + +def rawRatOneCode : List Bool := rawRatBinaryCode RawRat.one + +def machineRawRatPowerPack (acc base bound : List Bool) : List Bool := + pair acc (pair base bound) + +def machineRawRatPowerAccField (state : List Bool) : List Bool := + machinePairFirst state + +def machineRawRatPowerBaseField (state : List Bool) : List Bool := + machinePairFirst (machinePairSecond state) + +def machineRawRatPowerBoundField (state : List Bool) : List Bool := + machinePairSecond (machinePairSecond state) + +def machineRawRatPowerCandidate (state : List Bool) : List Bool := + machineRawRatMulCode + (pair (machineRawRatPowerAccField state) + (machineRawRatPowerBaseField state)) + +def machineRawRatPowerNextAcc (state : List Bool) : List Bool := + (machineRawRatPowerCandidate state).take + (machineRawRatPowerBoundField state).length + +def machineRawRatPowerStep (state : List Bool) : List Bool := + machineRawRatPowerPack (machineRawRatPowerNextAcc state) + (machineRawRatPowerBaseField state) + (machineRawRatPowerBoundField state) + +def machineRawRatPowerInputRuler (word : List Bool) : List Bool := + machinePairFirst word + +def machineRawRatPowerInputBase (word : List Bool) : List Bool := + machinePairSecond word + +def machineRawRatPowerInputBound (word : List Bool) : List Bool := + let square := machineBinaryMulWidth word + square ++ (square ++ (square ++ square)) + +def machineRawRatPowerInit (word : List Bool) : List Bool := + machineRawRatPowerPack rawRatOneCode + (machineRawRatPowerInputBase word) + (machineRawRatPowerInputBound word) + +def machineRawRatPowerWidth (word : List Bool) : List Bool := + let bound := machineRawRatPowerInputBound word + machineRawRatPowerPack bound bound bound + +def machineRawRatPowerFinalState (word : List Bool) : List Bool := + (machineRawRatPowerStep)^[(machineRawRatPowerInputRuler word).length] + (machineRawRatPowerInit word) + +def machineRawRatPowerCode (word : List Bool) : List Bool := + machineRawRatPowerAccField (machineRawRatPowerFinalState word) + +def machineRationalPowerCode (word : List Bool) : List Bool := + machineNormalizeRawRatBinaryCode (machineRawRatPowerCode word) + +theorem machineRawRatPowerAccField_mem_FP : + machineRawRatPowerAccField ∈ Complexity.FP := machinePairFirst_mem_FP + +theorem machineRawRatPowerBaseField_mem_FP : + machineRawRatPowerBaseField ∈ Complexity.FP := by + simpa only [machineRawRatPowerBaseField] using + machineCompose_mem_FP machinePairSecond_mem_FP machinePairFirst_mem_FP + +theorem machineRawRatPowerBoundField_mem_FP : + machineRawRatPowerBoundField ∈ Complexity.FP := by + simpa only [machineRawRatPowerBoundField] using + machineCompose_mem_FP machinePairSecond_mem_FP machinePairSecond_mem_FP + +theorem machineRawRatPowerCandidate_mem_FP : + machineRawRatPowerCandidate ∈ Complexity.FP := by + have hpair := machinePair_mem_FP machineRawRatPowerAccField_mem_FP + machineRawRatPowerBaseField_mem_FP + simpa only [machineRawRatPowerCandidate] using + machineCompose_mem_FP hpair machineRawRatMulCode_mem_FP + +theorem machineRawRatPowerNextAcc_mem_FP : + machineRawRatPowerNextAcc ∈ Complexity.FP := by + simpa only [machineRawRatPowerNextAcc] using + machineTake_mem_FP machineRawRatPowerBoundField_mem_FP + machineRawRatPowerCandidate_mem_FP + +theorem machineRawRatPowerStep_mem_FP : + machineRawRatPowerStep ∈ Complexity.FP := by + exact machinePair_mem_FP machineRawRatPowerNextAcc_mem_FP + (machinePair_mem_FP machineRawRatPowerBaseField_mem_FP + machineRawRatPowerBoundField_mem_FP) + +theorem machineRawRatPowerInputRuler_mem_FP : + machineRawRatPowerInputRuler ∈ Complexity.FP := machinePairFirst_mem_FP + +theorem machineRawRatPowerInputBase_mem_FP : + machineRawRatPowerInputBase ∈ Complexity.FP := machinePairSecond_mem_FP + +theorem machineRawRatPowerInputBound_mem_FP : + machineRawRatPowerInputBound ∈ Complexity.FP := + by + have hdouble := machineAppend_mem_FP machineBinaryMulWidth_mem_FP + machineBinaryMulWidth_mem_FP + have htriple := machineAppend_mem_FP machineBinaryMulWidth_mem_FP hdouble + have hquadruple := machineAppend_mem_FP machineBinaryMulWidth_mem_FP htriple + simpa only [machineRawRatPowerInputBound] using + hquadruple + +theorem machineRawRatPowerInit_mem_FP : + machineRawRatPowerInit ∈ Complexity.FP := by + exact machinePair_mem_FP (machineConst_mem_FP rawRatOneCode) + (machinePair_mem_FP machineRawRatPowerInputBase_mem_FP + machineRawRatPowerInputBound_mem_FP) + +theorem machineRawRatPowerWidth_mem_FP : + machineRawRatPowerWidth ∈ Complexity.FP := by + exact machinePair_mem_FP machineRawRatPowerInputBound_mem_FP + (machinePair_mem_FP machineRawRatPowerInputBound_mem_FP + machineRawRatPowerInputBound_mem_FP) + +@[simp] theorem machineRawRatPowerAccField_pack (acc base bound) : + machineRawRatPowerAccField (machineRawRatPowerPack acc base bound) = acc := by + simp [machineRawRatPowerAccField, machineRawRatPowerPack] + +@[simp] theorem machineRawRatPowerBaseField_pack (acc base bound) : + machineRawRatPowerBaseField (machineRawRatPowerPack acc base bound) = base := by + simp [machineRawRatPowerBaseField, machineRawRatPowerPack] + +@[simp] theorem machineRawRatPowerBoundField_pack (acc base bound) : + machineRawRatPowerBoundField (machineRawRatPowerPack acc base bound) = bound := by + simp [machineRawRatPowerBoundField, machineRawRatPowerPack] + +/-- Total clamped accumulator used to prove the machine's arbitrary-input +length bound. -/ +def clampedRawRatPowerAcc (word : List Bool) : ℕ → List Bool + | 0 => rawRatOneCode + | k + 1 => + (machineRawRatMulCode + (pair (clampedRawRatPowerAcc word k) + (machineRawRatPowerInputBase word))).take + (machineRawRatPowerInputBound word).length + +theorem machineRawRatPowerStep_semantics (word : List Bool) (k : ℕ) : + machineRawRatPowerStep + (machineRawRatPowerPack (clampedRawRatPowerAcc word k) + (machineRawRatPowerInputBase word) + (machineRawRatPowerInputBound word)) = + machineRawRatPowerPack (clampedRawRatPowerAcc word (k + 1)) + (machineRawRatPowerInputBase word) + (machineRawRatPowerInputBound word) := by + simp [machineRawRatPowerStep, machineRawRatPowerNextAcc, + machineRawRatPowerCandidate, clampedRawRatPowerAcc] + +theorem machineRawRatPowerIterate_semantics (word : List Bool) : ∀ k, + (machineRawRatPowerStep)^[k] (machineRawRatPowerInit word) = + machineRawRatPowerPack (clampedRawRatPowerAcc word k) + (machineRawRatPowerInputBase word) + (machineRawRatPowerInputBound word) := by + intro k + induction k with + | zero => rfl + | succ k ih => + rw [Function.iterate_succ_apply', ih, + machineRawRatPowerStep_semantics] + +theorem machineRawRatPowerInputBase_length_le_bound (word : List Bool) : + (machineRawRatPowerInputBase word).length ≤ + (machineRawRatPowerInputBound word).length := by + have hbase := machinePairSecond_length_le word + simp only [machineRawRatPowerInputBase, machineRawRatPowerInputBound, + machineBinaryMulWidth, List.length_replicate, List.length_append] + nlinarith + +theorem clampedRawRatPowerAcc_length_le_bound (word : List Bool) : ∀ k, + (clampedRawRatPowerAcc word k).length ≤ + (machineRawRatPowerInputBound word).length := by + intro k + cases k with + | zero => + simp [clampedRawRatPowerAcc, rawRatOneCode, rawRatBinaryCode, + RawRat.one, integerBinaryCode, machineRawRatPowerInputBound, + machineBinaryMulWidth] + nlinarith + | succ k => + simp only [clampedRawRatPowerAcc] + apply List.length_take_le + +theorem machineRawRatPowerIterate_length_le_width + (word : List Bool) (iterations : ℕ) + (_ : iterations ≤ (machineRawRatPowerInputRuler word).length) : + ((machineRawRatPowerStep)^[iterations] + (machineRawRatPowerInit word)).length ≤ + (machineRawRatPowerWidth word).length := by + rw [machineRawRatPowerIterate_semantics] + simp only [machineRawRatPowerPack, machineRawRatPowerWidth, pair_length] + have hacc := clampedRawRatPowerAcc_length_le_bound word iterations + have hbase := machineRawRatPowerInputBase_length_le_bound word + omega + +theorem machineRawRatPowerFinalState_mem_FP : + machineRawRatPowerFinalState ∈ Complexity.FP := by + exact Cobham.iterate_mem_FP machineRawRatPowerStep_mem_FP + machineRawRatPowerInit_mem_FP machineRawRatPowerInputRuler_mem_FP + machineRawRatPowerWidth_mem_FP + machineRawRatPowerIterate_length_le_width + +theorem machineRawRatPowerCode_mem_FP : + machineRawRatPowerCode ∈ Complexity.FP := by + simpa only [machineRawRatPowerCode] using + machineCompose_mem_FP machineRawRatPowerFinalState_mem_FP + machineRawRatPowerAccField_mem_FP + +theorem machineRationalPowerCode_mem_FP : + machineRationalPowerCode ∈ Complexity.FP := by + simpa only [machineRationalPowerCode] using + machineCompose_mem_FP machineRawRatPowerCode_mem_FP + machineNormalizeRawRatBinaryCode_mem_FP + +private theorem integerNatAbs_size_le_code_length (z : ℤ) : + z.natAbs.size ≤ (integerBinaryCode z).length := by + cases z with + | ofNat n => + simp [integerBinaryCode, Nat.size_eq_bits_len] + | negSucc n => + have hs : (n + 1).size ≤ n.size + 1 := by + rw [Nat.size_le] + have hle : n + 1 ≤ 2 ^ n.size := + Nat.succ_le_iff.mpr (Nat.lt_size_self n) + have hlt : 2 ^ n.size < 2 ^ (n.size + 1) := by + rw [pow_succ] + have hpos : 0 < 2 ^ n.size := by positivity + omega + exact hle.trans_lt hlt + simpa [integerBinaryCode, Nat.size_eq_bits_len, + Nat.add_comm] using hs + +private theorem rawRatWidth_le_code_length (q : RawRat) : + rawRatWidth q ≤ (rawRatBinaryCode q).length := by + rw [rawRatWidth, rawRatBinaryCode, pair_length] + apply max_le + · have h := integerNatAbs_size_le_code_length q.num + omega + · rw [Nat.size_eq_bits_len] + omega + +private theorem rawRatBinaryCode_length_le_width (q : RawRat) : + (rawRatBinaryCode q).length ≤ 4 + 3 * rawRatWidth q := by + rw [rawRatBinaryCode, pair_length] + have hnum : (integerBinaryCode q.num).length ≤ + 1 + rawRatWidth q := by + cases hqnum : q.num with + | ofNat n => + simp only [integerBinaryCode, List.length_cons, + Nat.size_eq_bits_len] + have habs := rawRat_num_size_le_width q + simp only [hqnum, Int.natAbs_ofNat'] at habs + omega + | negSucc n => + simp only [integerBinaryCode, List.length_cons, + Nat.size_eq_bits_len] + have hsize : n.size ≤ (n + 1).size := + Nat.size_le_size (Nat.le_succ n) + have habs : (n + 1).size ≤ rawRatWidth q := by + simpa only [hqnum, Int.natAbs_negSucc] using + rawRat_num_size_le_width q + have hnwidth : n.size ≤ rawRatWidth q := hsize.trans habs + omega + have hden := rawRat_den_size_le_width q + have hdenBits : q.den.bits.length ≤ rawRatWidth q := by + rw [Nat.size_eq_bits_len] + exact hden + omega + +private theorem rawRatPowerCode_length_le_inputBound + (q : RawRat) (total k : ℕ) (hk : k ≤ total) : + (rawRatBinaryCode (q.pow k)).length ≤ + (machineRawRatPowerInputBound + (pair (List.replicate total true) (rawRatBinaryCode q))).length := by + let word := pair (List.replicate total true) (rawRatBinaryCode q) + have hcode := rawRatBinaryCode_length_le_width (q.pow k) + have hpow := RawRat.width_pow_le q k + have hqwidth := rawRatWidth_le_code_length q + have hraw : (rawRatBinaryCode q).length ≤ word.length := by + simp only [word, pair_length, List.length_replicate] + omega + have htotal : total ≤ word.length := by + simp only [word, pair_length, List.length_replicate] + omega + have hproduct : k * rawRatWidth q ≤ word.length * word.length := + Nat.mul_le_mul (hk.trans htotal) (hqwidth.trans hraw) + calc + (rawRatBinaryCode (q.pow k)).length + ≤ 4 + 3 * rawRatWidth (q.pow k) := hcode + _ ≤ 4 + 3 * (1 + k * rawRatWidth q) := by omega + _ ≤ 4 * ((16 + word.length) * (16 + word.length)) := by nlinarith + _ = (machineRawRatPowerInputBound word).length := by + simp [machineRawRatPowerInputBound, machineBinaryMulWidth] + ring + +theorem clampedRawRatPowerAcc_encode (q : RawRat) (total : ℕ) : + ∀ k ≤ total, + clampedRawRatPowerAcc + (pair (List.replicate total true) (rawRatBinaryCode q)) k = + rawRatBinaryCode (q.pow k) := by + intro k hk + induction k with + | zero => rfl + | succ k ih => + rw [clampedRawRatPowerAcc, ih (by omega)] + simp only [machineRawRatPowerInputBase, machinePairSecond_pair, + machineRawRatMulCode_encode] + exact (List.take_eq_self_iff _).2 + (rawRatPowerCode_length_le_inputBound q total (k + 1) hk) + +theorem machineRawRatPowerCode_encode (q : RawRat) (k : ℕ) : + machineRawRatPowerCode + (pair (List.replicate k true) (rawRatBinaryCode q)) = + rawRatBinaryCode (q.pow k) := by + simp only [machineRawRatPowerCode, machineRawRatPowerFinalState, + machineRawRatPowerInputRuler, machinePairFirst_pair, + List.length_replicate, machineRawRatPowerIterate_semantics, + machineRawRatPowerAccField_pack] + exact clampedRawRatPowerAcc_encode q k k le_rfl + +theorem machineRationalPowerCode_encode (q : RawRat) (k : ℕ) : + machineRationalPowerCode + (pair (List.replicate k true) (rawRatBinaryCode q)) = + rationalBinaryCode (binaryNormalizeRawRat (q.pow k)) := by + rw [machineRationalPowerCode, machineRawRatPowerCode_encode, + machineNormalizeRawRatBinaryCode_encode] + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalRowAdd.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalRowAdd.lean new file mode 100644 index 0000000000..fc76bb9d08 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalRowAdd.lean @@ -0,0 +1,639 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineListReverse +import LeanPool.BeyondBethe.BeyondBethe.MachineMatrixSum +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalArithmetic +import Mathlib.Tactic + +/-! +# Adding every entry of a rational row by one raw rational + +The input is `pair deltaRawCode rowCode`. Each output entry is normalized to +the numerator/denominator pair encoding required inside rational matrices. +This is deliberately not `machineRationalDivCode`, whose public output uses a +different one-natural encoding. +-/ + +namespace BeyondBethe + +open Complexity + +def machineRationalRowAddDelta (word : List Bool) : List Bool := + machinePairFirst word + +def machineRationalRowAddRow (word : List Bool) : List Bool := + machinePairSecond word + +def machineRationalRowAddPadTwo (word : List Bool) : List Bool := + word ++ word + +def machineRationalRowAddPadFour (word : List Bool) : List Bool := + machineRationalRowAddPadTwo word ++ machineRationalRowAddPadTwo word + +def machineRationalRowAddPadEight (word : List Bool) : List Bool := + machineRationalRowAddPadFour word ++ machineRationalRowAddPadFour word + +def machineRationalRowAddPadSixteen (word : List Bool) : List Bool := + machineRationalRowAddPadEight word ++ machineRationalRowAddPadEight word + +/-- A coefficient-adjusted quadratic envelope. Sixteen copies before the +standard square provide enough room for every normalized output entry without +the impractical quartic padding used by an earlier draft. -/ +def machineRationalRowAddInputBound (word : List Bool) : List Bool := + machineBinaryMulWidth (machineRationalRowAddPadSixteen word) + +def machineRationalRowAddPack + (remaining accumulator delta bound : List Bool) : List Bool := + pair remaining (pair accumulator (pair delta bound)) + +def machineRationalRowAddRemaining (state : List Bool) : List Bool := + machinePairFirst state + +def machineRationalRowAddAccumulator (state : List Bool) : List Bool := + machinePairFirst (machinePairSecond state) + +def machineRationalRowAddDeltaField (state : List Bool) : List Bool := + machinePairFirst (machinePairSecond (machinePairSecond state)) + +def machineRationalRowAddBound (state : List Bool) : List Bool := + machinePairSecond (machinePairSecond (machinePairSecond state)) + +def machineRationalRowAddRawEntry (state : List Bool) : List Bool := + machineRawRatAddCode + (pair (machineListHead (machineRationalRowAddRemaining state)) + (machineRationalRowAddDeltaField state)) + +def machineRationalRowAddEntry (state : List Bool) : List Bool := + machineNormalizeRawRatEntryCode + (machineRationalRowAddRawEntry state) + +def machineRationalRowAddCandidate (state : List Bool) : List Bool := + pair (machineRationalRowAddEntry state) + (machineRationalRowAddAccumulator state) + +def machineRationalRowAddNextAccumulator (state : List Bool) : List Bool := + (machineRationalRowAddCandidate state).take + (machineRationalRowAddBound state).length + +def machineRationalRowAddAdvance (state : List Bool) : List Bool := + machineRationalRowAddPack + (machineListTail (machineRationalRowAddRemaining state)) + (machineRationalRowAddNextAccumulator state) + (machineRationalRowAddDeltaField state) + (machineRationalRowAddBound state) + +def machineRationalRowAddStep (state : List Bool) : List Bool := + machineIfEmpty (machineRationalRowAddRemaining state) state + (machineRationalRowAddAdvance state) + +def machineRationalRowAddInit (word : List Bool) : List Bool := + machineRationalRowAddPack (machineRationalRowAddRow word) [] + (machineRationalRowAddDelta word) + (machineRationalRowAddInputBound word) + +def machineRationalRowAddWidth (word : List Bool) : List Bool := + let bound := machineRationalRowAddInputBound word + machineRationalRowAddPack word bound word bound + +def machineRationalRowAddFinalState (word : List Bool) : List Bool := + (machineRationalRowAddStep)^[word.length] + (machineRationalRowAddInit word) + +def machineRationalRowAdd (word : List Bool) : List Bool := + machineListReverse + (machineRationalRowAddAccumulator + (machineRationalRowAddFinalState word)) + +theorem machineRationalRowAddDelta_mem_FP : + machineRationalRowAddDelta ∈ Complexity.FP := + machinePairFirst_mem_FP + +theorem machineRationalRowAddRow_mem_FP : + machineRationalRowAddRow ∈ Complexity.FP := + machinePairSecond_mem_FP + +theorem machineRationalRowAddPadTwo_mem_FP : + machineRationalRowAddPadTwo ∈ Complexity.FP := + machineAppend_mem_FP id_mem_FP id_mem_FP + +theorem machineRationalRowAddPadFour_mem_FP : + machineRationalRowAddPadFour ∈ Complexity.FP := + machineAppend_mem_FP machineRationalRowAddPadTwo_mem_FP + machineRationalRowAddPadTwo_mem_FP + +theorem machineRationalRowAddPadEight_mem_FP : + machineRationalRowAddPadEight ∈ Complexity.FP := + machineAppend_mem_FP machineRationalRowAddPadFour_mem_FP + machineRationalRowAddPadFour_mem_FP + +theorem machineRationalRowAddPadSixteen_mem_FP : + machineRationalRowAddPadSixteen ∈ Complexity.FP := + machineAppend_mem_FP machineRationalRowAddPadEight_mem_FP + machineRationalRowAddPadEight_mem_FP + +theorem machineRationalRowAddInputBound_mem_FP : + machineRationalRowAddInputBound ∈ Complexity.FP := by + simpa only [machineRationalRowAddInputBound] using + machineCompose_mem_FP machineRationalRowAddPadSixteen_mem_FP + machineBinaryMulWidth_mem_FP + +theorem machineRationalRowAddPadSixteen_length (word : List Bool) : + (machineRationalRowAddPadSixteen word).length = 16 * word.length := by + simp only [machineRationalRowAddPadSixteen, + machineRationalRowAddPadEight, + machineRationalRowAddPadFour, + machineRationalRowAddPadTwo, List.length_append] + omega + +theorem machineRationalRowAddInputBound_length_mono + {left right : List Bool} (h : left.length ≤ right.length) : + (machineRationalRowAddInputBound left).length ≤ + (machineRationalRowAddInputBound right).length := by + apply machineBinaryMulWidth_length_mono + rw [machineRationalRowAddPadSixteen_length, + machineRationalRowAddPadSixteen_length] + exact Nat.mul_le_mul_left 16 h + +theorem machineRationalRowAddRemaining_mem_FP : + machineRationalRowAddRemaining ∈ Complexity.FP := + machinePairFirst_mem_FP + +theorem machineRationalRowAddAccumulator_mem_FP : + machineRationalRowAddAccumulator ∈ Complexity.FP := by + simpa only [machineRationalRowAddAccumulator] using + machineCompose_mem_FP machinePairSecond_mem_FP machinePairFirst_mem_FP + +theorem machineRationalRowAddDeltaField_mem_FP : + machineRationalRowAddDeltaField ∈ Complexity.FP := by + have htail := machineCompose_mem_FP machinePairSecond_mem_FP + machinePairSecond_mem_FP + simpa only [machineRationalRowAddDeltaField] using + machineCompose_mem_FP htail machinePairFirst_mem_FP + +theorem machineRationalRowAddBound_mem_FP : + machineRationalRowAddBound ∈ Complexity.FP := by + have htail := machineCompose_mem_FP machinePairSecond_mem_FP + machinePairSecond_mem_FP + simpa only [machineRationalRowAddBound] using + machineCompose_mem_FP htail machinePairSecond_mem_FP + +theorem machineRationalRowAddRawEntry_mem_FP : + machineRationalRowAddRawEntry ∈ Complexity.FP := by + have hhead := machineCompose_mem_FP machineRationalRowAddRemaining_mem_FP + machineListHead_mem_FP + have hinput := machinePair_mem_FP hhead + machineRationalRowAddDeltaField_mem_FP + simpa only [machineRationalRowAddRawEntry] using + machineCompose_mem_FP hinput machineRawRatAddCode_mem_FP + +theorem machineRationalRowAddEntry_mem_FP : + machineRationalRowAddEntry ∈ Complexity.FP := by + simpa only [machineRationalRowAddEntry] using + machineCompose_mem_FP machineRationalRowAddRawEntry_mem_FP + machineNormalizeRawRatEntryCode_mem_FP + +theorem machineRationalRowAddCandidate_mem_FP : + machineRationalRowAddCandidate ∈ Complexity.FP := + machinePair_mem_FP machineRationalRowAddEntry_mem_FP + machineRationalRowAddAccumulator_mem_FP + +theorem machineRationalRowAddNextAccumulator_mem_FP : + machineRationalRowAddNextAccumulator ∈ Complexity.FP := by + simpa only [machineRationalRowAddNextAccumulator] using + machineTake_mem_FP machineRationalRowAddBound_mem_FP + machineRationalRowAddCandidate_mem_FP + +theorem machineRationalRowAddAdvance_mem_FP : + machineRationalRowAddAdvance ∈ Complexity.FP := by + have htail := machineCompose_mem_FP machineRationalRowAddRemaining_mem_FP + machineListTail_mem_FP + exact machinePair_mem_FP htail + (machinePair_mem_FP machineRationalRowAddNextAccumulator_mem_FP + (machinePair_mem_FP machineRationalRowAddDeltaField_mem_FP + machineRationalRowAddBound_mem_FP)) + +theorem machineRationalRowAddStep_mem_FP : + machineRationalRowAddStep ∈ Complexity.FP := by + exact machineIfEmpty_mem_FP machineRationalRowAddRemaining_mem_FP + id_mem_FP machineRationalRowAddAdvance_mem_FP + +theorem machineRationalRowAddInit_mem_FP : + machineRationalRowAddInit ∈ Complexity.FP := by + exact machinePair_mem_FP machineRationalRowAddRow_mem_FP + (machinePair_mem_FP (machineConst_mem_FP []) + (machinePair_mem_FP machineRationalRowAddDelta_mem_FP + machineRationalRowAddInputBound_mem_FP)) + +theorem machineRationalRowAddWidth_mem_FP : + machineRationalRowAddWidth ∈ Complexity.FP := by + exact machinePair_mem_FP id_mem_FP + (machinePair_mem_FP machineRationalRowAddInputBound_mem_FP + (machinePair_mem_FP id_mem_FP + machineRationalRowAddInputBound_mem_FP)) + +@[simp] theorem machineRationalRowAddRemaining_pack (a b c d) : + machineRationalRowAddRemaining + (machineRationalRowAddPack a b c d) = a := by + simp [machineRationalRowAddRemaining, machineRationalRowAddPack] + +@[simp] theorem machineRationalRowAddAccumulator_pack (a b c d) : + machineRationalRowAddAccumulator + (machineRationalRowAddPack a b c d) = b := by + simp [machineRationalRowAddAccumulator, machineRationalRowAddPack] + +@[simp] theorem machineRationalRowAddDeltaField_pack (a b c d) : + machineRationalRowAddDeltaField + (machineRationalRowAddPack a b c d) = c := by + simp [machineRationalRowAddDeltaField, machineRationalRowAddPack] + +@[simp] theorem machineRationalRowAddBound_pack (a b c d) : + machineRationalRowAddBound + (machineRationalRowAddPack a b c d) = d := by + simp [machineRationalRowAddBound, machineRationalRowAddPack] + +def MachineRationalRowAddStateBound (word state : List Bool) : Prop := + state = machineRationalRowAddPack + (machineRationalRowAddRemaining state) + (machineRationalRowAddAccumulator state) + (machineRationalRowAddDeltaField state) + (machineRationalRowAddBound state) ∧ + (machineRationalRowAddRemaining state).length ≤ word.length ∧ + (machineRationalRowAddAccumulator state).length ≤ + (machineRationalRowAddInputBound word).length ∧ + (machineRationalRowAddDeltaField state).length ≤ word.length ∧ + machineRationalRowAddBound state = + machineRationalRowAddInputBound word + +theorem machineRationalRowAddInit_bound (word : List Bool) : + MachineRationalRowAddStateBound word + (machineRationalRowAddInit word) := by + simp only [MachineRationalRowAddStateBound, + machineRationalRowAddInit, + machineRationalRowAddRemaining_pack, + machineRationalRowAddAccumulator_pack, + machineRationalRowAddDeltaField_pack, + machineRationalRowAddBound_pack] + refine ⟨trivial, ?_, by simp, ?_, trivial⟩ + · simpa only [machineRationalRowAddRow] using + machinePairSecond_length_le word + · simpa only [machineRationalRowAddDelta] using + machinePairFirst_length_le word + +theorem machineRationalRowAddStep_bound {word state : List Bool} + (hstate : MachineRationalRowAddStateBound word state) : + MachineRationalRowAddStateBound word + (machineRationalRowAddStep state) := by + rcases hstate with + ⟨hdecomp, hremaining, haccumulator, hdelta, hbound⟩ + by_cases hnil : machineRationalRowAddRemaining state = [] + · rw [machineRationalRowAddStep, hnil, machineIfEmpty_nil] + exact ⟨hdecomp, hremaining, haccumulator, hdelta, hbound⟩ + · rw [machineRationalRowAddStep] + cases hremainingCode : machineRationalRowAddRemaining state with + | nil => exact False.elim (hnil hremainingCode) + | cons bit tail => + rw [machineIfEmpty_cons, machineRationalRowAddAdvance] + simp only [MachineRationalRowAddStateBound, + machineRationalRowAddRemaining_pack, + machineRationalRowAddAccumulator_pack, + machineRationalRowAddDeltaField_pack, + machineRationalRowAddBound_pack] + refine ⟨trivial, ?_, ?_, hdelta, hbound⟩ + · exact (machineListTail_length_le + (machineRationalRowAddRemaining state)).trans hremaining + · rw [machineRationalRowAddNextAccumulator, hbound] + exact List.length_take_le _ _ + +theorem machineRationalRowAddIterate_bound (word : List Bool) : ∀ k, + MachineRationalRowAddStateBound word + ((machineRationalRowAddStep)^[k] + (machineRationalRowAddInit word)) := by + intro k + induction k with + | zero => exact machineRationalRowAddInit_bound word + | succ k ih => + rw [Function.iterate_succ_apply'] + exact machineRationalRowAddStep_bound ih + +theorem machineRationalRowAddIterate_length_le_width + (word : List Bool) (iterations : ℕ) (_ : iterations ≤ word.length) : + ((machineRationalRowAddStep)^[iterations] + (machineRationalRowAddInit word)).length ≤ + (machineRationalRowAddWidth word).length := by + rcases machineRationalRowAddIterate_bound word iterations with + ⟨hdecomp, hremaining, haccumulator, hdelta, hbound⟩ + rw [hdecomp, hbound] + simp only [machineRationalRowAddPack, + machineRationalRowAddWidth, pair_length] + omega + +theorem machineRationalRowAddFinalState_mem_FP : + machineRationalRowAddFinalState ∈ Complexity.FP := by + exact Cobham.iterate_mem_FP machineRationalRowAddStep_mem_FP + machineRationalRowAddInit_mem_FP id_mem_FP + machineRationalRowAddWidth_mem_FP + machineRationalRowAddIterate_length_le_width + +theorem machineRationalRowAdd_mem_FP : + machineRationalRowAdd ∈ Complexity.FP := by + have hacc := machineCompose_mem_FP + machineRationalRowAddFinalState_mem_FP + machineRationalRowAddAccumulator_mem_FP + simpa only [machineRationalRowAdd] using + machineCompose_mem_FP hacc machineListReverse_mem_FP + +/-! ## Ordinary output-size estimate -/ + +private theorem natList_sum_le_length_mul {values : List ℕ} {bound : ℕ} + (h : ∀ value ∈ values, value ≤ bound) : + values.sum ≤ values.length * bound := by + induction values with + | nil => simp + | cons value values ih => + simp only [List.sum_cons, List.length_cons] + have hvalue := h value (by simp) + have htail : ∀ x ∈ values, x ≤ bound := by + intro x hx + exact h x (by simp [hx]) + have hi := ih htail + calc + value + values.sum ≤ bound + values.length * bound := + Nat.add_le_add hvalue hi + _ = (values.length + 1) * bound := by ring + +theorem machineRationalRowAdd_output_length_le_bound + (delta : RawRat) (row : List ℚ) : + let word := pair (rawRatBinaryCode delta) + (binaryListCode rationalEntryBinaryCode row) + let output := row.map fun q ↦ + binaryNormalizeRawRat ((rawRatOfRat q).add delta) + (binaryListCode rationalEntryBinaryCode output).length ≤ + (machineRationalRowAddInputBound word).length := by + dsimp only + let word := pair (rawRatBinaryCode delta) + (binaryListCode rationalEntryBinaryCode row) + have hdelta : rawRatWidth delta ≤ word.length := by + have hcomponent : (rawRatBinaryCode delta).length ≤ word.length := by + simpa only [word, machinePairFirst_pair] using + machinePairFirst_length_le word + exact (rawRatWidth_le_binaryCode_length delta).trans + hcomponent + have hrowLength : row.length ≤ word.length := by + have hcomponent : + (binaryListCode rationalEntryBinaryCode row).length ≤ + word.length := by + simpa only [word, machinePairSecond_pair] using + machinePairSecond_length_le word + exact (binaryListCode_listLength_le rationalEntryBinaryCode row).trans + hcomponent + have hentry : ∀ q ∈ row, + (rationalEntryBinaryCode + (binaryNormalizeRawRat ((rawRatOfRat q).add delta))).length ≤ + 100 + 72 * word.length := by + intro q hq + have hqCode := binaryListCode_element_length_le + rationalEntryBinaryCode hq + have hqWidth : rawRatWidth (rawRatOfRat q) ≤ word.length := by + have hentryCode : + (rawRatBinaryCode (rawRatOfRat q)).length ≤ + (binaryListCode rationalEntryBinaryCode row).length := by + simpa only [rawRatBinaryCode_rawRatOfRat] using hqCode + have hrowCode : + (binaryListCode rationalEntryBinaryCode row).length ≤ + word.length := by + simpa only [word, machinePairSecond_pair] using + machinePairSecond_length_le word + exact (rawRatWidth_le_binaryCode_length (rawRatOfRat q)).trans + (hentryCode.trans hrowCode) + have hdiv := rawRatWidth_add_le (rawRatOfRat q) delta + have hnormalize := + rationalEntryBinaryCode_binaryNormalizeRawRat_length_le + ((rawRatOfRat q).add delta) + omega + rw [binaryListCode_length_eq_sum] + have hterm : ∀ value ∈ + ((row.map fun q ↦ binaryNormalizeRawRat + ((rawRatOfRat q).add delta)).map + fun q ↦ 2 * (rationalEntryBinaryCode q).length + 2), + value ≤ 202 + 144 * word.length := by + simp only [List.map_map] + intro value hvalue + rw [List.mem_map] at hvalue + rcases hvalue with ⟨q, hq, rfl⟩ + have := hentry q hq + simp only [Function.comp_apply] + omega + have hsum := natList_sum_le_length_mul hterm + simp only [List.length_map] at hsum + have hpoly : + word.length * (202 + 144 * word.length) ≤ + (machineRationalRowAddInputBound word).length := by + simp only [machineRationalRowAddInputBound, + machineBinaryMulWidth, + List.length_replicate, List.length_append] + rw [machineRationalRowAddPadSixteen_length] + nlinarith [sq_nonneg word.length] + exact hsum.trans <| (Nat.mul_le_mul_right _ hrowLength).trans hpoly + +/-! ## Exact semantics -/ + +def rationalRowAddValues (delta : RawRat) (row : List ℚ) : List ℚ := + row.map fun q ↦ binaryNormalizeRawRat ((rawRatOfRat q).add delta) + +def machineRationalRowAddCanonicalInput + (delta : RawRat) (row : List ℚ) : List Bool := + pair (rawRatBinaryCode delta) + (binaryListCode rationalEntryBinaryCode row) + +def machineRationalRowAddSemanticState + (delta : RawRat) (row : List ℚ) (k : ℕ) : List Bool := + let output := rationalRowAddValues delta row + let word := machineRationalRowAddCanonicalInput delta row + machineRationalRowAddPack + (binaryListCode rationalEntryBinaryCode (row.drop k)) + (binaryListCode rationalEntryBinaryCode (output.take k).reverse) + (rawRatBinaryCode delta) + (machineRationalRowAddInputBound word) + +theorem machineRationalRowAddInit_semantics + (delta : RawRat) (row : List ℚ) : + machineRationalRowAddInit + (machineRationalRowAddCanonicalInput delta row) = + machineRationalRowAddSemanticState delta row 0 := by + simp [machineRationalRowAddInit, + machineRationalRowAddCanonicalInput, + machineRationalRowAddSemanticState, + machineRationalRowAddRow, machineRationalRowAddDelta, + binaryListCode] + +theorem machineRationalRowAddEntry_semantics + (delta : RawRat) (row : List ℚ) (k : ℕ) (hk : k < row.length) : + machineRationalRowAddEntry + (machineRationalRowAddSemanticState delta row k) = + rationalEntryBinaryCode + (binaryNormalizeRawRat ((rawRatOfRat row[k]).add delta)) := by + have hdrop := List.drop_eq_getElem_cons hk + rw [machineRationalRowAddEntry, + machineRationalRowAddRawEntry] + simp only [machineRationalRowAddSemanticState, + machineRationalRowAddRemaining_pack, + machineRationalRowAddDeltaField_pack, hdrop, + machineListHead_cons, ← rawRatBinaryCode_rawRatOfRat, + machineRawRatAddCode_encode, + machineNormalizeRawRatEntryCode_encode] + +theorem machineRationalRowAddStep_semantics + (delta : RawRat) (row : List ℚ) (k : ℕ) (hk : k < row.length) : + machineRationalRowAddStep + (machineRationalRowAddSemanticState delta row k) = + machineRationalRowAddSemanticState delta row (k + 1) := by + let output := rationalRowAddValues delta row + let word := machineRationalRowAddCanonicalInput delta row + have houtputLength : output.length = row.length := by + simp [output, rationalRowAddValues] + have hkoutput : k < output.length := by omega + have houtputGet : output[k] = + binaryNormalizeRawRat ((rawRatOfRat row[k]).add delta) := by + simp [output, rationalRowAddValues, List.getElem_map] + have hdrop := List.drop_eq_getElem_cons hk + have htake := List.take_concat_get hkoutput + have hprefix : (output.take (k + 1)).reverse = + output[k] :: (output.take k).reverse := by + rw [← htake] + simpa only [List.concat_eq_append] using + (List.reverse_concat (l := output.take k) (a := output[k])) + have hfullBound : + (binaryListCode rationalEntryBinaryCode output).length ≤ + (machineRationalRowAddInputBound word).length := by + simpa only [word, output, machineRationalRowAddCanonicalInput, + rationalRowAddValues] using + machineRationalRowAdd_output_length_le_bound delta row + have hprefixLength : + (binaryListCode rationalEntryBinaryCode + (output.take (k + 1)).reverse).length ≤ + (machineRationalRowAddInputBound word).length := + (binaryListCode_take_reverse_length_le rationalEntryBinaryCode + output (k + 1)).trans hfullBound + have htakeBound : + (binaryListCode rationalEntryBinaryCode + (output.take (k + 1)).reverse).take + (machineRationalRowAddInputBound word).length = + binaryListCode rationalEntryBinaryCode + (output.take (k + 1)).reverse := + List.take_of_length_le hprefixLength + have hnonempty : + binaryListCode rationalEntryBinaryCode (row.drop k) ≠ [] := by + rw [hdrop] + exact binaryListCode_cons_ne_nil _ _ _ + rw [machineRationalRowAddStep] + simp only [machineRationalRowAddSemanticState, + machineRationalRowAddRemaining_pack] + rw [machineIfEmpty_of_ne_nil _ _ _ hnonempty, + machineRationalRowAddAdvance] + simp only [machineRationalRowAddRemaining_pack, + machineRationalRowAddAccumulator_pack, + machineRationalRowAddDeltaField_pack, + machineRationalRowAddBound_pack, + machineRationalRowAddNextAccumulator, + machineRationalRowAddCandidate] + have hentry : + machineRationalRowAddEntry + (machineRationalRowAddPack + (binaryListCode rationalEntryBinaryCode (row.drop k)) + (binaryListCode rationalEntryBinaryCode + (output.take k).reverse) + (rawRatBinaryCode delta) + (machineRationalRowAddInputBound word)) = + rationalEntryBinaryCode output[k] := by + rw [houtputGet] + simpa only [machineRationalRowAddSemanticState, output, word] using + machineRationalRowAddEntry_semantics delta row k hk + rw [hentry] + rw [hdrop, machineListTail_cons] + change machineRationalRowAddPack + (binaryListCode rationalEntryBinaryCode (row.drop (k + 1))) + ((binaryListCode rationalEntryBinaryCode + (output[k] :: (output.take k).reverse)).take + (machineRationalRowAddInputBound word).length) + (rawRatBinaryCode delta) + (machineRationalRowAddInputBound word) = _ + rw [← hprefix, htakeBound] + +theorem machineRationalRowAddIterate_semantics + (delta : RawRat) (row : List ℚ) : ∀ k ≤ row.length, + (machineRationalRowAddStep)^[k] + (machineRationalRowAddInit + (machineRationalRowAddCanonicalInput delta row)) = + machineRationalRowAddSemanticState delta row k := by + intro k hk + induction k with + | zero => exact machineRationalRowAddInit_semantics delta row + | succ k ih => + rw [Function.iterate_succ_apply', ih (by omega)] + exact machineRationalRowAddStep_semantics delta row k (by omega) + +theorem machineRationalRowAdd_done_iterate + (extra : ℕ) (accumulator delta bound : List Bool) : + (machineRationalRowAddStep)^[extra] + (machineRationalRowAddPack [] accumulator delta bound) = + machineRationalRowAddPack [] accumulator delta bound := by + induction extra with + | zero => rfl + | succ k ih => + rw [Function.iterate_succ_apply', ih] + simp [machineRationalRowAddStep] + +theorem machineRationalRowAddFinalState_encode + (delta : RawRat) (row : List ℚ) : + machineRationalRowAddFinalState + (machineRationalRowAddCanonicalInput delta row) = + machineRationalRowAddPack [] + (binaryListCode rationalEntryBinaryCode + (rationalRowAddValues delta row).reverse) + (rawRatBinaryCode delta) + (machineRationalRowAddInputBound + (machineRationalRowAddCanonicalInput delta row)) := by + let word := machineRationalRowAddCanonicalInput delta row + have hrowLength : row.length ≤ word.length := by + have hcomponent : + (binaryListCode rationalEntryBinaryCode row).length ≤ + word.length := by + simpa only [word, machineRationalRowAddCanonicalInput, + machinePairSecond_pair] using + (show (machinePairSecond word).length ≤ word.length from + machinePairSecond_length_le word) + exact (binaryListCode_listLength_le rationalEntryBinaryCode row).trans + hcomponent + have htakeAll : + (rationalRowAddValues delta row).take row.length = + rationalRowAddValues delta row := by + have hlength : (rationalRowAddValues delta row).length = + row.length := by simp [rationalRowAddValues] + rw [← hlength, List.take_length] + have hsplit : word.length = + (word.length - row.length) + row.length := by omega + change (machineRationalRowAddStep)^[word.length] + (machineRationalRowAddInit word) = _ + rw [hsplit, Function.iterate_add_apply, + machineRationalRowAddIterate_semantics delta row row.length le_rfl] + simp only [machineRationalRowAddSemanticState, List.drop_length, + binaryListCode, word] + rw [htakeAll] + rw [machineRationalRowAdd_done_iterate] + +@[simp] theorem machineRationalRowAdd_encode + (delta : RawRat) (row : List ℚ) : + machineRationalRowAdd + (machineRationalRowAddCanonicalInput delta row) = + binaryListCode rationalEntryBinaryCode + (rationalRowAddValues delta row) := by + rw [machineRationalRowAdd, + machineRationalRowAddFinalState_encode] + simp only [machineRationalRowAddAccumulator_pack, + machineListReverse_encode, List.reverse_reverse] + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalRowDivide.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalRowDivide.lean new file mode 100644 index 0000000000..0c093c9cc8 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalRowDivide.lean @@ -0,0 +1,639 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineListReverse +import LeanPool.BeyondBethe.BeyondBethe.MachineMatrixSum +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalUnary +import Mathlib.Tactic + +/-! +# Dividing every entry of a rational row by one raw rational + +The input is `pair scaleRawCode rowCode`. Each output entry is normalized to +the numerator/denominator pair encoding required inside rational matrices. +This is deliberately not `machineRationalDivCode`, whose public output uses a +different one-natural encoding. +-/ + +namespace BeyondBethe + +open Complexity + +def machineRationalRowDivideScale (word : List Bool) : List Bool := + machinePairFirst word + +def machineRationalRowDivideRow (word : List Bool) : List Bool := + machinePairSecond word + +def machineRationalRowDividePadTwo (word : List Bool) : List Bool := + word ++ word + +def machineRationalRowDividePadFour (word : List Bool) : List Bool := + machineRationalRowDividePadTwo word ++ machineRationalRowDividePadTwo word + +def machineRationalRowDividePadEight (word : List Bool) : List Bool := + machineRationalRowDividePadFour word ++ machineRationalRowDividePadFour word + +def machineRationalRowDividePadSixteen (word : List Bool) : List Bool := + machineRationalRowDividePadEight word ++ machineRationalRowDividePadEight word + +/-- A coefficient-adjusted quadratic envelope. Sixteen copies before the +standard square provide enough room for every normalized output entry without +the impractical quartic padding used by an earlier draft. -/ +def machineRationalRowDivideInputBound (word : List Bool) : List Bool := + machineBinaryMulWidth (machineRationalRowDividePadSixteen word) + +def machineRationalRowDividePack + (remaining accumulator scale bound : List Bool) : List Bool := + pair remaining (pair accumulator (pair scale bound)) + +def machineRationalRowDivideRemaining (state : List Bool) : List Bool := + machinePairFirst state + +def machineRationalRowDivideAccumulator (state : List Bool) : List Bool := + machinePairFirst (machinePairSecond state) + +def machineRationalRowDivideScaleField (state : List Bool) : List Bool := + machinePairFirst (machinePairSecond (machinePairSecond state)) + +def machineRationalRowDivideBound (state : List Bool) : List Bool := + machinePairSecond (machinePairSecond (machinePairSecond state)) + +def machineRationalRowDivideRawEntry (state : List Bool) : List Bool := + machineRawRatDivCode + (pair (machineListHead (machineRationalRowDivideRemaining state)) + (machineRationalRowDivideScaleField state)) + +def machineRationalRowDivideEntry (state : List Bool) : List Bool := + machineNormalizeRawRatEntryCode + (machineRationalRowDivideRawEntry state) + +def machineRationalRowDivideCandidate (state : List Bool) : List Bool := + pair (machineRationalRowDivideEntry state) + (machineRationalRowDivideAccumulator state) + +def machineRationalRowDivideNextAccumulator (state : List Bool) : List Bool := + (machineRationalRowDivideCandidate state).take + (machineRationalRowDivideBound state).length + +def machineRationalRowDivideAdvance (state : List Bool) : List Bool := + machineRationalRowDividePack + (machineListTail (machineRationalRowDivideRemaining state)) + (machineRationalRowDivideNextAccumulator state) + (machineRationalRowDivideScaleField state) + (machineRationalRowDivideBound state) + +def machineRationalRowDivideStep (state : List Bool) : List Bool := + machineIfEmpty (machineRationalRowDivideRemaining state) state + (machineRationalRowDivideAdvance state) + +def machineRationalRowDivideInit (word : List Bool) : List Bool := + machineRationalRowDividePack (machineRationalRowDivideRow word) [] + (machineRationalRowDivideScale word) + (machineRationalRowDivideInputBound word) + +def machineRationalRowDivideWidth (word : List Bool) : List Bool := + let bound := machineRationalRowDivideInputBound word + machineRationalRowDividePack word bound word bound + +def machineRationalRowDivideFinalState (word : List Bool) : List Bool := + (machineRationalRowDivideStep)^[word.length] + (machineRationalRowDivideInit word) + +def machineRationalRowDivide (word : List Bool) : List Bool := + machineListReverse + (machineRationalRowDivideAccumulator + (machineRationalRowDivideFinalState word)) + +theorem machineRationalRowDivideScale_mem_FP : + machineRationalRowDivideScale ∈ Complexity.FP := + machinePairFirst_mem_FP + +theorem machineRationalRowDivideRow_mem_FP : + machineRationalRowDivideRow ∈ Complexity.FP := + machinePairSecond_mem_FP + +theorem machineRationalRowDividePadTwo_mem_FP : + machineRationalRowDividePadTwo ∈ Complexity.FP := + machineAppend_mem_FP id_mem_FP id_mem_FP + +theorem machineRationalRowDividePadFour_mem_FP : + machineRationalRowDividePadFour ∈ Complexity.FP := + machineAppend_mem_FP machineRationalRowDividePadTwo_mem_FP + machineRationalRowDividePadTwo_mem_FP + +theorem machineRationalRowDividePadEight_mem_FP : + machineRationalRowDividePadEight ∈ Complexity.FP := + machineAppend_mem_FP machineRationalRowDividePadFour_mem_FP + machineRationalRowDividePadFour_mem_FP + +theorem machineRationalRowDividePadSixteen_mem_FP : + machineRationalRowDividePadSixteen ∈ Complexity.FP := + machineAppend_mem_FP machineRationalRowDividePadEight_mem_FP + machineRationalRowDividePadEight_mem_FP + +theorem machineRationalRowDivideInputBound_mem_FP : + machineRationalRowDivideInputBound ∈ Complexity.FP := by + simpa only [machineRationalRowDivideInputBound] using + machineCompose_mem_FP machineRationalRowDividePadSixteen_mem_FP + machineBinaryMulWidth_mem_FP + +theorem machineRationalRowDividePadSixteen_length (word : List Bool) : + (machineRationalRowDividePadSixteen word).length = 16 * word.length := by + simp only [machineRationalRowDividePadSixteen, + machineRationalRowDividePadEight, + machineRationalRowDividePadFour, + machineRationalRowDividePadTwo, List.length_append] + omega + +theorem machineRationalRowDivideInputBound_length_mono + {left right : List Bool} (h : left.length ≤ right.length) : + (machineRationalRowDivideInputBound left).length ≤ + (machineRationalRowDivideInputBound right).length := by + apply machineBinaryMulWidth_length_mono + rw [machineRationalRowDividePadSixteen_length, + machineRationalRowDividePadSixteen_length] + exact Nat.mul_le_mul_left 16 h + +theorem machineRationalRowDivideRemaining_mem_FP : + machineRationalRowDivideRemaining ∈ Complexity.FP := + machinePairFirst_mem_FP + +theorem machineRationalRowDivideAccumulator_mem_FP : + machineRationalRowDivideAccumulator ∈ Complexity.FP := by + simpa only [machineRationalRowDivideAccumulator] using + machineCompose_mem_FP machinePairSecond_mem_FP machinePairFirst_mem_FP + +theorem machineRationalRowDivideScaleField_mem_FP : + machineRationalRowDivideScaleField ∈ Complexity.FP := by + have htail := machineCompose_mem_FP machinePairSecond_mem_FP + machinePairSecond_mem_FP + simpa only [machineRationalRowDivideScaleField] using + machineCompose_mem_FP htail machinePairFirst_mem_FP + +theorem machineRationalRowDivideBound_mem_FP : + machineRationalRowDivideBound ∈ Complexity.FP := by + have htail := machineCompose_mem_FP machinePairSecond_mem_FP + machinePairSecond_mem_FP + simpa only [machineRationalRowDivideBound] using + machineCompose_mem_FP htail machinePairSecond_mem_FP + +theorem machineRationalRowDivideRawEntry_mem_FP : + machineRationalRowDivideRawEntry ∈ Complexity.FP := by + have hhead := machineCompose_mem_FP machineRationalRowDivideRemaining_mem_FP + machineListHead_mem_FP + have hinput := machinePair_mem_FP hhead + machineRationalRowDivideScaleField_mem_FP + simpa only [machineRationalRowDivideRawEntry] using + machineCompose_mem_FP hinput machineRawRatDivCode_mem_FP + +theorem machineRationalRowDivideEntry_mem_FP : + machineRationalRowDivideEntry ∈ Complexity.FP := by + simpa only [machineRationalRowDivideEntry] using + machineCompose_mem_FP machineRationalRowDivideRawEntry_mem_FP + machineNormalizeRawRatEntryCode_mem_FP + +theorem machineRationalRowDivideCandidate_mem_FP : + machineRationalRowDivideCandidate ∈ Complexity.FP := + machinePair_mem_FP machineRationalRowDivideEntry_mem_FP + machineRationalRowDivideAccumulator_mem_FP + +theorem machineRationalRowDivideNextAccumulator_mem_FP : + machineRationalRowDivideNextAccumulator ∈ Complexity.FP := by + simpa only [machineRationalRowDivideNextAccumulator] using + machineTake_mem_FP machineRationalRowDivideBound_mem_FP + machineRationalRowDivideCandidate_mem_FP + +theorem machineRationalRowDivideAdvance_mem_FP : + machineRationalRowDivideAdvance ∈ Complexity.FP := by + have htail := machineCompose_mem_FP machineRationalRowDivideRemaining_mem_FP + machineListTail_mem_FP + exact machinePair_mem_FP htail + (machinePair_mem_FP machineRationalRowDivideNextAccumulator_mem_FP + (machinePair_mem_FP machineRationalRowDivideScaleField_mem_FP + machineRationalRowDivideBound_mem_FP)) + +theorem machineRationalRowDivideStep_mem_FP : + machineRationalRowDivideStep ∈ Complexity.FP := by + exact machineIfEmpty_mem_FP machineRationalRowDivideRemaining_mem_FP + id_mem_FP machineRationalRowDivideAdvance_mem_FP + +theorem machineRationalRowDivideInit_mem_FP : + machineRationalRowDivideInit ∈ Complexity.FP := by + exact machinePair_mem_FP machineRationalRowDivideRow_mem_FP + (machinePair_mem_FP (machineConst_mem_FP []) + (machinePair_mem_FP machineRationalRowDivideScale_mem_FP + machineRationalRowDivideInputBound_mem_FP)) + +theorem machineRationalRowDivideWidth_mem_FP : + machineRationalRowDivideWidth ∈ Complexity.FP := by + exact machinePair_mem_FP id_mem_FP + (machinePair_mem_FP machineRationalRowDivideInputBound_mem_FP + (machinePair_mem_FP id_mem_FP + machineRationalRowDivideInputBound_mem_FP)) + +@[simp] theorem machineRationalRowDivideRemaining_pack (a b c d) : + machineRationalRowDivideRemaining + (machineRationalRowDividePack a b c d) = a := by + simp [machineRationalRowDivideRemaining, machineRationalRowDividePack] + +@[simp] theorem machineRationalRowDivideAccumulator_pack (a b c d) : + machineRationalRowDivideAccumulator + (machineRationalRowDividePack a b c d) = b := by + simp [machineRationalRowDivideAccumulator, machineRationalRowDividePack] + +@[simp] theorem machineRationalRowDivideScaleField_pack (a b c d) : + machineRationalRowDivideScaleField + (machineRationalRowDividePack a b c d) = c := by + simp [machineRationalRowDivideScaleField, machineRationalRowDividePack] + +@[simp] theorem machineRationalRowDivideBound_pack (a b c d) : + machineRationalRowDivideBound + (machineRationalRowDividePack a b c d) = d := by + simp [machineRationalRowDivideBound, machineRationalRowDividePack] + +def MachineRationalRowDivideStateBound (word state : List Bool) : Prop := + state = machineRationalRowDividePack + (machineRationalRowDivideRemaining state) + (machineRationalRowDivideAccumulator state) + (machineRationalRowDivideScaleField state) + (machineRationalRowDivideBound state) ∧ + (machineRationalRowDivideRemaining state).length ≤ word.length ∧ + (machineRationalRowDivideAccumulator state).length ≤ + (machineRationalRowDivideInputBound word).length ∧ + (machineRationalRowDivideScaleField state).length ≤ word.length ∧ + machineRationalRowDivideBound state = + machineRationalRowDivideInputBound word + +theorem machineRationalRowDivideInit_bound (word : List Bool) : + MachineRationalRowDivideStateBound word + (machineRationalRowDivideInit word) := by + simp only [MachineRationalRowDivideStateBound, + machineRationalRowDivideInit, + machineRationalRowDivideRemaining_pack, + machineRationalRowDivideAccumulator_pack, + machineRationalRowDivideScaleField_pack, + machineRationalRowDivideBound_pack] + refine ⟨trivial, ?_, by simp, ?_, trivial⟩ + · simpa only [machineRationalRowDivideRow] using + machinePairSecond_length_le word + · simpa only [machineRationalRowDivideScale] using + machinePairFirst_length_le word + +theorem machineRationalRowDivideStep_bound {word state : List Bool} + (hstate : MachineRationalRowDivideStateBound word state) : + MachineRationalRowDivideStateBound word + (machineRationalRowDivideStep state) := by + rcases hstate with + ⟨hdecomp, hremaining, haccumulator, hscale, hbound⟩ + by_cases hnil : machineRationalRowDivideRemaining state = [] + · rw [machineRationalRowDivideStep, hnil, machineIfEmpty_nil] + exact ⟨hdecomp, hremaining, haccumulator, hscale, hbound⟩ + · rw [machineRationalRowDivideStep] + cases hremainingCode : machineRationalRowDivideRemaining state with + | nil => exact False.elim (hnil hremainingCode) + | cons bit tail => + rw [machineIfEmpty_cons, machineRationalRowDivideAdvance] + simp only [MachineRationalRowDivideStateBound, + machineRationalRowDivideRemaining_pack, + machineRationalRowDivideAccumulator_pack, + machineRationalRowDivideScaleField_pack, + machineRationalRowDivideBound_pack] + refine ⟨trivial, ?_, ?_, hscale, hbound⟩ + · exact (machineListTail_length_le + (machineRationalRowDivideRemaining state)).trans hremaining + · rw [machineRationalRowDivideNextAccumulator, hbound] + exact List.length_take_le _ _ + +theorem machineRationalRowDivideIterate_bound (word : List Bool) : ∀ k, + MachineRationalRowDivideStateBound word + ((machineRationalRowDivideStep)^[k] + (machineRationalRowDivideInit word)) := by + intro k + induction k with + | zero => exact machineRationalRowDivideInit_bound word + | succ k ih => + rw [Function.iterate_succ_apply'] + exact machineRationalRowDivideStep_bound ih + +theorem machineRationalRowDivideIterate_length_le_width + (word : List Bool) (iterations : ℕ) (_ : iterations ≤ word.length) : + ((machineRationalRowDivideStep)^[iterations] + (machineRationalRowDivideInit word)).length ≤ + (machineRationalRowDivideWidth word).length := by + rcases machineRationalRowDivideIterate_bound word iterations with + ⟨hdecomp, hremaining, haccumulator, hscale, hbound⟩ + rw [hdecomp, hbound] + simp only [machineRationalRowDividePack, + machineRationalRowDivideWidth, pair_length] + omega + +theorem machineRationalRowDivideFinalState_mem_FP : + machineRationalRowDivideFinalState ∈ Complexity.FP := by + exact Cobham.iterate_mem_FP machineRationalRowDivideStep_mem_FP + machineRationalRowDivideInit_mem_FP id_mem_FP + machineRationalRowDivideWidth_mem_FP + machineRationalRowDivideIterate_length_le_width + +theorem machineRationalRowDivide_mem_FP : + machineRationalRowDivide ∈ Complexity.FP := by + have hacc := machineCompose_mem_FP + machineRationalRowDivideFinalState_mem_FP + machineRationalRowDivideAccumulator_mem_FP + simpa only [machineRationalRowDivide] using + machineCompose_mem_FP hacc machineListReverse_mem_FP + +/-! ## Ordinary output-size estimate -/ + +private theorem natList_sum_le_length_mul {values : List ℕ} {bound : ℕ} + (h : ∀ value ∈ values, value ≤ bound) : + values.sum ≤ values.length * bound := by + induction values with + | nil => simp + | cons value values ih => + simp only [List.sum_cons, List.length_cons] + have hvalue := h value (by simp) + have htail : ∀ x ∈ values, x ≤ bound := by + intro x hx + exact h x (by simp [hx]) + have hi := ih htail + calc + value + values.sum ≤ bound + values.length * bound := + Nat.add_le_add hvalue hi + _ = (values.length + 1) * bound := by ring + +theorem machineRationalRowDivide_output_length_le_bound + (scale : RawRat) (row : List ℚ) : + let word := pair (rawRatBinaryCode scale) + (binaryListCode rationalEntryBinaryCode row) + let output := row.map fun q ↦ + binaryNormalizeRawRat ((rawRatOfRat q).div scale) + (binaryListCode rationalEntryBinaryCode output).length ≤ + (machineRationalRowDivideInputBound word).length := by + dsimp only + let word := pair (rawRatBinaryCode scale) + (binaryListCode rationalEntryBinaryCode row) + have hscale : rawRatWidth scale ≤ word.length := by + have hcomponent : (rawRatBinaryCode scale).length ≤ word.length := by + simpa only [word, machinePairFirst_pair] using + machinePairFirst_length_le word + exact (rawRatWidth_le_binaryCode_length scale).trans + hcomponent + have hrowLength : row.length ≤ word.length := by + have hcomponent : + (binaryListCode rationalEntryBinaryCode row).length ≤ + word.length := by + simpa only [word, machinePairSecond_pair] using + machinePairSecond_length_le word + exact (binaryListCode_listLength_le rationalEntryBinaryCode row).trans + hcomponent + have hentry : ∀ q ∈ row, + (rationalEntryBinaryCode + (binaryNormalizeRawRat ((rawRatOfRat q).div scale))).length ≤ + 64 + 72 * word.length := by + intro q hq + have hqCode := binaryListCode_element_length_le + rationalEntryBinaryCode hq + have hqWidth : rawRatWidth (rawRatOfRat q) ≤ word.length := by + have hentryCode : + (rawRatBinaryCode (rawRatOfRat q)).length ≤ + (binaryListCode rationalEntryBinaryCode row).length := by + simpa only [rawRatBinaryCode_rawRatOfRat] using hqCode + have hrowCode : + (binaryListCode rationalEntryBinaryCode row).length ≤ + word.length := by + simpa only [word, machinePairSecond_pair] using + machinePairSecond_length_le word + exact (rawRatWidth_le_binaryCode_length (rawRatOfRat q)).trans + (hentryCode.trans hrowCode) + have hdiv := rawRatWidth_div_le (rawRatOfRat q) scale + have hnormalize := + rationalEntryBinaryCode_binaryNormalizeRawRat_length_le + ((rawRatOfRat q).div scale) + omega + rw [binaryListCode_length_eq_sum] + have hterm : ∀ value ∈ + ((row.map fun q ↦ binaryNormalizeRawRat + ((rawRatOfRat q).div scale)).map + fun q ↦ 2 * (rationalEntryBinaryCode q).length + 2), + value ≤ 130 + 144 * word.length := by + simp only [List.map_map] + intro value hvalue + rw [List.mem_map] at hvalue + rcases hvalue with ⟨q, hq, rfl⟩ + have := hentry q hq + simp only [Function.comp_apply] + omega + have hsum := natList_sum_le_length_mul hterm + simp only [List.length_map] at hsum + have hpoly : + word.length * (130 + 144 * word.length) ≤ + (machineRationalRowDivideInputBound word).length := by + simp only [machineRationalRowDivideInputBound, + machineBinaryMulWidth, + List.length_replicate, List.length_append] + rw [machineRationalRowDividePadSixteen_length] + nlinarith [sq_nonneg word.length] + exact hsum.trans <| (Nat.mul_le_mul_right _ hrowLength).trans hpoly + +/-! ## Exact semantics -/ + +def rationalRowDivideValues (scale : RawRat) (row : List ℚ) : List ℚ := + row.map fun q ↦ binaryNormalizeRawRat ((rawRatOfRat q).div scale) + +def machineRationalRowDivideCanonicalInput + (scale : RawRat) (row : List ℚ) : List Bool := + pair (rawRatBinaryCode scale) + (binaryListCode rationalEntryBinaryCode row) + +def machineRationalRowDivideSemanticState + (scale : RawRat) (row : List ℚ) (k : ℕ) : List Bool := + let output := rationalRowDivideValues scale row + let word := machineRationalRowDivideCanonicalInput scale row + machineRationalRowDividePack + (binaryListCode rationalEntryBinaryCode (row.drop k)) + (binaryListCode rationalEntryBinaryCode (output.take k).reverse) + (rawRatBinaryCode scale) + (machineRationalRowDivideInputBound word) + +theorem machineRationalRowDivideInit_semantics + (scale : RawRat) (row : List ℚ) : + machineRationalRowDivideInit + (machineRationalRowDivideCanonicalInput scale row) = + machineRationalRowDivideSemanticState scale row 0 := by + simp [machineRationalRowDivideInit, + machineRationalRowDivideCanonicalInput, + machineRationalRowDivideSemanticState, + machineRationalRowDivideRow, machineRationalRowDivideScale, + binaryListCode] + +theorem machineRationalRowDivideEntry_semantics + (scale : RawRat) (row : List ℚ) (k : ℕ) (hk : k < row.length) : + machineRationalRowDivideEntry + (machineRationalRowDivideSemanticState scale row k) = + rationalEntryBinaryCode + (binaryNormalizeRawRat ((rawRatOfRat row[k]).div scale)) := by + have hdrop := List.drop_eq_getElem_cons hk + rw [machineRationalRowDivideEntry, + machineRationalRowDivideRawEntry] + simp only [machineRationalRowDivideSemanticState, + machineRationalRowDivideRemaining_pack, + machineRationalRowDivideScaleField_pack, hdrop, + machineListHead_cons, ← rawRatBinaryCode_rawRatOfRat, + machineRawRatDivCode_encode, + machineNormalizeRawRatEntryCode_encode] + +theorem machineRationalRowDivideStep_semantics + (scale : RawRat) (row : List ℚ) (k : ℕ) (hk : k < row.length) : + machineRationalRowDivideStep + (machineRationalRowDivideSemanticState scale row k) = + machineRationalRowDivideSemanticState scale row (k + 1) := by + let output := rationalRowDivideValues scale row + let word := machineRationalRowDivideCanonicalInput scale row + have houtputLength : output.length = row.length := by + simp [output, rationalRowDivideValues] + have hkoutput : k < output.length := by omega + have houtputGet : output[k] = + binaryNormalizeRawRat ((rawRatOfRat row[k]).div scale) := by + simp [output, rationalRowDivideValues, List.getElem_map] + have hdrop := List.drop_eq_getElem_cons hk + have htake := List.take_concat_get hkoutput + have hprefix : (output.take (k + 1)).reverse = + output[k] :: (output.take k).reverse := by + rw [← htake] + simpa only [List.concat_eq_append] using + (List.reverse_concat (l := output.take k) (a := output[k])) + have hfullBound : + (binaryListCode rationalEntryBinaryCode output).length ≤ + (machineRationalRowDivideInputBound word).length := by + simpa only [word, output, machineRationalRowDivideCanonicalInput, + rationalRowDivideValues] using + machineRationalRowDivide_output_length_le_bound scale row + have hprefixLength : + (binaryListCode rationalEntryBinaryCode + (output.take (k + 1)).reverse).length ≤ + (machineRationalRowDivideInputBound word).length := + (binaryListCode_take_reverse_length_le rationalEntryBinaryCode + output (k + 1)).trans hfullBound + have htakeBound : + (binaryListCode rationalEntryBinaryCode + (output.take (k + 1)).reverse).take + (machineRationalRowDivideInputBound word).length = + binaryListCode rationalEntryBinaryCode + (output.take (k + 1)).reverse := + List.take_of_length_le hprefixLength + have hnonempty : + binaryListCode rationalEntryBinaryCode (row.drop k) ≠ [] := by + rw [hdrop] + exact binaryListCode_cons_ne_nil _ _ _ + rw [machineRationalRowDivideStep] + simp only [machineRationalRowDivideSemanticState, + machineRationalRowDivideRemaining_pack] + rw [machineIfEmpty_of_ne_nil _ _ _ hnonempty, + machineRationalRowDivideAdvance] + simp only [machineRationalRowDivideRemaining_pack, + machineRationalRowDivideAccumulator_pack, + machineRationalRowDivideScaleField_pack, + machineRationalRowDivideBound_pack, + machineRationalRowDivideNextAccumulator, + machineRationalRowDivideCandidate] + have hentry : + machineRationalRowDivideEntry + (machineRationalRowDividePack + (binaryListCode rationalEntryBinaryCode (row.drop k)) + (binaryListCode rationalEntryBinaryCode + (output.take k).reverse) + (rawRatBinaryCode scale) + (machineRationalRowDivideInputBound word)) = + rationalEntryBinaryCode output[k] := by + rw [houtputGet] + simpa only [machineRationalRowDivideSemanticState, output, word] using + machineRationalRowDivideEntry_semantics scale row k hk + rw [hentry] + rw [hdrop, machineListTail_cons] + change machineRationalRowDividePack + (binaryListCode rationalEntryBinaryCode (row.drop (k + 1))) + ((binaryListCode rationalEntryBinaryCode + (output[k] :: (output.take k).reverse)).take + (machineRationalRowDivideInputBound word).length) + (rawRatBinaryCode scale) + (machineRationalRowDivideInputBound word) = _ + rw [← hprefix, htakeBound] + +theorem machineRationalRowDivideIterate_semantics + (scale : RawRat) (row : List ℚ) : ∀ k ≤ row.length, + (machineRationalRowDivideStep)^[k] + (machineRationalRowDivideInit + (machineRationalRowDivideCanonicalInput scale row)) = + machineRationalRowDivideSemanticState scale row k := by + intro k hk + induction k with + | zero => exact machineRationalRowDivideInit_semantics scale row + | succ k ih => + rw [Function.iterate_succ_apply', ih (by omega)] + exact machineRationalRowDivideStep_semantics scale row k (by omega) + +theorem machineRationalRowDivide_done_iterate + (extra : ℕ) (accumulator scale bound : List Bool) : + (machineRationalRowDivideStep)^[extra] + (machineRationalRowDividePack [] accumulator scale bound) = + machineRationalRowDividePack [] accumulator scale bound := by + induction extra with + | zero => rfl + | succ k ih => + rw [Function.iterate_succ_apply', ih] + simp [machineRationalRowDivideStep] + +theorem machineRationalRowDivideFinalState_encode + (scale : RawRat) (row : List ℚ) : + machineRationalRowDivideFinalState + (machineRationalRowDivideCanonicalInput scale row) = + machineRationalRowDividePack [] + (binaryListCode rationalEntryBinaryCode + (rationalRowDivideValues scale row).reverse) + (rawRatBinaryCode scale) + (machineRationalRowDivideInputBound + (machineRationalRowDivideCanonicalInput scale row)) := by + let word := machineRationalRowDivideCanonicalInput scale row + have hrowLength : row.length ≤ word.length := by + have hcomponent : + (binaryListCode rationalEntryBinaryCode row).length ≤ + word.length := by + simpa only [word, machineRationalRowDivideCanonicalInput, + machinePairSecond_pair] using + (show (machinePairSecond word).length ≤ word.length from + machinePairSecond_length_le word) + exact (binaryListCode_listLength_le rationalEntryBinaryCode row).trans + hcomponent + have htakeAll : + (rationalRowDivideValues scale row).take row.length = + rationalRowDivideValues scale row := by + have hlength : (rationalRowDivideValues scale row).length = + row.length := by simp [rationalRowDivideValues] + rw [← hlength, List.take_length] + have hsplit : word.length = + (word.length - row.length) + row.length := by omega + change (machineRationalRowDivideStep)^[word.length] + (machineRationalRowDivideInit word) = _ + rw [hsplit, Function.iterate_add_apply, + machineRationalRowDivideIterate_semantics scale row row.length le_rfl] + simp only [machineRationalRowDivideSemanticState, List.drop_length, + binaryListCode, word] + rw [htakeAll] + rw [machineRationalRowDivide_done_iterate] + +@[simp] theorem machineRationalRowDivide_encode + (scale : RawRat) (row : List ℚ) : + machineRationalRowDivide + (machineRationalRowDivideCanonicalInput scale row) = + binaryListCode rationalEntryBinaryCode + (rationalRowDivideValues scale row) := by + rw [machineRationalRowDivide, + machineRationalRowDivideFinalState_encode] + simp only [machineRationalRowDivideAccumulator_pack, + machineListReverse_encode, List.reverse_reverse] + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalTransposeMulVector.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalTransposeMulVector.lean new file mode 100644 index 0000000000..8d36e9f863 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalTransposeMulVector.lean @@ -0,0 +1,672 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalMatrixColumn +import LeanPool.BeyondBethe.BeyondBethe.MachineUnaryRange + +/-! +# Polynomial-time rational transpose--vector multiplication + +This module maps the verified one-coordinate routine over all unary column +indices. The output is the canonical vector word for `Aᵀ v`. A concrete +degree-eight word bounds every intermediate accumulator even on malformed +inputs; on canonical inputs a separate encoding estimate proves that the +clamp never truncates. +-/ + +namespace BeyondBethe + +open Complexity + +/-- The semantic transpose--vector product used by the exactness theorem. -/ +def rationalTransposeMulVector {d : ℕ} + (A : Matrix (Fin d) (Fin d) ℚ) (v : Fin d → ℚ) : Fin d → ℚ := + fun j ↦ ∑ i, A i j * v i + +def rawRationalTransposeCoordinate {d : ℕ} + (A : Matrix (Fin d) (Fin d) ℚ) (v : Fin d → ℚ) + (j : Fin d) : RawRat := + rawRatListDot RawRat.zero + (rationalColumnOfRows (rationalMatrixRows A) j.1) + (List.ofFn v) + +theorem rawRationalTransposeCoordinate_value {d : ℕ} + (A : Matrix (Fin d) (Fin d) ℚ) (v : Fin d → ℚ) + (j : Fin d) : + (rawRationalTransposeCoordinate A v j).value = + rationalTransposeMulVector A v j := by + rw [rawRationalTransposeCoordinate, + rationalColumnOfRows_matrix] + exact rawRatListDot_ofFn_value (fun i => A i j) v + +def rationalTransposeMulVectorCanonicalWord {d : ℕ} + (A : Matrix (Fin d) (Fin d) ℚ) (v : Fin d → ℚ) : List Bool := + pair (List.replicate d true) + (pair (rationalSquareMatrixRowsCode A) + (rationalFiniteVectorCode v)) + +theorem rawRationalTransposeCoordinate_width_le_word {d : ℕ} + (A : Matrix (Fin d) (Fin d) ℚ) (v : Fin d → ℚ) + (j : Fin d) : + rawRatWidth (rawRationalTransposeCoordinate A v j) ≤ + (rationalTransposeMulVectorCanonicalWord A v).length := by + let column := rationalColumnOfRows (rationalMatrixRows A) j.1 + let vector := List.ofFn v + have hwidth := rawRatWidth_listDot_le RawRat.zero column vector + simp only [rawRatWidth_zero] at hwidth + have hcost := rawRatListDotCost_le_codeLength column vector + have hcolumn := rationalColumnOfRows_code_length_le j.1 + (rationalMatrixRows A) (rationalMatrixRows_haveColumn A j) + have hcolumn' : + (binaryListCode rationalEntryBinaryCode column).length ≤ + (binaryListCode (binaryListCode rationalEntryBinaryCode) + (rationalMatrixRows A)).length := by + simpa only [column] using hcolumn + have hcombined : + 1 + (binaryListCode (binaryListCode rationalEntryBinaryCode) + (rationalMatrixRows A)).length + + (binaryListCode rationalEntryBinaryCode vector).length ≤ + (rationalTransposeMulVectorCanonicalWord A v).length := by + simp only [rationalTransposeMulVectorCanonicalWord, + rationalSquareMatrixRowsCode, rationalFiniteVectorCode, + vector, pair_length, List.length_replicate] + omega + change rawRatWidth + (rawRatListDot RawRat.zero column vector) ≤ _ + omega + +theorem rationalTransposeMulVector_entry_code_length_le {d : ℕ} + (A : Matrix (Fin d) (Fin d) ℚ) (v : Fin d → ℚ) + (j : Fin d) : + (rationalEntryBinaryCode + (rationalTransposeMulVector A v j)).length ≤ + 64 + 36 * (rationalTransposeMulVectorCanonicalWord A v).length := by + have hcanonical := + rationalEntryBinaryCode_binaryNormalizeRawRat_length_le + (rawRationalTransposeCoordinate A v j) + rw [binaryNormalizeRawRat_eq_value, + rawRationalTransposeCoordinate_value] at hcanonical + exact hcanonical.trans (Nat.add_le_add_left + (Nat.mul_le_mul_left 36 + (rawRationalTransposeCoordinate_width_le_word A v j)) 64) + +def machineRationalTransposeMulVectorInputBound + (word : List Bool) : List Bool := + machineBinaryMulWidth + (machineBinaryMulWidth (machineBinaryMulWidth word)) + +theorem machineRationalTransposeMulVectorInputBound_mem_FP : + machineRationalTransposeMulVectorInputBound ∈ FP := by + have h1 := machineBinaryMulWidth_mem_FP + have h2 := machineCompose_mem_FP h1 machineBinaryMulWidth_mem_FP + have h3 := machineCompose_mem_FP h2 machineBinaryMulWidth_mem_FP + simpa only [machineRationalTransposeMulVectorInputBound] using h3 + +theorem rationalTransposeMulVector_code_length_le_bound {d : ℕ} + (A : Matrix (Fin d) (Fin d) ℚ) (v : Fin d → ℚ) : + (rationalFiniteVectorCode + (rationalTransposeMulVector A v)).length ≤ + (machineRationalTransposeMulVectorInputBound + (rationalTransposeMulVectorCanonicalWord A v)).length := by + let word := rationalTransposeMulVectorCanonicalWord A v + let B := 64 + 36 * word.length + have hdim : d ≤ word.length := by + have hfirst := machinePairFirst_length_le word + simpa only [word, rationalTransposeMulVectorCanonicalWord, + machinePairFirst_pair, List.length_replicate] using hfirst + have heach : ∀ q ∈ List.ofFn (rationalTransposeMulVector A v), + (rationalEntryBinaryCode q).length ≤ B := by + intro q hq + obtain ⟨j, rfl⟩ := List.mem_ofFn.mp hq + exact rationalTransposeMulVector_entry_code_length_le A v j + have hsum := List.sum_le_card_nsmul + ((List.ofFn (rationalTransposeMulVector A v)).map + fun q ↦ 2 * (rationalEntryBinaryCode q).length + 2) + (2 * B + 2) (by + intro value hvalue + rw [List.mem_map] at hvalue + obtain ⟨q, hq, rfl⟩ := hvalue + have hq' := heach q hq + omega) + rw [rationalFiniteVectorCode, binaryListCode_length_eq_sum] + simp only [machineRationalTransposeMulVectorInputBound, + machineBinaryMulWidth, List.length_replicate, + List.length_append, List.length_map, List.length_ofFn, + Nat.nsmul_eq_mul] at hsum ⊢ + dsimp only [B, word] at hsum ⊢ + nlinarith [sq_nonneg + (rationalTransposeMulVectorCanonicalWord A v).length] + +/-! ## Finite-word transducer -/ + +def machineRationalTransposeMulVectorDimension + (word : List Bool) : List Bool := machinePairFirst word + +def machineRationalTransposeMulVectorPayload + (word : List Bool) : List Bool := machinePairSecond word + +def machineRationalTransposeMulVectorIndices + (word : List Bool) : List Bool := + machineUnaryRangeCode + (machineRationalTransposeMulVectorDimension word) + +def machineRationalTransposeMulVectorPack + (remaining accumulator payload bound : List Bool) : List Bool := + pair remaining (pair accumulator (pair payload bound)) + +def machineRationalTransposeMulVectorRemaining + (state : List Bool) : List Bool := machinePairFirst state + +def machineRationalTransposeMulVectorAccumulator + (state : List Bool) : List Bool := + machinePairFirst (machinePairSecond state) + +def machineRationalTransposeMulVectorStatePayload + (state : List Bool) : List Bool := + machinePairFirst (machinePairSecond (machinePairSecond state)) + +def machineRationalTransposeMulVectorBound + (state : List Bool) : List Bool := + machinePairSecond (machinePairSecond (machinePairSecond state)) + +def machineRationalTransposeMulVectorCurrentIndex + (state : List Bool) : List Bool := + machineListHead (machineRationalTransposeMulVectorRemaining state) + +def machineRationalTransposeMulVectorCurrentEntry + (state : List Bool) : List Bool := + machineRationalMatrixTransposeMulVectorEntryCode + (pair (machineRationalTransposeMulVectorCurrentIndex state) + (machineRationalTransposeMulVectorStatePayload state)) + +def machineRationalTransposeMulVectorCandidate + (state : List Bool) : List Bool := + pair (machineRationalTransposeMulVectorCurrentEntry state) + (machineRationalTransposeMulVectorAccumulator state) + +def machineRationalTransposeMulVectorNextAccumulator + (state : List Bool) : List Bool := + (machineRationalTransposeMulVectorCandidate state).take + (machineRationalTransposeMulVectorBound state).length + +def machineRationalTransposeMulVectorAdvance + (state : List Bool) : List Bool := + machineRationalTransposeMulVectorPack + (machineListTail (machineRationalTransposeMulVectorRemaining state)) + (machineRationalTransposeMulVectorNextAccumulator state) + (machineRationalTransposeMulVectorStatePayload state) + (machineRationalTransposeMulVectorBound state) + +def machineRationalTransposeMulVectorStep + (state : List Bool) : List Bool := + machineIfEmpty (machineRationalTransposeMulVectorRemaining state) state + (machineRationalTransposeMulVectorAdvance state) + +def machineRationalTransposeMulVectorInit (word : List Bool) : List Bool := + machineRationalTransposeMulVectorPack + (machineRationalTransposeMulVectorIndices word) [] + (machineRationalTransposeMulVectorPayload word) + (machineRationalTransposeMulVectorInputBound word) + +def machineRationalTransposeMulVectorWidth (word : List Bool) : List Bool := + let bound := machineRationalTransposeMulVectorInputBound word + machineRationalTransposeMulVectorPack bound bound bound bound + +def machineRationalTransposeMulVectorFinalState + (word : List Bool) : List Bool := + (machineRationalTransposeMulVectorStep)^[word.length] + (machineRationalTransposeMulVectorInit word) + +def machineRationalTransposeMulVectorReversedCode + (word : List Bool) : List Bool := + machineRationalTransposeMulVectorAccumulator + (machineRationalTransposeMulVectorFinalState word) + +/-- Input: `pair dimensionUnary (pair nestedMatrixRowsCode vectorCode)`. -/ +def machineRationalTransposeMulVectorCode + (word : List Bool) : List Bool := + machineListReverse + (machineRationalTransposeMulVectorReversedCode word) + +theorem machineRationalTransposeMulVectorDimension_mem_FP : + machineRationalTransposeMulVectorDimension ∈ FP := machinePairFirst_mem_FP + +theorem machineRationalTransposeMulVectorPayload_mem_FP : + machineRationalTransposeMulVectorPayload ∈ FP := machinePairSecond_mem_FP + +theorem machineRationalTransposeMulVectorIndices_mem_FP : + machineRationalTransposeMulVectorIndices ∈ FP := by + simpa only [machineRationalTransposeMulVectorIndices] using + machineCompose_mem_FP machineRationalTransposeMulVectorDimension_mem_FP + machineUnaryRangeCode_mem_FP + +theorem machineRationalTransposeMulVectorRemaining_mem_FP : + machineRationalTransposeMulVectorRemaining ∈ FP := machinePairFirst_mem_FP + +theorem machineRationalTransposeMulVectorAccumulator_mem_FP : + machineRationalTransposeMulVectorAccumulator ∈ FP := by + simpa only [machineRationalTransposeMulVectorAccumulator] using + machineCompose_mem_FP machinePairSecond_mem_FP machinePairFirst_mem_FP + +theorem machineRationalTransposeMulVectorStatePayload_mem_FP : + machineRationalTransposeMulVectorStatePayload ∈ FP := by + simpa only [machineRationalTransposeMulVectorStatePayload] using + machineCompose_mem_FP + (machineCompose_mem_FP machinePairSecond_mem_FP + machinePairSecond_mem_FP) machinePairFirst_mem_FP + +theorem machineRationalTransposeMulVectorBound_mem_FP : + machineRationalTransposeMulVectorBound ∈ FP := by + simpa only [machineRationalTransposeMulVectorBound] using + machineCompose_mem_FP + (machineCompose_mem_FP machinePairSecond_mem_FP + machinePairSecond_mem_FP) machinePairSecond_mem_FP + +theorem machineRationalTransposeMulVectorCurrentIndex_mem_FP : + machineRationalTransposeMulVectorCurrentIndex ∈ FP := by + simpa only [machineRationalTransposeMulVectorCurrentIndex] using + machineCompose_mem_FP machineRationalTransposeMulVectorRemaining_mem_FP + machineListHead_mem_FP + +theorem machineRationalTransposeMulVectorCurrentEntry_mem_FP : + machineRationalTransposeMulVectorCurrentEntry ∈ FP := by + have hp := machinePair_mem_FP + machineRationalTransposeMulVectorCurrentIndex_mem_FP + machineRationalTransposeMulVectorStatePayload_mem_FP + simpa only [machineRationalTransposeMulVectorCurrentEntry] using + machineCompose_mem_FP hp + machineRationalMatrixTransposeMulVectorEntryCode_mem_FP + +theorem machineRationalTransposeMulVectorCandidate_mem_FP : + machineRationalTransposeMulVectorCandidate ∈ FP := + machinePair_mem_FP machineRationalTransposeMulVectorCurrentEntry_mem_FP + machineRationalTransposeMulVectorAccumulator_mem_FP + +theorem machineRationalTransposeMulVectorNextAccumulator_mem_FP : + machineRationalTransposeMulVectorNextAccumulator ∈ FP := by + simpa only [machineRationalTransposeMulVectorNextAccumulator] using + machineTake_mem_FP machineRationalTransposeMulVectorBound_mem_FP + machineRationalTransposeMulVectorCandidate_mem_FP + +theorem machineRationalTransposeMulVectorAdvance_mem_FP : + machineRationalTransposeMulVectorAdvance ∈ FP := by + have htail := machineCompose_mem_FP + machineRationalTransposeMulVectorRemaining_mem_FP machineListTail_mem_FP + exact machinePair_mem_FP htail + (machinePair_mem_FP machineRationalTransposeMulVectorNextAccumulator_mem_FP + (machinePair_mem_FP + machineRationalTransposeMulVectorStatePayload_mem_FP + machineRationalTransposeMulVectorBound_mem_FP)) + +theorem machineRationalTransposeMulVectorStep_mem_FP : + machineRationalTransposeMulVectorStep ∈ FP := + machineIfEmpty_mem_FP machineRationalTransposeMulVectorRemaining_mem_FP + id_mem_FP machineRationalTransposeMulVectorAdvance_mem_FP + +theorem machineRationalTransposeMulVectorInit_mem_FP : + machineRationalTransposeMulVectorInit ∈ FP := by + exact machinePair_mem_FP machineRationalTransposeMulVectorIndices_mem_FP + (machinePair_mem_FP (machineConst_mem_FP []) + (machinePair_mem_FP machineRationalTransposeMulVectorPayload_mem_FP + machineRationalTransposeMulVectorInputBound_mem_FP)) + +theorem machineRationalTransposeMulVectorWidth_mem_FP : + machineRationalTransposeMulVectorWidth ∈ FP := by + exact machinePair_mem_FP machineRationalTransposeMulVectorInputBound_mem_FP + (machinePair_mem_FP machineRationalTransposeMulVectorInputBound_mem_FP + (machinePair_mem_FP machineRationalTransposeMulVectorInputBound_mem_FP + machineRationalTransposeMulVectorInputBound_mem_FP)) + +@[simp] theorem machineRationalTransposeMulVectorRemaining_pack (a b c d) : + machineRationalTransposeMulVectorRemaining + (machineRationalTransposeMulVectorPack a b c d) = a := by + simp [machineRationalTransposeMulVectorRemaining, + machineRationalTransposeMulVectorPack] + +@[simp] theorem machineRationalTransposeMulVectorAccumulator_pack (a b c d) : + machineRationalTransposeMulVectorAccumulator + (machineRationalTransposeMulVectorPack a b c d) = b := by + simp [machineRationalTransposeMulVectorAccumulator, + machineRationalTransposeMulVectorPack] + +@[simp] theorem machineRationalTransposeMulVectorStatePayload_pack (a b c d) : + machineRationalTransposeMulVectorStatePayload + (machineRationalTransposeMulVectorPack a b c d) = c := by + simp [machineRationalTransposeMulVectorStatePayload, + machineRationalTransposeMulVectorPack] + +@[simp] theorem machineRationalTransposeMulVectorBound_pack (a b c d) : + machineRationalTransposeMulVectorBound + (machineRationalTransposeMulVectorPack a b c d) = d := by + simp [machineRationalTransposeMulVectorBound, + machineRationalTransposeMulVectorPack] + +def MachineRationalTransposeMulVectorStateBound + (word state : List Bool) : Prop := + let bound := machineRationalTransposeMulVectorInputBound word + state = machineRationalTransposeMulVectorPack + (machineRationalTransposeMulVectorRemaining state) + (machineRationalTransposeMulVectorAccumulator state) + (machineRationalTransposeMulVectorStatePayload state) + (machineRationalTransposeMulVectorBound state) ∧ + (machineRationalTransposeMulVectorRemaining state).length ≤ bound.length ∧ + (machineRationalTransposeMulVectorAccumulator state).length ≤ bound.length ∧ + (machineRationalTransposeMulVectorStatePayload state).length ≤ bound.length ∧ + machineRationalTransposeMulVectorBound state = bound + +theorem machineRationalTransposeMulVector_word_le_bound (word : List Bool) : + word.length ≤ + (machineRationalTransposeMulVectorInputBound word).length := by + simp only [machineRationalTransposeMulVectorInputBound, + machineBinaryMulWidth, List.length_replicate, List.length_append] + nlinarith [sq_nonneg word.length] + +theorem machineRationalTransposeMulVector_indices_le_bound + (word : List Bool) : + (machineRationalTransposeMulVectorIndices word).length ≤ + (machineRationalTransposeMulVectorInputBound word).length := by + have hrange := machineUnaryRangeCode_length_le_inputBound + (machineRationalTransposeMulVectorDimension word) + have hdimension := machinePairFirst_length_le word + have hdimension' : + (machineRationalTransposeMulVectorDimension word).length ≤ + word.length := by + simpa only [machineRationalTransposeMulVectorDimension] using hdimension + have hmono := machineListUpdateInputBound_length_mono hdimension' + apply hrange.trans (hmono.trans ?_) + simp only [machineListUpdateInputBound, + machineRationalTransposeMulVectorInputBound, + machineBinaryMulWidth, List.length_replicate, List.length_append] + nlinarith [sq_nonneg word.length] + +theorem machineRationalTransposeMulVectorInit_bound (word : List Bool) : + MachineRationalTransposeMulVectorStateBound word + (machineRationalTransposeMulVectorInit word) := by + simp only [MachineRationalTransposeMulVectorStateBound, + machineRationalTransposeMulVectorInit, + machineRationalTransposeMulVectorRemaining_pack, + machineRationalTransposeMulVectorAccumulator_pack, + machineRationalTransposeMulVectorStatePayload_pack, + machineRationalTransposeMulVectorBound_pack] + refine ⟨trivial, + machineRationalTransposeMulVector_indices_le_bound word, + by simp, ?_, trivial⟩ + exact (machinePairSecond_length_le word).trans + (machineRationalTransposeMulVector_word_le_bound word) + +theorem machineRationalTransposeMulVectorStep_bound {word state : List Bool} + (hs : MachineRationalTransposeMulVectorStateBound word state) : + MachineRationalTransposeMulVectorStateBound word + (machineRationalTransposeMulVectorStep state) := by + dsimp only [MachineRationalTransposeMulVectorStateBound] at hs ⊢ + rcases hs with ⟨hdecomp, hremaining, hacc, hpayload, hbound⟩ + by_cases hnil : machineRationalTransposeMulVectorRemaining state = [] + · rw [machineRationalTransposeMulVectorStep, hnil, machineIfEmpty_nil] + exact ⟨hdecomp, hremaining, hacc, hpayload, hbound⟩ + · rw [machineRationalTransposeMulVectorStep] + cases hcode : machineRationalTransposeMulVectorRemaining state with + | nil => exact False.elim (hnil hcode) + | cons bit tail => + rw [machineIfEmpty_cons, machineRationalTransposeMulVectorAdvance] + simp only [machineRationalTransposeMulVectorRemaining_pack, + machineRationalTransposeMulVectorAccumulator_pack, + machineRationalTransposeMulVectorStatePayload_pack, + machineRationalTransposeMulVectorBound_pack] + refine ⟨trivial, ?_, ?_, hpayload, hbound⟩ + · exact (machineListTail_length_le + (machineRationalTransposeMulVectorRemaining state)).trans + hremaining + · rw [machineRationalTransposeMulVectorNextAccumulator, hbound] + exact List.length_take_le _ _ + +theorem machineRationalTransposeMulVectorIterate_bound + (word : List Bool) : ∀ k, + MachineRationalTransposeMulVectorStateBound word + ((machineRationalTransposeMulVectorStep)^[k] + (machineRationalTransposeMulVectorInit word)) := by + intro k + induction k with + | zero => exact machineRationalTransposeMulVectorInit_bound word + | succ k ih => + rw [Function.iterate_succ_apply'] + exact machineRationalTransposeMulVectorStep_bound ih + +theorem machineRationalTransposeMulVectorIterate_length_le_width + (word : List Bool) (iterations : ℕ) + (_ : iterations ≤ word.length) : + ((machineRationalTransposeMulVectorStep)^[iterations] + (machineRationalTransposeMulVectorInit word)).length ≤ + (machineRationalTransposeMulVectorWidth word).length := by + rcases machineRationalTransposeMulVectorIterate_bound word iterations with + ⟨hdecomp, hremaining, hacc, hpayload, hbound⟩ + rw [hdecomp, hbound] + simp only [machineRationalTransposeMulVectorPack, + machineRationalTransposeMulVectorWidth, pair_length] + omega + +theorem machineRationalTransposeMulVectorFinalState_mem_FP : + machineRationalTransposeMulVectorFinalState ∈ FP := by + exact Cobham.iterate_mem_FP machineRationalTransposeMulVectorStep_mem_FP + machineRationalTransposeMulVectorInit_mem_FP id_mem_FP + machineRationalTransposeMulVectorWidth_mem_FP + machineRationalTransposeMulVectorIterate_length_le_width + +theorem machineRationalTransposeMulVectorReversedCode_mem_FP : + machineRationalTransposeMulVectorReversedCode ∈ FP := by + simpa only [machineRationalTransposeMulVectorReversedCode] using + machineCompose_mem_FP machineRationalTransposeMulVectorFinalState_mem_FP + machineRationalTransposeMulVectorAccumulator_mem_FP + +theorem machineRationalTransposeMulVectorCode_mem_FP : + machineRationalTransposeMulVectorCode ∈ FP := by + simpa only [machineRationalTransposeMulVectorCode] using + machineCompose_mem_FP + machineRationalTransposeMulVectorReversedCode_mem_FP + machineListReverse_mem_FP + +/-! ## Exact iteration semantics -/ + +def rationalTransposePrefix {d : ℕ} + (A : Matrix (Fin d) (Fin d) ℚ) (v : Fin d → ℚ) + (k : ℕ) : List ℚ := + ((List.finRange d).take k).map + fun j ↦ rationalTransposeMulVector A v j + +def machineRationalTransposeMulVectorSemanticState {d : ℕ} + (A : Matrix (Fin d) (Fin d) ℚ) (v : Fin d → ℚ) + (k : ℕ) : List Bool := + let word := rationalTransposeMulVectorCanonicalWord A v + machineRationalTransposeMulVectorPack + (binaryListCode finUnaryCode ((List.finRange d).drop k)) + (binaryListCode rationalEntryBinaryCode + (rationalTransposePrefix A v k).reverse) + (pair (rationalSquareMatrixRowsCode A) + (rationalFiniteVectorCode v)) + (machineRationalTransposeMulVectorInputBound word) + +theorem machineRationalTransposeMulVectorInit_semantics {d : ℕ} + (A : Matrix (Fin d) (Fin d) ℚ) (v : Fin d → ℚ) : + machineRationalTransposeMulVectorInit + (rationalTransposeMulVectorCanonicalWord A v) = + machineRationalTransposeMulVectorSemanticState A v 0 := by + simp [machineRationalTransposeMulVectorInit, + machineRationalTransposeMulVectorSemanticState, + machineRationalTransposeMulVectorIndices, + machineRationalTransposeMulVectorDimension, + machineRationalTransposeMulVectorPayload, + rationalTransposeMulVectorCanonicalWord, + machineUnaryRangeCode_encode, finRangeUnaryCode, + rationalTransposePrefix, binaryListCode] + +theorem rationalTransposePrefix_succ {d : ℕ} + (A : Matrix (Fin d) (Fin d) ℚ) (v : Fin d → ℚ) + (k : ℕ) (hk : k < d) : + rationalTransposePrefix A v (k + 1) = + rationalTransposePrefix A v k ++ + [rationalTransposeMulVector A v ⟨k, hk⟩] := by + simp only [rationalTransposePrefix, List.map_take] + have hkm : k < (List.finRange d).length := by simpa + simpa [List.getElem_finRange] using + congrArg (List.map fun j ↦ rationalTransposeMulVector A v j) + (List.take_concat_get hkm).symm + +theorem machineRationalTransposeMulVectorStep_semantics {d : ℕ} + (A : Matrix (Fin d) (Fin d) ℚ) (v : Fin d → ℚ) + (k : ℕ) (hk : k < d) : + machineRationalTransposeMulVectorStep + (machineRationalTransposeMulVectorSemanticState A v k) = + machineRationalTransposeMulVectorSemanticState A v (k + 1) := by + let word := rationalTransposeMulVectorCanonicalWord A v + let j : Fin d := ⟨k, hk⟩ + have hdrop : + (List.finRange d).drop k = + j :: (List.finRange d).drop (k + 1) := by + convert List.drop_eq_getElem_cons + (show k < (List.finRange d).length by simpa) using 1 + simp [j, List.getElem_finRange] + have hprefix := rationalTransposePrefix_succ A v k hk + have hreverse : + (rationalTransposePrefix A v (k + 1)).reverse = + rationalTransposeMulVector A v j :: + (rationalTransposePrefix A v k).reverse := by + rw [hprefix, List.reverse_append] + simp [j] + have hcand : + (binaryListCode rationalEntryBinaryCode + (rationalTransposePrefix A v (k + 1)).reverse).length ≤ + (machineRationalTransposeMulVectorInputBound word).length := by + have hprefixBound := binaryListCode_take_reverse_length_le + rationalEntryBinaryCode + (List.ofFn (rationalTransposeMulVector A v)) (k + 1) + have hprefixEq : rationalTransposePrefix A v (k + 1) = + (List.ofFn (rationalTransposeMulVector A v)).take (k + 1) := by + apply List.ext_getElem + · simp [rationalTransposePrefix] + · intro i hiLeft hiRight + simp [rationalTransposePrefix, List.getElem_finRange] + rw [hprefixEq] + exact hprefixBound.trans + (rationalTransposeMulVector_code_length_le_bound A v) + have hcandPair : + (pair (rationalEntryBinaryCode + (rationalTransposeMulVector A v j)) + (binaryListCode rationalEntryBinaryCode + (rationalTransposePrefix A v k).reverse)).length ≤ + (machineRationalTransposeMulVectorInputBound word).length := by + simpa only [hreverse, binaryListCode] using hcand + have hnonempty : + binaryListCode finUnaryCode ((List.finRange d).drop k) ≠ [] := by + rw [hdrop] + exact binaryListCode_cons_ne_nil finUnaryCode j + ((List.finRange d).drop (k + 1)) + rw [machineRationalTransposeMulVectorStep] + simp only [machineRationalTransposeMulVectorSemanticState, + machineRationalTransposeMulVectorRemaining_pack] + rw [machineIfEmpty_of_ne_nil_matrix _ _ _ hnonempty, + machineRationalTransposeMulVectorAdvance] + simp only [machineRationalTransposeMulVectorRemaining_pack, + machineRationalTransposeMulVectorAccumulator_pack, + machineRationalTransposeMulVectorStatePayload_pack, + machineRationalTransposeMulVectorBound_pack, + machineRationalTransposeMulVectorNextAccumulator, + machineRationalTransposeMulVectorCandidate, + machineRationalTransposeMulVectorCurrentEntry, + machineRationalTransposeMulVectorCurrentIndex] + rw [hdrop, machineListHead_cons, machineListTail_cons] + change machineRationalTransposeMulVectorPack _ + ((pair (machineRationalMatrixTransposeMulVectorEntryCode + (pair (finUnaryCode j) + (pair (rationalSquareMatrixRowsCode A) + (rationalFiniteVectorCode v)))) + (binaryListCode rationalEntryBinaryCode + (rationalTransposePrefix A v k).reverse)).take + (machineRationalTransposeMulVectorInputBound word).length) _ _ = _ + rw [show finUnaryCode j = List.replicate j.1 true by rfl, + machineRationalMatrixTransposeMulVectorEntryCode_encode] + change machineRationalTransposeMulVectorPack _ + ((pair (rationalEntryBinaryCode + (rationalTransposeMulVector A v j)) + (binaryListCode rationalEntryBinaryCode + (rationalTransposePrefix A v k).reverse)).take + (machineRationalTransposeMulVectorInputBound word).length) _ _ = _ + rw [List.take_of_length_le hcandPair, hreverse] + rfl + +theorem machineRationalTransposeMulVectorIterate_semantics {d : ℕ} + (A : Matrix (Fin d) (Fin d) ℚ) (v : Fin d → ℚ) : ∀ k ≤ d, + (machineRationalTransposeMulVectorStep)^[k] + (machineRationalTransposeMulVectorInit + (rationalTransposeMulVectorCanonicalWord A v)) = + machineRationalTransposeMulVectorSemanticState A v k := by + intro k hk + induction k with + | zero => exact machineRationalTransposeMulVectorInit_semantics A v + | succ k ih => + rw [Function.iterate_succ_apply', ih (by omega)] + exact machineRationalTransposeMulVectorStep_semantics A v k (by omega) + +theorem machineRationalTransposeMulVector_done_iterate + (extra : ℕ) (accumulator payload bound : List Bool) : + (machineRationalTransposeMulVectorStep)^[extra] + (machineRationalTransposeMulVectorPack [] accumulator payload bound) = + machineRationalTransposeMulVectorPack [] accumulator payload bound := by + induction extra with + | zero => rfl + | succ k ih => + rw [Function.iterate_succ_apply', ih] + simp [machineRationalTransposeMulVectorStep] + +theorem rationalTransposePrefix_all {d : ℕ} + (A : Matrix (Fin d) (Fin d) ℚ) (v : Fin d → ℚ) : + rationalTransposePrefix A v d = + List.ofFn (rationalTransposeMulVector A v) := by + apply List.ext_getElem + · simp [rationalTransposePrefix] + · intro i hiLeft hiRight + simp [rationalTransposePrefix, List.getElem_finRange] + +theorem machineRationalTransposeMulVectorReversedCode_encode {d : ℕ} + (A : Matrix (Fin d) (Fin d) ℚ) (v : Fin d → ℚ) : + machineRationalTransposeMulVectorReversedCode + (rationalTransposeMulVectorCanonicalWord A v) = + binaryListCode rationalEntryBinaryCode + (List.ofFn (rationalTransposeMulVector A v)).reverse := by + let word := rationalTransposeMulVectorCanonicalWord A v + have hd : d ≤ word.length := by + have h := machinePairFirst_length_le word + simpa only [word, rationalTransposeMulVectorCanonicalWord, + machinePairFirst_pair, List.length_replicate] using h + have hsplit : word.length = (word.length - d) + d := by omega + change machineRationalTransposeMulVectorReversedCode word = _ + rw [machineRationalTransposeMulVectorReversedCode, + machineRationalTransposeMulVectorFinalState, hsplit, + Function.iterate_add_apply, + machineRationalTransposeMulVectorIterate_semantics A v d le_rfl] + simp only [machineRationalTransposeMulVectorSemanticState] + rw [show binaryListCode finUnaryCode ((List.finRange d).drop d) = [] by + rw [List.drop_eq_nil_of_le (by simp)] + rfl] + rw [machineRationalTransposeMulVector_done_iterate] + simp only [machineRationalTransposeMulVectorAccumulator_pack] + rw [rationalTransposePrefix_all] + +@[simp] theorem machineRationalTransposeMulVectorCode_encode {d : ℕ} + (A : Matrix (Fin d) (Fin d) ℚ) (v : Fin d → ℚ) : + machineRationalTransposeMulVectorCode + (rationalTransposeMulVectorCanonicalWord A v) = + rationalFiniteVectorCode (rationalTransposeMulVector A v) := by + rw [machineRationalTransposeMulVectorCode, + machineRationalTransposeMulVectorReversedCode_encode, + machineListReverse_encode, List.reverse_reverse] + rfl + +theorem rationalTransposeMulVector_eq_pulledBack {d : ℕ} + (E : RationalEllipsoidState d) (a : Fin d → ℚ) : + rationalTransposeMulVector E.basis a = + rationalPulledBackNormal E a := by + rfl + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalUnary.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalUnary.lean new file mode 100644 index 0000000000..6815d9463d --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalUnary.lean @@ -0,0 +1,178 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalArithmetic +import LeanPool.BeyondBethe.BeyondBethe.RawRationalBitBounds + +/-! +# Polynomial-time rational negation, inversion, and division + +The reciprocal machine handles zero explicitly and otherwise swaps the +positive denominator with the absolute numerator while preserving the +numerator sign. Division is multiplication by this verified reciprocal. +-/ + +namespace BeyondBethe + +open Complexity + +def machineRawRatNegCode (word : List Bool) : List Bool := + pair (machineIntegerNegCode (machinePairFirst word)) + (machinePairSecond word) + +def machineRawRatInvNonzeroCode (word : List Bool) : List Bool := + pair + (machineCanonicalIntegerFromSignedAbs + (pair (machineHeadBit (machinePairFirst word)) + (machinePairSecond word))) + (machineIntegerNatAbsBits (machinePairFirst word)) + +def machineRawRatInvCode (word : List Bool) : List Bool := + machineIfEmpty (machineIntegerNatAbsBits (machinePairFirst word)) + (pair [false] [true]) (machineRawRatInvNonzeroCode word) + +def machineRawRatDivCode (word : List Bool) : List Bool := + machineRawRatMulCode + (pair (machinePairFirst word) + (machineRawRatInvCode (machinePairSecond word))) + +def machineRationalNegCode (word : List Bool) : List Bool := + machineNormalizeRawRatBinaryCode (machineRawRatNegCode word) + +def machineRationalInvCode (word : List Bool) : List Bool := + machineNormalizeRawRatBinaryCode (machineRawRatInvCode word) + +def machineRationalDivCode (word : List Bool) : List Bool := + machineNormalizeRawRatBinaryCode (machineRawRatDivCode word) + +theorem machineRawRatNegCode_mem_FP : machineRawRatNegCode ∈ Complexity.FP := by + have hnum := machineCompose_mem_FP machinePairFirst_mem_FP + machineIntegerNegCode_mem_FP + exact machinePair_mem_FP hnum machinePairSecond_mem_FP + +theorem machineRawRatInvNonzeroCode_mem_FP : + machineRawRatInvNonzeroCode ∈ Complexity.FP := by + have hsign := machineCompose_mem_FP machinePairFirst_mem_FP + machineHeadBit_mem_FP + have hsigned := machinePair_mem_FP hsign machinePairSecond_mem_FP + have hnum := machineCompose_mem_FP hsigned + machineCanonicalIntegerFromSignedAbs_mem_FP + have habs := machineCompose_mem_FP machinePairFirst_mem_FP + machineIntegerNatAbsBits_mem_FP + exact machinePair_mem_FP hnum habs + +theorem machineRawRatInvCode_mem_FP : machineRawRatInvCode ∈ Complexity.FP := by + have habs := machineCompose_mem_FP machinePairFirst_mem_FP + machineIntegerNatAbsBits_mem_FP + exact machineIfEmpty_mem_FP habs + (machineConst_mem_FP (pair [false] [true])) + machineRawRatInvNonzeroCode_mem_FP + +theorem machineRawRatDivCode_mem_FP : machineRawRatDivCode ∈ Complexity.FP := by + have hinv := machineCompose_mem_FP machinePairSecond_mem_FP + machineRawRatInvCode_mem_FP + have hpair := machinePair_mem_FP machinePairFirst_mem_FP hinv + simpa only [machineRawRatDivCode] using + machineCompose_mem_FP hpair machineRawRatMulCode_mem_FP + +theorem machineRationalNegCode_mem_FP : machineRationalNegCode ∈ Complexity.FP := by + simpa only [machineRationalNegCode] using + machineCompose_mem_FP machineRawRatNegCode_mem_FP + machineNormalizeRawRatBinaryCode_mem_FP + +theorem machineRationalInvCode_mem_FP : machineRationalInvCode ∈ Complexity.FP := by + simpa only [machineRationalInvCode] using + machineCompose_mem_FP machineRawRatInvCode_mem_FP + machineNormalizeRawRatBinaryCode_mem_FP + +theorem machineRationalDivCode_mem_FP : machineRationalDivCode ∈ Complexity.FP := by + simpa only [machineRationalDivCode] using + machineCompose_mem_FP machineRawRatDivCode_mem_FP + machineNormalizeRawRatBinaryCode_mem_FP + +theorem machineRawRatNegCode_encode (q : RawRat) : + machineRawRatNegCode (rawRatBinaryCode q) = rawRatBinaryCode q.neg := by + simp [machineRawRatNegCode, rawRatBinaryCode, + machineIntegerNegCode_encode, RawRat.neg] + +theorem machineRawRatInvNonzeroCode_encode (q : RawRat) (hq : q.num ≠ 0) : + machineRawRatInvNonzeroCode (rawRatBinaryCode q) = + rawRatBinaryCode q.inv := by + rcases q with ⟨num, den, hden⟩ + cases num with + | ofNat n => + cases n with + | zero => contradiction + | succ n => + simp only [machineRawRatInvNonzeroCode, rawRatBinaryCode, + machinePairFirst_pair, machinePairSecond_pair, + machineHeadBit_cons, machineIntegerNatAbsBits_encode, + RawRat.inv] + change pair + (machineCanonicalIntegerFromSignedAbs (pair [false] den.bits)) + (n + 1).bits = pair (integerBinaryCode (den : ℤ)) (n + 1).bits + rw [machineCanonicalIntegerFromSignedAbs_pair] + rfl + | negSucc n => + simp only [machineRawRatInvNonzeroCode, rawRatBinaryCode, + machinePairFirst_pair, machinePairSecond_pair, + machineHeadBit_cons, machineIntegerNatAbsBits_encode, + RawRat.inv] + change pair + (machineCanonicalIntegerFromSignedAbs (pair [true] den.bits)) + (n + 1).bits = pair (integerBinaryCode (-(den : ℤ))) (n + 1).bits + rw [machineCanonicalIntegerFromSignedAbs_pair] + simp [signedMagnitudeValue] + +theorem machineRawRatInvCode_encode (q : RawRat) : + machineRawRatInvCode (rawRatBinaryCode q) = rawRatBinaryCode q.inv := by + by_cases hq : q.num = 0 + · have habs : q.num.natAbs.bits = [] := by simp [hq] + rw [machineRawRatInvCode] + simp only [rawRatBinaryCode, machinePairFirst_pair, + machineIntegerNatAbsBits_encode, habs, machineIfEmpty_nil] + simp [RawRat.inv, RawRat.zero, hq, rawRatBinaryCode, + integerBinaryCode] + · have habs : q.num.natAbs.bits ≠ [] := + natBits_ne_nil_of_ne_zero (Int.natAbs_ne_zero.mpr hq) + rw [machineRawRatInvCode] + simp only [rawRatBinaryCode, machinePairFirst_pair, + machineIntegerNatAbsBits_encode] + rw [machineIfEmpty_of_ne_nil q.num.natAbs.bits + (pair [false] [true]) + (machineRawRatInvNonzeroCode + (pair (integerBinaryCode q.num) q.den.bits)) habs] + simpa only [rawRatBinaryCode] using + machineRawRatInvNonzeroCode_encode q hq + +theorem machineRawRatDivCode_encode (q r : RawRat) : + machineRawRatDivCode + (pair (rawRatBinaryCode q) (rawRatBinaryCode r)) = + rawRatBinaryCode (q.div r) := by + rw [machineRawRatDivCode] + simp only [machinePairFirst_pair, machinePairSecond_pair, + machineRawRatInvCode_encode, machineRawRatMulCode_encode, RawRat.div] + +theorem machineRationalNegCode_encode (q : RawRat) : + machineRationalNegCode (rawRatBinaryCode q) = + rationalBinaryCode (binaryNormalizeRawRat q.neg) := by + rw [machineRationalNegCode, machineRawRatNegCode_encode, + machineNormalizeRawRatBinaryCode_encode] + +theorem machineRationalInvCode_encode (q : RawRat) : + machineRationalInvCode (rawRatBinaryCode q) = + rationalBinaryCode (binaryNormalizeRawRat q.inv) := by + rw [machineRationalInvCode, machineRawRatInvCode_encode, + machineNormalizeRawRatBinaryCode_encode] + +theorem machineRationalDivCode_encode (q r : RawRat) : + machineRationalDivCode + (pair (rawRatBinaryCode q) (rawRatBinaryCode r)) = + rationalBinaryCode (binaryNormalizeRawRat (q.div r)) := by + rw [machineRationalDivCode, machineRawRatDivCode_encode, + machineNormalizeRawRatBinaryCode_encode] + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalVectorDot.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalVectorDot.lean new file mode 100644 index 0000000000..64fe5d241e --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalVectorDot.lean @@ -0,0 +1,679 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalVectorSum +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalEllipsoidEncoding + +/-! +# Polynomial-time dot products of rational vectors + +The central ellipsoid update repeatedly forms rational dot products. This +module implements the basic operation directly on two right-nested lists of +canonical rational entries. The accumulator is an unreduced rational. A +quadratic clamp makes the transducer polynomially bounded on every bitstring; +the semantic invariant proves that the clamp is inactive on canonical vector +inputs. +-/ + +namespace BeyondBethe + +open Complexity + +def machineRationalVectorDotPack + (left right acc bound : List Bool) : List Bool := + pair left (pair right (pair acc bound)) + +def machineRationalVectorDotLeft (state : List Bool) : List Bool := + machinePairFirst state + +def machineRationalVectorDotRight (state : List Bool) : List Bool := + machinePairFirst (machinePairSecond state) + +def machineRationalVectorDotAcc (state : List Bool) : List Bool := + machinePairFirst (machinePairSecond (machinePairSecond state)) + +def machineRationalVectorDotBound (state : List Bool) : List Bool := + machinePairSecond (machinePairSecond (machinePairSecond state)) + +def machineRationalVectorDotLeftEntry (state : List Bool) : List Bool := + machineListHead (machineRationalVectorDotLeft state) + +def machineRationalVectorDotRightEntry (state : List Bool) : List Bool := + machineListHead (machineRationalVectorDotRight state) + +def machineRationalVectorDotProduct (state : List Bool) : List Bool := + machineRawRatMulCode + (pair (machineRationalVectorDotLeftEntry state) + (machineRationalVectorDotRightEntry state)) + +def machineRationalVectorDotCandidate (state : List Bool) : List Bool := + machineRawRatAddCode + (pair (machineRationalVectorDotAcc state) + (machineRationalVectorDotProduct state)) + +def machineRationalVectorDotNextAcc (state : List Bool) : List Bool := + (machineRationalVectorDotCandidate state).take + (machineRationalVectorDotBound state).length + +def machineRationalVectorDotAdvance (state : List Bool) : List Bool := + machineRationalVectorDotPack + (machineListTail (machineRationalVectorDotLeft state)) + (machineListTail (machineRationalVectorDotRight state)) + (machineRationalVectorDotNextAcc state) + (machineRationalVectorDotBound state) + +/-- Stop as soon as either input list is exhausted. -/ +def machineRationalVectorDotStep (state : List Bool) : List Bool := + machineIfEmpty (machineRationalVectorDotLeft state) state + (machineIfEmpty (machineRationalVectorDotRight state) state + (machineRationalVectorDotAdvance state)) + +def machineRationalVectorDotInputBound (word : List Bool) : List Bool := + machineBinaryMulWidth word + +def machineRationalVectorDotInit (word : List Bool) : List Bool := + machineRationalVectorDotPack (machinePairFirst word) + (machinePairSecond word) (rawRatBinaryCode RawRat.zero) + (machineRationalVectorDotInputBound word) + +def machineRationalVectorDotWidth (word : List Bool) : List Bool := + let bound := machineRationalVectorDotInputBound word + machineRationalVectorDotPack word word bound bound + +def machineRationalVectorDotFinalState (word : List Bool) : List Bool := + (machineRationalVectorDotStep)^[word.length] + (machineRationalVectorDotInit word) + +/-- Unreduced rational code of the dot product. -/ +def machineRationalVectorDotRawCode (word : List Bool) : List Bool := + machineRationalVectorDotAcc + (machineRationalVectorDotFinalState word) + +/-- Canonical rational-entry code of the dot product. -/ +def machineRationalVectorDotEntryCode (word : List Bool) : List Bool := + machineNormalizeRawRatEntryCode + (machineRationalVectorDotRawCode word) + +theorem machineRationalVectorDotLeft_mem_FP : + machineRationalVectorDotLeft ∈ FP := machinePairFirst_mem_FP + +theorem machineRationalVectorDotRight_mem_FP : + machineRationalVectorDotRight ∈ FP := by + simpa only [machineRationalVectorDotRight] using + machineCompose_mem_FP machinePairSecond_mem_FP machinePairFirst_mem_FP + +theorem machineRationalVectorDotAcc_mem_FP : + machineRationalVectorDotAcc ∈ FP := by + simpa only [machineRationalVectorDotAcc] using + machineCompose_mem_FP + (machineCompose_mem_FP machinePairSecond_mem_FP + machinePairSecond_mem_FP) + machinePairFirst_mem_FP + +theorem machineRationalVectorDotBound_mem_FP : + machineRationalVectorDotBound ∈ FP := by + simpa only [machineRationalVectorDotBound] using + machineCompose_mem_FP + (machineCompose_mem_FP machinePairSecond_mem_FP + machinePairSecond_mem_FP) + machinePairSecond_mem_FP + +theorem machineRationalVectorDotLeftEntry_mem_FP : + machineRationalVectorDotLeftEntry ∈ FP := by + simpa only [machineRationalVectorDotLeftEntry] using + machineCompose_mem_FP machineRationalVectorDotLeft_mem_FP + machineListHead_mem_FP + +theorem machineRationalVectorDotRightEntry_mem_FP : + machineRationalVectorDotRightEntry ∈ FP := by + simpa only [machineRationalVectorDotRightEntry] using + machineCompose_mem_FP machineRationalVectorDotRight_mem_FP + machineListHead_mem_FP + +theorem machineRationalVectorDotProduct_mem_FP : + machineRationalVectorDotProduct ∈ FP := by + have hp := machinePair_mem_FP machineRationalVectorDotLeftEntry_mem_FP + machineRationalVectorDotRightEntry_mem_FP + simpa only [machineRationalVectorDotProduct] using + machineCompose_mem_FP hp machineRawRatMulCode_mem_FP + +theorem machineRationalVectorDotCandidate_mem_FP : + machineRationalVectorDotCandidate ∈ FP := by + have hp := machinePair_mem_FP machineRationalVectorDotAcc_mem_FP + machineRationalVectorDotProduct_mem_FP + simpa only [machineRationalVectorDotCandidate] using + machineCompose_mem_FP hp machineRawRatAddCode_mem_FP + +theorem machineRationalVectorDotNextAcc_mem_FP : + machineRationalVectorDotNextAcc ∈ FP := by + simpa only [machineRationalVectorDotNextAcc] using + machineTake_mem_FP machineRationalVectorDotBound_mem_FP + machineRationalVectorDotCandidate_mem_FP + +theorem machineRationalVectorDotAdvance_mem_FP : + machineRationalVectorDotAdvance ∈ FP := by + have hl := machineCompose_mem_FP machineRationalVectorDotLeft_mem_FP + machineListTail_mem_FP + have hr := machineCompose_mem_FP machineRationalVectorDotRight_mem_FP + machineListTail_mem_FP + exact machinePair_mem_FP hl + (machinePair_mem_FP hr + (machinePair_mem_FP machineRationalVectorDotNextAcc_mem_FP + machineRationalVectorDotBound_mem_FP)) + +theorem machineRationalVectorDotStep_mem_FP : + machineRationalVectorDotStep ∈ FP := by + have hinner := machineIfEmpty_mem_FP + machineRationalVectorDotRight_mem_FP id_mem_FP + machineRationalVectorDotAdvance_mem_FP + exact machineIfEmpty_mem_FP machineRationalVectorDotLeft_mem_FP + id_mem_FP hinner + +theorem machineRationalVectorDotInputBound_mem_FP : + machineRationalVectorDotInputBound ∈ FP := + machineBinaryMulWidth_mem_FP + +theorem machineRationalVectorDotInit_mem_FP : + machineRationalVectorDotInit ∈ FP := by + exact machinePair_mem_FP machinePairFirst_mem_FP + (machinePair_mem_FP machinePairSecond_mem_FP + (machinePair_mem_FP + (machineConst_mem_FP (rawRatBinaryCode RawRat.zero)) + machineRationalVectorDotInputBound_mem_FP)) + +theorem machineRationalVectorDotWidth_mem_FP : + machineRationalVectorDotWidth ∈ FP := by + exact machinePair_mem_FP id_mem_FP + (machinePair_mem_FP id_mem_FP + (machinePair_mem_FP machineRationalVectorDotInputBound_mem_FP + machineRationalVectorDotInputBound_mem_FP)) + +@[simp] theorem machineRationalVectorDotLeft_pack (left right acc bound) : + machineRationalVectorDotLeft + (machineRationalVectorDotPack left right acc bound) = left := by + simp [machineRationalVectorDotLeft, machineRationalVectorDotPack] + +@[simp] theorem machineRationalVectorDotRight_pack (left right acc bound) : + machineRationalVectorDotRight + (machineRationalVectorDotPack left right acc bound) = right := by + simp [machineRationalVectorDotRight, machineRationalVectorDotPack] + +@[simp] theorem machineRationalVectorDotAcc_pack (left right acc bound) : + machineRationalVectorDotAcc + (machineRationalVectorDotPack left right acc bound) = acc := by + simp [machineRationalVectorDotAcc, machineRationalVectorDotPack] + +@[simp] theorem machineRationalVectorDotBound_pack (left right acc bound) : + machineRationalVectorDotBound + (machineRationalVectorDotPack left right acc bound) = bound := by + simp [machineRationalVectorDotBound, machineRationalVectorDotPack] + +def MachineRationalVectorDotStateBound + (word state : List Bool) : Prop := + state = machineRationalVectorDotPack + (machineRationalVectorDotLeft state) + (machineRationalVectorDotRight state) + (machineRationalVectorDotAcc state) + (machineRationalVectorDotBound state) ∧ + (machineRationalVectorDotLeft state).length ≤ word.length ∧ + (machineRationalVectorDotRight state).length ≤ word.length ∧ + (machineRationalVectorDotAcc state).length ≤ + (machineRationalVectorDotInputBound word).length ∧ + machineRationalVectorDotBound state = + machineRationalVectorDotInputBound word + +theorem machineRationalVectorDotInit_bound (word : List Bool) : + MachineRationalVectorDotStateBound word + (machineRationalVectorDotInit word) := by + simp only [MachineRationalVectorDotStateBound, + machineRationalVectorDotInit, machineRationalVectorDotLeft_pack, + machineRationalVectorDotRight_pack, machineRationalVectorDotAcc_pack, + machineRationalVectorDotBound_pack] + refine ⟨trivial, machinePairFirst_length_le word, + machinePairSecond_length_le word, ?_, trivial⟩ + simp [machineRationalVectorDotInputBound, machineBinaryMulWidth, + rawRatBinaryCode, RawRat.zero, integerBinaryCode] + nlinarith [sq_nonneg (word.length + 16)] + +theorem machineRationalVectorDotStep_bound {word state : List Bool} + (hs : MachineRationalVectorDotStateBound word state) : + MachineRationalVectorDotStateBound word + (machineRationalVectorDotStep state) := by + rcases hs with ⟨hdecomp, hl, hr, hacc, hbound⟩ + by_cases hleft : machineRationalVectorDotLeft state = [] + · rw [machineRationalVectorDotStep, hleft, machineIfEmpty_nil] + exact ⟨hdecomp, hl, hr, hacc, hbound⟩ + · rw [machineRationalVectorDotStep] + cases hleftCode : machineRationalVectorDotLeft state with + | nil => exact False.elim (hleft hleftCode) + | cons bit tail => + rw [machineIfEmpty_cons] + by_cases hright : machineRationalVectorDotRight state = [] + · rw [hright, machineIfEmpty_nil] + exact ⟨hdecomp, hl, hr, hacc, hbound⟩ + · cases hrightCode : machineRationalVectorDotRight state with + | nil => exact False.elim (hright hrightCode) + | cons bit' tail' => + rw [machineIfEmpty_cons, + machineRationalVectorDotAdvance] + simp only [MachineRationalVectorDotStateBound, + machineRationalVectorDotLeft_pack, + machineRationalVectorDotRight_pack, + machineRationalVectorDotAcc_pack, + machineRationalVectorDotBound_pack] + refine ⟨trivial, ?_, ?_, ?_, hbound⟩ + · exact (machineListTail_length_le + (machineRationalVectorDotLeft state)).trans hl + · exact (machineListTail_length_le + (machineRationalVectorDotRight state)).trans hr + · rw [machineRationalVectorDotNextAcc, hbound] + exact List.length_take_le _ _ + +theorem machineRationalVectorDotIterate_bound + (word : List Bool) : ∀ k, + MachineRationalVectorDotStateBound word + ((machineRationalVectorDotStep)^[k] + (machineRationalVectorDotInit word)) := by + intro k + induction k with + | zero => exact machineRationalVectorDotInit_bound word + | succ k ih => + rw [Function.iterate_succ_apply'] + exact machineRationalVectorDotStep_bound ih + +theorem machineRationalVectorDotIterate_length_le_width + (word : List Bool) (iterations : ℕ) + (_ : iterations ≤ word.length) : + ((machineRationalVectorDotStep)^[iterations] + (machineRationalVectorDotInit word)).length ≤ + (machineRationalVectorDotWidth word).length := by + rcases machineRationalVectorDotIterate_bound word iterations with + ⟨hdecomp, hl, hr, hacc, hbound⟩ + rw [hdecomp, hbound] + simp only [machineRationalVectorDotPack, + machineRationalVectorDotWidth, pair_length] + omega + +theorem machineRationalVectorDotFinalState_mem_FP : + machineRationalVectorDotFinalState ∈ FP := by + exact Cobham.iterate_mem_FP machineRationalVectorDotStep_mem_FP + machineRationalVectorDotInit_mem_FP id_mem_FP + machineRationalVectorDotWidth_mem_FP + machineRationalVectorDotIterate_length_le_width + +theorem machineRationalVectorDotRawCode_mem_FP : + machineRationalVectorDotRawCode ∈ FP := by + simpa only [machineRationalVectorDotRawCode] using + machineCompose_mem_FP machineRationalVectorDotFinalState_mem_FP + machineRationalVectorDotAcc_mem_FP + +theorem machineRationalVectorDotEntryCode_mem_FP : + machineRationalVectorDotEntryCode ∈ FP := by + simpa only [machineRationalVectorDotEntryCode] using + machineCompose_mem_FP machineRationalVectorDotRawCode_mem_FP + machineNormalizeRawRatEntryCode_mem_FP + +/-! ## Exact semantics -/ + +def rawRatListDotCost : List ℚ → List ℚ → ℕ + | q :: qs, r :: rs => + rawRatWidth (rawRatOfRat q) + rawRatWidth (rawRatOfRat r) + 2 + + rawRatListDotCost qs rs + | _, _ => 0 + +def rawRatListDot : RawRat → List ℚ → List ℚ → RawRat + | acc, q :: qs, r :: rs => + rawRatListDot + (acc.add ((rawRatOfRat q).mul (rawRatOfRat r))) qs rs + | acc, _, _ => acc + +theorem rawRatWidth_listDot_le (acc : RawRat) : ∀ xs ys, + rawRatWidth (rawRatListDot acc xs ys) ≤ + rawRatWidth acc + rawRatListDotCost xs ys := by + intro xs + induction xs generalizing acc with + | nil => intro ys; simp [rawRatListDot, rawRatListDotCost] + | cons q qs ih => + intro ys + cases ys with + | nil => simp [rawRatListDot, rawRatListDotCost] + | cons r rs => + rw [rawRatListDot, rawRatListDotCost] + have hmul := rawRatWidth_mul_le + (rawRatOfRat q) (rawRatOfRat r) + have hadd := rawRatWidth_add_le acc + ((rawRatOfRat q).mul (rawRatOfRat r)) + have htail := ih + (acc.add ((rawRatOfRat q).mul (rawRatOfRat r))) rs + omega + +theorem rawRatListDotCost_le_codeLength : ∀ xs ys : List ℚ, + rawRatListDotCost xs ys ≤ + (binaryListCode rationalEntryBinaryCode xs).length + + (binaryListCode rationalEntryBinaryCode ys).length := by + intro xs + induction xs with + | nil => intro ys; simp [rawRatListDotCost] + | cons q qs ih => + intro ys + cases ys with + | nil => simp [rawRatListDotCost] + | cons r rs => + rw [rawRatListDotCost, binaryListCode, binaryListCode, + pair_length, pair_length] + have hq : rawRatWidth (rawRatOfRat q) ≤ + (rationalEntryBinaryCode q).length := by + rw [← rawRatBinaryCode_rawRatOfRat] + exact rawRatWidth_le_binaryCode_length _ + have hr : rawRatWidth (rawRatOfRat r) ≤ + (rationalEntryBinaryCode r).length := by + rw [← rawRatBinaryCode_rawRatOfRat] + exact rawRatWidth_le_binaryCode_length _ + have htail := ih rs + omega + +structure RationalVectorDotSemState where + left : List ℚ + right : List ℚ + acc : RawRat + +def rationalVectorDotSemStep + (s : RationalVectorDotSemState) : RationalVectorDotSemState := + match s.left, s.right with + | q :: qs, r :: rs => + ⟨qs, rs, s.acc.add ((rawRatOfRat q).mul (rawRatOfRat r))⟩ + | _, _ => s + +def rationalVectorDotSemCode (bound : List Bool) + (s : RationalVectorDotSemState) : List Bool := + machineRationalVectorDotPack + (binaryListCode rationalEntryBinaryCode s.left) + (binaryListCode rationalEntryBinaryCode s.right) + (rawRatBinaryCode s.acc) bound + +def RationalVectorDotSemInvariant (budget : ℕ) + (s : RationalVectorDotSemState) : Prop := + rawRatWidth s.acc + rawRatListDotCost s.left s.right ≤ budget + +theorem rationalVectorDotSemStep_invariant {budget : ℕ} + {s : RationalVectorDotSemState} + (hs : RationalVectorDotSemInvariant budget s) : + RationalVectorDotSemInvariant budget + (rationalVectorDotSemStep s) := by + rcases s with ⟨left, right, acc⟩ + cases left with + | nil => exact hs + | cons q qs => + cases right with + | nil => exact hs + | cons r rs => + have hmul := rawRatWidth_mul_le + (rawRatOfRat q) (rawRatOfRat r) + have hadd := rawRatWidth_add_le acc + ((rawRatOfRat q).mul (rawRatOfRat r)) + simp only [RationalVectorDotSemInvariant, + rationalVectorDotSemStep, rawRatListDotCost] at hs ⊢ + omega + +theorem rationalVectorDotBound_large (word : List Bool) : + 4 + 3 * (1 + word.length) ≤ + (machineRationalVectorDotInputBound word).length := by + simp only [machineRationalVectorDotInputBound, + machineBinaryMulWidth, List.length_replicate, List.length_append] + nlinarith + +theorem machineRationalVectorDotStep_semantics + (word : List Bool) (s : RationalVectorDotSemState) + (hs : RationalVectorDotSemInvariant (1 + word.length) s) : + machineRationalVectorDotStep + (rationalVectorDotSemCode + (machineRationalVectorDotInputBound word) s) = + rationalVectorDotSemCode + (machineRationalVectorDotInputBound word) + (rationalVectorDotSemStep s) := by + rcases s with ⟨left, right, acc⟩ + cases left with + | nil => + simp [rationalVectorDotSemCode, rationalVectorDotSemStep, + machineRationalVectorDotStep, binaryListCode] + | cons q qs => + cases right with + | nil => + rw [rationalVectorDotSemCode, rationalVectorDotSemStep, + machineRationalVectorDotStep] + simp only [machineRationalVectorDotLeft_pack] + rw [machineIfEmpty_of_ne_nil_matrix _ _ _ + (binaryListCode_cons_ne_nil rationalEntryBinaryCode q qs)] + simp [binaryListCode, rationalVectorDotSemCode] + | cons r rs => + have hnext : + rawRatWidth + (acc.add ((rawRatOfRat q).mul (rawRatOfRat r))) ≤ + 1 + word.length := by + have hinv := rationalVectorDotSemStep_invariant hs + have hinv' : rawRatWidth + (acc.add ((rawRatOfRat q).mul (rawRatOfRat r))) + + rawRatListDotCost qs rs ≤ 1 + word.length := by + simpa only [RationalVectorDotSemInvariant, + rationalVectorDotSemStep, rawRatListDotCost, + Nat.add_zero] using hinv + omega + have hcode : + (rawRatBinaryCode + (acc.add ((rawRatOfRat q).mul + (rawRatOfRat r)))).length ≤ + (machineRationalVectorDotInputBound word).length := + (rawRatBinaryCode_length_le_width _).trans + ((Nat.add_le_add_left (Nat.mul_le_mul_left 3 hnext) 4).trans + (rationalVectorDotBound_large word)) + rw [rationalVectorDotSemCode, rationalVectorDotSemStep, + machineRationalVectorDotStep] + simp only [machineRationalVectorDotLeft_pack] + rw [machineIfEmpty_of_ne_nil_matrix _ _ _ + (binaryListCode_cons_ne_nil rationalEntryBinaryCode q qs)] + simp only [machineRationalVectorDotRight_pack] + rw [machineIfEmpty_of_ne_nil_matrix _ _ _ + (binaryListCode_cons_ne_nil rationalEntryBinaryCode r rs)] + simp only [machineRationalVectorDotAdvance, + machineRationalVectorDotLeft_pack, + machineRationalVectorDotRight_pack, + machineRationalVectorDotAcc_pack, + machineRationalVectorDotBound_pack, + machineListTail_cons, machineRationalVectorDotNextAcc, + machineRationalVectorDotCandidate, + machineRationalVectorDotProduct, + machineRationalVectorDotLeftEntry, + machineRationalVectorDotRightEntry, machineListHead_cons] + rw [← rawRatBinaryCode_rawRatOfRat q, + ← rawRatBinaryCode_rawRatOfRat r, + machineRawRatMulCode_encode, + machineRawRatAddCode_encode, + (List.take_eq_self_iff _).mpr hcode] + rfl + +theorem machineRationalVectorDotIterate_semantics + (word : List Bool) (s : RationalVectorDotSemState) + (hs : RationalVectorDotSemInvariant (1 + word.length) s) : ∀ k, + (machineRationalVectorDotStep)^[k] + (rationalVectorDotSemCode + (machineRationalVectorDotInputBound word) s) = + rationalVectorDotSemCode + (machineRationalVectorDotInputBound word) + ((rationalVectorDotSemStep)^[k] s) := by + intro k + have hinv : ∀ t : ℕ, + RationalVectorDotSemInvariant (1 + word.length) + ((rationalVectorDotSemStep)^[t] s) := by + intro t + induction t with + | zero => exact hs + | succ t iht => + rw [Function.iterate_succ_apply'] + exact rationalVectorDotSemStep_invariant iht + induction k with + | zero => rfl + | succ k ih => + rw [Function.iterate_succ_apply', Function.iterate_succ_apply', ih] + exact machineRationalVectorDotStep_semantics word _ (hinv k) + +theorem rationalVectorDotSem_process : ∀ (xs ys : List ℚ) + (acc : RawRat), xs.length = ys.length → + (rationalVectorDotSemStep)^[xs.length] + ⟨xs, ys, acc⟩ = ⟨[], [], rawRatListDot acc xs ys⟩ := by + intro xs + induction xs with + | nil => + intro ys acc hlen + cases ys with + | nil => rfl + | cons r rs => simp at hlen + | cons q qs ih => + intro ys acc hlen + cases ys with + | nil => simp at hlen + | cons r rs => + rw [List.length_cons, Function.iterate_succ_apply, + rationalVectorDotSemStep, ih] + · rfl + · simpa using Nat.succ.inj hlen + +theorem rationalVectorDotSem_done_iterate + (extra : ℕ) (acc : RawRat) : + (rationalVectorDotSemStep)^[extra] + ⟨[], [], acc⟩ = ⟨[], [], acc⟩ := by + induction extra with + | zero => rfl + | succ k ih => + rw [Function.iterate_succ_apply', ih] + rfl + +theorem machineRationalVectorDot_done_iterate + (extra : ℕ) (acc : RawRat) (bound : List Bool) : + (machineRationalVectorDotStep)^[extra] + (machineRationalVectorDotPack [] [] + (rawRatBinaryCode acc) bound) = + machineRationalVectorDotPack [] [] + (rawRatBinaryCode acc) bound := by + induction extra with + | zero => rfl + | succ k ih => + rw [Function.iterate_succ_apply', ih] + simp [machineRationalVectorDotStep] + +theorem machineRationalVectorDotFinalState_encode {n : ℕ} + (v w : Fin n → ℚ) : + let word := pair (rationalFiniteVectorCode v) + (rationalFiniteVectorCode w) + machineRationalVectorDotFinalState word = + machineRationalVectorDotPack [] [] + (rawRatBinaryCode + (rawRatListDot RawRat.zero (List.ofFn v) (List.ofFn w))) + (machineRationalVectorDotInputBound word) := by + let left := List.ofFn v + let right := List.ofFn w + let word := pair (rationalFiniteVectorCode v) + (rationalFiniteVectorCode w) + let s : RationalVectorDotSemState := ⟨left, right, RawRat.zero⟩ + have hleftCode : + (binaryListCode rationalEntryBinaryCode left).length ≤ + word.length := by + calc + _ = (machinePairFirst word).length := by + simp [word, left, rationalFiniteVectorCode] + _ ≤ word.length := machinePairFirst_length_le word + have hrightCode : + (binaryListCode rationalEntryBinaryCode right).length ≤ + word.length := by + calc + _ = (machinePairSecond word).length := by + simp [word, right, rationalFiniteVectorCode] + _ ≤ word.length := machinePairSecond_length_le word + have hinv : RationalVectorDotSemInvariant (1 + word.length) s := by + simp only [RationalVectorDotSemInvariant, s, + rawRatWidth_zero] + have hcost := rawRatListDotCost_le_codeLength left right + have hcodes : + (binaryListCode rationalEntryBinaryCode left).length + + (binaryListCode rationalEntryBinaryCode right).length ≤ + word.length := by + simp only [word, rationalFiniteVectorCode, left, right, pair_length] + omega + omega + have hn : n ≤ word.length := by + have hlist := list_length_le_binaryListCode_length + rationalEntryBinaryCode left + simpa only [left, List.length_ofFn] using hlist.trans hleftCode + have hsplit : word.length = (word.length - n) + n := by omega + have hinit : machineRationalVectorDotInit word = + rationalVectorDotSemCode + (machineRationalVectorDotInputBound word) s := by + simp [machineRationalVectorDotInit, rationalVectorDotSemCode, + s, word, left, right, rationalFiniteVectorCode] + have hprocess : + (rationalVectorDotSemStep)^[n] s = + ⟨[], [], rawRatListDot RawRat.zero left right⟩ := by + simpa [s, left, right] using + (rationalVectorDotSem_process left right RawRat.zero + (by simp [left, right])) + change machineRationalVectorDotFinalState word = _ + rw [machineRationalVectorDotFinalState, hsplit, + Function.iterate_add_apply, hinit, + machineRationalVectorDotIterate_semantics word s hinv, hprocess] + simp only [rationalVectorDotSemCode, binaryListCode] + rw [machineRationalVectorDot_done_iterate] + +@[simp] theorem machineRationalVectorDotRawCode_encode {n : ℕ} + (v w : Fin n → ℚ) : + machineRationalVectorDotRawCode + (pair (rationalFiniteVectorCode v) + (rationalFiniteVectorCode w)) = + rawRatBinaryCode + (rawRatListDot RawRat.zero (List.ofFn v) (List.ofFn w)) := by + rw [machineRationalVectorDotRawCode, + machineRationalVectorDotFinalState_encode] + simp + +theorem rawRatListDot_value (acc : RawRat) : ∀ xs ys : List ℚ, + (rawRatListDot acc xs ys).value = + acc.value + (List.zipWith (fun q r : ℚ => q * r) xs ys).sum := by + intro xs ys + induction xs generalizing acc ys with + | nil => simp [rawRatListDot] + | cons q qs ih => + cases ys with + | nil => simp [rawRatListDot] + | cons r rs => + rw [rawRatListDot, ih] + simp [RawRat.value_add, RawRat.value_mul, + rawRatOfRat_value, add_assoc] + +theorem rawRatListDot_ofFn_value {n : ℕ} (v w : Fin n → ℚ) : + (rawRatListDot RawRat.zero (List.ofFn v) (List.ofFn w)).value = + ∑ i, v i * w i := by + rw [rawRatListDot_value, RawRat.value_zero, zero_add] + have hzip : + List.zipWith (fun q r : ℚ => q * r) + (List.ofFn v) (List.ofFn w) = + List.ofFn (fun i : Fin n => v i * w i) := by + apply List.ext_getElem + · simp + · intro i hiLeft hiRight + simp + rw [hzip, List.sum_ofFn] + +@[simp] theorem machineRationalVectorDotEntryCode_encode {n : ℕ} + (v w : Fin n → ℚ) : + machineRationalVectorDotEntryCode + (pair (rationalFiniteVectorCode v) + (rationalFiniteVectorCode w)) = + rationalEntryBinaryCode (∑ i, v i * w i) := by + rw [machineRationalVectorDotEntryCode, + machineRationalVectorDotRawCode_encode, + machineNormalizeRawRatEntryCode_encode, + binaryNormalizeRawRat_eq_value, + rawRatListDot_ofFn_value] + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalVectorL1.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalVectorL1.lean new file mode 100644 index 0000000000..47cf31ddfa --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalVectorL1.lean @@ -0,0 +1,553 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalVectorSum +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalEllipsoidEncoding + +/-! +# Polynomial-time rational `ℓ1` norms + +The rational ellipsoid update normalizes a pulled-back cut by +`sum i, |b i|`. This module implements that quantity directly on the +right-nested finite-word encoding of a rational vector. The accumulator is +an unreduced rational. As in the other rational folds, a quadratic clamp +makes the transducer polynomially bounded on malformed words, while the +semantic invariant proves that the clamp is inactive on canonical inputs. +-/ + +namespace BeyondBethe + +open Complexity + +namespace RawRat + +/-- Replace the signed numerator by its absolute value without changing the +positive denominator. -/ +def magnitude (q : RawRat) : RawRat := + ⟨Int.ofNat q.num.natAbs, q.den, q.den_pos⟩ + +@[simp] theorem magnitude_value (q : RawRat) : + q.magnitude.value = abs q.value := by + rcases q with ⟨num, den, hden⟩ + cases num with + | ofNat n => + have hdenQ : (0 : ℚ) < den := by exact_mod_cast hden + simp [magnitude, value, abs_div, abs_of_pos hdenQ] + | negSucc n => + have hdenQ : (0 : ℚ) < den := by exact_mod_cast hden + simp only [magnitude, value, Int.natAbs_negSucc, Int.cast_ofNat, + Int.cast_negSucc, Nat.cast_add, Nat.cast_one, abs_div, + abs_of_pos hdenQ] + rw [abs_neg, abs_of_nonneg (by positivity : (0 : ℚ) ≤ n + 1)] + norm_num + +@[simp] theorem width_magnitude (q : RawRat) : + rawRatWidth q.magnitude = rawRatWidth q := by + rcases q with ⟨num, den, hden⟩ + cases num with + | ofNat n => simp [magnitude, rawRatWidth] + | negSucc n => + simp only [magnitude, rawRatWidth, Int.natAbs_negSucc] + simp only [Int.natAbs_ofNat'] + +end RawRat + +/-- Exact finite-word absolute value for an unreduced rational entry. -/ +def machineRawRatMagnitudeCode (word : List Bool) : List Bool := + pair + (machineCanonicalIntegerFromSignedAbs + (pair [false] + (machineIntegerNatAbsBits (machinePairFirst word)))) + (machinePairSecond word) + +theorem machineRawRatMagnitudeCode_mem_FP : + machineRawRatMagnitudeCode ∈ FP := by + have habs := machineCompose_mem_FP machinePairFirst_mem_FP + machineIntegerNatAbsBits_mem_FP + have hsigned := machinePair_mem_FP (machineConst_mem_FP [false]) habs + have hnum := machineCompose_mem_FP hsigned + machineCanonicalIntegerFromSignedAbs_mem_FP + exact machinePair_mem_FP hnum machinePairSecond_mem_FP + +@[simp] theorem machineRawRatMagnitudeCode_encode (q : RawRat) : + machineRawRatMagnitudeCode (rawRatBinaryCode q) = + rawRatBinaryCode q.magnitude := by + rw [machineRawRatMagnitudeCode, rawRatBinaryCode] + simp only [machinePairFirst_pair, machinePairSecond_pair, + machineIntegerNatAbsBits_encode, RawRat.magnitude] + rw [machineCanonicalIntegerFromSignedAbs_pair] + simp [signedMagnitudeValue, rawRatBinaryCode] + +def machineRationalVectorL1Pack + (current acc bound : List Bool) : List Bool := + pair current (pair acc bound) + +def machineRationalVectorL1Current (state : List Bool) : List Bool := + machinePairFirst state + +def machineRationalVectorL1Acc (state : List Bool) : List Bool := + machinePairFirst (machinePairSecond state) + +def machineRationalVectorL1Bound (state : List Bool) : List Bool := + machinePairSecond (machinePairSecond state) + +def machineRationalVectorL1Entry (state : List Bool) : List Bool := + machineListHead (machineRationalVectorL1Current state) + +def machineRationalVectorL1Magnitude (state : List Bool) : List Bool := + machineRawRatMagnitudeCode (machineRationalVectorL1Entry state) + +def machineRationalVectorL1Candidate (state : List Bool) : List Bool := + machineRawRatAddCode + (pair (machineRationalVectorL1Acc state) + (machineRationalVectorL1Magnitude state)) + +def machineRationalVectorL1NextAcc (state : List Bool) : List Bool := + (machineRationalVectorL1Candidate state).take + (machineRationalVectorL1Bound state).length + +def machineRationalVectorL1Advance (state : List Bool) : List Bool := + machineRationalVectorL1Pack + (machineListTail (machineRationalVectorL1Current state)) + (machineRationalVectorL1NextAcc state) + (machineRationalVectorL1Bound state) + +def machineRationalVectorL1Step (state : List Bool) : List Bool := + machineIfEmpty (machineRationalVectorL1Current state) state + (machineRationalVectorL1Advance state) + +def machineRationalVectorL1InputBound (word : List Bool) : List Bool := + machineBinaryMulWidth word + +def machineRationalVectorL1Init (word : List Bool) : List Bool := + machineRationalVectorL1Pack word (rawRatBinaryCode RawRat.zero) + (machineRationalVectorL1InputBound word) + +def machineRationalVectorL1Width (word : List Bool) : List Bool := + let bound := machineRationalVectorL1InputBound word + machineRationalVectorL1Pack word bound bound + +def machineRationalVectorL1FinalState (word : List Bool) : List Bool := + (machineRationalVectorL1Step)^[word.length] + (machineRationalVectorL1Init word) + +/-- Unreduced rational word for the exact `ℓ1` norm. -/ +def machineRationalVectorL1RawCode (word : List Bool) : List Bool := + machineRationalVectorL1Acc (machineRationalVectorL1FinalState word) + +/-- Canonical rational-entry word for the exact `ℓ1` norm. -/ +def machineRationalVectorL1EntryCode (word : List Bool) : List Bool := + machineNormalizeRawRatEntryCode (machineRationalVectorL1RawCode word) + +theorem machineRationalVectorL1Current_mem_FP : + machineRationalVectorL1Current ∈ FP := machinePairFirst_mem_FP + +theorem machineRationalVectorL1Acc_mem_FP : + machineRationalVectorL1Acc ∈ FP := by + simpa only [machineRationalVectorL1Acc] using + machineCompose_mem_FP machinePairSecond_mem_FP machinePairFirst_mem_FP + +theorem machineRationalVectorL1Bound_mem_FP : + machineRationalVectorL1Bound ∈ FP := by + simpa only [machineRationalVectorL1Bound] using + machineCompose_mem_FP machinePairSecond_mem_FP machinePairSecond_mem_FP + +theorem machineRationalVectorL1Entry_mem_FP : + machineRationalVectorL1Entry ∈ FP := by + simpa only [machineRationalVectorL1Entry] using + machineCompose_mem_FP machineRationalVectorL1Current_mem_FP + machineListHead_mem_FP + +theorem machineRationalVectorL1Magnitude_mem_FP : + machineRationalVectorL1Magnitude ∈ FP := by + simpa only [machineRationalVectorL1Magnitude] using + machineCompose_mem_FP machineRationalVectorL1Entry_mem_FP + machineRawRatMagnitudeCode_mem_FP + +theorem machineRationalVectorL1Candidate_mem_FP : + machineRationalVectorL1Candidate ∈ FP := by + have hp := machinePair_mem_FP machineRationalVectorL1Acc_mem_FP + machineRationalVectorL1Magnitude_mem_FP + simpa only [machineRationalVectorL1Candidate] using + machineCompose_mem_FP hp machineRawRatAddCode_mem_FP + +theorem machineRationalVectorL1NextAcc_mem_FP : + machineRationalVectorL1NextAcc ∈ FP := by + simpa only [machineRationalVectorL1NextAcc] using + machineTake_mem_FP machineRationalVectorL1Bound_mem_FP + machineRationalVectorL1Candidate_mem_FP + +theorem machineRationalVectorL1Advance_mem_FP : + machineRationalVectorL1Advance ∈ FP := by + have htail := machineCompose_mem_FP machineRationalVectorL1Current_mem_FP + machineListTail_mem_FP + exact machinePair_mem_FP htail + (machinePair_mem_FP machineRationalVectorL1NextAcc_mem_FP + machineRationalVectorL1Bound_mem_FP) + +theorem machineRationalVectorL1Step_mem_FP : + machineRationalVectorL1Step ∈ FP := by + exact machineIfEmpty_mem_FP machineRationalVectorL1Current_mem_FP + id_mem_FP machineRationalVectorL1Advance_mem_FP + +theorem machineRationalVectorL1InputBound_mem_FP : + machineRationalVectorL1InputBound ∈ FP := + machineBinaryMulWidth_mem_FP + +theorem machineRationalVectorL1Init_mem_FP : + machineRationalVectorL1Init ∈ FP := by + exact machinePair_mem_FP id_mem_FP + (machinePair_mem_FP + (machineConst_mem_FP (rawRatBinaryCode RawRat.zero)) + machineRationalVectorL1InputBound_mem_FP) + +theorem machineRationalVectorL1Width_mem_FP : + machineRationalVectorL1Width ∈ FP := by + exact machinePair_mem_FP id_mem_FP + (machinePair_mem_FP machineRationalVectorL1InputBound_mem_FP + machineRationalVectorL1InputBound_mem_FP) + +@[simp] theorem machineRationalVectorL1Current_pack (current acc bound) : + machineRationalVectorL1Current + (machineRationalVectorL1Pack current acc bound) = current := by + simp [machineRationalVectorL1Current, machineRationalVectorL1Pack] + +@[simp] theorem machineRationalVectorL1Acc_pack (current acc bound) : + machineRationalVectorL1Acc + (machineRationalVectorL1Pack current acc bound) = acc := by + simp [machineRationalVectorL1Acc, machineRationalVectorL1Pack] + +@[simp] theorem machineRationalVectorL1Bound_pack (current acc bound) : + machineRationalVectorL1Bound + (machineRationalVectorL1Pack current acc bound) = bound := by + simp [machineRationalVectorL1Bound, machineRationalVectorL1Pack] + +def MachineRationalVectorL1StateBound + (word state : List Bool) : Prop := + state = machineRationalVectorL1Pack + (machineRationalVectorL1Current state) + (machineRationalVectorL1Acc state) + (machineRationalVectorL1Bound state) ∧ + (machineRationalVectorL1Current state).length ≤ word.length ∧ + (machineRationalVectorL1Acc state).length ≤ + (machineRationalVectorL1InputBound word).length ∧ + machineRationalVectorL1Bound state = + machineRationalVectorL1InputBound word + +theorem machineRationalVectorL1Init_bound (word : List Bool) : + MachineRationalVectorL1StateBound word + (machineRationalVectorL1Init word) := by + simp only [MachineRationalVectorL1StateBound, + machineRationalVectorL1Init, machineRationalVectorL1Current_pack, + machineRationalVectorL1Acc_pack, machineRationalVectorL1Bound_pack] + refine ⟨trivial, le_rfl, ?_, trivial⟩ + simp [machineRationalVectorL1InputBound, machineBinaryMulWidth, + rawRatBinaryCode, RawRat.zero, integerBinaryCode] + nlinarith [sq_nonneg (word.length + 16)] + +theorem machineRationalVectorL1Step_bound {word state : List Bool} + (hs : MachineRationalVectorL1StateBound word state) : + MachineRationalVectorL1StateBound word + (machineRationalVectorL1Step state) := by + rcases hs with ⟨hdecomp, hcurrent, hacc, hbound⟩ + by_cases hnil : machineRationalVectorL1Current state = [] + · rw [machineRationalVectorL1Step, hnil, machineIfEmpty_nil] + exact ⟨hdecomp, hcurrent, hacc, hbound⟩ + · cases hcode : machineRationalVectorL1Current state with + | nil => exact False.elim (hnil hcode) + | cons bit tail => + rw [machineRationalVectorL1Step, hcode, machineIfEmpty_cons, + machineRationalVectorL1Advance] + simp only [MachineRationalVectorL1StateBound, + machineRationalVectorL1Current_pack, + machineRationalVectorL1Acc_pack, + machineRationalVectorL1Bound_pack] + refine ⟨trivial, ?_, ?_, hbound⟩ + · exact (machineListTail_length_le + (machineRationalVectorL1Current state)).trans hcurrent + · rw [machineRationalVectorL1NextAcc, hbound] + exact List.length_take_le _ _ + +theorem machineRationalVectorL1Iterate_bound + (word : List Bool) : ∀ k, + MachineRationalVectorL1StateBound word + ((machineRationalVectorL1Step)^[k] + (machineRationalVectorL1Init word)) := by + intro k + induction k with + | zero => exact machineRationalVectorL1Init_bound word + | succ k ih => + rw [Function.iterate_succ_apply'] + exact machineRationalVectorL1Step_bound ih + +theorem machineRationalVectorL1Iterate_length_le_width + (word : List Bool) (iterations : ℕ) + (_ : iterations ≤ word.length) : + ((machineRationalVectorL1Step)^[iterations] + (machineRationalVectorL1Init word)).length ≤ + (machineRationalVectorL1Width word).length := by + rcases machineRationalVectorL1Iterate_bound word iterations with + ⟨hdecomp, hcurrent, hacc, hbound⟩ + rw [hdecomp, hbound] + simp only [machineRationalVectorL1Pack, + machineRationalVectorL1Width, pair_length] + omega + +theorem machineRationalVectorL1FinalState_mem_FP : + machineRationalVectorL1FinalState ∈ FP := by + exact Cobham.iterate_mem_FP machineRationalVectorL1Step_mem_FP + machineRationalVectorL1Init_mem_FP id_mem_FP + machineRationalVectorL1Width_mem_FP + machineRationalVectorL1Iterate_length_le_width + +theorem machineRationalVectorL1RawCode_mem_FP : + machineRationalVectorL1RawCode ∈ FP := by + simpa only [machineRationalVectorL1RawCode] using + machineCompose_mem_FP machineRationalVectorL1FinalState_mem_FP + machineRationalVectorL1Acc_mem_FP + +theorem machineRationalVectorL1EntryCode_mem_FP : + machineRationalVectorL1EntryCode ∈ FP := by + simpa only [machineRationalVectorL1EntryCode] using + machineCompose_mem_FP machineRationalVectorL1RawCode_mem_FP + machineNormalizeRawRatEntryCode_mem_FP + +/-! ## Exact semantics -/ + +def rawRatListL1Sum : RawRat → List ℚ → RawRat + | acc, [] => acc + | acc, q :: qs => + rawRatListL1Sum (acc.add (rawRatOfRat q).magnitude) qs + +theorem rawRatWidth_listL1Sum_le (acc : RawRat) : ∀ xs : List ℚ, + rawRatWidth (rawRatListL1Sum acc xs) ≤ + rawRatWidth acc + rawRatListCost xs := by + intro xs + induction xs generalizing acc with + | nil => simp [rawRatListL1Sum, rawRatListCost] + | cons q qs ih => + rw [rawRatListL1Sum] + have hadd := rawRatWidth_add_le acc (rawRatOfRat q).magnitude + rw [RawRat.width_magnitude] at hadd + have htail := ih (acc.add (rawRatOfRat q).magnitude) + simp only [rawRatListCost, List.map_cons, List.sum_cons] at htail ⊢ + omega + +structure RationalVectorL1SemState where + current : List ℚ + acc : RawRat + +def rationalVectorL1SemStep + (s : RationalVectorL1SemState) : RationalVectorL1SemState := + match s.current with + | q :: qs => ⟨qs, s.acc.add (rawRatOfRat q).magnitude⟩ + | [] => s + +def rationalVectorL1SemCode (bound : List Bool) + (s : RationalVectorL1SemState) : List Bool := + machineRationalVectorL1Pack + (binaryListCode rationalEntryBinaryCode s.current) + (rawRatBinaryCode s.acc) bound + +def RationalVectorL1SemInvariant (budget : ℕ) + (s : RationalVectorL1SemState) : Prop := + rawRatWidth s.acc + rawRatListCost s.current ≤ budget + +theorem rationalVectorL1SemStep_invariant {budget : ℕ} + {s : RationalVectorL1SemState} + (hs : RationalVectorL1SemInvariant budget s) : + RationalVectorL1SemInvariant budget (rationalVectorL1SemStep s) := by + rcases s with ⟨current, acc⟩ + cases current with + | nil => exact hs + | cons q qs => + have hadd := rawRatWidth_add_le acc (rawRatOfRat q).magnitude + rw [RawRat.width_magnitude] at hadd + simp only [RationalVectorL1SemInvariant, rationalVectorL1SemStep, + rawRatListCost, List.map_cons, List.sum_cons] at hs ⊢ + omega + +theorem rationalVectorL1Bound_large (word : List Bool) : + 4 + 3 * (1 + word.length) ≤ + (machineRationalVectorL1InputBound word).length := by + simp only [machineRationalVectorL1InputBound, + machineBinaryMulWidth, List.length_replicate, List.length_append] + nlinarith + +theorem machineRationalVectorL1Step_semantics + (word : List Bool) (s : RationalVectorL1SemState) + (hs : RationalVectorL1SemInvariant (1 + word.length) s) : + machineRationalVectorL1Step + (rationalVectorL1SemCode + (machineRationalVectorL1InputBound word) s) = + rationalVectorL1SemCode + (machineRationalVectorL1InputBound word) + (rationalVectorL1SemStep s) := by + rcases s with ⟨current, acc⟩ + cases current with + | nil => + simp [rationalVectorL1SemCode, rationalVectorL1SemStep, + machineRationalVectorL1Step, binaryListCode] + | cons q qs => + have hnext : + rawRatWidth (acc.add (rawRatOfRat q).magnitude) ≤ + 1 + word.length := by + have hinv := rationalVectorL1SemStep_invariant hs + have hinv' : + rawRatWidth (acc.add (rawRatOfRat q).magnitude) + + rawRatListCost qs ≤ 1 + word.length := by + simpa only [RationalVectorL1SemInvariant, + rationalVectorL1SemStep] using hinv + omega + have hcode : + (rawRatBinaryCode + (acc.add (rawRatOfRat q).magnitude)).length ≤ + (machineRationalVectorL1InputBound word).length := + (rawRatBinaryCode_length_le_width _).trans + ((Nat.add_le_add_left (Nat.mul_le_mul_left 3 hnext) 4).trans + (rationalVectorL1Bound_large word)) + rw [rationalVectorL1SemCode, rationalVectorL1SemStep, + machineRationalVectorL1Step] + simp only [machineRationalVectorL1Current_pack] + rw [machineIfEmpty_of_ne_nil_matrix _ _ _ + (binaryListCode_cons_ne_nil rationalEntryBinaryCode q qs)] + simp only [machineRationalVectorL1Advance, + machineRationalVectorL1Current_pack, + machineRationalVectorL1Acc_pack, + machineRationalVectorL1Bound_pack, + machineListTail_cons, machineRationalVectorL1NextAcc, + machineRationalVectorL1Candidate, + machineRationalVectorL1Magnitude, + machineRationalVectorL1Entry, machineListHead_cons] + rw [← rawRatBinaryCode_rawRatOfRat q, + machineRawRatMagnitudeCode_encode, + machineRawRatAddCode_encode, + (List.take_eq_self_iff _).mpr hcode] + rfl + +theorem machineRationalVectorL1Iterate_semantics + (word : List Bool) (s : RationalVectorL1SemState) + (hs : RationalVectorL1SemInvariant (1 + word.length) s) : ∀ k, + (machineRationalVectorL1Step)^[k] + (rationalVectorL1SemCode + (machineRationalVectorL1InputBound word) s) = + rationalVectorL1SemCode + (machineRationalVectorL1InputBound word) + ((rationalVectorL1SemStep)^[k] s) := by + intro k + have hinv : ∀ t : ℕ, + RationalVectorL1SemInvariant (1 + word.length) + ((rationalVectorL1SemStep)^[t] s) := by + intro t + induction t with + | zero => exact hs + | succ t iht => + rw [Function.iterate_succ_apply'] + exact rationalVectorL1SemStep_invariant iht + induction k with + | zero => rfl + | succ k ih => + rw [Function.iterate_succ_apply', Function.iterate_succ_apply', ih] + exact machineRationalVectorL1Step_semantics word _ (hinv k) + +theorem rationalVectorL1Sem_process : ∀ (xs : List ℚ) (acc : RawRat), + (rationalVectorL1SemStep)^[xs.length] ⟨xs, acc⟩ = + ⟨[], rawRatListL1Sum acc xs⟩ := by + intro xs + induction xs with + | nil => intro acc; rfl + | cons q qs ih => + intro acc + rw [List.length_cons, Function.iterate_succ_apply, + rationalVectorL1SemStep, ih] + rfl + +theorem machineRationalVectorL1_done_iterate + (extra : ℕ) (acc : RawRat) (bound : List Bool) : + (machineRationalVectorL1Step)^[extra] + (machineRationalVectorL1Pack [] (rawRatBinaryCode acc) bound) = + machineRationalVectorL1Pack [] (rawRatBinaryCode acc) bound := by + induction extra with + | zero => rfl + | succ k ih => + rw [Function.iterate_succ_apply', ih] + simp [machineRationalVectorL1Step] + +theorem machineRationalVectorL1FinalState_encode {n : ℕ} + (v : Fin n → ℚ) : + let word := rationalFiniteVectorCode v + machineRationalVectorL1FinalState word = + machineRationalVectorL1Pack [] + (rawRatBinaryCode + (rawRatListL1Sum RawRat.zero (List.ofFn v))) + (machineRationalVectorL1InputBound word) := by + let xs := List.ofFn v + let word := rationalFiniteVectorCode v + let s : RationalVectorL1SemState := ⟨xs, RawRat.zero⟩ + have hcode : + (binaryListCode rationalEntryBinaryCode xs).length = word.length := by + simp [word, xs, rationalFiniteVectorCode] + have hinv : RationalVectorL1SemInvariant (1 + word.length) s := by + simp only [RationalVectorL1SemInvariant, s, rawRatWidth_zero] + have hcost := rawRatListCost_le_codeLength xs + omega + have hn : n ≤ word.length := by + have hlist := list_length_le_binaryListCode_length + rationalEntryBinaryCode xs + simpa only [xs, List.length_ofFn, hcode] using hlist + have hsplit : word.length = (word.length - n) + n := by omega + have hinit : machineRationalVectorL1Init word = + rationalVectorL1SemCode + (machineRationalVectorL1InputBound word) s := by + simp [machineRationalVectorL1Init, rationalVectorL1SemCode, + s, word, xs, rationalFiniteVectorCode] + have hprocess : + (rationalVectorL1SemStep)^[n] s = + ⟨[], rawRatListL1Sum RawRat.zero xs⟩ := by + simpa [s, xs] using rationalVectorL1Sem_process xs RawRat.zero + change machineRationalVectorL1FinalState word = _ + rw [machineRationalVectorL1FinalState, hsplit, + Function.iterate_add_apply, hinit, + machineRationalVectorL1Iterate_semantics word s hinv, hprocess] + simp only [rationalVectorL1SemCode, binaryListCode] + rw [machineRationalVectorL1_done_iterate] + +@[simp] theorem machineRationalVectorL1RawCode_encode {n : ℕ} + (v : Fin n → ℚ) : + machineRationalVectorL1RawCode (rationalFiniteVectorCode v) = + rawRatBinaryCode + (rawRatListL1Sum RawRat.zero (List.ofFn v)) := by + rw [machineRationalVectorL1RawCode, + machineRationalVectorL1FinalState_encode] + simp + +theorem rawRatListL1Sum_value (acc : RawRat) : ∀ xs : List ℚ, + (rawRatListL1Sum acc xs).value = + acc.value + (xs.map abs).sum := by + intro xs + induction xs generalizing acc with + | nil => simp [rawRatListL1Sum] + | cons q qs ih => + rw [rawRatListL1Sum, ih] + simp [RawRat.value_add, rawRatOfRat_value, add_assoc] + +theorem rawRatListL1Sum_ofFn_value {n : ℕ} (v : Fin n → ℚ) : + (rawRatListL1Sum RawRat.zero (List.ofFn v)).value = + ∑ i, abs (v i) := by + rw [rawRatListL1Sum_value, RawRat.value_zero, zero_add] + simp only [List.map_ofFn, List.sum_ofFn, Function.comp_apply] + +@[simp] theorem machineRationalVectorL1EntryCode_encode {n : ℕ} + (v : Fin n → ℚ) : + machineRationalVectorL1EntryCode (rationalFiniteVectorCode v) = + rationalEntryBinaryCode (cutL1Scale v) := by + rw [machineRationalVectorL1EntryCode, + machineRationalVectorL1RawCode_encode, + machineNormalizeRawRatEntryCode_encode, + binaryNormalizeRawRat_eq_value, + rawRatListL1Sum_ofFn_value, cutL1Scale] + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalVectorScale.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalVectorScale.lean new file mode 100644 index 0000000000..a23032b7fb --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalVectorScale.lean @@ -0,0 +1,80 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalNormalizedDirection + +/-! +# Polynomial-time rational vector scaling + +The input is a raw rational scalar followed by a canonically encoded rational +vector. We reduce scaling to the verified row-division machine: division by +`1 / s` is multiplication by `s`, including at `s = 0` under the field's total +inverse convention. The reciprocal remains an unreduced `RawRat` word, so +the composition performs no decoding or hidden rational arithmetic. +-/ + +namespace BeyondBethe + +open Complexity + +def rationalVectorScale {d : ℕ} + (s : ℚ) (v : Fin d → ℚ) : Fin d → ℚ := + fun i ↦ s * v i + +def machineRationalVectorScaleReciprocalCode + (word : List Bool) : List Bool := + machineRawRatDivCode + (pair (rawRatBinaryCode RawRat.one) (machinePairFirst word)) + +def machineRationalVectorScaleCode + (word : List Bool) : List Bool := + machineRationalRowDivide + (pair (machineRationalVectorScaleReciprocalCode word) + (machinePairSecond word)) + +theorem machineRationalVectorScaleReciprocalCode_mem_FP : + machineRationalVectorScaleReciprocalCode ∈ FP := by + have hinput := machinePair_mem_FP + (machineConst_mem_FP (rawRatBinaryCode RawRat.one)) + machinePairFirst_mem_FP + simpa only [machineRationalVectorScaleReciprocalCode] using + machineCompose_mem_FP hinput machineRawRatDivCode_mem_FP + +theorem machineRationalVectorScaleCode_mem_FP : + machineRationalVectorScaleCode ∈ FP := by + have hinput := machinePair_mem_FP + machineRationalVectorScaleReciprocalCode_mem_FP machinePairSecond_mem_FP + simpa only [machineRationalVectorScaleCode] using + machineCompose_mem_FP hinput machineRationalRowDivide_mem_FP + +theorem rationalRowDivideValues_reciprocal_ofFn {d : ℕ} + (s : RawRat) (v : Fin d → ℚ) : + rationalRowDivideValues (RawRat.one.div s) (List.ofFn v) = + List.ofFn (rationalVectorScale s.value v) := by + rw [rationalRowDivideValues, List.map_ofFn] + apply congrArg List.ofFn + funext i + simp [rationalVectorScale, binaryNormalizeRawRat_eq_value, + RawRat.value_div, RawRat.value_one, rawRatOfRat_value] + ring + +@[simp] theorem machineRationalVectorScaleCode_encode {d : ℕ} + (s : RawRat) (v : Fin d → ℚ) : + machineRationalVectorScaleCode + (pair (rawRatBinaryCode s) (rationalFiniteVectorCode v)) = + rationalFiniteVectorCode (rationalVectorScale s.value v) := by + rw [machineRationalVectorScaleCode, + machineRationalVectorScaleReciprocalCode] + simp only [machinePairFirst_pair, machinePairSecond_pair, + machineRawRatDivCode_encode] + change machineRationalRowDivide + (machineRationalRowDivideCanonicalInput + (RawRat.one.div s) (List.ofFn v)) = _ + rw [machineRationalRowDivide_encode, + rationalRowDivideValues_reciprocal_ofFn] + rfl + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalVectorSub.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalVectorSub.lean new file mode 100644 index 0000000000..e711c9a3b4 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalVectorSub.lean @@ -0,0 +1,550 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalMatrixMulVector +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalVectorScale + +/-! +# Polynomial-time componentwise subtraction of rational vectors + +The canonical input stores a unary dimension followed by two rational-vector +words. A verified coordinate routine indexes both words, negates the second +raw rational, adds, and normalizes. A bounded finite-word scan maps this +routine over all coordinates and reverses its accumulator once at the end. +-/ + +namespace BeyondBethe + +open Complexity + +def rationalVectorSub {d : ℕ} + (x y : Fin d → ℚ) : Fin d → ℚ := + fun i ↦ x i - y i + +def machineRationalVectorSubEntryCode + (word : List Bool) : List Bool := + let index := machinePairFirst word + let payload := machinePairSecond word + let xCode := machinePairFirst payload + let yCode := machinePairSecond payload + let xEntry := machineListIndex (pair index xCode) + let yEntry := machineListIndex (pair index yCode) + machineNormalizeRawRatEntryCode + (machineRawRatAddCode + (pair xEntry (machineRawRatNegCode yEntry))) + +theorem machineRationalVectorSubEntryCode_mem_FP : + machineRationalVectorSubEntryCode ∈ FP := by + have hindex := machinePairFirst_mem_FP + have hpayload := machinePairSecond_mem_FP + have hxCode := machineCompose_mem_FP hpayload machinePairFirst_mem_FP + have hyCode := machineCompose_mem_FP hpayload machinePairSecond_mem_FP + have hxInput := machinePair_mem_FP hindex hxCode + have hyInput := machinePair_mem_FP hindex hyCode + have hxEntry := machineCompose_mem_FP hxInput machineListIndex_mem_FP + have hyEntry := machineCompose_mem_FP hyInput machineListIndex_mem_FP + have hnegY := machineCompose_mem_FP hyEntry machineRawRatNegCode_mem_FP + have haddInput := machinePair_mem_FP hxEntry hnegY + have hadd := machineCompose_mem_FP haddInput machineRawRatAddCode_mem_FP + simpa only [machineRationalVectorSubEntryCode] using + machineCompose_mem_FP hadd machineNormalizeRawRatEntryCode_mem_FP + +@[simp] theorem machineRationalVectorSubEntryCode_encode {d : ℕ} + (x y : Fin d → ℚ) (i : Fin d) : + machineRationalVectorSubEntryCode + (pair (List.replicate i.1 true) + (pair (rationalFiniteVectorCode x) + (rationalFiniteVectorCode y))) = + rationalEntryBinaryCode (rationalVectorSub x y i) := by + rw [machineRationalVectorSubEntryCode] + simp only [machinePairFirst_pair, machinePairSecond_pair, + rationalFiniteVectorCode] + rw [machineListIndex_binaryListCode (k := i.1), + machineListIndex_binaryListCode (k := i.1)] + · simp only [List.getElem_ofFn, ← rawRatBinaryCode_rawRatOfRat, + machineRawRatNegCode_encode, machineRawRatAddCode_encode, + machineNormalizeRawRatEntryCode_encode] + simp [binaryNormalizeRawRat_eq_value, RawRat.value_add, + RawRat.value_neg, rawRatOfRat_value, rationalVectorSub, + sub_eq_add_neg] + · simp + · simp + +def rawRationalVectorSubCoordinate {d : ℕ} + (x y : Fin d → ℚ) (i : Fin d) : RawRat := + (rawRatOfRat (x i)).sub (rawRatOfRat (y i)) + +theorem rawRationalVectorSubCoordinate_value {d : ℕ} + (x y : Fin d → ℚ) (i : Fin d) : + (rawRationalVectorSubCoordinate x y i).value = + rationalVectorSub x y i := by + simp [rawRationalVectorSubCoordinate, rationalVectorSub, + RawRat.sub, RawRat.value_add, RawRat.value_neg, rawRatOfRat_value, + sub_eq_add_neg] + +def rationalVectorSubCanonicalWord {d : ℕ} + (x y : Fin d → ℚ) : List Bool := + pair (List.replicate d true) + (pair (rationalFiniteVectorCode x) + (rationalFiniteVectorCode y)) + +theorem rawRationalVectorSubCoordinate_width_le {d : ℕ} + (x y : Fin d → ℚ) (i : Fin d) : + rawRatWidth (rawRationalVectorSubCoordinate x y i) ≤ + 2 * (rationalVectorSubCanonicalWord x y).length + 1 := by + let word := rationalVectorSubCanonicalWord x y + have hxElem := binaryListCode_element_length_le + rationalEntryBinaryCode + (show x i ∈ List.ofFn x by simp) + have hyElem := binaryListCode_element_length_le + rationalEntryBinaryCode + (show y i ∈ List.ofFn y by simp) + have hxVector : (rationalFiniteVectorCode x).length ≤ word.length := by + have hinner := machinePairFirst_length_le + (pair (rationalFiniteVectorCode x) (rationalFiniteVectorCode y)) + have hpayload : + (pair (rationalFiniteVectorCode x) + (rationalFiniteVectorCode y)).length ≤ word.length := by + simpa only [word, rationalVectorSubCanonicalWord, + machinePairSecond_pair] using machinePairSecond_length_le word + simpa only [machinePairFirst_pair] using hinner.trans hpayload + have hyVector : (rationalFiniteVectorCode y).length ≤ word.length := by + have hinner := machinePairSecond_length_le + (pair (rationalFiniteVectorCode x) (rationalFiniteVectorCode y)) + have hpayload : + (pair (rationalFiniteVectorCode x) + (rationalFiniteVectorCode y)).length ≤ word.length := by + simpa only [word, rationalVectorSubCanonicalWord, + machinePairSecond_pair] using machinePairSecond_length_le word + simpa only [machinePairSecond_pair] using hinner.trans hpayload + have hxWidth : rawRatWidth (rawRatOfRat (x i)) ≤ word.length := by + have hxCode : + (rawRatBinaryCode (rawRatOfRat (x i))).length ≤ + (rationalFiniteVectorCode x).length := by + simpa only [rationalFiniteVectorCode, + rawRatBinaryCode_rawRatOfRat] using hxElem + exact (rawRatWidth_le_binaryCode_length _).trans + (hxCode.trans hxVector) + have hyWidth : rawRatWidth (rawRatOfRat (y i)) ≤ word.length := by + have hyCode : + (rawRatBinaryCode (rawRatOfRat (y i))).length ≤ + (rationalFiniteVectorCode y).length := by + simpa only [rationalFiniteVectorCode, + rawRatBinaryCode_rawRatOfRat] using hyElem + exact (rawRatWidth_le_binaryCode_length _).trans + (hyCode.trans hyVector) + change rawRatWidth ((rawRatOfRat (x i)).sub (rawRatOfRat (y i))) ≤ + 2 * word.length + 1 + exact (rawRatWidth_sub_le _ _).trans (by omega) + +theorem rationalVectorSub_entry_code_length_le {d : ℕ} + (x y : Fin d → ℚ) (i : Fin d) : + (rationalEntryBinaryCode (rationalVectorSub x y i)).length ≤ + 100 + 72 * (rationalVectorSubCanonicalWord x y).length := by + have hnormalize := + rationalEntryBinaryCode_binaryNormalizeRawRat_length_le + (rawRationalVectorSubCoordinate x y i) + rw [binaryNormalizeRawRat_eq_value, + rawRationalVectorSubCoordinate_value] at hnormalize + have hwidth := rawRationalVectorSubCoordinate_width_le x y i + omega + +def machineRationalVectorSubInputBound + (word : List Bool) : List Bool := + machineRationalTransposeMulVectorInputBound word + +theorem machineRationalVectorSubInputBound_mem_FP : + machineRationalVectorSubInputBound ∈ FP := + machineRationalTransposeMulVectorInputBound_mem_FP + +theorem rationalVectorSub_code_length_le_bound {d : ℕ} + (x y : Fin d → ℚ) : + (rationalFiniteVectorCode (rationalVectorSub x y)).length ≤ + (machineRationalVectorSubInputBound + (rationalVectorSubCanonicalWord x y)).length := by + let word := rationalVectorSubCanonicalWord x y + let B := 100 + 72 * word.length + have hdim : d ≤ word.length := by + have hfirst := machinePairFirst_length_le word + simpa only [word, rationalVectorSubCanonicalWord, + machinePairFirst_pair, List.length_replicate] using hfirst + have heach : ∀ q ∈ List.ofFn (rationalVectorSub x y), + (rationalEntryBinaryCode q).length ≤ B := by + intro q hq + obtain ⟨i, rfl⟩ := List.mem_ofFn.mp hq + exact rationalVectorSub_entry_code_length_le x y i + have hsum := List.sum_le_card_nsmul + ((List.ofFn (rationalVectorSub x y)).map + fun q ↦ 2 * (rationalEntryBinaryCode q).length + 2) + (2 * B + 2) (by + intro value hvalue + rw [List.mem_map] at hvalue + obtain ⟨q, hq, rfl⟩ := hvalue + have hq' := heach q hq + omega) + rw [rationalFiniteVectorCode, binaryListCode_length_eq_sum] + simp only [machineRationalVectorSubInputBound, + machineRationalTransposeMulVectorInputBound, + machineBinaryMulWidth, List.length_replicate, + List.length_append, List.length_map, List.length_ofFn, + Nat.nsmul_eq_mul] at hsum ⊢ + dsimp only [B, word] at hsum ⊢ + nlinarith [sq_nonneg (rationalVectorSubCanonicalWord x y).length] + +/-! ## Bounded scan -/ + +def machineRationalVectorSubCurrentEntry + (state : List Bool) : List Bool := + machineRationalVectorSubEntryCode + (pair (machineRationalTransposeMulVectorCurrentIndex state) + (machineRationalTransposeMulVectorStatePayload state)) + +def machineRationalVectorSubCandidate + (state : List Bool) : List Bool := + pair (machineRationalVectorSubCurrentEntry state) + (machineRationalTransposeMulVectorAccumulator state) + +def machineRationalVectorSubNextAccumulator + (state : List Bool) : List Bool := + (machineRationalVectorSubCandidate state).take + (machineRationalTransposeMulVectorBound state).length + +def machineRationalVectorSubAdvance + (state : List Bool) : List Bool := + machineRationalTransposeMulVectorPack + (machineListTail (machineRationalTransposeMulVectorRemaining state)) + (machineRationalVectorSubNextAccumulator state) + (machineRationalTransposeMulVectorStatePayload state) + (machineRationalTransposeMulVectorBound state) + +def machineRationalVectorSubStep + (state : List Bool) : List Bool := + machineIfEmpty (machineRationalTransposeMulVectorRemaining state) state + (machineRationalVectorSubAdvance state) + +def machineRationalVectorSubInit (word : List Bool) : List Bool := + machineRationalTransposeMulVectorPack + (machineRationalTransposeMulVectorIndices word) [] + (machineRationalTransposeMulVectorPayload word) + (machineRationalVectorSubInputBound word) + +def machineRationalVectorSubWidth (word : List Bool) : List Bool := + let bound := machineRationalVectorSubInputBound word + machineRationalTransposeMulVectorPack bound bound bound bound + +def machineRationalVectorSubFinalState + (word : List Bool) : List Bool := + (machineRationalVectorSubStep)^[word.length] + (machineRationalVectorSubInit word) + +def machineRationalVectorSubReversedCode + (word : List Bool) : List Bool := + machineRationalTransposeMulVectorAccumulator + (machineRationalVectorSubFinalState word) + +def machineRationalVectorSubCode + (word : List Bool) : List Bool := + machineListReverse (machineRationalVectorSubReversedCode word) + +theorem machineRationalVectorSubCurrentEntry_mem_FP : + machineRationalVectorSubCurrentEntry ∈ FP := by + have hp := machinePair_mem_FP + machineRationalTransposeMulVectorCurrentIndex_mem_FP + machineRationalTransposeMulVectorStatePayload_mem_FP + simpa only [machineRationalVectorSubCurrentEntry] using + machineCompose_mem_FP hp machineRationalVectorSubEntryCode_mem_FP + +theorem machineRationalVectorSubCandidate_mem_FP : + machineRationalVectorSubCandidate ∈ FP := + machinePair_mem_FP machineRationalVectorSubCurrentEntry_mem_FP + machineRationalTransposeMulVectorAccumulator_mem_FP + +theorem machineRationalVectorSubNextAccumulator_mem_FP : + machineRationalVectorSubNextAccumulator ∈ FP := by + simpa only [machineRationalVectorSubNextAccumulator] using + machineTake_mem_FP machineRationalTransposeMulVectorBound_mem_FP + machineRationalVectorSubCandidate_mem_FP + +theorem machineRationalVectorSubAdvance_mem_FP : + machineRationalVectorSubAdvance ∈ FP := by + have htail := machineCompose_mem_FP + machineRationalTransposeMulVectorRemaining_mem_FP machineListTail_mem_FP + exact machinePair_mem_FP htail + (machinePair_mem_FP machineRationalVectorSubNextAccumulator_mem_FP + (machinePair_mem_FP + machineRationalTransposeMulVectorStatePayload_mem_FP + machineRationalTransposeMulVectorBound_mem_FP)) + +theorem machineRationalVectorSubStep_mem_FP : + machineRationalVectorSubStep ∈ FP := + machineIfEmpty_mem_FP machineRationalTransposeMulVectorRemaining_mem_FP + id_mem_FP machineRationalVectorSubAdvance_mem_FP + +theorem machineRationalVectorSubInit_mem_FP : + machineRationalVectorSubInit ∈ FP := by + exact machinePair_mem_FP machineRationalTransposeMulVectorIndices_mem_FP + (machinePair_mem_FP (machineConst_mem_FP []) + (machinePair_mem_FP machineRationalTransposeMulVectorPayload_mem_FP + machineRationalVectorSubInputBound_mem_FP)) + +theorem machineRationalVectorSubWidth_mem_FP : + machineRationalVectorSubWidth ∈ FP := by + exact machinePair_mem_FP machineRationalVectorSubInputBound_mem_FP + (machinePair_mem_FP machineRationalVectorSubInputBound_mem_FP + (machinePair_mem_FP machineRationalVectorSubInputBound_mem_FP + machineRationalVectorSubInputBound_mem_FP)) + +theorem machineRationalVectorSubStep_bound {word state : List Bool} + (hs : MachineRationalTransposeMulVectorStateBound word state) : + MachineRationalTransposeMulVectorStateBound word + (machineRationalVectorSubStep state) := by + dsimp only [MachineRationalTransposeMulVectorStateBound] at hs ⊢ + rcases hs with ⟨hdecomp, hremaining, hacc, hpayload, hbound⟩ + by_cases hnil : machineRationalTransposeMulVectorRemaining state = [] + · rw [machineRationalVectorSubStep, hnil, machineIfEmpty_nil] + exact ⟨hdecomp, hremaining, hacc, hpayload, hbound⟩ + · cases hcode : machineRationalTransposeMulVectorRemaining state with + | nil => exact False.elim (hnil hcode) + | cons bit tail => + rw [machineRationalVectorSubStep, hcode, + machineIfEmpty_cons, machineRationalVectorSubAdvance] + simp only [machineRationalTransposeMulVectorRemaining_pack, + machineRationalTransposeMulVectorAccumulator_pack, + machineRationalTransposeMulVectorStatePayload_pack, + machineRationalTransposeMulVectorBound_pack] + refine ⟨trivial, ?_, ?_, hpayload, hbound⟩ + · exact (machineListTail_length_le + (machineRationalTransposeMulVectorRemaining state)).trans + hremaining + · rw [machineRationalVectorSubNextAccumulator, hbound] + exact List.length_take_le _ _ + +theorem machineRationalVectorSubIterate_bound + (word : List Bool) : ∀ k, + MachineRationalTransposeMulVectorStateBound word + ((machineRationalVectorSubStep)^[k] + (machineRationalVectorSubInit word)) := by + intro k + induction k with + | zero => + simpa only [machineRationalVectorSubInit, + machineRationalVectorSubInputBound, + machineRationalTransposeMulVectorInit] using + machineRationalTransposeMulVectorInit_bound word + | succ k ih => + rw [Function.iterate_succ_apply'] + exact machineRationalVectorSubStep_bound ih + +theorem machineRationalVectorSubIterate_length_le_width + (word : List Bool) (iterations : ℕ) + (_ : iterations ≤ word.length) : + ((machineRationalVectorSubStep)^[iterations] + (machineRationalVectorSubInit word)).length ≤ + (machineRationalVectorSubWidth word).length := by + rcases machineRationalVectorSubIterate_bound word iterations with + ⟨hdecomp, hremaining, hacc, hpayload, hbound⟩ + rw [hdecomp, hbound] + simp only [machineRationalTransposeMulVectorPack, + machineRationalVectorSubWidth, machineRationalVectorSubInputBound, + pair_length] + omega + +theorem machineRationalVectorSubFinalState_mem_FP : + machineRationalVectorSubFinalState ∈ FP := by + exact Cobham.iterate_mem_FP machineRationalVectorSubStep_mem_FP + machineRationalVectorSubInit_mem_FP id_mem_FP + machineRationalVectorSubWidth_mem_FP + machineRationalVectorSubIterate_length_le_width + +theorem machineRationalVectorSubReversedCode_mem_FP : + machineRationalVectorSubReversedCode ∈ FP := by + simpa only [machineRationalVectorSubReversedCode] using + machineCompose_mem_FP machineRationalVectorSubFinalState_mem_FP + machineRationalTransposeMulVectorAccumulator_mem_FP + +theorem machineRationalVectorSubCode_mem_FP : + machineRationalVectorSubCode ∈ FP := by + simpa only [machineRationalVectorSubCode] using + machineCompose_mem_FP machineRationalVectorSubReversedCode_mem_FP + machineListReverse_mem_FP + +/-! ## Exact scan semantics -/ + +def rationalVectorSubPrefix {d : ℕ} + (x y : Fin d → ℚ) (k : ℕ) : List ℚ := + ((List.finRange d).take k).map fun i ↦ rationalVectorSub x y i + +def machineRationalVectorSubSemanticState {d : ℕ} + (x y : Fin d → ℚ) (k : ℕ) : List Bool := + let word := rationalVectorSubCanonicalWord x y + machineRationalTransposeMulVectorPack + (binaryListCode finUnaryCode ((List.finRange d).drop k)) + (binaryListCode rationalEntryBinaryCode + (rationalVectorSubPrefix x y k).reverse) + (pair (rationalFiniteVectorCode x) (rationalFiniteVectorCode y)) + (machineRationalVectorSubInputBound word) + +theorem machineRationalVectorSubInit_semantics {d : ℕ} + (x y : Fin d → ℚ) : + machineRationalVectorSubInit (rationalVectorSubCanonicalWord x y) = + machineRationalVectorSubSemanticState x y 0 := by + simp [machineRationalVectorSubInit, + machineRationalVectorSubSemanticState, + machineRationalTransposeMulVectorIndices, + machineRationalTransposeMulVectorDimension, + machineRationalTransposeMulVectorPayload, + rationalVectorSubCanonicalWord, machineUnaryRangeCode_encode, + finRangeUnaryCode, rationalVectorSubPrefix, binaryListCode] + +theorem rationalVectorSubPrefix_succ {d : ℕ} + (x y : Fin d → ℚ) (k : ℕ) (hk : k < d) : + rationalVectorSubPrefix x y (k + 1) = + rationalVectorSubPrefix x y k ++ + [rationalVectorSub x y ⟨k, hk⟩] := by + simp only [rationalVectorSubPrefix, List.map_take] + have hkm : k < (List.finRange d).length := by simpa + simpa [List.getElem_finRange] using + congrArg (List.map fun i ↦ rationalVectorSub x y i) + (List.take_concat_get hkm).symm + +theorem machineRationalVectorSubStep_semantics {d : ℕ} + (x y : Fin d → ℚ) (k : ℕ) (hk : k < d) : + machineRationalVectorSubStep + (machineRationalVectorSubSemanticState x y k) = + machineRationalVectorSubSemanticState x y (k + 1) := by + let word := rationalVectorSubCanonicalWord x y + let i : Fin d := ⟨k, hk⟩ + have hdrop : + (List.finRange d).drop k = + i :: (List.finRange d).drop (k + 1) := by + convert List.drop_eq_getElem_cons + (show k < (List.finRange d).length by simpa) using 1 + simp [i, List.getElem_finRange] + have hprefix := rationalVectorSubPrefix_succ x y k hk + have hreverse : + (rationalVectorSubPrefix x y (k + 1)).reverse = + rationalVectorSub x y i :: + (rationalVectorSubPrefix x y k).reverse := by + rw [hprefix, List.reverse_append] + simp [i] + have hcand : + (binaryListCode rationalEntryBinaryCode + (rationalVectorSubPrefix x y (k + 1)).reverse).length ≤ + (machineRationalVectorSubInputBound word).length := by + have hprefixBound := binaryListCode_take_reverse_length_le + rationalEntryBinaryCode (List.ofFn (rationalVectorSub x y)) (k + 1) + have hprefixEq : rationalVectorSubPrefix x y (k + 1) = + (List.ofFn (rationalVectorSub x y)).take (k + 1) := by + apply List.ext_getElem + · simp [rationalVectorSubPrefix] + · intro r hrLeft hrRight + simp [rationalVectorSubPrefix, List.getElem_finRange] + rw [hprefixEq] + exact hprefixBound.trans (rationalVectorSub_code_length_le_bound x y) + have hcandPair : + (pair (rationalEntryBinaryCode (rationalVectorSub x y i)) + (binaryListCode rationalEntryBinaryCode + (rationalVectorSubPrefix x y k).reverse)).length ≤ + (machineRationalVectorSubInputBound word).length := by + simpa only [hreverse, binaryListCode] using hcand + have hnonempty : + binaryListCode finUnaryCode ((List.finRange d).drop k) ≠ [] := by + rw [hdrop] + exact binaryListCode_cons_ne_nil finUnaryCode i _ + rw [machineRationalVectorSubStep] + simp only [machineRationalVectorSubSemanticState, + machineRationalTransposeMulVectorRemaining_pack] + rw [machineIfEmpty_of_ne_nil_matrix _ _ _ hnonempty, + machineRationalVectorSubAdvance] + simp only [machineRationalTransposeMulVectorRemaining_pack, + machineRationalTransposeMulVectorAccumulator_pack, + machineRationalTransposeMulVectorStatePayload_pack, + machineRationalTransposeMulVectorBound_pack, + machineRationalVectorSubNextAccumulator, + machineRationalVectorSubCandidate, + machineRationalVectorSubCurrentEntry, + machineRationalTransposeMulVectorCurrentIndex] + rw [hdrop, machineListHead_cons, machineListTail_cons] + change machineRationalTransposeMulVectorPack _ + ((pair (machineRationalVectorSubEntryCode + (pair (finUnaryCode i) + (pair (rationalFiniteVectorCode x) + (rationalFiniteVectorCode y)))) + (binaryListCode rationalEntryBinaryCode + (rationalVectorSubPrefix x y k).reverse)).take + (machineRationalVectorSubInputBound word).length) _ _ = _ + rw [show finUnaryCode i = List.replicate i.1 true by rfl, + machineRationalVectorSubEntryCode_encode] + rw [List.take_of_length_le hcandPair, hreverse] + rfl + +theorem machineRationalVectorSubIterate_semantics {d : ℕ} + (x y : Fin d → ℚ) : ∀ k ≤ d, + (machineRationalVectorSubStep)^[k] + (machineRationalVectorSubInit (rationalVectorSubCanonicalWord x y)) = + machineRationalVectorSubSemanticState x y k := by + intro k hk + induction k with + | zero => exact machineRationalVectorSubInit_semantics x y + | succ k ih => + rw [Function.iterate_succ_apply', ih (by omega)] + exact machineRationalVectorSubStep_semantics x y k (by omega) + +theorem machineRationalVectorSub_done_iterate + (extra : ℕ) (accumulator payload bound : List Bool) : + (machineRationalVectorSubStep)^[extra] + (machineRationalTransposeMulVectorPack [] accumulator payload bound) = + machineRationalTransposeMulVectorPack [] accumulator payload bound := by + induction extra with + | zero => rfl + | succ k ih => + rw [Function.iterate_succ_apply', ih] + simp [machineRationalVectorSubStep] + +theorem rationalVectorSubPrefix_all {d : ℕ} + (x y : Fin d → ℚ) : + rationalVectorSubPrefix x y d = + List.ofFn (rationalVectorSub x y) := by + apply List.ext_getElem + · simp [rationalVectorSubPrefix] + · intro i hiLeft hiRight + simp [rationalVectorSubPrefix, List.getElem_finRange] + +theorem machineRationalVectorSubReversedCode_encode {d : ℕ} + (x y : Fin d → ℚ) : + machineRationalVectorSubReversedCode + (rationalVectorSubCanonicalWord x y) = + binaryListCode rationalEntryBinaryCode + (List.ofFn (rationalVectorSub x y)).reverse := by + let word := rationalVectorSubCanonicalWord x y + have hd : d ≤ word.length := by + have h := machinePairFirst_length_le word + simpa only [word, rationalVectorSubCanonicalWord, + machinePairFirst_pair, List.length_replicate] using h + have hsplit : word.length = (word.length - d) + d := by omega + change machineRationalVectorSubReversedCode word = _ + rw [machineRationalVectorSubReversedCode, + machineRationalVectorSubFinalState, hsplit, + Function.iterate_add_apply, + machineRationalVectorSubIterate_semantics x y d le_rfl] + simp only [machineRationalVectorSubSemanticState] + rw [show binaryListCode finUnaryCode ((List.finRange d).drop d) = [] by + rw [List.drop_eq_nil_of_le (by simp)] + rfl] + rw [machineRationalVectorSub_done_iterate] + simp only [machineRationalTransposeMulVectorAccumulator_pack] + rw [rationalVectorSubPrefix_all] + +@[simp] theorem machineRationalVectorSubCode_encode {d : ℕ} + (x y : Fin d → ℚ) : + machineRationalVectorSubCode (rationalVectorSubCanonicalWord x y) = + rationalFiniteVectorCode (rationalVectorSub x y) := by + rw [machineRationalVectorSubCode, + machineRationalVectorSubReversedCode_encode, + machineListReverse_encode, List.reverse_reverse] + rfl + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalVectorSum.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalVectorSum.lean new file mode 100644 index 0000000000..4cc1c818d0 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalVectorSum.lean @@ -0,0 +1,113 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerCertificateBoundary +import LeanPool.BeyondBethe.BeyondBethe.MachineMatrixSum + +/-! +# Polynomial-time rational-vector summation + +Optimizer potentials are encoded as right-nested lists of canonical rational +entries. We reuse the verified clamped matrix fold by presenting such a list +as a one-row nested list. The semantic proof below is stated first for an +arbitrary rectangular list of rows; square matrices are not needed by the +fold itself. +-/ + +namespace BeyondBethe + +open Complexity + +theorem machineMatrixRawSumFinalState_rows_encode + (rows : List (List ℚ)) : + let word := pair [] + (binaryListCode (binaryListCode rationalEntryBinaryCode) rows) + machineMatrixRawSumFinalState word = + machineMatrixRawSumPack [] [] + (rawRatBinaryCode (rawRatRowsSum RawRat.zero rows)) + (machineMatrixRawSumInputBound word) := by + let word := pair [] + (binaryListCode (binaryListCode rationalEntryBinaryCode) rows) + let s : MatrixRawSumSemState := ⟨rows, [], RawRat.zero⟩ + have hrowsLength : + (binaryListCode (binaryListCode rationalEntryBinaryCode) rows).length ≤ + word.length := by + simpa only [word] using machinePairSecond_length_le word + have hinv : MatrixRawSumSemInvariant (1 + word.length) s := by + simp only [MatrixRawSumSemInvariant, s, rawRatListCost, + List.map_nil, List.sum_nil, rawRatWidth_zero, Nat.add_zero] + exact Nat.add_le_add_left + ((rawRatRowsCost_le_codeLength rows).trans hrowsLength) 1 + have hwork : matrixNonnegativeRowsWork rows ≤ word.length := + (binaryListCode_length_ge_work rows).trans hrowsLength + have hsplit : word.length = + (word.length - matrixNonnegativeRowsWork rows) + + matrixNonnegativeRowsWork rows := by omega + have hinit : machineMatrixRawSumInit word = + matrixRawSumSemCode (machineMatrixRawSumInputBound word) s := by + simp [machineMatrixRawSumInit, matrixRawSumSemCode, s, word, + binaryListCode, machineMatrixRowsWord] + change machineMatrixRawSumFinalState word = _ + rw [machineMatrixRawSumFinalState, hsplit, Function.iterate_add_apply, + hinit, machineMatrixRawSumIterate_semantics word s hinv, + matrixRawSumSem_processRows] + simp only [matrixRawSumSemCode, binaryListCode] + rw [machineMatrixRawSum_done_iterate] + +@[simp] theorem machineMatrixRawSumCode_rows_encode + (rows : List (List ℚ)) : + machineMatrixRawSumCode + (pair [] + (binaryListCode (binaryListCode rationalEntryBinaryCode) rows)) = + rawRatBinaryCode (rawRatRowsSum RawRat.zero rows) := by + rw [machineMatrixRawSumCode, + machineMatrixRawSumFinalState_rows_encode] + simp + +/-- View a canonical rational-vector word as the only row of a nested row +list. The unused matrix-dimension component is the empty word. -/ +def machineRationalVectorAsRowsWord (word : List Bool) : List Bool := + pair [] (pair word []) + +def machineRationalVectorRawSumCode (word : List Bool) : List Bool := + machineMatrixRawSumCode (machineRationalVectorAsRowsWord word) + +theorem machineRationalVectorAsRowsWord_mem_FP : + machineRationalVectorAsRowsWord ∈ Complexity.FP := by + exact machinePair_mem_FP (machineConst_mem_FP []) + (machinePair_mem_FP id_mem_FP (machineConst_mem_FP [])) + +theorem machineRationalVectorRawSumCode_mem_FP : + machineRationalVectorRawSumCode ∈ Complexity.FP := by + simpa only [machineRationalVectorRawSumCode] using + machineCompose_mem_FP machineRationalVectorAsRowsWord_mem_FP + machineMatrixRawSumCode_mem_FP + +@[simp] theorem machineRationalVectorRawSumCode_encode {n : ℕ} + (v : Fin n → ℚ) : + machineRationalVectorRawSumCode (rationalVectorBinaryCode v) = + rawRatBinaryCode + (rawRatListSum RawRat.zero (List.ofFn v)) := by + rw [machineRationalVectorRawSumCode, + machineRationalVectorAsRowsWord, rationalVectorBinaryCode] + change machineMatrixRawSumCode + (pair [] + (binaryListCode (binaryListCode rationalEntryBinaryCode) + [List.ofFn v])) = _ + rw [machineMatrixRawSumCode_rows_encode] + rfl + +theorem rawRatListSum_ofFn_value {n : ℕ} (v : Fin n → ℚ) : + (rawRatListSum RawRat.zero (List.ofFn v)).value = ∑ i, v i := by + rw [rawRatListSum_value, RawRat.value_zero, zero_add] + exact List.sum_ofFn + +theorem machineRationalVectorRawSumCode_value {n : ℕ} + (v : Fin n → ℚ) : + RawRat.value (rawRatListSum RawRat.zero (List.ofFn v)) = ∑ i, v i := + rawRatListSum_ofFn_value v + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRepeatPair.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRepeatPair.lean new file mode 100644 index 0000000000..91eacba7e4 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRepeatPair.lean @@ -0,0 +1,344 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineBinaryMul +import LeanPool.BeyondBethe.BeyondBethe.MachineFPBasics + +/-! # Machine Repeat Pair -/ + +namespace BeyondBethe + +open Complexity + +/-! +# Polynomial-time repeated pairing + +`repeatPairCode n item tail` is the right-nested word obtained by prepending +`item` exactly `n` times to `tail`. This is the machine-level constructor for +fixedValue rational vectors and, later, for the zero blocks of diagonal +matrices. Its iteration count is supplied in unary and its accumulator is +clamped by an explicit quadratic envelope. +-/ + +def repeatPairCode : ℕ → List Bool → List Bool → List Bool + | 0, _, tail => tail + | n + 1, item, tail => pair item (repeatPairCode n item tail) + +@[simp] theorem repeatPairCode_zero (item tail : List Bool) : + repeatPairCode 0 item tail = tail := rfl + +@[simp] theorem repeatPairCode_succ (n : ℕ) (item tail : List Bool) : + repeatPairCode (n + 1) item tail = + pair item (repeatPairCode n item tail) := rfl + +theorem repeatPairCode_length (n : ℕ) (item tail : List Bool) : + (repeatPairCode n item tail).length = + n * (2 * item.length + 2) + tail.length := by + induction n with + | zero => simp + | succ n ih => + rw [repeatPairCode_succ, pair_length, ih] + ring + +theorem repeatPairCode_binaryListCode {α : Type*} + (encode : α → List Bool) (n : ℕ) (x : α) (xs : List α) : + repeatPairCode n (encode x) (binaryListCode encode xs) = + binaryListCode encode (List.replicate n x ++ xs) := by + induction n with + | zero => simp [repeatPairCode] + | succ n ih => + rw [repeatPairCode_succ, ih] + simp only [List.replicate_succ, List.cons_append, binaryListCode] + +def machineRepeatPairRuler (word : List Bool) : List Bool := + machinePairFirst word + +def machineRepeatPairItem (word : List Bool) : List Bool := + machinePairFirst (machinePairSecond word) + +def machineRepeatPairTail (word : List Bool) : List Bool := + machinePairSecond (machinePairSecond word) + +def machineRepeatPairBound (word : List Bool) : List Bool := + machineBinaryMulWidth word + +def machineRepeatPairPack + (item acc bound : List Bool) : List Bool := + pair item (pair acc bound) + +def machineRepeatPairStateItem (state : List Bool) : List Bool := + machinePairFirst state + +def machineRepeatPairStateAcc (state : List Bool) : List Bool := + machinePairFirst (machinePairSecond state) + +def machineRepeatPairStateBound (state : List Bool) : List Bool := + machinePairSecond (machinePairSecond state) + +def machineRepeatPairCandidate (state : List Bool) : List Bool := + pair (machineRepeatPairStateItem state) + (machineRepeatPairStateAcc state) + +def machineRepeatPairNextAcc (state : List Bool) : List Bool := + (machineRepeatPairCandidate state).take + (machineRepeatPairStateBound state).length + +def machineRepeatPairStep (state : List Bool) : List Bool := + machineRepeatPairPack (machineRepeatPairStateItem state) + (machineRepeatPairNextAcc state) + (machineRepeatPairStateBound state) + +def machineRepeatPairInit (word : List Bool) : List Bool := + machineRepeatPairPack (machineRepeatPairItem word) + (machineRepeatPairTail word) (machineRepeatPairBound word) + +def machineRepeatPairWidth (word : List Bool) : List Bool := + machineRepeatPairPack (machineRepeatPairBound word) + (machineRepeatPairBound word) (machineRepeatPairBound word) + +def machineRepeatPairFinalState (word : List Bool) : List Bool := + (machineRepeatPairStep)^[(machineRepeatPairRuler word).length] + (machineRepeatPairInit word) + +def machineRepeatPairCode (word : List Bool) : List Bool := + machineRepeatPairStateAcc (machineRepeatPairFinalState word) + +/-! ## Polynomial-time closure -/ + +theorem machineRepeatPairRuler_mem_FP : machineRepeatPairRuler ∈ FP := + machinePairFirst_mem_FP + +theorem machineRepeatPairItem_mem_FP : machineRepeatPairItem ∈ FP := by + simpa only [machineRepeatPairItem] using + machineCompose_mem_FP machinePairSecond_mem_FP machinePairFirst_mem_FP + +theorem machineRepeatPairTail_mem_FP : machineRepeatPairTail ∈ FP := by + simpa only [machineRepeatPairTail] using + machineCompose_mem_FP machinePairSecond_mem_FP machinePairSecond_mem_FP + +theorem machineRepeatPairBound_mem_FP : machineRepeatPairBound ∈ FP := + machineBinaryMulWidth_mem_FP + +theorem machineRepeatPairStateItem_mem_FP : + machineRepeatPairStateItem ∈ FP := machinePairFirst_mem_FP + +theorem machineRepeatPairStateAcc_mem_FP : + machineRepeatPairStateAcc ∈ FP := by + simpa only [machineRepeatPairStateAcc] using + machineCompose_mem_FP machinePairSecond_mem_FP machinePairFirst_mem_FP + +theorem machineRepeatPairStateBound_mem_FP : + machineRepeatPairStateBound ∈ FP := by + simpa only [machineRepeatPairStateBound] using + machineCompose_mem_FP machinePairSecond_mem_FP machinePairSecond_mem_FP + +theorem machineRepeatPairCandidate_mem_FP : + machineRepeatPairCandidate ∈ FP := + machinePair_mem_FP machineRepeatPairStateItem_mem_FP + machineRepeatPairStateAcc_mem_FP + +theorem machineRepeatPairNextAcc_mem_FP : + machineRepeatPairNextAcc ∈ FP := by + simpa only [machineRepeatPairNextAcc] using + machineTake_mem_FP machineRepeatPairStateBound_mem_FP + machineRepeatPairCandidate_mem_FP + +theorem machineRepeatPairStep_mem_FP : machineRepeatPairStep ∈ FP := + machinePair_mem_FP machineRepeatPairStateItem_mem_FP + (machinePair_mem_FP machineRepeatPairNextAcc_mem_FP + machineRepeatPairStateBound_mem_FP) + +theorem machineRepeatPairInit_mem_FP : machineRepeatPairInit ∈ FP := + machinePair_mem_FP machineRepeatPairItem_mem_FP + (machinePair_mem_FP machineRepeatPairTail_mem_FP + machineRepeatPairBound_mem_FP) + +theorem machineRepeatPairWidth_mem_FP : machineRepeatPairWidth ∈ FP := + machinePair_mem_FP machineRepeatPairBound_mem_FP + (machinePair_mem_FP machineRepeatPairBound_mem_FP + machineRepeatPairBound_mem_FP) + +@[simp] theorem machineRepeatPairStateItem_pack (a b c) : + machineRepeatPairStateItem (machineRepeatPairPack a b c) = a := by + simp [machineRepeatPairStateItem, machineRepeatPairPack] + +@[simp] theorem machineRepeatPairStateAcc_pack (a b c) : + machineRepeatPairStateAcc (machineRepeatPairPack a b c) = b := by + simp [machineRepeatPairStateAcc, machineRepeatPairPack] + +@[simp] theorem machineRepeatPairStateBound_pack (a b c) : + machineRepeatPairStateBound (machineRepeatPairPack a b c) = c := by + simp [machineRepeatPairStateBound, machineRepeatPairPack] + +def MachineRepeatPairStateBound (word state : List Bool) : Prop := + let B := (machineRepeatPairBound word).length + state = machineRepeatPairPack + (machineRepeatPairStateItem state) + (machineRepeatPairStateAcc state) + (machineRepeatPairStateBound state) ∧ + (machineRepeatPairStateItem state).length ≤ B ∧ + (machineRepeatPairStateAcc state).length ≤ B ∧ + (machineRepeatPairStateBound state).length ≤ B + +theorem machineRepeatPair_word_length_le_bound (word : List Bool) : + word.length ≤ (machineRepeatPairBound word).length := by + simp only [machineRepeatPairBound, machineBinaryMulWidth, + List.length_replicate, List.length_append] + nlinarith + +theorem machineRepeatPairInit_bound (word : List Bool) : + MachineRepeatPairStateBound word (machineRepeatPairInit word) := by + simp only [MachineRepeatPairStateBound, machineRepeatPairInit, + machineRepeatPairStateItem_pack, machineRepeatPairStateAcc_pack, + machineRepeatPairStateBound_pack] + refine ⟨trivial, ?_, ?_, le_rfl⟩ + · exact (machinePairFirst_length_le (machinePairSecond word)).trans + ((machinePairSecond_length_le word).trans + (machineRepeatPair_word_length_le_bound word)) + · exact (machinePairSecond_length_le (machinePairSecond word)).trans + ((machinePairSecond_length_le word).trans + (machineRepeatPair_word_length_le_bound word)) + +theorem machineRepeatPairStep_bound {word state : List Bool} + (hstate : MachineRepeatPairStateBound word state) : + MachineRepeatPairStateBound word (machineRepeatPairStep state) := by + dsimp only [MachineRepeatPairStateBound] at hstate ⊢ + rcases hstate with ⟨_, hitem, _hacc, hbound⟩ + simp only [machineRepeatPairStep, machineRepeatPairStateItem_pack, + machineRepeatPairStateAcc_pack, machineRepeatPairStateBound_pack] + refine ⟨trivial, hitem, ?_, hbound⟩ + exact (List.length_take_le _ _).trans hbound + +theorem machineRepeatPairIterate_bound (word : List Bool) : ∀ k, + MachineRepeatPairStateBound word + ((machineRepeatPairStep)^[k] (machineRepeatPairInit word)) := by + intro k + induction k with + | zero => exact machineRepeatPairInit_bound word + | succ k ih => + rw [Function.iterate_succ_apply'] + exact machineRepeatPairStep_bound ih + +theorem machineRepeatPairIterate_length_le_width + (word : List Bool) (iterations : ℕ) + (_ : iterations ≤ (machineRepeatPairRuler word).length) : + ((machineRepeatPairStep)^[iterations] + (machineRepeatPairInit word)).length ≤ + (machineRepeatPairWidth word).length := by + rcases machineRepeatPairIterate_bound word iterations with + ⟨hdecomp, hitem, hacc, hbound⟩ + rw [hdecomp] + simp only [machineRepeatPairPack, machineRepeatPairWidth, pair_length] + omega + +theorem machineRepeatPairFinalState_mem_FP : + machineRepeatPairFinalState ∈ FP := + Cobham.iterate_mem_FP machineRepeatPairStep_mem_FP + machineRepeatPairInit_mem_FP machineRepeatPairRuler_mem_FP + machineRepeatPairWidth_mem_FP machineRepeatPairIterate_length_le_width + +theorem machineRepeatPairCode_mem_FP : machineRepeatPairCode ∈ FP := by + simpa only [machineRepeatPairCode] using + machineCompose_mem_FP machineRepeatPairFinalState_mem_FP + machineRepeatPairStateAcc_mem_FP + +/-! ## Exact semantics on well-formed unary calls -/ + +def machineRepeatPairCanonicalInput + (n : ℕ) (item tail : List Bool) : List Bool := + pair (List.replicate n true) (pair item tail) + +def machineRepeatPairCanonicalState + (n : ℕ) (item tail : List Bool) (k : ℕ) : List Bool := + let word := machineRepeatPairCanonicalInput n item tail + machineRepeatPairPack item (repeatPairCode k item tail) + (machineRepeatPairBound word) + +theorem machineRepeatPair_candidate_length_le_bound + (n k : ℕ) (item tail : List Bool) (hk : k + 1 ≤ n) : + (pair item (repeatPairCode k item tail)).length ≤ + (machineRepeatPairBound + (machineRepeatPairCanonicalInput n item tail)).length := by + let W := (machineRepeatPairCanonicalInput n item tail).length + have hnW : n ≤ W := by + simp only [W, machineRepeatPairCanonicalInput, pair_length, + List.length_replicate] + omega + have hiW : 2 * item.length + 2 ≤ W := by + simp only [W, machineRepeatPairCanonicalInput, pair_length, + List.length_replicate] + omega + have htW : tail.length ≤ W := by + simp only [W, machineRepeatPairCanonicalInput, pair_length, + List.length_replicate] + omega + have hkW : k + 1 ≤ W := hk.trans hnW + have hproduct := Nat.mul_le_mul hkW hiW + rw [pair_length, repeatPairCode_length] + simp only [machineRepeatPairBound, machineBinaryMulWidth, + List.length_replicate, List.length_append] + change 2 * item.length + 2 + + (k * (2 * item.length + 2) + tail.length) ≤ + (16 + W) * (16 + W) + calc + 2 * item.length + 2 + + (k * (2 * item.length + 2) + tail.length) = + (k + 1) * (2 * item.length + 2) + tail.length := by ring + _ ≤ W * W + W := Nat.add_le_add hproduct htW + _ ≤ (16 + W) * (16 + W) := by nlinarith + +theorem machineRepeatPairInit_semantics + (n : ℕ) (item tail : List Bool) : + machineRepeatPairInit (machineRepeatPairCanonicalInput n item tail) = + machineRepeatPairCanonicalState n item tail 0 := by + simp [machineRepeatPairInit, machineRepeatPairCanonicalInput, + machineRepeatPairCanonicalState, machineRepeatPairItem, + machineRepeatPairTail] + +theorem machineRepeatPairStep_semantics + (n k : ℕ) (item tail : List Bool) (hk : k < n) : + machineRepeatPairStep + (machineRepeatPairCanonicalState n item tail k) = + machineRepeatPairCanonicalState n item tail (k + 1) := by + have hbound := machineRepeatPair_candidate_length_le_bound + n k item tail (by omega) + have htake : + (pair item (repeatPairCode k item tail)).take + (machineRepeatPairBound + (machineRepeatPairCanonicalInput n item tail)).length = + pair item (repeatPairCode k item tail) := + List.take_of_length_le hbound + simp only [machineRepeatPairStep, machineRepeatPairCanonicalState, + machineRepeatPairStateItem_pack, machineRepeatPairStateAcc_pack, + machineRepeatPairStateBound_pack, machineRepeatPairNextAcc, + machineRepeatPairCandidate] + rw [htake] + rfl + +theorem machineRepeatPairIterate_semantics + (n : ℕ) (item tail : List Bool) : ∀ k ≤ n, + (machineRepeatPairStep)^[k] + (machineRepeatPairInit + (machineRepeatPairCanonicalInput n item tail)) = + machineRepeatPairCanonicalState n item tail k := by + intro k hk + induction k with + | zero => exact machineRepeatPairInit_semantics n item tail + | succ k ih => + rw [Function.iterate_succ_apply', ih (by omega)] + exact machineRepeatPairStep_semantics n k item tail (by omega) + +@[simp] theorem machineRepeatPairCode_encode + (n : ℕ) (item tail : List Bool) : + machineRepeatPairCode (machineRepeatPairCanonicalInput n item tail) = + repeatPairCode n item tail := by + have hstate := congrArg machineRepeatPairStateAcc + (machineRepeatPairIterate_semantics n item tail n le_rfl) + simpa [machineRepeatPairCode, machineRepeatPairFinalState, + machineRepeatPairRuler, machineRepeatPairCanonicalInput, + machineRepeatPairCanonicalState] using hstate + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRowComplementUpperSum.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRowComplementUpperSum.lean new file mode 100644 index 0000000000..6dfef54989 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRowComplementUpperSum.lean @@ -0,0 +1,729 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineNearbyMatrixSum + +/-! +# A directed upper logarithm sum for one matrix row + +The four-core eligibility test repeatedly uses + +`sum_k scheduledLogUpper (1 - X i k) p`. + +This module realizes that row sum directly on the canonical optimizer word. +The input is `pair rowUnary optimizerWord`. As in the matrix-wide nearby +sum, the transducer is total on arbitrary strings and clamps its unreduced +rational accumulator by an explicit degree-eight word. The semantic proof +shows that the clamp is inactive on every canonical in-range row query. +-/ + +namespace BeyondBethe + +open Complexity + +def machineRowUpperPack + (source current acc bound : List Bool) : List Bool := + pair source (pair current (pair acc bound)) + +def machineRowUpperSource (state : List Bool) : List Bool := + machinePairFirst state + +def machineRowUpperCurrent (state : List Bool) : List Bool := + machinePairFirst (machinePairSecond state) + +def machineRowUpperAcc (state : List Bool) : List Bool := + machinePairFirst (machinePairSecond (machinePairSecond state)) + +def machineRowUpperBound (state : List Bool) : List Bool := + machinePairSecond (machinePairSecond (machinePairSecond state)) + +def machineRowUpperRowRuler (word : List Bool) : List Bool := + machinePairFirst word + +def machineRowUpperOptimizerWord (word : List Bool) : List Bool := + machinePairSecond word + +def machineRowUpperMatrixWord (word : List Bool) : List Bool := + machineOptimizerMatrixWord (machineRowUpperOptimizerWord word) + +def machineRowUpperInitialRow (word : List Bool) : List Bool := + machineListIndex + (pair (machineRowUpperRowRuler word) + (machineMatrixRowsWord (machineRowUpperMatrixWord word))) + +def machineRowUpperEntry (state : List Bool) : List Bool := + machineListHead (machineRowUpperCurrent state) + +def machineRowUpperComplementInput (state : List Bool) : List Bool := + pair + (machineCertificateLogPrecisionRuler + (machineRowUpperOptimizerWord (machineRowUpperSource state))) + (pair (rawRatBinaryCode RawRat.zero) (machineRowUpperEntry state)) + +def machineRowUpperComplementCode (state : List Bool) : List Bool := + machineNearbyCoordinateComplementCode + (machineRowUpperComplementInput state) + +def machineRowUpperLogRawCode (state : List Bool) : List Bool := + machineScheduledLogUpperRawCode + (pair + (machineCertificateLogPrecisionRuler + (machineRowUpperOptimizerWord (machineRowUpperSource state))) + (machineRowUpperComplementCode state)) + +def machineRowUpperCandidate (state : List Bool) : List Bool := + machineRawRatAddCode + (pair (machineRowUpperAcc state) (machineRowUpperLogRawCode state)) + +def machineRowUpperNextAcc (state : List Bool) : List Bool := + (machineRowUpperCandidate state).take (machineRowUpperBound state).length + +def machineRowUpperStep (state : List Bool) : List Bool := + machineIfEmpty (machineRowUpperCurrent state) state + (machineRowUpperPack + (machineRowUpperSource state) + (machineListTail (machineRowUpperCurrent state)) + (machineRowUpperNextAcc state) + (machineRowUpperBound state)) + +def machineRowUpperInputBound (word : List Bool) : List Bool := + machineBinaryMulWidth + (machineBinaryMulWidth (machineBinaryMulWidth word)) + +def machineRowUpperInit (word : List Bool) : List Bool := + machineRowUpperPack word (machineRowUpperInitialRow word) + (rawRatBinaryCode RawRat.zero) (machineRowUpperInputBound word) + +def machineRowUpperWidth (word : List Bool) : List Bool := + let bound := machineRowUpperInputBound word + machineRowUpperPack word word bound bound + +def machineRowUpperFinalState (word : List Bool) : List Bool := + (machineRowUpperStep)^[word.length] (machineRowUpperInit word) + +/-- Canonical raw-rational code for the directed upper complement-log row +sum, on every canonical in-range query. -/ +def machineRowComplementUpperSumRawCode (word : List Bool) : List Bool := + machineRowUpperAcc (machineRowUpperFinalState word) + +theorem machineRowUpperSource_mem_FP : machineRowUpperSource ∈ FP := + machinePairFirst_mem_FP + +theorem machineRowUpperCurrent_mem_FP : machineRowUpperCurrent ∈ FP := by + simpa only [machineRowUpperCurrent] using + machineCompose_mem_FP machinePairSecond_mem_FP machinePairFirst_mem_FP + +theorem machineRowUpperAcc_mem_FP : machineRowUpperAcc ∈ FP := by + simpa only [machineRowUpperAcc] using machineCompose_mem_FP + (machineCompose_mem_FP machinePairSecond_mem_FP machinePairSecond_mem_FP) + machinePairFirst_mem_FP + +theorem machineRowUpperBound_mem_FP : machineRowUpperBound ∈ FP := by + simpa only [machineRowUpperBound] using machineCompose_mem_FP + (machineCompose_mem_FP machinePairSecond_mem_FP machinePairSecond_mem_FP) + machinePairSecond_mem_FP + +theorem machineRowUpperRowRuler_mem_FP : machineRowUpperRowRuler ∈ FP := + machinePairFirst_mem_FP + +theorem machineRowUpperOptimizerWord_mem_FP : + machineRowUpperOptimizerWord ∈ FP := machinePairSecond_mem_FP + +theorem machineRowUpperMatrixWord_mem_FP : machineRowUpperMatrixWord ∈ FP := by + simpa only [machineRowUpperMatrixWord] using machineCompose_mem_FP + machineRowUpperOptimizerWord_mem_FP machineOptimizerMatrixWord_mem_FP + +theorem machineRowUpperInitialRow_mem_FP : machineRowUpperInitialRow ∈ FP := by + have hrows := machineCompose_mem_FP machineRowUpperMatrixWord_mem_FP + machineMatrixRowsWord_mem_FP + have hpair := machinePair_mem_FP machineRowUpperRowRuler_mem_FP hrows + simpa only [machineRowUpperInitialRow] using + machineCompose_mem_FP hpair machineListIndex_mem_FP + +theorem machineRowUpperEntry_mem_FP : machineRowUpperEntry ∈ FP := by + simpa only [machineRowUpperEntry] using machineCompose_mem_FP + machineRowUpperCurrent_mem_FP machineListHead_mem_FP + +theorem machineRowUpperComplementInput_mem_FP : + machineRowUpperComplementInput ∈ FP := by + have hsourceOptimizer := machineCompose_mem_FP machineRowUpperSource_mem_FP + machineRowUpperOptimizerWord_mem_FP + have hp := machineCompose_mem_FP hsourceOptimizer + machineCertificateLogPrecisionRuler_mem_FP + exact machinePair_mem_FP hp + (machinePair_mem_FP (machineConst_mem_FP (rawRatBinaryCode RawRat.zero)) + machineRowUpperEntry_mem_FP) + +theorem machineRowUpperComplementCode_mem_FP : + machineRowUpperComplementCode ∈ FP := by + simpa only [machineRowUpperComplementCode] using machineCompose_mem_FP + machineRowUpperComplementInput_mem_FP + machineNearbyCoordinateComplementCode_mem_FP + +theorem machineRowUpperLogRawCode_mem_FP : machineRowUpperLogRawCode ∈ FP := by + have hsourceOptimizer := machineCompose_mem_FP machineRowUpperSource_mem_FP + machineRowUpperOptimizerWord_mem_FP + have hp := machineCompose_mem_FP hsourceOptimizer + machineCertificateLogPrecisionRuler_mem_FP + have hpair := machinePair_mem_FP hp machineRowUpperComplementCode_mem_FP + simpa only [machineRowUpperLogRawCode] using machineCompose_mem_FP hpair + machineScheduledLogUpperRawCode_mem_FP + +theorem machineRowUpperCandidate_mem_FP : machineRowUpperCandidate ∈ FP := by + have hpair := machinePair_mem_FP machineRowUpperAcc_mem_FP + machineRowUpperLogRawCode_mem_FP + simpa only [machineRowUpperCandidate] using machineCompose_mem_FP hpair + machineRawRatAddCode_mem_FP + +theorem machineRowUpperNextAcc_mem_FP : machineRowUpperNextAcc ∈ FP := by + simpa only [machineRowUpperNextAcc] using machineTake_mem_FP + machineRowUpperBound_mem_FP machineRowUpperCandidate_mem_FP + +theorem machineRowUpperStep_mem_FP : machineRowUpperStep ∈ FP := by + have htail := machineCompose_mem_FP machineRowUpperCurrent_mem_FP + machineListTail_mem_FP + have helse := machinePair_mem_FP machineRowUpperSource_mem_FP + (machinePair_mem_FP htail + (machinePair_mem_FP machineRowUpperNextAcc_mem_FP + machineRowUpperBound_mem_FP)) + exact machineIfEmpty_mem_FP machineRowUpperCurrent_mem_FP id_mem_FP helse + +theorem machineRowUpperInputBound_mem_FP : machineRowUpperInputBound ∈ FP := by + have h1 := machineBinaryMulWidth_mem_FP + have h2 := machineCompose_mem_FP h1 machineBinaryMulWidth_mem_FP + simpa only [machineRowUpperInputBound] using + machineCompose_mem_FP h2 machineBinaryMulWidth_mem_FP + +theorem machineRowUpperInit_mem_FP : machineRowUpperInit ∈ FP := by + exact machinePair_mem_FP id_mem_FP + (machinePair_mem_FP machineRowUpperInitialRow_mem_FP + (machinePair_mem_FP + (machineConst_mem_FP (rawRatBinaryCode RawRat.zero)) + machineRowUpperInputBound_mem_FP)) + +theorem machineRowUpperWidth_mem_FP : machineRowUpperWidth ∈ FP := by + exact machinePair_mem_FP id_mem_FP + (machinePair_mem_FP id_mem_FP + (machinePair_mem_FP machineRowUpperInputBound_mem_FP + machineRowUpperInputBound_mem_FP)) + +@[simp] theorem machineRowUpperSource_pack (source current acc bound) : + machineRowUpperSource (machineRowUpperPack source current acc bound) = + source := by simp [machineRowUpperSource, machineRowUpperPack] + +@[simp] theorem machineRowUpperCurrent_pack (source current acc bound) : + machineRowUpperCurrent (machineRowUpperPack source current acc bound) = + current := by simp [machineRowUpperCurrent, machineRowUpperPack] + +@[simp] theorem machineRowUpperAcc_pack (source current acc bound) : + machineRowUpperAcc (machineRowUpperPack source current acc bound) = acc := by + simp [machineRowUpperAcc, machineRowUpperPack] + +@[simp] theorem machineRowUpperBound_pack (source current acc bound) : + machineRowUpperBound (machineRowUpperPack source current acc bound) = + bound := by simp [machineRowUpperBound, machineRowUpperPack] + +def MachineRowUpperStateBound (word state : List Bool) : Prop := + state = machineRowUpperPack (machineRowUpperSource state) + (machineRowUpperCurrent state) (machineRowUpperAcc state) + (machineRowUpperBound state) ∧ + machineRowUpperSource state = word ∧ + (machineRowUpperCurrent state).length ≤ word.length ∧ + (machineRowUpperAcc state).length ≤ + (machineRowUpperInputBound word).length ∧ + machineRowUpperBound state = machineRowUpperInputBound word + +theorem machineRowUpperInit_bound (word : List Bool) : + MachineRowUpperStateBound word (machineRowUpperInit word) := by + simp only [MachineRowUpperStateBound, machineRowUpperInit, + machineRowUpperSource_pack, machineRowUpperCurrent_pack, + machineRowUpperAcc_pack, machineRowUpperBound_pack] + refine ⟨trivial, trivial, ?_, ?_, trivial⟩ + · have hindex := machineListIndex_length_le_data + (pair (machineRowUpperRowRuler word) + (machineMatrixRowsWord (machineRowUpperMatrixWord word))) + simp only [machineListIndexData, machinePairSecond_pair] at hindex + exact hindex.trans + ((machinePairSecond_length_le + (machineRowUpperMatrixWord word)).trans + ((machinePairFirst_length_le + (machineRowUpperOptimizerWord word)).trans + (machinePairSecond_length_le word))) + · simp [machineRowUpperInputBound, machineBinaryMulWidth, + rawRatBinaryCode, RawRat.zero, integerBinaryCode] + nlinarith [sq_nonneg (word.length + 16)] + +theorem machineRowUpperStep_bound {word state : List Bool} + (hstate : MachineRowUpperStateBound word state) : + MachineRowUpperStateBound word (machineRowUpperStep state) := by + rcases hstate with ⟨hdecomp, hsource, hcurrent, hacc, hbound⟩ + by_cases hc : machineRowUpperCurrent state = [] + · rw [machineRowUpperStep, hc, machineIfEmpty_nil] + exact ⟨hdecomp, hsource, hcurrent, hacc, hbound⟩ + · rw [machineRowUpperStep] + cases hcode : machineRowUpperCurrent state with + | nil => exact False.elim (hc hcode) + | cons bit tail => + rw [machineIfEmpty_cons] + simp only [MachineRowUpperStateBound, + machineRowUpperSource_pack, machineRowUpperCurrent_pack, + machineRowUpperAcc_pack, machineRowUpperBound_pack] + refine ⟨trivial, hsource, ?_, ?_, hbound⟩ + · have htail := machineListTail_length_le + (machineRowUpperCurrent state) + rw [hcode] at htail + rw [hcode] at hcurrent + exact htail.trans hcurrent + · rw [machineRowUpperNextAcc, hbound] + exact List.length_take_le _ _ + +theorem machineRowUpperIterate_bound (word : List Bool) : ∀ k, + MachineRowUpperStateBound word + ((machineRowUpperStep)^[k] (machineRowUpperInit word)) := by + intro k + induction k with + | zero => exact machineRowUpperInit_bound word + | succ k ih => + rw [Function.iterate_succ_apply'] + exact machineRowUpperStep_bound ih + +theorem machineRowUpperIterate_length_le_width + (word : List Bool) (iterations : ℕ) (_ : iterations ≤ word.length) : + ((machineRowUpperStep)^[iterations] + (machineRowUpperInit word)).length ≤ (machineRowUpperWidth word).length := by + rcases machineRowUpperIterate_bound word iterations with + ⟨hdecomp, hsource, hcurrent, hacc, hbound⟩ + rw [hdecomp, hsource, hbound] + simp only [machineRowUpperPack, machineRowUpperWidth, pair_length] + omega + +theorem machineRowUpperFinalState_mem_FP : machineRowUpperFinalState ∈ FP := by + exact Cobham.iterate_mem_FP machineRowUpperStep_mem_FP + machineRowUpperInit_mem_FP id_mem_FP machineRowUpperWidth_mem_FP + machineRowUpperIterate_length_le_width + +theorem machineRowComplementUpperSumRawCode_mem_FP : + machineRowComplementUpperSumRawCode ∈ FP := by + simpa only [machineRowComplementUpperSumRawCode] using machineCompose_mem_FP + machineRowUpperFinalState_mem_FP machineRowUpperAcc_mem_FP + +/-! ## Exact semantics -/ + +def rawRowComplementUpperCost (p : ℕ) (xs : List ℚ) : ℕ := + (xs.map fun q => rawRatWidth (rawScheduledLogUpper (1 - q) p) + 1).sum + +def rawRowComplementUpperSum (p : ℕ) : RawRat → List ℚ → RawRat + | acc, [] => acc + | acc, q :: qs => + rawRowComplementUpperSum p + (acc.add (rawScheduledLogUpper (1 - q) p)) qs + +structure RowUpperSemState where + current : List ℚ + acc : RawRat + +def rowUpperSemStep (p : ℕ) (s : RowUpperSemState) : RowUpperSemState := + match s.current with + | [] => s + | q :: qs => ⟨qs, s.acc.add (rawScheduledLogUpper (1 - q) p)⟩ + +def rowUpperSemCode (source bound : List Bool) + (s : RowUpperSemState) : List Bool := + machineRowUpperPack source + (binaryListCode rationalEntryBinaryCode s.current) + (rawRatBinaryCode s.acc) bound + +def RowUpperSemInvariant (p budget : ℕ) (s : RowUpperSemState) : Prop := + rawRatWidth s.acc + rawRowComplementUpperCost p s.current ≤ budget + +theorem rowUpperSemStep_invariant {p budget : ℕ} {s : RowUpperSemState} + (hs : RowUpperSemInvariant p budget s) : + RowUpperSemInvariant p budget (rowUpperSemStep p s) := by + rcases s with ⟨current, acc⟩ + cases current with + | nil => exact hs + | cons q qs => + have hadd := rawRatWidth_add_le acc + (rawScheduledLogUpper (1 - q) p) + simp only [RowUpperSemInvariant, rowUpperSemStep, + rawRowComplementUpperCost, List.map_cons, List.sum_cons] at hs ⊢ + omega + +@[simp] theorem machineRowUpperInitialRow_encode {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℚ) (i : Fin n) : + machineRowUpperInitialRow + (pair (List.replicate i.1 true) + (rationalOptimizerOutputCode ⟨X, R, C⟩)) = + binaryListCode rationalEntryBinaryCode (List.ofFn (X i)) := by + rw [machineRowUpperInitialRow] + simp only [machineRowUpperRowRuler, machinePairFirst_pair, + machineRowUpperMatrixWord, machineRowUpperOptimizerWord, + machinePairSecond_pair, machineOptimizerMatrixWord_encode, + machineMatrixRowsWord_encode] + rw [machineListIndex_binaryListCode] + · simp [rationalMatrixRows, List.getElem_ofFn] + · simp [rationalMatrixRows] + +@[simp] theorem machineRowUpperComplementCode_semCode {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℚ) + (rowRuler : List Bool) (q : ℚ) (qs : List ℚ) (acc : RawRat) + (bound : List Bool) : + machineRowUpperComplementCode + (rowUpperSemCode + (pair rowRuler (rationalOptimizerOutputCode ⟨X, R, C⟩)) bound + ⟨q :: qs, acc⟩) = + rawRatBinaryCode (rawRatOfRat (1 - q)) := by + rw [machineRowUpperComplementCode, machineRowUpperComplementInput] + simp only [rowUpperSemCode, machineRowUpperSource_pack, + machineRowUpperOptimizerWord, machinePairSecond_pair, + machineCertificateLogPrecisionRuler_encode, machineRowUpperEntry, + machineRowUpperCurrent_pack, machineListHead_cons, + machineNearbyCoordinateComplementCode_encode] + +@[simp] theorem machineRowUpperLogRawCode_semCode {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℚ) + (rowRuler : List Bool) (q : ℚ) (qs : List ℚ) (acc : RawRat) + (bound : List Bool) : + machineRowUpperLogRawCode + (rowUpperSemCode + (pair rowRuler (rationalOptimizerOutputCode ⟨X, R, C⟩)) bound + ⟨q :: qs, acc⟩) = + rawRatBinaryCode + (rawScheduledLogUpper (1 - q) (directedCertificatePrecision n)) := by + have hcomp := machineRowUpperComplementCode_semCode + X R C rowRuler q qs acc bound + dsimp only [rowUpperSemCode] at hcomp + rw [machineRowUpperLogRawCode] + simp only [rowUpperSemCode, machineRowUpperSource_pack, + machineRowUpperOptimizerWord, machinePairSecond_pair, + machineCertificateLogPrecisionRuler_encode] + rw [hcomp, machineScheduledLogUpperRawCode_encode] + +theorem machineRowUpperStep_semantics {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℚ) + (rowRuler bound : List Bool) (s : RowUpperSemState) (budget : ℕ) + (hs : RowUpperSemInvariant (directedCertificatePrecision n) budget s) + (hlarge : 4 + 3 * budget ≤ bound.length) : + machineRowUpperStep + (rowUpperSemCode + (pair rowRuler (rationalOptimizerOutputCode ⟨X, R, C⟩)) bound s) = + rowUpperSemCode + (pair rowRuler (rationalOptimizerOutputCode ⟨X, R, C⟩)) bound + (rowUpperSemStep (directedCertificatePrecision n) s) := by + rcases s with ⟨current, acc⟩ + cases current with + | nil => + simp [rowUpperSemCode, rowUpperSemStep, machineRowUpperStep, + binaryListCode] + | cons q qs => + have hlog := machineRowUpperLogRawCode_semCode + X R C rowRuler q qs acc bound + dsimp only [rowUpperSemCode] at hlog + have hnext : rawRatWidth + (acc.add (rawScheduledLogUpper (1 - q) + (directedCertificatePrecision n))) ≤ budget := by + have hinv := rowUpperSemStep_invariant hs + have hinv' : rawRatWidth + (acc.add (rawScheduledLogUpper (1 - q) + (directedCertificatePrecision n))) + + rawRowComplementUpperCost (directedCertificatePrecision n) qs ≤ + budget := by + simpa only [RowUpperSemInvariant, rowUpperSemStep] using hinv + omega + have hcode : + (rawRatBinaryCode + (acc.add (rawScheduledLogUpper (1 - q) + (directedCertificatePrecision n)))).length ≤ bound.length := + (rawRatBinaryCode_length_le_width _).trans + ((Nat.add_le_add_left (Nat.mul_le_mul_left 3 hnext) 4).trans hlarge) + rw [rowUpperSemCode, rowUpperSemStep, machineRowUpperStep] + simp only [machineRowUpperCurrent_pack] + rw [machineIfEmpty_of_ne_nil_matrix _ _ _ + (binaryListCode_cons_ne_nil rationalEntryBinaryCode q qs)] + simp only [machineRowUpperSource_pack, machineRowUpperCurrent_pack, + machineRowUpperAcc_pack, machineRowUpperBound_pack, + machineListTail_cons, machineRowUpperNextAcc, + machineRowUpperCandidate] + rw [hlog] + rw [machineRawRatAddCode_encode] + rw [(List.take_eq_self_iff _).mpr hcode] + rfl + +theorem machineRowUpperIterate_semantics {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℚ) + (rowRuler bound : List Bool) (s : RowUpperSemState) (budget : ℕ) + (hs : RowUpperSemInvariant (directedCertificatePrecision n) budget s) + (hlarge : 4 + 3 * budget ≤ bound.length) : ∀ k, + (machineRowUpperStep)^[k] + (rowUpperSemCode + (pair rowRuler (rationalOptimizerOutputCode ⟨X, R, C⟩)) bound s) = + rowUpperSemCode + (pair rowRuler (rationalOptimizerOutputCode ⟨X, R, C⟩)) bound + ((rowUpperSemStep (directedCertificatePrecision n))^[k] s) := by + intro k + have hinv : ∀ t, RowUpperSemInvariant (directedCertificatePrecision n) + budget ((rowUpperSemStep (directedCertificatePrecision n))^[t] s) := by + intro t + induction t with + | zero => exact hs + | succ t iht => + rw [Function.iterate_succ_apply'] + exact rowUpperSemStep_invariant iht + induction k with + | zero => rfl + | succ k ih => + rw [Function.iterate_succ_apply', Function.iterate_succ_apply', ih] + exact machineRowUpperStep_semantics X R C rowRuler bound _ budget + (hinv k) hlarge + +theorem rowUpperSem_processList (p : ℕ) (xs : List ℚ) (acc : RawRat) : + (rowUpperSemStep p)^[xs.length] ⟨xs, acc⟩ = + ⟨[], rawRowComplementUpperSum p acc xs⟩ := by + induction xs generalizing acc with + | nil => rfl + | cons q qs ih => + rw [List.length_cons, Function.iterate_succ_apply, + rowUpperSemStep, ih] + rfl + +theorem machineRowUpper_done_iterate + (extra : ℕ) (source : List Bool) (acc : RawRat) (bound : List Bool) : + (machineRowUpperStep)^[extra] + (machineRowUpperPack source [] (rawRatBinaryCode acc) bound) = + machineRowUpperPack source [] (rawRatBinaryCode acc) bound := by + induction extra with + | zero => rfl + | succ k ih => + rw [Function.iterate_succ_apply', ih] + simp [machineRowUpperStep] + +def rawRowComplementUpperInputWidthBudget (L : ℕ) : ℕ := + 64 * ((L + 400) + 2 * (44 + 12 * L) + 4) ^ 2 * + ((44 + 12 * L) + 2) + +theorem rawScheduledLogUpper_complement_width_le_query + {n : ℕ} (X : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℚ) + (i j : Fin n) : + rawRatWidth (rawScheduledLogUpper (1 - X i j) + (directedCertificatePrecision n)) ≤ + rawRowComplementUpperInputWidthBudget + (pair (List.replicate i.1 true) + (rationalOptimizerOutputCode ⟨X, R, C⟩)).length := by + let optimizer := rationalOptimizerOutputCode ⟨X, R, C⟩ + let word := pair (List.replicate i.1 true) optimizer + let L := word.length + have hentryCode : (rationalEntryBinaryCode (X i j)).length ≤ + optimizer.length := by + have hrow : List.ofFn (X i) ∈ rationalMatrixRows X := by + simp [rationalMatrixRows] + have hq : X i j ∈ List.ofFn (X i) := by simp + have hqCode := binaryListCode_element_length_le rationalEntryBinaryCode hq + have hrowCode := binaryListCode_element_length_le + (binaryListCode rationalEntryBinaryCode) hrow + have hrowsCode : + (binaryListCode (binaryListCode rationalEntryBinaryCode) + (rationalMatrixRows X)).length ≤ optimizer.length := by + calc + _ = (machineMatrixRowsWord + (rationalMatrixBinaryEncoding.encode ⟨n, X⟩)).length := by + simpa using congrArg List.length (machineMatrixRowsWord_encode X).symm + _ ≤ (rationalMatrixBinaryEncoding.encode ⟨n, X⟩).length := by + simpa only [machineMatrixRowsWord] using machinePairSecond_length_le + (rationalMatrixBinaryEncoding.encode ⟨n, X⟩) + _ ≤ optimizer.length := by + simpa only [optimizer, rationalOptimizerOutputCode, + machinePairFirst_pair] using machinePairFirst_length_le optimizer + exact hqCode.trans (hrowCode.trans hrowsCode) + have hxWidth : rawRatWidth (rawRatOfRat (X i j)) ≤ L := by + have hentryRaw : + (rawRatBinaryCode (rawRatOfRat (X i j))).length ≤ optimizer.length := by + simpa only [rawRatBinaryCode_rawRatOfRat] using hentryCode + have hoptimizerWord : optimizer.length ≤ word.length := by + simpa only [word, machinePairSecond_pair] using + machinePairSecond_length_le word + exact (rawRatWidth_le_binaryCode_length _).trans + (hentryRaw.trans hoptimizerWord) + have hcomp := rawRatWidth_complement_le (X i j) + have hcompL : rawRatWidth (rawRatOfRat (1 - X i j)) ≤ 44 + 12 * L := by + omega + have hn := matrix_dimension_le_code_length X + have hnL : n ≤ L := by + have hmatrix : + (rationalMatrixBinaryEncoding.encode ⟨n, X⟩).length ≤ optimizer.length := by + simpa only [optimizer, rationalOptimizerOutputCode, + machinePairFirst_pair] using machinePairFirst_length_le optimizer + have hoptimizerWord : optimizer.length ≤ word.length := by + simpa only [word, machinePairSecond_pair] using + machinePairSecond_length_le word + exact hn.trans (hmatrix.trans hoptimizerWord) + have hp : directedCertificatePrecision n ≤ L + 400 := by + rw [directedCertificatePrecision] + omega + simpa only [rawRowComplementUpperInputWidthBudget, L] using + rawRatWidth_scheduledLogUpper_of_bounds_le (1 - X i j) hp hcompL + +theorem rawRowComplementUpperCost_le_query + {n : ℕ} (X : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℚ) + (i : Fin n) : + rawRowComplementUpperCost (directedCertificatePrecision n) + (List.ofFn (X i)) ≤ + (pair (List.replicate i.1 true) + (rationalOptimizerOutputCode ⟨X, R, C⟩)).length * + (rawRowComplementUpperInputWidthBudget + (pair (List.replicate i.1 true) + (rationalOptimizerOutputCode ⟨X, R, C⟩)).length + 1) := by + let word := pair (List.replicate i.1 true) + (rationalOptimizerOutputCode ⟨X, R, C⟩) + let budget := rawRowComplementUpperInputWidthBudget word.length + have hpoint : ∀ q ∈ List.ofFn (X i), + rawRatWidth (rawScheduledLogUpper (1 - q) + (directedCertificatePrecision n)) ≤ budget := by + intro q hq + obtain ⟨j, rfl⟩ := List.mem_ofFn.mp hq + simpa only [word, budget] using + rawScheduledLogUpper_complement_width_le_query X R C i j + have rawCost_le_uniform : ∀ xs : List ℚ, + (∀ q ∈ xs, rawRatWidth (rawScheduledLogUpper (1 - q) + (directedCertificatePrecision n)) ≤ budget) → + rawRowComplementUpperCost (directedCertificatePrecision n) xs ≤ + xs.length * (budget + 1) := by + intro xs hxs + induction xs with + | nil => simp [rawRowComplementUpperCost] + | cons q qs ih => + have hq := hxs q (by simp) + have htail : ∀ r ∈ qs, + rawRatWidth (rawScheduledLogUpper (1 - r) + (directedCertificatePrecision n)) ≤ budget := by + intro r hr + exact hxs r (by simp [hr]) + have ih' := ih htail + have ih'' : + (qs.map fun r => rawRatWidth + (rawScheduledLogUpper (1 - r) + (directedCertificatePrecision n)) + 1).sum ≤ + qs.length * (budget + 1) := by + simpa only [rawRowComplementUpperCost] using ih' + simp only [rawRowComplementUpperCost, List.map_cons, List.sum_cons, + List.length_cons, Nat.add_mul] + omega + have hcost := rawCost_le_uniform (List.ofFn (X i)) hpoint + have hn : (List.ofFn (X i)).length = n := by simp + have hnword : n ≤ word.length := by + have hnopt := matrix_dimension_le_code_length X + have hmatrix : + (rationalMatrixBinaryEncoding.encode ⟨n, X⟩).length ≤ + (rationalOptimizerOutputCode ⟨X, R, C⟩).length := by + simpa only [rationalOptimizerOutputCode, machinePairFirst_pair] using + machinePairFirst_length_le + (rationalOptimizerOutputCode ⟨X, R, C⟩) + have hoptimizerWord : + (rationalOptimizerOutputCode ⟨X, R, C⟩).length ≤ word.length := by + simpa only [word, machinePairSecond_pair] using + machinePairSecond_length_le word + exact hnopt.trans (hmatrix.trans hoptimizerWord) + rw [hn] at hcost + exact hcost.trans (Nat.mul_le_mul_right (budget + 1) hnword) + +theorem machineRowUpperInputBound_length_dominates (word : List Bool) : + 4 + 3 * (1 + word.length * + (rawRowComplementUpperInputWidthBudget word.length + 1)) ≤ + (machineRowUpperInputBound word).length := by + have hnear := machineNearbyMatrixInputBound_length_dominates word + have hbudget : rawRowComplementUpperInputWidthBudget word.length ≤ + rawNearbyCoordinateInputWidthBudget word.length := by + simp only [rawRowComplementUpperInputWidthBudget, + rawNearbyCoordinateInputWidthBudget] + omega + have hmul := Nat.mul_le_mul_left word.length + (Nat.add_le_add_right hbudget 1) + have htarget : + 4 + 3 * (1 + word.length * + (rawRowComplementUpperInputWidthBudget word.length + 1)) ≤ + 4 + 3 * (1 + word.length * + (rawNearbyCoordinateInputWidthBudget word.length + 1)) := by omega + simpa only [machineRowUpperInputBound, machineNearbyMatrixInputBound] using + htarget.trans hnear + +@[simp] theorem machineRowComplementUpperSumRawCode_encode + {n : ℕ} (X : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℚ) + (i : Fin n) : + machineRowComplementUpperSumRawCode + (pair (List.replicate i.1 true) + (rationalOptimizerOutputCode ⟨X, R, C⟩)) = + rawRatBinaryCode + (rawRowComplementUpperSum (directedCertificatePrecision n) + RawRat.zero (List.ofFn (X i))) := by + let word := pair (List.replicate i.1 true) + (rationalOptimizerOutputCode ⟨X, R, C⟩) + let xs := List.ofFn (X i) + let p := directedCertificatePrecision n + let s : RowUpperSemState := ⟨xs, RawRat.zero⟩ + let budget := 1 + rawRowComplementUpperCost p xs + have hinv : RowUpperSemInvariant p budget s := by + simp [RowUpperSemInvariant, s, budget, rawRatWidth_zero] + have hrowCode : (binaryListCode rationalEntryBinaryCode xs).length ≤ + word.length := by + calc + _ = (machineRowUpperInitialRow word).length := by + simpa only [word, xs] using congrArg List.length + (machineRowUpperInitialRow_encode X R C i).symm + _ ≤ word.length := by + have hindex := machineListIndex_length_le_data + (pair (machineRowUpperRowRuler word) + (machineMatrixRowsWord (machineRowUpperMatrixWord word))) + simp only [machineListIndexData, machinePairSecond_pair] at hindex + exact hindex.trans + ((machinePairSecond_length_le + (machineRowUpperMatrixWord word)).trans + ((machinePairFirst_length_le + (machineRowUpperOptimizerWord word)).trans + (machinePairSecond_length_le word))) + have hwork : xs.length ≤ word.length := by + exact (list_length_le_binaryListCode_length + rationalEntryBinaryCode xs).trans hrowCode + have hsplit : word.length = (word.length - xs.length) + xs.length := by omega + have hinit : machineRowUpperInit word = + rowUpperSemCode word (machineRowUpperInputBound word) s := by + simp [machineRowUpperInit, rowUpperSemCode, s, word, xs, + machineRowUpperInitialRow_encode] + have hcost := rawRowComplementUpperCost_le_query X R C i + have hruler := machineRowUpperInputBound_length_dominates word + have hlarge : 4 + 3 * budget ≤ + (machineRowUpperInputBound word).length := by + have hbudget : budget ≤ 1 + word.length * + (rawRowComplementUpperInputWidthBudget word.length + 1) := by + dsimp only [budget, p, xs, word] at hcost ⊢ + omega + exact (Nat.add_le_add_left (Nat.mul_le_mul_left 3 hbudget) 4).trans + hruler + rw [machineRowComplementUpperSumRawCode, machineRowUpperFinalState, + hsplit, Function.iterate_add_apply, hinit, + machineRowUpperIterate_semantics X R C (List.replicate i.1 true) + (machineRowUpperInputBound word) s budget hinv hlarge, + rowUpperSem_processList] + simp only [rowUpperSemCode, binaryListCode] + rw [machineRowUpper_done_iterate] + simp [machineRowUpperAcc_pack, xs] + +theorem rawRowComplementUpperSum_value (p : ℕ) (acc : RawRat) : ∀ xs, + (rawRowComplementUpperSum p acc xs).value = + acc.value + (xs.map fun q => scheduledLogUpper (1 - q) p).sum := by + intro xs + induction xs generalizing acc with + | nil => simp [rawRowComplementUpperSum] + | cons q qs ih => + rw [rawRowComplementUpperSum, ih] + simp [rawScheduledLogUpper_value, add_assoc] + +theorem rawRowComplementUpperSum_matrix_value {n : ℕ} + (X : Matrix (Fin n) (Fin n) ℚ) (i : Fin n) (p : ℕ) : + (rawRowComplementUpperSum p RawRat.zero (List.ofFn (X i))).value = + ∑ k, scheduledLogUpper (1 - X i k) p := by + rw [rawRowComplementUpperSum_value] + simp [List.sum_ofFn] + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRowPairDisjoint.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRowPairDisjoint.lean new file mode 100644 index 0000000000..db115ff296 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRowPairDisjoint.lean @@ -0,0 +1,493 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineCertifiedPairEligibility +import LeanPool.BeyondBethe.BeyondBethe.MachineListReverse + +/-! +# Disjointness from an encoded row-pair list + +An ordered row pair is encoded as a pair of unary row rulers. The scanner +tests whether a candidate pair shares an endpoint with any selected pair. +It iterates for the bit-length of the selected-list encoding, so malformed +inputs remain polynomially bounded; after the encoded list is exhausted the +step stutters. +-/ + +namespace BeyondBethe + +open Complexity + +def orderedRowPairCode {n : ℕ} (q : Fin n × Fin n) : List Bool := + pair (finUnaryCode q.1) (finUnaryCode q.2) + +def machineDisjointCandidateFirst (word : List Bool) : List Bool := + machinePairFirst word + +def machineDisjointRest (word : List Bool) : List Bool := + machinePairSecond word + +def machineDisjointCandidateSecond (word : List Bool) : List Bool := + machinePairFirst (machineDisjointRest word) + +def machineDisjointSelectedList (word : List Bool) : List Bool := + machinePairSecond (machineDisjointRest word) + +def machineDisjointPack + (remaining conflict source : List Bool) : List Bool := + pair remaining (pair conflict source) + +def machineDisjointRemaining (state : List Bool) : List Bool := + machinePairFirst state + +def machineDisjointConflict (state : List Bool) : List Bool := + machinePairFirst (machinePairSecond state) + +def machineDisjointSource (state : List Bool) : List Bool := + machinePairSecond (machinePairSecond state) + +def machineDisjointCurrentPair (state : List Bool) : List Bool := + machineListHead (machineDisjointRemaining state) + +def machineDisjointCurrentFirst (state : List Bool) : List Bool := + machinePairFirst (machineDisjointCurrentPair state) + +def machineDisjointCurrentSecond (state : List Bool) : List Bool := + machinePairSecond (machineDisjointCurrentPair state) + +def machineUnaryRulersEqualBit (lhs rhs : List Bool) : List Bool := + machineBinaryNatEqBit (pair (machineLengthBits lhs) (machineLengthBits rhs)) + +def machineDisjointIFirstBit (state : List Bool) : List Bool := + machineUnaryRulersEqualBit + (machineDisjointCandidateFirst (machineDisjointSource state)) + (machineDisjointCurrentFirst state) + +def machineDisjointISecondBit (state : List Bool) : List Bool := + machineUnaryRulersEqualBit + (machineDisjointCandidateFirst (machineDisjointSource state)) + (machineDisjointCurrentSecond state) + +def machineDisjointJFirstBit (state : List Bool) : List Bool := + machineUnaryRulersEqualBit + (machineDisjointCandidateSecond (machineDisjointSource state)) + (machineDisjointCurrentFirst state) + +def machineDisjointJSecondBit (state : List Bool) : List Bool := + machineUnaryRulersEqualBit + (machineDisjointCandidateSecond (machineDisjointSource state)) + (machineDisjointCurrentSecond state) + +def machineDisjointCurrentConflictBit (state : List Bool) : List Bool := + machineOrBit (machineDisjointIFirstBit state) + (machineOrBit (machineDisjointISecondBit state) + (machineOrBit (machineDisjointJFirstBit state) + (machineDisjointJSecondBit state))) + +def machineDisjointInputBound (word : List Bool) : List Bool := + pair [false] word + +def machineDisjointNextConflict (state : List Bool) : List Bool := + (machineOrBit (machineDisjointConflict state) + (machineDisjointCurrentConflictBit state)).take + (machineDisjointInputBound (machineDisjointSource state)).length + +def machineDisjointProcess (state : List Bool) : List Bool := + machineDisjointPack (machineListTail (machineDisjointRemaining state)) + (machineDisjointNextConflict state) (machineDisjointSource state) + +def machineDisjointStep (state : List Bool) : List Bool := + machineIfEmpty (machineDisjointRemaining state) state + (machineDisjointProcess state) + +def machineDisjointInit (word : List Bool) : List Bool := + machineDisjointPack (machineDisjointSelectedList word) [false] word + +def machineDisjointWidth (word : List Bool) : List Bool := + let bound := machineDisjointInputBound word + machineDisjointPack bound bound bound + +def machineDisjointFinalState (word : List Bool) : List Bool := + (machineDisjointStep)^[(machineDisjointSelectedList word).length] + (machineDisjointInit word) + +def machineRowPairConflictBit (word : List Bool) : List Bool := + machineDisjointConflict (machineDisjointFinalState word) + +/-- One bit, true exactly when the candidate is disjoint from every encoded +selected pair on canonical inputs. -/ +def machineRowPairDisjointBit (word : List Bool) : List Bool := + machineNotBit (machineRowPairConflictBit word) + +theorem machineDisjointCandidateFirst_mem_FP : + machineDisjointCandidateFirst ∈ FP := machinePairFirst_mem_FP + +theorem machineDisjointRest_mem_FP : machineDisjointRest ∈ FP := + machinePairSecond_mem_FP + +theorem machineDisjointCandidateSecond_mem_FP : + machineDisjointCandidateSecond ∈ FP := by + simpa only [machineDisjointCandidateSecond] using machineCompose_mem_FP + machineDisjointRest_mem_FP machinePairFirst_mem_FP + +theorem machineDisjointSelectedList_mem_FP : + machineDisjointSelectedList ∈ FP := by + simpa only [machineDisjointSelectedList] using machineCompose_mem_FP + machineDisjointRest_mem_FP machinePairSecond_mem_FP + +theorem machineDisjointRemaining_mem_FP : machineDisjointRemaining ∈ FP := + machinePairFirst_mem_FP + +theorem machineDisjointConflict_mem_FP : machineDisjointConflict ∈ FP := by + simpa only [machineDisjointConflict] using machineCompose_mem_FP + machinePairSecond_mem_FP machinePairFirst_mem_FP + +theorem machineDisjointSource_mem_FP : machineDisjointSource ∈ FP := by + simpa only [machineDisjointSource] using machineCompose_mem_FP + machinePairSecond_mem_FP machinePairSecond_mem_FP + +theorem machineDisjointCurrentPair_mem_FP : + machineDisjointCurrentPair ∈ FP := by + simpa only [machineDisjointCurrentPair] using machineCompose_mem_FP + machineDisjointRemaining_mem_FP machineListHead_mem_FP + +theorem machineDisjointCurrentFirst_mem_FP : + machineDisjointCurrentFirst ∈ FP := by + simpa only [machineDisjointCurrentFirst] using machineCompose_mem_FP + machineDisjointCurrentPair_mem_FP machinePairFirst_mem_FP + +theorem machineDisjointCurrentSecond_mem_FP : + machineDisjointCurrentSecond ∈ FP := by + simpa only [machineDisjointCurrentSecond] using machineCompose_mem_FP + machineDisjointCurrentPair_mem_FP machinePairSecond_mem_FP + +theorem machineUnaryRulersEqualBit_mem_FP + {lhs rhs : List Bool → List Bool} (hlhs : lhs ∈ FP) (hrhs : rhs ∈ FP) : + (fun word ↦ machineUnaryRulersEqualBit (lhs word) (rhs word)) ∈ FP := by + have hl := machineCompose_mem_FP hlhs machineLengthBits_mem_FP + have hr := machineCompose_mem_FP hrhs machineLengthBits_mem_FP + have hinput := machinePair_mem_FP hl hr + simpa only [machineUnaryRulersEqualBit] using machineCompose_mem_FP hinput + machineBinaryNatEqBit_mem_FP + +theorem machineDisjointIFirstBit_mem_FP : machineDisjointIFirstBit ∈ FP := by + exact machineUnaryRulersEqualBit_mem_FP + (machineCompose_mem_FP machineDisjointSource_mem_FP + machineDisjointCandidateFirst_mem_FP) + machineDisjointCurrentFirst_mem_FP + +theorem machineDisjointISecondBit_mem_FP : machineDisjointISecondBit ∈ FP := by + exact machineUnaryRulersEqualBit_mem_FP + (machineCompose_mem_FP machineDisjointSource_mem_FP + machineDisjointCandidateFirst_mem_FP) + machineDisjointCurrentSecond_mem_FP + +theorem machineDisjointJFirstBit_mem_FP : machineDisjointJFirstBit ∈ FP := by + exact machineUnaryRulersEqualBit_mem_FP + (machineCompose_mem_FP machineDisjointSource_mem_FP + machineDisjointCandidateSecond_mem_FP) + machineDisjointCurrentFirst_mem_FP + +theorem machineDisjointJSecondBit_mem_FP : machineDisjointJSecondBit ∈ FP := by + exact machineUnaryRulersEqualBit_mem_FP + (machineCompose_mem_FP machineDisjointSource_mem_FP + machineDisjointCandidateSecond_mem_FP) + machineDisjointCurrentSecond_mem_FP + +theorem machineDisjointCurrentConflictBit_mem_FP : + machineDisjointCurrentConflictBit ∈ FP := by + exact machineOrBit_mem_FP machineDisjointIFirstBit_mem_FP + (machineOrBit_mem_FP machineDisjointISecondBit_mem_FP + (machineOrBit_mem_FP machineDisjointJFirstBit_mem_FP + machineDisjointJSecondBit_mem_FP)) + +theorem machineDisjointInputBound_mem_FP : machineDisjointInputBound ∈ FP := + machinePair_mem_FP (machineConst_mem_FP [false]) id_mem_FP + +theorem machineDisjointNextConflict_mem_FP : + machineDisjointNextConflict ∈ FP := by + have hdata := machineOrBit_mem_FP machineDisjointConflict_mem_FP + machineDisjointCurrentConflictBit_mem_FP + have hbound := machineCompose_mem_FP machineDisjointSource_mem_FP + machineDisjointInputBound_mem_FP + simpa only [machineDisjointNextConflict] using machineTake_mem_FP hbound hdata + +theorem machineDisjointProcess_mem_FP : machineDisjointProcess ∈ FP := by + have htail := machineCompose_mem_FP machineDisjointRemaining_mem_FP + machineListTail_mem_FP + exact machinePair_mem_FP htail + (machinePair_mem_FP machineDisjointNextConflict_mem_FP + machineDisjointSource_mem_FP) + +theorem machineDisjointStep_mem_FP : machineDisjointStep ∈ FP := by + simpa only [machineDisjointStep] using machineIfEmpty_mem_FP + machineDisjointRemaining_mem_FP id_mem_FP machineDisjointProcess_mem_FP + +theorem machineDisjointInit_mem_FP : machineDisjointInit ∈ FP := + machinePair_mem_FP machineDisjointSelectedList_mem_FP + (machinePair_mem_FP (machineConst_mem_FP [false]) id_mem_FP) + +theorem machineDisjointWidth_mem_FP : machineDisjointWidth ∈ FP := + machinePair_mem_FP machineDisjointInputBound_mem_FP + (machinePair_mem_FP machineDisjointInputBound_mem_FP + machineDisjointInputBound_mem_FP) + +@[simp] theorem machineDisjointRemaining_pack (remaining conflict source) : + machineDisjointRemaining (machineDisjointPack remaining conflict source) = + remaining := by simp [machineDisjointRemaining, machineDisjointPack] + +@[simp] theorem machineDisjointConflict_pack (remaining conflict source) : + machineDisjointConflict (machineDisjointPack remaining conflict source) = + conflict := by simp [machineDisjointConflict, machineDisjointPack] + +@[simp] theorem machineDisjointSource_pack (remaining conflict source) : + machineDisjointSource (machineDisjointPack remaining conflict source) = + source := by simp [machineDisjointSource, machineDisjointPack] + +def MachineDisjointStateBound (word state : List Bool) : Prop := + let B := (machineDisjointInputBound word).length + state = machineDisjointPack (machineDisjointRemaining state) + (machineDisjointConflict state) (machineDisjointSource state) ∧ + (machineDisjointRemaining state).length ≤ B ∧ + (machineDisjointConflict state).length ≤ B ∧ + machineDisjointSource state = word + +theorem machineDisjointSelected_length_le (word : List Bool) : + (machineDisjointSelectedList word).length ≤ + (machineDisjointInputBound word).length := by + exact ((machinePairSecond_length_le (machineDisjointRest word)).trans + (machinePairSecond_length_le word)).trans + (by + simp only [machineDisjointInputBound, pair_length] + omega) + +theorem machineDisjoint_one_le_bound (word : List Bool) : + 1 ≤ (machineDisjointInputBound word).length := by + simp only [machineDisjointInputBound, pair_length] + omega + +theorem machineDisjoint_source_le_bound (word : List Bool) : + word.length ≤ (machineDisjointInputBound word).length := by + simp only [machineDisjointInputBound, pair_length] + omega + +theorem machineDisjointInit_bound (word : List Bool) : + MachineDisjointStateBound word (machineDisjointInit word) := by + simp only [MachineDisjointStateBound, machineDisjointInit, + machineDisjointRemaining_pack, machineDisjointConflict_pack, + machineDisjointSource_pack] + exact ⟨trivial, machineDisjointSelected_length_le word, + machineDisjoint_one_le_bound word, trivial⟩ + +theorem machineDisjointStep_bound {word state : List Bool} + (hstate : MachineDisjointStateBound word state) : + MachineDisjointStateBound word (machineDisjointStep state) := by + rcases hstate with ⟨hpack, hremaining, hconflict, hsource⟩ + by_cases hrem : machineDisjointRemaining state = [] + · rw [machineDisjointStep, hrem, machineIfEmpty_nil] + exact ⟨hpack, hremaining, hconflict, hsource⟩ + · rw [machineDisjointStep] + cases hcode : machineDisjointRemaining state with + | nil => exact False.elim (hrem hcode) + | cons bit tail => + rw [machineIfEmpty_cons, machineDisjointProcess] + simp only [MachineDisjointStateBound, machineDisjointRemaining_pack, + machineDisjointConflict_pack, machineDisjointSource_pack] + refine ⟨trivial, ?_, ?_, hsource⟩ + · exact (machinePairSecond_length_le + (machineDisjointRemaining state)).trans hremaining + · simp only [machineDisjointNextConflict, List.length_take] + rw [hsource] + exact Nat.min_le_left _ _ + +theorem machineDisjointIterate_bound (word : List Bool) : ∀ k, + MachineDisjointStateBound word + ((machineDisjointStep)^[k] (machineDisjointInit word)) := by + intro k + induction k with + | zero => exact machineDisjointInit_bound word + | succ k ih => + rw [Function.iterate_succ_apply'] + exact machineDisjointStep_bound ih + +theorem machineDisjointIterate_length_le_width + (word : List Bool) (iterations : ℕ) + (_ : iterations ≤ (machineDisjointSelectedList word).length) : + ((machineDisjointStep)^[iterations] (machineDisjointInit word)).length ≤ + (machineDisjointWidth word).length := by + rcases machineDisjointIterate_bound word iterations with + ⟨hpack, hremaining, hconflict, hsource⟩ + have hsourceLength : (machineDisjointSource + ((machineDisjointStep)^[iterations] (machineDisjointInit word))).length ≤ + (machineDisjointInputBound word).length := by + rw [hsource] + exact machineDisjoint_source_le_bound word + rw [hpack] + simp only [machineDisjointPack, machineDisjointWidth, pair_length] + omega + +theorem machineDisjointFinalState_mem_FP : machineDisjointFinalState ∈ FP := by + exact Cobham.iterate_mem_FP machineDisjointStep_mem_FP + machineDisjointInit_mem_FP machineDisjointSelectedList_mem_FP + machineDisjointWidth_mem_FP machineDisjointIterate_length_le_width + +theorem machineRowPairConflictBit_mem_FP : machineRowPairConflictBit ∈ FP := by + simpa only [machineRowPairConflictBit] using machineCompose_mem_FP + machineDisjointFinalState_mem_FP machineDisjointConflict_mem_FP + +theorem machineRowPairDisjointBit_mem_FP : machineRowPairDisjointBit ∈ FP := + machineNotBit_mem_FP machineRowPairConflictBit_mem_FP + +/-! ## Exact semantics -/ + +def orderedPairsConflict {n : ℕ} + (i j : Fin n) (selected : List (Fin n × Fin n)) : Bool := + selected.any fun q ↦ decide (i = q.1 ∨ i = q.2 ∨ j = q.1 ∨ j = q.2) + +def machineDisjointInput {n : ℕ} + (i j : Fin n) (selected : List (Fin n × Fin n)) : List Bool := + pair (finUnaryCode i) + (pair (finUnaryCode j) (binaryListCode orderedRowPairCode selected)) + +@[simp] theorem machineUnaryRulersEqualBit_encode {n : ℕ} + (i j : Fin n) : + machineUnaryRulersEqualBit (finUnaryCode i) (finUnaryCode j) = + [decide (i = j)] := by + rw [machineUnaryRulersEqualBit] + simp only [machineLengthBits_encode, finUnaryCode, List.length_replicate, + machineBinaryNatEqBit_pair_natBits] + by_cases hval : i.1 = j.1 + · have h : i = j := Fin.ext hval + simp [hval, h] + · have h : i ≠ j := fun hij ↦ hval (congrArg Fin.val hij) + simp [hval, h] + +@[simp] theorem machineDisjointCurrentConflictBit_encode {n : ℕ} + (i j x y : Fin n) (qs sourceSelected : List (Fin n × Fin n)) + (conflict : Bool) : + machineDisjointCurrentConflictBit + (machineDisjointPack + (binaryListCode orderedRowPairCode ((x, y) :: qs)) [conflict] + (machineDisjointInput i j sourceSelected)) = + [decide (i = x ∨ i = y ∨ j = x ∨ j = y)] := by + simp only [machineDisjointCurrentConflictBit, machineDisjointIFirstBit, + machineDisjointISecondBit, machineDisjointJFirstBit, + machineDisjointJSecondBit, machineDisjointSource_pack, + machineDisjointCurrentFirst, machineDisjointCurrentSecond, + machineDisjointCurrentPair, machineDisjointRemaining_pack, + machineListHead_cons, orderedRowPairCode, machinePairFirst_pair, + machinePairSecond_pair, machineDisjointCandidateFirst, + machineDisjointCandidateSecond, machineDisjointRest, + machineDisjointInput, machineUnaryRulersEqualBit_encode, + machineOrBit_one] + by_cases hix : i = x <;> by_cases hiy : i = y <;> + by_cases hjx : j = x <;> by_cases hjy : j = y <;> + simp [hix, hiy, hjx, hjy] + +def machineDisjointSemanticState {n : ℕ} + (i j : Fin n) (selected : List (Fin n × Fin n)) (k : ℕ) : List Bool := + machineDisjointPack + (binaryListCode orderedRowPairCode (selected.drop k)) + [orderedPairsConflict i j (selected.take k)] + (machineDisjointInput i j selected) + +@[simp] theorem machineDisjointSemanticState_zero {n : ℕ} + (i j : Fin n) (selected : List (Fin n × Fin n)) : + machineDisjointSemanticState i j selected 0 = + machineDisjointInit (machineDisjointInput i j selected) := by + simp [machineDisjointSemanticState, machineDisjointInit, + machineDisjointInput, machineDisjointSelectedList, + machineDisjointRest, orderedPairsConflict] + +theorem machineDisjointSemanticState_step {n : ℕ} + (i j : Fin n) (selected : List (Fin n × Fin n)) + (k : ℕ) (hk : k < selected.length) : + machineDisjointStep (machineDisjointSemanticState i j selected k) = + machineDisjointSemanticState i j selected (k + 1) := by + rw [machineDisjointSemanticState, List.drop_eq_getElem_cons hk, + machineDisjointStep] + simp only [machineDisjointRemaining_pack] + rw [machineIfEmpty_of_ne_nil_matrix _ _ _ + (binaryListCode_cons_ne_nil orderedRowPairCode selected[k] + (selected.drop (k + 1)))] + rw [machineDisjointProcess] + simp only [machineDisjointRemaining_pack, machineListTail_cons, + machineDisjointSource_pack, machineDisjointNextConflict, + machineDisjointConflict_pack] + rcases hp : selected[k] with ⟨x, y⟩ + rw [machineDisjointCurrentConflictBit_encode] + simp only [machineOrBit_one] + have hbound : 1 ≤ + (machineDisjointInputBound (machineDisjointInput i j selected)).length := + machineDisjoint_one_le_bound _ + rw [(List.take_eq_self_iff _).2 (by simpa using hbound)] + rw [machineDisjointSemanticState] + apply congrArg (fun z : Bool ↦ machineDisjointPack + (binaryListCode orderedRowPairCode (selected.drop (k + 1))) [z] + (machineDisjointInput i j selected)) + rw [orderedPairsConflict, orderedPairsConflict, + ← List.take_concat_get hk, List.concat_eq_append, List.any_append] + simp [hp] + +theorem machineDisjointIterate_semantics {n : ℕ} + (i j : Fin n) (selected : List (Fin n × Fin n)) : ∀ k ≤ selected.length, + (machineDisjointStep)^[k] + (machineDisjointInit (machineDisjointInput i j selected)) = + machineDisjointSemanticState i j selected k := by + intro k hk + induction k with + | zero => exact (machineDisjointSemanticState_zero i j selected).symm + | succ k ih => + rw [Function.iterate_succ_apply', ih (by omega)] + exact machineDisjointSemanticState_step i j selected k (by omega) + +theorem machineDisjoint_done_iterate + (extra : ℕ) (conflict source : List Bool) : + (machineDisjointStep)^[extra] + (machineDisjointPack [] conflict source) = + machineDisjointPack [] conflict source := by + induction extra with + | zero => rfl + | succ k ih => + rw [Function.iterate_succ_apply', ih] + simp [machineDisjointStep] + +@[simp] theorem machineDisjointSelectedList_input {n : ℕ} + (i j : Fin n) (selected : List (Fin n × Fin n)) : + machineDisjointSelectedList (machineDisjointInput i j selected) = + binaryListCode orderedRowPairCode selected := by + simp [machineDisjointSelectedList, machineDisjointRest, + machineDisjointInput] + +@[simp] theorem machineRowPairConflictBit_encode {n : ℕ} + (i j : Fin n) (selected : List (Fin n × Fin n)) : + machineRowPairConflictBit (machineDisjointInput i j selected) = + [orderedPairsConflict i j selected] := by + rw [machineRowPairConflictBit, machineDisjointFinalState, + machineDisjointSelectedList_input] + let word := binaryListCode orderedRowPairCode selected + have hle : selected.length ≤ word.length := + binaryListCode_listLength_le orderedRowPairCode selected + have hsplit : word.length = (word.length - selected.length) + selected.length := by + omega + rw [hsplit, Function.iterate_add_apply, + machineDisjointIterate_semantics i j selected selected.length le_rfl] + simp only [machineDisjointSemanticState, List.drop_length, List.take_length] + change machineDisjointConflict + ((machineDisjointStep)^[word.length - selected.length] + (machineDisjointPack [] [orderedPairsConflict i j selected] + (machineDisjointInput i j selected))) = _ + rw [machineDisjoint_done_iterate] + simp only [machineDisjointConflict_pack] + +@[simp] theorem machineRowPairDisjointBit_encode {n : ℕ} + (i j : Fin n) (selected : List (Fin n × Fin n)) : + machineRowPairDisjointBit (machineDisjointInput i j selected) = + [!orderedPairsConflict i j selected] := by + rw [machineRowPairDisjointBit, machineRowPairConflictBit_encode, + machineNotBit_one] + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineScheduledLog.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineScheduledLog.lean new file mode 100644 index 0000000000..e7a2d11833 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineScheduledLog.lean @@ -0,0 +1,267 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineCertificateScales +import LeanPool.BeyondBethe.BeyondBethe.MachineIntegerSignedMagnitude + +/-! +# The input-dependent directed-logarithm schedule + +`scheduledLogLower q p` uses `directedLogTerms q p`, not merely `p`, series +terms. This module computes that exact term count from the unary precision +ruler and the signed dyadic exponent of `q`, expands it under a quadratic +guard, and invokes the verified directed-logarithm machine. +-/ + +namespace BeyondBethe + +open Complexity + +def machineScheduledLogPrecisionRuler (word : List Bool) : List Bool := + machinePairFirst word + +def machineScheduledLogArgumentRawCode (word : List Bool) : List Bool := + machinePairSecond word + +def machineScheduledLogPrecisionBits (word : List Bool) : List Bool := + machineLengthBits (machineScheduledLogPrecisionRuler word) + +def machineScheduledLogExponentIntegerCode (word : List Bool) : List Bool := + machineDirectedLogExponentIntegerCode word + +def machineScheduledLogExponentAbsBits (word : List Bool) : List Bool := + machineIntegerNatAbsBits + (machineScheduledLogExponentIntegerCode word) + +def machineScheduledLogPrecisionPlusExponentBits + (word : List Bool) : List Bool := + machineBinaryAddBits + (pair (machineScheduledLogPrecisionBits word) + (machineScheduledLogExponentAbsBits word)) + +def machineScheduledLogTermsBits (word : List Bool) : List Bool := + machineBinaryAddBits + (pair (machineScheduledLogPrecisionPlusExponentBits word) + (2 : ℕ).bits) + +/-- A total quadratic guard. On canonical inputs it dominates the exact +input-dependent term count. -/ +def machineScheduledLogTermsGuard (word : List Bool) : List Bool := + machineBinaryMulWidth word + +def machineScheduledLogTermsRuler (word : List Bool) : List Bool := + machineBoundedUnary + (pair (machineScheduledLogTermsGuard word) + (machineScheduledLogTermsBits word)) + +def machineScheduledLogLowerRawCode (word : List Bool) : List Bool := + machineDirectedLogLowerRawCode + (pair (machineScheduledLogTermsRuler word) + (machineScheduledLogArgumentRawCode word)) + +def machineScheduledLogUpperRawCode (word : List Bool) : List Bool := + machineDirectedLogUpperRawCode + (pair (machineScheduledLogTermsRuler word) + (machineScheduledLogArgumentRawCode word)) + +theorem machineScheduledLogPrecisionRuler_mem_FP : + machineScheduledLogPrecisionRuler ∈ Complexity.FP := + machinePairFirst_mem_FP + +theorem machineScheduledLogArgumentRawCode_mem_FP : + machineScheduledLogArgumentRawCode ∈ Complexity.FP := + machinePairSecond_mem_FP + +theorem machineScheduledLogPrecisionBits_mem_FP : + machineScheduledLogPrecisionBits ∈ Complexity.FP := by + simpa only [machineScheduledLogPrecisionBits] using + machineCompose_mem_FP machineScheduledLogPrecisionRuler_mem_FP + machineLengthBits_mem_FP + +theorem machineScheduledLogExponentIntegerCode_mem_FP : + machineScheduledLogExponentIntegerCode ∈ Complexity.FP := by + simpa only [machineScheduledLogExponentIntegerCode] using + machineDirectedLogExponentIntegerCode_mem_FP + +theorem machineScheduledLogExponentAbsBits_mem_FP : + machineScheduledLogExponentAbsBits ∈ Complexity.FP := by + simpa only [machineScheduledLogExponentAbsBits] using + machineCompose_mem_FP machineScheduledLogExponentIntegerCode_mem_FP + machineIntegerNatAbsBits_mem_FP + +theorem machineScheduledLogPrecisionPlusExponentBits_mem_FP : + machineScheduledLogPrecisionPlusExponentBits ∈ Complexity.FP := by + have hpair := machinePair_mem_FP machineScheduledLogPrecisionBits_mem_FP + machineScheduledLogExponentAbsBits_mem_FP + simpa only [machineScheduledLogPrecisionPlusExponentBits] using + machineCompose_mem_FP hpair machineBinaryAddBits_mem_FP + +theorem machineScheduledLogTermsBits_mem_FP : + machineScheduledLogTermsBits ∈ Complexity.FP := by + have hpair := machinePair_mem_FP + machineScheduledLogPrecisionPlusExponentBits_mem_FP + (machineConst_mem_FP (2 : ℕ).bits) + simpa only [machineScheduledLogTermsBits] using + machineCompose_mem_FP hpair machineBinaryAddBits_mem_FP + +theorem machineScheduledLogTermsGuard_mem_FP : + machineScheduledLogTermsGuard ∈ Complexity.FP := + machineBinaryMulWidth_mem_FP + +theorem machineScheduledLogTermsRuler_mem_FP : + machineScheduledLogTermsRuler ∈ Complexity.FP := by + have hpair := machinePair_mem_FP machineScheduledLogTermsGuard_mem_FP + machineScheduledLogTermsBits_mem_FP + simpa only [machineScheduledLogTermsRuler] using + machineCompose_mem_FP hpair machineBoundedUnary_mem_FP + +theorem machineScheduledLogLowerRawCode_mem_FP : + machineScheduledLogLowerRawCode ∈ Complexity.FP := by + have hpair := machinePair_mem_FP machineScheduledLogTermsRuler_mem_FP + machineScheduledLogArgumentRawCode_mem_FP + simpa only [machineScheduledLogLowerRawCode] using + machineCompose_mem_FP hpair machineDirectedLogLowerRawCode_mem_FP + +theorem machineScheduledLogUpperRawCode_mem_FP : + machineScheduledLogUpperRawCode ∈ Complexity.FP := by + have hpair := machinePair_mem_FP machineScheduledLogTermsRuler_mem_FP + machineScheduledLogArgumentRawCode_mem_FP + simpa only [machineScheduledLogUpperRawCode] using + machineCompose_mem_FP hpair machineDirectedLogUpperRawCode_mem_FP + +@[simp] theorem machineScheduledLogPrecisionBits_encode + (q : ℚ) (p : ℕ) : + machineScheduledLogPrecisionBits + (pair (List.replicate p true) + (rawRatBinaryCode (rawRatOfRat q))) = p.bits := by + simp [machineScheduledLogPrecisionBits, + machineScheduledLogPrecisionRuler] + +@[simp] theorem machineScheduledLogExponentIntegerCode_encode + (q : ℚ) (p : ℕ) : + machineScheduledLogExponentIntegerCode + (pair (List.replicate p true) + (rawRatBinaryCode (rawRatOfRat q))) = + integerBinaryCode (rationalBinaryExponent q) := by + rw [machineScheduledLogExponentIntegerCode, + machineDirectedLogExponentIntegerCode_encode, + binaryRationalBinaryExponent_eq] + +@[simp] theorem machineScheduledLogExponentAbsBits_encode + (q : ℚ) (p : ℕ) : + machineScheduledLogExponentAbsBits + (pair (List.replicate p true) + (rawRatBinaryCode (rawRatOfRat q))) = + (rationalBinaryExponent q).natAbs.bits := by + rw [machineScheduledLogExponentAbsBits, + machineScheduledLogExponentIntegerCode_encode, + machineIntegerNatAbsBits_encode] + +@[simp] theorem machineScheduledLogTermsBits_encode + (q : ℚ) (p : ℕ) : + machineScheduledLogTermsBits + (pair (List.replicate p true) + (rawRatBinaryCode (rawRatOfRat q))) = + (directedLogTerms q p).bits := by + rw [machineScheduledLogTermsBits, + machineScheduledLogPrecisionPlusExponentBits, + machineScheduledLogPrecisionBits_encode, + machineScheduledLogExponentAbsBits_encode, + machineBinaryAddBits_pair_natBits] + change machineBinaryAddBits + (pair (p + (rationalBinaryExponent q).natAbs).bits (2 : ℕ).bits) = _ + rw [machineBinaryAddBits_pair_natBits] + rfl + +theorem rationalBinaryExponent_natAbs_le_two_rawWidth (q : ℚ) : + (rationalBinaryExponent q).natAbs ≤ + 2 * rawRatWidth (rawRatOfRat q) := by + have habs := Int.natAbs_sub_le + (Nat.log 2 q.num.natAbs : ℤ) (Nat.log 2 q.den : ℤ) + simp only [Int.natAbs_natCast] at habs + have hnum : Nat.log 2 q.num.natAbs ≤ + rawRatWidth (rawRatOfRat q) := by + rw [← binaryNatLog2_eq_log_two, binaryNatLog2] + exact (Nat.sub_le _ _).trans (le_max_left _ _) + have hden : Nat.log 2 q.den ≤ rawRatWidth (rawRatOfRat q) := by + rw [← binaryNatLog2_eq_log_two, binaryNatLog2] + exact (Nat.sub_le _ _).trans (le_max_right _ _) + rw [rationalBinaryExponent] + omega + +theorem directedLogTerms_le_scheduledLogGuard (q : ℚ) (p : ℕ) : + directedLogTerms q p ≤ + (machineScheduledLogTermsGuard + (pair (List.replicate p true) + (rawRatBinaryCode (rawRatOfRat q)))).length := by + let code := rawRatBinaryCode (rawRatOfRat q) + let word := pair (List.replicate p true) code + have hwidth := rawRatWidth_le_binaryCode_length (rawRatOfRat q) + have hexp := rationalBinaryExponent_natAbs_le_two_rawWidth q + have hword : word.length = 2 * p + code.length + 2 := by + simp [word] + omega + have hterms : directedLogTerms q p ≤ 3 * word.length + 2 := by + rw [directedLogTerms] + simp only [word, code] at hword ⊢ + omega + have hquad : 3 * word.length + 2 ≤ (word.length + 16) ^ 2 := by + nlinarith [sq_nonneg (word.length + 14)] + simpa only [machineScheduledLogTermsGuard, machineBinaryMulWidth, + List.length_replicate, List.length_append, pow_two, + List.length_cons, List.length_nil, Nat.zero_add, word, Nat.add_comm] using + hterms.trans hquad + +@[simp] theorem machineScheduledLogTermsRuler_encode + (q : ℚ) (p : ℕ) : + machineScheduledLogTermsRuler + (pair (List.replicate p true) + (rawRatBinaryCode (rawRatOfRat q))) = + List.replicate (directedLogTerms q p) true := by + rw [machineScheduledLogTermsRuler, + machineScheduledLogTermsBits_encode, + machineBoundedUnary_encode_of_le] + exact directedLogTerms_le_scheduledLogGuard q p + +def rawScheduledLogLower (q : ℚ) (p : ℕ) : RawRat := + RawRat.logLower q (directedLogTerms q p) + +def rawScheduledLogUpper (q : ℚ) (p : ℕ) : RawRat := + RawRat.logUpper q (directedLogTerms q p) + +@[simp] theorem machineScheduledLogLowerRawCode_encode + (q : ℚ) (p : ℕ) : + machineScheduledLogLowerRawCode + (pair (List.replicate p true) + (rawRatBinaryCode (rawRatOfRat q))) = + rawRatBinaryCode (rawScheduledLogLower q p) := by + rw [machineScheduledLogLowerRawCode, + machineScheduledLogTermsRuler_encode] + simp only [machineScheduledLogArgumentRawCode, machinePairSecond_pair, + machineDirectedLogLowerRawCode_encode, rawScheduledLogLower] + +@[simp] theorem machineScheduledLogUpperRawCode_encode + (q : ℚ) (p : ℕ) : + machineScheduledLogUpperRawCode + (pair (List.replicate p true) + (rawRatBinaryCode (rawRatOfRat q))) = + rawRatBinaryCode (rawScheduledLogUpper q p) := by + rw [machineScheduledLogUpperRawCode, + machineScheduledLogTermsRuler_encode] + simp only [machineScheduledLogArgumentRawCode, machinePairSecond_pair, + machineDirectedLogUpperRawCode_encode, rawScheduledLogUpper] + +theorem rawScheduledLogLower_value (q : ℚ) (p : ℕ) : + (rawScheduledLogLower q p).value = scheduledLogLower q p := by + simp [rawScheduledLogLower, scheduledLogLower, + RawRat.value_logLower, binaryDirectedLogLower_eq] + +theorem rawScheduledLogUpper_value (q : ℚ) (p : ℕ) : + (rawScheduledLogUpper q p).value = scheduledLogUpper q p := by + simp [rawScheduledLogUpper, scheduledLogUpper, + RawRat.value_logUpper, binaryDirectedLogUpper_eq] + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineScheduledLogWidth.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineScheduledLogWidth.lean new file mode 100644 index 0000000000..3059861e0b --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineScheduledLogWidth.lean @@ -0,0 +1,472 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineNearbyCoordinate + +/-! +# Explicit raw-width bounds for scheduled logarithms + +These lemmas bound the unreduced fractions produced by the directed logarithm +and by one nearby-Bethe coordinate. They are intentionally stated in terms of +the exact arithmetic definitions, so the matrix-fold clamp can later be proved +inactive without an abstract bit-complexity assumption. +-/ + +namespace BeyondBethe + +def rawLogSeriesWidthBudget (w N : ℕ) : ℕ := + 1 + N * ((2 * N + 1) * w + 2 * N + 4) + +def rawLogUnitLowerWidthBudget (w N : ℕ) : ℕ := + 3 + rawLogSeriesWidthBudget (2 * w + 4) N + +def rawLogSeriesErrorWidthBudget (w N : ℕ) : ℕ := + 6 + (2 * N + 3) * (2 * w + 4) + +def rawLogUnitUpperWidthBudget (w N : ℕ) : ℕ := + rawLogUnitLowerWidthBudget w N + + rawLogSeriesErrorWidthBudget w N + 1 + +def rawDirectedLogWidthBudget (w N : ℕ) : ℕ := + (2 * w + 2 + rawLogUnitUpperWidthBudget 2 N) + + rawLogUnitUpperWidthBudget (2 * w + 1) N + 1 + +/-- A deliberately coarse closed form for the exact syntactic budget above. +It is useful when composing the logarithm machine with matrix traversals: the +right-hand side exposes only the input width and the actual number of series +terms. -/ +theorem rawDirectedLogWidthBudget_le (w N : ℕ) : + rawDirectedLogWidthBudget w N ≤ 64 * (N + 2) ^ 2 * (w + 2) := by + simp only [rawDirectedLogWidthBudget, rawLogUnitUpperWidthBudget, + rawLogUnitLowerWidthBudget, rawLogSeriesErrorWidthBudget, + rawLogSeriesWidthBudget] + nlinarith + +theorem rawRatWidth_ofInt_le (z : ℤ) : + rawRatWidth (RawRat.ofInt z) ≤ z.natAbs.size + 1 := by + simp [RawRat.ofInt, rawRatWidth] + +theorem rawRatWidth_logScale_le (q : ℚ) : + rawRatWidth (RawRat.logScale q) ≤ + rawRatWidth (rawRatOfRat q) + 1 := by + have hnum := rawRat_num_size_le_width (rawRatOfRat q) + have hden := rawRat_den_size_le_width (rawRatOfRat q) + simp only [rawRatOfRat] at hnum hden + rw [RawRat.logScale, rawRatWidth] + change max (2 ^ binaryNatLog2 q.num.natAbs).size + (2 ^ binaryNatLog2 q.den).size ≤ + rawRatWidth (⟨q.num, q.den, q.den_pos⟩ : RawRat) + 1 + rw [Nat.size_pow, Nat.size_pow, binaryNatLog2, binaryNatLog2] + apply max_le <;> omega + +theorem rawRatWidth_logResidual_le (q : ℚ) : + rawRatWidth (RawRat.logResidual q) ≤ + 2 * rawRatWidth (rawRatOfRat q) + 1 := by + rw [RawRat.logResidual] + have hdiv := rawRatWidth_div_le (rawRatOfRat q) (RawRat.logScale q) + have hscale := rawRatWidth_logScale_le q + omega + +theorem rawRatWidth_logUnit_le (q : ℚ) : + rawRatWidth (RawRat.logUnit q) ≤ + 2 * rawRatWidth (rawRatOfRat q) + 1 := by + rw [RawRat.logUnit] + split_ifs + · exact rawRatWidth_logResidual_le q + · exact (rawRatWidth_inv_le _).trans (rawRatWidth_logResidual_le q) + +theorem rawRatWidth_logUnitParameter_le (y : RawRat) : + rawRatWidth (RawRat.logUnitParameter y) ≤ 2 * rawRatWidth y + 4 := by + rw [RawRat.logUnitParameter] + have hneg : rawRatWidth RawRat.one.neg = 1 := by + rw [rawRatWidth_neg, rawRatWidth_one] + have hnum := rawRatWidth_add_le y RawRat.one.neg + have hden := rawRatWidth_add_le y RawRat.one + have hdiv := rawRatWidth_div_le (y.add RawRat.one.neg) (y.add RawRat.one) + rw [hneg] at hnum + rw [rawRatWidth_one] at hden + omega + +theorem rawLogSeriesWidthBudget_mono {w w' N : ℕ} (h : w ≤ w') : + rawLogSeriesWidthBudget w N ≤ rawLogSeriesWidthBudget w' N := by + have hmul : (2 * N + 1) * w ≤ (2 * N + 1) * w' := + Nat.mul_le_mul_left _ h + have hinner : (2 * N + 1) * w + 2 * N + 4 ≤ + (2 * N + 1) * w' + 2 * N + 4 := by omega + simp only [rawLogSeriesWidthBudget] + exact Nat.add_le_add_left (Nat.mul_le_mul_left N hinner) 1 + +theorem rawLogUnitLowerWidthBudget_mono {w w' N : ℕ} (h : w ≤ w') : + rawLogUnitLowerWidthBudget w N ≤ rawLogUnitLowerWidthBudget w' N := by + simp only [rawLogUnitLowerWidthBudget] + exact Nat.add_le_add_left + (rawLogSeriesWidthBudget_mono (by omega : 2 * w + 4 ≤ 2 * w' + 4)) 3 + +theorem rawLogSeriesErrorWidthBudget_mono {w w' N : ℕ} (h : w ≤ w') : + rawLogSeriesErrorWidthBudget w N ≤ rawLogSeriesErrorWidthBudget w' N := by + have hinner : 2 * w + 4 ≤ 2 * w' + 4 := by omega + simp only [rawLogSeriesErrorWidthBudget] + exact Nat.add_le_add_left (Nat.mul_le_mul_left (2 * N + 3) hinner) 6 + +theorem rawLogUnitUpperWidthBudget_mono {w w' N : ℕ} (h : w ≤ w') : + rawLogUnitUpperWidthBudget w N ≤ rawLogUnitUpperWidthBudget w' N := by + simp only [rawLogUnitUpperWidthBudget] + exact Nat.add_le_add_right + (Nat.add_le_add (rawLogUnitLowerWidthBudget_mono h) + (rawLogSeriesErrorWidthBudget_mono h)) 1 + +theorem rawRatWidth_logSeriesSum_budget (x : RawRat) (N : ℕ) : + rawRatWidth (RawRat.logSeriesSum x N) ≤ + rawLogSeriesWidthBudget (rawRatWidth x) N := by + exact RawRat.width_logSeriesSum_le x N + +theorem rawRatWidth_logUnitLower_le (y : RawRat) (N : ℕ) : + rawRatWidth (RawRat.logUnitLower y N) ≤ + rawLogUnitLowerWidthBudget (rawRatWidth y) N := by + rw [RawRat.logUnitLower] + have htwo := RawRat.width_ofNat_le 2 + have hx := rawRatWidth_logUnitParameter_le y + have hseries := RawRat.width_logSeriesSum_le + (RawRat.logUnitParameter y) N + have hmul := rawRatWidth_mul_le (RawRat.ofNat 2) + (RawRat.logSeriesSum (RawRat.logUnitParameter y) N) + simp only [rawLogUnitLowerWidthBudget, rawLogSeriesWidthBudget] + have hprod : + (2 * N + 1) * rawRatWidth (RawRat.logUnitParameter y) ≤ + (2 * N + 1) * (2 * rawRatWidth y + 4) := + Nat.mul_le_mul_left _ hx + have hinner : + (2 * N + 1) * rawRatWidth (RawRat.logUnitParameter y) + 2 * N + 4 ≤ + (2 * N + 1) * (2 * rawRatWidth y + 4) + 2 * N + 4 := by omega + have hseriesMono := Nat.mul_le_mul_left N hinner + omega + +theorem rawRatWidth_logSeriesError_le (y : RawRat) (N : ℕ) : + rawRatWidth (RawRat.logSeriesError y N) ≤ + rawLogSeriesErrorWidthBudget (rawRatWidth y) N := by + let x := RawRat.logUnitParameter y + change rawRatWidth + ((RawRat.ofNat 2).mul + ((x.pow (2 * N + 1)).div + (RawRat.one.add (x.mul x).neg))) ≤ _ + have hx : rawRatWidth x ≤ 2 * rawRatWidth y + 4 := + rawRatWidth_logUnitParameter_le y + have hpow := RawRat.width_pow_le x (2 * N + 1) + have hsquare := rawRatWidth_mul_le x x + have hden := rawRatWidth_add_le RawRat.one (x.mul x).neg + rw [rawRatWidth_one, rawRatWidth_neg] at hden + have hdiv := rawRatWidth_div_le (x.pow (2 * N + 1)) + (RawRat.one.add (x.mul x).neg) + have htwo := RawRat.width_ofNat_le 2 + have hmul := rawRatWidth_mul_le (RawRat.ofNat 2) + ((x.pow (2 * N + 1)).div (RawRat.one.add (x.mul x).neg)) + simp only [rawLogSeriesErrorWidthBudget] + have hprod : + (2 * N + 3) * rawRatWidth x ≤ + (2 * N + 3) * (2 * rawRatWidth y + 4) := + Nat.mul_le_mul_left _ hx + have hdivBound : + rawRatWidth + ((x.pow (2 * N + 1)).div + (RawRat.one.add (x.mul x).neg)) ≤ + 3 + (2 * N + 3) * rawRatWidth x := by + have hdenBound : + rawRatWidth (RawRat.one.add (x.mul x).neg) ≤ + 2 * rawRatWidth x + 2 := by omega + calc + _ ≤ rawRatWidth (x.pow (2 * N + 1)) + + rawRatWidth (RawRat.one.add (x.mul x).neg) := hdiv + _ ≤ (1 + (2 * N + 1) * rawRatWidth x) + + (2 * rawRatWidth x + 2) := Nat.add_le_add hpow hdenBound + _ = 3 + (2 * N + 3) * rawRatWidth x := by ring + have hmulBound : + rawRatWidth + ((RawRat.ofNat 2).mul + ((x.pow (2 * N + 1)).div + (RawRat.one.add (x.mul x).neg))) ≤ + 6 + (2 * N + 3) * rawRatWidth x := by + calc + _ ≤ rawRatWidth (RawRat.ofNat 2) + + rawRatWidth + ((x.pow (2 * N + 1)).div + (RawRat.one.add (x.mul x).neg)) := hmul + _ ≤ 3 + (3 + (2 * N + 3) * rawRatWidth x) := + Nat.add_le_add htwo hdivBound + _ = 6 + (2 * N + 3) * rawRatWidth x := by omega + exact hmulBound.trans (Nat.add_le_add_left hprod 6) + +theorem rawRatWidth_logUnitUpper_le (y : RawRat) (N : ℕ) : + rawRatWidth (RawRat.logUnitUpper y N) ≤ + rawLogUnitUpperWidthBudget (rawRatWidth y) N := by + rw [RawRat.logUnitUpper] + have hlo := rawRatWidth_logUnitLower_le y N + have herr := rawRatWidth_logSeriesError_le y N + have hadd := rawRatWidth_add_le (RawRat.logUnitLower y N) + (RawRat.logSeriesError y N) + simp only [rawLogUnitUpperWidthBudget] + omega + +theorem rawLogUnitLowerWidthBudget_le_upper (w N : ℕ) : + rawLogUnitLowerWidthBudget w N ≤ rawLogUnitUpperWidthBudget w N := by + simp only [rawLogUnitUpperWidthBudget] + omega + +theorem rationalBinaryExponent_natAbs_size_le (q : ℚ) : + (rationalBinaryExponent q).natAbs.size ≤ + 2 * rawRatWidth (rawRatOfRat q) + 1 := by + have hexp := rationalBinaryExponent_natAbs_le_two_rawWidth q + have hsize : (rationalBinaryExponent q).natAbs.size ≤ + (rationalBinaryExponent q).natAbs + 1 := by + rw [Nat.size_le] + exact (Nat.lt_two_pow_self + (n := (rationalBinaryExponent q).natAbs)).trans_le + (Nat.pow_le_pow_right (by decide) (Nat.le_succ _)) + omega + +theorem rawRatWidth_logIntegerLower_le (q : ℚ) (N : ℕ) : + rawRatWidth (RawRat.logIntegerLower q N) ≤ + 2 * rawRatWidth (rawRatOfRat q) + 2 + + rawLogUnitUpperWidthBudget 2 N := by + rw [RawRat.logIntegerLower, binaryRationalBinaryExponent_eq] + have hk := rationalBinaryExponent_natAbs_size_le q + have hint := rawRatWidth_ofInt_le (rationalBinaryExponent q) + have htwo : rawRatWidth (RawRat.ofNat 2) = 2 := by + decide + have hlo := rawRatWidth_logUnitLower_le (RawRat.ofNat 2) N + have hhi := rawRatWidth_logUnitUpper_le (RawRat.ofNat 2) N + rw [htwo] at hlo hhi + have hint' : + rawRatWidth (RawRat.ofInt (rationalBinaryExponent q)) ≤ + 2 * rawRatWidth (rawRatOfRat q) + 2 := by omega + split_ifs with hsign + · have hmul := rawRatWidth_mul_le + (RawRat.ofInt (rationalBinaryExponent q)) + (RawRat.logUnitLower (RawRat.ofNat 2) N) + have hfactor : + rawRatWidth (RawRat.logUnitLower (RawRat.ofNat 2) N) ≤ + rawLogUnitUpperWidthBudget 2 N := + hlo.trans (rawLogUnitLowerWidthBudget_le_upper 2 N) + exact hmul.trans (Nat.add_le_add hint' hfactor) + · have hmul := rawRatWidth_mul_le + (RawRat.ofInt (rationalBinaryExponent q)) + (RawRat.logUnitUpper (RawRat.ofNat 2) N) + exact hmul.trans (Nat.add_le_add hint' hhi) + +theorem rawRatWidth_logIntegerUpper_le (q : ℚ) (N : ℕ) : + rawRatWidth (RawRat.logIntegerUpper q N) ≤ + 2 * rawRatWidth (rawRatOfRat q) + 2 + + rawLogUnitUpperWidthBudget 2 N := by + rw [RawRat.logIntegerUpper, binaryRationalBinaryExponent_eq] + have hk := rationalBinaryExponent_natAbs_size_le q + have hint := rawRatWidth_ofInt_le (rationalBinaryExponent q) + have htwo : rawRatWidth (RawRat.ofNat 2) = 2 := by + decide + have hlo := rawRatWidth_logUnitLower_le (RawRat.ofNat 2) N + have hhi := rawRatWidth_logUnitUpper_le (RawRat.ofNat 2) N + rw [htwo] at hlo hhi + have hint' : + rawRatWidth (RawRat.ofInt (rationalBinaryExponent q)) ≤ + 2 * rawRatWidth (rawRatOfRat q) + 2 := by omega + split_ifs with hsign + · have hmul := rawRatWidth_mul_le + (RawRat.ofInt (rationalBinaryExponent q)) + (RawRat.logUnitUpper (RawRat.ofNat 2) N) + exact hmul.trans (Nat.add_le_add hint' hhi) + · have hmul := rawRatWidth_mul_le + (RawRat.ofInt (rationalBinaryExponent q)) + (RawRat.logUnitLower (RawRat.ofNat 2) N) + have hfactor : + rawRatWidth (RawRat.logUnitLower (RawRat.ofNat 2) N) ≤ + rawLogUnitUpperWidthBudget 2 N := + hlo.trans (rawLogUnitLowerWidthBudget_le_upper 2 N) + exact hmul.trans (Nat.add_le_add hint' hfactor) + +theorem rawRatWidth_logResidualLower_le (q : ℚ) (N : ℕ) : + rawRatWidth (RawRat.logResidualLower q N) ≤ + rawLogUnitUpperWidthBudget + (2 * rawRatWidth (rawRatOfRat q) + 1) N := by + rw [RawRat.logResidualLower] + have hy := rawRatWidth_logUnit_le q + have hlo := rawRatWidth_logUnitLower_le (RawRat.logUnit q) N + have hhi := rawRatWidth_logUnitUpper_le (RawRat.logUnit q) N + have hmono : + rawLogUnitUpperWidthBudget (rawRatWidth (RawRat.logUnit q)) N ≤ + rawLogUnitUpperWidthBudget + (2 * rawRatWidth (rawRatOfRat q) + 1) N := by + exact rawLogUnitUpperWidthBudget_mono hy + split_ifs + · exact hlo.trans + ((rawLogUnitLowerWidthBudget_le_upper _ _).trans hmono) + · rw [rawRatWidth_neg] + exact hhi.trans hmono + +theorem rawRatWidth_logResidualUpper_le (q : ℚ) (N : ℕ) : + rawRatWidth (RawRat.logResidualUpper q N) ≤ + rawLogUnitUpperWidthBudget + (2 * rawRatWidth (rawRatOfRat q) + 1) N := by + rw [RawRat.logResidualUpper] + have hy := rawRatWidth_logUnit_le q + have hlo := rawRatWidth_logUnitLower_le (RawRat.logUnit q) N + have hhi := rawRatWidth_logUnitUpper_le (RawRat.logUnit q) N + have hmono : + rawLogUnitUpperWidthBudget (rawRatWidth (RawRat.logUnit q)) N ≤ + rawLogUnitUpperWidthBudget + (2 * rawRatWidth (rawRatOfRat q) + 1) N := by + exact rawLogUnitUpperWidthBudget_mono hy + split_ifs + · exact hhi.trans hmono + · rw [rawRatWidth_neg] + exact hlo.trans + ((rawLogUnitLowerWidthBudget_le_upper _ _).trans hmono) + +theorem rawRatWidth_logLower_le (q : ℚ) (N : ℕ) : + rawRatWidth (RawRat.logLower q N) ≤ + rawDirectedLogWidthBudget (rawRatWidth (rawRatOfRat q)) N := by + rw [RawRat.logLower] + have hint := rawRatWidth_logIntegerLower_le q N + have hres := rawRatWidth_logResidualLower_le q N + have hadd := rawRatWidth_add_le (RawRat.logIntegerLower q N) + (RawRat.logResidualLower q N) + exact hadd.trans (by + simp only [rawDirectedLogWidthBudget] + omega) + +theorem rawRatWidth_logUpper_le (q : ℚ) (N : ℕ) : + rawRatWidth (RawRat.logUpper q N) ≤ + rawDirectedLogWidthBudget (rawRatWidth (rawRatOfRat q)) N := by + rw [RawRat.logUpper] + have hint := rawRatWidth_logIntegerUpper_le q N + have hres := rawRatWidth_logResidualUpper_le q N + have hadd := rawRatWidth_add_le (RawRat.logIntegerUpper q N) + (RawRat.logResidualUpper q N) + exact hadd.trans (by + simp only [rawDirectedLogWidthBudget] + omega) + +theorem rawRatWidth_scheduledLogLower_le (q : ℚ) (p : ℕ) : + rawRatWidth (rawScheduledLogLower q p) ≤ + rawDirectedLogWidthBudget (rawRatWidth (rawRatOfRat q)) + (directedLogTerms q p) := by + exact rawRatWidth_logLower_le q (directedLogTerms q p) + +theorem rawRatWidth_scheduledLogUpper_le (q : ℚ) (p : ℕ) : + rawRatWidth (rawScheduledLogUpper q p) ≤ + rawDirectedLogWidthBudget (rawRatWidth (rawRatOfRat q)) + (directedLogTerms q p) := by + exact rawRatWidth_logUpper_le q (directedLogTerms q p) + +theorem directedLogTerms_le_rawWidth (q : ℚ) (p : ℕ) : + directedLogTerms q p ≤ + p + 2 * rawRatWidth (rawRatOfRat q) + 2 := by + have h := rationalBinaryExponent_natAbs_le_two_rawWidth q + rw [directedLogTerms] + omega + +/-- Closed polynomial width bound for one scheduled lower logarithm. -/ +theorem rawRatWidth_scheduledLogLower_polynomial_le (q : ℚ) (p : ℕ) : + rawRatWidth (rawScheduledLogLower q p) ≤ + 64 * (p + 2 * rawRatWidth (rawRatOfRat q) + 4) ^ 2 * + (rawRatWidth (rawRatOfRat q) + 2) := by + have hterms0 := directedLogTerms_le_rawWidth q p + have hterms : directedLogTerms q p + 2 ≤ + p + 2 * rawRatWidth (rawRatOfRat q) + 4 := by omega + have hsquare : (directedLogTerms q p + 2) ^ 2 ≤ + (p + 2 * rawRatWidth (rawRatOfRat q) + 4) ^ 2 := + Nat.pow_le_pow_left hterms 2 + have hmul := Nat.mul_le_mul_right + (rawRatWidth (rawRatOfRat q) + 2) + (Nat.mul_le_mul_left 64 hsquare) + exact (rawRatWidth_scheduledLogLower_le q p).trans + ((rawDirectedLogWidthBudget_le + (rawRatWidth (rawRatOfRat q)) (directedLogTerms q p)).trans hmul) + +/-- Closed polynomial width bound for one scheduled upper logarithm. -/ +theorem rawRatWidth_scheduledLogUpper_polynomial_le (q : ℚ) (p : ℕ) : + rawRatWidth (rawScheduledLogUpper q p) ≤ + 64 * (p + 2 * rawRatWidth (rawRatOfRat q) + 4) ^ 2 * + (rawRatWidth (rawRatOfRat q) + 2) := by + have hterms0 := directedLogTerms_le_rawWidth q p + have hterms : directedLogTerms q p + 2 ≤ + p + 2 * rawRatWidth (rawRatOfRat q) + 4 := by omega + have hsquare : (directedLogTerms q p + 2) ^ 2 ≤ + (p + 2 * rawRatWidth (rawRatOfRat q) + 4) ^ 2 := + Nat.pow_le_pow_left hterms 2 + have hmul := Nat.mul_le_mul_right + (rawRatWidth (rawRatOfRat q) + 2) + (Nat.mul_le_mul_left 64 hsquare) + exact (rawRatWidth_scheduledLogUpper_le q p).trans + ((rawDirectedLogWidthBudget_le + (rawRatWidth (rawRatOfRat q)) (directedLogTerms q p)).trans hmul) + +theorem rawRatWidth_scheduledLogLower_of_bounds_le + (q : ℚ) {p P W : ℕ} (hp : p ≤ P) + (hw : rawRatWidth (rawRatOfRat q) ≤ W) : + rawRatWidth (rawScheduledLogLower q p) ≤ + 64 * (P + 2 * W + 4) ^ 2 * (W + 2) := by + have hbase : p + 2 * rawRatWidth (rawRatOfRat q) + 4 ≤ + P + 2 * W + 4 := by omega + have hpow := Nat.pow_le_pow_left hbase 2 + have hleft := Nat.mul_le_mul_left 64 hpow + have hright : rawRatWidth (rawRatOfRat q) + 2 ≤ W + 2 := by omega + exact (rawRatWidth_scheduledLogLower_polynomial_le q p).trans + (Nat.mul_le_mul hleft hright) + +theorem rawRatWidth_scheduledLogUpper_of_bounds_le + (q : ℚ) {p P W : ℕ} (hp : p ≤ P) + (hw : rawRatWidth (rawRatOfRat q) ≤ W) : + rawRatWidth (rawScheduledLogUpper q p) ≤ + 64 * (P + 2 * W + 4) ^ 2 * (W + 2) := by + have hbase : p + 2 * rawRatWidth (rawRatOfRat q) + 4 ≤ + P + 2 * W + 4 := by omega + have hpow := Nat.pow_le_pow_left hbase 2 + have hleft := Nat.mul_le_mul_left 64 hpow + have hright : rawRatWidth (rawRatOfRat q) + 2 ≤ W + 2 := by omega + exact (rawRatWidth_scheduledLogUpper_polynomial_le q p).trans + (Nat.mul_le_mul hleft hright) + +theorem rawRatWidth_complement_le (x : ℚ) : + rawRatWidth (rawRatOfRat (1 - x)) ≤ + 44 + 12 * rawRatWidth (rawRatOfRat x) := by + let r := RawRat.one.add (rawRatOfRat x).neg + have hr : rawRatWidth r ≤ rawRatWidth (rawRatOfRat x) + 2 := by + have hadd := rawRatWidth_add_le RawRat.one (rawRatOfRat x).neg + rw [rawRatWidth_one, rawRatWidth_neg] at hadd + exact hadd.trans (by omega) + have hvalue : binaryNormalizeRawRat r = 1 - x := by + rw [binaryNormalizeRawRat_eq_value] + simp [r, RawRat.value_add, RawRat.value_one, RawRat.value_neg, + rawRatOfRat_value] + ring + have hcanonical := rawRatOfRat_width_le_encodedBitLength (1 - x) + rw [← hvalue] at hcanonical + have hnormalize := binaryNormalizeRawRat_encodedBitLength_le r + rw [← hvalue] + omega + +def rawNearbyCoordinateWidthBudget (tau : RawRat) (x : ℚ) (p : ℕ) : ℕ := + rawDirectedLogWidthBudget (rawRatWidth (rawRatOfRat (1 - x))) + (directedLogTerms (1 - x) p) + + rawRatWidth tau + rawRatWidth (rawRatOfRat x) + + rawDirectedLogWidthBudget (rawRatWidth (rawRatOfRat x)) + (directedLogTerms x p) + 1 + +theorem rawRatWidth_nearbyCoordinateLower_le + (tau : RawRat) (x : ℚ) (p : ℕ) : + rawRatWidth (rawNearbyCoordinateLower tau x p) ≤ + rawNearbyCoordinateWidthBudget tau x p := by + rw [rawNearbyCoordinateLower] + have hcomp := rawRatWidth_scheduledLogLower_le (1 - x) p + have htx := rawRatWidth_mul_le tau (rawRatOfRat x) + have hlogx := rawRatWidth_scheduledLogLower_le x p + have hweighted := rawRatWidth_mul_le (tau.mul (rawRatOfRat x)) + (rawScheduledLogLower x p) + have hadd := rawRatWidth_add_le (rawScheduledLogLower (1 - x) p) + ((tau.mul (rawRatOfRat x)).mul (rawScheduledLogLower x p)) + exact hadd.trans (by + simp only [rawNearbyCoordinateWidthBudget] + omega) + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineScheduledRoundedEllipsoid.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineScheduledRoundedEllipsoid.lean new file mode 100644 index 0000000000..512ca99207 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineScheduledRoundedEllipsoid.lean @@ -0,0 +1,459 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineDyadicFloorMatrix + +/-! +# Polynomial-time scheduled rounded ellipsoid update + +This module implements the determinant-independent rounded state transition. +The center and basis are floored at a unary precision. The rounded basis is +then left-multiplied by an explicitly constructed scalar diagonal matrix, +which realizes the prescribed inflation without another matrix mapper. +-/ + +namespace BeyondBethe + +open Complexity + +def rawRoundedInflationDenominator (d : ℕ) : RawRat := + (RawRat.ofNat 1024).mul + ((rawEllipsoidDimensionSquare d).mul + (rawEllipsoidDimensionSquare d)) + +def rawRoundedInflation (d : ℕ) : RawRat := + rawEllipsoidOne.div (rawRoundedInflationDenominator d) + +def rawRoundedInflationFactor (d : ℕ) : RawRat := + rawEllipsoidOne.add (rawRoundedInflation d) + +@[simp] theorem rawRoundedInflation_value (d : ℕ) : + (rawRoundedInflation d).value = roundedEllipsoidInflation d := by + simp [rawRoundedInflation, rawRoundedInflationDenominator, + roundedEllipsoidInflation, rawEllipsoidDimensionSquare, + rawEllipsoidOne, RawRat.value_one, RawRat.value_ofNat] + ring + +@[simp] theorem rawRoundedInflationFactor_value (d : ℕ) : + (rawRoundedInflationFactor d).value = + 1 + roundedEllipsoidInflation d := by + simp [rawRoundedInflationFactor, rawEllipsoidOne, + RawRat.value_one, RawRat.value_ofNat] + +def machineScheduledRoundPrecision (word : List Bool) : List Bool := + machinePairFirst word + +def machineScheduledRoundState (word : List Bool) : List Bool := + machinePairSecond word + +def machineScheduledRoundDimensionBits (word : List Bool) : List Bool := + machineRationalEllipsoidDimensionWord (machineScheduledRoundState word) + +def machineScheduledRoundDimensionUnary (word : List Bool) : List Bool := + machineBoundedUnary + (pair (machineScheduledRoundState word) + (machineScheduledRoundDimensionBits word)) + +def machineScheduledRoundCenter (word : List Bool) : List Bool := + machineRationalEllipsoidCenterWord (machineScheduledRoundState word) + +def machineScheduledRoundBasis (word : List Bool) : List Bool := + machineRationalEllipsoidBasisWord (machineScheduledRoundState word) + +def machineRoundedInflationDimensionRawCode + (word : List Bool) : List Bool := + machineEllipsoidDimensionRawCode word + +def machineRoundedInflationDimensionSquareRawCode + (word : List Bool) : List Bool := + machineRawRatMulCode + (pair (machineRoundedInflationDimensionRawCode word) + (machineRoundedInflationDimensionRawCode word)) + +def machineRoundedInflationDimensionFourthRawCode + (word : List Bool) : List Bool := + machineRawRatMulCode + (pair (machineRoundedInflationDimensionSquareRawCode word) + (machineRoundedInflationDimensionSquareRawCode word)) + +def machineRoundedInflationDenominatorRawCode + (word : List Bool) : List Bool := + machineRawRatMulCode + (pair (rawRatBinaryCode (RawRat.ofNat 1024)) + (machineRoundedInflationDimensionFourthRawCode word)) + +def machineRoundedInflationRawCode (word : List Bool) : List Bool := + machineRawRatDivCode + (pair (rawRatBinaryCode rawEllipsoidOne) + (machineRoundedInflationDenominatorRawCode word)) + +def machineRoundedInflationFactorRawCode + (word : List Bool) : List Bool := + machineRawRatAddCode + (pair (rawRatBinaryCode rawEllipsoidOne) + (machineRoundedInflationRawCode word)) + +def machineRoundedInflationFactorEntryCode + (word : List Bool) : List Bool := + machineNormalizeRawRatEntryCode + (machineRoundedInflationFactorRawCode word) + +def machineScheduledRoundCenterCode (word : List Bool) : List Bool := + machineDyadicFloorVectorCode + (pair (machineScheduledRoundPrecision word) + (machineScheduledRoundCenter word)) + +def machineScheduledRoundFlooredBasisCode + (word : List Bool) : List Bool := + machineDyadicFloorMatrixCode + (pair (machineScheduledRoundPrecision word) + (machineScheduledRoundBasis word)) + +def machineScheduledRoundInflationDiagonalCode + (word : List Bool) : List Bool := + machineDiagonalBasisRowsCode + (pair (machineScheduledRoundDimensionUnary word) + (machineRoundedInflationFactorEntryCode + (machineScheduledRoundDimensionBits word))) + +def machineScheduledRoundBasisCode (word : List Bool) : List Bool := + machineRationalMatrixMulCode + (pair (machineScheduledRoundDimensionUnary word) + (pair (machineScheduledRoundInflationDiagonalCode word) + (machineScheduledRoundFlooredBasisCode word))) + +/-- Input: `pair precisionUnary rationalEllipsoidStateBinaryCode`. -/ +def machineScheduledRoundedEllipsoidCode (word : List Bool) : List Bool := + pair (machineScheduledRoundDimensionBits word) + (pair (machineScheduledRoundCenterCode word) + (machineScheduledRoundBasisCode word)) + +/-! ## Polynomial-time closure -/ + +theorem machineScheduledRoundPrecision_mem_FP : + machineScheduledRoundPrecision ∈ FP := machinePairFirst_mem_FP + +theorem machineScheduledRoundState_mem_FP : + machineScheduledRoundState ∈ FP := machinePairSecond_mem_FP + +theorem machineScheduledRoundDimensionBits_mem_FP : + machineScheduledRoundDimensionBits ∈ FP := by + simpa only [machineScheduledRoundDimensionBits] using + machineCompose_mem_FP machineScheduledRoundState_mem_FP + machineRationalEllipsoidDimensionWord_mem_FP + +theorem machineScheduledRoundDimensionUnary_mem_FP : + machineScheduledRoundDimensionUnary ∈ FP := by + have hinput := machinePair_mem_FP machineScheduledRoundState_mem_FP + machineScheduledRoundDimensionBits_mem_FP + simpa only [machineScheduledRoundDimensionUnary] using + machineCompose_mem_FP hinput machineBoundedUnary_mem_FP + +theorem machineScheduledRoundCenter_mem_FP : + machineScheduledRoundCenter ∈ FP := by + simpa only [machineScheduledRoundCenter] using + machineCompose_mem_FP machineScheduledRoundState_mem_FP + machineRationalEllipsoidCenterWord_mem_FP + +theorem machineScheduledRoundBasis_mem_FP : + machineScheduledRoundBasis ∈ FP := by + simpa only [machineScheduledRoundBasis] using + machineCompose_mem_FP machineScheduledRoundState_mem_FP + machineRationalEllipsoidBasisWord_mem_FP + +theorem machineRoundedInflationDimensionRawCode_mem_FP : + machineRoundedInflationDimensionRawCode ∈ FP := + machineEllipsoidDimensionRawCode_mem_FP + +theorem machineRoundedInflationDimensionSquareRawCode_mem_FP : + machineRoundedInflationDimensionSquareRawCode ∈ FP := by + have hinput := machinePair_mem_FP + machineRoundedInflationDimensionRawCode_mem_FP + machineRoundedInflationDimensionRawCode_mem_FP + simpa only [machineRoundedInflationDimensionSquareRawCode] using + machineCompose_mem_FP hinput machineRawRatMulCode_mem_FP + +theorem machineRoundedInflationDimensionFourthRawCode_mem_FP : + machineRoundedInflationDimensionFourthRawCode ∈ FP := by + have hinput := machinePair_mem_FP + machineRoundedInflationDimensionSquareRawCode_mem_FP + machineRoundedInflationDimensionSquareRawCode_mem_FP + simpa only [machineRoundedInflationDimensionFourthRawCode] using + machineCompose_mem_FP hinput machineRawRatMulCode_mem_FP + +theorem machineRoundedInflationDenominatorRawCode_mem_FP : + machineRoundedInflationDenominatorRawCode ∈ FP := by + have hinput := machinePair_mem_FP + (machineConst_mem_FP (rawRatBinaryCode (RawRat.ofNat 1024))) + machineRoundedInflationDimensionFourthRawCode_mem_FP + simpa only [machineRoundedInflationDenominatorRawCode] using + machineCompose_mem_FP hinput machineRawRatMulCode_mem_FP + +theorem machineRoundedInflationRawCode_mem_FP : + machineRoundedInflationRawCode ∈ FP := by + have hinput := machinePair_mem_FP + (machineConst_mem_FP (rawRatBinaryCode rawEllipsoidOne)) + machineRoundedInflationDenominatorRawCode_mem_FP + simpa only [machineRoundedInflationRawCode] using + machineCompose_mem_FP hinput machineRawRatDivCode_mem_FP + +theorem machineRoundedInflationFactorRawCode_mem_FP : + machineRoundedInflationFactorRawCode ∈ FP := by + have hinput := machinePair_mem_FP + (machineConst_mem_FP (rawRatBinaryCode rawEllipsoidOne)) + machineRoundedInflationRawCode_mem_FP + simpa only [machineRoundedInflationFactorRawCode] using + machineCompose_mem_FP hinput machineRawRatAddCode_mem_FP + +theorem machineRoundedInflationFactorEntryCode_mem_FP : + machineRoundedInflationFactorEntryCode ∈ FP := by + simpa only [machineRoundedInflationFactorEntryCode] using + machineCompose_mem_FP machineRoundedInflationFactorRawCode_mem_FP + machineNormalizeRawRatEntryCode_mem_FP + +theorem machineScheduledRoundCenterCode_mem_FP : + machineScheduledRoundCenterCode ∈ FP := by + have hinput := machinePair_mem_FP machineScheduledRoundPrecision_mem_FP + machineScheduledRoundCenter_mem_FP + simpa only [machineScheduledRoundCenterCode] using + machineCompose_mem_FP hinput machineDyadicFloorVectorCode_mem_FP + +theorem machineScheduledRoundFlooredBasisCode_mem_FP : + machineScheduledRoundFlooredBasisCode ∈ FP := by + have hinput := machinePair_mem_FP machineScheduledRoundPrecision_mem_FP + machineScheduledRoundBasis_mem_FP + simpa only [machineScheduledRoundFlooredBasisCode] using + machineCompose_mem_FP hinput machineDyadicFloorMatrixCode_mem_FP + +theorem machineScheduledRoundInflationDiagonalCode_mem_FP : + machineScheduledRoundInflationDiagonalCode ∈ FP := by + have hfactor := machineCompose_mem_FP + machineScheduledRoundDimensionBits_mem_FP + machineRoundedInflationFactorEntryCode_mem_FP + have hinput := machinePair_mem_FP + machineScheduledRoundDimensionUnary_mem_FP hfactor + simpa only [machineScheduledRoundInflationDiagonalCode] using + machineCompose_mem_FP hinput machineDiagonalBasisRowsCode_mem_FP + +theorem machineScheduledRoundBasisCode_mem_FP : + machineScheduledRoundBasisCode ∈ FP := by + have hinput := machinePair_mem_FP + machineScheduledRoundDimensionUnary_mem_FP + (machinePair_mem_FP + machineScheduledRoundInflationDiagonalCode_mem_FP + machineScheduledRoundFlooredBasisCode_mem_FP) + simpa only [machineScheduledRoundBasisCode] using + machineCompose_mem_FP hinput machineRationalMatrixMulCode_mem_FP + +theorem machineScheduledRoundedEllipsoidCode_mem_FP : + machineScheduledRoundedEllipsoidCode ∈ FP := + machinePair_mem_FP machineScheduledRoundDimensionBits_mem_FP + (machinePair_mem_FP machineScheduledRoundCenterCode_mem_FP + machineScheduledRoundBasisCode_mem_FP) + +/-! ## Exact semantics -/ + +@[simp] theorem machineScheduledRoundDimensionUnary_encode {d : ℕ} + (p : ℕ) (E : RationalEllipsoidState d) : + machineScheduledRoundDimensionUnary + (pair (List.replicate p true) + (rationalEllipsoidStateBinaryCode E)) = + List.replicate d true := by + rw [machineScheduledRoundDimensionUnary] + simp only [machineScheduledRoundState, machinePairSecond_pair, + machineScheduledRoundDimensionBits, + machineRationalEllipsoidDimensionWord_encode] + exact machineBoundedUnary_encode_of_le + (rationalEllipsoidStateBinaryCode E) d + (rationalEllipsoid_dimension_le_state_code_length E) + +@[simp] theorem machineRoundedInflationDimensionRawCode_encode (d : ℕ) : + machineRoundedInflationDimensionRawCode d.bits = + rawRatBinaryCode (rawEllipsoidDimension d) := by + exact machineEllipsoidDimensionRawCode_encode d + +@[simp] theorem machineRoundedInflationDimensionSquareRawCode_encode + (d : ℕ) : + machineRoundedInflationDimensionSquareRawCode d.bits = + rawRatBinaryCode (rawEllipsoidDimensionSquare d) := by + rw [machineRoundedInflationDimensionSquareRawCode] + simp only [machineRoundedInflationDimensionRawCode_encode, + machineRawRatMulCode_encode, rawEllipsoidDimensionSquare] + +@[simp] theorem machineRoundedInflationDimensionFourthRawCode_encode + (d : ℕ) : + machineRoundedInflationDimensionFourthRawCode d.bits = + rawRatBinaryCode ((rawEllipsoidDimensionSquare d).mul + (rawEllipsoidDimensionSquare d)) := by + rw [machineRoundedInflationDimensionFourthRawCode] + simp only [machineRoundedInflationDimensionSquareRawCode_encode, + machineRawRatMulCode_encode] + +@[simp] theorem machineRoundedInflationDenominatorRawCode_encode (d : ℕ) : + machineRoundedInflationDenominatorRawCode d.bits = + rawRatBinaryCode (rawRoundedInflationDenominator d) := by + rw [machineRoundedInflationDenominatorRawCode] + simp only [machineRoundedInflationDimensionFourthRawCode_encode, + machineRawRatMulCode_encode, rawRoundedInflationDenominator] + +@[simp] theorem machineRoundedInflationRawCode_encode (d : ℕ) : + machineRoundedInflationRawCode d.bits = + rawRatBinaryCode (rawRoundedInflation d) := by + rw [machineRoundedInflationRawCode] + simp only [machineRoundedInflationDenominatorRawCode_encode, + machineRawRatDivCode_encode, rawRoundedInflation] + +@[simp] theorem machineRoundedInflationFactorRawCode_encode (d : ℕ) : + machineRoundedInflationFactorRawCode d.bits = + rawRatBinaryCode (rawRoundedInflationFactor d) := by + rw [machineRoundedInflationFactorRawCode] + simp only [machineRoundedInflationRawCode_encode, + machineRawRatAddCode_encode, rawRoundedInflationFactor] + +@[simp] theorem machineRoundedInflationFactorEntryCode_encode (d : ℕ) : + machineRoundedInflationFactorEntryCode d.bits = + rationalEntryBinaryCode (1 + roundedEllipsoidInflation d) := by + rw [machineRoundedInflationFactorEntryCode, + machineRoundedInflationFactorRawCode_encode, + machineNormalizeRawRatEntryCode_encode, + binaryNormalizeRawRat_eq_value, + rawRoundedInflationFactor_value] + +@[simp] theorem machineScheduledRoundCenterCode_encode {d : ℕ} + (p : ℕ) (E : RationalEllipsoidState d) : + machineScheduledRoundCenterCode + (pair (List.replicate p true) + (rationalEllipsoidStateBinaryCode E)) = + rationalFiniteVectorCode (dyadicFloorVector p E.center) := by + rw [machineScheduledRoundCenterCode] + simp only [machineScheduledRoundPrecision, machinePairFirst_pair, + machineScheduledRoundCenter, machineScheduledRoundState, + machinePairSecond_pair, machineRationalEllipsoidCenterWord_encode] + change machineDyadicFloorVectorCode + (dyadicFloorVectorCanonicalWord p E.center) = _ + rw [machineDyadicFloorVectorCode_encode] + +@[simp] theorem machineScheduledRoundFlooredBasisCode_encode {d : ℕ} + (p : ℕ) (E : RationalEllipsoidState d) : + machineScheduledRoundFlooredBasisCode + (pair (List.replicate p true) + (rationalEllipsoidStateBinaryCode E)) = + rationalSquareMatrixRowsCode (dyadicFloorMatrix p E.basis) := by + rw [machineScheduledRoundFlooredBasisCode] + simp only [machineScheduledRoundPrecision, machinePairFirst_pair, + machineScheduledRoundBasis, machineScheduledRoundState, + machinePairSecond_pair, machineRationalEllipsoidBasisWord_encode] + change machineDyadicFloorMatrixCode + (dyadicFloorMatrixCanonicalWord p E.basis) = _ + rw [machineDyadicFloorMatrixCode_encode] + +@[simp] theorem machineScheduledRoundInflationDiagonalCode_encode {d : ℕ} + (p : ℕ) (E : RationalEllipsoidState d) : + machineScheduledRoundInflationDiagonalCode + (pair (List.replicate p true) + (rationalEllipsoidStateBinaryCode E)) = + rationalSquareMatrixRowsCode + (rationalBallEllipsoid d 0 + (1 + roundedEllipsoidInflation d)).basis := by + rw [machineScheduledRoundInflationDiagonalCode] + simp only [machineScheduledRoundDimensionUnary_encode, + machineScheduledRoundDimensionBits, machineScheduledRoundState, + machinePairSecond_pair, machineRationalEllipsoidDimensionWord_encode, + machineRoundedInflationFactorEntryCode_encode] + exact machineDiagonalBasisRowsCode_encode d + (1 + roundedEllipsoidInflation d) + +theorem rationalMatrixMul_inflationDiagonal {d : ℕ} + (s : ℚ) (A : Matrix (Fin d) (Fin d) ℚ) : + rationalMatrixMul (rationalBallEllipsoid d 0 s).basis A = + fun i j ↦ s * A i j := by + rw [rationalMatrixMul_eq_matrix_mul, + rationalBallEllipsoid_basis] + ext i j + rw [Matrix.diagonal_mul] + +@[simp] theorem machineScheduledRoundBasisCode_encode {d : ℕ} + (p : ℕ) (E : RationalEllipsoidState d) : + machineScheduledRoundBasisCode + (pair (List.replicate p true) + (rationalEllipsoidStateBinaryCode E)) = + rationalSquareMatrixRowsCode + (scheduledRoundedEllipsoid p E).basis := by + rw [machineScheduledRoundBasisCode] + simp only [machineScheduledRoundDimensionUnary_encode, + machineScheduledRoundInflationDiagonalCode_encode, + machineScheduledRoundFlooredBasisCode_encode] + change machineRationalMatrixMulCode + (rationalMatrixMulCanonicalWord + (rationalBallEllipsoid d 0 + (1 + roundedEllipsoidInflation d)).basis + (dyadicFloorMatrix p E.basis)) = _ + rw [machineRationalMatrixMulCode_encode, + rationalMatrixMul_inflationDiagonal] + rfl + +@[simp] theorem machineScheduledRoundedEllipsoidCode_encode {d : ℕ} + (p : ℕ) (E : RationalEllipsoidState d) : + machineScheduledRoundedEllipsoidCode + (pair (List.replicate p true) + (rationalEllipsoidStateBinaryCode E)) = + rationalEllipsoidStateBinaryCode + (scheduledRoundedEllipsoid p E) := by + rw [machineScheduledRoundedEllipsoidCode, + machineScheduledRoundCenterCode_encode, + machineScheduledRoundBasisCode_encode] + simp [machineScheduledRoundDimensionBits, + machineScheduledRoundState, machineRationalEllipsoidDimensionWord, + rationalEllipsoidStateBinaryCode, + scheduledRoundedEllipsoid] + +/-! ## Exact central update followed by scheduled rounding -/ + +def machineScheduledCentralPrecision (word : List Bool) : List Bool := + machinePairFirst word + +def machineScheduledCentralStateAndCut (word : List Bool) : List Bool := + machinePairSecond word + +def machineScheduledRoundedEllipsoidCentralUpdateCode + (word : List Bool) : List Bool := + machineScheduledRoundedEllipsoidCode + (pair (machineScheduledCentralPrecision word) + (machineRationalEllipsoidCentralUpdateCode + (machineScheduledCentralStateAndCut word))) + +theorem machineScheduledCentralPrecision_mem_FP : + machineScheduledCentralPrecision ∈ FP := machinePairFirst_mem_FP + +theorem machineScheduledCentralStateAndCut_mem_FP : + machineScheduledCentralStateAndCut ∈ FP := machinePairSecond_mem_FP + +theorem machineScheduledRoundedEllipsoidCentralUpdateCode_mem_FP : + machineScheduledRoundedEllipsoidCentralUpdateCode ∈ FP := by + have hupdate := machineCompose_mem_FP + machineScheduledCentralStateAndCut_mem_FP + machineRationalEllipsoidCentralUpdateCode_mem_FP + have hinput := machinePair_mem_FP machineScheduledCentralPrecision_mem_FP + hupdate + simpa only [machineScheduledRoundedEllipsoidCentralUpdateCode] using + machineCompose_mem_FP hinput machineScheduledRoundedEllipsoidCode_mem_FP + +@[simp] theorem machineScheduledRoundedEllipsoidCentralUpdateCode_encode + {d : ℕ} (p : ℕ) (E : RationalEllipsoidState d) (a : Fin d → ℚ) : + machineScheduledRoundedEllipsoidCentralUpdateCode + (pair (List.replicate p true) + (pair (rationalEllipsoidStateBinaryCode E) + (rationalFiniteVectorCode a))) = + rationalEllipsoidStateBinaryCode + (scheduledRoundedEllipsoidCentralUpdate p E a) := by + rw [machineScheduledRoundedEllipsoidCentralUpdateCode] + simp only [machineScheduledCentralPrecision, machinePairFirst_pair, + machineScheduledCentralStateAndCut, machinePairSecond_pair, + machineRationalEllipsoidCentralUpdateCode_encode] + rw [machineScheduledRoundedEllipsoidCode_encode] + rfl + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineScheduledStateEncodingBound.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineScheduledStateEncodingBound.lean new file mode 100644 index 0000000000..1876cef44a --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineScheduledStateEncodingBound.lean @@ -0,0 +1,174 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineBetheFeasibilitySemantics +import LeanPool.BeyondBethe.BeyondBethe.RationalEncodingBounds +import Mathlib.Tactic + +/-! +# Ordinary binary bounds for scheduled ellipsoid states + +The semantic feasibility proof bounds magnitudes and denominators. The +finite-word loop needs the corresponding bound on its concrete, nested binary +code. This file supplies that elementary bridge without changing encodings. +-/ + +namespace BeyondBethe + +open Complexity +open scoped BigOperators + +def rationalEntryMachineCodeBound (K P : ℕ) : ℕ := + 8 + 2 * K + 4 * P + +def rationalVectorMachineCodeBound (d K P : ℕ) : ℕ := + d * (2 * rationalEntryMachineCodeBound K P + 2) + +def rationalMatrixMachineCodeBound (d K P : ℕ) : ℕ := + d * (2 * rationalVectorMachineCodeBound d K P + 2) + +def rationalEllipsoidMachineCodeBound (d K P : ℕ) : ℕ := + 2 * (d + 1) + + 2 * (2 * rationalVectorMachineCodeBound d K P + + 2 * rationalMatrixMachineCodeBound d K P + 2) + 2 + +theorem integerBinaryCode_length_le_of_natAbs_le_two_pow + {z : ℤ} {K : ℕ} (h : z.natAbs ≤ 2 ^ K) : + (integerBinaryCode z).length ≤ K + 2 := by + cases z with + | ofNat n => + have hn : n ≤ 2 ^ K := by simpa using h + have hs := nat_size_le_succ_of_le_two_pow hn + have hs' : n.bits.length ≤ K + 1 := by + simpa only [Nat.size_eq_bits_len] using hs + simp only [integerBinaryCode, List.length_cons] + omega + | negSucc n => + have hn : n ≤ 2 ^ K := by + simp only [Int.natAbs_negSucc] at h + omega + have hs := nat_size_le_succ_of_le_two_pow hn + have hs' : n.bits.length ≤ K + 1 := by + simpa only [Nat.size_eq_bits_len] using hs + simp only [integerBinaryCode, List.length_cons] + omega + +theorem rationalEntryBinaryCode_length_le_of_abs_and_den_bounds + {q : ℚ} {K P : ℕ} + (habs : abs q ≤ (2 : ℚ) ^ K) + (hden : q.den ≤ 2 ^ P) : + (rationalEntryBinaryCode q).length ≤ + rationalEntryMachineCodeBound K P := by + have hnum := rat_num_natAbs_le_of_abs_and_den_bounds habs hden + have hnumCode := integerBinaryCode_length_le_of_natAbs_le_two_pow hnum + have hdenSize := nat_size_le_succ_of_le_two_pow hden + rw [rationalEntryBinaryCode, pair_length] + rw [← Nat.size_eq_bits_len] at hdenSize + simp only [rationalEntryMachineCodeBound] + omega + +theorem rationalFiniteVectorCode_length_le_of_bounds {d K P : ℕ} + (v : Fin d → ℚ) + (habs : ∀ i, abs (v i) ≤ (2 : ℚ) ^ K) + (hden : ∀ i, (v i).den ≤ 2 ^ P) : + (rationalFiniteVectorCode v).length ≤ + rationalVectorMachineCodeBound d K P := by + rw [rationalFiniteVectorCode, binaryListCode_length_eq_sum, + List.map_ofFn, List.sum_ofFn] + have hsum : (∑ i : Fin d, + (2 * (rationalEntryBinaryCode (v i)).length + 2)) ≤ + ∑ _i : Fin d, (2 * rationalEntryMachineCodeBound K P + 2) := by + apply Finset.sum_le_sum + intro i _ + have hi := rationalEntryBinaryCode_length_le_of_abs_and_den_bounds + (habs i) (hden i) + omega + simpa only [rationalVectorMachineCodeBound, Finset.sum_const, + Finset.card_univ, Fintype.card_fin, nsmul_eq_mul, + Nat.mul_comm] using hsum + +theorem rationalSquareMatrixRowsCode_length_le_of_bounds {d K P : ℕ} + (A : Matrix (Fin d) (Fin d) ℚ) + (habs : ∀ i j, abs (A i j) ≤ (2 : ℚ) ^ K) + (hden : ∀ i j, (A i j).den ≤ 2 ^ P) : + (rationalSquareMatrixRowsCode A).length ≤ + rationalMatrixMachineCodeBound d K P := by + rw [rationalSquareMatrixRowsCode, binaryListCode_length_eq_sum, + rationalMatrixRows, List.map_ofFn, List.sum_ofFn] + have hsum : (∑ i : Fin d, + (2 * (binaryListCode rationalEntryBinaryCode + (List.ofFn (A i))).length + 2)) ≤ + ∑ _i : Fin d, (2 * rationalVectorMachineCodeBound d K P + 2) := by + apply Finset.sum_le_sum + intro i _ + have hi := rationalFiniteVectorCode_length_le_of_bounds + (A i) (habs i) (hden i) + simp only [rationalFiniteVectorCode] at hi + omega + simpa only [rationalMatrixMachineCodeBound, Finset.sum_const, + Finset.card_univ, Fintype.card_fin, nsmul_eq_mul, + Nat.mul_comm] using hsum + +theorem nat_bits_length_le_add_one (d : ℕ) : + d.bits.length ≤ d + 1 := by + cases d with + | zero => simp + | succ k => + rw [Nat.size_eq_bits_len, Nat.size_le] + exact Nat.lt_two_pow_self.trans + (Nat.pow_lt_pow_right (by decide) (by omega)) + +theorem rationalEllipsoidStateBinaryCode_length_le_of_bounds {d K P : ℕ} + (E : RationalEllipsoidState d) + (hcenterAbs : ∀ i, abs (E.center i) ≤ (2 : ℚ) ^ K) + (hcenterDen : ∀ i, (E.center i).den ≤ 2 ^ P) + (hbasisAbs : ∀ i j, abs (E.basis i j) ≤ (2 : ℚ) ^ K) + (hbasisDen : ∀ i j, (E.basis i j).den ≤ 2 ^ P) : + (rationalEllipsoidStateBinaryCode E).length ≤ + rationalEllipsoidMachineCodeBound d K P := by + have hc := rationalFiniteVectorCode_length_le_of_bounds + E.center hcenterAbs hcenterDen + have hB := rationalSquareMatrixRowsCode_length_le_of_bounds + E.basis hbasisAbs hbasisDen + have hd := nat_bits_length_le_add_one d + rw [rationalEllipsoidStateBinaryCode] + simp only [pair_length, rationalEllipsoidMachineCodeBound] + omega + +theorem scheduledRoundedEllipsoid_stateCode_length_le + {d K p : ℕ} (hd : 0 < d) (U : RationalEllipsoidState d) + (hM : rationalStateAbsBound (scheduledRoundedEllipsoid p U) ≤ + (2 : ℚ) ^ K) : + (rationalEllipsoidStateBinaryCode + (scheduledRoundedEllipsoid p U)).length ≤ + rationalEllipsoidMachineCodeBound d K (p + 10 + 4 * d) := by + apply rationalEllipsoidStateBinaryCode_length_le_of_bounds + · intro i + exact (abs_center_entry_lt_rationalStateAbsBound + (scheduledRoundedEllipsoid p U) i).le.trans hM + · intro i + have hden := inflatedDyadicRound_center_den_le (p := p) + (roundedEllipsoidInflation d) U i + have hp : p ≤ p + 10 + 4 * d := by omega + exact hden.trans (Nat.pow_le_pow_right (by decide) hp) + · intro i j + exact (abs_basis_entry_lt_rationalStateAbsBound + (scheduledRoundedEllipsoid p U) i j).le.trans hM + · intro i j + exact inflatedDyadicRound_basis_den_le hd U i j + +theorem scheduledRoundedEllipsoidCentralUpdate_stateCode_length_le + {d K p : ℕ} (hd : 0 < d) (E : RationalEllipsoidState d) + (a : Fin d → ℚ) + (hM : rationalStateAbsBound + (scheduledRoundedEllipsoidCentralUpdate p E a) ≤ (2 : ℚ) ^ K) : + (rationalEllipsoidStateBinaryCode + (scheduledRoundedEllipsoidCentralUpdate p E a)).length ≤ + rationalEllipsoidMachineCodeBound d K (p + 10 + 4 * d) := by + exact scheduledRoundedEllipsoid_stateCode_length_le hd + (rationalEllipsoidCentralUpdate E a) hM + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineSmallDimension.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineSmallDimension.lean new file mode 100644 index 0000000000..60097f28d5 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineSmallDimension.lean @@ -0,0 +1,144 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineOutputEncoding + +/-! +# Exact order-zero and order-one matrix branches + +The completed permanent algorithm handles dimensions zero and one exactly. +This file realizes those branches directly from the canonical matrix code. +-/ + +namespace BeyondBethe + +open Complexity + +def machineMatrixDimensionZeroBit (word : List Bool) : List Bool := + machineBinaryNatEqBit + (pair (machineMatrixDimensionWord word) []) + +def machineMatrixDimensionOneBit (word : List Bool) : List Bool := + machineBinaryNatEqBit + (pair (machineMatrixDimensionWord word) [true]) + +def machineMatrixFirstRowCode (word : List Bool) : List Bool := + machineListHead (machineMatrixRowsWord word) + +def machineMatrixFirstEntryCode (word : List Bool) : List Bool := + machineListHead (machineMatrixFirstRowCode word) + +def machineMatrixFirstEntryOutput (word : List Bool) : List Bool := + machineRationalBinaryCode (machineMatrixFirstEntryCode word) + +def machineSmallDimensionPermanentCode (word : List Bool) : List Bool := + machineIfHead (machineMatrixDimensionZeroBit word) + (rationalBinaryCode 1) + (machineIfHead (machineMatrixDimensionOneBit word) + (machineMatrixFirstEntryOutput word) []) + +theorem machineMatrixDimensionZeroBit_mem_FP : + machineMatrixDimensionZeroBit ∈ Complexity.FP := by + have hpair := machinePair_mem_FP machineMatrixDimensionWord_mem_FP + (machineConst_mem_FP []) + simpa only [machineMatrixDimensionZeroBit] using + machineCompose_mem_FP hpair machineBinaryNatEqBit_mem_FP + +theorem machineMatrixDimensionOneBit_mem_FP : + machineMatrixDimensionOneBit ∈ Complexity.FP := by + have hpair := machinePair_mem_FP machineMatrixDimensionWord_mem_FP + (machineConst_mem_FP [true]) + simpa only [machineMatrixDimensionOneBit] using + machineCompose_mem_FP hpair machineBinaryNatEqBit_mem_FP + +theorem machineMatrixFirstRowCode_mem_FP : + machineMatrixFirstRowCode ∈ Complexity.FP := by + simpa only [machineMatrixFirstRowCode, machineListHead] using + machineCompose_mem_FP machineMatrixRowsWord_mem_FP machinePairFirst_mem_FP + +theorem machineMatrixFirstEntryCode_mem_FP : + machineMatrixFirstEntryCode ∈ Complexity.FP := by + simpa only [machineMatrixFirstEntryCode, machineListHead] using + machineCompose_mem_FP machineMatrixFirstRowCode_mem_FP + machinePairFirst_mem_FP + +theorem machineMatrixFirstEntryOutput_mem_FP : + machineMatrixFirstEntryOutput ∈ Complexity.FP := by + simpa only [machineMatrixFirstEntryOutput] using + machineCompose_mem_FP machineMatrixFirstEntryCode_mem_FP + machineRationalBinaryCode_mem_FP + +theorem machineSmallDimensionPermanentCode_mem_FP : + machineSmallDimensionPermanentCode ∈ Complexity.FP := by + have hone := machineIfHead_mem_FP machineMatrixDimensionOneBit_mem_FP + machineMatrixFirstEntryOutput_mem_FP (machineConst_mem_FP []) + exact machineIfHead_mem_FP machineMatrixDimensionZeroBit_mem_FP + (machineConst_mem_FP (rationalBinaryCode 1)) hone + +@[simp] theorem machineMatrixDimensionZeroBit_encode {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) : + machineMatrixDimensionZeroBit + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩) = + [decide (n = 0)] := by + rw [machineMatrixDimensionZeroBit, machineMatrixDimensionWord_encode, + show ([] : List Bool) = (0 : ℕ).bits by rfl, + machineBinaryNatEqBit_pair_natBits] + simp + +@[simp] theorem machineMatrixDimensionOneBit_encode {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) : + machineMatrixDimensionOneBit + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩) = + [decide (n = 1)] := by + rw [machineMatrixDimensionOneBit, machineMatrixDimensionWord_encode, + show ([true] : List Bool) = (1 : ℕ).bits by rfl, + machineBinaryNatEqBit_pair_natBits] + +@[simp] theorem machineMatrixFirstRowCode_encode + (A : Matrix (Fin 1) (Fin 1) ℚ) : + machineMatrixFirstRowCode + (rationalMatrixBinaryEncoding.encode ⟨1, A⟩) = + binaryListCode rationalEntryBinaryCode [A 0 0] := by + simp [machineMatrixFirstRowCode, rationalMatrixRows] + +@[simp] theorem machineMatrixFirstEntryCode_encode + (A : Matrix (Fin 1) (Fin 1) ℚ) : + machineMatrixFirstEntryCode + (rationalMatrixBinaryEncoding.encode ⟨1, A⟩) = + rationalEntryBinaryCode (A 0 0) := by + simp [machineMatrixFirstEntryCode] + +@[simp] theorem machineMatrixFirstEntryOutput_encode + (A : Matrix (Fin 1) (Fin 1) ℚ) : + machineMatrixFirstEntryOutput + (rationalMatrixBinaryEncoding.encode ⟨1, A⟩) = + rationalBinaryCode (A 0 0) := by + simp [machineMatrixFirstEntryOutput, machineRationalBinaryCode_encode] + +theorem machineSmallDimensionPermanentCode_zero + (A : Matrix (Fin 0) (Fin 0) ℚ) : + machineSmallDimensionPermanentCode + (rationalMatrixBinaryEncoding.encode ⟨0, A⟩) = + rationalBinaryCode (Matrix.permanent A) := by + simp [machineSmallDimensionPermanentCode, Matrix.permanent] + +theorem machineSmallDimensionPermanentCode_one + (A : Matrix (Fin 1) (Fin 1) ℚ) : + machineSmallDimensionPermanentCode + (rationalMatrixBinaryEncoding.encode ⟨1, A⟩) = + rationalBinaryCode (Matrix.permanent A) := by + simp [machineSmallDimensionPermanentCode, Matrix.permanent_fin_one] + +theorem machineSmallDimensionPermanentCode_encode {n : ℕ} + (hn : n < 2) (A : Matrix (Fin n) (Fin n) ℚ) : + machineSmallDimensionPermanentCode + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩) = + rationalBinaryCode (Matrix.permanent A) := by + interval_cases n + · exact machineSmallDimensionPermanentCode_zero A + · exact machineSmallDimensionPermanentCode_one A + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineSmoothedMatrix.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineSmoothedMatrix.lean new file mode 100644 index 0000000000..54bc68e10b --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineSmoothedMatrix.lean @@ -0,0 +1,119 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineMatrixAddDelta +import LeanPool.BeyondBethe.BeyondBethe.MachineMatrixNormalizeEntries +import LeanPool.BeyondBethe.BeyondBethe.MachineSmoothingDelta + +/-! +# The complete normalization-and-smoothing matrix transform + +The input is `pair chiRawCode matrixCode`. We normalize the matrix, compute +the raw smoothing witness from that normalized matrix, and add the witness to +every normalized entry. Keeping the smoothing witness in raw-fraction format +is essential: the canonical public rational output uses a different encoding +and cannot be fed directly to the matrix-entry arithmetic machines. +-/ + +namespace BeyondBethe + +open Complexity + +def machineSmoothedMatrixChiRawCode (word : List Bool) : List Bool := + machinePairFirst word + +def machineSmoothedMatrixInputCode (word : List Bool) : List Bool := + machinePairSecond word + +def machineSmoothedMatrixNormalizedCode (word : List Bool) : List Bool := + machineMatrixNormalizeEntries (machineSmoothedMatrixInputCode word) + +def machineSmoothedMatrixDeltaRawCode (word : List Bool) : List Bool := + machineSmoothingDeltaRawCode + (pair (machineSmoothedMatrixChiRawCode word) + (machineSmoothedMatrixNormalizedCode word)) + +def machineSmoothedMatrixCode (word : List Bool) : List Bool := + machineMatrixAddDeltaEntries + (pair (machineSmoothedMatrixDeltaRawCode word) + (machineSmoothedMatrixNormalizedCode word)) + +theorem machineSmoothedMatrixChiRawCode_mem_FP : + machineSmoothedMatrixChiRawCode ∈ Complexity.FP := machinePairFirst_mem_FP + +theorem machineSmoothedMatrixInputCode_mem_FP : + machineSmoothedMatrixInputCode ∈ Complexity.FP := machinePairSecond_mem_FP + +theorem machineSmoothedMatrixNormalizedCode_mem_FP : + machineSmoothedMatrixNormalizedCode ∈ Complexity.FP := by + simpa only [machineSmoothedMatrixNormalizedCode] using + machineCompose_mem_FP machineSmoothedMatrixInputCode_mem_FP + machineMatrixNormalizeEntries_mem_FP + +theorem machineSmoothedMatrixDeltaRawCode_mem_FP : + machineSmoothedMatrixDeltaRawCode ∈ Complexity.FP := by + have hpair := machinePair_mem_FP machineSmoothedMatrixChiRawCode_mem_FP + machineSmoothedMatrixNormalizedCode_mem_FP + simpa only [machineSmoothedMatrixDeltaRawCode] using + machineCompose_mem_FP hpair machineSmoothingDeltaRawCode_mem_FP + +theorem machineSmoothedMatrixCode_mem_FP : + machineSmoothedMatrixCode ∈ Complexity.FP := by + have hpair := machinePair_mem_FP machineSmoothedMatrixDeltaRawCode_mem_FP + machineSmoothedMatrixNormalizedCode_mem_FP + simpa only [machineSmoothedMatrixCode] using + machineCompose_mem_FP hpair machineMatrixAddDeltaEntries_mem_FP + +@[simp] theorem machineSmoothedMatrixNormalizedCode_encode {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) (χ : RawRat) : + machineSmoothedMatrixNormalizedCode + (pair (rawRatBinaryCode χ) + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩)) = + rationalMatrixBinaryEncoding.encode + ⟨n, normalizedRationalMatrix A⟩ := by + simp [machineSmoothedMatrixNormalizedCode, + machineSmoothedMatrixInputCode] + +@[simp] theorem machineSmoothedMatrixDeltaRawCode_encode {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) (χ : RawRat) : + machineSmoothedMatrixDeltaRawCode + (pair (rawRatBinaryCode χ) + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩)) = + rawRatBinaryCode + (rawRationalSmoothingDelta (normalizedRationalMatrix A) χ) := by + simp [machineSmoothedMatrixDeltaRawCode, + machineSmoothedMatrixChiRawCode] + +@[simp] theorem machineSmoothedMatrixCode_encode {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) (χ : RawRat) : + machineSmoothedMatrixCode + (pair (rawRatBinaryCode χ) + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩)) = + rationalMatrixBinaryEncoding.encode + ⟨n, smoothedRationalMatrix A χ.value⟩ := by + rw [machineSmoothedMatrixCode, + machineSmoothedMatrixDeltaRawCode_encode, + machineSmoothedMatrixNormalizedCode_encode] + change machineMatrixAddDeltaEntries + (machineMatrixAddDeltaCanonicalInput + (rawRationalSmoothingDelta (normalizedRationalMatrix A) χ) + (normalizedRationalMatrix A)) = _ + rw [machineMatrixAddDeltaEntries_encode] + congr 2 + funext i j + simp only [rationalMatrixAddDeltaSemantic, smoothedRationalMatrix] + rw [rawRationalSmoothingDelta_value] + +@[simp] theorem machineSmoothedMatrixCode_rational {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) (χ : ℚ) : + machineSmoothedMatrixCode + (pair (rawRatBinaryCode (rawRatOfRat χ)) + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩)) = + rationalMatrixBinaryEncoding.encode + ⟨n, smoothedRationalMatrix A χ⟩ := by + rw [machineSmoothedMatrixCode_encode, rawRatOfRat_value] + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineSmoothingDelta.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineSmoothingDelta.lean new file mode 100644 index 0000000000..3bef2e73ba --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineSmoothingDelta.lean @@ -0,0 +1,329 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineFactorial +import LeanPool.BeyondBethe.BeyondBethe.MachineLengthBits +import LeanPool.BeyondBethe.BeyondBethe.MachineMatrixDimension +import LeanPool.BeyondBethe.BeyondBethe.MachineMatrixSupportProduct +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalMin +import LeanPool.BeyondBethe.BeyondBethe.MachineRationalPower + +/-! +# The rational smoothing level as a finite-word function + +The input is a pair consisting of an unreduced rational word for `chi` and a +canonical rational-matrix word. We assemble + +`min (1 / (2 * n)) (chi * supportFloor ^ n / (4 * n!))` + +from the verified finite-word primitives. The matrix dimension is first +converted to a guarded unary ruler; this same ruler drives both exponentiation +and factorial. All intermediate rational words remain unreduced until the +final minimum has selected a branch, at which point the selected fraction is +canonically normalized. +-/ + +namespace BeyondBethe + +open Complexity + +def machineSmoothingChiRawCode (word : List Bool) : List Bool := + machinePairFirst word + +def machineSmoothingMatrixCode (word : List Bool) : List Bool := + machinePairSecond word + +def machineSmoothingDimensionRuler (word : List Bool) : List Bool := + machineMatrixDimensionUnary (machineSmoothingMatrixCode word) + +def machineSmoothingDimensionRawCode (word : List Bool) : List Bool := + pair (false :: machineLengthBits (machineSmoothingDimensionRuler word)) + (1 : ℕ).bits + +def machineSmoothingSupportRawCode (word : List Bool) : List Bool := + machineMatrixSupportRawCode (machineSmoothingMatrixCode word) + +def machineSmoothingSupportPowerRawCode (word : List Bool) : List Bool := + machineRawRatPowerCode + (pair (machineSmoothingDimensionRuler word) + (machineSmoothingSupportRawCode word)) + +def machineSmoothingFactorialRawCode (word : List Bool) : List Bool := + machineFactorialRawRatCode (machineSmoothingDimensionRuler word) + +def machineSmoothingFirstDenominatorRawCode (word : List Bool) : List Bool := + machineRawRatMulCode + (pair (rawRatBinaryCode (RawRat.ofNat 2)) + (machineSmoothingDimensionRawCode word)) + +def machineSmoothingFirstRawCode (word : List Bool) : List Bool := + machineRawRatDivCode + (pair (rawRatBinaryCode RawRat.one) + (machineSmoothingFirstDenominatorRawCode word)) + +def machineSmoothingWeightedSupportRawCode (word : List Bool) : List Bool := + machineRawRatMulCode + (pair (machineSmoothingChiRawCode word) + (machineSmoothingSupportPowerRawCode word)) + +def machineSmoothingSecondDenominatorRawCode (word : List Bool) : List Bool := + machineRawRatMulCode + (pair (rawRatBinaryCode (RawRat.ofNat 4)) + (machineSmoothingFactorialRawCode word)) + +def machineSmoothingSecondRawCode (word : List Bool) : List Bool := + machineRawRatDivCode + (pair (machineSmoothingWeightedSupportRawCode word) + (machineSmoothingSecondDenominatorRawCode word)) + +def machineSmoothingDeltaRawCode (word : List Bool) : List Bool := + machineRawRatMinCode + (pair (machineSmoothingFirstRawCode word) + (machineSmoothingSecondRawCode word)) + +def machineSmoothingDeltaCode (word : List Bool) : List Bool := + machineNormalizeRawRatBinaryCode (machineSmoothingDeltaRawCode word) + +theorem machineSmoothingChiRawCode_mem_FP : + machineSmoothingChiRawCode ∈ Complexity.FP := machinePairFirst_mem_FP + +theorem machineSmoothingMatrixCode_mem_FP : + machineSmoothingMatrixCode ∈ Complexity.FP := machinePairSecond_mem_FP + +theorem machineSmoothingDimensionRuler_mem_FP : + machineSmoothingDimensionRuler ∈ Complexity.FP := by + simpa only [machineSmoothingDimensionRuler] using + machineCompose_mem_FP machineSmoothingMatrixCode_mem_FP + machineMatrixDimensionUnary_mem_FP + +theorem machineSmoothingDimensionRawCode_mem_FP : + machineSmoothingDimensionRawCode ∈ Complexity.FP := by + have hbits := machineCompose_mem_FP + machineSmoothingDimensionRuler_mem_FP machineLengthBits_mem_FP + have hnum := machineCompose_mem_FP hbits (machinePrepend_mem_FP false) + exact machinePair_mem_FP hnum (machineConst_mem_FP (1 : ℕ).bits) + +theorem machineSmoothingSupportRawCode_mem_FP : + machineSmoothingSupportRawCode ∈ Complexity.FP := by + simpa only [machineSmoothingSupportRawCode] using + machineCompose_mem_FP machineSmoothingMatrixCode_mem_FP + machineMatrixSupportRawCode_mem_FP + +theorem machineSmoothingSupportPowerRawCode_mem_FP : + machineSmoothingSupportPowerRawCode ∈ Complexity.FP := by + have hpair := machinePair_mem_FP machineSmoothingDimensionRuler_mem_FP + machineSmoothingSupportRawCode_mem_FP + simpa only [machineSmoothingSupportPowerRawCode] using + machineCompose_mem_FP hpair machineRawRatPowerCode_mem_FP + +theorem machineSmoothingFactorialRawCode_mem_FP : + machineSmoothingFactorialRawCode ∈ Complexity.FP := by + simpa only [machineSmoothingFactorialRawCode] using + machineCompose_mem_FP machineSmoothingDimensionRuler_mem_FP + machineFactorialRawRatCode_mem_FP + +theorem machineSmoothingFirstDenominatorRawCode_mem_FP : + machineSmoothingFirstDenominatorRawCode ∈ Complexity.FP := by + have hpair := machinePair_mem_FP + (machineConst_mem_FP (rawRatBinaryCode (RawRat.ofNat 2))) + machineSmoothingDimensionRawCode_mem_FP + simpa only [machineSmoothingFirstDenominatorRawCode] using + machineCompose_mem_FP hpair machineRawRatMulCode_mem_FP + +theorem machineSmoothingFirstRawCode_mem_FP : + machineSmoothingFirstRawCode ∈ Complexity.FP := by + have hpair := machinePair_mem_FP + (machineConst_mem_FP (rawRatBinaryCode RawRat.one)) + machineSmoothingFirstDenominatorRawCode_mem_FP + simpa only [machineSmoothingFirstRawCode] using + machineCompose_mem_FP hpair machineRawRatDivCode_mem_FP + +theorem machineSmoothingWeightedSupportRawCode_mem_FP : + machineSmoothingWeightedSupportRawCode ∈ Complexity.FP := by + have hpair := machinePair_mem_FP machineSmoothingChiRawCode_mem_FP + machineSmoothingSupportPowerRawCode_mem_FP + simpa only [machineSmoothingWeightedSupportRawCode] using + machineCompose_mem_FP hpair machineRawRatMulCode_mem_FP + +theorem machineSmoothingSecondDenominatorRawCode_mem_FP : + machineSmoothingSecondDenominatorRawCode ∈ Complexity.FP := by + have hpair := machinePair_mem_FP + (machineConst_mem_FP (rawRatBinaryCode (RawRat.ofNat 4))) + machineSmoothingFactorialRawCode_mem_FP + simpa only [machineSmoothingSecondDenominatorRawCode] using + machineCompose_mem_FP hpair machineRawRatMulCode_mem_FP + +theorem machineSmoothingSecondRawCode_mem_FP : + machineSmoothingSecondRawCode ∈ Complexity.FP := by + have hpair := machinePair_mem_FP + machineSmoothingWeightedSupportRawCode_mem_FP + machineSmoothingSecondDenominatorRawCode_mem_FP + simpa only [machineSmoothingSecondRawCode] using + machineCompose_mem_FP hpair machineRawRatDivCode_mem_FP + +theorem machineSmoothingDeltaRawCode_mem_FP : + machineSmoothingDeltaRawCode ∈ Complexity.FP := by + have hpair := machinePair_mem_FP machineSmoothingFirstRawCode_mem_FP + machineSmoothingSecondRawCode_mem_FP + simpa only [machineSmoothingDeltaRawCode] using + machineCompose_mem_FP hpair machineRawRatMinCode_mem_FP + +theorem machineSmoothingDeltaCode_mem_FP : + machineSmoothingDeltaCode ∈ Complexity.FP := by + simpa only [machineSmoothingDeltaCode] using + machineCompose_mem_FP machineSmoothingDeltaRawCode_mem_FP + machineNormalizeRawRatBinaryCode_mem_FP + +/-! ## Exact semantics on canonical inputs -/ + +@[simp] theorem machineSmoothingDimensionRawCode_encode {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) (χ : RawRat) : + machineSmoothingDimensionRawCode + (pair (rawRatBinaryCode χ) + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩)) = + rawRatBinaryCode (RawRat.ofNat n) := by + simp [machineSmoothingDimensionRawCode, machineSmoothingDimensionRuler, + machineSmoothingMatrixCode, rawRatBinaryCode, RawRat.ofNat, + integerBinaryCode] + +@[simp] theorem machineSmoothingSupportRawCode_encode {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) (χ : RawRat) : + machineSmoothingSupportRawCode + (pair (rawRatBinaryCode χ) + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩)) = + rawRatBinaryCode + (rawRatRowsSupportProduct RawRat.one (rationalMatrixRows A)) := by + simp [machineSmoothingSupportRawCode, machineSmoothingMatrixCode] + +@[simp] theorem machineSmoothingSupportPowerRawCode_encode {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) (χ : RawRat) : + machineSmoothingSupportPowerRawCode + (pair (rawRatBinaryCode χ) + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩)) = + rawRatBinaryCode + ((rawRatRowsSupportProduct RawRat.one + (rationalMatrixRows A)).pow n) := by + rw [machineSmoothingSupportPowerRawCode, + machineSmoothingDimensionRuler, machineSmoothingMatrixCode, + machinePairSecond_pair, machineMatrixDimensionUnary_encode, + machineSmoothingSupportRawCode_encode, + machineRawRatPowerCode_encode] + +@[simp] theorem machineSmoothingFactorialRawCode_encode {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) (χ : RawRat) : + machineSmoothingFactorialRawCode + (pair (rawRatBinaryCode χ) + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩)) = + rawRatBinaryCode (RawRat.ofNat n.factorial) := by + simp [machineSmoothingFactorialRawCode, machineSmoothingDimensionRuler, + machineSmoothingMatrixCode] + +def rawRationalSmoothingFirst (n : ℕ) : RawRat := + RawRat.one.div ((RawRat.ofNat 2).mul (RawRat.ofNat n)) + +def rawRationalSmoothingSecond {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) (χ : RawRat) : RawRat := + (χ.mul ((rawRatRowsSupportProduct RawRat.one + (rationalMatrixRows A)).pow n)).div + ((RawRat.ofNat 4).mul (RawRat.ofNat n.factorial)) + +def rawRationalSmoothingDelta {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) (χ : RawRat) : RawRat := + if (rawRationalSmoothingFirst n).value ≤ + (rawRationalSmoothingSecond A χ).value then + rawRationalSmoothingFirst n + else + rawRationalSmoothingSecond A χ + +@[simp] theorem machineSmoothingDeltaRawCode_encode {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) (χ : RawRat) : + machineSmoothingDeltaRawCode + (pair (rawRatBinaryCode χ) + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩)) = + rawRatBinaryCode (rawRationalSmoothingDelta A χ) := by + simp only [machineSmoothingDeltaRawCode, + machineSmoothingFirstRawCode, + machineSmoothingFirstDenominatorRawCode, + machineSmoothingSecondRawCode, + machineSmoothingWeightedSupportRawCode, + machineSmoothingSecondDenominatorRawCode, + machineSmoothingChiRawCode, machinePairFirst_pair, + machineSmoothingDimensionRawCode_encode, + machineSmoothingSupportPowerRawCode_encode, + machineSmoothingFactorialRawCode_encode, + machineRawRatMulCode_encode, machineRawRatDivCode_encode, + machineRawRatMinCode_encode, rawRationalSmoothingDelta, + rawRationalSmoothingFirst, rawRationalSmoothingSecond] + +theorem rawRationalSmoothingDelta_value {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) (χ : RawRat) : + (rawRationalSmoothingDelta A χ).value = + rationalSmoothingDelta A χ.value := by + simp only [rawRationalSmoothingDelta, rawRationalSmoothingFirst, + rawRationalSmoothingSecond, RawRat.value_div, RawRat.value_mul, + RawRat.value_pow, RawRat.value_ofNat, RawRat.value_one, + rawRatRowsSupportProduct_eq_rationalSupportFloor, + rationalSmoothingDelta] + norm_num only [Nat.cast_ofNat] + by_cases h : + 1 / ((2 : ℚ) * n) ≤ + χ.value * rationalSupportFloor A ^ n / + ((4 : ℚ) * n.factorial) + · rw [if_pos h, min_eq_left h] + simp + · have hright : + χ.value * rationalSupportFloor A ^ n / + ((4 : ℚ) * n.factorial) ≤ + 1 / ((2 : ℚ) * n) := le_of_not_ge h + rw [if_neg h, min_eq_right hright] + simp [rawRatRowsSupportProduct_eq_rationalSupportFloor] + +theorem machineSmoothingDeltaCode_encode {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) (χ : RawRat) : + machineSmoothingDeltaCode + (pair (rawRatBinaryCode χ) + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩)) = + rationalBinaryCode (rationalSmoothingDelta A χ.value) := by + simp only [machineSmoothingDeltaCode, machineSmoothingDeltaRawCode, + machineSmoothingFirstRawCode, + machineSmoothingFirstDenominatorRawCode, + machineSmoothingSecondRawCode, + machineSmoothingWeightedSupportRawCode, + machineSmoothingSecondDenominatorRawCode, + machineSmoothingChiRawCode, machinePairFirst_pair, + machineSmoothingDimensionRawCode_encode, + machineSmoothingSupportPowerRawCode_encode, + machineSmoothingFactorialRawCode_encode, + machineRawRatMulCode_encode, machineRawRatDivCode_encode, + machineRawRatMinCode_encode, + machineNormalizeRawRatBinaryCode_encode, + binaryNormalizeRawRat_eq_value, rationalSmoothingDelta, + RawRat.value_div, RawRat.value_mul, RawRat.value_pow, + RawRat.value_ofNat, RawRat.value_one, + rawRatRowsSupportProduct_eq_rationalSupportFloor] + norm_num only [Nat.cast_ofNat] + by_cases h : + 1 / ((2 : ℚ) * n) ≤ + χ.value * rationalSupportFloor A ^ n / + ((4 : ℚ) * n.factorial) + · rw [if_pos h, min_eq_left h] + simp + · have hright : + χ.value * rationalSupportFloor A ^ n / + ((4 : ℚ) * n.factorial) ≤ + 1 / ((2 : ℚ) * n) := le_of_not_ge h + rw [if_neg h, min_eq_right hright] + simp [rawRatRowsSupportProduct_eq_rationalSupportFloor] + +@[simp] theorem machineSmoothingDeltaCode_rational {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) (χ : ℚ) : + machineSmoothingDeltaCode + (pair (rawRatBinaryCode (rawRatOfRat χ)) + (rationalMatrixBinaryEncoding.encode ⟨n, A⟩)) = + rationalBinaryCode (rationalSmoothingDelta A χ) := by + rw [machineSmoothingDeltaCode_encode, rawRatOfRat_value] + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineTrimHighZeros.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineTrimHighZeros.lean new file mode 100644 index 0000000000..3a9c8ce729 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineTrimHighZeros.lean @@ -0,0 +1,257 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineBitAssembly +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleSub.Defs + +/-! +# Polynomial-time canonicalization of little-endian natural words + +A bit-graph machine may emit a polynomially bounded fixed-width word. The +public rational encoding uses canonical `Nat.bits`, so redundant high zeroes +must be removed. The implementation below is a length-bounded Cobham fold, +not a semantic list primitive assumed to be efficient. +-/ + +namespace BeyondBethe + +open Complexity + +def machineTrimAcc (state : List Bool) : List Bool := + machinePairSecond (machinePairFirst state) + +def machineTrimFalseStep (state : List Bool) : List Bool := + machineIfEmpty (machineTrimAcc state) [] + (false :: machineTrimAcc state) + +def machineTrimTrueStep (state : List Bool) : List Bool := + true :: machineTrimAcc state + +def machineTrimPacked (packed : List Bool) : List Bool := + Cobham.recFoldClamp machineTrimFalseStep machineTrimTrueStep + packed.length [] + (machinePairFirst packed) (machinePairSecond packed) + +def machineTrimHighZeros (word : List Bool) : List Bool := + machineTrimPacked (pair [] word) + +theorem machineTrimAcc_mem_FP : machineTrimAcc ∈ Complexity.FP := by + simpa only [machineTrimAcc] using + machineCompose_mem_FP machinePairFirst_mem_FP machinePairSecond_mem_FP + +theorem machineTrimFalseStep_mem_FP : + machineTrimFalseStep ∈ Complexity.FP := by + have hcons : (fun state => false :: machineTrimAcc state) ∈ + Complexity.FP := + machineCompose_mem_FP machineTrimAcc_mem_FP + (machinePrepend_mem_FP false) + exact machineIfEmpty_mem_FP machineTrimAcc_mem_FP + (machineConst_mem_FP []) hcons + +theorem machineTrimTrueStep_mem_FP : + machineTrimTrueStep ∈ Complexity.FP := by + simpa only [machineTrimTrueStep] using + machineCompose_mem_FP machineTrimAcc_mem_FP + (machinePrepend_mem_FP true) + +theorem machineTrimPacked_mem_FP : machineTrimPacked ∈ Complexity.FP := by + simpa only [machineTrimPacked, Polynomial.eval_X] using + Cobham.recFoldClamp_mem_FP machineTrimFalseStep_mem_FP + machineTrimTrueStep_mem_FP (machineConst_mem_FP []) Polynomial.X + +theorem machineTrimHighZeros_mem_FP : + machineTrimHighZeros ∈ Complexity.FP := by + have hpack : (fun word : List Bool => pair [] word) ∈ Complexity.FP := + machinePair_mem_FP (machineConst_mem_FP []) id_mem_FP + simpa only [machineTrimHighZeros] using + machineCompose_mem_FP hpack machineTrimPacked_mem_FP + +theorem binaryTrimHighZeros_length_le : ∀ bits : List Bool, + (BinaryRippleSub.trimHighZeros bits).length ≤ bits.length := by + intro bits + induction bits with + | nil => rfl + | cons bit rest ih => + simp only [BinaryRippleSub.trimHighZeros] + cases htrim : BinaryRippleSub.trimHighZeros rest with + | nil => cases bit <;> simp + | cons high tail => + simp only [htrim, List.length_cons] at ih ⊢ + omega + +theorem machineTrim_recFold_eq : ∀ bits : List Bool, + Cobham.recFold machineTrimFalseStep machineTrimTrueStep [] [] bits = + BinaryRippleSub.trimHighZeros bits := by + intro bits + induction bits with + | nil => rfl + | cons bit rest ih => + simp only [Cobham.recFold] + cases bit with + | false => + simp only [Bool.false_eq, cond_false, machineTrimFalseStep, + machineTrimAcc, machinePairFirst_pair, machinePairSecond_pair, ih] + cases htrim : BinaryRippleSub.trimHighZeros rest with + | nil => simp [BinaryRippleSub.trimHighZeros, htrim] + | cons high tail => + simp [BinaryRippleSub.trimHighZeros, htrim] + | true => + simp only [cond_true, ih] + cases htrim : BinaryRippleSub.trimHighZeros rest <;> + simp [machineTrimTrueStep, machineTrimAcc, + BinaryRippleSub.trimHighZeros, htrim] + +/-- The concrete bounded fold removes precisely the redundant high zeroes. -/ +theorem machineTrimHighZeros_eq (word : List Bool) : + machineTrimHighZeros word = BinaryRippleSub.trimHighZeros word := by + rw [machineTrimHighZeros, machineTrimPacked] + have hbound : ∀ t : List Bool, t.length ≤ word.length → + (Cobham.recFold machineTrimFalseStep machineTrimTrueStep [] [] t).length ≤ + (pair [] word).length := by + intro t ht + rw [machineTrim_recFold_eq] + have htrim := binaryTrimHighZeros_length_le t + simp only [pair_length, List.length_nil] + omega + simp only [machinePairFirst_pair, machinePairSecond_pair] + rw [Cobham.recFoldClamp_eq_recFold word hbound, + machineTrim_recFold_eq] + +def machineAssembleCanonicalBits + (query ruler : List Bool → List Bool) (word : List Bool) : List Bool := + machineTrimHighZeros (machineAssembleBits query ruler word) + +theorem machineAssembleCanonicalBits_mem_FP + {query ruler : List Bool → List Bool} + (hquery : query ∈ Complexity.FP) (hruler : ruler ∈ Complexity.FP) : + machineAssembleCanonicalBits query ruler ∈ Complexity.FP := by + simpa only [machineAssembleCanonicalBits] using + machineCompose_mem_FP (machineAssembleBits_mem_FP hquery hruler) + machineTrimHighZeros_mem_FP + +theorem replicate_false_succ_append (k : ℕ) : + List.replicate (k + 1) false = List.replicate k false ++ [false] := by + induction k with + | zero => simp + | succ k ih => + calc + List.replicate (k + 1 + 1) false = + false :: List.replicate (k + 1) false := by + rw [List.replicate_succ] + _ = false :: (List.replicate k false ++ [false]) := by rw [ih] + _ = List.replicate (k + 1) false ++ [false] := by + rw [List.replicate_succ, List.cons_append] + +theorem binaryTrimHighZeros_append_false (bits : List Bool) : + BinaryRippleSub.trimHighZeros (bits ++ [false]) = + BinaryRippleSub.trimHighZeros bits := by + induction bits with + | nil => rfl + | cons bit rest ih => + rw [List.cons_append, BinaryRippleSub.trimHighZeros, ih] + cases htrim : BinaryRippleSub.trimHighZeros rest <;> + simp [BinaryRippleSub.trimHighZeros, htrim] + +theorem binaryTrimHighZeros_append_replicate_false + (bits : List Bool) : ∀ k : ℕ, + BinaryRippleSub.trimHighZeros (bits ++ List.replicate k false) = + BinaryRippleSub.trimHighZeros bits := by + intro k + induction k with + | zero => simp + | succ k ih => + rw [replicate_false_succ_append, ← List.append_assoc, + binaryTrimHighZeros_append_false, ih] + +theorem assembledOutputBitLanguage_padded + (target : List Bool → List Bool) (word : List Bool) : ∀ extra : ℕ, + assembledQueryBits + (MachineRAMBridge.languageFlag (outputBitLanguage target)) word + ((target word).length + extra) = + target word ++ List.replicate extra false := by + intro extra + induction extra with + | zero => + simpa using assembledQueryBits_eq_take + (MachineRAMBridge.languageFlag (outputBitLanguage target)) target + (outputBitLanguage_flag_pair target) word + (target word).length le_rfl + | succ extra ih => + rw [Nat.add_succ, assembledQueryBits, ih, + outputBitLanguage_flag_pair_all] + have hnone : + (target word)[(target word).length + extra]? = none := + List.getElem?_eq_none (by omega) + rw [hnone] + simp only [Option.getD_none, machineHeadBit_cons] + rw [replicate_false_succ_append, List.append_assoc] + +/-- With a polynomial upper bound on output width, bit-graph assembly followed +by verified high-zero trimming recovers any already-canonical target word. -/ +theorem machineAssembleCanonicalBits_realizes + (target ruler : List Bool → List Bool) + (hruler : ∀ word, (target word).length ≤ (ruler word).length) + (hcanonical : ∀ word, + BinaryRippleSub.trimHighZeros (target word) = target word) : + machineAssembleCanonicalBits + (MachineRAMBridge.languageFlag (outputBitLanguage target)) ruler = + target := by + funext word + rw [machineAssembleCanonicalBits, machineAssembleBits_eq] + have hsum : (target word).length + + ((ruler word).length - (target word).length) = + (ruler word).length := Nat.add_sub_of_le (hruler word) + rw [← hsum, assembledOutputBitLanguage_padded, + machineTrimHighZeros_eq, + binaryTrimHighZeros_append_replicate_false, + hcanonical] + +/-- Upper-bound version of the RAM bit-graph reduction. This is the form +used for canonical natural and rational outputs. -/ +theorem canonicalTarget_mem_FP_of_ramBitProgram + (target ruler : List Bool → List Bool) + (program : RAM.Program) (p : Polynomial ℕ) + (hdecides : program.DecidesInTime (outputBitLanguage target) p.eval) + (hrulerFP : ruler ∈ Complexity.FP) + (hrulerLength : ∀ word, + (target word).length ≤ (ruler word).length) + (hcanonical : ∀ word, + BinaryRippleSub.trimHighZeros (target word) = target word) : + target ∈ Complexity.FP := by + let query := MachineRAMBridge.languageFlag (outputBitLanguage target) + have hqueryFP : query ∈ Complexity.FP := + MachineRAMBridge.languageFlag_mem_FP_of_ramProgram program p hdecides + have hassembly : machineAssembleCanonicalBits query ruler ∈ Complexity.FP := + machineAssembleCanonicalBits_mem_FP hqueryFP hrulerFP + have heq : machineAssembleCanonicalBits query ruler = target := + machineAssembleCanonicalBits_realizes target ruler hrulerLength hcanonical + rwa [heq] at hassembly + +/-- Scratch-register-prefix version of the upper-bound RAM bit-graph +reduction. -/ +theorem canonicalTarget_mem_FP_of_paddedRamBitProgram + (scratchRegisters : ℕ) (target ruler : List Bool → List Bool) + (program : RAM.Program) (p : Polynomial ℕ) + (hdecides : program.DecidesInTime + (MachineRAMBridge.paddedLanguage scratchRegisters + (outputBitLanguage target)) p.eval) + (hrulerFP : ruler ∈ Complexity.FP) + (hrulerLength : ∀ word, + (target word).length ≤ (ruler word).length) + (hcanonical : ∀ word, + BinaryRippleSub.trimHighZeros (target word) = target word) : + target ∈ Complexity.FP := by + let query := MachineRAMBridge.languageFlag (outputBitLanguage target) + have hqueryFP : query ∈ Complexity.FP := + MachineRAMBridge.languageFlag_mem_FP_of_paddedRamProgram + scratchRegisters program p hdecides + have hassembly : machineAssembleCanonicalBits query ruler ∈ Complexity.FP := + machineAssembleCanonicalBits_mem_FP hqueryFP hrulerFP + have heq : machineAssembleCanonicalBits query ruler = target := + machineAssembleCanonicalBits_realizes target ruler hrulerLength hcanonical + rwa [heq] at hassembly + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineUnaryGridGenerator.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineUnaryGridGenerator.lean new file mode 100644 index 0000000000..ddea664aa3 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineUnaryGridGenerator.lean @@ -0,0 +1,1277 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineDirectedNegativeObjectiveSum +import LeanPool.BeyondBethe.BeyondBethe.MachineListReverse + +/-! +# A reusable finite-word generator for square rational grids + +Given a unary dimension `m`, an explicit accumulator bound, and an immutable +payload, this machine visits the pairs `(0,0),...,(m-1,m-1)` in row-major +order. A supplied entry machine receives `pair row (pair column payload)`. +Its output is prepended to an encoded-list accumulator. The explicit `take` +is part of the total machine; clients prove separately that their chosen bound +never truncates a canonical run. + +The generator is intentionally independent of the Bethe formulas. It will be +used both for the nonlinear affine-gradient vector and for complete floor-cut +vectors, avoiding two unrelated implementations of the same grid traversal. +-/ + +namespace BeyondBethe + +open Complexity + +def machineUnaryGridGeneratorDimension (word : List Bool) : List Bool := + machinePairFirst word + +def machineUnaryGridGeneratorRest (word : List Bool) : List Bool := + machinePairSecond word + +def machineUnaryGridGeneratorInputBound (word : List Bool) : List Bool := + machinePairFirst (machineUnaryGridGeneratorRest word) + +def machineUnaryGridGeneratorInputPayload (word : List Bool) : List Bool := + machinePairSecond (machineUnaryGridGeneratorRest word) + +def machineUnaryGridGeneratorPack + (row column accumulator bound done payload : List Bool) : List Bool := + pair row (pair column + (pair accumulator (pair bound (pair done payload)))) + +def machineUnaryGridGeneratorRow (state : List Bool) : List Bool := + machinePairFirst state + +def machineUnaryGridGeneratorColumn (state : List Bool) : List Bool := + machinePairFirst (machinePairSecond state) + +def machineUnaryGridGeneratorAccumulator + (state : List Bool) : List Bool := + machinePairFirst (machinePairSecond (machinePairSecond state)) + +def machineUnaryGridGeneratorBound (state : List Bool) : List Bool := + machinePairFirst + (machinePairSecond (machinePairSecond (machinePairSecond state))) + +def machineUnaryGridGeneratorDone (state : List Bool) : List Bool := + machinePairFirst (machinePairSecond + (machinePairSecond (machinePairSecond (machinePairSecond state)))) + +def machineUnaryGridGeneratorPayload (state : List Bool) : List Bool := + machinePairSecond (machinePairSecond + (machinePairSecond (machinePairSecond (machinePairSecond state)))) + +@[simp] theorem machineUnaryGridGeneratorRow_pack + (row column accumulator bound done payload : List Bool) : + machineUnaryGridGeneratorRow + (machineUnaryGridGeneratorPack row column accumulator bound done payload) = row := by + simp [machineUnaryGridGeneratorRow, machineUnaryGridGeneratorPack] + +@[simp] theorem machineUnaryGridGeneratorColumn_pack + (row column accumulator bound done payload : List Bool) : + machineUnaryGridGeneratorColumn + (machineUnaryGridGeneratorPack row column accumulator bound done payload) = column := by + simp [machineUnaryGridGeneratorColumn, machineUnaryGridGeneratorPack] + +@[simp] theorem machineUnaryGridGeneratorAccumulator_pack + (row column accumulator bound done payload : List Bool) : + machineUnaryGridGeneratorAccumulator + (machineUnaryGridGeneratorPack row column accumulator bound done payload) = accumulator := by + simp [machineUnaryGridGeneratorAccumulator, machineUnaryGridGeneratorPack] + +@[simp] theorem machineUnaryGridGeneratorBound_pack + (row column accumulator bound done payload : List Bool) : + machineUnaryGridGeneratorBound + (machineUnaryGridGeneratorPack row column accumulator bound done payload) = bound := by + simp [machineUnaryGridGeneratorBound, machineUnaryGridGeneratorPack] + +@[simp] theorem machineUnaryGridGeneratorDone_pack + (row column accumulator bound done payload : List Bool) : + machineUnaryGridGeneratorDone + (machineUnaryGridGeneratorPack row column accumulator bound done payload) = done := by + simp [machineUnaryGridGeneratorDone, machineUnaryGridGeneratorPack] + +@[simp] theorem machineUnaryGridGeneratorPayload_pack + (row column accumulator bound done payload : List Bool) : + machineUnaryGridGeneratorPayload + (machineUnaryGridGeneratorPack row column accumulator bound done payload) = payload := by + simp [machineUnaryGridGeneratorPayload, machineUnaryGridGeneratorPack] + +def machineUnaryGridGeneratorStateDimension + (state : List Bool) : List Bool := + machineUnaryGridGeneratorDimension + (machineUnaryGridGeneratorPayload state) + +def machineUnaryGridGeneratorEntryInput + (state : List Bool) : List Bool := + pair (machineUnaryGridGeneratorRow state) + (pair (machineUnaryGridGeneratorColumn state) + (machineUnaryGridGeneratorInputPayload + (machineUnaryGridGeneratorPayload state))) + +def machineUnaryGridGeneratorNextRow (state : List Bool) : List Bool := + (machineUnaryGridGeneratorRow state ++ [true]).take + (machineUnaryGridGeneratorPayload state).length + +def machineUnaryGridGeneratorNextColumn (state : List Bool) : List Bool := + (machineUnaryGridGeneratorColumn state ++ [true]).take + (machineUnaryGridGeneratorPayload state).length + +def machineUnaryGridGeneratorColumnCompletesBit + (state : List Bool) : List Bool := + machineHeadBit (machineUnaryRulersEqualBit + (machineUnaryGridGeneratorNextColumn state) + (machineUnaryGridGeneratorStateDimension state)) + +def machineUnaryGridGeneratorRowCompletesBit + (state : List Bool) : List Bool := + machineHeadBit (machineUnaryRulersEqualBit + (machineUnaryGridGeneratorNextRow state) + (machineUnaryGridGeneratorStateDimension state)) + +def machineUnaryGridGeneratorCandidate + (entry : List Bool → List Bool) (state : List Bool) : List Bool := + pair (entry (machineUnaryGridGeneratorEntryInput state)) + (machineUnaryGridGeneratorAccumulator state) + +def machineUnaryGridGeneratorNextAccumulator + (entry : List Bool → List Bool) (state : List Bool) : List Bool := + (machineUnaryGridGeneratorCandidate entry state).take + (machineUnaryGridGeneratorBound state).length + +def machineUnaryGridGeneratorFinish + (entry : List Bool → List Bool) (state : List Bool) : List Bool := + machineUnaryGridGeneratorPack + (machineUnaryGridGeneratorRow state) + (machineUnaryGridGeneratorColumn state) + (machineUnaryGridGeneratorNextAccumulator entry state) + (machineUnaryGridGeneratorBound state) [true] + (machineUnaryGridGeneratorPayload state) + +def machineUnaryGridGeneratorAdvanceRow + (entry : List Bool → List Bool) (state : List Bool) : List Bool := + machineUnaryGridGeneratorPack + (machineUnaryGridGeneratorNextRow state) [] + (machineUnaryGridGeneratorNextAccumulator entry state) + (machineUnaryGridGeneratorBound state) + (machineUnaryGridGeneratorDone state) + (machineUnaryGridGeneratorPayload state) + +def machineUnaryGridGeneratorAdvanceColumn + (entry : List Bool → List Bool) (state : List Bool) : List Bool := + machineUnaryGridGeneratorPack + (machineUnaryGridGeneratorRow state) + (machineUnaryGridGeneratorNextColumn state) + (machineUnaryGridGeneratorNextAccumulator entry state) + (machineUnaryGridGeneratorBound state) + (machineUnaryGridGeneratorDone state) + (machineUnaryGridGeneratorPayload state) + +def machineUnaryGridGeneratorProcess + (entry : List Bool → List Bool) (state : List Bool) : List Bool := + machineIfHead (machineUnaryGridGeneratorColumnCompletesBit state) + (machineIfHead (machineUnaryGridGeneratorRowCompletesBit state) + (machineUnaryGridGeneratorFinish entry state) + (machineUnaryGridGeneratorAdvanceRow entry state)) + (machineUnaryGridGeneratorAdvanceColumn entry state) + +def machineUnaryGridGeneratorStep + (entry : List Bool → List Bool) (state : List Bool) : List Bool := + machineIfHead (machineHeadBit (machineUnaryGridGeneratorDone state)) state + (machineUnaryGridGeneratorProcess entry state) + +def machineUnaryGridGeneratorInit (word : List Bool) : List Bool := + machineUnaryGridGeneratorPack [] [] [] + (machineUnaryGridGeneratorInputBound word) [false] word + +def machineUnaryGridGeneratorDimensionBits + (word : List Bool) : List Bool := + machineLengthBits (machineUnaryGridGeneratorDimension word) + +def machineUnaryGridGeneratorWorkBits (word : List Bool) : List Bool := + machineBinaryMulBits + (pair (machineUnaryGridGeneratorDimensionBits word) + (machineUnaryGridGeneratorDimensionBits word)) + +def machineUnaryGridGeneratorGuard (word : List Bool) : List Bool := + machineBinaryMulWidth word + +def machineUnaryGridGeneratorRuler (word : List Bool) : List Bool := + machineBoundedUnary + (pair (machineUnaryGridGeneratorGuard word) + (machineUnaryGridGeneratorWorkBits word)) + +def machineUnaryGridGeneratorEnvelope (word : List Bool) : List Bool := + machineIteratedBinaryWidth 2 (word ++ List.replicate 16 false) + +def machineUnaryGridGeneratorWidth (word : List Bool) : List Bool := + let envelope := machineUnaryGridGeneratorEnvelope word + machineUnaryGridGeneratorPack envelope envelope envelope envelope + envelope envelope + +def machineUnaryGridGeneratorFinalState + (entry : List Bool → List Bool) (word : List Bool) : List Bool := + (machineUnaryGridGeneratorStep entry)^[(machineUnaryGridGeneratorRuler word).length] + (machineUnaryGridGeneratorInit word) + +def machineUnaryGridGeneratorReversedCode + (entry : List Bool → List Bool) (word : List Bool) : List Bool := + machineUnaryGridGeneratorAccumulator + (machineUnaryGridGeneratorFinalState entry word) + +def machineUnaryGridGeneratorCode + (entry : List Bool → List Bool) (word : List Bool) : List Bool := + machineListReverse (machineUnaryGridGeneratorReversedCode entry word) + +/-! ## Polynomial-time closure -/ + +theorem machineUnaryGridGeneratorDimension_mem_FP : + machineUnaryGridGeneratorDimension ∈ FP := machinePairFirst_mem_FP + +theorem machineUnaryGridGeneratorRest_mem_FP : + machineUnaryGridGeneratorRest ∈ FP := machinePairSecond_mem_FP + +theorem machineUnaryGridGeneratorInputBound_mem_FP : + machineUnaryGridGeneratorInputBound ∈ FP := by + simpa only [machineUnaryGridGeneratorInputBound] using + machineCompose_mem_FP machineUnaryGridGeneratorRest_mem_FP + machinePairFirst_mem_FP + +theorem machineUnaryGridGeneratorInputPayload_mem_FP : + machineUnaryGridGeneratorInputPayload ∈ FP := by + simpa only [machineUnaryGridGeneratorInputPayload] using + machineCompose_mem_FP machineUnaryGridGeneratorRest_mem_FP + machinePairSecond_mem_FP + +theorem machineUnaryGridGeneratorRow_mem_FP : + machineUnaryGridGeneratorRow ∈ FP := machinePairFirst_mem_FP + +theorem machineUnaryGridGeneratorColumn_mem_FP : + machineUnaryGridGeneratorColumn ∈ FP := by + simpa only [machineUnaryGridGeneratorColumn] using + machineCompose_mem_FP machinePairSecond_mem_FP machinePairFirst_mem_FP + +theorem machineUnaryGridGeneratorAccumulator_mem_FP : + machineUnaryGridGeneratorAccumulator ∈ FP := by + have htail := machineCompose_mem_FP machinePairSecond_mem_FP + machinePairSecond_mem_FP + simpa only [machineUnaryGridGeneratorAccumulator] using + machineCompose_mem_FP htail machinePairFirst_mem_FP + +theorem machineUnaryGridGeneratorBound_mem_FP : + machineUnaryGridGeneratorBound ∈ FP := by + have htailTwo := machineCompose_mem_FP machinePairSecond_mem_FP + machinePairSecond_mem_FP + have htailThree := machineCompose_mem_FP htailTwo machinePairSecond_mem_FP + simpa only [machineUnaryGridGeneratorBound] using + machineCompose_mem_FP htailThree machinePairFirst_mem_FP + +theorem machineUnaryGridGeneratorDone_mem_FP : + machineUnaryGridGeneratorDone ∈ FP := by + have htailTwo := machineCompose_mem_FP machinePairSecond_mem_FP + machinePairSecond_mem_FP + have htailThree := machineCompose_mem_FP htailTwo machinePairSecond_mem_FP + have htailFour := machineCompose_mem_FP htailThree machinePairSecond_mem_FP + simpa only [machineUnaryGridGeneratorDone] using + machineCompose_mem_FP htailFour machinePairFirst_mem_FP + +theorem machineUnaryGridGeneratorPayload_mem_FP : + machineUnaryGridGeneratorPayload ∈ FP := by + have htailTwo := machineCompose_mem_FP machinePairSecond_mem_FP + machinePairSecond_mem_FP + have htailThree := machineCompose_mem_FP htailTwo machinePairSecond_mem_FP + have htailFour := machineCompose_mem_FP htailThree machinePairSecond_mem_FP + simpa only [machineUnaryGridGeneratorPayload] using + machineCompose_mem_FP htailFour machinePairSecond_mem_FP + +theorem machineUnaryGridGeneratorStateDimension_mem_FP : + machineUnaryGridGeneratorStateDimension ∈ FP := by + simpa only [machineUnaryGridGeneratorStateDimension] using + machineCompose_mem_FP machineUnaryGridGeneratorPayload_mem_FP + machineUnaryGridGeneratorDimension_mem_FP + +theorem machineUnaryGridGeneratorEntryInput_mem_FP : + machineUnaryGridGeneratorEntryInput ∈ FP := by + have hpayload := machineCompose_mem_FP + machineUnaryGridGeneratorPayload_mem_FP + machineUnaryGridGeneratorInputPayload_mem_FP + exact machinePair_mem_FP machineUnaryGridGeneratorRow_mem_FP + (machinePair_mem_FP machineUnaryGridGeneratorColumn_mem_FP hpayload) + +theorem machineUnaryGridGeneratorNextRow_mem_FP : + machineUnaryGridGeneratorNextRow ∈ FP := by + have happend := machineAppend_mem_FP machineUnaryGridGeneratorRow_mem_FP + (machineConst_mem_FP [true]) + simpa only [machineUnaryGridGeneratorNextRow] using + machineTake_mem_FP machineUnaryGridGeneratorPayload_mem_FP happend + +theorem machineUnaryGridGeneratorNextColumn_mem_FP : + machineUnaryGridGeneratorNextColumn ∈ FP := by + have happend := machineAppend_mem_FP machineUnaryGridGeneratorColumn_mem_FP + (machineConst_mem_FP [true]) + simpa only [machineUnaryGridGeneratorNextColumn] using + machineTake_mem_FP machineUnaryGridGeneratorPayload_mem_FP happend + +theorem machineUnaryGridGeneratorColumnCompletesBit_mem_FP : + machineUnaryGridGeneratorColumnCompletesBit ∈ FP := by + have heq := machineUnaryRulersEqualBit_mem_FP + machineUnaryGridGeneratorNextColumn_mem_FP + machineUnaryGridGeneratorStateDimension_mem_FP + simpa only [machineUnaryGridGeneratorColumnCompletesBit] using + machineCompose_mem_FP heq machineHeadBit_mem_FP + +theorem machineUnaryGridGeneratorRowCompletesBit_mem_FP : + machineUnaryGridGeneratorRowCompletesBit ∈ FP := by + have heq := machineUnaryRulersEqualBit_mem_FP + machineUnaryGridGeneratorNextRow_mem_FP + machineUnaryGridGeneratorStateDimension_mem_FP + simpa only [machineUnaryGridGeneratorRowCompletesBit] using + machineCompose_mem_FP heq machineHeadBit_mem_FP + +theorem machineUnaryGridGeneratorCandidate_mem_FP + {entry : List Bool → List Bool} (hentry : entry ∈ FP) : + machineUnaryGridGeneratorCandidate entry ∈ FP := by + have hcurrent := machineCompose_mem_FP + machineUnaryGridGeneratorEntryInput_mem_FP hentry + exact machinePair_mem_FP hcurrent + machineUnaryGridGeneratorAccumulator_mem_FP + +theorem machineUnaryGridGeneratorNextAccumulator_mem_FP + {entry : List Bool → List Bool} (hentry : entry ∈ FP) : + machineUnaryGridGeneratorNextAccumulator entry ∈ FP := by + simpa only [machineUnaryGridGeneratorNextAccumulator] using + machineTake_mem_FP machineUnaryGridGeneratorBound_mem_FP + (machineUnaryGridGeneratorCandidate_mem_FP hentry) + +theorem machineUnaryGridGeneratorFinish_mem_FP + {entry : List Bool → List Bool} (hentry : entry ∈ FP) : + machineUnaryGridGeneratorFinish entry ∈ FP := + machinePair_mem_FP machineUnaryGridGeneratorRow_mem_FP + (machinePair_mem_FP machineUnaryGridGeneratorColumn_mem_FP + (machinePair_mem_FP + (machineUnaryGridGeneratorNextAccumulator_mem_FP hentry) + (machinePair_mem_FP machineUnaryGridGeneratorBound_mem_FP + (machinePair_mem_FP (machineConst_mem_FP [true]) + machineUnaryGridGeneratorPayload_mem_FP)))) + +theorem machineUnaryGridGeneratorAdvanceRow_mem_FP + {entry : List Bool → List Bool} (hentry : entry ∈ FP) : + machineUnaryGridGeneratorAdvanceRow entry ∈ FP := + machinePair_mem_FP machineUnaryGridGeneratorNextRow_mem_FP + (machinePair_mem_FP (machineConst_mem_FP []) + (machinePair_mem_FP + (machineUnaryGridGeneratorNextAccumulator_mem_FP hentry) + (machinePair_mem_FP machineUnaryGridGeneratorBound_mem_FP + (machinePair_mem_FP machineUnaryGridGeneratorDone_mem_FP + machineUnaryGridGeneratorPayload_mem_FP)))) + +theorem machineUnaryGridGeneratorAdvanceColumn_mem_FP + {entry : List Bool → List Bool} (hentry : entry ∈ FP) : + machineUnaryGridGeneratorAdvanceColumn entry ∈ FP := + machinePair_mem_FP machineUnaryGridGeneratorRow_mem_FP + (machinePair_mem_FP machineUnaryGridGeneratorNextColumn_mem_FP + (machinePair_mem_FP + (machineUnaryGridGeneratorNextAccumulator_mem_FP hentry) + (machinePair_mem_FP machineUnaryGridGeneratorBound_mem_FP + (machinePair_mem_FP machineUnaryGridGeneratorDone_mem_FP + machineUnaryGridGeneratorPayload_mem_FP)))) + +theorem machineUnaryGridGeneratorProcess_mem_FP + {entry : List Bool → List Bool} (hentry : entry ∈ FP) : + machineUnaryGridGeneratorProcess entry ∈ FP := by + have hlast := machineIfHead_mem_FP + machineUnaryGridGeneratorRowCompletesBit_mem_FP + (machineUnaryGridGeneratorFinish_mem_FP hentry) + (machineUnaryGridGeneratorAdvanceRow_mem_FP hentry) + exact machineIfHead_mem_FP + machineUnaryGridGeneratorColumnCompletesBit_mem_FP hlast + (machineUnaryGridGeneratorAdvanceColumn_mem_FP hentry) + +theorem machineUnaryGridGeneratorStep_mem_FP + {entry : List Bool → List Bool} (hentry : entry ∈ FP) : + machineUnaryGridGeneratorStep entry ∈ FP := by + have hdone := machineCompose_mem_FP machineUnaryGridGeneratorDone_mem_FP + machineHeadBit_mem_FP + exact machineIfHead_mem_FP hdone id_mem_FP + (machineUnaryGridGeneratorProcess_mem_FP hentry) + +theorem machineUnaryGridGeneratorInit_mem_FP : + machineUnaryGridGeneratorInit ∈ FP := + machinePair_mem_FP (machineConst_mem_FP []) + (machinePair_mem_FP (machineConst_mem_FP []) + (machinePair_mem_FP (machineConst_mem_FP []) + (machinePair_mem_FP machineUnaryGridGeneratorInputBound_mem_FP + (machinePair_mem_FP (machineConst_mem_FP [false]) id_mem_FP)))) + +theorem machineUnaryGridGeneratorDimensionBits_mem_FP : + machineUnaryGridGeneratorDimensionBits ∈ FP := by + simpa only [machineUnaryGridGeneratorDimensionBits] using + machineCompose_mem_FP machineUnaryGridGeneratorDimension_mem_FP + machineLengthBits_mem_FP + +theorem machineUnaryGridGeneratorWorkBits_mem_FP : + machineUnaryGridGeneratorWorkBits ∈ FP := by + have hinput := machinePair_mem_FP + machineUnaryGridGeneratorDimensionBits_mem_FP + machineUnaryGridGeneratorDimensionBits_mem_FP + simpa only [machineUnaryGridGeneratorWorkBits] using + machineCompose_mem_FP hinput machineBinaryMulBits_mem_FP + +theorem machineUnaryGridGeneratorGuard_mem_FP : + machineUnaryGridGeneratorGuard ∈ FP := machineBinaryMulWidth_mem_FP + +theorem machineUnaryGridGeneratorRuler_mem_FP : + machineUnaryGridGeneratorRuler ∈ FP := by + have hinput := machinePair_mem_FP machineUnaryGridGeneratorGuard_mem_FP + machineUnaryGridGeneratorWorkBits_mem_FP + simpa only [machineUnaryGridGeneratorRuler] using + machineCompose_mem_FP hinput machineBoundedUnary_mem_FP + +theorem machineUnaryGridGeneratorEnvelope_mem_FP : + machineUnaryGridGeneratorEnvelope ∈ FP := by + have hpadded := machineAppend_mem_FP id_mem_FP + (machineConst_mem_FP (List.replicate 16 false)) + simpa only [machineUnaryGridGeneratorEnvelope] using + machineCompose_mem_FP hpadded (machineIteratedBinaryWidth_mem_FP 2) + +theorem machineUnaryGridGeneratorWidth_mem_FP : + machineUnaryGridGeneratorWidth ∈ FP := by + let h := machineUnaryGridGeneratorEnvelope_mem_FP + exact machinePair_mem_FP h + (machinePair_mem_FP h + (machinePair_mem_FP h + (machinePair_mem_FP h (machinePair_mem_FP h h)))) + +def MachineUnaryGridGeneratorStateBound + (word state : List Bool) : Prop := + state = machineUnaryGridGeneratorPack + (machineUnaryGridGeneratorRow state) + (machineUnaryGridGeneratorColumn state) + (machineUnaryGridGeneratorAccumulator state) + (machineUnaryGridGeneratorBound state) + (machineUnaryGridGeneratorDone state) + (machineUnaryGridGeneratorPayload state) ∧ + (machineUnaryGridGeneratorRow state).length ≤ word.length ∧ + (machineUnaryGridGeneratorColumn state).length ≤ word.length ∧ + (machineUnaryGridGeneratorAccumulator state).length ≤ + (machineUnaryGridGeneratorInputBound word).length ∧ + machineUnaryGridGeneratorBound state = + machineUnaryGridGeneratorInputBound word ∧ + (machineUnaryGridGeneratorDone state).length ≤ 1 ∧ + machineUnaryGridGeneratorPayload state = word + +theorem machineUnaryGridGeneratorInit_bound (word : List Bool) : + MachineUnaryGridGeneratorStateBound word + (machineUnaryGridGeneratorInit word) := by + simp [MachineUnaryGridGeneratorStateBound, + machineUnaryGridGeneratorInit] + +theorem machineUnaryGridGeneratorStep_bound + {entry : List Bool → List Bool} {word state : List Bool} + (hs : MachineUnaryGridGeneratorStateBound word state) : + MachineUnaryGridGeneratorStateBound word + (machineUnaryGridGeneratorStep entry state) := by + rcases hs with ⟨hdecomp, hrow, hcolumn, hacc, hbound, hdone, hpayload⟩ + have hnextAcc : + (machineUnaryGridGeneratorNextAccumulator entry state).length ≤ + (machineUnaryGridGeneratorInputBound word).length := by + rw [machineUnaryGridGeneratorNextAccumulator, hbound] + exact List.length_take_le _ _ + have hnextRow : (machineUnaryGridGeneratorNextRow state).length ≤ + word.length := by + rw [machineUnaryGridGeneratorNextRow, hpayload] + exact List.length_take_le _ _ + have hnextColumn : (machineUnaryGridGeneratorNextColumn state).length ≤ + word.length := by + rw [machineUnaryGridGeneratorNextColumn, hpayload] + exact List.length_take_le _ _ + have hfinish : MachineUnaryGridGeneratorStateBound word + (machineUnaryGridGeneratorFinish entry state) := by + simp only [MachineUnaryGridGeneratorStateBound, + machineUnaryGridGeneratorFinish, + machineUnaryGridGeneratorRow_pack, + machineUnaryGridGeneratorColumn_pack, + machineUnaryGridGeneratorAccumulator_pack, + machineUnaryGridGeneratorBound_pack, + machineUnaryGridGeneratorDone_pack, + machineUnaryGridGeneratorPayload_pack] + exact ⟨trivial, hrow, hcolumn, hnextAcc, hbound, by simp, hpayload⟩ + have hadvanceRow : MachineUnaryGridGeneratorStateBound word + (machineUnaryGridGeneratorAdvanceRow entry state) := by + simp only [MachineUnaryGridGeneratorStateBound, + machineUnaryGridGeneratorAdvanceRow, + machineUnaryGridGeneratorRow_pack, + machineUnaryGridGeneratorColumn_pack, + machineUnaryGridGeneratorAccumulator_pack, + machineUnaryGridGeneratorBound_pack, + machineUnaryGridGeneratorDone_pack, + machineUnaryGridGeneratorPayload_pack] + exact ⟨trivial, hnextRow, by simp, hnextAcc, hbound, hdone, hpayload⟩ + have hadvanceColumn : MachineUnaryGridGeneratorStateBound word + (machineUnaryGridGeneratorAdvanceColumn entry state) := by + simp only [MachineUnaryGridGeneratorStateBound, + machineUnaryGridGeneratorAdvanceColumn, + machineUnaryGridGeneratorRow_pack, + machineUnaryGridGeneratorColumn_pack, + machineUnaryGridGeneratorAccumulator_pack, + machineUnaryGridGeneratorBound_pack, + machineUnaryGridGeneratorDone_pack, + machineUnaryGridGeneratorPayload_pack] + exact ⟨trivial, hrow, hnextColumn, hnextAcc, hbound, hdone, hpayload⟩ + rw [machineUnaryGridGeneratorStep] + cases hdoneCode : machineUnaryGridGeneratorDone state with + | nil => + rw [machineHeadBit_nil, machineIfHead_false, + machineUnaryGridGeneratorProcess] + cases hcolumnCode : machineUnaryGridGeneratorColumnCompletesBit state with + | nil => + have hlen : + (machineUnaryGridGeneratorColumnCompletesBit state).length = 1 := by + simp [machineUnaryGridGeneratorColumnCompletesBit] + rw [hcolumnCode] at hlen + simp at hlen + | cons columnBit columnTail => + cases columnBit with + | false => + rw [machineIfHead_false] + exact hadvanceColumn + | true => + rw [machineIfHead_true] + cases hrowCode : machineUnaryGridGeneratorRowCompletesBit state with + | nil => + have hlen : + (machineUnaryGridGeneratorRowCompletesBit state).length = 1 := by + simp [machineUnaryGridGeneratorRowCompletesBit] + rw [hrowCode] at hlen + simp at hlen + | cons rowBit rowTail => + cases rowBit with + | false => + rw [machineIfHead_false] + exact hadvanceRow + | true => + rw [machineIfHead_true] + exact hfinish + | cons doneBit doneTail => + cases doneBit with + | false => + rw [machineHeadBit_cons, machineIfHead_false, + machineUnaryGridGeneratorProcess] + cases hcolumnCode : machineUnaryGridGeneratorColumnCompletesBit state with + | nil => + have hlen : + (machineUnaryGridGeneratorColumnCompletesBit state).length = 1 := by + simp [machineUnaryGridGeneratorColumnCompletesBit] + rw [hcolumnCode] at hlen + simp at hlen + | cons columnBit columnTail => + cases columnBit with + | false => + rw [machineIfHead_false] + exact hadvanceColumn + | true => + rw [machineIfHead_true] + cases hrowCode : machineUnaryGridGeneratorRowCompletesBit state with + | nil => + have hlen : + (machineUnaryGridGeneratorRowCompletesBit state).length = 1 := by + simp [machineUnaryGridGeneratorRowCompletesBit] + rw [hrowCode] at hlen + simp at hlen + | cons rowBit rowTail => + cases rowBit with + | false => + rw [machineIfHead_false] + exact hadvanceRow + | true => + rw [machineIfHead_true] + exact hfinish + | true => + rw [machineHeadBit_cons, machineIfHead_true] + exact ⟨hdecomp, hrow, hcolumn, hacc, hbound, hdone, hpayload⟩ + +theorem machineUnaryGridGeneratorIterate_bound + (entry : List Bool → List Bool) (word : List Bool) : ∀ k, + MachineUnaryGridGeneratorStateBound word + ((machineUnaryGridGeneratorStep entry)^[k] + (machineUnaryGridGeneratorInit word)) := by + intro k + induction k with + | zero => exact machineUnaryGridGeneratorInit_bound word + | succ k ih => + rw [Function.iterate_succ_apply'] + exact machineUnaryGridGeneratorStep_bound ih + +theorem machineUnaryGridGeneratorEnvelope_word_le (word : List Bool) : + word.length ≤ (machineUnaryGridGeneratorEnvelope word).length := by + rw [machineUnaryGridGeneratorEnvelope, + machineIteratedBinaryWidth_length] + have hpadded : word.length ≤ (word ++ List.replicate 16 false).length := by + simp + exact hpadded.trans (certificateExpGuardWidth_self_le 2 _) + +theorem machineUnaryGridGeneratorEnvelope_pos (word : List Bool) : + 1 ≤ (machineUnaryGridGeneratorEnvelope word).length := by + have hword := machineUnaryGridGeneratorEnvelope_word_le word + by_cases hnil : word = [] + · subst word + norm_num [machineUnaryGridGeneratorEnvelope, + machineIteratedBinaryWidth_length, certificateExpGuardWidth] + · have hpos : 0 < word.length := List.length_pos_of_ne_nil hnil + have : 1 ≤ word.length := by omega + omega + +theorem machineUnaryGridGeneratorInputBound_le_envelope (word : List Bool) : + (machineUnaryGridGeneratorInputBound word).length ≤ + (machineUnaryGridGeneratorEnvelope word).length := + (machinePairFirst_length_le (machineUnaryGridGeneratorRest word)).trans + ((machinePairSecond_length_le word).trans + (machineUnaryGridGeneratorEnvelope_word_le word)) + +theorem machineUnaryGridGeneratorIterate_length_le_width + (entry : List Bool → List Bool) (word : List Bool) (iterations : ℕ) + (_ : iterations ≤ (machineUnaryGridGeneratorRuler word).length) : + ((machineUnaryGridGeneratorStep entry)^[iterations] + (machineUnaryGridGeneratorInit word)).length ≤ + (machineUnaryGridGeneratorWidth word).length := by + rcases machineUnaryGridGeneratorIterate_bound entry word iterations with + ⟨hdecomp, hrow, hcolumn, hacc, hbound, hdone, hpayload⟩ + have hwe := machineUnaryGridGeneratorEnvelope_word_le word + have hbe := machineUnaryGridGeneratorInputBound_le_envelope word + have hepos := machineUnaryGridGeneratorEnvelope_pos word + rw [hdecomp, hbound, hpayload] + simp only [machineUnaryGridGeneratorPack, + machineUnaryGridGeneratorWidth, pair_length] + omega + +theorem machineUnaryGridGeneratorFinalState_mem_FP + {entry : List Bool → List Bool} (hentry : entry ∈ FP) : + machineUnaryGridGeneratorFinalState entry ∈ FP := by + exact Cobham.iterate_mem_FP + (machineUnaryGridGeneratorStep_mem_FP hentry) + machineUnaryGridGeneratorInit_mem_FP + machineUnaryGridGeneratorRuler_mem_FP + machineUnaryGridGeneratorWidth_mem_FP + (machineUnaryGridGeneratorIterate_length_le_width entry) + +theorem machineUnaryGridGeneratorReversedCode_mem_FP + {entry : List Bool → List Bool} (hentry : entry ∈ FP) : + machineUnaryGridGeneratorReversedCode entry ∈ FP := by + simpa only [machineUnaryGridGeneratorReversedCode] using + machineCompose_mem_FP + (machineUnaryGridGeneratorFinalState_mem_FP hentry) + machineUnaryGridGeneratorAccumulator_mem_FP + +theorem machineUnaryGridGeneratorCode_mem_FP + {entry : List Bool → List Bool} (hentry : entry ∈ FP) : + machineUnaryGridGeneratorCode entry ∈ FP := by + simpa only [machineUnaryGridGeneratorCode] using + machineCompose_mem_FP + (machineUnaryGridGeneratorReversedCode_mem_FP hentry) + machineListReverse_mem_FP + +/-! ## Canonical inputs and exact iteration ruler -/ + +def machineUnaryGridGeneratorCanonicalWord + (m : ℕ) (bound payload : List Bool) : List Bool := + pair (List.replicate m true) (pair bound payload) + +@[simp] theorem machineUnaryGridGeneratorDimension_encode + (m : ℕ) (bound payload : List Bool) : + machineUnaryGridGeneratorDimension + (machineUnaryGridGeneratorCanonicalWord m bound payload) = + List.replicate m true := by + simp [machineUnaryGridGeneratorDimension, + machineUnaryGridGeneratorCanonicalWord] + +@[simp] theorem machineUnaryGridGeneratorInputBound_encode + (m : ℕ) (bound payload : List Bool) : + machineUnaryGridGeneratorInputBound + (machineUnaryGridGeneratorCanonicalWord m bound payload) = bound := by + simp [machineUnaryGridGeneratorInputBound, + machineUnaryGridGeneratorRest, + machineUnaryGridGeneratorCanonicalWord] + +@[simp] theorem machineUnaryGridGeneratorInputPayload_encode + (m : ℕ) (bound payload : List Bool) : + machineUnaryGridGeneratorInputPayload + (machineUnaryGridGeneratorCanonicalWord m bound payload) = payload := by + simp [machineUnaryGridGeneratorInputPayload, + machineUnaryGridGeneratorRest, + machineUnaryGridGeneratorCanonicalWord] + +@[simp] theorem machineUnaryGridGeneratorWorkBits_encode + (m : ℕ) (bound payload : List Bool) : + machineUnaryGridGeneratorWorkBits + (machineUnaryGridGeneratorCanonicalWord m bound payload) = + (m * m).bits := by + rw [machineUnaryGridGeneratorWorkBits, + machineUnaryGridGeneratorDimensionBits, + machineUnaryGridGeneratorDimension_encode, + machineLengthBits_encode, List.length_replicate, + machineBinaryMulBits_pair_natBits] + +theorem machineUnaryGridGeneratorWork_le_guard + (m : ℕ) (bound payload : List Bool) : + m * m ≤ + (machineUnaryGridGeneratorGuard + (machineUnaryGridGeneratorCanonicalWord m bound payload)).length := by + have hm : m ≤ + (machineUnaryGridGeneratorCanonicalWord m bound payload).length := by + simp only [machineUnaryGridGeneratorCanonicalWord, pair_length, + List.length_replicate] + omega + simp only [machineUnaryGridGeneratorGuard, machineBinaryMulWidth, + List.length_replicate, List.length_append] + nlinarith + +@[simp] theorem machineUnaryGridGeneratorRuler_encode + (m : ℕ) (bound payload : List Bool) : + machineUnaryGridGeneratorRuler + (machineUnaryGridGeneratorCanonicalWord m bound payload) = + List.replicate (m * m) true := by + rw [machineUnaryGridGeneratorRuler, + machineUnaryGridGeneratorWorkBits_encode, + machineBoundedUnary_encode_of_le] + exact machineUnaryGridGeneratorWork_le_guard m bound payload + +/-! ## Typed row-major semantics -/ + +structure UnaryGridSemanticState (m : ℕ) where + row : Fin m + column : Fin m + accumulator : List ℚ + done : Bool + +def unaryGridSemanticInit {m : ℕ} (hm : 0 < m) : + UnaryGridSemanticState m where + row := ⟨0, hm⟩ + column := ⟨0, hm⟩ + accumulator := [] + done := false + +def unaryGridSemanticStep {m : ℕ} + (f : Fin m → Fin m → ℚ) (state : UnaryGridSemanticState m) : + UnaryGridSemanticState m := + if state.done then state + else + let nextAccumulator := f state.row state.column :: state.accumulator + if hcolumn : state.column.1 + 1 = m then + if hrow : state.row.1 + 1 = m then + { state with accumulator := nextAccumulator, done := true } + else + { state with + row := ⟨state.row.1 + 1, by omega⟩ + column := ⟨0, by omega⟩ + accumulator := nextAccumulator } + else + { state with + column := ⟨state.column.1 + 1, by omega⟩ + accumulator := nextAccumulator } + +def machineUnaryGridGeneratorSemanticCode {m : ℕ} + (bound payload : List Bool) (state : UnaryGridSemanticState m) : + List Bool := + machineUnaryGridGeneratorPack + (List.replicate state.row.1 true) + (List.replicate state.column.1 true) + (binaryListCode rationalEntryBinaryCode state.accumulator) + bound [state.done] + (machineUnaryGridGeneratorCanonicalWord m bound payload) + +@[simp] theorem machineUnaryGridGeneratorEntryInput_semanticCode {m : ℕ} + (bound payload : List Bool) (state : UnaryGridSemanticState m) : + machineUnaryGridGeneratorEntryInput + (machineUnaryGridGeneratorSemanticCode bound payload state) = + pair (List.replicate state.row.1 true) + (pair (List.replicate state.column.1 true) payload) := by + simp [machineUnaryGridGeneratorEntryInput, + machineUnaryGridGeneratorSemanticCode] + +@[simp] theorem machineUnaryGridGeneratorNextRow_semanticCode {m : ℕ} + (bound payload : List Bool) (state : UnaryGridSemanticState m) : + machineUnaryGridGeneratorNextRow + (machineUnaryGridGeneratorSemanticCode bound payload state) = + List.replicate (state.row.1 + 1) true := by + have hlength : state.row.1 + 1 ≤ + (machineUnaryGridGeneratorCanonicalWord m bound payload).length := by + have hrow : state.row.1 + 1 ≤ m := by omega + have hm : m ≤ + (machineUnaryGridGeneratorCanonicalWord m bound payload).length := by + simp only [machineUnaryGridGeneratorCanonicalWord, pair_length, + List.length_replicate] + omega + omega + rw [machineUnaryGridGeneratorNextRow] + simp only [machineUnaryGridGeneratorSemanticCode, + machineUnaryGridGeneratorRow_pack, + machineUnaryGridGeneratorPayload_pack] + have happend : List.replicate state.row.1 true ++ [true] = + List.replicate (state.row.1 + 1) true := by + rw [show ([true] : List Bool) = List.replicate 1 true by rfl, + List.replicate_append_replicate] + rw [happend, List.take_of_length_le (by simpa using hlength)] + +@[simp] theorem machineUnaryGridGeneratorNextColumn_semanticCode {m : ℕ} + (bound payload : List Bool) (state : UnaryGridSemanticState m) : + machineUnaryGridGeneratorNextColumn + (machineUnaryGridGeneratorSemanticCode bound payload state) = + List.replicate (state.column.1 + 1) true := by + have hlength : state.column.1 + 1 ≤ + (machineUnaryGridGeneratorCanonicalWord m bound payload).length := by + have hcolumn : state.column.1 + 1 ≤ m := by omega + have hm : m ≤ + (machineUnaryGridGeneratorCanonicalWord m bound payload).length := by + simp only [machineUnaryGridGeneratorCanonicalWord, pair_length, + List.length_replicate] + omega + omega + rw [machineUnaryGridGeneratorNextColumn] + simp only [machineUnaryGridGeneratorSemanticCode, + machineUnaryGridGeneratorColumn_pack, + machineUnaryGridGeneratorPayload_pack] + have happend : List.replicate state.column.1 true ++ [true] = + List.replicate (state.column.1 + 1) true := by + rw [show ([true] : List Bool) = List.replicate 1 true by rfl, + List.replicate_append_replicate] + rw [happend, List.take_of_length_le (by simpa using hlength)] + +@[simp] theorem machineUnaryGridGeneratorColumnCompletesBit_semanticCode + {m : ℕ} (bound payload : List Bool) + (state : UnaryGridSemanticState m) : + machineUnaryGridGeneratorColumnCompletesBit + (machineUnaryGridGeneratorSemanticCode bound payload state) = + [decide (state.column.1 + 1 = m)] := by + rw [machineUnaryGridGeneratorColumnCompletesBit, + machineUnaryGridGeneratorNextColumn_semanticCode, + machineUnaryGridGeneratorStateDimension] + simp only [machineUnaryGridGeneratorSemanticCode, + machineUnaryGridGeneratorPayload_pack, + machineUnaryGridGeneratorDimension_encode, + machineUnaryRulersEqualBit_replicate, machineHeadBit_cons] + +@[simp] theorem machineUnaryGridGeneratorRowCompletesBit_semanticCode + {m : ℕ} (bound payload : List Bool) + (state : UnaryGridSemanticState m) : + machineUnaryGridGeneratorRowCompletesBit + (machineUnaryGridGeneratorSemanticCode bound payload state) = + [decide (state.row.1 + 1 = m)] := by + rw [machineUnaryGridGeneratorRowCompletesBit, + machineUnaryGridGeneratorNextRow_semanticCode, + machineUnaryGridGeneratorStateDimension] + simp only [machineUnaryGridGeneratorSemanticCode, + machineUnaryGridGeneratorPayload_pack, + machineUnaryGridGeneratorDimension_encode, + machineUnaryRulersEqualBit_replicate, machineHeadBit_cons] + +theorem machineUnaryGridGeneratorStep_semanticCode {m : ℕ} + (entry : List Bool → List Bool) (f : Fin m → Fin m → ℚ) + (bound payload : List Bool) (state : UnaryGridSemanticState m) + (hentry : ∀ i j, + entry (pair (List.replicate i.1 true) + (pair (List.replicate j.1 true) payload)) = + rationalEntryBinaryCode (f i j)) + (hlarge : + (binaryListCode rationalEntryBinaryCode + (f state.row state.column :: state.accumulator)).length ≤ + bound.length) : + machineUnaryGridGeneratorStep entry + (machineUnaryGridGeneratorSemanticCode bound payload state) = + machineUnaryGridGeneratorSemanticCode bound payload + (unaryGridSemanticStep f state) := by + rcases state with ⟨row, column, accumulator, done⟩ + cases done + · have hcandidate : + machineUnaryGridGeneratorNextAccumulator entry + (machineUnaryGridGeneratorSemanticCode bound payload + ⟨row, column, accumulator, false⟩) = + binaryListCode rationalEntryBinaryCode + (f row column :: accumulator) := by + rw [machineUnaryGridGeneratorNextAccumulator, + machineUnaryGridGeneratorCandidate, + machineUnaryGridGeneratorEntryInput_semanticCode, + hentry] + simp only [machineUnaryGridGeneratorSemanticCode, + machineUnaryGridGeneratorAccumulator_pack, + machineUnaryGridGeneratorBound_pack, binaryListCode] + exact List.take_of_length_le hlarge + by_cases hcolumn : column.1 + 1 = m + · by_cases hrow : row.1 + 1 = m + · have hdoneFalse : + machineHeadBit (machineUnaryGridGeneratorDone + (machineUnaryGridGeneratorSemanticCode bound payload + ⟨row, column, accumulator, false⟩)) = [false] := by + simp [machineUnaryGridGeneratorSemanticCode] + rw [machineUnaryGridGeneratorStep, hdoneFalse, + machineIfHead_false, machineUnaryGridGeneratorProcess, + machineUnaryGridGeneratorColumnCompletesBit_semanticCode] + simp only [hcolumn, decide_true, machineIfHead_true] + rw [machineUnaryGridGeneratorRowCompletesBit_semanticCode] + simp only [hrow, decide_true, machineIfHead_true] + rw [machineUnaryGridGeneratorFinish, hcandidate] + simp [unaryGridSemanticStep, hcolumn, hrow, + machineUnaryGridGeneratorSemanticCode] + · have hdoneFalse : + machineHeadBit (machineUnaryGridGeneratorDone + (machineUnaryGridGeneratorSemanticCode bound payload + ⟨row, column, accumulator, false⟩)) = [false] := by + simp [machineUnaryGridGeneratorSemanticCode] + rw [machineUnaryGridGeneratorStep, hdoneFalse, + machineIfHead_false, machineUnaryGridGeneratorProcess, + machineUnaryGridGeneratorColumnCompletesBit_semanticCode] + simp only [hcolumn, decide_true, machineIfHead_true] + rw [machineUnaryGridGeneratorRowCompletesBit_semanticCode] + simp only [hrow, decide_false, machineIfHead_false] + rw [machineUnaryGridGeneratorAdvanceRow, + machineUnaryGridGeneratorNextRow_semanticCode, hcandidate] + simp [unaryGridSemanticStep, hcolumn, hrow, + machineUnaryGridGeneratorSemanticCode] + · have hdoneFalse : + machineHeadBit (machineUnaryGridGeneratorDone + (machineUnaryGridGeneratorSemanticCode bound payload + ⟨row, column, accumulator, false⟩)) = [false] := by + simp [machineUnaryGridGeneratorSemanticCode] + rw [machineUnaryGridGeneratorStep, hdoneFalse, + machineIfHead_false, machineUnaryGridGeneratorProcess, + machineUnaryGridGeneratorColumnCompletesBit_semanticCode] + simp only [hcolumn, decide_false, machineIfHead_false] + rw [machineUnaryGridGeneratorAdvanceColumn, + machineUnaryGridGeneratorNextColumn_semanticCode, hcandidate] + simp [unaryGridSemanticStep, hcolumn, + machineUnaryGridGeneratorSemanticCode] + · simp [machineUnaryGridGeneratorStep, unaryGridSemanticStep, + machineUnaryGridGeneratorSemanticCode] + +def unaryGridOrdinal {m : ℕ} (row column : Fin m) : ℕ := + row.1 * m + column.1 + +theorem unaryGridOrdinal_lt_square {m : ℕ} + (row column : Fin m) : unaryGridOrdinal row column < m * m := by + rw [unaryGridOrdinal] + nlinarith [row.isLt, column.isLt] + +theorem unaryGridOrdinal_injective (m : ℕ) : + Function.Injective + (fun ij : Fin m × Fin m => unaryGridOrdinal ij.1 ij.2) := by + intro a b hab + have hmod := congrArg (fun q : ℕ => q % m) hab + have hmpos : 0 < m := Nat.zero_lt_of_lt a.1.isLt + have hmodA : unaryGridOrdinal a.1 a.2 % m = a.2.1 := by + simp [unaryGridOrdinal, Nat.add_mod, Nat.mod_eq_of_lt a.2.isLt, + hmpos] + have hmodB : unaryGridOrdinal b.1 b.2 % m = b.2.1 := by + simp [unaryGridOrdinal, Nat.add_mod, Nat.mod_eq_of_lt b.2.isLt, + hmpos] + have hcolumn : a.2.1 = b.2.1 := by + calc + a.2.1 = unaryGridOrdinal a.1 a.2 % m := hmodA.symm + _ = unaryGridOrdinal b.1 b.2 % m := hmod + _ = b.2.1 := hmodB + have hrowMul : a.1.1 * m = b.1.1 * m := by + simp only [unaryGridOrdinal] at hab + rw [hcolumn] at hab + exact Nat.add_right_cancel hab + have hrow : a.1.1 = b.1.1 := + Nat.mul_right_cancel hmpos hrowMul + exact Prod.ext (Fin.ext hrow) (Fin.ext hcolumn) + +theorem unaryGridOrdinal_nextColumn {m : ℕ} + (row column : Fin m) (hcolumn : column.1 + 1 ≠ m) : + unaryGridOrdinal row + ⟨column.1 + 1, show column.1 + 1 < m by omega⟩ = + unaryGridOrdinal row column + 1 := by + rw [unaryGridOrdinal, unaryGridOrdinal] + change row.1 * m + (column.1 + 1) = + row.1 * m + column.1 + 1 + ring + +theorem unaryGridOrdinal_nextRow {m : ℕ} + (row column : Fin m) (hcolumn : column.1 + 1 = m) + (hrow : row.1 + 1 ≠ m) : + unaryGridOrdinal + ⟨row.1 + 1, show row.1 + 1 < m by omega⟩ + ⟨0, show 0 < m by omega⟩ = + unaryGridOrdinal row column + 1 := by + rw [unaryGridOrdinal, unaryGridOrdinal] + change (row.1 + 1) * m + 0 = row.1 * m + column.1 + 1 + calc + (row.1 + 1) * m + 0 = row.1 * m + m := by ring + _ = row.1 * m + column.1 + 1 := by omega + +theorem unaryGridOrdinal_last {m : ℕ} + (row column : Fin m) (hcolumn : column.1 + 1 = m) + (hrow : row.1 + 1 = m) : + unaryGridOrdinal row column + 1 = m * m := by + simp [unaryGridOrdinal] + nlinarith + +def unaryGridValues {m : ℕ} (f : Fin m → Fin m → ℚ) : List ℚ := + List.ofFn (fun k : Fin (m * m) => + f (finProdFinEquiv.symm k).1 (finProdFinEquiv.symm k).2) + +def unaryGridPrefix {m : ℕ} + (f : Fin m → Fin m → ℚ) (k : ℕ) : List ℚ := + (unaryGridValues f).take k + +@[simp] theorem unaryGridValues_length {m : ℕ} + (f : Fin m → Fin m → ℚ) : (unaryGridValues f).length = m * m := by + simp [unaryGridValues] + +theorem unaryGridPrefix_succ_of_ordinal {m k : ℕ} + (f : Fin m → Fin m → ℚ) (row column : Fin m) + (hordinal : unaryGridOrdinal row column = k) : + unaryGridPrefix f (k + 1) = + unaryGridPrefix f k ++ [f row column] := by + have hk : k < (unaryGridValues f).length := by + rw [unaryGridValues_length] + rw [← hordinal] + exact unaryGridOrdinal_lt_square row column + have hget : (unaryGridValues f)[k] = f row column := by + have hk' : k < m * m := by simpa using hk + let ij : Fin m × Fin m := (row, column) + have hfin : (⟨k, hk'⟩ : Fin (m * m)) = finProdFinEquiv ij := by + apply Fin.ext + change k = column.1 + m * row.1 + calc + k = row.1 * m + column.1 := hordinal.symm + _ = column.1 + m * row.1 := by ring + simp only [unaryGridValues, List.getElem_ofFn] + rw [hfin, Equiv.symm_apply_apply] + rw [unaryGridPrefix, unaryGridPrefix] + simpa only [List.concat_eq_append, hget] using + (List.take_concat_get hk).symm + +def UnaryGridValueInvariant {m : ℕ} + (f : Fin m → Fin m → ℚ) (k : ℕ) + (state : UnaryGridSemanticState m) : Prop := + (state.done = true ∧ m * m ≤ k ∧ + state.accumulator = (unaryGridValues f).reverse) ∨ + (state.done = false ∧ unaryGridOrdinal state.row state.column = k ∧ + state.accumulator = (unaryGridPrefix f k).reverse) + +theorem unaryGridSemanticInit_valueInvariant {m : ℕ} + (hm : 0 < m) (f : Fin m → Fin m → ℚ) : + UnaryGridValueInvariant f 0 (unaryGridSemanticInit hm) := by + right + simp [UnaryGridValueInvariant, unaryGridSemanticInit, + unaryGridOrdinal, unaryGridPrefix] + +theorem unaryGridSemanticStep_valueInvariant {m k : ℕ} + (f : Fin m → Fin m → ℚ) (state : UnaryGridSemanticState m) + (hinvariant : UnaryGridValueInvariant f k state) : + UnaryGridValueInvariant f (k + 1) (unaryGridSemanticStep f state) := by + rcases hinvariant with hdone | hactive + · rcases hdone with ⟨hdone, hwork, haccumulator⟩ + have hstep : unaryGridSemanticStep f state = state := by + simp [unaryGridSemanticStep, hdone] + rw [hstep] + left + exact ⟨hdone, hwork.trans (by omega), haccumulator⟩ + · rcases hactive with ⟨hdone, hordinal, haccumulator⟩ + have hprefix := unaryGridPrefix_succ_of_ordinal + f state.row state.column hordinal + have hnextAccumulator : + f state.row state.column :: state.accumulator = + (unaryGridPrefix f (k + 1)).reverse := by + rw [hprefix, List.reverse_append, haccumulator] + rfl + by_cases hcolumn : state.column.1 + 1 = m + · by_cases hrow : state.row.1 + 1 = m + · have hstep : unaryGridSemanticStep f state = + { state with + accumulator := f state.row state.column :: state.accumulator + done := true } := by + simp [unaryGridSemanticStep, hdone, hcolumn, hrow] + rw [hstep] + left + refine ⟨rfl, ?_, ?_⟩ + · have htotal : k + 1 = m * m := by + rw [← hordinal] + exact unaryGridOrdinal_last state.row state.column hcolumn hrow + omega + · rw [hnextAccumulator] + have htotal : k + 1 = m * m := by + rw [← hordinal] + exact unaryGridOrdinal_last state.row state.column hcolumn hrow + rw [htotal, unaryGridPrefix, + List.take_of_length_le (by simp)] + · have hstep : unaryGridSemanticStep f state = + { state with + row := ⟨state.row.1 + 1, by omega⟩ + column := ⟨0, by omega⟩ + accumulator := f state.row state.column :: state.accumulator } := by + simp [unaryGridSemanticStep, hdone, hcolumn, hrow] + rw [hstep] + right + refine ⟨hdone, ?_, hnextAccumulator⟩ + rw [unaryGridOrdinal_nextRow state.row state.column hcolumn hrow, + hordinal] + · have hstep : unaryGridSemanticStep f state = + { state with + column := ⟨state.column.1 + 1, by omega⟩ + accumulator := f state.row state.column :: state.accumulator } := by + simp [unaryGridSemanticStep, hdone, hcolumn] + rw [hstep] + right + refine ⟨hdone, ?_, hnextAccumulator⟩ + rw [unaryGridOrdinal_nextColumn state.row state.column hcolumn, + hordinal] + +def unaryGridSemanticStateAt {m : ℕ} (hm : 0 < m) + (f : Fin m → Fin m → ℚ) (k : ℕ) : UnaryGridSemanticState m := + (unaryGridSemanticStep f)^[k] (unaryGridSemanticInit hm) + +theorem unaryGridSemanticStateAt_valueInvariant {m : ℕ} + (hm : 0 < m) (f : Fin m → Fin m → ℚ) : ∀ k, + UnaryGridValueInvariant f k (unaryGridSemanticStateAt hm f k) := by + intro k + induction k with + | zero => exact unaryGridSemanticInit_valueInvariant hm f + | succ k ih => + rw [unaryGridSemanticStateAt, Function.iterate_succ_apply'] + exact unaryGridSemanticStep_valueInvariant f _ ih + +theorem unaryGridSemanticStateAt_full_accumulator {m : ℕ} + (hm : 0 < m) (f : Fin m → Fin m → ℚ) : + (unaryGridSemanticStateAt hm f (m * m)).accumulator = + (unaryGridValues f).reverse := by + have hinvariant := unaryGridSemanticStateAt_valueInvariant hm f (m * m) + rcases hinvariant with hdone | hactive + · exact hdone.2.2 + · have hord := hactive.2.1 + have hlt := unaryGridOrdinal_lt_square + (unaryGridSemanticStateAt hm f (m * m)).row + (unaryGridSemanticStateAt hm f (m * m)).column + omega + +theorem unaryGridSemanticStateAt_active {m k : ℕ} + (hm : 0 < m) (f : Fin m → Fin m → ℚ) (hk : k < m * m) : + (unaryGridSemanticStateAt hm f k).done = false ∧ + unaryGridOrdinal (unaryGridSemanticStateAt hm f k).row + (unaryGridSemanticStateAt hm f k).column = k ∧ + (unaryGridSemanticStateAt hm f k).accumulator = + (unaryGridPrefix f k).reverse := by + have hinvariant := unaryGridSemanticStateAt_valueInvariant hm f k + rcases hinvariant with hdone | hactive + · omega + · exact hactive + +theorem machineUnaryGridGeneratorInit_semanticCode {m : ℕ} + (hm : 0 < m) (f : Fin m → Fin m → ℚ) + (bound payload : List Bool) : + machineUnaryGridGeneratorInit + (machineUnaryGridGeneratorCanonicalWord m bound payload) = + machineUnaryGridGeneratorSemanticCode bound payload + (unaryGridSemanticInit hm) := by + rw [machineUnaryGridGeneratorInit, + machineUnaryGridGeneratorInputBound_encode] + simp [ + machineUnaryGridGeneratorSemanticCode, unaryGridSemanticInit, + machineUnaryGridGeneratorCanonicalWord, binaryListCode] + +theorem unaryGridSemanticStateAt_candidate_eq_prefix {m k : ℕ} + (hm : 0 < m) (f : Fin m → Fin m → ℚ) (hk : k < m * m) : + f (unaryGridSemanticStateAt hm f k).row + (unaryGridSemanticStateAt hm f k).column :: + (unaryGridSemanticStateAt hm f k).accumulator = + (unaryGridPrefix f (k + 1)).reverse := by + have hactive := unaryGridSemanticStateAt_active hm f hk + have hprefix := unaryGridPrefix_succ_of_ordinal f + (unaryGridSemanticStateAt hm f k).row + (unaryGridSemanticStateAt hm f k).column hactive.2.1 + rw [hactive.2.2, hprefix, List.reverse_append] + rfl + +theorem machineUnaryGridGeneratorIterate_semanticCode {m : ℕ} + (hm : 0 < m) (entry : List Bool → List Bool) + (f : Fin m → Fin m → ℚ) (bound payload : List Bool) + (hentry : ∀ i j, + entry (pair (List.replicate i.1 true) + (pair (List.replicate j.1 true) payload)) = + rationalEntryBinaryCode (f i j)) + (hbound : + (binaryListCode rationalEntryBinaryCode (unaryGridValues f)).length ≤ + bound.length) : + ∀ k, k ≤ m * m → + (machineUnaryGridGeneratorStep entry)^[k] + (machineUnaryGridGeneratorInit + (machineUnaryGridGeneratorCanonicalWord m bound payload)) = + machineUnaryGridGeneratorSemanticCode bound payload + (unaryGridSemanticStateAt hm f k) := by + intro k hk + induction k with + | zero => exact machineUnaryGridGeneratorInit_semanticCode hm f bound payload + | succ k ih => + have hklt : k < m * m := by omega + rw [Function.iterate_succ_apply', ih (by omega)] + have hlarge : + (binaryListCode rationalEntryBinaryCode + (f (unaryGridSemanticStateAt hm f k).row + (unaryGridSemanticStateAt hm f k).column :: + (unaryGridSemanticStateAt hm f k).accumulator)).length ≤ + bound.length := by + rw [unaryGridSemanticStateAt_candidate_eq_prefix hm f hklt] + have hprefixBound := binaryListCode_take_reverse_length_le + rationalEntryBinaryCode (unaryGridValues f) (k + 1) + simpa only [unaryGridPrefix] using hprefixBound.trans hbound + have hstep := machineUnaryGridGeneratorStep_semanticCode entry f + bound payload (unaryGridSemanticStateAt hm f k) hentry hlarge + simpa only [unaryGridSemanticStateAt, + Function.iterate_succ_apply'] using hstep + +theorem machineUnaryGridGeneratorReversedCode_encode_of_bound {m : ℕ} + (entry : List Bool → List Bool) (f : Fin m → Fin m → ℚ) + (bound payload : List Bool) + (hentry : ∀ i j, + entry (pair (List.replicate i.1 true) + (pair (List.replicate j.1 true) payload)) = + rationalEntryBinaryCode (f i j)) + (hbound : + (binaryListCode rationalEntryBinaryCode (unaryGridValues f)).length ≤ + bound.length) : + machineUnaryGridGeneratorReversedCode entry + (machineUnaryGridGeneratorCanonicalWord m bound payload) = + binaryListCode rationalEntryBinaryCode (unaryGridValues f).reverse := by + cases m with + | zero => + rw [machineUnaryGridGeneratorReversedCode, + machineUnaryGridGeneratorFinalState, + machineUnaryGridGeneratorRuler_encode] + simp [ + machineUnaryGridGeneratorInit, + machineUnaryGridGeneratorCanonicalWord, + unaryGridValues, binaryListCode] + | succ m => + have hm : 0 < m + 1 := by omega + rw [machineUnaryGridGeneratorReversedCode, + machineUnaryGridGeneratorFinalState, + machineUnaryGridGeneratorRuler_encode, List.length_replicate, + machineUnaryGridGeneratorIterate_semanticCode hm entry f bound payload + hentry hbound ((m + 1) * (m + 1)) le_rfl] + simp only [machineUnaryGridGeneratorSemanticCode, + machineUnaryGridGeneratorAccumulator_pack] + rw [unaryGridSemanticStateAt_full_accumulator hm f] + +theorem machineUnaryGridGeneratorCode_encode_of_bound {m : ℕ} + (entry : List Bool → List Bool) (f : Fin m → Fin m → ℚ) + (bound payload : List Bool) + (hentry : ∀ i j, + entry (pair (List.replicate i.1 true) + (pair (List.replicate j.1 true) payload)) = + rationalEntryBinaryCode (f i j)) + (hbound : + (binaryListCode rationalEntryBinaryCode (unaryGridValues f)).length ≤ + bound.length) : + machineUnaryGridGeneratorCode entry + (machineUnaryGridGeneratorCanonicalWord m bound payload) = + binaryListCode rationalEntryBinaryCode (unaryGridValues f) := by + rw [machineUnaryGridGeneratorCode, + machineUnaryGridGeneratorReversedCode_encode_of_bound + entry f bound payload hentry hbound, + machineListReverse_encode, List.reverse_reverse] + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineUnaryMatrixGenerator.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineUnaryMatrixGenerator.lean new file mode 100644 index 0000000000..5a5fc337f4 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineUnaryMatrixGenerator.lean @@ -0,0 +1,1269 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineUnaryGridGenerator + +/-! +# A reusable finite-word generator for square rational matrices + +This is the nested-row counterpart of `machineUnaryGridGeneratorCode`. +Given a unary dimension, an accumulator bound, and an immutable payload, the +machine visits all matrix positions in row-major order. It stores the current +row and the completed rows in reverse order, and reverses them at the two +row boundaries. Thus its output is exactly the canonical nested-list matrix +code, not a flat list requiring an implicit decoder. + +Both accumulators are explicitly clamped on malformed inputs. The semantic +proof below shows that neither clamp is active on canonical inputs satisfying +the stated output-size bound. +-/ + +namespace BeyondBethe + +open Complexity + +def machineUnaryMatrixGeneratorDimension (word : List Bool) : List Bool := + machinePairFirst word + +def machineUnaryMatrixGeneratorRest (word : List Bool) : List Bool := + machinePairSecond word + +def machineUnaryMatrixGeneratorInputBound (word : List Bool) : List Bool := + machinePairFirst (machineUnaryMatrixGeneratorRest word) + +def machineUnaryMatrixGeneratorInputPayload (word : List Bool) : List Bool := + machinePairSecond (machineUnaryMatrixGeneratorRest word) + +def machineUnaryMatrixGeneratorPack + (row column current rows bound done payload : List Bool) : List Bool := + pair row (pair column (pair current + (pair rows (pair bound (pair done payload))))) + +def machineUnaryMatrixGeneratorRow (state : List Bool) : List Bool := + machinePairFirst state + +def machineUnaryMatrixGeneratorColumn (state : List Bool) : List Bool := + machinePairFirst (machinePairSecond state) + +def machineUnaryMatrixGeneratorCurrent (state : List Bool) : List Bool := + machinePairFirst (machinePairSecond (machinePairSecond state)) + +def machineUnaryMatrixGeneratorRows (state : List Bool) : List Bool := + machinePairFirst + (machinePairSecond (machinePairSecond (machinePairSecond state))) + +def machineUnaryMatrixGeneratorBound (state : List Bool) : List Bool := + machinePairFirst (machinePairSecond + (machinePairSecond (machinePairSecond (machinePairSecond state)))) + +def machineUnaryMatrixGeneratorDone (state : List Bool) : List Bool := + machinePairFirst (machinePairSecond (machinePairSecond + (machinePairSecond (machinePairSecond (machinePairSecond state))))) + +def machineUnaryMatrixGeneratorPayload (state : List Bool) : List Bool := + machinePairSecond (machinePairSecond (machinePairSecond + (machinePairSecond (machinePairSecond (machinePairSecond state))))) + +@[simp] theorem machineUnaryMatrixGeneratorRow_pack + (row column current rows bound done payload : List Bool) : + machineUnaryMatrixGeneratorRow + (machineUnaryMatrixGeneratorPack row column current rows bound done payload) = row := by + simp [machineUnaryMatrixGeneratorRow, machineUnaryMatrixGeneratorPack] + +@[simp] theorem machineUnaryMatrixGeneratorColumn_pack + (row column current rows bound done payload : List Bool) : + machineUnaryMatrixGeneratorColumn + (machineUnaryMatrixGeneratorPack row column current rows bound done payload) = column := by + simp [machineUnaryMatrixGeneratorColumn, machineUnaryMatrixGeneratorPack] + +@[simp] theorem machineUnaryMatrixGeneratorCurrent_pack + (row column current rows bound done payload : List Bool) : + machineUnaryMatrixGeneratorCurrent + (machineUnaryMatrixGeneratorPack row column current rows bound done payload) = current := by + simp [machineUnaryMatrixGeneratorCurrent, machineUnaryMatrixGeneratorPack] + +@[simp] theorem machineUnaryMatrixGeneratorRows_pack + (row column current rows bound done payload : List Bool) : + machineUnaryMatrixGeneratorRows + (machineUnaryMatrixGeneratorPack row column current rows bound done payload) = rows := by + simp [machineUnaryMatrixGeneratorRows, machineUnaryMatrixGeneratorPack] + +@[simp] theorem machineUnaryMatrixGeneratorBound_pack + (row column current rows bound done payload : List Bool) : + machineUnaryMatrixGeneratorBound + (machineUnaryMatrixGeneratorPack row column current rows bound done payload) = bound := by + simp [machineUnaryMatrixGeneratorBound, machineUnaryMatrixGeneratorPack] + +@[simp] theorem machineUnaryMatrixGeneratorDone_pack + (row column current rows bound done payload : List Bool) : + machineUnaryMatrixGeneratorDone + (machineUnaryMatrixGeneratorPack row column current rows bound done payload) = done := by + simp [machineUnaryMatrixGeneratorDone, machineUnaryMatrixGeneratorPack] + +@[simp] theorem machineUnaryMatrixGeneratorPayload_pack + (row column current rows bound done payload : List Bool) : + machineUnaryMatrixGeneratorPayload + (machineUnaryMatrixGeneratorPack row column current rows bound done payload) = payload := by + simp [machineUnaryMatrixGeneratorPayload, machineUnaryMatrixGeneratorPack] + +def machineUnaryMatrixGeneratorStateDimension (state : List Bool) : List Bool := + machineUnaryMatrixGeneratorDimension + (machineUnaryMatrixGeneratorPayload state) + +def machineUnaryMatrixGeneratorEntryInput (state : List Bool) : List Bool := + pair (machineUnaryMatrixGeneratorRow state) + (pair (machineUnaryMatrixGeneratorColumn state) + (machineUnaryMatrixGeneratorInputPayload + (machineUnaryMatrixGeneratorPayload state))) + +def machineUnaryMatrixGeneratorNextRow (state : List Bool) : List Bool := + (machineUnaryMatrixGeneratorRow state ++ [true]).take + (machineUnaryMatrixGeneratorPayload state).length + +def machineUnaryMatrixGeneratorNextColumn (state : List Bool) : List Bool := + (machineUnaryMatrixGeneratorColumn state ++ [true]).take + (machineUnaryMatrixGeneratorPayload state).length + +def machineUnaryMatrixGeneratorColumnCompletesBit + (state : List Bool) : List Bool := + machineHeadBit (machineUnaryRulersEqualBit + (machineUnaryMatrixGeneratorNextColumn state) + (machineUnaryMatrixGeneratorStateDimension state)) + +def machineUnaryMatrixGeneratorRowCompletesBit + (state : List Bool) : List Bool := + machineHeadBit (machineUnaryRulersEqualBit + (machineUnaryMatrixGeneratorNextRow state) + (machineUnaryMatrixGeneratorStateDimension state)) + +def machineUnaryMatrixGeneratorCurrentCandidate + (entry : List Bool → List Bool) (state : List Bool) : List Bool := + pair (entry (machineUnaryMatrixGeneratorEntryInput state)) + (machineUnaryMatrixGeneratorCurrent state) + +def machineUnaryMatrixGeneratorNextCurrent + (entry : List Bool → List Bool) (state : List Bool) : List Bool := + (machineUnaryMatrixGeneratorCurrentCandidate entry state).take + (machineUnaryMatrixGeneratorBound state).length + +def machineUnaryMatrixGeneratorCompletedRow + (entry : List Bool → List Bool) (state : List Bool) : List Bool := + machineListReverse (machineUnaryMatrixGeneratorNextCurrent entry state) + +def machineUnaryMatrixGeneratorRowsCandidate + (entry : List Bool → List Bool) (state : List Bool) : List Bool := + pair (machineUnaryMatrixGeneratorCompletedRow entry state) + (machineUnaryMatrixGeneratorRows state) + +def machineUnaryMatrixGeneratorNextRows + (entry : List Bool → List Bool) (state : List Bool) : List Bool := + (machineUnaryMatrixGeneratorRowsCandidate entry state).take + (machineUnaryMatrixGeneratorBound state).length + +def machineUnaryMatrixGeneratorFinish + (entry : List Bool → List Bool) (state : List Bool) : List Bool := + machineUnaryMatrixGeneratorPack + (machineUnaryMatrixGeneratorRow state) + (machineUnaryMatrixGeneratorColumn state) [] + (machineUnaryMatrixGeneratorNextRows entry state) + (machineUnaryMatrixGeneratorBound state) [true] + (machineUnaryMatrixGeneratorPayload state) + +def machineUnaryMatrixGeneratorAdvanceRow + (entry : List Bool → List Bool) (state : List Bool) : List Bool := + machineUnaryMatrixGeneratorPack + (machineUnaryMatrixGeneratorNextRow state) [] [] + (machineUnaryMatrixGeneratorNextRows entry state) + (machineUnaryMatrixGeneratorBound state) + (machineUnaryMatrixGeneratorDone state) + (machineUnaryMatrixGeneratorPayload state) + +def machineUnaryMatrixGeneratorAdvanceColumn + (entry : List Bool → List Bool) (state : List Bool) : List Bool := + machineUnaryMatrixGeneratorPack + (machineUnaryMatrixGeneratorRow state) + (machineUnaryMatrixGeneratorNextColumn state) + (machineUnaryMatrixGeneratorNextCurrent entry state) + (machineUnaryMatrixGeneratorRows state) + (machineUnaryMatrixGeneratorBound state) + (machineUnaryMatrixGeneratorDone state) + (machineUnaryMatrixGeneratorPayload state) + +def machineUnaryMatrixGeneratorProcess + (entry : List Bool → List Bool) (state : List Bool) : List Bool := + machineIfHead (machineUnaryMatrixGeneratorColumnCompletesBit state) + (machineIfHead (machineUnaryMatrixGeneratorRowCompletesBit state) + (machineUnaryMatrixGeneratorFinish entry state) + (machineUnaryMatrixGeneratorAdvanceRow entry state)) + (machineUnaryMatrixGeneratorAdvanceColumn entry state) + +def machineUnaryMatrixGeneratorStep + (entry : List Bool → List Bool) (state : List Bool) : List Bool := + machineIfHead (machineHeadBit (machineUnaryMatrixGeneratorDone state)) state + (machineUnaryMatrixGeneratorProcess entry state) + +def machineUnaryMatrixGeneratorInit (word : List Bool) : List Bool := + machineUnaryMatrixGeneratorPack [] [] [] [] + (machineUnaryMatrixGeneratorInputBound word) [false] word + +def machineUnaryMatrixGeneratorDimensionBits (word : List Bool) : List Bool := + machineLengthBits (machineUnaryMatrixGeneratorDimension word) + +def machineUnaryMatrixGeneratorWorkBits (word : List Bool) : List Bool := + machineBinaryMulBits (pair + (machineUnaryMatrixGeneratorDimensionBits word) + (machineUnaryMatrixGeneratorDimensionBits word)) + +def machineUnaryMatrixGeneratorGuard (word : List Bool) : List Bool := + machineBinaryMulWidth word + +def machineUnaryMatrixGeneratorRuler (word : List Bool) : List Bool := + machineBoundedUnary (pair (machineUnaryMatrixGeneratorGuard word) + (machineUnaryMatrixGeneratorWorkBits word)) + +def machineUnaryMatrixGeneratorEnvelope (word : List Bool) : List Bool := + machineIteratedBinaryWidth 2 (word ++ List.replicate 16 false) + +def machineUnaryMatrixGeneratorWidth (word : List Bool) : List Bool := + let envelope := machineUnaryMatrixGeneratorEnvelope word + machineUnaryMatrixGeneratorPack envelope envelope envelope envelope + envelope envelope envelope + +def machineUnaryMatrixGeneratorFinalState + (entry : List Bool → List Bool) (word : List Bool) : List Bool := + (machineUnaryMatrixGeneratorStep entry)^[(machineUnaryMatrixGeneratorRuler word).length] + (machineUnaryMatrixGeneratorInit word) + +def machineUnaryMatrixGeneratorReversedRowsCode + (entry : List Bool → List Bool) (word : List Bool) : List Bool := + machineUnaryMatrixGeneratorRows + (machineUnaryMatrixGeneratorFinalState entry word) + +def machineUnaryMatrixGeneratorRowsCode + (entry : List Bool → List Bool) (word : List Bool) : List Bool := + machineListReverse (machineUnaryMatrixGeneratorReversedRowsCode entry word) + +/-! ## Polynomial-time closure + +The proof is deliberately structural: each accessor and transition is built +from already verified finite-word primitives, and the bounded iterator has an +explicit polynomial state envelope. +-/ + +theorem machineUnaryMatrixGeneratorDimension_mem_FP : + machineUnaryMatrixGeneratorDimension ∈ FP := machinePairFirst_mem_FP + +theorem machineUnaryMatrixGeneratorRest_mem_FP : + machineUnaryMatrixGeneratorRest ∈ FP := machinePairSecond_mem_FP + +theorem machineUnaryMatrixGeneratorInputBound_mem_FP : + machineUnaryMatrixGeneratorInputBound ∈ FP := by + simpa only [machineUnaryMatrixGeneratorInputBound] using + machineCompose_mem_FP machineUnaryMatrixGeneratorRest_mem_FP + machinePairFirst_mem_FP + +theorem machineUnaryMatrixGeneratorInputPayload_mem_FP : + machineUnaryMatrixGeneratorInputPayload ∈ FP := by + simpa only [machineUnaryMatrixGeneratorInputPayload] using + machineCompose_mem_FP machineUnaryMatrixGeneratorRest_mem_FP + machinePairSecond_mem_FP + +theorem machineUnaryMatrixGeneratorRow_mem_FP : + machineUnaryMatrixGeneratorRow ∈ FP := machinePairFirst_mem_FP + +theorem machineUnaryMatrixGeneratorColumn_mem_FP : + machineUnaryMatrixGeneratorColumn ∈ FP := by + simpa only [machineUnaryMatrixGeneratorColumn] using + machineCompose_mem_FP machinePairSecond_mem_FP machinePairFirst_mem_FP + +theorem machineUnaryMatrixGeneratorCurrent_mem_FP : + machineUnaryMatrixGeneratorCurrent ∈ FP := by + have h := machineCompose_mem_FP machinePairSecond_mem_FP machinePairSecond_mem_FP + simpa only [machineUnaryMatrixGeneratorCurrent] using + machineCompose_mem_FP h machinePairFirst_mem_FP + +theorem machineUnaryMatrixGeneratorRows_mem_FP : + machineUnaryMatrixGeneratorRows ∈ FP := by + have h₂ := machineCompose_mem_FP machinePairSecond_mem_FP machinePairSecond_mem_FP + have h₃ := machineCompose_mem_FP h₂ machinePairSecond_mem_FP + simpa only [machineUnaryMatrixGeneratorRows] using + machineCompose_mem_FP h₃ machinePairFirst_mem_FP + +theorem machineUnaryMatrixGeneratorBound_mem_FP : + machineUnaryMatrixGeneratorBound ∈ FP := by + have h₂ := machineCompose_mem_FP machinePairSecond_mem_FP machinePairSecond_mem_FP + have h₃ := machineCompose_mem_FP h₂ machinePairSecond_mem_FP + have h₄ := machineCompose_mem_FP h₃ machinePairSecond_mem_FP + simpa only [machineUnaryMatrixGeneratorBound] using + machineCompose_mem_FP h₄ machinePairFirst_mem_FP + +theorem machineUnaryMatrixGeneratorDone_mem_FP : + machineUnaryMatrixGeneratorDone ∈ FP := by + have h₂ := machineCompose_mem_FP machinePairSecond_mem_FP machinePairSecond_mem_FP + have h₃ := machineCompose_mem_FP h₂ machinePairSecond_mem_FP + have h₄ := machineCompose_mem_FP h₃ machinePairSecond_mem_FP + have h₅ := machineCompose_mem_FP h₄ machinePairSecond_mem_FP + simpa only [machineUnaryMatrixGeneratorDone] using + machineCompose_mem_FP h₅ machinePairFirst_mem_FP + +theorem machineUnaryMatrixGeneratorPayload_mem_FP : + machineUnaryMatrixGeneratorPayload ∈ FP := by + have h₂ := machineCompose_mem_FP machinePairSecond_mem_FP machinePairSecond_mem_FP + have h₃ := machineCompose_mem_FP h₂ machinePairSecond_mem_FP + have h₄ := machineCompose_mem_FP h₃ machinePairSecond_mem_FP + have h₅ := machineCompose_mem_FP h₄ machinePairSecond_mem_FP + simpa only [machineUnaryMatrixGeneratorPayload] using + machineCompose_mem_FP h₅ machinePairSecond_mem_FP + +theorem machineUnaryMatrixGeneratorStateDimension_mem_FP : + machineUnaryMatrixGeneratorStateDimension ∈ FP := by + simpa only [machineUnaryMatrixGeneratorStateDimension] using + machineCompose_mem_FP machineUnaryMatrixGeneratorPayload_mem_FP + machineUnaryMatrixGeneratorDimension_mem_FP + +theorem machineUnaryMatrixGeneratorEntryInput_mem_FP : + machineUnaryMatrixGeneratorEntryInput ∈ FP := by + have hpayload := machineCompose_mem_FP + machineUnaryMatrixGeneratorPayload_mem_FP + machineUnaryMatrixGeneratorInputPayload_mem_FP + exact machinePair_mem_FP machineUnaryMatrixGeneratorRow_mem_FP + (machinePair_mem_FP machineUnaryMatrixGeneratorColumn_mem_FP hpayload) + +theorem machineUnaryMatrixGeneratorNextRow_mem_FP : + machineUnaryMatrixGeneratorNextRow ∈ FP := by + have happend := machineAppend_mem_FP machineUnaryMatrixGeneratorRow_mem_FP + (machineConst_mem_FP [true]) + simpa only [machineUnaryMatrixGeneratorNextRow] using + machineTake_mem_FP machineUnaryMatrixGeneratorPayload_mem_FP happend + +theorem machineUnaryMatrixGeneratorNextColumn_mem_FP : + machineUnaryMatrixGeneratorNextColumn ∈ FP := by + have happend := machineAppend_mem_FP machineUnaryMatrixGeneratorColumn_mem_FP + (machineConst_mem_FP [true]) + simpa only [machineUnaryMatrixGeneratorNextColumn] using + machineTake_mem_FP machineUnaryMatrixGeneratorPayload_mem_FP happend + +theorem machineUnaryMatrixGeneratorColumnCompletesBit_mem_FP : + machineUnaryMatrixGeneratorColumnCompletesBit ∈ FP := by + have heq := machineUnaryRulersEqualBit_mem_FP + machineUnaryMatrixGeneratorNextColumn_mem_FP + machineUnaryMatrixGeneratorStateDimension_mem_FP + simpa only [machineUnaryMatrixGeneratorColumnCompletesBit] using + machineCompose_mem_FP heq machineHeadBit_mem_FP + +theorem machineUnaryMatrixGeneratorRowCompletesBit_mem_FP : + machineUnaryMatrixGeneratorRowCompletesBit ∈ FP := by + have heq := machineUnaryRulersEqualBit_mem_FP + machineUnaryMatrixGeneratorNextRow_mem_FP + machineUnaryMatrixGeneratorStateDimension_mem_FP + simpa only [machineUnaryMatrixGeneratorRowCompletesBit] using + machineCompose_mem_FP heq machineHeadBit_mem_FP + +theorem machineUnaryMatrixGeneratorCurrentCandidate_mem_FP + {entry : List Bool → List Bool} (hentry : entry ∈ FP) : + machineUnaryMatrixGeneratorCurrentCandidate entry ∈ FP := by + have hcurrentEntry := machineCompose_mem_FP + machineUnaryMatrixGeneratorEntryInput_mem_FP hentry + exact machinePair_mem_FP hcurrentEntry + machineUnaryMatrixGeneratorCurrent_mem_FP + +theorem machineUnaryMatrixGeneratorNextCurrent_mem_FP + {entry : List Bool → List Bool} (hentry : entry ∈ FP) : + machineUnaryMatrixGeneratorNextCurrent entry ∈ FP := by + simpa only [machineUnaryMatrixGeneratorNextCurrent] using + machineTake_mem_FP machineUnaryMatrixGeneratorBound_mem_FP + (machineUnaryMatrixGeneratorCurrentCandidate_mem_FP hentry) + +theorem machineUnaryMatrixGeneratorCompletedRow_mem_FP + {entry : List Bool → List Bool} (hentry : entry ∈ FP) : + machineUnaryMatrixGeneratorCompletedRow entry ∈ FP := by + simpa only [machineUnaryMatrixGeneratorCompletedRow] using + machineCompose_mem_FP + (machineUnaryMatrixGeneratorNextCurrent_mem_FP hentry) + machineListReverse_mem_FP + +theorem machineUnaryMatrixGeneratorRowsCandidate_mem_FP + {entry : List Bool → List Bool} (hentry : entry ∈ FP) : + machineUnaryMatrixGeneratorRowsCandidate entry ∈ FP := + machinePair_mem_FP (machineUnaryMatrixGeneratorCompletedRow_mem_FP hentry) + machineUnaryMatrixGeneratorRows_mem_FP + +theorem machineUnaryMatrixGeneratorNextRows_mem_FP + {entry : List Bool → List Bool} (hentry : entry ∈ FP) : + machineUnaryMatrixGeneratorNextRows entry ∈ FP := by + simpa only [machineUnaryMatrixGeneratorNextRows] using + machineTake_mem_FP machineUnaryMatrixGeneratorBound_mem_FP + (machineUnaryMatrixGeneratorRowsCandidate_mem_FP hentry) + +theorem machineUnaryMatrixGeneratorFinish_mem_FP + {entry : List Bool → List Bool} (hentry : entry ∈ FP) : + machineUnaryMatrixGeneratorFinish entry ∈ FP := + machinePair_mem_FP machineUnaryMatrixGeneratorRow_mem_FP + (machinePair_mem_FP machineUnaryMatrixGeneratorColumn_mem_FP + (machinePair_mem_FP (machineConst_mem_FP []) + (machinePair_mem_FP (machineUnaryMatrixGeneratorNextRows_mem_FP hentry) + (machinePair_mem_FP machineUnaryMatrixGeneratorBound_mem_FP + (machinePair_mem_FP (machineConst_mem_FP [true]) + machineUnaryMatrixGeneratorPayload_mem_FP))))) + +theorem machineUnaryMatrixGeneratorAdvanceRow_mem_FP + {entry : List Bool → List Bool} (hentry : entry ∈ FP) : + machineUnaryMatrixGeneratorAdvanceRow entry ∈ FP := + machinePair_mem_FP machineUnaryMatrixGeneratorNextRow_mem_FP + (machinePair_mem_FP (machineConst_mem_FP []) + (machinePair_mem_FP (machineConst_mem_FP []) + (machinePair_mem_FP (machineUnaryMatrixGeneratorNextRows_mem_FP hentry) + (machinePair_mem_FP machineUnaryMatrixGeneratorBound_mem_FP + (machinePair_mem_FP machineUnaryMatrixGeneratorDone_mem_FP + machineUnaryMatrixGeneratorPayload_mem_FP))))) + +theorem machineUnaryMatrixGeneratorAdvanceColumn_mem_FP + {entry : List Bool → List Bool} (hentry : entry ∈ FP) : + machineUnaryMatrixGeneratorAdvanceColumn entry ∈ FP := + machinePair_mem_FP machineUnaryMatrixGeneratorRow_mem_FP + (machinePair_mem_FP machineUnaryMatrixGeneratorNextColumn_mem_FP + (machinePair_mem_FP (machineUnaryMatrixGeneratorNextCurrent_mem_FP hentry) + (machinePair_mem_FP machineUnaryMatrixGeneratorRows_mem_FP + (machinePair_mem_FP machineUnaryMatrixGeneratorBound_mem_FP + (machinePair_mem_FP machineUnaryMatrixGeneratorDone_mem_FP + machineUnaryMatrixGeneratorPayload_mem_FP))))) + +theorem machineUnaryMatrixGeneratorProcess_mem_FP + {entry : List Bool → List Bool} (hentry : entry ∈ FP) : + machineUnaryMatrixGeneratorProcess entry ∈ FP := by + have hrow := machineIfHead_mem_FP + machineUnaryMatrixGeneratorRowCompletesBit_mem_FP + (machineUnaryMatrixGeneratorFinish_mem_FP hentry) + (machineUnaryMatrixGeneratorAdvanceRow_mem_FP hentry) + exact machineIfHead_mem_FP + machineUnaryMatrixGeneratorColumnCompletesBit_mem_FP hrow + (machineUnaryMatrixGeneratorAdvanceColumn_mem_FP hentry) + +theorem machineUnaryMatrixGeneratorStep_mem_FP + {entry : List Bool → List Bool} (hentry : entry ∈ FP) : + machineUnaryMatrixGeneratorStep entry ∈ FP := by + have hdone := machineCompose_mem_FP machineUnaryMatrixGeneratorDone_mem_FP + machineHeadBit_mem_FP + exact machineIfHead_mem_FP hdone id_mem_FP + (machineUnaryMatrixGeneratorProcess_mem_FP hentry) + +theorem machineUnaryMatrixGeneratorInit_mem_FP : + machineUnaryMatrixGeneratorInit ∈ FP := + machinePair_mem_FP (machineConst_mem_FP []) + (machinePair_mem_FP (machineConst_mem_FP []) + (machinePair_mem_FP (machineConst_mem_FP []) + (machinePair_mem_FP (machineConst_mem_FP []) + (machinePair_mem_FP machineUnaryMatrixGeneratorInputBound_mem_FP + (machinePair_mem_FP (machineConst_mem_FP [false]) id_mem_FP))))) + +theorem machineUnaryMatrixGeneratorDimensionBits_mem_FP : + machineUnaryMatrixGeneratorDimensionBits ∈ FP := by + simpa only [machineUnaryMatrixGeneratorDimensionBits] using + machineCompose_mem_FP machineUnaryMatrixGeneratorDimension_mem_FP + machineLengthBits_mem_FP + +theorem machineUnaryMatrixGeneratorWorkBits_mem_FP : + machineUnaryMatrixGeneratorWorkBits ∈ FP := by + have hinput := machinePair_mem_FP + machineUnaryMatrixGeneratorDimensionBits_mem_FP + machineUnaryMatrixGeneratorDimensionBits_mem_FP + simpa only [machineUnaryMatrixGeneratorWorkBits] using + machineCompose_mem_FP hinput machineBinaryMulBits_mem_FP + +theorem machineUnaryMatrixGeneratorGuard_mem_FP : + machineUnaryMatrixGeneratorGuard ∈ FP := machineBinaryMulWidth_mem_FP + +theorem machineUnaryMatrixGeneratorRuler_mem_FP : + machineUnaryMatrixGeneratorRuler ∈ FP := by + have hinput := machinePair_mem_FP machineUnaryMatrixGeneratorGuard_mem_FP + machineUnaryMatrixGeneratorWorkBits_mem_FP + simpa only [machineUnaryMatrixGeneratorRuler] using + machineCompose_mem_FP hinput machineBoundedUnary_mem_FP + +theorem machineUnaryMatrixGeneratorEnvelope_mem_FP : + machineUnaryMatrixGeneratorEnvelope ∈ FP := by + have hpadded := machineAppend_mem_FP id_mem_FP + (machineConst_mem_FP (List.replicate 16 false)) + simpa only [machineUnaryMatrixGeneratorEnvelope] using + machineCompose_mem_FP hpadded (machineIteratedBinaryWidth_mem_FP 2) + +theorem machineUnaryMatrixGeneratorWidth_mem_FP : + machineUnaryMatrixGeneratorWidth ∈ FP := by + let h := machineUnaryMatrixGeneratorEnvelope_mem_FP + exact machinePair_mem_FP h + (machinePair_mem_FP h + (machinePair_mem_FP h + (machinePair_mem_FP h + (machinePair_mem_FP h (machinePair_mem_FP h h))))) + +def MachineUnaryMatrixGeneratorStateBound + (word state : List Bool) : Prop := + state = machineUnaryMatrixGeneratorPack + (machineUnaryMatrixGeneratorRow state) + (machineUnaryMatrixGeneratorColumn state) + (machineUnaryMatrixGeneratorCurrent state) + (machineUnaryMatrixGeneratorRows state) + (machineUnaryMatrixGeneratorBound state) + (machineUnaryMatrixGeneratorDone state) + (machineUnaryMatrixGeneratorPayload state) ∧ + (machineUnaryMatrixGeneratorRow state).length ≤ word.length ∧ + (machineUnaryMatrixGeneratorColumn state).length ≤ word.length ∧ + (machineUnaryMatrixGeneratorCurrent state).length ≤ + (machineUnaryMatrixGeneratorInputBound word).length ∧ + (machineUnaryMatrixGeneratorRows state).length ≤ + (machineUnaryMatrixGeneratorInputBound word).length ∧ + machineUnaryMatrixGeneratorBound state = + machineUnaryMatrixGeneratorInputBound word ∧ + (machineUnaryMatrixGeneratorDone state).length ≤ 1 ∧ + machineUnaryMatrixGeneratorPayload state = word + +theorem machineUnaryMatrixGeneratorInit_bound (word : List Bool) : + MachineUnaryMatrixGeneratorStateBound word + (machineUnaryMatrixGeneratorInit word) := by + simp [MachineUnaryMatrixGeneratorStateBound, + machineUnaryMatrixGeneratorInit] + +theorem machineUnaryMatrixGeneratorStep_bound + {entry : List Bool → List Bool} {word state : List Bool} + (hs : MachineUnaryMatrixGeneratorStateBound word state) : + MachineUnaryMatrixGeneratorStateBound word + (machineUnaryMatrixGeneratorStep entry state) := by + rcases hs with + ⟨hdecomp, hrow, hcolumn, hcurrent, hrows, hbound, hdone, hpayload⟩ + have hnextCurrent : + (machineUnaryMatrixGeneratorNextCurrent entry state).length ≤ + (machineUnaryMatrixGeneratorInputBound word).length := by + rw [machineUnaryMatrixGeneratorNextCurrent, hbound] + exact List.length_take_le _ _ + have hnextRows : + (machineUnaryMatrixGeneratorNextRows entry state).length ≤ + (machineUnaryMatrixGeneratorInputBound word).length := by + rw [machineUnaryMatrixGeneratorNextRows, hbound] + exact List.length_take_le _ _ + have hnextRow : (machineUnaryMatrixGeneratorNextRow state).length ≤ + word.length := by + rw [machineUnaryMatrixGeneratorNextRow, hpayload] + exact List.length_take_le _ _ + have hnextColumn : (machineUnaryMatrixGeneratorNextColumn state).length ≤ + word.length := by + rw [machineUnaryMatrixGeneratorNextColumn, hpayload] + exact List.length_take_le _ _ + have hfinish : MachineUnaryMatrixGeneratorStateBound word + (machineUnaryMatrixGeneratorFinish entry state) := by + simp only [MachineUnaryMatrixGeneratorStateBound, + machineUnaryMatrixGeneratorFinish, + machineUnaryMatrixGeneratorRow_pack, + machineUnaryMatrixGeneratorColumn_pack, + machineUnaryMatrixGeneratorCurrent_pack, + machineUnaryMatrixGeneratorRows_pack, + machineUnaryMatrixGeneratorBound_pack, + machineUnaryMatrixGeneratorDone_pack, + machineUnaryMatrixGeneratorPayload_pack] + exact ⟨trivial, hrow, hcolumn, by simp, hnextRows, hbound, by simp, + hpayload⟩ + have hadvanceRow : MachineUnaryMatrixGeneratorStateBound word + (machineUnaryMatrixGeneratorAdvanceRow entry state) := by + simp only [MachineUnaryMatrixGeneratorStateBound, + machineUnaryMatrixGeneratorAdvanceRow, + machineUnaryMatrixGeneratorRow_pack, + machineUnaryMatrixGeneratorColumn_pack, + machineUnaryMatrixGeneratorCurrent_pack, + machineUnaryMatrixGeneratorRows_pack, + machineUnaryMatrixGeneratorBound_pack, + machineUnaryMatrixGeneratorDone_pack, + machineUnaryMatrixGeneratorPayload_pack] + exact ⟨trivial, hnextRow, by simp, by simp, hnextRows, hbound, hdone, + hpayload⟩ + have hadvanceColumn : MachineUnaryMatrixGeneratorStateBound word + (machineUnaryMatrixGeneratorAdvanceColumn entry state) := by + simp only [MachineUnaryMatrixGeneratorStateBound, + machineUnaryMatrixGeneratorAdvanceColumn, + machineUnaryMatrixGeneratorRow_pack, + machineUnaryMatrixGeneratorColumn_pack, + machineUnaryMatrixGeneratorCurrent_pack, + machineUnaryMatrixGeneratorRows_pack, + machineUnaryMatrixGeneratorBound_pack, + machineUnaryMatrixGeneratorDone_pack, + machineUnaryMatrixGeneratorPayload_pack] + exact ⟨trivial, hrow, hnextColumn, hnextCurrent, hrows, hbound, hdone, + hpayload⟩ + rw [machineUnaryMatrixGeneratorStep] + cases hdoneCode : machineUnaryMatrixGeneratorDone state with + | nil => + rw [machineHeadBit_nil, machineIfHead_false, + machineUnaryMatrixGeneratorProcess] + cases hcolumnCode : machineUnaryMatrixGeneratorColumnCompletesBit state with + | nil => + have hlen : + (machineUnaryMatrixGeneratorColumnCompletesBit state).length = 1 := by + simp [machineUnaryMatrixGeneratorColumnCompletesBit] + rw [hcolumnCode] at hlen + simp at hlen + | cons columnBit columnTail => + cases columnBit with + | false => rw [machineIfHead_false]; exact hadvanceColumn + | true => + rw [machineIfHead_true] + cases hrowCode : machineUnaryMatrixGeneratorRowCompletesBit state with + | nil => + have hlen : + (machineUnaryMatrixGeneratorRowCompletesBit state).length = 1 := by + simp [machineUnaryMatrixGeneratorRowCompletesBit] + rw [hrowCode] at hlen + simp at hlen + | cons rowBit rowTail => + cases rowBit with + | false => rw [machineIfHead_false]; exact hadvanceRow + | true => rw [machineIfHead_true]; exact hfinish + | cons doneBit doneTail => + cases doneBit with + | false => + rw [machineHeadBit_cons, machineIfHead_false, + machineUnaryMatrixGeneratorProcess] + cases hcolumnCode : machineUnaryMatrixGeneratorColumnCompletesBit state with + | nil => + have hlen : + (machineUnaryMatrixGeneratorColumnCompletesBit state).length = 1 := by + simp [machineUnaryMatrixGeneratorColumnCompletesBit] + rw [hcolumnCode] at hlen + simp at hlen + | cons columnBit columnTail => + cases columnBit with + | false => rw [machineIfHead_false]; exact hadvanceColumn + | true => + rw [machineIfHead_true] + cases hrowCode : machineUnaryMatrixGeneratorRowCompletesBit state with + | nil => + have hlen : + (machineUnaryMatrixGeneratorRowCompletesBit state).length = 1 := by + simp [machineUnaryMatrixGeneratorRowCompletesBit] + rw [hrowCode] at hlen + simp at hlen + | cons rowBit rowTail => + cases rowBit with + | false => rw [machineIfHead_false]; exact hadvanceRow + | true => rw [machineIfHead_true]; exact hfinish + | true => + rw [machineHeadBit_cons, machineIfHead_true] + exact ⟨hdecomp, hrow, hcolumn, hcurrent, hrows, hbound, hdone, + hpayload⟩ + +theorem machineUnaryMatrixGeneratorIterate_bound + (entry : List Bool → List Bool) (word : List Bool) : ∀ k, + MachineUnaryMatrixGeneratorStateBound word + ((machineUnaryMatrixGeneratorStep entry)^[k] + (machineUnaryMatrixGeneratorInit word)) := by + intro k + induction k with + | zero => exact machineUnaryMatrixGeneratorInit_bound word + | succ k ih => + rw [Function.iterate_succ_apply'] + exact machineUnaryMatrixGeneratorStep_bound ih + +theorem machineUnaryMatrixGeneratorEnvelope_word_le (word : List Bool) : + word.length ≤ (machineUnaryMatrixGeneratorEnvelope word).length := by + rw [machineUnaryMatrixGeneratorEnvelope, + machineIteratedBinaryWidth_length] + have hpadded : word.length ≤ (word ++ List.replicate 16 false).length := by + simp + exact hpadded.trans (certificateExpGuardWidth_self_le 2 _) + +theorem machineUnaryMatrixGeneratorEnvelope_pos (word : List Bool) : + 1 ≤ (machineUnaryMatrixGeneratorEnvelope word).length := by + have hword := machineUnaryMatrixGeneratorEnvelope_word_le word + by_cases hnil : word = [] + · subst word + norm_num [machineUnaryMatrixGeneratorEnvelope, + machineIteratedBinaryWidth_length, certificateExpGuardWidth] + · have hpos : 0 < word.length := List.length_pos_of_ne_nil hnil + have : 1 ≤ word.length := by omega + omega + +theorem machineUnaryMatrixGeneratorInputBound_le_envelope (word : List Bool) : + (machineUnaryMatrixGeneratorInputBound word).length ≤ + (machineUnaryMatrixGeneratorEnvelope word).length := + (machinePairFirst_length_le (machineUnaryMatrixGeneratorRest word)).trans + ((machinePairSecond_length_le word).trans + (machineUnaryMatrixGeneratorEnvelope_word_le word)) + +theorem machineUnaryMatrixGeneratorIterate_length_le_width + (entry : List Bool → List Bool) (word : List Bool) (iterations : ℕ) + (_ : iterations ≤ (machineUnaryMatrixGeneratorRuler word).length) : + ((machineUnaryMatrixGeneratorStep entry)^[iterations] + (machineUnaryMatrixGeneratorInit word)).length ≤ + (machineUnaryMatrixGeneratorWidth word).length := by + rcases machineUnaryMatrixGeneratorIterate_bound entry word iterations with + ⟨hdecomp, hrow, hcolumn, hcurrent, hrows, hbound, hdone, hpayload⟩ + have hwe := machineUnaryMatrixGeneratorEnvelope_word_le word + have hbe := machineUnaryMatrixGeneratorInputBound_le_envelope word + have hepos := machineUnaryMatrixGeneratorEnvelope_pos word + rw [hdecomp, hbound, hpayload] + simp only [machineUnaryMatrixGeneratorPack, + machineUnaryMatrixGeneratorWidth, pair_length] + omega + +theorem machineUnaryMatrixGeneratorFinalState_mem_FP + {entry : List Bool → List Bool} (hentry : entry ∈ FP) : + machineUnaryMatrixGeneratorFinalState entry ∈ FP := + Cobham.iterate_mem_FP + (machineUnaryMatrixGeneratorStep_mem_FP hentry) + machineUnaryMatrixGeneratorInit_mem_FP + machineUnaryMatrixGeneratorRuler_mem_FP + machineUnaryMatrixGeneratorWidth_mem_FP + (machineUnaryMatrixGeneratorIterate_length_le_width entry) + +theorem machineUnaryMatrixGeneratorReversedRowsCode_mem_FP + {entry : List Bool → List Bool} (hentry : entry ∈ FP) : + machineUnaryMatrixGeneratorReversedRowsCode entry ∈ FP := by + simpa only [machineUnaryMatrixGeneratorReversedRowsCode] using + machineCompose_mem_FP + (machineUnaryMatrixGeneratorFinalState_mem_FP hentry) + machineUnaryMatrixGeneratorRows_mem_FP + +theorem machineUnaryMatrixGeneratorRowsCode_mem_FP + {entry : List Bool → List Bool} (hentry : entry ∈ FP) : + machineUnaryMatrixGeneratorRowsCode entry ∈ FP := by + simpa only [machineUnaryMatrixGeneratorRowsCode] using + machineCompose_mem_FP + (machineUnaryMatrixGeneratorReversedRowsCode_mem_FP hentry) + machineListReverse_mem_FP + +/-! ## Canonical inputs and exact traversal -/ + +def machineUnaryMatrixGeneratorCanonicalWord + (m : ℕ) (bound payload : List Bool) : List Bool := + pair (List.replicate m true) (pair bound payload) + +@[simp] theorem machineUnaryMatrixGeneratorDimension_encode + (m : ℕ) (bound payload : List Bool) : + machineUnaryMatrixGeneratorDimension + (machineUnaryMatrixGeneratorCanonicalWord m bound payload) = + List.replicate m true := by + simp [machineUnaryMatrixGeneratorDimension, + machineUnaryMatrixGeneratorCanonicalWord] + +@[simp] theorem machineUnaryMatrixGeneratorInputBound_encode + (m : ℕ) (bound payload : List Bool) : + machineUnaryMatrixGeneratorInputBound + (machineUnaryMatrixGeneratorCanonicalWord m bound payload) = bound := by + simp [machineUnaryMatrixGeneratorInputBound, + machineUnaryMatrixGeneratorRest, + machineUnaryMatrixGeneratorCanonicalWord] + +@[simp] theorem machineUnaryMatrixGeneratorInputPayload_encode + (m : ℕ) (bound payload : List Bool) : + machineUnaryMatrixGeneratorInputPayload + (machineUnaryMatrixGeneratorCanonicalWord m bound payload) = payload := by + simp [machineUnaryMatrixGeneratorInputPayload, + machineUnaryMatrixGeneratorRest, + machineUnaryMatrixGeneratorCanonicalWord] + +@[simp] theorem machineUnaryMatrixGeneratorWorkBits_encode + (m : ℕ) (bound payload : List Bool) : + machineUnaryMatrixGeneratorWorkBits + (machineUnaryMatrixGeneratorCanonicalWord m bound payload) = + (m * m).bits := by + rw [machineUnaryMatrixGeneratorWorkBits, + machineUnaryMatrixGeneratorDimensionBits, + machineUnaryMatrixGeneratorDimension_encode, + machineLengthBits_encode, List.length_replicate, + machineBinaryMulBits_pair_natBits] + +theorem machineUnaryMatrixGeneratorWork_le_guard + (m : ℕ) (bound payload : List Bool) : + m * m ≤ + (machineUnaryMatrixGeneratorGuard + (machineUnaryMatrixGeneratorCanonicalWord m bound payload)).length := by + have hm : m ≤ + (machineUnaryMatrixGeneratorCanonicalWord m bound payload).length := by + simp only [machineUnaryMatrixGeneratorCanonicalWord, pair_length, + List.length_replicate] + omega + simp only [machineUnaryMatrixGeneratorGuard, machineBinaryMulWidth, + List.length_replicate, List.length_append] + nlinarith + +@[simp] theorem machineUnaryMatrixGeneratorRuler_encode + (m : ℕ) (bound payload : List Bool) : + machineUnaryMatrixGeneratorRuler + (machineUnaryMatrixGeneratorCanonicalWord m bound payload) = + List.replicate (m * m) true := by + rw [machineUnaryMatrixGeneratorRuler, + machineUnaryMatrixGeneratorWorkBits_encode, + machineBoundedUnary_encode_of_le] + exact machineUnaryMatrixGeneratorWork_le_guard m bound payload + +/-! ## Typed row-major semantics -/ + +def unaryMatrixRows {m : ℕ} + (f : Fin m → Fin m → ℚ) : List (List ℚ) := + List.ofFn fun i ↦ List.ofFn fun j ↦ f i j + +@[simp] theorem unaryMatrixRows_length {m : ℕ} + (f : Fin m → Fin m → ℚ) : (unaryMatrixRows f).length = m := by + simp [unaryMatrixRows] + +@[simp] theorem unaryMatrixRows_getElem {m : ℕ} + (f : Fin m → Fin m → ℚ) (i : ℕ) (hi : i < (unaryMatrixRows f).length) : + (unaryMatrixRows f)[i] = + List.ofFn (f ⟨i, by simpa using hi⟩) := by + simp [unaryMatrixRows] + +def unaryMatrixCurrent {m : ℕ} + (f : Fin m → Fin m → ℚ) (state : UnaryGridSemanticState m) : List ℚ := + if state.done then [] + else (List.ofFn (f state.row)).take state.column.1 |>.reverse + +def unaryMatrixCompletedRows {m : ℕ} + (f : Fin m → Fin m → ℚ) (state : UnaryGridSemanticState m) : + List (List ℚ) := + if state.done then (unaryMatrixRows f).reverse + else ((unaryMatrixRows f).take state.row.1).reverse + +def machineUnaryMatrixGeneratorSemanticCode {m : ℕ} + (f : Fin m → Fin m → ℚ) (bound payload : List Bool) + (state : UnaryGridSemanticState m) : List Bool := + machineUnaryMatrixGeneratorPack + (List.replicate state.row.1 true) + (List.replicate state.column.1 true) + (binaryListCode rationalEntryBinaryCode (unaryMatrixCurrent f state)) + (binaryListCode (binaryListCode rationalEntryBinaryCode) + (unaryMatrixCompletedRows f state)) + bound [state.done] + (machineUnaryMatrixGeneratorCanonicalWord m bound payload) + +@[simp] theorem machineUnaryMatrixGeneratorEntryInput_semanticCode {m : ℕ} + (f : Fin m → Fin m → ℚ) (bound payload : List Bool) + (state : UnaryGridSemanticState m) : + machineUnaryMatrixGeneratorEntryInput + (machineUnaryMatrixGeneratorSemanticCode f bound payload state) = + pair (List.replicate state.row.1 true) + (pair (List.replicate state.column.1 true) payload) := by + simp [machineUnaryMatrixGeneratorEntryInput, + machineUnaryMatrixGeneratorSemanticCode] + +@[simp] theorem machineUnaryMatrixGeneratorNextRow_semanticCode {m : ℕ} + (f : Fin m → Fin m → ℚ) (bound payload : List Bool) + (state : UnaryGridSemanticState m) : + machineUnaryMatrixGeneratorNextRow + (machineUnaryMatrixGeneratorSemanticCode f bound payload state) = + List.replicate (state.row.1 + 1) true := by + have hlength : state.row.1 + 1 ≤ + (machineUnaryMatrixGeneratorCanonicalWord m bound payload).length := by + have hrow : state.row.1 + 1 ≤ m := by omega + have hm : m ≤ + (machineUnaryMatrixGeneratorCanonicalWord m bound payload).length := by + simp only [machineUnaryMatrixGeneratorCanonicalWord, pair_length, + List.length_replicate] + omega + omega + rw [machineUnaryMatrixGeneratorNextRow] + simp only [machineUnaryMatrixGeneratorSemanticCode, + machineUnaryMatrixGeneratorRow_pack, + machineUnaryMatrixGeneratorPayload_pack] + have happend : List.replicate state.row.1 true ++ [true] = + List.replicate (state.row.1 + 1) true := by + rw [show ([true] : List Bool) = List.replicate 1 true by rfl, + List.replicate_append_replicate] + rw [happend, List.take_of_length_le (by simpa using hlength)] + +@[simp] theorem machineUnaryMatrixGeneratorNextColumn_semanticCode {m : ℕ} + (f : Fin m → Fin m → ℚ) (bound payload : List Bool) + (state : UnaryGridSemanticState m) : + machineUnaryMatrixGeneratorNextColumn + (machineUnaryMatrixGeneratorSemanticCode f bound payload state) = + List.replicate (state.column.1 + 1) true := by + have hlength : state.column.1 + 1 ≤ + (machineUnaryMatrixGeneratorCanonicalWord m bound payload).length := by + have hcolumn : state.column.1 + 1 ≤ m := by omega + have hm : m ≤ + (machineUnaryMatrixGeneratorCanonicalWord m bound payload).length := by + simp only [machineUnaryMatrixGeneratorCanonicalWord, pair_length, + List.length_replicate] + omega + omega + rw [machineUnaryMatrixGeneratorNextColumn] + simp only [machineUnaryMatrixGeneratorSemanticCode, + machineUnaryMatrixGeneratorColumn_pack, + machineUnaryMatrixGeneratorPayload_pack] + have happend : List.replicate state.column.1 true ++ [true] = + List.replicate (state.column.1 + 1) true := by + rw [show ([true] : List Bool) = List.replicate 1 true by rfl, + List.replicate_append_replicate] + rw [happend, List.take_of_length_le (by simpa using hlength)] + +@[simp] theorem machineUnaryMatrixGeneratorColumnCompletesBit_semanticCode + {m : ℕ} (f : Fin m → Fin m → ℚ) (bound payload : List Bool) + (state : UnaryGridSemanticState m) : + machineUnaryMatrixGeneratorColumnCompletesBit + (machineUnaryMatrixGeneratorSemanticCode f bound payload state) = + [decide (state.column.1 + 1 = m)] := by + rw [machineUnaryMatrixGeneratorColumnCompletesBit, + machineUnaryMatrixGeneratorNextColumn_semanticCode, + machineUnaryMatrixGeneratorStateDimension] + simp only [machineUnaryMatrixGeneratorSemanticCode, + machineUnaryMatrixGeneratorPayload_pack, + machineUnaryMatrixGeneratorDimension_encode, + machineUnaryRulersEqualBit_replicate, machineHeadBit_cons] + +@[simp] theorem machineUnaryMatrixGeneratorRowCompletesBit_semanticCode + {m : ℕ} (f : Fin m → Fin m → ℚ) (bound payload : List Bool) + (state : UnaryGridSemanticState m) : + machineUnaryMatrixGeneratorRowCompletesBit + (machineUnaryMatrixGeneratorSemanticCode f bound payload state) = + [decide (state.row.1 + 1 = m)] := by + rw [machineUnaryMatrixGeneratorRowCompletesBit, + machineUnaryMatrixGeneratorNextRow_semanticCode, + machineUnaryMatrixGeneratorStateDimension] + simp only [machineUnaryMatrixGeneratorSemanticCode, + machineUnaryMatrixGeneratorPayload_pack, + machineUnaryMatrixGeneratorDimension_encode, + machineUnaryRulersEqualBit_replicate, machineHeadBit_cons] + +theorem unaryMatrixCurrent_active {m : ℕ} + (f : Fin m → Fin m → ℚ) (state : UnaryGridSemanticState m) + (hdone : state.done = false) : + unaryMatrixCurrent f state = + ((List.ofFn (f state.row)).take state.column.1).reverse := by + simp [unaryMatrixCurrent, hdone] + +theorem unaryMatrixCompletedRows_active {m : ℕ} + (f : Fin m → Fin m → ℚ) (state : UnaryGridSemanticState m) + (hdone : state.done = false) : + unaryMatrixCompletedRows f state = + ((unaryMatrixRows f).take state.row.1).reverse := by + simp [unaryMatrixCompletedRows, hdone] + +theorem unaryMatrixCurrentCandidate_eq {m : ℕ} + (f : Fin m → Fin m → ℚ) (state : UnaryGridSemanticState m) + (hdone : state.done = false) : + f state.row state.column :: unaryMatrixCurrent f state = + ((List.ofFn (f state.row)).take (state.column.1 + 1)).reverse := by + rw [unaryMatrixCurrent_active f state hdone] + have hcolumn : state.column.1 < (List.ofFn (f state.row)).length := by + simp + have htake := List.take_concat_get hcolumn + have hget : (List.ofFn (f state.row))[state.column.1] = + f state.row state.column := by simp + rw [hget] at htake + rw [← htake] + simpa only [List.concat_eq_append] using + (List.reverse_concat + (l := (List.ofFn (f state.row)).take state.column.1) + (a := f state.row state.column)).symm + +theorem unaryMatrixRowsCandidate_eq {m : ℕ} + (f : Fin m → Fin m → ℚ) (state : UnaryGridSemanticState m) + (hdone : state.done = false) + (hcolumn : state.column.1 + 1 = m) : + (f state.row state.column :: unaryMatrixCurrent f state).reverse :: + unaryMatrixCompletedRows f state = + ((unaryMatrixRows f).take (state.row.1 + 1)).reverse := by + rw [unaryMatrixCurrentCandidate_eq f state hdone, + unaryMatrixCompletedRows_active f state hdone, + List.reverse_reverse] + have hfull : + (List.ofFn (f state.row)).take (state.column.1 + 1) = + List.ofFn (f state.row) := by + rw [hcolumn] + exact List.take_of_length_le (by simp) + rw [hfull] + have hrow : state.row.1 < (unaryMatrixRows f).length := by simp + have htake := List.take_concat_get hrow + have hget : (unaryMatrixRows f)[state.row.1] = + List.ofFn (f state.row) := by + simp [unaryMatrixRows] + rw [← hget, ← htake] + simpa only [List.concat_eq_append] using + (List.reverse_concat + (l := (unaryMatrixRows f).take state.row.1) + (a := (unaryMatrixRows f)[state.row.1])).symm + +theorem unaryMatrixCurrentCandidate_code_length_le {m : ℕ} + (f : Fin m → Fin m → ℚ) (state : UnaryGridSemanticState m) + (hdone : state.done = false) : + (binaryListCode rationalEntryBinaryCode + (f state.row state.column :: unaryMatrixCurrent f state)).length ≤ + (binaryListCode (binaryListCode rationalEntryBinaryCode) + (unaryMatrixRows f)).length := by + rw [unaryMatrixCurrentCandidate_eq f state hdone] + have hprefix := binaryListCode_take_reverse_length_le + rationalEntryBinaryCode (List.ofFn (f state.row)) + (state.column.1 + 1) + have hmem : List.ofFn (f state.row) ∈ unaryMatrixRows f := by + rw [unaryMatrixRows] + exact List.mem_ofFn.mpr ⟨state.row, rfl⟩ + exact hprefix.trans (binaryListCode_element_length_le + (binaryListCode rationalEntryBinaryCode) hmem) + +theorem unaryMatrixRowsCandidate_code_length_le {m : ℕ} + (f : Fin m → Fin m → ℚ) (state : UnaryGridSemanticState m) + (hdone : state.done = false) + (hcolumn : state.column.1 + 1 = m) : + (binaryListCode (binaryListCode rationalEntryBinaryCode) + ((f state.row state.column :: unaryMatrixCurrent f state).reverse :: + unaryMatrixCompletedRows f state)).length ≤ + (binaryListCode (binaryListCode rationalEntryBinaryCode) + (unaryMatrixRows f)).length := by + rw [unaryMatrixRowsCandidate_eq f state hdone hcolumn] + exact binaryListCode_take_reverse_length_le + (binaryListCode rationalEntryBinaryCode) (unaryMatrixRows f) + (state.row.1 + 1) + +theorem machineUnaryMatrixGeneratorStep_semanticCode {m : ℕ} + (entry : List Bool → List Bool) (f : Fin m → Fin m → ℚ) + (bound payload : List Bool) (state : UnaryGridSemanticState m) + (hentry : ∀ i j, + entry (pair (List.replicate i.1 true) + (pair (List.replicate j.1 true) payload)) = + rationalEntryBinaryCode (f i j)) + (hbound : + (binaryListCode (binaryListCode rationalEntryBinaryCode) + (unaryMatrixRows f)).length ≤ bound.length) : + machineUnaryMatrixGeneratorStep entry + (machineUnaryMatrixGeneratorSemanticCode f bound payload state) = + machineUnaryMatrixGeneratorSemanticCode f bound payload + (unaryGridSemanticStep f state) := by + rcases state with ⟨row, column, accumulator, done⟩ + cases done + · have hcurrentCandidate : + machineUnaryMatrixGeneratorCurrentCandidate entry + (machineUnaryMatrixGeneratorSemanticCode f bound payload + ⟨row, column, accumulator, false⟩) = + binaryListCode rationalEntryBinaryCode + (f row column :: + unaryMatrixCurrent f ⟨row, column, accumulator, false⟩) := by + rw [machineUnaryMatrixGeneratorCurrentCandidate, + machineUnaryMatrixGeneratorEntryInput_semanticCode, hentry] + simp [machineUnaryMatrixGeneratorSemanticCode, binaryListCode] + have hcurrentLarge : + (binaryListCode rationalEntryBinaryCode + (f row column :: + unaryMatrixCurrent f ⟨row, column, accumulator, false⟩)).length ≤ + bound.length := + (unaryMatrixCurrentCandidate_code_length_le f + ⟨row, column, accumulator, false⟩ rfl).trans hbound + have hnextCurrent : + machineUnaryMatrixGeneratorNextCurrent entry + (machineUnaryMatrixGeneratorSemanticCode f bound payload + ⟨row, column, accumulator, false⟩) = + binaryListCode rationalEntryBinaryCode + (f row column :: + unaryMatrixCurrent f ⟨row, column, accumulator, false⟩) := by + rw [machineUnaryMatrixGeneratorNextCurrent, hcurrentCandidate] + simp only [machineUnaryMatrixGeneratorSemanticCode, + machineUnaryMatrixGeneratorBound_pack] + exact List.take_of_length_le hcurrentLarge + have hcompletedRow : + machineUnaryMatrixGeneratorCompletedRow entry + (machineUnaryMatrixGeneratorSemanticCode f bound payload + ⟨row, column, accumulator, false⟩) = + binaryListCode rationalEntryBinaryCode + (f row column :: + unaryMatrixCurrent f + ⟨row, column, accumulator, false⟩).reverse := by + rw [machineUnaryMatrixGeneratorCompletedRow, hnextCurrent, + machineListReverse_encode] + have hcurrentEq := unaryMatrixCurrentCandidate_eq f + ⟨row, column, accumulator, false⟩ rfl + rw [hcurrentEq] at hnextCurrent + by_cases hcolumn : column.1 + 1 = m + · have hrowsCandidate : + machineUnaryMatrixGeneratorRowsCandidate entry + (machineUnaryMatrixGeneratorSemanticCode f bound payload + ⟨row, column, accumulator, false⟩) = + binaryListCode (binaryListCode rationalEntryBinaryCode) + ((f row column :: + unaryMatrixCurrent f + ⟨row, column, accumulator, false⟩).reverse :: + unaryMatrixCompletedRows f + ⟨row, column, accumulator, false⟩) := by + rw [machineUnaryMatrixGeneratorRowsCandidate, hcompletedRow] + simp [machineUnaryMatrixGeneratorSemanticCode, binaryListCode] + have hrowsLarge : + (binaryListCode (binaryListCode rationalEntryBinaryCode) + ((f row column :: + unaryMatrixCurrent f + ⟨row, column, accumulator, false⟩).reverse :: + unaryMatrixCompletedRows f + ⟨row, column, accumulator, false⟩)).length ≤ bound.length := + (unaryMatrixRowsCandidate_code_length_le f + ⟨row, column, accumulator, false⟩ rfl hcolumn).trans hbound + have hnextRows : + machineUnaryMatrixGeneratorNextRows entry + (machineUnaryMatrixGeneratorSemanticCode f bound payload + ⟨row, column, accumulator, false⟩) = + binaryListCode (binaryListCode rationalEntryBinaryCode) + ((f row column :: + unaryMatrixCurrent f + ⟨row, column, accumulator, false⟩).reverse :: + unaryMatrixCompletedRows f + ⟨row, column, accumulator, false⟩) := by + rw [machineUnaryMatrixGeneratorNextRows, hrowsCandidate] + simp only [machineUnaryMatrixGeneratorSemanticCode, + machineUnaryMatrixGeneratorBound_pack] + exact List.take_of_length_le hrowsLarge + have hrowsEq := unaryMatrixRowsCandidate_eq f + ⟨row, column, accumulator, false⟩ rfl hcolumn + rw [hrowsEq] at hnextRows + by_cases hrow : row.1 + 1 = m + · have htakeAll : (unaryMatrixRows f).take m = unaryMatrixRows f := by + exact List.take_of_length_le (by simp) + have hdoneFalse : + machineHeadBit (machineUnaryMatrixGeneratorDone + (machineUnaryMatrixGeneratorSemanticCode f bound payload + ⟨row, column, accumulator, false⟩)) = [false] := by + simp [machineUnaryMatrixGeneratorSemanticCode] + rw [machineUnaryMatrixGeneratorStep, hdoneFalse, + machineIfHead_false, machineUnaryMatrixGeneratorProcess, + machineUnaryMatrixGeneratorColumnCompletesBit_semanticCode] + simp only [hcolumn, decide_true, machineIfHead_true] + rw [machineUnaryMatrixGeneratorRowCompletesBit_semanticCode] + simp only [hrow, decide_true, machineIfHead_true] + rw [machineUnaryMatrixGeneratorFinish, hnextRows] + simp [unaryGridSemanticStep, hcolumn, hrow, + machineUnaryMatrixGeneratorSemanticCode, + unaryMatrixCurrent, unaryMatrixCompletedRows, + htakeAll, binaryListCode] + · have hdoneFalse : + machineHeadBit (machineUnaryMatrixGeneratorDone + (machineUnaryMatrixGeneratorSemanticCode f bound payload + ⟨row, column, accumulator, false⟩)) = [false] := by + simp [machineUnaryMatrixGeneratorSemanticCode] + rw [machineUnaryMatrixGeneratorStep, hdoneFalse, + machineIfHead_false, machineUnaryMatrixGeneratorProcess, + machineUnaryMatrixGeneratorColumnCompletesBit_semanticCode] + simp only [hcolumn, decide_true, machineIfHead_true] + rw [machineUnaryMatrixGeneratorRowCompletesBit_semanticCode] + simp only [hrow, decide_false, machineIfHead_false] + rw [machineUnaryMatrixGeneratorAdvanceRow, + machineUnaryMatrixGeneratorNextRow_semanticCode, hnextRows] + simp [unaryGridSemanticStep, hcolumn, hrow, + machineUnaryMatrixGeneratorSemanticCode, + unaryMatrixCurrent, unaryMatrixCompletedRows, binaryListCode] + · have hdoneFalse : + machineHeadBit (machineUnaryMatrixGeneratorDone + (machineUnaryMatrixGeneratorSemanticCode f bound payload + ⟨row, column, accumulator, false⟩)) = [false] := by + simp [machineUnaryMatrixGeneratorSemanticCode] + rw [machineUnaryMatrixGeneratorStep, hdoneFalse, + machineIfHead_false, machineUnaryMatrixGeneratorProcess, + machineUnaryMatrixGeneratorColumnCompletesBit_semanticCode] + simp only [hcolumn, decide_false, machineIfHead_false] + rw [machineUnaryMatrixGeneratorAdvanceColumn, + machineUnaryMatrixGeneratorNextColumn_semanticCode, hnextCurrent] + simp [unaryGridSemanticStep, hcolumn, + machineUnaryMatrixGeneratorSemanticCode, + unaryMatrixCurrent, unaryMatrixCompletedRows] + · simp [machineUnaryMatrixGeneratorStep, unaryGridSemanticStep, + machineUnaryMatrixGeneratorSemanticCode] + +theorem machineUnaryMatrixGeneratorInit_semanticCode {m : ℕ} + (hm : 0 < m) (f : Fin m → Fin m → ℚ) + (bound payload : List Bool) : + machineUnaryMatrixGeneratorInit + (machineUnaryMatrixGeneratorCanonicalWord m bound payload) = + machineUnaryMatrixGeneratorSemanticCode f bound payload + (unaryGridSemanticInit hm) := by + rw [machineUnaryMatrixGeneratorInit, + machineUnaryMatrixGeneratorInputBound_encode] + simp [machineUnaryMatrixGeneratorSemanticCode, unaryGridSemanticInit, + machineUnaryMatrixGeneratorCanonicalWord, unaryMatrixCurrent, + unaryMatrixCompletedRows, binaryListCode] + +theorem machineUnaryMatrixGeneratorIterate_semanticCode {m : ℕ} + (hm : 0 < m) (entry : List Bool → List Bool) + (f : Fin m → Fin m → ℚ) (bound payload : List Bool) + (hentry : ∀ i j, + entry (pair (List.replicate i.1 true) + (pair (List.replicate j.1 true) payload)) = + rationalEntryBinaryCode (f i j)) + (hbound : + (binaryListCode (binaryListCode rationalEntryBinaryCode) + (unaryMatrixRows f)).length ≤ bound.length) : ∀ k, + (machineUnaryMatrixGeneratorStep entry)^[k] + (machineUnaryMatrixGeneratorInit + (machineUnaryMatrixGeneratorCanonicalWord m bound payload)) = + machineUnaryMatrixGeneratorSemanticCode f bound payload + (unaryGridSemanticStateAt hm f k) := by + intro k + induction k with + | zero => exact machineUnaryMatrixGeneratorInit_semanticCode hm f bound payload + | succ k ih => + rw [Function.iterate_succ_apply', ih] + simpa only [unaryGridSemanticStateAt, + Function.iterate_succ_apply'] using + machineUnaryMatrixGeneratorStep_semanticCode + entry f bound payload (unaryGridSemanticStateAt hm f k) + hentry hbound + +theorem unaryGridSemanticStateAt_full_done {m : ℕ} + (hm : 0 < m) (f : Fin m → Fin m → ℚ) : + (unaryGridSemanticStateAt hm f (m * m)).done = true := by + have hinvariant := unaryGridSemanticStateAt_valueInvariant hm f (m * m) + rcases hinvariant with hdone | hactive + · exact hdone.1 + · have hord := hactive.2.1 + have hlt := unaryGridOrdinal_lt_square + (unaryGridSemanticStateAt hm f (m * m)).row + (unaryGridSemanticStateAt hm f (m * m)).column + omega + +theorem machineUnaryMatrixGeneratorReversedRowsCode_encode_of_bound {m : ℕ} + (entry : List Bool → List Bool) (f : Fin m → Fin m → ℚ) + (bound payload : List Bool) + (hentry : ∀ i j, + entry (pair (List.replicate i.1 true) + (pair (List.replicate j.1 true) payload)) = + rationalEntryBinaryCode (f i j)) + (hbound : + (binaryListCode (binaryListCode rationalEntryBinaryCode) + (unaryMatrixRows f)).length ≤ bound.length) : + machineUnaryMatrixGeneratorReversedRowsCode entry + (machineUnaryMatrixGeneratorCanonicalWord m bound payload) = + binaryListCode (binaryListCode rationalEntryBinaryCode) + (unaryMatrixRows f).reverse := by + cases m with + | zero => + rw [machineUnaryMatrixGeneratorReversedRowsCode, + machineUnaryMatrixGeneratorFinalState, + machineUnaryMatrixGeneratorRuler_encode] + simp [machineUnaryMatrixGeneratorInit, + machineUnaryMatrixGeneratorCanonicalWord, + unaryMatrixRows, binaryListCode] + | succ m => + have hm : 0 < m + 1 := by omega + rw [machineUnaryMatrixGeneratorReversedRowsCode, + machineUnaryMatrixGeneratorFinalState, + machineUnaryMatrixGeneratorRuler_encode, List.length_replicate, + machineUnaryMatrixGeneratorIterate_semanticCode hm entry f + bound payload hentry hbound ((m + 1) * (m + 1))] + simp only [machineUnaryMatrixGeneratorSemanticCode, + machineUnaryMatrixGeneratorRows_pack] + rw [unaryMatrixCompletedRows, + unaryGridSemanticStateAt_full_done hm f] + simp + +theorem machineUnaryMatrixGeneratorRowsCode_encode_of_bound {m : ℕ} + (entry : List Bool → List Bool) (f : Fin m → Fin m → ℚ) + (bound payload : List Bool) + (hentry : ∀ i j, + entry (pair (List.replicate i.1 true) + (pair (List.replicate j.1 true) payload)) = + rationalEntryBinaryCode (f i j)) + (hbound : + (binaryListCode (binaryListCode rationalEntryBinaryCode) + (unaryMatrixRows f)).length ≤ bound.length) : + machineUnaryMatrixGeneratorRowsCode entry + (machineUnaryMatrixGeneratorCanonicalWord m bound payload) = + binaryListCode (binaryListCode rationalEntryBinaryCode) + (unaryMatrixRows f) := by + rw [machineUnaryMatrixGeneratorRowsCode, + machineUnaryMatrixGeneratorReversedRowsCode_encode_of_bound + entry f bound payload hentry hbound, + machineListReverse_encode, List.reverse_reverse] + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineUnaryRange.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineUnaryRange.lean new file mode 100644 index 0000000000..cdff453abc --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineUnaryRange.lean @@ -0,0 +1,331 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineMateMemory +import LeanPool.BeyondBethe.BeyondBethe.KuhnSmallStep + +/-! +# Constructing the unary column range + +The matching evaluator scans `List.finRange n`. This module constructs its +right-nested finite-word encoding from the unary dimension ruler. The +constructor counts down and prepends, so after `n` steps the values occur in +the required increasing order `0,1,...,n-1`. +-/ + +namespace BeyondBethe + +open Complexity + +def finUnaryCode {n : ℕ} (i : Fin n) : List Bool := + List.replicate i.1 true + +def finRangeUnaryCode (n : ℕ) : List Bool := + binaryListCode finUnaryCode (List.finRange n) + +def machineUnaryRangePack + (remaining acc bound : List Bool) : List Bool := + pair remaining (pair acc bound) + +def machineUnaryRangeRemaining (state : List Bool) : List Bool := + machinePairFirst state + +def machineUnaryRangeAcc (state : List Bool) : List Bool := + machinePairFirst (machinePairSecond state) + +def machineUnaryRangeBound (state : List Bool) : List Bool := + machinePairSecond (machinePairSecond state) + +def machineUnaryRangeCandidate (state : List Bool) : List Bool := + pair (machineUnaryRangeRemaining state).tail + (machineUnaryRangeAcc state) + +def machineUnaryRangeNextAcc (state : List Bool) : List Bool := + (machineUnaryRangeCandidate state).take + (machineUnaryRangeBound state).length + +def machineUnaryRangeStep (state : List Bool) : List Bool := + machineIfEmpty (machineUnaryRangeRemaining state) state + (machineUnaryRangePack (machineUnaryRangeRemaining state).tail + (machineUnaryRangeNextAcc state) (machineUnaryRangeBound state)) + +def machineUnaryRangeInputBound (ruler : List Bool) : List Bool := + machineListUpdateInputBound ruler + +def machineUnaryRangeInit (ruler : List Bool) : List Bool := + machineUnaryRangePack ruler [] (machineUnaryRangeInputBound ruler) + +def machineUnaryRangeWidth (ruler : List Bool) : List Bool := + let bound := machineUnaryRangeInputBound ruler + machineUnaryRangePack bound bound bound + +def machineUnaryRangeFinalState (ruler : List Bool) : List Bool := + (machineUnaryRangeStep)^[ruler.length] (machineUnaryRangeInit ruler) + +def machineUnaryRangeCode (ruler : List Bool) : List Bool := + machineUnaryRangeAcc (machineUnaryRangeFinalState ruler) + +theorem machineUnaryRangeRemaining_mem_FP : + machineUnaryRangeRemaining ∈ Complexity.FP := machinePairFirst_mem_FP + +theorem machineUnaryRangeAcc_mem_FP : + machineUnaryRangeAcc ∈ Complexity.FP := by + simpa only [machineUnaryRangeAcc] using + machineCompose_mem_FP machinePairSecond_mem_FP machinePairFirst_mem_FP + +theorem machineUnaryRangeBound_mem_FP : + machineUnaryRangeBound ∈ Complexity.FP := by + simpa only [machineUnaryRangeBound] using + machineCompose_mem_FP machinePairSecond_mem_FP machinePairSecond_mem_FP + +theorem machineUnaryRangeCandidate_mem_FP : + machineUnaryRangeCandidate ∈ Complexity.FP := by + have hremainingTail := machineCompose_mem_FP + machineUnaryRangeRemaining_mem_FP machineTail_mem_FP + exact machinePair_mem_FP hremainingTail machineUnaryRangeAcc_mem_FP + +theorem machineUnaryRangeNextAcc_mem_FP : + machineUnaryRangeNextAcc ∈ Complexity.FP := by + simpa only [machineUnaryRangeNextAcc] using + machineTake_mem_FP machineUnaryRangeBound_mem_FP + machineUnaryRangeCandidate_mem_FP + +theorem machineUnaryRangeStep_mem_FP : + machineUnaryRangeStep ∈ Complexity.FP := by + have hremainingTail := machineCompose_mem_FP + machineUnaryRangeRemaining_mem_FP machineTail_mem_FP + have hadvance := machinePair_mem_FP hremainingTail + (machinePair_mem_FP machineUnaryRangeNextAcc_mem_FP + machineUnaryRangeBound_mem_FP) + exact machineIfEmpty_mem_FP machineUnaryRangeRemaining_mem_FP id_mem_FP + hadvance + +theorem machineUnaryRangeInputBound_mem_FP : + machineUnaryRangeInputBound ∈ Complexity.FP := + machineListUpdateInputBound_mem_FP + +theorem machineUnaryRangeInit_mem_FP : + machineUnaryRangeInit ∈ Complexity.FP := by + exact machinePair_mem_FP id_mem_FP + (machinePair_mem_FP (machineConst_mem_FP []) + machineUnaryRangeInputBound_mem_FP) + +theorem machineUnaryRangeWidth_mem_FP : + machineUnaryRangeWidth ∈ Complexity.FP := by + exact machinePair_mem_FP machineUnaryRangeInputBound_mem_FP + (machinePair_mem_FP machineUnaryRangeInputBound_mem_FP + machineUnaryRangeInputBound_mem_FP) + +@[simp] theorem machineUnaryRangeRemaining_pack (a b c) : + machineUnaryRangeRemaining (machineUnaryRangePack a b c) = a := by + simp [machineUnaryRangeRemaining, machineUnaryRangePack] + +@[simp] theorem machineUnaryRangeAcc_pack (a b c) : + machineUnaryRangeAcc (machineUnaryRangePack a b c) = b := by + simp [machineUnaryRangeAcc, machineUnaryRangePack] + +@[simp] theorem machineUnaryRangeBound_pack (a b c) : + machineUnaryRangeBound (machineUnaryRangePack a b c) = c := by + simp [machineUnaryRangeBound, machineUnaryRangePack] + +def MachineUnaryRangeStateBound (ruler state : List Bool) : Prop := + let B := (machineUnaryRangeInputBound ruler).length + state = machineUnaryRangePack + (machineUnaryRangeRemaining state) + (machineUnaryRangeAcc state) + (machineUnaryRangeBound state) ∧ + (machineUnaryRangeRemaining state).length ≤ B ∧ + (machineUnaryRangeAcc state).length ≤ B ∧ + (machineUnaryRangeBound state).length ≤ B + +theorem machineUnaryRange_ruler_le_bound (ruler : List Bool) : + ruler.length ≤ (machineUnaryRangeInputBound ruler).length := by + simp only [machineUnaryRangeInputBound, machineListUpdateInputBound, + machineBinaryMulWidth, List.length_replicate, List.length_append] + nlinarith + +theorem machineUnaryRangeInit_bound (ruler : List Bool) : + MachineUnaryRangeStateBound ruler (machineUnaryRangeInit ruler) := by + simp only [MachineUnaryRangeStateBound, machineUnaryRangeInit, + machineUnaryRangeRemaining_pack, machineUnaryRangeAcc_pack, + machineUnaryRangeBound_pack] + exact ⟨trivial, machineUnaryRange_ruler_le_bound ruler, by simp, le_rfl⟩ + +theorem machineUnaryRangeStep_bound {ruler state : List Bool} + (hstate : MachineUnaryRangeStateBound ruler state) : + MachineUnaryRangeStateBound ruler (machineUnaryRangeStep state) := by + dsimp only [MachineUnaryRangeStateBound] at hstate ⊢ + rcases hstate with ⟨hpack, hremaining, hacc, hbound⟩ + cases hremainingEq : machineUnaryRangeRemaining state with + | nil => + rw [hremainingEq] at hpack hremaining + rw [machineUnaryRangeStep] + simp only [hremainingEq, machineIfEmpty_nil] + exact ⟨hpack, hremaining, hacc, hbound⟩ + | cons bit tail => + have htail : tail.length ≤ + (machineUnaryRangeInputBound ruler).length := by + rw [hremainingEq] at hremaining + simp only [List.length_cons] at hremaining + omega + rw [machineUnaryRangeStep] + simp only [hremainingEq, machineIfEmpty_cons, + machineUnaryRangeRemaining_pack, machineUnaryRangeAcc_pack, + machineUnaryRangeBound_pack] + refine ⟨trivial, htail, ?_, hbound⟩ + · simp only [machineUnaryRangeNextAcc, List.length_take] + exact (Nat.min_le_left _ _).trans hbound + +theorem machineUnaryRangeIterate_bound (ruler : List Bool) : ∀ k, + MachineUnaryRangeStateBound ruler + ((machineUnaryRangeStep)^[k] (machineUnaryRangeInit ruler)) := by + intro k + induction k with + | zero => simpa using machineUnaryRangeInit_bound ruler + | succ k ih => + rw [Function.iterate_succ_apply'] + exact machineUnaryRangeStep_bound ih + +theorem machineUnaryRangeIterate_length_le_width + (ruler : List Bool) (iterations : ℕ) + (_ : iterations ≤ ruler.length) : + ((machineUnaryRangeStep)^[iterations] + (machineUnaryRangeInit ruler)).length ≤ + (machineUnaryRangeWidth ruler).length := by + have hbound := machineUnaryRangeIterate_bound ruler iterations + dsimp only [MachineUnaryRangeStateBound] at hbound + rcases hbound with ⟨hpack, hremaining, hacc, hbound⟩ + rw [hpack] + simp only [machineUnaryRangePack, machineUnaryRangeWidth, pair_length] + omega + +theorem machineUnaryRangeFinalState_mem_FP : + machineUnaryRangeFinalState ∈ Complexity.FP := by + exact Cobham.iterate_mem_FP machineUnaryRangeStep_mem_FP + machineUnaryRangeInit_mem_FP id_mem_FP machineUnaryRangeWidth_mem_FP + machineUnaryRangeIterate_length_le_width + +theorem machineUnaryRangeCode_mem_FP : + machineUnaryRangeCode ∈ Complexity.FP := by + simpa only [machineUnaryRangeCode] using + machineCompose_mem_FP machineUnaryRangeFinalState_mem_FP + machineUnaryRangeAcc_mem_FP + +/-! ## Exact semantics -/ + +def machineUnaryRangeSemanticState (n k : ℕ) : List Bool := + machineUnaryRangePack (List.replicate (n - k) true) + (binaryListCode finUnaryCode ((List.finRange n).drop (n - k))) + (machineUnaryRangeInputBound (List.replicate n true)) + +theorem finRangeUnaryCode_length_le_bound (n : ℕ) : + (finRangeUnaryCode n).length ≤ + (machineUnaryRangeInputBound (List.replicate n true)).length := by + rw [finRangeUnaryCode, binaryListCode_length_eq_sum] + have heach : ∀ i ∈ List.finRange n, + (finUnaryCode i).length ≤ n := by + intro i _ + simpa [finUnaryCode] using i.isLt.le + have hsum : + ((List.finRange n).map fun i ↦ 2 * (finUnaryCode i).length + 2).sum ≤ + n * (2 * n + 2) := by + have h := List.sum_le_card_nsmul + ((List.finRange n).map fun i ↦ 2 * (finUnaryCode i).length + 2) + (2 * n + 2) (by + intro value hvalue + rw [List.mem_map] at hvalue + obtain ⟨i, hi, rfl⟩ := hvalue + have := heach i hi + omega) + simpa [List.length_finRange, Nat.nsmul_eq_mul] using h + simp only [machineUnaryRangeInputBound, machineListUpdateInputBound, + machineBinaryMulWidth, List.length_replicate, List.length_append] + exact hsum.trans (by nlinarith) + +@[simp] theorem machineUnaryRangeSemanticState_zero (n : ℕ) : + machineUnaryRangeSemanticState n 0 = + machineUnaryRangeInit (List.replicate n true) := by + rw [machineUnaryRangeSemanticState, machineUnaryRangeInit, + List.drop_eq_nil_of_le (by simp)] + rfl + +theorem machineUnaryRangeSemanticState_step (n k : ℕ) (hk : k < n) : + machineUnaryRangeStep (machineUnaryRangeSemanticState n k) = + machineUnaryRangeSemanticState n (k + 1) := by + have hindex : n - k - 1 < (List.finRange n).length := by + simp only [List.length_finRange] + omega + have hdrop : + (List.finRange n).drop (n - k - 1) = + ⟨n - k - 1, by omega⟩ :: (List.finRange n).drop (n - k) := by + convert List.drop_eq_getElem_cons hindex using 1 <;> + simp [List.getElem_finRange] <;> omega + have hcandidateLength : + (pair (List.replicate (n - k - 1) true) + (binaryListCode finUnaryCode + ((List.finRange n).drop (n - k)))).length ≤ + (machineUnaryRangeInputBound (List.replicate n true)).length := by + rw [show pair (List.replicate (n - k - 1) true) + (binaryListCode finUnaryCode ((List.finRange n).drop (n - k))) = + binaryListCode finUnaryCode ((List.finRange n).drop (n - k - 1)) by + rw [hdrop] + rfl] + exact (binaryListCode_drop_length_le finUnaryCode (List.finRange n) + (n - k - 1)).trans (finRangeUnaryCode_length_le_bound n) + have hsub : n - k = (n - k - 1) + 1 := by omega + have htake : + (pair (List.replicate (n - k - 1) true) + (binaryListCode finUnaryCode + ((List.finRange n).drop (n - k)))).take + (machineUnaryRangeInputBound (List.replicate n true)).length = + pair (List.replicate (n - k - 1) true) + (binaryListCode finUnaryCode + ((List.finRange n).drop (n - k))) := + (List.take_eq_self_iff _).2 hcandidateLength + have htake' : + (pair (List.replicate (n - k - 1) true) + (binaryListCode finUnaryCode + ((List.finRange n).drop (n - k - 1 + 1)))).take + (machineUnaryRangeInputBound (List.replicate n true)).length = + pair (List.replicate (n - k - 1) true) + (binaryListCode finUnaryCode + ((List.finRange n).drop (n - k - 1 + 1))) := by + simpa only [← hsub] using htake + have hnext : n - (k + 1) = n - k - 1 := by omega + rw [machineUnaryRangeSemanticState, hsub, List.replicate_succ, + machineUnaryRangeStep] + simp only [machineUnaryRangeSemanticState, + machineUnaryRangeRemaining_pack, machineIfEmpty_cons, + machineUnaryRangeAcc_pack, machineUnaryRangeBound_pack, + machineUnaryRangeNextAcc, machineUnaryRangeCandidate, + List.tail_cons, htake'] + unfold machineUnaryRangePack + apply congrArg₂ pair + · congr 1 + · apply congrArg₂ pair + · rw [hnext, hdrop] + rw [← hsub] + rfl + · rfl + +theorem machineUnaryRangeIterate_semantics (n k : ℕ) (hk : k ≤ n) : + (machineUnaryRangeStep)^[k] + (machineUnaryRangeInit (List.replicate n true)) = + machineUnaryRangeSemanticState n k := by + induction k with + | zero => exact (machineUnaryRangeSemanticState_zero n).symm + | succ k ih => + rw [Function.iterate_succ_apply', ih (by omega), + machineUnaryRangeSemanticState_step n k (by omega)] + +@[simp] theorem machineUnaryRangeCode_encode (n : ℕ) : + machineUnaryRangeCode (List.replicate n true) = finRangeUnaryCode n := by + rw [machineUnaryRangeCode, machineUnaryRangeFinalState, + List.length_replicate, machineUnaryRangeIterate_semantics n n le_rfl, + machineUnaryRangeSemanticState, machineUnaryRangeAcc_pack] + simp [finRangeUnaryCode] + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/Main.lean b/LeanPool/BeyondBethe/BeyondBethe/Main.lean new file mode 100644 index 0000000000..f3c1f4edc5 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/Main.lean @@ -0,0 +1,255 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.FinalAssembly +import LeanPool.BeyondBethe.BeyondBethe.ExplicitPositiveRoutine +import LeanPool.BeyondBethe.BeyondBethe.ExplicitScales +import LeanPool.BeyondBethe.BeyondBethe.SourceAnariRezaeiList +import LeanPool.BeyondBethe.BeyondBethe.SourceStableReindex +import LeanPool.BeyondBethe.BeyondBethe.MachineCompletedAlgorithm +import LeanPool.BeyondBethe.BeyondBethe.MachinePositiveAlgorithm +import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerCertificateBoundary +import LeanPool.BeyondBethe.BeyondBethe.MachineExplicitCertificate +import LeanPool.BeyondBethe.BeyondBethe.ExecutablePositiveRoutine +import LeanPool.BeyondBethe.BeyondBethe.MachineExecutablePositiveAlgorithm + +/-! # Main -/ + +namespace BeyondBethe + +/-- A faithful algorithmic statement of Theorem 1 contains both the +two-sided approximation guarantee and a concrete Turing-machine +polynomial-time claim. -/ +structure TheoremOneSpec where + c : ℝ + alg : ∀ n, Matrix (Fin n) (Fin n) ℚ → ℚ + guarantee : ApproximationGuarantee alg c + polynomialTime : RunsInPolynomialTime alg + +/-- The internally reconstructed source theorems imply the exact +positive-matrix certificate used by the numerical layer. -/ +theorem exists_exactPositiveCertificate : + ∃ ε : ℝ, 0 < ε ∧ ExactPositiveCertificate ε := by + simpa only [ExactPositiveCertificate] using + exists_absolute_positiveMatrix_logApproximation + anariOveisGharanStableCoefficient + +/-- The one fixed rational algorithm used in the final theorem. -/ +def explicitTheoremOneAlgorithm : + ∀ n, Matrix (Fin n) (Fin n) ℚ → ℚ := + completedAlgorithm explicitCertifiedPositiveRoutine + (canonicalSmoothingParameter explicitCertifiedEpsilon) + +theorem explicitCertifiedEpsilon_le_quarter : + explicitCertifiedEpsilon ≤ (1 / 4 : ℚ) := by + rw [explicitCertifiedEpsilon, explicitCertifiedEpsilon_eq] + have hδ : explicitDelta ≤ (1 / 200000 : ℚ) := by + have hcast := explicitDelta_le_rowRatio + have hcast' : (explicitDelta : ℝ) ≤ ((1 / 200000 : ℚ) : ℝ) := by + norm_num [explicitRowRatio] at hcast ⊢ + exact hcast + exact Rat.cast_le.mp hcast' + calc + explicitDelta - explicitXi ≤ explicitDelta := + sub_le_self _ explicitXi_pos.le + _ ≤ 1 / 200000 := hδ + _ ≤ 1 / 4 := by norm_num + +/-- The mathematical approximation guarantee of the fixed algorithm is +unconditional; no numerical-oracle interface remains in this statement. -/ +theorem explicitTheoremOneAlgorithm_guarantee : + ApproximationGuarantee explicitTheoremOneAlgorithm + (finalBase (explicitCertifiedEpsilon : ℝ)) := by + have hεq : 0 < explicitCertifiedEpsilon := explicitCertifiedEpsilon_pos + have hε : 0 < (explicitCertifiedEpsilon : ℝ) := by + exact_mod_cast hεq + have hquarter : (explicitCertifiedEpsilon : ℝ) ≤ 1 / 4 := by + have hcast : (explicitCertifiedEpsilon : ℝ) ≤ ((1 / 4 : ℚ) : ℝ) := by + exact_mod_cast explicitCertifiedEpsilon_le_quarter + norm_num at hcast ⊢ + exact hcast + have hεbound : (explicitCertifiedEpsilon : ℝ) ≤ Real.log 2 / 2 := by + nlinarith [Real.one_sub_inv_le_log_of_pos + (by norm_num : (0 : ℝ) < 2)] + refine ⟨finalBase_pos _, finalBase_lt_sqrtTwo hε, ?_⟩ + simpa only [explicitTheoremOneAlgorithm] using + completedAlgorithm_guarantee hε hεbound + explicitCertifiedPositiveRoutine + (canonicalSmoothingParameter explicitCertifiedEpsilon) + (canonicalSmoothingParameter_pos hεq) + (canonicalSmoothingParameter_le_half hεq) + +theorem explicitTheoremOneAlgorithm_runsInPolynomialTime_of_rawPositiveMachine + {positiveMachine : List Bool → List Bool} + (hpositiveFP : positiveMachine ∈ Complexity.FP) + (hrealizes : RawStringRealizes positiveMachine + explicitCertifiedPositiveRoutine.alg) : + RunsInPolynomialTime explicitTheoremOneAlgorithm := by + simpa only [explicitTheoremOneAlgorithm] using + completedAlgorithm_runsInPolynomialTime_of_rawMachine + explicitCertifiedPositiveRoutine hpositiveFP hrealizes + (canonicalSmoothingParameter explicitCertifiedEpsilon) + +theorem explicitTheoremOneAlgorithm_runsInPolynomialTime_of_positive_rawMachine + {positiveMachine : List Bool → List Bool} + (hpositiveFP : positiveMachine ∈ Complexity.FP) + (hrealizes : PositiveRawStringRealizes positiveMachine + explicitCertifiedPositiveRoutine.alg) : + RunsInPolynomialTime explicitTheoremOneAlgorithm := by + simpa only [explicitTheoremOneAlgorithm] using + completedAlgorithm_runsInPolynomialTime_of_positive_rawMachine + explicitCertifiedPositiveRoutine hpositiveFP hrealizes + (canonicalSmoothingParameter explicitCertifiedEpsilon) + (canonicalSmoothingParameter_pos explicitCertifiedEpsilon_pos) + +/-- Compatibility statement for the earlier semantic optimizer: a raw-machine +proof for that particular tie-breaking choice still yields Theorem 1. -/ +theorem theoremOne_of_explicitPolynomialTime + (polynomialTime : RunsInPolynomialTime explicitTheoremOneAlgorithm) : + Nonempty TheoremOneSpec := by + exact ⟨ + { c := finalBase (explicitCertifiedEpsilon : ℝ) + alg := explicitTheoremOneAlgorithm + guarantee := explicitTheoremOneAlgorithm_guarantee + polynomialTime := polynomialTime }⟩ + +theorem theoremOne_of_normalizedCertificateMachine + {certificateMachine : List Bool → List Bool} + (hcertificateFP : certificateMachine ∈ Complexity.FP) + (hrealizes : RawStringRealizes certificateMachine + explicitNormalizedCertificateAlgorithm) : + Nonempty TheoremOneSpec := by + let positiveMachine := machinePositiveAlgorithmRawCode certificateMachine + have hpositiveFP : positiveMachine ∈ Complexity.FP := + machinePositiveAlgorithmRawCode_mem_FP hcertificateFP + have hpositiveRealizes : + RawStringRealizes positiveMachine explicitPositiveAlgorithm := + machinePositiveAlgorithmRawCode_realizes hrealizes + exact theoremOne_of_explicitPolynomialTime + (explicitTheoremOneAlgorithm_runsInPolynomialTime_of_rawPositiveMachine + hpositiveFP hpositiveRealizes) + +theorem theoremOne_of_normalizedCertificateMachine_onPositive + {certificateMachine : List Bool → List Bool} + (hcertificateFP : certificateMachine ∈ Complexity.FP) + (hrealizes : + NormalizedCertificateStringRealizesOnPositive certificateMachine) : + Nonempty TheoremOneSpec := by + let positiveMachine := machinePositiveAlgorithmRawCode certificateMachine + have hpositiveFP : positiveMachine ∈ Complexity.FP := + machinePositiveAlgorithmRawCode_mem_FP hcertificateFP + have hpositiveRealizes : + PositiveRawStringRealizes positiveMachine explicitPositiveAlgorithm := + machinePositiveAlgorithmRawCode_realizes_onPositive hrealizes + exact theoremOne_of_explicitPolynomialTime + (explicitTheoremOneAlgorithm_runsInPolynomialTime_of_positive_rawMachine + hpositiveFP hpositiveRealizes) + +/-- Machine-checked Theorem 1 from separate finite-word implementations of +the normalized optimizer and the directed certificate evaluator. -/ +theorem theoremOne_of_optimizer_and_certificate_machines + {optimizerMachine certificateMachine : List Bool → List Bool} + (hoptimizerFP : optimizerMachine ∈ Complexity.FP) + (hoptimizer : LargeOptimizerStringRealizes optimizerMachine) + (hcertificateFP : certificateMachine ∈ Complexity.FP) + (hcertificate : CertificateEvaluatorStringRealizes certificateMachine) : + Nonempty TheoremOneSpec := by + let normalizedMachine := machineNormalizedCertificateFromParts + optimizerMachine certificateMachine + have hnormalizedFP : normalizedMachine ∈ Complexity.FP := + machineNormalizedCertificateFromParts_mem_FP + hoptimizerFP hcertificateFP + have hnormalizedRealizes : RawStringRealizes normalizedMachine + explicitNormalizedCertificateAlgorithm := + machineNormalizedCertificateFromParts_realizes + hoptimizer hcertificate + exact theoremOne_of_normalizedCertificateMachine + hnormalizedFP hnormalizedRealizes + +/-- Machine-checked Theorem 1 from machines whose certificate contract is +restricted to the positive normalized inputs used by the algorithm. -/ +theorem theoremOne_of_optimizer_and_certificate_machines_onPositive + {optimizerMachine certificateMachine : List Bool → List Bool} + (hoptimizerFP : optimizerMachine ∈ Complexity.FP) + (hoptimizer : LargeOptimizerStringRealizes optimizerMachine) + (hcertificateFP : certificateMachine ∈ Complexity.FP) + (hcertificate : + CertificateEvaluatorStringRealizesOnPositiveNormalized certificateMachine) : + Nonempty TheoremOneSpec := by + let normalizedMachine := machineNormalizedCertificateFromParts + optimizerMachine certificateMachine + have hnormalizedFP : normalizedMachine ∈ Complexity.FP := + machineNormalizedCertificateFromParts_mem_FP + hoptimizerFP hcertificateFP + have hnormalizedRealizes : + NormalizedCertificateStringRealizesOnPositive normalizedMachine := + machineNormalizedCertificateFromParts_realizes_onPositive + hoptimizer hcertificate + exact theoremOne_of_normalizedCertificateMachine_onPositive + hnormalizedFP hnormalizedRealizes + +/-- Legacy modular assembly theorem for replacing the semantic optimizer by +any finite-word implementation satisfying the older exact-output contract. -/ +theorem theoremOne_of_optimizerMachine + {optimizerMachine : List Bool → List Bool} + (hoptimizerFP : optimizerMachine ∈ Complexity.FP) + (hoptimizer : LargeOptimizerStringRealizes optimizerMachine) : + Nonempty TheoremOneSpec := by + exact theoremOne_of_optimizer_and_certificate_machines_onPositive + hoptimizerFP hoptimizer + machineExplicitCertificateValueRawCode_mem_FP + machineExplicitCertificateValueRawCode_realizes_onPositive + +/-! ## Unconditional executable Theorem 1 -/ + +/-- The completed rational algorithm using the verified row-major optimizer. -/ +def executableTheoremOneAlgorithm : + ∀ n, Matrix (Fin n) (Fin n) ℚ → ℚ := + completedAlgorithm executableCertifiedPositiveRoutine + (canonicalSmoothingParameter explicitCertifiedEpsilon) + +theorem executableTheoremOneAlgorithm_guarantee : + ApproximationGuarantee executableTheoremOneAlgorithm + (finalBase (explicitCertifiedEpsilon : ℝ)) := by + have hεq : 0 < explicitCertifiedEpsilon := explicitCertifiedEpsilon_pos + have hε : 0 < (explicitCertifiedEpsilon : ℝ) := by + exact_mod_cast hεq + have hεbound : (explicitCertifiedEpsilon : ℝ) ≤ Real.log 2 / 2 := by + have hquarter : (explicitCertifiedEpsilon : ℝ) ≤ 1 / 4 := by + have hcast : (explicitCertifiedEpsilon : ℝ) ≤ ((1 / 4 : ℚ) : ℝ) := by + exact_mod_cast explicitCertifiedEpsilon_le_quarter + norm_num at hcast ⊢ + exact hcast + nlinarith [Real.one_sub_inv_le_log_of_pos + (by norm_num : (0 : ℝ) < 2)] + refine ⟨finalBase_pos _, finalBase_lt_sqrtTwo hε, ?_⟩ + simpa only [executableTheoremOneAlgorithm] using + completedAlgorithm_guarantee hε hεbound + executableCertifiedPositiveRoutine + (canonicalSmoothingParameter explicitCertifiedEpsilon) + (canonicalSmoothingParameter_pos hεq) + (canonicalSmoothingParameter_le_half hεq) + +theorem executableTheoremOneAlgorithm_runsInPolynomialTime : + RunsInPolynomialTime executableTheoremOneAlgorithm := by + simpa only [executableTheoremOneAlgorithm] using + completedAlgorithm_runsInPolynomialTime_of_positive_rawMachine + executableCertifiedPositiveRoutine + machineExecutablePositiveAlgorithmRawCode_mem_FP + machineExecutablePositiveAlgorithmRawCode_realizes_onPositive + (canonicalSmoothingParameter explicitCertifiedEpsilon) + (canonicalSmoothingParameter_pos explicitCertifiedEpsilon_pos) + +/-- Fully machine-checked Theorem 1. Both the approximation guarantee and the +ordinary finite-word polynomial-time implementation are constructed here. -/ +theorem theoremOne : Nonempty TheoremOneSpec := by + exact ⟨ + { c := finalBase (explicitCertifiedEpsilon : ℝ) + alg := executableTheoremOneAlgorithm + guarantee := executableTheoremOneAlgorithm_guarantee + polynomialTime := executableTheoremOneAlgorithm_runsInPolynomialTime }⟩ + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MatchingAlgorithm.lean b/LeanPool/BeyondBethe/BeyondBethe/MatchingAlgorithm.lean new file mode 100644 index 0000000000..f7bcd119b7 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MatchingAlgorithm.lean @@ -0,0 +1,37 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.Permanent +import Mathlib.Tactic + +/-! # Matching Algorithm -/ + +namespace BeyondBethe + +/-! +# Executable support matching + +This first executable decision procedure is the finite reference +specification. A polynomial augmenting-path implementation will be proved +extensionally equal to it below; the wrapper can therefore remain independent +of propositional decidability throughout that refinement. +-/ + +def supportMatchingDecision {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) : Bool := + decide (∃ σ : Equiv.Perm (Fin n), ∀ i, A (σ i) i ≠ 0) + +theorem supportMatchingDecision_eq_true_iff {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) : + supportMatchingDecision A = true ↔ Matrix.HasPerfectMatching A := by + simp [supportMatchingDecision, Matrix.HasPerfectMatching] + +theorem supportMatchingDecision_eq_false_iff {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) : + supportMatchingDecision A = false ↔ ¬Matrix.HasPerfectMatching A := by + simp [supportMatchingDecision, Matrix.HasPerfectMatching] + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MatrixPerturbation.lean b/LeanPool/BeyondBethe/BeyondBethe/MatrixPerturbation.lean new file mode 100644 index 0000000000..cb45d26a60 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/MatrixPerturbation.lean @@ -0,0 +1,205 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.DyadicRounding +import Mathlib.Algebra.Order.BigOperators.Group.Finset +import Mathlib.Algebra.Order.BigOperators.Ring.Finset +import Mathlib.LinearAlgebra.Matrix.Adjugate +import Mathlib.Tactic + +/-! # Matrix Perturbation -/ + +open scoped BigOperators + +namespace BeyondBethe + +/-! +# Entrywise perturbation bounds for finite matrices + +These estimates are intentionally elementary. They expand the determinant +as a finite signed sum and bound each product by induction. This avoids +appealing to an unformalized operator-norm or numerical linear-algebra result +in the rounded ellipsoid proof. +-/ + +theorem abs_finset_prod_le_pow {ι : Type*} {s : Finset ι} + (f : ι → ℝ) {M : ℝ} (hM : 0 ≤ M) + (hf : ∀ i ∈ s, abs (f i) ≤ M) : + abs (∏ i ∈ s, f i) ≤ M ^ s.card := by + classical + rw [Finset.abs_prod] + simpa using Finset.prod_le_prod (fun _ _ ↦ abs_nonneg _) + (fun i hi ↦ hf i hi) + +/-- A deliberately coarse but uniform product perturbation estimate. The +extra factor `M` in the usual sharp estimate is harmless here and makes the +induction valid without a separate zero-cardinality case in the exponent. -/ +theorem abs_finset_prod_sub_prod_le {ι : Type*} {s : Finset ι} + (f g : ι → ℝ) {M δ : ℝ} (hM : 1 ≤ M) (hδ : 0 ≤ δ) + (hf : ∀ i ∈ s, abs (f i) ≤ M) + (hg : ∀ i ∈ s, abs (g i) ≤ M) + (hfg : ∀ i ∈ s, abs (f i - g i) ≤ δ) : + abs ((∏ i ∈ s, f i) - ∏ i ∈ s, g i) ≤ + s.card * δ * M ^ s.card := by + classical + induction s using Finset.induction_on with + | empty => simp + | @insert a s ha ih => + have hM0 : 0 ≤ M := le_trans (by norm_num) hM + have hpow0 : 0 ≤ M ^ s.card := pow_nonneg hM0 _ + have hprodF : abs (∏ i ∈ s, f i) ≤ M ^ s.card := + abs_finset_prod_le_pow f hM0 (fun i hi ↦ hf i (Finset.mem_insert_of_mem hi)) + have hih : abs ((∏ i ∈ s, f i) - ∏ i ∈ s, g i) ≤ + s.card * δ * M ^ s.card := + ih (fun i hi ↦ hf i (Finset.mem_insert_of_mem hi)) + (fun i hi ↦ hg i (Finset.mem_insert_of_mem hi)) + (fun i hi ↦ hfg i (Finset.mem_insert_of_mem hi)) + have hfirst : + abs ((f a - g a) * ∏ i ∈ s, f i) ≤ δ * M ^ s.card := by + rw [abs_mul] + exact mul_le_mul (hfg a (Finset.mem_insert_self a s)) hprodF + (abs_nonneg _) hδ + have hsecond : + abs (g a * ((∏ i ∈ s, f i) - ∏ i ∈ s, g i)) ≤ + M * (s.card * δ * M ^ s.card) := by + rw [abs_mul] + exact mul_le_mul (hg a (Finset.mem_insert_self a s)) hih + (abs_nonneg _) hM0 + have hpowStep : M ^ s.card ≤ M ^ (s.card + 1) := by + rw [pow_succ] + exact le_mul_of_one_le_right hpow0 hM + rw [Finset.prod_insert ha, Finset.prod_insert ha, + Finset.card_insert_of_notMem ha] + have hdecomp : + f a * ∏ i ∈ s, f i - g a * ∏ i ∈ s, g i = + (f a - g a) * ∏ i ∈ s, f i + + g a * ((∏ i ∈ s, f i) - ∏ i ∈ s, g i) := by ring + rw [hdecomp] + calc + abs ((f a - g a) * ∏ i ∈ s, f i + + g a * ((∏ i ∈ s, f i) - ∏ i ∈ s, g i)) ≤ + abs ((f a - g a) * ∏ i ∈ s, f i) + + abs (g a * ((∏ i ∈ s, f i) - ∏ i ∈ s, g i)) := + abs_add_le _ _ + _ ≤ δ * M ^ s.card + M * (s.card * δ * M ^ s.card) := + add_le_add hfirst hsecond + _ ≤ δ * M ^ (s.card + 1) + + M * (s.card * δ * M ^ s.card) := by + gcongr + _ = ((s.card + 1 : ℕ) : ℝ) * δ * M ^ (s.card + 1) := by + push_cast + rw [pow_succ] + ring + +/-- Entrywise perturbation bound for determinants. -/ +theorem abs_det_sub_det_le_of_entrywise {d : ℕ} + (A B : Matrix (Fin d) (Fin d) ℝ) {M δ : ℝ} + (hM : 1 ≤ M) (hδ : 0 ≤ δ) + (hA : ∀ i j, abs (A i j) ≤ M) + (hB : ∀ i j, abs (B i j) ≤ M) + (hAB : ∀ i j, abs (A i j - B i j) ≤ δ) : + abs (Matrix.det A - Matrix.det B) ≤ + d.factorial * (d * δ * M ^ d) := by + rw [Matrix.det_apply, Matrix.det_apply, ← Finset.sum_sub_distrib] + calc + abs (∑ σ : Equiv.Perm (Fin d), + (σ.sign • ∏ i, A (σ i) i - σ.sign • ∏ i, B (σ i) i)) ≤ + ∑ σ : Equiv.Perm (Fin d), + abs (σ.sign • ∏ i, A (σ i) i - + σ.sign • ∏ i, B (σ i) i) := Finset.abs_sum_le_sum_abs _ _ + _ ≤ ∑ _σ : Equiv.Perm (Fin d), d * δ * M ^ d := by + apply Finset.sum_le_sum + intro σ _ + rw [← smul_sub] + change (AbsoluteValue.abs : AbsoluteValue ℝ ℝ) + (σ.sign • ((∏ i, A (σ i) i) - ∏ i, B (σ i) i)) ≤ _ + rw [(AbsoluteValue.abs : AbsoluteValue ℝ ℝ).map_units_int_smul] + simpa [AbsoluteValue.abs, Fintype.card_fin] using + (abs_finset_prod_sub_prod_le + (s := (Finset.univ : Finset (Fin d))) + (fun i ↦ A (σ i) i) (fun i ↦ B (σ i) i) + hM hδ (fun i _ ↦ hA _ _) (fun i _ ↦ hB _ _) + (fun i _ ↦ hAB _ _)) + _ = d.factorial * (d * δ * M ^ d) := by + simp [Fintype.card_perm] + +/-- The standard determinant bound, specialized to real square matrices. -/ +theorem abs_det_le_of_entrywise {d : ℕ} + (A : Matrix (Fin d) (Fin d) ℝ) {M : ℝ} + (hA : ∀ i j, abs (A i j) ≤ M) : + abs (Matrix.det A) ≤ d.factorial * M ^ d := by + simpa [Fintype.card_fin, nsmul_eq_mul] using + (Matrix.det_le (abv := (AbsoluteValue.abs : AbsoluteValue ℝ ℝ)) + (A := A) (x := M) hA) + +/-- Determinant error caused by flooring every entry of a rational matrix to +one dyadic grid. The estimate is stated after casting to `ℝ`, exactly as it +is consumed by the ellipsoid volume proof. -/ +theorem abs_det_dyadicFloorMatrix_sub_det_le {d : ℕ} + (p : ℕ) (A : Matrix (Fin d) (Fin d) ℚ) {M : ℝ} + (hM : 1 ≤ M) (hA : ∀ i j, abs ((A i j : ℚ) : ℝ) ≤ M) : + abs (Matrix.det (fun i j ↦ ((dyadicFloorMatrix p A i j : ℚ) : ℝ)) - + Matrix.det (fun i j ↦ ((A i j : ℚ) : ℝ))) ≤ + d.factorial * + (d * (dyadicMesh p : ℝ) * (2 * M) ^ d) := by + have hmesh0 : (0 : ℝ) ≤ (dyadicMesh p : ℝ) := by + exact_mod_cast dyadicMesh_nonneg p + have hmesh1 : (dyadicMesh p : ℝ) ≤ 1 := by + exact_mod_cast dyadicMesh_le_one p + have htwoM : (1 : ℝ) ≤ 2 * M := by linarith + apply abs_det_sub_det_le_of_entrywise _ _ htwoM hmesh0 + · intro i j + exact (abs_cast_dyadicFloorMatrix_le p A i j).le.trans + (by linarith [hA i j]) + · intro i j + exact (hA i j).trans (by linarith) + · intro i j + have h := cast_dyadicFloorMatrix_entry_error_lt p A i j + simpa only [Rat.cast_sub] using h.le + +/-- A determinant margin larger than the explicit rounding loss guarantees +that the rounded rational matrix remains nonsingular. -/ +theorem det_dyadicFloorMatrix_ne_zero_of_margin {d : ℕ} + (p : ℕ) (A : Matrix (Fin d) (Fin d) ℚ) {M : ℝ} + (hM : 1 ≤ M) (hA : ∀ i j, abs ((A i j : ℚ) : ℝ) ≤ M) + (hmargin : d.factorial * + (d * (dyadicMesh p : ℝ) * (2 * M) ^ d) < + abs ((Matrix.det A : ℚ) : ℝ)) : + Matrix.det (dyadicFloorMatrix p A) ≠ 0 := by + intro hzero + have hpert := abs_det_dyadicFloorMatrix_sub_det_le p A hM hA + have hcastRound : + Matrix.det (fun i j ↦ ((dyadicFloorMatrix p A i j : ℚ) : ℝ)) = 0 := by + rw [show (fun i j ↦ ((dyadicFloorMatrix p A i j : ℚ) : ℝ)) = + (dyadicFloorMatrix p A).map (fun q : ℚ ↦ (q : ℝ)) by rfl, + ← Rat.cast_det, hzero] + simp + have hcastA : + Matrix.det (fun i j ↦ ((A i j : ℚ) : ℝ)) = + ((Matrix.det A : ℚ) : ℝ) := by + rw [show (fun i j ↦ ((A i j : ℚ) : ℝ)) = + A.map (fun q : ℚ ↦ (q : ℝ)) by rfl, Rat.cast_det] + rw [hcastRound, hcastA, zero_sub, abs_neg] at hpert + exact (not_lt_of_ge hpert) hmargin + +theorem abs_adjugate_entry_le_of_entrywise {d : ℕ} + (A : Matrix (Fin d) (Fin d) ℝ) {M : ℝ} (hM : 1 ≤ M) + (hA : ∀ i j, abs (A i j) ≤ M) (i j : Fin d) : + abs (A.adjugate i j) ≤ d.factorial * M ^ d := by + have hM0 : 0 ≤ M := by linarith + rw [Matrix.adjugate_apply] + apply abs_det_le_of_entrywise + intro k l + by_cases hkj : k = j + · subst k + by_cases hil : i = l + · subst l + simp [hM] + · simp [Matrix.updateRow_apply, hil, hM0] + · rw [Matrix.updateRow_apply, if_neg hkj] + exact hA k l + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/NearCase.lean b/LeanPool/BeyondBethe/BeyondBethe/NearCase.lean new file mode 100644 index 0000000000..614e5c7451 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/NearCase.lean @@ -0,0 +1,1627 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.CycleTransfer +import LeanPool.BeyondBethe.BeyondBethe.CleanConstants +import LeanPool.BeyondBethe.BeyondBethe.Completion +import LeanPool.BeyondBethe.BeyondBethe.ClusterCertificate +import LeanPool.BeyondBethe.BeyondBethe.SourceBetheUpper +import Mathlib.Data.Finset.Sort +import Mathlib.Tactic + +/-! # Near Case -/ + +open scoped BigOperators + +namespace BeyondBethe + +/-- The actual clean two-row factors of the alternating permutation. -/ +noncomputable def cleanCycleFactors + {n : ℕ} (η : ℝ) (P : Matrix (Fin n) (Fin n) ℝ) + (h : Equiv.Perm (Fin n)) : Finset h.cycleFactorsFinset := by + classical + exact Finset.univ.filter fun c ↦ + (c : Equiv.Perm (Fin n)).support.card = 2 ∧ + cycleGoodCount η P h c = 2 + +theorem cleanCycleFactors_card + {n : ℕ} (η : ℝ) (P : Matrix (Fin n) (Fin n) ℝ) + (h : Equiv.Perm (Fin n)) : + (cleanCycleFactors η P h).card = cleanCycleCount η P h := by + classical + rw [cleanCycleCount] + calc + (cleanCycleFactors η P h).card = + ∑ c : h.cycleFactorsFinset, + if (c : Equiv.Perm (Fin n)).support.card = 2 ∧ + cycleGoodCount η P h c = 2 then 1 else 0 := by + simp [cleanCycleFactors] + _ = ∑ c : h.cycleFactorsFinset, cleanCycleIndicator η P h c := by + apply Finset.sum_congr rfl + intro c _ + rfl + +theorem cleanCycleFactor_property + {n : ℕ} {η : ℝ} {P : Matrix (Fin n) (Fin n) ℝ} + {h : Equiv.Perm (Fin n)} (c : cleanCycleFactors η P h) : + (c.1 : Equiv.Perm (Fin n)).support.card = 2 ∧ + cycleGoodCount η P h c.1 = 2 := by + have hc := c.2 + change c.1 ∈ Finset.univ.filter (fun d : h.cycleFactorsFinset ↦ + (d : Equiv.Perm (Fin n)).support.card = 2 ∧ + cycleGoodCount η P h d = 2) at hc + exact (Finset.mem_filter.mp hc).2 + +/-- The two rows of a clean factor, in the ambient linear order. -/ +noncomputable def cleanCycleRow + {n : ℕ} {η : ℝ} {P : Matrix (Fin n) (Fin n) ℝ} + {h : Equiv.Perm (Fin n)} (c : cleanCycleFactors η P h) : + Fin 2 → Fin n := fun k ↦ + ((c.1 : Equiv.Perm (Fin n)).support.orderIsoOfFin + (cleanCycleFactor_property c).1 k).1 + +theorem cleanCycleRow_mem_support + {n : ℕ} {η : ℝ} {P : Matrix (Fin n) (Fin n) ℝ} + {h : Equiv.Perm (Fin n)} (c : cleanCycleFactors η P h) (k : Fin 2) : + cleanCycleRow c k ∈ (c.1 : Equiv.Perm (Fin n)).support := by + exact ((c.1 : Equiv.Perm (Fin n)).support.orderIsoOfFin + (cleanCycleFactor_property c).1 k).2 + +theorem cleanCycleRow_injective + {n : ℕ} {η : ℝ} {P : Matrix (Fin n) (Fin n) ℝ} + {h : Equiv.Perm (Fin n)} (c : cleanCycleFactors η P h) : + Function.Injective (cleanCycleRow c) := by + intro k l hkl + apply ((c.1 : Equiv.Perm (Fin n)).support.orderIsoOfFin + (cleanCycleFactor_property c).1).injective + exact Subtype.ext hkl + +theorem cleanCycleRows_ne + {n : ℕ} {η : ℝ} {P : Matrix (Fin n) (Fin n) ℝ} + {h : Equiv.Perm (Fin n)} (c : cleanCycleFactors η P h) : + cleanCycleRow c 0 ≠ cleanCycleRow c 1 := by + intro hrs + have := cleanCycleRow_injective c hrs + norm_num at this + +theorem cleanCycleRow_mem_goodRows + {n : ℕ} {η : ℝ} {P : Matrix (Fin n) (Fin n) ℝ} + {h : Equiv.Perm (Fin n)} (c : cleanCycleFactors η P h) (k : Fin 2) : + cleanCycleRow c k ∈ goodRows η P := by + have hcard := cleanCycleFactor_property c + have hinter : + (c.1 : Equiv.Perm (Fin n)).support ∩ goodRows η P = + (c.1 : Equiv.Perm (Fin n)).support := by + apply Finset.eq_of_subset_of_card_le Finset.inter_subset_left + rw [hcard.1] + simpa [cycleGoodCount] using hcard.2.symm.le + have hmem := cleanCycleRow_mem_support c k + rw [← hinter] at hmem + exact (Finset.mem_inter.mp hmem).2 + +/-- On a two-row alternating component, the two perfect matchings cross: +the unordered pair of core columns is the same at both rows. -/ +theorem cleanCycle_core_columns + {n : ℕ} {f g : Equiv.Perm (Fin n)} + {η : ℝ} {P : Matrix (Fin n) (Fin n) ℝ} + (c : cleanCycleFactors η P (alternatingRowPerm f g)) : + let r := cleanCycleRow c 0 + let s := cleanCycleRow c 1 + r ≠ s ∧ f r ≠ g r ∧ f r = g s ∧ g r = f s := by + let h := alternatingRowPerm f g + let q : Equiv.Perm (Fin n) := c.1 + let r := cleanCycleRow c 0 + let s := cleanCycleRow c 1 + have hrs : r ≠ s := cleanCycleRows_ne c + have hrq : r ∈ q.support := cleanCycleRow_mem_support c 0 + have hsq : s ∈ q.support := cleanCycleRow_mem_support c 1 + have hpair : q.support = {r, s} := by + symm + apply Finset.eq_of_subset_of_card_le + · intro i hi + simp only [Finset.mem_insert, Finset.mem_singleton] at hi + rcases hi with rfl | rfl + · exact hrq + · exact hsq + · have hqcard : q.support.card = 2 := (cleanCycleFactor_property c).1 + simpa [hrs, hqcard] + have hqr_ne : q r ≠ r := Equiv.Perm.mem_support.mp hrq + have hqs_ne : q s ≠ s := Equiv.Perm.mem_support.mp hsq + have hqr_mem : q r ∈ q.support := by + rw [Equiv.Perm.mem_support] + exact mt q.injective.eq_iff.mp hqr_ne + have hqs_mem : q s ∈ q.support := by + rw [Equiv.Perm.mem_support] + exact mt q.injective.eq_iff.mp hqs_ne + have hqr : q r = s := by + rw [hpair] at hqr_mem + simp only [Finset.mem_insert, Finset.mem_singleton] at hqr_mem + exact hqr_mem.resolve_left hqr_ne + have hqs : q s = r := by + rw [hpair] at hqs_mem + simp only [Finset.mem_insert, Finset.mem_singleton] at hqs_mem + exact hqs_mem.resolve_right hqs_ne + have hfactor := Equiv.Perm.mem_cycleFactorsFinset_iff.mp c.1.2 + have hhr : h r = s := by + rw [← hfactor.2 r hrq, hqr] + have hhs : h s = r := by + rw [← hfactor.2 s hsq, hqs] + have hfrgs : f r = g s := by + have := congrArg g hhr + simpa [h, alternatingRowPerm] using this + have hgrfs : g r = f s := by + have := congrArg g hhs + simpa [h, alternatingRowPerm] using this.symm + have hfg : f r ≠ g r := by + intro heq + have hfix : h r = r := (alternatingRowPerm_fixed_iff f g r).2 heq + exact hrs (hfix.symm.trans hhr) + exact ⟨hrs, hfg, hfrgs, hgrfs⟩ + +theorem twoMatching_core_mem_heavy_of_good + {n : ℕ} {P : Matrix (Fin n) (Fin n) ℝ} + (hP : ∀ i, IsStrictProbabilityVector (P i)) + {η : ℝ} (f g : Equiv.Perm (Fin n)) + (hheavy : ∀ i j, j ∈ heavyCoordinates η (P i) → + j = f i ∨ j = g i) + {i : Fin n} (hgood : IsGoodRow η (P i)) : + f i ∈ heavyCoordinates η (P i) ∧ + g i ∈ heavyCoordinates η (P i) ∧ f i ≠ g i := by + obtain ⟨a, b, hab, hdist⟩ := hgood + have hcore := goodRow_witness_mem_heavyCoordinates + (hP i).probability hab hdist + have ha := hheavy i a hcore.1 + have hb := hheavy i b hcore.2 + rcases ha with haf | hag <;> rcases hb with hbf | hbg + · exact False.elim (hab (haf.trans hbf.symm)) + · subst a + subst b + exact ⟨hcore.1, hcore.2, hab⟩ + · subst a + subst b + exact ⟨hcore.2, hcore.1, hab.symm⟩ + · exact False.elim (hab (hag.trans hbg.symm)) + +theorem univ_sdiff_coreOutside_of_ne + {ι : Type*} [Fintype ι] [DecidableEq ι] + {a b : ι} (hab : a ≠ b) : + Finset.univ \ coreOutside a b = {a, b} := by + ext j + simp only [Finset.mem_sdiff, Finset.mem_univ, coreOutside, + Finset.mem_filter, true_and, Finset.mem_insert, Finset.mem_singleton] + tauto + +noncomputable def encodedCoreRowTransferCost + {n : ℕ} (f g : Equiv.Perm (Fin n)) + (P U : Matrix (Fin n) (Fin n) ℝ) (i : Fin n) : ℝ := + transferCostOn (Finset.univ \ coreOutside (f i) (g i)) (P i) (U i) + +noncomputable def cleanCycleWeightedCost + {n : ℕ} {η : ℝ} {P : Matrix (Fin n) (Fin n) ℝ} + {f g : Equiv.Perm (Fin n)} + (U : Matrix (Fin n) (Fin n) ℝ) + (c : cleanCycleFactors η P (alternatingRowPerm f g)) : ℝ := + ∑ k : Fin 2, encodedCoreRowTransferCost f g P U (cleanCycleRow c k) + +theorem cleanCycleWeightedCost_eq_support_sum + {n : ℕ} {η : ℝ} {P : Matrix (Fin n) (Fin n) ℝ} + {f g : Equiv.Perm (Fin n)} + (U : Matrix (Fin n) (Fin n) ℝ) + (c : cleanCycleFactors η P (alternatingRowPerm f g)) : + cleanCycleWeightedCost U c = + ∑ i ∈ (c.1 : Equiv.Perm (Fin n)).support, + encodedCoreRowTransferCost f g P U i := by + let e := (c.1 : Equiv.Perm (Fin n)).support.orderIsoOfFin + (cleanCycleFactor_property c).1 + rw [cleanCycleWeightedCost] + calc + (∑ k : Fin 2, encodedCoreRowTransferCost f g P U (cleanCycleRow c k)) = + ∑ i : (c.1 : Equiv.Perm (Fin n)).support, + encodedCoreRowTransferCost f g P U i.1 := by + exact Equiv.sum_comp e.toEquiv + (fun i : (c.1 : Equiv.Perm (Fin n)).support ↦ + encodedCoreRowTransferCost f g P U i.1) + _ = ∑ i ∈ (c.1 : Equiv.Perm (Fin n)).support, + encodedCoreRowTransferCost f g P U i := by + simpa using Finset.sum_coe_sort + (c.1 : Equiv.Perm (Fin n)).support + (encodedCoreRowTransferCost f g P U) + +theorem encodedCoreRowTransferCost_nonneg + {n : ℕ} {τ : ℝ} (hτ : 0 ≤ τ) + {P X : Matrix (Fin n) (Fin n) ℝ} + (hP : IsDoublyStochastic P) + (hXint : ∀ i, IsInteriorProbabilityVector (X i)) + (f g : Equiv.Perm (Fin n)) (i : Fin n) : + 0 ≤ encodedCoreRowTransferCost f g P + (fun a b ↦ transferU τ (X a) b) i := by + rw [encodedCoreRowTransferCost, transferCostOn] + apply Finset.sum_nonneg + intro j _ + exact mul_nonneg (hP.nonnegative i j) + (log_one_div_nonneg_of_pos_le_one + (transferU_pos (hXint i) j) + (transferU_le_one hτ (hXint i) j)) + +/-- Clean factors are vertex-disjoint, so their weighted core costs are +bounded by the global core-transfer cost. -/ +theorem sum_cleanCycleWeightedCost_le_coreTransferCost + {n : ℕ} {τ η : ℝ} + {P X : Matrix (Fin n) (Fin n) ℝ} + (hP : IsDoublyStochastic P) (hτ : 0 ≤ τ) + (hXint : ∀ i, IsInteriorProbabilityVector (X i)) + (f g : Equiv.Perm (Fin n)) : + (∑ c : cleanCycleFactors η P (alternatingRowPerm f g), + cleanCycleWeightedCost (fun i j ↦ transferU τ (X i) j) c) ≤ + coreTransferCost (fun i ↦ coreOutside (f i) (g i)) P + (fun i j ↦ transferU τ (X i) j) := by + let S := cleanCycleFactors η P (alternatingRowPerm f g) + let t : (alternatingRowPerm f g).cycleFactorsFinset → Finset (Fin n) := + fun c ↦ (c : Equiv.Perm (Fin n)).support + let w : Fin n → ℝ := fun i ↦ encodedCoreRowTransferCost f g P + (fun a b ↦ transferU τ (X a) b) i + have hpair : (↑S : Set (alternatingRowPerm f g).cycleFactorsFinset).PairwiseDisjoint t := by + intro c hc d hd hcd + have hcd' : (c : Equiv.Perm (Fin n)) ≠ d := by + intro heq + apply hcd + exact Subtype.ext heq + exact (alternatingRowPerm f g).cycleFactorsFinset_pairwise_disjoint + c.2 d.2 hcd' |>.disjoint_support + have hunion : (∑ c : S, ∑ i ∈ t c.1, w i) = + ∑ i ∈ S.biUnion t, w i := by + calc + (∑ c : S, ∑ i ∈ t c.1, w i) = + ∑ c ∈ S, ∑ i ∈ t c, w i := by + simpa using Finset.sum_coe_sort S (fun c ↦ ∑ i ∈ t c, w i) + _ = ∑ i ∈ S.biUnion t, w i := (Finset.sum_biUnion hpair).symm + rw [coreTransferCost] + simp_rw [cleanCycleWeightedCost_eq_support_sum] + change (∑ c : S, ∑ i ∈ t c.1, w i) ≤ ∑ i, w i + rw [hunion] + exact Finset.sum_le_sum_of_subset_of_nonneg (Finset.subset_univ _) + (fun i _ _ ↦ encodedCoreRowTransferCost_nonneg hτ hP hXint f g i) + +theorem cleanCycle_minCost_mul_fourCore + {n : ℕ} {τ η : ℝ} + {P X : Matrix (Fin n) (Fin n) ℝ} + (hP : ∀ i, IsStrictProbabilityVector (P i)) + (hτ : 0 ≤ τ) + (hXint : ∀ i, IsInteriorProbabilityVector (X i)) + (f g : Equiv.Perm (Fin n)) + (hheavy : ∀ i j, j ∈ heavyCoordinates η (P i) → + j = f i ∨ j = g i) + (c : cleanCycleFactors η P (alternatingRowPerm f g)) : + (1 / 2 - η) * fourCoreTransferCost τ X + (cleanCycleRow c 0) (cleanCycleRow c 1) + (f (cleanCycleRow c 0)) (g (cleanCycleRow c 0)) ≤ + cleanCycleWeightedCost (fun i j ↦ transferU τ (X i) j) c := by + let r := cleanCycleRow c 0 + let s := cleanCycleRow c 1 + let a := f r + let b := g r + have hcols := cleanCycle_core_columns c + have hrgood : IsGoodRow η (P r) := by + simpa [goodRows] using cleanCycleRow_mem_goodRows c 0 + have hsgood : IsGoodRow η (P s) := by + simpa [goodRows] using cleanCycleRow_mem_goodRows c 1 + have hrheavy := twoMatching_core_mem_heavy_of_good hP f g hheavy hrgood + have hsheavy := twoMatching_core_mem_heavy_of_good hP f g hheavy hsgood + have hra : 1 / 2 - η ≤ P r a := by + simpa [a, heavyCoordinates] using hrheavy.1 + have hrb : 1 / 2 - η ≤ P r b := by + simpa [b, heavyCoordinates] using hrheavy.2.1 + have hsa : 1 / 2 - η ≤ P s a := by + have : a = g s := hcols.2.2.1 + rw [this] + simpa [heavyCoordinates] using hsheavy.2.1 + have hsb : 1 / 2 - η ≤ P s b := by + have : b = f s := hcols.2.2.2 + rw [this] + simpa [heavyCoordinates] using hsheavy.1 + have hlog : ∀ i j, + 0 ≤ Real.log (1 / transferU τ (X i) j) := fun i j ↦ + log_one_div_nonneg_of_pos_le_one (transferU_pos (hXint i) j) + (transferU_le_one hτ (hXint i) j) + have hsaCore : coreOutside (f s) (g s) = coreOutside a b := by + rw [hcols.2.2.2.symm, hcols.2.2.1.symm, coreOutside_comm] + rw [cleanCycleWeightedCost] + simp only [Fin.sum_univ_two] + rw [show cleanCycleRow c 0 = r by rfl, show cleanCycleRow c 1 = s by rfl] + rw [encodedCoreRowTransferCost, encodedCoreRowTransferCost, hsaCore, + univ_sdiff_coreOutside_of_ne hcols.2.1] + simp only [transferCostOn, Finset.sum_insert, + Finset.sum_singleton, Finset.mem_singleton, hcols.2.1, not_false_eq_true] + rw [fourCoreTransferCost] + nlinarith [mul_le_mul_of_nonneg_right hra (hlog r a), + mul_le_mul_of_nonneg_right hrb (hlog r b), + mul_le_mul_of_nonneg_right hsa (hlog s a), + mul_le_mul_of_nonneg_right hsb (hlog s b)] + +noncomputable def failedCleanCycles + {n : ℕ} (κ τ η : ℝ) + (P X : Matrix (Fin n) (Fin n) ℝ) + (f g : Equiv.Perm (Fin n)) : + Finset (cleanCycleFactors η P (alternatingRowPerm f g)) := by + classical + exact Finset.univ.filter fun c ↦ + κ < fourCoreTransferCost τ X + (cleanCycleRow c 0) (cleanCycleRow c 1) + (f (cleanCycleRow c 0)) (g (cleanCycleRow c 0)) + +noncomputable def successfulCleanCycles + {n : ℕ} (κ τ η : ℝ) + (P X : Matrix (Fin n) (Fin n) ℝ) + (f g : Equiv.Perm (Fin n)) : + Finset (cleanCycleFactors η P (alternatingRowPerm f g)) := + Finset.univ \ failedCleanCycles κ τ η P X f g + +theorem cleanCycleWeightedCost_nonneg + {n : ℕ} {τ η : ℝ} + {P X : Matrix (Fin n) (Fin n) ℝ} + (hP : IsDoublyStochastic P) (hτ : 0 ≤ τ) + (hXint : ∀ i, IsInteriorProbabilityVector (X i)) + (f g : Equiv.Perm (Fin n)) + (c : cleanCycleFactors η P (alternatingRowPerm f g)) : + 0 ≤ cleanCycleWeightedCost + (fun i j ↦ transferU τ (X i) j) c := by + rw [cleanCycleWeightedCost] + exact Finset.sum_nonneg fun k _ ↦ + encodedCoreRowTransferCost_nonneg hτ hP hXint f g (cleanCycleRow c k) + +/-- The weighted Markov step on the actual clean alternating factors. -/ +theorem failedCleanCycles_count_mul_le_coreTransferCost + {n : ℕ} {κ τ η : ℝ} + {P X : Matrix (Fin n) (Fin n) ℝ} + (hP : ∀ i, IsStrictProbabilityVector (P i)) + (hPds : IsDoublyStochastic P) + (hτ : 0 ≤ τ) (hfactor : 0 ≤ 1 / 2 - η) + (hXint : ∀ i, IsInteriorProbabilityVector (X i)) + (f g : Equiv.Perm (Fin n)) + (hheavy : ∀ i j, j ∈ heavyCoordinates η (P i) → + j = f i ∨ j = g i) : + ((failedCleanCycles κ τ η P X f g).card : ℝ) * + ((1 / 2 - η) * κ) ≤ + coreTransferCost (fun i ↦ coreOutside (f i) (g i)) P + (fun i j ↦ transferU τ (X i) j) := by + let F := failedCleanCycles κ τ η P X f g + let C := cleanCycleFactors η P (alternatingRowPerm f g) + let W : C → ℝ := fun c ↦ cleanCycleWeightedCost + (fun i j ↦ transferU τ (X i) j) c + have hpoint : ∀ c ∈ F, (1 / 2 - η) * κ ≤ W c := by + intro c hc + have hfail : κ < fourCoreTransferCost τ X + (cleanCycleRow c 0) (cleanCycleRow c 1) + (f (cleanCycleRow c 0)) (g (cleanCycleRow c 0)) := by + simpa [F, failedCleanCycles] using hc + have hscaled : (1 / 2 - η) * κ ≤ + (1 / 2 - η) * fourCoreTransferCost τ X + (cleanCycleRow c 0) (cleanCycleRow c 1) + (f (cleanCycleRow c 0)) (g (cleanCycleRow c 0)) := + mul_le_mul_of_nonneg_left hfail.le hfactor + exact hscaled.trans (cleanCycle_minCost_mul_fourCore + hP hτ hXint f g hheavy c) + have hfailedSum : (F.card : ℝ) * ((1 / 2 - η) * κ) ≤ + ∑ c ∈ F, W c := by + calc + (F.card : ℝ) * ((1 / 2 - η) * κ) = + ∑ _c ∈ F, ((1 / 2 - η) * κ) := by simp + _ ≤ ∑ c ∈ F, W c := Finset.sum_le_sum hpoint + have hsubset : F ⊆ Finset.univ := Finset.subset_univ F + have hsumAll : (∑ c ∈ F, W c) ≤ ∑ c : C, W c := by + exact Finset.sum_le_sum_of_subset_of_nonneg hsubset + (fun c _ _ ↦ cleanCycleWeightedCost_nonneg hPds hτ hXint f g c) + exact hfailedSum.trans (hsumAll.trans + (sum_cleanCycleWeightedCost_le_coreTransferCost hPds hτ hXint f g)) + +theorem failedCleanCycles_count_le + {n : ℕ} (hn : 0 < n) {κ τ η εtr : ℝ} + {P X : Matrix (Fin n) (Fin n) ℝ} + (hP : ∀ i, IsStrictProbabilityVector (P i)) + (hPds : IsDoublyStochastic P) + (hτ : 0 ≤ τ) (hfactor : 0 ≤ 1 / 2 - η) + (hmin : 0 < (1 / 2 - η) * κ) + (hXint : ∀ i, IsInteriorProbabilityVector (X i)) + (f g : Equiv.Perm (Fin n)) + (hheavy : ∀ i j, j ∈ heavyCoordinates η (P i) → + j = f i ∨ j = g i) + (hcore : coreTransferCost (fun i ↦ coreOutside (f i) (g i)) P + (fun i j ↦ transferU τ (X i) j) / n ≤ + εtr * ((1 / 2 - η) * κ)) : + ((failedCleanCycles κ τ η P X f g).card : ℝ) ≤ εtr * n := by + have hweighted := failedCleanCycles_count_mul_le_coreTransferCost + (κ := κ) hP hPds hτ hfactor hXint f g hheavy + have hnR : 0 < (n : ℝ) := by exact_mod_cast hn + have htotal := (div_le_iff₀ hnR).mp hcore + exact failedPair_count_le_transferError hmin hweighted (by + calc + coreTransferCost (fun i ↦ coreOutside (f i) (g i)) P + (fun i j ↦ transferU τ (X i) j) ≤ + (εtr * ((1 / 2 - η) * κ)) * n := htotal + _ = εtr * n * ((1 / 2 - η) * κ) := by ring) + +theorem successfulCleanCycles_card_add_failed + {n : ℕ} (κ τ η : ℝ) + (P X : Matrix (Fin n) (Fin n) ℝ) + (f g : Equiv.Perm (Fin n)) : + (successfulCleanCycles κ τ η P X f g).card + + (failedCleanCycles κ τ η P X f g).card = + cleanCycleCount η P (alternatingRowPerm f g) := by + have hpart := Finset.card_sdiff_add_card_eq_card + (Finset.subset_univ (failedCleanCycles κ τ η P X f g)) + simpa [successfulCleanCycles, Finset.card_univ, Fintype.card_coe, + cleanCycleFactors_card] using hpart + +/-- The exact clean-pair counting conclusion used in the near case. -/ +theorem successfulCleanCycles_count_ge_threeEighths + {n : ℕ} {κ τ η : ℝ} + {P X : Matrix (Fin n) (Fin n) ℝ} + (hP : ∀ i, IsStrictProbabilityVector (P i)) + (f g : Equiv.Perm (Fin n)) + (hheavy : ∀ i j, j ∈ heavyCoordinates η (P i) → + j = f i ∨ j = g i) + (hbad : ((badRows η P).card : ℝ) ≤ n / 128) + (hlong : (longCycleGoodRows η P (alternatingRowPerm f g) : ℝ) ≤ + n / 16) + (hfailed : ((failedCleanCycles κ τ η P X f g).card : ℝ) ≤ + n / 16) : + 3 * n / 8 ≤ + ((successfulCleanCycles κ τ η P X f g).card : ℝ) := by + have haccountNat := alternating_cleanCycle_count hP f g hheavy + have haccountCast : (n : ℝ) ≤ + 2 * ((badRows η P).card : ℝ) + + (longCycleGoodRows η P (alternatingRowPerm f g) : ℝ) + + 2 * (cleanCycleCount η P (alternatingRowPerm f g) : ℝ) := by + exact_mod_cast haccountNat + have haccount : (n : ℝ) - 2 * (badRows η P).card - + longCycleGoodRows η P (alternatingRowPerm f g) ≤ + 2 * cleanCycleCount η P (alternatingRowPerm f g) := by + linarith + have hclean := cleanPair_count_ge_fiftyNine hbad hlong haccount + have hpartitionNat := successfulCleanCycles_card_add_failed + κ τ η P X f g + have hpartitionCast : + ((successfulCleanCycles κ τ η P X f g).card : ℝ) + + ((failedCleanCycles κ τ η P X f g).card : ℝ) = + (cleanCycleCount η P (alternatingRowPerm f g) : ℝ) := by + exact_mod_cast hpartitionNat + have hpartition : + (cleanCycleCount η P (alternatingRowPerm f g) : ℝ) - + (failedCleanCycles κ τ η P X f g).card ≤ + (successfulCleanCycles κ τ η P X f g).card := by + linarith + exact successfulCleanPair_count_ge_threeEighths (Nat.cast_nonneg n) + hclean hfailed hpartition + +/-- Pointwise form: every successful clean factor receives the uniform gain +from Lemma 19. -/ +theorem successfulCleanCycle_gain + {n : ℕ} {κ₀ ξ₀ γ₀ ell ξ τ η : ℝ} + (hgain : CleanPairGainGuarantee κ₀ ξ₀ γ₀) + (hell : 1 ≤ ell) (hlogn : Real.log n ≤ ell * Real.log 2) + (hξ : 0 < ξ) (hξ₀ : ξ ≤ ξ₀) (hτscale : τ = ξ / (4 * ell)) + {A P X : Matrix (Fin n) (Fin n) ℝ} + (hA : Matrix.Positive A) (hX : IsDoublyStochastic X) + (hXint : ∀ i, IsInteriorProbabilityVector (X i)) + {R C : Fin n → ℝ} (hKKT : HasLogKKT τ A X R C) + (f g : Equiv.Perm (Fin n)) + (c : cleanCycleFactors η P (alternatingRowPerm f g)) + (hc : c ∈ successfulCleanCycles κ₀ τ η P X f g) : + γ₀ ≤ Real.log + (pairGain A X (cleanCycleRow c 0) (cleanCycleRow c 1)) := by + let rscale : Fin n → ℝ := fun i ↦ Real.exp (R i) + let cscale : Fin n → ℝ := fun j ↦ Real.exp (C j) + have hmult : HasMultiplicativeKKT τ A X rscale cscale := + hasMultiplicativeKKT_of_logKKT hA hXint hKKT + have hcost : fourCoreTransferCost τ X + (cleanCycleRow c 0) (cleanCycleRow c 1) + (f (cleanCycleRow c 0)) (g (cleanCycleRow c 0)) ≤ κ₀ := by + have hnot : ¬ κ₀ < fourCoreTransferCost τ X + (cleanCycleRow c 0) (cleanCycleRow c 1) + (f (cleanCycleRow c 0)) (g (cleanCycleRow c 0)) := by + simpa [successfulCleanCycles, failedCleanCycles] using hc + exact le_of_not_gt hnot + have hcols := cleanCycle_core_columns c + exact hgain hell hlogn hξ hξ₀ hτscale hA hX hXint + (fun i ↦ Real.exp_pos _) (fun j ↦ Real.exp_pos _) hmult + hcols.1 hcols.2.1 hcost + +/-- Summed form of the preceding pointwise gain. -/ +theorem successfulCleanCycles_gain_sum + {n : ℕ} {κ₀ ξ₀ γ₀ ell ξ τ η : ℝ} + (hgain : CleanPairGainGuarantee κ₀ ξ₀ γ₀) + (hell : 1 ≤ ell) (hlogn : Real.log n ≤ ell * Real.log 2) + (hξ : 0 < ξ) (hξ₀ : ξ ≤ ξ₀) (hτscale : τ = ξ / (4 * ell)) + {A P X : Matrix (Fin n) (Fin n) ℝ} + (hA : Matrix.Positive A) (hX : IsDoublyStochastic X) + (hXint : ∀ i, IsInteriorProbabilityVector (X i)) + {R C : Fin n → ℝ} (hKKT : HasLogKKT τ A X R C) + (f g : Equiv.Perm (Fin n)) : + ((successfulCleanCycles κ₀ τ η P X f g).card : ℝ) * γ₀ ≤ + ∑ c ∈ successfulCleanCycles κ₀ τ η P X f g, + Real.log (pairGain A X (cleanCycleRow c 0) (cleanCycleRow c 1)) := by + have hpoint := successfulCleanCycle_gain hgain hell hlogn hξ hξ₀ + (P := P) (η := η) hτscale hA hX hXint hKKT f g + calc + ((successfulCleanCycles κ₀ τ η P X f g).card : ℝ) * γ₀ = + ∑ _c ∈ successfulCleanCycles κ₀ τ η P X f g, γ₀ := by simp + _ ≤ ∑ c ∈ successfulCleanCycles κ₀ τ η P X f g, + Real.log (pairGain A X (cleanCycleRow c 0) (cleanCycleRow c 1)) := + Finset.sum_le_sum hpoint + +/-- An unordered pair of distinct rows. The ambient order gives it a +canonical orientation whenever a formula such as `pairGain` expects one. -/ +abbrev RowPair (n : ℕ) := {q : Finset (Fin n) // q.card = 2} + +def rowPairRow {n : ℕ} (q : RowPair n) : Fin 2 → Fin n := + fun k ↦ (q.1.orderIsoOfFin q.2 k).1 + +def IsRowMatching {n : ℕ} (M : Finset (RowPair n)) : Prop := + (↑M : Set (RowPair n)).PairwiseDisjoint fun q ↦ q.1 + +noncomputable def rowPairWeight + {n : ℕ} (A X : Matrix (Fin n) (Fin n) ℝ) (q : RowPair n) : ℝ := + max 0 (Real.log (pairGain A X (rowPairRow q 0) (rowPairRow q 1))) + +noncomputable def rowMatchingWeight + {n : ℕ} (A X : Matrix (Fin n) (Fin n) ℝ) + (M : Finset (RowPair n)) : ℝ := + ∑ q ∈ M, rowPairWeight A X q + +noncomputable def allRowMatchings (n : ℕ) : Finset (Finset (RowPair n)) := by + classical + exact Finset.univ.filter IsRowMatching + +theorem allRowMatchings_nonempty (n : ℕ) : + (allRowMatchings n).Nonempty := by + refine ⟨∅, ?_⟩ + simp [allRowMatchings, IsRowMatching] + +noncomputable def maximumMatchingGain + {n : ℕ} (A X : Matrix (Fin n) (Fin n) ℝ) : ℝ := + (allRowMatchings n).sup' (allRowMatchings_nonempty n) + (rowMatchingWeight A X) + +theorem rowMatchingWeight_le_maximum + {n : ℕ} (A X : Matrix (Fin n) (Fin n) ℝ) + {M : Finset (RowPair n)} (hM : IsRowMatching M) : + rowMatchingWeight A X M ≤ maximumMatchingGain A X := by + apply Finset.le_sup' + simpa [allRowMatchings] using hM + +theorem maximumMatchingGain_nonneg + {n : ℕ} (A X : Matrix (Fin n) (Fin n) ℝ) : + 0 ≤ maximumMatchingGain A X := by + have h := rowMatchingWeight_le_maximum A X + (M := ∅) (by simp [IsRowMatching]) + simpa [rowMatchingWeight] using h + +theorem exists_maximumRowMatching + {n : ℕ} (A X : Matrix (Fin n) (Fin n) ℝ) : + ∃ M : Finset (RowPair n), IsRowMatching M ∧ + rowMatchingWeight A X M = maximumMatchingGain A X := by + let S := allRowMatchings n + have hnonempty : S.Nonempty := allRowMatchings_nonempty n + have hexists : ∃ M ∈ S, + maximumMatchingGain A X ≤ rowMatchingWeight A X M := by + rw [maximumMatchingGain] + exact (Finset.le_sup'_iff hnonempty).mp le_rfl + obtain ⟨M, hMS, hle⟩ := hexists + have hM : IsRowMatching M := by + simpa [S, allRowMatchings] using hMS + exact ⟨M, hM, le_antisymm (rowMatchingWeight_le_maximum A X hM) hle⟩ + +/-- Delete the zero-weight pairs from a matching. Since the matching weights +are positive parts of logarithmic gains, this preserves the objective and +leaves only pairs whose multiplicative gain is strictly larger than one. -/ +noncomputable def positiveRowPairs + {n : ℕ} (A X : Matrix (Fin n) (Fin n) ℝ) + (M : Finset (RowPair n)) : Finset (RowPair n) := + M.filter fun q ↦ 0 < Real.log + (pairGain A X (rowPairRow q 0) (rowPairRow q 1)) + +theorem positiveRowPairs_subset + {n : ℕ} (A X : Matrix (Fin n) (Fin n) ℝ) + (M : Finset (RowPair n)) : + positiveRowPairs A X M ⊆ M := by + exact Finset.filter_subset _ _ + +theorem positiveRowPairs_isRowMatching + {n : ℕ} {A X : Matrix (Fin n) (Fin n) ℝ} + {M : Finset (RowPair n)} (hM : IsRowMatching M) : + IsRowMatching (positiveRowPairs A X M) := by + intro q hq q' hq' hne + exact hM (positiveRowPairs_subset A X M hq) + (positiveRowPairs_subset A X M hq') hne + +theorem positiveRowPairs_logGain_pos + {n : ℕ} {A X : Matrix (Fin n) (Fin n) ℝ} + {M : Finset (RowPair n)} {q : RowPair n} + (hq : q ∈ positiveRowPairs A X M) : + 0 < Real.log (pairGain A X (rowPairRow q 0) (rowPairRow q 1)) := by + exact (Finset.mem_filter.mp hq).2 + +theorem positiveRowPairs_weight_eq + {n : ℕ} (A X : Matrix (Fin n) (Fin n) ℝ) + (M : Finset (RowPair n)) : + rowMatchingWeight A X (positiveRowPairs A X M) = + rowMatchingWeight A X M := by + rw [rowMatchingWeight, rowMatchingWeight, positiveRowPairs] + apply Finset.sum_subset (Finset.filter_subset _ _) + intro q hqM hqfilter + have hpos : ¬ 0 < Real.log + (pairGain A X (rowPairRow q 0) (rowPairRow q 1)) := by + intro h + exact hqfilter (Finset.mem_filter.mpr ⟨hqM, h⟩) + have hnonpos : Real.log + (pairGain A X (rowPairRow q 0) (rowPairRow q 1)) ≤ 0 := + le_of_not_gt hpos + simp [rowPairWeight, max_eq_left hnonpos] + +theorem exists_positive_maximumRowMatching + {n : ℕ} (A X : Matrix (Fin n) (Fin n) ℝ) : + ∃ M : Finset (RowPair n), IsRowMatching M ∧ + rowMatchingWeight A X M = maximumMatchingGain A X ∧ + ∀ q ∈ M, 0 < Real.log + (pairGain A X (rowPairRow q 0) (rowPairRow q 1)) := by + obtain ⟨M, hM, hmax⟩ := exists_maximumRowMatching A X + refine ⟨positiveRowPairs A X M, positiveRowPairs_isRowMatching hM, + (positiveRowPairs_weight_eq A X M).trans hmax, ?_⟩ + intro q hq + exact positiveRowPairs_logGain_pos hq + +noncomputable def cleanCycleRowPair + {n : ℕ} {η : ℝ} {P : Matrix (Fin n) (Fin n) ℝ} + {f g : Equiv.Perm (Fin n)} + (c : cleanCycleFactors η P (alternatingRowPerm f g)) : RowPair n := + ⟨(c.1 : Equiv.Perm (Fin n)).support, + (cleanCycleFactor_property c).1⟩ + +theorem rowPairRow_cleanCycleRowPair + {n : ℕ} {η : ℝ} {P : Matrix (Fin n) (Fin n) ℝ} + {f g : Equiv.Perm (Fin n)} + (c : cleanCycleFactors η P (alternatingRowPerm f g)) (k : Fin 2) : + rowPairRow (cleanCycleRowPair c) k = cleanCycleRow c k := by + rfl + +theorem cleanCycleRowPair_injective + {n : ℕ} {η : ℝ} {P : Matrix (Fin n) (Fin n) ℝ} + {f g : Equiv.Perm (Fin n)} : + Function.Injective + (cleanCycleRowPair : + cleanCycleFactors η P (alternatingRowPerm f g) → RowPair n) := by + intro c d heq + apply Subtype.ext + by_contra hcd + have hcd' : (c.1 : Equiv.Perm (Fin n)) ≠ d.1 := by + intro h + apply hcd + exact Subtype.ext h + have hdisj := (alternatingRowPerm f g).cycleFactorsFinset_pairwise_disjoint + c.1.2 d.1.2 hcd' |>.disjoint_support + have hsupp : (c.1 : Equiv.Perm (Fin n)).support = + (d.1 : Equiv.Perm (Fin n)).support := congrArg Subtype.val heq + have hr := cleanCycleRow_mem_support c 0 + exact (Finset.disjoint_left.mp hdisj) hr (by rwa [← hsupp]) + +noncomputable def successfulRowPairs + {n : ℕ} (κ τ η : ℝ) + (P X : Matrix (Fin n) (Fin n) ℝ) + (f g : Equiv.Perm (Fin n)) : Finset (RowPair n) := + (successfulCleanCycles κ τ η P X f g).image cleanCycleRowPair + +theorem successfulRowPairs_isRowMatching + {n : ℕ} (κ τ η : ℝ) + (P X : Matrix (Fin n) (Fin n) ℝ) + (f g : Equiv.Perm (Fin n)) : + IsRowMatching (successfulRowPairs κ τ η P X f g) := by + intro q hq q' hq' hqq' + obtain ⟨c, hc, rfl⟩ := Finset.mem_image.mp hq + obtain ⟨d, hd, rfl⟩ := Finset.mem_image.mp hq' + have hcd : c ≠ d := by + intro heq + subst d + exact hqq' rfl + have hcd' : (c.1 : Equiv.Perm (Fin n)) ≠ d.1 := by + intro heq + apply hcd + exact Subtype.ext (Subtype.ext heq) + exact (alternatingRowPerm f g).cycleFactorsFinset_pairwise_disjoint + c.1.2 d.1.2 hcd' |>.disjoint_support + +theorem successfulRowPairs_weight_eq + {n : ℕ} {κ τ η : ℝ} + {A P X : Matrix (Fin n) (Fin n) ℝ} + (f g : Equiv.Perm (Fin n)) + (hpositive : ∀ c ∈ successfulCleanCycles κ τ η P X f g, + 0 ≤ Real.log + (pairGain A X (cleanCycleRow c 0) (cleanCycleRow c 1))) : + rowMatchingWeight A X (successfulRowPairs κ τ η P X f g) = + ∑ c ∈ successfulCleanCycles κ τ η P X f g, + Real.log (pairGain A X (cleanCycleRow c 0) (cleanCycleRow c 1)) := by + rw [rowMatchingWeight, successfulRowPairs, + Finset.sum_image (cleanCycleRowPair_injective.injOn)] + apply Finset.sum_congr rfl + intro c hc + rw [rowPairWeight, rowPairRow_cleanCycleRowPair, + rowPairRow_cleanCycleRowPair, max_eq_right (hpositive c hc)] + +/-- The computable maximum-weight matching dominates the disjoint successful +clean pairs used only in the analysis. -/ +theorem maximumMatchingGain_ge_successfulCleanCycles + {n : ℕ} {κ τ η γ : ℝ} + {A P X : Matrix (Fin n) (Fin n) ℝ} + (f g : Equiv.Perm (Fin n)) + (hγ : 0 ≤ γ) + (hpoint : ∀ c ∈ successfulCleanCycles κ τ η P X f g, + γ ≤ Real.log + (pairGain A X (cleanCycleRow c 0) (cleanCycleRow c 1))) : + ((successfulCleanCycles κ τ η P X f g).card : ℝ) * γ ≤ + maximumMatchingGain A X := by + have hpositive : ∀ c ∈ successfulCleanCycles κ τ η P X f g, + 0 ≤ Real.log + (pairGain A X (cleanCycleRow c 0) (cleanCycleRow c 1)) := by + intro c hc + exact hγ.trans (hpoint c hc) + have hsum : ((successfulCleanCycles κ τ η P X f g).card : ℝ) * γ ≤ + ∑ c ∈ successfulCleanCycles κ τ η P X f g, + Real.log (pairGain A X (cleanCycleRow c 0) (cleanCycleRow c 1)) := by + calc + ((successfulCleanCycles κ τ η P X f g).card : ℝ) * γ = + ∑ _c ∈ successfulCleanCycles κ τ η P X f g, γ := by simp + _ ≤ _ := Finset.sum_le_sum hpoint + rw [← successfulRowPairs_weight_eq f g hpositive] at hsum + exact hsum.trans (rowMatchingWeight_le_maximum A X + (successfulRowPairs_isRowMatching κ τ η P X f g)) + +/-- Once the three exceptional sets have the advertised sizes, the clean +pair lemma and disjointness give the full near-case matching gain. -/ +theorem maximumMatchingGain_ge_threeEighths_of_structuralBounds + {n : ℕ} (hn : 0 < n) + {κ₀ ξ₀ γ₀ ell ξ τ η : ℝ} + (hgain : CleanPairGainGuarantee κ₀ ξ₀ γ₀) + (hκ₀ : 0 < κ₀) (hγ₀ : 0 ≤ γ₀) + (hell : 1 ≤ ell) (hlogn : Real.log n ≤ ell * Real.log 2) + (hξ : 0 < ξ) (hξ₀ : ξ ≤ ξ₀) (hτscale : τ = ξ / (4 * ell)) + {A P X : Matrix (Fin n) (Fin n) ℝ} + (hA : Matrix.Positive A) + (hP : ∀ i, IsStrictProbabilityVector (P i)) + (hPds : IsDoublyStochastic P) + (hX : IsDoublyStochastic X) + (hXint : ∀ i, IsInteriorProbabilityVector (X i)) + {R C : Fin n → ℝ} (hKKT : HasLogKKT τ A X R C) + (f g : Equiv.Perm (Fin n)) + (hheavy : ∀ i j, j ∈ heavyCoordinates η (P i) → + j = f i ∨ j = g i) + (hηhalf : η < 1 / 2) + (hbad : ((badRows η P).card : ℝ) ≤ n / 128) + (hlong : (longCycleGoodRows η P (alternatingRowPerm f g) : ℝ) ≤ + n / 16) + (hcore : coreTransferCost (fun i ↦ coreOutside (f i) (g i)) P + (fun i j ↦ transferU τ (X i) j) / n ≤ + (1 / 16) * ((1 / 2 - η) * κ₀)) : + 3 * γ₀ / 8 * n ≤ maximumMatchingGain A X := by + have hellpos : 0 < ell := lt_of_lt_of_le (by norm_num) hell + have hτ : 0 ≤ τ := by + rw [hτscale] + positivity + have hfactor : 0 ≤ 1 / 2 - η := (sub_pos.mpr hηhalf).le + have hmin : 0 < (1 / 2 - η) * κ₀ := + mul_pos (sub_pos.mpr hηhalf) hκ₀ + have hfailed : ((failedCleanCycles κ₀ τ η P X f g).card : ℝ) ≤ n / 16 := by + have hf := failedCleanCycles_count_le hn hP hPds hτ + hfactor hmin hXint f g hheavy hcore + nlinarith + have hsuccess := successfulCleanCycles_count_ge_threeEighths hP f g + hheavy hbad hlong hfailed + have hmatching := maximumMatchingGain_ge_successfulCleanCycles + (A := A) (P := P) (X := X) (κ := κ₀) (τ := τ) (η := η) + (γ := γ₀) f g hγ₀ + (fun c hc ↦ successfulCleanCycle_gain hgain hell hlogn hξ hξ₀ + (P := P) (η := η) hτscale hA hX hXint hKKT f g c hc) + have hfinal := matchingGain_ge_threeEighths hγ₀ hsuccess hmatching + nlinarith + +/-- The structural content of the near case, separated from the choice of +matching algorithm. It produces two perfect matchings whose alternating +permutation contains at least `3n/8` successful clean two-cycles. -/ +theorem nearCase_successfulCleanCycles_count_ge_threeEighths + (hrowInequality : AnariRezaeiRowInequality) + {n : ℕ} (hn : 2 ≤ n) + {κ₀ ell ξ τ η δ : ℝ} + (hκ₀ : 0 < κ₀) + (hell : 1 ≤ ell) (hlogn : Real.log n ≤ ell * Real.log 2) + (hξ : 0 < ξ) (hτscale : τ = ξ / (4 * ell)) + (hη : 0 < η) (hηtenth : η ≤ 1 / 10) + (hrowSmall : δ / (η / 3074) ^ 4 ≤ 1 / 128) + (hcycleSmall : 6 / Real.log 2 * + (δ + (1 + Real.log 2 / 2) * (δ / (η / 3074) ^ 4) + + goodRowOmega η) ≤ 1 / 16) + (htransferSmall : + δ + 2 * ξ + binaryEntropy η + η + + (1 + Real.log 2) * (δ / (η / 3074) ^ 4) ≤ + (1 / 16) * ((1 / 2 - η) * κ₀)) + {A X : Matrix (Fin n) (Fin n) ℝ} + (hA : Matrix.Positive A) + (hX : IsDoublyStochastic X) + (hXint : ∀ i, IsInteriorProbabilityVector (X i)) + {R C : Fin n → ℝ} (hKKT : HasLogKKT τ A X R C) + (hnear : betheSlack n (betheLogValue A) + (Real.log (Matrix.permanent A)) < δ * n) : + ∃ f g : Equiv.Perm (Fin n), + 3 * n / 8 ≤ + ((successfulCleanCycles κ₀ τ η (assignmentMarginal A) X f g).card : ℝ) := by + have hnpos : 0 < n := by omega + have hnR : 0 < (n : ℝ) := by exact_mod_cast hnpos + let P := assignmentMarginal A + let S := betheSlack n (betheLogValue A) + (Real.log (Matrix.permanent A)) + let D := gibbsSequentialDivergence A + have hPds : IsDoublyStochastic P := by + exact assignmentMarginal_doublyStochastic A + (fun i j ↦ (hA i j).le) + (permanent_pos_of_positive A hA).ne' + have hPstrict : ∀ i, IsStrictProbabilityVector (P i) := + assignmentMarginal_strictProbabilityVector A hA + have hseq : Real.log (Matrix.permanent A) = + betheObjective A P + (∑ i, rowCorrection (P i)) - D := by + exact gibbs_exact_sequential_identity A hA + have hdecomp : S = + betheSuboptimality (betheLogValue A) (betheObjective A P) + + (∑ i, rowDeficit (P i)) + D := + slack_decomposition_rowDeficit P hseq + have hsub0 : 0 ≤ + betheSuboptimality (betheLogValue A) (betheObjective A P) := by + rw [betheSuboptimality] + exact sub_nonneg.mpr + (betheObjective_le_betheLogValue_of_positive hA hPds) + have hrow0 : 0 ≤ ∑ i, rowDeficit (P i) := + Finset.sum_nonneg fun i _ ↦ hrowInequality hn (P i) (hPstrict i).1 + have hD0 : 0 ≤ D := gibbsSequentialDivergence_nonneg A hA + have hterms := terms_le_slack_of_decomposition hsub0 hrow0 hD0 hdecomp + have hrowSum : (∑ i, rowDeficit (P i)) ≤ S := hterms.2.1 + have hDle : D ≤ S := hterms.2.2 + have hSlt : S < δ * n := by simpa only [S] using hnear + have hd0 : 0 < (η / 3074) ^ 4 := pow_pos (div_pos hη (by norm_num)) 4 + have hbadRaw := badRow_count_le_slack hrowInequality hn hη hPstrict hrowSum + have hquot : S / (η / 3074) ^ 4 < + (δ / (η / 3074) ^ 4) * n := by + calc + S / (η / 3074) ^ 4 < (δ * n) / (η / 3074) ^ 4 := + (div_lt_div_iff_of_pos_right hd0).2 hSlt + _ = (δ / (η / 3074) ^ 4) * n := by ring + have hbadError : ((badRows η P).card : ℝ) ≤ + (δ / (η / 3074) ^ 4) * n := + hbadRaw.trans hquot.le + have hbad : ((badRows η P).card : ℝ) ≤ n / 128 := by + have hscaled := mul_le_mul_of_nonneg_right hrowSmall (Nat.cast_nonneg n) + nlinarith + obtain ⟨f, g, hheavy, hrobust⟩ := + exists_gibbs_robust_cycle_information A hA hη.le hηtenth + have hlongRaw := longRow_count_le_cycleError + (n := (n : ℝ)) (D := D) + (N := (longCycleGoodRows η P (alternatingRowPerm f g) : ℝ)) + (bad := ((badRows η P).card : ℝ)) + (δ := δ) (rowError := δ / (η / 3074) ^ 4) + (ω := goodRowOmega η) + (cycleError := 6 / Real.log 2 * + (δ + (1 + Real.log 2 / 2) * (δ / (η / 3074) ^ 4) + + goodRowOmega η)) + (Nat.cast_nonneg n) (hDle.trans_lt hSlt).le + hbadError + (by simpa only [P, D] using hrobust) rfl + have hlong : (longCycleGoodRows η P (alternatingRowPerm f g) : ℝ) ≤ + n / 16 := by + have hscaled := mul_le_mul_of_nonneg_right hcycleSmall (Nat.cast_nonneg n) + nlinarith + have hbudget : τ * (n * Real.log n) ≤ ξ * n := + regularization_budget_of_paper_scale + (lt_of_lt_of_le (by norm_num) hell) hlogn hξ hτscale + have hτ : 0 ≤ τ := by rw [hτscale]; positivity + have hcoreRaw := gibbs_twoMatching_coreTransferCost_normalized_le hnpos + A hA hτ hbudget ⟨hη.le, hηtenth.trans (by norm_num)⟩ f g hheavy + hX hXint hKKT + have hSnorm : S / n < δ := (div_lt_iff₀ hnR).2 hSlt + have hbadNorm : ((badRows η P).card : ℝ) / n ≤ + δ / (η / 3074) ^ 4 := by + exact (div_le_iff₀ hnR).2 hbadError + have hcore : coreTransferCost (fun i ↦ coreOutside (f i) (g i)) P + (fun i j ↦ transferU τ (X i) j) / n ≤ + (1 / 16) * ((1 / 2 - η) * κ₀) := by + have hraw : coreTransferCost (fun i ↦ coreOutside (f i) (g i)) P + (fun i j ↦ transferU τ (X i) j) / n ≤ + S / n + 2 * ξ + binaryEntropy η + η + + (1 + Real.log 2) * ((badRows η P).card : ℝ) / n := by + simpa only [P, S] using hcoreRaw + have hbadCoeff : 0 ≤ 1 + Real.log 2 := by + have := Real.log_pos (by norm_num : (1 : ℝ) < 2) + linarith + have htail := mul_le_mul_of_nonneg_left hbadNorm hbadCoeff + have hraw' : coreTransferCost (fun i ↦ coreOutside (f i) (g i)) P + (fun i j ↦ transferU τ (X i) j) / n ≤ + S / n + 2 * ξ + binaryEntropy η + η + + (1 + Real.log 2) * (((badRows η P).card : ℝ) / n) := by + convert hraw using 1 <;> ring + linarith + have hfactor : 0 ≤ 1 / 2 - η := + (sub_pos.mpr (hηtenth.trans_lt (by norm_num))).le + have hmin : 0 < (1 / 2 - η) * κ₀ := + mul_pos (sub_pos.mpr (hηtenth.trans_lt (by norm_num))) hκ₀ + have hfailed : ((failedCleanCycles κ₀ τ η P X f g).card : ℝ) ≤ + n / 16 := by + have hf := failedCleanCycles_count_le hnpos hPstrict hPds hτ + hfactor hmin hXint f g hheavy hcore + nlinarith + have hsuccess := successfulCleanCycles_count_ge_threeEighths hPstrict f g + hheavy hbad hlong hfailed + refine ⟨f, g, ?_⟩ + simpa only [P] using hsuccess + +/-- Full structural near case for a positive matrix. The three displayed +smallness hypotheses are exactly the row, long-cycle, and transfer choices in +the paper's completion section. -/ +theorem nearCase_maximumMatchingGain_ge_threeEighths + (hrowInequality : AnariRezaeiRowInequality) + {n : ℕ} (hn : 2 ≤ n) + {κ₀ ξ₀ γ₀ ell ξ τ η δ : ℝ} + (hgain : CleanPairGainGuarantee κ₀ ξ₀ γ₀) + (hκ₀ : 0 < κ₀) (hγ₀ : 0 ≤ γ₀) + (hell : 1 ≤ ell) (hlogn : Real.log n ≤ ell * Real.log 2) + (hξ : 0 < ξ) (hξ₀ : ξ ≤ ξ₀) (hτscale : τ = ξ / (4 * ell)) + (hη : 0 < η) (hηtenth : η ≤ 1 / 10) + (hrowSmall : δ / (η / 3074) ^ 4 ≤ 1 / 128) + (hcycleSmall : 6 / Real.log 2 * + (δ + (1 + Real.log 2 / 2) * (δ / (η / 3074) ^ 4) + + goodRowOmega η) ≤ 1 / 16) + (htransferSmall : + δ + 2 * ξ + binaryEntropy η + η + + (1 + Real.log 2) * (δ / (η / 3074) ^ 4) ≤ + (1 / 16) * ((1 / 2 - η) * κ₀)) + {A X : Matrix (Fin n) (Fin n) ℝ} + (hA : Matrix.Positive A) + (hX : IsDoublyStochastic X) + (hXint : ∀ i, IsInteriorProbabilityVector (X i)) + {R C : Fin n → ℝ} (hKKT : HasLogKKT τ A X R C) + (hnear : betheSlack n (betheLogValue A) + (Real.log (Matrix.permanent A)) < δ * n) : + 3 * γ₀ / 8 * n ≤ maximumMatchingGain A X := by + obtain ⟨f, g, hsuccess⟩ := + nearCase_successfulCleanCycles_count_ge_threeEighths hrowInequality hn + hκ₀ hell hlogn hξ hτscale hη hηtenth hrowSmall hcycleSmall + htransferSmall hA hX hXint hKKT hnear + have hmatching := maximumMatchingGain_ge_successfulCleanCycles + (A := A) (P := assignmentMarginal A) (X := X) + (κ := κ₀) (τ := τ) (η := η) (γ := γ₀) f g hγ₀ + (fun c hc ↦ successfulCleanCycle_gain hgain hell hlogn hξ hξ₀ + hτscale hA hX hXint hKKT f g c hc) + have hfinal := matchingGain_ge_threeEighths hγ₀ hsuccess hmatching + nlinarith + +theorem rowPairRow_mem + {n : ℕ} (q : RowPair n) (k : Fin 2) : rowPairRow q k ∈ q.1 := by + exact (q.1.orderIsoOfFin q.2 k).2 + +theorem rowPairRow_injective + {n : ℕ} (q : RowPair n) : Function.Injective (rowPairRow q) := by + intro k l hkl + apply (q.1.orderIsoOfFin q.2).injective + exact Subtype.ext hkl + +theorem rowPairRow_ne + {n : ℕ} (q : RowPair n) : rowPairRow q 0 ≠ rowPairRow q 1 := by + intro h + have hk := rowPairRow_injective q h + norm_num at hk + +noncomputable def matchingRows + {n : ℕ} (M : Finset (RowPair n)) : Finset (Fin n) := + M.biUnion fun q ↦ q.1 + +abbrev UnmatchedRow {n : ℕ} (M : Finset (RowPair n)) := + {i : Fin n // i ∉ matchingRows M} + +abbrev MatchingCluster {n : ℕ} (M : Finset (RowPair n)) := + M ⊕ UnmatchedRow M + +def matchingClusterSize + {n : ℕ} {M : Finset (RowPair n)} : MatchingCluster M → ℕ + | Sum.inl _ => 2 + | Sum.inr _ => 1 + +noncomputable def matchingRowMap + {n : ℕ} (M : Finset (RowPair n)) : + (Σ c : MatchingCluster M, Fin (matchingClusterSize c)) → Fin n + | ⟨Sum.inl q, k⟩ => rowPairRow q.1 k + | ⟨Sum.inr i, _⟩ => i.1 + +theorem matchingRowMap_bijective + {n : ℕ} {M : Finset (RowPair n)} (hM : IsRowMatching M) : + Function.Bijective (matchingRowMap M) := by + constructor + · rintro ⟨c, k⟩ ⟨d, l⟩ heq + rcases c with q | i <;> rcases d with q' | i' + · change Fin 2 at k l + change rowPairRow q.1 k = rowPairRow q'.1 l at heq + have hqq : q = q' := by + by_contra hne + have hne' : q.1 ≠ q'.1 := by + intro h + exact hne (Subtype.ext h) + have hdisj := hM q.2 q'.2 hne' + exact (Finset.disjoint_left.mp hdisj) + (rowPairRow_mem q.1 k) (by rw [heq]; exact rowPairRow_mem q'.1 l) + subst q' + have hkl : k = l := rowPairRow_injective q.1 heq + subst l + rfl + · change Fin 2 at k + change rowPairRow q.1 k = i'.1 at heq + have hmatched : rowPairRow q.1 k ∈ matchingRows M := by + exact Finset.mem_biUnion.mpr ⟨q.1, q.2, rowPairRow_mem q.1 k⟩ + have : i'.1 ∈ matchingRows M := by rwa [← heq] + exact False.elim (i'.2 this) + · change Fin 2 at l + change i.1 = rowPairRow q'.1 l at heq + have hmatched : rowPairRow q'.1 l ∈ matchingRows M := by + exact Finset.mem_biUnion.mpr ⟨q'.1, q'.2, rowPairRow_mem q'.1 l⟩ + have : i.1 ∈ matchingRows M := by rwa [heq] + exact False.elim (i.2 this) + · have hii : i = i' := Subtype.ext heq + subst i' + change Fin 1 at k l + have hkl : k = l := Subsingleton.elim _ _ + subst l + rfl + · intro i + by_cases hi : i ∈ matchingRows M + · obtain ⟨q, hqM, hiq⟩ := Finset.mem_biUnion.mp hi + let qM : M := ⟨q, hqM⟩ + obtain ⟨k, hk⟩ := (q.1.orderIsoOfFin q.2).surjective ⟨i, hiq⟩ + exact ⟨⟨Sum.inl qM, k⟩, by exact congrArg Subtype.val hk⟩ + · let k : Fin (matchingClusterSize (Sum.inr ⟨i, hi⟩ : MatchingCluster M)) := + ⟨0, by simp [matchingClusterSize]⟩ + exact ⟨⟨Sum.inr ⟨i, hi⟩, k⟩, rfl⟩ + +/-- The row-labeling equivalence, written with an explicit forward map so its +action on a cluster is transparent to subsequent proofs. -/ +noncomputable def matchingRowsEquiv + {n : ℕ} (M : Finset (RowPair n)) (hM : IsRowMatching M) : + (Σ c : MatchingCluster M, Fin (matchingClusterSize c)) ≃ Fin n where + toFun := matchingRowMap M + invFun := Function.surjInv (matchingRowMap_bijective hM).2 + left_inv := Function.leftInverse_surjInv (matchingRowMap_bijective hM) + right_inv := Function.rightInverse_surjInv _ + +@[simp] theorem matchingRowsEquiv_apply + {n : ℕ} (M : Finset (RowPair n)) (hM : IsRowMatching M) + (x : Σ c : MatchingCluster M, Fin (matchingClusterSize c)) : + matchingRowsEquiv M hM x = matchingRowMap M x := rfl + +/-- Convert a disjoint row matching into the singleton/pair clustering used +by the paired-certificate theorem. -/ +noncomputable def rowClusteringOfMatching + {n : ℕ} (M : Finset (RowPair n)) (hM : IsRowMatching M) : + RowClustering n where + Cluster := MatchingCluster M + clusterFintype := inferInstance + clusterDecidableEq := Classical.decEq _ + size := matchingClusterSize + rows := matchingRowsEquiv M hM + +theorem rowClusteringOfMatching_singletonPairs + {n : ℕ} (M : Finset (RowPair n)) (hM : IsRowMatching M) : + IsSingletonPairClustering (rowClusteringOfMatching M hM) := by + intro c + rcases c with q | i + · exact Or.inr rfl + · exact Or.inl rfl + +theorem singletonClusterRow_rowClusteringOfMatching + {n : ℕ} (M : Finset (RowPair n)) (hM : IsRowMatching M) + (i : UnmatchedRow M) : + singletonClusterRow (rowClusteringOfMatching M hM) (Sum.inr i) rfl = i.1 := by + rfl + +theorem pairClusterRow_rowClusteringOfMatching + {n : ℕ} (M : Finset (RowPair n)) (hM : IsRowMatching M) + (q : M) (k : Fin 2) : + pairClusterRow (rowClusteringOfMatching M hM) (Sum.inl q) rfl k = + rowPairRow q.1 k := by + rfl + +theorem rowClusteringOfMatching_rows_pair + {n : ℕ} (M : Finset (RowPair n)) (hM : IsRowMatching M) + (q : M) (k : Fin 2) : + (rowClusteringOfMatching M hM).rows ⟨Sum.inl q, k⟩ = + rowPairRow q.1 k := by + rfl + +theorem rowClusteringOfMatching_rows_singleton + {n : ℕ} (M : Finset (RowPair n)) (hM : IsRowMatching M) + (i : UnmatchedRow M) (k : Fin 1) : + (rowClusteringOfMatching M hM).rows ⟨Sum.inr i, k⟩ = i.1 := by + have hk : k = 0 := Subsingleton.elim _ _ + subst k + rfl + +theorem pairCertificateValue_nonneg + {n : ℕ} {A X : Matrix (Fin n) (Fin n) ℝ} + (hA : Matrix.Nonnegative A) (hX : IsDoublyStochastic X) + {r s : Fin n} (hrs : r ≠ s) : + 0 ≤ pairCertificateValue A X r s := by + rw [pairCertificateValue] + apply mul_nonneg + · exact Finset.prod_nonneg fun j _ ↦ Real.rpow_nonneg + (sub_nonneg.mpr (pairAlpha_le_one hX hrs j)) _ + · exact polynomialCapacity_nonneg + (pairPolynomial_nonnegativeCoefficients (hA r) (hA s)) _ + +/-- Algebraic meaning of the gain ratio: a pair factor is its gain times the +two singleton factors that it replaces. -/ +theorem pairCertificateValue_eq_pairGain_mul_singletons + {n : ℕ} {A X : Matrix (Fin n) (Fin n) ℝ} + (hcard : 2 ≤ n) (hA : Matrix.Positive A) + (hX : IsDoublyStochastic X) (hXpos : ∀ i j, 0 < X i j) + (r s : Fin n) : + pairCertificateValue A X r s = + pairGain A X r s * (singletonFactor A X r * singletonFactor A X s) := by + have hr := singletonProductValue_eq_singletonFactor hcard hA hX hXpos r + have hs := singletonProductValue_eq_singletonFactor hcard hA hX hXpos s + have hden : singletonFactor A X r * singletonFactor A X s ≠ 0 := + mul_ne_zero (Real.exp_ne_zero _) (Real.exp_ne_zero _) + rw [pairGain, hr, hs] + exact (div_mul_cancel₀ _ hden).symm + +theorem pairCertificateValue_eq_exp_logGain_mul_singletons + {n : ℕ} {A X : Matrix (Fin n) (Fin n) ℝ} + (hcard : 2 ≤ n) (hA : Matrix.Positive A) + (hX : IsDoublyStochastic X) (hXpos : ∀ i j, 0 < X i j) + (r s : Fin n) (hrs : r ≠ s) + (hgain : 0 < Real.log (pairGain A X r s)) : + pairCertificateValue A X r s = + Real.exp (Real.log (pairGain A X r s)) * + (singletonFactor A X r * singletonFactor A X s) := by + have hgain0 : 0 ≤ pairGain A X r s := by + have hr := singletonProductValue_eq_singletonFactor hcard hA hX hXpos r + have hs := singletonProductValue_eq_singletonFactor hcard hA hX hXpos s + have hden : 0 ≤ singletonProductValue A X r * singletonProductValue A X s := by + rw [hr, hs] + exact mul_nonneg (Real.exp_pos _).le (Real.exp_pos _).le + rw [pairGain] + exact div_nonneg (pairCertificateValue_nonneg + (fun i j ↦ (hA i j).le) hX hrs) + hden + have hone : 1 < pairGain A X r s := (Real.log_pos_iff hgain0).mp hgain + rw [Real.exp_log (zero_lt_one.trans hone)] + exact pairCertificateValue_eq_pairGain_mul_singletons hcard hA hX hXpos r s + +noncomputable def matchingClusterLogGain + {n : ℕ} (A X : Matrix (Fin n) (Fin n) ℝ) + {M : Finset (RowPair n)} : MatchingCluster M → ℝ + | Sum.inl q => Real.log + (pairGain A X (rowPairRow q.1 0) (rowPairRow q.1 1)) + | Sum.inr _ => 0 + +theorem sum_matchingClusterLogGain_eq_rowMatchingWeight + {n : ℕ} {A X : Matrix (Fin n) (Fin n) ℝ} + {M : Finset (RowPair n)} + (hpositive : ∀ q ∈ M, 0 < Real.log + (pairGain A X (rowPairRow q 0) (rowPairRow q 1))) : + ∑ c : MatchingCluster M, matchingClusterLogGain A X c = + rowMatchingWeight A X M := by + rw [Fintype.sum_sum_type] + simp only [matchingClusterLogGain] + have hzero : (∑ _i : UnmatchedRow M, (0 : ℝ)) = 0 := by simp + rw [hzero, add_zero] + calc + (∑ q : M, Real.log + (pairGain A X (rowPairRow q.1 0) (rowPairRow q.1 1))) = + ∑ q ∈ M, Real.log + (pairGain A X (rowPairRow q 0) (rowPairRow q 1)) := + by + simpa using (Finset.sum_coe_sort M (fun q : RowPair n ↦ + Real.log (pairGain A X (rowPairRow q 0) (rowPairRow q 1)))) + _ = rowMatchingWeight A X M := by + rw [rowMatchingWeight] + apply Finset.sum_congr rfl + intro q hq + rw [rowPairWeight, max_eq_right (hpositive q hq).le] + +theorem paperClusterFactor_rowClusteringOfMatching + {n : ℕ} {A X : Matrix (Fin n) (Fin n) ℝ} + {M : Finset (RowPair n)} (hM : IsRowMatching M) + (hcard : 2 ≤ n) (hA : Matrix.Positive A) + (hX : IsDoublyStochastic X) (hXpos : ∀ i j, 0 < X i j) + (hpositive : ∀ q ∈ M, 0 < Real.log + (pairGain A X (rowPairRow q 0) (rowPairRow q 1))) + (c : MatchingCluster M) : + paperClusterFactor A X (rowClusteringOfMatching M hM) + (rowClusteringOfMatching_singletonPairs M hM) c = + Real.exp (matchingClusterLogGain A X c) * + ∏ k, singletonFactor A X + ((rowClusteringOfMatching M hM).rows ⟨c, k⟩) := by + rcases c with q | i + · change pairCertificateValue A X (rowPairRow q.1 0) (rowPairRow q.1 1) = _ + rw [pairCertificateValue_eq_exp_logGain_mul_singletons hcard hA hX hXpos + (rowPairRow q.1 0) (rowPairRow q.1 1) (rowPairRow_ne q.1) + (hpositive q.1 q.2)] + rw [matchingClusterLogGain] + simp only [rowClusteringOfMatching_rows_pair] + have hprod := Fin.prod_univ_two (fun k : Fin 2 ↦ + singletonFactor A X (rowPairRow q.1 k)) + exact congrArg (Real.exp + (Real.log (pairGain A X (rowPairRow q.1 0) (rowPairRow q.1 1))) * ·) + hprod.symm + · change singletonFactor A X i.1 = _ + change singletonFactor A X i.1 = Real.exp 0 * + ∏ _k : Fin 1, singletonFactor A X i.1 + simp + +theorem prod_paperClusterFactor_rowClusteringOfMatching + {n : ℕ} {A X : Matrix (Fin n) (Fin n) ℝ} + {M : Finset (RowPair n)} (hM : IsRowMatching M) + (hcard : 2 ≤ n) (hA : Matrix.Positive A) + (hX : IsDoublyStochastic X) (hXpos : ∀ i j, 0 < X i j) + (hpositive : ∀ q ∈ M, 0 < Real.log + (pairGain A X (rowPairRow q 0) (rowPairRow q 1))) : + (∏ c, paperClusterFactor A X (rowClusteringOfMatching M hM) + (rowClusteringOfMatching_singletonPairs M hM) c) = + Real.exp (betheObjective A X + rowMatchingWeight A X M) := by + let hclusters := rowClusteringOfMatching_singletonPairs M hM + calc + (∏ c, paperClusterFactor A X (rowClusteringOfMatching M hM) hclusters c) = + ∏ c, (Real.exp (matchingClusterLogGain A X c) * + ∏ k, singletonFactor A X + ((rowClusteringOfMatching M hM).rows ⟨c, k⟩)) := by + apply Finset.prod_congr rfl + intro c _ + exact paperClusterFactor_rowClusteringOfMatching hM hcard hA hX hXpos + hpositive c + _ = (∏ c, Real.exp (matchingClusterLogGain A X c)) * + ∏ c, ∏ k, singletonFactor A X + ((rowClusteringOfMatching M hM).rows ⟨c, k⟩) := by + exact Finset.prod_mul_distrib + _ = Real.exp (∑ c : MatchingCluster M, matchingClusterLogGain A X c) * + ∏ s : Σ c : (rowClusteringOfMatching M hM).Cluster, + Fin ((rowClusteringOfMatching M hM).size c), + singletonFactor A X ((rowClusteringOfMatching M hM).rows s) := by + rw [Real.exp_sum, ← Fintype.prod_sigma'] + _ = Real.exp (rowMatchingWeight A X M) * + ∏ i, singletonFactor A X i := by + rw [sum_matchingClusterLogGain_eq_rowMatchingWeight hpositive] + exact congrArg (Real.exp (rowMatchingWeight A X M) * ·) + (Equiv.prod_comp (rowClusteringOfMatching M hM).rows + (singletonFactor A X)) + _ = Real.exp (rowMatchingWeight A X M) * + Real.exp (betheObjective A X) := by + rw [prod_singletonFactor_eq_exp_betheObjective] + _ = Real.exp (betheObjective A X + rowMatchingWeight A X M) := by + rw [← Real.exp_add] + congr 1 + ring + +/-- Every positive-gain row matching produces a certified lower bound. -/ +theorem exp_betheObjective_add_rowMatchingWeight_le_permanent + {n : ℕ} + (stableCoefficient : AnariOveisGharanStableCoefficient.{0}) + {A X : Matrix (Fin n) (Fin n) ℝ} + {M : Finset (RowPair n)} (hM : IsRowMatching M) + (hcard : 2 ≤ n) (hA : Matrix.Positive A) + (hX : IsDoublyStochastic X) (hXpos : ∀ i j, 0 < X i j) + (hpositive : ∀ q ∈ M, 0 < Real.log + (pairGain A X (rowPairRow q 0) (rowPairRow q 1))) : + Real.exp (betheObjective A X + rowMatchingWeight A X M) ≤ + Matrix.permanent A := by + rw [← prod_paperClusterFactor_rowClusteringOfMatching hM hcard hA hX + hXpos hpositive] + exact pairedLowerCertificate_for_clustering stableCoefficient + (rowClusteringOfMatching M hM) hcard hA hX hXpos + (rowClusteringOfMatching_singletonPairs M hM) + +/-- The output based on a maximum-weight row matching remains below the +permanent. Zero-gain edges are deleted before applying the cluster theorem. -/ +theorem exp_betheObjective_add_maximumMatchingGain_le_permanent + {n : ℕ} + (stableCoefficient : AnariOveisGharanStableCoefficient.{0}) + {A X : Matrix (Fin n) (Fin n) ℝ} + (hcard : 2 ≤ n) (hA : Matrix.Positive A) + (hX : IsDoublyStochastic X) (hXpos : ∀ i j, 0 < X i j) : + Real.exp (betheObjective A X + maximumMatchingGain A X) ≤ + Matrix.permanent A := by + obtain ⟨M, hM, hmax, hpositive⟩ := exists_positive_maximumRowMatching A X + rw [← hmax] + exact exp_betheObjective_add_rowMatchingWeight_le_permanent + stableCoefficient hM hcard hA hX hXpos hpositive + +/-- Positive-matrix form of Proposition 20. Vontobel's concavity theorem, +the sharp row inequality, and the upper Bethe bound are proved internally. -/ +theorem positiveMatrix_logApproximation + (stableCoefficient : AnariOveisGharanStableCoefficient.{0}) + {n : ℕ} (hn : 2 ≤ n) + {κ₀ ξ₀ γ₀ ell ξ τ η δ : ℝ} + (hgain : CleanPairGainGuarantee κ₀ ξ₀ γ₀) + (hκ₀ : 0 < κ₀) (hγ₀ : 0 < γ₀) + (hell : 1 ≤ ell) (hlogn : Real.log n ≤ ell * Real.log 2) + (hξ : 0 < ξ) (hξ₀ : ξ ≤ ξ₀) (hτscale : τ = ξ / (4 * ell)) + (hη : 0 < η) (hηtenth : η ≤ 1 / 10) + (hrowSmall : δ / (η / 3074) ^ 4 ≤ 1 / 128) + (hcycleSmall : 6 / Real.log 2 * + (δ + (1 + Real.log 2 / 2) * (δ / (η / 3074) ^ 4) + + goodRowOmega η) ≤ 1 / 16) + (htransferSmall : + δ + 2 * ξ + binaryEntropy η + η + + (1 + Real.log 2) * (δ / (η / 3074) ^ 4) ≤ + (1 / 16) * ((1 / 2 - η) * κ₀)) + (hξδ : ξ < δ) (hξγ : ξ < 3 * γ₀ / 8) + (A : Matrix (Fin n) (Fin n) ℝ) (hA : Matrix.Positive A) : + 0 < epsilonPlus δ ξ γ₀ ∧ + ∃ X : Matrix (Fin n) (Fin n) ℝ, + IsDoublyStochastic X ∧ + (∀ i, IsInteriorProbabilityVector (X i)) ∧ + Real.exp (betheObjective A X + maximumMatchingGain A X) ≤ + Matrix.permanent A ∧ + Real.log (Matrix.permanent A) - + (betheObjective A X + maximumMatchingGain A X) ≤ + (Real.log 2 / 2 - epsilonPlus δ ξ γ₀) * n := by + obtain ⟨X, hX, hXint, _hmax, ⟨R, C, hKKT⟩, hobjective⟩ := + exists_regularizedOptimizer_at_paper_scale + (show 1 < n by omega) (lt_of_lt_of_le (by norm_num) hell) + hlogn hξ hτscale A hA + have hmatch := positiveMatrix_hasPerfectMatching hA + have hlogBethe : Real.log (bethePermanent A) = betheLogValue A := by + rw [bethePermanent, if_pos hmatch, Real.log_exp] + have hupper : Real.log (Matrix.permanent A) ≤ + Real.log (bethePermanent A) + n * (Real.log 2 / 2) := by + rw [hlogBethe] + exact log_permanent_le_betheLogValue_add_log_two_half hn A hA + have hcertificate := + exp_betheObjective_add_maximumMatchingGain_le_permanent + stableCoefficient hn hA hX (fun i j ↦ (hXint i).2 j |>.1) + have hnearGain : betheSlack n (Real.log (bethePermanent A)) + (Real.log (Matrix.permanent A)) < δ * n → + 3 * γ₀ / 8 * n ≤ maximumMatchingGain A X := by + intro hnear + rw [hlogBethe] at hnear + exact nearCase_maximumMatchingGain_ge_threeEighths + anariRezaeiRowInequality hn + hgain hκ₀ hγ₀.le hell hlogn hξ hξ₀ hτscale hη hηtenth + hrowSmall hcycleSmall htransferSmall hA hX hXint hKKT hnear + have hcases := completionCaseDisjunction + (logPermanent := Real.log (Matrix.permanent A)) + (logBethe := Real.log (bethePermanent A)) + (objective := betheObjective A X) + (gain := maximumMatchingGain A X) + (δ := δ) (ξ := ξ) (γ := γ₀) + hobjective (maximumMatchingGain_nonneg A X) hupper hnearGain + have hgap := positiveDichotomy_exponent hcases + exact ⟨epsilonPlus_pos hξδ hξγ, X, hX, hXint, hcertificate, hgap⟩ + +/-- The hierarchy of absolute scales used in the completion exists. We +parameterize `δ` as a small multiple of `(η/3074)^4`; this makes the apparent +singularity in the row-error ratio disappear. -/ +theorem exists_completion_scales + {κ₀ ξ₀ γ₀ : ℝ} (hκ₀ : 0 < κ₀) (hξ₀ : 0 < ξ₀) (hγ₀ : 0 < γ₀) : + ∃ η δ ξ : ℝ, + 0 < η ∧ η ≤ 1 / 10 ∧ 0 < δ ∧ 0 < ξ ∧ ξ ≤ ξ₀ ∧ + δ / (η / 3074) ^ 4 ≤ 1 / 128 ∧ + 6 / Real.log 2 * + (δ + (1 + Real.log 2 / 2) * (δ / (η / 3074) ^ 4) + + goodRowOmega η) ≤ 1 / 16 ∧ + δ + 2 * ξ + binaryEntropy η + η + + (1 + Real.log 2) * (δ / (η / 3074) ^ 4) ≤ + (1 / 16) * ((1 / 2 - η) * κ₀) ∧ + ξ < δ ∧ ξ < 3 * γ₀ / 8 := by + have hlog : 0 < Real.log 2 := Real.log_pos (by norm_num) + have hωtarget : 0 < Real.log 2 / 384 := div_pos hlog (by norm_num) + have hωevent : {x : ℝ | goodRowOmega x < Real.log 2 / 384} ∈ nhds 0 := + tendsto_goodRowOmega_zero (isOpen_Iio.mem_nhds hωtarget) + have hHcont : ContinuousAt (fun x : ℝ ↦ binaryEntropy x + x) 0 := + continuous_binaryEntropy.continuousAt.add continuousAt_id + have hHtarget : 0 < κ₀ / 256 := div_pos hκ₀ (by norm_num) + have hHevent : {x : ℝ | binaryEntropy x + x < κ₀ / 256} ∈ nhds 0 := by + exact hHcont.eventually (isOpen_Iio.mem_nhds (by + simpa [binaryEntropy] using hHtarget)) + have hevent := Filter.inter_mem hωevent hHevent + rw [Metric.mem_nhds_iff] at hevent + obtain ⟨a, ha, hball⟩ := hevent + let η : ℝ := min (a / 2) (1 / 20) + have hη : 0 < η := lt_min (half_pos ha) (by norm_num) + have hηtwenty : η ≤ 1 / 20 := min_le_right _ _ + have hηa : η < a := (min_le_left _ _).trans_lt (half_lt_self ha) + have hηmem := hball (by + rw [Metric.mem_ball, Real.dist_eq, sub_zero, abs_of_pos hη] + exact hηa) + have hωsmall : goodRowOmega η < Real.log 2 / 384 := hηmem.1 + have hHsmall : binaryEntropy η + η < κ₀ / 256 := hηmem.2 + have hηtenth : η ≤ 1 / 10 := hηtwenty.trans (by norm_num) + have hcycleBase : 6 / Real.log 2 * goodRowOmega η < 1 / 64 := by + have hcoef : 0 < 6 / Real.log 2 := div_pos (by norm_num) hlog + calc + 6 / Real.log 2 * goodRowOmega η < + 6 / Real.log 2 * (Real.log 2 / 384) := + mul_lt_mul_of_pos_left hωsmall hcoef + _ = 1 / 64 := by field_simp [hlog.ne'] <;> norm_num + have hηκ : η * κ₀ ≤ (1 / 20) * κ₀ := + mul_le_mul_of_nonneg_right hηtwenty hκ₀.le + have htransferBase : binaryEntropy η + η < + (1 / 16) * ((1 / 2 - η) * κ₀) := by + nlinarith + let cycleMargin : ℝ := 1 / 16 - 6 / Real.log 2 * goodRowOmega η + let transferMargin : ℝ := + (1 / 16) * ((1 / 2 - η) * κ₀) - (binaryEntropy η + η) + have hcycleMargin : 0 < cycleMargin := by + dsimp only [cycleMargin] + linarith + have htransferMargin : 0 < transferMargin := by + dsimp only [transferMargin] + linarith + let d₀ : ℝ := (η / 3074) ^ 4 + have hd₀ : 0 < d₀ := pow_pos (div_pos hη (by norm_num)) 4 + let cycleCoefficient : ℝ := + 6 / Real.log 2 * (d₀ + (1 + Real.log 2 / 2)) + have hcycleCoefficient : 0 < cycleCoefficient := by + dsimp only [cycleCoefficient] + have hc : 0 < d₀ + (1 + Real.log 2 / 2) := by positivity + exact mul_pos (div_pos (by norm_num) hlog) hc + let transferCoefficient : ℝ := d₀ + (1 + Real.log 2) + have htransferCoefficient : 0 < transferCoefficient := by + dsimp only [transferCoefficient] + positivity + let r : ℝ := min (1 / 128) + (min (cycleMargin / (2 * cycleCoefficient)) + (transferMargin / (2 * transferCoefficient))) + have hr : 0 < r := by + dsimp only [r] + exact lt_min (by norm_num) (lt_min + (div_pos hcycleMargin (mul_pos (by norm_num) hcycleCoefficient)) + (div_pos htransferMargin (mul_pos (by norm_num) htransferCoefficient))) + have hr128 : r ≤ 1 / 128 := min_le_left _ _ + have hrcycle : r ≤ cycleMargin / (2 * cycleCoefficient) := + (min_le_right _ _).trans (min_le_left _ _) + have hrtransfer : r ≤ transferMargin / (2 * transferCoefficient) := + (min_le_right _ _).trans (min_le_right _ _) + have hcycleExtra : cycleCoefficient * r ≤ cycleMargin / 2 := by + calc + cycleCoefficient * r ≤ + cycleCoefficient * (cycleMargin / (2 * cycleCoefficient)) := + mul_le_mul_of_nonneg_left hrcycle hcycleCoefficient.le + _ = cycleMargin / 2 := by field_simp [hcycleCoefficient.ne'] + have htransferExtra : transferCoefficient * r ≤ transferMargin / 2 := by + calc + transferCoefficient * r ≤ + transferCoefficient * (transferMargin / (2 * transferCoefficient)) := + mul_le_mul_of_nonneg_left hrtransfer htransferCoefficient.le + _ = transferMargin / 2 := by field_simp [htransferCoefficient.ne'] + let δ : ℝ := d₀ * r + have hδ : 0 < δ := mul_pos hd₀ hr + have hratio : δ / (η / 3074) ^ 4 = r := by + change d₀ * r / d₀ = r + exact mul_div_cancel_left₀ r hd₀.ne' + have hcycle : 6 / Real.log 2 * + (δ + (1 + Real.log 2 / 2) * (δ / (η / 3074) ^ 4) + + goodRowOmega η) < 1 / 16 := by + rw [hratio] + have hid : 6 / Real.log 2 * + (δ + (1 + Real.log 2 / 2) * r + goodRowOmega η) = + 6 / Real.log 2 * goodRowOmega η + cycleCoefficient * r := by + dsimp only [δ, cycleCoefficient] + dsimp only [d₀] + ring + rw [hid] + dsimp only [cycleMargin] at hcycleExtra + linarith + have htransferZero : + δ + binaryEntropy η + η + + (1 + Real.log 2) * (δ / (η / 3074) ^ 4) < + (1 / 16) * ((1 / 2 - η) * κ₀) := by + rw [hratio] + have hid : δ + binaryEntropy η + η + (1 + Real.log 2) * r = + (binaryEntropy η + η) + transferCoefficient * r := by + dsimp only [δ, transferCoefficient] + ring + rw [hid] + dsimp only [transferMargin] at htransferExtra + linarith + let remaining : ℝ := (1 / 16) * ((1 / 2 - η) * κ₀) - + (δ + binaryEntropy η + η + + (1 + Real.log 2) * (δ / (η / 3074) ^ 4)) + have hremaining : 0 < remaining := by + dsimp only [remaining] + linarith + let ξ : ℝ := min (ξ₀ / 2) + (min (δ / 2) (min (3 * γ₀ / 16) (remaining / 4))) + have hξ : 0 < ξ := by + dsimp only [ξ] + exact lt_min (half_pos hξ₀) (lt_min (half_pos hδ) (lt_min + (div_pos (mul_pos (by norm_num) hγ₀) (by norm_num)) + (div_pos hremaining (by norm_num)))) + have hξξ₀ : ξ ≤ ξ₀ := + (min_le_left _ _).trans (half_le_self hξ₀.le) + have hξδ : ξ < δ := + (min_le_right _ _).trans (min_le_left _ _) |>.trans_lt (half_lt_self hδ) + have hξγ : ξ < 3 * γ₀ / 8 := by + have hle : ξ ≤ 3 * γ₀ / 16 := + (min_le_right _ _).trans ((min_le_right _ _).trans (min_le_left _ _)) + nlinarith + have hξremaining : ξ ≤ remaining / 4 := + (min_le_right _ _).trans ((min_le_right _ _).trans (min_le_right _ _)) + have htransfer : + δ + 2 * ξ + binaryEntropy η + η + + (1 + Real.log 2) * (δ / (η / 3074) ^ 4) ≤ + (1 / 16) * ((1 / 2 - η) * κ₀) := by + dsimp only [remaining] at hξremaining + nlinarith + exact ⟨η, δ, ξ, hη, hηtenth, hδ, hξ, hξξ₀, + by simpa [hratio] using hr128, hcycle.le, htransfer, hξδ, hξγ⟩ + +noncomputable def paperScaleEll (n : ℕ) : ℝ := + max 1 (Real.log n / Real.log 2) + +theorem one_le_paperScaleEll (n : ℕ) : 1 ≤ paperScaleEll n := by + exact le_max_left _ _ + +theorem log_le_paperScaleEll_mul_log_two (n : ℕ) : + Real.log n ≤ paperScaleEll n * Real.log 2 := by + have hlog : 0 < Real.log 2 := Real.log_pos (by norm_num) + have hmax : Real.log n / Real.log 2 ≤ paperScaleEll n := + le_max_right _ _ + calc + Real.log n = (Real.log n / Real.log 2) * Real.log 2 := by + field_simp [hlog.ne'] + _ ≤ paperScaleEll n * Real.log 2 := + mul_le_mul_of_nonneg_right hmax hlog.le + +/-- Exact positive-matrix certificate property at logarithmic improvement +`epsilon`. This is the mathematical core of Theorem 1 before smoothing and +finite-precision evaluation. -/ +def ExactPositiveCertificate (ε : ℝ) : Prop := + ∀ {n : ℕ}, 2 ≤ n → + ∀ A : Matrix (Fin n) (Fin n) ℝ, Matrix.Positive A → + ∃ X : Matrix (Fin n) (Fin n) ℝ, + IsDoublyStochastic X ∧ + Real.exp (betheObjective A X + maximumMatchingGain A X) ≤ + Matrix.permanent A ∧ + Real.log (Matrix.permanent A) - + (betheObjective A X + maximumMatchingGain A X) ≤ + (Real.log 2 / 2 - ε) * n + +/-- Absolute positive-matrix approximation theorem, with all constants +chosen internally. This is the mathematical core of Theorem 1 before the +standard smoothing and finite-precision wrapper. -/ +theorem exists_absolute_positiveMatrix_logApproximation + (stableCoefficient : AnariOveisGharanStableCoefficient.{0}) : + ∃ ε : ℝ, 0 < ε ∧ ∀ {n : ℕ}, 2 ≤ n → + ∀ A : Matrix (Fin n) (Fin n) ℝ, Matrix.Positive A → + ∃ X : Matrix (Fin n) (Fin n) ℝ, + IsDoublyStochastic X ∧ + Real.exp (betheObjective A X + maximumMatchingGain A X) ≤ + Matrix.permanent A ∧ + Real.log (Matrix.permanent A) - + (betheObjective A X + maximumMatchingGain A X) ≤ + (Real.log 2 / 2 - ε) * n := by + obtain ⟨κq, ξq, γq, hκq, hξq, hγq, hgain⟩ := + exists_rational_cleanPairGain_constants + have hκ : 0 < (κq : ℝ) := by exact_mod_cast hκq + have hξ₀ : 0 < (ξq : ℝ) := by exact_mod_cast hξq + have hγ : 0 < (γq : ℝ) := by exact_mod_cast hγq + obtain ⟨η, δ, ξ, hη, hηtenth, _hδ, hξ, hξξ₀, hrowSmall, + hcycleSmall, htransferSmall, hξδ, hξγ⟩ := + exists_completion_scales hκ hξ₀ hγ + let ε := epsilonPlus δ ξ (γq : ℝ) + have hε : 0 < ε := epsilonPlus_pos hξδ hξγ + refine ⟨ε, hε, ?_⟩ + intro n hn A hA + let ell := paperScaleEll n + let τ := ξ / (4 * ell) + have hresult := positiveMatrix_logApproximation stableCoefficient hn + hgain hκ hγ + (one_le_paperScaleEll n) (log_le_paperScaleEll_mul_log_two n) + hξ hξξ₀ (show τ = ξ / (4 * ell) by rfl) hη hηtenth + hrowSmall hcycleSmall htransferSmall hξδ hξγ A hA + rcases hresult with ⟨hε', X, hX, _hXint, hcert, hgap⟩ + exact ⟨X, hX, hcert, by simpa only [ε] using hgap⟩ + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/NumericalAffine.lean b/LeanPool/BeyondBethe/BeyondBethe/NumericalAffine.lean new file mode 100644 index 0000000000..d27e0d8638 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/NumericalAffine.lean @@ -0,0 +1,384 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.Transfer +import Mathlib.Tactic + +/-! # Numerical Affine -/ + +open scoped BigOperators + +namespace BeyondBethe + +/-! +# Exact rational coordinates for the Birkhoff affine hull + +The upper-left `n`-by-`n` block gives coordinates for matrices of order +`n+1`. The last row and column are recovered by the sum constraints. This +file makes the recovery map executable over the rationals and proves, without +any numerical tolerance, that its image has every row and column sum equal to +one. +-/ + +/-- Recover a matrix of order `n+1` from its upper-left `n`-by-`n` block. +The definition uses only finite sums and ring operations, so in particular it +maps rational coordinates to a rational matrix. -/ +def birkhoffAffineMap {n : ℕ} {R : Type*} [CommRing R] + (Y : Matrix (Fin n) (Fin n) R) : Matrix (Fin (n + 1)) (Fin (n + 1)) R := + Fin.snoc + (fun i ↦ Fin.snoc (Y i) (1 - ∑ j, Y i j)) + (Fin.snoc + (fun j ↦ 1 - ∑ i, Y i j) + ((∑ i, ∑ j, Y i j) - (n - 1))) + +/-- Extract the upper-left affine coordinates from a square matrix of order +`n+1`. -/ +def birkhoffAffineCoordinates {n : ℕ} {R : Type*} + (X : Matrix (Fin (n + 1)) (Fin (n + 1)) R) : + Matrix (Fin n) (Fin n) R := + fun i j ↦ X i.castSucc j.castSucc + +@[simp] theorem birkhoffAffineMap_castSucc_castSucc + {n : ℕ} {R : Type*} [CommRing R] + (Y : Matrix (Fin n) (Fin n) R) (i j : Fin n) : + birkhoffAffineMap Y i.castSucc j.castSucc = Y i j := by + simp [birkhoffAffineMap] + +@[simp] theorem birkhoffAffineMap_castSucc_last + {n : ℕ} {R : Type*} [CommRing R] + (Y : Matrix (Fin n) (Fin n) R) (i : Fin n) : + birkhoffAffineMap Y i.castSucc (Fin.last n) = 1 - ∑ j, Y i j := by + simp [birkhoffAffineMap] + +@[simp] theorem birkhoffAffineMap_last_castSucc + {n : ℕ} {R : Type*} [CommRing R] + (Y : Matrix (Fin n) (Fin n) R) (j : Fin n) : + birkhoffAffineMap Y (Fin.last n) j.castSucc = 1 - ∑ i, Y i j := by + simp [birkhoffAffineMap] + +@[simp] theorem birkhoffAffineMap_last_last + {n : ℕ} {R : Type*} [CommRing R] + (Y : Matrix (Fin n) (Fin n) R) : + birkhoffAffineMap Y (Fin.last n) (Fin.last n) = + (∑ i, ∑ j, Y i j) - (n - 1) := by + simp [birkhoffAffineMap] + +/-- Every recovered row sums to one, identically over any commutative ring. -/ +theorem birkhoffAffineMap_row_sum + {n : ℕ} {R : Type*} [CommRing R] + (Y : Matrix (Fin n) (Fin n) R) (i : Fin (n + 1)) : + ∑ j, birkhoffAffineMap Y i j = 1 := by + refine Fin.lastCases ?_ (fun i ↦ ?_) i + · rw [Fin.sum_univ_castSucc] + simp only [birkhoffAffineMap_last_castSucc, + birkhoffAffineMap_last_last] + rw [Finset.sum_sub_distrib] + simp only [Finset.sum_const, Finset.card_univ, Fintype.card_fin, + nsmul_eq_mul] + rw [Finset.sum_comm] + ring + · rw [Fin.sum_univ_castSucc] + simp + +/-- Every recovered column sums to one, identically over any commutative +ring. -/ +theorem birkhoffAffineMap_col_sum + {n : ℕ} {R : Type*} [CommRing R] + (Y : Matrix (Fin n) (Fin n) R) (j : Fin (n + 1)) : + ∑ i, birkhoffAffineMap Y i j = 1 := by + refine Fin.lastCases ?_ (fun j ↦ ?_) j + · rw [Fin.sum_univ_castSucc] + simp only [birkhoffAffineMap_castSucc_last, + birkhoffAffineMap_last_last] + rw [Finset.sum_sub_distrib] + simp only [Finset.sum_const, Finset.card_univ, Fintype.card_fin, + nsmul_eq_mul] + ring + · rw [Fin.sum_univ_castSucc] + simp + +/-- A matrix in the Birkhoff affine hull is recovered exactly from its +upper-left block. -/ +theorem birkhoffAffineMap_coordinates_of_unit_sums + {n : ℕ} {R : Type*} [CommRing R] + (X : Matrix (Fin (n + 1)) (Fin (n + 1)) R) + (hrow : ∀ i, ∑ j, X i j = 1) + (hcol : ∀ j, ∑ i, X i j = 1) : + birkhoffAffineMap (birkhoffAffineCoordinates X) = X := by + ext i j + refine Fin.lastCases ?_ (fun i ↦ ?_) i <;> + refine Fin.lastCases ?_ (fun j ↦ ?_) j + · simp only [birkhoffAffineMap_last_last, birkhoffAffineCoordinates] + have hlastCols : ∀ j : Fin n, + X (Fin.last n) j.castSucc = 1 - ∑ i : Fin n, X i.castSucc j.castSucc := by + intro j + have h := hcol j.castSucc + rw [Fin.sum_univ_castSucc] at h + rw [← h] + ring + have hlastRow := hrow (Fin.last n) + rw [Fin.sum_univ_castSucc] at hlastRow + simp_rw [hlastCols] at hlastRow + rw [Finset.sum_sub_distrib, Finset.sum_const, Finset.card_univ, + Fintype.card_fin, nsmul_eq_mul] at hlastRow + rw [Finset.sum_comm] at hlastRow + push_cast at hlastRow ⊢ + linear_combination -hlastRow + · simp only [birkhoffAffineMap_last_castSucc, birkhoffAffineCoordinates] + have h := hcol j.castSucc + rw [Fin.sum_univ_castSucc] at h + rw [← h] + ring + · simp only [birkhoffAffineMap_castSucc_last, birkhoffAffineCoordinates] + have h := hrow i.castSucc + rw [Fin.sum_univ_castSucc] at h + rw [← h] + ring + · simp [birkhoffAffineCoordinates] + +/-- The affine recovery map commutes with matrix segments. -/ +theorem birkhoffAffineMap_affineCombination + {n : ℕ} {t : ℝ} (Y Z : Matrix (Fin n) (Fin n) ℝ) : + birkhoffAffineMap (fun i j ↦ (1 - t) * Y i j + t * Z i j) = + fun i j ↦ (1 - t) * birkhoffAffineMap Y i j + + t * birkhoffAffineMap Z i j := by + ext i j + refine Fin.lastCases ?_ (fun i ↦ ?_) i <;> + refine Fin.lastCases ?_ (fun j ↦ ?_) j + · simp only [birkhoffAffineMap_last_last, + Finset.sum_add_distrib] + have hY : + (∑ i, ∑ j, (1 - t) * Y i j) = + (1 - t) * (∑ i, ∑ j, Y i j) := by + calc + (∑ i, ∑ j, (1 - t) * Y i j) = + ∑ i, (1 - t) * ∑ j, Y i j := by + apply Finset.sum_congr rfl + intro i _ + rw [Finset.mul_sum] + _ = (1 - t) * (∑ i, ∑ j, Y i j) := by + rw [Finset.mul_sum] + have hZ : + (∑ i, ∑ j, t * Z i j) = t * (∑ i, ∑ j, Z i j) := by + calc + (∑ i, ∑ j, t * Z i j) = ∑ i, t * ∑ j, Z i j := by + apply Finset.sum_congr rfl + intro i _ + rw [Finset.mul_sum] + _ = t * (∑ i, ∑ j, Z i j) := by + rw [Finset.mul_sum] + rw [hY, hZ] + ring + · simp only [birkhoffAffineMap_last_castSucc, + Finset.sum_add_distrib] + repeat' rw [← Finset.mul_sum] + ring + · simp only [birkhoffAffineMap_castSucc_last, + Finset.sum_add_distrib] + repeat' rw [← Finset.mul_sum] + ring + · simp + +/-- The affine map lands in the Birkhoff affine hull exactly; only +nonnegativity remains to be checked by rational inequalities. -/ +theorem birkhoffAffineMap_has_unit_sums + {n : ℕ} (Y : Matrix (Fin n) (Fin n) ℚ) : + (∀ i, ∑ j, birkhoffAffineMap Y i j = 1) ∧ + (∀ j, ∑ i, birkhoffAffineMap Y i j = 1) := by + exact ⟨birkhoffAffineMap_row_sum Y, birkhoffAffineMap_col_sum Y⟩ + +/-- Rational coordinates are feasible exactly when the recovered entries are +nonnegative. -/ +theorem birkhoffAffineMap_doublyStochastic_iff + {n : ℕ} (Y : Matrix (Fin n) (Fin n) ℚ) : + IsDoublyStochastic + (fun i j ↦ ((birkhoffAffineMap Y i j : ℚ) : ℝ)) ↔ + ∀ i j, 0 ≤ birkhoffAffineMap Y i j := by + constructor + · intro h i j + exact_mod_cast h.nonnegative i j + · intro h + refine ⟨?_, ?_, ?_⟩ + · intro i j + change 0 ≤ ((birkhoffAffineMap Y i j : ℚ) : ℝ) + exact Rat.cast_nonneg.mpr (h i j) + · intro i + change ∑ j, ((birkhoffAffineMap Y i j : ℚ) : ℝ) = 1 + rw [← Rat.cast_sum] + norm_num [birkhoffAffineMap_row_sum] + · intro j + change ∑ i, ((birkhoffAffineMap Y i j : ℚ) : ℝ) = 1 + rw [← Rat.cast_sum] + norm_num [birkhoffAffineMap_col_sum] + +/-- Coordinatewise lower bounds make the recovered rational matrix an +interior doubly stochastic point. -/ +theorem birkhoffAffineMap_interior + {n : ℕ} (hn : 0 < n) {Y : Matrix (Fin n) (Fin n) ℚ} {δ : ℚ} + (hδ : 0 < δ) (hfloor : ∀ i j, δ ≤ birkhoffAffineMap Y i j) : + IsDoublyStochastic + (fun i j ↦ ((birkhoffAffineMap Y i j : ℚ) : ℝ)) ∧ + ∀ i, IsInteriorProbabilityVector + (fun j ↦ ((birkhoffAffineMap Y i j : ℚ) : ℝ)) := by + have hds := (birkhoffAffineMap_doublyStochastic_iff Y).2 + (fun i j ↦ (hδ.le.trans (hfloor i j))) + refine ⟨hds, fun i ↦ + ⟨⟨fun j ↦ hds.nonnegative i j, hds.row_sum i⟩, + fun j ↦ ⟨?_, ?_⟩⟩⟩ + · change 0 < ((birkhoffAffineMap Y i j : ℚ) : ℝ) + exact Rat.cast_pos.mpr (hδ.trans_le (hfloor i j)) + · exact hds.entry_lt_one_of_positive + (fun a b ↦ by exact_mod_cast hδ.trans_le (hfloor a b)) + (by simp; omega) i j + +/-- In a probability row with at least two coordinates, a common entry floor +also gives the same floor for every complementary coordinate. -/ +theorem one_sub_entry_ge_of_common_floor + {ι : Type*} [Fintype ι] [DecidableEq ι] + (hcard : 1 < Fintype.card ι) {X : Matrix ι ι ℝ} {δ : ℝ} + (hX : IsDoublyStochastic X) (hfloor : ∀ i j, δ ≤ X i j) + (i j : ι) : δ ≤ 1 - X i j := by + obtain ⟨k, hkj⟩ := Fintype.exists_ne_of_one_lt_card hcard j + have hkMem : k ∈ Finset.univ.erase j := by + simp [hkj] + have hrest : X i k ≤ ∑ l ∈ Finset.univ.erase j, X i l := by + exact Finset.single_le_sum + (fun l _ ↦ hX.nonnegative i l) hkMem + have hsum : ∑ l ∈ Finset.univ.erase j, X i l = 1 - X i j := by + have htotal := hX.row_sum i + rw [← Finset.sum_erase_add _ _ (Finset.mem_univ j)] at htotal + linarith + rw [← hsum] + exact (hfloor i k).trans hrest + +/-- The uniform point has fixedValue upper-left coordinates. -/ +def uniformAffineCoordinates (n : ℕ) : Matrix (Fin n) (Fin n) ℚ := + fun _ _ ↦ 1 / (n + 1) + +@[simp] theorem birkhoffAffineMap_uniformAffineCoordinates + (n : ℕ) (i j : Fin (n + 1)) : + birkhoffAffineMap (uniformAffineCoordinates n) i j = 1 / (n + 1) := by + refine Fin.lastCases ?_ (fun i ↦ ?_) i <;> + refine Fin.lastCases ?_ (fun j ↦ ?_) j + · simp [uniformAffineCoordinates] + field_simp + ring + · simp [uniformAffineCoordinates] + field_simp + ring + · simp [uniformAffineCoordinates] + field_simp + ring + · simp [uniformAffineCoordinates] + +/-- In particular, the rational floor body is nonempty whenever its floor is +at most the uniform entry. -/ +theorem uniformAffineCoordinates_meets_floor + (n : ℕ) {δ : ℚ} (hδ : δ ≤ 1 / (n + 1)) : + ∀ i j, δ ≤ birkhoffAffineMap (uniformAffineCoordinates n) i j := by + intro i j + simpa using hδ + +/-- Entrywise `ℓ1` distance in the upper-left affine coordinates. -/ +def affineCoordinateL1Distance {n : ℕ} + (Y Z : Matrix (Fin n) (Fin n) ℝ) : ℝ := + ∑ i, ∑ j, abs (Y i j - Z i j) + +theorem affineCoordinateL1Distance_nonneg {n : ℕ} + (Y Z : Matrix (Fin n) (Fin n) ℝ) : + 0 ≤ affineCoordinateL1Distance Y Z := by + exact Finset.sum_nonneg fun i _ ↦ Finset.sum_nonneg fun j _ ↦ abs_nonneg _ + +theorem affineCoordinate_abs_sub_le_l1 {n : ℕ} + (Y Z : Matrix (Fin n) (Fin n) ℝ) (i j : Fin n) : + abs (Y i j - Z i j) ≤ affineCoordinateL1Distance Y Z := by + apply (Finset.single_le_sum + (fun a _ ↦ Finset.sum_nonneg fun b _ ↦ abs_nonneg (Y a b - Z a b)) + (Finset.mem_univ i)).trans' + exact Finset.single_le_sum + (fun b _ ↦ abs_nonneg (Y i b - Z i b)) (Finset.mem_univ j) + +theorem affineCoordinate_row_sum_abs_le_l1 {n : ℕ} + (Y Z : Matrix (Fin n) (Fin n) ℝ) (i : Fin n) : + abs (∑ j, (Y i j - Z i j)) ≤ affineCoordinateL1Distance Y Z := by + refine (Finset.abs_sum_le_sum_abs _ _).trans ?_ + exact Finset.single_le_sum + (fun a _ ↦ Finset.sum_nonneg fun b _ ↦ abs_nonneg (Y a b - Z a b)) + (Finset.mem_univ i) + +theorem affineCoordinate_col_sum_abs_le_l1 {n : ℕ} + (Y Z : Matrix (Fin n) (Fin n) ℝ) (j : Fin n) : + abs (∑ i, (Y i j - Z i j)) ≤ affineCoordinateL1Distance Y Z := by + refine (Finset.abs_sum_le_sum_abs _ _).trans ?_ + calc + ∑ i, abs (Y i j - Z i j) ≤ + ∑ i, ∑ k, abs (Y i k - Z i k) := by + apply Finset.sum_le_sum + intro i _ + exact Finset.single_le_sum + (fun k _ ↦ abs_nonneg (Y i k - Z i k)) (Finset.mem_univ j) + _ = affineCoordinateL1Distance Y Z := rfl + +theorem affineCoordinate_total_sum_abs_le_l1 {n : ℕ} + (Y Z : Matrix (Fin n) (Fin n) ℝ) : + abs (∑ i, ∑ j, (Y i j - Z i j)) ≤ + affineCoordinateL1Distance Y Z := by + refine (Finset.abs_sum_le_sum_abs _ _).trans ?_ + apply Finset.sum_le_sum + intro i _ + exact Finset.abs_sum_le_sum_abs _ _ + +/-- The affine recovery map is entrywise 1-Lipschitz for the coordinate +`ℓ1` distance. This single bound covers the upper-left block, recovered +row/column entries, and the corner entry. -/ +theorem birkhoffAffineMap_abs_sub_le_l1 {n : ℕ} + (Y Z : Matrix (Fin n) (Fin n) ℝ) (i j : Fin (n + 1)) : + abs (birkhoffAffineMap Y i j - birkhoffAffineMap Z i j) ≤ + affineCoordinateL1Distance Y Z := by + refine Fin.lastCases ?_ (fun i ↦ ?_) i <;> + refine Fin.lastCases ?_ (fun j ↦ ?_) j + · simp only [birkhoffAffineMap_last_last] + have heq : + ((∑ i, ∑ j, Y i j) - (n - 1 : ℝ)) - + ((∑ i, ∑ j, Z i j) - (n - 1 : ℝ)) = + ∑ i, ∑ j, (Y i j - Z i j) := by + simp_rw [Finset.sum_sub_distrib] + ring + rw [heq] + exact affineCoordinate_total_sum_abs_le_l1 Y Z + · simp only [birkhoffAffineMap_last_castSucc] + have heq : + (1 - ∑ i, Y i j) - (1 - ∑ i, Z i j) = + -(∑ i, (Y i j - Z i j)) := by + rw [Finset.sum_sub_distrib] + ring + rw [heq, abs_neg] + exact affineCoordinate_col_sum_abs_le_l1 Y Z j + · simp only [birkhoffAffineMap_castSucc_last] + have heq : + (1 - ∑ j, Y i j) - (1 - ∑ j, Z i j) = + -(∑ j, (Y i j - Z i j)) := by + rw [Finset.sum_sub_distrib] + ring + rw [heq, abs_neg] + exact affineCoordinate_row_sum_abs_le_l1 Y Z i + · simpa only [birkhoffAffineMap_castSucc_castSucc] using + affineCoordinate_abs_sub_le_l1 Y Z i j + +/-- A weak optimizer may perturb the coordinate vector, but an `ℓ1` +perturbation smaller than half the floor preserves an explicit positive +floor in the recovered matrix. -/ +theorem birkhoffAffineMap_floor_of_l1_near + {n : ℕ} {Y Z : Matrix (Fin n) (Fin n) ℝ} {δ σ : ℝ} + (hY : ∀ i j, δ ≤ birkhoffAffineMap Y i j) + (hnear : affineCoordinateL1Distance Y Z ≤ σ) + (i j : Fin (n + 1)) : + δ - σ ≤ birkhoffAffineMap Z i j := by + have habs := (birkhoffAffineMap_abs_sub_le_l1 Y Z i j).trans hnear + have hupper := (abs_le.mp habs).2 + linarith [hY i j] + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/NumericalCapacity.lean b/LeanPool/BeyondBethe/BeyondBethe/NumericalCapacity.lean new file mode 100644 index 0000000000..439ab37b68 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/NumericalCapacity.lean @@ -0,0 +1,118 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.NumericalInterior +import Mathlib.Tactic + +/-! # Numerical Capacity -/ + +namespace BeyondBethe + +/-! +# Exact feasibility and interior mixing for capacity certificates + +These auxiliary lemmas record the feasibility-recovery argument for a generic +capacity routine. The final algorithm uses the explicit sparse witnesses in +`NumericalWitness` and therefore no longer invokes such a routine, but the +lemmas remain useful independent checks: affine mixing preserves the mass and +moment equalities, creates an explicit coordinate floor, and loses only a +controlled fraction of the entropy objective range. +-/ + +/-- Feasibility of a coefficient distribution for the entropy capacity +certificate. -/ +def IsCapacityDistribution + {κ σ : Type*} [Fintype κ] + (θ : κ → ℝ) (E : κ → σ → ℕ) (α : σ → ℝ) : Prop := + IsProbabilityVector θ ∧ ∀ j, exponentMoment θ E j = α j + +/-- Coordinatewise affine interpolation of two coefficient distributions. -/ +def distributionSegment + {κ : Type*} (t : ℝ) (θ φ : κ → ℝ) : κ → ℝ := + fun e ↦ (1 - t) * θ e + t * φ e + +/-- Exact mass and moment constraints are preserved by rational affine +mixing. -/ +theorem distributionSegment_isCapacityDistribution + {κ σ : Type*} [Fintype κ] + {t : ℝ} (ht0 : 0 ≤ t) (ht1 : t ≤ 1) + {θ φ : κ → ℝ} {E : κ → σ → ℕ} {α : σ → ℝ} + (hθ : IsCapacityDistribution θ E α) + (hφ : IsCapacityDistribution φ E α) : + IsCapacityDistribution (distributionSegment t θ φ) E α := by + constructor + · constructor + · intro e + exact add_nonneg + (mul_nonneg (sub_nonneg.mpr ht1) (hθ.1.nonnegative e)) + (mul_nonneg ht0 (hφ.1.nonnegative e)) + · simp_rw [distributionSegment, Finset.sum_add_distrib, + ← Finset.mul_sum, hθ.1.sum_eq_one, hφ.1.sum_eq_one] + ring + · intro j + rw [exponentMoment] + simp_rw [distributionSegment, add_mul, Finset.sum_add_distrib, + mul_assoc, ← Finset.mul_sum] + rw [← exponentMoment, ← exponentMoment, hθ.2 j, hφ.2 j] + ring + +theorem capacityCoordinate_eq + {c x : ℝ} (hc : 0 < c) : + x * Real.log (c / x) = x * Real.log c + Real.negMulLog x := by + by_cases hx0 : x = 0 + · simp [hx0] + · rw [Real.log_div hc.ne' hx0, Real.negMulLog_def] + ring + +/-- Concavity of the entropy capacity objective along a nonnegative segment. -/ +theorem entropyCapacityCertificate_segment_lower + {κ : Type*} [Fintype κ] + {t : ℝ} (ht0 : 0 ≤ t) (ht1 : t ≤ 1) + {θ φ c : κ → ℝ} + (hθ : ∀ e, 0 ≤ θ e) (hφ : ∀ e, 0 ≤ φ e) + (hc : ∀ e, 0 < c e) : + (1 - t) * entropyCapacityCertificate θ c + + t * entropyCapacityCertificate φ c ≤ + entropyCapacityCertificate (distributionSegment t θ φ) c := by + simp only [entropyCapacityCertificate] + rw [Finset.mul_sum, Finset.mul_sum, ← Finset.sum_add_distrib] + apply Finset.sum_le_sum + intro e _ + rw [capacityCoordinate_eq (hc e), + capacityCoordinate_eq (hc e), + capacityCoordinate_eq (hc e)] + have hgap := negMulLog_segment_gap_nonneg ht0 ht1 (hθ e) (hφ e) + dsimp only [distributionSegment] at hgap ⊢ + linarith + +/-- Mixing toward a point with coordinate floor `ρ` creates floor `tρ`. -/ +theorem distributionSegment_coordinate_floor + {κ : Type*} {t ρ : ℝ} (ht0 : 0 ≤ t) (ht1 : t ≤ 1) + {θ φ : κ → ℝ} (hθ : ∀ e, 0 ≤ θ e) (hφ : ∀ e, ρ ≤ φ e) : + ∀ e, t * ρ ≤ distributionSegment t θ φ e := by + intro e + dsimp only [distributionSegment] + have hfirst : 0 ≤ (1 - t) * θ e := + mul_nonneg (sub_nonneg.mpr ht1) (hθ e) + have hsecond := mul_le_mul_of_nonneg_left (hφ e) ht0 + linarith + +/-- The objective loss under interior mixing is at most the mixing weight +times the objective range between the two endpoints. -/ +theorem entropyCapacityCertificate_sub_segment_le + {κ : Type*} [Fintype κ] + {t : ℝ} (ht0 : 0 ≤ t) (ht1 : t ≤ 1) + {θ φ c : κ → ℝ} + (hθ : ∀ e, 0 ≤ θ e) (hφ : ∀ e, 0 ≤ φ e) + (hc : ∀ e, 0 < c e) : + entropyCapacityCertificate θ c - + entropyCapacityCertificate (distributionSegment t θ φ) c ≤ + t * (entropyCapacityCertificate θ c - + entropyCapacityCertificate φ c) := by + have hconc := entropyCapacityCertificate_segment_lower ht0 ht1 hθ hφ hc + linarith + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/NumericalInterior.lean b/LeanPool/BeyondBethe/BeyondBethe/NumericalInterior.lean new file mode 100644 index 0000000000..b4ace3c532 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/NumericalInterior.lean @@ -0,0 +1,321 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.NumericalNearby +import Mathlib.Tactic + +/-! # Numerical Interior -/ + +namespace BeyondBethe + +/-! +# Quantitative interiority of the regularized optimizer + +This file proves the analytic part of the finite-precision truncation used by +the algorithm. The bounds are deliberately elementary: `x log x` terms are +controlled by entropy and by `negMulLog x ≤ 1 - x`. +-/ + +/-- A convenient range bound for the unregularized Bethe objective when all +matrix entries lie in `[m,1]`. -/ +noncomputable def numericalObjectiveRange (n : ℕ) (m : ℝ) : ℝ := + n * Real.log (1 / m) + n * Real.log n + n + +/-- On a matrix with entries at most one, the Bethe objective is at most the +total row entropy. -/ +theorem betheObjective_le_totalRowEntropy + {n : Type*} [Fintype n] [DecidableEq n] + {A X : Matrix n n ℝ} (hApos : Matrix.Positive A) + (hAupper : ∀ i j, A i j ≤ 1) (hX : IsDoublyStochastic X) : + betheObjective A X ≤ totalRowEntropy X := by + simp only [betheObjective, betheRowObjective, totalRowEntropy, + shannonEntropy] + apply Finset.sum_le_sum + intro i _ + apply Finset.sum_le_sum + intro j _ + have hlogA : Real.log (A i j) ≤ 0 := + Real.log_nonpos (hApos i j).le (hAupper i j) + have hlinear : X i j * Real.log (A i j) ≤ 0 := + mul_nonpos_of_nonneg_of_nonpos (hX.nonnegative i j) hlogA + have hcomp : (1 - X i j) * Real.log (1 - X i j) ≤ 0 := + Real.mul_log_nonpos (sub_nonneg.mpr (hX.entry_le_one i j)) + (by linarith [hX.nonnegative i j]) + linarith + +/-- A lower bound on the Bethe objective using only a common lower bound on +the entries of the input matrix. -/ +theorem betheObjective_lower_of_entry_lower + {n : Type*} [Fintype n] [DecidableEq n] + {m : ℝ} (hm : 0 < m) {A X : Matrix n n ℝ} + (hAlower : ∀ i j, m ≤ A i j) (hX : IsDoublyStochastic X) : + Fintype.card n * Real.log m - Fintype.card n ≤ + betheObjective A X := by + simp only [betheObjective, betheRowObjective] + calc + Fintype.card n * Real.log m - Fintype.card n = + ∑ _i : n, (Real.log m - 1) := by + simp [nsmul_eq_mul] + _ ≤ ∑ i, ∑ j, + (X i j * Real.log (A i j) + Real.negMulLog (X i j) + + (1 - X i j) * Real.log (1 - X i j)) := by + apply Finset.sum_le_sum + intro i _ + have hrow : Real.log m - 1 = ∑ j, (X i j * Real.log m - X i j) := by + rw [Finset.sum_sub_distrib, ← Finset.sum_mul, hX.row_sum] + ring + rw [hrow] + apply Finset.sum_le_sum + intro j _ + have hlog : Real.log m ≤ Real.log (A i j) := + Real.log_le_log hm (hAlower i j) + have hlinear : X i j * Real.log m ≤ + X i j * Real.log (A i j) := + mul_le_mul_of_nonneg_left hlog (hX.nonnegative i j) + have hentropy : 0 ≤ Real.negMulLog (X i j) := + Real.negMulLog_nonneg (hX.nonnegative i j) (hX.entry_le_one i j) + have hcompNonneg : 0 ≤ 1 - X i j := + sub_nonneg.mpr (hX.entry_le_one i j) + have hcomp := Real.negMulLog_le_one_sub_self hcompNonneg + rw [Real.negMulLog_def] at hcomp + linarith + +/-- The unregularized objective changes by at most +`numericalObjectiveRange` between a feasible point and the Birkhoff +barycenter. -/ +theorem betheObjective_sub_uniform_le_range + {n : ℕ} (hn : 1 < n) {m : ℝ} (hm : 0 < m) + {A X : Matrix (Fin n) (Fin n) ℝ} + (hApos : Matrix.Positive A) (hAlower : ∀ i j, m ≤ A i j) + (hAupper : ∀ i j, A i j ≤ 1) (hX : IsDoublyStochastic X) : + betheObjective A X - betheObjective A (uniformBirkhoff n) ≤ + numericalObjectiveRange n m := by + have hn0 : 0 < n := by omega + letI : Nonempty (Fin n) := ⟨⟨0, hn0⟩⟩ + have hW := uniformBirkhoff_doublyStochastic hn0 + have hupper := (betheObjective_le_totalRowEntropy hApos hAupper hX).trans + (by simpa using totalRowEntropy_le hX) + have hlower := betheObjective_lower_of_entry_lower hm hAlower hW + have hloginv : Real.log (1 / m) = -Real.log m := by + rw [one_div, Real.log_inv] + dsimp only [numericalObjectiveRange] + rw [hloginv] + simp only [Fintype.card_fin] at hupper hlower + linarith + +/-- The directional entropy derivative from an interior regularized maximizer +toward the Birkhoff barycenter is controlled by the unregularized objective +range. -/ +theorem entropy_direction_to_uniform_mul_le_range + {n : ℕ} (hn : 1 < n) {τ m : ℝ} (hτ : 0 < τ) (hm : 0 < m) + {A X : Matrix (Fin n) (Fin n) ℝ} + (hApos : Matrix.Positive A) (hAlower : ∀ i j, m ≤ A i j) + (hAupper : ∀ i j, A i j ≤ 1) + (hX : IsDoublyStochastic X) + (hmax : ∀ Y, IsDoublyStochastic Y → + regularizedBetheObjective τ A Y ≤ regularizedBetheObjective τ A X) : + τ * (∑ i, ∑ j, (-1 - Real.log (X i j)) * + (uniformBirkhoff n i j - X i j)) ≤ + numericalObjectiveRange n m := by + have hW : IsDoublyStochastic (uniformBirkhoff n) := + uniformBirkhoff_doublyStochastic (show 0 < n by omega) + have hXint := regularizedBetheMaximizer_interior hn hτ hApos hX hmax + have hDrow : ∀ i, ∑ j, (uniformBirkhoff n i j - X i j) = 0 := by + intro i + simp_rw [Finset.sum_sub_distrib, hW.row_sum, hX.row_sum, sub_self] + have hDcol : ∀ j, ∑ i, (uniformBirkhoff n i j - X i j) = 0 := by + intro j + simp_rw [Finset.sum_sub_distrib, hW.col_sum, hX.col_sum, sub_self] + have hstationary := regularizedBetheMaximizer_tangent_orthogonal + (D := fun i j ↦ uniformBirkhoff n i j - X i j) + hX hXint hmax hDrow hDcol + have hsupport := regularizedBetheObjective_sub_le_gradient + (A := A) (X := X) (Y := uniformBirkhoff n) (τ := 0) + (by simpa using hn) (by norm_num) hX hW hXint + have hbetaLower : -numericalObjectiveRange n m ≤ + betheObjective A (uniformBirkhoff n) - betheObjective A X := by + have hrange := betheObjective_sub_uniform_le_range hn hm hApos + hAlower hAupper hX + linarith + have hbetheDirectional : -numericalObjectiveRange n m ≤ + ∑ i, ∑ j, regularizedBetheGradient 0 A X i j * + (uniformBirkhoff n i j - X i j) := by + rw [regularizedBetheObjective, regularizedBetheObjective] at hsupport + simp only [zero_mul, add_zero] at hsupport + exact hbetaLower.trans hsupport + have hgradient : ∀ i j, + regularizedBetheGradient τ A X i j = + regularizedBetheGradient 0 A X i j + + τ * (-1 - Real.log (X i j)) := by + intro i j + simp only [regularizedBetheGradient] + ring + have hdecomp : + (∑ i, ∑ j, regularizedBetheGradient τ A X i j * + (uniformBirkhoff n i j - X i j)) = + (∑ i, ∑ j, regularizedBetheGradient 0 A X i j * + (uniformBirkhoff n i j - X i j)) + + τ * (∑ i, ∑ j, (-1 - Real.log (X i j)) * + (uniformBirkhoff n i j - X i j)) := by + rw [Finset.mul_sum, ← Finset.sum_add_distrib] + apply Finset.sum_congr rfl + intro i _ + rw [Finset.mul_sum, ← Finset.sum_add_distrib] + apply Finset.sum_congr rfl + intro j _ + rw [hgradient] + ring + rw [hdecomp] at hstationary + linarith + +/-- Exact formula for the entropy directional derivative toward the Birkhoff +barycenter. -/ +theorem entropy_direction_to_uniform_eq + {n : ℕ} (hn : 0 < n) {X : Matrix (Fin n) (Fin n) ℝ} + (hX : IsDoublyStochastic X) : + (∑ i, ∑ j, (-1 - Real.log (X i j)) * + (uniformBirkhoff n i j - X i j)) = + -totalRowEntropy X - + (1 / n) * (∑ i, ∑ j, Real.log (X i j)) := by + let W := uniformBirkhoff n + have hW : IsDoublyStochastic W := uniformBirkhoff_doublyStochastic hn + have htotalDiff : ∑ i, ∑ j, (X i j - W i j) = 0 := by + simp_rw [Finset.sum_sub_distrib, hX.row_sum, hW.row_sum, sub_self] + have hentropy : (∑ i, ∑ j, X i j * Real.log (X i j)) = + -totalRowEntropy X := by + rw [totalRowEntropy, ← Finset.sum_neg_distrib] + apply Finset.sum_congr rfl + intro i _ + rw [shannonEntropy, ← Finset.sum_neg_distrib] + apply Finset.sum_congr rfl + intro j _ + rw [Real.negMulLog_def] + ring + have hWlog : (∑ i, ∑ j, W i j * Real.log (X i j)) = + (1 / n) * (∑ i, ∑ j, Real.log (X i j)) := by + dsimp only [W, uniformBirkhoff] + simp_rw [← Finset.mul_sum] + change (∑ i, ∑ j, (-1 - Real.log (X i j)) * + (W i j - X i j)) = _ + calc + (∑ i, ∑ j, (-1 - Real.log (X i j)) * (W i j - X i j)) = + (∑ i, ∑ j, X i j * Real.log (X i j)) - + (∑ i, ∑ j, W i j * Real.log (X i j)) + + ∑ i, ∑ j, (X i j - W i j) := by + rw [← Finset.sum_sub_distrib, ← Finset.sum_add_distrib] + apply Finset.sum_congr rfl + intro i _ + rw [← Finset.sum_sub_distrib, ← Finset.sum_add_distrib] + apply Finset.sum_congr rfl + intro j _ + ring + _ = -totalRowEntropy X - + (1 / n) * (∑ i, ∑ j, Real.log (X i j)) := by + rw [hentropy, hWlog, htotalDiff, add_zero] + +/-- Quantitative form of the interior bound. Every coordinate, not merely a +chosen minimum, obeys the same estimate. -/ +theorem regularizedBetheMaximizer_log_inv_entry_le + {n : ℕ} (hn : 1 < n) {τ m : ℝ} (hτ : 0 < τ) (hm : 0 < m) + {A X : Matrix (Fin n) (Fin n) ℝ} + (hApos : Matrix.Positive A) (hAlower : ∀ i j, m ≤ A i j) + (hAupper : ∀ i j, A i j ≤ 1) + (hX : IsDoublyStochastic X) + (hmax : ∀ Y, IsDoublyStochastic Y → + regularizedBetheObjective τ A Y ≤ regularizedBetheObjective τ A X) + (i₀ j₀ : Fin n) : + Real.log (1 / X i₀ j₀) ≤ + n * numericalObjectiveRange n m / τ + n ^ 2 * Real.log n := by + have hn0 : 0 < n := by omega + letI : Nonempty (Fin n) := ⟨⟨0, hn0⟩⟩ + have hXint := regularizedBetheMaximizer_interior hn hτ hApos hX hmax + have hXpos : ∀ i j, 0 < X i j := fun i j ↦ (hXint i).2 j |>.1 + have hdir := entropy_direction_to_uniform_mul_le_range hn hτ hm + hApos hAlower hAupper hX hmax + rw [entropy_direction_to_uniform_eq hn0 hX] at hdir + have hentropy := totalRowEntropy_le hX + have hlognonpos : ∀ i j, Real.log (X i j) ≤ 0 := fun i j ↦ + Real.log_nonpos (hX.nonnegative i j) (hX.entry_le_one i j) + have hchosen : -Real.log (X i₀ j₀) ≤ + -(∑ i, ∑ j, Real.log (X i j)) := by + have hnonneg : ∀ i j, 0 ≤ -Real.log (X i j) := fun i j ↦ + neg_nonneg.mpr (hlognonpos i j) + have hsingle : -Real.log (X i₀ j₀) ≤ + ∑ j, -Real.log (X i₀ j) := + Finset.single_le_sum (fun j _ ↦ hnonneg i₀ j) (Finset.mem_univ j₀) + have hrow : ∑ j, -Real.log (X i₀ j) ≤ + ∑ i, ∑ j, -Real.log (X i j) := + Finset.single_le_sum + (fun i _ ↦ Finset.sum_nonneg fun j _ ↦ hnonneg i j) + (Finset.mem_univ i₀) + simpa only [Finset.sum_neg_distrib] using hsingle.trans hrow + have hloginv : Real.log (1 / X i₀ j₀) = -Real.log (X i₀ j₀) := by + rw [one_div, Real.log_inv] + have hnR : (0 : ℝ) < n := by exact_mod_cast hn0 + rw [hloginv] + simp only [Fintype.card_fin] at hentropy + have hscaledChosen := mul_le_mul_of_nonneg_left hchosen + (by positivity : 0 ≤ (1 / (n : ℝ))) + have hdirLower : + -(n : ℝ) * Real.log n + (1 / n) * (-Real.log (X i₀ j₀)) ≤ + -totalRowEntropy X - + (1 / n) * (∑ i, ∑ j, Real.log (X i j)) := by + linarith + have hcore : τ * (-(n : ℝ) * Real.log n + + (1 / n) * (-Real.log (X i₀ j₀))) ≤ + numericalObjectiveRange n m := + (mul_le_mul_of_nonneg_left hdirLower hτ.le).trans hdir + have hmul := mul_le_mul_of_nonneg_left hcore hnR.le + have halgebra : + (n : ℝ) * (τ * (-(n : ℝ) * Real.log n + + (1 / n) * (-Real.log (X i₀ j₀)))) = + τ * (-Real.log (X i₀ j₀) - + (n : ℝ) ^ 2 * Real.log n) := by + field_simp [hnR.ne'] + ring + rw [halgebra] at hmul + have hmul' : + (-Real.log (X i₀ j₀) - (n : ℝ) ^ 2 * Real.log n) * τ ≤ + (n : ℝ) * numericalObjectiveRange n m := by + simpa only [mul_comm] using hmul + have hdiv := (le_div_iff₀ hτ).2 hmul' + linarith + +/-- The complementary coordinates obey the same logarithmic bit bound. -/ +theorem regularizedBetheMaximizer_log_inv_one_sub_entry_le + {n : ℕ} (hn : 1 < n) {τ m : ℝ} (hτ : 0 < τ) (hm : 0 < m) + {A X : Matrix (Fin n) (Fin n) ℝ} + (hApos : Matrix.Positive A) (hAlower : ∀ i j, m ≤ A i j) + (hAupper : ∀ i j, A i j ≤ 1) + (hX : IsDoublyStochastic X) + (hmax : ∀ Y, IsDoublyStochastic Y → + regularizedBetheObjective τ A Y ≤ regularizedBetheObjective τ A X) + (i₀ j₀ : Fin n) : + Real.log (1 / (1 - X i₀ j₀)) ≤ + n * numericalObjectiveRange n m / τ + n ^ 2 * Real.log n := by + obtain ⟨k, hkj⟩ := Fintype.exists_ne_of_one_lt_card + (by simpa using hn) j₀ + have hXint := regularizedBetheMaximizer_interior hn hτ hApos hX hmax + have hkpos : 0 < X i₀ k := (hXint i₀).2 k |>.1 + have hcompPos : 0 < 1 - X i₀ j₀ := + sub_pos.mpr ((hXint i₀).2 j₀ |>.2) + have hpair : X i₀ j₀ + X i₀ k ≤ 1 := by + rw [← hX.row_sum i₀] + calc + X i₀ j₀ + X i₀ k = + ∑ l ∈ ({j₀, k} : Finset (Fin n)), X i₀ l := by + rw [Finset.sum_pair hkj.symm] + _ ≤ ∑ l, X i₀ l := + Finset.sum_le_sum_of_subset_of_nonneg (Finset.subset_univ _) + (fun l _ _ ↦ hX.nonnegative i₀ l) + have hkcomp : X i₀ k ≤ 1 - X i₀ j₀ := by linarith + have hinv : 1 / (1 - X i₀ j₀) ≤ 1 / X i₀ k := + one_div_le_one_div_of_le hkpos hkcomp + exact (Real.log_le_log (one_div_pos.mpr hcompPos) hinv).trans + (regularizedBetheMaximizer_log_inv_entry_le hn hτ hm hApos + hAlower hAupper hX hmax i₀ k) + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/NumericalNearby.lean b/LeanPool/BeyondBethe/BeyondBethe/NumericalNearby.lean new file mode 100644 index 0000000000..6904f4693b --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/NumericalNearby.lean @@ -0,0 +1,301 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.NumericalScales +import Mathlib.Tactic + +/-! # Numerical Nearby -/ + +namespace BeyondBethe + +/-! +# The nearby-matrix step in certified optimization + +An approximate KKT point for a rational input matrix is turned into an exact +KKT point for a nearby positive real matrix. This file proves the sign and +normalization-sensitive comparison used to transfer the permanent estimate +back to the input matrix. +-/ + +/-- Matrix for which the proposed point and potentials satisfy the +multiplicative KKT equations exactly. -/ +noncomputable def nearbyKKTMatrix + {ι : Type*} (τ : ℝ) (X : Matrix ι ι ℝ) (r c : ι → ℝ) : + Matrix ι ι ℝ := + fun i j ↦ Real.exp (r i + c j) * + (X i j) ^ (1 + τ) * (1 - X i j) + +/-- Coordinatewise approximate logarithmic KKT equations. -/ +def HasApproximateLogKKT + {ι : Type*} [Fintype ι] + (ε τ : ℝ) (A X : Matrix ι ι ℝ) (r c : ι → ℝ) : Prop := + ∀ i j, abs (Real.log (A i j) - + (r i + c j + (1 + τ) * Real.log (X i j) + + Real.log (1 - X i j))) ≤ ε + +theorem nearbyKKTMatrix_positive + {ι : Type*} {τ : ℝ} {X : Matrix ι ι ℝ} {r c : ι → ℝ} + (hXpos : ∀ i j, 0 < X i j) + (hXlt : ∀ i j, X i j < 1) : + Matrix.Positive (nearbyKKTMatrix τ X r c) := by + intro i j + exact mul_pos (mul_pos (Real.exp_pos _) (Real.rpow_pos_of_pos (hXpos i j) _)) + (sub_pos.mpr (hXlt i j)) + +theorem log_nearbyKKTMatrix + {ι : Type*} {τ : ℝ} {X : Matrix ι ι ℝ} {r c : ι → ℝ} + (hXpos : ∀ i j, 0 < X i j) + (hXlt : ∀ i j, X i j < 1) (i j : ι) : + Real.log (nearbyKKTMatrix τ X r c i j) = + r i + c j + (1 + τ) * Real.log (X i j) + + Real.log (1 - X i j) := by + have hx := hXpos i j + have hc : 0 < 1 - X i j := sub_pos.mpr (hXlt i j) + rw [nearbyKKTMatrix, + Real.log_mul + (mul_ne_zero (Real.exp_pos _).ne' + (Real.rpow_pos_of_pos hx _).ne') hc.ne', + Real.log_mul (Real.exp_pos _).ne' + (Real.rpow_pos_of_pos hx _).ne', + Real.log_exp, Real.log_rpow hx] + +theorem nearbyKKTMatrix_hasLogKKT + {ι : Type*} [Fintype ι] + {τ : ℝ} {X : Matrix ι ι ℝ} {r c : ι → ℝ} + (hXpos : ∀ i j, 0 < X i j) + (hXlt : ∀ i j, X i j < 1) : + HasLogKKT τ (nearbyKKTMatrix τ X r c) X r c := by + intro i j + exact log_nearbyKKTMatrix hXpos hXlt i j + +theorem approximateLogKKT_nearby_log_bounds + {ι : Type*} [Fintype ι] + {ε τ : ℝ} {A X : Matrix ι ι ℝ} {r c : ι → ℝ} + (happrox : HasApproximateLogKKT ε τ A X r c) + (hXpos : ∀ i j, 0 < X i j) + (hXlt : ∀ i j, X i j < 1) (i j : ι) : + Real.log (nearbyKKTMatrix τ X r c i j) - ε ≤ + Real.log (A i j) ∧ + Real.log (A i j) ≤ + Real.log (nearbyKKTMatrix τ X r c i j) + ε := by + have h := (abs_le.mp (happrox i j)) + rw [← log_nearbyKKTMatrix hXpos hXlt i j] at h + constructor <;> linarith + +theorem approximateLogKKT_entrywise_comparison + {ι : Type*} [Fintype ι] + {ε τ : ℝ} {A X : Matrix ι ι ℝ} {r c : ι → ℝ} + (hApos : Matrix.Positive A) + (happrox : HasApproximateLogKKT ε τ A X r c) + (hXpos : ∀ i j, 0 < X i j) + (hXlt : ∀ i j, X i j < 1) (i j : ι) : + Real.exp (-ε) * nearbyKKTMatrix τ X r c i j ≤ A i j ∧ + A i j ≤ Real.exp ε * nearbyKKTMatrix τ X r c i j := by + have hnearPos := nearbyKKTMatrix_positive + (τ := τ) (r := r) (c := c) hXpos hXlt i j + obtain ⟨hlower, hupper⟩ := approximateLogKKT_nearby_log_bounds + happrox hXpos hXlt i j + have hlowerExp := Real.exp_le_exp.mpr hlower + have hupperExp := Real.exp_le_exp.mpr hupper + rw [Real.exp_sub, Real.exp_log hnearPos, Real.exp_log (hApos i j)] at hlowerExp + rw [Real.exp_add, Real.exp_log hnearPos, Real.exp_log (hApos i j)] at hupperExp + simpa [div_eq_mul_inv, Real.exp_neg, mul_comm] using + And.intro hlowerExp hupperExp + +theorem approximateLogKKT_permanent_comparison + {ι : Type*} [Fintype ι] [DecidableEq ι] + {ε τ : ℝ} {A X : Matrix ι ι ℝ} {r c : ι → ℝ} + (hApos : Matrix.Positive A) + (happrox : HasApproximateLogKKT ε τ A X r c) + (hXpos : ∀ i j, 0 < X i j) + (hXlt : ∀ i j, X i j < 1) : + (Real.exp (-ε)) ^ Fintype.card ι * + Matrix.permanent (nearbyKKTMatrix τ X r c) ≤ + Matrix.permanent A ∧ + Matrix.permanent A ≤ + (Real.exp ε) ^ Fintype.card ι * + Matrix.permanent (nearbyKKTMatrix τ X r c) := by + let A' := nearbyKKTMatrix τ X r c + have hA'pos : Matrix.Positive A' := nearbyKKTMatrix_positive hXpos hXlt + have hlowerEntries : ∀ i j, Real.exp (-ε) * A' i j ≤ A i j := + fun i j ↦ (approximateLogKKT_entrywise_comparison hApos happrox + hXpos hXlt i j).1 + have hupperEntries : ∀ i j, A i j ≤ Real.exp ε * A' i j := + fun i j ↦ (approximateLogKKT_entrywise_comparison hApos happrox + hXpos hXlt i j).2 + have hA0 : Matrix.Nonnegative A := fun i j ↦ (hApos i j).le + have hA'0 : Matrix.Nonnegative A' := fun i j ↦ (hA'pos i j).le + constructor + · rw [← Matrix.permanent_scale_real] + exact Matrix.permanent_mono_real + (fun i j ↦ mul_nonneg (Real.exp_pos _).le (hA'0 i j)) + hlowerEntries + · rw [← Matrix.permanent_scale_real] + exact Matrix.permanent_mono_real hA0 hupperEntries + +/-- Row entropy is concave along a matrix segment. -/ +theorem totalRowEntropy_segment_lower + {ι : Type*} [Fintype ι] + {t : ℝ} (ht0 : 0 ≤ t) (ht1 : t ≤ 1) + {X Y : Matrix ι ι ℝ} + (hX : Matrix.Nonnegative X) (hY : Matrix.Nonnegative Y) : + (1 - t) * totalRowEntropy X + t * totalRowEntropy Y ≤ + totalRowEntropy (matrixSegment t X Y) := by + simp only [totalRowEntropy, shannonEntropy] + rw [Finset.mul_sum, Finset.mul_sum, ← Finset.sum_add_distrib] + apply Finset.sum_le_sum + intro i _ + rw [Finset.mul_sum, Finset.mul_sum, ← Finset.sum_add_distrib] + apply Finset.sum_le_sum + intro j _ + have hgap := negMulLog_segment_gap_nonneg ht0 ht1 (hX i j) (hY i j) + dsimp only [matrixSegment] + linarith + +/-- Concavity of the entropy-regularized Bethe objective on the Birkhoff +polytope. -/ +theorem regularizedBetheObjective_segment_lower + {ι : Type*} [Fintype ι] [DecidableEq ι] + (hcard : 1 < Fintype.card ι) + {τ t : ℝ} (hτ : 0 ≤ τ) (ht0 : 0 ≤ t) (ht1 : t ≤ 1) + (A : Matrix ι ι ℝ) {X Y : Matrix ι ι ℝ} + (hX : IsDoublyStochastic X) (hY : IsDoublyStochastic Y) : + (1 - t) * regularizedBetheObjective τ A X + + t * regularizedBetheObjective τ A Y ≤ + regularizedBetheObjective τ A (matrixSegment t X Y) := by + have hbethe := betheObjective_segment_lower hcard A X Y hX hY ht0 ht1 + have hsegment : betheMatrixSegment t X Y = matrixSegment t X Y := by + ext i j + rfl + rw [hsegment] at hbethe + have hentropy := totalRowEntropy_segment_lower ht0 ht1 + hX.nonnegative hY.nonnegative + have hscaled := mul_le_mul_of_nonneg_left hentropy hτ + rw [regularizedBetheObjective, regularizedBetheObjective, + regularizedBetheObjective] + nlinarith + +/-- The one-dimensional restriction of the regularized objective to any +Birkhoff segment is concave. -/ +theorem regularizedBetheObjective_line_concave + {ι : Type*} [Fintype ι] [DecidableEq ι] + (hcard : 1 < Fintype.card ι) + {τ : ℝ} (hτ : 0 ≤ τ) (A : Matrix ι ι ℝ) + {X Y : Matrix ι ι ℝ} + (hX : IsDoublyStochastic X) (hY : IsDoublyStochastic Y) : + ConcaveOn ℝ (Set.Icc (0 : ℝ) 1) + (fun t ↦ regularizedBetheObjective τ A (matrixSegment t X Y)) := by + refine ⟨convex_Icc 0 1, ?_⟩ + intro x hx y hy a b ha hb hab + have hsegX := matrixSegment_doublyStochastic hx.1 hx.2 hX hY + have hsegY := matrixSegment_doublyStochastic hy.1 hy.2 hX hY + have hb1 : b ≤ 1 := by linarith + have hmain := regularizedBetheObjective_segment_lower hcard hτ hb hb1 A + hsegX hsegY + have hweight : 1 - b = a := by linarith + have hnested : matrixSegment b (matrixSegment x X Y) + (matrixSegment y X Y) = matrixSegment (a * x + b * y) X Y := by + ext i j + dsimp only [matrixSegment] + rw [hweight] + linear_combination (X i j) * hab + simpa only [smul_eq_mul, hweight, hnested] using hmain + +/-- First-order upper support inequality for the regularized objective. -/ +theorem regularizedBetheObjective_sub_le_gradient + {ι : Type*} [Fintype ι] [DecidableEq ι] + (hcard : 1 < Fintype.card ι) + {τ : ℝ} (hτ : 0 ≤ τ) {A X Y : Matrix ι ι ℝ} + (hX : IsDoublyStochastic X) (hY : IsDoublyStochastic Y) + (hXint : ∀ i, IsInteriorProbabilityVector (X i)) : + regularizedBetheObjective τ A Y - regularizedBetheObjective τ A X ≤ + ∑ i, ∑ j, regularizedBetheGradient τ A X i j * (Y i j - X i j) := by + have hderiv : HasDerivAt + (fun t ↦ regularizedBetheObjective τ A (matrixSegment t X Y)) + (∑ i, ∑ j, regularizedBetheGradient τ A X i j * + (Y i j - X i j)) 0 := by + have hbase := hasDerivAt_regularizedBetheObjective_line + (τ := τ) (A := A) (X := X) + (D := fun i j ↦ Y i j - X i j) hXint + convert hbase using 1 + funext t + congr 1 + ext i j + dsimp only [matrixSegment, linearMatrixPerturb] + ring + have hconc := regularizedBetheObjective_line_concave + hcard hτ A hX hY + have hslope := hconc.slope_le_of_hasDerivAt + (Set.mem_Icc.mpr ⟨le_rfl, by norm_num⟩) + (Set.mem_Icc.mpr ⟨by norm_num, le_rfl⟩) + (by norm_num : (0 : ℝ) < 1) hderiv + have hzero : matrixSegment 0 X Y = X := by + ext i j + simp [matrixSegment] + have hone : matrixSegment 1 X Y = Y := by + ext i j + simp [matrixSegment] + simpa [slope, hzero, hone] using hslope + +/-- Exact logarithmic KKT equations are sufficient for global optimality of +the regularized objective. -/ +theorem regularizedBetheObjective_le_of_logKKT + {ι : Type*} [Fintype ι] [DecidableEq ι] + (hcard : 1 < Fintype.card ι) + {τ : ℝ} (hτ : 0 ≤ τ) {A X : Matrix ι ι ℝ} + (hX : IsDoublyStochastic X) + (hXint : ∀ i, IsInteriorProbabilityVector (X i)) + {r c : ι → ℝ} (hKKT : HasLogKKT τ A X r c) : + ∀ Y, IsDoublyStochastic Y → + regularizedBetheObjective τ A Y ≤ + regularizedBetheObjective τ A X := by + intro Y hY + have hsupport := regularizedBetheObjective_sub_le_gradient + (A := A) hcard hτ hX hY hXint + have hgrad : ∀ i j, regularizedBetheGradient τ A X i j = + r i + c j - (2 + τ) := by + intro i j + specialize hKKT i j + dsimp only [regularizedBetheGradient] + linarith + have hzero : + ∑ i, ∑ j, regularizedBetheGradient τ A X i j * + (Y i j - X i j) = 0 := by + simp_rw [hgrad] + have hpot := rowColumnPotential_sum_eq hY hX + (fun i ↦ r i - (2 + τ)) c + have hpot' : + (∑ i, ∑ j, (r i + c j - (2 + τ)) * Y i j) = + ∑ i, ∑ j, (r i + c j - (2 + τ)) * X i j := by + convert hpot using 1 <;> + apply Finset.sum_congr rfl <;> intro i _ <;> + apply Finset.sum_congr rfl <;> intro j _ <;> ring + calc + (∑ i, ∑ j, (r i + c j - (2 + τ)) * (Y i j - X i j)) = + (∑ i, ∑ j, (r i + c j - (2 + τ)) * Y i j) - + ∑ i, ∑ j, (r i + c j - (2 + τ)) * X i j := by + simp_rw [mul_sub, Finset.sum_sub_distrib] + _ = 0 := sub_eq_zero.mpr hpot' + linarith + +/-- The nearby KKT matrix makes the proposed interior doubly stochastic point +an exact regularized optimizer. -/ +theorem nearbyKKTMatrix_exact_optimizer + {ι : Type*} [Fintype ι] [DecidableEq ι] + (hcard : 1 < Fintype.card ι) + {τ : ℝ} (hτ : 0 ≤ τ) {X : Matrix ι ι ℝ} + (hX : IsDoublyStochastic X) + (hXint : ∀ i, IsInteriorProbabilityVector (X i)) + (r c : ι → ℝ) : + ∀ Y, IsDoublyStochastic Y → + regularizedBetheObjective τ (nearbyKKTMatrix τ X r c) Y ≤ + regularizedBetheObjective τ (nearbyKKTMatrix τ X r c) X := by + have hXpos : ∀ i j, 0 < X i j := fun i j ↦ (hXint i).2 j |>.1 + have hXlt : ∀ i j, X i j < 1 := fun i j ↦ (hXint i).2 j |>.2 + exact regularizedBetheObjective_le_of_logKKT hcard hτ hX hXint + (nearbyKKTMatrix_hasLogKKT hXpos hXlt) + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/NumericalPotentials.lean b/LeanPool/BeyondBethe/BeyondBethe/NumericalPotentials.lean new file mode 100644 index 0000000000..db83dcd35b --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/NumericalPotentials.lean @@ -0,0 +1,113 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.NumericalTransfer +import Mathlib.Tactic + +/-! # Numerical Potentials -/ + +namespace BeyondBethe + +/-! +# Explicit row and column potentials + +Least-squares projection is unnecessary in the numerical argument. Fixing +one row and one column gives an explicit rational recovery map. Exact +row-plus-column matrices are recovered identically, while a coordinatewise +perturbation of size `delta` creates residual at most `4 * delta`. +-/ + +/-- Row potentials anchored at one column. -/ +def anchoredRowPotential + {ι κ : Type*} (G : Matrix ι κ ℝ) (j0 : κ) : ι → ℝ := + fun i ↦ G i j0 + +/-- Column potentials anchored at one row and normalized to vanish at the +anchor column. -/ +def anchoredColumnPotential + {ι κ : Type*} (G : Matrix ι κ ℝ) (i0 : ι) (j0 : κ) : κ → ℝ := + fun j ↦ G i0 j - G i0 j0 + +theorem anchoredPotentials_exact + {ι κ : Type*} (r : ι → ℝ) (c : κ → ℝ) + (i0 : ι) (j0 : κ) (i : ι) (j : κ) : + anchoredRowPotential (fun a b ↦ r a + c b) j0 i + + anchoredColumnPotential (fun a b ↦ r a + c b) i0 j0 j = + r i + c j := by + simp [anchoredRowPotential, anchoredColumnPotential] + +theorem abs_sub_sub_add_le_four + {a b c d δ : ℝ} + (ha : abs a ≤ δ) (hb : abs b ≤ δ) + (hc : abs c ≤ δ) (hd : abs d ≤ δ) : + abs (a - b - c + d) ≤ 4 * δ := by + calc + abs (a - b - c + d) = abs ((a - b) + (d - c)) := by ring + _ ≤ abs (a - b) + abs (d - c) := abs_add_le _ _ + _ ≤ (abs a + abs b) + (abs d + abs c) := + add_le_add (abs_sub a b) (abs_sub d c) + _ ≤ 4 * δ := by linarith + +/-- Anchored potentials turn coordinatewise proximity to a row-plus-column +matrix into a coordinatewise KKT residual. -/ +theorem anchoredPotentials_residual_le + {ι κ : Type*} {G Gstar : Matrix ι κ ℝ} + {r : ι → ℝ} {c : κ → ℝ} {δ : ℝ} + (hstar : ∀ i j, Gstar i j = r i + c j) + (hclose : ∀ i j, abs (G i j - Gstar i j) ≤ δ) + (i0 : ι) (j0 : κ) (i : ι) (j : κ) : + abs (G i j - + (anchoredRowPotential G j0 i + + anchoredColumnPotential G i0 j0 j)) ≤ 4 * δ := by + have hid : G i j - + (anchoredRowPotential G j0 i + + anchoredColumnPotential G i0 j0 j) = + (G i j - Gstar i j) - (G i j0 - Gstar i j0) - + (G i0 j - Gstar i0 j) + (G i0 j0 - Gstar i0 j0) := by + simp only [anchoredRowPotential, anchoredColumnPotential] + rw [hstar i j, hstar i j0, hstar i0 j, hstar i0 j0] + ring + rw [hid] + exact abs_sub_sub_add_le_four + (hclose i j) (hclose i j0) (hclose i0 j) (hclose i0 j0) + +/-- If `Gtilde` is a rational approximation to a computable gradient `G`, +the same anchored potentials have residual `evaluationError + 4 * modelError` +for `G`. The statement separates elementary-function evaluation error from +the optimization error that moves the gradient away from the exact KKT +subspace. -/ +theorem anchoredPotentials_residual_of_evaluation + {ι κ : Type*} {G Gtilde Gstar : Matrix ι κ ℝ} + {r : ι → ℝ} {c : κ → ℝ} {modelError evaluationError : ℝ} + (hstar : ∀ i j, Gstar i j = r i + c j) + (hmodel : ∀ i j, abs (Gtilde i j - Gstar i j) ≤ modelError) + (heval : ∀ i j, abs (G i j - Gtilde i j) ≤ evaluationError) + (i0 : ι) (j0 : κ) (i : ι) (j : κ) : + abs (G i j - + (anchoredRowPotential Gtilde j0 i + + anchoredColumnPotential Gtilde i0 j0 j)) ≤ + evaluationError + 4 * modelError := by + have hres := anchoredPotentials_residual_le + hstar hmodel i0 j0 i j + have htriangle : abs (G i j - + (anchoredRowPotential Gtilde j0 i + + anchoredColumnPotential Gtilde i0 j0 j)) ≤ + abs (G i j - Gtilde i j) + + abs (Gtilde i j - + (anchoredRowPotential Gtilde j0 i + + anchoredColumnPotential Gtilde i0 j0 j)) := by + have hid : (G i j - Gtilde i j) + + (Gtilde i j - + (anchoredRowPotential Gtilde j0 i + + anchoredColumnPotential Gtilde i0 j0 j)) = + G i j - + (anchoredRowPotential Gtilde j0 i + + anchoredColumnPotential Gtilde i0 j0 j) := by ring + rw [← hid] + exact abs_add_le _ _ + exact htriangle.trans (add_le_add (heval i j) hres) + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/NumericalScales.lean b/LeanPool/BeyondBethe/BeyondBethe/NumericalScales.lean new file mode 100644 index 0000000000..a27b4cf02d --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/NumericalScales.lean @@ -0,0 +1,456 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.NearCase +import Mathlib.Algebra.Order.Archimedean.Basic + +/-! # Numerical Scales -/ + +namespace BeyondBethe + +/-! +# Rational structural scales for the numerical algorithm + +The qualitative completion theorem chooses its hierarchy of constants in +`ℝ`. That is sufficient for the mathematical approximation theorem, but an +algorithm cannot use an unspecified real regularization parameter. This file +repeats the choice with rational points at every open step. The resulting +constants can be hard-coded in a Turing machine and the regularization scale +`ξ / (4n)` is rational on every input dimension. +-/ + +/-- Rational data satisfying exactly the scale inequalities consumed by the +positive-matrix dichotomy. Analytic expressions are compared after casting +the rational constants to `ℝ`. -/ +structure RationalCompletionScales (κ₀ ξ₀ γ₀ : ℚ) where + η : ℚ + δ : ℚ + ξ : ℚ + η_pos : 0 < η + η_le_tenth : (η : ℝ) ≤ 1 / 10 + δ_pos : 0 < δ + ξ_pos : 0 < ξ + ξ_le_source : ξ ≤ ξ₀ + row_small : + (δ : ℝ) / ((η : ℝ) / 3074) ^ 4 ≤ 1 / 128 + cycle_small : + 6 / Real.log 2 * + ((δ : ℝ) + (1 + Real.log 2 / 2) * + ((δ : ℝ) / ((η : ℝ) / 3074) ^ 4) + + goodRowOmega (η : ℝ)) ≤ 1 / 16 + transfer_small : + (δ : ℝ) + 2 * (ξ : ℝ) + binaryEntropy (η : ℝ) + (η : ℝ) + + (1 + Real.log 2) * + ((δ : ℝ) / ((η : ℝ) / 3074) ^ 4) ≤ + (1 / 16) * ((1 / 2 - (η : ℝ)) * (κ₀ : ℝ)) + ξ_lt_δ : ξ < δ + ξ_lt_gain : ξ < 3 * γ₀ / 8 + +/-- The completion hierarchy may be chosen rationally. The proof uses +rational density only inside strict margins, so no numerical approximation is +smuggled into the theorem. -/ +theorem exists_rational_completion_scales + {κ₀ ξ₀ γ₀ : ℚ} (hκ₀ : 0 < κ₀) (hξ₀ : 0 < ξ₀) (hγ₀ : 0 < γ₀) : + Nonempty (RationalCompletionScales κ₀ ξ₀ γ₀) := by + have hκ₀r : 0 < (κ₀ : ℝ) := by exact_mod_cast hκ₀ + have hξ₀r : 0 < (ξ₀ : ℝ) := by exact_mod_cast hξ₀ + have hγ₀r : 0 < (γ₀ : ℝ) := by exact_mod_cast hγ₀ + have hlog : 0 < Real.log 2 := Real.log_pos (by norm_num) + have hωtarget : 0 < Real.log 2 / 384 := div_pos hlog (by norm_num) + have hωevent : {x : ℝ | goodRowOmega x < Real.log 2 / 384} ∈ nhds 0 := + tendsto_goodRowOmega_zero (isOpen_Iio.mem_nhds hωtarget) + have hHcont : ContinuousAt (fun x : ℝ ↦ binaryEntropy x + x) 0 := + continuous_binaryEntropy.continuousAt.add continuousAt_id + have hHtarget : 0 < (κ₀ : ℝ) / 256 := div_pos hκ₀r (by norm_num) + have hHevent : + {x : ℝ | binaryEntropy x + x < (κ₀ : ℝ) / 256} ∈ nhds 0 := by + exact hHcont.eventually (isOpen_Iio.mem_nhds (by + simpa [binaryEntropy] using hHtarget)) + have hevent := Filter.inter_mem hωevent hHevent + rw [Metric.mem_nhds_iff] at hevent + obtain ⟨a, ha, hball⟩ := hevent + have hηbound : 0 < min a (1 / 20 : ℝ) := lt_min ha (by norm_num) + obtain ⟨ηq, hηq0r, hηqbound⟩ := exists_pos_rat_lt hηbound + have hηq0 : 0 < ηq := hηq0r + let η : ℝ := (ηq : ℝ) + have hη : 0 < η := by + simpa only [η, Rat.cast_pos] using hηq0r + have hηtwenty : η < 1 / 20 := + hηqbound.trans_le (min_le_right _ _) + have hηa : η < a := hηqbound.trans_le (min_le_left _ _) + have hηmem := hball (by + rw [Metric.mem_ball, Real.dist_eq, sub_zero, abs_of_pos hη] + exact hηa) + have hωsmall : goodRowOmega η < Real.log 2 / 384 := hηmem.1 + have hHsmall : binaryEntropy η + η < (κ₀ : ℝ) / 256 := hηmem.2 + have hηtenth : η ≤ 1 / 10 := hηtwenty.le.trans (by norm_num) + have hcycleBase : 6 / Real.log 2 * goodRowOmega η < 1 / 64 := by + have hcoef : 0 < 6 / Real.log 2 := div_pos (by norm_num) hlog + calc + 6 / Real.log 2 * goodRowOmega η < + 6 / Real.log 2 * (Real.log 2 / 384) := + mul_lt_mul_of_pos_left hωsmall hcoef + _ = 1 / 64 := by field_simp [hlog.ne'] <;> norm_num + have hηκ : η * (κ₀ : ℝ) ≤ (1 / 20) * (κ₀ : ℝ) := + mul_le_mul_of_nonneg_right hηtwenty.le hκ₀r.le + have htransferBase : binaryEntropy η + η < + (1 / 16) * ((1 / 2 - η) * (κ₀ : ℝ)) := by + nlinarith + let cycleMargin : ℝ := 1 / 16 - 6 / Real.log 2 * goodRowOmega η + let transferMargin : ℝ := + (1 / 16) * ((1 / 2 - η) * (κ₀ : ℝ)) - (binaryEntropy η + η) + have hcycleMargin : 0 < cycleMargin := by + dsimp only [cycleMargin] + linarith + have htransferMargin : 0 < transferMargin := by + dsimp only [transferMargin] + linarith + let d₀q : ℚ := (ηq / 3074) ^ 4 + let d₀ : ℝ := (d₀q : ℚ) + have hd₀_cast : d₀ = (η / 3074) ^ 4 := by + simp [d₀, d₀q, η] + have hd₀ : 0 < d₀ := by + rw [hd₀_cast] + positivity + let cycleCoefficient : ℝ := + 6 / Real.log 2 * (d₀ + (1 + Real.log 2 / 2)) + have hcycleCoefficient : 0 < cycleCoefficient := by + dsimp only [cycleCoefficient] + have hc : 0 < d₀ + (1 + Real.log 2 / 2) := by positivity + exact mul_pos (div_pos (by norm_num) hlog) hc + let transferCoefficient : ℝ := d₀ + (1 + Real.log 2) + have htransferCoefficient : 0 < transferCoefficient := by + dsimp only [transferCoefficient] + positivity + let rBound : ℝ := min (1 / 128) + (min (cycleMargin / (2 * cycleCoefficient)) + (transferMargin / (2 * transferCoefficient))) + have hrBound : 0 < rBound := by + dsimp only [rBound] + exact lt_min (by norm_num) (lt_min + (div_pos hcycleMargin (mul_pos (by norm_num) hcycleCoefficient)) + (div_pos htransferMargin (mul_pos (by norm_num) htransferCoefficient))) + obtain ⟨rq, hrq0r, hrqBound⟩ := exists_pos_rat_lt hrBound + have hrq0 : 0 < rq := hrq0r + let r : ℝ := (rq : ℝ) + have hr : 0 < r := by + simpa only [r, Rat.cast_pos] using hrq0r + have hr128 : r ≤ 1 / 128 := + hrqBound.le.trans (min_le_left _ _) + have hrcycle : r ≤ cycleMargin / (2 * cycleCoefficient) := + hrqBound.le.trans ((min_le_right _ _).trans (min_le_left _ _)) + have hrtransfer : r ≤ transferMargin / (2 * transferCoefficient) := + hrqBound.le.trans ((min_le_right _ _).trans (min_le_right _ _)) + have hcycleExtra : cycleCoefficient * r ≤ cycleMargin / 2 := by + calc + cycleCoefficient * r ≤ + cycleCoefficient * (cycleMargin / (2 * cycleCoefficient)) := + mul_le_mul_of_nonneg_left hrcycle hcycleCoefficient.le + _ = cycleMargin / 2 := by field_simp [hcycleCoefficient.ne'] + have htransferExtra : transferCoefficient * r ≤ transferMargin / 2 := by + calc + transferCoefficient * r ≤ + transferCoefficient * (transferMargin / (2 * transferCoefficient)) := + mul_le_mul_of_nonneg_left hrtransfer htransferCoefficient.le + _ = transferMargin / 2 := by field_simp [htransferCoefficient.ne'] + let δq : ℚ := d₀q * rq + let δ : ℝ := (δq : ℚ) + have hδ_cast : δ = d₀ * r := by simp [δ, δq, d₀, r] + have hδ : 0 < δ := by rw [hδ_cast]; exact mul_pos hd₀ hr + have hδq : 0 < δq := by + dsimp only [δq, d₀q] + positivity + have hratio : δ / (η / 3074) ^ 4 = r := by + rw [← hd₀_cast, hδ_cast] + exact mul_div_cancel_left₀ r hd₀.ne' + have hcycle : 6 / Real.log 2 * + (δ + (1 + Real.log 2 / 2) * (δ / (η / 3074) ^ 4) + + goodRowOmega η) < 1 / 16 := by + rw [hratio] + have hid : 6 / Real.log 2 * + (δ + (1 + Real.log 2 / 2) * r + goodRowOmega η) = + 6 / Real.log 2 * goodRowOmega η + cycleCoefficient * r := by + rw [hδ_cast] + dsimp only [cycleCoefficient] + ring + rw [hid] + dsimp only [cycleMargin] at hcycleExtra + linarith + have htransferZero : + δ + binaryEntropy η + η + + (1 + Real.log 2) * (δ / (η / 3074) ^ 4) < + (1 / 16) * ((1 / 2 - η) * (κ₀ : ℝ)) := by + rw [hratio] + have hid : δ + binaryEntropy η + η + (1 + Real.log 2) * r = + (binaryEntropy η + η) + transferCoefficient * r := by + rw [hδ_cast] + dsimp only [transferCoefficient] + ring + rw [hid] + dsimp only [transferMargin] at htransferExtra + linarith + let remaining : ℝ := (1 / 16) * ((1 / 2 - η) * (κ₀ : ℝ)) - + (δ + binaryEntropy η + η + + (1 + Real.log 2) * (δ / (η / 3074) ^ 4)) + have hremaining : 0 < remaining := by + dsimp only [remaining] + linarith + let ξBound : ℝ := min (ξ₀ : ℝ) + (min δ (min (3 * (γ₀ : ℝ) / 8) (remaining / 4))) + have hξBound : 0 < ξBound := by + dsimp only [ξBound] + exact lt_min hξ₀r (lt_min hδ (lt_min + (div_pos (mul_pos (by norm_num) hγ₀r) (by norm_num)) + (div_pos hremaining (by norm_num)))) + obtain ⟨ξq, hξq0r, hξqBound⟩ := exists_pos_rat_lt hξBound + have hξq0 : 0 < ξq := by exact_mod_cast hξq0r + let ξ : ℝ := (ξq : ℝ) + have hξξ₀r : ξ < (ξ₀ : ℝ) := + hξqBound.trans_le (min_le_left _ _) + have hξξ₀ : ξq ≤ ξ₀ := by + have hcast : (ξq : ℝ) ≤ (ξ₀ : ℝ) := by + simpa only [ξ] using hξξ₀r.le + exact_mod_cast hcast + have hξδr : ξ < δ := + hξqBound.trans_le ((min_le_right _ _).trans (min_le_left _ _)) + have hξδ : ξq < δq := by + change (ξq : ℝ) < (δq : ℝ) at hξδr + exact_mod_cast hξδr + have hξγ : ξ < 3 * (γ₀ : ℝ) / 8 := + hξqBound.trans_le ((min_le_right _ _).trans + ((min_le_right _ _).trans (min_le_left _ _))) + have hξremaining : ξ ≤ remaining / 4 := + hξqBound.le.trans ((min_le_right _ _).trans + ((min_le_right _ _).trans (min_le_right _ _))) + have htransfer : + δ + 2 * ξ + binaryEntropy η + η + + (1 + Real.log 2) * (δ / (η / 3074) ^ 4) ≤ + (1 / 16) * ((1 / 2 - η) * (κ₀ : ℝ)) := by + dsimp only [remaining] at hξremaining + nlinarith + exact ⟨{ + η := ηq + δ := δq + ξ := ξq + η_pos := hηq0 + η_le_tenth := by simpa only [η] using hηtenth + δ_pos := hδq + ξ_pos := hξq0 + ξ_le_source := hξξ₀ + row_small := by + change δ / (η / 3074) ^ 4 ≤ 1 / 128 + rw [hratio] + exact hr128 + cycle_small := by simpa only [δ, η] using hcycle.le + transfer_small := by simpa only [δ, ξ, η] using htransfer + ξ_lt_δ := hξδ + ξ_lt_gain := by + have hcast : (ξq : ℝ) < ((3 * γ₀ / 8 : ℚ) : ℝ) := by + norm_num only [Rat.cast_div, Rat.cast_mul, Rat.cast_ofNat] + simpa only [ξ] using hξγ + exact_mod_cast hcast }⟩ + +/-- A rational version of the improvement left after the far/near dichotomy. -/ +def rationalEpsilonPlus + {κ₀ ξ₀ γ₀ : ℚ} (s : RationalCompletionScales κ₀ ξ₀ γ₀) : ℚ := + min (s.δ - s.ξ) (3 * γ₀ / 8 - s.ξ) + +theorem rationalEpsilonPlus_pos + {κ₀ ξ₀ γ₀ : ℚ} (s : RationalCompletionScales κ₀ ξ₀ γ₀) : + 0 < rationalEpsilonPlus s := by + rw [rationalEpsilonPlus, lt_min_iff] + exact ⟨sub_pos.mpr s.ξ_lt_δ, sub_pos.mpr s.ξ_lt_gain⟩ + +theorem cast_rationalEpsilonPlus + {κ₀ ξ₀ γ₀ : ℚ} (s : RationalCompletionScales κ₀ ξ₀ γ₀) : + ((rationalEpsilonPlus s : ℚ) : ℝ) = + epsilonPlus (s.δ : ℝ) (s.ξ : ℝ) (γ₀ : ℝ) := by + simp [rationalEpsilonPlus, epsilonPlus, Rat.cast_min] + +/-- The elementary dimension bound that permits the algorithm to use the +rational scale `ell = n`, instead of the nonrational expression +`max 1 (log n / log 2)`. -/ +theorem log_natCast_le_natCast_mul_log_two + {n : ℕ} (hn : 1 ≤ n) : + Real.log n ≤ (n : ℝ) * Real.log 2 := by + have hnpos : (0 : ℝ) < n := by exact_mod_cast (Nat.zero_lt_of_lt hn) + have hpowpos : (0 : ℝ) < (2 : ℝ) ^ n := pow_pos (by norm_num) n + have hnat : n ≤ 2 ^ n := n.lt_two_pow_self.le + have hcast : (n : ℝ) ≤ (2 : ℝ) ^ n := by exact_mod_cast hnat + have hlog := Real.strictMonoOn_log.monotoneOn hnpos hpowpos hcast + rw [Real.log_pow] at hlog + simpa only [Nat.cast_ofNat] using hlog + +/-- All absolute constants needed by the structural argument, now retained +as rational data instead of being erased into an existential real constant. -/ +structure RationalStructuralScales where + κ₀ : ℚ + ξ₀ : ℚ + γ₀ : ℚ + κ₀_pos : 0 < κ₀ + ξ₀_pos : 0 < ξ₀ + γ₀_pos : 0 < γ₀ + cleanGain : CleanPairGainGuarantee (κ₀ : ℝ) (ξ₀ : ℝ) (γ₀ : ℝ) + completion : RationalCompletionScales κ₀ ξ₀ γ₀ + +theorem exists_rational_structuralScales : + Nonempty RationalStructuralScales := by + obtain ⟨κ₀, ξ₀, γ₀, hκ₀, hξ₀, hγ₀, hgain⟩ := + exists_rational_cleanPairGain_constants + obtain ⟨s⟩ := exists_rational_completion_scales hκ₀ hξ₀ hγ₀ + exact ⟨{ + κ₀ := κ₀ + ξ₀ := ξ₀ + γ₀ := γ₀ + κ₀_pos := hκ₀ + ξ₀_pos := hξ₀ + γ₀_pos := hγ₀ + cleanGain := hgain + completion := s }⟩ + +/-- The rational regularization parameter used in dimension `n`. -/ +def rationalRegularizationScale (s : RationalStructuralScales) (n : ℕ) : ℚ := + s.completion.ξ / (4 * n) + +theorem cast_rationalRegularizationScale + (s : RationalStructuralScales) (n : ℕ) : + ((rationalRegularizationScale s n : ℚ) : ℝ) = + (s.completion.ξ : ℝ) / (4 * (n : ℝ)) := by + simp [rationalRegularizationScale] + +theorem rationalRegularizationScale_pos + (s : RationalStructuralScales) {n : ℕ} (hn : 0 < n) : + 0 < rationalRegularizationScale s n := by + rw [rationalRegularizationScale] + exact div_pos s.completion.ξ_pos (by positivity) + +/-- The structural certificate applies to any exact optimizer at the rational +scale. This is the form needed after the numerical routine replaces its +approximate optimizer by a nearby matrix for which the KKT equations are +exact. -/ +theorem rationalScales_certificate_of_optimizer + (stableCoefficient : AnariOveisGharanStableCoefficient.{0}) + (s : RationalStructuralScales) + {n : ℕ} (hn : 2 ≤ n) + {A X : Matrix (Fin n) (Fin n) ℝ} + (hA : Matrix.Positive A) + (hX : IsDoublyStochastic X) + (hXint : ∀ i, IsInteriorProbabilityVector (X i)) + (hmax : ∀ Y, IsDoublyStochastic Y → + regularizedBetheObjective + ((rationalRegularizationScale s n : ℚ) : ℝ) A Y ≤ + regularizedBetheObjective + ((rationalRegularizationScale s n : ℚ) : ℝ) A X) + (hKKT : ∃ r c : Fin n → ℝ, + HasLogKKT ((rationalRegularizationScale s n : ℚ) : ℝ) A X r c) : + Real.exp (betheObjective A X + maximumMatchingGain A X) ≤ + Matrix.permanent A ∧ + Real.log (Matrix.permanent A) - + (betheObjective A X + maximumMatchingGain A X) ≤ + (Real.log 2 / 2 - + ((rationalEpsilonPlus s.completion : ℚ) : ℝ)) * n := by + let η : ℝ := (s.completion.η : ℝ) + let δ : ℝ := (s.completion.δ : ℝ) + let ξ : ℝ := (s.completion.ξ : ℝ) + let τ : ℝ := ((rationalRegularizationScale s n : ℚ) : ℝ) + obtain ⟨rscale, cscale, hKKT⟩ := hKKT + have hκ : 0 < (s.κ₀ : ℝ) := by exact_mod_cast s.κ₀_pos + have hγ : 0 < (s.γ₀ : ℝ) := by exact_mod_cast s.γ₀_pos + have hξ : 0 < ξ := by + simpa only [ξ, Rat.cast_pos] using s.completion.ξ_pos + have hξξ₀ : ξ ≤ (s.ξ₀ : ℝ) := by + have hcast : (s.completion.ξ : ℝ) ≤ (s.ξ₀ : ℝ) := by + exact_mod_cast s.completion.ξ_le_source + simpa only [ξ] using hcast + have hτscale : τ = ξ / (4 * (n : ℝ)) := by + exact cast_rationalRegularizationScale s n + have hobjective : + Real.log (bethePermanent A) - ξ * n ≤ betheObjective A X := by + have hbudget := regularization_budget_of_paper_scale + (show (0 : ℝ) < n by positivity) + (log_natCast_le_natCast_mul_log_two (show 1 ≤ n by omega)) + hξ hτscale + have hvalue := betheLogValue_le_regularizedMaximizer + (show 1 < n by omega) + (le_of_lt (by + change 0 < ((rationalRegularizationScale s n : ℚ) : ℝ) + exact_mod_cast rationalRegularizationScale_pos s (show 0 < n by omega))) + hA hX hmax + have hmatch := positiveMatrix_hasPerfectMatching hA + have hlogBethe : Real.log (bethePermanent A) = betheLogValue A := by + rw [bethePermanent, if_pos hmatch, Real.log_exp] + rw [hlogBethe] + linarith + have hmatch := positiveMatrix_hasPerfectMatching hA + have hlogBethe : Real.log (bethePermanent A) = betheLogValue A := by + rw [bethePermanent, if_pos hmatch, Real.log_exp] + have hupper : Real.log (Matrix.permanent A) ≤ + Real.log (bethePermanent A) + n * (Real.log 2 / 2) := by + rw [hlogBethe] + exact log_permanent_le_betheLogValue_add_log_two_half hn A hA + have hcertificate := + exp_betheObjective_add_maximumMatchingGain_le_permanent + stableCoefficient hn hA hX (fun i j ↦ (hXint i).2 j |>.1) + have hnearGain : betheSlack n (Real.log (bethePermanent A)) + (Real.log (Matrix.permanent A)) < δ * n → + 3 * (s.γ₀ : ℝ) / 8 * n ≤ maximumMatchingGain A X := by + intro hnear + rw [hlogBethe] at hnear + exact nearCase_maximumMatchingGain_ge_threeEighths + anariRezaeiRowInequality hn + s.cleanGain hκ hγ.le + (show (1 : ℝ) ≤ n by exact_mod_cast (show 1 ≤ n by omega)) + (log_natCast_le_natCast_mul_log_two (show 1 ≤ n by omega)) + hξ hξξ₀ hτscale + (by exact_mod_cast s.completion.η_pos) + s.completion.η_le_tenth + s.completion.row_small s.completion.cycle_small + s.completion.transfer_small hA hX hXint hKKT hnear + have hcases := completionCaseDisjunction + (logPermanent := Real.log (Matrix.permanent A)) + (logBethe := Real.log (bethePermanent A)) + (objective := betheObjective A X) + (gain := maximumMatchingGain A X) + (δ := δ) (ξ := ξ) (γ := (s.γ₀ : ℝ)) + hobjective (maximumMatchingGain_nonneg A X) hupper hnearGain + have hgap := positiveDichotomy_exponent hcases + have hεcast := cast_rationalEpsilonPlus s.completion + constructor + · exact hcertificate + · simpa only [η, δ, ξ, hεcast] using hgap + +/-- The positive-matrix certificate with a rational improvement fixedValue and +an explicitly rational regularization scale. -/ +theorem rationalScales_exactPositiveCertificate + (stableCoefficient : AnariOveisGharanStableCoefficient.{0}) + (s : RationalStructuralScales) : + ExactPositiveCertificate + ((rationalEpsilonPlus s.completion : ℚ) : ℝ) := by + intro n hn A hA + let τ : ℝ := ((rationalRegularizationScale s n : ℚ) : ℝ) + have hξ : 0 < (s.completion.ξ : ℝ) := by + exact_mod_cast s.completion.ξ_pos + have hτscale : τ = (s.completion.ξ : ℝ) / (4 * (n : ℝ)) := by + exact cast_rationalRegularizationScale s n + obtain ⟨X, hX, hXint, hmax, hKKT, _hobjective⟩ := + exists_regularizedOptimizer_at_paper_scale + (show 1 < n by omega) + (show (0 : ℝ) < n by positivity) + (log_natCast_le_natCast_mul_log_two (show 1 ≤ n by omega)) + hξ hτscale A hA + obtain ⟨hlower, hgap⟩ := rationalScales_certificate_of_optimizer + stableCoefficient s hn hA hX hXint hmax hKKT + exact ⟨X, hX, hlower, hgap⟩ + +theorem exists_rational_exactPositiveCertificate + (stableCoefficient : AnariOveisGharanStableCoefficient.{0}) : + ∃ ε : ℚ, 0 < ε ∧ ExactPositiveCertificate (ε : ℝ) := by + obtain ⟨s⟩ := exists_rational_structuralScales + exact ⟨rationalEpsilonPlus s.completion, + rationalEpsilonPlus_pos s.completion, + rationalScales_exactPositiveCertificate stableCoefficient s⟩ + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/NumericalTransfer.lean b/LeanPool/BeyondBethe/BeyondBethe/NumericalTransfer.lean new file mode 100644 index 0000000000..6033dc0fa6 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/NumericalTransfer.lean @@ -0,0 +1,152 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.NumericalNearby + +/-! # Numerical Transfer -/ + +namespace BeyondBethe + +/-! +# Certified transfer from an approximate KKT point + +The numerical optimizer need not return the exact regularized maximizer for +the input matrix. It is enough to return an exactly doubly stochastic +interior matrix and row/column potentials satisfying the logarithmic KKT +equations approximately. The nearby matrix then has those KKT equations +exactly. This file combines the nearby-matrix comparison with the structural +certificate and records the complete two-sided loss: the transfer costs two +copies of the logarithmic KKT residual. +-/ + +/-- The logarithm of the one-sided certificate transferred from the nearby +matrix back to the input matrix. -/ +noncomputable def nearbyCertificateLog + {n : ℕ} (error τ : ℝ) (X : Matrix (Fin n) (Fin n) ℝ) + (r c : Fin n → ℝ) : ℝ := + let A' := nearbyKKTMatrix τ X r c + betheObjective A' X + maximumMatchingGain A' X - error * n + +/-- The positive certificate obtained from an approximate KKT point. -/ +noncomputable def nearbyCertificateValue + {n : ℕ} (error τ : ℝ) (X : Matrix (Fin n) (Fin n) ℝ) + (r c : Fin n → ℝ) : ℝ := + Real.exp (nearbyCertificateLog error τ X r c) + +theorem nearbyCertificateValue_pos + {n : ℕ} (error τ : ℝ) (X : Matrix (Fin n) (Fin n) ℝ) + (r c : Fin n → ℝ) : + 0 < nearbyCertificateValue error τ X r c := by + exact Real.exp_pos _ + +/-- An approximate logarithmic KKT certificate loses exactly two copies of +its residual in the final logarithmic approximation: one when comparing the +input permanent to the nearby permanent, and one in the downward shift that +preserves the lower-bound direction. -/ +theorem nearbyCertificate_twoSided + (stableCoefficient : AnariOveisGharanStableCoefficient.{0}) + (s : RationalStructuralScales) + {n : ℕ} (hn : 2 ≤ n) + {A X : Matrix (Fin n) (Fin n) ℝ} + (hA : Matrix.Positive A) + (hX : IsDoublyStochastic X) + (hXint : ∀ i, IsInteriorProbabilityVector (X i)) + {error : ℝ} {r c : Fin n → ℝ} + (happrox : HasApproximateLogKKT error + ((rationalRegularizationScale s n : ℚ) : ℝ) A X r c) : + nearbyCertificateValue error + ((rationalRegularizationScale s n : ℚ) : ℝ) X r c ≤ + Matrix.permanent A ∧ + Matrix.permanent A ≤ + (Real.sqrt 2 * Real.exp + (-(((rationalEpsilonPlus s.completion : ℚ) : ℝ) - + 2 * error))) ^ n * + nearbyCertificateValue error + ((rationalRegularizationScale s n : ℚ) : ℝ) X r c := by + let τ : ℝ := ((rationalRegularizationScale s n : ℚ) : ℝ) + let A' := nearbyKKTMatrix τ X r c + let F := betheObjective A' X + maximumMatchingGain A' X + let L := nearbyCertificateValue error τ X r c + have hXpos : ∀ i j, 0 < X i j := fun i j ↦ (hXint i).2 j |>.1 + have hXlt : ∀ i j, X i j < 1 := fun i j ↦ (hXint i).2 j |>.2 + have hA' : Matrix.Positive A' := nearbyKKTMatrix_positive hXpos hXlt + have hτ : 0 ≤ τ := by + change 0 ≤ (((rationalRegularizationScale s n : ℚ) : ℝ)) + exact_mod_cast (rationalRegularizationScale_pos s (show 0 < n by omega)).le + have hmax : ∀ Y, IsDoublyStochastic Y → + regularizedBetheObjective τ A' Y ≤ + regularizedBetheObjective τ A' X := by + have hcard : 1 < Fintype.card (Fin n) := by + simpa only [Fintype.card_fin] using (show 1 < n by omega) + exact nearbyKKTMatrix_exact_optimizer (ι := Fin n) hcard + hτ hX hXint r c + have hstruct := rationalScales_certificate_of_optimizer + stableCoefficient s hn hA' hX hXint hmax + ⟨r, c, nearbyKKTMatrix_hasLogKKT hXpos hXlt⟩ + have hcompare := approximateLogKKT_permanent_comparison + hA (by simpa only [τ] using happrox) hXpos hXlt + have hcompare' : + (Real.exp (-error)) ^ n * Matrix.permanent A' ≤ + Matrix.permanent A ∧ + Matrix.permanent A ≤ + (Real.exp error) ^ n * Matrix.permanent A' := by + simpa only [A', τ, Fintype.card_fin] using hcompare + have hstructLower : Real.exp F ≤ Matrix.permanent A' := by + simpa only [F] using hstruct.1 + have hstructGap : Real.log (Matrix.permanent A') - F ≤ + (Real.log 2 / 2 - + ((rationalEpsilonPlus s.completion : ℚ) : ℝ)) * n := by + simpa only [F] using hstruct.2 + have hperA : 0 < Matrix.permanent A := permanent_pos_of_positive A hA + have hperA' : 0 < Matrix.permanent A' := permanent_pos_of_positive A' hA' + have hL : L = Real.exp (F - error * n) := by + simp only [L, nearbyCertificateValue, nearbyCertificateLog, A', F, τ] + have hfactor : Real.exp (F - error * n) = + (Real.exp (-error)) ^ n * Real.exp F := by + calc + Real.exp (F - error * n) = + Real.exp F * Real.exp (-(error * n)) := by + rw [sub_eq_add_neg, Real.exp_add] + _ = Real.exp F * Real.exp ((n : ℝ) * (-error)) := by + congr 2 + ring + _ = Real.exp F * (Real.exp (-error)) ^ n := by + rw [Real.exp_nat_mul] + _ = (Real.exp (-error)) ^ n * Real.exp F := by ring + constructor + · change L ≤ Matrix.permanent A + rw [hL, hfactor] + have hscaled : (Real.exp (-error)) ^ n * Real.exp F ≤ + (Real.exp (-error)) ^ n * Matrix.permanent A' := + mul_le_mul_of_nonneg_left hstructLower + (pow_nonneg (Real.exp_pos (-error)).le n) + exact hscaled.trans hcompare'.1 + · have hscalePos : 0 < (Real.exp error) ^ n * Matrix.permanent A' := + mul_pos (pow_pos (Real.exp_pos _) n) hperA' + have hlogCompare : Real.log (Matrix.permanent A) ≤ + Real.log ((Real.exp error) ^ n * Matrix.permanent A') := + Real.strictMonoOn_log.monotoneOn hperA hscalePos hcompare'.2 + have hlogScale : + Real.log ((Real.exp error) ^ n * Matrix.permanent A') = + error * n + Real.log (Matrix.permanent A') := by + rw [Real.log_mul (pow_ne_zero n (Real.exp_ne_zero error)) hperA'.ne', + Real.log_pow, Real.log_exp] + ring + have hgap : Real.log (Matrix.permanent A) - Real.log L ≤ + (Real.log 2 / 2 - + (((rationalEpsilonPlus s.completion : ℚ) : ℝ) - + 2 * error)) * n := by + rw [hlogScale] at hlogCompare + rw [hL, Real.log_exp] + nlinarith [hstructGap] + change Matrix.permanent A ≤ + (Real.sqrt 2 * Real.exp + (-(((rationalEpsilonPlus s.completion : ℚ) : ℝ) - + 2 * error))) ^ n * L + exact logGap_implies_positive_approximation + (by rw [hL]; exact Real.exp_pos _) hperA hgap + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/NumericalWitness.lean b/LeanPool/BeyondBethe/BeyondBethe/NumericalWitness.lean new file mode 100644 index 0000000000..0ef841b424 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/NumericalWitness.lean @@ -0,0 +1,507 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.CleanGain +import LeanPool.BeyondBethe.BeyondBethe.NumericalCapacity +import Mathlib.Tactic + +/-! # Numerical Witness -/ + +open scoped BigOperators + +namespace BeyondBethe + +/-! +# Explicit finite witnesses for the pair gain + +The clean-pair proof already constructs a sparse feasible coefficient +distribution. Evaluating these distributions for every candidate pair of +core columns removes the need to solve a second convex program for each pair +capacity. This file records the exact logarithmic witness and its one-sided +comparison with the true pair gain. +-/ + +/-- The sparse coefficient distribution associated with candidate core +columns `a,b`. When the outside mass is zero, Lean's totalized division makes +the two arm families vanish and leaves the point mass on the core edge. -/ +noncomputable def explicitPairWitness + {n : ℕ} (X : Matrix (Fin n) (Fin n) ℝ) + (r s a b : Fin n) : CapacityWitnessEdge (OutsideColumn a b) → ℝ := + let α := pairAlpha X r s + let ρ := outsideMassTwo α a b + let δa := 1 - α a + let δb := 1 - α b + capacityWitnessMass ρ δa δb (fun l ↦ α l.1) + +/-- Logarithm of the explicit witness lower bound on `pairGain`. -/ +noncomputable def explicitPairWitnessLogGain + {n : ℕ} (τ : ℝ) (X : Matrix (Fin n) (Fin n) ℝ) + (r s a b : Fin n) : ℝ := + let α := pairAlpha X r s + let Ur : Fin n → ℝ := fun j ↦ transferU τ (X r) j + let Us : Fin n → ℝ := fun j ↦ transferU τ (X s) j + let θ := explicitPairWitness X r s a b + let coeff := cleanWitnessCoefficient Ur Us a b + let normalization := + -Real.log (rowZeta τ (X r)) - Real.log (rowZeta τ (X s)) + let productTerm := ∑ j, (1 - α j) * Real.log (1 - α j) + let certificate := entropyCapacityCertificate θ coeff + normalization + productTerm + certificate + +/-- Algorithm-facing form of the clean-pair lemma. Unlike +`CleanPairGainGuarantee`, this statement does not mention the input matrix or +KKT multipliers: it says that the finite witness computed from `X` already +has the advertised gain. This is the form needed before directed rational +evaluation and threshold matching are introduced. -/ +def ExplicitPairWitnessGainGuarantee (κ₀ ξ₀ γ₀ : ℝ) : Prop := + ∀ {n : ℕ} {ell ξ τ : ℝ} {X : Matrix (Fin n) (Fin n) ℝ}, + 1 ≤ ell → + Real.log n ≤ ell * Real.log 2 → + 0 < ξ → ξ ≤ ξ₀ → τ = ξ / (4 * ell) → + IsDoublyStochastic X → + (∀ i, IsInteriorProbabilityVector (X i)) → + ∀ {r s a b : Fin n}, r ≠ s → a ≠ b → + fourCoreTransferCost τ X r s a b ≤ κ₀ → + γ₀ ≤ explicitPairWitnessLogGain τ X r s a b + +/-- For positive outside mass at most one, the explicit distribution is an +exactly feasible capacity witness. -/ +theorem explicitPairWitness_isCapacityDistribution_of_positiveLeakage + {n : ℕ} {X : Matrix (Fin n) (Fin n) ℝ} + (hX : IsDoublyStochastic X) + {r s a b : Fin n} (hrs : r ≠ s) (hab : a ≠ b) + (hρ : 0 < outsideMassTwo (pairAlpha X r s) a b) + (hρ1 : outsideMassTwo (pairAlpha X r s) a b ≤ 1) : + IsCapacityDistribution (explicitPairWitness X r s a b) + (cleanWitnessExponent a b) (pairAlpha X r s) := by + constructor + · simpa only [explicitPairWitness] using + cleanWitness_pairAlpha_isProbabilityVector hX hrs hab hρ hρ1 + · simpa only [explicitPairWitness] using + cleanWitness_pairAlpha_moment hX hab hρ + +/-- The clean-pair analysis lower-bounds the explicit witness itself, not +merely the larger optimized capacity. This is the formal statement that +justifies replacing the capacity program by finite witness enumeration. -/ +theorem cleanGainLowerBound_le_explicitPairWitnessLogGain + {n : ℕ} {τ κ : ℝ} (hτ : 0 ≤ τ) + {X : Matrix (Fin n) (Fin n) ℝ} + (hX : IsDoublyStochastic X) + (hXint : ∀ i, IsInteriorProbabilityVector (X i)) + {r s a b : Fin n} (hrs : r ≠ s) (hab : a ≠ b) + (hcost : fourCoreTransferCost τ X r s a b ≤ κ) + (hρ : 0 < outsideMassTwo (pairAlpha X r s) a b) + (hρ1 : outsideMassTwo (pairAlpha X r s) a b < 1) : + cleanGainLowerBound κ τ + (outsideMassTwo (pairAlpha X r s) a b) + (fun l : OutsideColumn a b ↦ pairAlpha X r s l.1) ≤ + explicitPairWitnessLogGain τ X r s a b := by + let α := pairAlpha X r s + let ρ := outsideMassTwo α a b + let δa := 1 - α a + let δb := 1 - α b + let Ur : Fin n → ℝ := fun j ↦ transferU τ (X r) j + let Us : Fin n → ℝ := fun j ↦ transferU τ (X s) j + let θ := explicitPairWitness X r s a b + let coeff := cleanWitnessCoefficient Ur Us a b + have hcore := fourCoreTransfer_lower hτ hXint hcost + have hδpos := pairAlpha_coreDeficit_pos hX hXint hrs hab hρ + have hαpos : ∀ l : OutsideColumn a b, 0 < α l.1 := by + intro l + exact add_pos ((hXint r).2 l.1).1 ((hXint s).2 l.1).1 + have hαsum : ∑ l : OutsideColumn a b, α l.1 = ρ := + sum_outsideColumn_eq_outsideMassTwo α a b + have hδsum : δa + δb = ρ := by + have hsplit := twoCore_add_outsideMassTwo_eq_sum α hab + rw [show ∑ j, α j = 2 by + simpa only [α] using sum_pairAlpha hX r s] at hsplit + dsimp only [δa, δb, ρ] + linarith + have houtside : + -τ * ρ * Real.log 2 + + (1 + τ) * + (∑ l : OutsideColumn a b, α l.1 * Real.log (α l.1)) ≤ + ∑ l : OutsideColumn a b, + α l.1 * Real.log (Ur l.1 + Us l.1) := by + exact sum_alpha_log_pairTransfer_lower (a := a) (b := b) + hτ (hXint r) (hXint s) + (by simpa only [α, ρ, pairAlpha] using hαsum) + have hUr : ∀ j, 0 < Ur j := fun j ↦ transferU_pos (hXint r) j + have hUs : ∀ j, 0 < Us j := fun j ↦ transferU_pos (hXint s) j + have hcertificateLower : + (1 - ρ) * Real.log ((2 * (Real.exp (-κ)) ^ 2) / (1 - ρ)) + + ρ * Real.log (Real.exp (-κ)) - τ * ρ * Real.log 2 + + τ * (∑ l : OutsideColumn a b, α l.1 * Real.log (α l.1)) - + δa * Real.log (δa / ρ) - δb * Real.log (δb / ρ) ≤ + entropyCapacityCertificate θ coeff := by + dsimp only [θ, coeff, explicitPairWitness, α, ρ, δa, δb, + Ur, Us] + apply cleanWitness_capacity_theta_lower hab (Real.exp_pos _) hρ hρ1 + hδpos.1 hδpos.2 hδsum hαpos hαsum hUr hUs + · exact hcore.1 + · exact hcore.2.1 + · exact hcore.2.2.1 + · exact hcore.2.2.2 + · exact houtside + have hcard := two_lt_card_of_outsideMassTwo_pos hab hρ + have hXpos : ∀ i j, 0 < X i j := fun i j ↦ (hXint i).2 j |>.1 + have hαlt : ∀ j, α j < 1 := fun j ↦ + pairAlpha_lt_one_of_positive hX hXpos hcard hrs j + have hsumDecomp : + (∑ j, (1 - α j) * Real.log (1 - α j)) = + δa * Real.log δa + δb * Real.log δb + + ∑ l : OutsideColumn a b, + (1 - α l.1) * Real.log (1 - α l.1) := by + have hsplit := twoCore_add_outsideMassTwo_eq_sum + (fun j ↦ (1 - α j) * Real.log (1 - α j)) hab + rw [← sum_outsideColumn_eq_outsideMassTwo] at hsplit + dsimp only [δa, δb] + exact hsplit.symm + have houtsideFactor : + -ρ ≤ ∑ l : OutsideColumn a b, + (1 - α l.1) * Real.log (1 - α l.1) := by + calc + -ρ = ∑ l : OutsideColumn a b, -α l.1 := by + rw [Finset.sum_neg_distrib, hαsum] + _ ≤ ∑ l : OutsideColumn a b, + (1 - α l.1) * Real.log (1 - α l.1) := by + apply Finset.sum_le_sum + intro l _ + exact neg_alpha_le_one_sub_mul_log (hαlt l.1) + have hsumLower : + δa * Real.log δa + δb * Real.log δb - ρ ≤ + ∑ j, (1 - α j) * Real.log (1 - α j) := by + rw [hsumDecomp] + linarith + have hcancel := core_entropy_cancellation + hδpos.1 hδpos.2 hρ hδsum + have hzetaR : rowZeta τ (X r) ≤ 1 := + rowZeta_le_one hτ (hX.row_probability r) + have hzetaS : rowZeta τ (X s) ≤ 1 := + rowZeta_le_one hτ (hX.row_probability s) + have hzetaRpos : 0 < rowZeta τ (X r) := + rowZeta_pos (fun j ↦ (hXint r).2 j |>.1) + have hzetaSpos : 0 < rowZeta τ (X s) := + rowZeta_pos (fun j ↦ (hXint s).2 j |>.1) + have hlogNormalization : + 0 ≤ -Real.log (rowZeta τ (X r)) - Real.log (rowZeta τ (X s)) := by + have hrlog : Real.log (rowZeta τ (X r)) ≤ 0 := + Real.log_nonpos hzetaRpos.le hzetaR + have hslog : Real.log (rowZeta τ (X s)) ≤ 0 := + Real.log_nonpos hzetaSpos.le hzetaS + linarith + dsimp only [cleanGainLowerBound, explicitPairWitnessLogGain, α, ρ, + δa, δb, Ur, Us, θ, coeff] at * + linarith + +/-- At zero leakage the explicit point-mass witness retains the full core +coefficient. This is the boundary counterpart of +`cleanGainLowerBound_le_explicitPairWitnessLogGain`. -/ +theorem coreLowerBound_le_explicitPairWitnessLogGain_of_zeroLeakage + {n : ℕ} {τ κ : ℝ} (hτ : 0 ≤ τ) + {X : Matrix (Fin n) (Fin n) ℝ} + (hX : IsDoublyStochastic X) + (hXint : ∀ i, IsInteriorProbabilityVector (X i)) + {r s a b : Fin n} (hrs : r ≠ s) (hab : a ≠ b) + (hcost : fourCoreTransferCost τ X r s a b ≤ κ) + (hzero : outsideMassTwo (pairAlpha X r s) a b = 0) : + Real.log (2 * (Real.exp (-κ)) ^ 2) ≤ + explicitPairWitnessLogGain τ X r s a b := by + let α := pairAlpha X r s + let Ur : Fin n → ℝ := fun j ↦ transferU τ (X r) j + let Us : Fin n → ℝ := fun j ↦ transferU τ (X s) j + letI : IsEmpty (OutsideColumn a b) := + isEmpty_outsideColumn_of_pairAlpha_outsideMass_eq_zero hX hXint hzero + have hzeroWitness := cleanWitness_pairAlpha_zero hX hrs hab hzero + (inferInstance : IsEmpty (OutsideColumn a b)) + have ha : α a = 1 := by + have hsplit := twoCore_add_outsideMassTwo_eq_sum α hab + rw [show outsideMassTwo α a b = 0 by simpa only [α] using hzero, + show ∑ j, α j = 2 by simpa only [α] using sum_pairAlpha hX r s] + at hsplit + have hlea := pairAlpha_le_one hX hrs a + have hleb := pairAlpha_le_one hX hrs b + dsimp only [α] + linarith + have hb : α b = 1 := by + have hsplit := twoCore_add_outsideMassTwo_eq_sum α hab + rw [show outsideMassTwo α a b = 0 by simpa only [α] using hzero, + show ∑ j, α j = 2 by simpa only [α] using sum_pairAlpha hX r s] + at hsplit + have hlea := pairAlpha_le_one hX hrs a + have hleb := pairAlpha_le_one hX hrs b + dsimp only [α] + linarith + have hαone : ∀ j, α j = 1 := by + intro j + have hj : j = a ∨ j = b := by + by_contra h + push Not at h + let l : OutsideColumn a b := ⟨j, by + simp [outsideColumnFinset, h.1, h.2]⟩ + exact isEmptyElim l + exact hj.elim (fun h ↦ h ▸ ha) (fun h ↦ h ▸ hb) + have hθ : explicitPairWitness X r s a b = + capacityWitnessMass 0 0 0 (fun l : OutsideColumn a b ↦ α l.1) := by + simp only [explicitPairWitness] + rw [show outsideMassTwo (pairAlpha X r s) a b = 0 from hzero] + rw [show 1 - pairAlpha X r s a = 0 by + simpa only [α] using sub_eq_zero.mpr ha.symm, + show 1 - pairAlpha X r s b = 0 by + simpa only [α] using sub_eq_zero.mpr hb.symm] + have hcertificate : + entropyCapacityCertificate (explicitPairWitness X r s a b) + (cleanWitnessCoefficient Ur Us a b) = + Real.log (cleanWitnessCoefficient Ur Us a b (Sum.inl ())) := by + rw [hθ] + simp [entropyCapacityCertificate, capacityWitnessMass] + have hcore := fourCoreTransfer_lower hτ hXint hcost + have hcoreCoeff := cleanWitnessCoefficient_core_lower + (Real.exp_pos _).le hcore.1 hcore.2.1 hcore.2.2.1 hcore.2.2.2 + have hcoreBase : 0 < 2 * (Real.exp (-κ)) ^ 2 := + mul_pos (by norm_num) (sq_pos_of_pos (Real.exp_pos _)) + have hlogCore : Real.log (2 * (Real.exp (-κ)) ^ 2) ≤ + Real.log (cleanWitnessCoefficient Ur Us a b (Sum.inl ())) := + Real.log_le_log hcoreBase hcoreCoeff + have hzetaR : rowZeta τ (X r) ≤ 1 := + rowZeta_le_one hτ (hX.row_probability r) + have hzetaS : rowZeta τ (X s) ≤ 1 := + rowZeta_le_one hτ (hX.row_probability s) + have hzetaRpos : 0 < rowZeta τ (X r) := + rowZeta_pos (fun j ↦ (hXint r).2 j |>.1) + have hzetaSpos : 0 < rowZeta τ (X s) := + rowZeta_pos (fun j ↦ (hXint s).2 j |>.1) + have hlogNormalization : + 0 ≤ -Real.log (rowZeta τ (X r)) - Real.log (rowZeta τ (X s)) := by + have hrlog : Real.log (rowZeta τ (X r)) ≤ 0 := + Real.log_nonpos hzetaRpos.le hzetaR + have hslog : Real.log (rowZeta τ (X s)) ≤ 0 := + Real.log_nonpos hzetaSpos.le hzetaS + linarith + have hproductTerm : + (∑ j, (1 - α j) * Real.log (1 - α j)) = 0 := by + simp_rw [hαone] + simp + dsimp only [explicitPairWitnessLogGain, α, Ur, Us] + rw [hproductTerm, hcertificate] + linarith + +/-- Every eligible explicit witness is a rigorous lower bound on the true +pair gain. Only the log-sum certificate direction of capacity is used. -/ +theorem explicitPairWitnessLogGain_le_log_pairGain_of_positiveLeakage + {n : ℕ} {τ : ℝ} {A X : Matrix (Fin n) (Fin n) ℝ} + {rscale cscale : Fin n → ℝ} + (hApos : ∀ i j, 0 < A i j) + (hX : IsDoublyStochastic X) + (hXint : ∀ i, IsInteriorProbabilityVector (X i)) + (hrscale : ∀ i, 0 < rscale i) (hcscale : ∀ j, 0 < cscale j) + (hKKT : HasMultiplicativeKKT τ A X rscale cscale) + {r s a b : Fin n} (hrs : r ≠ s) (hab : a ≠ b) + (hρ : 0 < outsideMassTwo (pairAlpha X r s) a b) + (hρ1 : outsideMassTwo (pairAlpha X r s) a b ≤ 1) : + explicitPairWitnessLogGain τ X r s a b ≤ + Real.log (pairGain A X r s) := by + let α := pairAlpha X r s + let Ur : Fin n → ℝ := fun j ↦ transferU τ (X r) j + let Us : Fin n → ℝ := fun j ↦ transferU τ (X s) j + let cap := polynomialCapacity α (pairPolynomial Ur Us) + let prodFactor := ∏ j, (1 - α j) ^ (1 - α j) + let scale := 1 / (rowZeta τ (X r) * rowZeta τ (X s)) + let θ := explicitPairWitness X r s a b + let coeff := cleanWitnessCoefficient Ur Us a b + have hfeasible := explicitPairWitness_isCapacityDistribution_of_positiveLeakage + hX hrs hab hρ hρ1 + have hUr : ∀ j, 0 < Ur j := fun j ↦ transferU_pos (hXint r) j + have hUs : ∀ j, 0 < Us j := fun j ↦ transferU_pos (hXint s) j + have hcoeff : ∀ e, 0 < coeff e := by + simpa only [coeff] using cleanWitnessCoefficient_positive hUr hUs a b + have hcert : entropyCapacityCertificate θ coeff ≤ Real.log cap := by + dsimp only [θ, coeff, cap, α, Ur, Us] + exact cleanWitnessEntropyCertificate_le_log_pairPolynomialCapacity hab + hfeasible.1.nonnegative hfeasible.1.sum_eq_one + (by simpa only [coeff, Ur, Us] using hcoeff) hfeasible.2 + (fun j ↦ (hUr j).le) (fun j ↦ (hUs j).le) + have hcard : 2 < Fintype.card (Fin n) := + two_lt_card_of_outsideMassTwo_pos hab hρ + have hXpos : ∀ i j, 0 < X i j := fun i j ↦ (hXint i).2 j |>.1 + have hαlt : ∀ j, α j < 1 := fun j ↦ + pairAlpha_lt_one_of_positive hX hXpos hcard hrs j + have hcomp : ∀ j, 0 < 1 - α j := fun j ↦ sub_pos.mpr (hαlt j) + have hprodPos : 0 < prodFactor := by + dsimp only [prodFactor] + exact Finset.prod_pos fun j _ ↦ Real.rpow_pos_of_pos (hcomp j) _ + have hcapPos : 0 < cap := by + dsimp only [cap, α, Ur, Us] + exact pairTransferPolynomialCapacity_pos hX hXint hrs hab hρ hρ1 + have hzetaR : 0 < rowZeta τ (X r) := + rowZeta_pos (fun j ↦ (hXint r).2 j |>.1) + have hzetaS : 0 < rowZeta τ (X s) := + rowZeta_pos (fun j ↦ (hXint s).2 j |>.1) + have hscalePos : 0 < scale := by + dsimp only [scale] + exact one_div_pos.mpr (mul_pos hzetaR hzetaS) + have hfactor := pairGain_factorization hApos hX hXint + hrscale hcscale hKKT r s + have hlogFactor : Real.log (pairGain A X r s) = + Real.log scale + + (∑ j, (1 - α j) * Real.log (1 - α j)) + + Real.log cap := by + rw [hfactor] + dsimp only [scale, prodFactor, cap, α, Ur, Us] + rw [Real.log_mul (mul_pos hscalePos hprodPos).ne' hcapPos.ne', + Real.log_mul hscalePos.ne' hprodPos.ne', + Real.log_prod (fun j _ ↦ + (Real.rpow_pos_of_pos (hcomp j) _).ne')] + simp_rw [Real.log_rpow (hcomp _)] + ring + rw [hlogFactor] + dsimp only [explicitPairWitnessLogGain, α, Ur, Us, θ, coeff, scale] + have hlogScale : Real.log + (1 / (rowZeta τ (X r) * rowZeta τ (X s))) = + -Real.log (rowZeta τ (X r)) - Real.log (rowZeta τ (X s)) := by + rw [one_div, Real.log_inv, Real.log_mul hzetaR.ne' hzetaS.ne'] + ring + rw [hlogScale] + linarith + +/-- The point-mass witness is also a rigorous lower bound in the exact +zero-leakage boundary case. This branch is proved directly because the +complement factors are `0^0`, so a positivity argument through their +logarithms would be inappropriate. -/ +theorem explicitPairWitnessLogGain_le_log_pairGain_of_zeroLeakage + {n : ℕ} {τ : ℝ} {A X : Matrix (Fin n) (Fin n) ℝ} + {rscale cscale : Fin n → ℝ} + (hApos : ∀ i j, 0 < A i j) + (hX : IsDoublyStochastic X) + (hXint : ∀ i, IsInteriorProbabilityVector (X i)) + (hrscale : ∀ i, 0 < rscale i) (hcscale : ∀ j, 0 < cscale j) + (hKKT : HasMultiplicativeKKT τ A X rscale cscale) + {r s a b : Fin n} (hrs : r ≠ s) (hab : a ≠ b) + (hzero : outsideMassTwo (pairAlpha X r s) a b = 0) : + explicitPairWitnessLogGain τ X r s a b ≤ + Real.log (pairGain A X r s) := by + let α := pairAlpha X r s + let Ur : Fin n → ℝ := fun j ↦ transferU τ (X r) j + let Us : Fin n → ℝ := fun j ↦ transferU τ (X s) j + let cap := polynomialCapacity α (pairPolynomial Ur Us) + let scale := 1 / (rowZeta τ (X r) * rowZeta τ (X s)) + letI : IsEmpty (OutsideColumn a b) := + isEmpty_outsideColumn_of_pairAlpha_outsideMass_eq_zero hX hXint hzero + have hzeroWitness := cleanWitness_pairAlpha_zero hX hrs hab hzero + (inferInstance : IsEmpty (OutsideColumn a b)) + have ha : α a = 1 := by + have hsplit := twoCore_add_outsideMassTwo_eq_sum α hab + rw [show outsideMassTwo α a b = 0 by simpa only [α] using hzero, + show ∑ j, α j = 2 by simpa only [α] using sum_pairAlpha hX r s] + at hsplit + have hlea := pairAlpha_le_one hX hrs a + have hleb := pairAlpha_le_one hX hrs b + dsimp only [α] + linarith + have hb : α b = 1 := by + have hsplit := twoCore_add_outsideMassTwo_eq_sum α hab + rw [show outsideMassTwo α a b = 0 by simpa only [α] using hzero, + show ∑ j, α j = 2 by simpa only [α] using sum_pairAlpha hX r s] + at hsplit + have hlea := pairAlpha_le_one hX hrs a + have hleb := pairAlpha_le_one hX hrs b + dsimp only [α] + linarith + have hαone : ∀ j, α j = 1 := by + intro j + have hj : j = a ∨ j = b := by + by_contra h + push Not at h + let l : OutsideColumn a b := ⟨j, by + simp [outsideColumnFinset, h.1, h.2]⟩ + exact isEmptyElim l + exact hj.elim (fun h ↦ h ▸ ha) (fun h ↦ h ▸ hb) + have hθ : explicitPairWitness X r s a b = + capacityWitnessMass 0 0 0 (fun l : OutsideColumn a b ↦ α l.1) := by + simp only [explicitPairWitness] + rw [show outsideMassTwo (pairAlpha X r s) a b = 0 from hzero] + rw [show 1 - pairAlpha X r s a = 0 by + simpa only [α] using sub_eq_zero.mpr ha.symm, + show 1 - pairAlpha X r s b = 0 by + simpa only [α] using sub_eq_zero.mpr hb.symm] + have hUr : ∀ j, 0 < Ur j := fun j ↦ transferU_pos (hXint r) j + have hUs : ∀ j, 0 < Us j := fun j ↦ transferU_pos (hXint s) j + have hcoeff : ∀ e, 0 < cleanWitnessCoefficient Ur Us a b e := + cleanWitnessCoefficient_positive hUr hUs a b + have hcert : entropyCapacityCertificate (explicitPairWitness X r s a b) + (cleanWitnessCoefficient Ur Us a b) ≤ Real.log cap := by + dsimp only [cap, α, Ur, Us] + exact cleanWitnessEntropyCertificate_le_log_pairPolynomialCapacity hab + (by simpa only [hθ] using hzeroWitness.1.1) + (by simpa only [hθ] using hzeroWitness.1.2) + (by simpa only [Ur, Us] using hcoeff) + (by simpa only [hθ] using hzeroWitness.2) + (fun j ↦ (hUr j).le) (fun j ↦ (hUs j).le) + have hexp := exp_entropyCapacityCertificate_le_finitePolynomialCapacity + hzeroWitness.1.1 hzeroWitness.1.2 hcoeff hzeroWitness.2 + have hcapFinite := cleanWitnessCapacity_le_pairPolynomialCapacity hab + (u := Ur) (v := Us) (α := α) + (fun j ↦ (hUr j).le) (fun j ↦ (hUs j).le) + have hcapPos : 0 < cap := by + dsimp only [cap] + exact (Real.exp_pos _).trans_le (hexp.trans hcapFinite) + have hzetaR : 0 < rowZeta τ (X r) := + rowZeta_pos (fun j ↦ (hXint r).2 j |>.1) + have hzetaS : 0 < rowZeta τ (X s) := + rowZeta_pos (fun j ↦ (hXint s).2 j |>.1) + have hscalePos : 0 < scale := by + dsimp only [scale] + exact one_div_pos.mpr (mul_pos hzetaR hzetaS) + have hfactor := pairGain_factorization hApos hX hXint + hrscale hcscale hKKT r s + have hgainEq : pairGain A X r s = scale * cap := by + rw [hfactor] + simp_rw [show ∀ j, pairAlpha X r s j = 1 by + simpa only [α] using hαone] + simp [scale, cap, α, Ur, Us] + have hlogGain : Real.log (pairGain A X r s) = + Real.log scale + Real.log cap := by + rw [hgainEq, Real.log_mul hscalePos.ne' hcapPos.ne'] + have hlogScale : Real.log scale = + -Real.log (rowZeta τ (X r)) - Real.log (rowZeta τ (X s)) := by + dsimp only [scale] + rw [one_div, Real.log_inv, Real.log_mul hzetaR.ne' hzetaS.ne'] + ring + have hproductTerm : + (∑ j, (1 - α j) * Real.log (1 - α j)) = 0 := by + simp_rw [hαone] + simp + rw [hlogGain, hlogScale] + dsimp only [explicitPairWitnessLogGain, α, Ur, Us] + rw [hproductTerm] + linarith + +/-- Unified algorithm-facing form: the sole numerical eligibility test is +that the rational outside mass is at most one. Nonnegativity is automatic +from double stochasticity, and exact zero is dispatched to the point-mass +branch. -/ +theorem explicitPairWitnessLogGain_le_log_pairGain_of_le_one + {n : ℕ} {τ : ℝ} {A X : Matrix (Fin n) (Fin n) ℝ} + {rscale cscale : Fin n → ℝ} + (hApos : ∀ i j, 0 < A i j) + (hX : IsDoublyStochastic X) + (hXint : ∀ i, IsInteriorProbabilityVector (X i)) + (hrscale : ∀ i, 0 < rscale i) (hcscale : ∀ j, 0 < cscale j) + (hKKT : HasMultiplicativeKKT τ A X rscale cscale) + {r s a b : Fin n} (hrs : r ≠ s) (hab : a ≠ b) + (hρ1 : outsideMassTwo (pairAlpha X r s) a b ≤ 1) : + explicitPairWitnessLogGain τ X r s a b ≤ + Real.log (pairGain A X r s) := by + have hρnonneg : 0 ≤ outsideMassTwo (pairAlpha X r s) a b := by + dsimp only [outsideMassTwo] + exact Finset.sum_nonneg fun j _ ↦ pairAlpha_nonneg hX r s j + rcases hρnonneg.eq_or_lt with hzero | hpos + · exact explicitPairWitnessLogGain_le_log_pairGain_of_zeroLeakage + hApos hX hXint hrscale hcscale hKKT hrs hab hzero.symm + · exact explicitPairWitnessLogGain_le_log_pairGain_of_positiveLeakage + hApos hX hXint hrscale hcscale hKKT hrs hab hpos hρ1 + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/Optimizer.lean b/LeanPool/BeyondBethe/BeyondBethe/Optimizer.lean new file mode 100644 index 0000000000..e2b4fed7a7 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/Optimizer.lean @@ -0,0 +1,768 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.TransferIdentity +import LeanPool.BeyondBethe.BeyondBethe.SourceVontobel +import Mathlib.Analysis.Calculus.LocalExtr.Basic +import Mathlib.Topology.Instances.Matrix +import Mathlib.Tactic + +/-! # Optimizer -/ + +open scoped BigOperators Topology + +namespace BeyondBethe + +noncomputable section + +/-- The barycenter of the Birkhoff polytope. -/ +noncomputable def uniformBirkhoff (n : ℕ) : Matrix (Fin n) (Fin n) ℝ := + fun _ _ ↦ 1 / n + +theorem uniformBirkhoff_doublyStochastic + {n : ℕ} (hn : 0 < n) : + IsDoublyStochastic (uniformBirkhoff n) := by + refine ⟨?_, ?_, ?_⟩ + · intro i j + exact div_nonneg (by norm_num) (Nat.cast_nonneg n) + · intro i + simp [uniformBirkhoff, hn.ne'] + · intro j + simp [uniformBirkhoff, hn.ne'] + +theorem uniformBirkhoff_interior + {n : ℕ} (hn : 1 < n) : + ∀ i, IsInteriorProbabilityVector (uniformBirkhoff n i) := by + intro i + have hn0 : 0 < n := by omega + refine ⟨(uniformBirkhoff_doublyStochastic hn0).row_probability i, ?_⟩ + intro j + constructor + · exact div_pos (by norm_num) (by exact_mod_cast hn0) + · rw [uniformBirkhoff] + exact (div_lt_one (by exact_mod_cast hn0)).2 (by exact_mod_cast hn) + +/-- The Birkhoff polytope is closed in the finite matrix space. -/ +theorem isClosed_doublyStochastic + {n : Type*} [Fintype n] : + IsClosed {X : Matrix n n ℝ | IsDoublyStochastic X} := by + have hnonneg : IsClosed + {X : Matrix n n ℝ | ∀ i j, 0 ≤ X i j} := by + simp only [show {X : Matrix n n ℝ | ∀ i j, 0 ≤ X i j} = + ⋂ i, ⋂ j, {X | 0 ≤ X i j} by ext X; simp] + exact isClosed_iInter fun i ↦ isClosed_iInter fun j ↦ + isClosed_le continuous_const (continuous_apply_apply i j) + have hrow : IsClosed + {X : Matrix n n ℝ | ∀ i, ∑ j, X i j = 1} := by + simp only [show {X : Matrix n n ℝ | ∀ i, ∑ j, X i j = 1} = + ⋂ i, {X | ∑ j, X i j = 1} by ext X; simp] + exact isClosed_iInter fun i ↦ isClosed_eq + (continuous_finsetSum Finset.univ fun j _ ↦ + continuous_apply_apply i j) continuous_const + have hcol : IsClosed + {X : Matrix n n ℝ | ∀ j, ∑ i, X i j = 1} := by + simp only [show {X : Matrix n n ℝ | ∀ j, ∑ i, X i j = 1} = + ⋂ j, {X | ∑ i, X i j = 1} by ext X; simp] + exact isClosed_iInter fun j ↦ isClosed_eq + (continuous_finsetSum Finset.univ fun i _ ↦ + continuous_apply_apply i j) continuous_const + simpa [IsDoublyStochastic, Matrix.Nonnegative, Set.setOf_and] using + hnonneg.inter (hrow.inter hcol) + +/-- The Birkhoff polytope is compact. -/ +theorem isCompact_doublyStochastic + {n : Type*} [Fintype n] [DecidableEq n] : + IsCompact {X : Matrix n n ℝ | IsDoublyStochastic X} := by + let box : Set (Matrix n n ℝ) := + Set.univ.pi fun _i ↦ Set.univ.pi fun _j ↦ Set.Icc 0 1 + have hbox : IsCompact box := + isCompact_univ_pi fun _i ↦ isCompact_univ_pi fun _j ↦ isCompact_Icc + apply hbox.of_isClosed_subset isClosed_doublyStochastic + intro X hX i _ j _ + exact ⟨hX.nonnegative i j, hX.entry_le_one i j⟩ + +theorem regularizedBetheCoordinate_eq_continuousForm + (τ a x : ℝ) : + regularizedBetheCoordinate τ a x = + x * Real.log a + (1 + τ) * Real.negMulLog x - + Real.negMulLog (1 - x) := by + rw [regularizedBetheCoordinate, Real.negMulLog_def] + ring + +/-- For a positive matrix the regularized objective is continuous even at +the boundary; `negMulLog` supplies the continuous extension at zero. -/ +theorem continuous_regularizedBetheObjective + {n : Type*} [Fintype n] + (τ : ℝ) (A : Matrix n n ℝ) : + Continuous (regularizedBetheObjective τ A) := by + rw [show regularizedBetheObjective τ A = fun X ↦ + ∑ i, ∑ j, regularizedBetheCoordinate τ (A i j) (X i j) by + funext X + exact regularizedBetheObjective_eq_sum_coordinates τ A X] + apply continuous_finsetSum + intro i _ + apply continuous_finsetSum + intro j _ + simp_rw [regularizedBetheCoordinate_eq_continuousForm] + fun_prop + +/-- A regularized maximizer exists on the Birkhoff polytope. -/ +theorem exists_regularizedBetheMaximizer + {n : ℕ} (τ : ℝ) (A : Matrix (Fin n) (Fin n) ℝ) : + ∃ X, IsDoublyStochastic X ∧ + ∀ Y, IsDoublyStochastic Y → + regularizedBetheObjective τ A Y ≤ + regularizedBetheObjective τ A X := by + have hne : ({X : Matrix (Fin n) (Fin n) ℝ | + IsDoublyStochastic X} : Set _).Nonempty := by + let I : Matrix (Fin n) (Fin n) ℝ := fun i j ↦ if i = j then 1 else 0 + refine ⟨I, ?_⟩ + refine ⟨(fun i j ↦ by by_cases h : i = j <;> simp [I, h]), ?_, ?_⟩ + · intro i + simp [I] + · intro j + simp [I] + obtain ⟨X, hX, hmax⟩ := isCompact_doublyStochastic.exists_isMaxOn + hne (continuous_regularizedBetheObjective τ A).continuousOn + exact ⟨X, hX, fun Y hY ↦ hmax hY⟩ + +/-- Affine interpolation of two matrices. -/ +def matrixSegment + {n : Type*} (t : ℝ) (X Y : Matrix n n ℝ) : Matrix n n ℝ := + fun i j ↦ (1 - t) * X i j + t * Y i j + +theorem matrixSegment_doublyStochastic + {n : Type*} [Fintype n] + {t : ℝ} (ht₀ : 0 ≤ t) (ht₁ : t ≤ 1) + {X Y : Matrix n n ℝ} + (hX : IsDoublyStochastic X) (hY : IsDoublyStochastic Y) : + IsDoublyStochastic (matrixSegment t X Y) := by + refine ⟨?_, ?_, ?_⟩ + · intro i j + exact add_nonneg + (mul_nonneg (sub_nonneg.mpr ht₁) (hX.nonnegative i j)) + (mul_nonneg ht₀ (hY.nonnegative i j)) + · intro i + simp_rw [matrixSegment, Finset.sum_add_distrib, + ← Finset.mul_sum, hX.row_sum, hY.row_sum] + ring + · intro j + simp_rw [matrixSegment, Finset.sum_add_distrib, + ← Finset.mul_sum, hX.col_sum, hY.col_sum] + ring + +theorem negMulLog_segment_gap_nonneg + {t x y : ℝ} (ht₀ : 0 ≤ t) (ht₁ : t ≤ 1) + (hx : 0 ≤ x) (hy : 0 ≤ y) : + 0 ≤ Real.negMulLog ((1 - t) * x + t * y) - + ((1 - t) * Real.negMulLog x + t * Real.negMulLog y) := by + have hconc := Real.concaveOn_negMulLog.2 hx hy + (sub_nonneg.mpr ht₁) ht₀ (by ring : (1 - t) + t = 1) + simpa [smul_eq_mul] using sub_nonneg.mpr hconc + +theorem negMulLog_segment_gap_zero + (t y : ℝ) : + Real.negMulLog ((1 - t) * 0 + t * y) - + ((1 - t) * Real.negMulLog 0 + t * Real.negMulLog y) = + y * Real.negMulLog t := by + rw [Real.negMulLog_zero] + simp only [mul_zero, zero_add] + rw [Real.negMulLog_mul] + ring + +/-- Quantitative entropy barrier at a zero coordinate. Besides ordinary +concavity, mixing with the uniform matrix gains one copy of +`negMulLog t / n` from the chosen zero entry. -/ +theorem totalRowEntropy_matrixSegment_uniform_bonus + {n : ℕ} (hn : 0 < n) + {X : Matrix (Fin n) (Fin n) ℝ} (hX : IsDoublyStochastic X) + {i₀ j₀ : Fin n} (hzero : X i₀ j₀ = 0) + {t : ℝ} (ht₀ : 0 ≤ t) (ht₁ : t ≤ 1) : + (1 - t) * totalRowEntropy X + + t * totalRowEntropy (uniformBirkhoff n) + + (1 / n) * Real.negMulLog t ≤ + totalRowEntropy (matrixSegment t X (uniformBirkhoff n)) := by + let gap : Fin n → Fin n → ℝ := fun i j ↦ + Real.negMulLog (matrixSegment t X (uniformBirkhoff n) i j) - + ((1 - t) * Real.negMulLog (X i j) + + t * Real.negMulLog (uniformBirkhoff n i j)) + have hgap : ∀ i j, 0 ≤ gap i j := by + intro i j + exact negMulLog_segment_gap_nonneg ht₀ ht₁ + (hX.nonnegative i j) + ((uniformBirkhoff_doublyStochastic hn).nonnegative i j) + have hspecial : gap i₀ j₀ = (1 / n) * Real.negMulLog t := by + dsimp [gap] + rw [matrixSegment, hzero] + calc + Real.negMulLog ((1 - t) * 0 + + t * uniformBirkhoff n i₀ j₀) - + ((1 - t) * Real.negMulLog 0 + + t * Real.negMulLog (uniformBirkhoff n i₀ j₀)) = + uniformBirkhoff n i₀ j₀ * Real.negMulLog t := + negMulLog_segment_gap_zero t (uniformBirkhoff n i₀ j₀) + _ = (1 / n) * Real.negMulLog t := by rfl + have hrow : gap i₀ j₀ ≤ ∑ j, gap i₀ j := + Finset.single_le_sum (fun j _ ↦ hgap i₀ j) (Finset.mem_univ j₀) + have hall : (∑ j, gap i₀ j) ≤ ∑ i, ∑ j, gap i j := + Finset.single_le_sum + (fun i _ ↦ Finset.sum_nonneg fun j _ ↦ hgap i j) + (Finset.mem_univ i₀) + rw [hspecial] at hrow + have hbonus := hrow.trans hall + simp_rw [gap, totalRowEntropy, shannonEntropy, + Finset.sum_sub_distrib, Finset.sum_add_distrib, + ← Finset.mul_sum] at hbonus ⊢ + simp_rw [matrixSegment] at hbonus ⊢ + linarith + +theorem negMulLog_exp_neg (K : ℝ) : + Real.negMulLog (Real.exp (-K)) = Real.exp (-K) * K := by + change -Real.exp (-K) * Real.log (Real.exp (-K)) = _ + rw [Real.log_exp] + ring + +/-- Concavity of the Bethe objective plus the quantitative entropy barrier +rules out every zero coordinate of a regularized maximizer. This proof +avoids coordinatewise asymptotic `O(t)` bookkeeping. -/ +theorem regularizedBetheMaximizer_positive + {n : ℕ} (hn : 1 < n) + {τ : ℝ} (hτ : 0 < τ) + {A X : Matrix (Fin n) (Fin n) ℝ} + (hA : Matrix.Positive A) + (hX : IsDoublyStochastic X) + (hmax : ∀ Y, IsDoublyStochastic Y → + regularizedBetheObjective τ A Y ≤ + regularizedBetheObjective τ A X) : + ∀ i j, 0 < X i j := by + have hn0 : 0 < n := by omega + let W := uniformBirkhoff n + have hW : IsDoublyStochastic W := uniformBirkhoff_doublyStochastic hn0 + intro i₀ j₀ + by_contra hnot + have hzero : X i₀ j₀ = 0 := + le_antisymm (le_of_not_gt hnot) (hX.nonnegative i₀ j₀) + let d := regularizedBetheObjective τ A X - + regularizedBetheObjective τ A W + let K := (n : ℝ) / τ * (|d| + 1) + let t := Real.exp (-K) + have hnR : (0 : ℝ) < n := by exact_mod_cast hn0 + have hK : 0 < K := by + dsimp [K] + exact mul_pos (div_pos hnR hτ) (by positivity) + have ht₀ : 0 < t := by + dsimp [t] + positivity + have ht₁ : t < 1 := by + dsimp [t] + simpa only [Real.exp_zero] using Real.exp_lt_exp.mpr (neg_neg_of_pos hK) + let Z := matrixSegment t X W + have hZ : IsDoublyStochastic Z := + matrixSegment_doublyStochastic ht₀.le ht₁.le hX hW + have hentropy : + (1 - t) * totalRowEntropy X + t * totalRowEntropy W + + (1 / n) * Real.negMulLog t ≤ totalRowEntropy Z := by + exact totalRowEntropy_matrixSegment_uniform_bonus hn0 hX hzero + ht₀.le ht₁.le + have hbeta : + (1 - t) * betheObjective A X + t * betheObjective A W ≤ + betheObjective A Z := by + have hc := betheObjective_segment_lower + (ι := Fin n) (by simpa using hn) A X W hX hW ht₀.le ht₁.le + have hseg : betheMatrixSegment t X W = Z := by + ext i j + simp [Z, matrixSegment, betheMatrixSegment, probabilitySegment] + rw [← hseg] + exact hc + have hscale : + τ * ((1 / n) * Real.negMulLog t) = t * (|d| + 1) := by + rw [show Real.negMulLog t = t * K by + simpa [t] using negMulLog_exp_neg K] + dsimp [K] + field_simp [hτ.ne', hnR.ne'] + have hgain : + 0 < t * (regularizedBetheObjective τ A W - + regularizedBetheObjective τ A X) + + τ * ((1 / n) * Real.negMulLog t) := by + rw [hscale] + have hd : regularizedBetheObjective τ A X - + regularizedBetheObjective τ A W = d := by rfl + have habs : d ≤ |d| := le_abs_self d + rw [← hd] at habs + have hbracket : 0 < + (regularizedBetheObjective τ A W - + regularizedBetheObjective τ A X) + (|d| + 1) := by + linarith + nlinarith [mul_pos ht₀ hbracket] + have hbetter : regularizedBetheObjective τ A X < + regularizedBetheObjective τ A Z := by + have hentropyτ := mul_le_mul_of_nonneg_left hentropy hτ.le + rw [regularizedBetheObjective, regularizedBetheObjective] at hgain + rw [regularizedBetheObjective, regularizedBetheObjective] + nlinarith + exact (not_lt_of_ge (hmax Z hZ)) hbetter + +theorem regularizedBetheMaximizer_interior + {n : ℕ} (hn : 1 < n) + {τ : ℝ} (hτ : 0 < τ) + {A X : Matrix (Fin n) (Fin n) ℝ} + (hA : Matrix.Positive A) + (hX : IsDoublyStochastic X) + (hmax : ∀ Y, IsDoublyStochastic Y → + regularizedBetheObjective τ A Y ≤ + regularizedBetheObjective τ A X) : + ∀ i, IsInteriorProbabilityVector (X i) := by + have hpos := regularizedBetheMaximizer_positive hn hτ hA hX hmax + intro i + exact ⟨hX.row_probability i, fun j ↦ + ⟨hpos i j, + hX.entry_lt_one_of_positive hpos (by simpa using hn) i j⟩⟩ + +/-- Coordinate derivative of the regularized Bethe objective. -/ +noncomputable def regularizedBetheGradient + {n : Type*} (τ : ℝ) (A X : Matrix n n ℝ) (i j : n) : ℝ := + Real.log (A i j) - (1 + τ) * Real.log (X i j) - + Real.log (1 - X i j) - (2 + τ) + +theorem hasDerivAt_regularizedBetheCoordinate + {τ a x : ℝ} (hx₀ : x ≠ 0) (hx₁ : 1 - x ≠ 0) : + HasDerivAt (regularizedBetheCoordinate τ a) + (Real.log a - (1 + τ) * Real.log x - + Real.log (1 - x) - (2 + τ)) x := by + have hlinear : HasDerivAt (fun y : ℝ ↦ y * Real.log a) + (Real.log a) x := by + convert! (hasDerivAt_id x).mul_const (Real.log a) using 1 <;> simp + have hentropy : HasDerivAt + (fun y : ℝ ↦ (1 + τ) * Real.negMulLog y) + ((1 + τ) * (-Real.log x - 1)) x := by + convert! (Real.hasDerivAt_negMulLog hx₀).const_mul (1 + τ) using 1 + have hcomplementInner : HasDerivAt (fun y : ℝ ↦ 1 - y) (-1) x := by + convert! (hasDerivAt_neg' x).const_add 1 using 1 + have hcomplement : HasDerivAt + (fun y : ℝ ↦ Real.negMulLog (1 - y)) + ((-Real.log (1 - x) - 1) * (-1)) x := by + convert! (Real.hasDerivAt_negMulLog hx₁).comp x hcomplementInner using 1 + rw [show regularizedBetheCoordinate τ a = fun y ↦ + y * Real.log a + (1 + τ) * Real.negMulLog y - + Real.negMulLog (1 - y) by + funext y + exact regularizedBetheCoordinate_eq_continuousForm τ a y] + convert! (hlinear.add hentropy).sub hcomplement using 1 <;> ring + +/-- An affine perturbation in a matrix direction. -/ +def linearMatrixPerturb + {n : Type*} (X D : Matrix n n ℝ) (t : ℝ) : Matrix n n ℝ := + fun i j ↦ X i j + t * D i j + +theorem hasDerivAt_regularizedBetheObjective_line + {n : Type*} [Fintype n] + {τ : ℝ} {A X D : Matrix n n ℝ} + (hXint : ∀ i, IsInteriorProbabilityVector (X i)) : + HasDerivAt + (fun t ↦ regularizedBetheObjective τ A + (linearMatrixPerturb X D t)) + (∑ i, ∑ j, regularizedBetheGradient τ A X i j * D i j) 0 := by + rw [show (fun t ↦ regularizedBetheObjective τ A + (linearMatrixPerturb X D t)) = fun t ↦ + ∑ i, ∑ j, regularizedBetheCoordinate τ (A i j) + (linearMatrixPerturb X D t i j) by + funext t + exact regularizedBetheObjective_eq_sum_coordinates τ A _] + apply HasDerivAt.fun_sum + intro i _ + apply HasDerivAt.fun_sum + intro j _ + have hcoord := hasDerivAt_regularizedBetheCoordinate (τ := τ) (a := A i j) + ((hXint i).2 j).1.ne' + (sub_pos.mpr ((hXint i).2 j).2).ne' + have hinner : HasDerivAt (fun t : ℝ ↦ X i j + t * D i j) + (D i j) 0 := by + convert! (hasDerivAt_const (0 : ℝ) (X i j)).add + ((hasDerivAt_id (0 : ℝ)).mul_const (D i j)) using 1 <;> simp + have hcoord' : HasDerivAt (regularizedBetheCoordinate τ (A i j)) + (Real.log (A i j) - (1 + τ) * Real.log (X i j) - + Real.log (1 - X i j) - (2 + τ)) + ((fun t : ℝ ↦ X i j + t * D i j) 0) := by + convert! hcoord using 1 <;> simp + convert! hcoord'.comp 0 hinner using 1 <;> + simp [linearMatrixPerturb, regularizedBetheGradient] <;> ring + +/-- A strictly positive finite matrix remains nonnegative under all +sufficiently small affine perturbations. -/ +theorem eventually_linearMatrixPerturb_nonnegative + {n : Type*} [Fintype n] + {X D : Matrix n n ℝ} (hXpos : ∀ i j, 0 < X i j) : + ∀ᶠ t in 𝓝 (0 : ℝ), Matrix.Nonnegative (linearMatrixPerturb X D t) := by + classical + have hone : ∀ p : n × n, + ∀ᶠ t in 𝓝 (0 : ℝ), 0 < linearMatrixPerturb X D t p.1 p.2 := by + intro p + have hcont : ContinuousAt + (fun t : ℝ ↦ linearMatrixPerturb X D t p.1 p.2) 0 := by + simp only [linearMatrixPerturb] + fun_prop + exact hcont.tendsto.eventually (Ioi_mem_nhds (by + simpa [linearMatrixPerturb] using hXpos p.1 p.2)) + have hfin : ∀ s : Finset (n × n), + ∀ᶠ t in 𝓝 (0 : ℝ), ∀ p ∈ s, + 0 < linearMatrixPerturb X D t p.1 p.2 := by + intro s + induction s using Finset.induction_on with + | empty => simp + | @insert p s hp ih => + filter_upwards [hone p, ih] with t hpt hst + intro q hq + rw [Finset.mem_insert] at hq + rcases hq with rfl | hq + · exact hpt + · exact hst q hq + filter_upwards [hfin Finset.univ] with t ht i j + exact (ht (i, j) (Finset.mem_univ _)).le + +theorem linearMatrixPerturb_doublyStochastic + {n : Type*} [Fintype n] + {X D : Matrix n n ℝ} {t : ℝ} + (hX : IsDoublyStochastic X) + (hDrow : ∀ i, ∑ j, D i j = 0) + (hDcol : ∀ j, ∑ i, D i j = 0) + (hnonneg : Matrix.Nonnegative (linearMatrixPerturb X D t)) : + IsDoublyStochastic (linearMatrixPerturb X D t) := by + refine ⟨hnonneg, ?_, ?_⟩ + · intro i + simp_rw [linearMatrixPerturb, Finset.sum_add_distrib, ← Finset.mul_sum, + hX.row_sum, hDrow] + ring + · intro j + simp_rw [linearMatrixPerturb, Finset.sum_add_distrib, ← Finset.mul_sum, + hX.col_sum, hDcol] + ring + +/-- First-order optimality on the tangent space of the Birkhoff polytope. -/ +theorem regularizedBetheMaximizer_tangent_orthogonal + {n : Type*} [Fintype n] + {τ : ℝ} {A X D : Matrix n n ℝ} + (hX : IsDoublyStochastic X) + (hXint : ∀ i, IsInteriorProbabilityVector (X i)) + (hmax : ∀ Y, IsDoublyStochastic Y → + regularizedBetheObjective τ A Y ≤ + regularizedBetheObjective τ A X) + (hDrow : ∀ i, ∑ j, D i j = 0) + (hDcol : ∀ j, ∑ i, D i j = 0) : + ∑ i, ∑ j, regularizedBetheGradient τ A X i j * D i j = 0 := by + have hXpos : ∀ i j, 0 < X i j := fun i j ↦ (hXint i).2 j |>.1 + have hfeasible : ∀ᶠ t in 𝓝 (0 : ℝ), + IsDoublyStochastic (linearMatrixPerturb X D t) := + (eventually_linearMatrixPerturb_nonnegative hXpos).mono fun _ ht ↦ + linearMatrixPerturb_doublyStochastic hX hDrow hDcol ht + have hlocal : IsLocalMax + (fun t ↦ regularizedBetheObjective τ A + (linearMatrixPerturb X D t)) 0 := + hfeasible.mono fun t ht ↦ by + have hzeroPerturb : linearMatrixPerturb X D 0 = X := by + ext i j + simp [linearMatrixPerturb] + change regularizedBetheObjective τ A (linearMatrixPerturb X D t) ≤ + regularizedBetheObjective τ A (linearMatrixPerturb X D 0) + rw [hzeroPerturb] + exact hmax _ ht + exact hlocal.hasDerivAt_eq_zero + (hasDerivAt_regularizedBetheObjective_line hXint) + +/-- Signed difference of two coordinate atoms. -/ +def signedPair + {ι : Type*} [DecidableEq ι] (a b : ι) (x : ι) : ℝ := + (if a = x then 1 else 0) - (if b = x then 1 else 0) + +theorem sum_signedPair + {ι : Type*} [Fintype ι] [DecidableEq ι] + {a b : ι} (hab : a ≠ b) : + ∑ x, signedPair a b x = 0 := by + simp [signedPair, Finset.sum_sub_distrib] + +theorem sum_signedPair_mul + {ι : Type*} [Fintype ι] [DecidableEq ι] + {a b : ι} (hab : a ≠ b) (q : ι → ℝ) : + ∑ x, signedPair a b x * q x = q a - q b := by + simp [signedPair, sub_mul, Finset.sum_sub_distrib] + +/-- The elementary four-cycle direction in the tangent space of the +Birkhoff polytope. -/ +def rectangleDirection + {ι : Type*} [DecidableEq ι] + (i k j l : ι) : Matrix ι ι ℝ := + fun a b ↦ signedPair i k a * signedPair j l b + +theorem rectangleDirection_row_sum + {ι : Type*} [Fintype ι] [DecidableEq ι] + {i k j l : ι} (hjl : j ≠ l) : + ∀ a, ∑ b, rectangleDirection i k j l a b = 0 := by + intro a + rw [show (∑ b, rectangleDirection i k j l a b) = + signedPair i k a * ∑ b, signedPair j l b by + simp_rw [rectangleDirection, Finset.mul_sum]] + rw [sum_signedPair hjl, mul_zero] + +theorem rectangleDirection_col_sum + {ι : Type*} [Fintype ι] [DecidableEq ι] + {i k j l : ι} (hik : i ≠ k) : + ∀ b, ∑ a, rectangleDirection i k j l a b = 0 := by + intro b + rw [show (∑ a, rectangleDirection i k j l a b) = + (∑ a, signedPair i k a) * signedPair j l b by + simp_rw [rectangleDirection, Finset.sum_mul]] + rw [sum_signedPair hik, zero_mul] + +theorem sum_mul_rectangleDirection + {ι : Type*} [Fintype ι] [DecidableEq ι] + (G : Matrix ι ι ℝ) {i k j l : ι} + (hik : i ≠ k) (hjl : j ≠ l) : + (∑ a, ∑ b, G a b * rectangleDirection i k j l a b) = + G i j - G i l - G k j + G k l := by + have hinner : ∀ a, + (∑ b, G a b * rectangleDirection i k j l a b) = + signedPair i k a * (G a j - G a l) := by + intro a + calc + (∑ b, G a b * rectangleDirection i k j l a b) = + signedPair i k a * + ∑ b, signedPair j l b * G a b := by + simp_rw [rectangleDirection] + rw [Finset.mul_sum] + apply Finset.sum_congr rfl + intro b _ + ring + _ = signedPair i k a * (G a j - G a l) := by + rw [sum_signedPair_mul hjl] + simp_rw [hinner] + rw [sum_signedPair_mul hik] + ring + +/-- The gradient at an interior maximizer has vanishing alternating sum on +every four-cycle. -/ +theorem regularizedGradient_rectangle_identity + {ι : Type*} [Fintype ι] [DecidableEq ι] + {τ : ℝ} {A X : Matrix ι ι ℝ} + (hX : IsDoublyStochastic X) + (hXint : ∀ i, IsInteriorProbabilityVector (X i)) + (hmax : ∀ Y, IsDoublyStochastic Y → + regularizedBetheObjective τ A Y ≤ + regularizedBetheObjective τ A X) + {i k j l : ι} (hik : i ≠ k) (hjl : j ≠ l) : + regularizedBetheGradient τ A X i j - + regularizedBetheGradient τ A X i l - + regularizedBetheGradient τ A X k j + + regularizedBetheGradient τ A X k l = 0 := by + have htangent := regularizedBetheMaximizer_tangent_orthogonal + hX hXint hmax + (rectangleDirection_row_sum hjl) + (rectangleDirection_col_sum hik) + rw [sum_mul_rectangleDirection _ hik hjl] at htangent + exact htangent + +/-- Any matrix with zero alternating sum on every rectangle is a sum of a +row potential and a column potential. -/ +theorem exists_rowColumnPotentials_of_rectangle_identity + {ι : Type*} [Fintype ι] [DecidableEq ι] [Nonempty ι] + (G : Matrix ι ι ℝ) + (hrect : ∀ {i k j l : ι}, i ≠ k → j ≠ l → + G i j - G i l - G k j + G k l = 0) : + ∃ r c : ι → ℝ, ∀ i j, G i j = r i + c j := by + let i₀ : ι := Classical.choice inferInstance + let j₀ : ι := Classical.choice inferInstance + let r : ι → ℝ := fun i ↦ G i j₀ + let c : ι → ℝ := fun j ↦ G i₀ j - G i₀ j₀ + refine ⟨r, c, ?_⟩ + intro i j + by_cases hi : i = i₀ + · subst i + simp [r, c] + by_cases hj : j = j₀ + · subst j + simp [r, c] + have h := hrect hi hj + dsimp [r, c] + linarith + +/-- The logarithmic KKT factorization in paper Lemma 14. -/ +theorem exists_logKKT_of_regularizedBetheMaximizer + {ι : Type*} [Fintype ι] [DecidableEq ι] [Nonempty ι] + {τ : ℝ} {A X : Matrix ι ι ℝ} + (hX : IsDoublyStochastic X) + (hXint : ∀ i, IsInteriorProbabilityVector (X i)) + (hmax : ∀ Y, IsDoublyStochastic Y → + regularizedBetheObjective τ A Y ≤ + regularizedBetheObjective τ A X) : + ∃ r c : ι → ℝ, HasLogKKT τ A X r c := by + obtain ⟨R, C, hRC⟩ := exists_rowColumnPotentials_of_rectangle_identity + (fun i j ↦ regularizedBetheGradient τ A X i j) + (fun hik hjl ↦ regularizedGradient_rectangle_identity + hX hXint hmax hik hjl) + let r : ι → ℝ := fun i ↦ R i + (2 + τ) + refine ⟨r, C, ?_⟩ + intro i j + have h := hRC i j + dsimp [regularizedBetheGradient, r] at h ⊢ + linarith + +theorem positiveMatrix_hasPerfectMatching + {ι : Type*} [Fintype ι] [DecidableEq ι] + {A : Matrix ι ι ℝ} (hA : Matrix.Positive A) : + Matrix.HasPerfectMatching A := by + refine ⟨Equiv.refl ι, ?_⟩ + intro i + exact (hA i i).ne' + +/-- A regularized maximizer is within the entropy-regularization budget of +the variational Bethe value. This proof uses the supremum definition and +does not assume that a separate unregularized maximizer has already been +chosen. -/ +theorem betheLogValue_le_regularizedMaximizer + {n : ℕ} (hn : 1 < n) + {τ : ℝ} (hτ : 0 ≤ τ) + {A X : Matrix (Fin n) (Fin n) ℝ} + (hA : Matrix.Positive A) + (hX : IsDoublyStochastic X) + (hmax : ∀ Y, IsDoublyStochastic Y → + regularizedBetheObjective τ A Y ≤ + regularizedBetheObjective τ A X) : + betheLogValue A ≤ betheObjective A X + + τ * (n * Real.log n) := by + let W := uniformBirkhoff n + have hn0 : 0 < n := by omega + letI : Nonempty (Fin n) := Fin.pos_iff_nonempty.mp hn0 + have hW : IsDoublyStochastic W := uniformBirkhoff_doublyStochastic hn0 + have hsetNonempty : + ({v : ℝ | ∃ Y, BetheAdmissible A Y ∧ + betheObjective A Y = v} : Set ℝ).Nonempty := by + refine ⟨betheObjective A W, W, ?_, rfl⟩ + exact ⟨hW, fun i j hzero ↦ False.elim ((hA i j).ne' hzero)⟩ + rw [betheLogValue] + apply csSup_le hsetNonempty + intro v hv + obtain ⟨Y, hY, rfl⟩ := hv + have hnear := regularized_near_bethe hτ A X Y hX hY.1 (hmax Y hY.1) + simpa using hnear + +/-- Every feasible value is bounded above by the variational Bethe value. +For positive matrices the support condition in `BetheAdmissible` is +automatic. Compactness supplies a finite upper bound for the supremum. -/ +theorem betheObjective_le_betheLogValue_of_positive + {n : ℕ} {A X : Matrix (Fin n) (Fin n) ℝ} + (hA : Matrix.Positive A) (hX : IsDoublyStochastic X) : + betheObjective A X ≤ betheLogValue A := by + obtain ⟨M, hM, hmax⟩ := exists_regularizedBetheMaximizer 0 A + have hmax' : ∀ Y, IsDoublyStochastic Y → + betheObjective A Y ≤ betheObjective A M := by + intro Y hY + simpa [regularizedBetheObjective] using hmax Y hY + have hbdd : BddAbove + {v : ℝ | ∃ Y, BetheAdmissible A Y ∧ betheObjective A Y = v} := by + refine ⟨betheObjective A M, ?_⟩ + rintro v ⟨Y, hY, rfl⟩ + exact hmax' Y hY.1 + rw [betheLogValue] + apply le_csSup hbdd + exact ⟨X, ⟨hX, fun i j hzero ↦ False.elim ((hA i j).ne' hzero)⟩, rfl⟩ + +/-- The regularized objective gap at an arbitrary feasible comparison point +is at most its unregularized Bethe suboptimality plus the entropy budget. +This is the optimization input used in the global transfer estimate. -/ +theorem regularizedDifference_le_betheSuboptimality_add_budget + {n : ℕ} (hn : 0 < n) {τ ξ : ℝ} (hτ : 0 ≤ τ) + (hbudget : τ * (n * Real.log n) ≤ ξ * n) + {A X P : Matrix (Fin n) (Fin n) ℝ} + (hA : Matrix.Positive A) + (hX : IsDoublyStochastic X) (hP : IsDoublyStochastic P) : + regularizedBetheObjective τ A X - + regularizedBetheObjective τ A P ≤ + betheSuboptimality (betheLogValue A) (betheObjective A P) + ξ * n := by + letI : Nonempty (Fin n) := Fin.pos_iff_nonempty.mp hn + have hbethe := betheObjective_le_betheLogValue_of_positive hA hX + have hHX : totalRowEntropy X ≤ n * Real.log n := by + simpa using totalRowEntropy_le hX + have hHP : 0 ≤ totalRowEntropy P := totalRowEntropy_nonneg hP + have hτHX := mul_le_mul_of_nonneg_left hHX hτ + have hτHP : 0 ≤ τ * totalRowEntropy P := mul_nonneg hτ hHP + rw [regularizedBetheObjective, regularizedBetheObjective, + betheSuboptimality] + linarith + +/-- Paper Lemma 14, in the form consumed by the later transfer argument. +Existence, interiority, near-optimality, and the logarithmic KKT equations are +all proved; the only imported hypothesis is Vontobel's concavity theorem. -/ +theorem exists_regularizedOptimizer_with_logKKT + {n : ℕ} (hn : 1 < n) + {τ ξ : ℝ} (hτ : 0 < τ) + (hregularization : τ * (n * Real.log n) ≤ ξ * n) + (A : Matrix (Fin n) (Fin n) ℝ) (hA : Matrix.Positive A) : + ∃ X : Matrix (Fin n) (Fin n) ℝ, + IsDoublyStochastic X ∧ + (∀ i, IsInteriorProbabilityVector (X i)) ∧ + (∀ Y, IsDoublyStochastic Y → + regularizedBetheObjective τ A Y ≤ + regularizedBetheObjective τ A X) ∧ + (∃ r c : Fin n → ℝ, HasLogKKT τ A X r c) ∧ + Real.log (bethePermanent A) - ξ * n ≤ betheObjective A X := by + have hn0 : 0 < n := by omega + letI : Nonempty (Fin n) := Fin.pos_iff_nonempty.mp hn0 + obtain ⟨X, hX, hmax⟩ := exists_regularizedBetheMaximizer τ A + have hXint := regularizedBetheMaximizer_interior hn hτ hA hX hmax + obtain ⟨r, c, hKKT⟩ := + exists_logKKT_of_regularizedBetheMaximizer hX hXint hmax + have hvalue := betheLogValue_le_regularizedMaximizer + hn hτ.le hA hX hmax + have hmatch := positiveMatrix_hasPerfectMatching hA + have hlog : Real.log (bethePermanent A) = betheLogValue A := by + rw [bethePermanent, if_pos hmatch, Real.log_exp] + refine ⟨X, hX, hXint, hmax, ⟨r, c, hKKT⟩, ?_⟩ + rw [hlog] + nlinarith + +theorem regularization_budget_of_paper_scale + {n : ℕ} {ell ξ τ : ℝ} + (hell : 0 < ell) + (hlogn : Real.log n ≤ ell * Real.log 2) + (hξ : 0 < ξ) (hτ : τ = ξ / (4 * ell)) : + τ * (n * Real.log n) ≤ ξ * n := by + have hτpos : 0 < τ := by rw [hτ]; positivity + have hlog2 : Real.log 2 ≤ 1 := by + have := Real.log_le_sub_one_of_pos (by norm_num : (0 : ℝ) < 2) + norm_num at this ⊢ + exact this + have hτlog : τ * Real.log n ≤ ξ := by + calc + τ * Real.log n ≤ τ * (ell * Real.log 2) := + mul_le_mul_of_nonneg_left hlogn hτpos.le + _ = ξ * Real.log 2 / 4 := by + rw [hτ] + field_simp [hell.ne'] + _ ≤ ξ := by + have := mul_le_mul_of_nonneg_left hlog2 hξ.le + nlinarith + calc + τ * (n * Real.log n) = n * (τ * Real.log n) := by ring + _ ≤ n * ξ := mul_le_mul_of_nonneg_left hτlog (Nat.cast_nonneg n) + _ = ξ * n := by ring + +theorem exists_regularizedOptimizer_at_paper_scale + {n : ℕ} (hn : 1 < n) + {ell ξ τ : ℝ} (hell : 0 < ell) + (hlogn : Real.log n ≤ ell * Real.log 2) + (hξ : 0 < ξ) (hτ : τ = ξ / (4 * ell)) + (A : Matrix (Fin n) (Fin n) ℝ) (hA : Matrix.Positive A) : + ∃ X : Matrix (Fin n) (Fin n) ℝ, + IsDoublyStochastic X ∧ + (∀ i, IsInteriorProbabilityVector (X i)) ∧ + (∀ Y, IsDoublyStochastic Y → + regularizedBetheObjective τ A Y ≤ + regularizedBetheObjective τ A X) ∧ + (∃ r c : Fin n → ℝ, HasLogKKT τ A X r c) ∧ + Real.log (bethePermanent A) - ξ * n ≤ betheObjective A X := by + have hτpos : 0 < τ := by rw [hτ]; positivity + exact exists_regularizedOptimizer_with_logKKT hn hτpos + (regularization_budget_of_paper_scale hell hlogn hξ hτ) A hA +end +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/OptimizerOutputEncoding.lean b/LeanPool/BeyondBethe/BeyondBethe/OptimizerOutputEncoding.lean new file mode 100644 index 0000000000..31f0480282 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/OptimizerOutputEncoding.lean @@ -0,0 +1,39 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.AlgorithmicSpec + +/-! +# Canonical finite-word encoding of optimizer output + +This dependency-light module fixes the typed optimizer output and its exact +right-nested binary encoding. It is shared by both the optimizer producer +and the certificate consumer, so neither side depends on the other's +correctness theorem. +-/ + +namespace BeyondBethe + +open Complexity + +/-- Rational data returned by a normalized regularized-Bethe optimizer. -/ +structure RationalOptimizerOutput (n : ℕ) where + matrix : Matrix (Fin n) (Fin n) ℚ + rowPotential : Fin n → ℚ + columnPotential : Fin n → ℚ + +/-- Canonical right-nested list encoding of a rational vector. -/ +def rationalVectorBinaryCode {n : ℕ} (v : Fin n → ℚ) : List Bool := + binaryListCode rationalEntryBinaryCode (List.ofFn v) + +/-- Canonical optimizer-output word: matrix, then row and column potentials. -/ +def rationalOptimizerOutputCode {n : ℕ} + (out : RationalOptimizerOutput n) : List Bool := + pair (rationalMatrixBinaryEncoding.encode ⟨n, out.matrix⟩) + (pair (rationalVectorBinaryCode out.rowPotential) + (rationalVectorBinaryCode out.columnPotential)) + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/PairFactorization.lean b/LeanPool/BeyondBethe/BeyondBethe/PairFactorization.lean new file mode 100644 index 0000000000..4a3e29b52e --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/PairFactorization.lean @@ -0,0 +1,223 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.CapacityScaling +import LeanPool.BeyondBethe.BeyondBethe.ClusterCertificate +import LeanPool.BeyondBethe.BeyondBethe.Gain +import LeanPool.BeyondBethe.BeyondBethe.TransferIdentity +import Mathlib.Tactic + +/-! # Pair Factorization -/ + +open scoped BigOperators + +namespace BeyondBethe + +open MvPolynomial + +/-- Multiplicative form of the KKT equations (paper (35)). -/ +def HasMultiplicativeKKT + {ι : Type*} [Fintype ι] + (τ : ℝ) (A X : Matrix ι ι ℝ) (r c : ι → ℝ) : Prop := + ∀ i j, A i j = r i * c j * (X i j) ^ (1 + τ) * (1 - X i j) + +theorem hasMultiplicativeKKT_of_logKKT + {ι : Type*} [Fintype ι] + {τ : ℝ} {A X : Matrix ι ι ℝ} {R C : ι → ℝ} + (hApos : ∀ i j, 0 < A i j) + (hXint : ∀ i, IsInteriorProbabilityVector (X i)) + (hKKT : HasLogKKT τ A X R C) : + HasMultiplicativeKKT τ A X (fun i ↦ Real.exp (R i)) + (fun j ↦ Real.exp (C j)) := by + intro i j + have hx : 0 < X i j := (hXint i).2 j |>.1 + have hcomp : 0 < 1 - X i j := sub_pos.mpr ((hXint i).2 j |>.2) + calc + A i j = Real.exp (Real.log (A i j)) := + (Real.exp_log (hApos i j)).symm + _ = Real.exp (R i + C j + + (1 + τ) * Real.log (X i j) + Real.log (1 - X i j)) := by + rw [hKKT i j] + _ = Real.exp (R i) * Real.exp (C j) * + (X i j) ^ (1 + τ) * (1 - X i j) := by + rw [Real.exp_add, Real.exp_add, Real.exp_add, + Real.rpow_def_of_pos hx, Real.exp_log hcomp] + ring + +theorem multiplicativeKKT_eq_row_column_transfer + {ι : Type*} [Fintype ι] [DecidableEq ι] + {τ : ℝ} {A X : Matrix ι ι ℝ} {r c : ι → ℝ} + (hXint : ∀ i, IsInteriorProbabilityVector (X i)) + (hKKT : HasMultiplicativeKKT τ A X r c) (i j : ι) : + A i j = r i * complementProduct (X i) * c j * + transferU τ (X i) j := by + rw [hKKT i j, transferU_eq_div_complementProduct (hXint i) j] + field_simp [ne_of_gt (complementProduct_pos (hXint i))] + +theorem pairPolynomial_eval_of_row_column_scaling + {ι : Type*} [Fintype ι] [DecidableEq ι] + {a b u v c z : ι → ℝ} {R S : ℝ} + (ha : ∀ j, a j = R * c j * u j) + (hb : ∀ j, b j = S * c j * v j) : + (pairPolynomial a b).eval z = + (R * S) * (pairPolynomial u v).eval (fun j ↦ c j * z j) := by + rw [pairPolynomial_eval, pairPolynomial_eval] + rw [Finset.mul_sum] + apply Finset.sum_congr rfl + intro e _ + rw [ha e.1, hb e.2] + ring + +theorem pairPolynomial_capacity_of_row_column_scaling + {ι : Type*} [Fintype ι] [DecidableEq ι] + {a b u v c α : ι → ℝ} {R S : ℝ} + (ha0 : ∀ j, 0 ≤ a j) (hb0 : ∀ j, 0 ≤ b j) + (hu0 : ∀ j, 0 ≤ u j) (hv0 : ∀ j, 0 ≤ v j) + (hR : 0 < R) (hS : 0 < S) (hc : ∀ j, 0 < c j) + (ha : ∀ j, a j = R * c j * u j) + (hb : ∀ j, b j = S * c j * v j) : + polynomialCapacity α (pairPolynomial a b) = + ((R * S) * realMonomial c α) * + polynomialCapacity α (pairPolynomial u v) := by + apply polynomialCapacity_eq_of_positive_diagonal_rescaling + (pairPolynomial_nonnegativeCoefficients ha0 hb0) + (pairPolynomial_nonnegativeCoefficients hu0 hv0) + (mul_pos hR hS) hc + intro z + exact pairPolynomial_eval_of_row_column_scaling (z := z) ha hb + +theorem singletonCoordinate_factorization + {a x r c τ : ℝ} + (hx : 0 < x) (hx1 : x < 1) (hr : 0 < r) (hc : 0 < c) + (ha : a = r * c * x ^ (1 + τ) * (1 - x)) : + (a / x) ^ x * (1 - x) ^ (1 - x) = + r ^ x * c ^ x * x ^ (τ * x) * (1 - x) := by + have hcomp : 0 < 1 - x := sub_pos.mpr hx1 + have hAx : a / x = r * c * x ^ τ * (1 - x) := by + rw [ha, Real.rpow_add hx 1 τ, Real.rpow_one] + field_simp [hx.ne'] + rw [hAx] + rw [Real.mul_rpow (mul_nonneg + (mul_nonneg hr.le hc.le) (Real.rpow_nonneg hx.le τ)) hcomp.le] + rw [Real.mul_rpow (mul_nonneg hr.le hc.le) + (Real.rpow_nonneg hx.le τ)] + rw [Real.mul_rpow hr.le hc.le] + rw [← Real.rpow_mul hx.le τ x] + have hcompPow : (1 - x) ^ x * (1 - x) ^ (1 - x) = 1 - x := by + rw [← Real.rpow_add hcomp x (1 - x)] + convert Real.rpow_one (1 - x) using 2 <;> ring + calc + r ^ x * c ^ x * x ^ (τ * x) * (1 - x) ^ x * + (1 - x) ^ (1 - x) = + (r ^ x * c ^ x * x ^ (τ * x)) * + ((1 - x) ^ x * (1 - x) ^ (1 - x)) := by ring + _ = r ^ x * c ^ x * x ^ (τ * x) * (1 - x) := by + rw [hcompPow] + +/-- Paper (44), stated first for the explicit singleton product `S_i`. -/ +theorem singletonProductValue_factorized_of_multiplicativeKKT + {n : ℕ} {τ : ℝ} {A X : Matrix (Fin n) (Fin n) ℝ} + {r c : Fin n → ℝ} + (hX : IsDoublyStochastic X) + (hXint : ∀ i, IsInteriorProbabilityVector (X i)) + (hr : ∀ i, 0 < r i) (hc : ∀ j, 0 < c j) + (hKKT : HasMultiplicativeKKT τ A X r c) (i : Fin n) : + singletonProductValue A X i = + r i * complementProduct (X i) * rowZeta τ (X i) * + realMonomial c (X i) := by + rw [singletonProductValue, rowZeta, complementProduct, realMonomial] + simp_rw [singletonCoordinate_factorization + ((hXint i).2 _ |>.1) ((hXint i).2 _ |>.2) (hr i) (hc _) + (hKKT i _)] + have hrprod : (∏ j, (r i) ^ (X i j)) = r i := by + rw [← Real.rpow_sum_of_pos (hr i), hX.row_sum i, Real.rpow_one] + rw [show (∏ j, ((r i) ^ (X i j) * (c j) ^ (X i j) * + (X i j) ^ (τ * X i j) * (1 - X i j))) = + (∏ j, (r i) ^ (X i j)) * (∏ j, (c j) ^ (X i j)) * + (∏ j, (X i j) ^ (τ * X i j)) * + ∏ j, (1 - X i j) by + simp only [← Finset.prod_mul_distrib] + ] + rw [hrprod] + ring + +theorem realMonomial_pairAlpha + {ι : Type*} [Fintype ι] + (c : ι → ℝ) (hc : ∀ j, 0 < c j) + (X : Matrix ι ι ℝ) (r s : ι) : + realMonomial c (pairAlpha X r s) = + realMonomial c (X r) * realMonomial c (X s) := by + rw [realMonomial, realMonomial, realMonomial, + ← Finset.prod_mul_distrib] + apply Finset.prod_congr rfl + intro j _ + exact Real.rpow_add (hc j) (X r j) (X s j) + +/-- The gain ratio `Gamma_rs` from paper (10), using the explicit singleton +products from paper (7). -/ +noncomputable def pairGain + {n : ℕ} (A X : Matrix (Fin n) (Fin n) ℝ) (r s : Fin n) : ℝ := + pairCertificateValue A X r s / + (singletonProductValue A X r * singletonProductValue A X s) + +/-- Paper Lemma 18. Every KKT scaling and every capacity change of variables +is canceled explicitly. -/ +theorem pairGain_factorization + {n : ℕ} {τ : ℝ} {A X : Matrix (Fin n) (Fin n) ℝ} + {rscale cscale : Fin n → ℝ} + (hApos : ∀ i j, 0 < A i j) + (hX : IsDoublyStochastic X) + (hXint : ∀ i, IsInteriorProbabilityVector (X i)) + (hr : ∀ i, 0 < rscale i) (hc : ∀ j, 0 < cscale j) + (hKKT : HasMultiplicativeKKT τ A X rscale cscale) + (r s : Fin n) : + pairGain A X r s = + 1 / (rowZeta τ (X r) * rowZeta τ (X s)) * + (∏ j, (1 - pairAlpha X r s j) ^ + (1 - pairAlpha X r s j)) * + polynomialCapacity (pairAlpha X r s) + (pairPolynomial (fun j ↦ transferU τ (X r) j) + (fun j ↦ transferU τ (X s) j)) := by + let qr := complementProduct (X r) + let qs := complementProduct (X s) + let Ur : Fin n → ℝ := fun j ↦ transferU τ (X r) j + let Us : Fin n → ℝ := fun j ↦ transferU τ (X s) j + have hqr : 0 < qr := complementProduct_pos (hXint r) + have hqs : 0 < qs := complementProduct_pos (hXint s) + have hUr : ∀ j, 0 < Ur j := fun j ↦ transferU_pos (hXint r) j + have hUs : ∀ j, 0 < Us j := fun j ↦ transferU_pos (hXint s) j + have hAr : ∀ j, A r j = (rscale r * qr) * cscale j * Ur j := by + intro j + simpa only [qr, Ur, mul_assoc] using + multiplicativeKKT_eq_row_column_transfer hXint hKKT r j + have hAs : ∀ j, A s j = (rscale s * qs) * cscale j * Us j := by + intro j + simpa only [qs, Us, mul_assoc] using + multiplicativeKKT_eq_row_column_transfer hXint hKKT s j + have hcap := pairPolynomial_capacity_of_row_column_scaling + (α := pairAlpha X r s) + (fun j ↦ (hApos r j).le) (fun j ↦ (hApos s j).le) + (fun j ↦ (hUr j).le) (fun j ↦ (hUs j).le) + (mul_pos (hr r) hqr) (mul_pos (hr s) hqs) hc hAr hAs + have hSr := singletonProductValue_factorized_of_multiplicativeKKT + hX hXint hr hc hKKT r + have hSs := singletonProductValue_factorized_of_multiplicativeKKT + hX hXint hr hc hKKT s + have hcAlpha := realMonomial_pairAlpha cscale hc X r s + have hzetaR : 0 < rowZeta τ (X r) := + rowZeta_pos (fun j ↦ (hXint r).2 j |>.1) + have hzetaS : 0 < rowZeta τ (X s) := + rowZeta_pos (fun j ↦ (hXint s).2 j |>.1) + have hcR : 0 < realMonomial cscale (X r) := + realMonomial_pos hc (X r) + have hcS : 0 < realMonomial cscale (X s) := + realMonomial_pos hc (X s) + rw [pairGain, pairCertificateValue, hcap, hSr, hSs, hcAlpha] + dsimp only [qr, qs, Ur, Us] at * + field_simp [ne_of_gt (hr r), ne_of_gt (hr s), hqr.ne', hqs.ne', + hzetaR.ne', hzetaS.ne', hcR.ne', hcS.ne'] + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/PairStability.lean b/LeanPool/BeyondBethe/BeyondBethe/PairStability.lean new file mode 100644 index 0000000000..f211f3c98f --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/PairStability.lean @@ -0,0 +1,290 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.PairedCertificate + +/-! # Pair Stability -/ + +open scoped BigOperators ComplexConjugate + +namespace BeyondBethe + +open MvPolynomial + +noncomputable def positiveLinearPolynomial + {ι : Type*} [Fintype ι] [DecidableEq ι] + (u : ι → ℝ) : MvPolynomial ι ℝ := + ∑ j, monomial (Finsupp.single j 1) (u j) + +theorem positiveLinearPolynomial_nonnegativeCoefficients + {ι : Type*} [Fintype ι] [DecidableEq ι] + {u : ι → ℝ} (hu : ∀ i, 0 ≤ u i) : + HasNonnegativeCoefficients (positiveLinearPolynomial u) := by + intro d + rw [positiveLinearPolynomial, coeff_sum] + apply Finset.sum_nonneg + intro i _ + rw [coeff_monomial] + split + · exact hu i + · exact le_rfl + +theorem positiveLinearPolynomial_isRealStable + {ι : Type*} [Fintype ι] [DecidableEq ι] [Nonempty ι] + {u : ι → ℝ} (hu : ∀ i, 0 < u i) : + IsRealStable (positiveLinearPolynomial u) := by + intro z hz + rw [positiveLinearPolynomial, eval₂_sum] + simp only [eval₂_monomial, RingHom.id_apply, + Finsupp.prod_single_index, pow_one, one_mul] + have him : 0 < ∑ i, u i * (z i).im := + Finset.sum_pos (fun i _ ↦ mul_pos (hu i) (hz i)) + Finset.univ_nonempty + intro heq + have hzero := congrArg Complex.im heq + simp at hzero + linarith + +noncomputable def realDot + {ι : Type*} [Fintype ι] (a x : ι → ℝ) : ℝ := + ∑ i, a i * x i + +noncomputable def pairQuadraticForm + {ι : Type*} [Fintype ι] (u v x : ι → ℝ) : ℝ := + realDot u x * realDot v x - ∑ i, u i * v i * x i ^ 2 + +noncomputable def pairBilinearForm + {ι : Type*} [Fintype ι] (u v x y : ι → ℝ) : ℝ := + realDot u x * realDot v y + realDot u y * realDot v x - + 2 * ∑ i, u i * v i * x i * y i + +theorem realDot_mul_realDot + {ι : Type*} [Fintype ι] + (a b x y : ι → ℝ) : + realDot a x * realDot b y = + ∑ i, ∑ j, a i * b j * x i * y j := by + simp only [realDot] + rw [Finset.mul_sum] + simp_rw [Finset.sum_mul] + rw [Finset.sum_comm] + apply Finset.sum_congr rfl + intro i _ + apply Finset.sum_congr rfl + intro j _ + ring + +theorem sum_offDiag_eq_sum_product_sub_diag + {ι : Type*} [Fintype ι] [DecidableEq ι] + (f : ι × ι → ℝ) : + (∑ e ∈ (Finset.univ : Finset ι).offDiag, f e) = + (∑ i, ∑ j, f (i, j)) - ∑ i, f (i, i) := by + have hunion : + (∑ e ∈ (Finset.univ : Finset ι).diag ∪ Finset.univ.offDiag, f e) = + (∑ e ∈ (Finset.univ : Finset ι).diag, f e) + + ∑ e ∈ (Finset.univ : Finset ι).offDiag, f e := + Finset.sum_union + (Finset.disjoint_diag_offDiag (Finset.univ : Finset ι)) + rw [Finset.diag_union_offDiag, Finset.sum_diag, + Finset.sum_product] at hunion + linarith + +theorem pairQuadraticForm_eq_offDiag + {ι : Type*} [Fintype ι] [DecidableEq ι] + (u v x : ι → ℝ) : + pairQuadraticForm u v x = + ∑ e ∈ (Finset.univ : Finset ι).offDiag, + u e.1 * v e.2 * x e.1 * x e.2 := by + rw [sum_offDiag_eq_sum_product_sub_diag] + simp only [pairQuadraticForm] + rw [realDot_mul_realDot] + apply congrArg₂ (· - ·) rfl + apply Finset.sum_congr rfl + intro i _ + ring + +theorem pairBilinearForm_eq_offDiag + {ι : Type*} [Fintype ι] [DecidableEq ι] + (u v x y : ι → ℝ) : + pairBilinearForm u v x y = + ∑ e ∈ (Finset.univ : Finset ι).offDiag, + u e.1 * v e.2 * (x e.1 * y e.2 + y e.1 * x e.2) := by + rw [sum_offDiag_eq_sum_product_sub_diag] + simp only [pairBilinearForm] + rw [realDot_mul_realDot, realDot_mul_realDot] + simp_rw [mul_add, Finset.sum_add_distrib] + have hdiag : (∑ i, u i * v i * (y i * x i)) = + ∑ i, u i * v i * (x i * y i) := by + apply Finset.sum_congr rfl + intro i _ + ring + rw [hdiag] + ring + +theorem pairPolynomial_eval_eq_quadraticForm + {ι : Type*} [Fintype ι] [DecidableEq ι] + (u v x : ι → ℝ) : + (pairPolynomial u v).eval x = pairQuadraticForm u v x := by + rw [pairPolynomial_eval, pairQuadraticForm_eq_offDiag] + +theorem pairPolynomial_eval₂_complex + {ι : Type*} [Fintype ι] [DecidableEq ι] + (u v : ι → ℝ) (z : ι → ℂ) : + (pairPolynomial u v).eval₂ (algebraMap ℝ ℂ) z = + ∑ e ∈ (Finset.univ : Finset ι).offDiag, + ((u e.1 * v e.2 : ℝ) : ℂ) * z e.1 * z e.2 := by + rw [pairPolynomial, eval₂_sum] + apply Finset.sum_congr rfl + intro e _ + rw [eval₂_monomial] + rw [Finsupp.prod_add_index] + · simp [Finsupp.prod_single_index, mul_assoc, mul_left_comm, mul_comm] + · simp + · intro a _ b c + exact pow_add (z a) b c + +theorem pairPolynomial_eval₂_complex_re + {ι : Type*} [Fintype ι] [DecidableEq ι] + (u v : ι → ℝ) (z : ι → ℂ) : + ((pairPolynomial u v).eval₂ (algebraMap ℝ ℂ) z).re = + pairQuadraticForm u v (fun i ↦ (z i).re) - + pairQuadraticForm u v (fun i ↦ (z i).im) := by + rw [pairPolynomial_eval₂_complex] + simp + rw [pairQuadraticForm_eq_offDiag, pairQuadraticForm_eq_offDiag] + +theorem pairPolynomial_eval₂_complex_im + {ι : Type*} [Fintype ι] [DecidableEq ι] + (u v : ι → ℝ) (z : ι → ℂ) : + ((pairPolynomial u v).eval₂ (algebraMap ℝ ℂ) z).im = + pairBilinearForm u v (fun i ↦ (z i).re) (fun i ↦ (z i).im) := by + rw [pairPolynomial_eval₂_complex] + simp + rw [pairBilinearForm_eq_offDiag] + ring + +theorem realDot_sub_mul + {ι : Type*} [Fintype ι] + (u x y : ι → ℝ) (t : ℝ) : + realDot u (fun i ↦ x i - t * y i) = + realDot u x - t * realDot u y := by + simp only [realDot, mul_sub] + rw [Finset.sum_sub_distrib, Finset.mul_sum] + apply congrArg₂ (· - ·) rfl + apply Finset.sum_congr rfl + intro i _ + ring + +theorem pairQuadraticForm_sub_mul + {ι : Type*} [Fintype ι] + (u v x y : ι → ℝ) (t : ℝ) : + pairQuadraticForm u v (fun i ↦ x i - t * y i) = + pairQuadraticForm u v x - t * pairBilinearForm u v x y + + t ^ 2 * pairQuadraticForm u v y := by + have hdiag : + (∑ i, u i * v i * (x i - t * y i) ^ 2) = + (∑ i, u i * v i * x i ^ 2) - + 2 * t * (∑ i, u i * v i * x i * y i) + + t ^ 2 * (∑ i, u i * v i * y i ^ 2) := by + calc + (∑ i, u i * v i * (x i - t * y i) ^ 2) = + ∑ i, (u i * v i * x i ^ 2 - + 2 * t * (u i * v i * x i * y i) + + t ^ 2 * (u i * v i * y i ^ 2)) := by + apply Finset.sum_congr rfl + intro i _ + ring + _ = (∑ i, u i * v i * x i ^ 2) - + 2 * t * (∑ i, u i * v i * x i * y i) + + t ^ 2 * (∑ i, u i * v i * y i ^ 2) := by + simp_rw [Finset.sum_add_distrib, Finset.sum_sub_distrib, + Finset.mul_sum] + simp only [pairQuadraticForm, pairBilinearForm, realDot_sub_mul, hdiag] + ring + +theorem pairQuadraticForm_pos + {ι : Type*} [Fintype ι] [DecidableEq ι] + {u v y : ι → ℝ} (hcard : 2 ≤ Fintype.card ι) + (hu : ∀ i, 0 < u i) (hv : ∀ i, 0 < v i) + (hy : ∀ i, 0 < y i) : + 0 < pairQuadraticForm u v y := by + rw [pairQuadraticForm_eq_offDiag] + apply Finset.sum_pos + · intro e he + exact mul_pos (mul_pos (mul_pos (hu e.1) (hv e.2)) (hy e.1)) (hy e.2) + · obtain ⟨i, j, hij⟩ := Fintype.one_lt_card_iff.mp (by omega : + 1 < Fintype.card ι) + exact ⟨(i, j), by simp [hij]⟩ + +/-- The quadratic form of the pair polynomial is nonpositive on the +bilinear-orthogonal complement of any positive direction. This is the +at-most-one-positive-direction argument needed in the stability proof; it +uses the hyperplane `dot(u,x)=0`, on which the form is visibly nonpositive. -/ +theorem pairQuadraticForm_nonpos_of_bilinear_zero + {ι : Type*} [Fintype ι] [Nonempty ι] + {u v x y : ι → ℝ} + (hu : ∀ i, 0 < u i) (hv : ∀ i, 0 < v i) + (hy : ∀ i, 0 < y i) + (hypos : 0 < pairQuadraticForm u v y) + (horth : pairBilinearForm u v x y = 0) : + pairQuadraticForm u v x ≤ 0 := by + let uy := realDot u y + have huy : 0 < uy := by + dsimp [uy] + rw [realDot] + exact Finset.sum_pos (fun i _ ↦ mul_pos (hu i) (hy i)) + Finset.univ_nonempty + let t := realDot u x / uy + let z : ι → ℝ := fun i ↦ x i - t * y i + have huz : realDot u z = 0 := by + change realDot u (fun i ↦ x i - t * y i) = 0 + rw [realDot_sub_mul] + dsimp [t] + rw [div_mul_cancel₀ _ (ne_of_gt huy)] + ring + have hznonpos : pairQuadraticForm u v z ≤ 0 := by + rw [pairQuadraticForm, huz, zero_mul, zero_sub] + exact neg_nonpos.mpr (Finset.sum_nonneg fun i _ ↦ + mul_nonneg (mul_nonneg (le_of_lt (hu i)) (le_of_lt (hv i))) + (sq_nonneg (z i))) + have hshift : pairQuadraticForm u v z = + pairQuadraticForm u v x + t ^ 2 * pairQuadraticForm u v y := by + change pairQuadraticForm u v (fun i ↦ x i - t * y i) = _ + rw [pairQuadraticForm_sub_mul, horth] + ring + have hgain : 0 ≤ t ^ 2 * pairQuadraticForm u v y := + mul_nonneg (sq_nonneg t) (le_of_lt hypos) + linarith + +/-- The pair polynomial is real stable for positive row weights as soon as +there are at least two variables. This closes the quadratic-stability step +for the polynomial used in the paper without importing an eigenvalue or +inertia theorem: the hyperplane orthogonal to `u` already witnesses that the +quadratic form has at most one positive direction. -/ +theorem pairPolynomial_isRealStable_of_pos + {ι : Type*} [Fintype ι] [DecidableEq ι] + {u v : ι → ℝ} (hcard : 2 ≤ Fintype.card ι) + (hu : ∀ i, 0 < u i) (hv : ∀ i, 0 < v i) : + IsRealStable (pairPolynomial u v) := by + letI : Nonempty ι := Fintype.card_pos_iff.mp (by omega) + intro z hz hzero + let x : ι → ℝ := fun i ↦ (z i).re + let y : ι → ℝ := fun i ↦ (z i).im + have hypos : 0 < pairQuadraticForm u v y := + pairQuadraticForm_pos hcard hu hv (fun i ↦ hz i) + have hre : pairQuadraticForm u v x - pairQuadraticForm u v y = 0 := by + have h := congrArg Complex.re hzero + rw [pairPolynomial_eval₂_complex_re] at h + simpa [x, y] using h + have him : pairBilinearForm u v x y = 0 := by + have h := congrArg Complex.im hzero + rw [pairPolynomial_eval₂_complex_im] at h + simpa [x, y] using h + have hxnonpos : pairQuadraticForm u v x ≤ 0 := + pairQuadraticForm_nonpos_of_bilinear_zero hu hv (fun i ↦ hz i) + hypos him + linarith + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/PairedCertificate.lean b/LeanPool/BeyondBethe/BeyondBethe/PairedCertificate.lean new file mode 100644 index 0000000000..0cea285a39 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/PairedCertificate.lean @@ -0,0 +1,483 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.Permanent +import LeanPool.BeyondBethe.BeyondBethe.Stable +import Mathlib.Tactic + +/-! # Paired Certificate -/ + +open scoped BigOperators + +namespace BeyondBethe + +open MvPolynomial + +/-- A partition of the row set into named clusters. The equivalence labels +each row by its cluster and its position inside that cluster. Pair +certificates use the special case in which every size is one or two, but the +coefficient identity below holds for arbitrary cluster sizes. -/ +structure RowClustering (n : ℕ) where + Cluster : Type + clusterFintype : Fintype Cluster + clusterDecidableEq : DecidableEq Cluster + size : Cluster → ℕ + rows : (Σ c, Fin (size c)) ≃ Fin n + +attribute [instance] RowClustering.clusterFintype +attribute [instance] RowClustering.clusterDecidableEq + +namespace RowClustering + +variable {n : ℕ} (C : RowClustering n) + +/-- The cluster containing a row. -/ +noncomputable def clusterOfRow (i : Fin n) : C.Cluster := + (C.rows.symm i).1 + +/-- The cluster selected at each column by a permutation in Mathlib's +column-to-row orientation. -/ +noncomputable def clusterAssignment (σ : Equiv.Perm (Fin n)) : + Fin n → C.Cluster := + fun j ↦ C.clusterOfRow (σ j) + +end RowClustering + +/-- Squarefree exponent vector selecting one cluster variable for each +column. -/ +noncomputable def selectorExponent + {κ ι : Type*} [Fintype κ] [DecidableEq κ] [Fintype ι] + (h : ι → κ) : κ × ι →₀ ℕ := + Finsupp.equivFunOnFinite.symm fun v ↦ if v.1 = h v.2 then 1 else 0 + +@[simp] +theorem selectorExponent_apply + {κ ι : Type*} [Fintype κ] [DecidableEq κ] [Fintype ι] + (h : ι → κ) (c : κ) (j : ι) : + selectorExponent h (c, j) = if c = h j then 1 else 0 := by + simp [selectorExponent] + +theorem selectorExponent_injective + {κ ι : Type*} [Fintype κ] [DecidableEq κ] [Fintype ι] + [DecidableEq ι] : + Function.Injective (selectorExponent : (ι → κ) → κ × ι →₀ ℕ) := by + intro h h' heq + funext j + have hj := congrArg (fun d : κ × ι →₀ ℕ ↦ d (h j, j)) heq + simp only [selectorExponent_apply, if_pos rfl] at hj + by_contra hne + simp [hne] at hj + +theorem selectorExponent_eq_sum_single + {κ ι : Type*} [Fintype κ] [DecidableEq κ] + [Fintype ι] [DecidableEq ι] (h : ι → κ) : + selectorExponent h = + ∑ j, Finsupp.single (h j, j) 1 := by + classical + ext ⟨c, j⟩ + simp [selectorExponent_apply, Finsupp.single_apply] + by_cases hc : c = h j + · subst c + have hs : ({x : ι | h x = h j ∧ x = j} : Finset ι) = {j} := by + ext x + simp only [Finset.mem_filter, Finset.mem_univ, true_and, + Finset.mem_singleton] + constructor + · intro hx + simpa using hx.2 + · intro hx + have hxj : x = j := by simpa using hx + subst x + simp + rw [hs] + simp + · have hs : ({x : ι | h x = c ∧ x = j} : Finset ι) = ∅ := by + ext x + simp only [Finset.mem_filter, Finset.mem_univ, true_and] + constructor + · intro hx + have hxj : x = j := hx.2 + subst x + exact (hc hx.1.symm).elim + · simp + rw [hs] + simp [hc] + +theorem selectorExponent_degree + {κ ι : Type*} [Fintype κ] [DecidableEq κ] + [Fintype ι] [DecidableEq ι] (h : ι → κ) : + Finsupp.degree (selectorExponent h) = Fintype.card ι := by + rw [selectorExponent_eq_sum_single, map_sum] + simp [Finsupp.degree_single] + +theorem monomial_selectorExponent + {κ ι : Type*} [Fintype κ] [DecidableEq κ] + [Fintype ι] [DecidableEq ι] (h : ι → κ) : + (monomial (selectorExponent h) 1 : MvPolynomial (κ × ι) ℝ) = + ∏ j, X (h j, j) := by + rw [selectorExponent_eq_sum_single, monomial_sum_one] + simp [← X_pow_eq_monomial] + +/-- The column-selector polynomial written in its monomial expansion. It is +the expansion of `prod_j (sum_C z_{Cj})`. -/ +noncomputable def columnSelector + (κ ι : Type*) [Fintype κ] [DecidableEq κ] + [Fintype ι] [DecidableEq ι] : MvPolynomial (κ × ι) ℝ := + ∑ h : ι → κ, monomial (selectorExponent h) 1 + +/-- The factored form of the column selector used for its stability proof. -/ +noncomputable def columnSelectorProduct + (κ ι : Type*) [Fintype κ] [DecidableEq κ] + [Fintype ι] [DecidableEq ι] : MvPolynomial (κ × ι) ℝ := + ∏ j : ι, ∑ c : κ, X (c, j) + +theorem columnSelector_eq_product + (κ ι : Type*) [Fintype κ] [DecidableEq κ] + [Fintype ι] [DecidableEq ι] : + columnSelector κ ι = columnSelectorProduct κ ι := by + rw [columnSelectorProduct, Fintype.prod_sum, columnSelector] + apply Finset.sum_congr rfl + intro h _ + exact monomial_selectorExponent h + +/-- The column selector is real stable: at an upper-half-plane input, each +column factor has strictly positive imaginary part. -/ +theorem columnSelector_isRealStable + (κ ι : Type*) [Fintype κ] [DecidableEq κ] [Nonempty κ] + [Fintype ι] [DecidableEq ι] : + IsRealStable (columnSelector κ ι) := by + rw [columnSelector_eq_product] + intro z hz + rw [columnSelectorProduct, MvPolynomial.eval₂_prod] + apply Finset.prod_ne_zero_iff.mpr + intro j _ + rw [MvPolynomial.eval₂_sum] + simp only [MvPolynomial.eval₂_X] + have him : 0 < ∑ c : κ, (z (c, j)).im := + Finset.sum_pos (fun c _ ↦ hz (c, j)) Finset.univ_nonempty + intro heq + have hzero := congrArg Complex.im heq + simp at hzero + linarith + +theorem columnSelector_nonnegativeCoefficients + (κ ι : Type*) [Fintype κ] [DecidableEq κ] + [Fintype ι] [DecidableEq ι] : + HasNonnegativeCoefficients (columnSelector κ ι) := by + intro d + rw [columnSelector, coeff_sum] + apply Finset.sum_nonneg + intro h _ + rw [coeff_monomial] + split <;> norm_num + +theorem columnSelector_isHomogeneous + (κ ι : Type*) [Fintype κ] [DecidableEq κ] + [Fintype ι] [DecidableEq ι] : + (columnSelector κ ι).IsHomogeneous (Fintype.card ι) := by + rw [columnSelector] + apply MvPolynomial.IsHomogeneous.sum + intro h _ + exact isHomogeneous_monomial 1 (selectorExponent_degree h) + +theorem columnSelector_isMultiaffine + (κ ι : Type*) [Fintype κ] [DecidableEq κ] + [Fintype ι] [DecidableEq ι] : + IsMultiaffine (columnSelector κ ι) := by + intro v + rw [columnSelector] + refine (degreeOf_sum_le v _ _).trans (Finset.sup_le ?_) + intro h _ + rw [degreeOf_monomial_eq _ _ one_ne_zero] + rcases v with ⟨c, j⟩ + rw [selectorExponent_apply] + split <;> simp + +theorem columnSelector_coeff_selectorExponent + {κ ι : Type*} [Fintype κ] [DecidableEq κ] + [Fintype ι] [DecidableEq ι] (h : ι → κ) : + (columnSelector κ ι).coeff (selectorExponent h) = 1 := by + rw [columnSelector, coeff_sum] + simp only [coeff_monomial] + have heq : ∀ h' : ι → κ, + (selectorExponent h' = selectorExponent h) ↔ h' = h := fun h' ↦ + (selectorExponent_injective.eq_iff) + simp_rw [heq] + rw [Finset.sum_ite_eq' Finset.univ h] + simp + +theorem columnSelector_support + (κ ι : Type*) [Fintype κ] [DecidableEq κ] + [Fintype ι] [DecidableEq ι] : + (columnSelector κ ι).support = + Finset.univ.image (selectorExponent : (ι → κ) → κ × ι →₀ ℕ) := by + ext d + constructor + · intro hd + rw [mem_support_iff, columnSelector, coeff_sum] at hd + simp only [coeff_monomial] at hd + obtain ⟨h, _, hh⟩ := Finset.exists_ne_zero_of_sum_ne_zero hd + by_cases heq : selectorExponent h = d + · exact Finset.mem_image.mpr ⟨h, Finset.mem_univ h, heq⟩ + · simp [heq] at hh + · intro hd + obtain ⟨h, _, rfl⟩ := Finset.mem_image.mp hd + rw [mem_support_iff, columnSelector_coeff_selectorExponent h] + norm_num +theorem coefficientInnerProduct_eq_sum_right_support_of_coeff_one + {σ : Type*} + (p q : MvPolynomial σ ℝ) + (hq : ∀ d ∈ q.support, q.coeff d = 1) : + coefficientInnerProduct p q = ∑ d ∈ q.support, p.coeff d := by + classical + rw [coefficientInnerProduct] + calc + (∑ d ∈ p.support.filter (· ∈ q.support), + p.coeff d * q.coeff d) = + ∑ d ∈ p.support.filter (· ∈ q.support), p.coeff d := by + apply Finset.sum_congr rfl + intro d hd + rw [hq d (Finset.mem_filter.mp hd).2, mul_one] + _ = ∑ d ∈ q.support, p.coeff d := by + apply Finset.sum_subset + · intro d hd + exact (Finset.mem_filter.mp hd).2 + · intro d hdq hdnot + by_contra hne + apply hdnot + exact Finset.mem_filter.mpr ⟨by + rwa [mem_support_iff], hdq⟩ + +/- Pairing with the column selector extracts exactly the coefficients whose +exponents choose one cluster for each column. -/ +theorem coefficientInnerProduct_columnSelector + {κ ι : Type*} [Fintype κ] [DecidableEq κ] + [Fintype ι] [DecidableEq ι] + (p : MvPolynomial (κ × ι) ℝ) : + coefficientInnerProduct p (columnSelector κ ι) = + ∑ h : ι → κ, p.coeff (selectorExponent h) := by + rw [coefficientInnerProduct_eq_sum_right_support_of_coeff_one] + · rw [columnSelector_support, + Finset.sum_image selectorExponent_injective.injOn] + · intro d hd + rw [columnSelector_support] at hd + obtain ⟨h, _, rfl⟩ := Finset.mem_image.mp hd + exact columnSelector_coeff_selectorExponent h + +/-- The cluster polynomial in expanded form. Permutations that differ only +inside a cluster contribute to the same monomial, so their weights add in its +coefficient exactly as in the paper's pair polynomial. -/ +noncomputable def expandedClusterPolynomial + {n : ℕ} (A : Matrix (Fin n) (Fin n) ℝ) (C : RowClustering n) : + MvPolynomial (C.Cluster × Fin n) ℝ := + ∑ σ : Equiv.Perm (Fin n), + monomial (selectorExponent (C.clusterAssignment σ)) + (∏ j, A (σ j) j) + +theorem expandedClusterPolynomial_support + {n : ℕ} (A : Matrix (Fin n) (Fin n) ℝ) (C : RowClustering n) + {d : C.Cluster × Fin n →₀ ℕ} + (hd : d ∈ (expandedClusterPolynomial A C).support) : + ∃ σ : Equiv.Perm (Fin n), + d = selectorExponent (C.clusterAssignment σ) := by + rw [mem_support_iff] at hd + rw [expandedClusterPolynomial, coeff_sum] at hd + simp only [coeff_monomial] at hd + obtain ⟨σ, _, hσ⟩ := Finset.exists_ne_zero_of_sum_ne_zero hd + by_cases heq : selectorExponent (C.clusterAssignment σ) = d + · exact ⟨σ, heq.symm⟩ + · simp [heq] at hσ + +theorem columnSelector_coeff_of_mem_expandedClusterPolynomial + {n : ℕ} (A : Matrix (Fin n) (Fin n) ℝ) (C : RowClustering n) + {d : C.Cluster × Fin n →₀ ℕ} + (hd : d ∈ (expandedClusterPolynomial A C).support) : + (columnSelector C.Cluster (Fin n)).coeff d = 1 := by + obtain ⟨σ, rfl⟩ := expandedClusterPolynomial_support A C hd + exact columnSelector_coeff_selectorExponent (C.clusterAssignment σ) + +theorem sum_coeff_expandedClusterPolynomial_eq_permanent + {n : ℕ} (A : Matrix (Fin n) (Fin n) ℝ) (C : RowClustering n) : + (∑ d ∈ (expandedClusterPolynomial A C).support, + (expandedClusterPolynomial A C).coeff d) = Matrix.permanent A := by + let one : C.Cluster × Fin n → ℝ := fun _ ↦ 1 + have hevalCoeffs : + (expandedClusterPolynomial A C).eval one = + ∑ d ∈ (expandedClusterPolynomial A C).support, + (expandedClusterPolynomial A C).coeff d := by + rw [eval_eq] + simp [one] + have hevalPerm : + (expandedClusterPolynomial A C).eval one = Matrix.permanent A := by + rw [expandedClusterPolynomial, eval_sum] + simp [eval_monomial, one, Matrix.permanent] + exact hevalCoeffs.symm.trans hevalPerm + +/- Paper equation (12): the same-monomial coefficient pairing of the +expanded cluster polynomial and the column selector is exactly the +permanent. This proof is purely finite and does not use real stability. -/ +theorem coefficientInnerProduct_cluster_selector_eq_permanent + {n : ℕ} (A : Matrix (Fin n) (Fin n) ℝ) (C : RowClustering n) : + coefficientInnerProduct (expandedClusterPolynomial A C) + (columnSelector C.Cluster (Fin n)) = Matrix.permanent A := by + let p := expandedClusterPolynomial A C + let q := columnSelector C.Cluster (Fin n) + change coefficientInnerProduct p q = Matrix.permanent A + rw [coefficientInnerProduct, Finset.sum_filter] + have hsum : (∑ d ∈ p.support, p.coeff d) = Matrix.permanent A := by + simpa only [p] using sum_coeff_expandedClusterPolynomial_eq_permanent A C + apply Eq.trans ?_ hsum + apply Finset.sum_congr rfl + intro d hd + have hcoeff : q.coeff d = 1 := + columnSelector_coeff_of_mem_expandedClusterPolynomial A C hd + have hmem : d ∈ q.support := by + rw [mem_support_iff, hcoeff] + norm_num + simp [hmem, hcoeff] + +/-- The two-row polynomial `Q_{rs}` from paper (9), written as a sum over +ordered off-diagonal pairs. The two orientations of `{j,k}` contribute the +two terms in its coefficient. -/ +noncomputable def pairPolynomial + {ι : Type*} [Fintype ι] [DecidableEq ι] + (u v : ι → ℝ) : MvPolynomial ι ℝ := + ∑ e ∈ (Finset.univ : Finset ι).offDiag, + monomial (Finsupp.single e.1 1 + Finsupp.single e.2 1) + (u e.1 * v e.2) + +theorem single_add_single_one_eq_iff + {ι : Type*} [DecidableEq ι] + {a b j k : ι} (hab : a ≠ b) (hjk : j ≠ k) : + Finsupp.single a 1 + Finsupp.single b 1 = + Finsupp.single j 1 + Finsupp.single k 1 ↔ + (a = j ∧ b = k) ∨ (a = k ∧ b = j) := by + rw [Finsupp.single_add_single_eq_single_add_single + (one_ne_zero : (1 : ℕ) ≠ 0) (one_ne_zero : (1 : ℕ) ≠ 0)] + simp [hab, hjk] + +/-- The coefficient of `z_j z_k` is the combined weight of the two internal +assignments, exactly as stated below paper (9). -/ +theorem pairPolynomial_coeff_two + {ι : Type*} [Fintype ι] [DecidableEq ι] + (u v : ι → ℝ) {j k : ι} (hjk : j ≠ k) : + (pairPolynomial u v).coeff + (Finsupp.single j 1 + Finsupp.single k 1) = + u j * v k + u k * v j := by + classical + rw [pairPolynomial, coeff_sum] + simp only [coeff_monomial] + have hjkMem : (j, k) ∈ (Finset.univ : Finset ι).offDiag := by + simp [hjk] + have hkjMem : (k, j) ∈ (Finset.univ : Finset ι).offDiag := by + simp [Ne.symm hjk] + calc + (∑ e ∈ (Finset.univ : Finset ι).offDiag, + if Finsupp.single e.1 1 + Finsupp.single e.2 1 = + Finsupp.single j 1 + Finsupp.single k 1 then + u e.1 * v e.2 else 0) = + ∑ e ∈ (Finset.univ : Finset ι).offDiag, + if e = (j, k) ∨ e = (k, j) then u e.1 * v e.2 else 0 := by + apply Finset.sum_congr rfl + intro e he + have heNe : e.1 ≠ e.2 := (Finset.mem_offDiag.mp he).2.2 + have hiff : + (Finsupp.single e.1 1 + Finsupp.single e.2 1 = + Finsupp.single j 1 + Finsupp.single k 1) ↔ + e = (j, k) ∨ e = (k, j) := by + rw [single_add_single_one_eq_iff heNe hjk] + simp only [Prod.ext_iff] + by_cases h : Finsupp.single e.1 1 + Finsupp.single e.2 1 = + Finsupp.single j 1 + Finsupp.single k 1 + · simp [h, hiff.mp h] + · have hnot : ¬(e = (j, k) ∨ e = (k, j)) := fun heq ↦ h (hiff.mpr heq) + simp [h, hnot] + _ = u j * v k + u k * v j := by + rw [← Finset.sum_filter, Finset.filter_or, + Finset.filter_eq' _ (j, k), Finset.filter_eq' _ (k, j)] + simp [hjkMem, hkjMem, hjk] + +/-- Evaluation of the pair polynomial in the ordered-pair form. -/ +theorem pairPolynomial_eval + {ι : Type*} [Fintype ι] [DecidableEq ι] + (u v z : ι → ℝ) : + (pairPolynomial u v).eval z = + ∑ e ∈ (Finset.univ : Finset ι).offDiag, + u e.1 * v e.2 * z e.1 * z e.2 := by + rw [pairPolynomial, eval_sum] + apply Finset.sum_congr rfl + intro e _ + rw [eval_monomial] + rw [Finsupp.prod_add_index] + · simp [Finsupp.prod_single_index, mul_assoc, mul_left_comm, mul_comm] + · simp + · intro a _ b c + exact pow_add (z a) b c + +theorem pairPolynomial_nonnegativeCoefficients + {ι : Type*} [Fintype ι] [DecidableEq ι] + {u v : ι → ℝ} (hu : ∀ i, 0 ≤ u i) (hv : ∀ i, 0 ≤ v i) : + HasNonnegativeCoefficients (pairPolynomial u v) := by + intro d + rw [pairPolynomial, coeff_sum] + apply Finset.sum_nonneg + intro e _ + rw [coeff_monomial] + split + · exact mul_nonneg (hu e.1) (hv e.2) + · exact le_rfl + +theorem pairPolynomial_isHomogeneous + {ι : Type*} [Fintype ι] [DecidableEq ι] + (u v : ι → ℝ) : + (pairPolynomial u v).IsHomogeneous 2 := by + rw [pairPolynomial] + apply MvPolynomial.IsHomogeneous.sum + intro e he + apply isHomogeneous_monomial + simp [map_add, Finsupp.degree_single] + +theorem pairPolynomial_isMultiaffine + {ι : Type*} [Fintype ι] [DecidableEq ι] + (u v : ι → ℝ) : + IsMultiaffine (pairPolynomial u v) := by + intro i + rw [pairPolynomial] + refine (degreeOf_sum_le i _ _).trans (Finset.sup_le ?_) + intro e he + have hne : e.1 ≠ e.2 := (Finset.mem_offDiag.mp he).2.2 + by_cases hc : u e.1 * v e.2 = 0 + · simp [hc] + · rw [degreeOf_monomial_eq _ _ hc] + by_cases hi : i = e.1 + · subst i + simp [Finsupp.single_apply, hne] + · by_cases hi' : i = e.2 + · subst i + simp [Finsupp.single_apply, hne, Ne.symm hne] + · simp [Finsupp.single_apply, hi, hi'] + +/-- The formal Hessian matrix of `Q(u,v)`: diagonal entries vanish because +the polynomial is multiaffine, while off-diagonal entries are the paired +coefficients. -/ +def pairHessian + {ι : Type*} [DecidableEq ι] (u v : ι → ℝ) : Matrix ι ι ℝ := + fun i j ↦ if i = j then 0 else u i * v j + v i * u j + +/-- Paper equation (11), the exact rank-two-minus-diagonal Hessian identity. -/ +theorem pairHessian_eq + {ι : Type*} [DecidableEq ι] (u v : ι → ℝ) : + pairHessian u v = + Matrix.vecMulVec u v + Matrix.vecMulVec v u - + 2 • Matrix.diagonal (fun i ↦ u i * v i) := by + ext i j + by_cases hij : i = j + · subst j + simp [pairHessian, Matrix.vecMulVec] + ring + · simp [pairHessian, Matrix.vecMulVec, Matrix.diagonal_apply, hij] + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/PalomarComplexity.lean b/LeanPool/BeyondBethe/BeyondBethe/PalomarComplexity.lean new file mode 100644 index 0000000000..58c4f04bef --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/PalomarComplexity.lean @@ -0,0 +1,149 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham + +/-! +# A source-stable statement of polynomial time for Palomar + +Palomar compares the declarations exported from `Challenge.lean` and +`Solution.lean`. A recursive definition written with equation syntax acquires +module-private auxiliary declarations, so copying Complexitylib's definition +of recursion on notation into a standalone challenge does not produce the +same exported declaration. This file gives an equivalent presentation using +the public recursor `List.rec`. It is therefore declaration-stable when copied +to the Mathlib-only challenge. + +The final theorem below embeds Complexitylib's Cobham class into this +presentation. Together with Complexitylib's formalized Cobham theorem, this +shows that membership still has its usual meaning: deterministic polynomial +time on finite bitstrings. +-/ + +namespace BeyondBethe.PalomarComplexity + +/-- Recursion on the bit notation of the first input, written directly with +`List.rec` so its declaration has no module-private equation compiler helper. -/ +def recNotation {n : ℕ} (g : (Fin n → List Bool) → List Bool) + (h₀ h₁ : (Fin (n + 2) → List Bool) → List Bool) + (x : List Bool) (v : Fin n → List Bool) : List Bool := + List.rec g + (fun b tail recurse parameters => + (bif b then h₁ else h₀) + (Fin.cons tail (Fin.cons (recurse parameters) parameters))) + x v + +@[simp] theorem recNotation_nil {n : ℕ} + (g : (Fin n → List Bool) → List Bool) + (h₀ h₁ : (Fin (n + 2) → List Bool) → List Bool) + (v : Fin n → List Bool) : + recNotation g h₀ h₁ [] v = g v := by + rfl + +@[simp] theorem recNotation_cons {n : ℕ} + (g : (Fin n → List Bool) → List Bool) + (h₀ h₁ : (Fin (n + 2) → List Bool) → List Bool) + (b : Bool) (tail : List Bool) (v : Fin n → List Bool) : + recNotation g h₀ h₁ (b :: tail) v = + (bif b then h₁ else h₀) + (Fin.cons tail (Fin.cons (recNotation g h₀ h₁ tail v) v)) := by + rfl + +/-- Cobham's algebra of polynomial-time bitstring functions, in a +source-stable presentation suitable for Palomar's challenge/solution +comparison. -/ +inductive Cobham : ∀ {n : ℕ}, ((Fin n → List Bool) → List Bool) → Prop + | proj {n : ℕ} (i : Fin n) : Cobham fun v => v i + | empty {n : ℕ} : Cobham fun _ : Fin n → List Bool => [] + | bit (b : Bool) : Cobham fun v : Fin 1 → List Bool => + b :: v ⟨0, Nat.zero_lt_succ 0⟩ + | smash : Cobham fun v : Fin 2 → List Bool => + Complexity.smash + (v ⟨0, Nat.zero_lt_succ 1⟩) + (v ⟨1, Nat.succ_lt_succ (Nat.zero_lt_succ 0)⟩) + | comp {m n : ℕ} {f : (Fin m → List Bool) → List Bool} + {gs : Fin m → (Fin n → List Bool) → List Bool} : + Cobham f → (∀ i, Cobham (gs i)) → + Cobham fun v => f fun i => gs i v + | boundedRec {n : ℕ} {g : (Fin n → List Bool) → List Bool} + {h₀ h₁ : (Fin (n + 2) → List Bool) → List Bool} + {j : (Fin (n + 1) → List Bool) → List Bool} : + Cobham g → Cobham h₀ → Cobham h₁ → Cobham j → + (∀ x v, (recNotation g h₀ h₁ x v).length ≤ + (j (Fin.cons x v)).length) → + Cobham fun v : Fin (n + 1) → List Bool => + recNotation g h₀ h₁ (v ⟨0, Nat.zero_lt_succ n⟩) (Fin.tail v) + +/-- The unary fragment of the source-stable Cobham algebra. -/ +def CobhamFP : Set (List Bool → List Bool) := + {f | Cobham fun v : Fin 1 → List Bool => + f (v ⟨0, Nat.zero_lt_succ 0⟩)} + +theorem recNotation_eq_complexity {n : ℕ} + (g : (Fin n → List Bool) → List Bool) + (h₀ h₁ : (Fin (n + 2) → List Bool) → List Bool) : + recNotation g h₀ h₁ = Complexity.recNotation g h₀ h₁ := by + funext x v + induction x with + | nil => rfl + | cons b tail ih => + simp only [recNotation_cons, Complexity.recNotation_cons, ih] + +/-- Complexitylib's standard Cobham class embeds into the source-stable +presentation. -/ +theorem of_complexity_cobham {n : ℕ} + {f : (Fin n → List Bool) → List Bool} + (hf : Complexity.Cobham f) : Cobham f := by + induction hf with + | proj i => exact .proj i + | empty => exact .empty + | bit b => exact .bit b + | smash => exact .smash + | comp hf hgs ihf ihgs => exact .comp ihf ihgs + | @boundedRec n g h₀ h₁ j hg hh₀ hh₁ hj hbound ihg ihh₀ ihh₁ ihj => + have hstable : Cobham fun v : Fin (n + 1) → List Bool => + recNotation g h₀ h₁ (v ⟨0, Nat.zero_lt_succ n⟩) (Fin.tail v) := by + refine .boundedRec ihg ihh₀ ihh₁ ihj ?_ + intro x v + simpa only [recNotation_eq_complexity] using hbound x v + simpa only [recNotation_eq_complexity] using hstable + +/-- The source-stable presentation also embeds back into Complexitylib's +standard Cobham class. -/ +theorem to_complexity_cobham {n : ℕ} + {f : (Fin n → List Bool) → List Bool} + (hf : Cobham f) : Complexity.Cobham f := by + induction hf with + | proj i => exact .proj i + | empty => exact .empty + | bit b => exact .bit b + | smash => exact .smash + | comp hf hgs ihf ihgs => exact .comp ihf ihgs + | @boundedRec n g h₀ h₁ j hg hh₀ hh₁ hj hbound ihg ihh₀ ihh₁ ihj => + have hstandard : Complexity.Cobham fun v : Fin (n + 1) → List Bool => + Complexity.recNotation g h₀ h₁ + (v ⟨0, Nat.zero_lt_succ n⟩) (Fin.tail v) := by + refine .boundedRec ihg ihh₀ ihh₁ ihj ?_ + intro x v + simpa only [recNotation_eq_complexity] using hbound x v + simpa only [recNotation_eq_complexity] using hstandard + +/-- Every polynomial-time function in Complexitylib's Cobham presentation +belongs to the source-stable presentation used in the Palomar statement. -/ +theorem cobhamFP_of_complexity {f : List Bool → List Bool} + (hf : f ∈ Complexity.CobhamFP) : f ∈ CobhamFP := + of_complexity_cobham hf + +/-- The Palomar-facing class is extensionally the usual Cobham class used by +Complexitylib. -/ +theorem cobhamFP_iff_complexity {f : List Bool → List Bool} : + f ∈ CobhamFP ↔ f ∈ Complexity.CobhamFP := by + constructor + · intro hf + exact to_complexity_cobham hf + · exact cobhamFP_of_complexity + +end BeyondBethe.PalomarComplexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/Permanent.lean b/LeanPool/BeyondBethe/BeyondBethe/Permanent.lean new file mode 100644 index 0000000000..90db828f0f --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/Permanent.lean @@ -0,0 +1,116 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import Mathlib.LinearAlgebra.Matrix.Permanent +import Mathlib.Data.Real.Basic +import Mathlib.Data.Rat.BigOperators + +/-! # Permanent -/ + +namespace Matrix + +/-- Entrywise nonnegativity. -/ +def Nonnegative {m n : Type*} {R : Type*} [Zero R] [LE R] + (A : Matrix m n R) : Prop := + ∀ i j, 0 ≤ A i j + +/-- The positive support of `A` has a perfect matching, in the orientation +used by Mathlib's definition of the permanent. -/ +def HasPerfectMatching {n : Type*} [Fintype n] [DecidableEq n] + {R : Type*} [Zero R] (A : Matrix n n R) : Prop := + ∃ σ : Equiv.Perm n, ∀ i, A (σ i) i ≠ 0 + +theorem permanent_fin_one {R : Type*} [CommSemiring R] + (A : Matrix (Fin 1) (Fin 1) R) : + permanent A = A 0 0 := by + simp + +theorem permanent_nonneg_real {n : Type*} [Fintype n] [DecidableEq n] + (A : Matrix n n ℝ) (hA : Nonnegative A) : + 0 ≤ permanent A := by + classical + rw [permanent] + exact Finset.sum_nonneg fun σ _ ↦ + Finset.prod_nonneg fun i _ ↦ hA (σ i) i + +theorem permanent_mono_real {n : Type*} [Fintype n] [DecidableEq n] + {A B : Matrix n n ℝ} (hA : Nonnegative A) + (hAB : ∀ i j, A i j ≤ B i j) : + permanent A ≤ permanent B := by + classical + rw [permanent, permanent] + apply Finset.sum_le_sum + intro σ _ + exact Finset.prod_le_prod (fun i _ ↦ hA (σ i) i) fun i _ ↦ hAB (σ i) i + +/-- Degree-`n` homogeneity under global scaling, as used when the algorithm +normalizes the largest matrix entry. -/ +theorem permanent_scale_real {n : Type*} [Fintype n] [DecidableEq n] + (A : Matrix n n ℝ) (c : ℝ) : + permanent (c • A) = c ^ Fintype.card n * permanent A := + permanent_smul A c + +/-- Casting a rational permanent to the reals is the same as first casting +the entries and then taking the real permanent. -/ +theorem cast_permanent_rat {n : Type*} [Fintype n] [DecidableEq n] + (A : Matrix n n ℚ) : + ((permanent A : ℚ) : ℝ) = permanent (fun i j ↦ (A i j : ℝ)) := by + classical + simp [permanent] + +theorem permanent_eq_zero_of_noPerfectMatching + {n : Type*} [Fintype n] [DecidableEq n] + {R : Type*} [CommSemiring R] (A : Matrix n n R) + (hA : ¬HasPerfectMatching A) : + permanent A = 0 := by + classical + rw [permanent] + apply Finset.sum_eq_zero + intro σ _ + have hzero : ∃ i, A (σ i) i = 0 := by + by_contra hnone + apply hA + refine ⟨σ, ?_⟩ + intro i hi + exact hnone ⟨i, hi⟩ + obtain ⟨i, hi⟩ := hzero + exact Finset.prod_eq_zero (Finset.mem_univ i) hi + +theorem permanent_pos_of_hasPerfectMatching + {n : Type*} [Fintype n] [DecidableEq n] + (A : Matrix n n ℝ) (hA : Nonnegative A) + (hmatch : HasPerfectMatching A) : + 0 < permanent A := by + classical + obtain ⟨σ, hσ⟩ := hmatch + rw [permanent] + apply Finset.sum_pos' + · exact fun τ _ ↦ Finset.prod_nonneg fun i _ ↦ hA (τ i) i + · refine ⟨σ, Finset.mem_univ σ, ?_⟩ + exact Finset.prod_pos fun i _ ↦ lt_of_le_of_ne (hA (σ i) i) (Ne.symm (hσ i)) + +/-- A perfect matching whose nonzero entries are at least `m` contributes at +least `m ^ |n|` to the permanent. -/ +theorem pow_card_le_permanent_of_hasPerfectMatching + {n : Type*} [Fintype n] [DecidableEq n] + (A : Matrix n n ℝ) {m : ℝ} (hm : 0 ≤ m) + (hA : Nonnegative A) + (hmin : ∀ i j, A i j ≠ 0 → m ≤ A i j) + (hmatch : HasPerfectMatching A) : + m ^ Fintype.card n ≤ permanent A := by + classical + obtain ⟨σ, hσ⟩ := hmatch + rw [permanent] + calc + m ^ Fintype.card n = ∏ _i : n, m := by simp + _ ≤ ∏ i : n, A (σ i) i := by + exact Finset.prod_le_prod (fun _ _ ↦ hm) fun i _ ↦ hmin (σ i) i (hσ i) + _ ≤ ∑ τ : Equiv.Perm n, ∏ i : n, A (τ i) i := by + exact Finset.single_le_sum + (fun τ _ ↦ Finset.prod_nonneg fun i _ ↦ hA (τ i) i) + (Finset.mem_univ σ) + +end Matrix diff --git a/LeanPool/BeyondBethe/BeyondBethe/RationalEllipsoid.lean b/LeanPool/BeyondBethe/BeyondBethe/RationalEllipsoid.lean new file mode 100644 index 0000000000..59c3e1e667 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/RationalEllipsoid.lean @@ -0,0 +1,1358 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import Mathlib.Algebra.Order.Chebyshev +import Mathlib.Analysis.SpecialFunctions.Log.Basic +import Mathlib.LinearAlgebra.Matrix.Determinant.Basic +import Mathlib.LinearAlgebra.Matrix.AbsoluteValue +import Mathlib.LinearAlgebra.Matrix.SchurComplement +import Mathlib.Tactic + +/-! # Rational Ellipsoid -/ + +open scoped BigOperators + +namespace BeyondBethe + +/-! +# A square-root-free rational ellipsoid update + +An ellipsoid is represented as the affine image of the Euclidean unit ball, +`c + B y`. Both `c` and `B` will be rational in the executable algorithm. +For a central cut with pulled-back normal `b = Bᵀ a`, the usual optimal +ellipsoid update normalizes `b` by its Euclidean norm and therefore introduces +a square root. We instead normalize by the rational quantity `sum |bᵢ|` and +take a smaller center step. The update is weaker, but it still contracts +volume by an inverse-polynomial factor and keeps all stored data rational. +-/ + +/-- Explicit dot product, used over both `ℚ` and `ℝ`. -/ +def finiteDot {d : ℕ} {R : Type*} [CommSemiring R] + (x y : Fin d → R) : R := + ∑ i, x i * y i + +/-- Squared Euclidean norm, expressed without a square root. -/ +def finiteNormSq {d : ℕ} {R : Type*} [CommSemiring R] + (x : Fin d → R) : R := + finiteDot x x + +/-- Rational normalization used for a cut direction. -/ +def cutL1Scale {d : ℕ} (b : Fin d → ℚ) : ℚ := + ∑ i, abs (b i) + +theorem finiteNormSq_nonneg {d : ℕ} (x : Fin d → ℝ) : + 0 ≤ finiteNormSq x := by + rw [finiteNormSq, finiteDot] + exact Finset.sum_nonneg fun i _ ↦ mul_self_nonneg (x i) + +theorem finiteNormSq_eq_zero_iff {d : ℕ} (x : Fin d → ℝ) : + finiteNormSq x = 0 ↔ x = 0 := by + rw [finiteNormSq, finiteDot, Finset.sum_mul_self_eq_zero_iff] + constructor + · intro h + ext i + simpa using h i (Finset.mem_univ i) + · intro h + subst x + simp + +theorem cutL1Scale_nonnegative {d : ℕ} (b : Fin d → ℚ) : + 0 ≤ cutL1Scale b := by + rw [cutL1Scale] + exact Finset.sum_nonneg fun i _ ↦ abs_nonneg (b i) + +theorem cutL1Scale_pos {d : ℕ} {b : Fin d → ℚ} (hb : b ≠ 0) : + 0 < cutL1Scale b := by + have hnonneg : 0 ≤ ∑ i, abs (b i) := + Finset.sum_nonneg fun i _ ↦ abs_nonneg (b i) + have hne : (∑ i, abs (b i)) ≠ 0 := by + intro hzero + apply hb + ext i + exact abs_eq_zero.mp + ((Finset.sum_eq_zero_iff_of_nonneg + (fun i (_hi : i ∈ Finset.univ) ↦ abs_nonneg (b i))).1 + hzero i (Finset.mem_univ i)) + rw [cutL1Scale] + exact lt_of_le_of_ne hnonneg (Ne.symm hne) + +/-- The Euclidean norm is at most the `ℓ1` norm. We state the squared form, +which is the one used by the rational update. -/ +theorem finiteNormSq_le_cutL1Scale_sq {d : ℕ} (b : Fin d → ℚ) : + finiteNormSq b ≤ cutL1Scale b ^ 2 := by + let S : ℚ := ∑ i, abs (b i) + have hi : ∀ i, abs (b i) ≤ S := by + intro i + exact Finset.single_le_sum (fun j _ ↦ abs_nonneg (b j)) + (Finset.mem_univ i) + calc + finiteNormSq b = ∑ i, (abs (b i)) ^ 2 := by + simp [finiteNormSq, finiteDot, sq] + _ ≤ ∑ i, abs (b i) * S := by + apply Finset.sum_le_sum + intro i _ + rw [sq] + exact mul_le_mul_of_nonneg_left (hi i) (abs_nonneg _) + _ = S ^ 2 := by simp [S, sq, Finset.sum_mul] + _ = cutL1Scale b ^ 2 := by rw [cutL1Scale] + +/-- Cauchy--Schwarz gives the converse comparison with a factor equal to the +dimension. -/ +theorem cutL1Scale_sq_le_card_mul_normSq {d : ℕ} (b : Fin d → ℚ) : + cutL1Scale b ^ 2 ≤ d * finiteNormSq b := by + rw [cutL1Scale, finiteNormSq, finiteDot] + simpa [sq, abs_mul_abs_self] using + (sq_sum_le_card_mul_sum_sq (s := Finset.univ) + (f := fun i ↦ abs (b i))) + +/-- Finite-dimensional Cauchy--Schwarz in the squared form needed below. -/ +theorem finiteDot_sq_le_normSq_mul_normSq {d : ℕ} + (x y : Fin d → ℝ) : + finiteDot x y ^ 2 ≤ finiteNormSq x * finiteNormSq y := by + simpa [finiteDot, finiteNormSq, sq, mul_comm] using + (Finset.sum_mul_sq_le_sq_mul_sq (s := Finset.univ) x y) + +theorem finiteDot_add_right {d : ℕ} (x y z : Fin d → ℝ) : + finiteDot x (fun i ↦ y i + z i) = finiteDot x y + finiteDot x z := by + simp [finiteDot, mul_add, Finset.sum_add_distrib] + +theorem finiteDot_smul_left {d : ℕ} (a : ℝ) (x y : Fin d → ℝ) : + finiteDot (fun i ↦ a * x i) y = a * finiteDot x y := by + rw [finiteDot, finiteDot] + calc + (∑ i, a * x i * y i) = ∑ i, a * (x i * y i) := by + apply Finset.sum_congr rfl + intro i _ + ring + _ = a * ∑ i, x i * y i := by rw [Finset.mul_sum] + +theorem finiteDot_smul_right {d : ℕ} (a : ℝ) (x y : Fin d → ℝ) : + finiteDot x (fun i ↦ a * y i) = a * finiteDot x y := by + rw [finiteDot, finiteDot] + calc + (∑ i, x i * (a * y i)) = ∑ i, a * (x i * y i) := by + apply Finset.sum_congr rfl + intro i _ + ring + _ = a * ∑ i, x i * y i := by rw [Finset.mul_sum] + +theorem finiteNormSq_smul {d : ℕ} (a : ℝ) (x : Fin d → ℝ) : + finiteNormSq (fun i ↦ a * x i) = a ^ 2 * finiteNormSq x := by + rw [finiteNormSq, finiteDot, finiteNormSq, finiteDot] + calc + (∑ i, a * x i * (a * x i)) = ∑ i, a ^ 2 * (x i * x i) := by + apply Finset.sum_congr rfl + intro i _ + ring + _ = a ^ 2 * ∑ i, x i * x i := by rw [Finset.mul_sum] + +theorem finiteNormSq_add {d : ℕ} (x y : Fin d → ℝ) : + finiteNormSq (fun i ↦ x i + y i) = + finiteNormSq x + 2 * finiteDot x y + finiteNormSq y := by + rw [finiteNormSq, finiteDot, finiteNormSq, finiteDot, + finiteDot] + calc + (∑ i, (x i + y i) * (x i + y i)) = + ∑ i, (x i * x i + (2 * (x i * y i) + y i * y i)) := by + apply Finset.sum_congr rfl + intro i _ + ring + _ = (∑ i, x i * x i) + + 2 * (∑ i, x i * y i) + ∑ i, y i * y i := by + simp only [Finset.sum_add_distrib, ← Finset.mul_sum] + ring + +/-- Center-step coefficient for dimension `d`. The update is used only for +positive dimensions. -/ +def rationalEllipsoidAlpha (d : ℕ) : ℚ := 1 / (4 * d ^ 2) + +/-- Expansion in directions orthogonal to the cut. -/ +def rationalEllipsoidPerpScale (d : ℕ) : ℚ := + 1 + 2 * rationalEllipsoidAlpha d ^ 2 + +/-- Contraction in the cut direction. -/ +def rationalEllipsoidParallelScale (d : ℕ) : ℚ := + 1 - rationalEllipsoidAlpha d / d + +theorem rationalEllipsoidAlpha_pos {d : ℕ} (hd : 0 < d) : + 0 < rationalEllipsoidAlpha d := by + rw [rationalEllipsoidAlpha] + positivity + +theorem rationalEllipsoidAlpha_le_quarter {d : ℕ} (hd : 0 < d) : + rationalEllipsoidAlpha d ≤ 1 / 4 := by + have hdq : (1 : ℚ) ≤ d := by exact_mod_cast hd + change (1 : ℚ) / (4 * (d : ℚ) ^ 2) ≤ 1 / 4 + rw [div_le_div_iff₀ (by positivity) (by norm_num)] + nlinarith [sq_nonneg ((d : ℚ) - 1)] + +theorem rationalEllipsoidParallelScale_pos {d : ℕ} (hd : 0 < d) : + 0 < rationalEllipsoidParallelScale d := by + have ha0 := rationalEllipsoidAlpha_pos hd + have ha1 := rationalEllipsoidAlpha_le_quarter hd + have hdq : (1 : ℚ) ≤ d := by exact_mod_cast hd + rw [rationalEllipsoidParallelScale] + have had : rationalEllipsoidAlpha d / d ≤ 1 / 4 := by + exact (div_le_iff₀ (by positivity : (0 : ℚ) < d)).2 + (by nlinarith) + linarith + +theorem rationalEllipsoidParallelScale_le_one (d : ℕ) : + rationalEllipsoidParallelScale d ≤ 1 := by + rw [rationalEllipsoidParallelScale] + by_cases hd : d = 0 + · simp [hd] + · have hdq : (0 : ℚ) < d := by exact_mod_cast (Nat.pos_of_ne_zero hd) + have : 0 ≤ rationalEllipsoidAlpha d / d := + (div_pos (rationalEllipsoidAlpha_pos (Nat.pos_of_ne_zero hd)) hdq).le + linarith + +theorem rationalEllipsoidParallelScale_ge_three_quarters + {d : ℕ} (hd : 0 < d) : + (3 / 4 : ℚ) ≤ rationalEllipsoidParallelScale d := by + have ha := rationalEllipsoidAlpha_le_quarter hd + have hdq : (1 : ℚ) ≤ d := by exact_mod_cast hd + have had : rationalEllipsoidAlpha d / d ≤ 1 / 4 := by + rw [div_le_iff₀ (by positivity : (0 : ℚ) < d)] + nlinarith + rw [rationalEllipsoidParallelScale] + linarith + +theorem rationalEllipsoidPerpScale_pos (d : ℕ) : + 0 < rationalEllipsoidPerpScale d := by + rw [rationalEllipsoidPerpScale] + positivity + +theorem rationalEllipsoidParallel_lt_perp {d : ℕ} (hd : 0 < d) : + rationalEllipsoidParallelScale d < rationalEllipsoidPerpScale d := by + have ha := rationalEllipsoidAlpha_pos hd + have hdq : (0 : ℚ) < d := by exact_mod_cast hd + rw [rationalEllipsoidParallelScale, rationalEllipsoidPerpScale] + have had : 0 < rationalEllipsoidAlpha d / d := div_pos ha hdq + nlinarith [sq_nonneg (rationalEllipsoidAlpha d)] + +/-- A coarse lower bound on the exact determinant multiplier. It is used +for an all-input bit-growth bound; unlike the contraction estimate, no +transcendental inequality is needed. -/ +theorem rationalEllipsoid_volumeFactor_ge_half {d : ℕ} (hd : 0 < d) : + (1 / 2 : ℝ) ≤ + (rationalEllipsoidPerpScale d : ℝ) ^ (d - 1) * + (rationalEllipsoidParallelScale d : ℝ) := by + have hperp : (1 : ℝ) ≤ (rationalEllipsoidPerpScale d : ℝ) := by + rw [rationalEllipsoidPerpScale] + norm_num + positivity + have hpow : (1 : ℝ) ≤ + (rationalEllipsoidPerpScale d : ℝ) ^ (d - 1) := + one_le_pow₀ hperp + have hparallel : (3 / 4 : ℝ) ≤ + (rationalEllipsoidParallelScale d : ℝ) := by + have hq := rationalEllipsoidParallelScale_ge_three_quarters hd + have hcast : (((3 / 4 : ℚ) : ℚ) : ℝ) ≤ + (rationalEllipsoidParallelScale d : ℝ) := Rat.cast_le.mpr hq + norm_num at hcast ⊢ + exact hcast + calc + (1 / 2 : ℝ) ≤ 1 * (3 / 4 : ℝ) := by norm_num + _ ≤ (rationalEllipsoidPerpScale d : ℝ) ^ (d - 1) * + (rationalEllipsoidParallelScale d : ℝ) := + mul_le_mul hpow hparallel (by norm_num) (by positivity) + +/-- Quantitative inverse-polynomial contraction of the determinant factor. +The proof uses only `1+x ≤ exp x`; no numerical estimate or square-root +normalization is hidden here. -/ +theorem rationalEllipsoid_volumeFactor_le_exp_neg {d : ℕ} (hd : 0 < d) : + (rationalEllipsoidPerpScale d : ℝ) ^ (d - 1) * + (rationalEllipsoidParallelScale d : ℝ) ≤ + Real.exp (-1 / (8 * (d : ℝ) ^ 3)) := by + let α : ℝ := (rationalEllipsoidAlpha d : ℝ) + let x : ℝ := 2 * α ^ 2 + let y : ℝ := α / d + have hα0 : 0 < α := by + have hq := rationalEllipsoidAlpha_pos hd + have hc : (0 : ℝ) < (rationalEllipsoidAlpha d : ℝ) := by + exact_mod_cast hq + simpa only [α] using hc + have hdR : (1 : ℝ) ≤ d := by exact_mod_cast hd + have hx0 : 0 ≤ x := by simp [x]; positivity + have hy0 : 0 < y := div_pos hα0 (by positivity) + have hA : (rationalEllipsoidPerpScale d : ℝ) = 1 + x := by + simp [rationalEllipsoidPerpScale, x, α] + have hp : (rationalEllipsoidParallelScale d : ℝ) = 1 - y := by + simp [rationalEllipsoidParallelScale, y, α] + have hp0 : 0 < 1 - y := by + rw [← hp] + have hq := rationalEllipsoidParallelScale_pos hd + exact Rat.cast_pos.mpr hq + have hbase : 1 + x ≤ Real.exp x := by + simpa [add_comm] using Real.add_one_le_exp x + have hpow : (1 + x) ^ (d - 1) ≤ (Real.exp x) ^ (d - 1) := + pow_le_pow_left₀ (by positivity) hbase _ + have hparallel : 1 - y ≤ Real.exp (-y) := by + linarith [Real.add_one_le_exp (-y)] + have hfirst := mul_le_mul hpow hparallel hp0.le + (by positivity : 0 ≤ (Real.exp x) ^ (d - 1)) + have hexpEq : (Real.exp x) ^ (d - 1) * Real.exp (-y) = + Real.exp (((d - 1 : ℕ) : ℝ) * x - y) := by + rw [← Real.exp_nat_mul, ← Real.exp_add] + congr 1 + have hαformula : α = 1 / (4 * (d : ℝ) ^ 2) := by + simp [α, rationalEllipsoidAlpha] + have hexponent : (((d - 1 : ℕ) : ℝ) * x - y) ≤ + -1 / (8 * (d : ℝ) ^ 3) := by + have hdsub : ((d - 1 : ℕ) : ℝ) ≤ (d : ℝ) := by + exact_mod_cast Nat.sub_le d 1 + have hdpos : (0 : ℝ) < d := by positivity + dsimp only [x, y] + rw [hαformula] + field_simp + nlinarith + calc + (rationalEllipsoidPerpScale d : ℝ) ^ (d - 1) * + (rationalEllipsoidParallelScale d : ℝ) = + (1 + x) ^ (d - 1) * (1 - y) := by rw [hA, hp] + _ ≤ (Real.exp x) ^ (d - 1) * Real.exp (-y) := hfirst + _ = Real.exp (((d - 1 : ℕ) : ℝ) * x - y) := hexpEq + _ ≤ Real.exp (-1 / (8 * (d : ℝ) ^ 3)) := Real.exp_le_exp.mpr hexponent + +theorem rationalEllipsoid_volumeFactor_lt_one {d : ℕ} (hd : 0 < d) : + (rationalEllipsoidPerpScale d : ℝ) ^ (d - 1) * + (rationalEllipsoidParallelScale d : ℝ) < 1 := by + calc + (rationalEllipsoidPerpScale d : ℝ) ^ (d - 1) * + (rationalEllipsoidParallelScale d : ℝ) ≤ + Real.exp (-1 / (8 * (d : ℝ) ^ 3)) := + rationalEllipsoid_volumeFactor_le_exp_neg hd + _ < Real.exp 0 := Real.exp_lt_exp.mpr (by + have hdR : (0 : ℝ) < d := by exact_mod_cast hd + have : (0 : ℝ) < 1 / (8 * (d : ℝ) ^ 3) := by positivity + rw [show (-1 : ℝ) / (8 * (d : ℝ) ^ 3) = + -(1 / (8 * (d : ℝ) ^ 3)) by ring] + linarith) + _ = 1 := Real.exp_zero + +/-- A rationally stated version of the volume contraction. The weaker +fixedValue is convenient when we later reserve part of the contraction for +rounding and inflation. -/ +theorem rationalEllipsoid_volumeFactor_le_one_sub {d : ℕ} (hd : 0 < d) : + (rationalEllipsoidPerpScale d : ℝ) ^ (d - 1) * + (rationalEllipsoidParallelScale d : ℝ) ≤ + 1 - 1 / (16 * (d : ℝ) ^ 3) := by + let x : ℝ := 1 / (8 * (d : ℝ) ^ 3) + have hx0 : 0 < x := by dsimp only [x]; positivity + have hdR : (1 : ℝ) ≤ d := by exact_mod_cast hd + have hx1 : x ≤ 1 := by + dsimp only [x] + have hden : (8 : ℝ) ≤ 8 * (d : ℝ) ^ 3 := by + nlinarith [one_le_pow₀ (n := 3) hdR] + exact (div_le_one (by positivity : (0 : ℝ) < 8 * (d : ℝ) ^ 3)).2 + (by nlinarith) + have hexpLower : 1 + x ≤ Real.exp x := by + simpa [add_comm] using Real.add_one_le_exp x + have hrecip : Real.exp (-x) ≤ 1 / (1 + x) := by + rw [Real.exp_neg, one_div] + exact (inv_le_inv₀ (by positivity : (0 : ℝ) < Real.exp x) + (by positivity : (0 : ℝ) < 1 + x)).2 hexpLower + have hrational : 1 / (1 + x) ≤ 1 - x / 2 := by + rw [div_le_iff₀ (by positivity : (0 : ℝ) < 1 + x)] + nlinarith [mul_nonneg hx0.le (sub_nonneg.mpr hx1)] + calc + (rationalEllipsoidPerpScale d : ℝ) ^ (d - 1) * + (rationalEllipsoidParallelScale d : ℝ) ≤ + Real.exp (-1 / (8 * (d : ℝ) ^ 3)) := + rationalEllipsoid_volumeFactor_le_exp_neg hd + _ = Real.exp (-x) := by + congr 1 + dsimp only [x] + ring + _ ≤ 1 / (1 + x) := hrecip + _ ≤ 1 - x / 2 := hrational + _ = 1 - 1 / (16 * (d : ℝ) ^ 3) := by + dsimp only [x] + ring + +/-- Rank-one linear update with prescribed scale `A` orthogonal to `b` and +scale `p` parallel to `b`. -/ +def directionUpdateMatrix {d : ℕ} {R : Type*} + [Field R] [DecidableEq (Fin d)] + (A p : R) (b : Fin d → R) : Matrix (Fin d) (Fin d) R := + fun i j ↦ A * (if i = j then 1 else 0) - + ((A - p) / finiteNormSq b) * b i * b j + +/-- Explicit inverse action for the rank-one update. -/ +def directionUpdatePreimage {d : ℕ} {R : Type*} + [Field R] (A p : R) (b x : Fin d → R) : Fin d → R := + fun i ↦ x i / A + + (1 / p - 1 / A) * (finiteDot b x / finiteNormSq b) * b i + +theorem directionUpdateMatrix_mulVec {d : ℕ} {R : Type*} + [Field R] [DecidableEq (Fin d)] + (A p : R) (b z : Fin d → R) (i : Fin d) : + Matrix.mulVec (directionUpdateMatrix A p b) z i = + A * z i - ((A - p) / finiteNormSq b) * b i * finiteDot b z := by + simp only [Matrix.mulVec, directionUpdateMatrix, dotProduct, sub_mul, + Finset.sum_sub_distrib] + rw [show (∑ x, A * (if i = x then 1 else 0) * z x) = A * z i by simp] + congr 1 + rw [finiteDot] + rw [show + ((A - p) / finiteNormSq b) * b i * (∑ j, b j * z j) = + (((A - p) / finiteNormSq b) * b i) * (∑ j, b j * z j) by ring, + Finset.mul_sum] + apply Finset.sum_congr rfl + intro j _ + ring + +theorem finiteDot_directionUpdatePreimage {d : ℕ} + {A p : ℝ} {b x : Fin d → ℝ} + (hA : A ≠ 0) (hp : p ≠ 0) (hb : finiteNormSq b ≠ 0) : + finiteDot b (directionUpdatePreimage A p b x) = + finiteDot b x / p := by + simp only [finiteDot, directionUpdatePreimage, mul_add, + Finset.sum_add_distrib] + rw [show (∑ i, b i * (x i / A)) = (∑ i, b i * x i) / A by + rw [Finset.sum_div]; congr 1; ext i; ring] + rw [show + (∑ i, b i * + ((1 / p - 1 / A) * + ((∑ j, b j * x j) / finiteNormSq b) * b i)) = + (1 / p - 1 / A) * + ((∑ j, b j * x j) / finiteNormSq b) * finiteNormSq b by + rw [finiteNormSq, finiteDot] + let C : ℝ := (1 / p - 1 / A) * + ((∑ j, b j * x j) / (∑ i, b i * b i)) + change (∑ i, b i * (C * b i)) = C * ∑ i, b i * b i + calc + (∑ i, b i * (C * b i)) = ∑ i, C * (b i * b i) := by + apply Finset.sum_congr rfl + intro i _ + ring + _ = C * ∑ i, b i * b i := by rw [Finset.mul_sum]] + field_simp + ring + +theorem directionUpdateMatrix_preimage {d : ℕ} + {A p : ℝ} {b x : Fin d → ℝ} + (hA : A ≠ 0) (hp : p ≠ 0) (hb : finiteNormSq b ≠ 0) : + Matrix.mulVec (directionUpdateMatrix A p b) + (directionUpdatePreimage A p b x) = x := by + ext i + rw [directionUpdateMatrix_mulVec, + finiteDot_directionUpdatePreimage hA hp hb] + simp only [directionUpdatePreimage] + field_simp + ring + +/-- Exact squared-norm formula for the explicit inverse action. -/ +theorem finiteNormSq_directionUpdatePreimage {d : ℕ} + {A p : ℝ} {b x : Fin d → ℝ} + (hA : A ≠ 0) (hp : p ≠ 0) (hb : finiteNormSq b ≠ 0) : + finiteNormSq (directionUpdatePreimage A p b x) = + (finiteNormSq x - finiteDot b x ^ 2 / finiteNormSq b) / A ^ 2 + + finiteDot b x ^ 2 / (finiteNormSq b * p ^ 2) := by + let q := finiteDot b x + let s := finiteNormSq b + let k : ℝ := (1 / p - 1 / A) * (q / s) + have hpre : directionUpdatePreimage A p b x = + fun i ↦ (1 / A) * x i + k * b i := by + ext i + simp only [directionUpdatePreimage, k, q, s] + ring + rw [hpre, finiteNormSq_add, + finiteNormSq_smul, finiteDot_smul_left, finiteDot_smul_right, + finiteNormSq_smul] + change (1 / A) ^ 2 * finiteNormSq x + + 2 * ((1 / A) * (k * finiteDot x b)) + + k ^ 2 * finiteNormSq b = _ + have hcomm : finiteDot x b = finiteDot b x := by + simp [finiteDot, mul_comm] + rw [hcomm] + dsimp only [k] + dsimp only [q, s] + field_simp + ring + +/-- Point relative to the shifted center, in the old ellipsoid coordinates. -/ +noncomputable def directionShiftedPoint {d : ℕ} (α u : ℝ) + (b y : Fin d → ℝ) : Fin d → ℝ := + fun i ↦ y i + (α / u) * b i +/-- The only scalar geometry needed for containment. The variable `t` is +the component of a unit-ball point in the cut direction and `h` is the +actual center displacement. A convex quadratic on `[-1,0]` is bounded by +its two endpoints. -/ +theorem rationalEllipsoid_scalar_containment + {d : ℕ} (hd : 0 < d) {t h : ℝ} + (ht0 : t ≤ 0) (ht1 : -1 ≤ t) + (hh0 : (rationalEllipsoidAlpha d : ℝ) / d ≤ h) + (hh1 : h ≤ (rationalEllipsoidAlpha d : ℝ)) : + (1 - t ^ 2) / (rationalEllipsoidPerpScale d : ℝ) ^ 2 + + (t + h) ^ 2 / (rationalEllipsoidParallelScale d : ℝ) ^ 2 ≤ 1 := by + let α : ℝ := (rationalEllipsoidAlpha d : ℝ) + let A : ℝ := (rationalEllipsoidPerpScale d : ℝ) + let p : ℝ := (rationalEllipsoidParallelScale d : ℝ) + have hα0 : 0 < α := by + have hq := rationalEllipsoidAlpha_pos hd + have hc : (0 : ℝ) < (rationalEllipsoidAlpha d : ℝ) := by + exact_mod_cast hq + simpa only [α] using hc + have hα1 : α ≤ 1 / 4 := by + have hq := rationalEllipsoidAlpha_le_quarter hd + have hc : (rationalEllipsoidAlpha d : ℝ) ≤ (((1 / 4 : ℚ) : ℝ)) := + Rat.cast_le.mpr hq + norm_num at hc ⊢ + simpa only [α] using hc + have hdR : (1 : ℝ) ≤ d := by exact_mod_cast hd + have hp0 : 0 < p := by + simpa [p] using Rat.cast_pos.mpr (rationalEllipsoidParallelScale_pos hd) + have hp1 : p ≤ 1 := by + simpa [p] using Rat.cast_le.mpr (rationalEllipsoidParallelScale_le_one d) + have hA0 : 0 < A := by + simpa [A] using Rat.cast_pos.mpr (rationalEllipsoidPerpScale_pos d) + have hpA : p < A := by + simpa [p, A] using Rat.cast_lt.mpr (rationalEllipsoidParallel_lt_perp hd) + have hh0' : α / d ≤ h := by simpa [α] using hh0 + have hh1' : h ≤ α := by simpa [α] using hh1 + have hhpos : 0 ≤ h := by + have : 0 < α / (d : ℝ) := div_pos hα0 (by positivity) + linarith + have hh_le_one : h ≤ 1 := hh1'.trans (hα1.trans (by norm_num)) + have hp : p = 1 - α / d := by + simp [p, α, rationalEllipsoidParallelScale] + have hA : A = 1 + 2 * α ^ 2 := by + simp [A, α, rationalEllipsoidPerpScale] + have hendpointNeg : (1 - h) ^ 2 / p ^ 2 ≤ 1 := by + have hph : 1 - h ≤ p := by rw [hp]; linarith + have honeh0 : 0 ≤ 1 - h := sub_nonneg.mpr hh_le_one + rw [div_le_iff₀ (sq_pos_of_pos hp0)] + nlinarith + have hp_ge_three_quarters : 3 / 4 ≤ p := by + rw [hp] + have : α / (d : ℝ) ≤ 1 / 4 := by + exact (div_le_iff₀ (by positivity : (0 : ℝ) < d)).2 (by nlinarith) + linarith + have hendpointZero : 1 / A ^ 2 + h ^ 2 / p ^ 2 ≤ 1 := by + have hh_sq : h ^ 2 ≤ α ^ 2 := by nlinarith + have hp_sq : (9 / 16 : ℝ) ≤ p ^ 2 := by nlinarith + have hA_sq : 1 + 4 * α ^ 2 ≤ A ^ 2 := by rw [hA]; nlinarith [sq_nonneg α] + have hαsq : α ^ 2 ≤ 1 / 16 := by nlinarith + have hfirst : 1 / A ^ 2 ≤ 1 / (1 + 4 * α ^ 2) := by + exact one_div_le_one_div_of_le (by positivity) hA_sq + have hsecond : h ^ 2 / p ^ 2 ≤ (16 / 9) * α ^ 2 := by + have := (div_le_div_iff₀ (by positivity : (0 : ℝ) < p ^ 2) + (by norm_num : (0 : ℝ) < 9 / 16)).2 + (by nlinarith : h ^ 2 * (9 / 16 : ℝ) ≤ α ^ 2 * p ^ 2) + norm_num at this ⊢ + linarith + have hsum : 1 / (1 + 4 * α ^ 2) + (16 / 9) * α ^ 2 ≤ 1 := by + have hden : 0 < 1 + 4 * α ^ 2 := by positivity + have hid : + 1 / (1 + 4 * α ^ 2) + (16 / 9) * α ^ 2 = + (1 + (16 / 9) * α ^ 2 * (1 + 4 * α ^ 2)) / + (1 + 4 * α ^ 2) := by field_simp + rw [hid, div_le_one hden] + nlinarith + linarith + have hcoef : 0 ≤ 1 / p ^ 2 - 1 / A ^ 2 := by + have hp2 : p ^ 2 ≤ A ^ 2 := by nlinarith [hp0, hA0] + exact sub_nonneg.mpr (one_div_le_one_div_of_le (by positivity) hp2) + have htprod : t * (t + 1) ≤ 0 := mul_nonpos_of_nonpos_of_nonneg ht0 (by linarith) + have hchord : + (1 - t ^ 2) / A ^ 2 + (t + h) ^ 2 / p ^ 2 ≤ + (-t) * ((1 - h) ^ 2 / p ^ 2) + + (1 + t) * (1 / A ^ 2 + h ^ 2 / p ^ 2) := by + have hid : + ((-t) * ((1 - h) ^ 2 / p ^ 2) + + (1 + t) * (1 / A ^ 2 + h ^ 2 / p ^ 2)) - + ((1 - t ^ 2) / A ^ 2 + (t + h) ^ 2 / p ^ 2) = + -(1 / p ^ 2 - 1 / A ^ 2) * t * (t + 1) := by ring + rw [← sub_nonneg] + rw [hid] + rw [mul_assoc] + exact mul_nonneg_of_nonpos_of_nonpos (neg_nonpos.mpr hcoef) htprod + calc + (1 - t ^ 2) / + (rationalEllipsoidPerpScale d : ℝ) ^ 2 + + (t + h) ^ 2 / + (rationalEllipsoidParallelScale d : ℝ) ^ 2 = + (1 - t ^ 2) / A ^ 2 + (t + h) ^ 2 / p ^ 2 := by rfl + _ ≤ (-t) * ((1 - h) ^ 2 / p ^ 2) + + (1 + t) * (1 / A ^ 2 + h ^ 2 / p ^ 2) := hchord + _ ≤ (-t) * 1 + (1 + t) * 1 := by + exact add_le_add + (mul_le_mul_of_nonneg_left hendpointNeg (by linarith)) + (mul_le_mul_of_nonneg_left hendpointZero (by linarith)) + _ = 1 := by ring +/-- Full-dimensional containment for the rational update. The hypotheses on +`u` say that it approximates the Euclidean norm of `b` between factors `1` +and `sqrt d`. The executable choice `u = sum |bᵢ|` has exactly these +properties by the two elementary inequalities proved above. -/ +theorem rationalEllipsoid_direction_containment + {d : ℕ} (hd : 0 < d) {b y : Fin d → ℝ} {u : ℝ} + (hb : b ≠ 0) (hu : 0 < u) + (hnormLower : finiteNormSq b ≤ u ^ 2) + (hnormUpper : u ^ 2 ≤ d * finiteNormSq b) + (hy : finiteNormSq y ≤ 1) + (hcut : finiteDot b y ≤ 0) : + finiteNormSq + (directionUpdatePreimage + (rationalEllipsoidPerpScale d : ℝ) + (rationalEllipsoidParallelScale d : ℝ) b + (directionShiftedPoint + (rationalEllipsoidAlpha d : ℝ) u b y)) ≤ 1 := by + let s : ℝ := finiteNormSq b + let r : ℝ := Real.sqrt s + let α : ℝ := (rationalEllipsoidAlpha d : ℝ) + let A : ℝ := (rationalEllipsoidPerpScale d : ℝ) + let p : ℝ := (rationalEllipsoidParallelScale d : ℝ) + let q : ℝ := finiteDot b y + let t : ℝ := q / r + let h : ℝ := α * r / u + let x : Fin d → ℝ := directionShiftedPoint α u b y + have hs0 : 0 ≤ s := finiteNormSq_nonneg b + have hsne : s ≠ 0 := by + intro hs + apply hb + exact (finiteNormSq_eq_zero_iff b).1 (by simpa [s] using hs) + have hspos : 0 < s := lt_of_le_of_ne hs0 (Ne.symm hsne) + have hrpos : 0 < r := by simpa [r] using Real.sqrt_pos.2 hspos + have hrsq : r ^ 2 = s := by simpa [r] using Real.sq_sqrt hs0 + have hApos : 0 < A := by + simpa [A] using Rat.cast_pos.mpr (rationalEllipsoidPerpScale_pos d) + have hppos : 0 < p := by + simpa [p] using Rat.cast_pos.mpr (rationalEllipsoidParallelScale_pos hd) + have hαpos : 0 < α := by + simpa [α] using Rat.cast_pos.mpr (rationalEllipsoidAlpha_pos hd) + have hqcut : q ≤ 0 := by simpa [q] using hcut + have ht0 : t ≤ 0 := by + dsimp only [t] + exact div_nonpos_of_nonpos_of_nonneg hqcut hrpos.le + have hcauchy : q ^ 2 ≤ s * finiteNormSq y := by + simpa [q, s] using finiteDot_sq_le_normSq_mul_normSq b y + have htSq : t ^ 2 ≤ finiteNormSq y := by + dsimp only [t] + rw [div_pow, div_le_iff₀ (sq_pos_of_pos hrpos), hrsq] + simpa [mul_comm] using hcauchy + have htSqOne : t ^ 2 ≤ 1 := htSq.trans hy + have htNegOne : -1 ≤ t := by nlinarith + have hrsqrt_le_u : r ≤ u := by + have : Real.sqrt s ≤ u := + (Real.sqrt_le_iff).2 ⟨hu.le, hnormLower⟩ + simpa only [r] using this + have hdR : (1 : ℝ) ≤ d := by exact_mod_cast hd + have hu_le_dsqrt : u ≤ d * r := by + have hds : (d : ℝ) * s ≤ (d : ℝ) ^ 2 * s := by + have : 0 ≤ (d : ℝ) := by positivity + nlinarith + have huSq : u ^ 2 ≤ ((d : ℝ) * r) ^ 2 := by + calc + u ^ 2 ≤ (d : ℝ) * s := by simpa [s] using hnormUpper + _ ≤ (d : ℝ) ^ 2 * s := hds + _ = ((d : ℝ) * r) ^ 2 := by rw [mul_pow, hrsq] + have hdr0 : 0 ≤ (d : ℝ) * r := mul_nonneg (by positivity) hrpos.le + nlinarith + have hhLower : α / (d : ℝ) ≤ h := by + dsimp only [h] + have hratio : 1 / (d : ℝ) ≤ r / u := by + exact (le_div_iff₀ hu).2 (by + rw [one_div_mul_eq_div] + exact (div_le_iff₀ (by positivity : (0 : ℝ) < d)).2 + (by simpa [mul_comm] using hu_le_dsqrt)) + have := mul_le_mul_of_nonneg_left hratio hαpos.le + simpa [div_eq_mul_inv, mul_assoc] using this + have hhUpper : h ≤ α := by + dsimp only [h] + have hratio : r / u ≤ 1 := (div_le_one hu).2 hrsqrt_le_u + have := mul_le_mul_of_nonneg_left hratio hαpos.le + calc + α * r / u = α * (r / u) := by ring + _ ≤ α := by simpa using this + have hdotx : finiteDot b x = q + (α / u) * s := by + dsimp only [x] + change finiteDot b (fun i ↦ y i + (α / u) * b i) = _ + rw [finiteDot_add_right, + finiteDot_smul_right] + rw [show finiteDot b b = finiteNormSq b by rfl] + have hnormx : finiteNormSq x = + finiteNormSq y + 2 * (α / u) * q + (α / u) ^ 2 * s := by + dsimp only [x] + change finiteNormSq (fun i ↦ y i + (α / u) * b i) = _ + rw [finiteNormSq_add, + finiteDot_smul_right, finiteNormSq_smul] + rw [show finiteDot y b = finiteDot b y by + simp [finiteDot, mul_comm]] + simp only [q, s] + ring + have hperp : + finiteNormSq x - finiteDot b x ^ 2 / s = + finiteNormSq y - t ^ 2 := by + rw [hnormx, hdotx] + dsimp only [t] + field_simp [hsne, hrpos.ne', hu.ne'] + ring_nf + rw [hrsq] + ring + have hparallel : finiteDot b x ^ 2 / (s * p ^ 2) = + (t + h) ^ 2 / p ^ 2 := by + rw [hdotx] + dsimp only [t, h] + have hr4 : r ^ 4 = s ^ 2 := by nlinarith [hrsq] + field_simp [hsne, hrpos.ne', hu.ne'] + ring_nf + rw [hrsq, hr4] + ring + have hinverse := finiteNormSq_directionUpdatePreimage + (A := A) (p := p) (b := b) (x := x) + hApos.ne' hppos.ne' hsne + have hscalar := rationalEllipsoid_scalar_containment hd ht0 htNegOne + (by simpa [α] using hhLower) (by simpa [α] using hhUpper) + change finiteNormSq (directionUpdatePreimage A p b x) ≤ 1 + rw [hinverse] + change (finiteNormSq x - finiteDot b x ^ 2 / s) / A ^ 2 + + finiteDot b x ^ 2 / (s * p ^ 2) ≤ 1 + rw [hperp, hparallel] + calc + (finiteNormSq y - t ^ 2) / A ^ 2 + (t + h) ^ 2 / p ^ 2 ≤ + (1 - t ^ 2) / A ^ 2 + (t + h) ^ 2 / p ^ 2 := by + gcongr + _ ≤ 1 := by simpa [A, p] using hscalar + +/-- Casting the executable `ℓ1` normalization to the reals commutes with the +finite sum and absolute value. -/ +theorem cast_cutL1Scale {d : ℕ} (b : Fin d → ℚ) : + (cutL1Scale b : ℝ) = ∑ i, abs (b i : ℝ) := by + simp [cutL1Scale] + +theorem cast_finiteNormSq {d : ℕ} (b : Fin d → ℚ) : + ((finiteNormSq b : ℚ) : ℝ) = + finiteNormSq (fun i ↦ (b i : ℝ)) := by + simp [finiteNormSq, finiteDot] + +/-- Concrete containment theorem for the normalization actually computed by +the rational algorithm. -/ +theorem rationalEllipsoid_direction_containment_of_rational + {d : ℕ} (hd : 0 < d) {bq : Fin d → ℚ} {y : Fin d → ℝ} + (hbq : bq ≠ 0) (hy : finiteNormSq y ≤ 1) + (hcut : finiteDot (fun i ↦ (bq i : ℝ)) y ≤ 0) : + finiteNormSq + (directionUpdatePreimage + (rationalEllipsoidPerpScale d : ℝ) + (rationalEllipsoidParallelScale d : ℝ) + (fun i ↦ (bq i : ℝ)) + (directionShiftedPoint + (rationalEllipsoidAlpha d : ℝ) (cutL1Scale bq : ℝ) + (fun i ↦ (bq i : ℝ)) y)) ≤ 1 := by + let b : Fin d → ℝ := fun i ↦ (bq i : ℝ) + have hb : b ≠ 0 := by + intro h + apply hbq + ext i + have hi := congrFun h i + exact Rat.cast_eq_zero.mp (by simpa [b] using hi) + have huq := cutL1Scale_pos hbq + have hu : 0 < (cutL1Scale bq : ℝ) := Rat.cast_pos.mpr huq + have hlowerQ := finiteNormSq_le_cutL1Scale_sq bq + have hlower : finiteNormSq b ≤ (cutL1Scale bq : ℝ) ^ 2 := by + rw [← cast_finiteNormSq bq] + exact_mod_cast hlowerQ + have hupperQ := cutL1Scale_sq_le_card_mul_normSq bq + have hupper : (cutL1Scale bq : ℝ) ^ 2 ≤ d * finiteNormSq b := by + rw [← cast_finiteNormSq bq] + exact_mod_cast hupperQ + exact rationalEllipsoid_direction_containment hd hb hu hlower hupper hy + (by simpa [b] using hcut) + +/-- Entirely rational state stored by the cutting-plane algorithm. -/ +structure RationalEllipsoidState (d : ℕ) where + center : Fin d → ℚ + basis : Matrix (Fin d) (Fin d) ℚ + +/-- Pull a physical cut normal back to unit-ball coordinates. -/ +def rationalPulledBackNormal {d : ℕ} + (E : RationalEllipsoidState d) (a : Fin d → ℚ) : Fin d → ℚ := + fun j ↦ ∑ i, E.basis i j * a i + +/-- One square-root-free central-cut update. Division by zero is harmless in +the total Lean definition; correctness is invoked only when the pulled-back +normal is nonzero, in which case `cutL1Scale` is positive. -/ +def rationalEllipsoidCentralUpdate {d : ℕ} + (E : RationalEllipsoidState d) (a : Fin d → ℚ) : + RationalEllipsoidState d := + let b := rationalPulledBackNormal E a + let u := cutL1Scale b + let α := rationalEllipsoidAlpha d + let C := directionUpdateMatrix + (rationalEllipsoidPerpScale d) + (rationalEllipsoidParallelScale d) b + { center := fun i ↦ E.center i - + α * ∑ j, E.basis i j * (b j / u) + basis := E.basis * C } + +/-- Real point represented by rational ellipsoid data and real unit-ball +coordinates. -/ +noncomputable def rationalEllipsoidPoint {d : ℕ} + (E : RationalEllipsoidState d) (y : Fin d → ℝ) : Fin d → ℝ := + fun i ↦ (E.center i : ℝ) + ∑ j, (E.basis i j : ℝ) * y j + +theorem cast_directionUpdateMatrix {d : ℕ} + (A p : ℚ) (b : Fin d → ℚ) (i j : Fin d) : + ((directionUpdateMatrix A p b i j : ℚ) : ℝ) = + directionUpdateMatrix (A : ℝ) (p : ℝ) + (fun k ↦ (b k : ℝ)) i j := by + by_cases hij : i = j <;> + simp [directionUpdateMatrix, cast_finiteNormSq, hij] + +theorem cast_rationalPulledBackNormal {d : ℕ} + (E : RationalEllipsoidState d) (a : Fin d → ℚ) (j : Fin d) : + (rationalPulledBackNormal E a j : ℝ) = + ∑ i, (E.basis i j : ℝ) * (a i : ℝ) := by + simp [rationalPulledBackNormal] + +/-- The stored rational rank-one matrix sends the explicit real preimage to +the shifted old coordinate exactly. -/ +theorem cast_directionUpdateMatrix_preimage {d : ℕ} (hd : 0 < d) + {bq : Fin d → ℚ} (hbq : bq ≠ 0) {y : Fin d → ℝ} : + Matrix.mulVec + (fun i j ↦ + ((directionUpdateMatrix + (rationalEllipsoidPerpScale d) + (rationalEllipsoidParallelScale d) bq i j : ℚ) : ℝ)) + (directionUpdatePreimage + (rationalEllipsoidPerpScale d : ℝ) + (rationalEllipsoidParallelScale d : ℝ) + (fun i ↦ (bq i : ℝ)) + (directionShiftedPoint + (rationalEllipsoidAlpha d : ℝ) (cutL1Scale bq : ℝ) + (fun i ↦ (bq i : ℝ)) y)) = + directionShiftedPoint + (rationalEllipsoidAlpha d : ℝ) (cutL1Scale bq : ℝ) + (fun i ↦ (bq i : ℝ)) y := by + let b : Fin d → ℝ := fun i ↦ (bq i : ℝ) + have hb : b ≠ 0 := by + intro h + apply hbq + ext i + exact Rat.cast_eq_zero.mp (by simpa [b] using congrFun h i) + have hnorm : finiteNormSq b ≠ 0 := by + intro h + exact hb ((finiteNormSq_eq_zero_iff b).1 h) + have hA : (0 : ℝ) < (rationalEllipsoidPerpScale d : ℝ) := + Rat.cast_pos.mpr (rationalEllipsoidPerpScale_pos d) + have hp : (0 : ℝ) < (rationalEllipsoidParallelScale d : ℝ) := + Rat.cast_pos.mpr (rationalEllipsoidParallelScale_pos hd) + have hinv := directionUpdateMatrix_preimage + (A := (rationalEllipsoidPerpScale d : ℝ)) + (p := (rationalEllipsoidParallelScale d : ℝ)) + (b := b) + (x := directionShiftedPoint + (rationalEllipsoidAlpha d : ℝ) (cutL1Scale bq : ℝ) b y) + hA.ne' hp.ne' hnorm + simpa only [b, cast_directionUpdateMatrix] using hinv + +/-- Every point surviving a central cut in the old ellipsoid has an explicit +unit-ball coordinate in the updated rational ellipsoid. -/ +theorem rationalEllipsoidCentralUpdate_contains {d : ℕ} (hd : 0 < d) + (E : RationalEllipsoidState d) (a : Fin d → ℚ) {y : Fin d → ℝ} + (hb : rationalPulledBackNormal E a ≠ 0) + (hy : finiteNormSq y ≤ 1) + (hcut : finiteDot + (fun i ↦ (rationalPulledBackNormal E a i : ℝ)) y ≤ 0) : + ∃ y' : Fin d → ℝ, finiteNormSq y' ≤ 1 ∧ + rationalEllipsoidPoint (rationalEllipsoidCentralUpdate E a) y' = + rationalEllipsoidPoint E y := by + let bq := rationalPulledBackNormal E a + let b : Fin d → ℝ := fun i ↦ (bq i : ℝ) + let y' := directionUpdatePreimage + (rationalEllipsoidPerpScale d : ℝ) + (rationalEllipsoidParallelScale d : ℝ) b + (directionShiftedPoint + (rationalEllipsoidAlpha d : ℝ) (cutL1Scale bq : ℝ) b y) + have hbq : bq ≠ 0 := by simpa [bq] using hb + have hy' : finiteNormSq y' ≤ 1 := by + dsimp only [y'] + exact rationalEllipsoid_direction_containment_of_rational hd hbq hy + (by simpa [b, bq] using hcut) + refine ⟨y', hy', ?_⟩ + have hCy := cast_directionUpdateMatrix_preimage hd hbq (y := y) + change Matrix.mulVec + (fun i j ↦ + ((directionUpdateMatrix + (rationalEllipsoidPerpScale d) + (rationalEllipsoidParallelScale d) bq i j : ℚ) : ℝ)) y' = + directionShiftedPoint + (rationalEllipsoidAlpha d : ℝ) (cutL1Scale bq : ℝ) b y at hCy + have hCyReal : + Matrix.mulVec + (directionUpdateMatrix + (rationalEllipsoidPerpScale d : ℝ) + (rationalEllipsoidParallelScale d : ℝ) b) y' = + directionShiftedPoint + (rationalEllipsoidAlpha d : ℝ) (cutL1Scale bq : ℝ) b y := by + rw [← hCy] + congr 1 + ext j k + exact (cast_directionUpdateMatrix + (rationalEllipsoidPerpScale d) + (rationalEllipsoidParallelScale d) bq j k).symm + ext i + rw [rationalEllipsoidPoint, rationalEllipsoidPoint] + simp only [rationalEllipsoidCentralUpdate] + simp only [Matrix.mul_apply] + push_cast + change (E.center i : ℝ) - + (rationalEllipsoidAlpha d : ℝ) * + (∑ x, (E.basis i x : ℝ) * + ((bq x : ℝ) / (cutL1Scale bq : ℝ))) + + (∑ j, + (∑ k, (E.basis i k : ℝ) * + ((directionUpdateMatrix + (rationalEllipsoidPerpScale d) + (rationalEllipsoidParallelScale d) bq k j : ℚ) : ℝ)) * y' j) = + (E.center i : ℝ) + ∑ j, (E.basis i j : ℝ) * y j + have hbasis : + (∑ j, + (∑ k, (E.basis i k : ℝ) * + (directionUpdateMatrix + (rationalEllipsoidPerpScale d : ℝ) + (rationalEllipsoidParallelScale d : ℝ) b k j)) * y' j) = + ∑ k, (E.basis i k : ℝ) * + (Matrix.mulVec + (directionUpdateMatrix + (rationalEllipsoidPerpScale d : ℝ) + (rationalEllipsoidParallelScale d : ℝ) b) y') k := by + simp only [Matrix.mulVec, dotProduct] + calc + (∑ j, + (∑ k, (E.basis i k : ℝ) * + directionUpdateMatrix + (rationalEllipsoidPerpScale d : ℝ) + (rationalEllipsoidParallelScale d : ℝ) b k j) * y' j) = + ∑ j, ∑ k, (E.basis i k : ℝ) * + (directionUpdateMatrix + (rationalEllipsoidPerpScale d : ℝ) + (rationalEllipsoidParallelScale d : ℝ) b k j * y' j) := by + apply Finset.sum_congr rfl + intro j _ + rw [Finset.sum_mul] + apply Finset.sum_congr rfl + intro k _ + ring + _ = ∑ k, ∑ j, (E.basis i k : ℝ) * + (directionUpdateMatrix + (rationalEllipsoidPerpScale d : ℝ) + (rationalEllipsoidParallelScale d : ℝ) b k j * y' j) := + Finset.sum_comm + _ = ∑ k, (E.basis i k : ℝ) * + ∑ j, directionUpdateMatrix + (rationalEllipsoidPerpScale d : ℝ) + (rationalEllipsoidParallelScale d : ℝ) b k j * y' j := by + apply Finset.sum_congr rfl + intro k _ + rw [Finset.mul_sum] + rw [show + (∑ j, + (∑ k, (E.basis i k : ℝ) * + ((directionUpdateMatrix + (rationalEllipsoidPerpScale d) + (rationalEllipsoidParallelScale d) bq k j : ℚ) : ℝ)) * y' j) = + ∑ j, + (∑ k, (E.basis i k : ℝ) * + (directionUpdateMatrix + (rationalEllipsoidPerpScale d : ℝ) + (rationalEllipsoidParallelScale d : ℝ) b k j)) * y' j by + apply Finset.sum_congr rfl + intro j _ + congr 1 + apply Finset.sum_congr rfl + intro k _ + rw [cast_directionUpdateMatrix] + ] + rw [hbasis] + rw [hCyReal] + simp only [directionShiftedPoint] + simp only [b] + ring_nf + simp only [Finset.sum_add_distrib, Finset.mul_sum] + have hcancel : + (∑ x, (rationalEllipsoidAlpha d : ℝ) * + ((E.basis i x : ℝ) * (bq x : ℝ) * + (cutL1Scale bq : ℝ)⁻¹)) = + ∑ x, (rationalEllipsoidAlpha d : ℝ) * + (cutL1Scale bq : ℝ)⁻¹ * (E.basis i x : ℝ) * (bq x : ℝ) := by + apply Finset.sum_congr rfl + intro x _ + ring + rw [hcancel] + ring + +/-- Exact determinant of the rank-one direction update. -/ +theorem det_directionUpdateMatrix {d : ℕ} (hd : 0 < d) + {R : Type*} [Field R] {A p : R} (hA : A ≠ 0) {b : Fin d → R} + (hb : finiteNormSq b ≠ 0) : + Matrix.det (directionUpdateMatrix A p b) = A ^ (d - 1) * p := by + let v : Fin d → R := fun i ↦ -((A - p) / (A * finiteNormSq b)) * b i + have hform : directionUpdateMatrix A p b = + A • (1 + Matrix.vecMulVec b v) := by + ext i j + change A * (if i = j then 1 else 0) - + ((A - p) / finiteNormSq b) * b i * b j = + A * ((if i = j then 1 else 0) + b i * v j) + dsimp only [v] + by_cases hij : i = j + · subst j + simp only [ite_true] + field_simp [hA, hb] + ring + · simp only [hij, ite_false, zero_add, mul_zero] + field_simp [hA, hb] + ring + rw [hform, Matrix.det_smul] + rw [Matrix.vecMulVec_eq Unit, + Matrix.det_one_add_replicateCol_mul_replicateRow] + have hdot : v ⬝ᵥ b = -(A - p) / A := by + rw [dotProduct] + let C : R := -((A - p) / (A * finiteNormSq b)) + change (∑ i, C * b i * b i) = _ + calc + (∑ i, C * b i * b i) = C * ∑ i, b i * b i := by + rw [Finset.mul_sum] + apply Finset.sum_congr rfl + intro i _ + ring + _ = C * finiteNormSq b := by rfl + _ = -(A - p) / A := by + dsimp only [C] + field_simp [hA, hb] + rw [hdot] + simp only [Fintype.card_fin] + have hdle : 1 ≤ d := hd + rw [show 1 + -(A - p) / A = p / A by + field_simp [hA] + ring] + rw [show d = (d - 1) + 1 by omega, pow_succ] + have hcancel : A * (p / A) = p := by field_simp [hA] + calc + A ^ (d - 1) * A * (p / A) = + A ^ (d - 1) * (A * (p / A)) := by ring + _ = A ^ (d - 1) * p := by rw [hcancel] + +/-- Consequently the stored basis determinant contracts by the explicit +factor from `rationalEllipsoid_volumeFactor_lt_one`. -/ +theorem det_rationalEllipsoidCentralUpdate {d : ℕ} (hd : 0 < d) + (E : RationalEllipsoidState d) (a : Fin d → ℚ) + (hb : rationalPulledBackNormal E a ≠ 0) : + Matrix.det (rationalEllipsoidCentralUpdate E a).basis = + Matrix.det E.basis * + (rationalEllipsoidPerpScale d ^ (d - 1) * + rationalEllipsoidParallelScale d) := by + let b := rationalPulledBackNormal E a + have hbq : finiteNormSq b ≠ 0 := by + intro hzero + apply hb + rw [finiteNormSq, finiteDot, + Finset.sum_mul_self_eq_zero_iff] at hzero + ext i + exact hzero i (Finset.mem_univ i) + rw [rationalEllipsoidCentralUpdate] + simp only + rw [Matrix.det_mul] + change Matrix.det E.basis * + Matrix.det (directionUpdateMatrix + (rationalEllipsoidPerpScale d) + (rationalEllipsoidParallelScale d) b) = _ + rw [det_directionUpdateMatrix hd + (rationalEllipsoidPerpScale_pos d).ne' hbq] + +/-- Apply a finite list of central cuts, in list order. -/ +def rationalEllipsoidIterate {d : ℕ} : + RationalEllipsoidState d → List (Fin d → ℚ) → + RationalEllipsoidState d + | E, [] => E + | E, a :: cuts => + rationalEllipsoidIterate (rationalEllipsoidCentralUpdate E a) cuts + +/-- Every cut in a run has a nonzero pulled-back normal at the state where it +is used. This is exactly the side condition needed by the update proof. -/ +def RationalEllipsoidCutsNonzero {d : ℕ} : + RationalEllipsoidState d → List (Fin d → ℚ) → Prop + | _, [] => True + | E, a :: cuts => + rationalPulledBackNormal E a ≠ 0 ∧ + RationalEllipsoidCutsNonzero + (rationalEllipsoidCentralUpdate E a) cuts + +/-- Exact determinant after a finite valid rational cutting-plane run. -/ +theorem det_rationalEllipsoidIterate {d : ℕ} (hd : 0 < d) + (E : RationalEllipsoidState d) (cuts : List (Fin d → ℚ)) + (hnonzero : RationalEllipsoidCutsNonzero E cuts) : + Matrix.det (rationalEllipsoidIterate E cuts).basis = + Matrix.det E.basis * + (rationalEllipsoidPerpScale d ^ (d - 1) * + rationalEllipsoidParallelScale d) ^ cuts.length := by + induction cuts generalizing E with + | nil => simp [rationalEllipsoidIterate] + | cons a cuts ih => + rw [rationalEllipsoidIterate] + change rationalPulledBackNormal E a ≠ 0 ∧ + RationalEllipsoidCutsNonzero + (rationalEllipsoidCentralUpdate E a) cuts at hnonzero + rw [ih (rationalEllipsoidCentralUpdate E a) hnonzero.2, + det_rationalEllipsoidCentralUpdate hd E a hnonzero.1] + simp only [List.length_cons, pow_succ] + ring + +/-- The determinant after `k` cuts is bounded by the explicit exponential +contraction. -/ +theorem abs_det_rationalEllipsoidIterate_le_exp {d : ℕ} (hd : 0 < d) + (E : RationalEllipsoidState d) (cuts : List (Fin d → ℚ)) + (hnonzero : RationalEllipsoidCutsNonzero E cuts) : + abs ((Matrix.det (rationalEllipsoidIterate E cuts).basis : ℚ) : ℝ) ≤ + abs ((Matrix.det E.basis : ℚ) : ℝ) * + Real.exp (-(cuts.length : ℝ) / (8 * (d : ℝ) ^ 3)) := by + let q : ℝ := + (rationalEllipsoidPerpScale d : ℝ) ^ (d - 1) * + (rationalEllipsoidParallelScale d : ℝ) + have hq0 : 0 ≤ q := by + exact mul_nonneg (pow_nonneg + (Rat.cast_nonneg.mpr (rationalEllipsoidPerpScale_pos d).le) _) + (Rat.cast_nonneg.mpr (rationalEllipsoidParallelScale_pos hd).le) + have hqexp : q ≤ Real.exp (-(1 : ℝ) / (8 * (d : ℝ) ^ 3)) := by + simpa [q] using rationalEllipsoid_volumeFactor_le_exp_neg hd + have hpow : q ^ cuts.length ≤ + Real.exp (-(1 : ℝ) / (8 * (d : ℝ) ^ 3)) ^ cuts.length := + pow_le_pow_left₀ hq0 hqexp _ + have hexp : + Real.exp (-(1 : ℝ) / (8 * (d : ℝ) ^ 3)) ^ cuts.length = + Real.exp (-(cuts.length : ℝ) / (8 * (d : ℝ) ^ 3)) := by + rw [← Real.exp_nat_mul] + congr 1 + ring + rw [← hexp] + have hdet := det_rationalEllipsoidIterate hd E cuts hnonzero + have hdetReal : + ((Matrix.det (rationalEllipsoidIterate E cuts).basis : ℚ) : ℝ) = + ((Matrix.det E.basis : ℚ) : ℝ) * q ^ cuts.length := by + have hcast := congrArg (fun x : ℚ ↦ (x : ℝ)) hdet + simpa [q] using hcast + rw [hdetReal, abs_mul] + have hqabs : abs q = q := abs_of_nonneg hq0 + rw [abs_pow, hqabs] + exact mul_le_mul_of_nonneg_left hpow (abs_nonneg _) + +/-- A coordinate of a point in the Euclidean unit ball has absolute value at +most one. -/ +theorem abs_coordinate_le_one_of_normSq_le_one {d : ℕ} + {x : Fin d → ℝ} (hx : finiteNormSq x ≤ 1) (i : Fin d) : + abs (x i) ≤ 1 := by + have hcoord : x i * x i ≤ finiteNormSq x := by + rw [finiteNormSq, finiteDot] + exact Finset.single_le_sum (fun j _ ↦ mul_self_nonneg (x j)) + (Finset.mem_univ i) + have hsquare : (abs (x i)) ^ 2 ≤ 1 := by + rw [sq_abs, sq] + exact hcoord.trans hx + nlinarith [abs_nonneg (x i)] + +/-- Difference matrix whose `k`th column joins two unit-ball coordinates. -/ +def unitBallDifferenceMatrix {d : ℕ} + (yPlus yMinus : Fin d → Fin d → ℝ) : Matrix (Fin d) (Fin d) ℝ := + fun i k ↦ yPlus k i - yMinus k i + +theorem unitBallDifferenceMatrix_entry_le_two {d : ℕ} + {yPlus yMinus : Fin d → Fin d → ℝ} + (hplus : ∀ k, finiteNormSq (yPlus k) ≤ 1) + (hminus : ∀ k, finiteNormSq (yMinus k) ≤ 1) + (i k : Fin d) : + abs (unitBallDifferenceMatrix yPlus yMinus i k) ≤ 2 := by + rw [unitBallDifferenceMatrix] + exact (abs_sub (yPlus k i) (yMinus k i)).trans + (by linarith [abs_coordinate_le_one_of_normSq_le_one (hplus k) i, + abs_coordinate_le_one_of_normSq_le_one (hminus k) i]) + +/-- Elementary substitute for the usual volume lower bound. If a linear +image of the unit ball contains the `2d` endpoints of the coordinate +diameters of a radius-`r` ball, its determinant is at least `r^d / d!`. +This follows from the Leibniz determinant bound, so no measure theory is +needed. -/ +theorem determinant_lower_of_coordinate_diameters {d : ℕ} + (B : Matrix (Fin d) (Fin d) ℝ) {r : ℝ} (hr : 0 ≤ r) + {yPlus yMinus : Fin d → Fin d → ℝ} + (hplus : ∀ k, finiteNormSq (yPlus k) ≤ 1) + (hminus : ∀ k, finiteNormSq (yMinus k) ≤ 1) + (hdiameter : ∀ k, + Matrix.mulVec B (fun j ↦ yPlus k j - yMinus k j) = + fun i ↦ if i = k then 2 * r else 0) : + r ^ d ≤ Nat.factorial d * abs (Matrix.det B) := by + let V := unitBallDifferenceMatrix yPlus yMinus + have hBV : B * V = (2 * r) • (1 : Matrix (Fin d) (Fin d) ℝ) := by + ext i k + rw [Matrix.mul_apply] + have hk := congrFun (hdiameter k) i + change (∑ x, B i x * V x k) = _ + rw [show (∑ x, B i x * V x k) = + Matrix.mulVec B (fun j ↦ yPlus k j - yMinus k j) i by rfl, + hk] + by_cases hik : i = k <;> simp [hik] + have hdetEq : Matrix.det B * Matrix.det V = (2 * r) ^ d := by + rw [← Matrix.det_mul, hBV, Matrix.det_smul, Matrix.det_one, + mul_one, Fintype.card_fin] + have hdetV : abs (Matrix.det V) ≤ Nat.factorial d * 2 ^ d := by + have h := Matrix.det_le (abv := (AbsoluteValue.abs : AbsoluteValue ℝ ℝ)) + (A := V) (x := (2 : ℝ)) + (fun i k ↦ unitBallDifferenceMatrix_entry_le_two hplus hminus i k) + simpa [Fintype.card_fin, nsmul_eq_mul] using h + have habsEq : abs (Matrix.det B) * abs (Matrix.det V) = (2 * r) ^ d := by + rw [← abs_mul, hdetEq, abs_of_nonneg (pow_nonneg (mul_nonneg (by norm_num) hr) _)] + have hscaled : (2 * r) ^ d ≤ + abs (Matrix.det B) * (Nat.factorial d * 2 ^ d) := by + rw [← habsEq] + exact mul_le_mul_of_nonneg_left hdetV (abs_nonneg _) + have htwo : (0 : ℝ) < 2 ^ d := by positivity + have hrewrite : (2 * r) ^ d = 2 ^ d * r ^ d := by rw [mul_pow] + rw [hrewrite] at hscaled + have hscaled' : 2 ^ d * r ^ d ≤ + 2 ^ d * (Nat.factorial d * abs (Matrix.det B)) := by + calc + 2 ^ d * r ^ d ≤ abs (Matrix.det B) * (Nat.factorial d * 2 ^ d) := hscaled + _ = 2 ^ d * (Nat.factorial d * abs (Matrix.det B)) := by ring + exact le_of_mul_le_mul_left hscaled' htwo + +/-- If a rational ellipsoid contains the coordinate endpoints of a real ball +of radius `r`, its (real-cast) basis determinant has the corresponding +algebraic lower bound. This is the exact finite substitute for the usual +statement that containment of an inner ball gives a lower volume bound. -/ +theorem rationalEllipsoid_determinant_lower_of_ball_endpoints {d : ℕ} + (E : RationalEllipsoidState d) {z : Fin d → ℝ} {r : ℝ} (hr : 0 ≤ r) + (hplus : ∀ k, ∃ y : Fin d → ℝ, finiteNormSq y ≤ 1 ∧ + rationalEllipsoidPoint E y = + fun i ↦ z i + if i = k then r else 0) + (hminus : ∀ k, ∃ y : Fin d → ℝ, finiteNormSq y ≤ 1 ∧ + rationalEllipsoidPoint E y = + fun i ↦ z i - if i = k then r else 0) : + r ^ d ≤ Nat.factorial d * + abs (Matrix.det (fun i j ↦ (E.basis i j : ℝ))) := by + classical + choose yPlus hplusNorm hplusPoint using hplus + choose yMinus hminusNorm hminusPoint using hminus + apply determinant_lower_of_coordinate_diameters + (fun i j ↦ (E.basis i j : ℝ)) hr hplusNorm hminusNorm + intro k + ext i + have hp := congrFun (hplusPoint k) i + have hm := congrFun (hminusPoint k) i + rw [rationalEllipsoidPoint] at hp hm + change (∑ j, (E.basis i j : ℝ) * (yPlus k j - yMinus k j)) = _ + simp_rw [mul_sub] + rw [Finset.sum_sub_distrib] + by_cases hik : i = k <;> simp [hik] at hp hm ⊢ <;> linarith + +/-- The same lower bound written directly in terms of the stored rational +determinant. -/ +theorem rationalEllipsoid_storedDet_lower_of_ball_endpoints {d : ℕ} + (E : RationalEllipsoidState d) {z : Fin d → ℝ} {r : ℝ} (hr : 0 ≤ r) + (hplus : ∀ k, ∃ y : Fin d → ℝ, finiteNormSq y ≤ 1 ∧ + rationalEllipsoidPoint E y = + fun i ↦ z i + if i = k then r else 0) + (hminus : ∀ k, ∃ y : Fin d → ℝ, finiteNormSq y ≤ 1 ∧ + rationalEllipsoidPoint E y = + fun i ↦ z i - if i = k then r else 0) : + r ^ d ≤ Nat.factorial d * abs ((Matrix.det E.basis : ℚ) : ℝ) := by + simpa only [Rat.cast_det] using + rationalEllipsoid_determinant_lower_of_ball_endpoints E hr hplus hminus + +/-- The elementary estimate `exp (-1) ≤ 1/2`, derived from the power-series +lower bound `2 ≤ exp 1`. -/ +theorem real_exp_neg_one_le_half : + Real.exp (-1) ≤ (1 / 2 : ℝ) := by + rw [Real.exp_neg] + have htwo : (2 : ℝ) ≤ Real.exp 1 := by + convert Real.add_one_le_exp (1 : ℝ) using 1 <;> norm_num + have hinv := one_div_le_one_div_of_le (by norm_num : (0 : ℝ) < 2) htwo + simpa [one_div] using hinv + +/-- After `8 d^3 M` cuts, the analytic contraction factor is at most +`2^{-M}`. Thus the iteration budget can be chosen using ordinary binary +lengths rather than a real logarithm. -/ +theorem exp_neg_cutRatio_le_half_pow {d M k : ℕ} (hd : 0 < d) + (hk : 8 * d ^ 3 * M ≤ k) : + Real.exp (-(k : ℝ) / (8 * (d : ℝ) ^ 3)) ≤ (1 / 2 : ℝ) ^ M := by + have hden : (0 : ℝ) < 8 * (d : ℝ) ^ 3 := by positivity + have hkReal : (8 : ℝ) * (d : ℝ) ^ 3 * (M : ℝ) ≤ (k : ℝ) := by + exact_mod_cast hk + have hratio : (M : ℝ) ≤ (k : ℝ) / (8 * (d : ℝ) ^ 3) := by + rw [le_div_iff₀ hden] + calc + (M : ℝ) * (8 * (d : ℝ) ^ 3) = + 8 * (d : ℝ) ^ 3 * (M : ℝ) := by ring + _ ≤ (k : ℝ) := hkReal + calc + Real.exp (-(k : ℝ) / (8 * (d : ℝ) ^ 3)) ≤ + Real.exp (-(M : ℝ)) := by + rw [Real.exp_le_exp] + convert neg_le_neg hratio using 1 <;> ring + _ = Real.exp (-1) ^ M := by + rw [show -(M : ℝ) = (M : ℝ) * (-1 : ℝ) by ring, + Real.exp_nat_mul] + _ ≤ (1 / 2 : ℝ) ^ M := + pow_le_pow_left₀ (Real.exp_pos (-1)).le real_exp_neg_one_le_half M + +/-- The determinant upper and lower bounds sandwich every run that still +contains the endpoints of a radius-`r` ball. -/ +theorem rationalEllipsoid_run_sandwich {d : ℕ} (hd : 0 < d) + (E : RationalEllipsoidState d) (cuts : List (Fin d → ℚ)) + (hnonzero : RationalEllipsoidCutsNonzero E cuts) + {z : Fin d → ℝ} {r : ℝ} (hr : 0 ≤ r) + (hplus : ∀ k, ∃ y : Fin d → ℝ, finiteNormSq y ≤ 1 ∧ + rationalEllipsoidPoint (rationalEllipsoidIterate E cuts) y = + fun i ↦ z i + if i = k then r else 0) + (hminus : ∀ k, ∃ y : Fin d → ℝ, finiteNormSq y ≤ 1 ∧ + rationalEllipsoidPoint (rationalEllipsoidIterate E cuts) y = + fun i ↦ z i - if i = k then r else 0) : + r ^ d ≤ Nat.factorial d * abs ((Matrix.det E.basis : ℚ) : ℝ) * + Real.exp (-(cuts.length : ℝ) / (8 * (d : ℝ) ^ 3)) := by + have hlower := rationalEllipsoid_storedDet_lower_of_ball_endpoints + (rationalEllipsoidIterate E cuts) hr hplus hminus + have hupper := abs_det_rationalEllipsoidIterate_le_exp hd E cuts hnonzero + calc + r ^ d ≤ Nat.factorial d * + abs ((Matrix.det (rationalEllipsoidIterate E cuts).basis : ℚ) : ℝ) := + hlower + _ ≤ Nat.factorial d * + (abs ((Matrix.det E.basis : ℚ) : ℝ) * + Real.exp (-(cuts.length : ℝ) / (8 * (d : ℝ) ^ 3))) := by + exact mul_le_mul_of_nonneg_left hupper (Nat.cast_nonneg _) + _ = Nat.factorial d * abs ((Matrix.det E.basis : ℚ) : ℝ) * + Real.exp (-(cuts.length : ℝ) / (8 * (d : ℝ) ^ 3)) := by ring + +/-- A concrete dyadic budget rules out a run that continues to contain the +inner ball. -/ +theorem rationalEllipsoid_no_long_run {d M : ℕ} (hd : 0 < d) + (E : RationalEllipsoidState d) (cuts : List (Fin d → ℚ)) + (hnonzero : RationalEllipsoidCutsNonzero E cuts) + (hlength : 8 * d ^ 3 * M ≤ cuts.length) + {z : Fin d → ℝ} {r : ℝ} (hr : 0 ≤ r) + (hdyadic : Nat.factorial d * abs ((Matrix.det E.basis : ℚ) : ℝ) * + (1 / 2 : ℝ) ^ M < r ^ d) + (hplus : ∀ k, ∃ y : Fin d → ℝ, finiteNormSq y ≤ 1 ∧ + rationalEllipsoidPoint (rationalEllipsoidIterate E cuts) y = + fun i ↦ z i + if i = k then r else 0) + (hminus : ∀ k, ∃ y : Fin d → ℝ, finiteNormSq y ≤ 1 ∧ + rationalEllipsoidPoint (rationalEllipsoidIterate E cuts) y = + fun i ↦ z i - if i = k then r else 0) : False := by + have hsandwich := rationalEllipsoid_run_sandwich hd E cuts hnonzero + hr hplus hminus + have hexp := exp_neg_cutRatio_le_half_pow hd hlength + have hnonneg : + 0 ≤ Nat.factorial d * abs ((Matrix.det E.basis : ℚ) : ℝ) := by + positivity + have hcontract : + Nat.factorial d * abs ((Matrix.det E.basis : ℚ) : ℝ) * + Real.exp (-(cuts.length : ℝ) / (8 * (d : ℝ) ^ 3)) ≤ + Nat.factorial d * abs ((Matrix.det E.basis : ℚ) : ℝ) * + (1 / 2 : ℝ) ^ M := + mul_le_mul_of_nonneg_left hexp hnonneg + linarith + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/RationalEncodingBounds.lean b/LeanPool/BeyondBethe/BeyondBethe/RationalEncodingBounds.lean new file mode 100644 index 0000000000..81dbed9bc8 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/RationalEncodingBounds.lean @@ -0,0 +1,427 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.RoundedEllipsoidIterationBounds +import Mathlib.Data.Rat.Lemmas +import Mathlib.Tactic + +/-! # Rational Encoding Bounds -/ + +namespace BeyondBethe + +open Complexity + +/-! +# Upper bounds for the canonical rational encoding + +The algorithm uses Complexitylib's parenthesized binary `DataEncode` +serialization. These lemmas give explicit upper bounds for that exact +encoding, rather than appealing to an informal notion of rational bit size. +-/ + +theorem bool_dataEncode_size_le_four (b : Bool) : + (DataEncode.encode b).size ≤ 4 := by + cases b <;> norm_num [DataEncode.encode, Data.size] + +theorem nat_encodedBitLength_le (n : ℕ) : + encodedBitLength ℕ n ≤ 2 + 4 * n.size := by + rw [encodedBitLength_eq_dataSize] + change (Data.l (n.bits.map fun b ↦ DataEncode.encode b)).size ≤ _ + rw [Data.size] + simp only [List.map_map] + have hsum : + ((n.bits.map fun b ↦ (DataEncode.encode b).size).sum) ≤ + 4 * n.bits.length := by + induction n.bits with + | nil => simp + | cons b bits ih => + simp only [List.map_cons, List.sum_cons, List.length_cons] + have hb := bool_dataEncode_size_le_four b + omega + have hadd := Nat.add_le_add_left hsum 2 + simpa only [Function.comp_apply, Nat.size_eq_bits_len] using hadd + +theorem integer_encodedBitLength_le (z : ℤ) : + encodedBitLength ℤ z ≤ 8 + 4 * z.natAbs.size := by + rw [encodedBitLength_eq_dataSize] + change (DataEncode.encode (integerPayload z)).size ≤ _ + rw [show DataEncode.encode (integerPayload z) = + Data.l [DataEncode.encode (integerPayload z).1, + DataEncode.encode (integerPayload z).2] by + exact DataEncode_pair _ _] + simp only [Data.size, List.map_cons, List.map_nil, List.sum_cons, + List.sum_nil, add_zero] + have hb := bool_dataEncode_size_le_four (integerPayload z).1 + have hn := nat_encodedBitLength_le (integerPayload z).2 + rw [encodedBitLength_eq_dataSize] at hn + have hn' : (DataEncode.encode (integerPayload z).2).size ≤ + 2 + 4 * z.natAbs.size := by + simpa only [integerPayload_snd] using hn + omega + +theorem rational_encodedBitLength_le (q : ℚ) : + encodedBitLength ℚ q ≤ + 12 + 4 * (q.num.natAbs.size + q.den.size) := by + rw [encodedBitLength_eq_dataSize] + change (DataEncode.encode (rationalPayload q)).size ≤ _ + rw [show DataEncode.encode (rationalPayload q) = + Data.l [DataEncode.encode q.num, DataEncode.encode q.den] by + simpa only [rationalPayload] using DataEncode_pair q.num q.den] + simp only [Data.size, List.map_cons, List.map_nil, List.sum_cons, + List.sum_nil, add_zero] + have hz := integer_encodedBitLength_le q.num + have hd := nat_encodedBitLength_le q.den + rw [encodedBitLength_eq_dataSize] at hz hd + omega + +theorem one_le_rational_encodedBitLength (q : ℚ) : + 1 ≤ encodedBitLength ℚ q := by + have h := denominator_encodedBitLength_lt_rational q + omega + +theorem nat_size_le_succ_of_le_two_pow {n P : ℕ} + (h : n ≤ 2 ^ P) : n.size ≤ P + 1 := by + rw [Nat.size_le] + calc + n ≤ 2 ^ P := h + _ < 2 ^ (P + 1) := by + rw [pow_succ] + have hp : 0 < 2 ^ P := by positivity + omega + +theorem rat_abs_eq_numNatAbs_div_den (q : ℚ) : + abs q = (q.num.natAbs : ℚ) / q.den := by + rw [Rat.abs_def, Rat.divInt_eq_div] + norm_num + +theorem rat_num_natAbs_le_of_abs_and_den_bounds + {q : ℚ} {K P : ℕ} + (habs : abs q ≤ (2 : ℚ) ^ K) + (hden : q.den ≤ 2 ^ P) : + q.num.natAbs ≤ 2 ^ (K + P) := by + have hdenQ : (q.den : ℚ) ≤ (2 : ℚ) ^ P := by exact_mod_cast hden + have hnumQ : (q.num.natAbs : ℚ) ≤ + (2 : ℚ) ^ K * q.den := by + rw [rat_abs_eq_numNatAbs_div_den] at habs + rw [div_le_iff₀ (by positivity : (0 : ℚ) < q.den)] at habs + simpa only [mul_comm] using habs + have hboundQ : (q.num.natAbs : ℚ) ≤ (2 : ℚ) ^ (K + P) := by + calc + (q.num.natAbs : ℚ) ≤ (2 : ℚ) ^ K * q.den := hnumQ + _ ≤ (2 : ℚ) ^ K * (2 : ℚ) ^ P := + mul_le_mul_of_nonneg_left hdenQ (by positivity) + _ = (2 : ℚ) ^ (K + P) := by rw [pow_add] + exact_mod_cast hboundQ + +theorem rational_encodedBitLength_le_of_abs_and_den_bounds + {q : ℚ} {K P : ℕ} + (habs : abs q ≤ (2 : ℚ) ^ K) + (hden : q.den ≤ 2 ^ P) : + encodedBitLength ℚ q ≤ 20 + 4 * K + 8 * P := by + have hnum := rat_num_natAbs_le_of_abs_and_den_bounds habs hden + have hnumSize := nat_size_le_succ_of_le_two_pow hnum + have hdenSize := nat_size_le_succ_of_le_two_pow hden + have hencode := rational_encodedBitLength_le q + omega + +theorem dyadicFloor_den_le (p : ℕ) (q : ℚ) : + (dyadicFloor p q).den ≤ 2 ^ p := by + let z : ℤ := Int.floor (q * (2 : ℚ) ^ p) + have heq : dyadicFloor p q = Rat.divInt z (2 ^ p : ℤ) := by + rw [dyadicFloor] + dsimp only [z] + rw [show (2 : ℚ) ^ p = ((2 ^ p : ℕ) : ℚ) by norm_num, + ← Rat.intCast_div_eq_divInt] + norm_num + have hdvdZ : (((dyadicFloor p q).den : ℕ) : ℤ) ∣ (2 ^ p : ℤ) := by + rw [heq] + exact Rat.den_dvd z (2 ^ p : ℤ) + have hdvd : (dyadicFloor p q).den ∣ 2 ^ p := by + exact_mod_cast hdvdZ + exact Nat.le_of_dvd (by positivity) hdvd + +theorem abs_dyadicFloor_le_two_pow_succ {p K : ℕ} {q : ℚ} + (hq : abs q ≤ (2 : ℚ) ^ K) : + abs (dyadicFloor p q) ≤ (2 : ℚ) ^ (K + 1) := by + have hround := abs_dyadicFloor_le p q + have hmesh := dyadicMesh_le_one p + have hone : (1 : ℚ) ≤ (2 : ℚ) ^ K := one_le_pow₀ (by norm_num) + rw [pow_succ] + linarith + +/-- Exact encoding bound for the executable dyadic-floor primitive. -/ +theorem dyadicFloor_encodedBitLength_le {p K : ℕ} {q : ℚ} + (hq : abs q ≤ (2 : ℚ) ^ K) : + encodedBitLength ℚ (dyadicFloor p q) ≤ + 24 + 4 * K + 8 * p := by + have h := rational_encodedBitLength_le_of_abs_and_den_bounds + (abs_dyadicFloor_le_two_pow_succ (p := p) hq) + (dyadicFloor_den_le p q) + omega + +theorem roundedEllipsoidInflationFactor_den_dvd (d : ℕ) : + (1 + roundedEllipsoidInflation d).den ∣ 1024 * d ^ 4 := by + let N := 1024 * d ^ 4 + have heq : roundedEllipsoidInflation d = Rat.divInt 1 (N : ℤ) := by + rw [roundedEllipsoidInflation] + dsimp only [N] + rw [← Rat.intCast_div_eq_divInt] + norm_num + have hdenZ : (((roundedEllipsoidInflation d).den : ℕ) : ℤ) ∣ (N : ℤ) := by + rw [heq] + exact Rat.den_dvd 1 (N : ℤ) + have hden : (roundedEllipsoidInflation d).den ∣ N := by + exact_mod_cast hdenZ + have hadd : (1 + roundedEllipsoidInflation d).den ∣ + (roundedEllipsoidInflation d).den := by + simpa using Rat.add_den_dvd (1 : ℚ) (roundedEllipsoidInflation d) + exact hadd.trans hden + +theorem roundedEllipsoidInflationFactor_den_le {d : ℕ} (hd : 0 < d) : + (1 + roundedEllipsoidInflation d).den ≤ 1024 * d ^ 4 := + Nat.le_of_dvd (by positivity) (roundedEllipsoidInflationFactor_den_dvd d) + +theorem roundedEllipsoidInflationDenominator_le_two_pow (d : ℕ) : + (1024 * d ^ 4 : ℕ) ≤ 2 ^ (10 + 4 * d) := by + have hdq := natCast_le_two_pow_self d + have hd4 : (d : ℚ) ^ 4 ≤ ((2 : ℚ) ^ d) ^ 4 := + pow_le_pow_left₀ (by positivity) hdq 4 + have hq : ((1024 * d ^ 4 : ℕ) : ℚ) ≤ + ((2 ^ (10 + 4 * d) : ℕ) : ℚ) := by + norm_num only [Nat.cast_mul, Nat.cast_pow, Nat.cast_ofNat] + calc + (1024 : ℚ) * d ^ 4 ≤ 1024 * ((2 : ℚ) ^ d) ^ 4 := + mul_le_mul_of_nonneg_left hd4 (by norm_num) + _ = (2 : ℚ) ^ (10 + 4 * d) := by + rw [show (1024 : ℚ) = 2 ^ 10 by norm_num, ← pow_mul, ← pow_add] + congr 1 + omega + exact_mod_cast hq + +theorem inflatedDyadicRound_center_den_le {d p : ℕ} (η : ℚ) + (U : RationalEllipsoidState d) (i : Fin d) : + ((inflatedDyadicRound p η U).center i).den ≤ 2 ^ p := by + change (dyadicFloor p (U.center i)).den ≤ 2 ^ p + exact dyadicFloor_den_le p (U.center i) + +theorem inflatedDyadicRound_basis_den_le {d p : ℕ} (hd : 0 < d) + (U : RationalEllipsoidState d) (i j : Fin d) : + ((inflatedDyadicRound p (roundedEllipsoidInflation d) U).basis i j).den ≤ + 2 ^ (p + 10 + 4 * d) := by + let f : ℚ := 1 + roundedEllipsoidInflation d + let q : ℚ := dyadicFloor p (U.basis i j) + have hdiv : (f * q).den ∣ f.den * q.den := Rat.mul_den_dvd f q + have hprodPos : 0 < f.den * q.den := by positivity + have hden : (f * q).den ≤ f.den * q.den := Nat.le_of_dvd hprodPos hdiv + have hf : f.den ≤ 1024 * d ^ 4 := by + dsimp only [f] + exact roundedEllipsoidInflationFactor_den_le hd + have hq : q.den ≤ 2 ^ p := by + dsimp only [q] + exact dyadicFloor_den_le p (U.basis i j) + have hN := roundedEllipsoidInflationDenominator_le_two_pow d + change (f * q).den ≤ 2 ^ (p + 10 + 4 * d) + calc + (f * q).den ≤ f.den * q.den := hden + _ ≤ (1024 * d ^ 4) * 2 ^ p := Nat.mul_le_mul hf hq + _ ≤ 2 ^ (10 + 4 * d) * 2 ^ p := Nat.mul_le_mul_right _ hN + _ = 2 ^ (p + 10 + 4 * d) := by + rw [← pow_add] + congr 1 + omega + +theorem adaptiveRoundedEllipsoid_center_den_le {d : ℕ} + (U : RationalEllipsoidState d) (i : Fin d) : + ((adaptiveRoundedEllipsoid U).center i).den ≤ + 2 ^ roundedEllipsoidPrecision U := by + exact inflatedDyadicRound_center_den_le + (roundedEllipsoidInflation d) U i + +theorem adaptiveRoundedEllipsoid_basis_den_le {d : ℕ} (hd : 0 < d) + (U : RationalEllipsoidState d) (i j : Fin d) : + ((adaptiveRoundedEllipsoid U).basis i j).den ≤ + 2 ^ (roundedEllipsoidPrecision U + 10 + 4 * d) := by + exact inflatedDyadicRound_basis_den_le hd U i j + +theorem abs_center_entry_lt_rationalCenterAbsBound {d : ℕ} + (c : Fin d → ℚ) (i : Fin d) : + abs (c i) < rationalCenterAbsBound c := by + rw [rationalCenterAbsBound] + have hi : abs (c i) ≤ ∑ j, abs (c j) := + Finset.single_le_sum (fun j _ ↦ abs_nonneg (c j)) + (Finset.mem_univ i) + linarith + +theorem abs_center_entry_lt_rationalStateAbsBound {d : ℕ} + (E : RationalEllipsoidState d) (i : Fin d) : + abs (E.center i) < rationalStateAbsBound E := by + rw [rationalStateAbsBound] + exact (abs_center_entry_lt_rationalCenterAbsBound E.center i).trans_le + (le_add_of_nonneg_right (by + linarith [rationalMatrixAbsBound_one_le E.basis])) + +theorem abs_basis_entry_lt_rationalStateAbsBound {d : ℕ} + (E : RationalEllipsoidState d) (i j : Fin d) : + abs (E.basis i j) < rationalStateAbsBound E := by + rw [rationalStateAbsBound] + exact (abs_entry_lt_rationalMatrixAbsBound E.basis i j).trans_le + (le_add_of_nonneg_left (by + linarith [rationalCenterAbsBound_one_le E.center])) + +theorem adaptiveRoundedEllipsoid_center_encodedBitLength_le + {d K P : ℕ} (U : RationalEllipsoidState d) + (hM : rationalStateAbsBound (adaptiveRoundedEllipsoid U) ≤ (2 : ℚ) ^ K) + (hp : roundedEllipsoidPrecision U ≤ P) (i : Fin d) : + encodedBitLength ℚ ((adaptiveRoundedEllipsoid U).center i) ≤ + 20 + 4 * K + 8 * P := by + have habs : abs ((adaptiveRoundedEllipsoid U).center i) ≤ (2 : ℚ) ^ K := + (abs_center_entry_lt_rationalStateAbsBound + (adaptiveRoundedEllipsoid U) i).le.trans hM + have hden0 := adaptiveRoundedEllipsoid_center_den_le U i + have hpow : 2 ^ roundedEllipsoidPrecision U ≤ 2 ^ P := + Nat.pow_le_pow_right (by decide) hp + exact rational_encodedBitLength_le_of_abs_and_den_bounds habs + (hden0.trans hpow) + +theorem adaptiveRoundedEllipsoid_basis_encodedBitLength_le + {d K P : ℕ} (hd : 0 < d) (U : RationalEllipsoidState d) + (hM : rationalStateAbsBound (adaptiveRoundedEllipsoid U) ≤ (2 : ℚ) ^ K) + (hp : roundedEllipsoidPrecision U ≤ P) (i j : Fin d) : + encodedBitLength ℚ ((adaptiveRoundedEllipsoid U).basis i j) ≤ + 100 + 4 * K + 8 * P + 32 * d := by + have habs : abs ((adaptiveRoundedEllipsoid U).basis i j) ≤ (2 : ℚ) ^ K := + (abs_basis_entry_lt_rationalStateAbsBound + (adaptiveRoundedEllipsoid U) i j).le.trans hM + have hden0 := adaptiveRoundedEllipsoid_basis_den_le hd U i j + have hexp : roundedEllipsoidPrecision U + 10 + 4 * d ≤ + P + 10 + 4 * d := by omega + have hpow : 2 ^ (roundedEllipsoidPrecision U + 10 + 4 * d) ≤ + 2 ^ (P + 10 + 4 * d) := Nat.pow_le_pow_right (by decide) hexp + have h := rational_encodedBitLength_le_of_abs_and_den_bounds habs + (hden0.trans hpow) + omega + +/-- Canonical payload for a fixed-dimensional ellipsoid state. -/ +def rationalEllipsoidStatePayload {d : ℕ} (E : RationalEllipsoidState d) : + List ℚ × List (List ℚ) := + (List.ofFn E.center, rationalMatrixRows E.basis) + +def rationalEllipsoidStateEncodedBitLength {d : ℕ} + (E : RationalEllipsoidState d) : ℕ := + encodedBitLength (List ℚ × List (List ℚ)) + (rationalEllipsoidStatePayload E) + +theorem dataEncode_list_ofFn_size {d : ℕ} {α : Type} + [DataEncode α] (x : Fin d → α) : + (DataEncode.encode (List.ofFn x)).size = + 2 + ∑ i, (DataEncode.encode (x i)).size := by + change (Data.l ((List.ofFn x).map DataEncode.encode)).size = _ + rw [Data.size] + simpa only [List.map_ofFn, List.sum_ofFn, Function.comp_apply] + +theorem rationalMatrixInput_encodedBitLength_eq {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) : + encodedBitLength RationalMatrixInput ⟨n, A⟩ = + 4 + encodedBitLength ℕ n + 2 * n + + ∑ i, ∑ j, encodedBitLength ℚ (A i j) := by + rw [encodedBitLength_eq_dataSize] + change (DataEncode.encode (rationalMatrixInputPayload ⟨n, A⟩)).size = _ + simp only [rationalMatrixInputPayload, DataEncode_pair, Data.size, + List.map_cons, List.map_nil, List.sum_cons, List.sum_nil, add_zero, + rationalMatrixRows, encodedBitLength_eq_dataSize] + rw [dataEncode_list_ofFn_size] + simp_rw [dataEncode_list_ofFn_size] + have htwo : (∑ _i : Fin n, (2 : ℕ)) = 2 * n := by + simp [mul_comm] + rw [Finset.sum_add_distrib, htwo] + omega + +theorem rationalMatrixEntryBitBound_le_inputLength {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) : + rationalMatrixEntryBitBound A ≤ + encodedBitLength RationalMatrixInput ⟨n, A⟩ := by + rw [rationalMatrixInput_encodedBitLength_eq, rationalMatrixEntryBitBound] + omega + +theorem matrixDimensionSq_le_inputLength {n : ℕ} + (A : Matrix (Fin n) (Fin n) ℚ) : + n ^ 2 ≤ encodedBitLength RationalMatrixInput ⟨n, A⟩ := by + have hentries : n ^ 2 ≤ + ∑ i, ∑ j, encodedBitLength ℚ (A i j) := by + calc + n ^ 2 = ∑ _i : Fin n, ∑ _j : Fin n, 1 := by simp; ring + _ ≤ ∑ i, ∑ j, encodedBitLength ℚ (A i j) := by + apply Finset.sum_le_sum + intro i _ + apply Finset.sum_le_sum + intro j _ + exact one_le_rational_encodedBitLength (A i j) + rw [rationalMatrixInput_encodedBitLength_eq] + omega + +theorem rationalEllipsoidStateEncodedBitLength_eq {d : ℕ} + (E : RationalEllipsoidState d) : + rationalEllipsoidStateEncodedBitLength E = + 6 + (∑ i, encodedBitLength ℚ (E.center i)) + 2 * d + + ∑ i, ∑ j, encodedBitLength ℚ (E.basis i j) := by + rw [rationalEllipsoidStateEncodedBitLength, + encodedBitLength_eq_dataSize] + simp only [rationalEllipsoidStatePayload, DataEncode_pair, Data.size, + List.map_cons, List.map_nil, List.sum_cons, List.sum_nil, add_zero, + rationalMatrixRows, encodedBitLength_eq_dataSize] + rw [dataEncode_list_ofFn_size, dataEncode_list_ofFn_size] + simp_rw [dataEncode_list_ofFn_size] + have htwo : (∑ _i : Fin d, (2 : ℕ)) = 2 * d := by + simp [mul_comm] + rw [Finset.sum_add_distrib] + rw [htwo] + omega + +/-- Total encoding size of one stored rounded state. -/ +theorem adaptiveRoundedEllipsoid_state_encodedBitLength_le + {d K P : ℕ} (hd : 0 < d) (U : RationalEllipsoidState d) + (hM : rationalStateAbsBound (adaptiveRoundedEllipsoid U) ≤ (2 : ℚ) ^ K) + (hp : roundedEllipsoidPrecision U ≤ P) : + rationalEllipsoidStateEncodedBitLength (adaptiveRoundedEllipsoid U) ≤ + 6 + d * (20 + 4 * K + 8 * P) + 2 * d + + d ^ 2 * (100 + 4 * K + 8 * P + 32 * d) := by + rw [rationalEllipsoidStateEncodedBitLength_eq] + have hc : (∑ i : Fin d, encodedBitLength ℚ + ((adaptiveRoundedEllipsoid U).center i)) ≤ + ∑ _i : Fin d, (20 + 4 * K + 8 * P) := by + apply Finset.sum_le_sum + intro i _ + exact adaptiveRoundedEllipsoid_center_encodedBitLength_le U hM hp i + have hB : (∑ i : Fin d, ∑ j : Fin d, encodedBitLength ℚ + ((adaptiveRoundedEllipsoid U).basis i j)) ≤ + ∑ _i : Fin d, ∑ _j : Fin d, + (100 + 4 * K + 8 * P + 32 * d) := by + apply Finset.sum_le_sum + intro i _ + apply Finset.sum_le_sum + intro j _ + exact adaptiveRoundedEllipsoid_basis_encodedBitLength_le hd U hM hp i j + have hc' : (∑ i : Fin d, encodedBitLength ℚ + ((adaptiveRoundedEllipsoid U).center i)) ≤ + d * (20 + 4 * K + 8 * P) := by + simpa only [Finset.sum_const, Finset.card_univ, Fintype.card_fin, + nsmul_eq_mul] using hc + have hB' : (∑ i : Fin d, ∑ j : Fin d, encodedBitLength ℚ + ((adaptiveRoundedEllipsoid U).basis i j)) ≤ + d * (d * (100 + 4 * K + 8 * P + 32 * d)) := by + simpa only [Finset.sum_const, Finset.card_univ, Fintype.card_fin, + nsmul_eq_mul] using hB + calc + 6 + (∑ i, encodedBitLength ℚ + ((adaptiveRoundedEllipsoid U).center i)) + 2 * d + + ∑ i, ∑ j, encodedBitLength ℚ + ((adaptiveRoundedEllipsoid U).basis i j) ≤ + 6 + d * (20 + 4 * K + 8 * P) + 2 * d + + d * (d * (100 + 4 * K + 8 * P + 32 * d)) := by omega + _ = 6 + d * (20 + 4 * K + 8 * P) + 2 * d + + d ^ 2 * (100 + 4 * K + 8 * P + 32 * d) := by ring + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/RationalEpigraphOracle.lean b/LeanPool/BeyondBethe/BeyondBethe/RationalEpigraphOracle.lean new file mode 100644 index 0000000000..9067b5eac9 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/RationalEpigraphOracle.lean @@ -0,0 +1,182 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.RationalLinearOracle +import Mathlib.Tactic + +/-! # Rational Epigraph Oracle -/ + +open scoped BigOperators + +namespace BeyondBethe + +/-! +# Directed rational cuts for a convex epigraph + +The first `d` coordinates are base variables and the last coordinate is the +epigraph height. A lower objective endpoint and an approximate gradient give +an entirely rational violation test. When the test succeeds, convexity and +the explicit gradient-error budget prove that the returned normal is a strict +central cut for the exact epigraph. +-/ + +def epigraphBase {d : ℕ} {R : Type*} + (x : Fin (d + 1) → R) : Fin d → R := + fun i ↦ x i.castSucc + +def epigraphHeight {d : ℕ} {R : Type*} + (x : Fin (d + 1) → R) : R := + x (Fin.last d) + +def epigraphNormal {d : ℕ} {R : Type*} [Neg R] [OfNat R 1] + (g : Fin d → R) : Fin (d + 1) → R := + Fin.snoc g (-1) + +@[simp] theorem epigraphNormal_castSucc {d : ℕ} {R : Type*} + [Neg R] [OfNat R 1] (g : Fin d → R) (i : Fin d) : + epigraphNormal g i.castSucc = g i := by + simp [epigraphNormal] + +@[simp] theorem epigraphNormal_last {d : ℕ} {R : Type*} + [Neg R] [OfNat R 1] (g : Fin d → R) : + epigraphNormal g (Fin.last d) = -1 := by + simp [epigraphNormal] + +theorem epigraphNormal_ne_zero {d : ℕ} (g : Fin d → ℚ) : + epigraphNormal g ≠ 0 := by + intro hzero + have hlast := congrFun hzero (Fin.last d) + norm_num at hlast + +/-- Entrywise `l1` size of a vector. -/ +def vectorL1 {d : ℕ} (x : Fin d → ℝ) : ℝ := + ∑ i, abs (x i) + +theorem vectorL1_nonneg {d : ℕ} (x : Fin d → ℝ) : + 0 ≤ vectorL1 x := + Finset.sum_nonneg fun i _ ↦ abs_nonneg (x i) + +theorem finiteDot_sub_le_error_mul_vectorL1 {d : ℕ} + {G H D : Fin d → ℝ} {e : ℝ} + (herr : ∀ i, abs (H i - G i) ≤ e) : + finiteDot H D - finiteDot G D ≤ e * vectorL1 D := by + rw [finiteDot, finiteDot, vectorL1, ← Finset.sum_sub_distrib, + Finset.mul_sum] + apply Finset.sum_le_sum + intro i _ + have hpoint : (H i - G i) * D i ≤ e * abs (D i) := by + calc + (H i - G i) * D i ≤ abs ((H i - G i) * D i) := le_abs_self _ + _ = abs (H i - G i) * abs (D i) := abs_mul _ _ + _ ≤ e * abs (D i) := + mul_le_mul_of_nonneg_right (herr i) (abs_nonneg _) + convert hpoint using 1 <;> ring + +/-- Dot product of an epigraph normal with an epigraph displacement. -/ +theorem epigraphNormal_dot_displacement {d : ℕ} + (H : Fin d → ℝ) (z q : Fin (d + 1) → ℝ) : + finiteDot (epigraphNormal H) (fun i ↦ z i - q i) = + finiteDot H (fun i ↦ epigraphBase z i - epigraphBase q i) - + (epigraphHeight z - epigraphHeight q) := by + rw [finiteDot, Fin.sum_univ_castSucc] + simp [finiteDot, epigraphBase, epigraphHeight] + ring + +/-- Vector version of the tolerant supporting-hyperplane estimate. -/ +theorem approximateVectorEpigraphCut_valid {d : ℕ} + {fY fZ lower t s e Dmax : ℝ} + {G H D : Fin d → ℝ} + (hsupport : fY + finiteDot G D ≤ fZ) + (hlower : lower ≤ fY) + (hgradient : ∀ i, abs (H i - G i) ≤ e) + (hD : vectorL1 D ≤ Dmax) + (he : 0 ≤ e) (hepigraph : fZ ≤ s) : + finiteDot H D - (s - t) ≤ t - lower + e * Dmax := by + have hpair := finiteDot_sub_le_error_mul_vectorL1 (D := D) hgradient + have hscale := mul_le_mul_of_nonneg_left hD he + linarith + +/-- Executable lower endpoint and executable approximate gradient. -/ +structure DirectedEpigraphData (d : ℕ) where + lower : (Fin d → ℚ) → ℚ + gradient : (Fin d → ℚ) → Fin d → ℚ + +/-- The nonlinear oracle accepts unless the rational lower endpoint exceeds +the query height by more than the full gradient-error budget. -/ +def directedEpigraphOracle {d : ℕ} + (data : DirectedEpigraphData d) (e Dmax : ℚ) : + RationalCentralOracle (d + 1) := + fun E ↦ + let y := epigraphBase E.center + let t := epigraphHeight E.center + if t + e * Dmax < data.lower y then + .cut (epigraphNormal (data.gradient y)) + else .accept + +theorem directedEpigraphOracle_cut_ne_zero {d : ℕ} + (data : DirectedEpigraphData d) (e Dmax : ℚ) + (E : RationalEllipsoidState (d + 1)) + {a : Fin (d + 1) → ℚ} + (hresponse : directedEpigraphOracle data e Dmax E = .cut a) : + a ≠ 0 := by + rw [directedEpigraphOracle] at hresponse + split at hresponse + · cases hresponse + exact epigraphNormal_ne_zero _ + · contradiction + +/-- A reported nonlinear cut is valid for any exact epigraph point satisfying +the displayed support, directed-value, directed-gradient, and radius bounds. -/ +theorem directedEpigraphOracle_cut_valid {d : ℕ} + (data : DirectedEpigraphData d) {e Dmax : ℚ} + (he : 0 ≤ e) (E : RationalEllipsoidState (d + 1)) + {a : Fin (d + 1) → ℚ} + (hresponse : directedEpigraphOracle data e Dmax E = .cut a) + {fY fZ : ℝ} {G : Fin d → ℝ} {z : Fin (d + 1) → ℝ} + (hsupport : fY + finiteDot G + (fun i ↦ epigraphBase z i - + ((epigraphBase E.center i : ℚ) : ℝ)) ≤ fZ) + (hlower : (data.lower (epigraphBase E.center) : ℝ) ≤ fY) + (hgradient : ∀ i, abs + ((data.gradient (epigraphBase E.center) i : ℝ) - G i) ≤ (e : ℝ)) + (hD : vectorL1 + (fun i ↦ epigraphBase z i - + ((epigraphBase E.center i : ℚ) : ℝ)) ≤ + (Dmax : ℝ)) + (hepigraph : fZ ≤ epigraphHeight z) : + a ≠ 0 ∧ finiteDot (fun i ↦ (a i : ℝ)) + (fun i ↦ z i - rationalCenterReal E i) < 0 := by + rw [directedEpigraphOracle] at hresponse + split at hresponse <;> rename_i hviolation + · cases hresponse + refine ⟨epigraphNormal_ne_zero _, ?_⟩ + have hbound := approximateVectorEpigraphCut_valid + (t := ((epigraphHeight E.center : ℚ) : ℝ)) + (s := epigraphHeight z) hsupport hlower hgradient hD + (Rat.cast_nonneg.mpr he) hepigraph + have hviolationReal : + ((epigraphHeight E.center : ℚ) : ℝ) + (e : ℝ) * (Dmax : ℝ) < + (data.lower (epigraphBase E.center) : ℝ) := by + exact_mod_cast hviolation + have hdot : finiteDot + (fun i ↦ ((epigraphNormal + (data.gradient (epigraphBase E.center)) i : ℚ) : ℝ)) + (fun i ↦ z i - rationalCenterReal E i) = + finiteDot + (fun i ↦ (data.gradient (epigraphBase E.center) i : ℝ)) + (fun i ↦ epigraphBase z i - + ((epigraphBase E.center i : ℚ) : ℝ)) - + (epigraphHeight z - ((epigraphHeight E.center : ℚ) : ℝ)) := by + rw [finiteDot, Fin.sum_univ_castSucc] + simp [finiteDot, epigraphNormal, rationalCenterReal, + epigraphBase, epigraphHeight] + ring + rw [hdot] + norm_num only [Rat.cast_mul] at hbound + linarith + · contradiction + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/RationalFeasibility.lean b/LeanPool/BeyondBethe/BeyondBethe/RationalFeasibility.lean new file mode 100644 index 0000000000..60a99d965f --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/RationalFeasibility.lean @@ -0,0 +1,548 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.RationalEllipsoid +import LeanPool.BeyondBethe.BeyondBethe.AlgorithmicSpec +import Mathlib.Tactic + +/-! # Rational Feasibility -/ + +open scoped BigOperators + +namespace BeyondBethe + +/-! +# An executable rational central-cut feasibility loop + +This file connects the square-root-free ellipsoid update to an actual finite +algorithm. The oracle either accepts the current rational center or returns a +rational central cut. The generic correctness theorem is deliberately +elementary: a valid cut preserves every target point, and a run long enough to +violate the determinant sandwich cannot be exhausted. +-/ + +/-- A target point belongs to the real ellipsoid represented by a rational +state if it has a real unit-ball preimage. -/ +def RationalEllipsoidContains {d : ℕ} + (E : RationalEllipsoidState d) (x : Fin d → ℝ) : Prop := + ∃ y : Fin d → ℝ, finiteNormSq y ≤ 1 ∧ rationalEllipsoidPoint E y = x + +/-- Real cast of a rational center. -/ +def rationalCenterReal {d : ℕ} (E : RationalEllipsoidState d) : Fin d → ℝ := + fun i ↦ (E.center i : ℝ) + +/-- Rational representation of the Euclidean ball of radius `R` centered at +`c`. -/ +def rationalBallEllipsoid (d : ℕ) (c : Fin d → ℚ) (R : ℚ) : + RationalEllipsoidState d where + center := c + basis := fun i j ↦ if i = j then R else 0 + +@[simp] theorem rationalBallEllipsoid_center {d : ℕ} + (c : Fin d → ℚ) (R : ℚ) : + (rationalBallEllipsoid d c R).center = c := rfl + +theorem rationalBallEllipsoid_basis {d : ℕ} + (c : Fin d → ℚ) (R : ℚ) : + (rationalBallEllipsoid d c R).basis = Matrix.diagonal (fun _ ↦ R) := by + ext i j + by_cases hij : i = j <;> simp [rationalBallEllipsoid, hij] + +theorem det_rationalBallEllipsoid {d : ℕ} + (c : Fin d → ℚ) (R : ℚ) : + Matrix.det (rationalBallEllipsoid d c R).basis = R ^ d := by + rw [rationalBallEllipsoid_basis, Matrix.det_diagonal] + simp + +/-- Every point in the ordinary radius-`R` ball has its explicit normalized +coordinate in the rational ball ellipsoid. -/ +theorem rationalBallEllipsoid_contains {d : ℕ} + (c : Fin d → ℚ) {R : ℚ} (hR : 0 < R) {x : Fin d → ℝ} + (hx : finiteNormSq + (fun i ↦ x i - (c i : ℝ)) ≤ (R : ℝ) ^ 2) : + RationalEllipsoidContains (rationalBallEllipsoid d c R) x := by + let y : Fin d → ℝ := fun i ↦ (x i - (c i : ℝ)) / (R : ℝ) + have hRreal : 0 < (R : ℝ) := Rat.cast_pos.mpr hR + have hyform : y = fun i ↦ ((R : ℝ)⁻¹) * (x i - (c i : ℝ)) := by + funext i + simp [y, div_eq_mul_inv, mul_comm] + have hynorm : finiteNormSq y ≤ 1 := by + rw [hyform, finiteNormSq_smul] + have hR2 : 0 < (R : ℝ) ^ 2 := sq_pos_of_pos hRreal + rw [inv_pow] + simpa [div_eq_mul_inv, mul_comm] using (div_le_one hR2).2 hx + refine ⟨y, hynorm, ?_⟩ + ext i + rw [rationalEllipsoidPoint] + have hRne : (R : ℝ) ≠ 0 := hRreal.ne' + change (c i : ℝ) + + ∑ j, ((if i = j then R else 0 : ℚ) : ℝ) * + ((x j - (c j : ℝ)) / (R : ℝ)) = x i + simp_rw [show ∀ j : Fin d, + ((if i = j then R else 0 : ℚ) : ℝ) = + if i = j then (R : ℝ) else 0 by + intro j + by_cases hij : i = j <;> simp [hij]] + simp + field_simp [hRne] + ring + +/-- Binary exponent sufficient to dominate the determinant ratio between a +radius-`R` outer ball and a radius-`r` inner ball. -/ +def rationalBallDyadicExponent (d : ℕ) (R r : ℚ) : ℕ := + d ^ 2 + encodedBitLength ℚ R * d + encodedBitLength ℚ r * d + 1 + +theorem factorial_le_two_pow_sq (d : ℕ) : + d.factorial ≤ 2 ^ (d ^ 2) := by + calc + d.factorial ≤ d ^ d := Nat.factorial_le_pow d + _ ≤ (2 ^ d) ^ d := Nat.pow_le_pow_left d.lt_two_pow_self.le d + _ = 2 ^ (d ^ 2) := by simp [pow_mul, pow_two] + +/-- The dyadic exponent computed from ordinary encodings makes the initial +determinant upper bound strictly smaller than the inner-ball lower bound. -/ +theorem rationalBallDyadicExponent_works {d : ℕ} (hd : 0 < d) + {R r : ℚ} (hR : 0 < R) (hr : 0 < r) : + (d.factorial : ℚ) * R ^ d * + (1 / 2 : ℚ) ^ rationalBallDyadicExponent d R r < r ^ d := by + let LR := encodedBitLength ℚ R + let Lr := encodedBitLength ℚ r + let A := d ^ 2 + LR * d + let C := Lr * d + have hfac : (d.factorial : ℚ) ≤ (2 : ℚ) ^ (d ^ 2) := by + exact_mod_cast factorial_le_two_pow_sq d + have hRup : R < (2 : ℚ) ^ LR := by + simpa only [LR] using positive_rational_lt_two_pow_encodedBitLength hR + have hRpow : R ^ d < (2 : ℚ) ^ (LR * d) := by + calc + R ^ d < ((2 : ℚ) ^ LR) ^ d := + pow_lt_pow_left₀ hRup hR.le hd.ne' + _ = (2 : ℚ) ^ (LR * d) := by rw [← pow_mul] + have hrlow : (1 / 2 : ℚ) ^ Lr < r := by + simpa only [Lr] using dyadic_encodedBitLength_lt_positive_rational hr + have hrpow : ((1 / 2 : ℚ) ^ Lr) ^ d < r ^ d := + pow_lt_pow_left₀ hrlow (by positivity) hd.ne' + have hM : rationalBallDyadicExponent d R r = A + C + 1 := by + simp only [rationalBallDyadicExponent, A, C, LR, Lr] + have hupper : + (d.factorial : ℚ) * R ^ d * + (1 / 2 : ℚ) ^ rationalBallDyadicExponent d R r < + (2 : ℚ) ^ (d ^ 2) * (2 : ℚ) ^ (LR * d) * + (1 / 2 : ℚ) ^ rationalBallDyadicExponent d R r := by + have hdyadicPos : 0 < + (1 / 2 : ℚ) ^ rationalBallDyadicExponent d R r := by positivity + have hfactorialPos : (0 : ℚ) < d.factorial := by positivity + have hrightNonneg : (0 : ℚ) ≤ (2 : ℚ) ^ (LR * d) := by positivity + have hproduct : (d.factorial : ℚ) * R ^ d < + (2 : ℚ) ^ (d ^ 2) * (2 : ℚ) ^ (LR * d) := by + exact (mul_lt_mul_of_pos_left hRpow hfactorialPos).trans_le + (mul_le_mul_of_nonneg_right hfac hrightNonneg) + exact mul_lt_mul_of_pos_right + hproduct hdyadicPos + have hcollapse : + (2 : ℚ) ^ (d ^ 2) * (2 : ℚ) ^ (LR * d) * + (1 / 2 : ℚ) ^ rationalBallDyadicExponent d R r = + (1 / 2 : ℚ) ^ (C + 1) := by + have htwo : (2 : ℚ) ^ (d ^ 2) * (2 : ℚ) ^ (LR * d) = + (2 : ℚ) ^ A := by + rw [← pow_add] + have hcancel : (2 : ℚ) ^ A * (1 / 2 : ℚ) ^ A = 1 := by + rw [← mul_pow] + norm_num + calc + (2 : ℚ) ^ (d ^ 2) * (2 : ℚ) ^ (LR * d) * + (1 / 2 : ℚ) ^ rationalBallDyadicExponent d R r = + (2 : ℚ) ^ A * (1 / 2 : ℚ) ^ (A + (C + 1)) := by + rw [htwo, hM] + congr 2 <;> omega + _ = (2 : ℚ) ^ A * + ((1 / 2 : ℚ) ^ A * (1 / 2 : ℚ) ^ (C + 1)) := by + congr 1 + rw [pow_add] + _ = (1 / 2 : ℚ) ^ (C + 1) := by + rw [← mul_assoc, hcancel, one_mul] + have hstep : (1 / 2 : ℚ) ^ (C + 1) < (1 / 2 : ℚ) ^ C := by + rw [pow_succ] + have hpos : 0 < (1 / 2 : ℚ) ^ C := by positivity + nlinarith + calc + (d.factorial : ℚ) * R ^ d * + (1 / 2 : ℚ) ^ rationalBallDyadicExponent d R r < + (2 : ℚ) ^ (d ^ 2) * (2 : ℚ) ^ (LR * d) * + (1 / 2 : ℚ) ^ rationalBallDyadicExponent d R r := hupper + _ = (1 / 2 : ℚ) ^ (C + 1) := hcollapse + _ < (1 / 2 : ℚ) ^ C := hstep + _ = ((1 / 2 : ℚ) ^ Lr) ^ d := by rw [← pow_mul] + _ < r ^ d := hrpow + +/-- Real determinant form consumed by the generic feasibility theorem. -/ +theorem rationalBallEllipsoid_dyadic_budget {d : ℕ} (hd : 0 < d) + (c : Fin d → ℚ) {R r : ℚ} (hR : 0 < R) (hr : 0 < r) : + d.factorial * + abs ((Matrix.det (rationalBallEllipsoid d c R).basis : ℚ) : ℝ) * + (1 / 2 : ℝ) ^ rationalBallDyadicExponent d R r < (r : ℝ) ^ d := by + have hq := rationalBallDyadicExponent_works hd hR hr + rw [det_rationalBallEllipsoid, Rat.cast_pow, + abs_of_pos (pow_pos (Rat.cast_pos.mpr hR) _)] + have hcast : + (((d.factorial : ℚ) * R ^ d * + (1 / 2 : ℚ) ^ rationalBallDyadicExponent d R r : ℚ) : ℝ) < + ((r ^ d : ℚ) : ℝ) := (Rat.cast_lt (K := ℝ)).mpr hq + norm_num only [Rat.cast_mul, Rat.cast_pow, Rat.cast_div, Rat.cast_one, + Rat.cast_ofNat, Rat.cast_natCast] at hcast + simpa using hcast + +/-- Pullback identity for the physical displacement from the ellipsoid +center. -/ +theorem physicalDot_point_sub_center_eq_pulledDot {d : ℕ} + (E : RationalEllipsoidState d) (a : Fin d → ℚ) (y : Fin d → ℝ) : + finiteDot (fun i ↦ (a i : ℝ)) + (fun i ↦ rationalEllipsoidPoint E y i - rationalCenterReal E i) = + finiteDot (fun j ↦ (rationalPulledBackNormal E a j : ℝ)) y := by + rw [finiteDot, finiteDot] + simp only [rationalEllipsoidPoint, rationalCenterReal, add_sub_cancel_left] + simp_rw [Finset.mul_sum] + rw [Finset.sum_comm] + apply Finset.sum_congr rfl + intro j _ + rw [cast_rationalPulledBackNormal] + push_cast + rw [Finset.sum_mul] + apply Finset.sum_congr rfl + intro i _ + ring + +theorem rationalPulledBackNormal_eq_transpose_mulVec {d : ℕ} + (E : RationalEllipsoidState d) (a : Fin d → ℚ) : + rationalPulledBackNormal E a = E.basis.transpose.mulVec a := by + ext j + simp [rationalPulledBackNormal, Matrix.mulVec, dotProduct, + Matrix.transpose_apply] + +/-- A nonsingular stored basis cannot annihilate a nonzero physical normal. -/ +theorem rationalPulledBackNormal_ne_zero_of_det_ne_zero {d : ℕ} + (E : RationalEllipsoidState d) (a : Fin d → ℚ) + (hdet : Matrix.det E.basis ≠ 0) (ha : a ≠ 0) : + rationalPulledBackNormal E a ≠ 0 := by + rw [rationalPulledBackNormal_eq_transpose_mulVec] + intro hzero + apply ha + have hdetT : Matrix.det E.basis.transpose ≠ 0 := by + simpa [Matrix.det_transpose] using hdet + have hunit : IsUnit (Matrix.det E.basis.transpose) := + (isUnit_iff_ne_zero).2 hdetT + have hinv := Matrix.nonsing_inv_mul E.basis.transpose hunit + calc + a = Matrix.mulVec (1 : Matrix (Fin d) (Fin d) ℚ) a := by simp + _ = Matrix.mulVec (E.basis.transpose⁻¹ * E.basis.transpose) a := by + rw [hinv] + _ = Matrix.mulVec E.basis.transpose⁻¹ + (Matrix.mulVec E.basis.transpose a) := by + rw [Matrix.mulVec_mulVec] + _ = 0 := by rw [hzero]; simp + +theorem det_rationalEllipsoidCentralUpdate_ne_zero {d : ℕ} (hd : 0 < d) + (E : RationalEllipsoidState d) (a : Fin d → ℚ) + (hdet : Matrix.det E.basis ≠ 0) + (hpulled : rationalPulledBackNormal E a ≠ 0) : + Matrix.det (rationalEllipsoidCentralUpdate E a).basis ≠ 0 := by + rw [det_rationalEllipsoidCentralUpdate hd E a hpulled] + exact mul_ne_zero hdet (mul_ne_zero + (pow_ne_zero _ (rationalEllipsoidPerpScale_pos d).ne') + (rationalEllipsoidParallelScale_pos hd).ne') + +/-- A valid physical central cut preserves any contained target point. -/ +theorem rationalEllipsoidCentralUpdate_contains_point {d : ℕ} (hd : 0 < d) + (E : RationalEllipsoidState d) (a : Fin d → ℚ) {x : Fin d → ℝ} + (hnonzero : rationalPulledBackNormal E a ≠ 0) + (hcontains : RationalEllipsoidContains E x) + (hcut : finiteDot (fun i ↦ (a i : ℝ)) + (fun i ↦ x i - rationalCenterReal E i) ≤ 0) : + RationalEllipsoidContains (rationalEllipsoidCentralUpdate E a) x := by + obtain ⟨y, hy, hpoint⟩ := hcontains + have hpulled : finiteDot + (fun j ↦ (rationalPulledBackNormal E a j : ℝ)) y ≤ 0 := by + rw [← physicalDot_point_sub_center_eq_pulledDot E a y] + simpa only [hpoint] using hcut + obtain ⟨y', hy', hpoint'⟩ := + rationalEllipsoidCentralUpdate_contains hd E a hnonzero hy hpulled + exact ⟨y', hy', hpoint'.trans hpoint⟩ + +/-- The two possible responses of the central-cut oracle. -/ +inductive RationalCentralOracleResponse (d : ℕ) + | accept + | cut (normal : Fin d → ℚ) +deriving DecidableEq + +/-- An oracle is executable data: it reads the complete rational ellipsoid +state and either accepts its center or returns a rational cut normal. -/ +abbrev RationalCentralOracle (d : ℕ) := + RationalEllipsoidState d → RationalCentralOracleResponse d + +/-- Semantic validity of every cut returned by an oracle for a target set +`K`. This is a property to be proved for the concrete oracle, not an +assumption built into the algorithm. -/ +def RationalCentralOracleValid {d : ℕ} + (K : (Fin d → ℝ) → Prop) (oracle : RationalCentralOracle d) : Prop := + ∀ E a, oracle E = .cut a → + a ≠ 0 ∧ + ∀ x, K x → finiteDot (fun i ↦ (a i : ℝ)) + (fun i ↦ x i - rationalCenterReal E i) ≤ 0 + +/-- Optional semantic condition on acceptance. Concrete weak oracles use +`Good` for membership in the prescribed enlargement. -/ +def RationalCentralOracleAcceptsOnly {d : ℕ} + (Good : (Fin d → ℚ) → Prop) (oracle : RationalCentralOracle d) : Prop := + ∀ E, oracle E = .accept → Good E.center + +/-- Result of the bounded feasibility loop. -/ +inductive RationalFeasibilityResult (d : ℕ) + | accepted (point : Fin d → ℚ) + | exhausted (state : RationalEllipsoidState d) + +/-- Execute at most `budget` oracle calls. -/ +def runRationalFeasibility {d : ℕ} + (oracle : RationalCentralOracle d) : + ℕ → RationalEllipsoidState d → RationalFeasibilityResult d + | 0, E => .exhausted E + | budget + 1, E => + match oracle E with + | .accept => .accepted E.center + | .cut a => + runRationalFeasibility oracle budget + (rationalEllipsoidCentralUpdate E a) + +/-- The exact list of cuts executed before acceptance or exhaustion. -/ +def rationalFeasibilityCuts {d : ℕ} + (oracle : RationalCentralOracle d) : + ℕ → RationalEllipsoidState d → List (Fin d → ℚ) + | 0, _ => [] + | budget + 1, E => + match oracle E with + | .accept => [] + | .cut a => a :: rationalFeasibilityCuts oracle budget + (rationalEllipsoidCentralUpdate E a) + +theorem runRationalFeasibility_acceptsOnly {d : ℕ} + {Good : (Fin d → ℚ) → Prop} {oracle : RationalCentralOracle d} + (haccept : RationalCentralOracleAcceptsOnly Good oracle) + {budget : ℕ} {E : RationalEllipsoidState d} {x : Fin d → ℚ} + (hrun : runRationalFeasibility oracle budget E = .accepted x) : + Good x := by + induction budget generalizing E with + | zero => simp [runRationalFeasibility] at hrun + | succ budget ih => + rw [runRationalFeasibility] at hrun + split at hrun <;> rename_i hresponse + · cases hrun + exact haccept E hresponse + · exact ih hrun + +/-- If the loop exhausts its budget, every oracle call was a cut. -/ +theorem rationalFeasibilityCuts_length_of_exhausted {d : ℕ} + (oracle : RationalCentralOracle d) {budget : ℕ} + {E E' : RationalEllipsoidState d} + (hrun : runRationalFeasibility oracle budget E = .exhausted E') : + (rationalFeasibilityCuts oracle budget E).length = budget := by + induction budget generalizing E E' with + | zero => simp [rationalFeasibilityCuts] + | succ budget ih => + rw [runRationalFeasibility] at hrun + split at hrun <;> rename_i hresponse + · contradiction + · rw [rationalFeasibilityCuts, hresponse] + simp only [List.length_cons] + rw [ih hrun] + +/-- The state returned on exhaustion is exactly the iteration of the recorded +cut list. -/ +theorem rationalEllipsoidIterate_cuts_eq_of_exhausted {d : ℕ} + (oracle : RationalCentralOracle d) {budget : ℕ} + {E E' : RationalEllipsoidState d} + (hrun : runRationalFeasibility oracle budget E = .exhausted E') : + rationalEllipsoidIterate E (rationalFeasibilityCuts oracle budget E) = E' := by + induction budget generalizing E E' with + | zero => simpa [runRationalFeasibility, rationalFeasibilityCuts] using hrun + | succ budget ih => + rw [runRationalFeasibility] at hrun + split at hrun <;> rename_i hresponse + · contradiction + · rw [rationalFeasibilityCuts, hresponse, + rationalEllipsoidIterate] + exact ih hrun + +/-- Validity of the concrete oracle supplies every nonzero-normal side +condition in an exhausted trace. -/ +theorem rationalFeasibilityCuts_nonzero_of_exhausted {d : ℕ} + {K : (Fin d → ℝ) → Prop} {oracle : RationalCentralOracle d} + (hvalid : RationalCentralOracleValid K oracle) + (hd : 0 < d) + {budget : ℕ} {E E' : RationalEllipsoidState d} + (hdet : Matrix.det E.basis ≠ 0) + (hrun : runRationalFeasibility oracle budget E = .exhausted E') : + RationalEllipsoidCutsNonzero E + (rationalFeasibilityCuts oracle budget E) := by + induction budget generalizing E E' with + | zero => simp [rationalFeasibilityCuts, RationalEllipsoidCutsNonzero] + | succ budget ih => + rw [runRationalFeasibility] at hrun + split at hrun <;> rename_i hresponse + · contradiction + · rw [rationalFeasibilityCuts, hresponse] + change rationalPulledBackNormal E _ ≠ 0 ∧ _ + have hpulled := rationalPulledBackNormal_ne_zero_of_det_ne_zero + E _ hdet (hvalid E _ hresponse).1 + exact ⟨hpulled, ih + (det_rationalEllipsoidCentralUpdate_ne_zero hd E _ hdet hpulled) + hrun⟩ + +/-- Every target point contained initially remains contained if a valid loop +exhausts its budget. -/ +theorem runRationalFeasibility_preserves_target_of_exhausted {d : ℕ} + (hd : 0 < d) {K : (Fin d → ℝ) → Prop} + {oracle : RationalCentralOracle d} + (hvalid : RationalCentralOracleValid K oracle) + {budget : ℕ} {E E' : RationalEllipsoidState d} + (hdet : Matrix.det E.basis ≠ 0) + (hrun : runRationalFeasibility oracle budget E = .exhausted E') + {x : Fin d → ℝ} (hK : K x) + (hcontains : RationalEllipsoidContains E x) : + RationalEllipsoidContains E' x := by + induction budget generalizing E E' with + | zero => + simp only [runRationalFeasibility] at hrun + cases hrun + exact hcontains + | succ budget ih => + rw [runRationalFeasibility] at hrun + split at hrun <;> rename_i hresponse + · contradiction + · have hcut := hvalid E _ hresponse + have hpulled := rationalPulledBackNormal_ne_zero_of_det_ne_zero + E _ hdet hcut.1 + have hnext := rationalEllipsoidCentralUpdate_contains_point hd E _ + hpulled hcontains (hcut.2 x hK) + exact ih + (det_rationalEllipsoidCentralUpdate_ne_zero hd E _ hdet hpulled) + hrun hnext + +/-- Main generic termination theorem. If the target contains a radius-`r` +coordinate cross and the initial ellipsoid contains those endpoints, the +loop cannot exhaust a dyadic determinant budget. -/ +theorem runRationalFeasibility_not_exhausted_of_inner_cross + {d M : ℕ} (hd : 0 < d) + {K : (Fin d → ℝ) → Prop} {oracle : RationalCentralOracle d} + (hvalid : RationalCentralOracleValid K oracle) + (E : RationalEllipsoidState d) + (hdet : Matrix.det E.basis ≠ 0) + {z : Fin d → ℝ} {r : ℝ} (hr : 0 ≤ r) + (hdyadic : Nat.factorial d * abs ((Matrix.det E.basis : ℚ) : ℝ) * + (1 / 2 : ℝ) ^ M < r ^ d) + (hKplus : ∀ k, K (fun i ↦ z i + if i = k then r else 0)) + (hKminus : ∀ k, K (fun i ↦ z i - if i = k then r else 0)) + (hEplus : ∀ k, RationalEllipsoidContains E + (fun i ↦ z i + if i = k then r else 0)) + (hEminus : ∀ k, RationalEllipsoidContains E + (fun i ↦ z i - if i = k then r else 0)) + (E' : RationalEllipsoidState d) : + runRationalFeasibility oracle (8 * d ^ 3 * M) E ≠ .exhausted E' := by + intro hrun + let cuts := rationalFeasibilityCuts oracle (8 * d ^ 3 * M) E + have hlength : 8 * d ^ 3 * M ≤ cuts.length := by + rw [rationalFeasibilityCuts_length_of_exhausted oracle hrun] + have hstate := rationalEllipsoidIterate_cuts_eq_of_exhausted oracle hrun + have hnonzero := rationalFeasibilityCuts_nonzero_of_exhausted + hvalid hd hdet hrun + have hplus : ∀ k, ∃ y : Fin d → ℝ, finiteNormSq y ≤ 1 ∧ + rationalEllipsoidPoint (rationalEllipsoidIterate E cuts) y = + fun i ↦ z i + if i = k then r else 0 := by + intro k + have hpreserve := runRationalFeasibility_preserves_target_of_exhausted + hd hvalid hdet hrun (hKplus k) (hEplus k) + rw [← hstate] at hpreserve + exact hpreserve + have hminus : ∀ k, ∃ y : Fin d → ℝ, finiteNormSq y ≤ 1 ∧ + rationalEllipsoidPoint (rationalEllipsoidIterate E cuts) y = + fun i ↦ z i - if i = k then r else 0 := by + intro k + have hpreserve := runRationalFeasibility_preserves_target_of_exhausted + hd hvalid hdet hrun (hKminus k) (hEminus k) + rw [← hstate] at hpreserve + exact hpreserve + exact rationalEllipsoid_no_long_run hd E cuts hnonzero hlength hr hdyadic + hplus hminus + +/-- Fully explicit specialization to a rational outer ball and a rational +inner radius. Both the iteration count and the initial state are executable +from their displayed rational data. -/ +theorem runRationalFeasibility_ball_not_exhausted + {d : ℕ} (hd : 0 < d) + {K : (Fin d → ℝ) → Prop} {oracle : RationalCentralOracle d} + (hvalid : RationalCentralOracleValid K oracle) + (c : Fin d → ℚ) {R r : ℚ} (hR : 0 < R) (hr : 0 < r) + {z : Fin d → ℝ} + (hKplus : ∀ k, K (fun i ↦ z i + if i = k then (r : ℝ) else 0)) + (hKminus : ∀ k, K (fun i ↦ z i - if i = k then (r : ℝ) else 0)) + (houterPlus : ∀ k, finiteNormSq + (fun i ↦ (z i + if i = k then (r : ℝ) else 0) - (c i : ℝ)) ≤ + (R : ℝ) ^ 2) + (houterMinus : ∀ k, finiteNormSq + (fun i ↦ (z i - if i = k then (r : ℝ) else 0) - (c i : ℝ)) ≤ + (R : ℝ) ^ 2) + (E' : RationalEllipsoidState d) : + runRationalFeasibility oracle + (8 * d ^ 3 * rationalBallDyadicExponent d R r) + (rationalBallEllipsoid d c R) ≠ .exhausted E' := by + apply runRationalFeasibility_not_exhausted_of_inner_cross + hd hvalid (rationalBallEllipsoid d c R) + (by rw [det_rationalBallEllipsoid]; exact pow_ne_zero _ hR.ne') + (hr := Rat.cast_nonneg.mpr hr.le) + (rationalBallEllipsoid_dyadic_budget hd c hR hr) + hKplus hKminus + · intro k + exact rationalBallEllipsoid_contains c hR (houterPlus k) + · intro k + exact rationalBallEllipsoid_contains c hR (houterMinus k) + +/-- Data-producing form: under the same explicit ball hypotheses, a valid +oracle that accepts only `Good` points returns a concrete rational `Good` +point within the computed budget. -/ +theorem runRationalFeasibility_ball_accepts + {d : ℕ} (hd : 0 < d) + {K : (Fin d → ℝ) → Prop} {Good : (Fin d → ℚ) → Prop} + {oracle : RationalCentralOracle d} + (hvalid : RationalCentralOracleValid K oracle) + (haccept : RationalCentralOracleAcceptsOnly Good oracle) + (c : Fin d → ℚ) {R r : ℚ} (hR : 0 < R) (hr : 0 < r) + {z : Fin d → ℝ} + (hKplus : ∀ k, K (fun i ↦ z i + if i = k then (r : ℝ) else 0)) + (hKminus : ∀ k, K (fun i ↦ z i - if i = k then (r : ℝ) else 0)) + (houterPlus : ∀ k, finiteNormSq + (fun i ↦ (z i + if i = k then (r : ℝ) else 0) - (c i : ℝ)) ≤ + (R : ℝ) ^ 2) + (houterMinus : ∀ k, finiteNormSq + (fun i ↦ (z i - if i = k then (r : ℝ) else 0) - (c i : ℝ)) ≤ + (R : ℝ) ^ 2) : + ∃ x : Fin d → ℚ, + runRationalFeasibility oracle + (8 * d ^ 3 * rationalBallDyadicExponent d R r) + (rationalBallEllipsoid d c R) = .accepted x ∧ Good x := by + let result := runRationalFeasibility oracle + (8 * d ^ 3 * rationalBallDyadicExponent d R r) + (rationalBallEllipsoid d c R) + cases hresult : result with + | accepted x => + refine ⟨x, ?_, ?_⟩ + · simpa only [result] using hresult + · exact runRationalFeasibility_acceptsOnly haccept + (by simpa only [result] using hresult) + | exhausted E' => + exfalso + exact runRationalFeasibility_ball_not_exhausted hd hvalid c hR hr + hKplus hKminus houterPlus houterMinus E' + (by simpa only [result] using hresult) + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/RationalLinearOracle.lean b/LeanPool/BeyondBethe/BeyondBethe/RationalLinearOracle.lean new file mode 100644 index 0000000000..5698dd8ddc --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/RationalLinearOracle.lean @@ -0,0 +1,198 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.RationalFeasibility +import Mathlib.Tactic + +/-! # Rational Linear Oracle -/ + +open scoped BigOperators + +namespace BeyondBethe + +/-! +# Exact rational linear-constraint cuts + +The bounded Bethe epigraph has many rational linear inequalities. This file +implements their scan and proves that every reported violation is a strict +central cut for every point satisfying the inequality. +-/ + +structure RationalHalfspace (d : ℕ) where + normal : Fin d → ℚ + offset : ℚ + normal_ne_zero : normal ≠ 0 + +def RationalHalfspace.SatisfiedBy {d : ℕ} + (h : RationalHalfspace d) (x : Fin d → ℝ) : Prop := + finiteDot (fun i ↦ (h.normal i : ℝ)) x ≤ (h.offset : ℝ) + +def RationalHalfspace.satisfiedByRational {d : ℕ} + (h : RationalHalfspace d) (x : Fin d → ℚ) : Prop := + finiteDot h.normal x ≤ h.offset + +/-- First exactly violated inequality, in list order. -/ +def firstViolatedHalfspace {d : ℕ} (x : Fin d → ℚ) : + List (RationalHalfspace d) → Option (RationalHalfspace d) + | [] => none + | h :: hs => + if h.offset < finiteDot h.normal x then some h + else firstViolatedHalfspace x hs + +theorem firstViolatedHalfspace_mem {d : ℕ} {x : Fin d → ℚ} + {hs : List (RationalHalfspace d)} {h : RationalHalfspace d} + (hfind : firstViolatedHalfspace x hs = some h) : h ∈ hs := by + induction hs with + | nil => simp [firstViolatedHalfspace] at hfind + | cons g hs ih => + rw [firstViolatedHalfspace] at hfind + split at hfind + · cases hfind + simp + · exact List.mem_cons_of_mem _ (ih hfind) + +theorem firstViolatedHalfspace_is_violated {d : ℕ} {x : Fin d → ℚ} + {hs : List (RationalHalfspace d)} {h : RationalHalfspace d} + (hfind : firstViolatedHalfspace x hs = some h) : + h.offset < finiteDot h.normal x := by + induction hs with + | nil => simp [firstViolatedHalfspace] at hfind + | cons g hs ih => + rw [firstViolatedHalfspace] at hfind + split at hfind <;> rename_i htest + · cases hfind + exact htest + · exact ih hfind + +theorem firstViolatedHalfspace_eq_none_iff {d : ℕ} + (x : Fin d → ℚ) (hs : List (RationalHalfspace d)) : + firstViolatedHalfspace x hs = none ↔ + ∀ h ∈ hs, h.satisfiedByRational x := by + induction hs with + | nil => simp [firstViolatedHalfspace] + | cons g hs ih => + rw [firstViolatedHalfspace] + split <;> rename_i htest + · constructor + · intro hnone + contradiction + · intro hall + exact ((not_lt_of_ge (hall g (by simp))) htest).elim + · rw [ih] + have hg : g.satisfiedByRational x := not_lt.mp htest + simp [hg] + +theorem finiteDot_sub_right_ratCast {d : ℕ} + (a : Fin d → ℚ) (x : Fin d → ℝ) (c : Fin d → ℚ) : + finiteDot (fun i ↦ (a i : ℝ)) (fun i ↦ x i - (c i : ℝ)) = + finiteDot (fun i ↦ (a i : ℝ)) x - + (finiteDot a c : ℚ) := by + rw [finiteDot, finiteDot, finiteDot] + simp_rw [mul_sub] + rw [Finset.sum_sub_distrib, Rat.cast_sum] + simp only [Rat.cast_mul] + +/-- Every exact violation gives a strict physical central cut. -/ +theorem firstViolatedHalfspace_valid_cut {d : ℕ} + {x : Fin d → ℚ} {hs : List (RationalHalfspace d)} + {h : RationalHalfspace d} + (hfind : firstViolatedHalfspace x hs = some h) + {z : Fin d → ℝ} (hz : h.SatisfiedBy z) : + finiteDot (fun i ↦ (h.normal i : ℝ)) + (fun i ↦ z i - (x i : ℝ)) < 0 := by + have hviolateQ := firstViolatedHalfspace_is_violated hfind + have hviolate : (h.offset : ℝ) < (finiteDot h.normal x : ℚ) := by + exact_mod_cast hviolateQ + rw [finiteDot_sub_right_ratCast] + exact sub_neg.mpr (hz.trans_lt hviolate) + +/-- Add an exact scan of rational linear inequalities in front of any other +central oracle. -/ +def withRationalLinearConstraints {d : ℕ} + (constraints : List (RationalHalfspace d)) + (fallback : RationalCentralOracle d) : RationalCentralOracle d := + fun E ↦ + match firstViolatedHalfspace E.center constraints with + | some h => .cut h.normal + | none => fallback E + +/-- If every target point satisfies every listed inequality and the fallback +oracle is valid, then the combined executable oracle is valid. -/ +theorem withRationalLinearConstraints_valid {d : ℕ} + {K : (Fin d → ℝ) → Prop} + (constraints : List (RationalHalfspace d)) + (hconstraints : ∀ x, K x → ∀ h ∈ constraints, h.SatisfiedBy x) + (fallback : RationalCentralOracle d) + (hfallback : RationalCentralOracleValid K fallback) : + RationalCentralOracleValid K + (withRationalLinearConstraints constraints fallback) := by + intro E a hresponse + rw [withRationalLinearConstraints] at hresponse + split at hresponse <;> rename_i hfind + · rename_i h + cases hresponse + refine ⟨h.normal_ne_zero, ?_⟩ + intro x hx + exact (firstViolatedHalfspace_valid_cut hfind + (hconstraints x hx h (firstViolatedHalfspace_mem hfind))).le + · exact hfallback E a hresponse + +/-- Conditional form used for logarithmic oracles, whose correctness is only +needed after the exact positivity constraints have passed. -/ +theorem withRationalLinearConstraints_valid_of_passed {d : ℕ} + {K : (Fin d → ℝ) → Prop} + (constraints : List (RationalHalfspace d)) + (hconstraints : ∀ x, K x → ∀ h ∈ constraints, h.SatisfiedBy x) + (fallback : RationalCentralOracle d) + (hfallback : ∀ E a, + firstViolatedHalfspace E.center constraints = none → + fallback E = .cut a → + a ≠ 0 ∧ ∀ x, K x → finiteDot (fun i ↦ (a i : ℝ)) + (fun i ↦ x i - rationalCenterReal E i) ≤ 0) : + RationalCentralOracleValid K + (withRationalLinearConstraints constraints fallback) := by + intro E a hresponse + rw [withRationalLinearConstraints] at hresponse + split at hresponse <;> rename_i hfind + · rename_i h + cases hresponse + refine ⟨h.normal_ne_zero, ?_⟩ + intro x hx + exact (firstViolatedHalfspace_valid_cut hfind + (hconstraints x hx h (firstViolatedHalfspace_mem hfind))).le + · exact hfallback E a hfind hresponse + +/-- Acceptance by the combined oracle comes from the fallback after every +linear inequality has passed. -/ +theorem withRationalLinearConstraints_acceptsOnly {d : ℕ} + {Good : (Fin d → ℚ) → Prop} + (constraints : List (RationalHalfspace d)) + (fallback : RationalCentralOracle d) + (hfallback : RationalCentralOracleAcceptsOnly Good fallback) : + RationalCentralOracleAcceptsOnly Good + (withRationalLinearConstraints constraints fallback) := by + intro E hresponse + rw [withRationalLinearConstraints] at hresponse + split at hresponse + · contradiction + · exact hfallback E hresponse + +theorem withRationalLinearConstraints_acceptsOnly_of_passed {d : ℕ} + {Good : (Fin d → ℚ) → Prop} + (constraints : List (RationalHalfspace d)) + (fallback : RationalCentralOracle d) + (hfallback : ∀ E, + firstViolatedHalfspace E.center constraints = none → + fallback E = .accept → Good E.center) : + RationalCentralOracleAcceptsOnly Good + (withRationalLinearConstraints constraints fallback) := by + intro E hresponse + rw [withRationalLinearConstraints] at hresponse + split at hresponse <;> rename_i hfind + · contradiction + · exact hfallback E hfind hresponse + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/RawRational.lean b/LeanPool/BeyondBethe/BeyondBethe/RawRational.lean new file mode 100644 index 0000000000..a118a38fa9 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/RawRational.lean @@ -0,0 +1,160 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.BinaryLongDivision +import Mathlib.Data.Rat.Lemmas +import Mathlib.Tactic + +/-! # Raw Rational -/ + +namespace BeyondBethe + +/-! +# Unreduced rational arithmetic + +The machine implementation carries signed numerators and positive +denominators without reducing after every field operation. This avoids hiding +a gcd call inside each use of Lean's canonical `Rat` arithmetic. Reduction is +performed explicitly by `binaryNormalizeRawRat` using the verified division +and Euclid recurrences. +-/ + +/-- A signed fraction with a strictly positive, not necessarily reduced, +denominator. -/ +structure RawRat where + num : ℤ + den : ℕ + den_pos : 0 < den +deriving DecidableEq + +namespace RawRat + +def zero : RawRat := ⟨0, 1, by omega⟩ + +def one : RawRat := ⟨1, 1, by omega⟩ + +/-- Mathematical value of an unreduced fraction. -/ +def value (q : RawRat) : ℚ := (q.num : ℚ) / (q.den : ℚ) + +def neg (q : RawRat) : RawRat := ⟨-q.num, q.den, q.den_pos⟩ + +def add (q r : RawRat) : RawRat := + ⟨q.num * r.den + r.num * q.den, q.den * r.den, + Nat.mul_pos q.den_pos r.den_pos⟩ + +def sub (q r : RawRat) : RawRat := add q (neg r) + +def mul (q r : RawRat) : RawRat := + ⟨q.num * r.num, q.den * r.den, Nat.mul_pos q.den_pos r.den_pos⟩ + +@[simp] theorem value_zero : zero.value = 0 := by + norm_num [zero, value] + +@[simp] theorem value_one : one.value = 1 := by + norm_num [one, value] + +@[simp] theorem value_neg (q : RawRat) : q.neg.value = -q.value := by + rw [neg, value, value] + push_cast + ring + +@[simp] theorem value_add (q r : RawRat) : (q.add r).value = q.value + r.value := by + rw [add, value, value, value] + push_cast + field_simp [Nat.ne_of_gt q.den_pos, Nat.ne_of_gt r.den_pos] + <;> ring + +@[simp] theorem value_sub (q r : RawRat) : (q.sub r).value = q.value - r.value := by + simp [sub, sub_eq_add_neg] + +@[simp] theorem value_mul (q r : RawRat) : (q.mul r).value = q.value * r.value := by + rw [mul, value, value, value] + push_cast + field_simp [Nat.ne_of_gt q.den_pos, Nat.ne_of_gt r.den_pos] + <;> ring + +end RawRat + +/-- Signed division by a positive natural, implemented by dividing the +absolute value and restoring the sign. -/ +def binaryIntDivNat (z : ℤ) (d : ℕ) : ℤ := + z.sign * ((binaryLongDiv z.natAbs d).1 : ℤ) + +theorem binaryIntDivNat_eq_ediv {z : ℤ} {d : ℕ} + (hd : 0 < d) (hdvd : d ∣ z.natAbs) : + binaryIntDivNat z d = z / (d : ℤ) := by + have hquot : (binaryLongDiv z.natAbs d).1 = z.natAbs / d := by + simp [binaryLongDiv_eq_div_mod] + have habs : z.natAbs = (z.natAbs / d) * d := + (Nat.div_mul_cancel hdvd).symm + apply (Int.ediv_eq_of_eq_mul_left (by exact_mod_cast hd.ne') ?_).symm + rw [binaryIntDivNat, hquot] + calc + z = z.sign * (z.natAbs : ℤ) := (Int.sign_mul_natAbs z).symm + _ = z.sign * (((z.natAbs / d) * d : ℕ) : ℤ) := by rw [← habs] + _ = (z.sign * (z.natAbs / d : ℕ)) * (d : ℤ) := by + push_cast + ring + +/-- Explicit canonicalization of one unreduced fraction. -/ +def binaryNormalizeRawRat (q : RawRat) : ℚ := + let g := binaryEuclidBounded q.num.natAbs q.den + have hgcd : g = Nat.gcd q.num.natAbs q.den := + binaryEuclidBounded_eq_gcd _ _ + have hgpos : 0 < g := by + rw [hgcd] + exact Nat.gcd_pos_of_pos_right _ q.den_pos + have hgdvdNum : g ∣ q.num.natAbs := by + rw [hgcd] + exact Nat.gcd_dvd_left _ _ + have hnum : binaryIntDivNat q.num g = q.num / (g : ℤ) := + binaryIntDivNat_eq_ediv hgpos hgdvdNum + have hden : (binaryLongDiv q.den g).1 = q.den / g := by + simp [binaryLongDiv_eq_div_mod] + have hgdvdDen : g ∣ q.den := by + rw [hgcd] + exact Nat.gcd_dvd_right _ _ + have hdenPos : 0 < (binaryLongDiv q.den g).1 := by + rw [hden] + exact Nat.div_pos (Nat.le_of_dvd q.den_pos hgdvdDen) hgpos + have hreduced : + (binaryIntDivNat q.num g).natAbs.Coprime + (binaryLongDiv q.den g).1 := by + rw [hnum, hden, hgcd] + exact Rat.normalize.reduced (Nat.ne_of_gt q.den_pos) rfl + Rat.mk' (binaryIntDivNat q.num g) (binaryLongDiv q.den g).1 + (Nat.ne_of_gt hdenPos) hreduced + +theorem binaryNormalizeRawRat_eq_normalize (q : RawRat) : + binaryNormalizeRawRat q = + Rat.normalize q.num q.den (Nat.ne_of_gt q.den_pos) := by + let g := binaryEuclidBounded q.num.natAbs q.den + have hgcd : g = Nat.gcd q.num.natAbs q.den := + binaryEuclidBounded_eq_gcd _ _ + have hgpos : 0 < g := by + rw [hgcd] + exact Nat.gcd_pos_of_pos_right _ q.den_pos + have hgdvdNum : g ∣ q.num.natAbs := by + rw [hgcd] + exact Nat.gcd_dvd_left _ _ + have hnum : binaryIntDivNat q.num g = q.num / (g : ℤ) := + binaryIntDivNat_eq_ediv hgpos hgdvdNum + have hden : (binaryLongDiv q.den g).1 = q.den / g := by + simp [binaryLongDiv_eq_div_mod] + rw [binaryNormalizeRawRat, Rat.normalize_eq] + apply Rat.ext + · simpa only [g, hgcd] using hnum + · simpa only [g, hgcd] using hden + +theorem binaryNormalizeRawRat_eq_value (q : RawRat) : + binaryNormalizeRawRat q = q.value := by + rw [binaryNormalizeRawRat_eq_normalize, + Rat.normalize_eq_mkRat (Nat.ne_of_gt q.den_pos)] + change mkRat q.num q.den = (q.num : ℚ) / ((q.den : ℤ) : ℚ) + rw [Rat.intCast_div_eq_divInt] + simp [Rat.divInt, mkRat, Nat.ne_of_gt q.den_pos] + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/RawRationalBitBounds.lean b/LeanPool/BeyondBethe/BeyondBethe/RawRationalBitBounds.lean new file mode 100644 index 0000000000..e829192bb8 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/RawRationalBitBounds.lean @@ -0,0 +1,452 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.RawRational +import LeanPool.BeyondBethe.BeyondBethe.RationalEncodingBounds +import Mathlib.Tactic + +/-! # Raw Rational Bit Bounds -/ + +namespace BeyondBethe + +/-! +# Bit growth of the explicit unreduced rational arithmetic + +`RawRat` deliberately does not hide normalization inside field operations. +This file proves the elementary size bounds needed by the eventual machine +simulation. The common width counts the larger of the signed numerator's +absolute-value width and the positive denominator's width. +-/ + +/-- Binary width of an unreduced signed fraction. -/ +def rawRatWidth (q : RawRat) : ℕ := + max q.num.natAbs.size q.den.size + +theorem rawRat_num_size_le_width (q : RawRat) : + q.num.natAbs.size ≤ rawRatWidth q := + le_max_left _ _ + +theorem rawRat_den_size_le_width (q : RawRat) : + q.den.size ≤ rawRatWidth q := + le_max_right _ _ + +theorem rawRat_num_lt_two_pow_width (q : RawRat) : + q.num.natAbs < 2 ^ rawRatWidth q := by + exact (Nat.lt_size_self q.num.natAbs).trans_le + (Nat.pow_le_pow_right (by decide) (rawRat_num_size_le_width q)) + +theorem rawRat_den_lt_two_pow_width (q : RawRat) : + q.den < 2 ^ rawRatWidth q := by + exact (Nat.lt_size_self q.den).trans_le + (Nat.pow_le_pow_right (by decide) (rawRat_den_size_le_width q)) + +theorem rawRatWidth_zero : rawRatWidth RawRat.zero = 1 := by + norm_num [rawRatWidth, RawRat.zero] + +theorem rawRatWidth_one : rawRatWidth RawRat.one = 1 := by + norm_num [rawRatWidth, RawRat.one] + +theorem rawRatWidth_neg (q : RawRat) : + rawRatWidth q.neg = rawRatWidth q := by + simp [rawRatWidth, RawRat.neg] + +namespace RawRat + +/-- Total reciprocal in the unreduced representation. The zero branch +agrees with the field convention `0⁻¹ = 0`; nonzero branches swap the +absolute numerator with the denominator and retain the sign. -/ +def inv (q : RawRat) : RawRat := + match q.num with + | .ofNat 0 => zero + | .ofNat (n + 1) => ⟨q.den, n + 1, by omega⟩ + | .negSucc n => ⟨-(q.den : ℤ), n + 1, by omega⟩ + +@[simp] theorem value_inv (q : RawRat) : q.inv.value = q.value⁻¹ := by + rcases q with ⟨num, den, hden⟩ + cases num with + | ofNat n => + cases n with + | zero => simp [inv, value, zero] + | succ n => + simp only [inv, value, Int.cast_ofNat, Nat.cast_add, Nat.cast_one] + field_simp + <;> norm_num + <;> ring + | negSucc n => + simp only [inv, value, Int.cast_negSucc, Nat.cast_add, Nat.cast_one, + Int.cast_neg, Int.cast_ofNat, inv_div] + field_simp + <;> norm_num + <;> ring + +def div (q r : RawRat) : RawRat := q.mul r.inv + +@[simp] theorem value_div (q r : RawRat) : + (q.div r).value = q.value / r.value := by + simp [div, div_eq_mul_inv] + +end RawRat + +theorem rawRatWidth_inv_le (q : RawRat) : + rawRatWidth q.inv ≤ rawRatWidth q := by + rcases q with ⟨num, den, hden⟩ + cases num with + | ofNat n => + cases n with + | zero => + simp only [RawRat.inv, rawRatWidth_zero] + have hsize : 1 ≤ den.size := by + exact Nat.size_pos.mpr hden + exact hsize.trans (le_max_right _ _) + | succ n => + change max den.size (n + 1).size ≤ + max (Int.ofNat (n + 1)).natAbs.size den.size + rw [Int.natAbs_ofNat', max_comm] + | negSucc n => + change max (-(den : ℤ)).natAbs.size (n + 1).size ≤ + max (Int.negSucc n).natAbs.size den.size + simp only [Int.natAbs_neg, Int.natAbs_natCast, Int.natAbs_negSucc] + rw [max_comm] + +private theorem mul_lt_two_pow_add + {a b u v : ℕ} (ha : a < 2 ^ u) (hb : b < 2 ^ v) : + a * b < 2 ^ (u + v) := by + rw [pow_add] + nlinarith [show 0 < 2 ^ u by positivity, + show 0 < 2 ^ v by positivity] + +private theorem add_of_two_lt_two_pow_lt + {a b k : ℕ} (ha : a < 2 ^ k) (hb : b < 2 ^ k) : + a + b < 2 ^ (k + 1) := by + rw [pow_succ] + omega + +/-- Multiplication adds the operand widths. -/ +theorem rawRatWidth_mul_le (q r : RawRat) : + rawRatWidth (q.mul r) ≤ rawRatWidth q + rawRatWidth r := by + apply max_le + · rw [RawRat.mul, Int.natAbs_mul, Nat.size_le] + exact mul_lt_two_pow_add + (rawRat_num_lt_two_pow_width q) + (rawRat_num_lt_two_pow_width r) + · rw [RawRat.mul, Nat.size_le] + exact mul_lt_two_pow_add + (rawRat_den_lt_two_pow_width q) + (rawRat_den_lt_two_pow_width r) + +theorem rawRatWidth_div_le (q r : RawRat) : + rawRatWidth (q.div r) ≤ rawRatWidth q + rawRatWidth r := by + exact (rawRatWidth_mul_le q r.inv).trans + (Nat.add_le_add_left (rawRatWidth_inv_le r) _) + +/-- Addition costs at most one carry bit beyond the sum of the operand +widths. This includes the cross-multiplied denominator representation. -/ +theorem rawRatWidth_add_le (q r : RawRat) : + rawRatWidth (q.add r) ≤ rawRatWidth q + rawRatWidth r + 1 := by + apply max_le + · rw [RawRat.add, Nat.size_le] + apply lt_of_le_of_lt (Int.natAbs_add_le _ _) + rw [Int.natAbs_mul, Int.natAbs_mul] + apply add_of_two_lt_two_pow_lt + · exact mul_lt_two_pow_add + (rawRat_num_lt_two_pow_width q) + (rawRat_den_lt_two_pow_width r) + · have h := mul_lt_two_pow_add + (rawRat_num_lt_two_pow_width r) + (rawRat_den_lt_two_pow_width q) + simpa only [Nat.add_comm] using h + · rw [RawRat.add, Nat.size_le] + exact (mul_lt_two_pow_add + (rawRat_den_lt_two_pow_width q) + (rawRat_den_lt_two_pow_width r)).trans_le + (Nat.pow_le_pow_right (by decide) (by omega)) + +theorem rawRatWidth_sub_le (q r : RawRat) : + rawRatWidth (q.sub r) ≤ rawRatWidth q + rawRatWidth r + 1 := by + simpa only [RawRat.sub, rawRatWidth_neg] using rawRatWidth_add_le q r.neg + +theorem rawRat_value_den_dvd (q : RawRat) : q.value.den ∣ q.den := by + have hz : (((q.value.den : ℕ) : ℤ) ∣ (q.den : ℤ)) := by + rw [RawRat.value, + show ((q.den : ℕ) : ℚ) = ((q.den : ℤ) : ℚ) by norm_num, + Rat.intCast_div_eq_divInt] + exact Rat.den_dvd q.num (q.den : ℤ) + exact_mod_cast hz + +theorem rawRat_value_den_le (q : RawRat) : q.value.den ≤ q.den := + Nat.le_of_dvd q.den_pos (rawRat_value_den_dvd q) + +theorem rawRat_value_abs_le_two_pow_width (q : RawRat) : + abs q.value ≤ (2 : ℚ) ^ rawRatWidth q := by + have hden : (1 : ℚ) ≤ q.den := by + exact_mod_cast q.den_pos + have hnum : (q.num.natAbs : ℚ) ≤ (2 : ℚ) ^ rawRatWidth q := by + exact_mod_cast (rawRat_num_lt_two_pow_width q).le + have habsnum : abs (q.num : ℚ) = (q.num.natAbs : ℚ) := by + rw [← Int.cast_abs] + norm_num + rw [RawRat.value, abs_div, habsnum, abs_of_nonneg (by positivity)] + exact (div_le_self (by positivity) hden).trans hnum + +/-- Canonicalization cannot create a large denominator and its exact +canonical `DataEncode` output has linear length in the unreduced width. -/ +theorem binaryNormalizeRawRat_encodedBitLength_le (q : RawRat) : + encodedBitLength ℚ (binaryNormalizeRawRat q) ≤ + 20 + 12 * rawRatWidth q := by + rw [binaryNormalizeRawRat_eq_value] + have hden : q.value.den ≤ 2 ^ rawRatWidth q := + (rawRat_value_den_le q).trans (rawRat_den_lt_two_pow_width q).le + have h := rational_encodedBitLength_le_of_abs_and_den_bounds + (rawRat_value_abs_le_two_pow_width q) hden + omega + +namespace RawRat + +/-- Repeated multiplication in the unreduced representation. This is a +semantic reference for the fixed-budget machine loop; normalization can be +postponed until the end. -/ +def pow (q : RawRat) : ℕ → RawRat + | 0 => one + | k + 1 => (pow q k).mul q + +@[simp] theorem value_pow (q : RawRat) : ∀ k : ℕ, + (q.pow k).value = q.value ^ k := by + intro k + induction k with + | zero => simp [pow] + | succ k ih => simp [pow, ih, pow_succ] + +/-- A length-`k` product has width at most the sum of the operand widths, +apart from the one-bit representation of the initial value `1`. -/ +theorem width_pow_le (q : RawRat) : ∀ k : ℕ, + rawRatWidth (q.pow k) ≤ 1 + k * rawRatWidth q := by + intro k + induction k with + | zero => simp [pow, rawRatWidth_one] + | succ k ih => + rw [pow] + exact (rawRatWidth_mul_le _ _).trans (by + rw [Nat.succ_mul] + omega) + +/-- Unreduced left fold for a finite sum. -/ +def sum : List RawRat → RawRat + | [] => zero + | q :: qs => q.add (sum qs) + +@[simp] theorem value_sum : ∀ qs : List RawRat, + (sum qs).value = (qs.map value).sum := by + intro qs + induction qs with + | nil => simp [sum] + | cons q qs ih => simp [sum, ih] + +theorem width_sum_le : ∀ qs : List RawRat, + rawRatWidth (sum qs) ≤ + 1 + (qs.map fun q ↦ rawRatWidth q + 1).sum := by + intro qs + induction qs with + | nil => simp [sum, rawRatWidth_zero] + | cons q qs ih => + rw [sum] + exact (rawRatWidth_add_le _ _).trans (by + simp only [List.map_cons, List.sum_cons] + omega) + +/-- Unreduced left fold for a finite product. -/ +def product : List RawRat → RawRat + | [] => one + | q :: qs => q.mul (product qs) + +@[simp] theorem value_product : ∀ qs : List RawRat, + (product qs).value = (qs.map value).prod := by + intro qs + induction qs with + | nil => simp [product] + | cons q qs ih => simp [product, ih] + +theorem width_product_le : ∀ qs : List RawRat, + rawRatWidth (product qs) ≤ + 1 + (qs.map rawRatWidth).sum := by + intro qs + induction qs with + | nil => simp [product, rawRatWidth_one] + | cons q qs ih => + rw [product] + exact (rawRatWidth_mul_le _ _).trans (by + simp only [List.map_cons, List.sum_cons] + omega) + +end RawRat + +/-- Canonical rationals embed into `RawRat` without changing their value. -/ +def rawRatOfRat (q : ℚ) : RawRat := + ⟨q.num, q.den, q.den_pos⟩ + +@[simp] theorem rawRatOfRat_value (q : ℚ) : + (rawRatOfRat q).value = q := by + simpa only [rawRatOfRat, RawRat.value] using q.num_div_den + +/-- The raw width of a canonical input is bounded by its exact project +encoding length. -/ +theorem rawRatOfRat_width_le_encodedBitLength (q : ℚ) : + rawRatWidth (rawRatOfRat q) ≤ encodedBitLength ℚ q := by + apply max_le + · exact (nat_size_le_encodedBitLength q.num.natAbs).trans + ((natAbs_encodedBitLength_lt_integer q.num).le.trans + (numerator_encodedBitLength_lt_rational q).le) + · exact (nat_size_le_encodedBitLength q.den).trans + (denominator_encodedBitLength_lt_rational q).le + +/-- Fully explicit addition: cross-multiply in `RawRat`, run verified bounded +Euclid, and return the canonical rational. -/ +def binaryRatAdd (q r : ℚ) : ℚ := + binaryNormalizeRawRat ((rawRatOfRat q).add (rawRatOfRat r)) + +theorem binaryRatAdd_eq_add (q r : ℚ) : binaryRatAdd q r = q + r := by + simp [binaryRatAdd, binaryNormalizeRawRat_eq_value] + +def binaryRatSub (q r : ℚ) : ℚ := + binaryNormalizeRawRat ((rawRatOfRat q).sub (rawRatOfRat r)) + +theorem binaryRatSub_eq_sub (q r : ℚ) : binaryRatSub q r = q - r := by + simp [binaryRatSub, binaryNormalizeRawRat_eq_value] + +def binaryRatNeg (q : ℚ) : ℚ := + binaryNormalizeRawRat (rawRatOfRat q).neg + +theorem binaryRatNeg_eq_neg (q : ℚ) : binaryRatNeg q = -q := by + simp [binaryRatNeg, binaryNormalizeRawRat_eq_value] + +def binaryRatMul (q r : ℚ) : ℚ := + binaryNormalizeRawRat ((rawRatOfRat q).mul (rawRatOfRat r)) + +theorem binaryRatMul_eq_mul (q r : ℚ) : binaryRatMul q r = q * r := by + simp [binaryRatMul, binaryNormalizeRawRat_eq_value] + +def binaryRatInv (q : ℚ) : ℚ := + binaryNormalizeRawRat (rawRatOfRat q).inv + +theorem binaryRatInv_eq_inv (q : ℚ) : binaryRatInv q = q⁻¹ := by + simp [binaryRatInv, binaryNormalizeRawRat_eq_value] + +def binaryRatDiv (q r : ℚ) : ℚ := + binaryNormalizeRawRat ((rawRatOfRat q).div (rawRatOfRat r)) + +theorem binaryRatDiv_eq_div (q r : ℚ) : binaryRatDiv q r = q / r := by + simp [binaryRatDiv, binaryNormalizeRawRat_eq_value] + +def binaryRatPow (q : ℚ) (k : ℕ) : ℚ := + binaryNormalizeRawRat ((rawRatOfRat q).pow k) + +theorem binaryRatPow_eq_pow (q : ℚ) (k : ℕ) : + binaryRatPow q k = q ^ k := by + simp [binaryRatPow, binaryNormalizeRawRat_eq_value] + +theorem binaryRatAdd_encodedBitLength_le (q r : ℚ) : + encodedBitLength ℚ (binaryRatAdd q r) ≤ + 32 + 12 * (encodedBitLength ℚ q + encodedBitLength ℚ r) := by + have hw := rawRatWidth_add_le (rawRatOfRat q) (rawRatOfRat r) + have hq := rawRatOfRat_width_le_encodedBitLength q + have hr := rawRatOfRat_width_le_encodedBitLength r + have hn := binaryNormalizeRawRat_encodedBitLength_le + ((rawRatOfRat q).add (rawRatOfRat r)) + change encodedBitLength ℚ + (binaryNormalizeRawRat ((rawRatOfRat q).add (rawRatOfRat r))) ≤ _ + calc + _ ≤ 20 + 12 * rawRatWidth + ((rawRatOfRat q).add (rawRatOfRat r)) := hn + _ ≤ 20 + 12 * (encodedBitLength ℚ q + + encodedBitLength ℚ r + 1) := by omega + _ = 32 + 12 * (encodedBitLength ℚ q + + encodedBitLength ℚ r) := by ring + +theorem binaryRatSub_encodedBitLength_le (q r : ℚ) : + encodedBitLength ℚ (binaryRatSub q r) ≤ + 32 + 12 * (encodedBitLength ℚ q + encodedBitLength ℚ r) := by + have hw := rawRatWidth_sub_le (rawRatOfRat q) (rawRatOfRat r) + have hq := rawRatOfRat_width_le_encodedBitLength q + have hr := rawRatOfRat_width_le_encodedBitLength r + have hn := binaryNormalizeRawRat_encodedBitLength_le + ((rawRatOfRat q).sub (rawRatOfRat r)) + change encodedBitLength ℚ + (binaryNormalizeRawRat ((rawRatOfRat q).sub (rawRatOfRat r))) ≤ _ + calc + _ ≤ 20 + 12 * rawRatWidth + ((rawRatOfRat q).sub (rawRatOfRat r)) := hn + _ ≤ 20 + 12 * (encodedBitLength ℚ q + + encodedBitLength ℚ r + 1) := by omega + _ = 32 + 12 * (encodedBitLength ℚ q + + encodedBitLength ℚ r) := by ring + +theorem binaryRatNeg_encodedBitLength_le (q : ℚ) : + encodedBitLength ℚ (binaryRatNeg q) ≤ + 20 + 12 * encodedBitLength ℚ q := by + have hw := rawRatOfRat_width_le_encodedBitLength q + have hn := binaryNormalizeRawRat_encodedBitLength_le + (rawRatOfRat q).neg + change encodedBitLength ℚ + (binaryNormalizeRawRat (rawRatOfRat q).neg) ≤ _ + rw [rawRatWidth_neg] at hn + omega + +theorem binaryRatMul_encodedBitLength_le (q r : ℚ) : + encodedBitLength ℚ (binaryRatMul q r) ≤ + 20 + 12 * (encodedBitLength ℚ q + encodedBitLength ℚ r) := by + have hw := rawRatWidth_mul_le (rawRatOfRat q) (rawRatOfRat r) + have hq := rawRatOfRat_width_le_encodedBitLength q + have hr := rawRatOfRat_width_le_encodedBitLength r + have hn := binaryNormalizeRawRat_encodedBitLength_le + ((rawRatOfRat q).mul (rawRatOfRat r)) + change encodedBitLength ℚ + (binaryNormalizeRawRat ((rawRatOfRat q).mul (rawRatOfRat r))) ≤ _ + calc + _ ≤ 20 + 12 * rawRatWidth + ((rawRatOfRat q).mul (rawRatOfRat r)) := hn + _ ≤ 20 + 12 * (encodedBitLength ℚ q + + encodedBitLength ℚ r) := by omega + +theorem binaryRatInv_encodedBitLength_le (q : ℚ) : + encodedBitLength ℚ (binaryRatInv q) ≤ + 20 + 12 * encodedBitLength ℚ q := by + have hw := rawRatWidth_inv_le (rawRatOfRat q) + have hq := rawRatOfRat_width_le_encodedBitLength q + have hn := binaryNormalizeRawRat_encodedBitLength_le + (rawRatOfRat q).inv + change encodedBitLength ℚ + (binaryNormalizeRawRat (rawRatOfRat q).inv) ≤ _ + omega + +theorem binaryRatDiv_encodedBitLength_le (q r : ℚ) : + encodedBitLength ℚ (binaryRatDiv q r) ≤ + 20 + 12 * (encodedBitLength ℚ q + encodedBitLength ℚ r) := by + have hw := rawRatWidth_div_le (rawRatOfRat q) (rawRatOfRat r) + have hq := rawRatOfRat_width_le_encodedBitLength q + have hr := rawRatOfRat_width_le_encodedBitLength r + have hn := binaryNormalizeRawRat_encodedBitLength_le + ((rawRatOfRat q).div (rawRatOfRat r)) + change encodedBitLength ℚ + (binaryNormalizeRawRat ((rawRatOfRat q).div (rawRatOfRat r))) ≤ _ + omega + +theorem binaryRatPow_encodedBitLength_le (q : ℚ) (k : ℕ) : + encodedBitLength ℚ (binaryRatPow q k) ≤ + 32 + 12 * k * encodedBitLength ℚ q := by + have hw := RawRat.width_pow_le (rawRatOfRat q) k + have hq := rawRatOfRat_width_le_encodedBitLength q + have hn := binaryNormalizeRawRat_encodedBitLength_le + ((rawRatOfRat q).pow k) + have hw' : rawRatWidth ((rawRatOfRat q).pow k) ≤ + 1 + k * encodedBitLength ℚ q := + hw.trans (Nat.add_le_add_left (Nat.mul_le_mul_left k hq) 1) + change encodedBitLength ℚ + (binaryNormalizeRawRat ((rawRatOfRat q).pow k)) ≤ _ + calc + _ ≤ 20 + 12 * rawRatWidth ((rawRatOfRat q).pow k) := hn + _ ≤ 20 + 12 * (1 + k * encodedBitLength ℚ q) := by omega + _ = 32 + 12 * k * encodedBitLength ℚ q := by ring + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/RobustCycle.lean b/LeanPool/BeyondBethe/BeyondBethe/RobustCycle.lean new file mode 100644 index 0000000000..32263b6890 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/RobustCycle.lean @@ -0,0 +1,785 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.GoodRowScore +import LeanPool.BeyondBethe.BeyondBethe.Sequential +import LeanPool.BeyondBethe.BeyondBethe.Slack + +/-! # Robust Cycle -/ + +namespace BeyondBethe + +/-- Inversion as an equivalence on permutations. The Gibbs layer represents +an assignment as `column -> row`, whereas the cycle layer represents it as +`row -> column`; this equivalence makes the conversion explicit. -/ +def permInverseEquiv {α : Type*} : Equiv.Perm α ≃ Equiv.Perm α where + toFun σ := σ.symm + invFun σ := σ.symm + left_inv σ := by simp + right_inv σ := by simp + +/-- The row-oriented version of a mass on Mathlib's column-oriented +permutations. -/ +noncomputable def rowOrientedMass + {α : Type*} [Fintype α] [DecidableEq α] + (μ : Equiv.Perm α → ℝ) : Equiv.Perm α → ℝ := + pushforwardMass μ permInverseEquiv + +theorem rowOrientedMass_apply + {α : Type*} [Fintype α] [DecidableEq α] + (μ : Equiv.Perm α → ℝ) (σ : Equiv.Perm α) : + rowOrientedMass μ σ = μ σ.symm := by + exact pushforwardMass_equiv_apply μ permInverseEquiv σ + +theorem rowOrientedMass_isProbabilityVector + {α : Type*} [Fintype α] [DecidableEq α] + {μ : Equiv.Perm α → ℝ} (hμ : IsProbabilityVector μ) : + IsProbabilityVector (rowOrientedMass μ) := + pushforwardMass_isProbabilityVector μ hμ permInverseEquiv + +theorem shannonEntropy_rowOrientedMass + {α : Type*} [Fintype α] [DecidableEq α] + (μ : Equiv.Perm α → ℝ) : + shannonEntropy (rowOrientedMass μ) = shannonEntropy μ := + shannonEntropy_pushforward_equiv μ permInverseEquiv + +/-- Evaluation of the row-oriented assignment has exactly the prescribed +row marginal. -/ +theorem rowOriented_evaluation_mass + {n : ℕ} {μ : Equiv.Perm (Fin n) → ℝ} + {P : Matrix (Fin n) (Fin n) ℝ} + (hmarg : HasAssignmentMarginals μ P) (i j : Fin n) : + pushforwardMass (rowOrientedMass μ) (fun σ ↦ σ i) j = P i j := by + classical + rw [rowOrientedMass, pushforwardMass_comp] + rw [hmarg i j] + unfold pushforwardMass + apply Finset.sum_congr rfl + intro σ _ + have heq : (permInverseEquiv σ) i = j ↔ σ j = i := by + change σ.symm i = j ↔ σ j = i + constructor + · intro h + simpa using (congrArg σ h).symm + · intro h + simpa using (congrArg σ.symm h).symm + by_cases h : σ j = i + · simp [h, heq.mpr h] + · have hs : ¬(permInverseEquiv σ) i = j := fun hs ↦ h (heq.mp hs) + simp [h, hs] + +/-- Relabel the two core outcomes by `none` and retain every outside outcome +as `some j`. -/ +def coreOutcome {α : Type*} [DecidableEq α] (a b j : α) : Option α := + if j = a ∨ j = b then none else some j + +theorem twoMatchingEncoding_apply + {α : Type*} [Fintype α] [DecidableEq α] + (f g σ : Equiv.Perm α) (i : α) : + twoMatchingEncoding f g σ i = coreOutcome (f i) (g i) (σ i) := by + by_cases h : UsesCoreEdge f g σ i + · have h' : σ i = f i ∨ σ i = g i := h + simp [twoMatchingEncoding, coreOutcome, h, h'] + · have h' : ¬(σ i = f i ∨ σ i = g i) := h + simp [twoMatchingEncoding, coreOutcome, h, h'] + +theorem coordinateEncoding_mass + {n : ℕ} {μ : Equiv.Perm (Fin n) → ℝ} + {P : Matrix (Fin n) (Fin n) ℝ} + (hmarg : HasAssignmentMarginals μ P) + (f g : Equiv.Perm (Fin n)) (i : Fin n) : + pushforwardMass (rowOrientedMass μ) + (fun σ ↦ twoMatchingEncoding f g σ i) = + pushforwardMass (P i) (coreOutcome (f i) (g i)) := by + funext y + have hfun : (fun σ ↦ twoMatchingEncoding f g σ i) = + coreOutcome (f i) (g i) ∘ (fun σ ↦ σ i) := by + funext σ + exact twoMatchingEncoding_apply f g σ i + rw [hfun, ← pushforwardMass_comp] + congr 1 + funext j + exact rowOriented_evaluation_mass hmarg i j + +theorem coreOutcome_none_mass + {α : Type*} [Fintype α] [DecidableEq α] + (p : α → ℝ) {a b : α} (hab : a ≠ b) : + pushforwardMass p (coreOutcome a b) none = p a + p b := by + unfold pushforwardMass + calc + (∑ j, if coreOutcome a b j = none then p j else 0) = + ∑ j, if j = a ∨ j = b then p j else 0 := by + apply Finset.sum_congr rfl + intro j _ + by_cases h : j = a ∨ j = b <;> simp [coreOutcome, h] + _ = p a + p b := by + calc + (∑ j, if j = a ∨ j = b then p j else 0) = + ∑ j, ((if j = a then p j else 0) + + (if j = b then p j else 0)) := by + apply Finset.sum_congr rfl + intro j _ + by_cases hja : j = a + · subst j + simp [hab] + · by_cases hjb : j = b <;> simp [hja, hjb, hab, Ne.symm hab] + _ = p a + p b := by rw [Finset.sum_add_distrib]; simp + +theorem coreOutcome_some_mass + {α : Type*} [Fintype α] [DecidableEq α] + (p : α → ℝ) (a b j : α) : + pushforwardMass p (coreOutcome a b) (some j) = + if a ≠ j ∧ b ≠ j then p j else 0 := by + unfold pushforwardMass + by_cases hj : a ≠ j ∧ b ≠ j + · rw [if_pos hj, Finset.sum_eq_single j] + · simp [coreOutcome, hj.1.symm, hj.2.symm] + · intro k _ hkj + have hne : coreOutcome a b k ≠ some j := by + by_cases hk : k = a ∨ k = b + · simp [coreOutcome, hk] + · simp [coreOutcome, hk, hkj] + simp [hne] + · simp + · rw [if_neg hj] + apply Finset.sum_eq_zero + intro k _ + by_cases hk : k = a ∨ k = b + · simp [coreOutcome, hk] + · have hkj : k ≠ j := by + intro h + subst k + exact hj ⟨fun h ↦ hk (Or.inl h.symm), fun h ↦ hk (Or.inr h.symm)⟩ + simp [coreOutcome, hk, hkj] + +/-- The rowwise encoding entropy is exactly the entropy obtained by merging +the two distinct core atoms. -/ +theorem coreOutcome_entropy_eq_twoCoreCoarsenedEntropy + {n : ℕ} (p : Fin n → ℝ) {a b : Fin n} (hab : a ≠ b) : + shannonEntropy (pushforwardMass p (coreOutcome a b)) = + twoCoreCoarsenedEntropy p a b := by + rw [shannonEntropy, Fintype.sum_option, coreOutcome_none_mass p hab] + simp_rw [coreOutcome_some_mass] + unfold twoCoreCoarsenedEntropy + congr 1 + apply Finset.sum_congr rfl + intro j _ + split_ifs <;> simp + +theorem coreOutcome_none_mass_same + {α : Type*} [Fintype α] [DecidableEq α] + (p : α → ℝ) (a : α) : + pushforwardMass p (coreOutcome a a) none = p a := by + unfold pushforwardMass + rw [Finset.sum_eq_single a] + · simp [coreOutcome] + · intro j _ hja + simp [coreOutcome, hja] + · simp + +theorem coreOutcome_entropy_same + {α : Type*} [Fintype α] [DecidableEq α] + (p : α → ℝ) (a : α) : + shannonEntropy (pushforwardMass p (coreOutcome a a)) = + shannonEntropy p := by + rw [shannonEntropy, Fintype.sum_option, coreOutcome_none_mass_same p a] + simp_rw [coreOutcome_some_mass] + have hout := sum_ite_ne_eq_sum_sub + (fun j ↦ Real.negMulLog (p j)) a + have hsimp : + (∑ x, Real.negMulLog (if a ≠ x ∧ a ≠ x then p x else 0)) = + ∑ x, if x ≠ a then Real.negMulLog (p x) else 0 := by + apply Finset.sum_congr rfl + intro x _ + by_cases hxa : x = a + · subst x + simp + · have hax : a ≠ x := Ne.symm hxa + simp [hxa, hax] + rw [shannonEntropy] + rw [hsimp, hout] + ring + +theorem coreOutcome_entropy_le + {n : ℕ} {p : Fin n → ℝ} (hp : IsStrictProbabilityVector p) + (a b : Fin n) : + shannonEntropy (pushforwardMass p (coreOutcome a b)) ≤ + shannonEntropy p := by + by_cases hab : a = b + · subst b + exact (coreOutcome_entropy_same p a).le + · rw [coreOutcome_entropy_eq_twoCoreCoarsenedEntropy p hab] + have hu := hp.positive a + have hv := hp.positive b + have hsum : 0 < p a + p b := add_pos hu hv + have hr0 : 0 ≤ p a / (p a + p b) := div_nonneg hu.le hsum.le + have hr1 : p a / (p a + p b) ≤ 1 := + (div_le_one hsum).2 (le_add_of_nonneg_right hv.le) + have hbin : 0 ≤ binaryEntropy (p a / (p a + p b)) := by + rw [binaryEntropy_eq_realBinEntropy] + exact Real.binEntropy_nonneg hr0 hr1 + have hloss := entropy_loss_merge_two hu hv + have hent := entropy_sub_twoCoreCoarsenedEntropy p hab + rw [hloss] at hent + nlinarith + +theorem coreOutcome_comm + {α : Type*} [DecidableEq α] (a b : α) : + coreOutcome a b = coreOutcome b a := by + funext j + by_cases h : j = a ∨ j = b + · have h' : j = b ∨ j = a := h.elim Or.inr Or.inl + simp [coreOutcome, h, h'] + · have h' : ¬(j = b ∨ j = a) := by + intro h' + exact h (h'.elim Or.inr Or.inl) + simp [coreOutcome, h, h'] + +theorem coreOutcome_eq_of_pair_membership + {α : Type*} [DecidableEq α] + {a b c d : α} (hab : a ≠ b) + (ha : a = c ∨ a = d) (hb : b = c ∨ b = d) : + coreOutcome c d = coreOutcome a b := by + rcases ha with ha | ha <;> rcases hb with hb | hb + · exact False.elim (hab (ha.trans hb.symm)) + · rw [ha, hb] + · rw [ha, hb, coreOutcome_comm] + · exact False.elim (hab (ha.trans hb.symm)) + +/-- The exact `L¹` witness of a good row supplies two heavy coordinates. -/ +theorem goodRow_witness_mem_heavyCoordinates + {n : ℕ} {p : Fin n → ℝ} (hp : IsProbabilityVector p) + {η : ℝ} {a b : Fin n} (hab : a ≠ b) + (hdist : halfHalfL1Distance p a b ≤ η) : + a ∈ heavyCoordinates η p ∧ b ∈ heavyCoordinates η p := by + have hq₀ : 0 ≤ 1 - p a - p b := by + have hsum : 0 ≤ + ∑ j, if a ≠ j ∧ b ≠ j then p j else 0 := by + apply Finset.sum_nonneg + intro j _ + split_ifs + · exact hp.nonnegative j + · exact le_rfl + rw [sum_away_from_two hp hab] at hsum + exact hsum + rw [halfHalfL1Distance_eq hp hab] at hdist + have haη : |p a - 1 / 2| ≤ η := by + linarith [abs_nonneg (p b - 1 / 2)] + have hbη : |p b - 1 / 2| ≤ η := by + linarith [abs_nonneg (p a - 1 / 2)] + have ha : 1 / 2 - η ≤ p a := by + linarith [neg_abs_le (p a - 1 / 2)] + have hb : 1 / 2 - η ≤ p b := by + linarith [neg_abs_le (p b - 1 / 2)] + simpa [heavyCoordinates] using And.intro ha hb + +/-- A good row has the paper's half-bit score relative to the coordinate of +the actual two-matching encoding. -/ +theorem goodRow_coordinateEncoding_score + {n : ℕ} {μ : Equiv.Perm (Fin n) → ℝ} + {P : Matrix (Fin n) (Fin n) ℝ} + (hmarg : HasAssignmentMarginals μ P) + (hP : ∀ i, IsStrictProbabilityVector (P i)) + {η : ℝ} (hη₀ : 0 ≤ η) (hη₁ : η ≤ 1 / 10) + (f g : Equiv.Perm (Fin n)) + (hheavy : ∀ i j, j ∈ heavyCoordinates η (P i) → + j = f i ∨ j = g i) + {i : Fin n} (hgood : IsGoodRow η (P i)) : + Real.log 2 / 2 - goodRowOmega η ≤ + rowScore (P i) - + shannonEntropy (pushforwardMass (rowOrientedMass μ) + (fun σ ↦ twoMatchingEncoding f g σ i)) := by + obtain ⟨a, b, hab, hdist, hscore⟩ := + goodRow_score (hP i) hη₀ hη₁ hgood + have hcore := goodRow_witness_mem_heavyCoordinates + (hP i).probability hab hdist + have ha := hheavy i a hcore.1 + have hb := hheavy i b hcore.2 + have houtcome : coreOutcome (f i) (g i) = coreOutcome a b := + coreOutcome_eq_of_pair_membership hab ha hb + have hentropy : + shannonEntropy (pushforwardMass (rowOrientedMass μ) + (fun σ ↦ twoMatchingEncoding f g σ i)) = + twoCoreCoarsenedEntropy (P i) a b := by + rw [coordinateEncoding_mass hmarg f g i, houtcome, + coreOutcome_entropy_eq_twoCoreCoarsenedEntropy (P i) hab] + rw [hentropy] + exact hscore + +/-- The coarse `-1` score bound for any row, relative to the same coordinate +encoding. -/ +theorem coordinateEncoding_score_ge_neg_one + {n : ℕ} {μ : Equiv.Perm (Fin n) → ℝ} + {P : Matrix (Fin n) (Fin n) ℝ} + (hmarg : HasAssignmentMarginals μ P) + (hP : ∀ i, IsStrictProbabilityVector (P i)) + (f g : Equiv.Perm (Fin n)) (i : Fin n) : + -1 ≤ rowScore (P i) - + shannonEntropy (pushforwardMass (rowOrientedMass μ) + (fun σ ↦ twoMatchingEncoding f g σ i)) := by + have hrow := rowScore_ge_entropy_sub_one (hP i).probability + have hentropy : + shannonEntropy (pushforwardMass (rowOrientedMass μ) + (fun σ ↦ twoMatchingEncoding f g σ i)) ≤ + shannonEntropy (P i) := by + rw [coordinateEncoding_mass hmarg f g i] + exact coreOutcome_entropy_le (hP i) (f i) (g i) + linarith + +/-- Paper Lemma 9 with the joint encoding entropy replaced by the sum of its +coordinate entropies. -/ +theorem twoMatching_coreEncoding_sum_coordinates + {n : ℕ} {μ : Equiv.Perm (Fin n) → ℝ} + (hμ : IsProbabilityVector μ) (f g : Equiv.Perm (Fin n)) : + shannonEntropy μ ≤ + (∑ i, shannonEntropy (pushforwardMass (rowOrientedMass μ) + (fun σ ↦ twoMatchingEncoding f g σ i))) + + (alternatingRowPerm f g).cycleFactorsFinset.card * Real.log 2 := by + let μr := rowOrientedMass μ + let Y := twoMatchingEncoding f g + have hμr : IsProbabilityVector μr := rowOrientedMass_isProbabilityVector hμ + have hcore := twoMatching_coreEncoding hμr f g + have hY : IsProbabilityVector (pushforwardMass μr Y) := + pushforwardMass_isProbabilityVector μr hμr Y + have hsub := functionEntropy_le_sum_coordinateEntropies hY + have hcoord (i : Fin n) : + pushforwardMass (pushforwardMass μr Y) (fun y ↦ y i) = + pushforwardMass μr (fun σ ↦ twoMatchingEncoding f g σ i) := by + funext y + rw [pushforwardMass_comp] + congr 1 + simp_rw [hcoord] at hsub + rw [shannonEntropy_rowOrientedMass] at hcore + linarith + +noncomputable def goodRows + {n : ℕ} (η : ℝ) (P : Matrix (Fin n) (Fin n) ℝ) : Finset (Fin n) := by + classical + exact Finset.univ.filter fun i ↦ IsGoodRow η (P i) + +theorem goodRows_disjoint_badRows + {n : ℕ} (η : ℝ) (P : Matrix (Fin n) (Fin n) ℝ) : + Disjoint (goodRows η P) (badRows η P) := by + classical + rw [Finset.disjoint_left] + intro i hgood hbad + simp [goodRows, badRows] at hgood hbad + exact hbad hgood + +theorem goodRows_union_badRows + {n : ℕ} (η : ℝ) (P : Matrix (Fin n) (Fin n) ℝ) : + goodRows η P ∪ badRows η P = Finset.univ := by + classical + ext i + by_cases h : IsGoodRow η (P i) <;> simp [goodRows, badRows, h] + +theorem goodRows_card_add_badRows_card + {n : ℕ} (η : ℝ) (P : Matrix (Fin n) (Fin n) ℝ) : + (goodRows η P).card + (badRows η P).card = n := by + rw [← Finset.card_union_of_disjoint (goodRows_disjoint_badRows η P), + goodRows_union_badRows] + simp + +/-- Sum of the good-row and coarse bad-row estimates, before applying the +joint core-encoding inequality. -/ +theorem sum_coordinateEncoding_score_lower + {n : ℕ} {μ : Equiv.Perm (Fin n) → ℝ} + {P : Matrix (Fin n) (Fin n) ℝ} + (hmarg : HasAssignmentMarginals μ P) + (hP : ∀ i, IsStrictProbabilityVector (P i)) + {η : ℝ} (hη₀ : 0 ≤ η) (hη₁ : η ≤ 1 / 10) + (f g : Equiv.Perm (Fin n)) + (hheavy : ∀ i j, j ∈ heavyCoordinates η (P i) → + j = f i ∨ j = g i) : + ((goodRows η P).card : ℝ) * + (Real.log 2 / 2 - goodRowOmega η) - + (badRows η P).card ≤ + ∑ i, (rowScore (P i) - + shannonEntropy (pushforwardMass (rowOrientedMass μ) + (fun σ ↦ twoMatchingEncoding f g σ i))) := by + let d : Fin n → ℝ := fun i ↦ rowScore (P i) - + shannonEntropy (pushforwardMass (rowOrientedMass μ) + (fun σ ↦ twoMatchingEncoding f g σ i)) + have hgood : ((goodRows η P).card : ℝ) * + (Real.log 2 / 2 - goodRowOmega η) ≤ + ∑ i ∈ goodRows η P, d i := by + calc + ((goodRows η P).card : ℝ) * + (Real.log 2 / 2 - goodRowOmega η) = + ∑ i ∈ goodRows η P, + (Real.log 2 / 2 - goodRowOmega η) := by + rw [Finset.sum_const, nsmul_eq_mul] + _ ≤ ∑ i ∈ goodRows η P, d i := by + apply Finset.sum_le_sum + intro i hi + have hi' : IsGoodRow η (P i) := by + simpa [goodRows] using hi + exact goodRow_coordinateEncoding_score hmarg hP hη₀ hη₁ + f g hheavy hi' + have hbad : -((badRows η P).card : ℝ) ≤ + ∑ i ∈ badRows η P, d i := by + calc + -((badRows η P).card : ℝ) = ∑ i ∈ badRows η P, (-1 : ℝ) := by + rw [Finset.sum_const, nsmul_eq_mul] + ring + _ ≤ ∑ i ∈ badRows η P, d i := by + apply Finset.sum_le_sum + intro i _ + exact coordinateEncoding_score_ge_neg_one hmarg hP f g i + have hpartition : (∑ i, d i) = + (∑ i ∈ goodRows η P, d i) + ∑ i ∈ badRows η P, d i := by + rw [← Finset.sum_union (goodRows_disjoint_badRows η P), + goodRows_union_badRows] + change _ ≤ ∑ i, d i + rw [hpartition] + linarith + +/-- The graph-indexed entropy-score inequality (paper (29)). -/ +theorem divergence_ge_good_bad_cycleScore + {n : ℕ} {μ : Equiv.Perm (Fin n) → ℝ} + {P : Matrix (Fin n) (Fin n) ℝ} + (hμ : IsProbabilityVector μ) + (hmarg : HasAssignmentMarginals μ P) + (hP : ∀ i, IsStrictProbabilityVector (P i)) + {η : ℝ} (hη₀ : 0 ≤ η) (hη₁ : η ≤ 1 / 10) + (f g : Equiv.Perm (Fin n)) + (hheavy : ∀ i j, j ∈ heavyCoordinates η (P i) → + j = f i ∨ j = g i) + {D : ℝ} (hD : D = -shannonEntropy μ + ∑ i, rowScore (P i)) : + ((goodRows η P).card : ℝ) * + (Real.log 2 / 2 - goodRowOmega η) - + (badRows η P).card - + (alternatingRowPerm f g).cycleFactorsFinset.card * Real.log 2 ≤ D := by + have hcore := twoMatching_coreEncoding_sum_coordinates hμ f g + have hrows := sum_coordinateEncoding_score_lower + hmarg hP hη₀ hη₁ f g hheavy + rw [Finset.sum_sub_distrib] at hrows + rw [hD] + linarith + +theorem goodRow_mem_alternating_support + {n : ℕ} {P : Matrix (Fin n) (Fin n) ℝ} + (hP : ∀ i, IsStrictProbabilityVector (P i)) + {η : ℝ} (f g : Equiv.Perm (Fin n)) + (hheavy : ∀ i j, j ∈ heavyCoordinates η (P i) → + j = f i ∨ j = g i) + {i : Fin n} (hgood : IsGoodRow η (P i)) : + i ∈ (alternatingRowPerm f g).support := by + obtain ⟨a, b, hab, hdist⟩ := hgood + have hcore := goodRow_witness_mem_heavyCoordinates + (hP i).probability hab hdist + have ha := hheavy i a hcore.1 + have hb := hheavy i b hcore.2 + have hfg : f i ≠ g i := by + intro h + rcases ha with ha | ha <;> rcases hb with hb | hb + · exact hab (ha.trans hb.symm) + · exact hab (ha.trans (h.trans hb.symm)) + · exact hab (ha.trans (h.symm.trans hb.symm)) + · exact hab (ha.trans hb.symm) + rw [Equiv.Perm.mem_support] + intro hfix + exact hfg ((alternatingRowPerm_fixed_iff f g i).1 hfix) + +/-- The supports of the nontrivial cycle factors partition any set contained +in the support of the ambient permutation. -/ +theorem sum_cycleSupport_inter_card + {α : Type*} [Fintype α] [DecidableEq α] + (h : Equiv.Perm α) (S : Finset α) (hS : S ⊆ h.support) : + (∑ c : h.cycleFactorsFinset, ((c : Equiv.Perm α).support ∩ S).card) = + S.card := by + let t : Equiv.Perm α → Finset α := fun c ↦ c.support ∩ S + have hpair : (↑h.cycleFactorsFinset : Set (Equiv.Perm α)).PairwiseDisjoint t := by + intro c hc d hd hcd + have hdisj := h.cycleFactorsFinset_pairwise_disjoint hc hd hcd + exact hdisj.disjoint_support.mono inf_le_left inf_le_left + have hunion : h.cycleFactorsFinset.biUnion t = S := by + ext i + constructor + · intro hi + obtain ⟨c, _, hi⟩ := Finset.mem_biUnion.mp hi + exact (Finset.mem_inter.mp hi).2 + · intro hi + have hisupp := hS hi + obtain ⟨c, hc, hic⟩ := + Equiv.Perm.mem_support_iff_mem_support_of_mem_cycleFactorsFinset.mp hisupp + exact Finset.mem_biUnion.mpr ⟨c, hc, Finset.mem_inter.mpr ⟨hic, hi⟩⟩ + calc + (∑ c : h.cycleFactorsFinset, + ((c : Equiv.Perm α).support ∩ S).card) = + ∑ c ∈ h.cycleFactorsFinset, (t c).card := by + simpa [t] using Finset.sum_coe_sort h.cycleFactorsFinset + (fun c ↦ (t c).card) + _ = (h.cycleFactorsFinset.biUnion t).card := + (Finset.card_biUnion hpair).symm + _ = S.card := by rw [hunion] + +theorem sum_cycleSupport_inter_card_le + {α : Type*} [Fintype α] [DecidableEq α] + (h : Equiv.Perm α) (S : Finset α) : + (∑ c : h.cycleFactorsFinset, ((c : Equiv.Perm α).support ∩ S).card) ≤ + S.card := by + let t : Equiv.Perm α → Finset α := fun c ↦ c.support ∩ S + have hpair : (↑h.cycleFactorsFinset : Set (Equiv.Perm α)).PairwiseDisjoint t := by + intro c hc d hd hcd + have hdisj := h.cycleFactorsFinset_pairwise_disjoint hc hd hcd + exact hdisj.disjoint_support.mono inf_le_left inf_le_left + have hsubset : h.cycleFactorsFinset.biUnion t ⊆ S := by + intro i hi + obtain ⟨c, _, hi⟩ := Finset.mem_biUnion.mp hi + exact (Finset.mem_inter.mp hi).2 + have hcard := Finset.card_le_card hsubset + rw [Finset.card_biUnion hpair] at hcard + calc + (∑ c : h.cycleFactorsFinset, + ((c : Equiv.Perm α).support ∩ S).card) = + ∑ c ∈ h.cycleFactorsFinset, (t c).card := by + simpa [t] using Finset.sum_coe_sort h.cycleFactorsFinset + (fun c ↦ (t c).card) + _ ≤ S.card := hcard + +noncomputable def cycleGoodCount + {n : ℕ} (η : ℝ) (P : Matrix (Fin n) (Fin n) ℝ) + (h : Equiv.Perm (Fin n)) (c : h.cycleFactorsFinset) : ℕ := + ((c : Equiv.Perm (Fin n)).support ∩ goodRows η P).card + +noncomputable def cycleBadCount + {n : ℕ} (η : ℝ) (P : Matrix (Fin n) (Fin n) ℝ) + (h : Equiv.Perm (Fin n)) (c : h.cycleFactorsFinset) : ℕ := + ((c : Equiv.Perm (Fin n)).support ∩ badRows η P).card + +noncomputable def longCycleGoodRows + {n : ℕ} (η : ℝ) (P : Matrix (Fin n) (Fin n) ℝ) + (h : Equiv.Perm (Fin n)) : ℕ := + ∑ c : h.cycleFactorsFinset, + longComponentGoodRows (c : Equiv.Perm (Fin n)).support.card + (cycleGoodCount η P h c) + +/-- Indicator that a nontrivial alternating component has exactly two rows, +both of them good. Such a component is one of the paper's clean pairs. -/ +noncomputable def cleanCycleIndicator + {n : ℕ} (η : ℝ) (P : Matrix (Fin n) (Fin n) ℝ) + (h : Equiv.Perm (Fin n)) (c : h.cycleFactorsFinset) : ℕ := + if (c : Equiv.Perm (Fin n)).support.card = 2 ∧ + cycleGoodCount η P h c = 2 then 1 else 0 + +noncomputable def cleanCycleCount + {n : ℕ} (η : ℝ) (P : Matrix (Fin n) (Fin n) ℝ) + (h : Equiv.Perm (Fin n)) : ℕ := + ∑ c : h.cycleFactorsFinset, cleanCycleIndicator η P h c + +theorem cycleGoodCount_add_cycleBadCount + {n : ℕ} (η : ℝ) (P : Matrix (Fin n) (Fin n) ℝ) + (h : Equiv.Perm (Fin n)) (c : h.cycleFactorsFinset) : + cycleGoodCount η P h c + cycleBadCount η P h c = + (c : Equiv.Perm (Fin n)).support.card := by + have hdisj : Disjoint + ((c : Equiv.Perm (Fin n)).support ∩ goodRows η P) + ((c : Equiv.Perm (Fin n)).support ∩ badRows η P) := + (goodRows_disjoint_badRows η P).mono inf_le_right inf_le_right + rw [cycleGoodCount, cycleBadCount, + ← Finset.card_union_of_disjoint hdisj] + congr 1 + ext i + simp only [Finset.mem_union, Finset.mem_inter] + constructor + · rintro (⟨hi, _⟩ | ⟨hi, _⟩) <;> exact hi + · intro hi + have hcover : i ∈ goodRows η P ∪ badRows η P := by + rw [goodRows_union_badRows] + simp + rcases Finset.mem_union.mp hcover with hgood | hbad + · exact Or.inl ⟨hi, hgood⟩ + · exact Or.inr ⟨hi, hbad⟩ + +/-- Paper component accounting (30), now instantiated with the actual cycle +factors of the completed two-matching graph. -/ +theorem alternating_component_accounting + {n : ℕ} {P : Matrix (Fin n) (Fin n) ℝ} + (hP : ∀ i, IsStrictProbabilityVector (P i)) + {η : ℝ} (f g : Equiv.Perm (Fin n)) + (hheavy : ∀ i j, j ∈ heavyCoordinates η (P i) → + j = f i ∨ j = g i) : + ((longCycleGoodRows η P (alternatingRowPerm f g) : ℕ) : ℝ) / 6 - + ((badRows η P).card : ℝ) / 2 ≤ + ((goodRows η P).card : ℝ) / 2 - + ((alternatingRowPerm f g).cycleFactorsFinset.card : ℝ) := by + let h := alternatingRowPerm f g + let k : h.cycleFactorsFinset → ℕ := + fun c ↦ (c : Equiv.Perm (Fin n)).support.card + let gc : h.cycleFactorsFinset → ℕ := cycleGoodCount η P h + let bc : h.cycleFactorsFinset → ℕ := cycleBadCount η P h + have hk2 : ∀ c, 2 ≤ k c := by + intro c + exact (Equiv.Perm.mem_cycleFactorsFinset_iff.mp c.property).1.two_le_card_support + have hpartition : ∀ c, gc c + bc c = k c := by + intro c + exact cycleGoodCount_add_cycleBadCount η P h c + have hcomp := component_accounting k gc bc + (fun c ↦ le_trans (by norm_num) (hk2 c)) hpartition + (fun c hc ↦ False.elim (by + have hc2 := hk2 c + omega)) + have hgoodSupport : goodRows η P ⊆ h.support := by + intro i hi + have hgood : IsGoodRow η (P i) := by simpa [goodRows] using hi + exact goodRow_mem_alternating_support hP f g hheavy hgood + have hgoodSum : (∑ c, gc c) = (goodRows η P).card := by + simpa [gc, cycleGoodCount] using + sum_cycleSupport_inter_card h (goodRows η P) hgoodSupport + have hbadSum : (∑ c, bc c) ≤ (badRows η P).card := by + simpa [bc, cycleBadCount] using + sum_cycleSupport_inter_card_le h (badRows η P) + have hm : (∑ c, nontrivialComponentCount (k c)) = + h.cycleFactorsFinset.card := by + calc + (∑ c, nontrivialComponentCount (k c)) = ∑ _c, 1 := by + apply Finset.sum_congr rfl + intro c _ + simp [nontrivialComponentCount, hk2 c] + _ = h.cycleFactorsFinset.card := by simp + have hlong : (∑ c, longComponentGoodRows (k c) (gc c)) = + longCycleGoodRows η P h := by rfl + have hgoodSumR : (∑ c, (gc c : ℝ)) = + ((goodRows η P).card : ℝ) := by + exact_mod_cast hgoodSum + have hmR : (∑ c, (nontrivialComponentCount (k c) : ℝ)) = + (h.cycleFactorsFinset.card : ℝ) := by + exact_mod_cast hm + have hlongR : (∑ c, (longComponentGoodRows (k c) (gc c) : ℝ)) = + (longCycleGoodRows η P h : ℝ) := by + exact_mod_cast hlong + rw [hgoodSumR, hmR, hlongR] at hcomp + have hbadCast : (∑ c, (bc c : ℝ)) ≤ ((badRows η P).card : ℝ) := by + exact_mod_cast hbadSum + linarith + +/-- Full graph-indexed robust cycle-information inequality, paper Lemma 13. -/ +theorem robust_cycle_information_twoMatchings + {n : ℕ} {μ : Equiv.Perm (Fin n) → ℝ} + {P : Matrix (Fin n) (Fin n) ℝ} + (hμ : IsProbabilityVector μ) + (hmarg : HasAssignmentMarginals μ P) + (hP : ∀ i, IsStrictProbabilityVector (P i)) + {η : ℝ} (hη₀ : 0 ≤ η) (hη₁ : η ≤ 1 / 10) + (f g : Equiv.Perm (Fin n)) + (hheavy : ∀ i j, j ∈ heavyCoordinates η (P i) → + j = f i ∨ j = g i) + {D : ℝ} (hD : D = -shannonEntropy μ + ∑ i, rowScore (P i)) : + Real.log 2 / 6 * + (longCycleGoodRows η P (alternatingRowPerm f g) : ℕ) - + (1 + Real.log 2 / 2) * (badRows η P).card - + n * goodRowOmega η ≤ D := by + have hscore := divergence_ge_good_bad_cycleScore + hμ hmarg hP hη₀ hη₁ f g hheavy hD + have haccount := alternating_component_accounting hP f g hheavy + have hG : ((goodRows η P).card : ℝ) ≤ n := by + have hGNat : (goodRows η P).card ≤ n := by + simpa using Finset.card_le_univ (goodRows η P) + exact_mod_cast hGNat + exact robust_cycle_information_of_accounting + (goodRowOmega_nonneg η) hG hscore haccount + +/-- The exact graph-indexed form of paper (31): after discarding bad rows +and good rows in long components, the remaining rows occur in vertex-disjoint +clean two-row components. -/ +theorem alternating_cleanCycle_count + {n : ℕ} {P : Matrix (Fin n) (Fin n) ℝ} + (hP : ∀ i, IsStrictProbabilityVector (P i)) + {η : ℝ} (f g : Equiv.Perm (Fin n)) + (hheavy : ∀ i j, j ∈ heavyCoordinates η (P i) → + j = f i ∨ j = g i) : + n ≤ 2 * (badRows η P).card + + longCycleGoodRows η P (alternatingRowPerm f g) + + 2 * cleanCycleCount η P (alternatingRowPerm f g) := by + let h := alternatingRowPerm f g + let k : h.cycleFactorsFinset → ℕ := + fun c ↦ (c : Equiv.Perm (Fin n)).support.card + let gc : h.cycleFactorsFinset → ℕ := cycleGoodCount η P h + let bc : h.cycleFactorsFinset → ℕ := cycleBadCount η P h + have hk2 : ∀ c, 2 ≤ k c := by + intro c + exact (Equiv.Perm.mem_cycleFactorsFinset_iff.mp c.property).1.two_le_card_support + have hpoint : ∀ c, gc c ≤ + 2 * cleanCycleIndicator η P h c + bc c + + longComponentGoodRows (k c) (gc c) := by + intro c + have hpart : gc c + bc c = k c := + cycleGoodCount_add_cycleBadCount η P h c + by_cases hk3 : 3 ≤ k c + · simp [cleanCycleIndicator, longComponentGoodRows, hk3] + · have hc2 := hk2 c + have hkEq : k c = 2 := by omega + by_cases hg2 : gc c = 2 + · have hclean : + (c : Equiv.Perm (Fin n)).support.card = 2 ∧ + cycleGoodCount η P h c = 2 := by + simpa [k, gc] using And.intro hkEq hg2 + rw [cleanCycleIndicator, if_pos hclean] + simp [longComponentGoodRows, hkEq] + omega + · have hgb : gc c ≤ bc c := by omega + have hnotclean : ¬((c : Equiv.Perm (Fin n)).support.card = 2 ∧ + cycleGoodCount η P h c = 2) := by + intro hclean + exact hg2 (by simpa [gc] using hclean.2) + rw [cleanCycleIndicator, if_neg hnotclean] + simp [longComponentGoodRows, hkEq] + exact hgb + have hsum := Finset.sum_le_sum (s := Finset.univ) + (fun c _ ↦ hpoint c) + have hsum' : (∑ c, gc c) ≤ + 2 * cleanCycleCount η P h + (∑ c, bc c) + + longCycleGoodRows η P h := by + simpa [cleanCycleCount, longCycleGoodRows, + Finset.sum_add_distrib, Finset.mul_sum] using hsum + have hgoodSupport : goodRows η P ⊆ h.support := by + intro i hi + have hgood : IsGoodRow η (P i) := by simpa [goodRows] using hi + exact goodRow_mem_alternating_support hP f g hheavy hgood + have hgoodSum : (∑ c, gc c) = (goodRows η P).card := by + simpa [gc, cycleGoodCount] using + sum_cycleSupport_inter_card h (goodRows η P) hgoodSupport + have hbadSum : (∑ c, bc c) ≤ (badRows η P).card := by + simpa [bc, cycleBadCount] using + sum_cycleSupport_inter_card_le h (badRows η P) + have hrows := goodRows_card_add_badRows_card (η := η) P + rw [hgoodSum] at hsum' + have hfinal : n ≤ 2 * (badRows η P).card + + longCycleGoodRows η P h + 2 * cleanCycleCount η P h := by + omega + simpa [h] using hfinal + +/-- Paper Lemma 13 for the Gibbs law of a positive matrix, with the completed +heavy graph and its two perfect matchings constructed rather than assumed. -/ +theorem exists_gibbs_robust_cycle_information + {n : ℕ} (A : Matrix (Fin n) (Fin n) ℝ) + (hA : ∀ i j, 0 < A i j) + {η : ℝ} (hη₀ : 0 ≤ η) (hη₁ : η ≤ 1 / 10) : + ∃ f g : Equiv.Perm (Fin n), + (∀ i j, j ∈ heavyCoordinates η (assignmentMarginal A i) → + j = f i ∨ j = g i) ∧ + Real.log 2 / 6 * + (longCycleGoodRows η (assignmentMarginal A) + (alternatingRowPerm f g) : ℕ) - + (1 + Real.log 2 / 2) * + (badRows η (assignmentMarginal A)).card - + n * goodRowOmega η ≤ gibbsSequentialDivergence A := by + have hper := permanent_pos_of_positive A hA + have hDS : IsDoublyStochastic (assignmentMarginal A) := + assignmentMarginal_doublyStochastic A + (fun i j ↦ (hA i j).le) hper.ne' + obtain ⟨f, g, hheavy⟩ := + exists_heavyCompletion_twoMatchings hDS hη₁ + refine ⟨f, g, hheavy, ?_⟩ + exact robust_cycle_information_twoMatchings + (gibbsProbability_isProbabilityVector A hA) + (gibbs_hasAssignmentMarginals A) + (assignmentMarginal_strictProbabilityVector A hA) + hη₀ hη₁ f g hheavy + (gibbsSequentialDivergence_eq_entropy A hA) + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/RoundedEllipsoid.lean b/LeanPool/BeyondBethe/BeyondBethe/RoundedEllipsoid.lean new file mode 100644 index 0000000000..3d153960e6 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/RoundedEllipsoid.lean @@ -0,0 +1,370 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MatrixPerturbation +import Mathlib.Tactic + +/-! # Rounded Ellipsoid -/ + +open scoped BigOperators + +namespace BeyondBethe + +/-! +# Containment tools for a rounded rational ellipsoid + +After an exact central-cut update we floor the center and basis to a fixed +dyadic grid and inflate the rounded basis. The lemmas below construct the +new unit-ball coordinate explicitly with the adjugate formula and bound it +entry by entry. Thus nonsingularity and containment are quantitative +consequences of displayed inequalities, not numerical assumptions. +-/ + +/-- Floor the center and basis, then inflate the basis by `1 + η`. -/ +def inflatedDyadicRound {d : ℕ} (p : ℕ) (η : ℚ) + (E : RationalEllipsoidState d) : RationalEllipsoidState d where + center := dyadicFloorVector p E.center + basis := fun i j ↦ (1 + η) * dyadicFloorMatrix p E.basis i j + +/-- The bounded-bit central-cut update: perform the exact rational update, +then round and inflate. -/ +def roundedRationalEllipsoidCentralUpdate {d : ℕ} + (p : ℕ) (η : ℚ) (E : RationalEllipsoidState d) + (a : Fin d → ℚ) : RationalEllipsoidState d := + inflatedDyadicRound p η (rationalEllipsoidCentralUpdate E a) + +@[simp] theorem inflatedDyadicRound_center {d : ℕ} (p : ℕ) (η : ℚ) + (E : RationalEllipsoidState d) : + (inflatedDyadicRound p η E).center = dyadicFloorVector p E.center := rfl + +@[simp] theorem inflatedDyadicRound_basis_apply {d : ℕ} (p : ℕ) (η : ℚ) + (E : RationalEllipsoidState d) (i j : Fin d) : + (inflatedDyadicRound p η E).basis i j = + (1 + η) * dyadicFloorMatrix p E.basis i j := rfl + +/-- Cramer's-rule correction solving `A v = e`. This is used only to exhibit +a real preimage in the correctness proof; it is not part of the executable +state. -/ +noncomputable def adjugateCorrection {d : ℕ} (A : Matrix (Fin d) (Fin d) ℝ) + (e : Fin d → ℝ) : Fin d → ℝ := + (Matrix.det A)⁻¹ • Matrix.cramer A e + +theorem mulVec_adjugateCorrection {d : ℕ} + (A : Matrix (Fin d) (Fin d) ℝ) (e : Fin d → ℝ) + (hdet : Matrix.det A ≠ 0) : + Matrix.mulVec A (adjugateCorrection A e) = e := by + rw [adjugateCorrection, Matrix.mulVec_smul, Matrix.mulVec_cramer] + ext i + simp [hdet] + +theorem finiteNormSq_le_card_mul_sq_of_abs_le {d : ℕ} + (v : Fin d → ℝ) {V : ℝ} (hV : 0 ≤ V) + (hv : ∀ i, abs (v i) ≤ V) : + finiteNormSq v ≤ d * V ^ 2 := by + rw [finiteNormSq, finiteDot, + show (d : ℝ) * V ^ 2 = ∑ _i : Fin d, V ^ 2 by simp] + apply Finset.sum_le_sum + intro i _ + have habs0 : 0 ≤ abs (v i) := abs_nonneg _ + calc + v i * v i = abs (v i) ^ 2 := by rw [sq_abs, sq] + _ ≤ V ^ 2 := (sq_le_sq₀ habs0 hV).2 (hv i) + +/-- Entrywise bound for the adjugate correction. -/ +theorem abs_adjugateCorrection_le {d : ℕ} + (A : Matrix (Fin d) (Fin d) ℝ) (e : Fin d → ℝ) + {D M E : ℝ} (hD : 0 < D) (hdet : D ≤ abs (Matrix.det A)) + (hM : 1 ≤ M) (hA : ∀ i j, abs (A i j) ≤ M) + (he : ∀ i, abs (e i) ≤ E) (hE : 0 ≤ E) (i : Fin d) : + abs (adjugateCorrection A e i) ≤ + (d * (d.factorial * M ^ d) * E) / D := by + have hdet0 : Matrix.det A ≠ 0 := by + intro hz + rw [hz, abs_zero] at hdet + linarith + have hcramer : abs (Matrix.cramer A e i) ≤ + d * (d.factorial * M ^ d) * E := by + rw [Matrix.cramer_eq_adjugate_mulVec, Matrix.mulVec, dotProduct] + calc + abs (∑ j, A.adjugate i j * e j) ≤ + ∑ j, abs (A.adjugate i j * e j) := + Finset.abs_sum_le_sum_abs _ _ + _ ≤ ∑ _j : Fin d, (d.factorial * M ^ d) * E := by + apply Finset.sum_le_sum + intro j _ + rw [abs_mul] + exact mul_le_mul + (abs_adjugate_entry_le_of_entrywise A hM hA i j) (he j) + (abs_nonneg _) (by positivity) + _ = d * (d.factorial * M ^ d) * E := by simp; ring + rw [adjugateCorrection, Pi.smul_apply, smul_eq_mul, abs_mul] + have hdetAbs : 0 < abs (Matrix.det A) := abs_pos.mpr hdet0 + have hinv : (abs (Matrix.det A))⁻¹ ≤ D⁻¹ := by + exact (inv_le_inv₀ hdetAbs hD).2 hdet + calc + abs ((Matrix.det A)⁻¹) * abs (Matrix.cramer A e i) = + (abs (Matrix.det A))⁻¹ * abs (Matrix.cramer A e i) := by + rw [abs_inv] + _ ≤ + D⁻¹ * (d * (d.factorial * M ^ d) * E) := by + exact mul_le_mul hinv hcramer (abs_nonneg _) (inv_nonneg.mpr hD.le) + _ = (d * (d.factorial * M ^ d) * E) / D := by + rw [div_eq_mul_inv] + ring + +/-- A small correction keeps the sum of an old unit vector and the +correction inside the ball inflated by `1 + η`. -/ +theorem finiteNormSq_add_le_inflation_sq {d : ℕ} + {y v : Fin d → ℝ} {η : ℝ} (hη : 0 ≤ η) + (hy : finiteNormSq y ≤ 1) (hv : finiteNormSq v ≤ η ^ 2) : + finiteNormSq (fun i ↦ y i + v i) ≤ (1 + η) ^ 2 := by + have hv0 := finiteNormSq_nonneg v + have hdotSq := finiteDot_sq_le_normSq_mul_normSq y v + have hynonneg := finiteNormSq_nonneg y + have hprod : finiteNormSq y * finiteNormSq v ≤ η ^ 2 := by + calc + finiteNormSq y * finiteNormSq v ≤ 1 * finiteNormSq v := by + exact mul_le_mul_of_nonneg_right hy hv0 + _ ≤ η ^ 2 := by simpa using hv + have habsdot : abs (finiteDot y v) ≤ η := by + have hsquare : abs (finiteDot y v) ^ 2 ≤ η ^ 2 := by + rw [sq_abs] + exact hdotSq.trans hprod + nlinarith [abs_nonneg (finiteDot y v)] + rw [finiteNormSq_add] + nlinarith [le_abs_self (finiteDot y v)] + +/-- Quantitative containment after dyadic rounding and inflation. All +quantities controlling the inverse are explicit: `D` is a determinant lower +bound, `M` is an entry bound for the rounded basis, and the final displayed +inequality is precisely the rounding-smallness condition. -/ +theorem inflatedDyadicRound_contains {d : ℕ} (hd : 0 < d) + (p : ℕ) (η : ℚ) (E : RationalEllipsoidState d) + {D M : ℝ} (hη : 0 ≤ η) (hD : 0 < D) (hM : 1 ≤ M) + (hA : ∀ i j, + abs (((dyadicFloorMatrix p E.basis i j : ℚ) : ℝ)) ≤ M) + (hdet : D ≤ abs (Matrix.det + (fun i j ↦ ((dyadicFloorMatrix p E.basis i j : ℚ) : ℝ)))) + (hsmall : + d * + ((d * (d.factorial * M ^ d) * + ((d + 1 : ℕ) * (dyadicMesh p : ℝ))) / D) ^ 2 ≤ + (η : ℝ) ^ 2) + {y : Fin d → ℝ} (hy : finiteNormSq y ≤ 1) : + ∃ y' : Fin d → ℝ, finiteNormSq y' ≤ 1 ∧ + rationalEllipsoidPoint (inflatedDyadicRound p η E) y' = + rationalEllipsoidPoint E y := by + let A : Matrix (Fin d) (Fin d) ℝ := + fun i j ↦ ((dyadicFloorMatrix p E.basis i j : ℚ) : ℝ) + let e : Fin d → ℝ := fun i ↦ + (E.center i : ℝ) - (dyadicFloorVector p E.center i : ℝ) + + ∑ j, ((E.basis i j : ℝ) - A i j) * y j + let v : Fin d → ℝ := adjugateCorrection A e + let s : ℝ := 1 + (η : ℝ) + let y' : Fin d → ℝ := fun i ↦ s⁻¹ * (y i + v i) + have hηR : 0 ≤ (η : ℝ) := Rat.cast_nonneg.mpr hη + have hs : 0 < s := by dsimp only [s]; linarith + have hdetA : D ≤ abs (Matrix.det A) := by simpa only [A] using hdet + have hdet0 : Matrix.det A ≠ 0 := by + intro hz + rw [hz, abs_zero] at hdetA + linarith + have hycoord : ∀ j, abs (y j) ≤ 1 := + fun j ↦ abs_coordinate_le_one_of_normSq_le_one hy j + have hcenter : ∀ i, + abs ((E.center i : ℝ) - + (dyadicFloorVector p E.center i : ℝ)) ≤ (dyadicMesh p : ℝ) := by + intro i + have h := abs_dyadicFloor_sub_lt p (E.center i) + have hcast : abs (((dyadicFloor p (E.center i) - E.center i : ℚ) : ℝ)) < + (dyadicMesh p : ℝ) := by exact_mod_cast h + rw [Rat.cast_sub, abs_sub_comm] at hcast + simpa only [dyadicFloorVector] using hcast.le + have hbasis : ∀ i j, + abs ((E.basis i j : ℝ) - A i j) ≤ (dyadicMesh p : ℝ) := by + intro i j + have h := cast_dyadicFloorMatrix_entry_error_lt p E.basis i j + rw [Rat.cast_sub, abs_sub_comm] at h + simpa only [A] using h.le + have hmesh0 : (0 : ℝ) ≤ (dyadicMesh p : ℝ) := by + exact_mod_cast dyadicMesh_nonneg p + have he : ∀ i, + abs (e i) ≤ ((d + 1 : ℕ) : ℝ) * (dyadicMesh p : ℝ) := by + intro i + dsimp only [e] + calc + abs ((E.center i : ℝ) - + (dyadicFloorVector p E.center i : ℝ) + + ∑ j, ((E.basis i j : ℝ) - A i j) * y j) ≤ + abs ((E.center i : ℝ) - + (dyadicFloorVector p E.center i : ℝ)) + + abs (∑ j, ((E.basis i j : ℝ) - A i j) * y j) := + abs_add_le _ _ + _ ≤ (dyadicMesh p : ℝ) + + ∑ j, abs (((E.basis i j : ℝ) - A i j) * y j) := + add_le_add (hcenter i) (Finset.abs_sum_le_sum_abs _ _) + _ ≤ (dyadicMesh p : ℝ) + + ∑ _j : Fin d, (dyadicMesh p : ℝ) := by + gcongr with j + rw [abs_mul] + calc + abs ((E.basis i j : ℝ) - A i j) * abs (y j) ≤ + (dyadicMesh p : ℝ) * 1 := + mul_le_mul (hbasis i j) (hycoord j) (abs_nonneg _) hmesh0 + _ = (dyadicMesh p : ℝ) := mul_one _ + _ = ((d + 1 : ℕ) : ℝ) * (dyadicMesh p : ℝ) := by + simp + ring + let V : ℝ := + (d * (d.factorial * M ^ d) * + (((d + 1 : ℕ) : ℝ) * (dyadicMesh p : ℝ))) / D + have hV0 : 0 ≤ V := by + dsimp only [V] + positivity + have hvcoord : ∀ i, abs (v i) ≤ V := by + intro i + dsimp only [v, V] + exact abs_adjugateCorrection_le A e hD hdetA hM + (by simpa only [A] using hA) he (by positivity) i + have hvnorm : finiteNormSq v ≤ (η : ℝ) ^ 2 := by + have hvbound := finiteNormSq_le_card_mul_sq_of_abs_le v hV0 hvcoord + exact hvbound.trans (by simpa only [V] using hsmall) + have hadd : finiteNormSq (fun i ↦ y i + v i) ≤ s ^ 2 := by + simpa only [s] using finiteNormSq_add_le_inflation_sq hηR hy hvnorm + have hy' : finiteNormSq y' ≤ 1 := by + have hs2 : 0 < s ^ 2 := sq_pos_of_pos hs + rw [show y' = fun i ↦ s⁻¹ * (y i + v i) by rfl, + finiteNormSq_smul] + rw [inv_pow] + calc + (s ^ 2)⁻¹ * finiteNormSq (fun i ↦ y i + v i) ≤ + (s ^ 2)⁻¹ * s ^ 2 := + mul_le_mul_of_nonneg_left hadd (inv_nonneg.mpr hs2.le) + _ = 1 := inv_mul_cancel₀ hs2.ne' + refine ⟨y', hy', ?_⟩ + have hAv : Matrix.mulVec A v = e := + mulVec_adjugateCorrection A e hdet0 + ext i + rw [rationalEllipsoidPoint, rationalEllipsoidPoint] + change + (dyadicFloorVector p E.center i : ℝ) + + ∑ j, (((1 + η) * dyadicFloorMatrix p E.basis i j : ℚ) : ℝ) * y' j = + (E.center i : ℝ) + ∑ j, (E.basis i j : ℝ) * y j + have hsCast : ((1 + η : ℚ) : ℝ) = s := by simp [s] + simp_rw [Rat.cast_mul, hsCast] + have hcancel : ∀ j, s * A i j * y' j = A i j * (y j + v j) := by + intro j + dsimp only [y'] + field_simp [hs.ne'] + rw [show + (∑ j, s * ((dyadicFloorMatrix p E.basis i j : ℚ) : ℝ) * y' j) = + ∑ j, A i j * (y j + v j) by + apply Finset.sum_congr rfl + intro j _ + simpa only [A] using hcancel j] + rw [show (∑ j, A i j * (y j + v j)) = + ∑ j, A i j * y j + Matrix.mulVec A v i by + simp [Matrix.mulVec, dotProduct, mul_add, Finset.sum_add_distrib]] + rw [hAv] + dsimp only [e] + ring_nf + rw [Finset.sum_sub_distrib] + ring + +/-- Exact determinant formula for the stored rounded-and-inflated basis. -/ +theorem det_inflatedDyadicRound_basis {d : ℕ} (p : ℕ) (η : ℚ) + (E : RationalEllipsoidState d) : + Matrix.det (inflatedDyadicRound p η E).basis = + (1 + η) ^ d * Matrix.det (dyadicFloorMatrix p E.basis) := by + have hbasis : (inflatedDyadicRound p η E).basis = + (1 + η) • dyadicFloorMatrix p E.basis := by + ext i j + simp [inflatedDyadicRound, Matrix.smul_apply] + rw [hbasis, Matrix.det_smul, Fintype.card_fin] + +/-- Determinant upper bound after rounding and inflation. -/ +theorem abs_det_inflatedDyadicRound_le {d : ℕ} + (p : ℕ) (η : ℚ) (E : RationalEllipsoidState d) + {M : ℝ} (hη : 0 ≤ η) (hM : 1 ≤ M) + (hE : ∀ i j, abs ((E.basis i j : ℚ) : ℝ) ≤ M) : + abs ((Matrix.det (inflatedDyadicRound p η E).basis : ℚ) : ℝ) ≤ + (1 + (η : ℝ)) ^ d * + (abs ((Matrix.det E.basis : ℚ) : ℝ) + + d.factorial * + (d * (dyadicMesh p : ℝ) * (2 * M) ^ d)) := by + have hscale : 0 ≤ (1 + (η : ℝ)) ^ d := by + exact pow_nonneg (by exact_mod_cast (show (0 : ℚ) ≤ 1 + η by linarith)) _ + have hpert := abs_det_dyadicFloorMatrix_sub_det_le p E.basis hM hE + have hround : + abs ((Matrix.det (dyadicFloorMatrix p E.basis) : ℚ) : ℝ) ≤ + abs ((Matrix.det E.basis : ℚ) : ℝ) + + d.factorial * (d * (dyadicMesh p : ℝ) * (2 * M) ^ d) := by + have htriangle : + abs (Matrix.det + (fun i j ↦ ((dyadicFloorMatrix p E.basis i j : ℚ) : ℝ))) ≤ + abs (Matrix.det (fun i j ↦ ((E.basis i j : ℚ) : ℝ))) + + abs (Matrix.det + (fun i j ↦ ((dyadicFloorMatrix p E.basis i j : ℚ) : ℝ)) - + Matrix.det (fun i j ↦ ((E.basis i j : ℚ) : ℝ))) := by + have := abs_add_le + (Matrix.det (fun i j ↦ ((E.basis i j : ℚ) : ℝ))) + (Matrix.det + (fun i j ↦ ((dyadicFloorMatrix p E.basis i j : ℚ) : ℝ)) - + Matrix.det (fun i j ↦ ((E.basis i j : ℚ) : ℝ))) + convert this using 1 <;> ring + have hcastRound : + Matrix.det + (fun i j ↦ ((dyadicFloorMatrix p E.basis i j : ℚ) : ℝ)) = + ((Matrix.det (dyadicFloorMatrix p E.basis) : ℚ) : ℝ) := by + rw [show (fun i j ↦ ((dyadicFloorMatrix p E.basis i j : ℚ) : ℝ)) = + (dyadicFloorMatrix p E.basis).map (fun q : ℚ ↦ (q : ℝ)) by rfl, + Rat.cast_det] + have hcastE : + Matrix.det (fun i j ↦ ((E.basis i j : ℚ) : ℝ)) = + ((Matrix.det E.basis : ℚ) : ℝ) := by + rw [show (fun i j ↦ ((E.basis i j : ℚ) : ℝ)) = + E.basis.map (fun q : ℚ ↦ (q : ℝ)) by rfl, Rat.cast_det] + rw [hcastRound, hcastE] at htriangle hpert + linarith + rw [det_inflatedDyadicRound_basis] + rw [Rat.cast_mul, Rat.cast_pow, Rat.cast_add, Rat.cast_one] + rw [abs_mul, abs_pow, + abs_of_nonneg (by exact_mod_cast (show (0 : ℚ) ≤ 1 + η by linarith))] + exact mul_le_mul_of_nonneg_left hround hscale + +/-- A valid central cut followed by sufficiently fine rounding preserves +every surviving point. -/ +theorem roundedRationalEllipsoidCentralUpdate_contains {d : ℕ} + (hd : 0 < d) (p : ℕ) (η : ℚ) + (E : RationalEllipsoidState d) (a : Fin d → ℚ) + {D M : ℝ} (hη : 0 ≤ η) (hD : 0 < D) (hM : 1 ≤ M) + (hA : ∀ i j, + abs (((dyadicFloorMatrix p + (rationalEllipsoidCentralUpdate E a).basis i j : ℚ) : ℝ)) ≤ M) + (hdet : D ≤ abs (Matrix.det + (fun i j ↦ ((dyadicFloorMatrix p + (rationalEllipsoidCentralUpdate E a).basis i j : ℚ) : ℝ)))) + (hsmall : + d * + ((d * (d.factorial * M ^ d) * + ((d + 1 : ℕ) * (dyadicMesh p : ℝ))) / D) ^ 2 ≤ + (η : ℝ) ^ 2) + {y : Fin d → ℝ} (hy : finiteNormSq y ≤ 1) + (hb : rationalPulledBackNormal E a ≠ 0) + (hcut : finiteDot + (fun i ↦ (rationalPulledBackNormal E a i : ℝ)) y ≤ 0) : + ∃ y' : Fin d → ℝ, finiteNormSq y' ≤ 1 ∧ + rationalEllipsoidPoint + (roundedRationalEllipsoidCentralUpdate p η E a) y' = + rationalEllipsoidPoint E y := by + obtain ⟨z, hz, hpoint⟩ := + rationalEllipsoidCentralUpdate_contains hd E a hb hy hcut + obtain ⟨z', hz', hrounded⟩ := inflatedDyadicRound_contains hd p η + (rationalEllipsoidCentralUpdate E a) hη hD hM hA hdet hsmall hz + refine ⟨z', hz', ?_⟩ + rw [roundedRationalEllipsoidCentralUpdate, hrounded, hpoint] + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/RoundedEllipsoidBitBounds.lean b/LeanPool/BeyondBethe/BeyondBethe/RoundedEllipsoidBitBounds.lean new file mode 100644 index 0000000000..9507233c57 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/RoundedEllipsoidBitBounds.lean @@ -0,0 +1,539 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.AdaptiveRoundedEllipsoid +import Mathlib.Tactic + +/-! # Rounded Ellipsoid Bit Bounds -/ + +open scoped BigOperators + +namespace BeyondBethe + +/-! +# Magnitude bounds for the bounded-bit ellipsoid + +The estimates in this file are deliberately coarse. Their purpose is to +show that the logarithm of every stored magnitude grows only linearly with +the number of cuts. Together with the determinant lower bound, this gives +a global polynomial bound on the magnitude-sensitive rounding precision. +-/ + +theorem natCast_le_two_pow_self (n : ℕ) : + (n : ℚ) ≤ (2 : ℚ) ^ n := by + induction n with + | zero => norm_num + | succ n ih => + by_cases hn : n = 0 + · subst n + norm_num + · have hone : (1 : ℚ) ≤ (2 : ℚ) ^ n := one_le_pow₀ (by norm_num) + rw [pow_succ] + push_cast at ih ⊢ + nlinarith + +theorem factorialCast_le_two_pow_sq (d : ℕ) : + (d.factorial : ℚ) ≤ (2 : ℚ) ^ (d ^ 2) := by + have hfac : d.factorial ≤ d ^ d := Nat.factorial_le_pow d + have hd : (d : ℚ) ≤ (2 : ℚ) ^ d := natCast_le_two_pow_self d + have hpow : (d : ℚ) ^ d ≤ ((2 : ℚ) ^ d) ^ d := + pow_le_pow_left₀ (by positivity) hd d + calc + (d.factorial : ℚ) ≤ ((d ^ d : ℕ) : ℚ) := by exact_mod_cast hfac + _ = (d : ℚ) ^ d := by norm_num + _ ≤ ((2 : ℚ) ^ d) ^ d := hpow + _ = (2 : ℚ) ^ (d ^ 2) := by rw [← pow_mul, pow_two] + +/-- Binary exponent dominating the common adaptive-rounding denominator +when `M ≤ 2^K`. -/ +def roundedEllipsoidDenominatorExponent (d K : ℕ) : ℕ := + 12 + 8 * d + d ^ 2 + d * K + +theorem roundedEllipsoidCoarseDenominator_le_two_pow + {d K : ℕ} {M : ℚ} (hM0 : 0 ≤ M) + (hM : M ≤ (2 : ℚ) ^ K) : + roundedEllipsoidCoarseDenominator d M ≤ + (2 : ℚ) ^ roundedEllipsoidDenominatorExponent d K := by + have hd : (d : ℚ) ≤ (2 : ℚ) ^ d := natCast_le_two_pow_self d + have hdsix : (d : ℚ) ^ 6 ≤ ((2 : ℚ) ^ d) ^ 6 := + pow_le_pow_left₀ (by positivity) hd 6 + have hdsucc : ((d + 1 : ℕ) : ℚ) ≤ (2 : ℚ) ^ (d + 1) := + natCast_le_two_pow_self (d + 1) + have hfac := factorialCast_le_two_pow_sq d + have htwoM : 2 * M ≤ (2 : ℚ) ^ (K + 1) := by + rw [pow_succ] + nlinarith + have htwoM0 : 0 ≤ 2 * M := mul_nonneg (by norm_num) hM0 + have hlast : (2 * M) ^ d ≤ ((2 : ℚ) ^ (K + 1)) ^ d := + pow_le_pow_left₀ htwoM0 htwoM d + norm_num only [Nat.cast_add, Nat.cast_one] at hdsucc + have hexponents : + 11 + d * 6 + (d + 1) + d ^ 2 + (K + 1) * d = + roundedEllipsoidDenominatorExponent d K := by + rw [roundedEllipsoidDenominatorExponent] + ring + rw [roundedEllipsoidCoarseDenominator] + calc + 2048 * (d : ℚ) ^ 6 * (d + 1) * d.factorial * (2 * M) ^ d ≤ + (2 : ℚ) ^ 11 * ((2 : ℚ) ^ d) ^ 6 * + (2 : ℚ) ^ (d + 1) * (2 : ℚ) ^ (d ^ 2) * + ((2 : ℚ) ^ (K + 1)) ^ d := by + norm_num only [show (2048 : ℚ) = 2 ^ 11 by norm_num] + gcongr + _ = (2 : ℚ) ^ roundedEllipsoidDenominatorExponent d K := by + rw [← pow_mul, ← pow_mul] + simp only [← pow_add] + rw [hexponents] + +/-- A dyadic lower bound on the determinant and an upper bound on the basis +magnitude give an explicit upper bound on the next rounding precision. -/ +theorem roundedEllipsoidPrecision_le_of_magnitude_bounds {d L K : ℕ} + (hd : 0 < d) (U : RationalEllipsoidState d) + (hdetLower : dyadicMesh L ≤ abs (Matrix.det U.basis)) + (hM : rationalMatrixAbsBound U.basis ≤ (2 : ℚ) ^ K) : + roundedEllipsoidPrecision U ≤ + L + roundedEllipsoidDenominatorExponent d K + 2 := by + let M := rationalMatrixAbsBound U.basis + let Δ := abs (Matrix.det U.basis) + let Q := roundedEllipsoidCoarseDenominator d M + let e := roundedEllipsoidDenominatorExponent d K + have hΔ0 : 0 < Δ := + (dyadicMesh_pos L).trans_le (by simpa only [Δ] using hdetLower) + have hdet : Matrix.det U.basis ≠ 0 := abs_pos.mp hΔ0 + have hM0 : 0 ≤ M := (rationalMatrixAbsBound_pos U.basis).le + have hQ0 : 0 < Q := roundedEllipsoidCoarseDenominator_pos hd + (rationalMatrixAbsBound_pos U.basis) + have hQ : Q ≤ (2 : ℚ) ^ e := by + simpa only [Q, M, e] using + roundedEllipsoidCoarseDenominator_le_two_pow hM0 hM + have hdyadic : dyadicMesh (L + e) ≤ Δ / Q := by + rw [dyadicMesh, pow_add] + rw [div_le_div_iff₀ + (by positivity : (0 : ℚ) < (2 : ℚ) ^ L * (2 : ℚ) ^ e) hQ0] + have hbase : (1 : ℚ) ≤ Δ * (2 : ℚ) ^ L := by + rw [← div_le_iff₀ (by positivity : (0 : ℚ) < (2 : ℚ) ^ L)] + simpa only [dyadicMesh, Δ] using hdetLower + calc + 1 * Q = Q := by ring + _ ≤ (2 : ℚ) ^ e := hQ + _ = 1 * (2 : ℚ) ^ e := by ring + _ ≤ (Δ * (2 : ℚ) ^ L) * (2 : ℚ) ^ e := + mul_le_mul_of_nonneg_right hbase (by positivity) + _ = Δ * ((2 : ℚ) ^ L * (2 : ℚ) ^ e) := by ring + have htarget : dyadicMesh (L + e) ≤ roundedEllipsoidMeshTarget U := + hdyadic.trans (abs_det_div_coarseDenominator_le_meshTarget hd U) + rw [roundedEllipsoidPrecision] + exact positiveDyadicPrecision_le_of_dyadicMesh_le + (roundedEllipsoidMeshTarget_pos hd U hdet) htarget + +theorem coordinate_sq_le_finiteNormSq_rat {d : ℕ} + (b : Fin d → ℚ) (i : Fin d) : + b i ^ 2 ≤ finiteNormSq b := by + rw [finiteNormSq, finiteDot, sq] + exact Finset.single_le_sum + (fun j _ ↦ mul_self_nonneg (b j)) (Finset.mem_univ i) + +theorem abs_mul_le_finiteNormSq_rat {d : ℕ} + (b : Fin d → ℚ) (i j : Fin d) : + abs (b i * b j) ≤ finiteNormSq b := by + let x := abs (b i) + let y := abs (b j) + let N := finiteNormSq b + have hxi : x ^ 2 ≤ N := by + dsimp only [x, N] + simpa only [sq_abs] using coordinate_sq_le_finiteNormSq_rat b i + have hyi : y ^ 2 ≤ N := by + dsimp only [y, N] + simpa only [sq_abs] using coordinate_sq_le_finiteNormSq_rat b j + have hxy : 2 * x * y ≤ x ^ 2 + y ^ 2 := by + nlinarith [sq_nonneg (x - y)] + have hnonneg : 0 ≤ x * y := mul_nonneg (abs_nonneg _) (abs_nonneg _) + rw [abs_mul] + dsimp only [x, y, N] at hxi hyi hxy hnonneg ⊢ + nlinarith + +theorem rationalEllipsoidPerpScale_le_two {d : ℕ} (hd : 0 < d) : + rationalEllipsoidPerpScale d ≤ 2 := by + have ha0 := rationalEllipsoidAlpha_pos hd + have ha := rationalEllipsoidAlpha_le_quarter hd + rw [rationalEllipsoidPerpScale] + nlinarith [sq_nonneg (rationalEllipsoidAlpha d - 1 / 4)] + +/-- Every entry of the square-root-free direction update has a universal +fixedValue bound, independent of the scale of the cut normal. -/ +theorem abs_directionUpdateMatrix_le_four {d : ℕ} (hd : 0 < d) + {b : Fin d → ℚ} (hb : b ≠ 0) (i j : Fin d) : + abs (directionUpdateMatrix + (rationalEllipsoidPerpScale d) + (rationalEllipsoidParallelScale d) b i j) ≤ 4 := by + let A := rationalEllipsoidPerpScale d + let P := rationalEllipsoidParallelScale d + let N := finiteNormSq b + have hN0 : 0 < N := by + dsimp only [N, finiteNormSq, finiteDot] + have hnonneg : 0 ≤ ∑ k, b k * b k := + Finset.sum_nonneg fun k _ ↦ mul_self_nonneg (b k) + have hne : (∑ k, b k * b k) ≠ 0 := by + intro hz + apply hb + ext k + have hk := (Finset.sum_eq_zero_iff_of_nonneg + (fun l (_hl : l ∈ Finset.univ) ↦ mul_self_nonneg (b l))).1 + hz k (Finset.mem_univ k) + exact (mul_self_eq_zero.mp hk) + exact lt_of_le_of_ne hnonneg (Ne.symm hne) + have hA0 : 0 ≤ A := by + dsimp only [A] + exact (rationalEllipsoidPerpScale_pos d).le + have hA2 : A ≤ 2 := by + dsimp only [A] + exact rationalEllipsoidPerpScale_le_two hd + have hP0 : 0 ≤ P := by + dsimp only [P] + exact (rationalEllipsoidParallelScale_pos hd).le + have hdiff0 : 0 ≤ A - P := by + dsimp only [A, P] + exact sub_nonneg.mpr (rationalEllipsoidParallel_lt_perp hd).le + have hdiff2 : A - P ≤ 2 := by linarith + have hratio : abs (b i * b j) / N ≤ 1 := by + rw [div_le_one hN0] + exact abs_mul_le_finiteNormSq_rat b i j + have hratio0 : 0 ≤ abs (b i * b j) / N := + div_nonneg (abs_nonneg _) hN0.le + have hterm : + abs (((A - P) / N) * b i * b j) ≤ 2 := by + rw [show ((A - P) / N) * b i * b j = + (A - P) * (b i * b j) / N by ring, + abs_div, abs_mul, abs_of_nonneg hdiff0, abs_of_pos hN0] + rw [div_eq_mul_inv, mul_assoc, ← div_eq_mul_inv] + calc + (A - P) * (abs (b i * b j) / N) ≤ 2 * 1 := + mul_le_mul hdiff2 hratio hratio0 (by norm_num) + _ = 2 := by norm_num + have hdiag : abs (A * (if i = j then 1 else 0)) ≤ 2 := by + by_cases hij : i = j + · simp [hij, abs_of_nonneg hA0, hA2] + · simp [hij] + rw [directionUpdateMatrix] + exact (abs_sub _ _).trans (by linarith) + +/-- One exact cut increases the total basis `ℓ₁` magnitude by at most a +factor `4d`. -/ +theorem rationalEllipsoidCentralUpdate_basis_abs_sum_le {d : ℕ} + (hd : 0 < d) (E : RationalEllipsoidState d) (a : Fin d → ℚ) + (hb : rationalPulledBackNormal E a ≠ 0) : + (∑ i, ∑ j, abs ((rationalEllipsoidCentralUpdate E a).basis i j)) ≤ + 4 * d * (∑ i, ∑ j, abs (E.basis i j)) := by + let b := rationalPulledBackNormal E a + let C := directionUpdateMatrix + (rationalEllipsoidPerpScale d) + (rationalEllipsoidParallelScale d) b + have hC : ∀ i j, abs (C i j) ≤ 4 := by + intro i j + exact abs_directionUpdateMatrix_le_four hd hb i j + have hentry : ∀ i j, + abs ((rationalEllipsoidCentralUpdate E a).basis i j) ≤ + ∑ k, 4 * abs (E.basis i k) := by + intro i j + change abs ((E.basis * C) i j) ≤ _ + rw [Matrix.mul_apply] + calc + abs (∑ k, E.basis i k * C k j) ≤ + ∑ k, abs (E.basis i k * C k j) := + Finset.abs_sum_le_sum_abs _ _ + _ ≤ ∑ k, 4 * abs (E.basis i k) := by + apply Finset.sum_le_sum + intro k _ + rw [abs_mul] + nlinarith [abs_nonneg (E.basis i k), hC k j] + calc + (∑ i, ∑ j, + abs ((rationalEllipsoidCentralUpdate E a).basis i j)) ≤ + ∑ i, ∑ _j : Fin d, ∑ k, 4 * abs (E.basis i k) := by + exact Finset.sum_le_sum fun i _ ↦ + Finset.sum_le_sum fun j _ ↦ hentry i j + _ = 4 * d * (∑ i, ∑ j, abs (E.basis i j)) := by + simp [Finset.mul_sum] + ring + +theorem rationalMatrixAbsBound_centralUpdate_le {d : ℕ} + (hd : 0 < d) (E : RationalEllipsoidState d) (a : Fin d → ℚ) + (hb : rationalPulledBackNormal E a ≠ 0) : + rationalMatrixAbsBound (rationalEllipsoidCentralUpdate E a).basis ≤ + 5 * d * rationalMatrixAbsBound E.basis := by + have hsum := rationalEllipsoidCentralUpdate_basis_abs_sum_le hd E a hb + have hdq : (1 : ℚ) ≤ d := by exact_mod_cast hd + have hT : 0 ≤ ∑ i, ∑ j, abs (E.basis i j) := + Finset.sum_nonneg fun i _ ↦ Finset.sum_nonneg fun j _ ↦ abs_nonneg _ + rw [rationalMatrixAbsBound, rationalMatrixAbsBound] + calc + 1 + ∑ i, ∑ j, + abs ((rationalEllipsoidCentralUpdate E a).basis i j) ≤ + 1 + 4 * d * (∑ i, ∑ j, abs (E.basis i j)) := + by simpa only [add_comm] using add_le_add_left hsum 1 + _ ≤ 5 * d * (1 + ∑ i, ∑ j, abs (E.basis i j)) := by + have hd0 : (0 : ℚ) ≤ d := by positivity + nlinarith [mul_nonneg hd0 hT] + +/-- Positive `ℓ₁` magnitude bounds for centers and complete states. -/ +def rationalCenterAbsBound {d : ℕ} (c : Fin d → ℚ) : ℚ := + 1 + ∑ i, abs (c i) + +def rationalStateAbsBound {d : ℕ} (E : RationalEllipsoidState d) : ℚ := + rationalCenterAbsBound E.center + rationalMatrixAbsBound E.basis + +theorem rationalCenterAbsBound_one_le {d : ℕ} (c : Fin d → ℚ) : + 1 ≤ rationalCenterAbsBound c := by + rw [rationalCenterAbsBound] + exact le_add_of_nonneg_right (Finset.sum_nonneg fun i _ ↦ abs_nonneg _) + +theorem rationalStateAbsBound_two_le {d : ℕ} + (E : RationalEllipsoidState d) : + 2 ≤ rationalStateAbsBound E := by + rw [rationalStateAbsBound] + linarith [rationalCenterAbsBound_one_le E.center, + rationalMatrixAbsBound_one_le E.basis] + +theorem rationalMatrixAbsBound_le_rationalStateAbsBound {d : ℕ} + (E : RationalEllipsoidState d) : + rationalMatrixAbsBound E.basis ≤ rationalStateAbsBound E := by + rw [rationalStateAbsBound] + linarith [rationalCenterAbsBound_one_le E.center] + +theorem abs_div_cutL1Scale_le_one {d : ℕ} {b : Fin d → ℚ} + (hb : b ≠ 0) (j : Fin d) : + abs (b j / cutL1Scale b) ≤ 1 := by + have hu := cutL1Scale_pos hb + rw [abs_div, abs_of_pos hu, div_le_one hu] + rw [cutL1Scale] + exact Finset.single_le_sum (fun k _ ↦ abs_nonneg (b k)) + (Finset.mem_univ j) + +theorem rationalCenterAbsBound_centralUpdate_le {d : ℕ} + (hd : 0 < d) (E : RationalEllipsoidState d) (a : Fin d → ℚ) + (hb : rationalPulledBackNormal E a ≠ 0) : + rationalCenterAbsBound (rationalEllipsoidCentralUpdate E a).center ≤ + rationalCenterAbsBound E.center + rationalMatrixAbsBound E.basis := by + let b := rationalPulledBackNormal E a + let u := cutL1Scale b + let α := rationalEllipsoidAlpha d + have hα0 : 0 ≤ α := by + dsimp only [α] + exact (rationalEllipsoidAlpha_pos hd).le + have hα1 : α ≤ 1 := by + dsimp only [α] + exact (rationalEllipsoidAlpha_le_quarter hd).trans (by norm_num) + have hratio : ∀ j, abs (b j / u) ≤ 1 := by + intro j + simpa only [b, u] using abs_div_cutL1Scale_le_one hb j + have hentry : ∀ i, + abs ((rationalEllipsoidCentralUpdate E a).center i) ≤ + abs (E.center i) + ∑ j, abs (E.basis i j) := by + intro i + change abs (E.center i - α * ∑ j, E.basis i j * (b j / u)) ≤ _ + calc + abs (E.center i - α * ∑ j, E.basis i j * (b j / u)) ≤ + abs (E.center i) + abs (α * ∑ j, + E.basis i j * (b j / u)) := abs_sub _ _ + _ ≤ abs (E.center i) + α * + ∑ j, abs (E.basis i j * (b j / u)) := by + rw [abs_mul, abs_of_nonneg hα0] + gcongr + exact Finset.abs_sum_le_sum_abs _ _ + _ ≤ abs (E.center i) + α * ∑ j, abs (E.basis i j) := by + have hs : (∑ j, abs (E.basis i j * (b j / u))) ≤ + ∑ j, abs (E.basis i j) := by + apply Finset.sum_le_sum + intro j _ + rw [abs_mul] + simpa only [mul_one] using mul_le_mul_of_nonneg_left + (hratio j) (abs_nonneg (E.basis i j)) + have hm := mul_le_mul_of_nonneg_left hs hα0 + simpa only [add_comm] using + add_le_add_left hm (abs (E.center i)) + _ ≤ abs (E.center i) + ∑ j, abs (E.basis i j) := by + have hrow : 0 ≤ ∑ j, abs (E.basis i j) := + Finset.sum_nonneg fun j _ ↦ abs_nonneg _ + nlinarith + rw [rationalCenterAbsBound, rationalCenterAbsBound, + rationalMatrixAbsBound] + calc + 1 + ∑ i, + abs ((rationalEllipsoidCentralUpdate E a).center i) ≤ + 1 + ∑ i, (abs (E.center i) + ∑ j, abs (E.basis i j)) := by + gcongr with i + exact hentry i + _ = (1 + ∑ i, abs (E.center i)) + + (1 + ∑ i, ∑ j, abs (E.basis i j)) - 1 := by + rw [Finset.sum_add_distrib] + ring + _ ≤ (1 + ∑ i, abs (E.center i)) + + (1 + ∑ i, ∑ j, abs (E.basis i j)) := by linarith + +theorem rationalStateAbsBound_centralUpdate_le {d : ℕ} + (hd : 0 < d) (E : RationalEllipsoidState d) (a : Fin d → ℚ) + (hb : rationalPulledBackNormal E a ≠ 0) : + rationalStateAbsBound (rationalEllipsoidCentralUpdate E a) ≤ + 6 * d * rationalStateAbsBound E := by + have hc := rationalCenterAbsBound_centralUpdate_le hd E a hb + have hB := rationalMatrixAbsBound_centralUpdate_le hd E a hb + have hdq : (1 : ℚ) ≤ d := by exact_mod_cast hd + have hc0 := rationalCenterAbsBound_one_le E.center + have hB0 := rationalMatrixAbsBound_one_le E.basis + rw [rationalStateAbsBound, rationalStateAbsBound] + calc + rationalCenterAbsBound (rationalEllipsoidCentralUpdate E a).center + + rationalMatrixAbsBound (rationalEllipsoidCentralUpdate E a).basis ≤ + (rationalCenterAbsBound E.center + rationalMatrixAbsBound E.basis) + + 5 * d * rationalMatrixAbsBound E.basis := add_le_add hc hB + _ ≤ 6 * d * + (rationalCenterAbsBound E.center + rationalMatrixAbsBound E.basis) := by + have hd0 : (0 : ℚ) ≤ d := by positivity + have hBnonneg : 0 ≤ rationalMatrixAbsBound E.basis := by linarith + nlinarith [mul_nonneg hd0 hBnonneg] + +theorem roundedEllipsoidInflation_le_one {d : ℕ} (hd : 0 < d) : + roundedEllipsoidInflation d ≤ 1 := by + rw [roundedEllipsoidInflation] + have hden : (1 : ℚ) ≤ 1024 * d ^ 4 := by + have hdq : (1 : ℚ) ≤ d := by exact_mod_cast hd + have hd4 : (1 : ℚ) ≤ (d : ℚ) ^ 4 := one_le_pow₀ hdq + norm_num only [Nat.cast_pow, Nat.cast_ofNat] + nlinarith + exact (div_le_one (by positivity : (0 : ℚ) < 1024 * d ^ 4)).2 hden + +/-- Rounding and inflation preserve a polynomial one-step magnitude bound. -/ +theorem rationalMatrixAbsBound_adaptiveRounded_le {d : ℕ} + (hd : 0 < d) (U : RationalEllipsoidState d) : + rationalMatrixAbsBound (adaptiveRoundedEllipsoid U).basis ≤ + 5 * d ^ 2 * rationalMatrixAbsBound U.basis := by + let M := rationalMatrixAbsBound U.basis + let p := roundedEllipsoidPrecision U + let η := roundedEllipsoidInflation d + have hM1 : (1 : ℚ) ≤ M := rationalMatrixAbsBound_one_le U.basis + have hη0 : 0 ≤ η := by + dsimp only [η] + exact roundedEllipsoidInflation_nonneg d + have hη1 : η ≤ 1 := by + dsimp only [η] + exact roundedEllipsoidInflation_le_one hd + have hentry : ∀ i j, + abs ((adaptiveRoundedEllipsoid U).basis i j) ≤ 4 * M := by + intro i j + have hround := abs_dyadicFloor_le p (U.basis i j) + have hmesh := dyadicMesh_le_one p + have hU := (abs_entry_lt_rationalMatrixAbsBound U.basis i j).le + have hfloor : abs (dyadicFloor p (U.basis i j)) ≤ 2 * M := by + linarith + rw [adaptiveRoundedEllipsoid, inflatedDyadicRound_basis_apply, abs_mul, + abs_of_nonneg (by linarith : 0 ≤ 1 + η)] + calc + (1 + η) * abs (dyadicFloor p (U.basis i j)) ≤ 2 * (2 * M) := + mul_le_mul (by linarith) hfloor (abs_nonneg _) (by linarith) + _ = 4 * M := by ring + rw [rationalMatrixAbsBound] + calc + 1 + ∑ i, ∑ j, abs ((adaptiveRoundedEllipsoid U).basis i j) ≤ + 1 + ∑ _i : Fin d, ∑ _j : Fin d, 4 * M := by + have hs0 : (∑ i : Fin d, ∑ j : Fin d, + abs ((adaptiveRoundedEllipsoid U).basis i j)) ≤ + ∑ _i : Fin d, ∑ _j : Fin d, 4 * M := by + apply Finset.sum_le_sum + intro i _ + apply Finset.sum_le_sum + intro j _ + exact hentry i j + have hs := add_le_add_left hs0 1 + simpa only [add_comm] using hs + _ = 1 + d ^ 2 * (4 * M) := by simp; ring + _ ≤ 5 * d ^ 2 * M := by + have hdq : (1 : ℚ) ≤ d := by exact_mod_cast hd + nlinarith [sq_nonneg ((d : ℚ) - 1)] + +theorem rationalCenterAbsBound_adaptiveRounded_le {d : ℕ} + (hd : 0 < d) (U : RationalEllipsoidState d) : + rationalCenterAbsBound (adaptiveRoundedEllipsoid U).center ≤ + rationalCenterAbsBound U.center + d := by + let p := roundedEllipsoidPrecision U + have hentry : ∀ i, + abs ((adaptiveRoundedEllipsoid U).center i) ≤ abs (U.center i) + 1 := by + intro i + have h := abs_dyadicFloor_le p (U.center i) + have hm := dyadicMesh_le_one p + have hadd : abs (U.center i) + dyadicMesh p ≤ + abs (U.center i) + 1 := by linarith + change abs (dyadicFloor p (U.center i)) ≤ abs (U.center i) + 1 + exact h.le.trans hadd + rw [rationalCenterAbsBound, rationalCenterAbsBound] + calc + 1 + ∑ i, abs ((adaptiveRoundedEllipsoid U).center i) ≤ + 1 + ∑ i, (abs (U.center i) + 1) := by + gcongr with i + exact hentry i + _ = (1 + ∑ i, abs (U.center i)) + d := by + rw [Finset.sum_add_distrib] + simp + ring + +theorem rationalStateAbsBound_adaptiveRounded_le {d : ℕ} + (hd : 0 < d) (U : RationalEllipsoidState d) : + rationalStateAbsBound (adaptiveRoundedEllipsoid U) ≤ + 7 * d ^ 2 * rationalStateAbsBound U := by + have hc := rationalCenterAbsBound_adaptiveRounded_le hd U + have hB := rationalMatrixAbsBound_adaptiveRounded_le hd U + have hdq : (1 : ℚ) ≤ d := by exact_mod_cast hd + have hT := rationalStateAbsBound_two_le U + have hc0 := rationalCenterAbsBound_one_le U.center + have hB0 := rationalMatrixAbsBound_one_le U.basis + rw [rationalStateAbsBound, rationalStateAbsBound] + calc + rationalCenterAbsBound (adaptiveRoundedEllipsoid U).center + + rationalMatrixAbsBound (adaptiveRoundedEllipsoid U).basis ≤ + (rationalCenterAbsBound U.center + d) + + 5 * d ^ 2 * rationalMatrixAbsBound U.basis := add_le_add hc hB + _ ≤ 7 * d ^ 2 * + (rationalCenterAbsBound U.center + rationalMatrixAbsBound U.basis) := by + have hBnonneg : 0 ≤ rationalMatrixAbsBound U.basis := by linarith + nlinarith [sq_nonneg ((d : ℚ) - 1), + mul_nonneg (sq_nonneg (d : ℚ)) hBnonneg] + +/-- A complete rounded cut grows the total basis magnitude by at most +`25 d³`. -/ +theorem rationalMatrixAbsBound_adaptiveCentralUpdate_le {d : ℕ} + (hd : 0 < d) (E : RationalEllipsoidState d) (a : Fin d → ℚ) + (hb : rationalPulledBackNormal E a ≠ 0) : + rationalMatrixAbsBound + (adaptiveRoundedEllipsoidCentralUpdate E a).basis ≤ + 25 * d ^ 3 * rationalMatrixAbsBound E.basis := by + let U := rationalEllipsoidCentralUpdate E a + have hround := rationalMatrixAbsBound_adaptiveRounded_le hd U + have hexact := rationalMatrixAbsBound_centralUpdate_le hd E a hb + calc + rationalMatrixAbsBound + (adaptiveRoundedEllipsoidCentralUpdate E a).basis = + rationalMatrixAbsBound (adaptiveRoundedEllipsoid U).basis := by rfl + _ ≤ 5 * d ^ 2 * rationalMatrixAbsBound U.basis := hround + _ ≤ 5 * d ^ 2 * (5 * d * rationalMatrixAbsBound E.basis) := + mul_le_mul_of_nonneg_left hexact (by positivity) + _ = 25 * d ^ 3 * rationalMatrixAbsBound E.basis := by ring + +theorem rationalStateAbsBound_adaptiveCentralUpdate_le {d : ℕ} + (hd : 0 < d) (E : RationalEllipsoidState d) (a : Fin d → ℚ) + (hb : rationalPulledBackNormal E a ≠ 0) : + rationalStateAbsBound (adaptiveRoundedEllipsoidCentralUpdate E a) ≤ + 42 * d ^ 3 * rationalStateAbsBound E := by + let U := rationalEllipsoidCentralUpdate E a + have hround := rationalStateAbsBound_adaptiveRounded_le hd U + have hexact := rationalStateAbsBound_centralUpdate_le hd E a hb + calc + rationalStateAbsBound (adaptiveRoundedEllipsoidCentralUpdate E a) = + rationalStateAbsBound (adaptiveRoundedEllipsoid U) := by rfl + _ ≤ 7 * d ^ 2 * rationalStateAbsBound U := hround + _ ≤ 7 * d ^ 2 * (6 * d * rationalStateAbsBound E) := + mul_le_mul_of_nonneg_left hexact (by positivity) + _ = 42 * d ^ 3 * rationalStateAbsBound E := by ring + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/RoundedEllipsoidIterationBounds.lean b/LeanPool/BeyondBethe/BeyondBethe/RoundedEllipsoidIterationBounds.lean new file mode 100644 index 0000000000..7cf82e19dd --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/RoundedEllipsoidIterationBounds.lean @@ -0,0 +1,435 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.RoundedEllipsoidBitBounds +import Mathlib.Tactic + +/-! # Rounded Ellipsoid Iteration Bounds -/ + +namespace BeyondBethe + +/-! +# Iterated size bounds + +This file turns the one-step determinant and magnitude estimates into a +uniform precision bound for every state in a regular rounded-cut sequence. +The bound is independent of feasibility: it uses only nonsingularity and +nonzero cuts. +-/ + +def adaptiveRoundedEllipsoidIterate {d : ℕ} : + RationalEllipsoidState d → List (Fin d → ℚ) → RationalEllipsoidState d + | E, [] => E + | E, a :: cuts => adaptiveRoundedEllipsoidIterate + (adaptiveRoundedEllipsoidCentralUpdate E a) cuts + +def AdaptiveCutSequenceRegular {d : ℕ} : + RationalEllipsoidState d → List (Fin d → ℚ) → Prop + | _, [] => True + | E, a :: cuts => + rationalPulledBackNormal E a ≠ 0 ∧ + AdaptiveCutSequenceRegular + (adaptiveRoundedEllipsoidCentralUpdate E a) cuts + +theorem adaptiveRoundedEllipsoidIterate_append {d : ℕ} + (E : RationalEllipsoidState d) + (xs ys : List (Fin d → ℚ)) : + adaptiveRoundedEllipsoidIterate E (xs ++ ys) = + adaptiveRoundedEllipsoidIterate + (adaptiveRoundedEllipsoidIterate E xs) ys := by + induction xs generalizing E with + | nil => simp [adaptiveRoundedEllipsoidIterate] + | cons a xs ih => + simp only [List.cons_append, adaptiveRoundedEllipsoidIterate] + exact ih _ + +theorem AdaptiveCutSequenceRegular.append_singleton {d : ℕ} + (E : RationalEllipsoidState d) (xs : List (Fin d → ℚ)) + (a : Fin d → ℚ) + (hregular : AdaptiveCutSequenceRegular E xs) + (ha : rationalPulledBackNormal + (adaptiveRoundedEllipsoidIterate E xs) a ≠ 0) : + AdaptiveCutSequenceRegular E (xs ++ [a]) := by + induction xs generalizing E with + | nil => exact ⟨ha, by simp [AdaptiveCutSequenceRegular]⟩ + | cons b xs ih => + exact ⟨hregular.1, ih _ hregular.2 ha⟩ + +theorem AdaptiveCutSequenceRegular.prefix_and_next {d : ℕ} + (E : RationalEllipsoidState d) (pre suffix : List (Fin d → ℚ)) + (a : Fin d → ℚ) + (hregular : AdaptiveCutSequenceRegular E (pre ++ a :: suffix)) : + AdaptiveCutSequenceRegular E pre ∧ + rationalPulledBackNormal + (adaptiveRoundedEllipsoidIterate E pre) a ≠ 0 := by + induction pre generalizing E with + | nil => + exact ⟨by simp [AdaptiveCutSequenceRegular], hregular.1⟩ + | cons b pre ih => + have htail := ih + (adaptiveRoundedEllipsoidCentralUpdate E b) hregular.2 + exact ⟨⟨hregular.1, htail.1⟩, htail.2⟩ + +theorem quarter_abs_det_le_adaptiveRoundedCentralUpdate_rat {d : ℕ} + (hd : 0 < d) (E : RationalEllipsoidState d) (a : Fin d → ℚ) + (hdet : Matrix.det E.basis ≠ 0) + (hb : rationalPulledBackNormal E a ≠ 0) : + (1 / 4 : ℚ) * abs (Matrix.det E.basis) ≤ + abs (Matrix.det + (adaptiveRoundedEllipsoidCentralUpdate E a).basis) := by + have hreal := quarter_abs_det_le_adaptiveRoundedCentralUpdate + hd E a hdet hb + have hcast : + ((((1 / 4 : ℚ) * abs (Matrix.det E.basis) : ℚ) : ℚ) : ℝ) ≤ + ((abs (Matrix.det + (adaptiveRoundedEllipsoidCentralUpdate E a).basis) : ℚ) : ℝ) := by + norm_num only [Rat.cast_mul, Rat.cast_div, Rat.cast_one, + Rat.cast_ofNat] + exact_mod_cast hreal + exact Rat.cast_le.mp hcast + +theorem half_abs_det_le_rationalEllipsoidCentralUpdate {d : ℕ} + (hd : 0 < d) (E : RationalEllipsoidState d) (a : Fin d → ℚ) + (hb : rationalPulledBackNormal E a ≠ 0) : + (1 / 2 : ℚ) * abs (Matrix.det E.basis) ≤ + abs (Matrix.det (rationalEllipsoidCentralUpdate E a).basis) := by + let q : ℚ := rationalEllipsoidPerpScale d ^ (d - 1) * + rationalEllipsoidParallelScale d + have hq : (1 / 2 : ℚ) ≤ q := by + have hperp : (1 : ℚ) ≤ rationalEllipsoidPerpScale d := by + rw [rationalEllipsoidPerpScale] + norm_num + positivity + have hpow : (1 : ℚ) ≤ + rationalEllipsoidPerpScale d ^ (d - 1) := one_le_pow₀ hperp + have hparallel : (3 / 4 : ℚ) ≤ + rationalEllipsoidParallelScale d := + rationalEllipsoidParallelScale_ge_three_quarters hd + dsimp only [q] + calc + (1 / 2 : ℚ) ≤ 1 * (3 / 4 : ℚ) := by norm_num + _ ≤ rationalEllipsoidPerpScale d ^ (d - 1) * + rationalEllipsoidParallelScale d := + mul_le_mul hpow hparallel (by norm_num) (by positivity) + have hq0 : 0 ≤ q := hq.trans' (by norm_num) + rw [det_rationalEllipsoidCentralUpdate hd E a hb, abs_mul, + abs_of_nonneg hq0] + simpa only [mul_comm] using + (mul_le_mul_of_nonneg_left hq (abs_nonneg (Matrix.det E.basis))) + +theorem dyadicMesh_succ_eq_half_mul (L : ℕ) : + dyadicMesh (L + 1) = (1 / 2 : ℚ) * dyadicMesh L := by + unfold dyadicMesh + rw [pow_add] + norm_num + +theorem rationalEllipsoidCentralUpdate_dyadic_det_lower {d L : ℕ} + (hd : 0 < d) (E : RationalEllipsoidState d) (a : Fin d → ℚ) + (hb : rationalPulledBackNormal E a ≠ 0) + (hdetLower : dyadicMesh L ≤ abs (Matrix.det E.basis)) : + dyadicMesh (L + 1) ≤ + abs (Matrix.det (rationalEllipsoidCentralUpdate E a).basis) := by + rw [dyadicMesh_succ_eq_half_mul] + exact (mul_le_mul_of_nonneg_left hdetLower (by norm_num)).trans + (half_abs_det_le_rationalEllipsoidCentralUpdate hd E a hb) + +theorem rationalEllipsoidExactGrowthFactor_le_two_pow (d : ℕ) : + (6 * d : ℚ) ≤ (2 : ℚ) ^ (3 + d) := by + have hd := natCast_le_two_pow_self d + calc + (6 * d : ℚ) ≤ 8 * (2 : ℚ) ^ d := by nlinarith + _ = (2 : ℚ) ^ (3 + d) := by + rw [show (8 : ℚ) = 2 ^ 3 by norm_num, ← pow_add] + +theorem rationalEllipsoidCentralUpdate_two_pow_state_magnitude_upper + {d K : ℕ} (hd : 0 < d) (E : RationalEllipsoidState d) + (a : Fin d → ℚ) (hb : rationalPulledBackNormal E a ≠ 0) + (hM : rationalStateAbsBound E ≤ (2 : ℚ) ^ K) : + rationalStateAbsBound (rationalEllipsoidCentralUpdate E a) ≤ + (2 : ℚ) ^ (K + 3 + d) := by + have hstep := rationalStateAbsBound_centralUpdate_le hd E a hb + have hfactor := rationalEllipsoidExactGrowthFactor_le_two_pow d + have hstate0 : 0 ≤ rationalStateAbsBound E := by + linarith [rationalStateAbsBound_two_le E] + calc + rationalStateAbsBound (rationalEllipsoidCentralUpdate E a) ≤ + 6 * d * rationalStateAbsBound E := hstep + _ ≤ (2 : ℚ) ^ (3 + d) * (2 : ℚ) ^ K := + mul_le_mul hfactor hM hstate0 (by positivity) + _ = (2 : ℚ) ^ (K + 3 + d) := by + rw [← pow_add] + congr 1 + omega + +/-- Precision used inside the next rounded update. This is the missing +intermediate-state estimate: precision is computed after the exact central +cut and before the state is rounded. -/ +theorem rationalEllipsoidCentralUpdate_precision_upper + {d L K : ℕ} (hd : 0 < d) (E : RationalEllipsoidState d) + (a : Fin d → ℚ) (hb : rationalPulledBackNormal E a ≠ 0) + (hdetLower : dyadicMesh L ≤ abs (Matrix.det E.basis)) + (hM : rationalStateAbsBound E ≤ (2 : ℚ) ^ K) : + roundedEllipsoidPrecision (rationalEllipsoidCentralUpdate E a) ≤ + (L + 1) + roundedEllipsoidDenominatorExponent d (K + 3 + d) + 2 := by + apply roundedEllipsoidPrecision_le_of_magnitude_bounds hd + · exact rationalEllipsoidCentralUpdate_dyadic_det_lower + hd E a hb hdetLower + · exact (rationalMatrixAbsBound_le_rationalStateAbsBound + (rationalEllipsoidCentralUpdate E a)).trans + (rationalEllipsoidCentralUpdate_two_pow_state_magnitude_upper + hd E a hb hM) + +def roundedEllipsoidNextPrecisionBound (d L K t : ℕ) : ℕ := + (L + 2 * t + 1) + + roundedEllipsoidDenominatorExponent d + (K + t * (6 + 3 * d) + 3 + d) + 2 + +theorem adaptiveRoundedEllipsoidIterate_det_lower {d : ℕ} + (hd : 0 < d) (E : RationalEllipsoidState d) + (hdet : Matrix.det E.basis ≠ 0) (cuts : List (Fin d → ℚ)) + (hregular : AdaptiveCutSequenceRegular E cuts) : + (1 / 4 : ℚ) ^ cuts.length * abs (Matrix.det E.basis) ≤ + abs (Matrix.det (adaptiveRoundedEllipsoidIterate E cuts).basis) := by + induction cuts generalizing E with + | nil => simp [adaptiveRoundedEllipsoidIterate] + | cons a cuts ih => + have hb := hregular.1 + let E' := adaptiveRoundedEllipsoidCentralUpdate E a + have hdet' : Matrix.det E'.basis ≠ 0 := + det_adaptiveRoundedEllipsoidCentralUpdate_ne_zero hd E a hdet hb + have hstep := quarter_abs_det_le_adaptiveRoundedCentralUpdate_rat + hd E a hdet hb + have htail := ih E' hdet' hregular.2 + rw [adaptiveRoundedEllipsoidIterate, List.length_cons, pow_succ] + calc + (1 / 4 : ℚ) ^ cuts.length * (1 / 4) * + abs (Matrix.det E.basis) = + (1 / 4 : ℚ) ^ cuts.length * + ((1 / 4) * abs (Matrix.det E.basis)) := by ring + _ ≤ (1 / 4 : ℚ) ^ cuts.length * abs (Matrix.det E'.basis) := + mul_le_mul_of_nonneg_left hstep (by positivity) + _ ≤ abs (Matrix.det + (adaptiveRoundedEllipsoidIterate E' cuts).basis) := htail + +theorem adaptiveRoundedEllipsoidIterate_magnitude_upper {d : ℕ} + (hd : 0 < d) (E : RationalEllipsoidState d) + (cuts : List (Fin d → ℚ)) + (hregular : AdaptiveCutSequenceRegular E cuts) : + rationalMatrixAbsBound + (adaptiveRoundedEllipsoidIterate E cuts).basis ≤ + (25 * d ^ 3 : ℚ) ^ cuts.length * + rationalMatrixAbsBound E.basis := by + induction cuts generalizing E with + | nil => simp [adaptiveRoundedEllipsoidIterate] + | cons a cuts ih => + have hb := hregular.1 + let E' := adaptiveRoundedEllipsoidCentralUpdate E a + have hstep := rationalMatrixAbsBound_adaptiveCentralUpdate_le + hd E a hb + have htail := ih E' hregular.2 + rw [adaptiveRoundedEllipsoidIterate, List.length_cons, pow_succ] + calc + rationalMatrixAbsBound + (adaptiveRoundedEllipsoidIterate E' cuts).basis ≤ + (25 * d ^ 3 : ℚ) ^ cuts.length * + rationalMatrixAbsBound E'.basis := htail + _ ≤ (25 * d ^ 3 : ℚ) ^ cuts.length * + (25 * d ^ 3 * rationalMatrixAbsBound E.basis) := + mul_le_mul_of_nonneg_left hstep (by positivity) + _ = (25 * d ^ 3 : ℚ) ^ cuts.length * + (25 * d ^ 3) * rationalMatrixAbsBound E.basis := by ring + +/-- The same iteration estimate for the center and basis together. This is +the quantity needed to bound the encoding of every stored ellipsoid state. -/ +theorem adaptiveRoundedEllipsoidIterate_state_magnitude_upper {d : ℕ} + (hd : 0 < d) (E : RationalEllipsoidState d) + (cuts : List (Fin d → ℚ)) + (hregular : AdaptiveCutSequenceRegular E cuts) : + rationalStateAbsBound (adaptiveRoundedEllipsoidIterate E cuts) ≤ + (42 * d ^ 3 : ℚ) ^ cuts.length * rationalStateAbsBound E := by + induction cuts generalizing E with + | nil => simp [adaptiveRoundedEllipsoidIterate] + | cons a cuts ih => + have hb := hregular.1 + let E' := adaptiveRoundedEllipsoidCentralUpdate E a + have hstep := rationalStateAbsBound_adaptiveCentralUpdate_le + hd E a hb + have htail := ih E' hregular.2 + rw [adaptiveRoundedEllipsoidIterate, List.length_cons, pow_succ] + calc + rationalStateAbsBound (adaptiveRoundedEllipsoidIterate E' cuts) ≤ + (42 * d ^ 3 : ℚ) ^ cuts.length * + rationalStateAbsBound E' := htail + _ ≤ (42 * d ^ 3 : ℚ) ^ cuts.length * + (42 * d ^ 3 * rationalStateAbsBound E) := + mul_le_mul_of_nonneg_left hstep (by positivity) + _ = (42 * d ^ 3 : ℚ) ^ cuts.length * + (42 * d ^ 3) * rationalStateAbsBound E := by ring + +theorem dyadicMesh_add_two_mul (L t : ℕ) : + dyadicMesh (L + 2 * t) = + (1 / 4 : ℚ) ^ t * dyadicMesh L := by + unfold dyadicMesh + rw [pow_add, pow_mul] + norm_num only [pow_two] + rw [show (1 / 4 : ℚ) ^ t = 1 / (4 : ℚ) ^ t by + simp only [one_div, inv_pow]] + ring + +theorem adaptiveRoundedEllipsoidIterate_dyadic_det_lower {d L : ℕ} + (hd : 0 < d) (E : RationalEllipsoidState d) + (hdet : Matrix.det E.basis ≠ 0) + (hdetLower : dyadicMesh L ≤ abs (Matrix.det E.basis)) + (cuts : List (Fin d → ℚ)) + (hregular : AdaptiveCutSequenceRegular E cuts) : + dyadicMesh (L + 2 * cuts.length) ≤ + abs (Matrix.det (adaptiveRoundedEllipsoidIterate E cuts).basis) := by + rw [dyadicMesh_add_two_mul] + calc + (1 / 4 : ℚ) ^ cuts.length * dyadicMesh L ≤ + (1 / 4 : ℚ) ^ cuts.length * abs (Matrix.det E.basis) := + mul_le_mul_of_nonneg_left hdetLower (by positivity) + _ ≤ abs (Matrix.det + (adaptiveRoundedEllipsoidIterate E cuts).basis) := + adaptiveRoundedEllipsoidIterate_det_lower hd E hdet cuts hregular + +theorem roundedEllipsoidGrowthFactor_le_two_pow (d : ℕ) : + (25 * d ^ 3 : ℚ) ≤ (2 : ℚ) ^ (5 + 3 * d) := by + have hd := natCast_le_two_pow_self d + have hd3 : (d : ℚ) ^ 3 ≤ ((2 : ℚ) ^ d) ^ 3 := + pow_le_pow_left₀ (by positivity) hd 3 + calc + (25 * d ^ 3 : ℚ) ≤ 32 * ((2 : ℚ) ^ d) ^ 3 := by + nlinarith [show (0 : ℚ) ≤ (d : ℚ) ^ 3 by positivity] + _ = (2 : ℚ) ^ (5 + 3 * d) := by + rw [show (32 : ℚ) = 2 ^ 5 by norm_num, ← pow_mul, ← pow_add] + congr 1 + omega + +theorem roundedEllipsoidStateGrowthFactor_le_two_pow (d : ℕ) : + (42 * d ^ 3 : ℚ) ≤ (2 : ℚ) ^ (6 + 3 * d) := by + have hd := natCast_le_two_pow_self d + have hd3 : (d : ℚ) ^ 3 ≤ ((2 : ℚ) ^ d) ^ 3 := + pow_le_pow_left₀ (by positivity) hd 3 + calc + (42 * d ^ 3 : ℚ) ≤ 64 * ((2 : ℚ) ^ d) ^ 3 := by + nlinarith [show (0 : ℚ) ≤ (d : ℚ) ^ 3 by positivity] + _ = (2 : ℚ) ^ (6 + 3 * d) := by + rw [show (64 : ℚ) = 2 ^ 6 by norm_num, ← pow_mul, ← pow_add] + congr 1 + omega + +def roundedEllipsoidMagnitudeExponent (d K t : ℕ) : ℕ := + K + t * (5 + 3 * d) + +def roundedEllipsoidStateMagnitudeExponent (d K t : ℕ) : ℕ := + K + t * (6 + 3 * d) + +theorem adaptiveRoundedEllipsoidIterate_two_pow_magnitude_upper + {d K : ℕ} (hd : 0 < d) (E : RationalEllipsoidState d) + (hM : rationalMatrixAbsBound E.basis ≤ (2 : ℚ) ^ K) + (cuts : List (Fin d → ℚ)) + (hregular : AdaptiveCutSequenceRegular E cuts) : + rationalMatrixAbsBound + (adaptiveRoundedEllipsoidIterate E cuts).basis ≤ + (2 : ℚ) ^ roundedEllipsoidMagnitudeExponent d K cuts.length := by + have hiter := adaptiveRoundedEllipsoidIterate_magnitude_upper + hd E cuts hregular + have hfactor := roundedEllipsoidGrowthFactor_le_two_pow d + have hpow : (25 * d ^ 3 : ℚ) ^ cuts.length ≤ + ((2 : ℚ) ^ (5 + 3 * d)) ^ cuts.length := + pow_le_pow_left₀ (by positivity) hfactor cuts.length + calc + rationalMatrixAbsBound + (adaptiveRoundedEllipsoidIterate E cuts).basis ≤ + (25 * d ^ 3 : ℚ) ^ cuts.length * + rationalMatrixAbsBound E.basis := hiter + _ ≤ ((2 : ℚ) ^ (5 + 3 * d)) ^ cuts.length * + (2 : ℚ) ^ K := + mul_le_mul hpow hM (rationalMatrixAbsBound_pos E.basis).le + (by positivity) + _ = (2 : ℚ) ^ + roundedEllipsoidMagnitudeExponent d K cuts.length := by + rw [← pow_mul, ← pow_add] + rw [roundedEllipsoidMagnitudeExponent] + congr 1 + ring + +theorem adaptiveRoundedEllipsoidIterate_two_pow_state_magnitude_upper + {d K : ℕ} (hd : 0 < d) (E : RationalEllipsoidState d) + (hM : rationalStateAbsBound E ≤ (2 : ℚ) ^ K) + (cuts : List (Fin d → ℚ)) + (hregular : AdaptiveCutSequenceRegular E cuts) : + rationalStateAbsBound (adaptiveRoundedEllipsoidIterate E cuts) ≤ + (2 : ℚ) ^ + roundedEllipsoidStateMagnitudeExponent d K cuts.length := by + have hiter := adaptiveRoundedEllipsoidIterate_state_magnitude_upper + hd E cuts hregular + have hfactor := roundedEllipsoidStateGrowthFactor_le_two_pow d + have hpow : (42 * d ^ 3 : ℚ) ^ cuts.length ≤ + ((2 : ℚ) ^ (6 + 3 * d)) ^ cuts.length := + pow_le_pow_left₀ (by positivity) hfactor cuts.length + have hstate0 : 0 ≤ rationalStateAbsBound E := by + linarith [rationalStateAbsBound_two_le E] + calc + rationalStateAbsBound (adaptiveRoundedEllipsoidIterate E cuts) ≤ + (42 * d ^ 3 : ℚ) ^ cuts.length * + rationalStateAbsBound E := hiter + _ ≤ ((2 : ℚ) ^ (6 + 3 * d)) ^ cuts.length * (2 : ℚ) ^ K := + mul_le_mul hpow hM hstate0 (by positivity) + _ = (2 : ℚ) ^ + roundedEllipsoidStateMagnitudeExponent d K cuts.length := by + rw [← pow_mul, ← pow_add] + rw [roundedEllipsoidStateMagnitudeExponent] + congr 1 + ring + +/-- Uniform bound for the proof-specification precision of the next exact +central cut after any regular prefix. A machine implementation may pass any +a-priori scheduled precision at least this large. -/ +theorem adaptiveRoundedEllipsoidIterate_next_precision_upper + {d L K : ℕ} (hd : 0 < d) (E : RationalEllipsoidState d) + (hdet : Matrix.det E.basis ≠ 0) + (hdetLower : dyadicMesh L ≤ abs (Matrix.det E.basis)) + (hM : rationalStateAbsBound E ≤ (2 : ℚ) ^ K) + (pre : List (Fin d → ℚ)) + (hregular : AdaptiveCutSequenceRegular E pre) + (a : Fin d → ℚ) + (ha : rationalPulledBackNormal + (adaptiveRoundedEllipsoidIterate E pre) a ≠ 0) : + roundedEllipsoidPrecision + (rationalEllipsoidCentralUpdate + (adaptiveRoundedEllipsoidIterate E pre) a) ≤ + roundedEllipsoidNextPrecisionBound d L K pre.length := by + have hdetPrefix := adaptiveRoundedEllipsoidIterate_dyadic_det_lower + hd E hdet hdetLower pre hregular + have hMPrefix := + adaptiveRoundedEllipsoidIterate_two_pow_state_magnitude_upper + hd E hM pre hregular + have h := rationalEllipsoidCentralUpdate_precision_upper hd + (adaptiveRoundedEllipsoidIterate E pre) a ha hdetPrefix hMPrefix + simpa only [roundedEllipsoidNextPrecisionBound, + roundedEllipsoidStateMagnitudeExponent] using h + +/-- Explicit polynomial precision bound at every reachable state. -/ +theorem adaptiveRoundedEllipsoidIterate_precision_upper + {d L K : ℕ} (hd : 0 < d) (E : RationalEllipsoidState d) + (hdet : Matrix.det E.basis ≠ 0) + (hdetLower : dyadicMesh L ≤ abs (Matrix.det E.basis)) + (hM : rationalMatrixAbsBound E.basis ≤ (2 : ℚ) ^ K) + (cuts : List (Fin d → ℚ)) + (hregular : AdaptiveCutSequenceRegular E cuts) : + roundedEllipsoidPrecision (adaptiveRoundedEllipsoidIterate E cuts) ≤ + (L + 2 * cuts.length) + + roundedEllipsoidDenominatorExponent d + (roundedEllipsoidMagnitudeExponent d K cuts.length) + 2 := by + exact roundedEllipsoidPrecision_le_of_magnitude_bounds hd _ + (adaptiveRoundedEllipsoidIterate_dyadic_det_lower + hd E hdet hdetLower cuts hregular) + (adaptiveRoundedEllipsoidIterate_two_pow_magnitude_upper + hd E hM cuts hregular) + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/RoundedEllipsoidScales.lean b/LeanPool/BeyondBethe/BeyondBethe/RoundedEllipsoidScales.lean new file mode 100644 index 0000000000..9f1e4ecd52 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/RoundedEllipsoidScales.lean @@ -0,0 +1,323 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.RoundedEllipsoid +import LeanPool.BeyondBethe.BeyondBethe.DyadicMagnitudePrecision +import Mathlib.LinearAlgebra.Matrix.Integer +import Mathlib.Tactic + +/-! # Rounded Ellipsoid Scales -/ + +open scoped BigOperators + +namespace BeyondBethe + +/-! +# Quantitative bounded-bit ellipsoid scales + +The exact determinant defines the least precision needed in the semantic +rounding proof. We also prove a determinant-free lower bound by clearing +entry denominators. The final bit-model implementation must use an a-priori +schedule dominating the semantic precision: Mathlib's specification of +`Matrix.det` is not the algorithm used by the optimizer. +-/ + +/-- A positive rational bound for every absolute matrix entry. -/ +def rationalMatrixAbsBound {d : ℕ} + (A : Matrix (Fin d) (Fin d) ℚ) : ℚ := + 1 + ∑ i, ∑ j, abs (A i j) + +theorem rationalMatrixAbsBound_pos {d : ℕ} + (A : Matrix (Fin d) (Fin d) ℚ) : 0 < rationalMatrixAbsBound A := by + rw [rationalMatrixAbsBound] + have hsum : 0 ≤ ∑ i, ∑ j, abs (A i j) := + Finset.sum_nonneg fun i _ ↦ Finset.sum_nonneg fun j _ ↦ abs_nonneg _ + linarith + +theorem abs_entry_lt_rationalMatrixAbsBound {d : ℕ} + (A : Matrix (Fin d) (Fin d) ℚ) (i j : Fin d) : + abs (A i j) < rationalMatrixAbsBound A := by + rw [rationalMatrixAbsBound] + have hrow : abs (A i j) ≤ ∑ k, abs (A i k) := + Finset.single_le_sum (fun k _ ↦ abs_nonneg (A i k)) (Finset.mem_univ j) + have hall : (∑ k, abs (A i k)) ≤ ∑ l, ∑ k, abs (A l k) := + Finset.single_le_sum + (fun l _ ↦ Finset.sum_nonneg fun k _ ↦ abs_nonneg (A l k)) + (Finset.mem_univ i) + linarith + +/-- Inflation per rounded update. Its logarithmic size is polynomial in the +dimension, while its determinant cost is much smaller than the exact +central-cut contraction. -/ +def roundedEllipsoidInflation (d : ℕ) : ℚ := + 1 / (1024 * d ^ 4) + +theorem roundedEllipsoidInflation_pos {d : ℕ} (hd : 0 < d) : + 0 < roundedEllipsoidInflation d := by + rw [roundedEllipsoidInflation] + positivity + +theorem roundedEllipsoidInflation_nonneg (d : ℕ) : + 0 ≤ roundedEllipsoidInflation d := by + by_cases hd : d = 0 + · simp [roundedEllipsoidInflation, hd] + · exact (roundedEllipsoidInflation_pos (Nat.pos_of_ne_zero hd)).le + +/-- Coefficient multiplying the mesh in the determinant perturbation bound. -/ +def roundedDeterminantCoefficient (d : ℕ) (M : ℚ) : ℚ := + d.factorial * d * (2 * M) ^ d + +/-- Coefficient multiplying the mesh in the adjugate correction bound. -/ +def roundedInverseCoefficient (d : ℕ) (M : ℚ) : ℚ := + d * (d.factorial * (2 * M) ^ d) * (d + 1) + +theorem roundedDeterminantCoefficient_pos {d : ℕ} (hd : 0 < d) + {M : ℚ} (hM : 0 < M) : + 0 < roundedDeterminantCoefficient d M := by + rw [roundedDeterminantCoefficient] + positivity + +theorem roundedInverseCoefficient_pos {d : ℕ} (hd : 0 < d) + {M : ℚ} (hM : 0 < M) : + 0 < roundedInverseCoefficient d M := by + rw [roundedInverseCoefficient] + positivity + +/-- The allowed mesh for rounding an exact one-step state. -/ +def roundedEllipsoidMeshTarget {d : ℕ} + (U : RationalEllipsoidState d) : ℚ := + let M := rationalMatrixAbsBound U.basis + let Δ := abs (Matrix.det U.basis) + min + (Δ / (128 * d ^ 3 * roundedDeterminantCoefficient d M)) + (roundedEllipsoidInflation d * Δ / + (2 * d * roundedInverseCoefficient d M)) + +/-- A common denominator dominating both adaptive rounding constraints. -/ +def roundedEllipsoidCoarseDenominator (d : ℕ) (M : ℚ) : ℚ := + 2048 * d ^ 6 * (d + 1) * d.factorial * (2 * M) ^ d + +theorem roundedEllipsoidCoarseDenominator_pos {d : ℕ} (hd : 0 < d) + {M : ℚ} (hM : 0 < M) : + 0 < roundedEllipsoidCoarseDenominator d M := by + rw [roundedEllipsoidCoarseDenominator] + positivity + +/-- A determinant lower bound computed without evaluating the determinant. +`Matrix.den` is the least common multiple of the entry denominators. -/ +def rationalMatrixDeterminantLower {d : ℕ} + (A : Matrix (Fin d) (Fin d) ℚ) : ℚ := + 1 / (A.den : ℚ) ^ d + +theorem rationalMatrixDeterminantLower_pos {d : ℕ} + (A : Matrix (Fin d) (Fin d) ℚ) : + 0 < rationalMatrixDeterminantLower A := by + rw [rationalMatrixDeterminantLower] + have hdenNat : 0 < A.den := Nat.pos_of_ne_zero A.den_ne_zero + have hden : (0 : ℚ) < A.den := by exact_mod_cast hdenNat + exact div_pos (by norm_num) (pow_pos hden d) + +/-- Clearing the common entry denominator turns the determinant into a +nonzero integer. Hence a nonzero rational determinant has magnitude at least +the reciprocal `d`-th power of that denominator. -/ +theorem rationalMatrixDeterminantLower_le_abs_det {d : ℕ} + (A : Matrix (Fin d) (Fin d) ℚ) (hdet : Matrix.det A ≠ 0) : + rationalMatrixDeterminantLower A ≤ abs (Matrix.det A) := by + have hmatrix := A.inv_denom_smul_num + have hdetEq := congrArg Matrix.det hmatrix + rw [Matrix.det_smul, Fintype.card_fin, ← Int.cast_det] at hdetEq + let z : ℤ := Matrix.det A.num + have hnumdet : z ≠ 0 := by + intro hz + apply hdet + rw [← hdetEq] + change (A.den : ℚ)⁻¹ ^ d * (z : ℚ) = 0 + rw [hz] + simp + have hint : (1 : ℤ) ≤ abs z := Int.one_le_abs hnumdet + have hintQ : (1 : ℚ) ≤ ((abs z : ℤ) : ℚ) := by + exact_mod_cast hint + rw [rationalMatrixDeterminantLower, ← hdetEq, abs_mul, abs_pow, + abs_inv, abs_of_nonneg (by positivity : (0 : ℚ) ≤ (A.den : ℚ)), + ← Int.cast_abs] + simpa only [one_div, inv_pow, mul_one, z] using + mul_le_mul_of_nonneg_left hintQ (by positivity : + 0 ≤ ((A.den : ℚ)⁻¹) ^ d) + +/-- A positive mesh target computed only from entry arithmetic. -/ +def determinantFreeRoundedMeshTarget {d : ℕ} + (U : RationalEllipsoidState d) : ℚ := + rationalMatrixDeterminantLower U.basis / + roundedEllipsoidCoarseDenominator d + (rationalMatrixAbsBound U.basis) + +theorem determinantFreeRoundedMeshTarget_pos {d : ℕ} (hd : 0 < d) + (U : RationalEllipsoidState d) : + 0 < determinantFreeRoundedMeshTarget U := by + rw [determinantFreeRoundedMeshTarget] + exact div_pos (rationalMatrixDeterminantLower_pos U.basis) + (roundedEllipsoidCoarseDenominator_pos hd + (rationalMatrixAbsBound_pos U.basis)) + +/-- Both determinant and inverse-error constraints are implied by one +coarse lower bound. -/ +theorem abs_det_div_coarseDenominator_le_meshTarget {d : ℕ} + (hd : 0 < d) (U : RationalEllipsoidState d) : + abs (Matrix.det U.basis) / + roundedEllipsoidCoarseDenominator d + (rationalMatrixAbsBound U.basis) ≤ + roundedEllipsoidMeshTarget U := by + let M := rationalMatrixAbsBound U.basis + let Δ := abs (Matrix.det U.basis) + let Q := roundedEllipsoidCoarseDenominator d M + have hM : 0 < M := rationalMatrixAbsBound_pos U.basis + have hQ : 0 < Q := roundedEllipsoidCoarseDenominator_pos hd hM + have hΔ : 0 ≤ Δ := abs_nonneg _ + rw [roundedEllipsoidMeshTarget] + apply le_min + · have hsmallDen : + 128 * (d : ℚ) ^ 3 * roundedDeterminantCoefficient d M ≤ Q := by + have hfactor : (1 : ℚ) ≤ 16 * d ^ 2 * (d + 1) := by + have hdq : (1 : ℚ) ≤ d := by exact_mod_cast hd + have hd2 : (1 : ℚ) ≤ (d : ℚ) ^ 2 := one_le_pow₀ hdq + nlinarith + have hbase : 0 ≤ + 128 * (d : ℚ) ^ 3 * roundedDeterminantCoefficient d M := by + rw [roundedDeterminantCoefficient] + positivity + have heq : Q = + (128 * (d : ℚ) ^ 3 * roundedDeterminantCoefficient d M) * + (16 * d ^ 2 * (d + 1)) := by + dsimp only [Q] + rw [roundedEllipsoidCoarseDenominator, + roundedDeterminantCoefficient] + push_cast + ring + rw [heq] + simpa only [mul_one] using mul_le_mul_of_nonneg_left hfactor hbase + exact div_le_div_of_nonneg_left hΔ + (by + rw [roundedDeterminantCoefficient] + positivity) hsmallDen + · have heq : + roundedEllipsoidInflation d * Δ / + (2 * d * roundedInverseCoefficient d M) = Δ / Q := by + dsimp only [Q] + rw [roundedEllipsoidInflation, roundedInverseCoefficient, + roundedEllipsoidCoarseDenominator] + push_cast + field_simp [Nat.ne_of_gt hd, hM.ne'] + <;> ring + rw [heq] + +theorem determinantFreeRoundedMeshTarget_le {d : ℕ} (hd : 0 < d) + (U : RationalEllipsoidState d) (hdet : Matrix.det U.basis ≠ 0) : + determinantFreeRoundedMeshTarget U ≤ roundedEllipsoidMeshTarget U := by + exact (div_le_div_of_nonneg_right + (rationalMatrixDeterminantLower_le_abs_det U.basis hdet) + (roundedEllipsoidCoarseDenominator_pos hd + (rationalMatrixAbsBound_pos U.basis)).le).trans + (abs_det_div_coarseDenominator_le_meshTarget hd U) + +/-- Mathematical lower bound on the number of fractional bits needed by one +rounded update. This quantity is used only as a proof specification: the +eventual machine uses an a priori schedule proved to dominate it and does not +evaluate a determinant. -/ +def roundedEllipsoidPrecision {d : ℕ} + (U : RationalEllipsoidState d) : ℕ := + positiveDyadicPrecision (roundedEllipsoidMeshTarget U) + +theorem dyadicMesh_eq_half_pow (p : ℕ) : + dyadicMesh p = (1 / 2 : ℚ) ^ p := by + simp [dyadicMesh, div_pow] + +theorem roundedEllipsoidMeshTarget_pos {d : ℕ} (hd : 0 < d) + (U : RationalEllipsoidState d) (hdet : Matrix.det U.basis ≠ 0) : + 0 < roundedEllipsoidMeshTarget U := by + let M := rationalMatrixAbsBound U.basis + have hM : 0 < M := rationalMatrixAbsBound_pos U.basis + have hΔ : 0 < abs (Matrix.det U.basis) := abs_pos.mpr hdet + rw [roundedEllipsoidMeshTarget] + apply lt_min + · exact div_pos hΔ (by + have hc := roundedDeterminantCoefficient_pos hd hM + positivity) + · exact div_pos + (mul_pos (roundedEllipsoidInflation_pos hd) hΔ) + (by + have hc := roundedInverseCoefficient_pos hd hM + positivity) + +theorem adaptive_dyadicMesh_lt_target {d : ℕ} (hd : 0 < d) + (U : RationalEllipsoidState d) (hdet : Matrix.det U.basis ≠ 0) : + dyadicMesh (roundedEllipsoidPrecision U) < + roundedEllipsoidMeshTarget U := by + rw [roundedEllipsoidPrecision] + exact dyadicMesh_positiveDyadicPrecision_lt + (roundedEllipsoidMeshTarget_pos hd U hdet) + +theorem adaptive_dyadicMesh_lt_determinant_threshold {d : ℕ} + (hd : 0 < d) (U : RationalEllipsoidState d) + (hdet : Matrix.det U.basis ≠ 0) : + dyadicMesh (roundedEllipsoidPrecision U) < + abs (Matrix.det U.basis) / + (128 * d ^ 3 * roundedDeterminantCoefficient d + (rationalMatrixAbsBound U.basis)) := by + exact (adaptive_dyadicMesh_lt_target hd U hdet).trans_le + (min_le_left _ _) + +theorem adaptive_dyadicMesh_lt_inverse_threshold {d : ℕ} + (hd : 0 < d) (U : RationalEllipsoidState d) + (hdet : Matrix.det U.basis ≠ 0) : + dyadicMesh (roundedEllipsoidPrecision U) < + roundedEllipsoidInflation d * abs (Matrix.det U.basis) / + (2 * d * roundedInverseCoefficient d + (rationalMatrixAbsBound U.basis)) := by + exact (adaptive_dyadicMesh_lt_target hd U hdet).trans_le + (min_le_right _ _) + +theorem adaptive_determinant_rounding_loss_lt {d : ℕ} + (hd : 0 < d) (U : RationalEllipsoidState d) + (hdet : Matrix.det U.basis ≠ 0) : + roundedDeterminantCoefficient d (rationalMatrixAbsBound U.basis) * + dyadicMesh (roundedEllipsoidPrecision U) < + abs (Matrix.det U.basis) / (128 * d ^ 3) := by + let C := roundedDeterminantCoefficient d + (rationalMatrixAbsBound U.basis) + have hC : 0 < C := roundedDeterminantCoefficient_pos hd + (rationalMatrixAbsBound_pos U.basis) + have hmesh := adaptive_dyadicMesh_lt_determinant_threshold hd U hdet + have hmul := mul_lt_mul_of_pos_left hmesh hC + change C * dyadicMesh (roundedEllipsoidPrecision U) < _ + calc + C * dyadicMesh (roundedEllipsoidPrecision U) < + C * (abs (Matrix.det U.basis) / (128 * d ^ 3 * C)) := hmul + _ = abs (Matrix.det U.basis) / (128 * d ^ 3) := by + field_simp [hC.ne'] + +theorem adaptive_inverse_rounding_loss_lt {d : ℕ} + (hd : 0 < d) (U : RationalEllipsoidState d) + (hdet : Matrix.det U.basis ≠ 0) : + roundedInverseCoefficient d (rationalMatrixAbsBound U.basis) * + dyadicMesh (roundedEllipsoidPrecision U) < + roundedEllipsoidInflation d * abs (Matrix.det U.basis) / + (2 * d) := by + let C := roundedInverseCoefficient d + (rationalMatrixAbsBound U.basis) + have hC : 0 < C := roundedInverseCoefficient_pos hd + (rationalMatrixAbsBound_pos U.basis) + have hmesh := adaptive_dyadicMesh_lt_inverse_threshold hd U hdet + have hmul := mul_lt_mul_of_pos_left hmesh hC + change C * dyadicMesh (roundedEllipsoidPrecision U) < _ + calc + C * dyadicMesh (roundedEllipsoidPrecision U) < + C * (roundedEllipsoidInflation d * abs (Matrix.det U.basis) / + (2 * d * C)) := hmul + _ = roundedEllipsoidInflation d * abs (Matrix.det U.basis) / + (2 * d) := by + field_simp [hC.ne', Nat.ne_of_gt hd] + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/RoundedFeasibility.lean b/LeanPool/BeyondBethe/BeyondBethe/RoundedFeasibility.lean new file mode 100644 index 0000000000..5c11d1f311 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/RoundedFeasibility.lean @@ -0,0 +1,286 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.AdaptiveRoundedEllipsoid +import LeanPool.BeyondBethe.BeyondBethe.RationalFeasibility +import Mathlib.Tactic + +/-! # Rounded Feasibility -/ + +open scoped BigOperators + +namespace BeyondBethe + +/-! +# Bounded-bit rational feasibility + +This is the executable feasibility loop used by the optimizer. It differs +from `runRationalFeasibility` only in replacing the exact central update by +the adaptive rounded update. The proofs below re-establish acceptance, +target preservation, nonsingularity, and finite termination with the weaker +rounded contraction constant. +-/ + +def runRoundedRationalFeasibility {d : ℕ} + (oracle : RationalCentralOracle d) : + ℕ → RationalEllipsoidState d → RationalFeasibilityResult d + | 0, E => .exhausted E + | budget + 1, E => + match oracle E with + | .accept => .accepted E.center + | .cut a => + runRoundedRationalFeasibility oracle budget + (adaptiveRoundedEllipsoidCentralUpdate E a) + +theorem runRoundedRationalFeasibility_acceptsOnly {d : ℕ} + {Good : (Fin d → ℚ) → Prop} {oracle : RationalCentralOracle d} + (haccept : RationalCentralOracleAcceptsOnly Good oracle) + {budget : ℕ} {E : RationalEllipsoidState d} {x : Fin d → ℚ} + (hrun : runRoundedRationalFeasibility oracle budget E = .accepted x) : + Good x := by + induction budget generalizing E with + | zero => simp [runRoundedRationalFeasibility] at hrun + | succ budget ih => + rw [runRoundedRationalFeasibility] at hrun + split at hrun <;> rename_i hresponse + · cases hrun + exact haccept E hresponse + · exact ih hrun + +/-- Physical form of adaptive rounded containment. -/ +theorem adaptiveRoundedEllipsoidCentralUpdate_contains_point {d : ℕ} + (hd : 0 < d) (E : RationalEllipsoidState d) (a : Fin d → ℚ) + (hdet : Matrix.det E.basis ≠ 0) + {x : Fin d → ℝ} (hcontains : RationalEllipsoidContains E x) + (ha : a ≠ 0) + (hcut : finiteDot (fun i ↦ (a i : ℝ)) + (fun i ↦ x i - rationalCenterReal E i) ≤ 0) : + RationalEllipsoidContains + (adaptiveRoundedEllipsoidCentralUpdate E a) x := by + obtain ⟨y, hy, hpoint⟩ := hcontains + have hb := rationalPulledBackNormal_ne_zero_of_det_ne_zero E a hdet ha + have hpulled : finiteDot + (fun j ↦ (rationalPulledBackNormal E a j : ℝ)) y ≤ 0 := by + rw [← physicalDot_point_sub_center_eq_pulledDot E a y] + simpa only [hpoint] using hcut + obtain ⟨y', hy', hpoint'⟩ := + adaptiveRoundedEllipsoidCentralUpdate_contains hd E a hdet hb hy hpulled + exact ⟨y', hy', hpoint'.trans hpoint⟩ + +theorem runRoundedRationalFeasibility_preserves_target_of_exhausted {d : ℕ} + (hd : 0 < d) {K : (Fin d → ℝ) → Prop} + {oracle : RationalCentralOracle d} + (hvalid : RationalCentralOracleValid K oracle) + {budget : ℕ} {E E' : RationalEllipsoidState d} + (hdet : Matrix.det E.basis ≠ 0) + (hrun : runRoundedRationalFeasibility oracle budget E = .exhausted E') + {x : Fin d → ℝ} (hK : K x) + (hcontains : RationalEllipsoidContains E x) : + RationalEllipsoidContains E' x := by + induction budget generalizing E E' with + | zero => + simp only [runRoundedRationalFeasibility] at hrun + cases hrun + exact hcontains + | succ budget ih => + rw [runRoundedRationalFeasibility] at hrun + split at hrun <;> rename_i hresponse + · contradiction + · have hcut := hvalid E _ hresponse + have hnext := adaptiveRoundedEllipsoidCentralUpdate_contains_point + hd E _ hdet hcontains hcut.1 (hcut.2 x hK) + have hpulled := rationalPulledBackNormal_ne_zero_of_det_ne_zero + E _ hdet hcut.1 + exact ih + (det_adaptiveRoundedEllipsoidCentralUpdate_ne_zero + hd E _ hdet hpulled) + hrun hnext + +theorem roundedContractionFactor_nonneg {d : ℕ} (hd : 0 < d) : + 0 ≤ 1 - 1 / (32 * (d : ℝ) ^ 3) := by + have hdR : (1 : ℝ) ≤ d := by exact_mod_cast hd + have hden : (1 : ℝ) ≤ 32 * (d : ℝ) ^ 3 := by + nlinarith [one_le_pow₀ (n := 3) hdR] + exact sub_nonneg.mpr + ((div_le_one (by positivity : (0 : ℝ) < 32 * (d : ℝ) ^ 3)).2 hden) + +theorem runRoundedRationalFeasibility_det_upper_of_exhausted {d : ℕ} + (hd : 0 < d) {K : (Fin d → ℝ) → Prop} + {oracle : RationalCentralOracle d} + (hvalid : RationalCentralOracleValid K oracle) + {budget : ℕ} {E E' : RationalEllipsoidState d} + (hdet : Matrix.det E.basis ≠ 0) + (hrun : runRoundedRationalFeasibility oracle budget E = .exhausted E') : + abs ((Matrix.det E'.basis : ℚ) : ℝ) ≤ + (1 - 1 / (32 * (d : ℝ) ^ 3)) ^ budget * + abs ((Matrix.det E.basis : ℚ) : ℝ) := by + induction budget generalizing E E' with + | zero => + simp only [runRoundedRationalFeasibility] at hrun + cases hrun + simp + | succ budget ih => + rw [runRoundedRationalFeasibility] at hrun + split at hrun + · rename_i hresponse + contradiction + · rename_i a hresponse + have hcut := hvalid E a hresponse + have hpulled := rationalPulledBackNormal_ne_zero_of_det_ne_zero + E a hdet hcut.1 + let Enext := adaptiveRoundedEllipsoidCentralUpdate E a + have hdetNext : Matrix.det Enext.basis ≠ 0 := + det_adaptiveRoundedEllipsoidCentralUpdate_ne_zero + hd E a hdet hpulled + have htail := ih hdetNext hrun + have hstep := abs_det_adaptiveRoundedCentralUpdate_le + hd E a hdet hpulled + have hfactor0 := roundedContractionFactor_nonneg hd + calc + abs ((Matrix.det E'.basis : ℚ) : ℝ) ≤ + (1 - 1 / (32 * (d : ℝ) ^ 3)) ^ budget * + abs ((Matrix.det Enext.basis : ℚ) : ℝ) := htail + _ ≤ (1 - 1 / (32 * (d : ℝ) ^ 3)) ^ budget * + ((1 - 1 / (32 * (d : ℝ) ^ 3)) * + abs ((Matrix.det E.basis : ℚ) : ℝ)) := + mul_le_mul_of_nonneg_left hstep (pow_nonneg hfactor0 _) + _ = (1 - 1 / (32 * (d : ℝ) ^ 3)) ^ (budget + 1) * + abs ((Matrix.det E.basis : ℚ) : ℝ) := by + rw [pow_succ] + ring + +theorem roundedContractionFactor_pow_budget_le_half_pow + {d M : ℕ} (hd : 0 < d) : + (1 - 1 / (32 * (d : ℝ) ^ 3)) ^ (32 * d ^ 3 * M) ≤ + (1 / 2 : ℝ) ^ M := by + let x : ℝ := 1 / (32 * (d : ℝ) ^ 3) + have hx0 : 0 ≤ x := by dsimp only [x]; positivity + have hbase : 1 - x ≤ Real.exp (-x) := by + simpa [sub_eq_add_neg, add_comm] using Real.add_one_le_exp (-x) + have hfactor : 0 ≤ 1 - x := by + simpa only [x] using roundedContractionFactor_nonneg hd + have hpow := pow_le_pow_left₀ hfactor hbase (32 * d ^ 3 * M) + have hexp : (Real.exp (-x)) ^ (32 * d ^ 3 * M) = + Real.exp (-(M : ℝ)) := by + rw [← Real.exp_nat_mul] + congr 1 + dsimp only [x] + have hdR : (0 : ℝ) < d := by exact_mod_cast hd + push_cast + field_simp + calc + (1 - 1 / (32 * (d : ℝ) ^ 3)) ^ (32 * d ^ 3 * M) = + (1 - x) ^ (32 * d ^ 3 * M) := by rfl + _ ≤ (Real.exp (-x)) ^ (32 * d ^ 3 * M) := hpow + _ = Real.exp (-(M : ℝ)) := hexp + _ = Real.exp (-1) ^ M := by + rw [show -(M : ℝ) = (M : ℝ) * (-1 : ℝ) by ring, + Real.exp_nat_mul] + _ ≤ (1 / 2 : ℝ) ^ M := + pow_le_pow_left₀ (Real.exp_pos (-1)).le real_exp_neg_one_le_half M + +/-- A rounded run cannot exhaust the determinant budget while retaining the +coordinate endpoints of a radius-`r` ball. -/ +theorem runRoundedRationalFeasibility_not_exhausted_of_inner_cross + {d M : ℕ} (hd : 0 < d) + {K : (Fin d → ℝ) → Prop} {oracle : RationalCentralOracle d} + (hvalid : RationalCentralOracleValid K oracle) + (E : RationalEllipsoidState d) + (hdet : Matrix.det E.basis ≠ 0) + {z : Fin d → ℝ} {r : ℝ} (hr : 0 ≤ r) + (hdyadic : Nat.factorial d * abs ((Matrix.det E.basis : ℚ) : ℝ) * + (1 / 2 : ℝ) ^ M < r ^ d) + (hKplus : ∀ k, K (fun i ↦ z i + if i = k then r else 0)) + (hKminus : ∀ k, K (fun i ↦ z i - if i = k then r else 0)) + (hEplus : ∀ k, RationalEllipsoidContains E + (fun i ↦ z i + if i = k then r else 0)) + (hEminus : ∀ k, RationalEllipsoidContains E + (fun i ↦ z i - if i = k then r else 0)) + (E' : RationalEllipsoidState d) : + runRoundedRationalFeasibility oracle (32 * d ^ 3 * M) E ≠ + .exhausted E' := by + intro hrun + have hplus : ∀ k, RationalEllipsoidContains E' + (fun i ↦ z i + if i = k then r else 0) := by + intro k + exact runRoundedRationalFeasibility_preserves_target_of_exhausted + hd hvalid hdet hrun (hKplus k) (hEplus k) + have hminus : ∀ k, RationalEllipsoidContains E' + (fun i ↦ z i - if i = k then r else 0) := by + intro k + exact runRoundedRationalFeasibility_preserves_target_of_exhausted + hd hvalid hdet hrun (hKminus k) (hEminus k) + have hlower := rationalEllipsoid_storedDet_lower_of_ball_endpoints + E' hr (fun k ↦ hplus k) (fun k ↦ hminus k) + have hupper := runRoundedRationalFeasibility_det_upper_of_exhausted + hd hvalid hdet hrun + have hfactor := roundedContractionFactor_pow_budget_le_half_pow + (d := d) (M := M) hd + have hdetUpper : abs ((Matrix.det E'.basis : ℚ) : ℝ) ≤ + (1 / 2 : ℝ) ^ M * abs ((Matrix.det E.basis : ℚ) : ℝ) := + hupper.trans (mul_le_mul_of_nonneg_right hfactor (abs_nonneg _)) + have hsandwich : r ^ d ≤ + Nat.factorial d * abs ((Matrix.det E.basis : ℚ) : ℝ) * + (1 / 2 : ℝ) ^ M := by + calc + r ^ d ≤ Nat.factorial d * + abs ((Matrix.det E'.basis : ℚ) : ℝ) := hlower + _ ≤ Nat.factorial d * + ((1 / 2 : ℝ) ^ M * + abs ((Matrix.det E.basis : ℚ) : ℝ)) := + mul_le_mul_of_nonneg_left hdetUpper (Nat.cast_nonneg _) + _ = Nat.factorial d * abs ((Matrix.det E.basis : ℚ) : ℝ) * + (1 / 2 : ℝ) ^ M := by ring + exact (not_lt_of_ge hsandwich) hdyadic + +/-- Ball specialization used by the concrete epigraph feasibility call. -/ +theorem runRoundedRationalFeasibility_ball_accepts + {d : ℕ} (hd : 0 < d) + {K : (Fin d → ℝ) → Prop} {Good : (Fin d → ℚ) → Prop} + {oracle : RationalCentralOracle d} + (hvalid : RationalCentralOracleValid K oracle) + (haccept : RationalCentralOracleAcceptsOnly Good oracle) + (c : Fin d → ℚ) {R r : ℚ} (hR : 0 < R) (hr : 0 < r) + {z : Fin d → ℝ} + (hKplus : ∀ k, K (fun i ↦ z i + if i = k then (r : ℝ) else 0)) + (hKminus : ∀ k, K (fun i ↦ z i - if i = k then (r : ℝ) else 0)) + (houterPlus : ∀ k, finiteNormSq + (fun i ↦ (z i + if i = k then (r : ℝ) else 0) - (c i : ℝ)) ≤ + (R : ℝ) ^ 2) + (houterMinus : ∀ k, finiteNormSq + (fun i ↦ (z i - if i = k then (r : ℝ) else 0) - (c i : ℝ)) ≤ + (R : ℝ) ^ 2) : + ∃ x : Fin d → ℚ, + runRoundedRationalFeasibility oracle + (32 * d ^ 3 * rationalBallDyadicExponent d R r) + (rationalBallEllipsoid d c R) = .accepted x ∧ Good x := by + let E := rationalBallEllipsoid d c R + let budget := 32 * d ^ 3 * rationalBallDyadicExponent d R r + let result := runRoundedRationalFeasibility oracle budget E + cases hresult : result with + | accepted x => + refine ⟨x, ?_, ?_⟩ + · simpa only [result, budget, E] using hresult + · exact runRoundedRationalFeasibility_acceptsOnly haccept + (by simpa only [result, budget, E] using hresult) + | exhausted E' => + exfalso + apply runRoundedRationalFeasibility_not_exhausted_of_inner_cross + hd hvalid E + (by + dsimp only [E] + rw [det_rationalBallEllipsoid] + exact pow_ne_zero _ hR.ne') + (hr := Rat.cast_nonneg.mpr hr.le) + (rationalBallEllipsoid_dyadic_budget hd c hR hr) + hKplus hKminus + · intro k + exact rationalBallEllipsoid_contains c hR (houterPlus k) + · intro k + exact rationalBallEllipsoid_contains c hR (houterMinus k) + · simpa only [result, budget, E] using hresult + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/RoundedFeasibilityBitBounds.lean b/LeanPool/BeyondBethe/BeyondBethe/RoundedFeasibilityBitBounds.lean new file mode 100644 index 0000000000..490bbbe6fc --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/RoundedFeasibilityBitBounds.lean @@ -0,0 +1,217 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.RoundedFeasibility +import LeanPool.BeyondBethe.BeyondBethe.RationalEncodingBounds +import Mathlib.Tactic + +/-! # Rounded Feasibility Bit Bounds -/ + +namespace BeyondBethe + +/-! +# Traces and size invariants for rounded feasibility + +The executable runner is recursive on a natural budget. This file exposes +the exact list of cuts it actually executes and connects that trace to the +iteration bounds. No feasibility assumption is needed for the size bounds; +oracle validity supplies only the nonzero-cut invariant. +-/ + +def roundedRationalFeasibilityCuts {d : ℕ} + (oracle : RationalCentralOracle d) : + ℕ → RationalEllipsoidState d → List (Fin d → ℚ) + | 0, _ => [] + | budget + 1, E => + match oracle E with + | .accept => [] + | .cut a => a :: roundedRationalFeasibilityCuts oracle budget + (adaptiveRoundedEllipsoidCentralUpdate E a) + +theorem roundedRationalFeasibilityCuts_length_le {d : ℕ} + (oracle : RationalCentralOracle d) (budget : ℕ) + (E : RationalEllipsoidState d) : + (roundedRationalFeasibilityCuts oracle budget E).length ≤ budget := by + induction budget generalizing E with + | zero => simp [roundedRationalFeasibilityCuts] + | succ budget ih => + rw [roundedRationalFeasibilityCuts] + split + · simp + · simp only [List.length_cons] + exact Nat.succ_le_succ (ih _) + +theorem adaptiveRoundedEllipsoidIterate_feasibilityCuts_terminal {d : ℕ} + (oracle : RationalCentralOracle d) (budget : ℕ) + (E : RationalEllipsoidState d) : + match runRoundedRationalFeasibility oracle budget E with + | .accepted x => + (adaptiveRoundedEllipsoidIterate E + (roundedRationalFeasibilityCuts oracle budget E)).center = x + | .exhausted E' => + adaptiveRoundedEllipsoidIterate E + (roundedRationalFeasibilityCuts oracle budget E) = E' := by + induction budget generalizing E with + | zero => simp [runRoundedRationalFeasibility, + roundedRationalFeasibilityCuts, adaptiveRoundedEllipsoidIterate] + | succ budget ih => + cases hresponse : oracle E with + | accept => + simp [runRoundedRationalFeasibility, + roundedRationalFeasibilityCuts, hresponse, + adaptiveRoundedEllipsoidIterate] + | cut a => + let E' := adaptiveRoundedEllipsoidCentralUpdate E a + have htail := ih E' + cases hrun : runRoundedRationalFeasibility oracle budget E' with + | accepted x => + rw [hrun] at htail + simpa only [runRoundedRationalFeasibility, + roundedRationalFeasibilityCuts, hresponse, + adaptiveRoundedEllipsoidIterate, E', hrun] using htail + | exhausted U => + rw [hrun] at htail + simpa only [runRoundedRationalFeasibility, + roundedRationalFeasibilityCuts, hresponse, + adaptiveRoundedEllipsoidIterate, E', hrun] using htail + +theorem roundedRationalFeasibilityCuts_regular {d : ℕ} + (hd : 0 < d) {K : (Fin d → ℝ) → Prop} + {oracle : RationalCentralOracle d} + (hvalid : RationalCentralOracleValid K oracle) + (budget : ℕ) (E : RationalEllipsoidState d) + (hdet : Matrix.det E.basis ≠ 0) : + AdaptiveCutSequenceRegular E + (roundedRationalFeasibilityCuts oracle budget E) := by + induction budget generalizing E with + | zero => simp [roundedRationalFeasibilityCuts, + AdaptiveCutSequenceRegular] + | succ budget ih => + rw [roundedRationalFeasibilityCuts] + split <;> rename_i hresponse + · simp [AdaptiveCutSequenceRegular] + · have ha := (hvalid E _ hresponse).1 + have hb := rationalPulledBackNormal_ne_zero_of_det_ne_zero + E _ hdet ha + have hdet' := det_adaptiveRoundedEllipsoidCentralUpdate_ne_zero + hd E _ hdet hb + exact ⟨hb, ih _ hdet'⟩ + +/-- Every terminal state of a valid rounded run has a trace of at most the +budgeted length and satisfies the determinant, magnitude, and precision +invariants proved for abstract regular traces. -/ +theorem runRoundedRationalFeasibility_terminal_invariants {d L K : ℕ} + (hd : 0 < d) {Target : (Fin d → ℝ) → Prop} + {oracle : RationalCentralOracle d} + (hvalid : RationalCentralOracleValid Target oracle) + (budget : ℕ) (E : RationalEllipsoidState d) + (hdet : Matrix.det E.basis ≠ 0) + (hdetLower : dyadicMesh L ≤ abs (Matrix.det E.basis)) + (hM : rationalStateAbsBound E ≤ (2 : ℚ) ^ K) : + let cuts := roundedRationalFeasibilityCuts oracle budget E + cuts.length ≤ budget ∧ + AdaptiveCutSequenceRegular E cuts ∧ + dyadicMesh (L + 2 * cuts.length) ≤ + abs (Matrix.det (adaptiveRoundedEllipsoidIterate E cuts).basis) ∧ + rationalStateAbsBound (adaptiveRoundedEllipsoidIterate E cuts) ≤ + (2 : ℚ) ^ roundedEllipsoidStateMagnitudeExponent + d K cuts.length ∧ + roundedEllipsoidPrecision (adaptiveRoundedEllipsoidIterate E cuts) ≤ + (L + 2 * cuts.length) + + roundedEllipsoidDenominatorExponent d + (roundedEllipsoidMagnitudeExponent d K cuts.length) + 2 := by + let cuts := roundedRationalFeasibilityCuts oracle budget E + have hlen : cuts.length ≤ budget := + roundedRationalFeasibilityCuts_length_le oracle budget E + have hregular : AdaptiveCutSequenceRegular E cuts := + roundedRationalFeasibilityCuts_regular hd hvalid budget E hdet + have hMbasis : rationalMatrixAbsBound E.basis ≤ (2 : ℚ) ^ K := + (rationalMatrixAbsBound_le_rationalStateAbsBound E).trans hM + exact ⟨hlen, hregular, + adaptiveRoundedEllipsoidIterate_dyadic_det_lower + hd E hdet hdetLower cuts hregular, + adaptiveRoundedEllipsoidIterate_two_pow_state_magnitude_upper + hd E hM cuts hregular, + adaptiveRoundedEllipsoidIterate_precision_upper + hd E hdet hdetLower hMbasis cuts hregular⟩ + +/-- Every exact central update that is actually requested by a valid run uses +at most the stated polynomial precision. The decomposition identifies the +cut and the trace prefix before it. -/ +theorem roundedRationalFeasibilityCuts_next_precision_upper + {d L K : ℕ} (hd : 0 < d) + {Target : (Fin d → ℝ) → Prop} + {oracle : RationalCentralOracle d} + (hvalid : RationalCentralOracleValid Target oracle) + (budget : ℕ) (E : RationalEllipsoidState d) + (hdet : Matrix.det E.basis ≠ 0) + (hdetLower : dyadicMesh L ≤ abs (Matrix.det E.basis)) + (hM : rationalStateAbsBound E ≤ (2 : ℚ) ^ K) + (pre suffix : List (Fin d → ℚ)) (a : Fin d → ℚ) + (htrace : roundedRationalFeasibilityCuts oracle budget E = + pre ++ a :: suffix) : + roundedEllipsoidPrecision + (rationalEllipsoidCentralUpdate + (adaptiveRoundedEllipsoidIterate E pre) a) ≤ + roundedEllipsoidNextPrecisionBound d L K pre.length := by + have hregular := roundedRationalFeasibilityCuts_regular + hd hvalid budget E hdet + rw [htrace] at hregular + have hpre := AdaptiveCutSequenceRegular.prefix_and_next + E pre suffix a hregular + exact adaptiveRoundedEllipsoidIterate_next_precision_upper + hd E hdet hdetLower hM pre hpre.1 a hpre.2 + +/-- The stored state immediately after every executed cut has a fully +explicit encoding-length bound. -/ +theorem roundedRationalFeasibilityCuts_next_state_encodedBitLength_le + {d L K : ℕ} (hd : 0 < d) + {Target : (Fin d → ℝ) → Prop} + {oracle : RationalCentralOracle d} + (hvalid : RationalCentralOracleValid Target oracle) + (budget : ℕ) (E : RationalEllipsoidState d) + (hdet : Matrix.det E.basis ≠ 0) + (hdetLower : dyadicMesh L ≤ abs (Matrix.det E.basis)) + (hM : rationalStateAbsBound E ≤ (2 : ℚ) ^ K) + (pre suffix : List (Fin d → ℚ)) (a : Fin d → ℚ) + (htrace : roundedRationalFeasibilityCuts oracle budget E = + pre ++ a :: suffix) : + rationalEllipsoidStateEncodedBitLength + (adaptiveRoundedEllipsoidCentralUpdate + (adaptiveRoundedEllipsoidIterate E pre) a) ≤ + 6 + d * (20 + 4 * + roundedEllipsoidStateMagnitudeExponent d K (pre.length + 1) + + 8 * roundedEllipsoidNextPrecisionBound d L K pre.length) + + 2 * d + d ^ 2 * (100 + 4 * + roundedEllipsoidStateMagnitudeExponent d K (pre.length + 1) + + 8 * roundedEllipsoidNextPrecisionBound d L K pre.length + + 32 * d) := by + have hregular := roundedRationalFeasibilityCuts_regular + hd hvalid budget E hdet + rw [htrace] at hregular + have hpre := AdaptiveCutSequenceRegular.prefix_and_next + E pre suffix a hregular + have hprea := AdaptiveCutSequenceRegular.append_singleton + E pre a hpre.1 hpre.2 + have hstate := + adaptiveRoundedEllipsoidIterate_two_pow_state_magnitude_upper + hd E hM (pre ++ [a]) hprea + have hstate' : + rationalStateAbsBound + (adaptiveRoundedEllipsoidCentralUpdate + (adaptiveRoundedEllipsoidIterate E pre) a) ≤ + (2 : ℚ) ^ + roundedEllipsoidStateMagnitudeExponent d K (pre.length + 1) := by + rw [adaptiveRoundedEllipsoidIterate_append] at hstate + simpa only [adaptiveRoundedEllipsoidIterate, List.length_append, + List.length_singleton, Nat.add_comm] using hstate + have hp := roundedRationalFeasibilityCuts_next_precision_upper + hd hvalid budget E hdet hdetLower hM pre suffix a htrace + exact adaptiveRoundedEllipsoid_state_encodedBitLength_le hd + (rationalEllipsoidCentralUpdate + (adaptiveRoundedEllipsoidIterate E pre) a) hstate' hp + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/RowStability.lean b/LeanPool/BeyondBethe/BeyondBethe/RowStability.lean new file mode 100644 index 0000000000..f5624685b7 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/RowStability.lean @@ -0,0 +1,1846 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.Slack +import Mathlib.Analysis.Convex.Jensen +import Mathlib.Analysis.SpecialFunctions.Artanh +import Mathlib.Analysis.SpecialFunctions.Log.Deriv +import Mathlib.Data.Fin.Rev +import Mathlib.Tactic + +/-! # Row Stability -/ + +namespace BeyondBethe + +/-- `b` occurs strictly between `a` and `c` in the ordering `π`. -/ +def OrderBetween {n : ℕ} (π : Equiv.Perm (Fin n)) + (a b c : Fin n) : Prop := + (π.symm a < π.symm b ∧ π.symm b < π.symm c) ∨ + (π.symm c < π.symm b ∧ π.symm b < π.symm a) + +instance instDecidableOrderBetween + {n : ℕ} (π : Equiv.Perm (Fin n)) (a b c : Fin n) : + Decidable (OrderBetween π a b c) := by + unfold OrderBetween + infer_instance + +theorem one_middle_indicator + {n : ℕ} (π : Equiv.Perm (Fin n)) + {i j k : Fin n} (hij : i ≠ j) (hik : i ≠ k) (hjk : j ≠ k) : + (if OrderBetween π j i k then (1 : ℝ) else 0) + + (if OrderBetween π i j k then 1 else 0) + + (if OrderBetween π i k j then 1 else 0) = 1 := by + classical + have hij' : π.symm i ≠ π.symm j := π.symm.injective.ne hij + have hik' : π.symm i ≠ π.symm k := π.symm.injective.ne hik + have hjk' : π.symm j ≠ π.symm k := π.symm.injective.ne hjk + rcases lt_or_gt_of_ne hij' with hijlt | hjilt + · rcases lt_or_gt_of_ne hjk' with hjklt | hkjlt + · have hiklt := hijlt.trans hjklt + have hjinot : ¬π.symm j < π.symm i := not_lt_of_ge hijlt.le + have hknotj : ¬π.symm k < π.symm j := not_lt_of_ge hjklt.le + have hknoti : ¬π.symm k < π.symm i := not_lt_of_ge hiklt.le + simp [OrderBetween, hijlt, hjklt, hiklt, hjinot, hknotj, hknoti] + · rcases lt_or_gt_of_ne hik' with hiklt | hkilt + · have hikj := hiklt.trans hkjlt + have hkinot : ¬π.symm k < π.symm i := not_lt_of_ge hiklt.le + have hjnotk : ¬π.symm j < π.symm k := not_lt_of_ge hkjlt.le + have hjnoti : ¬π.symm j < π.symm i := not_lt_of_ge hikj.le + simp [OrderBetween, hiklt, hkjlt, hikj, hkinot, hjnotk, hjnoti] + · have hkij := hkilt.trans hijlt + have hinotk : ¬π.symm i < π.symm k := not_lt_of_ge hkilt.le + have hjnoti : ¬π.symm j < π.symm i := not_lt_of_ge hijlt.le + have hjnotk : ¬π.symm j < π.symm k := not_lt_of_ge hkij.le + simp [OrderBetween, hkilt, hijlt, hkij, hinotk, hjnoti, hjnotk] + · rcases lt_or_gt_of_ne hik' with hiklt | hkilt + · have hjik := hjilt.trans hiklt + have hinotj : ¬π.symm i < π.symm j := not_lt_of_ge hjilt.le + have hknoti : ¬π.symm k < π.symm i := not_lt_of_ge hiklt.le + have hknotj : ¬π.symm k < π.symm j := not_lt_of_ge hjik.le + simp [OrderBetween, hjilt, hiklt, hjik, hinotj, hknoti, hknotj] + · rcases lt_or_gt_of_ne hjk' with hjklt | hkjlt + · have hjki := hjklt.trans hkilt + have hknotj : ¬π.symm k < π.symm j := not_lt_of_ge hjklt.le + have hinotk : ¬π.symm i < π.symm k := not_lt_of_ge hkilt.le + have hinotj : ¬π.symm i < π.symm j := not_lt_of_ge hjki.le + simp [OrderBetween, hjklt, hkilt, hjki, hknotj, hinotk, hinotj] + · have hkji := hkjlt.trans hjilt + have hjnotk : ¬π.symm j < π.symm k := not_lt_of_ge hkjlt.le + have hinotj : ¬π.symm i < π.symm j := not_lt_of_ge hjilt.le + have hinotk : ¬π.symm i < π.symm k := not_lt_of_ge hkji.le + simp [OrderBetween, hkjlt, hjilt, hkji, hjnotk, hinotj, hinotk] + +theorem orderBetween_trans_swap + {n : ℕ} (π : Equiv.Perm (Fin n)) + {i j k : Fin n} (hik : i ≠ k) (hjk : j ≠ k) : + OrderBetween (π.trans (Equiv.swap i j)) i j k ↔ + OrderBetween π j i k := by + simp [OrderBetween, Equiv.trans_apply, Equiv.swap_apply_def, hik, hjk, + Ne.symm hik, Ne.symm hjk] + +/-- Uniform probability that the middle argument lies between the two +endpoints in a random ordering. -/ +noncomputable def betweenProbability + {n : ℕ} (a b c : Fin n) : ℝ := by + classical + exact uniformAverage (fun π : Equiv.Perm (Fin n) ↦ + if OrderBetween π a b c then 1 else 0) + +theorem betweenProbability_endpoint_symm + {n : ℕ} (a b c : Fin n) : + betweenProbability a b c = betweenProbability c b a := by + classical + apply congrArg uniformAverage + funext π + apply if_congr + · simp only [OrderBetween] + tauto + · rfl + · rfl + +theorem betweenProbability_swap_middle + {n : ℕ} {i j k : Fin n} (hik : i ≠ k) (hjk : j ≠ k) : + betweenProbability j i k = betweenProbability i j k := by + classical + let f : Equiv.Perm (Fin n) → ℝ := fun π ↦ + if OrderBetween π i j k then 1 else 0 + calc + betweenProbability j i k = + uniformAverage (fun π : Equiv.Perm (Fin n) ↦ + f (π.trans (Equiv.swap i j))) := by + apply congrArg uniformAverage + funext π + simp only [f] + exact if_congr (orderBetween_trans_swap π hik hjk).symm rfl rfl + _ = uniformAverage f := uniformAverage_perm_trans f (Equiv.swap i j) + _ = betweenProbability i j k := rfl + +theorem betweenProbability_eq_one_third + {n : ℕ} {i j k : Fin n} + (hij : i ≠ j) (hik : i ≠ k) (hjk : j ≠ k) : + betweenProbability j i k = 1 / 3 := by + classical + have hijSymm := betweenProbability_swap_middle (i := i) (j := j) + (k := k) hik hjk + have hjkSymm := betweenProbability_swap_middle (i := j) (j := k) + (k := i) (Ne.symm hij) (Ne.symm hik) + have hBC : betweenProbability i j k = betweenProbability i k j := by + calc + betweenProbability i j k = betweenProbability k j i := + betweenProbability_endpoint_symm i j k + _ = betweenProbability j k i := hjkSymm + _ = betweenProbability i k j := + betweenProbability_endpoint_symm j k i + have hsum : betweenProbability j i k + + betweenProbability i j k + betweenProbability i k j = 1 := by + unfold betweenProbability uniformAverage + rw [← add_div, ← add_div, + ← Finset.sum_add_distrib, ← Finset.sum_add_distrib] + simp_rw [one_middle_indicator _ hij hik hjk] + rw [Finset.sum_const, Finset.card_univ, nsmul_eq_mul] + field_simp [Fintype.card_ne_zero] + rw [hijSymm, ← hBC] at hsum + linarith + +/-- The three named points occur in this strict order. -/ +def StrictTripleOrder {n : ℕ} (π : Equiv.Perm (Fin n)) + (a b c : Fin n) : Prop := + π.symm a < π.symm b ∧ π.symm b < π.symm c + +instance instDecidableStrictTripleOrder + {n : ℕ} (π : Equiv.Perm (Fin n)) (a b c : Fin n) : + Decidable (StrictTripleOrder π a b c) := by + unfold StrictTripleOrder + infer_instance + +noncomputable def tripleOrderProbability + {n : ℕ} (a b c : Fin n) : ℝ := by + classical + exact uniformAverage (fun π : Equiv.Perm (Fin n) ↦ + if StrictTripleOrder π a b c then 1 else 0) + +theorem strictTripleOrder_trans_swap_endpoints + {n : ℕ} (π : Equiv.Perm (Fin n)) + {a b c : Fin n} (hab : a ≠ b) (hbc : b ≠ c) : + StrictTripleOrder (π.trans (Equiv.swap a c)) a b c ↔ + StrictTripleOrder π c b a := by + simp [StrictTripleOrder, Equiv.trans_apply, Equiv.swap_apply_def, + hab, hbc, Ne.symm hab, Ne.symm hbc] + +theorem tripleOrderProbability_reverse + {n : ℕ} {a b c : Fin n} (hab : a ≠ b) (hbc : b ≠ c) : + tripleOrderProbability a b c = tripleOrderProbability c b a := by + classical + let f : Equiv.Perm (Fin n) → ℝ := fun π ↦ + if StrictTripleOrder π a b c then 1 else 0 + let g : Equiv.Perm (Fin n) → ℝ := fun π ↦ + if StrictTripleOrder π c b a then 1 else 0 + calc + tripleOrderProbability a b c = uniformAverage f := rfl + _ = uniformAverage (fun π : Equiv.Perm (Fin n) ↦ + g (π.trans (Equiv.swap c a))) := by + apply congrArg uniformAverage + funext π + exact if_congr + (strictTripleOrder_trans_swap_endpoints π + (a := c) (b := b) (c := a) (Ne.symm hbc) (Ne.symm hab)).symm + rfl rfl + _ = uniformAverage g := uniformAverage_perm_trans g (Equiv.swap c a) + _ = tripleOrderProbability c b a := rfl + +theorem betweenProbability_eq_tripleOrder_add_reverse + {n : ℕ} (a b c : Fin n) : + betweenProbability a b c = + tripleOrderProbability a b c + tripleOrderProbability c b a := by + classical + rw [betweenProbability, tripleOrderProbability, tripleOrderProbability, + ← uniformAverage_add] + apply congrArg uniformAverage + funext π + simp only [OrderBetween, StrictTripleOrder] + by_cases h₁ : π.symm a < π.symm b ∧ π.symm b < π.symm c + · have hnot : ¬(π.symm c < π.symm b ∧ π.symm b < π.symm a) := by + intro h + exact lt_asymm h₁.1 h.2 + simp [h₁, hnot] + · by_cases h₂ : π.symm c < π.symm b ∧ π.symm b < π.symm a + · simp [h₁, h₂] + · simp [h₁, h₂] + +theorem tripleOrderProbability_eq_one_sixth + {n : ℕ} {a b c : Fin n} + (hab : a ≠ b) (hac : a ≠ c) (hbc : b ≠ c) : + tripleOrderProbability a b c = 1 / 6 := by + have hbetween := betweenProbability_eq_one_third + (i := b) (j := a) (k := c) (Ne.symm hab) hbc hac + rw [betweenProbability_eq_tripleOrder_add_reverse] at hbetween + have hreverse := tripleOrderProbability_reverse hab hbc + rw [← hreverse] at hbetween + linarith + +/-- Mass strictly before coordinate `i` in an ordering. -/ +noncomputable def strictLeftMass + {n : ℕ} (p : Fin n → ℝ) (π : Equiv.Perm (Fin n)) (i : Fin n) : ℝ := + ∑ j, if π.symm j < π.symm i then p j else 0 + +/-- Mass strictly after coordinate `i` in an ordering. -/ +noncomputable def strictRightMass + {n : ℕ} (p : Fin n → ℝ) (π : Equiv.Perm (Fin n)) (i : Fin n) : ℝ := + ∑ j, if π.symm i < π.symm j then p j else 0 + +theorem strictLeftMass_add_strictRightMass + {n : ℕ} {p : Fin n → ℝ} (hp : IsProbabilityVector p) + (π : Equiv.Perm (Fin n)) (i : Fin n) : + strictLeftMass p π i + strictRightMass p π i = 1 - p i := by + classical + rw [strictLeftMass, strictRightMass, ← Finset.sum_add_distrib] + have hterm : ∀ j : Fin n, + (if π.symm j < π.symm i then p j else 0) + + (if π.symm i < π.symm j then p j else 0) = + if j = i then 0 else p j := by + intro j + by_cases hji : j = i + · subst j + simp + · have hpos : π.symm j ≠ π.symm i := π.symm.injective.ne hji + rcases lt_or_gt_of_ne hpos with hlt | hgt + · simp [hji, hlt, not_lt_of_ge hlt.le] + · simp [hji, hgt, not_lt_of_ge hgt.le] + simp_rw [hterm] + calc + ∑ j : Fin n, (if j = i then 0 else p j) = + ∑ j, (p j - if j = i then p j else 0) := by + apply Finset.sum_congr rfl + intro j _ + by_cases hji : j = i <;> simp [hji] + _ = (∑ j, p j) - ∑ j, (if j = i then p j else 0) := by + rw [Finset.sum_sub_distrib] + _ = 1 - p i := by rw [hp.sum_eq_one]; simp + +theorem prefix_mul_suffix_eq_self_add_crossing + {n : ℕ} {p : Fin n → ℝ} (hp : IsProbabilityVector p) + (π : Equiv.Perm (Fin n)) (i : Fin n) : + (p i + strictLeftMass p π i) * + (p i + strictRightMass p π i) = + p i + strictLeftMass p π i * strictRightMass p π i := by + have hmass := strictLeftMass_add_strictRightMass hp π i + calc + (p i + strictLeftMass p π i) * + (p i + strictRightMass p π i) = + (p i) ^ 2 + p i * + (strictLeftMass p π i + strictRightMass p π i) + + strictLeftMass p π i * strictRightMass p π i := by ring + _ = p i + strictLeftMass p π i * strictRightMass p π i := by + rw [hmass] + ring + +/-- The product of the strict masses on the two sides of `i` is the total +weight of ordered pairs that straddle `i`. -/ +theorem strictLeftMass_mul_strictRightMass + {n : ℕ} (p : Fin n → ℝ) (π : Equiv.Perm (Fin n)) (i : Fin n) : + strictLeftMass p π i * strictRightMass p π i = + ∑ j, ∑ k, if StrictTripleOrder π j i k then p j * p k else 0 := by + classical + rw [strictLeftMass, strictRightMass, Finset.sum_mul] + apply Finset.sum_congr rfl + intro j _ + rw [Finset.mul_sum] + apply Finset.sum_congr rfl + intro k _ + unfold StrictTripleOrder + by_cases hj : π.symm j < π.symm i + · by_cases hk : π.symm i < π.symm k <;> simp [hj, hk] + · simp [hj] + +theorem uniformAverage_indicator_mul + {α : Type*} [Fintype α] (P : α → Prop) [DecidablePred P] (c : ℝ) : + uniformAverage (fun x ↦ if P x then c else 0) = + c * uniformAverage (fun x ↦ if P x then 1 else 0) := by + rw [← uniformAverage_const_mul] + apply congrArg uniformAverage + funext x + by_cases hx : P x <;> simp [hx] + +theorem tripleOrderProbability_eq_zero_of_left_eq_middle + {n : ℕ} (a c : Fin n) : + tripleOrderProbability a a c = 0 := by + classical + rw [tripleOrderProbability] + calc + uniformAverage (fun π : Equiv.Perm (Fin n) ↦ + if StrictTripleOrder π a a c then 1 else 0) = + uniformAverage (fun _ : Equiv.Perm (Fin n) ↦ 0) := by + apply congrArg uniformAverage + funext π + simp [StrictTripleOrder] + _ = 0 := uniformAverage_const 0 + +theorem tripleOrderProbability_eq_zero_of_middle_eq_right + {n : ℕ} (a c : Fin n) : + tripleOrderProbability a c c = 0 := by + classical + rw [tripleOrderProbability] + calc + uniformAverage (fun π : Equiv.Perm (Fin n) ↦ + if StrictTripleOrder π a c c then 1 else 0) = + uniformAverage (fun _ : Equiv.Perm (Fin n) ↦ 0) := by + apply congrArg uniformAverage + funext π + simp [StrictTripleOrder] + _ = 0 := uniformAverage_const 0 + +theorem tripleOrderProbability_eq_zero_of_left_eq_right + {n : ℕ} (a b : Fin n) : + tripleOrderProbability a b a = 0 := by + classical + rw [tripleOrderProbability] + calc + uniformAverage (fun π : Equiv.Perm (Fin n) ↦ + if StrictTripleOrder π a b a then 1 else 0) = + uniformAverage (fun _ : Equiv.Perm (Fin n) ↦ 0) := by + apply congrArg uniformAverage + funext π + rw [if_neg] + intro h + exact lt_asymm h.1 h.2 + _ = 0 := uniformAverage_const 0 + +theorem tripleOrderProbability_cases + {n : ℕ} (a b c : Fin n) : + tripleOrderProbability a b c = + if a ≠ b ∧ a ≠ c ∧ b ≠ c then 1 / 6 else 0 := by + classical + by_cases hab : a = b + · subst b + simp [tripleOrderProbability_eq_zero_of_left_eq_middle] + · by_cases hac : a = c + · subst c + simp [hab, tripleOrderProbability_eq_zero_of_left_eq_right] + · by_cases hbc : b = c + · subst c + simp [hab, tripleOrderProbability_eq_zero_of_middle_eq_right] + · simp [hab, hac, hbc, tripleOrderProbability_eq_one_sixth hab hac hbc] + +/-- Uniformly averaging the strict-left/strict-right product turns every +ordered pair of distinct coordinates away from `i` into a `1/6` contribution. -/ +theorem average_strictLeftMass_mul_strictRightMass + {n : ℕ} (p : Fin n → ℝ) (i : Fin n) : + uniformAverage (fun π : Equiv.Perm (Fin n) ↦ + strictLeftMass p π i * strictRightMass p π i) = + (1 / 6) * ∑ j, ∑ k, + if j ≠ i ∧ j ≠ k ∧ i ≠ k then p j * p k else 0 := by + classical + calc + uniformAverage (fun π : Equiv.Perm (Fin n) ↦ + strictLeftMass p π i * strictRightMass p π i) = + uniformAverage (fun π : Equiv.Perm (Fin n) ↦ + ∑ j, ∑ k, + if StrictTripleOrder π j i k then p j * p k else 0) := + congrArg uniformAverage (funext fun π ↦ + strictLeftMass_mul_strictRightMass p π i) + _ = ∑ j, uniformAverage (fun π : Equiv.Perm (Fin n) ↦ + ∑ k, if StrictTripleOrder π j i k then p j * p k else 0) := + uniformAverage_sum _ + _ = ∑ j, ∑ k, uniformAverage (fun π : Equiv.Perm (Fin n) ↦ + if StrictTripleOrder π j i k then p j * p k else 0) := by + apply Finset.sum_congr rfl + intro j _ + exact uniformAverage_sum _ + _ = ∑ j, ∑ k, (1 / 6) * + (if j ≠ i ∧ j ≠ k ∧ i ≠ k then p j * p k else 0) := by + apply Finset.sum_congr rfl + intro j _ + apply Finset.sum_congr rfl + intro k _ + calc + uniformAverage (fun π : Equiv.Perm (Fin n) ↦ + if StrictTripleOrder π j i k then p j * p k else 0) = + p j * p k * tripleOrderProbability j i k := + uniformAverage_indicator_mul + (fun π : Equiv.Perm (Fin n) ↦ StrictTripleOrder π j i k) + (p j * p k) + _ = p j * p k * + (if j ≠ i ∧ j ≠ k ∧ i ≠ k then 1 / 6 else 0) := by + rw [tripleOrderProbability_cases] + _ = (1 / 6) * + (if j ≠ i ∧ j ≠ k ∧ i ≠ k then p j * p k else 0) := by + by_cases h : j ≠ i ∧ j ≠ k ∧ i ≠ k <;> simp [h] <;> ring + _ = (1 / 6) * ∑ j, ∑ k, + if j ≠ i ∧ j ≠ k ∧ i ≠ k then p j * p k else 0 := by + rw [Finset.mul_sum] + apply Finset.sum_congr rfl + intro j _ + rw [Finset.mul_sum] + +theorem sum_ite_ne_eq_sum_sub + {ι : Type*} [Fintype ι] [DecidableEq ι] + (f : ι → ℝ) (i : ι) : + (∑ j, if j ≠ i then f j else 0) = (∑ j, f j) - f i := by + calc + (∑ j, if j ≠ i then f j else 0) = + ∑ j, (f j - if j = i then f j else 0) := by + apply Finset.sum_congr rfl + intro j _ + by_cases hji : j = i <;> simp [hji] + _ = (∑ j, f j) - ∑ j, (if j = i then f j else 0) := by + rw [Finset.sum_sub_distrib] + _ = (∑ j, f j) - f i := by simp + +theorem sum_away_from_two + {n : ℕ} {p : Fin n → ℝ} (hp : IsProbabilityVector p) + {i j : Fin n} (hij : i ≠ j) : + (∑ k, if i ≠ k ∧ j ≠ k then p k else 0) = 1 - p i - p j := by + classical + calc + (∑ k, if i ≠ k ∧ j ≠ k then p k else 0) = + ∑ k, (p k - (if k = i then p k else 0) - + (if k = j then p k else 0)) := by + apply Finset.sum_congr rfl + intro k _ + by_cases hki : k = i + · subst k + simp [hij] + · by_cases hkj : k = j + · subst k + simp [hki] + · simp [hki, hkj, Ne.symm hki, Ne.symm hkj] + _ = (∑ k, p k) - ∑ k, (if k = i then p k else 0) - + ∑ k, (if k = j then p k else 0) := by + rw [Finset.sum_sub_distrib, Finset.sum_sub_distrib] + _ = 1 - p i - p j := by rw [hp.sum_eq_one]; simp + +theorem inner_ordered_distinct_products + {n : ℕ} {p : Fin n → ℝ} (hp : IsProbabilityVector p) + (i j : Fin n) : + (∑ k, if j ≠ i ∧ j ≠ k ∧ i ≠ k then p j * p k else 0) = + if j ≠ i then p j * (1 - p i - p j) else 0 := by + classical + by_cases hji : j = i + · subst j + simp + · calc + (∑ k, if j ≠ i ∧ j ≠ k ∧ i ≠ k then p j * p k else 0) = + p j * ∑ k, if i ≠ k ∧ j ≠ k then p k else 0 := by + rw [Finset.mul_sum] + apply Finset.sum_congr rfl + intro k _ + by_cases hjk : j = k + · subst k + simp + · by_cases hik : i = k + · subst k + simp [hji] + · simp [hji, hjk, hik, Ne.symm hjk, Ne.symm hik] + _ = p j * (1 - p i - p j) := by + rw [sum_away_from_two hp (Ne.symm hji)] + _ = if j ≠ i then p j * (1 - p i - p j) else 0 := by simp [hji] + +/-- The exact finite-sum identity behind the expected prefix--suffix moment. -/ +theorem sum_ordered_distinct_products + {n : ℕ} {p : Fin n → ℝ} (hp : IsProbabilityVector p) (i : Fin n) : + (∑ j, ∑ k, + if j ≠ i ∧ j ≠ k ∧ i ≠ k then p j * p k else 0) = + (1 - p i) ^ 2 - ((∑ j, (p j) ^ 2) - (p i) ^ 2) := by + classical + calc + (∑ j, ∑ k, + if j ≠ i ∧ j ≠ k ∧ i ≠ k then p j * p k else 0) = + ∑ j, if j ≠ i then p j * (1 - p i - p j) else 0 := by + apply Finset.sum_congr rfl + intro j _ + exact inner_ordered_distinct_products hp i j + _ = ∑ j, ((if j ≠ i then p j else 0) * (1 - p i) - + (if j ≠ i then (p j) ^ 2 else 0)) := by + apply Finset.sum_congr rfl + intro j _ + by_cases hji : j = i <;> simp [hji] <;> ring + _ = (∑ j, if j ≠ i then p j else 0) * (1 - p i) - + ∑ j, (if j ≠ i then (p j) ^ 2 else 0) := by + rw [Finset.sum_sub_distrib, Finset.sum_mul] + _ = ((∑ j, p j) - p i) * (1 - p i) - + ((∑ j, (p j) ^ 2) - (p i) ^ 2) := by + rw [sum_ite_ne_eq_sum_sub, sum_ite_ne_eq_sum_sub] + _ = (1 - p i) ^ 2 - ((∑ j, (p j) ^ 2) - (p i) ^ 2) := by + rw [hp.sum_eq_one] + ring + +/-- The expected product of the prefix and suffix masses at coordinate `i`. -/ +noncomputable def orderingMoment + {n : ℕ} (p : Fin n → ℝ) (i : Fin n) : ℝ := + uniformAverage (fun π : Equiv.Perm (Fin n) ↦ + (p i + strictLeftMass p π i) * (p i + strictRightMass p π i)) + +/-- Paper (31): the exact prefix--suffix moment identity. -/ +theorem orderingMoment_eq + {n : ℕ} {p : Fin n → ℝ} (hp : IsProbabilityVector p) (i : Fin n) : + orderingMoment p i = + (1 - ∑ j, (p j) ^ 2) / 6 + 2 / 3 * p i + 1 / 3 * (p i) ^ 2 := by + classical + calc + orderingMoment p i = uniformAverage (fun π : Equiv.Perm (Fin n) ↦ + p i + strictLeftMass p π i * strictRightMass p π i) := by + apply congrArg uniformAverage + funext π + exact prefix_mul_suffix_eq_self_add_crossing hp π i + _ = uniformAverage (fun _ : Equiv.Perm (Fin n) ↦ p i) + + uniformAverage (fun π : Equiv.Perm (Fin n) ↦ + strictLeftMass p π i * strictRightMass p π i) := + uniformAverage_add _ _ + _ = p i + (1 / 6) * ∑ j, ∑ k, + if j ≠ i ∧ j ≠ k ∧ i ≠ k then p j * p k else 0 := by + rw [uniformAverage_const, + average_strictLeftMass_mul_strictRightMass] + _ = p i + (1 / 6) * + ((1 - p i) ^ 2 - ((∑ j, (p j) ^ 2) - (p i) ^ 2)) := by + rw [sum_ordered_distinct_products hp] + _ = (1 - ∑ j, (p j) ^ 2) / 6 + + 2 / 3 * p i + 1 / 3 * (p i) ^ 2 := by ring + +/-- Jensen's inequality for the uniform average of logarithms. -/ +theorem uniformAverage_log_le_log_uniformAverage + {α : Type*} [Fintype α] [Nonempty α] + (f : α → ℝ) (hf : ∀ x, 0 < f x) : + uniformAverage (fun x ↦ Real.log (f x)) ≤ + Real.log (uniformAverage f) := by + let N : ℝ := Fintype.card α + have hN : 0 < N := by + simpa [N] using (Nat.cast_pos.mpr (Fintype.card_pos : 0 < Fintype.card α) : + (0 : ℝ) < Fintype.card α) + have hweights : ∑ _x : α, (1 / N : ℝ) = 1 := by + dsimp [N] + rw [Finset.sum_const, Finset.card_univ, nsmul_eq_mul] + field_simp + have h := strictConcaveOn_log_Ioi.concaveOn.le_map_sum + (t := Finset.univ) (w := fun _ : α ↦ (1 / N : ℝ)) (p := f) + (fun _ _ ↦ by positivity) hweights (fun x _ ↦ hf x) + calc + uniformAverage (fun x ↦ Real.log (f x)) = + ∑ x, (1 / N) • Real.log (f x) := by + rw [uniformAverage, div_eq_mul_inv, Finset.sum_mul] + apply Finset.sum_congr rfl + intro x _ + simp [N, smul_eq_mul] + ring + _ ≤ Real.log (∑ x, (1 / N) • f x) := h + _ = Real.log (uniformAverage f) := by + congr 1 + calc + (∑ x, (1 / N) • f x) = (1 / N) * ∑ x, f x := by + rw [Finset.mul_sum] + apply Finset.sum_congr rfl + intro x _ + simp [smul_eq_mul] + _ = uniformAverage f := by + simp [uniformAverage, N, div_eq_mul_inv] + ring + +theorem suffixMass_eq_self_add_strictRightMass + {n : ℕ} (p : Fin n → ℝ) (π : Equiv.Perm (Fin n)) (i : Fin n) : + suffixMass p π i = p i + strictRightMass p π i := by + classical + rw [suffixMass, strictRightMass] + calc + (∑ k, if π.symm i ≤ π.symm k then p k else 0) = + ∑ k, ((if k = i then p k else 0) + + (if π.symm i < π.symm k then p k else 0)) := by + apply Finset.sum_congr rfl + intro k _ + by_cases hki : k = i + · subst k + simp + · have hpos : π.symm i ≠ π.symm k := + π.symm.injective.ne (Ne.symm hki) + rcases lt_or_gt_of_ne hpos with hlt | hgt + · simp [hki, hlt, hlt.le] + · have hnot : ¬π.symm i < π.symm k := not_lt_of_ge hgt.le + simp [hki, hgt, not_le_of_gt hgt, hnot] + _ = (∑ k, if k = i then p k else 0) + + ∑ k, (if π.symm i < π.symm k then p k else 0) := by + rw [Finset.sum_add_distrib] + _ = p i + ∑ k, (if π.symm i < π.symm k then p k else 0) := by simp + +/-- Reverse an ordering by reversing its positions. -/ +def reverseOrdering {n : ℕ} (π : Equiv.Perm (Fin n)) : + Equiv.Perm (Fin n) := + Fin.revPerm.trans π + +/-- Left composition by a fixed permutation is a bijection on orderings. -/ +def permPreTransEquiv {n : ℕ} (τ : Equiv.Perm (Fin n)) : + Equiv.Perm (Fin n) ≃ Equiv.Perm (Fin n) where + toFun π := τ.trans π + invFun θ := τ.symm.trans θ + left_inv π := by + ext i + simp [Equiv.trans_apply] + right_inv θ := by + ext i + simp [Equiv.trans_apply] + +theorem uniformAverage_perm_preTrans + {n : ℕ} (f : Equiv.Perm (Fin n) → ℝ) + (τ : Equiv.Perm (Fin n)) : + uniformAverage (fun π : Equiv.Perm (Fin n) ↦ f (τ.trans π)) = + uniformAverage f := by + rw [uniformAverage, uniformAverage] + congr 1 + exact (permPreTransEquiv τ).sum_comp f + +theorem suffixMass_reverseOrdering + {n : ℕ} (p : Fin n → ℝ) (π : Equiv.Perm (Fin n)) (i : Fin n) : + suffixMass p (reverseOrdering π) i = p i + strictLeftMass p π i := by + classical + rw [suffixMass, strictLeftMass] + calc + (∑ k, if (reverseOrdering π).symm i ≤ + (reverseOrdering π).symm k then p k else 0) = + ∑ k, ((if k = i then p k else 0) + + (if π.symm k < π.symm i then p k else 0)) := by + apply Finset.sum_congr rfl + intro k _ + have hrev : (reverseOrdering π).symm i ≤ + (reverseOrdering π).symm k ↔ π.symm k ≤ π.symm i := by + simp [reverseOrdering, Equiv.trans_apply, Fin.rev_le_rev] + simp only [hrev] + by_cases hki : k = i + · subst k + simp + · have hpos : π.symm k ≠ π.symm i := π.symm.injective.ne hki + rcases lt_or_gt_of_ne hpos with hlt | hgt + · simp [hki, hlt, hlt.le] + · have hnot : ¬π.symm k < π.symm i := not_lt_of_ge hgt.le + simp [hki, hgt, not_le_of_gt hgt, hnot] + _ = (∑ k, if k = i then p k else 0) + + ∑ k, (if π.symm k < π.symm i then p k else 0) := by + rw [Finset.sum_add_distrib] + _ = p i + ∑ k, (if π.symm k < π.symm i then p k else 0) := by simp + +theorem average_log_suffix_reverseOrdering + {n : ℕ} (p : Fin n → ℝ) (i : Fin n) : + uniformAverage (fun π : Equiv.Perm (Fin n) ↦ + Real.log (suffixMass p (reverseOrdering π) i)) = + uniformAverage (fun π : Equiv.Perm (Fin n) ↦ + Real.log (suffixMass p π i)) := by + exact uniformAverage_perm_preTrans + (fun π : Equiv.Perm (Fin n) ↦ Real.log (suffixMass p π i)) + Fin.revPerm + +/-- Pairing an ordering with its reversal rewrites the suffix log as half the +logarithm of the prefix--suffix product. -/ +theorem average_log_suffix_symmetrized + {n : ℕ} {p : Fin n → ℝ} (hp : IsStrictProbabilityVector p) (i : Fin n) : + uniformAverage (fun π : Equiv.Perm (Fin n) ↦ + Real.log (suffixMass p π i)) = + (1 / 2) * uniformAverage (fun π : Equiv.Perm (Fin n) ↦ + Real.log ((p i + strictLeftMass p π i) * + (p i + strictRightMass p π i))) := by + have hprefix : uniformAverage (fun π : Equiv.Perm (Fin n) ↦ + Real.log (p i + strictLeftMass p π i)) = + uniformAverage (fun π : Equiv.Perm (Fin n) ↦ + Real.log (suffixMass p π i)) := by + calc + uniformAverage (fun π : Equiv.Perm (Fin n) ↦ + Real.log (p i + strictLeftMass p π i)) = + uniformAverage (fun π : Equiv.Perm (Fin n) ↦ + Real.log (suffixMass p (reverseOrdering π) i)) := by + apply congrArg uniformAverage + funext π + rw [suffixMass_reverseOrdering] + _ = uniformAverage (fun π : Equiv.Perm (Fin n) ↦ + Real.log (suffixMass p π i)) := + average_log_suffix_reverseOrdering p i + have hproduct : uniformAverage (fun π : Equiv.Perm (Fin n) ↦ + Real.log ((p i + strictLeftMass p π i) * + (p i + strictRightMass p π i))) = + uniformAverage (fun π : Equiv.Perm (Fin n) ↦ + Real.log (p i + strictLeftMass p π i)) + + uniformAverage (fun π : Equiv.Perm (Fin n) ↦ + Real.log (suffixMass p π i)) := by + calc + uniformAverage (fun π : Equiv.Perm (Fin n) ↦ + Real.log ((p i + strictLeftMass p π i) * + (p i + strictRightMass p π i))) = + uniformAverage (fun π : Equiv.Perm (Fin n) ↦ + Real.log (p i + strictLeftMass p π i) + + Real.log (suffixMass p π i)) := by + apply congrArg uniformAverage + funext π + rw [suffixMass_eq_self_add_strictRightMass] + exact Real.log_mul + (by + rw [← suffixMass_reverseOrdering] + exact (suffixMass_pos hp.1 (hp.2 i) _).ne') + (by + rw [← suffixMass_eq_self_add_strictRightMass] + exact (suffixMass_pos hp.1 (hp.2 i) _).ne') + _ = _ := uniformAverage_add _ _ + rw [hproduct, hprefix] + ring + +theorem average_log_suffix_le_half_log_orderingMoment + {n : ℕ} {p : Fin n → ℝ} (hp : IsStrictProbabilityVector p) (i : Fin n) : + uniformAverage (fun π : Equiv.Perm (Fin n) ↦ + Real.log (suffixMass p π i)) ≤ + (1 / 2) * Real.log (orderingMoment p i) := by + rw [average_log_suffix_symmetrized hp i] + apply mul_le_mul_of_nonneg_left _ (by norm_num) + exact uniformAverage_log_le_log_uniformAverage _ (fun π ↦ by + exact mul_pos + (by + rw [← suffixMass_reverseOrdering] + exact suffixMass_pos hp.1 (hp.2 i) _) + (by + rw [← suffixMass_eq_self_add_strictRightMass] + exact suffixMass_pos hp.1 (hp.2 i) _)) + +theorem uniformAverage_pos + {α : Type*} [Fintype α] [Nonempty α] + (f : α → ℝ) (hf : ∀ x, 0 < f x) : + 0 < uniformAverage f := by + rw [uniformAverage] + exact div_pos + (Finset.sum_pos (fun x _ ↦ hf x) Finset.univ_nonempty) + (by exact_mod_cast (Fintype.card_pos : 0 < Fintype.card α)) + +theorem orderingMoment_pos + {n : ℕ} {p : Fin n → ℝ} (hp : IsStrictProbabilityVector p) (i : Fin n) : + 0 < orderingMoment p i := by + apply uniformAverage_pos + intro π + exact mul_pos + (by + rw [← suffixMass_reverseOrdering] + exact suffixMass_pos hp.1 (hp.2 i) _) + (by + rw [← suffixMass_eq_self_add_strictRightMass] + exact suffixMass_pos hp.1 (hp.2 i) _) + +/-- The tangent inequality for `log` at `1/2`. -/ +theorem log_le_tangent_at_half {x : ℝ} (hx : 0 < x) : + Real.log x ≤ -Real.log 2 + 2 * x - 1 := by + have h := Real.log_le_sub_one_of_pos (mul_pos (by norm_num : (0 : ℝ) < 2) hx) + rw [Real.log_mul (by norm_num : (2 : ℝ) ≠ 0) hx.ne'] at h + linarith + +theorem rowT_le_moment_bound + {n : ℕ} {p : Fin n → ℝ} (hp : IsStrictProbabilityVector p) : + rowT p ≤ -1 / 2 * Real.log 2 + + ∑ i, p i * orderingMoment p i - 1 / 2 := by + calc + rowT p = ∑ i, p i * uniformAverage + (fun π : Equiv.Perm (Fin n) ↦ Real.log (suffixMass p π i)) := + rowT_eq_sum_mul_average_suffix p + _ ≤ ∑ i, p i * ((1 / 2) * Real.log (orderingMoment p i)) := by + apply Finset.sum_le_sum + intro i _ + exact mul_le_mul_of_nonneg_left + (average_log_suffix_le_half_log_orderingMoment hp i) + (hp.1.nonnegative i) + _ ≤ ∑ i, p i * ((1 / 2) * + (-Real.log 2 + 2 * orderingMoment p i - 1)) := by + apply Finset.sum_le_sum + intro i _ + apply mul_le_mul_of_nonneg_left _ (hp.1.nonnegative i) + apply mul_le_mul_of_nonneg_left _ (by norm_num) + exact log_le_tangent_at_half (orderingMoment_pos hp i) + _ = ∑ i, (-1 / 2 * Real.log 2 * p i + + p i * orderingMoment p i - 1 / 2 * p i) := by + apply Finset.sum_congr rfl + intro i _ + ring + _ = -1 / 2 * Real.log 2 + + ∑ i, p i * orderingMoment p i - 1 / 2 := by + rw [Finset.sum_sub_distrib, Finset.sum_add_distrib, + ← Finset.mul_sum, ← Finset.mul_sum, hp.1.sum_eq_one] + ring + +theorem sum_mul_orderingMoment_eq + {n : ℕ} {p : Fin n → ℝ} (hp : IsProbabilityVector p) : + (∑ i, p i * orderingMoment p i) = + 1 / 6 + 1 / 2 * (∑ i, (p i) ^ 2) + + 1 / 3 * (∑ i, (p i) ^ 3) := by + simp_rw [orderingMoment_eq hp] + calc + (∑ i, p i * + ((1 - ∑ j, p j ^ 2) / 6 + 2 / 3 * p i + 1 / 3 * p i ^ 2)) = + ∑ i, ((1 - ∑ j, p j ^ 2) / 6 * p i + + 2 / 3 * p i ^ 2 + 1 / 3 * p i ^ 3) := by + apply Finset.sum_congr rfl + intro i _ + ring + _ = (1 - ∑ j, p j ^ 2) / 6 * (∑ i, p i) + + 2 / 3 * (∑ i, p i ^ 2) + 1 / 3 * (∑ i, p i ^ 3) := by + rw [Finset.sum_add_distrib, Finset.sum_add_distrib, + ← Finset.mul_sum, ← Finset.mul_sum, ← Finset.mul_sum] + _ = 1 / 6 + 1 / 2 * (∑ i, p i ^ 2) + + 1 / 3 * (∑ i, p i ^ 3) := by + rw [hp.sum_eq_one] + ring + +/-- The symmetrization, exact moment, Jensen, and tangent estimates combined. -/ +theorem rowT_le_cubic_bound + {n : ℕ} {p : Fin n → ℝ} (hp : IsStrictProbabilityVector p) : + rowT p ≤ -1 / 2 * Real.log 2 - 1 / 3 + + 1 / 2 * (∑ i, (p i) ^ 2) + 1 / 3 * (∑ i, (p i) ^ 3) := by + calc + rowT p ≤ -1 / 2 * Real.log 2 + + ∑ i, p i * orderingMoment p i - 1 / 2 := + rowT_le_moment_bound hp + _ = -1 / 2 * Real.log 2 - 1 / 3 + + 1 / 2 * (∑ i, (p i) ^ 2) + 1 / 3 * (∑ i, (p i) ^ 3) := by + rw [sum_mul_orderingMoment_eq hp.1] + ring + +/-- The separable function `F` in paper (35). -/ +noncomputable def rowStabilityF (x : ℝ) : ℝ := + -(1 - x) * Real.log (1 - x) + x ^ 2 / 2 + x ^ 3 / 3 + +/-- The sharp value of the separable sum at a half--half vector. -/ +noncomputable def rowStabilityC : ℝ := + Real.log 2 + 1 / 3 + +/-- The ratio `h(x)=F(x)/x` used to identify the equality case. Only positive +arguments are used below. -/ +noncomputable def rowStabilityH (x : ℝ) : ℝ := + rowStabilityF x / x + +noncomputable def rowStabilityFPrime (x : ℝ) : ℝ := + Real.log (1 - x) + 1 + x + x ^ 2 + +noncomputable def rowStabilityHPrime (x : ℝ) : ℝ := + (Real.log (1 - x) + x + x ^ 2 / 2 + 2 * x ^ 3 / 3) / x ^ 2 + +theorem hasDerivAt_rowStabilityF + {x : ℝ} (hx : x < 1) : + HasDerivAt rowStabilityF (rowStabilityFPrime x) x := by + have hlinear : HasDerivAt (fun y : ℝ ↦ -(1 - y)) 1 x := by + convert! ((hasDerivAt_const x 1).sub (hasDerivAt_id x)).neg using 1 <;> ring + have hlog : HasDerivAt (fun y : ℝ ↦ Real.log (1 - y)) + (-1 / (1 - x)) x := by + simpa [Function.id_def] using + ((hasDerivAt_const x 1).sub (hasDerivAt_id x)).log + (by linarith : 1 - x ≠ 0) + have hsq : HasDerivAt (fun y : ℝ ↦ y ^ 2 / 2) x x := by + convert! (hasDerivAt_pow 2 x).div_const 2 using 1 <;> ring + have hcub : HasDerivAt (fun y : ℝ ↦ y ^ 3 / 3) (x ^ 2) x := by + convert! (hasDerivAt_pow 3 x).div_const 3 using 1 <;> ring + have h := (hlinear.mul hlog).add hsq |>.add hcub + unfold rowStabilityF rowStabilityFPrime + convert! h using 1 <;> + field_simp [show 1 - x ≠ 0 by linarith] <;> ring + +theorem hasDerivAt_rowStabilityH + {x : ℝ} (hx0 : 0 < x) (hx1 : x < 1) : + HasDerivAt rowStabilityH (rowStabilityHPrime x) x := by + have h := (hasDerivAt_rowStabilityF hx1).div (hasDerivAt_id x) hx0.ne' + simp only [Function.id_def] at h + unfold rowStabilityFPrime rowStabilityF at h + unfold rowStabilityH rowStabilityHPrime rowStabilityF + convert! h using 1 <;> field_simp [hx0.ne'] <;> ring + +/-- An explicit Taylor lower bound for `log(1-x)`. -/ +theorem log_one_sub_lower_eight + {x : ℝ} (hx0 : 0 ≤ x) (hx1 : x < 1) : + -(x + x ^ 2 / 2 + x ^ 3 / 3 + x ^ 4 / 4 + x ^ 5 / 5 + + x ^ 6 / 6 + x ^ 7 / 7 + x ^ 8 / 8) - x ^ 9 / (1 - x) ≤ + Real.log (1 - x) := by + have habs := Real.abs_log_sub_add_sum_range_le + (show |x| < 1 by simpa [abs_of_nonneg hx0]) 8 + have hneg := neg_le_of_abs_le habs + rw [abs_of_nonneg hx0] at hneg + norm_num [Finset.sum_range_succ] at hneg + nlinarith + +/-- On `[0,1/2]`, the numerator of `h'` has a uniform cubic lower bound. -/ +theorem rowStabilityHPrime_numerator_lower + {x : ℝ} (hx0 : 0 ≤ x) (hxHalf : x ≤ 1 / 2) : + x ^ 3 / 12 ≤ + Real.log (1 - x) + x + x ^ 2 / 2 + 2 * x ^ 3 / 3 := by + have hp (r : ℕ) : x ^ (3 + r) ≤ x ^ 3 * (1 / 2 : ℝ) ^ r := by + rw [pow_add] + exact mul_le_mul_of_nonneg_left + (pow_le_pow_left₀ hx0 hxHalf r) (pow_nonneg hx0 3) + have h4 : x ^ 4 ≤ x ^ 3 / 2 := by + simpa [div_eq_mul_inv] using hp 1 + have h5 : x ^ 5 ≤ x ^ 3 / 4 := by + convert hp 2 using 1 <;> norm_num <;> ring + have h6 : x ^ 6 ≤ x ^ 3 / 8 := by + convert hp 3 using 1 <;> norm_num <;> ring + have h7 : x ^ 7 ≤ x ^ 3 / 16 := by + convert hp 4 using 1 <;> norm_num <;> ring + have h8 : x ^ 8 ≤ x ^ 3 / 32 := by + convert hp 5 using 1 <;> norm_num <;> ring + have h9 : x ^ 9 ≤ x ^ 3 / 64 := by + convert hp 6 using 1 <;> norm_num <;> ring + have hden : 0 < 1 - x := by linarith + have hrem : x ^ 9 / (1 - x) ≤ x ^ 3 / 32 := by + rw [div_le_iff₀ hden] + have hs := mul_le_mul_of_nonneg_left + (show (1 / 2 : ℝ) ≤ 1 - x by linarith) (pow_nonneg hx0 3) + nlinarith + have hlog := log_one_sub_lower_eight hx0 (by linarith : x < 1) + have hneg : x ^ 4 / 4 + x ^ 5 / 5 + x ^ 6 / 6 + + x ^ 7 / 7 + x ^ 8 / 8 + x ^ 9 / (1 - x) ≤ x ^ 3 / 4 := by + nlinarith + nlinarith + +theorem rowStabilityHPrime_lower + {x : ℝ} (hx0 : 0 < x) (hxHalf : x ≤ 1 / 2) : + x / 12 ≤ rowStabilityHPrime x := by + have hnum := rowStabilityHPrime_numerator_lower hx0.le hxHalf + have hx2 : 0 < x ^ 2 := sq_pos_of_pos hx0 + calc + x / 12 = (x ^ 3 / 12) / x ^ 2 := by + field_simp [hx0.ne'] <;> ring + _ ≤ (Real.log (1 - x) + x + x ^ 2 / 2 + 2 * x ^ 3 / 3) / x ^ 2 := + (div_le_div_iff_of_pos_right hx2).2 hnum + _ = rowStabilityHPrime x := rfl + +theorem rowStabilityH_half : rowStabilityH (1 / 2) = rowStabilityC := by + rw [rowStabilityH, rowStabilityF, rowStabilityC] + have hhalf : (1 / 2 : ℝ) = (2 : ℝ)⁻¹ := by norm_num + rw [show (1 : ℝ) - 1 / 2 = 1 / 2 by norm_num, hhalf, Real.log_inv] + norm_num + ring + +theorem rowStabilityH_mono + {x y : ℝ} (hx0 : 0 < x) (hxy : x ≤ y) (hyHalf : y ≤ 1 / 2) : + rowStabilityH x ≤ rowStabilityH y := by + have hmono : MonotoneOn rowStabilityH (Set.Icc x y) := by + refine monotoneOn_of_hasDerivWithinAt_nonneg (convex_Icc x y) + (fun z hz ↦ (hasDerivAt_rowStabilityH + (by linarith [hz.1]) (by linarith [hz.2, hyHalf])).continuousAt.continuousWithinAt) + (fun z hz ↦ by + have hz' : z ∈ Set.Ioo x y := by simpa only [interior_Icc] using hz + exact (hasDerivAt_rowStabilityH + (by linarith [hz'.1]) (by linarith [hz'.2, hyHalf])).hasDerivWithinAt) + (fun z hz ↦ by + have hz' : z ∈ Set.Ioo x y := by simpa only [interior_Icc] using hz + have hprime := rowStabilityHPrime_lower (x := z) + (by linarith [hz'.1]) (by linarith [hz'.2, hyHalf]) + exact (show 0 ≤ z / 12 by linarith [hz'.1, hx0]).trans hprime) + exact hmono ⟨le_rfl, hxy⟩ ⟨hxy, le_rfl⟩ hxy + +/-- A concrete version of the paper's fixedValue `c₁`. -/ +theorem rowStabilityH_gap_to_half + {x : ℝ} (hxQuarter : 1 / 4 ≤ x) (hxHalf : x ≤ 1 / 2) : + (1 / 48) * (1 / 2 - x) ≤ rowStabilityC - rowStabilityH x := by + let corrected : ℝ → ℝ := fun z ↦ rowStabilityH z - z / 48 + have hmono : MonotoneOn corrected (Set.Icc x (1 / 2)) := by + refine monotoneOn_of_hasDerivWithinAt_nonneg (convex_Icc x (1 / 2)) + (fun z hz ↦ ((hasDerivAt_rowStabilityH + (by linarith [hz.1, hxQuarter]) (by linarith [hz.2])).sub + ((hasDerivAt_id z).div_const 48)).continuousAt.continuousWithinAt) + (fun z hz ↦ by + have hz' : z ∈ Set.Ioo x (1 / 2) := by simpa only [interior_Icc] using hz + exact ((hasDerivAt_rowStabilityH + (by linarith [hz'.1, hxQuarter]) (by linarith [hz'.2])).sub + ((hasDerivAt_id z).div_const 48)).hasDerivWithinAt) + (fun z hz ↦ by + have hz' : z ∈ Set.Ioo x (1 / 2) := by simpa only [interior_Icc] using hz + have hprime := rowStabilityHPrime_lower (x := z) + (by linarith [hz'.1, hxQuarter]) (by linarith [hz'.2]) + change 0 ≤ rowStabilityHPrime z - 1 / 48 + calc + 0 ≤ z / 12 - 1 / 48 := by + linarith [show (1 / 4 : ℝ) ≤ z by linarith [hz'.1, hxQuarter]] + _ ≤ rowStabilityHPrime z - 1 / 48 := sub_le_sub_right hprime _) + have h := hmono ⟨le_rfl, hxHalf⟩ ⟨hxHalf, le_rfl⟩ hxHalf + dsimp [corrected] at h + rw [rowStabilityH_half] at h + linarith + +/-- A concrete version of the paper's fixedValue `c₂`. -/ +theorem rowStabilityH_half_argument_gap + {x : ℝ} (hxQuarter : 1 / 4 ≤ x) (hxHalf : x ≤ 1 / 2) : + (1 / 1536 : ℝ) ≤ rowStabilityH x - rowStabilityH (x / 2) := by + let corrected : ℝ → ℝ := fun z ↦ rowStabilityH z - z / 96 + have hx2pos : 0 < x / 2 := by linarith + have hmono : MonotoneOn corrected (Set.Icc (x / 2) x) := by + refine monotoneOn_of_hasDerivWithinAt_nonneg (convex_Icc (x / 2) x) + (fun z hz ↦ ((hasDerivAt_rowStabilityH + (by linarith [hz.1, hxQuarter]) (by linarith [hz.2, hxHalf])).sub + ((hasDerivAt_id z).div_const 96)).continuousAt.continuousWithinAt) + (fun z hz ↦ by + have hz' : z ∈ Set.Ioo (x / 2) x := by simpa only [interior_Icc] using hz + exact ((hasDerivAt_rowStabilityH + (by linarith [hz'.1, hxQuarter]) + (by linarith [hz'.2, hxHalf])).sub + ((hasDerivAt_id z).div_const 96)).hasDerivWithinAt) + (fun z hz ↦ by + have hz' : z ∈ Set.Ioo (x / 2) x := by simpa only [interior_Icc] using hz + have hprime := rowStabilityHPrime_lower (x := z) + (by linarith [hz'.1, hxQuarter]) (by linarith [hz'.2, hxHalf]) + change 0 ≤ rowStabilityHPrime z - 1 / 96 + calc + 0 ≤ z / 12 - 1 / 96 := by + linarith [show (1 / 8 : ℝ) ≤ z by linarith [hz'.1, hxQuarter]] + _ ≤ rowStabilityHPrime z - 1 / 96 := sub_le_sub_right hprime _) + have h := hmono ⟨le_rfl, by linarith [hx2pos]⟩ + ⟨by linarith [hx2pos], le_rfl⟩ (by linarith [hx2pos]) + dsimp [corrected] at h + linarith [hxQuarter] + +/-- Two indices attaining respectively the largest and second-largest +coordinates of a finite vector. -/ +theorem exists_two_largest_coordinates + {n : ℕ} (hn : 2 ≤ n) (p : Fin n → ℝ) : + ∃ a b : Fin n, a ≠ b ∧ + (∀ j, p j ≤ p a) ∧ (∀ j, j ≠ a → p j ≤ p b) := by + classical + have huniv : (Finset.univ : Finset (Fin n)).Nonempty := by + exact ⟨⟨0, by omega⟩, Finset.mem_univ _⟩ + obtain ⟨a, _, ha⟩ := Finset.exists_max_image Finset.univ p huniv + have hcard : 1 < Fintype.card (Fin n) := by + simpa only [Fintype.card_fin] using (show 1 < n by omega) + obtain ⟨c, hca⟩ := Fintype.exists_ne_of_one_lt_card hcard a + have herase : (Finset.univ.erase a : Finset (Fin n)).Nonempty := + ⟨c, Finset.mem_erase.mpr ⟨hca, Finset.mem_univ c⟩⟩ + obtain ⟨b, hbmem, hb⟩ := + Finset.exists_max_image (Finset.univ.erase a) p herase + refine ⟨a, b, ?_, fun j ↦ ha j (Finset.mem_univ j), ?_⟩ + · exact (Finset.mem_erase.mp hbmem).1.symm + · intro j hja + exact hb j (Finset.mem_erase.mpr ⟨hja, Finset.mem_univ j⟩) + +/-- The half--half vector supported on two distinct coordinates. -/ +noncomputable def halfHalfVector + {n : ℕ} (a b : Fin n) (j : Fin n) : ℝ := + if j = a ∨ j = b then 1 / 2 else 0 + +noncomputable def halfHalfL1Distance + {n : ℕ} (p : Fin n → ℝ) (a b : Fin n) : ℝ := + ∑ j, |p j - halfHalfVector a b j| + +/-- Exact decomposition of the distance into the two distinguished-coordinate +errors and the mass outside them. -/ +theorem halfHalfL1Distance_eq + {n : ℕ} {p : Fin n → ℝ} (hp : IsProbabilityVector p) + {a b : Fin n} (hab : a ≠ b) : + halfHalfL1Distance p a b = + |p a - 1 / 2| + |p b - 1 / 2| + (1 - p a - p b) := by + classical + rw [halfHalfL1Distance] + calc + (∑ j, |p j - halfHalfVector a b j|) = + ∑ j, ((if j = a then |p a - 1 / 2| else 0) + + (if j = b then |p b - 1 / 2| else 0) + + (if j ≠ a ∧ j ≠ b then p j else 0)) := by + apply Finset.sum_congr rfl + intro j _ + by_cases hja : j = a + · subst j + simp [halfHalfVector, hab] + · by_cases hjb : j = b + · subst j + simp [halfHalfVector, hja] + · simp [halfHalfVector, hja, hjb, + abs_of_nonneg (hp.nonnegative j)] + _ = |p a - 1 / 2| + |p b - 1 / 2| + + ∑ j, (if j ≠ a ∧ j ≠ b then p j else 0) := by + rw [Finset.sum_add_distrib, Finset.sum_add_distrib] + simp + _ = |p a - 1 / 2| + |p b - 1 / 2| + (1 - p a - p b) := by + congr 1 + have htail : (∑ j, if j ≠ a ∧ j ≠ b then p j else 0) = + ∑ j, if a ≠ j ∧ b ≠ j then p j else 0 := by + apply Finset.sum_congr rfl + intro j _ + by_cases hja : j = a + · subst j; simp + · by_cases hjb : j = b + · subst j; simp + · simp [hja, hjb, Ne.symm hja, Ne.symm hjb] + rw [htail, sum_away_from_two hp hab] + +theorem halfHalfL1Distance_of_below_half + {n : ℕ} {p : Fin n → ℝ} (hp : IsProbabilityVector p) + {a b : Fin n} (hab : a ≠ b) + (ha0 : 0 ≤ p a) (hb0 : 0 ≤ p b) + (haHalf : p a ≤ 1 / 2) (hbHalf : p b ≤ 1 / 2) : + halfHalfL1Distance p a b = 2 * (1 - p a - p b) := by + classical + rw [halfHalfL1Distance] + calc + (∑ j, |p j - halfHalfVector a b j|) = + ∑ j, ((if j = a then 1 / 2 - p a else 0) + + (if j = b then 1 / 2 - p b else 0) + + (if j ≠ a ∧ j ≠ b then p j else 0)) := by + apply Finset.sum_congr rfl + intro j _ + by_cases hja : j = a + · subst j + have hsign : p a - (2 : ℝ)⁻¹ ≤ 0 := by + norm_num at haHalf ⊢ + exact haHalf + simp [halfHalfVector, hab, abs_of_nonpos hsign] + · by_cases hjb : j = b + · subst j + have hsign : p b - (2 : ℝ)⁻¹ ≤ 0 := by + norm_num at hbHalf ⊢ + exact hbHalf + simp [halfHalfVector, hja, abs_of_nonpos hsign] + · simp [halfHalfVector, hja, hjb, abs_of_nonneg (hp.nonnegative j)] + _ = (∑ j, if j = a then 1 / 2 - p a else 0) + + (∑ j, if j = b then 1 / 2 - p b else 0) + + ∑ j, (if j ≠ a ∧ j ≠ b then p j else 0) := by + rw [Finset.sum_add_distrib, Finset.sum_add_distrib] + _ = 2 * (1 - p a - p b) := by + have htail : (∑ j, if j ≠ a ∧ j ≠ b then p j else 0) = + ∑ j, if a ≠ j ∧ b ≠ j then p j else 0 := by + apply Finset.sum_congr rfl + intro j _ + by_cases hja : j = a + · subst j + simp + · by_cases hjb : j = b + · subst j + simp + · simp [hja, hjb, Ne.symm hja, Ne.symm hjb] + rw [htail, sum_away_from_two hp hab] + simp + ring + +theorem halfHalfL1Distance_of_above_half + {n : ℕ} {p : Fin n → ℝ} (hp : IsProbabilityVector p) + {a b : Fin n} (hab : a ≠ b) + (haHalf : 1 / 2 ≤ p a) (hb0 : 0 ≤ p b) (hbHalf : p b ≤ 1 / 2) : + halfHalfL1Distance p a b = + 2 * (p a - 1 / 2) + 2 * (1 - p a - p b) := by + classical + rw [halfHalfL1Distance] + calc + (∑ j, |p j - halfHalfVector a b j|) = + ∑ j, ((if j = a then p a - 1 / 2 else 0) + + (if j = b then 1 / 2 - p b else 0) + + (if j ≠ a ∧ j ≠ b then p j else 0)) := by + apply Finset.sum_congr rfl + intro j _ + by_cases hja : j = a + · subst j + have hsign : 0 ≤ p a - (2 : ℝ)⁻¹ := by + norm_num at haHalf ⊢ + exact haHalf + simp [halfHalfVector, hab, abs_of_nonneg hsign] + · by_cases hjb : j = b + · subst j + have hsign : p b - (2 : ℝ)⁻¹ ≤ 0 := by + norm_num at hbHalf ⊢ + exact hbHalf + simp [halfHalfVector, hja, abs_of_nonpos hsign] + · simp [halfHalfVector, hja, hjb, abs_of_nonneg (hp.nonnegative j)] + _ = (∑ j, if j = a then p a - 1 / 2 else 0) + + (∑ j, if j = b then 1 / 2 - p b else 0) + + ∑ j, (if j ≠ a ∧ j ≠ b then p j else 0) := by + rw [Finset.sum_add_distrib, Finset.sum_add_distrib] + _ = 2 * (p a - 1 / 2) + 2 * (1 - p a - p b) := by + have htail : (∑ j, if j ≠ a ∧ j ≠ b then p j else 0) = + ∑ j, if a ≠ j ∧ b ≠ j then p j else 0 := by + apply Finset.sum_congr rfl + intro j _ + by_cases hja : j = a + · subst j + simp + · by_cases hjb : j = b + · subst j + simp + · simp [hja, hjb, Ne.symm hja, Ne.symm hjb] + rw [htail, sum_away_from_two hp hab] + simp + ring + +/-- A fourth root expressed using square roots, convenient for ordered-real +reasoning. -/ +noncomputable def fourthRoot (x : ℝ) : ℝ := + Real.sqrt (Real.sqrt x) + +theorem fourthRoot_nonneg (x : ℝ) : 0 ≤ fourthRoot x := + Real.sqrt_nonneg _ + +theorem le_fourthRoot_of_pow_four_le + {x d : ℝ} (hx : 0 ≤ x) (hd : 0 ≤ d) (hpow : x ^ 4 ≤ d) : + x ≤ fourthRoot d := by + have hx2 : 0 ≤ x ^ 2 := sq_nonneg x + have hxsq : x ^ 2 ≤ Real.sqrt d := by + rw [Real.le_sqrt hx2 hd] + convert hpow using 1 <;> ring + rw [fourthRoot, Real.le_sqrt hx (Real.sqrt_nonneg d)] + exact hxsq + +theorem self_le_fourthRoot + {d : ℝ} (hd0 : 0 ≤ d) (hd1 : d ≤ 1) : + d ≤ fourthRoot d := by + apply le_fourthRoot_of_pow_four_le hd0 hd0 + have hd2 : d ^ 2 ≤ d := by nlinarith + nlinarith [sq_nonneg (d ^ 2 - d)] + +theorem sum_rowStabilityF_eq + {n : ℕ} (p : Fin n → ℝ) : + (∑ i, rowStabilityF (p i)) = + -(∑ i, (1 - p i) * Real.log (1 - p i)) + + 1 / 2 * (∑ i, (p i) ^ 2) + + 1 / 3 * (∑ i, (p i) ^ 3) := by + simp only [rowStabilityF] + calc + (∑ i, (-(1 - p i) * Real.log (1 - p i) + + p i ^ 2 / 2 + p i ^ 3 / 3)) = + ∑ i, (-(1 - p i) * Real.log (1 - p i) + + 1 / 2 * p i ^ 2 + 1 / 3 * p i ^ 3) := by + apply Finset.sum_congr rfl + intro i _ + ring + _ = -(∑ i, (1 - p i) * Real.log (1 - p i)) + + 1 / 2 * (∑ i, p i ^ 2) + 1 / 3 * (∑ i, p i ^ 3) := by + simp_rw [neg_mul] + rw [Finset.sum_add_distrib, Finset.sum_add_distrib, + Finset.sum_neg_distrib, ← Finset.mul_sum, ← Finset.mul_sum] + +theorem rowStabilityF_eq_mul_H {x : ℝ} (hx : 0 < x) : + rowStabilityF x = x * rowStabilityH x := by + rw [rowStabilityH] + field_simp [hx.ne'] + +/-- The separable defect is the average, under `p`, of the coordinate gaps +`C-h(p_i)`. -/ +theorem separableDefect_eq_sum_gap + {n : ℕ} {p : Fin n → ℝ} (hp : IsStrictProbabilityVector p) : + rowStabilityC - ∑ i, rowStabilityF (p i) = + ∑ i, p i * (rowStabilityC - rowStabilityH (p i)) := by + have hF : (∑ i, rowStabilityF (p i)) = + ∑ i, p i * rowStabilityH (p i) := by + apply Finset.sum_congr rfl + intro i _ + exact rowStabilityF_eq_mul_H (hp.2 i) + calc + rowStabilityC - ∑ i, rowStabilityF (p i) = + rowStabilityC * (∑ i, p i) - + ∑ i, p i * rowStabilityH (p i) := by + rw [hF, hp.1.sum_eq_one] + ring + _ = ∑ i, p i * (rowStabilityC - rowStabilityH (p i)) := by + rw [Finset.mul_sum, ← Finset.sum_sub_distrib] + apply Finset.sum_congr rfl + intro i _ + ring + +noncomputable def tailSeparableDefect + {n : ℕ} (p : Fin n → ℝ) (a : Fin n) : ℝ := + rowStabilityF (1 - p a) - + ∑ j, if j ≠ a then rowStabilityF (p j) else 0 + +theorem separableDefect_eq_head_add_tail + {n : ℕ} (p : Fin n → ℝ) (a : Fin n) : + rowStabilityC - ∑ i, rowStabilityF (p i) = + (rowStabilityC - rowStabilityF (p a) - rowStabilityF (1 - p a)) + + tailSeparableDefect p a := by + rw [tailSeparableDefect, sum_ite_ne_eq_sum_sub] + ring + +theorem tailSeparableDefect_eq_sum_gap + {n : ℕ} {p : Fin n → ℝ} (hp : IsStrictProbabilityVector p) + {a b : Fin n} (hab : a ≠ b) : + tailSeparableDefect p a = + ∑ j, if j ≠ a then + p j * (rowStabilityH (1 - p a) - rowStabilityH (p j)) else 0 := by + have hpa1 : p a < 1 := by + have hbpos := hp.2 b + have hbmem : b ∈ (Finset.univ.erase a : Finset (Fin n)) := + Finset.mem_erase.mpr ⟨Ne.symm hab, Finset.mem_univ b⟩ + have hb_le : p b ≤ ∑ j ∈ Finset.univ.erase a, p j := + Finset.single_le_sum (fun j _ ↦ hp.1.nonnegative j) hbmem + have htotal := Finset.sum_erase_add (s := Finset.univ) (f := p) + (Finset.mem_univ a) + rw [hp.1.sum_eq_one] at htotal + linarith + have htailSum : (∑ j, if j ≠ a then p j else 0) = 1 - p a := by + rw [sum_ite_ne_eq_sum_sub, hp.1.sum_eq_one] + rw [tailSeparableDefect, rowStabilityF_eq_mul_H (sub_pos.mpr hpa1)] + have hFtail : (∑ j, if j ≠ a then rowStabilityF (p j) else 0) = + ∑ j, if j ≠ a then p j * rowStabilityH (p j) else 0 := by + apply Finset.sum_congr rfl + intro j _ + by_cases hja : j = a + · simp [hja] + · simpa [hja] using rowStabilityF_eq_mul_H (hp.2 j) + rw [hFtail, ← htailSum, Finset.sum_mul, ← Finset.sum_sub_distrib] + apply Finset.sum_congr rfl + intro j _ + by_cases hja : j = a <;> simp [hja] <;> ring + +/-- Paper (34): the row deficit dominates a separable defect. -/ +theorem rowDeficit_ge_separable + {n : ℕ} {p : Fin n → ℝ} (hp : IsStrictProbabilityVector p) : + rowStabilityC - ∑ i, rowStabilityF (p i) ≤ rowDeficit p := by + have hT := rowT_le_cubic_bound hp + rw [rowDeficit, rowCorrection] + rw [sum_rowStabilityF_eq] + unfold rowStabilityC + linarith + +/-- In the variable `u = 2a-1`, this is the separable row defect +`C-F(a)-F(1-a)` from the proof of paper Lemma 8. -/ +noncomputable def bernoulliExcess (u : ℝ) : ℝ := + (1 + u) / 2 * Real.log (1 + u) + + (1 - u) / 2 * Real.log (1 - u) - u ^ 2 / 2 + +theorem hasDerivAt_bernoulliExcess + {u : ℝ} (huLeft : -1 < u) (huRight : u < 1) : + HasDerivAt bernoulliExcess + (1 / 2 * Real.log ((1 + u) / (1 - u)) - u) u := by + have hp : HasDerivAt (fun x : ℝ ↦ (1 + x) / 2) (1 / 2) u := by + convert! ((hasDerivAt_const u 1).add (hasDerivAt_id u)).div_const 2 using 1 <;> + ring + have hm : HasDerivAt (fun x : ℝ ↦ (1 - x) / 2) (-1 / 2) u := by + convert! ((hasDerivAt_const u 1).sub (hasDerivAt_id u)).div_const 2 using 1 <;> + ring + have hlp : HasDerivAt (fun x : ℝ ↦ Real.log (1 + x)) + (1 / (1 + u)) u := by + convert! ((hasDerivAt_const u 1).add (hasDerivAt_id u)).log (by + simpa using (show (1 : ℝ) + u ≠ 0 by linarith)) using 1 <;> + simp + have hlm : HasDerivAt (fun x : ℝ ↦ Real.log (1 - x)) + (-1 / (1 - u)) u := by + convert! ((hasDerivAt_const u 1).sub (hasDerivAt_id u)).log (by + simpa using (show (1 : ℝ) - u ≠ 0 by linarith)) using 1 <;> + simp + have hsq : HasDerivAt (fun x : ℝ ↦ x ^ 2 / 2) u u := by + convert! (hasDerivAt_pow 2 u).div_const 2 using 1 <;> ring + have h := (hp.mul hlp).add (hm.mul hlm) |>.sub hsq + unfold bernoulliExcess + convert! h using 1 + rw [Real.log_div (by linarith : 1 + u ≠ 0) (by linarith : 1 - u ≠ 0)] + field_simp [(show 1 + u ≠ 0 by linarith), + (show 1 - u ≠ 0 by linarith)] <;> ring + +/-- The first two terms in the power series for `artanh`. -/ +theorem one_add_cube_third_le_artanh + {u : ℝ} (hu0 : 0 ≤ u) (hu1 : u < 1) : + u + u ^ 3 / 3 ≤ Real.artanh u := by + have hseries := Real.sum_range_le_log_div hu0 hu1 2 + rw [← Real.artanh_eq_half_log (by exact ⟨by linarith, hu1.le⟩)] at hseries + norm_num [Finset.sum_range_succ] at hseries ⊢ + simpa [pow_succ] using hseries + +noncomputable def correctedBernoulliExcess (u : ℝ) : ℝ := + bernoulliExcess u - u ^ 4 / 12 + +theorem hasDerivAt_correctedBernoulliExcess + {u : ℝ} (huLeft : -1 < u) (huRight : u < 1) : + HasDerivAt correctedBernoulliExcess + (Real.artanh u - u - u ^ 3 / 3) u := by + have hpow : HasDerivAt (fun x : ℝ ↦ x ^ 4 / 12) (u ^ 3 / 3) u := by + convert! (hasDerivAt_pow 4 u).div_const 12 using 1 <;> ring + have h := (hasDerivAt_bernoulliExcess huLeft huRight).sub hpow + unfold correctedBernoulliExcess + convert! h using 1 + rw [Real.artanh_eq_half_log (by exact ⟨huLeft.le, huRight.le⟩)] + +/-- Quartic separation from the half--half equality case, paper (37). -/ +theorem bernoulliExcess_quartic + {u : ℝ} (hu0 : 0 ≤ u) (hu1 : u < 1) : + u ^ 4 / 12 ≤ bernoulliExcess u := by + have hmono : MonotoneOn correctedBernoulliExcess (Set.Icc 0 u) := by + refine monotoneOn_of_hasDerivWithinAt_nonneg (convex_Icc 0 u) + (fun y hy ↦ (hasDerivAt_correctedBernoulliExcess + (by linarith [hy.1]) (by linarith [hy.2])).continuousAt.continuousWithinAt) + (fun y hy ↦ by + have hy' : y ∈ Set.Ioo 0 u := by + simpa only [interior_Icc] using hy + exact (hasDerivAt_correctedBernoulliExcess + (by linarith [hy'.1]) (by linarith [hy'.2, hu1])).hasDerivWithinAt) + (fun y hy ↦ by + have hy' : y ∈ Set.Ioo 0 u := by + simpa only [interior_Icc] using hy + have hy0 : 0 ≤ y := by + exact hy'.1.le + have hy1 : y < 1 := by + have := hy'.2 + linarith + linarith [one_add_cube_third_le_artanh hy0 hy1]) + have h := hmono (show 0 ∈ Set.Icc (0 : ℝ) u by exact ⟨le_rfl, hu0⟩) + (show u ∈ Set.Icc (0 : ℝ) u by exact ⟨hu0, le_rfl⟩) hu0 + simpa [correctedBernoulliExcess, bernoulliExcess] using h + +theorem row_defect_eq_bernoulliExcess + {a : ℝ} (ha0 : 0 < a) (ha1 : a < 1) : + rowStabilityC - rowStabilityF a - rowStabilityF (1 - a) = + bernoulliExcess (2 * a - 1) := by + have h1a : 0 < 1 - a := sub_pos.mpr ha1 + have hplus : 1 + (2 * a - 1) = 2 * a := by ring + have hminus : 1 - (2 * a - 1) = 2 * (1 - a) := by ring + rw [rowStabilityC, rowStabilityF, rowStabilityF, bernoulliExcess, + hplus, hminus, + Real.log_mul (by norm_num : (2 : ℝ) ≠ 0) ha0.ne', + Real.log_mul (by norm_num : (2 : ℝ) ≠ 0) h1a.ne'] + ring + +/-- Paper (37), in the original largest-coordinate variable. -/ +theorem row_defect_quartic + {a : ℝ} (haHalf : 1 / 2 ≤ a) (ha1 : a < 1) : + 4 / 3 * (a - 1 / 2) ^ 4 ≤ + rowStabilityC - rowStabilityF a - rowStabilityF (1 - a) := by + have ha0 : 0 < a := by linarith + have hu0 : 0 ≤ 2 * a - 1 := by linarith + have hu1 : 2 * a - 1 < 1 := by linarith + rw [row_defect_eq_bernoulliExcess ha0 ha1] + have h := bernoulliExcess_quartic hu0 hu1 + convert h using 1 <;> ring + +theorem halfHalfVector_nonnegative + {n : ℕ} (a b j : Fin n) : 0 ≤ halfHalfVector a b j := by + rw [halfHalfVector] + split_ifs <;> norm_num + +theorem sum_halfHalfVector + {n : ℕ} {a b : Fin n} (hab : a ≠ b) : + (∑ j, halfHalfVector a b j) = 1 := by + classical + simp only [halfHalfVector] + have hrewrite : + (∑ j : Fin n, if j = a ∨ j = b then (1 / 2 : ℝ) else 0) = + ∑ j : Fin n, ((if j = a then (1 / 2 : ℝ) else 0) + + (if j = b then (1 / 2 : ℝ) else 0)) := by + apply Finset.sum_congr rfl + intro j _ + by_cases hja : j = a + · subst j + simp [hab] + · by_cases hjb : j = b <;> simp [hja, hjb, Ne.symm hab] + rw [hrewrite, Finset.sum_add_distrib] + norm_num + +/-- The total-variation diameter of the probability simplex, specialized to +the half--half comparison vector. -/ +theorem halfHalfL1Distance_le_two + {n : ℕ} {p : Fin n → ℝ} (hp : IsProbabilityVector p) + {a b : Fin n} (hab : a ≠ b) : + halfHalfL1Distance p a b ≤ 2 := by + rw [halfHalfL1Distance] + calc + (∑ j, |p j - halfHalfVector a b j|) ≤ + ∑ j, (p j + halfHalfVector a b j) := by + apply Finset.sum_le_sum + intro j _ + calc + |p j - halfHalfVector a b j| ≤ + |p j| + |halfHalfVector a b j| := + abs_sub (p j) (halfHalfVector a b j) + _ = p j + halfHalfVector a b j := by + rw [abs_of_nonneg (hp.nonnegative j), + abs_of_nonneg (halfHalfVector_nonnegative a b j)] + _ = 2 := by + rw [Finset.sum_add_distrib, hp.sum_eq_one, sum_halfHalfVector hab] + norm_num + +theorem rowStabilityH_gap_nonnegative + {x : ℝ} (hx0 : 0 < x) (hxHalf : x ≤ 1 / 2) : + 0 ≤ rowStabilityC - rowStabilityH x := by + rw [← rowStabilityH_half] + exact sub_nonneg.mpr (rowStabilityH_mono hx0 hxHalf le_rfl) + +/-- Coordinates below `1/4` pay a fixed per-unit-mass separable cost. -/ +theorem rowStabilityH_gap_of_lt_quarter + {x : ℝ} (hx0 : 0 < x) (hxQuarter : x < 1 / 4) : + (1 / 192 : ℝ) ≤ rowStabilityC - rowStabilityH x := by + have hmono := rowStabilityH_mono hx0 hxQuarter.le + (show (1 / 4 : ℝ) ≤ 1 / 2 by norm_num) + have hgap := rowStabilityH_gap_to_half + (x := (1 / 4 : ℝ)) le_rfl (by norm_num) + norm_num at hgap + linarith + +theorem separableDefect_nonnegative_of_le_half + {n : ℕ} {p : Fin n → ℝ} (hp : IsStrictProbabilityVector p) + (hhalf : ∀ i, p i ≤ 1 / 2) : + 0 ≤ rowStabilityC - ∑ i, rowStabilityF (p i) := by + rw [separableDefect_eq_sum_gap hp] + exact Finset.sum_nonneg (fun i _ ↦ + mul_nonneg (hp.1.nonnegative i) + (rowStabilityH_gap_nonnegative (hp.2 i) (hhalf i))) + +theorem separableDefect_ge_of_max_lt_quarter + {n : ℕ} {p : Fin n → ℝ} (hp : IsStrictProbabilityVector p) + {a : Fin n} (hmax : ∀ j, p j ≤ p a) (haQuarter : p a < 1 / 4) : + (1 / 192 : ℝ) ≤ rowStabilityC - ∑ i, rowStabilityF (p i) := by + rw [separableDefect_eq_sum_gap hp] + calc + (1 / 192 : ℝ) = ∑ i, p i / 192 := by + rw [← Finset.sum_div, hp.1.sum_eq_one] + _ ≤ ∑ i, p i * (rowStabilityC - rowStabilityH (p i)) := by + apply Finset.sum_le_sum + intro i _ + have hgap := rowStabilityH_gap_of_lt_quarter (hp.2 i) + (lt_of_le_of_lt (hmax i) haQuarter) + have hmul := mul_le_mul_of_nonneg_left hgap (hp.1.nonnegative i) + nlinarith + +theorem separableDefect_ge_tail_below_quarter + {n : ℕ} {p : Fin n → ℝ} (hp : IsStrictProbabilityVector p) + {a b : Fin n} (hsecond : ∀ j, j ≠ a → p j ≤ p b) + (haHalf : p a ≤ 1 / 2) (hbQuarter : p b < 1 / 4) : + (1 - p a) / 192 ≤ rowStabilityC - ∑ i, rowStabilityF (p i) := by + rw [separableDefect_eq_sum_gap hp] + calc + (1 - p a) / 192 = ∑ i, if i ≠ a then p i / 192 else 0 := by + have hsum : (∑ i, if i ≠ a then p i else 0) = 1 - p a := by + rw [sum_ite_ne_eq_sum_sub, hp.1.sum_eq_one] + calc + (1 - p a) / 192 = + (∑ i, if i ≠ a then p i else 0) / 192 := by rw [hsum] + _ = ∑ i, (if i ≠ a then p i else 0) / 192 := by + simpa using (Finset.sum_div Finset.univ + (fun i : Fin n ↦ if i ≠ a then p i else 0) (192 : ℝ)) + _ = ∑ i, if i ≠ a then p i / 192 else 0 := by + apply Finset.sum_congr rfl + intro i _ + by_cases hia : i = a <;> simp [hia] + _ ≤ ∑ i, p i * (rowStabilityC - rowStabilityH (p i)) := by + apply Finset.sum_le_sum + intro i _ + by_cases hia : i = a + · simp only [hia, ne_eq, not_true_eq_false, if_false] + exact mul_nonneg (hp.1.nonnegative a) + (rowStabilityH_gap_nonnegative (hp.2 a) haHalf) + · have hgap := rowStabilityH_gap_of_lt_quarter (hp.2 i) + (lt_of_le_of_lt (hsecond i hia) hbQuarter) + have hmul := mul_le_mul_of_nonneg_left hgap (hp.1.nonnegative i) + simpa [hia, div_eq_mul_inv] using hmul + +theorem separableDefect_ge_two_coordinates + {n : ℕ} {p : Fin n → ℝ} (hp : IsStrictProbabilityVector p) + {a b : Fin n} (hab : a ≠ b) (hhalf : ∀ i, p i ≤ 1 / 2) + (haQuarter : 1 / 4 ≤ p a) (hbQuarter : 1 / 4 ≤ p b) : + (1 / 192 : ℝ) * (1 - p a - p b) ≤ + rowStabilityC - ∑ i, rowStabilityF (p i) := by + let f : Fin n → ℝ := fun i ↦ + p i * (rowStabilityC - rowStabilityH (p i)) + have hfnon : ∀ i, 0 ≤ f i := fun i ↦ + mul_nonneg (hp.1.nonnegative i) + (rowStabilityH_gap_nonnegative (hp.2 i) (hhalf i)) + have hcoord : ∀ {i : Fin n}, 1 / 4 ≤ p i → + (1 / 192 : ℝ) * (1 / 2 - p i) ≤ f i := by + intro i hiQuarter + have hgap := rowStabilityH_gap_to_half hiQuarter (hhalf i) + calc + (1 / 192 : ℝ) * (1 / 2 - p i) = + (1 / 4) * ((1 / 48) * (1 / 2 - p i)) := by ring + _ ≤ p i * ((1 / 48) * (1 / 2 - p i)) := + mul_le_mul_of_nonneg_right hiQuarter + (mul_nonneg (by norm_num) (sub_nonneg.mpr (hhalf i))) + _ ≤ p i * (rowStabilityC - rowStabilityH (p i)) := + mul_le_mul_of_nonneg_left hgap (hp.1.nonnegative i) + _ = f i := rfl + have hbmem : b ∈ (Finset.univ.erase a : Finset (Fin n)) := + Finset.mem_erase.mpr ⟨Ne.symm hab, Finset.mem_univ b⟩ + have hb_le : f b ≤ ∑ i ∈ Finset.univ.erase a, f i := + Finset.single_le_sum (fun i _ ↦ hfnon i) hbmem + have hdecomp := Finset.sum_erase_add (s := Finset.univ) (f := f) + (Finset.mem_univ a) + rw [separableDefect_eq_sum_gap hp] + change (1 / 192 : ℝ) * (1 - p a - p b) ≤ ∑ i, f i + have haLower := hcoord haQuarter + have hbLower := hcoord hbQuarter + nlinarith + +/-- Quantitative stability when the largest coordinate is at most `1/2`. +The small-deficit hypothesis forces the two largest coordinates into the +interval `[1/4,1/2]`, where the explicit linear gap estimate applies. -/ +theorem below_half_distance_le_rowDeficit + {n : ℕ} {p : Fin n → ℝ} (hp : IsStrictProbabilityVector p) + {a b : Fin n} (hab : a ≠ b) + (hmax : ∀ j, p j ≤ p a) (hsecond : ∀ j, j ≠ a → p j ≤ p b) + (haHalf : p a ≤ 1 / 2) + (hsep : rowStabilityC - ∑ i, rowStabilityF (p i) ≤ rowDeficit p) + (hdsmall : rowDeficit p < 1 / 768) : + halfHalfL1Distance p a b ≤ 384 * rowDeficit p := by + have hhalf : ∀ i, p i ≤ 1 / 2 := fun i ↦ (hmax i).trans haHalf + have haQuarter : 1 / 4 ≤ p a := by + by_contra h + have hcost := separableDefect_ge_of_max_lt_quarter hp hmax + (lt_of_not_ge h) + linarith + have hbQuarter : 1 / 4 ≤ p b := by + by_contra h + have hcost := separableDefect_ge_tail_below_quarter hp hsecond haHalf + (lt_of_not_ge h) + have htail : 1 / 2 ≤ 1 - p a := by linarith + linarith + have hcost := separableDefect_ge_two_coordinates hp hab hhalf + haQuarter hbQuarter + rw [halfHalfL1Distance_of_below_half hp.1 hab + (hp.1.nonnegative a) (hp.1.nonnegative b) haHalf (hhalf b)] + nlinarith + +theorem coordinate_le_complement + {n : ℕ} {p : Fin n → ℝ} (hp : IsProbabilityVector p) + {a j : Fin n} (hja : j ≠ a) : p j ≤ 1 - p a := by + have hjmem : j ∈ (Finset.univ.erase a : Finset (Fin n)) := + Finset.mem_erase.mpr ⟨hja, Finset.mem_univ j⟩ + have hjle : p j ≤ ∑ k ∈ Finset.univ.erase a, p k := + Finset.single_le_sum (fun k _ ↦ hp.nonnegative k) hjmem + have htotal := Finset.sum_erase_add (s := Finset.univ) (f := p) + (Finset.mem_univ a) + rw [hp.sum_eq_one] at htotal + linarith + +theorem tailSeparableDefect_nonnegative + {n : ℕ} {p : Fin n → ℝ} (hp : IsStrictProbabilityVector p) + {a b : Fin n} (hab : a ≠ b) (haHalf : 1 / 2 ≤ p a) : + 0 ≤ tailSeparableDefect p a := by + rw [tailSeparableDefect_eq_sum_gap hp hab] + apply Finset.sum_nonneg + intro j _ + by_cases hja : j = a + · simp [hja] + · have hmono := rowStabilityH_mono (hp.2 j) + (coordinate_le_complement hp.1 hja) + (show 1 - p a ≤ 1 / 2 by linarith) + simpa [hja] using + mul_nonneg (hp.1.nonnegative j) (sub_nonneg.mpr hmono) + +theorem coordinate_le_outside_two + {n : ℕ} {p : Fin n → ℝ} (hp : IsProbabilityVector p) + {a b j : Fin n} (hab : a ≠ b) (hja : j ≠ a) (hjb : j ≠ b) : + p j ≤ 1 - p a - p b := by + have hterm : p j = if a ≠ j ∧ b ≠ j then p j else 0 := by + simp [Ne.symm hja, Ne.symm hjb] + rw [hterm, ← sum_away_from_two hp hab] + exact Finset.single_le_sum + (f := fun k ↦ if a ≠ k ∧ b ≠ k then p k else 0) + (fun k _ ↦ by + by_cases h : a ≠ k ∧ b ≠ k <;> simp [h, hp.nonnegative k]) + (Finset.mem_univ j) + +/-- If the largest coordinate exceeds `1/2`, the tail's separable defect +controls the mass outside the two largest coordinates. -/ +theorem tailSeparableDefect_ge_second_gap + {n : ℕ} {p : Fin n → ℝ} (hp : IsStrictProbabilityVector p) + {a b : Fin n} (hab : a ≠ b) + (hsecond : ∀ j, j ≠ a → p j ≤ p b) + (haHalf : 1 / 2 ≤ p a) (hqQuarter : 1 / 4 ≤ 1 - p a) : + (1 - p a - p b) / 1536 ≤ tailSeparableDefect p a := by + have hqHalf : 1 - p a ≤ 1 / 2 := by linarith + have hgapHalf := rowStabilityH_half_argument_gap hqQuarter hqHalf + rw [tailSeparableDefect_eq_sum_gap hp hab] + by_cases hcase : 1 - p a - p b ≤ (1 - p a) / 2 + · calc + (1 - p a - p b) / 1536 = + ∑ j, if j ≠ a ∧ j ≠ b then p j / 1536 else 0 := by + have hout : (∑ j, if a ≠ j ∧ b ≠ j then p j else 0) = + 1 - p a - p b := sum_away_from_two hp.1 hab + have horient : (∑ j, if j ≠ a ∧ j ≠ b then p j else 0) = + 1 - p a - p b := by + calc + (∑ j, if j ≠ a ∧ j ≠ b then p j else 0) = + ∑ j, if a ≠ j ∧ b ≠ j then p j else 0 := by + apply Finset.sum_congr rfl + intro j _ + by_cases hja : j = a + · subst j; simp + · by_cases hjb : j = b + · subst j; simp + · simp [hja, hjb, Ne.symm hja, Ne.symm hjb] + _ = 1 - p a - p b := hout + calc + (1 - p a - p b) / 1536 = + (∑ j, if j ≠ a ∧ j ≠ b then p j else 0) / 1536 := by + rw [horient] + _ = ∑ j, (if j ≠ a ∧ j ≠ b then p j else 0) / 1536 := by + simpa using (Finset.sum_div Finset.univ + (fun j : Fin n ↦ if j ≠ a ∧ j ≠ b then p j else 0) (1536 : ℝ)) + _ = ∑ j, if j ≠ a ∧ j ≠ b then p j / 1536 else 0 := by + apply Finset.sum_congr rfl + intro j _ + by_cases h : j ≠ a ∧ j ≠ b <;> simp [h] + _ ≤ ∑ j, if j ≠ a then + p j * (rowStabilityH (1 - p a) - rowStabilityH (p j)) else 0 := by + apply Finset.sum_le_sum + intro j _ + by_cases hja : j = a + · simp [hja] + · by_cases hjb : j = b + · subst j + have hble := coordinate_le_complement hp.1 (Ne.symm hab) + have hmono := rowStabilityH_mono (hp.2 b) hble hqHalf + simpa [Ne.symm hab] using + mul_nonneg (hp.1.nonnegative b) (sub_nonneg.mpr hmono) + · have hpjHalf : p j ≤ (1 - p a) / 2 := + (coordinate_le_outside_two hp.1 hab hja hjb).trans hcase + have hmono := rowStabilityH_mono (hp.2 j) hpjHalf + (show (1 - p a) / 2 ≤ 1 / 2 by linarith) + have hgap : (1 / 1536 : ℝ) ≤ + rowStabilityH (1 - p a) - rowStabilityH (p j) := by + linarith + have hmul := mul_le_mul_of_nonneg_left hgap (hp.1.nonnegative j) + simpa [hja, hjb, div_eq_mul_inv] using hmul + · have htailMass : + (∑ j, if j ≠ a then p j else 0) = 1 - p a := by + rw [sum_ite_ne_eq_sum_sub, hp.1.sum_eq_one] + have hsumLower : (1 - p a) / 1536 ≤ + ∑ j, if j ≠ a then + p j * (rowStabilityH (1 - p a) - rowStabilityH (p j)) else 0 := by + calc + (1 - p a) / 1536 = + ∑ j, if j ≠ a then p j / 1536 else 0 := by + calc + (1 - p a) / 1536 = + (∑ j, if j ≠ a then p j else 0) / 1536 := by + rw [htailMass] + _ = ∑ j, (if j ≠ a then p j else 0) / 1536 := by + simpa using (Finset.sum_div Finset.univ + (fun j : Fin n ↦ if j ≠ a then p j else 0) (1536 : ℝ)) + _ = ∑ j, if j ≠ a then p j / 1536 else 0 := by + apply Finset.sum_congr rfl + intro j _ + by_cases hja : j = a <;> simp [hja] + _ ≤ ∑ j, if j ≠ a then + p j * (rowStabilityH (1 - p a) - rowStabilityH (p j)) else 0 := by + apply Finset.sum_le_sum + intro j _ + by_cases hja : j = a + · simp [hja] + · have hpbHalf : p b ≤ (1 - p a) / 2 := by + have hpb0 := hp.1.nonnegative b + have := lt_of_not_ge hcase + linarith + have hpjHalf := (hsecond j hja).trans hpbHalf + have hmono := rowStabilityH_mono (hp.2 j) hpjHalf + (show (1 - p a) / 2 ≤ 1 / 2 by linarith) + have hgap : (1 / 1536 : ℝ) ≤ + rowStabilityH (1 - p a) - rowStabilityH (p j) := by + linarith + have hmul := mul_le_mul_of_nonneg_left hgap (hp.1.nonnegative j) + simpa [hja, div_eq_mul_inv] using hmul + have htail_ge : 1 - p a - p b ≤ 1 - p a := by + linarith [hp.1.nonnegative b] + linarith + +/-- Quantitative stability when the largest coordinate is at least `1/2`. +The quartic head gap controls its displacement from `1/2`, while the linear +tail gap controls the mass outside the two largest coordinates. -/ +theorem above_half_distance_le_rowDeficit + {n : ℕ} {p : Fin n → ℝ} (hp : IsStrictProbabilityVector p) + {a b : Fin n} (hab : a ≠ b) + (hsecond : ∀ j, j ≠ a → p j ≤ p b) + (haHalf : 1 / 2 ≤ p a) + (hsep : rowStabilityC - ∑ i, rowStabilityF (p i) ≤ rowDeficit p) + (hdsmall : rowDeficit p < 1 / 768) : + halfHalfL1Distance p a b ≤ + 2 * fourthRoot (rowDeficit p) + 3072 * rowDeficit p := by + have hpbq := coordinate_le_complement hp.1 (Ne.symm hab) + have hpa1 : p a < 1 := by linarith [hp.2 b] + have htailNonneg := tailSeparableDefect_nonnegative hp hab haHalf + have hdecomp := separableDefect_eq_head_add_tail p a + have hquart := row_defect_quartic haHalf hpa1 + have hhead_le : 4 / 3 * (p a - 1 / 2) ^ 4 ≤ + rowStabilityC - ∑ i, rowStabilityF (p i) := by + linarith + have hqQuarter : 1 / 4 ≤ 1 - p a := by + by_contra h + have hx : (1 / 4 : ℝ) ≤ p a - 1 / 2 := by + linarith [lt_of_not_ge h] + have hpow : (1 / 4 : ℝ) ^ 4 ≤ (p a - 1 / 2) ^ 4 := + pow_le_pow_left₀ (by norm_num) hx 4 + norm_num at hpow + linarith + have htailGap := tailSeparableDefect_ge_second_gap hp hab hsecond + haHalf hqQuarter + have htail_le : tailSeparableDefect p a ≤ + rowStabilityC - ∑ i, rowStabilityF (p i) := by + have hhead0 : 0 ≤ 4 / 3 * (p a - 1 / 2) ^ 4 := + mul_nonneg (by norm_num) (pow_nonneg (by linarith) 4) + linarith + have houtside : 1 - p a - p b ≤ 1536 * rowDeficit p := by + linarith + have hpowD : (p a - 1 / 2) ^ 4 ≤ rowDeficit p := by + have hxnon : 0 ≤ (p a - 1 / 2) ^ 4 := pow_nonneg (by linarith) 4 + nlinarith + have hd0 : 0 ≤ rowDeficit p := + (pow_nonneg (by linarith : 0 ≤ p a - 1 / 2) 4).trans hpowD + have hroot : p a - 1 / 2 ≤ fourthRoot (rowDeficit p) := + le_fourthRoot_of_pow_four_le (by linarith) hd0 hpowD + have hbHalf : p b ≤ 1 / 2 := hpbq.trans (by linarith) + rw [halfHalfL1Distance_of_above_half hp.1 hab haHalf + (hp.1.nonnegative b) hbHalf] + linarith + +/-- A fully explicit, strict-support version of paper Lemma 8. The sharp +one-row inequality is kept as an explicit argument for modularity and is +proved in `SourceAnariRezaeiList`; all stability and compactness arguments are +discharged here with the concrete fixedValue `3074`. Strict support is exactly +the case used for rows of the Gibbs marginal matrix associated with a positive +input matrix. -/ +theorem row_stability_explicit + (hrow : AnariRezaeiRowInequality) + {n : ℕ} (hn : 2 ≤ n) (p : Fin n → ℝ) + (hp : IsStrictProbabilityVector p) : + ∃ a b : Fin n, a ≠ b ∧ + halfHalfL1Distance p a b ≤ 3074 * fourthRoot (rowDeficit p) := by + obtain ⟨a, b, hab, hmax, hsecond⟩ := exists_two_largest_coordinates hn p + refine ⟨a, b, hab, ?_⟩ + have hd0 : 0 ≤ rowDeficit p := hrow hn p hp.1 + have hsep := rowDeficit_ge_separable hp + by_cases hdsmall : rowDeficit p < 1 / 768 + · have hd1 : rowDeficit p ≤ 1 := by linarith + have hdroot := self_le_fourthRoot hd0 hd1 + by_cases haHalf : p a ≤ 1 / 2 + · have hdist := below_half_distance_le_rowDeficit hp hab hmax hsecond + haHalf hsep hdsmall + nlinarith [fourthRoot_nonneg (rowDeficit p)] + · have hdist := above_half_distance_le_rowDeficit hp hab hsecond + (le_of_not_ge haHalf) hsep hdsmall + nlinarith [fourthRoot_nonneg (rowDeficit p)] + · have hdist := halfHalfL1Distance_le_two hp.1 hab + have hdlarge : 1 / 768 ≤ rowDeficit p := le_of_not_gt hdsmall + by_cases hd1 : rowDeficit p ≤ 1 + · have hdroot := self_le_fourthRoot hd0 hd1 + nlinarith + · have hone : (1 : ℝ) ≤ fourthRoot (rowDeficit p) := by + apply le_fourthRoot_of_pow_four_le (by norm_num) hd0 + norm_num + exact le_of_not_ge hd1 + nlinarith + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/ScannedBetheBisection.lean b/LeanPool/BeyondBethe/BeyondBethe/ScannedBetheBisection.lean new file mode 100644 index 0000000000..f83cdba1de --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/ScannedBetheBisection.lean @@ -0,0 +1,366 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.ScannedBetheThresholdFeasibility +import LeanPool.BeyondBethe.BeyondBethe.BetheBisection +import Mathlib.Tactic + +/-! +# Rational bisection for the row-major Bethe oracle + +The earlier semantic bisection permits a different choice among violated +floor constraints. This file follows the implemented row-major oracle +exactly. Its proof uses only validity and acceptance of that oracle, so the +optimization guarantee is unchanged even though the returned rational point +need not be byte-for-byte equal to the earlier runner's point. +-/ + +namespace BeyondBethe + +def scannedBetheBisectionStep {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (p : ℕ) (delta : RawRat) (r : ℚ) + (s : BetheBisectionState (m * m + 1)) : + BetheBisectionState (m * m + 1) := + let mid := (s.low + s.high) / 2 + match runExplicitScannedBetheThresholdFeasibility + tau A p delta (rawRatOfRat mid) r with + | .accepted q => ⟨s.low, mid, some q⟩ + | .exhausted _ => ⟨mid, s.high, s.witness⟩ + +def runScannedBetheBisection {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (p : ℕ) (delta : RawRat) (r : ℚ) : + ℕ → BetheBisectionState (m * m + 1) → + BetheBisectionState (m * m + 1) + | 0, s => s + | N + 1, s => runScannedBetheBisection tau A p delta r N + (scannedBetheBisectionStep tau A p delta r s) + +def initialScannedBetheBisectionState {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (p : ℕ) (delta : RawRat) (mix r : ℚ) : + BetheBisectionState (m * m + 1) := + let high := betheBisectionInitialHigh A mix r + match runExplicitScannedBetheThresholdFeasibility + tau A p delta (rawRatOfRat high) r with + | .accepted q => ⟨betheNegativeObjectiveLower m, high, some q⟩ + | .exhausted _ => ⟨betheNegativeObjectiveLower m, high, none⟩ + +@[simp] theorem initialScannedBetheBisectionState_low {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (p : ℕ) (delta : RawRat) (mix r : ℚ) : + (initialScannedBetheBisectionState tau A p delta mix r).low = + betheNegativeObjectiveLower m := by + rw [initialScannedBetheBisectionState] + split <;> rfl + +@[simp] theorem initialScannedBetheBisectionState_high {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (p : ℕ) (delta : RawRat) (mix r : ℚ) : + (initialScannedBetheBisectionState tau A p delta mix r).high = + betheBisectionInitialHigh A mix r := by + rw [initialScannedBetheBisectionState] + split <;> rfl + +def ScannedBetheBisectionWitnessValid {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (p : ℕ) (delta : RawRat) (r : ℚ) + (s : BetheBisectionState (m * m + 1)) : Prop := + ∀ q, s.witness = some q → + runExplicitScannedBetheThresholdFeasibility + tau A p delta (rawRatOfRat s.high) r = .accepted q ∧ + BetheEpigraphOracleAccepted tau A p delta.value s.high q + +theorem initialScannedBetheBisectionState_witnessValid {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (p : ℕ) (delta : RawRat) (mix r : ℚ) : + ScannedBetheBisectionWitnessValid tau A p delta r + (initialScannedBetheBisectionState tau A p delta mix r) := by + intro q hq + rw [initialScannedBetheBisectionState] at hq ⊢ + split at hq <;> rename_i hrun + · cases hq + refine ⟨hrun, ?_⟩ + simpa only [rawRatOfRat_value] using + runExplicitScannedBetheThresholdFeasibility_acceptsOnly + tau A p delta _ r hrun + · contradiction + +theorem scannedBetheBisectionStep_witnessValid {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (p : ℕ) (delta : RawRat) (r : ℚ) + {s : BetheBisectionState (m * m + 1)} + (hs : ScannedBetheBisectionWitnessValid tau A p delta r s) : + ScannedBetheBisectionWitnessValid tau A p delta r + (scannedBetheBisectionStep tau A p delta r s) := by + intro q hq + rw [scannedBetheBisectionStep] at hq ⊢ + split at hq <;> rename_i hrun + · cases hq + refine ⟨hrun, ?_⟩ + simpa only [rawRatOfRat_value] using + runExplicitScannedBetheThresholdFeasibility_acceptsOnly + tau A p delta _ r hrun + · exact hs q hq + +theorem runScannedBetheBisection_witnessValid {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (p : ℕ) (delta : RawRat) (r : ℚ) + {s : BetheBisectionState (m * m + 1)} + (hs : ScannedBetheBisectionWitnessValid tau A p delta r s) (N : ℕ) : + ScannedBetheBisectionWitnessValid tau A p delta r + (runScannedBetheBisection tau A p delta r N s) := by + induction N generalizing s with + | zero => simpa [runScannedBetheBisection] using hs + | succ N ih => + rw [runScannedBetheBisection] + exact ih (scannedBetheBisectionStep_witnessValid tau A p delta r hs) + +theorem scannedBetheBisectionStep_width {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (p : ℕ) (delta : RawRat) (r : ℚ) + (s : BetheBisectionState (m * m + 1)) : + (scannedBetheBisectionStep tau A p delta r s).high - + (scannedBetheBisectionStep tau A p delta r s).low = + (s.high - s.low) / 2 := by + rw [scannedBetheBisectionStep] + split <;> ring + +theorem runScannedBetheBisection_width {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (p : ℕ) (delta : RawRat) (r : ℚ) (N : ℕ) + (s : BetheBisectionState (m * m + 1)) : + (runScannedBetheBisection tau A p delta r N s).high - + (runScannedBetheBisection tau A p delta r N s).low = + (s.high - s.low) / 2 ^ N := by + induction N generalizing s with + | zero => simp [runScannedBetheBisection] + | succ N ih => + rw [runScannedBetheBisection, ih, scannedBetheBisectionStep_width] + rw [pow_succ] + ring + +theorem scannedBetheBisectionStep_low_le_cutoff {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (p : ℕ) (delta : RawRat) (r : ℚ) {cutoff : ℝ} + (hbelow : ∀ (u : ℚ) (E : RationalEllipsoidState (m * m + 1)), + runExplicitScannedBetheThresholdFeasibility + tau A p delta (rawRatOfRat u) r = .exhausted E → + (u : ℝ) < cutoff) + {s : BetheBisectionState (m * m + 1)} + (hlow : (s.low : ℝ) ≤ cutoff) : + ((scannedBetheBisectionStep tau A p delta r s).low : ℚ) ≤ + cutoff := by + rw [scannedBetheBisectionStep] + split <;> rename_i hrun + · exact hlow + · exact (hbelow _ _ hrun).le + +theorem runScannedBetheBisection_low_le_cutoff {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (p : ℕ) (delta : RawRat) (r : ℚ) {cutoff : ℝ} + (hbelow : ∀ (u : ℚ) (E : RationalEllipsoidState (m * m + 1)), + runExplicitScannedBetheThresholdFeasibility + tau A p delta (rawRatOfRat u) r = .exhausted E → + (u : ℝ) < cutoff) + {s : BetheBisectionState (m * m + 1)} + (hlow : (s.low : ℝ) ≤ cutoff) (N : ℕ) : + (((runScannedBetheBisection tau A p delta r N s).low : ℚ) : ℝ) ≤ + cutoff := by + induction N generalizing s with + | zero => simpa [runScannedBetheBisection] using hlow + | succ N ih => + rw [runScannedBetheBisection] + exact ih (scannedBetheBisectionStep_low_le_cutoff + tau A p delta r hbelow hlow) + +theorem runScannedBetheBisection_preserves_some {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (p : ℕ) (delta : RawRat) (r : ℚ) + {s : BetheBisectionState (m * m + 1)} + (hsome : ∃ q, s.witness = some q) (N : ℕ) : + ∃ q, (runScannedBetheBisection tau A p delta r N s).witness = some q := by + induction N generalizing s with + | zero => simpa [runScannedBetheBisection] using hsome + | succ N ih => + rw [runScannedBetheBisection] + apply ih + rw [scannedBetheBisectionStep] + split + · rename_i q hrun + exact ⟨q, rfl⟩ + · exact hsome + +theorem initialScannedBetheBisectionState_has_witness_of_optimizer + {m : ℕ} (hm : 0 < m) {tau : ℚ} (htau0 : 0 < tau) + (htau1 : tau ≤ 1) + {A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ} + (hApos : ∀ i j, 0 < A i j) (hAupper : ∀ i j, A i j ≤ 1) + {X : Matrix (Fin (m + 1)) (Fin (m + 1)) ℝ} + (hX : IsDoublyStochastic X) + (hmax : ∀ Y, IsDoublyStochastic Y → + regularizedBetheObjective (tau : ℝ) + (fun i j ↦ (A i j : ℝ)) Y ≤ + regularizedBetheObjective (tau : ℝ) + (fun i j ↦ (A i j : ℝ)) X) + {mix r : ℚ} {delta : RawRat} + (hmix0 : 0 < mix) (hmix1 : mix ≤ 1) + (hdelta : 0 < delta.value) (hr : 0 < r) + (hspike : r / mix ≤ 1 / (m + 1 : ℚ)) + (hfloor : delta.value ≤ (1 - mix) * + numericalInteriorFloor (m + 1) (rationalMatrixEntryBitBound A) tau) + (p : ℕ) : + ∃ q, (initialScannedBetheBisectionState + tau A p delta mix r).witness = some q := by + have hupper := (negativeObjective_mem_initial_interval htau0.le htau1 + hApos hAupper hX).2 + have hthreshold : + -regularizedBetheObjective (tau : ℝ) + (fun i j ↦ (A i j : ℝ)) X + + (mix : ℝ) * (rationalRegularizedObjectiveRange A : ℝ) + + 2 * (r : ℝ) ≤ (betheBisectionInitialHigh A mix r : ℝ) := by + rw [betheBisectionInitialHigh, betheSmoothingSlack] + push_cast + linarith + have hthreshold' : + -regularizedBetheObjective (tau : ℝ) + (fun i j ↦ (A i j : ℝ)) X + + (mix : ℝ) * (rationalRegularizedObjectiveRange A : ℝ) + + 2 * (r : ℝ) ≤ + ((rawRatOfRat (betheBisectionInitialHigh A mix r)).value : ℝ) := by + simpa only [rawRatOfRat_value] using hthreshold + obtain ⟨q, hrun, _⟩ := + runExplicitScannedBetheThresholdFeasibility_accepts_of_slack + (upper := rawRatOfRat (betheBisectionInitialHigh A mix r)) + hm htau0 htau1 hApos hAupper hX hmax hmix0 hmix1 hdelta hr + hspike hfloor hthreshold' p + refine ⟨q, ?_⟩ + rw [initialScannedBetheBisectionState, hrun] + +theorem runScannedBetheBisection_objective_gap + {m : ℕ} (hm : 0 < m) {tau : ℚ} (htau0 : 0 < tau) + (htau1 : tau ≤ 1) + {A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ} + (hApos : ∀ i j, 0 < A i j) (hAupper : ∀ i j, A i j ≤ 1) + {X : Matrix (Fin (m + 1)) (Fin (m + 1)) ℝ} + (hX : IsDoublyStochastic X) + (hmax : ∀ Y, IsDoublyStochastic Y → + regularizedBetheObjective (tau : ℝ) + (fun i j ↦ (A i j : ℝ)) Y ≤ + regularizedBetheObjective (tau : ℝ) + (fun i j ↦ (A i j : ℝ)) X) + {mix r : ℚ} {delta : RawRat} + (hmix0 : 0 < mix) (hmix1 : mix ≤ 1) + (hdelta : 0 < delta.value) (hr : 0 < r) + (hspike : r / mix ≤ 1 / (m + 1 : ℚ)) + (hfloor : delta.value ≤ (1 - mix) * + numericalInteriorFloor (m + 1) (rationalMatrixEntryBitBound A) tau) + (p N : ℕ) : + let s0 := initialScannedBetheBisectionState tau A p delta mix r + let sN := runScannedBetheBisection tau A p delta r N s0 + ∃ q : Fin (m * m + 1) → ℚ, + sN.witness = some q ∧ + BetheEpigraphOracleAccepted tau A p delta.value sN.high q ∧ + IsDoublyStochastic (acceptedBetheMatrix q) ∧ + (∀ i j, (delta.value : ℝ) ≤ acceptedBetheMatrix q i j) ∧ + regularizedBetheObjective (tau : ℝ) + (fun i j ↦ (A i j : ℝ)) X - + regularizedBetheObjective (tau : ℝ) + (fun i j ↦ (A i j : ℝ)) (acceptedBetheMatrix q) ≤ + (betheSmoothingSlack A mix r : ℝ) + + (((betheBisectionInitialHigh A mix r - + betheNegativeObjectiveLower m) / 2 ^ N : ℚ) : ℝ) + + (betheObjectiveEvaluationError m p : ℝ) := by + dsimp only + let s0 := initialScannedBetheBisectionState tau A p delta mix r + let sN := runScannedBetheBisection tau A p delta r N s0 + have hsome0 : ∃ q, s0.witness = some q := by + simpa only [s0] using + initialScannedBetheBisectionState_has_witness_of_optimizer + hm htau0 htau1 hApos hAupper hX hmax hmix0 hmix1 hdelta hr + hspike hfloor p + obtain ⟨q, hq⟩ := runScannedBetheBisection_preserves_some + tau A p delta r hsome0 N + have hqN : sN.witness = some q := by simpa only [sN] using hq + have hvalid0 := initialScannedBetheBisectionState_witnessValid + tau A p delta mix r + have hvalidN := runScannedBetheBisection_witnessValid + tau A p delta r hvalid0 N + have hcertificate : + BetheEpigraphOracleAccepted tau A p delta.value sN.high q := + (hvalidN q (by simpa only [sN] using hqN)).2 + have hbounds := negativeObjective_mem_initial_interval htau0.le htau1 + hApos hAupper hX + let cutoff : ℝ := + -regularizedBetheObjective (tau : ℝ) + (fun i j ↦ (A i j : ℝ)) X + + (betheSmoothingSlack A mix r : ℝ) + have hslack0 : 0 ≤ betheSmoothingSlack A mix r := by + rw [betheSmoothingSlack] + exact add_nonneg + (mul_nonneg hmix0.le (rationalRegularizedObjectiveRange_nonneg A)) + (mul_nonneg (by norm_num) hr.le) + have hlow0 : (s0.low : ℝ) ≤ cutoff := by + rw [show s0.low = betheNegativeObjectiveLower m by + simp only [s0, initialScannedBetheBisectionState_low]] + dsimp only [cutoff] + have hslack0R : 0 ≤ (betheSmoothingSlack A mix r : ℝ) := + Rat.cast_nonneg.mpr hslack0 + linarith [hbounds.1] + have hbelow : ∀ (u : ℚ) (E : RationalEllipsoidState (m * m + 1)), + runExplicitScannedBetheThresholdFeasibility + tau A p delta (rawRatOfRat u) r = .exhausted E → + (u : ℝ) < cutoff := by + intro u E hrun + have h := + runExplicitScannedBetheThresholdFeasibility_exhausted_lt_optimum_add_slack + hm htau0 htau1 hApos hAupper hX hmax hmix0 hmix1 hdelta hr + hspike hfloor p hrun + dsimp only [cutoff] + rw [betheSmoothingSlack] + push_cast + simpa [add_assoc] using h + have hlowN : (sN.low : ℝ) ≤ cutoff := by + simpa only [sN] using runScannedBetheBisection_low_le_cutoff + tau A p delta r hbelow hlow0 N + have hwidthQ := runScannedBetheBisection_width tau A p delta r N s0 + have hwidth : (sN.high : ℝ) - (sN.low : ℝ) = + (((betheBisectionInitialHigh A mix r - + betheNegativeObjectiveLower m) / 2 ^ N : ℚ) : ℝ) := by + have hwidthQ' : sN.high - sN.low = + (betheBisectionInitialHigh A mix r - + betheNegativeObjectiveLower m) / 2 ^ N := by + simpa only [sN, s0, initialScannedBetheBisectionState_high, + initialScannedBetheBisectionState_low] using hwidthQ + exact_mod_cast hwidthQ' + have hhigh : (sN.high : ℝ) ≤ cutoff + + (((betheBisectionInitialHigh A mix r - + betheNegativeObjectiveLower m) / 2 ^ N : ℚ) : ℝ) := by + linarith + have hobjective := + BetheEpigraphOracleAccepted_exact_objective_upper_compact + hm htau0.le htau1 hApos hdelta hcertificate + have hheight : ((epigraphHeight q : ℚ) : ℝ) ≤ (sN.high : ℝ) := by + exact_mod_cast hcertificate.2.1 + have hreturned : + -regularizedBetheObjective (tau : ℝ) + (fun i j ↦ (A i j : ℝ)) (acceptedBetheMatrix q) ≤ + (sN.high : ℝ) + (betheObjectiveEvaluationError m p : ℝ) := by + have hobjective' : + -regularizedBetheObjective (tau : ℝ) + (fun i j ↦ (A i j : ℝ)) (acceptedBetheMatrix q) ≤ + ((epigraphHeight q : ℚ) : ℝ) + + (betheObjectiveEvaluationError m p : ℝ) := by + simpa only [affineNegativeObjective, acceptedBetheMatrix] using hobjective + linarith + refine ⟨q, hqN, hcertificate, + BetheEpigraphOracleAccepted_doublyStochastic hdelta.le hcertificate, + BetheEpigraphOracleAccepted_entry_floor hcertificate, ?_⟩ + dsimp only [cutoff] at hhigh + linarith + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/ScannedBetheThresholdFeasibility.lean b/LeanPool/BeyondBethe/BeyondBethe/ScannedBetheThresholdFeasibility.lean new file mode 100644 index 0000000000..1917afb45b --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/ScannedBetheThresholdFeasibility.lean @@ -0,0 +1,169 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.MachineBetheEpigraphOracle +import LeanPool.BeyondBethe.BeyondBethe.ExplicitScheduledFeasibility +import Mathlib.Tactic + +/-! # Scanned Bethe Threshold Feasibility -/ + +namespace BeyondBethe + +/-! +# Threshold feasibility for the implemented Bethe oracle + +The finite-word oracle scans the floor constraints in row-major order. This +file gives that exact oracle its semantic feasibility runner. The older +`betheBoundedEpigraphOracle` may choose a different violated floor constraint; +no equality between the two tie-breaking rules is needed. +-/ + +def runExplicitScannedBetheThresholdFeasibility {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (p : ℕ) (delta upper : RawRat) (r : ℚ) : + RationalFeasibilityResult (m * m + 1) := + let R := betheEpigraphOuterRadius m upper.value r + runExplicitBallRationalFeasibility + (scannedBetheBoundedEpigraphOracle tau A p delta upper) + (betheThresholdFeasibilityBudget m upper.value r) R + +theorem runExplicitScannedBetheThresholdFeasibility_acceptsOnly {m : ℕ} + (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) + (p : ℕ) (delta upper : RawRat) (r : ℚ) + {q : Fin (m * m + 1) → ℚ} + (hrun : runExplicitScannedBetheThresholdFeasibility + tau A p delta upper r = .accepted q) : + BetheEpigraphOracleAccepted tau A p delta.value upper.value q := by + exact runExplicitBallRationalFeasibility_acceptsOnly + (scannedBetheBoundedEpigraphOracle_acceptsOnly tau A p delta upper) + (by simpa only [runExplicitScannedBetheThresholdFeasibility, + betheThresholdFeasibilityBudget] using hrun) + +theorem runExplicitScannedBetheThresholdFeasibility_accepts_of_slack + {m : ℕ} (hm : 0 < m) {tau : ℚ} (htau0 : 0 < tau) + (htau1 : tau ≤ 1) + {A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ} + (hApos : ∀ i j, 0 < A i j) (hAupper : ∀ i j, A i j ≤ 1) + {X : Matrix (Fin (m + 1)) (Fin (m + 1)) ℝ} + (hX : IsDoublyStochastic X) + (hmax : ∀ Y, IsDoublyStochastic Y → + regularizedBetheObjective (tau : ℝ) + (fun i j ↦ (A i j : ℝ)) Y ≤ + regularizedBetheObjective (tau : ℝ) + (fun i j ↦ (A i j : ℝ)) X) + {mix r : ℚ} {delta upper : RawRat} + (hmix0 : 0 < mix) (hmix1 : mix ≤ 1) + (hdelta : 0 < delta.value) (hr : 0 < r) + (hspike : r / mix ≤ 1 / (m + 1 : ℚ)) + (hfloor : delta.value ≤ (1 - mix) * + numericalInteriorFloor (m + 1) (rationalMatrixEntryBitBound A) tau) + (hslack : + -regularizedBetheObjective (tau : ℝ) + (fun i j ↦ (A i j : ℝ)) X + + (mix : ℝ) * (rationalRegularizedObjectiveRange A : ℝ) + + 2 * (r : ℝ) ≤ (upper.value : ℝ)) + (p : ℕ) : + ∃ q : Fin (m * m + 1) → ℚ, + runExplicitScannedBetheThresholdFeasibility + tau A p delta upper r = .accepted q ∧ + BetheEpigraphOracleAccepted + tau A p delta.value upper.value q := by + let delta0 : ℚ := numericalInteriorFloor (m + 1) + (rationalMatrixEntryBitBound A) tau + have hoptimizerFloor : ∀ i j, (delta0 : ℝ) ≤ X i j := by + intro i j + exact (regularizedOptimizer_meets_executable_floor + (n := m + 1) (by omega) htau0 hApos hAupper hX hmax i j).1 + have hcross := BetheEpigraphTarget_smoothed_inner_cross hm htau0.le htau1 + hApos hAupper hX hoptimizerFloor + (Rat.cast_pos.mpr hmix0) (by exact_mod_cast hmix1) + (Rat.cast_nonneg.mpr hr.le) (by + have hs := (Rat.cast_le (K := ℝ)).mpr hspike + norm_num only [Rat.cast_div, Rat.cast_one, Rat.cast_natCast] at hs + simpa using hs) + (δ := (delta.value : ℝ)) (upper := (upper.value : ℝ)) (by + exact_mod_cast hfloor) hslack + let ycenter := squareMatrixToVector (smoothedUniformAffineBase X (mix : ℝ)) + let zcenter := epigraphPoint ycenter ((upper.value : ℝ) - (r : ℝ)) + have hcross' : + (∀ k, BetheEpigraphTarget (tau : ℝ) (fun i j ↦ (A i j : ℝ)) + (delta.value : ℝ) (upper.value : ℝ) + (fun i ↦ zcenter i + if i = k then (r : ℝ) else 0)) ∧ + (∀ k, BetheEpigraphTarget (tau : ℝ) (fun i j ↦ (A i j : ℝ)) + (delta.value : ℝ) (upper.value : ℝ) + (fun i ↦ zcenter i - if i = k then (r : ℝ) else 0)) := by + simpa only [ycenter, zcenter] using hcross + have houter := BetheEpigraphTarget_inner_cross_outer_zero hm + (Rat.cast_nonneg.mpr hdelta.le) (Rat.cast_nonneg.mpr hr.le) ycenter + hcross'.1 hcross'.2 + have hR : 0 < betheEpigraphOuterRadius m upper.value r := + betheEpigraphOuterRadius_pos m hr.le + obtain ⟨q, hrun, hgood⟩ := + runExplicitBallRationalFeasibility_ball_accepts + (d := m * m + 1) (by omega) + (Target := BetheEpigraphTarget (tau : ℝ) (fun i j ↦ (A i j : ℝ)) + (delta.value : ℝ) (upper.value : ℝ)) + (Good := BetheEpigraphOracleAccepted + tau A p delta.value upper.value) + (oracle := scannedBetheBoundedEpigraphOracle tau A p delta upper) + (scannedBetheBoundedEpigraphOracle_valid hm htau0.le htau1 + hApos hdelta p upper) + (scannedBetheBoundedEpigraphOracle_acceptsOnly tau A p delta upper) + hR hr hcross'.1 hcross'.2 + (by + intro k + have hk := houter.1 k + rw [cast_betheEpigraphOuterRadius] + simpa [zcenter, ycenter] using hk) + (by + intro k + have hk := houter.2 k + rw [cast_betheEpigraphOuterRadius] + simpa [zcenter, ycenter] using hk) + refine ⟨q, ?_, hgood⟩ + simpa only [runExplicitScannedBetheThresholdFeasibility, + betheThresholdFeasibilityBudget] using hrun + +theorem runExplicitScannedBetheThresholdFeasibility_exhausted_lt_optimum_add_slack + {m : ℕ} (hm : 0 < m) {tau : ℚ} (htau0 : 0 < tau) + (htau1 : tau ≤ 1) + {A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ} + (hApos : ∀ i j, 0 < A i j) (hAupper : ∀ i j, A i j ≤ 1) + {X : Matrix (Fin (m + 1)) (Fin (m + 1)) ℝ} + (hX : IsDoublyStochastic X) + (hmax : ∀ Y, IsDoublyStochastic Y → + regularizedBetheObjective (tau : ℝ) + (fun i j ↦ (A i j : ℝ)) Y ≤ + regularizedBetheObjective (tau : ℝ) + (fun i j ↦ (A i j : ℝ)) X) + {mix r : ℚ} {delta upper : RawRat} + (hmix0 : 0 < mix) (hmix1 : mix ≤ 1) + (hdelta : 0 < delta.value) (hr : 0 < r) + (hspike : r / mix ≤ 1 / (m + 1 : ℚ)) + (hfloor : delta.value ≤ (1 - mix) * + numericalInteriorFloor (m + 1) (rationalMatrixEntryBitBound A) tau) + (p : ℕ) {E : RationalEllipsoidState (m * m + 1)} + (hrun : runExplicitScannedBetheThresholdFeasibility + tau A p delta upper r = .exhausted E) : + (upper.value : ℝ) < + -regularizedBetheObjective (tau : ℝ) + (fun i j ↦ (A i j : ℝ)) X + + (mix : ℝ) * (rationalRegularizedObjectiveRange A : ℝ) + + 2 * (r : ℝ) := by + by_contra hnot + have hslack : + -regularizedBetheObjective (tau : ℝ) + (fun i j ↦ (A i j : ℝ)) X + + (mix : ℝ) * (rationalRegularizedObjectiveRange A : ℝ) + + 2 * (r : ℝ) ≤ (upper.value : ℝ) := not_lt.mp hnot + obtain ⟨q, haccepted, _⟩ := + runExplicitScannedBetheThresholdFeasibility_accepts_of_slack + hm htau0 htau1 hApos hAupper hX hmax hmix0 hmix1 hdelta hr + hspike hfloor hslack p + rw [hrun] at haccepted + contradiction + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/ScheduledFeasibility.lean b/LeanPool/BeyondBethe/BeyondBethe/ScheduledFeasibility.lean new file mode 100644 index 0000000000..edd398b032 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/ScheduledFeasibility.lean @@ -0,0 +1,380 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.ScheduledRoundedEllipsoidIteration +import LeanPool.BeyondBethe.BeyondBethe.RationalFeasibility +import LeanPool.BeyondBethe.BeyondBethe.RoundedFeasibility +import Mathlib.Tactic + +/-! # Scheduled Feasibility -/ + +open scoped BigOperators + +namespace BeyondBethe + +/-! +# Fixed-precision rational feasibility + +The public runner computes two determinant-free exponents from its initial +state and one precision from the total iteration budget. That precision is +then held fixed throughout the recursive loop. +-/ + +/-- Determinant-free initial exponent. -/ +def scheduledInitialDetExponent {d : ℕ} + (E : RationalEllipsoidState d) : ℕ := + positiveDyadicPrecision (rationalMatrixDeterminantLower E.basis) + +/-- Initial exponent dominating the total rational state magnitude. -/ +def scheduledInitialMagnitudeExponent {d : ℕ} + (E : RationalEllipsoidState d) : ℕ := + encodedBitLength ℚ (rationalStateAbsBound E) + +theorem scheduledInitialDetExponent_lower {d : ℕ} + (E : RationalEllipsoidState d) (hdet : Matrix.det E.basis ≠ 0) : + dyadicMesh (scheduledInitialDetExponent E) ≤ + abs (Matrix.det E.basis) := by + exact (dyadicMesh_positiveDyadicPrecision_lt + (rationalMatrixDeterminantLower_pos E.basis)).le.trans + (rationalMatrixDeterminantLower_le_abs_det E.basis hdet) + +theorem scheduledInitialMagnitudeExponent_upper {d : ℕ} + (E : RationalEllipsoidState d) : + rationalStateAbsBound E ≤ + (2 : ℚ) ^ scheduledInitialMagnitudeExponent E := by + have hpos : 0 < rationalStateAbsBound E := + (show (0 : ℚ) < 2 by norm_num).trans_le + (rationalStateAbsBound_two_le E) + exact (positive_rational_lt_two_pow_encodedBitLength hpos).le + +/-- The determinant-independent precision computed once for a feasibility +run. -/ +def scheduledFeasibilityPrecision {d : ℕ} + (budget : ℕ) (E : RationalEllipsoidState d) : ℕ := + roundedEllipsoidPrecisionSchedule d + (scheduledInitialDetExponent E) + (scheduledInitialMagnitudeExponent E) budget + +/-- Recursive loop at a fixed precision. -/ +def runFixedPrecisionRationalFeasibility {d : ℕ} (p : ℕ) + (oracle : RationalCentralOracle d) : + ℕ → RationalEllipsoidState d → RationalFeasibilityResult d + | 0, E => .exhausted E + | budget + 1, E => + match oracle E with + | .accept => .accepted E.center + | .cut a => runFixedPrecisionRationalFeasibility p oracle budget + (scheduledRoundedEllipsoidCentralUpdate p E a) + +/-- Public scheduled runner. Its precision contains no determinant +evaluation and is unchanged inside the loop. -/ +def runScheduledRationalFeasibility {d : ℕ} + (oracle : RationalCentralOracle d) + (budget : ℕ) (E : RationalEllipsoidState d) : + RationalFeasibilityResult d := + runFixedPrecisionRationalFeasibility + (scheduledFeasibilityPrecision budget E) oracle budget E + +theorem runFixedPrecisionRationalFeasibility_acceptsOnly {d p : ℕ} + {Good : (Fin d → ℚ) → Prop} {oracle : RationalCentralOracle d} + (haccept : RationalCentralOracleAcceptsOnly Good oracle) + {budget : ℕ} {E : RationalEllipsoidState d} {x : Fin d → ℚ} + (hrun : runFixedPrecisionRationalFeasibility p oracle budget E = + .accepted x) : Good x := by + induction budget generalizing E with + | zero => simp [runFixedPrecisionRationalFeasibility] at hrun + | succ budget ih => + rw [runFixedPrecisionRationalFeasibility] at hrun + split at hrun <;> rename_i hresponse + · cases hrun + exact haccept E hresponse + · exact ih hrun + +theorem runScheduledRationalFeasibility_acceptsOnly {d : ℕ} + {Good : (Fin d → ℚ) → Prop} {oracle : RationalCentralOracle d} + (haccept : RationalCentralOracleAcceptsOnly Good oracle) + {budget : ℕ} {E : RationalEllipsoidState d} {x : Fin d → ℚ} + (hrun : runScheduledRationalFeasibility oracle budget E = .accepted x) : + Good x := by + exact runFixedPrecisionRationalFeasibility_acceptsOnly haccept + (by simpa only [runScheduledRationalFeasibility] using hrun) + +theorem scheduledRoundedEllipsoidCentralUpdate_contains_point {d p : ℕ} + (hd : 0 < d) (E : RationalEllipsoidState d) (a : Fin d → ℚ) + (hdet : Matrix.det E.basis ≠ 0) + (hp : roundedEllipsoidPrecision + (rationalEllipsoidCentralUpdate E a) ≤ p) + {x : Fin d → ℝ} (hcontains : RationalEllipsoidContains E x) + (ha : a ≠ 0) + (hcut : finiteDot (fun i ↦ (a i : ℝ)) + (fun i ↦ x i - rationalCenterReal E i) ≤ 0) : + RationalEllipsoidContains + (scheduledRoundedEllipsoidCentralUpdate p E a) x := by + obtain ⟨y, hy, hpoint⟩ := hcontains + have hb := rationalPulledBackNormal_ne_zero_of_det_ne_zero E a hdet ha + have hpulled : finiteDot + (fun j ↦ (rationalPulledBackNormal E a j : ℝ)) y ≤ 0 := by + rw [← physicalDot_point_sub_center_eq_pulledDot E a y] + simpa only [hpoint] using hcut + obtain ⟨y', hy', hpoint'⟩ := + scheduledRoundedEllipsoidCentralUpdate_contains + hd E a hdet hb hp hy hpulled + exact ⟨y', hy', hpoint'.trans hpoint⟩ + +theorem scheduledContractionFactor_nonneg {d : ℕ} (hd : 0 < d) : + 0 ≤ 1 - 1 / (32 * (d : ℝ) ^ 3) := by + have hdR : (1 : ℝ) ≤ d := by exact_mod_cast hd + have hden : (1 : ℝ) ≤ 32 * (d : ℝ) ^ 3 := by + nlinarith [one_le_pow₀ (n := 3) hdR] + exact sub_nonneg.mpr + ((div_le_one (by positivity : (0 : ℝ) < 32 * (d : ℝ) ^ 3)).2 hden) + +/-- Target preservation for a fixed-precision run. The global invariant +discharges the rounding precision at each recursive call. -/ +theorem runFixedPrecisionRationalFeasibility_preserves_target_of_exhausted + {d L K T t : ℕ} (hd : 0 < d) + {Target : (Fin d → ℝ) → Prop} {oracle : RationalCentralOracle d} + (hvalid : RationalCentralOracleValid Target oracle) + {budget : ℕ} {E E' : RationalEllipsoidState d} + (hInv : ScheduledEllipsoidInvariant d L K t E) + (hbudget : t + budget ≤ T) + (hrun : runFixedPrecisionRationalFeasibility + (roundedEllipsoidPrecisionSchedule d L K T) oracle budget E = + .exhausted E') + {x : Fin d → ℝ} (hTarget : Target x) + (hcontains : RationalEllipsoidContains E x) : + RationalEllipsoidContains E' x := by + induction budget generalizing E E' t with + | zero => + simp only [runFixedPrecisionRationalFeasibility] at hrun + cases hrun + exact hcontains + | succ budget ih => + rw [runFixedPrecisionRationalFeasibility] at hrun + split at hrun + · contradiction + · rename_i a hresponse + have hcut := hvalid E a hresponse + have hb := rationalPulledBackNormal_ne_zero_of_det_ne_zero + E a hInv.det_ne_zero hcut.1 + have htT : t ≤ T := by omega + have hadvance := hInv.advance hd a hb htT + let E₁ := scheduledRoundedEllipsoidCentralUpdate + (roundedEllipsoidPrecisionSchedule d L K T) E a + have hInv₁ : ScheduledEllipsoidInvariant d L K (t + 1) E₁ := by + simpa only [E₁] using hadvance.2 + have hnext := scheduledRoundedEllipsoidCentralUpdate_contains_point + hd E a hInv.det_ne_zero hadvance.1 hcontains hcut.1 + (hcut.2 x hTarget) + apply ih hInv₁ + · omega + · exact hrun + · exact hnext + +theorem runFixedPrecisionRationalFeasibility_det_upper_of_exhausted + {d L K T t : ℕ} (hd : 0 < d) + {Target : (Fin d → ℝ) → Prop} {oracle : RationalCentralOracle d} + (hvalid : RationalCentralOracleValid Target oracle) + {budget : ℕ} {E E' : RationalEllipsoidState d} + (hInv : ScheduledEllipsoidInvariant d L K t E) + (hbudget : t + budget ≤ T) + (hrun : runFixedPrecisionRationalFeasibility + (roundedEllipsoidPrecisionSchedule d L K T) oracle budget E = + .exhausted E') : + abs ((Matrix.det E'.basis : ℚ) : ℝ) ≤ + (1 - 1 / (32 * (d : ℝ) ^ 3)) ^ budget * + abs ((Matrix.det E.basis : ℚ) : ℝ) := by + induction budget generalizing E E' t with + | zero => + simp only [runFixedPrecisionRationalFeasibility] at hrun + cases hrun + simp + | succ budget ih => + rw [runFixedPrecisionRationalFeasibility] at hrun + split at hrun + · contradiction + · rename_i a hresponse + have hcut := hvalid E a hresponse + have hb := rationalPulledBackNormal_ne_zero_of_det_ne_zero + E a hInv.det_ne_zero hcut.1 + have htT : t ≤ T := by omega + have hadvance := hInv.advance hd a hb htT + let E₁ := scheduledRoundedEllipsoidCentralUpdate + (roundedEllipsoidPrecisionSchedule d L K T) E a + have hInv₁ : ScheduledEllipsoidInvariant d L K (t + 1) E₁ := by + simpa only [E₁] using hadvance.2 + have htail := ih hInv₁ (by omega) hrun + have hstep := abs_det_scheduledRoundedCentralUpdate_le + hd E a hInv.det_ne_zero hb hadvance.1 + have hfactor0 := scheduledContractionFactor_nonneg hd + calc + abs ((Matrix.det E'.basis : ℚ) : ℝ) ≤ + (1 - 1 / (32 * (d : ℝ) ^ 3)) ^ budget * + abs ((Matrix.det E₁.basis : ℚ) : ℝ) := htail + _ ≤ (1 - 1 / (32 * (d : ℝ) ^ 3)) ^ budget * + ((1 - 1 / (32 * (d : ℝ) ^ 3)) * + abs ((Matrix.det E.basis : ℚ) : ℝ)) := + mul_le_mul_of_nonneg_left hstep (pow_nonneg hfactor0 _) + _ = (1 - 1 / (32 * (d : ℝ) ^ 3)) ^ (budget + 1) * + abs ((Matrix.det E.basis : ℚ) : ℝ) := by + rw [pow_succ] + ring + +theorem scheduledInitialInvariant {d : ℕ} + (E : RationalEllipsoidState d) (hdet : Matrix.det E.basis ≠ 0) : + ScheduledEllipsoidInvariant d (scheduledInitialDetExponent E) + (scheduledInitialMagnitudeExponent E) 0 E := by + refine ⟨hdet, ?_, ?_⟩ + · simpa using scheduledInitialDetExponent_lower E hdet + · simpa using scheduledInitialMagnitudeExponent_upper E + +theorem runScheduledRationalFeasibility_preserves_target_of_exhausted + {d : ℕ} (hd : 0 < d) + {Target : (Fin d → ℝ) → Prop} {oracle : RationalCentralOracle d} + (hvalid : RationalCentralOracleValid Target oracle) + {budget : ℕ} {E E' : RationalEllipsoidState d} + (hdet : Matrix.det E.basis ≠ 0) + (hrun : runScheduledRationalFeasibility oracle budget E = .exhausted E') + {x : Fin d → ℝ} (hTarget : Target x) + (hcontains : RationalEllipsoidContains E x) : + RationalEllipsoidContains E' x := by + let L := scheduledInitialDetExponent E + let K := scheduledInitialMagnitudeExponent E + have hInv : ScheduledEllipsoidInvariant d L K 0 E := by + simpa only [L, K] using scheduledInitialInvariant E hdet + apply runFixedPrecisionRationalFeasibility_preserves_target_of_exhausted + (L := L) (K := K) (T := budget) (t := 0) (budget := budget) + (E := E) (E' := E') hd hvalid hInv (by omega) + · simpa only [runScheduledRationalFeasibility, + scheduledFeasibilityPrecision, L, K] using hrun + · exact hTarget + · exact hcontains + +theorem runScheduledRationalFeasibility_det_upper_of_exhausted + {d : ℕ} (hd : 0 < d) + {Target : (Fin d → ℝ) → Prop} {oracle : RationalCentralOracle d} + (hvalid : RationalCentralOracleValid Target oracle) + {budget : ℕ} {E E' : RationalEllipsoidState d} + (hdet : Matrix.det E.basis ≠ 0) + (hrun : runScheduledRationalFeasibility oracle budget E = .exhausted E') : + abs ((Matrix.det E'.basis : ℚ) : ℝ) ≤ + (1 - 1 / (32 * (d : ℝ) ^ 3)) ^ budget * + abs ((Matrix.det E.basis : ℚ) : ℝ) := by + let L := scheduledInitialDetExponent E + let K := scheduledInitialMagnitudeExponent E + have hInv : ScheduledEllipsoidInvariant d L K 0 E := by + simpa only [L, K] using scheduledInitialInvariant E hdet + apply runFixedPrecisionRationalFeasibility_det_upper_of_exhausted + (L := L) (K := K) (T := budget) (t := 0) (budget := budget) + (E := E) (E' := E') hd hvalid hInv (by omega) + simpa only [runScheduledRationalFeasibility, + scheduledFeasibilityPrecision, L, K] using hrun + +theorem runScheduledRationalFeasibility_not_exhausted_of_inner_cross + {d M : ℕ} (hd : 0 < d) + {Target : (Fin d → ℝ) → Prop} {oracle : RationalCentralOracle d} + (hvalid : RationalCentralOracleValid Target oracle) + (E : RationalEllipsoidState d) + (hdet : Matrix.det E.basis ≠ 0) + {z : Fin d → ℝ} {r : ℝ} (hr : 0 ≤ r) + (hdyadic : Nat.factorial d * abs ((Matrix.det E.basis : ℚ) : ℝ) * + (1 / 2 : ℝ) ^ M < r ^ d) + (hTargetPlus : ∀ k, Target + (fun i ↦ z i + if i = k then r else 0)) + (hTargetMinus : ∀ k, Target + (fun i ↦ z i - if i = k then r else 0)) + (hEplus : ∀ k, RationalEllipsoidContains E + (fun i ↦ z i + if i = k then r else 0)) + (hEminus : ∀ k, RationalEllipsoidContains E + (fun i ↦ z i - if i = k then r else 0)) + (E' : RationalEllipsoidState d) : + runScheduledRationalFeasibility oracle (32 * d ^ 3 * M) E ≠ + .exhausted E' := by + intro hrun + have hplus : ∀ k, RationalEllipsoidContains E' + (fun i ↦ z i + if i = k then r else 0) := by + intro k + exact runScheduledRationalFeasibility_preserves_target_of_exhausted + hd hvalid hdet hrun (hTargetPlus k) (hEplus k) + have hminus : ∀ k, RationalEllipsoidContains E' + (fun i ↦ z i - if i = k then r else 0) := by + intro k + exact runScheduledRationalFeasibility_preserves_target_of_exhausted + hd hvalid hdet hrun (hTargetMinus k) (hEminus k) + have hlower := rationalEllipsoid_storedDet_lower_of_ball_endpoints + E' hr (fun k ↦ hplus k) (fun k ↦ hminus k) + have hupper := runScheduledRationalFeasibility_det_upper_of_exhausted + hd hvalid hdet hrun + have hfactor := roundedContractionFactor_pow_budget_le_half_pow + (d := d) (M := M) hd + have hdetUpper : abs ((Matrix.det E'.basis : ℚ) : ℝ) ≤ + (1 / 2 : ℝ) ^ M * abs ((Matrix.det E.basis : ℚ) : ℝ) := + hupper.trans (mul_le_mul_of_nonneg_right hfactor (abs_nonneg _)) + have hsandwich : r ^ d ≤ + Nat.factorial d * abs ((Matrix.det E.basis : ℚ) : ℝ) * + (1 / 2 : ℝ) ^ M := by + calc + r ^ d ≤ Nat.factorial d * + abs ((Matrix.det E'.basis : ℚ) : ℝ) := hlower + _ ≤ Nat.factorial d * + ((1 / 2 : ℝ) ^ M * + abs ((Matrix.det E.basis : ℚ) : ℝ)) := + mul_le_mul_of_nonneg_left hdetUpper (Nat.cast_nonneg _) + _ = Nat.factorial d * abs ((Matrix.det E.basis : ℚ) : ℝ) * + (1 / 2 : ℝ) ^ M := by ring + exact (not_lt_of_ge hsandwich) hdyadic + +/-- Ball specialization used by the determinant-independent epigraph +feasibility call. -/ +theorem runScheduledRationalFeasibility_ball_accepts + {d : ℕ} (hd : 0 < d) + {Target : (Fin d → ℝ) → Prop} {Good : (Fin d → ℚ) → Prop} + {oracle : RationalCentralOracle d} + (hvalid : RationalCentralOracleValid Target oracle) + (haccept : RationalCentralOracleAcceptsOnly Good oracle) + (c : Fin d → ℚ) {R r : ℚ} (hR : 0 < R) (hr : 0 < r) + {z : Fin d → ℝ} + (hTargetPlus : ∀ k, Target + (fun i ↦ z i + if i = k then (r : ℝ) else 0)) + (hTargetMinus : ∀ k, Target + (fun i ↦ z i - if i = k then (r : ℝ) else 0)) + (houterPlus : ∀ k, finiteNormSq + (fun i ↦ (z i + if i = k then (r : ℝ) else 0) - (c i : ℝ)) ≤ + (R : ℝ) ^ 2) + (houterMinus : ∀ k, finiteNormSq + (fun i ↦ (z i - if i = k then (r : ℝ) else 0) - (c i : ℝ)) ≤ + (R : ℝ) ^ 2) : + ∃ x : Fin d → ℚ, + runScheduledRationalFeasibility oracle + (32 * d ^ 3 * rationalBallDyadicExponent d R r) + (rationalBallEllipsoid d c R) = .accepted x ∧ Good x := by + let E := rationalBallEllipsoid d c R + let budget := 32 * d ^ 3 * rationalBallDyadicExponent d R r + let result := runScheduledRationalFeasibility oracle budget E + cases hresult : result with + | accepted x => + refine ⟨x, ?_, ?_⟩ + · simpa only [result, budget, E] using hresult + · exact runScheduledRationalFeasibility_acceptsOnly haccept + (by simpa only [result, budget, E] using hresult) + | exhausted E' => + exfalso + apply runScheduledRationalFeasibility_not_exhausted_of_inner_cross + hd hvalid E + (by + dsimp only [E] + rw [det_rationalBallEllipsoid] + exact pow_ne_zero _ hR.ne') + (hr := Rat.cast_nonneg.mpr hr.le) + (rationalBallEllipsoid_dyadic_budget hd c hR hr) + hTargetPlus hTargetMinus + · intro k + exact rationalBallEllipsoid_contains c hR (houterPlus k) + · intro k + exact rationalBallEllipsoid_contains c hR (houterMinus k) + · simpa only [result, budget, E] using hresult + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/ScheduledRoundedEllipsoid.lean b/LeanPool/BeyondBethe/BeyondBethe/ScheduledRoundedEllipsoid.lean new file mode 100644 index 0000000000..0c45e29c49 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/ScheduledRoundedEllipsoid.lean @@ -0,0 +1,709 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.RoundedEllipsoidIterationBounds +import Mathlib.Tactic + +/-! # Scheduled Rounded Ellipsoid -/ + +open scoped BigOperators + +namespace BeyondBethe + +/-! +# Determinant-independent scheduled rounding + +`roundedEllipsoidPrecision` is a semantic proof specification: it mentions the +exact determinant of the state to be rounded. The definitions in this file +take an externally scheduled number of fractional bits. Correctness needs +only the displayed inequality saying that the schedule dominates the semantic +requirement. Later iteration lemmas discharge that inequality from the +initial determinant and magnitude bounds, without evaluating a determinant. +-/ + +/-- A uniform precision schedule for a run of at most `T` central cuts. -/ +def roundedEllipsoidPrecisionSchedule (d L K T : ℕ) : ℕ := + roundedEllipsoidNextPrecisionBound d L K T + +theorem roundedEllipsoidNextPrecisionBound_mono_last + {d L K t T : ℕ} (ht : t ≤ T) : + roundedEllipsoidNextPrecisionBound d L K t ≤ + roundedEllipsoidNextPrecisionBound d L K T := by + rw [roundedEllipsoidNextPrecisionBound, + roundedEllipsoidNextPrecisionBound, + roundedEllipsoidDenominatorExponent, + roundedEllipsoidDenominatorExponent] + gcongr + +theorem roundedEllipsoidNextPrecisionBound_le_schedule + {d L K t T : ℕ} (ht : t ≤ T) : + roundedEllipsoidNextPrecisionBound d L K t ≤ + roundedEllipsoidPrecisionSchedule d L K T := by + exact roundedEllipsoidNextPrecisionBound_mono_last ht + +/-- Round a state at a determinant-independent scheduled precision. -/ +def scheduledRoundedEllipsoid {d : ℕ} (p : ℕ) + (U : RationalEllipsoidState d) : RationalEllipsoidState d := + inflatedDyadicRound p (roundedEllipsoidInflation d) U + +/-- Exact central update followed by scheduled dyadic rounding. -/ +def scheduledRoundedEllipsoidCentralUpdate {d : ℕ} (p : ℕ) + (E : RationalEllipsoidState d) (a : Fin d → ℚ) : + RationalEllipsoidState d := + scheduledRoundedEllipsoid p (rationalEllipsoidCentralUpdate E a) + +theorem scheduled_dyadicMesh_le_adaptive {d p : ℕ} + (U : RationalEllipsoidState d) + (hp : roundedEllipsoidPrecision U ≤ p) : + dyadicMesh p ≤ dyadicMesh (roundedEllipsoidPrecision U) := + dyadicMesh_antitone hp + +theorem scheduled_dyadicMesh_lt_target {d p : ℕ} (hd : 0 < d) + (U : RationalEllipsoidState d) (hdet : Matrix.det U.basis ≠ 0) + (hp : roundedEllipsoidPrecision U ≤ p) : + dyadicMesh p < roundedEllipsoidMeshTarget U := + (scheduled_dyadicMesh_le_adaptive U hp).trans_lt + (adaptive_dyadicMesh_lt_target hd U hdet) + +theorem scheduled_determinant_rounding_loss_lt {d p : ℕ} + (hd : 0 < d) (U : RationalEllipsoidState d) + (hdet : Matrix.det U.basis ≠ 0) + (hp : roundedEllipsoidPrecision U ≤ p) : + roundedDeterminantCoefficient d (rationalMatrixAbsBound U.basis) * + dyadicMesh p < + abs (Matrix.det U.basis) / (128 * d ^ 3) := by + have hmesh := scheduled_dyadicMesh_le_adaptive U hp + have hC : 0 ≤ roundedDeterminantCoefficient d + (rationalMatrixAbsBound U.basis) := + (roundedDeterminantCoefficient_pos hd + (rationalMatrixAbsBound_pos U.basis)).le + exact (mul_le_mul_of_nonneg_left hmesh hC).trans_lt + (adaptive_determinant_rounding_loss_lt hd U hdet) + +theorem scheduled_inverse_rounding_loss_lt {d p : ℕ} + (hd : 0 < d) (U : RationalEllipsoidState d) + (hdet : Matrix.det U.basis ≠ 0) + (hp : roundedEllipsoidPrecision U ≤ p) : + roundedInverseCoefficient d (rationalMatrixAbsBound U.basis) * + dyadicMesh p < + roundedEllipsoidInflation d * abs (Matrix.det U.basis) / + (2 * d) := by + have hmesh := scheduled_dyadicMesh_le_adaptive U hp + have hC : 0 ≤ roundedInverseCoefficient d + (rationalMatrixAbsBound U.basis) := + (roundedInverseCoefficient_pos hd + (rationalMatrixAbsBound_pos U.basis)).le + exact (mul_le_mul_of_nonneg_left hmesh hC).trans_lt + (adaptive_inverse_rounding_loss_lt hd U hdet) + +theorem scheduledRounded_entry_bound {d p : ℕ} + (U : RationalEllipsoidState d) (i j : Fin d) : + abs (((dyadicFloorMatrix p U.basis i j : ℚ) : ℝ)) ≤ + (2 * rationalMatrixAbsBound U.basis : ℚ) := by + let M := rationalMatrixAbsBound U.basis + have hM1 : (1 : ℚ) ≤ M := rationalMatrixAbsBound_one_le U.basis + have hentry : abs (U.basis i j) < M := + abs_entry_lt_rationalMatrixAbsBound U.basis i j + have hround := abs_dyadicFloor_le p (U.basis i j) + have hmesh := dyadicMesh_le_one p + have hq : abs (dyadicFloor p (U.basis i j)) ≤ 2 * M := by + dsimp only [M] at hM1 hentry ⊢ + linarith + exact_mod_cast hq + +theorem scheduledRounded_det_lower {d p : ℕ} (hd : 0 < d) + (U : RationalEllipsoidState d) (hdet : Matrix.det U.basis ≠ 0) + (hp : roundedEllipsoidPrecision U ≤ p) : + ((abs (Matrix.det U.basis) / 2 : ℚ) : ℝ) ≤ + abs (Matrix.det + (fun i j ↦ ((dyadicFloorMatrix p U.basis i j : ℚ) : ℝ))) := by + let Mq := rationalMatrixAbsBound U.basis + let Δq := abs (Matrix.det U.basis) + let A : Matrix (Fin d) (Fin d) ℝ := + fun i j ↦ ((dyadicFloorMatrix p U.basis i j : ℚ) : ℝ) + let B : Matrix (Fin d) (Fin d) ℝ := + fun i j ↦ ((U.basis i j : ℚ) : ℝ) + have hMq1 : (1 : ℚ) ≤ Mq := rationalMatrixAbsBound_one_le U.basis + have hMreal : (1 : ℝ) ≤ (Mq : ℝ) := by exact_mod_cast hMq1 + have hBentry : ∀ i j, abs (B i j) ≤ (Mq : ℝ) := by + intro i j + change abs (((U.basis i j : ℚ) : ℝ)) ≤ (Mq : ℝ) + exact_mod_cast (abs_entry_lt_rationalMatrixAbsBound U.basis i j).le + have hpert := abs_det_dyadicFloorMatrix_sub_det_le p U.basis hMreal + (by simpa only [B] using hBentry) + have hlossQ := scheduled_determinant_rounding_loss_lt hd U hdet hp + have hloss : + d.factorial * + (d * (dyadicMesh p : ℝ) * (2 * (Mq : ℝ)) ^ d) < + (Δq : ℝ) / (128 * (d : ℝ) ^ 3) := by + have hc : + ((roundedDeterminantCoefficient d Mq * dyadicMesh p : ℚ) : ℝ) < + ((Δq / (128 * d ^ 3) : ℚ) : ℝ) := by + exact_mod_cast hlossQ + norm_num only [roundedDeterminantCoefficient, Rat.cast_mul, + Rat.cast_pow, Rat.cast_natCast, Rat.cast_div] at hc + convert hc using 1 <;> ring + have hsmallLoss : + d.factorial * + (d * (dyadicMesh p : ℝ) * (2 * (Mq : ℝ)) ^ d) < + (Δq : ℝ) / 2 := by + have hdR : (1 : ℝ) ≤ d := by exact_mod_cast hd + have hΔ : 0 < (Δq : ℝ) := by + exact_mod_cast (abs_pos.mpr hdet) + have hden : (2 : ℝ) ≤ 128 * (d : ℝ) ^ 3 := by + nlinarith [one_le_pow₀ (n := 3) hdR] + have hfrac : (Δq : ℝ) / (128 * (d : ℝ) ^ 3) ≤ (Δq : ℝ) / 2 := + div_le_div_of_nonneg_left hΔ.le (by norm_num) hden + exact hloss.trans_le hfrac + have htriangle : abs (Matrix.det B) ≤ + abs (Matrix.det A - Matrix.det B) + abs (Matrix.det A) := by + calc + abs (Matrix.det B) = + abs ((Matrix.det B - Matrix.det A) + Matrix.det A) := by ring_nf + _ ≤ abs (Matrix.det B - Matrix.det A) + abs (Matrix.det A) := + abs_add_le _ _ + _ = abs (Matrix.det A - Matrix.det B) + abs (Matrix.det A) := by + rw [show Matrix.det B - Matrix.det A = + -(Matrix.det A - Matrix.det B) by ring, abs_neg] + have hcastB : Matrix.det B = ((Matrix.det U.basis : ℚ) : ℝ) := by + rw [show B = U.basis.map (fun q : ℚ ↦ (q : ℝ)) by rfl, Rat.cast_det] + have hpert' : abs (Matrix.det A - Matrix.det B) ≤ + d.factorial * + (d * (dyadicMesh p : ℝ) * (2 * (Mq : ℝ)) ^ d) := by + simpa only [A, B] using hpert + rw [hcastB] at htriangle hpert' + have hΔcast : abs (((Matrix.det U.basis : ℚ) : ℝ)) = (Δq : ℝ) := by + exact_mod_cast (show abs (Matrix.det U.basis) = Δq by rfl) + rw [hΔcast] at htriangle + have hresult : (Δq : ℝ) / 2 ≤ abs (Matrix.det A) := by linarith + simpa only [A, Δq, Rat.cast_div, Rat.cast_ofNat] using hresult + +theorem scheduledRounded_contains {d p : ℕ} (hd : 0 < d) + (U : RationalEllipsoidState d) (hdet : Matrix.det U.basis ≠ 0) + (hp : roundedEllipsoidPrecision U ≤ p) + {y : Fin d → ℝ} (hy : finiteNormSq y ≤ 1) : + ∃ y' : Fin d → ℝ, finiteNormSq y' ≤ 1 ∧ + rationalEllipsoidPoint (scheduledRoundedEllipsoid p U) y' = + rationalEllipsoidPoint U y := by + let Mq := rationalMatrixAbsBound U.basis + let Mr : ℝ := 2 * (Mq : ℝ) + let Δq := abs (Matrix.det U.basis) + let D : ℝ := ((Δq / 2 : ℚ) : ℝ) + let η := roundedEllipsoidInflation d + have hMq : 0 < Mq := rationalMatrixAbsBound_pos U.basis + have hMr : (1 : ℝ) ≤ Mr := by + dsimp only [Mr] + have hMq1 := rationalMatrixAbsBound_one_le U.basis + exact_mod_cast (show (1 : ℚ) ≤ 2 * Mq by linarith) + have hD : 0 < D := by + dsimp only [D, Δq] + exact_mod_cast (div_pos (abs_pos.mpr hdet) (by norm_num : (0 : ℚ) < 2)) + have hη : 0 ≤ η := roundedEllipsoidInflation_nonneg d + have hentries : ∀ i j, + abs (((dyadicFloorMatrix p U.basis i j : ℚ) : ℝ)) ≤ Mr := by + intro i j + simpa only [Mr, Rat.cast_mul, Rat.cast_ofNat] using + scheduledRounded_entry_bound (p := p) U i j + have hdetLower : D ≤ abs (Matrix.det + (fun i j ↦ ((dyadicFloorMatrix p U.basis i j : ℚ) : ℝ))) := by + simpa only [D, Δq] using scheduledRounded_det_lower hd U hdet hp + have hinverseQ := scheduled_inverse_rounding_loss_lt hd U hdet hp + have hinverse : + (roundedInverseCoefficient d Mq : ℝ) * (dyadicMesh p : ℝ) < + (η : ℝ) * (Δq : ℝ) / (2 * (d : ℝ)) := by + exact_mod_cast hinverseQ + let V : ℝ := + (d * (d.factorial * Mr ^ d) * + (((d + 1 : ℕ) : ℝ) * (dyadicMesh p : ℝ))) / D + have hVform : V = + ((roundedInverseCoefficient d Mq : ℚ) : ℝ) * + (dyadicMesh p : ℝ) / D := by + have hCcast : ((roundedInverseCoefficient d Mq : ℚ) : ℝ) = + (d : ℝ) * (d.factorial * (2 * (Mq : ℝ)) ^ d) * (d + 1) := by + simp [roundedInverseCoefficient] + rw [hCcast] + dsimp only [V, Mr] + norm_num only [Nat.cast_add, Nat.cast_one] + ring + have hV0 : 0 ≤ V := by + have hMr0 : 0 ≤ Mr := by linarith [hMr] + have hMrpow : 0 ≤ Mr ^ d := pow_nonneg hMr0 _ + have hmesh0 : 0 ≤ (dyadicMesh p : ℝ) := by + exact_mod_cast dyadicMesh_nonneg p + dsimp only [V] + exact div_nonneg + (mul_nonneg + (mul_nonneg (by positivity) + (mul_nonneg (by positivity) hMrpow)) + (mul_nonneg (by positivity) hmesh0)) hD.le + have hV : V ≤ (η : ℝ) / d := by + rw [hVform] + have hΔ : 0 < (Δq : ℝ) := by + exact_mod_cast (abs_pos.mpr hdet) + have hdR : (0 : ℝ) < d := by exact_mod_cast hd + have hDform : D = (Δq : ℝ) / 2 := by + dsimp only [D] + norm_num + rw [hDform] + have hposDen : 0 < (Δq : ℝ) / 2 := div_pos hΔ (by norm_num) + rw [div_le_iff₀ hposDen] + have hηR : 0 ≤ (η : ℝ) := by exact_mod_cast hη + calc + ((roundedInverseCoefficient d Mq : ℚ) : ℝ) * + (dyadicMesh p : ℝ) ≤ + (η : ℝ) * (Δq : ℝ) / (2 * (d : ℝ)) := hinverse.le + _ = ((η : ℝ) / d) * ((Δq : ℝ) / 2) := by ring + have hsmall : d * V ^ 2 ≤ (η : ℝ) ^ 2 := by + have hdR : (1 : ℝ) ≤ d := by exact_mod_cast hd + have hηR : 0 ≤ (η : ℝ) := by exact_mod_cast hη + have hdiv0 : 0 ≤ (η : ℝ) / d := div_nonneg hηR (by positivity) + have hsq : V ^ 2 ≤ ((η : ℝ) / d) ^ 2 := + (sq_le_sq₀ hV0 hdiv0).2 hV + have hdpos : (0 : ℝ) < d := by positivity + calc + (d : ℝ) * V ^ 2 ≤ d * ((η : ℝ) / d) ^ 2 := + mul_le_mul_of_nonneg_left hsq hdpos.le + _ = (η : ℝ) ^ 2 / d := by field_simp + _ ≤ (η : ℝ) ^ 2 := div_le_self (sq_nonneg (η : ℝ)) hdR + have hsmall' : + d * + ((d * (d.factorial * Mr ^ d) * + ((d + 1 : ℕ) * (dyadicMesh p : ℝ))) / D) ^ 2 ≤ + (η : ℝ) ^ 2 := by simpa only [V] using hsmall + simpa only [scheduledRoundedEllipsoid, η] using + inflatedDyadicRound_contains hd p η U hη hD hMr hentries + hdetLower hsmall' hy + +theorem det_scheduledRoundedEllipsoid_ne_zero {d p : ℕ} (hd : 0 < d) + (U : RationalEllipsoidState d) (hdet : Matrix.det U.basis ≠ 0) + (hp : roundedEllipsoidPrecision U ≤ p) : + Matrix.det (scheduledRoundedEllipsoid p U).basis ≠ 0 := by + have hround : Matrix.det (dyadicFloorMatrix p U.basis) ≠ 0 := by + intro hz + have hlower := scheduledRounded_det_lower hd U hdet hp + have hzeroReal : Matrix.det + (fun i j ↦ ((dyadicFloorMatrix p U.basis i j : ℚ) : ℝ)) = 0 := by + rw [show (fun i j ↦ ((dyadicFloorMatrix p U.basis i j : ℚ) : ℝ)) = + (dyadicFloorMatrix p U.basis).map (fun q : ℚ ↦ (q : ℝ)) by rfl, + ← Rat.cast_det, hz] + simp + rw [hzeroReal] at hlower + have hpos : (0 : ℝ) < ((abs (Matrix.det U.basis) / 2 : ℚ) : ℝ) := by + exact_mod_cast div_pos (abs_pos.mpr hdet) (by norm_num : (0 : ℚ) < 2) + linarith + rw [scheduledRoundedEllipsoid, det_inflatedDyadicRound_basis] + exact mul_ne_zero + (pow_ne_zero _ (by + have hη := roundedEllipsoidInflation_pos hd + linarith)) hround + +theorem det_scheduledRoundedEllipsoidCentralUpdate_ne_zero {d p : ℕ} + (hd : 0 < d) (E : RationalEllipsoidState d) (a : Fin d → ℚ) + (hdet : Matrix.det E.basis ≠ 0) + (hb : rationalPulledBackNormal E a ≠ 0) + (hp : roundedEllipsoidPrecision + (rationalEllipsoidCentralUpdate E a) ≤ p) : + Matrix.det (scheduledRoundedEllipsoidCentralUpdate p E a).basis ≠ 0 := by + let U := rationalEllipsoidCentralUpdate E a + have hdetU : Matrix.det U.basis ≠ 0 := by + dsimp only [U] + rw [det_rationalEllipsoidCentralUpdate hd E a hb] + exact mul_ne_zero hdet (mul_ne_zero + (pow_ne_zero _ (rationalEllipsoidPerpScale_pos d).ne') + (rationalEllipsoidParallelScale_pos hd).ne') + exact det_scheduledRoundedEllipsoid_ne_zero hd U hdetU hp + +theorem scheduledRoundedEllipsoidCentralUpdate_contains {d p : ℕ} + (hd : 0 < d) (E : RationalEllipsoidState d) (a : Fin d → ℚ) + (hdet : Matrix.det E.basis ≠ 0) + (hb : rationalPulledBackNormal E a ≠ 0) + (hp : roundedEllipsoidPrecision + (rationalEllipsoidCentralUpdate E a) ≤ p) + {y : Fin d → ℝ} (hy : finiteNormSq y ≤ 1) + (hcut : finiteDot + (fun i ↦ (rationalPulledBackNormal E a i : ℝ)) y ≤ 0) : + ∃ y' : Fin d → ℝ, finiteNormSq y' ≤ 1 ∧ + rationalEllipsoidPoint + (scheduledRoundedEllipsoidCentralUpdate p E a) y' = + rationalEllipsoidPoint E y := by + let U := rationalEllipsoidCentralUpdate E a + have hdetU : Matrix.det U.basis ≠ 0 := by + dsimp only [U] + rw [det_rationalEllipsoidCentralUpdate hd E a hb] + exact mul_ne_zero hdet (mul_ne_zero + (pow_ne_zero _ (rationalEllipsoidPerpScale_pos d).ne') + (rationalEllipsoidParallelScale_pos hd).ne') + obtain ⟨z, hz, hpoint⟩ := + rationalEllipsoidCentralUpdate_contains hd E a hb hy hcut + obtain ⟨z', hz', hround⟩ := scheduledRounded_contains hd U hdetU hp hz + refine ⟨z', hz', ?_⟩ + rw [scheduledRoundedEllipsoidCentralUpdate, hround, hpoint] + +/-- A sufficiently fine scheduled rounded cut has the same uniform +determinant contraction as the proof-specification update. -/ +theorem abs_det_scheduledRoundedCentralUpdate_le {d p : ℕ} (hd : 0 < d) + (E : RationalEllipsoidState d) (a : Fin d → ℚ) + (hdet : Matrix.det E.basis ≠ 0) + (hb : rationalPulledBackNormal E a ≠ 0) + (hp : roundedEllipsoidPrecision + (rationalEllipsoidCentralUpdate E a) ≤ p) : + abs ((Matrix.det + (scheduledRoundedEllipsoidCentralUpdate p E a).basis : ℚ) : ℝ) ≤ + (1 - 1 / (32 * (d : ℝ) ^ 3)) * + abs ((Matrix.det E.basis : ℚ) : ℝ) := by + let U := rationalEllipsoidCentralUpdate E a + let Mq := rationalMatrixAbsBound U.basis + let η := roundedEllipsoidInflation d + let L : ℝ := d.factorial * + (d * (dyadicMesh p : ℝ) * (2 * (Mq : ℝ)) ^ d) + let ΔE : ℝ := abs ((Matrix.det E.basis : ℚ) : ℝ) + let ΔU : ℝ := abs ((Matrix.det U.basis : ℚ) : ℝ) + let q : ℝ := + (rationalEllipsoidPerpScale d : ℝ) ^ (d - 1) * + (rationalEllipsoidParallelScale d : ℝ) + have hdetU : Matrix.det U.basis ≠ 0 := by + dsimp only [U] + rw [det_rationalEllipsoidCentralUpdate hd E a hb] + exact mul_ne_zero hdet (mul_ne_zero + (pow_ne_zero _ (rationalEllipsoidPerpScale_pos d).ne') + (rationalEllipsoidParallelScale_pos hd).ne') + have hΔE0 : 0 ≤ ΔE := abs_nonneg _ + have hq0 : 0 ≤ q := by + dsimp only [q] + exact mul_nonneg + (pow_nonneg (Rat.cast_nonneg.mpr + (rationalEllipsoidPerpScale_pos d).le) _) + (Rat.cast_nonneg.mpr (rationalEllipsoidParallelScale_pos hd).le) + have hq1 : q ≤ 1 := (rationalEllipsoid_volumeFactor_lt_one hd).le + have hqContract : q ≤ 1 - 1 / (16 * (d : ℝ) ^ 3) := + rationalEllipsoid_volumeFactor_le_one_sub hd + have hΔeq : ΔU = ΔE * q := by + have hdetEq := det_rationalEllipsoidCentralUpdate hd E a hb + dsimp only [U, ΔU, ΔE, q] + rw [hdetEq, Rat.cast_mul, abs_mul] + norm_num only [Rat.cast_mul, Rat.cast_pow, Rat.cast_sub, + Rat.cast_div, Rat.cast_one, Rat.cast_natCast] + rw [abs_of_nonneg hq0] + have hΔUle : ΔU ≤ ΔE := by + rw [hΔeq] + simpa only [mul_one] using mul_le_mul_of_nonneg_left hq1 hΔE0 + have hMq1 : (1 : ℝ) ≤ (Mq : ℝ) := by + exact_mod_cast rationalMatrixAbsBound_one_le U.basis + have hUentry : ∀ i j, abs ((U.basis i j : ℚ) : ℝ) ≤ (Mq : ℝ) := by + intro i j + exact_mod_cast (abs_entry_lt_rationalMatrixAbsBound U.basis i j).le + have hupper0 := abs_det_inflatedDyadicRound_le p η U + (roundedEllipsoidInflation_nonneg d) hMq1 hUentry + have hupper : + abs ((Matrix.det + (scheduledRoundedEllipsoidCentralUpdate p E a).basis : ℚ) : ℝ) ≤ + (1 + (η : ℝ)) ^ d * (ΔU + L) := by + simpa only [scheduledRoundedEllipsoidCentralUpdate, + scheduledRoundedEllipsoid, U, η, ΔU, L] using hupper0 + have hlossQ := scheduled_determinant_rounding_loss_lt hd U hdetU hp + have hloss : L < ΔU / (128 * (d : ℝ) ^ 3) := by + have hc : + ((roundedDeterminantCoefficient d Mq * dyadicMesh p : ℚ) : ℝ) < + ((abs (Matrix.det U.basis) / (128 * d ^ 3) : ℚ) : ℝ) := by + exact_mod_cast hlossQ + norm_num only [roundedDeterminantCoefficient, Rat.cast_mul, + Rat.cast_pow, Rat.cast_natCast, Rat.cast_div] at hc + have hc' : L < + ((abs (Matrix.det U.basis) : ℚ) : ℝ) / + (128 * (d : ℝ) ^ 3) := by + dsimp only [L] + simpa [mul_assoc, mul_left_comm, mul_comm] using hc + have habsCast : ((abs (Matrix.det U.basis) : ℚ) : ℝ) = ΔU := by + dsimp only [ΔU] + exact_mod_cast (show abs (Matrix.det U.basis) = + abs (Matrix.det U.basis) by rfl) + rw [habsCast] at hc' + exact hc' + have hlossE : L ≤ ΔE / (128 * (d : ℝ) ^ 3) := by + have hden : 0 < (128 : ℝ) * (d : ℝ) ^ 3 := by positivity + exact hloss.le.trans (div_le_div_of_nonneg_right hΔUle hden.le) + have hbracket : ΔU + L ≤ + ΔE * (1 - 7 / (128 * (d : ℝ) ^ 3)) := by + rw [hΔeq] + have hq' : q ≤ 1 - 8 / (128 * (d : ℝ) ^ 3) := by + convert hqContract using 1 <;> ring + have hqmul := mul_le_mul_of_nonneg_left hq' hΔE0 + calc + ΔE * q + L ≤ + ΔE * (1 - 8 / (128 * (d : ℝ) ^ 3)) + + ΔE / (128 * (d : ℝ) ^ 3) := add_le_add hqmul hlossE + _ = ΔE * (1 - 7 / (128 * (d : ℝ) ^ 3)) := by ring + have hfactor0 : 0 ≤ 1 - 7 / (128 * (d : ℝ) ^ 3) := by + have hdR : (1 : ℝ) ≤ d := by exact_mod_cast hd + have hden : (7 : ℝ) ≤ 128 * (d : ℝ) ^ 3 := by + nlinarith [one_le_pow₀ (n := 3) hdR] + exact sub_nonneg.mpr + ((div_le_one (by positivity : (0 : ℝ) < 128 * (d : ℝ) ^ 3)).2 hden) + have hscale := roundedEllipsoidInflation_pow_bound hd + have hscale0 : 0 ≤ (1 + (η : ℝ)) ^ d := by + exact pow_nonneg (by + have hη0 : (0 : ℝ) ≤ (η : ℝ) := by + exact_mod_cast roundedEllipsoidInflation_nonneg d + linarith) _ + calc + abs ((Matrix.det + (scheduledRoundedEllipsoidCentralUpdate p E a).basis : ℚ) : ℝ) ≤ + (1 + (η : ℝ)) ^ d * (ΔU + L) := hupper + _ ≤ (1 + (η : ℝ)) ^ d * + (ΔE * (1 - 7 / (128 * (d : ℝ) ^ 3))) := + mul_le_mul_of_nonneg_left hbracket hscale0 + _ ≤ (1 + 1 / (512 * (d : ℝ) ^ 3)) * + (ΔE * (1 - 7 / (128 * (d : ℝ) ^ 3))) := by + exact mul_le_mul_of_nonneg_right hscale + (mul_nonneg hΔE0 hfactor0) + _ = ΔE * ((1 + 1 / (512 * (d : ℝ) ^ 3)) * + (1 - 7 / (128 * (d : ℝ) ^ 3))) := by ring + _ ≤ ΔE * (1 - 1 / (32 * (d : ℝ) ^ 3)) := + mul_le_mul_of_nonneg_left (roundedContraction_arithmetic hd) hΔE0 + _ = (1 - 1 / (32 * (d : ℝ) ^ 3)) * + abs ((Matrix.det E.basis : ℚ) : ℝ) := by + simp only [ΔE] + ring + +/-- A sufficiently fine scheduled rounded cut loses at most two binary bits +of determinant magnitude. -/ +theorem quarter_abs_det_le_scheduledRoundedCentralUpdate {d p : ℕ} + (hd : 0 < d) (E : RationalEllipsoidState d) (a : Fin d → ℚ) + (hdet : Matrix.det E.basis ≠ 0) + (hb : rationalPulledBackNormal E a ≠ 0) + (hp : roundedEllipsoidPrecision + (rationalEllipsoidCentralUpdate E a) ≤ p) : + (1 / 4 : ℝ) * abs ((Matrix.det E.basis : ℚ) : ℝ) ≤ + abs ((Matrix.det + (scheduledRoundedEllipsoidCentralUpdate p E a).basis : ℚ) : ℝ) := by + let U := rationalEllipsoidCentralUpdate E a + let η := roundedEllipsoidInflation d + let ΔE : ℝ := abs ((Matrix.det E.basis : ℚ) : ℝ) + let ΔU : ℝ := abs ((Matrix.det U.basis : ℚ) : ℝ) + let q : ℝ := + (rationalEllipsoidPerpScale d : ℝ) ^ (d - 1) * + (rationalEllipsoidParallelScale d : ℝ) + have hdetU : Matrix.det U.basis ≠ 0 := by + dsimp only [U] + rw [det_rationalEllipsoidCentralUpdate hd E a hb] + exact mul_ne_zero hdet (mul_ne_zero + (pow_ne_zero _ (rationalEllipsoidPerpScale_pos d).ne') + (rationalEllipsoidParallelScale_pos hd).ne') + have hq0 : 0 ≤ q := by + dsimp only [q] + exact mul_nonneg + (pow_nonneg (Rat.cast_nonneg.mpr + (rationalEllipsoidPerpScale_pos d).le) _) + (Rat.cast_nonneg.mpr (rationalEllipsoidParallelScale_pos hd).le) + have hΔeq : ΔU = ΔE * q := by + have hdetEq := det_rationalEllipsoidCentralUpdate hd E a hb + dsimp only [U, ΔU, ΔE, q] + rw [hdetEq, Rat.cast_mul, abs_mul] + norm_num only [Rat.cast_mul, Rat.cast_pow, Rat.cast_sub, + Rat.cast_div, Rat.cast_one, Rat.cast_natCast] + rw [abs_of_nonneg hq0] + have hqLower : (1 / 2 : ℝ) ≤ q := by + simpa only [q] using rationalEllipsoid_volumeFactor_ge_half hd + have hΔlower : (1 / 2 : ℝ) * ΔE ≤ ΔU := by + rw [hΔeq] + have hh : (1 / 2 : ℝ) * ΔE ≤ q * ΔE := + mul_le_mul_of_nonneg_right hqLower (by + dsimp only [ΔE] + exact abs_nonneg _) + simpa only [mul_comm] using hh + have hround0 := scheduledRounded_det_lower hd U hdetU hp + have hround : ΔU / 2 ≤ + abs (((Matrix.det (dyadicFloorMatrix p U.basis) : ℚ) : ℝ)) := by + have hcastDet : Matrix.det + (fun i j ↦ ((dyadicFloorMatrix p U.basis i j : ℚ) : ℝ)) = + ((Matrix.det (dyadicFloorMatrix p U.basis) : ℚ) : ℝ) := by + rw [show (fun i j ↦ + ((dyadicFloorMatrix p U.basis i j : ℚ) : ℝ)) = + (dyadicFloorMatrix p U.basis).map (fun q : ℚ ↦ (q : ℝ)) by rfl, + Rat.cast_det] + have habsCast : + (((abs (Matrix.det U.basis) : ℚ) : ℚ) : ℝ) = + abs (((Matrix.det U.basis : ℚ) : ℝ)) := by + exact_mod_cast (show abs (Matrix.det U.basis) = + abs (Matrix.det U.basis) by rfl) + norm_num only [Rat.cast_div, Rat.cast_ofNat] at hround0 + rw [hcastDet] at hround0 + simpa only [ΔU, habsCast] using hround0 + have hscale : (1 : ℝ) ≤ (1 + (η : ℝ)) ^ d := by + apply one_le_pow₀ + have hη0 : (0 : ℝ) ≤ (η : ℝ) := by + dsimp only [η] + exact_mod_cast roundedEllipsoidInflation_nonneg d + linarith + have hstored : + abs (((Matrix.det (dyadicFloorMatrix p U.basis) : ℚ) : ℝ)) ≤ + abs ((Matrix.det + (scheduledRoundedEllipsoidCentralUpdate p E a).basis : ℚ) : ℝ) := by + rw [scheduledRoundedEllipsoidCentralUpdate, scheduledRoundedEllipsoid, + det_inflatedDyadicRound_basis, Rat.cast_mul, abs_mul] + change abs (((1 + η) ^ d : ℚ) : ℝ) * + abs (((Matrix.det (dyadicFloorMatrix p U.basis) : ℚ) : ℝ)) ≥ _ + have hscaleAbs : (1 : ℝ) ≤ abs (((1 + η) ^ d : ℚ) : ℝ) := by + rw [Rat.cast_pow, Rat.cast_add, Rat.cast_one, + abs_of_nonneg (pow_nonneg (by + have hη0 : (0 : ℝ) ≤ (η : ℝ) := by + dsimp only [η] + exact_mod_cast roundedEllipsoidInflation_nonneg d + linarith) d)] + exact hscale + simpa only [one_mul] using mul_le_mul_of_nonneg_right hscaleAbs + (abs_nonneg (((Matrix.det (dyadicFloorMatrix p U.basis) : ℚ) : ℝ))) + calc + (1 / 4 : ℝ) * ΔE = ((1 / 2 : ℝ) * ΔE) / 2 := by ring + _ ≤ ΔU / 2 := div_le_div_of_nonneg_right hΔlower (by norm_num) + _ ≤ abs (((Matrix.det (dyadicFloorMatrix p U.basis) : ℚ) : ℝ)) := hround + _ ≤ abs ((Matrix.det + (scheduledRoundedEllipsoidCentralUpdate p E a).basis : ℚ) : ℝ) := + hstored + +theorem quarter_abs_det_le_scheduledRoundedCentralUpdate_rat {d p : ℕ} + (hd : 0 < d) (E : RationalEllipsoidState d) (a : Fin d → ℚ) + (hdet : Matrix.det E.basis ≠ 0) + (hb : rationalPulledBackNormal E a ≠ 0) + (hp : roundedEllipsoidPrecision + (rationalEllipsoidCentralUpdate E a) ≤ p) : + (1 / 4 : ℚ) * abs (Matrix.det E.basis) ≤ + abs (Matrix.det + (scheduledRoundedEllipsoidCentralUpdate p E a).basis) := by + have hreal := quarter_abs_det_le_scheduledRoundedCentralUpdate + hd E a hdet hb hp + have hcast : + ((((1 / 4 : ℚ) * abs (Matrix.det E.basis) : ℚ) : ℚ) : ℝ) ≤ + ((abs (Matrix.det + (scheduledRoundedEllipsoidCentralUpdate p E a).basis) : ℚ) : ℝ) := by + norm_num only [Rat.cast_mul, Rat.cast_div, Rat.cast_one, Rat.cast_ofNat] + exact_mod_cast hreal + exact Rat.cast_le.mp hcast + +theorem rationalMatrixAbsBound_scheduledRounded_le {d p : ℕ} + (hd : 0 < d) (U : RationalEllipsoidState d) : + rationalMatrixAbsBound (scheduledRoundedEllipsoid p U).basis ≤ + 5 * d ^ 2 * rationalMatrixAbsBound U.basis := by + let M := rationalMatrixAbsBound U.basis + let η := roundedEllipsoidInflation d + have hM1 : (1 : ℚ) ≤ M := rationalMatrixAbsBound_one_le U.basis + have hη0 : 0 ≤ η := roundedEllipsoidInflation_nonneg d + have hη1 : η ≤ 1 := roundedEllipsoidInflation_le_one hd + have hentry : ∀ i j, + abs ((scheduledRoundedEllipsoid p U).basis i j) ≤ 4 * M := by + intro i j + have hround := abs_dyadicFloor_le p (U.basis i j) + have hmesh := dyadicMesh_le_one p + have hU := (abs_entry_lt_rationalMatrixAbsBound U.basis i j).le + have hfloor : abs (dyadicFloor p (U.basis i j)) ≤ 2 * M := by + linarith + rw [scheduledRoundedEllipsoid, inflatedDyadicRound_basis_apply, abs_mul, + abs_of_nonneg (by linarith : 0 ≤ 1 + η)] + calc + (1 + η) * abs (dyadicFloor p (U.basis i j)) ≤ 2 * (2 * M) := + mul_le_mul (by linarith) hfloor (abs_nonneg _) (by linarith) + _ = 4 * M := by ring + rw [rationalMatrixAbsBound] + calc + 1 + ∑ i, ∑ j, abs ((scheduledRoundedEllipsoid p U).basis i j) ≤ + 1 + ∑ _i : Fin d, ∑ _j : Fin d, 4 * M := by + have hs0 : (∑ i : Fin d, ∑ j : Fin d, + abs ((scheduledRoundedEllipsoid p U).basis i j)) ≤ + ∑ _i : Fin d, ∑ _j : Fin d, 4 * M := by + apply Finset.sum_le_sum + intro i _ + apply Finset.sum_le_sum + intro j _ + exact hentry i j + have hs := add_le_add_left hs0 1 + simpa only [add_comm] using hs + _ = 1 + d ^ 2 * (4 * M) := by simp; ring + _ ≤ 5 * d ^ 2 * M := by + have hdq : (1 : ℚ) ≤ d := by exact_mod_cast hd + nlinarith [sq_nonneg ((d : ℚ) - 1)] + +theorem rationalCenterAbsBound_scheduledRounded_le {d p : ℕ} + (hd : 0 < d) (U : RationalEllipsoidState d) : + rationalCenterAbsBound (scheduledRoundedEllipsoid p U).center ≤ + rationalCenterAbsBound U.center + d := by + have hentry : ∀ i, + abs ((scheduledRoundedEllipsoid p U).center i) ≤ abs (U.center i) + 1 := by + intro i + have h := abs_dyadicFloor_le p (U.center i) + have hm := dyadicMesh_le_one p + have hadd : abs (U.center i) + dyadicMesh p ≤ + abs (U.center i) + 1 := by linarith + change abs (dyadicFloor p (U.center i)) ≤ abs (U.center i) + 1 + exact h.le.trans hadd + rw [rationalCenterAbsBound, rationalCenterAbsBound] + calc + 1 + ∑ i, abs ((scheduledRoundedEllipsoid p U).center i) ≤ + 1 + ∑ i, (abs (U.center i) + 1) := by + gcongr with i + exact hentry i + _ = (1 + ∑ i, abs (U.center i)) + d := by + rw [Finset.sum_add_distrib] + simp + ring + +theorem rationalStateAbsBound_scheduledRounded_le {d p : ℕ} + (hd : 0 < d) (U : RationalEllipsoidState d) : + rationalStateAbsBound (scheduledRoundedEllipsoid p U) ≤ + 7 * d ^ 2 * rationalStateAbsBound U := by + have hc := rationalCenterAbsBound_scheduledRounded_le (p := p) hd U + have hB := rationalMatrixAbsBound_scheduledRounded_le (p := p) hd U + have hdq : (1 : ℚ) ≤ d := by exact_mod_cast hd + have hT := rationalStateAbsBound_two_le U + have hc0 := rationalCenterAbsBound_one_le U.center + have hB0 := rationalMatrixAbsBound_one_le U.basis + rw [rationalStateAbsBound, rationalStateAbsBound] + calc + rationalCenterAbsBound (scheduledRoundedEllipsoid p U).center + + rationalMatrixAbsBound (scheduledRoundedEllipsoid p U).basis ≤ + (rationalCenterAbsBound U.center + d) + + 5 * d ^ 2 * rationalMatrixAbsBound U.basis := add_le_add hc hB + _ ≤ 7 * d ^ 2 * + (rationalCenterAbsBound U.center + rationalMatrixAbsBound U.basis) := by + have hBnonneg : 0 ≤ rationalMatrixAbsBound U.basis := + (rationalMatrixAbsBound_pos U.basis).le + nlinarith [sq_nonneg ((d : ℚ) - 1), + mul_nonneg (sq_nonneg (d : ℚ)) hBnonneg] + +theorem rationalMatrixAbsBound_scheduledCentralUpdate_le {d p : ℕ} + (hd : 0 < d) (E : RationalEllipsoidState d) (a : Fin d → ℚ) + (hb : rationalPulledBackNormal E a ≠ 0) : + rationalMatrixAbsBound + (scheduledRoundedEllipsoidCentralUpdate p E a).basis ≤ + 25 * d ^ 3 * rationalMatrixAbsBound E.basis := by + let U := rationalEllipsoidCentralUpdate E a + have hround := rationalMatrixAbsBound_scheduledRounded_le (p := p) hd U + have hexact := rationalMatrixAbsBound_centralUpdate_le hd E a hb + calc + rationalMatrixAbsBound + (scheduledRoundedEllipsoidCentralUpdate p E a).basis = + rationalMatrixAbsBound (scheduledRoundedEllipsoid p U).basis := by rfl + _ ≤ 5 * d ^ 2 * rationalMatrixAbsBound U.basis := hround + _ ≤ 5 * d ^ 2 * (5 * d * rationalMatrixAbsBound E.basis) := + mul_le_mul_of_nonneg_left hexact (by positivity) + _ = 25 * d ^ 3 * rationalMatrixAbsBound E.basis := by ring + +theorem rationalStateAbsBound_scheduledCentralUpdate_le {d p : ℕ} + (hd : 0 < d) (E : RationalEllipsoidState d) (a : Fin d → ℚ) + (hb : rationalPulledBackNormal E a ≠ 0) : + rationalStateAbsBound (scheduledRoundedEllipsoidCentralUpdate p E a) ≤ + 42 * d ^ 3 * rationalStateAbsBound E := by + let U := rationalEllipsoidCentralUpdate E a + have hround := rationalStateAbsBound_scheduledRounded_le (p := p) hd U + have hexact := rationalStateAbsBound_centralUpdate_le hd E a hb + calc + rationalStateAbsBound (scheduledRoundedEllipsoidCentralUpdate p E a) = + rationalStateAbsBound (scheduledRoundedEllipsoid p U) := by rfl + _ ≤ 7 * d ^ 2 * rationalStateAbsBound U := hround + _ ≤ 7 * d ^ 2 * (6 * d * rationalStateAbsBound E) := + mul_le_mul_of_nonneg_left hexact (by positivity) + _ = 42 * d ^ 3 * rationalStateAbsBound E := by ring + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/ScheduledRoundedEllipsoidIteration.lean b/LeanPool/BeyondBethe/BeyondBethe/ScheduledRoundedEllipsoidIteration.lean new file mode 100644 index 0000000000..9c3c01fdca --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/ScheduledRoundedEllipsoidIteration.lean @@ -0,0 +1,183 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.ScheduledRoundedEllipsoid +import Mathlib.Tactic + +/-! # Scheduled Rounded Ellipsoid Iteration -/ + +namespace BeyondBethe + +/-! +# Iteration of the determinant-independent schedule + +The theorem in this file is the bridge from the semantic one-step precision +requirement to a genuine implementation. One precision is computed from the +initial determinant exponent, initial magnitude exponent, and total cut +budget. Induction proves that it is sufficient at every reachable regular +state. No determinant is evaluated by the scheduled iteration. +-/ + +def scheduledRoundedEllipsoidIterate {d : ℕ} (p : ℕ) : + RationalEllipsoidState d → List (Fin d → ℚ) → RationalEllipsoidState d + | E, [] => E + | E, a :: cuts => scheduledRoundedEllipsoidIterate p + (scheduledRoundedEllipsoidCentralUpdate p E a) cuts + +def ScheduledCutSequenceRegular {d : ℕ} (p : ℕ) : + RationalEllipsoidState d → List (Fin d → ℚ) → Prop + | _, [] => True + | E, a :: cuts => + rationalPulledBackNormal E a ≠ 0 ∧ + ScheduledCutSequenceRegular p + (scheduledRoundedEllipsoidCentralUpdate p E a) cuts + +theorem dyadicMesh_add_two_step (L t : ℕ) : + dyadicMesh (L + 2 * (t + 1)) = + (1 / 4 : ℚ) * dyadicMesh (L + 2 * t) := by + rw [dyadicMesh_add_two_mul, dyadicMesh_add_two_mul, pow_succ] + ring + +private theorem scheduled_state_step_two_pow {d K t : ℕ} (hd : 0 < d) + (E : RationalEllipsoidState d) (a : Fin d → ℚ) (p : ℕ) + (hb : rationalPulledBackNormal E a ≠ 0) + (hM : rationalStateAbsBound E ≤ + (2 : ℚ) ^ (K + t * (6 + 3 * d))) : + rationalStateAbsBound (scheduledRoundedEllipsoidCentralUpdate p E a) ≤ + (2 : ℚ) ^ (K + (t + 1) * (6 + 3 * d)) := by + have hstep := rationalStateAbsBound_scheduledCentralUpdate_le + (p := p) hd E a hb + have hfactor := roundedEllipsoidStateGrowthFactor_le_two_pow d + have hstate0 : 0 ≤ rationalStateAbsBound E := by + linarith [rationalStateAbsBound_two_le E] + calc + rationalStateAbsBound (scheduledRoundedEllipsoidCentralUpdate p E a) ≤ + (42 * d ^ 3 : ℚ) * rationalStateAbsBound E := hstep + _ ≤ (2 : ℚ) ^ (6 + 3 * d) * + (2 : ℚ) ^ (K + t * (6 + 3 * d)) := + mul_le_mul hfactor hM hstate0 (by positivity) + _ = (2 : ℚ) ^ (K + (t + 1) * (6 + 3 * d)) := by + rw [← pow_add] + congr 1 + ring + +/-- The three quantitative facts carried by a scheduled run after `t` cuts. -/ +structure ScheduledEllipsoidInvariant (d L K t : ℕ) + (E : RationalEllipsoidState d) : Prop where + det_ne_zero : Matrix.det E.basis ≠ 0 + det_lower : dyadicMesh (L + 2 * t) ≤ abs (Matrix.det E.basis) + magnitude : rationalStateAbsBound E ≤ + (2 : ℚ) ^ (K + t * (6 + 3 * d)) + +/-- The schedule is sufficient for the next cut, and the next state satisfies +the invariant at time `t+1`. -/ +theorem ScheduledEllipsoidInvariant.advance + {d L K T t : ℕ} (hd : 0 < d) + {E : RationalEllipsoidState d} + (hE : ScheduledEllipsoidInvariant d L K t E) + (a : Fin d → ℚ) (hb : rationalPulledBackNormal E a ≠ 0) + (htT : t ≤ T) : + let P := roundedEllipsoidPrecisionSchedule d L K T + let U := rationalEllipsoidCentralUpdate E a + let E₁ := scheduledRoundedEllipsoidCentralUpdate P E a + roundedEllipsoidPrecision U ≤ P ∧ + ScheduledEllipsoidInvariant d L K (t + 1) E₁ := by + let P := roundedEllipsoidPrecisionSchedule d L K T + let U := rationalEllipsoidCentralUpdate E a + let E₁ := scheduledRoundedEllipsoidCentralUpdate P E a + have hsemantic0 := rationalEllipsoidCentralUpdate_precision_upper + hd E a hb hE.det_lower hE.magnitude + have hsemantic : roundedEllipsoidPrecision U ≤ + roundedEllipsoidNextPrecisionBound d L K t := by + simpa only [U, roundedEllipsoidNextPrecisionBound] using hsemantic0 + have hp : roundedEllipsoidPrecision U ≤ P := + hsemantic.trans (roundedEllipsoidNextPrecisionBound_le_schedule htT) + have hdet₁ : Matrix.det E₁.basis ≠ 0 := by + dsimp only [E₁, P, U] at hp ⊢ + exact det_scheduledRoundedEllipsoidCentralUpdate_ne_zero + hd E a hE.det_ne_zero hb hp + have hquarter := quarter_abs_det_le_scheduledRoundedCentralUpdate_rat + hd E a hE.det_ne_zero hb hp + have hdetLower₁ : dyadicMesh (L + 2 * (t + 1)) ≤ + abs (Matrix.det E₁.basis) := by + rw [dyadicMesh_add_two_step] + exact (mul_le_mul_of_nonneg_left hE.det_lower (by norm_num)).trans + (by simpa only [E₁, P] using hquarter) + have hM₁ : rationalStateAbsBound E₁ ≤ + (2 : ℚ) ^ (K + (t + 1) * (6 + 3 * d)) := by + dsimp only [E₁, P] + exact scheduled_state_step_two_pow hd E a _ hb hE.magnitude + exact ⟨hp, hdet₁, hdetLower₁, hM₁⟩ + +/-- One fixed precision, computed before the run, dominates every semantic +precision requirement and preserves the determinant and magnitude invariants +through an arbitrary regular cut sequence of the budgeted length. -/ +theorem scheduledRoundedEllipsoidIterate_invariants + {d L K T t : ℕ} (hd : 0 < d) + (E : RationalEllipsoidState d) + (hdet : Matrix.det E.basis ≠ 0) + (hdetLower : dyadicMesh (L + 2 * t) ≤ abs (Matrix.det E.basis)) + (hM : rationalStateAbsBound E ≤ + (2 : ℚ) ^ (K + t * (6 + 3 * d))) + (cuts : List (Fin d → ℚ)) + (hregular : ScheduledCutSequenceRegular + (roundedEllipsoidPrecisionSchedule d L K T) E cuts) + (hbudget : t + cuts.length ≤ T) : + let E' := scheduledRoundedEllipsoidIterate + (roundedEllipsoidPrecisionSchedule d L K T) E cuts + Matrix.det E'.basis ≠ 0 ∧ + dyadicMesh (L + 2 * (t + cuts.length)) ≤ + abs (Matrix.det E'.basis) ∧ + rationalStateAbsBound E' ≤ + (2 : ℚ) ^ (K + (t + cuts.length) * (6 + 3 * d)) := by + induction cuts generalizing E t with + | nil => + simpa [scheduledRoundedEllipsoidIterate] using + And.intro hdet (And.intro hdetLower hM) + | cons a cuts ih => + let P := roundedEllipsoidPrecisionSchedule d L K T + let E₁ := scheduledRoundedEllipsoidCentralUpdate P E a + have hb : rationalPulledBackNormal E a ≠ 0 := hregular.1 + have htT : t ≤ T := by omega + let hInv : ScheduledEllipsoidInvariant d L K t E := + ⟨hdet, hdetLower, hM⟩ + have hadvance := hInv.advance hd a hb htT + have hInv₁ : ScheduledEllipsoidInvariant d L K (t + 1) E₁ := by + simpa only [E₁, P] using hadvance.2 + have hbudgetTail : (t + 1) + cuts.length ≤ T := by + simpa only [List.length_cons, Nat.add_assoc, Nat.add_comm, + Nat.add_left_comm] using hbudget + have htail := ih (E := E₁) (t := t + 1) hInv₁.det_ne_zero + hInv₁.det_lower hInv₁.magnitude + hregular.2 hbudgetTail + have hindex : t + 1 + cuts.length = t + (cuts.length + 1) := by + omega + simpa only [scheduledRoundedEllipsoidIterate, E₁, P, + List.length_cons, hindex] using htail + +/-- Initial-state specialization of the scheduled invariants. -/ +theorem scheduledRoundedEllipsoidIterate_from_initial + {d L K T : ℕ} (hd : 0 < d) + (E : RationalEllipsoidState d) + (hdet : Matrix.det E.basis ≠ 0) + (hdetLower : dyadicMesh L ≤ abs (Matrix.det E.basis)) + (hM : rationalStateAbsBound E ≤ (2 : ℚ) ^ K) + (cuts : List (Fin d → ℚ)) + (hregular : ScheduledCutSequenceRegular + (roundedEllipsoidPrecisionSchedule d L K T) E cuts) + (hbudget : cuts.length ≤ T) : + let E' := scheduledRoundedEllipsoidIterate + (roundedEllipsoidPrecisionSchedule d L K T) E cuts + Matrix.det E'.basis ≠ 0 ∧ + dyadicMesh (L + 2 * cuts.length) ≤ abs (Matrix.det E'.basis) ∧ + rationalStateAbsBound E' ≤ + (2 : ℚ) ^ (K + cuts.length * (6 + 3 * d)) := by + simpa using scheduledRoundedEllipsoidIterate_invariants + (L := L) (K := K) (T := T) (t := 0) hd E hdet + (by simpa using hdetLower) (by simpa using hM) cuts hregular + (by omega) + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/Sequential.lean b/LeanPool/BeyondBethe/BeyondBethe/Sequential.lean new file mode 100644 index 0000000000..4098174ffd --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/Sequential.lean @@ -0,0 +1,366 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.Gibbs +import LeanPool.BeyondBethe.BeyondBethe.Transfer +import LeanPool.BeyondBethe.BeyondBethe.SequentialNormalization +import Mathlib.Tactic + +/-! # Sequential -/ + +open scoped BigOperators + +namespace BeyondBethe + +/-- A distribution on Mathlib permutations has row-column marginals `P` in +the orientation `σ column = row`. -/ +def HasAssignmentMarginals + {n : ℕ} (μ : Equiv.Perm (Fin n) → ℝ) + (P : Matrix (Fin n) (Fin n) ℝ) : Prop := + ∀ i j, P i j = ∑ σ, if σ j = i then μ σ else 0 + +theorem gibbs_hasAssignmentMarginals + {n : ℕ} (A : Matrix (Fin n) (Fin n) ℝ) : + HasAssignmentMarginals (gibbsProbability A) (assignmentMarginal A) := by + intro i j + exact assignmentMarginal_eq_gibbs_sum A i j + +/-- The column ordering induced by a row ordering `π` and a matching `σ`. +Mathlib represents `σ` from columns to rows, hence the inverse here. -/ +def inducedColumnOrder + {n : ℕ} (π σ : Equiv.Perm (Fin n)) : Equiv.Perm (Fin n) := + π.trans σ.symm + +/-- For a fixed row order, sending a matching to its induced column order is +a bijection. -/ +def inducedColumnOrderEquiv + {n : ℕ} (π : Equiv.Perm (Fin n)) : + Equiv.Perm (Fin n) ≃ Equiv.Perm (Fin n) where + toFun σ := inducedColumnOrder π σ + invFun θ := θ.symm.trans π + left_inv σ := by + ext i + simp [inducedColumnOrder, Equiv.trans_apply] + right_inv θ := by + ext i + simp [inducedColumnOrder, Equiv.trans_apply] + +theorem orderedSuffixWeight_eq_suffixMass + {n : ℕ} (W : Fin n → Fin n → ℝ) + (θ : Equiv.Perm (Fin n)) (t : Fin n) : + orderedSuffixWeight W θ t = suffixMass (W t) θ (θ t) := by + rw [suffixMass, ← Equiv.sum_comp θ] + simp [orderedSuffixWeight] + +/-- Likelihood of a matching under the sequential experiment for a fixed row +ordering. -/ +noncomputable def sequentialLikelihood + {n : ℕ} (P : Matrix (Fin n) (Fin n) ℝ) + (π σ : Equiv.Perm (Fin n)) : ℝ := + ∏ i, P i (σ.symm i) / + suffixMass (P i) (inducedColumnOrder π σ) (σ.symm i) + +/-- The paper's row-indexed formula is exactly the canonical sequential +likelihood after reindexing the rows by `π`. -/ +theorem sequentialLikelihood_eq_ordered + {n : ℕ} (P : Matrix (Fin n) (Fin n) ℝ) + (π σ : Equiv.Perm (Fin n)) : + sequentialLikelihood P π σ = + orderedSequentialLikelihood + (fun t j ↦ P (π t) j) (inducedColumnOrder π σ) := by + rw [sequentialLikelihood, orderedSequentialLikelihood, + ← Equiv.prod_comp π] + apply Finset.prod_congr rfl + intro t _ + change P (π t) (σ.symm (π t)) / + suffixMass (P (π t)) (inducedColumnOrder π σ) + (σ.symm (π t)) = + P (π t) ((inducedColumnOrder π σ) t) / + orderedSuffixWeight (fun s j ↦ P (π s) j) + (inducedColumnOrder π σ) t + rw [orderedSuffixWeight_eq_suffixMass] + rfl + +theorem sequentialLikelihood_pos + {n : ℕ} {P : Matrix (Fin n) (Fin n) ℝ} + (hP : ∀ i, IsStrictProbabilityVector (P i)) + (π σ : Equiv.Perm (Fin n)) : + 0 < sequentialLikelihood P π σ := by + rw [sequentialLikelihood] + apply Finset.prod_pos + intro i _ + exact div_pos ((hP i).2 (σ.symm i)) + (suffixMass_pos (hP i).1 ((hP i).2 (σ.symm i)) _) + +/-- For every fixed row order, the sequential likelihood is a probability +vector. This closes the normalization that is implicit in the paper's +description of the sequential experiment. -/ +theorem sequentialLikelihood_isProbabilityVector + {n : ℕ} {P : Matrix (Fin n) (Fin n) ℝ} + (hP : ∀ i, IsStrictProbabilityVector (P i)) + (π : Equiv.Perm (Fin n)) : + IsProbabilityVector (sequentialLikelihood P π) := by + constructor + · intro σ + exact (sequentialLikelihood_pos hP π σ).le + · simp_rw [sequentialLikelihood_eq_ordered] + calc + ∑ σ : Equiv.Perm (Fin n), + orderedSequentialLikelihood (fun t j ↦ P (π t) j) + (inducedColumnOrder π σ) = + ∑ θ : Equiv.Perm (Fin n), + orderedSequentialLikelihood (fun t j ↦ P (π t) j) θ := + Equiv.sum_comp (inducedColumnOrderEquiv π) + (orderedSequentialLikelihood (fun t j ↦ P (π t) j)) + _ = 1 := orderedSequentialLikelihood_sum_eq_one n + (fun t j ↦ P (π t) j) (fun t j ↦ (hP (π t)).2 j) + +theorem finiteKL_sequential_nonneg + {n : ℕ} {P : Matrix (Fin n) (Fin n) ℝ} + {p : Equiv.Perm (Fin n) → ℝ} + (hp : IsProbabilityVector p) (hppos : ∀ σ, 0 < p σ) + (hP : ∀ i, IsStrictProbabilityVector (P i)) + (π : Equiv.Perm (Fin n)) : + 0 ≤ finiteKL p (sequentialLikelihood P π) := + finiteKL_nonneg hp (sequentialLikelihood_isProbabilityVector hP π) + hppos (sequentialLikelihood_pos hP π) + +theorem log_sequentialLikelihood + {n : ℕ} {P : Matrix (Fin n) (Fin n) ℝ} + (hP : ∀ i, IsStrictProbabilityVector (P i)) + (π σ : Equiv.Perm (Fin n)) : + Real.log (sequentialLikelihood P π σ) = + ∑ i, (Real.log (P i (σ.symm i)) - + Real.log (suffixMass (P i) (inducedColumnOrder π σ) (σ.symm i))) := by + rw [sequentialLikelihood, Real.log_prod] + · apply Finset.sum_congr rfl + intro i _ + rw [Real.log_div ((hP i).2 (σ.symm i)).ne' + (suffixMass_pos (hP i).1 ((hP i).2 (σ.symm i)) _).ne'] + · intro i _ + exact (div_pos ((hP i).2 (σ.symm i)) + (suffixMass_pos (hP i).1 ((hP i).2 (σ.symm i)) _)).ne' + +/-- Right composition by a fixed permutation is a bijection on orderings. -/ +def permTransEquiv {n : ℕ} (τ : Equiv.Perm (Fin n)) : + Equiv.Perm (Fin n) ≃ Equiv.Perm (Fin n) where + toFun (π : Equiv.Perm (Fin n)) := π.trans τ + invFun (θ : Equiv.Perm (Fin n)) := θ.trans τ.symm + left_inv π := by + ext i + simp [Equiv.trans_apply] + right_inv θ := by + ext i + simp [Equiv.trans_apply] + +theorem uniformAverage_perm_trans + {n : ℕ} (f : Equiv.Perm (Fin n) → ℝ) + (τ : Equiv.Perm (Fin n)) : + uniformAverage (fun π : Equiv.Perm (Fin n) ↦ f (π.trans τ)) = uniformAverage f := by + rw [uniformAverage, uniformAverage] + congr 1 + exact (permTransEquiv τ).sum_comp f + +/-- Averaging an induced column ordering over uniform row orderings gives the +uniform average over column orderings. -/ +theorem average_induced_suffix + {n : ℕ} (p : Fin n → ℝ) (σ : Equiv.Perm (Fin n)) (j : Fin n) : + uniformAverage (fun π ↦ + Real.log (suffixMass p (inducedColumnOrder π σ) j)) = + uniformAverage (fun θ ↦ Real.log (suffixMass p θ j)) := by + exact uniformAverage_perm_trans + (fun θ ↦ Real.log (suffixMass p θ j)) σ.symm + +theorem uniformAverage_const {α : Type*} [Fintype α] [Nonempty α] + (c : ℝ) : uniformAverage (fun _ : α ↦ c) = c := by + rw [uniformAverage, Finset.sum_const, Finset.card_univ, nsmul_eq_mul] + field_simp [Fintype.card_ne_zero] + +theorem uniformAverage_sub + {α : Type*} [Fintype α] (f g : α → ℝ) : + uniformAverage (fun x ↦ f x - g x) = + uniformAverage f - uniformAverage g := by + simp [uniformAverage, Finset.sum_sub_distrib, sub_div] + +theorem uniformAverage_add + {α : Type*} [Fintype α] (f g : α → ℝ) : + uniformAverage (fun x ↦ f x + g x) = + uniformAverage f + uniformAverage g := by + simp [uniformAverage, Finset.sum_add_distrib, add_div] + +theorem uniformAverage_sum + {α ι : Type*} [Fintype α] [Fintype ι] + (f : α → ι → ℝ) : + uniformAverage (fun x ↦ ∑ i, f x i) = + ∑ i, uniformAverage (fun x ↦ f x i) := by + rw [uniformAverage] + simp_rw [uniformAverage, ← Finset.sum_div] + rw [Finset.sum_comm] + +theorem uniformAverage_const_mul + {α : Type*} [Fintype α] (c : ℝ) (f : α → ℝ) : + uniformAverage (fun x ↦ c * f x) = c * uniformAverage f := by + simp [uniformAverage, ← Finset.mul_sum, mul_div_assoc] + +theorem uniformAverage_nonneg + {α : Type*} [Fintype α] (f : α → ℝ) + (hf : ∀ x, 0 ≤ f x) : + 0 ≤ uniformAverage f := by + exact div_nonneg (Finset.sum_nonneg fun x _ ↦ hf x) (Nat.cast_nonneg _) + +/-- Marginal expectation for the column assigned to a fixed row. -/ +theorem marginal_expectation_row + {n : ℕ} {μ : Equiv.Perm (Fin n) → ℝ} + {P : Matrix (Fin n) (Fin n) ℝ} + (hmarg : HasAssignmentMarginals μ P) + (i : Fin n) (f : Fin n → ℝ) : + ∑ σ, μ σ * f (σ.symm i) = ∑ j, P i j * f j := by + classical + simp_rw [hmarg i, Finset.sum_mul] + rw [Finset.sum_comm] + apply Finset.sum_congr rfl + intro σ _ + rw [Finset.sum_eq_single (σ.symm i)] + · simp + · intro j _ hj + have hne : σ j ≠ i := by + intro h + apply hj + simpa using congrArg σ.symm h + simp [hne] + · simp + +/-- Rewriting `T(p)` by first fixing the sampled coordinate and then +averaging the ordering. -/ +theorem rowT_eq_sum_mul_average_suffix + {n : ℕ} (p : Fin n → ℝ) : + rowT p = ∑ j, p j * uniformAverage (fun θ : Equiv.Perm (Fin n) ↦ + Real.log (suffixMass p θ j)) := by + unfold rowT uniformAverage + rw [Finset.sum_comm] + rw [Finset.sum_div] + apply Finset.sum_congr rfl + intro j _ + rw [← Finset.mul_sum] + ring + +/-- The expected log numerator of the sequential likelihood is determined by +the assignment marginals. -/ +theorem expected_log_sequential_numerator + {n : ℕ} {μ : Equiv.Perm (Fin n) → ℝ} + {P : Matrix (Fin n) (Fin n) ℝ} + (hmarg : HasAssignmentMarginals μ P) : + ∑ σ, μ σ * (∑ i, Real.log (P i (σ.symm i))) = + ∑ i, ∑ j, P i j * Real.log (P i j) := by + simp_rw [Finset.mul_sum] + rw [Finset.sum_comm] + apply Finset.sum_congr rfl + intro i _ + exact marginal_expectation_row hmarg i (fun j ↦ Real.log (P i j)) + +/-- Averaging the log denominators in the sequential likelihood gives the +sum of the row suffix scores. -/ +theorem averaged_log_sequential_denominator + {n : ℕ} {μ : Equiv.Perm (Fin n) → ℝ} + {P : Matrix (Fin n) (Fin n) ℝ} + (hmarg : HasAssignmentMarginals μ P) : + uniformAverage (fun π : Equiv.Perm (Fin n) ↦ + ∑ σ, μ σ * (∑ i, + Real.log (suffixMass (P i) (inducedColumnOrder π σ) (σ.symm i)))) = + ∑ i, rowT (P i) := by + rw [uniformAverage_sum] + simp_rw [uniformAverage_const_mul, uniformAverage_sum] + simp_rw [Finset.mul_sum] + rw [Finset.sum_comm] + have havg : ∀ (σ : Equiv.Perm (Fin n)) (i : Fin n), + uniformAverage (fun π : Equiv.Perm (Fin n) ↦ + Real.log (suffixMass (P i) (inducedColumnOrder π σ) (σ.symm i))) = + uniformAverage (fun θ : Equiv.Perm (Fin n) ↦ + Real.log (suffixMass (P i) θ (σ.symm i))) := + fun σ i ↦ average_induced_suffix (P i) σ (σ.symm i) + simp_rw [havg] + apply Finset.sum_congr rfl + intro i _ + let f : Fin n → ℝ := fun j ↦ + uniformAverage (fun θ : Equiv.Perm (Fin n) ↦ + Real.log (suffixMass (P i) θ j)) + calc + ∑ σ, μ σ * uniformAverage (fun θ : Equiv.Perm (Fin n) ↦ + Real.log (suffixMass (P i) θ (σ.symm i))) = + ∑ j, P i j * f j := marginal_expectation_row hmarg i f + _ = rowT (P i) := (rowT_eq_sum_mul_average_suffix (P i)).symm + +/-- Exact entropy expansion of the averaged sequential KL divergence. -/ +theorem averagedSequentialKL_identity + {n : ℕ} {μ : Equiv.Perm (Fin n) → ℝ} + {P : Matrix (Fin n) (Fin n) ℝ} + (hμpos : ∀ σ, 0 < μ σ) + (hP : ∀ i, IsStrictProbabilityVector (P i)) + (hmarg : HasAssignmentMarginals μ P) : + uniformAverage (fun π : Equiv.Perm (Fin n) ↦ + finiteKL μ (sequentialLikelihood P π)) = + -shannonEntropy μ - (∑ i, ∑ j, P i j * Real.log (P i j)) + + ∑ i, rowT (P i) := by + have hKL : ∀ π : Equiv.Perm (Fin n), + finiteKL μ (sequentialLikelihood P π) = + -shannonEntropy μ - + ∑ σ, μ σ * Real.log (sequentialLikelihood P π σ) := by + intro π + exact finiteKL_eq_neg_entropy_sub hμpos + (sequentialLikelihood_pos hP π) + have hlog : uniformAverage (fun π : Equiv.Perm (Fin n) ↦ + ∑ σ, μ σ * Real.log (sequentialLikelihood P π σ)) = + (∑ i, ∑ j, P i j * Real.log (P i j)) - ∑ i, rowT (P i) := by + have hpoint : ∀ π : Equiv.Perm (Fin n), + (∑ σ, μ σ * Real.log (sequentialLikelihood P π σ)) = + (∑ σ, μ σ * (∑ i, Real.log (P i (σ.symm i)))) - + ∑ σ, μ σ * (∑ i, + Real.log (suffixMass (P i) + (inducedColumnOrder π σ) (σ.symm i))) := by + intro π + calc + ∑ σ, μ σ * Real.log (sequentialLikelihood P π σ) = + ∑ σ, μ σ * (∑ i, + (Real.log (P i (σ.symm i)) - + Real.log (suffixMass (P i) + (inducedColumnOrder π σ) (σ.symm i)))) := by + apply Finset.sum_congr rfl + intro σ _ + rw [log_sequentialLikelihood hP] + _ = (∑ σ, μ σ * (∑ i, Real.log (P i (σ.symm i)))) - + ∑ σ, μ σ * (∑ i, + Real.log (suffixMass (P i) + (inducedColumnOrder π σ) (σ.symm i))) := by + simp_rw [Finset.sum_sub_distrib, mul_sub, + Finset.sum_sub_distrib] + simp_rw [hpoint] + rw [uniformAverage_sub, + uniformAverage_const, + averaged_log_sequential_denominator hmarg, + expected_log_sequential_numerator hmarg] + simp_rw [hKL] + rw [uniformAverage_sub, uniformAverage_const, hlog] + ring + +/-- Average divergence between a target law and the sequential laws over all +row orderings. -/ +noncomputable def averagedSequentialDivergence + {n : ℕ} (μ : Equiv.Perm (Fin n) → ℝ) + (P : Matrix (Fin n) (Fin n) ℝ) : ℝ := + uniformAverage (fun π : Equiv.Perm (Fin n) ↦ + finiteKL μ (sequentialLikelihood P π)) + +theorem averagedSequentialDivergence_nonneg + {n : ℕ} {P : Matrix (Fin n) (Fin n) ℝ} + {p : Equiv.Perm (Fin n) → ℝ} + (hp : IsProbabilityVector p) (hppos : ∀ σ, 0 < p σ) + (hP : ∀ i, IsStrictProbabilityVector (P i)) : + 0 ≤ averagedSequentialDivergence p P := by + apply uniformAverage_nonneg + intro π + exact finiteKL_sequential_nonneg hp hppos hP π + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/SequentialNormalization.lean b/LeanPool/BeyondBethe/BeyondBethe/SequentialNormalization.lean new file mode 100644 index 0000000000..9ad8edb030 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/SequentialNormalization.lean @@ -0,0 +1,118 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.Entropy +import Mathlib.GroupTheory.Perm.Fin +import Mathlib.Tactic + +/-! # Sequential Normalization -/ + +open scoped BigOperators + +namespace BeyondBethe + +/-- Total weight still available to position `t` when the columns are exposed +in the order `θ`. This is the position-indexed version of `suffixMass`. -/ +noncomputable def orderedSuffixWeight + {n : ℕ} (W : Fin n → Fin n → ℝ) + (θ : Equiv.Perm (Fin n)) (t : Fin n) : ℝ := + ∑ s, if t ≤ s then W t (θ s) else 0 + +/-- The probability of one complete outcome of sequential sampling without +replacement, with rows processed in their natural order. -/ +noncomputable def orderedSequentialLikelihood + {n : ℕ} (W : Fin n → Fin n → ℝ) + (θ : Equiv.Perm (Fin n)) : ℝ := + ∏ t, W t (θ t) / orderedSuffixWeight W θ t + +/-- After the first column `p` is chosen, `tailWeight W p` is the smaller +instance obtained by deleting the first row and that column. The swap is the +one used by Mathlib's canonical decomposition of a permutation of `Fin (n+1)`. +-/ +def tailWeight {n : ℕ} + (W : Fin (n + 1) → Fin (n + 1) → ℝ) (p : Fin (n + 1)) : + Fin n → Fin n → ℝ := + fun i j ↦ W i.succ ((Equiv.swap 0 p) j.succ) + +theorem orderedSuffixWeight_zero + {n : ℕ} (W : Fin (n + 1) → Fin (n + 1) → ℝ) + (θ : Equiv.Perm (Fin (n + 1))) : + orderedSuffixWeight W θ 0 = ∑ j, W 0 j := by + unfold orderedSuffixWeight + simp only [Fin.zero_le, ↓reduceIte] + exact Equiv.sum_comp θ (W 0) + +theorem orderedSuffixWeight_decompose_succ + {n : ℕ} (W : Fin (n + 1) → Fin (n + 1) → ℝ) + (p : Fin (n + 1)) (e : Equiv.Perm (Fin n)) (i : Fin n) : + orderedSuffixWeight W (Equiv.Perm.decomposeFin.symm (p, e)) i.succ = + orderedSuffixWeight (tailWeight W p) e i := by + unfold orderedSuffixWeight tailWeight + rw [Fin.sum_univ_succ] + simp + +theorem orderedSequentialLikelihood_decompose + {n : ℕ} (W : Fin (n + 1) → Fin (n + 1) → ℝ) + (p : Fin (n + 1)) (e : Equiv.Perm (Fin n)) : + orderedSequentialLikelihood W (Equiv.Perm.decomposeFin.symm (p, e)) = + (W 0 p / ∑ j, W 0 j) * orderedSequentialLikelihood (tailWeight W p) e := by + rw [orderedSequentialLikelihood, Fin.prod_univ_succ, + Equiv.Perm.decomposeFin_symm_apply_zero, + orderedSuffixWeight_zero, orderedSequentialLikelihood] + congr 1 + apply Finset.prod_congr rfl + intro i _ + rw [Equiv.Perm.decomposeFin_symm_apply_succ, + orderedSuffixWeight_decompose_succ] + rfl + +/-- Sequential choice probabilities sum to one. The proof is the chain rule: +split a permutation according to its first chosen column and apply induction to +the remaining rows and columns. -/ +theorem orderedSequentialLikelihood_sum_eq_one : + ∀ (n : ℕ) (W : Fin n → Fin n → ℝ), + (∀ i j, 0 < W i j) → + ∑ θ : Equiv.Perm (Fin n), orderedSequentialLikelihood W θ = 1 := by + intro n + induction n with + | zero => + intro W _ + simp [orderedSequentialLikelihood] + | succ n ih => + intro W hW + have htail : ∀ p i j, 0 < tailWeight W p i j := by + intro p i j + exact hW i.succ ((Equiv.swap 0 p) j.succ) + have hrow : 0 < ∑ j, W 0 j := + Finset.sum_pos (fun j _ ↦ hW 0 j) ⟨0, Finset.mem_univ 0⟩ + calc + ∑ θ : Equiv.Perm (Fin (n + 1)), orderedSequentialLikelihood W θ = + ∑ pe : Fin (n + 1) × Equiv.Perm (Fin n), + orderedSequentialLikelihood W + (Equiv.Perm.decomposeFin.symm pe) := + (Equiv.sum_comp Equiv.Perm.decomposeFin.symm + (orderedSequentialLikelihood W)).symm + _ = ∑ p, ∑ e, + orderedSequentialLikelihood W + (Equiv.Perm.decomposeFin.symm (p, e)) := + Fintype.sum_prod_type _ + _ = ∑ p, ∑ e, + (W 0 p / ∑ j, W 0 j) * + orderedSequentialLikelihood (tailWeight W p) e := by + simp_rw [orderedSequentialLikelihood_decompose] + _ = ∑ p, (W 0 p / ∑ j, W 0 j) * + (∑ e, orderedSequentialLikelihood (tailWeight W p) e) := by + apply Finset.sum_congr rfl + intro p _ + rw [Finset.mul_sum] + _ = ∑ p, W 0 p / ∑ j, W 0 j := by + apply Finset.sum_congr rfl + intro p _ + rw [ih (tailWeight W p) (htail p), mul_one] + _ = 1 := by + rw [← Finset.sum_div, div_self hrow.ne'] + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/Slack.lean b/LeanPool/BeyondBethe/BeyondBethe/Slack.lean new file mode 100644 index 0000000000..f359a27fb9 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/Slack.lean @@ -0,0 +1,164 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.Bethe +import LeanPool.BeyondBethe.BeyondBethe.Sequential +import Mathlib.Tactic + +/-! # Slack -/ + +open scoped BigOperators + +namespace BeyondBethe + +/-- Row score `s(p)=H(p)+T(p)` from paper (24). -/ +noncomputable def rowScore + {m : ℕ} (p : Fin m → ℝ) : ℝ := + shannonEntropy p + rowT p + +/-- Direct cancellation between the Bethe objective and the row corrections. +This is the algebraic core of paper Lemma 10. -/ +theorem bethe_add_rowCorrection_eq_logWeight_add_rowScore + {m : ℕ} (A P : Matrix (Fin m) (Fin m) ℝ) : + betheObjective A P + ∑ i, rowCorrection (P i) = + (∑ i, ∑ j, P i j * Real.log (A i j)) + + ∑ i, rowScore (P i) := by + rw [betheObjective] + simp_rw [betheRowObjective, rowCorrection, rowScore, shannonEntropy] + simp only [Finset.sum_add_distrib, Finset.sum_sub_distrib] + ring + +/-- The averaged KL term `D` in the paper, specialized to the Gibbs law and +its assignment marginals. -/ +noncomputable def gibbsSequentialDivergence + {m : ℕ} (A : Matrix (Fin m) (Fin m) ℝ) : ℝ := + averagedSequentialDivergence + (gibbsProbability A) (assignmentMarginal A) + +theorem neg_logMarginals_add_rowT_eq_rowScore + {m : ℕ} (P : Matrix (Fin m) (Fin m) ℝ) : + -(∑ i, ∑ j, P i j * Real.log (P i j)) + ∑ i, rowT (P i) = + ∑ i, rowScore (P i) := by + have hneg : -(∑ i, ∑ j, P i j * Real.log (P i j)) = + ∑ i, ∑ j, -(P i j * Real.log (P i j)) := by + simp + simp_rw [rowScore, shannonEntropy, Real.negMulLog_def, + Finset.sum_add_distrib] + rw [hneg] + ring_nf + +/-- Entropy form of the averaged sequential divergence, now proved directly +for the Gibbs law rather than taken as a premise. -/ +theorem gibbsSequentialDivergence_eq_entropy + {m : ℕ} (A : Matrix (Fin m) (Fin m) ℝ) + (hA : ∀ i j, 0 < A i j) : + gibbsSequentialDivergence A = + -shannonEntropy (gibbsProbability A) + + ∑ i, rowScore (assignmentMarginal A i) := by + rw [gibbsSequentialDivergence, averagedSequentialDivergence] + calc + uniformAverage (fun π : Equiv.Perm (Fin m) ↦ + finiteKL (gibbsProbability A) + (sequentialLikelihood (assignmentMarginal A) π)) = + -shannonEntropy (gibbsProbability A) - + (∑ i, ∑ j, assignmentMarginal A i j * + Real.log (assignmentMarginal A i j)) + + ∑ i, rowT (assignmentMarginal A i) := + averagedSequentialKL_identity + (gibbsProbability_pos A hA) + (assignmentMarginal_strictProbabilityVector A hA) + (gibbs_hasAssignmentMarginals A) + _ = -shannonEntropy (gibbsProbability A) + + ∑ i, rowScore (assignmentMarginal A i) := by + rw [← neg_logMarginals_add_rowT_eq_rowScore] + ring + +theorem gibbsSequentialDivergence_nonneg + {m : ℕ} (A : Matrix (Fin m) (Fin m) ℝ) + (hA : ∀ i j, 0 < A i j) : + 0 ≤ gibbsSequentialDivergence A := by + exact averagedSequentialDivergence_nonneg + (gibbsProbability_isProbabilityVector A hA) + (gibbsProbability_pos A hA) + (assignmentMarginal_strictProbabilityVector A hA) + +/-- Paper Lemma 6 (exact sequential identity), with every probability and +normalization assertion discharged. -/ +theorem gibbs_exact_sequential_identity + {m : ℕ} (A : Matrix (Fin m) (Fin m) ℝ) + (hA : ∀ i j, 0 < A i j) : + Real.log (Matrix.permanent A) = + betheObjective A (assignmentMarginal A) + + (∑ i, rowCorrection (assignmentMarginal A i)) - + gibbsSequentialDivergence A := by + have hGibbs := gibbsEntropy_identity A hA + have hD := gibbsSequentialDivergence_eq_entropy A hA + have hBethe := bethe_add_rowCorrection_eq_logWeight_add_rowScore + A (assignmentMarginal A) + linarith + +/-- Entropy form of the sequential divergence, paper Lemma 10, derived from +the Gibbs entropy identity and the exact sequential identity. -/ +theorem entropy_form_of_sequential_identity + {m : ℕ} (A P : Matrix (Fin m) (Fin m) ℝ) + {logPermanent divergence gibbsEntropy : ℝ} + (hGibbs : gibbsEntropy = logPermanent - + ∑ i, ∑ j, P i j * Real.log (A i j)) + (hseq : logPermanent = + betheObjective A P + (∑ i, rowCorrection (P i)) - divergence) : + divergence = -gibbsEntropy + ∑ i, rowScore (P i) := by + rw [bethe_add_rowCorrection_eq_logWeight_add_rowScore A P] at hseq + linarith + +/-- Slack in the upper half of the Bethe sandwich, in logarithmic +coordinates. -/ +noncomputable def betheSlack (n : ℕ) (logBethe logPermanent : ℝ) : ℝ := + n * (Real.log 2 / 2) + logBethe - logPermanent + +/-- Loss from evaluating the Bethe objective away from its maximizer. -/ +def betheSuboptimality (logBethe objectiveValue : ℝ) : ℝ := + logBethe - objectiveValue + +/-- Paper Lemma 7 is an exact algebraic consequence of Lemma 6. This version +separates that closed algebra from the probabilistic proof of the sequential +identity. -/ +theorem slack_decomposition_of_sequential_identity + {m : ℕ} (g : Fin m → ℝ) + {logBethe logPermanent objectiveValue divergence : ℝ} + (hseq : logPermanent = + objectiveValue + (∑ i, g i) - divergence) : + betheSlack m logBethe logPermanent = + betheSuboptimality logBethe objectiveValue + + (∑ i, (Real.log 2 / 2 - g i)) + divergence := by + rw [betheSlack, betheSuboptimality, hseq] + simp_rw [Finset.sum_sub_distrib, Finset.sum_const, nsmul_eq_mul] + rw [Finset.card_univ, Fintype.card_fin] + ring + +/-- The same identity in the paper's `rowDeficit` notation. -/ +theorem slack_decomposition_rowDeficit + {m : ℕ} (p : Fin m → Fin m → ℝ) + {logBethe logPermanent objectiveValue divergence : ℝ} + (hseq : logPermanent = + objectiveValue + (∑ i, rowCorrection (p i)) - divergence) : + betheSlack m logBethe logPermanent = + betheSuboptimality logBethe objectiveValue + + (∑ i, rowDeficit (p i)) + divergence := by + simpa only [rowDeficit] using + slack_decomposition_of_sequential_identity + (fun i ↦ rowCorrection (p i)) hseq + +theorem terms_le_slack_of_decomposition + {slack sub row divergence : ℝ} + (hsub : 0 ≤ sub) (hrow : 0 ≤ row) (hdiv : 0 ≤ divergence) + (h : slack = sub + row + divergence) : + sub ≤ slack ∧ row ≤ slack ∧ divergence ≤ slack := by + subst slack + constructor + · linarith + constructor <;> linarith + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/Smoothing.lean b/LeanPool/BeyondBethe/BeyondBethe/Smoothing.lean new file mode 100644 index 0000000000..08921b4ed6 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/Smoothing.lean @@ -0,0 +1,238 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.Permanent +import Mathlib.Algebra.Order.Ring.Pow +import Mathlib.Analysis.Complex.Exponential +import Mathlib.Data.Fintype.Perm +import Mathlib.Tactic + +/-! # Smoothing -/ + +open scoped BigOperators + +namespace BeyondBethe + +/-- The smoothing level from paper (48), written for an abstract matrix order +`n`. -/ +noncomputable def smoothingDelta (n : ℕ) (m χ : ℝ) : ℝ := + min (1 / (2 * n)) (χ * m ^ n / (4 * Nat.factorial n)) + +theorem smoothingDelta_pos {n : ℕ} {m χ : ℝ} + (hn : 0 < n) (hm : 0 < m) (hχ : 0 < χ) : + 0 < smoothingDelta n m χ := by + rw [smoothingDelta, lt_min_iff] + constructor <;> positivity + +theorem smoothingDelta_scale {n : ℕ} {m χ : ℝ} : + smoothingDelta n m χ ≤ χ * m ^ n / (4 * Nat.factorial n) := by + exact min_le_right _ _ + +theorem smoothingDelta_half {n : ℕ} {m χ : ℝ} + (hn : 0 < n) : + (n : ℝ) * smoothingDelta n m χ ≤ 1 / 2 := by + have hle : smoothingDelta n m χ ≤ 1 / (2 * (n : ℝ)) := by + rw [smoothingDelta] + exact min_le_left _ _ + have hn0 : (n : ℝ) ≠ 0 := by exact_mod_cast hn.ne' + calc + (n : ℝ) * smoothingDelta n m χ + ≤ (n : ℝ) * (1 / (2 * (n : ℝ))) := + mul_le_mul_of_nonneg_left hle (by positivity) + _ = 1 / 2 := by field_simp + +/-- The elementary geometric-series estimate used after choosing +`n * δ ≤ 1/2` in the smoothing argument. -/ +theorem one_add_pow_sub_one_le_two_mul + {n : ℕ} {δ : ℝ} (hδ : 0 ≤ δ) + (hhalf : (n : ℝ) * δ ≤ 1 / 2) : + (1 + δ) ^ n - 1 ≤ 2 * n * δ := by + let x : ℝ := n * δ + have hx0 : 0 ≤ x := by dsimp [x]; positivity + have hxhalf : x ≤ 1 / 2 := by simpa [x] using hhalf + have hxlt : x < 1 := hxhalf.trans_lt (by norm_num) + have hpowexp : (1 + δ) ^ n ≤ Real.exp x := by + have h := Real.prod_one_add_le_exp_sum + (Finset.univ : Finset (Fin n)) (f := fun _ ↦ δ) (fun _ ↦ hδ) + simpa [Finset.prod_const, Finset.sum_const, nsmul_eq_mul, x, + mul_comm] using h + have hexp : Real.exp x ≤ 1 / (1 - x) := + Real.exp_bound_div_one_sub_of_interval hx0 hxlt + have hden : 0 < 1 - x := by linarith + have hfrac : 1 / (1 - x) ≤ 1 + 2 * x := by + rw [div_le_iff₀ hden] + nlinarith + calc + (1 + δ) ^ n - 1 ≤ Real.exp x - 1 := sub_le_sub_right hpowexp 1 + _ ≤ 1 / (1 - x) - 1 := sub_le_sub_right hexp 1 + _ ≤ 2 * x := by linarith + _ = 2 * n * δ := by dsimp [x]; ring + +/-- Increasing every factor in a product by `δ` changes the product by at +most the change at the all-ones vector. This is the termwise estimate used in +the smoothing lemma. -/ +theorem prod_add_const_sub_prod_le + {ι : Type*} [DecidableEq ι] (s : Finset ι) (a : ι → ℝ) {δ : ℝ} + (hδ : 0 ≤ δ) + (ha0 : ∀ i ∈ s, 0 ≤ a i) + (ha1 : ∀ i ∈ s, a i ≤ 1) : + (∏ i ∈ s, (a i + δ)) - (∏ i ∈ s, a i) + ≤ (1 + δ) ^ s.card - 1 := by + classical + induction s using Finset.induction_on with + | empty => simp + | @insert x s hx ih => + have hx0 : 0 ≤ a x := ha0 x (Finset.mem_insert_self x s) + have hx1 : a x ≤ 1 := ha1 x (Finset.mem_insert_self x s) + have hs0 : ∀ i ∈ s, 0 ≤ a i := fun i hi ↦ ha0 i (Finset.mem_insert_of_mem hi) + have hs1 : ∀ i ∈ s, a i ≤ 1 := fun i hi ↦ ha1 i (Finset.mem_insert_of_mem hi) + have hprod : (∏ i ∈ s, (a i + δ)) ≤ (1 + δ) ^ s.card := by + rw [← Finset.prod_const] + exact Finset.prod_le_prod + (fun i hi ↦ add_nonneg (hs0 i hi) hδ) + (fun i hi ↦ by simpa [add_comm] using add_le_add_right (hs1 i hi) δ) + have hpow : 0 ≤ (1 + δ) ^ s.card - 1 := by + apply sub_nonneg.mpr + exact one_le_pow₀ (by linarith) + calc + (∏ i ∈ insert x s, (a i + δ)) - (∏ i ∈ insert x s, a i) + = δ * (∏ i ∈ s, (a i + δ)) + + a x * ((∏ i ∈ s, (a i + δ)) - (∏ i ∈ s, a i)) := by + rw [Finset.prod_insert hx, Finset.prod_insert hx] + ring + _ ≤ δ * (1 + δ) ^ s.card + + a x * ((1 + δ) ^ s.card - 1) := by + exact add_le_add + (mul_le_mul_of_nonneg_left hprod hδ) + (mul_le_mul_of_nonneg_left (ih hs0 hs1) hx0) + _ ≤ δ * (1 + δ) ^ s.card + + ((1 + δ) ^ s.card - 1) := by + have hmul := mul_le_mul_of_nonneg_right hx1 hpow + nlinarith + _ = (1 + δ) ^ (insert x s).card - 1 := by + rw [Finset.card_insert_of_notMem hx, pow_succ] + ring + +/-- Matrix-level smoothing bound before choosing the smoothing scale. -/ +theorem permanent_add_uniform_sub_le + {n : Type*} [Fintype n] [DecidableEq n] + (A : Matrix n n ℝ) {δ : ℝ} + (hδ : 0 ≤ δ) (hA0 : Matrix.Nonnegative A) + (hA1 : ∀ i j, A i j ≤ 1) : + Matrix.permanent (fun i j ↦ A i j + δ) - Matrix.permanent A + ≤ Nat.factorial (Fintype.card n) * ((1 + δ) ^ Fintype.card n - 1) := by + classical + rw [Matrix.permanent, Matrix.permanent, ← Finset.sum_sub_distrib] + calc + ∑ σ : Equiv.Perm n, + ((∏ i, (A (σ i) i + δ)) - ∏ i, A (σ i) i) + ≤ ∑ _σ : Equiv.Perm n, ((1 + δ) ^ Fintype.card n - 1) := by + apply Finset.sum_le_sum + intro σ _ + simpa using prod_add_const_sub_prod_le Finset.univ + (fun i ↦ A (σ i) i) hδ + (fun i _ ↦ hA0 (σ i) i) + (fun i _ ↦ hA1 (σ i) i) + _ = Nat.factorial (Fintype.card n) * ((1 + δ) ^ Fintype.card n - 1) := by + rw [Finset.sum_const, Finset.card_univ, Fintype.card_perm, nsmul_eq_mul] + +/-- The quantitative form used in paper Lemma 21 once `δ ≤ 1/(2n)` has +been imposed. -/ +theorem permanent_add_uniform_sub_le_two_mul + {n : Type*} [Fintype n] [DecidableEq n] + (A : Matrix n n ℝ) {δ : ℝ} + (hδ : 0 ≤ δ) (hhalf : (Fintype.card n : ℝ) * δ ≤ 1 / 2) + (hA0 : Matrix.Nonnegative A) (hA1 : ∀ i j, A i j ≤ 1) : + Matrix.permanent (fun i j ↦ A i j + δ) - Matrix.permanent A + ≤ Nat.factorial (Fintype.card n) * + (2 * Fintype.card n * δ) := by + refine (permanent_add_uniform_sub_le A hδ hA0 hA1).trans ?_ + exact mul_le_mul_of_nonneg_left + (one_add_pow_sub_one_le_two_mul hδ hhalf) + (Nat.cast_nonneg _) + +/-- The mathematical comparison in paper Lemma 21. The statement isolates +the two inequalities imposed on the chosen smoothing scale `δ`; the paper's +explicit minimum satisfies both. -/ +theorem smoothing_comparison + {n : Type*} [Fintype n] [DecidableEq n] + (A : Matrix n n ℝ) {m χ δ : ℝ} + (hn : 0 < Fintype.card n) (hm : 0 < m) (hχ : 0 ≤ χ) + (hδ : 0 ≤ δ) + (hhalf : (Fintype.card n : ℝ) * δ ≤ 1 / 2) + (hscale : δ ≤ + χ * m ^ Fintype.card n / + (4 * Nat.factorial (Fintype.card n))) + (hA0 : Matrix.Nonnegative A) (hA1 : ∀ i j, A i j ≤ 1) + (hmin : ∀ i j, A i j ≠ 0 → m ≤ A i j) + (hmatch : Matrix.HasPerfectMatching A) : + Matrix.permanent A ≤ Matrix.permanent (fun i j ↦ A i j + δ) ∧ + Matrix.permanent (fun i j ↦ A i j + δ) ≤ + (1 + χ * Fintype.card n / 2) * Matrix.permanent A := by + let N : ℝ := Fintype.card n + let F : ℝ := Nat.factorial (Fintype.card n) + have hN : 0 ≤ N := by dsimp [N]; positivity + have hF : 0 < F := by dsimp [F]; positivity + have hper0 : 0 ≤ Matrix.permanent A := Matrix.permanent_nonneg_real A hA0 + have hmatched : m ^ Fintype.card n ≤ Matrix.permanent A := + Matrix.pow_card_le_permanent_of_hasPerfectMatching A hm.le hA0 hmin hmatch + have hlower : Matrix.permanent A ≤ Matrix.permanent (fun i j ↦ A i j + δ) := by + exact Matrix.permanent_mono_real hA0 fun i j ↦ by linarith + have hdiff := permanent_add_uniform_sub_le_two_mul A hδ hhalf hA0 hA1 + have hscale' : + F * (2 * N * δ) ≤ χ * N / 2 * m ^ Fintype.card n := by + have hmultiplier : 0 ≤ F * (2 * N) := + mul_nonneg hF.le (mul_nonneg (by norm_num) hN) + have hmul : (F * (2 * N)) * δ ≤ + (F * (2 * N)) * + (χ * m ^ Fintype.card n / + (4 * Nat.factorial (Fintype.card n))) := + mul_le_mul_of_nonneg_left hscale hmultiplier + dsimp [F, N] at hmul ⊢ + calc + (Nat.factorial (Fintype.card n) : ℝ) * + (2 * (Fintype.card n : ℝ) * δ) + = ((Nat.factorial (Fintype.card n) : ℝ) * + (2 * (Fintype.card n : ℝ))) * δ := by ring + _ ≤ ((Nat.factorial (Fintype.card n) : ℝ) * + (2 * (Fintype.card n : ℝ))) * + (χ * m ^ Fintype.card n / + (4 * Nat.factorial (Fintype.card n))) := hmul + _ = χ * (Fintype.card n : ℝ) / 2 * + m ^ Fintype.card n := by + field_simp + ring + refine ⟨hlower, ?_⟩ + have hdiff' : + Matrix.permanent (fun i j ↦ A i j + δ) - Matrix.permanent A + ≤ χ * N / 2 * m ^ Fintype.card n := by + exact hdiff.trans (by simpa [F, N] using hscale') + have hcoef : 0 ≤ χ * N / 2 := by positivity + have hmatched' := mul_le_mul_of_nonneg_left hmatched hcoef + dsimp [N] at hdiff' hmatched' ⊢ + linarith + +/-- Paper Lemma 21 with its explicit smoothing level. This is the exact +real-inequality content; rational bit length and construction time belong to +the algorithmic layer. -/ +theorem smoothing_comparison_explicit + {n : Type*} [Fintype n] [DecidableEq n] + (A : Matrix n n ℝ) {m χ : ℝ} + (hn : 0 < Fintype.card n) (hm : 0 < m) (hχ : 0 < χ) + (hA0 : Matrix.Nonnegative A) (hA1 : ∀ i j, A i j ≤ 1) + (hmin : ∀ i j, A i j ≠ 0 → m ≤ A i j) + (hmatch : Matrix.HasPerfectMatching A) : + let δ := smoothingDelta (Fintype.card n) m χ + Matrix.permanent A ≤ Matrix.permanent (fun i j ↦ A i j + δ) ∧ + Matrix.permanent (fun i j ↦ A i j + δ) ≤ + (1 + χ * Fintype.card n / 2) * Matrix.permanent A := by + dsimp only + exact smoothing_comparison A hn hm hχ.le + (smoothingDelta_pos hn hm hχ).le + (smoothingDelta_half hn) + smoothingDelta_scale hA0 hA1 hmin hmatch + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/SourceAnariRezaei.lean b/LeanPool/BeyondBethe/BeyondBethe/SourceAnariRezaei.lean new file mode 100644 index 0000000000..c71d2636d6 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/SourceAnariRezaei.lean @@ -0,0 +1,831 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.RowStability +import Mathlib.Analysis.Calculus.Deriv.MeanValue + +/-! # Source Anari Rezaei -/ + +open scoped BigOperators + +namespace BeyondBethe + +/-! +# Anari--Rezaei's sharp one-row inequality + +This file formalizes the source proof of the one-row inequality used in the +upper Bethe bound. The first step pairs every ordering with its reversal and +reduces the averaged row score to the deterministic prefix--suffix functional +called `phi` in the source. +-/ + +/-- The sum of the two row scores for an ordering and its reversal, minus +twice the complement-entropy term. After reindexing the coordinates into the +given order, this is Anari--Rezaei's function `phi`. -/ +noncomputable def pairedRowScore {m : ℕ} + (p : Fin m → ℝ) (π : Equiv.Perm (Fin m)) : ℝ := + (∑ j, p j * Real.log (suffixMass p π j)) + + (∑ j, p j * Real.log (suffixMass p (reverseOrdering π) j)) - + 2 * ∑ j, (1 - p j) * Real.log (1 - p j) + +/-- Averaging the paired score gives exactly twice the one-row correction. -/ +theorem uniformAverage_pairedRowScore {m : ℕ} (p : Fin m → ℝ) : + uniformAverage (pairedRowScore p) = 2 * rowCorrection p := by + let f : Equiv.Perm (Fin m) → ℝ := fun π ↦ + ∑ j, p j * Real.log (suffixMass p π j) + let C : ℝ := ∑ j, (1 - p j) * Real.log (1 - p j) + have hrev : uniformAverage (fun π : Equiv.Perm (Fin m) ↦ + f (reverseOrdering π)) = uniformAverage f := by + exact uniformAverage_perm_preTrans f Fin.revPerm + have hconst : uniformAverage + (fun _π : Equiv.Perm (Fin m) ↦ 2 * C) = 2 * C := + uniformAverage_const (2 * C) + rw [show pairedRowScore p = fun π ↦ + f π + f (reverseOrdering π) - 2 * C by + funext π + rfl] + rw [uniformAverage_sub, uniformAverage_add, hrev, hconst] + have hf : uniformAverage f = rowT p := rfl + rw [hf] + change rowT p + rowT p - 2 * C = 2 * rowCorrection p + rw [rowCorrection] + ring + +/-- Pointwise control of the reversal-paired functional implies the sharp +one-row deficit inequality. -/ +theorem rowDeficit_nonneg_of_pairedRowScore_le + {m : ℕ} (p : Fin m → ℝ) + (hphi : ∀ π : Equiv.Perm (Fin m), pairedRowScore p π ≤ Real.log 2) : + 0 ≤ rowDeficit p := by + have havg : uniformAverage (pairedRowScore p) ≤ + uniformAverage (fun _π : Equiv.Perm (Fin m) ↦ Real.log 2) := by + unfold uniformAverage + exact div_le_div_of_nonneg_right + (Finset.sum_le_sum fun π _ ↦ hphi π) (Nat.cast_nonneg _) + rw [uniformAverage_pairedRowScore, + uniformAverage_const (α := Equiv.Perm (Fin m))] at havg + rw [rowDeficit] + linarith + +/-- The canonical `phi`, with the coordinates already arranged in their +natural order. -/ +noncomputable def anariRezaeiPhi {m : ℕ} (p : Fin m → ℝ) : ℝ := + pairedRowScore p (Equiv.refl (Fin m)) + +/-- Reindex a probability vector by an ordering. -/ +def orderCoordinates {m : ℕ} + (p : Fin m → ℝ) (π : Equiv.Perm (Fin m)) : Fin m → ℝ := + fun i ↦ p (π i) + +theorem orderCoordinates_probability {m : ℕ} + {p : Fin m → ℝ} (hp : IsProbabilityVector p) + (π : Equiv.Perm (Fin m)) : + IsProbabilityVector (orderCoordinates p π) := by + refine ⟨fun i ↦ hp.nonnegative (π i), ?_⟩ + exact (Equiv.sum_comp π p).trans hp.sum_eq_one + +theorem suffixMass_orderCoordinates {m : ℕ} + (p : Fin m → ℝ) (π : Equiv.Perm (Fin m)) (i : Fin m) : + suffixMass (orderCoordinates p π) (Equiv.refl (Fin m)) i = + suffixMass p π (π i) := by + classical + rw [suffixMass, suffixMass] + change (∑ k, if i ≤ k then p (π k) else 0) = + ∑ k, if π.symm (π i) ≤ π.symm k then p k else 0 + let f : Fin m → ℝ := fun k ↦ + if π.symm (π i) ≤ π.symm k then p k else 0 + calc + (∑ k, if i ≤ k then p (π k) else 0) = + ∑ k, f (π k) := by simp [f] + _ = ∑ k, f k := Equiv.sum_comp π f + _ = ∑ k, if π.symm (π i) ≤ π.symm k then p k else 0 := rfl + +theorem suffixMass_reverse_orderCoordinates {m : ℕ} + (p : Fin m → ℝ) (π : Equiv.Perm (Fin m)) (i : Fin m) : + suffixMass (orderCoordinates p π) + (reverseOrdering (Equiv.refl (Fin m))) i = + suffixMass p (reverseOrdering π) (π i) := by + classical + rw [suffixMass, suffixMass] + change (∑ k, if + (reverseOrdering (Equiv.refl (Fin m))).symm i ≤ + (reverseOrdering (Equiv.refl (Fin m))).symm k + then p (π k) else 0) = + ∑ k, if (reverseOrdering π).symm (π i) ≤ + (reverseOrdering π).symm k then p k else 0 + let f : Fin m → ℝ := fun k ↦ + if (reverseOrdering π).symm (π i) ≤ + (reverseOrdering π).symm k then p k else 0 + calc + (∑ k, if + (reverseOrdering (Equiv.refl (Fin m))).symm i ≤ + (reverseOrdering (Equiv.refl (Fin m))).symm k + then p (π k) else 0) = + ∑ k, f (π k) := by + apply Finset.sum_congr rfl + intro k _ + simp [f, reverseOrdering, Equiv.trans_apply] + _ = ∑ k, f k := Equiv.sum_comp π f + _ = ∑ k, if (reverseOrdering π).symm (π i) ≤ + (reverseOrdering π).symm k then p k else 0 := rfl + +/-- Every paired row score is the canonical `phi` of the reordered vector. -/ +theorem anariRezaeiPhi_orderCoordinates {m : ℕ} + (p : Fin m → ℝ) (π : Equiv.Perm (Fin m)) : + anariRezaeiPhi (orderCoordinates p π) = pairedRowScore p π := by + classical + rw [anariRezaeiPhi, pairedRowScore, pairedRowScore] + have hsuffix : + (∑ j, orderCoordinates p π j * + Real.log (suffixMass (orderCoordinates p π) + (Equiv.refl (Fin m)) j)) = + ∑ j, p j * Real.log (suffixMass p π j) := by + let f : Fin m → ℝ := fun j ↦ + p j * Real.log (suffixMass p π j) + calc + (∑ j, orderCoordinates p π j * + Real.log (suffixMass (orderCoordinates p π) + (Equiv.refl (Fin m)) j)) = + ∑ i, f (π i) := by + apply Finset.sum_congr rfl + intro i _ + rw [suffixMass_orderCoordinates] + rfl + _ = ∑ j, f j := Equiv.sum_comp π f + _ = ∑ j, p j * Real.log (suffixMass p π j) := rfl + have hreverse : + (∑ j, orderCoordinates p π j * + Real.log (suffixMass (orderCoordinates p π) + (reverseOrdering (Equiv.refl (Fin m))) j)) = + ∑ j, p j * Real.log (suffixMass p (reverseOrdering π) j) := by + let f : Fin m → ℝ := fun j ↦ + p j * Real.log (suffixMass p (reverseOrdering π) j) + calc + (∑ j, orderCoordinates p π j * + Real.log (suffixMass (orderCoordinates p π) + (reverseOrdering (Equiv.refl (Fin m))) j)) = + ∑ i, f (π i) := by + apply Finset.sum_congr rfl + intro i _ + rw [suffixMass_reverse_orderCoordinates] + rfl + _ = ∑ j, f j := Equiv.sum_comp π f + _ = ∑ j, p j * + Real.log (suffixMass p (reverseOrdering π) j) := rfl + have hcomplement : + (∑ j, (1 - orderCoordinates p π j) * + Real.log (1 - orderCoordinates p π j)) = + ∑ j, (1 - p j) * Real.log (1 - p j) := by + exact Equiv.sum_comp π + (fun j ↦ (1 - p j) * Real.log (1 - p j)) + rw [hsuffix, hreverse, hcomplement] + +/-- The canonical `phi` inequality implies the full Anari--Rezaei one-row +interface. -/ +theorem anariRezaeiRowInequality_of_phi + (hphi : ∀ {m : ℕ}, 2 ≤ m → ∀ p : Fin m → ℝ, + IsProbabilityVector p → anariRezaeiPhi p ≤ Real.log 2) : + AnariRezaeiRowInequality := by + intro m hm p hp + apply rowDeficit_nonneg_of_pairedRowScore_le + intro π + rw [← anariRezaeiPhi_orderCoordinates] + exact hphi hm (orderCoordinates p π) + (orderCoordinates_probability hp π) + +/-! ## An analytic replacement for the source's three-variable grid check -/ + +/-- A hyperbolic upper bound for the logarithm. -/ +theorem two_mul_log_le_sub_inv {z : ℝ} (hz : 1 ≤ z) : + 2 * Real.log z ≤ z - 1 / z := by + let h : ℝ → ℝ := fun x ↦ x - 1 / x - 2 * Real.log x + have hcont : ContinuousOn h (Set.Ici (1 : ℝ)) := by + intro x hx + have hx0 : x ≠ 0 := ne_of_gt (lt_of_lt_of_le zero_lt_one hx) + dsimp [h] + fun_prop + have hdiff : DifferentiableOn ℝ h (interior (Set.Ici (1 : ℝ))) := by + intro x hx + have hx' : 1 < x := by simpa using hx + have hx0 : x ≠ 0 := ne_of_gt (zero_lt_one.trans hx') + have hd : HasDerivAt h (1 + 1 / x ^ 2 - 2 / x) x := by + dsimp [h] + convert! ((hasDerivAt_id x).sub + ((hasDerivAt_const x 1).div (hasDerivAt_id x) hx0)).sub + ((Real.hasDerivAt_log hx0).const_mul 2) using 1 <;> + simp only [id_eq] <;> ring + exact hd.differentiableAt.differentiableWithinAt + have hderiv : ∀ x ∈ interior (Set.Ici (1 : ℝ)), + deriv h x = (x - 1) ^ 2 / x ^ 2 := by + intro x hx + have hx' : 1 < x := by simpa using hx + have hx0 : x ≠ 0 := ne_of_gt (zero_lt_one.trans hx') + have hd : HasDerivAt h (1 + 1 / x ^ 2 - 2 / x) x := by + dsimp [h] + convert! ((hasDerivAt_id x).sub + ((hasDerivAt_const x 1).div (hasDerivAt_id x) hx0)).sub + ((Real.hasDerivAt_log hx0).const_mul 2) using 1 <;> + simp only [id_eq] <;> ring + rw [hd.deriv] + field_simp + ring + have hmono : MonotoneOn h (Set.Ici (1 : ℝ)) := + monotoneOn_of_deriv_nonneg (convex_Ici (1 : ℝ)) hcont hdiff fun x hx ↦ by + rw [hderiv x hx] + positivity + have hle := hmono (by simp : (1 : ℝ) ∈ Set.Ici 1) hz hz + dsimp [h] at hle + norm_num at hle ⊢ + linarith + +/-- Positive Bernstein coefficients for the rational polynomial certificate +used below. The two indices are the Bernstein degrees in `u` and `v`. -/ +private noncomputable def anariRezaeiDirectionCoeff + (k : Fin 7) (l : Fin 5) : ℝ := + match k.1, l.1 with + | 0, 0 => 1 | 0, 1 => 78/25 | 0, 2 => 84/25 | 0, 3 => 34/25 | 0, 4 => 3/25 + | 1, 0 => 6 | 1, 1 => 468/25 | 1, 2 => 12358/625 | 1, 3 => 118062/15625 | 1, 4 => 7862/15625 + | 2, 0 => 15 | 2, 1 => 234/5 | 2, 2 => 30048/625 | 2, 3 => 267446/15625 | 2, 4 => 313384/390625 + | 3, 0 => 20 | 3, 1 => 312/5 | 3, 2 => 7674/125 | 3, 3 => 312712/15625 | 3, 4 => 281922/390625 + | 4, 0 => 15 | 4, 1 => 234/5 | 4, 2 => 26781/625 | 4, 3 => 197266/15625 | 4, 4 => 264016/390625 + | 5, 0 => 6 | 5, 1 => 468/25 | 5, 2 => 9454/625 | 5, 3 => 66032/15625 | 5, 4 => 242288/390625 + | 6, 0 => 1 | 6, 1 => 78/25 | 6, 2 => 1253/625 | 6, 3 => 10844/15625 | 6, 4 => 81844/390625 + | _, _ => 0 + +private noncomputable def anariRezaeiDirectionCertificate + (u v : ℝ) : ℝ := + ∑ k : Fin 7, ∑ l : Fin 5, + anariRezaeiDirectionCoeff k l * + u ^ k.1 * (1 - u) ^ (6 - k.1) * + v ^ l.1 * (1 - v) ^ (4 - l.1) + +private theorem anariRezaeiDirectionCoeff_nonneg + (k : Fin 7) (l : Fin 5) : + 0 ≤ anariRezaeiDirectionCoeff k l := by + fin_cases k <;> fin_cases l <;> + norm_num [anariRezaeiDirectionCoeff] + +private theorem anariRezaeiDirectionCertificate_nonneg + {u v : ℝ} (hu0 : 0 ≤ u) (hu1 : u ≤ 1) + (hv0 : 0 ≤ v) (hv1 : v ≤ 1) : + 0 ≤ anariRezaeiDirectionCertificate u v := by + apply Finset.sum_nonneg + intro k _ + apply Finset.sum_nonneg + intro l _ + exact mul_nonneg (mul_nonneg (mul_nonneg (mul_nonneg + (anariRezaeiDirectionCoeff_nonneg k l) (pow_nonneg hu0 _)) + (pow_nonneg (sub_nonneg.mpr hu1) _)) + (pow_nonneg hv0 _)) (pow_nonneg (sub_nonneg.mpr hv1) _) + +private theorem anariRezaeiDirectionCertificate_eq (u v : ℝ) : + anariRezaeiDirectionCertificate u v = + 1 - (22/25)*v + - (242/625)*u*v^2 + (2662/15625)*u*v^3 + - (242/625)*u^2*v^2 + (7986/15625)*u^2*v^3 - (14641/390625)*u^2*v^4 + - (242/625)*u^3*v^2 + (10648/15625)*u^3*v^3 - (58564/390625)*u^3*v^4 + - (121/625)*u^4*v^2 + (7986/15625)*u^4*v^3 - (87846/390625)*u^4*v^4 + + (2662/15625)*u^5*v^3 - (58564/390625)*u^5*v^4 + - (14641/390625)*u^6*v^4 := by + norm_num [anariRezaeiDirectionCertificate, + anariRezaeiDirectionCoeff, Fin.sum_univ_succ] + ring + +/-- Polynomial obtained after removing denominators from the directional +derivative estimate for the three-variable `phi`. -/ +noncomputable def anariRezaeiLargeCoordinatePolynomial + (q s : ℝ) : ℝ := + 2*q*(1-q)*s*(q+s)^2 + s^2*(1-s)^2 - (1-q)^2*(q+s)^4 + +/-- The polynomial is nonnegative on the triangle +`0 ≤ q ≤ s ≤ 11/25`. This is the 35-term exact rational certificate that +replaces the source's `881^2` grid computation. -/ +theorem anariRezaeiLargeCoordinatePolynomial_nonneg + {q s : ℝ} (hq0 : 0 ≤ q) (hqs : q ≤ s) + (hs : s ≤ 11/25) : + 0 ≤ anariRezaeiLargeCoordinatePolynomial q s := by + have hs0 : 0 ≤ s := hq0.trans hqs + by_cases hs_zero : s = 0 + · have hq_zero : q = 0 := le_antisymm (hqs.trans_eq hs_zero) hq0 + simp [anariRezaeiLargeCoordinatePolynomial, hs_zero, hq_zero] + · have hspos : 0 < s := lt_of_le_of_ne hs0 (Ne.symm hs_zero) + let u := q / s + let v := s / (11/25 : ℝ) + have hu0 : 0 ≤ u := div_nonneg hq0 hs0 + have hu1 : u ≤ 1 := (div_le_one hspos).mpr hqs + have hv0 : 0 ≤ v := div_nonneg hs0 (by norm_num) + have hv1 : v ≤ 1 := + (div_le_one (by norm_num : (0 : ℝ) < 11/25)).mpr hs + have hc := anariRezaeiDirectionCertificate_nonneg hu0 hu1 hv0 hv1 + have hid : anariRezaeiLargeCoordinatePolynomial q s = + s^2 * anariRezaeiDirectionCertificate u v := by + rw [anariRezaeiDirectionCertificate_eq] + dsimp [anariRezaeiLargeCoordinatePolynomial, u, v] + field_simp [hs_zero] + ring + rw [hid] + exact mul_nonneg (sq_nonneg s) hc + +/-- The derivative of the three-variable `phi` in its larger endpoint +coordinate, after eliminating the middle coordinate by `r = 1-q-s`. -/ +noncomputable def anariRezaeiLargeCoordinateDerivative + (q s : ℝ) : ℝ := + Real.log (s*(1-s)/((1-q)*(q+s)^2)) + q/(1-s) + +/-- On `0 ≤ q ≤ s ≤ 11/25`, increasing the larger endpoint coordinate does +not decrease the three-variable `phi`. -/ +theorem anariRezaeiLargeCoordinateDerivative_nonneg + {q s : ℝ} (hq0 : 0 ≤ q) (hqs : q ≤ s) + (hs : s ≤ 11/25) (hspos : 0 < s) : + 0 ≤ anariRezaeiLargeCoordinateDerivative q s := by + have hs1 : s < 1 := hs.trans_lt (by norm_num) + have hq1 : q < 1 := hqs.trans_lt hs1 + have honeq : 0 < 1-q := sub_pos.mpr hq1 + have hones : 0 < 1-s := sub_pos.mpr hs1 + have hsum : 0 < q+s := add_pos_of_nonneg_of_pos hq0 hspos + let z : ℝ := (1-q)*(q+s)^2/(s*(1-s)) + have hzpos : 0 < z := div_pos (mul_pos honeq (sq_pos_of_pos hsum)) + (mul_pos hspos hones) + have hrewrite : anariRezaeiLargeCoordinateDerivative q s = + -Real.log z + q/(1-s) := by + rw [anariRezaeiLargeCoordinateDerivative] + have hinv : s * (1-s) / ((1-q)*(q+s)^2) = z⁻¹ := by + dsimp [z] + field_simp + rw [hinv, Real.log_inv] + rw [hrewrite] + by_cases hz : z ≤ 1 + · have hlog : Real.log z ≤ 0 := Real.log_nonpos hzpos.le hz + exact add_nonneg (neg_nonneg.mpr hlog) (div_nonneg hq0 hones.le) + · have hz1 : 1 ≤ z := le_of_not_ge hz + have hlog := two_mul_log_le_sub_inv hz1 + have hpoly := anariRezaeiLargeCoordinatePolynomial_nonneg hq0 hqs hs + have hrat : z - 1/z ≤ 2*q/(1-s) := by + dsimp [z] + have hden1 : s * (1-s) ≠ 0 := (mul_pos hspos hones).ne' + have hden2 : (1-q)*(q+s)^2 ≠ 0 := + (mul_pos honeq (sq_pos_of_pos hsum)).ne' + field_simp [hden1, hden2, hones.ne'] + rw [anariRezaeiLargeCoordinatePolynomial] at hpoly + nlinarith + have htwo : 2*q/(1-s) = 2*(q/(1-s)) := by ring + rw [htwo] at hrat + have hlog' : Real.log z ≤ q/(1-s) := by linarith + linarith + +/-- The source's three-variable `phi(q,1-q-s,s)`, written with the continuous +`negMulLog` convention at `q=0` or `s=0`. -/ +noncomputable def anariRezaeiPhiThree (q s : ℝ) : ℝ := + -Real.negMulLog q - Real.negMulLog s + - (1-q+s)*Real.log (1-q) + - (1+q-s)*Real.log (1-s) + + 2*Real.negMulLog (q+s) + +theorem hasDerivAt_anariRezaeiPhiThree_right + {q s : ℝ} (hq1 : q < 1) (hs0 : 0 < s) (hs1 : s < 1) + (hq0 : 0 ≤ q) : + HasDerivAt (anariRezaeiPhiThree q) + (anariRezaeiLargeCoordinateDerivative q s) s := by + have hqsum : 0 < q+s := add_pos_of_nonneg_of_pos hq0 hs0 + have h1q : 1-q ≠ 0 := (sub_pos.mpr hq1).ne' + have h1s : 1-s ≠ 0 := (sub_pos.mpr hs1).ne' + have hsum : q+s ≠ 0 := hqsum.ne' + have hnegS := (Real.hasDerivAt_negMulLog hs0.ne').neg + have hlin1 : HasDerivAt (fun x : ℝ => 1-q+x) 1 s := by + convert! (hasDerivAt_const s (1-q)).add (hasDerivAt_id s) using 1 <;> ring + have hterm1 := (hlin1.mul_const (Real.log (1-q))).neg + have hlin2 : HasDerivAt (fun x : ℝ => 1+q-x) (-1) s := by + convert! (hasDerivAt_const s (1+q)).sub (hasDerivAt_id s) using 1 <;> ring + have hcomp2 : HasDerivAt (fun x : ℝ => Real.log (1-x)) + (-1/(1-s)) s := by + convert! (Real.hasDerivAt_log h1s).comp s + ((hasDerivAt_const s 1).sub (hasDerivAt_id s)) using 1 <;> ring + have hterm2 := (hlin2.mul hcomp2).neg + have hsumlin : HasDerivAt (fun x : ℝ => q+x) 1 s := by + convert! (hasDerivAt_const s q).add (hasDerivAt_id s) using 1 <;> ring + have hterm3 := ((Real.hasDerivAt_negMulLog hsum).comp s hsumlin).const_mul 2 + have hd := ((((hasDerivAt_const s (-Real.negMulLog q)).add hnegS).add + hterm1).add hterm2).add hterm3 + convert! hd using 1 + rw [anariRezaeiLargeCoordinateDerivative] + rw [Real.log_div (mul_ne_zero hs0.ne' h1s) + (mul_ne_zero h1q (pow_ne_zero 2 hsum)), + Real.log_mul hs0.ne' h1s, + Real.log_mul h1q (pow_ne_zero 2 hsum), Real.log_pow] + field_simp [h1s] + ring + +/-- On the central triangle, `phi(q,1-q-s,s)` is no larger than its value +after increasing the larger endpoint coordinate to `11/25`. -/ +theorem anariRezaeiPhiThree_le_boundary + {q s : ℝ} (hq0 : 0 ≤ q) (hqs : q ≤ s) + (hs : s ≤ 11/25) : + anariRezaeiPhiThree q s ≤ anariRezaeiPhiThree q (11/25) := by + have hq1 : q < 1 := (hqs.trans hs).trans_lt (by norm_num) + have hcont : ContinuousOn (anariRezaeiPhiThree q) + (Set.Icc s (11/25)) := by + intro x hx + have hx1 : x < 1 := hx.2.trans_lt (by norm_num) + have h1q : 1-q ≠ 0 := (sub_pos.mpr hq1).ne' + have h1x : 1-x ≠ 0 := (sub_pos.mpr hx1).ne' + have hnml : ContinuousAt (fun y : ℝ ↦ Real.negMulLog y) x := + Real.continuous_negMulLog.continuousAt + have hlinearQ : ContinuousAt (fun y : ℝ ↦ 1 - q + y) x := + (continuousAt_const.sub continuousAt_const).add continuousAt_id + have hlinearX : ContinuousAt (fun y : ℝ ↦ 1 + q - y) x := + (continuousAt_const.add continuousAt_const).sub continuousAt_id + have hlogQ : ContinuousAt (fun _y : ℝ ↦ Real.log (1 - q)) x := + continuousAt_const + have hlogX : ContinuousAt (fun y : ℝ ↦ Real.log (1 - y)) x := + (continuousAt_const.sub continuousAt_id).log h1x + have hnmlSum : ContinuousAt (fun y : ℝ ↦ Real.negMulLog (q + y)) x := + Real.continuous_negMulLog.continuousAt.comp' + (continuousAt_const.add continuousAt_id) + have hzero : ContinuousAt (fun _y : ℝ ↦ -Real.negMulLog q) x := + continuousAt_const + have htwo : ContinuousAt (fun _y : ℝ ↦ (2 : ℝ)) x := + continuousAt_const + have htotal := + ((((hzero.sub hnml).sub (hlinearQ.mul hlogQ)).sub + (hlinearX.mul hlogX)).add (htwo.mul hnmlSum)) + change ContinuousWithinAt (fun y : ℝ ↦ + -Real.negMulLog q - Real.negMulLog y + - (1-q+y)*Real.log (1-q) + - (1+q-y)*Real.log (1-y) + + 2*Real.negMulLog (q+y)) (Set.Icc s (11/25)) x + exact htotal.continuousWithinAt + have hdiff : DifferentiableOn ℝ (anariRezaeiPhiThree q) + (interior (Set.Icc s (11/25))) := by + intro x hx + have hx' : s < x ∧ x < 11/25 := by simpa using hx + have hx0 : 0 < x := lt_of_le_of_lt (hq0.trans hqs) hx'.1 + have hx1 : x < 1 := hx'.2.trans (by norm_num) + exact (hasDerivAt_anariRezaeiPhiThree_right hq1 hx0 hx1 hq0).differentiableAt.differentiableWithinAt + have hmono : MonotoneOn (anariRezaeiPhiThree q) + (Set.Icc s (11/25)) := + monotoneOn_of_deriv_nonneg (convex_Icc s (11/25)) hcont hdiff fun x hx => by + have hx' : s < x ∧ x < 11/25 := by simpa using hx + have hx0 : 0 < x := lt_of_le_of_lt (hq0.trans hqs) hx'.1 + have hx1 : x < 1 := hx'.2.trans (by norm_num) + rw [(hasDerivAt_anariRezaeiPhiThree_right hq1 hx0 hx1 hq0).deriv] + exact anariRezaeiLargeCoordinateDerivative_nonneg hq0 + (hqs.trans hx'.1.le) hx'.2.le hx0 + exact hmono ⟨le_rfl, hs⟩ ⟨hs, le_rfl⟩ hs + +theorem anariRezaeiPhiThree_comm (q s : ℝ) : + anariRezaeiPhiThree q s = anariRezaeiPhiThree s q := by + rw [anariRezaeiPhiThree, anariRezaeiPhiThree] + ring + +/-! On the boundary `s = 11/25`, the derivative is nonnegative after +`q = 1/5`. The following five positive Bernstein coefficients certify the +only polynomial inequality needed for that assertion. -/ + +private noncomputable def anariRezaeiEdgeCoeff (k : Fin 5) : ℝ := + match k.1 with + | 0 => 3260944 / 244140625 + | 1 => 24245392 / 244140625 + | 2 => 53151396 / 244140625 + | 3 => 41514088 / 244140625 + | 4 => 9903124 / 244140625 + | _ => 0 + +private noncomputable def anariRezaeiEdgeCertificate (v : ℝ) : ℝ := + ∑ k : Fin 5, anariRezaeiEdgeCoeff k * + v ^ k.1 * (1 - v) ^ (4 - k.1) + +private theorem anariRezaeiEdgeCoeff_nonneg (k : Fin 5) : + 0 ≤ anariRezaeiEdgeCoeff k := by + fin_cases k <;> norm_num [anariRezaeiEdgeCoeff] + +private theorem anariRezaeiEdgeCertificate_nonneg + {v : ℝ} (hv0 : 0 ≤ v) (hv1 : v ≤ 1) : + 0 ≤ anariRezaeiEdgeCertificate v := by + apply Finset.sum_nonneg + intro k _ + exact mul_nonneg (mul_nonneg (anariRezaeiEdgeCoeff_nonneg k) + (pow_nonneg hv0 _)) (pow_nonneg (sub_nonneg.mpr hv1) _) + +private theorem anariRezaeiEdgeCertificate_eq (v : ℝ) : + anariRezaeiEdgeCertificate v = + (3260944 + 11201616*v - 19116*v^2 - 5096304*v^3 + + 555984*v^4) / 244140625 := by + norm_num [anariRezaeiEdgeCertificate, anariRezaeiEdgeCoeff, + Fin.sum_univ_succ] + ring + +noncomputable def anariRezaeiEdgePolynomial (q : ℝ) : ℝ := + 2*(11/25)*(14/25)*q*(q+11/25)^2 + q^2*(1-q)^2 - + (14/25)^2*(q+11/25)^4 + +theorem anariRezaeiEdgePolynomial_nonneg + {q : ℝ} (hq0 : 1/5 ≤ q) (hq1 : q ≤ 11/25) : + 0 ≤ anariRezaeiEdgePolynomial q := by + let v : ℝ := (q - 1/5) / (6/25) + have hv0 : 0 ≤ v := div_nonneg (sub_nonneg.mpr hq0) (by norm_num) + have hv1 : v ≤ 1 := by + dsimp [v] + apply (div_le_one (by norm_num : (0 : ℝ) < 6/25)).mpr + linarith + have hc := anariRezaeiEdgeCertificate_nonneg hv0 hv1 + have hid : anariRezaeiEdgePolynomial q = + anariRezaeiEdgeCertificate v := by + rw [anariRezaeiEdgeCertificate_eq] + dsimp [anariRezaeiEdgePolynomial, v] + ring + rw [hid] + exact hc + +/-- The boundary-edge derivative is nonnegative on `[1/5, 11/25]`. -/ +theorem anariRezaeiEdgeDerivative_nonneg + {q : ℝ} (hq0 : 1/5 ≤ q) (hq1 : q ≤ 11/25) : + 0 ≤ anariRezaeiLargeCoordinateDerivative (11/25) q := by + have hqpos : 0 < q := (by norm_num : (0 : ℝ) < 1/5).trans_le hq0 + have hq_lt_one : q < 1 := hq1.trans_lt (by norm_num) + have h1q : 0 < 1-q := sub_pos.mpr hq_lt_one + have ha0 : 0 < (11/25 : ℝ) := by norm_num + have ha1 : 0 < (14/25 : ℝ) := by norm_num + have hsum : 0 < q+11/25 := add_pos hqpos ha0 + let z : ℝ := (14/25)*(q+11/25)^2/(q*(1-q)) + have hzpos : 0 < z := div_pos (mul_pos ha1 (sq_pos_of_pos hsum)) + (mul_pos hqpos h1q) + have hrewrite : anariRezaeiLargeCoordinateDerivative (11/25) q = + -Real.log z + (11/25)/(1-q) := by + rw [anariRezaeiLargeCoordinateDerivative] + have hinv : q*(1-q)/((1-11/25)*(11/25+q)^2) = z⁻¹ := by + dsimp [z] + norm_num + field_simp + ring + rw [hinv, Real.log_inv] + rw [hrewrite] + by_cases hz : z ≤ 1 + · have hlog : Real.log z ≤ 0 := Real.log_nonpos hzpos.le hz + exact add_nonneg (neg_nonneg.mpr hlog) (div_nonneg (by norm_num) h1q.le) + · have hz1 : 1 ≤ z := le_of_not_ge hz + have hlog := two_mul_log_le_sub_inv hz1 + have hpoly := anariRezaeiEdgePolynomial_nonneg hq0 hq1 + have hrat : z - 1/z ≤ 2*(11/25)/(1-q) := by + dsimp [z] + have hden1 : q*(1-q) ≠ 0 := (mul_pos hqpos h1q).ne' + have hden2 : (14/25)*(q+11/25)^2 ≠ 0 := + (mul_pos ha1 (sq_pos_of_pos hsum)).ne' + field_simp [hden1, hden2, h1q.ne'] + rw [anariRezaeiEdgePolynomial] at hpoly + nlinarith + have htwo : 2*(11/25)/(1-q) = 2*((11/25)/(1-q)) := by ring + rw [htwo] at hrat + linarith + +theorem hasDerivAt_anariRezaeiPhiThree_edge + {q : ℝ} (hq0 : 0 < q) (hq1 : q < 1) : + HasDerivAt (fun x ↦ anariRezaeiPhiThree x (11/25)) + (anariRezaeiLargeCoordinateDerivative (11/25) q) q := by + have hd := hasDerivAt_anariRezaeiPhiThree_right + (q := (11/25 : ℝ)) (s := q) (by norm_num) hq0 hq1 (by norm_num) + have heq : (fun x ↦ anariRezaeiPhiThree x (11/25)) =ᶠ[nhds q] + anariRezaeiPhiThree (11/25) := + Filter.Eventually.of_forall fun x ↦ + (anariRezaeiPhiThree_comm (11/25) x).symm + exact hd.congr_of_eventuallyEq heq + +noncomputable def anariRezaeiEdgeSecondDerivative (q : ℝ) : ℝ := + 1/q - 2/(q+11/25) - (1-q-11/25)/(1-q)^2 + +theorem hasDerivAt_anariRezaeiEdgeDerivative + {q : ℝ} (hq0 : 0 < q) (hq1 : q < 1) : + HasDerivAt (anariRezaeiLargeCoordinateDerivative (11/25)) + (anariRezaeiEdgeSecondDerivative q) q := by + have h1q : 1-q ≠ 0 := (sub_pos.mpr hq1).ne' + have hsum : q+11/25 ≠ 0 := (add_pos hq0 (by norm_num)).ne' + have hnum : q*(1-q) ≠ 0 := mul_ne_zero hq0.ne' h1q + have hden : (1-11/25)*(11/25+q)^2 ≠ 0 := by + norm_num + simpa [add_comm] using hsum + have hnum' := (hasDerivAt_id q).mul + ((hasDerivAt_const q 1).sub (hasDerivAt_id q)) + have hsum' : HasDerivAt (fun x : ℝ ↦ 11/25+x) 1 q := by + convert! (hasDerivAt_const q (11/25)).add (hasDerivAt_id q) using 1 <;> ring + have hden' : HasDerivAt + (fun x : ℝ ↦ (1-11/25)*(11/25+x)^2) + (2*(1-11/25)*(11/25+q)) q := by + convert! (hsum'.pow 2).const_mul (1-11/25) using 1 <;> ring + have hquot := hnum'.div hden' hden + have hlog := (Real.hasDerivAt_log (div_ne_zero hnum hden)).comp q hquot + have hlin : HasDerivAt (fun x : ℝ ↦ 1-x) (-1) q := by + convert! (hasDerivAt_const q 1).sub (hasDerivAt_id q) using 1 <;> ring + have hfrac := (hasDerivAt_const q (11/25 : ℝ)).div hlin h1q + have hd := hlog.add hfrac + convert! hd using 1 <;> + dsimp [anariRezaeiLargeCoordinateDerivative, + anariRezaeiEdgeSecondDerivative] <;> + field_simp [hq0.ne', h1q, hsum] <;> ring + +private theorem anariRezaeiEdgeSecondNumerator_nonneg + {q : ℝ} (hq0 : 0 ≤ q) (hq1 : q ≤ 1/5) : + 0 ≤ 11/25 - (1329/625)*q + (58/25)*q^2 := by + have hfactor1 : 0 ≤ 1/5-q := sub_nonneg.mpr hq1 + have hfactor2 : 0 ≤ 1329/625-(58/25)*(q+1/5) := by + linarith + have hprod := mul_nonneg hfactor1 hfactor2 + nlinarith + +theorem anariRezaeiEdgeSecondDerivative_nonneg + {q : ℝ} (hq0 : 0 < q) (hq1 : q ≤ 1/5) : + 0 ≤ anariRezaeiEdgeSecondDerivative q := by + have hq_lt_one : q < 1 := hq1.trans_lt (by norm_num) + have h1q : 0 < 1-q := sub_pos.mpr hq_lt_one + have hsum : 0 < q+11/25 := add_pos hq0 (by norm_num) + have hnum := anariRezaeiEdgeSecondNumerator_nonneg hq0.le hq1 + have hden : 0 < q*(q+11/25)*(1-q)^2 := + mul_pos (mul_pos hq0 hsum) (sq_pos_of_pos h1q) + have hid : anariRezaeiEdgeSecondDerivative q = + (11/25 - (1329/625)*q + (58/25)*q^2) / + (q*(q+11/25)*(1-q)^2) := by + rw [anariRezaeiEdgeSecondDerivative] + field_simp [hq0.ne', hsum.ne', h1q.ne'] + ring + rw [hid] + exact div_nonneg hnum hden.le + +private theorem continuousWithinAt_anariRezaeiPhiThree_edge + {D : Set ℝ} {q : ℝ} (hq1 : q < 1) : + ContinuousWithinAt (fun x ↦ anariRezaeiPhiThree x (11/25)) D q := by + have h1q : 1-q ≠ 0 := (sub_pos.mpr hq1).ne' + have hid : ContinuousWithinAt (fun x : ℝ ↦ x) D q := + continuousAt_id.continuousWithinAt + have hc : ContinuousWithinAt (fun _x : ℝ ↦ (11/25 : ℝ)) D q := + continuousWithinAt_const + have hnq : ContinuousWithinAt (fun x : ℝ ↦ Real.negMulLog x) D q := + Real.continuous_negMulLog.continuousAt.continuousWithinAt + have hna : ContinuousWithinAt (fun _x : ℝ ↦ Real.negMulLog (11/25)) D q := + continuousWithinAt_const + have hlogq : ContinuousWithinAt (fun x : ℝ ↦ Real.log (1-x)) D q := + (continuousWithinAt_const.sub hid).log h1q + have hloga : ContinuousWithinAt + (fun _x : ℝ ↦ Real.log (1-11/25)) D q := continuousWithinAt_const + have hnsum : ContinuousWithinAt + (fun x : ℝ ↦ Real.negMulLog (x+11/25)) D q := by + simpa [Function.comp_def] using + (Real.continuous_negMulLog.continuousAt.comp + (continuousAt_id.add continuousAt_const)).continuousWithinAt + unfold anariRezaeiPhiThree + exact (((hnq.neg.sub hna).sub + (((continuousWithinAt_const.sub hid).add hc).mul hlogq)).sub + (((continuousWithinAt_const.add hid).sub hc).mul hloga)).add + (hnsum.const_mul 2) + +/-- The boundary-edge function is convex between `0` and `1/5`. -/ +theorem anariRezaeiPhiThree_edge_convex : + ConvexOn ℝ (Set.Icc (0 : ℝ) (1/5)) + (fun q ↦ anariRezaeiPhiThree q (11/25)) := by + apply convexOn_of_hasDerivWithinAt2_nonneg (convex_Icc 0 (1/5)) + · intro q hq + have hq1 : q < 1 := hq.2.trans_lt (by norm_num) + exact continuousWithinAt_anariRezaeiPhiThree_edge hq1 + · intro q hq + have hq' : 0 < q ∧ q < 1/5 := by simpa using hq + exact (hasDerivAt_anariRezaeiPhiThree_edge hq'.1 + (hq'.2.trans (by norm_num))).hasDerivWithinAt + · intro q hq + have hq' : 0 < q ∧ q < 1/5 := by simpa using hq + exact (hasDerivAt_anariRezaeiEdgeDerivative hq'.1 + (hq'.2.trans (by norm_num))).hasDerivWithinAt + · intro q hq + have hq' : 0 < q ∧ q < 1/5 := by simpa using hq + exact anariRezaeiEdgeSecondDerivative_nonneg hq'.1 hq'.2.le + +theorem binaryEntropy_le_log_two + {t : ℝ} (ht0 : 0 ≤ t) (ht1 : t ≤ 1) : + binaryEntropy t ≤ Real.log 2 := by + let p : Fin 2 → ℝ := fun i ↦ if i = 0 then t else 1-t + have hp : IsProbabilityVector p := by + constructor + · intro i + fin_cases i <;> simp [p, ht0, sub_nonneg.mpr ht1] + · norm_num [p, Fin.sum_univ_succ] + have h := shannonEntropy_le_log_card hp + simpa [shannonEntropy, binaryEntropy, p, Fin.sum_univ_succ] using h + +theorem anariRezaeiPhiThree_zero_edge : + anariRezaeiPhiThree 0 (11/25) = binaryEntropy (11/25) := by + rw [anariRezaeiPhiThree, binaryEntropy] + simp only [Real.negMulLog_zero, neg_zero, zero_add, + Real.log_one, mul_zero, sub_zero] + rw [Real.negMulLog_def] + ring + +theorem anariRezaeiPhiThree_zero_edge_le : + anariRezaeiPhiThree 0 (11/25) ≤ Real.log 2 := by + rw [anariRezaeiPhiThree_zero_edge] + exact binaryEntropy_le_log_two (by norm_num) (by norm_num) + +/-- At the other endpoint of the boundary edge, the desired estimate reduces +to a single exact integer inequality. -/ +theorem anariRezaeiPhiThree_diagonal_le_binaryEntropy : + anariRezaeiPhiThree (11/25) (11/25) ≤ binaryEntropy (11/25) := by + have h11 : (11/25 : ℝ) ≠ 0 := by norm_num + have h14 : (14/25 : ℝ) ≠ 0 := by norm_num + have h2 : (2 : ℝ) ≠ 0 := by norm_num + have hA : (11/25 : ℝ)^11 ≠ 0 := pow_ne_zero 11 h11 + have hB : (2 : ℝ)^44 ≠ 0 := pow_ne_zero 44 h2 + have hC : (14/25 : ℝ)^36 ≠ 0 := pow_ne_zero 36 h14 + have hprod : (1 : ℝ) ≤ + (11/25 : ℝ)^11 * 2^44 * (14/25)^36 := by + norm_num + have hlogprod := Real.log_nonneg hprod + rw [Real.log_mul (mul_ne_zero hA hB) hC, + Real.log_mul hA hB, Real.log_pow, Real.log_pow, Real.log_pow] at hlogprod + have h22 : (22/25 : ℝ) = 2*(11/25) := by norm_num + rw [anariRezaeiPhiThree, binaryEntropy, Real.negMulLog_def] + norm_num only [sub_self, add_zero, Real.log_one, + mul_zero, sub_zero] + rw [h22, Real.log_mul h2 h11] + nlinarith + +theorem anariRezaeiPhiThree_diagonal_le : + anariRezaeiPhiThree (11/25) (11/25) ≤ Real.log 2 := + anariRezaeiPhiThree_diagonal_le_binaryEntropy.trans + (binaryEntropy_le_log_two (by norm_num) (by norm_num)) + +theorem anariRezaeiPhiThree_edge_le_diagonal + {q : ℝ} (hq0 : 1/5 ≤ q) (hq1 : q ≤ 11/25) : + anariRezaeiPhiThree q (11/25) ≤ + anariRezaeiPhiThree (11/25) (11/25) := by + have hcont : ContinuousOn (fun x ↦ anariRezaeiPhiThree x (11/25)) + (Set.Icc q (11/25)) := by + intro x hx + exact continuousWithinAt_anariRezaeiPhiThree_edge + (hx.2.trans_lt (by norm_num)) + have hdiff : DifferentiableOn ℝ + (fun x ↦ anariRezaeiPhiThree x (11/25)) + (interior (Set.Icc q (11/25))) := by + intro x hx + have hx' : q < x ∧ x < 11/25 := by simpa using hx + exact (hasDerivAt_anariRezaeiPhiThree_edge + ((by norm_num : (0 : ℝ) < 1/5).trans_le (hq0.trans hx'.1.le)) + (hx'.2.trans (by norm_num))).differentiableAt.differentiableWithinAt + have hmono : MonotoneOn (fun x ↦ anariRezaeiPhiThree x (11/25)) + (Set.Icc q (11/25)) := + monotoneOn_of_deriv_nonneg (convex_Icc q (11/25)) hcont hdiff + fun x hx ↦ by + have hx' : q < x ∧ x < 11/25 := by simpa using hx + rw [(hasDerivAt_anariRezaeiPhiThree_edge + ((by norm_num : (0 : ℝ) < 1/5).trans_le (hq0.trans hx'.1.le)) + (hx'.2.trans (by norm_num))).deriv] + exact anariRezaeiEdgeDerivative_nonneg (hq0.trans hx'.1.le) hx'.2.le + exact hmono ⟨le_rfl, hq1⟩ ⟨hq1, le_rfl⟩ hq1 + +/-- Every point of the boundary edge satisfies the sharp `log 2` bound. -/ +theorem anariRezaeiPhiThree_edge_le + {q : ℝ} (hq0 : 0 ≤ q) (hq1 : q ≤ 11/25) : + anariRezaeiPhiThree q (11/25) ≤ Real.log 2 := by + by_cases hq : q ≤ 1/5 + · have hmax := anariRezaeiPhiThree_edge_convex.le_max_of_mem_Icc + (x := (0 : ℝ)) (y := (1/5 : ℝ)) (z := q) + (by norm_num) (by norm_num) ⟨hq0, hq⟩ + have hright : anariRezaeiPhiThree (1/5) (11/25) ≤ Real.log 2 := + (anariRezaeiPhiThree_edge_le_diagonal (by norm_num) (by norm_num)).trans + anariRezaeiPhiThree_diagonal_le + exact hmax.trans (max_le anariRezaeiPhiThree_zero_edge_le hright) + · exact (anariRezaeiPhiThree_edge_le_diagonal (le_of_not_ge hq) hq1).trans + anariRezaeiPhiThree_diagonal_le + +/-- Exact replacement for the source's computer-assisted three-variable +base case. -/ +theorem anariRezaeiPhiThree_le_log_two + {q s : ℝ} (hq0 : 0 ≤ q) (hs0 : 0 ≤ s) + (hq : q ≤ 11/25) (hs : s ≤ 11/25) : + anariRezaeiPhiThree q s ≤ Real.log 2 := by + rcases le_total q s with hqs | hsq + · exact (anariRezaeiPhiThree_le_boundary hq0 hqs hs).trans + (anariRezaeiPhiThree_edge_le hq0 hq) + · rw [anariRezaeiPhiThree_comm] + exact (anariRezaeiPhiThree_le_boundary hs0 hsq hq).trans + (anariRezaeiPhiThree_edge_le hs0 hs) + +def anariRezaeiThreeVector (q s : ℝ) : Fin 3 → ℝ := + ![q, 1-q-s, s] + +theorem anariRezaeiThreeVector_probability + {q s : ℝ} (hq : 0 ≤ q) (hs : 0 ≤ s) (hqs : q+s ≤ 1) : + IsProbabilityVector (anariRezaeiThreeVector q s) := by + constructor + · intro i + fin_cases i <;> simp [anariRezaeiThreeVector] <;> linarith + · norm_num [anariRezaeiThreeVector, Fin.sum_univ_succ] + +theorem anariRezaeiPhi_threeVector (q s : ℝ) : + anariRezaeiPhi (anariRezaeiThreeVector q s) = + anariRezaeiPhiThree q s := by + classical + rw [anariRezaeiPhi, pairedRowScore] + simp [suffixMass, reverseOrdering, anariRezaeiThreeVector, + Fin.sum_univ_succ, anariRezaeiPhiThree] + simp only [Real.negMulLog_def] + ring_nf + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/SourceAnariRezaeiList.lean b/LeanPool/BeyondBethe/BeyondBethe/SourceAnariRezaeiList.lean new file mode 100644 index 0000000000..7fc0626063 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/SourceAnariRezaeiList.lean @@ -0,0 +1,389 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.SourceAnariRezaeiMerge + +/-! # Source Anari Rezaei List -/ + +namespace BeyondBethe + +/-! +# Dimension reduction for the Anari--Rezaei functional + +Lists expose the adjacent-merge induction without finite-index casts. The +last part of the file identifies this list functional with the canonical +`Fin n` functional used by the rest of the development. +-/ + +noncomputable def anariRezaeiRightScore : List ℝ → ℝ + | [] => 0 + | x :: xs => x * Real.log ((x :: xs).sum) + anariRezaeiRightScore xs + +noncomputable def anariRezaeiComplementScore (p : List ℝ) : ℝ := + (p.map fun x ↦ (1-x)*Real.log (1-x)).sum + +noncomputable def anariRezaeiListPhi (p : List ℝ) : ℝ := + anariRezaeiRightScore p + anariRezaeiRightScore p.reverse - + 2*anariRezaeiComplementScore p + +theorem anariRezaeiRightScore_merge + (L R : List ℝ) (r s : ℝ) : + anariRezaeiRightScore (L ++ r :: s :: R) - + anariRezaeiRightScore (L ++ (r+s) :: R) = + s*(Real.log (s+R.sum)-Real.log (r+s+R.sum)) := by + induction L with + | nil => + simp [anariRezaeiRightScore] + ring + | cons x L ih => + simp only [List.cons_append, anariRezaeiRightScore] + have hsum : (x :: (L ++ r :: s :: R)).sum = + (x :: (L ++ (r+s) :: R)).sum := by simp; ring + rw [hsum] + linarith [ih] + +theorem anariRezaeiComplementScore_merge + (L R : List ℝ) (r s : ℝ) : + anariRezaeiComplementScore (L ++ r :: s :: R) - + anariRezaeiComplementScore (L ++ (r+s) :: R) = + (1-r)*Real.log (1-r) + (1-s)*Real.log (1-s) - + (1-r-s)*Real.log (1-r-s) := by + simp [anariRezaeiComplementScore] + ring + +noncomputable def anariRezaeiMergeExpandedGap (q r s t : ℝ) : ℝ := + r*(Real.log (q+r)-Real.log (q+r+s)) + + s*(Real.log (s+t)-Real.log (r+s+t)) - + 2*(1-r)*Real.log (1-r) - + 2*(1-s)*Real.log (1-s) + + 2*(1-r-s)*Real.log (1-r-s) + +theorem anariRezaeiListPhi_merge (L R : List ℝ) (r s : ℝ) : + anariRezaeiListPhi (L ++ r :: s :: R) - + anariRezaeiListPhi (L ++ (r+s) :: R) = + anariRezaeiMergeExpandedGap L.sum r s R.sum := by + have hrevOld : (L ++ r :: s :: R).reverse = + R.reverse ++ s :: r :: L.reverse := by simp + have hrevNew : (L ++ (r+s) :: R).reverse = + R.reverse ++ (s+r) :: L.reverse := by simp [add_comm] + have hf := anariRezaeiRightScore_merge L R r s + have hb := anariRezaeiRightScore_merge R.reverse L.reverse s r + have hc := anariRezaeiComplementScore_merge L R r s + have hb' : + anariRezaeiRightScore (R.reverse ++ s :: r :: L.reverse) - + anariRezaeiRightScore (R.reverse ++ (s+r) :: L.reverse) = + r*(Real.log (L.sum+r)-Real.log (L.sum+r+s)) := by + simpa [add_comm, add_left_comm, add_assoc] using hb + rw [anariRezaeiListPhi, anariRezaeiListPhi, hrevOld, hrevNew, + anariRezaeiMergeExpandedGap] + linear_combination hf + hb' - 2*hc + +theorem anariRezaeiMergeExpandedGap_nonpos + {q r s t : ℝ} (hq0 : 0 ≤ q) (hr0 : 0 ≤ r) + (hs0 : 0 ≤ s) (ht0 : 0 ≤ t) + (hsum : q+r+s+t = 1) (hC : r+s ≤ 14/25) : + anariRezaeiMergeExpandedGap q r s t ≤ 0 := by + by_cases hrz : r = 0 + · subst r + rw [anariRezaeiMergeExpandedGap] + norm_num + · by_cases hsz : s = 0 + · subst s + rw [anariRezaeiMergeExpandedGap] + norm_num + · have hr : 0 < r := lt_of_le_of_ne hr0 (Ne.symm hrz) + have hs : 0 < s := lt_of_le_of_ne hs0 (Ne.symm hsz) + have hqr : 0 < q+r := add_pos_of_nonneg_of_pos hq0 hr + have hqrs : 0 < q+r+s := add_pos hqr hs + have hst : 0 < s+t := add_pos_of_pos_of_nonneg hs ht0 + have hrst : 0 < r+s+t := add_pos_of_pos_of_nonneg (add_pos hr hs) ht0 + have heq : anariRezaeiMergeExpandedGap q r s t = + anariRezaeiMergeGap q r s t := by + rw [anariRezaeiMergeExpandedGap, anariRezaeiMergeGap, + Real.log_div hqr.ne' hqrs.ne', Real.log_div hst.ne' hrst.ne'] + rw [heq] + exact anariRezaeiMergeGap_nonpos hq0 hr0 hs0 ht0 hsum hC + +theorem anariRezaeiListPhi_le_of_merge + {L R : List ℝ} {r s : ℝ} + (hL : ∀ x ∈ L, 0 ≤ x) (hR : ∀ x ∈ R, 0 ≤ x) + (hr0 : 0 ≤ r) (hs0 : 0 ≤ s) + (hsum : (L ++ r :: s :: R).sum = 1) + (hC : r+s ≤ 14/25) : + anariRezaeiListPhi (L ++ r :: s :: R) ≤ + anariRezaeiListPhi (L ++ (r+s) :: R) := by + have hLsum : 0 ≤ L.sum := List.sum_nonneg hL + have hRsum : 0 ≤ R.sum := List.sum_nonneg hR + have hquad : L.sum+r+s+R.sum = 1 := by + simp only [List.sum_append, List.sum_cons, List.sum_nil] at hsum + linarith + have hgap := anariRezaeiMergeExpandedGap_nonpos + hLsum hr0 hs0 hRsum hquad hC + rw [← anariRezaeiListPhi_merge] at hgap + linarith + +theorem anariRezaeiListPhi_two + {q s : ℝ} (hsum : q+s = 1) : + anariRezaeiListPhi [q,s] = binaryEntropy q := by + have hs : s = 1-q := by linarith + subst s + simp [anariRezaeiListPhi, anariRezaeiRightScore, + anariRezaeiComplementScore, binaryEntropy, Real.negMulLog_def] + ring + +theorem anariRezaeiListPhi_two_le + {q s : ℝ} (hq0 : 0 ≤ q) (hs0 : 0 ≤ s) + (hsum : q+s = 1) : + anariRezaeiListPhi [q,s] ≤ Real.log 2 := by + rw [anariRezaeiListPhi_two hsum] + apply binaryEntropy_le_log_two hq0 + linarith + +theorem anariRezaeiListPhi_three + {q r s : ℝ} (hsum : q+r+s = 1) : + anariRezaeiListPhi [q,r,s] = anariRezaeiPhiThree q s := by + have hr : r = 1-q-s := by linarith + subst r + simp [anariRezaeiListPhi, anariRezaeiRightScore, + anariRezaeiComplementScore, anariRezaeiPhiThree, + Real.negMulLog_def] + ring_nf + rw [Real.log_one] + ring + +theorem anariRezaeiListPhi_three_le + {q r s : ℝ} (hq0 : 0 ≤ q) (hr0 : 0 ≤ r) (hs0 : 0 ≤ s) + (hsum : q+r+s = 1) : + anariRezaeiListPhi [q,r,s] ≤ Real.log 2 := by + by_cases hqr : q+r ≤ 14/25 + · calc + anariRezaeiListPhi [q,r,s] ≤ anariRezaeiListPhi [q+r,s] := by + simpa using anariRezaeiListPhi_le_of_merge + (L := []) (R := [s]) (r := q) (s := r) + (by simp) (by simpa) hq0 hr0 (by norm_num; linarith) hqr + _ ≤ Real.log 2 := anariRezaeiListPhi_two_le + (add_nonneg hq0 hr0) hs0 (by linarith) + · by_cases hrs : r+s ≤ 14/25 + · calc + anariRezaeiListPhi [q,r,s] ≤ anariRezaeiListPhi [q,r+s] := by + simpa using anariRezaeiListPhi_le_of_merge + (L := [q]) (R := []) (r := r) (s := s) + (by simpa) (by simp) hr0 hs0 (by norm_num; linarith) hrs + _ ≤ Real.log 2 := anariRezaeiListPhi_two_le + hq0 (add_nonneg hr0 hs0) (by linarith) + · rw [anariRezaeiListPhi_three hsum] + apply anariRezaeiPhiThree_le_log_two hq0 hs0 + · linarith + · linarith + +private theorem anariRezaeiListPhi_le_log_two_fuel + (fuel : ℕ) (p : List ℝ) (hlen : p.length ≤ fuel) + (hp : ∀ x ∈ p, 0 ≤ x) (hsum : p.sum = 1) : + anariRezaeiListPhi p ≤ Real.log 2 := by + induction fuel generalizing p with + | zero => + have hpempty : p = [] := List.length_eq_zero_iff.mp + (Nat.eq_zero_of_le_zero hlen) + subst p + simp at hsum + | succ fuel ih => + rcases p with _ | ⟨a, p⟩ + · simp at hsum + rcases p with _ | ⟨b, p⟩ + · have ha : a = 1 := by simpa using hsum + subst a + simp [anariRezaeiListPhi, anariRezaeiRightScore, + anariRezaeiComplementScore] + exact Real.log_nonneg (by norm_num) + rcases p with _ | ⟨c, p⟩ + · apply anariRezaeiListPhi_two_le + · exact hp a (by simp) + · exact hp b (by simp) + · norm_num at hsum ⊢ + linarith + rcases p with _ | ⟨d, R⟩ + · apply anariRezaeiListPhi_three_le + · exact hp a (by simp) + · exact hp b (by simp) + · exact hp c (by simp) + · norm_num at hsum ⊢ + linarith + have ha : 0 ≤ a := hp a (by simp) + have hb : 0 ≤ b := hp b (by simp) + have hc : 0 ≤ c := hp c (by simp) + have hd : 0 ≤ d := hp d (by simp) + have hR : ∀ x ∈ R, 0 ≤ x := by + intro x hx + exact hp x (by simp [hx]) + have hRsum : 0 ≤ R.sum := List.sum_nonneg hR + have hsum' : a+b+c+d+R.sum = 1 := by + norm_num at hsum + linarith + by_cases hab : a+b ≤ 1/2 + · let p' := (a+b) :: c :: d :: R + have hp' : ∀ x ∈ p', 0 ≤ x := by + intro x hx + simp only [p', List.mem_cons] at hx + rcases hx with rfl | rfl | rfl | hx + · exact add_nonneg ha hb + · exact hc + · exact hd + · exact hR x hx + have hp'sum : p'.sum = 1 := by + dsimp [p'] + norm_num + linarith + have hp'len : p'.length ≤ fuel := by + dsimp [p'] + simp at hlen ⊢ + omega + have hmerge : anariRezaeiListPhi (a :: b :: c :: d :: R) ≤ + anariRezaeiListPhi p' := by + simpa [p'] using anariRezaeiListPhi_le_of_merge + (L := []) (R := c :: d :: R) (r := a) (s := b) + (by simp) (by + intro x hx + simp only [List.mem_cons] at hx + rcases hx with rfl | rfl | hx + · exact hc + · exact hd + · exact hR x hx) + ha hb (by norm_num; linarith) (hab.trans (by norm_num)) + exact hmerge.trans (ih p' hp'len hp' hp'sum) + · have hcd : c+d ≤ 1/2 := by + have hab' : 1/2 < a+b := lt_of_not_ge hab + linarith + let p' := a :: b :: (c+d) :: R + have hp' : ∀ x ∈ p', 0 ≤ x := by + intro x hx + simp only [p', List.mem_cons] at hx + rcases hx with rfl | rfl | rfl | hx + · exact ha + · exact hb + · exact add_nonneg hc hd + · exact hR x hx + have hp'sum : p'.sum = 1 := by + dsimp [p'] + norm_num + linarith + have hp'len : p'.length ≤ fuel := by + dsimp [p'] + simp at hlen ⊢ + omega + have hmerge : anariRezaeiListPhi (a :: b :: c :: d :: R) ≤ + anariRezaeiListPhi p' := by + simpa [p'] using anariRezaeiListPhi_le_of_merge + (L := [a,b]) (R := R) (r := c) (s := d) + (by simp [ha, hb]) hR hc hd + (by norm_num; linarith) (hcd.trans (by norm_num)) + exact hmerge.trans (ih p' hp'len hp' hp'sum) + +/-- The sharp `log 2` bound for probability lists of arbitrary length. -/ +theorem anariRezaeiListPhi_le_log_two_of_probability + (p : List ℝ) (hp : ∀ x ∈ p, 0 ≤ x) (hsum : p.sum = 1) : + anariRezaeiListPhi p ≤ Real.log 2 := + anariRezaeiListPhi_le_log_two_fuel p.length p le_rfl hp hsum + +/-! ## Identification with the finite-coordinate functional -/ + +theorem list_sum_ofFn_eq_fin_sum {m : ℕ} (p : Fin m → ℝ) : + (List.ofFn p).sum = ∑ i, p i := by + induction m with + | zero => simp [List.ofFn_zero] + | succ m ih => + rw [List.ofFn_succ, Fin.sum_univ_succ] + simp only [List.sum_cons] + rw [ih] + +theorem anariRezaeiRightScore_ofFn {m : ℕ} (p : Fin m → ℝ) : + anariRezaeiRightScore (List.ofFn p) = + ∑ j, p j * Real.log (suffixMass p (Equiv.refl (Fin m)) j) := by + induction m with + | zero => simp [List.ofFn_zero, anariRezaeiRightScore, suffixMass] + | succ m ih => + rw [List.ofFn_succ, anariRezaeiRightScore, Fin.sum_univ_succ] + rw [ih (fun i ↦ p i.succ)] + have hsum : (p 0 :: List.ofFn fun i ↦ p i.succ).sum = ∑ i, p i := by + rw [List.sum_cons, list_sum_ofFn_eq_fin_sum, Fin.sum_univ_succ] + have hzero : suffixMass p (Equiv.refl (Fin (m+1))) 0 = ∑ i, p i := by + simp [suffixMass] + rw [hsum, hzero] + congr 1 + apply Finset.sum_congr rfl + intro j _ + congr 2 + rw [suffixMass, suffixMass, Fin.sum_univ_succ] + simp + rfl + +theorem anariRezaeiComplementScore_ofFn {m : ℕ} (p : Fin m → ℝ) : + anariRezaeiComplementScore (List.ofFn p) = + ∑ j, (1-p j)*Real.log (1-p j) := by + rw [anariRezaeiComplementScore] + rw [List.map_ofFn] + simpa [Function.comp_def] using + list_sum_ofFn_eq_fin_sum (fun j ↦ (1-p j)*Real.log (1-p j)) + +theorem ofFn_orderCoordinates_revPerm {m : ℕ} (p : Fin m → ℝ) : + List.ofFn (orderCoordinates p Fin.revPerm) = (List.ofFn p).reverse := by + apply List.ext_getElem + · simp + · intro i hi hri + rw [List.getElem_ofFn, List.getElem_reverse, List.getElem_ofFn] + apply congrArg p + apply Fin.ext + simp [orderCoordinates, Fin.revPerm_apply, Fin.val_rev] + omega + +theorem anariRezaeiReverseScore_ofFn {m : ℕ} (p : Fin m → ℝ) : + anariRezaeiRightScore (List.ofFn p).reverse = + ∑ j, p j * Real.log + (suffixMass p (reverseOrdering (Equiv.refl (Fin m))) j) := by + let f : Fin m → ℝ := fun j ↦ p j * Real.log + (suffixMass p (reverseOrdering (Equiv.refl (Fin m))) j) + calc + anariRezaeiRightScore (List.ofFn p).reverse = + anariRezaeiRightScore + (List.ofFn (orderCoordinates p Fin.revPerm)) := by + rw [ofFn_orderCoordinates_revPerm] + _ = ∑ i, orderCoordinates p Fin.revPerm i * + Real.log (suffixMass (orderCoordinates p Fin.revPerm) + (Equiv.refl (Fin m)) i) := + anariRezaeiRightScore_ofFn _ + _ = ∑ i, f (Fin.revPerm i) := by + apply Finset.sum_congr rfl + intro i _ + rw [suffixMass_orderCoordinates] + rfl + _ = ∑ j, f j := Equiv.sum_comp Fin.revPerm f + _ = ∑ j, p j * Real.log + (suffixMass p (reverseOrdering (Equiv.refl (Fin m))) j) := rfl + +theorem anariRezaeiListPhi_ofFn {m : ℕ} (p : Fin m → ℝ) : + anariRezaeiListPhi (List.ofFn p) = anariRezaeiPhi p := by + rw [anariRezaeiListPhi, anariRezaeiPhi, pairedRowScore, + anariRezaeiRightScore_ofFn, anariRezaeiReverseScore_ofFn, + anariRezaeiComplementScore_ofFn] + +/-- The source's sharp one-row inequality, now without an interface +hypothesis. -/ +theorem anariRezaeiPhi_le_log_two + {m : ℕ} (p : Fin m → ℝ) (hp : IsProbabilityVector p) : + anariRezaeiPhi p ≤ Real.log 2 := by + rw [← anariRezaeiListPhi_ofFn] + apply anariRezaeiListPhi_le_log_two_of_probability + · intro x hx + rw [List.mem_ofFn] at hx + rcases hx with ⟨i, rfl⟩ + exact hp.nonnegative i + · rw [list_sum_ofFn_eq_fin_sum, hp.sum_eq_one] + +theorem anariRezaeiRowInequality : AnariRezaeiRowInequality := by + apply anariRezaeiRowInequality_of_phi + intro m _hm p hp + exact anariRezaeiPhi_le_log_two p hp + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/SourceAnariRezaeiMerge.lean b/LeanPool/BeyondBethe/BeyondBethe/SourceAnariRezaeiMerge.lean new file mode 100644 index 0000000000..4d6c37a654 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/SourceAnariRezaeiMerge.lean @@ -0,0 +1,480 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.SourceAnariRezaei + +/-! # Source Anari Rezaei Merge -/ + +open scoped BigOperators + +namespace BeyondBethe + +/-! +# The Anari--Rezaei merge argument + +This file formalizes the dimension-reduction lemma in the source proof. We +use the rational cutoff `14/25`; it is smaller than the source cutoff and its +complement is exactly the `11/25` used by the analytic three-variable proof. +-/ + +/-- Loss in `phi` before two adjacent masses `r,s` are merged. -/ +noncomputable def anariRezaeiMergeGap (q r s t : ℝ) : ℝ := + r * Real.log ((q+r)/(q+r+s)) + + s * Real.log ((s+t)/(r+s+t)) - + 2*(1-r)*Real.log (1-r) - + 2*(1-s)*Real.log (1-s) + + 2*(1-r-s)*Real.log (1-r-s) + +/-- The value of the merge gap at its stationary choice of the exterior +masses. -/ +noncomputable def anariRezaeiMergePsi (r s : ℝ) : ℝ := + -(r+s)*Real.log (1+r+s) + + (s-r)*Real.log ((1+s)/(1+r)) - + 2*(1-r)*Real.log (1-r) - + 2*(1-s)*Real.log (1-s) + + 2*(1-r-s)*Real.log (1-r-s) + +noncomputable def anariRezaeiMergePsiAlong (C x : ℝ) : ℝ := + anariRezaeiMergePsi x (C-x) + +noncomputable def anariRezaeiMergePsiDerivative (r s : ℝ) : ℝ := + -2*Real.log ((1+s)/(1+r)) - + (s-r)*(1/(1+r)+1/(1+s)) + + 2*Real.log ((1-r)/(1-s)) + +theorem anariRezaeiMergePsi_zero (C : ℝ) : + anariRezaeiMergePsi 0 C = 0 := by + rw [anariRezaeiMergePsi] + norm_num + +theorem hasDerivAt_anariRezaeiMergePsiAlong + {C x : ℝ} (hx0 : 0 ≤ x) (hxC : x ≤ C) + (hC : C < 1) : + HasDerivAt (anariRezaeiMergePsiAlong C) + (anariRezaeiMergePsiDerivative x (C-x)) x := by + have h1px : 1+x ≠ 0 := by linarith + have h1ps : 1+(C-x) ≠ 0 := by linarith + have h1mx : 1-x ≠ 0 := by linarith + have h1ms : 1-(C-x) ≠ 0 := by linarith + have hconst : HasDerivAt (fun _y : ℝ ↦ C) 0 x := hasDerivAt_const x C + have hid := hasDerivAt_id x + have hs := hconst.sub hid + have h1px' := (hasDerivAt_const x 1).add hid + have h1ps' := (hasDerivAt_const x 1).add hs + have hratioPlus := h1ps'.div h1px' h1px + have hlogPlus := (Real.hasDerivAt_log (div_ne_zero h1ps h1px)).comp x hratioPlus + have hdiff := hs.sub hid + have hmiddle := hdiff.mul hlogPlus + have h1mx' := (hasDerivAt_const x 1).sub hid + have h1ms' := (hasDerivAt_const x 1).sub hs + have hlogmx := (Real.hasDerivAt_log h1mx).comp x h1mx' + have hlogms := (Real.hasDerivAt_log h1ms).comp x h1ms' + have hxm := (h1mx'.mul hlogmx).const_mul (-2) + have hsm := (h1ms'.mul hlogms).const_mul (-2) + have hlast : HasDerivAt + (fun _y : ℝ ↦ 2*(1-C)*Real.log (1-C)) 0 x := + hasDerivAt_const x _ + have hfirst : HasDerivAt + (fun _y : ℝ ↦ -C*Real.log (1+C)) 0 x := + hasDerivAt_const x _ + have hd := (((hfirst.add hmiddle).add hxm).add hsm).add hlast + convert! hd using 1 + · funext y + simp only [anariRezaeiMergePsiAlong, anariRezaeiMergePsi, + Function.comp_apply, Pi.add_apply, Pi.sub_apply, Pi.mul_apply, + Pi.div_apply, id_eq] + ring + · dsimp [anariRezaeiMergePsiDerivative] + rw [Real.log_div h1mx h1ms] + try simp only [Function.comp_apply, Pi.add_apply, Pi.sub_apply, + Pi.mul_apply, Pi.div_apply, id_eq] + field_simp [h1px, h1ps, h1mx, h1ms] + ring + +/-- The derivative of `psi(x,C-x)` is nonpositive on its first half. The +proof uses the elementary hyperbolic logarithm bound and exact polynomial +arithmetic; it replaces the integral estimate in the source. -/ +theorem anariRezaeiMergePsiDerivative_nonpos + {r s : ℝ} (hr0 : 0 ≤ r) (hrs : r ≤ s) + (hC : r+s ≤ 14/25) : + anariRezaeiMergePsiDerivative r s ≤ 0 := by + have hs0 : 0 ≤ s := hr0.trans hrs + have hs1 : s < 1 := (le_add_of_nonneg_left hr0).trans hC |>.trans_lt (by norm_num) + have hr1 : r < 1 := hrs.trans_lt hs1 + have h1mr : 0 < 1-r := sub_pos.mpr hr1 + have h1ms : 0 < 1-s := sub_pos.mpr hs1 + have h1pr : 0 < 1+r := by linarith + have h1ps : 0 < 1+s := by linarith + let z : ℝ := (1-r^2)/(1-s^2) + have hden : 0 < 1-s^2 := by nlinarith + have hnum : 0 < 1-r^2 := by nlinarith + have hzpos : 0 < z := div_pos hnum hden + have hz1 : 1 ≤ z := by + apply (one_le_div hden).mpr + nlinarith [mul_self_le_mul_self (by linarith : 0 ≤ r) hrs] + have hlog := two_mul_log_le_sub_inv hz1 + have hcut : 0 ≤ 2-3*(r+s)-(r+s)^2 := by + have hfac : 0 ≤ (14/25-(r+s))*(3+14/25+(r+s)) := + mul_nonneg (sub_nonneg.mpr hC) (by positivity) + nlinarith + have hrat : z-1/z ≤ + (s-r)*(1/(1+r)+1/(1+s)) := by + dsimp [z] + have hA : 1-r^2 ≠ 0 := hnum.ne' + have hB : 1-s^2 ≠ 0 := hden.ne' + field_simp [hA, hB, h1pr.ne', h1ps.ne'] + have hrs0 : 0 ≤ r*s := mul_nonneg hr0 hs0 + have h2C : 0 ≤ 2-(r+s) := by linarith + have hextra : 0 ≤ (r+s)^3 + (2-(r+s))*(r*s) := + add_nonneg (pow_nonneg (add_nonneg hr0 hs0) 3) + (mul_nonneg h2C hrs0) + have hD : 0 ≤ 2-3*(r+s)-(r+s)^2 + + ((r+s)^3 + (2-(r+s))*(r*s)) := add_nonneg hcut hextra + have hfactor : 0 ≤ (s-r)*(1+r)*(1+s)* + (2-3*(r+s)-(r+s)^2 + + ((r+s)^3 + (2-(r+s))*(r*s))) := by positivity + nlinarith + have hlogRewrite : Real.log z = + Real.log ((1-r)/(1-s)) - Real.log ((1+s)/(1+r)) := by + have hzEq : z = ((1-r)/(1-s))/((1+s)/(1+r)) := by + dsimp [z] + field_simp [h1mr.ne', h1ms.ne', h1pr.ne', h1ps.ne'] + ring + rw [hzEq, Real.log_div (div_ne_zero h1mr.ne' h1ms.ne') + (div_ne_zero h1ps.ne' h1pr.ne')] + rw [hlogRewrite] at hlog + rw [anariRezaeiMergePsiDerivative] + linarith + +theorem anariRezaeiMergePsi_nonpos_ordered + {r s : ℝ} (hr0 : 0 ≤ r) (hrs : r ≤ s) + (hC : r+s ≤ 14/25) : + anariRezaeiMergePsi r s ≤ 0 := by + let C := r+s + have hC0 : 0 ≤ C := add_nonneg hr0 (hr0.trans hrs) + have hrC : r ≤ C := le_add_of_nonneg_right (hr0.trans hrs) + have hClt : C < 1 := hC.trans_lt (by norm_num) + have hcont : ContinuousOn (anariRezaeiMergePsiAlong C) (Set.Icc 0 r) := by + intro x hx + exact (hasDerivAt_anariRezaeiMergePsiAlong hx.1 (hx.2.trans hrC) hClt).continuousAt.continuousWithinAt + have hdiff : DifferentiableOn ℝ (anariRezaeiMergePsiAlong C) + (interior (Set.Icc 0 r)) := by + intro x hx + have hx' : 0 < x ∧ x < r := by simpa using hx + exact (hasDerivAt_anariRezaeiMergePsiAlong hx'.1.le + (hx'.2.le.trans hrC) hClt).differentiableAt.differentiableWithinAt + have hanti : AntitoneOn (anariRezaeiMergePsiAlong C) (Set.Icc 0 r) := + antitoneOn_of_deriv_nonpos (convex_Icc 0 r) hcont hdiff fun x hx ↦ by + have hx' : 0 < x ∧ x < r := by simpa using hx + rw [(hasDerivAt_anariRezaeiMergePsiAlong hx'.1.le + (hx'.2.le.trans hrC) hClt).deriv] + apply anariRezaeiMergePsiDerivative_nonpos hx'.1.le + · dsimp [C] + linarith + · dsimp [C] + ring_nf + exact hC + have hle := hanti ⟨le_rfl, hr0⟩ ⟨hr0, le_rfl⟩ hr0 + dsimp [anariRezaeiMergePsiAlong, C] at hle + rw [show r+s-r=s by ring, anariRezaeiMergePsi_zero] at hle + exact hle + +theorem anariRezaeiMergePsi_comm + {r s : ℝ} (hr0 : 0 ≤ r) (hs0 : 0 ≤ s) : + anariRezaeiMergePsi r s = anariRezaeiMergePsi s r := by + have h1pr : 1+r ≠ 0 := by linarith + have h1ps : 1+s ≠ 0 := by linarith + rw [anariRezaeiMergePsi, anariRezaeiMergePsi] + rw [Real.log_div h1ps h1pr, Real.log_div h1pr h1ps] + ring + +theorem anariRezaeiMergePsi_nonpos + {r s : ℝ} (hr0 : 0 ≤ r) (hs0 : 0 ≤ s) + (hC : r+s ≤ 14/25) : + anariRezaeiMergePsi r s ≤ 0 := by + rcases le_total r s with hrs | hsr + · exact anariRezaeiMergePsi_nonpos_ordered hr0 hrs hC + · rw [anariRezaeiMergePsi_comm hr0 hs0] + exact anariRezaeiMergePsi_nonpos_ordered hs0 hsr (by linarith) + +noncomputable def anariRezaeiMergeQStar (r s : ℝ) : ℝ := + (1-r*(1+r+s))/(2+r+s) + +noncomputable def anariRezaeiMergeTStar (r s : ℝ) : ℝ := + (1-s*(1+r+s))/(2+r+s) + +private theorem anariRezaeiCutoff_product + {C : ℝ} (hC0 : 0 ≤ C) (hC : C ≤ 14/25) : + C*(1+C) < 1 := by + have hfac : 0 ≤ (14/25-C)*(1+14/25+C) := + mul_nonneg (sub_nonneg.mpr hC) (by positivity) + nlinarith + +theorem anariRezaeiMergeStars_nonnegative + {r s : ℝ} (hr0 : 0 ≤ r) (hs0 : 0 ≤ s) + (hC : r+s ≤ 14/25) : + 0 ≤ anariRezaeiMergeQStar r s ∧ + 0 ≤ anariRezaeiMergeTStar r s := by + have hC0 : 0 ≤ r+s := add_nonneg hr0 hs0 + have hprod := anariRezaeiCutoff_product hC0 hC + have hrC : r ≤ r+s := le_add_of_nonneg_right hs0 + have hsC : s ≤ r+s := le_add_of_nonneg_left hr0 + have hden : 0 < 2+r+s := by linarith + constructor + · rw [anariRezaeiMergeQStar] + exact div_nonneg (by nlinarith) hden.le + · rw [anariRezaeiMergeTStar] + exact div_nonneg (by nlinarith) hden.le + +theorem anariRezaeiMergeStars_sum (r s : ℝ) (hden : 2+r+s ≠ 0) : + anariRezaeiMergeQStar r s + anariRezaeiMergeTStar r s = + 1-r-s := by + rw [anariRezaeiMergeQStar, anariRezaeiMergeTStar] + field_simp [hden] + ring + +noncomputable def anariRezaeiMergeGapAlong (r s x : ℝ) : ℝ := + anariRezaeiMergeGap x r s (1-r-s-x) + +noncomputable def anariRezaeiMergeGapDerivative (r s x : ℝ) : ℝ := + r*s*(1/((x+r)*(x+r+s)) - + 1/((1-r-x)*(1-x))) + +theorem hasDerivAt_anariRezaeiMergeGapAlong + {r s x : ℝ} (hr : 0 < r) (hs : 0 < s) + (hx0 : 0 ≤ x) (ht0 : 0 ≤ 1-r-s-x) : + HasDerivAt (anariRezaeiMergeGapAlong r s) + (anariRezaeiMergeGapDerivative r s x) x := by + have hxr : 0 < x+r := add_pos_of_nonneg_of_pos hx0 hr + have hxC : 0 < x+r+s := add_pos hxr hs + have hst : 0 < s+(1-r-s-x) := add_pos_of_pos_of_nonneg hs ht0 + have hCt : 0 < r+s+(1-r-s-x) := add_pos_of_pos_of_nonneg (add_pos hr hs) ht0 + have hid := hasDerivAt_id x + have hxR := hid.add_const r + have hxC' := (hid.add_const r).add_const s + have hratio1 := hxR.div hxC' hxC.ne' + have hlog1 := (Real.hasDerivAt_log (div_ne_zero hxr.ne' hxC.ne')).comp x hratio1 + have hst2 : 0 < 1-r-x := by linarith + have hCt2 : 0 < 1-x := by linarith + have hsT' := (hasDerivAt_const x (1-r)).sub hid + have hCT' := (hasDerivAt_const x 1).sub hid + have hratio2 := hsT'.div hCT' hCt2.ne' + have hlog2 := (Real.hasDerivAt_log + (div_ne_zero hst2.ne' hCt2.ne')).comp x hratio2 + have hvar := (hlog1.const_mul r).add (hlog2.const_mul s) + have hconst : HasDerivAt (fun _y : ℝ ↦ + -2*(1-r)*Real.log (1-r) - + 2*(1-s)*Real.log (1-s) + + 2*(1-r-s)*Real.log (1-r-s)) 0 x := hasDerivAt_const x _ + have hd := hvar.add hconst + convert! hd using 1 + · funext y + simp only [anariRezaeiMergeGapAlong, anariRezaeiMergeGap, + Function.comp_apply, Pi.add_apply, Pi.sub_apply, Pi.div_apply, id_eq] + ring + · dsimp [anariRezaeiMergeGapDerivative] + try simp only [Function.comp_apply, Pi.add_apply, Pi.sub_apply, + Pi.div_apply, id_eq] + field_simp [hxr.ne', hxC.ne', hst2.ne', hCt2.ne'] + ring + +theorem anariRezaeiMergeGapDerivative_sign + {r s x : ℝ} (hr : 0 < r) (hs : 0 < s) + (hx0 : 0 ≤ x) (ht0 : 0 ≤ 1-r-s-x) : + (0 ≤ anariRezaeiMergeGapDerivative r s x ↔ + x ≤ anariRezaeiMergeQStar r s) ∧ + (anariRezaeiMergeGapDerivative r s x ≤ 0 ↔ + anariRezaeiMergeQStar r s ≤ x) := by + have hxr : 0 < x+r := add_pos_of_nonneg_of_pos hx0 hr + have hxC : 0 < x+r+s := add_pos hxr hs + have hst : 0 < 1-r-x := by linarith + have hCt : 0 < 1-x := by linarith + have hden : 0 < (x+r)*(x+r+s)*(1-r-x)*(1-x) := by positivity + have hstar : 0 < 2+r+s := by positivity + have hid : anariRezaeiMergeGapDerivative r s x = + r*s*(1-r*(1+r+s)-(2+r+s)*x) / + ((x+r)*(x+r+s)*(1-r-x)*(1-x)) := by + rw [anariRezaeiMergeGapDerivative] + field_simp [hxr.ne', hxC.ne', hst.ne', hCt.ne'] + ring + rw [hid] + have hrs : 0 < r*s := mul_pos hr hs + constructor + · constructor + · intro h + have hmul := mul_nonneg h hden.le + rw [div_mul_cancel₀ _ hden.ne'] at hmul + have hlin : 0 ≤ 1-r*(1+r+s)-(2+r+s)*x := + nonneg_of_mul_nonneg_right hmul hrs + rw [anariRezaeiMergeQStar, (le_div_iff₀ hstar)] + linarith + · intro h + rw [anariRezaeiMergeQStar, (le_div_iff₀ hstar)] at h + exact div_nonneg (mul_nonneg hrs.le (by linarith)) hden.le + · constructor + · intro h + have hmul := mul_nonpos_of_nonpos_of_nonneg h hden.le + rw [div_mul_cancel₀ _ hden.ne'] at hmul + have hlin : 1-r*(1+r+s)-(2+r+s)*x ≤ 0 := + nonpos_of_mul_nonpos_right hmul hrs + rw [anariRezaeiMergeQStar, (div_le_iff₀ hstar)] + linarith + · intro h + rw [anariRezaeiMergeQStar, (div_le_iff₀ hstar)] at h + exact div_nonpos_of_nonpos_of_nonneg + (mul_nonpos_of_nonneg_of_nonpos hrs.le (by linarith)) hden.le + +theorem anariRezaeiMergeGap_le_stationary + {q r s t : ℝ} (hq0 : 0 ≤ q) (hr : 0 < r) (hs : 0 < s) + (ht0 : 0 ≤ t) (hsum : q+r+s+t = 1) + (hC : r+s ≤ 14/25) : + anariRezaeiMergeGap q r s t ≤ + anariRezaeiMergeGap (anariRezaeiMergeQStar r s) r s + (anariRezaeiMergeTStar r s) := by + have hstars := anariRezaeiMergeStars_nonnegative hr.le hs.le hC + have hqstar0 := hstars.1 + have htstar0 := hstars.2 + have htEq : t = 1-r-s-q := by linarith + have hden : 2+r+s ≠ 0 := by positivity + have hstarEq : anariRezaeiMergeTStar r s = + 1-r-s-anariRezaeiMergeQStar r s := by + linarith [anariRezaeiMergeStars_sum r s hden] + have hcapStar : 0 ≤ 1-r-s-anariRezaeiMergeQStar r s := by + rw [← hstarEq] + exact htstar0 + subst t + rw [hstarEq] + change anariRezaeiMergeGapAlong r s q ≤ + anariRezaeiMergeGapAlong r s (anariRezaeiMergeQStar r s) + rcases le_total q (anariRezaeiMergeQStar r s) with hq | hq + · have hcont : ContinuousOn (anariRezaeiMergeGapAlong r s) + (Set.Icc q (anariRezaeiMergeQStar r s)) := by + intro x hx + exact (hasDerivAt_anariRezaeiMergeGapAlong hr hs + (hq0.trans hx.1) (by linarith [hcapStar, hx.2])).continuousAt.continuousWithinAt + have hdiff : DifferentiableOn ℝ (anariRezaeiMergeGapAlong r s) + (interior (Set.Icc q (anariRezaeiMergeQStar r s))) := by + intro x hx + have hx' : q < x ∧ x < anariRezaeiMergeQStar r s := by simpa using hx + exact (hasDerivAt_anariRezaeiMergeGapAlong hr hs + (hq0.trans hx'.1.le) (by linarith [hcapStar, hx'.2.le])).differentiableAt.differentiableWithinAt + have hmono := monotoneOn_of_deriv_nonneg + (convex_Icc q (anariRezaeiMergeQStar r s)) hcont hdiff fun x hx ↦ by + have hx' : q < x ∧ x < anariRezaeiMergeQStar r s := by simpa using hx + rw [(hasDerivAt_anariRezaeiMergeGapAlong hr hs + (hq0.trans hx'.1.le) (by linarith [hcapStar, hx'.2.le])).deriv] + exact (anariRezaeiMergeGapDerivative_sign hr hs + (hq0.trans hx'.1.le) (by linarith [hcapStar, hx'.2.le])).1.mpr hx'.2.le + exact hmono ⟨le_rfl, hq⟩ ⟨hq, le_rfl⟩ hq + · have hcont : ContinuousOn (anariRezaeiMergeGapAlong r s) + (Set.Icc (anariRezaeiMergeQStar r s) q) := by + intro x hx + exact (hasDerivAt_anariRezaeiMergeGapAlong hr hs + (hqstar0.trans hx.1) (by linarith [ht0, hx.2])).continuousAt.continuousWithinAt + have hdiff : DifferentiableOn ℝ (anariRezaeiMergeGapAlong r s) + (interior (Set.Icc (anariRezaeiMergeQStar r s) q)) := by + intro x hx + have hx' : anariRezaeiMergeQStar r s < x ∧ x < q := by simpa using hx + exact (hasDerivAt_anariRezaeiMergeGapAlong hr hs + (hqstar0.trans hx'.1.le) (by linarith [ht0, hx'.2.le])).differentiableAt.differentiableWithinAt + have hanti := antitoneOn_of_deriv_nonpos + (convex_Icc (anariRezaeiMergeQStar r s) q) hcont hdiff fun x hx ↦ by + have hx' : anariRezaeiMergeQStar r s < x ∧ x < q := by simpa using hx + rw [(hasDerivAt_anariRezaeiMergeGapAlong hr hs + (hqstar0.trans hx'.1.le) (by linarith [ht0, hx'.2.le])).deriv] + exact (anariRezaeiMergeGapDerivative_sign hr hs + (hqstar0.trans hx'.1.le) (by linarith [ht0, hx'.2.le])).2.mpr hx'.1.le + exact hanti ⟨le_rfl, hq⟩ ⟨hq, le_rfl⟩ hq + +theorem anariRezaeiMergeGap_stationary_eq + {r s : ℝ} (hr0 : 0 ≤ r) (hs0 : 0 ≤ s) + (hC : r+s ≤ 14/25) : + anariRezaeiMergeGap (anariRezaeiMergeQStar r s) r s + (anariRezaeiMergeTStar r s) = anariRezaeiMergePsi r s := by + have h1pr : 1+r ≠ 0 := by linarith + have h1ps : 1+s ≠ 0 := by linarith + have h1pC : 1+r+s ≠ 0 := by linarith + have hden : 2+r+s ≠ 0 := by linarith + have hqNum : anariRezaeiMergeQStar r s+r = + (1+r)/(2+r+s) := by + rw [anariRezaeiMergeQStar] + field_simp [hden] + ring + have hqDen : anariRezaeiMergeQStar r s+r+s = + ((1+r+s)*(1+s))/(2+r+s) := by + rw [anariRezaeiMergeQStar] + field_simp [hden] + ring + have hqratio : + (anariRezaeiMergeQStar r s+r)/ + (anariRezaeiMergeQStar r s+r+s) = + (1+r)/((1+r+s)*(1+s)) := by + rw [hqDen, hqNum] + field_simp [hden, h1pr, h1ps, h1pC] + have htNum : s+anariRezaeiMergeTStar r s = + (1+s)/(2+r+s) := by + rw [anariRezaeiMergeTStar] + field_simp [hden] + ring + have htDen : r+s+anariRezaeiMergeTStar r s = + ((1+r+s)*(1+r))/(2+r+s) := by + rw [anariRezaeiMergeTStar] + field_simp [hden] + ring + have htratio : + (s+anariRezaeiMergeTStar r s)/ + (r+s+anariRezaeiMergeTStar r s) = + (1+s)/((1+r+s)*(1+r)) := by + rw [htDen, htNum] + field_simp [hden, h1pr, h1ps, h1pC] + rw [anariRezaeiMergeGap, anariRezaeiMergePsi, hqratio, htratio] + rw [Real.log_div h1pr (mul_ne_zero h1pC h1ps), + Real.log_div h1ps (mul_ne_zero h1pC h1pr), + Real.log_div h1ps h1pr, + Real.log_mul h1pC h1ps, Real.log_mul h1pC h1pr] + ring + +/-- Four-mass merge lemma with the rational cutoff used by the formal proof. -/ +theorem anariRezaeiMergeGap_nonpos + {q r s t : ℝ} (hq0 : 0 ≤ q) (hr0 : 0 ≤ r) + (hs0 : 0 ≤ s) (ht0 : 0 ≤ t) + (hsum : q+r+s+t = 1) (hC : r+s ≤ 14/25) : + anariRezaeiMergeGap q r s t ≤ 0 := by + by_cases hrz : r = 0 + · subst r + rw [anariRezaeiMergeGap] + by_cases hst : s+t = 0 + · have hs : s = 0 := by linarith + subst s + norm_num + · have hratio : (s+t)/(s+t) = (1 : ℝ) := div_self hst + have hratio' : (s+t)/(0+s+t) = (1 : ℝ) := by + convert hratio using 1 <;> ring + rw [hratio'] + norm_num + · by_cases hsz : s = 0 + · subst s + rw [anariRezaeiMergeGap] + by_cases hqr : q+r = 0 + · have hrzero : r = 0 := by linarith + exact (hrz hrzero).elim + · have hratio : (q+r)/(q+r) = (1 : ℝ) := div_self hqr + have hratio' : (q+r)/(q+r+0) = (1 : ℝ) := by + convert hratio using 1 <;> ring + rw [hratio'] + norm_num + · calc + anariRezaeiMergeGap q r s t ≤ + anariRezaeiMergeGap (anariRezaeiMergeQStar r s) r s + (anariRezaeiMergeTStar r s) := + anariRezaeiMergeGap_le_stationary hq0 + (lt_of_le_of_ne hr0 (Ne.symm hrz)) + (lt_of_le_of_ne hs0 (Ne.symm hsz)) ht0 hsum hC + _ = anariRezaeiMergePsi r s := + anariRezaeiMergeGap_stationary_eq hr0 hs0 hC + _ ≤ 0 := anariRezaeiMergePsi_nonpos hr0 hs0 hC + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/SourceBetheLower.lean b/LeanPool/BeyondBethe/BeyondBethe/SourceBetheLower.lean new file mode 100644 index 0000000000..452ff8a688 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/SourceBetheLower.lean @@ -0,0 +1,123 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.ClusterCertificate +import LeanPool.BeyondBethe.BeyondBethe.Optimizer + +/-! # Source Bethe Lower -/ + +open scoped BigOperators + +namespace BeyondBethe + +/-! +# The lower half of the Bethe sandwich + +The stable-coefficient theorem contains Gurvits's Bethe lower bound as the +special case in which every row is a singleton cluster. This file makes that +reduction explicit. Once the stable-coefficient theorem is closed, there is +no separate Schrijver/Gurvits interface left in the development. +-/ + +/-- The clustering with one named singleton cluster for each row. -/ +noncomputable def singletonRowClustering (n : ℕ) : RowClustering n where + Cluster := Fin n + clusterFintype := inferInstance + clusterDecidableEq := inferInstance + size := fun _ ↦ 1 + rows := Equiv.sigmaUnique (Fin n) (fun _ ↦ Fin 1) + +@[simp] theorem singletonRowClustering_size (n : ℕ) + (i : (singletonRowClustering n).Cluster) : + (singletonRowClustering n).size i = 1 := rfl + +@[simp] theorem singletonRowClustering_rows (n : ℕ) + (s : Σ c : (singletonRowClustering n).Cluster, + Fin ((singletonRowClustering n).size c)) : + (singletonRowClustering n).rows s = s.1 := by + rfl + +theorem singletonRowClustering_singletonPairs (n : ℕ) : + IsSingletonPairClustering (singletonRowClustering n) := by + intro i + exact Or.inl rfl + +@[simp] theorem singletonClusterRow_singletonRowClustering + {n : ℕ} (i : Fin n) : + singletonClusterRow (singletonRowClustering n) i rfl = i := by + rfl + +theorem paperClusterFactor_singletonRowClustering + {n : ℕ} (hn : 2 ≤ n) + {A X : Matrix (Fin n) (Fin n) ℝ} + (hA : Matrix.Positive A) (hX : IsDoublyStochastic X) + (hXpos : ∀ i j, 0 < X i j) (i : Fin n) : + paperClusterFactor A X (singletonRowClustering n) + (singletonRowClustering_singletonPairs n) i = + singletonFactor A X i := by + rw [paperClusterFactor] + simp + +/-- Gurvits's pointwise Bethe lower certificate, obtained from the +stable-coefficient theorem with singleton clusters. -/ +theorem exp_betheObjective_le_permanent_of_stableCoefficient + {n : ℕ} (hn : 2 ≤ n) + (stableCoefficient : AnariOveisGharanStableCoefficient.{0}) + {A X : Matrix (Fin n) (Fin n) ℝ} + (hA : Matrix.Positive A) (hX : IsDoublyStochastic X) + (hXpos : ∀ i j, 0 < X i j) : + Real.exp (betheObjective A X) ≤ Matrix.permanent A := by + have hcert := pairedLowerCertificate_for_clustering stableCoefficient + (singletonRowClustering n) hn hA hX hXpos + (singletonRowClustering_singletonPairs n) + rw [← prod_singletonFactor_eq_exp_betheObjective] + calc + (∏ i, singletonFactor A X i) = + ∏ i, paperClusterFactor A X (singletonRowClustering n) + (singletonRowClustering_singletonPairs n) i := by + apply Finset.prod_congr rfl + intro i _ + exact (paperClusterFactor_singletonRowClustering hn hA hX hXpos i).symm + _ ≤ Matrix.permanent A := hcert + +/-- The lower half of the Bethe sandwich for positive matrices. -/ +theorem bethePermanent_le_permanent_of_positive + {n : ℕ} (hn : 2 ≤ n) + (stableCoefficient : AnariOveisGharanStableCoefficient.{0}) + (A : Matrix (Fin n) (Fin n) ℝ) (hA : Matrix.Positive A) : + bethePermanent A ≤ Matrix.permanent A := by + have hper : 0 < Matrix.permanent A := permanent_pos_of_positive A hA + have hlog : betheLogValue A ≤ Real.log (Matrix.permanent A) := by + apply le_of_forall_pos_le_add + intro ε hε + let C : ℝ := n * Real.log n + have hn1 : (1 : ℝ) ≤ n := by exact_mod_cast (show 1 ≤ n by omega) + have hC : 0 ≤ C := mul_nonneg (Nat.cast_nonneg n) + (Real.log_nonneg hn1) + let τ : ℝ := ε / (C + 1) + have hτ : 0 < τ := div_pos hε (by linarith) + obtain ⟨X, hX, hmax⟩ := exists_regularizedBetheMaximizer τ A + have hXpos := regularizedBetheMaximizer_positive + (show 1 < n by omega) hτ hA hX hmax + have hvalue := betheLogValue_le_regularizedMaximizer + (show 1 < n by omega) hτ.le hA hX hmax + have hcert := exp_betheObjective_le_permanent_of_stableCoefficient + hn stableCoefficient hA hX hXpos + have hobjective : betheObjective A X ≤ + Real.log (Matrix.permanent A) := + (Real.le_log_iff_exp_le hper).mpr hcert + have hbudget : τ * C ≤ ε := by + dsimp only [τ] + rw [div_mul_eq_mul_div, div_le_iff₀ (by linarith : 0 < C + 1)] + nlinarith + dsimp only [C] at hvalue hbudget + linarith + have hmatch : Matrix.HasPerfectMatching A := positiveMatrix_hasPerfectMatching hA + rw [bethePermanent, if_pos hmatch] + have hexp := Real.exp_le_exp.mpr hlog + rwa [Real.exp_log hper] at hexp + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/SourceBetheUpper.lean b/LeanPool/BeyondBethe/BeyondBethe/SourceBetheUpper.lean new file mode 100644 index 0000000000..87845152af --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/SourceBetheUpper.lean @@ -0,0 +1,84 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.Optimizer +import LeanPool.BeyondBethe.BeyondBethe.SourceAnariRezaeiList + +/-! # Source Bethe Upper -/ + +open scoped BigOperators + +namespace BeyondBethe + +/-! +# The upper half of the Bethe sandwich + +For a positive matrix, the Gibbs distribution on perfect matchings has a +doubly stochastic marginal matrix `P`. The exact sequential identity writes +`log(per A)` as the Bethe objective at `P`, plus one correction per row, minus +a nonnegative averaged relative entropy. The sharp Anari--Rezaei row theorem +bounds every correction by `log 2 / 2`. This is the whole upper-bound proof. +-/ + +theorem sum_rowCorrection_le_log_two_half + {n : ℕ} (hn : 2 ≤ n) {P : Matrix (Fin n) (Fin n) ℝ} + (hP : IsDoublyStochastic P) : + (∑ i, rowCorrection (P i)) ≤ n * (Real.log 2 / 2) := by + have hrow : ∀ i : Fin n, rowCorrection (P i) ≤ Real.log 2 / 2 := by + intro i + have hPi : IsProbabilityVector (P i) := + ⟨fun j ↦ hP.1 i j, hP.2.1 i⟩ + have hdeficit := anariRezaeiRowInequality hn (P i) hPi + rw [rowDeficit] at hdeficit + linarith + calc + (∑ i, rowCorrection (P i)) ≤ ∑ _i : Fin n, Real.log 2 / 2 := + Finset.sum_le_sum fun i _ ↦ hrow i + _ = n * (Real.log 2 / 2) := by simp + +/-- Logarithmic upper Bethe bound for positive matrices of order at least two. -/ +theorem log_permanent_le_betheLogValue_add_log_two_half + {n : ℕ} (hn : 2 ≤ n) (A : Matrix (Fin n) (Fin n) ℝ) + (hA : Matrix.Positive A) : + Real.log (Matrix.permanent A) ≤ + betheLogValue A + n * (Real.log 2 / 2) := by + let P := assignmentMarginal A + have hper : 0 < Matrix.permanent A := permanent_pos_of_positive A hA + have hP : IsDoublyStochastic P := + assignmentMarginal_doublyStochastic A (fun i j ↦ (hA i j).le) hper.ne' + have hobjective : betheObjective A P ≤ betheLogValue A := + betheObjective_le_betheLogValue_of_positive hA hP + have hrows : (∑ i, rowCorrection (P i)) ≤ + n * (Real.log 2 / 2) := sum_rowCorrection_le_log_two_half hn hP + have hdiv : 0 ≤ gibbsSequentialDivergence A := + gibbsSequentialDivergence_nonneg A hA + have hexact := gibbs_exact_sequential_identity A hA + dsimp only [P] at hP hobjective hrows hexact + linarith + +/-- The upper half of the Bethe sandwich for positive matrices. -/ +theorem permanent_le_sqrtTwo_pow_mul_bethePermanent_of_positive + {n : ℕ} (hn : 2 ≤ n) (A : Matrix (Fin n) (Fin n) ℝ) + (hA : Matrix.Positive A) : + Matrix.permanent A ≤ + (Real.sqrt 2) ^ n * bethePermanent A := by + have hmatch : Matrix.HasPerfectMatching A := positiveMatrix_hasPerfectMatching hA + have hper : 0 < Matrix.permanent A := permanent_pos_of_positive A hA + have hlog := log_permanent_le_betheLogValue_add_log_two_half hn A hA + have hexp := Real.exp_le_exp.mpr hlog + rw [Real.exp_log hper, Real.exp_add] at hexp + have hsqrt : 0 < Real.sqrt 2 := Real.sqrt_pos.2 (by norm_num) + have hfactor : Real.exp (n * (Real.log 2 / 2)) = + (Real.sqrt 2) ^ n := by + rw [Real.exp_nat_mul] + congr 1 + rw [← Real.exp_log hsqrt, Real.log_sqrt (by norm_num : (0 : ℝ) ≤ 2)] + have hbethe : bethePermanent A = Real.exp (betheLogValue A) := by + rw [bethePermanent, if_pos hmatch] + rw [hfactor, ← hbethe] at hexp + simpa [mul_comm] using hexp + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/SourceStableBivariate.lean b/LeanPool/BeyondBethe/BeyondBethe/SourceStableBivariate.lean new file mode 100644 index 0000000000..d34f9ae02c --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/SourceStableBivariate.lean @@ -0,0 +1,379 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import Mathlib.Analysis.Complex.Basic +import Mathlib.Analysis.MeanInequalities +import Mathlib.Analysis.SpecialFunctions.Pow.Real +import Mathlib.Tactic + +/-! # Source Stable Bivariate -/ + +namespace BeyondBethe + +/-! +# The bivariate core of the stable-coefficient inequality + +After all other variables have been specialized to positive real numbers, a +multiaffine bistable polynomial has the form + +`a*y*z + b*y + c*z + d`. + +Stability of the sign-reversed polynomial forces `b*c ≤ a*d`. The short +argument below is the elementary two-variable content behind the Rayleigh +inequality used in Anari--Oveis Gharan. +-/ + +/-- A nonnegative bivariate multiaffine polynomial is bistable when its +sign-reversal in the second variable has no zero with both variables in the +open upper half-plane. -/ +def BivariateBistable (a b c d : ℝ) : Prop := + ∀ y z : ℂ, 0 < y.im → 0 < z.im → + -(a : ℂ) * y * z + (b : ℂ) * y - (c : ℂ) * z + (d : ℂ) ≠ 0 + +/-- The bivariate Rayleigh determinant inequality, proved directly by +exhibiting an upper-half-plane zero if `a*d < b*c`. -/ +theorem bivariate_rayleigh_of_bistable + {a b c d : ℝ} + (ha : 0 ≤ a) (hb : 0 ≤ b) (hc : 0 ≤ c) (hd : 0 ≤ d) + (hstable : BivariateBistable a b c d) : + b * c ≤ a * d := by + by_contra hnot + have hgap : a * d < b * c := lt_of_not_ge hnot + have hbpos : 0 < b := by + by_contra hbnot + have hbzero : b = 0 := le_antisymm (le_of_not_gt hbnot) hb + rw [hbzero, zero_mul] at hgap + exact (not_lt_of_ge (mul_nonneg ha hd)) hgap + have hcpos : 0 < c := by + by_contra hcnot + have hczero : c = 0 := le_antisymm (le_of_not_gt hcnot) hc + rw [hczero, mul_zero] at hgap + exact (not_lt_of_ge (mul_nonneg ha hd)) hgap + let y : ℂ := Complex.I + let z : ℂ := ((d : ℂ) + (b : ℂ) * Complex.I) / + ((c : ℂ) + (a : ℂ) * Complex.I) + have hden : (c : ℂ) + (a : ℂ) * Complex.I ≠ 0 := by + intro hzero + have hre := congrArg Complex.re hzero + simp at hre + exact hcpos.ne' hre + have hyim : 0 < y.im := by simp [y] + have hzim_formula : z.im = (b * c - a * d) / (c ^ 2 + a ^ 2) := by + dsimp only [z] + rw [Complex.div_im] + simp only [Complex.add_re, Complex.ofReal_re, Complex.mul_re, + Complex.I_re, Complex.I_im, mul_zero, Complex.add_im, + Complex.ofReal_im, zero_add, Complex.mul_im, zero_mul, mul_one, + add_zero, Complex.normSq_apply] + congr 1 <;> ring + have hdenpos : 0 < c ^ 2 + a ^ 2 := by positivity + have hzim : 0 < z.im := by + rw [hzim_formula] + exact div_pos (sub_pos.mpr hgap) hdenpos + have hzero : + -(a : ℂ) * y * z + (b : ℂ) * y - (c : ℂ) * z + (d : ℂ) = 0 := by + dsimp only [y, z] + field_simp [hden] + ring + exact (hstable y z hyim hzim) hzero + +/-! ## The scalar capacity inequality -/ + +noncomputable def stableBoundaryScalar (α : ℝ) : ℝ := + (α : ℝ) ^ α * (1 - α) ^ (1 - α) + +/-- The weighted AM--GM inequality in the normalization used by the source +proof. -/ +theorem normalized_weighted_geometric_mean_le_add + {α u v : ℝ} (hα0 : 0 < α) (hα1 : α < 1) + (hu : 0 ≤ u) (hv : 0 ≤ v) : + u ^ α * v ^ (1 - α) ≤ stableBoundaryScalar α * (u + v) := by + have hα : 0 ≤ α := hα0.le + have h1α : 0 ≤ 1 - α := sub_nonneg.mpr hα1.le + have hamgm := Real.geom_mean_le_arith_mean2_weighted + hα h1α (div_nonneg hu hα) (div_nonneg hv h1α) (by ring) + rw [stableBoundaryScalar] + have hboundary : 0 < α ^ α * (1 - α) ^ (1 - α) := + mul_pos (Real.rpow_pos_of_pos hα0 α) + (Real.rpow_pos_of_pos (sub_pos.mpr hα1) (1 - α)) + have hscaled := mul_le_mul_of_nonneg_left hamgm hboundary.le + calc + u ^ α * v ^ (1 - α) = + (α ^ α * (1 - α) ^ (1 - α)) * + ((u / α) ^ α * (v / (1 - α)) ^ (1 - α)) := by + rw [Real.div_rpow hu hα, Real.div_rpow hv h1α] + field_simp [hα0.ne', (sub_pos.mpr hα1).ne'] + _ ≤ (α ^ α * (1 - α) ^ (1 - α)) * + (α * (u / α) + (1 - α) * (v / (1 - α))) := hscaled + _ = (α ^ α * (1 - α) ^ (1 - α)) * (u + v) := by + field_simp [hα0.ne', (sub_pos.mpr hα1).ne'] + +noncomputable def linearCapacityCandidate (α u v : ℝ) : ℝ := + α * v / ((1 - α) * u) + +theorem linearCapacityCandidate_pos + {α u v : ℝ} (hα0 : 0 < α) (hα1 : α < 1) + (hu : 0 < u) (hv : 0 < v) : + 0 < linearCapacityCandidate α u v := by + exact div_pos (mul_pos hα0 hv) (mul_pos (sub_pos.mpr hα1) hu) + +/-- Evaluation of a positive affine linear form at its weighted-AM--GM +minimizer. -/ +theorem linearCapacityCandidate_ratio + {α u v : ℝ} (hα0 : 0 < α) (hα1 : α < 1) + (hu : 0 < u) (hv : 0 < v) : + (u * linearCapacityCandidate α u v + v) / + (linearCapacityCandidate α u v) ^ α = + u ^ α * v ^ (1 - α) / stableBoundaryScalar α := by + have h1α : 0 < 1 - α := sub_pos.mpr hα1 + have ht : 0 < linearCapacityCandidate α u v := + linearCapacityCandidate_pos hα0 hα1 hu hv + have hnum : u * linearCapacityCandidate α u v + v = v / (1 - α) := by + rw [linearCapacityCandidate] + field_simp [hu.ne', h1α.ne'] + ring + rw [hnum, linearCapacityCandidate, stableBoundaryScalar] + rw [Real.div_rpow (mul_nonneg hα0.le hv.le) + (mul_nonneg h1α.le hu.le), + Real.mul_rpow hα0.le hv.le, + Real.mul_rpow h1α.le hu.le] + field_simp [hα0.ne', h1α.ne', hu.ne', hv.ne', + (Real.rpow_pos_of_pos hα0 α).ne', + (Real.rpow_pos_of_pos h1α (1 - α)).ne', + (Real.rpow_pos_of_pos hu α).ne', + (Real.rpow_pos_of_pos hv α).ne'] + have hsum : α + (1 - α) = 1 := by ring + calc + v * (1 - α) ^ α * (1 - α) ^ (1 - α) = + v * ((1 - α) ^ α * (1 - α) ^ (1 - α)) := by ring + _ = v * (1 - α) := by + rw [← Real.rpow_add h1α, hsum, Real.rpow_one] + _ = (1 - α) * v := by ring + _ = (1 - α) * (v ^ α * v ^ (1 - α)) := by + rw [← Real.rpow_add hv, hsum, Real.rpow_one] + _ = (1 - α) * v ^ α * v ^ (1 - α) := by ring + +/-- The exact bivariate capacity step used by the inductive +stable-coefficient proof, in the strictly positive interior case. -/ +theorem exists_bivariate_capacity_witness + {α a b c d : ℝ} (hα0 : 0 < α) (hα1 : α < 1) + (ha : 0 < a) (hb : 0 ≤ b) (hc : 0 < c) (hd : 0 < d) + (hrayleigh : b * c ≤ a * d) : + ∃ y z : ℝ, 0 < y ∧ 0 < z ∧ + stableBoundaryScalar α * + ((a * y * z + b * y + c * z + d) / (y * z) ^ α) ≤ + a + d := by + let y := linearCapacityCandidate α a c + let z := linearCapacityCandidate α 1 (d / c) + have hdc : 0 < d / c := div_pos hd hc + have hy : 0 < y := linearCapacityCandidate_pos hα0 hα1 ha hc + have hz : 0 < z := linearCapacityCandidate_pos hα0 hα1 (by norm_num) hdc + have hb' : b ≤ a * d / c := by + rw [le_div_iff₀ hc] + nlinarith + have hpoly : a * y * z + b * y + c * z + d ≤ + (a * y + c) * (z + d / c) := by + have := mul_le_mul_of_nonneg_right hb' hy.le + field_simp [hc.ne'] at this ⊢ + nlinarith + have hden : 0 < (y * z) ^ α := + Real.rpow_pos_of_pos (mul_pos hy hz) α + have hboundary : 0 < stableBoundaryScalar α := by + rw [stableBoundaryScalar] + exact mul_pos (Real.rpow_pos_of_pos hα0 α) + (Real.rpow_pos_of_pos (sub_pos.mpr hα1) (1 - α)) + have hratio := div_le_div_of_nonneg_right hpoly hden.le + have hscaled := mul_le_mul_of_nonneg_left hratio hboundary.le + have hfactor : + ((a * y + c) * (z + d / c)) / (y * z) ^ α = + ((a * y + c) / y ^ α) * ((z + d / c) / z ^ α) := by + rw [Real.mul_rpow hy.le hz.le] + field_simp [(Real.rpow_pos_of_pos hy α).ne', + (Real.rpow_pos_of_pos hz α).ne'] + have hyvalue : (a * y + c) / y ^ α = + a ^ α * c ^ (1 - α) / stableBoundaryScalar α := by + exact linearCapacityCandidate_ratio hα0 hα1 ha hc + have hzvalue : (z + d / c) / z ^ α = + (d / c) ^ (1 - α) / stableBoundaryScalar α := by + simpa using linearCapacityCandidate_ratio hα0 hα1 + (by norm_num : (0 : ℝ) < 1) hdc + have hcollapse : + stableBoundaryScalar α * + ((a ^ α * c ^ (1 - α) / stableBoundaryScalar α) * + ((d / c) ^ (1 - α) / stableBoundaryScalar α)) = + a ^ α * d ^ (1 - α) / stableBoundaryScalar α := by + rw [Real.div_rpow hd.le hc.le] + have hcPow : 0 < c ^ (1 - α) := Real.rpow_pos_of_pos hc _ + field_simp [hboundary.ne', hcPow.ne'] + have hamgm := normalized_weighted_geometric_mean_le_add + hα0 hα1 ha.le hd.le + have hfinal : + a ^ α * d ^ (1 - α) / stableBoundaryScalar α ≤ a + d := by + exact (div_le_iff₀ hboundary).mpr (by simpa [mul_comm] using hamgm) + refine ⟨y, z, hy, hz, ?_⟩ + calc + stableBoundaryScalar α * + ((a * y * z + b * y + c * z + d) / (y * z) ^ α) ≤ + stableBoundaryScalar α * + (((a * y + c) * (z + d / c)) / (y * z) ^ α) := hscaled + _ = stableBoundaryScalar α * + (((a * y + c) / y ^ α) * ((z + d / c) / z ^ α)) := by + rw [hfactor] + _ = stableBoundaryScalar α * + ((a ^ α * c ^ (1 - α) / stableBoundaryScalar α) * + ((d / c) ^ (1 - α) / stableBoundaryScalar α)) := by + rw [hyvalue, hzvalue] + _ = a ^ α * d ^ (1 - α) / stableBoundaryScalar α := hcollapse + _ ≤ a + d := hfinal + +/-- The strictly positive scalar lemma is sufficient after an arbitrarily +small coefficient regularization. This is the version needed by the source +induction: no coefficient is assumed positive, and the conclusion loses only +an arbitrary additive `ε`. -/ +theorem exists_bivariate_capacity_witness_nonnegative_interior + {α a b c d ε : ℝ} (hα0 : 0 < α) (hα1 : α < 1) + (ha : 0 ≤ a) (hb : 0 ≤ b) (hc : 0 ≤ c) (hd : 0 ≤ d) + (hrayleigh : b * c ≤ a * d) (hε : 0 < ε) : + ∃ y z : ℝ, 0 < y ∧ 0 < z ∧ + stableBoundaryScalar α * + ((a * y * z + b * y + c * z + d) / (y * z) ^ α) ≤ + a + d + ε := by + let δ : ℝ := ε / 4 + let c' : ℝ := c + δ ^ 2 / (b + 1) + have hδ : 0 < δ := by dsimp [δ]; positivity + have hb1 : 0 < b + 1 := by linarith + have hc' : 0 < c' := by + dsimp [c'] + exact add_pos_of_nonneg_of_pos hc (div_pos (sq_pos_of_pos hδ) hb1) + have hrayleigh' : b * c' ≤ (a + δ) * (d + δ) := by + have hfrac : b * (δ ^ 2 / (b + 1)) ≤ δ ^ 2 := by + rw [← mul_div_assoc] + apply (div_le_iff₀ hb1).2 + nlinarith + dsimp only [c'] + nlinarith [mul_nonneg ha hδ.le, mul_nonneg hd hδ.le] + obtain ⟨y, z, hy, hz, hwitness⟩ := + exists_bivariate_capacity_witness hα0 hα1 + (add_pos_of_nonneg_of_pos ha hδ) + hb hc' (add_pos_of_nonneg_of_pos hd hδ) hrayleigh' + have hden : 0 < (y * z) ^ α := + Real.rpow_pos_of_pos (mul_pos hy hz) α + have hpoly : + a * y * z + b * y + c * z + d ≤ + (a + δ) * y * z + b * y + c' * z + (d + δ) := by + have hcc' : c ≤ c' := by + dsimp [c'] + exact le_add_of_nonneg_right (div_nonneg (sq_nonneg δ) hb1.le) + nlinarith [mul_nonneg hy.le hz.le, + mul_le_mul_of_nonneg_right hcc' hz.le] + have hboundary : 0 ≤ stableBoundaryScalar α := by + rw [stableBoundaryScalar] + positivity + refine ⟨y, z, hy, hz, ?_⟩ + calc + stableBoundaryScalar α * + ((a * y * z + b * y + c * z + d) / (y * z) ^ α) ≤ + stableBoundaryScalar α * + (((a + δ) * y * z + b * y + c' * z + (d + δ)) / + (y * z) ^ α) := by + exact mul_le_mul_of_nonneg_left + (div_le_div_of_nonneg_right hpoly hden.le) hboundary + _ ≤ (a + δ) + (d + δ) := hwitness + _ ≤ a + d + ε := by dsimp [δ]; linarith + +/-- The endpoint `α = 0`: send both variables to zero. -/ +theorem exists_bivariate_capacity_witness_zero + {a b c d ε : ℝ} + (ha : 0 ≤ a) (hb : 0 ≤ b) (hc : 0 ≤ c) (hd : 0 ≤ d) + (hε : 0 < ε) : + ∃ y z : ℝ, 0 < y ∧ 0 < z ∧ + stableBoundaryScalar 0 * + ((a * y * z + b * y + c * z + d) / (y * z) ^ (0 : ℝ)) ≤ + a + d + ε := by + let s : ℝ := a + b + c + 1 + let t : ℝ := ε / ((ε + 1) * s) + have hs : 0 < s := by dsimp [s]; linarith + have hε1 : 0 < ε + 1 := by linarith + have ht : 0 < t := by dsimp [t]; positivity + have ht1 : t ≤ 1 := by + dsimp [t] + rw [div_le_one (mul_pos hε1 hs)] + have hs1 : 1 ≤ s := by dsimp [s]; linarith + nlinarith [mul_nonneg hε.le hs.le] + have hsmall : (a + b + c) * t < ε := by + dsimp [t] + rw [← mul_div_assoc] + apply (div_lt_iff₀ (mul_pos hε1 hs)).2 + have hsum : a + b + c < s := by dsimp [s]; linarith + have hs_scaled : s ≤ (ε + 1) * s := by + nlinarith [mul_nonneg hε.le hs.le] + simpa [mul_comm] using + (mul_lt_mul_of_pos_left (hsum.trans_le hs_scaled) hε) + refine ⟨t, t, ht, ht, ?_⟩ + rw [stableBoundaryScalar] + norm_num + have hatt : a * t * t ≤ a * t := by + nlinarith [mul_nonneg ha ht.le] + nlinarith + +/-- The endpoint `α = 1`: send both variables to infinity. -/ +theorem exists_bivariate_capacity_witness_one + {a b c d ε : ℝ} + (ha : 0 ≤ a) (hb : 0 ≤ b) (hc : 0 ≤ c) (hd : 0 ≤ d) + (hε : 0 < ε) : + ∃ y z : ℝ, 0 < y ∧ 0 < z ∧ + stableBoundaryScalar 1 * + ((a * y * z + b * y + c * z + d) / (y * z) ^ (1 : ℝ)) ≤ + a + d + ε := by + let s : ℝ := b + c + d + 1 + let t : ℝ := (ε + 1) * s / ε + have hs : 0 < s := by dsimp [s]; linarith + have hε1 : 0 < ε + 1 := by linarith + have ht : 0 < t := by dsimp [t]; positivity + have ht1 : 1 ≤ t := by + dsimp [t] + rw [le_div_iff₀ hε] + have hs1 : 1 ≤ s := by dsimp [s]; linarith + nlinarith [mul_nonneg hε.le hs.le] + have hsmall : (b + c + d) / t < ε := by + rw [div_lt_iff₀ ht] + dsimp [t] + have hsum : b + c + d < s := by dsimp [s]; linarith + have hs_scaled : s ≤ (ε + 1) * s := by + nlinarith [mul_nonneg hε.le hs.le] + have hcancel : ε * ((ε + 1) * s / ε) = (ε + 1) * s := by + field_simp [hε.ne'] + rw [hcancel] + exact hsum.trans_le hs_scaled + refine ⟨t, t, ht, ht, ?_⟩ + rw [stableBoundaryScalar] + norm_num [Real.rpow_one] + field_simp [ht.ne'] + have hdt : d ≤ d * t := by nlinarith [mul_nonneg hd (sub_nonneg.mpr ht1)] + have hsmall' : (b + c + d) * t < ε * t ^ 2 := by + rw [div_lt_iff₀ ht] at hsmall + nlinarith + nlinarith + +/-- Complete bivariate scalar step, including both boundary exponents. -/ +theorem exists_bivariate_capacity_witness_nonnegative + {α a b c d ε : ℝ} + (hα : 0 ≤ α ∧ α ≤ 1) + (ha : 0 ≤ a) (hb : 0 ≤ b) (hc : 0 ≤ c) (hd : 0 ≤ d) + (hrayleigh : b * c ≤ a * d) (hε : 0 < ε) : + ∃ y z : ℝ, 0 < y ∧ 0 < z ∧ + stableBoundaryScalar α * + ((a * y * z + b * y + c * z + d) / (y * z) ^ α) ≤ + a + d + ε := by + rcases hα with ⟨hα0, hα1⟩ + rcases eq_or_lt_of_le hα0 with rfl | hαpos + · exact exists_bivariate_capacity_witness_zero ha hb hc hd hε + rcases eq_or_lt_of_le hα1 with rfl | hαlt + · exact exists_bivariate_capacity_witness_one ha hb hc hd hε + exact exists_bivariate_capacity_witness_nonnegative_interior + hαpos hαlt ha hb hc hd hrayleigh hε + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/SourceStableClosure.lean b/LeanPool/BeyondBethe/BeyondBethe/SourceStableClosure.lean new file mode 100644 index 0000000000..e9f0501111 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/SourceStableClosure.lean @@ -0,0 +1,722 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.Stable +import Mathlib.Analysis.Complex.JensenFormula +import Mathlib.Analysis.Analytic.Polynomial +import Mathlib.Algebra.Polynomial.Roots +import Mathlib.Algebra.MvPolynomial.Funext +import Mathlib.Algebra.Polynomial.Degree.SmallDegree +import Mathlib.Tactic + +/-! # Source Stable Closure -/ + +open Filter MeasureTheory Metric Real Set + +namespace BeyondBethe + +/-! +# Closure of the stable cone + +The source proof uses two limiting operations on stable polynomials: taking a +coefficient in a multiaffine variable and specializing a variable to the real +boundary. In the source literature these facts are usually folded into the +statement that stability preservers may output the zero polynomial. + +This file starts from the one-variable analytic fact needed to justify those +limits. We prove it from the isolated-zero theorem, compactness of a circle, +and the mean-value identity for the logarithm of a nonvanishing analytic +function. Thus no version of Hurwitz's theorem is introduced as an axiom. +-/ + +/-- A linear perturbation of a nonzero polynomial cannot be zero-free on a +fixed disk for every positive perturbation size if the limiting polynomial +vanishes at the center. This is the precise one-variable Hurwitz principle +needed below. -/ +theorem polynomial_linear_perturbation_has_nearby_zero + (A B : Polynomial ℂ) (R : ℝ) + (hA : A ≠ 0) (hR : 0 < R) (hA0 : A.eval 0 = 0) : + ∃ t : ℝ, 0 < t ∧ ∃ z ∈ closedBall (0 : ℂ) R, + (A + Polynomial.C (t : ℂ) * B).eval z = 0 := by + have hAanalytic : AnalyticOnNhd ℂ (fun z : ℂ ↦ A.eval z) Set.univ := by + exact AnalyticOnNhd.eval_polynomial A + have hpunctured : + ∀ᶠ z in nhdsWithin (0 : ℂ) ({0} : Set ℂ)ᶜ, A.eval z ≠ 0 := by + rcases (hAanalytic 0 (Set.mem_univ 0)).eventually_eq_zero_or_eventually_ne_zero with + hlocal | hlocal + · have hzero : Set.EqOn (fun z : ℂ ↦ A.eval z) 0 Set.univ := + hAanalytic.eqOn_zero_of_preconnected_of_eventuallyEq_zero + isPreconnected_univ (Set.mem_univ 0) (by + filter_upwards [hlocal] with z hz + simpa using hz) + exfalso + apply hA + apply Polynomial.zero_of_eval_zero + intro z + simpa using hzero (Set.mem_univ z) + · exact hlocal + obtain ⟨δ, hδ, hδsub⟩ := Metric.mem_nhdsWithin_iff.mp hpunctured + let r : ℝ := min (δ / 2) (R / 2) + have hr : 0 < r := by + dsimp [r] + positivity + have hrδ : r < δ := by + dsimp [r] + exact lt_of_le_of_lt (min_le_left _ _) (half_lt_self hδ) + have hrR : r < R := by + dsimp [r] + exact lt_of_le_of_lt (min_le_right _ _) (half_lt_self hR) + have hsphereA : ∀ z ∈ sphere (0 : ℂ) r, A.eval z ≠ 0 := by + intro z hz + apply hδsub + constructor + · rw [mem_sphere, dist_zero_right] at hz + rw [mem_ball, dist_zero_right, hz] + exact hrδ + · rw [Set.mem_compl_iff, Set.mem_singleton_iff] + intro hz0 + subst z + have : (0 : ℝ) = r := by simpa [mem_sphere] using hz + exact hr.ne' this.symm + have hsphere_nonempty : (sphere (0 : ℂ) r).Nonempty := + NormedSpace.sphere_nonempty.mpr hr.le + obtain ⟨u, hu, humin⟩ := + (isCompact_sphere (0 : ℂ) r).exists_isMinOn hsphere_nonempty + (A.continuous.norm.continuousOn) + let m : ℝ := ‖A.eval u‖ + have hm : 0 < m := by + dsimp [m] + exact norm_pos_iff.mpr (hsphereA u hu) + have hm_lower : ∀ z ∈ sphere (0 : ℂ) r, m ≤ ‖A.eval z‖ := by + intro z hz + exact humin hz + obtain ⟨v, hv, hvmax⟩ := + (isCompact_sphere (0 : ℂ) r).exists_isMaxOn hsphere_nonempty + (B.continuous.norm.continuousOn) + let M : ℝ := max ‖B.eval v‖ ‖B.eval 0‖ + have hM0 : 0 ≤ M := by + dsimp [M] + positivity + have hM_sphere : ∀ z ∈ sphere (0 : ℂ) r, ‖B.eval z‖ ≤ M := by + intro z hz + exact (hvmax hz).trans (le_max_left _ _) + have hM_center : ‖B.eval 0‖ ≤ M := by + exact le_max_right _ _ + let t : ℝ := m / (4 * (M + 1)) + have ht : 0 < t := by + dsimp [t] + positivity + let F : Polynomial ℂ := A + Polynomial.C (t : ℂ) * B + by_contra hno + push_neg at hno + have hFzeroFree : ∀ z ∈ closedBall (0 : ℂ) r, F.eval z ≠ 0 := by + intro z hz + exact hno t ht z (closedBall_subset_closedBall hrR.le hz) + have hFanalytic : AnalyticOnNhd ℂ (fun z : ℂ ↦ F.eval z) + (closedBall (0 : ℂ) r) := by + exact (AnalyticOnNhd.eval_polynomial F).mono (Set.subset_univ _) + have hmean : + circleAverage (fun z : ℂ ↦ Real.log ‖F.eval z‖) 0 r = + Real.log ‖F.eval 0‖ := by + apply AnalyticOnNhd.circleAverage_log_norm_of_ne_zero + (R := r) (c := (0 : ℂ)) (g := fun z : ℂ ↦ F.eval z) + · simpa [abs_of_pos hr] using hFanalytic + · simpa [abs_of_pos hr] using hFzeroFree + have hperturb_sphere : ∀ z ∈ sphere (0 : ℂ) r, + ‖((t : ℂ) * B.eval z)‖ < m / 2 := by + intro z hz + calc + ‖((t : ℂ) * B.eval z)‖ = t * ‖B.eval z‖ := by + simp [norm_mul, Real.norm_eq_abs, abs_of_pos ht] + _ ≤ t * M := mul_le_mul_of_nonneg_left (hM_sphere z hz) ht.le + _ < m / 2 := by + dsimp [t] + have hden : 0 < 4 * (M + 1) := by positivity + rw [div_mul_eq_mul_div, div_lt_iff₀ hden, div_mul_eq_mul_div] + nlinarith + have hF_lower : ∀ z ∈ sphere (0 : ℂ) r, m / 2 < ‖F.eval z‖ := by + intro z hz + have htriangle : ‖A.eval z‖ ≤ + ‖F.eval z‖ + ‖((t : ℂ) * B.eval z)‖ := by + have heval : F.eval z = A.eval z + (t : ℂ) * B.eval z := by + simp [F] + rw [heval] + simpa [add_assoc] using norm_sub_le (A.eval z + (t : ℂ) * B.eval z) + ((t : ℂ) * B.eval z) + linarith [hm_lower z hz, hperturb_sphere z hz] + have hlog_lower : ∀ z ∈ sphere (0 : ℂ) r, + Real.log (m / 2) ≤ Real.log ‖F.eval z‖ := by + intro z hz + exact Real.strictMonoOn_log.monotoneOn + (half_pos hm) (norm_pos_iff.mpr (hFzeroFree z (sphere_subset_closedBall hz))) + (hF_lower z hz).le + have havg_lower : Real.log (m / 2) ≤ + circleAverage (fun z : ℂ ↦ Real.log ‖F.eval z‖) 0 r := by + rw [← circleAverage_const (Real.log (m / 2)) (0 : ℂ) r] + apply circleAverage_mono + · exact circleIntegrable_const _ _ _ + · have hmer : MeromorphicOn (fun z : ℂ ↦ F.eval z) + (sphere (0 : ℂ) |r|) := by + simpa [abs_of_pos hr] using + (hFanalytic.mono sphere_subset_closedBall).meromorphicOn + exact hmer.circleIntegrable_log_norm + · simpa [abs_of_pos hr] using hlog_lower + have hF0 : F.eval 0 = (t : ℂ) * B.eval 0 := by + simp [F, hA0] + have hcenter_norm : ‖F.eval 0‖ < m / 2 := by + rw [hF0] + simp only [norm_mul] + rw [show ‖(t : ℂ)‖ = t by simp [Real.norm_eq_abs, abs_of_pos ht]] + calc + t * ‖B.eval 0‖ ≤ t * M := mul_le_mul_of_nonneg_left hM_center ht.le + _ < m / 2 := by + dsimp [t] + have hden : 0 < 4 * (M + 1) := by positivity + rw [div_mul_eq_mul_div, div_lt_iff₀ hden, div_mul_eq_mul_div] + nlinarith + have hlog_center : Real.log ‖F.eval 0‖ < Real.log (m / 2) := by + exact Real.strictMonoOn_log + (norm_pos_iff.mpr (hFzeroFree 0 (by simp [hr.le]))) (half_pos hm) hcenter_norm + rw [hmean] at havg_lower + exact (not_lt_of_ge havg_lower) hlog_center + +/-! ## The multivariate closure lemma -/ + +/-- Complex-coefficient stability in the product of open upper half-planes. -/ +def IsUpperHalfPlaneStable + {σ : Type*} (p : MvPolynomial σ ℂ) : Prop := + ∀ z : σ → ℂ, (∀ i, 0 < (z i).im) → p.eval z ≠ 0 + +/-- Restrict a multivariate polynomial to the affine complex line `z + s v`. -/ +noncomputable def affineLinePolynomial + {σ : Type*} (p : MvPolynomial σ ℂ) (z v : σ → ℂ) : Polynomial ℂ := + p.eval₂ Polynomial.C (fun i ↦ Polynomial.C (z i) + Polynomial.C (v i) * Polynomial.X) + +@[simp] +theorem affineLinePolynomial_eval + {σ : Type*} (p : MvPolynomial σ ℂ) (z v : σ → ℂ) (s : ℂ) : + (affineLinePolynomial p z v).eval s = p.eval (fun i ↦ z i + s * v i) := by + rw [affineLinePolynomial, MvPolynomial.polynomial_eval_eval₂] + simp only [Polynomial.eval_add, Polynomial.eval_C, Polynomial.eval_mul, + Polynomial.eval_X] + have hring : (Polynomial.evalRingHom s).comp Polynomial.C = RingHom.id ℂ := by + ext x + simp + rw [hring, MvPolynomial.eval₂_id] + apply MvPolynomial.eval₂_congr + intro i c hi hc + ring + +theorem exists_eval_ne_zero_of_mvPolynomial_ne_zero + {σ : Type*} {p : MvPolynomial σ ℂ} (hp : p ≠ 0) : + ∃ z : σ → ℂ, p.eval z ≠ 0 := by + by_contra h + push Not at h + apply hp + apply MvPolynomial.funext + intro z + simpa using h z + +/-- The limit, along a positive real ray, of stable multivariate polynomials +is stable or identically zero. This is the finite-dimensional form of +Hurwitz closure used in the preservation argument. -/ +theorem upperHalfPlaneStableOrZero_of_positive_ray + {σ : Type*} [Fintype σ] + (p q : MvPolynomial σ ℂ) + (hstable : ∀ t : ℝ, 0 < t → + IsUpperHalfPlaneStable (p + MvPolynomial.C (t : ℂ) * q)) : + p = 0 ∨ IsUpperHalfPlaneStable p := by + by_cases hp : p = 0 + · exact Or.inl hp + right + intro z hz + intro hpz + obtain ⟨w, hw⟩ := exists_eval_ne_zero_of_mvPolynomial_ne_zero hp + let v : σ → ℂ := fun i ↦ w i - z i + let A : Polynomial ℂ := affineLinePolynomial p z v + let B : Polynomial ℂ := affineLinePolynomial q z v + have hA0 : A.eval 0 = 0 := by + simp [A, v, hpz] + have hA1 : A.eval 1 = p.eval w := by + simp [A, v] + have hA : A ≠ 0 := by + intro hzero + have := congrArg (fun P : Polynomial ℂ ↦ P.eval 1) hzero + simp [hA1, hw] at this + have hnear : + {s : ℂ | ∀ i, 0 < (z i + s * v i).im} ∈ nhds (0 : ℂ) := by + change ∀ᶠ s in nhds (0 : ℂ), ∀ i, 0 < (z i + s * v i).im + rw [Filter.eventually_all] + intro i + have hcont : ContinuousAt (fun s : ℂ ↦ (z i + s * v i).im) 0 := by + fun_prop + exact hcont.eventually (isOpen_Ioi.mem_nhds (by simpa using hz i)) + obtain ⟨R, hR, hRsub⟩ := Metric.mem_nhds_iff.mp hnear + obtain ⟨t, ht, s, hsball, hsroot⟩ := + polynomial_linear_perturbation_has_nearby_zero A B (R / 2) + hA (half_pos hR) hA0 + have hsR : s ∈ ball (0 : ℂ) R := by + rw [mem_closedBall, dist_zero_right] at hsball + rw [mem_ball, dist_zero_right] + exact hsball.trans_lt (half_lt_self hR) + have hlineUpper : ∀ i, 0 < (z i + s * v i).im := hRsub hsR + have hne := hstable t ht (fun i ↦ z i + s * v i) hlineUpper + apply hne + rw [MvPolynomial.eval_add, MvPolynomial.eval_mul, MvPolynomial.eval_C] + simpa [A, B, affineLinePolynomial_eval] using hsroot + +/-! ## Coefficients, boundary values, and the Lieb--Sokal contraction -/ + +/-- Adjoin one multiaffine variable, with fixedValue coefficient `g` and +linear coefficient `f`. -/ +noncomputable def linearExtension + {σ : Type*} (g f : MvPolynomial σ ℂ) : MvPolynomial (Option σ) ℂ := + MvPolynomial.rename some g + + MvPolynomial.X none * MvPolynomial.rename some f + +@[simp] +theorem linearExtension_eval + {σ : Type*} (g f : MvPolynomial σ ℂ) (z : Option σ → ℂ) : + (linearExtension g f).eval z = + g.eval (z ∘ some) + z none * f.eval (z ∘ some) := by + simp [linearExtension, MvPolynomial.eval_rename] + +/-- The coefficient of a stable polynomial in a multiaffine variable is +stable or zero. It is obtained as a large-imaginary-value limit. -/ +theorem linearExtension_linearCoefficient_stableOrZero + {σ : Type*} [Fintype σ] + {g f : MvPolynomial σ ℂ} + (hstable : IsUpperHalfPlaneStable (linearExtension g f)) : + f = 0 ∨ IsUpperHalfPlaneStable f := by + let q : MvPolynomial σ ℂ := MvPolynomial.C (-Complex.I) * g + apply upperHalfPlaneStableOrZero_of_positive_ray f q + intro t ht z hz + let w : Option σ → ℂ + | none => Complex.I / (t : ℂ) + | some i => z i + have hw : ∀ i, 0 < (w i).im := by + intro i + cases i with + | none => + simp [w, Complex.div_im, ht] + | some i => simpa [w] using hz i + have hne := hstable w hw + intro hzero + have hzero' : f.eval z - (t : ℂ) * Complex.I * g.eval z = 0 := by + simpa [q, sub_eq_add_neg, mul_assoc] using hzero + apply hne + have hwcomp : w ∘ some = z := by rfl + rw [linearExtension_eval, hwcomp] + calc + g.eval z + w none * f.eval z = + (Complex.I / (t : ℂ)) * + (f.eval z - (t : ℂ) * Complex.I * g.eval z) := by + dsimp [w] + field_simp [ht.ne'] + have hII (x : ℂ) : Complex.I * (Complex.I * x) = -x := by + rw [← mul_assoc, Complex.I_mul_I, neg_one_mul] + calc + g.eval z * (t : ℂ) + Complex.I * f.eval z = + Complex.I * f.eval z + g.eval z * (t : ℂ) := by ring + _ = Complex.I * f.eval z - + Complex.I * (Complex.I * (g.eval z * (t : ℂ))) := by + rw [hII] + ring + _ = Complex.I * + (f.eval z - g.eval z * Complex.I * (t : ℂ)) := by ring + _ = 0 := by rw [hzero']; ring + +/-- Substitution of a real-boundary value preserves stability, with the zero +polynomial allowed. Here the boundary value is zero; translations give the +usual general statement. -/ +theorem linearExtension_constantCoefficient_stableOrZero + {σ : Type*} [Fintype σ] + {g f : MvPolynomial σ ℂ} + (hstable : IsUpperHalfPlaneStable (linearExtension g f)) : + g = 0 ∨ IsUpperHalfPlaneStable g := by + let q : MvPolynomial σ ℂ := MvPolynomial.C Complex.I * f + apply upperHalfPlaneStableOrZero_of_positive_ray g q + intro t ht z hz + let w : Option σ → ℂ + | none => Complex.I * (t : ℂ) + | some i => z i + have hw : ∀ i, 0 < (w i).im := by + intro i + cases i with + | none => simpa [w] using ht + | some i => simpa [w] using hz i + have hne := hstable w hw + have hwcomp : w ∘ some = z := by rfl + intro hzero + apply hne + rw [linearExtension_eval, hwcomp] + have hzero' : g.eval z + (t : ℂ) * Complex.I * f.eval z = 0 := by + simpa [q, mul_assoc] using hzero + linear_combination hzero' + +/-- Ratio characterization for a polynomial affine in one new variable. -/ +theorem linearExtension_stable_iff_ratio + {σ : Type*} {g f : MvPolynomial σ ℂ} + (hf : IsUpperHalfPlaneStable f) : + IsUpperHalfPlaneStable (linearExtension g f) ↔ + ∀ z : σ → ℂ, (∀ i, 0 < (z i).im) → + 0 ≤ (g.eval z / f.eval z).im := by + constructor + · intro h z hz + have hfz := hf z hz + by_contra hneg + have him : 0 < (-g.eval z / f.eval z).im := by + rw [neg_div] + simpa using (lt_of_not_ge hneg) + let w : Option σ → ℂ + | none => -g.eval z / f.eval z + | some i => z i + have hw : ∀ i, 0 < (w i).im := by + intro i + cases i with + | none => exact him + | some i => simpa [w] using hz i + have hne := h w hw + apply hne + have hwcomp : w ∘ some = z := by rfl + rw [linearExtension_eval, hwcomp] + dsimp [w] + field_simp [hfz] + ring + · intro h z hz + have hbase : ∀ i, 0 < ((z ∘ some) i).im := fun i ↦ hz (some i) + have hfz := hf (z ∘ some) hbase + intro hzero + have hy : z none = -g.eval (z ∘ some) / f.eval (z ∘ some) := by + apply (eq_div_iff hfz).2 + have := hzero + simp only [linearExtension_eval] at this + rw [eq_neg_iff_add_eq_zero] + simpa [add_comm] using this + have him := h (z ∘ some) hbase + have hyim : (z none).im ≤ 0 := by + rw [hy, neg_div] + simpa using neg_nonpos.mpr him + exact (not_lt_of_ge hyim) (hz none) + +/-- The elementary inverse-shift identity in the Lieb--Sokal proof. -/ +theorem inverseShiftExtension_stable + {σ : Type*} [Fintype σ] + {f₀ f₁ : MvPolynomial σ ℂ} + (hf : IsUpperHalfPlaneStable (linearExtension f₀ f₁)) : + IsUpperHalfPlaneStable + (linearExtension (-MvPolynomial.rename some f₁) + (linearExtension f₀ f₁)) := by + intro z hz + let y : ℂ := z none + let u : Option σ → ℂ := z ∘ some + let shifted : Option σ → ℂ + | none => u none - 1 / y + | some i => u (some i) + have hy : 0 < y.im := by simpa [y] using hz none + have hyne : y ≠ 0 := by + intro h + rw [h] at hy + simp at hy + have him_inv : (1 / y).im < 0 := by + rw [one_div, Complex.inv_im] + exact div_neg_of_neg_of_pos (neg_neg_of_pos hy) (Complex.normSq_pos.mpr hyne) + have hshifted : ∀ i, 0 < (shifted i).im := by + intro i + cases i with + | none => + dsimp [shifted, u] + have hu := hz (some none) + linarith + | some i => simpa [shifted, u] using hz (some (some i)) + have hne := hf shifted hshifted + intro hzero + apply hne + have hzero' : + -f₁.eval (u ∘ some) + + y * (f₀.eval (u ∘ some) + u none * f₁.eval (u ∘ some)) = 0 := by + simpa [linearExtension_eval, MvPolynomial.eval_rename, y, u] using hzero + rw [linearExtension_eval] + have hshiftcomp : shifted ∘ some = u ∘ some := by rfl + rw [hshiftcomp] + change f₀.eval (u ∘ some) + + (u none - 1 / y) * f₁.eval (u ∘ some) = 0 + calc + f₀.eval (u ∘ some) + + (u none - 1 / y) * f₁.eval (u ∘ some) = + (1 / y) * + (-f₁.eval (u ∘ some) + + y * (f₀.eval (u ∘ some) + u none * f₁.eval (u ∘ some))) := by + field_simp [hyne] + ring + _ = 0 := by rw [hzero']; ring + +/-- Coordinate form of the Lieb--Sokal lemma. The proof uses only the ratio +characterization above, the inverse shift, and boundary closure. -/ +theorem liebSokal_linear_contraction + {σ : Type*} [Fintype σ] + (g : MvPolynomial (Option σ) ℂ) (f₀ f₁ : MvPolynomial σ ℂ) + (hstable : IsUpperHalfPlaneStable + (linearExtension g (linearExtension f₀ f₁))) : + g - MvPolynomial.rename some f₁ = 0 ∨ + IsUpperHalfPlaneStable (g - MvPolynomial.rename some f₁) := by + have hfOr := linearExtension_linearCoefficient_stableOrZero hstable + rcases hfOr with hfzero | hf + · have hf₁zero : f₁ = 0 := by + apply MvPolynomial.funext + intro z + let w₀ : Option σ → ℂ + | none => 0 + | some i => z i + let w₁ : Option σ → ℂ + | none => 1 + | some i => z i + have h₀ := congrArg (fun P : MvPolynomial (Option σ) ℂ ↦ P.eval w₀) hfzero + have h₁ := congrArg (fun P : MvPolynomial (Option σ) ℂ ↦ P.eval w₁) hfzero + have hw₀ : w₀ ∘ some = z := by rfl + have hw₁ : w₁ ∘ some = z := by rfl + simp [linearExtension_eval, w₀, w₁, hw₀, hw₁] at h₀ h₁ + change f₁.eval z = 0 + linear_combination h₁ - h₀ + subst f₁ + simpa using linearExtension_constantCoefficient_stableOrZero hstable + · have hinverse := inverseShiftExtension_stable hf + have hratio₁ := (linearExtension_stable_iff_ratio hf).1 hstable + have hratio₂ := (linearExtension_stable_iff_ratio hf).1 hinverse + have hcombined : IsUpperHalfPlaneStable + (linearExtension (g - MvPolynomial.rename some f₁) + (linearExtension f₀ f₁)) := by + apply (linearExtension_stable_iff_ratio hf).2 + intro z hz + have h₁ := hratio₁ z hz + have h₂ := hratio₂ z hz + simp only [MvPolynomial.eval_neg, neg_div] at h₂ + rw [MvPolynomial.eval_sub, sub_eq_add_neg, add_div, neg_div] + simpa only [Complex.add_im, Complex.neg_im] using add_nonneg h₁ h₂ + exact linearExtension_constantCoefficient_stableOrZero hcombined + +/-! ## Specializing an arbitrary multiaffine coordinate -/ + +def IsComplexMultiaffine + {σ : Type*} (p : MvPolynomial σ ℂ) : Prop := + ∀ i, p.degreeOf i ≤ 1 + +theorem IsUpperHalfPlaneStable.rename + {σ τ : Type*} {p : MvPolynomial σ ℂ} + (hp : IsUpperHalfPlaneStable p) (f : σ → τ) : + IsUpperHalfPlaneStable (MvPolynomial.rename f p) := by + intro z hz + rw [MvPolynomial.eval_rename] + exact hp (z ∘ f) (fun i ↦ hz (f i)) + +noncomputable def optionConstantCoefficient + {σ : Type*} (p : MvPolynomial (Option σ) ℂ) : MvPolynomial σ ℂ := + (MvPolynomial.optionEquivLeft ℂ σ p).coeff 0 + +noncomputable def optionLinearCoefficient + {σ : Type*} (p : MvPolynomial (Option σ) ℂ) : MvPolynomial σ ℂ := + (MvPolynomial.optionEquivLeft ℂ σ p).coeff 1 + +theorem optionEquivLeft_rename_some + {σ : Type*} (p : MvPolynomial σ ℂ) : + MvPolynomial.optionEquivLeft ℂ σ (MvPolynomial.rename some p) = + Polynomial.C p := by + induction p using MvPolynomial.induction_on with + | C r => simp + | add p q hp hq => simp [hp, hq] + | mul_X p n hp => simp [hp] + +theorem option_eq_linearExtension + {σ : Type*} (p : MvPolynomial (Option σ) ℂ) + (hdegree : p.degreeOf none ≤ 1) : + p = linearExtension (optionConstantCoefficient p) + (optionLinearCoefficient p) := by + apply (MvPolynomial.optionEquivLeft ℂ σ).injective + have hnat : (MvPolynomial.optionEquivLeft ℂ σ p).natDegree ≤ 1 := by + simpa [MvPolynomial.natDegree_optionEquivLeft] using hdegree + rw [Polynomial.eq_X_add_C_of_natDegree_le_one hnat] + simp only [linearExtension, map_add, map_mul, + MvPolynomial.optionEquivLeft_X_none, optionEquivLeft_rename_some] + dsimp [optionConstantCoefficient, optionLinearCoefficient] + ring + +theorem linearExtension_eq_zero_iff + {σ : Type*} {g f : MvPolynomial σ ℂ} : + linearExtension g f = 0 ↔ g = 0 ∧ f = 0 := by + constructor + · intro h + have h' := congrArg (MvPolynomial.optionEquivLeft ℂ σ) h + simp only [linearExtension, map_add, map_mul, + MvPolynomial.optionEquivLeft_X_none, optionEquivLeft_rename_some, map_zero] at h' + constructor + · have := congrArg (fun P : Polynomial (MvPolynomial σ ℂ) ↦ P.coeff 0) h' + simpa using this + · have := congrArg (fun P : Polynomial (MvPolynomial σ ℂ) ↦ P.coeff 1) h' + simpa using this + · rintro ⟨rfl, rfl⟩ + simp [linearExtension] +theorem linearExtension_multiaffine + {σ : Type*} {g f : MvPolynomial σ ℂ} + (hg : IsComplexMultiaffine g) (hf : IsComplexMultiaffine f) : + IsComplexMultiaffine (linearExtension g f) := by + classical + intro j + cases j with + | none => + rw [← MvPolynomial.natDegree_optionEquivLeft] + simp only [linearExtension, map_add, map_mul, + MvPolynomial.optionEquivLeft_X_none, optionEquivLeft_rename_some] + rw [show Polynomial.C g + Polynomial.X * Polynomial.C f = + Polynomial.C f * Polynomial.X + Polynomial.C g by ring] + exact Polynomial.natDegree_linear_le (a := f) (b := g) + | some i => + apply le_trans (MvPolynomial.degreeOf_add_le (some i) _ _) + apply max_le + · simpa using + (MvPolynomial.degreeOf_rename_of_injective (Option.some_injective σ) i).trans_le (hg i) + · apply le_trans (MvPolynomial.degreeOf_mul_le (some i) _ _) + have hx : (MvPolynomial.X none : MvPolynomial (Option σ) ℂ).degreeOf (some i) = 0 := + MvPolynomial.degreeOf_X_of_ne (by simp) + rw [hx, zero_add] + simpa using + (MvPolynomial.degreeOf_rename_of_injective (Option.some_injective σ) i).trans_le (hf i) + +/-- Specializing the adjoined variable to a real number preserves stability, +again allowing the zero polynomial. -/ +theorem linearExtension_specialize_real_stableOrZero + {σ : Type*} [Fintype σ] + {g f : MvPolynomial σ ℂ} (c : ℝ) + (hstable : IsUpperHalfPlaneStable (linearExtension g f)) : + g + MvPolynomial.C (c : ℂ) * f = 0 ∨ + IsUpperHalfPlaneStable (g + MvPolynomial.C (c : ℂ) * f) := by + have hshift : IsUpperHalfPlaneStable + (linearExtension (g + MvPolynomial.C (c : ℂ) * f) f) := by + intro z hz + let w : Option σ → ℂ + | none => z none + (c : ℂ) + | some i => z (some i) + have hw : ∀ i, 0 < (w i).im := by + intro i + cases i with + | none => simpa [w] using hz none + | some i => simpa [w] using hz (some i) + have hne := hstable w hw + have hwcomp : w ∘ some = z ∘ some := by rfl + intro hzero + apply hne + rw [linearExtension_eval, hwcomp] + have hzero' := hzero + rw [linearExtension_eval] at hzero' + simp only [MvPolynomial.eval_add, MvPolynomial.eval_mul, + MvPolynomial.eval_C] at hzero' + dsimp [w] + linear_combination hzero' + exact linearExtension_constantCoefficient_stableOrZero hshift + +/-- Coordinate specialization in a polynomial whose selected variable has +degree at most one. -/ +theorem option_specialize_real_stableOrZero + {σ : Type*} [Fintype σ] + (p : MvPolynomial (Option σ) ℂ) (c : ℝ) + (hdegree : p.degreeOf none ≤ 1) + (hstable : IsUpperHalfPlaneStable p) : + optionConstantCoefficient p + + MvPolynomial.C (c : ℂ) * optionLinearCoefficient p = 0 ∨ + IsUpperHalfPlaneStable + (optionConstantCoefficient p + + MvPolynomial.C (c : ℂ) * optionLinearCoefficient p) := by + rw [option_eq_linearExtension p hdegree] at hstable + exact linearExtension_specialize_real_stableOrZero c hstable + +theorem degreeOf_optionConstantCoefficient_le + {σ : Type*} (p : MvPolynomial (Option σ) ℂ) (i : σ) : + (optionConstantCoefficient p).degreeOf i ≤ p.degreeOf (some i) := by + rw [MvPolynomial.degreeOf_le_iff] + intro m hm + have hm' : m.optionElim 0 ∈ p.support := by + exact (MvPolynomial.mem_support_coeff_optionEquivLeft (R := ℂ)).mp hm + simpa using MvPolynomial.monomial_le_degreeOf (some i) hm' + +theorem degreeOf_optionLinearCoefficient_le + {σ : Type*} (p : MvPolynomial (Option σ) ℂ) (i : σ) : + (optionLinearCoefficient p).degreeOf i ≤ p.degreeOf (some i) := by + rw [MvPolynomial.degreeOf_le_iff] + intro m hm + have hm' : m.optionElim 1 ∈ p.support := by + exact (MvPolynomial.mem_support_coeff_optionEquivLeft (R := ℂ)).mp hm + simpa using MvPolynomial.monomial_le_degreeOf (some i) hm' + +theorem option_specialization_multiaffine + {σ : Type*} (p : MvPolynomial (Option σ) ℂ) (c : ℝ) + (hp : IsComplexMultiaffine p) : + IsComplexMultiaffine + (optionConstantCoefficient p + + MvPolynomial.C (c : ℂ) * optionLinearCoefficient p) := by + intro i + apply le_trans (MvPolynomial.degreeOf_add_le i _ _) + apply max_le + · exact (degreeOf_optionConstantCoefficient_le p i).trans (hp (some i)) + · exact (MvPolynomial.degreeOf_C_mul_le _ i _).trans + ((degreeOf_optionLinearCoefficient_le p i).trans (hp (some i))) + +noncomputable def coordinateReindex + {σ : Type*} (p : MvPolynomial σ ℂ) (i : σ) : + MvPolynomial (Option {j : σ // j ≠ i}) ℂ := by + classical + exact MvPolynomial.rename (Equiv.optionSubtypeNe i).symm p + +noncomputable def coordinateSpecialization + {σ : Type*} (p : MvPolynomial σ ℂ) (i : σ) (c : ℝ) : + MvPolynomial {j : σ // j ≠ i} ℂ := by + classical + exact optionConstantCoefficient (coordinateReindex p i) + + MvPolynomial.C (c : ℂ) * optionLinearCoefficient (coordinateReindex p i) + +theorem coordinateReindex_stable + {σ : Type*} {p : MvPolynomial σ ℂ} (i : σ) + (hp : IsUpperHalfPlaneStable p) : + IsUpperHalfPlaneStable (coordinateReindex p i) := by + classical + simpa [coordinateReindex] using hp.rename (Equiv.optionSubtypeNe i).symm + +theorem coordinateReindex_multiaffine + {σ : Type*} {p : MvPolynomial σ ℂ} (i : σ) + (hp : IsComplexMultiaffine p) : + IsComplexMultiaffine (coordinateReindex p i) := by + classical + intro j + let e := Equiv.optionSubtypeNe i + have hdegree := MvPolynomial.degreeOf_rename_of_injective e.symm.injective (e j) + (p := p) + have hp' := hp (e j) + change MvPolynomial.degreeOf j (MvPolynomial.rename e.symm p) ≤ 1 + convert hdegree.trans_le hp' using 1 + simp + +theorem coordinateSpecialization_stableOrZero + {σ : Type*} [Fintype σ] + (p : MvPolynomial σ ℂ) (i : σ) (c : ℝ) + (hmulti : IsComplexMultiaffine p) + (hstable : IsUpperHalfPlaneStable p) : + coordinateSpecialization p i c = 0 ∨ + IsUpperHalfPlaneStable (coordinateSpecialization p i c) := by + classical + let p' := coordinateReindex p i + have hdegree : p'.degreeOf none ≤ 1 := + coordinateReindex_multiaffine i hmulti none + simpa [coordinateSpecialization, p'] using + option_specialize_real_stableOrZero p' c hdegree + (coordinateReindex_stable i hstable) + +theorem coordinateSpecialization_multiaffine + {σ : Type*} (p : MvPolynomial σ ℂ) (i : σ) (c : ℝ) + (hp : IsComplexMultiaffine p) : + IsComplexMultiaffine (coordinateSpecialization p i c) := by + classical + exact option_specialization_multiaffine (coordinateReindex p i) c + (coordinateReindex_multiaffine i hp) + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/SourceStableEncoding.lean b/LeanPool/BeyondBethe/BeyondBethe/SourceStableEncoding.lean new file mode 100644 index 0000000000..413297c16b --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/SourceStableEncoding.lean @@ -0,0 +1,665 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.SourceStableInduction +import LeanPool.BeyondBethe.BeyondBethe.CapacityOrder +import Mathlib.Tactic + +/-! # Source Stable Encoding -/ + +open scoped BigOperators +open scoped ComplexConjugate + +namespace BeyondBethe + +/-! +# Encoding multiaffine polynomials by Boolean coefficient tables +-/ + +noncomputable def boolExponent {n : ℕ} (S : Fin n → Bool) : Fin n →₀ ℕ := + Finsupp.equivFunOnFinite.symm (fun i ↦ bif S i then 1 else 0) + +@[simp] +theorem boolExponent_apply {n : ℕ} (S : Fin n → Bool) (i : Fin n) : + boolExponent S i = bif S i then 1 else 0 := by + simp [boolExponent] + +theorem boolExponent_injective {n : ℕ} : + Function.Injective (@boolExponent n) := by + intro S T h + funext i + have hi := DFunLike.congr_fun h i + simp only [boolExponent_apply] at hi + cases hS : S i <;> cases hT : T i <;> simp [hS, hT] at hi ⊢ + +noncomputable def exponentBool {n : ℕ} (d : Fin n →₀ ℕ) : Fin n → Bool := + fun i ↦ decide (d i = 1) + +theorem boolExponent_exponentBool {n : ℕ} (d : Fin n →₀ ℕ) + (hd : ∀ i, d i ≤ 1) : boolExponent (exponentBool d) = d := by + ext i + simp only [boolExponent_apply, exponentBool] + by_cases h : d i = 1 + · simp [h] + · have hz : d i = 0 := by + rcases Nat.le_one_iff_eq_zero_or_eq_one.mp (hd i) with hz | ho + · exact hz + · exact (h ho).elim + simp [h, hz] + +theorem coeff_eq_zero_of_not_squarefree + {n : ℕ} {p : MvPolynomial (Fin n) ℝ} + (hp : IsMultiaffine p) {d : Fin n →₀ ℕ} + (hd : ¬ ∀ i, d i ≤ 1) : p.coeff d = 0 := by + by_contra hcoeff + push Not at hd + obtain ⟨i, hi⟩ := hd + have hmem : d ∈ p.support := MvPolynomial.mem_support_iff.mpr hcoeff + have hdegree := MvPolynomial.monomial_le_degreeOf i hmem + have := hp i + omega + +theorem multiaffine_eq_boolExpansion + {n : ℕ} (p : MvPolynomial (Fin n) ℝ) (hp : IsMultiaffine p) : + p = ∑ S : Fin n → Bool, + MvPolynomial.monomial (boolExponent S) (p.coeff (boolExponent S)) := by + classical + ext d + by_cases hd : ∀ i, d i ≤ 1 + · let S := exponentBool d + have hSd : boolExponent S = d := boolExponent_exponentBool d hd + rw [MvPolynomial.coeff_sum] + rw [Finset.sum_eq_single S] + · simp [hSd] + · intro T hT hTS + simp only [MvPolynomial.coeff_monomial] + rw [if_neg] + intro h + apply hTS + exact boolExponent_injective (h.trans hSd.symm) + · intro hS + exact (hS (Finset.mem_univ S)).elim + · rw [coeff_eq_zero_of_not_squarefree hp hd, MvPolynomial.coeff_sum] + symm + apply Finset.sum_eq_zero + intro S hS + simp only [MvPolynomial.coeff_monomial] + rw [if_neg] + intro h + apply hd + intro i + rw [← h, boolExponent_apply] + cases S i <;> simp + +noncomputable def boolMonomial {n : ℕ} + (x : Fin n → ℝ) (S : Fin n → Bool) : ℝ := + ∏ i, (x i) ^ (bif S i then (1 : ℕ) else 0) + +theorem multiaffine_eval_eq_boolSum + {n : ℕ} (p : MvPolynomial (Fin n) ℝ) (hp : IsMultiaffine p) + (x : Fin n → ℝ) : + p.eval x = ∑ S : Fin n → Bool, + p.coeff (boolExponent S) * boolMonomial x S := by + calc + p.eval x = + (∑ S : Fin n → Bool, + MvPolynomial.monomial (boolExponent S) (p.coeff (boolExponent S))).eval x := by + rw [← multiaffine_eq_boolExpansion p hp] + _ = ∑ S : Fin n → Bool, + p.coeff (boolExponent S) * boolMonomial x S := by + rw [map_sum] + apply Finset.sum_congr rfl + intro S hS + simp only [MvPolynomial.eval_monomial] + congr 1 + rw [Finsupp.prod_fintype] + · simp [boolMonomial, boolExponent_apply] + · intro i + simp + +theorem sum_bool_fin_succ {n : ℕ} {R : Type*} [AddCommMonoid R] + (f : (Fin (n + 1) → Bool) → R) : + (∑ S : Fin (n + 1) → Bool, f S) = + ∑ b : Bool, ∑ T : Fin n → Bool, f (prependBool b T) := by + let e : Bool × (Fin n → Bool) ≃ (Fin (n + 1) → Bool) := + Fin.consEquiv (fun _ ↦ Bool) + calc + (∑ S : Fin (n + 1) → Bool, f S) = + ∑ p : Bool × (Fin n → Bool), f (e p) := by + symm + exact e.sum_comp f + _ = ∑ b : Bool, ∑ T : Fin n → Bool, f (prependBool b T) := by + rw [Fintype.sum_prod_type] + rfl + +theorem boolMonomial_prepend {n : ℕ} (x : Fin (n + 1) → ℝ) + (b : Bool) (S : Fin n → Bool) : + boolMonomial x (prependBool b S) = + (bif b then x 0 else 1) * boolMonomial (fun i ↦ x i.succ) S := by + rw [boolMonomial, Fin.prod_univ_succ, boolMonomial] + simp only [prependBool, Fin.cases_zero, Fin.cases_succ] + cases b <;> simp + +theorem sum_sum_mul_factors {ι κ R : Type*} [Fintype ι] [Fintype κ] + [CommRing R] + (c : ι → κ → R) (u : ι → R) (v : κ → R) (A B : R) : + (∑ i, ∑ j, c i j * (A * u i) * (B * v j)) = + A * B * (∑ i, ∑ j, c i j * u i * v j) := by + calc + (∑ i, ∑ j, c i j * (A * u i) * (B * v j)) = + ∑ i, ∑ j, (A * B) * (c i j * u i * v j) := by + apply Finset.sum_congr rfl + intro i hi + apply Finset.sum_congr rfl + intro j hj + ring + _ = ∑ i, (A * B) * (∑ j, c i j * u i * v j) := by + apply Finset.sum_congr rfl + intro i hi + rw [Finset.mul_sum] + _ = A * B * (∑ i, ∑ j, c i j * u i * v j) := by + rw [Finset.mul_sum] + +theorem pairTableEval_eq_boolDoubleSum : + ∀ {n : ℕ} (c : PairTable n) (y z : Fin n → ℝ), + pairTableEval n c y z = + ∑ S : Fin n → Bool, ∑ T : Fin n → Bool, + c S T * boolMonomial y S * boolMonomial z T := by + intro n + induction n with + | zero => + intro c y z + have hy (S : Fin 0 → Bool) : boolMonomial y S = 1 := by + rw [boolMonomial] + apply Finset.prod_eq_one + intro i hi + exact Fin.elim0 i + have hz (T : Fin 0 → Bool) : boolMonomial z T = 1 := by + rw [boolMonomial] + apply Finset.prod_eq_one + intro i hi + exact Fin.elim0 i + simp only [pairTableEval, Fintype.sum_unique, hy, hz, mul_one] + apply congrArg₂ c <;> apply Subsingleton.elim + | succ n ih => + intro c y z + rw [sum_bool_fin_succ] + simp_rw [sum_bool_fin_succ] + simp only [Fintype.sum_bool, boolMonomial_prepend, + Finset.sum_add_distrib] + rw [sum_sum_mul_factors, sum_sum_mul_factors, + sum_sum_mul_factors, sum_sum_mul_factors] + simp only [Bool.false_eq, Bool.true_eq, Bool.cond_false, Bool.cond_true, + one_mul, mul_one] + change pairTableEval (n + 1) c y z = + y 0 * z 0 * + (∑ S, ∑ T, pairTableSection c true true S T * + boolMonomial (fun i ↦ y i.succ) S * boolMonomial (fun i ↦ z i.succ) T) + + z 0 * + (∑ S, ∑ T, pairTableSection c false true S T * + boolMonomial (fun i ↦ y i.succ) S * boolMonomial (fun i ↦ z i.succ) T) + + (y 0 * + (∑ S, ∑ T, pairTableSection c true false S T * + boolMonomial (fun i ↦ y i.succ) S * boolMonomial (fun i ↦ z i.succ) T) + + (∑ S, ∑ T, pairTableSection c false false S T * + boolMonomial (fun i ↦ y i.succ) S * boolMonomial (fun i ↦ z i.succ) T)) + rw [← ih (pairTableSection c true true) (fun i ↦ y i.succ) (fun i ↦ z i.succ), + ← ih (pairTableSection c false true) (fun i ↦ y i.succ) (fun i ↦ z i.succ), + ← ih (pairTableSection c true false) (fun i ↦ y i.succ) (fun i ↦ z i.succ), + ← ih (pairTableSection c false false) (fun i ↦ y i.succ) (fun i ↦ z i.succ)] + simp only [pairTableEval] + ring + +noncomputable def coefficientPairTable {n : ℕ} + (p q : MvPolynomial (Fin n) ℝ) : PairTable n := + fun S T ↦ p.coeff (boolExponent S) * q.coeff (boolExponent T) + +theorem coefficientPairTable_eval + {n : ℕ} (p q : MvPolynomial (Fin n) ℝ) + (hp : IsMultiaffine p) (hq : IsMultiaffine q) + (y z : Fin n → ℝ) : + pairTableEval n (coefficientPairTable p q) y z = p.eval y * q.eval z := by + rw [pairTableEval_eq_boolDoubleSum, + multiaffine_eval_eq_boolSum p hp, + multiaffine_eval_eq_boolSum q hq] + rw [Finset.sum_mul] + apply Finset.sum_congr rfl + intro S hS + rw [Finset.mul_sum] + apply Finset.sum_congr rfl + intro T hT + simp [coefficientPairTable] + ring + +noncomputable def complexBoolMonomial {n : ℕ} + (x : Fin n → ℂ) (S : Fin n → Bool) : ℂ := + ∏ i, (x i) ^ (bif S i then (1 : ℕ) else 0) + +theorem multiaffine_eval₂_eq_boolSum + {n : ℕ} (p : MvPolynomial (Fin n) ℝ) (hp : IsMultiaffine p) + (x : Fin n → ℂ) : + p.eval₂ (algebraMap ℝ ℂ) x = ∑ S : Fin n → Bool, + ((p.coeff (boolExponent S) : ℝ) : ℂ) * complexBoolMonomial x S := by + calc + p.eval₂ (algebraMap ℝ ℂ) x = + ((∑ S : Fin n → Bool, + MvPolynomial.monomial (boolExponent S) (p.coeff (boolExponent S) : ℝ)) : + MvPolynomial (Fin n) ℝ).eval₂ + (algebraMap ℝ ℂ) x := by + rw [← multiaffine_eq_boolExpansion p hp] + _ = ∑ S : Fin n → Bool, + ((p.coeff (boolExponent S) : ℝ) : ℂ) * complexBoolMonomial x S := by + rw [MvPolynomial.eval₂_sum] + apply Finset.sum_congr rfl + intro S hS + simp only [MvPolynomial.eval₂_monomial, map_natCast] + congr 1 + rw [Finsupp.prod_fintype] + · simp [complexBoolMonomial, boolExponent_apply] + · intro i + simp + +noncomputable def pairTableComplexEval : + ∀ n : ℕ, PairTable n → (Fin n → ℂ) → (Fin n → ℂ) → ℂ + | 0, c, _, _ => (c (fun i ↦ Fin.elim0 i) (fun i ↦ Fin.elim0 i) : ℂ) + | n + 1, c, y, z => + let yt : Fin n → ℂ := fun i ↦ y i.succ + let zt : Fin n → ℂ := fun i ↦ z i.succ + let a := pairTableComplexEval n (pairTableSection c true true) yt zt + let b := pairTableComplexEval n (pairTableSection c true false) yt zt + let cc := pairTableComplexEval n (pairTableSection c false true) yt zt + let d := pairTableComplexEval n (pairTableSection c false false) yt zt + a * y 0 * z 0 + b * y 0 + cc * z 0 + d + +theorem complexBoolMonomial_prepend {n : ℕ} (x : Fin (n + 1) → ℂ) + (b : Bool) (S : Fin n → Bool) : + complexBoolMonomial x (prependBool b S) = + (bif b then x 0 else 1) * complexBoolMonomial (fun i ↦ x i.succ) S := by + rw [complexBoolMonomial, Fin.prod_univ_succ, complexBoolMonomial] + simp only [prependBool, Fin.cases_zero, Fin.cases_succ] + cases b <;> simp + +theorem pairTableComplexEval_eq_boolDoubleSum : + ∀ {n : ℕ} (c : PairTable n) (y z : Fin n → ℂ), + pairTableComplexEval n c y z = + ∑ S : Fin n → Bool, ∑ T : Fin n → Bool, + (c S T : ℂ) * complexBoolMonomial y S * complexBoolMonomial z T := by + intro n + induction n with + | zero => + intro c y z + have hy (S : Fin 0 → Bool) : complexBoolMonomial y S = 1 := by + rw [complexBoolMonomial] + apply Finset.prod_eq_one + intro i hi + exact Fin.elim0 i + have hz (T : Fin 0 → Bool) : complexBoolMonomial z T = 1 := by + rw [complexBoolMonomial] + apply Finset.prod_eq_one + intro i hi + exact Fin.elim0 i + simp only [pairTableComplexEval, Fintype.sum_unique, hy, hz, mul_one] + norm_cast + | succ n ih => + intro c y z + rw [sum_bool_fin_succ] + simp_rw [sum_bool_fin_succ] + simp only [Fintype.sum_bool, complexBoolMonomial_prepend, + Finset.sum_add_distrib] + rw [sum_sum_mul_factors, sum_sum_mul_factors, + sum_sum_mul_factors, sum_sum_mul_factors] + simp only [Bool.cond_false, Bool.cond_true, one_mul, mul_one] + change pairTableComplexEval (n + 1) c y z = + y 0 * z 0 * + (∑ S, ∑ T, (pairTableSection c true true S T : ℂ) * + complexBoolMonomial (fun i ↦ y i.succ) S * complexBoolMonomial (fun i ↦ z i.succ) T) + + z 0 * + (∑ S, ∑ T, (pairTableSection c false true S T : ℂ) * + complexBoolMonomial (fun i ↦ y i.succ) S * complexBoolMonomial (fun i ↦ z i.succ) T) + + (y 0 * + (∑ S, ∑ T, (pairTableSection c true false S T : ℂ) * + complexBoolMonomial (fun i ↦ y i.succ) S * complexBoolMonomial (fun i ↦ z i.succ) T) + + (∑ S, ∑ T, (pairTableSection c false false S T : ℂ) * + complexBoolMonomial (fun i ↦ y i.succ) S * complexBoolMonomial (fun i ↦ z i.succ) T)) + rw [← ih (pairTableSection c true true) (fun i ↦ y i.succ) (fun i ↦ z i.succ), + ← ih (pairTableSection c false true) (fun i ↦ y i.succ) (fun i ↦ z i.succ), + ← ih (pairTableSection c true false) (fun i ↦ y i.succ) (fun i ↦ z i.succ), + ← ih (pairTableSection c false false) (fun i ↦ y i.succ) (fun i ↦ z i.succ)] + simp only [pairTableComplexEval] + ring + +theorem coefficientPairTable_complexEval + {n : ℕ} (p q : MvPolynomial (Fin n) ℝ) + (hp : IsMultiaffine p) (hq : IsMultiaffine q) + (y z : Fin n → ℂ) : + pairTableComplexEval n (coefficientPairTable p q) y z = + p.eval₂ (algebraMap ℝ ℂ) y * q.eval₂ (algebraMap ℝ ℂ) z := by + rw [pairTableComplexEval_eq_boolDoubleSum, + multiaffine_eval₂_eq_boolSum p hp, + multiaffine_eval₂_eq_boolSum q hq] + rw [Finset.sum_mul] + apply Finset.sum_congr rfl + intro S hS + rw [Finset.mul_sum] + apply Finset.sum_congr rfl + intro T hT + simp [coefficientPairTable] + push_cast + ring + +def pairVariablesLeft : + ∀ n : ℕ, (PairVariables n → ℂ) → Fin n → ℂ + | 0, _, i => Fin.elim0 i + | n + 1, w, i => Fin.cases (w none) (pairVariablesLeft n ((w ∘ some) ∘ some)) i + +def pairVariablesRight : + ∀ n : ℕ, (PairVariables n → ℂ) → Fin n → ℂ + | 0, _, i => Fin.elim0 i + | n + 1, w, i => Fin.cases (w (some none)) (pairVariablesRight n ((w ∘ some) ∘ some)) i + +theorem pairTableStablePolynomial_eval_coordinates : + ∀ {n : ℕ} (c : PairTable n) (w : PairVariables n → ℂ), + (pairTableStablePolynomial n c).eval w = + pairTableComplexEval n c (pairVariablesLeft n w) + (fun i ↦ -pairVariablesRight n w i) := by + intro n + induction n with + | zero => intro c w; simp [pairTableStablePolynomial, pairTableComplexEval] + | succ n ih => + intro c w + change Option (Option (PairVariables n)) → ℂ at w + simp only [pairTableStablePolynomial] + change + (linearExtension + (linearExtension (pairTableStablePolynomial n (pairTableSection c false false)) + (-pairTableStablePolynomial n (pairTableSection c false true))) + (linearExtension (pairTableStablePolynomial n (pairTableSection c true false)) + (-pairTableStablePolynomial n (pairTableSection c true true)))).eval w = + pairTableComplexEval (n + 1) c + (Fin.cases (w none) (pairVariablesLeft n ((w ∘ some) ∘ some))) + (fun i ↦ -Fin.cases (w (some none)) + (pairVariablesRight n ((w ∘ some) ∘ some)) i) + rw [linearExtension_eval, linearExtension_eval, linearExtension_eval] + simp only [MvPolynomial.eval_neg] + rw [ih, ih, ih, ih] + simp only [pairTableComplexEval, pairVariablesLeft, pairVariablesRight, + Fin.cases_zero, Fin.cases_succ, Function.comp_apply] + ring + +theorem coefficientPairTable_nonnegative + {n : ℕ} {p q : MvPolynomial (Fin n) ℝ} + (hp : HasNonnegativeCoefficients p) (hq : HasNonnegativeCoefficients q) : + PairTableNonnegative (coefficientPairTable p q) := by + intro S T + exact mul_nonneg (hp _) (hq _) + +theorem eval₂_conj_of_real + {σ : Type*} (p : MvPolynomial σ ℝ) (z : σ → ℂ) : + p.eval₂ (algebraMap ℝ ℂ) (fun i ↦ conj (z i)) = + conj (p.eval₂ (algebraMap ℝ ℂ) z) := by + induction p using MvPolynomial.induction_on with + | C r => simp + | add p q hp hq => simp [hp, hq] + | mul_X p i hp => simp [hp, map_mul] + +theorem IsRealStable.lowerHalfPlane + {σ : Type*} {p : MvPolynomial σ ℝ} (hp : IsRealStable p) + (z : σ → ℂ) (hz : ∀ i, (z i).im < 0) : + p.eval₂ (algebraMap ℝ ℂ) z ≠ 0 := by + have hupper : ∀ i, 0 < (conj (z i)).im := by + intro i + simpa using neg_pos.mpr (hz i) + have hne := hp (fun i ↦ conj (z i)) hupper + rw [eval₂_conj_of_real] at hne + intro hzero + apply hne + rw [hzero] + simp + +theorem pairVariablesLeft_upper : + ∀ {n : ℕ} (w : PairVariables n → ℂ), + (∀ i, 0 < (w i).im) → ∀ j, 0 < (pairVariablesLeft n w j).im := by + intro n + induction n with + | zero => intro w hw j; exact Fin.elim0 j + | succ n ih => + intro w hw j + change Option (Option (PairVariables n)) → ℂ at w + refine Fin.cases (hw none) (fun i ↦ ?_) j + exact ih ((w ∘ some) ∘ some) (fun k ↦ hw (some (some k))) i + +theorem pairVariablesRight_upper : + ∀ {n : ℕ} (w : PairVariables n → ℂ), + (∀ i, 0 < (w i).im) → ∀ j, 0 < (pairVariablesRight n w j).im := by + intro n + induction n with + | zero => intro w hw j; exact Fin.elim0 j + | succ n ih => + intro w hw j + change Option (Option (PairVariables n)) → ℂ at w + refine Fin.cases (hw (some none)) (fun i ↦ ?_) j + exact ih ((w ∘ some) ∘ some) (fun k ↦ hw (some (some k))) i + +theorem coefficientPairTable_stable + {n : ℕ} {p q : MvPolynomial (Fin n) ℝ} + (hpMulti : IsMultiaffine p) (hqMulti : IsMultiaffine q) + (hpStable : IsRealStable p) (hqStable : IsRealStable q) : + IsUpperHalfPlaneStable + (pairTableStablePolynomial n (coefficientPairTable p q)) := by + intro w hw + rw [pairTableStablePolynomial_eval_coordinates, + coefficientPairTable_complexEval p q hpMulti hqMulti] + apply mul_ne_zero + · apply hpStable + exact pairVariablesLeft_upper w hw + · apply hqStable.lowerHalfPlane + intro i + simp only [Complex.neg_im] + exact neg_lt_zero.mpr (pairVariablesRight_upper w hw i) + +theorem pairTableDiagonalSum_eq_boolSum : + ∀ {n : ℕ} (c : PairTable n), + pairTableDiagonalSum n c = ∑ S : Fin n → Bool, c S S := by + intro n + induction n with + | zero => + intro c + simp only [pairTableDiagonalSum, Fintype.sum_unique] + apply congrArg₂ c <;> apply Subsingleton.elim + | succ n ih => + intro c + rw [sum_bool_fin_succ] + simp only [Fintype.sum_bool] + change pairTableDiagonalSum (n + 1) c = + (∑ S, pairTableSection c true true S S) + + ∑ S, pairTableSection c false false S S + rw [← ih (pairTableSection c true true), + ← ih (pairTableSection c false false)] + simp only [pairTableDiagonalSum] + ring + +theorem exponentBool_boolExponent {n : ℕ} (S : Fin n → Bool) : + exponentBool (boolExponent S) = S := by + apply boolExponent_injective + rw [boolExponent_exponentBool] + intro i + rw [boolExponent_apply] + cases S i <;> simp +theorem coefficientInnerProduct_eq_boolSum + {n : ℕ} (p q : MvPolynomial (Fin n) ℝ) + (hp : IsMultiaffine p) : + coefficientInnerProduct p q = + ∑ S : Fin n → Bool, + p.coeff (boolExponent S) * q.coeff (boolExponent S) := by + classical + let target := (Finset.univ : Finset (Fin n → Bool)).filter + (fun S ↦ boolExponent S ∈ p.support ∧ boolExponent S ∈ q.support) + have hsquarefree {d : Fin n →₀ ℕ} + (hd : d ∈ p.support.filter (· ∈ q.support)) : ∀ i, d i ≤ 1 := by + intro i + have hdp : d ∈ p.support := (Finset.mem_filter.mp hd).1 + exact (MvPolynomial.monomial_le_degreeOf i hdp).trans (hp i) + have hreindex : + (∑ d ∈ p.support.filter (· ∈ q.support), p.coeff d * q.coeff d) = + ∑ S ∈ target, p.coeff (boolExponent S) * q.coeff (boolExponent S) := by + apply Finset.sum_nbij' exponentBool boolExponent + · intro d hd + have heq := boolExponent_exponentBool d (hsquarefree hd) + have hdpair := Finset.mem_filter.mp hd + change exponentBool d ∈ target + rw [Finset.mem_filter] + exact ⟨Finset.mem_univ _, by simpa [heq] using hdpair⟩ + · intro S hS + have hpair := (Finset.mem_filter.mp hS).2 + exact Finset.mem_filter.mpr hpair + · intro d hd + exact boolExponent_exponentBool d (hsquarefree hd) + · intro S hS + exact exponentBool_boolExponent S + · intro d hd + rw [boolExponent_exponentBool d (hsquarefree hd)] + have htarget : + (∑ S ∈ target, p.coeff (boolExponent S) * q.coeff (boolExponent S)) = + ∑ S, p.coeff (boolExponent S) * q.coeff (boolExponent S) := by + dsimp only [target] + rw [Finset.sum_filter] + apply Finset.sum_congr rfl + intro S hS + by_cases hpS : boolExponent S ∈ p.support + · by_cases hqS : boolExponent S ∈ q.support + · simp [hpS, hqS] + · have hqzero : q.coeff (boolExponent S) = 0 := + MvPolynomial.notMem_support_iff.mp hqS + simp [hpS, hqS, hqzero] + · have hpzero : p.coeff (boolExponent S) = 0 := + MvPolynomial.notMem_support_iff.mp hpS + simp [hpS, hpzero] + unfold coefficientInnerProduct + convert hreindex.trans htarget using 1 + apply Finset.sum_congr + · ext d + simp + · intro d hd + rfl + +theorem coefficientPairTable_diagonalSum + {n : ℕ} (p q : MvPolynomial (Fin n) ℝ) (hp : IsMultiaffine p) : + pairTableDiagonalSum n (coefficientPairTable p q) = + coefficientInnerProduct p q := by + rw [pairTableDiagonalSum_eq_boolSum, + coefficientInnerProduct_eq_boolSum p q hp] + rfl + +theorem pairTableBoundary_eq_stableBoundaryFactor : + ∀ {n : ℕ} (α : Fin n → ℝ), + pairTableBoundary n α = stableBoundaryFactor α := by + intro n + induction n with + | zero => + intro α + simp [pairTableBoundary, stableBoundaryFactor] + | succ n ih => + intro α + simp only [pairTableBoundary] + have hdef : stableBoundaryFactor α = + ∏ i, α i ^ α i * (1 - α i) ^ (1 - α i) := rfl + rw [hdef, Fin.prod_univ_succ, ih] + have htaildef : stableBoundaryFactor (fun i : Fin n ↦ α i.succ) = + ∏ i : Fin n, α i.succ ^ α i.succ * + (1 - α i.succ) ^ (1 - α i.succ) := rfl + rw [htaildef] + rfl + +theorem pairTableMonomial_eq_realMonomial : + ∀ {n : ℕ} (x α : Fin n → ℝ), + pairTableMonomial n x α = realMonomial x α := by + intro n + induction n with + | zero => + intro x α + simp [pairTableMonomial, realMonomial] + | succ n ih => + intro x α + simp only [pairTableMonomial] + have hdef : realMonomial x α = ∏ i, x i ^ α i := rfl + rw [hdef, Fin.prod_univ_succ, ih] + have htaildef : realMonomial (fun i : Fin n ↦ x i.succ) + (fun i : Fin n ↦ α i.succ) = ∏ i : Fin n, x i.succ ^ α i.succ := rfl + rw [htaildef] + +/-- The stable-coefficient inequality on the canonical finite coordinate type. +The source theorem assumes homogeneity and a prescribed total degree, but the +coefficient-table proof only needs nonnegative coefficients, multiaffinity, +stability, and `α ∈ [0,1]^n`; we record the stronger statement exposed by the +formal proof. -/ +theorem stableCoefficient_fin + {n : ℕ} (p q : MvPolynomial (Fin n) ℝ) (α : Fin n → ℝ) + (hpNonneg : HasNonnegativeCoefficients p) + (hqNonneg : HasNonnegativeCoefficients q) + (hpMulti : IsMultiaffine p) (hqMulti : IsMultiaffine q) + (hpStable : IsRealStable p) (hqStable : IsRealStable q) + (hα : ∀ i, 0 ≤ α i ∧ α i ≤ 1) : + stableBoundaryFactor α * + polynomialCapacity α p * polynomialCapacity α q ≤ + coefficientInnerProduct p q := by + have hboundary : 0 ≤ stableBoundaryFactor α := by + rw [← pairTableBoundary_eq_stableBoundaryFactor α] + exact pairTableBoundary_nonnegative hα + have hcapP : 0 ≤ polynomialCapacity α p := + polynomialCapacity_nonneg hpNonneg α + have hcapQ : 0 ≤ polynomialCapacity α q := + polynomialCapacity_nonneg hqNonneg α + refine le_of_forall_pos_le_add fun ε hε ↦ ?_ + obtain ⟨y, z, hy, hz, hwitness⟩ := + pairTable_stableCoefficient_witness + (coefficientPairTable p q) α + (coefficientPairTable_nonnegative hpNonneg hqNonneg) + (Or.inr (coefficientPairTable_stable hpMulti hqMulti hpStable hqStable)) + hα ε hε + have hmy : 0 < realMonomial y α := realMonomial_pos hy α + have hmz : 0 < realMonomial z α := realMonomial_pos hz α + let rp := p.eval y / realMonomial y α + let rq := q.eval z / realMonomial z α + have hrp : 0 ≤ rp := by + dsimp [rp] + exact div_nonneg + (eval_nonneg_of_nonnegativeCoefficients hpNonneg (fun i ↦ (hy i).le)) + hmy.le + have hrq : 0 ≤ rq := by + dsimp [rq] + exact div_nonneg + (eval_nonneg_of_nonnegativeCoefficients hqNonneg (fun i ↦ (hz i).le)) + hmz.le + have hcaps : + polynomialCapacity α p * polynomialCapacity α q ≤ rp * rq := by + exact mul_le_mul + (polynomialCapacity_le_ratio hpNonneg α y hy) + (polynomialCapacity_le_ratio hqNonneg α z hz) + hcapQ hrp + have hscaled := mul_le_mul_of_nonneg_left hcaps hboundary + calc + stableBoundaryFactor α * polynomialCapacity α p * + polynomialCapacity α q = + stableBoundaryFactor α * + (polynomialCapacity α p * polynomialCapacity α q) := by ring + _ ≤ stableBoundaryFactor α * (rp * rq) := hscaled + _ = stableBoundaryFactor α * + ((p.eval y * q.eval z) / + (realMonomial y α * realMonomial z α)) := by + dsimp [rp, rq] + field_simp [hmy.ne', hmz.ne'] + _ = pairTableBoundary n α * + (pairTableEval n (coefficientPairTable p q) y z / + (pairTableMonomial n y α * pairTableMonomial n z α)) := by + rw [pairTableBoundary_eq_stableBoundaryFactor, + coefficientPairTable_eval p q hpMulti hqMulti, + pairTableMonomial_eq_realMonomial, + pairTableMonomial_eq_realMonomial] + _ ≤ pairTableDiagonalSum n (coefficientPairTable p q) + ε := hwitness + _ = coefficientInnerProduct p q + ε := by + rw [coefficientPairTable_diagonalSum p q hpMulti] + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/SourceStableInduction.lean b/LeanPool/BeyondBethe/BeyondBethe/SourceStableInduction.lean new file mode 100644 index 0000000000..6edc426702 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/SourceStableInduction.lean @@ -0,0 +1,227 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.SourceStableSlice +import Mathlib.Tactic + +/-! # Source Stable Induction -/ + +namespace BeyondBethe + +/-! +# The multilinear stable-coefficient induction + +This is the source proof after its analytic content has been isolated. At +each step we contract the equal left--right coefficient, use stability of the +contraction for the induction hypothesis, and use the bivariate Rayleigh +inequality for the next pair of positive evaluation points. +-/ + +theorem pairTableBoundary_nonnegative : + ∀ {n : ℕ} {α : Fin n → ℝ}, + (∀ i, 0 ≤ α i ∧ α i ≤ 1) → 0 ≤ pairTableBoundary n α := by + intro n + induction n with + | zero => intro α hα; norm_num [pairTableBoundary] + | succ n ih => + intro α hα + simp only [pairTableBoundary] + apply mul_nonneg + · rw [stableBoundaryScalar] + exact mul_nonneg (Real.rpow_nonneg (hα 0).1 _) + (Real.rpow_nonneg (sub_nonneg.mpr (hα 0).2) _) + · exact ih (fun i ↦ hα i.succ) + +theorem pairTableMonomial_pos : + ∀ {n : ℕ} {x α : Fin n → ℝ}, + (∀ i, 0 < x i) → 0 < pairTableMonomial n x α := by + intro n + induction n with + | zero => intro x α hx; norm_num [pairTableMonomial] + | succ n ih => + intro x α hx + simp only [pairTableMonomial] + exact mul_pos (Real.rpow_pos_of_pos (hx 0) _) (ih (fun i ↦ hx i.succ)) + +theorem pairTableEval_eq_zero_of_stablePolynomial_eq_zero + {n : ℕ} {c : PairTable n} + (hzero : pairTableStablePolynomial n c = 0) + (y z : Fin n → ℝ) : pairTableEval n c y z = 0 := by + have heval := pairTableStablePolynomial_eval_signed n c y z + rw [hzero] at heval + simp only [map_zero] at heval + exact_mod_cast heval.symm + +theorem pairTableDiagonalSum_nonnegative + {n : ℕ} {c : PairTable n} (hc : PairTableNonnegative c) : + 0 ≤ pairTableDiagonalSum n c := by + induction n with + | zero => exact hc _ _ + | succ n ih => + simp only [pairTableDiagonalSum] + exact add_nonneg + (ih (pairTableSection_nonnegative hc false false)) + (ih (pairTableSection_nonnegative hc true true)) + +theorem pairTableEval_contract + {n : ℕ} (c : PairTable (n + 1)) (y z : Fin n → ℝ) : + pairTableEval n (pairTableContract c) y z = + pairTableEval n (pairTableSection c false false) y z + + pairTableEval n (pairTableSection c true true) y z := by + rw [pairTableContract, pairTableEval_add] + +theorem pairTableDiagonalSum_contract + {n : ℕ} (c : PairTable (n + 1)) : + pairTableDiagonalSum n (pairTableContract c) = + pairTableDiagonalSum (n + 1) c := by + rw [pairTableContract, pairTableDiagonalSum_add] + rfl + +/-- Approximate-attainment form of the stable-coefficient inequality. This +is stronger than the capacity statement needed later and avoids assuming that +an infimum is attained. -/ +theorem pairTable_stableCoefficient_witness : + ∀ {n : ℕ} (c : PairTable n) (α : Fin n → ℝ), + PairTableNonnegative c → PairTableStableOrZero c → + (∀ i, 0 ≤ α i ∧ α i ≤ 1) → + ∀ ε : ℝ, 0 < ε → + ∃ y z : Fin n → ℝ, + (∀ i, 0 < y i) ∧ (∀ i, 0 < z i) ∧ + pairTableBoundary n α * + (pairTableEval n c y z / + (pairTableMonomial n y α * pairTableMonomial n z α)) ≤ + pairTableDiagonalSum n c + ε := by + intro n + induction n with + | zero => + intro c α hc hstable hα ε hε + let y : Fin 0 → ℝ := fun i ↦ Fin.elim0 i + let z : Fin 0 → ℝ := fun i ↦ Fin.elim0 i + refine ⟨y, z, ?_, ?_, ?_⟩ + · intro i; exact Fin.elim0 i + · intro i; exact Fin.elim0 i + · simp only [pairTableBoundary, pairTableMonomial, pairTableEval, + pairTableDiagonalSum, one_mul, div_one] + linarith + | succ n ih => + intro c α hc hstable hα ε hε + rcases hstable with hzero | hstable + · let y : Fin (n + 1) → ℝ := fun _ ↦ 1 + let z : Fin (n + 1) → ℝ := fun _ ↦ 1 + refine ⟨y, z, (fun _ ↦ by norm_num [y]), (fun _ ↦ by norm_num [z]), ?_⟩ + have heval : pairTableEval (n + 1) c y z = 0 := + pairTableEval_eq_zero_of_stablePolynomial_eq_zero hzero y z + rw [heval, zero_div, mul_zero] + exact le_add_of_nonneg_right hε.le |>.trans' + (pairTableDiagonalSum_nonnegative hc) + · let αt : Fin n → ℝ := fun i ↦ α i.succ + have hαt : ∀ i, 0 ≤ αt i ∧ αt i ≤ 1 := fun i ↦ hα i.succ + have hcContract : PairTableNonnegative (pairTableContract c) := + pairTableContract_nonnegative hc + have hsContract : PairTableStableOrZero (pairTableContract c) := + pairTableContract_stableOrZero c (Or.inr hstable) + obtain ⟨yt, zt, hyt, hzt, htail⟩ := + ih (pairTableContract c) αt hcContract hsContract hαt (ε / 2) (half_pos hε) + let tailBoundary := pairTableBoundary n αt + let my := pairTableMonomial n yt αt + let mz := pairTableMonomial n zt αt + have hmy : 0 < my := pairTableMonomial_pos hyt + have hmz : 0 < mz := pairTableMonomial_pos hzt + have htailBoundary : 0 ≤ tailBoundary := pairTableBoundary_nonnegative hαt + let K := tailBoundary / (my * mz) + have hK : 0 ≤ K := div_nonneg htailBoundary (mul_pos hmy hmz).le + let δ := ε / (2 * (K + 1)) + have hδ : 0 < δ := by + dsimp [δ] + positivity + let a := pairTableEval n (pairTableSection c true true) yt zt + let b := pairTableEval n (pairTableSection c true false) yt zt + let cc := pairTableEval n (pairTableSection c false true) yt zt + let d := pairTableEval n (pairTableSection c false false) yt zt + have ha : 0 ≤ a := pairTableEval_nonnegative + (pairTableSection_nonnegative hc true true) + (fun i ↦ (hyt i).le) (fun i ↦ (hzt i).le) + have hb : 0 ≤ b := pairTableEval_nonnegative + (pairTableSection_nonnegative hc true false) + (fun i ↦ (hyt i).le) (fun i ↦ (hzt i).le) + have hcc : 0 ≤ cc := pairTableEval_nonnegative + (pairTableSection_nonnegative hc false true) + (fun i ↦ (hyt i).le) (fun i ↦ (hzt i).le) + have hd : 0 ≤ d := pairTableEval_nonnegative + (pairTableSection_nonnegative hc false false) + (fun i ↦ (hyt i).le) (fun i ↦ (hzt i).le) + have hrayleigh : b * cc ≤ a * d := by + exact pairTable_slice_rayleigh hc hstable yt zt hyt hzt + obtain ⟨Y, Z, hY, hZ, hlocal⟩ := + exists_bivariate_capacity_witness_nonnegative + (hα 0) ha hb hcc hd hrayleigh hδ + let y : Fin (n + 1) → ℝ := Fin.cases Y yt + let z : Fin (n + 1) → ℝ := Fin.cases Z zt + refine ⟨y, z, ?_, ?_, ?_⟩ + · intro i + refine Fin.cases hY (fun j ↦ ?_) i + simpa [y] using hyt j + · intro i + refine Fin.cases hZ (fun j ↦ ?_) i + simpa [z] using hzt j + · have hKδ : K * δ ≤ ε / 2 := by + dsimp [δ] + rw [← mul_div_assoc] + apply (div_le_iff₀ (by positivity : 0 < 2 * (K + 1))).2 + nlinarith + have hlocalScaled := mul_le_mul_of_nonneg_left hlocal hK + have htail' : K * (a + d) ≤ pairTableDiagonalSum (n + 1) c + ε / 2 := by + dsimp [K, a, d] + rw [add_comm, ← pairTableEval_contract, + ← pairTableDiagonalSum_contract] + change tailBoundary / (my * mz) * + pairTableEval n (pairTableContract c) yt zt ≤ + pairTableDiagonalSum n (pairTableContract c) + ε / 2 + calc + tailBoundary / (my * mz) * + pairTableEval n (pairTableContract c) yt zt = + tailBoundary * + (pairTableEval n (pairTableContract c) yt zt / (my * mz)) := by + field_simp [(mul_pos hmy hmz).ne'] + _ ≤ pairTableDiagonalSum n (pairTableContract c) + ε / 2 := by + simpa [tailBoundary, my, mz] using htail + have hcombined : + K * (stableBoundaryScalar (α 0) * + ((a * Y * Z + b * Y + cc * Z + d) / (Y * Z) ^ (α 0))) ≤ + pairTableDiagonalSum (n + 1) c + ε := by + calc + _ ≤ K * (a + d + δ) := hlocalScaled + _ = K * (a + d) + K * δ := by ring + _ ≤ (pairTableDiagonalSum (n + 1) c + ε / 2) + ε / 2 := + add_le_add htail' hKδ + _ = pairTableDiagonalSum (n + 1) c + ε := by ring + have hdenfactor : + pairTableMonomial (n + 1) y α * pairTableMonomial (n + 1) z α = + (Y * Z) ^ (α 0) * (my * mz) := by + simp only [pairTableMonomial] + change (Y ^ (α 0) * my) * (Z ^ (α 0) * mz) = _ + rw [Real.mul_rpow hY.le hZ.le] + ring + have heval : pairTableEval (n + 1) c y z = + a * Y * Z + b * Y + cc * Z + d := by + simp only [pairTableEval] + rfl + rw [pairTableBoundary, heval, hdenfactor] + dsimp [K, tailBoundary, my, mz] at hcombined + have hdenTail : 0 < my * mz := mul_pos hmy hmz + have hdenHead : 0 < (Y * Z) ^ (α 0) := + Real.rpow_pos_of_pos (mul_pos hY hZ) _ + calc + stableBoundaryScalar (α 0) * pairTableBoundary n αt * + ((a * Y * Z + b * Y + cc * Z + d) / + ((Y * Z) ^ (α 0) * (my * mz))) = + (pairTableBoundary n αt / (my * mz)) * + (stableBoundaryScalar (α 0) * + ((a * Y * Z + b * Y + cc * Z + d) / (Y * Z) ^ (α 0))) := by + field_simp [hdenTail.ne', hdenHead.ne'] + _ ≤ pairTableDiagonalSum (n + 1) c + ε := hcombined + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/SourceStableReindex.lean b/LeanPool/BeyondBethe/BeyondBethe/SourceStableReindex.lean new file mode 100644 index 0000000000..1848952da0 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/SourceStableReindex.lean @@ -0,0 +1,192 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.SourceStableEncoding +import Mathlib.Tactic + +/-! # Source Stable Reindex -/ + +open scoped BigOperators + +namespace BeyondBethe + +/-! +# Transporting the stable-coefficient theorem across finite coordinate types + +The coefficient-table induction is most naturally indexed by `Fin n`. This +file proves that all quantities in the theorem are invariant under a bijective +renaming of variables, and hence transports the result to an arbitrary finite +type. No mathematical theorem is hidden in this bookkeeping layer. +-/ + +open MvPolynomial + +theorem renameEquiv_nonnegativeCoefficients + {σ τ : Type*} (e : σ ≃ τ) {p : MvPolynomial σ ℝ} + (hp : HasNonnegativeCoefficients p) : + HasNonnegativeCoefficients (MvPolynomial.rename e p) := by + intro d + have hcoeff : + (MvPolynomial.rename e p).coeff d = + p.coeff (d.mapDomain e.symm) := by + have h := MvPolynomial.coeff_rename_mapDomain + e.symm e.symm.injective (MvPolynomial.rename e p) d + have hrename : + MvPolynomial.rename e.symm (MvPolynomial.rename e p) = p := + MvPolynomial.rename_leftInverse e.left_inv p + rw [hrename] at h + exact h.symm + rw [hcoeff] + exact hp _ + +theorem renameEquiv_multiaffine + {σ τ : Type*} (e : σ ≃ τ) {p : MvPolynomial σ ℝ} + (hp : IsMultiaffine p) : + IsMultiaffine (MvPolynomial.rename e p) := by + intro j + have hdegree := + MvPolynomial.degreeOf_rename_of_injective (R := ℝ) (p := p) + e.injective (e.symm j) + rw [e.apply_symm_apply] at hdegree + rw [hdegree] + exact hp (e.symm j) + +theorem stableBoundaryFactor_equiv + {σ τ : Type*} [Fintype σ] [Fintype τ] + (e : σ ≃ τ) (α : σ → ℝ) : + stableBoundaryFactor (fun j ↦ α (e.symm j)) = + stableBoundaryFactor α := by + unfold stableBoundaryFactor + exact e.symm.prod_comp + (fun i ↦ α i ^ α i * (1 - α i) ^ (1 - α i)) + +theorem realMonomial_equiv + {σ τ : Type*} [Fintype σ] [Fintype τ] + (e : σ ≃ τ) (z α : σ → ℝ) : + realMonomial (fun j ↦ z (e.symm j)) (fun j ↦ α (e.symm j)) = + realMonomial z α := by + unfold realMonomial + exact e.symm.prod_comp (fun i ↦ z i ^ α i) + +theorem renameEquiv_eval + {σ τ : Type*} (e : σ ≃ τ) (p : MvPolynomial σ ℝ) + (z : σ → ℝ) : + (MvPolynomial.rename e p).eval (fun j ↦ z (e.symm j)) = p.eval z := by + rw [MvPolynomial.eval_rename] + apply congrArg (fun w : σ → ℝ ↦ p.eval w) + funext i + simpa only [Function.comp_apply] using congrArg z (e.symm_apply_apply i) + +theorem polynomialCapacity_renameEquiv + {σ τ : Type*} [Fintype σ] [Fintype τ] + (e : σ ≃ τ) {p : MvPolynomial σ ℝ} + (hp : HasNonnegativeCoefficients p) (α : σ → ℝ) : + polynomialCapacity (fun j ↦ α (e.symm j)) + (MvPolynomial.rename e p) = + polynomialCapacity α p := by + let p' := MvPolynomial.rename e p + let α' : τ → ℝ := fun j ↦ α (e.symm j) + have hp' : HasNonnegativeCoefficients p' := + renameEquiv_nonnegativeCoefficients e hp + apply le_antisymm + · apply le_polynomialCapacity_of_le_ratio + intro z hz + let z' : τ → ℝ := fun j ↦ z (e.symm j) + have hz' : ∀ j, 0 < z' j := fun j ↦ hz (e.symm j) + have h := polynomialCapacity_le_ratio hp' α' z' hz' + simpa only [p', α', z', renameEquiv_eval, + realMonomial_equiv] using h + · apply le_polynomialCapacity_of_le_ratio + intro z hz + let z' : σ → ℝ := fun i ↦ z (e i) + have hz' : ∀ i, 0 < z' i := fun i ↦ hz (e i) + have h := polynomialCapacity_le_ratio hp α z' hz' + have heval : p.eval z' = p'.eval z := by + dsimp only [p', z'] + rw [MvPolynomial.eval_rename] + rfl + have hmonomial : realMonomial z' α = realMonomial z α' := by + rw [show z' = fun i ↦ z (e i) by rfl] + rw [show α = fun i ↦ α' (e i) by + funext i + simp [α']] + unfold realMonomial + exact e.prod_comp (fun j ↦ z j ^ α' j) + simpa only [heval, hmonomial] using h + +theorem coefficientInnerProduct_renameEquiv + {σ τ : Type*} (e : σ ≃ τ) (p q : MvPolynomial σ ℝ) : + coefficientInnerProduct (MvPolynomial.rename e p) + (MvPolynomial.rename e q) = + coefficientInnerProduct p q := by + classical + let E : (σ →₀ ℕ) ≃ (τ →₀ ℕ) := (Finsupp.domCongr e).toEquiv + have hE (d : σ →₀ ℕ) : E d = d.mapDomain e := by + change Finsupp.equivMapDomain e d = d.mapDomain e + exact Finsupp.equivMapDomain_eq_mapDomain e d + have hmem (d : σ →₀ ℕ) : + d ∈ p.support.filter (· ∈ q.support) ↔ + E d ∈ (MvPolynomial.rename e p).support.filter + (· ∈ (MvPolynomial.rename e q).support) := by + simp only [Finset.mem_filter] + have hpSupport := MvPolynomial.support_rename_of_injective + (p := p) e.injective + have hqSupport := MvPolynomial.support_rename_of_injective + (p := q) e.injective + rw [hpSupport, hqSupport, hE] + simp only [Finset.mem_image] + constructor + · rintro ⟨hdp, hdq⟩ + exact ⟨⟨d, hdp, rfl⟩, d, hdq, rfl⟩ + · rintro ⟨⟨a, hap, ha⟩, b, hbq, hb⟩ + have had : a = d := Finsupp.mapDomain_injective e.injective ha + have hbd : b = d := Finsupp.mapDomain_injective e.injective hb + simpa only [had, hbd] using And.intro hap hbq + have hsum : + (∑ d ∈ p.support.filter (· ∈ q.support), + p.coeff d * q.coeff d) = + ∑ d ∈ (MvPolynomial.rename e p).support.filter + (· ∈ (MvPolynomial.rename e q).support), + (MvPolynomial.rename e p).coeff d * + (MvPolynomial.rename e q).coeff d := by + apply Finset.sum_equiv E hmem + intro d hd + rw [hE] + simp only [MvPolynomial.coeff_rename_mapDomain e e.injective] + unfold coefficientInnerProduct + symm + convert hsum using 1 + +/-- The Anari--Oveis Gharan stable-coefficient inequality, reconstructed from +its bivariate analytic lemma and multilinear induction and transported from +`Fin n` to every finite coordinate type. -/ +theorem anariOveisGharanStableCoefficient : + AnariOveisGharanStableCoefficient := by + intro σ inst p q d α hpNonneg hqNonneg hpMulti hqMulti + hpStable hqStable hpHomogeneous hqHomogeneous hα hαsum + let e : σ ≃ Fin (Fintype.card σ) := Fintype.equivFin σ + let p' := MvPolynomial.rename e p + let q' := MvPolynomial.rename e q + let α' : Fin (Fintype.card σ) → ℝ := fun j ↦ α (e.symm j) + have hfin := stableCoefficient_fin p' q' α' + (renameEquiv_nonnegativeCoefficients e hpNonneg) + (renameEquiv_nonnegativeCoefficients e hqNonneg) + (renameEquiv_multiaffine e hpMulti) + (renameEquiv_multiaffine e hqMulti) + (hpStable.rename e) (hqStable.rename e) + (fun j ↦ hα (e.symm j)) + have hboundary : stableBoundaryFactor α' = stableBoundaryFactor α := + stableBoundaryFactor_equiv e α + have hcapP : polynomialCapacity α' p' = polynomialCapacity α p := + polynomialCapacity_renameEquiv e hpNonneg α + have hcapQ : polynomialCapacity α' q' = polynomialCapacity α q := + polynomialCapacity_renameEquiv e hqNonneg α + have hinner : coefficientInnerProduct p' q' = coefficientInnerProduct p q := + coefficientInnerProduct_renameEquiv e p q + rw [hboundary, hcapP, hcapQ, hinner] at hfin + exact hfin + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/SourceStableSlice.lean b/LeanPool/BeyondBethe/BeyondBethe/SourceStableSlice.lean new file mode 100644 index 0000000000..67c0c74beb --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/SourceStableSlice.lean @@ -0,0 +1,246 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.SourceStableSpecialization +import Mathlib.Tactic + +/-! # Source Stable Slice -/ + +namespace BeyondBethe + +/-! +# The stable bivariate slice of a coefficient table + +We now justify the bivariate polynomial used at one induction step. All tail +variables are placed on the real boundary, with the right variables sign +reversed. The finite closure theorem says that the resulting polynomial in +the next left--right pair is stable or zero. +-/ + +def pairVariablesSignedRealPoint : + ∀ n : ℕ, (Fin n → ℝ) → (Fin n → ℝ) → PairVariables n → ℝ + | 0, _, _, i => PEmpty.elim i + | n + 1, y, z, none => y 0 + | n + 1, y, z, some none => -z 0 + | n + 1, y, z, some (some i) => + pairVariablesSignedRealPoint n (fun j ↦ y j.succ) (fun j ↦ z j.succ) i + +theorem pairTableStablePolynomial_eval_signed : + ∀ (n : ℕ) (c : PairTable n) (y z : Fin n → ℝ), + (pairTableStablePolynomial n c).eval + (fun i ↦ (pairVariablesSignedRealPoint n y z i : ℂ)) = + (pairTableEval n c y z : ℂ) := by + intro n + induction n with + | zero => + intro c y z + simp [pairTableStablePolynomial, pairTableEval] + | succ n ih => + intro c y z + let yt : Fin n → ℝ := fun i ↦ y i.succ + let zt : Fin n → ℝ := fun i ↦ z i.succ + let w : Option (Option (PairVariables n)) → ℂ + | none => (y 0 : ℂ) + | some none => -(z 0 : ℂ) + | some (some i) => (pairVariablesSignedRealPoint n yt zt i : ℂ) + simp only [pairTableStablePolynomial, pairTableEval] + change PairVariables (n + 1) → ℂ at w + have hpoint : + (fun i ↦ (pairVariablesSignedRealPoint (n + 1) y z i : ℂ)) = w := by + funext i + change Option (Option (PairVariables n)) at i + cases i with + | none => rfl + | some i => + cases i with + | none => simp [w, pairVariablesSignedRealPoint] + | some i => rfl + rw [hpoint] + change Option (Option (PairVariables n)) → ℂ at w + change + (linearExtension + (linearExtension (pairTableStablePolynomial n (pairTableSection c false false)) + (-pairTableStablePolynomial n (pairTableSection c false true))) + (linearExtension (pairTableStablePolynomial n (pairTableSection c true false)) + (-pairTableStablePolynomial n (pairTableSection c true true)))).eval + w = _ + rw [linearExtension_eval, linearExtension_eval, linearExtension_eval] + have hcomp : + (w ∘ some) ∘ some = + fun i ↦ (pairVariablesSignedRealPoint n yt zt i : ℂ) := by + funext i + rfl + have hnone : w none = y 0 := rfl + have hsomeNone : (w ∘ some) none = -(z 0 : ℂ) := by rfl + rw [hcomp, hnone, hsomeNone] + simp only [MvPolynomial.eval_neg] + rw [ + ih (pairTableSection c false false) yt zt, + ih (pairTableSection c false true) yt zt, + ih (pairTableSection c true false) yt zt, + ih (pairTableSection c true true) yt zt] + push_cast + ring + +/-- Separate the tail variables from the next left--right pair. `false` is +the new left variable and `true` the new (sign-reversed) right variable. -/ +def pairHeadTailEquiv (n : ℕ) : + PairVariables (n + 1) ≃ PairVariables n ⊕ Bool where + toFun + | none => Sum.inr false + | some none => Sum.inr true + | some (some i) => Sum.inl i + invFun + | Sum.inr false => none + | Sum.inr true => some none + | Sum.inl i => some (some i) + left_inv x := by + change Option (Option (PairVariables n)) at x + cases x with + | none => rfl + | some x => cases x <;> rfl + right_inv x := by + cases x with + | inl x => rfl + | inr x => cases x <;> rfl + +noncomputable def pairTableHeadPolynomial + {n : ℕ} (c : PairTable (n + 1)) : + MvPolynomial (PairVariables n ⊕ Bool) ℂ := + MvPolynomial.rename (pairHeadTailEquiv n) (pairTableStablePolynomial (n + 1) c) + +theorem pairTableHeadPolynomial_multiaffine + {n : ℕ} (c : PairTable (n + 1)) : + IsComplexMultiaffine (pairTableHeadPolynomial c) := by + intro i + change MvPolynomial.degreeOf i + (MvPolynomial.rename (pairHeadTailEquiv n) + (pairTableStablePolynomial (n + 1) c)) ≤ 1 + have hdegree := MvPolynomial.degreeOf_rename_of_injective + (pairHeadTailEquiv n).injective ((pairHeadTailEquiv n).symm i) + (p := pairTableStablePolynomial (n + 1) c) + convert hdegree.trans_le + (pairTableStablePolynomial_multiaffine c ((pairHeadTailEquiv n).symm i)) using 1 + simp + +theorem pairTableHeadPolynomial_stable + {n : ℕ} {c : PairTable (n + 1)} + (hstable : IsUpperHalfPlaneStable (pairTableStablePolynomial (n + 1) c)) : + IsUpperHalfPlaneStable (pairTableHeadPolynomial c) := by + exact hstable.rename (pairHeadTailEquiv n) + +noncomputable def pairTableBivariateSlice + {n : ℕ} (c : PairTable (n + 1)) + (y z : Fin n → ℝ) : MvPolynomial Bool ℂ := + partialSpecialization (pairTableHeadPolynomial c) + (pairVariablesSignedRealPoint n y z) + +theorem pairTableBivariateSlice_eval + {n : ℕ} (c : PairTable (n + 1)) (y z : Fin n → ℝ) + (Y Z : ℂ) : + (pairTableBivariateSlice c y z).eval (fun b ↦ bif b then Z else Y) = + -(pairTableEval n (pairTableSection c true true) y z : ℂ) * Y * Z + + (pairTableEval n (pairTableSection c true false) y z : ℂ) * Y - + (pairTableEval n (pairTableSection c false true) y z : ℂ) * Z + + (pairTableEval n (pairTableSection c false false) y z : ℂ) := by + rw [pairTableBivariateSlice, partialSpecialization_eval, + pairTableHeadPolynomial, MvPolynomial.eval_rename] + let w : PairVariables (n + 1) → ℂ := + fun i ↦ Sum.elim + (fun j ↦ (pairVariablesSignedRealPoint n y z j : ℂ)) + (fun b ↦ bif b then Z else Y) (pairHeadTailEquiv n i) + change Option (Option (PairVariables n)) → ℂ at w + change (pairTableStablePolynomial (n + 1) c).eval w = _ + simp only [pairTableStablePolynomial] + change + (linearExtension + (linearExtension (pairTableStablePolynomial n (pairTableSection c false false)) + (-pairTableStablePolynomial n (pairTableSection c false true))) + (linearExtension (pairTableStablePolynomial n (pairTableSection c true false)) + (-pairTableStablePolynomial n (pairTableSection c true true)))).eval w = _ + rw [linearExtension_eval, linearExtension_eval, linearExtension_eval] + have htail : (w ∘ some) ∘ some = + fun i ↦ (pairVariablesSignedRealPoint n y z i : ℂ) := by + funext i + rfl + have hy : w none = Y := by rfl + have hz : (w ∘ some) none = Z := by rfl + rw [htail, hy, hz] + simp only [MvPolynomial.eval_neg] + rw [ + pairTableStablePolynomial_eval_signed, + pairTableStablePolynomial_eval_signed, + pairTableStablePolynomial_eval_signed, + pairTableStablePolynomial_eval_signed] + ring + +theorem pairTableBivariateSlice_stableOrZero + {n : ℕ} {c : PairTable (n + 1)} + (y z : Fin n → ℝ) + (hstable : IsUpperHalfPlaneStable (pairTableStablePolynomial (n + 1) c)) : + pairTableBivariateSlice c y z = 0 ∨ + IsUpperHalfPlaneStable (pairTableBivariateSlice c y z) := by + exact pairVariables_partialSpecialization_stableOrZero n + (pairTableHeadPolynomial c) (pairVariablesSignedRealPoint n y z) + (pairTableHeadPolynomial_multiaffine c) + (pairTableHeadPolynomial_stable hstable) + +/-- The coefficient determinant inequality for every real tail specialization. +This is the exact local consequence of stability consumed by the scalar +capacity lemma. -/ +theorem pairTable_slice_rayleigh + {n : ℕ} {c : PairTable (n + 1)} + (hc : PairTableNonnegative c) + (hstable : IsUpperHalfPlaneStable (pairTableStablePolynomial (n + 1) c)) + (y z : Fin n → ℝ) (hy : ∀ i, 0 < y i) (hz : ∀ i, 0 < z i) : + pairTableEval n (pairTableSection c true false) y z * + pairTableEval n (pairTableSection c false true) y z ≤ + pairTableEval n (pairTableSection c true true) y z * + pairTableEval n (pairTableSection c false false) y z := by + let a := pairTableEval n (pairTableSection c true true) y z + let b := pairTableEval n (pairTableSection c true false) y z + let cc := pairTableEval n (pairTableSection c false true) y z + let d := pairTableEval n (pairTableSection c false false) y z + have hy' : ∀ i, 0 ≤ y i := fun i ↦ (hy i).le + have hz' : ∀ i, 0 ≤ z i := fun i ↦ (hz i).le + have ha : 0 ≤ a := pairTableEval_nonnegative + (pairTableSection_nonnegative hc true true) hy' hz' + have hb : 0 ≤ b := pairTableEval_nonnegative + (pairTableSection_nonnegative hc true false) hy' hz' + have hcc : 0 ≤ cc := pairTableEval_nonnegative + (pairTableSection_nonnegative hc false true) hy' hz' + have hd : 0 ≤ d := pairTableEval_nonnegative + (pairTableSection_nonnegative hc false false) hy' hz' + rcases pairTableBivariateSlice_stableOrZero y z hstable with hzero | hs + · have heval : + (pairTableBivariateSlice c y z).eval + (fun q ↦ bif q then (0 : ℂ) else 1) = + (0 : MvPolynomial Bool ℂ).eval + (fun q ↦ bif q then (0 : ℂ) else 1) := by + exact congrArg + (fun p : MvPolynomial Bool ℂ ↦ + p.eval (fun q ↦ bif q then (0 : ℂ) else 1)) hzero + rw [pairTableBivariateSlice_eval] at heval + have hbzero : b = 0 := by + have hsum : (b : ℂ) + (d : ℂ) = 0 := by + simpa [a, b, cc, d] using heval + have hre := congrArg Complex.re hsum + simp only [Complex.add_re, Complex.ofReal_re, Complex.zero_re] at hre + linarith + change b * cc ≤ a * d + rw [hbzero, zero_mul] + exact mul_nonneg ha hd + · have hbistable : BivariateBistable a b cc d := by + intro Y Z hY hZ + have hne := hs (fun q ↦ bif q then Z else Y) (by + intro q + cases q with + | false => simpa using hY + | true => simpa using hZ) + simpa [a, b, cc, d, pairTableBivariateSlice_eval] using hne + exact bivariate_rayleigh_of_bistable ha hb hcc hd hbistable + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/SourceStableSpecialization.lean b/LeanPool/BeyondBethe/BeyondBethe/SourceStableSpecialization.lean new file mode 100644 index 0000000000..dd90ddc75e --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/SourceStableSpecialization.lean @@ -0,0 +1,235 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.SourceStableClosure +import LeanPool.BeyondBethe.BeyondBethe.SourceStableTable +import Mathlib.Tactic + +/-! # Source Stable Specialization -/ + +namespace BeyondBethe + +/-! +# Finite real-boundary specialization + +The source induction freezes every variable except the next left--right pair. +This file proves that operation from the one-coordinate closure theorem. The +proof keeps the two classes of variables separated by a sum type and performs +an explicit induction on the recursively finite type `PairVariables`. +-/ + +noncomputable def partialSpecialization + {κ τ : Type*} (p : MvPolynomial (κ ⊕ τ) ℂ) (x : κ → ℝ) : + MvPolynomial τ ℂ := + p.eval₂ MvPolynomial.C (Sum.elim (fun i ↦ MvPolynomial.C (x i : ℂ)) MvPolynomial.X) + +@[simp] +theorem partialSpecialization_eval + {κ τ : Type*} (p : MvPolynomial (κ ⊕ τ) ℂ) (x : κ → ℝ) + (z : τ → ℂ) : + (partialSpecialization p x).eval z = + p.eval (Sum.elim (fun i ↦ (x i : ℂ)) z) := by + change MvPolynomial.eval₂ (RingHom.id ℂ) z + (p.eval₂ MvPolynomial.C + (Sum.elim (fun i ↦ MvPolynomial.C (x i : ℂ)) MvPolynomial.X)) = _ + rw [← MvPolynomial.eval₂_assoc] + apply MvPolynomial.eval₂_congr + intro i d hi hd + cases i with + | inl i => simp + | inr i => simp + +theorem partialSpecialization_zero + {κ τ : Type*} (x : κ → ℝ) : + partialSpecialization (0 : MvPolynomial (κ ⊕ τ) ℂ) x = 0 := by + simp [partialSpecialization] + +/-- Move the distinguished `none` coordinate of `Option κ` in front of all +remaining variables. -/ +def optionSumEquiv (κ τ : Type*) : (Option κ ⊕ τ) ≃ Option (κ ⊕ τ) where + toFun + | Sum.inl none => none + | Sum.inl (some i) => some (Sum.inl i) + | Sum.inr j => some (Sum.inr j) + invFun + | none => Sum.inl none + | some (Sum.inl i) => Sum.inl (some i) + | some (Sum.inr j) => Sum.inr j + left_inv x := by cases x with + | inl x => cases x <;> rfl + | inr x => rfl + right_inv x := by cases x with + | none => rfl + | some x => cases x <;> rfl + +noncomputable def sumOptionReindex + {κ τ : Type*} (p : MvPolynomial (Option κ ⊕ τ) ℂ) : + MvPolynomial (Option (κ ⊕ τ)) ℂ := + MvPolynomial.rename (optionSumEquiv κ τ) p + +noncomputable def sumOptionSpecialization + {κ τ : Type*} (p : MvPolynomial (Option κ ⊕ τ) ℂ) (c : ℝ) : + MvPolynomial (κ ⊕ τ) ℂ := + optionConstantCoefficient (sumOptionReindex p) + + MvPolynomial.C (c : ℂ) * optionLinearCoefficient (sumOptionReindex p) + +theorem sumOptionReindex_multiaffine + {κ τ : Type*} {p : MvPolynomial (Option κ ⊕ τ) ℂ} + (hp : IsComplexMultiaffine p) : + IsComplexMultiaffine (sumOptionReindex p) := by + intro i + change MvPolynomial.degreeOf i + (MvPolynomial.rename (optionSumEquiv κ τ) p) ≤ 1 + have hdegree := MvPolynomial.degreeOf_rename_of_injective + (optionSumEquiv κ τ).injective ((optionSumEquiv κ τ).symm i) (p := p) + convert hdegree.trans_le (hp ((optionSumEquiv κ τ).symm i)) using 1 + simp + +theorem sumOptionReindex_stable + {κ τ : Type*} {p : MvPolynomial (Option κ ⊕ τ) ℂ} + (hp : IsUpperHalfPlaneStable p) : + IsUpperHalfPlaneStable (sumOptionReindex p) := by + exact hp.rename (optionSumEquiv κ τ) + +theorem sumOptionSpecialization_multiaffine + {κ τ : Type*} (p : MvPolynomial (Option κ ⊕ τ) ℂ) (c : ℝ) + (hp : IsComplexMultiaffine p) : + IsComplexMultiaffine (sumOptionSpecialization p c) := by + exact option_specialization_multiaffine (sumOptionReindex p) c + (sumOptionReindex_multiaffine hp) + +theorem sumOptionSpecialization_stableOrZero + {κ τ : Type*} [Fintype κ] [Fintype τ] + (p : MvPolynomial (Option κ ⊕ τ) ℂ) (c : ℝ) + (hmulti : IsComplexMultiaffine p) + (hstable : IsUpperHalfPlaneStable p) : + sumOptionSpecialization p c = 0 ∨ + IsUpperHalfPlaneStable (sumOptionSpecialization p c) := by + exact option_specialize_real_stableOrZero (sumOptionReindex p) c + (sumOptionReindex_multiaffine hmulti none) + (sumOptionReindex_stable hstable) + +@[simp] +theorem optionSumEquiv_apply_inl_none {κ τ : Type*} : + optionSumEquiv κ τ (Sum.inl none) = none := rfl + +@[simp] +theorem optionSumEquiv_apply_inl_some {κ τ : Type*} (i : κ) : + optionSumEquiv κ τ (Sum.inl (some i)) = some (Sum.inl i) := rfl + +@[simp] +theorem optionSumEquiv_apply_inr {κ τ : Type*} (j : τ) : + optionSumEquiv κ τ (Sum.inr j) = some (Sum.inr j) := rfl + +theorem sumOptionSpecialization_eval + {κ τ : Type*} (p : MvPolynomial (Option κ ⊕ τ) ℂ) (c : ℝ) + (hmulti : IsComplexMultiaffine p) (z : κ ⊕ τ → ℂ) : + (sumOptionSpecialization p c).eval z = + p.eval (Sum.elim (fun + | none => (c : ℂ) + | some i => z (Sum.inl i)) (fun j => z (Sum.inr j))) := by + let w : Option (κ ⊕ τ) → ℂ + | none => (c : ℂ) + | some i => z i + have hlinear := option_eq_linearExtension (sumOptionReindex p) + (sumOptionReindex_multiaffine hmulti none) + have heval : (sumOptionReindex p).eval w = + (linearExtension + (optionConstantCoefficient (sumOptionReindex p)) + (optionLinearCoefficient (sumOptionReindex p))).eval w := by + exact congrArg + (fun q : MvPolynomial (Option (κ ⊕ τ)) ℂ ↦ q.eval w) hlinear + rw [linearExtension_eval] at heval + have hwcomp : w ∘ some = z := by rfl + rw [hwcomp] at heval + calc + (sumOptionSpecialization p c).eval z = + (optionConstantCoefficient (sumOptionReindex p)).eval z + + (c : ℂ) * (optionLinearCoefficient (sumOptionReindex p)).eval z := by + simp [sumOptionSpecialization] + _ = (sumOptionReindex p).eval w := by + exact heval.symm + _ = p.eval (Sum.elim (fun + | none => (c : ℂ) + | some i => z (Sum.inl i)) (fun j => z (Sum.inr j))) := by + rw [sumOptionReindex, MvPolynomial.eval_rename] + apply congrArg (fun u ↦ p.eval u) + funext i + cases i with + | inl i => cases i <;> rfl + | inr i => rfl + +theorem partialSpecialization_option + {κ τ : Type*} (p : MvPolynomial (Option κ ⊕ τ) ℂ) + (x : Option κ → ℝ) (hmulti : IsComplexMultiaffine p) : + partialSpecialization p x = + partialSpecialization (sumOptionSpecialization p (x none)) + (fun i ↦ x (some i)) := by + apply MvPolynomial.funext + intro z + rw [partialSpecialization_eval, partialSpecialization_eval, + sumOptionSpecialization_eval _ _ hmulti] + apply congrArg (fun u ↦ p.eval u) + funext i + cases i with + | inl i => cases i <;> rfl + | inr i => rfl + +/-- Specializing the recursively finite set of `PairVariables` to real values +preserves upper-half-plane stability in the variables that remain. -/ +theorem pairVariables_partialSpecialization_stableOrZero : + ∀ (n : ℕ) {τ : Type*} [Fintype τ] + (p : MvPolynomial (PairVariables n ⊕ τ) ℂ) + (x : PairVariables n → ℝ), + IsComplexMultiaffine p → IsUpperHalfPlaneStable p → + partialSpecialization p x = 0 ∨ + IsUpperHalfPlaneStable (partialSpecialization p x) := by + intro n + induction n with + | zero => + intro τ _ p x hmulti hstable + right + intro z hz + rw [partialSpecialization_eval] + apply hstable + intro i + cases i with + | inl i => exact PEmpty.elim i + | inr i => exact hz i + | succ n ih => + intro τ _ p x hmulti hstable + change MvPolynomial (Option (Option (PairVariables n)) ⊕ τ) ℂ at p + change Option (Option (PairVariables n)) → ℝ at x + change partialSpecialization p x = 0 ∨ + IsUpperHalfPlaneStable (partialSpecialization p x) + have hfirst := sumOptionSpecialization_stableOrZero p (x none) hmulti hstable + rcases hfirst with hzero | hfirst + · left + rw [partialSpecialization_option p x hmulti, hzero, + partialSpecialization_zero] + · let p₁ := sumOptionSpecialization p (x none) + let x₁ : Option (PairVariables n) → ℝ := fun i ↦ x (some i) + have hm₁ : IsComplexMultiaffine p₁ := + sumOptionSpecialization_multiaffine p (x none) hmulti + have hsecond := sumOptionSpecialization_stableOrZero p₁ (x₁ none) hm₁ hfirst + rcases hsecond with hzero | hsecond + · left + rw [partialSpecialization_option p x hmulti] + change partialSpecialization p₁ x₁ = 0 + rw [partialSpecialization_option p₁ x₁ hm₁, hzero, + partialSpecialization_zero] + · let p₂ := sumOptionSpecialization p₁ (x₁ none) + let x₂ : PairVariables n → ℝ := fun i ↦ x₁ (some i) + have hm₂ : IsComplexMultiaffine p₂ := + sumOptionSpecialization_multiaffine p₁ (x₁ none) hm₁ + have htail := ih p₂ x₂ hm₂ hsecond + rw [partialSpecialization_option p x hmulti] + change partialSpecialization p₁ x₁ = 0 ∨ + IsUpperHalfPlaneStable (partialSpecialization p₁ x₁) + rw [partialSpecialization_option p₁ x₁ hm₁] + exact htail + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/SourceStableTable.lean b/LeanPool/BeyondBethe/BeyondBethe/SourceStableTable.lean new file mode 100644 index 0000000000..1c926da85e --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/SourceStableTable.lean @@ -0,0 +1,277 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.SourceStableClosure +import LeanPool.BeyondBethe.BeyondBethe.SourceStableBivariate +import Mathlib.Tactic + +/-! # Source Stable Table -/ + +namespace BeyondBethe + +/-! +# A coefficient-table model for the multilinear source induction + +A table records the coefficient of every pair of squarefree monomials. The +recursive variable type places the next left variable first and the next +right variable second. With this ordering, sign reversal on the right turns +one recursion step into two nested `linearExtension`s, exactly the form used +by the formal Lieb--Sokal contraction. +-/ + +abbrev PairTable (n : ℕ) := + (Fin n → Bool) → (Fin n → Bool) → ℝ + +def prependBool {n : ℕ} (b : Bool) (S : Fin n → Bool) : Fin (n + 1) → Bool := + Fin.cases b S + +def pairTableSection {n : ℕ} (c : PairTable (n + 1)) + (left right : Bool) : PairTable n := + fun S T ↦ c (prependBool left S) (prependBool right T) + +def PairVariables : ℕ → Type + | 0 => PEmpty + | n + 1 => Option (Option (PairVariables n)) + +noncomputable instance pairVariablesFintype (n : ℕ) : Fintype (PairVariables n) := by + induction n with + | zero => + change Fintype PEmpty + exact inferInstance + | succ n ih => + letI : Fintype (PairVariables n) := ih + change Fintype (Option (Option (PairVariables n))) + exact inferInstance + +noncomputable def pairTableStablePolynomial : + ∀ n : ℕ, PairTable n → MvPolynomial (PairVariables n) ℂ + | 0, c => MvPolynomial.C (c (fun i ↦ Fin.elim0 i) (fun i ↦ Fin.elim0 i) : ℂ) + | n + 1, c => + let A := pairTableStablePolynomial n (pairTableSection c true true) + let B := pairTableStablePolynomial n (pairTableSection c true false) + let C := pairTableStablePolynomial n (pairTableSection c false true) + let D := pairTableStablePolynomial n (pairTableSection c false false) + linearExtension (linearExtension D (-C)) (linearExtension B (-A)) + +def PairTableNonnegative {n : ℕ} (c : PairTable n) : Prop := + ∀ S T, 0 ≤ c S T + +def PairTableStableOrZero {n : ℕ} (c : PairTable n) : Prop := + pairTableStablePolynomial n c = 0 ∨ + IsUpperHalfPlaneStable (pairTableStablePolynomial n c) + +noncomputable def pairTableEval : + ∀ n : ℕ, PairTable n → (Fin n → ℝ) → (Fin n → ℝ) → ℝ + | 0, c, _, _ => c (fun i ↦ Fin.elim0 i) (fun i ↦ Fin.elim0 i) + | n + 1, c, y, z => + let yt : Fin n → ℝ := fun i ↦ y i.succ + let zt : Fin n → ℝ := fun i ↦ z i.succ + let a := pairTableEval n (pairTableSection c true true) yt zt + let b := pairTableEval n (pairTableSection c true false) yt zt + let cc := pairTableEval n (pairTableSection c false true) yt zt + let d := pairTableEval n (pairTableSection c false false) yt zt + a * y 0 * z 0 + b * y 0 + cc * z 0 + d + +noncomputable def pairTableDiagonalSum : ∀ n : ℕ, PairTable n → ℝ + | 0, c => c (fun i ↦ Fin.elim0 i) (fun i ↦ Fin.elim0 i) + | n + 1, c => + pairTableDiagonalSum n (pairTableSection c false false) + + pairTableDiagonalSum n (pairTableSection c true true) + +noncomputable def pairTableBoundary : ∀ n : ℕ, (Fin n → ℝ) → ℝ + | 0, _ => 1 + | n + 1, α => + stableBoundaryScalar (α 0) * pairTableBoundary n (fun i ↦ α i.succ) + +noncomputable def pairTableMonomial : + ∀ n : ℕ, (Fin n → ℝ) → (Fin n → ℝ) → ℝ + | 0, _, _ => 1 + | n + 1, x, α => + (x 0) ^ (α 0) * pairTableMonomial n (fun i ↦ x i.succ) (fun i ↦ α i.succ) + +theorem pairTableStablePolynomial_multiaffine : + ∀ {n : ℕ} (c : PairTable n), + IsComplexMultiaffine (pairTableStablePolynomial n c) := by + intro n + induction n with + | zero => + intro c i + exact PEmpty.elim i + | succ n ih => + intro c + dsimp only [pairTableStablePolynomial] + apply linearExtension_multiaffine + · apply linearExtension_multiaffine + · exact ih _ + · intro i + simpa using ih (pairTableSection c false true) i + · apply linearExtension_multiaffine + · exact ih _ + · intro i + simpa using ih (pairTableSection c true true) i + +theorem pairTableSection_nonnegative + {n : ℕ} {c : PairTable (n + 1)} (hc : PairTableNonnegative c) + (left right : Bool) : + PairTableNonnegative (pairTableSection c left right) := by + intro S T + exact hc _ _ + +def pairTableAdd {n : ℕ} (c d : PairTable n) : PairTable n := + fun S T ↦ c S T + d S T + +def pairTableContract {n : ℕ} (c : PairTable (n + 1)) : PairTable n := + pairTableAdd (pairTableSection c false false) + (pairTableSection c true true) + +theorem linearExtension_add {ι : Type*} + (g₁ f₁ g₂ f₂ : MvPolynomial ι ℂ) : + linearExtension (g₁ + g₂) (f₁ + f₂) = + linearExtension g₁ f₁ + linearExtension g₂ f₂ := by + simp only [linearExtension, map_add, mul_add] + abel + +theorem pairTableStablePolynomial_add : + ∀ {n : ℕ} (c d : PairTable n), + pairTableStablePolynomial n (pairTableAdd c d) = + pairTableStablePolynomial n c + pairTableStablePolynomial n d := by + intro n + induction n with + | zero => + intro c d + simp [pairTableStablePolynomial, pairTableAdd] + | succ n ih => + intro c d + simp only [pairTableStablePolynomial] + have hsection (l r : Bool) : + pairTableSection (pairTableAdd c d) l r = + pairTableAdd (pairTableSection c l r) (pairTableSection d l r) := by + rfl + simp_rw [hsection, ih] + simp only [neg_add_rev, add_comm, linearExtension_add] + rfl + +theorem pairTableEval_add : + ∀ {n : ℕ} (c d : PairTable n) (y z : Fin n → ℝ), + pairTableEval n (pairTableAdd c d) y z = + pairTableEval n c y z + pairTableEval n d y z := by + intro n + induction n with + | zero => + intro c d y z + simp [pairTableEval, pairTableAdd] + | succ n ih => + intro c d y z + simp only [pairTableEval] + have hsection (l r : Bool) : + pairTableSection (pairTableAdd c d) l r = + pairTableAdd (pairTableSection c l r) (pairTableSection d l r) := by + rfl + simp_rw [hsection, ih] + ring + +theorem pairTableEval_nonnegative : + ∀ {n : ℕ} {c : PairTable n} {y z : Fin n → ℝ}, + PairTableNonnegative c → + (∀ i, 0 ≤ y i) → (∀ i, 0 ≤ z i) → + 0 ≤ pairTableEval n c y z := by + intro n + induction n with + | zero => + intro c y z hc hy hz + exact hc _ _ + | succ n ih => + intro c y z hc hy hz + simp only [pairTableEval] + have hyt : ∀ i : Fin n, 0 ≤ y i.succ := fun i ↦ hy i.succ + have hzt : ∀ i : Fin n, 0 ≤ z i.succ := fun i ↦ hz i.succ + have ha := ih (pairTableSection_nonnegative hc true true) hyt hzt + have hb := ih (pairTableSection_nonnegative hc true false) hyt hzt + have hcc := ih (pairTableSection_nonnegative hc false true) hyt hzt + have hd := ih (pairTableSection_nonnegative hc false false) hyt hzt + exact add_nonneg + (add_nonneg + (add_nonneg (mul_nonneg (mul_nonneg ha (hy 0)) (hz 0)) + (mul_nonneg hb (hy 0))) + (mul_nonneg hcc (hz 0))) hd + +theorem pairTableDiagonalSum_add : + ∀ {n : ℕ} (c d : PairTable n), + pairTableDiagonalSum n (pairTableAdd c d) = + pairTableDiagonalSum n c + pairTableDiagonalSum n d := by + intro n + induction n with + | zero => + intro c d + simp [pairTableDiagonalSum, pairTableAdd] + | succ n ih => + intro c d + simp only [pairTableDiagonalSum] + have hsection (l r : Bool) : + pairTableSection (pairTableAdd c d) l r = + pairTableAdd (pairTableSection c l r) (pairTableSection d l r) := by + rfl + simp_rw [hsection, ih] + ring + +theorem pairTableContract_nonnegative + {n : ℕ} {c : PairTable (n + 1)} + (hc : PairTableNonnegative c) : + PairTableNonnegative (pairTableContract c) := by + intro S T + exact add_nonneg (hc _ _) (hc _ _) + +/-- The diagonal contraction is stable or zero. This is the exact operator +step in the Anari--Oveis Gharan induction. -/ +theorem pairTableContract_stableOrZero + {n : ℕ} (c : PairTable (n + 1)) + (hstable : PairTableStableOrZero c) : + PairTableStableOrZero (pairTableContract c) := by + let A := pairTableStablePolynomial n (pairTableSection c true true) + let B := pairTableStablePolynomial n (pairTableSection c true false) + let C := pairTableStablePolynomial n (pairTableSection c false true) + let D := pairTableStablePolynomial n (pairTableSection c false false) + have hcontract : + pairTableStablePolynomial n (pairTableContract c) = D + A := by + rw [pairTableContract, pairTableStablePolynomial_add] + rcases hstable with hzero | hstable + · change + linearExtension (linearExtension D (-C)) (linearExtension B (-A)) = 0 at hzero + have hout : linearExtension D (-C) = 0 := + (linearExtension_eq_zero_iff.mp (by + exact hzero)).1 + have hD : D = 0 := (linearExtension_eq_zero_iff.mp hout).1 + have hin : linearExtension B (-A) = 0 := + (linearExtension_eq_zero_iff.mp (by + exact hzero)).2 + have hA : A = 0 := by + have := (linearExtension_eq_zero_iff.mp hin).2 + simpa using this + left + rw [hcontract, hD, hA, add_zero] + · change + IsUpperHalfPlaneStable + (linearExtension (linearExtension D (-C)) (linearExtension B (-A))) at hstable + have hLS := liebSokal_linear_contraction + (linearExtension D (-C)) B (-A) (by + exact hstable) + have hrewrite : + linearExtension D (-C) - MvPolynomial.rename some (-A) = + linearExtension (D + A) (-C) := by + simp [linearExtension] + ring + rw [hrewrite] at hLS + rcases hLS with hzero | hLS + · have hDA := (linearExtension_eq_zero_iff.mp hzero).1 + left + rwa [hcontract] + · have hboundary := linearExtension_constantCoefficient_stableOrZero hLS + change pairTableStablePolynomial n (pairTableContract c) = 0 ∨ + IsUpperHalfPlaneStable (pairTableStablePolynomial n (pairTableContract c)) + rw [hcontract] + exact hboundary + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/SourceVontobel.lean b/LeanPool/BeyondBethe/BeyondBethe/SourceVontobel.lean new file mode 100644 index 0000000000..b1d2aee7d2 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/SourceVontobel.lean @@ -0,0 +1,506 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.Bethe +import Mathlib.Algebra.Order.BigOperators.Ring.Finset +import Mathlib.Analysis.Convex.Deriv + +/-! # Source Vontobel -/ + +open scoped BigOperators Topology + +namespace BeyondBethe + +/-! +# Vontobel's simplex-concavity theorem + +This file formalizes the source theorem used to prove concavity of the Bethe +objective. The algebraic core is the Hessian inequality + +`sum v_i^2 / (1 - p_i) <= sum v_i^2 / p_i` + +for a strictly positive probability vector `p` and a tangent vector `v` whose +coordinates sum to zero. This is the finite-dimensional form of the argument +in Vontobel's Theorem 20. The proof below uses weighted Cauchy--Schwarz and +also supplies the boundary control that is only sketched in the source. +-/ + +/-- Weighted Cauchy--Schwarz on the complement of one coordinate. -/ +private theorem tangent_coordinate_sq_div_complement_le + {ι : Type*} [DecidableEq ι] (s : Finset ι) + (p v : ι → ℝ) (hp : ∀ i ∈ s, 0 < p i) + (hpsum : ∑ i ∈ s, p i = 1) (hvsum : ∑ i ∈ s, v i = 0) + (i : ι) (hi : i ∈ s) (hpi : p i < 1) : + v i ^ 2 / (1 - p i) ≤ + ∑ j ∈ s.erase i, v j ^ 2 / p j := by + have hpsumErase : ∑ j ∈ s.erase i, p j = 1 - p i := by + have h := Finset.sum_erase_add s p hi + rw [hpsum] at h + linarith + have hpc : 0 < ∑ j ∈ s.erase i, p j := by + rw [hpsumErase] + exact sub_pos.mpr hpi + have hvsumErase : ∑ j ∈ s.erase i, v j = -v i := by + have h := Finset.sum_erase_add s v hi + rw [hvsum] at h + linarith + have hcs := Finset.sq_sum_div_le_sum_sq_div + (R := ℝ) (s.erase i) v + (fun j hj ↦ hp j (Finset.mem_of_mem_erase hj)) + rw [hpsumErase, hvsumErase, neg_sq] at hcs + exact hcs + +/-- The Hessian inequality behind concavity of Vontobel's simplex entropy. -/ +theorem vontobel_tangent_hessian_nonpos + {ι : Type*} [DecidableEq ι] (s : Finset ι) + (p v : ι → ℝ) (hp : ∀ i ∈ s, 0 < p i) + (hplt : ∀ i ∈ s, p i < 1) + (hpsum : ∑ i ∈ s, p i = 1) (hvsum : ∑ i ∈ s, v i = 0) : + (∑ i ∈ s, v i ^ 2 / (1 - p i)) - + ∑ i ∈ s, v i ^ 2 / p i ≤ 0 := by + have hcoord : ∀ i ∈ s, + p i * (v i ^ 2 / (1 - p i)) ≤ + p i * ∑ j ∈ s.erase i, v j ^ 2 / p j := by + intro i hi + exact mul_le_mul_of_nonneg_left + (tangent_coordinate_sq_div_complement_le s p v hp hpsum hvsum i hi (hplt i hi)) + (hp i hi).le + have hsum := Finset.sum_le_sum fun i hi ↦ hcoord i hi + have hdouble : + ∑ i ∈ s, p i * ∑ j ∈ s.erase i, v j ^ 2 / p j = + ∑ j ∈ s, (1 - p j) * (v j ^ 2 / p j) := by + classical + let a : ι → ℝ := fun j ↦ v j ^ 2 / p j + have herase : ∀ i ∈ s, ∑ j ∈ s.erase i, a j = (∑ j ∈ s, a j) - a i := by + intro i hi + have h := Finset.sum_erase_add s a hi + linarith + change (∑ i ∈ s, p i * ∑ j ∈ s.erase i, a j) = + ∑ j ∈ s, (1 - p j) * a j + calc + ∑ i ∈ s, p i * ∑ j ∈ s.erase i, a j + = ∑ i ∈ s, p i * ((∑ j ∈ s, a j) - a i) := by + apply Finset.sum_congr rfl + intro i hi + rw [herase i hi] + _ + = (∑ i ∈ s, p i) * (∑ j ∈ s, a j) - ∑ i ∈ s, p i * a i := by + simp_rw [mul_sub, Finset.sum_sub_distrib, Finset.sum_mul] + _ = (∑ j ∈ s, a j) - ∑ i ∈ s, p i * a i := by rw [hpsum, one_mul] + _ = ∑ j ∈ s, (1 - p j) * a j := by + simp_rw [sub_mul, one_mul, Finset.sum_sub_distrib] + rw [hdouble] at hsum + have hleft : + ∑ i ∈ s, v i ^ 2 / (1 - p i) = + ∑ i ∈ s, (v i ^ 2 + p i * (v i ^ 2 / (1 - p i))) := by + apply Finset.sum_congr rfl + intro i hi + have hne : 1 - p i ≠ 0 := (sub_pos.mpr (hplt i hi)).ne' + field_simp + ring + have hright : + ∑ i ∈ s, v i ^ 2 / p i = + ∑ i ∈ s, (v i ^ 2 + (1 - p i) * (v i ^ 2 / p i)) := by + apply Finset.sum_congr rfl + intro i hi + have hne : p i ≠ 0 := (hp i hi).ne' + field_simp + ring + rw [hleft, hright, Finset.sum_add_distrib, Finset.sum_add_distrib] + linarith + +/-- Vontobel's scalar entropy contribution +`-x log x + (1-x) log (1-x)`, written in a boundary-continuous form. -/ +noncomputable def vontobelEntropyTerm (x : ℝ) : ℝ := + Real.negMulLog x - Real.negMulLog (1 - x) + +/-- The entropy `S` in Vontobel's Theorem 20. -/ +noncomputable def vontobelSimplexEntropy + {ι : Type*} [Fintype ι] (p : ι → ℝ) : ℝ := + ∑ i, vontobelEntropyTerm (p i) + +/-- Affine segment between two finite vectors. -/ +def probabilitySegment + {ι : Type*} (p q : ι → ℝ) (t : ℝ) (i : ι) : ℝ := + (1 - t) * p i + t * q i + +theorem probabilitySegment_sum + {ι : Type*} [Fintype ι] {p q : ι → ℝ} + (hp : ∑ i, p i = 1) (hq : ∑ i, q i = 1) (t : ℝ) : + ∑ i, probabilitySegment p q t i = 1 := by + simp_rw [probabilitySegment, Finset.sum_add_distrib, ← Finset.mul_sum, + hp, hq] + ring + +theorem IsStrictProbabilityVector.lt_one_of_one_lt_card + {ι : Type*} [Fintype ι] [DecidableEq ι] + {p : ι → ℝ} (hp : IsStrictProbabilityVector p) + (hcard : 1 < Fintype.card ι) (i : ι) : + p i < 1 := by + obtain ⟨j, hji⟩ := Fintype.exists_ne_of_one_lt_card hcard i + rw [← hp.1.sum_eq_one] + calc + p i < p i + p j := lt_add_of_pos_right _ (hp.2 j) + _ = ∑ k ∈ ({i, j} : Finset ι), p k := by + rw [Finset.sum_pair hji.symm] + _ ≤ ∑ k, p k := Finset.sum_le_sum_of_subset_of_nonneg + (Finset.subset_univ _) (fun k _ _ ↦ hp.1.nonnegative k) + +theorem probabilitySegment_strictProbability + {ι : Type*} [Fintype ι] + {p q : ι → ℝ} (hp : IsProbabilityVector p) + (hq : IsStrictProbabilityVector q) {t : ℝ} + (ht0 : 0 < t) (ht1 : t < 1) : + IsStrictProbabilityVector (probabilitySegment p q t) := by + refine ⟨⟨?_, probabilitySegment_sum hp.sum_eq_one hq.1.sum_eq_one t⟩, ?_⟩ + · intro i + exact add_nonneg + (mul_nonneg (sub_nonneg.mpr ht1.le) (hp.nonnegative i)) + (mul_nonneg ht0.le (hq.1.nonnegative i)) + · intro i + exact add_pos_of_nonneg_of_pos + (mul_nonneg (sub_nonneg.mpr ht1.le) (hp.nonnegative i)) + (mul_pos ht0 (hq.2 i)) + +theorem hasDerivAt_probabilitySegment + {ι : Type*} (p q : ι → ℝ) (i : ι) (t : ℝ) : + HasDerivAt (fun u ↦ probabilitySegment p q u i) (q i - p i) t := by + convert! ((hasDerivAt_const t 1).sub (hasDerivAt_id t)).mul_const (p i) |>.add + ((hasDerivAt_id t).mul_const (q i)) using 1 <;> + simp [probabilitySegment] <;> ring + +private theorem hasDerivAt_vontobelEntropyTerm_segment + {ι : Type*} (p q : ι → ℝ) (i : ι) {t : ℝ} + (hpos : 0 < probabilitySegment p q t i) + (hlt : probabilitySegment p q t i < 1) : + HasDerivAt + (fun u ↦ vontobelEntropyTerm (probabilitySegment p q u i)) + ((q i - p i) * + (-Real.log (probabilitySegment p q t i) - + Real.log (1 - probabilitySegment p q t i) - 2)) t := by + let r := probabilitySegment p q t i + let v := q i - p i + have hr := hasDerivAt_probabilitySegment p q i t + have hneg : HasDerivAt + (fun u ↦ Real.negMulLog (probabilitySegment p q u i)) + ((-Real.log r - 1) * v) t := by + exact (Real.hasDerivAt_negMulLog hpos.ne').comp t hr + have hinner : HasDerivAt + (fun u ↦ 1 - probabilitySegment p q u i) (-v) t := by + convert! (hasDerivAt_const t 1).sub hr using 1 <;> simp [v] + have hcomp : HasDerivAt + (fun u ↦ Real.negMulLog (1 - probabilitySegment p q u i)) + ((-Real.log (1 - r) - 1) * (-v)) t := by + exact (Real.hasDerivAt_negMulLog (sub_pos.mpr hlt).ne').comp t hinner + change HasDerivAt + (fun u ↦ Real.negMulLog (probabilitySegment p q u i) - + Real.negMulLog (1 - probabilitySegment p q u i)) _ t + convert! hneg.sub hcomp using 1 <;> dsimp [r, v] <;> ring + +private theorem hasDerivAt_vontobelEntropyTerm_segment_deriv + {ι : Type*} (p q : ι → ℝ) (i : ι) {t : ℝ} + (hpos : 0 < probabilitySegment p q t i) + (hlt : probabilitySegment p q t i < 1) : + HasDerivAt + (fun u ↦ (q i - p i) * + (-Real.log (probabilitySegment p q u i) - + Real.log (1 - probabilitySegment p q u i) - 2)) + ((q i - p i) ^ 2 / (1 - probabilitySegment p q t i) - + (q i - p i) ^ 2 / probabilitySegment p q t i) t := by + let r := probabilitySegment p q t i + let v := q i - p i + have hr := hasDerivAt_probabilitySegment p q i t + have hlogr : HasDerivAt + (fun u ↦ Real.log (probabilitySegment p q u i)) (v / r) t := by + exact hr.log hpos.ne' + have hinner : HasDerivAt + (fun u ↦ 1 - probabilitySegment p q u i) (-v) t := by + convert! (hasDerivAt_const t 1).sub hr using 1 <;> simp [v] + have hlogc : HasDerivAt + (fun u ↦ Real.log (1 - probabilitySegment p q u i)) + ((-v) / (1 - r)) t := by + exact hinner.log (sub_pos.mpr hlt).ne' + have hsum := ((hlogr.neg.sub hlogc).sub_const 2).const_mul v + convert! hsum using 1 <;> dsimp [r, v] <;> field_simp <;> ring + +/-- Concavity along a segment whose second endpoint has full support. This +is the exact form first needed in the regularized-optimizer argument. -/ +theorem vontobelSimplexEntropy_segment_concave + {ι : Type*} [Fintype ι] [DecidableEq ι] + {p q : ι → ℝ} (hp : IsProbabilityVector p) + (hq : IsStrictProbabilityVector q) + (hcard : 1 < Fintype.card ι) : + ConcaveOn ℝ (Set.Icc (0 : ℝ) 1) + (fun t ↦ vontobelSimplexEntropy (probabilitySegment p q t)) := by + let f : ℝ → ℝ := fun t ↦ + vontobelSimplexEntropy (probabilitySegment p q t) + let f' : ℝ → ℝ := fun t ↦ ∑ i, + (q i - p i) * + (-Real.log (probabilitySegment p q t i) - + Real.log (1 - probabilitySegment p q t i) - 2) + let f'' : ℝ → ℝ := fun t ↦ ∑ i, + ((q i - p i) ^ 2 / (1 - probabilitySegment p q t i) - + (q i - p i) ^ 2 / probabilitySegment p q t i) + apply concaveOn_of_hasDerivWithinAt2_nonpos (convex_Icc 0 1) + · dsimp only [f, vontobelSimplexEntropy, vontobelEntropyTerm, + probabilitySegment] + fun_prop + · intro t ht + have ht' : t ∈ Set.Ioo (0 : ℝ) 1 := by simpa using ht + have hr := probabilitySegment_strictProbability hp hq ht'.1 ht'.2 + have hlt := hr.lt_one_of_one_lt_card hcard + apply (HasDerivAt.fun_sum fun i _ ↦ + hasDerivAt_vontobelEntropyTerm_segment p q i (hr.2 i) (hlt i)).hasDerivWithinAt + · intro t ht + have ht' : t ∈ Set.Ioo (0 : ℝ) 1 := by simpa using ht + have hr := probabilitySegment_strictProbability hp hq ht'.1 ht'.2 + have hlt := hr.lt_one_of_one_lt_card hcard + apply (HasDerivAt.fun_sum fun i _ ↦ + hasDerivAt_vontobelEntropyTerm_segment_deriv p q i (hr.2 i) (hlt i)).hasDerivWithinAt + · intro t ht + have ht' : t ∈ Set.Ioo (0 : ℝ) 1 := by simpa using ht + have hr := probabilitySegment_strictProbability hp hq ht'.1 ht'.2 + have hlt := hr.lt_one_of_one_lt_card hcard + have hsumv : ∑ i, (q i - p i) = 0 := by + rw [Finset.sum_sub_distrib, hq.1.sum_eq_one, hp.sum_eq_one] + ring + simpa [f'', Finset.sum_sub_distrib] using + vontobel_tangent_hessian_nonpos Finset.univ + (probabilitySegment p q t) (fun i ↦ q i - p i) + (fun i _ ↦ hr.2 i) (fun i _ ↦ hlt i) + (by simpa using hr.1.sum_eq_one) (by simpa using hsumv) + +@[simp] theorem probabilitySegment_zero + {ι : Type*} (p q : ι → ℝ) : + probabilitySegment p q 0 = p := by + funext i + simp [probabilitySegment] + +@[simp] theorem probabilitySegment_one + {ι : Type*} (p q : ι → ℝ) : + probabilitySegment p q 1 = q := by + funext i + simp [probabilitySegment] + +/-- Jensen form of Vontobel's entropy concavity when one endpoint has full +support. -/ +theorem vontobelSimplexEntropy_segment_lower_of_right_strict + {ι : Type*} [Fintype ι] [DecidableEq ι] + {p q : ι → ℝ} (hp : IsProbabilityVector p) + (hq : IsStrictProbabilityVector q) + (hcard : 1 < Fintype.card ι) + {t : ℝ} (ht0 : 0 ≤ t) (ht1 : t ≤ 1) : + (1 - t) * vontobelSimplexEntropy p + + t * vontobelSimplexEntropy q ≤ + vontobelSimplexEntropy (probabilitySegment p q t) := by + have hc := (vontobelSimplexEntropy_segment_concave hp hq hcard).2 + (show (0 : ℝ) ∈ Set.Icc (0 : ℝ) 1 by simp) + (show (1 : ℝ) ∈ Set.Icc (0 : ℝ) 1 by simp) + (sub_nonneg.mpr ht1) ht0 (by ring : (1 - t) + t = 1) + simpa [probabilitySegment, smul_eq_mul] using hc + +/-- The simplex entropy is continuous on the whole ambient finite-dimensional +space. In particular, its boundary convention agrees with limits from the +relative interior of the simplex. -/ +theorem continuous_vontobelSimplexEntropy + {ι : Type*} [Fintype ι] : + Continuous (vontobelSimplexEntropy : (ι → ℝ) → ℝ) := by + unfold vontobelSimplexEntropy vontobelEntropyTerm + apply continuous_finsetSum + intro i _ + fun_prop + +/-- Uniform probability vector on a nonempty finite type. -/ +noncomputable def uniformProbabilityVector + (ι : Type*) [Fintype ι] : ι → ℝ := + fun _ ↦ 1 / Fintype.card ι + +theorem uniformProbabilityVector_strict + {ι : Type*} [Fintype ι] [Nonempty ι] : + IsStrictProbabilityVector (uniformProbabilityVector ι) := by + have hcard : 0 < Fintype.card ι := Fintype.card_pos + refine ⟨⟨?_, ?_⟩, ?_⟩ + · intro i + exact div_nonneg zero_le_one (Nat.cast_nonneg _) + · simp [uniformProbabilityVector, hcard.ne'] + · intro i + exact div_pos zero_lt_one (by exact_mod_cast hcard) + +/-- Full Jensen form of Vontobel's simplex-concavity theorem. The proof +approximates the second endpoint by a full-support probability vector and +passes to the boundary using continuity. -/ +theorem vontobelSimplexEntropy_segment_lower + {ι : Type*} [Fintype ι] [DecidableEq ι] + {p q : ι → ℝ} (hp : IsProbabilityVector p) + (hq : IsProbabilityVector q) + (hcard : 1 < Fintype.card ι) + {t : ℝ} (ht0 : 0 ≤ t) (ht1 : t ≤ 1) : + (1 - t) * vontobelSimplexEntropy p + + t * vontobelSimplexEntropy q ≤ + vontobelSimplexEntropy (probabilitySegment p q t) := by + letI : Nonempty ι := Fintype.card_pos_iff.mp (by omega) + let u : ι → ℝ := uniformProbabilityVector ι + let qs : ℝ → ι → ℝ := fun δ ↦ probabilitySegment q u δ + let lhs : ℝ → ℝ := fun δ ↦ + (1 - t) * vontobelSimplexEntropy p + + t * vontobelSimplexEntropy (qs δ) + let rhs : ℝ → ℝ := fun δ ↦ + vontobelSimplexEntropy (probabilitySegment p (qs δ) t) + have hu : IsStrictProbabilityVector u := by + simpa [u] using (uniformProbabilityVector_strict (ι := ι)) + have hlhs : Continuous lhs := by + have hqs : Continuous qs := by + apply continuous_pi + intro i + dsimp [qs, probabilitySegment] + fun_prop + exact continuous_const.add + (continuous_const.mul (continuous_vontobelSimplexEntropy.comp hqs)) + have hrhs : Continuous rhs := by + have hsegment : Continuous + (fun δ ↦ probabilitySegment p (qs δ) t) := by + apply continuous_pi + intro i + dsimp [qs, probabilitySegment] + fun_prop + exact continuous_vontobelSimplexEntropy.comp hsegment + have hlhs0 : lhs 0 = + (1 - t) * vontobelSimplexEntropy p + + t * vontobelSimplexEntropy q := by + simp [lhs, qs] + have hrhs0 : rhs 0 = + vontobelSimplexEntropy (probabilitySegment p q t) := by + simp [rhs, qs] + rw [← hlhs0, ← hrhs0] + letI : Filter.NeBot (nhdsWithin (0 : ℝ) (Set.Ioi 0)) := + nhdsGT_neBot (0 : ℝ) + refine le_of_tendsto_of_tendsto (b := nhdsWithin (0 : ℝ) (Set.Ioi 0)) + (hlhs.tendsto 0 |>.mono_left nhdsWithin_le_nhds) + (hrhs.tendsto 0 |>.mono_left nhdsWithin_le_nhds) ?_ + filter_upwards [self_mem_nhdsWithin, + (eventually_lt_nhds (show (0 : ℝ) < 1 by norm_num)).filter_mono + nhdsWithin_le_nhds] with δ hδpos hδone + have hqs : IsStrictProbabilityVector (qs δ) := by + exact probabilitySegment_strictProbability hq hu hδpos hδone + exact vontobelSimplexEntropy_segment_lower_of_right_strict + hp hqs hcard ht0 ht1 + +theorem betheRowObjective_eq_linear_add_vontobelEntropy + {ι : Type*} [Fintype ι] + (A X : Matrix ι ι ℝ) (i : ι) : + betheRowObjective A X i = + (∑ j, X i j * Real.log (A i j)) + + vontobelSimplexEntropy (X i) := by + classical + simp only [betheRowObjective, vontobelSimplexEntropy, + vontobelEntropyTerm, Finset.sum_add_distrib, + Finset.sum_sub_distrib, Real.negMulLog] + have hneg : + (∑ j, -(1 - X i j) * Real.log (1 - X i j)) = + -(∑ j, (1 - X i j) * Real.log (1 - X i j)) := by + rw [← Finset.sum_neg_distrib] + apply Finset.sum_congr rfl + intro j _ + ring + rw [hneg] + ring + +/-- Matrix segment written rowwise. -/ +def betheMatrixSegment + {ι : Type*} (t : ℝ) (X Y : Matrix ι ι ℝ) : Matrix ι ι ℝ := + fun i ↦ probabilitySegment (X i) (Y i) t + +/-- Jensen inequality for the Bethe objective on the Birkhoff polytope. -/ +theorem betheObjective_segment_lower + {ι : Type*} [Fintype ι] [DecidableEq ι] + (hcard : 1 < Fintype.card ι) + (A X Y : Matrix ι ι ℝ) + (hX : IsDoublyStochastic X) (hY : IsDoublyStochastic Y) + {t : ℝ} (ht0 : 0 ≤ t) (ht1 : t ≤ 1) : + (1 - t) * betheObjective A X + t * betheObjective A Y ≤ + betheObjective A (betheMatrixSegment t X Y) := by + classical + simp_rw [betheObjective, betheRowObjective_eq_linear_add_vontobelEntropy, + Finset.mul_sum, ← Finset.sum_add_distrib] + apply Finset.sum_le_sum + intro i _ + have hentropy := vontobelSimplexEntropy_segment_lower + (hX.row_probability i) + (hY.row_probability i) hcard ht0 ht1 + have hentropy' : + (1 - t) * vontobelSimplexEntropy (X i) + + t * vontobelSimplexEntropy (Y i) ≤ + vontobelSimplexEntropy (betheMatrixSegment t X Y i) := by + simpa only [betheMatrixSegment] using hentropy + have hlinear : + (1 - t) * (∑ j, X i j * Real.log (A i j)) + + t * (∑ j, Y i j * Real.log (A i j)) = + ∑ j, betheMatrixSegment t X Y i j * Real.log (A i j) := by + rw [Finset.mul_sum, Finset.mul_sum, ← Finset.sum_add_distrib] + apply Finset.sum_congr rfl + intro j _ + simp only [betheMatrixSegment, probabilitySegment] + ring + rw [← hlinear] + linarith + +/-- The Birkhoff polytope is convex. -/ +theorem convex_doublyStochastic + {ι : Type*} [Fintype ι] : + Convex ℝ {X : Matrix ι ι ℝ | IsDoublyStochastic X} := by + rw [convex_iff_add_mem] + intro X hX Y hY a b ha hb hab + change IsDoublyStochastic + (fun i j ↦ a * X i j + b * Y i j) + refine ⟨?_, ?_, ?_⟩ + · intro i j + exact add_nonneg + (mul_nonneg ha (hX.nonnegative i j)) + (mul_nonneg hb (hY.nonnegative i j)) + · intro i + simp_rw [Finset.sum_add_distrib, ← Finset.mul_sum, + hX.row_sum, hY.row_sum] + simpa using hab + · intro j + simp_rw [Finset.sum_add_distrib, ← Finset.mul_sum, + hX.col_sum, hY.col_sum] + simpa using hab + +/-- Vontobel's full Bethe-concavity theorem, including boundary points of the +Birkhoff polytope. -/ +theorem vontobelBetheConcavity : VontobelBetheConcavity := by + intro ι _ A _hA + classical + refine ⟨convex_doublyStochastic, ?_⟩ + intro X hX Y hY a b ha hb hab + by_cases hcard : 1 < Fintype.card ι + · have hble : b ≤ 1 := by linarith + have hjensen := betheObjective_segment_lower hcard A X Y hX hY hb hble + have haeq : a = 1 - b := by linarith + rw [haeq] + have hmatrix : + (1 - b) • X + b • Y = betheMatrixSegment b X Y := by + funext i j + change (1 - b) * X i j + b * Y i j = + (1 - b) * X i j + b * Y i j + rfl + simpa [smul_eq_mul, hmatrix] using hjensen + · have hsmall : Fintype.card ι ≤ 1 := Nat.le_of_not_gt hcard + letI : Subsingleton ι := Fintype.card_le_one_iff_subsingleton.mp hsmall + have hXY : X = Y := by + ext i j + have hx := hX.row_sum i + have hy := hY.row_sum i + have huniv : (Finset.univ : Finset ι) = {j} := by + ext k + simp only [Finset.mem_univ, Finset.mem_singleton, true_iff] + exact Subsingleton.elim k j + rw [huniv] at hx hy + simpa using hx.trans hy.symm + subst Y + rw [Convex.combo_self hab, Convex.combo_self hab] + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/Stable.lean b/LeanPool/BeyondBethe/BeyondBethe/Stable.lean new file mode 100644 index 0000000000..99e7531a01 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/Stable.lean @@ -0,0 +1,120 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import Mathlib.Algebra.MvPolynomial.Eval +import Mathlib.Algebra.MvPolynomial.Degrees +import Mathlib.RingTheory.MvPolynomial.Homogeneous +import Mathlib.Analysis.Complex.Basic +import Mathlib.Analysis.SpecialFunctions.Pow.Real +import Mathlib.Tactic + +/-! # Stable -/ + +open scoped BigOperators + +namespace BeyondBethe + +open MvPolynomial + +/-- Real stability: the polynomial has no zero when every variable lies in +the open upper half-plane. -/ +def IsRealStable + {σ : Type*} (p : MvPolynomial σ ℝ) : Prop := + ∀ z : σ → ℂ, (∀ i, 0 < (z i).im) → + p.eval₂ (algebraMap ℝ ℂ) z ≠ 0 + +/-- The source literature includes the zero polynomial among the stable +polynomials. Keeping the nonzero notion above is convenient for evaluation +arguments, while this wrapper records the source convention whenever a +stability-preserving operator can annihilate its input. -/ +def IsRealStableOrZero + {σ : Type*} (p : MvPolynomial σ ℝ) : Prop := + p = 0 ∨ IsRealStable p + +def HasNonnegativeCoefficients + {σ : Type*} (p : MvPolynomial σ ℝ) : Prop := + ∀ d, 0 ≤ p.coeff d + +def IsMultiaffine + {σ : Type*} (p : MvPolynomial σ ℝ) : Prop := + ∀ i, p.degreeOf i ≤ 1 + +theorem IsRealStable.rename + {σ τ : Type*} {p : MvPolynomial σ ℝ} + (hp : IsRealStable p) (f : σ → τ) : + IsRealStable (MvPolynomial.rename f p) := by + intro z hz + rw [MvPolynomial.eval₂_rename] + exact hp (z ∘ f) (fun i ↦ hz (f i)) + +theorem IsRealStable.mul + {σ : Type*} {p q : MvPolynomial σ ℝ} + (hp : IsRealStable p) (hq : IsRealStable q) : + IsRealStable (p * q) := by + intro z hz + simp only [eval₂_mul] + exact mul_ne_zero (hp z hz) (hq z hz) + +theorem IsRealStable.isRealStableOrZero + {σ : Type*} {p : MvPolynomial σ ℝ} (hp : IsRealStable p) : + IsRealStableOrZero p := + Or.inr hp + +theorem IsRealStableOrZero.zero + {σ : Type*} : IsRealStableOrZero (0 : MvPolynomial σ ℝ) := + Or.inl rfl + +theorem IsRealStableOrZero.mul + {σ : Type*} {p q : MvPolynomial σ ℝ} + (hp : IsRealStableOrZero p) (hq : IsRealStableOrZero q) : + IsRealStableOrZero (p * q) := by + rcases hp with rfl | hp + · simp [IsRealStableOrZero] + rcases hq with rfl | hq + · simp [IsRealStableOrZero] + exact (hp.mul hq).isRealStableOrZero + +/-- `z^α` for a real exponent vector. -/ +noncomputable def realMonomial + {σ : Type*} [Fintype σ] (z α : σ → ℝ) : ℝ := + ∏ i, (z i) ^ (α i) + +/-- Capacity from paper (4). -/ +noncomputable def polynomialCapacity + {σ : Type*} [Fintype σ] + (α : σ → ℝ) (p : MvPolynomial σ ℝ) : ℝ := + sInf {v : ℝ | ∃ z : σ → ℝ, + (∀ i, 0 < z i) ∧ + v = p.eval z / realMonomial z α} + +/-- Same-squarefree-monomial coefficient pairing used in paper Theorem 3. -/ +noncomputable def coefficientInnerProduct + {σ : Type*} (p q : MvPolynomial σ ℝ) : ℝ := by + classical + exact ∑ d ∈ p.support.filter (· ∈ q.support), p.coeff d * q.coeff d + +/-- Boundary product in the multiaffine coefficient inequality. -/ +noncomputable def stableBoundaryFactor + {σ : Type*} [Fintype σ] (α : σ → ℝ) : ℝ := + ∏ i, (α i) ^ (α i) * (1 - α i) ^ (1 - α i) + +/-- Exact interface to the multiaffine coefficient theorem of +Anari--Oveis Gharan. Every hypothesis used in the paper is visible here. -/ +def AnariOveisGharanStableCoefficient : Prop := + ∀ {σ : Type*} [Fintype σ] + (p q : MvPolynomial σ ℝ) (d : ℕ) (α : σ → ℝ), + HasNonnegativeCoefficients p → + HasNonnegativeCoefficients q → + IsMultiaffine p → IsMultiaffine q → + IsRealStable p → IsRealStable q → + p.IsHomogeneous d → q.IsHomogeneous d → + (∀ i, 0 ≤ α i ∧ α i ≤ 1) → + (∑ i, α i) = d → + stableBoundaryFactor α * + polynomialCapacity α p * polynomialCapacity α q + ≤ coefficientInnerProduct p q + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/StrongEntropy.lean b/LeanPool/BeyondBethe/BeyondBethe/StrongEntropy.lean new file mode 100644 index 0000000000..b863f3e25f --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/StrongEntropy.lean @@ -0,0 +1,156 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.NumericalNearby +import Mathlib.Analysis.Convex.Strong +import Mathlib.Analysis.Convex.Deriv +import Mathlib.Tactic + +/-! # Strong Entropy -/ + +open scoped BigOperators + +namespace BeyondBethe + +/-! +# Quantitative concavity from row entropy + +The extra row-entropy regularizer is not merely strictly concave. On the +probability cube it supplies a uniform quadratic Jensen gap. This is the +bridge from objective accuracy to coordinate accuracy in the executable +optimizer. +-/ + +/-- On `[0,1]`, `x log x` is one-strongly convex. -/ +theorem strongConvexOn_mul_log_Icc : + StrongConvexOn (Set.Icc (0 : ℝ) 1) 1 + (fun x : ℝ ↦ x * Real.log x) := by + rw [strongConvexOn_iff_convex] + have hconv : ConvexOn ℝ (Set.Icc (0 : ℝ) 1) + (fun x : ℝ ↦ x * Real.log x - x ^ 2 / 2) := by + apply convexOn_of_hasDerivWithinAt2_nonneg (convex_Icc 0 1) + · exact (Real.continuous_mul_log.sub + (continuous_id.pow 2 |>.div_const 2)).continuousOn + · intro x hx + rw [interior_Icc] at hx + have hx0 : x ≠ 0 := ne_of_gt hx.1 + convert (Real.hasDerivAt_mul_log hx0).sub + ((hasDerivAt_pow 2 x).div_const 2) |>.hasDerivWithinAt using 1 <;> + ring + · intro x hx + rw [interior_Icc] at hx + have hx0 : x ≠ 0 := ne_of_gt hx.1 + convert (((hasDerivAt_const x 1).add + (Real.hasDerivAt_log hx0)).sub (hasDerivAt_id x)).hasDerivWithinAt + using 1 + · funext u + norm_num + ring + · intro x hx + rw [interior_Icc] at hx + have hxpos : 0 < x := hx.1 + have hxle : x ≤ 1 := hx.2.le + have hinv : 1 ≤ x⁻¹ := by + have hdiv : 1 ≤ 1 / x := (le_div_iff₀ hxpos).2 (by simpa using hxle) + simpa only [one_div] using hdiv + linarith + convert hconv using 1 + funext x + rw [Real.norm_eq_abs, sq_abs] + ring + +/-- Scalar quadratic Jensen bonus for `negMulLog`. -/ +theorem negMulLog_segment_gap_quadratic + {t x y : ℝ} (ht0 : 0 ≤ t) (ht1 : t ≤ 1) + (hx0 : 0 ≤ x) (hx1 : x ≤ 1) + (hy0 : 0 ≤ y) (hy1 : y ≤ 1) : + (1 - t) * Real.negMulLog x + t * Real.negMulLog y + + ((1 - t) * t / 2) * (x - y) ^ 2 ≤ + Real.negMulLog ((1 - t) * x + t * y) := by + have hstrong := strongConvexOn_mul_log_Icc.2 + (Set.mem_Icc.mpr ⟨hx0, hx1⟩) + (Set.mem_Icc.mpr ⟨hy0, hy1⟩) + (sub_nonneg.mpr ht1) ht0 (by ring : (1 - t) + t = 1) + simp only [smul_eq_mul, one_div] at hstrong + change (1 - t) * (-x * Real.log x) + t * (-y * Real.log y) + + (1 - t) * t / 2 * (x - y) ^ 2 ≤ + -((1 - t) * x + t * y) * Real.log ((1 - t) * x + t * y) + rw [Real.norm_eq_abs, sq_abs] at hstrong + linarith + +/-- Summing the scalar bonus gives a Frobenius-square Jensen gap for total +row entropy. -/ +theorem totalRowEntropy_segment_quadratic + {ι : Type*} [Fintype ι] + {t : ℝ} (ht0 : 0 ≤ t) (ht1 : t ≤ 1) + {X Y : Matrix ι ι ℝ} + (hX0 : Matrix.Nonnegative X) (hX1 : ∀ i j, X i j ≤ 1) + (hY0 : Matrix.Nonnegative Y) (hY1 : ∀ i j, Y i j ≤ 1) : + (1 - t) * totalRowEntropy X + t * totalRowEntropy Y + + ((1 - t) * t / 2) * (∑ i, ∑ j, (X i j - Y i j) ^ 2) ≤ + totalRowEntropy (matrixSegment t X Y) := by + simp only [totalRowEntropy, shannonEntropy] + rw [Finset.mul_sum, Finset.mul_sum, Finset.mul_sum] + rw [← Finset.sum_add_distrib, ← Finset.sum_add_distrib] + apply Finset.sum_le_sum + intro i _ + rw [Finset.mul_sum, Finset.mul_sum, Finset.mul_sum] + rw [← Finset.sum_add_distrib, ← Finset.sum_add_distrib] + apply Finset.sum_le_sum + intro j _ + simpa only [matrixSegment, mul_assoc] using + negMulLog_segment_gap_quadratic ht0 ht1 + (hX0 i j) (hX1 i j) (hY0 i j) (hY1 i j) + +/-- Strong-concavity form of the regularized Bethe segment inequality. -/ +theorem regularizedBetheObjective_segment_quadratic + {ι : Type*} [Fintype ι] [DecidableEq ι] + (hcard : 1 < Fintype.card ι) + {τ t : ℝ} (hτ : 0 ≤ τ) (ht0 : 0 ≤ t) (ht1 : t ≤ 1) + (A : Matrix ι ι ℝ) {X Y : Matrix ι ι ℝ} + (hX : IsDoublyStochastic X) (hY : IsDoublyStochastic Y) : + (1 - t) * regularizedBetheObjective τ A X + + t * regularizedBetheObjective τ A Y + + τ * (((1 - t) * t / 2) * + (∑ i, ∑ j, (X i j - Y i j) ^ 2)) ≤ + regularizedBetheObjective τ A (matrixSegment t X Y) := by + have hbethe := betheObjective_segment_lower hcard A X Y hX hY ht0 ht1 + have hsegment : betheMatrixSegment t X Y = matrixSegment t X Y := by + ext i j + rfl + rw [hsegment] at hbethe + have hentropy := totalRowEntropy_segment_quadratic ht0 ht1 + hX.nonnegative (fun i j ↦ hX.entry_le_one i j) + hY.nonnegative (fun i j ↦ hY.entry_le_one i j) + have hscaled := mul_le_mul_of_nonneg_left hentropy hτ + rw [regularizedBetheObjective, regularizedBetheObjective, + regularizedBetheObjective] + nlinarith + +/-- Objective suboptimality controls squared distance from any exact +regularized maximizer. The fixedValue `τ/4` comes from the midpoint case. -/ +theorem regularizedBetheMaximizer_distance_sq_le_gap + {ι : Type*} [Fintype ι] [DecidableEq ι] + (hcard : 1 < Fintype.card ι) + {τ : ℝ} (hτ : 0 ≤ τ) {A X Y : Matrix ι ι ℝ} + (hX : IsDoublyStochastic X) (hY : IsDoublyStochastic Y) + (hmax : ∀ Z, IsDoublyStochastic Z → + regularizedBetheObjective τ A Z ≤ + regularizedBetheObjective τ A X) : + (τ / 4) * (∑ i, ∑ j, (X i j - Y i j) ^ 2) ≤ + regularizedBetheObjective τ A X - + regularizedBetheObjective τ A Y := by + have hmidDS := matrixSegment_doublyStochastic + (show (0 : ℝ) ≤ 1 / 2 by norm_num) + (show (1 / 2 : ℝ) ≤ 1 by norm_num) hX hY + have hupper := hmax _ hmidDS + have hlower := regularizedBetheObjective_segment_quadratic + hcard hτ (show (0 : ℝ) ≤ 1 / 2 by norm_num) + (show (1 / 2 : ℝ) ≤ 1 by norm_num) A hX hY + norm_num at hlower + nlinarith + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/Transfer.lean b/LeanPool/BeyondBethe/BeyondBethe/Transfer.lean new file mode 100644 index 0000000000..adc2b1fe28 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/Transfer.lean @@ -0,0 +1,340 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.Entropy +import Mathlib.Analysis.SpecialFunctions.Log.Deriv +import Mathlib.Analysis.SpecialFunctions.Pow.Real +import Mathlib.Tactic + +/-! # Transfer -/ + +open scoped BigOperators + +namespace BeyondBethe + +/-- Interior probability vector. Both strict inequalities are recorded to +avoid repeatedly deriving the upper one from dimension assumptions. -/ +def IsInteriorProbabilityVector + {ι : Type*} [Fintype ι] (p : ι → ℝ) : Prop := + IsProbabilityVector p ∧ ∀ i, 0 < p i ∧ p i < 1 + +theorem IsInteriorProbabilityVector.strict + {ι : Type*} [Fintype ι] {p : ι → ℝ} + (hp : IsInteriorProbabilityVector p) : + IsStrictProbabilityVector p := + ⟨hp.1, fun i ↦ (hp.2 i).1⟩ + +/-- Second moment of a finite probability vector. -/ +noncomputable def secondMoment + {ι : Type*} [Fintype ι] (p : ι → ℝ) : ℝ := + ∑ i, (p i) ^ 2 + +theorem secondMoment_nonneg + {ι : Type*} [Fintype ι] (p : ι → ℝ) : + 0 ≤ secondMoment p := by + exact Finset.sum_nonneg fun _ _ ↦ sq_nonneg _ + +theorem secondMoment_lt_one + {ι : Type*} [Fintype ι] [DecidableEq ι] + {p : ι → ℝ} (hp : IsInteriorProbabilityVector p) : + secondMoment p < 1 := by + have huniv : (Finset.univ : Finset ι).Nonempty := by + by_contra hempty + have hsum0 : ∑ i, p i = 0 := by + rw [Finset.not_nonempty_iff_eq_empty.mp hempty] + simp + linarith [hp.1.sum_eq_one] + rw [← hp.1.sum_eq_one] + apply Finset.sum_lt_sum + · intro i _ + nlinarith [mul_nonneg (hp.1.nonnegative i) + (sub_nonneg.mpr (hp.1.le_one i))] + · obtain ⟨i, hi⟩ := huniv + refine ⟨i, hi, ?_⟩ + nlinarith [hp.2 i |>.1, hp.2 i |>.2] + +theorem coordinate_le_sqrt_secondMoment + {ι : Type*} [Fintype ι] + {p : ι → ℝ} (hp : ∀ i, 0 ≤ p i) (i : ι) : + p i ≤ Real.sqrt (secondMoment p) := by + have hs2 : (p i) ^ 2 ≤ secondMoment p := by + rw [secondMoment] + exact Finset.single_le_sum (fun j _ ↦ sq_nonneg (p j)) (Finset.mem_univ i) + exact (Real.le_sqrt (hp i) (secondMoment_nonneg p)).2 hs2 + +/-- Finite-dimensional monotonicity of `ell_p` norms in the exact form used +in the proof of paper Lemma 15. -/ +theorem sum_pow_le_sqrt_secondMoment_pow + {ι : Type*} [Fintype ι] + {p : ι → ℝ} (hp : ∀ i, 0 ≤ p i) {k : ℕ} (hk : 2 ≤ k) : + ∑ i, (p i) ^ k ≤ (Real.sqrt (secondMoment p)) ^ k := by + obtain ⟨t, rfl⟩ := Nat.exists_eq_add_of_le hk + have hcoord : ∀ i, p i ≤ Real.sqrt (secondMoment p) := + coordinate_le_sqrt_secondMoment hp + calc + ∑ i, (p i) ^ (2 + t) + = ∑ i, (p i) ^ 2 * (p i) ^ t := by + apply Finset.sum_congr rfl + intro i _ + rw [pow_add] + _ ≤ ∑ i, (p i) ^ 2 * (Real.sqrt (secondMoment p)) ^ t := by + apply Finset.sum_le_sum + intro i _ + exact mul_le_mul_of_nonneg_left + (pow_le_pow_left₀ (hp i) (hcoord i) t) (sq_nonneg (p i)) + _ = secondMoment p * (Real.sqrt (secondMoment p)) ^ t := by + rw [← Finset.sum_mul, secondMoment] + _ = (Real.sqrt (secondMoment p)) ^ (2 + t) := by + rw [pow_add, Real.sq_sqrt (secondMoment_nonneg p)] + +/-- Product of the complementary coordinates of a row. -/ +noncomputable def complementProduct + {ι : Type*} [Fintype ι] (p : ι → ℝ) : ℝ := + ∏ i, (1 - p i) + +theorem complementProduct_pos + {ι : Type*} [Fintype ι] + {p : ι → ℝ} (hp : IsInteriorProbabilityVector p) : + 0 < complementProduct p := by + rw [complementProduct] + exact Finset.prod_pos fun i _ ↦ sub_pos.mpr (hp.2 i).2 + +/-- The logarithmic estimate at the heart of the row-sum bound in paper +Lemma 15. -/ +theorem neg_log_complementProduct_le + {ι : Type*} [Fintype ι] [DecidableEq ι] + {p : ι → ℝ} (hp : IsInteriorProbabilityVector p) : + -Real.log (complementProduct p) ≤ + 1 - Real.log (1 - secondMoment p) := by + let a : ℝ := Real.sqrt (secondMoment p) + have ha0 : 0 ≤ a := Real.sqrt_nonneg _ + have ha_sq : a ^ 2 = secondMoment p := Real.sq_sqrt (secondMoment_nonneg p) + have ha1 : a < 1 := by + nlinarith [secondMoment_lt_one hp] + have hpabs : ∀ i, |p i| < 1 := by + intro i + rw [abs_of_pos (hp.2 i).1] + exact (hp.2 i).2 + have hleft : HasSum + (fun n : ℕ => ∑ i, (p i) ^ (n + 1) / ((n : ℝ) + 1)) + (∑ i, -Real.log (1 - p i)) := by + classical + have hfinite : ∀ s : Finset ι, HasSum + (fun n : ℕ => ∑ i ∈ s, (p i) ^ (n + 1) / ((n : ℝ) + 1)) + (∑ i ∈ s, -Real.log (1 - p i)) := by + intro s + induction s using Finset.induction_on with + | empty => simp + | @insert i s hi ih => + have hsingle := Real.hasSum_pow_div_log_of_abs_lt_one (hpabs i) + simpa [Finset.sum_insert hi] using hsingle.add ih + simpa using hfinite Finset.univ + have haabs : |a| < 1 := by simpa [abs_of_nonneg ha0] + have haSeries := Real.hasSum_pow_div_log_of_abs_lt_one haabs + have hpoint := hasSum_ite_eq (0 : ℕ) (1 - a) + have hright : HasSum + (fun n : ℕ => + a ^ (n + 1) / ((n : ℝ) + 1) + if n = 0 then 1 - a else 0) + (-Real.log (1 - a) + (1 - a)) := by + exact haSeries.add hpoint + have hterm : ∀ n : ℕ, + (∑ i, (p i) ^ (n + 1) / ((n : ℝ) + 1)) ≤ + a ^ (n + 1) / ((n : ℝ) + 1) + if n = 0 then 1 - a else 0 := by + intro n + cases n with + | zero => simp [hp.1.sum_eq_one] + | succ n => + have hk : 2 ≤ n.succ + 1 := by omega + have hpow := sum_pow_le_sqrt_secondMoment_pow hp.1.nonnegative hk + change (∑ i, (p i) ^ (n.succ + 1) / ((n.succ : ℝ) + 1)) ≤ _ + rw [← Finset.sum_div] + simp only [Nat.succ_ne_zero, ↓reduceIte, add_zero] + exact div_le_div_of_nonneg_right (by simpa [a] using hpow) + (by positivity) + have hseriesBound := hleft.summable.tsum_le_tsum hterm hright.summable + rw [hleft.tsum_eq, hright.tsum_eq] at hseriesBound + have halog : Real.log (1 + a) ≤ a := by + have := Real.log_le_sub_one_of_pos (by linarith : 0 < 1 + a) + linarith + have honeSub : 0 < 1 - a := sub_pos.mpr ha1 + have honeAdd : 0 < 1 + a := by linarith + have hlogFactor : + Real.log (1 - secondMoment p) = + Real.log (1 - a) + Real.log (1 + a) := by + rw [← Real.log_mul honeSub.ne' honeAdd.ne'] + congr 1 + nlinarith [ha_sq] + have hlogBound : + -Real.log (1 - a) + (1 - a) ≤ + 1 - Real.log (1 - secondMoment p) := by + rw [hlogFactor] + linarith + have hsumLog : + -Real.log (complementProduct p) = + ∑ i, -Real.log (1 - p i) := by + rw [complementProduct, Real.log_prod] + · rw [Finset.sum_neg_distrib] + · intro i _ + exact (sub_pos.mpr (hp.2 i).2).ne' + rw [hsumLog] + exact hseriesBound.trans hlogBound + +/-- Exponentiating the preceding logarithmic estimate yields the product +bound used in paper Lemma 15. -/ +theorem exp_neg_one_mul_one_sub_secondMoment_le_complementProduct + {ι : Type*} [Fintype ι] [DecidableEq ι] + {p : ι → ℝ} (hp : IsInteriorProbabilityVector p) : + Real.exp (-1) * (1 - secondMoment p) ≤ complementProduct p := by + have hd : 0 < 1 - secondMoment p := sub_pos.mpr (secondMoment_lt_one hp) + have hq : 0 < complementProduct p := complementProduct_pos hp + have hlog := neg_log_complementProduct_le hp + have hlog' : -1 + Real.log (1 - secondMoment p) ≤ + Real.log (complementProduct p) := by + linarith + have hexp := Real.exp_le_exp.mpr hlog' + rw [Real.exp_add, Real.exp_log hd, Real.exp_log hq] at hexp + exact hexp + +/-- Elementary product inequality +`1 - ∑ x_i ≤ ∏ (1 - x_i)` for nonnegative numbers with sum at most one. -/ +theorem one_sub_sum_le_prod_one_sub + {ι : Type*} [DecidableEq ι] (s : Finset ι) (x : ι → ℝ) + (hx : ∀ i ∈ s, 0 ≤ x i) (hsum : ∑ i ∈ s, x i ≤ 1) : + 1 - ∑ i ∈ s, x i ≤ ∏ i ∈ s, (1 - x i) := by + classical + induction s using Finset.induction_on with + | empty => simp + | @insert a s ha ih => + have ha0 : 0 ≤ x a := hx a (Finset.mem_insert_self a s) + have hxs : ∀ i ∈ s, 0 ≤ x i := + fun i hi ↦ hx i (Finset.mem_insert_of_mem hi) + have hs0 : 0 ≤ ∑ i ∈ s, x i := Finset.sum_nonneg hxs + have hsle : ∑ i ∈ s, x i ≤ 1 := by + rw [Finset.sum_insert ha] at hsum + linarith + have hale : x a ≤ 1 := by + rw [Finset.sum_insert ha] at hsum + linarith + have hih := ih hxs hsle + rw [Finset.sum_insert ha, Finset.prod_insert ha] + have hmul := mul_le_mul_of_nonneg_left hih (sub_nonneg.mpr hale) + nlinarith [mul_nonneg ha0 hs0] + +/-- Product of all complementary coordinates except `j`. -/ +noncomputable def productExcept + {ι : Type*} [Fintype ι] [DecidableEq ι] + (p : ι → ℝ) (j : ι) : ℝ := + ∏ k ∈ Finset.univ.erase j, (1 - p k) + +theorem self_le_productExcept + {ι : Type*} [Fintype ι] [DecidableEq ι] + {p : ι → ℝ} (hp : IsProbabilityVector p) (j : ι) : + p j ≤ productExcept p j := by + have hsum : ∑ k ∈ Finset.univ.erase j, p k = 1 - p j := by + have htotal := hp.sum_eq_one + rw [← Finset.sum_erase_add _ _ (Finset.mem_univ j)] at htotal + linarith + have hprod := one_sub_sum_le_prod_one_sub + (Finset.univ.erase j) p + (fun k _ ↦ hp.nonnegative k) + (by rw [hsum]; linarith [hp.nonnegative j]) + change 1 - ∑ k ∈ Finset.univ.erase j, p k ≤ productExcept p j at hprod + rw [hsum] at hprod + linarith + +theorem productExcept_pos + {ι : Type*} [Fintype ι] [DecidableEq ι] + {p : ι → ℝ} (hp : IsInteriorProbabilityVector p) (j : ι) : + 0 < productExcept p j := by + rw [productExcept] + exact Finset.prod_pos fun k _ ↦ sub_pos.mpr (hp.2 k).2 + +theorem complementProduct_eq_mul_productExcept + {ι : Type*} [Fintype ι] [DecidableEq ι] + (p : ι → ℝ) (j : ι) : + complementProduct p = (1 - p j) * productExcept p j := by + rw [complementProduct, productExcept] + exact (Finset.mul_prod_erase Finset.univ (fun k ↦ 1 - p k) + (Finset.mem_univ j)).symm + +/-- Transfer coordinate `U_j` from paper (37). -/ +noncomputable def transferU + {ι : Type*} [Fintype ι] [DecidableEq ι] + (τ : ℝ) (p : ι → ℝ) (j : ι) : ℝ := + (p j) ^ (1 + τ) / productExcept p j + +theorem transferU_pos + {ι : Type*} [Fintype ι] [DecidableEq ι] + {τ : ℝ} {p : ι → ℝ} (hp : IsInteriorProbabilityVector p) (j : ι) : + 0 < transferU τ p j := by + exact div_pos (Real.rpow_pos_of_pos (hp.2 j).1 _) (productExcept_pos hp j) + +theorem transferU_le_one + {ι : Type*} [Fintype ι] [DecidableEq ι] + {τ : ℝ} (hτ : 0 ≤ τ) {p : ι → ℝ} + (hp : IsInteriorProbabilityVector p) (j : ι) : + transferU τ p j ≤ 1 := by + have hpow : (p j) ^ (1 + τ) ≤ p j := by + have h := Real.rpow_le_rpow_of_exponent_ge' + (hp.1.nonnegative j) (hp.2 j).2.le (by norm_num : (0 : ℝ) ≤ 1) + (by linarith : (1 : ℝ) ≤ 1 + τ) + simpa using h + have hnum : (p j) ^ (1 + τ) ≤ productExcept p j := + hpow.trans (self_le_productExcept hp.1 j) + rw [transferU, div_le_one (productExcept_pos hp j)] + exact hnum + +theorem transferU_eq_div_complementProduct + {ι : Type*} [Fintype ι] [DecidableEq ι] + {τ : ℝ} {p : ι → ℝ} (hp : IsInteriorProbabilityVector p) (j : ι) : + transferU τ p j = + (p j) ^ (1 + τ) * (1 - p j) / complementProduct p := by + rw [transferU, complementProduct_eq_mul_productExcept p j] + field_simp [(sub_pos.mpr (hp.2 j).2).ne', (productExcept_pos hp j).ne'] + +/-- The full row-sum conclusion of paper Lemma 15. -/ +theorem sum_transferU_le_exp_one + {ι : Type*} [Fintype ι] [DecidableEq ι] + {τ : ℝ} (hτ : 0 ≤ τ) {p : ι → ℝ} + (hp : IsInteriorProbabilityVector p) : + ∑ j, transferU τ p j ≤ Real.exp 1 := by + have hq : 0 < complementProduct p := complementProduct_pos hp + have hpoint : ∀ j, + transferU τ p j ≤ p j * (1 - p j) / complementProduct p := by + intro j + rw [transferU_eq_div_complementProduct hp j] + have hpow : (p j) ^ (1 + τ) ≤ p j := by + have h := Real.rpow_le_rpow_of_exponent_ge' + (hp.1.nonnegative j) (hp.2 j).2.le (by norm_num : (0 : ℝ) ≤ 1) + (by linarith : (1 : ℝ) ≤ 1 + τ) + simpa using h + exact div_le_div_of_nonneg_right + (mul_le_mul_of_nonneg_right hpow (sub_nonneg.mpr (hp.1.le_one j))) hq.le + calc + ∑ j, transferU τ p j + ≤ ∑ j, p j * (1 - p j) / complementProduct p := + Finset.sum_le_sum fun j _ ↦ hpoint j + _ = (1 - secondMoment p) / complementProduct p := by + rw [← Finset.sum_div] + simp_rw [mul_sub, mul_one] + rw [Finset.sum_sub_distrib, hp.1.sum_eq_one, secondMoment] + simp only [pow_two] + _ ≤ Real.exp 1 := by + rw [div_le_iff₀ hq] + have hbase := + exp_neg_one_mul_one_sub_secondMoment_le_complementProduct hp + have hexppos : 0 < Real.exp 1 := Real.exp_pos 1 + have hscaled := mul_le_mul_of_nonneg_left hbase hexppos.le + have hexpinv : Real.exp 1 * Real.exp (-1) = 1 := by + rw [← Real.exp_add] + norm_num + calc + 1 - secondMoment p = + Real.exp 1 * (Real.exp (-1) * (1 - secondMoment p)) := by + rw [← mul_assoc, hexpinv, one_mul] + _ ≤ Real.exp 1 * complementProduct p := hscaled + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/TransferIdentity.lean b/LeanPool/BeyondBethe/BeyondBethe/TransferIdentity.lean new file mode 100644 index 0000000000..978006096b --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/TransferIdentity.lean @@ -0,0 +1,293 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.Transfer +import LeanPool.BeyondBethe.BeyondBethe.Slack +import Mathlib.Tactic + +/-! # Transfer Identity -/ + +open scoped BigOperators + +namespace BeyondBethe + +/-- The row contribution `h_B` used in the transfer identity. -/ +noncomputable def betheEntropyContribution + {ι : Type*} [Fintype ι] (p : ι → ℝ) : ℝ := + shannonEntropy p + ∑ j, (1 - p j) * Real.log (1 - p j) + +/-- Logarithmic form of the KKT factorization. It is the exact form needed +for the transfer identity; exponentiating the row and column potentials gives +the positive scalings in the paper. -/ +def HasLogKKT + {ι : Type*} [Fintype ι] + (τ : ℝ) (A X : Matrix ι ι ℝ) (r c : ι → ℝ) : Prop := + ∀ i j, Real.log (A i j) = r i + c j + + (1 + τ) * Real.log (X i j) + Real.log (1 - X i j) + +noncomputable def regularizedBetheCoordinate + (τ a x : ℝ) : ℝ := + x * Real.log a + Real.negMulLog x + + (1 - x) * Real.log (1 - x) + τ * Real.negMulLog x + +theorem regularizedBetheObjective_eq_sum_coordinates + {ι : Type*} [Fintype ι] (τ : ℝ) (A X : Matrix ι ι ℝ) : + regularizedBetheObjective τ A X = + ∑ i, ∑ j, regularizedBetheCoordinate τ (A i j) (X i j) := by + rw [regularizedBetheObjective, betheObjective, totalRowEntropy] + simp_rw [betheRowObjective, shannonEntropy, regularizedBetheCoordinate] + simp only [Finset.mul_sum, ← Finset.sum_add_distrib] + +theorem betheEntropyContribution_add_regularizer_eq_sum + {ι : Type*} [Fintype ι] (τ : ℝ) (P : Matrix ι ι ℝ) : + ∑ i, (betheEntropyContribution (P i) + τ * shannonEntropy (P i)) = + ∑ i, ∑ j, (Real.negMulLog (P i j) + + (1 - P i j) * Real.log (1 - P i j) + + τ * Real.negMulLog (P i j)) := by + simp_rw [betheEntropyContribution, shannonEntropy, Finset.mul_sum, + ← Finset.sum_add_distrib] + +theorem rowScore_eq_rowCorrection_add_betheEntropyContribution + {m : ℕ} (p : Fin m → ℝ) : + rowScore p = rowCorrection p + betheEntropyContribution p := by + rw [rowScore, rowCorrection, betheEntropyContribution] + ring + +/-- The upper-bound algebra in paper Lemma 16. The hypotheses name exactly +the three analytic/optimization inputs used in the paper: regularized +suboptimality, the size of the entropy regularizer, and the exact slack +decomposition. -/ +theorem global_transfer_upper_of_slack + {n : ℕ} {τ ξ E Eτ gibbsEntropy divergence slack : ℝ} + (P : Matrix (Fin n) (Fin n) ℝ) + (hEτ : Eτ ≤ E + ξ * n) + (hregularizer : τ * totalRowEntropy P ≤ ξ * n) + (hdivergence : divergence = + -gibbsEntropy + ∑ i, rowScore (P i)) + (hslack : slack = E + (∑ i, rowDeficit (P i)) + divergence) : + Eτ + ∑ i, (betheEntropyContribution (P i) + + τ * shannonEntropy (P i)) ≤ + slack + 2 * ξ * n + gibbsEntropy - n * (Real.log 2 / 2) := by + have hscore : (∑ i, rowScore (P i)) = + (∑ i, rowCorrection (P i)) + + ∑ i, betheEntropyContribution (P i) := by + simp_rw [rowScore_eq_rowCorrection_add_betheEntropyContribution] + exact Finset.sum_add_distrib + have hentropy : (∑ i, betheEntropyContribution (P i)) = + gibbsEntropy + divergence - ∑ i, rowCorrection (P i) := by + linarith + have hregularizerSum : + (∑ i, τ * shannonEntropy (P i)) = + τ * totalRowEntropy P := by + rw [totalRowEntropy, Finset.mul_sum] + have hdeficit : (∑ i, rowDeficit (P i)) = + n * (Real.log 2 / 2) - ∑ i, rowCorrection (P i) := by + simp_rw [rowDeficit, Finset.sum_sub_distrib, Finset.sum_const, + nsmul_eq_mul] + rw [Finset.card_univ, Fintype.card_fin] + rw [Finset.sum_add_distrib, hentropy, hregularizerSum] + linarith + +theorem neg_regularizedCoordinate_add_entropy + (τ a x : ℝ) : + -regularizedBetheCoordinate τ a x + + (Real.negMulLog x + (1 - x) * Real.log (1 - x) + + τ * Real.negMulLog x) = + -x * Real.log a := by + rw [regularizedBetheCoordinate] + ring + +theorem regularizedCoordinate_of_logKKT + (τ x R C : ℝ) : + x * (R + C + (1 + τ) * Real.log x + Real.log (1 - x)) + + Real.negMulLog x + (1 - x) * Real.log (1 - x) + + τ * Real.negMulLog x = + x * (R + C) + Real.log (1 - x) := by + rw [Real.negMulLog_def] + ring + +theorem rowColumnPotential_sum_eq + {ι : Type*} [Fintype ι] + {X P : Matrix ι ι ℝ} (hX : IsDoublyStochastic X) + (hP : IsDoublyStochastic P) (r c : ι → ℝ) : + (∑ i, ∑ j, X i j * (r i + c j)) = + ∑ i, ∑ j, P i j * (r i + c j) := by + have hrowX : (∑ i, ∑ j, X i j * r i) = ∑ i, r i := by + apply Finset.sum_congr rfl + intro i _ + rw [← Finset.sum_mul, hX.row_sum i, one_mul] + have hrowP : (∑ i, ∑ j, P i j * r i) = ∑ i, r i := by + apply Finset.sum_congr rfl + intro i _ + rw [← Finset.sum_mul, hP.row_sum i, one_mul] + have hcolX : (∑ i, ∑ j, X i j * c j) = ∑ j, c j := by + rw [Finset.sum_comm] + apply Finset.sum_congr rfl + intro j _ + rw [← Finset.sum_mul, hX.col_sum j, one_mul] + have hcolP : (∑ i, ∑ j, P i j * c j) = ∑ j, c j := by + rw [Finset.sum_comm] + apply Finset.sum_congr rfl + intro j _ + rw [← Finset.sum_mul, hP.col_sum j, one_mul] + simp_rw [mul_add, Finset.sum_add_distrib] + linarith + +theorem log_one_div_transferU + {ι : Type*} [Fintype ι] [DecidableEq ι] + {τ : ℝ} {p : ι → ℝ} (hp : IsInteriorProbabilityVector p) (j : ι) : + Real.log (1 / transferU τ p j) = + -(1 + τ) * Real.log (p j) - Real.log (1 - p j) + + Real.log (complementProduct p) := by + rw [transferU_eq_div_complementProduct hp j, one_div_div] + have hpPow : 0 < (p j) ^ (1 + τ) := + Real.rpow_pos_of_pos (hp.2 j).1 _ + have hcomp : 0 < 1 - p j := sub_pos.mpr (hp.2 j).2 + have hq : 0 < complementProduct p := complementProduct_pos hp + rw [Real.log_div hq.ne' (mul_ne_zero hpPow.ne' hcomp.ne'), + Real.log_mul hpPow.ne' hcomp.ne', Real.log_rpow (hp.2 j).1] + ring + +/-- Paper Lemma 16, the exact global transfer identity, assuming the KKT +equations. No optimization theorem or analytic approximation is used in +this algebraic step. -/ +theorem global_transfer_identity_of_logKKT + {n : ℕ} {τ : ℝ} {A X P : Matrix (Fin n) (Fin n) ℝ} + {r c : Fin n → ℝ} + (hX : IsDoublyStochastic X) (hP : IsDoublyStochastic P) + (hXint : ∀ i, IsInteriorProbabilityVector (X i)) + (hKKT : HasLogKKT τ A X r c) : + (regularizedBetheObjective τ A X - regularizedBetheObjective τ A P) + + ∑ i, (betheEntropyContribution (P i) + τ * shannonEntropy (P i)) = + ∑ i, ∑ j, P i j * Real.log (1 / transferU τ (X i) j) := by + unfold HasLogKKT at hKKT + have hPcancel : + -(∑ i, ∑ j, regularizedBetheCoordinate τ (A i j) (P i j)) + + ∑ i, ∑ j, (Real.negMulLog (P i j) + + (1 - P i j) * Real.log (1 - P i j) + + τ * Real.negMulLog (P i j)) = + -(∑ i, ∑ j, P i j * Real.log (A i j)) := by + calc + -(∑ i, ∑ j, regularizedBetheCoordinate τ (A i j) (P i j)) + + ∑ i, ∑ j, (Real.negMulLog (P i j) + + (1 - P i j) * Real.log (1 - P i j) + + τ * Real.negMulLog (P i j)) = + ∑ i, ∑ j, (-regularizedBetheCoordinate τ (A i j) (P i j) + + (Real.negMulLog (P i j) + + (1 - P i j) * Real.log (1 - P i j) + + τ * Real.negMulLog (P i j))) := by + simp only [Finset.sum_add_distrib, Finset.sum_neg_distrib] + _ = ∑ i, ∑ j, -(P i j * Real.log (A i j)) := by + apply Finset.sum_congr rfl + intro i _ + apply Finset.sum_congr rfl + intro j _ + rw [neg_regularizedCoordinate_add_entropy] + ring + _ = -(∑ i, ∑ j, P i j * Real.log (A i j)) := by + simp only [Finset.sum_neg_distrib] + have hcancel : + (regularizedBetheObjective τ A X - regularizedBetheObjective τ A P) + + ∑ i, (betheEntropyContribution (P i) + τ * shannonEntropy (P i)) = + regularizedBetheObjective τ A X - + ∑ i, ∑ j, P i j * Real.log (A i j) := by + rw [regularizedBetheObjective_eq_sum_coordinates, + regularizedBetheObjective_eq_sum_coordinates, + betheEntropyContribution_add_regularizer_eq_sum] + linarith + have hphiX : + regularizedBetheObjective τ A X = + (∑ i, ∑ j, X i j * (r i + c j)) + + ∑ i, ∑ j, Real.log (1 - X i j) := by + rw [regularizedBetheObjective_eq_sum_coordinates] + simp_rw [regularizedBetheCoordinate, hKKT, + regularizedCoordinate_of_logKKT] + simp only [Finset.sum_add_distrib] + have hlogAP : + (∑ i, ∑ j, P i j * Real.log (A i j)) = + (∑ i, ∑ j, P i j * (r i + c j)) + + ∑ i, ∑ j, P i j * + ((1 + τ) * Real.log (X i j) + Real.log (1 - X i j)) := by + simp_rw [hKKT] + simp only [mul_add, Finset.sum_add_distrib] + ring + have hpot := rowColumnPotential_sum_eq hX hP r c + have hq : ∀ i, + Real.log (complementProduct (X i)) = + ∑ j, Real.log (1 - X i j) := by + intro i + rw [complementProduct, Real.log_prod] + intro j _ + exact (sub_pos.mpr ((hXint i).2 j).2).ne' + have hweightedQ : + (∑ i, ∑ j, P i j * (∑ k, Real.log (1 - X i k))) = + ∑ i, ∑ k, Real.log (1 - X i k) := by + apply Finset.sum_congr rfl + intro i _ + rw [← Finset.sum_mul, hP.row_sum i, one_mul] + have hcostNeg : + (∑ i, ∑ j, P i j * + (-(1 + τ) * Real.log (X i j) - Real.log (1 - X i j))) = + -(∑ i, ∑ j, P i j * + ((1 + τ) * Real.log (X i j) + Real.log (1 - X i j))) := by + calc + (∑ i, ∑ j, P i j * + (-(1 + τ) * Real.log (X i j) - Real.log (1 - X i j))) = + ∑ i, ∑ j, -(P i j * + ((1 + τ) * Real.log (X i j) + Real.log (1 - X i j))) := by + apply Finset.sum_congr rfl + intro i _ + apply Finset.sum_congr rfl + intro j _ + ring + _ = -(∑ i, ∑ j, P i j * + ((1 + τ) * Real.log (X i j) + Real.log (1 - X i j))) := by + simp only [Finset.sum_neg_distrib] + have htransferCost : + (∑ i, ∑ j, P i j * Real.log (1 / transferU τ (X i) j)) = + -(∑ i, ∑ j, P i j * + ((1 + τ) * Real.log (X i j) + Real.log (1 - X i j))) + + ∑ i, ∑ k, Real.log (1 - X i k) := by + calc + (∑ i, ∑ j, P i j * Real.log (1 / transferU τ (X i) j)) = + ∑ i, ∑ j, P i j * + (-(1 + τ) * Real.log (X i j) - Real.log (1 - X i j) + + Real.log (complementProduct (X i))) := by + simp_rw [log_one_div_transferU (hXint _)] + _ = (∑ i, ∑ j, P i j * + (-(1 + τ) * Real.log (X i j) - Real.log (1 - X i j))) + + ∑ i, ∑ j, P i j * Real.log (complementProduct (X i)) := by + simp only [mul_add, Finset.sum_add_distrib] + _ = -(∑ i, ∑ j, P i j * + ((1 + τ) * Real.log (X i j) + Real.log (1 - X i j))) + + ∑ i, ∑ k, Real.log (1 - X i k) := by + rw [hcostNeg] + simp_rw [hq] + rw [hweightedQ] + rw [hcancel, hphiX, hlogAP, htransferCost] + linarith + +/-- Paper Lemma 16 in its upper-bound form, with the KKT and slack inputs +kept explicit. -/ +theorem global_transfer_upper_of_logKKT_and_slack + {n : ℕ} {τ ξ E gibbsEntropy divergence slack : ℝ} + {A X P : Matrix (Fin n) (Fin n) ℝ} {r c : Fin n → ℝ} + (hX : IsDoublyStochastic X) (hP : IsDoublyStochastic P) + (hXint : ∀ i, IsInteriorProbabilityVector (X i)) + (hKKT : HasLogKKT τ A X r c) + (hEτ : regularizedBetheObjective τ A X - + regularizedBetheObjective τ A P ≤ E + ξ * n) + (hregularizer : τ * totalRowEntropy P ≤ ξ * n) + (hdivergence : divergence = + -gibbsEntropy + ∑ i, rowScore (P i)) + (hslack : slack = E + (∑ i, rowDeficit (P i)) + divergence) : + ∑ i, ∑ j, P i j * Real.log (1 / transferU τ (X i) j) ≤ + slack + 2 * ξ * n + gibbsEntropy - n * (Real.log 2 / 2) := by + rw [← global_transfer_identity_of_logKKT hX hP hXint hKKT] + exact global_transfer_upper_of_slack P hEτ hregularizer + hdivergence hslack + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/WeakSeparation.lean b/LeanPool/BeyondBethe/BeyondBethe/WeakSeparation.lean new file mode 100644 index 0000000000..9e45bad774 --- /dev/null +++ b/LeanPool/BeyondBethe/BeyondBethe/WeakSeparation.lean @@ -0,0 +1,269 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.DirectedOptimizerOracle +import LeanPool.BeyondBethe.BeyondBethe.NumericalNearby +import LeanPool.BeyondBethe.BeyondBethe.NumericalPotentials +import Mathlib.Tactic + +/-! # Weak Separation -/ + +open scoped BigOperators + +namespace BeyondBethe + +/-! +# Supporting cuts in rational affine coordinates + +The affine pullback of a full matrix gradient has a four-corner formula. +Making this formula explicit avoids any appeal to an abstract adjoint and is +the algebraic core of the separation oracle. +-/ + +/-- Pull a full matrix covector back through the upper-left affine +parametrization of the Birkhoff affine hull. -/ +def affinePullbackGradient {n : ℕ} {R : Type*} [AddCommGroup R] + (G : Matrix (Fin (n + 1)) (Fin (n + 1)) R) : + Matrix (Fin n) (Fin n) R := + fun i j ↦ G i.castSucc j.castSucc - G i.castSucc (Fin.last n) - + G (Fin.last n) j.castSucc + G (Fin.last n) (Fin.last n) + +/-- Matrix pairing written as an explicit finite sum. -/ +def matrixPairing {m n : Type*} [Fintype m] [Fintype n] + {R : Type*} [Semiring R] (G D : Matrix m n R) : R := + ∑ i, ∑ j, G i j * D i j + +/-- Exact adjoint identity for the affine recovery map. -/ +theorem matrixPairing_affineMap_sub {n : ℕ} {R : Type*} [CommRing R] + (G : Matrix (Fin (n + 1)) (Fin (n + 1)) R) + (Y Z : Matrix (Fin n) (Fin n) R) : + matrixPairing G + (fun i j ↦ birkhoffAffineMap Z i j - birkhoffAffineMap Y i j) = + matrixPairing (affinePullbackGradient G) + (fun i j ↦ Z i j - Y i j) := by + simp only [matrixPairing] + have hpull : ∀ i j, + affinePullbackGradient G i j * (Z i j - Y i j) = + G i.castSucc j.castSucc * Z i j - + G i.castSucc j.castSucc * Y i j - + G i.castSucc (Fin.last n) * Z i j + + G i.castSucc (Fin.last n) * Y i j - + G (Fin.last n) j.castSucc * Z i j + + G (Fin.last n) j.castSucc * Y i j + + G (Fin.last n) (Fin.last n) * Z i j - + G (Fin.last n) (Fin.last n) * Y i j := by + intro i j + rw [affinePullbackGradient] + ring + simp_rw [hpull] + simp only [Finset.sum_add_distrib, Finset.sum_sub_distrib] + rw [Fin.sum_univ_castSucc] + simp_rw [Fin.sum_univ_castSucc] + simp only [birkhoffAffineMap_castSucc_castSucc, + birkhoffAffineMap_castSucc_last, birkhoffAffineMap_last_castSucc, + birkhoffAffineMap_last_last] + ring_nf + simp_rw [Finset.mul_sum] + simp_rw [Finset.sum_add_distrib, Finset.sum_neg_distrib] + have hcolZ : + (∑ j, ∑ i, G (Fin.last n) j.castSucc * Z i j) = + ∑ i, ∑ j, G (Fin.last n) j.castSucc * Z i j := by + exact Finset.sum_comm + have hcolY : + (∑ j, ∑ i, G (Fin.last n) j.castSucc * Y i j) = + ∑ i, ∑ j, G (Fin.last n) j.castSucc * Y i j := by + exact Finset.sum_comm + rw [hcolZ, hcolY] + repeat' first + | rw [Finset.sum_add_distrib] + | rw [Finset.sum_sub_distrib] + | rw [Finset.sum_neg_distrib] + have hupperBlock : + (∑ i, ∑ j, + (G i.castSucc j.castSucc * Z i j - + G i.castSucc j.castSucc * Y i j)) = + (∑ i, ∑ j, G i.castSucc j.castSucc * Z i j) - + ∑ i, ∑ j, G i.castSucc j.castSucc * Y i j := by + simp only [Finset.sum_sub_distrib] + rw [hupperBlock] + module + +/-- The negative regularized objective in upper-left affine coordinates. -/ +noncomputable def affineNegativeObjective {n : ℕ} + (τ : ℝ) (A : Matrix (Fin (n + 1)) (Fin (n + 1)) ℝ) + (Y : Matrix (Fin n) (Fin n) ℝ) : ℝ := + -regularizedBetheObjective τ A (birkhoffAffineMap Y) + +/-- The exact full negative gradient at a rational or real interior point. -/ +noncomputable def negativeGradientMatrix {n : ℕ} + (τ : ℝ) (A X : Matrix (Fin n) (Fin n) ℝ) : Matrix (Fin n) (Fin n) ℝ := + fun i j ↦ negativeRegularizedBetheGradientCoordinate τ (A i j) (X i j) + +theorem negativeGradientMatrix_eq_neg_gradient {n : ℕ} + (τ : ℝ) (A X : Matrix (Fin n) (Fin n) ℝ) (i j : Fin n) : + negativeGradientMatrix τ A X i j = + -regularizedBetheGradient τ A X i j := by + rw [negativeGradientMatrix, regularizedBetheGradient, + negativeRegularizedBetheGradientCoordinate_eq_neg] + +/-- Convexity gives the exact supporting-hyperplane inequality in the +explicit affine coordinates. -/ +theorem affineNegativeObjective_support + {n : ℕ} (hn : 0 < n) {τ : ℝ} (hτ : 0 ≤ τ) + {A : Matrix (Fin (n + 1)) (Fin (n + 1)) ℝ} + {Y Z : Matrix (Fin n) (Fin n) ℝ} + (hY : IsDoublyStochastic (birkhoffAffineMap Y)) + (hZ : IsDoublyStochastic (birkhoffAffineMap Z)) + (hYint : ∀ i, IsInteriorProbabilityVector (birkhoffAffineMap Y i)) : + affineNegativeObjective τ A Y + + matrixPairing + (affinePullbackGradient + (negativeGradientMatrix τ A (birkhoffAffineMap Y))) + (fun i j ↦ Z i j - Y i j) ≤ + affineNegativeObjective τ A Z := by + have hsupp := regularizedBetheObjective_sub_le_gradient + (show 1 < Fintype.card (Fin (n + 1)) by simp; omega) + (A := A) (X := birkhoffAffineMap Y) (Y := birkhoffAffineMap Z) + hτ hY hZ hYint + have hpair := matrixPairing_affineMap_sub + (negativeGradientMatrix τ A (birkhoffAffineMap Y)) Y Z + have hG : negativeGradientMatrix τ A (birkhoffAffineMap Y) = + fun i j ↦ -regularizedBetheGradient τ A (birkhoffAffineMap Y) i j := by + ext i j + exact negativeGradientMatrix_eq_neg_gradient τ A (birkhoffAffineMap Y) i j + rw [hG] at hpair ⊢ + simp only [matrixPairing, neg_mul] at hpair ⊢ + rw [← hpair] + simp_rw [Finset.sum_neg_distrib] + simp only [affineNegativeObjective] + linarith + +/-- Executable rational full-gradient lower endpoint. -/ +def directedNegativeGradientLowerMatrix {n : ℕ} + (τ : ℚ) (A X : Matrix (Fin n) (Fin n) ℚ) (p : ℕ) : + Matrix (Fin n) (Fin n) ℚ := + fun i j ↦ directedNegativeGradientLower τ (A i j) (X i j) p + +/-- Every pullback coordinate combines four full-gradient coordinates. Thus +an entrywise full-gradient error `e` becomes at most `4e`. -/ +theorem affinePullbackGradient_error_le_four + {n : ℕ} {G H : Matrix (Fin (n + 1)) (Fin (n + 1)) ℝ} {e : ℝ} + (h : ∀ i j, abs (G i j - H i j) ≤ e) (i j : Fin n) : + abs (affinePullbackGradient G i j - + affinePullbackGradient H i j) ≤ 4 * e := by + rw [affinePullbackGradient, affinePullbackGradient] + have hid : + (G i.castSucc j.castSucc - G i.castSucc (Fin.last n) - + G (Fin.last n) j.castSucc + G (Fin.last n) (Fin.last n)) - + (H i.castSucc j.castSucc - H i.castSucc (Fin.last n) - + H (Fin.last n) j.castSucc + H (Fin.last n) (Fin.last n)) = + (G i.castSucc j.castSucc - H i.castSucc j.castSucc) - + (G i.castSucc (Fin.last n) - H i.castSucc (Fin.last n)) - + (G (Fin.last n) j.castSucc - H (Fin.last n) j.castSucc) + + (G (Fin.last n) (Fin.last n) - H (Fin.last n) (Fin.last n)) := by ring + rw [hid] + exact abs_sub_sub_add_le_four + (h i.castSucc j.castSucc) (h i.castSucc (Fin.last n)) + (h (Fin.last n) j.castSucc) (h (Fin.last n) (Fin.last n)) + +/-- At precision `p`, the executable pullback gradient is within +`16·2⁻ᵖ` in every coordinate. -/ +theorem directedAffineGradient_error + {n : ℕ} {τ : ℚ} {A X : Matrix (Fin (n + 1)) (Fin (n + 1)) ℚ} + (hτ0 : 0 ≤ τ) (hτ1 : τ ≤ 1) + (hA : ∀ i j, 0 < A i j) + (hX0 : ∀ i j, 0 < X i j) (hX1 : ∀ i j, X i j < 1) + (p : ℕ) (i j : Fin n) : + abs (affinePullbackGradient + (negativeGradientMatrix (τ : ℝ) + (fun i j ↦ (A i j : ℝ)) (fun i j ↦ (X i j : ℝ))) i j - + (affinePullbackGradient + (fun i j ↦ ((directedNegativeGradientLowerMatrix τ A X p i j : ℚ) : ℝ))) i j) ≤ + 16 * (((1 / 2 : ℚ) ^ p : ℚ) : ℝ) := by + apply (affinePullbackGradient_error_le_four + (e := 4 * (((1 / 2 : ℚ) ^ p : ℚ) : ℝ)) ?_ i j).trans_eq + · ring + intro a b + have hb := directedNegativeGradient_bounds hτ0 hτ1 + (hA a b) (hX0 a b) (hX1 a b) p + have hlo := hb.1 + have hwidth := hb.2.2 + change abs (negativeRegularizedBetheGradientCoordinate + (τ : ℝ) (A a b : ℝ) (X a b : ℝ) - + (directedNegativeGradientLower τ (A a b) (X a b) p : ℝ)) ≤ _ + rw [abs_of_nonneg (sub_nonneg.mpr hlo)] + linarith [hb.2.1] + +/-- Entrywise `ℓ1` size of a matrix displacement. -/ +def matrixL1 {m n : Type*} [Fintype m] [Fintype n] + (D : Matrix m n ℝ) : ℝ := + ∑ i, ∑ j, abs (D i j) + +theorem matrixL1_nonneg {m n : Type*} [Fintype m] [Fintype n] + (D : Matrix m n ℝ) : 0 ≤ matrixL1 D := by + exact Finset.sum_nonneg fun i _ ↦ Finset.sum_nonneg fun j _ ↦ abs_nonneg _ + +/-- Coordinatewise covector error controls pairing error by the `ℓ1` size +of the displacement. -/ +theorem matrixPairing_sub_le_error_mul_l1 + {m n : Type*} [Fintype m] [Fintype n] + {G H D : Matrix m n ℝ} {e : ℝ} + (herr : ∀ i j, abs (G i j - H i j) ≤ e) : + matrixPairing G D - matrixPairing H D ≤ e * matrixL1 D := by + rw [matrixPairing, matrixPairing, matrixL1, ← Finset.sum_sub_distrib, + Finset.mul_sum] + apply Finset.sum_le_sum + intro i _ + rw [← Finset.sum_sub_distrib, Finset.mul_sum] + apply Finset.sum_le_sum + intro j _ + have hpoint : + (G i j - H i j) * D i j ≤ e * abs (D i j) := by + calc + (G i j - H i j) * D i j ≤ + abs ((G i j - H i j) * D i j) := le_abs_self _ + _ = abs (G i j - H i j) * abs (D i j) := abs_mul _ _ + _ ≤ e * abs (D i j) := + mul_le_mul_of_nonneg_right (herr i j) (abs_nonneg _) + convert hpoint using 1 <;> ring + +/-- Generic tolerant epigraph-cut lemma. It records all three losses used by +the executable oracle: a one-sided value approximation, a coordinatewise +gradient approximation, and a known `ℓ1` radius for candidate displacements. -/ +theorem approximateEpigraphCut_valid + {m n : Type*} [Fintype m] [Fintype n] + {fY fZ lower t s e Dmax : ℝ} + {G H D : Matrix m n ℝ} + (hsupport : fY + matrixPairing G D ≤ fZ) + (hlower : lower ≤ fY) + (hgradient : ∀ i j, abs (H i j - G i j) ≤ e) + (hD : matrixL1 D ≤ Dmax) + (he : 0 ≤ e) (hepigraph : fZ ≤ s) : + matrixPairing H D - (s - t) ≤ + t - lower + e * Dmax := by + have hpair := matrixPairing_sub_le_error_mul_l1 + (G := H) (H := G) (D := D) hgradient + have hscale := mul_le_mul_of_nonneg_left hD he + linarith + +/-- If the certified lower value exceeds the query height by more than the +gradient-error budget, the approximate supporting hyperplane strictly +separates the query from every epigraph point in the prescribed radius. -/ +theorem approximateEpigraphCut_strict + {m n : Type*} [Fintype m] [Fintype n] + {fY fZ lower t s e Dmax margin : ℝ} + {G H D : Matrix m n ℝ} + (hsupport : fY + matrixPairing G D ≤ fZ) + (hlower : lower ≤ fY) + (hgradient : ∀ i j, abs (H i j - G i j) ≤ e) + (hD : matrixL1 D ≤ Dmax) + (he : 0 ≤ e) (hepigraph : fZ ≤ s) + (hviolation : t - lower + e * Dmax ≤ -margin) : + matrixPairing H D - (s - t) ≤ -margin := + (approximateEpigraphCut_valid hsupport hlower hgradient hD he hepigraph).trans + hviolation + +end BeyondBethe diff --git a/LeanPool/BeyondBethe/Complexitylib.lean b/LeanPool/BeyondBethe/Complexitylib.lean new file mode 100644 index 0000000000..337fb26542 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib.lean @@ -0,0 +1,16 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.Complexitylib.Asymptotics +import LeanPool.BeyondBethe.Complexitylib.Circuits +import LeanPool.BeyondBethe.Complexitylib.Classes +import LeanPool.BeyondBethe.Complexitylib.Encoding +import LeanPool.BeyondBethe.Complexitylib.Languages +import LeanPool.BeyondBethe.Complexitylib.Mathlib +import LeanPool.BeyondBethe.Complexitylib.Models +import LeanPool.BeyondBethe.Complexitylib.SAT + +/-! Supporting modules for Beyond the Bethe approximation of the permanent. -/ diff --git a/LeanPool/BeyondBethe/Complexitylib/Asymptotics.lean b/LeanPool/BeyondBethe/Complexitylib/Asymptotics.lean new file mode 100644 index 0000000000..38905aabca --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Asymptotics.lean @@ -0,0 +1,448 @@ +/- +Copyright (c) 2025 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import Mathlib.Analysis.Asymptotics.SpecificAsymptotics +public import Mathlib.Data.Nat.Size + +/-! +# Asymptotic notation for natural number functions + +This module defines `Complexity.BigO` and `Complexity.LittleO`, thin adapters +that lift Mathlib's `Asymptotics.IsBigO` and `Asymptotics.IsLittleO` to +`ℕ → ℕ` functions (casting through `ℝ`). + +The scoped notations `f =O g` and `f =o g` are available when `Complexity` is +opened and read like standard complexity-theoretic asymptotic notation. + +## Main definitions + +- `BigO` — `f =O g` means `f(n) = O(g(n))` as `n → ∞` +- `LittleO` — `f =o g` means `f(n) = o(g(n))` as `n → ∞` + +## Main results + +### BigO +- `BigO.refl` — reflexivity +- `BigO.trans` — transitivity +- `BigO.of_le` — pointwise `≤` implies big-O +- `BigO.add` — sum of big-O is big-O +- `BigO.pow` — fixed powers preserve big-O +- `BigO.const_mul_left` — fixedValue multiple preserves big-O +- `BigO.natSize_of_pow` — binary widths of power-bounded values are logarithmic +- `BigO.le_add_left` / `BigO.le_add_right` — projections from a sum +- `BigO.const_mul_add` — `c * f₁ + f₂ = O(T₁ + T₂)` +- `polynomial_eval_mono_nat` — natural polynomial evaluation is monotone + +### LittleO +- `LittleO.isBigO` — little-o implies big-O +- `LittleO.trans` — transitivity +- `LittleO.trans_bigO` — mixed: `o` then `O` gives `o` +- `BigO.trans_littleO` — mixed: `O` then `o` gives `o` +- `LittleO.add` — sum of little-o is little-o +- `LittleO.const_mul_left` — fixedValue multiple preserves little-o +-/ + + +@[expose] public section + +open Asymptotics Filter + +namespace Complexity + +-- ════════════════════════════════════════════════════════════════════════ +-- Definitions +-- ════════════════════════════════════════════════════════════════════════ + +/-- `f` grows at most as fast as `g` asymptotically: `f(n) = O(g(n))` as `n → ∞`. + Lifts Mathlib's `Asymptotics.IsBigO` to `ℕ → ℕ` functions, avoiding + repeated `Nat.cast` coercions in complexity class definitions. + + Unfolding: `f =O g ↔ ∃ C, ∀ᶠ n in atTop, ↑(f n) ≤ C * ↑(g n)`. -/ +def BigO (f g : ℕ → ℕ) : Prop := + (fun n => (f n : ℝ)) =O[atTop] (fun n => (g n : ℝ)) + +@[inherit_doc BigO] +scoped infixl:50 " =O " => BigO + +/-- `f` grows strictly slower than `g` asymptotically: `f(n) = o(g(n))` as `n → ∞`. + Lifts Mathlib's `Asymptotics.IsLittleO` to `ℕ → ℕ` functions. + + Unfolding: `f =o g ↔ ∀ ε > 0, ∀ᶠ n in atTop, ↑(f n) ≤ ε * ↑(g n)`. -/ +def LittleO (f g : ℕ → ℕ) : Prop := + (fun n => (f n : ℝ)) =o[atTop] (fun n => (g n : ℝ)) + +@[inherit_doc LittleO] +scoped infixl:50 " =o " => LittleO + +-- ════════════════════════════════════════════════════════════════════════ +-- BigO core lemmas +-- ════════════════════════════════════════════════════════════════════════ + +/-- Big-O is reflexive: `f = O(f)`. -/ +theorem BigO.refl (f : ℕ → ℕ) : f =O f := + isBigO_refl _ _ + +/-- Big-O is transitive: `f = O(g) → g = O(h) → f = O(h)`. -/ +theorem BigO.trans {f g h : ℕ → ℕ} (h₁ : f =O g) (h₂ : g =O h) : f =O h := + IsBigO.trans h₁ h₂ + +/-- Pointwise `≤` implies big-O. -/ +theorem BigO.of_le {f g : ℕ → ℕ} (h : ∀ n, f n ≤ g n) : f =O g := by + apply IsBigO.of_bound 1 + filter_upwards with n + simp only [one_mul, Real.norm_natCast] + exact_mod_cast h n + +/-- Sum of two big-O functions: `f₁ = O(g) → f₂ = O(g) → (f₁ + f₂) = O(g)`. -/ +theorem BigO.add {f₁ f₂ g : ℕ → ℕ} (h₁ : f₁ =O g) (h₂ : f₂ =O g) : + (fun n => f₁ n + f₂ n) =O g := by + show (fun n => ((f₁ n + f₂ n : ℕ) : ℝ)) =O[atTop] _ + have key := IsBigO.add h₁ h₂ + convert key using 1 + ext n; push_cast; ring + +/-- Product of two big-O bounds: `f₁ = O(g₁) → f₂ = O(g₂) → (f₁·f₂) = O(g₁·g₂)`. -/ +theorem BigO.mul {f₁ f₂ g₁ g₂ : ℕ → ℕ} (h₁ : f₁ =O g₁) (h₂ : f₂ =O g₂) : + (fun n => f₁ n * f₂ n) =O (fun n => g₁ n * g₂ n) := by + show (fun n => ((f₁ n * f₂ n : ℕ) : ℝ)) =O[atTop] (fun n => ((g₁ n * g₂ n : ℕ) : ℝ)) + have key := IsBigO.mul h₁ h₂ + convert key using 1 + · ext n; push_cast; ring + · ext n; push_cast; ring + +/-- Raising both sides of a big-O bound to a fixed natural power preserves +big-O. -/ +theorem BigO.pow {f g : ℕ → ℕ} (h : f =O g) (k : ℕ) : + (fun n => (f n) ^ k) =O (fun n => (g n) ^ k) := by + induction k with + | zero => exact BigO.refl fun _ => 1 + | succ k ih => + simpa only [pow_succ] using BigO.mul ih h + +/-- Constant multiple preserves big-O. -/ +theorem BigO.const_mul_left (c : ℕ) {f g : ℕ → ℕ} (h : f =O g) : + (fun n => c * f n) =O g := by + show (fun n => ((c * f n : ℕ) : ℝ)) =O[atTop] _ + have hcf : (fun n => (c : ℝ) * (f n : ℝ)) =O[atTop] (fun n => (f n : ℝ)) := + IsBigO.const_mul_left (isBigO_refl _ _) (c : ℝ) + have key := IsBigO.trans hcf h + convert key using 1 + ext n; push_cast; ring + +-- ════════════════════════════════════════════════════════════════════════ +-- LittleO core lemmas +-- ════════════════════════════════════════════════════════════════════════ + +/-- Little-o implies big-O: if `f = o(g)` then `f = O(g)`. -/ +theorem LittleO.isBigO {f g : ℕ → ℕ} (h : f =o g) : f =O g := + IsLittleO.isBigO h + +/-- Little-o is transitive: `f = o(g) → g = o(h) → f = o(h)`. -/ +theorem LittleO.trans {f g h : ℕ → ℕ} (h₁ : f =o g) (h₂ : g =o h) : f =o h := + IsLittleO.trans_isBigO h₁ (IsLittleO.isBigO h₂) + +/-- Mixed transitivity: `f = o(g) → g = O(h) → f = o(h)`. -/ +theorem LittleO.trans_bigO {f g h : ℕ → ℕ} (h₁ : f =o g) (h₂ : g =O h) : f =o h := + IsLittleO.trans_isBigO h₁ h₂ + +/-- Mixed transitivity: `f = O(g) → g = o(h) → f = o(h)`. -/ +theorem BigO.trans_littleO {f g h : ℕ → ℕ} (h₁ : f =O g) (h₂ : g =o h) : f =o h := + IsBigO.trans_isLittleO h₁ h₂ + +/-- Sum of two little-o functions: `f₁ = o(g) → f₂ = o(g) → (f₁ + f₂) = o(g)`. -/ +theorem LittleO.add {f₁ f₂ g : ℕ → ℕ} (h₁ : f₁ =o g) (h₂ : f₂ =o g) : + (fun n => f₁ n + f₂ n) =o g := by + show (fun n => ((f₁ n + f₂ n : ℕ) : ℝ)) =o[atTop] _ + have key := IsLittleO.add h₁ h₂ + convert key using 1 + ext n; push_cast; ring + +/-- Constant multiple preserves little-o. -/ +theorem LittleO.const_mul_left (c : ℕ) {f g : ℕ → ℕ} (h : f =o g) : + (fun n => c * f n) =o g := by + show (fun n => ((c * f n : ℕ) : ℝ)) =o[atTop] _ + have hcf : (fun n => (c : ℝ) * (f n : ℝ)) =O[atTop] (fun n => (f n : ℝ)) := + IsBigO.const_mul_left (isBigO_refl _ _) (c : ℝ) + have key := IsBigO.trans_isLittleO hcf h + convert key using 1 + ext n; push_cast; ring + +-- ════════════════════════════════════════════════════════════════════════ +-- BigO arithmetic lemmas (addition bounds) +-- ════════════════════════════════════════════════════════════════════════ + +/-- `T₁` is big-O of `T₁ + T₂`. -/ +theorem BigO.le_add_left (T₁ T₂ : ℕ → ℕ) : + T₁ =O (fun n => T₁ n + T₂ n) := by + show (fun n => ((T₁ n : ℕ) : ℝ)) =O[atTop] (fun n => ((T₁ n + T₂ n : ℕ) : ℝ)) + apply IsBigO.of_bound 1 + filter_upwards with n + simp only [Nat.cast_add, one_mul, Real.norm_natCast] + exact le_of_le_of_eq (le_add_of_nonneg_right (Nat.cast_nonneg (α := ℝ) (T₂ n))) + (abs_of_nonneg (add_nonneg (Nat.cast_nonneg _) (Nat.cast_nonneg _))).symm + +/-- `T₂` is big-O of `T₁ + T₂`. -/ +theorem BigO.le_add_right (T₁ T₂ : ℕ → ℕ) : + T₂ =O (fun n => T₁ n + T₂ n) := by + show (fun n => ((T₂ n : ℕ) : ℝ)) =O[atTop] (fun n => ((T₁ n + T₂ n : ℕ) : ℝ)) + apply IsBigO.of_bound 1 + filter_upwards with n + simp only [Nat.cast_add, one_mul, Real.norm_natCast] + exact le_of_le_of_eq (le_add_of_nonneg_left (Nat.cast_nonneg (α := ℝ) (T₁ n))) + (abs_of_nonneg (add_nonneg (Nat.cast_nonneg _) (Nat.cast_nonneg _))).symm + +/-- If `f₁ =O T₁` and `f₂ =O T₂`, then `c * f₁ + f₂ =O (T₁ + T₂)`. -/ +theorem BigO.const_mul_add (c : ℕ) {f₁ f₂ T₁ T₂ : ℕ → ℕ} + (ho₁ : f₁ =O T₁) (ho₂ : f₂ =O T₂) : + (fun n => c * f₁ n + f₂ n) =O (fun n => T₁ n + T₂ n) := by + show (fun n => ((c * f₁ n + f₂ n : ℕ) : ℝ)) =O[atTop] + (fun n => ((T₁ n + T₂ n : ℕ) : ℝ)) + have hf₁ : (fun n => ((f₁ n : ℕ) : ℝ)) =O[atTop] + (fun n => ((T₁ n + T₂ n : ℕ) : ℝ)) := IsBigO.trans ho₁ (le_add_left T₁ T₂) + have hcf₁ : (fun n => ((c * f₁ n : ℕ) : ℝ)) =O[atTop] + (fun n => ((T₁ n + T₂ n : ℕ) : ℝ)) := by + have : (fun n => (c : ℝ) * ((f₁ n : ℕ) : ℝ)) =O[atTop] + (fun n => ((T₁ n + T₂ n : ℕ) : ℝ)) := + IsBigO.const_mul_left hf₁ c + convert this using 1 + ext n; push_cast; ring + have hf₂ : (fun n => ((f₂ n : ℕ) : ℝ)) =O[atTop] + (fun n => ((T₁ n + T₂ n : ℕ) : ℝ)) := IsBigO.trans ho₂ (le_add_right T₁ T₂) + have := IsBigO.add hcf₁ hf₂ + convert this using 1 + ext n; push_cast; ring + +-- ════════════════════════════════════════════════════════════════════════ +-- BigO max and power bounds +-- ════════════════════════════════════════════════════════════════════════ + +/-- `T₁` is big-O of `max T₁ T₂`. -/ +theorem BigO.le_max_left (T₁ T₂ : ℕ → ℕ) : + T₁ =O (fun n => max (T₁ n) (T₂ n)) := + BigO.of_le fun _ => Nat.le_max_left _ _ + +/-- `T₂` is big-O of `max T₁ T₂`. -/ +theorem BigO.le_max_right (T₁ T₂ : ℕ → ℕ) : + T₂ =O (fun n => max (T₁ n) (T₂ n)) := + BigO.of_le fun _ => Nat.le_max_right _ _ + +/-- `max T₁ T₂ =O (T₁ + T₂)`. -/ +theorem BigO.max_le_add (T₁ T₂ : ℕ → ℕ) : + (fun n => max (T₁ n) (T₂ n)) =O (fun n => T₁ n + T₂ n) := + BigO.of_le fun _ => Nat.max_le.mpr ⟨Nat.le_add_right _ _, Nat.le_add_left _ _⟩ + +/-- A pointwise maximum of two functions with the same asymptotic bound has +that bound as well. -/ +theorem BigO.max_same {f₁ f₂ g : ℕ → ℕ} (h₁ : f₁ =O g) (h₂ : f₂ =O g) : + (fun n => max (f₁ n) (f₂ n)) =O g := + (BigO.max_le_add f₁ f₂).trans (BigO.add h₁ h₂) + +/-- Any function is big-O of itself-plus-fixedValue: `f =O (fun n => f n + c)`. -/ +theorem BigO.self_le_add_const (f : ℕ → ℕ) (c : ℕ) : + f =O (fun n => f n + c) := + BigO.of_le fun _ => Nat.le_add_right _ _ + +/-- `n^k` is big-O of `n^(k+1)` on sequences with `n ≥ 1`. -/ +theorem BigO.pow_le_pow_succ (k : ℕ) : + (· ^ k) =O ((· ^ (k + 1)) : ℕ → ℕ) := by + apply IsBigO.of_bound 1 + filter_upwards [Filter.eventually_ge_atTop 1] with n hn + simp only [one_mul, Real.norm_natCast] + exact_mod_cast Nat.pow_le_pow_right hn (Nat.le_succ k) + +/-- `n^j =O n^k` when `j ≤ k` (on sequences with `n ≥ 1`). -/ +theorem BigO.pow_le_pow_right {j k : ℕ} (hjk : j ≤ k) : + (· ^ j) =O ((· ^ k) : ℕ → ℕ) := by + apply IsBigO.of_bound 1 + filter_upwards [Filter.eventually_ge_atTop 1] with n hn + simp only [one_mul, Real.norm_natCast] + exact_mod_cast Nat.pow_le_pow_right hn hjk + +/-- A fixedValue function is big-O of `n^k` (eventually `n^k ≥ 1`). -/ +theorem BigO.const_le_pow (c k : ℕ) : + (fun _ : ℕ => c) =O ((· ^ k) : ℕ → ℕ) := by + apply IsBigO.of_bound c + filter_upwards [Filter.eventually_ge_atTop 1] with n hn + simp only [Real.norm_natCast] + have : 1 ≤ n ^ k := Nat.one_le_pow _ _ hn + exact_mod_cast le_mul_of_one_le_right (Nat.zero_le _) this + +/-- Every fixed natural fixedValue is eventually bounded by a fixedValue multiple +of the unshifted base-two logarithm. The threshold `n ≥ 2` is necessary because +`Nat.log 2 0 = Nat.log 2 1 = 0`. -/ +theorem BigO.const_le_logTwo (c : ℕ) : + (fun _ : ℕ => c) =O (fun n => Nat.log 2 n) := by + apply IsBigO.of_bound c + filter_upwards [Filter.eventually_ge_atTop 2] with n hn + simp only [Real.norm_natCast] + have hlog : 1 ≤ Nat.log 2 n := Nat.log_pos (by omega) hn + exact_mod_cast le_mul_of_one_le_right (Nat.zero_le c) hlog + +/-- `n^j + n^k =O n^(max j k)` on sequences with `n ≥ 1`. -/ +theorem BigO.pow_add_pow (j k : ℕ) : + (fun n => n ^ j + n ^ k) =O ((· ^ max j k) : ℕ → ℕ) := by + apply IsBigO.of_bound 2 + filter_upwards [Filter.eventually_ge_atTop 1] with n hn + simp only [Real.norm_natCast] + have h1 : n ^ j ≤ n ^ max j k := Nat.pow_le_pow_right hn (Nat.le_max_left j k) + have h2 : n ^ k ≤ n ^ max j k := Nat.pow_le_pow_right hn (Nat.le_max_right j k) + have : n ^ j + n ^ k ≤ 2 * n ^ max j k := by omega + exact_mod_cast this + +/-! ### Natural polynomial evaluation -/ + +/-- Evaluation of a polynomial with natural coefficients is monotone in its + natural-number argument. -/ +theorem polynomial_eval_mono_nat (p : Polynomial ℕ) : Monotone p.eval := by + intro m n hmn + change p.eval m ≤ p.eval n + rw [Polynomial.eval_eq_sum_range, Polynomial.eval_eq_sum_range] + exact Finset.sum_le_sum fun i _ => + Nat.mul_le_mul_left (p.coeff i) (Nat.pow_le_pow_left hmn i) + +-- ════════════════════════════════════════════════════════════════════════ +-- BigO ⇒ polynomial bound +-- ════════════════════════════════════════════════════════════════════════ + +/-- **From `f =O (·^k)` to an explicit polynomial bound.** If `f : ℕ → ℕ` + is big-O of `n^k`, then there exists a polynomial `p` in `Polynomial ℕ` + with `f n ≤ p.eval n` *for every* `n` (not just eventually). + + The standard big-O definition gives only an asymptotic bound; this lemma + turns that into an everywhere-bound by (i) extracting a real fixedValue + `C` and threshold `N` such that `f n ≤ C · n^k` for `n ≥ N`, (ii) + rounding `C` up to a natural number, and (iii) adding a fixedValue term + that dominates `f` on the initial segment `[0, N)`. + + This is the bridge from big-O hypotheses to the explicit + `Polynomial ℕ` shape expected by definitions like `PolyBalanced` and + by time-bound packaging in the `WitnessNTMConstruction` + construction. -/ +theorem BigO.pow_polynomial_bound {f : ℕ → ℕ} {k : ℕ} (h : f =O (· ^ k)) : + ∃ p : Polynomial ℕ, ∀ n, f n ≤ p.eval n := by + rw [BigO, Asymptotics.isBigO_iff] at h + obtain ⟨C, hC⟩ := h + rw [Filter.eventually_atTop] at hC + obtain ⟨N, hN⟩ := hC + refine ⟨Polynomial.C ⌈C⌉₊ * Polynomial.X ^ k + + Polynomial.C ((Finset.range N).sup f), ?_⟩ + intro n + simp only [Polynomial.eval_add, Polynomial.eval_mul, Polynomial.eval_C, + Polynomial.eval_pow, Polynomial.eval_X] + by_cases hn : n < N + · have : f n ≤ (Finset.range N).sup f := + Finset.le_sup (f := f) (Finset.mem_range.mpr hn) + omega + · push Not at hn + have hb := hN n hn + simp only [Real.norm_natCast] at hb + have hC_le : C ≤ (⌈C⌉₊ : ℝ) := Nat.le_ceil C + have h_nk_nonneg : (0 : ℝ) ≤ ((n ^ k : ℕ) : ℝ) := by positivity + have h_real : (f n : ℝ) ≤ (⌈C⌉₊ : ℝ) * ((n ^ k : ℕ) : ℝ) := + le_trans hb (mul_le_mul_of_nonneg_right hC_le h_nk_nonneg) + have h_nat : f n ≤ ⌈C⌉₊ * n ^ k := by exact_mod_cast h_real + omega + +/-- **From a polynomial bound to `=O (·^deg)`.** If `f : ℕ → ℕ` is + pointwise bounded by a polynomial `p`, then `f =O (·^p.natDegree)`. + + Companion to `BigO.pow_polynomial_bound`; the pair lets you convert + freely between the big-O form used by complexity classes and the + explicit `Polynomial ℕ` shape used in `PolyBalanced` and in + running-time packaging for composite machines. -/ +theorem BigO.of_polynomial_bound {f : ℕ → ℕ} (p : Polynomial ℕ) + (h : ∀ n, f n ≤ p.eval n) : f =O (· ^ p.natDegree) := by + set S : ℕ := ∑ i ∈ Finset.range (p.natDegree + 1), p.coeff i with hS + apply IsBigO.of_bound S + filter_upwards [Filter.eventually_ge_atTop 1] with n hn + simp only [Real.norm_natCast] + have hp : p.eval n ≤ S * n ^ p.natDegree := by + rw [Polynomial.eval_eq_sum_range, hS, Finset.sum_mul] + refine Finset.sum_le_sum (fun i hi => ?_) + have hi' : i ≤ p.natDegree := by + rw [Finset.mem_range] at hi; omega + have : n ^ i ≤ n ^ p.natDegree := Nat.pow_le_pow_right hn hi' + exact Nat.mul_le_mul_left _ this + exact_mod_cast le_trans (h n) hp + +/-- Extract a natural-number fixedValue and threshold from a big-O bound: + `f =O g` yields `c` and `N` with `f n ≤ c * g n` for all `n ≥ N`. -/ +theorem BigO.exists_nat_bound {f g : ℕ → ℕ} (h : f =O g) : + ∃ (c N : ℕ), ∀ n, N ≤ n → f n ≤ c * g n := by + rw [BigO, Asymptotics.isBigO_iff] at h + obtain ⟨C, hC⟩ := h + rw [Filter.eventually_atTop] at hC + obtain ⟨N, hN⟩ := hC + refine ⟨⌈C⌉₊, N, fun n hn => ?_⟩ + have hb := hN n hn + simp only [Real.norm_natCast] at hb + have hr : (f n : ℝ) ≤ (⌈C⌉₊ : ℝ) * (g n : ℝ) := + le_trans hb (mul_le_mul_of_nonneg_right (Nat.le_ceil C) (Nat.cast_nonneg _)) + exact_mod_cast hr + +/-- Binary widths of power-bounded natural values are logarithmic. The proof +raises the eventual power bound by one, which uniformly handles exponent zero +and fixedValue functions. -/ +theorem BigO.natSize_of_pow {f : ℕ → ℕ} {d : ℕ} + (hf : f =O ((· ^ d) : ℕ → ℕ)) : + (fun n => (f n).size) =O (fun n => Nat.log 2 n) := by + obtain ⟨c, N, hbound⟩ := BigO.exists_nat_bound hf + rw [BigO] + apply Asymptotics.IsBigO.of_bound (2 * (d + 1)) + filter_upwards [Filter.eventually_ge_atTop (max 2 (max c N))] with n hn + simp only [Real.norm_natCast] + have hn2 : 2 ≤ n := le_trans (Nat.le_max_left 2 (max c N)) hn + have hcn : c ≤ n := le_trans (le_trans (Nat.le_max_left c N) + (Nat.le_max_right 2 (max c N))) hn + have hNn : N ≤ n := le_trans (le_trans (Nat.le_max_right c N) + (Nat.le_max_right 2 (max c N))) hn + have hvalue : f n ≤ n ^ (d + 1) := by + calc + f n ≤ c * n ^ d := hbound n hNn + _ ≤ n * n ^ d := Nat.mul_le_mul_right _ hcn + _ = n ^ (d + 1) := by rw [pow_succ'] + have hlog : 1 ≤ Nat.log 2 n := Nat.log_pos (by omega) hn2 + have hpow : n ^ (d + 1) < 2 ^ ((d + 1) * (Nat.log 2 n + 1)) := by + calc + n ^ (d + 1) < (2 ^ (Nat.log 2 n + 1)) ^ (d + 1) := + Nat.pow_lt_pow_left (Nat.lt_pow_succ_log_self (by omega) n) (by omega) + _ = 2 ^ ((d + 1) * (Nat.log 2 n + 1)) := by + rw [← pow_mul'] + have hsize : (f n).size ≤ (d + 1) * (Nat.log 2 n + 1) := + Nat.size_le.mpr (lt_of_le_of_lt hvalue hpow) + have hlog' : Nat.log 2 n + 1 ≤ 2 * Nat.log 2 n := by omega + have hfinal : (f n).size ≤ (2 * (d + 1)) * Nat.log 2 n := + hsize.trans (by + calc + (d + 1) * (Nat.log 2 n + 1) ≤ + (d + 1) * (2 * Nat.log 2 n) := Nat.mul_le_mul_left _ hlog' + _ = (2 * (d + 1)) * Nat.log 2 n := by ring) + exact_mod_cast hfinal + +/-- Binary widths of pointwise polynomial-bounded natural values are logarithmic. -/ +theorem BigO.natSize_of_polynomial_bound {f : ℕ → ℕ} + (p : Polynomial ℕ) (hf : ∀ n, f n ≤ p.eval n) : + (fun n => (f n).size) =O (fun n => Nat.log 2 n) := + BigO.natSize_of_pow (BigO.of_polynomial_bound p hf) + +/-- The binary width of a fixed natural polynomial evaluation is logarithmic. -/ +theorem BigO.natSize_polynomial_eval (p : Polynomial ℕ) : + (fun n => (p.eval n).size) =O (fun n => Nat.log 2 n) := + BigO.natSize_of_polynomial_bound p fun _ => le_rfl + +/-- Strict power gap, shifted to the everywhere-positive base `n + 1`: + `(n + 1)^p = o((n + 1)^q)` when `p < q`. -/ +theorem LittleO.pow_lt_pow {p q : ℕ} (hpq : p < q) : + LittleO (fun n => (n + 1) ^ p) (fun n => (n + 1) ^ q) := by + have hbase : Filter.Tendsto (fun n : ℕ => ((n : ℝ) + 1)) atTop atTop := + Filter.tendsto_atTop_add_const_right atTop 1 tendsto_natCast_atTop_atTop + have key := + (Asymptotics.isLittleO_pow_pow_atTop_of_lt (𝕜 := ℝ) hpq).comp_tendsto hbase + exact key.congr (fun n => by simp only [Function.comp_apply]; push_cast; ring) + (fun n => by simp only [Function.comp_apply]; push_cast; ring) + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Asymptotics/PolyBound.lean b/LeanPool/BeyondBethe/Complexitylib/Asymptotics/PolyBound.lean new file mode 100644 index 0000000000..ff3ce9fb34 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Asymptotics/PolyBound.lean @@ -0,0 +1,88 @@ +/- +Copyright (c) 2026 Bolton Bailey. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Bolton Bailey +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Asymptotics + +/-! +# Polynomial bounds on natural-number functions + +`PolyBound f` says `f` is dominated pointwise (at every argument, not merely +eventually) by the evaluation of a natural polynomial. Resource bookkeeping +assembles time and space bounds by addition, multiplication, and monotonicity, +so an everywhere-bound closed under those operations is easier to carry through +a construction than a big-O statement; `PolyBound.bigO` converts to the big-O +form the complexity classes are stated in. + +## Main results + +- `PolyBound` — pointwise domination by a natural polynomial +- `PolyBound.const`, `.id`, `.add`, `.mul`, `.pow`, `.mono`, `.max`, `.eval` — + the closure API +- `PolyBound.bigO` — a polynomial bound is a big-O power bound +-/ + + +@[expose] public section + +namespace Complexity + +/-- Pointwise domination by the evaluation of a natural polynomial. -/ +def PolyBound (f : ℕ → ℕ) : Prop := + ∃ p : Polynomial ℕ, ∀ inputLength, f inputLength ≤ p.eval inputLength + +namespace PolyBound + +theorem const (value : ℕ) : PolyBound (fun _ => value) := + ⟨Polynomial.C value, fun _ => by simp⟩ + +theorem id : PolyBound (fun inputLength => inputLength) := + ⟨Polynomial.X, fun _ => by simp⟩ + +theorem add {f g : ℕ → ℕ} (hf : PolyBound f) (hg : PolyBound g) : + PolyBound (fun inputLength => f inputLength + g inputLength) := by + obtain ⟨p, hp⟩ := hf + obtain ⟨q, hq⟩ := hg + exact ⟨p + q, fun inputLength => by + rw [Polynomial.eval_add] + exact Nat.add_le_add (hp inputLength) (hq inputLength)⟩ + +theorem mul {f g : ℕ → ℕ} (hf : PolyBound f) (hg : PolyBound g) : + PolyBound (fun inputLength => f inputLength * g inputLength) := by + obtain ⟨p, hp⟩ := hf + obtain ⟨q, hq⟩ := hg + exact ⟨p * q, fun inputLength => by + rw [Polynomial.eval_mul] + exact Nat.mul_le_mul (hp inputLength) (hq inputLength)⟩ + +theorem mono {f g : ℕ → ℕ} (hg : PolyBound g) + (hle : ∀ inputLength, f inputLength ≤ g inputLength) : PolyBound f := by + obtain ⟨p, hp⟩ := hg + exact ⟨p, fun inputLength => le_trans (hle inputLength) (hp inputLength)⟩ + +theorem max {f g : ℕ → ℕ} (hf : PolyBound f) (hg : PolyBound g) : + PolyBound (fun inputLength => max (f inputLength) (g inputLength)) := + (hf.add hg).mono fun _ => Nat.max_le.mpr + ⟨Nat.le_add_right _ _, Nat.le_add_left _ _⟩ + +theorem eval (p : Polynomial ℕ) : + PolyBound (fun inputLength => p.eval inputLength) := + ⟨p, fun _ => le_rfl⟩ + +theorem pow {f : ℕ → ℕ} (hf : PolyBound f) (exponent : ℕ) : + PolyBound (fun inputLength => f inputLength ^ exponent) := by + induction exponent with + | zero => simpa using const 1 + | succ exponent ih => simpa [pow_succ] using ih.mul hf + +/-- A polynomial bound is a big-O bound by the polynomial's degree. -/ +theorem bigO {f : ℕ → ℕ} (hf : PolyBound f) : ∃ d, f =O (· ^ d) := by + obtain ⟨p, hp⟩ := hf + exact ⟨p.natDegree, BigO.of_polynomial_bound p hp⟩ + +end PolyBound + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Asymptotics/PolynomialComposition.lean b/LeanPool/BeyondBethe/Complexitylib/Asymptotics/PolynomialComposition.lean new file mode 100644 index 0000000000..990148dae8 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Asymptotics/PolynomialComposition.lean @@ -0,0 +1,46 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Asymptotics + +/-! +# Polynomial composition bounds + +This module packages natural-polynomial composition as power-form big-O +bounds. The second theorem records the coarse time expression used when two +deterministic function computations are connected sequentially. + +## Main results + +- `BigO.polynomial_eval_comp` — nested polynomial evaluation is polynomially bounded +- `BigO.polynomial_composition_time` — the coarse sequential runtime is polynomially bounded +-/ + + +public section + +namespace Complexity + +/-- Composing evaluations of natural-coefficient polynomials gives a function +bounded by a power whose exponent is the degree of the composed polynomial. -/ +theorem BigO.polynomial_eval_comp (p q : Polynomial ℕ) : + (fun n => q.eval (p.eval n)) =O (· ^ (q.comp p).natDegree) := by + apply BigO.of_polynomial_bound (q.comp p) + intro n + simp [Polynomial.eval_comp] + +/-- The coarse runtime for sequentially composing computations with polynomial +bounds `p` and `q` is itself bounded by a power. -/ +theorem BigO.polynomial_composition_time (p q : Polynomial ℕ) : + (fun n => 4 * p.eval n + 11 + q.eval (p.eval n)) =O + (· ^ (Polynomial.C 4 * p + Polynomial.C 11 + q.comp p).natDegree) := by + apply BigO.of_polynomial_bound + (Polynomial.C 4 * p + Polynomial.C 11 + q.comp p) + intro n + simp [Polynomial.eval_comp] + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Circuits.lean b/LeanPool/BeyondBethe/Complexitylib/Circuits.lean new file mode 100644 index 0000000000..128db4cf2e --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Circuits.lean @@ -0,0 +1,11 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.Complexitylib.Circuits.AndOrNot +import LeanPool.BeyondBethe.Complexitylib.Circuits.Basic +import LeanPool.BeyondBethe.Complexitylib.Circuits.Encoding + +/-! Supporting modules for Beyond the Bethe approximation of the permanent. -/ diff --git a/LeanPool/BeyondBethe/Complexitylib/Circuits/AndOrNot.lean b/LeanPool/BeyondBethe/Complexitylib/Circuits/AndOrNot.lean new file mode 100644 index 0000000000..0d58e0367a --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Circuits/AndOrNot.lean @@ -0,0 +1,9 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.Complexitylib.Circuits.AndOrNot.Defs + +/-! Supporting modules for Beyond the Bethe approximation of the permanent. -/ diff --git a/LeanPool/BeyondBethe/Complexitylib/Circuits/AndOrNot/Defs.lean b/LeanPool/BeyondBethe/Complexitylib/Circuits/AndOrNot/Defs.lean new file mode 100644 index 0000000000..8c9e8eefa6 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Circuits/AndOrNot/Defs.lean @@ -0,0 +1,95 @@ +/- +Copyright (c) 2025 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Circuits.Basic + +/-! # AND/OR/NOT Basis — Definitions + +This module defines the AND/OR operations and various basis configurations +used throughout the circuit complexity library. + +## Main definitions + +* `AndOrOp` — AND/OR operations (negation is free via per-input gate flags) +* `AndOrOp.eval` — fold-based evaluation of AND/OR on `n` input bits +* `AndOrOp.dual`, `AndOrOp.dualIf` — De Morgan duality +* `Basis.unboundedAndOr` — unbounded fan-in AND/OR basis +* `Basis.boundedAndOr` — fan-in bounded by `k` AND/OR basis +* `Basis.andOr2` — fan-in exactly 2 AND/OR basis (used in Shannon/Schnorr bounds) +-/ + + +@[expose] public section + +namespace Complexity + +/-- Operations in an AND/OR basis. Negation is handled by per-input flags + on gates, so only AND and OR need explicit representation. -/ +inductive AndOrOp where + /-- The AND operation: outputs `true` iff all inputs are `true`. -/ + | and + /-- The OR operation: outputs `true` iff at least one input is `true`. -/ + | or + deriving Repr, DecidableEq + +/-- Evaluate an AND or OR operation on `n` input bits by folding. + AND folds with `&&` starting from `true`; OR folds with `||` from `false`. -/ +def AndOrOp.eval : (op : AndOrOp) → (n : Nat) → BitString n → Bool + | .and, n, inputs => Fin.foldl n (fun acc i => acc && inputs i) true + | .or, n, inputs => Fin.foldl n (fun acc i => acc || inputs i) false + +/-- De Morgan duality swaps AND and OR. -/ +def AndOrOp.dual : AndOrOp → AndOrOp + | .and => .or + | .or => .and + +/-- Select the De Morgan dual exactly when `negated` is true. -/ +def AndOrOp.dualIf (negated : Bool) (op : AndOrOp) : AndOrOp := + if negated then op.dual else op + +/-- AND/OR basis with unbounded fan-in. Negation is free (per-input flags on gates). -/ +def Basis.unboundedAndOr : Basis where + Op := AndOrOp + arity + | .and => .unbounded + | .or => .unbounded + eval op n _ inputs := op.eval n inputs + +/-- AND/OR basis with fan-in bounded by `k`. Negation is free (per-input flags on gates). -/ +def Basis.boundedAndOr (k : Nat) : Basis where + Op := AndOrOp + arity + | .and => .upto k + | .or => .upto k + eval op n _ inputs := op.eval n inputs + +/-- Fan-in-2 AND/OR basis. Every gate has exactly 2 inputs. + Negation is free (per-input flags on gates). + This is the basis used in the Shannon and Schnorr lower bound theorems. -/ +def Basis.andOr2 : Basis where + Op := AndOrOp + arity _ := .exactly 2 + eval op n _ inputs := op.eval n inputs + +/-- Every gate over `Basis.andOr2` has fan-in exactly 2. -/ +theorem fanIn_andOr2 {W : Nat} (g : Gate Basis.andOr2 W) : g.fanIn = 2 := g.arityOk + +/-- A fan-in-2 AND gate computes the conjunction of its two inputs. -/ +theorem AndOrOp.eval_two_and (inputs : BitString 2) : + AndOrOp.eval .and 2 inputs = (inputs 0 && inputs 1) := by + simp [AndOrOp.eval, Fin.foldl_succ_last, Fin.foldl_zero] + +/-- A fan-in-2 OR gate computes the disjunction of its two inputs. -/ +theorem AndOrOp.eval_two_or (inputs : BitString 2) : + AndOrOp.eval .or 2 inputs = (inputs 0 || inputs 1) := by + simp [AndOrOp.eval, Fin.foldl_succ_last, Fin.foldl_zero] + +@[simp] theorem AndOrOp.dual_dual (op : AndOrOp) : + op.dual.dual = op := by + cases op <;> rfl + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Circuits/Basic.lean b/LeanPool/BeyondBethe/Complexitylib/Circuits/Basic.lean new file mode 100644 index 0000000000..30dc754cd0 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Circuits/Basic.lean @@ -0,0 +1,366 @@ +/- +Copyright (c) 2025 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import Mathlib.Data.Nat.Lattice + +/-! # Boolean Circuit Complexity + +This file defines Boolean circuits parameterized by a basis of operations and +establishes the circuit size complexity measure for Boolean functions. + +## Main definitions + +* `BitString` — a string of bits of a specific length +* `BoolFunFamily` — a family of Boolean functions indexed by input length +* `Basis` — a basis of Boolean operations with arity constraints +* `Circuit` — an acyclic Boolean circuit (well-formedness by construction) +* `CompleteBasis` — typeclass for functionally complete bases +* `Circuit.wireDepth` — depth of a wire in the circuit DAG +* `Circuit.outputDepth` — depth of a single output gate +* `Circuit.depth` — depth of a (possibly multi-output) circuit +* `Circuit.Realizable` — whether a function is computed by some circuit over a basis +* `Circuit.sizeComplexityWithTop` — generic minimum size, with `⊤` for unrealizable functions +* `Circuit.sizeComplexity` — natural-valued minimum size over a complete basis + +## Main results + +* `Circuit.sizeComplexity_pos` — for complete bases, size complexity is positive +-/ + + +@[expose] public section + +namespace Complexity + +/-- A BitString of length `n`. -/ +abbrev BitString n := Fin n → Bool + +/-- A family of Boolean functions indexed by input length `N`. + +Each member maps `N`-bit strings to a single output bit. -/ +abbrev BoolFunFamily := (N : Nat) → BitString N → Bool + +/-- Arity constraint for operations in a basis. -/ +inductive Arity where + /-- Any number of inputs is allowed. -/ + | unbounded + /-- Exactly `k` inputs are required. -/ + | exactly (k : Nat) + /-- At most `k` inputs are allowed. -/ + | upto (k : Nat) + deriving Repr, DecidableEq + +/-- Whether `n` satisfies an arity constraint. -/ +def Arity.satisfiedBy : Arity → Nat → Prop + | .unbounded, _ => True + | .exactly k, n => n = k + | .upto k, n => n ≤ k + +instance (a : Arity) (n : Nat) : Decidable (a.satisfiedBy n) := by + cases a <;> simp only [Arity.satisfiedBy] <;> exact inferInstance + +/-- +A basis of Boolean operations. + +Each operation has an arity constraint and an evaluation function that computes +the output bit from any valid number of input bits. +-/ +structure Basis where + /-- The type of operations (e.g., AND, OR, NOT). -/ + Op : Type + /-- The arity constraint for each operation. -/ + arity : Op → Arity + /-- Evaluate an operation on `n` input bits, given that `n` satisfies the arity. -/ + eval : (op : Op) → (n : Nat) → (arity op).satisfiedBy n → BitString n → Bool + +/-- +A gate in a circuit over basis `B` with `W` wires available as inputs. +The gate's fan-in must satisfy the arity constraint of its operation, and each +input is wired to one of the `W` available wires. +-/ +structure Gate (B : Basis) (W : Nat) where + /-- The basis operation this gate computes. -/ + op : B.Op + /-- The number of inputs this gate reads. -/ + fanIn : Nat + /-- Proof that `fanIn` satisfies the arity constraint of `op`. -/ + arityOk : (B.arity op).satisfiedBy fanIn + /-- The wire each of the gate's `fanIn` inputs is connected to. -/ + inputs : Fin fanIn → Fin W + /-- Per-input negation flag. Negations are free under this library's size + convention. -/ + negated : Fin fanIn → Bool + +/-- Evaluate a gate given a wire-value assignment. -/ +def Gate.eval (g : Gate B W) (wireVal : BitString W) : Bool := + B.eval g.op g.fanIn g.arityOk (fun i => (g.negated i).xor (wireVal (g.inputs i))) + +/-- +A Boolean circuit over basis `B` with `N` inputs, `M` outputs, and `G` +internal gates. + +All gates reference wires from `Fin (N + G)`. The `acyclic` field ensures +that internal gate `i` only reads wires `0, …, N + i − 1`, preventing cycles. +-/ +structure Circuit (B : Basis) (N M G : Nat) [NeZero N] [NeZero M] where + /-- The internal gates; gate `i` drives wire `N + i`. -/ + gates : Fin G → Gate B (N + G) + /-- The output gates; output bit `j` is the value of gate `outputs j`. -/ + outputs : Fin M → Gate B (N + G) + /-- Acyclicity: internal gate `i` only reads wires `0, …, N + i − 1`. -/ + acyclic : ∀ (i : Fin G) (k : Fin (gates i).fanIn), + ((gates i).inputs k).val < N + i.val + +namespace Circuit +variable {B : Basis} {N M G : Nat} [NeZero N] [NeZero M] + +/-- Value of wire `w` when the circuit is fed `input`. + +The first `N` wires carry the primary inputs. Wire `N + i` carries the +output of internal gate `i`. -/ +def wireValue (c : Circuit B N M G) (input : BitString N) + (w : Fin (N + G)) : Bool := + if h : w.val < N then + input ⟨w.val, h⟩ + else + have hG : w.val - N < G := by omega + let gate := c.gates ⟨w.val - N, hG⟩ + B.eval gate.op gate.fanIn gate.arityOk + fun k => (gate.negated k).xor (c.wireValue input (gate.inputs k)) +termination_by w.val +decreasing_by + have hacyc := c.acyclic ⟨w.val - N, hG⟩ k + have : (⟨w.val - N, hG⟩ : Fin G).val = w.val - N := rfl + omega + +/-- On primary input wires (index < `N`), `wireValue` is the corresponding input bit. -/ +theorem wireValue_of_lt (c : Circuit B N M G) (input : BitString N) + (w : Fin (N + G)) (h : w.val < N) : + c.wireValue input w = input ⟨w.val, h⟩ := by + unfold wireValue + simp [h] + +/-- On internal gate wires (index ≥ `N`), `wireValue` is the evaluation of gate +`w − N` on the values of its input wires. -/ +theorem wireValue_of_not_lt (c : Circuit B N M G) (input : BitString N) + (w : Fin (N + G)) (h : ¬ (w.val < N)) : + c.wireValue input w = + (c.gates ⟨w.val - N, by omega⟩).eval (c.wireValue input) := by + unfold wireValue + simp only [h, dite_false] + rfl + +/-- Depth of wire `w` in the circuit DAG. + +Primary inputs have depth 0. Wire `N + i` (internal gate `i`) has depth +`1 + max over input wires`. -/ +def wireDepth (c : Circuit B N M G) (w : Fin (N + G)) : Nat := + if h : w.val < N then + 0 + else + have hG : w.val - N < G := by omega + let gate := c.gates ⟨w.val - N, hG⟩ + 1 + Fin.foldl gate.fanIn (fun acc k => max acc (c.wireDepth (gate.inputs k))) 0 +termination_by w.val +decreasing_by + have hacyc := c.acyclic ⟨w.val - N, hG⟩ k + have : (⟨w.val - N, hG⟩ : Fin G).val = w.val - N := rfl + omega + +/-- Primary input wires (index < N) have depth 0. -/ +@[simp] theorem wireDepth_of_lt (c : Circuit B N M G) + (w : Fin (N + G)) (h : w.val < N) : + c.wireDepth w = 0 := by + unfold wireDepth; simp [h] + +/-- Internal gate wires (index ≥ N) have depth 1 + max over their input wires. +Unfolds one step of `wireDepth` for the gate case. -/ +theorem wireDepth_of_not_lt (c : Circuit B N M G) + (w : Fin (N + G)) (h : ¬ (w.val < N)) : + c.wireDepth w = + 1 + Fin.foldl (c.gates ⟨w.val - N, by omega⟩).fanIn + (fun acc k => max acc (c.wireDepth ((c.gates ⟨w.val - N, by omega⟩).inputs k))) 0 := by + conv_lhs => unfold wireDepth + simp only [h, dite_false] + +/-- Depth contributed by a single output gate: one layer for the gate itself +plus the maximum `wireDepth` of its inputs. Always ≥ 1. -/ +def outputDepth (c : Circuit B N M G) (j : Fin M) : Nat := + let outGate := c.outputs j + 1 + Fin.foldl outGate.fanIn (fun acc k => max acc (c.wireDepth (outGate.inputs k))) 0 + +/-- Depth of a circuit: the maximum `outputDepth` over all output gates. -/ +def depth (c : Circuit B N M G) : Nat := + Fin.foldl M (fun acc j => max acc (c.outputDepth j)) 0 + +/-- Evaluate a circuit: map an `N`-bit input to an `M`-bit output. -/ +def eval (c : Circuit B N M G) (input : BitString N) : BitString M := + fun j => (c.outputs j).eval (c.wireValue input) + +/-- The library's circuit size: internal gates plus output gates. + +Primary input vertices are not counted, and the negation flags on gate inputs +have zero cost. Some texts instead count input vertices and explicit NOT gates; +those conventions agree only up to additive/linear overhead, not on exact size +bounds. -/ +-- The circuit argument is unused by design: `size` is determined by the +-- indices, and the argument exists purely to enable `c.size` dot notation. +def size (_ : Circuit B N M G) : Nat := G + M + +end Circuit + +/-- A basis is complete if every Boolean function can be computed by some circuit over it. -/ +class CompleteBasis (B : Basis) : Prop where + /-- Every function `BitString N → BitString M` is the evaluation of some circuit over `B`. -/ + complete : ∀ {N M} [NeZero N] [NeZero M] (f : BitString N → BitString M), + ∃ G, ∃ c : Circuit B N M G, c.eval = f + +/-- If every circuit over `B₁` can be simulated by a circuit over `B₂` + (possibly with a different number of internal gates), then completeness + of `B₁` implies completeness of `B₂`. + + This is the generic tool for proving new bases complete: show you can + compile each gate of a known-complete basis into a subcircuit of the + new basis. -/ +theorem CompleteBasis.of_simulation (B₁ B₂ : Basis) [CompleteBasis B₁] + (sim : ∀ {N M G} [NeZero N] [NeZero M] (c : Circuit B₁ N M G), + ∃ G', ∃ c' : Circuit B₂ N M G', c'.eval = c.eval) + : CompleteBasis B₂ where + complete f := by + obtain ⟨G, c, hc⟩ := CompleteBasis.complete (B := B₁) f + obtain ⟨G', c', hc'⟩ := sim c + exact ⟨G', c', hc'.trans hc⟩ + +namespace Circuit +variable {B : Basis} {N : Nat} [NeZero N] + +/-- A Boolean function is realizable over `B` when some single-output circuit +over `B` computes it. -/ +def Realizable (B : Basis) (f : BitString N → Bool) : Prop := + ∃ G, ∃ c : Circuit B N 1 G, (fun x => (c.eval x) 0) = f + +/-- Sizes of all single-output circuits over `B` that realize `f`. -/ +def realizationSizes (B : Basis) (f : BitString N → Bool) : Set Nat := + {s | ∃ G, ∃ c : Circuit B N 1 G, + c.size = s ∧ (fun x => (c.eval x) 0) = f} + +/-- The minimum circuit size over an arbitrary basis, as an extended natural. + +A single-output circuit `Circuit B N 1 G` has size `G + 1`. The value is `⊤` +exactly when no circuit over `B` computes `f`; thus an unrealizable function +cannot be confused with a zero-size function. -/ +noncomputable def sizeComplexityWithTop + (B : Basis) (f : BitString N → Bool) : WithTop Nat := + sInf ((fun s : Nat => (s : WithTop Nat)) '' realizationSizes B f) + +/-- The minimum circuit size over a complete basis `B` computing `f`. + +This natural-valued interface requires completeness so that the set of +realizing circuits is nonempty. Use `sizeComplexityWithTop` when the basis may +be incomplete. -/ +-- Completeness is an intentional API precondition. The infimum expression +-- itself does not inspect the selected witness. +noncomputable def sizeComplexity + (B : Basis) [CompleteBasis B] (f : BitString N → Bool) : Nat := + sInf (realizationSizes B f) + +private theorem realizationSizes_nonempty [CompleteBasis B] + (f : BitString N → Bool) : + (realizationSizes B f).Nonempty := by + obtain ⟨G, c, hc⟩ := CompleteBasis.complete (B := B) (fun x => (fun _ : Fin 1 => f x)) + refine ⟨c.size, G, c, rfl, ?_⟩ + funext x + exact congrFun (congrFun hc x) 0 + +/-- Any circuit computing `f` gives an upper bound on the generic extended +size complexity. -/ +theorem sizeComplexityWithTop_le {G : Nat} + (c : Circuit B N 1 G) (f : BitString N → Bool) + (hf : (fun x => (c.eval x) 0) = f) : + sizeComplexityWithTop B f ≤ c.size := by + apply sInf_le + exact ⟨c.size, ⟨G, c, rfl, hf⟩, rfl⟩ + +/-- Generic size complexity is infinite exactly for functions that cannot be +realized over the chosen basis. -/ +theorem sizeComplexityWithTop_eq_top_iff + (f : BitString N → Bool) : + sizeComplexityWithTop B f = ⊤ ↔ ¬ Realizable B f := by + rw [sizeComplexityWithTop, sInf_eq_top] + constructor + · intro h hrealizable + obtain ⟨G, c, hc⟩ := hrealizable + have htop := h (c.size : WithTop Nat) + ⟨c.size, ⟨G, c, rfl, hc⟩, rfl⟩ + exact (WithTop.coe_ne_top : (c.size : WithTop Nat) ≠ ⊤) htop + · intro h a ha + obtain ⟨s, ⟨G, c, _, hc⟩, rfl⟩ := ha + exact (h ⟨G, c, hc⟩).elim + +/-- Generic size complexity is finite exactly for realizable functions. -/ +theorem sizeComplexityWithTop_ne_top_iff + (f : BitString N → Bool) : + sizeComplexityWithTop B f ≠ ⊤ ↔ Realizable B f := by + rw [ne_eq, sizeComplexityWithTop_eq_top_iff] + simp only [not_not] + +/-- Whenever the generic size complexity is finite, a circuit realizes its +minimum value. -/ +theorem sizeComplexityWithTop_witness + (f : BitString N → Bool) + (hfinite : sizeComplexityWithTop B f ≠ ⊤) : + ∃ G, ∃ c : Circuit B N 1 G, + (c.size : WithTop Nat) = sizeComplexityWithTop B f ∧ + (fun x => (c.eval x) 0) = f := by + have hrealizable := (sizeComplexityWithTop_ne_top_iff (B := B) f).mp hfinite + obtain ⟨G₀, c₀, hc₀⟩ := hrealizable + have hset : ((fun s : Nat => (s : WithTop Nat)) '' + realizationSizes B f).Nonempty := + ⟨c₀.size, c₀.size, ⟨G₀, c₀, rfl, hc₀⟩, rfl⟩ + have hmem := csInf_mem hset + obtain ⟨s, ⟨G, c, hs, hc⟩, hcoe⟩ := hmem + exact ⟨G, c, hs ▸ hcoe, hc⟩ + +/-- Over a complete basis, the generic extended measure agrees with the +natural-valued minimum. -/ +theorem sizeComplexityWithTop_eq_coe [CompleteBasis B] + (f : BitString N → Bool) : + sizeComplexityWithTop B f = (sizeComplexity B f : WithTop Nat) := by + apply le_antisymm + · apply sInf_le + exact ⟨sizeComplexity B f, + Nat.sInf_mem (realizationSizes_nonempty (B := B) f), rfl⟩ + · apply le_sInf + rintro _ ⟨s, hs, rfl⟩ + exact WithTop.coe_le_coe.mpr (Nat.sInf_le hs) + +/-- For a complete basis, circuit size complexity is always positive. -/ +theorem sizeComplexity_pos [CompleteBasis B] + (f : BitString N → Bool) : + 0 < sizeComplexity B f := by + obtain ⟨_, _, hs, _⟩ := Nat.sInf_mem (realizationSizes_nonempty (B := B) f) + simp only [sizeComplexity] + rw [← hs, size] + omega + +/-- Any circuit computing `f` has size at least `sizeComplexity B f`. -/ +theorem sizeComplexity_le [CompleteBasis B] {G : Nat} + (c : Circuit B N 1 G) (f : BitString N → Bool) + (hf : (fun x => (c.eval x) 0) = f) : + sizeComplexity B f ≤ c.size := + Nat.sInf_le ⟨G, c, rfl, hf⟩ + +/-- For a complete basis, `sizeComplexity` is realized by some circuit. -/ +theorem sizeComplexity_witness [CompleteBasis B] + (f : BitString N → Bool) : + ∃ G, ∃ c : Circuit B N 1 G, + c.size = sizeComplexity B f ∧ (fun x => (c.eval x) 0) = f := + Nat.sInf_mem (realizationSizes_nonempty (B := B) f) + +end Circuit + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Circuits/Encoding.lean b/LeanPool/BeyondBethe/Complexitylib/Circuits/Encoding.lean new file mode 100644 index 0000000000..9811043957 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Circuits/Encoding.lean @@ -0,0 +1,10 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.Complexitylib.Circuits.Encoding.Defs +import LeanPool.BeyondBethe.Complexitylib.Circuits.Encoding.Internal + +/-! Supporting modules for Beyond the Bethe approximation of the permanent. -/ diff --git a/LeanPool/BeyondBethe/Complexitylib/Circuits/Encoding/Defs.lean b/LeanPool/BeyondBethe/Complexitylib/Circuits/Encoding/Defs.lean new file mode 100644 index 0000000000..436502481f --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Circuits/Encoding/Defs.lean @@ -0,0 +1,251 @@ +/- +Copyright (c) 2025 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Circuits.AndOrNot.Defs + +/-! +# Machine-facing encoding of fan-in-two AND/OR circuits + +This file defines a proof-free, on-tape representation of the library's +`Basis.andOr2` circuits. A raw circuit is an ordered list of gates. For an +input arity `N`, wires `0, ..., N - 1` are primary inputs and gate `i` produces +wire `N + i`. Thus topological well-formedness says that both references of +gate `i` are strictly less than `N + i`. The last gate is the sole output. + +The evaluator is intentionally iterative. It stores each wire value in an +array exactly once, so sharing in the circuit DAG does not cause the recursive +recomputation performed by the proof-oriented `Circuit.wireValue` definition. + +The bit format is deterministic and self-delimiting. Naturals use terminated +unary (`n` one-bits followed by a zero-bit), a gate stores three fixed bits and +two unary references, and a circuit starts with its unary gate count. Exact +decoding rejects truncation and trailing garbage. Unary references make the +format polynomially long in the input arity and number of gates; a binary +format can be added later without changing the raw circuit semantics. +-/ + + +@[expose] public section + +namespace Complexity + +namespace CircuitCode + +/-- A proof-free fan-in-two AND/OR gate. + +`input₀` and `input₁` are absolute wire indices. Negation flags are applied +before the AND/OR operation, matching `Gate.negated` in the typed circuit +model. -/ +structure RawGate where + /-- Whether the gate computes AND or OR of its (possibly negated) inputs. -/ + op : AndOrOp + /-- Absolute wire index of the first input. -/ + input₀ : ℕ + /-- Absolute wire index of the second input. -/ + input₁ : ℕ + /-- Whether the first input value is negated before applying `op`. -/ + negated₀ : Bool + /-- Whether the second input value is negated before applying `op`. -/ + negated₁ : Bool + deriving DecidableEq + +/-- A raw single-output circuit. The output is the value of the last gate. -/ +abbrev RawCircuit := List RawGate + +namespace RawGate + +/-- Both inputs of a gate must refer to already available wires. -/ +def WellFormedAt (g : RawGate) (available : ℕ) : Prop := + g.input₀ < available ∧ g.input₁ < available + +instance (g : RawGate) (available : ℕ) : Decidable (g.WellFormedAt available) := + by + unfold WellFormedAt + exact inferInstance + +/-- Boolean checker corresponding to `WellFormedAt`. -/ +def isWellFormedAt (g : RawGate) (available : ℕ) : Bool := + decide (g.WellFormedAt available) + +/-- Evaluate a gate once its two (unnegated) input values are known. -/ +def eval (g : RawGate) (value₀ value₁ : Bool) : Bool := + let value₀ := g.negated₀.xor value₀ + let value₁ := g.negated₁.xor value₁ + match g.op with + | .and => value₀ && value₁ + | .or => value₀ || value₁ + +end RawGate + +namespace RawCircuit + +/-- Every gate reference points to a primary input or an earlier gate. -/ +def TopologicallyWellFormed (N : ℕ) (c : RawCircuit) : Prop := + ∀ i : Fin c.length, (c.get i).WellFormedAt (N + i.val) + +instance (N : ℕ) (c : RawCircuit) : Decidable (TopologicallyWellFormed N c) := + by + unfold TopologicallyWellFormed + exact Fintype.decidableForallFintype + +/-- A valid single-output raw circuit is nonempty and topologically ordered. -/ +def WellFormed (N : ℕ) (c : RawCircuit) : Prop := + c ≠ [] ∧ c.TopologicallyWellFormed N + +instance (N : ℕ) (c : RawCircuit) : Decidable (WellFormed N c) := + by + unfold WellFormed + exact inferInstance + +/-- Boolean checker for the explicit well-formedness predicate. -/ +def isWellFormed (N : ℕ) (c : RawCircuit) : Bool := + decide (c.WellFormed N) + +/-- Evaluate gates in order, appending each result to the memo array. + +Failure means that a gate contains a forward or out-of-range reference. -/ +def evalAux? : RawCircuit → Array Bool → Option (Array Bool) + | [], wires => some wires + | gate :: gates, wires => do + let value₀ ← wires[gate.input₀]? + let value₁ ← wires[gate.input₁]? + evalAux? gates (wires.push (gate.eval value₀ value₁)) + +/-- Evaluate a raw circuit on a list of primary-input values. + +The empty gate list has no designated output and is rejected. -/ +def eval? (c : RawCircuit) (input : List Bool) : Option Bool := do + if c.isEmpty then + none + else + let wires ← evalAux? c input.toArray + wires[input.length + c.length - 1]? + +end RawCircuit + +/-! ## Terminated unary fields -/ + +namespace NatCode + +/-- Self-delimiting unary: `n` one-bits followed by a zero terminator. -/ +def encode (n : ℕ) : List Bool := + List.replicate n true ++ [false] + +/-- Parse one terminated-unary prefix, returning the unconsumed suffix. -/ +def decodeAux? : List Bool → ℕ → Option (ℕ × List Bool) + | [], _ => none + | false :: rest, acc => some (acc, rest) + | true :: rest, acc => decodeAux? rest (acc + 1) + +/-- Parse one terminated-unary prefix. -/ +def decodePrefix? (bits : List Bool) : Option (ℕ × List Bool) := + decodeAux? bits 0 + +end NatCode + +/-! ## Gate serialization -/ + +namespace RawGate + +/-- Operation bit: one is AND and zero is OR. -/ +def opBit (g : RawGate) : Bool := + match g.op with + | .and => true + | .or => false + +/-- Decode the operation bit used by `opBit`. -/ +def opOfBit : Bool → AndOrOp + | true => .and + | false => .or + +/-- Encode a gate as operation, negation flags, then two unary references. -/ +def encode (g : RawGate) : List Bool := + [g.opBit, g.negated₀, g.negated₁] ++ + NatCode.encode g.input₀ ++ NatCode.encode g.input₁ + +/-- Parse one gate prefix, returning the unconsumed suffix. -/ +def decodePrefix? : List Bool → Option (RawGate × List Bool) + | op :: negated₀ :: negated₁ :: rest => + match NatCode.decodePrefix? rest with + | none => none + | some (input₀, rest) => + match NatCode.decodePrefix? rest with + | none => none + | some (input₁, rest) => + some ({ op := opOfBit op, input₀, input₁, negated₀, negated₁ }, rest) + | _ => none + +end RawGate + +/-! ## Circuit serialization -/ + +namespace RawCircuit + +/-- Parse exactly `count` gate prefixes and return the remaining suffix. -/ +def decodeGates? : ℕ → List Bool → Option (RawCircuit × List Bool) + | 0, bits => some ([], bits) + | count + 1, bits => + match RawGate.decodePrefix? bits with + | none => none + | some (gate, rest) => + match decodeGates? count rest with + | none => none + | some (gates, rest) => some (gate :: gates, rest) + +/-- Serialize a circuit as its unary gate count followed by its gates. -/ +def encode (c : RawCircuit) : List Bool := + NatCode.encode c.length ++ c.flatMap RawGate.encode + +/-- Decode one circuit prefix and return the unconsumed suffix. -/ +def decodePrefix? (bits : List Bool) : Option (RawCircuit × List Bool) := + match NatCode.decodePrefix? bits with + | none => none + | some (count, rest) => decodeGates? count rest + +/-- Decode exactly one circuit. Any trailing bits are rejected. -/ +def decode? (bits : List Bool) : Option RawCircuit := + match decodePrefix? bits with + | some (c, []) => some c + | _ => none + +end RawCircuit + +/-- Translate a typed fan-in-two gate to the proof-free wire format. -/ +def RawGate.ofGate {W : ℕ} (g : Gate Basis.andOr2 W) : RawGate := by + have hfan : g.fanIn = 2 := fanIn_andOr2 g + exact + { op := g.op + input₀ := (g.inputs ⟨0, by omega⟩).val + input₁ := (g.inputs ⟨1, by omega⟩).val + negated₀ := g.negated ⟨0, by omega⟩ + negated₁ := g.negated ⟨1, by omega⟩ } + +/-- Translate a typed single-output circuit to an ordered raw circuit. + +Internal gates retain their order and the typed output gate is appended as the +last raw gate. -/ +def RawCircuit.ofCircuit {N G : ℕ} [NeZero N] + (c : Circuit Basis.andOr2 N 1 G) : RawCircuit := + List.ofFn (fun i : Fin G => RawGate.ofGate (c.gates i)) ++ + [RawGate.ofGate (c.outputs 0)] + +/-- Serialize a typed fan-in-two circuit as machine-facing bits. -/ +def encodeCircuit {N G : ℕ} [NeZero N] + (c : Circuit Basis.andOr2 N 1 G) : List Bool := + (RawCircuit.ofCircuit c).encode + +/-- Decode and evaluate a circuit code against an input of exactly `N` bits. -/ +def evalCode (N : ℕ) (code input : List Bool) : Option Bool := do + if input.length = N then + let circuit ← RawCircuit.decode? code + circuit.eval? input + else + none + +end CircuitCode + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Circuits/Encoding/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Circuits/Encoding/Internal.lean new file mode 100644 index 0000000000..f618af8072 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Circuits/Encoding/Internal.lean @@ -0,0 +1,9 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.Complexitylib.Circuits.Encoding.Internal.Codec + +/-! Supporting modules for Beyond the Bethe approximation of the permanent. -/ diff --git a/LeanPool/BeyondBethe/Complexitylib/Circuits/Encoding/Internal/Codec.lean b/LeanPool/BeyondBethe/Complexitylib/Circuits/Encoding/Internal/Codec.lean new file mode 100644 index 0000000000..ab8f266f74 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Circuits/Encoding/Internal/Codec.lean @@ -0,0 +1,552 @@ +/- +Copyright (c) 2025 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Circuits.Encoding.Defs +public import Std.Tactic.BVDecide.Normalize.Prop + +/-! +# Correctness of the machine-facing circuit codec + +This internal module proves that the proof-free encoding and iterative +evaluator in `Encoding.Defs` faithfully enforce their advertised syntactic +invariants. Semantic agreement with typed circuit evaluation is deliberately +kept in a separate proof layer. +-/ + + +public section + +namespace Complexity + +namespace CircuitCode + +namespace NatCode + +/-- The unary encoding of `n` uses exactly `n + 1` bits (`n` trues and a false). -/ +@[simp] theorem length_encode (n : ℕ) : (encode n).length = n + 1 := by + simp [encode] + +private theorem decodeAux?_replicate_true (n acc : ℕ) (suffix : List Bool) : + decodeAux? (List.replicate n true ++ false :: suffix) acc = + some (acc + n, suffix) := by + induction n generalizing acc with + | zero => simp [decodeAux?] + | succ n ih => + rw [List.replicate_succ, List.cons_append] + simp only [decodeAux?] + rw [ih] + congr 2 + omega + +/-- A unary field can be decoded in front of an arbitrary suffix. -/ +@[simp] theorem decodePrefix?_encode_append (n : ℕ) (suffix : List Bool) : + decodePrefix? (encode n ++ suffix) = some (n, suffix) := by + rw [decodePrefix?, encode, List.append_assoc] + change decodeAux? (List.replicate n true ++ false :: suffix) 0 = _ + simpa using decodeAux?_replicate_true n 0 suffix + +private theorem decodeAux?_sound {bits : List Bool} {acc n : ℕ} + {suffix : List Bool} (h : decodeAux? bits acc = some (n, suffix)) : + ∃ consumed : ℕ, + n = acc + consumed ∧ + bits = List.replicate consumed true ++ false :: suffix := by + induction bits generalizing acc with + | nil => simp [decodeAux?] at h + | cons bit bits ih => + cases bit with + | false => + simp only [decodeAux?] at h + cases h + exact ⟨0, by simp⟩ + | true => + simp only [decodeAux?] at h + obtain ⟨consumed, hn, hbits⟩ := ih h + refine ⟨consumed + 1, by omega, ?_⟩ + rw [List.replicate_succ] + simp [hbits] + +private theorem decodeAux?_eq_none_iff (bits : List Bool) (acc : ℕ) : + decodeAux? bits acc = none ↔ + bits = List.replicate bits.length true := by + induction bits generalizing acc with + | nil => simp [decodeAux?] + | cons bit bits ih => + cases bit <;> simp [decodeAux?, ih, List.replicate_succ] + +/-- Unary prefix decoding fails exactly when every available bit is a one, +so no zero terminator occurs. -/ +theorem decodePrefix?_eq_none_iff (bits : List Bool) : + decodePrefix? bits = none ↔ + bits = List.replicate bits.length true := by + simpa [decodePrefix?] using decodeAux?_eq_none_iff bits 0 + +/-- Successful unary prefix decoding reconstructs the consumed input exactly. -/ +theorem decodePrefix?_eq_some_iff (bits : List Bool) (n : ℕ) (suffix : List Bool) : + decodePrefix? bits = some (n, suffix) ↔ bits = encode n ++ suffix := by + constructor + · intro h + obtain ⟨consumed, hn, hbits⟩ := decodeAux?_sound h + simp only [decodePrefix?] at h + have : consumed = n := by omega + subst consumed + simpa [encode, List.append_assoc] using hbits + · rintro rfl + exact decodePrefix?_encode_append n suffix + +end NatCode + +namespace RawGate + +/-- The Boolean well-formedness check agrees with the `WellFormedAt` predicate. -/ +@[simp] theorem isWellFormedAt_eq_true (gate : RawGate) (available : ℕ) : + gate.isWellFormedAt available = true ↔ gate.WellFormedAt available := by + simp [isWellFormedAt] + +/-- Decoding a gate's operation bit recovers its operation. -/ +@[simp] theorem opOfBit_opBit (g : RawGate) : opOfBit g.opBit = g.op := by + cases g with + | mk op input₀ input₁ negated₀ negated₁ => cases op <;> rfl + +/-- A gate encoding uses five header/delimiter bits plus one bit per unary + input reference. -/ +@[simp] theorem length_encode (g : RawGate) : + g.encode.length = 5 + g.input₀ + g.input₁ := by + simp [encode, NatCode.length_encode] + omega + +/-- A gate can be decoded in front of an arbitrary suffix. -/ +@[simp] theorem decodePrefix?_encode_append (g : RawGate) (suffix : List Bool) : + decodePrefix? (g.encode ++ suffix) = some (g, suffix) := by + cases g with + | mk op input₀ input₁ negated₀ negated₁ => + cases op <;> + simp [encode, decodePrefix?, opBit, opOfBit, List.append_assoc] + +/-- Successful gate-prefix decoding reconstructs the consumed input exactly. -/ +theorem decodePrefix?_eq_some_iff (bits : List Bool) (gate : RawGate) + (suffix : List Bool) : + decodePrefix? bits = some (gate, suffix) ↔ bits = gate.encode ++ suffix := by + constructor + · intro h + cases bits with + | nil => simp [decodePrefix?] at h + | cons op bits => + cases bits with + | nil => simp [decodePrefix?] at h + | cons negated₀ bits => + cases bits with + | nil => simp [decodePrefix?] at h + | cons negated₁ rest => + cases h₀ : NatCode.decodePrefix? rest with + | none => simp [decodePrefix?, h₀] at h + | some parsed₀ => + obtain ⟨input₀, rest₀⟩ := parsed₀ + cases h₁ : NatCode.decodePrefix? rest₀ with + | none => simp [decodePrefix?, h₀, h₁] at h + | some parsed₁ => + obtain ⟨input₁, rest₁⟩ := parsed₁ + simp only [decodePrefix?, h₀, h₁] at h + cases h + have hrest₀ := + (NatCode.decodePrefix?_eq_some_iff rest input₀ rest₀).mp h₀ + have hrest₁ := + (NatCode.decodePrefix?_eq_some_iff rest₀ input₁ suffix).mp h₁ + cases op <;> + simp [encode, opBit, opOfBit, hrest₀, hrest₁, + List.append_assoc] + · rintro rfl + exact decodePrefix?_encode_append gate suffix + +end RawGate + +namespace RawCircuit + +/-- The Boolean well-formedness check agrees with the `WellFormed` predicate. -/ +@[simp] theorem isWellFormed_eq_true (circuit : RawCircuit) (N : ℕ) : + circuit.isWellFormed N = true ↔ circuit.WellFormed N := by + simp [isWellFormed] + +/-- Parsing an encoded gate list consumes exactly that list and leaves the + caller-supplied suffix untouched. -/ +@[simp] theorem decodeGates?_flatMap_encode_append + (c : RawCircuit) (suffix : List Bool) : + decodeGates? c.length (c.flatMap RawGate.encode ++ suffix) = some (c, suffix) := by + induction c with + | nil => simp [decodeGates?] + | cons gate gates ih => + simp [decodeGates?, ih, List.append_assoc] + +/-- A circuit prefix can be decoded in front of an arbitrary suffix. -/ +@[simp] theorem decodePrefix?_encode_append (c : RawCircuit) (suffix : List Bool) : + decodePrefix? (c.encode ++ suffix) = some (c, suffix) := by + simp [decodePrefix?, encode, List.append_assoc] + +/-- Exact decoding is a left inverse of circuit serialization. -/ +@[simp] theorem decode?_encode (c : RawCircuit) : decode? c.encode = some c := by + rw [show c.encode = c.encode ++ [] by simp] + unfold decode? + rw [decodePrefix?_encode_append] + +/-- Exact decoding rejects any nonempty suffix after a canonical encoding. -/ +theorem decode?_encode_append_eq_none (c : RawCircuit) {suffix : List Bool} + (h : suffix ≠ []) : decode? (c.encode ++ suffix) = none := by + simp [decode?, h] + +/-- A circuit encoding consists of the unary gate count followed by the + concatenated gate encodings. -/ +@[simp] theorem length_encode (c : RawCircuit) : + c.encode.length = c.length + 1 + (c.map fun gate => gate.encode.length).sum := by + simp [encode, NatCode.length_encode, List.length_flatMap] + +/-- Topological well-formedness of a nonempty gate list splits at its head. -/ +theorem topologicallyWellFormed_cons (N : ℕ) (gate : RawGate) (gates : RawCircuit) : + TopologicallyWellFormed N (gate :: gates) ↔ + gate.WellFormedAt N ∧ TopologicallyWellFormed (N + 1) gates := by + constructor + · intro h + constructor + · simpa [TopologicallyWellFormed] using h (0 : Fin (gate :: gates).length) + · intro i + have hi := h i.succ + change (gates.get i).WellFormedAt (N + (i.val + 1)) at hi + unfold RawGate.WellFormedAt at hi ⊢ + omega + · rintro ⟨hgate, hgates⟩ i + refine Fin.cases ?_ (fun j => ?_) i + · simpa using hgate + · have hj := hgates j + change (gates.get j).WellFormedAt (N + (j.val + 1)) + unfold RawGate.WellFormedAt at hj ⊢ + omega + +/-- Successful fixed-count gate decoding reconstructs the consumed input. -/ +theorem decodeGates?_eq_some_iff (count : ℕ) (bits : List Bool) + (circuit : RawCircuit) (suffix : List Bool) : + decodeGates? count bits = some (circuit, suffix) ↔ + circuit.length = count ∧ bits = circuit.flatMap RawGate.encode ++ suffix := by + constructor + · intro h + induction count generalizing bits circuit with + | zero => + simp only [decodeGates?] at h + cases h + simp + | succ count ih => + cases hgate : RawGate.decodePrefix? bits with + | none => simp [decodeGates?, hgate] at h + | some parsedGate => + obtain ⟨gate, rest⟩ := parsedGate + cases hgates : decodeGates? count rest with + | none => simp [decodeGates?, hgate, hgates] at h + | some parsedGates => + obtain ⟨gates, final⟩ := parsedGates + simp only [decodeGates?, hgate, hgates] at h + cases h + obtain ⟨hlen, hrest⟩ := ih rest gates hgates + have hbits := + (RawGate.decodePrefix?_eq_some_iff bits gate rest).mp hgate + constructor + · simp [hlen] + · rw [hbits, hrest] + simp [List.append_assoc] + · rintro ⟨hlen, rfl⟩ + subst count + exact decodeGates?_flatMap_encode_append circuit suffix + +/-- Successful circuit-prefix decoding reconstructs its canonical encoding. -/ +theorem decodePrefix?_eq_some_iff (bits : List Bool) (circuit : RawCircuit) + (suffix : List Bool) : + decodePrefix? bits = some (circuit, suffix) ↔ + bits = circuit.encode ++ suffix := by + constructor + · intro h + cases hcount : NatCode.decodePrefix? bits with + | none => simp [decodePrefix?, hcount] at h + | some parsedCount => + obtain ⟨count, rest⟩ := parsedCount + simp only [decodePrefix?, hcount] at h + have hbits := + (NatCode.decodePrefix?_eq_some_iff bits count rest).mp hcount + obtain ⟨hlen, hrest⟩ := + (decodeGates?_eq_some_iff count rest circuit suffix).mp h + rw [hbits, hrest] + simp [encode, hlen, List.append_assoc] + · rintro rfl + exact decodePrefix?_encode_append circuit suffix + +/-- Exact decoding succeeds precisely on canonical encodings. -/ +theorem decode?_eq_some_iff_internal (bits : List Bool) (circuit : RawCircuit) : + decode? bits = some circuit ↔ bits = circuit.encode := by + constructor + · intro h + cases hprefix : decodePrefix? bits with + | none => simp [decode?, hprefix] at h + | some parsed => + obtain ⟨decoded, suffix⟩ := parsed + cases suffix with + | nil => + simp only [decode?, hprefix] at h + cases h + simpa using (decodePrefix?_eq_some_iff bits circuit []).mp hprefix + | cons bit suffix => simp [decode?, hprefix] at h + · rintro rfl + exact decode?_encode circuit + +/-- Running the iterative evaluator succeeds exactly for topological gate lists. -/ +theorem evalAux?_isSome_iff (circuit : RawCircuit) (wires : Array Bool) : + (evalAux? circuit wires).isSome ↔ + circuit.TopologicallyWellFormed wires.size := by + induction circuit generalizing wires with + | nil => simp [evalAux?, TopologicallyWellFormed] + | cons gate gates ih => + rw [topologicallyWellFormed_cons] + simp only [evalAux?] + by_cases h₀ : gate.input₀ < wires.size + · rw [Array.getElem?_eq_getElem h₀] + by_cases h₁ : gate.input₁ < wires.size + · rw [Array.getElem?_eq_getElem h₁] + simp [ih, RawGate.WellFormedAt, h₀, h₁, Array.size_push] + · rw [Array.getElem?_eq_none (by omega)] + simp [RawGate.WellFormedAt, h₁] + · rw [Array.getElem?_eq_none (by omega)] + simp [RawGate.WellFormedAt, h₀] + +/-- Successful iterative evaluation appends exactly one wire per gate. -/ +theorem evalAux?_size {circuit : RawCircuit} {wires result : Array Bool} + (h : evalAux? circuit wires = some result) : + result.size = wires.size + circuit.length := by + induction circuit generalizing wires result with + | nil => + simp only [evalAux?] at h + cases h + simp + | cons gate gates ih => + cases h₀ : wires[gate.input₀]? with + | none => simp [evalAux?, h₀] at h + | some value₀ => + cases h₁ : wires[gate.input₁]? with + | none => simp [evalAux?, h₀, h₁] at h + | some value₁ => + simp only [evalAux?, h₀, h₁] at h + have hsize := ih h + rw [Array.size_push] at hsize + simpa [Nat.add_assoc, Nat.add_comm, Nat.add_left_comm] using hsize + +/-- Raw evaluation succeeds precisely for nonempty topologically ordered circuits. -/ +theorem eval?_isSome_iff_internal (circuit : RawCircuit) (input : List Bool) : + (circuit.eval? input).isSome ↔ circuit.WellFormed input.length := by + cases circuit with + | nil => simp [eval?, WellFormed] + | cons gate gates => + constructor + · intro h + cases haux : evalAux? (gate :: gates) input.toArray with + | none => simp [eval?, haux] at h + | some result => + have htop : + TopologicallyWellFormed input.toArray.size (gate :: gates) := + (evalAux?_isSome_iff (gate :: gates) input.toArray).mp (by simp [haux]) + constructor + · simp + · simpa using htop + · rintro ⟨_, htop⟩ + have htop' : + TopologicallyWellFormed input.toArray.size (gate :: gates) := by + simpa using htop + have hsome := + (evalAux?_isSome_iff (gate :: gates) input.toArray).mpr htop' + obtain ⟨result, haux⟩ := Option.isSome_iff_exists.mp hsome + have hsize := evalAux?_size haux + have hlt : + input.length + (gate :: gates).length - 1 < result.size := by + rw [hsize, List.size_toArray] + simp + rw [eval?] + simp only [List.isEmpty_cons, Bool.false_eq_true, if_false, haux] + change (result[input.length + (gate :: gates).length - 1]?).isSome + rw [Array.getElem?_eq_getElem hlt] + simp + +end RawCircuit + +/-- Code evaluation succeeds exactly when the input length is the declared arity, +the code is canonical, and the decoded raw circuit is well formed. -/ +theorem evalCode_isSome_iff (N : ℕ) (code input : List Bool) : + (evalCode N code input).isSome ↔ + input.length = N ∧ + ∃ circuit : RawCircuit, + code = circuit.encode ∧ circuit.WellFormed N := by + constructor + · intro h + by_cases hlen : input.length = N + · cases hdecode : RawCircuit.decode? code with + | none => simp [evalCode, hlen, hdecode] at h + | some circuit => + have heval : (circuit.eval? input).isSome := by + simpa [evalCode, hlen, hdecode] using h + have hwellInput := + (RawCircuit.eval?_isSome_iff_internal circuit input).mp heval + have hcode := + (RawCircuit.decode?_eq_some_iff_internal code circuit).mp hdecode + exact ⟨hlen, circuit, hcode, by simpa [hlen] using hwellInput⟩ + · simp [evalCode, hlen] at h + · rintro ⟨hlen, circuit, hcode, hwell⟩ + subst code + have heval : (circuit.eval? input).isSome := + (RawCircuit.eval?_isSome_iff_internal circuit input).mpr + (by simpa [hlen] using hwell) + simpa [evalCode, hlen] using heval + +namespace RawGate + +/-- The first raw reference is the first typed input wire. -/ +@[simp] theorem ofGate_input₀ {W : ℕ} (gate : Gate Basis.andOr2 W) : + (RawGate.ofGate gate).input₀ = (gate.inputs ⟨0, by rw [fanIn_andOr2 gate]; omega⟩).val := by + simp [RawGate.ofGate] + +/-- The second raw reference is the second typed input wire. -/ +@[simp] theorem ofGate_input₁ {W : ℕ} (gate : Gate Basis.andOr2 W) : + (RawGate.ofGate gate).input₁ = (gate.inputs ⟨1, by rw [fanIn_andOr2 gate]; omega⟩).val := by + simp [RawGate.ofGate] + +/-- Erasing a typed gate's proofs never introduces an out-of-range reference. -/ +theorem ofGate_wellFormedAt {W : ℕ} (gate : Gate Basis.andOr2 W) : + (RawGate.ofGate gate).WellFormedAt W := by + constructor <;> simp + +end RawGate + +namespace RawCircuit + +/-- Translating a typed single-output circuit produces one raw gate per +internal gate, followed by its output gate. -/ +@[simp] theorem length_ofCircuit {N G : ℕ} [NeZero N] + (c : Circuit Basis.andOr2 N 1 G) : + (ofCircuit c).length = G + 1 := by + simp [ofCircuit] + +/-- Translation preserves the typed circuit's topological ordering. -/ +theorem ofCircuit_topologicallyWellFormed {N G : ℕ} [NeZero N] + (c : Circuit Basis.andOr2 N 1 G) : + (ofCircuit c).TopologicallyWellFormed N := by + intro i + rw [List.get_eq_getElem] + change + (List.ofFn (fun j : Fin G => RawGate.ofGate (c.gates j)) ++ + [RawGate.ofGate (c.outputs 0)])[i.val].WellFormedAt (N + i.val) + by_cases hi : i.val < G + · rw [List.getElem_append_left (by simp [hi])] + rw [List.getElem_ofFn] + constructor + · rw [RawGate.ofGate_input₀] + exact c.acyclic ⟨i.val, hi⟩ + ⟨0, by rw [fanIn_andOr2 (c.gates ⟨i.val, hi⟩)]; omega⟩ + · rw [RawGate.ofGate_input₁] + exact c.acyclic ⟨i.val, hi⟩ + ⟨1, by rw [fanIn_andOr2 (c.gates ⟨i.val, hi⟩)]; omega⟩ + · have hieq : i.val = G := by + have := i.isLt + simp only [length_ofCircuit] at this + omega + rw [List.getElem_append_right (by simp; omega)] + simpa [hieq] using RawGate.ofGate_wellFormedAt (c.outputs 0) + +/-- Translation of a typed circuit is a valid raw single-output circuit. -/ +theorem ofCircuit_wellFormed {N G : ℕ} [NeZero N] + (c : Circuit Basis.andOr2 N 1 G) : + (ofCircuit c).WellFormed N := by + constructor + · intro hempty + have hlen := length_ofCircuit c + rw [hempty] at hlen + simp at hlen + · exact ofCircuit_topologicallyWellFormed c + +private theorem sum_encode_length_le (N : ℕ) (circuit : RawCircuit) + (hwell : circuit.TopologicallyWellFormed N) : + (circuit.map fun gate => gate.encode.length).sum ≤ + circuit.length * (2 * (N + circuit.length) + 5) := by + induction circuit generalizing N with + | nil => simp + | cons gate gates ih => + obtain ⟨hgate, hgates⟩ := + (topologicallyWellFormed_cons N gate gates).mp hwell + have hgateLength : gate.encode.length ≤ 2 * N + 5 := by + rw [RawGate.length_encode] + unfold RawGate.WellFormedAt at hgate + omega + have htail := ih (N + 1) hgates + let K := 2 * (N + (gate :: gates).length) + 5 + have htail' : + (gates.map fun next => next.encode.length).sum ≤ gates.length * K := by + simpa [K, Nat.add_assoc, Nat.add_comm, Nat.add_left_comm] using htail + have hgateLength' : gate.encode.length ≤ K := by + dsimp only [K] + simp only [List.length_cons] + omega + simp only [List.map_cons, List.sum_cons, List.length_cons] + calc + gate.encode.length + (gates.map fun next => next.encode.length).sum ≤ + K + gates.length * K := Nat.add_le_add hgateLength' htail' + _ = (gates.length + 1) * K := by + rw [Nat.add_mul] + simp [Nat.add_comm] + +/-- A generic topological raw circuit with `G` gates and input arity `N` has +quadratic-size unary encoding. -/ +theorem encode_length_le (N G : ℕ) (circuit : RawCircuit) + (hlen : circuit.length = G) + (hwell : circuit.TopologicallyWellFormed N) : + circuit.encode.length ≤ G + 1 + G * (2 * (N + G) + 5) := by + subst G + rw [RawCircuit.length_encode] + exact Nat.add_le_add_left (sum_encode_length_le N circuit hwell) _ + +end RawCircuit + +/-- A code produced from a typed circuit is evaluable exactly on inputs of +the circuit's declared arity. -/ +theorem evalCode_encodeCircuit_isSome_iff {N G : ℕ} [NeZero N] + (c : Circuit Basis.andOr2 N 1 G) (input : List Bool) : + (evalCode N (encodeCircuit c) input).isSome ↔ input.length = N := by + rw [evalCode_isSome_iff] + constructor + · exact And.left + · intro hlen + exact ⟨hlen, RawCircuit.ofCircuit c, rfl, RawCircuit.ofCircuit_wellFormed c⟩ + +/-- The unary encoding of a typed `G`-internal-gate circuit has a concrete +quadratic length bound. -/ +theorem encodeCircuit_length_le {N G : ℕ} [NeZero N] + (c : Circuit Basis.andOr2 N 1 G) : + (encodeCircuit c).length ≤ + (G + 1) + 1 + (G + 1) * (2 * (N + (G + 1)) + 5) := by + exact RawCircuit.encode_length_le N (G + 1) (RawCircuit.ofCircuit c) + (RawCircuit.length_ofCircuit c) (RawCircuit.ofCircuit_topologicallyWellFormed c) + +/-- In the library's size convention, which counts internal and output gates +but not primary inputs or free negations, unary circuit codes have quadratic +length in the input arity and circuit size. -/ +theorem encodeCircuit_length_le_size_internal {N G : ℕ} [NeZero N] + (c : Circuit Basis.andOr2 N 1 G) : + (encodeCircuit c).length ≤ + 1 + c.size * (2 * (N + c.size) + 6) := by + calc + (encodeCircuit c).length ≤ + (G + 1) + 1 + (G + 1) * (2 * (N + (G + 1)) + 5) := + encodeCircuit_length_le c + _ = 1 + c.size * (2 * (N + c.size) + 6) := by + simp only [Circuit.size] + conv_rhs => + rw [show 2 * (N + (G + 1)) + 6 = + (2 * (N + (G + 1)) + 5) + 1 by omega] + rw [Nat.mul_add] + omega + +end CircuitCode + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Classes.lean b/LeanPool/BeyondBethe/Complexitylib/Classes.lean new file mode 100644 index 0000000000..1bc004d062 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Classes.lean @@ -0,0 +1,18 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.Complexitylib.Classes.Containments +import LeanPool.BeyondBethe.Complexitylib.Classes.Exponential +import LeanPool.BeyondBethe.Complexitylib.Classes.FNP +import LeanPool.BeyondBethe.Complexitylib.Classes.L +import LeanPool.BeyondBethe.Complexitylib.Classes.NP +import LeanPool.BeyondBethe.Complexitylib.Classes.P +import LeanPool.BeyondBethe.Complexitylib.Classes.Pairing +import LeanPool.BeyondBethe.Complexitylib.Classes.Randomized +import LeanPool.BeyondBethe.Complexitylib.Classes.Space +import LeanPool.BeyondBethe.Complexitylib.Classes.Time + +/-! Supporting modules for Beyond the Bethe approximation of the permanent. -/ diff --git a/LeanPool/BeyondBethe/Complexitylib/Classes/Containments.lean b/LeanPool/BeyondBethe/Complexitylib/Classes/Containments.lean new file mode 100644 index 0000000000..53fa4c7c88 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Classes/Containments.lean @@ -0,0 +1,312 @@ +/- +Copyright (c) 2025 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Classes.P +public import LeanPool.BeyondBethe.Complexitylib.Classes.NP +public import LeanPool.BeyondBethe.Complexitylib.Classes.Randomized +public import LeanPool.BeyondBethe.Complexitylib.Classes.L +public import LeanPool.BeyondBethe.Complexitylib.Classes.Exponential + +/-! +# Containment relations between complexity classes + +This file collects the standard containment results between complexity classes. + +## Theorems + +- `DTIME_subset_NTIME` — `DTIME(T) ⊆ NTIME(T)` +- `P_subset_NP` — `P ⊆ NP` +- `DTIME_mono` — `T₁ =O T₂ → DTIME(T₁) ⊆ DTIME(T₂)` +- `NTIME_mono` — `T₁ =O T₂ → NTIME(T₁) ⊆ NTIME(T₂)` +- `DSPACE_mono` — `S₁ =O S₂ → DSPACE(S₁) ⊆ DSPACE(S₂)` +- `P_subset_EXP` — `P ⊆ EXP` +- `DTIME_subset_DSPACE` — `DTIME(T) ⊆ DSPACE(T)` (time bounds space) +- `P_subset_PSPACE` — `P ⊆ PSPACE` +- `RTIME_subset_NTIME` — `RTIME(T) ⊆ NTIME(T)` (one-sided error → nondeterministic) +- `RP_subset_NP` — `RP ⊆ NP` +- `DTIME_subset_BPTIME` — `DTIME(T) ⊆ BPTIME(T)` (deterministic → zero-error probabilistic) +- `P_subset_BPP` — `P ⊆ BPP` +- `NP_subset_NEXP` — `NP ⊆ NEXP` +- `EXP_subset_NEXP` — `EXP ⊆ NEXP` +- `BPTIME_subset_PPTIME` — `BPTIME(T) ⊆ PPTIME(T)` (bounded error → unbounded error) +- `BPP_subset_PP` — `BPP ⊆ PP` +- `P_compl` — `L ∈ P → Lᶜ ∈ P` (P closed under complement) +- `DSPACE_subset_NSPACE` — `DSPACE(S) ⊆ NSPACE(S)` +- `NSPACE_mono` — `S₁ =O S₂ → NSPACE(S₁) ⊆ NSPACE(S₂)` +- `L_subset_NL` — `L ⊆ NL` +- `ZPP_subset_RP` — `ZPP ⊆ RP` +- `ZPP_subset_coRP` — `ZPP ⊆ coRP` +- `DTIME_subset_NSPACE` — `DTIME(T) ⊆ NSPACE(T)` +- `P_subset_NPSPACE` — `P ⊆ NPSPACE` +- `P_subset_NEXP` — `P ⊆ NEXP` +- `P_subset_PP` — `P ⊆ PP` +- `P_union` — `L₁ ∈ P → L₂ ∈ P → L₁ ∪ L₂ ∈ P` (P closed under union) +- `P_inter` — `L₁ ∈ P → L₂ ∈ P → L₁ ∩ L₂ ∈ P` (P closed under intersection) +-/ + + +public section + +namespace Complexity + + +/-- **DTIME ⊆ NTIME**: every language decidable by a DTM in time `O(T)` is also + decidable by an NTM in time `O(T)`, via the `TM.toNTM` embedding. -/ +theorem DTIME_subset_NTIME (T : ℕ → ℕ) : DTIME T ⊆ NTIME T := by + intro L ⟨k, tm, f, hdec, hbig⟩ + exact ⟨k, tm.toNTM, f, tm.toNTM_decidesInTime hdec, hbig⟩ + +/-- **P ⊆ NP** -/ +theorem P_subset_NP : P ⊆ NP := + Set.iUnion_mono fun _ => DTIME_subset_NTIME _ + +/-- DTIME is monotone with respect to `=O`: if `T₁ =O T₂`, then `DTIME T₁ ⊆ DTIME T₂`. -/ +theorem DTIME_mono {T₁ T₂ : ℕ → ℕ} (h : T₁ =O T₂) : DTIME T₁ ⊆ DTIME T₂ := by + intro L ⟨k, tm, f, hdec, hbig⟩ + exact ⟨k, tm, f, hdec, hbig.trans h⟩ + +/-- **P ⊆ EXP**: every polynomial-time language is also exponential-time. -/ +theorem P_subset_EXP : P ⊆ EXP := + Set.iUnion_mono fun _ => DTIME_mono (BigO.of_le (fun _ => Nat.lt_two_pow_self.le)) + +/-- **DTIME ⊆ DSPACE**: a DTM running in time `T` uses at most + `O(T)` auxiliary space, since every two-way tape head can move at most one + cell per step. -/ +theorem DTIME_subset_DSPACE (T : ℕ → ℕ) : DTIME T ⊆ DSPACE T := by + intro L ⟨k, tm, f, hdec, hbig⟩ + refine ⟨k, tm, f, ⟨?_, ?_⟩, hbig⟩ + · -- Space bound: all reachable configurations obey the honest tape bounds + intro x c' hreach + obtain ⟨c_halt, t_halt, hle, hreachIn_halt, hhalt, _, _⟩ := hdec x + obtain ⟨t, hreachIn⟩ := TM.reaches_to_reachesIn tm hreach + have ht_le := TM.reachesIn_le_halt tm hreachIn hreachIn_halt hhalt + refine ⟨⟨?_, ?_⟩, ?_⟩ + · intro i + have hbound := TM.work_head_reachesIn_bound tm hreachIn i + have hzero := TM.initCfg_work_head_zero tm x i + omega + · have hbound := TM.input_head_reachesIn_bound tm hreachIn + have hzero := TM.initCfg_input_head_zero tm x + omega + · have hbound := TM.output_head_reachesIn_bound tm hreachIn + have hzero := TM.initCfg_output_head_zero tm x + omega + · -- Decision: reachesIn implies reaches, same output + intro x + obtain ⟨c', t, hle, hreachIn, hhalt, hyes, hno⟩ := hdec x + refine ⟨c', ?_, hhalt, hyes, hno⟩ + exact TM.reachesIn.rec Relation.ReflTransGen.refl + (fun hs _ ih => Relation.ReflTransGen.head hs ih) hreachIn + +/-- **P ⊆ PSPACE**: every polynomial-time language uses polynomial space. -/ +theorem P_subset_PSPACE : P ⊆ PSPACE := + Set.iUnion_mono fun _ => DTIME_subset_DSPACE _ + +/-- **RTIME ⊆ NTIME**: one-sided error implies nondeterministic. + The same NTM works: `RejectsWithProb 0` means no accepting paths for `x ∉ L`, + and `AcceptsWithProb (1/2)` means some accepting path exists for `x ∈ L`. -/ +theorem RTIME_subset_NTIME (T : ℕ → ℕ) : RTIME T ⊆ NTIME T := by + intro L ⟨k, tm, f, hhalt, hacc, hrej, hbig⟩ + refine ⟨k, tm, f, ⟨hhalt, fun x => ?_⟩, hbig⟩ + constructor + · -- x ∈ L → AcceptsInTime: acceptProb ≥ 1/2 > 0 implies ∃ accepting path + intro hx; by_contra hno + simp only [NTM.AcceptsInTime] at hno; push Not at hno + have hcount : tm.acceptCount x (f x.length) = 0 := by + simp only [NTM.acceptCount] + rw [Finset.filter_eq_empty_iff.mpr (fun ch _ => fun ⟨h1, h2⟩ => hno ch h1 h2)] + exact Finset.card_empty + have hprob := hacc x hx + simp [NTM.acceptProb, hcount] at hprob; norm_num at hprob + · -- AcceptsInTime → x ∈ L (contrapositive: x ∉ L → ¬AcceptsInTime) + intro ⟨choices, hhalt_ch, hout_ch⟩; by_contra hx + have hzero : tm.acceptProb x (f x.length) = 0 := + le_antisymm (hrej x hx) (by unfold NTM.acceptProb; positivity) + have hcount : tm.acceptCount x (f x.length) = 0 := by + unfold NTM.acceptProb at hzero + have h2T : (0:ℚ) < 2 ^ f x.length := by positivity + rw [div_eq_zero_iff] at hzero + cases hzero with + | inl h => exact_mod_cast h + | inr h => linarith + have hpos : 0 < tm.acceptCount x (f x.length) := by + unfold NTM.acceptCount + exact Finset.card_pos.mpr + ⟨choices, Finset.mem_filter.mpr ⟨Finset.mem_univ _, hhalt_ch, hout_ch⟩⟩ + omega + +/-- **RP ⊆ NP**. -/ +theorem RP_subset_NP : RP ⊆ NP := + Set.iUnion_mono fun _ => RTIME_subset_NTIME _ + +/-- **DTIME ⊆ BPTIME**: every deterministic TM can be viewed as a PTM with + zero error. When the DTM accepts, all paths accept (prob = 1 ≥ 2/3). + When it rejects, no path accepts (prob = 0 ≤ 1/3). -/ +theorem DTIME_subset_BPTIME (T : ℕ → ℕ) : DTIME T ⊆ BPTIME T := by + intro L ⟨k, tm, f, hdec, hbig⟩ + refine ⟨k, tm.toNTM, f, ?_, ?_, ?_, hbig⟩ + · -- AllPathsHaltIn: from toNTM_decidesInTime + exact (tm.toNTM_decidesInTime hdec).1 + · -- AcceptsWithProb L f (2/3): acceptProb ≥ 2/3 for x ∈ L + intro x hx + have ⟨c', t, hle, hreach, hhalt, hyes, _⟩ := hdec x + have htrace : ∀ ch, tm.toNTM.trace (f x.length) ch (tm.toNTM.initCfg x) = c' := + fun ch => tm.toNTM_trace_of_reachesIn hreach hhalt hle ch + -- acceptCount = 2^(f x.length) since all paths accept + have hcount : tm.toNTM.acceptCount x (f x.length) = 2 ^ f x.length := by + simp only [NTM.acceptCount] + have : (Finset.univ.filter fun (choices : Fin (f x.length) → Bool) => + let c' := tm.toNTM.trace (f x.length) choices (tm.toNTM.initCfg x) + c'.state = tm.toNTM.qhalt ∧ c'.output.cells 1 = Γ.one) = Finset.univ := by + ext ch; simp only [Finset.mem_filter, Finset.mem_univ, true_and] + rw [show (tm.toNTM.trace (f x.length) ch (tm.toNTM.initCfg x)) = c' from htrace ch] + exact ⟨fun _ => trivial, fun _ => ⟨hhalt, hyes hx⟩⟩ + rw [this, Finset.card_univ, Fintype.card_fun, Fintype.card_bool, Fintype.card_fin] + -- acceptProb = 1 + have hprob : tm.toNTM.acceptProb x (f x.length) = 1 := by + simp [NTM.acceptProb, hcount] + linarith + · -- RejectsWithProb L f (1/3): acceptProb ≤ 1/3 for x ∉ L + intro x hx + have ⟨c', t, hle, hreach, hhalt, _, hno⟩ := hdec x + have htrace : ∀ ch, tm.toNTM.trace (f x.length) ch (tm.toNTM.initCfg x) = c' := + fun ch => tm.toNTM_trace_of_reachesIn hreach hhalt hle ch + -- acceptCount = 0 since no path accepts + have hcount : tm.toNTM.acceptCount x (f x.length) = 0 := by + simp only [NTM.acceptCount] + rw [Finset.filter_eq_empty_iff.mpr] + · exact Finset.card_empty + · intro ch _ + rw [show (tm.toNTM.trace (f x.length) ch (tm.toNTM.initCfg x)) = c' from htrace ch] + intro ⟨_, h2⟩ + have := hno hx; simp_all + simp [NTM.acceptProb, hcount] + +/-- **P ⊆ BPP**: every polynomial-time language is also in BPP. -/ +theorem P_subset_BPP : P ⊆ BPP := + Set.iUnion_mono fun _ => DTIME_subset_BPTIME _ + +/-- NTIME is monotone: if `T₁ =O T₂`, then `NTIME T₁ ⊆ NTIME T₂`. -/ +theorem NTIME_mono {T₁ T₂ : ℕ → ℕ} (h : T₁ =O T₂) : NTIME T₁ ⊆ NTIME T₂ := by + intro L ⟨k, tm, f, hdec, hbig⟩ + exact ⟨k, tm, f, hdec, hbig.trans h⟩ + +/-- DSPACE is monotone: if `S₁ =O S₂`, then `DSPACE S₁ ⊆ DSPACE S₂`. -/ +theorem DSPACE_mono {S₁ S₂ : ℕ → ℕ} (h : S₁ =O S₂) : DSPACE S₁ ⊆ DSPACE S₂ := by + intro L ⟨k, tm, f, hdec, hbig⟩ + exact ⟨k, tm, f, hdec, hbig.trans h⟩ + +/-- **NP ⊆ NEXP**: every nondeterministic polynomial-time language is also + nondeterministic exponential-time. -/ +theorem NP_subset_NEXP : NP ⊆ NEXP := + Set.iUnion_mono fun _ => NTIME_mono (BigO.of_le (fun _ => Nat.lt_two_pow_self.le)) + +/-- **EXP ⊆ NEXP**: every deterministic exponential-time language is also + nondeterministic exponential-time. -/ +theorem EXP_subset_NEXP : EXP ⊆ NEXP := + Set.iUnion_mono fun _ => DTIME_subset_NTIME _ + +/-- **BPTIME ⊆ PPTIME**: two-sided bounded error implies unbounded error, + since 2/3 > 1/2 and 1/3 < 1/2. -/ +theorem BPTIME_subset_PPTIME (T : ℕ → ℕ) : BPTIME T ⊆ PPTIME T := by + intro L ⟨k, tm, f, hhalt, hacc, hrej, hbig⟩ + refine ⟨k, tm, f, hhalt, fun x => ⟨fun hx => ?_, fun hprob => ?_⟩, hbig⟩ + · -- x ∈ L → acceptProb > 1/2: acceptProb ≥ 2/3 > 1/2 + have := hacc x hx; linarith + · -- acceptProb > 1/2 → x ∈ L: contrapositive + by_contra hx + have := hrej x hx; linarith + +/-- **BPP ⊆ PP**. -/ +theorem BPP_subset_PP : BPP ⊆ PP := + Set.iUnion_mono fun _ => BPTIME_subset_PPTIME _ + +/-- **P is closed under complement**: if `L ∈ P` then `Lᶜ ∈ P`. -/ +theorem P_compl {L : Language} (h : L ∈ P) : Lᶜ ∈ P := by + obtain ⟨k, n_tapes, tm, f, hdec, hbig⟩ := Set.mem_iUnion.mp h + refine Set.mem_iUnion.mpr ⟨k + 1, n_tapes, tm.complementTM, fun n => 2 * f n + 4, + tm.complementTM_decidesInTime hdec, ?_⟩ + have hpow : f =O (· ^ (k + 1)) := hbig.trans (BigO.pow_le_pow_succ k) + exact BigO.add (BigO.const_mul_left 2 hpow) (BigO.const_le_pow 4 (k + 1)) + +/-- **DSPACE ⊆ NSPACE**: every language decidable by a DTM in space `O(S)` is also + decidable by an NTM in space `O(S)`, via the `TM.toNTM` embedding. -/ +theorem DSPACE_subset_NSPACE (S : ℕ → ℕ) : DSPACE S ⊆ NSPACE S := by + intro L ⟨k, tm, f, hdec, hbig⟩ + exact ⟨k, tm.toNTM, f, tm.toNTM_decidesInSpace hdec, hbig⟩ + +/-- NSPACE is monotone: if `S₁ =O S₂`, then `NSPACE S₁ ⊆ NSPACE S₂`. -/ +theorem NSPACE_mono {S₁ S₂ : ℕ → ℕ} (h : S₁ =O S₂) : NSPACE S₁ ⊆ NSPACE S₂ := by + intro L ⟨k, tm, f, hdec, hbig⟩ + exact ⟨k, tm, f, hdec, hbig.trans h⟩ + +/-- **L ⊆ NL**: every deterministic log-space transducer language is also in NL. -/ +theorem L_subset_NL : L ⊆ NL := by + intro L ⟨k, tm, f, htrans, hdec, hbig⟩ + exact ⟨k, tm.toNTM, f, tm.toNTM_isTransducer htrans, tm.toNTM_decidesInSpace hdec, hbig⟩ + +/-- **ZPP ⊆ RP**: zero-error probabilistic ⊆ one-sided error. -/ +theorem ZPP_subset_RP : ZPP ⊆ RP := Set.inter_subset_left + +/-- **ZPP ⊆ coRP**. -/ +theorem ZPP_subset_coRP : ZPP ⊆ coRP := Set.inter_subset_right + +/-- **ZPP ⊆ NP** via `ZPP ⊆ RP ⊆ NP`. -/ +theorem ZPP_subset_NP : ZPP ⊆ NP := ZPP_subset_RP.trans RP_subset_NP + +/-- **RP ⊆ NEXP** via `RP ⊆ NP ⊆ NEXP`. -/ +theorem RP_subset_NEXP : RP ⊆ NEXP := RP_subset_NP.trans NP_subset_NEXP + +/-- **ZPP ⊆ NEXP** via `ZPP ⊆ NP ⊆ NEXP`. -/ +theorem ZPP_subset_NEXP : ZPP ⊆ NEXP := ZPP_subset_NP.trans NP_subset_NEXP + +/-- **DTIME ⊆ NSPACE** (composition of `DTIME ⊆ DSPACE` and `DSPACE ⊆ NSPACE`). -/ +theorem DTIME_subset_NSPACE (T : ℕ → ℕ) : DTIME T ⊆ NSPACE T := + (DTIME_subset_DSPACE T).trans (DSPACE_subset_NSPACE T) + +/-- **P ⊆ NPSPACE** via `P ⊆ PSPACE ⊆ NPSPACE`. -/ +theorem P_subset_NPSPACE : P ⊆ NPSPACE := + Set.iUnion_mono fun _ => (DTIME_subset_DSPACE _).trans (DSPACE_subset_NSPACE _) + +/-- **P ⊆ NEXP** via `P ⊆ EXP ⊆ NEXP`. -/ +theorem P_subset_NEXP : P ⊆ NEXP := + P_subset_EXP.trans EXP_subset_NEXP + +/-- **P ⊆ PP** via `P ⊆ BPP ⊆ PP`. -/ +theorem P_subset_PP : P ⊆ PP := P_subset_BPP.trans BPP_subset_PP + +/-- **P is closed under union**: derived from `DTIME_union` and + polynomial-bound composition. -/ +theorem P_union {L₁ L₂ : Language} (h₁ : L₁ ∈ P) (h₂ : L₂ ∈ P) : L₁ ∪ L₂ ∈ P := by + obtain ⟨k₁, hdt₁⟩ := Set.mem_iUnion.mp h₁ + obtain ⟨k₂, hdt₂⟩ := Set.mem_iUnion.mp h₂ + have hunion := DTIME_union hdt₁ hdt₂ + refine Set.mem_iUnion.mpr ⟨max k₁ k₂, DTIME_mono ?_ hunion⟩ + exact BigO.add + (BigO.pow_le_pow_right (Nat.le_max_left k₁ k₂)) + (BigO.pow_le_pow_right (Nat.le_max_right k₁ k₂)) + +/-- **P is closed under intersection**: via `L₁ ∩ L₂ = (L₁ᶜ ∪ L₂ᶜ)ᶜ`. -/ +theorem P_inter {L₁ L₂ : Language} (h₁ : L₁ ∈ P) (h₂ : L₂ ∈ P) : L₁ ∩ L₂ ∈ P := by + have hcomp : (L₁ᶜ ∪ L₂ᶜ)ᶜ ∈ P := P_compl (P_union (P_compl h₁) (P_compl h₂)) + have heq : (L₁ᶜ ∪ L₂ᶜ)ᶜ = L₁ ∩ L₂ := by + ext x; simp + rwa [heq] at hcomp + +/-- **P is closed under set difference**: `L₁ \ L₂ = L₁ ∩ L₂ᶜ`. -/ +theorem P_diff {L₁ L₂ : Language} (h₁ : L₁ ∈ P) (h₂ : L₂ ∈ P) : L₁ \ L₂ ∈ P := by + rw [Set.diff_eq] + exact P_inter h₁ (P_compl h₂) + +/-- **P is closed under symmetric difference**: + `L₁ △ L₂ = (L₁ \ L₂) ∪ (L₂ \ L₁)`. Together with `P_compl`/`P_union`/`P_inter` + this makes `P` a Boolean subalgebra of the languages. -/ +theorem P_symmDiff {L₁ L₂ : Language} (h₁ : L₁ ∈ P) (h₂ : L₂ ∈ P) : + (L₁ \ L₂) ∪ (L₂ \ L₁) ∈ P := + P_union (P_diff h₁ h₂) (P_diff h₂ h₁) + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Classes/Exponential.lean b/LeanPool/BeyondBethe/Complexitylib/Classes/Exponential.lean new file mode 100644 index 0000000000..a3ba40ed44 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Classes/Exponential.lean @@ -0,0 +1,32 @@ +/- +Copyright (c) 2025 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Classes.Time + +/-! +# Exponential time complexity classes + +This file defines **EXP** and **NEXP**, the exponential-time analogues of P +and NP respectively. +-/ + + +@[expose] public section + +namespace Complexity + +/-- **EXP** is the class of languages decidable by a deterministic TM in + exponential time: `EXP = ⋃_k DTIME(2^(n^k))`. -/ +def EXP : Set Language := + ⋃ k : ℕ, DTIME (fun n => 2 ^ n ^ k) + +/-- **NEXP** is the class of languages decidable by a nondeterministic TM in + exponential time: `NEXP = ⋃_k NTIME(2^(n^k))`. -/ +def NEXP : Set Language := + ⋃ k : ℕ, NTIME (fun n => 2 ^ n ^ k) + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Classes/FNP.lean b/LeanPool/BeyondBethe/Complexitylib/Classes/FNP.lean new file mode 100644 index 0000000000..8290e48860 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Classes/FNP.lean @@ -0,0 +1,9 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.Complexitylib.Classes.FNP.Defs + +/-! Supporting modules for Beyond the Bethe approximation of the permanent. -/ diff --git a/LeanPool/BeyondBethe/Complexitylib/Classes/FNP/Defs.lean b/LeanPool/BeyondBethe/Complexitylib/Classes/FNP/Defs.lean new file mode 100644 index 0000000000..cb98389931 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Classes/FNP/Defs.lean @@ -0,0 +1,43 @@ +/- +Copyright (c) 2025 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Classes.Pairing +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Defs + +/-! +# FNP and TFNP — Definitions + +Core definitions for the function/search complexity classes **FNP** and **TFNP**, +and the `OrRelation` combinator used to construct TFNP problems from +NP ∩ coNP witness pairs. +-/ + + +@[expose] public section + +namespace Complexity + +/-- **FNP** is the class of search problems defined by NP relations: binary + relations that are polynomially balanced and decidable in polynomial time. + A relation `R` is in FNP if witnesses have poly-bounded length and the + pair language `{pair(x, y) | R x y}` is in P. -/ +def FNP : Set (List Bool → List Bool → Prop) := + {R | PolyBalanced R ∧ pairLang R ∈ P} + +/-- **TFNP** is the class of total FNP search problems: every instance has at + least one witness. -/ +def TFNP : Set (List Bool → List Bool → Prop) := + {R ∈ FNP | ∀ x, ∃ y, R x y} + +/-- Combine two witness relations by disjunction. Used to construct TFNP + problems from NP ∩ coNP witness pairs: the combined relation accepts any + witness valid for either component. -/ +def OrRelation (R₁ R₂ : List Bool → List Bool → Prop) : + List Bool → List Bool → Prop := + fun x y => R₁ x y ∨ R₂ x y + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Classes/L.lean b/LeanPool/BeyondBethe/Complexitylib/Classes/L.lean new file mode 100644 index 0000000000..2f3ee640d7 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Classes/L.lean @@ -0,0 +1,70 @@ +/- +Copyright (c) 2025 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Classes.Time +public import LeanPool.BeyondBethe.Complexitylib.Classes.Pairing + +/-! +# Log-space transducer classes + +This file defines the log-space complexity classes **L**, **NL**, **coNL**, +**FL**, and the search problem classes **FNL**, **TFNL**. + +These classes use the library's honest auxiliary-space convention: work-tape +travel is bounded, excess input-head travel is charged, and language deciders +also charge two-way output-tape travel beyond the verdict cell. They additionally +use the *transducer* discipline (`IsTransducer`), under which the output head +never moves left. `TM.ComputesInSpace` includes this discipline internally so +function output may have unbounded length without becoming read-write workspace. +-/ + + +@[expose] public section + +namespace Complexity + + +/-- **L** (LOGSPACE) is the class of languages decidable by a deterministic + log-space transducer: a DTM with `O(log n)` auxiliary space whose output + tape head never moves left. The transducer constraint prevents the output + tape from being used as extra workspace beyond the space bound. -/ +def L : Set Language := + {Lang | ∃ (k : ℕ) (tm : TM k) (f : ℕ → ℕ), + tm.IsTransducer ∧ tm.DecidesInSpace Lang f ∧ f =O (fun n => Nat.log 2 n)} + +/-- **NL** is the class of languages decidable by a nondeterministic log-space + transducer: an NTM with `O(log n)` auxiliary space whose output tape head + never moves left. -/ +def NL : Set Language := + {Lang | ∃ (k : ℕ) (tm : NTM k) (f : ℕ → ℕ), + tm.IsTransducer ∧ tm.DecidesInSpace Lang f ∧ f =O (fun n => Nat.log 2 n)} + +/-- **coNL** is the class of languages whose complements are in NL. + By the Immerman-Szelepcsényi theorem coNL = NL, but this is nontrivial. -/ +def coNL : Set Language := complClass NL + +/-- **FL** is the class of functions computable by a deterministic log-space + transducer: a DTM with `O(log n)` auxiliary space whose output tape head + never moves left. -/ +def FL : Set (List Bool → List Bool) := + {f | ∃ (k : ℕ) (tm : TM k) (S : ℕ → ℕ), + tm.ComputesInSpace f S ∧ S =O (fun n => Nat.log 2 n)} + +/-- **FNL** is the class of search problems with log-space verifiable relations: + binary relations that are polynomially balanced (witnesses have poly-bounded + length) and whose pair language is decidable in L (deterministic log space). + + This parallels FNP, which uses P (deterministic poly time) for verification. -/ +def FNL : Set (List Bool → List Bool → Prop) := + {R | PolyBalanced R ∧ pairLang R ∈ L} + +/-- **TFNL** is the class of total FNL search problems: every instance has at + least one witness. -/ +def TFNL : Set (List Bool → List Bool → Prop) := + {R ∈ FNL | ∀ x, ∃ y, R x y} + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Classes/NP.lean b/LeanPool/BeyondBethe/Complexitylib/Classes/NP.lean new file mode 100644 index 0000000000..d7fdac9a16 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Classes/NP.lean @@ -0,0 +1,37 @@ +/- +Copyright (c) 2025 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Classes.Time +public import LeanPool.BeyondBethe.Complexitylib.Classes.Space + +/-! +# NP, coNP, and NPSPACE + +This file defines **NP** (nondeterministic polynomial time), **coNP**, and +**NPSPACE** (nondeterministic polynomial space) in terms of the base classes +`NTIME` and `NSPACE`. +-/ + + +@[expose] public section + +namespace Complexity + +/-- **NP** is the class of languages decidable by a nondeterministic TM in + polynomial time: `NP = ⋃_k NTIME(n^k)`. -/ +def NP : Set Language := + ⋃ k : ℕ, NTIME (· ^ k) + +/-- **coNP** is the class of languages whose complements are in NP. -/ +def coNP : Set Language := complClass NP + +/-- **NPSPACE** is the class of languages decidable by a nondeterministic TM + using polynomial auxiliary space: `NPSPACE = ⋃_k NSPACE(n^k)`. -/ +def NPSPACE : Set Language := + ⋃ k : ℕ, NSPACE (· ^ k) + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Classes/NP/Witness.lean b/LeanPool/BeyondBethe/Complexitylib/Classes/NP/Witness.lean new file mode 100644 index 0000000000..c5d41fcc44 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Classes/NP/Witness.lean @@ -0,0 +1,157 @@ +/- +Copyright (c) 2025 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Classes.NP +public import LeanPool.BeyondBethe.Complexitylib.Classes.FNP.Defs + +/-! +# NP witness characterization + +This file states and (up to a single TM-engineering lemma) proves the +textbook characterization of `NP` via FNP witness relations: + +> A language `L` is in `NP` iff there is an FNP relation `R` such that +> `x ∈ L ↔ ∃ y, R x y`. + +The forward direction (`NP ⊆ witness form`) is a *computation-path* witness +argument and is left for a later pass. + +The reverse direction — **the FNP ⇒ NP bridge** used by SAT ∈ NP — is +captured here by `mem_NP_of_FNP_witness`, parameterized by the single +TM-engineering construction interface `WitnessNTMConstruction`: build the +nondeterministic "guess-and-verify" machine from a deterministic verifier +of `pairLang R`. Everything above that construction — unpacking FNP, +computing polynomial bounds, and packaging the result as membership in +`NP` — is proved here unconditionally. + +## Proof strategy for `WitnessNTMConstruction` + +Given: +- a DTM `M` deciding `pairLang R` in polynomial time, and +- a polynomial `p` bounding witness length (`PolyBalanced R`), + +construct an NTM `N` that, on input `x`: + +1. **Guess phase.** Reads `p.eval |x|` nondeterministic bits and writes them + onto a dedicated work tape as a guessed witness `y`. +2. **Pair construction.** Copies `pair(x, y)` onto another work tape using + `x` from the input tape and the guessed `y` from the witness tape. +3. **Verification.** Simulates `M` on the constructed pair (reading from + the work tape that holds `pair(x, y)` instead of the input tape). + +The total running time is polynomial: `O(p(n) + n + T(2n + p(n) + 2))` +where `T(n) = n^c` bounds `M`. + +The construction is mechanical but substantial — analogous in size to the +existing `unionTM`/`seqTM` combinators — and is deferred to a later pass. +All downstream consequences (including `SAT ∈ NP` conditional on the SAT +verifier being in P) rest only on that single lemma. +-/ + + +public section + +namespace Complexity + + +namespace NP + +/-- The witness language of a relation `R` — the set of inputs `x` that + admit some witness. Isolated as a definition so the statement of + `mem_NP_of_FNP_witness` reads cleanly. -/ +def witnessLang (R : List Bool → List Bool → Prop) : Language := + {x | ∃ y, R x y} + +/-- Membership in `witnessLang R` unfolds to the existence of a witness: + `x ∈ witnessLang R ↔ ∃ y, R x y`. -/ +@[simp] theorem mem_witnessLang {R : List Bool → List Bool → Prop} {x : List Bool} : + x ∈ witnessLang R ↔ ∃ y, R x y := Iff.rfl + +-- ════════════════════════════════════════════════════════════════════════ +-- The core TM-engineering construction interface +-- ════════════════════════════════════════════════════════════════════════ + +/-- **Guess-and-verify NTM construction interface.** Given a DTM `M` deciding + `pairLang R` within a time bound `T(n) ≤ O(n^c)` and a polynomial `p` + bounding witness length, there exists an NTM deciding + `witnessLang R = {x | ∃ y, R x y}` in polynomial time. + + The construction is the standard Arora-Barak guess-and-verify: + nondeterministically write a witness of length `≤ p(|x|)` onto a work + tape, build `pair(x, y)` on another work tape, then simulate `M`. + + This is isolated as a named proposition so results can state precisely + when they rely on the still-to-be-built machine construction, instead of + importing an unproved theorem. + + ## Supporting utilities + When implementing this construction, the following lemmas from + `Complexitylib.Asymptotics` will be useful for packaging the running-time + bound of the constructed NTM: + - `BigO.pow_polynomial_bound` — turn the hypothesis `f =O (·^c)` into + an explicit `Polynomial ℕ` bound on `f`. + - `BigO.of_polynomial_bound` — turn the computed polynomial bound on + the constructed NTM's running time back into `g =O (·^d)`. + The `pair_length` simp lemma in `Complexitylib.Classes.Pairing` gives + `|pair x y| = 2·|x| + 2 + |y|`, needed when substituting the simulated + verifier's input length. -/ +def WitnessNTMConstruction : Prop := + ∀ {R : List Bool → List Bool → Prop} + {p : Polynomial ℕ} {c k : ℕ} + {M : TM k} {f : ℕ → ℕ}, + (∀ x y, R x y → y.length ≤ p.eval x.length) → + M.DecidesInTime (pairLang R) f → + f =O (· ^ c) → + ∃ (k' d : ℕ) (N : NTM k') (g : ℕ → ℕ), + N.DecidesInTime (witnessLang R) g ∧ g =O (· ^ d) + +-- ════════════════════════════════════════════════════════════════════════ +-- Main theorem: FNP witness relations put L in NP +-- ════════════════════════════════════════════════════════════════════════ + +/-- **FNP ⇒ NP via witnesses.** If the generic guess-and-verify construction + has been implemented, `R ∈ FNP`, and `x ∈ L ↔ ∃ y, R x y`, then + `L ∈ NP`. Proof: unpack FNP to get a polynomial-time DTM verifier + `M` for `pairLang R` and a polynomial witness-length bound, apply the + construction to build the guess-and-verify NTM, and package the result as + NP membership. -/ +theorem mem_NP_of_FNP_witness + (hwitness : WitnessNTMConstruction) + {R : List Bool → List Bool → Prop} {L : Language} + (hR : R ∈ FNP) + (hchar : ∀ x, x ∈ L ↔ ∃ y, R x y) : + L ∈ NP := by + obtain ⟨hPB, hPairP⟩ := hR + -- Unpack `pairLang R ∈ P` to a DTM and a poly time bound. + obtain ⟨c, k, M, f, hM, hfO⟩ := Set.mem_iUnion.mp hPairP + -- Unpack `PolyBalanced R` to a polynomial witness-length bound. + obtain ⟨p, hp⟩ := hPB + -- Build the NTM via the core construction. + obtain ⟨k', d, N, g, hN, hgO⟩ := hwitness hp hM hfO + -- `L = witnessLang R` up to set extensionality. + have hLeq : L = witnessLang R := Set.ext fun x => by + simpa [witnessLang] using hchar x + -- Conclude. + rw [hLeq] + exact Set.mem_iUnion.mpr ⟨d, k', N, g, hN, hgO⟩ + +-- ════════════════════════════════════════════════════════════════════════ +-- Immediate corollary: FNP ⇔ NP-witness (the "reverse direction" only) +-- ════════════════════════════════════════════════════════════════════════ + +/-- **Restatement in terms of `witnessLang`.** If `R ∈ FNP`, then + `witnessLang R ∈ NP`. This is the useful form for applying to + concrete relations like `Witness`. -/ +theorem witnessLang_mem_NP_of_FNP + (hwitness : WitnessNTMConstruction) + {R : List Bool → List Bool → Prop} (hR : R ∈ FNP) : + witnessLang R ∈ NP := + mem_NP_of_FNP_witness hwitness hR fun _ => Iff.rfl + +end NP + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Classes/P.lean b/LeanPool/BeyondBethe/Complexitylib/Classes/P.lean new file mode 100644 index 0000000000..aa674224f4 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Classes/P.lean @@ -0,0 +1,70 @@ +/- +Copyright (c) 2025 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ +module +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Defs +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Internal +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.NormalForm +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Composition +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.PairWithInput +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Preimage +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.UnaryLength +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.FinsetDomain +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.CopyOutput + +/-! +# P — surface layer + +This file aggregates the definitions and theorems for P, FP, and PSPACE. + +## Definitions (from `P/Defs.lean`) + +- `P` — polynomial time: `⋃ k, DTIME(n^k)` +- `FP` — functions computable in polynomial time +- `PSPACE` — polynomial space: `⋃ k, DSPACE(n^k)` + +## Theorems + +- `DTIME_union` — DTIME is closed under union (AB Claim 1.5) +- `id_mem_FP` — the identity function is computable in linear time +- `mem_P_iff_decidesInTime_polynomial` — polynomial-evaluation normal form for `P` +- `mem_FP_iff_computesInTime_polynomial` — polynomial-evaluation normal form +- `mem_FP_comp` — `FP` is closed under function composition +- `mem_FP_pairWithInput` — an `FP` result can be paired with its original input +- `mem_P_preimage` — `P` is closed under preimages of functions in `FP` +- `unaryLength_mem_FP` — materializing the unary input length belongs to `FP` +- `ite_mem_finset_mem_FP` — functions supported on a finite set belong to `FP` +- `CobhamFP_eq_FP` — Cobham's machine-independent characterization of `FP` +-/ + + +public section + +namespace Complexity + + +/-- **DTIME is closed under union** (AB Claim 1.5): if `L₁ ∈ DTIME(T₁)` and + `L₂ ∈ DTIME(T₂)`, then `L₁ ∪ L₂ ∈ DTIME(T₁ + T₂)`. -/ +theorem DTIME_union {T₁ T₂ : ℕ → ℕ} {L₁ L₂ : Language} + (h₁ : L₁ ∈ DTIME T₁) (h₂ : L₂ ∈ DTIME T₂) : + L₁ ∪ L₂ ∈ DTIME (fun n => T₁ n + T₂ n) := by + obtain ⟨k₁, tm₁, f₁, hd₁, ho₁⟩ := h₁ + obtain ⟨k₂, tm₂, f₂, hd₂, ho₂⟩ := h₂ + exact ⟨k₁ + 1 + k₂, TM.unionTM tm₁ tm₂, fun n => 10 * f₁ n + f₂ n, + TM.unionTM_decidesInTime hd₁ hd₂, + bigO_union_bound ho₁ ho₂⟩ + +/-- **The identity function belongs to `FP`.** The executable + `copyInputToOutputTM` copies the input to the output in `n + 2` steps, and + this concrete bound is linear. -/ +theorem id_mem_FP : id ∈ FP := by + refine ⟨1, 0, TM.copyInputToOutputTM, (fun n => n + 2), ?_, ?_⟩ + · exact TM.copyInputToOutputTM_computesInTime 0 + · have hn : (fun n : ℕ => n) =O (· ^ 1) := by + simpa [pow_one] using BigO.refl (fun n : ℕ => n) + exact BigO.add hn (BigO.const_le_pow 2 1) + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham.lean b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham.lean new file mode 100644 index 0000000000..7a3371db6d --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham.lean @@ -0,0 +1,95 @@ +/- +Copyright (c) 2026 Bolton Bailey. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Bolton Bailey +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Defs +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Vec +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Defs +import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal + +/-! +# Cobham's characterization of FP — surface layer + +Cobham's theorem (1965): the machine-independent function algebra +`Complexity.Cobham` of `Complexitylib.Classes.P.Cobham.Defs` carves out exactly +the polynomial-time computable string functions. + +## Main results + +- `Cobham.cobham_iff_FPn` — the characterization at every fixed arity +- `CobhamFP_subset_FP` — every function of the algebra is polynomial-time +- `FP_subset_CobhamFP` — every polynomial-time function is in the algebra +- `CobhamFP_eq_FP` — **Cobham's theorem**, the two directions together + +## How the two directions are proved + +Both halves live in `Complexitylib.Classes.P.Cobham.Internal`. + +*Soundness* is the induction `Cobham f → FPn f` over the six constructors, where +`Cobham.FPn` lifts `FP` to argument vectors through the tuple encoding +`Cobham.encodeVec`. Four constructors are bespoke transducers +(`Cobham.cons_mem_FP`, `fstBlock_mem_FP`, `sndBlock_mem_FP`, `reorder_mem_FP`, +`mulLenFn_mem_FP`); the fifth, `boundedRec`, is a loop: recursion on notation is +a fold (`Cobham.recFold_eq_recNotation`), Cobham's side condition makes its width +clamp vacuous (`Cobham.recFoldClamp_eq_recFold`), and `Cobham.iterate_mem_FP` +runs the clamped step once per bit under a polynomial ruler. + +*Completeness* simulates a polynomial-time machine inside the algebra. A whole +configuration is one block-aligned bitstring with each tape split at its head, so +a head move is a two-bit shift (`Cobham.cfgCode`); the transition function is the +finite table `Cobham.stepFn`; the run is `Cobham.iterFn` under a clock built from +`smash` (`Cobham.exists_pow_clock`); and the output is read off the output tape +after a rewind (`Cobham.rewindFn`). The assembly is `Cobham.simFn_eq`. +-/ + + +public section + +namespace Complexity + +namespace Cobham + +/-- The canonical fixed-arity tuple encoding is itself a member of Cobham's +algebra. -/ +theorem encodeVec_mem {n : ℕ} : Cobham (@encodeVec n) := + encodeVec_mem_internal + +/-- Multi-arity completeness: every function that is polynomial-time on encoded +argument vectors belongs to Cobham's algebra. -/ +theorem FPn_imp_cobham {n : ℕ} {f : (Fin n → List Bool) → List Bool} : + FPn f → Cobham f := + FPn_imp_cobham_internal + +/-- **Cobham's theorem at every fixed arity.** A function belongs to Cobham's +algebra exactly when it is polynomial-time on the canonical encoded vectors. -/ +theorem cobham_iff_FPn {n : ℕ} {f : (Fin n → List Bool) → List Bool} : + Cobham f ↔ FPn f := + ⟨cobham_imp_FPn, FPn_imp_cobham⟩ + +end Cobham + +/-- Cobham's algebra is sound for polynomial time: every function of the (unary +fragment of the) algebra is computable by a deterministic TM in polynomial time. + +The multi-arity soundness induction `Cobham.cobham_imp_FPn`, specialized to +arity one. -/ +theorem CobhamFP_subset_FP : CobhamFP ⊆ FP := + Cobham.CobhamFP_subset_FP_of_FPn + +/-- Cobham's algebra is complete for polynomial time: every polynomial-time +computable function belongs to the algebra. + +Proved by simulating the machine inside the algebra (`Cobham.simFn_eq`). -/ +theorem FP_subset_CobhamFP : FP ⊆ CobhamFP := + Cobham.FP_subset_CobhamFP_internal + +/-- **Cobham's theorem** (1965): the machine-independent function algebra of +`Complexitylib.Classes.P.Cobham.Defs` characterizes exactly the polynomial-time +computable string functions. -/ +theorem CobhamFP_eq_FP : CobhamFP = FP := + Set.Subset.antisymm CobhamFP_subset_FP FP_subset_CobhamFP + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Defs.lean b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Defs.lean new file mode 100644 index 0000000000..ed5d0de947 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Defs.lean @@ -0,0 +1,131 @@ +/- +Copyright (c) 2026 Bolton Bailey. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Bolton Bailey +-/ + +module +public import Mathlib.Data.Fin.Tuple.Basic + +/-! +# Cobham's characterization of FP — definitions + +This file defines Cobham's machine-independent characterization of the polynomial-time +computable functions on bitstrings (Cobham, *The intrinsic computational difficulty of +functions*, 1965): the smallest class of functions `(Fin n → List Bool) → List Bool` +containing the projections, the empty string, the two bit successors, and the smash +function, and closed under composition and **limited recursion on notation**. + +Bitstrings are LSB-first: in the recursion on notation, the head of the list is the +least-significant (innermost) bit, so the bit successors *prepend* a bit +(`x ↦ b :: x`, the string analogue of `n ↦ 2·n + bit`), and recursion on notation +peels bits off the head. + +The functions are multi-arity (indexed by `Fin n` argument vectors) because limited +recursion on notation inherently produces functions of higher arity; the unary fragment +is collected in `CobhamFP`, which `Complexitylib.Classes.P.Cobham` proves equal to the +machine class `FP`. + +## Main definitions + +- `Complexity.smash` — binary-word smash: `1^(|x| · |y|)` +- `Complexity.recNotation` — the recursion-on-notation combinator +- `Complexity.Cobham` — the inductive predicate carving out Cobham's function algebra +- `Complexity.CobhamFP` — the unary fragment, as a set of string functions + +## Design notes + +The bound in `Cobham.boundedRec` follows Cobham's original formulation: the recursively +defined function must be *length-bounded by another function of the class* (rather than +by an external polynomial). Together with `smash` and the successors this realizes +exactly the polynomial length bounds, which is what makes the class no larger than `FP`; +dropping the bound would admit iterated doubling and hence exponential growth. + +The string toolkit the proof is written in — bit dispatch, flags, fixed-width blocks +— is not part of this statement and lives in +`Complexitylib.Classes.P.Cobham.Internal.Blocks`. +-/ + + +@[expose] public section + +namespace Complexity + +/-- **Cobham's smash function** in the binary-word presentation: +`smash x y = 1^(|x| · |y|)`. This is the length-arithmetic engine of the class: +composing `smash` with the bit successors and projections realizes every polynomial +length bound, which is what lets `Cobham.boundedRec` bound recursions by a function of +the class itself. + +This all-one word is the customary string analogue of Cobham's original +number-theoretic smash `x # y = 2^(|x|·|y|)`. -/ +def smash (x y : List Bool) : List Bool := + List.replicate (x.length * y.length) true + +@[simp] theorem smash_length (x y : List Bool) : + (smash x y).length = x.length * y.length := by + simp [smash] + + +/-- **Recursion on notation**: the string analogue of primitive recursion, recursing on +the bit structure of the first argument. + +`recNotation g h₀ h₁ x v` computes `g v` when `x` is empty, and on `b :: x` applies the +step function selected by the bit `b` to the argument vector consisting of the tail +`x`, the recursive value on the tail, and the parameters `v`. -/ +def recNotation {n : ℕ} (g : (Fin n → List Bool) → List Bool) + (h₀ h₁ : (Fin (n + 2) → List Bool) → List Bool) : + List Bool → (Fin n → List Bool) → List Bool + | [], v => g v + | b :: x, v => + (bif b then h₁ else h₀) (Fin.cons x (Fin.cons (recNotation g h₀ h₁ x v) v)) + +@[simp] theorem recNotation_nil {n : ℕ} (g : (Fin n → List Bool) → List Bool) + (h₀ h₁ : (Fin (n + 2) → List Bool) → List Bool) (v : Fin n → List Bool) : + recNotation g h₀ h₁ [] v = g v := rfl + +@[simp] theorem recNotation_cons {n : ℕ} (g : (Fin n → List Bool) → List Bool) + (h₀ h₁ : (Fin (n + 2) → List Bool) → List Bool) (b : Bool) (x : List Bool) + (v : Fin n → List Bool) : + recNotation g h₀ h₁ (b :: x) v = + (bif b then h₁ else h₀) (Fin.cons x (Fin.cons (recNotation g h₀ h₁ x v) v)) := rfl + +/-- **Cobham's function algebra**: the smallest class of bitstring functions containing +the projections, the empty string, the bit successors `x ↦ b :: x`, and `smash`, and +closed under composition and limited recursion on notation. + +In `boundedRec`, the recursion is *limited*: the result must be length-bounded, +uniformly in the arguments, by a function `j` already in the class. This is the +polynomial-growth leash that pins the class to exactly `FP` +(see `Complexitylib.Classes.P.Cobham`). -/ +inductive Cobham : ∀ {n : ℕ}, ((Fin n → List Bool) → List Bool) → Prop + /-- Every projection is in the class. -/ + | proj {n : ℕ} (i : Fin n) : Cobham fun v => v i + /-- The empty-string fixedValue (at every arity) is in the class. -/ + | empty {n : ℕ} : Cobham fun _ : Fin n → List Bool => [] + /-- The bit successors `x ↦ b :: x` (the string analogue of `n ↦ 2·n + b`) are in + the class. -/ + | bit (b : Bool) : Cobham fun v : Fin 1 → List Bool => b :: v 0 + /-- The smash function is in the class. -/ + | smash : Cobham fun v : Fin 2 → List Bool => smash (v 0) (v 1) + /-- The class is closed under composition. -/ + | comp {m n : ℕ} {f : (Fin m → List Bool) → List Bool} + {gs : Fin m → (Fin n → List Bool) → List Bool} : + Cobham f → (∀ i, Cobham (gs i)) → Cobham fun v => f fun i => gs i v + /-- The class is closed under **limited recursion on notation**: recursion on the bit + structure of the first argument, provided the result is length-bounded by a function + `j` of the class. -/ + | boundedRec {n : ℕ} {g : (Fin n → List Bool) → List Bool} + {h₀ h₁ : (Fin (n + 2) → List Bool) → List Bool} + {j : (Fin (n + 1) → List Bool) → List Bool} : + Cobham g → Cobham h₀ → Cobham h₁ → Cobham j → + (∀ x v, (recNotation g h₀ h₁ x v).length ≤ (j (Fin.cons x v)).length) → + Cobham fun v : Fin (n + 1) → List Bool => recNotation g h₀ h₁ (v 0) (Fin.tail v) + +/-- The unary fragment of Cobham's function algebra, as a class of string functions. +`Complexitylib.Classes.P.Cobham` proves `CobhamFP = FP`: this machine-independent +algebra carves out exactly the polynomial-time computable functions. -/ +def CobhamFP : Set (List Bool → List Bool) := + {f | Cobham fun v : Fin 1 → List Bool => f (v 0)} + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal.lean new file mode 100644 index 0000000000..ea9d914eb7 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal.lean @@ -0,0 +1,1142 @@ +/- +Copyright (c) 2026 Bolton Bailey. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Bolton Bailey +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Defs +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.FstBlock +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.SndBlock +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.Cat +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.ConsBit +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.Reorder +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.Vec +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.Algebra +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.Encoding +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.StepAlgebra +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.Simulate +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.IterateLayout +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.Iterate +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.TakeLen +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.Reverse +import LeanPool.BeyondBethe.Complexitylib.Classes.P.UnaryLength +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.MulLen +import LeanPool.BeyondBethe.Complexitylib.Classes.P.NormalForm +import LeanPool.BeyondBethe.Complexitylib.Classes.P.Composition +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.HeadFlag +import LeanPool.BeyondBethe.Complexitylib.Classes.P.PairWithInput + +/-! +# Cobham's characterization of FP — proof internals + +The assembly of `CobhamFP = FP` (`Complexitylib.Classes.P.Cobham`). Not meant +for human review of the mathematics — the surface file carries the auditable +statements; the type checker carries this. + +The machines are in sibling modules (`Internal.BlockScan`, `Internal.Cat`, +`Internal.ConsBit`, `Internal.Reorder`, `Internal.MulLen`, `Internal.Iterate`), +the algebra toolkit in `Internal.Algebra`, and the interpreter of the +completeness direction in `Internal.Encoding`, `Internal.StepAlgebra`, +`Internal.Extract` and `Internal.Simulate`. What remains here is the soundness +induction and the `boundedRec` loop. + +## Contents + +- the six constructor cases `fpn_empty`, `fpn_proj`, `fpn_bit`, `fpn_smash`, + `fpn_comp`, `fpn_boundedRec`, and the induction `cobham_imp_FPn` over them; +- the `FP` closure lemmas they need: `pairFn_mem_FP`, `appendFn_mem_FP`, + `selectHeadFn_mem_FP` (branching on a bit, via `Complexity.headFlag`), + `takeLenFn_mem_FP`, `assembleVec_mem_FP`; +- the `boundedRec` loop: `recNotation_eq_foldr`, `recFold_eq_recNotation`, + `recFoldClamp_eq_recFold`, `loopStep_iterate` and `recFoldClamp_mem_FP`, on top + of `iterate_mem_FP`; +- the rulers `exists_ruler` and `exists_exact_ruler` that carry the loop's width + clamp as data. +-/ + + +@[expose] public section + +namespace Complexity + +namespace Cobham + +/-! ## The canonical tuple encoding is in the algebra -/ + +/-- The nested tuple encoding is a Cobham function at every fixed arity. -/ +theorem encodeVec_mem_internal {n : ℕ} : Cobham (@encodeVec n) := by + induction n with + | zero => + exact Cobham.empty.of_eq fun v => by simp + | succ n ih => + have htail : Cobham fun v : Fin (n + 1) → List Bool => encodeVec (Fin.tail v) := + (Cobham.comp ih fun i : Fin n => Cobham.proj i.succ).of_eq fun v => rfl + exact (comp₂ pairing htail (Cobham.proj 0)).of_eq fun v => by + rw [encodeVec_succ] + rfl + +/-! ## Soundness: `Cobham f → FPn f`, constructor by constructor -/ + +/-- `empty` case: the fixedValue empty function is `FPn` at every arity, witnessed +by `const_nil_mem_FP`. -/ +theorem fpn_empty {n : ℕ} : FPn (fun _ : Fin n → List Bool => ([] : List Bool)) := + ⟨fun _ => [], const_nil_mem_FP, fun _ => rfl⟩ + +/-- `proj` case: extracting the `i`-th component of an encoded vector is `FP`. + +The extraction is `sndBlock` after `i`-fold `fstBlock`: peel `i` leading blocks to +reach the encoding of components `i, i+1, …`, then read its head with `sndBlock`. +Proved here by induction on the arity; each atomic step is `FP` +(`fstBlock_mem_FP`, `sndBlock_mem_FP`) and `FP` is closed under composition +(`mem_FP_comp`), so only those two machine lemmas remain open. -/ +theorem fpn_proj {n : ℕ} (i : Fin n) : FPn (fun v : Fin n → List Bool => v i) := by + induction n with + | zero => exact i.elim0 + | succ n ih => + induction i using Fin.cases with + | zero => + exact ⟨sndBlock, sndBlock_mem_FP, fun v => sndBlock_encodeVec_succ v⟩ + | succ j => + obtain ⟨g, hg, hgf⟩ := ih j + refine ⟨g ∘ fstBlock, mem_FP_comp fstBlock_mem_FP hg, fun v => ?_⟩ + show g (fstBlock (encodeVec v)) = v j.succ + rw [fstBlock_encodeVec_succ, hgf] + rfl + +/-- `bit` case: prepending a fixed bit is `FPn` at arity one. On the arity-one +encoding `encodeVec ![x] = pair [] x`, the head component `x` is `sndBlock`, so the +witness is `(b :: ·) ∘ sndBlock`; both factors are `FP`. -/ +theorem fpn_bit (b : Bool) : + FPn (fun v : Fin 1 → List Bool => b :: v 0) := by + refine ⟨(fun x => b :: x) ∘ sndBlock, + mem_FP_comp sndBlock_mem_FP (cons_mem_FP b), fun v => ?_⟩ + show b :: sndBlock (encodeVec v) = b :: v 0 + rw [sndBlock_encodeVec_succ] + +/-- Pairing two `FP` functions of the same input is `FP`. + +Built without a two-output machine: `mem_FP_pairWithInput` gives the nested triple +`z ↦ pair (a z) (pair (b z) z)` (pairing each computed value against the raw +input, then again), and the self-contained `reorder` drops the trailing input +copy to leave `pair (a z) (b z)`. This is what lets `fpn_comp` avoid a bespoke +tuple-assembly machine. -/ +theorem pairFn_mem_FP {a b : List Bool → List Bool} (ha : a ∈ FP) (hb : b ∈ FP) : + (fun z => pair (a z) (b z)) ∈ FP := by + have h1 : (fun z => pair (b z) z) ∈ FP := mem_FP_pairWithInput hb + have h2 : (fun w => pair (a (sndBlock w)) w) ∈ FP := + mem_FP_pairWithInput (mem_FP_comp sndBlock_mem_FP ha) + have h12 := mem_FP_comp h1 h2 + have heq : ((fun w => pair (a (sndBlock w)) w) ∘ fun z => pair (b z) z) + = fun z => pair (a z) (pair (b z) z) := by + funext z; simp [Function.comp, sndBlock_pair] + rw [heq] at h12 + have hr := mem_FP_comp h12 reorder_mem_FP + have heq2 : (reorder ∘ fun z => pair (a z) (pair (b z) z)) + = fun z => pair (a z) (b z) := by + funext z; simp [Function.comp, reorder_pair_pair] + rwa [heq2] at hr + +/-- **`FP` is closed under concatenation.** -/ +theorem appendFn_mem_FP {a b : List Bool → List Bool} (ha : a ∈ FP) (hb : b ∈ FP) : + (fun z => a z ++ b z) ∈ FP := by + have h := mem_FP_comp (pairFn_mem_FP ha hb) catBlocks_mem_FP + have heq : (catBlocks ∘ fun z => pair (a z) (b z)) = fun z => a z ++ b z := by + funext z + simp [Function.comp] + rwa [heq] at h + +/-- Emitting `|a z| · |b z|` copies of `false` is `FP` when `a, b` are. This +zero-filled ruler is an internal length-arithmetic helper, not Cobham's public +all-one smash. It is built as the self-contained `mulUnpair` (see +`Complexitylib.Classes.P.Cobham.Internal.MulLen`) after `pairFn a b`. -/ +theorem mulLenFn_mem_FP {a b : List Bool → List Bool} (ha : a ∈ FP) (hb : b ∈ FP) : + (fun z => List.replicate ((a z).length * (b z).length) false) ∈ FP := by + have hc := mem_FP_comp (pairFn_mem_FP ha hb) mulUnpair_mem_FP + have heq : (mulUnpair ∘ fun z => pair (a z) (b z)) + = fun z => List.replicate ((a z).length * (b z).length) false := by + funext z; simp [Function.comp, mulUnpair_pair] + rwa [heq] at hc + +/-- Truncating one `FP` value to another's length. -/ +theorem takeLenFn_mem_FP {a b : List Bool → List Bool} (ha : a ∈ FP) (hb : b ∈ FP) : + (fun z => (b z).take (a z).length) ∈ FP := by + have hc := mem_FP_comp (pairFn_mem_FP ha hb) takeLen_mem_FP + have heq : (takeLen ∘ fun z => pair (a z) (b z)) + = fun z => (b z).take (a z).length := by + funext z; simp [Function.comp, takeLen_pair] + rwa [heq] at hc + +/-- Select `x` or `y` according to the leading bit of `s`; nothing when `s` is +empty. This is the only shape of value-dependent branching the algebra's loop +needs, and `Complexity.headFlag` is what makes it expressible. -/ +def selectHead (s x y : List Bool) : List Bool := + if s.head? = some true then x else if s.head? = some false then y else [] + +/-- **Selection is masking.** Exactly one of the two masks is full width, so the +concatenation returns exactly one branch. -/ +theorem selectHead_eq (s x y : List Bool) : + selectHead s x y = x.take ((headFlag true s).length * x.length) + ++ y.take ((headFlag false s).length * y.length) := by + rw [selectHead, headFlag, headFlag] + rcases hs : s.head? with _ | a + · simp + · cases a <;> simp + +/-- **Selecting between two `FP` values by a bit is `FP`.** -/ +theorem selectHeadFn_mem_FP {f a b : List Bool → List Bool} + (hf : f ∈ FP) (ha : a ∈ FP) (hb : b ∈ FP) : + (fun z => selectHead (f z) (a z) (b z)) ∈ FP := by + have hflag : ∀ t : Bool, (fun z => headFlag t (f z)) ∈ FP := fun t => by + have := mem_FP_comp hf (headFlag_mem_FP t) + simpa [Function.comp] using this + have hx : (fun z => (a z).take ((headFlag true (f z)).length * (a z).length)) ∈ FP := by + have := takeLenFn_mem_FP (mulLenFn_mem_FP (hflag true) ha) ha + simpa using this + have hy : (fun z => (b z).take ((headFlag false (f z)).length * (b z).length)) ∈ FP := by + have := takeLenFn_mem_FP (mulLenFn_mem_FP (hflag false) hb) hb + simpa using this + have h := appendFn_mem_FP hx hy + have heq : (fun z => (a z).take ((headFlag true (f z)).length * (a z).length) + ++ (b z).take ((headFlag false (f z)).length * (b z).length)) + = fun z => selectHead (f z) (a z) (b z) := by + funext z; rw [selectHead_eq] + rwa [heq] at h + +/-- `smash` case: the smash function is `FPn`. On `encodeVec ![x, y]` the two +components are `sndBlock` and `sndBlock ∘ fstBlock`; `smash x y` is +`|x| · |y|` copies of `true`, so the witness first computes a zero-filled ruler +with `mulLenFn_mem_FP` and then applies `unaryLength_mem_FP`. -/ +theorem fpn_smash : + FPn (fun v : Fin 2 → List Bool => Complexity.smash (v 0) (v 1)) := by + refine ⟨fun z => + List.replicate ((sndBlock z).length * (sndBlock (fstBlock z)).length) true, + ?_, fun v => ?_⟩ + · have hmul := + mulLenFn_mem_FP sndBlock_mem_FP (mem_FP_comp fstBlock_mem_FP sndBlock_mem_FP) + have h := mem_FP_comp hmul unaryLength_mem_FP + have heq : (fun z => + List.replicate ((sndBlock z).length * (sndBlock (fstBlock z)).length) true) = + (fun x => List.replicate x.length true) ∘ fun z => + List.replicate ((sndBlock z).length * (sndBlock (fstBlock z)).length) false := by + funext z + simp [Function.comp] + rw [heq] + exact h + show List.replicate + ((sndBlock (encodeVec v)).length * + (sndBlock (fstBlock (encodeVec v))).length) true + = Complexity.smash (v 0) (v 1) + rw [sndBlock_encodeVec_succ, fstBlock_encodeVec_succ, sndBlock_encodeVec_succ, + Complexity.smash] + rfl + +/-- Assembling an encoded vector out of `FP` component functions of a common input +is `FP`. Proved by induction on the arity: the empty vector is the fixedValue `[]`, +and the successor step is one `pairFn_mem_FP`. -/ +theorem assembleVec_mem_FP {m : ℕ} (w : Fin m → (List Bool → List Bool)) + (hw : ∀ i, w i ∈ FP) : + (fun z => encodeVec fun i => w i z) ∈ FP := by + induction m with + | zero => + have : (fun z : List Bool => encodeVec fun i : Fin 0 => w i z) + = fun _ => [] := by funext z; rfl + rw [this]; exact const_nil_mem_FP + | succ m ih => + have htail : (fun z => encodeVec fun i : Fin m => Fin.tail w i z) ∈ FP := + ih (Fin.tail w) fun i => hw i.succ + have h0 : w 0 ∈ FP := hw 0 + have hpair := pairFn_mem_FP htail h0 + have heq : (fun z => encodeVec fun i : Fin (m + 1) => w i z) + = fun z => pair (encodeVec fun i : Fin m => Fin.tail w i z) (w 0 z) := by + funext z; rw [encodeVec_succ]; rfl + rw [heq]; exact hpair + +/-- `comp` case: `FPn` is closed under Cobham composition. On `encodeVec v`, each +inner `gs i` is computed by its `FP` witness `G i`, the results are assembled into +`encodeVec (fun i => gs i v)` (`assembleVec_mem_FP`), and the outer `f`'s witness +is applied; `FP` is closed under composition. Rests only on `pairFn_mem_FP`. -/ +theorem fpn_comp {m n : ℕ} {f : (Fin m → List Bool) → List Bool} + {gs : Fin m → (Fin n → List Bool) → List Bool} + (ihf : FPn f) (ihgs : ∀ i, FPn (gs i)) : + FPn (fun v => f fun i => gs i v) := by + obtain ⟨F, hF, hFf⟩ := ihf + choose G hG hGf using ihgs + refine ⟨F ∘ fun z => encodeVec fun i => G i z, + mem_FP_comp (assembleVec_mem_FP G hG) hF, fun v => ?_⟩ + show F (encodeVec fun i => G i (encodeVec v)) = f fun i => gs i v + have hinner : (fun i => G i (encodeVec v)) = fun i => gs i v := by + funext i; exact hGf i v + rw [hinner, hFf] + +/-- One step of recursion on notation viewed as a fold operation: extend the +running suffix `p.1` by the bit `b` and update the running recursive value `p.2` by +the bit-selected step function. Folding this over a string with `List.foldr` +reproduces `recNotation` (see `recNotation_eq_foldr`); it is the per-iteration +body a loop machine runs. -/ +def recNotationStep {n : ℕ} (h₀ h₁ : (Fin (n + 2) → List Bool) → List Bool) + (w : Fin n → List Bool) (b : Bool) (p : List Bool × List Bool) : + List Bool × List Bool := + (b :: p.1, (bif b then h₁ else h₀) (Fin.cons p.1 (Fin.cons p.2 w))) + +/-- The first component of the recursion-on-notation fold accumulates exactly the +bits processed so far — i.e. it rebuilds the input string. -/ +theorem recNotationStep_foldr_fst {n : ℕ} (g : (Fin n → List Bool) → List Bool) + {h₀ h₁ : (Fin (n + 2) → List Bool) → List Bool} (s : List Bool) + (w : Fin n → List Bool) : + (s.foldr (recNotationStep h₀ h₁ w) ([], g w)).1 = s := by + induction s with + | nil => rfl + | cons b x ih => simp [List.foldr_cons, recNotationStep, ih] + +/-- **Recursion on notation is a fold.** `recNotation g h₀ h₁ s w` is the second +component of folding `recNotationStep` over `s` from the empty suffix and base +value `g w`. This reduces the `boundedRec` case to iterating a single step +function over the bits of `s` — exactly what a loop machine computes — and is the +target identity for `fpn_boundedRec`. -/ +theorem recNotation_eq_foldr {n : ℕ} (g : (Fin n → List Bool) → List Bool) + (h₀ h₁ : (Fin (n + 2) → List Bool) → List Bool) (s : List Bool) + (w : Fin n → List Bool) : + recNotation g h₀ h₁ s w = + (s.foldr (recNotationStep h₀ h₁ w) ([], g w)).2 := by + induction s with + | nil => rfl + | cons b x ih => + rw [recNotation_cons, List.foldr_cons] + simp only [recNotationStep] + rw [recNotationStep_foldr_fst g x w, ih] + +/-! ### The `boundedRec` loop + +The `boundedRec` case runs the recursion as a loop on *encoded* arguments: +`recFold A B e W s` threads a running suffix `t` of `s` and the running +accumulator `a` through the argument encoding `pair (pair W a) t`, which is +exactly `encodeVec (Fin.cons t (Fin.cons a w))` when `W = encodeVec w`. + +A machine cannot run `recFold` as written: nothing stops the accumulator from +doubling in length at every iteration, so intermediate values would need +exponential space. `recFoldClamp` truncates every intermediate value to a +prescribed width, which makes the loop unconditionally polynomial-time +(`recFoldClamp_mem_FP`); Cobham's limited-recursion side condition is then +exactly what shows the truncation never fires (`recFoldClamp_eq_recFold`). -/ + +/-- The recursion-on-notation loop on encoded arguments: fold the bit-selected +step functions `A` (bit `false`) and `B` (bit `true`) over `s`, threading the +running suffix and accumulator through the argument encoding. -/ +def recFold (A B : List Bool → List Bool) (e W : List Bool) : + List Bool → List Bool + | [] => e + | b :: t => (bif b then B else A) (pair (pair W (recFold A B e W t)) t) + +/-- `recFold` with every intermediate value truncated to `bound` bits. This is +the loop a machine can actually run: each iteration's state is length-bounded, +so the whole loop takes polynomial time. -/ +def recFoldClamp (A B : List Bool → List Bool) (bound : ℕ) (e W : List Bool) : + List Bool → List Bool + | [] => e.take bound + | b :: t => + ((bif b then B else A) + (pair (pair W (recFoldClamp A B bound e W t)) t)).take bound + +/-- A natural-coefficient polynomial is dominated by a single power of `n + 1` +scaled by the sum of its coefficients. -/ +private theorem poly_eval_le_pow (p : Polynomial ℕ) (n : ℕ) : + p.eval n ≤ + (∑ i ∈ Finset.range (p.natDegree + 1), p.coeff i) * (n + 1) ^ p.natDegree := by + rw [Polynomial.eval_eq_sum_range, Finset.sum_mul] + refine Finset.sum_le_sum fun i hi => ?_ + have hi' : i ≤ p.natDegree := by rw [Finset.mem_range] at hi; omega + exact Nat.mul_le_mul_left _ + (le_trans (Nat.pow_le_pow_left (by omega) i) (Nat.pow_le_pow_right (by omega) hi')) + +/-- An `FP` function whose output is at least `c` bits long, for any fixedValue `c`. +Built by iterating `pair · []`, which doubles the length and adds two. -/ +theorem exists_const_ruler (c : ℕ) : + ∃ K : List Bool → List Bool, K ∈ FP ∧ ∀ z, c ≤ (K z).length := by + induction c with + | zero => exact ⟨fun _ => [], const_nil_mem_FP, fun _ => by simp⟩ + | succ c ih => + obtain ⟨K, hK, hlen⟩ := ih + refine ⟨fun z => pair (K z) [], pairFn_mem_FP hK const_nil_mem_FP, fun z => ?_⟩ + have := hlen z + simp only [pair_length, List.length_nil] + omega + +/-- **Rulers.** For every fixedValue `c` and exponent `d` there is an `FP` function +whose output is at least `c · (|z| + 1) ^ d` bits long. Rulers let the loop of the +`boundedRec` case carry its width clamp as *data* — truncating to a string costs +linear time, whereas truncating to a computed number would not. -/ +theorem exists_pow_ruler (c d : ℕ) : + ∃ R : List Bool → List Bool, R ∈ FP ∧ + ∀ z, c * (z.length + 1) ^ d ≤ (R z).length := by + induction d with + | zero => + obtain ⟨K, hK, hlen⟩ := exists_const_ruler c + exact ⟨K, hK, fun z => by simpa using hlen z⟩ + | succ d ih => + obtain ⟨R, hR, hlen⟩ := ih + refine ⟨fun z => List.replicate ((R z).length * (pair [] z).length) false, + mulLenFn_mem_FP hR pairLeftNil_mem_FP, fun z => ?_⟩ + have hR' := hlen z + have hL : z.length + 1 ≤ (pair [] z).length := by simp + calc c * (z.length + 1) ^ (d + 1) + = (c * (z.length + 1) ^ d) * (z.length + 1) := by ring + _ ≤ (R z).length * (pair [] z).length := Nat.mul_le_mul hR' hL + _ = _ := by simp + +/-- Every polynomial bound has an `FP` ruler. -/ +theorem exists_ruler (p : Polynomial ℕ) : + ∃ R : List Bool → List Bool, R ∈ FP ∧ ∀ z, p.eval z.length ≤ (R z).length := by + obtain ⟨R, hR, hlen⟩ := + exists_pow_ruler (∑ i ∈ Finset.range (p.natDegree + 1), p.coeff i) p.natDegree + exact ⟨R, hR, fun z => le_trans (poly_eval_le_pow p z.length) (hlen z)⟩ + +/-! ### Exact rulers + +`exists_ruler` builds an `FP` string *at least* `p.eval |z|` bits long, which is +all a clamp needs. The loop needs an exact one: the width it truncates to is the +ruler's length, and that has to be the bound the statement names. Exactness comes +from `Complexity.unaryLength_mem_FP` together with the two exact length +arithmetic operations now available — `mulLenFn_mem_FP` multiplies lengths and +`appendFn_mem_FP` adds them. -/ + +/-- Constants of any width are `FP`. -/ +theorem const_replicate_mem_FP (c : ℕ) : + (fun _ : List Bool => List.replicate c false) ∈ FP := by + induction c with + | zero => simpa using const_nil_mem_FP + | succ c ih => + have := mem_FP_comp ih (cons_mem_FP false) + simpa [Function.comp, List.replicate_succ] using this + +/-- A ruler of length exactly `|z| ^ d`. -/ +private theorem exists_pow_exact_ruler (d : ℕ) : + ∃ R : List Bool → List Bool, R ∈ FP ∧ ∀ z, (R z).length = z.length ^ d := by + induction d with + | zero => exact ⟨fun _ => List.replicate 1 false, const_replicate_mem_FP 1, + fun z => by simp⟩ + | succ d ih => + obtain ⟨R, hR, hlen⟩ := ih + refine ⟨fun z => List.replicate ((R z).length * (List.replicate z.length true).length) + false, mulLenFn_mem_FP hR unaryLength_mem_FP, fun z => ?_⟩ + simp [hlen, pow_succ] + +/-- **A ruler of length exactly `p.eval |z|`.** -/ +theorem exists_exact_ruler (p : Polynomial ℕ) : + ∃ R : List Bool → List Bool, R ∈ FP ∧ ∀ z, (R z).length = p.eval z.length := by + have hsum : ∀ N : ℕ, ∃ R : List Bool → List Bool, R ∈ FP ∧ + ∀ z, (R z).length = ∑ i ∈ Finset.range N, p.coeff i * z.length ^ i := by + intro N + induction N with + | zero => exact ⟨fun _ => [], const_nil_mem_FP, fun z => by simp⟩ + | succ N ih => + obtain ⟨R, hR, hlen⟩ := ih + obtain ⟨S, hS, hSlen⟩ := exists_pow_exact_ruler N + refine ⟨fun z => R z ++ List.replicate + ((List.replicate (p.coeff N) false).length * (S z).length) false, + appendFn_mem_FP hR (mulLenFn_mem_FP (const_replicate_mem_FP _) hS), + fun z => ?_⟩ + rw [List.length_append, hlen, List.length_replicate, List.length_replicate, + hSlen, Finset.sum_range_succ] + obtain ⟨R, hR, hlen⟩ := hsum (p.natDegree + 1) + exact ⟨R, hR, fun z => by rw [hlen, ← Polynomial.eval_eq_sum_range]⟩ + +/-! ### The loop as an iteration + +`recFoldClamp` is an iteration of a *single* `FP` step function on a packed +state. Writing `s` for `sndBlock z`, the state after `m` iterations is + + `pair (pair R (pair W s)) (pair (s.drop (|s| - m)) (recFoldClamp … (s.drop (|s| - m))))` + +so the answer is the accumulator after `|s|` iterations. Every ingredient of the +step is now `FP`: the suffix grows by `Complexity.takeLen` against a ruler one +longer, read off `s.reverse`; the branch on the new leading bit is `selectHead`; +and the clamp is `takeLen` against `R`. -/ + +/-- One iteration of the clamped loop, on the loop's components. -/ +def loopStepOn (A B : List Bool → List Bool) (R W s t a : List Bool) : List Bool := + pair (pair R (pair W s)) + (pair ((takeLen (pair (false :: t) s.reverse)).reverse) + (takeLen (pair R + (selectHead ((takeLen (pair (false :: t) s.reverse)).reverse) + (B (pair (pair W a) t)) (A (pair (pair W a) t)))))) + +/-- One iteration of the clamped loop, on the packed state. -/ +def loopStep (A B : List Bool → List Bool) (v : List Bool) : List Bool := + loopStepOn A B (fstBlock (fstBlock v)) (fstBlock (sndBlock (fstBlock v))) + (sndBlock (sndBlock (fstBlock v))) (fstBlock (sndBlock v)) (sndBlock (sndBlock v)) + +@[simp] theorem loopStep_pair (A B : List Bool → List Bool) (R W s t a : List Bool) : + loopStep A B (pair (pair R (pair W s)) (pair t a)) = loopStepOn A B R W s t a := by + simp [loopStep] + +/-- **The step is `FP`.** -/ +theorem loopStep_mem_FP {A B : List Bool → List Bool} (hA : A ∈ FP) (hB : B ∈ FP) : + loopStep A B ∈ FP := by + have hfst : fstBlock ∈ FP := fstBlock_mem_FP + have hsnd : sndBlock ∈ FP := sndBlock_mem_FP + have hcomp₁ : ∀ {g : List Bool → List Bool}, g ∈ FP → + (fun v => fstBlock (g v)) ∈ FP := fun hg => by + simpa [Function.comp] using mem_FP_comp hg hfst + have hcomp₂ : ∀ {g : List Bool → List Bool}, g ∈ FP → + (fun v => sndBlock (g v)) ∈ FP := fun hg => by + simpa [Function.comp] using mem_FP_comp hg hsnd + have hP : (fun v : List Bool => fstBlock v) ∈ FP := hfst + have hR : (fun v : List Bool => fstBlock (fstBlock v)) ∈ FP := hcomp₁ hP + have hW : (fun v : List Bool => fstBlock (sndBlock (fstBlock v))) ∈ FP := + hcomp₁ (hcomp₂ hP) + have hs : (fun v : List Bool => sndBlock (sndBlock (fstBlock v))) ∈ FP := + hcomp₂ (hcomp₂ hP) + have ht : (fun v : List Bool => fstBlock (sndBlock v)) ∈ FP := hcomp₁ hsnd + have ha : (fun v : List Bool => sndBlock (sndBlock v)) ∈ FP := hcomp₂ hsnd + have hrev : ∀ {g : List Bool → List Bool}, g ∈ FP → + (fun v => (g v).reverse) ∈ FP := fun hg => by + simpa [Function.comp] using mem_FP_comp hg reverse_mem_FP + have hcons : (fun v : List Bool => false :: fstBlock (sndBlock v)) ∈ FP := by + simpa [Function.comp] using mem_FP_comp ht (cons_mem_FP false) + have ht' : (fun v : List Bool => + (takeLen (pair (false :: fstBlock (sndBlock v)) + (sndBlock (sndBlock (fstBlock v))).reverse)).reverse) ∈ FP := by + refine hrev ?_ + have := takeLenFn_mem_FP hcons (hrev hs) + simpa [takeLen_pair] using this + have hX : (fun v : List Bool => + pair (pair (fstBlock (sndBlock (fstBlock v))) (sndBlock (sndBlock v))) + (fstBlock (sndBlock v))) ∈ FP := pairFn_mem_FP (pairFn_mem_FP hW ha) ht + have hsel := selectHeadFn_mem_FP ht' + (by simpa [Function.comp] using mem_FP_comp hX hB) + (by simpa [Function.comp] using mem_FP_comp hX hA) + have hacc : (fun v : List Bool => takeLen (pair (fstBlock (fstBlock v)) + (selectHead ((takeLen (pair (false :: fstBlock (sndBlock v)) + (sndBlock (sndBlock (fstBlock v))).reverse)).reverse) + (B (pair (pair (fstBlock (sndBlock (fstBlock v))) (sndBlock (sndBlock v))) + (fstBlock (sndBlock v)))) + (A (pair (pair (fstBlock (sndBlock (fstBlock v))) (sndBlock (sndBlock v))) + (fstBlock (sndBlock v))))))) ∈ FP := by + have := takeLenFn_mem_FP hR hsel + simpa [takeLen_pair, Function.comp] using this + have hall := pairFn_mem_FP (pairFn_mem_FP hR (pairFn_mem_FP hW hs)) + (pairFn_mem_FP ht' hacc) + simpa [loopStep, loopStepOn] using hall + +/-- **The loop's invariant.** After `m` iterations the state holds the suffix +`s.drop (|s| - m)` and the clamped fold over it. -/ +theorem loopStep_iterate {A B : List Bool → List Bool} (R W s e : List Bool) : + ∀ m ≤ s.length, + (loopStep A B)^[m] + (pair (pair R (pair W s)) (pair [] (e.take R.length))) + = pair (pair R (pair W s)) + (pair (s.drop (s.length - m)) + (recFoldClamp A B R.length e W (s.drop (s.length - m)))) := by + intro m + induction m with + | zero => intro _; simp [recFoldClamp] + | succ m ih => + intro hm + rw [Function.iterate_succ_apply', ih (by omega), loopStep_pair, loopStepOn] + have hlt : s.length - (m + 1) < s.length := by omega + have hdrop : s.drop (s.length - (m + 1)) + = s[s.length - (m + 1)] :: s.drop (s.length - m) := by + rw [List.drop_eq_getElem_cons hlt, + show s.length - (m + 1) + 1 = s.length - m from by omega] + have hnext : (takeLen (pair (false :: s.drop (s.length - m)) s.reverse)).reverse + = s.drop (s.length - (m + 1)) := by + rw [takeLen_pair, List.length_cons, List.length_drop, + show s.length - (s.length - m) + 1 = s.length - (s.length - (m + 1)) from by omega, + ← List.reverse_drop, List.reverse_reverse] + rw [hnext, hdrop, recFoldClamp] + congr 2 + rw [takeLen_pair, selectHead] + cases hb : s[s.length - (m + 1)] <;> simp + +/-- The clamp really clamps. -/ +theorem recFoldClamp_length_le (A B : List Bool → List Bool) (bound : ℕ) + (e W s : List Bool) : (recFoldClamp A B bound e W s).length ≤ bound := by + cases s with + | nil => simp [recFoldClamp] + | cons b t => simp [recFoldClamp] + +/-! ### The loop's step function + +`Complexity.iterate_input_mem_FP` supplies a machine that applies an `FP` +function once per bit of its own input, starting from `pair [] x`. The state +below is `pair (pair C v) x`: a counter `C`, the running value `v`, and the +machine's input `x` kept verbatim. Keeping `x` is what makes the whole +construction work: the ruler and the width stay readable at every step, and +truncating the new state to `|x|` bounds the state length *globally* — the +machine's contract needs a bound that holds for every input, not just for the +well-formed ones. -/ + +/-- A flag whose leading bit is `true` exactly when `s` is empty — the one test +`Complexity.selectHead` cannot make directly. -/ +def emptyFlag (s : List Bool) : List Bool := + headFlag true s ++ headFlag false s ++ [true] + +@[simp] theorem emptyFlag_nil : emptyFlag [] = [true] := rfl + +theorem emptyFlag_head_cons (b : Bool) (t : List Bool) : + (emptyFlag (b :: t)).head? = some false := by + cases b <;> rfl + +theorem selectHead_emptyFlag_nil (x y : List Bool) : selectHead (emptyFlag []) x y = x := by + rw [emptyFlag_nil, selectHead, + if_pos (show ([true] : List Bool).head? = some true from rfl)] + +theorem length_take_le_arg (n : ℕ) (l : List Bool) : (l.take n).length ≤ n := by + rw [List.length_take]; omega + +theorem selectHead_emptyFlag_cons (b : Bool) (t x y : List Bool) : + selectHead (emptyFlag (b :: t)) x y = y := by + rw [selectHead, if_neg (by rw [emptyFlag_head_cons]; simp), + if_pos (emptyFlag_head_cons b t)] + +theorem selectHead_length_le (s x y : List Bool) : + (selectHead s x y).length ≤ max x.length y.length := by + rw [selectHead] + split + · exact le_max_left _ _ + · split + · exact le_max_right _ _ + · simp + +/-- The counter of the next iteration: one more mark of the reversed ruler. -/ +def nextCounter (w : List Bool) : List Bool := + (takeLen (pair (false :: fstBlock (fstBlock w)) + (fstBlock (fstBlock (sndBlock w))))).reverse + +/-- The value of the next iteration: the initial value on the first step, then +`F` of the current value until the counter saturates. -/ +def nextValue (F : List Bool → List Bool) (w : List Bool) : List Bool := + selectHead (emptyFlag (fstBlock (fstBlock w))) + (sndBlock (sndBlock w)) + (selectHead (nextCounter w) (sndBlock (fstBlock w)) + (takeLen (pair (sndBlock (fstBlock (sndBlock w))) (F (sndBlock (fstBlock w)))))) + +/-- One iteration of the loop, truncated to the machine's own input length. -/ +def iterStep (F : List Bool → List Bool) (w : List Bool) : List Bool := + pair (takeLen (pair (sndBlock w) (pair (nextCounter w) (nextValue F w)))) (sndBlock w) + +theorem sndBlock_iterStep (F : List Bool → List Bool) (w : List Bool) : + sndBlock (iterStep F w) = sndBlock w := by + rw [iterStep, sndBlock_pair] + +theorem iterStep_length_le (F : List Bool → List Bool) (w : List Bool) : + (iterStep F w).length ≤ 3 * (sndBlock w).length + 2 := by + rw [iterStep, pair_length, takeLen_pair] + have := length_take_le_arg (sndBlock w).length (pair (nextCounter w) (nextValue F w)) + omega + +/-- **The state length is globally bounded**: whatever the input, the state +after one or more iterations fits in `3|x| + 2`. -/ +theorem iterStep_iterate_length_le (F : List Bool → List Bool) (x : List Bool) : + ∀ i, ((iterStep F)^[i] (pair [] x)).length ≤ 3 * x.length + 2 := by + have hsnd : ∀ i, sndBlock ((iterStep F)^[i] (pair [] x)) = x := by + intro i + induction i with + | zero => exact sndBlock_pair [] x + | succ i ih => rw [Function.iterate_succ_apply', sndBlock_iterStep, ih] + intro i + cases i with + | zero => + rw [Function.iterate_zero_apply, pair_length] + simp + omega + | succ i => + rw [Function.iterate_succ_apply'] + have := iterStep_length_le F ((iterStep F)^[i] (pair [] x)) + rw [hsnd i] at this + exact this + +theorem emptyFlag_mem_FP {f : List Bool → List Bool} (hf : f ∈ FP) : + (fun z => emptyFlag (f z)) ∈ FP := by + have hcst : (fun _ : List Bool => [true]) ∈ FP := by + simpa [Function.comp] using mem_FP_comp const_nil_mem_FP (cons_mem_FP true) + have h1 : (fun z => headFlag true (f z)) ∈ FP := by + simpa [Function.comp] using mem_FP_comp hf (headFlag_mem_FP true) + have h2 : (fun z => headFlag false (f z)) ∈ FP := by + simpa [Function.comp] using mem_FP_comp hf (headFlag_mem_FP false) + exact appendFn_mem_FP (appendFn_mem_FP h1 h2) hcst + +theorem nextCounter_mem_FP : nextCounter ∈ FP := by + have hf : fstBlock ∈ FP := fstBlock_mem_FP + have hs : sndBlock ∈ FP := sndBlock_mem_FP + have hc : (fun w => false :: fstBlock (fstBlock w)) ∈ FP := by + simpa [Function.comp] using + mem_FP_comp (mem_FP_comp hf hf) (cons_mem_FP false) + have hk : (fun w => fstBlock (fstBlock (sndBlock w))) ∈ FP := by + simpa [Function.comp] using mem_FP_comp hs (mem_FP_comp hf hf) + have := takeLenFn_mem_FP hc hk + have hrev : (fun w => ((fstBlock (fstBlock (sndBlock w))).take + (false :: fstBlock (fstBlock w)).length).reverse) ∈ FP := by + simpa [Function.comp] using mem_FP_comp this reverse_mem_FP + have heq : (fun w => ((fstBlock (fstBlock (sndBlock w))).take + (false :: fstBlock (fstBlock w)).length).reverse) = nextCounter := by + funext w + rw [nextCounter, takeLen_pair] + rwa [heq] at hrev + +theorem nextValue_mem_FP {F : List Bool → List Bool} (hF : F ∈ FP) : + nextValue F ∈ FP := by + have hf : fstBlock ∈ FP := fstBlock_mem_FP + have hs : sndBlock ∈ FP := sndBlock_mem_FP + have hC : (fun w => fstBlock (fstBlock w)) ∈ FP := mem_FP_comp hf hf + have hv : (fun w => sndBlock (fstBlock w)) ∈ FP := mem_FP_comp hf hs + have hv0 : (fun w => sndBlock (sndBlock w)) ∈ FP := mem_FP_comp hs hs + have hW : (fun w => sndBlock (fstBlock (sndBlock w))) ∈ FP := + mem_FP_comp hs (mem_FP_comp hf hs) + have hFv : (fun w => F (sndBlock (fstBlock w))) ∈ FP := mem_FP_comp hv hF + have hclamp : (fun w => takeLen (pair (sndBlock (fstBlock (sndBlock w))) + (F (sndBlock (fstBlock w))))) ∈ FP := by + have := takeLenFn_mem_FP hW hFv + simpa [takeLen_pair] using this + exact selectHeadFn_mem_FP (emptyFlag_mem_FP hC) hv0 + (selectHeadFn_mem_FP nextCounter_mem_FP hv hclamp) + +theorem iterStep_mem_FP {F : List Bool → List Bool} (hF : F ∈ FP) : + iterStep F ∈ FP := by + have hs : sndBlock ∈ FP := sndBlock_mem_FP + have hpair : (fun w => pair (nextCounter w) (nextValue F w)) ∈ FP := + pairFn_mem_FP nextCounter_mem_FP (nextValue_mem_FP hF) + have hclamp : (fun w => takeLen (pair (sndBlock w) + (pair (nextCounter w) (nextValue F w)))) ∈ FP := by + have := takeLenFn_mem_FP hs hpair + simpa [takeLen_pair] using this + exact pairFn_mem_FP hclamp hs + +/-- The value the loop carries after `i` iterations, from the second on. -/ +def iterVal (F : List Bool → List Bool) (Krev W v₀ : List Bool) : ℕ → List Bool + | 0 => v₀ + | i + 1 => selectHead ((Krev.take (i + 2)).reverse) (iterVal F Krev W v₀ i) + ((F (iterVal F Krev W v₀ i)).take W.length) + +theorem iterVal_length_le (F : List Bool → List Bool) (Krev W v₀ : List Bool) : + ∀ i, (iterVal F Krev W v₀ i).length ≤ max v₀.length W.length := by + intro i + induction i with + | zero => exact le_max_left _ _ + | succ i ih => + refine le_trans (selectHead_length_le _ _ _) ?_ + have := length_take_le_arg W.length (F (iterVal F Krev W v₀ i)) + omega + +theorem take_succ_min (l : List Bool) (i : ℕ) : + l.take (min i l.length + 1) = l.take (i + 1) := by + rcases Nat.lt_or_ge l.length i with h | h + · rw [min_eq_right (by omega), List.take_of_length_le (by omega), + List.take_of_length_le (by omega)] + · rw [min_eq_left h] + +/-- **The loop's trajectory.** With the counter growing one mark per iteration +and the state always fitting in the input, the `i+1`-st state is exactly the +counter `(Krev.take (i+1)).reverse` beside the value `iterVal … i`. -/ +theorem iterStep_iterate (F : List Bool → List Bool) (Krev W v₀ : List Bool) + (hK : Krev ≠ []) + (hfit : ∀ i, (pair ((Krev.take (i + 1)).reverse) (iterVal F Krev W v₀ i)).length + ≤ (pair (pair Krev W) v₀).length) : + ∀ i, (iterStep F)^[i + 1] (pair [] (pair (pair Krev W) v₀)) + = pair (pair ((Krev.take (i + 1)).reverse) (iterVal F Krev W v₀ i)) + (pair (pair Krev W) v₀) := by + intro i + induction i with + | zero => + rw [Function.iterate_succ_apply', Function.iterate_zero_apply, iterStep, sndBlock_pair] + rw [show nextCounter (pair [] (pair (pair Krev W) v₀)) = (Krev.take 1).reverse from by + rw [nextCounter, fstBlock_pair, sndBlock_pair, fstBlock_pair, fstBlock_pair, + takeLen_pair] + simp [fstBlock]] + rw [show nextValue F (pair [] (pair (pair Krev W) v₀)) = v₀ from by + rw [nextValue, fstBlock_pair, show fstBlock ([] : List Bool) = [] from rfl, + selectHead_emptyFlag_nil, sndBlock_pair, sndBlock_pair]] + rw [takeLen_pair] + show pair ((pair ((Krev.take (0 + 1)).reverse) (iterVal F Krev W v₀ 0)).take + (pair (pair Krev W) v₀).length) (pair (pair Krev W) v₀) = _ + rw [List.take_of_length_le (hfit 0)] + | succ i ih => + rw [Function.iterate_succ_apply', ih, iterStep, sndBlock_pair] + have hlen : ((Krev.take (i + 1)).reverse).length = min (i + 1) Krev.length := by + simp + have hC : nextCounter (pair (pair ((Krev.take (i + 1)).reverse) + (iterVal F Krev W v₀ i)) (pair (pair Krev W) v₀)) + = (Krev.take (i + 2)).reverse := by + rw [nextCounter, fstBlock_pair, sndBlock_pair, fstBlock_pair, fstBlock_pair, + fstBlock_pair, takeLen_pair, List.length_cons, hlen, take_succ_min] + have hne : (Krev.take (i + 1)).reverse ≠ [] := by + intro hc + have : Krev.length = 0 := by + have h0 : ((Krev.take (i + 1)).reverse).length = 0 := by rw [hc]; rfl + rw [hlen] at h0 + omega + exact hK (List.eq_nil_of_length_eq_zero this) + obtain ⟨b, t, hbt⟩ := List.exists_cons_of_ne_nil hne + have hV : nextValue F (pair (pair ((Krev.take (i + 1)).reverse) + (iterVal F Krev W v₀ i)) (pair (pair Krev W) v₀)) + = iterVal F Krev W v₀ (i + 1) := by + rw [nextValue, fstBlock_pair, fstBlock_pair, sndBlock_pair, sndBlock_pair, + fstBlock_pair, sndBlock_pair, hbt, selectHead_emptyFlag_cons, ← hbt, hC, + takeLen_pair, sndBlock_pair, iterVal] + rw [hC, hV, takeLen_pair, List.take_of_length_le (hfit (i + 1))] + +theorem counter_take_le (a j : ℕ) (h : j ≤ a) : + (List.replicate a false ++ [true]).take j = List.replicate j false := by + rw [List.take_append_of_le_length (by simpa using h), List.take_replicate, min_eq_left h] + +theorem counter_head_false (a j : ℕ) (h1 : 1 ≤ j) (h2 : j ≤ a) : + (((List.replicate a false ++ [true]).take j).reverse).head? = some false := by + rw [counter_take_le a j h2, List.reverse_replicate] + cases j with + | zero => omega + | succ j => rfl + +theorem counter_head_true (a j : ℕ) (h : a + 1 ≤ j) : + (((List.replicate a false ++ [true]).take j).reverse).head? = some true := by + rw [List.take_of_length_le (by simp; omega), List.reverse_append, List.reverse_replicate] + rfl + +/-- **The value sequence is the iterate.** While the counter has marks left the +step applies `F`; once it saturates the value stops changing. The clamp is a +no-op because every intermediate value fits in `W`. -/ +theorem iterVal_eq_iterate (F : List Bool → List Bool) (W v₀ : List Bool) (M : ℕ) + (hclamp : ∀ j, j ≤ M → (F^[j] v₀).length ≤ W.length) : + ∀ i, iterVal F (List.replicate (M + 1) false ++ [true]) W v₀ i = F^[min i M] v₀ := by + intro i + induction i with + | zero => simp [iterVal] + | succ i ih => + rw [iterVal, ih] + by_cases h : i + 2 ≤ M + 1 + · have hhead := counter_head_false (M + 1) (i + 2) (by omega) h + rw [selectHead, if_neg (by rw [hhead]; simp), if_pos hhead, + show min i M = i from by omega, ← Function.iterate_succ_apply' F i v₀, + List.take_of_length_le (hclamp (i + 1) (by omega)), + show min (i + 1) M = i + 1 from by omega] + · have hhead := counter_head_true (M + 1) (i + 2) (by omega) + rw [selectHead, if_pos hhead, show min i M = M from by omega, + show min (i + 1) M = M from by omega] + +/-- **`FP` is closed under bounded iteration** — the one machine-level fact the +soundness direction needs. + +*Construction.* The machine is assembled in +`Complexitylib.Classes.P.Cobham.Internal.Iterate` out of the phase contracts of +`Complexitylib.Classes.P.Cobham.Internal.IterateLayout`; `iterate_input_mem_FP` is its +interface. Three details are worth recording, because three earlier plans died +on them. + +*Why resetting scratch is the crux.* `F`'s machine `M` comes from an +existential (`F ∈ FP`), so nothing is known about the shape it leaves its +scratch tapes in. Re-running it needs those tapes genuinely blank, but a +content-driven eraser (`TM.blankWorkTM` scans right to the *first* blank) +under-wipes whenever `M` left a gap — an isolated blank cell with more content +beyond it. `TM.wipeStepTM` therefore writes blank *unconditionally*, and +`Complexity.resetTapesTM` drives it a fixed number of times off a fuel register +that is unrelated to the wiped tapes' content. `TM.reachesIn_work_cells_far` +supplies the bound that makes the fixed count sufficient: a `t`-step run cannot +have touched anything past `head + t`. `Complexity.iterTail` is the resulting +five-phase cleanup, shared by the loop body and the setup; its first two phases +are not bookkeeping either, since `δ_right_of_start` only forces a head +*reading* `▷` to move right, so an arbitrary witness machine may legitimately +*halt* with a head at cell `0`. + +*Why the state carries the machine's own input.* `TM.ComputesInTime` quantifies +over *all* inputs, so the loop's contract has to survive malformed ones: the +state is `pair (pair C v) x` with the machine's input `x` kept verbatim, and +every new state is truncated to `|x|` (`iterStep`). That makes +`iterStep_iterate_length_le` — a state-length bound holding for every input, +not just the well-formed ones — available for free, and keeps the ruler and the +width readable at every step. On the intended trajectory the truncation is a +no-op (`iterStep_iterate`). + +*How the counter avoids a second fuel value.* The loop runs `|x| + 1` times, one +per bit of the machine's own input (`TM.inputLenRegTM`), which is more +iterations than needed; the surplus is absorbed by a counter that grows one mark +of `Krev = 0^(m+1) 1` per step, whose leading bit turns `true` exactly when the +`m` real applications are done (`counter_head_false`, `counter_head_true`). So +`iterVal` is `F` iterated `min i m` times, and over-iteration is harmless +(`iterVal_eq_iterate`). The wipe width is a *different* register, `p.eval |x|`, +computed by `TM.polyEvalTM` — the state is longer than the input, so `|x|` +alone cannot pay for the reset. + +*Time.* Each iteration costs `iterStep`'s own polynomial bound at width +`(width z).length` — which is why `hbound` is a hypothesis — plus the linear +copies and the wipe, and there are `|x| + 1` of them, so the total is polynomial +(`polyBnd_iterBound`). -/ +theorem iterate_mem_FP {F init ruler width : List Bool → List Bool} + (hF : F ∈ FP) (hinit : init ∈ FP) (hruler : ruler ∈ FP) (hwidth : width ∈ FP) + (hbound : ∀ z, ∀ n ≤ (ruler z).length, + (F^[n] (init z)).length ≤ (width z).length) : + (fun z => F^[(ruler z).length] (init z)) ∈ FP := by + set Krev : List Bool → List Bool := + fun z => List.replicate ((ruler z).length + 1) false ++ [true] with hKrev + have hKrevLen : ∀ z, (Krev z).length = (ruler z).length + 2 := by + intro z; rw [hKrev]; simp + have hKrevNe : ∀ z, Krev z ≠ [] := by + intro z h + have := hKrevLen z + rw [h] at this + simp at this + -- the machine's input + set X : List Bool → List Bool := + fun z => pair (pair (Krev z) (width z)) (init z) with hX + have hXlen : ∀ z, (X z).length + = 4 * (Krev z).length + 2 * (width z).length + (init z).length + 6 := by + intro z; rw [hX]; simp only [pair_length]; omega + -- the iterated step is `FP`, and its state length is globally bounded + have hstep : iterStep F ∈ FP := iterStep_mem_FP hF + have hr : ∀ (x : List Bool), ∀ i ≤ x.length, + ((iterStep F)^[i] (pair [] x)).length + ≤ (3 * Polynomial.X + Polynomial.C 2 : Polynomial ℕ).eval x.length := by + intro x i _ + have := iterStep_iterate_length_le F x i + simpa using this + have hΛ := iterate_input_mem_FP hstep (3 * Polynomial.X + Polynomial.C 2) hr + -- the wrapper is `FP`, so the composite is + have hXFP : X ∈ FP := by + have hone : (fun _ : List Bool => [false]) ∈ FP := by + simpa [Function.comp] using mem_FP_comp const_nil_mem_FP (cons_mem_FP false) + have htrue : (fun _ : List Bool => [true]) ∈ FP := by + simpa [Function.comp] using mem_FP_comp const_nil_mem_FP (cons_mem_FP true) + have hrl : (fun z => ruler z ++ [false]) ∈ FP := appendFn_mem_FP hruler hone + have hrep : (fun z => List.replicate ((ruler z).length + 1) false) ∈ FP := by + have := mulLenFn_mem_FP hrl hone + simpa using this + exact pairFn_mem_FP (pairFn_mem_FP (appendFn_mem_FP hrep htrue) hwidth) hinit + have hXeq : ∀ z, X z = pair (pair (Krev z) (width z)) (init z) := fun z => by rw [hX] + have heq : (fun z => F^[(ruler z).length] (init z)) + = sndBlock ∘ (fstBlock ∘ ((fun x => (iterStep F)^[x.length + 1] (pair [] x)) ∘ X)) := by + funext z + simp only [Function.comp_apply] + have hfit : ∀ i, (pair (((Krev z).take (i + 1)).reverse) + (iterVal F (Krev z) (width z) (init z) i)).length ≤ (X z).length := by + intro i + have h1 : (((Krev z).take (i + 1)).reverse).length ≤ (Krev z).length := by simp + have h2 := iterVal_length_le F (Krev z) (width z) (init z) i + rw [pair_length, hXlen z] + omega + have hval : ∀ i, iterVal F (Krev z) (width z) (init z) i + = F^[min i (ruler z).length] (init z) := by + have hclamp : ∀ j, j ≤ (ruler z).length → (F^[j] (init z)).length ≤ (width z).length := + fun j hj => hbound z j hj + intro i + exact iterVal_eq_iterate F (width z) (init z) (ruler z).length hclamp i + have hiter := iterStep_iterate F (Krev z) (width z) (init z) (hKrevNe z) hfit (X z).length + have hlarge : (ruler z).length ≤ (X z).length := by + have := hKrevLen z + rw [hXlen z]; omega + rw [hXeq z, hiter, fstBlock_pair, sndBlock_pair, hval, min_eq_right hlarge] + rw [heq] + exact mem_FP_comp (mem_FP_comp (mem_FP_comp hXFP hΛ) fstBlock_mem_FP) sndBlock_mem_FP + +/-- **The loop of the `boundedRec` case.** `recFoldClamp` is `loopStep` iterated +once per bit of `sndBlock z` (`loopStep_iterate`), started from the packed state +`pair (pair R (pair W s)) (pair [] (e.take |R|))` — with `R` an *exact* ruler for +the clamp (`exists_exact_ruler`) — and read off with two `sndBlock`s. -/ +theorem recFoldClamp_mem_FP {A B E : List Bool → List Bool} + (hA : A ∈ FP) (hB : B ∈ FP) (hE : E ∈ FP) (p : Polynomial ℕ) : + (fun z => recFoldClamp A B (p.eval z.length) (E z) (fstBlock z) (sndBlock z)) + ∈ FP := by + obtain ⟨R, hR, hRlen⟩ := exists_exact_ruler p + have hfst : fstBlock ∈ FP := fstBlock_mem_FP + have hsnd : sndBlock ∈ FP := sndBlock_mem_FP + have hP : (fun z => pair (R z) (pair (fstBlock z) (sndBlock z))) ∈ FP := + pairFn_mem_FP hR (pairFn_mem_FP hfst hsnd) + have hinit : (fun z => pair (pair (R z) (pair (fstBlock z) (sndBlock z))) + (pair [] ((E z).take (R z).length))) ∈ FP := + pairFn_mem_FP hP (pairFn_mem_FP const_nil_mem_FP (takeLenFn_mem_FP hR hE)) + have hwidth : (fun z => pair (pair (R z) (pair (fstBlock z) (sndBlock z))) + (pair (sndBlock z) (R z))) ∈ FP := pairFn_mem_FP hP (pairFn_mem_FP hsnd hR) + have hbound : ∀ z, ∀ n ≤ (sndBlock z).length, + ((loopStep A B)^[n] (pair (pair (R z) (pair (fstBlock z) (sndBlock z))) + (pair [] ((E z).take (R z).length)))).length + ≤ (pair (pair (R z) (pair (fstBlock z) (sndBlock z))) + (pair (sndBlock z) (R z))).length := by + intro z n hn + rw [loopStep_iterate (A := A) (B := B) (R z) (fstBlock z) (sndBlock z) (E z) n hn] + have h1 : ((sndBlock z).drop ((sndBlock z).length - n)).length + ≤ (sndBlock z).length := by simp + have h2 : (recFoldClamp A B (R z).length (E z) (fstBlock z) + ((sndBlock z).drop ((sndBlock z).length - n))).length ≤ (R z).length := + recFoldClamp_length_le _ _ _ _ _ _ + simp only [pair_length] + omega + have hiter := iterate_mem_FP (loopStep_mem_FP hA hB) hinit hsnd hwidth hbound + have hout := mem_FP_comp hiter (mem_FP_comp hsnd hsnd) + have heq : ((sndBlock ∘ sndBlock) ∘ fun z => + (loopStep A B)^[(sndBlock z).length] + (pair (pair (R z) (pair (fstBlock z) (sndBlock z))) + (pair [] ((E z).take (R z).length)))) + = fun z => recFoldClamp A B (p.eval z.length) (E z) (fstBlock z) (sndBlock z) := by + funext z + rw [Function.comp, Function.comp, + loopStep_iterate (A := A) (B := B) (R z) (fstBlock z) (sndBlock z) (E z) + (sndBlock z).length le_rfl] + simp [hRlen z] + rwa [heq] at hout + +/-- Truncation is a no-op as soon as every intermediate value already fits. -/ +theorem recFoldClamp_eq_recFold {A B : List Bool → List Bool} {bound : ℕ} + {e W : List Bool} (s : List Bool) + (hle : ∀ t : List Bool, t.length ≤ s.length → + (recFold A B e W t).length ≤ bound) : + recFoldClamp A B bound e W s = recFold A B e W s := by + induction s with + | nil => + show e.take bound = e + exact List.take_of_length_le (hle [] (by simp)) + | cons b t ih => + have htail : recFoldClamp A B bound e W t = recFold A B e W t := + ih fun u hu => hle u (by simp only [List.length_cons]; omega) + show ((bif b then B else A) + (pair (pair W (recFoldClamp A B bound e W t)) t)).take bound = _ + rw [htail] + exact List.take_of_length_le (hle (b :: t) le_rfl) + +/-- On encoded arguments the loop computes recursion on notation: `recFold` over +the `FP` witnesses of `g`, `h₀`, `h₁` reproduces `recNotation`. -/ +theorem recFold_eq_recNotation {n : ℕ} {g : (Fin n → List Bool) → List Bool} + {h₀ h₁ : (Fin (n + 2) → List Bool) → List Bool} + {G H₀ H₁ : List Bool → List Bool} + (hG : ∀ u : Fin n → List Bool, G (encodeVec u) = g u) + (hH₀ : ∀ u : Fin (n + 2) → List Bool, H₀ (encodeVec u) = h₀ u) + (hH₁ : ∀ u : Fin (n + 2) → List Bool, H₁ (encodeVec u) = h₁ u) + (w : Fin n → List Bool) (s : List Bool) : + recFold H₀ H₁ (G (encodeVec w)) (encodeVec w) s = recNotation g h₀ h₁ s w := by + -- The encoded step argument is exactly the vector `Fin.cons t (Fin.cons a w)`. + have henc : ∀ (t a : List Bool), + pair (pair (encodeVec w) a) t = encodeVec (Fin.cons t (Fin.cons a w)) := by + intro t a + rw [encodeVec_succ, encodeVec_succ] + simp [Fin.tail_cons] + induction s with + | nil => exact hG w + | cons b t ih => + show (bif b then H₁ else H₀) + (pair (pair (encodeVec w) (recFold H₀ H₁ (G (encodeVec w)) (encodeVec w) t)) t) + = _ + rw [ih, henc, recNotation_cons] + cases b + · simp only [cond_false]; exact hH₀ _ + · simp only [cond_true]; exact hH₁ _ + +/-- Every `FP` function has polynomially bounded output length: a time bound is +also an output-length bound (`TM.ComputesInTime.output_length_le`). -/ +theorem output_length_poly_of_mem_FP {f : List Bool → List Bool} (hf : f ∈ FP) : + ∃ p : Polynomial ℕ, ∀ x, (f x).length ≤ p.eval x.length := by + obtain ⟨k, tm, p, hcomp⟩ := mem_FP_iff_computesInTime_polynomial.mp hf + exact ⟨p, fun x => hcomp.output_length_le x⟩ + +/-- `boundedRec` case: `FPn` is closed under limited recursion on notation. + +By `recFold_eq_recNotation` the value is the encoded-argument loop `recFold` run +over the bits of `v 0`. Cobham's limited-recursion side condition `hbound` caps +every intermediate accumulator by `|j (…)|`, which is polynomial in `|encodeVec v|` +(`output_length_poly_of_mem_FP`), so the clamped loop `recFoldClamp` — which a +machine can run in polynomial time (`recFoldClamp_mem_FP`) — never truncates and +therefore agrees with `recFold`. -/ +theorem fpn_boundedRec {n : ℕ} {g : (Fin n → List Bool) → List Bool} + {h₀ h₁ : (Fin (n + 2) → List Bool) → List Bool} + {j : (Fin (n + 1) → List Bool) → List Bool} + (ihg : FPn g) (ih0 : FPn h₀) (ih1 : FPn h₁) (ihj : FPn j) + (hbound : ∀ x v, (recNotation g h₀ h₁ x v).length ≤ (j (Fin.cons x v)).length) : + FPn (fun v : Fin (n + 1) → List Bool => + recNotation g h₀ h₁ (v 0) (Fin.tail v)) := by + obtain ⟨G, hGFP, hG⟩ := ihg + obtain ⟨H₀, hH0FP, hH0⟩ := ih0 + obtain ⟨H₁, hH1FP, hH1⟩ := ih1 + obtain ⟨J, hJFP, hJ⟩ := ihj + obtain ⟨p, hp⟩ := output_length_poly_of_mem_FP hJFP + have hE : (fun z => G (fstBlock z)) ∈ FP := mem_FP_comp fstBlock_mem_FP hGFP + refine ⟨fun z => recFoldClamp H₀ H₁ (p.eval z.length) (G (fstBlock z)) (fstBlock z) + (sndBlock z), recFoldClamp_mem_FP hH0FP hH1FP hE p, fun v => ?_⟩ + show recFoldClamp H₀ H₁ (p.eval (encodeVec v).length) (G (fstBlock (encodeVec v))) + (fstBlock (encodeVec v)) (sndBlock (encodeVec v)) + = recNotation g h₀ h₁ (v 0) (Fin.tail v) + rw [fstBlock_encodeVec_succ, sndBlock_encodeVec_succ] + rw [recFoldClamp_eq_recFold (v 0) ?_] + · exact recFold_eq_recNotation hG hH0 hH1 (Fin.tail v) (v 0) + · -- Cobham's limited-recursion bound caps every intermediate accumulator. + intro t ht + rw [recFold_eq_recNotation hG hH0 hH1 (Fin.tail v) t] + refine le_trans (hbound t (Fin.tail v)) ?_ + have hJt : (j (Fin.cons t (Fin.tail v))).length + ≤ p.eval (encodeVec (Fin.cons t (Fin.tail v))).length := by + rw [← hJ (Fin.cons t (Fin.tail v))] + exact hp _ + refine le_trans hJt (polynomial_eval_mono_nat p ?_) + have e1 : (encodeVec (Fin.cons t (Fin.tail v))).length + = 2 * (encodeVec (Fin.tail v)).length + 2 + t.length := by + simp [encodeVec_succ, Fin.tail_cons] + have e2 : (encodeVec v).length + = 2 * (encodeVec (Fin.tail v)).length + 2 + (v 0).length := by + simp [encodeVec_succ] + omega + +/-- **Soundness induction.** Every function of Cobham's algebra is polynomial +time on encoded argument vectors. -/ +theorem cobham_imp_FPn : ∀ {n : ℕ} {f : (Fin n → List Bool) → List Bool}, + Cobham f → FPn f := by + intro n f h + induction h with + | proj i => exact fpn_proj i + | empty => exact fpn_empty + | bit b => exact fpn_bit b + | smash => exact fpn_smash + | comp _ _ ihf ihgs => exact fpn_comp ihf ihgs + | boundedRec _ _ _ _ hbound ihg ih0 ih1 ihj => + exact fpn_boundedRec ihg ih0 ih1 ihj hbound + +/-- Arity-one specialization: from the multi-arity soundness induction, the +unary fragment `CobhamFP` lands in `FP`. -/ +theorem CobhamFP_subset_FP_of_FPn : CobhamFP ⊆ FP := by + intro f hf + obtain ⟨g, hg, hgf⟩ := cobham_imp_FPn hf + -- `hgf` specialized to `![x]`: `g (pair [] x) = f x`. + have hval : ∀ x : List Bool, g (pair [] x) = f x := by + intro x + have := hgf ![x] + rwa [encodeVec_one] at this + -- Hence `f = g ∘ (x ↦ pair [] x)`, a composition of `FP` functions. + have hfeq : f = g ∘ fun x : List Bool => pair [] x := by + funext x; simp [Function.comp, hval x] + rw [hfeq] + exact mem_FP_comp pairLeftNil_mem_FP hg + +/-! ## Completeness: `FP ⊆ CobhamFP` -/ + +/-- **Completeness direction.** Every polynomial-time function belongs to +Cobham's algebra. + +*Construction:* a polynomial-time Turing machine is simulated inside the algebra. +1. A whole configuration — state, input tape, output tape, work tapes and every + head position — is one bitstring of equal-width blocks, each tape split at its + head so that a head move is a two-bit shift (`Cobham.cfgCode`). +2. The one-step transition is a finite case split on (state, symbols read), which + is `Cobham.tableFn` against the finitely many fixedValue key patterns, with each + branch built from `takeFn`/`dropFn`/`appendFn`/`padFn` (`Cobham.stepFn`). At + the halting state the branch is the identity, so the encoding is a fixed point + once the machine stops. +3. The step is iterated once per bit of a clock string built from `smash` + (`Cobham.exists_pow_clock`), long enough by the polynomial normal form + `mem_FP_iff_computesInTime_polynomial`. +4. A second iteration walks the output head back to cell `0` + (`Cobham.rewindFn`), after which that tape's right half-block is the whole + tape in order, and the output is read off it by two `Complexity.cellBits` + recursions and one `Complexity.runTrue` (`Cobham.simFn`). +The length bounds throughout are polynomial, so every `boundedRec` side condition +is met. -/ +theorem FP_subset_CobhamFP_internal : FP ⊆ CobhamFP := by + intro f hf + obtain ⟨k, tm, p, hcomp⟩ := mem_FP_iff_computesInTime_polynomial.mp hf + exact computes_mem_CobhamFP tm + (S := ∑ i ∈ Finset.range (p.natDegree + 1), p.coeff i) (D := p.natDegree) + (poly_eval_le_pow p) hcomp + +/-- **Multi-arity completeness.** A unary `FP` witness on canonical encodings is +first translated into the unary Cobham algebra and then composed with +`encodeVec_mem_internal`. -/ +theorem FPn_imp_cobham_internal {n : ℕ} {f : (Fin n → List Bool) → List Bool} + (hf : FPn f) : Cobham f := by + obtain ⟨g, hg, hgf⟩ := hf + have hgCobham : Cobham fun v : Fin 1 → List Bool => g (v 0) := + FP_subset_CobhamFP_internal hg + refine (Cobham.comp hgCobham fun _ : Fin 1 => encodeVec_mem_internal).of_eq fun v => ?_ + exact hgf v diff --git a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/Algebra.lean b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/Algebra.lean new file mode 100644 index 0000000000..6c29285baa --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/Algebra.lean @@ -0,0 +1,543 @@ +/- +Copyright (c) 2026 Bolton Bailey. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Bolton Bailey +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.Blocks +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Defs +public import LeanPool.BeyondBethe.Complexitylib.Encoding.Pairing +public import Mathlib.Data.Fin.VecNotation +import Mathlib.Data.Fintype.Basic +import Mathlib.Tactic.FinCases +public import Mathlib.Tactic.Ring + +/-! +# Cobham's algebra — the working toolkit + +Derived members of `Complexity.Cobham`: the operations a Turing-machine +interpreter written inside the algebra needs. Each is a single limited recursion +on notation, or a finite composition of such. + +Two of these carry the weight. `dispatch` shows that branching is free: the step +functions of `recNotation` are already selected by the bit being peeled, so a +one-step recursion on `v 0` *is* an if-then-else on its leading bit. +`dropPrefix` shows how to move an argument that changes along a recursion — +`recNotation` fixes its parameters, so the changing value has to live in the +recursion's *value*, and iterating `tail` there gives `drop`. With `drop` in +hand, `takePrefix` reads off successive bits, and fixed-width pairing with +projections follows. +-/ + + +public section + +namespace Complexity + +namespace Cobham + +/-- The class respects pointwise equality of functions. Useful because the constructors +of `Cobham` produce syntactically specific lambda terms. -/ +theorem of_eq {n : ℕ} {f g : (Fin n → List Bool) → List Bool} (hf : Cobham f) + (h : ∀ v, f v = g v) : Cobham g := + (funext h : f = g) ▸ hf + +/-- Every fixedValue function is in the class: build the fixedValue string bit by bit from +`empty` and the successors. -/ +theorem const {n : ℕ} (s : List Bool) : Cobham fun _ : Fin n → List Bool => s := by + induction s with + | nil => exact .empty + | cons b s ih => exact (Cobham.comp (.bit b) fun _ : Fin 1 => ih).of_eq fun v => rfl + +/-- Composition with two inner functions, packaged for readability: the +constructor's `Fin`-indexed family is awkward to supply when the two components +differ. -/ +theorem comp₂ {n : ℕ} {f : (Fin 2 → List Bool) → List Bool} + {g₀ g₁ : (Fin n → List Bool) → List Bool} + (hf : Cobham f) (h₀ : Cobham g₀) (h₁ : Cobham g₁) : + Cobham fun v : Fin n → List Bool => f ![g₀ v, g₁ v] := by + refine (Cobham.comp hf (gs := ![g₀, g₁]) ?_).of_eq fun v => ?_ + · intro i; fin_cases i <;> assumption + · congr 1 + funext i + fin_cases i <;> rfl + +/-- Composition with three inner functions. -/ +theorem comp₃ {n : ℕ} {f : (Fin 3 → List Bool) → List Bool} + {g₀ g₁ g₂ : (Fin n → List Bool) → List Bool} + (hf : Cobham f) (h₀ : Cobham g₀) (h₁ : Cobham g₁) (h₂ : Cobham g₂) : + Cobham fun v : Fin n → List Bool => f ![g₀ v, g₁ v, g₂ v] := by + refine (Cobham.comp hf (gs := ![g₀, g₁, g₂]) ?_).of_eq fun v => ?_ + · intro i; fin_cases i <;> assumption + · congr 1 + funext i + fin_cases i <;> rfl + +/-- Concatenation is in the class, by limited recursion on notation on the first +argument with bound `smash (true :: x) (true :: y)`. -/ +theorem append : Cobham fun v : Fin 2 → List Bool => v 0 ++ v 1 := by + -- Recursion on notation computing `x ++ y`: base `y`, step `b :: ·` on the + -- recursive value. + have hrec : ∀ (x : List Bool) (v : Fin 1 → List Bool), + recNotation (fun v : Fin 1 → List Bool => v 0) + (fun w : Fin 3 → List Bool => false :: w 1) + (fun w : Fin 3 → List Bool => true :: w 1) x v = x ++ v 0 := by + intro x v + induction x with + | nil => rfl + | cons b x ih => cases b <;> simp [ih] + -- The bit-prepending step functions are in the class. + have hstep : ∀ b : Bool, Cobham fun w : Fin 3 → List Bool => b :: w 1 := fun b => + (Cobham.comp (.bit b) fun _ : Fin 1 => .proj 1).of_eq fun v => rfl + -- The length bound `smash (true :: x) (true :: y)` is in the class. + have hj : Cobham fun w : Fin 2 → List Bool => + Complexity.smash (true :: w 0) (true :: w 1) := + (Cobham.comp .smash fun i : Fin 2 => + (Cobham.comp (.bit true) fun _ : Fin 1 => .proj i).of_eq fun v => rfl).of_eq + fun v => rfl + refine (Cobham.boundedRec (.proj 0) (hstep false) (hstep true) hj ?_).of_eq fun v => ?_ + · intro x v + rw [hrec] + have h1 : (Fin.cons x v : Fin 2 → List Bool) 1 = v 0 := rfl + have hexp : (x.length + 1) * ((v 0).length + 1) = + x.length * (v 0).length + x.length + (v 0).length + 1 := by ring + simp only [Fin.cons_zero, h1, smash_length, List.length_append, List.length_cons] + omega + · rw [hrec] + rfl + +/-- Concatenation of two members of the class is a member of the class. -/ +theorem appendFn {n : ℕ} {g₀ g₁ : (Fin n → List Bool) → List Bool} + (h₀ : Cobham g₀) (h₁ : Cobham g₁) : + Cobham fun v : Fin n → List Bool => g₀ v ++ g₁ v := + (comp₂ append h₀ h₁).of_eq fun v => by simp + +/-- The self-delimiting pairing `pair x y = delimit x ++ y` is in the class, by +limited recursion on notation on `x`: each peeled bit is doubled onto the +recursive value, and the base case emits the separator `01` followed by `y`. The +bound is exact — `|pair x y| = |x ++ x| + |y ++ [0,1]|`. -/ +theorem pairing : Cobham fun v : Fin 2 → List Bool => pair (v 0) (v 1) := by + have hrec : ∀ (x : List Bool) (v : Fin 1 → List Bool), + recNotation (fun u : Fin 1 → List Bool => false :: true :: u 0) + (fun w : Fin 3 → List Bool => false :: false :: w 1) + (fun w : Fin 3 → List Bool => true :: true :: w 1) x v + = pair x (v 0) := by + intro x v + induction x with + | nil => rfl + | cons b x ih => cases b <;> simp [pair_cons_eq, ih] + have hg : Cobham fun u : Fin 1 → List Bool => false :: true :: u 0 := + (Cobham.comp (.bit false) fun _ : Fin 1 => + (Cobham.comp (.bit true) fun _ : Fin 1 => .proj 0).of_eq fun v => rfl).of_eq + fun v => rfl + have hstep : ∀ b : Bool, Cobham fun w : Fin 3 → List Bool => b :: b :: w 1 := fun b => + (Cobham.comp (.bit b) fun _ : Fin 1 => + (Cobham.comp (.bit b) fun _ : Fin 1 => .proj 1).of_eq fun v => rfl).of_eq + fun v => rfl + have hj : Cobham fun w : Fin 2 → List Bool => + (w 0 ++ w 0) ++ (w 1 ++ [false, true]) := + appendFn (appendFn (.proj 0) (.proj 0)) + (appendFn (.proj 1) (Cobham.const [false, true])) + refine (Cobham.boundedRec hg (hstep false) (hstep true) hj ?_).of_eq fun v => ?_ + · intro x v + rw [hrec] + have h0 : (Fin.cons x v : Fin 2 → List Bool) 0 = x := rfl + have h1 : (Fin.cons x v : Fin 2 → List Bool) 1 = v 0 := rfl + simp only [h0, h1, pair_length, List.length_append, List.length_cons, + List.length_nil] + omega + · rw [hrec] + rfl + +/-- Dropping the leading bit is in the class, by limited recursion on notation: +on `b :: x` both step functions return the peeled tail `x`, and the argument +itself bounds the result. -/ +theorem tail : Cobham fun v : Fin 1 → List Bool => (v 0).tail := by + have hrec : ∀ (x : List Bool) (v : Fin 0 → List Bool), + recNotation (fun _ : Fin 0 → List Bool => ([] : List Bool)) + (fun w : Fin 2 → List Bool => w 0) (fun w : Fin 2 → List Bool => w 0) x v + = x.tail := by + intro x v + cases x with + | nil => rfl + | cons b x => cases b <;> rfl + refine (Cobham.boundedRec .empty (.proj 0) (.proj 0) (.proj 0) ?_).of_eq fun v => ?_ + · intro x v + rw [hrec, Fin.cons_zero] + cases x <;> simp + · rw [hrec] + +/-- **Bit dispatch is in the class.** `caseBit (v 0) (v 1) (v 2)` is a single +limited recursion on notation over `v 0`: the recursion's own bit-selected step +functions do the branching, projecting out `v 1` or `v 2`, and the concatenation +of the two branches bounds the result. -/ +theorem dispatch : Cobham fun v : Fin 3 → List Bool => + caseBit (v 0) (v 1) (v 2) := by + -- On `b :: x` the step argument is `⟨x, rec, v 1, v 2⟩`, so the branches are + -- projections 3 (bit `0`) and 2 (bit `1`). + have hrec : ∀ (x : List Bool) (v : Fin 2 → List Bool), + recNotation (fun _ : Fin 2 → List Bool => ([] : List Bool)) + (fun w : Fin 4 → List Bool => w 3) (fun w : Fin 4 → List Bool => w 2) x v + = caseBit x (v 0) (v 1) := by + intro x v + cases x with + | nil => rfl + | cons b x => cases b <;> rfl + -- The bound: the two branches concatenated. + have hj : Cobham fun w : Fin 3 → List Bool => w 1 ++ w 2 := + (Cobham.comp Cobham.append fun i : Fin 2 => Cobham.proj i.succ).of_eq fun v => rfl + refine (Cobham.boundedRec .empty (.proj 3) (.proj 2) hj ?_).of_eq fun v => ?_ + · intro x v + rw [hrec] + exact caseBit_length_le _ _ _ + · rw [hrec] + rfl + +/-- **Dropping a prefix of a given length is in the class.** `v 1` is advanced by +one `tail` per bit of the ruler `v 0`: the recursion applies `tail` to its own +recursive value, so the changing argument lives in the recursion's value rather +than in its parameters — which is what makes it expressible at all. -/ +theorem dropPrefix : + Cobham fun v : Fin 2 → List Bool => (v 1).drop (v 0).length := by + have hrec : ∀ (r : List Bool) (u : Fin 1 → List Bool), + recNotation (fun u : Fin 1 → List Bool => u 0) + (fun w : Fin 3 → List Bool => (w 1).tail) + (fun w : Fin 3 → List Bool => (w 1).tail) r u + = (u 0).drop r.length := by + intro r u + induction r with + | nil => rfl + | cons b r ih => cases b <;> simp [ih, List.tail_drop] + have hstep : Cobham fun w : Fin 3 → List Bool => (w 1).tail := + (Cobham.comp Cobham.tail fun _ : Fin 1 => Cobham.proj 1).of_eq fun v => rfl + refine (Cobham.boundedRec (.proj 0) hstep hstep (.proj 1) ?_).of_eq fun v => ?_ + · intro r u + rw [hrec, show (Fin.cons r u : Fin 2 → List Bool) 1 = u 0 from rfl] + simp + · rw [hrec] + rfl + +/-- One more bit of a prefix is the prefix plus the first bit of what remains. -/ +private theorem take_succ_eq (x : List Bool) (n : ℕ) : + x.take (n + 1) = x.take n ++ (x.drop n).take 1 := by + induction n generalizing x with + | zero => simp + | succ n ih => + cases x with + | nil => simp + | cons a x => simpa using ih x + +/-- **Taking a prefix of a given length is in the class.** Each bit of the ruler +`v 0` appends one more bit of `v 1`, read off by dispatching on the head of what +is still undropped — so `dropPrefix` and `dispatch` together give `take`. -/ +theorem takePrefix : + Cobham fun v : Fin 2 → List Bool => (v 1).take (v 0).length := by + have hbit : ∀ z : List Bool, caseBit z [true] [false] = z.take 1 := by + intro z; cases z with + | nil => rfl + | cons b z => cases b <;> rfl + have hrec : ∀ (r : List Bool) (u : Fin 1 → List Bool), + recNotation (fun _ : Fin 1 → List Bool => ([] : List Bool)) + (fun w : Fin 3 → List Bool => + w 1 ++ caseBit ((w 2).drop (w 0).length) [true] [false]) + (fun w : Fin 3 → List Bool => + w 1 ++ caseBit ((w 2).drop (w 0).length) [true] [false]) r u + = (u 0).take r.length := by + intro r u + induction r with + | nil => rfl + | cons b r ih => + cases b <;> + · show (recNotation _ _ _ r u) ++ caseBit _ _ _ = _ + rw [ih, hbit] + exact (take_succ_eq (u 0) r.length).symm + -- The step: append the next bit of `u 0`, located by dropping `|r|` bits. + have hdrop : Cobham fun w : Fin 3 → List Bool => (w 2).drop (w 0).length := + (comp₂ dropPrefix (.proj 0) (.proj 2)).of_eq fun v => by simp + have hbitFn : Cobham fun w : Fin 3 → List Bool => + caseBit ((w 2).drop (w 0).length) [true] [false] := + (comp₃ dispatch hdrop (Cobham.const [true]) (Cobham.const [false])).of_eq + fun v => by simp + have hstep : Cobham fun w : Fin 3 → List Bool => + w 1 ++ caseBit ((w 2).drop (w 0).length) [true] [false] := + appendFn (.proj 1) hbitFn + refine (Cobham.boundedRec .empty hstep hstep (.proj 1) ?_).of_eq fun v => ?_ + · intro r u + rw [hrec, show (Fin.cons r u : Fin 2 → List Bool) 1 = u 0 from rfl] + simp + · rw [hrec] + rfl + +/-- **Total bit dispatch is in the class.** Same recursion as `dispatch`, except +the base case returns the `false` branch instead of the empty string — so the +empty string reads as `false` and every flag is genuinely one bit. -/ +theorem dispatch₀ : Cobham fun v : Fin 3 → List Bool => + caseBit₀ (v 0) (v 1) (v 2) := by + have hrec : ∀ (x : List Bool) (v : Fin 2 → List Bool), + recNotation (fun u : Fin 2 → List Bool => u 1) + (fun w : Fin 4 → List Bool => w 3) (fun w : Fin 4 → List Bool => w 2) x v + = caseBit₀ x (v 0) (v 1) := by + intro x v + cases x with + | nil => rfl + | cons b x => cases b <;> rfl + have hj : Cobham fun w : Fin 3 → List Bool => w 1 ++ w 2 := + (Cobham.comp Cobham.append fun i : Fin 2 => Cobham.proj i.succ).of_eq fun v => rfl + refine (Cobham.boundedRec (.proj 1) (.proj 3) (.proj 2) hj ?_).of_eq fun v => ?_ + · intro x v + rw [hrec] + exact caseBit₀_length_le _ _ _ + · rw [hrec] + rfl + +/-- Applying `tail` to a member of the class. -/ +theorem tailFn {n : ℕ} {g : (Fin n → List Bool) → List Bool} (h : Cobham g) : + Cobham fun v : Fin n → List Bool => (g v).tail := + (Cobham.comp Cobham.tail fun _ : Fin 1 => h).of_eq fun _ => rfl + +/-- Total if-then-else on a flag is in the class. -/ +theorem iteFn {n : ℕ} {gc gx gy : (Fin n → List Bool) → List Bool} + (hc : Cobham gc) (hx : Cobham gx) (hy : Cobham gy) : + Cobham fun v : Fin n → List Bool => caseBit₀ (gc v) (gx v) (gy v) := + (comp₃ dispatch₀ hc hx hy).of_eq fun v => by simp + +/-- The flag connectives are in the class: each is one `dispatch₀`. -/ +theorem andFn {n : ℕ} {g₀ g₁ : (Fin n → List Bool) → List Bool} + (h₀ : Cobham g₀) (h₁ : Cobham g₁) : + Cobham fun v : Fin n → List Bool => andBit (g₀ v) (g₁ v) := + iteFn h₀ (iteFn h₁ (Cobham.const [true]) (Cobham.const [false])) + (Cobham.const [false]) + +/-- Disjunction of flags is in the class. -/ +theorem orFn {n : ℕ} {g₀ g₁ : (Fin n → List Bool) → List Bool} + (h₀ : Cobham g₀) (h₁ : Cobham g₁) : + Cobham fun v : Fin n → List Bool => orBit (g₀ v) (g₁ v) := + iteFn h₀ (Cobham.const [true]) + (iteFn h₁ (Cobham.const [true]) (Cobham.const [false])) + +/-- Negation of a flag is in the class. -/ +theorem notFn {n : ℕ} {g : (Fin n → List Bool) → List Bool} (h : Cobham g) : + Cobham fun v : Fin n → List Bool => notBit (g v) := + iteFn h (Cobham.const [false]) (Cobham.const [true]) + +/-- **Bit extraction is in the class**: drop to the marked position and dispatch +on what is left. -/ +theorem bitAtFn : Cobham fun v : Fin 2 → List Bool => bitAt (v 0) (v 1) := + (comp₃ dispatch₀ dropPrefix (Cobham.const [true]) (Cobham.const [false])).of_eq + fun v => by simp [bitAt] + +/-- Extracting the leading bit of a member of the class, as a flag. -/ +theorem headFlagFn {n : ℕ} {g : (Fin n → List Bool) → List Bool} (h : Cobham g) : + Cobham fun v : Fin n → List Bool => bitAt [] (g v) := + (comp₂ bitAtFn (Cobham.const []) h).of_eq fun v => by simp + +/-- **The nonemptiness flag is in the class.** This is the one consumer of the +*partial* dispatcher: both branches are `[true]`, so the flag is `[true]` exactly +when there is a bit to read and `[]` otherwise. -/ +theorem nonemptyFn {n : ℕ} {g : (Fin n → List Bool) → List Bool} (h : Cobham g) : + Cobham fun v : Fin n → List Bool => nonemptyFlag (g v) := + (comp₃ dispatch h (Cobham.const [true]) (Cobham.const [true])).of_eq + fun v => by simp [nonemptyFlag] + +/-- **Matching against a fixed fixedValue is in the class.** For each fixedValue the +test unfolds into finitely many bit comparisons joined by `andFn`, so this is a +finite composition — the meta-level induction is on the fixedValue, not a +recursion inside the algebra. -/ +theorem matchPrefixFn {n : ℕ} {g : (Fin n → List Bool) → List Bool} (h : Cobham g) + (c : List Bool) : + Cobham fun v : Fin n → List Bool => matchPrefix c (g v) := by + induction c generalizing g with + | nil => exact (Cobham.const [true]).of_eq fun v => rfl + | cons b c ih => + have htail := ih (tailFn h) + have hhead : Cobham fun v : Fin n → List Bool => + bif b then bitAt [] (g v) else notBit (bitAt [] (g v)) := by + cases b + · exact (notFn (headFlagFn h)).of_eq fun v => rfl + · exact (headFlagFn h).of_eq fun v => rfl + exact (andFn (nonemptyFn h) (andFn hhead htail)).of_eq fun v => rfl + +/-- Taking a prefix of one member of the class at the width of another. -/ +theorem takeFn {n : ℕ} {gr gx : (Fin n → List Bool) → List Bool} + (hr : Cobham gr) (hx : Cobham gx) : + Cobham fun v : Fin n → List Bool => (gx v).take (gr v).length := + (comp₂ takePrefix hr hx).of_eq fun v => by simp + +/-- Dropping a prefix of one member of the class at the width of another. -/ +theorem dropFn {n : ℕ} {gr gx : (Fin n → List Bool) → List Bool} + (hr : Cobham gr) (hx : Cobham gx) : + Cobham fun v : Fin n → List Bool => (gx v).drop (gr v).length := + (comp₂ dropPrefix hr hx).of_eq fun v => by simp + +/-- A block of `|x|` zeros is in the class, by limited recursion on notation: +each peeled bit prepends one `0` to the recursive value, and the argument bounds +the result. -/ +theorem lengthPad : + Cobham fun v : Fin 1 → List Bool => List.replicate (v 0).length false := by + have hrec : ∀ (x : List Bool) (v : Fin 0 → List Bool), + recNotation (fun _ : Fin 0 → List Bool => ([] : List Bool)) + (fun w : Fin 2 → List Bool => false :: w 1) + (fun w : Fin 2 → List Bool => false :: w 1) x v + = List.replicate x.length false := by + intro x v + induction x with + | nil => rfl + | cons b x ih => cases b <;> simp [ih, List.replicate_succ] + have hstep : Cobham fun w : Fin 2 → List Bool => false :: w 1 := + (Cobham.comp (.bit false) fun _ : Fin 1 => .proj 1).of_eq fun v => rfl + refine (Cobham.boundedRec .empty hstep hstep (.proj 0) ?_).of_eq fun v => ?_ + · intro x v + rw [hrec, Fin.cons_zero] + simp + · rw [hrec] + +/-- A block of zeros as wide as a member of the class. -/ +theorem zeroBlockFn {n : ℕ} {g : (Fin n → List Bool) → List Bool} (h : Cobham g) : + Cobham fun v : Fin n → List Bool => List.replicate (g v).length false := + (Cobham.comp lengthPad fun _ : Fin 1 => h).of_eq fun _ => rfl + +/-- Concatenating `i` copies of a member of the class — a finite composition, so +the induction is at the meta level. -/ +theorem repeatFn {n : ℕ} {g : (Fin n → List Bool) → List Bool} (h : Cobham g) : + ∀ i : ℕ, Cobham fun v : Fin n → List Bool => (List.replicate i (g v)).flatten + | 0 => Cobham.empty.of_eq fun _ => rfl + | i + 1 => (appendFn h (repeatFn h i)).of_eq fun _ => by + simp [List.replicate_succ] + +/-- **Block addressing is in the class.** With every field of a configuration +padded to the ruler's width, field `i` is `takeFn` after dropping `i` rulers — +and `i` is a fixed natural number, so the drop is a finite concatenation. -/ +theorem blockFn {n : ℕ} {gr gx : (Fin n → List Bool) → List Bool} + (hr : Cobham gr) (hx : Cobham gx) (i : ℕ) : + Cobham fun v : Fin n → List Bool => blockAt (gr v) (gx v) i := + (takeFn hr (dropFn (repeatFn hr i) hx)).of_eq fun v => by + rw [blockAt] + congr 2 + simp + +/-- **Fixed-width padding is in the class.** With every field of a simulated +configuration padded to one ruler's width, field `i` is recovered by dropping `i` +rulers and taking one — so no self-delimiting decoder is ever needed inside the +algebra. -/ +theorem padFn {n : ℕ} {gr gx : (Fin n → List Bool) → List Bool} + (hr : Cobham gr) (hx : Cobham gx) : + Cobham fun v : Fin n → List Bool => padTo (gr v) (gx v) := + (takeFn hr (appendFn hx (zeroBlockFn hr))).of_eq fun _ => rfl + +/-- **Finite table dispatch is in the class.** Matching a member of the class +against each of finitely many fixedValue patterns in turn, taking the first +branch that fires and a default otherwise, is a finite chain of `iteFn`s. + +This is exactly the shape of a Turing machine's transition function: the patterns +are the (state, symbols-read) combinations, of which there are finitely many for +a fixed machine, and the branches assemble the successor configuration. -/ +theorem tableFn {n : ℕ} {g d : (Fin n → List Bool) → List Bool} + (hg : Cobham g) (hd : Cobham d) + (table : List (List Bool × ((Fin n → List Bool) → List Bool))) + (hbranch : ∀ p ∈ table, Cobham p.2) : + Cobham fun v : Fin n → List Bool => + table.foldr (fun p acc => caseBit₀ (matchPrefix p.1 (g v)) (p.2 v) acc) + (d v) := by + induction table with + | nil => exact hd + | cons p t ih => + exact iteFn (matchPrefixFn hg p.1) (hbranch p (by simp)) + (ih fun q hq => hbranch q (by simp [hq])) + +/-- **A table of fixedValue patterns is a case analysis.** If some entry's pattern +prefixes the key, and every entry whose pattern prefixes the key carries the same +value, then the fold returns that value — regardless of the order the entries +appear in. + +Phrasing it as "all matching entries agree" rather than "exactly one matches" +avoids having to prove the patterns pairwise distinct: for a transition table the +patterns *are* distinct, but agreement is the weaker and more convenient +obligation. -/ +theorem foldr_table_eq (g d val : List Bool) : + ∀ table : List (List Bool × List Bool), + (∃ p ∈ table, p.1 <+: g) → + (∀ q ∈ table, q.1 <+: g → q.2 = val) → + table.foldr (fun q acc => caseBit₀ (matchPrefix q.1 g) q.2 acc) d = val := by + intro table + induction table with + | nil => rintro ⟨p, hp, -⟩ -; simp at hp + | cons a rest ih => + rintro ⟨p, hp, hpre⟩ hall + rcases Decidable.em (a.1 <+: g) with hm | hm + · rw [List.foldr_cons, (matchPrefix_eq_true_iff a.1 g).mpr hm, caseBit₀_cons, + cond_true] + exact hall a (by simp) hm + · have hmf : matchPrefix a.1 g = [false] := by + rcases matchPrefix_flag a.1 g with h | h + · exact absurd ((matchPrefix_eq_true_iff a.1 g).mp h) hm + · exact h + rw [List.foldr_cons, hmf, caseBit₀_cons, cond_false] + refine ih ⟨p, ?_, hpre⟩ fun q hq => hall q (by simp [hq]) + rcases List.mem_cons.mp hp with rfl | hp' + · exact absurd hpre hm + · exact hp' + +/-! ### Clocked iteration + +The engine of the completeness direction: a machine is simulated by iterating its +one-step transition function a polynomial number of times, and both halves of +that — the iteration and the polynomial clock — are cheap inside the algebra. -/ + +/-- **Bounded iteration is in the class.** Iterating a step function once per bit +of a clock string is a single limited recursion on notation: the recursion +ignores *which* bit it peels and simply applies the step to its own recursive +value, so `h₀ = h₁ = f ∘ Fin.tail`. The clock's length is the iteration count, +which is why polynomial clocks (`exists_pow_clock`) give polynomially many +steps. -/ +theorem iterFn {n : ℕ} {e : (Fin n → List Bool) → List Bool} + {f j : (Fin (n + 1) → List Bool) → List Bool} + (he : Cobham e) (hf : Cobham f) (hj : Cobham j) + (hbound : ∀ (c : List Bool) (v : Fin n → List Bool), + ((fun s => f (Fin.cons s v))^[c.length] (e v)).length + ≤ (j (Fin.cons c v)).length) : + Cobham fun v : Fin (n + 1) → List Bool => + (fun s => f (Fin.cons s (Fin.tail v)))^[(v 0).length] (e (Fin.tail v)) := by + have hstep : Cobham fun w : Fin (n + 1 + 1) → List Bool => f (Fin.tail w) := + (Cobham.comp hf fun i : Fin (n + 1) => Cobham.proj i.succ).of_eq fun w => rfl + have hrec : ∀ (c : List Bool) (v : Fin n → List Bool), + recNotation e (fun w : Fin (n + 1 + 1) → List Bool => f (Fin.tail w)) + (fun w : Fin (n + 1 + 1) → List Bool => f (Fin.tail w)) c v + = (fun s => f (Fin.cons s v))^[c.length] (e v) := by + intro c v + induction c with + | nil => rfl + | cons b c ih => + rw [List.length_cons, Function.iterate_succ_apply', ← ih] + cases b <;> simp [Fin.tail_cons] + refine (Cobham.boundedRec he hstep hstep hj ?_).of_eq fun v => ?_ + · intro c v + rw [hrec] + exact hbound c v + · rw [hrec] + +/-- **Clocks.** For every fixedValue `c` and exponent `d` there is a member of the +class whose value on `v` is at least `c · (|v 0| + 1) ^ d` bits long — built from +constants and `smash`, which is exactly what `smash` is for. -/ +theorem exists_pow_clock (c d : ℕ) : + ∃ f : (Fin 1 → List Bool) → List Bool, Cobham f ∧ + ∀ v : Fin 1 → List Bool, c * ((v 0).length + 1) ^ d ≤ (f v).length := by + induction d with + | zero => + exact ⟨fun _ => List.replicate c false, Cobham.const _, fun v => by simp⟩ + | succ d ih => + obtain ⟨f, hf, hlen⟩ := ih + have hsucc : Cobham fun v : Fin 1 → List Bool => false :: v 0 := + (Cobham.comp (.bit false) fun _ : Fin 1 => .proj 0).of_eq fun v => rfl + refine ⟨fun v => Complexity.smash (f v) (false :: v 0), + (comp₂ Cobham.smash hf hsucc).of_eq fun v => by simp, fun v => ?_⟩ + have h1 := hlen v + calc c * ((v 0).length + 1) ^ (d + 1) + = (c * ((v 0).length + 1) ^ d) * ((v 0).length + 1) := by ring + _ ≤ (f v).length * (false :: v 0).length := by + exact Nat.mul_le_mul h1 (by simp) + _ = _ := by simp + +end Cobham + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/BlockScan.lean b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/BlockScan.lean new file mode 100644 index 0000000000..5356e65cd6 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/BlockScan.lean @@ -0,0 +1,77 @@ +/- +Copyright (c) 2026 Bolton Bailey. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Bolton Bailey +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.Vec + +/-! +# What the block scanners compute — proof internals + +The two total parsers of a self-delimiting block — `Cobham.fstBlock` decodes the +leading block's payload, `Cobham.sndBlock` returns the suffix after it — and the +control states their scanners share. `Complexity.pairSplitCoreTM` handles only +valid pair inputs, so the total decoders need machines of their own; those are +`Internal.SndBlock`, `Internal.FstBlock` and `Internal.Cat`, one per machine. +-/ + + +@[expose] public section + +namespace Complexity + +namespace Cobham + +/-- Decode the payload of the leading self-delimiting block: read doubled bits +until the `[false, true]` separator. On a valid pair `pair x y` this +returns `x` (see `fstBlock_pair`); on malformed input it returns the bits decoded +so far. This total, incremental form is what the `fstBlockTM` scanner computes. -/ +def fstBlock : List Bool → List Bool + | false :: false :: z => false :: fstBlock z + | true :: true :: z => true :: fstBlock z + | _ => [] + +/-- Take the suffix after the leading self-delimiting block (the second `unpair?` +component), or `[]` if the input is not a valid block. On `encodeVec` of a +nonempty vector this returns the head component `v 0`. -/ +def sndBlock (z : List Bool) : List Bool := + match unpair? z with + | some (_, s) => s + | none => [] + +@[simp] theorem fstBlock_pair (x y : List Bool) : fstBlock (pair x y) = x := by + induction x with + | nil => rfl + | cons b x ih => cases b <;> (rw [pair_cons_eq]; simp [fstBlock, ih]) + +@[simp] theorem sndBlock_pair (x y : List Bool) : sndBlock (pair x y) = y := by + simp [sndBlock] + +/-- Stripping the head component of an encoded vector yields the encoded tail. +(Not a `simp` lemma: `simp` already reaches this via `encodeVec_succ` and +`fstBlock_pair`.) -/ +theorem fstBlock_encodeVec_succ {n : ℕ} (v : Fin (n + 1) → List Bool) : + fstBlock (encodeVec v) = encodeVec (Fin.tail v) := by + simp + +/-- The suffix of an encoded vector is its head component. +(Not a `simp` lemma: `simp` already reaches this via `encodeVec_succ` and +`sndBlock_pair`.) -/ +theorem sndBlock_encodeVec_succ {n : ℕ} (v : Fin (n + 1) → List Bool) : + sndBlock (encodeVec v) = v 0 := by + simp + +/-- Control states of the block-decoding scanners. -/ +inductive ScanPhase where + | skip | scanA | scanBfalse | scanBtrue | emit | done + deriving DecidableEq + +instance : Fintype ScanPhase where + elems := {.skip, .scanA, .scanBfalse, .scanBtrue, .emit, .done} + complete := fun x => by cases x <;> simp + +end Cobham + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/Blocks.lean b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/Blocks.lean new file mode 100644 index 0000000000..a98a9a43ac --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/Blocks.lean @@ -0,0 +1,303 @@ +/- +Copyright (c) 2026 Bolton Bailey. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Bolton Bailey +-/ + +module +import Mathlib.Data.List.Basic + +/-! +# Blocks, flags, and bit dispatch — proof internals + +The string toolkit the simulation of a machine inside Cobham's algebra is +written in. None of it appears in the statement of `CobhamFP_eq_FP`; it is the +vocabulary of the proof. + +* *Dispatch* — `Complexity.caseBit` selects on a leading bit and returns nothing + on the empty string; `Complexity.caseBit₀` reads "no bit" as `false`. Both are + needed: the partial one to read off the end of a string, the total one so that + a *flag* (a one-bit string) is always genuinely one bit. +* *Flags* — `Complexity.andBit`, `orBit`, `notBit`, `bitAt`, + `Complexity.nonemptyFlag` and `Complexity.matchPrefix`, the Boolean layer a + machine's finite transition table is written in. `matchPrefix` unfolds into + `|c|` bit tests for each fixed fixedValue `c`, so it is a *finite* composition — + the induction is at the meta level, not inside the algebra. +* *Blocks* — `Complexity.padTo` pads a field to one ruler's width and + `Complexity.blockAt` reads field `i` back, so a packed configuration needs no + self-delimiting decoder inside the algebra. The padding algebra + (`padTo_append_padTo`, `take_padTo`, `drop_padTo`, `padTo_drop`) says that + re-padding commutes with the edits a simulated step performs. +-/ + + +@[expose] public section + +namespace Complexity + +/-- **Bit dispatch**: select `x` or `y` according to the leading bit of `s`, +returning the empty string when `s` is empty. + +This is the branching primitive of the algebra. It is definable by a single +limited recursion on notation (`Cobham.caseBit`) because the step functions of +`recNotation` are already selected by the bit being peeled — dispatching on a bit +costs nothing beyond the recursion that is there anyway. -/ +def caseBit (s x y : List Bool) : List Bool := + match s with + | [] => [] + | b :: _ => bif b then x else y + +@[simp] theorem caseBit_nil (x y : List Bool) : caseBit [] x y = [] := rfl + +@[simp] theorem caseBit_cons (b : Bool) (s x y : List Bool) : + caseBit (b :: s) x y = bif b then x else y := rfl + +/-- Bit dispatch never returns more than its two branches together. -/ +theorem caseBit_length_le (s x y : List Bool) : + (caseBit s x y).length ≤ (x ++ y).length := by + cases s with + | nil => simp + | cons b s => cases b <;> simp + +/-- **Total bit dispatch**: like `caseBit`, but the empty string selects the +`false` branch instead of returning nothing. + +Both variants are needed. `caseBit` is the *partial* reader used when running off +the end of a string must produce nothing (`Cobham.takePrefix` reads bits this +way); `caseBit₀` is the *total* one used for Boolean logic, where "no bit" has to +mean `false` so that flags are always exactly `[true]` or `[false]`. -/ +def caseBit₀ (s x y : List Bool) : List Bool := + match s with + | [] => y + | b :: _ => bif b then x else y + +@[simp] theorem caseBit₀_nil (x y : List Bool) : caseBit₀ [] x y = y := rfl + +@[simp] theorem caseBit₀_cons (b : Bool) (s x y : List Bool) : + caseBit₀ (b :: s) x y = bif b then x else y := rfl + +/-- Total bit dispatch never returns more than its two branches together. -/ +theorem caseBit₀_length_le (s x y : List Bool) : + (caseBit₀ s x y).length ≤ (x ++ y).length := by + cases s with + | nil => simp + | cons b s => cases b <;> simp + +/-! ### Flags + +A *flag* is a one-bit string, `[true]` or `[false]`. The connectives below are +each one `caseBit₀`, so they are in the algebra as soon as `caseBit₀` is, and +they are how the finite case analysis of a machine's transition function gets +written inside it. Because they are built on the *total* dispatcher, every flag +these produce is genuinely one bit — never empty — so they compose. -/ + +/-- Conjunction of flags. -/ +def andBit (x y : List Bool) : List Bool := + caseBit₀ x (caseBit₀ y [true] [false]) [false] + +/-- Disjunction of flags. -/ +def orBit (x y : List Bool) : List Bool := + caseBit₀ x [true] (caseBit₀ y [true] [false]) + +/-- Negation of a flag. -/ +def notBit (x : List Bool) : List Bool := caseBit₀ x [false] [true] + +/-- The bit of `x` at the position marked by the ruler `r`, as a flag; `false` +when the position is past the end of `x`. -/ +def bitAt (r x : List Bool) : List Bool := + caseBit₀ (x.drop r.length) [true] [false] + +@[simp] theorem bitAt_nil_left (x : List Bool) : + bitAt [] x = caseBit₀ x [true] [false] := by simp [bitAt] + +/-- A flag is exactly one bit long. -/ +theorem bitAt_length (r x : List Bool) : (bitAt r x).length = 1 := by + rw [bitAt] + rcases hx : x.drop r.length with _ | ⟨b, z⟩ + · simp + · cases b <;> simp + +/-- Pad (or truncate) `x` to exactly the width of the ruler `r`, filling with +zeros. + +Fixed-width blocks are how a simulated machine's configuration is packed into the +single string a member of the class returns: every field occupies `|r|` bits, so +field `i` is recovered by dropping `i` rulers and taking one — no self-delimiting +decoder is needed inside the algebra. -/ +def padTo (r x : List Bool) : List Bool := + (x ++ List.replicate r.length false).take r.length + +/-- A padded block always has exactly the ruler's width. -/ +@[simp] theorem padTo_length (r x : List Bool) : (padTo r x).length = r.length := by + rw [padTo, List.length_take, List.length_append, List.length_replicate] + omega + +/-- Padding a short string appends zeros. -/ +theorem padTo_eq_append (r x : List Bool) (h : x.length ≤ r.length) : + padTo r x = x ++ List.replicate (r.length - x.length) false := by + rw [padTo] + simp [List.take_append, List.take_replicate, List.take_of_length_le h] + +/-- The `i`-th block of `x`, when `x` is a concatenation of blocks each as wide +as the ruler `r`. -/ +def blockAt (r x : List Bool) (i : ℕ) : List Bool := + (x.drop (i * r.length)).take r.length + +/-- Block zero of a block-aligned string is its first block. -/ +@[simp] theorem blockAt_zero_append (r a x : List Bool) (h : a.length = r.length) : + blockAt r (a ++ x) 0 = a := by + rw [blockAt, Nat.zero_mul, List.drop_zero, ← h, List.take_left] + +/-- Later blocks of a block-aligned string are the blocks of its tail. -/ +theorem blockAt_succ_append (r a x : List Bool) (h : a.length = r.length) (i : ℕ) : + blockAt r (a ++ x) (i + 1) = blockAt r x i := by + have hd : (a ++ x).drop (i * a.length + a.length) = x.drop (i * a.length) := by + rw [Nat.add_comm] + simp + rw [blockAt, blockAt, Nat.succ_mul, ← h, hd] + +/-! ### Padding algebra + +A simulated step reads a padded block, edits it, and re-pads. These three lemmas +say that the padding is invisible to that: re-padding commutes with the edits, so +the encoded step can be reasoned about on raw contents. -/ + +/-- Extra zero padding is invisible to `padTo`. -/ +theorem padTo_append_replicate (r z : List Bool) (m : ℕ) : + padTo r (z ++ List.replicate m false) = padTo r z := by + rw [padTo, padTo, List.append_assoc, ← List.replicate_add, List.take_append, + List.take_append, List.take_replicate, List.take_replicate] + congr 2 + omega + +/-- Re-padding a padded block is the same as padding its raw content. -/ +theorem padTo_append_padTo (r y x : List Bool) (hx : x.length ≤ r.length) : + padTo r (y ++ padTo r x) = padTo r (y ++ x) := by + rw [padTo_eq_append r x hx, ← List.append_assoc, padTo_append_replicate] + +/-- Taking from within the content of a padded block ignores the padding. -/ +theorem take_padTo (r x : List Bool) (n : ℕ) (hn : n ≤ x.length) + (hx : x.length ≤ r.length) : + (padTo r x).take n = x.take n := by + rw [padTo, List.take_take, Nat.min_eq_left (by omega : n ≤ r.length), + List.take_append, Nat.sub_eq_zero_of_le hn, List.take_zero, List.append_nil] + +/-- Dropping from a padded block leaves the padding trailing at the end. -/ +theorem drop_padTo (r x : List Bool) (n : ℕ) (hn : n ≤ x.length) + (hx : x.length ≤ r.length) : + (padTo r x).drop n = x.drop n ++ List.replicate (r.length - x.length) false := by + rw [padTo_eq_append r x hx, List.drop_append, Nat.sub_eq_zero_of_le hn, + List.drop_zero] + +/-- Dropping from a padded block and re-padding ignores the padding. -/ +theorem padTo_drop (r x : List Bool) (n : ℕ) (hn : n ≤ x.length) + (hx : x.length ≤ r.length) : + padTo r ((padTo r x).drop n) = padTo r (x.drop n) := by + rw [padTo_eq_append r x hx, List.drop_append, Nat.sub_eq_zero_of_le hn, + List.drop_zero, padTo_append_replicate] + +/-- **Reading a field out of a block-aligned record.** When `bs` is a list of +blocks all as wide as the ruler `r`, block `i` of their concatenation is `bs[i]`. +This is what makes `Cobham.blockFn` a field accessor. -/ +theorem blockAt_flatten (r : List Bool) : + ∀ (bs : List (List Bool)), (∀ b ∈ bs, b.length = r.length) → + ∀ (i : ℕ) (hi : i < bs.length), blockAt r bs.flatten i = bs[i] := by + intro bs + induction bs with + | nil => intro _ i hi; simp at hi + | cons b bs ih => + intro hb i hi + cases i with + | zero => + rw [List.flatten_cons] + exact blockAt_zero_append r b _ (hb b (by simp)) + | succ i => + rw [List.flatten_cons, blockAt_succ_append _ _ _ (hb b (by simp))] + rw [ih (fun c hc => hb c (by simp [hc])) i (by simpa using hi)] + simp + +/-- Flag: is `x` nonempty? The *partial* dispatcher returns `[]` on the empty +string, and `[]` reads as false to the flag connectives — so this is the one +place `caseBit` rather than `caseBit₀` is what is wanted. + +Without it `matchPrefix` could not tell "the head bit is `0`" from "there is no +head bit", and would report a match of `[0]` against `[]`. -/ +def nonemptyFlag (x : List Bool) : List Bool := caseBit x [true] [true] + +@[simp] theorem nonemptyFlag_nil : nonemptyFlag [] = [] := rfl + +@[simp] theorem nonemptyFlag_cons (b : Bool) (x : List Bool) : + nonemptyFlag (b :: x) = [true] := by cases b <;> rfl + +/-- Flag: does `x` begin with the fixed fixedValue `c`? Unfolds into `|c|` bit +tests joined by `andBit`, so for each fixedValue it is a *finite* composition — +no recursion on notation is needed. -/ +def matchPrefix : List Bool → List Bool → List Bool + | [], _ => [true] + | b :: c, x => + andBit (nonemptyFlag x) + (andBit (bif b then bitAt [] x else notBit (bitAt [] x)) + (matchPrefix c x.tail)) + +@[simp] theorem matchPrefix_nil (x : List Bool) : matchPrefix [] x = [true] := rfl + +@[simp] theorem matchPrefix_cons (b : Bool) (c x : List Bool) : + matchPrefix (b :: c) x = + andBit (nonemptyFlag x) + (andBit (bif b then bitAt [] x else notBit (bitAt [] x)) + (matchPrefix c x.tail)) := rfl + +/-- A fixedValue is matched by anything it prefixes. -/ +theorem matchPrefix_append (c y : List Bool) : matchPrefix c (c ++ y) = [true] := by + induction c generalizing y with + | nil => rfl + | cons b c ih => cases b <;> simp [andBit, notBit, ih] + +/-- Nothing but the empty fixedValue matches the empty string. (Not a `simp` +lemma: `simp` unfolds the left-hand side past this shape.) -/ +theorem matchPrefix_nil_right (b : Bool) (c : List Bool) : + matchPrefix (b :: c) [] = [false] := by + cases b <;> rfl + +/-- Conjunction always returns a genuine one-bit flag, whatever it is given. -/ +theorem andBit_flag (x y : List Bool) : + andBit x y = [true] ∨ andBit x y = [false] := by + rw [andBit] + cases x with + | nil => exact Or.inr rfl + | cons a x => + cases a + · exact Or.inr rfl + · rw [caseBit₀_cons, cond_true] + cases y with + | nil => exact Or.inr rfl + | cons d y => cases d <;> simp + +/-- The match test always returns a genuine one-bit flag. -/ +theorem matchPrefix_flag (c x : List Bool) : + matchPrefix c x = [true] ∨ matchPrefix c x = [false] := by + cases c with + | nil => exact Or.inl rfl + | cons b c => rw [matchPrefix_cons]; exact andBit_flag _ _ + +/-- **The match test is exactly the prefix test.** This is what makes a table of +fixedValue patterns behave like a case analysis: the entry whose pattern is a +prefix of the key fires, and no other does. -/ +theorem matchPrefix_eq_true_iff (c x : List Bool) : + matchPrefix c x = [true] ↔ c <+: x := by + induction c generalizing x with + | nil => simp + | cons b c ih => + cases x with + | nil => simp [andBit] + | cons a x => + rw [matchPrefix_cons, nonemptyFlag_cons, andBit, caseBit₀_cons, cond_true, + andBit] + have hbit : (bif b then bitAt [] (a :: x) else notBit (bitAt [] (a :: x))) + = [decide (a = b)] := by + cases a <;> cases b <;> rfl + rw [hbit, List.cons_prefix_cons] + rcases matchPrefix_flag c x with h | h <;> cases a <;> cases b <;> + simp [h, ← ih x] + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/Cat.lean b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/Cat.lean new file mode 100644 index 0000000000..5e31911810 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/Cat.lean @@ -0,0 +1,413 @@ +/- +Copyright (c) 2026 Bolton Bailey. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Bolton Bailey +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.Counter +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Tape.Encoding +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.SndBlock + +/-! +# Concatenating two blocks — proof internals + +`Cobham.catBlocks` appends the payloads of two consecutive blocks, the string +concatenation behind `Cobham.appendFn_mem_FP`, together with the `Cobham.catTM` +scanner that computes it. + +## Main results + +- `Cobham.catBlocks_mem_FP` — concatenation is in `FP` +-/ + + +public section + +namespace Complexity + +namespace Cobham + +open Complexity.TM + +/-! ### Concatenation + +`catBlocks` is `fstBlock` and `sndBlock` fused: decode the leading block's +payload *and* keep the suffix, so on a genuine pair it is concatenation. Its +machine is `sndBlockTM` with the scan also emitting each decoded bit — the one +`FP` primitive that lets two computed strings be joined. -/ + +/-- Decode the leading self-delimiting block's payload and keep the suffix. On +`pair x y` this is `x ++ y` (`catBlocks_pair`); on malformed input it returns the +bits decoded so far. -/ +def catBlocks : List Bool → List Bool + | false :: false :: z => false :: catBlocks z + | true :: true :: z => true :: catBlocks z + | false :: true :: z => z + | _ => [] + +@[simp] theorem catBlocks_pair (x y : List Bool) : catBlocks (pair x y) = x ++ y := by + induction x with + | nil => rfl + | cons b x ih => cases b <;> (rw [pair_cons_eq]; simp [catBlocks, ih]) + +/-- The concatenator: like `sndBlockTM`, but the scan also emits each decoded +payload bit, so the output ends up holding the payload followed by the suffix. +Computes `catBlocks`. -/ +def catTM : TM 0 where + Q := ScanPhase + qstart := .skip + qhalt := .done + δ := fun state iHead wHeads oHead => + match state with + | .skip => + (.scanA, fun i => readBackWrite (wHeads i), readBackWrite oHead, Dir3.right, + fun i => idleDir (wHeads i), Dir3.right) + | .scanA => + match iHead with + | Γ.zero => + (.scanBfalse, fun i => readBackWrite (wHeads i), readBackWrite oHead, + Dir3.right, fun i => idleDir (wHeads i), idleDir oHead) + | Γ.one => + (.scanBtrue, fun i => readBackWrite (wHeads i), readBackWrite oHead, + Dir3.right, fun i => idleDir (wHeads i), idleDir oHead) + | _ => + (.done, fun i => readBackWrite (wHeads i), readBackWrite oHead, + idleDir iHead, fun i => idleDir (wHeads i), idleDir oHead) + | .scanBfalse => + match iHead with + | Γ.one => + (.emit, fun i => readBackWrite (wHeads i), readBackWrite oHead, + Dir3.right, fun i => idleDir (wHeads i), idleDir oHead) + | Γ.zero => + (.scanA, fun i => readBackWrite (wHeads i), Γw.ofBool false, + Dir3.right, fun i => idleDir (wHeads i), Dir3.right) + | _ => + (.done, fun i => readBackWrite (wHeads i), readBackWrite oHead, + idleDir iHead, fun i => idleDir (wHeads i), idleDir oHead) + | .scanBtrue => + match iHead with + | Γ.one => + (.scanA, fun i => readBackWrite (wHeads i), Γw.ofBool true, + Dir3.right, fun i => idleDir (wHeads i), Dir3.right) + | _ => + (.done, fun i => readBackWrite (wHeads i), readBackWrite oHead, + idleDir iHead, fun i => idleDir (wHeads i), idleDir oHead) + | .emit => + if iHead = Γ.blank then + (.done, fun i => readBackWrite (wHeads i), readBackWrite oHead, + idleDir iHead, fun i => idleDir (wHeads i), idleDir oHead) + else + (.emit, fun i => readBackWrite (wHeads i), readBackWrite iHead, + Dir3.right, fun i => idleDir (wHeads i), Dir3.right) + | .done => allIdle .done iHead wHeads oHead + δ_right_of_start := by + intro state iHead wHeads oHead + match state with + | .skip => exact ⟨fun _ => rfl, fun _ => idleDir_right_of_start, fun _ => rfl⟩ + | .scanA => + cases iHead <;> + exact ⟨by first | exact fun _ => rfl | exact idleDir_right_of_start, + fun _ => idleDir_right_of_start, + by first | exact fun _ => rfl | exact idleDir_right_of_start⟩ + | .scanBfalse => + cases iHead <;> + exact ⟨by first | exact fun _ => rfl | exact idleDir_right_of_start, + fun _ => idleDir_right_of_start, + by first | exact fun _ => rfl | exact idleDir_right_of_start⟩ + | .scanBtrue => + cases iHead <;> + exact ⟨by first | exact fun _ => rfl | exact idleDir_right_of_start, + fun _ => idleDir_right_of_start, + by first | exact fun _ => rfl | exact idleDir_right_of_start⟩ + | .emit => + dsimp only [] + split + · exact ⟨idleDir_right_of_start, fun _ => idleDir_right_of_start, + idleDir_right_of_start⟩ + · exact ⟨fun _ => rfl, fun _ => idleDir_right_of_start, fun _ => rfl⟩ + | .done => exact rightOfStart_allIdle iHead wHeads oHead + +/-- The copy phase of `catTM`: from `emit` with input cursor on suffix `y` and +output holding `acc`, the machine copies `y` after `acc` and halts. -/ +private theorem catTM_emit_loop : + ∀ (y acc : List Bool) (c : Cfg 0 catTM.Q), + c.state = ScanPhase.emit → + c.input.HasBinarySuffix y → + c.output.HasBinaryPrefix acc → + ∃ c' t, t ≤ y.length + 1 ∧ catTM.reachesIn t c c' ∧ catTM.halted c' ∧ + c'.output.HasBinaryPrefix (acc ++ y) := by + intro y + induction y with + | nil => + intro acc c hstate hsuf hpre + have hread : c.input.read = Γ.blank := hsuf.read_nil + have houtne : c.output.read ≠ Γ.start := by rw [hpre.read_blank]; decide + refine ⟨{ state := ScanPhase.done + input := c.input.move (idleDir c.input.read) + work := fun i => (c.work i).writeAndMove (readBackWrite (c.work i).read) + (idleDir (c.work i).read) + output := c.output.writeAndMove (readBackWrite c.output.read) + (idleDir c.output.read) }, 1, by simp, + .step (by simp [TM.step, hstate, catTM, hread]) .zero, rfl, ?_⟩ + rw [show c.output.writeAndMove (readBackWrite c.output.read) (idleDir c.output.read) + = c.output from Tape.writeAndMove_readBack_idle_of_ne_start _ houtne] + simpa using hpre + | cons bit y ih => + intro acc c hstate hsuf hpre + have hread : c.input.read = Γ.ofBool bit := hsuf.read_cons + have hne : c.input.read ≠ Γ.blank := by rw [hread]; cases bit <;> decide + let c1 : Cfg 0 catTM.Q := + { state := ScanPhase.emit + input := c.input.move Dir3.right + work := fun i => (c.work i).writeAndMove (readBackWrite (c.work i).read) + (idleDir (c.work i).read) + output := c.output.writeAndMove (readBackWrite c.input.read) Dir3.right } + have hstep : catTM.step c = some c1 := by + simp [TM.step, hstate, catTM, hne, c1] + have hpre1 : c1.output.HasBinaryPrefix (acc ++ [bit]) := by + have hco : (readBackWrite c.input.read).toΓ = Γ.ofBool bit := by + rw [hread]; cases bit <;> rfl + show (c.output.writeAndMove ((readBackWrite c.input.read).toΓ) Dir3.right).HasBinaryPrefix + (acc ++ [bit]) + rw [hco]; exact Tape.hasBinaryPrefix_write_bit bit hpre + obtain ⟨c', t, ht, hreach, hhalt, hout⟩ := + ih (acc ++ [bit]) c1 rfl hsuf.move_right_cons hpre1 + refine ⟨c', t + 1, by simp; omega, .step hstep hreach, hhalt, ?_⟩ + rwa [List.append_assoc, List.cons_append, List.nil_append] at hout + +/-- A one-step halt from a scan state whose input reads a symbol that ends the +block: the output is untouched. -/ +private theorem catTM_halt_step {c : Cfg 0 catTM.Q} {acc : List Bool} + (hstep : catTM.step c = some + { state := ScanPhase.done + input := c.input.move (idleDir c.input.read) + work := fun i => (c.work i).writeAndMove (readBackWrite (c.work i).read) + (idleDir (c.work i).read) + output := c.output.writeAndMove (readBackWrite c.output.read) + (idleDir c.output.read) }) + (hpre : c.output.HasBinaryPrefix acc) : + ∃ c' t, t ≤ 1 ∧ catTM.reachesIn t c c' ∧ catTM.halted c' ∧ + c'.output.HasBinaryPrefix acc := by + have houtne : c.output.read ≠ Γ.start := by rw [hpre.read_blank]; decide + refine ⟨_, 1, le_rfl, .step hstep .zero, rfl, ?_⟩ + rw [show c.output.writeAndMove (readBackWrite c.output.read) (idleDir c.output.read) + = c.output from Tape.writeAndMove_readBack_idle_of_ne_start _ houtne] + exact hpre + +/-- The scan phase of `catTM`: from `scanA` with input cursor on `w` and output +holding `acc`, the machine halts with output `acc ++ catBlocks w`. -/ +private theorem catTM_scan_loop : + ∀ (fuel : ℕ) (w acc : List Bool), w.length ≤ fuel → ∀ (c : Cfg 0 catTM.Q), + c.state = ScanPhase.scanA → + c.input.HasBinarySuffix w → + c.output.HasBinaryPrefix acc → + ∃ c' t, t ≤ 2 * w.length + 2 ∧ catTM.reachesIn t c c' ∧ catTM.halted c' ∧ + c'.output.HasBinaryPrefix (acc ++ catBlocks w) := by + intro fuel + induction fuel with + | zero => + intro w acc hw c hstate hsuf hpre + have hwnil : w = [] := List.length_eq_zero_iff.mp (Nat.le_zero.mp hw) + subst hwnil + have hread : c.input.read = Γ.blank := hsuf.read_nil + obtain ⟨c', t, ht, hreach, hhalt, hout⟩ := + catTM_halt_step (c := c) (acc := acc) + (by simp [TM.step, hstate, catTM, hread]) hpre + exact ⟨c', t, by omega, hreach, hhalt, by simpa [catBlocks] using hout⟩ + | succ fuel ih => + intro w acc hw c hstate hsuf hpre + have houtne : c.output.read ≠ Γ.start := by rw [hpre.read_blank]; decide + match w with + | [] => + have hread : c.input.read = Γ.blank := hsuf.read_nil + obtain ⟨c', t, ht, hreach, hhalt, hout⟩ := + catTM_halt_step (c := c) (acc := acc) + (by simp [TM.step, hstate, catTM, hread]) hpre + exact ⟨c', t, by omega, hreach, hhalt, by simpa [catBlocks] using hout⟩ + | [b0] => + have hread : c.input.read = Γ.ofBool b0 := hsuf.read_cons + let c1 : Cfg 0 catTM.Q := + { state := if b0 then ScanPhase.scanBtrue else ScanPhase.scanBfalse + input := c.input.move Dir3.right + work := fun i => (c.work i).writeAndMove (readBackWrite (c.work i).read) + (idleDir (c.work i).read) + output := c.output.writeAndMove (readBackWrite c.output.read) + (idleDir c.output.read) } + have hstep : catTM.step c = some c1 := by + cases b0 <;> simp [TM.step, hstate, catTM, hread, Γ.ofBool, c1] + have hsuf1 : c1.input.HasBinarySuffix [] := hsuf.move_right_cons + have hpre1 : c1.output.HasBinaryPrefix acc := by + show (c.output.writeAndMove (readBackWrite c.output.read) + (idleDir c.output.read)).HasBinaryPrefix acc + rw [Tape.writeAndMove_readBack_idle_of_ne_start _ houtne]; exact hpre + have hread1 : c1.input.read = Γ.blank := hsuf1.read_nil + obtain ⟨c', t, ht, hreach, hhalt, hout⟩ := + catTM_halt_step (c := c1) (acc := acc) + (by cases b0 <;> simp [TM.step, catTM, hread1, c1]) hpre1 + exact ⟨c', t + 1, by simp; omega, .step hstep hreach, hhalt, + by cases b0 <;> simpa [catBlocks] using hout⟩ + | false :: true :: y => + have hreadA : c.input.read = Γ.ofBool false := hsuf.read_cons + let c1 : Cfg 0 catTM.Q := + { state := ScanPhase.scanBfalse + input := c.input.move Dir3.right + work := fun i => (c.work i).writeAndMove (readBackWrite (c.work i).read) + (idleDir (c.work i).read) + output := c.output.writeAndMove (readBackWrite c.output.read) + (idleDir c.output.read) } + have hstepA : catTM.step c = some c1 := by + simp [TM.step, hstate, catTM, hreadA, Γ.ofBool, c1] + have hsuf1 : c1.input.HasBinarySuffix (true :: y) := hsuf.move_right_cons + have hpre1 : c1.output.HasBinaryPrefix acc := by + show (c.output.writeAndMove (readBackWrite c.output.read) + (idleDir c.output.read)).HasBinaryPrefix acc + rw [Tape.writeAndMove_readBack_idle_of_ne_start _ houtne]; exact hpre + have hreadB : c1.input.read = Γ.ofBool true := hsuf1.read_cons + have houtne1 : c1.output.read ≠ Γ.start := by rw [hpre1.read_blank]; decide + let c2 : Cfg 0 catTM.Q := + { state := ScanPhase.emit + input := c1.input.move Dir3.right + work := fun i => (c1.work i).writeAndMove (readBackWrite (c1.work i).read) + (idleDir (c1.work i).read) + output := c1.output.writeAndMove (readBackWrite c1.output.read) + (idleDir c1.output.read) } + have hstepB : catTM.step c1 = some c2 := by + simp [TM.step, catTM, hreadB, Γ.ofBool, c1, c2] + have hsuf2 : c2.input.HasBinarySuffix y := hsuf1.move_right_cons + have hpre2 : c2.output.HasBinaryPrefix acc := by + show (c1.output.writeAndMove (readBackWrite c1.output.read) + (idleDir c1.output.read)).HasBinaryPrefix acc + rw [Tape.writeAndMove_readBack_idle_of_ne_start _ houtne1]; exact hpre1 + obtain ⟨c', t, ht, hreach, hhalt, hout⟩ := catTM_emit_loop y acc c2 rfl hsuf2 hpre2 + refine ⟨c', t + 1 + 1, by simp only [List.length_cons]; omega, + .step hstepA (.step hstepB hreach), hhalt, ?_⟩ + simpa [catBlocks] using hout + | true :: false :: rest => + have hreadA : c.input.read = Γ.ofBool true := hsuf.read_cons + let c1 : Cfg 0 catTM.Q := + { state := ScanPhase.scanBtrue + input := c.input.move Dir3.right + work := fun i => (c.work i).writeAndMove (readBackWrite (c.work i).read) + (idleDir (c.work i).read) + output := c.output.writeAndMove (readBackWrite c.output.read) + (idleDir c.output.read) } + have hstepA : catTM.step c = some c1 := by + simp [TM.step, hstate, catTM, hreadA, Γ.ofBool, c1] + have hsuf1 : c1.input.HasBinarySuffix (false :: rest) := hsuf.move_right_cons + have hpre1 : c1.output.HasBinaryPrefix acc := by + show (c.output.writeAndMove (readBackWrite c.output.read) + (idleDir c.output.read)).HasBinaryPrefix acc + rw [Tape.writeAndMove_readBack_idle_of_ne_start _ houtne]; exact hpre + have hreadB : c1.input.read = Γ.ofBool false := hsuf1.read_cons + obtain ⟨c', t, ht, hreach, hhalt, hout⟩ := + catTM_halt_step (c := c1) (acc := acc) + (by simp [TM.step, catTM, hreadB, Γ.ofBool, c1]) hpre1 + exact ⟨c', t + 1, by simp only [List.length_cons]; omega, + .step hstepA hreach, hhalt, by simpa [catBlocks] using hout⟩ + | false :: false :: rest => + have hreadA : c.input.read = Γ.ofBool false := hsuf.read_cons + let c1 : Cfg 0 catTM.Q := + { state := ScanPhase.scanBfalse + input := c.input.move Dir3.right + work := fun i => (c.work i).writeAndMove (readBackWrite (c.work i).read) + (idleDir (c.work i).read) + output := c.output.writeAndMove (readBackWrite c.output.read) + (idleDir c.output.read) } + have hstepA : catTM.step c = some c1 := by + simp [TM.step, hstate, catTM, hreadA, Γ.ofBool, c1] + have hsuf1 : c1.input.HasBinarySuffix (false :: rest) := hsuf.move_right_cons + have hpre1 : c1.output.HasBinaryPrefix acc := by + show (c.output.writeAndMove (readBackWrite c.output.read) + (idleDir c.output.read)).HasBinaryPrefix acc + rw [Tape.writeAndMove_readBack_idle_of_ne_start _ houtne]; exact hpre + have hreadB : c1.input.read = Γ.ofBool false := hsuf1.read_cons + let c2 : Cfg 0 catTM.Q := + { state := ScanPhase.scanA + input := c1.input.move Dir3.right + work := fun i => (c1.work i).writeAndMove (readBackWrite (c1.work i).read) + (idleDir (c1.work i).read) + output := c1.output.writeAndMove (Γw.ofBool false) Dir3.right } + have hstepB : catTM.step c1 = some c2 := by + simp [TM.step, catTM, hreadB, Γ.ofBool, c1, c2] + have hsuf2 : c2.input.HasBinarySuffix rest := hsuf1.move_right_cons + have hpre2 : c2.output.HasBinaryPrefix (acc ++ [false]) := by + show (c1.output.writeAndMove ((Γw.ofBool false).toΓ) Dir3.right).HasBinaryPrefix + (acc ++ [false]) + rw [Γw.ofBool_toΓ]; exact Tape.hasBinaryPrefix_write_bit false hpre1 + have hrfuel : rest.length ≤ fuel := by + simp only [List.length_cons] at hw; omega + obtain ⟨c', t, ht, hreach, hhalt, hout⟩ := + ih rest (acc ++ [false]) hrfuel c2 rfl hsuf2 hpre2 + refine ⟨c', t + 1 + 1, by simp only [List.length_cons]; omega, + .step hstepA (.step hstepB hreach), hhalt, ?_⟩ + have hcb : catBlocks (false :: false :: rest) = false :: catBlocks rest := rfl + rw [hcb, List.append_assoc, List.cons_append, List.nil_append] at * + exact hout + | true :: true :: rest => + have hreadA : c.input.read = Γ.ofBool true := hsuf.read_cons + let c1 : Cfg 0 catTM.Q := + { state := ScanPhase.scanBtrue + input := c.input.move Dir3.right + work := fun i => (c.work i).writeAndMove (readBackWrite (c.work i).read) + (idleDir (c.work i).read) + output := c.output.writeAndMove (readBackWrite c.output.read) + (idleDir c.output.read) } + have hstepA : catTM.step c = some c1 := by + simp [TM.step, hstate, catTM, hreadA, Γ.ofBool, c1] + have hsuf1 : c1.input.HasBinarySuffix (true :: rest) := hsuf.move_right_cons + have hpre1 : c1.output.HasBinaryPrefix acc := by + show (c.output.writeAndMove (readBackWrite c.output.read) + (idleDir c.output.read)).HasBinaryPrefix acc + rw [Tape.writeAndMove_readBack_idle_of_ne_start _ houtne]; exact hpre + have hreadB : c1.input.read = Γ.ofBool true := hsuf1.read_cons + let c2 : Cfg 0 catTM.Q := + { state := ScanPhase.scanA + input := c1.input.move Dir3.right + work := fun i => (c1.work i).writeAndMove (readBackWrite (c1.work i).read) + (idleDir (c1.work i).read) + output := c1.output.writeAndMove (Γw.ofBool true) Dir3.right } + have hstepB : catTM.step c1 = some c2 := by + simp [TM.step, catTM, hreadB, Γ.ofBool, c1, c2] + have hsuf2 : c2.input.HasBinarySuffix rest := hsuf1.move_right_cons + have hpre2 : c2.output.HasBinaryPrefix (acc ++ [true]) := by + show (c1.output.writeAndMove ((Γw.ofBool true).toΓ) Dir3.right).HasBinaryPrefix + (acc ++ [true]) + rw [Γw.ofBool_toΓ]; exact Tape.hasBinaryPrefix_write_bit true hpre1 + have hrfuel : rest.length ≤ fuel := by + simp only [List.length_cons] at hw; omega + obtain ⟨c', t, ht, hreach, hhalt, hout⟩ := + ih rest (acc ++ [true]) hrfuel c2 rfl hsuf2 hpre2 + refine ⟨c', t + 1 + 1, by simp only [List.length_cons]; omega, + .step hstepA (.step hstepB hreach), hhalt, ?_⟩ + have hcb : catBlocks (true :: true :: rest) = true :: catBlocks rest := rfl + rw [hcb, List.append_assoc, List.cons_append, List.nil_append] at * + exact hout + +/-- **Concatenation is polynomial-time.** -/ +theorem catBlocks_mem_FP : catBlocks ∈ FP := by + refine ⟨1, 0, catTM, (fun m => 2 * m + 3), ?_, ?_⟩ + · intro z + let c1 : Cfg 0 catTM.Q := + { state := ScanPhase.scanA + input := (Tape.init (z.map Γ.ofBool)).move Dir3.right + work := fun _ => (Tape.init []).move Dir3.right + output := (Tape.init []).move Dir3.right } + have hstep1 : catTM.step (catTM.initCfg z) = some c1 := by + simp [TM.step, catTM, c1, Tape.read, Tape.init, readBackWrite, idleDir, + Tape.writeAndMove, Tape.write, Tape.move] + have hsuf : c1.input.HasBinarySuffix z := Tape.init_move_right_hasBinarySuffix z + have hpre : c1.output.HasBinaryPrefix [] := Tape.init_nil_move_right_hasBinaryPrefix_nil + obtain ⟨c', t, ht, hreach, hhalt, hcout⟩ := + catTM_scan_loop z.length z [] le_rfl c1 rfl hsuf hpre + refine ⟨c', t + 1, by show t + 1 ≤ 2 * z.length + 3; omega, + .step hstep1 hreach, hhalt, ?_⟩ + simpa using hcout.hasOutput + · have hn : (fun m : ℕ => 2 * m) =O ((· ^ 1) : ℕ → ℕ) := by + simpa [pow_one] using (BigO.refl (fun m : ℕ => m)).const_mul_left 2 + exact BigO.add hn (BigO.const_le_pow 3 1) + +end Cobham + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/ConsBit.lean b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/ConsBit.lean new file mode 100644 index 0000000000..a242ba3a4b --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/ConsBit.lean @@ -0,0 +1,226 @@ +/- +Copyright (c) 2026 Bolton Bailey. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Bolton Bailey +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.Counter +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Tape.Encoding + +/-! +# The bit successor — proof internals + +`Cobham.consBitTM b` prepends the fixed bit `b` to its input: the machine behind +the `bit` constructor of Cobham's algebra. + +## Main results + +- `Cobham.cons_mem_FP` — prepending a fixed bit is in `FP` +-/ + + +public section + +namespace Complexity + +namespace Cobham + +open Complexity.TM + +/-! ### The bit-successor transducer + +A small machine computing `x ↦ b :: x`: skip the left marker, emit `b`, then copy +the input verbatim after it. Modelled on `TM.copyInputToOutputTM`. -/ + + +/-- Control states of `consBitTM`: skip the `▷` marker, emit the fixed bit, copy +the input, halt. -/ +inductive ConsPhase where + | skip | emit | copy | done + deriving DecidableEq + +instance : Fintype ConsPhase where + elems := {.skip, .emit, .copy, .done} + complete := fun x => by cases x <;> simp + +/-- The bit-successor machine: on input `x` it writes `b :: x` to the output tape +in `|x| + 3` steps. First `skip` advances past the left markers, `emit` writes `b` +into output cell 1, and `copy` copies the input bits after it. -/ +def consBitTM (b : Bool) : TM 0 where + Q := ConsPhase + qstart := .skip + qhalt := .done + δ := fun state iHead wHeads oHead => + match state with + | .skip => + (.emit, fun i => readBackWrite (wHeads i), readBackWrite oHead, Dir3.right, + fun i => idleDir (wHeads i), Dir3.right) + | .emit => + (.copy, fun i => readBackWrite (wHeads i), Γw.ofBool b, idleDir iHead, + fun i => idleDir (wHeads i), Dir3.right) + | .copy => + if iHead = Γ.blank then + (.done, fun i => readBackWrite (wHeads i), readBackWrite oHead, + idleDir iHead, fun i => idleDir (wHeads i), idleDir oHead) + else + (.copy, fun i => readBackWrite (wHeads i), readBackWrite iHead, + Dir3.right, fun i => idleDir (wHeads i), Dir3.right) + | .done => allIdle .done iHead wHeads oHead + δ_right_of_start := by + intro state iHead wHeads oHead + match state with + | .skip => exact ⟨fun _ => rfl, fun _ => idleDir_right_of_start, fun _ => rfl⟩ + | .emit => + exact ⟨idleDir_right_of_start, fun _ => idleDir_right_of_start, fun _ => rfl⟩ + | .copy => + dsimp only [] + split + · exact ⟨idleDir_right_of_start, fun _ => idleDir_right_of_start, + idleDir_right_of_start⟩ + · exact ⟨fun _ => rfl, fun _ => idleDir_right_of_start, fun _ => rfl⟩ + | .done => exact rightOfStart_allIdle iHead wHeads oHead + +/-- The copy phase of `consBitTM`: from a configuration whose output already holds +`b :: x.take k` and whose input head is at the first uncopied cell, the remaining +`rem = |x| - k` bits are copied and the machine halts with output `b :: x`. -/ +private theorem consBitTM_copy_loop (b : Bool) (x : List Bool) : + ∀ rem k (c : Cfg 0 (consBitTM b).Q), + rem = x.length - k → + c.state = ConsPhase.copy → + c.input.cells = (Tape.init (x.map Γ.ofBool)).cells → + c.input.head = k + 1 → + c.output.HasBinaryPrefix (b :: x.take k) → + k ≤ x.length → + ∃ c', + (consBitTM b).reachesIn (rem + 1) c c' ∧ + (consBitTM b).halted c' ∧ + c'.output.HasBinaryPrefix (b :: x) := by + intro rem + induction rem with + | zero => + intro k c hrem hstate hcells hhead hprefix hk_le + have hk_eq : k = x.length := by omega + subst hk_eq + have hread : c.input.read = Γ.blank := by + simp [Tape.read, hhead, hcells, Tape.init_ofBool_cells_ge x x.length le_rfl] + have hprefix_full : c.output.HasBinaryPrefix (b :: x) := by + simpa using hprefix + have houtput_blank : c.output.read = Γ.blank := hprefix_full.read_blank + let c1 : Cfg 0 (consBitTM b).Q := + { state := ConsPhase.done + input := c.input.move (idleDir c.input.read) + work := fun i => + (c.work i).writeAndMove (readBackWrite (c.work i).read) + (idleDir (c.work i).read) + output := c.output.writeAndMove (readBackWrite c.output.read) + (idleDir c.output.read) } + have hinput_keep : c.input.move (idleDir c.input.read) = c.input := by + simp [idleDir, hread, Tape.move] + have houtput_keep : + c.output.writeAndMove (readBackWrite c.output.read) + (idleDir c.output.read) = c.output := by + rw [writeAndMove_readBack c.output (by simp [houtput_blank]), + idleDir, if_neg (by simp [houtput_blank]), Tape.move] + have hstep : (consBitTM b).step c = some c1 := by + simp [TM.step, hstate, consBitTM, hread, c1] + refine ⟨c1, .step hstep .zero, rfl, ?_⟩ + rw [show c1.output = c.output by simpa [c1] using houtput_keep] + exact hprefix_full + | succ rem ih => + intro k c hrem hstate hcells hhead hprefix hk_le + have hk_lt : k < x.length := by omega + have hread : c.input.read = Γ.ofBool (x[k]'hk_lt) := by + simp [Tape.read, hhead, hcells, Tape.init_ofBool_cells_lt x k hk_lt] + have hread_ne : c.input.read ≠ Γ.blank := by + rw [hread]; cases x[k]'hk_lt <;> simp [Γ.ofBool] + have hprefix_next : + (c.output.writeAndMove (Γ.ofBool (x[k]'hk_lt)) Dir3.right).HasBinaryPrefix + (b :: x.take (k + 1)) := by + have hwrite := Tape.hasBinaryPrefix_write_bit (x[k]'hk_lt) hprefix + have heq : (b :: x.take k) ++ [x[k]'hk_lt] = b :: x.take (k + 1) := by + rw [List.cons_append, List.take_concat_get' x k hk_lt] + rwa [heq] at hwrite + let c1 : Cfg 0 (consBitTM b).Q := + { state := ConsPhase.copy + input := c.input.move Dir3.right + work := fun i => + (c.work i).writeAndMove (readBackWrite (c.work i).read) + (idleDir (c.work i).read) + output := c.output.writeAndMove (readBackWrite c.input.read) Dir3.right } + have hstep : (consBitTM b).step c = some c1 := by + simp [TM.step, hstate, consBitTM, hread_ne, c1] + have hcells1 : c1.input.cells = (Tape.init (x.map Γ.ofBool)).cells := by + simpa [c1, Tape.move_cells] using hcells + have hhead1 : c1.input.head = (k + 1) + 1 := by simp [c1, Tape.move, hhead] + have hprefix1 : c1.output.HasBinaryPrefix (b :: x.take (k + 1)) := by + have hco : (readBackWrite c.input.read).toΓ = Γ.ofBool (x[k]'hk_lt) := by + rw [hread]; cases x[k]'hk_lt <;> rfl + show (c.output.writeAndMove ((readBackWrite c.input.read).toΓ) Dir3.right).HasBinaryPrefix + (b :: x.take (k + 1)) + rw [hco]; exact hprefix_next + obtain ⟨c', hreach, hhalt, hprefix'⟩ := + ih (k + 1) c1 (by omega) rfl hcells1 hhead1 hprefix1 (by omega) + exact ⟨c', .step hstep hreach, hhalt, hprefix'⟩ + +/-- `consBitTM b` computes `x ↦ b :: x` within the linear bound `|x| + 3`. -/ +theorem consBitTM_computesInTime (b : Bool) : + (consBitTM b).ComputesInTime (fun x => b :: x) (fun m => m + 3) := by + intro x + -- Step 1: `skip` advances past the left markers. + let c1 : Cfg 0 (consBitTM b).Q := + { state := ConsPhase.emit + input := (Tape.init (x.map Γ.ofBool)).move Dir3.right + work := fun _ => (Tape.init []).writeAndMove (readBackWrite (Tape.init []).read) + (idleDir (Tape.init []).read) + output := (Tape.init []).move Dir3.right } + have hstep1 : (consBitTM b).step ((consBitTM b).initCfg x) = some c1 := by + simp [TM.step, consBitTM, c1, Tape.read, Tape.init, idleDir, Tape.writeAndMove, + Tape.write, Tape.move] + -- The input head after `skip` reads a data/blank cell, never the marker. + have hne : c1.input.read ≠ Γ.start := by + cases x with + | nil => simp [c1, Tape.read, Tape.move, Tape.init] + | cons a t => cases a <;> simp [c1, Tape.read, Tape.move, Tape.init, Γ.ofBool] + -- Step 2: `emit` writes `b` into output cell 1. + let c2 : Cfg 0 (consBitTM b).Q := + { state := ConsPhase.copy + input := c1.input.move (idleDir c1.input.read) + work := fun i => (c1.work i).writeAndMove (readBackWrite (c1.work i).read) + (idleDir (c1.work i).read) + output := c1.output.writeAndMove (Γw.ofBool b) Dir3.right } + have hstep2 : (consBitTM b).step c1 = some c2 := by + simp [TM.step, consBitTM, c1, c2] + have hc2_input_cells : c2.input.cells = (Tape.init (x.map Γ.ofBool)).cells := by + simp [c2, c1, Tape.move_cells] + have hc2_input_head : c2.input.head = 0 + 1 := by + show (c1.input.move (idleDir c1.input.read)).head = 0 + 1 + rw [idleDir, if_neg hne] + simp [Tape.move, c1, Tape.init] + have hc2_output : c2.output.HasBinaryPrefix (b :: x.take 0) := by + have hbase : ((Tape.init []).move Dir3.right).HasBinaryPrefix [] := + Tape.init_nil_move_right_hasBinaryPrefix_nil + have hw := Tape.hasBinaryPrefix_write_bit (t := (Tape.init []).move Dir3.right) b hbase + show (c1.output.writeAndMove ((Γw.ofBool b).toΓ) Dir3.right).HasBinaryPrefix (b :: x.take 0) + rw [Γw.ofBool_toΓ, show c1.output = (Tape.init []).move Dir3.right from rfl] + simpa using hw + obtain ⟨c', hreach, hhalt, hprefix⟩ := + consBitTM_copy_loop b x x.length 0 c2 (by simp) rfl hc2_input_cells + hc2_input_head hc2_output (Nat.zero_le _) + refine ⟨c', x.length + 3, le_rfl, ?_, hhalt, (hprefix.hasOutput)⟩ + have : (consBitTM b).reachesIn (x.length + 1 + 1 + 1) ((consBitTM b).initCfg x) c' := + .step hstep1 (.step hstep2 hreach) + simpa [Nat.add_assoc] using this + +/-- Prepending a fixed bit is polynomial-time — the string-successor underlying +the `bit` constructor. Witnessed by `consBitTM`. -/ +theorem cons_mem_FP (b : Bool) : (fun x : List Bool => b :: x) ∈ FP := by + refine ⟨1, 0, consBitTM b, (fun m => m + 3), consBitTM_computesInTime b, ?_⟩ + have hn : (fun m : ℕ => m) =O ((· ^ 1) : ℕ → ℕ) := by + simpa only [pow_one] using BigO.refl (fun m : ℕ => m) + exact BigO.add hn (BigO.const_le_pow 3 1) + +end Cobham + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/Encoding.lean b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/Encoding.lean new file mode 100644 index 0000000000..172a2c796a --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/Encoding.lean @@ -0,0 +1,971 @@ +/- +Copyright (c) 2026 Bolton Bailey. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Bolton Bailey +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.Blocks +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Internal + +/-! +# Encoding machine configurations as bitstrings — proof internals + +The completeness direction of Cobham's theorem simulates a polynomial-time +machine inside the function algebra, so a configuration has to become a single +bitstring. This module fixes that encoding and proves the arithmetic facts about +it; the algebra-side operations that act on it live in +`Complexitylib.Classes.P.Cobham.Internal.StepAlgebra`. + +## The two design choices + +**Two bits per symbol, with blank `= 00`.** Fixed-width blocks are padded with +zeros (`Complexity.padTo`), so making blank the all-zero code means padding a +tape block with zeros *is* extending it with blanks — the padding needs no +special treatment anywhere. + +**Tapes split at the head.** A tape is stored as its cells to the left of the +head, nearest first, and its cells from the head rightwards. Then a head move is +transferring one symbol between the two sides, i.e. a `take`/`drop`/`append` of +two bits, rather than arithmetic on a position index. Reading is the first two +bits of the right part. + +Cell `0` is the only `▷` (the writable alphabet `Γw` excludes it), so "the head +is at cell 0" is exactly "the read symbol is `▷`" — and in that case +`TM.δ_right_of_start` forces a move right. The left part is therefore never +consulted when it is empty, which is why it needs no emptiness test. + +## Main definitions + +- `Complexity.Cobham.symCode` — two-bit code for `Γ` +- `Complexity.Cobham.cellsCode` — a window of cells as a bitstring +- `Complexity.Cobham.leftCode`, `Complexity.Cobham.rightCode` — a tape split at + its head + +## Main results + +The six lemmas that make the split representation simulate `Tape.writeAndMove`, +each expressing one head move as two bits crossing the split: + +- `leftCode_write_stay`, `rightCode_write_stay` +- `leftCode_write_right`, `rightCode_write_right` +- `leftCode_write_left`, `rightCode_write_left` + +Every right-hand side is built from `take 2`, `drop 2`, `++` and the fixedValue +`symCode s` — all of which the algebra has (`Cobham.takeFn`, `Cobham.dropFn`, +`Cobham.appendFn`, `Cobham.const`). +-/ + + +@[expose] public section + +namespace Complexity + +namespace Cobham + +/-! ## The symbol code -/ + +/-- Two-bit code for the tape alphabet. Blank is `00`, so zero-padding a block is +blank-padding it. -/ +def symCode : Γ → List Bool + | .blank => [false, false] + | .start => [false, true] + | .zero => [true, false] + | .one => [true, true] + +/-- Decode the leading two bits of a string as a tape symbol; anything shorter +than two bits reads as blank. -/ +def symDecode : List Bool → Γ + | false :: false :: _ => .blank + | false :: true :: _ => .start + | true :: false :: _ => .zero + | true :: true :: _ => .one + | _ => .blank + +@[simp] theorem symCode_length (g : Γ) : (symCode g).length = 2 := by cases g <;> rfl + +@[simp] theorem symCode_blank : symCode Γ.blank = [false, false] := rfl + +/-- The code round-trips, even with arbitrary trailing bits — which is what lets +the decoder read a symbol off the front of a longer block. -/ +@[simp] theorem symDecode_symCode (g : Γ) (rest : List Bool) : + symDecode (symCode g ++ rest) = g := by cases g <;> rfl + +/-- The decoder only ever looks at two bits, so truncating first changes +nothing. -/ +theorem symDecode_take_two (l : List Bool) : symDecode (l.take 2) = symDecode l := by + match l with + | [] => rfl + | [b] => cases b <;> rfl + | b :: b' :: t => cases b <;> cases b' <;> rfl + +/-- Zero padding decodes as blank: the reason `symCode Γ.blank = [0,0]`. -/ +theorem symDecode_replicate_false {n : ℕ} (h : 2 ≤ n) : + symDecode (List.replicate n false) = Γ.blank := by + obtain ⟨m, rfl⟩ : ∃ m, n = m + 2 := ⟨n - 2, by omega⟩ + rw [show m + 2 = 2 + m from by omega, List.replicate_add] + rfl + +/-- The code is injective. -/ +theorem symCode_injective : Function.Injective symCode := by + intro a b hab + have h1 : symDecode (symCode a ++ []) = a := symDecode_symCode a [] + rw [hab, symDecode_symCode] at h1 + exact h1.symm + +/-- Every symbol costs two bits, so a run of coded symbols has twice the +length. -/ +private theorem length_flatMap_symCode (l : List ℕ) (f : ℕ → Γ) : + ((l.flatMap fun j => symCode (f j)).length) = 2 * l.length := by + induction l with + | nil => rfl + | cons a l ih => simp only [List.flatMap_cons, List.length_append, ih, + symCode_length, List.length_cons]; omega + +/-! ## The control state + +The state is stored one-hot: `|Q|` bits with a single `1`. Fixed width and +injective, and — the point — every state's code is a *fixedValue* for a fixed +machine, so the transition table is finitely many `Cobham.matchPrefixFn` tests +against constants (`Cobham.tableFn`). Binary would need arithmetic; one-hot needs +none. -/ + +/-- One-hot code for a control state: one bit per element of `Q`, set exactly at +the state itself. + +Noncomputable only because `Finset.toList` picks an enumeration order; the code +appears solely in specifications, never in a machine that must run. -/ +noncomputable def stateCode {Q : Type} [Fintype Q] [DecidableEq Q] (q : Q) : + List Bool := + (Finset.univ.toList (α := Q)).map fun p => decide (p = q) + +@[simp] theorem stateCode_length {Q : Type} [Fintype Q] [DecidableEq Q] (q : Q) : + (stateCode q).length = Fintype.card Q := by + rw [stateCode, List.length_map, Finset.length_toList, Finset.card_univ] + +/-- Distinct states get distinct codes. -/ +theorem stateCode_injective {Q : Type} [Fintype Q] [DecidableEq Q] : + Function.Injective (stateCode (Q := Q)) := by + intro a b hab + rw [stateCode, stateCode, List.map_inj_left] at hab + have h := hab a (by simp) + simpa using h.symm + +/-! ## Windows of cells -/ + +/-- The `w` cells of `t` starting at cell `i`, two bits each. -/ +def cellsCode (t : Tape) (i w : ℕ) : List Bool := + (List.range w).flatMap fun j => symCode (t.cells (i + j)) + +@[simp] theorem cellsCode_zero (t : Tape) (i : ℕ) : cellsCode t i 0 = [] := rfl + +@[simp] theorem cellsCode_length (t : Tape) (i w : ℕ) : + (cellsCode t i w).length = 2 * w := by + rw [cellsCode, length_flatMap_symCode, List.length_range] + +/-- Peeling the first cell off a window. -/ +theorem cellsCode_succ_left (t : Tape) (i w : ℕ) : + cellsCode t i (w + 1) = symCode (t.cells i) ++ cellsCode t (i + 1) w := by + rw [cellsCode, cellsCode, List.range_succ_eq_map, List.flatMap_cons] + simp [List.flatMap_map, Nat.add_comm, Nat.add_left_comm] + +/-! ## Tapes split at the head -/ + +/-- The cells `n-1, n-2, …, 0` of `t`, nearest first. -/ +def leftCodeFrom (t : Tape) : ℕ → List Bool + | 0 => [] + | n + 1 => symCode (t.cells n) ++ leftCodeFrom t n + +/-- The cells strictly left of the head, nearest first. -/ +def leftCode (t : Tape) : List Bool := leftCodeFrom t t.head + +@[simp] theorem leftCodeFrom_zero (t : Tape) : leftCodeFrom t 0 = [] := rfl + +@[simp] theorem leftCodeFrom_succ (t : Tape) (n : ℕ) : + leftCodeFrom t (n + 1) = symCode (t.cells n) ++ leftCodeFrom t n := rfl + +@[simp] theorem leftCodeFrom_length (t : Tape) (n : ℕ) : + (leftCodeFrom t n).length = 2 * n := by + induction n with + | zero => rfl + | succ n ih => simp only [leftCodeFrom_succ, List.length_append, ih, symCode_length]; omega + +/-- The nearest-left window depends only on the cells it covers. -/ +theorem leftCodeFrom_congr {t t' : Tape} {n : ℕ} + (h : ∀ j, j < n → t.cells j = t'.cells j) : + leftCodeFrom t n = leftCodeFrom t' n := by + induction n with + | zero => rfl + | succ n ih => + rw [leftCodeFrom_succ, leftCodeFrom_succ, h n (by omega), + ih fun j hj => h j (by omega)] + +/-- The cells from the head rightwards, out to cell `W`. + +The width is `W + 1 - head`, complementary to `leftCode`'s `head`, so the two +parts always account for exactly the cells `0 … W`: their total width is the +fixedValue `2 · (W + 1)` and a head move just shifts two bits across the split. -/ +def rightCode (t : Tape) (W : ℕ) : List Bool := cellsCode t t.head (W + 1 - t.head) + +@[simp] theorem leftCode_length (t : Tape) : (leftCode t).length = 2 * t.head := + leftCodeFrom_length t t.head + +@[simp] theorem rightCode_length (t : Tape) (W : ℕ) : + (rightCode t W).length = 2 * (W + 1 - t.head) := cellsCode_length _ _ _ + +/-- The two halves together always span the same window. -/ +theorem leftCode_rightCode_length (t : Tape) {W : ℕ} (h : t.head ≤ W + 1) : + (leftCode t).length + (rightCode t W).length = 2 * (W + 1) := by + simp only [leftCode_length, rightCode_length] + omega + +/-- The read symbol is the first two bits of the right part. -/ +theorem symDecode_rightCode (t : Tape) {W : ℕ} (hw : t.head ≤ W) : + symDecode (rightCode t W) = t.read := by + rw [rightCode, show W + 1 - t.head = (W - t.head) + 1 from by omega, + cellsCode_succ_left] + exact symDecode_symCode _ _ + +/-! ### Congruence + +Both halves read only the cells in their own window, so an update outside that +window is invisible to them. These are the lemmas that let a single-cell write be +localized. -/ + +/-- A window depends only on the cells it covers. -/ +theorem cellsCode_congr {t t' : Tape} {i w : ℕ} + (h : ∀ j, j < w → t.cells (i + j) = t'.cells (i + j)) : + cellsCode t i w = cellsCode t' i w := by + rw [cellsCode, cellsCode] + refine List.flatMap_congr fun j hj => ?_ + rw [h j (List.mem_range.mp hj)] + +/-- The left half depends only on the head and the cells strictly below it. -/ +theorem leftCode_congr {t t' : Tape} (hh : t.head = t'.head) + (h : ∀ j, j < t.head → t.cells j = t'.cells j) : leftCode t = leftCode t' := by + rw [leftCode, leftCode, ← hh] + exact leftCodeFrom_congr h + +/-! ### Writing and moving + +`Tape.write` never touches cell `0` (the model makes writing there a no-op), and +`Γw` cannot produce `▷`, so cell `0` is permanently the unique `▷`. Hence "the +head is at `0`" is exactly "the read symbol is `▷`", and `TM.δ_right_of_start` +then forces a right move — which is why the left half is never consulted while +empty. -/ + +/-- Writing at the head leaves every other cell alone. -/ +theorem write_cells_of_ne {t : Tape} {s : Γ} {j : ℕ} (h : j ≠ t.head) : + (t.write s).cells j = t.cells j := by + rw [Tape.write] + split + · rfl + · exact Function.update_of_ne h _ _ + +/-- Writing at the head sets exactly that cell — except at cell `0`, where the +model makes the write a no-op, so callers must establish that the modeled symbol +already agrees with what is there. A raw `TM` transition writes only `Γw`, which +excludes `▷`; the encoded simulator later supplies the corrected symbol through +`correctWrite`. -/ +theorem write_cells_head {t : Tape} {s : Γ} (hs : t.head = 0 → s = t.cells t.head) : + (t.write s).cells t.head = s := by + rw [Tape.write] + split + · next h => exact (hs h).symm + · exact Function.update_self _ _ _ + +/-- Writing at the head sets exactly that cell, away from cell `0`. -/ +theorem write_cells_self {t : Tape} {s : Γ} (h : t.head ≠ 0) : + (t.write s).cells t.head = s := + write_cells_head fun h0 => absurd h0 h + +/-- **Staying put**: the left half is untouched and the right half gets its +leading symbol replaced. -/ +theorem leftCode_write_stay {t : Tape} {s : Γ} : + leftCode ((t.write s).move Dir3.stay) = leftCode t := by + have hhead : ((t.write s).move Dir3.stay).head = t.head := Tape.write_head t s + refine leftCode_congr hhead fun j hj => ?_ + rw [hhead] at hj + show (t.write s).cells j = t.cells j + exact write_cells_of_ne (by omega) + +/-- **Moving right**: the written symbol crosses over to the left half. This is +the one direction a head at cell `0` can take, so it is stated with the weaker +hypothesis that the write agrees with cell `0` when the head is there. -/ +theorem leftCode_write_right {t : Tape} {s : Γ} + (h : t.head = 0 → s = t.cells t.head) : + leftCode ((t.write s).move Dir3.right) = symCode s ++ leftCode t := by + have hhead : ((t.write s).move Dir3.right).head = t.head + 1 := by + rw [Tape.move, Tape.write_head] + rw [leftCode, leftCode, hhead, leftCodeFrom_succ] + congr 1 + · show symCode (((t.write s).move Dir3.right).cells t.head) = _ + rw [Tape.move_cells, write_cells_head h] + · exact leftCodeFrom_congr fun j hj => by + rw [Tape.move_cells]; exact write_cells_of_ne (by omega) + +/-- **Moving left**: the nearest left symbol crosses over to the right half, so +the left half loses its first two bits. -/ +theorem leftCode_write_left {t : Tape} {s : Γ} (h : t.head ≠ 0) : + leftCode ((t.write s).move Dir3.left) = (leftCode t).drop 2 := by + have hhead : ((t.write s).move Dir3.left).head = t.head - 1 := by + rw [Tape.move, Tape.write_head] + obtain ⟨m, hm⟩ : ∃ m, t.head = m + 1 := ⟨t.head - 1, by omega⟩ + rw [leftCode, leftCode, hhead, hm, Nat.add_sub_cancel, leftCodeFrom_succ] + rw [show (symCode (t.cells m) ++ leftCodeFrom t m).drop 2 + = leftCodeFrom t m from by + rw [List.drop_left' (by simp)]] + exact leftCodeFrom_congr fun j hj => by + rw [Tape.move_cells]; exact write_cells_of_ne (by omega) + +/-- **Staying put**, right half: the leading symbol is replaced. -/ +theorem rightCode_write_stay {t : Tape} {s : Γ} {W : ℕ} (h : t.head ≠ 0) + (hW : t.head ≤ W) : + rightCode ((t.write s).move Dir3.stay) W = symCode s ++ (rightCode t W).drop 2 := by + have hhead : ((t.write s).move Dir3.stay).head = t.head := Tape.write_head t s + rw [rightCode, rightCode, hhead, show W + 1 - t.head = (W - t.head) + 1 from by omega, + cellsCode_succ_left, cellsCode_succ_left] + congr 1 + · show symCode ((t.write s).cells t.head) = _ + rw [write_cells_self h] + · rw [List.drop_left' (by simp)] + exact cellsCode_congr fun j _ => write_cells_of_ne (by omega) + +/-- **Moving right**, right half: the leading symbol is consumed. -/ +theorem rightCode_write_right {t : Tape} {s : Γ} {W : ℕ} (hW : t.head ≤ W) : + rightCode ((t.write s).move Dir3.right) W = (rightCode t W).drop 2 := by + have hhead : ((t.write s).move Dir3.right).head = t.head + 1 := by + rw [Tape.move, Tape.write_head] + rw [rightCode, rightCode, hhead, show W + 1 - t.head = (W - t.head) + 1 from by omega, + cellsCode_succ_left, List.drop_left' (by simp), + show W + 1 - (t.head + 1) = W - t.head from by omega] + exact cellsCode_congr fun j _ => by + rw [Tape.move_cells]; exact write_cells_of_ne (by omega) + +/-- **Moving left**, right half: the nearest left symbol and the written symbol +both join it. -/ +theorem rightCode_write_left {t : Tape} {s : Γ} {W : ℕ} (h : t.head ≠ 0) + (hW : t.head ≤ W) : + rightCode ((t.write s).move Dir3.left) W = + (leftCode t).take 2 ++ symCode s ++ (rightCode t W).drop 2 := by + have hhead : ((t.write s).move Dir3.left).head = t.head - 1 := by + rw [Tape.move, Tape.write_head] + obtain ⟨m, hm⟩ : ∃ m, t.head = m + 1 := ⟨t.head - 1, by omega⟩ + have hleft : (leftCode t).take 2 = symCode (t.cells m) := by + rw [leftCode, hm, leftCodeFrom_succ, List.take_left' (by simp)] + rw [rightCode, rightCode, hhead, hm, Nat.add_sub_cancel, hleft, + show W + 1 - m = (W - m) + 1 from by omega, cellsCode_succ_left, + show W + 1 - (m + 1) = (W - (m + 1)) + 1 from by omega, cellsCode_succ_left, + List.drop_left' (by simp), List.append_assoc] + have hwrite : (t.write s).cells (m + 1) = s := by + rw [← hm]; exact write_cells_self h + congr 1 + · show symCode (((t.write s).move Dir3.left).cells m) = _ + rw [Tape.move_cells] + exact congrArg symCode (write_cells_of_ne (by omega)) + · rw [show W - m = (W - (m + 1)) + 1 from by omega, cellsCode_succ_left] + congr 1 + · show symCode (((t.write s).move Dir3.left).cells (m + 1)) = _ + rw [Tape.move_cells] + exact congrArg symCode hwrite + · refine cellsCode_congr fun j _ => ?_ + rw [Tape.move_cells] + exact write_cells_of_ne (by omega) + +/-! ## Whole configurations + +Every field occupies a block of the same width, so field `i` is recovered by +`Cobham.blockFn … i` — the algebra never needs a self-delimiting decoder. A tape +costs two blocks (its two halves); the state costs one, padded to the same +width. -/ + +/-- The block width used throughout: wide enough for either half of a tape whose +head stays within `0 … W`. -/ +def blockWidth (W : ℕ) : ℕ := 2 * (W + 1) + +/-- The canonical ruler of one block's width. -/ +def blockRuler (W : ℕ) : List Bool := List.replicate (blockWidth W) false + +@[simp] theorem blockRuler_length (W : ℕ) : (blockRuler W).length = blockWidth W := by + simp [blockRuler] + +/-- A tape as two padded half-blocks: the cells left of the head (nearest first) +and the cells from the head rightwards. -/ +def tapeBlocks (W : ℕ) (t : Tape) : List (List Bool) := + [padTo (blockRuler W) (leftCode t), padTo (blockRuler W) (rightCode t W)] + +/-- Both halves of a tape occupy one block each. -/ +theorem tapeBlocks_width (W : ℕ) (t : Tape) : + ∀ b ∈ tapeBlocks W t, b.length = (blockRuler W).length := by + intro b hb + rw [blockRuler_length] + rcases List.mem_cons.mp hb with rfl | hb + · simp + · rcases List.mem_cons.mp hb with rfl | hb + · simp + · simp at hb + +@[simp] theorem tapeBlocks_length (W : ℕ) (t : Tape) : + (tapeBlocks W t).length = 2 := rfl + +/-- A tape as a bitstring: its two half-blocks concatenated. -/ +def tapeCode (W : ℕ) (t : Tape) : List Bool := (tapeBlocks W t).flatten + +@[simp] theorem tapeCode_length (W : ℕ) (t : Tape) : + (tapeCode W t).length = 2 * blockWidth W := by + rw [tapeCode, tapeBlocks, List.flatten_cons, List.flatten_cons, + List.flatten_nil, List.length_append, List.length_append, padTo_length, + padTo_length, blockRuler_length] + simp + omega + +/-- Blocks of a common width concatenate to a predictable length. -/ +private theorem length_flatMap_const {α β : Type} (l : List α) (f : α → List β) + (m : ℕ) (h : ∀ a, (f a).length = m) : (l.flatMap f).length = l.length * m := by + induction l with + | nil => simp + | cons a l ih => + rw [List.flatMap_cons, List.length_append, ih, h a, List.length_cons, + Nat.succ_mul] + exact Nat.add_comm _ _ + +/-- The work tapes, one after another. -/ +def worksCode {k : ℕ} (W : ℕ) (work : Fin k → Tape) : List Bool := + (List.finRange k).flatMap fun i => tapeCode W (work i) + +@[simp] theorem worksCode_length {k : ℕ} (W : ℕ) (work : Fin k → Tape) : + (worksCode W work).length = k * (2 * blockWidth W) := by + rw [worksCode, length_flatMap_const _ _ _ (fun i => tapeCode_length W (work i)), + List.length_finRange] + +/-! ### The window invariant + +A head moves at most one cell per step and starts at cell `0`, so after `t` steps +every head is within `0 … t`. Taking the window `W` to be the machine's time +bound therefore discharges the `head ≤ W` side condition of every encoding lemma +— the simulated machine can never reach outside the encoded window. -/ + +/-- After `t` steps from the initial configuration every head is at most `t`. -/ +theorem heads_le_of_reachesIn {k : ℕ} (tm : TM k) {x : List Bool} {t : ℕ} + {c : Cfg k tm.Q} (h : tm.reachesIn t (tm.initCfg x) c) : + c.input.head ≤ t ∧ c.output.head ≤ t ∧ ∀ i, (c.work i).head ≤ t := by + obtain ⟨hin, hout, hwork⟩ := TM.head_le_start_add_of_reachesIn tm h + exact ⟨by simpa using hin, by simpa using hout, fun i => by simpa using hwork i⟩ + +/-- **Reading a symbol out of an encoded tape.** The head symbol is the first two +bits of the padded right half-block — one `takeFn` in the algebra. -/ +theorem symDecode_take_padTo_rightCode {W : ℕ} (t : Tape) (hW : t.head ≤ W) : + symDecode ((padTo (blockRuler W) (rightCode t W)).take 2) = t.read := by + rw [take_padTo _ _ 2 (by rw [rightCode_length]; omega) + (by rw [rightCode_length, blockRuler_length, blockWidth]; omega), + symDecode_take_two] + exact symDecode_rightCode t hW + +/-! ### One tape's step + +The encoded step on a tape's two half-blocks. Every right-hand side is +`take 2` / `drop 2` / `++` / a fixedValue and a re-pad, so the algebra realizes it +with `Cobham.takeFn`, `Cobham.dropFn`, `Cobham.appendFn`, `Cobham.const` and +`Cobham.padFn` — and within one branch of `Cobham.tableFn` the symbol `s` and the +direction `d` are *constants*. -/ + +/-- The two half-blocks of a tape after writing `s` and moving `d`. -/ +def tapeStepBlocks (R : List Bool) (s : Γ) (d : Dir3) (L Rt : List Bool) : + List Bool × List Bool := + match d with + | .stay => (L, padTo R (symCode s ++ Rt.drop 2)) + | .right => (padTo R (symCode s ++ L), padTo R (Rt.drop 2)) + | .left => (padTo R (L.drop 2), padTo R (L.take 2 ++ symCode s ++ Rt.drop 2)) + +/-- **The encoded step simulates `Tape.writeAndMove`** on both half-blocks. + +The hypotheses are exactly what the corrected encoded action supplies. `hs`: at +cell `0` the write is a no-op, so `correctWrite` replaces the raw `Γw` symbol by +the existing `▷`. `hne`: `TM.δ_right_of_start` ensures that a head at cell `0` +can only move *right*, so the stay and left cases never arise there. -/ +theorem tapeStepBlocks_eq {W : ℕ} (t : Tape) (s : Γ) (d : Dir3) + (hs : t.head = 0 → s = t.cells t.head) + (hne : d ≠ Dir3.right → t.head ≠ 0) (hW : t.head ≤ W) : + tapeStepBlocks (blockRuler W) s d + (padTo (blockRuler W) (leftCode t)) (padTo (blockRuler W) (rightCode t W)) + = (padTo (blockRuler W) (leftCode ((t.write s).move d)), + padTo (blockRuler W) (rightCode ((t.write s).move d) W)) := by + have hLlen : (leftCode t).length ≤ (blockRuler W).length := by + rw [leftCode_length, blockRuler_length, blockWidth]; omega + have hRlen : (rightCode t W).length ≤ (blockRuler W).length := by + rw [rightCode_length, blockRuler_length, blockWidth]; omega + have hR2 : 2 ≤ (rightCode t W).length := by rw [rightCode_length]; omega + have hdrop : (padTo (blockRuler W) (rightCode t W)).drop 2 + = (rightCode t W).drop 2 ++ + List.replicate ((blockRuler W).length - (rightCode t W).length) false := + drop_padTo _ _ 2 hR2 hRlen + cases d with + | stay => + have h0 : t.head ≠ 0 := hne (by decide) + rw [tapeStepBlocks, leftCode_write_stay, rightCode_write_stay h0 hW, hdrop, + ← List.append_assoc, padTo_append_replicate] + | right => + rw [tapeStepBlocks, leftCode_write_right hs, rightCode_write_right hW, hdrop, + padTo_append_padTo _ _ _ hLlen, padTo_append_replicate] + | left => + have h0 : t.head ≠ 0 := hne (by decide) + have hL2 : 2 ≤ (leftCode t).length := by + rw [leftCode_length]; omega + rw [tapeStepBlocks, leftCode_write_left h0, rightCode_write_left h0 hW, + padTo_drop _ _ 2 hL2 hLlen, take_padTo _ _ 2 hL2 hLlen, hdrop, + ← List.append_assoc, padTo_append_replicate] + +/-! ### All the tapes at once + +`TM.step` writes and moves on every tape independently, so the encoded step is +the same operation applied tapewise. Treating the tapes as one list — input, +output, then work tapes, the order the encoding uses — makes that a +`List.zipWith` against the transition's per-tape actions, with no positional +index arithmetic. -/ + +/-- Writing back the symbol already under the head changes nothing. This is what +lets the read-only input tape take part in the uniform tapewise step: its action +is "write what you read, then move". -/ +theorem write_read_self (t : Tape) : t.write t.read = t := by + rw [Tape.write] + split + · rfl + · exact Tape.ext rfl (by rw [Tape.read]; exact Function.update_eq_self _ _) + +/-- All of a configuration's tapes in encoding order. -/ +def cfgTapes {k : ℕ} {Q : Type} (c : Cfg k Q) : List Tape := + c.input :: c.output :: List.ofFn c.work + +@[simp] theorem cfgTapes_length {k : ℕ} {Q : Type} (c : Cfg k Q) : + (cfgTapes c).length = k + 2 := by + rw [cfgTapes, List.length_cons, List.length_cons, List.length_ofFn] + +/-! ### The transition key + +The transition function is indexed by the current state together with the symbol +under every head. Packing those into one string turns the whole finite case +analysis into `Cobham.tableFn`: each (state, symbols) combination is a *fixedValue* +pattern, and there are finitely many of them for a fixed machine. -/ + +/-- The state and the symbols under every head, in tape order. -/ +noncomputable def keyCode {k : ℕ} {Q : Type} [Fintype Q] [DecidableEq Q] + (c : Cfg k Q) : List Bool := + stateCode c.state ++ (cfgTapes c).flatMap fun t => symCode t.read + +@[simp] theorem keyCode_length {k : ℕ} {Q : Type} [Fintype Q] [DecidableEq Q] + (c : Cfg k Q) : (keyCode c).length = Fintype.card Q + 2 * (k + 2) := by + rw [keyCode, List.length_append, stateCode_length, + length_flatMap_const (cfgTapes c) (fun t => symCode t.read) 2 + (fun t => symCode_length t.read), cfgTapes_length, Nat.mul_comm] + +/-- The first two bits of a tape's right half-block are its read symbol. -/ +theorem take_rightCode (t : Tape) {W : ℕ} (hW : t.head ≤ W) : + (rightCode t W).take 2 = symCode t.read := by + rw [rightCode, show W + 1 - t.head = (W - t.head) + 1 from by omega, + cellsCode_succ_left, List.take_left' (by simp)] + rfl + + +/-- The blocks of a list of tapes: two per tape. -/ +def tapesBlocks (W : ℕ) (ts : List Tape) : List (List Bool) := + ts.flatMap (tapeBlocks W) + +@[simp] theorem tapesBlocks_length (W : ℕ) (ts : List Tape) : + (tapesBlocks W ts).length = 2 * ts.length := by + rw [tapesBlocks, length_flatMap_const _ _ 2 (fun t => tapeBlocks_length W t)] + omega + +/-- The tapes after one step, given each tape's write and move. -/ +def tapesStep (acts : List (Γ × Dir3)) (ts : List Tape) : List Tape := + List.zipWith (fun a t => (t.write a.1).move a.2) acts ts + +/-- `zipWith` over two tuples is the tuple of the pointwise results. -/ +private theorem zipWith_ofFn {α β γ : Type} {n : ℕ} (f : α → β → γ) + (g : Fin n → α) (h : Fin n → β) : + List.zipWith f (List.ofFn g) (List.ofFn h) = List.ofFn fun i => f (g i) (h i) := by + induction n with + | zero => rfl + | succ n ih => + rw [List.ofFn_succ, List.ofFn_succ, List.ofFn_succ, List.zipWith_cons_cons, ih] + +/-- The write a transition *really* performs: at cell `0` the model makes the +write a no-op, and this records that. Under `Tape.StartInvariant` the test is on +the **read symbol**, which the transition table already branches on — so the +correction costs the algebra nothing, it just picks a different fixedValue in the +`▷` branch. -/ +def correctWriteSym (r s : Γ) : Γ := if r = Γ.start then Γ.start else s + +/-- The corrected write on a tape — a function of its read symbol alone, which is +what puts it inside the transition key. -/ +def correctWrite (t : Tape) (s : Γ) : Γ := correctWriteSym t.read s + +/-- Correcting the write does not change what the write does. -/ +theorem write_correctWrite {t : Tape} (s : Γ) (h : t.StartInvariant) : + t.write (correctWrite t s) = t.write s := by + rw [correctWrite, correctWriteSym] + split + · next hr => + have hh : t.head = 0 := by + by_contra hne + exact h.read_ne_start (by omega) hr + rw [Tape.write, if_pos hh, Tape.write, if_pos hh] + · rfl + +/-- Under the invariant, the corrected write agrees with cell `0` when the head +is there — the hypothesis `tapeStepBlocks_eq` needs. -/ +theorem correctWrite_at_zero {t : Tape} (s : Γ) (h : t.StartInvariant) + (hh : t.head = 0) : correctWrite t s = t.cells t.head := by + have hr : t.read = Γ.start := by rw [Tape.read, hh]; exact h.1 + rw [correctWrite, correctWriteSym, if_pos hr] + show Γ.start = t.cells t.head + rw [hh] + exact h.1.symm + +/-- The per-tape (write, move) actions a transition prescribes, in encoding +order. The input tape's "write" is the symbol it just read, which by +`write_read_self` leaves it unchanged — so the read-only input tape fits the +uniform tapewise step with no special case. -/ +def stepActs {k : ℕ} (tm : TM k) (c : Cfg k tm.Q) : List (Γ × Dir3) := + let d := tm.δ c.state c.input.read (fun i => (c.work i).read) c.output.read + (c.input.read, d.2.2.2.1) :: + (correctWrite c.output d.2.2.1.toΓ, d.2.2.2.2.2) :: + List.ofFn fun i => (correctWrite (c.work i) (d.2.1 i).toΓ, d.2.2.2.2.1 i) + +/-! ### The transition key determines the step + +Everything the successor configuration depends on — the new state and every +tape's write and direction — is a function of the state together with the symbol +under each head. That is exactly what a `Cobham.tableFn` entry can be indexed by, +and it is why any entry matching a configuration's key carries the right +branch. -/ + +/-- The symbols under a configuration's heads, in `cfgTapes` order. -/ +def cfgReads {k : ℕ} {Q : Type} (c : Cfg k Q) : Fin (k + 2) → Γ := + Fin.cons c.input.read (Fin.cons c.output.read fun i => (c.work i).read) + +/-- A transition key's pattern string: the state's one-hot code followed by the +symbol under each head. Constant for each key, so it is what a +`Cobham.tableFn` entry matches against. -/ +noncomputable def keyPattern {k : ℕ} {Q : Type} [Fintype Q] [DecidableEq Q] + (p : Q × (Fin (k + 2) → Γ)) : List Bool := + stateCode p.1 ++ (List.ofFn p.2).flatMap symCode + +@[simp] theorem keyPattern_length {k : ℕ} {Q : Type} [Fintype Q] [DecidableEq Q] + (p : Q × (Fin (k + 2) → Γ)) : + (keyPattern p).length = Fintype.card Q + 2 * (k + 2) := by + rw [keyPattern, List.length_append, stateCode_length, + length_flatMap_const (List.ofFn p.2) symCode 2 symCode_length, List.length_ofFn, + Nat.mul_comm] + +/-- Runs of coded symbols determine their symbols. -/ +private theorem flatMap_symCode_injective : + ∀ l₁ l₂ : List Γ, l₁.length = l₂.length → + l₁.flatMap symCode = l₂.flatMap symCode → l₁ = l₂ := by + intro l₁ + induction l₁ with + | nil => intro l₂ hlen _; exact (List.length_eq_zero_iff.mp hlen.symm).symm + | cons a l₁ ih => + intro l₂ hlen heq + cases l₂ with + | nil => simp at hlen + | cons b l₂ => + rw [List.flatMap_cons, List.flatMap_cons] at heq + obtain ⟨h1, h2⟩ := List.append_inj heq (by simp) + rw [symCode_injective h1, ih l₂ (by simpa using hlen) h2] + +/-- **Distinct keys get distinct patterns.** Together with the fact that all +patterns have the same length, this is what makes at most one table entry match a +given key. -/ +theorem keyPattern_injective {k : ℕ} {Q : Type} [Fintype Q] [DecidableEq Q] : + Function.Injective (keyPattern (k := k) (Q := Q)) := by + rintro ⟨q₁, s₁⟩ ⟨q₂, s₂⟩ h + rw [keyPattern, keyPattern] at h + obtain ⟨h1, h2⟩ := List.append_inj h (by simp) + have hq := stateCode_injective h1 + have hs := flatMap_symCode_injective _ _ (by simp) h2 + subst hq + simp only [Prod.mk.injEq, true_and] + exact List.ofFn_inj.mp hs + +/-- The tapes' read symbols, listed, are the configuration's read tuple. -/ +theorem cfgTapes_map_read {k : ℕ} {Q : Type} (c : Cfg k Q) : + (cfgTapes c).map Tape.read = List.ofFn (cfgReads c) := by + rw [cfgTapes, cfgReads] + simp [List.ofFn_succ, Function.comp_def] + +/-- **A configuration's key is its key's pattern.** So the table entry indexed by +`(state, reads)` is the one that matches. -/ +theorem keyCode_eq {k : ℕ} {Q : Type} [Fintype Q] [DecidableEq Q] (c : Cfg k Q) : + keyCode c = keyPattern (c.state, cfgReads c) := by + rw [keyCode, keyPattern] + congr 1 + rw [← cfgTapes_map_read] + simp [List.flatMap_map] + +/-- The per-tape actions determined by a transition key. -/ +def stepActsOf {k : ℕ} (tm : TM k) (q : tm.Q) (syms : Fin (k + 2) → Γ) : + List (Γ × Dir3) := + let d := tm.δ q (syms 0) (fun i => syms i.succ.succ) (syms 1) + (syms 0, d.2.2.2.1) :: + (correctWriteSym (syms 1) d.2.2.1.toΓ, d.2.2.2.2.2) :: + List.ofFn fun i => + (correctWriteSym (syms i.succ.succ) (d.2.1 i).toΓ, d.2.2.2.2.1 i) + +/-- The successor state determined by a transition key. -/ +def stepStateOf {k : ℕ} (tm : TM k) (q : tm.Q) (syms : Fin (k + 2) → Γ) : tm.Q := + (tm.δ q (syms 0) (fun i => syms i.succ.succ) (syms 1)).1 + +/-- The actions a configuration prescribes are the ones its key prescribes. -/ +theorem stepActs_eq_stepActsOf {k : ℕ} (tm : TM k) (c : Cfg k tm.Q) : + stepActs tm c = stepActsOf tm c.state (cfgReads c) := rfl + +/-- The successor state is the one the key prescribes. -/ +theorem step_state_eq {k : ℕ} (tm : TM k) {c c' : Cfg k tm.Q} + (h : tm.step c = some c') : c'.state = stepStateOf tm c.state (cfgReads c) := by + have hne : ¬ c.state = tm.qhalt := fun hq => by simp [TM.step, hq] at h + rw [TM.step, if_neg hne] at h + injection h with h + subst h + rfl + +/-- **`TM.step` is the tapewise action.** Every tape writes and moves according +to `stepActs`, so the whole configuration's tapes step uniformly. -/ +theorem cfgTapes_step {k : ℕ} (tm : TM k) {c c' : Cfg k tm.Q} + (h : tm.step c = some c') (hout : c.output.StartInvariant) + (hwork : ∀ i, (c.work i).StartInvariant) : + cfgTapes c' = tapesStep (stepActs tm c) (cfgTapes c) := by + have hne : ¬ c.state = tm.qhalt := fun hq => by simp [TM.step, hq] at h + rw [TM.step, if_neg hne] at h + injection h with h + subst h + rw [cfgTapes, cfgTapes, stepActs, tapesStep] + dsimp only + rw [List.zipWith_cons_cons, List.zipWith_cons_cons, zipWith_ofFn] + dsimp only + simp only [write_read_self, write_correctWrite _ hout, + write_correctWrite _ (hwork _)] + +/-- **One tape's blocks after a step.** Immediate from `tapeStepBlocks_eq`; this +is the form that lifts tapewise across a whole configuration. -/ +theorem tapeBlocks_step {W : ℕ} (a : Γ × Dir3) (t : Tape) + (hs : t.head = 0 → a.1 = t.cells t.head) + (hne : a.2 ≠ Dir3.right → t.head ≠ 0) (hW : t.head ≤ W) : + tapeBlocks W ((t.write a.1).move a.2) = + [(tapeStepBlocks (blockRuler W) a.1 a.2 (padTo (blockRuler W) (leftCode t)) + (padTo (blockRuler W) (rightCode t W))).1, + (tapeStepBlocks (blockRuler W) a.1 a.2 (padTo (blockRuler W) (leftCode t)) + (padTo (blockRuler W) (rightCode t W))).2] := by + rw [tapeStepBlocks_eq t a.1 a.2 hs hne hW] + rfl + +/-- The tapewise step acts blockwise on the encoding. -/ +theorem tapesBlocks_tapesStep {W : ℕ} : + ∀ (acts : List (Γ × Dir3)) (ts : List Tape), + List.Forall₂ (fun (a : Γ × Dir3) (t : Tape) => + (t.head = 0 → a.1 = t.cells t.head) ∧ + (a.2 ≠ Dir3.right → t.head ≠ 0) ∧ t.head ≤ W) acts ts → + tapesBlocks W (tapesStep acts ts) = + (List.zipWith (fun a t => + [(tapeStepBlocks (blockRuler W) a.1 a.2 (padTo (blockRuler W) (leftCode t)) + (padTo (blockRuler W) (rightCode t W))).1, + (tapeStepBlocks (blockRuler W) a.1 a.2 (padTo (blockRuler W) (leftCode t)) + (padTo (blockRuler W) (rightCode t W))).2]) acts ts).flatten := by + intro acts ts h + induction h with + | nil => rfl + | @cons a t acts ts hat _ ih => + rw [tapesStep, List.zipWith_cons_cons, tapesBlocks, List.flatMap_cons, + tapeBlocks_step a t hat.1 hat.2.1 hat.2.2, List.zipWith_cons_cons, + List.flatten_cons] + exact congrArg (List.append _) ih + +/-- A whole configuration as a list of equal-width blocks: the one-hot state +padded to a block, then the input tape, the output tape, and the work tapes, +each as two half-blocks. -/ +noncomputable def cfgBlocks {k : ℕ} {Q : Type} [Fintype Q] [DecidableEq Q] + (W : ℕ) (c : Cfg k Q) : List (List Bool) := + padTo (blockRuler W) (stateCode c.state) :: tapesBlocks W (cfgTapes c) + +theorem cfgBlocks_eq {k : ℕ} {Q : Type} [Fintype Q] [DecidableEq Q] + (W : ℕ) (c : Cfg k Q) : + cfgBlocks W c = + padTo (blockRuler W) (stateCode c.state) :: tapesBlocks W (cfgTapes c) := rfl + +/-- Every field of a configuration occupies exactly one block. -/ +theorem cfgBlocks_width {k : ℕ} {Q : Type} [Fintype Q] [DecidableEq Q] + (W : ℕ) (c : Cfg k Q) : + ∀ b ∈ cfgBlocks W c, b.length = (blockRuler W).length := by + intro b hb + rw [cfgBlocks, List.mem_cons] at hb + rcases hb with rfl | hb + · simp + · obtain ⟨t, _, ht⟩ := List.mem_flatMap.mp hb + exact tapeBlocks_width W t b ht + +/-- A whole configuration as a bitstring. -/ +noncomputable def cfgCode {k : ℕ} {Q : Type} [Fintype Q] [DecidableEq Q] + (W : ℕ) (c : Cfg k Q) : List Bool := (cfgBlocks W c).flatten + +/-- **Field access.** Block `i` of an encoded configuration is field `i` — so +`Cobham.blockFn … i` reads it, and no self-delimiting decoder is ever needed. -/ +theorem blockAt_cfgCode {k : ℕ} {Q : Type} [Fintype Q] [DecidableEq Q] + (W : ℕ) (c : Cfg k Q) (i : ℕ) (hi : i < (cfgBlocks W c).length) : + blockAt (blockRuler W) (cfgCode W c) i = (cfgBlocks W c)[i] := + blockAt_flatten _ _ (cfgBlocks_width W c) i hi + +/-- A configuration has `2(k+2) + 1` blocks: one per tape half plus the state. -/ +@[simp] theorem cfgBlocks_length {k : ℕ} {Q : Type} [Fintype Q] [DecidableEq Q] + (W : ℕ) (c : Cfg k Q) : (cfgBlocks W c).length = 2 * (k + 2) + 1 := by + rw [cfgBlocks, List.length_cons, tapesBlocks, + length_flatMap_const _ _ 2 (fun t => tapeBlocks_length W t), cfgTapes_length] + omega + +/-- **The encoded configuration steps blockwise.** Composing `cfgTapes_step` +(`TM.step` is the tapewise action) with `tapesBlocks_tapesStep` (that action is +blockwise on the encoding): the successor's blocks are the new state block +followed by the old blocks transformed two at a time by `tapeStepBlocks`. + +The `Forall₂` hypothesis pairs each tape with its own action, which is what a run +supplies: `δ_right_of_start` constrains a tape at cell `0` only through *its own* +transition entry. -/ +theorem cfgBlocks_step {k : ℕ} (tm : TM k) {c c' : Cfg k tm.Q} {W : ℕ} + (h : tm.step c = some c') (hout : c.output.StartInvariant) + (hwork : ∀ i, (c.work i).StartInvariant) + (hgood : List.Forall₂ (fun (a : Γ × Dir3) (t : Tape) => + (t.head = 0 → a.1 = t.cells t.head) ∧ + (a.2 ≠ Dir3.right → t.head ≠ 0) ∧ t.head ≤ W) (stepActs tm c) (cfgTapes c)) : + cfgBlocks W c' = + padTo (blockRuler W) (stateCode c'.state) :: + (List.zipWith (fun a t => + [(tapeStepBlocks (blockRuler W) a.1 a.2 (padTo (blockRuler W) (leftCode t)) + (padTo (blockRuler W) (rightCode t W))).1, + (tapeStepBlocks (blockRuler W) a.1 a.2 (padTo (blockRuler W) (leftCode t)) + (padTo (blockRuler W) (rightCode t W))).2]) + (stepActs tm c) (cfgTapes c)).flatten := by + rw [cfgBlocks, cfgTapes_step tm h hout hwork, + tapesBlocks_tapesStep (stepActs tm c) (cfgTapes c) hgood] + +/-- `Forall₂` over two tuples follows pointwise. -/ +private theorem forall₂_ofFn {α β : Type} {R : α → β → Prop} {n : ℕ} + {f : Fin n → α} {g : Fin n → β} (h : ∀ i, R (f i) (g i)) : + List.Forall₂ R (List.ofFn f) (List.ofFn g) := by + induction n with + | zero => exact List.Forall₂.nil + | succ n ih => + rw [List.ofFn_succ, List.ofFn_succ] + exact List.Forall₂.cons (h 0) (ih fun i => h i.succ) + +/-- **The step's side conditions hold in any run.** The write-agreement at cell +`0` is `correctWrite_at_zero`, and "a head at cell `0` can only move right" is +exactly `TM.δ_right_of_start` read through the invariant: at cell `0` the tape +reads `▷`, which is the hypothesis that rule fires on. -/ +theorem stepActs_forall₂ {k : ℕ} (tm : TM k) (c : Cfg k tm.Q) {W : ℕ} + (hinv : ∀ t ∈ cfgTapes c, t.StartInvariant) + (hW : ∀ t ∈ cfgTapes c, t.head ≤ W) : + List.Forall₂ (fun (a : Γ × Dir3) (t : Tape) => + (t.head = 0 → a.1 = t.cells t.head) ∧ + (a.2 ≠ Dir3.right → t.head ≠ 0) ∧ t.head ≤ W) + (stepActs tm c) (cfgTapes c) := by + obtain ⟨hri, hrw, hro⟩ := + tm.δ_right_of_start c.state c.input.read (fun i => (c.work i).read) c.output.read + have hmem_in : c.input ∈ cfgTapes c := by simp [cfgTapes] + have hmem_out : c.output ∈ cfgTapes c := by simp [cfgTapes] + have hmem_work : ∀ i, c.work i ∈ cfgTapes c := fun i => by + simp only [cfgTapes, List.mem_cons] + exact Or.inr (Or.inr (List.mem_ofFn.mpr ⟨i, rfl⟩)) + -- At cell `0` a tape reads `▷`, which is what `δ_right_of_start` fires on. + have hzero : ∀ t ∈ cfgTapes c, t.head = 0 → t.read = Γ.start := fun t ht h0 => by + rw [Tape.read, h0]; exact (hinv t ht).1 + rw [stepActs, cfgTapes] + refine List.Forall₂.cons ⟨fun _ => rfl, fun hd h0 => hd ?_, hW _ hmem_in⟩ + (List.Forall₂.cons + ⟨fun h0 => correctWrite_at_zero _ (hinv _ hmem_out) h0, + fun hd h0 => hd ?_, hW _ hmem_out⟩ + (forall₂_ofFn fun i => + ⟨fun h0 => correctWrite_at_zero _ (hinv _ (hmem_work i)) h0, + fun hd h0 => hd ?_, hW _ (hmem_work i)⟩)) + · exact hri (hzero _ hmem_in h0) + · exact hro (hzero _ hmem_out h0) + · exact hrw i (hzero _ (hmem_work i) h0) + +/-- **Tape `j` lives in blocks `2j` and `2j+1`** of the tape-block list. Combined +with the state block at the front of `cfgBlocks`, tape `j` of a configuration +occupies blocks `2j+1` and `2j+2` — which is how `Cobham.blockFn` addresses +them. -/ +theorem getElem?_tapesBlocks (W : ℕ) : + ∀ (ts : List Tape) (j : ℕ), + (tapesBlocks W ts)[2 * j]? = + (ts[j]?).map (fun t => padTo (blockRuler W) (leftCode t)) ∧ + (tapesBlocks W ts)[2 * j + 1]? = + (ts[j]?).map (fun t => padTo (blockRuler W) (rightCode t W)) := by + intro ts + induction ts with + | nil => intro j; simp [tapesBlocks] + | cons t ts ih => + intro j + cases j with + | zero => simp [tapesBlocks, tapeBlocks] + | succ j => + have hlen : (tapeBlocks W t).length = 2 := rfl + have e1 : 2 * (j + 1) = (tapeBlocks W t).length + 2 * j := by + rw [hlen]; omega + rw [tapesBlocks, List.flatMap_cons, e1, + List.getElem?_append_right (by omega), + List.getElem?_append_right (by omega)] + simp only [Nat.add_sub_cancel_left, List.getElem?_cons_succ, + show (tapeBlocks W t).length + 2 * j + 1 - (tapeBlocks W t).length + = 2 * j + 1 from by omega] + exact ⟨(ih j).1, (ih j).2⟩ + +/-! ### Field accessors + +The first three blocks — the state and the input tape's two halves — read out +directly. Each is one `Cobham.blockFn` on the algebra side. -/ + +/-- Block `0` holds the state. -/ +theorem blockAt_cfgCode_state {k : ℕ} {Q : Type} [Fintype Q] [DecidableEq Q] + (W : ℕ) (c : Cfg k Q) : + blockAt (blockRuler W) (cfgCode W c) 0 + = padTo (blockRuler W) (stateCode c.state) := by + rw [blockAt_cfgCode W c 0 (by simp)] + rfl + +/-- Unpadding block `0` recovers the one-hot state code, which the transition +table then matches against its finitely many constants. -/ +theorem state_of_cfgCode {k : ℕ} {Q : Type} [Fintype Q] [DecidableEq Q] + (W : ℕ) (c : Cfg k Q) (hW : Fintype.card Q ≤ blockWidth W) : + (blockAt (blockRuler W) (cfgCode W c) 0).take (Fintype.card Q) + = stateCode c.state := by + rw [blockAt_cfgCode_state, + take_padTo _ _ _ (by simp) (by rw [stateCode_length, blockRuler_length]; omega), + List.take_of_length_le (by simp)] + +/-- Block `1` is the input tape's left half. -/ +theorem blockAt_cfgCode_inputLeft {k : ℕ} {Q : Type} [Fintype Q] [DecidableEq Q] + (W : ℕ) (c : Cfg k Q) : + blockAt (blockRuler W) (cfgCode W c) 1 + = padTo (blockRuler W) (leftCode c.input) := by + rw [blockAt_cfgCode W c 1 (by simp)] + rfl + +/-- Block `2` is the input tape's right half — the one the read symbol comes +from. -/ +theorem blockAt_cfgCode_inputRight {k : ℕ} {Q : Type} [Fintype Q] [DecidableEq Q] + (W : ℕ) (c : Cfg k Q) : + blockAt (blockRuler W) (cfgCode W c) 2 + = padTo (blockRuler W) (rightCode c.input W) := by + rw [blockAt_cfgCode W c 2 (by rw [cfgBlocks_length]; omega)] + rfl + +/-- The input head's symbol, read straight out of the encoding. -/ +theorem inputRead_of_cfgCode {k : ℕ} {Q : Type} [Fintype Q] [DecidableEq Q] + (W : ℕ) (c : Cfg k Q) (hW : c.input.head ≤ W) : + symDecode ((blockAt (blockRuler W) (cfgCode W c) 2).take 2) = c.input.read := by + rw [blockAt_cfgCode_inputRight] + exact symDecode_take_padTo_rightCode c.input hW + + +end Cobham + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/Extract.lean b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/Extract.lean new file mode 100644 index 0000000000..ef14f0a8e3 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/Extract.lean @@ -0,0 +1,251 @@ +/- +Copyright (c) 2026 Bolton Bailey. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Bolton Bailey +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.Blocks +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.Algebra + +/-! +# Reading a string out of an encoded tape — proof internals + +The completeness direction ends by reading the simulated machine's output off +its encoded output tape. Once the output head has been driven back to cell `0` +(see `Complexitylib.Classes.P.Cobham.Internal.StepAlgebra`), that tape's right +half-block is the whole tape in order, two bits per cell: the first bit of a +cell says whether it holds data, the second is the data bit. + +So the output is recovered by two short recursions on notation, both collected +here: + +* `Complexity.cellBits` — every second bit of a string, from a fixed offset; + used twice, once for the "is data" bits and once for the data bits; +* `Complexity.runTrue` — the leading run of `true`s, as a ruler; its length is + where the first blank cell is, hence the output's length. + +## Main results + +- `Complexity.Cobham.cellBitsFn`, `Complexity.Cobham.runTrueFn` — both are in + the algebra +- `Complexity.runTrue_length` — the run's length is where the first `false` is, + clamped by the ruler +-/ + + +@[expose] public section + +namespace Complexity + +/-! ## Reading a single bit -/ + +/-- The bit of `z` at position `p`, `false` past the end. -/ +def bitOf (z : List Bool) (p : ℕ) : Bool := (z.drop p).headD false + +/-- Within range, `bitOf` is the indexed bit. -/ +theorem bitOf_eq_getElem {z : List Bool} {p : ℕ} (h : p < z.length) : + bitOf z p = z[p] := by + rw [bitOf, List.drop_eq_getElem_cons h, List.headD_cons] + +/-- Past the end there is no bit. -/ +theorem bitOf_of_le {z : List Bool} {p : ℕ} (h : z.length ≤ p) : + bitOf z p = false := by + rw [bitOf, List.drop_eq_nil_of_le h, List.headD_nil] + +/-- Reading inside the first part of a concatenation. -/ +theorem bitOf_append_left {a : List Bool} {p : ℕ} (h : p < a.length) (b : List Bool) : + bitOf (a ++ b) p = bitOf a p := by + rw [bitOf, bitOf, List.drop_append_of_le_length h.le, List.drop_eq_getElem_cons h] + rw [List.cons_append, List.headD_cons, List.headD_cons] + +/-- Reading past the first part of a concatenation. -/ +theorem bitOf_append_right {a : List Bool} {p : ℕ} (h : a.length ≤ p) (b : List Bool) : + bitOf (a ++ b) p = bitOf b (p - a.length) := by + rw [bitOf, bitOf, List.drop_append, List.drop_eq_nil_of_le h, List.nil_append] + +/-- `Cobham.bitAt` reads exactly one bit, and it is `bitOf`. -/ +theorem bitAt_eq (r z : List Bool) : bitAt r z = [bitOf z r.length] := by + rw [bitAt, bitOf] + cases h : z.drop r.length with + | nil => rw [caseBit₀_nil, List.headD_nil] + | cons b l => cases b <;> rw [caseBit₀_cons] <;> rfl + +/-! ## Every second bit + +`cellBits o z m` lists the bits of `z` at positions `o, o + 2, …, o + 2(m-1)`. +With `z` a run of two-bit symbol codes, offset `o` picks out one bit of each +symbol — which is how both halves of a coded cell are read. -/ + +/-- The bits of `z` at positions `2i + o` for `i < m`. -/ +def cellBits (o : ℕ) (z : List Bool) : ℕ → List Bool + | 0 => [] + | m + 1 => cellBits o z m ++ [bitOf z (2 * m + o)] + +@[simp] theorem cellBits_length (o : ℕ) (z : List Bool) (m : ℕ) : + (cellBits o z m).length = m := by + induction m with + | zero => rfl + | succ m ih => rw [cellBits, List.length_append, ih]; rfl + +theorem cellBits_getElem? (o : ℕ) (z : List Bool) : + ∀ (m i : ℕ), i < m → (cellBits o z m)[i]? = some (bitOf z (2 * i + o)) := by + intro m + induction m with + | zero => intro i h; omega + | succ m ih => + intro i h + rw [cellBits] + rcases Nat.lt_or_ge i m with hi | hi + · rw [List.getElem?_append_left (by simpa using hi)] + exact ih i hi + · have him : i = m := by omega + subst him + rw [List.getElem?_append_right (by simp)] + simp + +/-! ## The leading run of `true`s + +The output tape's "is data" bits are `true` on the output and `false` at the +first blank past it, so the output's length is the length of the leading run of +`true`s. The recursion below computes it as a ruler, clamped at the width it is +run to: the guard `m ≤ |previous|` is what stops the run at the first `false` +rather than restarting after it. -/ + +/-- The leading run of `true`s of `z`, clamped to `m` bits, as a ruler. -/ +def runTrue (z : List Bool) : ℕ → List Bool + | 0 => [] + | m + 1 => + runTrue z m ++ (if m ≤ (runTrue z m).length ∧ bitOf z m = true then [true] else []) + +theorem runTrue_length_le (z : List Bool) (m : ℕ) : (runTrue z m).length ≤ m := by + induction m with + | zero => rfl + | succ m ih => + rw [runTrue, List.length_append] + split <;> simp <;> omega + +/-- **The run's length is where the first `false` is.** The guard in `runTrue` +stops the run at the first `false` rather than restarting after it, so the run's +length is the position of the first `false`, clamped by the width. -/ +theorem runTrue_length {z : List Bool} {n : ℕ} (htrue : ∀ i < n, bitOf z i = true) + (hfalse : bitOf z n = false) (m : ℕ) : + (runTrue z m).length = min m n := by + induction m with + | zero => simp [runTrue] + | succ m ih => + rw [runTrue, List.length_append, ih] + rcases Nat.lt_or_ge m n with hm | hm + · rw [if_pos ⟨by omega, htrue m hm⟩] + simp only [List.length_cons, List.length_nil] + omega + · rw [if_neg ?_] + · simp only [List.length_nil] + omega + · rintro ⟨h1, h2⟩ + have hme : m = n := by omega + rw [hme, hfalse] at h2 + exact Bool.noConfusion h2 + +/-! ## Both recursions are in the algebra -/ + +namespace Cobham + +/-- The step of `cellBits`: append the bit of the string at twice the remaining +ruler's length, plus the offset. -/ +private def cellStep (o : ℕ) (w : Fin 3 → List Bool) : List Bool := + w 1 ++ bitAt (w 0 ++ w 0 ++ List.replicate o false) (w 2) + +private theorem cellStep_cons (o : ℕ) (x p : List Bool) (v : Fin 1 → List Bool) : + cellStep o (Fin.cons x (Fin.cons p v)) + = p ++ bitAt (x ++ x ++ List.replicate o false) (v 0) := rfl + +/-- The step of `runTrue`: extend the run by one only when it has kept pace with +the ruler so far and the next bit is `true`. -/ +private def runStep (w : Fin 3 → List Bool) : List Bool := + w 1 ++ caseBit₀ + (andBit (notBit (nonemptyFlag ((w 0).drop (w 1).length))) (bitAt (w 0) (w 2))) + [true] [] + +private theorem runStep_cons (x p : List Bool) (v : Fin 1 → List Bool) : + runStep (Fin.cons x (Fin.cons p v)) + = p ++ caseBit₀ + (andBit (notBit (nonemptyFlag (x.drop p.length))) (bitAt x (v 0))) [true] [] := + rfl + +/-- **Every second bit is in the algebra.** One limited recursion on notation: +each peeled bit of the ruler appends one more bit of `z`, read at twice the +remaining ruler's length plus the offset. -/ +theorem cellBitsFn {n : ℕ} (o : ℕ) {gr gz : (Fin n → List Bool) → List Bool} + (hr : Cobham gr) (hz : Cobham gz) : + Cobham fun v : Fin n → List Bool => cellBits o (gz v) (gr v).length := by + have hrec : ∀ (x : List Bool) (v : Fin 1 → List Bool), + recNotation (fun _ : Fin 1 → List Bool => ([] : List Bool)) (cellStep o) + (cellStep o) x v = cellBits o (v 0) x.length := by + intro x v + induction x with + | nil => rfl + | cons b x ih => + have hlen : (x ++ x ++ List.replicate o false).length = 2 * x.length + o := by + simp; omega + cases b <;> + · rw [recNotation_cons] + simp only [cond_true, cond_false] + rw [cellStep_cons, ih, bitAt_eq, hlen, List.length_cons, cellBits] + have hh : Cobham (cellStep o) := + (appendFn (Cobham.proj 1) + (comp₂ bitAtFn + (appendFn (appendFn (Cobham.proj 0) (Cobham.proj 0)) + (Cobham.const (List.replicate o false))) + (Cobham.proj 2))).of_eq fun _ => rfl + have hbase : Cobham fun v : Fin 2 → List Bool => cellBits o (v 1) (v 0).length := by + refine (Cobham.boundedRec Cobham.empty hh hh (Cobham.proj 0) ?_).of_eq fun v => ?_ + · intro x v + rw [hrec, cellBits_length, Fin.cons_zero] + · rw [hrec]; rfl + exact (comp₂ hbase hr hz).of_eq fun _ => rfl + +/-- **The leading run of `true`s is in the algebra.** One limited recursion on +notation: the run grows by one only while it has kept pace with the ruler, which +is the length comparison `nonemptyFn`/`notFn` performs. -/ +theorem runTrueFn {n : ℕ} {gr gz : (Fin n → List Bool) → List Bool} + (hr : Cobham gr) (hz : Cobham gz) : + Cobham fun v : Fin n → List Bool => runTrue (gz v) (gr v).length := by + have hrec : ∀ (x : List Bool) (v : Fin 1 → List Bool), + recNotation (fun _ : Fin 1 → List Bool => ([] : List Bool)) runStep runStep x v + = runTrue (v 0) x.length := by + intro x v + induction x with + | nil => rfl + | cons b x ih => + cases b <;> + · rw [recNotation_cons] + simp only [cond_true, cond_false] + rw [runStep_cons, ih, bitAt_eq, List.length_cons, runTrue] + congr 1 + rcases Nat.lt_or_ge (runTrue (v 0) x.length).length x.length with hlt | hge + · rw [if_neg (by omega)] + cases hd : x.drop (runTrue (v 0) x.length).length with + | nil => rw [List.drop_eq_nil_iff] at hd; omega + | cons c l => cases c <;> rfl + · rw [List.drop_eq_nil_of_le hge] + cases hb : bitOf (v 0) x.length + · rw [if_neg (by simp)]; rfl + · rw [if_pos ⟨hge, rfl⟩]; rfl + have hh : Cobham runStep := + (appendFn (Cobham.proj 1) + (iteFn + (andFn (notFn (nonemptyFn (dropFn (Cobham.proj 1) (Cobham.proj 0)))) + (comp₂ bitAtFn (Cobham.proj 0) (Cobham.proj 2))) + (Cobham.const [true]) Cobham.empty)).of_eq fun _ => rfl + have hbase : Cobham fun v : Fin 2 → List Bool => runTrue (v 1) (v 0).length := by + refine (Cobham.boundedRec Cobham.empty hh hh (Cobham.proj 0) ?_).of_eq fun v => ?_ + · intro x v + rw [hrec, Fin.cons_zero] + exact runTrue_length_le _ _ + · rw [hrec]; rfl + exact (comp₂ hbase hr hz).of_eq fun _ => rfl + +end Cobham + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/FstBlock.lean b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/FstBlock.lean new file mode 100644 index 0000000000..0153aa290d --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/FstBlock.lean @@ -0,0 +1,357 @@ +/- +Copyright (c) 2026 Bolton Bailey. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Bolton Bailey +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.BlockScan +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.Counter +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Tape.Encoding + +/-! +# The block-payload decoder — proof internals + +`Cobham.fstBlockTM` is the same scan as `Cobham.sndBlockTM`, emitting each +decoded payload bit as it goes and stopping at the separator. Malformed input +halts with empty output. + +## Main results + +- `Cobham.fstBlock_mem_FP` — the payload decoder is in `FP` +-/ + + +public section + +namespace Complexity + +namespace Cobham + +open Complexity.TM + +/-- The payload decoder: scan doubled payload bits, emitting each decoded bit to +the output, until the `[false, true]` separator or end of input. Computes +`fstBlock`. -/ +def fstBlockTM : TM 0 where + Q := ScanPhase + qstart := .skip + qhalt := .done + δ := fun state iHead wHeads oHead => + match state with + | .skip => + (.scanA, fun i => readBackWrite (wHeads i), readBackWrite oHead, Dir3.right, + fun i => idleDir (wHeads i), Dir3.right) + | .scanA => + match iHead with + | Γ.zero => + (.scanBfalse, fun i => readBackWrite (wHeads i), readBackWrite oHead, + Dir3.right, fun i => idleDir (wHeads i), idleDir oHead) + | Γ.one => + (.scanBtrue, fun i => readBackWrite (wHeads i), readBackWrite oHead, + Dir3.right, fun i => idleDir (wHeads i), idleDir oHead) + | _ => + (.done, fun i => readBackWrite (wHeads i), readBackWrite oHead, + idleDir iHead, fun i => idleDir (wHeads i), idleDir oHead) + | .scanBfalse => + match iHead with + | Γ.zero => + (.scanA, fun i => readBackWrite (wHeads i), Γw.ofBool false, + Dir3.right, fun i => idleDir (wHeads i), Dir3.right) + | _ => + (.done, fun i => readBackWrite (wHeads i), readBackWrite oHead, + idleDir iHead, fun i => idleDir (wHeads i), idleDir oHead) + | .scanBtrue => + match iHead with + | Γ.one => + (.scanA, fun i => readBackWrite (wHeads i), Γw.ofBool true, + Dir3.right, fun i => idleDir (wHeads i), Dir3.right) + | _ => + (.done, fun i => readBackWrite (wHeads i), readBackWrite oHead, + idleDir iHead, fun i => idleDir (wHeads i), idleDir oHead) + | .emit => allIdle .done iHead wHeads oHead + | .done => allIdle .done iHead wHeads oHead + δ_right_of_start := by + intro state iHead wHeads oHead + match state with + | .skip => exact ⟨fun _ => rfl, fun _ => idleDir_right_of_start, fun _ => rfl⟩ + | .scanA => + cases iHead <;> + exact ⟨by first | exact fun _ => rfl | exact idleDir_right_of_start, + fun _ => idleDir_right_of_start, + by first | exact fun _ => rfl | exact idleDir_right_of_start⟩ + | .scanBfalse => + cases iHead <;> + exact ⟨by first | exact fun _ => rfl | exact idleDir_right_of_start, + fun _ => idleDir_right_of_start, + by first | exact fun _ => rfl | exact idleDir_right_of_start⟩ + | .scanBtrue => + cases iHead <;> + exact ⟨by first | exact fun _ => rfl | exact idleDir_right_of_start, + fun _ => idleDir_right_of_start, + by first | exact fun _ => rfl | exact idleDir_right_of_start⟩ + | .emit => exact rightOfStart_allIdle iHead wHeads oHead + | .done => exact rightOfStart_allIdle iHead wHeads oHead + +/-- The scan of `fstBlockTM`: from `scanA` on input `w` with output holding `acc`, +the machine emits the decoded payload of `w`, halting with `acc ++ fstBlock w`. -/ +private theorem fstBlockTM_scan_loop : + ∀ (fuel : ℕ) (w acc : List Bool), w.length ≤ fuel → ∀ (c : Cfg 0 fstBlockTM.Q), + c.state = ScanPhase.scanA → + c.input.HasBinarySuffix w → + c.output.HasBinaryPrefix acc → + ∃ c' t, t ≤ 2 * w.length + 2 ∧ fstBlockTM.reachesIn t c c' ∧ fstBlockTM.halted c' ∧ + c'.output.HasBinaryPrefix (acc ++ fstBlock w) := by + intro fuel + induction fuel with + | zero => + intro w acc hw c hstate hsuf hpre + have hwnil : w = [] := List.length_eq_zero_iff.mp (Nat.le_zero.mp hw) + subst hwnil + have hread : c.input.read = Γ.blank := hsuf.read_nil + have houtne : c.output.read ≠ Γ.start := by rw [hpre.read_blank]; decide + refine ⟨{ state := ScanPhase.done + input := c.input.move (idleDir c.input.read) + work := fun i => (c.work i).writeAndMove (readBackWrite (c.work i).read) + (idleDir (c.work i).read) + output := c.output.writeAndMove (readBackWrite c.output.read) + (idleDir c.output.read) }, 1, by simp, + .step (by simp [TM.step, hstate, fstBlockTM, hread]) .zero, rfl, ?_⟩ + rw [show c.output.writeAndMove (readBackWrite c.output.read) (idleDir c.output.read) + = c.output from Tape.writeAndMove_readBack_idle_of_ne_start _ houtne] + simpa [fstBlock] using hpre + | succ fuel ih => + intro w acc hw c hstate hsuf hpre + have houtne : c.output.read ≠ Γ.start := by rw [hpre.read_blank]; decide + match w with + | [] => + have hread : c.input.read = Γ.blank := hsuf.read_nil + refine ⟨{ state := ScanPhase.done + input := c.input.move (idleDir c.input.read) + work := fun i => (c.work i).writeAndMove (readBackWrite (c.work i).read) + (idleDir (c.work i).read) + output := c.output.writeAndMove (readBackWrite c.output.read) + (idleDir c.output.read) }, 1, by simp, + .step (by simp [TM.step, hstate, fstBlockTM, hread]) .zero, rfl, ?_⟩ + rw [show c.output.writeAndMove (readBackWrite c.output.read) (idleDir c.output.read) + = c.output from Tape.writeAndMove_readBack_idle_of_ne_start _ houtne] + simpa [fstBlock] using hpre + | [false] => + have hread : c.input.read = Γ.ofBool false := hsuf.read_cons + let c1 : Cfg 0 fstBlockTM.Q := + { state := ScanPhase.scanBfalse + input := c.input.move Dir3.right + work := fun i => (c.work i).writeAndMove (readBackWrite (c.work i).read) + (idleDir (c.work i).read) + output := c.output.writeAndMove (readBackWrite c.output.read) + (idleDir c.output.read) } + have hstep : fstBlockTM.step c = some c1 := by + simp [TM.step, hstate, fstBlockTM, hread, Γ.ofBool, c1] + have hsuf1 : c1.input.HasBinarySuffix [] := hsuf.move_right_cons + have hpre1 : c1.output.HasBinaryPrefix acc := by + rw [show c1.output = c.output from + Tape.writeAndMove_readBack_idle_of_ne_start _ houtne] + exact hpre + have hread1 : c1.input.read = Γ.blank := hsuf1.read_nil + have houtne1 : c1.output.read ≠ Γ.start := by rw [hpre1.read_blank]; decide + refine ⟨{ state := ScanPhase.done + input := c1.input.move (idleDir c1.input.read) + work := fun i => (c1.work i).writeAndMove (readBackWrite (c1.work i).read) + (idleDir (c1.work i).read) + output := c1.output.writeAndMove (readBackWrite c1.output.read) + (idleDir c1.output.read) }, 2, by simp, + .step hstep (.step (by simp [TM.step, fstBlockTM, hread1, c1]) .zero), rfl, ?_⟩ + rw [show c1.output.writeAndMove (readBackWrite c1.output.read) (idleDir c1.output.read) + = c1.output from Tape.writeAndMove_readBack_idle_of_ne_start _ houtne1] + simpa [fstBlock] using hpre1 + | [true] => + have hread : c.input.read = Γ.ofBool true := hsuf.read_cons + let c1 : Cfg 0 fstBlockTM.Q := + { state := ScanPhase.scanBtrue + input := c.input.move Dir3.right + work := fun i => (c.work i).writeAndMove (readBackWrite (c.work i).read) + (idleDir (c.work i).read) + output := c.output.writeAndMove (readBackWrite c.output.read) + (idleDir c.output.read) } + have hstep : fstBlockTM.step c = some c1 := by + simp [TM.step, hstate, fstBlockTM, hread, Γ.ofBool, c1] + have hsuf1 : c1.input.HasBinarySuffix [] := hsuf.move_right_cons + have hpre1 : c1.output.HasBinaryPrefix acc := by + rw [show c1.output = c.output from + Tape.writeAndMove_readBack_idle_of_ne_start _ houtne] + exact hpre + have hread1 : c1.input.read = Γ.blank := hsuf1.read_nil + have houtne1 : c1.output.read ≠ Γ.start := by rw [hpre1.read_blank]; decide + refine ⟨{ state := ScanPhase.done + input := c1.input.move (idleDir c1.input.read) + work := fun i => (c1.work i).writeAndMove (readBackWrite (c1.work i).read) + (idleDir (c1.work i).read) + output := c1.output.writeAndMove (readBackWrite c1.output.read) + (idleDir c1.output.read) }, 2, by simp, + .step hstep (.step (by simp [TM.step, fstBlockTM, hread1, c1]) .zero), rfl, ?_⟩ + rw [show c1.output.writeAndMove (readBackWrite c1.output.read) (idleDir c1.output.read) + = c1.output from Tape.writeAndMove_readBack_idle_of_ne_start _ houtne1] + simpa [fstBlock] using hpre1 + | false :: true :: y => + have hreadA : c.input.read = Γ.ofBool false := hsuf.read_cons + let c1 : Cfg 0 fstBlockTM.Q := + { state := ScanPhase.scanBfalse + input := c.input.move Dir3.right + work := fun i => (c.work i).writeAndMove (readBackWrite (c.work i).read) + (idleDir (c.work i).read) + output := c.output.writeAndMove (readBackWrite c.output.read) + (idleDir c.output.read) } + have hstepA : fstBlockTM.step c = some c1 := by + simp [TM.step, hstate, fstBlockTM, hreadA, Γ.ofBool, c1] + have hsuf1 : c1.input.HasBinarySuffix (true :: y) := hsuf.move_right_cons + have hpre1 : c1.output.HasBinaryPrefix acc := by + rw [show c1.output = c.output from + Tape.writeAndMove_readBack_idle_of_ne_start _ houtne] + exact hpre + have hreadB : c1.input.read = Γ.ofBool true := hsuf1.read_cons + have houtne1 : c1.output.read ≠ Γ.start := by rw [hpre1.read_blank]; decide + refine ⟨{ state := ScanPhase.done + input := c1.input.move (idleDir c1.input.read) + work := fun i => (c1.work i).writeAndMove (readBackWrite (c1.work i).read) + (idleDir (c1.work i).read) + output := c1.output.writeAndMove (readBackWrite c1.output.read) + (idleDir c1.output.read) }, 2, by simp, + .step hstepA (.step (by simp [TM.step, fstBlockTM, hreadB, Γ.ofBool, c1]) .zero), + rfl, ?_⟩ + rw [show c1.output.writeAndMove (readBackWrite c1.output.read) (idleDir c1.output.read) + = c1.output from Tape.writeAndMove_readBack_idle_of_ne_start _ houtne1] + simpa [fstBlock] using hpre1 + | true :: false :: rest => + have hreadA : c.input.read = Γ.ofBool true := hsuf.read_cons + let c1 : Cfg 0 fstBlockTM.Q := + { state := ScanPhase.scanBtrue + input := c.input.move Dir3.right + work := fun i => (c.work i).writeAndMove (readBackWrite (c.work i).read) + (idleDir (c.work i).read) + output := c.output.writeAndMove (readBackWrite c.output.read) + (idleDir c.output.read) } + have hstepA : fstBlockTM.step c = some c1 := by + simp [TM.step, hstate, fstBlockTM, hreadA, Γ.ofBool, c1] + have hsuf1 : c1.input.HasBinarySuffix (false :: rest) := hsuf.move_right_cons + have hpre1 : c1.output.HasBinaryPrefix acc := by + rw [show c1.output = c.output from + Tape.writeAndMove_readBack_idle_of_ne_start _ houtne] + exact hpre + have hreadB : c1.input.read = Γ.ofBool false := hsuf1.read_cons + have houtne1 : c1.output.read ≠ Γ.start := by rw [hpre1.read_blank]; decide + refine ⟨{ state := ScanPhase.done + input := c1.input.move (idleDir c1.input.read) + work := fun i => (c1.work i).writeAndMove (readBackWrite (c1.work i).read) + (idleDir (c1.work i).read) + output := c1.output.writeAndMove (readBackWrite c1.output.read) + (idleDir c1.output.read) }, 2, by simp, + .step hstepA (.step (by simp [TM.step, fstBlockTM, hreadB, Γ.ofBool, c1]) .zero), + rfl, ?_⟩ + rw [show c1.output.writeAndMove (readBackWrite c1.output.read) (idleDir c1.output.read) + = c1.output from Tape.writeAndMove_readBack_idle_of_ne_start _ houtne1] + simpa [fstBlock] using hpre1 + | false :: false :: z => + have hreadA : c.input.read = Γ.ofBool false := hsuf.read_cons + let c1 : Cfg 0 fstBlockTM.Q := + { state := ScanPhase.scanBfalse + input := c.input.move Dir3.right + work := fun i => (c.work i).writeAndMove (readBackWrite (c.work i).read) + (idleDir (c.work i).read) + output := c.output.writeAndMove (readBackWrite c.output.read) + (idleDir c.output.read) } + have hstepA : fstBlockTM.step c = some c1 := by + simp [TM.step, hstate, fstBlockTM, hreadA, Γ.ofBool, c1] + have hsuf1 : c1.input.HasBinarySuffix (false :: z) := hsuf.move_right_cons + have hpre1 : c1.output.HasBinaryPrefix acc := by + rw [show c1.output = c.output from + Tape.writeAndMove_readBack_idle_of_ne_start _ houtne] + exact hpre + have hreadB : c1.input.read = Γ.ofBool false := hsuf1.read_cons + let c2 : Cfg 0 fstBlockTM.Q := + { state := ScanPhase.scanA + input := c1.input.move Dir3.right + work := fun i => (c1.work i).writeAndMove (readBackWrite (c1.work i).read) + (idleDir (c1.work i).read) + output := c1.output.writeAndMove (Γw.ofBool false) Dir3.right } + have hstepB : fstBlockTM.step c1 = some c2 := by + simp [TM.step, fstBlockTM, hreadB, Γ.ofBool, c1, c2] + have hsuf2 : c2.input.HasBinarySuffix z := hsuf1.move_right_cons + have hpre2 : c2.output.HasBinaryPrefix (acc ++ [false]) := by + show (c1.output.writeAndMove ((Γw.ofBool false).toΓ) Dir3.right).HasBinaryPrefix + (acc ++ [false]) + rw [Γw.ofBool_toΓ]; exact Tape.hasBinaryPrefix_write_bit false hpre1 + have hzfuel : z.length ≤ fuel := by + simp only [List.length_cons] at hw; omega + obtain ⟨c', t, ht, hreach, hhalt, hcout⟩ := + ih z (acc ++ [false]) hzfuel c2 rfl hsuf2 hpre2 + refine ⟨c', t + 1 + 1, by simp only [List.length_cons]; omega, + .step hstepA (.step hstepB hreach), hhalt, ?_⟩ + have hfb : fstBlock (false :: false :: z) = false :: fstBlock z := rfl + rw [hfb, List.append_assoc, List.cons_append, List.nil_append] at * + exact hcout + | true :: true :: z => + have hreadA : c.input.read = Γ.ofBool true := hsuf.read_cons + let c1 : Cfg 0 fstBlockTM.Q := + { state := ScanPhase.scanBtrue + input := c.input.move Dir3.right + work := fun i => (c.work i).writeAndMove (readBackWrite (c.work i).read) + (idleDir (c.work i).read) + output := c.output.writeAndMove (readBackWrite c.output.read) + (idleDir c.output.read) } + have hstepA : fstBlockTM.step c = some c1 := by + simp [TM.step, hstate, fstBlockTM, hreadA, Γ.ofBool, c1] + have hsuf1 : c1.input.HasBinarySuffix (true :: z) := hsuf.move_right_cons + have hpre1 : c1.output.HasBinaryPrefix acc := by + rw [show c1.output = c.output from + Tape.writeAndMove_readBack_idle_of_ne_start _ houtne] + exact hpre + have hreadB : c1.input.read = Γ.ofBool true := hsuf1.read_cons + let c2 : Cfg 0 fstBlockTM.Q := + { state := ScanPhase.scanA + input := c1.input.move Dir3.right + work := fun i => (c1.work i).writeAndMove (readBackWrite (c1.work i).read) + (idleDir (c1.work i).read) + output := c1.output.writeAndMove (Γw.ofBool true) Dir3.right } + have hstepB : fstBlockTM.step c1 = some c2 := by + simp [TM.step, fstBlockTM, hreadB, Γ.ofBool, c1, c2] + have hsuf2 : c2.input.HasBinarySuffix z := hsuf1.move_right_cons + have hpre2 : c2.output.HasBinaryPrefix (acc ++ [true]) := by + show (c1.output.writeAndMove ((Γw.ofBool true).toΓ) Dir3.right).HasBinaryPrefix + (acc ++ [true]) + rw [Γw.ofBool_toΓ]; exact Tape.hasBinaryPrefix_write_bit true hpre1 + have hzfuel : z.length ≤ fuel := by + simp only [List.length_cons] at hw; omega + obtain ⟨c', t, ht, hreach, hhalt, hcout⟩ := + ih z (acc ++ [true]) hzfuel c2 rfl hsuf2 hpre2 + refine ⟨c', t + 1 + 1, by simp only [List.length_cons]; omega, + .step hstepA (.step hstepB hreach), hhalt, ?_⟩ + have hfb : fstBlock (true :: true :: z) = true :: fstBlock z := rfl + rw [hfb, List.append_assoc, List.cons_append, List.nil_append] at * + exact hcout + +/-- `fstBlock` is polynomial-time, via the `fstBlockTM` scanner. -/ +theorem fstBlock_mem_FP : fstBlock ∈ FP := by + refine ⟨1, 0, fstBlockTM, (fun m => 2 * m + 3), ?_, ?_⟩ + · intro z + let c1 : Cfg 0 fstBlockTM.Q := + { state := ScanPhase.scanA + input := (Tape.init (z.map Γ.ofBool)).move Dir3.right + work := fun _ => (Tape.init []).move Dir3.right + output := (Tape.init []).move Dir3.right } + have hstep1 : fstBlockTM.step (fstBlockTM.initCfg z) = some c1 := by + simp [TM.step, fstBlockTM, c1, Tape.read, Tape.init, readBackWrite, idleDir, + Tape.writeAndMove, Tape.write, Tape.move] + have hsuf : c1.input.HasBinarySuffix z := Tape.init_move_right_hasBinarySuffix z + have hpre : c1.output.HasBinaryPrefix [] := Tape.init_nil_move_right_hasBinaryPrefix_nil + obtain ⟨c', t, ht, hreach, hhalt, hcout⟩ := + fstBlockTM_scan_loop z.length z [] le_rfl c1 rfl hsuf hpre + refine ⟨c', t + 1, by show t + 1 ≤ 2 * z.length + 3; omega, + .step hstep1 hreach, hhalt, ?_⟩ + simpa using hcout.hasOutput + · have hn : (fun m : ℕ => 2 * m) =O ((· ^ 1) : ℕ → ℕ) := by + simpa [pow_one] using (BigO.refl (fun m : ℕ => m)).const_mul_left 2 + exact BigO.add hn (BigO.const_le_pow 3 1) + +end Cobham + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/HeadFlag.lean b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/HeadFlag.lean new file mode 100644 index 0000000000..ea95361940 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/HeadFlag.lean @@ -0,0 +1,170 @@ +/- +Copyright (c) 2026 Bolton Bailey. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Bolton Bailey +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines + +/-! +# Testing a leading bit — proof internals + +Every other `FP` primitive the Cobham proof uses — `Complexity.takeLen`, +`List.reverse`, `Complexity.pair`, `Cobham.mulUnpair` — fixes its output's +*length* from its inputs' lengths alone, so none of them can react to a bit's +value. `Complexity.headFlag` closes that gap by turning a bit test into a length: +the answer is carried by whether the result is empty. Its two-state transducer +moves off the left-end marker, then emits one bit exactly when the first input +bit matches. + +## Main results + +- `Complexity.headFlag_mem_FP` — the leading-bit test is in `FP` +-/ + + +@[expose] public section + +namespace Complexity + +open Complexity.TM + +/-- `[false]` when `x` begins with `target`, and `[]` otherwise: a bit test whose +answer is carried by the *length* of the result. -/ +def headFlag (target : Bool) (x : List Bool) : List Bool := + if x.head? = some target then [false] else [] + +/-- Control states of the head-bit flag machine. -/ +inductive HeadPhase where + /-- Advance past the left-end markers. -/ + | skip + /-- Read the first input bit. -/ + | test + /-- Halted. -/ + | done + deriving DecidableEq + +instance instFintypeHeadPhase : Fintype HeadPhase where + elems := {.skip, .test, .done} + complete := fun p => by cases p <;> simp + +/-- Read the first input bit and emit one output bit exactly when it is +`target`. Two steps: `skip` moves off the left-end markers, `test` reads the bit +and either writes or not. -/ +def headFlagTM (target : Bool) : TM 0 where + Q := HeadPhase + qstart := .skip + qhalt := .done + δ := fun state iHead wHeads oHead => + match state with + | .skip => + (.test, fun i => readBackWrite (wHeads i), readBackWrite oHead, Dir3.right, + fun i => idleDir (wHeads i), Dir3.right) + | .test => + if iHead = Γ.ofBool target then + (.done, fun i => readBackWrite (wHeads i), Γw.zero, idleDir iHead, + fun i => idleDir (wHeads i), Dir3.right) + else + (.done, fun i => readBackWrite (wHeads i), readBackWrite oHead, + idleDir iHead, fun i => idleDir (wHeads i), idleDir oHead) + | .done => allIdle .done iHead wHeads oHead + δ_right_of_start := by + intro state iHead wHeads oHead + match state with + | .skip => exact ⟨fun _ => rfl, fun _ => idleDir_right_of_start, fun _ => rfl⟩ + | .test => + dsimp only [] + split + · exact ⟨idleDir_right_of_start, fun _ => idleDir_right_of_start, fun _ => rfl⟩ + · exact ⟨idleDir_right_of_start, fun _ => idleDir_right_of_start, + idleDir_right_of_start⟩ + | .done => exact rightOfStart_allIdle iHead wHeads oHead + +/-- Writing back the symbol already under the head changes nothing. -/ +private theorem write_read_self' (t : Tape) : t.write t.read = t := by + rw [Tape.write] + split + · rfl + · exact Tape.ext rfl (Function.update_eq_self _ _) + +/-- The input's first cell after the marker holds the first bit, or blank. -/ +private theorem headFlagTM_read (x : List Bool) : + ((Tape.init (x.map Γ.ofBool)).move Dir3.right).read + = (x.head?).elim Γ.blank Γ.ofBool := by + cases x with + | nil => simp [Tape.read, Tape.move, Tape.init] + | cons a t => cases a <;> simp [Tape.read, Tape.move, Tape.init, Γ.ofBool] + +/-- `headFlagTM target` computes `headFlag target` in two steps. -/ +theorem headFlagTM_computesInTime (target : Bool) : + (headFlagTM target).ComputesInTime (headFlag target) (fun _ => 2) := by + intro x + let c1 : Cfg 0 (headFlagTM target).Q := + { state := HeadPhase.test + input := (Tape.init (x.map Γ.ofBool)).move Dir3.right + work := fun _ => (Tape.init []).writeAndMove + (readBackWrite (Tape.init []).read) (idleDir (Tape.init []).read) + output := (Tape.init []).move Dir3.right } + have hstep1 : (headFlagTM target).step ((headFlagTM target).initCfg x) = some c1 := by + simp [TM.step, headFlagTM, c1, Tape.read, Tape.init, idleDir, Tape.writeAndMove, + Tape.write, Tape.move] + have hread : c1.input.read = (x.head?).elim Γ.blank Γ.ofBool := + headFlagTM_read x + by_cases hb : x.head? = some target + · -- The bit matches: one output cell is written. + have hri : c1.input.read = Γ.ofBool target := by rw [hread, hb]; rfl + let c2 : Cfg 0 (headFlagTM target).Q := + { state := HeadPhase.done + input := c1.input.move (idleDir c1.input.read) + work := fun i => (c1.work i).writeAndMove + (readBackWrite (c1.work i).read) (idleDir (c1.work i).read) + output := c1.output.writeAndMove Γw.zero.toΓ Dir3.right } + have hstep2 : (headFlagTM target).step c1 = some c2 := by + simp [TM.step, headFlagTM, c1, c2, hri] + refine ⟨c2, 2, le_rfl, .step hstep1 (.step hstep2 .zero), rfl, ?_⟩ + rw [headFlag, if_pos hb] + refine ⟨fun i hi => ?_, ?_⟩ + · have hi0 : i = 0 := by simpa using hi + subst hi0 + simp [c2, c1, Tape.write, Tape.move, Tape.init, Γw.toΓ, Γ.ofBool] + · simp [c2, c1, Tape.write, Tape.move, Tape.init, Γw.toΓ] + · -- The bit does not match: nothing is written. + have hri : c1.input.read ≠ Γ.ofBool target := by + rw [hread] + cases hx : x.head? with + | none => cases target <;> simp [Γ.ofBool] + | some a => + rw [hx] at hb + simp only [Option.elim] + cases a <;> cases target <;> simp_all [Γ.ofBool] + let c2 : Cfg 0 (headFlagTM target).Q := + { state := HeadPhase.done + input := c1.input.move (idleDir c1.input.read) + work := fun i => (c1.work i).writeAndMove + (readBackWrite (c1.work i).read) (idleDir (c1.work i).read) + output := c1.output.writeAndMove (readBackWrite c1.output.read).toΓ + (idleDir c1.output.read) } + have hstep2 : (headFlagTM target).step c1 = some c2 := by + simp [TM.step, headFlagTM, c1, c2, hri] + refine ⟨c2, 2, le_rfl, .step hstep1 (.step hstep2 .zero), rfl, ?_⟩ + rw [headFlag, if_neg hb] + refine ⟨fun i hi => by simp at hi, ?_⟩ + have hoc : c1.output.read = Γ.blank := by + simp [c1, Tape.read, Tape.move, Tape.init] + have hcells : c2.output.cells = c1.output.cells := by + show ((c1.output.write ((readBackWrite c1.output.read).toΓ)).move + (idleDir c1.output.read)).cells = c1.output.cells + rw [Tape.move_cells, + show (readBackWrite c1.output.read).toΓ = c1.output.read from by rw [hoc]; rfl, + write_read_self'] + rw [hcells] + simp [c1, Tape.move, Tape.init] + +/-- **A bit test, as a length.** -/ +theorem headFlag_mem_FP (target : Bool) : headFlag target ∈ FP := + ⟨1, 0, headFlagTM target, (fun _ => 2), headFlagTM_computesInTime target, + BigO.const_le_pow 2 1⟩ + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/Iterate.lean b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/Iterate.lean new file mode 100644 index 0000000000..5597b54b17 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/Iterate.lean @@ -0,0 +1,966 @@ +/- +Copyright (c) 2026 Bolton Bailey. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Bolton Bailey +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Asymptotics.PolyBound +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.IterateLayout +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Registers.Horner +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Registers.InputLen +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.PairEmit +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.NormalForm + +/-! +# The bounded-iteration machine — proof internals + +`Complexity.Cobham.iterate_mem_FP` needs one machine: given a polynomial-time +`G`, a machine that applies `G` to its own input `|x|` times. This file builds +it out of the phase contracts of +`Complexitylib.Classes.P.Cobham.Internal.IterateLayout`. + +## Layout + +Three bookkeeping tapes (`rfIdx` the loop's fuel register, `wfIdx` the reset's +fuel register, `junkIdx` scratch for the register arithmetic) followed by +`TM.applyTM`'s own block (`appIdx`), whose virtual input `vinIdx` carries the +running value and whose last tape `resIdx` receives each result. + +## Phases + +* `Complexity.iterTail` — the five phases that follow every application: park, + rewind the result, blank the scratch, move the result into virtual-input + position, blank the result tape. Shared by the loop body and the setup. +* `Complexity.iterBody` — one application of the iterated function followed by + the tail; this is what the loop iterates. +* `Complexity.iterSetup` — bump, load `|x|` into the loop register, evaluate a + padding polynomial into the reset register, put `pair [] x` on the result + tape, then the tail. +* `Complexity.iterTM` — setup, loop, and one final application whose output is + the real output tape. +-/ + + +public section + +namespace Complexity + +open Complexity.TM + +variable {k : ℕ} + +/-! ## A confinement frame for an arbitrary bounded run + +Resetting the scratch of an opaque machine needs to know how far its heads can +have travelled. Any `b`-step run from tapes parked at cell `1` and blank beyond +it stays inside cell `1 + b`. -/ + +/-- **Every bounded run is confined.** From work tapes parked at cell `1` whose +content is confined to cell `1`, a `b`-step run leaves every work tape inside +`H` and blank beyond `H`. -/ +theorem hoareTime_confined {n : ℕ} {tm : TM n} {pre post : TapePred n} {b : ℕ} + (h : tm.HoareTime pre post b) (W : Fin n → Tape) (H : ℕ) (hH : 1 + b ≤ H) + (S : Fin n → Prop) (hWSI : ∀ i, Tape.StartInvariant (W i)) + (hWh : ∀ i, S i → (W i).head = 1) + (hWfar : ∀ i, S i → ∀ j, 1 < j → (W i).cells j = Γ.blank) : + tm.HoareTime + (fun inp work out => pre inp work out ∧ work = W ∧ + Tape.StartInvariant inp ∧ Tape.StartInvariant out) + (fun inp work out => post inp work out ∧ Tape.StartInvariant inp ∧ + Tape.StartInvariant out ∧ + ∀ i, Tape.StartInvariant (work i) ∧ (S i → + (work i).head ≤ H ∧ ∀ j, H < j → (work i).cells j = Γ.blank)) + b := by + rintro inp work out ⟨hpre, rfl, hinpSI, houtSI⟩ + obtain ⟨c', t, ht, hreach, hhalt, hpost⟩ := h inp work out hpre + have hSI := TM.reachesIn_startInvariant hreach hinpSI hWSI houtSI + refine ⟨c', t, ht, hreach, hhalt, hpost, hSI.1, hSI.2.2, + fun i => ⟨hSI.2.1 i, fun hSi => ⟨?_, fun j hj => ?_⟩⟩⟩ + · have hh := (head_le_start_add_of_reachesIn tm hreach).2.2 i + rw [show ((⟨tm.qstart, inp, work, out⟩ : Cfg n tm.Q).work i).head = 1 from hWh i hSi] at hh + omega + · rw [TM.reachesIn_work_cells_far hreach i j (by rw [show + ((⟨tm.qstart, inp, work, out⟩ : Cfg n tm.Q).work i).head = 1 from hWh i hSi]; omega)] + exact hWfar i hSi j (by omega) + +/-! ## The shared tail + +Every application of the iterated function — the loop body's, and the setup's +`pair [] x` — leaves its result on `resIdx` with the scratch dirty. The five +phases below restore the entry shape `TM.applyPre` demands. -/ + +/-- Park, rewind the result, blank the witness machine's scratch and the +virtual input, move the result into virtual-input position, blank the result +tape. -/ +def iterTail (k : ℕ) : TM (3 + (k + 2) + 0) := + seqTM + (seqTM (seqTM skipTM (rewindWorkTM resIdx)) (resetTapesTM (resetTargets k) wfIdx)) + (seqTM (copyToVirtualInputTM resIdx vinIdx) (resetTapesTM (resetResult k) wfIdx)) + +/-- `Complexity.iterTail`'s time bound. -/ +def tailBound (k H m : ℕ) : ℕ := + 1 + 1 + (H + 1 + 2) + 1 + + ((k + 1) * (H + 4) + H * 4 + 8 + 1 + ((k + 1) * (H + 4) + 1)) + 1 + + (2 * m + 5 + 1 + (1 * (H + 4) + H * 4 + 8 + 1 + (1 * (H + 4) + 1))) + +theorem startInvariant_regTape (H : ℕ) : Tape.StartInvariant (regTape H) := + ⟨by rw [regT_cells]; simp [regCells], (parked_regTape H).2⟩ + +/-- **The tail's contract.** From a result tape carrying `v` and a block whose +tapes are confined to `1 … H`, the five phases rebuild `TM.applyPre M v`. -/ +theorem iterTail_hoareTime (M : TM k) (H : ℕ) (v : List Bool) (hv : v.length + 1 ≤ H) + (inp₀ : Tape) (hinpP : Parked inp₀) (hinpSI : Tape.StartInvariant inp₀) + (rfT junkT : Tape) (hrfP : Parked rfT) (hrfSI : Tape.StartInvariant rfT) + (hjunkP : Parked junkT) (hjunkSI : Tape.StartInvariant junkT) : + (iterTail k).HoareTime + (fun inp work out => inp = inp₀ ∧ out = parkedBlank ∧ + (work resIdx).HasOutput v ∧ + (∀ j : Fin (k + 2), Tape.StartInvariant (work (appIdx j)) ∧ + (work (appIdx j)).head ≤ H ∧ + ∀ c, H < c → (work (appIdx j)).cells c = Γ.blank) ∧ + work rfIdx = rfT ∧ work wfIdx = regTape H ∧ work junkIdx = junkT) + (fun inp work out => inp = inp₀ ∧ out = parkedBlank ∧ + work rfIdx = rfT ∧ work junkIdx = junkT ∧ work wfIdx = regTape H ∧ + (∀ j, work (appIdx j) = TM.applyPre M v inp₀ j)) + (tailBound k H v.length) := by + intro inp work out hpre + obtain ⟨hi, ho, hres, hbnd, hrf, hwf, hjunk⟩ := hpre + subst hi + subst ho + have houtP : Parked parkedBlank := parked_parkedBlank + have houtSI : Tape.StartInvariant parkedBlank := startInvariant_initNil.move Dir3.right + have hregSI : Tape.StartInvariant (regTape H) := startInvariant_regTape H + have hSI : ∀ i, Tape.StartInvariant (work i) := by + intro i + rcases layout_cases i with h | h | h | ⟨j, h⟩ + · rw [h, hrf]; exact hrfSI + · rw [h, hwf]; exact hregSI + · rw [h, hjunk]; exact hjunkSI + · rw [h]; exact (hbnd j).1 + -- the three phase contracts, instantiated at the actual tape family + have hpark := iterPark_hoareTime H inp hinpP hinpSI work hSI (hbnd (Fin.last (k + 1))).2.1 + have hrst := iterResetScratch_hoareTime H (by omega) inp hinpP hinpSI work hSI + (fun j => (hbnd (Fin.castSucc j)).2.1) + (fun j c hc => (hbnd (Fin.castSucc j)).2.2 c hc) hwf + have hrfeq : (⟨max (work rfIdx).head 1, (work rfIdx).cells⟩ : Tape) = rfT := by + rw [hrf] + exact Tape.ext (by show max rfT.head 1 = rfT.head; have := hrfP.1; omega) rfl + have hjunkeq : (⟨max (work junkIdx).head 1, (work junkIdx).cells⟩ : Tape) = junkT := by + rw [hjunk] + exact Tape.ext (by show max junkT.head 1 = junkT.head; have := hjunkP.1; omega) rfl + have hfin := iterFinish_hoareTime M H v hv inp hinpP hinpSI + (⟨1, (work resIdx).cells⟩ : Tape) rfT junkT rfl + ((Tape.hasOutput_congr rfl v).mp hres) + ⟨(hbnd (Fin.last (k + 1))).1.1, fun c hc => (hbnd (Fin.last (k + 1))).1.2 c hc⟩ + (fun c hc => (hbnd (Fin.last (k + 1))).2.2 c hc) + hrfP hrfSI hjunkP hjunkSI + -- chain the three, converting the seams through the parked frame + have hAB := seqTM_hoareTime _ _ hpark (by + rintro inp' work' out' ⟨rfl, rfl, e3, e4, e5⟩ + have hP : ∀ i, Parked (work' i) := by + intro i + by_cases hir : i = resIdx + · exact ⟨by rw [hir, e3], fun c hc => by rw [hir, e4]; exact (hSI resIdx).2 c hc⟩ + · rw [e5 i hir] + exact ⟨le_max_right _ _, fun c hc => (hSI i).2 c hc⟩ + obtain ⟨t1, t2, t3⟩ := parked_transition hinpP hP houtP + rw [t1, t2, t3] + exact ⟨rfl, rfl, e3, e4, e5⟩) hrst + have hABC := seqTM_hoareTime _ _ hAB (by + rintro inp' work' out' ⟨rfl, rfl, e3, e4, e5, e6, e7, e8⟩ + have hP : ∀ i, Parked (work' i) := by + intro i + by_cases hir : i = resIdx + · exact ⟨by rw [hir, e3], fun c hc => by rw [hir, e4]; exact (hSI resIdx).2 c hc⟩ + · rcases layout_cases i with h | h | h | ⟨j, h⟩ + · rw [h, e7, hrfeq]; exact hrfP + · rw [h, e6]; exact parked_regTape H + · rw [h, e8, hjunkeq]; exact hjunkP + · by_cases hjl : j = Fin.last (k + 1) + · exact absurd (by rw [h, hjl]; rfl) hir + · have hjv : j.val < k + 1 := + lt_of_le_of_ne (Nat.lt_succ_iff.mp j.isLt) (fun hc => hjl (Fin.ext hc)) + rw [h, show j = Fin.castSucc (⟨j.val, hjv⟩ : Fin (k + 1)) from Fin.ext rfl, + e5 ⟨j.val, hjv⟩] + exact houtP + obtain ⟨t1, t2, t3⟩ := parked_transition hinpP hP houtP + rw [t1, t2, t3] + exact ⟨rfl, rfl, Tape.ext e3 e4, e7.trans hrfeq, e8.trans hjunkeq, e6, e5⟩) hfin + exact hABC inp work parkedBlank ⟨rfl, rfl, rfl⟩ + +/-! ## One iteration + +The loop body is one application of the iterated function followed by the +tail. -/ + +/-- One combinator seam on a tape satisfying the left-marker invariant: the +cells are untouched and the head only ever bounces off `▷`. -/ +theorem transitionTape_of_startInvariant {t : Tape} (h : Tape.StartInvariant t) : + transitionTape t = (⟨max t.head 1, t.cells⟩ : Tape) := by + by_cases hh : t.read = Γ.start + · have hh0 : t.head = 0 := by + by_contra hc + exact (h.2 t.head (by omega)) hh + refine Tape.ext ?_ (transitionTape_cells t (fun j hj => h.2 j hj)) + have h1 := one_le_head_transitionTape t h.1 + have h2 := head_transitionTape_le (p_bound := 0) h.1 (le_of_eq hh0) + show (transitionTape t).head = max t.head 1 + omega + · rw [transitionTape_eq_self hh] + have hh0 : t.head ≠ 0 := fun hc => hh (by rw [Tape.read, hc]; exact h.1) + exact Tape.ext (by show t.head = max t.head 1; omega) rfl + +/-- The three bookkeeping tapes, packaged as a placement frame. -/ +def bookTapes (rfT junkT : Tape) (H : ℕ) : Fin (3 + (k + 2) + 0) → Tape := + fun i => if i = rfIdx then rfT else if i = wfIdx then regTape H else junkT + +@[simp] theorem bookTapes_rf (rfT junkT : Tape) (H : ℕ) : + bookTapes (k := k) rfT junkT H rfIdx = rfT := by + rw [bookTapes, if_pos rfl] + +@[simp] theorem bookTapes_wf (rfT junkT : Tape) (H : ℕ) : + bookTapes (k := k) rfT junkT H wfIdx = regTape H := by + rw [bookTapes, if_neg (fun h => rfIdx_ne_wfIdx h.symm), if_pos rfl] + +@[simp] theorem bookTapes_junk (rfT junkT : Tape) (H : ℕ) : + bookTapes (k := k) rfT junkT H junkIdx = junkT := by + rw [bookTapes, if_neg junkIdx_ne_rfIdx, if_neg junkIdx_ne_wfIdx] + +theorem eq_bookTapes_of_not_middle {work : Fin (3 + (k + 2) + 0) → Tape} + {rfT junkT : Tape} {H : ℕ} + (hrf : work rfIdx = rfT) (hwf : work wfIdx = regTape H) (hjunk : work junkIdx = junkT) : + ∀ i, ¬ placeWorkInMiddle 3 (k + 2) i → work i = bookTapes rfT junkT H i := by + intro i hi + rcases layout_cases i with h | h | h | ⟨j, h⟩ + · rw [h, hrf, bookTapes_rf] + · rw [h, hwf, bookTapes_wf] + · rw [h, hjunk, bookTapes_junk] + · exact absurd (h ▸ appIdx_middle j) hi + +theorem bookTapes_startInvariant {rfT junkT : Tape} {H : ℕ} + (hrfSI : Tape.StartInvariant rfT) (hjunkSI : Tape.StartInvariant junkT) : + ∀ i, ¬ placeWorkInMiddle 3 (k + 2) i → Tape.StartInvariant (bookTapes rfT junkT H i) := by + intro i hi + rcases layout_cases i with h | h | h | ⟨j, h⟩ + · rw [h, bookTapes_rf]; exact hrfSI + · rw [h, bookTapes_wf]; exact startInvariant_regTape H + · rw [h, bookTapes_junk]; exact hjunkSI + · exact absurd (h ▸ appIdx_middle j) hi + +theorem bookTapes_head {rfT junkT : Tape} {H : ℕ} + (hrfP : Parked rfT) (hjunkP : Parked junkT) : + ∀ i, ¬ placeWorkInMiddle 3 (k + 2) i → 1 ≤ (bookTapes rfT junkT H i).head := by + intro i hi + rcases layout_cases i with h | h | h | ⟨j, h⟩ + · rw [h, bookTapes_rf]; exact hrfP.1 + · rw [h, bookTapes_wf]; exact (parked_regTape H).1 + · rw [h, bookTapes_junk]; exact hjunkP.1 + · exact absurd (h ▸ appIdx_middle j) hi + +/-- The loop body: apply the iterated function once, then restore the entry +shape. -/ +def iterBody (M : TM k) : TM (3 + (k + 2) + 0) := + seqTM (placeWorkTM 3 0 (TM.applyTM M)) (iterTail k) + +/-- **The body's contract.** From the entry shape for `y`, the body reaches the +entry shape for `G y`, holding both registers and the junk tape fixed. -/ +theorem iterBody_hoareTime (M : TM k) {G : List Bool → List Bool} {T : ℕ → ℕ} + (hcomp : M.ComputesInTime G T) (H : ℕ) (y : List Bool) + (hHy : y.length ≤ H) (hHT : 1 + T y.length ≤ H) (hGy : (G y).length + 1 ≤ H) + (inp₀ : Tape) (hinpP : Parked inp₀) (hinpSI : Tape.StartInvariant inp₀) + (rfT junkT : Tape) (hrfP : Parked rfT) (hrfSI : Tape.StartInvariant rfT) + (hjunkP : Parked junkT) (hjunkSI : Tape.StartInvariant junkT) : + (iterBody M).HoareTime + (fun inp work out => inp = inp₀ ∧ out = parkedBlank ∧ + (∀ j, work (appIdx j) = TM.applyPre M y inp₀ j) ∧ + work rfIdx = rfT ∧ work wfIdx = regTape H ∧ work junkIdx = junkT) + (fun inp work out => inp = inp₀ ∧ out = parkedBlank ∧ + work rfIdx = rfT ∧ work junkIdx = junkT ∧ work wfIdx = regTape H ∧ + (∀ j, work (appIdx j) = TM.applyPre M (G y) inp₀ j)) + (T y.length + 1 + tailBound k H (G y).length) := by + have happ := placedApply_hoareTime M hcomp y inp₀ hinpP hinpSI H hHy hHT + (bookTapes rfT junkT H) (bookTapes_startInvariant hrfSI hjunkSI) + (bookTapes_head hrfP hjunkP) + refine seqTM_hoareTime _ _ (happ.weaken_pre ?_) ?_ + (iterTail_hoareTime M H (G y) hGy inp₀ hinpP hinpSI rfT junkT hrfP hrfSI hjunkP hjunkSI) + · rintro inp work out ⟨hi, ho, happ', hrf, hwf, hjunk⟩ + exact ⟨hi, happ', eq_bookTapes_of_not_middle hrf hwf hjunk, ho⟩ + · rintro inp work out ⟨rfl, rfl, hres, hbnd, hext⟩ + dsimp only + have hrfe : work rfIdx = rfT := by + rw [hext rfIdx rfIdx_not_middle, bookTapes_rf] + have hwfe : work wfIdx = regTape H := by + rw [hext wfIdx wfIdx_not_middle, bookTapes_wf] + have hjunke : work junkIdx = junkT := by + rw [hext junkIdx junkIdx_not_middle, bookTapes_junk] + have hSIall : ∀ i, Tape.StartInvariant (work i) := by + intro i + rcases layout_cases i with h | h | h | ⟨j, h⟩ + · rw [h, hrfe]; exact hrfSI + · rw [h, hwfe]; exact startInvariant_regTape H + · rw [h, hjunke]; exact hjunkSI + · rw [h]; exact (hbnd j).1 + have htin : transitionInput inp = inp := transitionInput_eq_self hinpP.read_ne_start + have htout : transitionTape parkedBlank = parkedBlank := + transitionTape_eq_self parked_parkedBlank.read_ne_start + have hcells : ∀ i, (transitionTape (work i)).cells = (work i).cells := fun i => + transitionTape_cells _ (fun j hj => (hSIall i).2 j hj) + refine ⟨htin, htout, ?_, fun j => ⟨?_, ?_, ?_⟩, ?_, ?_, ?_⟩ + · exact (Tape.hasOutput_congr (hcells resIdx).symm (G y)).mp hres + · exact ⟨(hcells (appIdx j)) ▸ (hbnd j).1.1, + fun c hc => (hcells (appIdx j)) ▸ (hbnd j).1.2 c hc⟩ + · rw [transitionTape_of_startInvariant (hSIall (appIdx j))] + show max (work (appIdx j)).head 1 ≤ H + have := (hbnd j).2.1 + omega + · intro c hc + rw [hcells (appIdx j)] + exact (hbnd j).2.2 c hc + · rw [hrfe, transitionTape_eq_self hrfP.read_ne_start] + · rw [hwfe, transitionTape_eq_self (parked_regTape H).read_ne_start] + · rw [hjunke, transitionTape_eq_self hjunkP.read_ne_start] + +/-! ## The loop + +`TM.forRegTM` drives the body once per mark of the fuel register `rfIdx`, +threading the iteration-indexed ghost family below. -/ + +/-- The whole tape family at iteration `i`: the entry shape for the `i`-th +iterate on `TM.applyTM`'s block, the two registers, and the junk tape. -/ +def iterFamily (M : TM k) (Y : ℕ → List Bool) (inp₀ junkT : Tape) (v H : ℕ) : + ℕ → Fin (3 + (k + 2) + 0) → Tape := + fun i j => if hj : placeWorkInMiddle 3 (k + 2) j + then TM.applyPre M (Y i) inp₀ (placeWorkCoord 3 (k + 2) j hj) + else bookTapes (regTape v) junkT H j + +variable {M : TM k} {Y : ℕ → List Bool} {inp₀ junkT : Tape} {v H : ℕ} + +@[simp] theorem iterFamily_app (i : ℕ) (j : Fin (k + 2)) : + iterFamily M Y inp₀ junkT v H i (appIdx j) = TM.applyPre M (Y i) inp₀ j := by + rw [iterFamily] + rw [dif_pos (appIdx_middle j)] + congr 1 + exact placeWorkCoord_placeWorkIdx 3 0 j + +theorem iterFamily_book (i : ℕ) (j : Fin (3 + (k + 2) + 0)) + (hj : ¬ placeWorkInMiddle 3 (k + 2) j) : + iterFamily M Y inp₀ junkT v H i j = bookTapes (regTape v) junkT H j := by + rw [iterFamily, dif_neg hj] + +@[simp] theorem iterFamily_rf (i : ℕ) : + iterFamily M Y inp₀ junkT v H i rfIdx = regTape v := by + rw [iterFamily_book i rfIdx rfIdx_not_middle, bookTapes_rf] + +@[simp] theorem iterFamily_wf (i : ℕ) : + iterFamily M Y inp₀ junkT v H i wfIdx = regTape H := by + rw [iterFamily_book i wfIdx wfIdx_not_middle, bookTapes_wf] + +@[simp] theorem iterFamily_junk (i : ℕ) : + iterFamily M Y inp₀ junkT v H i junkIdx = junkT := by + rw [iterFamily_book i junkIdx junkIdx_not_middle, bookTapes_junk] + +theorem iterFamily_parked (hjunkP : Parked junkT) (i : ℕ) (j : Fin (3 + (k + 2) + 0)) + (hj : j ≠ rfIdx) : Parked (iterFamily M Y inp₀ junkT v H i j) := by + rcases layout_cases j with h | h | h | ⟨jj, h⟩ + · exact absurd h hj + · rw [h, iterFamily_wf]; exact parked_regTape H + · rw [h, iterFamily_junk]; exact hjunkP + · rw [h, iterFamily_app] + exact ⟨le_of_eq (TM.applyPre_head M (Y i) inp₀ jj).symm, + fun c hc => (TM.applyPre_startInvariant M (Y i) inp₀ jj).2 c hc⟩ + +/-- **The loop's contract.** `v` applications of the iterated function, each +returning the block to its entry shape. -/ +theorem iterLoop_hoareTime {G : List Bool → List Bool} {T : ℕ → ℕ} + (hcomp : M.ComputesInTime G T) + (hY : ∀ i, Y (i + 1) = G (Y i)) + (hlen : ∀ i, i ≤ v → (Y i).length + 1 ≤ H) + (hT : ∀ i, i < v → 1 + T (Y i).length ≤ H) + (b_iter : ℕ) + (hb : ∀ i, i < v → T (Y i).length + 1 + tailBound k H (Y (i + 1)).length ≤ b_iter) + (hinpP : Parked inp₀) (hinpSI : Tape.StartInvariant inp₀) + (hjunkP : Parked junkT) (hjunkSI : Tape.StartInvariant junkT) : + (forRegTM (iterBody M) rfIdx).HoareTime + (EmitPred inp₀ (iterFamily M Y inp₀ junkT v H 0) []) + (EmitPred inp₀ (iterFamily M Y inp₀ junkT v H v) []) + (v * (b_iter + 2) + (v + 2)) := by + refine forRegTM_hoareTime (iterBody M) rfIdx v inp₀ (iterFamily M Y inp₀ junkT v H) + (fun _ => []) b_iter hinpP (fun i => iterFamily_rf i) + (fun i j hj => iterFamily_parked hjunkP i j hj) (fun i hi => ?_) + have hrfP : Parked (⟨i + 2, regCells v⟩ : Tape) := regIterCells_parked v i + have hrfSI : Tape.StartInvariant (⟨i + 2, regCells v⟩ : Tape) := + ⟨(startInvariant_regTape v).1, hrfP.2⟩ + have hbody := iterBody_hoareTime M hcomp H (Y i) + (by have := hlen i (by omega); omega) (hT i hi) + (by rw [← hY i]; exact hlen (i + 1) (by omega)) + inp₀ hinpP hinpSI (⟨i + 2, regCells v⟩ : Tape) junkT hrfP hrfSI hjunkP hjunkSI + refine ((hbody.weaken_pre ?_).strengthen_post ?_).mono_bound ?_ + · rintro inp work out ⟨hi', hw, hout⟩ + refine ⟨hi', eq_parkedBlank_of_outAcc_nil hout, fun j => ?_, ?_, ?_, ?_⟩ + · rw [hw, Function.update_of_ne (fun h => rfIdx_ne_appIdx j h.symm), iterFamily_app] + · rw [hw, Function.update_self] + · rw [hw, Function.update_of_ne rfIdx_ne_wfIdx.symm, iterFamily_wf] + · rw [hw, Function.update_of_ne junkIdx_ne_rfIdx, iterFamily_junk] + · rintro inp work out ⟨hi', hout, hrf, hjunk, hwf, happ⟩ + refine ⟨hi', funext fun j => ?_, ?_⟩ + · rcases layout_cases j with h | h | h | ⟨jj, h⟩ + · rw [h, hrf, Function.update_self] + · rw [h, hwf, Function.update_of_ne rfIdx_ne_wfIdx.symm, iterFamily_wf] + · rw [h, hjunk, Function.update_of_ne junkIdx_ne_rfIdx, iterFamily_junk] + · rw [h, happ jj, Function.update_of_ne (fun hc => rfIdx_ne_appIdx jj hc.symm), + iterFamily_app, hY i] + · rw [hout] + exact outAcc_nil_of_parkedBlank + · rw [← hY i] + exact hb i hi + +/-! ## The setup + +Bump, load `|x|` into the loop register, evaluate the padding polynomial into +the reset register, and put `pair [] x` on the result tape. -/ + +@[simp] theorem parkedBlank_head : parkedBlank.head = 1 := rfl + +theorem parkedBlank_cells (j : ℕ) : + parkedBlank.cells j = if j = 0 then Γ.start else Γ.blank := by + show ((Tape.init ([] : List Γ)).move Dir3.right).cells j = _ + rw [Tape.move_cells, initNil_cells] + +theorem hasOutput_nil_parkedBlank : parkedBlank.HasOutput [] := + ⟨fun i hi => absurd hi (Nat.not_lt_zero i), by simp [parkedBlank_cells]⟩ + +/-- The tape family the emission phase starts from: `TM.applyTM`'s block blank, +the bookkeeping tapes as given. -/ +def emitStart (extras : Fin (3 + (k + 2) + 0) → Tape) : Fin (3 + (k + 2) + 0) → Tape := + fun i => if placeWorkInMiddle 3 (k + 2) i then parkedBlank else extras i + +theorem emitStart_middle (extras : Fin (3 + (k + 2) + 0) → Tape) (j : Fin (k + 2)) : + emitStart extras (appIdx j) = parkedBlank := by + rw [emitStart, if_pos (appIdx_middle j)] + +theorem emitStart_extra (extras : Fin (3 + (k + 2) + 0) → Tape) + (i : Fin (3 + (k + 2) + 0)) (hi : ¬ placeWorkInMiddle 3 (k + 2) i) : + emitStart extras i = extras i := by + rw [emitStart, if_neg hi] + +/-- **The setup's emission phase.** From the bumped input holding `x` and an +all-blank block, `pair [] x` lands on the result tape and the whole block stays +inside `H`. -/ +theorem placedEmit_hoareTime (x : List Bool) (H : ℕ) (hH : x.length + 4 ≤ H) + (extras : Fin (3 + (k + 2) + 0) → Tape) + (hextraSI : ∀ i, ¬ placeWorkInMiddle 3 (k + 2) i → Tape.StartInvariant (extras i)) + (hextraH : ∀ i, ¬ placeWorkInMiddle 3 (k + 2) i → 1 ≤ (extras i).head) : + (placeWorkTM 3 0 (TM.retargetOutput (TM.pairInputWorkTM (Fin.last k)))).HoareTime + (fun inp work out => inp = (Tape.init (x.map Γ.ofBool)).move Dir3.right ∧ + out = parkedBlank ∧ work = emitStart extras) + (fun inp work out => Tape.StartInvariant inp ∧ out = parkedBlank ∧ + (work resIdx).HasOutput (pair [] x) ∧ + (∀ j : Fin (k + 2), Tape.StartInvariant (work (appIdx j)) ∧ + (work (appIdx j)).head ≤ H ∧ + ∀ c, H < c → (work (appIdx j)).cells c = Γ.blank) ∧ + (∀ i, ¬ placeWorkInMiddle 3 (k + 2) i → work i = extras i)) + (x.length + 3) := by + have hblankSI : Tape.StartInvariant parkedBlank := startInvariant_initNil.move Dir3.right + have hplaced := TM.placeWorkTM_hoareTime_frame (pre := 3) (post := 0) + (TM.retargetOutput (TM.pairInputWorkTM (Fin.last k))) + (TM.retargetOutput_hoareTime _ (TM.pairInputWorkTM_hoareTime (Fin.last k) [] x)) + extras hextraSI hextraH + have hconf := hoareTime_confined hplaced (emitStart extras) H + (by simp only [TM.pairInputWorkTime, List.length_nil]; omega) + (placeWorkInMiddle 3 (k + 2)) + (fun i => by + by_cases hi : placeWorkInMiddle 3 (k + 2) i + · rw [emitStart, if_pos hi]; exact hblankSI + · rw [emitStart, if_neg hi]; exact hextraSI i hi) + (fun i hi => by rw [emitStart, if_pos hi, parkedBlank_head]) + (fun i hi j hj => by + rw [emitStart, if_pos hi] + show ((Tape.init ([] : List Γ)).move Dir3.right).cells j = Γ.blank + rw [Tape.move_cells, initNil_cells, if_neg (by omega)]) + refine ((hconf.weaken_pre ?_).strengthen_post ?_).mono_bound + (by simp only [TM.pairInputWorkTime, List.length_nil]; omega) + · rintro inp work out ⟨rfl, rfl, rfl⟩ + refine ⟨⟨⟨⟨rfl, ?_, ?_, ?_, ?_⟩, rfl⟩, + fun i hi => emitStart_extra extras i hi⟩, rfl, + (startInvariant_initOfBool x).move Dir3.right, hblankSI⟩ + · show (emitStart extras (appIdx (Fin.castSucc (Fin.last k)))).head = 1 + rw [emitStart_middle, parkedBlank_head] + · show (emitStart extras (appIdx (Fin.castSucc (Fin.last k)))).HasOutput [] + rw [emitStart_middle] + exact hasOutput_nil_parkedBlank + · intro i + show Tape.StartInvariant (emitStart extras (appIdx (Fin.castSucc i))) ∧ + 1 ≤ (emitStart extras (appIdx (Fin.castSucc i))).head + rw [emitStart_middle] + exact ⟨hblankSI, le_refl 1⟩ + · show emitStart extras (appIdx (Fin.last (k + 1))) = (Tape.init []).move Dir3.right + rw [emitStart_middle] + rfl + · rintro inp work out ⟨⟨⟨hout, ho⟩, hext⟩, hinpSI, -, hconf'⟩ + exact ⟨hinpSI, ho, hout, fun j => ⟨(hconf' (appIdx j)).1, + ((hconf' (appIdx j)).2 (appIdx_middle j)).1, + ((hconf' (appIdx j)).2 (appIdx_middle j)).2⟩, hext⟩ + +theorem parkedBlank_eq_regTape_zero : parkedBlank = regTape 0 := by + refine Tape.ext rfl (funext fun j => ?_) + rw [parkedBlank_cells, regT_cells] + show _ = regCells 0 j + rw [regCells] + by_cases hj : j = 0 + · rw [if_pos hj, if_pos hj] + · rw [if_neg hj, if_neg hj, if_neg (by omega)] + +/-- The register value cap the padding polynomial's evaluation runs under. -/ +def polyM (p : Polynomial ℕ) (n : ℕ) : ℕ := + ((polyCoeffs p).sum + 1) * (n + 1) ^ (polyCoeffs p).length + n + p.eval n + +/-- The setup machine: bump every head off cell `0`, load `|x|` into the loop +register, evaluate the padding polynomial into the reset register, and emit +`pair [] x` onto the result tape. -/ +def iterSetup (k : ℕ) (p : Polynomial ℕ) : TM (3 + (k + 2) + 0) := + seqTM (seqTM (seqTM skipTM (inputLenRegTM rfIdx)) (polyEvalTM rfIdx wfIdx junkIdx p)) + (placeWorkTM 3 0 (TM.retargetOutput (TM.pairInputWorkTM (Fin.last k)))) + +/-- `Complexity.iterSetup`'s time bound. -/ +def setupBound (p : Polynomial ℕ) (n : ℕ) : ℕ := + 1 + 1 + (2 * n + 4) + 1 + + (opBudget (polyM p n) + 1 + ((p.natDegree + 1) * (layerBudget (polyM p n) + 1) + 1)) + + 1 + (n + 3) + +theorem iterSetup_hoareTime (p : Polynomial ℕ) (x : List Bool) (H : ℕ) + (hH : H = p.eval x.length) (hHx : x.length + 4 ≤ H) : + (iterSetup k p).HoareTime + (fun inp work out => inp = Tape.init (x.map Γ.ofBool) ∧ + work = (fun _ => Tape.init []) ∧ out = Tape.init []) + (fun inp work out => Tape.StartInvariant inp ∧ out = parkedBlank ∧ + (work resIdx).HasOutput (pair [] x) ∧ + (∀ j : Fin (k + 2), Tape.StartInvariant (work (appIdx j)) ∧ + (work (appIdx j)).head ≤ H ∧ + ∀ c, H < c → (work (appIdx j)).cells c = Γ.blank) ∧ + work rfIdx = regTape x.length ∧ work wfIdx = regTape H ∧ work junkIdx = regTape H) + (setupBound p x.length) := by + set inpx : Tape := ⟨1, (Tape.init (x.map Γ.ofBool)).cells⟩ with hinpx + have hinpxP : Parked inpx := + ⟨le_refl 1, fun j hj => (startInvariant_initOfBool x).2 j hj⟩ + have hblankSI : Tape.StartInvariant parkedBlank := startInvariant_initNil.move Dir3.right + set W₀ : Fin (3 + (k + 2) + 0) → Tape := fun _ => parkedBlank with hW₀ + have hW₀P : ∀ i, Parked (W₀ i) := fun _ => parked_parkedBlank + -- phase 1: bump + have hA : (skipTM (n := 3 + (k + 2) + 0)).HoareTime + (fun inp work out => inp = Tape.init (x.map Γ.ofBool) ∧ + work = (fun _ => Tape.init []) ∧ out = Tape.init []) + (EmitPred inpx W₀ []) 1 := by + refine (parkAll_hoareTime (Tape.init (x.map Γ.ofBool)) (fun _ => Tape.init []) + (Tape.init []) (startInvariant_initOfBool x) (fun _ => startInvariant_initNil) + startInvariant_initNil).strengthen_post ?_ + rintro inp work out ⟨hi, hw, ho⟩ + refine ⟨hi, funext fun i => (hw i).trans ?_, ?_⟩ + · rw [hW₀] + exact Tape.ext (by show max 0 1 = 1; omega) rfl + · rw [ho] + show OutAcc [] (⟨max 0 1, (Tape.init ([] : List Γ)).cells⟩ : Tape) + have : (⟨max 0 1, (Tape.init ([] : List Γ)).cells⟩ : Tape) = parkedBlank := + Tape.ext (by show max 0 1 = 1; omega) rfl + rw [this] + exact outAcc_nil_of_parkedBlank + -- phase 2: the loop register + have hB := inputLenRegTM_hoareTime (n := 3 + (k + 2) + 0) rfIdx x W₀ [] + (fun i _ => hW₀P i) (by rw [hW₀]; exact parkedBlank_eq_regTape_zero) + set W₁ : Fin (3 + (k + 2) + 0) → Tape := + Function.update W₀ rfIdx (regTape x.length) with hW₁ + have hW₁P : ∀ i, Parked (W₁ i) := by + intro i + by_cases hi : i = rfIdx + · rw [hW₁, hi, Function.update_self]; exact parked_regTape _ + · rw [hW₁, Function.update_of_ne hi]; exact hW₀P i + -- phase 3: the reset register + have hC := polyEvalTM_hoareTime rfIdx wfIdx junkIdx rfIdx_ne_wfIdx + (fun h => junkIdx_ne_rfIdx h.symm) junkIdx_ne_wfIdx.symm p (polyM p x.length) + x.length 0 0 (by rw [polyM]; omega) (by omega) (by omega) + (fun j _ => le_trans (hornerFold_take_le x.length (polyCoeffs p) j) (by rw [polyM]; omega)) + inpx W₁ [] hinpxP hW₁P (by rw [hW₁, Function.update_self]) + (by rw [hW₁, Function.update_of_ne rfIdx_ne_wfIdx.symm, hW₀] + exact parkedBlank_eq_regTape_zero) + (by rw [hW₁, Function.update_of_ne junkIdx_ne_rfIdx, hW₀] + exact parkedBlank_eq_regTape_zero) + -- phase 4: the emission + have hfam : Function.update (Function.update W₁ junkIdx (regTape (p.eval x.length))) wfIdx + (regTape (p.eval x.length)) + = emitStart (bookTapes (regTape x.length) (regTape H) H) := by + funext i + rcases layout_cases i with h | h | h | ⟨j, h⟩ + · rw [h, Function.update_of_ne rfIdx_ne_wfIdx, Function.update_of_ne junkIdx_ne_rfIdx.symm, + hW₁, Function.update_self, emitStart_extra _ _ rfIdx_not_middle, bookTapes_rf] + · rw [h, Function.update_self, emitStart_extra _ _ wfIdx_not_middle, bookTapes_wf, hH] + · rw [h, Function.update_of_ne junkIdx_ne_wfIdx, Function.update_self, + emitStart_extra _ _ junkIdx_not_middle, bookTapes_junk, hH] + · rw [h, Function.update_of_ne (fun hc => wfIdx_ne_appIdx j hc.symm), + Function.update_of_ne (fun hc => junkIdx_ne_appIdx j hc.symm), hW₁, + Function.update_of_ne (fun hc => rfIdx_ne_appIdx j hc.symm), hW₀, emitStart_middle] + have hD := placedEmit_hoareTime (k := k) x H (by omega) + (bookTapes (regTape x.length) (regTape H) H) + (bookTapes_startInvariant (startInvariant_regTape _) (startInvariant_regTape _)) + (bookTapes_head (parked_regTape _) (parked_regTape _)) + -- chain + have hAB := seqTM_hoareTime _ _ hA (emitPred_transition hinpxP hW₀P []) hB + have hBC := seqTM_hoareTime _ _ hAB (emitPred_transition hinpxP hW₁P []) hC + refine ((seqTM_hoareTime _ _ hBC ?_ hD).strengthen_post ?_).mono_bound (by rw [setupBound]) + · rintro inp work out ⟨rfl, hw, hout⟩ + rw [hfam] at hw + subst hw + have houtEq := eq_parkedBlank_of_outAcc_nil hout + have hPall : ∀ i : Fin (3 + (k + 2) + 0), + Parked (emitStart (bookTapes (regTape x.length) (regTape H) H) i) := by + intro i + by_cases hi : placeWorkInMiddle 3 (k + 2) i + · rw [emitStart, if_pos hi]; exact parked_parkedBlank + · rw [emitStart, if_neg hi] + exact ⟨bookTapes_head (parked_regTape _) (parked_regTape _) i hi, + (bookTapes_startInvariant (startInvariant_regTape _) + (startInvariant_regTape _) i hi).2⟩ + obtain ⟨t1, t2, t3⟩ := parked_transition (inp₀ := inpx) (out₀ := out) hinpxP hPall + (houtEq ▸ parked_parkedBlank) + rw [t1, t2, t3] + exact ⟨rfl, houtEq, rfl⟩ + · rintro inp work out ⟨hinpSI, ho, hres, hbnd, hext⟩ + refine ⟨hinpSI, ho, hres, hbnd, ?_, ?_, ?_⟩ + · rw [hext rfIdx rfIdx_not_middle, bookTapes_rf] + · rw [hext wfIdx wfIdx_not_middle, bookTapes_wf] + · rw [hext junkIdx junkIdx_not_middle, bookTapes_junk] + +/-! ## The whole machine + +Setup, loop, and one final application whose output lands on the real output +tape. Over-iteration is harmless, so that last application is just one more +iteration. -/ + +theorem not_middle_succ_cases (i : Fin (3 + (k + 2) + 0)) + (hi : ¬ placeWorkInMiddle (post := 1) 3 (k + 1) i) : + i = rfIdx ∨ i = wfIdx ∨ i = junkIdx ∨ i = resIdx := by + have hlt := i.isLt + have hres : (resIdx (k := k)).val = 3 + (k + 1) := rfl + unfold placeWorkInMiddle at hi + have h : i.val = 0 ∨ i.val = 1 ∨ i.val = 2 ∨ i.val = 3 + (k + 1) := by omega + rcases h with h | h | h | h + · exact Or.inl (Fin.ext h) + · exact Or.inr (Or.inl (Fin.ext h)) + · exact Or.inr (Or.inr (Or.inl (Fin.ext h))) + · exact Or.inr (Or.inr (Or.inr (Fin.ext (h.trans hres.symm)))) + +/-- The frame of the final application: the three bookkeeping tapes and the +result tape, which the last application no longer needs. -/ +def teardownExtras (v H : ℕ) : Fin (3 + (k + 2) + 0) → Tape := + fun i => if i = resIdx then parkedBlank else bookTapes (regTape v) (regTape H) H i + +/-- Setup, loop, and the final application. -/ +def iterMain (M : TM k) : TM (3 + (k + 2) + 0) := + seqTM (seqTM (iterTail k) (forRegTM (iterBody M) rfIdx)) + (placeWorkTM 3 1 (TM.retargetInputStarted M)) + +/-- **The main run.** From the result tape carrying the initial value, the +machine iterates `v + 1` times and writes the last value to the real output. -/ +theorem iterMain_hoareTime (M : TM k) {G : List Bool → List Bool} {T : ℕ → ℕ} + (hcomp : M.ComputesInTime G T) (H : ℕ) (v : ℕ) + (Y : ℕ → List Bool) (hY : ∀ i, Y (i + 1) = G (Y i)) + (hlen : ∀ i, i ≤ v → (Y i).length + 1 ≤ H) + (hT : ∀ i, i < v → 1 + T (Y i).length ≤ H) + (b_iter : ℕ) + (hb : ∀ i, i < v → T (Y i).length + 1 + tailBound k H (Y (i + 1)).length ≤ b_iter) : + (iterMain M).HoareTime + (fun inp work out => Parked inp ∧ Tape.StartInvariant inp ∧ out = parkedBlank ∧ + (work resIdx).HasOutput (Y 0) ∧ + (∀ j : Fin (k + 2), Tape.StartInvariant (work (appIdx j)) ∧ + (work (appIdx j)).head ≤ H ∧ + ∀ c, H < c → (work (appIdx j)).cells c = Γ.blank) ∧ + work rfIdx = regTape v ∧ work wfIdx = regTape H ∧ work junkIdx = regTape H) + (fun _inp _work out => out.HasOutput (G (Y v))) + (tailBound k H (Y 0).length + 1 + (v * (b_iter + 2) + (v + 2)) + 1 + T (Y v).length) := by + rw [iterMain] + intro inp work out hpre + obtain ⟨hinpP, hinpSI, ho, hres, hbnd, hrf, hwf, hjunk⟩ := hpre + have hregP := parked_regTape H + have hregSI := startInvariant_regTape H + have hfamP : ∀ (i : ℕ) (j : Fin (3 + (k + 2) + 0)), + Parked (iterFamily M Y inp (regTape H) v H i j) := by + intro i j + by_cases hj : j = rfIdx + · rw [hj, iterFamily_rf]; exact parked_regTape v + · exact iterFamily_parked hregP i j hj + -- the tail, the loop, and the final application + have h1 := iterTail_hoareTime M H (Y 0) (hlen 0 (by omega)) inp hinpP hinpSI + (regTape v) (regTape H) (parked_regTape v) (startInvariant_regTape v) hregP hregSI + have h2 := iterLoop_hoareTime (M := M) (Y := Y) (inp₀ := inp) (junkT := regTape H) + (v := v) (H := H) hcomp hY hlen hT b_iter hb hinpP hinpSI hregP hregSI + have h3 := TM.placeWorkTM_hoareTime_frame (pre := 3) (post := 1) + (TM.retargetInputStarted M) (TM.retargetInputStarted_hoareTime M hcomp (Y v)) + (teardownExtras v H) + (fun i hi => by + rcases not_middle_succ_cases i hi with h | h | h | h + · rw [h, teardownExtras, if_neg rfIdx_ne_resIdx, bookTapes_rf] + exact startInvariant_regTape v + · rw [h, teardownExtras, if_neg wfIdx_ne_resIdx, bookTapes_wf]; exact hregSI + · rw [h, teardownExtras, if_neg junkIdx_ne_resIdx, bookTapes_junk]; exact hregSI + · rw [h, teardownExtras, if_pos rfl] + exact startInvariant_initNil.move Dir3.right) + (fun i hi => by + rcases not_middle_succ_cases i hi with h | h | h | h + · rw [h, teardownExtras, if_neg rfIdx_ne_resIdx, bookTapes_rf] + exact (parked_regTape v).1 + · rw [h, teardownExtras, if_neg wfIdx_ne_resIdx, bookTapes_wf]; exact hregP.1 + · rw [h, teardownExtras, if_neg junkIdx_ne_resIdx, bookTapes_junk]; exact hregP.1 + · rw [h, teardownExtras, if_pos rfl]; exact parked_parkedBlank.1) + -- the two seams are the identity: every tape is parked + have hseam : ∀ (W : Fin (3 + (k + 2) + 0) → Tape), (∀ i, Parked (W i)) → + ∀ (inp' : Tape) (out' : Tape), inp' = inp → out' = parkedBlank → + transitionInput inp' = inp ∧ (fun i => transitionTape (W i)) = W ∧ + transitionTape out' = parkedBlank := by + rintro W hW inp' out' rfl rfl + exact parked_transition hinpP hW parked_parkedBlank + have h12 := seqTM_hoareTime _ _ h1 (by + rintro inp' work' out' ⟨rfl, rfl, hrf', hjunk', hwf', happ'⟩ + have hWP : ∀ i, Parked (work' i) := by + intro i + rcases layout_cases i with h | h | h | ⟨j, h⟩ + · rw [h, hrf']; exact parked_regTape v + · rw [h, hwf']; exact hregP + · rw [h, hjunk']; exact hregP + · rw [h, happ' j] + exact ⟨le_of_eq (TM.applyPre_head M (Y 0) _ j).symm, + fun c hc => (TM.applyPre_startInvariant M (Y 0) _ j).2 c hc⟩ + obtain ⟨t1, t2, t3⟩ := hseam work' hWP inp' parkedBlank rfl rfl + rw [t1, t2, t3] + refine ⟨rfl, funext fun i => ?_, outAcc_nil_of_parkedBlank⟩ + rcases layout_cases i with h | h | h | ⟨j, h⟩ + · rw [h, hrf', iterFamily_rf] + · rw [h, hwf', iterFamily_wf] + · rw [h, hjunk', iterFamily_junk] + · rw [h, happ' j, iterFamily_app]) h2 + refine (seqTM_hoareTime _ _ h12 ?_ h3).strengthen_post + (post' := fun _inp _work out => out.HasOutput (G (Y v))) ?_ inp work out + ⟨rfl, ho, hres, hbnd, hrf, hwf, hjunk⟩ + · rintro inp' work' out' ⟨rfl, rfl, hout'⟩ + obtain ⟨t1, t2, t3⟩ := hseam _ (hfamP v) inp' out' + rfl (eq_parkedBlank_of_outAcc_nil hout') + rw [t1, t2, t3] + refine ⟨⟨funext fun i => ?_, rfl⟩, fun i hi => ?_⟩ + · show iterFamily M Y inp' (regTape H) v H v (appIdx (Fin.castSucc i)) = _ + rw [iterFamily_app] + exact congrFun (TM.applyPre_spec M (Y v) inp').1 i + · rcases not_middle_succ_cases i hi with h | h | h | h + · rw [h, iterFamily_rf, teardownExtras, if_neg rfIdx_ne_resIdx, bookTapes_rf] + · rw [h, iterFamily_wf, teardownExtras, if_neg wfIdx_ne_resIdx, bookTapes_wf] + · rw [h, iterFamily_junk, teardownExtras, if_neg junkIdx_ne_resIdx, bookTapes_junk] + · rw [h, show (resIdx (k := k)) = appIdx (Fin.last (k + 1)) from rfl, iterFamily_app, + teardownExtras, if_pos (show appIdx (Fin.last (k + 1)) = resIdx from rfl), + TM.applyPre, Fin.snoc_last] + · rintro inp' work' out' ⟨hout, -⟩ + exact hout + +/-- The complete iteration machine. -/ +def iterTM (M : TM k) (p : Polynomial ℕ) : TM (3 + (k + 2) + 0) := + seqTM (iterSetup k p) (iterMain M) + +theorem tailBound_mono (k H : ℕ) {m m' : ℕ} (h : m ≤ m') : + tailBound k H m ≤ tailBound k H m' := by + rw [tailBound, tailBound]; omega + +/-- `Complexity.iterTM`'s time bound. -/ +def iterBound (k : ℕ) (tp p r : Polynomial ℕ) (n : ℕ) : ℕ := + setupBound p n + 1 + + (tailBound k (p.eval n) (n + 2) + 1 + + (n * (tp.eval (r.eval n) + 1 + tailBound k (p.eval n) (r.eval n) + 2) + (n + 2)) + 1 + + tp.eval (r.eval n)) + +/-- **The iteration machine computes the iterate.** On input `x` it applies `G` +to `pair [] x` exactly `|x| + 1` times, provided the padding polynomial `p` +dominates the length bound `r` and the source machine's own bound `tp`. -/ +theorem iterTM_computesInTime (M : TM k) {G : List Bool → List Bool} {tp : Polynomial ℕ} + (hcomp : M.ComputesInTime G tp.eval) (p r : Polynomial ℕ) + (hp₁ : ∀ n, n + 4 ≤ p.eval n) (hp₂ : ∀ n, r.eval n + 1 ≤ p.eval n) + (hp₃ : ∀ n, 1 + tp.eval (r.eval n) ≤ p.eval n) + (hr : ∀ (x : List Bool), ∀ i ≤ x.length, (G^[i] (pair [] x)).length ≤ r.eval x.length) : + (iterTM M p).ComputesInTime (fun x => G^[x.length + 1] (pair [] x)) + (iterBound k tp p r) := by + intro x + set n := x.length with hn + set H := p.eval n with hH + set Y : ℕ → List Bool := fun i => G^[i] (pair [] x) with hY0 + have hYsucc : ∀ i, Y (i + 1) = G (Y i) := by + intro i + rw [hY0] + exact Function.iterate_succ_apply' G i (pair [] x) + have hYlen : ∀ i, i ≤ n → (Y i).length ≤ r.eval n := fun i hi => hr x i hi + have hHpos : 1 ≤ H := by have := hp₁ n; omega + have hlen : ∀ i, i ≤ n → (Y i).length + 1 ≤ H := by + intro i hi + have := hYlen i hi + have := hp₂ n + omega + have hTle : ∀ i, i ≤ n → tp.eval (Y i).length ≤ tp.eval (r.eval n) := fun i hi => + polynomial_eval_mono_nat tp (hYlen i hi) + have hsetup := iterSetup_hoareTime (k := k) p x H rfl (by have := hp₁ n; omega) + have hmain := iterMain_hoareTime M hcomp H n Y hYsucc hlen + (fun i hi => by have := hTle i (by omega); have := hp₃ n; omega) + (tp.eval (r.eval n) + 1 + tailBound k H (r.eval n)) + (fun i hi => by + have h1 := hTle i (by omega) + have h2 := tailBound_mono k H (hYlen (i + 1) (by omega)) + omega) + have hseam : ∀ (inp : Tape) (work : Fin (3 + (k + 2) + 0) → Tape) (out : Tape), + (Tape.StartInvariant inp ∧ out = parkedBlank ∧ + (work resIdx).HasOutput (pair [] x) ∧ + (∀ j : Fin (k + 2), Tape.StartInvariant (work (appIdx j)) ∧ + (work (appIdx j)).head ≤ H ∧ + ∀ c, H < c → (work (appIdx j)).cells c = Γ.blank) ∧ + work rfIdx = regTape n ∧ work wfIdx = regTape H ∧ work junkIdx = regTape H) → + (Parked (transitionInput inp) ∧ Tape.StartInvariant (transitionInput inp) ∧ + transitionTape out = parkedBlank ∧ + ((fun i => transitionTape (work i)) resIdx).HasOutput (Y 0) ∧ + (∀ j : Fin (k + 2), + Tape.StartInvariant ((fun i => transitionTape (work i)) (appIdx j)) ∧ + ((fun i => transitionTape (work i)) (appIdx j)).head ≤ H ∧ + ∀ c, H < c → ((fun i => transitionTape (work i)) (appIdx j)).cells c = Γ.blank) ∧ + (fun i => transitionTape (work i)) rfIdx = regTape n ∧ + (fun i => transitionTape (work i)) wfIdx = regTape H ∧ + (fun i => transitionTape (work i)) junkIdx = regTape H) := by + rintro inp work out ⟨hinpSI, rfl, hres, hbnd, hrf, hwf, hjunk⟩ + dsimp only + have hinpEq : transitionInput inp = (⟨max inp.head 1, inp.cells⟩ : Tape) := + move_idleDir_eq_of_startInvariant hinpSI + refine ⟨?_, ?_, transitionTape_eq_self parked_parkedBlank.read_ne_start, ?_, + fun j => ⟨?_, ?_, ?_⟩, ?_, ?_, ?_⟩ + · rw [hinpEq]; exact ⟨le_max_right _ _, fun c hc => hinpSI.2 c hc⟩ + · rw [hinpEq]; exact ⟨hinpSI.1, fun c hc => hinpSI.2 c hc⟩ + · exact (Tape.hasOutput_congr + (transitionTape_cells _ (fun c hc => (hbnd (Fin.last (k + 1))).1.2 c hc)).symm _).mp hres + · refine ⟨?_, fun c hc => ?_⟩ + · rw [transitionTape_cells _ (fun c' hc' => (hbnd j).1.2 c' hc')] + exact (hbnd j).1.1 + · rw [transitionTape_cells _ (fun c' hc' => (hbnd j).1.2 c' hc')] + exact (hbnd j).1.2 c hc + · rw [transitionTape_of_startInvariant (hbnd j).1] + show max (work (appIdx j)).head 1 ≤ H + have := (hbnd j).2.1 + omega + · intro c hc + rw [transitionTape_cells _ (fun c' hc' => (hbnd j).1.2 c' hc')] + exact (hbnd j).2.2 c hc + · show transitionTape (work rfIdx) = regTape n + rw [hrf]; exact transitionTape_eq_self (parked_regTape n).read_ne_start + · show transitionTape (work wfIdx) = regTape H + rw [hwf]; exact transitionTape_eq_self (parked_regTape H).read_ne_start + · show transitionTape (work junkIdx) = regTape H + rw [hjunk]; exact transitionTape_eq_self (parked_regTape H).read_ne_start + have hfull := seqTM_hoareTime _ _ hsetup hseam hmain + obtain ⟨c', t, ht, hreach, hhalt, hpost⟩ := hfull (Tape.init (x.map Γ.ofBool)) + (fun _ => Tape.init []) (Tape.init []) ⟨rfl, rfl, rfl⟩ + have hY0len : (Y 0).length = n + 2 := by + rw [hY0] + show (pair [] x).length = n + 2 + rw [pair_length] + simp + omega + refine ⟨c', t, ?_, hreach, hhalt, ?_⟩ + · refine le_trans ht ?_ + rw [iterBound, hY0len] + simp only [← hn, hH] + have := hTle n le_rfl + omega + · show c'.output.HasOutput (G^[x.length + 1] (pair [] x)) + rw [Function.iterate_succ_apply'] + exact hpost + +/-! ## Polynomial bounds + +`Complexity.iterBound` is a sum of products of polynomial evaluations, so the +closure API of `Complexitylib.Asymptotics.PolyBound` bounds it directly. -/ + +theorem polyBound_iterBound (k : ℕ) (tp p r : Polynomial ℕ) : + PolyBound (iterBound k tp p r) := by + have hcomp : PolyBound (fun n => tp.eval (r.eval n)) := + PolyBound.mono (PolyBound.eval (tp.comp r)) + (fun n => le_of_eq (by rw [Polynomial.eval_comp])) + have hp : PolyBound (fun n => p.eval n) := PolyBound.eval p + have hr : PolyBound (fun n => r.eval n) := PolyBound.eval r + have hpow : PolyBound (fun n => (n + 1) ^ (polyCoeffs p).length) := + PolyBound.pow (PolyBound.add PolyBound.id (PolyBound.const 1)) _ + have hM : PolyBound (fun n => polyM p n) := by + rw [show (fun n => polyM p n) = fun n => + ((polyCoeffs p).sum + 1) * (n + 1) ^ (polyCoeffs p).length + n + p.eval n from rfl] + exact PolyBound.add (PolyBound.add (PolyBound.mul (PolyBound.const _) hpow) PolyBound.id) hp + have hop : PolyBound (fun n => opBudget (polyM p n)) := by + rw [show (fun n => opBudget (polyM p n)) = fun n => + 32 * ((polyM p n + 2) * (polyM p n + 2) * (polyM p n + 2)) from rfl] + exact PolyBound.mul (PolyBound.const _) + (PolyBound.mul (PolyBound.mul (PolyBound.add hM (PolyBound.const _)) + (PolyBound.add hM (PolyBound.const _))) (PolyBound.add hM (PolyBound.const _))) + have hlayer : PolyBound (fun n => layerBudget (polyM p n)) := by + rw [show (fun n => layerBudget (polyM p n)) = fun n => + 4 * opBudget (polyM p n) + 3 from rfl] + exact PolyBound.add (PolyBound.mul (PolyBound.const _) hop) (PolyBound.const _) + have hsetup : PolyBound (setupBound p) := by + rw [show setupBound p = fun n => 1 + 1 + (2 * n + 4) + 1 + + (opBudget (polyM p n) + 1 + + ((p.natDegree + 1) * (layerBudget (polyM p n) + 1) + 1)) + 1 + (n + 3) from rfl] + exact PolyBound.add (PolyBound.add (PolyBound.add (PolyBound.add (PolyBound.add + (PolyBound.add (PolyBound.const _) (PolyBound.const _)) + (PolyBound.add (PolyBound.mul (PolyBound.const 2) PolyBound.id) (PolyBound.const _))) + (PolyBound.const _)) + (PolyBound.add (PolyBound.add hop (PolyBound.const _)) + (PolyBound.add + (PolyBound.mul (PolyBound.const _) (PolyBound.add hlayer (PolyBound.const _))) + (PolyBound.const _)))) + (PolyBound.const _)) (PolyBound.add PolyBound.id (PolyBound.const _)) + have htail : ∀ m : ℕ → ℕ, PolyBound m → + PolyBound (fun n => tailBound k (p.eval n) (m n)) := by + intro m hm + rw [show (fun n => tailBound k (p.eval n) (m n)) = fun n => + 1 + 1 + (p.eval n + 1 + 2) + 1 + + ((k + 1) * (p.eval n + 4) + p.eval n * 4 + 8 + 1 + ((k + 1) * (p.eval n + 4) + 1)) + 1 + + (2 * m n + 5 + 1 + + (1 * (p.eval n + 4) + p.eval n * 4 + 8 + 1 + (1 * (p.eval n + 4) + 1))) from rfl] + have hbase : PolyBound (fun n => p.eval n + 4) := PolyBound.add hp (PolyBound.const _) + have hk : PolyBound (fun n => (k + 1) * (p.eval n + 4)) := + PolyBound.mul (PolyBound.const _) hbase + have h1 : PolyBound (fun n => 1 * (p.eval n + 4)) := PolyBound.mul (PolyBound.const _) hbase + have h4 : PolyBound (fun n => p.eval n * 4) := PolyBound.mul hp (PolyBound.const _) + exact PolyBound.add (PolyBound.add (PolyBound.add (PolyBound.add (PolyBound.add + (PolyBound.add (PolyBound.const _) (PolyBound.const _)) + (PolyBound.add (PolyBound.add hp (PolyBound.const _)) (PolyBound.const _))) + (PolyBound.const _)) + (PolyBound.add (PolyBound.add (PolyBound.add (PolyBound.add hk h4) (PolyBound.const _)) + (PolyBound.const _)) (PolyBound.add hk (PolyBound.const _)))) (PolyBound.const _)) + (PolyBound.add (PolyBound.add (PolyBound.add (PolyBound.mul (PolyBound.const 2) hm) + (PolyBound.const _)) (PolyBound.const _)) + (PolyBound.add (PolyBound.add (PolyBound.add (PolyBound.add h1 h4) (PolyBound.const _)) + (PolyBound.const _)) (PolyBound.add h1 (PolyBound.const _)))) + rw [show iterBound k tp p r = fun n => setupBound p n + 1 + + (tailBound k (p.eval n) (n + 2) + 1 + + (n * (tp.eval (r.eval n) + 1 + tailBound k (p.eval n) (r.eval n) + 2) + (n + 2)) + 1 + + tp.eval (r.eval n)) from rfl] + exact PolyBound.add (PolyBound.add hsetup (PolyBound.const _)) + (PolyBound.add (PolyBound.add (PolyBound.add (PolyBound.add + (htail _ (PolyBound.add PolyBound.id (PolyBound.const _))) (PolyBound.const _)) + (PolyBound.add (PolyBound.mul PolyBound.id (PolyBound.add (PolyBound.add (PolyBound.add hcomp + (PolyBound.const _)) (htail _ hr)) (PolyBound.const _))) + (PolyBound.add PolyBound.id (PolyBound.const _)))) (PolyBound.const _)) hcomp) + +/-- **`FP` is closed under iterating a polynomial-time function once per input +bit**, provided every intermediate value stays polynomially bounded. -/ +theorem iterate_input_mem_FP {G : List Bool → List Bool} (hG : G ∈ FP) (r : Polynomial ℕ) + (hr : ∀ (x : List Bool), ∀ i ≤ x.length, (G^[i] (pair [] x)).length ≤ r.eval x.length) : + (fun x => G^[x.length + 1] (pair [] x)) ∈ FP := by + obtain ⟨k, M, tp, hcomp⟩ := mem_FP_iff_computesInTime_polynomial.mp hG + set p : Polynomial ℕ := + Polynomial.X + Polynomial.C 4 + r + Polynomial.C 1 + tp.comp r + Polynomial.C 1 with hpdef + have hpeval : ∀ n, p.eval n = n + 4 + r.eval n + 1 + tp.eval (r.eval n) + 1 := by + intro n + rw [hpdef] + simp [Polynomial.eval_comp] + obtain ⟨d, hd⟩ := (polyBound_iterBound k tp p r).bigO + exact ⟨d, 3 + (k + 2) + 0, iterTM M p, iterBound k tp p r, + iterTM_computesInTime M hcomp p r (fun n => by rw [hpeval]; omega) + (fun n => by rw [hpeval]; omega) (fun n => by rw [hpeval]; omega) hr, hd⟩ + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/IterateLayout.lean b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/IterateLayout.lean new file mode 100644 index 0000000000..5d9fa35c72 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/IterateLayout.lean @@ -0,0 +1,574 @@ +/- +Copyright (c) 2026 Bolton Bailey. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Bolton Bailey +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.Apply +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.CopyToVirtualInput + +/-! +# The bounded-iteration machine's tape layout — proof internals + +The tape layout and phase contracts that +`Complexitylib.Classes.P.Cobham.Internal.Iterate` assembles into the +bounded-iteration machine: two unary fuel registers (one consumed by the outer +loop, one reused by every reset), one junk tape for the register arithmetic, and +then `TM.applyTM`'s own tapes placed after them. The running value needs no tape +of its own — it lives on `applyTM`'s virtual-input tape, which is exactly where +the next call wants it. + +## Main results + +- `Complexity.rfIdx`, `wfIdx`, `junkIdx`, `appIdx`, `vinIdx`, `resIdx` — the layout +- `Complexity.placedApply_hoareTime` — one embedded application of the iterated function +- `Complexity.iterPark_hoareTime`, `iterResetScratch_hoareTime`, + `iterFinish_hoareTime` — the phase contracts around it +-/ + + +@[expose] public section + +namespace Complexity + +open Complexity.TM + +variable {k : ℕ} + +/-- The outer loop's fuel register. -/ +def rfIdx : Fin (3 + (k + 2) + 0) := ⟨0, by omega⟩ + +/-- The reset's fuel register, restored by every reset. -/ +def wfIdx : Fin (3 + (k + 2) + 0) := ⟨1, by omega⟩ + +/-- Holds the input's padding block; never read again. -/ +def junkIdx : Fin (3 + (k + 2) + 0) := ⟨2, by omega⟩ + +/-- Where `TM.applyTM`'s tape `j` sits in the composite layout. -/ +def appIdx (j : Fin (k + 2)) : Fin (3 + (k + 2) + 0) := placeWorkIdx 3 0 j + +/-- The running value's tape — `applyTM`'s virtual input. -/ +def vinIdx : Fin (3 + (k + 2) + 0) := appIdx (Fin.castSucc (Fin.last k)) + +/-- Where one application of the iterated function leaves its result. -/ +def resIdx : Fin (3 + (k + 2) + 0) := appIdx (Fin.last (k + 1)) + +@[simp] theorem rfIdx_val : (rfIdx (k := k)).val = 0 := rfl +@[simp] theorem wfIdx_val : (wfIdx (k := k)).val = 1 := rfl +@[simp] theorem junkIdx_val : (junkIdx (k := k)).val = 2 := rfl +@[simp] theorem appIdx_val (j : Fin (k + 2)) : (appIdx j).val = 3 + j.val := rfl + +/-- The three bookkeeping tapes are exactly the ones outside `applyTM`'s +block. -/ +theorem not_middle_iff (i : Fin (3 + (k + 2) + 0)) : + ¬ placeWorkInMiddle 3 (k + 2) i ↔ i.val < 3 := by + have hlt := i.isLt + unfold placeWorkInMiddle + constructor <;> intro h <;> omega + +theorem appIdx_middle (j : Fin (k + 2)) : placeWorkInMiddle 3 (k + 2) (appIdx j) := + placeWorkInMiddle_placeWorkIdx 3 0 j + +theorem appIdx_injective : Function.Injective (appIdx (k := k)) := + placeWorkIdx_injective 3 0 + +theorem rfIdx_not_middle : ¬ placeWorkInMiddle 3 (k + 2) (rfIdx (k := k)) := + (not_middle_iff _).mpr (by rw [rfIdx_val]; omega) + +theorem wfIdx_not_middle : ¬ placeWorkInMiddle 3 (k + 2) (wfIdx (k := k)) := + (not_middle_iff _).mpr (by rw [wfIdx_val]; omega) + +theorem junkIdx_not_middle : ¬ placeWorkInMiddle 3 (k + 2) (junkIdx (k := k)) := + (not_middle_iff _).mpr (by rw [junkIdx_val]; omega) + +theorem wfIdx_ne_appIdx (j : Fin (k + 2)) : wfIdx ≠ appIdx j := by + intro h + exact wfIdx_not_middle (h ▸ appIdx_middle j) + +theorem rfIdx_ne_appIdx (j : Fin (k + 2)) : rfIdx ≠ appIdx j := by + intro h + exact rfIdx_not_middle (h ▸ appIdx_middle j) + +theorem junkIdx_ne_appIdx (j : Fin (k + 2)) : junkIdx ≠ appIdx j := by + intro h + exact junkIdx_not_middle (h ▸ appIdx_middle j) + +/-- **The layout is exhaustive.** Every tape of the composite machine is one of +the three bookkeeping tapes or one of `TM.applyTM`'s own, so a predicate that +names all four kinds pins down the whole tape family. -/ +theorem layout_cases (i : Fin (3 + (k + 2) + 0)) : + i = rfIdx ∨ i = wfIdx ∨ i = junkIdx ∨ ∃ j : Fin (k + 2), i = appIdx j := by + by_cases hmid : placeWorkInMiddle 3 (k + 2) i + · exact Or.inr (Or.inr (Or.inr + ⟨placeWorkCoord 3 (k + 2) i hmid, (placeWorkIdx_placeWorkCoord i hmid).symm⟩)) + · rw [not_middle_iff] at hmid + have h : i.val = 0 ∨ i.val = 1 ∨ i.val = 2 := by omega + rcases h with h | h | h + · exact Or.inl (Fin.ext h) + · exact Or.inr (Or.inl (Fin.ext h)) + · exact Or.inr (Or.inr (Or.inl (Fin.ext h))) + +/-- **One application of the iterated function, in the composite layout.** +The bookkeeping tapes are held fixed; `applyTM`'s block goes from its entry +shape for `y` to a state where the result tape holds `G y` and every tape of +the block is still confined to cells `1 … H` — the two facts +`Complexity.resetTapesTM` needs to clean up afterwards. -/ +theorem placedApply_hoareTime (M : TM k) {G : List Bool → List Bool} {T : ℕ → ℕ} + (hcomp : M.ComputesInTime G T) (y : List Bool) + (inp₀ : Tape) (hinp : Parked inp₀) (hinpSI : Tape.StartInvariant inp₀) + (H : ℕ) (hHy : y.length ≤ H) (hHT : 1 + T y.length ≤ H) + (extras : Fin (3 + (k + 2) + 0) → Tape) + (hextraSI : ∀ i, ¬ placeWorkInMiddle 3 (k + 2) i → Tape.StartInvariant (extras i)) + (hextraH : ∀ i, ¬ placeWorkInMiddle 3 (k + 2) i → 1 ≤ (extras i).head) : + (placeWorkTM 3 0 (applyTM M)).HoareTime + (fun inp work out => inp = inp₀ ∧ + (∀ j, work (appIdx j) = applyPre M y inp₀ j) ∧ + (∀ i, ¬ placeWorkInMiddle 3 (k + 2) i → work i = extras i) ∧ + out = parkedBlank) + (fun inp work out => inp = inp₀ ∧ out = parkedBlank ∧ + (work resIdx).HasOutput (G y) ∧ + (∀ j, Tape.StartInvariant (work (appIdx j)) ∧ (work (appIdx j)).head ≤ H ∧ + ∀ c, H < c → (work (appIdx j)).cells c = Γ.blank) ∧ + (∀ i, ¬ placeWorkInMiddle 3 (k + 2) i → work i = extras i)) + (T y.length) := by + have hbase := placeWorkTM_hoareTime_frame (pre := 3) (post := 0) (applyTM M) + (applyTM_hoareTime_frame M hcomp y inp₀ hinp hinpSI H hHy hHT) extras hextraSI hextraH + refine (hbase.weaken_pre ?_).strengthen_post ?_ + · rintro inp work out ⟨hi, hmid, hext, ho⟩ + exact ⟨⟨hi, funext hmid, ho⟩, hext⟩ + · rintro inp work out ⟨⟨hi, ho, hres, hall⟩, hext⟩ + exact ⟨hi, ho, hres, hall, hext⟩ + +/-- The tapes cleaned between two applications of the iterated function: the +witness machine's own scratch together with the virtual-input tape. The result +tape is deliberately excluded — it still carries the value being moved. -/ +def resetTargets (k : ℕ) : List (Fin (3 + (k + 2) + 0)) := + (List.finRange (k + 1)).map (fun j => appIdx (Fin.castSucc j)) + +theorem resetTargets_nodup : (resetTargets k).Nodup := by + refine (List.nodup_finRange (k + 1)).map ?_ + intro a b hab + exact Fin.castSucc_injective (k + 1) (appIdx_injective hab) + +@[simp] theorem resetTargets_length : (resetTargets k).length = k + 1 := by + simp [resetTargets] + +theorem mem_resetTargets_iff (i : Fin (3 + (k + 2) + 0)) : + i ∈ resetTargets k ↔ ∃ j : Fin (k + 1), appIdx (Fin.castSucc j) = i := by + simp [resetTargets, eq_comm] + +theorem wfIdx_notMem_resetTargets : wfIdx ∉ resetTargets (k := k) := by + rw [mem_resetTargets_iff] + rintro ⟨j, hj⟩ + exact wfIdx_ne_appIdx _ hj.symm + +theorem resIdx_notMem_resetTargets : resIdx ∉ resetTargets (k := k) := by + rw [mem_resetTargets_iff] + rintro ⟨j, hj⟩ + have := appIdx_injective hj + exact absurd (congrArg Fin.val this) (by simp; omega) + +theorem vinIdx_mem_resetTargets : vinIdx ∈ resetTargets (k := k) := by + rw [mem_resetTargets_iff] + exact ⟨Fin.last k, rfl⟩ + +/-- The tape cleaned after the result has been moved back. -/ +def resetResult (k : ℕ) : List (Fin (3 + (k + 2) + 0)) := [resIdx] + +theorem resetResult_nodup : (resetResult k).Nodup := List.nodup_singleton _ + +theorem wfIdx_notMem_resetResult : wfIdx ∉ resetResult (k := k) := by + simp only [resetResult, List.mem_singleton] + exact wfIdx_ne_appIdx _ + +/-- **Phases 2–3 of the body.** `δ_right_of_start` only constrains a head that +*reads* `▷`, so an arbitrary witness machine may halt with a head parked on +cell `0`. One idle step lifts every head to at least cell `1`, and one rewind +then brings the result tape's head back to exactly cell `1` — the shape both +`Complexity.resetTapesTM` (which preserves non-target tapes only when they are +parked) and `TM.copyWorkToWorkTM` (which wants its source at cell `1`) +require. -/ +theorem iterPark_hoareTime (H : ℕ) (inp₀ : Tape) (hinpP : Parked inp₀) + (hinpSI : Tape.StartInvariant inp₀) + (W : Fin (3 + (k + 2) + 0) → Tape) + (hSI : ∀ i, Tape.StartInvariant (W i)) + (hB : (W resIdx).head ≤ H) : + (seqTM skipTM (rewindWorkTM resIdx)).HoareTime + (fun inp work out => inp = inp₀ ∧ work = W ∧ out = parkedBlank) + (fun inp work out => inp = inp₀ ∧ out = parkedBlank ∧ + (work resIdx).head = 1 ∧ + (work resIdx).cells = (W resIdx).cells ∧ + (∀ i, i ≠ resIdx → work i = (⟨max (W i).head 1, (W i).cells⟩ : Tape))) + (1 + 1 + (H + 1 + 2)) := by + set WA : Fin (3 + (k + 2) + 0) → Tape := + fun i => (⟨max (W i).head 1, (W i).cells⟩ : Tape) with hWA + have hWAP : ∀ i, Parked (WA i) := fun i => ⟨le_max_right _ _, fun j hj => (hSI i).2 j hj⟩ + have houtP : Parked parkedBlank := parked_parkedBlank + have houtSI : Tape.StartInvariant parkedBlank := startInvariant_initNil.move Dir3.right + have hinpEq : (⟨max inp₀.head 1, inp₀.cells⟩ : Tape) = inp₀ := + Tape.ext (by show max inp₀.head 1 = inp₀.head; have := hinpP.1; omega) rfl + have houtEq : (⟨max parkedBlank.head 1, parkedBlank.cells⟩ : Tape) = parkedBlank := + Tape.ext (by show max parkedBlank.head 1 = parkedBlank.head; have := houtP.1; omega) rfl + have hA' : (skipTM (n := 3 + (k + 2) + 0)).HoareTime + (fun inp work out => inp = inp₀ ∧ work = W ∧ out = parkedBlank) + (fun inp work out => inp = inp₀ ∧ work = WA ∧ out = parkedBlank) 1 := + (parkAll_hoareTime inp₀ W parkedBlank hinpSI hSI houtSI).strengthen_post (by + rintro inp work out ⟨hi, hw, ho⟩ + exact ⟨hi.trans hinpEq, funext hw, ho.trans houtEq⟩) + have hP : ∀ (inp : Tape) (work : Fin (3 + (k + 2) + 0) → Tape) (out : Tape) + (inp' : Tape) (work' : Fin (3 + (k + 2) + 0) → Tape) (out' : Tape), + ((work resIdx).cells = (W resIdx).cells ∧ inp = inp₀ ∧ out = parkedBlank ∧ + ∀ i, i ≠ resIdx → work i = WA i) → + (work' resIdx).cells = (work resIdx).cells → + (work' resIdx).head = 1 → + (∀ i, i ≠ resIdx → work' i = work i) → + inp' = inp → out'.cells = out.cells → out'.head = out.head → + ((work' resIdx).cells = (W resIdx).cells ∧ inp' = inp₀ ∧ out' = parkedBlank ∧ + ∀ i, i ≠ resIdx → work' i = WA i) := by + rintro inp work out inp' work' out' ⟨hc, rfl, rfl, hrest⟩ hc' _ hkeep rfl hoc hoh + exact ⟨hc'.trans hc, rfl, Tape.ext hoh hoc, + fun i hi => (hkeep i hi).trans (hrest i hi)⟩ + have hC := rewindWorkTM_hoareTime_frame (n := 3 + (k + 2) + 0) resIdx (H + 1) + (P := fun inp work out => (work resIdx).cells = (W resIdx).cells ∧ + inp = inp₀ ∧ out = parkedBlank ∧ ∀ i, i ≠ resIdx → work i = WA i) hP + have hpreC : ∀ (inp : Tape) (work : Fin (3 + (k + 2) + 0) → Tape) (out : Tape), + (inp = inp₀ ∧ work = WA ∧ out = parkedBlank) → + ((work resIdx).cells 0 = Γ.start ∧ + (∀ j, j ≥ 1 → (work resIdx).cells j ≠ Γ.start) ∧ + (work resIdx).head ≤ H + 1 ∧ + inp.read ≠ Γ.start ∧ + out.read ≠ Γ.start ∧ out.head ≥ 1 ∧ + (∀ i, i ≠ resIdx → (work i).read ≠ Γ.start ∧ (work i).head ≥ 1) ∧ + ((work resIdx).cells = (W resIdx).cells ∧ inp = inp₀ ∧ out = parkedBlank ∧ + ∀ i, i ≠ resIdx → work i = WA i)) := by + rintro inp work out ⟨hi, hw, ho⟩ + subst hw + refine ⟨(hSI resIdx).1, fun j hj => (hSI resIdx).2 j hj, ?_, + by rw [hi]; exact hinpP.read_ne_start, by rw [ho]; exact houtP.read_ne_start, + by rw [ho]; exact houtP.1, + fun i _ => ⟨(hWAP i).read_ne_start, (hWAP i).1⟩, rfl, hi, ho, fun i _ => rfl⟩ + show max (W resIdx).head 1 ≤ H + 1 + omega + have hC' := hC.weaken_pre hpreC + refine (seqTM_hoareTime _ _ hA' ?_ hC').strengthen_post ?_ + · rintro inp work out ⟨rfl, rfl, rfl⟩ + exact ⟨transitionInput_eq_self hinpP.read_ne_start, + funext fun i => transitionTape_eq_self (hWAP i).read_ne_start, + transitionTape_eq_self houtP.read_ne_start⟩ + · rintro inp work out ⟨hh, hc, hi, ho, hrest⟩ + exact ⟨hi, ho, hh, hc, hrest⟩ + +theorem rfIdx_ne_wfIdx : rfIdx (k := k) ≠ wfIdx := by + intro h; exact absurd (congrArg Fin.val h) (by simp) + +theorem junkIdx_ne_wfIdx : junkIdx (k := k) ≠ wfIdx := by + intro h; exact absurd (congrArg Fin.val h) (by simp) + +theorem resIdx_ne_wfIdx : resIdx (k := k) ≠ wfIdx := fun h => wfIdx_ne_appIdx _ h.symm + +theorem rfIdx_notMem_resetTargets : rfIdx ∉ resetTargets (k := k) := by + rw [mem_resetTargets_iff] + rintro ⟨j, hj⟩ + exact rfIdx_ne_appIdx _ hj.symm + +theorem junkIdx_notMem_resetTargets : junkIdx ∉ resetTargets (k := k) := by + rw [mem_resetTargets_iff] + rintro ⟨j, hj⟩ + exact junkIdx_ne_appIdx _ hj.symm + +/-- **Phase 4 of the body.** Blank the witness machine's scratch tapes and the +virtual-input tape, leaving the result tape (which carries the value being +moved), both fuel registers, and the junk tape exactly as they were. -/ +theorem iterResetScratch_hoareTime (H : ℕ) (hH : 1 ≤ H) + (inp₀ : Tape) (hinpP : Parked inp₀) (hinpSI : Tape.StartInvariant inp₀) + (W : Fin (3 + (k + 2) + 0) → Tape) + (hSI : ∀ i, Tape.StartInvariant (W i)) + (hB : ∀ j : Fin (k + 1), (W (appIdx (Fin.castSucc j))).head ≤ H) + (hfar : ∀ j : Fin (k + 1), ∀ c, H < c → (W (appIdx (Fin.castSucc j))).cells c = Γ.blank) + (hwf : W wfIdx = regTape H) : + (resetTapesTM (resetTargets k) wfIdx).HoareTime + (fun inp work out => inp = inp₀ ∧ out = parkedBlank ∧ + (work resIdx).head = 1 ∧ + (work resIdx).cells = (W resIdx).cells ∧ + (∀ i, i ≠ resIdx → work i = (⟨max (W i).head 1, (W i).cells⟩ : Tape))) + (fun inp work out => inp = inp₀ ∧ out = parkedBlank ∧ + (work resIdx).head = 1 ∧ + (work resIdx).cells = (W resIdx).cells ∧ + (∀ j : Fin (k + 1), work (appIdx (Fin.castSucc j)) = parkedBlank) ∧ + work wfIdx = regTape H ∧ + work rfIdx = (⟨max (W rfIdx).head 1, (W rfIdx).cells⟩ : Tape) ∧ + work junkIdx = (⟨max (W junkIdx).head 1, (W junkIdx).cells⟩ : Tape)) + ((k + 1) * (H + 4) + H * 4 + 8 + 1 + ((k + 1) * (H + 4) + 1)) := by + intro inp work out hpre + obtain ⟨hi, ho, hrh, hrc, hrest⟩ := hpre + rw [hi, ho] + have hworkSI : ∀ j, j ≠ wfIdx → Tape.StartInvariant (work j) := by + intro j _ + by_cases hjr : j = resIdx + · exact ⟨by rw [hjr, hrc]; exact (hSI resIdx).1, + fun c hc => by rw [hjr, hrc]; exact (hSI resIdx).2 c hc⟩ + · rw [hrest j hjr] + exact ⟨(hSI j).1, fun c hc => (hSI j).2 c hc⟩ + have hbnd : ∀ j, j ∈ resetTargets k → + (work j).head ≤ H ∧ ∀ c, H < c → (work j).cells c = Γ.blank := by + intro j hj + obtain ⟨j', rfl⟩ := (mem_resetTargets_iff j).mp hj + have hne : appIdx (Fin.castSucc j') ≠ resIdx := by + intro hc + exact absurd (congrArg Fin.val (appIdx_injective hc)) (by simp; omega) + rw [hrest _ hne] + refine ⟨?_, fun c hc => hfar j' c hc⟩ + show max (W (appIdx (Fin.castSucc j'))).head 1 ≤ H + have := hB j' + omega + have hwfEq : work wfIdx = regTape H := by + rw [hrest wfIdx (fun h => resIdx_ne_wfIdx h.symm), hwf] + refine Tape.ext ?_ rfl + show max (regTape H).head 1 = 1 + rw [regT_head] + omega + obtain ⟨c', t, ht, hreach, hhalt, hi', ho', hts, hR', hkeep⟩ := + resetTapesTM_hoareTime_of_bounds (resetTargets k) resetTargets_nodup wfIdx + wfIdx_notMem_resetTargets H inp₀ work parkedBlank hinpSI hinpP rfl + (fun j hjw hjt => by + by_cases hjr : j = resIdx + · exact ⟨by rw [hjr, hrh], fun c hc => by + rw [hjr, hrc]; exact (hSI resIdx).2 c hc⟩ + · rw [hrest j hjr] + exact ⟨le_max_right _ _, fun c hc => (hSI j).2 c hc⟩) + inp₀ work parkedBlank ⟨rfl, rfl, hworkSI, hbnd, hwfEq, fun _ _ _ => rfl⟩ + rw [resetTargets_length] at ht + refine ⟨c', t, ht, hreach, hhalt, hi', ho', ?_, ?_, ?_, hR', ?_, ?_⟩ + · rw [hkeep resIdx (fun h => resIdx_ne_wfIdx h) resIdx_notMem_resetTargets]; exact hrh + · rw [hkeep resIdx (fun h => resIdx_ne_wfIdx h) resIdx_notMem_resetTargets]; exact hrc + · intro j + exact hts _ ((mem_resetTargets_iff _).mpr ⟨j, rfl⟩) + · rw [hkeep rfIdx rfIdx_ne_wfIdx rfIdx_notMem_resetTargets] + exact hrest rfIdx (fun h => rfIdx_ne_appIdx _ h) + · rw [hkeep junkIdx junkIdx_ne_wfIdx junkIdx_notMem_resetTargets] + exact hrest junkIdx (fun h => junkIdx_ne_appIdx _ h) + +/-- `TM.applyPre` in closed form: the virtual-input tape carries the value, and +every other tape of the block is blank. -/ +theorem applyPre_eq (M : TM k) (x : List Bool) (inp₀ : Tape) (j : Fin (k + 2)) : + TM.applyPre M x inp₀ j = + if j = Fin.castSucc (Fin.last k) then (Tape.init (x.map Γ.ofBool)).move Dir3.right + else parkedBlank := by + refine Fin.lastCases ?_ ?_ j + · rw [TM.applyPre, Fin.snoc_last, if_neg] + intro hc + exact absurd (congrArg Fin.val hc) (by simp) + · intro j' + rw [TM.applyPre, Fin.snoc_castSucc] + show (TM.retargetInputStartedCfg M x inp₀).work j' = _ + rw [TM.retargetInputStartedCfg] + dsimp only + by_cases hj : j' = Fin.last k + · rw [hj, if_neg (by simp), if_pos rfl] + · have hlt : j'.val < k := by + have := j'.isLt + rcases Nat.lt_or_ge j'.val k with h | h + · exact h + · exact absurd (Fin.ext (show j'.val = (Fin.last k).val by + rw [Fin.val_last]; omega)) hj + rw [if_pos hlt, if_neg (fun hc => hj (Fin.castSucc_injective (k + 1) hc))] + rfl + +theorem resIdx_ne_vinIdx : resIdx (k := k) ≠ vinIdx := by + intro h + exact absurd (congrArg Fin.val (appIdx_injective h)) (by simp) + +theorem rfIdx_ne_resIdx : rfIdx (k := k) ≠ resIdx := rfIdx_ne_appIdx _ +theorem junkIdx_ne_resIdx : junkIdx (k := k) ≠ resIdx := junkIdx_ne_appIdx _ +theorem wfIdx_ne_resIdx : wfIdx (k := k) ≠ resIdx := wfIdx_ne_appIdx _ +theorem rfIdx_ne_vinIdx : rfIdx (k := k) ≠ vinIdx := rfIdx_ne_appIdx _ +theorem junkIdx_ne_vinIdx : junkIdx (k := k) ≠ vinIdx := junkIdx_ne_appIdx _ +theorem wfIdx_ne_vinIdx : wfIdx (k := k) ≠ vinIdx := wfIdx_ne_appIdx _ + +theorem junkIdx_ne_rfIdx : junkIdx (k := k) ≠ rfIdx := by + intro h; exact absurd (congrArg Fin.val h) (by simp) + +/-- **Phases 5–6 of the body.** Move the freshly computed value from the result +tape onto the virtual-input tape — where the next application will read it — +and then blank the result tape, restoring `TM.applyPre`'s entry shape for the +new value. -/ +theorem iterFinish_hoareTime (M : TM k) (H : ℕ) + (x : List Bool) (hx : x.length + 1 ≤ H) + (inp₀ : Tape) (hinpP : Parked inp₀) (hinpSI : Tape.StartInvariant inp₀) + (resT rfT junkT : Tape) + (hresH : resT.head = 1) (hresOut : resT.HasOutput x) + (hresSI : Tape.StartInvariant resT) + (hresFar : ∀ c, H < c → resT.cells c = Γ.blank) + (hrfP : Parked rfT) (hrfSI : Tape.StartInvariant rfT) + (hjunkP : Parked junkT) (hjunkSI : Tape.StartInvariant junkT) : + (seqTM (copyToVirtualInputTM resIdx vinIdx) + (resetTapesTM (resetResult k) wfIdx)).HoareTime + (fun inp work out => inp = inp₀ ∧ out = parkedBlank ∧ + work resIdx = resT ∧ work rfIdx = rfT ∧ work junkIdx = junkT ∧ + work wfIdx = regTape H ∧ + (∀ j : Fin (k + 1), work (appIdx (Fin.castSucc j)) = parkedBlank)) + (fun inp work out => inp = inp₀ ∧ out = parkedBlank ∧ + work rfIdx = rfT ∧ work junkIdx = junkT ∧ work wfIdx = regTape H ∧ + (∀ j, work (appIdx j) = TM.applyPre M x inp₀ j)) + (2 * x.length + 5 + 1 + + (1 * (H + 4) + H * 4 + 8 + 1 + (1 * (H + 4) + 1))) := by + have hregP : Parked (regTape H) := + ⟨le_refl 1, fun i hi => by + show regCells H i ≠ Γ.start + simp only [regCells]; split + · omega + · split <;> decide⟩ + have hregSI : Tape.StartInvariant (regTape H) := ⟨rfl, hregP.2⟩ + have houtP : Parked parkedBlank := parked_parkedBlank + have hblankSI : Tape.StartInvariant parkedBlank := startInvariant_initNil.move Dir3.right + -- the tape family entering phase 5 + set W₀ : Fin (3 + (k + 2) + 0) → Tape := fun i => + if i = resIdx then resT else if i = rfIdx then rfT else if i = junkIdx then junkT + else if i = wfIdx then regTape H else parkedBlank with hW₀ + have hW₀SI : ∀ i, Tape.StartInvariant (W₀ i) := by + intro i; rw [hW₀]; dsimp only + split; · exact hresSI + split; · exact hrfSI + split; · exact hjunkSI + split; · exact hregSI + exact hblankSI + have hW₀other : ∀ i, i ≠ resIdx → i ≠ vinIdx → Parked (W₀ i) := by + intro i hir _; rw [hW₀]; dsimp only + rw [if_neg hir] + split; · exact hrfP + split; · exact hjunkP + split; · exact hregP + exact houtP + have hW₀res : W₀ resIdx = resT := by rw [hW₀]; simp + have hW₀vin : W₀ vinIdx = parkedBlank := by + rw [hW₀] + dsimp only + rw [if_neg (fun h => resIdx_ne_vinIdx h.symm), if_neg (fun h => rfIdx_ne_appIdx _ h.symm), + if_neg (fun h => junkIdx_ne_appIdx _ h.symm), if_neg (fun h => wfIdx_ne_appIdx _ h.symm)] + have hW₀app : ∀ j : Fin (k + 2), appIdx j ≠ resIdx → W₀ (appIdx j) = parkedBlank := by + intro j hj + rw [hW₀] + dsimp only + rw [if_neg hj, if_neg (fun h => rfIdx_ne_appIdx _ h.symm), + if_neg (fun h => junkIdx_ne_appIdx _ h.symm), if_neg (fun h => wfIdx_ne_appIdx _ h.symm)] + have hW₀rf : W₀ rfIdx = rfT := by + rw [hW₀] + dsimp only + rw [if_neg rfIdx_ne_resIdx, if_pos rfl] + have hW₀junk : W₀ junkIdx = junkT := by + rw [hW₀] + dsimp only + rw [if_neg junkIdx_ne_resIdx, if_neg junkIdx_ne_rfIdx, if_pos rfl] + have hW₀wf : W₀ wfIdx = regTape H := by + rw [hW₀] + dsimp only + rw [if_neg wfIdx_ne_resIdx, if_neg (fun h => rfIdx_ne_wfIdx h.symm), + if_neg (fun h => junkIdx_ne_wfIdx h.symm), if_pos rfl] + -- the value tape produced by the copy, and the family after each phase + set vinT : Tape := (Tape.init (x.map Γ.ofBool)).move Dir3.right with hvinT + have hvinSI : Tape.StartInvariant vinT := (startInvariant_initOfBool x).move Dir3.right + have hvinP : Parked vinT := ⟨le_refl 1, hvinSI.2⟩ + set W₁ : Fin (3 + (k + 2) + 0) → Tape := + Function.update (Function.update W₀ vinIdx vinT) resIdx + (⟨x.length + 1, (W₀ resIdx).cells⟩ : Tape) with hW₁ + set W₂ : Fin (3 + (k + 2) + 0) → Tape := Function.update W₁ resIdx parkedBlank with hW₂ + have hW₁res : W₁ resIdx = (⟨x.length + 1, resT.cells⟩ : Tape) := by + rw [hW₁, Function.update_self, hW₀res] + have hW₁vin : W₁ vinIdx = vinT := by + rw [hW₁, Function.update_of_ne resIdx_ne_vinIdx.symm, Function.update_self] + have hW₁other : ∀ i, i ≠ resIdx → i ≠ vinIdx → W₁ i = W₀ i := by + intro i hir hiv + rw [hW₁, Function.update_of_ne hir, Function.update_of_ne hiv] + have hW₁P : ∀ i, Parked (W₁ i) := by + intro i + by_cases hir : i = resIdx + · rw [hir, hW₁res] + exact ⟨show 1 ≤ x.length + 1 by omega, fun j hj => hresSI.2 j hj⟩ + · by_cases hiv : i = vinIdx + · rw [hiv, hW₁vin]; exact hvinP + · rw [hW₁other i hir hiv]; exact hW₀other i hir hiv + -- phase 5: the copy + have hcopy := copyToVirtualInputTM_hoareTime resIdx vinIdx resIdx_ne_vinIdx x inp₀ W₀ + parkedBlank (by rw [hW₀res]; exact hresH) (by rw [hW₀res]; exact hresOut) + (by rw [hW₀res]; exact ⟨by omega, fun j hj => hresSI.2 j hj⟩) hW₀vin hinpP houtP hW₀other + -- phase 6: blanking the result tape + have hreset := resetTapesTM_hoareTime (resetResult k) resetResult_nodup wfIdx + wfIdx_notMem_resetResult H inp₀ W₁ parkedBlank hinpSI hinpP rfl + (fun j _ => by + by_cases hjr : j = resIdx + · rw [hjr, hW₁res]; exact ⟨hresSI.1, fun c hc => hresSI.2 c hc⟩ + · by_cases hjv : j = vinIdx + · rw [hjv, hW₁vin]; exact hvinSI + · rw [hW₁other j hjr hjv]; exact hW₀SI j) + (fun j hj => by + rw [List.mem_singleton.mp hj, hW₁res] + show x.length + 1 ≤ H + omega) + (fun j hj c hc => by + rw [List.mem_singleton.mp hj, hW₁res] + exact hresFar c hc) + (by rw [hW₁other wfIdx (fun h => resIdx_ne_wfIdx h.symm) (fun h => wfIdx_ne_appIdx _ h), + hW₀wf]) + (fun j hjw hjt => hW₁P j) + have hreset' : (resetTapesTM (resetResult k) wfIdx).HoareTime + (fun inp work out => inp = inp₀ ∧ work = W₁ ∧ out = parkedBlank) + (fun inp work out => inp = inp₀ ∧ work = W₂ ∧ out = parkedBlank) + (1 * (H + 4) + H * 4 + 8 + 1 + (1 * (H + 4) + 1)) := by + refine (hreset.strengthen_post ?_).mono_bound (by simp [resetResult]) + rintro inp work out ⟨hi, ho, hts, hR, hrest⟩ + refine ⟨hi, funext fun j => ?_, ho⟩ + by_cases hjr : j = resIdx + · rw [hjr, hts resIdx (by simp [resetResult]), hW₂, Function.update_self] + rfl + · rw [hW₂, Function.update_of_ne hjr] + by_cases hjw : j = wfIdx + · rw [hjw, hR, hW₁other wfIdx (fun h => resIdx_ne_wfIdx h.symm) + (fun h => wfIdx_ne_appIdx _ h), hW₀wf] + · exact hrest j hjw (by simp only [resetResult, List.mem_singleton]; exact hjr) + -- chain the two phases and read the result off + have hpre_imp : ∀ (inp : Tape) (work : Fin (3 + (k + 2) + 0) → Tape) (out : Tape), + (inp = inp₀ ∧ out = parkedBlank ∧ + work resIdx = resT ∧ work rfIdx = rfT ∧ work junkIdx = junkT ∧ + work wfIdx = regTape H ∧ + (∀ j : Fin (k + 1), work (appIdx (Fin.castSucc j)) = parkedBlank)) → + (inp = inp₀ ∧ work = W₀ ∧ out = parkedBlank) := by + rintro inp work out ⟨hi, ho, hres, hrf, hjunk, hwf, happ⟩ + refine ⟨hi, funext fun i => ?_, ho⟩ + rcases layout_cases i with hi' | hi' | hi' | ⟨j, hi'⟩ + · rw [hi', hrf, hW₀rf] + · rw [hi', hwf, hW₀wf] + · rw [hi', hjunk, hW₀junk] + · subst hi' + refine Fin.lastCases ?_ ?_ j + · rw [show appIdx (Fin.last (k + 1)) = resIdx from rfl, hres, hW₀res] + · intro j' + rw [happ j', hW₀app _ (fun h => absurd (appIdx_injective h) + (Fin.castSucc_lt_last j').ne)] + refine (((seqTM_det (copyToVirtualInputTM resIdx vinIdx) + (resetTapesTM (resetResult k) wfIdx) hinpP houtP hW₁P hcopy + hreset').weaken_pre hpre_imp).strengthen_post ?_).mono_bound le_rfl + · rintro inp work out ⟨hi, hw, ho⟩ + subst hw + refine ⟨hi, ho, ?_, ?_, ?_, fun j => ?_⟩ + · rw [hW₂, Function.update_of_ne rfIdx_ne_resIdx, + hW₁other rfIdx rfIdx_ne_resIdx rfIdx_ne_vinIdx, hW₀rf] + · rw [hW₂, Function.update_of_ne junkIdx_ne_resIdx, + hW₁other junkIdx junkIdx_ne_resIdx junkIdx_ne_vinIdx, hW₀junk] + · rw [hW₂, Function.update_of_ne wfIdx_ne_resIdx, + hW₁other wfIdx wfIdx_ne_resIdx wfIdx_ne_vinIdx, hW₀wf] + · rw [applyPre_eq] + by_cases hj : j = Fin.castSucc (Fin.last k) + · rw [if_pos hj, hj, show appIdx (Fin.castSucc (Fin.last k)) = vinIdx from rfl, + hW₂, Function.update_of_ne resIdx_ne_vinIdx.symm, hW₁vin] + · rw [if_neg hj] + by_cases hjl : j = Fin.last (k + 1) + · rw [hjl, show appIdx (Fin.last (k + 1)) = resIdx from rfl, hW₂, Function.update_self] + · have hjr : appIdx j ≠ resIdx := fun h => + hjl (appIdx_injective (h.trans (rfl : resIdx = appIdx (Fin.last (k + 1))))) + have hjv : appIdx j ≠ vinIdx := fun h => + hj (appIdx_injective (h.trans (rfl : vinIdx = appIdx (Fin.castSucc (Fin.last k))))) + rw [hW₂, Function.update_of_ne hjr, hW₁other _ hjr hjv, hW₀app j hjr] + + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/MulLen.lean b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/MulLen.lean new file mode 100644 index 0000000000..e69a650f12 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/MulLen.lean @@ -0,0 +1,718 @@ +/- +Copyright (c) 2026 Bolton Bailey. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Bolton Bailey +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Defs +public import LeanPool.BeyondBethe.Complexitylib.Encoding.Pairing +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Registers +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Tape.Encoding + +/-! +# Multiplying the block lengths of a pair — proof internals + +This module builds the one quadratic-output transducer needed by Cobham's +soundness direction: from `pair A B` it emits `|A| · |B|` copies of `false`, +which is exactly the length behaviour of `Complexity.smash`. The soundness proof +then applies `unaryLength_mem_FP` to turn this internal zero-filled ruler into +Cobham's all-one smash word. + +The machine `mulLenTM` is self-contained (one work tape, eight control states): + +1. *scan* — parse the leading self-delimiting block two symbols at a time, + writing one unary mark on the work tape per payload bit, so the work tape + ends up holding `|A|` in unary; +2. *outer loop* — for every remaining input symbol (i.e. `|B|` times) run the + *emit* pass, which walks the `|A|` marks writing one `false` per mark, and + the *rewind* pass, which returns the work head to cell one. + +Malformed input halts with empty output, matching `unpair? = none`. + +## Main results + +- `Complexity.Cobham.mulUnpair_mem_FP` — the block-length product is `FP` +-/ + + +@[expose] public section + +namespace Complexity + +namespace Cobham + +open Complexity.TM + +/-! ## The function computed by the scanner -/ + +/-- The remaining output of the length-multiplication scanner when `k` payload +bits of the leading block have already been counted and `w` is the unread part +of the input: `|A| · |B|` copies of `false` for a well-formed remainder, and +nothing at all when the block framing is broken. -/ +def mulAux (k : ℕ) (w : List Bool) : List Bool := + match unpair? w with + | some (x, y) => List.replicate ((k + x.length) * y.length) false + | none => [] + +/-- Emit `|A| · |B|` copies of `false` from a pair `pair A B`; the empty string +on input that is not a valid pair encoding. -/ +def mulUnpair (p : List Bool) : List Bool := mulAux 0 p + +@[simp] theorem mulAux_nil (k : ℕ) : mulAux k [] = [] := rfl + +@[simp] theorem mulAux_singleton (k : ℕ) (b : Bool) : mulAux k [b] = [] := by + cases b <;> rfl + +/-- Reaching the separator ends the block: only the suffix remains. -/ +@[simp] theorem mulAux_sep (k : ℕ) (z : List Bool) : + mulAux k (false :: true :: z) = List.replicate (k * z.length) false := by + simp [mulAux, unpair?] + +/-- A doubled payload bit increments the counted length. -/ +theorem mulAux_double (k : ℕ) (b : Bool) (z : List Bool) : + mulAux k (b :: b :: z) = mulAux (k + 1) z := by + cases b <;> + · simp only [mulAux, unpair?] + cases h : unpair? z with + | none => simp + | some xy => + obtain ⟨x, y⟩ := xy + simp only [Option.map_some, List.length_cons] + congr 2 + omega + +/-- A broken doubling halts the scan with no output. -/ +@[simp] theorem mulAux_broken (k : ℕ) (z : List Bool) : + mulAux k (true :: false :: z) = [] := rfl + +/-- On a genuine pair the scanner emits `|A| · |B|` copies of `false`. -/ +theorem mulUnpair_pair (A B : List Bool) : + mulUnpair (pair A B) = List.replicate (A.length * B.length) false := by + simp [mulUnpair, mulAux] + +/-! ## The scanner -/ + +section MulLenMachine + +/-- Control states of `mulLenTM`. -/ +inductive MulPhase where + /-- Move every head off the left-end marker. -/ + | skip + /-- Read the first symbol of a doubled payload bit. -/ + | scanA + /-- The first symbol of the pair was `0`. -/ + | scanB0 + /-- The first symbol of the pair was `1`. -/ + | scanB1 + /-- Consume one symbol of the suffix, or halt at its end. -/ + | outer + /-- Walk the unary marks, emitting one `false` per mark. -/ + | emit + /-- Rewind the work head to cell one. -/ + | rew + /-- Halt. -/ + | done + deriving DecidableEq + +instance : Fintype MulPhase where + elems := {.skip, .scanA, .scanB0, .scanB1, .outer, .emit, .rew, .done} + complete := fun x => by cases x <;> simp + +/-- **The length-multiplication scanner.** Parses the leading self-delimiting +block into `|A|` unary marks on its work tape, then emits `|A|` zeros for each +of the `|B|` remaining input symbols. Computes `mulUnpair`. -/ +def mulLenTM : TM 1 where + Q := MulPhase + qstart := .skip + qhalt := .done + δ := fun state iHead wHeads oHead => + match state with + | .skip => + (.scanA, fun i => readBackWrite (wHeads i), readBackWrite oHead, + Dir3.right, fun _ => Dir3.right, Dir3.right) + | .scanA => + match iHead with + | Γ.zero => + (.scanB0, fun i => readBackWrite (wHeads i), readBackWrite oHead, + Dir3.right, fun i => idleDir (wHeads i), idleDir oHead) + | Γ.one => + (.scanB1, fun i => readBackWrite (wHeads i), readBackWrite oHead, + Dir3.right, fun i => idleDir (wHeads i), idleDir oHead) + | _ => + (.done, fun i => readBackWrite (wHeads i), readBackWrite oHead, + idleDir iHead, fun i => idleDir (wHeads i), idleDir oHead) + | .scanB0 => + match iHead with + | Γ.zero => + (.scanA, fun _ => Γw.one, readBackWrite oHead, + Dir3.right, fun _ => Dir3.right, idleDir oHead) + | Γ.one => + (.rew, fun i => readBackWrite (wHeads i), readBackWrite oHead, + Dir3.right, fun i => idleDir (wHeads i), idleDir oHead) + | _ => + (.done, fun i => readBackWrite (wHeads i), readBackWrite oHead, + idleDir iHead, fun i => idleDir (wHeads i), idleDir oHead) + | .scanB1 => + match iHead with + | Γ.one => + (.scanA, fun _ => Γw.one, readBackWrite oHead, + Dir3.right, fun _ => Dir3.right, idleDir oHead) + | _ => + (.done, fun i => readBackWrite (wHeads i), readBackWrite oHead, + idleDir iHead, fun i => idleDir (wHeads i), idleDir oHead) + | .outer => + if iHead = Γ.blank then + (.done, fun i => readBackWrite (wHeads i), readBackWrite oHead, + idleDir iHead, fun i => idleDir (wHeads i), idleDir oHead) + else + (.emit, fun i => readBackWrite (wHeads i), readBackWrite oHead, + Dir3.right, fun i => idleDir (wHeads i), idleDir oHead) + | .emit => + if wHeads 0 = Γ.one then + (.emit, fun i => readBackWrite (wHeads i), Γw.zero, + idleDir iHead, fun _ => Dir3.right, Dir3.right) + else + (.rew, fun i => readBackWrite (wHeads i), readBackWrite oHead, + idleDir iHead, fun i => idleDir (wHeads i), idleDir oHead) + | .rew => + if wHeads 0 = Γ.start then + (.outer, fun i => readBackWrite (wHeads i), readBackWrite oHead, + idleDir iHead, fun _ => Dir3.right, idleDir oHead) + else + (.rew, fun i => readBackWrite (wHeads i), readBackWrite oHead, + idleDir iHead, fun i => moveLeftDir (wHeads i), idleDir oHead) + | .done => allIdle .done iHead wHeads oHead + δ_right_of_start := by + intro state iHead wHeads oHead + match state with + | .skip => exact ⟨fun _ => rfl, fun _ _ => rfl, fun _ => rfl⟩ + | .scanA => + cases iHead <;> + exact ⟨by first | exact fun _ => rfl | exact idleDir_right_of_start, + fun _ => idleDir_right_of_start, + by first | exact fun _ => rfl | exact idleDir_right_of_start⟩ + | .scanB0 => + cases iHead <;> + exact ⟨by first | exact fun _ => rfl | exact idleDir_right_of_start, + by first | exact fun _ _ => rfl | exact fun _ => idleDir_right_of_start, + by first | exact fun _ => rfl | exact idleDir_right_of_start⟩ + | .scanB1 => + cases iHead <;> + exact ⟨by first | exact fun _ => rfl | exact idleDir_right_of_start, + by first | exact fun _ _ => rfl | exact fun _ => idleDir_right_of_start, + by first | exact fun _ => rfl | exact idleDir_right_of_start⟩ + | .outer => + dsimp only [] + split + · exact ⟨idleDir_right_of_start, fun _ => idleDir_right_of_start, + idleDir_right_of_start⟩ + · exact ⟨fun _ => rfl, fun _ => idleDir_right_of_start, + idleDir_right_of_start⟩ + | .emit => + dsimp only [] + split + · exact ⟨idleDir_right_of_start, fun _ _ => rfl, fun _ => rfl⟩ + · exact ⟨idleDir_right_of_start, fun _ => idleDir_right_of_start, + idleDir_right_of_start⟩ + | .rew => + dsimp only [] + split + · exact ⟨idleDir_right_of_start, fun _ _ => rfl, idleDir_right_of_start⟩ + · exact ⟨idleDir_right_of_start, fun _ => moveLeftDir_right_of_start, + idleDir_right_of_start⟩ + | .done => exact rightOfStart_allIdle iHead wHeads oHead + +/-! ## Correctness of the scanner -/ + +/-- A content-preserving idle step on a tape whose head is off the left marker. -/ +private theorem idle_eq {t : Tape} (h : t.read ≠ Γ.start) : + t.writeAndMove (readBackWrite t.read) (idleDir t.read) = t := by + rw [writeAndMove_readBack t h, idleDir, if_neg h, Tape.move] + +/-- The emit pass: from `emit`, with `m` marks on the work tape and the work +head at cell `k + 1`, the machine writes one `false` for each of the `r` +remaining marks and enters `rew` with the work head past the last mark. -/ +private theorem mulLenTM_emit_loop : + ∀ (r k m : ℕ), k + r = m → ∀ (acc : List Bool) (c : Cfg 1 mulLenTM.Q), + c.state = MulPhase.emit → + (c.work 0).cells = regCells m → + (c.work 0).head = k + 1 → + c.input.read ≠ Γ.start → + c.output.HasBinaryPrefix acc → + ∃ c', mulLenTM.reachesIn (r + 1) c c' ∧ + c'.state = MulPhase.rew ∧ + (c'.work 0).cells = regCells m ∧ + (c'.work 0).head = m + 1 ∧ + c'.input = c.input ∧ + c'.output.HasBinaryPrefix (acc ++ List.replicate r false) := by + intro r + induction r with + | zero => + intro k m hkm acc c hstate hcells hhead hinp hpre + have hwread : (c.work 0).read = Γ.blank := by + rw [Tape.read, hcells, hhead]; exact regCells_blank (by omega) + have hwne : (c.work 0).read ≠ Γ.start := by rw [hwread]; decide + have houtne : c.output.read ≠ Γ.start := by rw [hpre.read_blank]; decide + have hinp_eq : c.input.move (idleDir c.input.read) = c.input := by + rw [idleDir, if_neg hinp, Tape.move] + refine ⟨{ state := MulPhase.rew + input := c.input + work := c.work + output := c.output }, ?_, rfl, hcells, by rw [hhead]; omega, rfl, by simpa⟩ + refine .step ?_ .zero + have hwork : (fun i => (c.work i).writeAndMove (readBackWrite ((c.work i).read)) + (idleDir ((c.work i).read))) = c.work := by + funext i + have : i = 0 := Subsingleton.elim i 0 + subst this + exact idle_eq hwne + simp only [TM.step, hstate, mulLenTM, hwread, hinp_eq, reduceCtorEq, if_false] + rw [hwork, idle_eq houtne] + | succ r ih => + intro k m hkm acc c hstate hcells hhead hinp hpre + have hwread : (c.work 0).read = Γ.one := by + rw [Tape.read, hcells, hhead]; exact regCells_one (by omega) (by omega) + have hwne : (c.work 0).read ≠ Γ.start := by rw [hwread]; decide + have hinp_eq : c.input.move (idleDir c.input.read) = c.input := by + rw [idleDir, if_neg hinp, Tape.move] + set c1 : Cfg 1 mulLenTM.Q := + { state := MulPhase.emit + input := c.input + work := fun i => (c.work i).move Dir3.right + output := c.output.writeAndMove (Γ.ofBool false) Dir3.right } with hc1 + have hwork : (fun i => (c.work i).writeAndMove (readBackWrite ((c.work i).read)).toΓ + Dir3.right) = fun i => (c.work i).move Dir3.right := by + funext i + have hi : i = 0 := Subsingleton.elim i 0 + subst hi + exact writeAndMove_readBack _ hwne _ + have hstep : mulLenTM.step c = some c1 := by + simp only [TM.step, hstate, mulLenTM, hwread, hinp_eq, hc1, reduceCtorEq, if_false, + reduceIte] + rw [hwork] + rfl + obtain ⟨c', hreach, hst, hcl, hhd, hin, hout⟩ := + ih (k + 1) m (by omega) (acc ++ [false]) c1 rfl + (by rw [hc1]; simpa using hcells) + (by rw [hc1]; simp [Tape.move, hhead]) + (by rw [hc1]; simpa using hinp) + (by rw [hc1]; exact Tape.hasBinaryPrefix_write_bit false hpre) + refine ⟨c', .step hstep hreach, hst, hcl, hhd, by rw [hin, hc1], ?_⟩ + rw [List.append_assoc] at hout + simpa using hout + +/-- The rewind pass: from `rew` with the work head at cell `h`, the machine walks +back to the left-end marker and re-enters `outer` with the work head at cell one, +leaving every tape's contents untouched. -/ +private theorem mulLenTM_rew_loop : + ∀ (h m : ℕ) (c : Cfg 1 mulLenTM.Q), + c.state = MulPhase.rew → + (c.work 0).cells = regCells m → + (c.work 0).head = h → + c.input.read ≠ Γ.start → + c.output.read ≠ Γ.start → + ∃ c', mulLenTM.reachesIn (h + 1) c c' ∧ + c'.state = MulPhase.outer ∧ + (c'.work 0).cells = regCells m ∧ + (c'.work 0).head = 1 ∧ + c'.input = c.input ∧ + c'.output = c.output := by + intro h + induction h with + | zero => + intro m c hstate hcells hhead hinp hout + have hwread : (c.work 0).read = Γ.start := by + rw [Tape.read, hcells, hhead]; rfl + have hinp_eq : c.input.move (idleDir c.input.read) = c.input := by + rw [idleDir, if_neg hinp, Tape.move] + have hwork : (fun i => (c.work i).writeAndMove (readBackWrite ((c.work i).read)).toΓ + Dir3.right) = fun i => (c.work i).move Dir3.right := by + funext i + have hi : i = 0 := Subsingleton.elim i 0 + subst hi + show ((c.work 0).write _).move Dir3.right = (c.work 0).move Dir3.right + rw [Tape.write, if_pos hhead] + refine ⟨{ state := MulPhase.outer + input := c.input + work := fun i => (c.work i).move Dir3.right + output := c.output }, ?_, rfl, by simp [Tape.move_cells, hcells], + by simp [Tape.move, hhead], rfl, rfl⟩ + refine .step ?_ .zero + simp only [TM.step, hstate, mulLenTM, hwread, hinp_eq, reduceIte, reduceCtorEq, + if_false] + rw [hwork, idle_eq hout] + | succ h ih => + intro m c hstate hcells hhead hinp hout + have hwne : (c.work 0).read ≠ Γ.start := by + rw [Tape.read, hcells, hhead]; exact regCells_ne_start (by omega) + have hinp_eq : c.input.move (idleDir c.input.read) = c.input := by + rw [idleDir, if_neg hinp, Tape.move] + set c1 : Cfg 1 mulLenTM.Q := + { state := MulPhase.rew + input := c.input + work := fun i => (c.work i).move Dir3.left + output := c.output } with hc1 + have hwork : (fun i => (c.work i).writeAndMove (readBackWrite ((c.work i).read)).toΓ + (moveLeftDir ((c.work i).read))) = fun i => (c.work i).move Dir3.left := by + funext i + have hi : i = 0 := Subsingleton.elim i 0 + subst hi + rw [moveLeftDir, if_neg hwne] + exact writeAndMove_readBack _ hwne _ + have hstep : mulLenTM.step c = some c1 := by + simp only [TM.step, hstate, mulLenTM, hinp_eq, hc1, if_neg hwne, reduceCtorEq, + if_false] + rw [hwork, idle_eq hout] + obtain ⟨c', hreach, hst, hcl, hhd, hin, hou⟩ := + ih m c1 rfl (by rw [hc1]; simpa [Tape.move_cells] using hcells) + (by rw [hc1]; simp [Tape.move, hhead]) + (by rw [hc1]; simpa using hinp) (by rw [hc1]; simpa using hout) + exact ⟨c', .step hstep hreach, hst, hcl, hhd, by rw [hin, hc1], by rw [hou, hc1]⟩ + +/-- The outer loop: from `outer`, with `m` marks on the work tape and `B` left to +read, the machine runs one emit-and-rewind pass per symbol of `B` and halts with +`|B| · m` zeros appended to the output. -/ +private theorem mulLenTM_outer_loop : + ∀ (B : List Bool) (m : ℕ) (acc : List Bool) (c : Cfg 1 mulLenTM.Q), + c.state = MulPhase.outer → + (c.work 0).cells = regCells m → + (c.work 0).head = 1 → + c.input.HasBinarySuffix B → + c.output.HasBinaryPrefix acc → + ∃ c' t, t ≤ B.length * (2 * m + 4) + 1 ∧ mulLenTM.reachesIn t c c' ∧ + mulLenTM.halted c' ∧ + c'.output.HasBinaryPrefix (acc ++ List.replicate (B.length * m) false) := by + intro B + induction B with + | nil => + intro m acc c hstate hcells hhead hsuf hpre + have hread : c.input.read = Γ.blank := hsuf.read_nil + have hinp : c.input.read ≠ Γ.start := by rw [hread]; decide + have hwne : (c.work 0).read ≠ Γ.start := by + rw [Tape.read, hcells, hhead]; exact regCells_ne_start (by omega) + have houtne : c.output.read ≠ Γ.start := by rw [hpre.read_blank]; decide + have hinp_eq : c.input.move (idleDir Γ.blank) = c.input := by + rw [idleDir, if_neg (by decide), Tape.move] + have hwork : (fun i => (c.work i).writeAndMove (readBackWrite ((c.work i).read)).toΓ + (idleDir ((c.work i).read))) = c.work := by + funext i + have hi : i = 0 := Subsingleton.elim i 0 + subst hi + exact idle_eq hwne + refine ⟨{ state := MulPhase.done + input := c.input + work := c.work + output := c.output }, 1, by omega, ?_, rfl, by simpa using hpre⟩ + refine .step ?_ .zero + simp only [TM.step, hstate, mulLenTM, hread, hinp_eq, reduceIte, reduceCtorEq, + if_false] + rw [hwork, idle_eq houtne] + | cons b B ih => + intro m acc c hstate hcells hhead hsuf hpre + have hread : c.input.read = Γ.ofBool b := hsuf.read_cons + have hnb : ¬ c.input.read = Γ.blank := by rw [hread]; cases b <;> decide + have hwne : (c.work 0).read ≠ Γ.start := by + rw [Tape.read, hcells, hhead]; exact regCells_ne_start (by omega) + have houtne : c.output.read ≠ Γ.start := by rw [hpre.read_blank]; decide + have hwork : (fun i => (c.work i).writeAndMove (readBackWrite ((c.work i).read)).toΓ + (idleDir ((c.work i).read))) = c.work := by + funext i + have hi : i = 0 := Subsingleton.elim i 0 + subst hi + exact idle_eq hwne + set c1 : Cfg 1 mulLenTM.Q := + { state := MulPhase.emit + input := c.input.move Dir3.right + work := c.work + output := c.output } with hc1 + have hstep : mulLenTM.step c = some c1 := by + simp only [TM.step, hstate, mulLenTM, hnb, hc1, reduceCtorEq, if_false] + rw [hwork, idle_eq houtne] + have hsuf1 : c1.input.HasBinarySuffix B := hsuf.move_right_cons + obtain ⟨c2, hreach2, hst2, hcl2, hhd2, hin2, hout2⟩ := + mulLenTM_emit_loop m 0 m (by omega) acc c1 rfl (by rw [hc1]; exact hcells) + (by rw [hc1]; simpa using hhead) hsuf1.read_ne_start (by rw [hc1]; exact hpre) + obtain ⟨c3, hreach3, hst3, hcl3, hhd3, hin3, hout3⟩ := + mulLenTM_rew_loop (m + 1) m c2 hst2 hcl2 hhd2 + (by rw [hin2]; exact hsuf1.read_ne_start) + (by rw [hout2.read_blank]; decide) + obtain ⟨c', t, ht, hreach', hhalt', hout'⟩ := + ih m (acc ++ List.replicate m false) c3 hst3 hcl3 hhd3 + (by rw [hin3, hin2]; exact hsuf1) (by rw [hout3]; exact hout2) + refine ⟨c', (m + 1 + (m + 1 + 1 + t)) + 1, ?_, ?_, hhalt', ?_⟩ + · simp only [List.length_cons] + have : (B.length + 1) * (2 * m + 4) = B.length * (2 * m + 4) + (2 * m + 4) := by ring + omega + · exact .step hstep + (mulLenTM.reachesIn_trans hreach2 (mulLenTM.reachesIn_trans hreach3 hreach')) + · rw [List.append_assoc, ← List.replicate_add] at hout' + have : m + B.length * m = (b :: B).length * m := by + simp only [List.length_cons]; ring + rwa [this] at hout' + +/-- The scan pass: from `scanA`, with `k` payload bits already counted as marks on +the work tape and `w` still unread, the machine runs the rest of the computation +and halts with `mulAux k w` on the output tape. The parameter `N` is a fuel bound +on `k + |w|`, which strictly decreases across the recursive step. -/ +private theorem mulLenTM_scan_loop : + ∀ (N : ℕ) (w : List Bool) (k : ℕ), k + w.length ≤ N → + ∀ (c : Cfg 1 mulLenTM.Q), + c.state = MulPhase.scanA → + (c.work 0).cells = regCells k → + (c.work 0).head = k + 1 → + c.input.HasBinarySuffix w → + c.output.HasBinaryPrefix [] → + ∃ c' t, t ≤ 2 * N ^ 2 + 5 * N + 5 ∧ mulLenTM.reachesIn t c c' ∧ + mulLenTM.halted c' ∧ + c'.output.HasBinaryPrefix (mulAux k w) := by + intro N + induction N with + | zero => + intro w k hN c hstate hcells hhead hsuf hpre + have hwnil : w = [] := List.length_eq_zero_iff.mp (by omega) + subst hwnil + have hwne : (c.work 0).read ≠ Γ.start := by + rw [Tape.read, hcells, hhead]; exact regCells_ne_start (by omega) + have houtne : c.output.read ≠ Γ.start := by rw [hpre.read_blank]; decide + have hwork : (fun i => (c.work i).writeAndMove (readBackWrite ((c.work i).read)).toΓ + (idleDir ((c.work i).read))) = c.work := by + funext i + have hi : i = 0 := Subsingleton.elim i 0 + subst hi + exact idle_eq hwne + have hread : c.input.read = Γ.blank := hsuf.read_nil + have hinp_eq : c.input.move (idleDir Γ.blank) = c.input := by + rw [idleDir, if_neg (by decide), Tape.move] + refine ⟨{ state := MulPhase.done + input := c.input + work := c.work + output := c.output }, 1, by omega, ?_, rfl, by simpa using hpre⟩ + refine .step ?_ .zero + simp only [TM.step, hstate, mulLenTM, hread, hinp_eq, reduceCtorEq, if_false] + rw [hwork, idle_eq houtne] + | succ N ih => + intro w k hN c hstate hcells hhead hsuf hpre + have hwne : (c.work 0).read ≠ Γ.start := by + rw [Tape.read, hcells, hhead]; exact regCells_ne_start (by omega) + have houtne : c.output.read ≠ Γ.start := by rw [hpre.read_blank]; decide + have hwork : (fun i => (c.work i).writeAndMove (readBackWrite ((c.work i).read)).toΓ + (idleDir ((c.work i).read))) = c.work := by + funext i + have hi : i = 0 := Subsingleton.elim i 0 + subst hi + exact idle_eq hwne + have hidleB : ∀ t : Tape, t.move (idleDir Γ.blank) = t := by + intro t; rw [idleDir, if_neg (by decide)]; rfl + have hidleZ : ∀ t : Tape, t.move (idleDir Γ.zero) = t := by + intro t; rw [idleDir, if_neg (by decide)]; rfl + -- The one-step transition out of `scanA` on a payload bit. + have hstepA : ∀ b : Bool, + c.input.read = Γ.ofBool b → + mulLenTM.step c = some + { state := (bif b then MulPhase.scanB1 else MulPhase.scanB0) + input := c.input.move Dir3.right + work := c.work + output := c.output } := by + intro b hread + cases b <;> + · simp only [TM.step, hstate, mulLenTM, hread, Γ.ofBool, reduceCtorEq, if_false, + cond_true, cond_false] + rw [hwork, idle_eq houtne] + match w with + | [] => + have hread : c.input.read = Γ.blank := hsuf.read_nil + refine ⟨{ state := MulPhase.done + input := c.input + work := c.work + output := c.output }, 1, by omega, ?_, rfl, by simpa using hpre⟩ + refine .step ?_ .zero + simp only [TM.step, hstate, mulLenTM, hread, hidleB, reduceCtorEq, if_false] + rw [hwork, idle_eq houtne] + | [b] => + -- One payload symbol then end of input: the block framing is broken. + have hsuf1 : (c.input.move Dir3.right).HasBinarySuffix [] := hsuf.move_right_cons + have hread1 : (c.input.move Dir3.right).read = Γ.blank := hsuf1.read_nil + refine ⟨{ state := MulPhase.done + input := c.input.move Dir3.right + work := c.work + output := c.output }, 2, by omega, ?_, rfl, by + simpa [mulAux_singleton] using hpre⟩ + refine .step (hstepA b hsuf.read_cons) (.step ?_ .zero) + cases b <;> + · simp only [TM.step, mulLenTM, hread1, hidleB, reduceCtorEq, if_false, + cond_true, cond_false] + rw [hwork, idle_eq houtne] + | true :: false :: z => + -- A broken doubling: halt with empty output. + have hsuf1 : (c.input.move Dir3.right).HasBinarySuffix (false :: z) := + hsuf.move_right_cons + have hread1 : (c.input.move Dir3.right).read = Γ.zero := hsuf1.read_cons + refine ⟨{ state := MulPhase.done + input := c.input.move Dir3.right + work := c.work + output := c.output }, 2, by omega, ?_, rfl, by + simpa [mulAux_broken] using hpre⟩ + refine .step (hstepA true hsuf.read_cons) (.step ?_ .zero) + simp only [TM.step, mulLenTM, hread1, hidleZ, reduceCtorEq, if_false, + cond_true] + rw [hwork, idle_eq houtne] + | false :: true :: z => + -- The separator: rewind the work tape and run the outer loop over `z`. + have hsuf1 : (c.input.move Dir3.right).HasBinarySuffix (true :: z) := + hsuf.move_right_cons + have hread1 : (c.input.move Dir3.right).read = Γ.one := hsuf1.read_cons + set c1 : Cfg 1 mulLenTM.Q := + { state := MulPhase.scanB0 + input := c.input.move Dir3.right + work := c.work + output := c.output } with hc1 + have hstep1 : mulLenTM.step c = some c1 := hstepA false hsuf.read_cons + set c2 : Cfg 1 mulLenTM.Q := + { state := MulPhase.rew + input := (c.input.move Dir3.right).move Dir3.right + work := c.work + output := c.output } with hc2 + have hstep2 : mulLenTM.step c1 = some c2 := by + simp only [TM.step, hc1, hc2, mulLenTM, hread1, reduceCtorEq, if_false] + rw [hwork, idle_eq houtne] + have hsuf2 : c2.input.HasBinarySuffix z := hsuf1.move_right_cons + obtain ⟨c3, hreach3, hst3, hcl3, hhd3, hin3, hou3⟩ := + mulLenTM_rew_loop (k + 1) k c2 rfl (by rw [hc2]; exact hcells) + (by rw [hc2]; exact hhead) hsuf2.read_ne_start (by rw [hc2]; exact houtne) + obtain ⟨c', t, ht, hreach', hhalt', hout'⟩ := + mulLenTM_outer_loop z k [] c3 hst3 hcl3 hhd3 (by rw [hin3]; exact hsuf2) + (by rw [hou3]; exact hpre) + refine ⟨c', (k + 1 + 1 + t) + 1 + 1, ?_, ?_, hhalt', ?_⟩ + · simp only [List.length_cons] at hN + have hz : z.length ≤ N := by omega + have hk : k ≤ N := by omega + have ht' : t ≤ z.length * (2 * k + 4) + 1 := ht + have : z.length * (2 * k + 4) ≤ N * (2 * N + 4) := by + exact Nat.mul_le_mul hz (by omega) + nlinarith [sq_nonneg N] + · exact .step hstep1 (.step hstep2 (mulLenTM.reachesIn_trans hreach3 hreach')) + · rw [mulAux_sep] + have : z.length * k = k * z.length := Nat.mul_comm _ _ + rw [this] at hout' + simpa using hout' + | false :: false :: z => + -- A doubled `0`: write one mark and continue scanning. + have hsuf1 : (c.input.move Dir3.right).HasBinarySuffix (false :: z) := + hsuf.move_right_cons + have hread1 : (c.input.move Dir3.right).read = Γ.zero := hsuf1.read_cons + set c1 : Cfg 1 mulLenTM.Q := + { state := MulPhase.scanB0 + input := c.input.move Dir3.right + work := c.work + output := c.output } with hc1 + have hstep1 : mulLenTM.step c = some c1 := hstepA false hsuf.read_cons + set c2 : Cfg 1 mulLenTM.Q := + { state := MulPhase.scanA + input := (c.input.move Dir3.right).move Dir3.right + work := fun i => ((c.work i).write Γ.one).move Dir3.right + output := c.output } with hc2 + have hwmark : (fun i => (c.work i).writeAndMove (Γw.one).toΓ Dir3.right) + = fun i => ((c.work i).write Γ.one).move Dir3.right := rfl + have hstep2 : mulLenTM.step c1 = some c2 := by + simp only [TM.step, hc1, hc2, mulLenTM, hread1, reduceCtorEq, if_false] + rw [hwmark, idle_eq houtne] + have hcells2 : (c2.work 0).cells = regCells (k + 1) := by + rw [hc2] + show (((c.work 0).write Γ.one).move Dir3.right).cells = _ + rw [Tape.move_cells, Tape.write, if_neg (by rw [hhead]; omega)] + show Function.update (c.work 0).cells ((c.work 0).head) Γ.one = _ + rw [hcells, hhead, regCells_update_succ] + have hhead2 : (c2.work 0).head = k + 1 + 1 := by + rw [hc2] + show (((c.work 0).write Γ.one).move Dir3.right).head = _ + rw [Tape.move, Tape.write_head, hhead] + obtain ⟨c', t, ht, hreach', hhalt', hout'⟩ := + ih z (k + 1) (by simp only [List.length_cons] at hN; omega) c2 rfl hcells2 hhead2 + (by rw [hc2]; exact hsuf1.move_right_cons) (by rw [hc2]; exact hpre) + refine ⟨c', t + 1 + 1, ?_, .step hstep1 (.step hstep2 hreach'), hhalt', ?_⟩ + · nlinarith [sq_nonneg N] + · rwa [mulAux_double] + | true :: true :: z => + -- A doubled `1`: write one mark and continue scanning. + have hsuf1 : (c.input.move Dir3.right).HasBinarySuffix (true :: z) := + hsuf.move_right_cons + have hread1 : (c.input.move Dir3.right).read = Γ.one := hsuf1.read_cons + set c1 : Cfg 1 mulLenTM.Q := + { state := MulPhase.scanB1 + input := c.input.move Dir3.right + work := c.work + output := c.output } with hc1 + have hstep1 : mulLenTM.step c = some c1 := hstepA true hsuf.read_cons + set c2 : Cfg 1 mulLenTM.Q := + { state := MulPhase.scanA + input := (c.input.move Dir3.right).move Dir3.right + work := fun i => ((c.work i).write Γ.one).move Dir3.right + output := c.output } with hc2 + have hwmark : (fun i => (c.work i).writeAndMove (Γw.one).toΓ Dir3.right) + = fun i => ((c.work i).write Γ.one).move Dir3.right := rfl + have hstep2 : mulLenTM.step c1 = some c2 := by + simp only [TM.step, hc1, hc2, mulLenTM, hread1, reduceCtorEq, if_false] + rw [hwmark, idle_eq houtne] + have hcells2 : (c2.work 0).cells = regCells (k + 1) := by + rw [hc2] + show (((c.work 0).write Γ.one).move Dir3.right).cells = _ + rw [Tape.move_cells, Tape.write, if_neg (by rw [hhead]; omega)] + show Function.update (c.work 0).cells ((c.work 0).head) Γ.one = _ + rw [hcells, hhead, regCells_update_succ] + have hhead2 : (c2.work 0).head = k + 1 + 1 := by + rw [hc2] + show (((c.work 0).write Γ.one).move Dir3.right).head = _ + rw [Tape.move, Tape.write_head, hhead] + obtain ⟨c', t, ht, hreach', hhalt', hout'⟩ := + ih z (k + 1) (by simp only [List.length_cons] at hN; omega) c2 rfl hcells2 hhead2 + (by rw [hc2]; exact hsuf1.move_right_cons) (by rw [hc2]; exact hpre) + refine ⟨c', t + 1 + 1, ?_, .step hstep1 (.step hstep2 hreach'), hhalt', ?_⟩ + · nlinarith [sq_nonneg N] + · rwa [mulAux_double] + +/-- The blank work tape of the initial configuration is the zero register. -/ +private theorem init_nil_cells_eq_regCells_zero : + (Tape.init ([] : List Γ)).cells = regCells 0 := by + funext j + rcases Nat.eq_zero_or_pos j with rfl | hj + · rfl + · obtain ⟨i, rfl⟩ : ∃ i, j = i + 1 := ⟨j - 1, by omega⟩ + rw [Tape.init_cells_ge _ _ (by simp), regCells_blank (by omega)] + +/-- `mulUnpair` is polynomial-time, via the `mulLenTM` scanner. -/ +theorem mulUnpair_mem_FP : mulUnpair ∈ FP := by + refine ⟨2, 1, mulLenTM, (fun m => 2 * m ^ 2 + 5 * m + 6), ?_, ?_⟩ + · intro z + -- Step 1: move every head off the left-end marker. + set c1 : Cfg 1 mulLenTM.Q := + { state := MulPhase.scanA + input := (Tape.init (z.map Γ.ofBool)).move Dir3.right + work := fun _ => (Tape.init []).move Dir3.right + output := (Tape.init []).move Dir3.right } with hc1 + have hstep1 : mulLenTM.step (mulLenTM.initCfg z) = some c1 := by + simp [TM.step, mulLenTM, hc1, Tape.read, Tape.init, readBackWrite, + Tape.writeAndMove, Tape.write, Tape.move] + have hsuf : c1.input.HasBinarySuffix z := Tape.init_move_right_hasBinarySuffix z + have hpre : c1.output.HasBinaryPrefix [] := Tape.init_nil_move_right_hasBinaryPrefix_nil + obtain ⟨c', t, ht, hreach, hhalt, hout⟩ := + mulLenTM_scan_loop z.length z 0 (by omega) c1 rfl + (by rw [hc1]; show ((Tape.init []).move Dir3.right).cells = _ + rw [Tape.move_cells, init_nil_cells_eq_regCells_zero]) + (by rw [hc1]; show ((Tape.init []).move Dir3.right).head = _ + simp [Tape.move]) + hsuf hpre + exact ⟨c', t + 1, by simpa using by omega, .step hstep1 hreach, hhalt, + hout.hasOutput⟩ + · have h1 : (fun m : ℕ => 2 * m ^ 2) =O ((· ^ 2) : ℕ → ℕ) := by + simpa using (BigO.refl (fun m : ℕ => m ^ 2)).const_mul_left 2 + have h2 : (fun m : ℕ => 5 * m) =O ((· ^ 2) : ℕ → ℕ) := + BigO.const_mul_left 5 + (by simpa [pow_one] using (BigO.pow_le_pow_right (by omega : 1 ≤ 2))) + exact BigO.add (BigO.add h1 h2) (BigO.const_le_pow 6 2) + +end MulLenMachine + +end Cobham + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/Reorder.lean b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/Reorder.lean new file mode 100644 index 0000000000..9ce7a254d1 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/Reorder.lean @@ -0,0 +1,709 @@ +/- +Copyright (c) 2026 Bolton Bailey. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Bolton Bailey +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.Counter +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Tape.Encoding +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.SndBlock + +/-! +# Dropping the third component of a triple — proof internals + +`Cobham.reorder` turns `pair A (pair B C)` into `pair A B`: copy the leading +block verbatim, then decode the next block's payload. It is the one machine the +`comp` constructor needs, via `Cobham.pairFn_mem_FP`. + +## Main results + +- `Cobham.reorder_mem_FP` — the triple reorder is in `FP` +-/ + + +public section + +namespace Complexity + +namespace Cobham + +open Complexity.TM + +/-- Drop the third component of a right-nested triple. Copy doubled payload bits +verbatim until the `[false, true]` separator, then decode the *next* block's +payload (`fstBlock`). On a valid triple this satisfies +`reorder (pair A (pair B C)) = pair A B` (`reorder_pair_pair`). The incremental +recursion (writing before knowing validity) is what the `reorderTM` scanner +computes; it is total and needs no sub-machines. -/ +def reorder : List Bool → List Bool + | false :: false :: z => false :: false :: reorder z + | true :: true :: z => true :: true :: reorder z + | false :: true :: z => false :: true :: fstBlock z + | c :: _ => [c] + | [] => [] + +theorem reorder_pair_pair (A B C : List Bool) : + reorder (pair A (pair B C)) = pair A B := by + induction A with + | nil => + show false :: true :: fstBlock (pair B C) = false :: true :: B + rw [fstBlock_pair] + | cons a A ih => + rw [pair_cons_eq] + cases a + · show false :: false :: reorder (pair A (pair B C)) = pair (false :: A) B + rw [ih, pair_cons_eq] + · show true :: true :: reorder (pair A (pair B C)) = pair (true :: A) B + rw [ih, pair_cons_eq] + +/-- Control states of `reorderTM`: skip the marker; phase 1 (`rcopyA`/`rcopyBf`/ +`rcopyBt`) copies doubled pairs verbatim until the separator; phase 2 +(`rdecA`/`rdecBf`/`rdecBt`) decodes the next block's payload; then halt. -/ +inductive ReorderPhase where + | rskip | rcopyA | rcopyBf | rcopyBt | rdecA | rdecBf | rdecBt | rdone + deriving DecidableEq + +instance : Fintype ReorderPhase where + elems := {.rskip, .rcopyA, .rcopyBf, .rcopyBt, .rdecA, .rdecBf, .rdecBt, .rdone} + complete := fun x => by cases x <;> simp + +/-- The reorder transducer computing `reorder`: copy the leading block verbatim +(phase 1) up to and including the `[false,true]` separator, then decode and emit +the payload of the following block (phase 2). -/ +def reorderTM : TM 0 where + Q := ReorderPhase + qstart := .rskip + qhalt := .rdone + δ := fun state iHead wHeads oHead => + match state with + | .rskip => + (.rcopyA, fun i => readBackWrite (wHeads i), readBackWrite oHead, Dir3.right, + fun i => idleDir (wHeads i), Dir3.right) + | .rcopyA => + match iHead with + | Γ.zero => + (.rcopyBf, fun i => readBackWrite (wHeads i), readBackWrite iHead, + Dir3.right, fun i => idleDir (wHeads i), Dir3.right) + | Γ.one => + (.rcopyBt, fun i => readBackWrite (wHeads i), readBackWrite iHead, + Dir3.right, fun i => idleDir (wHeads i), Dir3.right) + | _ => + (.rdone, fun i => readBackWrite (wHeads i), readBackWrite oHead, + idleDir iHead, fun i => idleDir (wHeads i), idleDir oHead) + | .rcopyBf => + match iHead with + | Γ.zero => + (.rcopyA, fun i => readBackWrite (wHeads i), readBackWrite iHead, + Dir3.right, fun i => idleDir (wHeads i), Dir3.right) + | Γ.one => + (.rdecA, fun i => readBackWrite (wHeads i), readBackWrite iHead, + Dir3.right, fun i => idleDir (wHeads i), Dir3.right) + | _ => + (.rdone, fun i => readBackWrite (wHeads i), readBackWrite oHead, + idleDir iHead, fun i => idleDir (wHeads i), idleDir oHead) + | .rcopyBt => + match iHead with + | Γ.one => + (.rcopyA, fun i => readBackWrite (wHeads i), readBackWrite iHead, + Dir3.right, fun i => idleDir (wHeads i), Dir3.right) + | _ => + (.rdone, fun i => readBackWrite (wHeads i), readBackWrite oHead, + idleDir iHead, fun i => idleDir (wHeads i), idleDir oHead) + | .rdecA => + match iHead with + | Γ.zero => + (.rdecBf, fun i => readBackWrite (wHeads i), readBackWrite oHead, + Dir3.right, fun i => idleDir (wHeads i), idleDir oHead) + | Γ.one => + (.rdecBt, fun i => readBackWrite (wHeads i), readBackWrite oHead, + Dir3.right, fun i => idleDir (wHeads i), idleDir oHead) + | _ => + (.rdone, fun i => readBackWrite (wHeads i), readBackWrite oHead, + idleDir iHead, fun i => idleDir (wHeads i), idleDir oHead) + | .rdecBf => + match iHead with + | Γ.zero => + (.rdecA, fun i => readBackWrite (wHeads i), Γw.ofBool false, + Dir3.right, fun i => idleDir (wHeads i), Dir3.right) + | _ => + (.rdone, fun i => readBackWrite (wHeads i), readBackWrite oHead, + idleDir iHead, fun i => idleDir (wHeads i), idleDir oHead) + | .rdecBt => + match iHead with + | Γ.one => + (.rdecA, fun i => readBackWrite (wHeads i), Γw.ofBool true, + Dir3.right, fun i => idleDir (wHeads i), Dir3.right) + | _ => + (.rdone, fun i => readBackWrite (wHeads i), readBackWrite oHead, + idleDir iHead, fun i => idleDir (wHeads i), idleDir oHead) + | .rdone => allIdle .rdone iHead wHeads oHead + δ_right_of_start := by + intro state iHead wHeads oHead + match state with + | .rskip => exact ⟨fun _ => rfl, fun _ => idleDir_right_of_start, fun _ => rfl⟩ + | .rcopyA => + cases iHead <;> + exact ⟨by first | exact fun _ => rfl | exact idleDir_right_of_start, + fun _ => idleDir_right_of_start, + by first | exact fun _ => rfl | exact idleDir_right_of_start⟩ + | .rcopyBf => + cases iHead <;> + exact ⟨by first | exact fun _ => rfl | exact idleDir_right_of_start, + fun _ => idleDir_right_of_start, + by first | exact fun _ => rfl | exact idleDir_right_of_start⟩ + | .rcopyBt => + cases iHead <;> + exact ⟨by first | exact fun _ => rfl | exact idleDir_right_of_start, + fun _ => idleDir_right_of_start, + by first | exact fun _ => rfl | exact idleDir_right_of_start⟩ + | .rdecA => + cases iHead <;> + exact ⟨by first | exact fun _ => rfl | exact idleDir_right_of_start, + fun _ => idleDir_right_of_start, + by first | exact fun _ => rfl | exact idleDir_right_of_start⟩ + | .rdecBf => + cases iHead <;> + exact ⟨by first | exact fun _ => rfl | exact idleDir_right_of_start, + fun _ => idleDir_right_of_start, + by first | exact fun _ => rfl | exact idleDir_right_of_start⟩ + | .rdecBt => + cases iHead <;> + exact ⟨by first | exact fun _ => rfl | exact idleDir_right_of_start, + fun _ => idleDir_right_of_start, + by first | exact fun _ => rfl | exact idleDir_right_of_start⟩ + | .rdone => exact rightOfStart_allIdle iHead wHeads oHead + +/-- Phase 2 of `reorderTM`: from `rdecA` on input `w` with output holding `acc`, +decode and emit `fstBlock w`, halting with `acc ++ fstBlock w`. Identical in shape +to `fstBlockTM_scan_loop`. -/ +private theorem reorderTM_dec_loop : + ∀ (fuel : ℕ) (w acc : List Bool), w.length ≤ fuel → ∀ (c : Cfg 0 reorderTM.Q), + c.state = ReorderPhase.rdecA → + c.input.HasBinarySuffix w → + c.output.HasBinaryPrefix acc → + ∃ c' t, t ≤ 2 * w.length + 2 ∧ reorderTM.reachesIn t c c' ∧ reorderTM.halted c' ∧ + c'.output.HasBinaryPrefix (acc ++ fstBlock w) := by + intro fuel + induction fuel with + | zero => + intro w acc hw c hstate hsuf hpre + have hwnil : w = [] := List.length_eq_zero_iff.mp (Nat.le_zero.mp hw) + subst hwnil + have hread : c.input.read = Γ.blank := hsuf.read_nil + have houtne : c.output.read ≠ Γ.start := by rw [hpre.read_blank]; decide + refine ⟨{ state := ReorderPhase.rdone + input := c.input.move (idleDir c.input.read) + work := fun i => (c.work i).writeAndMove (readBackWrite (c.work i).read) + (idleDir (c.work i).read) + output := c.output.writeAndMove (readBackWrite c.output.read) + (idleDir c.output.read) }, 1, by simp, + .step (by simp [TM.step, hstate, reorderTM, hread]) .zero, rfl, ?_⟩ + rw [show c.output.writeAndMove (readBackWrite c.output.read) (idleDir c.output.read) + = c.output from Tape.writeAndMove_readBack_idle_of_ne_start _ houtne] + simpa [fstBlock] using hpre + | succ fuel ih => + intro w acc hw c hstate hsuf hpre + have houtne : c.output.read ≠ Γ.start := by rw [hpre.read_blank]; decide + match w with + | [] => + have hread : c.input.read = Γ.blank := hsuf.read_nil + refine ⟨{ state := ReorderPhase.rdone + input := c.input.move (idleDir c.input.read) + work := fun i => (c.work i).writeAndMove (readBackWrite (c.work i).read) + (idleDir (c.work i).read) + output := c.output.writeAndMove (readBackWrite c.output.read) + (idleDir c.output.read) }, 1, by simp, + .step (by simp [TM.step, hstate, reorderTM, hread]) .zero, rfl, ?_⟩ + rw [show c.output.writeAndMove (readBackWrite c.output.read) (idleDir c.output.read) + = c.output from Tape.writeAndMove_readBack_idle_of_ne_start _ houtne] + simpa [fstBlock] using hpre + | [false] => + have hread : c.input.read = Γ.ofBool false := hsuf.read_cons + let c1 : Cfg 0 reorderTM.Q := + { state := ReorderPhase.rdecBf + input := c.input.move Dir3.right + work := fun i => (c.work i).writeAndMove (readBackWrite (c.work i).read) + (idleDir (c.work i).read) + output := c.output.writeAndMove (readBackWrite c.output.read) + (idleDir c.output.read) } + have hstep : reorderTM.step c = some c1 := by + simp [TM.step, hstate, reorderTM, hread, Γ.ofBool, c1] + have hsuf1 : c1.input.HasBinarySuffix [] := hsuf.move_right_cons + have hpre1 : c1.output.HasBinaryPrefix acc := by + rw [show c1.output = c.output from + Tape.writeAndMove_readBack_idle_of_ne_start _ houtne] + exact hpre + have hread1 : c1.input.read = Γ.blank := hsuf1.read_nil + have houtne1 : c1.output.read ≠ Γ.start := by rw [hpre1.read_blank]; decide + refine ⟨{ state := ReorderPhase.rdone + input := c1.input.move (idleDir c1.input.read) + work := fun i => (c1.work i).writeAndMove (readBackWrite (c1.work i).read) + (idleDir (c1.work i).read) + output := c1.output.writeAndMove (readBackWrite c1.output.read) + (idleDir c1.output.read) }, 2, by simp, + .step hstep (.step (by simp [TM.step, reorderTM, hread1, c1]) .zero), rfl, ?_⟩ + rw [show c1.output.writeAndMove (readBackWrite c1.output.read) (idleDir c1.output.read) + = c1.output from Tape.writeAndMove_readBack_idle_of_ne_start _ houtne1] + simpa [fstBlock] using hpre1 + | [true] => + have hread : c.input.read = Γ.ofBool true := hsuf.read_cons + let c1 : Cfg 0 reorderTM.Q := + { state := ReorderPhase.rdecBt + input := c.input.move Dir3.right + work := fun i => (c.work i).writeAndMove (readBackWrite (c.work i).read) + (idleDir (c.work i).read) + output := c.output.writeAndMove (readBackWrite c.output.read) + (idleDir c.output.read) } + have hstep : reorderTM.step c = some c1 := by + simp [TM.step, hstate, reorderTM, hread, Γ.ofBool, c1] + have hsuf1 : c1.input.HasBinarySuffix [] := hsuf.move_right_cons + have hpre1 : c1.output.HasBinaryPrefix acc := by + rw [show c1.output = c.output from + Tape.writeAndMove_readBack_idle_of_ne_start _ houtne] + exact hpre + have hread1 : c1.input.read = Γ.blank := hsuf1.read_nil + have houtne1 : c1.output.read ≠ Γ.start := by rw [hpre1.read_blank]; decide + refine ⟨{ state := ReorderPhase.rdone + input := c1.input.move (idleDir c1.input.read) + work := fun i => (c1.work i).writeAndMove (readBackWrite (c1.work i).read) + (idleDir (c1.work i).read) + output := c1.output.writeAndMove (readBackWrite c1.output.read) + (idleDir c1.output.read) }, 2, by simp, + .step hstep (.step (by simp [TM.step, reorderTM, hread1, c1]) .zero), rfl, ?_⟩ + rw [show c1.output.writeAndMove (readBackWrite c1.output.read) (idleDir c1.output.read) + = c1.output from Tape.writeAndMove_readBack_idle_of_ne_start _ houtne1] + simpa [fstBlock] using hpre1 + | false :: true :: y => + have hreadA : c.input.read = Γ.ofBool false := hsuf.read_cons + let c1 : Cfg 0 reorderTM.Q := + { state := ReorderPhase.rdecBf + input := c.input.move Dir3.right + work := fun i => (c.work i).writeAndMove (readBackWrite (c.work i).read) + (idleDir (c.work i).read) + output := c.output.writeAndMove (readBackWrite c.output.read) + (idleDir c.output.read) } + have hstepA : reorderTM.step c = some c1 := by + simp [TM.step, hstate, reorderTM, hreadA, Γ.ofBool, c1] + have hsuf1 : c1.input.HasBinarySuffix (true :: y) := hsuf.move_right_cons + have hpre1 : c1.output.HasBinaryPrefix acc := by + rw [show c1.output = c.output from + Tape.writeAndMove_readBack_idle_of_ne_start _ houtne] + exact hpre + have hreadB : c1.input.read = Γ.ofBool true := hsuf1.read_cons + have houtne1 : c1.output.read ≠ Γ.start := by rw [hpre1.read_blank]; decide + refine ⟨{ state := ReorderPhase.rdone + input := c1.input.move (idleDir c1.input.read) + work := fun i => (c1.work i).writeAndMove (readBackWrite (c1.work i).read) + (idleDir (c1.work i).read) + output := c1.output.writeAndMove (readBackWrite c1.output.read) + (idleDir c1.output.read) }, 2, by simp, + .step hstepA (.step (by simp [TM.step, reorderTM, hreadB, Γ.ofBool, c1]) .zero), + rfl, ?_⟩ + rw [show c1.output.writeAndMove (readBackWrite c1.output.read) (idleDir c1.output.read) + = c1.output from Tape.writeAndMove_readBack_idle_of_ne_start _ houtne1] + simpa [fstBlock] using hpre1 + | true :: false :: rest => + have hreadA : c.input.read = Γ.ofBool true := hsuf.read_cons + let c1 : Cfg 0 reorderTM.Q := + { state := ReorderPhase.rdecBt + input := c.input.move Dir3.right + work := fun i => (c.work i).writeAndMove (readBackWrite (c.work i).read) + (idleDir (c.work i).read) + output := c.output.writeAndMove (readBackWrite c.output.read) + (idleDir c.output.read) } + have hstepA : reorderTM.step c = some c1 := by + simp [TM.step, hstate, reorderTM, hreadA, Γ.ofBool, c1] + have hsuf1 : c1.input.HasBinarySuffix (false :: rest) := hsuf.move_right_cons + have hpre1 : c1.output.HasBinaryPrefix acc := by + rw [show c1.output = c.output from + Tape.writeAndMove_readBack_idle_of_ne_start _ houtne] + exact hpre + have hreadB : c1.input.read = Γ.ofBool false := hsuf1.read_cons + have houtne1 : c1.output.read ≠ Γ.start := by rw [hpre1.read_blank]; decide + refine ⟨{ state := ReorderPhase.rdone + input := c1.input.move (idleDir c1.input.read) + work := fun i => (c1.work i).writeAndMove (readBackWrite (c1.work i).read) + (idleDir (c1.work i).read) + output := c1.output.writeAndMove (readBackWrite c1.output.read) + (idleDir c1.output.read) }, 2, by simp, + .step hstepA (.step (by simp [TM.step, reorderTM, hreadB, Γ.ofBool, c1]) .zero), + rfl, ?_⟩ + rw [show c1.output.writeAndMove (readBackWrite c1.output.read) (idleDir c1.output.read) + = c1.output from Tape.writeAndMove_readBack_idle_of_ne_start _ houtne1] + simpa [fstBlock] using hpre1 + | false :: false :: z => + have hreadA : c.input.read = Γ.ofBool false := hsuf.read_cons + let c1 : Cfg 0 reorderTM.Q := + { state := ReorderPhase.rdecBf + input := c.input.move Dir3.right + work := fun i => (c.work i).writeAndMove (readBackWrite (c.work i).read) + (idleDir (c.work i).read) + output := c.output.writeAndMove (readBackWrite c.output.read) + (idleDir c.output.read) } + have hstepA : reorderTM.step c = some c1 := by + simp [TM.step, hstate, reorderTM, hreadA, Γ.ofBool, c1] + have hsuf1 : c1.input.HasBinarySuffix (false :: z) := hsuf.move_right_cons + have hpre1 : c1.output.HasBinaryPrefix acc := by + rw [show c1.output = c.output from + Tape.writeAndMove_readBack_idle_of_ne_start _ houtne] + exact hpre + have hreadB : c1.input.read = Γ.ofBool false := hsuf1.read_cons + let c2 : Cfg 0 reorderTM.Q := + { state := ReorderPhase.rdecA + input := c1.input.move Dir3.right + work := fun i => (c1.work i).writeAndMove (readBackWrite (c1.work i).read) + (idleDir (c1.work i).read) + output := c1.output.writeAndMove (Γw.ofBool false) Dir3.right } + have hstepB : reorderTM.step c1 = some c2 := by + simp [TM.step, reorderTM, hreadB, Γ.ofBool, c1, c2] + have hsuf2 : c2.input.HasBinarySuffix z := hsuf1.move_right_cons + have hpre2 : c2.output.HasBinaryPrefix (acc ++ [false]) := by + show (c1.output.writeAndMove ((Γw.ofBool false).toΓ) Dir3.right).HasBinaryPrefix + (acc ++ [false]) + rw [Γw.ofBool_toΓ]; exact Tape.hasBinaryPrefix_write_bit false hpre1 + have hzfuel : z.length ≤ fuel := by + simp only [List.length_cons] at hw; omega + obtain ⟨c', t, ht, hreach, hhalt, hcout⟩ := + ih z (acc ++ [false]) hzfuel c2 rfl hsuf2 hpre2 + refine ⟨c', t + 1 + 1, by simp only [List.length_cons]; omega, + .step hstepA (.step hstepB hreach), hhalt, ?_⟩ + have hfb : fstBlock (false :: false :: z) = false :: fstBlock z := rfl + rw [hfb, List.append_assoc, List.cons_append, List.nil_append] at * + exact hcout + | true :: true :: z => + have hreadA : c.input.read = Γ.ofBool true := hsuf.read_cons + let c1 : Cfg 0 reorderTM.Q := + { state := ReorderPhase.rdecBt + input := c.input.move Dir3.right + work := fun i => (c.work i).writeAndMove (readBackWrite (c.work i).read) + (idleDir (c.work i).read) + output := c.output.writeAndMove (readBackWrite c.output.read) + (idleDir c.output.read) } + have hstepA : reorderTM.step c = some c1 := by + simp [TM.step, hstate, reorderTM, hreadA, Γ.ofBool, c1] + have hsuf1 : c1.input.HasBinarySuffix (true :: z) := hsuf.move_right_cons + have hpre1 : c1.output.HasBinaryPrefix acc := by + rw [show c1.output = c.output from + Tape.writeAndMove_readBack_idle_of_ne_start _ houtne] + exact hpre + have hreadB : c1.input.read = Γ.ofBool true := hsuf1.read_cons + let c2 : Cfg 0 reorderTM.Q := + { state := ReorderPhase.rdecA + input := c1.input.move Dir3.right + work := fun i => (c1.work i).writeAndMove (readBackWrite (c1.work i).read) + (idleDir (c1.work i).read) + output := c1.output.writeAndMove (Γw.ofBool true) Dir3.right } + have hstepB : reorderTM.step c1 = some c2 := by + simp [TM.step, reorderTM, hreadB, Γ.ofBool, c1, c2] + have hsuf2 : c2.input.HasBinarySuffix z := hsuf1.move_right_cons + have hpre2 : c2.output.HasBinaryPrefix (acc ++ [true]) := by + show (c1.output.writeAndMove ((Γw.ofBool true).toΓ) Dir3.right).HasBinaryPrefix + (acc ++ [true]) + rw [Γw.ofBool_toΓ]; exact Tape.hasBinaryPrefix_write_bit true hpre1 + have hzfuel : z.length ≤ fuel := by + simp only [List.length_cons] at hw; omega + obtain ⟨c', t, ht, hreach, hhalt, hcout⟩ := + ih z (acc ++ [true]) hzfuel c2 rfl hsuf2 hpre2 + refine ⟨c', t + 1 + 1, by simp only [List.length_cons]; omega, + .step hstepA (.step hstepB hreach), hhalt, ?_⟩ + have hfb : fstBlock (true :: true :: z) = true :: fstBlock z := rfl + rw [hfb, List.append_assoc, List.cons_append, List.nil_append] at * + exact hcout + +/-- Phase 1 of `reorderTM`: from `rcopyA` on input `w` with output holding `acc`, +copy `w`'s leading block verbatim and decode the following block, halting with +`acc ++ reorder w`. The separator case hands off to `reorderTM_dec_loop`. -/ +private theorem reorderTM_copy_loop : + ∀ (fuel : ℕ) (w acc : List Bool), w.length ≤ fuel → ∀ (c : Cfg 0 reorderTM.Q), + c.state = ReorderPhase.rcopyA → + c.input.HasBinarySuffix w → + c.output.HasBinaryPrefix acc → + ∃ c' t, t ≤ 3 * w.length + 3 ∧ reorderTM.reachesIn t c c' ∧ reorderTM.halted c' ∧ + c'.output.HasBinaryPrefix (acc ++ reorder w) := by + intro fuel + induction fuel with + | zero => + intro w acc hw c hstate hsuf hpre + have hwnil : w = [] := List.length_eq_zero_iff.mp (Nat.le_zero.mp hw) + subst hwnil + have hread : c.input.read = Γ.blank := hsuf.read_nil + have houtne : c.output.read ≠ Γ.start := by rw [hpre.read_blank]; decide + refine ⟨{ state := ReorderPhase.rdone + input := c.input.move (idleDir c.input.read) + work := fun i => (c.work i).writeAndMove (readBackWrite (c.work i).read) + (idleDir (c.work i).read) + output := c.output.writeAndMove (readBackWrite c.output.read) + (idleDir c.output.read) }, 1, by simp, + .step (by simp [TM.step, hstate, reorderTM, hread]) .zero, rfl, ?_⟩ + rw [show c.output.writeAndMove (readBackWrite c.output.read) (idleDir c.output.read) + = c.output from Tape.writeAndMove_readBack_idle_of_ne_start _ houtne] + simpa [reorder] using hpre + | succ fuel ih => + intro w acc hw c hstate hsuf hpre + have houtne : c.output.read ≠ Γ.start := by rw [hpre.read_blank]; decide + -- The `rcopyA` step emits the first bit `c1` verbatim. + match w with + | [] => + have hread : c.input.read = Γ.blank := hsuf.read_nil + refine ⟨{ state := ReorderPhase.rdone + input := c.input.move (idleDir c.input.read) + work := fun i => (c.work i).writeAndMove (readBackWrite (c.work i).read) + (idleDir (c.work i).read) + output := c.output.writeAndMove (readBackWrite c.output.read) + (idleDir c.output.read) }, 1, by simp, + .step (by simp [TM.step, hstate, reorderTM, hread]) .zero, rfl, ?_⟩ + rw [show c.output.writeAndMove (readBackWrite c.output.read) (idleDir c.output.read) + = c.output from Tape.writeAndMove_readBack_idle_of_ne_start _ houtne] + simpa [reorder] using hpre + | [false] => + have hread : c.input.read = Γ.ofBool false := hsuf.read_cons + let c1 : Cfg 0 reorderTM.Q := + { state := ReorderPhase.rcopyBf + input := c.input.move Dir3.right + work := fun i => (c.work i).writeAndMove (readBackWrite (c.work i).read) + (idleDir (c.work i).read) + output := c.output.writeAndMove (readBackWrite c.input.read) Dir3.right } + have hstep : reorderTM.step c = some c1 := by + simp [TM.step, hstate, reorderTM, hread, Γ.ofBool, c1] + have hsuf1 : c1.input.HasBinarySuffix [] := hsuf.move_right_cons + have hpre1 : c1.output.HasBinaryPrefix (acc ++ [false]) := by + have hco : (readBackWrite c.input.read).toΓ = Γ.ofBool false := by rw [hread]; rfl + show (c.output.writeAndMove ((readBackWrite c.input.read).toΓ) + Dir3.right).HasBinaryPrefix + (acc ++ [false]) + rw [hco]; exact Tape.hasBinaryPrefix_write_bit false hpre + have hread1 : c1.input.read = Γ.blank := hsuf1.read_nil + have houtne1 : c1.output.read ≠ Γ.start := by rw [hpre1.read_blank]; decide + refine ⟨{ state := ReorderPhase.rdone + input := c1.input.move (idleDir c1.input.read) + work := fun i => (c1.work i).writeAndMove (readBackWrite (c1.work i).read) + (idleDir (c1.work i).read) + output := c1.output.writeAndMove (readBackWrite c1.output.read) + (idleDir c1.output.read) }, 2, by simp, + .step hstep (.step (by simp [TM.step, reorderTM, hread1, c1]) .zero), rfl, ?_⟩ + rw [show c1.output.writeAndMove (readBackWrite c1.output.read) (idleDir c1.output.read) + = c1.output from Tape.writeAndMove_readBack_idle_of_ne_start _ houtne1] + simpa [reorder] using hpre1 + | [true] => + have hread : c.input.read = Γ.ofBool true := hsuf.read_cons + let c1 : Cfg 0 reorderTM.Q := + { state := ReorderPhase.rcopyBt + input := c.input.move Dir3.right + work := fun i => (c.work i).writeAndMove (readBackWrite (c.work i).read) + (idleDir (c.work i).read) + output := c.output.writeAndMove (readBackWrite c.input.read) Dir3.right } + have hstep : reorderTM.step c = some c1 := by + simp [TM.step, hstate, reorderTM, hread, Γ.ofBool, c1] + have hsuf1 : c1.input.HasBinarySuffix [] := hsuf.move_right_cons + have hpre1 : c1.output.HasBinaryPrefix (acc ++ [true]) := by + have hco : (readBackWrite c.input.read).toΓ = Γ.ofBool true := by rw [hread]; rfl + show (c.output.writeAndMove ((readBackWrite c.input.read).toΓ) + Dir3.right).HasBinaryPrefix + (acc ++ [true]) + rw [hco]; exact Tape.hasBinaryPrefix_write_bit true hpre + have hread1 : c1.input.read = Γ.blank := hsuf1.read_nil + have houtne1 : c1.output.read ≠ Γ.start := by rw [hpre1.read_blank]; decide + refine ⟨{ state := ReorderPhase.rdone + input := c1.input.move (idleDir c1.input.read) + work := fun i => (c1.work i).writeAndMove (readBackWrite (c1.work i).read) + (idleDir (c1.work i).read) + output := c1.output.writeAndMove (readBackWrite c1.output.read) + (idleDir c1.output.read) }, 2, by simp, + .step hstep (.step (by simp [TM.step, reorderTM, hread1, c1]) .zero), rfl, ?_⟩ + rw [show c1.output.writeAndMove (readBackWrite c1.output.read) (idleDir c1.output.read) + = c1.output from Tape.writeAndMove_readBack_idle_of_ne_start _ houtne1] + simpa [reorder] using hpre1 + | false :: true :: y => + -- separator: copy `false` then `true`, then decode `y`. + have hreadA : c.input.read = Γ.ofBool false := hsuf.read_cons + let c1 : Cfg 0 reorderTM.Q := + { state := ReorderPhase.rcopyBf + input := c.input.move Dir3.right + work := fun i => (c.work i).writeAndMove (readBackWrite (c.work i).read) + (idleDir (c.work i).read) + output := c.output.writeAndMove (readBackWrite c.input.read) Dir3.right } + have hstepA : reorderTM.step c = some c1 := by + simp [TM.step, hstate, reorderTM, hreadA, Γ.ofBool, c1] + have hsuf1 : c1.input.HasBinarySuffix (true :: y) := hsuf.move_right_cons + have hpre1 : c1.output.HasBinaryPrefix (acc ++ [false]) := by + have hco : (readBackWrite c.input.read).toΓ = Γ.ofBool false := by rw [hreadA]; rfl + show (c.output.writeAndMove ((readBackWrite c.input.read).toΓ) + Dir3.right).HasBinaryPrefix + (acc ++ [false]) + rw [hco]; exact Tape.hasBinaryPrefix_write_bit false hpre + have hreadB : c1.input.read = Γ.ofBool true := hsuf1.read_cons + let c2 : Cfg 0 reorderTM.Q := + { state := ReorderPhase.rdecA + input := c1.input.move Dir3.right + work := fun i => (c1.work i).writeAndMove (readBackWrite (c1.work i).read) + (idleDir (c1.work i).read) + output := c1.output.writeAndMove (readBackWrite c1.input.read) Dir3.right } + have hstepB : reorderTM.step c1 = some c2 := by + simp [TM.step, reorderTM, hreadB, Γ.ofBool, c1, c2] + have hsuf2 : c2.input.HasBinarySuffix y := hsuf1.move_right_cons + have hpre2 : c2.output.HasBinaryPrefix (acc ++ [false, true]) := by + have hco : (readBackWrite c1.input.read).toΓ = Γ.ofBool true := by rw [hreadB]; rfl + show (c1.output.writeAndMove ((readBackWrite c1.input.read).toΓ) + Dir3.right).HasBinaryPrefix + (acc ++ [false, true]) + rw [hco] + have := Tape.hasBinaryPrefix_write_bit true hpre1 + rwa [List.append_assoc] at this + have hyfuel : y.length ≤ fuel := by + simp only [List.length_cons] at hw; omega + obtain ⟨c', t, ht, hreach, hhalt, hcout⟩ := + reorderTM_dec_loop fuel y (acc ++ [false, true]) hyfuel c2 rfl hsuf2 hpre2 + refine ⟨c', t + 1 + 1, by simp only [List.length_cons]; omega, + .step hstepA (.step hstepB hreach), hhalt, ?_⟩ + have hr : reorder (false :: true :: y) = false :: true :: fstBlock y := rfl + rw [hr] + rwa [List.append_assoc] at hcout + | false :: false :: z => + have hreadA : c.input.read = Γ.ofBool false := hsuf.read_cons + let c1 : Cfg 0 reorderTM.Q := + { state := ReorderPhase.rcopyBf + input := c.input.move Dir3.right + work := fun i => (c.work i).writeAndMove (readBackWrite (c.work i).read) + (idleDir (c.work i).read) + output := c.output.writeAndMove (readBackWrite c.input.read) Dir3.right } + have hstepA : reorderTM.step c = some c1 := by + simp [TM.step, hstate, reorderTM, hreadA, Γ.ofBool, c1] + have hsuf1 : c1.input.HasBinarySuffix (false :: z) := hsuf.move_right_cons + have hpre1 : c1.output.HasBinaryPrefix (acc ++ [false]) := by + have hco : (readBackWrite c.input.read).toΓ = Γ.ofBool false := by rw [hreadA]; rfl + show (c.output.writeAndMove ((readBackWrite c.input.read).toΓ) + Dir3.right).HasBinaryPrefix + (acc ++ [false]) + rw [hco]; exact Tape.hasBinaryPrefix_write_bit false hpre + have hreadB : c1.input.read = Γ.ofBool false := hsuf1.read_cons + let c2 : Cfg 0 reorderTM.Q := + { state := ReorderPhase.rcopyA + input := c1.input.move Dir3.right + work := fun i => (c1.work i).writeAndMove (readBackWrite (c1.work i).read) + (idleDir (c1.work i).read) + output := c1.output.writeAndMove (readBackWrite c1.input.read) Dir3.right } + have hstepB : reorderTM.step c1 = some c2 := by + simp [TM.step, reorderTM, hreadB, Γ.ofBool, c1, c2] + have hsuf2 : c2.input.HasBinarySuffix z := hsuf1.move_right_cons + have hpre2 : c2.output.HasBinaryPrefix (acc ++ [false, false]) := by + have hco : (readBackWrite c1.input.read).toΓ = Γ.ofBool false := by rw [hreadB]; rfl + show (c1.output.writeAndMove ((readBackWrite c1.input.read).toΓ) + Dir3.right).HasBinaryPrefix + (acc ++ [false, false]) + rw [hco] + have := Tape.hasBinaryPrefix_write_bit false hpre1 + rwa [List.append_assoc] at this + have hzfuel : z.length ≤ fuel := by + simp only [List.length_cons] at hw; omega + obtain ⟨c', t, ht, hreach, hhalt, hcout⟩ := + ih z (acc ++ [false, false]) hzfuel c2 rfl hsuf2 hpre2 + refine ⟨c', t + 1 + 1, by simp only [List.length_cons]; omega, + .step hstepA (.step hstepB hreach), hhalt, ?_⟩ + have hr : reorder (false :: false :: z) = false :: false :: reorder z := rfl + rw [hr] + rwa [List.append_assoc] at hcout + | true :: true :: z => + have hreadA : c.input.read = Γ.ofBool true := hsuf.read_cons + let c1 : Cfg 0 reorderTM.Q := + { state := ReorderPhase.rcopyBt + input := c.input.move Dir3.right + work := fun i => (c.work i).writeAndMove (readBackWrite (c.work i).read) + (idleDir (c.work i).read) + output := c.output.writeAndMove (readBackWrite c.input.read) Dir3.right } + have hstepA : reorderTM.step c = some c1 := by + simp [TM.step, hstate, reorderTM, hreadA, Γ.ofBool, c1] + have hsuf1 : c1.input.HasBinarySuffix (true :: z) := hsuf.move_right_cons + have hpre1 : c1.output.HasBinaryPrefix (acc ++ [true]) := by + have hco : (readBackWrite c.input.read).toΓ = Γ.ofBool true := by rw [hreadA]; rfl + show (c.output.writeAndMove ((readBackWrite c.input.read).toΓ) + Dir3.right).HasBinaryPrefix + (acc ++ [true]) + rw [hco]; exact Tape.hasBinaryPrefix_write_bit true hpre + have hreadB : c1.input.read = Γ.ofBool true := hsuf1.read_cons + let c2 : Cfg 0 reorderTM.Q := + { state := ReorderPhase.rcopyA + input := c1.input.move Dir3.right + work := fun i => (c1.work i).writeAndMove (readBackWrite (c1.work i).read) + (idleDir (c1.work i).read) + output := c1.output.writeAndMove (readBackWrite c1.input.read) Dir3.right } + have hstepB : reorderTM.step c1 = some c2 := by + simp [TM.step, reorderTM, hreadB, Γ.ofBool, c1, c2] + have hsuf2 : c2.input.HasBinarySuffix z := hsuf1.move_right_cons + have hpre2 : c2.output.HasBinaryPrefix (acc ++ [true, true]) := by + have hco : (readBackWrite c1.input.read).toΓ = Γ.ofBool true := by rw [hreadB]; rfl + show (c1.output.writeAndMove ((readBackWrite c1.input.read).toΓ) + Dir3.right).HasBinaryPrefix + (acc ++ [true, true]) + rw [hco] + have := Tape.hasBinaryPrefix_write_bit true hpre1 + rwa [List.append_assoc] at this + have hzfuel : z.length ≤ fuel := by + simp only [List.length_cons] at hw; omega + obtain ⟨c', t, ht, hreach, hhalt, hcout⟩ := + ih z (acc ++ [true, true]) hzfuel c2 rfl hsuf2 hpre2 + refine ⟨c', t + 1 + 1, by simp only [List.length_cons]; omega, + .step hstepA (.step hstepB hreach), hhalt, ?_⟩ + have hr : reorder (true :: true :: z) = true :: true :: reorder z := rfl + rw [hr] + rwa [List.append_assoc] at hcout + | true :: false :: rest => + have hreadA : c.input.read = Γ.ofBool true := hsuf.read_cons + let c1 : Cfg 0 reorderTM.Q := + { state := ReorderPhase.rcopyBt + input := c.input.move Dir3.right + work := fun i => (c.work i).writeAndMove (readBackWrite (c.work i).read) + (idleDir (c.work i).read) + output := c.output.writeAndMove (readBackWrite c.input.read) Dir3.right } + have hstepA : reorderTM.step c = some c1 := by + simp [TM.step, hstate, reorderTM, hreadA, Γ.ofBool, c1] + have hsuf1 : c1.input.HasBinarySuffix (false :: rest) := hsuf.move_right_cons + have hpre1 : c1.output.HasBinaryPrefix (acc ++ [true]) := by + have hco : (readBackWrite c.input.read).toΓ = Γ.ofBool true := by rw [hreadA]; rfl + show (c.output.writeAndMove ((readBackWrite c.input.read).toΓ) + Dir3.right).HasBinaryPrefix + (acc ++ [true]) + rw [hco]; exact Tape.hasBinaryPrefix_write_bit true hpre + have hreadB : c1.input.read = Γ.ofBool false := hsuf1.read_cons + have houtne1 : c1.output.read ≠ Γ.start := by rw [hpre1.read_blank]; decide + refine ⟨{ state := ReorderPhase.rdone + input := c1.input.move (idleDir c1.input.read) + work := fun i => (c1.work i).writeAndMove (readBackWrite (c1.work i).read) + (idleDir (c1.work i).read) + output := c1.output.writeAndMove (readBackWrite c1.output.read) + (idleDir c1.output.read) }, 2, by simp, + .step hstepA (.step (by simp [TM.step, reorderTM, hreadB, Γ.ofBool, c1]) .zero), + rfl, ?_⟩ + rw [show c1.output.writeAndMove (readBackWrite c1.output.read) (idleDir c1.output.read) + = c1.output from Tape.writeAndMove_readBack_idle_of_ne_start _ houtne1] + have hr : reorder (true :: false :: rest) = [true] := rfl + rw [hr] + exact hpre1 + +/-- `reorder` is polynomial-time, via the `reorderTM` scanner. -/ +theorem reorder_mem_FP : reorder ∈ FP := by + refine ⟨1, 0, reorderTM, (fun m => 3 * m + 4), ?_, ?_⟩ + · intro z + let c1 : Cfg 0 reorderTM.Q := + { state := ReorderPhase.rcopyA + input := (Tape.init (z.map Γ.ofBool)).move Dir3.right + work := fun _ => (Tape.init []).move Dir3.right + output := (Tape.init []).move Dir3.right } + have hstep1 : reorderTM.step (reorderTM.initCfg z) = some c1 := by + simp [TM.step, reorderTM, c1, Tape.read, Tape.init, readBackWrite, idleDir, + Tape.writeAndMove, Tape.write, Tape.move] + have hsuf : c1.input.HasBinarySuffix z := Tape.init_move_right_hasBinarySuffix z + have hpre : c1.output.HasBinaryPrefix [] := Tape.init_nil_move_right_hasBinaryPrefix_nil + obtain ⟨c', t, ht, hreach, hhalt, hcout⟩ := + reorderTM_copy_loop z.length z [] le_rfl c1 rfl hsuf hpre + refine ⟨c', t + 1, by show t + 1 ≤ 3 * z.length + 4; omega, + .step hstep1 hreach, hhalt, ?_⟩ + simpa using hcout.hasOutput + · have hn : (fun m : ℕ => 3 * m) =O ((· ^ 1) : ℕ → ℕ) := by + simpa [pow_one] using (BigO.refl (fun m : ℕ => m)).const_mul_left 3 + exact BigO.add hn (BigO.const_le_pow 4 1) + +end Cobham + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/Reverse.lean b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/Reverse.lean new file mode 100644 index 0000000000..7b0dcf185b --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/Reverse.lean @@ -0,0 +1,313 @@ +/- +Copyright (c) 2026 Bolton Bailey. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Bolton Bailey +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Tape.Encoding + +/-! +# Polynomial-time string reversal — proof internals + +The transducer `reverseTM` has one work tape and four control states: it copies +the input onto the work tape left to right, then walks the work head back to the +left-end marker, emitting each cell to the output as it passes. The result is the +input read backwards, in `2 · |x| + 3` steps. + +Reversal is what turns a right-to-left recursion into a left-to-right loop: +recursion on notation peels the *head* of a string, so an iterative evaluation +consumes the *last* bit first. + +## Main results + +- `Complexity.reverse_mem_FP` — reversal is in `FP` +-/ + + +public section + +namespace Complexity + +open Complexity.TM + +/-- Control states of `reverseTM`. -/ +inductive RevPhase where + /-- Move every head off the left-end marker. -/ + | skip + /-- Copy the input onto the work tape, left to right. -/ + | copy + /-- Walk the work head back, emitting each cell to the output. -/ + | emit + /-- Halt. -/ + | done + deriving DecidableEq + +instance : Fintype RevPhase where + elems := {.skip, .copy, .emit, .done} + complete := fun x => by cases x <;> simp + +/-- **The reversal transducer.** Copies the input onto its work tape, then +sweeps the work head back to the left-end marker, writing each cell it passes to +the output tape. Computes `List.reverse`. -/ +def reverseTM : TM 1 where + Q := RevPhase + qstart := .skip + qhalt := .done + δ := fun state iHead wHeads oHead => + match state with + | .skip => + (.copy, fun i => readBackWrite (wHeads i), readBackWrite oHead, + Dir3.right, fun _ => Dir3.right, Dir3.right) + | .copy => + match iHead with + | Γ.zero => + (.copy, fun _ => Γw.zero, readBackWrite oHead, + Dir3.right, fun _ => Dir3.right, idleDir oHead) + | Γ.one => + (.copy, fun _ => Γw.one, readBackWrite oHead, + Dir3.right, fun _ => Dir3.right, idleDir oHead) + | _ => + (.emit, fun i => readBackWrite (wHeads i), readBackWrite oHead, + idleDir iHead, fun i => moveLeftDir (wHeads i), idleDir oHead) + | .emit => + if wHeads 0 = Γ.zero then + (.emit, fun i => readBackWrite (wHeads i), Γw.zero, + idleDir iHead, fun i => moveLeftDir (wHeads i), Dir3.right) + else if wHeads 0 = Γ.one then + (.emit, fun i => readBackWrite (wHeads i), Γw.one, + idleDir iHead, fun i => moveLeftDir (wHeads i), Dir3.right) + else + (.done, fun i => readBackWrite (wHeads i), readBackWrite oHead, + idleDir iHead, fun i => idleDir (wHeads i), idleDir oHead) + | .done => allIdle .done iHead wHeads oHead + δ_right_of_start := by + intro state iHead wHeads oHead + match state with + | .skip => exact ⟨fun _ => rfl, fun _ _ => rfl, fun _ => rfl⟩ + | .copy => + cases iHead <;> + exact ⟨by first | exact fun _ => rfl | exact idleDir_right_of_start, + by first | exact fun _ _ => rfl | exact fun _ => moveLeftDir_right_of_start, + by first | exact fun _ => rfl | exact idleDir_right_of_start⟩ + | .emit => + dsimp only [] + split + · exact ⟨idleDir_right_of_start, fun _ => moveLeftDir_right_of_start, + fun _ => rfl⟩ + · split + · exact ⟨idleDir_right_of_start, fun _ => moveLeftDir_right_of_start, + fun _ => rfl⟩ + · exact ⟨idleDir_right_of_start, fun _ => idleDir_right_of_start, + idleDir_right_of_start⟩ + | .done => exact rightOfStart_allIdle iHead wHeads oHead + +/-- A content-preserving idle step on a tape whose head is off the left marker. -/ +private theorem rev_idle_eq {t : Tape} (h : t.read ≠ Γ.start) : + t.writeAndMove (readBackWrite t.read) (idleDir t.read) = t := by + rw [writeAndMove_readBack t h, idleDir, if_neg h, Tape.move] + +/-- The copy phase: from `copy` with the input cursor on `w` and the work tape +holding `acc`, the machine appends `w` to the work tape and enters `emit` with +the work head on the last copied cell. -/ +private theorem reverseTM_copy_loop : + ∀ (w acc : List Bool) (c : Cfg 1 reverseTM.Q), + c.state = RevPhase.copy → + c.input.HasBinarySuffix w → + (c.work 0).HasBinaryPrefix acc → + (c.work 0).cells 0 = Γ.start → + c.output.HasBinaryPrefix [] → + ∃ c', reverseTM.reachesIn (w.length + 1) c c' ∧ + c'.state = RevPhase.emit ∧ + (c'.work 0).HasBinaryContent (acc ++ w) ∧ + (c'.work 0).cells 0 = Γ.start ∧ + (c'.work 0).head = (acc ++ w).length ∧ + c'.input.read ≠ Γ.start ∧ + c'.output.HasBinaryPrefix [] := by + intro w + induction w with + | nil => + intro acc c hstate hsuf hwork hw0 hout + have hread : c.input.read = Γ.blank := hsuf.read_nil + have houtne : c.output.read ≠ Γ.start := by rw [hout.read_blank]; decide + have hwread : (c.work 0).read = Γ.blank := by + rw [Tape.read, hwork.1] + exact hwork.2.2 acc.length le_rfl + have hwne : (c.work 0).read ≠ Γ.start := by rw [hwread]; decide + have hinp_eq : c.input.move (idleDir Γ.blank) = c.input := by + rw [idleDir, if_neg (by decide), Tape.move] + have hwmove : (fun i => (c.work i).writeAndMove (readBackWrite ((c.work i).read)).toΓ + (moveLeftDir ((c.work i).read))) = fun i => (c.work i).move Dir3.left := by + funext i + have hi : i = 0 := Subsingleton.elim i 0 + subst hi + rw [moveLeftDir, if_neg hwne] + exact writeAndMove_readBack _ hwne _ + refine ⟨{ state := RevPhase.emit + input := c.input + work := fun i => (c.work i).move Dir3.left + output := c.output }, ?_, rfl, ?_, ?_, ?_, by rw [hread]; decide, by simpa⟩ + · refine .step ?_ .zero + simp only [TM.step, hstate, reverseTM, hread, hinp_eq, reduceCtorEq, if_false] + rw [hwmove, rev_idle_eq houtne] + · have hc : (c.work 0).HasBinaryContent acc := hwork.2 + simpa using hc.move Dir3.left + · show ((c.work 0).move Dir3.left).cells 0 = _ + rw [Tape.move_cells]; exact hw0 + · show ((c.work 0).move Dir3.left).head = _ + simp only [Tape.move, hwork.1, List.append_nil] + omega + | cons b w ih => + intro acc c hstate hsuf hwork hw0 hout + have hread : c.input.read = Γ.ofBool b := hsuf.read_cons + have houtne : c.output.read ≠ Γ.start := by rw [hout.read_blank]; decide + set c1 : Cfg 1 reverseTM.Q := + { state := RevPhase.copy + input := c.input.move Dir3.right + work := fun i => (c.work i).writeAndMove (Γ.ofBool b) Dir3.right + output := c.output } with hc1 + have hstep : reverseTM.step c = some c1 := by + cases b <;> + · simp only [TM.step, hstate, reverseTM, hread, Γ.ofBool, hc1, + reduceCtorEq, if_false] + rw [rev_idle_eq houtne] + rfl + obtain ⟨c', hreach, hst, hcont, hcz, hhd, hinp, hpre⟩ := + ih (acc ++ [b]) c1 rfl hsuf.move_right_cons + (by rw [hc1]; exact Tape.hasBinaryPrefix_write_bit b hwork) + (by + show ((c.work 0).writeAndMove (Γ.ofBool b) Dir3.right).cells 0 = Γ.start + exact Tape.write_move_cell0 _ _ hw0) + (by rw [hc1]; exact hout) + refine ⟨c', .step hstep hreach, hst, ?_, hcz, ?_, hinp, hpre⟩ + · simpa using hcont + · simpa using hhd + +/-- The emit phase: from `emit` with the work tape holding `bits` and its head on +cell `j`, the machine writes `bits.take j` backwards to the output and halts. -/ +private theorem reverseTM_emit_loop : + ∀ (j : ℕ) (bits acc : List Bool) (c : Cfg 1 reverseTM.Q), + c.state = RevPhase.emit → + (c.work 0).HasBinaryContent bits → + (c.work 0).cells 0 = Γ.start → + (c.work 0).head = j → j ≤ bits.length → + c.input.read ≠ Γ.start → + c.output.HasBinaryPrefix acc → + ∃ c', reverseTM.reachesIn (j + 1) c c' ∧ reverseTM.halted c' ∧ + c'.output.HasBinaryPrefix (acc ++ (bits.take j).reverse) := by + intro j + induction j with + | zero => + intro bits acc c hstate hcont hw0 hhead _ hinp hout + have hwread : (c.work 0).read = Γ.start := by rw [Tape.read, hhead]; exact hw0 + have hwne0 : ¬ (c.work 0).read = Γ.zero := by rw [hwread]; decide + have hwne1 : ¬ (c.work 0).read = Γ.one := by rw [hwread]; decide + have houtne : c.output.read ≠ Γ.start := by rw [hout.read_blank]; decide + have hinp_eq : c.input.move (idleDir c.input.read) = c.input := by + rw [idleDir, if_neg hinp, Tape.move] + refine ⟨{ state := RevPhase.done + input := c.input + work := fun i => (c.work i).move Dir3.right + output := c.output }, ?_, rfl, by simpa using hout⟩ + refine .step ?_ .zero + have hwork : (fun i => (c.work i).writeAndMove (readBackWrite ((c.work i).read)).toΓ + (idleDir ((c.work i).read))) = fun i => (c.work i).move Dir3.right := by + funext i + have hi : i = 0 := Subsingleton.elim i 0 + subst hi + rw [Tape.writeAndMove, Tape.write, if_pos (by omega : (c.work 0).head = 0), + idleDir, if_pos hwread] + simp only [TM.step, hstate, reverseTM, hinp_eq, hwne0, hwne1, reduceCtorEq, + if_false] + rw [hwork, rev_idle_eq houtne] + | succ j ih => + intro bits acc c hstate hcont hw0 hhead hjb hinp hout + have hjlt : j < bits.length := by omega + have hwread : (c.work 0).read = Γ.ofBool (bits[j]'hjlt) := by + rw [Tape.read, hhead]; exact hcont.1 j hjlt + have hwne : (c.work 0).read ≠ Γ.start := by + rw [hwread]; exact Γ.ofBool_ne_start _ + have hinp_eq : c.input.move (idleDir c.input.read) = c.input := by + rw [idleDir, if_neg hinp, Tape.move] + have hwmove : (fun i => (c.work i).writeAndMove (readBackWrite ((c.work i).read)).toΓ + (moveLeftDir ((c.work i).read))) = fun i => (c.work i).move Dir3.left := by + funext i + have hi : i = 0 := Subsingleton.elim i 0 + subst hi + rw [moveLeftDir, if_neg hwne] + exact writeAndMove_readBack _ hwne _ + set c1 : Cfg 1 reverseTM.Q := + { state := RevPhase.emit + input := c.input + work := fun i => (c.work i).move Dir3.left + output := c.output.writeAndMove (Γ.ofBool (bits[j]'hjlt)) Dir3.right } with hc1 + have hstep : reverseTM.step c = some c1 := by + rcases hb : bits[j]'hjlt with _ | _ + · have h0 : (c.work 0).read = Γ.zero := by rw [hwread, hb]; rfl + simp only [TM.step, hstate, reverseTM, hinp_eq, h0, hc1, hb, Γ.ofBool, + reduceCtorEq, if_false, reduceIte] + rw [hwmove] + rfl + · have h1 : (c.work 0).read = Γ.one := by rw [hwread, hb]; rfl + simp only [TM.step, hstate, reverseTM, hinp_eq, h1, hc1, hb, Γ.ofBool, + reduceCtorEq, if_false, reduceIte] + rw [hwmove] + rfl + obtain ⟨c', hreach, hhalt, hfin⟩ := + ih bits (acc ++ [bits[j]'hjlt]) c1 rfl + (by rw [hc1]; exact hcont.move Dir3.left) + (by rw [hc1]; show ((c.work 0).move Dir3.left).cells 0 = _ + rw [Tape.move_cells]; exact hw0) + (by rw [hc1]; show ((c.work 0).move Dir3.left).head = _ + simp only [Tape.move, hhead]; omega) + (by omega) + (by rw [hc1]; exact hinp) + (by rw [hc1]; exact Tape.hasBinaryPrefix_write_bit _ hout) + refine ⟨c', .step hstep hreach, hhalt, ?_⟩ + have hsplit : bits.take (j + 1) = bits.take j ++ [bits[j]'hjlt] := by + rw [List.take_add_one, List.getElem?_eq_getElem hjlt] + rfl + have heq : acc ++ (bits.take (j + 1)).reverse + = (acc ++ [bits[j]'hjlt]) ++ (bits.take j).reverse := by + rw [hsplit]; simp + rw [heq] + exact hfin + +/-- `reverseTM` computes `List.reverse` in `2 · |x| + 3` steps. -/ +theorem reverseTM_computesInTime : + reverseTM.ComputesInTime (fun x : List Bool => x.reverse) (fun n => 2 * n + 3) := by + intro x + set c1 : Cfg 1 reverseTM.Q := + { state := RevPhase.copy + input := (Tape.init (x.map Γ.ofBool)).move Dir3.right + work := fun _ => (Tape.init []).move Dir3.right + output := (Tape.init []).move Dir3.right } with hc1 + have hstep1 : reverseTM.step (reverseTM.initCfg x) = some c1 := by + simp [TM.step, reverseTM, hc1, Tape.read, Tape.init, readBackWrite, + Tape.writeAndMove, Tape.write, Tape.move] + obtain ⟨c2, hreach2, hst2, hcont2, hcz2, hhd2, hinp2, hout2⟩ := + reverseTM_copy_loop x [] c1 rfl + (by rw [hc1]; exact Tape.init_move_right_hasBinarySuffix x) + (by rw [hc1]; exact Tape.init_nil_move_right_hasBinaryPrefix_nil) + (by rw [hc1]; show ((Tape.init ([] : List Γ)).move Dir3.right).cells 0 = _ + rw [Tape.move_cells]; simp) + (by rw [hc1]; exact Tape.init_nil_move_right_hasBinaryPrefix_nil) + obtain ⟨c', hreach', hhalt', hfin⟩ := + reverseTM_emit_loop x.length x [] c2 hst2 (by simpa using hcont2) hcz2 + (by simpa using hhd2) le_rfl hinp2 hout2 + refine ⟨c', ((x.length + 1) + (x.length + 1)) + 1, by simp; omega, + .step hstep1 (reverseTM.reachesIn_trans hreach2 hreach'), hhalt', ?_⟩ + rw [List.nil_append, List.take_length] at hfin + exact hfin.hasOutput + +/-- Internal proof that string reversal is in `FP`. -/ +theorem reverse_mem_FP : + (fun x : List Bool => x.reverse) ∈ FP := by + refine ⟨1, 1, reverseTM, (fun n => 2 * n + 3), reverseTM_computesInTime, ?_⟩ + have hn : (fun n : ℕ => 2 * n) =O ((· ^ 1) : ℕ → ℕ) := by + simpa [pow_one] using (BigO.refl (fun n : ℕ => n)).const_mul_left 2 + exact BigO.add hn (BigO.const_le_pow 3 1) + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/Simulate.lean b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/Simulate.lean new file mode 100644 index 0000000000..32310b9bc2 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/Simulate.lean @@ -0,0 +1,536 @@ +/- +Copyright (c) 2026 Bolton Bailey. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Bolton Bailey +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.Extract +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.StepAlgebra +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.OutputBounds + +/-! +# Running a machine inside the algebra — proof internals + +Everything the completeness direction needs about a *run*, as opposed to a single +step: a total step function that stands still once the machine has halted, the +standing invariants of a run (the left-end marker where it belongs, every head +inside the encoded window), and the iterated versions of `Cobham.stepFn` and +`Cobham.rewindFn`. + +## Main results + +- `Complexity.TM.runCfg` — the configuration after `n` steps, halting-idempotent +- `Complexity.Cobham.iterate_stepFn` — the encoded iteration tracks it +- `Complexity.Cobham.iterate_rewindFn` — the rewind iteration drives the head to + cell `0` +-/ + + +@[expose] public section + +namespace Complexity + +namespace TM + +variable {k : ℕ} + +/-! ## A total run -/ + +/-- The configuration after `n` steps, standing still once halted. -/ +def runCfg (tm : TM k) (c : Cfg k tm.Q) : ℕ → Cfg k tm.Q + | 0 => c + | n + 1 => (tm.step (runCfg tm c n)).getD (runCfg tm c n) + +@[simp] theorem runCfg_zero (tm : TM k) (c : Cfg k tm.Q) : runCfg tm c 0 = c := rfl + +theorem runCfg_succ (tm : TM k) (c : Cfg k tm.Q) (n : ℕ) : + runCfg tm c (n + 1) = (tm.step (runCfg tm c n)).getD (runCfg tm c n) := rfl + +theorem runCfg_add (tm : TM k) (c : Cfg k tm.Q) (a b : ℕ) : + runCfg tm c (a + b) = runCfg tm (runCfg tm c a) b := by + induction b with + | zero => rfl + | succ b ih => rw [show a + (b + 1) = (a + b) + 1 from by omega, runCfg_succ, ih, + runCfg_succ] + +/-- Once halted, the run stands still. -/ +theorem runCfg_of_halted (tm : TM k) {c : Cfg k tm.Q} (h : c.state = tm.qhalt) (n : ℕ) : + runCfg tm c n = c := by + induction n with + | zero => rfl + | succ n ih => rw [runCfg_succ, ih, TM.step, if_pos h, Option.getD_none] + +/-- A run of exactly `t` steps is the `t`-th iterate. -/ +theorem runCfg_of_reachesIn (tm : TM k) {c c' : Cfg k tm.Q} {t : ℕ} + (h : tm.reachesIn t c c') : runCfg tm c t = c' := by + induction h with + | zero => rfl + | @step c c'' t c' hstep _ ih => + rw [show t + 1 = 1 + t from by omega, runCfg_add, runCfg_succ, runCfg_zero, hstep, + Option.getD_some, ih] + +/-! ## The standing invariants of a run -/ + +/-- One step preserves the left-end marker's position on every tape. -/ +theorem step_startInvariant (tm : TM k) {c c' : Cfg k tm.Q} (h : tm.step c = some c') + (hin : c.input.StartInvariant) (hwork : ∀ i, (c.work i).StartInvariant) + (hout : c.output.StartInvariant) : + c'.input.StartInvariant ∧ (∀ i, (c'.work i).StartInvariant) ∧ + c'.output.StartInvariant := by + rw [TM.step, if_neg (TM.state_ne_qhalt_of_step h)] at h + injection h with h + subst h + exact ⟨hin.move _, fun i => (hwork i).writeAndMove _ _, hout.writeAndMove _ _⟩ + +/-- One step moves every head by at most one cell. -/ +theorem step_head_le (tm : TM k) {c c' : Cfg k tm.Q} (h : tm.step c = some c') : + c'.input.head ≤ c.input.head + 1 ∧ (∀ i, (c'.work i).head ≤ (c.work i).head + 1) ∧ + c'.output.head ≤ c.output.head + 1 := by + rw [TM.step, if_neg (TM.state_ne_qhalt_of_step h)] at h + injection h with h + subst h + exact ⟨Tape.head_move_le _ _, fun i => Tape.head_writeAndMove_le _ _ _, + Tape.head_writeAndMove_le _ _ _⟩ + +/-- **Every tape of a run keeps its left-end marker.** -/ +theorem runCfg_startInvariant (tm : TM k) (x : List Bool) (n : ℕ) : + (runCfg tm (tm.initCfg x) n).input.StartInvariant ∧ + (∀ i, ((runCfg tm (tm.initCfg x) n).work i).StartInvariant) ∧ + (runCfg tm (tm.initCfg x) n).output.StartInvariant := by + induction n with + | zero => + exact ⟨Tape.StartInvariant.init_ofBool x, fun _ => Tape.StartInvariant.init_nil, + Tape.StartInvariant.init_nil⟩ + | succ n ih => + rw [runCfg_succ] + cases hs : tm.step (runCfg tm (tm.initCfg x) n) with + | none => rw [Option.getD_none]; exact ih + | some c' => + rw [Option.getD_some] + exact step_startInvariant tm hs ih.1 ih.2.1 ih.2.2 + +/-- **After `n` steps every head is within `n` cells of the start.** -/ +theorem runCfg_head_le (tm : TM k) (x : List Bool) (n : ℕ) : + (runCfg tm (tm.initCfg x) n).input.head ≤ n ∧ + (∀ i, ((runCfg tm (tm.initCfg x) n).work i).head ≤ n) ∧ + (runCfg tm (tm.initCfg x) n).output.head ≤ n := by + induction n with + | zero => exact ⟨by simp, fun _ => by simp, by simp⟩ + | succ n ih => + rw [runCfg_succ] + cases hs : tm.step (runCfg tm (tm.initCfg x) n) with + | none => rw [Option.getD_none]; exact ⟨by omega, fun i => by have := ih.2.1 i; omega, + by omega⟩ + | some c' => + rw [Option.getD_some] + obtain ⟨h1, h2, h3⟩ := step_head_le tm hs + exact ⟨by omega, fun i => by have := h2 i; have := ih.2.1 i; omega, by omega⟩ + +end TM + +namespace Cobham + +variable {k : ℕ} + +/-- The invariants of a run, in the form the encoding lemmas want. -/ +theorem cfgTapes_runCfg_inv (tm : TM k) (x : List Bool) (n W : ℕ) (hn : n ≤ W) : + (∀ t ∈ cfgTapes (TM.runCfg tm (tm.initCfg x) n), t.StartInvariant) ∧ + (∀ t ∈ cfgTapes (TM.runCfg tm (tm.initCfg x) n), t.head ≤ W) := by + obtain ⟨i1, w1, o1⟩ := TM.runCfg_startInvariant tm x n + obtain ⟨i2, w2, o2⟩ := TM.runCfg_head_le tm x n + constructor <;> intro t ht <;> + · rw [cfgTapes, List.mem_cons, List.mem_cons, List.mem_ofFn] at ht + rcases ht with rfl | rfl | ⟨i, rfl⟩ + · first | exact i1 | omega + · first | exact o1 | omega + · first | exact w1 i | (have := w2 i; omega) + +/-- **The encoded iteration tracks the run.** -/ +theorem iterate_stepFn (tm : TM k) (W : ℕ) (x : List Bool) + (hq : Fintype.card tm.Q ≤ blockWidth W) : + ∀ n : ℕ, n ≤ W → + (stepFn tm (blockRuler W))^[n] (cfgCode W (tm.initCfg x)) + = cfgCode W (TM.runCfg tm (tm.initCfg x) n) := by + intro n + induction n with + | zero => intro _; rfl + | succ n ih => + intro hn + obtain ⟨hinv, hW⟩ := cfgTapes_runCfg_inv tm x n W (by omega) + rw [Function.iterate_succ_apply', ih (by omega), TM.runCfg_succ] + cases hs : tm.step (TM.runCfg tm (tm.initCfg x) n) with + | none => + rw [Option.getD_none] + exact stepFn_halted tm (TM.step_eq_none_iff_halted.mp hs) hq hW + | some c' => + rw [Option.getD_some] + have hgood := stepActs_forall₂ tm _ hinv hW + refine stepFn_eq tm hs hq hW ?_ ?_ hgood + · exact hinv _ (by simp [cfgTapes]) + · intro i + exact hinv _ (by + rw [cfgTapes] + exact List.mem_cons_of_mem _ (List.mem_cons_of_mem _ + (List.mem_ofFn.mpr ⟨i, rfl⟩))) + +/-! ## The rewind iteration -/ + +private theorem head_move_left (s : Tape) : (s.move Dir3.left).head = s.head - 1 := rfl + +/-- Iterated left moves. -/ +private theorem head_moveLeft (t : Tape) (n : ℕ) : + ((fun s : Tape => s.move Dir3.left)^[n] t).head = t.head - n ∧ + ((fun s : Tape => s.move Dir3.left)^[n] t).cells = t.cells := by + induction n with + | zero => exact ⟨rfl, rfl⟩ + | succ n ih => + rw [Function.iterate_succ_apply'] + refine ⟨?_, ?_⟩ + · rw [head_move_left, ih.1] + omega + · rw [Tape.move_cells, ih.2] + +private theorem startInvariant_moveLeft (t : Tape) (h : t.StartInvariant) (n : ℕ) : + ((fun s : Tape => s.move Dir3.left)^[n] t).StartInvariant := by + induction n with + | zero => exact h + | succ n ih => rw [Function.iterate_succ_apply']; exact ih.move _ + +/-- **The rewind iteration walks the head left.** -/ +theorem iterate_rewindFn {W : ℕ} (t : Tape) (hinv : t.StartInvariant) (hW : t.head ≤ W) : + ∀ n : ℕ, (rewindFn (blockRuler W))^[n] (pairCode W t) + = pairCode W ((fun s : Tape => s.move Dir3.left)^[n] t) := by + intro n + induction n with + | zero => rfl + | succ n ih => + rw [Function.iterate_succ_apply', ih, Function.iterate_succ_apply'] + exact rewindFn_eq _ (startInvariant_moveLeft t hinv n) + (by have := (head_moveLeft t n).1; omega) + +/-- **After enough rewinding the head is at cell `0`.** -/ +theorem rewound (t : Tape) {n : ℕ} (h : t.head ≤ n) : + (fun s : Tape => s.move Dir3.left)^[n] t + = { head := 0, cells := t.cells } := by + obtain ⟨h1, h2⟩ := head_moveLeft t n + refine Tape.ext ?_ h2 + show ((fun s : Tape => s.move Dir3.left)^[n] t).head = 0 + rw [h1] + omega + +/-! ## Reading the output off the rewound tape + +With the head at cell `0` the tape's right half-block is the whole window, in +order and two bits per cell. The first bit of each cell says whether it holds +data — `symCode` is arranged so that only `0` and `1` have it set — and the +second is the bit itself. So the output is the second bits, truncated where the +first bits stop: `Complexity.cellBits` twice and one `Complexity.runTrue`. -/ + +@[simp] theorem cellsCode_one (t : Tape) (i : ℕ) : + cellsCode t i 1 = symCode (t.cells i) := by + rw [cellsCode_succ_left, cellsCode_zero, List.append_nil] + +/-- Reading one bit of an aligned window is reading one bit of a cell's code. -/ +theorem bitOf_cellsCode (t : Tape) {w j : ℕ} (hj : j < w) {o : ℕ} (ho : o < 2) : + bitOf (cellsCode t 0 w) (2 * j + o) = bitOf (symCode (t.cells j)) o := by + have hsplit : cellsCode t 0 w + = cellsCode t 0 j ++ (cellsCode t j 1 ++ cellsCode t (j + 1) (w - j - 1)) := by + conv_lhs => rw [show w = j + (1 + (w - j - 1)) from by omega] + rw [cellsCode_add t 0 j, cellsCode_add t (0 + j) 1 (w - j - 1)] + simp only [Nat.zero_add] + have hlen1 : (cellsCode t 0 j).length = 2 * j := cellsCode_length _ _ _ + have hlen2 : (cellsCode t j 1).length = 2 := by rw [cellsCode_one, symCode_length] + rw [hsplit, bitOf_append_right (by omega), hlen1, + show 2 * j + o - 2 * j = o from by omega, bitOf_append_left (by omega), + cellsCode_one] + +/-- A padded block of exactly the ruler's width is the block itself. -/ +private theorem padTo_of_length_eq {r x : List Bool} (h : x.length = r.length) : + padTo r x = x := by + rw [padTo_eq_append r x h.le, h, Nat.sub_self, List.replicate_zero, List.append_nil] + +/-- The aligned window of a rewound tape is its right half-block. -/ +theorem drop_pairCode_rewound (W : ℕ) (t : Tape) : + (pairCode W { head := 0, cells := t.cells }).drop (blockRuler W).length + = cellsCode t 0 (W + 1) := by + rw [drop_pairCode, rightCode] + refine padTo_of_length_eq ?_ + rw [cellsCode_length, blockRuler_length, blockWidth] + rfl + +/-- **Reading the output off an aligned window.** -/ +theorem output_of_cellsCode {W : ℕ} (t : Tape) (y : List Bool) + (hy : t.HasOutput y) (hyW : y.length + 1 ≤ W) : + (cellBits 3 (cellsCode t 0 (W + 1)) W).take + (runTrue (cellBits 2 (cellsCode t 0 (W + 1)) W) W).length = y := by + set u := cellsCode t 0 (W + 1) with hu + -- Each cell's two bits, read out of the window. + have hcell : ∀ (i : ℕ), i < W → ∀ o < 2, + bitOf u (2 * i + (2 + o)) = bitOf (symCode (t.cells (i + 1))) o := by + intro i hi o ho + rw [hu, show 2 * i + (2 + o) = 2 * (i + 1) + o from by omega, + bitOf_cellsCode t (by omega) ho] + have hflag : ∀ i < W, bitOf (cellBits 2 u W) i + = bitOf (symCode (t.cells (i + 1))) 0 := by + intro i hi + rw [bitOf_eq_getElem (by rw [cellBits_length]; exact hi), + ← Option.some_inj, ← List.getElem?_eq_getElem, cellBits_getElem? 2 u W i hi, + Option.some_inj] + exact hcell i hi 0 (by omega) + have hbit : ∀ i < W, bitOf (cellBits 3 u W) i + = bitOf (symCode (t.cells (i + 1))) 1 := by + intro i hi + rw [bitOf_eq_getElem (by rw [cellBits_length]; exact hi), + ← Option.some_inj, ← List.getElem?_eq_getElem, cellBits_getElem? 3 u W i hi, + Option.some_inj] + have := hcell i hi 1 (by omega) + rwa [show 2 * i + (2 + 1) = 2 * i + 3 from by omega] at this + -- The data flags are `true` exactly on the output. + have hlen : (runTrue (cellBits 2 u W) W).length = y.length := by + have h1 : ∀ i < y.length, bitOf (cellBits 2 u W) i = true := by + intro i hi + rw [hflag i (by omega), hy.1 i hi] + cases y[i] <;> rfl + have h2 : bitOf (cellBits 2 u W) y.length = false := by + rw [hflag y.length (by omega), hy.2] + rfl + rw [runTrue_length h1 h2 W] + omega + rw [hlen] + refine List.ext_getElem (by rw [List.length_take, cellBits_length]; omega) ?_ + intro i h1 h2 + rw [List.getElem_take] + have hiy : i < y.length := by + rwa [List.length_take, cellBits_length, min_eq_left (by omega : y.length ≤ W)] at h1 + rw [← bitOf_eq_getElem (by rw [cellBits_length]; omega), hbit i (by omega), + hy.1 i hiy] + cases hb : y[i] <;> rfl + +/-! ## The whole simulation + +Everything above, wired together: a clock long enough to run the machine to a +halt and to rewind the output head, a first iteration that runs the machine, a +second that rewinds, and the extraction. -/ + +private theorem length_flatten_replicate (u : List Bool) : + ∀ n : ℕ, (List.replicate n u).flatten.length = n * u.length := by + intro n + induction n with + | zero => simp + | succ n ih => + rw [List.replicate_succ, List.flatten_cons, List.length_append, ih] + ring + +theorem initFn_length (tm : TM k) (R x : List Bool) : + (initFn tm R x).length = (2 * (k + 2) + 1) * R.length := by + rw [initFn] + simp only [List.length_append, padTo_length, length_flatten_replicate] + ring + +/-- **A polynomial bound with room for the clock's other duties**: the clock has +to outlast the machine, cover the input, and be wide enough for the state code. -/ +private theorem exists_clock_bound (tm : TM k) {T : ℕ → ℕ} {S D : ℕ} + (hSD : ∀ n, T n ≤ S * (n + 1) ^ D) : + ∃ C E : ℕ, ∀ n : ℕ, T n + n + Fintype.card tm.Q + 2 ≤ C * (n + 1) ^ E := by + refine ⟨S + Fintype.card tm.Q + 2, max D 1, fun n => ?_⟩ + have h1 : T n ≤ S * (n + 1) ^ max D 1 := + le_trans (hSD n) + (Nat.mul_le_mul_left _ (Nat.pow_le_pow_right (by omega) (le_max_left _ _))) + have h2 : n + 1 ≤ (n + 1) ^ max D 1 := Nat.le_self_pow (by omega) _ + have h3 : n + Fintype.card tm.Q + 2 ≤ (Fintype.card tm.Q + 2) * (n + 1) := by + have : 1 * n ≤ (Fintype.card tm.Q + 2) * n := Nat.mul_le_mul_right _ (by omega) + rw [Nat.mul_add, Nat.mul_one] + omega + calc T n + n + Fintype.card tm.Q + 2 + ≤ S * (n + 1) ^ max D 1 + (Fintype.card tm.Q + 2) * (n + 1) := by omega + _ ≤ S * (n + 1) ^ max D 1 + (Fintype.card tm.Q + 2) * (n + 1) ^ max D 1 := + Nat.add_le_add_left (Nat.mul_le_mul_left _ h2) _ + _ = (S + Fintype.card tm.Q + 2) * (n + 1) ^ max D 1 := by ring + +/-! ### The three stages, as functions of the clock + +The clock string `u` fixes the encoded window: the ruler is `2|u|` bits wide, so +the window is `W = |u| - 1` cells and `u.tail` is a ruler of exactly `W` bits. -/ + +/-- The block ruler belonging to a clock value. -/ +def clockRuler (u : List Bool) : List Bool := List.replicate (u ++ u).length false + +theorem clockRuler_eq {u : List Bool} (h : 1 ≤ u.length) : + clockRuler u = blockRuler (u.length - 1) := by + rw [clockRuler, blockRuler, blockWidth] + congr 1 + rw [List.length_append] + omega + +theorem clockRulerFn {n : ℕ} {gu : (Fin n → List Bool) → List Bool} (hu : Cobham gu) : + Cobham fun w : Fin n → List Bool => clockRuler (gu w) := + (zeroBlockFn (appendFn hu hu)).of_eq fun _ => rfl + +/-- Stage one: the encoding after running the machine to a halt. -/ +noncomputable def runFn (tm : TM k) (u x : List Bool) : List Bool := + (stepFn tm (clockRuler u))^[u.tail.length] (initFn tm (clockRuler u) x) + +/-- Stage two: the output tape's two half-blocks, head rewound to cell `0`. -/ +noncomputable def outPairFn (tm : TM k) (u x : List Bool) : List Bool := + (rewindFn (clockRuler u))^[u.length] + (blockAt (clockRuler u) (runFn tm u x) 3 ++ blockAt (clockRuler u) (runFn tm u x) 4) + +/-- Stage three: the string on the rewound output tape. -/ +noncomputable def simFn (tm : TM k) (u x : List Bool) : List Bool := + (cellBits 3 ((outPairFn tm u x).drop (clockRuler u).length) u.tail.length).take + (runTrue (cellBits 2 ((outPairFn tm u x).drop (clockRuler u).length) u.tail.length) + u.tail.length).length + +/-- The simulated run never leaves its blocks. -/ +theorem iterate_stepFn_length_le (tm : TM k) (R x : List Bool) (n : ℕ) : + ((stepFn tm R)^[n] (initFn tm R x)).length ≤ (2 * (k + 2) + 1) * R.length := by + induction n with + | zero => exact (initFn_length tm R x).le + | succ n ih => rw [Function.iterate_succ_apply']; exact stepFn_length_le tm R _ ih + +/-- The rewind never leaves its two blocks. -/ +theorem iterate_rewindFn_length_le (R z : List Bool) (hz : z.length ≤ 2 * R.length) + (n : ℕ) : ((rewindFn R)^[n] z).length ≤ 2 * R.length := by + induction n with + | zero => exact hz + | succ n ih => rw [Function.iterate_succ_apply']; exact rewindFn_length_le R _ ih + +private theorem tail_cons₂ (a b : List Bool) : Fin.tail ![a, b] = fun _ => b := by + funext i + rw [Subsingleton.elim i 0] + rfl + +private theorem cons_val_one (s : List Bool) (v : Fin 1 → List Bool) : + (Fin.cons s v : Fin 2 → List Bool) 1 = v 0 := rfl + +private theorem cons_val_zero' (s : List Bool) (v : Fin 1 → List Bool) : + (Fin.cons s v : Fin 2 → List Bool) 0 = s := rfl + +/-- **The whole simulation is in the algebra.** -/ +theorem simFn_mem (tm : TM k) {gu : (Fin 1 → List Bool) → List Bool} + (hu : Cobham gu) : Cobham fun v : Fin 1 → List Bool => simFn tm (gu v) (v 0) := by + have hu2 : Cobham fun w : Fin 2 → List Bool => gu (fun _ => w 1) := + (Cobham.comp hu fun _ : Fin 1 => Cobham.proj 1).of_eq fun _ => rfl + have hu1 : Cobham fun w : Fin 1 → List Bool => gu (fun _ => w 0) := + (Cobham.comp hu fun _ : Fin 1 => Cobham.proj 0).of_eq fun _ => rfl + have huu : ∀ w : Fin 1 → List Bool, gu (fun _ => w 0) = gu w := fun w => by + congr 1 + funext i + rw [Subsingleton.elim i 0] + -- Stage one. + have hrun : Cobham fun v : Fin 1 → List Bool => runFn tm (gu v) (v 0) := by + have hstage := + iterFn (e := fun w : Fin 1 → List Bool => + initFn tm (clockRuler (gu (fun _ => w 0))) (w 0)) + (f := fun w : Fin 2 → List Bool => + stepFn tm (clockRuler (gu (fun _ => w 1))) (w 0)) + (j := fun w : Fin 2 → List Bool => + (List.replicate (2 * (k + 2) + 1) + (clockRuler (gu (fun _ => w 1)))).flatten) + (initFn_mem tm (clockRulerFn hu1) (Cobham.proj 0)) + (stepFn_mem tm (clockRulerFn hu2) (Cobham.proj 0)) + (repeatFn (clockRulerFn hu2) _) ?_ + · refine (comp₂ hstage (tailFn hu1) (Cobham.proj 0)).of_eq fun v => ?_ + simp only [tail_cons₂, cons_val_one, cons_val_zero', Matrix.cons_val_zero] + rw [runFn, huu] + · intro c v + have := iterate_stepFn_length_le tm (clockRuler (gu fun _ => v 0)) (v 0) c.length + rw [length_flatten_replicate] + exact this + -- Stage two. + have hpair : Cobham fun v : Fin 1 → List Bool => outPairFn tm (gu v) (v 0) := by + have hstage := + iterFn (e := fun w : Fin 1 → List Bool => + blockAt (clockRuler (gu (fun _ => w 0))) (runFn tm (gu (fun _ => w 0)) (w 0)) 3 + ++ blockAt (clockRuler (gu (fun _ => w 0))) + (runFn tm (gu (fun _ => w 0)) (w 0)) 4) + (f := fun w : Fin 2 → List Bool => + rewindFn (clockRuler (gu (fun _ => w 1))) (w 0)) + (j := fun w : Fin 2 → List Bool => + clockRuler (gu (fun _ => w 1)) ++ clockRuler (gu (fun _ => w 1))) + (appendFn (blockFn (clockRulerFn hu1) (hrun.of_eq fun v => by rw [huu]) 3) + (blockFn (clockRulerFn hu1) (hrun.of_eq fun v => by rw [huu]) 4)) + (rewindFn_mem (clockRulerFn hu2) (Cobham.proj 0)) + (appendFn (clockRulerFn hu2) (clockRulerFn hu2)) ?_ + · refine (comp₂ hstage hu1 (Cobham.proj 0)).of_eq fun v => ?_ + simp only [tail_cons₂, cons_val_one, cons_val_zero', Matrix.cons_val_zero] + rw [outPairFn, huu] + · intro c v + simp only [cons_val_one, cons_val_zero'] + have hb : ((rewindFn (clockRuler (gu fun _ => v 0)))^[c.length] + (blockAt (clockRuler (gu fun _ => v 0)) (runFn tm (gu fun _ => v 0) (v 0)) 3 ++ + blockAt (clockRuler (gu fun _ => v 0)) + (runFn tm (gu fun _ => v 0) (v 0)) 4)).length + ≤ 2 * (clockRuler (gu fun _ => v 0)).length := by + refine iterate_rewindFn_length_le _ _ ?_ _ + rw [List.length_append, blockAt, blockAt, List.length_take, List.length_take] + omega + rw [List.length_append] + exact le_trans hb (by omega) + -- Stage three. + have hdrop : Cobham fun v : Fin 1 → List Bool => + (outPairFn tm (gu v) (v 0)).drop (clockRuler (gu v)).length := + dropFn (clockRulerFn hu) hpair + exact (takeFn (runTrueFn (tailFn hu) (cellBitsFn 2 (tailFn hu) hdrop)) + (cellBitsFn 3 (tailFn hu) hdrop)).of_eq fun v => by rw [simFn] + +/-- **The simulation computes the machine's function.** Provided the clock +outlasts the run, covers the input and is wide enough for the state code, the +three stages reproduce exactly the string the machine leaves on its output +tape. -/ +theorem simFn_eq (tm : TM k) {T : ℕ → ℕ} {f : List Bool → List Bool} + (hcomp : tm.ComputesInTime f T) (u x : List Bool) + (hlen : T x.length + x.length + Fintype.card tm.Q + 2 ≤ u.length) : + simFn tm u x = f x := by + have hu1 : 1 ≤ u.length := by omega + have hR : clockRuler u = blockRuler (u.length - 1) := clockRuler_eq hu1 + have htail : u.tail.length = u.length - 1 := List.length_tail + have hq : Fintype.card tm.Q ≤ blockWidth (u.length - 1) := by rw [blockWidth]; omega + obtain ⟨c', t, ht, hreach, hhalt, hout⟩ := hcomp x + have hylen : (f x).length ≤ t := TM.output_length_le_of_reachesIn hreach hout + have hrunW : TM.runCfg tm (tm.initCfg x) (u.length - 1) = c' := by + rw [show u.length - 1 = t + (u.length - 1 - t) from by omega, TM.runCfg_add, + TM.runCfg_of_reachesIn tm hreach, TM.runCfg_of_halted tm hhalt] + have hrun : runFn tm u x = cfgCode (u.length - 1) c' := by + rw [runFn, hR, htail, initFn_eq tm _ x (by omega), + iterate_stepFn tm _ x hq _ le_rfl, hrunW] + obtain ⟨hinv, hWh⟩ := cfgTapes_runCfg_inv tm x (u.length - 1) (u.length - 1) le_rfl + rw [hrunW] at hinv hWh + have hmem : c'.output ∈ cfgTapes c' := by simp [cfgTapes] + have hstart : c'.output.StartInvariant := hinv _ hmem + have hhead : c'.output.head ≤ u.length - 1 := hWh _ hmem + obtain ⟨hb3, hb4⟩ := + blockAt_cfgCode_tape (u.length - 1) c' 1 (by rw [cfgTapes_length]; omega) + have hidx : (cfgTapes c')[1]'(by rw [cfgTapes_length]; omega) = c'.output := rfl + rw [hidx, show 2 * 1 + 1 = 3 from rfl] at hb3 + rw [hidx, show 2 * 1 + 2 = 4 from rfl] at hb4 + have hpair : blockAt (clockRuler u) (runFn tm u x) 3 + ++ blockAt (clockRuler u) (runFn tm u x) 4 = pairCode (u.length - 1) c'.output := by + rw [hrun, hR, hb3, hb4, pairCode] + have hrew : outPairFn tm u x + = pairCode (u.length - 1) { head := 0, cells := c'.output.cells } := by + rw [outPairFn, hpair, hR, iterate_rewindFn c'.output hstart hhead u.length, + rewound c'.output (by omega)] + have hdropeq : (outPairFn tm u x).drop (clockRuler u).length + = cellsCode c'.output 0 (u.length - 1 + 1) := by + rw [hrew, hR, drop_pairCode_rewound] + rw [simFn, htail, hdropeq] + exact output_of_cellsCode c'.output (f x) hout (by omega) + +/-- **The completeness direction, for one machine.** -/ +theorem computes_mem_CobhamFP (tm : TM k) {T : ℕ → ℕ} {S D : ℕ} + (hSD : ∀ n, T n ≤ S * (n + 1) ^ D) {f : List Bool → List Bool} + (hcomp : tm.ComputesInTime f T) : CobhamFP f := by + obtain ⟨C, E, hCE⟩ := exists_clock_bound tm hSD + obtain ⟨clk, hclk, hclklen⟩ := exists_pow_clock C E + have hclk1 : Cobham fun w : Fin 1 → List Bool => clk (fun _ => w 0) := + (Cobham.comp hclk fun _ : Fin 1 => Cobham.proj 0).of_eq fun _ => rfl + refine ((simFn_mem tm hclk1).of_eq fun v => ?_ : Cobham fun v : Fin 1 → List Bool => + f (v 0)) + refine simFn_eq tm hcomp _ (v 0) (le_trans (hCE (v 0).length) ?_) + exact hclklen (fun _ => v 0) + +end Cobham + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/SndBlock.lean b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/SndBlock.lean new file mode 100644 index 0000000000..431155d7f9 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/SndBlock.lean @@ -0,0 +1,452 @@ +/- +Copyright (c) 2026 Bolton Bailey. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Bolton Bailey +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.BlockScan +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.Counter +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Tape.Encoding + +/-! +# The block-suffix decoder — proof internals + +`Cobham.sndBlockTM` scans the doubled payload two bits at a time until the +`[false, true]` separator, then copies the rest of the input to the output. +Malformed input halts with empty output, matching `unpair? = none`. + +## Main results + +- `Cobham.sndBlock_mem_FP` — the suffix decoder is in `FP` +-/ + + +public section + +namespace Complexity + +namespace Cobham + +open Complexity.TM + +/-- The suffix decoder: scan doubled payload bits until the `[false, true]` +separator, then copy the remaining input (the suffix `y` of `pair x y`) to the +output. On malformed input it halts with empty output. Computes `sndBlock`. -/ +def sndBlockTM : TM 0 where + Q := ScanPhase + qstart := .skip + qhalt := .done + δ := fun state iHead wHeads oHead => + match state with + | .skip => + (.scanA, fun i => readBackWrite (wHeads i), readBackWrite oHead, Dir3.right, + fun i => idleDir (wHeads i), Dir3.right) + | .scanA => + match iHead with + | Γ.zero => + (.scanBfalse, fun i => readBackWrite (wHeads i), readBackWrite oHead, + Dir3.right, fun i => idleDir (wHeads i), idleDir oHead) + | Γ.one => + (.scanBtrue, fun i => readBackWrite (wHeads i), readBackWrite oHead, + Dir3.right, fun i => idleDir (wHeads i), idleDir oHead) + | _ => + (.done, fun i => readBackWrite (wHeads i), readBackWrite oHead, + idleDir iHead, fun i => idleDir (wHeads i), idleDir oHead) + | .scanBfalse => + match iHead with + | Γ.one => + (.emit, fun i => readBackWrite (wHeads i), readBackWrite oHead, + Dir3.right, fun i => idleDir (wHeads i), idleDir oHead) + | Γ.zero => + (.scanA, fun i => readBackWrite (wHeads i), readBackWrite oHead, + Dir3.right, fun i => idleDir (wHeads i), idleDir oHead) + | _ => + (.done, fun i => readBackWrite (wHeads i), readBackWrite oHead, + idleDir iHead, fun i => idleDir (wHeads i), idleDir oHead) + | .scanBtrue => + match iHead with + | Γ.one => + (.scanA, fun i => readBackWrite (wHeads i), readBackWrite oHead, + Dir3.right, fun i => idleDir (wHeads i), idleDir oHead) + | _ => + (.done, fun i => readBackWrite (wHeads i), readBackWrite oHead, + idleDir iHead, fun i => idleDir (wHeads i), idleDir oHead) + | .emit => + if iHead = Γ.blank then + (.done, fun i => readBackWrite (wHeads i), readBackWrite oHead, + idleDir iHead, fun i => idleDir (wHeads i), idleDir oHead) + else + (.emit, fun i => readBackWrite (wHeads i), readBackWrite iHead, + Dir3.right, fun i => idleDir (wHeads i), Dir3.right) + | .done => allIdle .done iHead wHeads oHead + δ_right_of_start := by + intro state iHead wHeads oHead + match state with + | .skip => exact ⟨fun _ => rfl, fun _ => idleDir_right_of_start, fun _ => rfl⟩ + | .scanA => + cases iHead <;> + exact ⟨by first | exact fun _ => rfl | exact idleDir_right_of_start, + fun _ => idleDir_right_of_start, + by first | exact fun _ => rfl | exact idleDir_right_of_start⟩ + | .scanBfalse => + cases iHead <;> + exact ⟨by first | exact fun _ => rfl | exact idleDir_right_of_start, + fun _ => idleDir_right_of_start, + by first | exact fun _ => rfl | exact idleDir_right_of_start⟩ + | .scanBtrue => + cases iHead <;> + exact ⟨by first | exact fun _ => rfl | exact idleDir_right_of_start, + fun _ => idleDir_right_of_start, + by first | exact fun _ => rfl | exact idleDir_right_of_start⟩ + | .emit => + dsimp only [] + split + · exact ⟨idleDir_right_of_start, fun _ => idleDir_right_of_start, + idleDir_right_of_start⟩ + · exact ⟨fun _ => rfl, fun _ => idleDir_right_of_start, fun _ => rfl⟩ + | .done => exact rightOfStart_allIdle iHead wHeads oHead + +/-- The copy phase of `sndBlockTM`: from `emit` with input cursor on suffix `y` +and output holding `acc`, the machine copies `y` after `acc` and halts. -/ +private theorem sndBlockTM_emit_loop : + ∀ (y acc : List Bool) (c : Cfg 0 sndBlockTM.Q), + c.state = ScanPhase.emit → + c.input.HasBinarySuffix y → + c.output.HasBinaryPrefix acc → + ∃ c' t, t ≤ y.length + 1 ∧ sndBlockTM.reachesIn t c c' ∧ sndBlockTM.halted c' ∧ + c'.output.HasBinaryPrefix (acc ++ y) := by + intro y + induction y with + | nil => + intro acc c hstate hsuf hpre + have hread : c.input.read = Γ.blank := hsuf.read_nil + have hout : c.output.read = Γ.blank := hpre.read_blank + have houtne : c.output.read ≠ Γ.start := by rw [hout]; decide + refine ⟨{ state := ScanPhase.done + input := c.input.move (idleDir c.input.read) + work := fun i => (c.work i).writeAndMove (readBackWrite (c.work i).read) + (idleDir (c.work i).read) + output := c.output.writeAndMove (readBackWrite c.output.read) + (idleDir c.output.read) }, 1, by simp, + .step (by simp [TM.step, hstate, sndBlockTM, hread]) .zero, rfl, ?_⟩ + rw [show c.output.writeAndMove (readBackWrite c.output.read) (idleDir c.output.read) + = c.output from by + rw [writeAndMove_readBack c.output houtne, idleDir, if_neg houtne, Tape.move]] + simpa using hpre + | cons bit y ih => + intro acc c hstate hsuf hpre + have hread : c.input.read = Γ.ofBool bit := hsuf.read_cons + have hne : c.input.read ≠ Γ.blank := by rw [hread]; cases bit <;> decide + let c1 : Cfg 0 sndBlockTM.Q := + { state := ScanPhase.emit + input := c.input.move Dir3.right + work := fun i => (c.work i).writeAndMove (readBackWrite (c.work i).read) + (idleDir (c.work i).read) + output := c.output.writeAndMove (readBackWrite c.input.read) Dir3.right } + have hstep : sndBlockTM.step c = some c1 := by + simp [TM.step, hstate, sndBlockTM, hne, c1] + have hpre1 : c1.output.HasBinaryPrefix (acc ++ [bit]) := by + have hco : (readBackWrite c.input.read).toΓ = Γ.ofBool bit := by + rw [hread]; cases bit <;> rfl + show (c.output.writeAndMove ((readBackWrite c.input.read).toΓ) Dir3.right).HasBinaryPrefix + (acc ++ [bit]) + rw [hco]; exact Tape.hasBinaryPrefix_write_bit bit hpre + obtain ⟨c', t, ht, hreach, hhalt, hout⟩ := + ih (acc ++ [bit]) c1 rfl hsuf.move_right_cons hpre1 + refine ⟨c', t + 1, by simp; omega, .step hstep hreach, hhalt, ?_⟩ + rwa [List.append_assoc, List.cons_append, List.nil_append] at hout + +/-- The scan phase of `sndBlockTM`: from `scanA` with input cursor on `w`, the +machine parses doubled pairs to the separator and copies the suffix, halting with +output `sndBlock w`. `fuel` bounds the recursion by the input length. -/ +private theorem sndBlockTM_scan_loop : + ∀ (fuel : ℕ) (w : List Bool), w.length ≤ fuel → ∀ (c : Cfg 0 sndBlockTM.Q), + c.state = ScanPhase.scanA → + c.input.HasBinarySuffix w → + c.output.HasBinaryPrefix [] → + ∃ c' t, t ≤ 2 * w.length + 2 ∧ sndBlockTM.reachesIn t c c' ∧ sndBlockTM.halted c' ∧ + c'.output.HasOutput (sndBlock w) := by + intro fuel + induction fuel with + | zero => + intro w hw c hstate hsuf hpre + have hwnil : w = [] := List.length_eq_zero_iff.mp (Nat.le_zero.mp hw) + subst hwnil + have hread : c.input.read = Γ.blank := hsuf.read_nil + have hout : c.output.read = Γ.blank := hpre.read_blank + have houtne : c.output.read ≠ Γ.start := by rw [hout]; decide + refine ⟨{ state := ScanPhase.done + input := c.input.move (idleDir c.input.read) + work := fun i => (c.work i).writeAndMove (readBackWrite (c.work i).read) + (idleDir (c.work i).read) + output := c.output.writeAndMove (readBackWrite c.output.read) + (idleDir c.output.read) }, 1, by simp, + .step (by simp [TM.step, hstate, sndBlockTM, hread]) .zero, rfl, ?_⟩ + rw [show c.output.writeAndMove (readBackWrite c.output.read) (idleDir c.output.read) + = c.output from by + rw [writeAndMove_readBack c.output houtne, idleDir, if_neg houtne, Tape.move]] + simpa [sndBlock] using hpre.hasOutput + | succ fuel ih => + intro w hw c hstate hsuf hpre + -- Halting helper for the malformed / end-of-input branches. + have hout : c.output.read = Γ.blank := hpre.read_blank + have houtne : c.output.read ≠ Γ.start := by rw [hout]; decide + match w with + | [] => + have hread : c.input.read = Γ.blank := hsuf.read_nil + refine ⟨{ state := ScanPhase.done + input := c.input.move (idleDir c.input.read) + work := fun i => (c.work i).writeAndMove (readBackWrite (c.work i).read) + (idleDir (c.work i).read) + output := c.output.writeAndMove (readBackWrite c.output.read) + (idleDir c.output.read) }, 1, by simp, + .step (by simp [TM.step, hstate, sndBlockTM, hread]) .zero, rfl, ?_⟩ + rw [show c.output.writeAndMove (readBackWrite c.output.read) (idleDir c.output.read) + = c.output from by + rw [writeAndMove_readBack c.output houtne, idleDir, if_neg houtne, Tape.move]] + simpa [sndBlock] using hpre.hasOutput + | [false] => + -- scanA reads false → scanBfalse; next reads blank → done. + have hread : c.input.read = Γ.ofBool false := hsuf.read_cons + let c1 : Cfg 0 sndBlockTM.Q := + { state := ScanPhase.scanBfalse + input := c.input.move Dir3.right + work := fun i => (c.work i).writeAndMove (readBackWrite (c.work i).read) + (idleDir (c.work i).read) + output := c.output.writeAndMove (readBackWrite c.output.read) + (idleDir c.output.read) } + have hstep : sndBlockTM.step c = some c1 := by + simp [TM.step, hstate, sndBlockTM, hread, Γ.ofBool, c1] + have hsuf1 : c1.input.HasBinarySuffix [] := hsuf.move_right_cons + have hpre1 : c1.output.HasBinaryPrefix [] := by + rw [show c1.output = c.output from + Tape.writeAndMove_readBack_idle_of_ne_start _ houtne] + exact hpre + have hread1 : c1.input.read = Γ.blank := hsuf1.read_nil + have hout1 : c1.output.read = Γ.blank := hpre1.read_blank + have houtne1 : c1.output.read ≠ Γ.start := by rw [hout1]; decide + refine ⟨{ state := ScanPhase.done + input := c1.input.move (idleDir c1.input.read) + work := fun i => (c1.work i).writeAndMove (readBackWrite (c1.work i).read) + (idleDir (c1.work i).read) + output := c1.output.writeAndMove (readBackWrite c1.output.read) + (idleDir c1.output.read) }, 2, by simp, + .step hstep (.step (by simp [TM.step, sndBlockTM, hread1, c1]) .zero), rfl, ?_⟩ + rw [show c1.output.writeAndMove (readBackWrite c1.output.read) (idleDir c1.output.read) + = c1.output from by + rw [writeAndMove_readBack c1.output houtne1, idleDir, if_neg houtne1, Tape.move]] + simpa [sndBlock] using hpre1.hasOutput + | [true] => + have hread : c.input.read = Γ.ofBool true := hsuf.read_cons + let c1 : Cfg 0 sndBlockTM.Q := + { state := ScanPhase.scanBtrue + input := c.input.move Dir3.right + work := fun i => (c.work i).writeAndMove (readBackWrite (c.work i).read) + (idleDir (c.work i).read) + output := c.output.writeAndMove (readBackWrite c.output.read) + (idleDir c.output.read) } + have hstep : sndBlockTM.step c = some c1 := by + simp [TM.step, hstate, sndBlockTM, hread, Γ.ofBool, c1] + have hsuf1 : c1.input.HasBinarySuffix [] := hsuf.move_right_cons + have hpre1 : c1.output.HasBinaryPrefix [] := by + rw [show c1.output = c.output from + Tape.writeAndMove_readBack_idle_of_ne_start _ houtne] + exact hpre + have hread1 : c1.input.read = Γ.blank := hsuf1.read_nil + have hout1 : c1.output.read = Γ.blank := hpre1.read_blank + have houtne1 : c1.output.read ≠ Γ.start := by rw [hout1]; decide + refine ⟨{ state := ScanPhase.done + input := c1.input.move (idleDir c1.input.read) + work := fun i => (c1.work i).writeAndMove (readBackWrite (c1.work i).read) + (idleDir (c1.work i).read) + output := c1.output.writeAndMove (readBackWrite c1.output.read) + (idleDir c1.output.read) }, 2, by simp, + .step hstep (.step (by simp [TM.step, sndBlockTM, hread1, c1]) .zero), rfl, ?_⟩ + rw [show c1.output.writeAndMove (readBackWrite c1.output.read) (idleDir c1.output.read) + = c1.output from by + rw [writeAndMove_readBack c1.output houtne1, idleDir, if_neg houtne1, Tape.move]] + simpa [sndBlock] using hpre1.hasOutput + | false :: true :: y => + -- separator: scanA false → scanBfalse → (reads true) → emit; copy y. + have hreadA : c.input.read = Γ.ofBool false := hsuf.read_cons + let c1 : Cfg 0 sndBlockTM.Q := + { state := ScanPhase.scanBfalse + input := c.input.move Dir3.right + work := fun i => (c.work i).writeAndMove (readBackWrite (c.work i).read) + (idleDir (c.work i).read) + output := c.output.writeAndMove (readBackWrite c.output.read) + (idleDir c.output.read) } + have hstepA : sndBlockTM.step c = some c1 := by + simp [TM.step, hstate, sndBlockTM, hreadA, Γ.ofBool, c1] + have hsuf1 : c1.input.HasBinarySuffix (true :: y) := hsuf.move_right_cons + have hpre1 : c1.output.HasBinaryPrefix [] := by + rw [show c1.output = c.output from + Tape.writeAndMove_readBack_idle_of_ne_start _ houtne] + exact hpre + have hreadB : c1.input.read = Γ.ofBool true := hsuf1.read_cons + let c2 : Cfg 0 sndBlockTM.Q := + { state := ScanPhase.emit + input := c1.input.move Dir3.right + work := fun i => (c1.work i).writeAndMove (readBackWrite (c1.work i).read) + (idleDir (c1.work i).read) + output := c1.output.writeAndMove (readBackWrite c1.output.read) + (idleDir c1.output.read) } + have hstepB : sndBlockTM.step c1 = some c2 := by + simp [TM.step, sndBlockTM, hreadB, Γ.ofBool, c1, c2] + have hsuf2 : c2.input.HasBinarySuffix y := hsuf1.move_right_cons + have hpre2 : c2.output.HasBinaryPrefix [] := by + have hout1 : c1.output.read ≠ Γ.start := by + rw [hpre1.read_blank]; decide + rw [show c2.output = c1.output from + Tape.writeAndMove_readBack_idle_of_ne_start _ hout1] + exact hpre1 + obtain ⟨c', t, ht, hreach, hhalt, hcout⟩ := + sndBlockTM_emit_loop y [] c2 rfl hsuf2 hpre2 + refine ⟨c', t + 1 + 1, by simp only [List.length_cons]; omega, + .step hstepA (.step hstepB hreach), hhalt, ?_⟩ + have : sndBlock (false :: true :: y) = y := by simp [sndBlock, unpair?] + rw [this] + simpa using hcout.hasOutput + | false :: false :: z => + have hreadA : c.input.read = Γ.ofBool false := hsuf.read_cons + let c1 : Cfg 0 sndBlockTM.Q := + { state := ScanPhase.scanBfalse + input := c.input.move Dir3.right + work := fun i => (c.work i).writeAndMove (readBackWrite (c.work i).read) + (idleDir (c.work i).read) + output := c.output.writeAndMove (readBackWrite c.output.read) + (idleDir c.output.read) } + have hstepA : sndBlockTM.step c = some c1 := by + simp [TM.step, hstate, sndBlockTM, hreadA, Γ.ofBool, c1] + have hsuf1 : c1.input.HasBinarySuffix (false :: z) := hsuf.move_right_cons + have hpre1 : c1.output.HasBinaryPrefix [] := by + rw [show c1.output = c.output from + Tape.writeAndMove_readBack_idle_of_ne_start _ houtne] + exact hpre + have hreadB : c1.input.read = Γ.ofBool false := hsuf1.read_cons + let c2 : Cfg 0 sndBlockTM.Q := + { state := ScanPhase.scanA + input := c1.input.move Dir3.right + work := fun i => (c1.work i).writeAndMove (readBackWrite (c1.work i).read) + (idleDir (c1.work i).read) + output := c1.output.writeAndMove (readBackWrite c1.output.read) + (idleDir c1.output.read) } + have hstepB : sndBlockTM.step c1 = some c2 := by + simp [TM.step, sndBlockTM, hreadB, Γ.ofBool, c1, c2] + have hsuf2 : c2.input.HasBinarySuffix z := hsuf1.move_right_cons + have hpre2 : c2.output.HasBinaryPrefix [] := by + have hout1 : c1.output.read ≠ Γ.start := by rw [hpre1.read_blank]; decide + rw [show c2.output = c1.output from + Tape.writeAndMove_readBack_idle_of_ne_start _ hout1] + exact hpre1 + have hzfuel : z.length ≤ fuel := by + simp only [List.length_cons] at hw; omega + obtain ⟨c', t, ht, hreach, hhalt, hcout⟩ := + ih z hzfuel c2 rfl hsuf2 hpre2 + refine ⟨c', t + 1 + 1, by simp only [List.length_cons]; omega, + .step hstepA (.step hstepB hreach), hhalt, ?_⟩ + have : sndBlock (false :: false :: z) = sndBlock z := by + cases h : unpair? z <;> simp [sndBlock, unpair?, h] + rw [this]; exact hcout + | true :: true :: z => + have hreadA : c.input.read = Γ.ofBool true := hsuf.read_cons + let c1 : Cfg 0 sndBlockTM.Q := + { state := ScanPhase.scanBtrue + input := c.input.move Dir3.right + work := fun i => (c.work i).writeAndMove (readBackWrite (c.work i).read) + (idleDir (c.work i).read) + output := c.output.writeAndMove (readBackWrite c.output.read) + (idleDir c.output.read) } + have hstepA : sndBlockTM.step c = some c1 := by + simp [TM.step, hstate, sndBlockTM, hreadA, Γ.ofBool, c1] + have hsuf1 : c1.input.HasBinarySuffix (true :: z) := hsuf.move_right_cons + have hpre1 : c1.output.HasBinaryPrefix [] := by + rw [show c1.output = c.output from + Tape.writeAndMove_readBack_idle_of_ne_start _ houtne] + exact hpre + have hreadB : c1.input.read = Γ.ofBool true := hsuf1.read_cons + let c2 : Cfg 0 sndBlockTM.Q := + { state := ScanPhase.scanA + input := c1.input.move Dir3.right + work := fun i => (c1.work i).writeAndMove (readBackWrite (c1.work i).read) + (idleDir (c1.work i).read) + output := c1.output.writeAndMove (readBackWrite c1.output.read) + (idleDir c1.output.read) } + have hstepB : sndBlockTM.step c1 = some c2 := by + simp [TM.step, sndBlockTM, hreadB, Γ.ofBool, c1, c2] + have hsuf2 : c2.input.HasBinarySuffix z := hsuf1.move_right_cons + have hpre2 : c2.output.HasBinaryPrefix [] := by + have hout1 : c1.output.read ≠ Γ.start := by rw [hpre1.read_blank]; decide + rw [show c2.output = c1.output from + Tape.writeAndMove_readBack_idle_of_ne_start _ hout1] + exact hpre1 + have hzfuel : z.length ≤ fuel := by + simp only [List.length_cons] at hw; omega + obtain ⟨c', t, ht, hreach, hhalt, hcout⟩ := + ih z hzfuel c2 rfl hsuf2 hpre2 + refine ⟨c', t + 1 + 1, by simp only [List.length_cons]; omega, + .step hstepA (.step hstepB hreach), hhalt, ?_⟩ + have : sndBlock (true :: true :: z) = sndBlock z := by + cases h : unpair? z <;> simp [sndBlock, unpair?, h] + rw [this]; exact hcout + | true :: false :: rest => + -- malformed: scanA true → scanBtrue → reads false → done, empty output. + have hreadA : c.input.read = Γ.ofBool true := hsuf.read_cons + let c1 : Cfg 0 sndBlockTM.Q := + { state := ScanPhase.scanBtrue + input := c.input.move Dir3.right + work := fun i => (c.work i).writeAndMove (readBackWrite (c.work i).read) + (idleDir (c.work i).read) + output := c.output.writeAndMove (readBackWrite c.output.read) + (idleDir c.output.read) } + have hstepA : sndBlockTM.step c = some c1 := by + simp [TM.step, hstate, sndBlockTM, hreadA, Γ.ofBool, c1] + have hsuf1 : c1.input.HasBinarySuffix (false :: rest) := hsuf.move_right_cons + have hpre1 : c1.output.HasBinaryPrefix [] := by + rw [show c1.output = c.output from + Tape.writeAndMove_readBack_idle_of_ne_start _ houtne] + exact hpre + have hreadB : c1.input.read = Γ.ofBool false := hsuf1.read_cons + have hout1 : c1.output.read = Γ.blank := hpre1.read_blank + have houtne1 : c1.output.read ≠ Γ.start := by rw [hout1]; decide + refine ⟨{ state := ScanPhase.done + input := c1.input.move (idleDir c1.input.read) + work := fun i => (c1.work i).writeAndMove (readBackWrite (c1.work i).read) + (idleDir (c1.work i).read) + output := c1.output.writeAndMove (readBackWrite c1.output.read) + (idleDir c1.output.read) }, 2, by simp, + .step hstepA (.step (by simp [TM.step, sndBlockTM, hreadB, Γ.ofBool, c1]) .zero), + rfl, ?_⟩ + rw [show c1.output.writeAndMove (readBackWrite c1.output.read) (idleDir c1.output.read) + = c1.output from by + rw [writeAndMove_readBack c1.output houtne1, idleDir, if_neg houtne1, Tape.move]] + have : sndBlock (true :: false :: rest) = [] := by simp [sndBlock, unpair?] + rw [this]; simpa using hpre1.hasOutput + +/-- `sndBlock` is polynomial-time, via the `sndBlockTM` scanner. -/ +theorem sndBlock_mem_FP : sndBlock ∈ FP := by + refine ⟨1, 0, sndBlockTM, (fun m => 2 * m + 3), ?_, ?_⟩ + · intro z + -- Step 1: skip past ▷, positioning both cursors. + let c1 : Cfg 0 sndBlockTM.Q := + { state := ScanPhase.scanA + input := (Tape.init (z.map Γ.ofBool)).move Dir3.right + work := fun _ => (Tape.init []).move Dir3.right + output := (Tape.init []).move Dir3.right } + have hstep1 : sndBlockTM.step (sndBlockTM.initCfg z) = some c1 := by + simp [TM.step, sndBlockTM, c1, Tape.read, Tape.init, readBackWrite, idleDir, + Tape.writeAndMove, Tape.write, Tape.move] + have hsuf : c1.input.HasBinarySuffix z := Tape.init_move_right_hasBinarySuffix z + have hpre : c1.output.HasBinaryPrefix [] := Tape.init_nil_move_right_hasBinaryPrefix_nil + obtain ⟨c', t, ht, hreach, hhalt, hcout⟩ := + sndBlockTM_scan_loop z.length z le_rfl c1 rfl hsuf hpre + exact ⟨c', t + 1, by show t + 1 ≤ 2 * z.length + 3; omega, + .step hstep1 hreach, hhalt, hcout⟩ + · have hn : (fun m : ℕ => 2 * m) =O ((· ^ 1) : ℕ → ℕ) := by + simpa [pow_one] using (BigO.refl (fun m : ℕ => m)).const_mul_left 2 + exact BigO.add hn (BigO.const_le_pow 3 1) + +end Cobham + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/StepAlgebra.lean b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/StepAlgebra.lean new file mode 100644 index 0000000000..a2f56575e5 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/StepAlgebra.lean @@ -0,0 +1,756 @@ +/- +Copyright (c) 2026 Bolton Bailey. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Bolton Bailey +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.Algebra +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.Encoding +public import Mathlib.Data.Fintype.Prod + +/-! +# The encoded machine step, inside the algebra — proof internals + +`Complexitylib.Classes.P.Cobham.Internal.Encoding` shows that one machine step +acts on an encoded configuration blockwise, via `tapeStepBlocks`. This module +shows the other half: that `tapeStepBlocks` is *in Cobham's algebra* once the +written symbol and the direction are fixed constants — which they are inside one +branch of `Cobham.tableFn`, since the branch is selected by the (state, +read-symbols) key. + +Each half-block of the successor is a short composition of toolkit members: +`Cobham.takeFn` and `Cobham.dropFn` at width two, `Cobham.appendFn`, +`Cobham.const`, and one `Cobham.padFn` to restore the block width. + +## Main results + +- `Complexity.Cobham.tapeStepBlocksFst`, `Complexity.Cobham.tapeStepBlocksSnd` — + both half-blocks of a stepped tape are in the algebra +-/ + + +@[expose] public section + +namespace Complexity + +namespace Cobham + +/-- The two-bit ruler: dropping or taking `2` is `dropFn`/`takeFn` against this +constant. -/ +private def twoRuler : List Bool := [false, false] + +/-- **The left half-block after a step is in the algebra.** For a fixed direction +and written symbol it is one of: the old left block unchanged (stay), the symbol +prepended (right), or two bits dropped (left). -/ +theorem tapeStepBlocksFst {n : ℕ} (s : Γ) (d : Dir3) + {gR gL gRt : (Fin n → List Bool) → List Bool} + (hR : Cobham gR) (hL : Cobham gL) (_hRt : Cobham gRt) : + Cobham fun v : Fin n → List Bool => + (tapeStepBlocks (gR v) s d (gL v) (gRt v)).1 := by + cases d + · exact (padFn hR (dropFn (Cobham.const twoRuler) hL)).of_eq fun _ => rfl + · exact (padFn hR (appendFn (Cobham.const (symCode s)) hL)).of_eq fun _ => rfl + · exact hL.of_eq fun _ => rfl + +/-- **The right half-block after a step is in the algebra.** For a fixed +direction and written symbol it is the old right block with its leading symbol +replaced (stay), consumed (right), or pushed back together with the nearest left +symbol (left). -/ +theorem tapeStepBlocksSnd {n : ℕ} (s : Γ) (d : Dir3) + {gR gL gRt : (Fin n → List Bool) → List Bool} + (hR : Cobham gR) (hL : Cobham gL) (hRt : Cobham gRt) : + Cobham fun v : Fin n → List Bool => + (tapeStepBlocks (gR v) s d (gL v) (gRt v)).2 := by + cases d + · exact (padFn hR (appendFn + (appendFn (takeFn (Cobham.const twoRuler) hL) (Cobham.const (symCode s))) + (dropFn (Cobham.const twoRuler) hRt))).of_eq fun _ => rfl + · exact (padFn hR (dropFn (Cobham.const twoRuler) hRt)).of_eq fun _ => rfl + · exact (padFn hR (appendFn (Cobham.const (symCode s)) + (dropFn (Cobham.const twoRuler) hRt))).of_eq fun _ => rfl + +/-- **Tape `j`'s two half-blocks, read out of an encoded configuration.** Block +`0` is the state, so tape `j` occupies blocks `2j+1` and `2j+2` — exactly the +indices `tapesStepFn` addresses with `Cobham.blockFn`. -/ +theorem blockAt_cfgCode_tape {k : ℕ} {Q : Type} [Fintype Q] [DecidableEq Q] + (W : ℕ) (c : Cfg k Q) (j : ℕ) (hj : j < (cfgTapes c).length) : + blockAt (blockRuler W) (cfgCode W c) (2 * j + 1) + = padTo (blockRuler W) (leftCode (cfgTapes c)[j]) ∧ + blockAt (blockRuler W) (cfgCode W c) (2 * j + 2) + = padTo (blockRuler W) (rightCode (cfgTapes c)[j] W) := by + have hj' : j < k + 2 := by rwa [cfgTapes_length] at hj + have hblocks : (tapesBlocks W (cfgTapes c)).length = 2 * (k + 2) := by + rw [tapesBlocks_length, cfgTapes_length] + obtain ⟨h1, h2⟩ := getElem?_tapesBlocks W (cfgTapes c) j + rw [List.getElem?_eq_getElem (by omega), List.getElem?_eq_getElem hj] at h1 h2 + simp only [Option.map_some] at h1 h2 + replace h1 := Option.some_inj.mp h1 + replace h2 := Option.some_inj.mp h2 + -- Work through `getElem?` so no dependent index proofs appear under a rewrite. + have key1 : (cfgBlocks W c)[2 * j + 1]? = (tapesBlocks W (cfgTapes c))[2 * j]? := by + rw [cfgBlocks_eq]; exact List.getElem?_cons_succ + have key2 : (cfgBlocks W c)[2 * j + 2]? = (tapesBlocks W (cfgTapes c))[2 * j + 1]? := by + rw [cfgBlocks_eq]; exact List.getElem?_cons_succ + rw [List.getElem?_eq_getElem (by rw [cfgBlocks_length]; omega), + List.getElem?_eq_getElem (by omega)] at key1 + rw [List.getElem?_eq_getElem (by rw [cfgBlocks_length]; omega), + List.getElem?_eq_getElem (by omega)] at key2 + exact ⟨by rw [blockAt_cfgCode W c (2 * j + 1) (by rw [cfgBlocks_length]; omega), + Option.some_inj.mp key1, h1], + by rw [blockAt_cfgCode W c (2 * j + 2) (by rw [cfgBlocks_length]; omega), + Option.some_inj.mp key2, h2]⟩ + +/-! ## The transition key + +The key is the state together with the symbol under every head. Reading it out of +an encoding is one `takeFn` per field: the state block truncated to `|Q|` bits, +then the first two bits of each tape's right half-block. -/ + +/-- The read symbols of the tapes from index `j` on, `m` of them. -/ +def readsFn (R : List Bool) (m j : ℕ) (z : List Bool) : List Bool := + match m with + | 0 => [] + | m + 1 => (blockAt R z (2 * j + 2)).take 2 ++ readsFn R m (j + 1) z + +/-- The transition key, read out of an encoded configuration. -/ +def keyFn (R : List Bool) (q m : ℕ) (z : List Bool) : List Bool := + (blockAt R z 0).take q ++ readsFn R m 0 z + +/-- **Reading the head symbols is in the algebra.** -/ +theorem readsFn_mem {n : ℕ} (m j : ℕ) + {gR gz : (Fin n → List Bool) → List Bool} (hR : Cobham gR) (hz : Cobham gz) : + Cobham fun v : Fin n → List Bool => readsFn (gR v) m j (gz v) := by + induction m generalizing j with + | zero => exact Cobham.empty.of_eq fun _ => rfl + | succ m ih => + exact (appendFn (takeFn (Cobham.const twoRuler) (blockFn hR hz (2 * j + 2))) + (ih (j + 1))).of_eq fun _ => rfl + +/-- **Reading the transition key is in the algebra.** -/ +theorem keyFn_mem {n : ℕ} (q m : ℕ) + {gR gz : (Fin n → List Bool) → List Bool} (hR : Cobham gR) (hz : Cobham gz) : + Cobham fun v : Fin n → List Bool => keyFn (gR v) q m (gz v) := + (appendFn (takeFn (Cobham.const (List.replicate q false)) (blockFn hR hz 0)) + (readsFn_mem m 0 hR hz)).of_eq fun _ => by rw [keyFn, List.length_replicate] + +/-- **The extracted key is the transition key.** -/ +theorem readsFn_eq {k : ℕ} {Q : Type} [Fintype Q] [DecidableEq Q] + (W : ℕ) (c : Cfg k Q) (hW : ∀ t ∈ cfgTapes c, t.head ≤ W) : + ∀ (m j : ℕ), j + m = (cfgTapes c).length → + readsFn (blockRuler W) m j (cfgCode W c) + = ((cfgTapes c).drop j).flatMap fun t => symCode t.read := by + intro m + induction m with + | zero => + intro j hj + have : (cfgTapes c).drop j = [] := by + rw [List.drop_eq_nil_iff]; omega + rw [readsFn, this, List.flatMap_nil] + | succ m ih => + intro j hj + have hjlt : j < (cfgTapes c).length := by omega + obtain ⟨_, hRt⟩ := blockAt_cfgCode_tape W c j hjlt + have hmem : (cfgTapes c)[j] ∈ cfgTapes c := List.getElem_mem hjlt + rw [readsFn, hRt, List.drop_eq_getElem_cons hjlt, List.flatMap_cons, + take_padTo _ _ 2 (by rw [rightCode_length]; have := hW _ hmem; omega) + (by rw [rightCode_length, blockRuler_length, blockWidth] + have := hW _ hmem; omega), + take_rightCode _ (hW _ hmem), ih (j + 1) (by omega)] + +/-- The whole key, read out of an encoded configuration. -/ +theorem keyFn_eq {k : ℕ} {Q : Type} [Fintype Q] [DecidableEq Q] + (W : ℕ) (c : Cfg k Q) (hq : Fintype.card Q ≤ blockWidth W) + (hW : ∀ t ∈ cfgTapes c, t.head ≤ W) : + keyFn (blockRuler W) (Fintype.card Q) (k + 2) (cfgCode W c) = keyCode c := by + rw [keyFn, state_of_cfgCode W c hq, + readsFn_eq W c hW (k + 2) 0 (by rw [cfgTapes_length]; omega), List.drop_zero, + keyCode] + +/-! ## Lifting across all the tapes + +A machine has a fixed number of tapes, so stepping all of them is a *finite* +composition — the recursion below is at the meta level, over the list of +per-tape actions, not inside the algebra. Tape `j` occupies blocks `2j+1` and +`2j+2` (block `0` is the state), which `Cobham.blockFn` addresses. -/ + +/-- The successor's tape blocks for one transition-table branch, as a function of +the predecessor's encoding: tape `j`'s two half-blocks, stepped, concatenated. -/ +def tapesStepFn (R : List Bool) (acts : List (Γ × Dir3)) (j : ℕ) (z : List Bool) : + List Bool := + match acts with + | [] => [] + | a :: rest => + (tapeStepBlocks R a.1 a.2 (blockAt R z (2 * j + 1)) + (blockAt R z (2 * j + 2))).1 ++ + ((tapeStepBlocks R a.1 a.2 (blockAt R z (2 * j + 1)) + (blockAt R z (2 * j + 2))).2 ++ tapesStepFn R rest (j + 1) z) + +/-- **Stepping every tape is in the algebra.** -/ +theorem tapesStepFn_mem {n : ℕ} (acts : List (Γ × Dir3)) (j : ℕ) + {gR gz : (Fin n → List Bool) → List Bool} (hR : Cobham gR) (hz : Cobham gz) : + Cobham fun v : Fin n → List Bool => tapesStepFn (gR v) acts j (gz v) := by + induction acts generalizing j with + | nil => exact Cobham.empty.of_eq fun _ => rfl + | cons a rest ih => + exact (appendFn + (tapeStepBlocksFst a.1 a.2 hR (blockFn hR hz (2 * j + 1)) + (blockFn hR hz (2 * j + 2))) + (appendFn + (tapeStepBlocksSnd a.1 a.2 hR (blockFn hR hz (2 * j + 1)) + (blockFn hR hz (2 * j + 2))) + (ih (j + 1)))).of_eq fun _ => rfl + +/-- **The algebra-side tape step computes the machine-side one.** Reading the +half-blocks out of the encoding (`blockAt`) gives exactly the tapes' own +half-blocks, so `tapesStepFn` reproduces the blockwise map of +`tapesBlocks_tapesStep`. -/ +theorem tapesStepFn_eq {k : ℕ} {Q : Type} [Fintype Q] [DecidableEq Q] + (W : ℕ) (c : Cfg k Q) : + ∀ (acts : List (Γ × Dir3)) (j : ℕ), j + acts.length ≤ (cfgTapes c).length → + tapesStepFn (blockRuler W) acts j (cfgCode W c) + = ((List.zipWith (fun a t => + [(tapeStepBlocks (blockRuler W) a.1 a.2 (padTo (blockRuler W) (leftCode t)) + (padTo (blockRuler W) (rightCode t W))).1, + (tapeStepBlocks (blockRuler W) a.1 a.2 (padTo (blockRuler W) (leftCode t)) + (padTo (blockRuler W) (rightCode t W))).2]) + acts ((cfgTapes c).drop j)).flatten).flatten := by + intro acts + induction acts with + | nil => intro j _; rfl + | cons a rest ih => + intro j hj + have hjlt : j < (cfgTapes c).length := by + simp only [List.length_cons] at hj; omega + obtain ⟨hL, hRt⟩ := blockAt_cfgCode_tape W c j hjlt + rw [List.drop_eq_getElem_cons hjlt, List.zipWith_cons_cons, List.flatten_cons, + List.flatten_append, tapesStepFn, hL, hRt, + ih (j + 1) (by simp only [List.length_cons] at hj; omega)] + simp [List.append_assoc] + +/-- One whole branch of the transition table: the new state block (a fixedValue) +followed by every tape stepped. -/ +def branchFn (R q' : List Bool) (acts : List (Γ × Dir3)) (z : List Bool) : + List Bool := + padTo R q' ++ tapesStepFn R acts 0 z + +/-- **A transition-table branch is in the algebra.** With the branch fixed, the +new state code and every tape's write and direction are constants, so the whole +successor configuration is a finite composition of toolkit members. -/ +theorem branchFn_mem {n : ℕ} (q' : List Bool) (acts : List (Γ × Dir3)) + {gR gz : (Fin n → List Bool) → List Bool} (hR : Cobham gR) (hz : Cobham gz) : + Cobham fun v : Fin n → List Bool => branchFn (gR v) q' acts (gz v) := + (appendFn (padFn hR (Cobham.const q')) (tapesStepFn_mem acts 0 hR hz)).of_eq + fun _ => rfl + +/-- **The join.** For a fixed transition-table branch, the algebra-side successor +`branchFn` — built purely from `takeFn`/`dropFn`/`appendFn`/`padFn`/`const` — *is* +the encoding of the machine's successor configuration. + +This is the point where the two halves of the development meet: the machine side +(`cfgBlocks_step`, from the six write-and-move lemmas) and the algebra side +(`tapesStepFn`, in the class by `branchFn_mem`). -/ +theorem branchFn_eq {k : ℕ} (tm : TM k) {c c' : Cfg k tm.Q} {W : ℕ} + (h : tm.step c = some c') (hout : c.output.StartInvariant) + (hwork : ∀ i, (c.work i).StartInvariant) + (hgood : List.Forall₂ (fun (a : Γ × Dir3) (t : Tape) => + (t.head = 0 → a.1 = t.cells t.head) ∧ + (a.2 ≠ Dir3.right → t.head ≠ 0) ∧ t.head ≤ W) (stepActs tm c) (cfgTapes c)) : + branchFn (blockRuler W) (stateCode c'.state) (stepActs tm c) (cfgCode W c) + = cfgCode W c' := by + rw [branchFn, tapesStepFn_eq W c (stepActs tm c) 0 (by simpa using hgood.length_eq.le)] + conv_rhs => rw [cfgCode, cfgBlocks_step tm h hout hwork hgood, List.flatten_cons] + simp + +/-! ## The whole transition table + +A machine has finitely many (state, read-symbols) keys, so the transition +function is a finite table: one `branchFn` per key, selected by matching the key +read out of the encoding against the key's fixedValue pattern. -/ + +/-- The transition table's index set: every (state, read-symbols) pair. -/ +noncomputable def stepEntries {k : ℕ} (tm : TM k) : + List (tm.Q × (Fin (k + 2) → Γ)) := + (Finset.univ : Finset (tm.Q × (Fin (k + 2) → Γ))).toList + +/-- Every key is in the table. -/ +theorem mem_stepEntries {k : ℕ} (tm : TM k) (p : tm.Q × (Fin (k + 2) → Γ)) : + p ∈ stepEntries tm := Finset.mem_toList.mpr (Finset.mem_univ p) + +/-- The branch a transition key selects. A halting key stands still: the machine +has stopped, but the *simulation* runs for a fixed polynomial number of steps, so +the encoding has to be a fixed point from then on. -/ +noncomputable def stepBranch {k : ℕ} (tm : TM k) (R : List Bool) + (p : tm.Q × (Fin (k + 2) → Γ)) (z : List Bool) : List Bool := + if p.1 = tm.qhalt then z + else branchFn R (stateCode (stepStateOf tm p.1 p.2)) (stepActsOf tm p.1 p.2) z + +theorem stepBranch_halt {k : ℕ} (tm : TM k) (R : List Bool) + {p : tm.Q × (Fin (k + 2) → Γ)} (h : p.1 = tm.qhalt) (z : List Bool) : + stepBranch tm R p z = z := if_pos h + +theorem stepBranch_step {k : ℕ} (tm : TM k) (R : List Bool) + {p : tm.Q × (Fin (k + 2) → Γ)} (h : p.1 ≠ tm.qhalt) (z : List Bool) : + stepBranch tm R p z + = branchFn R (stateCode (stepStateOf tm p.1 p.2)) (stepActsOf tm p.1 p.2) z := + if_neg h + +/-- **One machine step, on encodings.** The table dispatches on the key read out +of the encoding and applies that key's branch. -/ +noncomputable def stepFn {k : ℕ} (tm : TM k) (R z : List Bool) : List Bool := + (stepEntries tm).foldr + (fun p acc => + caseBit₀ (matchPrefix (keyPattern p) (keyFn R (Fintype.card tm.Q) (k + 2) z)) + (stepBranch tm R p z) acc) + [] + +/-- **The encoded step is in the algebra.** -/ +theorem stepFn_mem {n k : ℕ} (tm : TM k) + {gR gz : (Fin n → List Bool) → List Bool} (hR : Cobham gR) (hz : Cobham gz) : + Cobham fun v : Fin n → List Bool => stepFn tm (gR v) (gz v) := by + refine (tableFn (keyFn_mem (Fintype.card tm.Q) (k + 2) hR hz) Cobham.empty + ((stepEntries tm).map fun p => + (keyPattern p, fun v : Fin n → List Bool => stepBranch tm (gR v) p (gz v))) + ?_).of_eq fun v => ?_ + · rintro p hp + obtain ⟨q, -, rfl⟩ := List.mem_map.mp hp + by_cases hh : q.1 = tm.qhalt + · exact hz.of_eq fun v => (stepBranch_halt tm (gR v) hh (gz v)).symm + · exact (branchFn_mem _ _ hR hz).of_eq fun v => + (stepBranch_step tm (gR v) hh (gz v)).symm + · rw [stepFn, List.foldr_map] + +/-- **The table selects the configuration's own branch.** The key read out of the +encoding is the configuration's key, and by `keyPattern_injective` no other +entry's pattern matches it. -/ +theorem stepFn_apply {k : ℕ} (tm : TM k) (c : Cfg k tm.Q) {W : ℕ} + (hq : Fintype.card tm.Q ≤ blockWidth W) (hW : ∀ t ∈ cfgTapes c, t.head ≤ W) : + stepFn tm (blockRuler W) (cfgCode W c) + = stepBranch tm (blockRuler W) (c.state, cfgReads c) (cfgCode W c) := by + have hkey := foldr_table_eq (keyCode c) [] + (stepBranch tm (blockRuler W) (c.state, cfgReads c) (cfgCode W c)) + ((stepEntries tm).map fun p => + (keyPattern p, stepBranch tm (blockRuler W) p (cfgCode W c))) ?_ ?_ + · rw [List.foldr_map] at hkey + rw [stepFn, keyFn_eq W c hq hW] + exact hkey + · refine ⟨_, List.mem_map_of_mem (mem_stepEntries tm (c.state, cfgReads c)), ?_⟩ + show keyPattern (c.state, cfgReads c) <+: keyCode c + rw [← keyCode_eq] + · rintro q hq' hpre + obtain ⟨p, -, rfl⟩ := List.mem_map.mp hq' + replace hpre : keyPattern p <+: keyCode c := hpre + have hlen : (keyPattern p).length = (keyCode c).length := by simp + have hp : p = (c.state, cfgReads c) := + keyPattern_injective (by rw [hpre.eq_of_length hlen, keyCode_eq]) + rw [hp] + +/-- **The encoded step computes the machine step.** -/ +theorem stepFn_eq {k : ℕ} (tm : TM k) {c c' : Cfg k tm.Q} {W : ℕ} + (h : tm.step c = some c') (hq : Fintype.card tm.Q ≤ blockWidth W) + (hW : ∀ t ∈ cfgTapes c, t.head ≤ W) + (hout : c.output.StartInvariant) (hwork : ∀ i, (c.work i).StartInvariant) + (hgood : List.Forall₂ (fun (a : Γ × Dir3) (t : Tape) => + (t.head = 0 → a.1 = t.cells t.head) ∧ + (a.2 ≠ Dir3.right → t.head ≠ 0) ∧ t.head ≤ W) (stepActs tm c) (cfgTapes c)) : + stepFn tm (blockRuler W) (cfgCode W c) = cfgCode W c' := by + rw [stepFn_apply tm c hq hW, + stepBranch_step tm _ (TM.state_ne_qhalt_of_step h), ← step_state_eq tm h, + ← stepActs_eq_stepActsOf] + exact branchFn_eq tm h hout hwork hgood + +/-- **A halted encoding is a fixed point.** -/ +theorem stepFn_halted {k : ℕ} (tm : TM k) {c : Cfg k tm.Q} {W : ℕ} + (h : c.state = tm.qhalt) (hq : Fintype.card tm.Q ≤ blockWidth W) + (hW : ∀ t ∈ cfgTapes c, t.head ≤ W) : + stepFn tm (blockRuler W) (cfgCode W c) = cfgCode W c := by + rw [stepFn_apply tm c hq hW, stepBranch_halt tm _ h] + +/-! ## Length bounds + +`Cobham.iterFn` needs one polynomial bound covering *every* iterate, including +the ones reached from junk inputs. Both simulated steps keep an encoding inside a +fixed number of blocks, which is all the bound needs. -/ + +/-- Total dispatch returns one of its two branches. -/ +private theorem caseBit₀_cases (s x y : List Bool) : + caseBit₀ s x y = x ∨ caseBit₀ s x y = y := by + cases s with + | nil => exact Or.inr rfl + | cons b s => cases b <;> simp + +/-- Both half-blocks of a stepped tape fit in one block each. -/ +private theorem tapeStepBlocks_length_le (R : List Bool) (s : Γ) (d : Dir3) + (L Rt : List Bool) (hL : L.length ≤ R.length) : + (tapeStepBlocks R s d L Rt).1.length ≤ R.length ∧ + (tapeStepBlocks R s d L Rt).2.length ≤ R.length := by + cases d <;> exact ⟨by simp [tapeStepBlocks, hL], by simp [tapeStepBlocks]⟩ + +theorem tapesStepFn_length_le (R : List Bool) : + ∀ (acts : List (Γ × Dir3)) (j : ℕ) (z : List Bool), + (tapesStepFn R acts j z).length ≤ 2 * acts.length * R.length := by + intro acts + induction acts with + | nil => intro j z; simp [tapesStepFn] + | cons a rest ih => + intro j z + obtain ⟨h1, h2⟩ := tapeStepBlocks_length_le R a.1 a.2 + (blockAt R z (2 * j + 1)) (blockAt R z (2 * j + 2)) + (by rw [blockAt]; simp) + have := ih (j + 1) z + have hexp : 2 * (rest.length + 1) * R.length + = 2 * rest.length * R.length + (R.length + R.length) := by ring + rw [tapesStepFn, List.length_append, List.length_append, List.length_cons, hexp] + omega + +theorem branchFn_length_le (R q' : List Bool) (acts : List (Γ × Dir3)) (z : List Bool) : + (branchFn R q' acts z).length ≤ (2 * acts.length + 1) * R.length := by + have := tapesStepFn_length_le R acts 0 z + have hexp : (2 * acts.length + 1) * R.length + = 2 * acts.length * R.length + R.length := by ring + rw [branchFn, List.length_append, padTo_length, hexp] + omega + +@[simp] theorem stepActsOf_length {k : ℕ} (tm : TM k) (q : tm.Q) + (syms : Fin (k + 2) → Γ) : (stepActsOf tm q syms).length = k + 2 := by + rw [stepActsOf] + simp + +/-- **An encoded configuration stays within its blocks.** -/ +theorem stepFn_length_le {k : ℕ} (tm : TM k) (R z : List Bool) + (hz : z.length ≤ (2 * (k + 2) + 1) * R.length) : + (stepFn tm R z).length ≤ (2 * (k + 2) + 1) * R.length := by + rw [stepFn] + induction stepEntries tm with + | nil => simp + | cons p rest ih => + rw [List.foldr_cons] + rcases caseBit₀_cases (matchPrefix (keyPattern p) + (keyFn R (Fintype.card tm.Q) (k + 2) z)) + (stepBranch tm R p z) _ with h | h + · rw [h] + by_cases hh : p.1 = tm.qhalt + · rw [stepBranch_halt tm R hh]; exact hz + · rw [stepBranch_step tm R hh] + have := branchFn_length_le R (stateCode (stepStateOf tm p.1 p.2)) + (stepActsOf tm p.1 p.2) z + rwa [stepActsOf_length] at this + · rw [h]; exact ih + +/-! ## Rewinding the output head + +The encoding splits a tape at its head, so reading a tape off an encoding is +easy only when the head sits at cell `0` — then the left half is empty and the +right half is the whole tape, in order. Driving the head back to cell `0` is a +*separate* iteration, of a step that moves one cell left and writes nothing. + +It is stated on one tape's pair of half-blocks rather than on a whole +configuration: after the simulation only the output tape matters, and a pair of +blocks splits with one `takeFn`/`dropFn`. -/ + +/-- One tape as its two padded half-blocks, concatenated. -/ +def pairCode (W : ℕ) (t : Tape) : List Bool := + padTo (blockRuler W) (leftCode t) ++ padTo (blockRuler W) (rightCode t W) + +theorem take_pairCode (W : ℕ) (t : Tape) : + (pairCode W t).take (blockRuler W).length = padTo (blockRuler W) (leftCode t) := + List.take_left' (by simp) + +theorem drop_pairCode (W : ℕ) (t : Tape) : + (pairCode W t).drop (blockRuler W).length = padTo (blockRuler W) (rightCode t W) := + List.drop_left' (by simp) + +/-- One left move on a pair of half-blocks, writing back the symbol `s`. -/ +def rewindStep (R : List Bool) (s : Γ) (z : List Bool) : List Bool := + (tapeStepBlocks R s Dir3.left (z.take R.length) (z.drop R.length)).1 ++ + (tapeStepBlocks R s Dir3.left (z.take R.length) (z.drop R.length)).2 + +/-- **One rewind step.** The head moves one cell left, except at cell `0` — where +it reads `▷` and stays put, which is also what the machine model does. The symbol +written back is the one just read, so nothing changes but the head. -/ +def rewindFn (R z : List Bool) : List Bool := + caseBit₀ (matchPrefix (symCode Γ.start) (z.drop R.length)) z + (caseBit₀ (matchPrefix (symCode Γ.blank) (z.drop R.length)) (rewindStep R Γ.blank z) + (caseBit₀ (matchPrefix (symCode Γ.zero) (z.drop R.length)) (rewindStep R Γ.zero z) + (rewindStep R Γ.one z))) + +/-- **The rewind step is in the algebra.** -/ +theorem rewindFn_mem {n : ℕ} {gR gz : (Fin n → List Bool) → List Bool} + (hR : Cobham gR) (hz : Cobham gz) : + Cobham fun v : Fin n → List Bool => rewindFn (gR v) (gz v) := by + have hstep : ∀ s : Γ, Cobham fun v : Fin n → List Bool => rewindStep (gR v) s (gz v) := + fun s => + (appendFn (tapeStepBlocksFst s Dir3.left hR (takeFn hR hz) (dropFn hR hz)) + (tapeStepBlocksSnd s Dir3.left hR (takeFn hR hz) (dropFn hR hz))).of_eq + fun _ => rfl + have hkey : Cobham fun v : Fin n → List Bool => (gz v).drop (gR v).length := + dropFn hR hz + exact (iteFn (matchPrefixFn hkey _) hz + (iteFn (matchPrefixFn hkey _) (hstep _) + (iteFn (matchPrefixFn hkey _) (hstep _) (hstep _)))).of_eq fun _ => rfl + +/-- The first two bits of a tape's padded right half-block code its read symbol. -/ +theorem take_two_drop_pairCode {W : ℕ} (t : Tape) (hW : t.head ≤ W) : + ((pairCode W t).drop (blockRuler W).length).take 2 = symCode t.read := by + rw [drop_pairCode, + take_padTo _ _ 2 (by rw [rightCode_length]; omega) + (by rw [rightCode_length, blockRuler_length, blockWidth]; omega), + take_rightCode _ hW] + +/-- A two-bit symbol code prefixes a padded right half-block exactly when it is +*the* read symbol's code. -/ +private theorem matchPrefix_symCode {W : ℕ} (t : Tape) (hW : t.head ≤ W) (s : Γ) : + matchPrefix (symCode s) ((pairCode W t).drop (blockRuler W).length) + = if s = t.read then [true] else [false] := by + have hlen : (symCode s).length = 2 := symCode_length s + split + · next h => + subst h + refine (matchPrefix_eq_true_iff _ _).mpr ?_ + rw [← take_two_drop_pairCode t hW, ← hlen] + exact List.take_prefix _ _ + · next h => + rcases matchPrefix_flag (symCode s) + ((pairCode W t).drop (blockRuler W).length) with hm | hm + · exfalso + have hpre := (matchPrefix_eq_true_iff _ _).mp hm + have : symCode s = symCode t.read := by + rw [← take_two_drop_pairCode t hW, ← hlen] + exact List.prefix_iff_eq_take.mp hpre + exact h (symCode_injective this) + · exact hm + +/-- At cell `0` a left move stands still — `Nat` subtraction saturates. -/ +private theorem move_left_of_head_zero {t : Tape} (h : t.head = 0) : + t.move Dir3.left = t := by + obtain ⟨hd, cs⟩ := t + simp only at h + subst h + rfl + +/-- **The rewind step computes a left move.** Away from cell `0` the symbol +written back is the one read, so `tapeStepBlocks_eq` applies with +`Tape.write_read_self`; at cell `0` the head reads `▷` and both sides stand +still. -/ +theorem rewindFn_eq {W : ℕ} (t : Tape) (hinv : t.StartInvariant) (hW : t.head ≤ W) : + rewindFn (blockRuler W) (pairCode W t) = pairCode W (t.move Dir3.left) := by + by_cases h0 : t.head = 0 + · have hread : t.read = Γ.start := by rw [Tape.read, h0]; exact hinv.1 + have hmove : t.move Dir3.left = t := move_left_of_head_zero h0 + rw [rewindFn, matchPrefix_symCode t hW, if_pos hread.symm, caseBit₀_cons, cond_true, + hmove] + · have hread : t.read ≠ Γ.start := hinv.read_ne_start (by omega) + have hstep : ∀ s : Γ, s = t.read → + rewindStep (blockRuler W) s (pairCode W t) = pairCode W (t.move Dir3.left) := by + rintro s rfl + have := tapeStepBlocks_eq (W := W) t t.read Dir3.left (fun _ => rfl) + (fun _ => h0) hW + rw [rewindStep, take_pairCode, drop_pairCode, this, write_read_self, pairCode] + rw [rewindFn, matchPrefix_symCode t hW, matchPrefix_symCode t hW, + matchPrefix_symCode t hW] + cases hr : t.read with + | start => exact absurd hr hread + | blank | zero | one => + simp +decide only [caseBit₀] + exact hstep _ hr.symm + +/-- **A rewound pair stays within its two blocks.** -/ +theorem rewindFn_length_le (R z : List Bool) (hz : z.length ≤ 2 * R.length) : + (rewindFn R z).length ≤ 2 * R.length := by + have hstep : ∀ s : Γ, (rewindStep R s z).length = 2 * R.length := fun s => by + rw [rewindStep, tapeStepBlocks, List.length_append, padTo_length, padTo_length] + omega + rw [rewindFn] + rcases caseBit₀_cases (matchPrefix (symCode Γ.start) (z.drop R.length)) z _ with h | h + · rw [h]; exact hz + · rw [h] + rcases caseBit₀_cases (matchPrefix (symCode Γ.blank) (z.drop R.length)) + (rewindStep R Γ.blank z) _ with h2 | h2 + · rw [h2]; exact (hstep _).le + · rw [h2] + rcases caseBit₀_cases (matchPrefix (symCode Γ.zero) (z.drop R.length)) + (rewindStep R Γ.zero z) _ with h3 | h3 + · rw [h3]; exact (hstep _).le + · rw [h3]; exact (hstep _).le + +/-! ## The initial encoding + +At the start every tape but the input is blank and every head is at cell `0`, so +the encoding is a fixedValue apart from the input tape's right half-block — which +is the input string at two bits per cell. Zero padding *is* blank padding, which +is why `symCode Γ.blank = [0,0]`. -/ + +/-- A bitstring as tape cells, two bits each. -/ +def encodeBits (x : List Bool) : List Bool := x.flatMap fun b => symCode (Γ.ofBool b) + +@[simp] theorem encodeBits_nil : encodeBits [] = [] := rfl + +@[simp] theorem encodeBits_cons (b : Bool) (x : List Bool) : + encodeBits (b :: x) = symCode (Γ.ofBool b) ++ encodeBits x := rfl + +@[simp] theorem encodeBits_length (x : List Bool) : + (encodeBits x).length = 2 * x.length := by + induction x with + | nil => rfl + | cons b x ih => + rw [encodeBits_cons, List.length_append, symCode_length, ih, List.length_cons] + omega + +/-- The step of `encodeBits`: prepend the peeled bit's two-bit code. -/ +private def encStep (b : Bool) (w : Fin 2 → List Bool) : List Bool := + symCode (Γ.ofBool b) ++ w 1 + +private theorem encStep_cons (b : Bool) (x p : List Bool) (v : Fin 0 → List Bool) : + encStep b (Fin.cons x (Fin.cons p v)) = symCode (Γ.ofBool b) ++ p := rfl + +/-- **Coding a string as tape cells is in the algebra.** -/ +theorem encodeBitsFn {n : ℕ} {g : (Fin n → List Bool) → List Bool} (h : Cobham g) : + Cobham fun v : Fin n → List Bool => encodeBits (g v) := by + have hrec : ∀ (x : List Bool) (v : Fin 0 → List Bool), + recNotation (fun _ : Fin 0 → List Bool => ([] : List Bool)) (encStep false) + (encStep true) x v = encodeBits x := by + intro x v + induction x with + | nil => rfl + | cons b x ih => + cases b <;> + · rw [recNotation_cons] + simp only [cond_true, cond_false] + rw [encStep_cons, ih, encodeBits_cons] + have hs : ∀ b : Bool, Cobham (encStep b) := fun b => + (appendFn (Cobham.const (symCode (Γ.ofBool b))) (Cobham.proj 1)).of_eq fun _ => rfl + have hbase : Cobham fun v : Fin 1 → List Bool => encodeBits (v 0) := by + refine (Cobham.boundedRec Cobham.empty (hs false) (hs true) + (appendFn (Cobham.proj 0) (Cobham.proj 0)) ?_).of_eq fun v => ?_ + · intro x v + rw [hrec, encodeBits_length, Fin.cons_zero, List.length_append] + omega + · rw [hrec] + exact (Cobham.comp hbase fun _ : Fin 1 => h).of_eq fun _ => rfl + +/-- **The initial encoding.** Everything but the input tape's right half-block is +a fixedValue of the machine. -/ +noncomputable def initFn {k : ℕ} (tm : TM k) (R x : List Bool) : List Bool := + padTo R (stateCode tm.qstart) ++ + (padTo R [] ++ (padTo R (symCode Γ.start ++ encodeBits x) ++ + (List.replicate (k + 1) (padTo R [] ++ padTo R (symCode Γ.start))).flatten)) + +/-- **The initial encoding is in the algebra.** -/ +theorem initFn_mem {n k : ℕ} (tm : TM k) + {gR gx : (Fin n → List Bool) → List Bool} (hR : Cobham gR) (hx : Cobham gx) : + Cobham fun v : Fin n → List Bool => initFn tm (gR v) (gx v) := + (appendFn (padFn hR (Cobham.const _)) + (appendFn (padFn hR Cobham.empty) + (appendFn (padFn hR (appendFn (Cobham.const _) (encodeBitsFn hx))) + (repeatFn (appendFn (padFn hR Cobham.empty) + (padFn hR (Cobham.const _))) (k + 1))))).of_eq fun _ => rfl + +/-! ### The initial tapes -/ + +private theorem flatten_tapesBlocks (W : ℕ) : ∀ ts : List Tape, + (tapesBlocks W ts).flatten + = (ts.map fun t => padTo (blockRuler W) (leftCode t) + ++ padTo (blockRuler W) (rightCode t W)).flatten := by + intro ts + induction ts with + | nil => rfl + | cons t ts ih => + rw [tapesBlocks, List.flatMap_cons, List.flatten_append, ← tapesBlocks, ih, + List.map_cons, List.flatten_cons, tapeBlocks] + simp + +/-- Windows concatenate. -/ +theorem cellsCode_add (t : Tape) (i a b : ℕ) : + cellsCode t i (a + b) = cellsCode t i a ++ cellsCode t (i + a) b := by + induction a generalizing i with + | zero => simp + | succ a ih => + rw [show a + 1 + b = (a + b) + 1 from by omega, cellsCode_succ_left, + cellsCode_succ_left, ih, List.append_assoc, + show i + 1 + a = i + (a + 1) from by omega] + +private theorem cellsCode_of_bits (x : List Bool) : + ∀ (t : Tape) (i : ℕ), (∀ j, ∀ hj : j < x.length, t.cells (i + j) = Γ.ofBool x[j]) → + cellsCode t i x.length = encodeBits x := by + induction x with + | nil => intro t i _; rfl + | cons b x ih => + intro t i hcells + rw [List.length_cons, cellsCode_succ_left, encodeBits_cons, + show t.cells i = Γ.ofBool b from by simpa using hcells 0 (by simp)] + congr 1 + exact ih t (i + 1) fun j hj => by + have := hcells (j + 1) (by rw [List.length_cons]; omega) + rw [show i + 1 + j = i + (j + 1) from by omega] + simpa using this + +private theorem cellsCode_of_blank (t : Tape) (i w : ℕ) + (h : ∀ j < w, t.cells (i + j) = Γ.blank) : + cellsCode t i w = List.replicate (2 * w) false := by + induction w generalizing i with + | zero => rfl + | succ w ih => + rw [cellsCode_succ_left, show t.cells i = Γ.blank from by simpa using h 0 (by omega), + ih (i + 1) fun j hj => by + rw [show i + 1 + j = i + (j + 1) from by omega]; exact h (j + 1) (by omega), + show 2 * (w + 1) = 2 + 2 * w from by omega, List.replicate_add] + rfl + +/-- **The initial encoding is the initial configuration's.** -/ +theorem initFn_eq {k : ℕ} (tm : TM k) (W : ℕ) (x : List Bool) (hx : x.length ≤ W) : + initFn tm (blockRuler W) x = cfgCode W (tm.initCfg x) := by + set R := blockRuler W with hR + -- The input tape. + have hin : padTo R (rightCode (Tape.init (x.map Γ.ofBool)) W) + = padTo R (symCode Γ.start ++ encodeBits x) := by + have h0 : cellsCode (Tape.init (x.map Γ.ofBool)) 0 1 = symCode Γ.start := by + rw [cellsCode_succ_left, cellsCode_zero, List.append_nil, Tape.init_cells_zero] + have h1 : cellsCode (Tape.init (x.map Γ.ofBool)) 1 x.length = encodeBits x := + cellsCode_of_bits x _ 1 fun j hj => by + rw [show 1 + j = j + 1 from by omega, Tape.init_cells_succ] + have hjm : j < (x.map Γ.ofBool).length := by simpa using hj + rw [List.getElem?_eq_getElem hjm] + simp + have h2 : cellsCode (Tape.init (x.map Γ.ofBool)) (1 + x.length) (W - x.length) + = List.replicate (2 * (W - x.length)) false := + cellsCode_of_blank _ _ _ fun j _ => by + rw [show 1 + x.length + j = (x.length + j) + 1 from by omega, + Tape.init_cells_succ, List.getElem?_eq_none (by simp)] + rfl + have hcells : cellsCode (Tape.init (x.map Γ.ofBool)) 0 (W + 1) + = symCode Γ.start ++ (encodeBits x + ++ List.replicate (2 * (W - x.length)) false) := by + rw [show W + 1 = 1 + (x.length + (W - x.length)) from by omega, + cellsCode_add _ 0 1 _, cellsCode_add _ (0 + 1) x.length _] + simp only [Nat.zero_add] + rw [h0, h1, h2] + rw [rightCode, Tape.init_head, Nat.sub_zero, hcells, ← List.append_assoc, + padTo_append_replicate] + have hblank : padTo R (rightCode (Tape.init []) W) = padTo R (symCode Γ.start) := by + have h0 : cellsCode (Tape.init ([] : List Γ)) 0 1 = symCode Γ.start := by + rw [cellsCode_succ_left, cellsCode_zero, List.append_nil, Tape.init_cells_zero] + have h2 : cellsCode (Tape.init ([] : List Γ)) 1 W + = List.replicate (2 * W) false := + cellsCode_of_blank _ _ _ fun j _ => by + rw [show 1 + j = j + 1 from by omega, Tape.init_nil_cells_succ] + have hcells : cellsCode (Tape.init ([] : List Γ)) 0 (W + 1) + = symCode Γ.start ++ List.replicate (2 * W) false := by + rw [show W + 1 = 1 + W from by omega, cellsCode_add _ 0 1 W] + simp only [Nat.zero_add] + rw [h0, h2] + rw [rightCode, Tape.init_head, Nat.sub_zero, hcells, padTo_append_replicate] + have hleft : ∀ contents : List Γ, leftCode (Tape.init contents) = [] := fun _ => rfl + have hct : cfgTapes (tm.initCfg x) + = Tape.init (x.map Γ.ofBool) :: List.replicate (k + 1) (Tape.init []) := by + rw [cfgTapes] + congr 1 + show (Tape.init [] : Tape) :: List.ofFn (fun _ : Fin k => (Tape.init [] : Tape)) + = List.replicate (k + 1) (Tape.init []) + rw [List.replicate_succ, List.ofFn_const] + rw [cfgCode, cfgBlocks_eq, List.flatten_cons, flatten_tapesBlocks, hct, + List.map_cons, List.flatten_cons, List.map_replicate, hleft, hleft, hin, hblank, + initFn, List.append_assoc] + +end Cobham + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/TakeLen.lean b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/TakeLen.lean new file mode 100644 index 0000000000..a99968b325 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/TakeLen.lean @@ -0,0 +1,616 @@ +/- +Copyright (c) 2026 Bolton Bailey. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Bolton Bailey +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Defs +public import LeanPool.BeyondBethe.Complexitylib.Encoding.Pairing +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Registers +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Tape.Encoding + +/-! +# Truncating to the length of a leading block — proof internals + +`takeLen (pair c y) = y.take |c|`: the leading self-delimiting block acts as a +*ruler* and the verbatim suffix is truncated to its length. Carrying a width +bound as a string rather than as a number is what keeps an iterated `FP` step +function polynomial-time — each iteration truncates its state to the ruler, so no +intermediate value can grow beyond it. + +The transducer `takeLenTM` has one work tape: *scan* parses the leading block two +symbols at a time, writing one unary mark per payload bit; *rewind* returns the +work head to cell one; *copy* emits one input symbol per remaining mark. +Malformed input halts with empty output, matching `unpair? = none`. + +## Main results + +- `Complexity.takeLen_pair` — the defining equation on genuine pairs +- `Complexity.takeLen_mem_FP` — the truncation is in `FP` +-/ + + +@[expose] public section + +namespace Complexity + +open Complexity.TM + +/-! ## The function computed by the scanner -/ + +/-- The remaining output of the truncation scanner when `k` payload bits of the +leading block have already been counted and `w` is the unread part of the input: +the suffix truncated to the total ruler length, and nothing at all when the block +framing is broken. -/ +def takeLenAux (k : ℕ) (w : List Bool) : List Bool := + match unpair? w with + | some (x, y) => y.take (k + x.length) + | none => [] + +/-- Truncate the verbatim suffix of a pair to the length of its leading block. -/ +def takeLen (p : List Bool) : List Bool := takeLenAux 0 p + +@[simp] theorem takeLenAux_nil (k : ℕ) : takeLenAux k [] = [] := rfl + +@[simp] theorem takeLenAux_singleton (k : ℕ) (b : Bool) : takeLenAux k [b] = [] := by + cases b <;> rfl + +/-- Reaching the separator ends the ruler: the suffix is truncated to `k`. -/ +@[simp] theorem takeLenAux_sep (k : ℕ) (z : List Bool) : + takeLenAux k (false :: true :: z) = z.take k := by + simp [takeLenAux, unpair?] + +/-- A doubled payload bit lengthens the ruler by one. -/ +theorem takeLenAux_double (k : ℕ) (b : Bool) (z : List Bool) : + takeLenAux k (b :: b :: z) = takeLenAux (k + 1) z := by + cases b <;> + · simp only [takeLenAux, unpair?] + cases h : unpair? z with + | none => simp + | some xy => + obtain ⟨x, y⟩ := xy + simp only [Option.map_some, List.length_cons] + rw [show k + (x.length + 1) = k + 1 + x.length from by omega] + +/-- A broken doubling halts the scan with no output. -/ +@[simp] theorem takeLenAux_broken (k : ℕ) (z : List Bool) : + takeLenAux k (true :: false :: z) = [] := rfl + +/-- On a genuine pair the leading block is the ruler. -/ +theorem takeLen_pair (c y : List Bool) : takeLen (pair c y) = y.take c.length := by + simp [takeLen, takeLenAux] + +section TakeLenMachine + +/-- Control states of `takeLenTM`. -/ +inductive TakePhase where + /-- Move every head off the left-end marker. -/ + | skip + /-- Read the first symbol of a doubled payload bit. -/ + | scanA + /-- The first symbol of the pair was `0`. -/ + | scanB0 + /-- The first symbol of the pair was `1`. -/ + | scanB1 + /-- Rewind the work head to cell one. -/ + | rew + /-- Emit one input symbol per remaining mark. -/ + | copy + /-- Halt. -/ + | done + deriving DecidableEq + +instance : Fintype TakePhase where + elems := {.skip, .scanA, .scanB0, .scanB1, .rew, .copy, .done} + complete := fun x => by cases x <;> simp + +/-- **The truncation scanner.** Parses the leading self-delimiting block into +`|c|` unary marks on its work tape, then copies that many input symbols to the +output. Computes `takeLen`. -/ +def takeLenTM : TM 1 where + Q := TakePhase + qstart := .skip + qhalt := .done + δ := fun state iHead wHeads oHead => + match state with + | .skip => + (.scanA, fun i => readBackWrite (wHeads i), readBackWrite oHead, + Dir3.right, fun _ => Dir3.right, Dir3.right) + | .scanA => + match iHead with + | Γ.zero => + (.scanB0, fun i => readBackWrite (wHeads i), readBackWrite oHead, + Dir3.right, fun i => idleDir (wHeads i), idleDir oHead) + | Γ.one => + (.scanB1, fun i => readBackWrite (wHeads i), readBackWrite oHead, + Dir3.right, fun i => idleDir (wHeads i), idleDir oHead) + | _ => + (.done, fun i => readBackWrite (wHeads i), readBackWrite oHead, + idleDir iHead, fun i => idleDir (wHeads i), idleDir oHead) + | .scanB0 => + match iHead with + | Γ.zero => + (.scanA, fun _ => Γw.one, readBackWrite oHead, + Dir3.right, fun _ => Dir3.right, idleDir oHead) + | Γ.one => + (.rew, fun i => readBackWrite (wHeads i), readBackWrite oHead, + Dir3.right, fun i => idleDir (wHeads i), idleDir oHead) + | _ => + (.done, fun i => readBackWrite (wHeads i), readBackWrite oHead, + idleDir iHead, fun i => idleDir (wHeads i), idleDir oHead) + | .scanB1 => + match iHead with + | Γ.one => + (.scanA, fun _ => Γw.one, readBackWrite oHead, + Dir3.right, fun _ => Dir3.right, idleDir oHead) + | _ => + (.done, fun i => readBackWrite (wHeads i), readBackWrite oHead, + idleDir iHead, fun i => idleDir (wHeads i), idleDir oHead) + | .rew => + if wHeads 0 = Γ.start then + (.copy, fun i => readBackWrite (wHeads i), readBackWrite oHead, + idleDir iHead, fun _ => Dir3.right, idleDir oHead) + else + (.rew, fun i => readBackWrite (wHeads i), readBackWrite oHead, + idleDir iHead, fun i => moveLeftDir (wHeads i), idleDir oHead) + | .copy => + if wHeads 0 = Γ.one then + match iHead with + | Γ.zero => + (.copy, fun i => readBackWrite (wHeads i), Γw.zero, + Dir3.right, fun _ => Dir3.right, Dir3.right) + | Γ.one => + (.copy, fun i => readBackWrite (wHeads i), Γw.one, + Dir3.right, fun _ => Dir3.right, Dir3.right) + | _ => + (.done, fun i => readBackWrite (wHeads i), readBackWrite oHead, + idleDir iHead, fun i => idleDir (wHeads i), idleDir oHead) + else + (.done, fun i => readBackWrite (wHeads i), readBackWrite oHead, + idleDir iHead, fun i => idleDir (wHeads i), idleDir oHead) + | .done => allIdle .done iHead wHeads oHead + δ_right_of_start := by + intro state iHead wHeads oHead + match state with + | .skip => exact ⟨fun _ => rfl, fun _ _ => rfl, fun _ => rfl⟩ + | .scanA => + cases iHead <;> + exact ⟨by first | exact fun _ => rfl | exact idleDir_right_of_start, + fun _ => idleDir_right_of_start, + by first | exact fun _ => rfl | exact idleDir_right_of_start⟩ + | .scanB0 => + cases iHead <;> + exact ⟨by first | exact fun _ => rfl | exact idleDir_right_of_start, + by first | exact fun _ _ => rfl | exact fun _ => idleDir_right_of_start, + by first | exact fun _ => rfl | exact idleDir_right_of_start⟩ + | .scanB1 => + cases iHead <;> + exact ⟨by first | exact fun _ => rfl | exact idleDir_right_of_start, + by first | exact fun _ _ => rfl | exact fun _ => idleDir_right_of_start, + by first | exact fun _ => rfl | exact idleDir_right_of_start⟩ + | .rew => + dsimp only [] + split + · exact ⟨idleDir_right_of_start, fun _ _ => rfl, idleDir_right_of_start⟩ + · exact ⟨idleDir_right_of_start, fun _ => moveLeftDir_right_of_start, + idleDir_right_of_start⟩ + | .copy => + dsimp only [] + split + · cases iHead <;> + exact ⟨by first | exact fun _ => rfl | exact idleDir_right_of_start, + by first | exact fun _ _ => rfl | exact fun _ => idleDir_right_of_start, + by first | exact fun _ => rfl | exact idleDir_right_of_start⟩ + · exact ⟨idleDir_right_of_start, fun _ => idleDir_right_of_start, + idleDir_right_of_start⟩ + | .done => exact rightOfStart_allIdle iHead wHeads oHead + +/-! ## Correctness of the scanner -/ + +/-- A content-preserving idle step on a tape whose head is off the left marker. -/ +private theorem take_idle_eq {t : Tape} (h : t.read ≠ Γ.start) : + t.writeAndMove (readBackWrite t.read) (idleDir t.read) = t := by + rw [writeAndMove_readBack t h, idleDir, if_neg h, Tape.move] + +/-- The copy phase: with `r` marks left under and to the right of the work head, +the machine emits the first `r` symbols of the remaining input. -/ +private theorem takeLenTM_copy_loop : + ∀ (r h m : ℕ), h + r = m + 1 → 1 ≤ h → + ∀ (y acc : List Bool) (c : Cfg 1 takeLenTM.Q), + c.state = TakePhase.copy → + (c.work 0).cells = regCells m → + (c.work 0).head = h → + c.input.HasBinarySuffix y → + c.output.HasBinaryPrefix acc → + ∃ c' t, t ≤ r + 1 ∧ takeLenTM.reachesIn t c c' ∧ takeLenTM.halted c' ∧ + c'.output.HasBinaryPrefix (acc ++ y.take r) := by + intro r + induction r with + | zero => + intro h m hsum hh y acc c hstate hcells hhead hsuf hpre + have hwread : (c.work 0).read = Γ.blank := by + rw [Tape.read, hcells, hhead]; exact regCells_blank (by omega) + have hwne : (c.work 0).read ≠ Γ.start := by rw [hwread]; decide + have hwne1 : ¬ (c.work 0).read = Γ.one := by rw [hwread]; decide + have houtne : c.output.read ≠ Γ.start := by rw [hpre.read_blank]; decide + have hinp_eq : c.input.move (idleDir c.input.read) = c.input := by + rw [idleDir, if_neg hsuf.read_ne_start, Tape.move] + have hwork : (fun i => (c.work i).writeAndMove (readBackWrite ((c.work i).read)).toΓ + (idleDir ((c.work i).read))) = c.work := by + funext i + have hi : i = 0 := Subsingleton.elim i 0 + subst hi + exact take_idle_eq hwne + refine ⟨{ state := TakePhase.done + input := c.input + work := c.work + output := c.output }, 1, by omega, ?_, rfl, by simpa using hpre⟩ + refine .step ?_ .zero + simp only [TM.step, hstate, takeLenTM, hwne1, hinp_eq, reduceCtorEq, if_false] + rw [hwork, take_idle_eq houtne] + | succ r ih => + intro h m hsum hh y acc c hstate hcells hhead hsuf hpre + have hwread : (c.work 0).read = Γ.one := by + rw [Tape.read, hcells, hhead]; exact regCells_one (by omega) (by omega) + have hwne : (c.work 0).read ≠ Γ.start := by rw [hwread]; decide + have houtne : c.output.read ≠ Γ.start := by rw [hpre.read_blank]; decide + have hinp_eq : c.input.move (idleDir c.input.read) = c.input := by + rw [idleDir, if_neg hsuf.read_ne_start, Tape.move] + have hworkIdle : (fun i => (c.work i).writeAndMove (readBackWrite ((c.work i).read)).toΓ + (idleDir ((c.work i).read))) = c.work := by + funext i + have hi : i = 0 := Subsingleton.elim i 0 + subst hi + exact take_idle_eq hwne + have hworkR : (fun i => (c.work i).writeAndMove (readBackWrite ((c.work i).read)).toΓ + Dir3.right) = fun i => (c.work i).move Dir3.right := by + funext i + have hi : i = 0 := Subsingleton.elim i 0 + subst hi + exact writeAndMove_readBack _ hwne _ + have hidleB : ∀ t : Tape, t.move (idleDir Γ.blank) = t := by + intro t; rw [idleDir, if_neg (by decide)]; rfl + match y with + | [] => + have hread : c.input.read = Γ.blank := hsuf.read_nil + refine ⟨{ state := TakePhase.done + input := c.input + work := c.work + output := c.output }, 1, by omega, ?_, rfl, by simpa using hpre⟩ + refine .step ?_ .zero + simp only [TM.step, hstate, takeLenTM, hwread, hread, hidleB, reduceCtorEq, + if_false, reduceIte] + rw [hworkIdle, take_idle_eq houtne] + | b :: y => + have hread : c.input.read = Γ.ofBool b := hsuf.read_cons + set c1 : Cfg 1 takeLenTM.Q := + { state := TakePhase.copy + input := c.input.move Dir3.right + work := fun i => (c.work i).move Dir3.right + output := c.output.writeAndMove (Γ.ofBool b) Dir3.right } with hc1 + have hstep : takeLenTM.step c = some c1 := by + cases b <;> + · simp only [TM.step, hstate, takeLenTM, hwread, hread, hc1, Γ.ofBool, + reduceCtorEq, if_false, reduceIte] + rw [hworkR] + rfl + obtain ⟨c', t, ht, hreach, hhalt, hfin⟩ := + ih (h + 1) m (by omega) (by omega) y (acc ++ [b]) c1 rfl + (by rw [hc1]; simpa using hcells) + (by rw [hc1]; simp [Tape.move, hhead]) + (by rw [hc1]; exact hsuf.move_right_cons) + (by rw [hc1]; exact Tape.hasBinaryPrefix_write_bit b hpre) + refine ⟨c', t + 1, by omega, .step hstep hreach, hhalt, ?_⟩ + simpa using hfin + +/-- The rewind phase: walk the work head back to the left-end marker and enter +`copy` with the work head at cell one. -/ +private theorem takeLenTM_rew_loop : + ∀ (h m : ℕ) (c : Cfg 1 takeLenTM.Q), + c.state = TakePhase.rew → + (c.work 0).cells = regCells m → + (c.work 0).head = h → + c.input.read ≠ Γ.start → + c.output.read ≠ Γ.start → + ∃ c', takeLenTM.reachesIn (h + 1) c c' ∧ + c'.state = TakePhase.copy ∧ + (c'.work 0).cells = regCells m ∧ + (c'.work 0).head = 1 ∧ + c'.input = c.input ∧ + c'.output = c.output := by + intro h + induction h with + | zero => + intro m c hstate hcells hhead hinp hout + have hwread : (c.work 0).read = Γ.start := by + rw [Tape.read, hcells, hhead]; rfl + have hinp_eq : c.input.move (idleDir c.input.read) = c.input := by + rw [idleDir, if_neg hinp, Tape.move] + have hwork : (fun i => (c.work i).writeAndMove (readBackWrite ((c.work i).read)).toΓ + Dir3.right) = fun i => (c.work i).move Dir3.right := by + funext i + have hi : i = 0 := Subsingleton.elim i 0 + subst hi + show ((c.work 0).write _).move Dir3.right = (c.work 0).move Dir3.right + rw [Tape.write, if_pos hhead] + refine ⟨{ state := TakePhase.copy + input := c.input + work := fun i => (c.work i).move Dir3.right + output := c.output }, ?_, rfl, by simp [Tape.move_cells, hcells], + by simp [Tape.move, hhead], rfl, rfl⟩ + refine .step ?_ .zero + simp only [TM.step, hstate, takeLenTM, hwread, hinp_eq, reduceIte, reduceCtorEq, + if_false] + rw [hwork, take_idle_eq hout] + | succ h ih => + intro m c hstate hcells hhead hinp hout + have hwne : (c.work 0).read ≠ Γ.start := by + rw [Tape.read, hcells, hhead]; exact regCells_ne_start (by omega) + have hinp_eq : c.input.move (idleDir c.input.read) = c.input := by + rw [idleDir, if_neg hinp, Tape.move] + set c1 : Cfg 1 takeLenTM.Q := + { state := TakePhase.rew + input := c.input + work := fun i => (c.work i).move Dir3.left + output := c.output } with hc1 + have hwork : (fun i => (c.work i).writeAndMove (readBackWrite ((c.work i).read)).toΓ + (moveLeftDir ((c.work i).read))) = fun i => (c.work i).move Dir3.left := by + funext i + have hi : i = 0 := Subsingleton.elim i 0 + subst hi + rw [moveLeftDir, if_neg hwne] + exact writeAndMove_readBack _ hwne _ + have hstep : takeLenTM.step c = some c1 := by + simp only [TM.step, hstate, takeLenTM, hinp_eq, hc1, if_neg hwne, reduceCtorEq, + if_false] + rw [hwork, take_idle_eq hout] + obtain ⟨c', hreach, hst, hcl, hhd, hin, hou⟩ := + ih m c1 rfl (by rw [hc1]; simpa [Tape.move_cells] using hcells) + (by rw [hc1]; simp [Tape.move, hhead]) + (by rw [hc1]; simpa using hinp) (by rw [hc1]; simpa using hout) + exact ⟨c', .step hstep hreach, hst, hcl, hhd, by rw [hin, hc1], by rw [hou, hc1]⟩ + +/-- The scan phase: from `scanA` with `k` ruler bits already counted and `w` +unread, the machine runs to a halt with `takeLenAux k w` on the output tape. -/ +private theorem takeLenTM_scan_loop : + ∀ (N : ℕ) (w : List Bool) (k : ℕ), k + w.length ≤ N → + ∀ (c : Cfg 1 takeLenTM.Q), + c.state = TakePhase.scanA → + (c.work 0).cells = regCells k → + (c.work 0).head = k + 1 → + c.input.HasBinarySuffix w → + c.output.HasBinaryPrefix [] → + ∃ c' t, t ≤ 3 * N + 5 ∧ takeLenTM.reachesIn t c c' ∧ + takeLenTM.halted c' ∧ + c'.output.HasBinaryPrefix (takeLenAux k w) := by + intro N + induction N with + | zero => + intro w k hN c hstate hcells hhead hsuf hpre + have hwnil : w = [] := List.length_eq_zero_iff.mp (by omega) + subst hwnil + have hwne : (c.work 0).read ≠ Γ.start := by + rw [Tape.read, hcells, hhead]; exact regCells_ne_start (by omega) + have houtne : c.output.read ≠ Γ.start := by rw [hpre.read_blank]; decide + have hwork : (fun i => (c.work i).writeAndMove (readBackWrite ((c.work i).read)).toΓ + (idleDir ((c.work i).read))) = c.work := by + funext i + have hi : i = 0 := Subsingleton.elim i 0 + subst hi + exact take_idle_eq hwne + have hread : c.input.read = Γ.blank := hsuf.read_nil + have hidleB : ∀ t : Tape, t.move (idleDir Γ.blank) = t := by + intro t; rw [idleDir, if_neg (by decide)]; rfl + refine ⟨{ state := TakePhase.done + input := c.input + work := c.work + output := c.output }, 1, by omega, ?_, rfl, by simpa using hpre⟩ + refine .step ?_ .zero + simp only [TM.step, hstate, takeLenTM, hread, hidleB, reduceCtorEq, if_false] + rw [hwork, take_idle_eq houtne] + | succ N ih => + intro w k hN c hstate hcells hhead hsuf hpre + have hwne : (c.work 0).read ≠ Γ.start := by + rw [Tape.read, hcells, hhead]; exact regCells_ne_start (by omega) + have houtne : c.output.read ≠ Γ.start := by rw [hpre.read_blank]; decide + have hwork : (fun i => (c.work i).writeAndMove (readBackWrite ((c.work i).read)).toΓ + (idleDir ((c.work i).read))) = c.work := by + funext i + have hi : i = 0 := Subsingleton.elim i 0 + subst hi + exact take_idle_eq hwne + have hidleB : ∀ t : Tape, t.move (idleDir Γ.blank) = t := by + intro t; rw [idleDir, if_neg (by decide)]; rfl + have hidleZ : ∀ t : Tape, t.move (idleDir Γ.zero) = t := by + intro t; rw [idleDir, if_neg (by decide)]; rfl + have hstepA : ∀ b : Bool, + c.input.read = Γ.ofBool b → + takeLenTM.step c = some + { state := (bif b then TakePhase.scanB1 else TakePhase.scanB0) + input := c.input.move Dir3.right + work := c.work + output := c.output } := by + intro b hread + cases b <;> + · simp only [TM.step, hstate, takeLenTM, hread, Γ.ofBool, reduceCtorEq, if_false, + cond_true, cond_false] + rw [hwork, take_idle_eq houtne] + match w with + | [] => + have hread : c.input.read = Γ.blank := hsuf.read_nil + refine ⟨{ state := TakePhase.done + input := c.input + work := c.work + output := c.output }, 1, by omega, ?_, rfl, by simpa using hpre⟩ + refine .step ?_ .zero + simp only [TM.step, hstate, takeLenTM, hread, hidleB, reduceCtorEq, if_false] + rw [hwork, take_idle_eq houtne] + | [b] => + have hsuf1 : (c.input.move Dir3.right).HasBinarySuffix [] := hsuf.move_right_cons + have hread1 : (c.input.move Dir3.right).read = Γ.blank := hsuf1.read_nil + refine ⟨{ state := TakePhase.done + input := c.input.move Dir3.right + work := c.work + output := c.output }, 2, by omega, ?_, rfl, by + simpa [takeLenAux_singleton] using hpre⟩ + refine .step (hstepA b hsuf.read_cons) (.step ?_ .zero) + cases b <;> + · simp only [TM.step, takeLenTM, hread1, hidleB, reduceCtorEq, if_false, + cond_true, cond_false] + rw [hwork, take_idle_eq houtne] + | true :: false :: z => + have hsuf1 : (c.input.move Dir3.right).HasBinarySuffix (false :: z) := + hsuf.move_right_cons + have hread1 : (c.input.move Dir3.right).read = Γ.zero := hsuf1.read_cons + refine ⟨{ state := TakePhase.done + input := c.input.move Dir3.right + work := c.work + output := c.output }, 2, by omega, ?_, rfl, by + simpa [takeLenAux_broken] using hpre⟩ + refine .step (hstepA true hsuf.read_cons) (.step ?_ .zero) + simp only [TM.step, takeLenTM, hread1, hidleZ, reduceCtorEq, if_false, cond_true] + rw [hwork, take_idle_eq houtne] + | false :: true :: z => + have hsuf1 : (c.input.move Dir3.right).HasBinarySuffix (true :: z) := + hsuf.move_right_cons + have hread1 : (c.input.move Dir3.right).read = Γ.one := hsuf1.read_cons + set c1 : Cfg 1 takeLenTM.Q := + { state := TakePhase.scanB0 + input := c.input.move Dir3.right + work := c.work + output := c.output } with hc1 + have hstep1 : takeLenTM.step c = some c1 := hstepA false hsuf.read_cons + set c2 : Cfg 1 takeLenTM.Q := + { state := TakePhase.rew + input := (c.input.move Dir3.right).move Dir3.right + work := c.work + output := c.output } with hc2 + have hstep2 : takeLenTM.step c1 = some c2 := by + simp only [TM.step, hc1, hc2, takeLenTM, hread1, reduceCtorEq, if_false] + rw [hwork, take_idle_eq houtne] + have hsuf2 : c2.input.HasBinarySuffix z := hsuf1.move_right_cons + obtain ⟨c3, hreach3, hst3, hcl3, hhd3, hin3, hou3⟩ := + takeLenTM_rew_loop (k + 1) k c2 rfl (by rw [hc2]; exact hcells) + (by rw [hc2]; exact hhead) hsuf2.read_ne_start (by rw [hc2]; exact houtne) + obtain ⟨c', t, ht, hreach', hhalt', hout'⟩ := + takeLenTM_copy_loop k 1 k (by omega) (by omega) z [] c3 hst3 hcl3 hhd3 + (by rw [hin3]; exact hsuf2) (by rw [hou3]; exact hpre) + refine ⟨c', (k + 1 + 1 + t) + 1 + 1, ?_, ?_, hhalt', ?_⟩ + · simp only [List.length_cons] at hN + omega + · exact .step hstep1 (.step hstep2 (takeLenTM.reachesIn_trans hreach3 hreach')) + · rw [takeLenAux_sep] + simpa using hout' + | false :: false :: z => + have hsuf1 : (c.input.move Dir3.right).HasBinarySuffix (false :: z) := + hsuf.move_right_cons + have hread1 : (c.input.move Dir3.right).read = Γ.zero := hsuf1.read_cons + set c1 : Cfg 1 takeLenTM.Q := + { state := TakePhase.scanB0 + input := c.input.move Dir3.right + work := c.work + output := c.output } with hc1 + have hstep1 : takeLenTM.step c = some c1 := hstepA false hsuf.read_cons + set c2 : Cfg 1 takeLenTM.Q := + { state := TakePhase.scanA + input := (c.input.move Dir3.right).move Dir3.right + work := fun i => ((c.work i).write Γ.one).move Dir3.right + output := c.output } with hc2 + have hwmark : (fun i => (c.work i).writeAndMove (Γw.one).toΓ Dir3.right) + = fun i => ((c.work i).write Γ.one).move Dir3.right := rfl + have hstep2 : takeLenTM.step c1 = some c2 := by + simp only [TM.step, hc1, hc2, takeLenTM, hread1, reduceCtorEq, if_false] + rw [hwmark, take_idle_eq houtne] + have hcells2 : (c2.work 0).cells = regCells (k + 1) := by + rw [hc2] + show (((c.work 0).write Γ.one).move Dir3.right).cells = _ + rw [Tape.move_cells, Tape.write, if_neg (by rw [hhead]; omega)] + show Function.update (c.work 0).cells ((c.work 0).head) Γ.one = _ + rw [hcells, hhead, regCells_update_succ] + have hhead2 : (c2.work 0).head = k + 1 + 1 := by + rw [hc2] + show (((c.work 0).write Γ.one).move Dir3.right).head = _ + rw [Tape.move, Tape.write_head, hhead] + obtain ⟨c', t, ht, hreach', hhalt', hout'⟩ := + ih z (k + 1) (by simp only [List.length_cons] at hN; omega) c2 rfl hcells2 + hhead2 (by rw [hc2]; exact hsuf1.move_right_cons) (by rw [hc2]; exact hpre) + refine ⟨c', t + 1 + 1, by omega, .step hstep1 (.step hstep2 hreach'), hhalt', ?_⟩ + rwa [takeLenAux_double] + | true :: true :: z => + have hsuf1 : (c.input.move Dir3.right).HasBinarySuffix (true :: z) := + hsuf.move_right_cons + have hread1 : (c.input.move Dir3.right).read = Γ.one := hsuf1.read_cons + set c1 : Cfg 1 takeLenTM.Q := + { state := TakePhase.scanB1 + input := c.input.move Dir3.right + work := c.work + output := c.output } with hc1 + have hstep1 : takeLenTM.step c = some c1 := hstepA true hsuf.read_cons + set c2 : Cfg 1 takeLenTM.Q := + { state := TakePhase.scanA + input := (c.input.move Dir3.right).move Dir3.right + work := fun i => ((c.work i).write Γ.one).move Dir3.right + output := c.output } with hc2 + have hwmark : (fun i => (c.work i).writeAndMove (Γw.one).toΓ Dir3.right) + = fun i => ((c.work i).write Γ.one).move Dir3.right := rfl + have hstep2 : takeLenTM.step c1 = some c2 := by + simp only [TM.step, hc1, hc2, takeLenTM, hread1, reduceCtorEq, if_false] + rw [hwmark, take_idle_eq houtne] + have hcells2 : (c2.work 0).cells = regCells (k + 1) := by + rw [hc2] + show (((c.work 0).write Γ.one).move Dir3.right).cells = _ + rw [Tape.move_cells, Tape.write, if_neg (by rw [hhead]; omega)] + show Function.update (c.work 0).cells ((c.work 0).head) Γ.one = _ + rw [hcells, hhead, regCells_update_succ] + have hhead2 : (c2.work 0).head = k + 1 + 1 := by + rw [hc2] + show (((c.work 0).write Γ.one).move Dir3.right).head = _ + rw [Tape.move, Tape.write_head, hhead] + obtain ⟨c', t, ht, hreach', hhalt', hout'⟩ := + ih z (k + 1) (by simp only [List.length_cons] at hN; omega) c2 rfl hcells2 + hhead2 (by rw [hc2]; exact hsuf1.move_right_cons) (by rw [hc2]; exact hpre) + refine ⟨c', t + 1 + 1, by omega, .step hstep1 (.step hstep2 hreach'), hhalt', ?_⟩ + rwa [takeLenAux_double] + +/-- The blank work tape of the initial configuration is the zero register. -/ +private theorem take_init_nil_cells : + (Tape.init ([] : List Γ)).cells = regCells 0 := by + funext j + rcases Nat.eq_zero_or_pos j with rfl | hj + · rfl + · obtain ⟨i, rfl⟩ : ∃ i, j = i + 1 := ⟨j - 1, by omega⟩ + rw [Tape.init_cells_ge _ _ (by simp), regCells_blank (by omega)] + +/-- `takeLenTM` computes `takeLen` in `3 · |p| + 6` steps. -/ +theorem takeLenTM_computesInTime : + takeLenTM.ComputesInTime takeLen (fun n => 3 * n + 6) := by + intro p + set c1 : Cfg 1 takeLenTM.Q := + { state := TakePhase.scanA + input := (Tape.init (p.map Γ.ofBool)).move Dir3.right + work := fun _ => (Tape.init []).move Dir3.right + output := (Tape.init []).move Dir3.right } with hc1 + have hstep1 : takeLenTM.step (takeLenTM.initCfg p) = some c1 := by + simp [TM.step, takeLenTM, hc1, Tape.read, Tape.init, readBackWrite, + Tape.writeAndMove, Tape.write, Tape.move] + obtain ⟨c', t, ht, hreach, hhalt, hout⟩ := + takeLenTM_scan_loop p.length p 0 (by omega) c1 rfl + (by rw [hc1]; show ((Tape.init []).move Dir3.right).cells = _ + rw [Tape.move_cells, take_init_nil_cells]) + (by rw [hc1]; show ((Tape.init []).move Dir3.right).head = _ + simp [Tape.move]) + (by rw [hc1]; exact Tape.init_move_right_hasBinarySuffix p) + (by rw [hc1]; exact Tape.init_nil_move_right_hasBinaryPrefix_nil) + exact ⟨c', t + 1, by simp; omega, .step hstep1 hreach, hhalt, hout.hasOutput⟩ + +end TakeLenMachine + +/-- Internal proof that ruler-truncation is in `FP`. -/ +theorem takeLen_mem_FP : takeLen ∈ FP := by + refine ⟨1, 1, takeLenTM, (fun n => 3 * n + 6), takeLenTM_computesInTime, ?_⟩ + have hn : (fun n : ℕ => 3 * n) =O ((· ^ 1) : ℕ → ℕ) := by + simpa [pow_one] using (BigO.refl (fun n : ℕ => n)).const_mul_left 3 + exact BigO.add hn (BigO.const_le_pow 6 1) + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/Vec.lean b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/Vec.lean new file mode 100644 index 0000000000..f991e26346 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/Vec.lean @@ -0,0 +1,50 @@ +/- +Copyright (c) 2026 Bolton Bailey. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Bolton Bailey +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Vec +import LeanPool.BeyondBethe.Complexitylib.Classes.P.FinsetDomain +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.PairWithInput + +/-! +# The multi-arity bridge — proof internals + +The public tuple encoding and `FPn` predicate live in +`Complexitylib.Classes.P.Cobham.Vec`. This internal module supplies the concrete +`FP` building blocks used to connect their arity-one specialization to `FP`. + +## Main results + +- `Cobham.const_nil_mem_FP`, `Cobham.pairLeftNil_mem_FP` — the two `FP` maps the + arity-one glue needs +-/ + + +@[expose] public section + +namespace Complexity + +namespace Cobham + +/-! ## Foundational FP building blocks -/ + +/-- The fixedValue empty-output function is in `FP` (the empty-support case of +`ite_mem_finset_mem_FP`). -/ +theorem const_nil_mem_FP : (fun _ : List Bool => ([] : List Bool)) ∈ FP := by + have h := ite_mem_finset_mem_FP (fun _ => []) (∅ : Finset (List Bool)) + simpa using h + +/-- The framing map `x ↦ pair [] x` (i.e. `false :: true :: x`) is +polynomial-time. This is the foundational map behind the arity-one encoding +`encodeVec ![x] = pair [] x`, and it is exactly `mem_FP_pairWithInput` applied to +the fixedValue empty function. -/ +theorem pairLeftNil_mem_FP : (fun x : List Bool => pair [] x) ∈ FP := by + have h := mem_FP_pairWithInput const_nil_mem_FP + simpa using h + +end Cobham + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Vec.lean b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Vec.lean new file mode 100644 index 0000000000..e49a11d4c0 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Vec.lean @@ -0,0 +1,120 @@ +/- +Copyright (c) 2026 Bolton Bailey. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Bolton Bailey, Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Defs +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Defs +public import LeanPool.BeyondBethe.Complexitylib.Encoding.Pairing +import Mathlib.Algebra.BigOperators.Group.Finset.Basic + +/-! +# Fixed-arity inputs for Cobham's characterization + +`FP` is defined for unary string functions, while Cobham's algebra is inherently +multi-arity. This module gives the public, auditable bridge: `encodeVec` packs a +fixed-arity argument vector into one string, `vectorLength` measures its unencoded +size, and `FPn` asks a unary `FP` function to agree on the encoded vectors. + +The nested pairing has an arity-dependent fixedValue overhead. It is injective, and +for every fixed arity its encoded length is linear in `vectorLength`. + +## Main definitions and results + +- `Cobham.encodeVec` — nested-pairing tuple encoding, head component last +- `Cobham.vectorLength` — sum of the component lengths +- `Cobham.encodeVec_injective` — tuple encoding loses no information +- `Cobham.encodeVec_length_le` — fixed-arity linear length bound +- `Cobham.FPn` — polynomial time on encoded argument vectors +-/ + + +@[expose] public section + +namespace Complexity + +namespace Cobham + +/-- Encode an argument vector as a single bitstring by nested pairing, with the +head component placed in the verbatim suffix: +`encodeVec ![] = []` and `encodeVec (x ::ᵥ v) = pair (encodeVec v) x`. -/ +def encodeVec : {n : ℕ} → (Fin n → List Bool) → List Bool + | 0, _ => [] + | _ + 1, v => pair (encodeVec (Fin.tail v)) (v 0) + +@[simp] theorem encodeVec_zero (v : Fin 0 → List Bool) : encodeVec v = [] := rfl + +@[simp] theorem encodeVec_succ {n : ℕ} (v : Fin (n + 1) → List Bool) : + encodeVec v = pair (encodeVec (Fin.tail v)) (v 0) := rfl + +/-- The arity-one encoding is the single component placed in the verbatim suffix +of an empty block: `encodeVec ![x] = pair [] x`. -/ +theorem encodeVec_one (v : Fin 1 → List Bool) : encodeVec v = pair [] (v 0) := by + simp [encodeVec] + +/-- The sum of the component lengths of a fixed-arity input vector. -/ +def vectorLength {n : ℕ} (v : Fin n → List Bool) : ℕ := + ∑ i, (v i).length + +@[simp] theorem vectorLength_zero (v : Fin 0 → List Bool) : vectorLength v = 0 := by + simp [vectorLength] + +@[simp] theorem vectorLength_succ {n : ℕ} (v : Fin (n + 1) → List Bool) : + vectorLength v = (v 0).length + vectorLength (Fin.tail v) := by + rw [vectorLength, Fin.sum_univ_succ, vectorLength] + rfl + +/-- Exact recursive length law for the nested tuple encoding. -/ +theorem encodeVec_length_succ {n : ℕ} (v : Fin (n + 1) → List Bool) : + (encodeVec v).length = + 2 * (encodeVec (Fin.tail v)).length + 2 + (v 0).length := by + simp [encodeVec_succ] + +/-- `encodeVec` is injective at every arity. -/ +theorem encodeVec_injective {n : ℕ} : Function.Injective (@encodeVec n) := by + induction n with + | zero => + intro v w _ + funext i + exact Fin.elim0 i + | succ n ih => + intro v w h + rw [encodeVec_succ, encodeVec_succ] at h + obtain ⟨htail, hhead⟩ := pair_inj h + have htail' : Fin.tail v = Fin.tail w := ih htail + funext i + refine Fin.cases ?_ (fun j => ?_) i + · exact hhead + · exact congrFun htail' j + +/-- For fixed arity `n`, the nested encoding has length linear in the sum of the +component lengths. The explicit coefficient also records that this is not a +uniform-in-arity linear bound. -/ +theorem encodeVec_length_le {n : ℕ} (v : Fin n → List Bool) : + (encodeVec v).length ≤ 2 ^ n * (vectorLength v + 2 * n) := by + induction n with + | zero => + simp [encodeVec, vectorLength] + | succ n ih => + rw [encodeVec_length_succ, vectorLength_succ] + have hp : 1 ≤ 2 ^ n := one_le_pow₀ (by omega) + have h2 := Nat.mul_le_mul_left 2 (ih (Fin.tail v)) + calc + 2 * (encodeVec (Fin.tail v)).length + 2 + (v 0).length + ≤ 2 * (2 ^ n * (vectorLength (Fin.tail v) + 2 * n)) + + 2 + (v 0).length := by omega + _ ≤ 2 ^ (n + 1) * + ((v 0).length + vectorLength (Fin.tail v) + 2 * (n + 1)) := by + rw [pow_succ] + nlinarith + +/-- **Multi-arity polynomial time.** A function of an argument vector is `FPn` +when some genuine unary `FP` function computes it on encoded vectors. -/ +def FPn {n : ℕ} (f : (Fin n → List Bool) → List Bool) : Prop := + ∃ g, g ∈ FP ∧ ∀ v, g (encodeVec v) = f v + +end Cobham + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Composition.lean b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Composition.lean new file mode 100644 index 0000000000..597d21f41d --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Composition.lean @@ -0,0 +1,28 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Internal.Composition + +/-! +# Closure of FP under composition + +## Main result + +- `mem_FP_comp` — polynomial-time string functions are closed under composition +-/ + + +public section + +namespace Complexity + +/-- The composition of two polynomial-time string functions is polynomial-time. -/ +theorem mem_FP_comp {f g : List Bool → List Bool} + (hf : f ∈ FP) (hg : g ∈ FP) : (g ∘ f) ∈ FP := by + exact mem_FP_comp_internal hf hg + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Defs.lean b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Defs.lean new file mode 100644 index 0000000000..4c5778b5e0 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Defs.lean @@ -0,0 +1,41 @@ +/- +Copyright (c) 2025 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Classes.Time +public import LeanPool.BeyondBethe.Complexitylib.Classes.Space + +/-! +# P, FP, and PSPACE + +This file defines **P** (polynomial time), **FP** (polynomial-time functions), +and **PSPACE** (polynomial space) in terms of the base classes `DTIME` and +`DSPACE`. +-/ + + +@[expose] public section + +namespace Complexity + + +/-- **P** is the class of languages decidable by a deterministic TM in + polynomial time: `P = ⋃_k DTIME(n^k)`. -/ +def P : Set Language := + ⋃ k : ℕ, DTIME (· ^ k) + +/-- **FP** is the class of functions computable by a deterministic TM in + polynomial time. -/ +def FP : Set (List Bool → List Bool) := + {f | ∃ (d k : ℕ) (tm : TM k) (T : ℕ → ℕ), + tm.ComputesInTime f T ∧ T =O (· ^ d)} + +/-- **PSPACE** is the class of languages decidable by a deterministic TM using + polynomial auxiliary space: `PSPACE = ⋃_k DSPACE(n^k)`. -/ +def PSPACE : Set Language := + ⋃ k : ℕ, DSPACE (· ^ k) + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Classes/P/FinsetDomain.lean b/LeanPool/BeyondBethe/Complexitylib/Classes/P/FinsetDomain.lean new file mode 100644 index 0000000000..b59dfc910a --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Classes/P/FinsetDomain.lean @@ -0,0 +1,41 @@ +/- +Copyright (c) 2026 Bolton Bailey. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Bolton Bailey +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.FinsetDomain.Internal + +/-! +# Finite-deviation functions are polynomial-time + +A function that agrees with the fixedValue empty-output function on all but +finitely many inputs is polynomial-time computable. Concretely, for any target +function `g` and finite set `S`, the function `fun s => if s ∈ S then g s else []` +belongs to `FP`: the finite lookup table can be hard-wired into the states of a +Turing machine that decides membership in `S` while scanning the input and then +emits the corresponding fixed output, all in linear time. + +This is the base case for building up polynomial-time functions — every function +with finite support (relative to the empty output) is trivially in `FP`, +regardless of how the values `g s` are chosen. + +## Main result + +- `ite_mem_finset_mem_FP` — `fun s => if s ∈ S then g s else []` belongs to `FP` +-/ + +public section + +namespace Complexity + +/-- A function that agrees with the fixedValue empty-output function except on a +finite set `S` — that is, `fun s => if s ∈ S then g s else []` — is computable in +polynomial (indeed linear) time. The finite table of exceptional values is +hard-wired into the lookup machine's states. -/ +theorem ite_mem_finset_mem_FP (g : List Bool → List Bool) (S : Finset (List Bool)) : + (fun s => if s ∈ S then g s else []) ∈ FP := + ite_mem_finset_mem_FP_internal g S + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Classes/P/FinsetDomain/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Classes/P/FinsetDomain/Internal.lean new file mode 100644 index 0000000000..5812eb727c --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Classes/P/FinsetDomain/Internal.lean @@ -0,0 +1,484 @@ +/- +Copyright (c) 2026 Bolton Bailey. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Bolton Bailey +-/ + +module +public import Mathlib.Data.Fintype.Sets +public import Mathlib.Data.Fintype.Option +public import Mathlib.Data.Finset.Lattice.Fold +public import LeanPool.BeyondBethe.Complexitylib.Mathlib.FinsetPrefixes +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.NormalForm +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Tape.Encoding +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators + +/-! +# Finite-domain lookup machine (internal) + +Construction and correctness of a deterministic Turing machine computing a +function of the form `fun s => if s ∈ S then g s else []`, where `S` is a finite +set of "inputs of interest" and `g` an arbitrary target function. Such a +function differs from the fixedValue empty-output function on only finitely many +inputs, so it can be computed by a table lookup that runs in linear time. + +The machine has no work tapes. It works in two phases: + +* **Read phase.** It scans the read-only input tape left to right, tracking in + its finite state the prefix read so far — as long as that prefix is still a + prefix of some element of `S`; otherwise it enters a "dead" state. The output + head bumps off the left marker on the first step and then idles at cell one. +* **Write phase.** On reaching the first input blank it knows exactly which + element of `S` (if any) the input was, hence which fixed output string to + produce. It writes that string onto the output tape, one symbol per step, + landing on the halting configuration. + +Since the read phase takes `|x|` steps and the write phase is bounded by the +longest possible output, the runtime is linear. + +The public statement (`ite_mem_finset_mem_FP`) lives in +`Complexitylib.Classes.P.FinsetDomain`. +-/ + +public section + +namespace Complexity + +namespace TM.FinsetDomain + +variable (g : List Bool → List Bool) (S : Finset (List Bool)) + +/-! ## Output finset + +The read phase tracks membership in `S.prefixes` and the write phase tracks +membership in `(outputsFinset g S).suffixes`; both finsets come from the +generic `Finset.prefixes`/`Finset.suffixes` API. -/ + +/-- The possible output strings: `g s` for `s ∈ S`, together with `[]`. -/ +def outputsFinset (g : List Bool → List Bool) (S : Finset (List Bool)) : + Finset (List Bool) := + insert [] (S.image g) + +theorem nil_mem_suffixes_outputsFinset : + ([] : List Bool) ∈ (outputsFinset g S).suffixes := + Finset.nil_mem_suffixes ⟨[], Finset.mem_insert_self _ _⟩ + +theorem output_mem_suffixes_outputsFinset {input : List Bool} : + (if input ∈ S then g input else ([] : List Bool)) ∈ (outputsFinset g S).suffixes := by + refine Finset.mem_suffixes_self ?_ + unfold outputsFinset + split + · exact Finset.mem_insert_of_mem (Finset.mem_image_of_mem g ‹_›) + · exact Finset.mem_insert_self _ _ + +/-! ## The lookup machine -/ + +instance : Fintype {p : List Bool // p ∈ S.prefixes} := Finset.Subtype.fintype _ +instance : Fintype {w : List Bool // w ∈ (outputsFinset g S).suffixes} := + Finset.Subtype.fintype _ + +/-- States of the lookup machine. -/ +inductive LookupState (g : List Bool → List Bool) (S : Finset (List Bool)) : Type where + /-- Read phase: the viable prefix consumed so far, carried together with the + proof that it is a prefix of some element of `S`, so that the transition + function can use the proof directly. -/ + | read (p : List Bool) (hp : p ∈ S.prefixes) : LookupState g S + /-- Read phase, dead state: the input read so far has diverged from every + element of `S`. -/ + | dead : LookupState g S + /-- Write phase: the output suffix still to be written. -/ + | write (w : List Bool) (hw : w ∈ (outputsFinset g S).suffixes) : LookupState g S + /-- The halt state. -/ + | halt : LookupState g S + +/-- `LookupState` as a sum of two finite subtypes and two extra states. This +equivalence supplies the `DecidableEq` and `Fintype` instances, which cannot be +derived because the `read`/`write` constructors have dependent fields. -/ +def lookupStateEquiv : + LookupState g S ≃ + (Option {p : List Bool // p ∈ S.prefixes} ⊕ + Option {w : List Bool // w ∈ (outputsFinset g S).suffixes}) where + toFun + | .read p hp => .inl (some ⟨p, hp⟩) + | .dead => .inl none + | .write w hw => .inr (some ⟨w, hw⟩) + | .halt => .inr none + invFun + | .inl (some ⟨p, hp⟩) => .read p hp + | .inl none => .dead + | .inr (some ⟨w, hw⟩) => .write w hw + | .inr none => .halt + left_inv s := by cases s <;> rfl + right_inv s := by rcases s with (_ | ⟨p, hp⟩) | (_ | ⟨w, hw⟩) <;> rfl + +instance : DecidableEq (LookupState g S) := (lookupStateEquiv g S).decidableEq +instance : Fintype (LookupState g S) := Fintype.ofEquiv _ (lookupStateEquiv g S).symm + +/-- The read-phase state after consuming prefix `p`: the viable prefix `p` if it +is still a prefix of some element of `S`, otherwise the dead state. -/ +def readState (p : List Bool) : LookupState g S := + if h : p ∈ S.prefixes then .read p h else .dead + +/-- The write-phase state carrying output suffix `c`. -/ +def writeState (c : List Bool) (hc : c ∈ (outputsFinset g S).suffixes) : LookupState g S := + .write c hc + +/-- The halt state. -/ +def haltState : LookupState g S := .halt + +theorem readState_ne_haltState (p : List Bool) : readState g S p ≠ haltState g S := by + rw [readState, haltState] + split <;> simp + +/-- The lookup machine for `g` and `S`. See the module docstring for the +construction. It has no work tapes. -/ +def lookupTM : TM 0 where + Q := LookupState g S + qstart := readState g S [] + qhalt := haltState g S + δ := fun state iHead wHeads oHead => + match state with + | .read p hp => + match iHead with + | Γ.blank => + -- end of input: hand off to the write phase + (writeState g S (if p ∈ S then g p else []) + (output_mem_suffixes_outputsFinset g S), + fun i => readBackWrite (wHeads i), readBackWrite oHead, + idleDir iHead, fun i => idleDir (wHeads i), idleDir oHead) + | Γ.start => + -- skip the left-end marker: move input right, keep the state + (.read p hp, + fun i => readBackWrite (wHeads i), readBackWrite oHead, + Dir3.right, fun i => idleDir (wHeads i), idleDir oHead) + | Γ.zero => + (readState g S (p ++ [false]), + fun i => readBackWrite (wHeads i), readBackWrite oHead, + Dir3.right, fun i => idleDir (wHeads i), idleDir oHead) + | Γ.one => + (readState g S (p ++ [true]), + fun i => readBackWrite (wHeads i), readBackWrite oHead, + Dir3.right, fun i => idleDir (wHeads i), idleDir oHead) + | .dead => + match iHead with + | Γ.blank => + -- end of input: no element of `S` matched, write the empty output + (writeState g S [] (nil_mem_suffixes_outputsFinset g S), + fun i => readBackWrite (wHeads i), readBackWrite oHead, + idleDir iHead, fun i => idleDir (wHeads i), idleDir oHead) + | Γ.start => + (.dead, + fun i => readBackWrite (wHeads i), readBackWrite oHead, + Dir3.right, fun i => idleDir (wHeads i), idleDir oHead) + | Γ.zero => + (.dead, + fun i => readBackWrite (wHeads i), readBackWrite oHead, + Dir3.right, fun i => idleDir (wHeads i), idleDir oHead) + | Γ.one => + (.dead, + fun i => readBackWrite (wHeads i), readBackWrite oHead, + Dir3.right, fun i => idleDir (wHeads i), idleDir oHead) + | .write [] _ => + (haltState g S, + fun i => readBackWrite (wHeads i), readBackWrite oHead, + idleDir iHead, fun i => idleDir (wHeads i), idleDir oHead) + | .write (a :: rest) hw => + (writeState g S rest (Finset.mem_suffixes_of_suffix (List.suffix_cons a rest) hw), + fun i => readBackWrite (wHeads i), Γw.ofBool a, + idleDir iHead, fun i => idleDir (wHeads i), Dir3.right) + | .halt => + (haltState g S, + fun i => readBackWrite (wHeads i), readBackWrite oHead, + idleDir iHead, fun i => idleDir (wHeads i), idleDir oHead) + δ_right_of_start := by + intro state iHead wHeads oHead + match state with + | .read p hp => + match iHead with + | Γ.blank => + exact ⟨fun h => absurd h (by decide), fun _ => idleDir_right_of_start, + idleDir_right_of_start⟩ + | Γ.start => + exact ⟨fun _ => rfl, fun _ => idleDir_right_of_start, idleDir_right_of_start⟩ + | Γ.zero => + exact ⟨fun h => absurd h (by decide), fun _ => idleDir_right_of_start, + idleDir_right_of_start⟩ + | Γ.one => + exact ⟨fun h => absurd h (by decide), fun _ => idleDir_right_of_start, + idleDir_right_of_start⟩ + | .dead => + match iHead with + | Γ.blank => + exact ⟨fun h => absurd h (by decide), fun _ => idleDir_right_of_start, + idleDir_right_of_start⟩ + | Γ.start => + exact ⟨fun _ => rfl, fun _ => idleDir_right_of_start, idleDir_right_of_start⟩ + | Γ.zero => + exact ⟨fun h => absurd h (by decide), fun _ => idleDir_right_of_start, + idleDir_right_of_start⟩ + | Γ.one => + exact ⟨fun h => absurd h (by decide), fun _ => idleDir_right_of_start, + idleDir_right_of_start⟩ + | .write [] _ => + exact ⟨idleDir_right_of_start, fun _ => idleDir_right_of_start, + idleDir_right_of_start⟩ + | .write (a :: rest) hw => + exact ⟨idleDir_right_of_start, fun _ => idleDir_right_of_start, fun _ => rfl⟩ + | .halt => + exact ⟨idleDir_right_of_start, fun _ => idleDir_right_of_start, + idleDir_right_of_start⟩ + +/-! ## Correctness -/ + +/-- Reading a Boolean symbol in the read phase advances the tracked prefix and +moves the input head right. -/ +private theorem lookup_read_bit_step (p : List Bool) (b : Bool) + (c : Cfg 0 (lookupTM g S).Q) + (hstate : c.state = readState g S p) + (hread : c.input.read = Γ.ofBool b) : + (lookupTM g S).step c = some + { state := readState g S (p ++ [b]) + input := c.input.move Dir3.right + work := fun i => (c.work i).writeAndMove (readBackWrite (c.work i).read) + (idleDir (c.work i).read) + output := c.output.writeAndMove (readBackWrite c.output.read) + (idleDir c.output.read) } := by + have hne : c.state ≠ (lookupTM g S).qhalt := by + rw [hstate]; exact readState_ne_haltState g S p + by_cases hp : p ∈ S.prefixes + · cases b <;> + simp [TM.step, lookupTM, hstate, hread, readState, haltState, dif_pos hp, Γ.ofBool] + · have hp' : p ++ [b] ∉ S.prefixes := fun h => + hp (Finset.mem_prefixes_of_prefix (List.prefix_append p [b]) h) + cases b <;> + simp [TM.step, lookupTM, hstate, hread, readState, haltState, dif_neg hp, dif_neg hp', + Γ.ofBool] + +/-- Writing back the (blank) symbol under an idle output head keeps the output +tape an empty binary prefix. -/ +private theorem hasBinaryPrefix_idle {t : Tape} {bits : List Bool} + (h : t.HasBinaryPrefix bits) : + (t.writeAndMove (readBackWrite t.read) (idleDir t.read)).HasBinaryPrefix bits := by + have hread : t.read = Γ.blank := h.read_blank + have hne : t.read ≠ Γ.start := by rw [hread]; decide + rw [writeAndMove_readBack t hne] + have hstay : idleDir t.read = Dir3.stay := by rw [hread]; rfl + rw [hstay] + exact h + +/-- The read phase: from a config tracking prefix `x.take k` with the input head +at `k + 1`, the machine consumes the remaining input in `|x| - k` steps, reaching +the state that tracks the full input `x`. -/ +private theorem lookup_read_loop (x : List Bool) : + ∀ rem k (c : Cfg 0 (lookupTM g S).Q), + rem = x.length - k → + c.state = readState g S (x.take k) → + c.input.cells = (Tape.init (x.map Γ.ofBool)).cells → + c.input.head = k + 1 → + c.output.HasBinaryPrefix [] → + k ≤ x.length → + ∃ c', + (lookupTM g S).reachesIn rem c c' ∧ + c'.state = readState g S x ∧ + c'.input.cells = (Tape.init (x.map Γ.ofBool)).cells ∧ + c'.input.head = x.length + 1 ∧ + c'.output.HasBinaryPrefix [] := by + intro rem + induction rem with + | zero => + intro k c hrem hstate hcells hhead houtput hk + have hk_eq : k = x.length := by omega + subst hk_eq + rw [List.take_length] at hstate + exact ⟨c, .zero, hstate, hcells, hhead, houtput⟩ + | succ rem ih => + intro k c hrem hstate hcells hhead houtput hk + have hk_lt : k < x.length := by omega + have hread : c.input.read = Γ.ofBool (x[k]'hk_lt) := by + simp [Tape.read, hhead, hcells, Tape.init_ofBool_cells_lt x k hk_lt] + have hstep := lookup_read_bit_step g S (x.take k) (x[k]'hk_lt) c hstate hread + set c1 : Cfg 0 (lookupTM g S).Q := + { state := readState g S (x.take k ++ [x[k]'hk_lt]) + input := c.input.move Dir3.right + work := fun i => (c.work i).writeAndMove (readBackWrite (c.work i).read) + (idleDir (c.work i).read) + output := c.output.writeAndMove (readBackWrite c.output.read) + (idleDir c.output.read) } with hc1 + have htake : x.take k ++ [x[k]'hk_lt] = x.take (k + 1) := List.take_concat_get' x k hk_lt + have hstate1 : c1.state = readState g S (x.take (k + 1)) := by rw [hc1, htake] + have hcells1 : c1.input.cells = (Tape.init (x.map Γ.ofBool)).cells := by + simp [hc1, Tape.move_cells, hcells] + have hhead1 : c1.input.head = k + 1 + 1 := by simp [hc1, Tape.move, hhead] + have houtput1 : c1.output.HasBinaryPrefix [] := hasBinaryPrefix_idle houtput + obtain ⟨c', hreach, hstate', hcells', hhead', houtput'⟩ := + ih (k + 1) c1 (by omega) hstate1 hcells1 hhead1 houtput1 (by omega) + exact ⟨c', .step hstep hreach, hstate', hcells', hhead', houtput'⟩ + +/-- The first step skips the left-end markers: the input head advances to cell +one over the input contents and the output head bumps off its marker. -/ +private theorem lookup_initial_step (x : List Bool) : + ∃ c0, (lookupTM g S).step ((lookupTM g S).initCfg x) = some c0 ∧ + c0.state = readState g S [] ∧ + c0.input.cells = (Tape.init (x.map Γ.ofBool)).cells ∧ + c0.input.head = 1 ∧ + c0.output.HasBinaryPrefix [] := by + set c0 : Cfg 0 (lookupTM g S).Q := + { state := readState g S [] + input := (Tape.init (x.map Γ.ofBool)).move Dir3.right + work := fun _ => (Tape.init []).move Dir3.right + output := (Tape.init ([] : List Γ)).move Dir3.right } with hc0 + have hg : ((lookupTM g S).initCfg x).state ≠ (lookupTM g S).qhalt := + readState_ne_haltState g S [] + have hstep : (lookupTM g S).step ((lookupTM g S).initCfg x) = some c0 := by + by_cases h : ([] : List Bool) ∈ S.prefixes + · simp only [TM.step, hc0, lookupTM, readState, dif_pos h] + exact congrArg some (Cfg.ext rfl rfl (Subsingleton.elim _ _) rfl) + · simp only [TM.step, hc0, lookupTM, readState, dif_neg h] + exact congrArg some (Cfg.ext rfl rfl (Subsingleton.elim _ _) rfl) + refine ⟨c0, hstep, rfl, ?_, ?_, ?_⟩ + · rw [hc0]; simp [Tape.move_cells] + · rw [hc0]; simp [Tape.move] + · rw [hc0]; exact Tape.init_nil_move_right_hasBinaryPrefix_nil + +/-- The handoff step from read phase to write phase: on reaching the input blank +the machine commits to writing the fixed output `if inp ∈ S then g inp else []`. -/ +private theorem lookup_handoff_step (inp : List Bool) (c : Cfg 0 (lookupTM g S).Q) + (hstate : c.state = readState g S inp) + (hread : c.input.read = Γ.blank) + (houtput : c.output.HasBinaryPrefix []) : + ∃ c', (lookupTM g S).step c = some c' ∧ + c'.state = writeState g S (if inp ∈ S then g inp else []) + (output_mem_suffixes_outputsFinset g S) ∧ + c'.output.HasBinaryPrefix [] := by + set c1 : Cfg 0 (lookupTM g S).Q := + { state := writeState g S (if inp ∈ S then g inp else []) + (output_mem_suffixes_outputsFinset g S) + input := c.input.move (idleDir c.input.read) + work := fun i => (c.work i).writeAndMove (readBackWrite (c.work i).read) + (idleDir (c.work i).read) + output := c.output.writeAndMove (readBackWrite c.output.read) + (idleDir c.output.read) } with hc1 + have hstep : (lookupTM g S).step c = some c1 := by + by_cases hp : inp ∈ S.prefixes + · simp [TM.step, lookupTM, hstate, hread, readState, writeState, haltState, dif_pos hp, hc1] + · have hpS : inp ∉ S := fun h => hp (Finset.mem_prefixes_self h) + simp [TM.step, lookupTM, hstate, hread, readState, writeState, haltState, dif_neg hp, + if_neg hpS, hc1] + refine ⟨c1, hstep, by rw [hc1], ?_⟩ + rw [hc1] + exact hasBinaryPrefix_idle houtput + +/-- Writing one output symbol in the write phase extends the written prefix and +advances to the remaining suffix. -/ +private theorem lookup_write_cons_step (a : Bool) (rest : List Bool) + (hw : a :: rest ∈ (outputsFinset g S).suffixes) (c : Cfg 0 (lookupTM g S).Q) + (hstate : c.state = writeState g S (a :: rest) hw) : + (lookupTM g S).step c = some + { state := writeState g S rest (Finset.mem_suffixes_of_suffix (List.suffix_cons a rest) hw) + input := c.input.move (idleDir c.input.read) + work := fun i => (c.work i).writeAndMove (readBackWrite (c.work i).read) + (idleDir (c.work i).read) + output := c.output.writeAndMove (Γ.ofBool a) Dir3.right } := by + cases a <;> simp [TM.step, lookupTM, hstate, writeState, haltState, Γ.ofBool, Γw.ofBool] + +/-- The write phase: from a config whose output already holds `written` and whose +state carries the remaining suffix `w`, the machine writes `w` and halts, in +`|w| + 1` steps, leaving `written ++ w` on the output tape. -/ +private theorem lookup_write_loop (written : List Bool) : + ∀ (w : List Bool) (hw : w ∈ (outputsFinset g S).suffixes) (c : Cfg 0 (lookupTM g S).Q), + c.state = writeState g S w hw → + c.output.HasBinaryPrefix written → + ∃ c', + (lookupTM g S).reachesIn (w.length + 1) c c' ∧ + (lookupTM g S).halted c' ∧ + c'.output.HasBinaryPrefix (written ++ w) := by + intro w + induction w generalizing written with + | nil => + intro hw c hstate houtput + have hne : c.state ≠ (lookupTM g S).qhalt := by + rw [hstate, writeState]; simp [lookupTM, haltState] + set c1 : Cfg 0 (lookupTM g S).Q := + { state := haltState g S + input := c.input.move (idleDir c.input.read) + work := fun i => (c.work i).writeAndMove (readBackWrite (c.work i).read) + (idleDir (c.work i).read) + output := c.output.writeAndMove (readBackWrite c.output.read) + (idleDir c.output.read) } with hc1 + have hstep : (lookupTM g S).step c = some c1 := by + simp [TM.step, lookupTM, hstate, writeState, haltState, hc1] + refine ⟨c1, .step hstep .zero, ?_, ?_⟩ + · show c1.state = (lookupTM g S).qhalt + rw [hc1]; rfl + · rw [List.append_nil, hc1] + exact hasBinaryPrefix_idle houtput + | cons a rest ih => + intro hw c hstate houtput + have hstep := lookup_write_cons_step g S a rest hw c hstate + set c1 : Cfg 0 (lookupTM g S).Q := + { state := writeState g S rest (Finset.mem_suffixes_of_suffix (List.suffix_cons a rest) hw) + input := c.input.move (idleDir c.input.read) + work := fun i => (c.work i).writeAndMove (readBackWrite (c.work i).read) + (idleDir (c.work i).read) + output := c.output.writeAndMove (Γ.ofBool a) Dir3.right } with hc1 + have hout1 : c1.output.HasBinaryPrefix (written ++ [a]) := by + rw [hc1]; exact Tape.hasBinaryPrefix_write_bit a houtput + obtain ⟨c', hreach, hhalt, hout'⟩ := + ih (written ++ [a]) (Finset.mem_suffixes_of_suffix (List.suffix_cons a rest) hw) c1 rfl hout1 + refine ⟨c', ?_, hhalt, ?_⟩ + · have : rest.length + 1 + 1 = (a :: rest).length + 1 := by simp [List.length_cons] + rw [← this] + exact .step hstep hreach + · rwa [List.append_assoc, List.singleton_append] at hout' + +/-- The lookup machine computes `fun s => if s ∈ S then g s else []` within a +linear time bound. -/ +theorem lookupTM_computesInTime : + (lookupTM g S).ComputesInTime (fun s => if s ∈ S then g s else []) + (fun m => m + (S.sup fun s => (g s).length) + 3) := by + intro x + obtain ⟨c0, hstep0, hst0, hcells0, hhead0, hout0⟩ := lookup_initial_step g S x + obtain ⟨c1, hreadloop, hst1, hcells1, hhead1, hout1⟩ := + lookup_read_loop g S x x.length 0 c0 (by omega) hst0 hcells0 hhead0 hout0 (Nat.zero_le _) + have hread1_blank : c1.input.read = Γ.blank := by + rw [Tape.read, hhead1, hcells1, Tape.init_ofBool_cells_ge x x.length le_rfl] + obtain ⟨c2, hstep2, hst2, hout2⟩ := lookup_handoff_step g S x c1 hst1 hread1_blank hout1 + set cval : List Bool := if x ∈ S then g x else [] with hcval + obtain ⟨c3, hwriteloop, hhalt3, hout3⟩ := + lookup_write_loop g S [] cval (output_mem_suffixes_outputsFinset g S) c2 hst2 hout2 + have hlen : cval.length ≤ S.sup fun s => (g s).length := by + rw [hcval] + split + · exact Finset.le_sup (f := fun s => (g s).length) ‹x ∈ S› + · exact Nat.zero_le _ + refine ⟨c3, x.length + cval.length + 3, by dsimp only; omega, ?_, hhalt3, ?_⟩ + · have hreach := + reachesIn.step hstep0 + (reachesIn_trans (lookupTM g S) hreadloop + (reachesIn.step hstep2 hwriteloop)) + have heq : x.length + (cval.length + 1 + 1) + 1 = x.length + cval.length + 3 := by omega + rwa [heq] at hreach + · have hres : c3.output.HasOutput cval := by + have h := hout3 + rw [List.nil_append] at h + exact h.hasOutput + exact hres + +end TM.FinsetDomain + +open Polynomial in +/-- Internal proof that a function supported on a finite set belongs to `FP`: +the lookup machine's linear time bound is packaged as a degree-one polynomial. -/ +theorem ite_mem_finset_mem_FP_internal (g : List Bool → List Bool) (S : Finset (List Bool)) : + (fun s => if s ∈ S then g s else []) ∈ FP := by + rw [mem_FP_iff_computesInTime_polynomial] + refine ⟨0, TM.FinsetDomain.lookupTM g S, X + C ((S.sup fun s => (g s).length) + 3), ?_⟩ + have heval : (X + C ((S.sup fun s => (g s).length) + 3)).eval + = fun m : ℕ => m + (S.sup fun s => (g s).length) + 3 := by + funext m + simp only [eval_add, eval_X, eval_C] + omega + rw [heval] + exact TM.FinsetDomain.lookupTM_computesInTime g S + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Internal.lean new file mode 100644 index 0000000000..ab7438f998 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Internal.lean @@ -0,0 +1,121 @@ +/- +Copyright (c) 2025 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators +public import LeanPool.BeyondBethe.Complexitylib.Asymptotics +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.Internal.Retarget +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.Internal.Union + +/-! +# P closure properties — proof internals + +This file contains the proof helpers used by `DTIME_union` (stated in `P.lean`). +The key simulation theorem `unionTM_decidesInTime` establishes that the +composite machine from `TM.unionTM` correctly decides `L₁ ∪ L₂`. +-/ + + +public section + +namespace Complexity + +open Complexity Asymptotics Filter + +variable {n₁ n₂ : ℕ} + +namespace TM + +-- ════════════════════════════════════════════════════════════════════════ +-- Core simulation theorem +-- ════════════════════════════════════════════════════════════════════════ + +/-- The union TM correctly decides `L₁ ∪ L₂` with time bound `10·f₁ + f₂`. + + The factor 10 arises from Phase 1 (f₁ steps), transition (≤ 2·f₁ + 7 steps + absorbed into 9·f₁ since f₁ ≥ 1), and Phase 2 (f₂ steps). -/ +theorem unionTM_decidesInTime {tm₁ : TM n₁} {tm₂ : TM n₂} + {L₁ L₂ : Language} {f₁ f₂ : ℕ → ℕ} + (h₁ : tm₁.DecidesInTime L₁ f₁) (h₂ : tm₂.DecidesInTime L₂ f₂) : + (unionTM tm₁ tm₂).DecidesInTime (L₁ ∪ L₂) (fun n => 10 * f₁ n + f₂ n) := by + have hne₁ := qstart_ne_qhalt_of_decidesInTime _ h₁ + have hne₂ := qstart_ne_qhalt_of_decidesInTime _ h₂ + intro x + obtain ⟨c₁, t₁, ht₁, hreach₁, hhalt₁, hmem₁, hnmem₁⟩ := h₁ x + obtain ⟨c₂, t₂, ht₂, hreach₂, hhalt₂, hmem₂, hnmem₂⟩ := h₂ x + -- t₁ ≥ 1 since qstart ≠ qhalt (halting at step 0 means qstart = qhalt) + have ht₁_pos : t₁ ≥ 1 := by + rcases t₁ with _ | t₁ + · cases hreach₁; exact absurd hhalt₁ hne₁ + · omega + have ht₂_pos : t₂ ≥ 1 := by + rcases t₂ with _ | t₂ + · cases hreach₂; exact absurd hhalt₂ hne₂ + · omega + -- Head bounds: tape heads are ≤ t₁ after Phase 1 + have hbounds := head_le_of_reachesIn tm₁ hreach₁ + -- Phase 1: union machine simulates tm₁ for t₁ steps + have hphase1 := unionTM_phase1_simulation tm₁ tm₂ x hreach₁ ht₁_pos + -- Case split on whether tm₁ accepted + by_cases hx₁ : x ∈ L₁ + · -- tm₁ accepted: output cell 1 = Γ.one + have hcell := hmem₁ hx₁ + -- Derive output tape invariants from reachesIn + have hcell0_out := output_cells_zero_eq_start_of_reachesIn hreach₁ (Tape.init_cells_zero _) + have hnostart_out := output_cells_ne_start_of_reachesIn hreach₁ + (fun i hi => Tape.init_nil_cells_ne_start i hi) + -- Transition: rewind fake output, check, write Γ.one to real output, halt + obtain ⟨t_tr, c_final, htrans, hhalt_f, hout_f, htr_bound⟩ := + unionTM_transition_accept tm₁ tm₂ hhalt₁ hcell hcell0_out hnostart_out + -- Combine Phase 1 + transition + have hoh := hbounds.2.1 -- c₁.output.head ≤ t₁ + refine ⟨c_final, t₁ + t_tr, ?_, reachesIn_trans _ hphase1 htrans, hhalt_f, ?_, ?_⟩ + · show t₁ + t_tr ≤ 10 * f₁ x.length + f₂ x.length; omega + · exact fun _ => hout_f + · intro hx; exfalso; exact hx (Or.inl hx₁) + · -- tm₁ rejected: output cell 1 = Γ.zero + have hcell := hnmem₁ hx₁ + -- Derive output tape and input tape invariants from reachesIn + have hcell0_out := output_cells_zero_eq_start_of_reachesIn hreach₁ (Tape.init_cells_zero _) + have hnostart_out := output_cells_ne_start_of_reachesIn hreach₁ + (fun i hi => Tape.init_nil_cells_ne_start i hi) + have hinput_cells := input_cells_eq_of_reachesIn hreach₁ + -- Transition: full transition to Phase 2 + obtain ⟨t_tr, c_mid, htrans, hmid_state, hmid_input, hmid_work, hmid_output, htr_bound⟩ := + unionTM_transition_reject tm₁ tm₂ x hhalt₁ hcell hcell0_out hnostart_out hinput_cells + -- Phase 2: union machine simulates tm₂ for t₂ steps + obtain ⟨c_end, hphase2, hend_state, hend_output⟩ := + unionTM_phase2_simulation tm₁ tm₂ x hreach₂ hmid_state hmid_input hmid_work hmid_output + -- Combine Phase 1 + transition + Phase 2 + have hfull := reachesIn_trans _ (reachesIn_trans _ hphase1 htrans) hphase2 + -- The final config is halted + have hfinal_halted : (unionTM tm₁ tm₂).halted c_end := by + show c_end.state = Sum.inr (Sum.inr tm₂.qhalt) + rw [hend_state, hhalt₂] + have hih := hbounds.1 -- c₁.input.head ≤ t₁ + have hoh := hbounds.2.1 -- c₁.output.head ≤ t₁ + refine ⟨c_end, t₁ + t_tr + t₂, ?_, hfull, hfinal_halted, ?_, ?_⟩ + · show t₁ + t_tr + t₂ ≤ 10 * f₁ x.length + f₂ x.length; omega + · intro hx; rw [hend_output]; cases hx with + | inl h => exact absurd h hx₁ + | inr h => exact hmem₂ h + · intro hx; rw [hend_output] + have : x ∉ L₂ := fun h => hx (Set.mem_union_right _ h) + exact hnmem₂ this + +end TM + +-- ════════════════════════════════════════════════════════════════════════ +-- BigO arithmetic: 10·f₁ + f₂ =O (T₁ + T₂) +-- ════════════════════════════════════════════════════════════════════════ + +/-- If `f₁ =O T₁` and `f₂ =O T₂`, then `10·f₁ + f₂ =O (T₁ + T₂)`. -/ +theorem bigO_union_bound {f₁ f₂ T₁ T₂ : ℕ → ℕ} + (ho₁ : f₁ =O T₁) (ho₂ : f₂ =O T₂) : + (fun n => 10 * f₁ n + f₂ n) =O (fun n => T₁ n + T₂ n) := + BigO.const_mul_add 10 ho₁ ho₂ + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Internal/Composition.lean b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Internal/Composition.lean new file mode 100644 index 0000000000..2f7998fb21 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Internal/Composition.lean @@ -0,0 +1,40 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Asymptotics.PolynomialComposition +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Internal.NormalForm +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Composition + +/-! +# Closure of FP under composition — proof internals + +This module combines the sequential machine construction with polynomial +normal forms for its two component computations. The public theorem is in +`Complexitylib.Classes.P.Composition`. +-/ + + +public section + +namespace Complexity + +/-- Internal proof that polynomial-time string functions are closed under +function composition. -/ +theorem mem_FP_comp_internal {f g : List Bool → List Bool} + (hf : f ∈ FP) (hg : g ∈ FP) : (g ∘ f) ∈ FP := by + obtain ⟨nf, tmF, p, hfComp⟩ := + mem_FP_iff_computesInTime_polynomial_internal.mp hf + obtain ⟨ng, tmG, q, hgComp⟩ := + mem_FP_iff_computesInTime_polynomial_internal.mp hg + refine ⟨(Polynomial.C 4 * p + Polynomial.C 11 + q.comp p).natDegree, + TM.compositionTapeCount nf ng, TM.compositionTM tmF tmG, + (fun n => 4 * p.eval n + 11 + q.eval (p.eval n)), ?_, ?_⟩ + · exact TM.compositionTM_computesInTime hfComp hgComp + (polynomial_eval_mono_nat q) + · exact BigO.polynomial_composition_time p q + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Internal/NormalForm.lean b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Internal/NormalForm.lean new file mode 100644 index 0000000000..e90cdd1155 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Internal/NormalForm.lean @@ -0,0 +1,54 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Defs + +/-! +# Polynomial-time normal forms — proof internals + +The definitions of `P` and `FP` permit arbitrary time functions with Big-O +power bounds. This module replaces either witness by the evaluation of one +polynomial over the naturals, giving everywhere-valid monotone time bounds. + +The public theorem is in `Complexitylib.Classes.P.NormalForm`. +-/ + + +public section + +namespace Complexity + +/-- Internal proof that `P` membership is equivalent to decision within the +evaluation of a natural-coefficient polynomial. -/ +theorem mem_P_iff_decidesInTime_polynomial_internal {L : Language} : + L ∈ P ↔ ∃ (k : ℕ) (tm : TM k) (p : Polynomial ℕ), + tm.DecidesInTime L p.eval := by + constructor + · intro hL + obtain ⟨d, k, tm, T, hdec, hbig⟩ := Set.mem_iUnion.mp hL + obtain ⟨p, hp⟩ := BigO.pow_polynomial_bound hbig + exact ⟨k, tm, p, hdec.mono hp⟩ + · rintro ⟨k, tm, p, hdec⟩ + apply Set.mem_iUnion.mpr + refine ⟨p.natDegree, k, tm, p.eval, hdec, ?_⟩ + exact BigO.of_polynomial_bound p fun _ => le_rfl + +/-- Internal proof that `FP` membership is equivalent to computation within +the evaluation of a natural-coefficient polynomial. -/ +theorem mem_FP_iff_computesInTime_polynomial_internal + {f : List Bool → List Bool} : + f ∈ FP ↔ ∃ (k : ℕ) (tm : TM k) (p : Polynomial ℕ), + tm.ComputesInTime f p.eval := by + constructor + · rintro ⟨d, k, tm, T, hcomp, hbig⟩ + obtain ⟨p, hp⟩ := BigO.pow_polynomial_bound hbig + exact ⟨k, tm, p, hcomp.mono hp⟩ + · rintro ⟨k, tm, p, hcomp⟩ + refine ⟨p.natDegree, k, tm, p.eval, hcomp, ?_⟩ + exact BigO.of_polynomial_bound p fun _ => le_rfl + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Internal/Preimage.lean b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Internal/Preimage.lean new file mode 100644 index 0000000000..3f1a6df4a1 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Internal/Preimage.lean @@ -0,0 +1,39 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Internal.NormalForm +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Composition + +/-! +# Closure of P under FP preimages — proof internals + +The preprocessing function and target decider are first normalized to +natural-polynomial time bounds. Their executable sequential composition then +decides the preimage language within the polynomial obtained by composing +those bounds. +-/ + + +public section + +namespace Complexity + +/-- Internal proof that polynomial-time languages are closed under preimages +of polynomial-time string functions. -/ +theorem mem_P_preimage_internal {f : List Bool → List Bool} {L : Language} + (hf : f ∈ FP) (hL : L ∈ P) : f ⁻¹' L ∈ P := by + obtain ⟨nf, tmF, p, hF⟩ := + mem_FP_iff_computesInTime_polynomial_internal.mp hf + obtain ⟨ng, tmG, q, hG⟩ := + mem_P_iff_decidesInTime_polynomial_internal.mp hL + let r := Polynomial.C 4 * p + Polynomial.C 11 + q.comp p + apply mem_P_iff_decidesInTime_polynomial_internal.mpr + refine ⟨TM.compositionTapeCount nf ng, TM.compositionTM tmF tmG, r, ?_⟩ + simpa [r, Polynomial.eval_comp] using + TM.compositionTM_decidesInTime hF hG (polynomial_eval_mono_nat q) + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Classes/P/NormalForm.lean b/LeanPool/BeyondBethe/Complexitylib/Classes/P/NormalForm.lean new file mode 100644 index 0000000000..6495056485 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Classes/P/NormalForm.lean @@ -0,0 +1,43 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Internal.NormalForm + +/-! +# Polynomial-time normal forms + +`P` and `FP` membership can be witnessed by deterministic machines whose +running-time bounds are evaluations of polynomials with natural coefficients. +Unlike the arbitrary asymptotic witnesses in the class definitions, these +normalized bounds are valid on every input length and are monotone. + +## Main result + +- `mem_P_iff_decidesInTime_polynomial` — polynomial-evaluation normal form for `P` +- `mem_FP_iff_computesInTime_polynomial` — polynomial-evaluation normal form for `FP` +-/ + + +public section + +namespace Complexity + +/-- A language belongs to `P` exactly when some deterministic machine decides +it within the evaluation of a natural-coefficient polynomial. -/ +theorem mem_P_iff_decidesInTime_polynomial {L : Language} : + L ∈ P ↔ ∃ (k : ℕ) (tm : TM k) (p : Polynomial ℕ), + tm.DecidesInTime L p.eval := by + exact mem_P_iff_decidesInTime_polynomial_internal + +/-- A function belongs to `FP` exactly when some deterministic machine +computes it within the evaluation of a natural-coefficient polynomial. -/ +theorem mem_FP_iff_computesInTime_polynomial {f : List Bool → List Bool} : + f ∈ FP ↔ ∃ (k : ℕ) (tm : TM k) (p : Polynomial ℕ), + tm.ComputesInTime f p.eval := by + exact mem_FP_iff_computesInTime_polynomial_internal + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Classes/P/PairWithInput.lean b/LeanPool/BeyondBethe/Complexitylib/Classes/P/PairWithInput.lean new file mode 100644 index 0000000000..c65525ae06 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Classes/P/PairWithInput.lean @@ -0,0 +1,29 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.PairWithInput.Internal + +/-! +# Polynomial-time pairing with the original input + +## Main result + +- `mem_FP_pairWithInput` — if `f ∈ FP`, then `x ↦ pair (f x) x` is in `FP` +-/ + + +public section + +namespace Complexity + +/-- A polynomial-time function can be evaluated and paired with its unchanged +original input in polynomial time. -/ +theorem mem_FP_pairWithInput {f : List Bool → List Bool} + (hf : f ∈ FP) : (fun x => pair (f x) x) ∈ FP := + mem_FP_pairWithInput_internal hf + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Classes/P/PairWithInput/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Classes/P/PairWithInput/Internal.lean new file mode 100644 index 0000000000..47e73dfd24 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Classes/P/PairWithInput/Internal.lean @@ -0,0 +1,32 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Internal.NormalForm +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Composition.PairWithInput + +/-! +# Polynomial-time pairing with the original input — proof internals +-/ + + +public section + +namespace Complexity + +/-- Internal closure of `FP` under `x ↦ pair (f x) x`. -/ +theorem mem_FP_pairWithInput_internal {f : List Bool → List Bool} + (hf : f ∈ FP) : (fun x => pair (f x) x) ∈ FP := by + obtain ⟨k, tm, p, hcomp⟩ := + mem_FP_iff_computesInTime_polynomial_internal.mp hf + let q : Polynomial ℕ := + Polynomial.C 5 * p + Polynomial.X + Polynomial.C 12 + apply mem_FP_iff_computesInTime_polynomial_internal.mpr + refine ⟨TM.pairWithInputTapeCount k, TM.pairWithInputTM tm, q, ?_⟩ + simpa [q, TM.pairWithInputTime] using + TM.pairWithInputTM_computesInTime hcomp + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Preimage.lean b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Preimage.lean new file mode 100644 index 0000000000..a7ebf87996 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Preimage.lean @@ -0,0 +1,29 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Internal.Preimage + +/-! +# Closure of P under FP preimages + +## Main result + +- `mem_P_preimage` — polynomial-time preprocessing preserves membership in `P` +-/ + + +public section + +namespace Complexity + +/-- If `f` is polynomial-time computable and `L` is polynomial-time +decidable, then the preimage language `{x | f x ∈ L}` is in `P`. -/ +theorem mem_P_preimage {f : List Bool → List Bool} {L : Language} + (hf : f ∈ FP) (hL : L ∈ P) : f ⁻¹' L ∈ P := + mem_P_preimage_internal hf hL + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Classes/P/UnaryLength.lean b/LeanPool/BeyondBethe/Complexitylib/Classes/P/UnaryLength.lean new file mode 100644 index 0000000000..1b843c26d1 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Classes/P/UnaryLength.lean @@ -0,0 +1,29 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.UnaryLength.Internal + +/-! +# Polynomial-time unary input length + +## Main result + +- `unaryLength_mem_FP` — `x ↦ 1^|x|` is polynomial-time computable +-/ + + +public section + +namespace Complexity + +/-- Writing one unary mark per input bit is a polynomial-time string +function. -/ +theorem unaryLength_mem_FP : + (fun x : List Bool => List.replicate x.length true) ∈ FP := + unaryLength_mem_FP_internal + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Classes/P/UnaryLength/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Classes/P/UnaryLength/Internal.lean new file mode 100644 index 0000000000..c47d6ff796 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Classes/P/UnaryLength/Internal.lean @@ -0,0 +1,29 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.UnaryLength + +/-! +# Polynomial-time unary input length — proof internals +-/ + + +public section + +namespace Complexity + +/-- Internal proof that materializing unary input length is in `FP`. -/ +theorem unaryLength_mem_FP_internal : + (fun x : List Bool => List.replicate x.length true) ∈ FP := by + refine ⟨1, 0, TM.unaryLengthTM, + (fun n => n + 2), TM.unaryLengthTM_computesInTime 0, ?_⟩ + have hn : (fun n : ℕ => n) =O ((· ^ 1) : ℕ → ℕ) := by + simpa only [pow_one] using BigO.refl (fun n : ℕ => n) + exact BigO.add hn (BigO.const_le_pow 2 1) + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Classes/Pairing.lean b/LeanPool/BeyondBethe/Complexitylib/Classes/Pairing.lean new file mode 100644 index 0000000000..fde80e2c35 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Classes/Pairing.lean @@ -0,0 +1,47 @@ +/- +Copyright (c) 2025 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Encoding.Pairing +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine +public import Mathlib.Algebra.Polynomial.Eval.Defs + +/-! +# Paired relation predicates + +This file adds the complexity-class predicates built on the neutral binary +pairing codec from `Complexitylib.Encoding.Pairing`. +-/ + + +@[expose] public section + +namespace Complexity + +/-- A binary relation is **polynomially balanced** if witness length is bounded +by a polynomial in the input length. This is the standard short-witness +condition used in the definitions of NP, FNP, FNL, and related classes. -/ +def PolyBalanced (R : List Bool → List Bool → Prop) : Prop := + ∃ p : Polynomial ℕ, ∀ x y, R x y → y.length ≤ p.eval x.length + +/-- The pair language of `R` contains exactly the encodings `pair x y` for +which `R x y` holds. -/ +def pairLang (R : List Bool → List Bool → Prop) : Language := + {z | ∃ x y, z = pair x y ∧ R x y} + +/-- Membership of a canonically encoded pair reduces to the underlying +binary relation. -/ +@[simp] theorem mem_pairLang_pair (R : List Bool → List Bool → Prop) + (x y : List Bool) : + pair x y ∈ pairLang R ↔ R x y := by + constructor + · rintro ⟨x', y', hpair, hR⟩ + obtain ⟨hx, hy⟩ := pair_inj hpair + simpa [hx, hy] using hR + · intro hR + exact ⟨x, y, rfl, hR⟩ + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Classes/Randomized.lean b/LeanPool/BeyondBethe/Complexitylib/Classes/Randomized.lean new file mode 100644 index 0000000000..65f1c7b0be --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Classes/Randomized.lean @@ -0,0 +1,111 @@ +/- +Copyright (c) 2025 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Classes.Time + +/-! +# Randomized complexity classes + +This file defines the randomized complexity classes **BPP**, **RP**, **coRP**, +**ZPP**, and **PP**, along with the time-parameterized classes `BPTIME`, +`RTIME`, and `PPTIME`, and the predicate `NTM.IsPPT`. + +A PTM (probabilistic Turing machine) is an NTM where the two transition +functions are selected uniformly at random. Acceptance probability is defined +via `NTM.acceptProb`. + +## Helper predicates + +The acceptance-probability conditions shared across classes are factored into +`NTM.AcceptsWithProb` (lower-bounding acceptance on yes-instances) and +`NTM.RejectsWithProb` (upper-bounding acceptance on no-instances). +-/ + + +@[expose] public section + +namespace Complexity + + +namespace NTM + +variable {n : ℕ} + +/-- The PTM accepts every `x ∈ L` with probability at least `c` within + `T(|x|)` steps. -/ +def AcceptsWithProb (tm : NTM n) (L : Language) (T : ℕ → ℕ) (c : ℚ) : Prop := + ∀ x, x ∈ L → tm.acceptProb x (T x.length) ≥ c + +/-- The PTM accepts every `x ∉ L` with probability at most `s` within + `T(|x|)` steps. -/ +def RejectsWithProb (tm : NTM n) (L : Language) (T : ℕ → ℕ) (s : ℚ) : Prop := + ∀ x, x ∉ L → tm.acceptProb x (T x.length) ≤ s + +/-- An NTM is **probabilistic polynomial-time (PPT)** if there exist a time + bound `f` and degree `d` such that every computation path halts within + `f(|x|)` steps and `f(n) = O(n^d)`. This is the central notion in + cryptographic security definitions. -/ +def IsPPT (tm : NTM n) : Prop := + ∃ (f : ℕ → ℕ) (d : ℕ), tm.AllPathsHaltIn f ∧ f =O (· ^ d) + +end NTM + +/-- `BPTIME(T)` is the class of languages decidable by a PTM in time `O(T(n))` + with two-sided bounded error (accept probability ≥ 2/3 on yes-instances, + ≤ 1/3 on no-instances). -/ +def BPTIME (T : ℕ → ℕ) : Set Language := + {L | ∃ (k : ℕ) (tm : NTM k) (f : ℕ → ℕ), + tm.AllPathsHaltIn f ∧ + tm.AcceptsWithProb L f (2 / 3) ∧ + tm.RejectsWithProb L f (1 / 3) ∧ + f =O T} + +/-- **BPP** is the class of languages decidable by a PTM in polynomial time + with two-sided bounded error: `BPP = ⋃_k BPTIME(n^k)`. -/ +def BPP : Set Language := + ⋃ k : ℕ, BPTIME (· ^ k) + +/-- `RTIME(T)` is the class of languages decidable by a PTM in time `O(T(n))` + with one-sided error: yes-instances accepted with probability ≥ 1/2, + no-instances never accepted (accept probability 0). -/ +def RTIME (T : ℕ → ℕ) : Set Language := + {L | ∃ (k : ℕ) (tm : NTM k) (f : ℕ → ℕ), + tm.AllPathsHaltIn f ∧ + tm.AcceptsWithProb L f (1 / 2) ∧ + tm.RejectsWithProb L f 0 ∧ + f =O T} + +/-- **RP** is the class of languages decidable by a PTM in polynomial time + with one-sided error: `RP = ⋃_k RTIME(n^k)`. -/ +def RP : Set Language := + ⋃ k : ℕ, RTIME (· ^ k) + +/-- **coRP** is the class of languages whose complements are in RP. + Equivalently: yes-instances always accepted (probability 1), no-instances + accepted with probability ≤ 1/2. -/ +def coRP : Set Language := complClass RP + +/-- **ZPP** (zero-error probabilistic polynomial time) is RP ∩ coRP. A language + is in ZPP iff it has a PTM with zero-error expected polynomial running + time. -/ +def ZPP : Set Language := RP ∩ coRP + +/-- `PPTIME(T)` is the class of languages decidable by a PTM in time `O(T(n))` + with unbounded error: `x ∈ L` iff the PTM accepts with probability + strictly greater than 1/2. -/ +def PPTIME (T : ℕ → ℕ) : Set Language := + {L | ∃ (k : ℕ) (tm : NTM k) (f : ℕ → ℕ), + tm.AllPathsHaltIn f ∧ + (∀ x, x ∈ L ↔ tm.acceptProb x (f x.length) > 1 / 2) ∧ + f =O T} + +/-- **PP** (probabilistic polynomial time) is the class of languages decidable + by a PTM in polynomial time with unbounded error: `PP = ⋃_k PPTIME(n^k)`. -/ +def PP : Set Language := + ⋃ k : ℕ, PPTIME (· ^ k) + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Classes/Space.lean b/LeanPool/BeyondBethe/Complexitylib/Classes/Space.lean new file mode 100644 index 0000000000..940f057c8f --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Classes/Space.lean @@ -0,0 +1,42 @@ +/- +Copyright (c) 2025 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine +public import LeanPool.BeyondBethe.Complexitylib.Asymptotics + +/-! +# Base space complexity classes + +This file defines the parametric space complexity classes `DSPACE(S)` and +`NSPACE(S)`, the building blocks from which polynomial and log-space classes +are derived. + +Work-tape head positions are bounded directly. The finite input region and its +first trailing blank are free, while farther input-head travel is charged. The +output verdict cell is free, while farther two-way output-head travel is also +charged. This prevents either infinite named tape from becoming hidden workspace. +-/ + + +@[expose] public section + +namespace Complexity + + +/-- `DSPACE(S)` is the class of languages decidable by a deterministic TM using + `O(S(n))` auxiliary space under `Cfg.WithinDecisionSpace`. -/ +def DSPACE (S : ℕ → ℕ) : Set Language := + {L | ∃ (k : ℕ) (tm : TM k) (f : ℕ → ℕ), + tm.DecidesInSpace L f ∧ f =O S} + +/-- `NSPACE(S)` is the class of languages decidable by a nondeterministic TM + using `O(S(n))` auxiliary space under `Cfg.WithinDecisionSpace`. -/ +def NSPACE (S : ℕ → ℕ) : Set Language := + {L | ∃ (k : ℕ) (tm : NTM k) (f : ℕ → ℕ), + tm.DecidesInSpace L f ∧ f =O S} + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Classes/Time.lean b/LeanPool/BeyondBethe/Complexitylib/Classes/Time.lean new file mode 100644 index 0000000000..bb5ee8fc95 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Classes/Time.lean @@ -0,0 +1,55 @@ +/- +Copyright (c) 2025 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine +public import LeanPool.BeyondBethe.Complexitylib.Asymptotics + +/-! +# Base time complexity classes + +This file defines the parametric time complexity classes `DTIME(T)` and +`NTIME(T)`, the building blocks from which polynomial, exponential, and +randomized time classes are derived. + +Both use `=O` (Mathlib's `IsBigO` lifted to `ℕ → ℕ`) to express asymptotic +bounds. +-/ + + +@[expose] public section + +namespace Complexity + + +/-- `DTIME(T)` is the class of languages decidable by a deterministic TM in + time `O(T(n))` (AB Definition 1.6). The machine may have any number of + work tapes. -/ +def DTIME (T : ℕ → ℕ) : Set Language := + {L | ∃ (k : ℕ) (tm : TM k) (f : ℕ → ℕ), + tm.DecidesInTime L f ∧ f =O T} + +/-- `NTIME(T)` is the class of languages decidable by a nondeterministic TM in + time `O(T(n))` (AB Definition 2.1). The machine may have any number of + work tapes. -/ +def NTIME (T : ℕ → ℕ) : Set Language := + {L | ∃ (k : ℕ) (tm : NTM k) (f : ℕ → ℕ), + tm.DecidesInTime L f ∧ f =O T} + +/-- **Complement class** constructor: `complClass C = {L | Lᶜ ∈ C}`. + Used to uniformly define `coNP`, `coRP`, `coNL`, etc. -/ +def complClass (C : Set Language) : Set Language := + {L | Lᶜ ∈ C} + +/-- Membership in `complClass C` is exactly membership of the complement in `C`. -/ +@[simp] theorem mem_complClass {L : Language} {C : Set Language} : + L ∈ complClass C ↔ Lᶜ ∈ C := Iff.rfl + +/-- The complement class is involutive: `complClass (complClass C) = C`. -/ +theorem complClass_complClass (C : Set Language) : complClass (complClass C) = C := by + ext L; simp [complClass] + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Encoding.lean b/LeanPool/BeyondBethe/Complexitylib/Encoding.lean new file mode 100644 index 0000000000..fcc183b3a0 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Encoding.lean @@ -0,0 +1,12 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.Complexitylib.Encoding.Data +import LeanPool.BeyondBethe.Complexitylib.Encoding.DataEncode +import LeanPool.BeyondBethe.Complexitylib.Encoding.Delimit +import LeanPool.BeyondBethe.Complexitylib.Encoding.Pairing + +/-! Supporting modules for Beyond the Bethe approximation of the permanent. -/ diff --git a/LeanPool/BeyondBethe/Complexitylib/Encoding/Data.lean b/LeanPool/BeyondBethe/Complexitylib/Encoding/Data.lean new file mode 100644 index 0000000000..38e12112c8 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Encoding/Data.lean @@ -0,0 +1,229 @@ +/- +Copyright (c) 2026 Christian Reitwiessner. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Christian Reitwiessner +-/ + +module +public import Aesop.BuiltinRules +public import Mathlib.Data.Nat.Notation +public import Mathlib.Data.List.Basic +public import Mathlib.Tactic.Finiteness.Attr +public import Mathlib.Tactic.Push +public import Mathlib.Tactic.ToAdditive +public import Mathlib.Tactic.ToDual + +/-! +# Main internal data type for the rose tree machine (RTM) + +This file contains the main internal data structure for the RTM, `Data`, a rose tree. + +## Main definitions and notations + +- `Data` - the main data structure +- `Data.size` - the size of a `Data` object when encoded using parentheses, complexity results + use this size as the main measure. +- `Data.toBits` - a parenthesized (balanced-bracket) serialization into `List Bool`, with length + equal to `Data.size`, and injective (`Data.toBits_injective`). +- `Data.recL` - the main recursion principle for `Data` +- `Data.inductionL` - the main induction principle for `Data` + +-/ + + +public section + +namespace Complexity + +/-- Rose-tree data structure, it allows us to encode most of Lean's data structures in a +"natural" manner -/ +inductive Data where + | l : List Data → Data +deriving Repr + +mutual + /-- Decidable equality for `Data`, defined jointly with `Data.listDecEq`. -/ + def Data.decEq : ∀ (a b : Data), Decidable (a = b) + | .l xs, .l ys => + match Data.listDecEq xs ys with + | isTrue h => isTrue (congrArg Data.l h) + | isFalse h => isFalse fun heq => h (Data.l.inj heq) + /-- Decidable equality for `List Data`, defined jointly with `Data.decEq`. -/ + def Data.listDecEq : ∀ (xs ys : List Data), Decidable (xs = ys) + | [], [] => isTrue rfl + | [], _ :: _ => isFalse (by simp) + | _ :: _, [] => isFalse (by simp) + | x :: xs, y :: ys => + match Data.decEq x y, Data.listDecEq xs ys with + | isTrue hxy, isTrue hxys => isTrue (congrArg₂ List.cons hxy hxys) + | isFalse hxy, _ => isFalse fun h => hxy (List.cons.inj h).1 + | _, isFalse hxys => isFalse fun h => hxys (List.cons.inj h).2 +end + +instance : DecidableEq Data := Data.decEq +instance : BEq Data := inferInstance +instance : LawfulBEq Data := inferInstance + +/-- The empty `Data` node, `Data.l []`. -/ +abbrev Data.empty := Data.l [] + + +/-- The list of children of a `Data` node. -/ +@[scoped grind =] +def Data.asList + | Data.l xs => xs + +@[scoped grind =] +lemma Data.asList_empty : Data.empty.asList = [] := by rfl + +@[simp, scoped grind =] +lemma Data.asList_l (d : Data) : Data.l d.asList = d := by simp [Data.asList]; grind + +@[simp, scoped grind =] +lemma Data.l_asList (xs : List Data) : (Data.l xs).asList = xs := by simp [Data.asList] + +/-- The encoding length of `d`, relevant for complexity. +This is the encoded size assuming an encoding into parenthesized expressions. -/ +def Data.size : Data → ℕ + | Data.l xs => 2 + (xs.map Data.size |>.sum) + +@[simp] +lemma Data.size_le {d : Data} : 0 < d.size := by + obtain ⟨xs⟩ := d + grind [Data.size] + +@[simp, scoped grind =] +lemma Data.size_empty : Data.empty.size = 2 := by simp [Data.empty, Data.size] + +@[simp, scoped grind =] +lemma Data.cons_size {h : Data} {t : List Data} : + (Data.l (h :: t)).size = h.size + (Data.l t).size := by + simp [Data.size] + grind + +lemma Data.size_lt_of_mem {c : Data} {xs : List Data} (hc : c ∈ xs) : + c.size < (Data.l xs).size := by + induction xs with + | nil => simp at hc + | cons a as ih => + rw [Data.cons_size] + rcases List.mem_cons.1 hc with h | h + · subst h; have := @Data.size_le (Data.l as); omega + · have := ih h; omega + +/-- Recursion principle for `Data`. -/ +@[elab_as_elim] +def Data.recL {motive : Data → Sort*} + (nil : motive (Data.l [])) + (cons : ∀ (x : Data) (xs : List Data), + motive x → motive (Data.l xs) → motive (Data.l (x :: xs))) : + ∀ d, motive d + | .l [] => nil + | .l (x :: xs) => + cons x xs (Data.recL nil cons x) (Data.recL nil cons (.l xs)) + +/-- Induction principle for `Data`, the `Prop`-valued companion to `Data.recL`. -/ +@[elab_as_elim] +theorem Data.inductionL {motive : Data → Prop} + (nil : motive (Data.l [])) + (cons : ∀ (x : Data) (xs : List Data), + motive x → motive (Data.l xs) → motive (Data.l (x :: xs))) + (d : Data) : motive d := + Data.recL nil cons d + +/-! ## Bitstring serialization + +`Data.toBits` serializes a `Data` value into a `List Bool` using a parenthesized +(balanced-bracket) encoding: `false` opens a node, its children are serialized in order, and +`true` closes the node. This matches `Data.size` exactly (`Data.length_toBits`) and is injective +(`Data.toBits_injective`), so any `DataEncode` instance yields an injective bitstring encoding +(see `Complexitylib.Encoding.DataEncode`). -/ + +/-- Serialize `Data` into a bitstring with a parenthesized (balanced-bracket) encoding: `false` +opens a node, the children are serialized in order, and `true` closes the node. -/ +def Data.toBits : Data → List Bool + | Data.l xs => false :: ((xs.map Data.toBits).flatten ++ [true]) + +lemma Data.toBits_l (xs : List Data) : + (Data.l xs).toBits = false :: ((xs.map Data.toBits).flatten ++ [true]) := by + rw [Data.toBits] + +@[simp] +lemma Data.length_toBits (d : Data) : d.toBits.length = d.size := by + induction d using Data.inductionL with + | nil => simp [Data.toBits] + | cons x xs ihx ihxs => + simp only [Data.toBits, Data.size, List.map_cons, List.flatten_cons, List.length_cons, + List.length_append, List.length_flatten, List.map_map] at * + grind + +/-- One step of the stack-based `Data.fromBits` parser. The state is a stack of frames, each a +list of the sibling nodes completed so far at that nesting depth (outermost frame at the bottom). +Reading `false` opens a new (empty) frame; reading `true` closes the top frame into a `Data.l` +node and appends it to its parent. `none` is a permanent failure state (an unmatched `true`). -/ +def Data.fromBitsStep : Option (List (List Data)) → Bool → Option (List (List Data)) + | none, _ => none + | some stack, false => some ([] :: stack) + | some stack, true => + match stack with + | kids :: parent :: rest => some ((parent ++ [Data.l kids]) :: rest) + | _ => none + +/-- Decode a bitstring produced by `Data.toBits` back into a `Data` value, or `none` if it is not +a valid single serialization. This is a left inverse of `Data.toBits` (`Data.fromBits_toBits`). -/ +def Data.fromBits (bits : List Bool) : Option Data := + match bits.foldl Data.fromBitsStep (some [[]]) with + | some [[d]] => some d + | _ => none + +/-- Running `Data.fromBitsStep` over `d.toBits` appends the decoded `d` to the top frame of the +stack, leaving the rest of the stack untouched. This is the key lemma behind +`Data.fromBits_toBits`. -/ +theorem Data.foldl_fromBitsStep_toBits : + ∀ (d : Data) (top : List Data) (rest : List (List Data)), + d.toBits.foldl Data.fromBitsStep (some (top :: rest)) = some ((top ++ [d]) :: rest) := by + -- Strong induction on the size of `d`, so that each child (strictly smaller) can appeal to the + -- inductive hypothesis while a plain list induction consumes the children in order. + have key : ∀ (n : ℕ) (d : Data) (top : List Data) (rest : List (List Data)), + d.size ≤ n → + d.toBits.foldl Data.fromBitsStep (some (top :: rest)) = some ((top ++ [d]) :: rest) := by + intro n + induction n using Nat.strongRecOn with + | ind n IH => + rintro ⟨xs⟩ top rest hsz + -- Consuming the flattened children appends them, in order, to the current frame. + have L : ∀ (xs : List Data) (cur : List Data) (rest : List (List Data)), + (∀ c ∈ xs, c.size < n) → + (xs.map Data.toBits).flatten.foldl Data.fromBitsStep (some (cur :: rest)) + = some ((cur ++ xs) :: rest) := by + intro xs + induction xs with + | nil => intro cur rest _; simp + | cons c cs ihcs => + intro cur rest hlt + have hc : c.size < n := hlt c (List.mem_cons_self ..) + simp only [List.map_cons, List.flatten_cons, List.foldl_append] + rw [IH c.size hc c cur rest (Nat.le_refl _), + ihcs (cur ++ [c]) rest (fun c' hc' => hlt c' (List.mem_cons_of_mem _ hc'))] + simp + rw [Data.toBits_l] + simp only [List.foldl_cons, List.foldl_append, Data.fromBitsStep] + rw [L xs [] (top :: rest) (fun c hc => Nat.lt_of_lt_of_le (Data.size_lt_of_mem hc) hsz)] + simp + intro d top rest + exact key d.size d top rest (Nat.le_refl _) + +/-- `Data.fromBits` recovers any value serialized by `Data.toBits`. -/ +@[simp] +theorem Data.fromBits_toBits (d : Data) : Data.fromBits d.toBits = some d := by + simp only [Data.fromBits, Data.foldl_fromBitsStep_toBits, List.nil_append] + +/-- `Data.toBits` is injective: the parenthesized serialization determines the value. This follows +from `Data.fromBits` being a left inverse. -/ +theorem Data.toBits_injective : Function.Injective Data.toBits := by + intro a b h + have := Data.fromBits_toBits a + rw [h, Data.fromBits_toBits b] at this + exact Option.some.inj this.symm + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Encoding/DataEncode.lean b/LeanPool/BeyondBethe/Complexitylib/Encoding/DataEncode.lean new file mode 100644 index 0000000000..912af2fb3a --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Encoding/DataEncode.lean @@ -0,0 +1,122 @@ +/- +Copyright (c) 2026 Christian Reitwiessner. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Christian Reitwiessner +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Encoding.Data +public import Mathlib.Data.Nat.Bits +public import Mathlib.Data.List.Basic + +/-! +# Encodings into `Data` + +This file defines the class that is used to encode arbitrary data structures into `Data`, +so that RTMs (rose tree machines) can operate on them. + +Instances are provided for convenience for `Data` itself, `Bool`, `List α`, `Option α`, `α × β`, +and `ℕ` (binary encoding via `List Bool`) + +Every `DataEncode` instance also yields a *bitstring* encoding `DataEncode.bitstringEncode`, by +serializing the target `Data` value with `Data.toBits`. Since both the `DataEncode` instance and +`Data.toBits` are injective, `bitstringEncode` is injective too +(`DataEncode.bitstringEncode_injective`). +-/ + + +public section + +namespace Complexity + +/-- Encoding of types into `Data`. -/ +class DataEncode (α : Type) where + /-- Encode a value of `α` as `Data`. -/ + encode : α → Data + /-- The encoding is injective, so distinct values never collide. -/ + h_inj : encode.Injective + +instance : DataEncode Data where + encode b := b + h_inj := by intros a b h_eq; grind + +@[simp, scoped grind =] +lemma DataEncode_encode_data (d : Data) : DataEncode.encode d = d := rfl + +instance : DataEncode Bool where + encode b := if b then Data.l [ Data.l [] ] else Data.l [] + h_inj := by intros a b h_eq; grind + +instance (α : Type) [DataEncode α] : DataEncode (List α) where + encode xs := Data.l (xs.map DataEncode.encode) + h_inj := by + intro a b h + exact List.map_injective_iff.mpr DataEncode.h_inj (Data.l.inj h) + +@[simp, scoped grind =] +lemma DataEncode_list_nil {α : Type} [DataEncode α] : + DataEncode.encode ([] : List α) = Data.l [] := by + simp [DataEncode.encode] + +@[simp, scoped grind =] +lemma DataEncode_list_eq_nil_iff_nil {α : Type} [DataEncode α] (xs : List α) : + DataEncode.encode xs = Data.empty ↔ xs = [] := by + simp [DataEncode.encode] + +@[simp, scoped grind =] +lemma DataEncode_list_tail {α : Type} [DataEncode α] (xs : List α) : + (DataEncode.encode xs).asList.tail = (DataEncode.encode xs.tail).asList := by + simp [DataEncode.encode] + +instance (α : Type) [DataEncode α] : DataEncode (Option α) where + encode := fun + | none => Data.l [] + | some x => Data.l [DataEncode.encode x] + h_inj := by + intro a b h + grind [DataEncode.h_inj] + +@[simp] +lemma DataEncode_Option_empty {α : Type} [DataEncode α] (x : Option α) : + (DataEncode.encode x == Data.empty) = x.isNone := by + cases x <;> simp [DataEncode.encode, Data.empty] + +instance (α β : Type) [DataEncode α] [DataEncode β] : DataEncode (α × β) where + encode := fun (a, b) => Data.l [DataEncode.encode a, DataEncode.encode b] + h_inj := by + intro ⟨a₁, b₁⟩ ⟨a₂, b₂⟩ h + grind [DataEncode.h_inj] + +lemma DataEncode_pair {α β : Type} [DataEncode α] [DataEncode β] (a : α) (b : β) : + DataEncode.encode (a, b) = Data.l [DataEncode.encode a, DataEncode.encode b] := by + simp [DataEncode.encode] + +instance : DataEncode ℕ where + encode x := DataEncode.encode (Nat.bits x) + h_inj := by + intro a b h + have hb : a.bits = b.bits := DataEncode.h_inj h + have hrec : ∀ n : ℕ, n.bits.foldr (fun b acc => Nat.bit b acc) 0 = n := by + intro n + induction n using Nat.binaryRec' with + | zero => simp + | bit b n hn ih => rw [Nat.bits_append_bit n b hn]; simp [ih] + have := congrArg (List.foldr (fun b acc => Nat.bit b acc) 0) hb + simpa [hrec] using this + +/-- Encode a value into a bitstring (`List Bool`) by first encoding it into `Data` and then +serializing that with the parenthesized `Data.toBits`. This is the class-inferrable bitstring +encoding available for any type with a `DataEncode` instance. -/ +@[expose] def DataEncode.bitstringEncode {α : Type} [DataEncode α] (a : α) : List Bool := + (DataEncode.encode a).toBits + +lemma DataEncode.bitstringEncode_def {α : Type} [DataEncode α] (a : α) : + DataEncode.bitstringEncode a = (DataEncode.encode a).toBits := rfl + +/-- The bitstring encoding is injective: distinct values yield distinct bitstrings. This composes +the injectivity of the `DataEncode` instance with that of `Data.toBits`. -/ +theorem DataEncode.bitstringEncode_injective {α : Type} [DataEncode α] : + Function.Injective (DataEncode.bitstringEncode (α := α)) := + Data.toBits_injective.comp DataEncode.h_inj + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Encoding/Delimit.lean b/LeanPool/BeyondBethe/Complexitylib/Encoding/Delimit.lean new file mode 100644 index 0000000000..f18be139fc --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Encoding/Delimit.lean @@ -0,0 +1,209 @@ +/- +Copyright (c) 2026 Bolton Bailey. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Bolton Bailey +-/ + +module +public import Mathlib.Data.List.Basic +public import Mathlib.Data.Nat.Init +public import Aesop.BuiltinRules +public import Mathlib.Tactic.Attr.Core +public import Mathlib.Tactic.Basic +public import Mathlib.Tactic.Push +public import Mathlib.Tactic.Widget.Calc +public import Std.Tactic.BVDecide.Normalize.Prop + +/-! +# Self-delimiting blocks + +To concatenate binary strings into a single binary string, each piece must announce its own +end. This file defines the library's single framing operation and its parsers: + +- `delimit` frames a payload: each payload bit is doubled (`false ↦ [false, false]`, + `true ↦ [true, true]`) and the block is terminated by the separator `[false, true]`, + which no run of doubled bits can produce. +- `unpair?` parses one block off the front of the input, returning the payload and the + remaining suffix (`none` on malformed input). It is named for its role in the pairing + codec `Complexity.pair` (see `Complexitylib.Encoding.Pairing`), which is + `pair x y = delimit x ++ y`. +- `undelimitBlock`, `takeFirstBlock`, `hasBlock`, `tagBlock`, and `undelimitBlocks` are the + total helper functions machines compute when working with framed data. + +This file deliberately has no dependency on the machine or complexity-class layers, so the +machine-input pairing codec (`Complexitylib.Encoding.Pairing`) can build on it without import +cycles. +-/ + + +@[expose] public section + +namespace Complexity + +/-- Frame a binary string as a self-delimiting block: each payload bit is doubled + (`false ↦ [false, false]`, `true ↦ [true, true]`) and the block is terminated by the + separator `[false, true]`, which no run of doubled bits can produce. -/ +def delimit (x : List Bool) : List Bool := + (x.flatMap fun b => [b, b]) ++ [false, true] + +@[simp] theorem delimit_nil : delimit [] = [false, true] := rfl + +@[simp] theorem delimit_cons (b : Bool) (l : List Bool) : + delimit (b :: l) = b :: b :: delimit l := by + simp [delimit] + +@[simp] theorem delimit_length (l : List Bool) : (delimit l).length = 2 * l.length + 2 := by + induction l with + | nil => rfl + | cons b l ih => simp only [delimit_cons, List.length_cons, ih]; omega + +/-- Parse one self-delimiting block off the front of the input. It scans doubled bits until + the first separator `[false, true]`, returning the decoded payload together with the + remaining suffix. Invalid doubled prefixes return `none`. -/ +def unpair? : List Bool → Option (List Bool × List Bool) + | [] => none + | false :: true :: y => some ([], y) + | false :: false :: z => + Option.map (fun (xy : List Bool × List Bool) => (false :: xy.1, xy.2)) (unpair? z) + | true :: true :: z => + Option.map (fun (xy : List Bool × List Bool) => (true :: xy.1, xy.2)) (unpair? z) + | _ => none + +/-- `unpair?` reads back the framing written by `delimit`: parsing one block off the front + of any input recovers the payload and the remaining suffix. -/ +@[simp] theorem unpair?_delimit_append (x y : List Bool) : + unpair? (delimit x ++ y) = some (x, y) := by + induction x with + | nil => simp [unpair?] + | cons b x ih => cases b <;> simp [unpair?, ih] + +/-- Soundness of the parser: a successful parse decomposes the input as the parsed payload's + framing followed by the leftover suffix. -/ +theorem eq_delimit_append_of_unpair?_eq_some : + ∀ {z x y : List Bool}, unpair? z = some (x, y) → z = delimit x ++ y + | [], _, _, h => by simp [unpair?] at h + | [b], _, _, h => by cases b <;> simp [unpair?] at h + | false :: true :: rest, x, y, h => by + simp only [unpair?, Option.some.injEq, Prod.mk.injEq] at h + obtain ⟨rfl, rfl⟩ := h + rfl + | false :: false :: rest, x, y, h => by + simp only [unpair?, Option.map_eq_some_iff] at h + obtain ⟨⟨p₁, p₂⟩, hp, heq⟩ := h + obtain ⟨rfl, rfl⟩ : false :: p₁ = x ∧ p₂ = y := by simpa [Prod.ext_iff] using heq + simp only [eq_delimit_append_of_unpair?_eq_some hp, delimit_cons, List.cons_append] + | true :: true :: rest, x, y, h => by + simp only [unpair?, Option.map_eq_some_iff] at h + obtain ⟨⟨p₁, p₂⟩, hp, heq⟩ := h + obtain ⟨rfl, rfl⟩ : true :: p₁ = x ∧ p₂ = y := by simpa [Prod.ext_iff] using heq + simp only [eq_delimit_append_of_unpair?_eq_some hp, delimit_cons, List.cons_append] + | true :: false :: rest, _, _, h => by simp [unpair?] at h + +/- ## Total block helpers -/ + +/-- Strip the framing of a single self-delimiting block, returning its payload. On `delimit P` +this returns `P`. Unlike `unpair?`, this is total: it ignores any data trailing the first block +and maps malformed input to `[]`. -/ +def undelimitBlock : List Bool → List Bool + | false :: true :: _ => [] + | false :: false :: rest => false :: undelimitBlock rest + | true :: _ :: rest => true :: undelimitBlock rest + | _ => [] + +@[simp] +theorem undelimitBlock_delimit (P : List Bool) : + undelimitBlock (delimit P) = P := by + induction P with + | nil => rfl + | cons b P ih => cases b <;> simp [undelimitBlock, ih] + +/-- Keep the leading self-delimiting block of a bitstring, dropping everything after it. On a +pair encoding `delimit x ++ w` this returns `delimit x`. -/ +def takeFirstBlock : List Bool → List Bool + | false :: true :: _ => [false, true] + | false :: false :: rest => false :: false :: takeFirstBlock rest + | true :: c :: rest => true :: c :: takeFirstBlock rest + | l => l + +@[simp] +theorem takeFirstBlock_delimit_append (P Q : List Bool) : + takeFirstBlock (delimit P ++ Q) = delimit P := by + induction P with + | nil => rfl + | cons b P ih => cases b <;> simp [takeFirstBlock, ih] + +/-- Does the bitstring begin with a well-formed self-delimiting block? -/ +def hasBlock : List Bool → Bool + | false :: true :: _ => true + | false :: false :: rest => hasBlock rest + | true :: true :: rest => hasBlock rest + | _ => false + +theorem hasBlock_eq_isSome_unpair? : + ∀ l : List Bool, hasBlock l = (unpair? l).isSome + | [] => rfl + | [b] => by cases b <;> rfl + | false :: true :: _ => rfl + | false :: false :: rest => by + simp only [hasBlock, unpair?, hasBlock_eq_isSome_unpair? rest] + cases unpair? rest <;> rfl + | true :: true :: rest => by + simp only [hasBlock, unpair?, hasBlock_eq_isSome_unpair? rest] + cases unpair? rest <;> rfl + | true :: false :: _ => rfl + +/-- Tag a bitstring with a leading `true` if it begins with a well-formed self-delimiting +block, and return the empty bitstring otherwise. On pair encodings this computes +`encode ∘ decode`. -/ +def tagBlock (l : List Bool) : List Bool := + bif hasBlock l then true :: l else [] + +/- ## Parsing a sequence of blocks -/ + +/-- Parse a sequence of self-delimiting blocks, using `fuel` to bound the number of blocks. + +This is the auxiliary, fuel-carrying implementation of `undelimitBlocks`; since every block +is nonempty, `input.length` is always enough fuel. -/ +def undelimitBlocksAux : ℕ → List Bool → Option (List (List Bool)) + | _, [] => some [] + | 0, _ :: _ => none + | fuel + 1, input => do + let (block, rest) ← unpair? input + let blocks ← undelimitBlocksAux fuel rest + return block :: blocks + +/-- Parse a sequence of self-delimiting blocks off the front of the input. + +Since every block is nonempty, `input.length` bounds the number of blocks, so it always +suffices as fuel for `undelimitBlocksAux`. -/ +def undelimitBlocks (input : List Bool) : Option (List (List Bool)) := + undelimitBlocksAux input.length input + +theorem length_le_length_flatten_delimit (l : List (List Bool)) : + l.length ≤ ((l.map delimit).flatten).length := by + induction l with + | nil => simp + | cons b t ih => + simp only [List.map_cons, List.flatten_cons, List.length_append, List.length_cons, + delimit_length] + omega + +private theorem undelimitBlocksAux_flatten_delimit (l : List (List Bool)) : + ∀ fuel, l.length ≤ fuel → undelimitBlocksAux fuel ((l.map delimit).flatten) = some l := by + induction l with + | nil => intro fuel _; cases fuel <;> rfl + | cons b t ih => + intro fuel hfuel + rw [List.length_cons] at hfuel + obtain ⟨fuel, rfl⟩ : ∃ f, fuel = f + 1 := ⟨fuel - 1, by omega⟩ + obtain ⟨hd, tl, hcons⟩ : ∃ hd tl, delimit b ++ (t.map delimit).flatten = hd :: tl := by + cases b <;> exact ⟨_, _, rfl⟩ + simp only [List.map_cons, List.flatten_cons, hcons, undelimitBlocksAux] + rw [← hcons, unpair?_delimit_append] + simp [ih fuel (by omega)] + +theorem undelimitBlocks_flatten_delimit (l : List (List Bool)) : + undelimitBlocks ((l.map delimit).flatten) = some l := + undelimitBlocksAux_flatten_delimit l _ (length_le_length_flatten_delimit l) + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Encoding/Pairing.lean b/LeanPool/BeyondBethe/Complexitylib/Encoding/Pairing.lean new file mode 100644 index 0000000000..ee2a71800a --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Encoding/Pairing.lean @@ -0,0 +1,263 @@ +/- +Copyright (c) 2025 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Encoding.Delimit +public import Mathlib.Data.Nat.Init +public import Aesop.BuiltinRules +public import Mathlib.Tactic.Attr.Core +public import Mathlib.Tactic.Basic +public import Mathlib.Tactic.Push +public import Mathlib.Tactic.Widget.Calc +public import Std.Tactic.BVDecide.Normalize.Prop + +/-! +# Pairing binary strings + +This file defines the low-level self-delimiting pairing codec used by machine +inputs throughout Complexitylib. It deliberately has no dependency on the +machine or complexity-class layers, so parsers and encoders can reuse it +without introducing an import cycle. +-/ + + +@[expose] public section + +namespace Complexity + +/-- Encode a pair of binary strings as a single binary string. + Each bit of `x` is doubled (`false ↦ [false, false]`, `true ↦ [true, true]`), + followed by the separator `[false, true]`, followed by `y` verbatim. + This encoding is injective and computable in linear time. -/ +def pair (x y : List Bool) : List Bool := + delimit x ++ y + +private theorem pair_nil_eq (y : List Bool) : + pair [] y = false :: true :: y := by + simp [pair] + +/-- One step of the doubling encoder: `pair` on `b :: x` prepends the + doubled bit `b, b`. -/ +theorem pair_cons_eq (b : Bool) (x y : List Bool) : + pair (b :: x) y = b :: b :: pair x y := by + simp [pair] + +/-- `|pair x y| = 2·|x| + 2 + |y|`. The `2·|x|` comes from doubling every + bit of `x`; the `+2` is the separator `[false, true]`. -/ +@[simp] theorem pair_length (x y : List Bool) : + (pair x y).length = 2 * x.length + 2 + y.length := by + induction x with + | nil => simp [pair]; omega + | cons b xs ih => + rw [pair_cons_eq, List.length_cons, List.length_cons, List.length_cons, ih] + omega + +/-- `pair` is injective: if `pair x₁ y₁ = pair x₂ y₂` then `x₁ = x₂` and +`y₁ = y₂`. -/ +theorem pair_inj {x₁ x₂ : List Bool} {y₁ y₂ : List Bool} + (h : pair x₁ y₁ = pair x₂ y₂) : x₁ = x₂ ∧ y₁ = y₂ := by + induction x₁ generalizing x₂ with + | nil => + rw [pair_nil_eq] at h + cases x₂ with + | nil => + rw [pair_nil_eq] at h + exact ⟨rfl, (List.cons.inj (List.cons.inj h).2).2⟩ + | cons b x₂' => + rw [pair_cons_eq] at h + have h1 := (List.cons.inj h).1 -- false = b + have h2 := (List.cons.inj (List.cons.inj h).2).1 -- true = b + exact absurd (h1.trans h2.symm) Bool.false_ne_true + | cons b₁ x₁' ih => + rw [pair_cons_eq] at h + cases x₂ with + | nil => + rw [pair_nil_eq] at h + have h1 := (List.cons.inj h).1 -- b₁ = false + have h2 := (List.cons.inj (List.cons.inj h).2).1 -- b₁ = true + exact absurd (h1.symm.trans h2) Bool.false_ne_true + | cons b₂ x₂' => + rw [pair_cons_eq] at h + have hb := (List.cons.inj h).1 -- b₁ = b₂ + have htail := (List.cons.inj (List.cons.inj h).2).2 -- pair x₁' y₁ = pair x₂' y₂ + have ⟨hx, hy⟩ := ih htail + subst hb; subst hx + exact ⟨rfl, hy⟩ + +/-- `unpair?` is a left inverse of `pair`: decoding an encoded pair + recovers exactly its two components. -/ +@[simp] theorem unpair?_pair (x y : List Bool) : + unpair? (pair x y) = some (x, y) := + unpair?_delimit_append x y + +/-- Soundness of the decoder: if `unpair?` succeeds on `z`, producing `(x, y)`, + then `z` was exactly the encoding `pair x y`. -/ +theorem eq_pair_of_unpair?_eq_some {z x y : List Bool} (h : unpair? z = some (x, y)) : + z = pair x y := + eq_delimit_append_of_unpair?_eq_some h + +/-- `unpair? z` returns `some (x, y)` if and only if `z = pair x y`, + characterizing exactly which strings are valid pair encodings. -/ +theorem unpair?_eq_some_iff {z x y : List Bool} : + unpair? z = some (x, y) ↔ z = pair x y := by + constructor + · exact eq_pair_of_unpair?_eq_some + · intro hz + subst hz + exact unpair?_pair x y + +/-- In `pair x y`, the first duplicated copy of `x[i]` sits at position `2*i`. -/ +theorem pair_getElem_left_first (x y : List Bool) (i : ℕ) (hi : i < x.length) : + (pair x y)[2 * i]'(by rw [pair_length]; omega) = x[i]'hi := by + induction x generalizing i with + | nil => + cases hi + | cons b xs ih => + cases i with + | zero => + simp [pair_cons_eq] + | succ i => + have hi' : i < xs.length := by simpa using hi + change (b :: b :: pair xs y)[2 * (i + 1)]'( + by simp [pair_length]; omega) = xs[i]'hi' + have hshift : + (b :: b :: pair xs y)[2 * (i + 1)]'(by simp [pair_length]; omega) = + (pair xs y)[2 * i]'(by rw [pair_length]; omega) := by + calc + (b :: b :: pair xs y)[2 * (i + 1)]'(by simp [pair_length]; omega) + = (b :: pair xs y)[2 * i + 1]'(by simp [pair_length]; omega) := by + exact List.getElem_cons_succ b (b :: pair xs y) (2 * i + 1) + (by simp [pair_length]; omega) + _ = (pair xs y)[2 * i]'(by rw [pair_length]; omega) := by + exact List.getElem_cons_succ b (pair xs y) (2 * i) + (by simp [pair_length]; omega) + rw [hshift] + exact ih i hi' + +/-- In `pair x y`, the second duplicated copy of `x[i]` sits at position `2*i+1`. -/ +theorem pair_getElem_left_second (x y : List Bool) (i : ℕ) (hi : i < x.length) : + (pair x y)[2 * i + 1]'(by rw [pair_length]; omega) = x[i]'hi := by + induction x generalizing i with + | nil => + cases hi + | cons b xs ih => + cases i with + | zero => + simp [pair_cons_eq] + | succ i => + have hi' : i < xs.length := by simpa using hi + change (b :: b :: pair xs y)[2 * (i + 1) + 1]'( + by simp [pair_length]; omega) = xs[i]'hi' + have hshift : + (b :: b :: pair xs y)[2 * (i + 1) + 1]'(by simp [pair_length]; omega) = + (pair xs y)[2 * i + 1]'(by rw [pair_length]; omega) := by + calc + (b :: b :: pair xs y)[2 * (i + 1) + 1]'(by simp [pair_length]; omega) + = (b :: pair xs y)[2 * i + 2]'(by simp [pair_length]; omega) := by + exact List.getElem_cons_succ b (b :: pair xs y) (2 * i + 2) + (by simp [pair_length]; omega) + _ = (pair xs y)[2 * i + 1]'(by rw [pair_length]; omega) := by + exact List.getElem_cons_succ b (pair xs y) (2 * i + 1) + (by simp [pair_length]; omega) + rw [hshift] + exact ih i hi' + +/-- The first separator bit in `pair x y` is `false`. -/ +theorem pair_getElem_sep_zero (x y : List Bool) : + (pair x y)[2 * x.length]'(by rw [pair_length]; omega) = false := by + induction x with + | nil => + simp [pair] + | cons b xs ih => + change (b :: b :: pair xs y)[2 * (xs.length + 1)]'( + by simp [pair_length]; omega) = false + have hshift : + (b :: b :: pair xs y)[2 * (xs.length + 1)]'(by simp [pair_length]; omega) = + (pair xs y)[2 * xs.length]'(by rw [pair_length]; omega) := by + calc + (b :: b :: pair xs y)[2 * (xs.length + 1)]'(by simp [pair_length]; omega) + = (b :: pair xs y)[2 * xs.length + 1]'(by simp [pair_length]; omega) := by + exact List.getElem_cons_succ b (b :: pair xs y) (2 * xs.length + 1) + (by simp [pair_length]; omega) + _ = (pair xs y)[2 * xs.length]'(by rw [pair_length]; omega) := by + exact List.getElem_cons_succ b (pair xs y) (2 * xs.length) + (by simp [pair_length]; omega) + rw [hshift] + exact ih + +/-- The second separator bit in `pair x y` is `true`. -/ +theorem pair_getElem_sep_one (x y : List Bool) : + (pair x y)[2 * x.length + 1]'(by rw [pair_length]; omega) = true := by + induction x with + | nil => + simp [pair] + | cons b xs ih => + change (b :: b :: pair xs y)[2 * (xs.length + 1) + 1]'( + by simp [pair_length]; omega) = true + have hshift : + (b :: b :: pair xs y)[2 * (xs.length + 1) + 1] = + (pair xs y)[2 * xs.length + 1] := by + have h₁ : 2 * xs.length + 2 + 1 < (b :: b :: pair xs y).length := by + simp [pair_length] + omega + have h₂ : 2 * xs.length + 1 + 1 < (b :: pair xs y).length := by + simp [pair_length] + omega + calc + (b :: b :: pair xs y)[2 * (xs.length + 1) + 1] + = (b :: pair xs y)[2 * xs.length + 2] := by + simpa only [Nat.mul_add, Nat.mul_one, Nat.add_assoc] using + List.getElem_cons_succ b (b :: pair xs y) (2 * xs.length + 2) + (h := h₁) + _ = (pair xs y)[2 * xs.length + 1] := by + simpa only [Nat.add_assoc] using + List.getElem_cons_succ b (pair xs y) (2 * xs.length + 1) + (h := h₂) + rw [hshift] + exact ih + +/-- Length of the doubled prefix used in `pair x y`. -/ +private theorem pair_flatMap_doubled_length (x : List Bool) : + (x.flatMap fun b => [b, b]).length = 2 * x.length := by + induction x with + | nil => + simp + | cons b xs ih => + rw [List.flatMap_cons, List.length_append, ih] + simp + omega + +/-- In `pair x y`, the suffix after the separator is exactly `y`. -/ +theorem pair_getElem_right (x y : List Bool) (j : ℕ) (hj : j < y.length) : + (pair x y)[2 * x.length + 2 + j]'(by rw [pair_length]; omega) = y[j]'hj := by + have hdecomp : pair x y = (x.flatMap fun b => [b, b]) ++ [false, true] ++ y := rfl + have hflat := pair_flatMap_doubled_length x + have hprefix : + ((x.flatMap fun b => [b, b]) ++ [false, true]).length = 2 * x.length + 2 := by + rw [List.length_append, hflat] + rfl + have hge : + ((x.flatMap fun b => [b, b]) ++ [false, true]).length ≤ 2 * x.length + 2 + j := by + rw [hprefix] + omega + have hj' : + (2 * x.length + 2 + j) - + ((x.flatMap fun b => [b, b]) ++ [false, true]).length < y.length := by + rw [hprefix] + omega + calc + (pair x y)[2 * x.length + 2 + j]'(by rw [pair_length]; omega) + = ((x.flatMap fun b => [b, b]) ++ [false, true] ++ y)[2 * x.length + 2 + j]' + (by rw [← hdecomp, pair_length]; omega) := by + exact List.getElem_of_eq hdecomp _ + _ = y[(2 * x.length + 2 + j) - ((x.flatMap fun b => [b, b]) ++ [false, true]).length]'hj' := + List.getElem_append_right hge + _ = y[j]'hj := by + congr 1 + rw [hprefix] + omega + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Languages.lean b/LeanPool/BeyondBethe/Complexitylib/Languages.lean new file mode 100644 index 0000000000..02379bfa90 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Languages.lean @@ -0,0 +1,9 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.Complexitylib.Languages.LastBit + +/-! Supporting modules for Beyond the Bethe approximation of the permanent. -/ diff --git a/LeanPool/BeyondBethe/Complexitylib/Languages/LastBit.lean b/LeanPool/BeyondBethe/Complexitylib/Languages/LastBit.lean new file mode 100644 index 0000000000..65c0e0928e --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Languages/LastBit.lean @@ -0,0 +1,127 @@ +/- +Copyright (c) 2025 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.Internal.Scanner +public import LeanPool.BeyondBethe.Complexitylib.Classes.Containments + +/-! +# `lastBitOne` and `lastBitZero`: final-symbol languages + +Strings whose last bit is `1` (resp. `0`); the empty string is not in +either language. Decided by a 3-state `scannerTM` instance: the scan state +is the last bit seen so far, or `none` if no bit has been read. + +## Main definitions + +- `Language.lastBitOne`, `Language.lastBitZero`. +- `TM.lastBitTM target` — `scannerTM` specialized to `target : Bool`. + +## Main results + +- `lastBitOne_in_DTIME`, `lastBitZero_in_DTIME` — both in `DTIME(n + 2)`. +- `lastBitOne_mem_P`, `lastBitZero_mem_P`. +-/ + + +public section + +namespace Complexity + +open Complexity + +namespace TM + +/-- Scanner for "last input bit equals `target`". Scan state: the last bit + seen so far as an `Option Bool` (`none` initially). -/ +def lastBitTM (target : Bool) : TM 0 := + scannerTM (S := Option Bool) none + (fun _ b => some b) + (fun s => if decide (s = some target) = true then Γw.one else Γw.zero) + +end TM + +namespace Language + +/-- Strings whose last bit is `0` (empty string excluded). -/ +def lastBitZero : Language := {x | x.getLast? = some false} + +/-- Strings whose last bit is `1` (empty string excluded). -/ +def lastBitOne : Language := {x | x.getLast? = some true} + +end Language + +-- ════════════════════════════════════════════════════════════════════════ +-- Fold characterization +-- ════════════════════════════════════════════════════════════════════════ + +/-- Folding `(fun _ b => some b)` over a list with seed `s` yields + `x.getLast?` if `x` is nonempty, else `s`. -/ +private theorem lastBit_fold : + ∀ (x : List Bool) (s : Option Bool), + x.foldl (fun _ b => some b) s = + (x.getLast?.orElse (fun _ => s)) := by + intro x + induction x with + | nil => intro s; simp + | cons b xs ih => + intro s + rw [List.foldl_cons, ih] + cases hxs : xs with + | nil => simp + | cons c cs => + simp [List.getLast?_cons, ← hxs] + +/-- The last-bit scanner fold from `none` is exactly `List.getLast?`. -/ +theorem lastBit_fold_eq_getLast? (x : List Bool) : + x.foldl (fun _ b => some b) none = x.getLast? := by + rw [lastBit_fold] + cases x.getLast? <;> simp + +-- ════════════════════════════════════════════════════════════════════════ +-- DTIME memberships +-- ════════════════════════════════════════════════════════════════════════ + +/-- **`lastBitZero ∈ DTIME(n + 2)`**. -/ +theorem lastBitZero_in_DTIME : + Language.lastBitZero ∈ DTIME (fun n => n + 2) := by + refine ⟨0, TM.lastBitTM false, fun n => n + 2, ?_, BigO.refl _⟩ + exact TM.scannerTM_decidesInTime (S := Option Bool) none + (fun _ b => some b) (fun s => decide (s = some false)) + (L := Language.lastBitZero) + (fun x => by + show (x.getLast? = some false) ↔ (decide (x.foldl _ none = some false) = true) + rw [lastBit_fold_eq_getLast?, decide_eq_true_iff]) + +/-- **`lastBitOne ∈ DTIME(n + 2)`**. -/ +theorem lastBitOne_in_DTIME : + Language.lastBitOne ∈ DTIME (fun n => n + 2) := by + refine ⟨0, TM.lastBitTM true, fun n => n + 2, ?_, BigO.refl _⟩ + exact TM.scannerTM_decidesInTime (S := Option Bool) none + (fun _ b => some b) (fun s => decide (s = some true)) + (L := Language.lastBitOne) + (fun x => by + show (x.getLast? = some true) ↔ (decide (x.foldl _ none = some true) = true) + rw [lastBit_fold_eq_getLast?, decide_eq_true_iff]) + +-- ════════════════════════════════════════════════════════════════════════ +-- P memberships +-- ════════════════════════════════════════════════════════════════════════ + +/-- **`lastBitZero ∈ P`**. -/ +theorem lastBitZero_mem_P : Language.lastBitZero ∈ P := by + refine Set.mem_iUnion.mpr ⟨1, DTIME_mono ?_ lastBitZero_in_DTIME⟩ + refine BigO.add ?_ (BigO.const_le_pow 2 1) + simpa using BigO.refl (fun n : ℕ => n) + +/-- **`lastBitOne ∈ P`**. -/ +theorem lastBitOne_mem_P : Language.lastBitOne ∈ P := by + refine Set.mem_iUnion.mpr ⟨1, DTIME_mono ?_ lastBitOne_in_DTIME⟩ + refine BigO.add ?_ (BigO.const_le_pow 2 1) + simpa using BigO.refl (fun n : ℕ => n) + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Mathlib.lean b/LeanPool/BeyondBethe/Complexitylib/Mathlib.lean new file mode 100644 index 0000000000..92eec1d30a --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Mathlib.lean @@ -0,0 +1,10 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.Complexitylib.Mathlib.FinsetPrefixes +import LeanPool.BeyondBethe.Complexitylib.Mathlib.NatBits + +/-! Supporting modules for Beyond the Bethe approximation of the permanent. -/ diff --git a/LeanPool/BeyondBethe/Complexitylib/Mathlib/FinsetPrefixes.lean b/LeanPool/BeyondBethe/Complexitylib/Mathlib/FinsetPrefixes.lean new file mode 100644 index 0000000000..96ca3e9bd6 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Mathlib/FinsetPrefixes.lean @@ -0,0 +1,71 @@ +/- +Copyright (c) 2026 Bolton Bailey. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Bolton Bailey +-/ + +module +public import Mathlib.Data.Finset.Union +public import Mathlib.Data.List.Infix + +/-! +# Finsets of prefixes and suffixes + +For a finite set `S` of lists, `Finset.prefixes S` is the finite set of all +prefixes of elements of `S`, and `Finset.suffixes S` the finite set of all +suffixes of elements of `S`. The two operations have dual APIs: membership +characterizations (`mem_prefixes`/`mem_suffixes`), self-membership, and +closure under taking further prefixes/suffixes. + +This file lives in `Complexitylib/Mathlib/` because it extends a Mathlib +type in its home namespace — the sanctioned exception to the `Complexity` +root-namespace rule. Its contents are candidates for upstreaming to Mathlib. +-/ + +public section + +namespace Finset + +variable {α : Type*} [DecidableEq α] {S : Finset (List α)} + +/-- The finite set of all prefixes of elements of `S`. -/ +def prefixes (S : Finset (List α)) : Finset (List α) := + S.biUnion fun s => s.inits.toFinset + +/-- The finite set of all suffixes of elements of `S`. -/ +def suffixes (S : Finset (List α)) : Finset (List α) := + S.biUnion fun s => s.tails.toFinset + +theorem mem_prefixes {p : List α} : p ∈ S.prefixes ↔ ∃ s ∈ S, p <+: s := by + simp [prefixes, List.mem_inits] + +theorem mem_suffixes {w : List α} : w ∈ S.suffixes ↔ ∃ s ∈ S, w <:+ s := by + simp [suffixes, List.mem_tails] + +theorem mem_prefixes_self {s : List α} (hs : s ∈ S) : s ∈ S.prefixes := + mem_prefixes.2 ⟨s, hs, List.prefix_rfl⟩ + +theorem mem_suffixes_self {s : List α} (hs : s ∈ S) : s ∈ S.suffixes := + mem_suffixes.2 ⟨s, hs, List.suffix_rfl⟩ + +theorem nil_mem_prefixes (hS : S.Nonempty) : ([] : List α) ∈ S.prefixes := + let ⟨s, hs⟩ := hS + mem_prefixes.2 ⟨s, hs, List.nil_prefix⟩ + +theorem nil_mem_suffixes (hS : S.Nonempty) : ([] : List α) ∈ S.suffixes := + let ⟨s, hs⟩ := hS + mem_suffixes.2 ⟨s, hs, List.nil_suffix⟩ + +/-- `S.prefixes` is downward closed under taking prefixes. -/ +theorem mem_prefixes_of_prefix {p q : List α} (hpq : p <+: q) (hq : q ∈ S.prefixes) : + p ∈ S.prefixes := by + obtain ⟨s, hs, hqs⟩ := mem_prefixes.1 hq + exact mem_prefixes.2 ⟨s, hs, hpq.trans hqs⟩ + +/-- `S.suffixes` is downward closed under taking suffixes. -/ +theorem mem_suffixes_of_suffix {w v : List α} (hwv : w <:+ v) (hv : v ∈ S.suffixes) : + w ∈ S.suffixes := by + obtain ⟨s, hs, hvs⟩ := mem_suffixes.1 hv + exact mem_suffixes.2 ⟨s, hs, hwv.trans hvs⟩ + +end Finset diff --git a/LeanPool/BeyondBethe/Complexitylib/Mathlib/NatBits.lean b/LeanPool/BeyondBethe/Complexitylib/Mathlib/NatBits.lean new file mode 100644 index 0000000000..25a9cbf816 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Mathlib/NatBits.lean @@ -0,0 +1,216 @@ +/- +Copyright (c) 2025 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import Mathlib.Data.Nat.Log +public import Mathlib.Data.Nat.Size +public import Mathlib.Tactic.NormNum.Inv +public import Mathlib.Tactic.NormNum.Pow + +/-! +# Fixed-width binary encodings of natural numbers + +Big-endian, fixed-width binary encoding `Nat.toBits` with its exact decoder +`Nat.fromBits`, plus the little-endian views `Nat.toBitsLE` and +`Nat.fromBitsLE` used by local Turing-machine arithmetic. Both conventions +have exact length, truncation, round-trip, and fixed-width injectivity lemmas. +Values wider than the target width are truncated modulo `2 ^ w`. + +This file lives in `Complexitylib/Mathlib/` because it extends a Mathlib +type in its home (root) namespace — the sanctioned exception to the +`Complexity` root-namespace rule. Its contents are candidates for +upstreaming to Mathlib. +-/ + + +@[expose] public section + +/-- Encode a natural number as a big-endian binary list of exactly `w` bits. + Numbers larger than `2^w - 1` are truncated (mod 2^w). -/ +def Nat.toBits : ℕ → ℕ → List Bool + | 0, _ => [] + | w + 1, val => (val / 2 ^ w % 2 == 1) :: Nat.toBits w val + +theorem Nat.length_toBits : ∀ (w val : ℕ), (Nat.toBits w val).length = w + | 0, _ => rfl + | w + 1, val => by simp [Nat.toBits, Nat.length_toBits w] + +/-- Decode a big-endian binary list to a natural number. -/ +def Nat.fromBits : List Bool → ℕ + | [] => 0 + | b :: rest => (if b then 1 else 0) * 2 ^ rest.length + Nat.fromBits rest + +/-- Decoded values are bounded by `2 ^ length`. -/ +theorem Nat.fromBits_lt_pow_length : ∀ (l : List Bool), Nat.fromBits l < 2 ^ l.length + | [] => by simp [Nat.fromBits] + | b :: rest => by + have ih := Nat.fromBits_lt_pow_length rest + simp only [Nat.fromBits, List.length_cons, pow_succ] + rcases b with _ | _ <;> simp <;> omega + +/-- `fromBits ∘ toBits w` reduces any input modulo `2 ^ w`. -/ +theorem Nat.fromBits_toBits_mod : ∀ (w val : ℕ), + Nat.fromBits (Nat.toBits w val) = val % 2 ^ w + | 0, val => by simp [Nat.toBits, Nat.fromBits, Nat.mod_one] + | w + 1, val => by + have ih := Nat.fromBits_toBits_mod w val + simp only [Nat.toBits, Nat.fromBits, Nat.length_toBits, ih] + have hbit : (val / 2 ^ w) % 2 = if (val / 2 ^ w % 2 == 1) then 1 else 0 := by + rcases Nat.mod_two_eq_zero_or_one (val / 2 ^ w) with h | h <;> simp [h] + have hpow : (2 : ℕ) ^ (w + 1) = 2 ^ w * 2 := by rw [pow_succ] + have hkey : val % 2 ^ (w + 1) = (val / 2 ^ w) % 2 * 2 ^ w + val % 2 ^ w := by + rw [hpow, Nat.mod_mul, Nat.mul_comm (2^w) _, Nat.add_comm] + rw [hkey, ← hbit] + +/-- `Nat.fromBits` is a left inverse of `Nat.toBits` on values below `2 ^ w`. -/ +theorem Nat.fromBits_toBits {w val : ℕ} (hv : val < 2 ^ w) : + Nat.fromBits (Nat.toBits w val) = val := by + rw [Nat.fromBits_toBits_mod, Nat.mod_eq_of_lt hv] + +/-- Adding a multiple of `2^w` does not change the low `w` encoded bits. -/ +theorem Nat.toBits_add_pow_mul : ∀ (w val c : ℕ), + Nat.toBits w (val + c * 2 ^ w) = Nat.toBits w val + | 0, _, _ => rfl + | w + 1, val, c => by + have hrw : val + c * 2 ^ (w + 1) = val + c * 2 * 2 ^ w := by + rw [pow_succ] + simp [Nat.mul_comm, Nat.mul_assoc] + have hdiv : (val + c * 2 * 2 ^ w) / 2 ^ w = val / 2 ^ w + c * 2 := + Nat.add_mul_div_right _ _ (Nat.two_pow_pos w) + simp only [hrw, Nat.toBits, hdiv, List.cons.injEq] + constructor + · rw [Nat.add_mul_mod_self_right] + · exact Nat.toBits_add_pow_mul w val (c * 2) + +/-- Fixed-width encoding recovers every bit list from its decoded value. -/ +theorem Nat.toBits_fromBits : ∀ bits : List Bool, + Nat.toBits bits.length (Nat.fromBits bits) = bits + | [] => rfl + | bit :: rest => by + have hlt := Nat.fromBits_lt_pow_length rest + have hval : Nat.fromBits (bit :: rest) = + Nat.fromBits rest + (if bit then 1 else 0) * 2 ^ rest.length := by + simp only [Nat.fromBits] + exact Nat.add_comm _ _ + simp only [Nat.toBits, List.cons.injEq] + constructor + · rw [hval, Nat.add_mul_div_right _ _ (Nat.two_pow_pos _), Nat.div_eq_of_lt hlt] + cases bit <;> simp + · rw [hval, Nat.toBits_add_pow_mul, Nat.toBits_fromBits rest] + +/-- Decoding is injective among bit lists of the same width. -/ +theorem Nat.fromBits_inj_of_length_eq {first second : List Bool} + (hlen : first.length = second.length) + (hvalue : Nat.fromBits first = Nat.fromBits second) : first = second := by + have hfirst := Nat.toBits_fromBits first + rw [hvalue, hlen] at hfirst + rw [← hfirst, Nat.toBits_fromBits second] + +/-- Little-endian fixed-width bits, with the least significant bit first. -/ +def Nat.toBitsLE (width value : ℕ) : List Bool := + (Nat.toBits width value).reverse + +/-- Decode a little-endian bit list. -/ +def Nat.fromBitsLE (bits : List Bool) : ℕ := + Nat.fromBits bits.reverse + +/-- Little-endian encoding has exactly the requested width. -/ +@[simp] theorem Nat.length_toBitsLE (width value : ℕ) : + (Nat.toBitsLE width value).length = width := by + simp [Nat.toBitsLE, Nat.length_toBits] + +/-- Little-endian decoding of a fixed-width encoding truncates modulo `2^width`. -/ +theorem Nat.fromBitsLE_toBitsLE_mod (width value : ℕ) : + Nat.fromBitsLE (Nat.toBitsLE width value) = value % 2 ^ width := by + simp [Nat.fromBitsLE, Nat.toBitsLE, Nat.fromBits_toBits_mod] + +/-- Little-endian encoding exactly round-trips values that fit the width. -/ +theorem Nat.fromBitsLE_toBitsLE {width value : ℕ} (hvalue : value < 2 ^ width) : + Nat.fromBitsLE (Nat.toBitsLE width value) = value := by + rw [Nat.fromBitsLE_toBitsLE_mod, Nat.mod_eq_of_lt hvalue] + +/-- Every little-endian list is recovered at its own fixed width. -/ +theorem Nat.toBitsLE_fromBitsLE (bits : List Bool) : + Nat.toBitsLE bits.length (Nat.fromBitsLE bits) = bits := by + unfold Nat.toBitsLE Nat.fromBitsLE + rw [show bits.length = bits.reverse.length by simp, + Nat.toBits_fromBits, List.reverse_reverse] + +/-- A little-endian list decodes below `2` raised to its width. -/ +theorem Nat.fromBitsLE_lt_pow_length (bits : List Bool) : + Nat.fromBitsLE bits < 2 ^ bits.length := by + unfold Nat.fromBitsLE + simpa using Nat.fromBits_lt_pow_length bits.reverse + +/-- Little-endian decoding is injective at a fixed width. -/ +theorem Nat.fromBitsLE_inj_of_length_eq {first second : List Bool} + (hlen : first.length = second.length) + (hvalue : Nat.fromBitsLE first = Nat.fromBitsLE second) : first = second := by + have hfirst := Nat.toBitsLE_fromBitsLE first + rw [hvalue, hlen] at hfirst + rw [← hfirst, Nat.toBitsLE_fromBitsLE second] + +private theorem Nat.fromBits_append_singleton : + ∀ (bits : List Bool) (bit : Bool), + Nat.fromBits (bits ++ [bit]) = + 2 * Nat.fromBits bits + (if bit then 1 else 0) + | [], bit => by cases bit <;> simp [Nat.fromBits] + | first :: rest, bit => by + rw [List.cons_append, Nat.fromBits, + Nat.fromBits_append_singleton rest bit] + simp only [List.length_append, List.length_singleton, pow_succ] + cases first <;> simp [Nat.fromBits] + omega + +/-- Little-endian decoding exposes its least-significant head bit. -/ +theorem Nat.fromBitsLE_cons (bit : Bool) (bits : List Bool) : + Nat.fromBitsLE (bit :: bits) = + (if bit then 1 else 0) + 2 * Nat.fromBitsLE bits := by + simp only [Nat.fromBitsLE, List.reverse_cons] + rw [Nat.fromBits_append_singleton] + omega + +/-- Decoding the canonical variable-width little-endian bits recovers the +original natural number. -/ +theorem Nat.fromBitsLE_bits : ∀ value : ℕ, + Nat.fromBitsLE value.bits = value := by + intro value + induction value using Nat.binaryRec' with + | zero => simp [Nat.fromBitsLE, Nat.fromBits] + | bit bit value hvalue ih => + rw [Nat.bits_append_bit value bit hvalue, + Nat.fromBitsLE_cons, ih] + cases bit <;> simp [Nat.bit] + omega + +/-- The minimal fixed-width little-endian encoding is exactly the canonical +variable-width bit list. -/ +theorem Nat.toBitsLE_size (value : ℕ) : + Nat.toBitsLE value.size value = value.bits := by + calc + Nat.toBitsLE value.size value = + Nat.toBitsLE value.bits.length (Nat.fromBitsLE value.bits) := by + congr 1 + · exact (Nat.size_eq_bits_len value).symm + · exact (Nat.fromBitsLE_bits value).symm + _ = value.bits := Nat.toBitsLE_fromBitsLE value.bits + +/-- Binary digit width is at most floor-log base two plus one. -/ +theorem Nat.size_le_log_two_add_one (value : ℕ) : + value.size ≤ Nat.log 2 value + 1 := by + rw [Nat.size_le] + simpa only [Nat.succ_eq_add_one] using + Nat.lt_pow_succ_log_self (b := 2) (by omega) value + +/-- Every positive natural has binary digit width exactly floor-log base two +plus one. -/ +theorem Nat.size_eq_log_two_add_one {value : ℕ} (hvalue : value ≠ 0) : + value.size = Nat.log 2 value + 1 := by + apply le_antisymm (Nat.size_le_log_two_add_one value) + have hlower : Nat.log 2 value < value.size := by + rw [Nat.lt_size] + exact Nat.pow_log_le_self 2 hvalue + omega diff --git a/LeanPool/BeyondBethe/Complexitylib/Models.lean b/LeanPool/BeyondBethe/Complexitylib/Models.lean new file mode 100644 index 0000000000..72afcbed23 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models.lean @@ -0,0 +1,10 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine + +/-! Supporting modules for Beyond the Bethe approximation of the permanent. -/ diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine.lean new file mode 100644 index 0000000000..dbee340369 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine.lean @@ -0,0 +1,365 @@ +/- +Copyright (c) 2025 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Soundness +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Classes +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Step +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.Step +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.ABI +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.Containment +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.DenseOverlay +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.DenseInputLookup +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Containment +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.AddressEq +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryAppend +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryDecode +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryEncode +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryCleanup +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryLookup +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryLookupRestore +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryMissCopy +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryMatch +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryReplace +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryScanStep +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryScan +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Dense +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Dispatch +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Initialization +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.DenseInit +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.DenseDecision +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.DenseBounds +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Decision +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.WordDecode +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.WordEncode +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.Switch.Compiled +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.Hamming +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.GateEval +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.GateStep +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.GateStreamStep +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.Scanner +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.PairValidate +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.LastBit +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.ThreeSATSyntax +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.UnaryDecode + +/-! +# Random access machines (surface) + +This is the public entry point for the library's Random Access Machine (RAM) +model: a register machine with indirect addressing, executed under a +**logarithmic-cost** time measure and a matching space measure. The model, +its executable semantics, and both cost measures are defined in +`Complexitylib.Models.RandomAccessMachine.Defs`; the operational metatheory is +proved in `…/Internal`; the soundness of the cost convention is established in +`…/Soundness`. + +## Main definitions + +- `RAM.Instr`, `RAM.Program`, `RAM.Cfg`, `RAM.step`, `RAM.run` — the model +- `RAM.logTimeUpto`, `RAM.unitTimeUpto`, `RAM.spaceUpto` — the resource measures +- `RAM.Program.DecidesInTime`, `RAM.Program.DecidesInSpace` — deciding a language +- `RAM.DTIME`, `RAM.DSPACE`, `RAM.P` — the RAM time/space classes, over the same + `Language = Set (List Bool)` interface as the Turing-machine classes `DTIME`, + `DSPACE`, so the two families are directly comparable + +## Main results + +- `RAM.logGap_squaring` — the **soundness theorem**: the squaring program family + has unit time `k + 1` but logarithmic time at least `2 ^ k`, so unit cost is + super-polynomially stronger than logarithmic cost. This is the formal reason + the library measures RAM time logarithmically and only then compares it to + Turing time. +- `RAM.unitTimeUpto_le_logTimeUpto` — the step count is always at most the + logarithmic time (every step costs `≥ 1`). +- `RAM.Program.DecidesInTime.mono` — deciding is monotone in the time bound. +- `RAM.run_initCfg_finiteSupport` — the register file keeps finite support + along any run, so the space measure `RAM.Cfg.space` is a genuine finite sum. +- `RAM.TMConfig.decode_encode` — the explicit bounded TM-configuration layout + in RAM registers decodes exactly; registers beyond the state/head/cell blocks + are zero. +- `RAM.TMConfig.Step.compiled_encode_decodes` — the complete bounded dense + transition block compiles to concrete RAM code and decodes to the exact TM + successor with explicit logarithmic-time and peak-space bounds. +- `RAM.TMConfig.Sparse.decode_encode` — the fixed interleaved layout represents + and decodes every tape cell without a bound baked into the representation. +- `RAM.TMConfig.Sparse.loadOps_correct` — the fixed uniform transition prelude + computes runtime cell addresses, preserves the complete representation, and + loads the state and all named head symbols exactly. +- `RAM.TMConfig.Sparse.compiledUntilHalt_correct` — one concrete RAM program, + determined solely by the TM, follows any exact halting TM run and decodes to + its halted configuration with exact compiled cost and space preservation. +- `RAM.TMConfig.Sparse.compiledDecision_correct` — the fixed sparse simulator + includes the public input/output ABI, follows any exact halting TM run, and + returns the Boolean verdict in `R₀` with exact compiled cost and space. +- `RAM.TMConfig.Sparse.compiledDecision_resourceBound` — the same fixed program + has a concrete end-to-end logarithmic-cost and sparse-store bound depending + only on the TM, public input length, and simulated halting-run length. +- `RAM.TMConfig.Sparse.P_subset_RAM_P` — every polynomial-time Turing language + is decided in polynomial logarithmic-cost RAM time by the fixed sparse + simulator. +- `RAM.RegisterStore.Snapshot.decode_run` — a finite sparse address/value + snapshot interpreter preserves canonicality and decodes exactly to the RAM + run; its self-delimiting binary tape codec round-trips with a concrete + quadratic-size envelope. +- `RAM.RegisterStore.Snapshot.encode_run_length_le_logTime` — every reachable + encoded snapshot has an explicit quadratic envelope in initial store size, + fixed program literals, and charged RAM logarithmic time. +- `RAM.RegisterStore.Snapshot.encode_initial_run_length_le_logTime` — the same + envelope starts from the public `RAM.initCfg` ABI with explicit input-length + dependence. +- `RAM.RegisterStore.Machine.wordWidthTM_reachesIn_frame` — the first concrete + reverse-simulation parser phase scans a self-delimiting word's unary width + prefix in exact time, stops on its separator, and produces the width on a + canonical binary work tape. +- `RAM.RegisterStore.Machine.payloadBitTM_reachesIn_frame` — the concrete + payload leaf consumes and appends one fixed-width payload bit while preserving + every unrelated tape. +- `RAM.RegisterStore.Machine.wordPayloadTM_reachesIn_frame` — a canonical + binary counter and preserved width drive that leaf for exactly the payload + length, leaving the source at the next encoded word with an exact runtime. +- `RAM.RegisterStore.Machine.wordDecodeTM_reachesIn_frame_encode` — the complete + decoder consumes one canonical `WordCode.encode` prefix, recovers its payload, + and leaves the following encoded stream untouched; the companion + `wordDecodeTM_prefix_withinAuxSpace` bounds every run prefix's auxiliary + space. +- `RAM.RegisterStore.Machine.wordTargetRewind_reachesIn_frame` — a decoded + append-position payload rewinds to the canonical cell-one read convention in + linear time while preserving every framed tape. +- `TM.binaryEqTM_reachesIn_frame` — two canonical binary work tapes are compared + in linear time, with the equality bit written to a dedicated work tape and + every framed tape preserved. +- `TM.binaryRippleAddTM_reachesIn_frame` — two canonical binary operands are + preserved while their sum is written to a fresh result tape in time linear in + their bit widths, with a literal external frame and all-prefix space bound. +- `RAM.RegisterStore.Machine.entryDecodeTM_reachesIn_frame` — one canonical + sparse address/value entry is decoded in exact time, leaving the following + entry stream untouched; `entryDecodeTM_prefix_withinAuxSpace` bounds every + run prefix's auxiliary space. +- `RAM.RegisterStore.Machine.decodedAddressEqTM_reachesIn_frame` — the decoded + address is rewound and compared with a canonical query in linear time, with + both left markers and every framed tape preserved. +- `RAM.RegisterStore.Machine.entryMatchTM_reachesIn_frame` — one concrete + decode-and-compare unit consumes an encoded sparse entry, exposes its value + and equality flag, preserves a parked frame, and has explicit time/space + bounds ready for bounded iteration. +- `RAM.RegisterStore.Machine.entryMatchReadTM_reachesIn_frame` — the match flag + is rewound to cell one for direct controller inspection while preserving all + decoded scratch contracts and an explicit per-tape head bound. +- `RAM.RegisterStore.Machine.entryScanTM_hoareTime_frame` — one fixed bounded + scanner uses a runtime binary entry count, returns the first matching decoded + value or certifies a miss, and preserves every tape outside its ten-tape + assignment with explicit time and all-prefix space envelopes. +- `RAM.RegisterStore.Machine.entryLookupTM_hoareTime_frame` — the same concrete + scan is packaged as a sparse lookup whose decoded-value tape equals the pure + `RegisterStore.read` result, including the default-zero miss case. +- `RAM.RegisterStore.Machine.entryUpdateTM_hoareTime_frame` — one fixed + runtime-counted controller realizes the pure sparse-store `write`, including + copy, replacement, deletion, absent-address append, exact frames, and an + explicit time/all-prefix space envelope. +- `RAM.RegisterStore.Machine.binaryInstructionUpdateTM_hoareTime_frame` — + width-efficient addition, truncated subtraction, or multiplication feeds its + canonical result directly into sparse update, with no hidden value-counted + copy between phases and with an exact framed runtime. +- `RAM.RegisterStore.Machine.binaryInstructionUpdateTM_retargetOutput_hoareTime_frame` + — the same arithmetic/update kernel can place the updated encoded store on a + fresh work tape while keeping the public output blank and parked. +- `RAM.RegisterStore.Machine.programInstructionTM_hoareTime_frame` — one fixed + finite-control dispatch machine selects the RAM instruction named by the + canonical program counter and realizes its exact sparse snapshot step in a + fresh next-store buffer. +- `RAM.RegisterStore.Machine.programDecisionTM_hoareTime_ramRun` — one fixed + twenty-work-tape machine marshals the public input, iterates exact sparse RAM + steps through the first halt, and writes the RAM verdict to the public output. +- `RAM.RegisterStore.Machine.programDecisionTime_le_envelope` — the complete + simulator has a checked fourth-degree runtime envelope in input length and + charged RAM logarithmic time. +- `RAM.RegisterStore.Machine.denseProgramDecisionTM_hoareTime_ramRun` — the + optimized fixed twenty-work-tape machine keeps the public input immutable and + stores only a sparse tagged mutable overlay while realizing the same RAM run. +- `RAM.RegisterStore.Machine.denseProgramDecisionTime_le_envelope` — the + optimized complete simulator has a checked quadratic envelope in input length + plus charged RAM logarithmic time. +- `RAM.RegisterStore.Machine.RAM_DTIME_subset_DTIME_sq` — whenever `T` + asymptotically dominates `n + 1`, logarithmic-cost `RAM.DTIME(T)` is contained + in multitape `DTIME(T²)`. +- `RAM.RegisterStore.Machine.RAM_P_eq_P` — logarithmic-cost RAM polynomial time + and deterministic multitape Turing polynomial time define the same class. +- `RAM.RegisterStore.Machine.wordEncodeTM_hoareTime_frame` and + `rewindEntryEncodeTM_hoareTime_frame` — canonical or arbitrarily positioned + decoded words and entries are re-emitted in the exact self-delimiting store + codec, with explicit time, space, and external-frame contracts. +- `TM.resetBinaryWorkTM_hoareTime_frame` — an arbitrary cursor over canonical + binary contents is rewound and cleared to the standard blank tape with an + explicit time/space envelope and literal external frame. +- `RAM.Structured.Switch.select_compiled` — finite numeric case dispatch has an + exact selected-branch transition count and transfers explicit logarithmic + cost and space envelopes to concrete RAM code. +- `RAM.TMConfig.Step.loadOps_correct` — the fixed TM-transition block's loading + phase preserves the represented configuration while recovering the finite + state and all named head symbols exactly. +- `RAM.Structured.Exec.compile_correct` — structured source execution compiles + with exact register, logarithmic-time, and peak-space preservation. +- `RAM.Structured.Hamming.compiled_performance` — a verified imperative + Hamming-weight program with an exact transition count, explicit logarithmic + time and peak-space bounds, and end-to-end source-to-RAM resource transfer. +- `RAM.Structured.Hamming.timeBound_bigO_quasilinear` and + `spaceBound_bigO_quasilinear` — both explicit budgets are `O(n · bitlen n)`. +- `RAM.Structured.Scanner.compiled_performance` — a reusable verified compiler + from numeric finite-state scanners to concrete logarithmic-cost RAM programs. +- `RAM.Structured.PairValidate.compiled_performance` — a table-driven + reimplementation of `TM.pairValidateTM`, with exact steps, explicit + logarithmic time/space, and agreement with `validPairEncoding`. +- `RAM.Structured.LastBit.compiled_performance` — a second typed-scanner + instance, agreeing with the existing last-bit languages. +- `RAM.Structured.ThreeSATSyntax.compiled_performance` — the existing 27-state + exact-3-CNF syntax automaton compiled with exact steps and language agreement. +- `RAM.Structured.UnaryDecode.compiled_performance` — a non-regular cursor + decoder for terminated-unary circuit fields, including successful and + truncated-input exits, exact steps, and the decoded suffix position. +- `RAM.Structured.GateEval.compiled_performance` — a branch-free twenty-step + decoded-gate kernel with indirect memo reads and append, exact logarithmic + cost, explicit peak space, and preservation of all existing wire entries. +- `RAM.Structured.GateStep.compiled_performance` — one fixed serialized-gate + program composing two unary cursor calls with the decoded-gate kernel at a + runtime-discovered memo base, with exact transitions and concrete transferred + time/space bounds. +- `RAM.Structured.GateStreamStep.compiled_correct` — the bounded split-layout + admission test: one routine consumes a gate from an arbitrary unread stream, + advances a separate memo, preserves the tail, and transfers its exact source + execution and resource measurements to concrete RAM execution. + +## Relationship to the Turing-machine models + +The RAM shares the library's `Language` interface, so `RAM.DTIME`/`RAM.DSPACE` +and the Turing-machine classes `DTIME`/`DSPACE` speak about the same objects. +The classical two-way simulation bounds that make the models polynomially +equivalent are (Cook–Reckhow, *Time bounded random access machines*, JCSS 7 +(1973), 354–375; van Emde Boas, *Machine models and simulations*, Handbook of +Theoretical Computer Science A, 1990): + +* **Turing machine → RAM.** A `T(n)`-time multi-tape Turing machine is + simulated by a RAM in logarithmic time `O(T(n) · log T(n))`. +* **RAM → Turing machine.** A `T(n)`-time logarithmic-cost RAM is simulated by + a multi-tape Turing machine in time `O(T(n)²)`. + +Both overheads are polynomial, so `RAM.DTIME` and `DTIME` yield the *same* +polynomial-time class: `RAM-P = P`. Under the **unit-cost** measure the +RAM → TM direction fails — `RAM.logGap_squaring` exhibits a program whose +unit-time is linear but whose output already needs exponentially many Turing +steps to write — which is precisely why the model is defined with logarithmic +cost. The bounded dense transition block is proved end to end, including +selected actions, nested dispatch, concrete compilation, and explicit resource +bounds. That block is a bounded program family: its register layout depends on +the tape window, so it cannot by itself witness `RAM.DTIME`, whose program must +be fixed. The uniform replacement now has a fixed sparse interleaved +representation, checked runtime address/loading and action/dispatch layers, a +fixed compiled loop that follows an arbitrary exact halting TM run, and a +checked public-ABI marshaller and verdict extractor. The remaining TM-to-RAM +work is now narrower: the repeated sparse core and complete public +marshaller/extractor share a concrete envelope, a linear-times-word-width cost +theorem, and a checked logarithmic word-width bound. The fixed compiled program +now transfers `TM.DecidesInTime` to `RAM.Program.DecidesInTime`, packages the +result in `RAM.DTIME` at its explicit transformed bound, and proves the class +theorem `P ⊆ RAM.P`. The sharper parametric `DTIME(T)` statement still +requires an explicit input-length domination hypothesis: the public marshaller +necessarily costs `O(n · log n)`, while an arbitrary stated time bound `T` need +not dominate `n`. The reverse simulation is now checked end to end. +Finite-support register functions have canonical sparse snapshots whose binary +tape codec round-trips with an explicit length bound. Fixed lookup, update, +binary-arithmetic, control, cleanup, initialization, iteration, and output +machines realize every RAM instruction and complete halting run on twenty work +tapes. The original sparse public-input ABI retains an explicit fourth-degree +envelope as a simple fallback. The optimized machine instead leaves the dense +public input on its read-only tape and maintains a positive-tagged sparse +mutable overlay. Selected-width step accounting and a decreasing square +potential give a checked `O((n + T(n))²)` public-ABI bound. Consequently, +`RAM_DTIME_subset_DTIME_sq` gives the textbook `RAM.DTIME(T) ⊆ DTIME(T²)` under +the explicit hypothesis `n + 1 = O(T(n))`. Choosing the least halting fuel also +transfers every `RAM.P` decider to `P`; together with the fixed sparse forward +simulator this proves `RAM.RegisterStore.Machine.RAM_P_eq_P`. +-/ + + +public section + +namespace Complexity + +namespace RAM + +/-! ### A worked decider + +The two-instruction program `⟨imm 0 1⟩` overwrites the verdict register with `1` +and then halts (its program counter runs off the end). It decides the universal +language in fixedValue logarithmic time, exercising the full `DecidesInTime` API +end to end. -/ + +/-- The always-accept program: set the verdict register to `1`. -/ +def acceptProg : Program := [Instr.imm 0 1] + +/-- On any input, `acceptProg` halts after one step with verdict `1`. -/ +theorem acceptProg_run (x : List Bool) : + (run acceptProg 1 (initCfg x)).verdict = 1 := by + rfl + +/-- `acceptProg` decides the universal language in fixedValue logarithmic time. -/ +theorem acceptProg_decides : acceptProg.DecidesInTime Set.univ (fun _ => 2) := by + intro x + refine ⟨1, ?_, ?_, ?_, ?_⟩ + · rfl + · rfl + · intro _; rfl + · intro hx; exact absurd (Set.mem_univ x) hx + +/-- The universal language is in `RAM.DTIME` at a fixedValue bound: a witness that + the RAM time classes are inhabited over the shared `Language` interface. -/ +theorem univ_mem_DTIME : Set.univ ∈ DTIME (fun _ => 2) := + ⟨acceptProg, (fun _ => 2), acceptProg_decides, BigO.refl _⟩ + +/-- The always-reject program: set the verdict register to `0`. -/ +def rejectProg : Program := [Instr.imm 0 0] + +/-- On any input, `rejectProg` halts after one step with verdict `0`. -/ +theorem rejectProg_run (x : List Bool) : + (run rejectProg 1 (initCfg x)).verdict = 0 := by rfl + +/-- `rejectProg` decides the empty language in fixedValue logarithmic time, + exercising the rejection side of the `DecidesInTime` API. -/ +theorem rejectProg_decides : rejectProg.DecidesInTime (∅ : Language) (fun _ => 2) := by + intro x + refine ⟨1, ?_, ?_, ?_, ?_⟩ + · rfl + · show (1 : ℕ) ≤ 2; omega + · intro hx; simp at hx + · intro _; rfl + +/-- The empty language is in `RAM.DTIME` at a fixedValue bound (the rejection + counterpart of `univ_mem_DTIME`). -/ +theorem empty_mem_DTIME : (∅ : Language) ∈ DTIME (fun _ => 2) := + ⟨rejectProg, (fun _ => 2), rejectProg_decides, BigO.refl _⟩ + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Classes.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Classes.lean new file mode 100644 index 0000000000..4d8d53bb96 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Classes.lean @@ -0,0 +1,42 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Classes.Defs + +/-! +# Random-access-machine complexity classes + +This surface exposes the logarithmic-cost RAM time and space classes and their +elementary monotonicity properties. +-/ + + +public section + +namespace Complexity + +namespace RAM + + +/-- Deciding in logarithmic time is monotone in the time bound. -/ +theorem Program.DecidesInTime.mono {P : Program} {L : Language} {T T' : ℕ → ℕ} + (hle : ∀ m, T m ≤ T' m) (h : P.DecidesInTime L T) : P.DecidesInTime L T' := by + intro x + obtain ⟨fuel, hhalt, hcost, hyes, hno⟩ := h x + exact ⟨fuel, hhalt, hcost.trans (hle x.length), hyes, hno⟩ + +/-- Deciding in logarithmic space is monotone in the space bound. -/ +theorem Program.DecidesInSpace.mono {P : Program} {L : Language} {S S' : ℕ → ℕ} + (hle : ∀ m, S m ≤ S' m) (h : P.DecidesInSpace L S) : + P.DecidesInSpace L S' := by + intro x + obtain ⟨fuel, hhalt, hspace, hyes, hno⟩ := h x + exact ⟨fuel, hhalt, hspace.trans (hle x.length), hyes, hno⟩ + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Classes/Defs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Classes/Defs.lean new file mode 100644 index 0000000000..d4e3bdaff4 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Classes/Defs.lean @@ -0,0 +1,43 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Defs +public import LeanPool.BeyondBethe.Complexitylib.Asymptotics + +/-! +# Random-access-machine complexity classes: definitions + +This definitions layer places the logarithmic-cost RAM classes over the same +`Language` interface as the Turing-machine classes. It is intentionally +independent of either simulation direction. +-/ + + +@[expose] public section + +namespace Complexity + +namespace RAM + + +/-- `RAM.DTIME(T)` is the class of languages decided by a RAM in logarithmic +time `O(T(n))`. -/ +def DTIME (T : ℕ → ℕ) : Set Language := + {L | ∃ (P : Program) (f : ℕ → ℕ), P.DecidesInTime L f ∧ f =O T} + +/-- `RAM.DSPACE(S)` is the class of languages decided by a RAM in logarithmic +space `O(S(n))`. -/ +def DSPACE (S : ℕ → ℕ) : Set Language := + {L | ∃ (P : Program) (f : ℕ → ℕ), P.DecidesInSpace L f ∧ f =O S} + +/-- `RAM.P` is polynomial logarithmic-cost RAM time. -/ +def P : Set Language := + ⋃ k : ℕ, DTIME (· ^ k) + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Defs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Defs.lean new file mode 100644 index 0000000000..75ab336df2 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Defs.lean @@ -0,0 +1,264 @@ +/- +Copyright (c) 2025 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import Mathlib.Algebra.BigOperators.Finprod +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine +public import Mathlib.Data.Nat.Bits + +/-! +# Random access machines: model and cost measures + +This file defines a Random Access Machine (RAM) — a register machine with +indirect addressing — together with **logarithmic-cost** time and space +measures. The design follows the standard successor/register RAM of +Cook–Reckhow, *Time bounded random access machines* (JCSS 7 (1973), 354–375) +and the textbook presentations of Papadimitriou (*Computational Complexity*, +§2.6) and van Emde Boas (*Machine models and simulations*, Handbook of +Theoretical Computer Science A, 1990). Conventions are adapted for a clean +formalization where a text is silent or divergent, but the *cost measure* is +kept faithful to the literature, because it is exactly the cost measure that +determines whether the model is a sound stand-in for a Turing machine. + +## Why logarithmic cost (the soundness point) + +A RAM stores natural numbers of unbounded magnitude in each register. Under the +naive **unit-cost** measure — one time unit per instruction regardless of +operand size — a RAM can square a register repeatedly to build the number +`2 ^ (2 ^ k)` in `O(k)` steps. That number needs `2 ^ k` bits to write down, so +no Turing machine can even emit it in fewer than `2 ^ k` steps: unit-cost RAM +time is **super-polynomially** stronger than Turing time, and the two models are +*not* polynomially equivalent. Adopting unit cost and then comparing to Turing +machines would be a category error — the exact "reward hacking" this model is +designed to avoid. `RAM.logGap_squaring` in the surface file turns this into a +theorem about this very model. + +The **logarithmic-cost** measure charges each instruction the total bit-length +of the numbers it manipulates (operand *contents* and, for indirect operands, +the runtime *addresses*), plus a base cost of `1` so every step costs at least +one time unit. Under this measure the RAM is polynomially equivalent to the +multi-tape Turing machine of `Complexitylib.Models.TuringMachine`; the precise +two-way simulation bounds are recorded in the surface module +`Complexitylib.Models.RandomAccessMachine`. + +## Main definitions + +- `RAM.Instr` — the instruction set (immediate, `add`/`sub`/`mul`, indirect + `load`/`store`, conditional/unconditional jump, `halt`) +- `RAM.Cfg` — a configuration: a program counter and a register file `ℕ → ℕ` +- `RAM.step`, `RAM.run` — executable single step and fuel-bounded run +- `RAM.bitlen` — the length function `l(v) = Nat.size v` (number of bits) +- `RAM.Instr.logCost` — the logarithmic cost of one instruction in a state +- `RAM.logTimeUpto`, `RAM.unitTimeUpto` — accumulated log-cost / step count +- `RAM.Cfg.space`, `RAM.spaceUpto` — logarithmic-cost space +- `RAM.initCfg` — input convention (length in `R₀`, bits in `R₁ … Rₙ`) +- `RAM.Program.DecidesInTime`, `RAM.Program.DecidesInSpace` — deciding a + `Language` with the verdict read from `R₀`, mirroring `TM.DecidesInTime` + +## Design notes + +- **Register file `ℕ → ℕ`**: total and computable, so programs are executable + witnesses (`#eval`-able). Only finitely many registers are ever nonzero along + a run; this finite-support invariant makes the space measure well defined. +- **`bitlen v = Nat.size v`**: the number of binary digits, with `bitlen 0 = 0`, + `bitlen 1 = 1`, `bitlen (2^k) = k + 1`. Instruction costs add `1` so that each + step costs `≥ 1` regardless of operand sizes. +- **Direct vs. indirect addressing**: register *literals* named in an + instruction (`d`, `s`, `t`, `a`) are program constants, bounded by the program + size, so the cost does not separately charge for them; runtime addresses + (`R a` in `load`/`store`) *are* charged via `bitlen (c.regs a)`. This keeps the + cost within a fixedValue factor of the Cook–Reckhow measure while remaining + sound: every value read, computed, or written is charged its bit-length. +- **Out-of-range `pc` halts**: `curInstr` reads `Instr.halt` when `pc` is past the + program, so a program need not end in `halt` and jumps may target the end. +-/ + + +@[expose] public section + +namespace Complexity + +namespace RAM + +/-- The RAM instruction set. Register indices and jump targets are natural + numbers. `add`/`sub`/`mul` are three-address; `sub` is truncated + subtraction (`Nat` monus). `load`/`store` use *indirect* addressing — the + accessed register index is itself the content of a register — which is what + makes the machine "random access". -/ +inductive Instr where + /-- `imm d v`: set `R d := v` (load an immediate fixedValue). -/ + | imm (d v : ℕ) + /-- `add d s t`: set `R d := R s + R t`. -/ + | add (d s t : ℕ) + /-- `sub d s t`: set `R d := R s ∸ R t` (truncated subtraction). -/ + | sub (d s t : ℕ) + /-- `mul d s t`: set `R d := R s * R t`. -/ + | mul (d s t : ℕ) + /-- `load d a`: indirect load `R d := R (R a)`. -/ + | load (d a : ℕ) + /-- `store a s`: indirect store `R (R a) := R s`. -/ + | store (a s : ℕ) + /-- `jz s tgt`: if `R s = 0` jump to `tgt`, else fall through. -/ + | jz (s tgt : ℕ) + /-- `jmp tgt`: unconditional jump to `tgt`. -/ + | jmp (tgt : ℕ) + /-- `halt`: stop the machine. -/ + | halt + deriving Repr, DecidableEq, Inhabited + +/-- A RAM program is a finite list of instructions, indexed by the program + counter. -/ +abbrev Program := List Instr + +/-- A RAM configuration: the program counter and the register file. Register `i` + currently holds `regs i`. -/ +@[ext] +structure Cfg where + /-- The program counter (index of the next instruction). -/ + pc : ℕ + /-- The register file: `regs i` is the content of register `i`. -/ + regs : ℕ → ℕ + +/-- The length function `l(v)`: the number of binary digits of `v`. + `bitlen 0 = 0`, `bitlen 1 = 1`, `bitlen (2 ^ k) = k + 1`. This is the + quantity charged (per operand) by the logarithmic cost measure. -/ +def bitlen (v : ℕ) : ℕ := Nat.size v + +/-- The instruction the machine is about to execute. A program counter past the + end of the program reads as `halt`, so programs need not end in `halt`. -/ +def curInstr (P : Program) (c : Cfg) : Instr := (P[c.pc]?).getD Instr.halt + +/-- A configuration is halted (for a given program) when the current instruction + is `halt` — including the case of a program counter past the program end. -/ +def Halted (P : Program) (c : Cfg) : Prop := curInstr P c = Instr.halt + +instance (P : Program) (c : Cfg) : Decidable (Halted P c) := by + unfold Halted; infer_instance + +/-- Execute one instruction, producing the successor configuration. `halt` is a + no-op here; `step` only applies this to a non-halted configuration. -/ +def stepInstr : Instr → Cfg → Cfg + | .imm d v, c => { pc := c.pc + 1, regs := Function.update c.regs d v } + | .add d s t, c => { pc := c.pc + 1, regs := Function.update c.regs d (c.regs s + c.regs t) } + | .sub d s t, c => { pc := c.pc + 1, regs := Function.update c.regs d (c.regs s - c.regs t) } + | .mul d s t, c => { pc := c.pc + 1, regs := Function.update c.regs d (c.regs s * c.regs t) } + | .load d a, c => { pc := c.pc + 1, regs := Function.update c.regs d (c.regs (c.regs a)) } + | .store a s, c => { pc := c.pc + 1, regs := Function.update c.regs (c.regs a) (c.regs s) } + | .jz s tgt, c => if c.regs s = 0 then { c with pc := tgt } else { c with pc := c.pc + 1 } + | .jmp tgt, c => { c with pc := tgt } + | .halt, c => c + +/-- Step a RAM by one instruction (a no-op on a halted configuration). -/ +def step (P : Program) (c : Cfg) : Cfg := stepInstr (curInstr P c) c + +/-- The logarithmic cost of executing instruction `i` in configuration `c`: the + base cost `1` plus the bit-length of every value the instruction reads, + computes, or writes (and, for indirect operands, the runtime address). + + This is the crux of the model's soundness: every number the instruction + touches is charged its bit-length, so a run of total log-cost `T` can only + manipulate numbers of bit-length at most `T`. See the module docstring. -/ +def Instr.logCost (i : Instr) (c : Cfg) : ℕ := + match i with + | .imm _ v => bitlen v + 1 + | .add _ s t => bitlen (c.regs s) + bitlen (c.regs t) + bitlen (c.regs s + c.regs t) + 1 + | .sub _ s t => bitlen (c.regs s) + bitlen (c.regs t) + 1 + | .mul _ s t => bitlen (c.regs s) + bitlen (c.regs t) + bitlen (c.regs s * c.regs t) + 1 + | .load _ a => bitlen (c.regs a) + bitlen (c.regs (c.regs a)) + 1 + | .store a s => bitlen (c.regs a) + bitlen (c.regs s) + 1 + | .jz s _ => bitlen (c.regs s) + 1 + | .jmp _ => 1 + | .halt => 1 + +/-- The logarithmic cost of the machine's next step. -/ +def stepLogCost (P : Program) (c : Cfg) : ℕ := (curInstr P c).logCost c + +/-- Fuel-bounded run: execute up to `fuel` steps, stopping early once halted. + Once halted, the configuration is stationary (`run_halted`), so the final + configuration is independent of any fuel large enough to reach a halt. -/ +def run (P : Program) : ℕ → Cfg → Cfg + | 0, c => c + | fuel + 1, c => if Halted P c then c else run P fuel (step P c) + +/-- Accumulated **logarithmic time** over a fuel-bounded run: the sum of the + per-step logarithmic costs of the non-halted steps taken. -/ +def logTimeUpto (P : Program) : ℕ → Cfg → ℕ + | 0, _ => 0 + | fuel + 1, c => if Halted P c then 0 else stepLogCost P c + logTimeUpto P fuel (step P c) + +/-- Accumulated **unit time** over a fuel-bounded run: simply the number of + non-halted steps taken. Provided for contrast with `logTimeUpto`; the gap + between the two is exactly what makes unit cost unsound (see the surface + theorem `RAM.logGap_squaring`). -/ +def unitTimeUpto (P : Program) : ℕ → Cfg → ℕ + | 0, _ => 0 + | fuel + 1, c => if Halted P c then 0 else 1 + unitTimeUpto P fuel (step P c) + +/-- The logarithmic **space content** of a configuration: the total number of + bits needed to name and store every nonzero register — for each nonzero + register `i`, its address bits `bitlen i` plus its content bits + `bitlen (regs i)`. Registers holding `0` are free. The `finsum` is finite + exactly when the register file has finite support, which is an invariant of + every run started from `initCfg` (`run_finiteSupport`). -/ +noncomputable def Cfg.space (c : Cfg) : ℕ := + ∑ᶠ i, (if c.regs i = 0 then 0 else bitlen i + bitlen (c.regs i)) + +/-- Peak logarithmic space over a fuel-bounded run: the maximum space content of + any configuration visited (including the halted one). -/ +noncomputable def spaceUpto (P : Program) : ℕ → Cfg → ℕ + | 0, c => c.space + | fuel + 1, c => if Halted P c then c.space else max c.space (spaceUpto P fuel (step P c)) + +/-- The input convention. On input `x : List Bool`: + * register `0` holds the length `|x|`; + * register `i + 1` holds bit `x[i]` (as `0`/`1`) for `i < |x|`; + * all other registers hold `0`. + + Register `0` doubles as the accumulator/verdict register on output. -/ +def initRegs (x : List Bool) : ℕ → ℕ := fun i => + if i = 0 then x.length + else match x[i - 1]? with + | some b => if b then 1 else 0 + | none => 0 + +/-- The initial configuration on input `x`: program counter `0`, registers set by + `initRegs`. -/ +def initCfg (x : List Bool) : Cfg := { pc := 0, regs := initRegs x } + +/-- A program *halts within `fuel` steps* on `c` when the fuel-bounded run + reaches a halted configuration. -/ +def HaltsIn (P : Program) (c : Cfg) (fuel : ℕ) : Prop := Halted P (run P fuel c) + +/-- A program *halts* on `c` when it halts within some amount of fuel. -/ +def Halts (P : Program) (c : Cfg) : Prop := ∃ fuel, HaltsIn P c fuel + +/-- The **output** of a decider: register `0` at halt. `1` means accept, `0` + means reject. -/ +def Cfg.verdict (c : Cfg) : ℕ := c.regs 0 + +/-- `P` decides `L` within logarithmic time `T(n)`: on every input `x`, the run + halts having spent log-time at most `T |x|`, with verdict `R₀ = 1` when + `x ∈ L` and `R₀ = 0` when `x ∉ L`. Mirrors `TM.DecidesInTime`. -/ +def Program.DecidesInTime (P : Program) (L : Language) (T : ℕ → ℕ) : Prop := + ∀ x, ∃ fuel, + Halted P (run P fuel (initCfg x)) ∧ + logTimeUpto P fuel (initCfg x) ≤ T x.length ∧ + (x ∈ L → (run P fuel (initCfg x)).verdict = 1) ∧ + (x ∉ L → (run P fuel (initCfg x)).verdict = 0) + +/-- `P` decides `L` within logarithmic space `S(n)`: on every input `x`, the run + halts with the correct verdict and peak space at most `S |x|`. Mirrors + `TM.DecidesInSpace`. -/ +def Program.DecidesInSpace (P : Program) (L : Language) (S : ℕ → ℕ) : Prop := + ∀ x, ∃ fuel, + Halted P (run P fuel (initCfg x)) ∧ + spaceUpto P fuel (initCfg x) ≤ S x.length ∧ + (x ∈ L → (run P fuel (initCfg x)).verdict = 1) ∧ + (x ∉ L → (run P fuel (initCfg x)).verdict = 0) + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Internal.lean new file mode 100644 index 0000000000..6ffa470874 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Internal.lean @@ -0,0 +1,282 @@ +/- +Copyright (c) 2025 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Defs +public import Mathlib.Tactic.Ring.RingNF + +/-! +# Random access machines: operational metatheory (proof internals) + +This module proves the structural facts about `RAM.run`, `RAM.logTimeUpto`, +`RAM.unitTimeUpto`, and register support that the surface theorems rely on: + +* **Unfolding lemmas** and the fixed-point behaviour of a halted configuration + (`step_halted`, `run_halted`, `logTimeUpto_halted`, `unitTimeUpto_halted`). +* **Run/cost algebra**: `run_one`, `run_succ_step`, and the additive + decompositions `run_add`, `logTimeUpto_add`, `unitTimeUpto_add`, giving + stationarity of the run and cost once halted, and monotonicity of the cost + in the fuel. +* **Cost lower bounds**: every executed step costs at least one time unit + (`Instr.one_le_logCost`), so the step count never exceeds the logarithmic + time (`unitTimeUpto_le_logTimeUpto`). +* **Finite support**: the register file has finite support along any run from + a finitely-supported start (`run_finiteSupport`), which is what makes the + `finsum`-based space measure `RAM.Cfg.space` a genuine finite sum. + +Not intended for human audit: the definitions in `Defs.lean` and the theorem +statements in the surface module carry the mathematical content. +-/ + + +public section + +namespace Complexity + +namespace RAM + +variable (P : Program) + +/-! ### Unfolding lemmas -/ + +@[simp] theorem run_zero (c : Cfg) : run P 0 c = c := rfl + +@[simp] theorem logTimeUpto_zero (c : Cfg) : logTimeUpto P 0 c = 0 := rfl + +@[simp] theorem unitTimeUpto_zero (c : Cfg) : unitTimeUpto P 0 c = 0 := rfl + +theorem run_succ (fuel : ℕ) (c : Cfg) : + run P (fuel + 1) c = if Halted P c then c else run P fuel (step P c) := rfl + +theorem logTimeUpto_succ (fuel : ℕ) (c : Cfg) : + logTimeUpto P (fuel + 1) c = + if Halted P c then 0 else stepLogCost P c + logTimeUpto P fuel (step P c) := rfl + +theorem unitTimeUpto_succ (fuel : ℕ) (c : Cfg) : + unitTimeUpto P (fuel + 1) c = + if Halted P c then 0 else 1 + unitTimeUpto P fuel (step P c) := rfl + +/-! ### Halted configurations are fixed points -/ + +/-- Stepping a halted configuration is a no-op: `halt` leaves everything fixed. -/ +theorem step_halted {c : Cfg} (h : Halted P c) : step P c = c := by + unfold step + rw [show curInstr P c = Instr.halt from h] + rfl + +/-- Running a halted configuration for any amount of fuel leaves it fixed. -/ +theorem run_halted {c : Cfg} (h : Halted P c) (fuel : ℕ) : run P fuel c = c := by + cases fuel with + | zero => rfl + | succ f => rw [run_succ, if_pos h] + +/-- A halted configuration accumulates no logarithmic time. -/ +theorem logTimeUpto_halted {c : Cfg} (h : Halted P c) (fuel : ℕ) : + logTimeUpto P fuel c = 0 := by + cases fuel with + | zero => rfl + | succ f => rw [logTimeUpto_succ, if_pos h] + +/-- A halted configuration accumulates no unit time. -/ +theorem unitTimeUpto_halted {c : Cfg} (h : Halted P c) (fuel : ℕ) : + unitTimeUpto P fuel c = 0 := by + cases fuel with + | zero => rfl + | succ f => rw [unitTimeUpto_succ, if_pos h] + +/-! ### Run/cost algebra -/ + +/-- One unit of fuel performs exactly one step (a no-op if already halted). -/ +theorem run_one (c : Cfg) : run P 1 c = step P c := by + rw [show (1 : ℕ) = 0 + 1 from rfl, run_succ] + by_cases h : Halted P c + · rw [if_pos h, step_halted P h] + · rw [if_neg h, run_zero] + +/-- The run decomposes additively: `a + b` steps is `b` steps after `a` steps. -/ +theorem run_add (a b : ℕ) (c : Cfg) : run P (a + b) c = run P b (run P a c) := by + induction a generalizing c with + | zero => simp + | succ a ih => + rw [Nat.succ_add, run_succ, run_succ] + by_cases h : Halted P c + · rw [if_pos h, if_pos h] + exact (run_halted P h b).symm + · rw [if_neg h, if_neg h] + exact ih (step P c) + +/-- Running `n + 1` steps is one step after running `n` steps. -/ +theorem run_succ_step (n : ℕ) (c : Cfg) : run P (n + 1) c = step P (run P n c) := by + rw [run_add P n 1, run_one] + +/-- Logarithmic time decomposes additively along the run. -/ +theorem logTimeUpto_add (a b : ℕ) (c : Cfg) : + logTimeUpto P (a + b) c = + logTimeUpto P a c + logTimeUpto P b (run P a c) := by + induction a generalizing c with + | zero => simp + | succ a ih => + rw [Nat.succ_add, logTimeUpto_succ, logTimeUpto_succ, run_succ] + by_cases h : Halted P c + · rw [if_pos h, if_pos h, if_pos h, logTimeUpto_halted P h b] + · rw [if_neg h, if_neg h, if_neg h, ih (step P c)] + ring + +/-- Unit time decomposes additively along the run. -/ +theorem unitTimeUpto_add (a b : ℕ) (c : Cfg) : + unitTimeUpto P (a + b) c = + unitTimeUpto P a c + unitTimeUpto P b (run P a c) := by + induction a generalizing c with + | zero => simp + | succ a ih => + rw [Nat.succ_add, unitTimeUpto_succ, unitTimeUpto_succ, run_succ] + by_cases h : Halted P c + · rw [if_pos h, if_pos h, if_pos h, unitTimeUpto_halted P h b] + · rw [if_neg h, if_neg h, if_neg h, ih (step P c)] + ring + +/-- Once halted after `f` steps, extra fuel does not change the configuration. -/ +theorem run_eq_of_halted_le {c : Cfg} {f f' : ℕ} (hle : f ≤ f') + (h : Halted P (run P f c)) : run P f' c = run P f c := by + obtain ⟨g, rfl⟩ := Nat.le.dest hle + rw [run_add] + exact run_halted P h g + +/-- Once halted after `f` steps, extra fuel does not change the logarithmic time. -/ +theorem logTimeUpto_eq_of_halted_le {c : Cfg} {f f' : ℕ} (hle : f ≤ f') + (h : Halted P (run P f c)) : logTimeUpto P f' c = logTimeUpto P f c := by + obtain ⟨g, rfl⟩ := Nat.le.dest hle + rw [logTimeUpto_add, logTimeUpto_halted P h g, Nat.add_zero] + +/-- Logarithmic time is monotone in the fuel. -/ +theorem logTimeUpto_mono {c : Cfg} {f f' : ℕ} (hle : f ≤ f') : + logTimeUpto P f c ≤ logTimeUpto P f' c := by + obtain ⟨g, rfl⟩ := Nat.le.dest hle + rw [logTimeUpto_add] + exact Nat.le_add_right _ _ + +/-- Unit time is monotone in the fuel. -/ +theorem unitTimeUpto_mono {c : Cfg} {f f' : ℕ} (hle : f ≤ f') : + unitTimeUpto P f c ≤ unitTimeUpto P f' c := by + obtain ⟨g, rfl⟩ := Nat.le.dest hle + rw [unitTimeUpto_add] + exact Nat.le_add_right _ _ + +/-! ### Cost lower bounds -/ + +/-- Every instruction costs at least one time unit under the logarithmic + measure (the base cost). -/ +theorem Instr.one_le_logCost (i : Instr) (c : Cfg) : 1 ≤ i.logCost c := by + cases i <;> simp only [Instr.logCost] <;> omega + +/-- Every executed step costs at least one time unit. -/ +theorem one_le_stepLogCost (c : Cfg) : 1 ≤ stepLogCost P c := + Instr.one_le_logCost _ _ + +/-- The number of steps taken never exceeds the logarithmic time: each step + costs at least one time unit, so log-time dominates the step count. -/ +theorem unitTimeUpto_le_logTimeUpto (fuel : ℕ) (c : Cfg) : + unitTimeUpto P fuel c ≤ logTimeUpto P fuel c := by + induction fuel generalizing c with + | zero => simp + | succ f ih => + rw [unitTimeUpto_succ, logTimeUpto_succ] + by_cases h : Halted P c + · rw [if_pos h, if_pos h] + · rw [if_neg h, if_neg h] + have h1 : 1 ≤ stepLogCost P c := one_le_stepLogCost P c + have h2 := ih (step P c) + omega + +/-- If no halt occurs in the first `fuel` steps, the unit time is exactly the + fuel (every step is counted). -/ +theorem unitTimeUpto_eq_of_not_halted (c : Cfg) (fuel : ℕ) + (h : ∀ j < fuel, ¬ Halted P (run P j c)) : unitTimeUpto P fuel c = fuel := by + induction fuel generalizing c with + | zero => simp + | succ f ih => + have h0 : ¬ Halted P c := h 0 (Nat.succ_pos f) + rw [unitTimeUpto_succ, if_neg h0] + have hrec : unitTimeUpto P f (step P c) = f := by + apply ih + intro j hj + have hstep : run P j (step P c) = run P (j + 1) c := by + rw [run_succ, if_neg h0] + rw [hstep] + exact h (j + 1) (by omega) + rw [hrec] + omega + +/-! ### Finite support of the register file -/ + +/-- The support of an updated function is contained in the support of the + original with the written index inserted. -/ +theorem support_update_subset (f : ℕ → ℕ) (i v : ℕ) : + Function.support (Function.update f i v) ⊆ insert i (Function.support f) := by + intro j hj + simp only [Function.mem_support] at hj + by_cases hji : j = i + · subst hji; exact Set.mem_insert _ _ + · rw [Function.update_of_ne hji] at hj + exact Set.mem_insert_of_mem _ hj + +/-- The initial register file has finite support: only registers `0 … |x|` can + be nonzero. -/ +theorem initRegs_finiteSupport (x : List Bool) : + (Function.support (initRegs x)).Finite := by + apply Set.Finite.subset (Finset.range (x.length + 1)).finite_toSet + intro i hi + simp only [Function.mem_support] at hi + simp only [Finset.coe_range, Set.mem_Iio] + by_contra hlt + rw [not_lt] at hlt + apply hi + have hi0 : i ≠ 0 := by omega + simp only [initRegs, hi0, if_false, List.getElem?_eq_none (show x.length ≤ i - 1 by omega)] + +/-- One instruction preserves finite support of the register file: each + instruction writes at most one register. -/ +theorem stepInstr_finiteSupport (i : Instr) (c : Cfg) + (h : (Function.support c.regs).Finite) : + (Function.support (stepInstr i c).regs).Finite := by + cases i with + | imm d v => exact (h.insert d).subset (support_update_subset c.regs d v) + | add d s t => exact (h.insert d).subset (support_update_subset c.regs d _) + | sub d s t => exact (h.insert d).subset (support_update_subset c.regs d _) + | mul d s t => exact (h.insert d).subset (support_update_subset c.regs d _) + | load d a => exact (h.insert d).subset (support_update_subset c.regs d _) + | store a s => exact (h.insert (c.regs a)).subset (support_update_subset c.regs (c.regs a) _) + | jz s tgt => dsimp only [stepInstr]; split <;> exact h + | jmp tgt => exact h + | halt => exact h + +/-- One step preserves finite support of the register file. -/ +theorem step_finiteSupport (c : Cfg) (h : (Function.support c.regs).Finite) : + (Function.support (step P c).regs).Finite := + stepInstr_finiteSupport _ c h + +/-- Finite support of the register file is a run invariant. -/ +theorem run_finiteSupport (fuel : ℕ) (c : Cfg) + (h : (Function.support c.regs).Finite) : + (Function.support (run P fuel c).regs).Finite := by + induction fuel generalizing c with + | zero => simpa using h + | succ f ih => + rw [run_succ] + split + · exact h + · exact ih (step P c) (step_finiteSupport P c h) + +/-- Finite support along any run started from an initial configuration. This + guarantees `RAM.Cfg.space` is a genuine finite sum, not the `finsum` + fallback value `0`. -/ +theorem run_initCfg_finiteSupport (fuel : ℕ) (x : List Bool) : + (Function.support (run P fuel (initCfg x)).regs).Finite := + run_finiteSupport P fuel (initCfg x) (initRegs_finiteSupport x) + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation.lean new file mode 100644 index 0000000000..8f2f13b473 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation.lean @@ -0,0 +1,10 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig + +/-! Supporting modules for Beyond the Bethe approximation of the permanent. -/ diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore.lean new file mode 100644 index 0000000000..60cee37c94 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore.lean @@ -0,0 +1,313 @@ +/- +Copyright (c) 2025 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Internal + +/-! +# Sparse RAM register stores on Turing tapes + +This module exposes the representation boundary used by the RAM-to-Turing- +machine simulation. A canonical finite list of nonzero address/value pairs +decodes to the RAM model's total register file. Functional reads and writes are +exact, every finite-support register file has a canonical representation, and +the self-delimiting binary snapshot codec round-trips. + +The concrete length theorem is the first resource bridge for the reverse +simulation: if the program counter, entry count, addresses, and values all have +bit-width at most `w`, a snapshot with `m` entries occupies at most +`(m + 1) * (4 * w + 2)` tape cells. +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace RegisterStore + +/-- Sparse writing implements functional update exactly when addresses are +unique. -/ +theorem read_write (store : Store) (hstore : AddressesNodup store) + (address value target : ℕ) : + read (write store address value) target = + Function.update (read store) address value target := + read_write_internal store hstore address value target + +/-- Sparse writing preserves unique addresses and omission of zero values. -/ +theorem write_canonical (store : Store) (hstore : Canonical store) + (address value : ℕ) : + Canonical (write store address value) := + write_canonical_internal store hstore address value + +/-- Decoding after a sparse write is exactly functional update. -/ +theorem decode_write (store : Store) (hstore : AddressesNodup store) + (address value : ℕ) : + decode (write store address value) = Function.update (decode store) address value := + decode_write_internal store hstore address value + +/-- Materializing any finite-support register file gives a canonical exact +representation. -/ +theorem ofRegs_represents (regs : ℕ → ℕ) + (hfinite : (Function.support regs).Finite) : + Represents (ofRegs regs hfinite) regs := + ofRegs_represents_internal regs hfinite + +/-- The canonical public-input store has at most one entry per initialized +register. -/ +theorem initialStore_length_le (input : List Bool) : + (initialStore input).length ≤ input.length + 1 := + initialStore_length_le_internal input + +namespace WordCode + +/-- A canonical word code parses to its value and leaves any suffix untouched. -/ +theorem decodePrefix?_encode_append (value : ℕ) (suffix : List Bool) : + decodePrefix? (encode value ++ suffix) = some (value, suffix) := + decodePrefix?_encode_append_internal value suffix + +/-- One self-delimiting word occupies twice its bit-width plus one cell. -/ +theorem encode_length (value : ℕ) : + (encode value).length = 2 * bitlen value + 1 := + encode_length_internal value + +end WordCode + +namespace Entry + +/-- A canonical address/value code parses exactly and leaves its suffix. -/ +theorem decodePrefix?_encode_append (entry : Entry) (suffix : List Bool) : + decodePrefix? (encode entry ++ suffix) = some (entry, suffix) := + decodePrefix?_encode_append_internal entry suffix + +/-- An encoded entry charges twice the address width, twice the value width, +and two separators. -/ +theorem encode_length (entry : Entry) : + (encode entry).length = 2 * bitlen entry.1 + 2 * bitlen entry.2 + 2 := + encode_length_internal entry + +end Entry + +/-- One sparse write increases the actual encoded store by at most the code of +the address/value pair being written. Replacement and deletion can only make +this estimate smaller. -/ +theorem encodedStoreLength_write_le (store : Store) (address value : ℕ) : + encodedStoreLength (write store address value) ≤ + encodedStoreLength store + (Entry.encode (address, value)).length := + encodedStoreLength_write_le_internal store address value + +namespace Snapshot + +/-- The explicit finite public-input snapshot decodes to `RAM.initCfg`. -/ +theorem initial_represents (input : List Bool) : + (initial input).Represents (RAM.initCfg input) := + initial_represents_internal input + +/-- The public-input snapshot's intrinsic width is at most the width of +`|input| + 1`. -/ +theorem initial_width_le (input : List Bool) : + (initial input).width ≤ bitlen (input.length + 1) := + initial_width_le_internal input + +/-- Materializing a finite-support RAM configuration gives a canonical exact +snapshot. -/ +theorem ofCfg_represents (cfg : Cfg) + (hfinite : (Function.support cfg.regs).Finite) : + (ofCfg cfg hfinite).Represents cfg := + ofCfg_represents_internal cfg hfinite + +/-- One sparse interpreter instruction preserves canonicality. -/ +theorem stepInstr_canonical (instruction : Instr) (snapshot : Snapshot) + (hcanonical : Canonical snapshot.store) : + Canonical (stepInstr instruction snapshot).store := + stepInstr_canonical_internal instruction snapshot hcanonical + +/-- Decoding commutes exactly with one sparse interpreter instruction. -/ +theorem decode_stepInstr (instruction : Instr) (snapshot : Snapshot) + (hcanonical : Canonical snapshot.store) : + (stepInstr instruction snapshot).decode = + RAM.stepInstr instruction snapshot.decode := + decode_stepInstr_internal instruction snapshot hcanonical + +/-- The selected sparse step preserves canonicality. -/ +theorem step_canonical (program : Program) (snapshot : Snapshot) + (hcanonical : Canonical snapshot.store) : + Canonical (snapshot.step program).store := + step_canonical_internal program snapshot hcanonical + +/-- Decoding commutes exactly with the selected RAM step. -/ +theorem decode_step (program : Program) (snapshot : Snapshot) + (hcanonical : Canonical snapshot.store) : + (snapshot.step program).decode = RAM.step program snapshot.decode := + decode_step_internal program snapshot hcanonical + +/-- One sparse interpreter instruction grows the intrinsic width only to the +maximum of the old width plus one, its fixed literal width, and its charged +logarithmic runtime width. -/ +theorem width_stepInstr_le (instruction : Instr) (snapshot : Snapshot) : + (stepInstr instruction snapshot).width ≤ snapshot.stepWidthBound instruction := + width_stepInstr_le_internal instruction snapshot + +/-- A selected sparse step is bounded by the fixed program's literal width and +the RAM step's logarithmic charge. -/ +theorem width_step_le (program : Program) (snapshot : Snapshot) : + (snapshot.step program).width ≤ + max (snapshot.width + 1) + (max (programStaticWidth program) (RAM.stepLogCost program snapshot.decode)) := + width_step_le_internal program snapshot + +/-- Every finite sparse run preserves canonicality. -/ +theorem run_canonical (program : Program) (fuel : ℕ) (snapshot : Snapshot) + (hcanonical : Canonical snapshot.store) : + Canonical (snapshot.run program fuel).store := + run_canonical_internal program fuel snapshot hcanonical + +/-- The complete sparse interpreter run decodes to the executable RAM run. -/ +theorem decode_run (program : Program) (fuel : ℕ) (snapshot : Snapshot) + (hcanonical : Canonical snapshot.store) : + (snapshot.run program fuel).decode = RAM.run program fuel snapshot.decode := + decode_run_internal program fuel snapshot hcanonical + +/-- Each RAM instruction materializes at most one additional sparse entry. -/ +theorem length_run_le (program : Program) (fuel : ℕ) (snapshot : Snapshot) : + Canonical snapshot.store → + (snapshot.run program fuel).store.length ≤ + snapshot.store.length + RAM.unitTimeUpto program fuel snapshot.decode := + length_run_le_internal program fuel snapshot + +/-- Along a canonical sparse run, width grows linearly with executed fuel, the +fixed program literal width, and accumulated logarithmic RAM time. -/ +theorem width_run_le (program : Program) (fuel : ℕ) (snapshot : Snapshot) + (hcanonical : Canonical snapshot.store) : + (snapshot.run program fuel).width ≤ + snapshot.width + RAM.unitTimeUpto program fuel snapshot.decode * + (programStaticWidth program + 1) + + RAM.logTimeUpto program fuel snapshot.decode := + width_run_le_internal program fuel snapshot hcanonical + +/-- The live sparse-store code has amortized growth controlled by the resources actually +charged by the RAM run. In particular, this avoids the spurious product of the +number of entries and the maximum entry width: each executed instruction pays +once for its fixed destination width and for the operand/result bits in its +logarithmic cost. -/ +theorem encodedStoreLength_run_le (program : Program) (fuel : ℕ) + (snapshot : Snapshot) (hcanonical : Canonical snapshot.store) : + encodedStoreLength (snapshot.run program fuel).store ≤ + encodedStoreLength snapshot.store + + 4 * (RAM.unitTimeUpto program fuel snapshot.decode * + (programStaticWidth program + 1) + + RAM.logTimeUpto program fuel snapshot.decode) := + encodedStoreLength_run_le_internal program fuel snapshot hcanonical + +/-- Canonical snapshot serialization round-trips exactly. -/ +theorem decode?_encode (snapshot : Snapshot) : + decode? snapshot.encode = some snapshot := + decode?_encode_internal snapshot + +/-- A width-`w`, `m`-entry RAM snapshot occupies at most +`(m + 1) * (4 * w + 2)` Turing-tape cells. -/ +theorem encode_length_le (snapshot : Snapshot) (width : ℕ) + (hpc : bitlen snapshot.pc ≤ width) + (hcount : bitlen snapshot.store.length ≤ width) + (hstore : ∀ entry ∈ snapshot.store, + bitlen entry.1 ≤ width ∧ bitlen entry.2 ≤ width) : + snapshot.encode.length ≤ (snapshot.store.length + 1) * (4 * width + 2) := + encode_length_le_internal snapshot width hpc hcount hstore + +/-- Every canonical snapshot code satisfies its intrinsic concrete tape-cell +envelope, without external side conditions. -/ +theorem encode_length_le_sizeBound (snapshot : Snapshot) : + snapshot.encode.length ≤ snapshot.sizeBound := + encode_length_le_sizeBound_internal snapshot + +/-- A snapshot code is bounded by its actual live-entry encoding plus the two +header words. This is the width-sensitive alternative to the product envelope +`Snapshot.sizeBound`. -/ +theorem encode_length_le_encodedStore (snapshot : Snapshot) : + snapshot.encode.length ≤ + encodedStoreLength snapshot.store + 4 * snapshot.width + 2 := + encode_length_le_encodedStore_internal snapshot + +/-- Combining the actual live-store charge with the width invariant gives a +linear-in-accumulated-cost representation bound for every canonical sparse +run, relative to the initial sparse encoding. -/ +theorem encode_run_length_le_amortized (program : Program) (fuel : ℕ) + (snapshot : Snapshot) (hcanonical : Canonical snapshot.store) : + (snapshot.run program fuel).encode.length ≤ + encodedStoreLength snapshot.store + 4 * snapshot.width + + 8 * (RAM.unitTimeUpto program fuel snapshot.decode * + (programStaticWidth program + 1) + + RAM.logTimeUpto program fuel snapshot.decode) + 2 := + encode_run_length_le_amortized_internal program fuel snapshot hcanonical + +/-- The materialized public-input store occupies at most one fixed-width entry +per initialized register. This records the current ABI's explicit +`O(n log n)` initialization term. -/ +theorem encodedStoreLength_initial_le (input : List Bool) : + encodedStoreLength (initialStore input) ≤ + (input.length + 1) * (4 * bitlen (input.length + 1) + 2) := + encodedStoreLength_initial_le_internal input + +/-- Public-input specialization of the amortized live-representation bound. +The accumulated part is linear in charged RAM time; the separate +`n * bitlen n` term comes from eagerly materializing all nonzero input +registers in the current snapshot ABI. -/ +theorem encode_initial_run_length_le_amortized + (program : Program) (fuel : ℕ) (input : List Bool) : + ((initial input).run program fuel).encode.length ≤ + (input.length + 1) * (4 * bitlen (input.length + 1) + 2) + + 4 * bitlen (input.length + 1) + + 8 * (RAM.logTimeUpto program fuel (RAM.initCfg input) * + (programStaticWidth program + 2)) + 2 := + encode_initial_run_length_le_amortized_internal program fuel input + +/-- The canonical code of every reachable snapshot has an explicit product +bound: entry count grows by at most one per step, while width grows only with +fixed program literals and charged logarithmic RAM time. -/ +theorem encode_run_length_le (program : Program) (fuel : ℕ) + (snapshot : Snapshot) (hcanonical : Canonical snapshot.store) : + (snapshot.run program fuel).encode.length ≤ + (snapshot.store.length + RAM.unitTimeUpto program fuel snapshot.decode + 1) * + (4 * (snapshot.width + RAM.unitTimeUpto program fuel snapshot.decode * + (programStaticWidth program + 1) + + RAM.logTimeUpto program fuel snapshot.decode) + 2) := + encode_run_length_le_internal program fuel snapshot hcanonical + +/-- Eliminating actual step count via `unitTimeUpto ≤ logTimeUpto` gives a +pure logarithmic-time tape-size envelope. This is the quadratic representation +bound needed by the RAM-to-TM simulation. -/ +theorem encode_run_length_le_logTime (program : Program) (fuel : ℕ) + (snapshot : Snapshot) (hcanonical : Canonical snapshot.store) : + (snapshot.run program fuel).encode.length ≤ + (snapshot.store.length + RAM.logTimeUpto program fuel snapshot.decode + 1) * + (4 * (snapshot.width + RAM.logTimeUpto program fuel snapshot.decode * + (programStaticWidth program + 1) + + RAM.logTimeUpto program fuel snapshot.decode) + 2) := + encode_run_length_le_logTime_internal program fuel snapshot hcanonical + +/-- From the public RAM ABI, every reachable snapshot code has an explicit +quadratic envelope in input length, logarithmic RAM time, and one fixed program +constant. -/ +theorem encode_initial_run_length_le_logTime + (program : Program) (fuel : ℕ) (input : List Bool) : + ((initial input).run program fuel).encode.length ≤ + (input.length + 1 + RAM.logTimeUpto program fuel (RAM.initCfg input) + 1) * + (4 * (bitlen (input.length + 1) + + RAM.logTimeUpto program fuel (RAM.initCfg input) * + (programStaticWidth program + 1) + + RAM.logTimeUpto program fuel (RAM.initCfg input)) + 2) := + encode_initial_run_length_le_logTime_internal program fuel input + +end Snapshot + +end RegisterStore + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Containment.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Containment.lean new file mode 100644 index 0000000000..04e0bbf57f --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Containment.lean @@ -0,0 +1,85 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Containment.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.Containment + +/-! +# RAM-to-TM time-class containment + +The fixed twenty-work-tape simulators transfer logarithmic-cost RAM deciders to +deterministic Turing deciders. The sparse fallback gives the original quartic +polynomial envelope; the dense-input overlay gives the sharp quadratic +parametric containment. Together with the sparse TM-to-RAM compiler, these +establish machine-model robustness of polynomial time. +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace RegisterStore + +namespace Machine + +/-- Evaluating the packaged simulator polynomial gives its concrete runtime +envelope with the supplied polynomial RAM-time bound. -/ +theorem programDecisionPolynomial_eval (program : Program) + (p : Polynomial ℕ) (inputLength : ℕ) : + (programDecisionPolynomial program p).eval inputLength = + programDecisionEnvelope program inputLength (p.eval inputLength) := + programDecisionPolynomial_eval_internal program p inputLength + +/-- Every RAM decider transfers to the fixed sparse Turing simulator with the +explicit fourth-degree envelope around its logarithmic-time bound. -/ +theorem programDecision_decidesInTime + {L : Language} {T : ℕ → ℕ} (program : Program) + (hdecides : program.DecidesInTime L T) : + (programDecisionTM standardControlInstructionTapes program).DecidesInTime L + (fun inputLength => + programDecisionEnvelope program inputLength (T inputLength)) := + programDecision_decidesInTime_internal program hdecides + +/-- Every RAM decider transfers to the optimized fixed dense-input simulator +with an explicit quadratic envelope in input length plus RAM time. -/ +theorem denseProgramDecision_decidesInTime + {L : Language} {T : ℕ → ℕ} (program : Program) + (hdecides : program.DecidesInTime L T) : + (denseProgramDecisionTM standardControlInstructionTapes program).DecidesInTime L + (fun inputLength => + denseProgramDecisionEnvelope program inputLength (T inputLength)) := + denseProgramDecision_decidesInTime_internal program hdecides + +/-- Under the standard assumption that the RAM time bound dominates reading +the input, logarithmic-cost RAM time `T` is contained in deterministic Turing +time `T²`. -/ +theorem RAM_DTIME_subset_DTIME_sq (T : ℕ → ℕ) + (hinput : (fun inputLength => inputLength + 1) =O T) : + RAM.DTIME T ⊆ Complexity.DTIME (fun inputLength => (T inputLength) ^ 2) := + DTIME_subset_DTIME_sq_internal T hinput + +/-- Every polynomial logarithmic-cost RAM language is in deterministic +polynomial Turing time. -/ +theorem RAM_P_subset_P : RAM.P ⊆ Complexity.P := + P_subset_internal + +/-- Polynomial time is invariant between the concrete multitape TM and +logarithmic-cost RAM models formalized in the library. -/ +theorem RAM_P_eq_P : RAM.P = Complexity.P := + Set.Subset.antisymm RAM_P_subset_P + RAM.TMConfig.Sparse.P_subset_RAM_P + +end Machine + +end RegisterStore + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Containment/Defs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Containment/Defs.lean new file mode 100644 index 0000000000..790cf18b75 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Containment/Defs.lean @@ -0,0 +1,80 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Bounds.Defs +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Defs +public import Mathlib.Analysis.SpecialFunctions.Pow.NNReal +public import Mathlib.Tactic.Measurability.Init +public import Mathlib.Tactic.NormNum.BigOperators +public import Mathlib.Tactic.NormNum.Irrational +public import Mathlib.Tactic.NormNum.IsCoprime +public import Mathlib.Tactic.NormNum.IsSquare +public import Mathlib.Tactic.NormNum.LegendreSymbol +public import Mathlib.Tactic.NormNum.ModEq +public import Mathlib.Tactic.NormNum.NatFactorial +public import Mathlib.Tactic.NormNum.NatFib +public import Mathlib.Tactic.NormNum.NatLog +public import Mathlib.Tactic.NormNum.NatSqrt +public import Mathlib.Tactic.NormNum.Ordinal +public import Mathlib.Tactic.NormNum.Parity +public import Mathlib.Tactic.NormNum.Prime +public import Mathlib.Tactic.NormNum.RealSqrt + +/-! +# RAM-to-TM time-class containment -- definitions + +This layer fixes the twenty-work-tape concrete simulator and packages its +fourth-degree resource envelope as a natural polynomial. +-/ + + +@[expose] public section + +namespace Complexity + +namespace RAM + +namespace RegisterStore + +namespace Machine + +/-- The canonical assignment of the eighteen data roles and one disjoint +program-counter role. The complete decision simulator adds one buffer tape, +so the resulting TM has twenty work tapes. -/ +def standardControlInstructionTapes : ControlInstructionTapes 19 where + data := + { idx := fun slot => ⟨slot.val, by omega⟩ + injective := by + intro i j h + apply Fin.ext + simpa using congrArg Fin.val h } + pc := ⟨18, by omega⟩ + pc_ne := by + intro slot h + have hval := congrArg Fin.val h + change 18 = slot.val at hval + omega + +/-- Polynomial obtained by substituting a polynomial RAM-time bound into the +checked concrete simulation envelope. -/ +noncomputable def programDecisionPolynomial (program : Program) + (p : Polynomial ℕ) : + Polynomial ℕ := + Polynomial.C (1000000000 * programResourceMagnitude program) * + (Polynomial.X + + Polynomial.C (programResourceMagnitude program + 2) * p + + Polynomial.C (programResourceMagnitude program + 4)) ^ 4 + +end Machine + +end RegisterStore + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Containment/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Containment/Internal.lean new file mode 100644 index 0000000000..e798c0154b --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Containment/Internal.lean @@ -0,0 +1,224 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.NormalForm +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Classes +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Containment.Defs +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.DenseBounds +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.DenseDecision +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Decision +public import Mathlib.Tactic.ENatToNat +public import Mathlib.Tactic.ReduceModChar +public import Mathlib.Tactic.SetNotationForOrder + +/-! +# RAM-to-TM time-class containment -- proof internals + +The concrete sparse simulator is applied at the first halting fuel. Minimality +makes that fuel equal to unit-cost time, hence no larger than logarithmic RAM +time. This discharges the quantitative side condition of the checked runtime +envelope and lifts the simulation to deterministic polynomial time. +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace RegisterStore + +namespace Machine + +theorem programDecisionPolynomial_eval_internal (program : Program) + (p : Polynomial ℕ) (inputLength : ℕ) : + (programDecisionPolynomial program p).eval inputLength = + programDecisionEnvelope program inputLength (p.eval inputLength) := by + simp [programDecisionPolynomial, programDecisionEnvelope, + programDecisionScale, Polynomial.eval_mul, Polynomial.eval_add, + Polynomial.eval_pow] + ring_nf + exact Or.inl trivial + +theorem programDecision_decidesInTime_internal + {L : Language} {T : ℕ → ℕ} (program : Program) + (hdecides : program.DecidesInTime L T) : + (programDecisionTM standardControlInstructionTapes program).DecidesInTime L + (fun inputLength => + programDecisionEnvelope program inputLength (T inputLength)) := by + intro input + obtain ⟨fuel, hhalted, hcost, hyes, hno⟩ := hdecides input + let haltWitness : ∃ candidate, + RAM.Halted program + (RAM.run program candidate (RAM.initCfg input)) := ⟨fuel, hhalted⟩ + let firstFuel := Nat.find haltWitness + have hfirstHalted : RAM.Halted program + (RAM.run program firstFuel (RAM.initCfg input)) := + Nat.find_spec haltWitness + have hfirstLe : firstFuel ≤ fuel := Nat.find_min' haltWitness hhalted + have hnotHalted : ∀ candidate < firstFuel, + ¬ RAM.Halted program + (RAM.run program candidate (RAM.initCfg input)) := by + intro candidate hcandidate + exact Nat.find_min haltWitness hcandidate + have hunit : RAM.unitTimeUpto program firstFuel (RAM.initCfg input) = + firstFuel := + RAM.unitTimeUpto_eq_of_not_halted program (RAM.initCfg input) firstFuel + hnotHalted + have hfuelCost : firstFuel ≤ + RAM.logTimeUpto program firstFuel (RAM.initCfg input) := by + calc + firstFuel = RAM.unitTimeUpto program firstFuel (RAM.initCfg input) := + hunit.symm + _ ≤ RAM.logTimeUpto program firstFuel (RAM.initCfg input) := + RAM.unitTimeUpto_le_logTimeUpto program firstFuel (RAM.initCfg input) + have hcostMono := RAM.logTimeUpto_mono program + (c := RAM.initCfg input) hfirstLe + have hfirstCost : RAM.logTimeUpto program firstFuel (RAM.initCfg input) ≤ + T input.length := le_trans hcostMono hcost + have hrunEq : RAM.run program fuel (RAM.initCfg input) = + RAM.run program firstFuel (RAM.initCfg input) := + RAM.run_eq_of_halted_le program hfirstLe hfirstHalted + have hmachine := programDecisionTM_hoareTime_ramRun + standardControlInstructionTapes program input firstFuel hfirstHalted + obtain ⟨final, time, htime, hreach, hfinalHalted, houtput⟩ := + hmachine (Tape.init (input.map Γ.ofBool)) + (fun _ => Tape.init []) (Tape.init []) ⟨rfl, rfl, rfl⟩ + have hresource := programDecisionTime_le_envelope + standardControlInstructionTapes program input firstFuel hfirstHalted hfuelCost + have henvelope := programDecisionEnvelope_mono_cost program input.length + (RAM.logTimeUpto program firstFuel (RAM.initCfg input)) (T input.length) + hfirstCost + refine ⟨final, time, le_trans htime (le_trans hresource henvelope), + hreach, hfinalHalted, ?_, ?_⟩ + · intro hmember + rw [houtput, registerVerdictOutput_cell_one] + have hverdict : + (RAM.run program firstFuel (RAM.initCfg input)).verdict = 1 := by + rw [← hrunEq] + exact hyes hmember + rw [hverdict] + decide + · intro hnotMember + rw [houtput, registerVerdictOutput_cell_one] + have hverdict : + (RAM.run program firstFuel (RAM.initCfg input)).verdict = 0 := by + rw [← hrunEq] + exact hno hnotMember + rw [hverdict] + decide + +theorem denseProgramDecision_decidesInTime_internal + {L : Language} {T : ℕ → ℕ} (program : Program) + (hdecides : program.DecidesInTime L T) : + (denseProgramDecisionTM standardControlInstructionTapes program).DecidesInTime L + (fun inputLength => + denseProgramDecisionEnvelope program inputLength (T inputLength)) := by + intro input + obtain ⟨fuel, hhalted, hcost, hyes, hno⟩ := hdecides input + let haltWitness : ∃ candidate, + RAM.Halted program + (RAM.run program candidate (RAM.initCfg input)) := ⟨fuel, hhalted⟩ + let firstFuel := Nat.find haltWitness + have hfirstHalted : RAM.Halted program + (RAM.run program firstFuel (RAM.initCfg input)) := + Nat.find_spec haltWitness + have hfirstLe : firstFuel ≤ fuel := Nat.find_min' haltWitness hhalted + have hnotHalted : ∀ candidate < firstFuel, + ¬ RAM.Halted program + (RAM.run program candidate (RAM.initCfg input)) := by + intro candidate hcandidate + exact Nat.find_min haltWitness hcandidate + have hunit : RAM.unitTimeUpto program firstFuel (RAM.initCfg input) = + firstFuel := + RAM.unitTimeUpto_eq_of_not_halted program (RAM.initCfg input) firstFuel + hnotHalted + have hfuelCost : firstFuel ≤ + RAM.logTimeUpto program firstFuel (RAM.initCfg input) := by + calc + firstFuel = RAM.unitTimeUpto program firstFuel (RAM.initCfg input) := + hunit.symm + _ ≤ RAM.logTimeUpto program firstFuel (RAM.initCfg input) := + RAM.unitTimeUpto_le_logTimeUpto program firstFuel (RAM.initCfg input) + have hcostMono := RAM.logTimeUpto_mono program + (c := RAM.initCfg input) hfirstLe + have hfirstCost : RAM.logTimeUpto program firstFuel (RAM.initCfg input) ≤ + T input.length := le_trans hcostMono hcost + have hrunEq : RAM.run program fuel (RAM.initCfg input) = + RAM.run program firstFuel (RAM.initCfg input) := + RAM.run_eq_of_halted_le program hfirstLe hfirstHalted + have hmachine := denseProgramDecisionTM_hoareTime_ramRun + standardControlInstructionTapes program input firstFuel hfirstHalted + obtain ⟨final, time, htime, hreach, hfinalHalted, houtput⟩ := + hmachine (Tape.init (input.map Γ.ofBool)) + (fun _ => Tape.init []) (Tape.init []) ⟨rfl, rfl, rfl⟩ + have hresource := denseProgramDecisionTime_le_envelope + standardControlInstructionTapes program input firstFuel hfirstHalted hfuelCost + have henvelope := denseProgramDecisionEnvelope_mono_cost program input.length + (RAM.logTimeUpto program firstFuel (RAM.initCfg input)) (T input.length) + hfirstCost + refine ⟨final, time, le_trans htime (le_trans hresource henvelope), + hreach, hfinalHalted, ?_, ?_⟩ + · intro hmember + rw [houtput, registerVerdictOutput_cell_one] + have hverdict : + (RAM.run program firstFuel (RAM.initCfg input)).verdict = 1 := by + rw [← hrunEq] + exact hyes hmember + rw [hverdict] + decide + · intro hnotMember + rw [houtput, registerVerdictOutput_cell_one] + have hverdict : + (RAM.run program firstFuel (RAM.initCfg input)).verdict = 0 := by + rw [← hrunEq] + exact hno hnotMember + rw [hverdict] + decide + +theorem DTIME_subset_DTIME_sq_internal (T : ℕ → ℕ) + (hinput : (fun inputLength => inputLength + 1) =O T) : + RAM.DTIME T ⊆ Complexity.DTIME (fun inputLength => (T inputLength) ^ 2) := by + intro L hL + obtain ⟨program, timeBound, hdecides, htimeBound⟩ := hL + have htm := denseProgramDecision_decidesInTime_internal program hdecides + refine ⟨20, denseProgramDecisionTM standardControlInstructionTapes program, + (fun inputLength => denseProgramDecisionEnvelope program inputLength + (timeBound inputLength)), htm, ?_⟩ + have hsumRaw := BigO.add hinput htimeBound + have hsum : (fun inputLength => inputLength + timeBound inputLength + 1) =O T := by + convert hsumRaw using 1 + ext inputLength + omega + have hsquare := BigO.pow hsum 2 + have hconstant := BigO.const_mul_left + (500000000000 * (programResourceMagnitude program + 1) ^ 4) hsquare + simpa only [denseProgramDecisionEnvelope, Nat.mul_assoc] using hconstant + +theorem P_subset_internal : RAM.P ⊆ Complexity.P := by + intro L hL + obtain ⟨degree, program, timeBound, hdecides, hbigO⟩ := + Set.mem_iUnion.mp hL + obtain ⟨p, hp⟩ := BigO.pow_polynomial_bound hbigO + have hramPolynomial := RAM.Program.DecidesInTime.mono hp hdecides + have htm := programDecision_decidesInTime_internal program hramPolynomial + apply mem_P_iff_decidesInTime_polynomial.mpr + refine ⟨20, programDecisionTM standardControlInstructionTapes program, + programDecisionPolynomial program p, ?_⟩ + simpa only [programDecisionPolynomial_eval_internal] using htm + +end Machine + +end RegisterStore + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Defs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Defs.lean new file mode 100644 index 0000000000..23d6def3a2 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Defs.lean @@ -0,0 +1,311 @@ +/- +Copyright (c) 2025 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Mathlib.NatBits +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Defs +public import Mathlib.Data.Finset.Sort + +/-! +# Sparse RAM register stores on Turing tapes: definitions + +This file defines the auditable representation boundary for simulating a RAM +with a Turing machine. A finite register file is represented by a list of +address/value pairs. Zero-valued registers are omitted. Words use a +self-delimiting binary code consisting of a unary width, a zero separator, and +exactly that many binary payload bits. Thus a word of bit-width `w` occupies +`2 * w + 1` tape cells. + +`Snapshot` adds the program counter to a finite store. Its bit encoding begins +with the program counter and entry count, followed by the address and value of +each entry. The corresponding decoders are total `Option`-valued functions. + +Proofs that the store operations implement functional register reads/writes +and that every codec round-trips live in the internal module. +-/ + + +@[expose] public section + +namespace Complexity + +namespace RAM + +namespace RegisterStore + +namespace Instr + +/-- Maximum bit-width of an instruction's hardwired register indices, +immediate, and jump target. These literals are fixed with the program and are +therefore not charged as runtime indirect addresses by `Instr.logCost`. -/ +def staticWidth : Instr → ℕ + | .imm destination value => max (bitlen destination) (bitlen value) + | .add destination source₀ source₁ + | .sub destination source₀ source₁ + | .mul destination source₀ source₁ => + max (bitlen destination) (max (bitlen source₀) (bitlen source₁)) + | .load destination addressRegister + | .store destination addressRegister => + max (bitlen destination) (bitlen addressRegister) + | .jz source target => max (bitlen source) (bitlen target) + | .jmp target => bitlen target + | .halt => 0 + +end Instr + +/-- Maximum hardwired literal width appearing in a fixed RAM program. -/ +def programStaticWidth : Program → ℕ + | [] => 0 + | instruction :: rest => + max (RegisterStore.Instr.staticWidth instruction) (programStaticWidth rest) + +/-- One sparse register entry: an address paired with its nonzero value. -/ +abbrev Entry := ℕ × ℕ + +/-- A finite sparse register file. -/ +abbrev Store := List Entry + +/-- Read an address from a sparse store, defaulting to zero. -/ +def read : Store → ℕ → ℕ + | [], _ => 0 + | (storedAddress, value) :: rest, address => + if address = storedAddress then value else read rest address + +/-- Write one address in a sparse store. Writing zero removes the entry; +writing a nonzero value replaces the first matching entry or appends a fresh +entry when the address is absent. -/ +def write : Store → ℕ → ℕ → Store + | [], address, value => if value = 0 then [] else [(address, value)] + | entry@(storedAddress, _) :: rest, address, value => + if address = storedAddress then + if value = 0 then rest else (address, value) :: rest + else entry :: write rest address value + +/-- No address occurs twice in a sparse store. -/ +def AddressesNodup (store : Store) : Prop := + (store.map Prod.fst).Nodup + +/-- Every materialized entry carries a nonzero value. -/ +def ValuesNonzero (store : Store) : Prop := + ∀ entry ∈ store, entry.2 ≠ 0 + +/-- A canonical sparse store has unique addresses and omits zero values. -/ +def Canonical (store : Store) : Prop := + AddressesNodup store ∧ ValuesNonzero store + +/-- Decode a sparse store into the RAM model's total register file. -/ +def decode (store : Store) : ℕ → ℕ := + read store + +/-- A finite sparse store represents a total RAM register file exactly. -/ +def Represents (store : Store) (regs : ℕ → ℕ) : Prop := + Canonical store ∧ decode store = regs + +/-- Maximum address/value bit-width materialized in a sparse store. -/ +def maxWidth : Store → ℕ + | [] => 0 + | entry :: rest => + max (bitlen entry.1) (max (bitlen entry.2) (maxWidth rest)) + +/-- Materialize the finite support of a total register file as a sparse store. -/ +noncomputable def ofRegs (regs : ℕ → ℕ) + (hfinite : (Function.support regs).Finite) : Store := + hfinite.toFinset.toList.map fun address => (address, regs address) + +/-- Nonzero public-input registers, selected from the known finite input range. -/ +def initialAddresses (input : List Bool) : Finset ℕ := + (Finset.range (input.length + 1)).filter fun address => initRegs input address ≠ 0 + +/-- Canonical sparse materialization of the RAM public-input register file. -/ +def initialStore (input : List Bool) : Store := + ((initialAddresses input).sort (· ≤ ·)).map fun address => + (address, initRegs input address) + +/-! ## Self-delimiting binary words -/ + +namespace WordCode + +/-- Encode a natural as unary bit-width, a zero separator, and fixed-width +little-endian payload bits. The payload convention matches the library's +canonical binary-arithmetic work tapes. -/ +def encode (value : ℕ) : List Bool := + List.replicate (bitlen value) true ++ + false :: Nat.toBitsLE (bitlen value) value + +/-- Parse the unary-width prefix, then consume exactly that many payload bits. -/ +def decodeAux? : List Bool → ℕ → Option (ℕ × List Bool) + | [], _ => none + | true :: rest, width => decodeAux? rest (width + 1) + | false :: rest, width => + if width ≤ rest.length then + some (Nat.fromBitsLE (rest.take width), rest.drop width) + else + none + +/-- Parse one self-delimiting binary word and return the unconsumed suffix. -/ +def decodePrefix? (bits : List Bool) : Option (ℕ × List Bool) := + decodeAux? bits 0 + +end WordCode + +namespace Entry + +/-- Serialize an address/value entry as two self-delimiting words. -/ +def encode (entry : Entry) : List Bool := + WordCode.encode entry.1 ++ WordCode.encode entry.2 + +/-- Parse one address/value entry and return the unconsumed suffix. -/ +def decodePrefix? (bits : List Bool) : Option (Entry × List Bool) := do + let (address, rest) ← WordCode.decodePrefix? bits + let (value, rest) ← WordCode.decodePrefix? rest + pure ((address, value), rest) + +end Entry + +/-- Number of tape cells occupied by the concatenated self-delimiting codes of +the live sparse-store entries. Unlike `Snapshot.sizeBound`, this charges the +actual width of every entry instead of multiplying the entry count by one +run-wide maximum width. -/ +def encodedStoreLength (store : Store) : ℕ := + (store.flatMap Entry.encode).length + +/-- Parse exactly `count` sparse entries and return the unconsumed suffix. -/ +def decodeEntries? : ℕ → List Bool → Option (Store × List Bool) + | 0, bits => some ([], bits) + | count + 1, bits => do + let (entry, rest) ← Entry.decodePrefix? bits + let (entries, rest) ← decodeEntries? count rest + pure (entry :: entries, rest) + +/-- A finite RAM snapshot: program counter plus sparse register store. -/ +structure Snapshot where + /-- Program counter of the represented RAM configuration. -/ + pc : ℕ + /-- Materialized nonzero register entries. -/ + store : Store + deriving DecidableEq + +namespace Snapshot + +/-- Decode a finite snapshot to a RAM configuration. -/ +def decode (snapshot : Snapshot) : Cfg where + pc := snapshot.pc + regs := RegisterStore.decode snapshot.store + +/-- Serialize a snapshot as program counter, entry count, and entries. -/ +def encode (snapshot : Snapshot) : List Bool := + WordCode.encode snapshot.pc ++ + WordCode.encode snapshot.store.length ++ + snapshot.store.flatMap Entry.encode + +/-- Parse one snapshot prefix and return the unconsumed suffix. -/ +def decodePrefix? (bits : List Bool) : Option (Snapshot × List Bool) := do + let (pc, rest) ← WordCode.decodePrefix? bits + let (count, rest) ← WordCode.decodePrefix? rest + let (store, rest) ← decodeEntries? count rest + pure ({ pc, store }, rest) + +/-- Decode an exact snapshot code, rejecting trailing bits. -/ +def decode? (bits : List Bool) : Option Snapshot := do + let (snapshot, rest) ← decodePrefix? bits + if rest.isEmpty then pure snapshot else none + +/-- A canonical snapshot represents a RAM configuration exactly. -/ +def Represents (snapshot : Snapshot) (cfg : Cfg) : Prop := + RegisterStore.Canonical snapshot.store ∧ snapshot.decode = cfg + +/-- One width envelope for the program counter, entry count, addresses, and +values of a finite snapshot. -/ +def width (snapshot : Snapshot) : ℕ := + max (bitlen snapshot.pc) + (max (bitlen snapshot.store.length) (RegisterStore.maxWidth snapshot.store)) + +/-- Concrete tape-cell envelope for the canonical snapshot encoding. -/ +def sizeBound (snapshot : Snapshot) : ℕ := + (snapshot.store.length + 1) * (4 * snapshot.width + 2) + +/-- One-step width envelope: old width plus one, or a width explicitly exposed +by the instruction literal or its logarithmic runtime charge. -/ +def stepWidthBound (instruction : Instr) (snapshot : Snapshot) : ℕ := + max (snapshot.width + 1) + (max (RegisterStore.Instr.staticWidth instruction) + (instruction.logCost snapshot.decode)) + +/-- Materialize a RAM configuration whose register support is finite. -/ +noncomputable def ofCfg (cfg : Cfg) + (hfinite : (Function.support cfg.regs).Finite) : Snapshot where + pc := cfg.pc + store := RegisterStore.ofRegs cfg.regs hfinite + +/-- Canonical finite snapshot of the RAM public-input configuration. -/ +def initial (input : List Bool) : Snapshot where + pc := 0 + store := RegisterStore.initialStore input + +/-- The instruction selected by a finite snapshot. -/ +def curInstr (program : Program) (snapshot : Snapshot) : Instr := + (program[snapshot.pc]?).getD Instr.halt + +/-- Execute one RAM instruction directly on the sparse finite store. -/ +def stepInstr : Instr → Snapshot → Snapshot + | .imm destination value, snapshot => + { pc := snapshot.pc + 1 + store := write snapshot.store destination value } + | .add destination source₀ source₁, snapshot => + { pc := snapshot.pc + 1 + store := write snapshot.store destination + (read snapshot.store source₀ + read snapshot.store source₁) } + | .sub destination source₀ source₁, snapshot => + { pc := snapshot.pc + 1 + store := write snapshot.store destination + (read snapshot.store source₀ - read snapshot.store source₁) } + | .mul destination source₀ source₁, snapshot => + { pc := snapshot.pc + 1 + store := write snapshot.store destination + (read snapshot.store source₀ * read snapshot.store source₁) } + | .load destination addressRegister, snapshot => + { pc := snapshot.pc + 1 + store := write snapshot.store destination + (read snapshot.store (read snapshot.store addressRegister)) } + | .store addressRegister source, snapshot => + { pc := snapshot.pc + 1 + store := write snapshot.store (read snapshot.store addressRegister) + (read snapshot.store source) } + | .jz source target, snapshot => + if read snapshot.store source = 0 then + { snapshot with pc := target } + else + { snapshot with pc := snapshot.pc + 1 } + | .jmp target, snapshot => + { snapshot with pc := target } + | .halt, snapshot => snapshot + +/-- Execute the selected RAM instruction on a sparse snapshot. -/ +def step (program : Program) (snapshot : Snapshot) : Snapshot := + stepInstr (curInstr program snapshot) snapshot + +/-- A sparse snapshot is halted exactly when its selected instruction is halt. -/ +def Halted (program : Program) (snapshot : Snapshot) : Prop := + curInstr program snapshot = Instr.halt + +instance (program : Program) (snapshot : Snapshot) : Decidable (Halted program snapshot) := by + unfold Halted + infer_instance + +/-- Fuel-bounded sparse execution, stopping at the first halted snapshot. -/ +def run (program : Program) : ℕ → Snapshot → Snapshot + | 0, snapshot => snapshot + | fuel + 1, snapshot => + if Halted program snapshot then snapshot + else run program fuel (step program snapshot) + +end Snapshot + +end RegisterStore + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/DenseOverlay.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/DenseOverlay.lean new file mode 100644 index 0000000000..bb54546670 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/DenseOverlay.lean @@ -0,0 +1,235 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.DenseOverlay.Internal + +/-! +# Dense public input with a sparse mutable overlay + +This module exposes the semantic representation used by the optimized +RAM-to-Turing simulation. The immutable public input is not duplicated in the +mutable snapshot; positive tags make explicit writes of zero distinguishable +from an absent overlay entry. +-/ + + +public section + +namespace Complexity +namespace RAM +namespace RegisterStore +namespace DenseOverlay + +/-- With no mutable entries, reads agree exactly with the public RAM input ABI. -/ +theorem read_empty (input : List Bool) (address : ℕ) : + read input [] address = RAM.initRegs input address := + read_empty_internal input address + +/-- A positive-tag overlay write implements functional update, including an +explicit write of zero over a nonzero public-input bit. -/ +theorem read_write (input : List Bool) (overlay : Store) + (hcanonical : Canonical overlay) (address value : ℕ) : + read input (write overlay address value) = + Function.update (read input overlay) address value := + read_write_internal input overlay hcanonical address value + +/-- Every overlay write preserves unique addresses and positive tags. -/ +theorem write_canonical (overlay : Store) (hcanonical : Canonical overlay) + (address value : ℕ) : Canonical (write overlay address value) := + write_canonical_internal overlay hcanonical address value + +/-- Materializing a positive tag preserves the invariant that register zero +never falls through to the dense input bank. -/ +theorem write_coversZero (overlay : Store) (hcanonical : Canonical overlay) + (hcovers : CoversZero overlay) (address value : ℕ) : + CoversZero (write overlay address value) := + write_coversZero_internal overlay hcanonical hcovers address value + +/-- The empty mutable overlay already decodes to the complete public RAM input +configuration. -/ +theorem Snapshot.initial_decode (input : List Bool) : + (Snapshot.initial input).decode input = RAM.initCfg input := + Snapshot.initial_decode_internal input + +/-- The initial one-entry overlay is canonical. -/ +theorem Snapshot.initial_canonical (input : List Bool) : + Canonical (Snapshot.initial input).overlay := + Snapshot.initial_canonical_internal input + +/-- The initial overlay materializes register zero. -/ +theorem Snapshot.initial_coversZero (input : List Bool) : + CoversZero (Snapshot.initial input).overlay := + Snapshot.initial_coversZero_internal input + +/-- The initial overlay satisfies the full representation invariant. -/ +theorem Snapshot.initial_valid (input : List Bool) : + Valid (Snapshot.initial input).overlay := + Snapshot.initial_valid_internal input + +/-- Decoding commutes exactly with one selected instruction. -/ +theorem Snapshot.decode_stepInstr (input : List Bool) (instruction : Instr) + (snapshot : Snapshot) (hcanonical : Canonical snapshot.overlay) : + (snapshot.stepInstr input instruction).decode input = + RAM.stepInstr instruction (snapshot.decode input) := + Snapshot.decode_stepInstr_internal input instruction snapshot hcanonical + +/-- One selected instruction preserves overlay canonicality. -/ +theorem Snapshot.stepInstr_canonical (input : List Bool) + (instruction : Instr) (snapshot : Snapshot) + (hcanonical : Canonical snapshot.overlay) : + Canonical (snapshot.stepInstr input instruction).overlay := + Snapshot.stepInstr_canonical_internal input instruction snapshot hcanonical + +/-- One selected instruction preserves materialization of register zero. -/ +theorem Snapshot.stepInstr_coversZero (input : List Bool) + (instruction : Instr) (snapshot : Snapshot) + (hvalid : Valid snapshot.overlay) : + CoversZero (snapshot.stepInstr input instruction).overlay := + Snapshot.stepInstr_coversZero_internal input instruction snapshot hvalid + +/-- One selected instruction preserves the full overlay invariant. -/ +theorem Snapshot.stepInstr_valid (input : List Bool) + (instruction : Instr) (snapshot : Snapshot) + (hvalid : Valid snapshot.overlay) : + Valid (snapshot.stepInstr input instruction).overlay := + Snapshot.stepInstr_valid_internal input instruction snapshot hvalid + +/-- Decoding commutes exactly with one program-selected RAM step. -/ +theorem Snapshot.decode_step (program : Program) (input : List Bool) + (snapshot : Snapshot) (hcanonical : Canonical snapshot.overlay) : + (snapshot.step program input).decode input = + RAM.step program (snapshot.decode input) := + Snapshot.decode_step_internal program input snapshot hcanonical + +/-- Every program-selected step preserves overlay canonicality. -/ +theorem Snapshot.step_canonical (program : Program) (input : List Bool) + (snapshot : Snapshot) (hcanonical : Canonical snapshot.overlay) : + Canonical (snapshot.step program input).overlay := + Snapshot.step_canonical_internal program input snapshot hcanonical + +/-- One program-selected step preserves the full overlay invariant. -/ +theorem Snapshot.step_valid (program : Program) (input : List Bool) + (snapshot : Snapshot) (hvalid : Valid snapshot.overlay) : + Valid (snapshot.step program input).overlay := + Snapshot.step_valid_internal program input snapshot hvalid + +/-- A complete fuel-bounded dense-overlay execution decodes to the ordinary +RAM run. -/ +theorem Snapshot.decode_run (program : Program) (input : List Bool) + (fuel : ℕ) (snapshot : Snapshot) + (hcanonical : Canonical snapshot.overlay) : + (snapshot.run program input fuel).decode input = + RAM.run program fuel (snapshot.decode input) := + Snapshot.decode_run_internal program input fuel snapshot hcanonical + +/-- Every fuel-bounded dense-overlay execution remains canonical. -/ +theorem Snapshot.run_canonical (program : Program) (input : List Bool) + (fuel : ℕ) (snapshot : Snapshot) + (hcanonical : Canonical snapshot.overlay) : + Canonical (snapshot.run program input fuel).overlay := + Snapshot.run_canonical_internal program input fuel snapshot hcanonical + +/-- A complete dense-overlay run preserves the full representation invariant. -/ +theorem Snapshot.run_valid (program : Program) (input : List Bool) + (fuel : ℕ) (snapshot : Snapshot) (hvalid : Valid snapshot.overlay) : + Valid (snapshot.run program input fuel).overlay := + Snapshot.run_valid_internal program input fuel snapshot hvalid + +/-- One tagged write adds at most one mutable overlay entry. -/ +theorem write_length_le (overlay : Store) (address value : ℕ) : + (write overlay address value).length ≤ overlay.length + 1 := + write_length_le_internal overlay address value + +/-- One selected instruction adds at most one mutable overlay entry. -/ +theorem Snapshot.length_stepInstr_le (input : List Bool) + (instruction : Instr) (snapshot : Snapshot) : + (snapshot.stepInstr input instruction).overlay.length ≤ + snapshot.overlay.length + 1 := + Snapshot.length_stepInstr_le_internal input instruction snapshot + +/-- A dense-overlay run materializes at most one entry per executed RAM step. -/ +theorem Snapshot.length_run_le (program : Program) (input : List Bool) + (fuel : ℕ) (snapshot : Snapshot) + (hcanonical : Canonical snapshot.overlay) : + (snapshot.run program input fuel).overlay.length ≤ + snapshot.overlay.length + + RAM.unitTimeUpto program fuel (snapshot.decode input) := + Snapshot.length_run_le_internal program input fuel snapshot hcanonical + +/-- A tagged write increases the live overlay code by at most the code of its +address and positive value tag. -/ +theorem encodedStoreLength_write_le (overlay : Store) + (address value : ℕ) : + encodedStoreLength (write overlay address value) ≤ + encodedStoreLength overlay + (Entry.encode (address, value + 1)).length := + encodedStoreLength_write_le_internal overlay address value + +/-- One selected instruction grows the actual live overlay code linearly in +its fixed literal width and its logarithmic RAM charge. -/ +theorem Snapshot.encodedStoreLength_stepInstr_le (input : List Bool) + (instruction : Instr) (snapshot : Snapshot) : + encodedStoreLength (snapshot.stepInstr input instruction).overlay ≤ + encodedStoreLength snapshot.overlay + + 2 * (RegisterStore.Instr.staticWidth instruction + + instruction.logCost (snapshot.decode input) + 1) := + Snapshot.encodedStoreLength_stepInstr_le_internal input instruction snapshot + +/-- One program-selected step satisfies the same live-code bound using the +fixed program's maximum literal width. -/ +theorem Snapshot.encodedStoreLength_step_le (program : Program) + (input : List Bool) (snapshot : Snapshot) : + encodedStoreLength (snapshot.step program input).overlay ≤ + encodedStoreLength snapshot.overlay + + 2 * (programStaticWidth program + + RAM.stepLogCost program (snapshot.decode input) + 1) := + Snapshot.encodedStoreLength_step_le_internal program input snapshot + +/-- The live mutable overlay has amortized encoded growth linear in the work +actually charged by the RAM run; the immutable public input contributes no +repeated sparse-store term. -/ +theorem Snapshot.encodedStoreLength_run_le (program : Program) + (input : List Bool) (fuel : ℕ) (snapshot : Snapshot) + (hcanonical : Canonical snapshot.overlay) : + encodedStoreLength (snapshot.run program input fuel).overlay ≤ + encodedStoreLength snapshot.overlay + + 2 * (RAM.unitTimeUpto program fuel (snapshot.decode input) * + (programStaticWidth program + 1) + + RAM.logTimeUpto program fuel (snapshot.decode input)) := + Snapshot.encodedStoreLength_run_le_internal program input fuel snapshot hcanonical + +/-- Starting from the public ABI, mutable entry count is bounded solely by the +executed step count. -/ +theorem Snapshot.initial_length_run_le (program : Program) + (input : List Bool) (fuel : ℕ) : + ((Snapshot.initial input).run program input fuel).overlay.length ≤ + 1 + RAM.unitTimeUpto program fuel (RAM.initCfg input) := + Snapshot.initial_length_run_le_internal program input fuel + +/-- Starting from the public ABI, live mutable code is linear in accumulated +RAM cost and carries no eager `input.length * bitlen input.length` term. -/ +theorem Snapshot.initial_encodedStoreLength_run_le + (program : Program) (input : List Bool) (fuel : ℕ) : + encodedStoreLength + ((Snapshot.initial input).run program input fuel).overlay ≤ + 2 * bitlen (input.length + 1) + 2 + + 2 * (RAM.unitTimeUpto program fuel (RAM.initCfg input) * + (programStaticWidth program + 1) + + RAM.logTimeUpto program fuel (RAM.initCfg input)) := + Snapshot.initial_encodedStoreLength_run_le_internal program input fuel + +/-- The initial snapshot contains only the two headers and the tagged `R₀` +length entry; public input bits remain in the immutable bank. -/ +theorem Snapshot.initial_encode_length (input : List Bool) : + (Snapshot.initial input).encode.length = + 2 * bitlen (input.length + 1) + 6 := + Snapshot.initial_encode_length_internal input + +end DenseOverlay +end RegisterStore +end RAM +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/DenseOverlay/Defs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/DenseOverlay/Defs.lean new file mode 100644 index 0000000000..599931df34 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/DenseOverlay/Defs.lean @@ -0,0 +1,152 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Defs + +/-! +# Dense public input with a sparse mutable overlay -- definitions + +The ordinary sparse snapshot eagerly materializes every nonzero public-input +register. That representation is convenient but occupies `Theta(n log n)` +cells before the RAM executes a step. This module separates the immutable input +bank from the mutable register overlay. + +An overlay entry `(address, tag)` represents the actual value `tag - 1`. +Because every stored tag is positive, an absent address is distinguishable from +an explicit write of zero (`tag = 1`). Absent reads fall through to the dense +public-input ABI `RAM.initRegs input`. +-/ + + +@[expose] public section + +namespace Complexity +namespace RAM +namespace RegisterStore +namespace DenseOverlay + +/-- Mutable tagged entries layered over the immutable public-input bank. -/ +abbrev Store := RegisterStore.Store + +/-- Read through the sparse tagged overlay, falling back to the public input. -/ +def read (input : List Bool) (overlay : Store) (address : ℕ) : ℕ := + let tag := RegisterStore.read overlay address + if tag = 0 then RAM.initRegs input address else tag - 1 + +/-- Record an explicit mutable value. The positive tag preserves written zero. -/ +def write (overlay : Store) (address value : ℕ) : Store := + RegisterStore.write overlay address (value + 1) + +/-- A valid overlay has unique addresses and positive tags. -/ +abbrev Canonical (overlay : Store) : Prop := RegisterStore.Canonical overlay + +/-- Register zero is materialized in every concrete overlay. This lets the +dense-input lookup specialize its fallback path to positive input addresses. -/ +def CoversZero (overlay : Store) : Prop := + RegisterStore.read overlay 0 ≠ 0 + +/-- Full representation invariant for the mutable overlay. -/ +def Valid (overlay : Store) : Prop := + Canonical overlay ∧ CoversZero overlay + +/-- Decode the dense-input/overlay pair to a total RAM register file. -/ +def decode (input : List Bool) (overlay : Store) : ℕ → ℕ := read input overlay + +/-- A finite mutable overlay plus program counter. The immutable input remains +on the Turing input tape and is not duplicated in this snapshot. -/ +structure Snapshot where + /-- Current RAM program counter. -/ + pc : ℕ + /-- Sparse positive-tag overlay. -/ + overlay : Store + deriving DecidableEq + +namespace Snapshot + +/-- Decode one dense-overlay snapshot against its immutable public input. -/ +def decode (input : List Bool) (snapshot : Snapshot) : RAM.Cfg where + pc := snapshot.pc + regs := DenseOverlay.decode input snapshot.overlay + +/-- Reuse the checked sparse snapshot codec for the tagged mutable overlay. -/ +def encode (snapshot : Snapshot) : List Bool := + RegisterStore.Snapshot.encode { pc := snapshot.pc, store := snapshot.overlay } + +/-- The initial mutable overlay materializes only `R₀ = input.length`; all input +bits remain in the read-only dense bank. The stored positive tag is +`input.length + 1`. -/ +def initial (input : List Bool) : Snapshot := + { pc := 0, overlay := DenseOverlay.write [] 0 input.length } + +/-- Instruction selected by the current program counter. -/ +def curInstr (program : Program) (snapshot : Snapshot) : Instr := + (program[snapshot.pc]?).getD .halt + +/-- Whether the selected instruction is `halt`. -/ +def Halted (program : Program) (snapshot : Snapshot) : Prop := + snapshot.curInstr program = .halt + +instance (program : Program) (snapshot : Snapshot) : + Decidable (snapshot.Halted program) := by + unfold Halted + infer_instance + +/-- Execute one RAM instruction against the decoded input/overlay register +file, recording the result as a positive tag. -/ +def stepInstr (input : List Bool) : Instr → Snapshot → Snapshot + | .imm destination value, snapshot => + { pc := snapshot.pc + 1 + overlay := DenseOverlay.write snapshot.overlay destination value } + | .add destination source₀ source₁, snapshot => + { pc := snapshot.pc + 1 + overlay := DenseOverlay.write snapshot.overlay destination + (DenseOverlay.read input snapshot.overlay source₀ + + DenseOverlay.read input snapshot.overlay source₁) } + | .sub destination source₀ source₁, snapshot => + { pc := snapshot.pc + 1 + overlay := DenseOverlay.write snapshot.overlay destination + (DenseOverlay.read input snapshot.overlay source₀ - + DenseOverlay.read input snapshot.overlay source₁) } + | .mul destination source₀ source₁, snapshot => + { pc := snapshot.pc + 1 + overlay := DenseOverlay.write snapshot.overlay destination + (DenseOverlay.read input snapshot.overlay source₀ * + DenseOverlay.read input snapshot.overlay source₁) } + | .load destination addressRegister, snapshot => + { pc := snapshot.pc + 1 + overlay := DenseOverlay.write snapshot.overlay destination + (DenseOverlay.read input snapshot.overlay + (DenseOverlay.read input snapshot.overlay addressRegister)) } + | .store addressRegister source, snapshot => + { pc := snapshot.pc + 1 + overlay := DenseOverlay.write snapshot.overlay + (DenseOverlay.read input snapshot.overlay addressRegister) + (DenseOverlay.read input snapshot.overlay source) } + | .jz source target, snapshot => + if DenseOverlay.read input snapshot.overlay source = 0 then + { snapshot with pc := target } + else + { snapshot with pc := snapshot.pc + 1 } + | .jmp target, snapshot => { snapshot with pc := target } + | .halt, snapshot => snapshot + +/-- Execute the instruction selected by the current program counter. -/ +def step (program : Program) (input : List Bool) (snapshot : Snapshot) : Snapshot := + snapshot.stepInstr input (snapshot.curInstr program) + +/-- Fuel-bounded dense-overlay execution, stopping once halted. -/ +def run (program : Program) (input : List Bool) : ℕ → Snapshot → Snapshot + | 0, snapshot => snapshot + | fuel + 1, snapshot => + if snapshot.Halted program then snapshot + else run program input fuel (snapshot.step program input) + +end Snapshot +end DenseOverlay +end RegisterStore +end RAM +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/DenseOverlay/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/DenseOverlay/Internal.lean new file mode 100644 index 0000000000..aadb063b47 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/DenseOverlay/Internal.lean @@ -0,0 +1,509 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.DenseOverlay.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Internal + +/-! +# Dense public input with a sparse mutable overlay -- proof internals +-/ + + +public section + +namespace Complexity +namespace RAM +namespace RegisterStore +namespace DenseOverlay + +theorem read_empty_internal (input : List Bool) (address : ℕ) : + read input [] address = RAM.initRegs input address := by + simp [read, RegisterStore.read] + +theorem read_write_internal (input : List Bool) (overlay : Store) + (hcanonical : Canonical overlay) (address value : ℕ) : + read input (write overlay address value) = + Function.update (read input overlay) address value := by + funext target + have htag := RegisterStore.read_write_internal overlay hcanonical.1 + address (value + 1) target + unfold read write + rw [htag] + by_cases htarget : target = address + · subst target + simp + · simp [Function.update, htarget] + +theorem write_canonical_internal (overlay : Store) + (hcanonical : Canonical overlay) (address value : ℕ) : + Canonical (write overlay address value) := by + exact RegisterStore.write_canonical_internal overlay hcanonical address + (value + 1) + +theorem write_coversZero_internal (overlay : Store) + (hcanonical : Canonical overlay) (hcovers : CoversZero overlay) + (address value : ℕ) : CoversZero (write overlay address value) := by + have hread := RegisterStore.read_write_internal overlay hcanonical.1 + address (value + 1) 0 + unfold CoversZero write + rw [hread] + by_cases haddress : address = 0 + · subst address + simp + · simpa [Function.update, haddress, Ne.symm haddress] using hcovers + +theorem Snapshot.initial_decode_internal (input : List Bool) : + (Snapshot.initial input).decode input = RAM.initCfg input := by + apply RAM.Cfg.ext + · rfl + · funext address + change read input (write [] 0 input.length) address = + RAM.initRegs input address + rw [read_write_internal input [] + (by simp [RegisterStore.Canonical, RegisterStore.AddressesNodup, + RegisterStore.ValuesNonzero])] + by_cases haddress : address = 0 + · subst address + simp [Function.update, RAM.initRegs] + · simp [Function.update, haddress, read_empty_internal, RAM.initRegs] + +theorem Snapshot.initial_canonical_internal (input : List Bool) : + Canonical (Snapshot.initial input).overlay := by + exact write_canonical_internal [] + (by simp [RegisterStore.Canonical, RegisterStore.AddressesNodup, + RegisterStore.ValuesNonzero]) 0 input.length + +theorem Snapshot.initial_coversZero_internal (input : List Bool) : + CoversZero (Snapshot.initial input).overlay := by + unfold Snapshot.initial CoversZero DenseOverlay.write + simp [RegisterStore.write, RegisterStore.read] + +theorem Snapshot.initial_valid_internal (input : List Bool) : + Valid (Snapshot.initial input).overlay := + ⟨Snapshot.initial_canonical_internal input, + Snapshot.initial_coversZero_internal input⟩ + +theorem Snapshot.decode_stepInstr_internal (input : List Bool) + (instruction : Instr) (snapshot : Snapshot) + (hcanonical : Canonical snapshot.overlay) : + (snapshot.stepInstr input instruction).decode input = + RAM.stepInstr instruction (snapshot.decode input) := by + cases instruction with + | imm destination value => + apply RAM.Cfg.ext + · rfl + · exact read_write_internal input snapshot.overlay hcanonical + destination value + | add destination source₀ source₁ => + apply RAM.Cfg.ext + · rfl + · exact read_write_internal input snapshot.overlay hcanonical destination _ + | sub destination source₀ source₁ => + apply RAM.Cfg.ext + · rfl + · exact read_write_internal input snapshot.overlay hcanonical destination _ + | mul destination source₀ source₁ => + apply RAM.Cfg.ext + · rfl + · exact read_write_internal input snapshot.overlay hcanonical destination _ + | load destination addressRegister => + apply RAM.Cfg.ext + · rfl + · exact read_write_internal input snapshot.overlay hcanonical destination _ + | store addressRegister source => + apply RAM.Cfg.ext + · rfl + · exact read_write_internal input snapshot.overlay hcanonical _ _ + | jz source target => + simp only [Snapshot.stepInstr, RAM.stepInstr, Snapshot.decode] + split <;> simp_all [DenseOverlay.decode] + | jmp target => rfl + | halt => rfl + +theorem Snapshot.stepInstr_canonical_internal (input : List Bool) + (instruction : Instr) (snapshot : Snapshot) + (hcanonical : Canonical snapshot.overlay) : + Canonical (snapshot.stepInstr input instruction).overlay := by + cases instruction <;> simp only [Snapshot.stepInstr] + all_goals first + | exact write_canonical_internal snapshot.overlay hcanonical _ _ + | split <;> exact hcanonical + | exact hcanonical + +theorem Snapshot.stepInstr_coversZero_internal (input : List Bool) + (instruction : Instr) (snapshot : Snapshot) + (hvalid : Valid snapshot.overlay) : + CoversZero (snapshot.stepInstr input instruction).overlay := by + cases instruction <;> simp only [Snapshot.stepInstr] + all_goals first + | exact write_coversZero_internal snapshot.overlay hvalid.1 hvalid.2 _ _ + | split <;> exact hvalid.2 + | exact hvalid.2 + +theorem Snapshot.stepInstr_valid_internal (input : List Bool) + (instruction : Instr) (snapshot : Snapshot) + (hvalid : Valid snapshot.overlay) : + Valid (snapshot.stepInstr input instruction).overlay := + ⟨Snapshot.stepInstr_canonical_internal input instruction snapshot hvalid.1, + Snapshot.stepInstr_coversZero_internal input instruction snapshot hvalid⟩ + +theorem Snapshot.decode_step_internal (program : Program) (input : List Bool) + (snapshot : Snapshot) (hcanonical : Canonical snapshot.overlay) : + (snapshot.step program input).decode input = + RAM.step program (snapshot.decode input) := by + unfold Snapshot.step RAM.step Snapshot.curInstr RAM.curInstr + rw [Snapshot.decode_stepInstr_internal input _ snapshot hcanonical] + rfl + +theorem Snapshot.step_canonical_internal (program : Program) + (input : List Bool) (snapshot : Snapshot) + (hcanonical : Canonical snapshot.overlay) : + Canonical (snapshot.step program input).overlay := by + exact Snapshot.stepInstr_canonical_internal input _ snapshot hcanonical + +theorem Snapshot.step_valid_internal (program : Program) + (input : List Bool) (snapshot : Snapshot) + (hvalid : Valid snapshot.overlay) : + Valid (snapshot.step program input).overlay := by + exact Snapshot.stepInstr_valid_internal input _ snapshot hvalid + +theorem Snapshot.decode_run_internal (program : Program) (input : List Bool) + (fuel : ℕ) (snapshot : Snapshot) + (hcanonical : Canonical snapshot.overlay) : + (snapshot.run program input fuel).decode input = + RAM.run program fuel (snapshot.decode input) := by + induction fuel generalizing snapshot with + | zero => rfl + | succ fuel ih => + simp only [Snapshot.run, RAM.run] + have hhalted : snapshot.Halted program ↔ + RAM.Halted program (snapshot.decode input) := by + unfold Snapshot.Halted RAM.Halted Snapshot.curInstr RAM.curInstr + rfl + by_cases hhalt : snapshot.Halted program + · rw [if_pos hhalt, if_pos (hhalted.mp hhalt)] + · rw [if_neg hhalt, if_neg (fun h => hhalt (hhalted.mpr h))] + rw [ih (snapshot.step program input) + (Snapshot.step_canonical_internal program input snapshot hcanonical)] + rw [Snapshot.decode_step_internal program input snapshot hcanonical] + +theorem Snapshot.run_canonical_internal (program : Program) + (input : List Bool) (fuel : ℕ) (snapshot : Snapshot) + (hcanonical : Canonical snapshot.overlay) : + Canonical (snapshot.run program input fuel).overlay := by + induction fuel generalizing snapshot with + | zero => exact hcanonical + | succ fuel ih => + simp only [Snapshot.run] + split + · exact hcanonical + · exact ih (snapshot.step program input) + (Snapshot.step_canonical_internal program input snapshot hcanonical) + +theorem Snapshot.run_valid_internal (program : Program) + (input : List Bool) (fuel : ℕ) (snapshot : Snapshot) + (hvalid : Valid snapshot.overlay) : + Valid (snapshot.run program input fuel).overlay := by + induction fuel generalizing snapshot with + | zero => exact hvalid + | succ fuel ih => + simp only [Snapshot.run] + split + · exact hvalid + · exact ih (snapshot.step program input) + (Snapshot.step_valid_internal program input snapshot hvalid) + +private theorem bitlen_succ_le (value : ℕ) : + bitlen (value + 1) ≤ bitlen value + 1 := by + rw [bitlen, bitlen, Nat.size_le] + have hvalue := Nat.lt_size_self value + have hpowPos : 0 < 2 ^ value.size := pow_pos (by omega) _ + rw [pow_succ] + omega + +theorem write_length_le_internal (overlay : Store) (address value : ℕ) : + (write overlay address value).length ≤ overlay.length + 1 := by + induction overlay with + | nil => simp [write, RegisterStore.write] + | cons entry rest ih => + rcases entry with ⟨storedAddress, storedTag⟩ + by_cases haddress : address = storedAddress + · subst address + simp [write, RegisterStore.write] + · have ih' : (RegisterStore.write rest address (value + 1)).length ≤ + rest.length + 1 := by + simpa only [write] using ih + simp only [write, RegisterStore.write, haddress, if_false, + List.length_cons] + omega + +theorem Snapshot.length_stepInstr_le_internal (input : List Bool) + (instruction : Instr) (snapshot : Snapshot) : + (snapshot.stepInstr input instruction).overlay.length ≤ + snapshot.overlay.length + 1 := by + cases instruction with + | imm destination value => + exact write_length_le_internal snapshot.overlay destination value + | add destination source₀ source₁ => + exact write_length_le_internal snapshot.overlay destination _ + | sub destination source₀ source₁ => + exact write_length_le_internal snapshot.overlay destination _ + | mul destination source₀ source₁ => + exact write_length_le_internal snapshot.overlay destination _ + | load destination addressRegister => + exact write_length_le_internal snapshot.overlay destination _ + | store addressRegister source => + exact write_length_le_internal snapshot.overlay _ _ + | jz source target => + simp only [Snapshot.stepInstr] + split <;> simp + | jmp target => simp [Snapshot.stepInstr] + | halt => simp [Snapshot.stepInstr] + +theorem Snapshot.length_run_le_internal (program : Program) + (input : List Bool) (fuel : ℕ) (snapshot : Snapshot) + (hcanonical : Canonical snapshot.overlay) : + (snapshot.run program input fuel).overlay.length ≤ + snapshot.overlay.length + + RAM.unitTimeUpto program fuel (snapshot.decode input) := by + induction fuel generalizing snapshot with + | zero => simp [Snapshot.run, RAM.unitTimeUpto] + | succ fuel ih => + rw [Snapshot.run, RAM.unitTimeUpto] + have hhalted : snapshot.Halted program ↔ + RAM.Halted program (snapshot.decode input) := Iff.rfl + by_cases hhalt : snapshot.Halted program + · rw [if_pos hhalt, if_pos (hhalted.mp hhalt)] + omega + · rw [if_neg hhalt, if_neg (fun h => hhalt (hhalted.mpr h))] + have hstep := Snapshot.length_stepInstr_le_internal input + (snapshot.curInstr program) snapshot + have hstep' : (snapshot.step program input).overlay.length ≤ + snapshot.overlay.length + 1 := by + simpa only [Snapshot.step] using hstep + have hnextCanonical := Snapshot.step_canonical_internal + program input snapshot hcanonical + have hrun := ih (snapshot.step program input) hnextCanonical + rw [Snapshot.decode_step_internal program input snapshot hcanonical] at hrun + omega + +theorem encodedStoreLength_write_le_internal (overlay : Store) + (address value : ℕ) : + encodedStoreLength (write overlay address value) ≤ + encodedStoreLength overlay + (Entry.encode (address, value + 1)).length := by + exact RegisterStore.encodedStoreLength_write_le_internal overlay address + (value + 1) + +theorem Snapshot.encodedStoreLength_stepInstr_le_internal + (input : List Bool) (instruction : Instr) (snapshot : Snapshot) : + encodedStoreLength (snapshot.stepInstr input instruction).overlay ≤ + encodedStoreLength snapshot.overlay + + 2 * (RegisterStore.Instr.staticWidth instruction + + instruction.logCost (snapshot.decode input) + 1) := by + cases instruction with + | imm destination value => + have hwrite := encodedStoreLength_write_le_internal snapshot.overlay + destination value + have hsucc := bitlen_succ_le value + apply le_trans hwrite + rw [Entry.encode_length_internal] + simp only [RegisterStore.Instr.staticWidth, Instr.logCost] + omega + | add destination source₀ source₁ => + have hwrite := encodedStoreLength_write_le_internal snapshot.overlay + destination + (read input snapshot.overlay source₀ + read input snapshot.overlay source₁) + have hsucc := bitlen_succ_le + (read input snapshot.overlay source₀ + read input snapshot.overlay source₁) + apply le_trans hwrite + rw [Entry.encode_length_internal] + simp only [RegisterStore.Instr.staticWidth, Instr.logCost, + Snapshot.decode, DenseOverlay.decode] + omega + | sub destination source₀ source₁ => + have hwrite := encodedStoreLength_write_le_internal snapshot.overlay + destination + (read input snapshot.overlay source₀ - read input snapshot.overlay source₁) + have hsub : bitlen + (read input snapshot.overlay source₀ - read input snapshot.overlay source₁) ≤ + bitlen (read input snapshot.overlay source₀) := + Nat.size_le_size (Nat.sub_le _ _) + have hsucc := bitlen_succ_le + (read input snapshot.overlay source₀ - read input snapshot.overlay source₁) + apply le_trans hwrite + rw [Entry.encode_length_internal] + simp only [RegisterStore.Instr.staticWidth, Instr.logCost, + Snapshot.decode, DenseOverlay.decode] + omega + | mul destination source₀ source₁ => + have hwrite := encodedStoreLength_write_le_internal snapshot.overlay + destination + (read input snapshot.overlay source₀ * read input snapshot.overlay source₁) + have hsucc := bitlen_succ_le + (read input snapshot.overlay source₀ * read input snapshot.overlay source₁) + apply le_trans hwrite + rw [Entry.encode_length_internal] + simp only [RegisterStore.Instr.staticWidth, Instr.logCost, + Snapshot.decode, DenseOverlay.decode] + omega + | load destination addressRegister => + have hwrite := encodedStoreLength_write_le_internal snapshot.overlay + destination + (read input snapshot.overlay (read input snapshot.overlay addressRegister)) + have hsucc := bitlen_succ_le + (read input snapshot.overlay (read input snapshot.overlay addressRegister)) + apply le_trans hwrite + rw [Entry.encode_length_internal] + simp only [RegisterStore.Instr.staticWidth, Instr.logCost, + Snapshot.decode, DenseOverlay.decode] + omega + | store addressRegister source => + have hwrite := encodedStoreLength_write_le_internal snapshot.overlay + (read input snapshot.overlay addressRegister) + (read input snapshot.overlay source) + have hsucc := bitlen_succ_le (read input snapshot.overlay source) + apply le_trans hwrite + rw [Entry.encode_length_internal] + simp only [RegisterStore.Instr.staticWidth, Instr.logCost, + Snapshot.decode, DenseOverlay.decode] + omega + | jz source target => + simp only [Snapshot.stepInstr] + split <;> simp + | jmp target => simp [Snapshot.stepInstr] + | halt => simp [Snapshot.stepInstr] + +private theorem staticWidth_curInstr_le (program : Program) (pc : ℕ) : + RegisterStore.Instr.staticWidth ((program[pc]?).getD Instr.halt) ≤ + programStaticWidth program := by + induction program generalizing pc with + | nil => simp [programStaticWidth, RegisterStore.Instr.staticWidth] + | cons instruction rest ih => + cases pc with + | zero => simp [programStaticWidth] + | succ pc => + simp only [List.getElem?_cons_succ] + exact le_trans (ih pc) (le_max_right _ _) + +theorem Snapshot.encodedStoreLength_step_le_internal (program : Program) + (input : List Bool) (snapshot : Snapshot) : + encodedStoreLength (snapshot.step program input).overlay ≤ + encodedStoreLength snapshot.overlay + + 2 * (programStaticWidth program + + RAM.stepLogCost program (snapshot.decode input) + 1) := by + have hstep := Snapshot.encodedStoreLength_stepInstr_le_internal input + (snapshot.curInstr program) snapshot + have hstatic := staticWidth_curInstr_le program snapshot.pc + apply le_trans hstep + apply Nat.add_le_add_left + have hcost : (snapshot.curInstr program).logCost (snapshot.decode input) = + RAM.stepLogCost program (snapshot.decode input) := rfl + rw [hcost] + exact Nat.mul_le_mul_left 2 + (Nat.add_le_add_right (Nat.add_le_add_right hstatic _) 1) + +theorem Snapshot.encodedStoreLength_run_le_internal (program : Program) + (input : List Bool) (fuel : ℕ) (snapshot : Snapshot) + (hcanonical : Canonical snapshot.overlay) : + encodedStoreLength (snapshot.run program input fuel).overlay ≤ + encodedStoreLength snapshot.overlay + + 2 * (RAM.unitTimeUpto program fuel (snapshot.decode input) * + (programStaticWidth program + 1) + + RAM.logTimeUpto program fuel (snapshot.decode input)) := by + induction fuel generalizing snapshot with + | zero => simp [Snapshot.run, RAM.unitTimeUpto, RAM.logTimeUpto] + | succ fuel ih => + rw [Snapshot.run] + have hhalted : snapshot.Halted program ↔ + RAM.Halted program (snapshot.decode input) := Iff.rfl + by_cases hhalt : snapshot.Halted program + · have hramHalted := hhalted.mp hhalt + simp only [hhalt, hramHalted, if_true, RAM.unitTimeUpto, + RAM.logTimeUpto] + simp + · have hramNotHalted : ¬RAM.Halted program (snapshot.decode input) := + fun h => hhalt (hhalted.mpr h) + rw [if_neg hhalt] + simp only [RAM.unitTimeUpto, RAM.logTimeUpto, hramNotHalted, + if_false] + have hstep := Snapshot.encodedStoreLength_step_le_internal + program input snapshot + have hnextCanonical := Snapshot.step_canonical_internal + program input snapshot hcanonical + have htail := ih (snapshot.step program input) hnextCanonical + have hdecode := Snapshot.decode_step_internal + program input snapshot hcanonical + rw [hdecode] at htail + calc + encodedStoreLength + (Snapshot.run program input fuel + (snapshot.step program input)).overlay ≤ + encodedStoreLength (snapshot.step program input).overlay + + 2 * (RAM.unitTimeUpto program fuel + (RAM.step program (snapshot.decode input)) * + (programStaticWidth program + 1) + + RAM.logTimeUpto program fuel + (RAM.step program (snapshot.decode input))) := htail + _ ≤ (encodedStoreLength snapshot.overlay + + 2 * (programStaticWidth program + + RAM.stepLogCost program (snapshot.decode input) + 1)) + + 2 * (RAM.unitTimeUpto program fuel + (RAM.step program (snapshot.decode input)) * + (programStaticWidth program + 1) + + RAM.logTimeUpto program fuel + (RAM.step program (snapshot.decode input))) := + Nat.add_le_add_right hstep _ + _ = encodedStoreLength snapshot.overlay + + 2 * ((1 + RAM.unitTimeUpto program fuel + (RAM.step program (snapshot.decode input))) * + (programStaticWidth program + 1) + + (RAM.stepLogCost program (snapshot.decode input) + + RAM.logTimeUpto program fuel + (RAM.step program (snapshot.decode input)))) := by ring + +theorem Snapshot.initial_length_run_le_internal (program : Program) + (input : List Bool) (fuel : ℕ) : + ((Snapshot.initial input).run program input fuel).overlay.length ≤ + 1 + RAM.unitTimeUpto program fuel (RAM.initCfg input) := by + have hrun := Snapshot.length_run_le_internal program input fuel + (Snapshot.initial input) (Snapshot.initial_canonical_internal input) + rw [Snapshot.initial_decode_internal input] at hrun + simpa [Snapshot.initial, write, RegisterStore.write] using hrun + +theorem Snapshot.initial_encodedStoreLength_run_le_internal + (program : Program) (input : List Bool) (fuel : ℕ) : + encodedStoreLength + ((Snapshot.initial input).run program input fuel).overlay ≤ + 2 * bitlen (input.length + 1) + 2 + + 2 * (RAM.unitTimeUpto program fuel (RAM.initCfg input) * + (programStaticWidth program + 1) + + RAM.logTimeUpto program fuel (RAM.initCfg input)) := by + have hrun := Snapshot.encodedStoreLength_run_le_internal program input fuel + (Snapshot.initial input) (Snapshot.initial_canonical_internal input) + rw [Snapshot.initial_decode_internal input] at hrun + have hentry : (Entry.encode (0, input.length + 1)).length = + 2 * bitlen (input.length + 1) + 2 := by + rw [Entry.encode_length_internal] + have hz : bitlen 0 = 0 := rfl + simp [hz] + simpa [Snapshot.initial, write, RegisterStore.write, encodedStoreLength, + hentry] using hrun + +theorem Snapshot.initial_encode_length_internal (input : List Bool) : + (Snapshot.initial input).encode.length = + 2 * bitlen (input.length + 1) + 6 := by + rw [Snapshot.encode, Snapshot.initial, RegisterStore.Snapshot.encode] + have hz : bitlen 0 = 0 := rfl + have hone : bitlen 1 = 1 := rfl + simp [write, RegisterStore.write, Entry.encode, WordCode.encode, + Nat.length_toBitsLE, hz, hone] + omega + +end DenseOverlay +end RegisterStore +end RAM +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Internal.lean new file mode 100644 index 0000000000..e051606809 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Internal.lean @@ -0,0 +1,1146 @@ +/- +Copyright (c) 2025 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Internal +public import Mathlib.Algebra.Order.Ring.Nat + +/-! +# Sparse RAM register stores on Turing tapes: proof internals + +This module proves the finite-store semantics and codec round trips exposed by +the surface module. It is not part of the human-audited definitions layer. +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace RegisterStore + +private theorem read_eq_zero_of_not_mem (store : Store) (address : ℕ) + (haddress : address ∉ store.map Prod.fst) : + read store address = 0 := by + induction store with + | nil => rfl + | cons entry rest ih => + rcases entry with ⟨storedAddress, value⟩ + simp only [List.map_cons, List.mem_cons, not_or] at haddress + simp only [read, haddress.1, ↓reduceIte] + exact ih haddress.2 + +theorem read_write_internal (store : Store) (hstore : AddressesNodup store) + (address value target : ℕ) : + read (write store address value) target = + Function.update (read store) address value target := by + induction store with + | nil => + by_cases hvalue : value = 0 <;> by_cases htarget : target = address + · simp [write, read, hvalue, htarget, Function.update] + · simp [write, read, hvalue, htarget, Function.update] + · simp [write, read, hvalue, htarget, Function.update] + · simp [write, read, hvalue, htarget, Function.update] + | cons entry rest ih => + rcases entry with ⟨storedAddress, storedValue⟩ + simp only [AddressesNodup, List.map_cons, List.nodup_cons] at hstore + by_cases haddress : address = storedAddress + · subst address + by_cases hvalue : value = 0 + · subst value + by_cases htarget : target = storedAddress + · subst target + simp only [write, ↓reduceIte, read, Function.update_self] + exact read_eq_zero_of_not_mem rest storedAddress hstore.1 + · simp [write, read, htarget] + · by_cases htarget : target = storedAddress + · subst target + simp [write, read, hvalue] + · simp [write, read, hvalue, htarget] + · by_cases htarget : target = storedAddress + · subst target + have hne : storedAddress ≠ address := Ne.symm haddress + simp [write, read, haddress, hne, Function.update] + · simpa [write, read, haddress, htarget, Function.update] using ih hstore.2 + +private theorem mem_addresses_write (store : Store) (address value target : ℕ) + (htarget : target ∈ (write store address value).map Prod.fst) : + target = address ∨ target ∈ store.map Prod.fst := by + induction store with + | nil => + by_cases hvalue : value = 0 + · simp [write, hvalue] at htarget + · simp [write, hvalue] at htarget + exact Or.inl htarget + | cons entry rest ih => + rcases entry with ⟨storedAddress, storedValue⟩ + by_cases haddress : address = storedAddress + · subst address + by_cases hvalue : value = 0 + · simp [write, hvalue] at htarget ⊢ + exact Or.inr htarget + · simp [write, hvalue] at htarget ⊢ + rcases htarget with htarget | htarget + · exact Or.inl htarget + · exact Or.inr htarget + · simp only [write, haddress, ↓reduceIte, List.map_cons, + List.mem_cons] at htarget ⊢ + rcases htarget with htarget | htarget + · exact Or.inr (Or.inl htarget) + · rcases ih htarget with htarget | htarget + · exact Or.inl htarget + · exact Or.inr (Or.inr htarget) + +theorem write_addressesNodup_internal (store : Store) + (hstore : AddressesNodup store) (address value : ℕ) : + AddressesNodup (write store address value) := by + induction store with + | nil => + by_cases hvalue : value = 0 <;> + simp [AddressesNodup, write, hvalue] + | cons entry rest ih => + rcases entry with ⟨storedAddress, storedValue⟩ + simp only [AddressesNodup, List.map_cons, List.nodup_cons] at hstore + by_cases haddress : address = storedAddress + · subst address + by_cases hvalue : value = 0 + · simpa [AddressesNodup, write, hvalue] using hstore.2 + · simpa [AddressesNodup, write, hvalue] using hstore + · simp only [write, haddress, ↓reduceIte, AddressesNodup, + List.map_cons, List.nodup_cons] + refine ⟨?_, ih hstore.2⟩ + intro hmem + rcases mem_addresses_write rest address value storedAddress hmem with + heq | hmem + · exact haddress heq.symm + · exact hstore.1 hmem + +theorem write_valuesNonzero_internal (store : Store) + (hstore : ValuesNonzero store) (address value : ℕ) : + ValuesNonzero (write store address value) := by + induction store with + | nil => + by_cases hvalue : value = 0 <;> + simp [ValuesNonzero, write, hvalue] + | cons entry rest ih => + rcases entry with ⟨storedAddress, storedValue⟩ + have hstored : storedValue ≠ 0 := hstore (storedAddress, storedValue) (by simp) + have hrest : ValuesNonzero rest := by + intro restEntry hmem + exact hstore restEntry (by simp [hmem]) + by_cases haddress : address = storedAddress + · subst address + by_cases hvalue : value = 0 + · simpa [write, hvalue] using hrest + · simp only [write, hvalue, ↓reduceIte] + intro current hmem + rcases List.mem_cons.mp hmem with heq | hmem + · subst current + exact hvalue + · exact hrest current hmem + · simp only [write, haddress, ↓reduceIte] + intro current hmem + rcases List.mem_cons.mp hmem with heq | hmem + · subst current + exact hstored + · exact ih hrest current hmem + +theorem write_canonical_internal (store : Store) (hstore : Canonical store) + (address value : ℕ) : + Canonical (write store address value) := by + exact ⟨write_addressesNodup_internal store hstore.1 address value, + write_valuesNonzero_internal store hstore.2 address value⟩ + +theorem decode_write_internal (store : Store) (hstore : AddressesNodup store) + (address value : ℕ) : + decode (write store address value) = Function.update (decode store) address value := by + funext target + exact read_write_internal store hstore address value target + +private theorem read_map_entries_of_mem (addresses : List ℕ) (regs : ℕ → ℕ) + (address : ℕ) (haddress : address ∈ addresses) : + read (addresses.map fun current => (current, regs current)) address = regs address := by + induction addresses with + | nil => simp at haddress + | cons current rest ih => + simp only [List.mem_cons] at haddress + rcases haddress with haddress | haddress + · subst current + simp [read] + · by_cases heq : address = current + · subst current + simp [read] + · simp [read, heq, ih haddress] + +theorem ofRegs_canonical_internal (regs : ℕ → ℕ) + (hfinite : (Function.support regs).Finite) : + Canonical (ofRegs regs hfinite) := by + constructor + · unfold AddressesNodup ofRegs + simpa [Function.comp_def] using + hfinite.toFinset.nodup_toList + · intro entry hentry + rcases entry with ⟨address, value⟩ + simp only [ofRegs, List.mem_map] at hentry + obtain ⟨storedAddress, hstored, heq⟩ := hentry + simp only [Prod.mk.injEq] at heq + rcases heq with ⟨rfl, rfl⟩ + exact Function.mem_support.mp + (hfinite.mem_toFinset.mp (Finset.mem_toList.mp hstored)) + +theorem decode_ofRegs_internal (regs : ℕ → ℕ) + (hfinite : (Function.support regs).Finite) : + decode (ofRegs regs hfinite) = regs := by + funext address + by_cases haddress : address ∈ Function.support regs + · unfold ofRegs + apply read_map_entries_of_mem + rw [Finset.mem_toList, hfinite.mem_toFinset] + exact haddress + · have hnotmem : address ∉ (ofRegs regs hfinite).map Prod.fst := by + unfold ofRegs + simpa [Function.comp_def, hfinite.mem_toFinset] using haddress + rw [decode, read_eq_zero_of_not_mem _ _ hnotmem] + have hzero : ¬regs address ≠ 0 := by + simpa only [Function.mem_support] using haddress + by_contra hne + exact hzero (Ne.symm hne) + +theorem ofRegs_represents_internal (regs : ℕ → ℕ) + (hfinite : (Function.support regs).Finite) : + Represents (ofRegs regs hfinite) regs := + ⟨ofRegs_canonical_internal regs hfinite, decode_ofRegs_internal regs hfinite⟩ + +private theorem initRegs_ne_zero_address_lt (input : List Bool) (address : ℕ) + (hvalue : initRegs input address ≠ 0) : + address < input.length + 1 := by + by_contra hlt + rw [not_lt] at hlt + have haddress : address ≠ 0 := by omega + apply hvalue + simp only [initRegs, haddress, if_false] + rw [List.getElem?_eq_none (show input.length ≤ address - 1 by omega)] + +private theorem initRegs_le_length_add_one (input : List Bool) (address : ℕ) : + initRegs input address ≤ input.length + 1 := by + simp only [initRegs] + split + · omega + · split + · split <;> omega + · omega + +theorem initialStore_canonical_internal (input : List Bool) : + Canonical (initialStore input) := by + constructor + · unfold AddressesNodup initialStore + simp [Function.comp_def] + · intro entry hentry + rcases entry with ⟨address, value⟩ + simp only [initialStore, List.mem_map] at hentry + obtain ⟨storedAddress, hstored, heq⟩ := hentry + simp only [Prod.mk.injEq] at heq + rcases heq with ⟨rfl, rfl⟩ + exact (Finset.mem_filter.mp + ((Finset.mem_sort (r := (· ≤ ·))).mp hstored)).2 + +theorem decode_initialStore_internal (input : List Bool) : + decode (initialStore input) = initRegs input := by + funext address + by_cases hvalue : initRegs input address = 0 + · have hnotmem : address ∉ (initialStore input).map Prod.fst := by + unfold initialStore + simp [Function.comp_def, initialAddresses, hvalue] + rw [decode, read_eq_zero_of_not_mem _ _ hnotmem, hvalue] + · apply read_map_entries_of_mem + rw [Finset.mem_sort (r := (· ≤ ·)), initialAddresses, + Finset.mem_filter, Finset.mem_range] + exact ⟨initRegs_ne_zero_address_lt input address hvalue, hvalue⟩ + +theorem Snapshot.initial_represents_internal (input : List Bool) : + (Snapshot.initial input).Represents (RAM.initCfg input) := by + constructor + · exact initialStore_canonical_internal input + · apply Cfg.ext + · rfl + · exact decode_initialStore_internal input + +theorem initialStore_length_le_internal (input : List Bool) : + (initialStore input).length ≤ input.length + 1 := by + unfold initialStore initialAddresses + simp only [List.length_map, Finset.length_sort] + simpa using Finset.card_filter_le (Finset.range (input.length + 1)) + (fun address => initRegs input address ≠ 0) + +private theorem maxWidth_le (store : Store) (width : ℕ) + (hwidth : ∀ entry ∈ store, + bitlen entry.1 ≤ width ∧ bitlen entry.2 ≤ width) : + maxWidth store ≤ width := by + induction store with + | nil => simp [maxWidth] + | cons entry rest ih => + have hentry := hwidth entry (by simp) + have hrest : ∀ current ∈ rest, + bitlen current.1 ≤ width ∧ bitlen current.2 ≤ width := by + intro current hmem + exact hwidth current (by simp [hmem]) + simp only [maxWidth] + exact max_le hentry.1 (max_le hentry.2 (ih hrest)) + +theorem Snapshot.initial_width_le_internal (input : List Bool) : + (Snapshot.initial input).width ≤ bitlen (input.length + 1) := by + have hlength := initialStore_length_le_internal input + have hcount : bitlen (initialStore input).length ≤ bitlen (input.length + 1) := + Nat.size_le_size hlength + have hstore : maxWidth (initialStore input) ≤ bitlen (input.length + 1) := by + apply maxWidth_le + intro entry hentry + rcases entry with ⟨address, value⟩ + simp only [initialStore, List.mem_map] at hentry + obtain ⟨storedAddress, hstored, heq⟩ := hentry + simp only [Prod.mk.injEq] at heq + rcases heq with ⟨rfl, rfl⟩ + have hmember := Finset.mem_filter.mp + ((Finset.mem_sort (r := (· ≤ ·))).mp hstored) + exact ⟨Nat.size_le_size (Nat.le_of_lt (Finset.mem_range.mp hmember.1)), + Nat.size_le_size (initRegs_le_length_add_one input storedAddress)⟩ + exact max_le (by simp [Snapshot.initial, bitlen]) (max_le hcount hstore) + +theorem Snapshot.ofCfg_represents_internal (cfg : Cfg) + (hfinite : (Function.support cfg.regs).Finite) : + (Snapshot.ofCfg cfg hfinite).Represents cfg := by + constructor + · exact ofRegs_canonical_internal cfg.regs hfinite + · apply Cfg.ext + · rfl + · exact decode_ofRegs_internal cfg.regs hfinite + +theorem Snapshot.stepInstr_canonical_internal (instruction : Instr) + (snapshot : Snapshot) (hcanonical : Canonical snapshot.store) : + Canonical (Snapshot.stepInstr instruction snapshot).store := by + cases instruction with + | imm destination value => + exact write_canonical_internal snapshot.store hcanonical destination value + | add destination source₀ source₁ => + exact write_canonical_internal snapshot.store hcanonical destination _ + | sub destination source₀ source₁ => + exact write_canonical_internal snapshot.store hcanonical destination _ + | mul destination source₀ source₁ => + exact write_canonical_internal snapshot.store hcanonical destination _ + | load destination addressRegister => + exact write_canonical_internal snapshot.store hcanonical destination _ + | store addressRegister source => + exact write_canonical_internal snapshot.store hcanonical _ _ + | jz source target => + simp only [Snapshot.stepInstr] + split <;> exact hcanonical + | jmp target => exact hcanonical + | halt => exact hcanonical + +theorem Snapshot.decode_stepInstr_internal (instruction : Instr) + (snapshot : Snapshot) (hcanonical : Canonical snapshot.store) : + (Snapshot.stepInstr instruction snapshot).decode = + RAM.stepInstr instruction snapshot.decode := by + cases instruction with + | imm destination value => + apply Cfg.ext + · rfl + · exact decode_write_internal snapshot.store hcanonical.1 destination value + | add destination source₀ source₁ => + apply Cfg.ext + · rfl + · exact decode_write_internal snapshot.store hcanonical.1 destination _ + | sub destination source₀ source₁ => + apply Cfg.ext + · rfl + · exact decode_write_internal snapshot.store hcanonical.1 destination _ + | mul destination source₀ source₁ => + apply Cfg.ext + · rfl + · exact decode_write_internal snapshot.store hcanonical.1 destination _ + | load destination addressRegister => + apply Cfg.ext + · rfl + · exact decode_write_internal snapshot.store hcanonical.1 destination _ + | store addressRegister source => + apply Cfg.ext + · rfl + · exact decode_write_internal snapshot.store hcanonical.1 _ _ + | jz source target => + by_cases hzero : read snapshot.store source = 0 <;> + simp [Snapshot.stepInstr, RAM.stepInstr, Snapshot.decode, + RegisterStore.decode, hzero] + | jmp target => rfl + | halt => rfl + +theorem Snapshot.curInstr_decode_internal (program : Program) (snapshot : Snapshot) : + RAM.curInstr program snapshot.decode = snapshot.curInstr program := + rfl + +theorem Snapshot.halted_decode_iff_internal (program : Program) (snapshot : Snapshot) : + RAM.Halted program snapshot.decode ↔ snapshot.Halted program := + Iff.rfl + +theorem Snapshot.step_canonical_internal (program : Program) (snapshot : Snapshot) + (hcanonical : Canonical snapshot.store) : + Canonical (snapshot.step program).store := + Snapshot.stepInstr_canonical_internal _ snapshot hcanonical + +theorem Snapshot.decode_step_internal (program : Program) (snapshot : Snapshot) + (hcanonical : Canonical snapshot.store) : + (snapshot.step program).decode = RAM.step program snapshot.decode := by + exact Snapshot.decode_stepInstr_internal _ snapshot hcanonical + +theorem Snapshot.run_canonical_internal (program : Program) (fuel : ℕ) + (snapshot : Snapshot) (hcanonical : Canonical snapshot.store) : + Canonical (snapshot.run program fuel).store := by + induction fuel generalizing snapshot with + | zero => exact hcanonical + | succ fuel ih => + rw [Snapshot.run] + by_cases hhalt : snapshot.Halted program + · rw [if_pos hhalt] + exact hcanonical + · rw [if_neg hhalt] + exact ih (snapshot.step program) + (Snapshot.step_canonical_internal program snapshot hcanonical) + +theorem Snapshot.decode_run_internal (program : Program) (fuel : ℕ) + (snapshot : Snapshot) (hcanonical : Canonical snapshot.store) : + (snapshot.run program fuel).decode = RAM.run program fuel snapshot.decode := by + induction fuel generalizing snapshot with + | zero => rfl + | succ fuel ih => + rw [Snapshot.run, RAM.run] + by_cases hhalt : snapshot.Halted program + · rw [if_pos hhalt, + if_pos ((Snapshot.halted_decode_iff_internal program snapshot).mpr hhalt)] + · rw [if_neg hhalt, + if_neg (mt (Snapshot.halted_decode_iff_internal program snapshot).mp hhalt)] + rw [ih (snapshot.step program) + (Snapshot.step_canonical_internal program snapshot hcanonical)] + rw [Snapshot.decode_step_internal program snapshot hcanonical] + +private theorem bitlen_succ_le (value : ℕ) : + bitlen (value + 1) ≤ bitlen value + 1 := by + rw [bitlen, bitlen, Nat.size_le] + have hvalue := Nat.lt_size_self value + have hpowPos : 0 < 2 ^ value.size := pow_pos (by omega) _ + rw [pow_succ] + omega + +private theorem length_write_le (store : Store) (address value : ℕ) : + (write store address value).length ≤ store.length + 1 := by + induction store with + | nil => + by_cases hvalue : value = 0 <;> simp [write, hvalue] + | cons entry rest ih => + rcases entry with ⟨storedAddress, storedValue⟩ + by_cases haddress : address = storedAddress + · subst address + by_cases hvalue : value = 0 + · simp [write, hvalue] + omega + · simp [write, hvalue] + · simp [write, haddress, ih] + +private theorem maxWidth_write_le (store : Store) (address value : ℕ) : + maxWidth (write store address value) ≤ + max (maxWidth store) (max (bitlen address) (bitlen value)) := by + induction store with + | nil => + by_cases hvalue : value = 0 <;> simp [write, maxWidth, hvalue] + | cons entry rest ih => + rcases entry with ⟨storedAddress, storedValue⟩ + by_cases haddress : address = storedAddress + · subst address + by_cases hvalue : value = 0 + · simp [write, maxWidth, hvalue] + · simp [write, maxWidth, hvalue] + omega + · simp only [write, haddress, ↓reduceIte, maxWidth] + omega + +private theorem Snapshot.width_write_le (snapshot : Snapshot) + (address value newPC bound : ℕ) + (hbase : snapshot.width + 1 ≤ bound) + (hpc : bitlen newPC ≤ bound) + (haddress : bitlen address ≤ bound) + (hvalue : bitlen value ≤ bound) : + Snapshot.width { pc := newPC, store := write snapshot.store address value } ≤ bound := by + have holdCount : bitlen snapshot.store.length ≤ snapshot.width := + le_trans (le_max_left _ _) (le_max_right _ _) + have holdStore : maxWidth snapshot.store ≤ snapshot.width := + le_trans (le_max_right _ _) (le_max_right _ _) + have hlength := length_write_le snapshot.store address value + have hcountStep : bitlen (write snapshot.store address value).length ≤ + bitlen (snapshot.store.length + 1) := by + exact Nat.size_le_size hlength + have hcountSucc := bitlen_succ_le snapshot.store.length + have hcount : bitlen (write snapshot.store address value).length ≤ bound := by + omega + have hstoreStep := maxWidth_write_le snapshot.store address value + have hstore : maxWidth (write snapshot.store address value) ≤ bound := by + exact le_trans hstoreStep + (max_le (le_trans holdStore (by omega)) (max_le haddress hvalue)) + exact max_le hpc (max_le hcount hstore) + +private theorem Snapshot.width_pc_le (snapshot : Snapshot) (newPC bound : ℕ) + (hbase : snapshot.width + 1 ≤ bound) + (hpc : bitlen newPC ≤ bound) : + Snapshot.width { snapshot with pc := newPC } ≤ bound := by + have hrest : max (bitlen snapshot.store.length) (maxWidth snapshot.store) ≤ + snapshot.width := le_max_right _ _ + exact max_le hpc (le_trans hrest (by omega)) + +theorem Snapshot.width_stepInstr_le_internal (instruction : Instr) + (snapshot : Snapshot) : + (Snapshot.stepInstr instruction snapshot).width ≤ + snapshot.stepWidthBound instruction := by + let bound := snapshot.stepWidthBound instruction + have hbase : snapshot.width + 1 ≤ bound := by + exact le_max_left _ _ + have hstatic : RegisterStore.Instr.staticWidth instruction ≤ bound := + le_trans (le_max_left _ _) (le_max_right _ _) + have hcost : instruction.logCost snapshot.decode ≤ bound := + le_trans (le_max_right _ _) (le_max_right _ _) + have holdPC : bitlen snapshot.pc ≤ snapshot.width := le_max_left _ _ + have hnextPC : bitlen (snapshot.pc + 1) ≤ bound := by + have := bitlen_succ_le snapshot.pc + omega + cases instruction with + | imm destination value => + apply Snapshot.width_write_le snapshot destination value + (snapshot.pc + 1) bound hbase hnextPC + · exact le_trans (le_max_left _ _) hstatic + · exact le_trans (le_max_right _ _) hstatic + | add destination source₀ source₁ => + apply Snapshot.width_write_le snapshot destination + (read snapshot.store source₀ + read snapshot.store source₁) + (snapshot.pc + 1) bound hbase hnextPC + · exact le_trans (le_max_left _ _) hstatic + · simp only [Instr.logCost, Snapshot.decode, RegisterStore.decode] at hcost + omega + | sub destination source₀ source₁ => + apply Snapshot.width_write_le snapshot destination + (read snapshot.store source₀ - read snapshot.store source₁) + (snapshot.pc + 1) bound hbase hnextPC + · exact le_trans (le_max_left _ _) hstatic + · have hsub : bitlen (read snapshot.store source₀ - read snapshot.store source₁) ≤ + bitlen (read snapshot.store source₀) := + Nat.size_le_size (Nat.sub_le _ _) + simp only [Instr.logCost, Snapshot.decode, RegisterStore.decode] at hcost + omega + | mul destination source₀ source₁ => + apply Snapshot.width_write_le snapshot destination + (read snapshot.store source₀ * read snapshot.store source₁) + (snapshot.pc + 1) bound hbase hnextPC + · exact le_trans (le_max_left _ _) hstatic + · simp only [Instr.logCost, Snapshot.decode, RegisterStore.decode] at hcost + omega + | load destination addressRegister => + apply Snapshot.width_write_le snapshot destination + (read snapshot.store (read snapshot.store addressRegister)) + (snapshot.pc + 1) bound hbase hnextPC + · exact le_trans (le_max_left _ _) hstatic + · simp only [Instr.logCost, Snapshot.decode, RegisterStore.decode] at hcost + omega + | store addressRegister source => + apply Snapshot.width_write_le snapshot + (read snapshot.store addressRegister) (read snapshot.store source) + (snapshot.pc + 1) bound hbase hnextPC + · simp only [Instr.logCost, Snapshot.decode, RegisterStore.decode] at hcost + omega + · simp only [Instr.logCost, Snapshot.decode, RegisterStore.decode] at hcost + omega + | jz source target => + by_cases hzero : read snapshot.store source = 0 + · simp only [Snapshot.stepInstr, hzero, ↓reduceIte] + apply Snapshot.width_pc_le snapshot target bound hbase + exact le_trans (le_max_right _ _) hstatic + · simp only [Snapshot.stepInstr, hzero, ↓reduceIte] + exact Snapshot.width_pc_le snapshot (snapshot.pc + 1) bound hbase hnextPC + | jmp target => + apply Snapshot.width_pc_le snapshot target bound hbase + exact hstatic + | halt => + exact le_trans (Nat.le_add_right snapshot.width 1) hbase + +private theorem staticWidth_curInstr_le (program : Program) (pc : ℕ) : + RegisterStore.Instr.staticWidth ((program[pc]?).getD Instr.halt) ≤ + programStaticWidth program := by + induction program generalizing pc with + | nil => simp [programStaticWidth, RegisterStore.Instr.staticWidth] + | cons instruction rest ih => + cases pc with + | zero => simp [programStaticWidth] + | succ pc => + simp only [List.getElem?_cons_succ] + exact le_trans (ih pc) (le_max_right _ _) + +theorem Snapshot.width_step_le_internal (program : Program) (snapshot : Snapshot) : + (snapshot.step program).width ≤ + max (snapshot.width + 1) + (max (programStaticWidth program) (RAM.stepLogCost program snapshot.decode)) := by + have hstep := Snapshot.width_stepInstr_le_internal + (snapshot.curInstr program) snapshot + have hstatic := staticWidth_curInstr_le program snapshot.pc + apply le_trans hstep + apply max_le + · exact le_max_left _ _ + · apply max_le + · exact le_trans hstatic (le_trans (le_max_left _ _) (le_max_right _ _)) + · exact le_trans (le_max_right _ _) (le_max_right _ _) + +theorem Snapshot.length_stepInstr_le_internal (instruction : Instr) + (snapshot : Snapshot) : + (Snapshot.stepInstr instruction snapshot).store.length ≤ + snapshot.store.length + 1 := by + cases instruction with + | imm destination value => exact length_write_le snapshot.store destination value + | add destination source₀ source₁ => exact length_write_le snapshot.store destination _ + | sub destination source₀ source₁ => exact length_write_le snapshot.store destination _ + | mul destination source₀ source₁ => exact length_write_le snapshot.store destination _ + | load destination addressRegister => exact length_write_le snapshot.store destination _ + | store addressRegister source => exact length_write_le snapshot.store _ _ + | jz source target => + simp only [Snapshot.stepInstr] + split <;> simp + | jmp target => simp [Snapshot.stepInstr] + | halt => simp [Snapshot.stepInstr] + +theorem Snapshot.length_run_le_internal (program : Program) (fuel : ℕ) + (snapshot : Snapshot) (hcanonical : Canonical snapshot.store) : + (snapshot.run program fuel).store.length ≤ + snapshot.store.length + RAM.unitTimeUpto program fuel snapshot.decode := by + induction fuel generalizing snapshot with + | zero => simp [Snapshot.run, RAM.unitTimeUpto] + | succ fuel ih => + rw [Snapshot.run, RAM.unitTimeUpto] + by_cases hhalt : snapshot.Halted program + · rw [if_pos hhalt, + if_pos ((Snapshot.halted_decode_iff_internal program snapshot).mpr hhalt)] + omega + · rw [if_neg hhalt, + if_neg (mt (Snapshot.halted_decode_iff_internal program snapshot).mp hhalt)] + have hstep := Snapshot.length_stepInstr_le_internal + (snapshot.curInstr program) snapshot + have hstep' : (snapshot.step program).store.length ≤ + snapshot.store.length + 1 := by + simpa only [Snapshot.step] using hstep + have hstepCanonical := Snapshot.step_canonical_internal + program snapshot hcanonical + have hrun := ih (snapshot.step program) hstepCanonical + rw [Snapshot.decode_step_internal program snapshot hcanonical] at hrun + omega + +theorem Snapshot.width_run_le_internal (program : Program) (fuel : ℕ) + (snapshot : Snapshot) (hcanonical : Canonical snapshot.store) : + (snapshot.run program fuel).width ≤ + snapshot.width + RAM.unitTimeUpto program fuel snapshot.decode * + (programStaticWidth program + 1) + + RAM.logTimeUpto program fuel snapshot.decode := by + induction fuel generalizing snapshot with + | zero => simp [Snapshot.run] + | succ fuel ih => + rw [Snapshot.run, RAM.unitTimeUpto, RAM.logTimeUpto] + by_cases hhalt : snapshot.Halted program + · rw [if_pos hhalt, + if_pos ((Snapshot.halted_decode_iff_internal program snapshot).mpr hhalt), + if_pos ((Snapshot.halted_decode_iff_internal program snapshot).mpr hhalt)] + omega + · rw [if_neg hhalt, + if_neg (mt (Snapshot.halted_decode_iff_internal program snapshot).mp hhalt), + if_neg (mt (Snapshot.halted_decode_iff_internal program snapshot).mp hhalt)] + have hstepCanonical := Snapshot.step_canonical_internal + program snapshot hcanonical + have hrun := ih (snapshot.step program) hstepCanonical + rw [Snapshot.decode_step_internal program snapshot hcanonical] at hrun + have hstep := Snapshot.width_step_le_internal program snapshot + rw [Nat.add_mul] + omega + +private theorem WordCode.decodeAux?_replicate_true + (remaining consumed : ℕ) (payload suffix : List Bool) + (hlength : payload.length = consumed + remaining) : + WordCode.decodeAux? + (List.replicate remaining true ++ false :: payload ++ suffix) consumed = + some (Nat.fromBitsLE payload, suffix) := by + induction remaining generalizing consumed with + | zero => + have hconsumed : consumed = payload.length := by omega + subst consumed + simp [WordCode.decodeAux?] + | succ remaining ih => + simp only [List.replicate_succ, List.cons_append, WordCode.decodeAux?] + apply ih (consumed + 1) + omega + +theorem WordCode.decodePrefix?_encode_append_internal (value : ℕ) + (suffix : List Bool) : + WordCode.decodePrefix? (WordCode.encode value ++ suffix) = + some (value, suffix) := by + have hdecode := WordCode.decodeAux?_replicate_true + (bitlen value) 0 (Nat.toBitsLE (bitlen value) value) suffix + (by simp [bitlen, Nat.length_toBitsLE]) + have hround : Nat.fromBitsLE (Nat.toBitsLE (bitlen value) value) = value := by + apply Nat.fromBitsLE_toBitsLE + simpa [bitlen] using Nat.lt_size_self value + rw [hround] at hdecode + simpa [WordCode.decodePrefix?, WordCode.encode, List.append_assoc] using hdecode + +theorem WordCode.decodePrefix?_encode_internal (value : ℕ) : + WordCode.decodePrefix? (WordCode.encode value) = some (value, []) := by + simpa using WordCode.decodePrefix?_encode_append_internal value [] + +theorem WordCode.encode_length_internal (value : ℕ) : + (WordCode.encode value).length = 2 * bitlen value + 1 := by + simp [WordCode.encode, Nat.length_toBitsLE] + omega + +theorem Entry.decodePrefix?_encode_append_internal (entry : Entry) + (suffix : List Bool) : + Entry.decodePrefix? (Entry.encode entry ++ suffix) = some (entry, suffix) := by + rcases entry with ⟨address, value⟩ + simp [Entry.encode, Entry.decodePrefix?, List.append_assoc, + WordCode.decodePrefix?_encode_append_internal] + +theorem Entry.encode_length_internal (entry : Entry) : + (Entry.encode entry).length = + 2 * bitlen entry.1 + 2 * bitlen entry.2 + 2 := by + rw [Entry.encode, List.length_append, + WordCode.encode_length_internal, WordCode.encode_length_internal] + omega + +theorem encodedStoreLength_write_le_internal (store : Store) + (address value : ℕ) : + encodedStoreLength (write store address value) ≤ + encodedStoreLength store + (Entry.encode (address, value)).length := by + induction store with + | nil => + by_cases hvalue : value = 0 <;> + simp [encodedStoreLength, write, hvalue] + | cons entry rest ih => + rcases entry with ⟨storedAddress, storedValue⟩ + by_cases haddress : address = storedAddress + · subst address + by_cases hvalue : value = 0 + · subst value + simp only [write, ↓reduceIte, encodedStoreLength, + List.flatMap_cons, List.length_append] + exact le_trans (Nat.le_add_left _ _) + (Nat.le_add_right _ _) + · simp only [write, hvalue, ↓reduceIte, encodedStoreLength, + List.flatMap_cons, List.length_append] + calc + (Entry.encode (storedAddress, value)).length + + (List.flatMap Entry.encode rest).length = + (List.flatMap Entry.encode rest).length + + (Entry.encode (storedAddress, value)).length := by omega + _ ≤ ((Entry.encode (storedAddress, storedValue)).length + + (List.flatMap Entry.encode rest).length) + + (Entry.encode (storedAddress, value)).length := + Nat.add_le_add_right (Nat.le_add_left _ _) _ + · unfold encodedStoreLength at ih + simp only [write, haddress, ↓reduceIte, encodedStoreLength, + List.flatMap_cons, List.length_append] + simpa only [Nat.add_assoc] using + Nat.add_le_add_left ih + (Entry.encode (storedAddress, storedValue)).length + +private theorem encodedStoreLength_stepInstr_le (instruction : Instr) + (snapshot : Snapshot) : + encodedStoreLength (Snapshot.stepInstr instruction snapshot).store ≤ + encodedStoreLength snapshot.store + + 4 * (RegisterStore.Instr.staticWidth instruction + + instruction.logCost snapshot.decode + 1) := by + cases instruction with + | imm destination value => + have hwrite := encodedStoreLength_write_le_internal snapshot.store + destination value + apply le_trans hwrite + rw [Entry.encode_length_internal] + simp only [RegisterStore.Instr.staticWidth, Instr.logCost] + omega + | add destination source₀ source₁ => + have hwrite := encodedStoreLength_write_le_internal snapshot.store + destination + (read snapshot.store source₀ + read snapshot.store source₁) + apply le_trans hwrite + rw [Entry.encode_length_internal] + simp only [RegisterStore.Instr.staticWidth, Instr.logCost, + Snapshot.decode, RegisterStore.decode] + omega + | sub destination source₀ source₁ => + have hwrite := encodedStoreLength_write_le_internal snapshot.store + destination + (read snapshot.store source₀ - read snapshot.store source₁) + have hsub : bitlen + (read snapshot.store source₀ - read snapshot.store source₁) ≤ + bitlen (read snapshot.store source₀) := + Nat.size_le_size (Nat.sub_le _ _) + apply le_trans hwrite + rw [Entry.encode_length_internal] + simp only [RegisterStore.Instr.staticWidth, Instr.logCost, + Snapshot.decode, RegisterStore.decode] + omega + | mul destination source₀ source₁ => + have hwrite := encodedStoreLength_write_le_internal snapshot.store + destination + (read snapshot.store source₀ * read snapshot.store source₁) + apply le_trans hwrite + rw [Entry.encode_length_internal] + simp only [RegisterStore.Instr.staticWidth, Instr.logCost, + Snapshot.decode, RegisterStore.decode] + omega + | load destination addressRegister => + have hwrite := encodedStoreLength_write_le_internal snapshot.store + destination (read snapshot.store (read snapshot.store addressRegister)) + apply le_trans hwrite + rw [Entry.encode_length_internal] + simp only [RegisterStore.Instr.staticWidth, Instr.logCost, + Snapshot.decode, RegisterStore.decode] + omega + | store addressRegister source => + have hwrite := encodedStoreLength_write_le_internal snapshot.store + (read snapshot.store addressRegister) (read snapshot.store source) + apply le_trans hwrite + rw [Entry.encode_length_internal] + simp only [RegisterStore.Instr.staticWidth, Instr.logCost, + Snapshot.decode, RegisterStore.decode] + omega + | jz source target => + simp only [Snapshot.stepInstr] + split <;> simp [encodedStoreLength] + | jmp target => simp [Snapshot.stepInstr] + | halt => simp [Snapshot.stepInstr] + +private theorem encodedStoreLength_step_le (program : Program) + (snapshot : Snapshot) : + encodedStoreLength (snapshot.step program).store ≤ + encodedStoreLength snapshot.store + + 4 * (programStaticWidth program + + RAM.stepLogCost program snapshot.decode + 1) := by + have hstep := encodedStoreLength_stepInstr_le + (snapshot.curInstr program) snapshot + have hstatic : RegisterStore.Instr.staticWidth + (snapshot.curInstr program) ≤ programStaticWidth program := by + simpa only [Snapshot.curInstr] using + staticWidth_curInstr_le program snapshot.pc + apply le_trans hstep + apply Nat.add_le_add_left + have hcost : (snapshot.curInstr program).logCost snapshot.decode = + RAM.stepLogCost program snapshot.decode := rfl + rw [hcost] + exact Nat.mul_le_mul_left 4 + (Nat.add_le_add_right + (Nat.add_le_add_right hstatic _) 1) + +theorem Snapshot.encodedStoreLength_run_le_internal (program : Program) + (fuel : ℕ) (snapshot : Snapshot) + (hcanonical : Canonical snapshot.store) : + encodedStoreLength (snapshot.run program fuel).store ≤ + encodedStoreLength snapshot.store + + 4 * (RAM.unitTimeUpto program fuel snapshot.decode * + (programStaticWidth program + 1) + + RAM.logTimeUpto program fuel snapshot.decode) := by + induction fuel generalizing snapshot with + | zero => simp [Snapshot.run, RAM.unitTimeUpto, RAM.logTimeUpto] + | succ fuel ih => + rw [Snapshot.run] + by_cases hhalt : snapshot.Halted program + · have hramHalted := + (Snapshot.halted_decode_iff_internal program snapshot).mpr hhalt + simp only [hhalt, hramHalted, if_true, RAM.unitTimeUpto, + RAM.logTimeUpto] + simp + · have hramNotHalted : ¬RAM.Halted program snapshot.decode := + mt (Snapshot.halted_decode_iff_internal program snapshot).mp hhalt + rw [if_neg hhalt] + simp only [RAM.unitTimeUpto, RAM.logTimeUpto, hramNotHalted, + if_false] + have hstep := encodedStoreLength_step_le program snapshot + have hnextCanonical := + Snapshot.step_canonical_internal program snapshot hcanonical + have htail := ih (snapshot.step program) hnextCanonical + have hdecode := Snapshot.decode_step_internal program snapshot hcanonical + rw [hdecode] at htail + calc + encodedStoreLength + (Snapshot.run program fuel (snapshot.step program)).store ≤ + encodedStoreLength (snapshot.step program).store + + 4 * (RAM.unitTimeUpto program fuel + (RAM.step program snapshot.decode) * + (programStaticWidth program + 1) + + RAM.logTimeUpto program fuel + (RAM.step program snapshot.decode)) := htail + _ ≤ (encodedStoreLength snapshot.store + + 4 * (programStaticWidth program + + RAM.stepLogCost program snapshot.decode + 1)) + + 4 * (RAM.unitTimeUpto program fuel + (RAM.step program snapshot.decode) * + (programStaticWidth program + 1) + + RAM.logTimeUpto program fuel + (RAM.step program snapshot.decode)) := + Nat.add_le_add_right hstep _ + _ = encodedStoreLength snapshot.store + + 4 * ((1 + RAM.unitTimeUpto program fuel + (RAM.step program snapshot.decode)) * + (programStaticWidth program + 1) + + (RAM.stepLogCost program snapshot.decode + + RAM.logTimeUpto program fuel + (RAM.step program snapshot.decode))) := by ring + +private theorem entries_encode_length_le (store : Store) (width : ℕ) + (hwidth : ∀ entry ∈ store, + bitlen entry.1 ≤ width ∧ bitlen entry.2 ≤ width) : + (store.flatMap Entry.encode).length ≤ store.length * (4 * width + 2) := by + induction store with + | nil => simp + | cons entry rest ih => + have hentry := hwidth entry (by simp) + have hrest : ∀ current ∈ rest, + bitlen current.1 ≤ width ∧ bitlen current.2 ≤ width := by + intro current hmem + exact hwidth current (by simp [hmem]) + have hhead : (Entry.encode entry).length ≤ 4 * width + 2 := by + rw [Entry.encode_length_internal] + omega + have htail := ih hrest + simp only [List.flatMap_cons, List.length_append, List.length_cons] + rw [Nat.succ_mul] + omega + +theorem decodeEntries?_encode_append_internal (store : Store) (suffix : List Bool) : + decodeEntries? store.length (store.flatMap Entry.encode ++ suffix) = + some (store, suffix) := by + induction store with + | nil => rfl + | cons entry rest ih => + simp [List.flatMap_cons, decodeEntries?, List.append_assoc, + Entry.decodePrefix?_encode_append_internal, ih] + +theorem Snapshot.decodePrefix?_encode_append_internal (snapshot : Snapshot) + (suffix : List Bool) : + Snapshot.decodePrefix? (snapshot.encode ++ suffix) = some (snapshot, suffix) := by + rcases snapshot with ⟨pc, store⟩ + simp [Snapshot.encode, Snapshot.decodePrefix?, List.append_assoc, + WordCode.decodePrefix?_encode_append_internal, + decodeEntries?_encode_append_internal] + +theorem Snapshot.decodePrefix?_encode_internal (snapshot : Snapshot) : + Snapshot.decodePrefix? snapshot.encode = some (snapshot, []) := by + simpa using Snapshot.decodePrefix?_encode_append_internal snapshot [] + +theorem Snapshot.decode?_encode_internal (snapshot : Snapshot) : + Snapshot.decode? snapshot.encode = some snapshot := by + rw [Snapshot.decode?, Snapshot.decodePrefix?_encode_internal] + rfl + +theorem Snapshot.encode_length_le_internal (snapshot : Snapshot) (width : ℕ) + (hpc : bitlen snapshot.pc ≤ width) + (hcount : bitlen snapshot.store.length ≤ width) + (hstore : ∀ entry ∈ snapshot.store, + bitlen entry.1 ≤ width ∧ bitlen entry.2 ≤ width) : + snapshot.encode.length ≤ (snapshot.store.length + 1) * (4 * width + 2) := by + have hentries := entries_encode_length_le snapshot.store width hstore + have hpcCode : (WordCode.encode snapshot.pc).length ≤ 2 * width + 1 := by + rw [WordCode.encode_length_internal] + omega + have hcountCode : (WordCode.encode snapshot.store.length).length ≤ 2 * width + 1 := by + rw [WordCode.encode_length_internal] + omega + simp only [Snapshot.encode, List.length_append] + rw [Nat.add_mul] + omega + +private theorem bitlen_le_maxWidth (store : Store) (entry : Entry) + (hentry : entry ∈ store) : + bitlen entry.1 ≤ maxWidth store ∧ bitlen entry.2 ≤ maxWidth store := by + induction store with + | nil => simp at hentry + | cons head rest ih => + simp only [List.mem_cons] at hentry + rcases hentry with rfl | hentry + · simp [maxWidth] + · have hrest := ih hentry + simp only [maxWidth] + have htail : maxWidth rest ≤ + max (bitlen head.1) (max (bitlen head.2) (maxWidth rest)) := + le_trans (le_max_right _ _) (le_max_right _ _) + exact ⟨le_trans hrest.1 htail, le_trans hrest.2 htail⟩ + +theorem encodedStoreLength_initial_le_internal (input : List Bool) : + encodedStoreLength (initialStore input) ≤ + (input.length + 1) * (4 * bitlen (input.length + 1) + 2) := by + have hlength := initialStore_length_le_internal input + have hsnapshotWidth := Snapshot.initial_width_le_internal input + have hstoreWidth : ∀ entry ∈ initialStore input, + bitlen entry.1 ≤ bitlen (input.length + 1) ∧ + bitlen entry.2 ≤ bitlen (input.length + 1) := by + intro entry hentry + have hentryWidth := bitlen_le_maxWidth (initialStore input) entry hentry + have hmaxWidth : maxWidth (initialStore input) ≤ + (Snapshot.initial input).width := by + exact le_trans (le_max_right _ _) (le_max_right _ _) + exact ⟨le_trans hentryWidth.1 (le_trans hmaxWidth hsnapshotWidth), + le_trans hentryWidth.2 (le_trans hmaxWidth hsnapshotWidth)⟩ + have hentries := entries_encode_length_le (initialStore input) + (bitlen (input.length + 1)) hstoreWidth + unfold encodedStoreLength + exact le_trans hentries + (Nat.mul_le_mul_right (4 * bitlen (input.length + 1) + 2) hlength) + +theorem Snapshot.encode_length_le_sizeBound_internal (snapshot : Snapshot) : + snapshot.encode.length ≤ snapshot.sizeBound := by + apply Snapshot.encode_length_le_internal snapshot snapshot.width + · exact le_max_left _ _ + · exact le_trans (le_max_left _ _) (le_max_right _ _) + · intro entry hentry + have hwidth := bitlen_le_maxWidth snapshot.store entry hentry + exact ⟨le_trans hwidth.1 (le_trans (le_max_right _ _) (le_max_right _ _)), + le_trans hwidth.2 (le_trans (le_max_right _ _) (le_max_right _ _))⟩ + +theorem Snapshot.encode_length_le_encodedStore_internal (snapshot : Snapshot) : + snapshot.encode.length ≤ + encodedStoreLength snapshot.store + 4 * snapshot.width + 2 := by + have hpc : bitlen snapshot.pc ≤ snapshot.width := le_max_left _ _ + have hcount : bitlen snapshot.store.length ≤ snapshot.width := + le_trans (le_max_left _ _) (le_max_right _ _) + simp only [Snapshot.encode, List.length_append, encodedStoreLength] + rw [WordCode.encode_length_internal, WordCode.encode_length_internal] + omega + +theorem Snapshot.encode_run_length_le_amortized_internal + (program : Program) (fuel : ℕ) (snapshot : Snapshot) + (hcanonical : Canonical snapshot.store) : + (snapshot.run program fuel).encode.length ≤ + encodedStoreLength snapshot.store + 4 * snapshot.width + + 8 * (RAM.unitTimeUpto program fuel snapshot.decode * + (programStaticWidth program + 1) + + RAM.logTimeUpto program fuel snapshot.decode) + 2 := by + let growth := RAM.unitTimeUpto program fuel snapshot.decode * + (programStaticWidth program + 1) + + RAM.logTimeUpto program fuel snapshot.decode + have hcode := Snapshot.encode_length_le_encodedStore_internal + (snapshot.run program fuel) + have hentries := Snapshot.encodedStoreLength_run_le_internal + program fuel snapshot hcanonical + have hwidth := Snapshot.width_run_le_internal + program fuel snapshot hcanonical + calc + (snapshot.run program fuel).encode.length ≤ + encodedStoreLength (snapshot.run program fuel).store + + 4 * (snapshot.run program fuel).width + 2 := hcode + _ ≤ (encodedStoreLength snapshot.store + 4 * growth) + + 4 * (snapshot.width + growth) + 2 := by + simpa only [growth, Nat.add_assoc] using Nat.add_le_add_right + (Nat.add_le_add hentries (Nat.mul_le_mul_left 4 hwidth)) 2 + _ = encodedStoreLength snapshot.store + 4 * snapshot.width + + 8 * growth + 2 := by ring + +theorem Snapshot.encode_initial_run_length_le_amortized_internal + (program : Program) (fuel : ℕ) (input : List Bool) : + ((Snapshot.initial input).run program fuel).encode.length ≤ + (input.length + 1) * (4 * bitlen (input.length + 1) + 2) + + 4 * bitlen (input.length + 1) + + 8 * (RAM.logTimeUpto program fuel (RAM.initCfg input) * + (programStaticWidth program + 2)) + 2 := by + have hinitial := Snapshot.initial_represents_internal input + have hrun := Snapshot.encode_run_length_le_amortized_internal + program fuel (Snapshot.initial input) hinitial.1 + rw [hinitial.2] at hrun + have hentries := encodedStoreLength_initial_le_internal input + have hentries' : encodedStoreLength (Snapshot.initial input).store ≤ + (input.length + 1) * (4 * bitlen (input.length + 1) + 2) := by + simpa only [Snapshot.initial] using hentries + have hwidth := Snapshot.initial_width_le_internal input + have hunit := RAM.unitTimeUpto_le_logTimeUpto program fuel + (RAM.initCfg input) + have hgrowth : + RAM.unitTimeUpto program fuel (RAM.initCfg input) * + (programStaticWidth program + 1) + + RAM.logTimeUpto program fuel (RAM.initCfg input) ≤ + RAM.logTimeUpto program fuel (RAM.initCfg input) * + (programStaticWidth program + 2) := by + calc + RAM.unitTimeUpto program fuel (RAM.initCfg input) * + (programStaticWidth program + 1) + + RAM.logTimeUpto program fuel (RAM.initCfg input) ≤ + RAM.logTimeUpto program fuel (RAM.initCfg input) * + (programStaticWidth program + 1) + + RAM.logTimeUpto program fuel (RAM.initCfg input) := + Nat.add_le_add_right + (Nat.mul_le_mul_right (programStaticWidth program + 1) hunit) _ + _ = RAM.logTimeUpto program fuel (RAM.initCfg input) * + (programStaticWidth program + 2) := by ring + have hentriesWidth := Nat.add_le_add hentries' + (Nat.mul_le_mul_left 4 hwidth) + have hgrowth' := Nat.mul_le_mul_left 8 hgrowth + exact le_trans hrun + (Nat.add_le_add_right (Nat.add_le_add hentriesWidth hgrowth') 2) + +theorem Snapshot.encode_run_length_le_internal (program : Program) (fuel : ℕ) + (snapshot : Snapshot) (hcanonical : Canonical snapshot.store) : + (snapshot.run program fuel).encode.length ≤ + (snapshot.store.length + RAM.unitTimeUpto program fuel snapshot.decode + 1) * + (4 * (snapshot.width + RAM.unitTimeUpto program fuel snapshot.decode * + (programStaticWidth program + 1) + + RAM.logTimeUpto program fuel snapshot.decode) + 2) := by + have hcode := Snapshot.encode_length_le_sizeBound_internal + (snapshot.run program fuel) + have hlength := Snapshot.length_run_le_internal program fuel snapshot hcanonical + have hwidth := Snapshot.width_run_le_internal program fuel snapshot hcanonical + apply le_trans hcode + unfold Snapshot.sizeBound + apply Nat.mul_le_mul + · omega + · omega + +theorem Snapshot.encode_run_length_le_logTime_internal + (program : Program) (fuel : ℕ) (snapshot : Snapshot) + (hcanonical : Canonical snapshot.store) : + (snapshot.run program fuel).encode.length ≤ + (snapshot.store.length + RAM.logTimeUpto program fuel snapshot.decode + 1) * + (4 * (snapshot.width + RAM.logTimeUpto program fuel snapshot.decode * + (programStaticWidth program + 1) + + RAM.logTimeUpto program fuel snapshot.decode) + 2) := by + have hcode := Snapshot.encode_run_length_le_internal + program fuel snapshot hcanonical + have hunit := RAM.unitTimeUpto_le_logTimeUpto program fuel snapshot.decode + apply le_trans hcode + apply Nat.mul_le_mul + · omega + · have hmul := Nat.mul_le_mul_right (programStaticWidth program + 1) hunit + omega + +theorem Snapshot.encode_initial_run_length_le_logTime_internal + (program : Program) (fuel : ℕ) (input : List Bool) : + ((Snapshot.initial input).run program fuel).encode.length ≤ + (input.length + 1 + RAM.logTimeUpto program fuel (RAM.initCfg input) + 1) * + (4 * (bitlen (input.length + 1) + + RAM.logTimeUpto program fuel (RAM.initCfg input) * + (programStaticWidth program + 1) + + RAM.logTimeUpto program fuel (RAM.initCfg input)) + 2) := by + have hrepresents := Snapshot.initial_represents_internal input + have hcode := Snapshot.encode_run_length_le_logTime_internal program fuel + (Snapshot.initial input) hrepresents.1 + rw [hrepresents.2] at hcode + have hlength := initialStore_length_le_internal input + have hlength' : (Snapshot.initial input).store.length ≤ input.length + 1 := by + simpa only [Snapshot.initial] using hlength + have hwidth := Snapshot.initial_width_le_internal input + apply le_trans hcode + apply Nat.mul_le_mul <;> omega + +end RegisterStore + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine.lean new file mode 100644 index 0000000000..9153920c54 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine.lean @@ -0,0 +1,27 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.AddressEq +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.DenseInputLookup +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryAppend +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryCleanup +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryDecode +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryEncode +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryLookup +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryLookupRestore +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryMatch +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryMissCopy +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryReplace +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryScan +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryScanStep +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.WordDecode +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.WordEncode + +/-! Supporting modules for Beyond the Bethe approximation of the permanent. -/ diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/AddressEq.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/AddressEq.lean new file mode 100644 index 0000000000..21cb6a4258 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/AddressEq.lean @@ -0,0 +1,98 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.AddressEq.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.ClearWork + +/-! +# Decoded sparse-address equality + +This module exposes the framed linear-time semantics of address rewind and +comparison used by the concrete sparse register-store scan. +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace RegisterStore + +namespace Machine + +/-- Rewind one decoded address and compare it to a canonical query, preserving +both contents, both left markers, and every unrelated tape. -/ +theorem decodedAddressEqTM_reachesIn_frame {n : ℕ} + (addressIdx queryIdx resultIdx : Fin n) + (hdistinct : TM.BinaryEqDistinct addressIdx queryIdx resultIdx) + (addressBits queryBits : List Bool) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (haddress : (work₀ addressIdx).HasBinaryPrefix addressBits) + (haddressStart : (work₀ addressIdx).cells 0 = Γ.start) + (hquery : (work₀ queryIdx).HasBinaryString queryBits) + (hqueryStart : (work₀ queryIdx).cells 0 = Γ.start) + (hresult : (work₀ resultIdx).HasBinaryPrefix []) + (hinput : inp₀.read ≠ Γ.start) + (hother : ∀ i, i ≠ addressIdx → i ≠ queryIdx → i ≠ resultIdx → + (work₀ i).read ≠ Γ.start ∧ 1 ≤ (work₀ i).head) + (houtput : out₀.read ≠ Γ.start) (houtputHead : 1 ≤ out₀.head) : + ∃ c' t, + t ≤ decodedAddressEqTime addressBits queryBits ∧ + (decodedAddressEqTM addressIdx queryIdx resultIdx).reachesIn t + { state := (decodedAddressEqTM addressIdx queryIdx resultIdx).qstart + input := inp₀ + work := work₀ + output := out₀ } c' ∧ + (decodedAddressEqTM addressIdx queryIdx resultIdx).halted c' ∧ + c'.input = inp₀ ∧ + (c'.work resultIdx).HasBinaryPrefix + [decide (addressBits = queryBits)] ∧ + (c'.work addressIdx).HasBinaryContent addressBits ∧ + 1 ≤ (c'.work addressIdx).head ∧ + (c'.work addressIdx).cells 0 = Γ.start ∧ + (c'.work queryIdx).HasBinaryContent queryBits ∧ + 1 ≤ (c'.work queryIdx).head ∧ + (c'.work queryIdx).cells 0 = Γ.start ∧ + (∀ i, i ≠ addressIdx → i ≠ queryIdx → i ≠ resultIdx → + c'.work i = work₀ i) ∧ + c'.output = out₀ := + decodedAddressEqTM_reachesIn_frame_internal addressIdx queryIdx resultIdx + hdistinct addressBits queryBits inp₀ work₀ out₀ haddress haddressStart + hquery hqueryStart hresult hinput hother houtput houtputHead + +/-- Coarse all-prefix auxiliary-space envelope for decoded-address equality. -/ +theorem decodedAddressEqTM_prefix_withinAuxSpace {n : ℕ} + (addressIdx queryIdx resultIdx : Fin n) (addressBits queryBits : List Bool) + (inputLength initialSpace time : ℕ) + (start current : Complexity.Cfg n + (decodedAddressEqTM addressIdx queryIdx resultIdx).Q) + (hinitial : start.WithinAuxSpace inputLength initialSpace) + (hreach : (decodedAddressEqTM addressIdx queryIdx resultIdx).reachesIn + time start current) + (htime : time ≤ decodedAddressEqTime addressBits queryBits) : + current.WithinAuxSpace inputLength + (initialSpace + decodedAddressEqTime addressBits queryBits) := + (hinitial.reachesIn hreach).mono le_rfl (by omega) + +/-- Decoded-address equality preserves one-way output safety. -/ +theorem decodedAddressEqTM_isTransducer {n : ℕ} + (addressIdx queryIdx resultIdx : Fin n) : + (decodedAddressEqTM addressIdx queryIdx resultIdx).IsTransducer := by + unfold decodedAddressEqTM + exact (TM.rewindWorkTM_isTransducer addressIdx).seqTM + (TM.binaryEqTM_isTransducer addressIdx queryIdx resultIdx) + +end Machine + +end RegisterStore + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/AddressEq/Defs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/AddressEq/Defs.lean new file mode 100644 index 0000000000..f8dbfaec6a --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/AddressEq/Defs.lean @@ -0,0 +1,47 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryEq.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines + +/-! +# Decoded sparse-address equality — definitions + +The entry decoder leaves an address target at its append position. This stage +rewinds it and compares it against a canonical query address, writing the +Boolean result on a third work tape. +-/ + + +@[expose] public section + +namespace Complexity + +namespace RAM + +namespace RegisterStore + +namespace Machine + +/-- Rewind a decoded address and compare it with a canonical query address. -/ +def decodedAddressEqTM {n : ℕ} + (addressIdx queryIdx resultIdx : Fin n) : TM n := + TM.seqTM (TM.rewindWorkTM addressIdx) + (TM.binaryEqTM addressIdx queryIdx resultIdx) + +/-- Linear time bound for decoded-address equality, including its composition +seam. -/ +def decodedAddressEqTime (addressBits queryBits : List Bool) : ℕ := + addressBits.length + 3 + 1 + TM.binaryEqTime addressBits queryBits + +end Machine + +end RegisterStore + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/AddressEq/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/AddressEq/Internal.lean new file mode 100644 index 0000000000..9707478df6 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/AddressEq/Internal.lean @@ -0,0 +1,156 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.AddressEq.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.WordDecode +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryEq + +/-! +# Decoded sparse-address equality — proof internals +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace RegisterStore + +namespace Machine + +theorem decodedAddressEqTM_reachesIn_frame_internal {n : ℕ} + (addressIdx queryIdx resultIdx : Fin n) + (hdistinct : TM.BinaryEqDistinct addressIdx queryIdx resultIdx) + (addressBits queryBits : List Bool) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (haddress : (work₀ addressIdx).HasBinaryPrefix addressBits) + (haddressStart : (work₀ addressIdx).cells 0 = Γ.start) + (hquery : (work₀ queryIdx).HasBinaryString queryBits) + (hqueryStart : (work₀ queryIdx).cells 0 = Γ.start) + (hresult : (work₀ resultIdx).HasBinaryPrefix []) + (hinput : inp₀.read ≠ Γ.start) + (hother : ∀ i, i ≠ addressIdx → i ≠ queryIdx → i ≠ resultIdx → + (work₀ i).read ≠ Γ.start ∧ 1 ≤ (work₀ i).head) + (houtput : out₀.read ≠ Γ.start) (houtputHead : 1 ≤ out₀.head) : + ∃ c' t, + t ≤ decodedAddressEqTime addressBits queryBits ∧ + (decodedAddressEqTM addressIdx queryIdx resultIdx).reachesIn t + { state := (decodedAddressEqTM addressIdx queryIdx resultIdx).qstart + input := inp₀ + work := work₀ + output := out₀ } c' ∧ + (decodedAddressEqTM addressIdx queryIdx resultIdx).halted c' ∧ + c'.input = inp₀ ∧ + (c'.work resultIdx).HasBinaryPrefix + [decide (addressBits = queryBits)] ∧ + (c'.work addressIdx).HasBinaryContent addressBits ∧ + 1 ≤ (c'.work addressIdx).head ∧ + (c'.work addressIdx).cells 0 = Γ.start ∧ + (c'.work queryIdx).HasBinaryContent queryBits ∧ + 1 ≤ (c'.work queryIdx).head ∧ + (c'.work queryIdx).cells 0 = Γ.start ∧ + (∀ i, i ≠ addressIdx → i ≠ queryIdx → i ≠ resultIdx → + c'.work i = work₀ i) ∧ + c'.output = out₀ := by + let rewindTM := TM.rewindWorkTM addressIdx + let compareTM := TM.binaryEqTM addressIdx queryIdx resultIdx + have hrewindOther : ∀ i, i ≠ addressIdx → + (work₀ i).read ≠ Γ.start ∧ 1 ≤ (work₀ i).head := by + intro i hia + by_cases hiq : i = queryIdx + · subst i + exact ⟨hquery.hasBinarySuffix.read_ne_start, by rw [hquery.1]⟩ + · by_cases hir : i = resultIdx + · subst i + exact ⟨by rw [hresult.read_blank]; decide, by rw [hresult.1]; simp⟩ + · exact hother i hia hiq hir + obtain ⟨rewindDone, rewindTime, hrewindTime, hrewindReach, hrewindHalt, + hrewindInput, hrewindAddress, hrewindFrame, hrewindOutput⟩ := + wordTargetRewind_reachesIn_frame addressIdx addressBits inp₀ work₀ out₀ + haddress haddressStart hinput hrewindOther houtput houtputHead + have hrewindQuery : (rewindDone.work queryIdx).HasBinaryString queryBits := by + rw [hrewindFrame queryIdx (Ne.symm hdistinct.lhs_rhs)] + exact hquery + have hrewindResult : (rewindDone.work resultIdx).HasBinaryPrefix [] := by + rw [hrewindFrame resultIdx (Ne.symm hdistinct.lhs_result)] + exact hresult + have hrewindReads : ∀ i, (rewindDone.work i).read ≠ Γ.start := by + intro i + by_cases hia : i = addressIdx + · subst i + exact hrewindAddress.hasBinarySuffix.read_ne_start + · rw [hrewindFrame i hia] + exact (hrewindOther i hia).1 + obtain ⟨compareDone, compareTime, hcompareTime, hcompareReach, + hcompareHalt, hcompareInput, hcompareResult, hcompareAddress, + hcompareAddressHead, hcompareQuery, hcompareQueryHead, hcompareFrame, + hcompareOutput⟩ := + TM.binaryEqTM_reachesIn_frame addressIdx queryIdx resultIdx hdistinct + addressBits queryBits rewindDone.input rewindDone.work rewindDone.output + hrewindAddress hrewindQuery hrewindResult + (by rw [hrewindInput]; exact hinput) + (fun i _ _ _ => hrewindReads i) + (by rw [hrewindOutput]; exact houtput) + have htransitionInput : TM.transitionInput rewindDone.input = + rewindDone.input := + TM.transitionInput_eq_self (by rw [hrewindInput]; exact hinput) + have htransitionWork : + (fun i => TM.transitionTape (rewindDone.work i)) = rewindDone.work := by + funext i + exact TM.transitionTape_eq_self (hrewindReads i) + have htransitionOutput : TM.transitionTape rewindDone.output = + rewindDone.output := + TM.transitionTape_eq_self (by rw [hrewindOutput]; exact houtput) + have hcompareReach' : compareTM.reachesIn compareTime + { state := compareTM.qstart + input := TM.transitionInput rewindDone.input + work := fun i => TM.transitionTape (rewindDone.work i) + output := TM.transitionTape rewindDone.output } compareDone := by + rw [htransitionInput, htransitionWork, htransitionOutput] + simpa [compareTM] using hcompareReach + have hfullReach := TM.seqTM_reachesIn_of_reachesIn rewindTM compareTM + (by simpa [rewindTM] using hrewindReach) hrewindHalt hcompareReach' + let finalCfg := TM.phase2Wrap rewindTM compareTM compareDone + have hfullReach' : + (decodedAddressEqTM addressIdx queryIdx resultIdx).reachesIn + (rewindTime + 1 + compareTime) + { state := (decodedAddressEqTM addressIdx queryIdx resultIdx).qstart + input := inp₀ + work := work₀ + output := out₀ } finalCfg := by + simpa [decodedAddressEqTM, rewindTM, compareTM, finalCfg] using hfullReach + have haddressStartFinal : (finalCfg.work addressIdx).cells 0 = Γ.start := + TM.work_cells_zero_eq_start_of_reachesIn + (tm := decodedAddressEqTM addressIdx queryIdx resultIdx) addressIdx + hfullReach' haddressStart + have hqueryStartFinal : (finalCfg.work queryIdx).cells 0 = Γ.start := + TM.work_cells_zero_eq_start_of_reachesIn + (tm := decodedAddressEqTM addressIdx queryIdx resultIdx) queryIdx + hfullReach' hqueryStart + refine ⟨finalCfg, rewindTime + 1 + compareTime, ?_, hfullReach', ?_, + hcompareInput.trans hrewindInput, hcompareResult, hcompareAddress, + hcompareAddressHead, haddressStartFinal, hcompareQuery, + hcompareQueryHead, hqueryStartFinal, ?_, + hcompareOutput.trans hrewindOutput⟩ + · simp only [decodedAddressEqTime] + omega + · exact (TM.phase2Wrap_halted_iff rewindTM compareTM compareDone).2 + hcompareHalt + · intro i hia hiq hir + change compareDone.work i = work₀ i + rw [hcompareFrame i hia hiq hir, hrewindFrame i hia] + +end Machine + +end RegisterStore + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/DenseInputLookup.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/DenseInputLookup.lean new file mode 100644 index 0000000000..2b6dbe405d --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/DenseInputLookup.lean @@ -0,0 +1,164 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import +LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.DenseInputLookup.Internal + +/-! +# Dense public-input lookup + +This module exposes the fixed leaves used to look through a sparse tagged +overlay into the immutable public-input bank. +-/ + + +public section + +namespace Complexity +namespace RAM +namespace RegisterStore +namespace Machine + +/-- The direct-branch identity leaf preserves a fully parked frame exactly. -/ +theorem denseInputIdleTM_reachesIn_frame {n : ℕ} + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hinput : TM.Parked inp₀) (hwork : ∀ i, TM.Parked (work₀ i)) + (houtput : TM.Parked out₀) : + ∃ c', + (denseInputIdleTM (n := n)).reachesIn 1 + { state := (denseInputIdleTM (n := n)).qstart + input := inp₀ + work := work₀ + output := out₀ } c' ∧ + (denseInputIdleTM (n := n)).halted c' ∧ + c'.input = inp₀ ∧ c'.work = work₀ ∧ c'.output = out₀ := + denseInputIdleTM_reachesIn_frame_internal inp₀ work₀ out₀ + hinput hwork houtput + +/-- Copy the preceding Boolean input symbol into one canonical work tape and +restore the read-only input head in exactly two transitions. -/ +theorem capturePreviousInputBitTM_reachesIn_frame {n : ℕ} + (result : Fin n) (bit : Bool) (inp₀ : Tape) + (work₀ : Fin n → Tape) (out₀ : Tape) + (hinput : inp₀.StartInvariant) (hhead : 2 ≤ inp₀.head) + (hbit : inp₀.cells (inp₀.head - 1) = Γ.ofBool bit) + (hresult : work₀ result = TM.resetBinaryBlank) + (hwork : ∀ i, TM.Parked (work₀ i)) (houtput : TM.Parked out₀) : + ∃ c', + (capturePreviousInputBitTM result).reachesIn 2 + { state := (capturePreviousInputBitTM result).qstart + input := inp₀ + work := work₀ + output := out₀ } c' ∧ + (capturePreviousInputBitTM result).halted c' ∧ + c'.input = inp₀ ∧ + c'.work = Function.update work₀ result (denseInputBitTape bit) ∧ + c'.output = out₀ := + capturePreviousInputBitTM_reachesIn_frame_internal result bit inp₀ + work₀ out₀ hinput hhead hbit hresult hwork houtput + +/-- The canonical captured-bit tape represents exactly zero or one. -/ +theorem denseInputBitTape_hasBinaryNat (bit : Bool) : + (denseInputBitTape bit).HasBinaryNat (if bit then 1 else 0) := + denseInputBitTape_hasBinaryNat_internal bit + +/-- Every captured-bit tape is parked at its first data cell. -/ +theorem denseInputBitTape_parked (bit : Bool) : + TM.Parked (denseInputBitTape bit) := + denseInputBitTape_parked_internal bit + +/-- One scan body step decrements a positive countdown, captures the preceding +input bit exactly when the countdown reaches zero, and preserves every frame. -/ +theorem denseInputStepTM_reachesIn_frame {n : ℕ} + (counter result : Fin n) (hne : counter ≠ result) + (remaining : ℕ) (bit : Bool) (inp₀ : Tape) + (work₀ : Fin n → Tape) (out₀ : Tape) + (hinput : inp₀.StartInvariant) (hhead : 2 ≤ inp₀.head) + (hbit : inp₀.cells (inp₀.head - 1) = Γ.ofBool bit) + (hcounter : (work₀ counter).HasBinaryNat remaining) + (hresult : remaining = 1 → work₀ result = TM.resetBinaryBlank) + (hwork : ∀ i, TM.Parked (work₀ i)) (houtput : TM.Parked out₀) : + ∃ c', + (denseInputStepTM counter result).reachesIn + (denseInputStepTime remaining) + { state := (denseInputStepTM counter result).qstart + input := inp₀ + work := work₀ + output := out₀ } c' ∧ + (denseInputStepTM counter result).halted c' ∧ + c'.input = inp₀ ∧ + (c'.work counter).HasBinaryNat (remaining - 1) ∧ + c'.work result = denseInputStepResult remaining bit (work₀ result) ∧ + (∀ i, i ≠ counter → i ≠ result → c'.work i = work₀ i) ∧ + c'.output = out₀ := + denseInputStepTM_reachesIn_frame_internal counter result hne remaining bit + inp₀ work₀ out₀ hinput hhead hbit hcounter hresult hwork houtput + +/-- A positive RAM address can be looked up by one exact scan of the immutable +input bank. The scanner leaves the input contents unchanged, parks at the first +blank, decrements its counter once per bit, and returns `RAM.initRegs`. -/ +theorem denseInputScanTM_reachesIn_frame {n : ℕ} + (counter result : Fin n) (hne : counter ≠ result) + (input : List Bool) (address : ℕ) (work₀ : Fin n → Tape) + (out₀ : Tape) (haddress : address ≠ 0) + (hcounter : (work₀ counter).HasBinaryNat address) + (hresult : work₀ result = TM.resetBinaryBlank) + (hwork : ∀ i, TM.Parked (work₀ i)) (houtput : TM.Parked out₀) : + ∃ c', + (denseInputScanTM counter result).reachesIn + (denseInputScanTime input.length address) + { state := (denseInputScanTM counter result).qstart + input := (Tape.init (input.map Γ.ofBool)).move Dir3.right + work := work₀ + output := out₀ } c' ∧ + (denseInputScanTM counter result).halted c' ∧ + c'.input.head = input.length + 1 ∧ + c'.input.cells = (Tape.init (input.map Γ.ofBool)).cells ∧ + (c'.work counter).HasBinaryNat (address - input.length) ∧ + (c'.work result).HasBinaryNat (Complexity.RAM.initRegs input address) ∧ + (∀ i, i ≠ counter → i ≠ result → c'.work i = work₀ i) ∧ + c'.output = out₀ := + denseInputScanTM_reachesIn_frame_internal counter result hne input address + work₀ out₀ haddress hcounter hresult hwork houtput + +/-- Dense-bank lookup is linear in the public-input length and logarithmic in +the queried positive address. -/ +theorem denseInputScanTime_le_width (inputLength address : ℕ) : + denseInputScanTime inputLength address ≤ + inputLength * (2 * address.size + 9) + 1 := + denseInputScanTime_le_width_internal inputLength address + +/-- Full dense-bank fallback preserves the query and scratch tapes, restores +the input head and countdown tape, and returns the standard RAM input value. -/ +theorem denseInputLookupTM_hoareTime {n : ℕ} + (query counter result scratch : Fin n) + (hqc : query ≠ counter) (hqr : query ≠ result) + (hqs : query ≠ scratch) (hcr : counter ≠ result) + (hcs : counter ≠ scratch) (hrs : result ≠ scratch) + (input : List Bool) (address : ℕ) (initialWork : Fin n → Tape) + (out₀ : Tape) (haddress : address ≠ 0) + (hready : DenseInputLookupReady query counter result scratch address + initialWork) + (houtput : TM.Parked out₀) : + (denseInputLookupTM query counter result scratch).HoareTime + (fun inp work out => + inp = (Tape.init (input.map Γ.ofBool)).move Dir3.right ∧ + work = initialWork ∧ out = out₀) + (fun inp work out => + inp = (Tape.init (input.map Γ.ofBool)).move Dir3.right ∧ + DenseInputLookupResult query counter result scratch input address + initialWork work ∧ + out = out₀) + (denseInputLookupTime input.length address) := + denseInputLookupTM_hoareTime_internal query counter result scratch + hqc hqr hqs hcr hcs hrs input address initialWork out₀ haddress + hready houtput + +end Machine +end RegisterStore +end RAM +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/DenseInputLookup/Defs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/DenseInputLookup/Defs.lean new file mode 100644 index 0000000000..eb04d0b80f --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/DenseInputLookup/Defs.lean @@ -0,0 +1,179 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.WorkBranch.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.ForInput.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryCopy.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryPred.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.ResetBinaryMany.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinarySucc.Defs + +/-! +# Dense public-input lookup -- definitions + +These finite controllers are the concrete bridge from a sparse mutable RAM +overlay to the immutable public input on the Turing input tape. The scan keeps +a binary countdown on a work tape. When that countdown first reaches zero, +the preceding input symbol is copied to a canonical Boolean result tape. +-/ + + +@[expose] public section + +namespace Complexity +namespace RAM +namespace RegisterStore +namespace Machine + +/-- Two-state framed identity used as a direct-branch leaf. -/ +inductive DenseInputIdlePhase where + | run + | done + deriving DecidableEq + +instance : Fintype DenseInputIdlePhase where + elems := {.run, .done} + complete := fun phase => by cases phase <;> simp + +/-- A one-step identity on every parked tape. -/ +def denseInputIdleTM {n : ℕ} : TM n where + Q := DenseInputIdlePhase + qstart := .run + qhalt := .done + δ := fun _ iHead wHeads oHead => + (.done, fun i => TM.readBackWrite (wHeads i), TM.readBackWrite oHead, + TM.idleDir iHead, fun i => TM.idleDir (wHeads i), TM.idleDir oHead) + δ_right_of_start := fun _ _ _ _ => + ⟨TM.idleDir_right_of_start, fun _ => TM.idleDir_right_of_start, + TM.idleDir_right_of_start⟩ + +/-- Two-step controller that moves left to the preceding input symbol, copies +that Boolean value to one work cell, and restores the input head. -/ +inductive DenseInputCapturePhase where + | moveLeft + | write + | done + deriving DecidableEq + +instance : Fintype DenseInputCapturePhase where + elems := {.moveLeft, .write, .done} + complete := fun phase => by cases phase <;> simp + +/-- Canonical binary work tape representing one public-input bit. -/ +def denseInputBitTape (bit : Bool) : Tape := + TM.resetBinaryBlank.writeAndMove + (if bit then Γw.one.toΓ else Γw.blank.toΓ) Dir3.stay + +/-- Copy the Boolean input symbol immediately to the left of the current head +onto a blank canonical result tape, restoring the input head in two steps. -/ +def capturePreviousInputBitTM {n : ℕ} (result : Fin n) : TM n where + Q := DenseInputCapturePhase + qstart := .moveLeft + qhalt := .done + δ := fun phase iHead wHeads oHead => + match phase with + | .moveLeft => + (.write, fun i => TM.readBackWrite (wHeads i), + TM.readBackWrite oHead, TM.moveLeftDir iHead, + fun i => TM.idleDir (wHeads i), TM.idleDir oHead) + | .write => + (.done, + fun i => + if i = result then + if iHead = Γ.one then Γw.one else Γw.blank + else TM.readBackWrite (wHeads i), + TM.readBackWrite oHead, Dir3.right, + fun i => TM.idleDir (wHeads i), TM.idleDir oHead) + | .done => TM.allIdle .done iHead wHeads oHead + δ_right_of_start := by + intro phase iHead wHeads oHead + cases phase with + | moveLeft => + exact ⟨TM.moveLeftDir_right_of_start, + fun _ => TM.idleDir_right_of_start, + TM.idleDir_right_of_start⟩ + | write => + exact ⟨fun _ => rfl, fun _ => TM.idleDir_right_of_start, + TM.idleDir_right_of_start⟩ + | done => exact TM.rightOfStart_allIdle iHead wHeads oHead + +/-- One input-scan body step. A zero countdown is stationary. A positive +countdown is decremented; when it becomes zero, the preceding input bit is +captured exactly once. -/ +def denseInputStepTM {n : ℕ} (counter result : Fin n) : TM n := + TM.branchWorkBlankTM counter denseInputIdleTM + (TM.seqTM (TM.binaryPredTM counter) + (TM.branchWorkBlankTM counter + (capturePreviousInputBitTM result) denseInputIdleTM)) + +/-- Exact body time as a function of the positive-or-zero countdown. -/ +def denseInputStepTime (remaining : ℕ) : ℕ := + if remaining = 0 then 2 + else if remaining = 1 then TM.binaryPredTime 0 + 5 + else TM.binaryPredTime (remaining - 1) + 4 + +/-- Result tape after one scan iteration. Only the transition from countdown +one to zero captures the current input bit. -/ +def denseInputStepResult (remaining : ℕ) (bit : Bool) + (current : Tape) : Tape := + if remaining = 1 then denseInputBitTape bit else current + +/-- Scan the entire immutable Boolean input while decrementing a canonical +binary address counter and capturing the addressed bit. -/ +def denseInputScanTM {n : ℕ} (counter result : Fin n) : TM n := + TM.forInputTM (denseInputStepTM counter result) + +/-- Exact complete input-scan time from a positive address. -/ +def denseInputScanTime (inputLength address : ℕ) : ℕ := + TM.forInputLoopTime + (fun processed => denseInputStepTime (address - processed)) + 0 inputLength + +/-- Full positive-address dense-bank fallback: copy the query into a private +countdown, scan the immutable input, rewind the input head, and clear the +countdown back to the reusable blank boundary. -/ +def denseInputLookupTM {n : ℕ} + (query counter result scratch : Fin n) : TM n := + TM.seqTM (TM.binaryCopyIntoTM query counter scratch) + (TM.seqTM (denseInputScanTM counter result) + (TM.seqTM TM.rewindInputTM (TM.resetBinaryWorkTM counter))) + +/-- Complete fallback budget, including all three sequencing seams. -/ +def denseInputLookupTime (inputLength address : ℕ) : ℕ := + TM.binaryCopyTime address 0 + 1 + + (denseInputScanTime inputLength address + 1 + + (inputLength + 3 + 1 + + TM.resetBinaryWorkTime 1 (address - inputLength).bits.length)) + +/-- Reusable work-tape boundary before a positive-address dense-bank lookup. -/ +structure DenseInputLookupReady {n : ℕ} + (query counter result scratch : Fin n) (address : ℕ) + (work : Fin n → Tape) : Prop where + query : (work query).HasBinaryNat address + counter : (work counter).HasBinaryNat 0 + result : (work result).HasBinaryNat 0 + scratch : (work scratch).HasBinaryNat 0 + parked : ∀ i, TM.Parked (work i) + +/-- Reusable work-tape endpoint after dense-bank fallback. -/ +structure DenseInputLookupResult {n : ℕ} + (query counter result scratch : Fin n) (input : List Bool) + (address : ℕ) (initialWork finalWork : Fin n → Tape) : Prop where + query_eq : finalWork query = initialWork query + counter_zero : (finalWork counter).HasBinaryNat 0 + result_value : (finalWork result).HasBinaryNat + (Complexity.RAM.initRegs input address) + scratch_eq : finalWork scratch = initialWork scratch + parked : ∀ i, TM.Parked (finalWork i) + frame : ∀ i, i ≠ query → i ≠ counter → i ≠ result → i ≠ scratch → + finalWork i = initialWork i + +end Machine +end RegisterStore +end RAM +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/DenseInputLookup/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/DenseInputLookup/Internal.lean new file mode 100644 index 0000000000..5f23837249 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/DenseInputLookup/Internal.lean @@ -0,0 +1,1103 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.DenseInputLookup.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.WorkBranch +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.ForInput.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryCopy +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryPred +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.ResetBinary + +/-! +# Dense public-input lookup -- proof internals +-/ + + +public section + +namespace Complexity +namespace RAM +namespace RegisterStore +namespace Machine + +theorem denseInputIdleTM_reachesIn_frame_internal {n : ℕ} + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hinput : TM.Parked inp₀) (hwork : ∀ i, TM.Parked (work₀ i)) + (houtput : TM.Parked out₀) : + ∃ c', + (denseInputIdleTM (n := n)).reachesIn 1 + { state := (denseInputIdleTM (n := n)).qstart + input := inp₀ + work := work₀ + output := out₀ } c' ∧ + (denseInputIdleTM (n := n)).halted c' ∧ + c'.input = inp₀ ∧ c'.work = work₀ ∧ c'.output = out₀ := by + let c' : Complexity.Cfg n (denseInputIdleTM (n := n)).Q := + { state := (denseInputIdleTM (n := n)).qhalt + input := inp₀ + work := work₀ + output := out₀ } + have hstep : (denseInputIdleTM (n := n)).step + { state := (denseInputIdleTM (n := n)).qstart + input := inp₀ + work := work₀ + output := out₀ } = some c' := by + simp only [TM.step, denseInputIdleTM, reduceCtorEq, ↓reduceIte, c'] + refine congrArg some ((Complexity.Cfg.mk.injEq ..).mpr ⟨rfl, ?_, ?_, ?_⟩) + · exact hinput.move_idle + · funext i + exact (hwork i).writeAndMove_readBack_idle + · exact houtput.writeAndMove_readBack_idle + exact ⟨c', .step hstep .zero, rfl, rfl, rfl, rfl⟩ + +theorem capturePreviousInputBitTM_reachesIn_frame_internal {n : ℕ} + (result : Fin n) (bit : Bool) (inp₀ : Tape) + (work₀ : Fin n → Tape) (out₀ : Tape) + (hinput : inp₀.StartInvariant) (hhead : 2 ≤ inp₀.head) + (hbit : inp₀.cells (inp₀.head - 1) = Γ.ofBool bit) + (hresult : work₀ result = TM.resetBinaryBlank) + (hwork : ∀ i, TM.Parked (work₀ i)) (houtput : TM.Parked out₀) : + ∃ c', + (capturePreviousInputBitTM result).reachesIn 2 + { state := (capturePreviousInputBitTM result).qstart + input := inp₀ + work := work₀ + output := out₀ } c' ∧ + (capturePreviousInputBitTM result).halted c' ∧ + c'.input = inp₀ ∧ + c'.work = Function.update work₀ result (denseInputBitTape bit) ∧ + c'.output = out₀ := by + have hinputRead : inp₀.read ≠ Γ.start := + hinput.read_ne_start (by omega) + let inp₁ := inp₀.move Dir3.left + have hinp₁Head : inp₁.head = inp₀.head - 1 := by + simp [inp₁, Tape.move] + have hinp₁Cells : inp₁.cells = inp₀.cells := Tape.move_cells _ _ + have hinp₁Read : inp₁.read = Γ.ofBool bit := by + simp only [Tape.read, hinp₁Head, hinp₁Cells, hbit] + let c₁ : Complexity.Cfg n (capturePreviousInputBitTM result).Q := + { state := .write, input := inp₁, work := work₀, output := out₀ } + have hstep₁ : (capturePreviousInputBitTM result).step + { state := (capturePreviousInputBitTM result).qstart + input := inp₀ + work := work₀ + output := out₀ } = some c₁ := by + simp only [TM.step, capturePreviousInputBitTM, reduceCtorEq, + ↓reduceIte, c₁] + refine congrArg some ((Complexity.Cfg.mk.injEq ..).mpr ⟨rfl, ?_, ?_, ?_⟩) + · simp [inp₁, TM.moveLeftDir, hinputRead] + · funext i + exact (hwork i).writeAndMove_readBack_idle + · exact houtput.writeAndMove_readBack_idle + let finalWork := Function.update work₀ result (denseInputBitTape bit) + let c₂ : Complexity.Cfg n (capturePreviousInputBitTM result).Q := + { state := .done, input := inp₀, work := finalWork, output := out₀ } + have hstep₂ : (capturePreviousInputBitTM result).step c₁ = some c₂ := by + simp only [TM.step, capturePreviousInputBitTM, reduceCtorEq, + ↓reduceIte, c₁, c₂] + refine congrArg some ((Complexity.Cfg.mk.injEq ..).mpr ⟨rfl, ?_, ?_, ?_⟩) + · apply Tape.ext + · simp [inp₁, Tape.move] + omega + · simp [inp₁, Tape.move_cells] + · funext i + by_cases hi : i = result + · subst i + simp only [finalWork, Function.update_self, hinp₁Read] + rw [hresult] + cases bit <;> + simp [denseInputBitTape, TM.resetBinaryBlank, Tape.writeAndMove, + Tape.write, Tape.move, TM.idleDir, Tape.read, Tape.init, + Γ.ofBool] + · simp only [finalWork, Function.update_of_ne hi, hi, if_false] + exact (hwork i).writeAndMove_readBack_idle + · exact houtput.writeAndMove_readBack_idle + exact ⟨c₂, .step hstep₁ (.step hstep₂ .zero), rfl, rfl, rfl, rfl⟩ + +theorem denseInputBitTape_hasBinaryNat_internal (bit : Bool) : + (denseInputBitTape bit).HasBinaryNat (if bit then 1 else 0) := by + have heq : denseInputBitTape bit = + (Tape.init ((if bit then 1 else 0).bits.map Γ.ofBool)).move + Dir3.right := by + cases bit with + | false => + apply Tape.ext + · simp [denseInputBitTape, TM.resetBinaryBlank, + Tape.writeAndMove, Tape.write, Tape.move, Tape.init, Nat.bits] + · funext i + by_cases hi0 : i = 0 + · subst i + simp [denseInputBitTape, TM.resetBinaryBlank, + Tape.writeAndMove, Tape.write, Tape.move, Tape.init, Nat.bits] + · by_cases hi1 : i = 1 + · subst i + simp [denseInputBitTape, TM.resetBinaryBlank, + Tape.writeAndMove, Tape.write, Tape.move, Tape.init, + Nat.bits] + · simp [denseInputBitTape, TM.resetBinaryBlank, + Tape.writeAndMove, Tape.write, Tape.move, Tape.init, + Nat.bits, hi0, hi1] + | true => + apply Tape.ext + · simp [denseInputBitTape, TM.resetBinaryBlank, + Tape.writeAndMove, Tape.write, Tape.move, Tape.init, Nat.bits] + · funext i + by_cases hi0 : i = 0 + · subst i + simp [denseInputBitTape, TM.resetBinaryBlank, + Tape.writeAndMove, Tape.write, Tape.move, Tape.init, Nat.bits] + · by_cases hi1 : i = 1 + · subst i + simp [denseInputBitTape, TM.resetBinaryBlank, + Tape.writeAndMove, Tape.write, Tape.move, Tape.init, + Nat.bits, Γ.ofBool] + · have hnone : [Γ.one][i - 1]? = none := by + apply List.getElem?_eq_none + simp + omega + simp [denseInputBitTape, TM.resetBinaryBlank, + Tape.writeAndMove, Tape.write, Tape.move, Tape.init, + Nat.bits, hi0, hi1, hnone, Γ.ofBool] + rw [heq] + exact Tape.init_move_right_hasBinaryNat _ + +theorem denseInputBitTape_parked_internal (bit : Bool) : + TM.Parked (denseInputBitTape bit) := by + have h := denseInputBitTape_hasBinaryNat_internal bit + exact ⟨by simp [Tape.HasBinaryNat, Tape.HasBinaryString] at h; omega, + h.2.hasBinaryContent.cells_ne_start⟩ + +private def denseInputNatTape (value : ℕ) : Tape := + (Tape.init (value.bits.map Γ.ofBool)).move Dir3.right + +private def denseInputTape (input : List Bool) (head : ℕ) : Tape := + { head := head + cells := (Tape.init (input.map Γ.ofBool)).cells } + +private def denseInputResultTape (input : List Bool) (address processed : ℕ) : + Tape := + if address = 0 then TM.resetBinaryBlank + else if address ≤ processed then + denseInputBitTape (input[address - 1]?.getD false) + else TM.resetBinaryBlank + +private def denseInputWork {n : ℕ} (counter result : Fin n) + (work₀ : Fin n → Tape) (input : List Bool) (address processed : ℕ) : + Fin n → Tape := + Function.update + (Function.update work₀ counter (denseInputNatTape (address - processed))) + result (denseInputResultTape input address processed) + +private theorem denseInputNatTape_hasBinaryNat (value : ℕ) : + (denseInputNatTape value).HasBinaryNat value := + Tape.init_move_right_hasBinaryNat value + +private theorem denseInputNatTape_parked (value : ℕ) : + TM.Parked (denseInputNatTape value) := by + have h := denseInputNatTape_hasBinaryNat value + exact ⟨by simp [Tape.HasBinaryNat, Tape.HasBinaryString] at h; omega, + h.2.hasBinaryContent.cells_ne_start⟩ + +private theorem denseInputResultTape_parked (input : List Bool) + (address processed : ℕ) : + TM.Parked (denseInputResultTape input address processed) := by + unfold denseInputResultTape + split + · exact ⟨by simp [TM.resetBinaryBlank, Tape.move], + by simpa [TM.resetBinaryBlank] using + Tape.init_ofBool_move_right_cells_ne_start []⟩ + · split + · exact denseInputBitTape_parked_internal _ + · exact ⟨by simp [TM.resetBinaryBlank, Tape.move], + by simpa [TM.resetBinaryBlank] using + Tape.init_ofBool_move_right_cells_ne_start []⟩ + +private theorem denseInputWork_counter {n : ℕ} (counter result : Fin n) + (hne : counter ≠ result) (work₀ : Fin n → Tape) + (input : List Bool) (address processed : ℕ) : + denseInputWork counter result work₀ input address processed counter = + denseInputNatTape (address - processed) := by + simp [denseInputWork, hne] + +private theorem denseInputWork_result {n : ℕ} (counter result : Fin n) + (work₀ : Fin n → Tape) (input : List Bool) + (address processed : ℕ) : + denseInputWork counter result work₀ input address processed result = + denseInputResultTape input address processed := by + simp [denseInputWork] + +private theorem denseInputWork_other {n : ℕ} (counter result : Fin n) + (work₀ : Fin n → Tape) (input : List Bool) (address processed : ℕ) + (i : Fin n) (hic : i ≠ counter) (hir : i ≠ result) : + denseInputWork counter result work₀ input address processed i = work₀ i := by + simp [denseInputWork, hic, hir] + +private theorem denseInputWork_parked {n : ℕ} (counter result : Fin n) + (hne : counter ≠ result) (work₀ : Fin n → Tape) + (input : List Bool) (address processed : ℕ) + (hwork : ∀ i, TM.Parked (work₀ i)) : + ∀ i, TM.Parked + (denseInputWork counter result work₀ input address processed i) := by + intro i + by_cases hic : i = counter + · subst i + rw [denseInputWork_counter counter result hne] + exact denseInputNatTape_parked _ + · by_cases hir : i = result + · subst i + rw [denseInputWork_result] + exact denseInputResultTape_parked input address processed + · rw [denseInputWork_other counter result work₀ input address processed + i hic hir] + exact hwork i + +private theorem denseInputTape_startInvariant (input : List Bool) + (head : ℕ) : (denseInputTape input head).StartInvariant := by + constructor + · simp [denseInputTape] + · intro j hj + simpa [denseInputTape] using Tape.init_ofBool_cells_ne_start input j hj + +private theorem denseInputTape_read_bit (input : List Bool) (processed : ℕ) + (hprocessed : processed < input.length) : + (denseInputTape input (processed + 1)).read = + Γ.ofBool (input[processed]'hprocessed) := by + exact Tape.init_ofBool_cells_lt input processed hprocessed + +private theorem denseInputTape_read_blank (input : List Bool) : + (denseInputTape input (input.length + 1)).read = Γ.blank := by + exact Tape.init_ofBool_cells_ge input input.length le_rfl + +private theorem denseInputStepResult_eq (input : List Bool) + (address processed : ℕ) (haddress : address ≠ 0) + (hprocessed : processed < input.length) : + denseInputStepResult (address - processed) + (input[processed]'hprocessed) + (denseInputResultTape input address processed) = + denseInputResultTape input address (processed + 1) := by + by_cases hbefore : address ≤ processed + · rw [denseInputStepResult, if_neg (by omega)] + unfold denseInputResultTape + rw [if_neg haddress, if_pos hbefore, if_neg haddress, + if_pos (le_trans hbefore (by omega))] + · by_cases hcurrent : address = processed + 1 + · subst address + have hremaining : processed + 1 - processed = 1 := by omega + rw [denseInputStepResult, if_pos hremaining] + unfold denseInputResultTape + rw [if_neg haddress, if_pos (le_refl (processed + 1))] + congr 1 + have hindex : processed + 1 - 1 = processed := by omega + rw [hindex] + rw [List.getElem?_eq_getElem hprocessed] + rfl + · have hafter : processed + 1 < address := by omega + have hremaining : address - processed ≠ 1 := by omega + rw [denseInputStepResult, if_neg hremaining] + unfold denseInputResultTape + rw [if_neg haddress, if_neg (by omega), if_neg haddress, + if_neg (Nat.not_le_of_lt hafter)] + +private def denseInputScanCfg {n : ℕ} (counter result : Fin n) + (work₀ : Fin n → Tape) (out₀ : Tape) (input : List Bool) + (address processed : ℕ) : + Complexity.Cfg n (denseInputScanTM counter result).Q := + { state := .inl .scan + input := denseInputTape input (processed + 1) + work := denseInputWork counter result work₀ input address processed + output := out₀ } + +private def denseInputBodyStartCfg {n : ℕ} (counter result : Fin n) + (work₀ : Fin n → Tape) (out₀ : Tape) (input : List Bool) + (address processed : ℕ) : + Complexity.Cfg n (denseInputStepTM counter result).Q := + { state := (denseInputStepTM counter result).qstart + input := denseInputTape input (processed + 2) + work := denseInputWork counter result work₀ input address processed + output := out₀ } + +private def denseInputBodyDoneCfg {n : ℕ} (counter result : Fin n) + (work₀ : Fin n → Tape) (out₀ : Tape) (input : List Bool) + (address processed : ℕ) : + Complexity.Cfg n (denseInputStepTM counter result).Q := + { state := (denseInputStepTM counter result).qhalt + input := denseInputTape input (processed + 2) + work := denseInputWork counter result work₀ input address (processed + 1) + output := out₀ } + +private def denseInputDoneCfg {n : ℕ} (counter result : Fin n) + (work₀ : Fin n → Tape) (out₀ : Tape) (input : List Bool) + (address : ℕ) : Complexity.Cfg n (denseInputScanTM counter result).Q := + { state := .inl .done + input := denseInputTape input (input.length + 1) + work := denseInputWork counter result work₀ input address input.length + output := out₀ } + +private theorem denseInputScanTM_scan_bit_step {n : ℕ} + (counter result : Fin n) (hne : counter ≠ result) + (work₀ : Fin n → Tape) (out₀ : Tape) (input : List Bool) + (address processed : ℕ) (hprocessed : processed < input.length) + (hwork : ∀ i, TM.Parked (work₀ i)) (houtput : TM.Parked out₀) : + (denseInputScanTM counter result).step + (denseInputScanCfg counter result work₀ out₀ input address processed) = + some (TM.forInputBodyWrap (denseInputStepTM counter result) + (denseInputBodyStartCfg counter result work₀ out₀ input address + processed)) := by + have hread := denseInputTape_read_bit input processed hprocessed + have hstep := TM.forInputTM_step_scan_bit_internal + (denseInputStepTM counter result) + (denseInputScanCfg counter result work₀ out₀ input address processed) + rfl + (by + change (denseInputTape input (processed + 1)).read ≠ Γ.start + rw [hread] + exact Γ.ofBool_ne_start _) + (by + change (denseInputTape input (processed + 1)).read ≠ Γ.blank + rw [hread] + exact Γ.ofBool_ne_blank _) + (fun i => (denseInputWork_parked counter result hne work₀ input + address processed hwork i).read_ne_start) + houtput.read_ne_start + simpa [denseInputScanTM, denseInputScanCfg, denseInputBodyStartCfg, + TM.forInputBodyWrap, denseInputTape, Tape.move] using hstep + +private theorem denseInputScanTM_scan_blank_step {n : ℕ} + (counter result : Fin n) (hne : counter ≠ result) + (work₀ : Fin n → Tape) (out₀ : Tape) (input : List Bool) + (address : ℕ) (hwork : ∀ i, TM.Parked (work₀ i)) + (houtput : TM.Parked out₀) : + (denseInputScanTM counter result).step + (denseInputScanCfg counter result work₀ out₀ input address input.length) = + some (denseInputDoneCfg counter result work₀ out₀ input address) := by + have hstep := TM.forInputTM_step_scan_blank_internal + (denseInputStepTM counter result) + (denseInputScanCfg counter result work₀ out₀ input address input.length) + rfl (denseInputTape_read_blank input) + (fun i => (denseInputWork_parked counter result hne work₀ input + address input.length hwork i).read_ne_start) + houtput.read_ne_start + simpa [denseInputScanTM, denseInputScanCfg, denseInputDoneCfg] using hstep + +theorem denseInputStepTM_reachesIn_frame_internal {n : ℕ} + (counter result : Fin n) (hne : counter ≠ result) + (remaining : ℕ) (bit : Bool) (inp₀ : Tape) + (work₀ : Fin n → Tape) (out₀ : Tape) + (hinput : inp₀.StartInvariant) (hhead : 2 ≤ inp₀.head) + (hbit : inp₀.cells (inp₀.head - 1) = Γ.ofBool bit) + (hcounter : (work₀ counter).HasBinaryNat remaining) + (hresult : remaining = 1 → work₀ result = TM.resetBinaryBlank) + (hwork : ∀ i, TM.Parked (work₀ i)) (houtput : TM.Parked out₀) : + ∃ c', + (denseInputStepTM counter result).reachesIn + (denseInputStepTime remaining) + { state := (denseInputStepTM counter result).qstart + input := inp₀ + work := work₀ + output := out₀ } c' ∧ + (denseInputStepTM counter result).halted c' ∧ + c'.input = inp₀ ∧ + (c'.work counter).HasBinaryNat (remaining - 1) ∧ + c'.work result = denseInputStepResult remaining bit (work₀ result) ∧ + (∀ i, i ≠ counter → i ≠ result → c'.work i = work₀ i) ∧ + c'.output = out₀ := by + by_cases hzero : remaining = 0 + · subst remaining + have hblank : (work₀ counter).read = Γ.blank := + hcounter.read_eq_blank_iff.mpr rfl + obtain ⟨idleDone, hidleReach, hidleHalt, hidleInput, + hidleWork, hidleOutput⟩ := + denseInputIdleTM_reachesIn_frame_internal inp₀ work₀ out₀ + ⟨by omega, hinput.2⟩ hwork houtput + obtain ⟨done, hreach, hhalt, hdoneInput, hdoneWork, hdoneOutput⟩ := + TM.branchWorkBlankTM_reachesIn_blank_frame counter + (denseInputIdleTM (n := n)) + (TM.seqTM (TM.binaryPredTM counter) + (TM.branchWorkBlankTM counter + (capturePreviousInputBitTM result) denseInputIdleTM)) + inp₀ work₀ out₀ hblank + (hinput.read_ne_start (by omega)) + (fun i => (hwork i).read_ne_start) houtput.read_ne_start + hidleReach hidleHalt + refine ⟨done, ?_, hhalt, ?_, ?_, ?_, ?_, ?_⟩ + · simpa [denseInputStepTM, denseInputStepTime] + · exact hdoneInput.trans hidleInput + · rw [hdoneWork, hidleWork] + simpa using hcounter + · rw [hdoneWork, hidleWork] + simp [denseInputStepResult] + · intro i _ _ + rw [hdoneWork, hidleWork] + · exact hdoneOutput.trans hidleOutput + · obtain ⟨predecessor, rfl⟩ : ∃ predecessor, remaining = predecessor + 1 := + ⟨remaining - 1, by omega⟩ + have hcounterPos : (work₀ counter).HasBinaryNat (predecessor + 1) := + hcounter + have hnonblank : (work₀ counter).read ≠ Γ.blank := by + exact fun h => by + have := hcounterPos.read_eq_blank_iff.mp h + omega + obtain ⟨predDone, hpredReach, hpredHalt, hpredInput, + hpredOther, hpredCounter, hpredOutput⟩ := + TM.binaryPredTM_reachesIn_frame counter predecessor inp₀ work₀ out₀ + hcounterPos (hinput.read_ne_start (by omega)) + (fun i _ => (hwork i).read_ne_start) houtput.read_ne_start + have hpredResult : predDone.work result = work₀ result := + hpredOther result (Ne.symm hne) + have hpredWorkParked : ∀ i, TM.Parked (predDone.work i) := by + intro i + by_cases hi : i = counter + · subst i + exact ⟨by + simp [Tape.HasBinaryNat, Tape.HasBinaryString] at hpredCounter + omega, + hpredCounter.2.hasBinaryContent.cells_ne_start⟩ + · rw [hpredOther i hi] + exact hwork i + let inner := TM.branchWorkBlankTM counter + (capturePreviousInputBitTM result) (denseInputIdleTM (n := n)) + by_cases hpredZero : predecessor = 0 + · subst predecessor + have hinnerBlank : (predDone.work counter).read = Γ.blank := + hpredCounter.read_eq_blank_iff.mpr rfl + have hresultBlank : predDone.work result = TM.resetBinaryBlank := by + rw [hpredResult] + exact hresult rfl + obtain ⟨captureDone, hcaptureReach, hcaptureHalt, + hcaptureInput, hcaptureWork, hcaptureOutput⟩ := + capturePreviousInputBitTM_reachesIn_frame_internal result bit + predDone.input predDone.work predDone.output + (by simpa [hpredInput] using hinput) + (by simpa [hpredInput] using hhead) + (by simpa [hpredInput] using hbit) + hresultBlank hpredWorkParked (by simpa [hpredOutput] using houtput) + obtain ⟨innerDone, hinnerReach, hinnerHalt, hinnerInput, + hinnerWork, hinnerOutput⟩ := + TM.branchWorkBlankTM_reachesIn_blank_frame counter + (capturePreviousInputBitTM result) (denseInputIdleTM (n := n)) + predDone.input predDone.work predDone.output hinnerBlank + (by simpa [hpredInput] using hinput.read_ne_start (by omega)) + (fun i => (hpredWorkParked i).read_ne_start) + (by simpa [hpredOutput] using houtput.read_ne_start) + hcaptureReach hcaptureHalt + have hpredInputRead : predDone.input.read ≠ Γ.start := by + rw [hpredInput] + exact hinput.read_ne_start (by omega) + have hpredOutputRead : predDone.output.read ≠ Γ.start := by + rw [hpredOutput] + exact houtput.read_ne_start + have htransition := TM.phaseTransition_eq_self_of_reads_ne_start + hpredInputRead (fun i => (hpredWorkParked i).read_ne_start) + hpredOutputRead + have hinnerReach' : inner.reachesIn 3 + { state := inner.qstart + input := TM.transitionInput predDone.input + work := fun i => TM.transitionTape (predDone.work i) + output := TM.transitionTape predDone.output } innerDone := by + simpa [inner, htransition.1, htransition.2.1, htransition.2.2] using + hinnerReach + have hseqReach := TM.seqTM_reachesIn_of_reachesIn + (TM.binaryPredTM counter) inner hpredReach hpredHalt hinnerReach' + have hseqHalt : + (TM.seqTM (TM.binaryPredTM counter) inner).halted + (TM.phase2Wrap (TM.binaryPredTM counter) inner innerDone) := + (TM.phase2Wrap_halted_iff _ _ _).mpr hinnerHalt + obtain ⟨done, hreach, hhalt, hdoneInput, hdoneWork, hdoneOutput⟩ := + TM.branchWorkBlankTM_reachesIn_nonblank_frame counter + (denseInputIdleTM (n := n)) + (TM.seqTM (TM.binaryPredTM counter) inner) + inp₀ work₀ out₀ hnonblank + (hinput.read_ne_start (by omega)) + (fun i => (hwork i).read_ne_start) houtput.read_ne_start + hseqReach hseqHalt + simp only [TM.phase2Wrap] at hdoneInput hdoneWork hdoneOutput + refine ⟨done, ?_, hhalt, ?_, ?_, ?_, ?_, ?_⟩ + · simpa [denseInputStepTM, denseInputStepTime, inner] + · exact hdoneInput.trans + (hinnerInput.trans (hcaptureInput.trans hpredInput)) + · rw [hdoneWork, hinnerWork, hcaptureWork, + Function.update_of_ne hne] + simpa using hpredCounter + · rw [hdoneWork, hinnerWork, hcaptureWork, Function.update_self] + simp [denseInputStepResult] + · intro i hic hir + rw [hdoneWork, hinnerWork, hcaptureWork, + Function.update_of_ne hir] + exact hpredOther i hic + · exact hdoneOutput.trans + (hinnerOutput.trans (hcaptureOutput.trans hpredOutput)) + · have hinnerNonblank : (predDone.work counter).read ≠ Γ.blank := by + exact fun h => hpredZero (hpredCounter.read_eq_blank_iff.mp h) + obtain ⟨idleDone, hidleReach, hidleHalt, hidleInput, + hidleWork, hidleOutput⟩ := + denseInputIdleTM_reachesIn_frame_internal predDone.input + predDone.work predDone.output + (by + rw [hpredInput] + exact (⟨by omega, hinput.2⟩ : TM.Parked inp₀)) + hpredWorkParked (by simpa [hpredOutput] using houtput) + obtain ⟨innerDone, hinnerReach, hinnerHalt, hinnerInput, + hinnerWork, hinnerOutput⟩ := + TM.branchWorkBlankTM_reachesIn_nonblank_frame counter + (capturePreviousInputBitTM result) (denseInputIdleTM (n := n)) + predDone.input predDone.work predDone.output hinnerNonblank + (by simpa [hpredInput] using hinput.read_ne_start (by omega)) + (fun i => (hpredWorkParked i).read_ne_start) + (by simpa [hpredOutput] using houtput.read_ne_start) + hidleReach hidleHalt + have hpredInputRead : predDone.input.read ≠ Γ.start := by + rw [hpredInput] + exact hinput.read_ne_start (by omega) + have hpredOutputRead : predDone.output.read ≠ Γ.start := by + rw [hpredOutput] + exact houtput.read_ne_start + have htransition := TM.phaseTransition_eq_self_of_reads_ne_start + hpredInputRead (fun i => (hpredWorkParked i).read_ne_start) + hpredOutputRead + have hinnerReach' : inner.reachesIn 2 + { state := inner.qstart + input := TM.transitionInput predDone.input + work := fun i => TM.transitionTape (predDone.work i) + output := TM.transitionTape predDone.output } innerDone := by + simpa [inner, htransition.1, htransition.2.1, htransition.2.2] using + hinnerReach + have hseqReach := TM.seqTM_reachesIn_of_reachesIn + (TM.binaryPredTM counter) inner hpredReach hpredHalt hinnerReach' + have hseqHalt : + (TM.seqTM (TM.binaryPredTM counter) inner).halted + (TM.phase2Wrap (TM.binaryPredTM counter) inner innerDone) := + (TM.phase2Wrap_halted_iff _ _ _).mpr hinnerHalt + obtain ⟨done, hreach, hhalt, hdoneInput, hdoneWork, hdoneOutput⟩ := + TM.branchWorkBlankTM_reachesIn_nonblank_frame counter + (denseInputIdleTM (n := n)) + (TM.seqTM (TM.binaryPredTM counter) inner) + inp₀ work₀ out₀ hnonblank + (hinput.read_ne_start (by omega)) + (fun i => (hwork i).read_ne_start) houtput.read_ne_start + hseqReach hseqHalt + simp only [TM.phase2Wrap] at hdoneInput hdoneWork hdoneOutput + refine ⟨done, ?_, hhalt, ?_, ?_, ?_, ?_, ?_⟩ + · have hnotOne : predecessor + 1 ≠ 1 := by omega + simpa [denseInputStepTM, denseInputStepTime, inner, hnotOne, + hpredZero] + · exact hdoneInput.trans + (hinnerInput.trans (hidleInput.trans hpredInput)) + · rw [hdoneWork, hinnerWork, hidleWork] + simpa using hpredCounter + · rw [hdoneWork, hinnerWork, hidleWork] + simpa [denseInputStepResult, hpredZero] using hpredResult + · intro i hic _ + rw [hdoneWork, hinnerWork, hidleWork] + exact hpredOther i hic + · exact hdoneOutput.trans + (hinnerOutput.trans (hidleOutput.trans hpredOutput)) + +private theorem denseInputScanTM_body_run {n : ℕ} + (counter result : Fin n) (hne : counter ≠ result) + (work₀ : Fin n → Tape) (out₀ : Tape) (input : List Bool) + (address processed : ℕ) (haddress : address ≠ 0) + (hprocessed : processed < input.length) + (hwork : ∀ i, TM.Parked (work₀ i)) (houtput : TM.Parked out₀) : + (denseInputStepTM counter result).reachesIn + (denseInputStepTime (address - processed)) + (denseInputBodyStartCfg counter result work₀ out₀ input address + processed) + (denseInputBodyDoneCfg counter result work₀ out₀ input address + processed) := by + let initialWork := denseInputWork counter result work₀ input address processed + obtain ⟨done, hreach, hhalt, hdoneInput, hdoneCounter, + hdoneResult, hdoneOther, hdoneOutput⟩ := + denseInputStepTM_reachesIn_frame_internal counter result hne + (address - processed) (input[processed]'hprocessed) + (denseInputTape input (processed + 2)) initialWork out₀ + (denseInputTape_startInvariant input (processed + 2)) + (by simp [denseInputTape]) + (by + change (Tape.init (input.map Γ.ofBool)).cells + (processed + 2 - 1) = Γ.ofBool input[processed] + have hindex : processed + 2 - 1 = processed + 1 := by omega + rw [hindex] + exact Tape.init_ofBool_cells_lt input processed hprocessed) + (by + change (denseInputWork counter result work₀ input address processed + counter).HasBinaryNat (address - processed) + rw [denseInputWork_counter counter result hne] + exact denseInputNatTape_hasBinaryNat _) + (by + intro hremaining + change denseInputWork counter result work₀ input address processed + result = TM.resetBinaryBlank + rw [denseInputWork_result] + unfold denseInputResultTape + rw [if_neg haddress, if_neg (by omega)]) + (denseInputWork_parked counter result hne work₀ input address + processed hwork) houtput + have hdone : done = + denseInputBodyDoneCfg counter result work₀ out₀ input address processed := by + apply Complexity.Cfg.ext hhalt + · exact hdoneInput + · funext i + change done.work i = denseInputWork counter result work₀ input address + (processed + 1) i + by_cases hic : i = counter + · subst i + rw [denseInputWork_counter counter result hne] + have hcanonical := hdoneCounter.eq_init_move_right + have hsub : address - processed - 1 = address - (processed + 1) := by + omega + simpa [denseInputNatTape, hsub] using hcanonical + · by_cases hir : i = result + · subst i + rw [denseInputWork_result] + rw [hdoneResult] + change denseInputStepResult (address - processed) + (input[processed]'hprocessed) + (denseInputWork counter result work₀ input address processed + result) = denseInputResultTape input address (processed + 1) + rw [denseInputWork_result] + exact denseInputStepResult_eq input address processed haddress hprocessed + · rw [denseInputWork_other counter result work₀ input address + (processed + 1) i hic hir] + rw [hdoneOther i hic hir] + exact denseInputWork_other counter result work₀ input address + processed i hic hir + · exact hdoneOutput + rw [← hdone] + exact hreach + +private theorem denseInputScanTM_loopback_step {n : ℕ} + (counter result : Fin n) (hne : counter ≠ result) + (work₀ : Fin n → Tape) (out₀ : Tape) (input : List Bool) + (address processed : ℕ) (hwork : ∀ i, TM.Parked (work₀ i)) + (houtput : TM.Parked out₀) : + (denseInputScanTM counter result).step + (TM.forInputBodyWrap (denseInputStepTM counter result) + (denseInputBodyDoneCfg counter result work₀ out₀ input address + processed)) = + some (denseInputScanCfg counter result work₀ out₀ input address + (processed + 1)) := by + have hstep := TM.forInputTM_step_body_halt_internal + (denseInputStepTM counter result) + (denseInputBodyDoneCfg counter result work₀ out₀ input address processed) + rfl + ((denseInputTape_startInvariant input (processed + 2)).read_ne_start + (by simp [denseInputTape])) + (fun i => (denseInputWork_parked counter result hne work₀ input + address (processed + 1) hwork i).read_ne_start) + houtput.read_ne_start + simpa [denseInputScanTM, denseInputBodyDoneCfg, denseInputScanCfg, + TM.forInputBodyWrap, Nat.add_assoc, Nat.add_comm, Nat.add_left_comm] using + hstep + +private def denseInputLoopSpec {n : ℕ} (counter result : Fin n) + (hne : counter ≠ result) (work₀ : Fin n → Tape) (out₀ : Tape) + (input : List Bool) (address : ℕ) (haddress : address ≠ 0) + (hwork : ∀ i, TM.Parked (work₀ i)) (houtput : TM.Parked out₀) : + TM.ForInputLoopSpec (denseInputStepTM counter result) + (fun processed => denseInputStepTime (address - processed)) + input.length where + scanCfg := denseInputScanCfg counter result work₀ out₀ input address + bodyStartCfg := fun processed => + TM.forInputBodyWrap (denseInputStepTM counter result) + (denseInputBodyStartCfg counter result work₀ out₀ input address processed) + bodyDoneCfg := fun processed => + TM.forInputBodyWrap (denseInputStepTM counter result) + (denseInputBodyDoneCfg counter result work₀ out₀ input address processed) + doneCfg := denseInputDoneCfg counter result work₀ out₀ input address + scanStep := fun processed hprocessed => + denseInputScanTM_scan_bit_step counter result hne work₀ out₀ input + address processed hprocessed hwork houtput + bodyRun := fun processed hprocessed => by + simpa [denseInputScanTM] using + TM.forInputTM_body_reachesIn_internal (denseInputStepTM counter result) + (denseInputScanTM_body_run counter result hne work₀ out₀ input + address processed haddress hprocessed hwork houtput) + loopbackStep := fun processed _ => + denseInputScanTM_loopback_step counter result hne work₀ out₀ input + address processed hwork houtput + blankStep := denseInputScanTM_scan_blank_step counter result hne work₀ out₀ + input address hwork houtput + +private theorem denseInputResultTape_final_hasBinaryNat + (input : List Bool) (address : ℕ) (haddress : address ≠ 0) : + (denseInputResultTape input address input.length).HasBinaryNat + (Complexity.RAM.initRegs input address) := by + by_cases hindex : address ≤ input.length + · have hlt : address - 1 < input.length := by omega + rw [denseInputResultTape, if_neg haddress, if_pos hindex] + rw [Complexity.RAM.initRegs, if_neg haddress, + List.getElem?_eq_getElem hlt] + simpa using denseInputBitTape_hasBinaryNat_internal + (input[address - 1]'hlt) + · have hnone : input[address - 1]? = none := + List.getElem?_eq_none (by omega) + rw [denseInputResultTape, if_neg haddress, if_neg hindex] + simpa [Complexity.RAM.initRegs, haddress, hnone, + TM.resetBinaryBlank] using + Tape.init_move_right_hasBinaryNat 0 + +theorem denseInputScanTM_reachesIn_frame_internal {n : ℕ} + (counter result : Fin n) (hne : counter ≠ result) + (input : List Bool) (address : ℕ) (work₀ : Fin n → Tape) + (out₀ : Tape) (haddress : address ≠ 0) + (hcounter : (work₀ counter).HasBinaryNat address) + (hresult : work₀ result = TM.resetBinaryBlank) + (hwork : ∀ i, TM.Parked (work₀ i)) (houtput : TM.Parked out₀) : + ∃ c', + (denseInputScanTM counter result).reachesIn + (denseInputScanTime input.length address) + { state := (denseInputScanTM counter result).qstart + input := (Tape.init (input.map Γ.ofBool)).move Dir3.right + work := work₀ + output := out₀ } c' ∧ + (denseInputScanTM counter result).halted c' ∧ + c'.input.head = input.length + 1 ∧ + c'.input.cells = (Tape.init (input.map Γ.ofBool)).cells ∧ + (c'.work counter).HasBinaryNat (address - input.length) ∧ + (c'.work result).HasBinaryNat (Complexity.RAM.initRegs input address) ∧ + (∀ i, i ≠ counter → i ≠ result → c'.work i = work₀ i) ∧ + c'.output = out₀ := by + let spec := denseInputLoopSpec counter result hne work₀ out₀ input address + haddress hwork houtput + have hstart : + { state := (denseInputScanTM counter result).qstart + input := (Tape.init (input.map Γ.ofBool)).move Dir3.right + work := work₀ + output := out₀ } = spec.scanCfg 0 := by + change + { state := (denseInputScanTM counter result).qstart + input := (Tape.init (input.map Γ.ofBool)).move Dir3.right + work := work₀ + output := out₀ } = + denseInputScanCfg counter result work₀ out₀ input address 0 + apply Complexity.Cfg.ext + (c := + { state := (denseInputScanTM counter result).qstart + input := (Tape.init (input.map Γ.ofBool)).move Dir3.right + work := work₀ + output := out₀ }) + (c' := denseInputScanCfg counter result work₀ out₀ input address 0) + rfl + · apply Tape.ext + · simp [denseInputScanCfg, denseInputTape, Tape.move] + · simp [denseInputScanCfg, denseInputTape, Tape.move] + · funext i + change work₀ i = denseInputWork counter result work₀ input address 0 i + by_cases hic : i = counter + · subst i + rw [denseInputWork_counter counter result hne] + simpa [denseInputNatTape] using hcounter.eq_init_move_right + · by_cases hir : i = result + · subst i + rw [denseInputWork_result, hresult] + unfold denseInputResultTape + rw [if_neg haddress, if_neg (by omega)] + · rw [denseInputWork_other counter result work₀ input address 0 + i hic hir] + · rfl + have hrun := spec.reachesIn_internal input.length 0 (by omega) + rw [← hstart] at hrun + let done := denseInputDoneCfg counter result work₀ out₀ input address + refine ⟨done, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_⟩ + · simpa [denseInputScanTime, spec, denseInputLoopSpec, done] using hrun + · rfl + · rfl + · rfl + · change (denseInputWork counter result work₀ input address input.length + counter).HasBinaryNat (address - input.length) + rw [denseInputWork_counter counter result hne] + exact denseInputNatTape_hasBinaryNat _ + · change (denseInputWork counter result work₀ input address input.length + result).HasBinaryNat (Complexity.RAM.initRegs input address) + rw [denseInputWork_result] + exact denseInputResultTape_final_hasBinaryNat input address haddress + · intro i hic hir + change denseInputWork counter result work₀ input address input.length i = + work₀ i + exact denseInputWork_other counter result work₀ input address input.length + i hic hir + · rfl + +private theorem denseInputStepTime_le_width (address processed : ℕ) : + denseInputStepTime (address - processed) ≤ 2 * address.size + 7 := by + by_cases hzero : address - processed = 0 + · simp [denseInputStepTime, hzero] + · by_cases hone : address - processed = 1 + · have hpred := TM.binaryPredTime_le_internal 0 + have hsize : 1 ≤ address.size := + Nat.size_pos.mpr (by omega) + simp [denseInputStepTime, hone] at hpred ⊢ + omega + · have hpred := + TM.binaryPredTime_le_internal (address - processed - 1) + have hwidth : (address - processed).size ≤ address.size := + Nat.size_le_size (Nat.sub_le address processed) + rw [denseInputStepTime, if_neg hzero, if_neg hone] + have hsucc : address - processed - 1 + 1 = address - processed := by + omega + rw [hsucc] at hpred + omega + +private theorem denseInputLoopTime_le_width (inputLength address processed : ℕ) : + TM.forInputLoopTime + (fun current => denseInputStepTime (address - current)) + processed inputLength ≤ + inputLength * (2 * address.size + 9) + 1 := by + induction inputLength generalizing processed with + | zero => simp [TM.forInputLoopTime] + | succ count ih => + rw [TM.forInputLoopTime] + have hbody := denseInputStepTime_le_width address processed + have htail := ih (processed + 1) + rw [Nat.add_mul, one_mul] + omega + +theorem denseInputScanTime_le_width_internal (inputLength address : ℕ) : + denseInputScanTime inputLength address ≤ + inputLength * (2 * address.size + 9) + 1 := by + exact denseInputLoopTime_le_width inputLength address 0 + +private theorem parked_of_hasBinaryNat {tape : Tape} {value : ℕ} + (hvalue : tape.HasBinaryNat value) : TM.Parked tape := + ⟨by rw [hvalue.2.1], hvalue.2.hasBinaryContent.cells_ne_start⟩ + +theorem denseInputLookupTM_hoareTime_internal {n : ℕ} + (query counter result scratch : Fin n) + (hqc : query ≠ counter) (hqr : query ≠ result) + (hqs : query ≠ scratch) (hcr : counter ≠ result) + (hcs : counter ≠ scratch) (hrs : result ≠ scratch) + (input : List Bool) (address : ℕ) (initialWork : Fin n → Tape) + (out₀ : Tape) (haddress : address ≠ 0) + (hready : DenseInputLookupReady query counter result scratch address + initialWork) + (houtput : TM.Parked out₀) : + (denseInputLookupTM query counter result scratch).HoareTime + (fun inp work out => + inp = (Tape.init (input.map Γ.ofBool)).move Dir3.right ∧ + work = initialWork ∧ out = out₀) + (fun inp work out => + inp = (Tape.init (input.map Γ.ofBool)).move Dir3.right ∧ + DenseInputLookupResult query counter result scratch input address + initialWork work ∧ + out = out₀) + (denseInputLookupTime input.length address) := by + let inp₀ := (Tape.init (input.map Γ.ofBool)).move Dir3.right + let copiedWork := Function.update initialWork counter + (denseInputNatTape address) + have hinput : TM.Parked inp₀ := by + refine ⟨by simp [inp₀, Tape.move], ?_⟩ + simpa [inp₀] using Tape.init_ofBool_move_right_cells_ne_start input + have hcopiedCounter : (copiedWork counter).HasBinaryNat address := by + simp only [copiedWork, Function.update_self] + exact denseInputNatTape_hasBinaryNat address + have hcopiedResult : copiedWork result = TM.resetBinaryBlank := by + simp only [copiedWork, Function.update_of_ne hcr.symm] + simpa [TM.resetBinaryBlank] using hready.result.eq_init_move_right + have hcopiedParked : ∀ i, TM.Parked (copiedWork i) := by + intro i + by_cases hi : i = counter + · subst i + exact parked_of_hasBinaryNat hcopiedCounter + · simp only [copiedWork, Function.update_of_ne hi] + exact hready.parked i + have hcopyRaw := TM.binaryCopyIntoTM_hoareTime_frame + query counter scratch hqc hqs hcs address 0 inp₀ initialWork out₀ + hready.query hready.counter hready.scratch hinput + (fun i _ _ _ => hready.parked i) houtput + have hcopy : (TM.binaryCopyIntoTM query counter scratch).HoareTime + (fun inp work out => inp = inp₀ ∧ work = initialWork ∧ out = out₀) + (fun inp work out => inp = inp₀ ∧ work = copiedWork ∧ out = out₀) + (TM.binaryCopyTime address 0) := by + simpa [copiedWork, denseInputNatTape] using hcopyRaw + let scannedPost : TM.TapePred n := fun inp work out => + inp.head = input.length + 1 ∧ inp.cells = inp₀.cells ∧ + (work counter).HasBinaryNat (address - input.length) ∧ + (work result).HasBinaryNat (Complexity.RAM.initRegs input address) ∧ + (∀ i, i ≠ counter → i ≠ result → work i = copiedWork i) ∧ + (∀ i, TM.Parked (work i)) ∧ out = out₀ + have hscan : (denseInputScanTM counter result).HoareTime + (fun inp work out => inp = inp₀ ∧ work = copiedWork ∧ out = out₀) + scannedPost (denseInputScanTime input.length address) := by + intro inp work out ⟨hinp, hwork, hout⟩ + subst inp + subst work + subst out + obtain ⟨done, hreach, hhalt, hdoneHead, hdoneCells, + hdoneCounter, hdoneResult, hdoneOther, hdoneOutput⟩ := + denseInputScanTM_reachesIn_frame_internal counter result hcr input + address copiedWork out₀ haddress hcopiedCounter hcopiedResult + hcopiedParked houtput + have hdoneParked : ∀ i, TM.Parked (done.work i) := by + intro i + by_cases hic : i = counter + · subst i + exact parked_of_hasBinaryNat hdoneCounter + · by_cases hir : i = result + · subst i + exact parked_of_hasBinaryNat hdoneResult + · rw [hdoneOther i hic hir] + exact hcopiedParked i + exact ⟨done, denseInputScanTime input.length address, le_rfl, + hreach, hhalt, hdoneHead, by simpa [inp₀] using hdoneCells, + hdoneCounter, hdoneResult, hdoneOther, hdoneParked, hdoneOutput⟩ + let stablePost : TM.TapePred n := fun inp work out => + inp.cells = inp₀.cells ∧ + (work counter).HasBinaryNat (address - input.length) ∧ + (work result).HasBinaryNat (Complexity.RAM.initRegs input address) ∧ + (∀ i, i ≠ counter → i ≠ result → work i = copiedWork i) ∧ + (∀ i, TM.Parked (work i)) ∧ out = out₀ + let rewoundPost : TM.TapePred n := fun inp work out => + inp.head = 1 ∧ stablePost inp work out + have hrewind : (TM.rewindInputTM (n := n)).HoareTime + scannedPost rewoundPost (input.length + 3) := by + have hraw := TM.rewindInputTM_hoareTime_frame (n := n) + (input.length + 1) (P := stablePost) + (by + intro inp work out inp' work' out' hstable hcells hhead + hwork hout + subst work' + subst out' + exact ⟨hcells.trans hstable.1, hstable.2⟩) + intro inp work out hscanned + rcases hscanned with ⟨hhead, hcells, hcounter, hresult, + hother, hparked, hout⟩ + have hstart : inp.cells 0 = Γ.start := by + rw [hcells] + simp [inp₀, Tape.move] + have hnostart : ∀ j, j ≥ 1 → inp.cells j ≠ Γ.start := by + intro j hj + rw [hcells] + simpa [inp₀] using + Tape.init_ofBool_move_right_cells_ne_start input j hj + exact hraw inp work out + ⟨hstart, hnostart, by omega, hout ▸ houtput.read_ne_start, + hout ▸ houtput.1, + fun i => ⟨(hparked i).read_ne_start, (hparked i).1⟩, + hcells, hcounter, hresult, hother, hparked, hout⟩ + have hscanTransition : ∀ inp work out, scannedPost inp work out → + scannedPost (TM.transitionInput inp) + (fun i => TM.transitionTape (work i)) (TM.transitionTape out) := by + intro inp work out hscanned + rcases hscanned with ⟨hhead, hcells, hcounter, hresult, + hother, hparked, hout⟩ + have hinpParked : TM.Parked inp := by + refine ⟨by omega, ?_⟩ + intro j hj + rw [hcells] + simpa [inp₀] using + Tape.init_ofBool_move_right_cells_ne_start input j hj + obtain ⟨hi, hw, ho⟩ := TM.phaseTransition_eq_self_of_reads_ne_start + hinpParked.read_ne_start (fun i => (hparked i).read_ne_start) + (hout ▸ houtput.read_ne_start) + rw [hi, hw, ho] + exact ⟨hhead, hcells, hcounter, hresult, hother, hparked, hout⟩ + let finalPost : TM.TapePred n := fun inp work out => + inp = inp₀ ∧ + DenseInputLookupResult query counter result scratch input address + initialWork work ∧ + out = out₀ + have hreset : (TM.resetBinaryWorkTM counter).HoareTime + rewoundPost finalPost + (TM.resetBinaryWorkTime 1 + (address - input.length).bits.length) := by + intro inp work out hrewound + rcases hrewound with ⟨hhead, hcells, hcounter, hresult, + hother, hparked, hout⟩ + have hinp : inp = inp₀ := by + apply Tape.ext + · simpa [inp₀, Tape.move] using hhead + · exact hcells + have hrun := TM.resetBinaryWorkTM_hoareTime_frame counter + (address - input.length).bits 1 inp work out + hcounter.2.hasBinaryContent hcounter.1 + ⟨by rw [hcounter.2.1], by rw [hcounter.2.1]⟩ + (by simpa [hinp] using hinput) + (fun i _ => hparked i) (by simpa [hout] using houtput) + obtain ⟨done, time, htime, hreach, hhalt, hdoneInput, + hdoneWork, hdoneOutput⟩ := + hrun inp work out ⟨rfl, rfl, rfl⟩ + have hblankNat : + ((Tape.init []).move Dir3.right).HasBinaryNat 0 := by + simpa using Tape.init_move_right_hasBinaryNat 0 + have hdoneResult : DenseInputLookupResult query counter result scratch + input address initialWork done.work := by + rw [hdoneWork] + constructor + · rw [Function.update_of_ne hqc] + rw [hother query hqc hqr] + simp [copiedWork, Function.update_of_ne hqc] + · rw [Function.update_self] + exact hblankNat + · rw [Function.update_of_ne hcr.symm] + exact hresult + · rw [Function.update_of_ne hcs.symm] + rw [hother scratch hcs.symm hrs.symm] + simp [copiedWork, Function.update_of_ne hcs.symm] + · intro i + by_cases hi : i = counter + · subst i + rw [Function.update_self] + exact parked_of_hasBinaryNat hblankNat + · rw [Function.update_of_ne hi] + exact hparked i + · intro i _ hic hir _ + rw [Function.update_of_ne hic] + rw [hother i hic hir] + simp [copiedWork, Function.update_of_ne hic] + exact ⟨done, time, htime, hreach, hhalt, + hdoneInput.trans hinp, hdoneResult, hdoneOutput.trans hout⟩ + have hrewindTransition : ∀ inp work out, rewoundPost inp work out → + rewoundPost (TM.transitionInput inp) + (fun i => TM.transitionTape (work i)) (TM.transitionTape out) := by + intro inp work out hrewound + rcases hrewound with ⟨hhead, hcells, hcounter, hresult, + hother, hparked, hout⟩ + have hinpParked : TM.Parked inp := by + refine ⟨by omega, ?_⟩ + intro j hj + rw [hcells] + simpa [inp₀] using + Tape.init_ofBool_move_right_cells_ne_start input j hj + obtain ⟨hi, hw, ho⟩ := TM.phaseTransition_eq_self_of_reads_ne_start + hinpParked.read_ne_start (fun i => (hparked i).read_ne_start) + (hout ▸ houtput.read_ne_start) + rw [hi, hw, ho] + exact ⟨hhead, hcells, hcounter, hresult, hother, hparked, hout⟩ + have hrewindReset := TM.seqTM_hoareTime + (TM.rewindInputTM (n := n)) (TM.resetBinaryWorkTM counter) + hrewind hrewindTransition hreset + have hscanTail := TM.seqTM_hoareTime + (denseInputScanTM counter result) + (TM.seqTM (TM.rewindInputTM (n := n)) + (TM.resetBinaryWorkTM counter)) + hscan hscanTransition hrewindReset + have hcopyTransition : ∀ inp work out, + (inp = inp₀ ∧ work = copiedWork ∧ out = out₀) → + (TM.transitionInput inp = inp₀ ∧ + (fun i => TM.transitionTape (work i)) = copiedWork ∧ + TM.transitionTape out = out₀) := by + intro inp work out ⟨hinp, hwork, hout⟩ + subst inp + subst work + subst out + obtain ⟨hi, hw, ho⟩ := TM.phaseTransition_eq_self_of_reads_ne_start + hinput.read_ne_start (fun i => (hcopiedParked i).read_ne_start) + houtput.read_ne_start + exact ⟨hi, hw, ho⟩ + have hall := TM.seqTM_hoareTime + (TM.binaryCopyIntoTM query counter scratch) + (TM.seqTM (denseInputScanTM counter result) + (TM.seqTM (TM.rewindInputTM (n := n)) + (TM.resetBinaryWorkTM counter))) + hcopy hcopyTransition hscanTail + simpa [denseInputLookupTM, denseInputLookupTime, inp₀, finalPost] using hall + +end Machine +end RegisterStore +end RAM +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryAppend.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryAppend.lean new file mode 100644 index 0000000000..b06359a3ba --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryAppend.lean @@ -0,0 +1,73 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryAppend.Defs +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryAppend.Internal + +/-! +# Sparse-entry final append +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace RegisterStore + +namespace Machine + +/-- Append one absent query/nonzero-value entry and restore both canonical +source tapes exactly, retaining the caller's complete work family. -/ +theorem entryAppendRestoreTM_hoareTime_frame {n : ℕ} + (tapes : EntryReplaceTapes n) (address newValue : ℕ) + (emitted : List Bool) (initialWork readyWork : Fin n → Tape) + (inp₀ out₀ : Tape) + (hready : EntryScanReady tapes.entry [] address.bits initialWork readyWork) + (hreplacement : (readyWork tapes.replacement).HasBinaryNat newValue) + (hinput : TM.Parked inp₀) (houtput : out₀.HasBinaryPrefix emitted) : + (entryAppendRestoreTM tapes).HoareTime + (fun inp work out => inp = inp₀ ∧ work = readyWork ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ work = readyWork ∧ + out.HasBinaryPrefix + (emitted ++ Entry.encode (address, newValue))) + (entryAppendRestoreTime address newValue) := + entryAppendRestoreTM_hoareTime_frame_internal tapes address newValue + emitted initialWork readyWork inp₀ out₀ hready hreplacement hinput houtput + +/-- Final append and restoration are append-only on the output tape. -/ +theorem entryAppendRestoreTM_isTransducer {n : ℕ} + (tapes : EntryReplaceTapes n) : + (entryAppendRestoreTM tapes).IsTransducer := + (rewindEntryEncodeTM_isTransducer tapes.appendEncodeTapes).seqTM + ((TM.rewindWorkTM_isTransducer tapes.entry.query).seqTM + (TM.rewindWorkTM_isTransducer tapes.replacement)) + +/-- Coarse all-prefix auxiliary-space envelope for final append/restoration. -/ +theorem entryAppendRestoreTM_prefix_withinAuxSpace {n : ℕ} + (tapes : EntryReplaceTapes n) (address newValue : ℕ) + (inputLength initialSpace time : ℕ) + (start current : Complexity.Cfg n (entryAppendRestoreTM tapes).Q) + (hinitial : start.WithinAuxSpace inputLength initialSpace) + (hreach : (entryAppendRestoreTM tapes).reachesIn time start current) + (htime : time ≤ entryAppendRestoreTime address newValue) : + current.WithinAuxSpace inputLength + (initialSpace + entryAppendRestoreTime address newValue) := + (hinitial.reachesIn hreach).mono le_rfl (by omega) + +end Machine + +end RegisterStore + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryAppend/Defs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryAppend/Defs.lean new file mode 100644 index 0000000000..a92d3c293f --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryAppend/Defs.lean @@ -0,0 +1,67 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryReplace.Defs + +/-! +# Sparse-entry final append — definitions + +When an update exhausts the old store without a match, a nonzero new value is +appended using the preserved query and replacement tapes. Both sources are then +restored exactly so the caller retains its canonical work frame. +-/ + + +@[expose] public section + +namespace Complexity + +namespace RAM + +namespace RegisterStore + +namespace Machine + +namespace EntryReplaceTapes + +/-- View the preserved query and replacement tapes as a fresh-entry encoder. -/ +def appendEncodeTapes {n : ℕ} + (tapes : EntryReplaceTapes n) : EntryEncodeTapes n where + address := tapes.entry.query + value := tapes.replacement + ne := Ne.symm (tapes.replacement_ne 7) + +@[simp] theorem appendEncodeTapes_address {n : ℕ} + (tapes : EntryReplaceTapes n) : + tapes.appendEncodeTapes.address = tapes.entry.query := rfl + +@[simp] theorem appendEncodeTapes_value {n : ℕ} + (tapes : EntryReplaceTapes n) : + tapes.appendEncodeTapes.value = tapes.replacement := rfl + +end EntryReplaceTapes + +/-- Emit a fresh query/value entry and restore both canonical source cursors. -/ +def entryAppendRestoreTM {n : ℕ} (tapes : EntryReplaceTapes n) : TM n := + TM.seqTM (rewindEntryEncodeTM tapes.appendEncodeTapes) + (TM.seqTM (TM.rewindWorkTM tapes.entry.query) + (TM.rewindWorkTM tapes.replacement)) + +/-- Exact compositional bound for final append and two-source restoration. -/ +def entryAppendRestoreTime (address newValue : ℕ) : ℕ := + rewindEntryEncodeTime (address, newValue) 1 1 + 1 + + (address.bits.length + 1 + 2 + 1 + + (newValue.bits.length + 1 + 2)) + +end Machine + +end RegisterStore + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryAppend/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryAppend/Internal.lean new file mode 100644 index 0000000000..6d27de5bc8 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryAppend/Internal.lean @@ -0,0 +1,264 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryAppend.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryEncode +public import Mathlib.Data.Rat.Cast.Order +public import Mathlib.Tactic.NormNum.Abs +public import Mathlib.Tactic.NormNum.DivMod +public import Mathlib.Tactic.NormNum.OfScientific + +/-! +# Sparse-entry final append — proof internals +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace RegisterStore + +namespace Machine + +variable {n : ℕ} + +private theorem parked_of_binarySuffix {t : Tape} {bits : List Bool} + (h : t.HasBinarySuffix bits) : TM.Parked t := + ⟨h.1, h.2.2.2⟩ + +private theorem parked_of_binaryPrefix {t : Tape} {bits : List Bool} + (h : t.HasBinaryPrefix bits) : TM.Parked t := + ⟨by rw [h.1]; omega, + (show t.HasBinaryContent bits from h.2).cells_ne_start⟩ + +theorem entryAppendRestoreTM_hoareTime_frame_internal + (tapes : EntryReplaceTapes n) (address newValue : ℕ) + (emitted : List Bool) (initialWork readyWork : Fin n → Tape) + (inp₀ out₀ : Tape) + (hready : EntryScanReady tapes.entry [] address.bits initialWork readyWork) + (hreplacement : (readyWork tapes.replacement).HasBinaryNat newValue) + (hinput : TM.Parked inp₀) (houtput : out₀.HasBinaryPrefix emitted) : + (entryAppendRestoreTM tapes).HoareTime + (fun inp work out => inp = inp₀ ∧ work = readyWork ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ work = readyWork ∧ + out.HasBinaryPrefix + (emitted ++ Entry.encode (address, newValue))) + (entryAppendRestoreTime address newValue) := by + intro inp work out hpre + rcases hpre with ⟨hinp, hwork, hout⟩ + subst inp + subst work + subst out + have hqueryHead : 1 ≤ (readyWork tapes.entry.query).head ∧ + (readyWork tapes.entry.query).head ≤ 1 := by + rw [hready.query.1] + exact ⟨le_rfl, le_rfl⟩ + have hreplacementHead : 1 ≤ (readyWork tapes.replacement).head ∧ + (readyWork tapes.replacement).head ≤ 1 := by + rw [hreplacement.2.1] + exact ⟨le_rfl, le_rfl⟩ + have hencode := rewindEntryEncodeTM_hoareTime_frame + tapes.appendEncodeTapes (address, newValue) 1 1 emitted + inp₀ readyWork out₀ hready.query.2 hready.queryStart hqueryHead + hreplacement.2.hasBinaryContent hreplacement.1 hreplacementHead + hinput (fun i _ _ => hready.parked i) houtput + obtain ⟨encoded, encodeTime, hencodeTime, hencodeReach, hencodeHalt, + hencodedInput, hquerySuffix, hqueryCells, hqueryEncodedHead, + hreplacementSuffix, hreplacementCells, hreplacementEncodedHead, + hencodedFrame, hencodedOutput⟩ := + hencode inp₀ readyWork out₀ ⟨rfl, rfl, rfl⟩ + have hqueryCells' : (encoded.work tapes.entry.query).cells = + (readyWork tapes.entry.query).cells := by + simpa using hqueryCells + have hqueryEncodedHead' : (encoded.work tapes.entry.query).head = + address.bits.length + 1 := by + simpa using hqueryEncodedHead + have hreplacementCells' : (encoded.work tapes.replacement).cells = + (readyWork tapes.replacement).cells := by + simpa using hreplacementCells + have hreplacementEncodedHead' : + (encoded.work tapes.replacement).head = newValue.bits.length + 1 := by + simpa using hreplacementEncodedHead + have hencodedInputParked : TM.Parked encoded.input := by + rw [hencodedInput] + exact hinput + have hencodedOutputParked : TM.Parked encoded.output := + parked_of_binaryPrefix hencodedOutput + have hencodedWorkParked : ∀ i, TM.Parked (encoded.work i) := by + intro i + by_cases hiq : i = tapes.entry.query + · subst i + exact parked_of_binarySuffix (by simpa using hquerySuffix) + · by_cases hir : i = tapes.replacement + · subst i + exact parked_of_binarySuffix (by simpa using hreplacementSuffix) + · rw [hencodedFrame i hiq hir] + exact hready.parked i + have hqueryContent : + (encoded.work tapes.entry.query).HasBinaryContent address.bits := by + simpa only [Tape.HasBinaryContent, hqueryCells'] using hready.query.2 + have hqueryStart : + (encoded.work tapes.entry.query).cells 0 = Γ.start := by + rw [hqueryCells'] + exact hready.queryStart + have hqueryRewind := TM.rewindBinaryWorkTM_hoareTime_frame + tapes.entry.query address.bits (address.bits.length + 1) + encoded.input encoded.work encoded.output hqueryContent hqueryStart + ⟨by rw [hqueryEncodedHead']; omega, by rw [hqueryEncodedHead']⟩ + hencodedInputParked (fun i _ => hencodedWorkParked i) + hencodedOutputParked + obtain ⟨queryRewound, queryTime, hqueryTime, hqueryReach, hqueryHalt, + hqueryInput, hqueryRestoredCanonical, hqueryFrame, + hqueryOutput⟩ := + hqueryRewind encoded.input encoded.work encoded.output ⟨rfl, rfl, rfl⟩ + have hqueryCanonical : readyWork tapes.entry.query = + (Tape.init (address.bits.map Γ.ofBool)).move Dir3.right := + Tape.eq_init_move_right_of_hasBinaryString hready.query hready.queryStart + have hqueryRestored : queryRewound.work tapes.entry.query = + readyWork tapes.entry.query := + hqueryRestoredCanonical.trans hqueryCanonical.symm + have hreplacementContent : + (queryRewound.work tapes.replacement).HasBinaryContent newValue.bits := by + rw [hqueryFrame tapes.replacement + (tapes.replacement_ne 7)] + simpa only [Tape.HasBinaryContent, hreplacementCells'] using + hreplacement.2.hasBinaryContent + have hreplacementStart : + (queryRewound.work tapes.replacement).cells 0 = Γ.start := by + rw [hqueryFrame tapes.replacement + (tapes.replacement_ne 7), hreplacementCells'] + exact hreplacement.1 + have hreplacementHead' : + (queryRewound.work tapes.replacement).head = + newValue.bits.length + 1 := by + rw [hqueryFrame tapes.replacement + (tapes.replacement_ne 7)] + exact hreplacementEncodedHead' + have hqueryInputParked : TM.Parked queryRewound.input := by + rw [hqueryInput] + exact hencodedInputParked + have hqueryOutputParked : TM.Parked queryRewound.output := by + rw [hqueryOutput] + exact hencodedOutputParked + have hqueryWorkParked : ∀ i, TM.Parked (queryRewound.work i) := by + intro i + by_cases hiq : i = tapes.entry.query + · subst i + rw [hqueryRestored] + exact hready.parked tapes.entry.query + · rw [hqueryFrame i hiq] + exact hencodedWorkParked i + have hreplacementRewind := TM.rewindBinaryWorkTM_hoareTime_frame + tapes.replacement newValue.bits (newValue.bits.length + 1) + queryRewound.input queryRewound.work queryRewound.output + hreplacementContent hreplacementStart + ⟨by rw [hreplacementHead']; omega, by rw [hreplacementHead']⟩ + hqueryInputParked (fun i _ => hqueryWorkParked i) hqueryOutputParked + obtain ⟨restored, replacementTime, hreplacementTime, + hreplacementReach, hreplacementHalt, hreplacementInput, + hreplacementRestoredCanonical, hreplacementFrame, + hreplacementOutput⟩ := + hreplacementRewind queryRewound.input queryRewound.work + queryRewound.output ⟨rfl, rfl, rfl⟩ + have hreplacementCanonical : readyWork tapes.replacement = + (Tape.init (newValue.bits.map Γ.ofBool)).move Dir3.right := + Tape.eq_init_move_right_of_hasBinaryString hreplacement.2 hreplacement.1 + have hreplacementRestored : restored.work tapes.replacement = + readyWork tapes.replacement := + hreplacementRestoredCanonical.trans hreplacementCanonical.symm + have hrestoredWork : restored.work = readyWork := by + funext i + by_cases hir : i = tapes.replacement + · subst i + exact hreplacementRestored + · rw [hreplacementFrame i hir] + by_cases hiq : i = tapes.entry.query + · subst i + exact hqueryRestored + · exact (hqueryFrame i hiq).trans (hencodedFrame i hiq hir) + obtain ⟨hqueryInputTransition, hqueryWorkTransition, + hqueryOutputTransition⟩ := + TM.phaseTransition_eq_self_of_reads_ne_start + hqueryInputParked.read_ne_start + (fun i => (hqueryWorkParked i).read_ne_start) + hqueryOutputParked.read_ne_start + have hreplacementReach' : + (TM.rewindWorkTM tapes.replacement).reachesIn replacementTime + { state := (TM.rewindWorkTM tapes.replacement).qstart + input := TM.transitionInput queryRewound.input + work := fun i => TM.transitionTape (queryRewound.work i) + output := TM.transitionTape queryRewound.output } + restored := by + simpa only [hqueryInputTransition, hqueryWorkTransition, + hqueryOutputTransition] using hreplacementReach + have htailReach := TM.seqTM_reachesIn_of_reachesIn + (TM.rewindWorkTM tapes.entry.query) (TM.rewindWorkTM tapes.replacement) + hqueryReach hqueryHalt hreplacementReach' + let tailFinal := TM.phase2Wrap (TM.rewindWorkTM tapes.entry.query) + (TM.rewindWorkTM tapes.replacement) restored + have htailHalt : + (TM.seqTM (TM.rewindWorkTM tapes.entry.query) + (TM.rewindWorkTM tapes.replacement)).halted tailFinal := by + rw [TM.phase2Wrap_halted_iff] + exact hreplacementHalt + obtain ⟨hencodedInputTransition, hencodedWorkTransition, + hencodedOutputTransition⟩ := + TM.phaseTransition_eq_self_of_reads_ne_start + hencodedInputParked.read_ne_start + (fun i => (hencodedWorkParked i).read_ne_start) + hencodedOutputParked.read_ne_start + have htailReach' : + (TM.seqTM (TM.rewindWorkTM tapes.entry.query) + (TM.rewindWorkTM tapes.replacement)).reachesIn + (queryTime + 1 + replacementTime) + { state := (TM.seqTM (TM.rewindWorkTM tapes.entry.query) + (TM.rewindWorkTM tapes.replacement)).qstart + input := TM.transitionInput encoded.input + work := fun i => TM.transitionTape (encoded.work i) + output := TM.transitionTape encoded.output } + tailFinal := by + simpa only [hencodedInputTransition, hencodedWorkTransition, + hencodedOutputTransition] using htailReach + have hreach := TM.seqTM_reachesIn_of_reachesIn + (rewindEntryEncodeTM tapes.appendEncodeTapes) + (TM.seqTM (TM.rewindWorkTM tapes.entry.query) + (TM.rewindWorkTM tapes.replacement)) + hencodeReach hencodeHalt htailReach' + let finalCfg := TM.phase2Wrap + (rewindEntryEncodeTM tapes.appendEncodeTapes) + (TM.seqTM (TM.rewindWorkTM tapes.entry.query) + (TM.rewindWorkTM tapes.replacement)) tailFinal + refine ⟨finalCfg, encodeTime + 1 + (queryTime + 1 + replacementTime), + ?_, hreach, ?_, ?_⟩ + · unfold entryAppendRestoreTime + omega + · change (entryAppendRestoreTM tapes).halted finalCfg + unfold entryAppendRestoreTM + rw [TM.phase2Wrap_halted_iff] + exact htailHalt + · refine ⟨?_, ?_, ?_⟩ + · change restored.input = inp₀ + exact hreplacementInput.trans (hqueryInput.trans hencodedInput) + · change restored.work = readyWork + exact hrestoredWork + · change restored.output.HasBinaryPrefix + (emitted ++ Entry.encode (address, newValue)) + rw [hreplacementOutput, hqueryOutput] + exact hencodedOutput + +end Machine + +end RegisterStore + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryCleanup.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryCleanup.lean new file mode 100644 index 0000000000..793f88c65e --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryCleanup.lean @@ -0,0 +1,73 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryCleanup.Defs +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryCleanup.Internal + +/-! +# Sparse-entry miss cleanup + +This module exposes the exact invariant-restoring miss branch used by the +bounded sparse register-store scan. +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace RegisterStore + +namespace Machine + +/-- After a failed readable entry match, rewind the preserved query and reset +all seven decoder/result scratch tapes, restoring the next-iteration frame. -/ +theorem entryMissCleanupTM_hoareTime_frame {n : ℕ} + (tapes : EntryMatchTapes n) (entry : Entry) (rest queryBits : List Bool) + (initialWork matchedWork : Fin n → Tape) (inp₀ out₀ : Tape) + (hmatch : ReadableEntryMatch tapes entry rest queryBits initialWork matchedWork) + (hinput : TM.Parked inp₀) (houtput : TM.Parked out₀) : + (entryMissCleanupTM tapes).HoareTime + (fun inp work out => inp = inp₀ ∧ work = matchedWork ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + EntryScanReady tapes rest queryBits initialWork work ∧ + out = out₀) + (entryMissCleanupTime tapes entry queryBits initialWork) := + entryMissCleanupTM_hoareTime_frame_internal tapes entry rest queryBits + initialWork matchedWork inp₀ out₀ hmatch hinput houtput + +/-- Miss cleanup preserves one-way output safety. -/ +theorem entryMissCleanupTM_isTransducer {n : ℕ} (tapes : EntryMatchTapes n) : + (entryMissCleanupTM tapes).IsTransducer := by + unfold entryMissCleanupTM + exact (TM.rewindWorkTM_isTransducer tapes.query).seqTM + (TM.resetBinaryWorkManyTM_isTransducer (entryMissTargets tapes)) + +/-- Coarse all-prefix auxiliary-space envelope for miss cleanup. -/ +theorem entryMissCleanupTM_prefix_withinAuxSpace {n : ℕ} + (tapes : EntryMatchTapes n) (entry : Entry) (queryBits : List Bool) + (initialWork : Fin n → Tape) (inputLength initialSpace time : ℕ) + (start current : Complexity.Cfg n (entryMissCleanupTM tapes).Q) + (hinitial : start.WithinAuxSpace inputLength initialSpace) + (hreach : (entryMissCleanupTM tapes).reachesIn time start current) + (htime : time ≤ entryMissCleanupTime tapes entry queryBits initialWork) : + current.WithinAuxSpace inputLength + (initialSpace + entryMissCleanupTime tapes entry queryBits initialWork) := + (hinitial.reachesIn hreach).mono le_rfl (by omega) + +end Machine + +end RegisterStore + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryCleanup/Defs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryCleanup/Defs.lean new file mode 100644 index 0000000000..3463949d1e --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryCleanup/Defs.lean @@ -0,0 +1,140 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryMatch.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.ResetBinaryMany.Defs + +/-! +# Sparse-entry miss cleanup — definitions + +The miss branch after `entryMatchReadTM` resets the seven decoder/result +scratch tapes while preserving the consumed source cursor and query address. +This restores the exact invariant needed to inspect the next encoded entry. +-/ + + +@[expose] public section + +namespace Complexity + +namespace RAM + +namespace RegisterStore + +namespace Machine + +namespace EntryMatchTapes + +/-- Embed the seven cleanup slots into the nine entry-match tapes. Slots zero +through five select decoder scratch `1..6`; slot six selects result tape `8`, +skipping the preserved query tape `7`. -/ +def cleanupIdx {n : ℕ} (tapes : EntryMatchTapes n) (i : Fin 7) : Fin n := + tapes.idx ⟨if i.val = 6 then 8 else i.val + 1, by split <;> omega⟩ + +/-- The cleanup-slot embedding is injective. -/ +theorem cleanupIdx_injective {n : ℕ} (tapes : EntryMatchTapes n) : + Function.Injective tapes.cleanupIdx := by + intro i j hij + have hslot := tapes.injective hij + apply Fin.ext + have hval := congrArg Fin.val hslot + change (if i.val = 6 then 8 else i.val + 1) = + (if j.val = 6 then 8 else j.val + 1) at hval + split at hval <;> split at hval <;> omega + +@[simp] theorem cleanupIdx_zero {n : ℕ} (tapes : EntryMatchTapes n) : + tapes.cleanupIdx 0 = tapes.address := rfl + +@[simp] theorem cleanupIdx_one {n : ℕ} (tapes : EntryMatchTapes n) : + tapes.cleanupIdx 1 = tapes.value := rfl + +@[simp] theorem cleanupIdx_two {n : ℕ} (tapes : EntryMatchTapes n) : + tapes.cleanupIdx 2 = tapes.addressCounter := rfl + +@[simp] theorem cleanupIdx_three {n : ℕ} (tapes : EntryMatchTapes n) : + tapes.cleanupIdx 3 = tapes.addressWidth := rfl + +@[simp] theorem cleanupIdx_four {n : ℕ} (tapes : EntryMatchTapes n) : + tapes.cleanupIdx 4 = tapes.valueCounter := rfl + +@[simp] theorem cleanupIdx_five {n : ℕ} (tapes : EntryMatchTapes n) : + tapes.cleanupIdx 5 = tapes.valueWidth := rfl + +@[simp] theorem cleanupIdx_six {n : ℕ} (tapes : EntryMatchTapes n) : + tapes.cleanupIdx 6 = tapes.result := rfl + +end EntryMatchTapes + +/-- Fixed, machine-level list of the seven scratch tapes reset on a miss. -/ +def entryMissTargets {n : ℕ} (tapes : EntryMatchTapes n) : List (Fin n) := + List.ofFn tapes.cleanupIdx + +/-- Canonical represented contents occupying each scratch tape at the readable +match endpoint. Values away from the seven scratch tapes are irrelevant. -/ +def entryMissBits {n : ℕ} (tapes : EntryMatchTapes n) + (entry : Entry) (queryBits : List Bool) (i : Fin n) : List Bool := + if i = tapes.address then entry.1.bits + else if i = tapes.value then entry.2.bits + else if i = tapes.addressCounter then List.replicate (bitlen entry.1) true + else if i = tapes.addressWidth then [] + else if i = tapes.valueCounter then List.replicate (bitlen entry.2) true + else if i = tapes.valueWidth then [] + else if i = tapes.result then [decide (entry.1.bits = queryBits)] + else [] + +/-- Per-tape cursor bound inherited from the readable match contract. -/ +def entryMissHeadBound {n : ℕ} (entry : Entry) (queryBits : List Bool) + (initialWork : Fin n → Tape) (i : Fin n) : ℕ := + (initialWork i).head + entryMatchReadTime entry queryBits + +/-- Rewind the preserved query, then reset all decoder/result scratch after a +failed entry comparison. -/ +def entryMissCleanupTM {n : ℕ} (tapes : EntryMatchTapes n) : TM n := + TM.seqTM (TM.rewindWorkTM tapes.query) + (TM.resetBinaryWorkManyTM (entryMissTargets tapes)) + +/-- Compositional miss-cleanup bound specialized to the readable endpoint. -/ +def entryMissCleanupTime {n : ℕ} (tapes : EntryMatchTapes n) + (entry : Entry) (queryBits : List Bool) (initialWork : Fin n → Tape) : ℕ := + entryMissHeadBound entry queryBits initialWork tapes.query + 2 + 1 + + TM.resetBinaryWorkManyTime (entryMissBits tapes entry queryBits) + (entryMissHeadBound entry queryBits initialWork) (entryMissTargets tapes) + +/-- Loop invariant restored after a failed match: the source points at the +next entry, query is preserved, and all seven scratch tapes are canonical +blank/zero tapes ready for another decode. -/ +structure EntryScanReady {n : ℕ} (tapes : EntryMatchTapes n) + (remaining queryBits : List Bool) (initialWork finalWork : Fin n → Tape) : + Prop where + source : (finalWork tapes.source).HasBinarySuffix remaining + address : (finalWork tapes.address).HasBinaryPrefix [] + addressStart : (finalWork tapes.address).cells 0 = Γ.start + value : (finalWork tapes.value).HasBinaryPrefix [] + valueStart : (finalWork tapes.value).cells 0 = Γ.start + addressCounter : (finalWork tapes.addressCounter).HasBinaryNat 0 + addressWidth : (finalWork tapes.addressWidth).HasBinaryNat 0 + valueCounter : (finalWork tapes.valueCounter).HasBinaryNat 0 + valueWidth : (finalWork tapes.valueWidth).HasBinaryNat 0 + query : (finalWork tapes.query).HasBinaryString queryBits + queryStart : (finalWork tapes.query).cells 0 = Γ.start + result : (finalWork tapes.result).HasBinaryPrefix [] + resultStart : (finalWork tapes.result).cells 0 = Γ.start + parked : ∀ i, TM.Parked (finalWork i) + frame : ∀ i, i ≠ tapes.source → i ≠ tapes.address → + i ≠ tapes.value → i ≠ tapes.addressCounter → + i ≠ tapes.addressWidth → i ≠ tapes.valueCounter → + i ≠ tapes.valueWidth → i ≠ tapes.query → i ≠ tapes.result → + finalWork i = initialWork i + +end Machine + +end RegisterStore + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryCleanup/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryCleanup/Internal.lean new file mode 100644 index 0000000000..5ad3ed7c55 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryCleanup/Internal.lean @@ -0,0 +1,352 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryCleanup.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.ResetBinaryMany +public import Mathlib.Tactic.FinCases +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinarySucc +public import Mathlib.Data.Rat.Cast.Order +public import Mathlib.Tactic.NormNum.Abs +public import Mathlib.Tactic.NormNum.DivMod +public import Mathlib.Tactic.NormNum.OfScientific + +/-! +# Sparse-entry miss cleanup — proof internals +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace RegisterStore + +namespace Machine + +variable {n : ℕ} + +private theorem entryMissTargets_nodup (tapes : EntryMatchTapes n) : + (entryMissTargets tapes).Nodup := by + exact List.nodup_ofFn_ofInjective tapes.cleanupIdx_injective + +private theorem cleanupIdx_mem (tapes : EntryMatchTapes n) (slot : Fin 7) : + tapes.cleanupIdx slot ∈ entryMissTargets tapes := by + exact List.mem_ofFn.mpr ⟨slot, rfl⟩ + +private theorem source_not_mem_entryMissTargets (tapes : EntryMatchTapes n) : + tapes.source ∉ entryMissTargets tapes := by + intro hmem + obtain ⟨slot, hslot⟩ := List.mem_ofFn.mp hmem + have hidx := tapes.injective hslot + have hval := congrArg Fin.val hidx + change (if slot.val = 6 then 8 else slot.val + 1) = 0 at hval + split at hval <;> omega + +private theorem query_not_mem_entryMissTargets (tapes : EntryMatchTapes n) : + tapes.query ∉ entryMissTargets tapes := by + intro hmem + obtain ⟨slot, hslot⟩ := List.mem_ofFn.mp hmem + have hidx := tapes.injective hslot + have hval := congrArg Fin.val hidx + change (if slot.val = 6 then 8 else slot.val + 1) = 7 at hval + split at hval <;> omega + +private theorem cleanupIdx_ne_query (tapes : EntryMatchTapes n) + (slot : Fin 7) : tapes.cleanupIdx slot ≠ tapes.query := by + intro heq + exact query_not_mem_entryMissTargets tapes + (heq ▸ cleanupIdx_mem tapes slot) + +private theorem readable_target_content + (tapes : EntryMatchTapes n) (entry : Entry) (rest queryBits : List Bool) + (initialWork matchedWork : Fin n → Tape) + (hmatch : ReadableEntryMatch tapes entry rest queryBits initialWork matchedWork) : + ∀ i, i ∈ entryMissTargets tapes → + (matchedWork i).HasBinaryContent (entryMissBits tapes entry queryBits i) := by + intro i hi + obtain ⟨slot, rfl⟩ := List.mem_ofFn.mp hi + fin_cases slot + · simpa [entryMissBits, EntryMatchTapes.address, EntryMatchTapes.value, + EntryMatchTapes.addressCounter, EntryMatchTapes.addressWidth, + EntryMatchTapes.valueCounter, EntryMatchTapes.valueWidth, + EntryMatchTapes.result, tapes.injective.eq_iff] using hmatch.address + · simpa [entryMissBits, EntryMatchTapes.address, EntryMatchTapes.value, + EntryMatchTapes.addressCounter, EntryMatchTapes.addressWidth, + EntryMatchTapes.valueCounter, EntryMatchTapes.valueWidth, + EntryMatchTapes.result, tapes.injective.eq_iff] using hmatch.value.2 + · dsimp only [EntryMatchTapes.cleanupIdx] + change (matchedWork tapes.addressCounter).HasBinaryContent + (entryMissBits tapes entry queryBits tapes.addressCounter) + unfold entryMissBits + have haddress : tapes.addressCounter ≠ tapes.address := + tapes.ne (show (3 : Fin 9) ≠ 1 by decide) + have hvalue : tapes.addressCounter ≠ tapes.value := + tapes.ne (show (3 : Fin 9) ≠ 2 by decide) + rw [if_neg haddress, if_neg hvalue, if_pos rfl] + exact hmatch.addressCounter.2 + · simpa [entryMissBits, EntryMatchTapes.address, EntryMatchTapes.value, + EntryMatchTapes.addressCounter, EntryMatchTapes.addressWidth, + EntryMatchTapes.valueCounter, EntryMatchTapes.valueWidth, + EntryMatchTapes.result, tapes.injective.eq_iff] using + hmatch.addressWidth.2.hasBinaryContent + · dsimp only [EntryMatchTapes.cleanupIdx] + change (matchedWork tapes.valueCounter).HasBinaryContent + (entryMissBits tapes entry queryBits tapes.valueCounter) + unfold entryMissBits + have haddress : tapes.valueCounter ≠ tapes.address := + tapes.ne (show (5 : Fin 9) ≠ 1 by decide) + have hvalue : tapes.valueCounter ≠ tapes.value := + tapes.ne (show (5 : Fin 9) ≠ 2 by decide) + have haddressCounter : tapes.valueCounter ≠ tapes.addressCounter := + tapes.ne (show (5 : Fin 9) ≠ 3 by decide) + have haddressWidth : tapes.valueCounter ≠ tapes.addressWidth := + tapes.ne (show (5 : Fin 9) ≠ 4 by decide) + rw [if_neg haddress, if_neg hvalue, if_neg haddressCounter, + if_neg haddressWidth, if_pos rfl] + exact hmatch.valueCounter.2 + · simpa [entryMissBits, EntryMatchTapes.address, EntryMatchTapes.value, + EntryMatchTapes.addressCounter, EntryMatchTapes.addressWidth, + EntryMatchTapes.valueCounter, EntryMatchTapes.valueWidth, + EntryMatchTapes.result, tapes.injective.eq_iff] using + hmatch.valueWidth.2.hasBinaryContent + · simpa [entryMissBits, EntryMatchTapes.address, EntryMatchTapes.value, + EntryMatchTapes.addressCounter, EntryMatchTapes.addressWidth, + EntryMatchTapes.valueCounter, EntryMatchTapes.valueWidth, + EntryMatchTapes.result, tapes.injective.eq_iff] using + hmatch.result.hasBinaryContent + +private theorem readable_target_start + (tapes : EntryMatchTapes n) (entry : Entry) (rest queryBits : List Bool) + (initialWork matchedWork : Fin n → Tape) + (hmatch : ReadableEntryMatch tapes entry rest queryBits initialWork matchedWork) : + ∀ i, i ∈ entryMissTargets tapes → (matchedWork i).cells 0 = Γ.start := by + intro i hi + obtain ⟨slot, rfl⟩ := List.mem_ofFn.mp hi + fin_cases slot + · exact hmatch.addressStart + · exact hmatch.valueStart + · exact hmatch.addressCounterStart + · exact hmatch.addressWidth.1 + · exact hmatch.valueCounterStart + · exact hmatch.valueWidth.1 + · exact hmatch.resultStart + +private theorem readable_target_head + (tapes : EntryMatchTapes n) (entry : Entry) (rest queryBits : List Bool) + (initialWork matchedWork : Fin n → Tape) + (hmatch : ReadableEntryMatch tapes entry rest queryBits initialWork matchedWork) : + ∀ i, i ∈ entryMissTargets tapes → + (matchedWork i).head ≤ entryMissHeadBound entry queryBits initialWork i := by + intro i _ + exact hmatch.headBound i + +private theorem resetBinaryBlank_hasBinaryNat_zero : + TM.resetBinaryBlank.HasBinaryNat 0 := by + simpa [TM.resetBinaryBlank] using Tape.init_move_right_hasBinaryNat 0 + +private theorem resetBinaryBlank_start : + TM.resetBinaryBlank.cells 0 = Γ.start := by + simp [TM.resetBinaryBlank, Tape.init, Tape.move] + +private theorem hasBinaryString_parked {t : Tape} {bits : List Bool} + (h : t.HasBinaryString bits) : TM.Parked t := + ⟨by rw [h.1], Tape.cells_ne_start_of_hasBinaryString h⟩ + +private theorem entryMissCleanup_post + (tapes : EntryMatchTapes n) (entry : Entry) (rest queryBits : List Bool) + (initialWork matchedWork rewoundWork : Fin n → Tape) + (hmatch : ReadableEntryMatch tapes entry rest queryBits initialWork matchedWork) + (hrewoundQuery : rewoundWork tapes.query = + (Tape.init (queryBits.map Γ.ofBool)).move Dir3.right) + (hrewoundOther : ∀ i, i ≠ tapes.query → rewoundWork i = matchedWork i) + (hrewoundParked : ∀ i, TM.Parked (rewoundWork i)) : + EntryScanReady tapes rest queryBits initialWork + (TM.resetBinaryWorkManyResult rewoundWork (entryMissTargets tapes)) := by + let finalWork := TM.resetBinaryWorkManyResult rewoundWork (entryMissTargets tapes) + have hsource : finalWork tapes.source = rewoundWork tapes.source := + TM.resetBinaryWorkManyResult_eq_of_not_mem rewoundWork _ tapes.source + (source_not_mem_entryMissTargets tapes) + have hquery : finalWork tapes.query = rewoundWork tapes.query := + TM.resetBinaryWorkManyResult_eq_of_not_mem rewoundWork _ tapes.query + (query_not_mem_entryMissTargets tapes) + have hblank : ∀ slot : Fin 7, + finalWork (tapes.cleanupIdx slot) = TM.resetBinaryBlank := by + intro slot + exact TM.resetBinaryWorkManyResult_eq_blank_of_mem rewoundWork _ _ + (cleanupIdx_mem tapes slot) + have hblankPrefix : ∀ slot : Fin 7, + (finalWork (tapes.cleanupIdx slot)).HasBinaryPrefix [] := by + intro slot + rw [hblank] + exact Tape.init_nil_move_right_hasBinaryPrefix_nil + have hblankStart : ∀ slot : Fin 7, + (finalWork (tapes.cleanupIdx slot)).cells 0 = Γ.start := by + intro slot + rw [hblank] + exact resetBinaryBlank_start + have hblankNat : ∀ slot : Fin 7, + (finalWork (tapes.cleanupIdx slot)).HasBinaryNat 0 := by + intro slot + rw [hblank] + exact resetBinaryBlank_hasBinaryNat_zero + refine ⟨?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_⟩ + · have hsourceOther : rewoundWork tapes.source = matchedWork tapes.source := + hrewoundOther tapes.source (tapes.ne (by decide)) + have h := hmatch.source + rw [← hsourceOther, ← hsource] at h + simpa [finalWork] using h + · simpa [finalWork] using hblankPrefix 0 + · simpa [finalWork] using hblankStart 0 + · simpa [finalWork] using hblankPrefix 1 + · simpa [finalWork] using hblankStart 1 + · simpa [finalWork] using hblankNat 2 + · simpa [finalWork] using hblankNat 3 + · simpa [finalWork] using hblankNat 4 + · simpa [finalWork] using hblankNat 5 + · have h := Tape.init_move_right_hasBinaryString queryBits + rw [← hrewoundQuery, ← hquery] at h + simpa [finalWork] using h + · have hfinalQuery : + TM.resetBinaryWorkManyResult rewoundWork (entryMissTargets tapes) + tapes.query = + (Tape.init (queryBits.map Γ.ofBool)).move Dir3.right := by + simpa [finalWork] using hquery.trans hrewoundQuery + rw [hfinalQuery] + simp [Tape.init, Tape.move] + · simpa [finalWork] using hblankPrefix 6 + · simpa [finalWork] using hblankStart 6 + · exact TM.resetBinaryWorkManyResult_parked rewoundWork _ hrewoundParked + · intro i hsourceNe haddressNe hvalueNe haddressCounterNe + haddressWidthNe hvalueCounterNe hvalueWidthNe hqueryNe hresultNe + have hnotmem : i ∉ entryMissTargets tapes := by + intro hmem + obtain ⟨slot, hslot⟩ := List.mem_ofFn.mp hmem + fin_cases slot <;> simp_all + have hframe := hmatch.frame i hsourceNe haddressNe hvalueNe + haddressCounterNe haddressWidthNe hvalueCounterNe hvalueWidthNe + hqueryNe hresultNe + have hrewound := hrewoundOther i hqueryNe + simpa [finalWork, + TM.resetBinaryWorkManyResult_eq_of_not_mem rewoundWork _ i hnotmem] + using hrewound.trans hframe + +theorem entryMissCleanupTM_hoareTime_frame_internal + (tapes : EntryMatchTapes n) (entry : Entry) (rest queryBits : List Bool) + (initialWork matchedWork : Fin n → Tape) (inp₀ out₀ : Tape) + (hmatch : ReadableEntryMatch tapes entry rest queryBits initialWork matchedWork) + (hinput : TM.Parked inp₀) (houtput : TM.Parked out₀) : + (entryMissCleanupTM tapes).HoareTime + (fun inp work out => inp = inp₀ ∧ work = matchedWork ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + EntryScanReady tapes rest queryBits initialWork work ∧ + out = out₀) + (entryMissCleanupTime tapes entry queryBits initialWork) := by + let queryTape := (Tape.init (queryBits.map Γ.ofBool)).move Dir3.right + let rewoundWork := Function.update matchedWork tapes.query queryTape + have hrewindBase := TM.rewindBinaryWorkTM_hoareTime_frame tapes.query + queryBits (entryMissHeadBound entry queryBits initialWork tapes.query) + inp₀ matchedWork out₀ hmatch.query hmatch.queryStart + ⟨(hmatch.parked tapes.query).1, hmatch.headBound tapes.query⟩ hinput + (fun i _ => hmatch.parked i) houtput + have hrewind : (TM.rewindWorkTM tapes.query).HoareTime + (fun inp work out => inp = inp₀ ∧ work = matchedWork ∧ out = out₀) + (fun inp work out => inp = inp₀ ∧ work = rewoundWork ∧ out = out₀) + (entryMissHeadBound entry queryBits initialWork tapes.query + 2) := by + exact hrewindBase.strengthen_post (by + intro inp work out hpost + rcases hpost with ⟨hinp, hquery, hother, hout⟩ + refine ⟨hinp, ?_, hout⟩ + funext i + by_cases hi : i = tapes.query + · subst i + simpa [rewoundWork, queryTape] using hquery + · simpa [rewoundWork, Function.update_of_ne hi] using hother i hi) + have hrewoundOther : ∀ i, i ≠ tapes.query → + rewoundWork i = matchedWork i := by + intro i hi + simp [rewoundWork, Function.update_of_ne hi] + have hrewoundParked : ∀ i, TM.Parked (rewoundWork i) := by + intro i + by_cases hi : i = tapes.query + · subst i + rw [show rewoundWork tapes.query = queryTape by + simp [rewoundWork, Function.update_self]] + exact hasBinaryString_parked (by + simpa [queryTape] using Tape.init_move_right_hasBinaryString queryBits) + · rw [hrewoundOther i hi] + exact hmatch.parked i + have htargetContent : ∀ i, i ∈ entryMissTargets tapes → + (rewoundWork i).HasBinaryContent (entryMissBits tapes entry queryBits i) := by + intro i hi + have hne : i ≠ tapes.query := by + intro heq + exact query_not_mem_entryMissTargets tapes (heq ▸ hi) + rw [hrewoundOther i hne] + exact readable_target_content tapes entry rest queryBits initialWork + matchedWork hmatch i hi + have htargetStart : ∀ i, i ∈ entryMissTargets tapes → + (rewoundWork i).cells 0 = Γ.start := by + intro i hi + have hne : i ≠ tapes.query := by + intro heq + exact query_not_mem_entryMissTargets tapes (heq ▸ hi) + rw [hrewoundOther i hne] + exact readable_target_start tapes entry rest queryBits initialWork + matchedWork hmatch i hi + have htargetHead : ∀ i, i ∈ entryMissTargets tapes → + (rewoundWork i).head ≤ entryMissHeadBound entry queryBits initialWork i := by + intro i hi + have hne : i ≠ tapes.query := by + intro heq + exact query_not_mem_entryMissTargets tapes (heq ▸ hi) + rw [hrewoundOther i hne] + exact hmatch.headBound i + have hreset := TM.resetBinaryWorkManyTM_hoareTime_frame + (entryMissTargets tapes) (entryMissBits tapes entry queryBits) + (entryMissHeadBound entry queryBits initialWork) inp₀ rewoundWork out₀ + (entryMissTargets_nodup tapes) htargetContent htargetStart htargetHead + hinput hrewoundParked houtput + have hseq := TM.seqTM_hoareTime (TM.rewindWorkTM tapes.query) + (TM.resetBinaryWorkManyTM (entryMissTargets tapes)) hrewind + (by + intro inp work out hmid + rcases hmid with ⟨hinp, hwork, hout⟩ + subst work + obtain ⟨hinpTransition, hworkTransition, houtTransition⟩ := + TM.phaseTransition_eq_self_of_reads_ne_start + (hinp ▸ hinput.read_ne_start) + (fun i => (hrewoundParked i).read_ne_start) + (hout ▸ houtput.read_ne_start) + rw [hinpTransition, hworkTransition, houtTransition] + exact ⟨hinp, rfl, hout⟩) + hreset + have hfinal := hseq.strengthen_post + (post' := fun inp work out => + inp = inp₀ ∧ + EntryScanReady tapes rest queryBits initialWork work ∧ + out = out₀) (by + intro inp work out hpost + rcases hpost with ⟨hinp, hwork, hout⟩ + subst work + exact ⟨hinp, + entryMissCleanup_post tapes entry rest queryBits initialWork matchedWork + rewoundWork hmatch (by simp [rewoundWork, queryTape]) hrewoundOther + hrewoundParked, + hout⟩) + simpa [entryMissCleanupTM, entryMissCleanupTime] using hfinal + +end Machine + +end RegisterStore + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryDecode.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryDecode.lean new file mode 100644 index 0000000000..b5ad13f156 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryDecode.lean @@ -0,0 +1,177 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryDecode.Defs +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryDecode.Internal +public import +LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryDecode.LinearInternal + +/-! +# RAM sparse-entry decoder + +This module exposes the exact framed semantics of the concrete two-word sparse +address/value decoder. +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace RegisterStore + +namespace Machine + +/-- Decode one canonical sparse address/value entry exactly, leaving the next +encoded entry under the source head and preserving every unrelated tape. -/ +theorem entryDecodeTM_reachesIn_frame {n : ℕ} + (tapes : EntryDecodeTapes n) (entry : Entry) (rest : List Bool) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hsource : (work₀ tapes.source).HasBinarySuffix (Entry.encode entry ++ rest)) + (haddress : (work₀ tapes.address).HasBinaryPrefix []) + (hvalue : (work₀ tapes.value).HasBinaryPrefix []) + (haddressStart : (work₀ tapes.address).cells 0 = Γ.start) + (hvalueStart : (work₀ tapes.value).cells 0 = Γ.start) + (haddressCounter : (work₀ tapes.addressCounter).HasBinaryNat 0) + (haddressWidth : (work₀ tapes.addressWidth).HasBinaryNat 0) + (hvalueCounter : (work₀ tapes.valueCounter).HasBinaryNat 0) + (hvalueWidth : (work₀ tapes.valueWidth).HasBinaryNat 0) + (hinput : inp₀.read ≠ Γ.start) + (hreads : ∀ i, (work₀ i).read ≠ Γ.start) + (houtput : out₀.read ≠ Γ.start) : + ∃ c', + (entryDecodeTM tapes).reachesIn (entryDecodeTime entry.1 entry.2) + { state := (entryDecodeTM tapes).qstart + input := inp₀ + work := work₀ + output := out₀ } c' ∧ + (entryDecodeTM tapes).halted c' ∧ + c'.input = inp₀ ∧ + (c'.work tapes.source).HasBinarySuffix rest ∧ + (c'.work tapes.address).HasBinaryPrefix entry.1.bits ∧ + (c'.work tapes.address).cells 0 = Γ.start ∧ + (c'.work tapes.value).HasBinaryPrefix entry.2.bits ∧ + (c'.work tapes.value).cells 0 = Γ.start ∧ + (c'.work tapes.addressCounter).HasBinaryNat (bitlen entry.1) ∧ + (c'.work tapes.addressWidth).HasBinaryNat (bitlen entry.1) ∧ + (c'.work tapes.valueCounter).HasBinaryNat (bitlen entry.2) ∧ + (c'.work tapes.valueWidth).HasBinaryNat (bitlen entry.2) ∧ + (∀ i, i ≠ tapes.source → i ≠ tapes.address → i ≠ tapes.value → + i ≠ tapes.addressCounter → i ≠ tapes.addressWidth → + i ≠ tapes.valueCounter → i ≠ tapes.valueWidth → + c'.work i = work₀ i) ∧ + c'.output = out₀ := + entryDecodeTM_reachesIn_frame_internal tapes entry rest inp₀ work₀ out₀ + hsource haddress hvalue haddressStart hvalueStart haddressCounter + haddressWidth hvalueCounter hvalueWidth hinput hreads houtput + +/-- Coarse all-prefix auxiliary-space envelope for entry decoding. -/ +theorem entryDecodeTM_prefix_withinAuxSpace {n : ℕ} + (tapes : EntryDecodeTapes n) (address value : ℕ) + (inputLength initialSpace time : ℕ) + (start current : Complexity.Cfg n (entryDecodeTM tapes).Q) + (hinitial : start.WithinAuxSpace inputLength initialSpace) + (hreach : (entryDecodeTM tapes).reachesIn time start current) + (htime : time ≤ entryDecodeTime address value) : + current.WithinAuxSpace inputLength + (initialSpace + entryDecodeTime address value) := + (hinitial.reachesIn hreach).mono le_rfl (by omega) + +/-- Entry decoding preserves one-way output safety. -/ +theorem entryDecodeTM_isTransducer {n : ℕ} (tapes : EntryDecodeTapes n) : + (entryDecodeTM tapes).IsTransducer := by + unfold entryDecodeTM + exact (wordDecodeTM_isTransducer tapes.source tapes.address + tapes.addressCounter tapes.addressWidth).seqTM + (wordDecodeTM_isTransducer tapes.source tapes.value tapes.valueCounter + tapes.valueWidth) + +/-! ## Linear unary-marker decoder -/ + +/-- Decode one canonical sparse entry using unary markers, leaving the next +entry under the source head and preserving the two unused width tapes. -/ +theorem entryDecodeLinearTM_reachesIn_frame {n : ℕ} + (tapes : EntryDecodeTapes n) (entry : Entry) (rest : List Bool) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hsource : (work₀ tapes.source).HasBinarySuffix (Entry.encode entry ++ rest)) + (haddress : (work₀ tapes.address).HasBinaryPrefix []) + (hvalue : (work₀ tapes.value).HasBinaryPrefix []) + (haddressStart : (work₀ tapes.address).cells 0 = Γ.start) + (hvalueStart : (work₀ tapes.value).cells 0 = Γ.start) + (haddressMarker : (work₀ tapes.addressCounter).HasBinaryPrefix []) + (haddressMarkerStart : (work₀ tapes.addressCounter).cells 0 = Γ.start) + (hvalueMarker : (work₀ tapes.valueCounter).HasBinaryPrefix []) + (hvalueMarkerStart : (work₀ tapes.valueCounter).cells 0 = Γ.start) + (hinput : inp₀.read ≠ Γ.start) + (hreads : ∀ i, (work₀ i).read ≠ Γ.start) + (houtput : out₀.read ≠ Γ.start) : + ∃ c', + (entryDecodeLinearTM tapes).reachesIn + (entryDecodeLinearTime entry.1 entry.2) + { state := (entryDecodeLinearTM tapes).qstart + input := inp₀ + work := work₀ + output := out₀ } c' ∧ + (entryDecodeLinearTM tapes).halted c' ∧ + c'.input = inp₀ ∧ + (c'.work tapes.source).HasBinarySuffix rest ∧ + (c'.work tapes.address).HasBinaryPrefix entry.1.bits ∧ + (c'.work tapes.address).cells 0 = Γ.start ∧ + (c'.work tapes.value).HasBinaryPrefix entry.2.bits ∧ + (c'.work tapes.value).cells 0 = Γ.start ∧ + (c'.work tapes.addressCounter).HasBinaryPrefix + (List.replicate (bitlen entry.1) true) ∧ + (c'.work tapes.valueCounter).HasBinaryPrefix + (List.replicate (bitlen entry.2) true) ∧ + (∀ i, i ≠ tapes.source → i ≠ tapes.address → i ≠ tapes.value → + i ≠ tapes.addressCounter → i ≠ tapes.valueCounter → + c'.work i = work₀ i) ∧ + c'.output = out₀ := + entryDecodeLinearTM_reachesIn_frame_internal tapes entry rest inp₀ work₀ out₀ + hsource haddress hvalue haddressStart hvalueStart haddressMarker + haddressMarkerStart hvalueMarker hvalueMarkerStart hinput hreads houtput + +/-- The exact optimized entry-decoding time is linear in the two word widths. -/ +theorem entryDecodeLinearTime_eq (address value : ℕ) : + entryDecodeLinearTime address value = + 3 * (bitlen address + bitlen value) + 7 := by + unfold entryDecodeLinearTime wordDecodeLinearTime + omega + +/-- Coarse all-prefix auxiliary-space envelope for optimized entry decoding. -/ +theorem entryDecodeLinearTM_prefix_withinAuxSpace {n : ℕ} + (tapes : EntryDecodeTapes n) (address value : ℕ) + (inputLength initialSpace time : ℕ) + (start current : Complexity.Cfg n (entryDecodeLinearTM tapes).Q) + (hinitial : start.WithinAuxSpace inputLength initialSpace) + (hreach : (entryDecodeLinearTM tapes).reachesIn time start current) + (htime : time ≤ entryDecodeLinearTime address value) : + current.WithinAuxSpace inputLength + (initialSpace + entryDecodeLinearTime address value) := + (hinitial.reachesIn hreach).mono le_rfl (by omega) + +/-- Optimized entry decoding preserves one-way output safety. -/ +theorem entryDecodeLinearTM_isTransducer {n : ℕ} + (tapes : EntryDecodeTapes n) : + (entryDecodeLinearTM tapes).IsTransducer := by + unfold entryDecodeLinearTM + exact (wordDecodeLinearTM_isTransducer tapes.source tapes.address + tapes.addressCounter).seqTM + (wordDecodeLinearTM_isTransducer tapes.source tapes.value + tapes.valueCounter) + +end Machine + +end RegisterStore + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryDecode/Defs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryDecode/Defs.lean new file mode 100644 index 0000000000..fa977d94de --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryDecode/Defs.lean @@ -0,0 +1,116 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.WordDecode.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Defs +public import Mathlib.Tactic.NormNum.Inv +public import Mathlib.Tactic.NormNum.Pow + +/-! +# RAM sparse-entry decoder — definitions + +One sparse register entry contains two consecutive self-delimiting words: its +address and value. `entryDecodeTM` gives each word its own target, counter, and +width tapes so the two checked word decoders compose without a clearing phase. +-/ + + +@[expose] public section + +namespace Complexity + +namespace RAM + +namespace RegisterStore + +namespace Machine + +/-- Seven pairwise-distinct work tapes used by one sparse-entry decoder. -/ +structure EntryDecodeTapes (n : ℕ) where + /-- Tape assignment in the order source, address, value, address counter, + address width, value counter, value width. -/ + idx : Fin 7 → Fin n + injective : Function.Injective idx + +namespace EntryDecodeTapes + +/-- Encoded entry-stream source tape. -/ +def source {n : ℕ} (tapes : EntryDecodeTapes n) : Fin n := tapes.idx 0 +/-- Decoded address target tape. -/ +def address {n : ℕ} (tapes : EntryDecodeTapes n) : Fin n := tapes.idx 1 +/-- Decoded value target tape. -/ +def value {n : ℕ} (tapes : EntryDecodeTapes n) : Fin n := tapes.idx 2 +/-- Binary loop counter used while decoding the address. -/ +def addressCounter {n : ℕ} (tapes : EntryDecodeTapes n) : Fin n := tapes.idx 3 +/-- Preserved address payload-width tape. -/ +def addressWidth {n : ℕ} (tapes : EntryDecodeTapes n) : Fin n := tapes.idx 4 +/-- Binary loop counter used while decoding the value. -/ +def valueCounter {n : ℕ} (tapes : EntryDecodeTapes n) : Fin n := tapes.idx 5 +/-- Preserved value payload-width tape. -/ +def valueWidth {n : ℕ} (tapes : EntryDecodeTapes n) : Fin n := tapes.idx 6 + +theorem ne {n : ℕ} (tapes : EntryDecodeTapes n) {i j : Fin 7} (h : i ≠ j) : + tapes.idx i ≠ tapes.idx j := + fun hij => h (tapes.injective hij) + +theorem addressDistinct {n : ℕ} (tapes : EntryDecodeTapes n) : + PayloadLoopDistinct tapes.source tapes.address tapes.addressCounter + tapes.addressWidth := by + exact ⟨tapes.ne (by decide), tapes.ne (by decide), tapes.ne (by decide), + tapes.ne (by decide), tapes.ne (by decide), tapes.ne (by decide)⟩ + +theorem valueDistinct {n : ℕ} (tapes : EntryDecodeTapes n) : + PayloadLoopDistinct tapes.source tapes.value tapes.valueCounter + tapes.valueWidth := by + exact ⟨tapes.ne (by decide), tapes.ne (by decide), tapes.ne (by decide), + tapes.ne (by decide), tapes.ne (by decide), tapes.ne (by decide)⟩ + +/-- Source, address target, and address marker are pairwise distinct. -/ +theorem addressLinearDistinct {n : ℕ} (tapes : EntryDecodeTapes n) : + LinearWordDistinct tapes.source tapes.address tapes.addressCounter := by + exact ⟨tapes.ne (by decide), tapes.ne (by decide), tapes.ne (by decide)⟩ + +/-- Source, value target, and value marker are pairwise distinct. -/ +theorem valueLinearDistinct {n : ℕ} (tapes : EntryDecodeTapes n) : + LinearWordDistinct tapes.source tapes.value tapes.valueCounter := by + exact ⟨tapes.ne (by decide), tapes.ne (by decide), tapes.ne (by decide)⟩ + +end EntryDecodeTapes + +/-- Decode the address word and then the value word of one sparse entry. -/ +def entryDecodeTM {n : ℕ} (tapes : EntryDecodeTapes n) : TM n := + TM.seqTM + (wordDecodeTM tapes.source tapes.address tapes.addressCounter + tapes.addressWidth) + (wordDecodeTM tapes.source tapes.value tapes.valueCounter tapes.valueWidth) + +/-- Exact runtime for decoding both words, including the composition seam. -/ +def entryDecodeTime (address value : ℕ) : ℕ := + wordDecodeTime (bitlen address) + 1 + wordDecodeTime (bitlen value) + +/-- Decode both entry words with unary markers. The former counter tapes serve +as address and value markers; the two width tapes are left untouched so this +machine can replace `entryDecodeTM` inside the established seven-tape ABI. -/ +def entryDecodeLinearTM {n : ℕ} (tapes : EntryDecodeTapes n) : TM n := + TM.seqTM + (wordDecodeLinearTM tapes.source tapes.address tapes.addressCounter) + (wordDecodeLinearTM tapes.source tapes.value tapes.valueCounter) + +/-- Exact runtime of the optimized two-word decoder, including its composition +seam. -/ +def entryDecodeLinearTime (address value : ℕ) : ℕ := + wordDecodeLinearTime (bitlen address) + 1 + + wordDecodeLinearTime (bitlen value) + +end Machine + +end RegisterStore + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryDecode/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryDecode/Internal.lean new file mode 100644 index 0000000000..c8ff974df6 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryDecode/Internal.lean @@ -0,0 +1,186 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryDecode.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.WordDecode + +/-! +# RAM sparse-entry decoder — proof internals +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace RegisterStore + +namespace Machine + +theorem entryDecodeTM_reachesIn_frame_internal {n : ℕ} + (tapes : EntryDecodeTapes n) (entry : Entry) (rest : List Bool) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hsource : (work₀ tapes.source).HasBinarySuffix (Entry.encode entry ++ rest)) + (haddress : (work₀ tapes.address).HasBinaryPrefix []) + (hvalue : (work₀ tapes.value).HasBinaryPrefix []) + (haddressStart : (work₀ tapes.address).cells 0 = Γ.start) + (hvalueStart : (work₀ tapes.value).cells 0 = Γ.start) + (haddressCounter : (work₀ tapes.addressCounter).HasBinaryNat 0) + (haddressWidth : (work₀ tapes.addressWidth).HasBinaryNat 0) + (hvalueCounter : (work₀ tapes.valueCounter).HasBinaryNat 0) + (hvalueWidth : (work₀ tapes.valueWidth).HasBinaryNat 0) + (hinput : inp₀.read ≠ Γ.start) + (hreads : ∀ i, (work₀ i).read ≠ Γ.start) + (houtput : out₀.read ≠ Γ.start) : + ∃ c', + (entryDecodeTM tapes).reachesIn (entryDecodeTime entry.1 entry.2) + { state := (entryDecodeTM tapes).qstart + input := inp₀ + work := work₀ + output := out₀ } c' ∧ + (entryDecodeTM tapes).halted c' ∧ + c'.input = inp₀ ∧ + (c'.work tapes.source).HasBinarySuffix rest ∧ + (c'.work tapes.address).HasBinaryPrefix entry.1.bits ∧ + (c'.work tapes.address).cells 0 = Γ.start ∧ + (c'.work tapes.value).HasBinaryPrefix entry.2.bits ∧ + (c'.work tapes.value).cells 0 = Γ.start ∧ + (c'.work tapes.addressCounter).HasBinaryNat (bitlen entry.1) ∧ + (c'.work tapes.addressWidth).HasBinaryNat (bitlen entry.1) ∧ + (c'.work tapes.valueCounter).HasBinaryNat (bitlen entry.2) ∧ + (c'.work tapes.valueWidth).HasBinaryNat (bitlen entry.2) ∧ + (∀ i, i ≠ tapes.source → i ≠ tapes.address → i ≠ tapes.value → + i ≠ tapes.addressCounter → i ≠ tapes.addressWidth → + i ≠ tapes.valueCounter → i ≠ tapes.valueWidth → + c'.work i = work₀ i) ∧ + c'.output = out₀ := by + let addressTM := wordDecodeTM tapes.source tapes.address + tapes.addressCounter tapes.addressWidth + let valueTM := wordDecodeTM tapes.source tapes.value + tapes.valueCounter tapes.valueWidth + have hsourceAddress : (work₀ tapes.source).HasBinarySuffix + (WordCode.encode entry.1 ++ (WordCode.encode entry.2 ++ rest)) := by + simpa [Entry.encode, List.append_assoc] using hsource + obtain ⟨addressDone, haddressReach, haddressHalt, haddressInput, + haddressSource, haddressTarget, haddressCounterFinal, + haddressWidthFinal, haddressFrame, haddressOutput⟩ := + wordDecodeTM_reachesIn_frame_encode tapes.source tapes.address + tapes.addressCounter tapes.addressWidth tapes.addressDistinct entry.1 + (WordCode.encode entry.2 ++ rest) inp₀ work₀ out₀ hsourceAddress haddress + haddressCounter haddressWidth hinput (fun i _ _ _ _ => hreads i) houtput + have haddressStartFinal : + (addressDone.work tapes.address).cells 0 = Γ.start := + TM.work_cells_zero_eq_start_of_reachesIn tapes.address haddressReach + haddressStart + have haddressReads : ∀ i, (addressDone.work i).read ≠ Γ.start := by + intro i + by_cases his : i = tapes.source + · subst i + exact haddressSource.read_ne_start + · by_cases hit : i = tapes.address + · subst i + rw [haddressTarget.read_blank] + decide + · by_cases hic : i = tapes.addressCounter + · subst i + rw [haddressCounterFinal.eq_init_move_right] + exact Tape.init_ofBool_move_right_read_ne_start (bitlen entry.1).bits + · by_cases hiw : i = tapes.addressWidth + · subst i + rw [haddressWidthFinal.eq_init_move_right] + exact Tape.init_ofBool_move_right_read_ne_start (bitlen entry.1).bits + · rw [haddressFrame i his hit hic hiw] + exact hreads i + have hvalueInitial : (addressDone.work tapes.value).HasBinaryPrefix [] := by + rw [haddressFrame tapes.value (tapes.ne (by decide)) + (tapes.ne (by decide)) (tapes.ne (by decide)) (tapes.ne (by decide))] + exact hvalue + have hvalueStartInitial : + (addressDone.work tapes.value).cells 0 = Γ.start := by + rw [haddressFrame tapes.value (tapes.ne (by decide)) + (tapes.ne (by decide)) (tapes.ne (by decide)) (tapes.ne (by decide))] + exact hvalueStart + have hvalueCounterInitial : + (addressDone.work tapes.valueCounter).HasBinaryNat 0 := by + rw [haddressFrame tapes.valueCounter (tapes.ne (by decide)) + (tapes.ne (by decide)) (tapes.ne (by decide)) (tapes.ne (by decide))] + exact hvalueCounter + have hvalueWidthInitial : + (addressDone.work tapes.valueWidth).HasBinaryNat 0 := by + rw [haddressFrame tapes.valueWidth (tapes.ne (by decide)) + (tapes.ne (by decide)) (tapes.ne (by decide)) (tapes.ne (by decide))] + exact hvalueWidth + obtain ⟨valueDone, hvalueReach, hvalueHalt, hvalueInput, hvalueSource, + hvalueTarget, hvalueCounterFinal, hvalueWidthFinal, hvalueFrame, + hvalueOutput⟩ := + wordDecodeTM_reachesIn_frame_encode tapes.source tapes.value + tapes.valueCounter tapes.valueWidth tapes.valueDistinct entry.2 rest + addressDone.input addressDone.work addressDone.output haddressSource + hvalueInitial hvalueCounterInitial hvalueWidthInitial + (by rw [haddressInput]; exact hinput) + (fun i _ _ _ _ => haddressReads i) + (by rw [haddressOutput]; exact houtput) + have hvalueStartFinal : (valueDone.work tapes.value).cells 0 = Γ.start := + TM.work_cells_zero_eq_start_of_reachesIn tapes.value hvalueReach + hvalueStartInitial + have htransitionInput : TM.transitionInput addressDone.input = + addressDone.input := + TM.transitionInput_eq_self (by rw [haddressInput]; exact hinput) + have htransitionWork : + (fun i => TM.transitionTape (addressDone.work i)) = addressDone.work := by + funext i + exact TM.transitionTape_eq_self (haddressReads i) + have htransitionOutput : TM.transitionTape addressDone.output = + addressDone.output := + TM.transitionTape_eq_self (by rw [haddressOutput]; exact houtput) + have hvalueReach' : valueTM.reachesIn (wordDecodeTime (bitlen entry.2)) + { state := valueTM.qstart + input := TM.transitionInput addressDone.input + work := fun i => TM.transitionTape (addressDone.work i) + output := TM.transitionTape addressDone.output } valueDone := by + rw [htransitionInput, htransitionWork, htransitionOutput] + simpa [valueTM] using hvalueReach + have hfullReach := TM.seqTM_reachesIn_of_reachesIn addressTM valueTM + (by simpa [addressTM] using haddressReach) haddressHalt hvalueReach' + let finalCfg := TM.phase2Wrap addressTM valueTM valueDone + refine ⟨finalCfg, ?_, ?_, hvalueInput.trans haddressInput, hvalueSource, ?_, + ?_, hvalueTarget, hvalueStartFinal, ?_, ?_, hvalueCounterFinal, + hvalueWidthFinal, ?_, hvalueOutput.trans haddressOutput⟩ + · simpa [entryDecodeTM, entryDecodeTime, addressTM, valueTM, finalCfg] using + hfullReach + · exact (TM.phase2Wrap_halted_iff addressTM valueTM valueDone).2 hvalueHalt + · change (valueDone.work tapes.address).HasBinaryPrefix entry.1.bits + rw [hvalueFrame tapes.address (tapes.ne (by decide)) + (tapes.ne (by decide)) (tapes.ne (by decide)) (tapes.ne (by decide))] + exact haddressTarget + · change (valueDone.work tapes.address).cells 0 = Γ.start + rw [hvalueFrame tapes.address (tapes.ne (by decide)) + (tapes.ne (by decide)) (tapes.ne (by decide)) (tapes.ne (by decide))] + exact haddressStartFinal + · change (valueDone.work tapes.addressCounter).HasBinaryNat (bitlen entry.1) + rw [hvalueFrame tapes.addressCounter (tapes.ne (by decide)) + (tapes.ne (by decide)) (tapes.ne (by decide)) (tapes.ne (by decide))] + exact haddressCounterFinal + · change (valueDone.work tapes.addressWidth).HasBinaryNat (bitlen entry.1) + rw [hvalueFrame tapes.addressWidth (tapes.ne (by decide)) + (tapes.ne (by decide)) (tapes.ne (by decide)) (tapes.ne (by decide))] + exact haddressWidthFinal + · intro i his hia hiv hiac hiaw hivc hivw + change valueDone.work i = work₀ i + rw [hvalueFrame i his hiv hivc hivw, + haddressFrame i his hia hiac hiaw] + +end Machine + +end RegisterStore + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryDecode/LinearInternal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryDecode/LinearInternal.lean new file mode 100644 index 0000000000..b6fbb277e1 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryDecode/LinearInternal.lean @@ -0,0 +1,183 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryDecode.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.WordDecode + +/-! +# Linear RAM sparse-entry decoder -- proof internals + +The address and value words are decoded by the linear unary-marker decoder. +The established counter tapes become markers, while the width tapes remain +framed for compatibility with the existing sparse-store work-tape layout. +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace RegisterStore + +namespace Machine + +theorem entryDecodeLinearTM_reachesIn_frame_internal {n : ℕ} + (tapes : EntryDecodeTapes n) (entry : Entry) (rest : List Bool) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hsource : (work₀ tapes.source).HasBinarySuffix (Entry.encode entry ++ rest)) + (haddress : (work₀ tapes.address).HasBinaryPrefix []) + (hvalue : (work₀ tapes.value).HasBinaryPrefix []) + (haddressStart : (work₀ tapes.address).cells 0 = Γ.start) + (hvalueStart : (work₀ tapes.value).cells 0 = Γ.start) + (haddressMarker : (work₀ tapes.addressCounter).HasBinaryPrefix []) + (haddressMarkerStart : (work₀ tapes.addressCounter).cells 0 = Γ.start) + (hvalueMarker : (work₀ tapes.valueCounter).HasBinaryPrefix []) + (hvalueMarkerStart : (work₀ tapes.valueCounter).cells 0 = Γ.start) + (hinput : inp₀.read ≠ Γ.start) + (hreads : ∀ i, (work₀ i).read ≠ Γ.start) + (houtput : out₀.read ≠ Γ.start) : + ∃ c', + (entryDecodeLinearTM tapes).reachesIn + (entryDecodeLinearTime entry.1 entry.2) + { state := (entryDecodeLinearTM tapes).qstart + input := inp₀ + work := work₀ + output := out₀ } c' ∧ + (entryDecodeLinearTM tapes).halted c' ∧ + c'.input = inp₀ ∧ + (c'.work tapes.source).HasBinarySuffix rest ∧ + (c'.work tapes.address).HasBinaryPrefix entry.1.bits ∧ + (c'.work tapes.address).cells 0 = Γ.start ∧ + (c'.work tapes.value).HasBinaryPrefix entry.2.bits ∧ + (c'.work tapes.value).cells 0 = Γ.start ∧ + (c'.work tapes.addressCounter).HasBinaryPrefix + (List.replicate (bitlen entry.1) true) ∧ + (c'.work tapes.valueCounter).HasBinaryPrefix + (List.replicate (bitlen entry.2) true) ∧ + (∀ i, i ≠ tapes.source → i ≠ tapes.address → i ≠ tapes.value → + i ≠ tapes.addressCounter → i ≠ tapes.valueCounter → + c'.work i = work₀ i) ∧ + c'.output = out₀ := by + let addressTM := wordDecodeLinearTM tapes.source tapes.address + tapes.addressCounter + let valueTM := wordDecodeLinearTM tapes.source tapes.value + tapes.valueCounter + have hsourceAddress : (work₀ tapes.source).HasBinarySuffix + (WordCode.encode entry.1 ++ (WordCode.encode entry.2 ++ rest)) := by + simpa [Entry.encode, List.append_assoc] using hsource + obtain ⟨addressDone, haddressReach, haddressHalt, haddressInput, + haddressSource, haddressTarget, haddressMarkerFinal, haddressFrame, + haddressOutput⟩ := + wordDecodeLinearTM_reachesIn_frame_encode tapes.source tapes.address + tapes.addressCounter tapes.addressLinearDistinct entry.1 + (WordCode.encode entry.2 ++ rest) inp₀ work₀ out₀ hsourceAddress + haddress haddressMarker haddressMarkerStart hinput hreads houtput + have haddressStartFinal : + (addressDone.work tapes.address).cells 0 = Γ.start := + TM.work_cells_zero_eq_start_of_reachesIn tapes.address haddressReach + haddressStart + have haddressReads : ∀ i, (addressDone.work i).read ≠ Γ.start := by + intro i + by_cases his : i = tapes.source + · subst i + exact haddressSource.read_ne_start + · by_cases hia : i = tapes.address + · subst i + rw [haddressTarget.read_blank] + decide + · by_cases him : i = tapes.addressCounter + · subst i + rw [haddressMarkerFinal.read_blank] + decide + · rw [haddressFrame i his hia him] + exact hreads i + have hvalueInitial : + (addressDone.work tapes.value).HasBinaryPrefix [] := by + rw [haddressFrame tapes.value (tapes.ne (by decide)) + (tapes.ne (by decide)) (tapes.ne (by decide))] + exact hvalue + have hvalueStartInitial : + (addressDone.work tapes.value).cells 0 = Γ.start := by + rw [haddressFrame tapes.value (tapes.ne (by decide)) + (tapes.ne (by decide)) (tapes.ne (by decide))] + exact hvalueStart + have hvalueMarkerInitial : + (addressDone.work tapes.valueCounter).HasBinaryPrefix [] := by + rw [haddressFrame tapes.valueCounter (tapes.ne (by decide)) + (tapes.ne (by decide)) (tapes.ne (by decide))] + exact hvalueMarker + have hvalueMarkerStartInitial : + (addressDone.work tapes.valueCounter).cells 0 = Γ.start := by + rw [haddressFrame tapes.valueCounter (tapes.ne (by decide)) + (tapes.ne (by decide)) (tapes.ne (by decide))] + exact hvalueMarkerStart + obtain ⟨valueDone, hvalueReach, hvalueHalt, hvalueInput, hvalueSource, + hvalueTarget, hvalueMarkerFinal, hvalueFrame, hvalueOutput⟩ := + wordDecodeLinearTM_reachesIn_frame_encode tapes.source tapes.value + tapes.valueCounter tapes.valueLinearDistinct entry.2 rest + addressDone.input addressDone.work addressDone.output haddressSource + hvalueInitial hvalueMarkerInitial hvalueMarkerStartInitial + (by rw [haddressInput]; exact hinput) haddressReads + (by rw [haddressOutput]; exact houtput) + have hvalueStartFinal : + (valueDone.work tapes.value).cells 0 = Γ.start := + TM.work_cells_zero_eq_start_of_reachesIn tapes.value hvalueReach + hvalueStartInitial + have htransitionInput : TM.transitionInput addressDone.input = + addressDone.input := + TM.transitionInput_eq_self (by rw [haddressInput]; exact hinput) + have htransitionWork : + (fun i => TM.transitionTape (addressDone.work i)) = addressDone.work := by + funext i + exact TM.transitionTape_eq_self (haddressReads i) + have htransitionOutput : TM.transitionTape addressDone.output = + addressDone.output := + TM.transitionTape_eq_self (by rw [haddressOutput]; exact houtput) + have hvalueReach' : valueTM.reachesIn + (wordDecodeLinearTime (bitlen entry.2)) + { state := valueTM.qstart + input := TM.transitionInput addressDone.input + work := fun i => TM.transitionTape (addressDone.work i) + output := TM.transitionTape addressDone.output } valueDone := by + rw [htransitionInput, htransitionWork, htransitionOutput] + simpa [valueTM] using hvalueReach + have hfullReach := TM.seqTM_reachesIn_of_reachesIn addressTM valueTM + (by simpa [addressTM] using haddressReach) haddressHalt hvalueReach' + let finalCfg := TM.phase2Wrap addressTM valueTM valueDone + refine ⟨finalCfg, ?_, ?_, hvalueInput.trans haddressInput, hvalueSource, + ?_, ?_, hvalueTarget, hvalueStartFinal, ?_, hvalueMarkerFinal, ?_, + hvalueOutput.trans haddressOutput⟩ + · simpa [entryDecodeLinearTM, entryDecodeLinearTime, addressTM, valueTM, + finalCfg] using hfullReach + · exact (TM.phase2Wrap_halted_iff addressTM valueTM valueDone).2 hvalueHalt + · change (valueDone.work tapes.address).HasBinaryPrefix entry.1.bits + rw [hvalueFrame tapes.address (tapes.ne (by decide)) + (tapes.ne (by decide)) (tapes.ne (by decide))] + exact haddressTarget + · change (valueDone.work tapes.address).cells 0 = Γ.start + rw [hvalueFrame tapes.address (tapes.ne (by decide)) + (tapes.ne (by decide)) (tapes.ne (by decide))] + exact haddressStartFinal + · change (valueDone.work tapes.addressCounter).HasBinaryPrefix + (List.replicate (bitlen entry.1) true) + rw [hvalueFrame tapes.addressCounter (tapes.ne (by decide)) + (tapes.ne (by decide)) (tapes.ne (by decide))] + exact haddressMarkerFinal + · intro i his hia hiv hiac hivc + change valueDone.work i = work₀ i + rw [hvalueFrame i his hiv hivc, haddressFrame i his hia hiac] + +end Machine + +end RegisterStore + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryEncode.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryEncode.lean new file mode 100644 index 0000000000..c93593a45b --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryEncode.lean @@ -0,0 +1,208 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryEncode.Defs +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryEncode.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Hoare.RetargetOutput + +/-! +# Sparse entry emission +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace RegisterStore + +namespace Machine + +/-- Emit exactly `Entry.encode entry` from distinct canonical address and value +work tapes, with a literal frame around those sources. -/ +theorem entryEncodeTM_hoareTime_frame {n : ℕ} + (tapes : EntryEncodeTapes n) (entry : Entry) (emitted : List Bool) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (haddress : (work₀ tapes.address).HasBinaryNat entry.1) + (hvalue : (work₀ tapes.value).HasBinaryNat entry.2) + (hinput : TM.Parked inp₀) + (hother : ∀ i, i ≠ tapes.address → i ≠ tapes.value → + TM.Parked (work₀ i)) + (houtput : out₀.HasBinaryPrefix emitted) : + (entryEncodeTM tapes).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + (work tapes.address).HasBinarySuffix [] ∧ + (work tapes.address).cells = (work₀ tapes.address).cells ∧ + (work tapes.address).head = entry.1.bits.length + 1 ∧ + (work tapes.value).HasBinarySuffix [] ∧ + (work tapes.value).cells = (work₀ tapes.value).cells ∧ + (work tapes.value).head = entry.2.bits.length + 1 ∧ + (∀ i, i ≠ tapes.address → i ≠ tapes.value → work i = work₀ i) ∧ + out.HasBinaryPrefix (emitted ++ Entry.encode entry)) + (entryEncodeTime entry) := + entryEncodeTM_hoareTime_frame_internal tapes entry emitted inp₀ work₀ out₀ + haddress hvalue hinput hother houtput + +/-- Rewind arbitrary bounded decoded address/value cursors and emit exactly +`Entry.encode entry`, retaining a literal frame around both sources. -/ +theorem rewindEntryEncodeTM_hoareTime_frame {n : ℕ} + (tapes : EntryEncodeTapes n) (entry : Entry) + (addressHeadBound valueHeadBound : ℕ) (emitted : List Bool) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (haddress : (work₀ tapes.address).HasBinaryContent entry.1.bits) + (haddressStart : (work₀ tapes.address).cells 0 = Γ.start) + (haddressHead : 1 ≤ (work₀ tapes.address).head ∧ + (work₀ tapes.address).head ≤ addressHeadBound) + (hvalue : (work₀ tapes.value).HasBinaryContent entry.2.bits) + (hvalueStart : (work₀ tapes.value).cells 0 = Γ.start) + (hvalueHead : 1 ≤ (work₀ tapes.value).head ∧ + (work₀ tapes.value).head ≤ valueHeadBound) + (hinput : TM.Parked inp₀) + (hother : ∀ i, i ≠ tapes.address → i ≠ tapes.value → + TM.Parked (work₀ i)) + (houtput : out₀.HasBinaryPrefix emitted) : + (rewindEntryEncodeTM tapes).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + (work tapes.address).HasBinarySuffix [] ∧ + (work tapes.address).cells = (work₀ tapes.address).cells ∧ + (work tapes.address).head = entry.1.bits.length + 1 ∧ + (work tapes.value).HasBinarySuffix [] ∧ + (work tapes.value).cells = (work₀ tapes.value).cells ∧ + (work tapes.value).head = entry.2.bits.length + 1 ∧ + (∀ i, i ≠ tapes.address → i ≠ tapes.value → work i = work₀ i) ∧ + out.HasBinaryPrefix (emitted ++ Entry.encode entry)) + (rewindEntryEncodeTime entry addressHeadBound valueHeadBound) := + rewindEntryEncodeTM_hoareTime_frame_internal tapes entry addressHeadBound + valueHeadBound emitted inp₀ work₀ out₀ haddress haddressStart + haddressHead hvalue hvalueStart hvalueHead hinput hother houtput + +/-- Emit one entry from canonical address/value sources, then restore the +entire work family exactly. -/ +theorem rewindEntryEncodeRestoreTM_hoareTime_frame {n : ℕ} + (tapes : EntryEncodeTapes n) (entry : Entry) (emitted : List Bool) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (haddress : (work₀ tapes.address).HasBinaryNat entry.1) + (hvalue : (work₀ tapes.value).HasBinaryNat entry.2) + (hinput : TM.Parked inp₀) + (hother : ∀ i, i ≠ tapes.address → i ≠ tapes.value → + TM.Parked (work₀ i)) + (houtput : out₀.HasBinaryPrefix emitted) : + (rewindEntryEncodeRestoreTM tapes).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ work = work₀ ∧ + out.HasBinaryPrefix (emitted ++ Entry.encode entry)) + (rewindEntryEncodeRestoreTime entry) := + rewindEntryEncodeRestoreTM_hoareTime_frame_internal tapes entry emitted + inp₀ work₀ out₀ haddress hvalue hinput hother houtput + +/-- Redirect restored entry emission into the fresh last work tape. All base +work tapes are restored exactly and the real output remains standard blank. -/ +theorem rewindEntryEncodeRestoreTM_retargetOutput_hoareTime_frame {n : ℕ} + (tapes : EntryEncodeTapes n) (entry : Entry) (emitted : List Bool) + (inp₀ : Tape) (work₀ : Fin (n + 1) → Tape) + (haddress : (work₀ (Fin.castSucc tapes.address)).HasBinaryNat entry.1) + (hvalue : (work₀ (Fin.castSucc tapes.value)).HasBinaryNat entry.2) + (hinput : TM.Parked inp₀) + (hother : ∀ i, i ≠ tapes.address → i ≠ tapes.value → + TM.Parked (work₀ (Fin.castSucc i))) + (hbuffer : (work₀ (Fin.last n)).HasBinaryPrefix emitted) : + (rewindEntryEncodeRestoreTM tapes).retargetOutput.HoareTime + (fun inp work out => + inp = inp₀ ∧ work = work₀ ∧ + out = (Tape.init []).move Dir3.right) + (fun inp work out => + inp = inp₀ ∧ + (∀ i, i ≠ Fin.last n → work i = work₀ i) ∧ + (work (Fin.last n)).HasBinaryPrefix + (emitted ++ Entry.encode entry) ∧ + out = (Tape.init []).move Dir3.right) + (rewindEntryEncodeRestoreTime entry) := by + let baseWork : Fin n → Tape := fun i => work₀ (Fin.castSucc i) + have hbase := rewindEntryEncodeRestoreTM_hoareTime_frame tapes entry emitted + inp₀ baseWork (work₀ (Fin.last n)) haddress hvalue hinput hother hbuffer + have hlift := TM.retargetOutput_hoareTime + (rewindEntryEncodeRestoreTM tapes) hbase + apply hlift.consequence + · rintro inp work out ⟨hinp, hwork, hout⟩ + subst inp + subst work + exact ⟨⟨rfl, rfl, rfl⟩, hout⟩ + · intro inp work out hpost + rcases hpost with ⟨⟨hinp, hbaseWork, hbuffer'⟩, hout⟩ + refine ⟨hinp, ?_, hbuffer', hout⟩ + intro i hi + have hil : i.val < n := by + have hle : i.val ≤ n := by omega + have hne : i.val ≠ n := by + intro hval + apply hi + apply Fin.ext + simpa using hval + omega + let j : Fin n := ⟨i.val, hil⟩ + have hij : i = Fin.castSucc j := by + apply Fin.ext + rfl + rw [hij] + exact congrFun hbaseWork j + · exact le_rfl + +/-- Entry emission is append-only on the output tape. -/ +theorem entryEncodeTM_isTransducer {n : ℕ} (tapes : EntryEncodeTapes n) : + (entryEncodeTM tapes).IsTransducer := + (wordEncodeTM_isTransducer tapes.address).seqTM + (wordEncodeTM_isTransducer tapes.value) + +/-- Rewind-and-emit entry encoding is append-only on the output tape. -/ +theorem rewindEntryEncodeTM_isTransducer {n : ℕ} + (tapes : EntryEncodeTapes n) : + (rewindEntryEncodeTM tapes).IsTransducer := + (rewindWordEncodeTM_isTransducer tapes.address).seqTM + (rewindWordEncodeTM_isTransducer tapes.value) + +/-- Coarse all-prefix auxiliary-space envelope for entry emission. -/ +theorem entryEncodeTM_prefix_withinAuxSpace {n : ℕ} + (tapes : EntryEncodeTapes n) (entry : Entry) + (inputLength initialSpace time : ℕ) + (start current : Complexity.Cfg n (entryEncodeTM tapes).Q) + (hinitial : start.WithinAuxSpace inputLength initialSpace) + (hreach : (entryEncodeTM tapes).reachesIn time start current) + (htime : time ≤ entryEncodeTime entry) : + current.WithinAuxSpace inputLength + (initialSpace + entryEncodeTime entry) := + (hinitial.reachesIn hreach).mono le_rfl (by omega) + +/-- Coarse all-prefix envelope for rewind-and-emit entry encoding. -/ +theorem rewindEntryEncodeTM_prefix_withinAuxSpace {n : ℕ} + (tapes : EntryEncodeTapes n) (entry : Entry) + (addressHeadBound valueHeadBound inputLength initialSpace time : ℕ) + (start current : Complexity.Cfg n (rewindEntryEncodeTM tapes).Q) + (hinitial : start.WithinAuxSpace inputLength initialSpace) + (hreach : (rewindEntryEncodeTM tapes).reachesIn time start current) + (htime : time ≤ + rewindEntryEncodeTime entry addressHeadBound valueHeadBound) : + current.WithinAuxSpace inputLength + (initialSpace + + rewindEntryEncodeTime entry addressHeadBound valueHeadBound) := + (hinitial.reachesIn hreach).mono le_rfl (by omega) + +end Machine + +end RegisterStore + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryEncode/Defs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryEncode/Defs.lean new file mode 100644 index 0000000000..46722fcd12 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryEncode/Defs.lean @@ -0,0 +1,73 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.WordEncode.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Defs + +/-! +# Sparse entry emission — definitions +-/ + + +@[expose] public section + +namespace Complexity + +namespace RAM + +namespace RegisterStore + +namespace Machine + +/-- Distinct decoded address and value tapes used to emit one sparse entry. -/ +structure EntryEncodeTapes (n : ℕ) where + /-- Decoded address source. -/ + address : Fin n + /-- Decoded value source. -/ + value : Fin n + /-- The address and value sources are distinct. -/ + ne : address ≠ value + +/-- Emit one address/value entry as two consecutive self-delimiting words. -/ +def entryEncodeTM {n : ℕ} (tapes : EntryEncodeTapes n) : TM n := + TM.seqTM (wordEncodeTM tapes.address) (wordEncodeTM tapes.value) + +/-- Compositional time bound for one encoded entry. -/ +def entryEncodeTime (entry : Entry) : ℕ := + wordEncodeTime entry.1 + 1 + wordEncodeTime entry.2 + +/-- Rewind arbitrary decoded address/value cursors and emit the entry. -/ +def rewindEntryEncodeTM {n : ℕ} (tapes : EntryEncodeTapes n) : TM n := + TM.seqTM (rewindWordEncodeTM tapes.address) + (rewindWordEncodeTM tapes.value) + +/-- Composition bound for emitting an entry from arbitrary bounded cursors. -/ +def rewindEntryEncodeTime (entry : Entry) + (addressHeadBound valueHeadBound : ℕ) : ℕ := + rewindWordEncodeTime entry.1 addressHeadBound + 1 + + rewindWordEncodeTime entry.2 valueHeadBound + +/-- Emit an entry from canonical sources and restore both source heads to +cell one. -/ +def rewindEntryEncodeRestoreTM {n : ℕ} (tapes : EntryEncodeTapes n) : TM n := + TM.seqTM (rewindEntryEncodeTM tapes) + (TM.seqTM (TM.rewindWorkTM tapes.address) + (TM.rewindWorkTM tapes.value)) + +/-- Compositional bound for entry emission followed by two-source restore. -/ +def rewindEntryEncodeRestoreTime (entry : Entry) : ℕ := + rewindEntryEncodeTime entry 1 1 + 1 + + (entry.1.bits.length + 3 + 1 + entry.2.bits.length + 3) + +end Machine + +end RegisterStore + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryEncode/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryEncode/Internal.lean new file mode 100644 index 0000000000..893c3c0cee --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryEncode/Internal.lean @@ -0,0 +1,492 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryEncode.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.WordEncode + +/-! +# Sparse entry emission — proof internals +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace RegisterStore + +namespace Machine + +variable {n : ℕ} + +private theorem parked_of_binaryNat {t : Tape} {value : ℕ} + (h : t.HasBinaryNat value) : TM.Parked t := + ⟨by rw [h.2.1], h.2.hasBinaryContent.cells_ne_start⟩ + +private theorem parked_of_binarySuffix {t : Tape} {bits : List Bool} + (h : t.HasBinarySuffix bits) : TM.Parked t := + ⟨h.1, h.2.2.2⟩ + +private theorem parked_of_binaryPrefix {t : Tape} {bits : List Bool} + (h : t.HasBinaryPrefix bits) : TM.Parked t := + ⟨by rw [h.1]; omega, + (show t.HasBinaryContent bits from h.2).cells_ne_start⟩ + +theorem entryEncodeTM_hoareTime_frame_internal + (tapes : EntryEncodeTapes n) (entry : Entry) (emitted : List Bool) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (haddress : (work₀ tapes.address).HasBinaryNat entry.1) + (hvalue : (work₀ tapes.value).HasBinaryNat entry.2) + (hinput : TM.Parked inp₀) + (hother : ∀ i, i ≠ tapes.address → i ≠ tapes.value → + TM.Parked (work₀ i)) + (houtput : out₀.HasBinaryPrefix emitted) : + (entryEncodeTM tapes).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + (work tapes.address).HasBinarySuffix [] ∧ + (work tapes.address).cells = (work₀ tapes.address).cells ∧ + (work tapes.address).head = entry.1.bits.length + 1 ∧ + (work tapes.value).HasBinarySuffix [] ∧ + (work tapes.value).cells = (work₀ tapes.value).cells ∧ + (work tapes.value).head = entry.2.bits.length + 1 ∧ + (∀ i, i ≠ tapes.address → i ≠ tapes.value → work i = work₀ i) ∧ + out.HasBinaryPrefix (emitted ++ Entry.encode entry)) + (entryEncodeTime entry) := by + intro inp work out hpre + rcases hpre with ⟨hinp, hwork, hout⟩ + subst inp + subst work + subst out + have hinitialParked : ∀ i, TM.Parked (work₀ i) := by + intro i + by_cases hia : i = tapes.address + · subst i + exact parked_of_binaryNat haddress + · by_cases hiv : i = tapes.value + · subst i + exact parked_of_binaryNat hvalue + · exact hother i hia hiv + have haddressContract := wordEncodeTM_hoareTime_frame tapes.address + entry.1 emitted inp₀ work₀ out₀ haddress hinput + (fun i _ => hinitialParked i) houtput + obtain ⟨addressDone, addressTime, haddressTime, haddressReach, + haddressHalt, haddressInput, haddressSuffix, haddressCells, + haddressHeadDone, haddressFrame, haddressOutput⟩ := + haddressContract inp₀ work₀ out₀ ⟨rfl, rfl, rfl⟩ + have haddressParked : TM.Parked (addressDone.work tapes.address) := + parked_of_binarySuffix haddressSuffix + have haddressWorkParked : ∀ i, TM.Parked (addressDone.work i) := by + intro i + by_cases hi : i = tapes.address + · subst i + exact haddressParked + · rw [haddressFrame i hi] + exact hinitialParked i + have haddressOutputParked : TM.Parked addressDone.output := + parked_of_binaryPrefix haddressOutput + obtain ⟨hinputTransition, hworkTransition, houtputTransition⟩ := + TM.phaseTransition_eq_self_of_reads_ne_start + (haddressInput ▸ hinput.read_ne_start) + (fun i => (haddressWorkParked i).read_ne_start) + haddressOutputParked.read_ne_start + have hvalueDone : (addressDone.work tapes.value).HasBinaryNat entry.2 := by + rw [haddressFrame tapes.value (Ne.symm tapes.ne)] + exact hvalue + have hvalueContract := wordEncodeTM_hoareTime_frame tapes.value entry.2 + (emitted ++ WordCode.encode entry.1) addressDone.input addressDone.work + addressDone.output hvalueDone (haddressInput ▸ hinput) + (fun i _ => haddressWorkParked i) haddressOutput + obtain ⟨valueDone, valueTime, hvalueTime, hvalueReach, hvalueHalt, + hvalueInput, hvalueSuffix, hvalueCells, hvalueHeadFinal, + hvalueFrame, hvalueOutput⟩ := + hvalueContract addressDone.input addressDone.work addressDone.output + ⟨rfl, rfl, rfl⟩ + have hvalueReach' : (wordEncodeTM tapes.value).reachesIn valueTime + { state := (wordEncodeTM tapes.value).qstart + input := TM.transitionInput addressDone.input + work := fun i => TM.transitionTape (addressDone.work i) + output := TM.transitionTape addressDone.output } + valueDone := by + simpa [hinputTransition, hworkTransition, houtputTransition] using + hvalueReach + have hreach := TM.seqTM_reachesIn_of_reachesIn + (wordEncodeTM tapes.address) (wordEncodeTM tapes.value) + haddressReach haddressHalt hvalueReach' + let finalCfg := TM.phase2Wrap (wordEncodeTM tapes.address) + (wordEncodeTM tapes.value) valueDone + refine ⟨finalCfg, addressTime + 1 + valueTime, ?_, hreach, ?_, ?_⟩ + · unfold entryEncodeTime + omega + · change (entryEncodeTM tapes).halted finalCfg + unfold entryEncodeTM + rw [TM.phase2Wrap_halted_iff] + exact hvalueHalt + · refine ⟨?_, ?_, ?_, ?_, hvalueSuffix, ?_, hvalueHeadFinal, ?_, ?_⟩ + · simpa [finalCfg] using hvalueInput.trans haddressInput + · change (valueDone.work tapes.address).HasBinarySuffix [] + rw [hvalueFrame tapes.address tapes.ne] + exact haddressSuffix + · change (valueDone.work tapes.address).cells = + (work₀ tapes.address).cells + rw [hvalueFrame tapes.address tapes.ne] + exact haddressCells + · change (valueDone.work tapes.address).head = entry.1.bits.length + 1 + rw [hvalueFrame tapes.address tapes.ne] + exact haddressHeadDone + · change (valueDone.work tapes.value).cells = (work₀ tapes.value).cells + rw [hvalueCells, haddressFrame tapes.value (Ne.symm tapes.ne)] + · intro i hia hiv + change valueDone.work i = work₀ i + exact (hvalueFrame i hiv).trans (haddressFrame i hia) + · simpa [finalCfg, Entry.encode, List.append_assoc] using hvalueOutput + +theorem rewindEntryEncodeTM_hoareTime_frame_internal + (tapes : EntryEncodeTapes n) (entry : Entry) + (addressHeadBound valueHeadBound : ℕ) (emitted : List Bool) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (haddress : (work₀ tapes.address).HasBinaryContent entry.1.bits) + (haddressStart : (work₀ tapes.address).cells 0 = Γ.start) + (haddressHead : 1 ≤ (work₀ tapes.address).head ∧ + (work₀ tapes.address).head ≤ addressHeadBound) + (hvalue : (work₀ tapes.value).HasBinaryContent entry.2.bits) + (hvalueStart : (work₀ tapes.value).cells 0 = Γ.start) + (hvalueHead : 1 ≤ (work₀ tapes.value).head ∧ + (work₀ tapes.value).head ≤ valueHeadBound) + (hinput : TM.Parked inp₀) + (hother : ∀ i, i ≠ tapes.address → i ≠ tapes.value → + TM.Parked (work₀ i)) + (houtput : out₀.HasBinaryPrefix emitted) : + (rewindEntryEncodeTM tapes).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + (work tapes.address).HasBinarySuffix [] ∧ + (work tapes.address).cells = (work₀ tapes.address).cells ∧ + (work tapes.address).head = entry.1.bits.length + 1 ∧ + (work tapes.value).HasBinarySuffix [] ∧ + (work tapes.value).cells = (work₀ tapes.value).cells ∧ + (work tapes.value).head = entry.2.bits.length + 1 ∧ + (∀ i, i ≠ tapes.address → i ≠ tapes.value → work i = work₀ i) ∧ + out.HasBinaryPrefix (emitted ++ Entry.encode entry)) + (rewindEntryEncodeTime entry addressHeadBound valueHeadBound) := by + intro inp work out hpre + rcases hpre with ⟨hinp, hwork, hout⟩ + subst inp + subst work + subst out + have hinitialParked : ∀ i, TM.Parked (work₀ i) := by + intro i + by_cases hia : i = tapes.address + · subst i + exact ⟨haddressHead.1, haddress.cells_ne_start⟩ + · by_cases hiv : i = tapes.value + · subst i + exact ⟨hvalueHead.1, hvalue.cells_ne_start⟩ + · exact hother i hia hiv + have haddressContract := rewindWordEncodeTM_hoareTime_frame tapes.address + entry.1 addressHeadBound emitted inp₀ work₀ out₀ haddress haddressStart + haddressHead hinput (fun i _ => hinitialParked i) houtput + obtain ⟨addressDone, addressTime, haddressTime, haddressReach, + haddressHalt, haddressInput, haddressSuffix, haddressCells, + haddressHeadDone, haddressFrame, haddressOutput⟩ := + haddressContract inp₀ work₀ out₀ ⟨rfl, rfl, rfl⟩ + have haddressWorkParked : ∀ i, TM.Parked (addressDone.work i) := by + intro i + by_cases hi : i = tapes.address + · subst i + exact parked_of_binarySuffix haddressSuffix + · rw [haddressFrame i hi] + exact hinitialParked i + have haddressOutputParked : TM.Parked addressDone.output := + parked_of_binaryPrefix haddressOutput + obtain ⟨hinputTransition, hworkTransition, houtputTransition⟩ := + TM.phaseTransition_eq_self_of_reads_ne_start + (haddressInput ▸ hinput.read_ne_start) + (fun i => (haddressWorkParked i).read_ne_start) + haddressOutputParked.read_ne_start + have hvalueDone : + (addressDone.work tapes.value).HasBinaryContent entry.2.bits := by + rw [haddressFrame tapes.value (Ne.symm tapes.ne)] + exact hvalue + have hvalueStartDone : + (addressDone.work tapes.value).cells 0 = Γ.start := by + rw [haddressFrame tapes.value (Ne.symm tapes.ne)] + exact hvalueStart + have hvalueHeadDone : + 1 ≤ (addressDone.work tapes.value).head ∧ + (addressDone.work tapes.value).head ≤ valueHeadBound := by + rw [haddressFrame tapes.value (Ne.symm tapes.ne)] + exact hvalueHead + have hvalueContract := rewindWordEncodeTM_hoareTime_frame tapes.value + entry.2 valueHeadBound (emitted ++ WordCode.encode entry.1) + addressDone.input addressDone.work addressDone.output hvalueDone + hvalueStartDone hvalueHeadDone (haddressInput ▸ hinput) + (fun i _ => haddressWorkParked i) haddressOutput + obtain ⟨valueDone, valueTime, hvalueTime, hvalueReach, hvalueHalt, + hvalueInput, hvalueSuffix, hvalueCells, hvalueHeadFinal, + hvalueFrame, hvalueOutput⟩ := + hvalueContract addressDone.input addressDone.work addressDone.output + ⟨rfl, rfl, rfl⟩ + have hvalueReach' : (rewindWordEncodeTM tapes.value).reachesIn valueTime + { state := (rewindWordEncodeTM tapes.value).qstart + input := TM.transitionInput addressDone.input + work := fun i => TM.transitionTape (addressDone.work i) + output := TM.transitionTape addressDone.output } + valueDone := by + simpa [hinputTransition, hworkTransition, houtputTransition] using + hvalueReach + have hreach := TM.seqTM_reachesIn_of_reachesIn + (rewindWordEncodeTM tapes.address) (rewindWordEncodeTM tapes.value) + haddressReach haddressHalt hvalueReach' + let finalCfg := TM.phase2Wrap (rewindWordEncodeTM tapes.address) + (rewindWordEncodeTM tapes.value) valueDone + refine ⟨finalCfg, addressTime + 1 + valueTime, ?_, hreach, ?_, ?_⟩ + · unfold rewindEntryEncodeTime + omega + · change (rewindEntryEncodeTM tapes).halted finalCfg + unfold rewindEntryEncodeTM + rw [TM.phase2Wrap_halted_iff] + exact hvalueHalt + · refine ⟨?_, ?_, ?_, ?_, hvalueSuffix, ?_, hvalueHeadFinal, ?_, ?_⟩ + · simpa [finalCfg] using hvalueInput.trans haddressInput + · change (valueDone.work tapes.address).HasBinarySuffix [] + rw [hvalueFrame tapes.address tapes.ne] + exact haddressSuffix + · change (valueDone.work tapes.address).cells = + (work₀ tapes.address).cells + rw [hvalueFrame tapes.address tapes.ne] + exact haddressCells + · change (valueDone.work tapes.address).head = entry.1.bits.length + 1 + rw [hvalueFrame tapes.address tapes.ne] + exact haddressHeadDone + · change (valueDone.work tapes.value).cells = (work₀ tapes.value).cells + rw [hvalueCells, haddressFrame tapes.value (Ne.symm tapes.ne)] + · intro i hia hiv + change valueDone.work i = work₀ i + exact (hvalueFrame i hiv).trans (haddressFrame i hia) + · simpa [finalCfg, Entry.encode, List.append_assoc] using hvalueOutput + +theorem rewindEntryEncodeRestoreTM_hoareTime_frame_internal + (tapes : EntryEncodeTapes n) (entry : Entry) (emitted : List Bool) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (haddress : (work₀ tapes.address).HasBinaryNat entry.1) + (hvalue : (work₀ tapes.value).HasBinaryNat entry.2) + (hinput : TM.Parked inp₀) + (hother : ∀ i, i ≠ tapes.address → i ≠ tapes.value → + TM.Parked (work₀ i)) + (houtput : out₀.HasBinaryPrefix emitted) : + (rewindEntryEncodeRestoreTM tapes).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ work = work₀ ∧ + out.HasBinaryPrefix (emitted ++ Entry.encode entry)) + (rewindEntryEncodeRestoreTime entry) := by + intro inp work out hpre + rcases hpre with ⟨hinp, hwork, hout⟩ + subst inp + subst work + subst out + have haddressHead : 1 ≤ (work₀ tapes.address).head ∧ + (work₀ tapes.address).head ≤ 1 := by + rw [haddress.2.1] + exact ⟨le_rfl, le_rfl⟩ + have hvalueHead : 1 ≤ (work₀ tapes.value).head ∧ + (work₀ tapes.value).head ≤ 1 := by + rw [hvalue.2.1] + exact ⟨le_rfl, le_rfl⟩ + have hencode := rewindEntryEncodeTM_hoareTime_frame_internal tapes entry + 1 1 emitted inp₀ work₀ out₀ haddress.2.hasBinaryContent haddress.1 + haddressHead hvalue.2.hasBinaryContent hvalue.1 hvalueHead hinput + hother houtput + obtain ⟨encoded, encodeTime, hencodeTime, hencodeReach, hencodeHalt, + hencodedInput, haddressSuffix, haddressCells, haddressEncodedHead, + hvalueSuffix, hvalueCells, hvalueEncodedHead, hencodedFrame, + hencodedOutput⟩ := hencode inp₀ work₀ out₀ ⟨rfl, rfl, rfl⟩ + have haddressCells' : (encoded.work tapes.address).cells = + (work₀ tapes.address).cells := by + simpa using haddressCells + have haddressEncodedHead' : (encoded.work tapes.address).head = + entry.1.bits.length + 1 := by + simpa using haddressEncodedHead + have hvalueCells' : (encoded.work tapes.value).cells = + (work₀ tapes.value).cells := by + simpa using hvalueCells + have hvalueEncodedHead' : (encoded.work tapes.value).head = + entry.2.bits.length + 1 := by + simpa using hvalueEncodedHead + have hencodedInputParked : TM.Parked encoded.input := by + rw [hencodedInput] + exact hinput + have hencodedOutputParked : TM.Parked encoded.output := + parked_of_binaryPrefix hencodedOutput + have hencodedWorkParked : ∀ i, TM.Parked (encoded.work i) := by + intro i + by_cases hia : i = tapes.address + · subst i + exact parked_of_binarySuffix haddressSuffix + · by_cases hiv : i = tapes.value + · subst i + exact parked_of_binarySuffix hvalueSuffix + · rw [hencodedFrame i hia hiv] + exact hother i hia hiv + have haddressContent : + (encoded.work tapes.address).HasBinaryContent entry.1.bits := by + simpa only [Tape.HasBinaryContent, haddressCells'] using + haddress.2.hasBinaryContent + have haddressStart : + (encoded.work tapes.address).cells 0 = Γ.start := by + rw [haddressCells'] + exact haddress.1 + have haddressRewind := TM.rewindBinaryWorkTM_hoareTime_frame + tapes.address entry.1.bits (entry.1.bits.length + 1) + encoded.input encoded.work encoded.output haddressContent haddressStart + ⟨by rw [haddressEncodedHead']; omega, + by rw [haddressEncodedHead']⟩ + hencodedInputParked (fun i _ => hencodedWorkParked i) + hencodedOutputParked + obtain ⟨addressRewound, addressTime, haddressTime, haddressReach, + haddressHalt, haddressInput, haddressRestoredCanonical, + haddressFrame, haddressOutput⟩ := + haddressRewind encoded.input encoded.work encoded.output ⟨rfl, rfl, rfl⟩ + have haddressCanonical : work₀ tapes.address = + (Tape.init (entry.1.bits.map Γ.ofBool)).move Dir3.right := + Tape.eq_init_move_right_of_hasBinaryString haddress.2 haddress.1 + have haddressRestored : addressRewound.work tapes.address = + work₀ tapes.address := + haddressRestoredCanonical.trans haddressCanonical.symm + have hvalueContent : + (addressRewound.work tapes.value).HasBinaryContent entry.2.bits := by + rw [haddressFrame tapes.value (Ne.symm tapes.ne)] + simpa only [Tape.HasBinaryContent, hvalueCells'] using + hvalue.2.hasBinaryContent + have hvalueStart : + (addressRewound.work tapes.value).cells 0 = Γ.start := by + rw [haddressFrame tapes.value (Ne.symm tapes.ne), hvalueCells'] + exact hvalue.1 + have hvalueHead' : (addressRewound.work tapes.value).head = + entry.2.bits.length + 1 := by + rw [haddressFrame tapes.value (Ne.symm tapes.ne)] + exact hvalueEncodedHead' + have haddressInputParked : TM.Parked addressRewound.input := by + rw [haddressInput] + exact hencodedInputParked + have haddressOutputParked : TM.Parked addressRewound.output := by + rw [haddressOutput] + exact hencodedOutputParked + have haddressWorkParked : ∀ i, TM.Parked (addressRewound.work i) := by + intro i + by_cases hia : i = tapes.address + · subst i + rw [haddressRestored] + exact parked_of_binaryNat haddress + · rw [haddressFrame i hia] + exact hencodedWorkParked i + have hvalueRewind := TM.rewindBinaryWorkTM_hoareTime_frame + tapes.value entry.2.bits (entry.2.bits.length + 1) + addressRewound.input addressRewound.work addressRewound.output + hvalueContent hvalueStart + ⟨by rw [hvalueHead']; omega, by rw [hvalueHead']⟩ + haddressInputParked (fun i _ => haddressWorkParked i) + haddressOutputParked + obtain ⟨restored, valueTime, hvalueTime, hvalueReach, hvalueHalt, + hvalueInput, hvalueRestoredCanonical, hvalueFrame, + hvalueOutput⟩ := + hvalueRewind addressRewound.input addressRewound.work + addressRewound.output ⟨rfl, rfl, rfl⟩ + have hvalueCanonical : work₀ tapes.value = + (Tape.init (entry.2.bits.map Γ.ofBool)).move Dir3.right := + Tape.eq_init_move_right_of_hasBinaryString hvalue.2 hvalue.1 + have hvalueRestored : restored.work tapes.value = work₀ tapes.value := + hvalueRestoredCanonical.trans hvalueCanonical.symm + have hrestoredWork : restored.work = work₀ := by + funext i + by_cases hiv : i = tapes.value + · subst i + exact hvalueRestored + · rw [hvalueFrame i hiv] + by_cases hia : i = tapes.address + · subst i + exact haddressRestored + · exact (haddressFrame i hia).trans (hencodedFrame i hia hiv) + obtain ⟨haddressInputTransition, haddressWorkTransition, + haddressOutputTransition⟩ := + TM.phaseTransition_eq_self_of_reads_ne_start + haddressInputParked.read_ne_start + (fun i => (haddressWorkParked i).read_ne_start) + haddressOutputParked.read_ne_start + have hvalueReach' : (TM.rewindWorkTM tapes.value).reachesIn valueTime + { state := (TM.rewindWorkTM tapes.value).qstart + input := TM.transitionInput addressRewound.input + work := fun i => TM.transitionTape (addressRewound.work i) + output := TM.transitionTape addressRewound.output } + restored := by + simpa only [haddressInputTransition, haddressWorkTransition, + haddressOutputTransition] using hvalueReach + have htailReach := TM.seqTM_reachesIn_of_reachesIn + (TM.rewindWorkTM tapes.address) (TM.rewindWorkTM tapes.value) + haddressReach haddressHalt hvalueReach' + let tailFinal := TM.phase2Wrap (TM.rewindWorkTM tapes.address) + (TM.rewindWorkTM tapes.value) restored + have htailHalt : + (TM.seqTM (TM.rewindWorkTM tapes.address) + (TM.rewindWorkTM tapes.value)).halted tailFinal := by + rw [TM.phase2Wrap_halted_iff] + exact hvalueHalt + obtain ⟨hencodedInputTransition, hencodedWorkTransition, + hencodedOutputTransition⟩ := + TM.phaseTransition_eq_self_of_reads_ne_start + hencodedInputParked.read_ne_start + (fun i => (hencodedWorkParked i).read_ne_start) + hencodedOutputParked.read_ne_start + have htailReach' : + (TM.seqTM (TM.rewindWorkTM tapes.address) + (TM.rewindWorkTM tapes.value)).reachesIn + (addressTime + 1 + valueTime) + { state := (TM.seqTM (TM.rewindWorkTM tapes.address) + (TM.rewindWorkTM tapes.value)).qstart + input := TM.transitionInput encoded.input + work := fun i => TM.transitionTape (encoded.work i) + output := TM.transitionTape encoded.output } + tailFinal := by + simpa only [hencodedInputTransition, hencodedWorkTransition, + hencodedOutputTransition] using htailReach + have hreach := TM.seqTM_reachesIn_of_reachesIn + (rewindEntryEncodeTM tapes) + (TM.seqTM (TM.rewindWorkTM tapes.address) + (TM.rewindWorkTM tapes.value)) + hencodeReach hencodeHalt htailReach' + let finalCfg := TM.phase2Wrap (rewindEntryEncodeTM tapes) + (TM.seqTM (TM.rewindWorkTM tapes.address) + (TM.rewindWorkTM tapes.value)) tailFinal + refine ⟨finalCfg, encodeTime + 1 + (addressTime + 1 + valueTime), + ?_, hreach, ?_, ?_⟩ + · unfold rewindEntryEncodeRestoreTime + omega + · change (rewindEntryEncodeRestoreTM tapes).halted finalCfg + unfold rewindEntryEncodeRestoreTM + rw [TM.phase2Wrap_halted_iff] + exact htailHalt + · refine ⟨?_, hrestoredWork, ?_⟩ + · change restored.input = inp₀ + exact hvalueInput.trans (haddressInput.trans hencodedInput) + · change restored.output.HasBinaryPrefix + (emitted ++ Entry.encode entry) + rw [hvalueOutput, haddressOutput] + exact hencodedOutput + +end Machine + +end RegisterStore + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryLookup.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryLookup.lean new file mode 100644 index 0000000000..6cc222e36c --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryLookup.lean @@ -0,0 +1,124 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryLookup.Defs +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryLookup.Internal +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Source + +/-! +# Sparse register lookup +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace RegisterStore + +namespace Machine + +/-- A bounded lookup advances the encoded source cursor without modifying its +cells. -/ +theorem entryLookupTM_source_readOnly {n : ℕ} (tapes : EntryScanTapes n) : + (entryLookupTM tapes).WorkReadOnly tapes.entry.source := + entryScanTM_source_readOnly_internal tapes + +/-- Scan a runtime-sized encoded sparse store and leave exactly +`RegisterStore.read store address` on the decoded-value tape. -/ +theorem entryLookupTM_hoareTime_frame {n : ℕ} + (tapes : EntryScanTapes n) (store : Store) (address : ℕ) + (initialWork : Fin n → Tape) (inp₀ out₀ : Tape) + (hready : EntryScanReady tapes.entry (store.flatMap Entry.encode) + address.bits initialWork initialWork) + (hcount : (initialWork tapes.count).HasBinaryNat store.length) + (hinput : TM.Parked inp₀) (houtput : TM.Parked out₀) : + (entryLookupTM tapes).HoareTime + (fun inp work out => inp = inp₀ ∧ work = initialWork ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + EntryLookupResult tapes store address initialWork work ∧ + out = out₀) + (entryLookupTime tapes address store) := + entryLookupTM_hoareTime_frame_internal tapes store address initialWork + inp₀ out₀ hready hcount hinput houtput + +/-- Framed lookup with explicit preservation of the complete encoded source +cell function. -/ +theorem entryLookupTM_hoareTime_frame_source {n : ℕ} + (tapes : EntryScanTapes n) (store : Store) (address : ℕ) + (initialWork : Fin n → Tape) (inp₀ out₀ : Tape) + (hready : EntryScanReady tapes.entry (store.flatMap Entry.encode) + address.bits initialWork initialWork) + (hcount : (initialWork tapes.count).HasBinaryNat store.length) + (hinput : TM.Parked inp₀) (houtput : TM.Parked out₀) : + (entryLookupTM tapes).HoareTime + (fun inp work out => inp = inp₀ ∧ work = initialWork ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + EntryLookupResult tapes store address initialWork work ∧ + (work tapes.entry.source).cells = + (initialWork tapes.entry.source).cells ∧ + (∀ i, (work i).head ≤ (initialWork i).head + + entryLookupTime tapes address store) ∧ + out = out₀) + (entryLookupTime tapes address store) := by + have hlookup := entryLookupTM_hoareTime_frame tapes store address + initialWork inp₀ out₀ hready hcount hinput houtput + intro inp work out hpre + obtain ⟨final, time, htime, hreach, hhalt, hinp, hresult, hout⟩ := + hlookup inp work out hpre + have hstartWork : work = initialWork := hpre.2.1 + have hnostart : ∀ j, 1 ≤ j → + (work tapes.entry.source).cells j ≠ Γ.start := by + rw [hstartWork] + exact hready.source.2.2.2 + have hcells := (entryLookupTM_source_readOnly tapes).cells_eq_of_reachesIn + hreach hnostart + have hheads := TM.head_le_start_add_of_reachesIn + (entryLookupTM tapes) hreach + have hworkHeads : ∀ i, (final.work i).head ≤ + (initialWork i).head + entryLookupTime tapes address store := by + intro i + have hi := hheads.2.2 i + rw [hstartWork] at hi + dsimp only at hi + omega + exact ⟨final, time, htime, hreach, hhalt, hinp, hresult, + hcells.trans (congrArg (fun w => (w tapes.entry.source).cells) + hstartWork), hworkHeads, hout⟩ + +/-- Sparse lookup preserves one-way output safety. -/ +theorem entryLookupTM_isTransducer {n : ℕ} (tapes : EntryScanTapes n) : + (entryLookupTM tapes).IsTransducer := + entryScanTM_isTransducer tapes + +/-- Sparse lookup inherits the scanner's all-prefix auxiliary-space envelope. -/ +theorem entryLookupTM_prefix_withinAuxSpace {n : ℕ} + (tapes : EntryScanTapes n) (store : Store) (address : ℕ) + (inputLength initialSpace time : ℕ) + (start current : Complexity.Cfg n (entryLookupTM tapes).Q) + (hinitial : start.WithinAuxSpace inputLength initialSpace) + (hreach : (entryLookupTM tapes).reachesIn time start current) + (htime : time ≤ entryLookupTime tapes address store) : + current.WithinAuxSpace inputLength + (initialSpace + entryLookupTime tapes address store) := + entryScanTM_prefix_withinAuxSpace tapes store address.bits inputLength + initialSpace time start current hinitial hreach htime + +end Machine + +end RegisterStore + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryLookup/Defs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryLookup/Defs.lean new file mode 100644 index 0000000000..b64f140d95 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryLookup/Defs.lean @@ -0,0 +1,62 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryScan.Defs + +/-! +# Sparse register lookup — definitions + +The bounded scanner is already the concrete lookup machine. This module names +its semantic endpoint in terms of the pure sparse-store `read` operation. +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace RegisterStore + +namespace Machine + +/-- A completed lookup leaves the pure sparse-store value on the decoded-value +tape and preserves the scanner's complete external frame. -/ +structure EntryLookupResult {n : ℕ} (tapes : EntryScanTapes n) + (store : Store) (address : ℕ) + (initialWork finalWork : Fin n → Tape) : Prop where + value : (finalWork tapes.entry.value).HasBinaryPrefix + (RegisterStore.read store address).bits + valueStart : (finalWork tapes.entry.value).cells 0 = Γ.start + /-- The runtime counter records the unscanned suffix beginning at a hit, or + zero after an unsuccessful scan. -/ + count : ∃ remaining, remaining ≤ store.length ∧ + (finalWork tapes.count).HasBinaryNat remaining + parked : ∀ i, TM.Parked (finalWork i) + frame : EntryScanFrame tapes initialWork finalWork + /-- The complete scanner endpoint is retained so a caller can restore every + owned cursor and scratch tape without re-proving the scan decomposition. -/ + outcome : EntryScanOutcome tapes store address.bits initialWork finalWork + +/-- The concrete sparse lookup is the fixed runtime-count entry scanner. -/ +abbrev entryLookupTM {n : ℕ} (tapes : EntryScanTapes n) : TM n := + entryScanTM tapes + +/-- Lookup inherits the scanner's explicit runtime bound. -/ +abbrev entryLookupTime {n : ℕ} (tapes : EntryScanTapes n) + (address : ℕ) (store : Store) : ℕ := + entryScanTime tapes address.bits store + +end Machine + +end RegisterStore + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryLookup/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryLookup/Internal.lean new file mode 100644 index 0000000000..badc4dbfb9 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryLookup/Internal.lean @@ -0,0 +1,119 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryLookup.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryScan +public import Mathlib.Data.Nat.Bitwise + +/-! +# Sparse register lookup — proof internals +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace RegisterStore + +namespace Machine + +variable {n : ℕ} + +private theorem nat_eq_of_bits_eq {a b : ℕ} (h : a.bits = b.bits) : a = b := by + apply Nat.eq_of_testBit_eq + intro i + rw [Nat.testBit_eq_inth, Nat.testBit_eq_inth, h] + +private theorem read_eq_matched + (scanned : Store) (matched : Entry) (rest : Store) (address : ℕ) + (hmiss : ∀ prior ∈ scanned, prior.1.bits ≠ address.bits) + (hmatch : matched.1.bits = address.bits) : + RegisterStore.read (scanned ++ matched :: rest) address = matched.2 := by + induction scanned with + | nil => + simp [RegisterStore.read, nat_eq_of_bits_eq hmatch] + | cons prior scanned ih => + have hprior : prior.1 ≠ address := by + intro heq + exact hmiss prior (by simp) (congrArg Nat.bits heq) + simp only [List.cons_append, RegisterStore.read] + rw [if_neg (Ne.symm hprior)] + apply ih + intro candidate hcandidate + exact hmiss candidate (by simp [hcandidate]) + +private theorem read_eq_zero + (store : Store) (address : ℕ) + (hmiss : ∀ entry ∈ store, entry.1.bits ≠ address.bits) : + RegisterStore.read store address = 0 := by + induction store with + | nil => rfl + | cons entry rest ih => + have hentry : entry.1 ≠ address := by + intro heq + exact hmiss entry (by simp) (congrArg Nat.bits heq) + simp only [RegisterStore.read] + rw [if_neg (Ne.symm hentry)] + exact ih (fun candidate hcandidate => + hmiss candidate (by simp [hcandidate])) + +private theorem outcome_to_lookup + (tapes : EntryScanTapes n) (store : Store) (address : ℕ) + (initialWork finalWork : Fin n → Tape) + (houtcome : + EntryScanOutcome tapes store address.bits initialWork finalWork) : + EntryLookupResult tapes store address initialWork finalWork := by + have houtcome' := houtcome + rcases houtcome with hfound | hmiss + · rcases hfound with ⟨scanned, matched, rest, _, hfound⟩ + have hread : RegisterStore.read store address = matched.2 := by + rw [hfound.store_eq] + exact read_eq_matched scanned matched rest address hfound.prefixMiss + hfound.hit.addressEq + exact ⟨by simpa [hread] using hfound.hit.value, + hfound.hit.valueStart, ⟨rest.length + 1, by + rw [hfound.store_eq] + simp, hfound.count⟩, hfound.hit.parked, hfound.frame, houtcome'⟩ + · rcases hmiss with ⟨_, hmiss⟩ + have hread : RegisterStore.read store address = 0 := + read_eq_zero store address hmiss.notFound + exact ⟨by simpa [hread] using hmiss.ready.value, + hmiss.ready.valueStart, ⟨0, Nat.zero_le _, hmiss.count⟩, + hmiss.ready.parked, hmiss.frame, houtcome'⟩ + +theorem entryLookupTM_hoareTime_frame_internal + (tapes : EntryScanTapes n) (store : Store) (address : ℕ) + (initialWork : Fin n → Tape) (inp₀ out₀ : Tape) + (hready : EntryScanReady tapes.entry (store.flatMap Entry.encode) + address.bits initialWork initialWork) + (hcount : (initialWork tapes.count).HasBinaryNat store.length) + (hinput : TM.Parked inp₀) (houtput : TM.Parked out₀) : + (entryLookupTM tapes).HoareTime + (fun inp work out => inp = inp₀ ∧ work = initialWork ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + EntryLookupResult tapes store address initialWork work ∧ + out = out₀) + (entryLookupTime tapes address store) := by + exact (entryScanTM_hoareTime_frame tapes store address.bits initialWork + inp₀ out₀ hready hcount hinput houtput).consequence + (fun _ _ _ h => h) + (fun _ _ _ h => ⟨h.1, outcome_to_lookup tapes store address + initialWork _ h.2.1, h.2.2⟩) + le_rfl + +end Machine + +end RegisterStore + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryLookupRestore.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryLookupRestore.lean new file mode 100644 index 0000000000..54f64f960b --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryLookupRestore.lean @@ -0,0 +1,165 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.DenseInternal + +/-! +# Reusable sparse-register operand lookup + +This module exposes one complete sparse-register read as a reusable TM +subroutine. It loads a canonical query, scans the encoded store, copies the +semantic value out, resets every scanner-owned tape, rewinds the read-only +source, restores the runtime entry count, and returns to the same scanner ABI. +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace RegisterStore + +namespace Machine + +/-- One loaded lookup returns the scanner to its blank-query boundary, places +exactly `RegisterStore.read store address` on the destination tape, and +preserves the complete external frame. -/ +theorem entryLookupLoadedTM_hoareTime_frame {n : ℕ} + (tapes : EntryLookupRestoreTapes n) (store : Store) (address : ℕ) + (initialWork : Fin n → Tape) (inp₀ out₀ : Tape) + (hready : EntryLookupRestoreReady tapes store address initialWork) + (hinput : TM.Parked inp₀) (houtput : TM.Parked out₀) : + (entryLookupLoadedTM tapes).HoareTime + (fun inp work out => inp = inp₀ ∧ work = initialWork ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + EntryLookupRestoreResult tapes store address initialWork work ∧ + out = out₀) + (entryLookupLoadedTime tapes store address) := + entryLookupLoaded_hoareTime_internal tapes store address initialWork + inp₀ out₀ hready hinput houtput + +/-- A reusable lookup through a positive-tag mutable overlay returns either +the decoded tag or the corresponding immutable public-input register. -/ +theorem denseOverlayLookupTM_hoareTime_frame {n : ℕ} + (tapes : EntryLookupRestoreTapes n) (input : List Bool) + (overlay : Store) (address : ℕ) (initialWork : Fin n → Tape) + (out₀ : Tape) (hvalid : DenseOverlay.Valid overlay) + (hready : EntryLookupRestoreReady tapes overlay address initialWork) + (houtput : TM.Parked out₀) : + (denseOverlayLookupTM tapes).HoareTime + (fun inp work out => + inp = (Tape.init (input.map Γ.ofBool)).move Dir3.right ∧ + work = initialWork ∧ out = out₀) + (fun inp work out => + inp = (Tape.init (input.map Γ.ofBool)).move Dir3.right ∧ + DenseOverlayLookupResult tapes input overlay address initialWork work ∧ + out = out₀) + (denseOverlayLookupTime tapes input.length overlay address) := + denseOverlayLookupTM_hoareTime_internal tapes input overlay address + initialWork out₀ hvalid hready houtput + +/-- A fixed-address dense-overlay lookup synthesizes and clears its query, +while returning the decoded register value at the reusable scanner boundary. -/ +theorem denseOverlayLookupStaticTM_hoareTime_frame {n : ℕ} + (tapes : EntryLookupRestoreTapes n) (input : List Bool) + (overlay : Store) (address : ℕ) (initialWork : Fin n → Tape) + (out₀ : Tape) (hvalid : DenseOverlay.Valid overlay) + (hready : EntryLookupStaticReady tapes overlay initialWork) + (houtput : TM.Parked out₀) : + (denseOverlayLookupStaticTM tapes address).HoareTime + (fun inp work out => + inp = (Tape.init (input.map Γ.ofBool)).move Dir3.right ∧ + work = initialWork ∧ out = out₀) + (fun inp work out => + inp = (Tape.init (input.map Γ.ofBool)).move Dir3.right ∧ + DenseOverlayLookupStaticResult tapes input overlay address initialWork + work ∧ out = out₀) + (denseOverlayLookupStaticTime tapes input.length overlay address) := + denseOverlayLookupStaticTM_hoareTime_internal tapes input overlay address + initialWork out₀ hvalid hready houtput + +/-- Reusable sparse-register lookup never moves the output head left. -/ +theorem entryLookupLoadedTM_isTransducer {n : ℕ} + (tapes : EntryLookupRestoreTapes n) : + (entryLookupLoadedTM tapes).IsTransducer := by + exact + (TM.binaryCopyIntoTM_isTransducer tapes.querySource + tapes.scan.entry.query tapes.copyScratch).seqTM + ((entryLookupTM_isTransducer tapes.scan).seqTM + ((TM.rewindWorkTM_isTransducer tapes.scan.entry.value).seqTM + ((TM.binaryCopyIntoTM_isTransducer tapes.scan.entry.value + tapes.destination tapes.copyScratch).seqTM + ((TM.resetBinaryWorkManyTM_isTransducer + (entryLookupResetTargets tapes)).seqTM + ((TM.rewindWorkTM_isTransducer tapes.scan.entry.source).seqTM + (TM.binaryCopyIntoTM_isTransducer tapes.countSource + tapes.scan.count tapes.copyScratch)))))) + +/-- Every prefix of a loaded lookup stays within its initial auxiliary space +plus the advertised total running-time bound. -/ +theorem entryLookupLoadedTM_prefix_withinAuxSpace {n : ℕ} + (tapes : EntryLookupRestoreTapes n) (store : Store) (address : ℕ) + (inputLength initialSpace time : ℕ) + (start current : Complexity.Cfg n (entryLookupLoadedTM tapes).Q) + (hinitial : start.WithinAuxSpace inputLength initialSpace) + (hreach : (entryLookupLoadedTM tapes).reachesIn time start current) + (htime : time ≤ entryLookupLoadedTime tapes store address) : + current.WithinAuxSpace inputLength + (initialSpace + entryLookupLoadedTime tapes store address) := + (hinitial.reachesIn hreach).mono le_rfl (by omega) + +/-- A fixed-address lookup synthesizes its query from zero, returns the +scanner to its reusable boundary, places the semantic register value in the +destination, and clears the temporary query source. -/ +theorem entryLookupStaticTM_hoareTime_frame {n : ℕ} + (tapes : EntryLookupRestoreTapes n) (store : Store) (address : ℕ) + (initialWork : Fin n → Tape) (inp₀ out₀ : Tape) + (hready : EntryLookupStaticReady tapes store initialWork) + (hinput : TM.Parked inp₀) (houtput : TM.Parked out₀) : + (entryLookupStaticTM tapes address).HoareTime + (fun inp work out => inp = inp₀ ∧ work = initialWork ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + EntryLookupStaticResult tapes store address initialWork work ∧ + out = out₀) + (entryLookupStaticTime tapes store address) := + entryLookupStatic_hoareTime_internal tapes store address initialWork + inp₀ out₀ hready hinput houtput + +/-- Fixed-address lookup never moves the output head left. -/ +theorem entryLookupStaticTM_isTransducer {n : ℕ} + (tapes : EntryLookupRestoreTapes n) (address : ℕ) : + (entryLookupStaticTM tapes address).IsTransducer := by + exact + (TM.binaryAddConstTM_isTransducer tapes.querySource address).seqTM + ((entryLookupLoadedTM_isTransducer tapes).seqTM + (TM.resetBinaryWorkTM_isTransducer tapes.querySource)) + +/-- Every fixed-address lookup prefix stays within its initial auxiliary space +plus the advertised total running-time bound. -/ +theorem entryLookupStaticTM_prefix_withinAuxSpace {n : ℕ} + (tapes : EntryLookupRestoreTapes n) (store : Store) (address : ℕ) + (inputLength initialSpace time : ℕ) + (start current : Complexity.Cfg n (entryLookupStaticTM tapes address).Q) + (hinitial : start.WithinAuxSpace inputLength initialSpace) + (hreach : (entryLookupStaticTM tapes address).reachesIn time start current) + (htime : time ≤ entryLookupStaticTime tapes store address) : + current.WithinAuxSpace inputLength + (initialSpace + entryLookupStaticTime tapes store address) := + (hinitial.reachesIn hreach).mono le_rfl (by omega) + +end Machine + +end RegisterStore + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryMatch.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryMatch.lean new file mode 100644 index 0000000000..b94ad6a98b --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryMatch.lean @@ -0,0 +1,207 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryMatch.Defs +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryMatch.Internal + +/-! +# RAM sparse-entry matching + +This module exposes the exact framed semantics of the concrete decode-and-match +unit used by a bounded sparse register-store scan. +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace RegisterStore + +namespace Machine + +/-- Decode one canonical sparse entry and compare its address with a preserved +canonical query, leaving the next entry under the source head. -/ +theorem entryMatchTM_reachesIn_frame {n : ℕ} + (tapes : EntryMatchTapes n) (entry : Entry) (rest queryBits : List Bool) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hsource : (work₀ tapes.source).HasBinarySuffix (Entry.encode entry ++ rest)) + (haddress : (work₀ tapes.address).HasBinaryPrefix []) + (hvalue : (work₀ tapes.value).HasBinaryPrefix []) + (haddressStart : (work₀ tapes.address).cells 0 = Γ.start) + (hvalueStart : (work₀ tapes.value).cells 0 = Γ.start) + (haddressCounter : (work₀ tapes.addressCounter).HasBinaryNat 0) + (haddressWidth : (work₀ tapes.addressWidth).HasBinaryNat 0) + (hvalueCounter : (work₀ tapes.valueCounter).HasBinaryNat 0) + (hvalueWidth : (work₀ tapes.valueWidth).HasBinaryNat 0) + (hquery : (work₀ tapes.query).HasBinaryString queryBits) + (hqueryStart : (work₀ tapes.query).cells 0 = Γ.start) + (hresult : (work₀ tapes.result).HasBinaryPrefix []) + (hresultStart : (work₀ tapes.result).cells 0 = Γ.start) + (hinput : TM.Parked inp₀) (hwork : ∀ i, TM.Parked (work₀ i)) + (houtput : TM.Parked out₀) : + ∃ c' t, + t ≤ entryMatchTime entry queryBits ∧ + (entryMatchTM tapes).reachesIn t + { state := (entryMatchTM tapes).qstart + input := inp₀ + work := work₀ + output := out₀ } c' ∧ + (entryMatchTM tapes).halted c' ∧ + c'.input = inp₀ ∧ + (c'.work tapes.source).HasBinarySuffix rest ∧ + (c'.work tapes.address).HasBinaryContent entry.1.bits ∧ + 1 ≤ (c'.work tapes.address).head ∧ + (c'.work tapes.address).cells 0 = Γ.start ∧ + (c'.work tapes.value).HasBinaryPrefix entry.2.bits ∧ + (c'.work tapes.value).cells 0 = Γ.start ∧ + (c'.work tapes.addressCounter).HasBinaryPrefix + (List.replicate (bitlen entry.1) true) ∧ + (c'.work tapes.addressCounter).cells 0 = Γ.start ∧ + (c'.work tapes.addressWidth).HasBinaryNat 0 ∧ + (c'.work tapes.valueCounter).HasBinaryPrefix + (List.replicate (bitlen entry.2) true) ∧ + (c'.work tapes.valueCounter).cells 0 = Γ.start ∧ + (c'.work tapes.valueWidth).HasBinaryNat 0 ∧ + (c'.work tapes.query).HasBinaryContent queryBits ∧ + 1 ≤ (c'.work tapes.query).head ∧ + (c'.work tapes.query).cells 0 = Γ.start ∧ + (c'.work tapes.result).HasBinaryPrefix + [decide (entry.1.bits = queryBits)] ∧ + (c'.work tapes.result).cells 0 = Γ.start ∧ + (∀ i, TM.Parked (c'.work i)) ∧ + (∀ i, i ≠ tapes.source → i ≠ tapes.address → i ≠ tapes.value → + i ≠ tapes.addressCounter → i ≠ tapes.addressWidth → + i ≠ tapes.valueCounter → i ≠ tapes.valueWidth → + i ≠ tapes.query → i ≠ tapes.result → c'.work i = work₀ i) ∧ + c'.output = out₀ := + entryMatchTM_reachesIn_frame_internal tapes entry rest queryBits inp₀ + work₀ out₀ hsource haddress hvalue haddressStart hvalueStart + haddressCounter haddressWidth hvalueCounter hvalueWidth hquery + hqueryStart hresult hresultStart hinput hwork houtput + +/-- Decode and compare one canonical sparse entry, then rewind the one-bit +result to cell one so that the enclosing bounded scan can branch on it. -/ +theorem entryMatchReadTM_reachesIn_frame {n : ℕ} + (tapes : EntryMatchTapes n) (entry : Entry) (rest queryBits : List Bool) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hsource : (work₀ tapes.source).HasBinarySuffix (Entry.encode entry ++ rest)) + (haddress : (work₀ tapes.address).HasBinaryPrefix []) + (hvalue : (work₀ tapes.value).HasBinaryPrefix []) + (haddressStart : (work₀ tapes.address).cells 0 = Γ.start) + (hvalueStart : (work₀ tapes.value).cells 0 = Γ.start) + (haddressCounter : (work₀ tapes.addressCounter).HasBinaryNat 0) + (haddressWidth : (work₀ tapes.addressWidth).HasBinaryNat 0) + (hvalueCounter : (work₀ tapes.valueCounter).HasBinaryNat 0) + (hvalueWidth : (work₀ tapes.valueWidth).HasBinaryNat 0) + (hquery : (work₀ tapes.query).HasBinaryString queryBits) + (hqueryStart : (work₀ tapes.query).cells 0 = Γ.start) + (hresult : (work₀ tapes.result).HasBinaryPrefix []) + (hresultStart : (work₀ tapes.result).cells 0 = Γ.start) + (hinput : TM.Parked inp₀) (hwork : ∀ i, TM.Parked (work₀ i)) + (houtput : TM.Parked out₀) : + ∃ c' t, + t ≤ entryMatchReadTime entry queryBits ∧ + (entryMatchReadTM tapes).reachesIn t + { state := (entryMatchReadTM tapes).qstart + input := inp₀ + work := work₀ + output := out₀ } c' ∧ + (entryMatchReadTM tapes).halted c' ∧ + c'.input = inp₀ ∧ + ReadableEntryMatch tapes entry rest queryBits work₀ c'.work ∧ + c'.output = out₀ := + entryMatchReadTM_reachesIn_frame_internal tapes entry rest queryBits inp₀ + work₀ out₀ hsource haddress hvalue haddressStart hvalueStart + haddressCounter haddressWidth hvalueCounter hvalueWidth hquery + hqueryStart hresult hresultStart hinput hwork houtput + +/-- A readable entry-match endpoint exposes its Boolean answer directly under +the result-tape head. -/ +theorem ReadableEntryMatch.result_read {n : ℕ} {tapes : EntryMatchTapes n} + {entry : Entry} {rest queryBits : List Bool} + {initialWork finalWork : Fin n → Tape} + (h : ReadableEntryMatch tapes entry rest queryBits initialWork finalWork) : + (finalWork tapes.result).read = + Γ.ofBool (decide (entry.1.bits = queryBits)) := + h.result.hasBinarySuffix.read_cons + +/-- The result head reads one exactly when the decoded address equals the +query. -/ +theorem ReadableEntryMatch.result_read_eq_one_iff {n : ℕ} + {tapes : EntryMatchTapes n} {entry : Entry} {rest queryBits : List Bool} + {initialWork finalWork : Fin n → Tape} + (h : ReadableEntryMatch tapes entry rest queryBits initialWork finalWork) : + (finalWork tapes.result).read = Γ.one ↔ entry.1.bits = queryBits := by + by_cases heq : entry.1.bits = queryBits <;> + simp [h.result_read, heq, Γ.ofBool] + +/-- Exact closed form for the readable unary-marker entry-match runtime. -/ +theorem entryMatchReadTime_eq (entry : Entry) (queryBits : List Bool) : + entryMatchReadTime entry queryBits = + 4 * entry.1.bits.length + 3 * entry.2.bits.length + + max entry.1.bits.length queryBits.length + 18 := + entryMatchReadTime_eq_internal entry queryBits + +/-- One readable entry match is linear in the serialized entry and query +widths. -/ +theorem entryMatchReadTime_le_linear (entry : Entry) + (queryBits : List Bool) : + entryMatchReadTime entry queryBits ≤ + 5 * entry.1.bits.length + 3 * entry.2.bits.length + + queryBits.length + 18 := + entryMatchReadTime_le_linear_internal entry queryBits + +/-- Coarse all-prefix auxiliary-space envelope for one entry match. -/ +theorem entryMatchTM_prefix_withinAuxSpace {n : ℕ} + (tapes : EntryMatchTapes n) (entry : Entry) (queryBits : List Bool) + (inputLength initialSpace time : ℕ) + (start current : Complexity.Cfg n (entryMatchTM tapes).Q) + (hinitial : start.WithinAuxSpace inputLength initialSpace) + (hreach : (entryMatchTM tapes).reachesIn time start current) + (htime : time ≤ entryMatchTime entry queryBits) : + current.WithinAuxSpace inputLength + (initialSpace + entryMatchTime entry queryBits) := + (hinitial.reachesIn hreach).mono le_rfl (by omega) + +/-- Entry matching preserves one-way output safety. -/ +theorem entryMatchTM_isTransducer {n : ℕ} (tapes : EntryMatchTapes n) : + (entryMatchTM tapes).IsTransducer := by + unfold entryMatchTM + exact (entryDecodeLinearTM_isTransducer tapes.decode).seqTM + (decodedAddressEqTM_isTransducer tapes.address tapes.query tapes.result) + +/-- Readable entry matching preserves one-way output safety. -/ +theorem entryMatchReadTM_isTransducer {n : ℕ} (tapes : EntryMatchTapes n) : + (entryMatchReadTM tapes).IsTransducer := by + unfold entryMatchReadTM + exact (entryMatchTM_isTransducer tapes).seqTM + (TM.rewindWorkTM_isTransducer tapes.result) + +/-- Coarse all-prefix auxiliary-space envelope for readable entry matching. -/ +theorem entryMatchReadTM_prefix_withinAuxSpace {n : ℕ} + (tapes : EntryMatchTapes n) (entry : Entry) (queryBits : List Bool) + (inputLength initialSpace time : ℕ) + (start current : Complexity.Cfg n (entryMatchReadTM tapes).Q) + (hinitial : start.WithinAuxSpace inputLength initialSpace) + (hreach : (entryMatchReadTM tapes).reachesIn time start current) + (htime : time ≤ entryMatchReadTime entry queryBits) : + current.WithinAuxSpace inputLength + (initialSpace + entryMatchReadTime entry queryBits) := + (hinitial.reachesIn hreach).mono le_rfl (by omega) + +end Machine + +end RegisterStore + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryMatch/Defs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryMatch/Defs.lean new file mode 100644 index 0000000000..759d3979aa --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryMatch/Defs.lean @@ -0,0 +1,166 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.AddressEq.Defs +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryDecode.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Registers +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Defs + +/-! +# RAM sparse-entry matching — definitions + +`entryMatchTM` is the concrete unit consumed by a bounded sparse-store scan. +It decodes one address/value entry and compares the decoded address with a +preserved canonical query. The result is appended to a dedicated work tape. +-/ + + +@[expose] public section + +namespace Complexity + +namespace RAM + +namespace RegisterStore + +namespace Machine + +/-- Nine pairwise-distinct work tapes used to decode and match one sparse +register-store entry. -/ +structure EntryMatchTapes (n : ℕ) where + /-- Tape assignment in the order source, address, value, address counter, + address width, value counter, value width, query, and result. -/ + idx : Fin 9 → Fin n + injective : Function.Injective idx + +namespace EntryMatchTapes + +/-- The seven decoder tapes contained in an entry-matching assignment. -/ +def decode {n : ℕ} (tapes : EntryMatchTapes n) : EntryDecodeTapes n where + idx := fun i => tapes.idx ⟨i, by omega⟩ + injective := by + intro i j h + have h' : (⟨i, by omega⟩ : Fin 9) = ⟨j, by omega⟩ := + tapes.injective h + apply Fin.ext + exact congrArg (fun k : Fin 9 => k.val) h' + +/-- Encoded entry-stream source tape. -/ +def source {n : ℕ} (tapes : EntryMatchTapes n) : Fin n := tapes.idx 0 +/-- Decoded address scratch tape. -/ +def address {n : ℕ} (tapes : EntryMatchTapes n) : Fin n := tapes.idx 1 +/-- Decoded value scratch tape. -/ +def value {n : ℕ} (tapes : EntryMatchTapes n) : Fin n := tapes.idx 2 +/-- Binary loop counter used while decoding the address. -/ +def addressCounter {n : ℕ} (tapes : EntryMatchTapes n) : Fin n := tapes.idx 3 +/-- Preserved address payload-width tape. -/ +def addressWidth {n : ℕ} (tapes : EntryMatchTapes n) : Fin n := tapes.idx 4 +/-- Binary loop counter used while decoding the value. -/ +def valueCounter {n : ℕ} (tapes : EntryMatchTapes n) : Fin n := tapes.idx 5 +/-- Preserved value payload-width tape. -/ +def valueWidth {n : ℕ} (tapes : EntryMatchTapes n) : Fin n := tapes.idx 6 +/-- Canonical query-address tape. -/ +def query {n : ℕ} (tapes : EntryMatchTapes n) : Fin n := tapes.idx 7 +/-- Boolean match-result tape. -/ +def result {n : ℕ} (tapes : EntryMatchTapes n) : Fin n := tapes.idx 8 + +theorem ne {n : ℕ} (tapes : EntryMatchTapes n) {i j : Fin 9} (h : i ≠ j) : + tapes.idx i ≠ tapes.idx j := + fun hij => h (tapes.injective hij) + +theorem binaryEqDistinct {n : ℕ} (tapes : EntryMatchTapes n) : + TM.BinaryEqDistinct tapes.address tapes.query tapes.result := by + exact ⟨tapes.ne (by decide), tapes.ne (by decide), tapes.ne (by decide)⟩ + +@[simp] theorem decode_source {n : ℕ} (tapes : EntryMatchTapes n) : + tapes.decode.source = tapes.source := rfl + +@[simp] theorem decode_address {n : ℕ} (tapes : EntryMatchTapes n) : + tapes.decode.address = tapes.address := rfl + +@[simp] theorem decode_value {n : ℕ} (tapes : EntryMatchTapes n) : + tapes.decode.value = tapes.value := rfl + +@[simp] theorem decode_addressCounter {n : ℕ} (tapes : EntryMatchTapes n) : + tapes.decode.addressCounter = tapes.addressCounter := rfl + +@[simp] theorem decode_addressWidth {n : ℕ} (tapes : EntryMatchTapes n) : + tapes.decode.addressWidth = tapes.addressWidth := rfl + +@[simp] theorem decode_valueCounter {n : ℕ} (tapes : EntryMatchTapes n) : + tapes.decode.valueCounter = tapes.valueCounter := rfl + +@[simp] theorem decode_valueWidth {n : ℕ} (tapes : EntryMatchTapes n) : + tapes.decode.valueWidth = tapes.valueWidth := rfl + +end EntryMatchTapes + +/-- Decode one sparse entry with unary markers and compare its address with the +preserved query. -/ +def entryMatchTM {n : ℕ} (tapes : EntryMatchTapes n) : TM n := + TM.seqTM (entryDecodeLinearTM tapes.decode) + (decodedAddressEqTM tapes.address tapes.query tapes.result) + +/-- Runtime bound for decoding and matching one sparse entry, including the +composition seam. -/ +def entryMatchTime (entry : Entry) (queryBits : List Bool) : ℕ := + entryDecodeLinearTime entry.1 entry.2 + 1 + + decodedAddressEqTime entry.1.bits queryBits + +/-- Decode and compare one sparse entry, then rewind the one-bit result to its +canonical cell-one read position. -/ +def entryMatchReadTM {n : ℕ} (tapes : EntryMatchTapes n) : TM n := + TM.seqTM (entryMatchTM tapes) (TM.rewindWorkTM tapes.result) + +/-- Runtime bound for a readable one-entry match, including both composition +seams and the at-most-four-step rewind of the one-bit result. -/ +def entryMatchReadTime (entry : Entry) (queryBits : List Bool) : ℕ := + entryMatchTime entry queryBits + 1 + 4 + +/-- Auditable endpoint contract for one readable sparse-entry match. The +decoded scratch remains available to a hit branch or can be cleared by a miss +branch; the result is parked at cell one for direct controller inspection. -/ +structure ReadableEntryMatch {n : ℕ} (tapes : EntryMatchTapes n) + (entry : Entry) (rest queryBits : List Bool) + (initialWork finalWork : Fin n → Tape) : Prop where + source : (finalWork tapes.source).HasBinarySuffix rest + address : (finalWork tapes.address).HasBinaryContent entry.1.bits + addressStart : (finalWork tapes.address).cells 0 = Γ.start + value : (finalWork tapes.value).HasBinaryPrefix entry.2.bits + valueStart : (finalWork tapes.value).cells 0 = Γ.start + addressCounter : (finalWork tapes.addressCounter).HasBinaryPrefix + (List.replicate (bitlen entry.1) true) + addressCounterStart : + (finalWork tapes.addressCounter).cells 0 = Γ.start + addressWidth : (finalWork tapes.addressWidth).HasBinaryNat 0 + valueCounter : (finalWork tapes.valueCounter).HasBinaryPrefix + (List.replicate (bitlen entry.2) true) + valueCounterStart : (finalWork tapes.valueCounter).cells 0 = Γ.start + valueWidth : (finalWork tapes.valueWidth).HasBinaryNat 0 + query : (finalWork tapes.query).HasBinaryContent queryBits + queryStart : (finalWork tapes.query).cells 0 = Γ.start + result : (finalWork tapes.result).HasBinaryString + [decide (entry.1.bits = queryBits)] + resultStart : (finalWork tapes.result).cells 0 = Γ.start + parked : ∀ i, TM.Parked (finalWork i) + headBound : ∀ i, (finalWork i).head ≤ + (initialWork i).head + entryMatchReadTime entry queryBits + frame : ∀ i, i ≠ tapes.source → i ≠ tapes.address → + i ≠ tapes.value → i ≠ tapes.addressCounter → + i ≠ tapes.addressWidth → i ≠ tapes.valueCounter → + i ≠ tapes.valueWidth → i ≠ tapes.query → i ≠ tapes.result → + finalWork i = initialWork i + +end Machine + +end RegisterStore + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryMatch/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryMatch/Internal.lean new file mode 100644 index 0000000000..c560b54771 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryMatch/Internal.lean @@ -0,0 +1,556 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.AddressEq +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryDecode +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryMatch.Defs + +/-! +# RAM sparse-entry matching — proof internals +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace RegisterStore + +namespace Machine + +private theorem parked_of_hasBinaryPrefix {t : Tape} {bits : List Bool} + (h : t.HasBinaryPrefix bits) : TM.Parked t := + ⟨by rw [h.1]; omega, + Tape.HasBinaryContent.cells_ne_start + (show t.HasBinaryContent bits from h.2)⟩ + +private theorem parked_of_hasBinarySuffix {t : Tape} {bits : List Bool} + (h : t.HasBinarySuffix bits) : TM.Parked t := + ⟨h.1, h.2.2.2⟩ + +private theorem parked_of_hasBinaryNat {t : Tape} {value : ℕ} + (h : t.HasBinaryNat value) : TM.Parked t := + ⟨by rw [h.2.1], h.2.hasBinaryContent.cells_ne_start⟩ + +theorem entryMatchTM_reachesIn_frame_internal {n : ℕ} + (tapes : EntryMatchTapes n) (entry : Entry) (rest queryBits : List Bool) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hsource : (work₀ tapes.source).HasBinarySuffix (Entry.encode entry ++ rest)) + (haddress : (work₀ tapes.address).HasBinaryPrefix []) + (hvalue : (work₀ tapes.value).HasBinaryPrefix []) + (haddressStart : (work₀ tapes.address).cells 0 = Γ.start) + (hvalueStart : (work₀ tapes.value).cells 0 = Γ.start) + (haddressCounter : (work₀ tapes.addressCounter).HasBinaryNat 0) + (haddressWidth : (work₀ tapes.addressWidth).HasBinaryNat 0) + (hvalueCounter : (work₀ tapes.valueCounter).HasBinaryNat 0) + (hvalueWidth : (work₀ tapes.valueWidth).HasBinaryNat 0) + (hquery : (work₀ tapes.query).HasBinaryString queryBits) + (hqueryStart : (work₀ tapes.query).cells 0 = Γ.start) + (hresult : (work₀ tapes.result).HasBinaryPrefix []) + (hresultStart : (work₀ tapes.result).cells 0 = Γ.start) + (hinput : TM.Parked inp₀) (hwork : ∀ i, TM.Parked (work₀ i)) + (houtput : TM.Parked out₀) : + ∃ c' t, + t ≤ entryMatchTime entry queryBits ∧ + (entryMatchTM tapes).reachesIn t + { state := (entryMatchTM tapes).qstart + input := inp₀ + work := work₀ + output := out₀ } c' ∧ + (entryMatchTM tapes).halted c' ∧ + c'.input = inp₀ ∧ + (c'.work tapes.source).HasBinarySuffix rest ∧ + (c'.work tapes.address).HasBinaryContent entry.1.bits ∧ + 1 ≤ (c'.work tapes.address).head ∧ + (c'.work tapes.address).cells 0 = Γ.start ∧ + (c'.work tapes.value).HasBinaryPrefix entry.2.bits ∧ + (c'.work tapes.value).cells 0 = Γ.start ∧ + (c'.work tapes.addressCounter).HasBinaryPrefix + (List.replicate (bitlen entry.1) true) ∧ + (c'.work tapes.addressCounter).cells 0 = Γ.start ∧ + (c'.work tapes.addressWidth).HasBinaryNat 0 ∧ + (c'.work tapes.valueCounter).HasBinaryPrefix + (List.replicate (bitlen entry.2) true) ∧ + (c'.work tapes.valueCounter).cells 0 = Γ.start ∧ + (c'.work tapes.valueWidth).HasBinaryNat 0 ∧ + (c'.work tapes.query).HasBinaryContent queryBits ∧ + 1 ≤ (c'.work tapes.query).head ∧ + (c'.work tapes.query).cells 0 = Γ.start ∧ + (c'.work tapes.result).HasBinaryPrefix + [decide (entry.1.bits = queryBits)] ∧ + (c'.work tapes.result).cells 0 = Γ.start ∧ + (∀ i, TM.Parked (c'.work i)) ∧ + (∀ i, i ≠ tapes.source → i ≠ tapes.address → i ≠ tapes.value → + i ≠ tapes.addressCounter → i ≠ tapes.addressWidth → + i ≠ tapes.valueCounter → i ≠ tapes.valueWidth → + i ≠ tapes.query → i ≠ tapes.result → c'.work i = work₀ i) ∧ + c'.output = out₀ := by + let decodeTM := entryDecodeLinearTM tapes.decode + let compareTM := decodedAddressEqTM tapes.address tapes.query tapes.result + obtain ⟨decodeDone, hdecodeReach, hdecodeHalt, hdecodeInput, + hdecodeSource, hdecodeAddress, hdecodeAddressStart, hdecodeValue, + hdecodeValueStart, hdecodeAddressCounter, hdecodeValueCounter, + hdecodeFrame, hdecodeOutput⟩ := + entryDecodeLinearTM_reachesIn_frame tapes.decode entry rest inp₀ work₀ out₀ + (by simpa using hsource) (by simpa using haddress) + (by simpa using hvalue) (by simpa using haddressStart) + (by simpa using hvalueStart) + (by + simpa [Tape.HasBinaryPrefix, Tape.HasBinaryString] using + haddressCounter.2) + haddressCounter.1 + (by + simpa [Tape.HasBinaryPrefix, Tape.HasBinaryString] using + hvalueCounter.2) + hvalueCounter.1 hinput.read_ne_start + (fun i => (hwork i).read_ne_start) houtput.read_ne_start + have hdecodeAddressWidth : + (decodeDone.work tapes.addressWidth).HasBinaryNat 0 := by + rw [hdecodeFrame tapes.addressWidth + (by simpa using tapes.ne (show (4 : Fin 9) ≠ 0 by decide)) + (by simpa using tapes.ne (show (4 : Fin 9) ≠ 1 by decide)) + (by simpa using tapes.ne (show (4 : Fin 9) ≠ 2 by decide)) + (by simpa using tapes.ne (show (4 : Fin 9) ≠ 3 by decide)) + (by simpa using tapes.ne (show (4 : Fin 9) ≠ 5 by decide))] + exact haddressWidth + have hdecodeValueWidth : + (decodeDone.work tapes.valueWidth).HasBinaryNat 0 := by + rw [hdecodeFrame tapes.valueWidth + (by simpa using tapes.ne (show (6 : Fin 9) ≠ 0 by decide)) + (by simpa using tapes.ne (show (6 : Fin 9) ≠ 1 by decide)) + (by simpa using tapes.ne (show (6 : Fin 9) ≠ 2 by decide)) + (by simpa using tapes.ne (show (6 : Fin 9) ≠ 3 by decide)) + (by simpa using tapes.ne (show (6 : Fin 9) ≠ 5 by decide))] + exact hvalueWidth + have hdecodeQuery : + (decodeDone.work tapes.query).HasBinaryString queryBits := by + rw [hdecodeFrame tapes.query + (by simpa using tapes.ne (show (7 : Fin 9) ≠ 0 by decide)) + (by simpa using tapes.ne (show (7 : Fin 9) ≠ 1 by decide)) + (by simpa using tapes.ne (show (7 : Fin 9) ≠ 2 by decide)) + (by simpa using tapes.ne (show (7 : Fin 9) ≠ 3 by decide)) + (by simpa using tapes.ne (show (7 : Fin 9) ≠ 5 by decide))] + exact hquery + have hdecodeResult : + (decodeDone.work tapes.result).HasBinaryPrefix [] := by + rw [hdecodeFrame tapes.result + (by simpa using tapes.ne (show (8 : Fin 9) ≠ 0 by decide)) + (by simpa using tapes.ne (show (8 : Fin 9) ≠ 1 by decide)) + (by simpa using tapes.ne (show (8 : Fin 9) ≠ 2 by decide)) + (by simpa using tapes.ne (show (8 : Fin 9) ≠ 3 by decide)) + (by simpa using tapes.ne (show (8 : Fin 9) ≠ 5 by decide))] + exact hresult + have hdecodeParked : ∀ i, TM.Parked (decodeDone.work i) := by + intro i + by_cases his : i = tapes.source + · subst i + exact parked_of_hasBinarySuffix (by simpa using hdecodeSource) + · by_cases hia : i = tapes.address + · subst i + exact parked_of_hasBinaryPrefix (by simpa using hdecodeAddress) + · by_cases hiv : i = tapes.value + · subst i + exact parked_of_hasBinaryPrefix (by simpa using hdecodeValue) + · by_cases hiac : i = tapes.addressCounter + · subst i + exact parked_of_hasBinaryPrefix + (by simpa using hdecodeAddressCounter) + · by_cases hiaw : i = tapes.addressWidth + · subst i + exact parked_of_hasBinaryNat + (by simpa using hdecodeAddressWidth) + · by_cases hivc : i = tapes.valueCounter + · subst i + exact parked_of_hasBinaryPrefix + (by simpa using hdecodeValueCounter) + · by_cases hivw : i = tapes.valueWidth + · subst i + exact parked_of_hasBinaryNat + (by simpa using hdecodeValueWidth) + · by_cases hiq : i = tapes.query + · subst i + exact ⟨by rw [hdecodeQuery.1], + hdecodeQuery.hasBinaryContent.cells_ne_start⟩ + · by_cases hir : i = tapes.result + · subst i + exact parked_of_hasBinaryPrefix hdecodeResult + · rw [hdecodeFrame i (by simpa using his) + (by simpa using hia) (by simpa using hiv) + (by simpa using hiac) (by simpa using hivc)] + exact hwork i + have hdecodeQueryStart : + (decodeDone.work tapes.query).cells 0 = Γ.start := + TM.work_cells_zero_eq_start_of_reachesIn tapes.query hdecodeReach + hqueryStart + obtain ⟨compareDone, compareTime, hcompareTime, hcompareReach, + hcompareHalt, hcompareInput, hcompareResult, hcompareAddress, + hcompareAddressHead, hcompareAddressStart, hcompareQuery, + hcompareQueryHead, hcompareQueryStart, hcompareFrame, hcompareOutput⟩ := + decodedAddressEqTM_reachesIn_frame tapes.address tapes.query tapes.result + tapes.binaryEqDistinct entry.1.bits queryBits decodeDone.input + decodeDone.work decodeDone.output (by simpa using hdecodeAddress) + (by simpa using hdecodeAddressStart) hdecodeQuery hdecodeQueryStart + hdecodeResult (by rw [hdecodeInput]; exact hinput.read_ne_start) + (fun i _ _ _ => ⟨(hdecodeParked i).read_ne_start, + (hdecodeParked i).1⟩) + (by rw [hdecodeOutput]; exact houtput.read_ne_start) + (by rw [hdecodeOutput]; exact houtput.1) + have htransitionInput : TM.transitionInput decodeDone.input = + decodeDone.input := + TM.transitionInput_eq_self (by rw [hdecodeInput]; exact hinput.read_ne_start) + have htransitionWork : + (fun i => TM.transitionTape (decodeDone.work i)) = decodeDone.work := by + funext i + exact TM.transitionTape_eq_self (hdecodeParked i).read_ne_start + have htransitionOutput : TM.transitionTape decodeDone.output = + decodeDone.output := + TM.transitionTape_eq_self + (by rw [hdecodeOutput]; exact houtput.read_ne_start) + have hcompareReach' : compareTM.reachesIn compareTime + { state := compareTM.qstart + input := TM.transitionInput decodeDone.input + work := fun i => TM.transitionTape (decodeDone.work i) + output := TM.transitionTape decodeDone.output } compareDone := by + rw [htransitionInput, htransitionWork, htransitionOutput] + simpa [compareTM] using hcompareReach + have hfullReach := TM.seqTM_reachesIn_of_reachesIn decodeTM compareTM + (by simpa [decodeTM] using hdecodeReach) hdecodeHalt hcompareReach' + let finalCfg := TM.phase2Wrap decodeTM compareTM compareDone + have hresultStartFinal : (finalCfg.work tapes.result).cells 0 = Γ.start := + TM.work_cells_zero_eq_start_of_reachesIn + (tm := TM.seqTM decodeTM compareTM) tapes.result hfullReach hresultStart + have haddressCounterStartFinal : + (finalCfg.work tapes.addressCounter).cells 0 = Γ.start := + TM.work_cells_zero_eq_start_of_reachesIn + (tm := TM.seqTM decodeTM compareTM) tapes.addressCounter hfullReach + haddressCounter.1 + have hvalueCounterStartFinal : + (finalCfg.work tapes.valueCounter).cells 0 = Γ.start := + TM.work_cells_zero_eq_start_of_reachesIn + (tm := TM.seqTM decodeTM compareTM) tapes.valueCounter hfullReach + hvalueCounter.1 + have hfinalParked : ∀ i, TM.Parked (finalCfg.work i) := by + intro i + change TM.Parked (compareDone.work i) + by_cases his : i = tapes.source + · subst i + apply parked_of_hasBinarySuffix + rw [hcompareFrame tapes.source + (by simpa using tapes.ne (show (0 : Fin 9) ≠ 1 by decide)) + (by simpa using tapes.ne (show (0 : Fin 9) ≠ 7 by decide)) + (by simpa using tapes.ne (show (0 : Fin 9) ≠ 8 by decide))] + simpa using hdecodeSource + · by_cases hia : i = tapes.address + · subst i + exact ⟨hcompareAddressHead, + hcompareAddress.cells_ne_start⟩ + · by_cases hiv : i = tapes.value + · subst i + apply parked_of_hasBinaryPrefix + rw [hcompareFrame tapes.value + (by simpa using tapes.ne (show (2 : Fin 9) ≠ 1 by decide)) + (by simpa using tapes.ne (show (2 : Fin 9) ≠ 7 by decide)) + (by simpa using tapes.ne (show (2 : Fin 9) ≠ 8 by decide))] + simpa using hdecodeValue + · by_cases hiac : i = tapes.addressCounter + · subst i + apply parked_of_hasBinaryPrefix + rw [hcompareFrame tapes.addressCounter + (by simpa using tapes.ne (show (3 : Fin 9) ≠ 1 by decide)) + (by simpa using tapes.ne (show (3 : Fin 9) ≠ 7 by decide)) + (by simpa using tapes.ne (show (3 : Fin 9) ≠ 8 by decide))] + simpa using hdecodeAddressCounter + · by_cases hiaw : i = tapes.addressWidth + · subst i + apply parked_of_hasBinaryNat + rw [hcompareFrame tapes.addressWidth + (by simpa using tapes.ne (show (4 : Fin 9) ≠ 1 by decide)) + (by simpa using tapes.ne (show (4 : Fin 9) ≠ 7 by decide)) + (by simpa using tapes.ne (show (4 : Fin 9) ≠ 8 by decide))] + simpa using hdecodeAddressWidth + · by_cases hivc : i = tapes.valueCounter + · subst i + apply parked_of_hasBinaryPrefix + rw [hcompareFrame tapes.valueCounter + (by simpa using tapes.ne (show (5 : Fin 9) ≠ 1 by decide)) + (by simpa using tapes.ne (show (5 : Fin 9) ≠ 7 by decide)) + (by simpa using tapes.ne (show (5 : Fin 9) ≠ 8 by decide))] + simpa using hdecodeValueCounter + · by_cases hivw : i = tapes.valueWidth + · subst i + apply parked_of_hasBinaryNat + rw [hcompareFrame tapes.valueWidth + (by simpa using tapes.ne (show (6 : Fin 9) ≠ 1 by decide)) + (by simpa using tapes.ne (show (6 : Fin 9) ≠ 7 by decide)) + (by simpa using tapes.ne (show (6 : Fin 9) ≠ 8 by decide))] + simpa using hdecodeValueWidth + · by_cases hiq : i = tapes.query + · subst i + exact ⟨hcompareQueryHead, + hcompareQuery.cells_ne_start⟩ + · by_cases hir : i = tapes.result + · subst i + exact parked_of_hasBinaryPrefix hcompareResult + · rw [hcompareFrame i hia hiq hir, + hdecodeFrame i (by simpa using his) + (by simpa using hia) (by simpa using hiv) + (by simpa using hiac) (by simpa using hivc)] + exact hwork i + refine ⟨finalCfg, entryDecodeLinearTime entry.1 entry.2 + 1 + compareTime, + ?_, ?_, ?_, hcompareInput.trans hdecodeInput, ?_, hcompareAddress, + hcompareAddressHead, hcompareAddressStart, ?_, ?_, ?_, + haddressCounterStartFinal, ?_, ?_, hvalueCounterStartFinal, ?_, + hcompareQuery, hcompareQueryHead, hcompareQueryStart, hcompareResult, + hresultStartFinal, hfinalParked, ?_, + hcompareOutput.trans hdecodeOutput⟩ + · simp only [entryMatchTime] + omega + · simpa [entryMatchTM, decodeTM, compareTM, finalCfg] using hfullReach + · exact (TM.phase2Wrap_halted_iff decodeTM compareTM compareDone).2 + hcompareHalt + · change (compareDone.work tapes.source).HasBinarySuffix rest + rw [hcompareFrame tapes.source + (by simpa using tapes.ne (show (0 : Fin 9) ≠ 1 by decide)) + (by simpa using tapes.ne (show (0 : Fin 9) ≠ 7 by decide)) + (by simpa using tapes.ne (show (0 : Fin 9) ≠ 8 by decide))] + simpa using hdecodeSource + · change (compareDone.work tapes.value).HasBinaryPrefix entry.2.bits + rw [hcompareFrame tapes.value + (by simpa using tapes.ne (show (2 : Fin 9) ≠ 1 by decide)) + (by simpa using tapes.ne (show (2 : Fin 9) ≠ 7 by decide)) + (by simpa using tapes.ne (show (2 : Fin 9) ≠ 8 by decide))] + simpa using hdecodeValue + · change (compareDone.work tapes.value).cells 0 = Γ.start + rw [hcompareFrame tapes.value + (by simpa using tapes.ne (show (2 : Fin 9) ≠ 1 by decide)) + (by simpa using tapes.ne (show (2 : Fin 9) ≠ 7 by decide)) + (by simpa using tapes.ne (show (2 : Fin 9) ≠ 8 by decide))] + simpa using hdecodeValueStart + · change (compareDone.work tapes.addressCounter).HasBinaryPrefix + (List.replicate (bitlen entry.1) true) + rw [hcompareFrame tapes.addressCounter + (by simpa using tapes.ne (show (3 : Fin 9) ≠ 1 by decide)) + (by simpa using tapes.ne (show (3 : Fin 9) ≠ 7 by decide)) + (by simpa using tapes.ne (show (3 : Fin 9) ≠ 8 by decide))] + simpa using hdecodeAddressCounter + · change (compareDone.work tapes.addressWidth).HasBinaryNat 0 + rw [hcompareFrame tapes.addressWidth + (by simpa using tapes.ne (show (4 : Fin 9) ≠ 1 by decide)) + (by simpa using tapes.ne (show (4 : Fin 9) ≠ 7 by decide)) + (by simpa using tapes.ne (show (4 : Fin 9) ≠ 8 by decide))] + simpa using hdecodeAddressWidth + · change (compareDone.work tapes.valueCounter).HasBinaryPrefix + (List.replicate (bitlen entry.2) true) + rw [hcompareFrame tapes.valueCounter + (by simpa using tapes.ne (show (5 : Fin 9) ≠ 1 by decide)) + (by simpa using tapes.ne (show (5 : Fin 9) ≠ 7 by decide)) + (by simpa using tapes.ne (show (5 : Fin 9) ≠ 8 by decide))] + simpa using hdecodeValueCounter + · change (compareDone.work tapes.valueWidth).HasBinaryNat 0 + rw [hcompareFrame tapes.valueWidth + (by simpa using tapes.ne (show (6 : Fin 9) ≠ 1 by decide)) + (by simpa using tapes.ne (show (6 : Fin 9) ≠ 7 by decide)) + (by simpa using tapes.ne (show (6 : Fin 9) ≠ 8 by decide))] + simpa using hdecodeValueWidth + · intro i his hia hiv hiac hiaw hivc hivw hiq hir + change compareDone.work i = work₀ i + rw [hcompareFrame i hia hiq hir, + hdecodeFrame i (by simpa using his) (by simpa using hia) + (by simpa using hiv) (by simpa using hiac) (by simpa using hivc)] + +theorem entryMatchReadTM_reachesIn_frame_internal {n : ℕ} + (tapes : EntryMatchTapes n) (entry : Entry) (rest queryBits : List Bool) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hsource : (work₀ tapes.source).HasBinarySuffix (Entry.encode entry ++ rest)) + (haddress : (work₀ tapes.address).HasBinaryPrefix []) + (hvalue : (work₀ tapes.value).HasBinaryPrefix []) + (haddressStart : (work₀ tapes.address).cells 0 = Γ.start) + (hvalueStart : (work₀ tapes.value).cells 0 = Γ.start) + (haddressCounter : (work₀ tapes.addressCounter).HasBinaryNat 0) + (haddressWidth : (work₀ tapes.addressWidth).HasBinaryNat 0) + (hvalueCounter : (work₀ tapes.valueCounter).HasBinaryNat 0) + (hvalueWidth : (work₀ tapes.valueWidth).HasBinaryNat 0) + (hquery : (work₀ tapes.query).HasBinaryString queryBits) + (hqueryStart : (work₀ tapes.query).cells 0 = Γ.start) + (hresult : (work₀ tapes.result).HasBinaryPrefix []) + (hresultStart : (work₀ tapes.result).cells 0 = Γ.start) + (hinput : TM.Parked inp₀) (hwork : ∀ i, TM.Parked (work₀ i)) + (houtput : TM.Parked out₀) : + ∃ c' t, + t ≤ entryMatchReadTime entry queryBits ∧ + (entryMatchReadTM tapes).reachesIn t + { state := (entryMatchReadTM tapes).qstart + input := inp₀ + work := work₀ + output := out₀ } c' ∧ + (entryMatchReadTM tapes).halted c' ∧ + c'.input = inp₀ ∧ + ReadableEntryMatch tapes entry rest queryBits work₀ c'.work ∧ + c'.output = out₀ := by + let matchTM := entryMatchTM tapes + let rewindTM := TM.rewindWorkTM tapes.result + obtain ⟨matchDone, matchTime, hmatchTime, hmatchReach, hmatchHalt, + hmatchInput, hmatchSource, hmatchAddress, hmatchAddressHead, + hmatchAddressStart, hmatchValue, hmatchValueStart, hmatchAddressCounter, + hmatchAddressCounterStart, hmatchAddressWidth, hmatchValueCounter, + hmatchValueCounterStart, hmatchValueWidth, hmatchQuery, hmatchQueryHead, + hmatchQueryStart, hmatchResult, hmatchResultStart, hmatchParked, + hmatchFrame, hmatchOutput⟩ := + entryMatchTM_reachesIn_frame_internal tapes entry rest queryBits inp₀ + work₀ out₀ hsource haddress hvalue haddressStart hvalueStart + haddressCounter haddressWidth hvalueCounter hvalueWidth hquery + hqueryStart hresult hresultStart hinput hwork houtput + let resultBits : List Bool := [decide (entry.1.bits = queryBits)] + obtain ⟨rewindDone, rewindTime, hrewindTime, hrewindReach, hrewindHalt, + hrewindInput, hrewindResult, hrewindFrame, hrewindOutput⟩ := + wordTargetRewind_reachesIn_frame tapes.result resultBits matchDone.input + matchDone.work matchDone.output (by simpa [resultBits] using hmatchResult) + hmatchResultStart + (by rw [hmatchInput]; exact hinput.read_ne_start) + (fun i _ => ⟨(hmatchParked i).read_ne_start, (hmatchParked i).1⟩) + (by rw [hmatchOutput]; exact houtput.read_ne_start) + (by rw [hmatchOutput]; exact houtput.1) + have htransitionInput : TM.transitionInput matchDone.input = + matchDone.input := + TM.transitionInput_eq_self + (by rw [hmatchInput]; exact hinput.read_ne_start) + have htransitionWork : + (fun i => TM.transitionTape (matchDone.work i)) = matchDone.work := by + funext i + exact TM.transitionTape_eq_self (hmatchParked i).read_ne_start + have htransitionOutput : TM.transitionTape matchDone.output = + matchDone.output := + TM.transitionTape_eq_self + (by rw [hmatchOutput]; exact houtput.read_ne_start) + have hrewindReach' : rewindTM.reachesIn rewindTime + { state := rewindTM.qstart + input := TM.transitionInput matchDone.input + work := fun i => TM.transitionTape (matchDone.work i) + output := TM.transitionTape matchDone.output } rewindDone := by + rw [htransitionInput, htransitionWork, htransitionOutput] + simpa [rewindTM] using hrewindReach + have hfullReach := TM.seqTM_reachesIn_of_reachesIn matchTM rewindTM + (by simpa [matchTM] using hmatchReach) hmatchHalt hrewindReach' + let finalCfg := TM.phase2Wrap matchTM rewindTM rewindDone + have hresultStartFinal : (finalCfg.work tapes.result).cells 0 = Γ.start := + TM.work_cells_zero_eq_start_of_reachesIn + (tm := TM.seqTM matchTM rewindTM) tapes.result hfullReach hresultStart + have hfinalParked : ∀ i, TM.Parked (finalCfg.work i) := by + intro i + change TM.Parked (rewindDone.work i) + by_cases hir : i = tapes.result + · subst i + exact ⟨by rw [hrewindResult.1], + hrewindResult.hasBinaryContent.cells_ne_start⟩ + · rw [hrewindFrame i hir] + exact hmatchParked i + have hrewindTimeFour : rewindTime ≤ 4 := by + simpa [resultBits] using hrewindTime + have hfullTime : matchTime + 1 + rewindTime ≤ + entryMatchReadTime entry queryBits := by + simp only [entryMatchReadTime] + omega + have hpreserve (i : Fin n) (hir : i ≠ tapes.result) : + finalCfg.work i = matchDone.work i := by + change rewindDone.work i = matchDone.work i + exact hrewindFrame i hir + have hreadable : + ReadableEntryMatch tapes entry rest queryBits work₀ finalCfg.work := by + constructor + · rw [hpreserve tapes.source + (by simpa using tapes.ne (show (0 : Fin 9) ≠ 8 by decide))] + exact hmatchSource + · rw [hpreserve tapes.address + (by simpa using tapes.ne (show (1 : Fin 9) ≠ 8 by decide))] + exact hmatchAddress + · rw [hpreserve tapes.address + (by simpa using tapes.ne (show (1 : Fin 9) ≠ 8 by decide))] + exact hmatchAddressStart + · rw [hpreserve tapes.value + (by simpa using tapes.ne (show (2 : Fin 9) ≠ 8 by decide))] + exact hmatchValue + · rw [hpreserve tapes.value + (by simpa using tapes.ne (show (2 : Fin 9) ≠ 8 by decide))] + exact hmatchValueStart + · rw [hpreserve tapes.addressCounter + (by simpa using tapes.ne (show (3 : Fin 9) ≠ 8 by decide))] + exact hmatchAddressCounter + · rw [hpreserve tapes.addressCounter + (by simpa using tapes.ne (show (3 : Fin 9) ≠ 8 by decide))] + exact hmatchAddressCounterStart + · rw [hpreserve tapes.addressWidth + (by simpa using tapes.ne (show (4 : Fin 9) ≠ 8 by decide))] + exact hmatchAddressWidth + · rw [hpreserve tapes.valueCounter + (by simpa using tapes.ne (show (5 : Fin 9) ≠ 8 by decide))] + exact hmatchValueCounter + · rw [hpreserve tapes.valueCounter + (by simpa using tapes.ne (show (5 : Fin 9) ≠ 8 by decide))] + exact hmatchValueCounterStart + · rw [hpreserve tapes.valueWidth + (by simpa using tapes.ne (show (6 : Fin 9) ≠ 8 by decide))] + exact hmatchValueWidth + · rw [hpreserve tapes.query + (by simpa using tapes.ne (show (7 : Fin 9) ≠ 8 by decide))] + exact hmatchQuery + · rw [hpreserve tapes.query + (by simpa using tapes.ne (show (7 : Fin 9) ≠ 8 by decide))] + exact hmatchQueryStart + · simpa [resultBits] using hrewindResult + · exact hresultStartFinal + · exact hfinalParked + · intro i + have hhead := (TM.seqTM matchTM rewindTM).work_head_reachesIn_bound + hfullReach i + have hhead' := le_trans hhead + (Nat.add_le_add_left hfullTime (work₀ i).head) + simpa [finalCfg] using hhead' + · intro i his hia hiv hiac hiaw hivc hivw hiq hir + rw [hpreserve i hir] + exact hmatchFrame i his hia hiv hiac hiaw hivc hivw hiq hir + refine ⟨finalCfg, matchTime + 1 + rewindTime, ?_, ?_, ?_, + hrewindInput.trans hmatchInput, hreadable, + hrewindOutput.trans hmatchOutput⟩ + · exact hfullTime + · simpa [entryMatchReadTM, matchTM, rewindTM, finalCfg] using hfullReach + · exact (TM.phase2Wrap_halted_iff matchTM rewindTM rewindDone).2 + hrewindHalt + +/-- Closed form for the optimized unary-marker decode-and-match runtime. -/ +theorem entryMatchReadTime_eq_internal (entry : Entry) + (queryBits : List Bool) : + entryMatchReadTime entry queryBits = + 4 * entry.1.bits.length + 3 * entry.2.bits.length + + max entry.1.bits.length queryBits.length + 18 := by + unfold entryMatchReadTime entryMatchTime entryDecodeLinearTime + wordDecodeLinearTime decodedAddressEqTime TM.binaryEqTime + simp only [bitlen, Nat.size_eq_bits_len] + omega + +/-- One optimized readable match is linear in the two encoded word widths and +the preserved query width. -/ +theorem entryMatchReadTime_le_linear_internal (entry : Entry) + (queryBits : List Bool) : + entryMatchReadTime entry queryBits ≤ + 5 * entry.1.bits.length + 3 * entry.2.bits.length + + queryBits.length + 18 := by + rw [entryMatchReadTime_eq_internal] + have hmax : max entry.1.bits.length queryBits.length ≤ + entry.1.bits.length + queryBits.length := + max_le (Nat.le_add_right _ _) (Nat.le_add_left _ _) + omega + +end Machine + +end RegisterStore + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryMissCopy.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryMissCopy.lean new file mode 100644 index 0000000000..8314cf8195 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryMissCopy.lean @@ -0,0 +1,75 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryMissCopy.Defs +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryMissCopy.Internal + +/-! +# Sparse-entry miss copy + +This module exposes the update-scan branch that appends one unmatched entry to +the new store and restores the exact invariant needed to inspect the next one. +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace RegisterStore + +namespace Machine + +/-- Copy one decoded unmatched entry to the output stream and restore the +ordinary next-entry scan invariant, with an explicit intermediate work frame. -/ +theorem entryMissCopyTM_hoareTime_frame {n : ℕ} + (tapes : EntryMatchTapes n) (entry : Entry) (rest queryBits emitted : List Bool) + (initialWork matchedWork : Fin n → Tape) (inp₀ out₀ : Tape) + (hmatch : ReadableEntryMatch tapes entry rest queryBits initialWork matchedWork) + (hinput : TM.Parked inp₀) (houtput : out₀.HasBinaryPrefix emitted) : + (entryMissCopyTM tapes).HoareTime + (fun inp work out => inp = inp₀ ∧ work = matchedWork ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + EntryScanReady tapes rest queryBits initialWork work ∧ + out.HasBinaryPrefix (emitted ++ Entry.encode entry)) + (entryMissCopyTime tapes entry queryBits initialWork matchedWork) := + entryMissCopyTM_hoareTime_frame_internal tapes entry rest queryBits emitted + initialWork matchedWork inp₀ out₀ hmatch hinput houtput + +/-- Miss-copy is append-only on the output tape. -/ +theorem entryMissCopyTM_isTransducer {n : ℕ} (tapes : EntryMatchTapes n) : + (entryMissCopyTM tapes).IsTransducer := + (rewindEntryEncodeTM_isTransducer tapes.encodeTapes).seqTM + (entryMissCleanupTM_isTransducer tapes) + +/-- Coarse all-prefix auxiliary-space envelope for one miss-copy branch. -/ +theorem entryMissCopyTM_prefix_withinAuxSpace {n : ℕ} + (tapes : EntryMatchTapes n) (entry : Entry) (queryBits : List Bool) + (initialWork matchedWork : Fin n → Tape) + (inputLength initialSpace time : ℕ) + (start current : Complexity.Cfg n (entryMissCopyTM tapes).Q) + (hinitial : start.WithinAuxSpace inputLength initialSpace) + (hreach : (entryMissCopyTM tapes).reachesIn time start current) + (htime : time ≤ + entryMissCopyTime tapes entry queryBits initialWork matchedWork) : + current.WithinAuxSpace inputLength + (initialSpace + + entryMissCopyTime tapes entry queryBits initialWork matchedWork) := + (hinitial.reachesIn hreach).mono le_rfl (by omega) + +end Machine + +end RegisterStore + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryMissCopy/Defs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryMissCopy/Defs.lean new file mode 100644 index 0000000000..60a3d5d2e1 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryMissCopy/Defs.lean @@ -0,0 +1,82 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryCleanup.Defs +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryEncode.Defs + +/-! +# Sparse-entry miss copy — definitions + +An update scan must preserve every unmatched sparse entry. This module first +emits the decoded address/value pair to the output stream and then restores the +ordinary next-entry scan invariant. +-/ + + +@[expose] public section + +namespace Complexity + +namespace RAM + +namespace RegisterStore + +namespace Machine + +namespace EntryMatchTapes + +/-- View the decoded address and value tapes as entry-emission sources. -/ +def encodeTapes {n : ℕ} (tapes : EntryMatchTapes n) : EntryEncodeTapes n where + address := tapes.address + value := tapes.value + ne := tapes.ne (by decide) + +@[simp] theorem encodeTapes_address {n : ℕ} (tapes : EntryMatchTapes n) : + tapes.encodeTapes.address = tapes.address := rfl + +@[simp] theorem encodeTapes_value {n : ℕ} (tapes : EntryMatchTapes n) : + tapes.encodeTapes.value = tapes.value := rfl + +end EntryMatchTapes + +/-- Exact work family after the decoded address and value have been emitted. +Only their heads change; their canonical contents and every other tape remain +literal copies of the readable-match endpoint. -/ +def entryMissCopiedWork {n : ℕ} (tapes : EntryMatchTapes n) + (entry : Entry) (work : Fin n → Tape) (i : Fin n) : Tape := + if i = tapes.address then + { head := entry.1.bits.length + 1, cells := (work i).cells } + else if i = tapes.value then + { head := entry.2.bits.length + 1, cells := (work i).cells } + else work i + +/-- Emit the decoded unmatched entry and restore the next-iteration scratch +invariant. -/ +def entryMissCopyTM {n : ℕ} (tapes : EntryMatchTapes n) : TM n := + TM.seqTM (rewindEntryEncodeTM tapes.encodeTapes) + (entryMissCleanupTM tapes) + +/-- Compositional runtime bound for copying and cleaning one unmatched entry. -/ +def entryMissCopyTime {n : ℕ} (tapes : EntryMatchTapes n) + (entry : Entry) (queryBits : List Bool) + (initialWork matchedWork : Fin n → Tape) : ℕ := + rewindEntryEncodeTime entry + (entryMissHeadBound entry queryBits initialWork tapes.address) + (entryMissHeadBound entry queryBits initialWork tapes.value) + + 1 + + entryMissCleanupTime tapes entry queryBits + (entryMissCopiedWork tapes entry matchedWork) + +end Machine + +end RegisterStore + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryMissCopy/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryMissCopy/Internal.lean new file mode 100644 index 0000000000..2f65ea111f --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryMissCopy/Internal.lean @@ -0,0 +1,269 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryMissCopy.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryCleanup +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryEncode + +/-! +# Sparse-entry miss copy — proof internals +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace RegisterStore + +namespace Machine + +variable {n : ℕ} + +private theorem parked_of_binarySuffix {t : Tape} {bits : List Bool} + (h : t.HasBinarySuffix bits) : TM.Parked t := + ⟨h.1, h.2.2.2⟩ + +private theorem parked_of_binaryPrefix {t : Tape} {bits : List Bool} + (h : t.HasBinaryPrefix bits) : TM.Parked t := + ⟨by rw [h.1]; omega, + (show t.HasBinaryContent bits from h.2).cells_ne_start⟩ + +private theorem entryMissCopiedWork_eq + (tapes : EntryMatchTapes n) (entry : Entry) + (matchedWork copiedWork : Fin n → Tape) + (haddressCells : (copiedWork tapes.address).cells = + (matchedWork tapes.address).cells) + (haddressHead : (copiedWork tapes.address).head = + entry.1.bits.length + 1) + (hvalueCells : (copiedWork tapes.value).cells = + (matchedWork tapes.value).cells) + (hvalueHead : (copiedWork tapes.value).head = + entry.2.bits.length + 1) + (hframe : ∀ i, i ≠ tapes.address → i ≠ tapes.value → + copiedWork i = matchedWork i) : + copiedWork = entryMissCopiedWork tapes entry matchedWork := by + funext i + by_cases hia : i = tapes.address + · subst i + simp only [entryMissCopiedWork, if_pos] + exact Tape.ext haddressHead haddressCells + · by_cases hiv : i = tapes.value + · subst i + simp only [entryMissCopiedWork, hia, if_false, if_pos] + exact Tape.ext hvalueHead hvalueCells + · simp only [entryMissCopiedWork, hia, hiv, if_false] + exact hframe i hia hiv + +private theorem readableEntryMatch_rebase_after_copy + (tapes : EntryMatchTapes n) (entry : Entry) (rest queryBits : List Bool) + (baseWork initialWork copiedWork : Fin n → Tape) + (hmatch : ReadableEntryMatch tapes entry rest queryBits baseWork initialWork) + (haddressSuffix : (copiedWork tapes.address).HasBinarySuffix []) + (haddressCells : (copiedWork tapes.address).cells = + (initialWork tapes.address).cells) + (hvalueSuffix : (copiedWork tapes.value).HasBinarySuffix []) + (hvalueCells : (copiedWork tapes.value).cells = + (initialWork tapes.value).cells) + (hvalueHead : (copiedWork tapes.value).head = + entry.2.bits.length + 1) + (hframe : ∀ i, i ≠ tapes.address → i ≠ tapes.value → + copiedWork i = initialWork i) : + ReadableEntryMatch tapes entry rest queryBits copiedWork copiedWork := by + have hsourceNeAddress : tapes.source ≠ tapes.address := tapes.ne (by decide) + have hsourceNeValue : tapes.source ≠ tapes.value := tapes.ne (by decide) + have haddressContent : + (copiedWork tapes.address).HasBinaryContent entry.1.bits := by + simpa only [Tape.HasBinaryContent, haddressCells] using hmatch.address + have hvalueContent : + (copiedWork tapes.value).HasBinaryContent entry.2.bits := by + simpa only [Tape.HasBinaryContent, hvalueCells] using hmatch.value.2 + constructor + · rw [hframe tapes.source hsourceNeAddress hsourceNeValue] + exact hmatch.source + · exact haddressContent + · rw [haddressCells] + exact hmatch.addressStart + · exact ⟨hvalueHead, hvalueContent⟩ + · rw [hvalueCells] + exact hmatch.valueStart + · rw [hframe tapes.addressCounter (tapes.ne (by decide)) + (tapes.ne (by decide))] + exact hmatch.addressCounter + · rw [hframe tapes.addressCounter (tapes.ne (by decide)) + (tapes.ne (by decide))] + exact hmatch.addressCounterStart + · rw [hframe tapes.addressWidth (tapes.ne (by decide)) + (tapes.ne (by decide))] + exact hmatch.addressWidth + · rw [hframe tapes.valueCounter (tapes.ne (by decide)) + (tapes.ne (by decide))] + exact hmatch.valueCounter + · rw [hframe tapes.valueCounter (tapes.ne (by decide)) + (tapes.ne (by decide))] + exact hmatch.valueCounterStart + · rw [hframe tapes.valueWidth (tapes.ne (by decide)) + (tapes.ne (by decide))] + exact hmatch.valueWidth + · rw [hframe tapes.query (tapes.ne (by decide)) + (tapes.ne (by decide))] + exact hmatch.query + · rw [hframe tapes.query (tapes.ne (by decide)) + (tapes.ne (by decide))] + exact hmatch.queryStart + · rw [hframe tapes.result (tapes.ne (by decide)) + (tapes.ne (by decide))] + exact hmatch.result + · rw [hframe tapes.result (tapes.ne (by decide)) + (tapes.ne (by decide))] + exact hmatch.resultStart + · intro i + by_cases hia : i = tapes.address + · subst i + exact parked_of_binarySuffix haddressSuffix + · by_cases hiv : i = tapes.value + · subst i + exact parked_of_binarySuffix hvalueSuffix + · rw [hframe i hia hiv] + exact hmatch.parked i + · intro i + exact Nat.le_add_right _ _ + · intro i _ _ _ _ _ _ _ _ _ + rfl + +theorem entryMissCopyTM_hoareTime_frame_internal + (tapes : EntryMatchTapes n) (entry : Entry) (rest queryBits emitted : List Bool) + (initialWork matchedWork : Fin n → Tape) (inp₀ out₀ : Tape) + (hmatch : ReadableEntryMatch tapes entry rest queryBits initialWork matchedWork) + (hinput : TM.Parked inp₀) (houtput : out₀.HasBinaryPrefix emitted) : + (entryMissCopyTM tapes).HoareTime + (fun inp work out => inp = inp₀ ∧ work = matchedWork ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + EntryScanReady tapes rest queryBits initialWork work ∧ + out.HasBinaryPrefix (emitted ++ Entry.encode entry)) + (entryMissCopyTime tapes entry queryBits initialWork matchedWork) := by + intro inp work out hpre + rcases hpre with ⟨hinp, hwork, hout⟩ + subst inp + subst work + subst out + let copiedWork := entryMissCopiedWork tapes entry matchedWork + have hencode := rewindEntryEncodeTM_hoareTime_frame tapes.encodeTapes entry + (entryMissHeadBound entry queryBits initialWork tapes.address) + (entryMissHeadBound entry queryBits initialWork tapes.value) + emitted inp₀ matchedWork out₀ hmatch.address hmatch.addressStart + ⟨(hmatch.parked tapes.address).1, hmatch.headBound tapes.address⟩ + hmatch.value.2 hmatch.valueStart + ⟨(hmatch.parked tapes.value).1, hmatch.headBound tapes.value⟩ + hinput (fun i _ _ => hmatch.parked i) houtput + obtain ⟨encoded, encodeTime, hencodeTime, hencodeReach, hencodeHalt, + hencodedInput, haddressSuffix, haddressCells, haddressHead, + hvalueSuffix, hvalueCells, hvalueHead, hencodedFrame, + hencodedOutput⟩ := + hencode inp₀ matchedWork out₀ ⟨rfl, rfl, rfl⟩ + have hencodedWork : encoded.work = copiedWork := by + apply entryMissCopiedWork_eq tapes entry matchedWork encoded.work + · simpa using haddressCells + · simpa using haddressHead + · simpa using hvalueCells + · simpa using hvalueHead + · intro i hia hiv + exact hencodedFrame i hia hiv + have hmatchSelf : + ReadableEntryMatch tapes entry rest queryBits copiedWork copiedWork := by + have hmatchCopied : + ReadableEntryMatch tapes entry rest queryBits encoded.work encoded.work := + readableEntryMatch_rebase_after_copy tapes entry rest queryBits + initialWork matchedWork encoded.work hmatch + (by simpa using haddressSuffix) (by simpa using haddressCells) + (by simpa using hvalueSuffix) + (by simpa using hvalueCells) (by simpa using hvalueHead) + (by + intro i hia hiv + exact hencodedFrame i hia hiv) + simpa [hencodedWork] using hmatchCopied + have hencodedInputParked : TM.Parked encoded.input := by + rw [hencodedInput] + exact hinput + have hencodedWorkParked : ∀ i, TM.Parked (encoded.work i) := by + intro i + rw [hencodedWork] + exact hmatchSelf.parked i + have hencodedOutputParked : TM.Parked encoded.output := + parked_of_binaryPrefix hencodedOutput + have hcleanup := entryMissCleanupTM_hoareTime_frame tapes entry rest queryBits + copiedWork copiedWork encoded.input encoded.output hmatchSelf + (by simpa [hencodedInput] using hinput) hencodedOutputParked + obtain ⟨cleaned, cleanupTime, hcleanupTime, hcleanupReach, hcleanupHalt, + hcleanedInput, hready, hcleanedOutput⟩ := + hcleanup encoded.input copiedWork encoded.output ⟨rfl, rfl, rfl⟩ + obtain ⟨hinputTransition, hworkTransition, houtputTransition⟩ := + TM.phaseTransition_eq_self_of_reads_ne_start + hencodedInputParked.read_ne_start + (fun i => (hencodedWorkParked i).read_ne_start) + hencodedOutputParked.read_ne_start + have hworkTransition' : + (fun i => TM.transitionTape (encoded.work i)) = copiedWork := + hworkTransition.trans hencodedWork + have hcleanupReach' : (entryMissCleanupTM tapes).reachesIn cleanupTime + { state := (entryMissCleanupTM tapes).qstart + input := TM.transitionInput encoded.input + work := fun i => TM.transitionTape (encoded.work i) + output := TM.transitionTape encoded.output } + cleaned := by + simpa only [hinputTransition, hworkTransition', houtputTransition] + using hcleanupReach + have hreach := TM.seqTM_reachesIn_of_reachesIn + (rewindEntryEncodeTM tapes.encodeTapes) (entryMissCleanupTM tapes) + hencodeReach hencodeHalt hcleanupReach' + let finalCfg := TM.phase2Wrap (rewindEntryEncodeTM tapes.encodeTapes) + (entryMissCleanupTM tapes) cleaned + refine ⟨finalCfg, encodeTime + 1 + cleanupTime, ?_, hreach, ?_, ?_⟩ + · unfold entryMissCopyTime + change encodeTime + 1 + cleanupTime ≤ + rewindEntryEncodeTime entry + (entryMissHeadBound entry queryBits initialWork tapes.address) + (entryMissHeadBound entry queryBits initialWork tapes.value) + + 1 + entryMissCleanupTime tapes entry queryBits copiedWork + omega + · change (entryMissCopyTM tapes).halted finalCfg + unfold entryMissCopyTM + rw [TM.phase2Wrap_halted_iff] + exact hcleanupHalt + · have hreadyGlobal : + EntryScanReady tapes rest queryBits initialWork cleaned.work := by + refine ⟨hready.source, hready.address, hready.addressStart, + hready.value, hready.valueStart, hready.addressCounter, + hready.addressWidth, hready.valueCounter, hready.valueWidth, + hready.query, hready.queryStart, hready.result, hready.resultStart, + hready.parked, ?_⟩ + intro i hsource haddress hvalue haddressCounter haddressWidth + hvalueCounter hvalueWidth hquery hresult + have hcopied : copiedWork i = matchedWork i := by + simp [copiedWork, entryMissCopiedWork, haddress, hvalue] + exact (hready.frame i hsource haddress hvalue haddressCounter + haddressWidth hvalueCounter hvalueWidth hquery hresult).trans + (hcopied.trans (hmatch.frame i hsource haddress hvalue + haddressCounter haddressWidth hvalueCounter hvalueWidth hquery + hresult)) + refine ⟨?_, hreadyGlobal, ?_⟩ + · simpa [finalCfg] using hcleanedInput.trans hencodedInput + · change cleaned.output.HasBinaryPrefix (emitted ++ Entry.encode entry) + rw [hcleanedOutput] + exact hencodedOutput + +end Machine + +end RegisterStore + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryReplace.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryReplace.lean new file mode 100644 index 0000000000..4a64b67bfb --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryReplace.lean @@ -0,0 +1,81 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryReplace.Defs +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryReplace.Internal + +/-! +# Sparse-entry replacement +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace RegisterStore + +namespace Machine + +/-- Emit a matched address with a canonical replacement value, restore that +external value source, and clear all entry scratch for the next iteration. -/ +theorem entryReplaceCleanupTM_hoareTime_frame {n : ℕ} + (tapes : EntryReplaceTapes n) (entry : Entry) (newValue : ℕ) + (rest queryBits emitted : List Bool) + (initialWork matchedWork : Fin n → Tape) (inp₀ out₀ : Tape) + (hmatch : ReadableEntryMatch tapes.entry entry rest queryBits + initialWork matchedWork) + (hreplacement : (matchedWork tapes.replacement).HasBinaryNat newValue) + (hinput : TM.Parked inp₀) (houtput : out₀.HasBinaryPrefix emitted) : + (entryReplaceCleanupTM tapes).HoareTime + (fun inp work out => inp = inp₀ ∧ work = matchedWork ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + EntryScanReady tapes.entry rest queryBits initialWork work ∧ + work tapes.replacement = matchedWork tapes.replacement ∧ + out.HasBinaryPrefix + (emitted ++ Entry.encode (entry.1, newValue))) + (entryReplaceCleanupTime tapes entry newValue queryBits + initialWork matchedWork) := + entryReplaceCleanupTM_hoareTime_frame_internal tapes entry newValue rest + queryBits emitted initialWork matchedWork inp₀ out₀ hmatch hreplacement + hinput houtput + +/-- Replacement emission and cleanup are append-only on the output tape. -/ +theorem entryReplaceCleanupTM_isTransducer {n : ℕ} + (tapes : EntryReplaceTapes n) : + (entryReplaceCleanupTM tapes).IsTransducer := + (rewindEntryEncodeTM_isTransducer tapes.encodeTapes).seqTM + ((TM.rewindWorkTM_isTransducer tapes.replacement).seqTM + (entryMissCleanupTM_isTransducer tapes.entry)) + +/-- Coarse all-prefix auxiliary-space envelope for replacement and cleanup. -/ +theorem entryReplaceCleanupTM_prefix_withinAuxSpace {n : ℕ} + (tapes : EntryReplaceTapes n) (entry : Entry) (newValue : ℕ) + (queryBits : List Bool) (initialWork matchedWork : Fin n → Tape) + (inputLength initialSpace time : ℕ) + (start current : Complexity.Cfg n (entryReplaceCleanupTM tapes).Q) + (hinitial : start.WithinAuxSpace inputLength initialSpace) + (hreach : (entryReplaceCleanupTM tapes).reachesIn time start current) + (htime : time ≤ entryReplaceCleanupTime tapes entry newValue queryBits + initialWork matchedWork) : + current.WithinAuxSpace inputLength + (initialSpace + entryReplaceCleanupTime tapes entry newValue queryBits + initialWork matchedWork) := + (hinitial.reachesIn hreach).mono le_rfl (by omega) + +end Machine + +end RegisterStore + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryReplace/Defs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryReplace/Defs.lean new file mode 100644 index 0000000000..02069d3366 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryReplace/Defs.lean @@ -0,0 +1,88 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryCleanup.Defs +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryEncode.Defs + +/-! +# Sparse-entry replacement — definitions + +The replacement branch emits the matched address paired with a distinct +canonical new-value tape, rewinds that external value source, and restores the +ordinary next-entry scan invariant. +-/ + + +@[expose] public section + +namespace Complexity + +namespace RAM + +namespace RegisterStore + +namespace Machine + +/-- Entry-match tapes plus a distinct source containing the replacement value. -/ +structure EntryReplaceTapes (n : ℕ) where + /-- The nine tapes used to decode and match the old entry. -/ + entry : EntryMatchTapes n + /-- Canonical new-value source. -/ + replacement : Fin n + /-- The replacement source is outside the complete entry-match assignment. -/ + replacement_ne : ∀ i, replacement ≠ entry.idx i + +namespace EntryReplaceTapes + +/-- Emit the matched decoded address paired with the replacement source. -/ +def encodeTapes {n : ℕ} (tapes : EntryReplaceTapes n) : EntryEncodeTapes n where + address := tapes.entry.address + value := tapes.replacement + ne := Ne.symm (tapes.replacement_ne 1) + +@[simp] theorem encodeTapes_address {n : ℕ} (tapes : EntryReplaceTapes n) : + tapes.encodeTapes.address = tapes.entry.address := rfl + +@[simp] theorem encodeTapes_value {n : ℕ} (tapes : EntryReplaceTapes n) : + tapes.encodeTapes.value = tapes.replacement := rfl + +end EntryReplaceTapes + +/-- Exact work family after replacement emission and restoration of the +external replacement cursor. Only the decoded address head remains changed. -/ +def entryReplaceReadyWork {n : ℕ} (tapes : EntryReplaceTapes n) + (entry : Entry) (work : Fin n → Tape) (i : Fin n) : Tape := + if i = tapes.entry.address then + { head := entry.1.bits.length + 1, cells := (work i).cells } + else work i + +/-- Emit the replacement entry, restore the replacement cursor, and clear all +entry decoder/result scratch. -/ +def entryReplaceCleanupTM {n : ℕ} (tapes : EntryReplaceTapes n) : TM n := + TM.seqTM (rewindEntryEncodeTM tapes.encodeTapes) + (TM.seqTM (TM.rewindWorkTM tapes.replacement) + (entryMissCleanupTM tapes.entry)) + +/-- Compositional runtime bound for replacement emission and cleanup. -/ +def entryReplaceCleanupTime {n : ℕ} (tapes : EntryReplaceTapes n) + (entry : Entry) (newValue : ℕ) (queryBits : List Bool) + (initialWork matchedWork : Fin n → Tape) : ℕ := + rewindEntryEncodeTime (entry.1, newValue) + (entryMissHeadBound entry queryBits initialWork tapes.entry.address) 1 + + 1 + (newValue.bits.length + 1 + 2 + 1 + + entryMissCleanupTime tapes.entry entry queryBits + (entryReplaceReadyWork tapes entry matchedWork)) + +end Machine + +end RegisterStore + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryReplace/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryReplace/Internal.lean new file mode 100644 index 0000000000..9364d83606 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryReplace/Internal.lean @@ -0,0 +1,359 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryReplace.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryCleanup +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryEncode + +/-! +# Sparse-entry replacement — proof internals +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace RegisterStore + +namespace Machine + +variable {n : ℕ} + +private theorem parked_of_binarySuffix {t : Tape} {bits : List Bool} + (h : t.HasBinarySuffix bits) : TM.Parked t := + ⟨h.1, h.2.2.2⟩ + +private theorem parked_of_binaryPrefix {t : Tape} {bits : List Bool} + (h : t.HasBinaryPrefix bits) : TM.Parked t := + ⟨by rw [h.1]; omega, + (show t.HasBinaryContent bits from h.2).cells_ne_start⟩ + +private theorem readableEntryMatch_rebase_after_address_emit + (tapes : EntryReplaceTapes n) (entry : Entry) + (rest queryBits : List Bool) (baseWork matchedWork readyWork : Fin n → Tape) + (hmatch : ReadableEntryMatch tapes.entry entry rest queryBits + baseWork matchedWork) + (haddressSuffix : (readyWork tapes.entry.address).HasBinarySuffix []) + (haddressCells : (readyWork tapes.entry.address).cells = + (matchedWork tapes.entry.address).cells) + (hframe : ∀ i, i ≠ tapes.entry.address → readyWork i = matchedWork i) : + ReadableEntryMatch tapes.entry entry rest queryBits readyWork readyWork := by + have haddressContent : + (readyWork tapes.entry.address).HasBinaryContent entry.1.bits := by + simpa only [Tape.HasBinaryContent, haddressCells] using hmatch.address + constructor + · rw [hframe tapes.entry.source (tapes.entry.ne (by decide))] + exact hmatch.source + · exact haddressContent + · rw [haddressCells] + exact hmatch.addressStart + · rw [hframe tapes.entry.value (tapes.entry.ne (by decide))] + exact hmatch.value + · rw [hframe tapes.entry.value (tapes.entry.ne (by decide))] + exact hmatch.valueStart + · rw [hframe tapes.entry.addressCounter (tapes.entry.ne (by decide))] + exact hmatch.addressCounter + · rw [hframe tapes.entry.addressCounter (tapes.entry.ne (by decide))] + exact hmatch.addressCounterStart + · rw [hframe tapes.entry.addressWidth (tapes.entry.ne (by decide))] + exact hmatch.addressWidth + · rw [hframe tapes.entry.valueCounter (tapes.entry.ne (by decide))] + exact hmatch.valueCounter + · rw [hframe tapes.entry.valueCounter (tapes.entry.ne (by decide))] + exact hmatch.valueCounterStart + · rw [hframe tapes.entry.valueWidth (tapes.entry.ne (by decide))] + exact hmatch.valueWidth + · rw [hframe tapes.entry.query (tapes.entry.ne (by decide))] + exact hmatch.query + · rw [hframe tapes.entry.query (tapes.entry.ne (by decide))] + exact hmatch.queryStart + · rw [hframe tapes.entry.result (tapes.entry.ne (by decide))] + exact hmatch.result + · rw [hframe tapes.entry.result (tapes.entry.ne (by decide))] + exact hmatch.resultStart + · intro i + by_cases hia : i = tapes.entry.address + · subst i + exact parked_of_binarySuffix haddressSuffix + · rw [hframe i hia] + exact hmatch.parked i + · intro i + exact Nat.le_add_right _ _ + · intro i _ _ _ _ _ _ _ _ _ + rfl + +private theorem entryReplaceReadyWork_eq + (tapes : EntryReplaceTapes n) (entry : Entry) + (matchedWork readyWork : Fin n → Tape) + (haddressCells : (readyWork tapes.entry.address).cells = + (matchedWork tapes.entry.address).cells) + (haddressHead : (readyWork tapes.entry.address).head = + entry.1.bits.length + 1) + (hframe : ∀ i, i ≠ tapes.entry.address → readyWork i = matchedWork i) : + readyWork = entryReplaceReadyWork tapes entry matchedWork := by + funext i + by_cases hia : i = tapes.entry.address + · subst i + simp only [entryReplaceReadyWork, if_pos] + exact Tape.ext haddressHead haddressCells + · simp only [entryReplaceReadyWork, hia, if_false] + exact hframe i hia + +theorem entryReplaceCleanupTM_hoareTime_frame_internal + (tapes : EntryReplaceTapes n) (entry : Entry) (newValue : ℕ) + (rest queryBits emitted : List Bool) + (initialWork matchedWork : Fin n → Tape) (inp₀ out₀ : Tape) + (hmatch : ReadableEntryMatch tapes.entry entry rest queryBits + initialWork matchedWork) + (hreplacement : (matchedWork tapes.replacement).HasBinaryNat newValue) + (hinput : TM.Parked inp₀) (houtput : out₀.HasBinaryPrefix emitted) : + (entryReplaceCleanupTM tapes).HoareTime + (fun inp work out => inp = inp₀ ∧ work = matchedWork ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + EntryScanReady tapes.entry rest queryBits initialWork work ∧ + work tapes.replacement = matchedWork tapes.replacement ∧ + out.HasBinaryPrefix + (emitted ++ Entry.encode (entry.1, newValue))) + (entryReplaceCleanupTime tapes entry newValue queryBits + initialWork matchedWork) := by + intro inp work out hpre + rcases hpre with ⟨hinp, hwork, hout⟩ + subst inp + subst work + subst out + let readyWork := entryReplaceReadyWork tapes entry matchedWork + have hencode := rewindEntryEncodeTM_hoareTime_frame tapes.encodeTapes + (entry.1, newValue) + (entryMissHeadBound entry queryBits initialWork tapes.entry.address) 1 + emitted inp₀ matchedWork out₀ hmatch.address hmatch.addressStart + ⟨(hmatch.parked tapes.entry.address).1, + hmatch.headBound tapes.entry.address⟩ + hreplacement.2.hasBinaryContent hreplacement.1 + (by + have hhead : 1 ≤ (matchedWork tapes.replacement).head ∧ + (matchedWork tapes.replacement).head ≤ 1 := by + rw [hreplacement.2.1] + exact ⟨le_rfl, le_rfl⟩ + simpa using hhead) + hinput (fun i _ _ => hmatch.parked i) houtput + obtain ⟨encoded, encodeTime, hencodeTime, hencodeReach, hencodeHalt, + hencodedInput, haddressSuffix, haddressCells, haddressHead, + hreplacementSuffix, hreplacementCells, hreplacementHead, + hencodedFrame, hencodedOutput⟩ := + hencode inp₀ matchedWork out₀ ⟨rfl, rfl, rfl⟩ + have hencodedInputParked : TM.Parked encoded.input := by + rw [hencodedInput] + exact hinput + have hencodedOutputParked : TM.Parked encoded.output := + parked_of_binaryPrefix hencodedOutput + have hencodedWorkParked : ∀ i, TM.Parked (encoded.work i) := by + intro i + by_cases hia : i = tapes.entry.address + · subst i + exact parked_of_binarySuffix haddressSuffix + · by_cases hir : i = tapes.replacement + · subst i + exact parked_of_binarySuffix hreplacementSuffix + · rw [hencodedFrame i hia hir] + exact hmatch.parked i + have hreplacementContent : + (encoded.work tapes.replacement).HasBinaryContent newValue.bits := by + have hcells : (encoded.work tapes.replacement).cells = + (matchedWork tapes.replacement).cells := by + simpa using hreplacementCells + simpa only [Tape.HasBinaryContent, hcells] using + hreplacement.2.hasBinaryContent + have hreplacementStart : + (encoded.work tapes.replacement).cells 0 = Γ.start := by + have hcells : (encoded.work tapes.replacement).cells = + (matchedWork tapes.replacement).cells := by + simpa using hreplacementCells + rw [hcells] + exact hreplacement.1 + have hreplacementHead' : (encoded.work tapes.replacement).head = + newValue.bits.length + 1 := by + simpa using hreplacementHead + have hrewind := TM.rewindBinaryWorkTM_hoareTime_frame tapes.replacement + newValue.bits (newValue.bits.length + 1) encoded.input encoded.work + encoded.output hreplacementContent hreplacementStart + ⟨by rw [hreplacementHead']; omega, by rw [hreplacementHead']⟩ + hencodedInputParked + (fun i _ => hencodedWorkParked i) hencodedOutputParked + obtain ⟨rewound, rewindTime, hrewindTime, hrewindReach, hrewindHalt, + hrewoundInput, hrewoundReplacement, hrewoundFrame, + hrewoundOutput⟩ := + hrewind encoded.input encoded.work encoded.output ⟨rfl, rfl, rfl⟩ + have hmatchedReplacement : matchedWork tapes.replacement = + (Tape.init (newValue.bits.map Γ.ofBool)).move Dir3.right := + Tape.eq_init_move_right_of_hasBinaryString hreplacement.2 hreplacement.1 + have hreplacementRestored : + rewound.work tapes.replacement = matchedWork tapes.replacement := + hrewoundReplacement.trans hmatchedReplacement.symm + have hreadyWorkEq : rewound.work = readyWork := by + apply entryReplaceReadyWork_eq tapes entry matchedWork rewound.work + · rw [hrewoundFrame tapes.entry.address + (Ne.symm (tapes.replacement_ne 1))] + simpa using haddressCells + · rw [hrewoundFrame tapes.entry.address + (Ne.symm (tapes.replacement_ne 1))] + simpa using haddressHead + · intro i hia + by_cases hir : i = tapes.replacement + · subst i + exact hreplacementRestored + · exact (hrewoundFrame i hir).trans (hencodedFrame i hia hir) + have hmatchSelf : ReadableEntryMatch tapes.entry entry rest queryBits + readyWork readyWork := by + have hmatchReady := readableEntryMatch_rebase_after_address_emit tapes + entry rest queryBits initialWork matchedWork rewound.work hmatch + (by + rw [hrewoundFrame tapes.entry.address + (Ne.symm (tapes.replacement_ne 1))] + simpa using haddressSuffix) + (by + rw [hrewoundFrame tapes.entry.address + (Ne.symm (tapes.replacement_ne 1))] + simpa using haddressCells) + (by + intro i hia + by_cases hir : i = tapes.replacement + · subst i + exact hreplacementRestored + · exact (hrewoundFrame i hir).trans (hencodedFrame i hia hir)) + simpa [hreadyWorkEq] using hmatchReady + have hrewoundInputParked : TM.Parked rewound.input := by + rw [hrewoundInput, hencodedInput] + exact hinput + have hrewoundOutputParked : TM.Parked rewound.output := by + rw [hrewoundOutput] + exact hencodedOutputParked + have hrewoundWorkParked : ∀ i, TM.Parked (rewound.work i) := by + intro i + rw [hreadyWorkEq] + exact hmatchSelf.parked i + have hcleanup := entryMissCleanupTM_hoareTime_frame tapes.entry entry rest + queryBits readyWork readyWork rewound.input rewound.output hmatchSelf + hrewoundInputParked hrewoundOutputParked + obtain ⟨cleaned, cleanupTime, hcleanupTime, hcleanupReach, hcleanupHalt, + hcleanedInput, hready, hcleanedOutput⟩ := + hcleanup rewound.input readyWork rewound.output ⟨rfl, rfl, rfl⟩ + obtain ⟨hrewindInputTransition, hrewindWorkTransition, + hrewindOutputTransition⟩ := + TM.phaseTransition_eq_self_of_reads_ne_start + hrewoundInputParked.read_ne_start + (fun i => (hrewoundWorkParked i).read_ne_start) + hrewoundOutputParked.read_ne_start + have hrewindWorkTransition' : + (fun i => TM.transitionTape (rewound.work i)) = readyWork := + hrewindWorkTransition.trans hreadyWorkEq + have hcleanupReach' : (entryMissCleanupTM tapes.entry).reachesIn cleanupTime + { state := (entryMissCleanupTM tapes.entry).qstart + input := TM.transitionInput rewound.input + work := fun i => TM.transitionTape (rewound.work i) + output := TM.transitionTape rewound.output } + cleaned := by + simpa only [hrewindInputTransition, hrewindWorkTransition', + hrewindOutputTransition] using hcleanupReach + have htailReach := TM.seqTM_reachesIn_of_reachesIn + (TM.rewindWorkTM tapes.replacement) (entryMissCleanupTM tapes.entry) + hrewindReach hrewindHalt hcleanupReach' + let tailFinal := TM.phase2Wrap (TM.rewindWorkTM tapes.replacement) + (entryMissCleanupTM tapes.entry) cleaned + have htailHalt : + (TM.seqTM (TM.rewindWorkTM tapes.replacement) + (entryMissCleanupTM tapes.entry)).halted tailFinal := by + rw [TM.phase2Wrap_halted_iff] + exact hcleanupHalt + obtain ⟨hencodedInputTransition, hencodedWorkTransition, + hencodedOutputTransition⟩ := + TM.phaseTransition_eq_self_of_reads_ne_start + hencodedInputParked.read_ne_start + (fun i => (hencodedWorkParked i).read_ne_start) + hencodedOutputParked.read_ne_start + have htailReach' : + (TM.seqTM (TM.rewindWorkTM tapes.replacement) + (entryMissCleanupTM tapes.entry)).reachesIn + (rewindTime + 1 + cleanupTime) + { state := (TM.seqTM (TM.rewindWorkTM tapes.replacement) + (entryMissCleanupTM tapes.entry)).qstart + input := TM.transitionInput encoded.input + work := fun i => TM.transitionTape (encoded.work i) + output := TM.transitionTape encoded.output } + tailFinal := by + simpa only [hencodedInputTransition, hencodedWorkTransition, + hencodedOutputTransition] using htailReach + have hreach := TM.seqTM_reachesIn_of_reachesIn + (rewindEntryEncodeTM tapes.encodeTapes) + (TM.seqTM (TM.rewindWorkTM tapes.replacement) + (entryMissCleanupTM tapes.entry)) + hencodeReach hencodeHalt htailReach' + let finalCfg := TM.phase2Wrap (rewindEntryEncodeTM tapes.encodeTapes) + (TM.seqTM (TM.rewindWorkTM tapes.replacement) + (entryMissCleanupTM tapes.entry)) tailFinal + refine ⟨finalCfg, encodeTime + 1 + (rewindTime + 1 + cleanupTime), + ?_, hreach, ?_, ?_⟩ + · unfold entryReplaceCleanupTime + change encodeTime + 1 + (rewindTime + 1 + cleanupTime) ≤ + rewindEntryEncodeTime (entry.1, newValue) + (entryMissHeadBound entry queryBits initialWork tapes.entry.address) 1 + + 1 + (newValue.bits.length + 1 + 2 + 1 + + entryMissCleanupTime tapes.entry entry queryBits readyWork) + omega + · change (entryReplaceCleanupTM tapes).halted finalCfg + unfold entryReplaceCleanupTM + rw [TM.phase2Wrap_halted_iff] + exact htailHalt + · have hreadyGlobal : + EntryScanReady tapes.entry rest queryBits initialWork cleaned.work := by + refine ⟨hready.source, hready.address, hready.addressStart, + hready.value, hready.valueStart, hready.addressCounter, + hready.addressWidth, hready.valueCounter, hready.valueWidth, + hready.query, hready.queryStart, hready.result, hready.resultStart, + hready.parked, ?_⟩ + intro i hsource haddress hvalue haddressCounter haddressWidth + hvalueCounter hvalueWidth hquery hresult + have hbase : readyWork i = matchedWork i := by + simp [readyWork, entryReplaceReadyWork, haddress] + exact (hready.frame i hsource haddress hvalue haddressCounter + haddressWidth hvalueCounter hvalueWidth hquery hresult).trans + (hbase.trans (hmatch.frame i hsource haddress hvalue haddressCounter + haddressWidth hvalueCounter hvalueWidth hquery hresult)) + refine ⟨?_, hreadyGlobal, ?_, ?_⟩ + · change cleaned.input = inp₀ + exact hcleanedInput.trans (hrewoundInput.trans hencodedInput) + · have hreplacementReady : readyWork tapes.replacement = + matchedWork tapes.replacement := by + have hne : tapes.replacement ≠ tapes.entry.address := + tapes.replacement_ne 1 + change (if tapes.replacement = tapes.entry.address then + { head := entry.1.bits.length + 1, + cells := (matchedWork tapes.replacement).cells } + else matchedWork tapes.replacement) = matchedWork tapes.replacement + rw [if_neg hne] + exact (hready.frame tapes.replacement + (tapes.replacement_ne 0) (tapes.replacement_ne 1) + (tapes.replacement_ne 2) (tapes.replacement_ne 3) + (tapes.replacement_ne 4) (tapes.replacement_ne 5) + (tapes.replacement_ne 6) (tapes.replacement_ne 7) + (tapes.replacement_ne 8)).trans hreplacementReady + · change cleaned.output.HasBinaryPrefix + (emitted ++ Entry.encode (entry.1, newValue)) + rw [hcleanedOutput, hrewoundOutput] + exact hencodedOutput + +end Machine + +end RegisterStore + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryScan.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryScan.lean new file mode 100644 index 0000000000..70cce4fee1 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryScan.lean @@ -0,0 +1,112 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryScan.Defs +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryScan.Internal.Sem +public import +LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryScan.Internal.Bounds + +/-! +# Bounded sparse-entry scan + +This module exposes the complete time-bounded contract for the fixed sparse +store scanner. The runtime entry count is read from a canonical binary tape; +it is not hardwired into the finite controller. +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace RegisterStore + +namespace Machine + +/-- Scan a runtime-sized sparse store. A successful endpoint contains the +first matching entry's decoded value; a miss certifies that every address was +different. Input, output, and every work tape outside the ten-tape assignment +are preserved exactly. -/ +theorem entryScanTM_hoareTime_frame {n : ℕ} + (tapes : EntryScanTapes n) (store : Store) (queryBits : List Bool) + (initialWork : Fin n → Tape) (inp₀ out₀ : Tape) + (hready : EntryScanReady tapes.entry (store.flatMap Entry.encode) + queryBits initialWork initialWork) + (hcount : (initialWork tapes.count).HasBinaryNat store.length) + (hinput : TM.Parked inp₀) (houtput : TM.Parked out₀) : + (entryScanTM tapes).HoareTime + (fun inp work out => inp = inp₀ ∧ work = initialWork ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + EntryScanOutcome tapes store queryBits initialWork work ∧ + out = out₀) + (entryScanTime tapes queryBits store) := + entryScanTM_hoareTime_frame_internal tapes store queryBits initialWork + inp₀ out₀ hready hcount hinput houtput + +/-- The bounded scanner preserves one-way output safety. -/ +theorem entryScanTM_isTransducer {n : ℕ} (tapes : EntryScanTapes n) : + (entryScanTM tapes).IsTransducer := by + intro state iHead wHeads oHead + rcases state with phase | nested + · cases phase <;> cases oHead <;> + simp [entryScanTM, TM.allReadBack, TM.allIdle, TM.idleDir] <;> + split <;> simp + · rcases nested with body | pred + · simp only [entryScanTM] + split + · split <;> cases oHead <;> simp [TM.allReadBack, TM.idleDir] + · exact entryScanStepTM_isTransducer tapes.entry body iHead wHeads oHead + · simp only [entryScanTM] + split + · cases oHead <;> simp [TM.allReadBack, TM.idleDir] + · exact TM.binaryPredTM_isTransducer tapes.count pred iHead wHeads oHead + +/-- Coarse all-prefix auxiliary-space envelope for the bounded scan. -/ +theorem entryScanTM_prefix_withinAuxSpace {n : ℕ} + (tapes : EntryScanTapes n) (store : Store) (queryBits : List Bool) + (inputLength initialSpace time : ℕ) + (start current : Complexity.Cfg n (entryScanTM tapes).Q) + (hinitial : start.WithinAuxSpace inputLength initialSpace) + (hreach : (entryScanTM tapes).reachesIn time start current) + (htime : time ≤ entryScanTime tapes queryBits store) : + current.WithinAuxSpace inputLength + (initialSpace + entryScanTime tapes queryBits store) := + (hinitial.reachesIn hreach).mono le_rfl (by omega) + +/-- One invariant-preserving entry iteration is linear in the two serialized +words and the query width. -/ +theorem entryScanOneTime_le_linear {n : ℕ} + (tapes : EntryScanTapes n) (entry : Entry) + (queryBits : List Bool) : + entryScanOneTime tapes entry queryBits ≤ + 400 * (entry.1.bits.length + entry.2.bits.length + + queryBits.length + 1) := + entryScanOneTime_le_linear_internal tapes entry queryBits + +/-- A complete sparse scan is charged by the serialized entries actually +traversed, the repeated query width, and the binary remaining-count overhead. +In particular, it no longer multiplies every entry by a run-wide square-width +envelope. -/ +theorem entryScanTime_le_encoded {n : ℕ} + (tapes : EntryScanTapes n) (queryBits : List Bool) (store : Store) : + entryScanTime tapes queryBits store ≤ + 1000 * (encodedStoreLength store + + store.length * (queryBits.length + bitlen store.length + 2) + 1) := + entryScanTime_le_encoded_internal tapes queryBits store + +end Machine + +end RegisterStore + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryScan/Defs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryScan/Defs.lean new file mode 100644 index 0000000000..b59c14c242 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryScan/Defs.lean @@ -0,0 +1,194 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryScanStep.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryPred.Defs + +/-! +# Bounded sparse-entry scan — definitions + +`entryScanTM` is a fixed machine, independent of the runtime store size. A +canonical binary remaining-count tape bounds the scan. Each iteration runs the +checked entry step; a hit leaves its readable result at `1` and halts, while a +miss restores scratch, decrements the count, and loops. Count zero halts with +the blank miss result. +-/ + + +@[expose] public section + +namespace Complexity + +namespace RAM + +namespace RegisterStore + +namespace Machine + +/-- Entry-match tapes plus a distinct canonical binary remaining-count tape. -/ +structure EntryScanTapes (n : ℕ) where + /-- The nine tapes used by one decode/compare iteration. -/ + entry : EntryMatchTapes n + /-- Runtime remaining-entry count. -/ + count : Fin n + /-- The count tape is distinct from every entry-step tape. -/ + count_ne : ∀ i, count ≠ entry.idx i + +namespace EntryScanTapes + +/-- The count tape is distinct from the encoded entry source. -/ +theorem count_ne_source {n : ℕ} (tapes : EntryScanTapes n) : + tapes.count ≠ tapes.entry.source := tapes.count_ne 0 + +/-- The count tape is distinct from the readable match-result tape. -/ +theorem count_ne_result {n : ℕ} (tapes : EntryScanTapes n) : + tapes.count ≠ tapes.entry.result := tapes.count_ne 8 + +end EntryScanTapes + +/-- Finite controller phases outside the nested entry-step and predecessor +machines. -/ +inductive EntryScanPhase where + | test + | done + deriving DecidableEq + +/-- `EntryScanPhase` has exactly two states. -/ +instance instFintypeEntryScanPhase : Fintype EntryScanPhase where + elems := {.test, .done} + complete := fun phase => by cases phase <;> simp + +/-- State type of the bounded sparse-entry controller. -/ +abbrev EntryScanQ {n : ℕ} (tapes : EntryScanTapes n) := + EntryScanPhase ⊕ ((entryScanStepTM tapes.entry).Q ⊕ (TM.binaryPredTM tapes.count).Q) + +/-- Fixed bounded scan controlled by a runtime canonical binary count. + +The test phase halts on the empty encoding of zero. At positive count it runs +one entry step. A readable `1` result exits immediately with the decoded value; +the blank miss result enters binary predecessor and then loops. -/ +def entryScanTM {n : ℕ} (tapes : EntryScanTapes n) : TM n where + Q := EntryScanQ tapes + qstart := .inl .test + qhalt := .inl .done + δ := fun state iHead wHeads oHead => + match state with + | .inl .test => + if wHeads tapes.count = Γ.blank then + TM.allReadBack (.inl .done) iHead wHeads oHead + else + TM.allReadBack (.inr (.inl (entryScanStepTM tapes.entry).qstart)) + iHead wHeads oHead + | .inl .done => TM.allIdle (.inl .done) iHead wHeads oHead + | .inr (.inl q) => + if q = (entryScanStepTM tapes.entry).qhalt then + if wHeads tapes.entry.result = Γ.one then + TM.allReadBack (.inl .done) iHead wHeads oHead + else + TM.allReadBack (.inr (.inr (TM.binaryPredTM tapes.count).qstart)) + iHead wHeads oHead + else + let (q', workWrites, outputWrite, inputDir, workDirs, outputDir) := + (entryScanStepTM tapes.entry).δ q iHead wHeads oHead + (.inr (.inl q'), workWrites, outputWrite, inputDir, workDirs, outputDir) + | .inr (.inr q) => + if q = (TM.binaryPredTM tapes.count).qhalt then + TM.allReadBack (.inl .test) iHead wHeads oHead + else + let (q', workWrites, outputWrite, inputDir, workDirs, outputDir) := + (TM.binaryPredTM tapes.count).δ q iHead wHeads oHead + (.inr (.inr q'), workWrites, outputWrite, inputDir, workDirs, outputDir) + δ_right_of_start := by + intro state iHead wHeads oHead + match state with + | .inl .test => + dsimp only + split <;> exact TM.rightOfStart_allReadBack iHead wHeads oHead + | .inl .done => exact TM.rightOfStart_allIdle iHead wHeads oHead + | .inr (.inl q) => + dsimp only + split + · split <;> exact TM.rightOfStart_allReadBack iHead wHeads oHead + · exact (entryScanStepTM tapes.entry).δ_right_of_start q iHead wHeads oHead + | .inr (.inr q) => + dsimp only + split + · exact TM.rightOfStart_allReadBack iHead wHeads oHead + · exact (TM.binaryPredTM tapes.count).δ_right_of_start q iHead wHeads oHead + +/-- Canonical all-blank work family used only to state the iteration bound; +every tape head is at cell one. -/ +def entryScanCanonicalWork {n : ℕ} : Fin n → Tape := + Function.const (Fin n) TM.resetBinaryBlank + +/-- Work-value-independent bound for one invariant-preserving entry step. -/ +def entryScanOneTime {n : ℕ} (tapes : EntryScanTapes n) + (entry : Entry) (queryBits : List Bool) : ℕ := + entryScanStepTime tapes.entry entry queryBits entryScanCanonicalWork + +/-- Recursive bound for scanning a whole finite store. It reserves the miss +path at every entry, so it also bounds an earlier successful exit. -/ +def entryScanTime {n : ℕ} (tapes : EntryScanTapes n) + (queryBits : List Bool) : Store → ℕ + | [] => 1 + | entry :: rest => + 1 + entryScanOneTime tapes entry queryBits + 1 + + TM.binaryPredTime rest.length + 1 + entryScanTime tapes queryBits rest + +/-- Exact preservation predicate outside the ten tapes owned by the bounded +entry scanner. -/ +def EntryScanFrame {n : ℕ} (tapes : EntryScanTapes n) + (initialWork finalWork : Fin n → Tape) : Prop := + ∀ i, i ≠ tapes.count → i ≠ tapes.entry.source → + i ≠ tapes.entry.address → i ≠ tapes.entry.value → + i ≠ tapes.entry.addressCounter → i ≠ tapes.entry.addressWidth → + i ≠ tapes.entry.valueCounter → i ≠ tapes.entry.valueWidth → + i ≠ tapes.entry.query → i ≠ tapes.entry.result → + finalWork i = initialWork i + +/-- Successful bounded scan result. The decomposition records the first +matching entry, the decoded value remains readable, and the runtime count is +the number of entries beginning at that hit. -/ +structure EntryScanFound {n : ℕ} (tapes : EntryScanTapes n) + (store scanned : Store) (matched : Entry) (rest : Store) + (queryBits : List Bool) (initialWork hitBase finalWork : Fin n → Tape) : + Prop where + store_eq : store = scanned ++ matched :: rest + prefixMiss : ∀ prior ∈ scanned, prior.1.bits ≠ queryBits + hit : EntryScanHit tapes.entry matched (rest.flatMap Entry.encode) queryBits + hitBase finalWork + count : (finalWork tapes.count).HasBinaryNat (rest.length + 1) + frame : EntryScanFrame tapes initialWork finalWork + +/-- Unsuccessful bounded scan result. Every address is certified different, +the source and scratch invariant is exhausted, and the runtime count is zero. -/ +structure EntryScanMiss {n : ℕ} (tapes : EntryScanTapes n) + (store : Store) (queryBits : List Bool) + (initialWork readyBase finalWork : Fin n → Tape) : Prop where + notFound : ∀ entry ∈ store, entry.1.bits ≠ queryBits + ready : EntryScanReady tapes.entry [] queryBits readyBase finalWork + count : (finalWork tapes.count).HasBinaryNat 0 + frame : EntryScanFrame tapes initialWork finalWork + +/-- Complete semantic outcome of a bounded sparse-entry scan. -/ +def EntryScanOutcome {n : ℕ} (tapes : EntryScanTapes n) + (store : Store) (queryBits : List Bool) + (initialWork finalWork : Fin n → Tape) : Prop := + (∃ scanned matched rest hitBase, + EntryScanFound tapes store scanned matched rest queryBits initialWork + hitBase finalWork) ∨ + ∃ readyBase, + EntryScanMiss tapes store queryBits initialWork readyBase finalWork + +end Machine + +end RegisterStore + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryScan/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryScan/Internal.lean new file mode 100644 index 0000000000..8c00907302 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryScan/Internal.lean @@ -0,0 +1,12 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryScan.Internal.Bounds +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryScan.Internal.Ctrl +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryScan.Internal.Inv +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryScan.Internal.Sem + +/-! Supporting modules for Beyond the Bethe approximation of the permanent. -/ diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryScan/Internal/Bounds.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryScan/Internal/Bounds.lean new file mode 100644 index 0000000000..1eac8f1459 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryScan/Internal/Bounds.lean @@ -0,0 +1,161 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryMatch.Internal +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryScan.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryPred +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.ResetBinaryMany + +/-! +# Encoded-length bounds for sparse-entry scans -- proof internals + +The optimized word decoder leaves unary width markers. This makes decoding, +matching, and cleanup linear in the two words actually traversed. The final +scan theorem retains only the separate binary remaining-count charge. +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace RegisterStore + +namespace Machine + +private theorem entryMissBits_length_le_sum {n : ℕ} + (tapes : EntryMatchTapes n) (entry : Entry) + (queryBits : List Bool) (i : Fin n) : + (entryMissBits tapes entry queryBits i).length ≤ + bitlen entry.1 + bitlen entry.2 + 1 := by + unfold entryMissBits + split_ifs <;> + (try simp only [List.length_nil, List.length_replicate, + List.length_singleton, bitlen, Nat.size_eq_bits_len]) <;> omega + +private theorem entryMissCleanupTime_canonical_le_linear {n : ℕ} + (tapes : EntryMatchTapes n) (entry : Entry) + (queryBits : List Bool) : + entryMissCleanupTime tapes entry queryBits + (entryScanCanonicalWork (n := n)) ≤ + 300 * (entry.1.bits.length + entry.2.bits.length + + queryBits.length + 1) := by + let matchTime := entryMatchReadTime entry queryBits + have hmatch : matchTime ≤ + 5 * entry.1.bits.length + 3 * entry.2.bits.length + + queryBits.length + 18 := + entryMatchReadTime_le_linear_internal entry queryBits + have hreset := TM.resetBinaryWorkManyTime_le + (entryMissTargets tapes) (entryMissBits tapes entry queryBits) + (entryMissHeadBound entry queryBits (entryScanCanonicalWork (n := n))) + (1 + matchTime) (bitlen entry.1 + bitlen entry.2 + 1) + (fun i _ => by + unfold entryMissHeadBound entryScanCanonicalWork + simp [TM.resetBinaryBlank, Tape.move, Tape.init] + dsimp only [matchTime] + exact le_rfl) + (fun i _ => entryMissBits_length_le_sum tapes entry queryBits i) + have htargets : (entryMissTargets tapes).length = 7 := by + simp [entryMissTargets] + rw [htargets] at hreset + have hreset' : + TM.resetBinaryWorkManyTime (entryMissBits tapes entry queryBits) + (fun _ => 1 + matchTime) (entryMissTargets tapes) ≤ + 7 * (1 + matchTime + + 2 * (bitlen entry.1 + bitlen entry.2 + 1) + 9) + 1 := by + simpa [entryMissHeadBound, entryScanCanonicalWork, + TM.resetBinaryBlank, Tape.move, Tape.init] using hreset + unfold entryMissCleanupTime entryMissHeadBound entryScanCanonicalWork + simp only [Function.const_apply, TM.resetBinaryBlank, Tape.move, Tape.init, + Nat.zero_add] + dsimp only [matchTime] at hmatch hreset' + have haddressWidth : bitlen entry.1 = entry.1.bits.length := by + exact (Nat.size_eq_bits_len entry.1).symm + have hvalueWidth : bitlen entry.2 = entry.2.bits.length := by + exact (Nat.size_eq_bits_len entry.2).symm + rw [haddressWidth, hvalueWidth] at hreset' + omega + +theorem entryScanOneTime_le_linear_internal {n : ℕ} + (tapes : EntryScanTapes n) (entry : Entry) + (queryBits : List Bool) : + entryScanOneTime tapes entry queryBits ≤ + 400 * (entry.1.bits.length + entry.2.bits.length + + queryBits.length + 1) := by + have hmatch := entryMatchReadTime_le_linear_internal entry queryBits + have hcleanup := entryMissCleanupTime_canonical_le_linear tapes.entry entry + queryBits + unfold entryScanOneTime entryScanStepTime entryScanBranchTime + TM.branchWorkSymbolTime + have hmax : max 1 + (entryMissCleanupTime tapes.entry entry queryBits + (entryScanCanonicalWork (n := n))) ≤ + 300 * (entry.1.bits.length + entry.2.bits.length + + queryBits.length + 1) := by + apply max_le + · nlinarith + · exact hcleanup + omega + +theorem entryScanTime_le_encoded_internal {n : ℕ} + (tapes : EntryScanTapes n) (queryBits : List Bool) (store : Store) : + entryScanTime tapes queryBits store ≤ + 1000 * (encodedStoreLength store + + store.length * (queryBits.length + bitlen store.length + 2) + 1) := by + induction store with + | nil => simp [entryScanTime, encodedStoreLength] + | cons entry rest ih => + have hone := entryScanOneTime_le_linear_internal tapes entry queryBits + have hpred := TM.binaryPredTime_le rest.length + have hsize : bitlen rest.length ≤ bitlen (rest.length + 1) := by + unfold bitlen + exact Nat.size_le_size (by omega) + have hfactor : queryBits.length + bitlen rest.length + 2 ≤ + queryBits.length + bitlen (rest.length + 1) + 2 := by omega + have hinside : encodedStoreLength rest + + rest.length * (queryBits.length + bitlen rest.length + 2) + 1 ≤ + encodedStoreLength rest + + rest.length * + (queryBits.length + bitlen (rest.length + 1) + 2) + 1 := by + exact Nat.add_le_add_right + (Nat.add_le_add_left (Nat.mul_le_mul_left rest.length hfactor) _) + 1 + have htail : entryScanTime tapes queryBits rest ≤ + 1000 * (encodedStoreLength rest + + rest.length * + (queryBits.length + bitlen (rest.length + 1) + 2) + 1) := + le_trans ih (Nat.mul_le_mul_left 1000 hinside) + have hentryLength : (Entry.encode entry).length = + 2 * entry.1.bits.length + 2 * entry.2.bits.length + 2 := by + rw [Entry.encode_length] + simp only [bitlen, Nat.size_eq_bits_len] + simp only [entryScanTime, List.length_cons] + have hencoded : encodedStoreLength (entry :: rest) = + (Entry.encode entry).length + encodedStoreLength rest := by + simp [encodedStoreLength] + rw [hencoded, hentryLength] + simp only [bitlen] at hsize ⊢ + have hmul : (rest.length + 1) * + (queryBits.length + (rest.length + 1).size + 2) = + rest.length * + (queryBits.length + (rest.length + 1).size + 2) + + (queryBits.length + (rest.length + 1).size + 2) := by ring + rw [hmul] + simp only [bitlen] at htail + omega + +end Machine + +end RegisterStore + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryScan/Internal/Ctrl.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryScan/Internal/Ctrl.lean new file mode 100644 index 0000000000..3dff68295b --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryScan/Internal/Ctrl.lean @@ -0,0 +1,219 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryScan.Defs + +/-! +# Bounded sparse-entry scan — controller internals +-/ + + +@[expose] public section + +namespace Complexity + +namespace RAM + +namespace RegisterStore + +namespace Machine + +variable {n : ℕ} + +/-- Embed an entry-step configuration in the bounded scan controller. -/ +def entryScanBodyWrap (tapes : EntryScanTapes n) + (cfg : Complexity.Cfg n (entryScanStepTM tapes.entry).Q) : + Complexity.Cfg n (entryScanTM tapes).Q where + state := .inr (.inl cfg.state) + input := cfg.input + work := cfg.work + output := cfg.output + +/-- Embed a binary-predecessor configuration in the bounded scan controller. -/ +def entryScanPredWrap (tapes : EntryScanTapes n) + (cfg : Complexity.Cfg n (TM.binaryPredTM tapes.count).Q) : + Complexity.Cfg n (entryScanTM tapes).Q where + state := .inr (.inr cfg.state) + input := cfg.input + work := cfg.work + output := cfg.output + +/-- Canonical halted controller configuration with the supplied tapes. -/ +def entryScanDoneCfg (tapes : EntryScanTapes n) + (inp : Tape) (work : Fin n → Tape) (out : Tape) : + Complexity.Cfg n (entryScanTM tapes).Q where + state := .inl .done + input := inp + work := work + output := out + +/-- Canonical loop-test controller configuration with the supplied tapes. -/ +def entryScanTestCfg (tapes : EntryScanTapes n) + (inp : Tape) (work : Fin n → Tape) (out : Tape) : + Complexity.Cfg n (entryScanTM tapes).Q where + state := .inl .test + input := inp + work := work + output := out + +private theorem entryScanTM_body_step + (tapes : EntryScanTapes n) + {cfg next : Complexity.Cfg n (entryScanStepTM tapes.entry).Q} + (hstep : (entryScanStepTM tapes.entry).step cfg = some next) : + (entryScanTM tapes).step (entryScanBodyWrap tapes cfg) = + some (entryScanBodyWrap tapes next) := by + have hne : cfg.state ≠ (entryScanStepTM tapes.entry).qhalt := + TM.state_ne_qhalt_of_step hstep + rw [TM.step, if_neg (by + simp [entryScanBodyWrap, entryScanTM])] + simp only [entryScanBodyWrap, entryScanTM, hne, ↓reduceIte] + rw [TM.step, if_neg hne] at hstep + revert hstep + generalize haction : (entryScanStepTM tapes.entry).δ cfg.state cfg.input.read + (fun i => (cfg.work i).read) cfg.output.read = action + obtain ⟨q', workWrites, outputWrite, inputDir, workDirs, outputDir⟩ := action + simp only [haction] + intro hstep + cases Option.some.inj hstep + rfl + +private theorem entryScanTM_pred_step + (tapes : EntryScanTapes n) + {cfg next : Complexity.Cfg n (TM.binaryPredTM tapes.count).Q} + (hstep : (TM.binaryPredTM tapes.count).step cfg = some next) : + (entryScanTM tapes).step (entryScanPredWrap tapes cfg) = + some (entryScanPredWrap tapes next) := by + have hne : cfg.state ≠ (TM.binaryPredTM tapes.count).qhalt := + TM.state_ne_qhalt_of_step hstep + rw [TM.step, if_neg (by + simp [entryScanPredWrap, entryScanTM])] + simp only [entryScanPredWrap, entryScanTM, hne, ↓reduceIte] + rw [TM.step, if_neg hne] at hstep + revert hstep + generalize haction : (TM.binaryPredTM tapes.count).δ cfg.state cfg.input.read + (fun i => (cfg.work i).read) cfg.output.read = action + obtain ⟨q', workWrites, outputWrite, inputDir, workDirs, outputDir⟩ := action + simp only [haction] + intro hstep + cases Option.some.inj hstep + rfl + +theorem entryScanTM_body_reachesIn_internal + (tapes : EntryScanTapes n) {time : ℕ} + {cfg next : Complexity.Cfg n (entryScanStepTM tapes.entry).Q} + (hreach : (entryScanStepTM tapes.entry).reachesIn time cfg next) : + (entryScanTM tapes).reachesIn time + (entryScanBodyWrap tapes cfg) (entryScanBodyWrap tapes next) := + TM.reachesIn_map (entryScanBodyWrap tapes) + (fun _ _ => entryScanTM_body_step tapes) hreach + +theorem entryScanTM_pred_reachesIn_internal + (tapes : EntryScanTapes n) {time : ℕ} + {cfg next : Complexity.Cfg n (TM.binaryPredTM tapes.count).Q} + (hreach : (TM.binaryPredTM tapes.count).reachesIn time cfg next) : + (entryScanTM tapes).reachesIn time + (entryScanPredWrap tapes cfg) (entryScanPredWrap tapes next) := + TM.reachesIn_map (entryScanPredWrap tapes) + (fun _ _ => entryScanTM_pred_step tapes) hreach + +theorem entryScanTM_step_test_zero_internal + (tapes : EntryScanTapes n) (inp : Tape) (work : Fin n → Tape) (out : Tape) + (hcount : (work tapes.count).read = Γ.blank) + (hinput : TM.Parked inp) (hwork : ∀ i, TM.Parked (work i)) + (houtput : TM.Parked out) : + (entryScanTM tapes).step + { state := .inl .test, input := inp, work := work, output := out } = + some { state := .inl .done, input := inp, work := work, output := out } := by + rw [TM.step, if_neg (by simp [entryScanTM])] + simp only [entryScanTM, hcount, ↓reduceIte] + refine congrArg some (Complexity.Cfg.ext rfl ?_ ?_ ?_) + · exact hinput.move_idle + · funext i + exact (hwork i).writeAndMove_readBack_idle + · exact houtput.writeAndMove_readBack_idle + +theorem entryScanTM_step_test_positive_internal + (tapes : EntryScanTapes n) (inp : Tape) (work : Fin n → Tape) (out : Tape) + (hcount : (work tapes.count).read ≠ Γ.blank) + (hinput : TM.Parked inp) (hwork : ∀ i, TM.Parked (work i)) + (houtput : TM.Parked out) : + (entryScanTM tapes).step + { state := .inl .test, input := inp, work := work, output := out } = + some (entryScanBodyWrap tapes + { state := (entryScanStepTM tapes.entry).qstart + input := inp, work := work, output := out }) := by + rw [TM.step, if_neg (by simp [entryScanTM])] + simp only [entryScanTM, hcount, ↓reduceIte, entryScanBodyWrap] + refine congrArg some (Complexity.Cfg.ext rfl ?_ ?_ ?_) + · exact hinput.move_idle + · funext i + exact (hwork i).writeAndMove_readBack_idle + · exact houtput.writeAndMove_readBack_idle + +theorem entryScanTM_step_body_hit_internal + (tapes : EntryScanTapes n) + (cfg : Complexity.Cfg n (entryScanStepTM tapes.entry).Q) + (hhalt : (entryScanStepTM tapes.entry).halted cfg) + (hresult : (cfg.work tapes.entry.result).read = Γ.one) + (hinput : TM.Parked cfg.input) (hwork : ∀ i, TM.Parked (cfg.work i)) + (houtput : TM.Parked cfg.output) : + (entryScanTM tapes).step (entryScanBodyWrap tapes cfg) = + some (entryScanDoneCfg tapes cfg.input cfg.work cfg.output) := by + rw [TM.step, if_neg (by simp [entryScanBodyWrap, entryScanTM])] + simp only [entryScanBodyWrap, entryScanDoneCfg, entryScanTM, hhalt, + hresult, ↓reduceIte] + refine congrArg some (Complexity.Cfg.ext rfl ?_ ?_ ?_) + · exact hinput.move_idle + · funext i + exact (hwork i).writeAndMove_readBack_idle + · exact houtput.writeAndMove_readBack_idle + +theorem entryScanTM_step_body_miss_internal + (tapes : EntryScanTapes n) + (cfg : Complexity.Cfg n (entryScanStepTM tapes.entry).Q) + (hhalt : (entryScanStepTM tapes.entry).halted cfg) + (hresult : (cfg.work tapes.entry.result).read ≠ Γ.one) + (hinput : TM.Parked cfg.input) (hwork : ∀ i, TM.Parked (cfg.work i)) + (houtput : TM.Parked cfg.output) : + (entryScanTM tapes).step (entryScanBodyWrap tapes cfg) = + some (entryScanPredWrap tapes + { state := (TM.binaryPredTM tapes.count).qstart + input := cfg.input, work := cfg.work, output := cfg.output }) := by + rw [TM.step, if_neg (by simp [entryScanBodyWrap, entryScanTM])] + simp only [entryScanBodyWrap, entryScanTM, hhalt, hresult, ↓reduceIte, + entryScanPredWrap] + refine congrArg some (Complexity.Cfg.ext rfl ?_ ?_ ?_) + · exact hinput.move_idle + · funext i + exact (hwork i).writeAndMove_readBack_idle + · exact houtput.writeAndMove_readBack_idle + +theorem entryScanTM_step_pred_halt_internal + (tapes : EntryScanTapes n) + (cfg : Complexity.Cfg n (TM.binaryPredTM tapes.count).Q) + (hhalt : (TM.binaryPredTM tapes.count).halted cfg) + (hinput : TM.Parked cfg.input) (hwork : ∀ i, TM.Parked (cfg.work i)) + (houtput : TM.Parked cfg.output) : + (entryScanTM tapes).step (entryScanPredWrap tapes cfg) = + some (entryScanTestCfg tapes cfg.input cfg.work cfg.output) := by + rw [TM.step, if_neg (by simp [entryScanPredWrap, entryScanTM])] + simp only [entryScanPredWrap, entryScanTestCfg, entryScanTM, hhalt, + ↓reduceIte] + refine congrArg some (Complexity.Cfg.ext rfl ?_ ?_ ?_) + · exact hinput.move_idle + · funext i + exact (hwork i).writeAndMove_readBack_idle + · exact houtput.writeAndMove_readBack_idle + +end Machine + +end RegisterStore + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryScan/Internal/Inv.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryScan/Internal/Inv.lean new file mode 100644 index 0000000000..082439b030 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryScan/Internal/Inv.lean @@ -0,0 +1,236 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryScan.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.ResetBinaryMany +import Mathlib.Tactic.FinCases +import Mathlib.Data.Rat.Cast.Order +import Mathlib.Tactic.NormNum.Abs +import Mathlib.Tactic.NormNum.DivMod +import Mathlib.Tactic.NormNum.OfScientific + +/-! +# Bounded sparse-entry scan — invariant internals +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace RegisterStore + +namespace Machine + +variable {n : ℕ} + +private theorem resetBinaryBlank_head : TM.resetBinaryBlank.head = 1 := by + simp [TM.resetBinaryBlank, Tape.init, Tape.move] + +private theorem parked_of_hasBinaryNat {t : Tape} {value : ℕ} + (h : t.HasBinaryNat value) : TM.Parked t := by + exact ⟨by simp [Tape.HasBinaryNat, Tape.HasBinaryString] at h; omega, + h.2.hasBinaryContent.cells_ne_start⟩ + +private theorem EntryScanReady.target_head + {tapes : EntryMatchTapes n} {remaining queryBits : List Bool} + {initialWork work : Fin n → Tape} + (h : EntryScanReady tapes remaining queryBits initialWork work) : + ∀ i, i ∈ entryMissTargets tapes → (work i).head = 1 := by + intro i hi + obtain ⟨slot, rfl⟩ := List.mem_ofFn.mp hi + fin_cases slot + · simpa using h.address.1 + · simpa using h.value.1 + · exact h.addressCounter.2.1 + · exact h.addressWidth.2.1 + · exact h.valueCounter.2.1 + · exact h.valueWidth.2.1 + · simpa using h.result.1 + +theorem EntryScanReady.stepTime_eq_oneTime_internal + {tapes : EntryScanTapes n} {entry : Entry} {rest queryBits : List Bool} + {initialWork work : Fin n → Tape} + (h : EntryScanReady tapes.entry (Entry.encode entry ++ rest) queryBits + initialWork work) : + entryScanStepTime tapes.entry entry queryBits work = + entryScanOneTime tapes entry queryBits := by + have hquery : + entryMissHeadBound entry queryBits work tapes.entry.query = + entryMissHeadBound entry queryBits entryScanCanonicalWork + tapes.entry.query := by + simp [entryMissHeadBound, entryScanCanonicalWork, h.query.1, + resetBinaryBlank_head] + have htargets : ∀ i, i ∈ entryMissTargets tapes.entry → + entryMissHeadBound entry queryBits work i = + entryMissHeadBound entry queryBits entryScanCanonicalWork i := by + intro i hi + simp [entryMissHeadBound, entryScanCanonicalWork, h.target_head i hi, + resetBinaryBlank_head] + have hreset := TM.resetBinaryWorkManyTime_congr_headBound + (entryMissTargets tapes.entry) (entryMissBits tapes.entry entry queryBits) + (entryMissHeadBound entry queryBits work) + (entryMissHeadBound entry queryBits entryScanCanonicalWork) htargets + unfold entryScanOneTime entryScanStepTime entryScanBranchTime + entryMissCleanupTime TM.branchWorkSymbolTime + rw [hquery, hreset] + +/-- Forget an older frame base and use the current work family as the exact +base for the next loop iteration. -/ +theorem EntryScanReady.rebase_self_internal + {tapes : EntryMatchTapes n} {remaining queryBits : List Bool} + {initialWork work : Fin n → Tape} + (h : EntryScanReady tapes remaining queryBits initialWork work) : + EntryScanReady tapes remaining queryBits work work := by + refine ⟨h.source, h.address, h.addressStart, h.value, h.valueStart, + h.addressCounter, h.addressWidth, h.valueCounter, h.valueWidth, + h.query, h.queryStart, h.result, h.resultStart, h.parked, ?_⟩ + intro i _ _ _ _ _ _ _ _ _ + rfl + +/-- Changing only the distinct count tape preserves the entry-loop invariant; +the new count representation supplies parkedness for that tape. -/ +theorem EntryScanReady.change_count_internal + {tapes : EntryScanTapes n} {remaining queryBits : List Bool} + {initialWork work finalWork : Fin n → Tape} {count : ℕ} + (h : EntryScanReady tapes.entry remaining queryBits initialWork work) + (hother : ∀ i, i ≠ tapes.count → finalWork i = work i) + (hcount : (finalWork tapes.count).HasBinaryNat count) : + EntryScanReady tapes.entry remaining queryBits finalWork finalWork := by + have hsource := hother tapes.entry.source (Ne.symm (tapes.count_ne 0)) + have haddress := hother tapes.entry.address (Ne.symm (tapes.count_ne 1)) + have hvalue := hother tapes.entry.value (Ne.symm (tapes.count_ne 2)) + have haddressCounter := + hother tapes.entry.addressCounter (Ne.symm (tapes.count_ne 3)) + have haddressWidth := + hother tapes.entry.addressWidth (Ne.symm (tapes.count_ne 4)) + have hvalueCounter := + hother tapes.entry.valueCounter (Ne.symm (tapes.count_ne 5)) + have hvalueWidth := + hother tapes.entry.valueWidth (Ne.symm (tapes.count_ne 6)) + have hquery := hother tapes.entry.query (Ne.symm (tapes.count_ne 7)) + have hresult := hother tapes.entry.result (Ne.symm (tapes.count_ne 8)) + refine ⟨?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_⟩ + · rw [hsource] + exact h.source + · rw [haddress] + exact h.address + · rw [haddress] + exact h.addressStart + · rw [hvalue] + exact h.value + · rw [hvalue] + exact h.valueStart + · rw [haddressCounter] + exact h.addressCounter + · rw [haddressWidth] + exact h.addressWidth + · rw [hvalueCounter] + exact h.valueCounter + · rw [hvalueWidth] + exact h.valueWidth + · rw [hquery] + exact h.query + · rw [hquery] + exact h.queryStart + · rw [hresult] + exact h.result + · rw [hresult] + exact h.resultStart + · intro i + by_cases hi : i = tapes.count + · subst i + exact parked_of_hasBinaryNat hcount + · rw [hother i hi] + exact h.parked i + · intro i _ _ _ _ _ _ _ _ _ + rfl + +/-- An entry-ready frame implies the scanner's weaker ten-tape frame. -/ +theorem EntryScanReady.scanFrame_internal + {tapes : EntryScanTapes n} {remaining queryBits : List Bool} + {initialWork finalWork : Fin n → Tape} + (h : EntryScanReady tapes.entry remaining queryBits initialWork finalWork) : + EntryScanFrame tapes initialWork finalWork := by + intro i _ hsource haddress hvalue haddressCounter haddressWidth + hvalueCounter hvalueWidth hquery hresult + exact h.frame i hsource haddress hvalue haddressCounter haddressWidth + hvalueCounter hvalueWidth hquery hresult + +/-- A successful entry endpoint implies the scanner's ten-tape frame. -/ +theorem EntryScanHit.scanFrame_internal + {tapes : EntryScanTapes n} {entry : Entry} {rest queryBits : List Bool} + {initialWork finalWork : Fin n → Tape} + (h : EntryScanHit tapes.entry entry rest queryBits initialWork finalWork) : + EntryScanFrame tapes initialWork finalWork := by + intro i _ hsource haddress hvalue haddressCounter haddressWidth + hvalueCounter hvalueWidth hquery hresult + exact h.frame i hsource haddress hvalue haddressCounter haddressWidth + hvalueCounter hvalueWidth hquery hresult + +/-- Scanner frames compose across loop iterations. -/ +theorem EntryScanFrame.trans_internal + {tapes : EntryScanTapes n} {work₀ work₁ work₂ : Fin n → Tape} + (h₁ : EntryScanFrame tapes work₀ work₁) + (h₂ : EntryScanFrame tapes work₁ work₂) : + EntryScanFrame tapes work₀ work₂ := by + intro i hcount hsource haddress hvalue haddressCounter haddressWidth + hvalueCounter hvalueWidth hquery hresult + exact (h₂ i hcount hsource haddress hvalue haddressCounter haddressWidth + hvalueCounter hvalueWidth hquery hresult).trans + (h₁ i hcount hsource haddress hvalue haddressCounter haddressWidth + hvalueCounter hvalueWidth hquery hresult) + +/-- The count tape is in the frame of every entry-ready endpoint. -/ +theorem EntryScanReady.count_eq_internal + {tapes : EntryScanTapes n} {remaining queryBits : List Bool} + {initialWork finalWork : Fin n → Tape} + (h : EntryScanReady tapes.entry remaining queryBits initialWork finalWork) : + finalWork tapes.count = initialWork tapes.count := + h.frame tapes.count (tapes.count_ne 0) (tapes.count_ne 1) + (tapes.count_ne 2) (tapes.count_ne 3) (tapes.count_ne 4) + (tapes.count_ne 5) (tapes.count_ne 6) (tapes.count_ne 7) + (tapes.count_ne 8) + +/-- The count tape is in the frame of every successful entry endpoint. -/ +theorem EntryScanHit.count_eq_internal + {tapes : EntryScanTapes n} {entry : Entry} {rest queryBits : List Bool} + {initialWork finalWork : Fin n → Tape} + (h : EntryScanHit tapes.entry entry rest queryBits initialWork finalWork) : + finalWork tapes.count = initialWork tapes.count := + h.frame tapes.count (tapes.count_ne 0) (tapes.count_ne 1) + (tapes.count_ne 2) (tapes.count_ne 3) (tapes.count_ne 4) + (tapes.count_ne 5) (tapes.count_ne 6) (tapes.count_ne 7) + (tapes.count_ne 8) + +/-- A restored miss invariant exposes a blank readable result. -/ +theorem EntryScanReady.result_read_blank_internal + {tapes : EntryMatchTapes n} {remaining queryBits : List Bool} + {initialWork finalWork : Fin n → Tape} + (h : EntryScanReady tapes remaining queryBits initialWork finalWork) : + (finalWork tapes.result).read = Γ.blank := + h.result.read_blank + +/-- A successful hit exposes the readable one flag. -/ +theorem EntryScanHit.result_read_one_internal + {tapes : EntryMatchTapes n} {entry : Entry} {rest queryBits : List Bool} + {initialWork finalWork : Fin n → Tape} + (h : EntryScanHit tapes entry rest queryBits initialWork finalWork) : + (finalWork tapes.result).read = Γ.one := by + rw [Tape.read, h.result.1] + simpa [Γ.ofBool] using h.result.2.1 0 (by simp) + +end Machine + +end RegisterStore + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryScan/Internal/Sem.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryScan/Internal/Sem.lean new file mode 100644 index 0000000000..893094e907 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryScan/Internal/Sem.lean @@ -0,0 +1,225 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryScan.Internal.Ctrl +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryScan.Internal.Inv +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.WorkBranch +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryPred +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryScanStep + +/-! +# Bounded sparse-entry scan — semantic internals +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace RegisterStore + +namespace Machine + +variable {n : ℕ} + +theorem entryScanTM_hoareTime_frame_internal + (tapes : EntryScanTapes n) (store : Store) (queryBits : List Bool) + (initialWork : Fin n → Tape) (inp₀ out₀ : Tape) + (hready : EntryScanReady tapes.entry (store.flatMap Entry.encode) + queryBits initialWork initialWork) + (hcount : (initialWork tapes.count).HasBinaryNat store.length) + (hinput : TM.Parked inp₀) (houtput : TM.Parked out₀) : + (entryScanTM tapes).HoareTime + (fun inp work out => inp = inp₀ ∧ work = initialWork ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + EntryScanOutcome tapes store queryBits initialWork work ∧ + out = out₀) + (entryScanTime tapes queryBits store) := by + intro inp work out hpre + rcases hpre with ⟨hinp, hwork, hout⟩ + subst inp + subst work + subst out + induction store generalizing initialWork with + | nil => + have hblank : (initialWork tapes.count).read = Γ.blank := + hcount.read_eq_blank_iff.mpr rfl + have hstep := entryScanTM_step_test_zero_internal tapes inp₀ initialWork + out₀ hblank hinput hready.parked houtput + refine ⟨entryScanDoneCfg tapes inp₀ initialWork out₀, 1, ?_, + .step hstep .zero, ?_, rfl, ?_, rfl⟩ + · simp [entryScanTime] + · rfl + · exact Or.inr ⟨initialWork, ⟨by simp, hready, hcount, by + intro i _ _ _ _ _ _ _ _ _ _ + simp [entryScanDoneCfg]⟩⟩ + | cons entry rest ih => + have hreadyStep : + EntryScanReady tapes.entry + (Entry.encode entry ++ rest.flatMap Entry.encode) queryBits + initialWork initialWork := by + simpa using hready + have hcountPositive : + (initialWork tapes.count).HasBinaryNat (rest.length + 1) := by + simpa using hcount + have hnonblank : (initialWork tapes.count).read ≠ Γ.blank := by + intro hblank + have hzero := hcountPositive.read_eq_blank_iff.mp hblank + omega + have htest := entryScanTM_step_test_positive_internal tapes inp₀ + initialWork out₀ hnonblank hinput hready.parked houtput + have hstepContract := entryScanStepTM_hoareTime_frame tapes.entry entry + (rest.flatMap Entry.encode) queryBits initialWork initialWork inp₀ out₀ + hreadyStep hinput houtput + obtain ⟨bodyDone, bodyTime, hbodyTime, hbodyReach, hbodyHalt, + hbodyInput, hstepOutcome, hbodyOutput⟩ := + hstepContract inp₀ initialWork out₀ ⟨rfl, rfl, rfl⟩ + have hbodyTime' : + bodyTime ≤ entryScanOneTime tapes entry queryBits := by + simpa [hreadyStep.stepTime_eq_oneTime_internal] using hbodyTime + have hbodyReach' := + entryScanTM_body_reachesIn_internal tapes hbodyReach + rcases hstepOutcome with hhitTagged | hmissTagged + · rcases hhitTagged with ⟨_, hhit⟩ + have hfinish := entryScanTM_step_body_hit_internal tapes bodyDone + hbodyHalt hhit.result_read_one_internal + (hbodyInput ▸ hinput) hhit.parked (hbodyOutput ▸ houtput) + have hprefix : (entryScanTM tapes).reachesIn (bodyTime + 1) + (entryScanTestCfg tapes inp₀ initialWork out₀) + (entryScanBodyWrap tapes bodyDone) := + .step htest hbodyReach' + have hreach : (entryScanTM tapes).reachesIn + (bodyTime + 1 + 1) + (entryScanTestCfg tapes inp₀ initialWork out₀) + (entryScanDoneCfg tapes bodyDone.input bodyDone.work + bodyDone.output) := + TM.reachesIn_trans _ hprefix (.step hfinish .zero) + refine ⟨entryScanDoneCfg tapes bodyDone.input bodyDone.work + bodyDone.output, bodyTime + 1 + 1, ?_, ?_, rfl, ?_, ?_, ?_⟩ + · simp only [entryScanTime] + omega + · simpa [entryScanTestCfg, entryScanTM] using hreach + · simpa [entryScanDoneCfg] using hbodyInput + · exact Or.inl ⟨[], entry, rest, initialWork, ⟨by simp, by simp, + hhit, by + simpa [entryScanDoneCfg, hhit.count_eq_internal] using + hcountPositive, + hhit.scanFrame_internal⟩⟩ + · simpa [entryScanDoneCfg] using hbodyOutput + · rcases hmissTagged with ⟨hneq, hmiss⟩ + have hdispatch := entryScanTM_step_body_miss_internal tapes bodyDone + hbodyHalt (by + rw [hmiss.result_read_blank_internal] + decide) + (hbodyInput ▸ hinput) hmiss.parked (hbodyOutput ▸ houtput) + have hcountBody : + (bodyDone.work tapes.count).HasBinaryNat (rest.length + 1) := by + rw [hmiss.count_eq_internal] + exact hcountPositive + obtain ⟨predDone, hpredReach, hpredHalt, hpredInput, + hpredOther, hpredCount, hpredOutput⟩ := + TM.binaryPredTM_reachesIn_frame tapes.count rest.length + bodyDone.input bodyDone.work bodyDone.output hcountBody + (hbodyInput ▸ hinput.read_ne_start) + (fun i _ => (hmiss.parked i).read_ne_start) + (hbodyOutput ▸ houtput.read_ne_start) + have hpredReach' := + entryScanTM_pred_reachesIn_internal tapes hpredReach + have hreadyPred := hmiss.change_count_internal hpredOther hpredCount + have hloop := entryScanTM_step_pred_halt_internal tapes predDone + hpredHalt (by + rw [hpredInput, hbodyInput] + exact hinput) + hreadyPred.parked (by + rw [hpredOutput, hbodyOutput] + exact houtput) + have hpredInput0 : predDone.input = inp₀ := + hpredInput.trans hbodyInput + have hpredOutput0 : predDone.output = out₀ := + hpredOutput.trans hbodyOutput + have hloop' : (entryScanTM tapes).step + (entryScanPredWrap tapes predDone) = + some (entryScanTestCfg tapes inp₀ predDone.work out₀) := by + simpa [hpredInput0, hpredOutput0] using hloop + obtain ⟨final, recTime, hrecTime, hrecReach, hrecHalt, + hrecInput, hrecOutcome, hrecOutput⟩ := + ih predDone.work hreadyPred hpredCount + have hentryFrame : + EntryScanFrame tapes initialWork bodyDone.work := + hmiss.scanFrame_internal + have hpredFrame : + EntryScanFrame tapes bodyDone.work predDone.work := by + intro i hcountIdx _ _ _ _ _ _ _ _ _ + exact hpredOther i hcountIdx + have hphaseFrame : + EntryScanFrame tapes initialWork predDone.work := + hentryFrame.trans_internal hpredFrame + have hprefix : (entryScanTM tapes).reachesIn + (bodyTime + 1 + 1 + TM.binaryPredTime rest.length + 1) + (entryScanTestCfg tapes inp₀ initialWork out₀) + (entryScanTestCfg tapes inp₀ predDone.work out₀) := by + have htestBody : (entryScanTM tapes).reachesIn (bodyTime + 1) + (entryScanTestCfg tapes inp₀ initialWork out₀) + (entryScanBodyWrap tapes bodyDone) := + .step htest hbodyReach' + have htoPred : (entryScanTM tapes).reachesIn + (bodyTime + 1 + 1) + (entryScanTestCfg tapes inp₀ initialWork out₀) + (entryScanPredWrap tapes + { state := (TM.binaryPredTM tapes.count).qstart + input := bodyDone.input + work := bodyDone.work + output := bodyDone.output }) := + TM.reachesIn_trans _ htestBody (.step hdispatch .zero) + have hthroughPred := + TM.reachesIn_trans (entryScanTM tapes) htoPred hpredReach' + have hthroughLoop := TM.reachesIn_trans (entryScanTM tapes) + hthroughPred (.step hloop' .zero) + simpa [Nat.add_assoc] using hthroughLoop + have hreach := + TM.reachesIn_trans (entryScanTM tapes) hprefix hrecReach + refine ⟨final, + bodyTime + 1 + 1 + TM.binaryPredTime rest.length + 1 + recTime, + ?_, ?_, hrecHalt, hrecInput, ?_, hrecOutput⟩ + · simp only [entryScanTime] + omega + · simpa [entryScanTestCfg, entryScanTM, Nat.add_assoc] using hreach + · rcases hrecOutcome with hfound | hnone + · rcases hfound with ⟨scanned, matched, suffix, hitBase, hfound⟩ + exact Or.inl ⟨entry :: scanned, matched, suffix, hitBase, + ⟨by simp [hfound.store_eq], by + intro prior hprior + simp only [List.mem_cons] at hprior + rcases hprior with rfl | hprior + · exact hneq + · exact hfound.prefixMiss prior hprior, + hfound.hit, hfound.count, + hphaseFrame.trans_internal hfound.frame⟩⟩ + · rcases hnone with ⟨readyBase, hnone⟩ + exact Or.inr ⟨readyBase, + ⟨by + intro candidate hcand + simp only [List.mem_cons] at hcand + rcases hcand with rfl | hcand + · exact hneq + · exact hnone.notFound candidate hcand, + hnone.ready, hnone.count, + hphaseFrame.trans_internal hnone.frame⟩⟩ + +end Machine + +end RegisterStore + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryScanStep.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryScanStep.lean new file mode 100644 index 0000000000..8970e91ea1 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryScanStep.lean @@ -0,0 +1,80 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryScanStep.Defs +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryScanStep.Internal + +/-! +# One bounded sparse-entry scan iteration + +This module exposes the compositional hit-or-next-iteration contract for one +encoded sparse register-store entry. +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace RegisterStore + +namespace Machine + +/-- Decode and compare one entry, then either expose its decoded value on a +hit or restore the exact invariant for the remaining encoded stream. -/ +theorem entryScanStepTM_hoareTime_frame {n : ℕ} + (tapes : EntryMatchTapes n) (entry : Entry) (rest queryBits : List Bool) + (initialWork iterationWork : Fin n → Tape) (inp₀ out₀ : Tape) + (hready : EntryScanReady tapes (Entry.encode entry ++ rest) queryBits + initialWork iterationWork) + (hinput : TM.Parked inp₀) (houtput : TM.Parked out₀) : + (entryScanStepTM tapes).HoareTime + (fun inp work out => inp = inp₀ ∧ work = iterationWork ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + ((entry.1.bits = queryBits ∧ + EntryScanHit tapes entry rest queryBits initialWork work) ∨ + (entry.1.bits ≠ queryBits ∧ + EntryScanReady tapes rest queryBits initialWork work)) ∧ + out = out₀) + (entryScanStepTime tapes entry queryBits iterationWork) := + entryScanStepTM_hoareTime_frame_internal tapes entry rest queryBits + initialWork iterationWork inp₀ out₀ hready hinput houtput + +/-- One scan iteration preserves one-way output safety. -/ +theorem entryScanStepTM_isTransducer {n : ℕ} (tapes : EntryMatchTapes n) : + (entryScanStepTM tapes).IsTransducer := by + have hskip : (TM.skipTM (n := n)).IsTransducer := by + intro state iHead wHeads oHead + cases state <;> cases oHead <;> simp [TM.skipTM, TM.idleDir] + unfold entryScanStepTM entryScanBranchTM + exact (entryMatchReadTM_isTransducer tapes).seqTM + (hskip.branchWorkSymbolTM (entryMissCleanupTM_isTransducer tapes)) + +/-- Coarse all-prefix auxiliary-space envelope for one scan iteration. -/ +theorem entryScanStepTM_prefix_withinAuxSpace {n : ℕ} + (tapes : EntryMatchTapes n) (entry : Entry) (queryBits : List Bool) + (initialWork : Fin n → Tape) (inputLength initialSpace time : ℕ) + (start current : Complexity.Cfg n (entryScanStepTM tapes).Q) + (hinitial : start.WithinAuxSpace inputLength initialSpace) + (hreach : (entryScanStepTM tapes).reachesIn time start current) + (htime : time ≤ entryScanStepTime tapes entry queryBits initialWork) : + current.WithinAuxSpace inputLength + (initialSpace + entryScanStepTime tapes entry queryBits initialWork) := + (hinitial.reachesIn hreach).mono le_rfl (by omega) + +end Machine + +end RegisterStore + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryScanStep/Defs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryScanStep/Defs.lean new file mode 100644 index 0000000000..03d7f5fc51 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryScanStep/Defs.lean @@ -0,0 +1,81 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryCleanup.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.WorkSymbolBranch.Defs + +/-! +# One bounded sparse-entry scan iteration — definitions + +One iteration decodes and compares the next entry, branches directly on the +readable equality flag, preserves the decoded value on a hit, and restores the +next-iteration scratch invariant on a miss. +-/ + + +@[expose] public section + +namespace Complexity + +namespace RAM + +namespace RegisterStore + +namespace Machine + +/-- Direct hit/miss branch selected by the readable equality-result tape. -/ +def entryScanBranchTM {n : ℕ} (tapes : EntryMatchTapes n) : TM n := + TM.branchWorkSymbolTM tapes.result Γ.one TM.skipTM (entryMissCleanupTM tapes) + +/-- Decode, compare, and dispatch one encoded sparse entry. -/ +def entryScanStepTM {n : ℕ} (tapes : EntryMatchTapes n) : TM n := + TM.seqTM (entryMatchReadTM tapes) (entryScanBranchTM tapes) + +/-- Coarse branch bound covering both the one-step hit and miss cleanup. -/ +def entryScanBranchTime {n : ℕ} (tapes : EntryMatchTapes n) + (entry : Entry) (queryBits : List Bool) (initialWork : Fin n → Tape) : ℕ := + TM.branchWorkSymbolTime 1 + (entryMissCleanupTime tapes entry queryBits initialWork) + +/-- Compositional time bound for one complete scan iteration. -/ +def entryScanStepTime {n : ℕ} (tapes : EntryMatchTapes n) + (entry : Entry) (queryBits : List Bool) (initialWork : Fin n → Tape) : ℕ := + entryMatchReadTime entry queryBits + 1 + + entryScanBranchTime tapes entry queryBits initialWork + +/-- Successful scan endpoint exposing the decoded value and the global +external frame. -/ +structure EntryScanHit {n : ℕ} (tapes : EntryMatchTapes n) + (entry : Entry) (rest queryBits : List Bool) + (initialWork finalWork : Fin n → Tape) : Prop where + addressEq : entry.1.bits = queryBits + source : (finalWork tapes.source).HasBinarySuffix rest + value : (finalWork tapes.value).HasBinaryPrefix entry.2.bits + valueStart : (finalWork tapes.value).cells 0 = Γ.start + query : (finalWork tapes.query).HasBinaryContent queryBits + queryStart : (finalWork tapes.query).cells 0 = Γ.start + result : (finalWork tapes.result).HasBinaryString [true] + resultStart : (finalWork tapes.result).cells 0 = Γ.start + parked : ∀ i, TM.Parked (finalWork i) + frame : ∀ i, i ≠ tapes.source → i ≠ tapes.address → + i ≠ tapes.value → i ≠ tapes.addressCounter → + i ≠ tapes.addressWidth → i ≠ tapes.valueCounter → + i ≠ tapes.valueWidth → i ≠ tapes.query → i ≠ tapes.result → + finalWork i = initialWork i + /-- The complete readable-match endpoint is retained for downstream + consumers that must reset every decoder scratch tape after a hit. -/ + readable : ∃ iterationWork, + ReadableEntryMatch tapes entry rest queryBits iterationWork finalWork + +end Machine + +end RegisterStore + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryScanStep/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryScanStep/Internal.lean new file mode 100644 index 0000000000..8e5a036177 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryScanStep/Internal.lean @@ -0,0 +1,184 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryCleanup +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryScanStep.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.WorkSymbolBranch +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryMatch + +/-! +# One bounded sparse-entry scan iteration — proof internals +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace RegisterStore + +namespace Machine + +variable {n : ℕ} + +private theorem readableEntryMatch_to_hit + (tapes : EntryMatchTapes n) (entry : Entry) (rest queryBits : List Bool) + (initialWork iterationWork matchedWork : Fin n → Tape) + (hready : EntryScanReady tapes (Entry.encode entry ++ rest) queryBits + initialWork iterationWork) + (hmatch : ReadableEntryMatch tapes entry rest queryBits iterationWork matchedWork) + (heq : entry.1.bits = queryBits) : + EntryScanHit tapes entry rest queryBits initialWork matchedWork := by + refine ⟨heq, hmatch.source, hmatch.value, hmatch.valueStart, + hmatch.query, hmatch.queryStart, ?_, hmatch.resultStart, + hmatch.parked, ?_, ⟨iterationWork, hmatch⟩⟩ + · simpa [heq] using hmatch.result + · intro i hsource haddress hvalue haddressCounter haddressWidth + hvalueCounter hvalueWidth hquery hresult + exact (hmatch.frame i hsource haddress hvalue haddressCounter + haddressWidth hvalueCounter hvalueWidth hquery hresult).trans + (hready.frame i hsource haddress hvalue haddressCounter + haddressWidth hvalueCounter hvalueWidth hquery hresult) + +private theorem entryScanReady_reframe + (tapes : EntryMatchTapes n) (consumed rest queryBits : List Bool) + (initialWork iterationWork finalWork : Fin n → Tape) + (hready : EntryScanReady tapes consumed queryBits initialWork iterationWork) + (hfinal : EntryScanReady tapes rest queryBits iterationWork finalWork) : + EntryScanReady tapes rest queryBits initialWork finalWork := by + refine ⟨hfinal.source, hfinal.address, hfinal.addressStart, + hfinal.value, hfinal.valueStart, hfinal.addressCounter, + hfinal.addressWidth, hfinal.valueCounter, hfinal.valueWidth, + hfinal.query, hfinal.queryStart, hfinal.result, hfinal.resultStart, + hfinal.parked, ?_⟩ + intro i hsource haddress hvalue haddressCounter haddressWidth + hvalueCounter hvalueWidth hquery hresult + exact (hfinal.frame i hsource haddress hvalue haddressCounter + haddressWidth hvalueCounter hvalueWidth hquery hresult).trans + (hready.frame i hsource haddress hvalue haddressCounter + haddressWidth hvalueCounter hvalueWidth hquery hresult) + +theorem entryScanStepTM_hoareTime_frame_internal + (tapes : EntryMatchTapes n) (entry : Entry) (rest queryBits : List Bool) + (initialWork iterationWork : Fin n → Tape) (inp₀ out₀ : Tape) + (hready : EntryScanReady tapes (Entry.encode entry ++ rest) queryBits + initialWork iterationWork) + (hinput : TM.Parked inp₀) (houtput : TM.Parked out₀) : + (entryScanStepTM tapes).HoareTime + (fun inp work out => inp = inp₀ ∧ work = iterationWork ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + ((entry.1.bits = queryBits ∧ + EntryScanHit tapes entry rest queryBits initialWork work) ∨ + (entry.1.bits ≠ queryBits ∧ + EntryScanReady tapes rest queryBits initialWork work)) ∧ + out = out₀) + (entryScanStepTime tapes entry queryBits iterationWork) := by + have hmatchRun : (entryMatchReadTM tapes).HoareTime + (fun inp work out => inp = inp₀ ∧ work = iterationWork ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + ReadableEntryMatch tapes entry rest queryBits iterationWork work ∧ + out = out₀) + (entryMatchReadTime entry queryBits) := by + intro inp work out hpre + rcases hpre with ⟨hinpEq, hworkEq, houtEq⟩ + subst inp + subst work + subst out + obtain ⟨c', t, ht, hreach, hhalt, hinp, hmatch, hout⟩ := + entryMatchReadTM_reachesIn_frame tapes entry rest queryBits inp₀ + iterationWork out₀ hready.source hready.address hready.value + hready.addressStart hready.valueStart hready.addressCounter + hready.addressWidth hready.valueCounter hready.valueWidth hready.query + hready.queryStart hready.result hready.resultStart hinput hready.parked + houtput + exact ⟨c', t, ht, hreach, hhalt, hinp, hmatch, hout⟩ + have hbranch : (entryScanBranchTM tapes).HoareTime + (fun inp work out => + inp = inp₀ ∧ + ReadableEntryMatch tapes entry rest queryBits iterationWork work ∧ + out = out₀) + (fun inp work out => + inp = inp₀ ∧ + ((entry.1.bits = queryBits ∧ + EntryScanHit tapes entry rest queryBits initialWork work) ∨ + (entry.1.bits ≠ queryBits ∧ + EntryScanReady tapes rest queryBits initialWork work)) ∧ + out = out₀) + (entryScanBranchTime tapes entry queryBits iterationWork) := by + intro inp work out hpre + rcases hpre with ⟨hinp, hmatch, hout⟩ + subst inp + subst out + by_cases heq : entry.1.bits = queryBits + · have hread : (work tapes.result).read = Γ.one := + hmatch.result_read_eq_one_iff.mpr heq + have hskip := TM.skipTM_hoareTime_frame inp₀ work out₀ hinput + hmatch.parked houtput + obtain ⟨c', t, ht, hreach, hhalt, hinp', hwork', hout'⟩ := + hskip inp₀ work out₀ ⟨rfl, rfl, rfl⟩ + obtain ⟨C, hbranchReach, hbranchHalt, hCinput, hCwork, hCoutput⟩ := + TM.branchWorkSymbolTM_reachesIn_equal_frame tapes.result Γ.one + TM.skipTM (entryMissCleanupTM tapes) inp₀ work out₀ hread + hinput.read_ne_start (fun i => (hmatch.parked i).read_ne_start) + houtput.read_ne_start hreach hhalt + have hhit := readableEntryMatch_to_hit tapes entry rest queryBits + initialWork iterationWork work hready hmatch heq + refine ⟨C, t + 1, ?_, hbranchReach, hbranchHalt, ?_⟩ + · unfold entryScanBranchTime TM.branchWorkSymbolTime + omega + · refine ⟨hCinput.trans hinp', Or.inl ⟨heq, ?_⟩, + hCoutput.trans hout'⟩ + rw [hCwork, hwork'] + exact hhit + · have hread : (work tapes.result).read ≠ Γ.one := by + exact fun h => heq (hmatch.result_read_eq_one_iff.mp h) + have hcleanup := entryMissCleanupTM_hoareTime_frame tapes entry rest + queryBits iterationWork work inp₀ out₀ hmatch hinput houtput + obtain ⟨c', t, ht, hreach, hhalt, hinp', hready', hout'⟩ := + hcleanup inp₀ work out₀ ⟨rfl, rfl, rfl⟩ + obtain ⟨C, hbranchReach, hbranchHalt, hCinput, hCwork, hCoutput⟩ := + TM.branchWorkSymbolTM_reachesIn_different_frame tapes.result Γ.one + TM.skipTM (entryMissCleanupTM tapes) inp₀ work out₀ hread + hinput.read_ne_start (fun i => (hmatch.parked i).read_ne_start) + houtput.read_ne_start hreach hhalt + have hreadyGlobal := entryScanReady_reframe tapes + (Entry.encode entry ++ rest) rest queryBits initialWork iterationWork + c'.work hready hready' + refine ⟨C, t + 1, ?_, hbranchReach, hbranchHalt, ?_⟩ + · unfold entryScanBranchTime TM.branchWorkSymbolTime + omega + · refine ⟨hCinput.trans hinp', Or.inr ⟨heq, ?_⟩, + hCoutput.trans hout'⟩ + rw [hCwork] + exact hreadyGlobal + have hseq := TM.seqTM_hoareTime (entryMatchReadTM tapes) + (entryScanBranchTM tapes) hmatchRun + (by + intro inp work out hmid + rcases hmid with ⟨hinp, hmatch, hout⟩ + obtain ⟨hinpTransition, hworkTransition, houtTransition⟩ := + TM.phaseTransition_eq_self_of_reads_ne_start + (hinp ▸ hinput.read_ne_start) + (fun i => (hmatch.parked i).read_ne_start) + (hout ▸ houtput.read_ne_start) + rw [hinpTransition, hworkTransition, houtTransition] + exact ⟨hinp, hmatch, hout⟩) + hbranch + simpa [entryScanStepTM, entryScanStepTime] using hseq + +end Machine + +end RegisterStore + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate.lean new file mode 100644 index 0000000000..6a567a0872 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate.lean @@ -0,0 +1,185 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Defs +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Out +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Sem +public import +LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.BoundsInternal +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Source + +/-! +# Bounded encoded sparse-store update + +This module exposes the complete fixed-controller implementation of one +canonical sparse-store write. The machine scans a runtime-counted old store, +copies misses, replaces or deletes the unique hit, and appends a fresh nonzero +entry exactly when the address was absent. +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace RegisterStore + +namespace Machine + +/-- The encoded source cursor may move during an update, but its complete cell +contents are read-only. -/ +theorem entryUpdateTM_source_readOnly {n : ℕ} (tapes : EntryUpdateTapes n) : + (entryUpdateTM tapes).WorkReadOnly tapes.entry.source := + entryUpdateTM_source_readOnly_internal tapes + +/-- Update one runtime-sized canonical sparse store. The output appends exactly +the encoding of `RegisterStore.write`; input, the replacement source, and every +work tape outside the thirteen-tape assignment retain their checked frames. -/ +theorem entryUpdateTM_hoareTime_frame {n : ℕ} + (tapes : EntryUpdateTapes n) (store : Store) (address newValue : ℕ) + (emittedBits : List Bool) (initialWork : Fin n → Tape) + (inp₀ out₀ : Tape) + (hcanonical : Canonical store) + (hready : EntryScanReady tapes.entry (store.flatMap Entry.encode) + address.bits initialWork initialWork) + (hreplacement : + (initialWork tapes.replacement).HasBinaryNat newValue) + (hremaining : + (initialWork tapes.remaining).HasBinaryNat store.length) + (hfound : (initialWork tapes.found).HasBinaryNat 0) + (hresultCount : + (initialWork tapes.resultCount).HasBinaryNat store.length) + (hinput : TM.Parked inp₀) + (houtput : out₀.HasBinaryPrefix emittedBits) : + (entryUpdateTM tapes).HoareTime + (fun inp work out => + inp = inp₀ ∧ work = initialWork ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + EntryUpdateOutcome tapes store address newValue initialWork work ∧ + out.HasBinaryPrefix + (emittedBits ++ + (RegisterStore.write store address newValue).flatMap + Entry.encode) ∧ + (work tapes.entry.source).cells = + (initialWork tapes.entry.source).cells) + (entryUpdateTime tapes store address newValue) := by + have hupdate := entryUpdateTM_hoareTime_frame_internal tapes store address newValue + emittedBits initialWork inp₀ out₀ hcanonical hready hreplacement + hremaining hfound hresultCount hinput houtput + intro inp work out hpre + obtain ⟨final, time, htime, hreach, hhalt, hinp, houtcome, hout⟩ := + hupdate inp work out hpre + have hsourceCells : + (final.work tapes.entry.source).cells = + (initialWork tapes.entry.source).cells := by + have hstartWork : work = initialWork := hpre.2.1 + have hnostart : ∀ j, 1 ≤ j → + (work tapes.entry.source).cells j ≠ Γ.start := by + rw [hstartWork] + exact hready.source.2.2.2 + exact ((entryUpdateTM_source_readOnly tapes).cells_eq_of_reachesIn + hreach hnostart).trans (congrArg (fun w => (w tapes.entry.source).cells) + hstartWork) + exact ⟨final, time, htime, hreach, hhalt, hinp, houtcome, hout, + hsourceCells⟩ + +/-- Redirect an encoded sparse-store update into a fresh last work tape. This +is the stable seam used by the multi-step RAM interpreter: the real output is +left blank while the updated store becomes an ordinary work-tape buffer. -/ +theorem entryUpdateTM_retargetOutput_hoareTime_frame {n : ℕ} + (tapes : EntryUpdateTapes n) (store : Store) (address newValue : ℕ) + (emittedBits : List Bool) (initialWork : Fin (n + 1) → Tape) + (inp₀ : Tape) + (hcanonical : Canonical store) + (hready : EntryScanReady tapes.entry (store.flatMap Entry.encode) + address.bits (fun i => initialWork (Fin.castSucc i)) + (fun i => initialWork (Fin.castSucc i))) + (hreplacement : + (initialWork (Fin.castSucc tapes.replacement)).HasBinaryNat newValue) + (hremaining : + (initialWork (Fin.castSucc tapes.remaining)).HasBinaryNat store.length) + (hfound : + (initialWork (Fin.castSucc tapes.found)).HasBinaryNat 0) + (hresultCount : + (initialWork (Fin.castSucc tapes.resultCount)).HasBinaryNat store.length) + (hinput : TM.Parked inp₀) + (hbuffer : (initialWork (Fin.last n)).HasBinaryPrefix emittedBits) : + (entryUpdateTM tapes).retargetOutput.HoareTime + (fun inp work out => + inp = inp₀ ∧ work = initialWork ∧ + out = (Tape.init []).move Dir3.right) + (fun inp work out => + inp = inp₀ ∧ + EntryUpdateOutcome tapes store address newValue + (fun i => initialWork (Fin.castSucc i)) + (fun i => work (Fin.castSucc i)) ∧ + (work (Fin.last n)).HasBinaryPrefix + (emittedBits ++ + (RegisterStore.write store address newValue).flatMap Entry.encode) ∧ + (work (Fin.castSucc tapes.entry.source)).cells = + (initialWork (Fin.castSucc tapes.entry.source)).cells ∧ + out = (Tape.init []).move Dir3.right) + (entryUpdateTime tapes store address newValue) := by + let baseWork : Fin n → Tape := fun i => initialWork (Fin.castSucc i) + let buffer := initialWork (Fin.last n) + have hupdate := entryUpdateTM_hoareTime_frame tapes store address newValue + emittedBits baseWork inp₀ buffer hcanonical hready hreplacement hremaining + hfound hresultCount hinput hbuffer + have hlift := TM.retargetOutput_hoareTime (entryUpdateTM tapes) hupdate + apply hlift.consequence + · rintro inp work out ⟨hinp, hwork, hout⟩ + subst inp + subst work + exact ⟨⟨rfl, rfl, rfl⟩, hout⟩ + · intro inp work out hpost + rcases hpost with ⟨⟨hinp, houtcome, hstore, hsource⟩, hout⟩ + exact ⟨hinp, houtcome, hstore, hsource, hout⟩ + · exact le_rfl + +/-- The sparse-store update controller is append-only on its output tape. -/ +theorem entryUpdateTM_isTransducer {n : ℕ} (tapes : EntryUpdateTapes n) : + (entryUpdateTM tapes).IsTransducer := + entryUpdateTM_isTransducer_internal tapes + +/-- Coarse all-prefix auxiliary-space envelope for one complete update. -/ +theorem entryUpdateTM_prefix_withinAuxSpace {n : ℕ} + (tapes : EntryUpdateTapes n) (store : Store) (address newValue : ℕ) + (inputLength initialSpace time : ℕ) + (start current : Complexity.Cfg n (entryUpdateTM tapes).Q) + (hinitial : start.WithinAuxSpace inputLength initialSpace) + (hreach : (entryUpdateTM tapes).reachesIn time start current) + (htime : time ≤ entryUpdateTime tapes store address newValue) : + current.WithinAuxSpace inputLength + (initialSpace + entryUpdateTime tapes store address newValue) := + (hinitial.reachesIn hreach).mono le_rfl (by omega) + +/-- A complete sparse update is charged by the entries actually traversed and +the query, replacement, and remaining-count widths reserved at each iteration. +This avoids the former product of entry count with a squared run-wide width. -/ +theorem entryUpdateTime_le_encoded {n : ℕ} + (tapes : EntryUpdateTapes n) (store : Store) + (address newValue : ℕ) : + entryUpdateTime tapes store address newValue ≤ + 1000 * (encodedStoreLength store + + (store.length + 1) * + (bitlen address + bitlen newValue + bitlen store.length + 1) + 1) := + entryUpdateTime_le_encoded_internal tapes store address newValue + +end Machine + +end RegisterStore + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/BoundsInternal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/BoundsInternal.lean new file mode 100644 index 0000000000..02905c0211 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/BoundsInternal.lean @@ -0,0 +1,237 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryMatch.Internal +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryPred +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.ResetBinaryMany + +/-! +# Encoded-length sparse-update bounds -- proof internals + +The update controller reserves the slower of copy, replacement, and deletion +at each iteration. With unary-marker decoding, each such reservation is still +linear in the current entry and the instruction's query/replacement widths. +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace RegisterStore + +namespace Machine + +private theorem entryMatchReadTime_le_bitlen (entry : Entry) + (queryBits : List Bool) : + entryMatchReadTime entry queryBits ≤ + 5 * bitlen entry.1 + 3 * bitlen entry.2 + queryBits.length + 18 := by + have h := entryMatchReadTime_le_linear_internal entry queryBits + simpa only [bitlen, Nat.size_eq_bits_len] using h + +private theorem entryMissBits_length_le_bitlen {n : ℕ} + (tapes : EntryMatchTapes n) (entry : Entry) + (queryBits : List Bool) (i : Fin n) : + (entryMissBits tapes entry queryBits i).length ≤ + bitlen entry.1 + bitlen entry.2 + 1 := by + unfold entryMissBits + split_ifs <;> + (try simp only [List.length_nil, List.length_replicate, + List.length_singleton, bitlen, Nat.size_eq_bits_len]) <;> omega + +private theorem entryUpdatePostEmitHead_le_bitlen {n : ℕ} + (tapes : EntryUpdateTapes n) (entry : Entry) (i : Fin n) : + entryUpdatePostEmitHead tapes entry i ≤ + bitlen entry.1 + bitlen entry.2 + 1 := by + unfold entryUpdatePostEmitHead + split_ifs <;> + simp only [bitlen, Nat.size_eq_bits_len] <;> omega + +private theorem entryUpdateReadyCleanupTime_le_linear {n : ℕ} + (tapes : EntryUpdateTapes n) (entry : Entry) (address : ℕ) : + entryUpdateReadyCleanupTime tapes entry address ≤ + 300 * (bitlen entry.1 + bitlen entry.2 + bitlen address + 1) := by + let matchTime := entryMatchReadTime entry address.bits + have hmatch : matchTime ≤ + 5 * bitlen entry.1 + 3 * bitlen entry.2 + bitlen address + 18 := by + dsimp only [matchTime] + simpa only [bitlen, Nat.size_eq_bits_len] using + entryMatchReadTime_le_bitlen entry address.bits + have hreset := TM.resetBinaryWorkManyTime_le + (entryMissTargets tapes.entry) + (entryMissBits tapes.entry entry address.bits) + (fun _ => 1 + matchTime) (1 + matchTime) + (bitlen entry.1 + bitlen entry.2 + 1) + (fun _ _ => le_rfl) + (fun i _ => entryMissBits_length_le_bitlen tapes.entry entry address.bits i) + have htargets : (entryMissTargets tapes.entry).length = 7 := by + simp [entryMissTargets] + rw [htargets] at hreset + unfold entryUpdateReadyCleanupTime + dsimp only [matchTime] at hmatch hreset ⊢ + omega + +private theorem entryUpdatePostEmitCleanupTime_le_linear {n : ℕ} + (tapes : EntryUpdateTapes n) (entry : Entry) (address : ℕ) : + entryUpdatePostEmitCleanupTime tapes entry address ≤ + 300 * (bitlen entry.1 + bitlen entry.2 + bitlen address + 1) := by + let matchTime := entryMatchReadTime entry address.bits + have hmatch : matchTime ≤ + 5 * bitlen entry.1 + 3 * bitlen entry.2 + bitlen address + 18 := by + dsimp only [matchTime] + simpa only [bitlen, Nat.size_eq_bits_len] using + entryMatchReadTime_le_bitlen entry address.bits + have hreset := TM.resetBinaryWorkManyTime_le + (entryMissTargets tapes.entry) + (entryMissBits tapes.entry entry address.bits) + (fun i => entryUpdatePostEmitHead tapes entry i + matchTime) + (bitlen entry.1 + bitlen entry.2 + 1 + matchTime) + (bitlen entry.1 + bitlen entry.2 + 1) + (fun i _ => Nat.add_le_add_right + (entryUpdatePostEmitHead_le_bitlen tapes entry i) matchTime) + (fun i _ => entryMissBits_length_le_bitlen tapes.entry entry address.bits i) + have htargets : (entryMissTargets tapes.entry).length = 7 := by + simp [entryMissTargets] + rw [htargets] at hreset + unfold entryUpdatePostEmitCleanupTime + dsimp only [matchTime] at hmatch hreset ⊢ + omega + +private theorem rewindEntryEncodeTime_le_linear (entry : Entry) + (addressHead valueHead : ℕ) : + rewindEntryEncodeTime entry addressHead valueHead ≤ + addressHead + valueHead + 3 * bitlen entry.1 + + 3 * bitlen entry.2 + 21 := by + unfold rewindEntryEncodeTime rewindWordEncodeTime wordEncodeTime + simp only [bitlen, Nat.size_eq_bits_len] + omega +private theorem entryUpdateBranchTime_le_linear {n : ℕ} + (tapes : EntryUpdateTapes n) (entry : Entry) + (address newValue total : ℕ) : + entryUpdateBranchTime tapes entry address newValue total ≤ + 500 * (bitlen entry.1 + bitlen entry.2 + bitlen address + + bitlen newValue + bitlen total + 1) := by + let matchTime := entryMatchReadTime entry address.bits + have hmatch : matchTime ≤ + 5 * bitlen entry.1 + 3 * bitlen entry.2 + bitlen address + 18 := by + dsimp only [matchTime] + simpa only [bitlen, Nat.size_eq_bits_len] using + entryMatchReadTime_le_bitlen entry address.bits + have hready := entryUpdateReadyCleanupTime_le_linear tapes entry address + have hpost := entryUpdatePostEmitCleanupTime_le_linear tapes entry address + have hmiss := rewindEntryEncodeTime_le_linear entry + (1 + matchTime) (1 + matchTime) + have hreplace := rewindEntryEncodeTime_le_linear (entry.1, newValue) + (1 + matchTime) 1 + have hcount : entryUpdateCountTime total ≤ 2 * bitlen total + 2 := by + unfold entryUpdateCountTime bitlen + omega + have hnewValue : newValue.bits.length = bitlen newValue := by + exact Nat.size_eq_bits_len newValue + unfold entryUpdateBranchTime entryUpdateMissTime entryUpdateReplaceTime + dsimp only [matchTime] at hmatch hmiss hreplace ⊢ + rw [hnewValue] + apply max_le + · omega + · apply max_le <;> omega + +private theorem entryUpdateIterationTime_le_linear {n : ℕ} + (tapes : EntryUpdateTapes n) (entry : Entry) (rest : Store) + (address newValue total : ℕ) (hrest : rest.length + 1 ≤ total) : + entryUpdateIterationTime tapes entry rest address newValue total ≤ + 600 * (bitlen entry.1 + bitlen entry.2 + bitlen address + + bitlen newValue + bitlen total + 1) := by + have hmatch := entryMatchReadTime_le_bitlen entry address.bits + have hbranch := entryUpdateBranchTime_le_linear tapes entry address + newValue total + have hpred := TM.binaryPredTime_le rest.length + have hrestWidth : (rest.length + 1).size ≤ bitlen total := by + unfold bitlen + exact Nat.size_le_size hrest + unfold entryUpdateIterationTime + have haddressBits : address.bits.length = bitlen address := + Nat.size_eq_bits_len address + rw [haddressBits] at hmatch + omega + +private theorem entryUpdateNilTime_le_linear {n : ℕ} + (tapes : EntryUpdateTapes n) (address newValue total : ℕ) : + entryUpdateLoopTime tapes address newValue total [] ≤ + 100 * (bitlen address + bitlen newValue + bitlen total + 1) := by + have hrewind := rewindEntryEncodeTime_le_linear (address, newValue) 1 1 + change rewindEntryEncodeTime (address, newValue) 1 1 ≤ + 1 + 1 + 3 * bitlen address + 3 * bitlen newValue + 21 at hrewind + have hcount : entryUpdateCountTime total ≤ 2 * bitlen total + 2 := by + unfold entryUpdateCountTime bitlen + omega + unfold entryUpdateLoopTime entryAppendRestoreTime + have haddress : address.bits.length = bitlen address := + Nat.size_eq_bits_len address + have hnewValue : newValue.bits.length = bitlen newValue := + Nat.size_eq_bits_len newValue + rw [haddress, hnewValue] + omega + +theorem entryUpdateTime_le_encoded_internal {n : ℕ} + (tapes : EntryUpdateTapes n) (store : Store) + (address newValue : ℕ) : + entryUpdateTime tapes store address newValue ≤ + 1000 * (encodedStoreLength store + + (store.length + 1) * + (bitlen address + bitlen newValue + bitlen store.length + 1) + 1) := by + have hloop : ∀ remaining : Store, remaining.length ≤ store.length → + entryUpdateLoopTime tapes address newValue store.length remaining ≤ + 1000 * (encodedStoreLength remaining + + (remaining.length + 1) * + (bitlen address + bitlen newValue + bitlen store.length + 1) + 1) := by + intro remaining hremaining + induction remaining with + | nil => + have hnil := entryUpdateNilTime_le_linear tapes address newValue + store.length + simp only [encodedStoreLength, List.flatMap_nil, List.length_nil, + Nat.zero_add, Nat.one_mul] + omega + | cons entry rest ih => + have hrestLength : rest.length + 1 ≤ store.length := by + simpa only [List.length_cons] using hremaining + have hiteration := entryUpdateIterationTime_le_linear tapes entry rest + address newValue store.length hrestLength + have htail := ih (by omega) + have hentryLength : (Entry.encode entry).length = + 2 * bitlen entry.1 + 2 * bitlen entry.2 + 2 := + Entry.encode_length entry + unfold entryUpdateLoopTime + have hencoded : encodedStoreLength (entry :: rest) = + (Entry.encode entry).length + encodedStoreLength rest := by + simp [encodedStoreLength] + rw [hencoded, hentryLength] + simp only [List.length_cons] + have hmul : (rest.length + 1 + 1) * + (bitlen address + bitlen newValue + bitlen store.length + 1) = + (rest.length + 1) * + (bitlen address + bitlen newValue + bitlen store.length + 1) + + (bitlen address + bitlen newValue + bitlen store.length + 1) := by + ring + rw [hmul] + omega + unfold entryUpdateTime + exact hloop store le_rfl + +end Machine + +end RegisterStore + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Defs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Defs.lean new file mode 100644 index 0000000000..3916a7451a --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Defs.lean @@ -0,0 +1,391 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryAppend.Defs +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryMissCopy.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryPred.Defs + +/-! +# Bounded encoded sparse-store update — controller definitions + +The fixed controller owns thirteen pairwise-distinct work tapes. It scans a +runtime-counted entry stream, copying misses, replacing or deleting a hit, and +appending a fresh nonzero entry only when the old count is exhausted without a +match. A second count tape tracks the output-store cardinality. +-/ + + +@[expose] public section + +namespace Complexity + +namespace RAM + +namespace RegisterStore + +namespace Machine + +/-- Thirteen pairwise-distinct tapes used by encoded sparse-store update. -/ +structure EntryUpdateTapes (n : ℕ) where + /-- Assignment order: nine entry-match tapes, remaining count, replacement + value, found flag, and output count. -/ + idx : Fin 13 → Fin n + /-- The complete assignment is injective. -/ + injective : Function.Injective idx + +namespace EntryUpdateTapes + +/-- The nine-tape decode-and-match assignment. -/ +def entry {n : ℕ} (tapes : EntryUpdateTapes n) : EntryMatchTapes n where + idx := fun i => tapes.idx ⟨i, by omega⟩ + injective := by + intro i j hij + have h : (⟨i, by omega⟩ : Fin 13) = ⟨j, by omega⟩ := + tapes.injective hij + apply Fin.ext + exact congrArg (fun k : Fin 13 => k.val) h + +/-- Runtime number of old entries still unread. -/ +def remaining {n : ℕ} (tapes : EntryUpdateTapes n) : Fin n := tapes.idx 9 + +/-- Canonical source containing the requested new value. -/ +def replacement {n : ℕ} (tapes : EntryUpdateTapes n) : Fin n := tapes.idx 10 + +/-- One-bit flag recording whether a matching old address has been seen. -/ +def found {n : ℕ} (tapes : EntryUpdateTapes n) : Fin n := tapes.idx 11 + +/-- Canonical count of entries emitted by the completed update. -/ +def resultCount {n : ℕ} (tapes : EntryUpdateTapes n) : Fin n := tapes.idx 12 + +/-- Distinct indices in the thirteen-tape assignment remain distinct. -/ +theorem ne {n : ℕ} (tapes : EntryUpdateTapes n) {i j : Fin 13} (h : i ≠ j) : + tapes.idx i ≠ tapes.idx j := + fun hij => h (tapes.injective hij) + +/-- Replacement-emission view of the update assignment. -/ +def replace {n : ℕ} (tapes : EntryUpdateTapes n) : EntryReplaceTapes n where + entry := tapes.entry + replacement := tapes.replacement + replacement_ne := by + intro i h + change tapes.idx 10 = tapes.idx ⟨i.val, by omega⟩ at h + have h' : (10 : Fin 13) = ⟨i.val, by omega⟩ := tapes.injective h + have hv : (10 : ℕ) = i.val := + congrArg (fun k : Fin 13 => k.val) h' + omega + +@[simp] theorem replace_entry {n : ℕ} (tapes : EntryUpdateTapes n) : + tapes.replace.entry = tapes.entry := rfl + +@[simp] theorem replace_replacement {n : ℕ} (tapes : EntryUpdateTapes n) : + tapes.replace.replacement = tapes.replacement := rfl + +end EntryUpdateTapes + +/-- Exact preservation predicate outside the thirteen tapes owned by update. -/ +def EntryUpdateFrame {n : ℕ} (tapes : EntryUpdateTapes n) + (initialWork finalWork : Fin n → Tape) : Prop := + ∀ i, (∀ slot, i ≠ tapes.idx slot) → finalWork i = initialWork i + +/-- Auditable final work-tape contract for one encoded sparse-store update. -/ +structure EntryUpdateOutcome {n : ℕ} (tapes : EntryUpdateTapes n) + (store : Store) (address newValue : ℕ) + (initialWork finalWork : Fin n → Tape) : Prop where + /-- The encoded old store has been consumed and all entry scratch is reset. -/ + ready : EntryScanReady tapes.entry [] address.bits finalWork finalWork + /-- The external replacement source is restored literally. -/ + replacement : finalWork tapes.replacement = initialWork tapes.replacement + /-- The runtime old-entry counter is exhausted. -/ + remaining : (finalWork tapes.remaining).HasBinaryNat 0 + /-- The flag records whether the old store contained the updated address. -/ + found : (finalWork tapes.found).HasBinaryNat + (if address ∈ store.map Prod.fst then 1 else 0) + /-- The result counter is the exact cardinality of the pure sparse write. -/ + resultCount : (finalWork tapes.resultCount).HasBinaryNat + (RegisterStore.write store address newValue).length + /-- Every work tape outside the fixed assignment is unchanged. -/ + frame : EntryUpdateFrame tapes initialWork finalWork + +/-- Canonical head profile after an old decoded entry has been emitted. -/ +def entryUpdatePostEmitHead {n : ℕ} (tapes : EntryUpdateTapes n) + (entry : Entry) (i : Fin n) : ℕ := + if i = tapes.entry.address then entry.1.bits.length + 1 + else if i = tapes.entry.value then entry.2.bits.length + 1 + else if i = tapes.entry.addressCounter then bitlen entry.1 + 1 + else if i = tapes.entry.valueCounter then bitlen entry.2 + 1 + else 1 + +/-- Work-independent cleanup bound when deletion emits no entry. -/ +def entryUpdateReadyCleanupTime {n : ℕ} (tapes : EntryUpdateTapes n) + (entry : Entry) (address : ℕ) : ℕ := + let matchTime := entryMatchReadTime entry address.bits + 1 + matchTime + 2 + 1 + + TM.resetBinaryWorkManyTime + (entryMissBits tapes.entry entry address.bits) + (fun _ => 1 + matchTime) (entryMissTargets tapes.entry) + +/-- Work-independent cleanup bound after miss-copy or replacement emission. -/ +def entryUpdatePostEmitCleanupTime {n : ℕ} + (tapes : EntryUpdateTapes n) (entry : Entry) (address : ℕ) : ℕ := + let matchTime := entryMatchReadTime entry address.bits + 1 + 2 * matchTime + 2 + 1 + + TM.resetBinaryWorkManyTime + (entryMissBits tapes.entry entry address.bits) + (fun i => entryUpdatePostEmitHead tapes entry i + matchTime) + (entryMissTargets tapes.entry) + +/-- Fixed bound for copying one unmatched entry and restoring scratch. -/ +def entryUpdateMissTime {n : ℕ} (tapes : EntryUpdateTapes n) + (entry : Entry) (address : ℕ) : ℕ := + let matchTime := entryMatchReadTime entry address.bits + rewindEntryEncodeTime entry (1 + matchTime) (1 + matchTime) + 1 + + entryUpdatePostEmitCleanupTime tapes entry address + +/-- Fixed bound for emitting a replacement and restoring scratch. -/ +def entryUpdateReplaceTime {n : ℕ} (tapes : EntryUpdateTapes n) + (entry : Entry) (address newValue : ℕ) : ℕ := + let matchTime := entryMatchReadTime entry address.bits + rewindEntryEncodeTime (entry.1, newValue) (1 + matchTime) 1 + 1 + + (newValue.bits.length + 1 + 2 + 1 + + entryUpdatePostEmitCleanupTime tapes entry address) + +/-- Uniform binary counter-update budget below the initial store size. -/ +def entryUpdateCountTime (total : ℕ) : ℕ := + 2 * total.size + 2 + +/-- Maximum controller branch cost after one readable comparison. -/ +def entryUpdateBranchTime {n : ℕ} (tapes : EntryUpdateTapes n) + (entry : Entry) (address newValue total : ℕ) : ℕ := + max (entryUpdateMissTime tapes entry address + 1) + (max (entryUpdateReplaceTime tapes entry address newValue + 1) + (entryUpdateReadyCleanupTime tapes entry address + 1 + + entryUpdateCountTime total + 1)) + +/-- Fixed cost of one positive-count iteration, excluding the recursive tail. -/ +def entryUpdateIterationTime {n : ℕ} (tapes : EntryUpdateTapes n) + (entry : Entry) (rest : Store) (address newValue total : ℕ) : ℕ := + 1 + entryMatchReadTime entry address.bits + 1 + + entryUpdateBranchTime tapes entry address newValue total + + TM.binaryPredTime rest.length + 1 + +/-- Recursive fixed bound for updating a remaining sparse-store suffix. -/ +def entryUpdateLoopTime {n : ℕ} (tapes : EntryUpdateTapes n) + (address newValue total : ℕ) : Store → ℕ + | [] => + 1 + entryAppendRestoreTime address newValue + 1 + + entryUpdateCountTime total + 1 + | entry :: rest => + entryUpdateIterationTime tapes entry rest address newValue total + + entryUpdateLoopTime tapes address newValue total rest + +/-- Public runtime bound for one complete encoded sparse-store update. -/ +def entryUpdateTime {n : ℕ} (tapes : EntryUpdateTapes n) + (store : Store) (address newValue : ℕ) : ℕ := + entryUpdateLoopTime tapes address newValue store.length store + +/-- Controller states, including each checked nested machine. -/ +inductive EntryUpdateQ {n : ℕ} (tapes : EntryUpdateTapes n) where + | test + | matching : (entryMatchReadTM tapes.entry).Q → EntryUpdateQ tapes + | miss : (entryMissCopyTM tapes.entry).Q → EntryUpdateQ tapes + | delete : (entryMissCleanupTM tapes.entry).Q → EntryUpdateQ tapes + | replace : (entryReplaceCleanupTM tapes.replace).Q → EntryUpdateQ tapes + | append : (entryAppendRestoreTM tapes.replace).Q → EntryUpdateQ tapes + | remaining : (TM.binaryPredTM tapes.remaining).Q → EntryUpdateQ tapes + | deleteCount : (TM.binaryPredTM tapes.resultCount).Q → EntryUpdateQ tapes + | appendCount : (TM.binarySuccTM tapes.resultCount).Q → EntryUpdateQ tapes + | done + deriving DecidableEq + +/-- The update controller has finitely many states because every nested +machine state type is finite. -/ +instance instFintypeEntryUpdateQ {n : ℕ} + (tapes : EntryUpdateTapes n) : Fintype (EntryUpdateQ tapes) where + elems := + {.test, .done} ∪ + (Finset.univ.image EntryUpdateQ.matching) ∪ + (Finset.univ.image EntryUpdateQ.miss) ∪ + (Finset.univ.image EntryUpdateQ.delete) ∪ + (Finset.univ.image EntryUpdateQ.replace) ∪ + (Finset.univ.image EntryUpdateQ.append) ∪ + (Finset.univ.image EntryUpdateQ.remaining) ∪ + (Finset.univ.image EntryUpdateQ.deleteCount) ∪ + (Finset.univ.image EntryUpdateQ.appendCount) + complete := by + intro q + cases q <;> simp + +/-- Fixed runtime-counted update controller. The old remaining count reaches +zero on every complete scan; the result count is decremented only for deletion +and incremented only for absent-address append. -/ +def entryUpdateTM {n : ℕ} (tapes : EntryUpdateTapes n) : TM n where + Q := EntryUpdateQ tapes + qstart := .test + qhalt := .done + δ := fun state iHead wHeads oHead => + match state with + | .test => + if wHeads tapes.remaining = Γ.blank then + if wHeads tapes.found = Γ.one then + TM.allReadBack .done iHead wHeads oHead + else if wHeads tapes.replacement = Γ.blank then + TM.allReadBack .done iHead wHeads oHead + else + TM.allReadBack + (.append (entryAppendRestoreTM tapes.replace).qstart) + iHead wHeads oHead + else + TM.allReadBack (.matching (entryMatchReadTM tapes.entry).qstart) + iHead wHeads oHead + | .matching q => + if q = (entryMatchReadTM tapes.entry).qhalt then + if wHeads tapes.entry.result = Γ.one then + let next := + if wHeads tapes.replacement = Γ.blank then + .delete (entryMissCleanupTM tapes.entry).qstart + else + .replace (entryReplaceCleanupTM tapes.replace).qstart + (next, + fun i => if i = tapes.found then Γw.one + else TM.readBackWrite (wHeads i), + TM.readBackWrite oHead, TM.idleDir iHead, + fun i => TM.idleDir (wHeads i), TM.idleDir oHead) + else + TM.allReadBack (.miss (entryMissCopyTM tapes.entry).qstart) + iHead wHeads oHead + else + let (q', workWrites, outputWrite, inputDir, workDirs, outputDir) := + (entryMatchReadTM tapes.entry).δ q iHead wHeads oHead + (.matching q', workWrites, outputWrite, inputDir, workDirs, outputDir) + | .miss q => + if q = (entryMissCopyTM tapes.entry).qhalt then + TM.allReadBack (.remaining (TM.binaryPredTM tapes.remaining).qstart) + iHead wHeads oHead + else + let (q', workWrites, outputWrite, inputDir, workDirs, outputDir) := + (entryMissCopyTM tapes.entry).δ q iHead wHeads oHead + (.miss q', workWrites, outputWrite, inputDir, workDirs, outputDir) + | .delete q => + if q = (entryMissCleanupTM tapes.entry).qhalt then + TM.allReadBack + (.deleteCount (TM.binaryPredTM tapes.resultCount).qstart) + iHead wHeads oHead + else + let (q', workWrites, outputWrite, inputDir, workDirs, outputDir) := + (entryMissCleanupTM tapes.entry).δ q iHead wHeads oHead + (.delete q', workWrites, outputWrite, inputDir, workDirs, outputDir) + | .replace q => + if q = (entryReplaceCleanupTM tapes.replace).qhalt then + TM.allReadBack (.remaining (TM.binaryPredTM tapes.remaining).qstart) + iHead wHeads oHead + else + let (q', workWrites, outputWrite, inputDir, workDirs, outputDir) := + (entryReplaceCleanupTM tapes.replace).δ q iHead wHeads oHead + (.replace q', workWrites, outputWrite, inputDir, workDirs, outputDir) + | .append q => + if q = (entryAppendRestoreTM tapes.replace).qhalt then + TM.allReadBack + (.appendCount (TM.binarySuccTM tapes.resultCount).qstart) + iHead wHeads oHead + else + let (q', workWrites, outputWrite, inputDir, workDirs, outputDir) := + (entryAppendRestoreTM tapes.replace).δ q iHead wHeads oHead + (.append q', workWrites, outputWrite, inputDir, workDirs, outputDir) + | .remaining q => + if q = (TM.binaryPredTM tapes.remaining).qhalt then + TM.allReadBack .test iHead wHeads oHead + else + let (q', workWrites, outputWrite, inputDir, workDirs, outputDir) := + (TM.binaryPredTM tapes.remaining).δ q iHead wHeads oHead + (.remaining q', workWrites, outputWrite, inputDir, workDirs, outputDir) + | .deleteCount q => + if q = (TM.binaryPredTM tapes.resultCount).qhalt then + TM.allReadBack (.remaining (TM.binaryPredTM tapes.remaining).qstart) + iHead wHeads oHead + else + let (q', workWrites, outputWrite, inputDir, workDirs, outputDir) := + (TM.binaryPredTM tapes.resultCount).δ q iHead wHeads oHead + (.deleteCount q', workWrites, outputWrite, inputDir, workDirs, outputDir) + | .appendCount q => + if q = (TM.binarySuccTM tapes.resultCount).qhalt then + TM.allReadBack .done iHead wHeads oHead + else + let (q', workWrites, outputWrite, inputDir, workDirs, outputDir) := + (TM.binarySuccTM tapes.resultCount).δ q iHead wHeads oHead + (.appendCount q', workWrites, outputWrite, inputDir, workDirs, outputDir) + | .done => TM.allIdle .done iHead wHeads oHead + δ_right_of_start := by + intro state iHead wHeads oHead + cases state with + | test => + dsimp only + split + · split + · exact TM.rightOfStart_allReadBack iHead wHeads oHead + · split <;> exact TM.rightOfStart_allReadBack iHead wHeads oHead + · exact TM.rightOfStart_allReadBack iHead wHeads oHead + | matching q => + dsimp only + split + · split + · exact TM.rightOfStart_allReadBack iHead wHeads oHead + · exact TM.rightOfStart_allReadBack iHead wHeads oHead + · exact (entryMatchReadTM tapes.entry).δ_right_of_start + q iHead wHeads oHead + | miss q => + dsimp only + split + · exact TM.rightOfStart_allReadBack iHead wHeads oHead + · exact (entryMissCopyTM tapes.entry).δ_right_of_start + q iHead wHeads oHead + | delete q => + dsimp only + split + · exact TM.rightOfStart_allReadBack iHead wHeads oHead + · exact (entryMissCleanupTM tapes.entry).δ_right_of_start + q iHead wHeads oHead + | replace q => + dsimp only + split + · exact TM.rightOfStart_allReadBack iHead wHeads oHead + · exact (entryReplaceCleanupTM tapes.replace).δ_right_of_start + q iHead wHeads oHead + | append q => + dsimp only + split + · exact TM.rightOfStart_allReadBack iHead wHeads oHead + · exact (entryAppendRestoreTM tapes.replace).δ_right_of_start + q iHead wHeads oHead + | remaining q => + dsimp only + split + · exact TM.rightOfStart_allReadBack iHead wHeads oHead + · exact (TM.binaryPredTM tapes.remaining).δ_right_of_start + q iHead wHeads oHead + | deleteCount q => + dsimp only + split + · exact TM.rightOfStart_allReadBack iHead wHeads oHead + · exact (TM.binaryPredTM tapes.resultCount).δ_right_of_start + q iHead wHeads oHead + | appendCount q => + dsimp only + split + · exact TM.rightOfStart_allReadBack iHead wHeads oHead + · exact (TM.binarySuccTM tapes.resultCount).δ_right_of_start + q iHead wHeads oHead + | done => exact TM.rightOfStart_allIdle iHead wHeads oHead + +end Machine + +end RegisterStore + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal.lean new file mode 100644 index 0000000000..29820fba6b --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal.lean @@ -0,0 +1,18 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Ctrl +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.End +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Hit +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Inv +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Loop +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Miss +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Out +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Sem +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Step +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Time + +/-! Supporting modules for Beyond the Bethe approximation of the permanent. -/ diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Ctrl.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Ctrl.lean new file mode 100644 index 0000000000..36598a441e --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Ctrl.lean @@ -0,0 +1,666 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Defs + +/-! +# Bounded encoded sparse-store update — controller internals +-/ + + +@[expose] public section + +namespace Complexity + +namespace RAM + +namespace RegisterStore + +namespace Machine + +variable {n : ℕ} + +/-- Embed a match configuration in the update controller. -/ +def entryUpdateMatchWrap (tapes : EntryUpdateTapes n) + (cfg : Complexity.Cfg n (entryMatchReadTM tapes.entry).Q) : + Complexity.Cfg n (entryUpdateTM tapes).Q where + state := .matching cfg.state + input := cfg.input + work := cfg.work + output := cfg.output + +/-- Embed a miss-copy configuration in the update controller. -/ +def entryUpdateMissWrap (tapes : EntryUpdateTapes n) + (cfg : Complexity.Cfg n (entryMissCopyTM tapes.entry).Q) : + Complexity.Cfg n (entryUpdateTM tapes).Q where + state := .miss cfg.state + input := cfg.input + work := cfg.work + output := cfg.output + +/-- Embed a deletion-cleanup configuration in the update controller. -/ +def entryUpdateDeleteWrap (tapes : EntryUpdateTapes n) + (cfg : Complexity.Cfg n (entryMissCleanupTM tapes.entry).Q) : + Complexity.Cfg n (entryUpdateTM tapes).Q where + state := .delete cfg.state + input := cfg.input + work := cfg.work + output := cfg.output + +/-- Embed a replacement configuration in the update controller. -/ +def entryUpdateReplaceWrap (tapes : EntryUpdateTapes n) + (cfg : Complexity.Cfg n (entryReplaceCleanupTM tapes.replace).Q) : + Complexity.Cfg n (entryUpdateTM tapes).Q where + state := .replace cfg.state + input := cfg.input + work := cfg.work + output := cfg.output + +/-- Embed a final-append configuration in the update controller. -/ +def entryUpdateAppendWrap (tapes : EntryUpdateTapes n) + (cfg : Complexity.Cfg n (entryAppendRestoreTM tapes.replace).Q) : + Complexity.Cfg n (entryUpdateTM tapes).Q where + state := .append cfg.state + input := cfg.input + work := cfg.work + output := cfg.output + +/-- Embed the remaining-count predecessor in the update controller. -/ +def entryUpdateRemainingWrap (tapes : EntryUpdateTapes n) + (cfg : Complexity.Cfg n (TM.binaryPredTM tapes.remaining).Q) : + Complexity.Cfg n (entryUpdateTM tapes).Q where + state := .remaining cfg.state + input := cfg.input + work := cfg.work + output := cfg.output + +/-- Embed the deletion result-count predecessor in the update controller. -/ +def entryUpdateDeleteCountWrap (tapes : EntryUpdateTapes n) + (cfg : Complexity.Cfg n (TM.binaryPredTM tapes.resultCount).Q) : + Complexity.Cfg n (entryUpdateTM tapes).Q where + state := .deleteCount cfg.state + input := cfg.input + work := cfg.work + output := cfg.output + +/-- Embed the append result-count successor in the update controller. -/ +def entryUpdateAppendCountWrap (tapes : EntryUpdateTapes n) + (cfg : Complexity.Cfg n (TM.binarySuccTM tapes.resultCount).Q) : + Complexity.Cfg n (entryUpdateTM tapes).Q where + state := .appendCount cfg.state + input := cfg.input + work := cfg.work + output := cfg.output + +/-- Canonical loop-test controller configuration. -/ +def entryUpdateTestCfg (tapes : EntryUpdateTapes n) + (inp : Tape) (work : Fin n → Tape) (out : Tape) : + Complexity.Cfg n (entryUpdateTM tapes).Q where + state := .test + input := inp + work := work + output := out + +/-- Canonical halted update-controller configuration. -/ +def entryUpdateDoneCfg (tapes : EntryUpdateTapes n) + (inp : Tape) (work : Fin n → Tape) (out : Tape) : + Complexity.Cfg n (entryUpdateTM tapes).Q where + state := .done + input := inp + work := work + output := out + +/-- Work family after the hit-dispatch transition records a match. -/ +def entryUpdateMarkFoundWork (tapes : EntryUpdateTapes n) + (work : Fin n → Tape) : Fin n → Tape := + Function.update work tapes.found + ((work tapes.found).writeAndMove Γ.one + (TM.idleDir (work tapes.found).read)) + +private theorem entryUpdateTM_match_step + (tapes : EntryUpdateTapes n) + {cfg next : Complexity.Cfg n (entryMatchReadTM tapes.entry).Q} + (hstep : (entryMatchReadTM tapes.entry).step cfg = some next) : + (entryUpdateTM tapes).step (entryUpdateMatchWrap tapes cfg) = + some (entryUpdateMatchWrap tapes next) := by + have hne : cfg.state ≠ (entryMatchReadTM tapes.entry).qhalt := + TM.state_ne_qhalt_of_step hstep + rw [TM.step, if_neg (by simp [entryUpdateMatchWrap, entryUpdateTM])] + simp only [entryUpdateMatchWrap, entryUpdateTM, hne, ↓reduceIte] + rw [TM.step, if_neg hne] at hstep + revert hstep + generalize haction : (entryMatchReadTM tapes.entry).δ cfg.state + cfg.input.read (fun i => (cfg.work i).read) cfg.output.read = action + obtain ⟨q', workWrites, outputWrite, inputDir, workDirs, outputDir⟩ := action + simp only [haction] + intro hstep + cases Option.some.inj hstep + rfl + +private theorem entryUpdateTM_miss_step + (tapes : EntryUpdateTapes n) + {cfg next : Complexity.Cfg n (entryMissCopyTM tapes.entry).Q} + (hstep : (entryMissCopyTM tapes.entry).step cfg = some next) : + (entryUpdateTM tapes).step (entryUpdateMissWrap tapes cfg) = + some (entryUpdateMissWrap tapes next) := by + have hne : cfg.state ≠ (entryMissCopyTM tapes.entry).qhalt := + TM.state_ne_qhalt_of_step hstep + rw [TM.step, if_neg (by simp [entryUpdateMissWrap, entryUpdateTM])] + simp only [entryUpdateMissWrap, entryUpdateTM, hne, ↓reduceIte] + rw [TM.step, if_neg hne] at hstep + revert hstep + generalize haction : (entryMissCopyTM tapes.entry).δ cfg.state + cfg.input.read (fun i => (cfg.work i).read) cfg.output.read = action + obtain ⟨q', workWrites, outputWrite, inputDir, workDirs, outputDir⟩ := action + simp only [haction] + intro hstep + cases Option.some.inj hstep + rfl + +private theorem entryUpdateTM_delete_step + (tapes : EntryUpdateTapes n) + {cfg next : Complexity.Cfg n (entryMissCleanupTM tapes.entry).Q} + (hstep : (entryMissCleanupTM tapes.entry).step cfg = some next) : + (entryUpdateTM tapes).step (entryUpdateDeleteWrap tapes cfg) = + some (entryUpdateDeleteWrap tapes next) := by + have hne : cfg.state ≠ (entryMissCleanupTM tapes.entry).qhalt := + TM.state_ne_qhalt_of_step hstep + rw [TM.step, if_neg (by simp [entryUpdateDeleteWrap, entryUpdateTM])] + simp only [entryUpdateDeleteWrap, entryUpdateTM, hne, ↓reduceIte] + rw [TM.step, if_neg hne] at hstep + revert hstep + generalize haction : (entryMissCleanupTM tapes.entry).δ cfg.state + cfg.input.read (fun i => (cfg.work i).read) cfg.output.read = action + obtain ⟨q', workWrites, outputWrite, inputDir, workDirs, outputDir⟩ := action + simp only [haction] + intro hstep + cases Option.some.inj hstep + rfl + +private theorem entryUpdateTM_replace_step + (tapes : EntryUpdateTapes n) + {cfg next : Complexity.Cfg n (entryReplaceCleanupTM tapes.replace).Q} + (hstep : (entryReplaceCleanupTM tapes.replace).step cfg = some next) : + (entryUpdateTM tapes).step (entryUpdateReplaceWrap tapes cfg) = + some (entryUpdateReplaceWrap tapes next) := by + have hne : cfg.state ≠ (entryReplaceCleanupTM tapes.replace).qhalt := + TM.state_ne_qhalt_of_step hstep + rw [TM.step, if_neg (by simp [entryUpdateReplaceWrap, entryUpdateTM])] + simp only [entryUpdateReplaceWrap, entryUpdateTM, hne, ↓reduceIte] + rw [TM.step, if_neg hne] at hstep + revert hstep + generalize haction : (entryReplaceCleanupTM tapes.replace).δ cfg.state + cfg.input.read (fun i => (cfg.work i).read) cfg.output.read = action + obtain ⟨q', workWrites, outputWrite, inputDir, workDirs, outputDir⟩ := action + simp only [haction] + intro hstep + cases Option.some.inj hstep + rfl + +private theorem entryUpdateTM_append_step + (tapes : EntryUpdateTapes n) + {cfg next : Complexity.Cfg n (entryAppendRestoreTM tapes.replace).Q} + (hstep : (entryAppendRestoreTM tapes.replace).step cfg = some next) : + (entryUpdateTM tapes).step (entryUpdateAppendWrap tapes cfg) = + some (entryUpdateAppendWrap tapes next) := by + have hne : cfg.state ≠ (entryAppendRestoreTM tapes.replace).qhalt := + TM.state_ne_qhalt_of_step hstep + rw [TM.step, if_neg (by simp [entryUpdateAppendWrap, entryUpdateTM])] + simp only [entryUpdateAppendWrap, entryUpdateTM, hne, ↓reduceIte] + rw [TM.step, if_neg hne] at hstep + revert hstep + generalize haction : (entryAppendRestoreTM tapes.replace).δ cfg.state + cfg.input.read (fun i => (cfg.work i).read) cfg.output.read = action + obtain ⟨q', workWrites, outputWrite, inputDir, workDirs, outputDir⟩ := action + simp only [haction] + intro hstep + cases Option.some.inj hstep + rfl + +private theorem entryUpdateTM_remaining_step + (tapes : EntryUpdateTapes n) + {cfg next : Complexity.Cfg n (TM.binaryPredTM tapes.remaining).Q} + (hstep : (TM.binaryPredTM tapes.remaining).step cfg = some next) : + (entryUpdateTM tapes).step (entryUpdateRemainingWrap tapes cfg) = + some (entryUpdateRemainingWrap tapes next) := by + have hne : cfg.state ≠ (TM.binaryPredTM tapes.remaining).qhalt := + TM.state_ne_qhalt_of_step hstep + rw [TM.step, if_neg (by simp [entryUpdateRemainingWrap, entryUpdateTM])] + simp only [entryUpdateRemainingWrap, entryUpdateTM, hne, ↓reduceIte] + rw [TM.step, if_neg hne] at hstep + revert hstep + generalize haction : (TM.binaryPredTM tapes.remaining).δ cfg.state + cfg.input.read (fun i => (cfg.work i).read) cfg.output.read = action + obtain ⟨q', workWrites, outputWrite, inputDir, workDirs, outputDir⟩ := action + simp only [haction] + intro hstep + cases Option.some.inj hstep + rfl + +private theorem entryUpdateTM_deleteCount_step + (tapes : EntryUpdateTapes n) + {cfg next : Complexity.Cfg n (TM.binaryPredTM tapes.resultCount).Q} + (hstep : (TM.binaryPredTM tapes.resultCount).step cfg = some next) : + (entryUpdateTM tapes).step (entryUpdateDeleteCountWrap tapes cfg) = + some (entryUpdateDeleteCountWrap tapes next) := by + have hne : cfg.state ≠ (TM.binaryPredTM tapes.resultCount).qhalt := + TM.state_ne_qhalt_of_step hstep + rw [TM.step, if_neg (by simp [entryUpdateDeleteCountWrap, entryUpdateTM])] + simp only [entryUpdateDeleteCountWrap, entryUpdateTM, hne, ↓reduceIte] + rw [TM.step, if_neg hne] at hstep + revert hstep + generalize haction : (TM.binaryPredTM tapes.resultCount).δ cfg.state + cfg.input.read (fun i => (cfg.work i).read) cfg.output.read = action + obtain ⟨q', workWrites, outputWrite, inputDir, workDirs, outputDir⟩ := action + simp only [haction] + intro hstep + cases Option.some.inj hstep + rfl + +private theorem entryUpdateTM_appendCount_step + (tapes : EntryUpdateTapes n) + {cfg next : Complexity.Cfg n (TM.binarySuccTM tapes.resultCount).Q} + (hstep : (TM.binarySuccTM tapes.resultCount).step cfg = some next) : + (entryUpdateTM tapes).step (entryUpdateAppendCountWrap tapes cfg) = + some (entryUpdateAppendCountWrap tapes next) := by + have hne : cfg.state ≠ (TM.binarySuccTM tapes.resultCount).qhalt := + TM.state_ne_qhalt_of_step hstep + rw [TM.step, if_neg (by simp [entryUpdateAppendCountWrap, entryUpdateTM])] + simp only [entryUpdateAppendCountWrap, entryUpdateTM, hne, ↓reduceIte] + rw [TM.step, if_neg hne] at hstep + revert hstep + generalize haction : (TM.binarySuccTM tapes.resultCount).δ cfg.state + cfg.input.read (fun i => (cfg.work i).read) cfg.output.read = action + obtain ⟨q', workWrites, outputWrite, inputDir, workDirs, outputDir⟩ := action + simp only [haction] + intro hstep + cases Option.some.inj hstep + rfl + +theorem entryUpdateTM_match_reachesIn_internal + (tapes : EntryUpdateTapes n) {time : ℕ} + {cfg next : Complexity.Cfg n (entryMatchReadTM tapes.entry).Q} + (hreach : (entryMatchReadTM tapes.entry).reachesIn time cfg next) : + (entryUpdateTM tapes).reachesIn time + (entryUpdateMatchWrap tapes cfg) (entryUpdateMatchWrap tapes next) := + TM.reachesIn_map (entryUpdateMatchWrap tapes) + (fun _ _ => entryUpdateTM_match_step tapes) hreach + +theorem entryUpdateTM_miss_reachesIn_internal + (tapes : EntryUpdateTapes n) {time : ℕ} + {cfg next : Complexity.Cfg n (entryMissCopyTM tapes.entry).Q} + (hreach : (entryMissCopyTM tapes.entry).reachesIn time cfg next) : + (entryUpdateTM tapes).reachesIn time + (entryUpdateMissWrap tapes cfg) (entryUpdateMissWrap tapes next) := + TM.reachesIn_map (entryUpdateMissWrap tapes) + (fun _ _ => entryUpdateTM_miss_step tapes) hreach + +theorem entryUpdateTM_delete_reachesIn_internal + (tapes : EntryUpdateTapes n) {time : ℕ} + {cfg next : Complexity.Cfg n (entryMissCleanupTM tapes.entry).Q} + (hreach : (entryMissCleanupTM tapes.entry).reachesIn time cfg next) : + (entryUpdateTM tapes).reachesIn time + (entryUpdateDeleteWrap tapes cfg) (entryUpdateDeleteWrap tapes next) := + TM.reachesIn_map (entryUpdateDeleteWrap tapes) + (fun _ _ => entryUpdateTM_delete_step tapes) hreach + +theorem entryUpdateTM_replace_reachesIn_internal + (tapes : EntryUpdateTapes n) {time : ℕ} + {cfg next : Complexity.Cfg n (entryReplaceCleanupTM tapes.replace).Q} + (hreach : (entryReplaceCleanupTM tapes.replace).reachesIn time cfg next) : + (entryUpdateTM tapes).reachesIn time + (entryUpdateReplaceWrap tapes cfg) (entryUpdateReplaceWrap tapes next) := + TM.reachesIn_map (entryUpdateReplaceWrap tapes) + (fun _ _ => entryUpdateTM_replace_step tapes) hreach + +theorem entryUpdateTM_append_reachesIn_internal + (tapes : EntryUpdateTapes n) {time : ℕ} + {cfg next : Complexity.Cfg n (entryAppendRestoreTM tapes.replace).Q} + (hreach : (entryAppendRestoreTM tapes.replace).reachesIn time cfg next) : + (entryUpdateTM tapes).reachesIn time + (entryUpdateAppendWrap tapes cfg) (entryUpdateAppendWrap tapes next) := + TM.reachesIn_map (entryUpdateAppendWrap tapes) + (fun _ _ => entryUpdateTM_append_step tapes) hreach + +theorem entryUpdateTM_remaining_reachesIn_internal + (tapes : EntryUpdateTapes n) {time : ℕ} + {cfg next : Complexity.Cfg n (TM.binaryPredTM tapes.remaining).Q} + (hreach : (TM.binaryPredTM tapes.remaining).reachesIn time cfg next) : + (entryUpdateTM tapes).reachesIn time + (entryUpdateRemainingWrap tapes cfg) (entryUpdateRemainingWrap tapes next) := + TM.reachesIn_map (entryUpdateRemainingWrap tapes) + (fun _ _ => entryUpdateTM_remaining_step tapes) hreach + +theorem entryUpdateTM_deleteCount_reachesIn_internal + (tapes : EntryUpdateTapes n) {time : ℕ} + {cfg next : Complexity.Cfg n (TM.binaryPredTM tapes.resultCount).Q} + (hreach : (TM.binaryPredTM tapes.resultCount).reachesIn time cfg next) : + (entryUpdateTM tapes).reachesIn time + (entryUpdateDeleteCountWrap tapes cfg) + (entryUpdateDeleteCountWrap tapes next) := + TM.reachesIn_map (entryUpdateDeleteCountWrap tapes) + (fun _ _ => entryUpdateTM_deleteCount_step tapes) hreach + +theorem entryUpdateTM_appendCount_reachesIn_internal + (tapes : EntryUpdateTapes n) {time : ℕ} + {cfg next : Complexity.Cfg n (TM.binarySuccTM tapes.resultCount).Q} + (hreach : (TM.binarySuccTM tapes.resultCount).reachesIn time cfg next) : + (entryUpdateTM tapes).reachesIn time + (entryUpdateAppendCountWrap tapes cfg) + (entryUpdateAppendCountWrap tapes next) := + TM.reachesIn_map (entryUpdateAppendCountWrap tapes) + (fun _ _ => entryUpdateTM_appendCount_step tapes) hreach + +theorem entryUpdateTM_step_test_continue_internal + (tapes : EntryUpdateTapes n) (inp : Tape) (work : Fin n → Tape) (out : Tape) + (hremaining : (work tapes.remaining).read ≠ Γ.blank) + (hinput : TM.Parked inp) (hwork : ∀ i, TM.Parked (work i)) + (houtput : TM.Parked out) : + (entryUpdateTM tapes).step (entryUpdateTestCfg tapes inp work out) = + some (entryUpdateMatchWrap tapes + { state := (entryMatchReadTM tapes.entry).qstart + input := inp, work := work, output := out }) := by + rw [TM.step, if_neg (by simp [entryUpdateTestCfg, entryUpdateTM])] + simp only [entryUpdateTestCfg, entryUpdateTM, hremaining, ↓reduceIte, + entryUpdateMatchWrap] + refine congrArg some (Complexity.Cfg.ext rfl ?_ ?_ ?_) + · exact hinput.move_idle + · funext i + exact (hwork i).writeAndMove_readBack_idle + · exact houtput.writeAndMove_readBack_idle + +theorem entryUpdateTM_step_test_found_internal + (tapes : EntryUpdateTapes n) (inp : Tape) (work : Fin n → Tape) (out : Tape) + (hremaining : (work tapes.remaining).read = Γ.blank) + (hfound : (work tapes.found).read = Γ.one) + (hinput : TM.Parked inp) (hwork : ∀ i, TM.Parked (work i)) + (houtput : TM.Parked out) : + (entryUpdateTM tapes).step (entryUpdateTestCfg tapes inp work out) = + some (entryUpdateDoneCfg tapes inp work out) := by + rw [TM.step, if_neg (by simp [entryUpdateTestCfg, entryUpdateTM])] + simp only [entryUpdateTestCfg, entryUpdateDoneCfg, entryUpdateTM, + hremaining, hfound, ↓reduceIte] + refine congrArg some (Complexity.Cfg.ext rfl ?_ ?_ ?_) + · exact hinput.move_idle + · funext i + exact (hwork i).writeAndMove_readBack_idle + · exact houtput.writeAndMove_readBack_idle + +theorem entryUpdateTM_step_test_zero_internal + (tapes : EntryUpdateTapes n) (inp : Tape) (work : Fin n → Tape) (out : Tape) + (hremaining : (work tapes.remaining).read = Γ.blank) + (hfound : (work tapes.found).read ≠ Γ.one) + (hreplacement : (work tapes.replacement).read = Γ.blank) + (hinput : TM.Parked inp) (hwork : ∀ i, TM.Parked (work i)) + (houtput : TM.Parked out) : + (entryUpdateTM tapes).step (entryUpdateTestCfg tapes inp work out) = + some (entryUpdateDoneCfg tapes inp work out) := by + rw [TM.step, if_neg (by simp [entryUpdateTestCfg, entryUpdateTM])] + simp only [entryUpdateTestCfg, entryUpdateDoneCfg, entryUpdateTM, + hremaining, hfound, hreplacement, ↓reduceIte] + refine congrArg some (Complexity.Cfg.ext rfl ?_ ?_ ?_) + · exact hinput.move_idle + · funext i + exact (hwork i).writeAndMove_readBack_idle + · exact houtput.writeAndMove_readBack_idle + +theorem entryUpdateTM_step_test_append_internal + (tapes : EntryUpdateTapes n) (inp : Tape) (work : Fin n → Tape) (out : Tape) + (hremaining : (work tapes.remaining).read = Γ.blank) + (hfound : (work tapes.found).read ≠ Γ.one) + (hreplacement : (work tapes.replacement).read ≠ Γ.blank) + (hinput : TM.Parked inp) (hwork : ∀ i, TM.Parked (work i)) + (houtput : TM.Parked out) : + (entryUpdateTM tapes).step (entryUpdateTestCfg tapes inp work out) = + some (entryUpdateAppendWrap tapes + { state := (entryAppendRestoreTM tapes.replace).qstart + input := inp, work := work, output := out }) := by + rw [TM.step, if_neg (by simp [entryUpdateTestCfg, entryUpdateTM])] + simp only [entryUpdateTestCfg, entryUpdateTM, hremaining, hfound, + hreplacement, ↓reduceIte, entryUpdateAppendWrap] + refine congrArg some (Complexity.Cfg.ext rfl ?_ ?_ ?_) + · exact hinput.move_idle + · funext i + exact (hwork i).writeAndMove_readBack_idle + · exact houtput.writeAndMove_readBack_idle + +private theorem entryUpdateMarkFoundWork_apply_eq + (tapes : EntryUpdateTapes n) (work : Fin n → Tape) : + entryUpdateMarkFoundWork tapes work tapes.found = + (work tapes.found).writeAndMove Γ.one + (TM.idleDir (work tapes.found).read) := by + simp [entryUpdateMarkFoundWork] + +private theorem entryUpdateMarkFoundWork_apply_ne + (tapes : EntryUpdateTapes n) (work : Fin n → Tape) + (i : Fin n) (hi : i ≠ tapes.found) : + entryUpdateMarkFoundWork tapes work i = work i := by + simp [entryUpdateMarkFoundWork, Function.update_of_ne hi] + +theorem entryUpdateTM_step_match_delete_internal + (tapes : EntryUpdateTapes n) + (cfg : Complexity.Cfg n (entryMatchReadTM tapes.entry).Q) + (hhalt : (entryMatchReadTM tapes.entry).halted cfg) + (hresult : (cfg.work tapes.entry.result).read = Γ.one) + (hreplacement : (cfg.work tapes.replacement).read = Γ.blank) + (hinput : TM.Parked cfg.input) (hwork : ∀ i, TM.Parked (cfg.work i)) + (houtput : TM.Parked cfg.output) : + (entryUpdateTM tapes).step (entryUpdateMatchWrap tapes cfg) = + some (entryUpdateDeleteWrap tapes + { state := (entryMissCleanupTM tapes.entry).qstart + input := cfg.input + work := entryUpdateMarkFoundWork tapes cfg.work + output := cfg.output }) := by + rw [TM.step, if_neg (by simp [entryUpdateMatchWrap, entryUpdateTM])] + simp only [entryUpdateMatchWrap, entryUpdateDeleteWrap, entryUpdateTM, + hhalt, hresult, hreplacement, ↓reduceIte] + refine congrArg some (Complexity.Cfg.ext rfl ?_ ?_ ?_) + · exact hinput.move_idle + · funext i + change (cfg.work i).writeAndMove + (if i = tapes.found then Γw.one + else TM.readBackWrite (cfg.work i).read).toΓ + (TM.idleDir (cfg.work i).read) = + entryUpdateMarkFoundWork tapes cfg.work i + by_cases hi : i = tapes.found + · subst i + simp [entryUpdateMarkFoundWork] + · simp only [hi, if_false, + entryUpdateMarkFoundWork_apply_ne tapes cfg.work i hi] + exact (hwork i).writeAndMove_readBack_idle + · exact houtput.writeAndMove_readBack_idle + +theorem entryUpdateTM_step_match_replace_internal + (tapes : EntryUpdateTapes n) + (cfg : Complexity.Cfg n (entryMatchReadTM tapes.entry).Q) + (hhalt : (entryMatchReadTM tapes.entry).halted cfg) + (hresult : (cfg.work tapes.entry.result).read = Γ.one) + (hreplacement : (cfg.work tapes.replacement).read ≠ Γ.blank) + (hinput : TM.Parked cfg.input) (hwork : ∀ i, TM.Parked (cfg.work i)) + (houtput : TM.Parked cfg.output) : + (entryUpdateTM tapes).step (entryUpdateMatchWrap tapes cfg) = + some (entryUpdateReplaceWrap tapes + { state := (entryReplaceCleanupTM tapes.replace).qstart + input := cfg.input + work := entryUpdateMarkFoundWork tapes cfg.work + output := cfg.output }) := by + rw [TM.step, if_neg (by simp [entryUpdateMatchWrap, entryUpdateTM])] + simp only [entryUpdateMatchWrap, entryUpdateReplaceWrap, entryUpdateTM, + hhalt, hresult, hreplacement, ↓reduceIte] + refine congrArg some (Complexity.Cfg.ext rfl ?_ ?_ ?_) + · exact hinput.move_idle + · funext i + change (cfg.work i).writeAndMove + (if i = tapes.found then Γw.one + else TM.readBackWrite (cfg.work i).read).toΓ + (TM.idleDir (cfg.work i).read) = + entryUpdateMarkFoundWork tapes cfg.work i + by_cases hi : i = tapes.found + · subst i + simp [entryUpdateMarkFoundWork] + · simp only [hi, if_false, + entryUpdateMarkFoundWork_apply_ne tapes cfg.work i hi] + exact (hwork i).writeAndMove_readBack_idle + · exact houtput.writeAndMove_readBack_idle + +theorem entryUpdateTM_step_match_miss_internal + (tapes : EntryUpdateTapes n) + (cfg : Complexity.Cfg n (entryMatchReadTM tapes.entry).Q) + (hhalt : (entryMatchReadTM tapes.entry).halted cfg) + (hresult : (cfg.work tapes.entry.result).read ≠ Γ.one) + (hinput : TM.Parked cfg.input) (hwork : ∀ i, TM.Parked (cfg.work i)) + (houtput : TM.Parked cfg.output) : + (entryUpdateTM tapes).step (entryUpdateMatchWrap tapes cfg) = + some (entryUpdateMissWrap tapes + { state := (entryMissCopyTM tapes.entry).qstart + input := cfg.input, work := cfg.work, output := cfg.output }) := by + rw [TM.step, if_neg (by simp [entryUpdateMatchWrap, entryUpdateTM])] + simp only [entryUpdateMatchWrap, entryUpdateMissWrap, entryUpdateTM, + hhalt, hresult, ↓reduceIte] + refine congrArg some (Complexity.Cfg.ext rfl ?_ ?_ ?_) + · exact hinput.move_idle + · funext i + exact (hwork i).writeAndMove_readBack_idle + · exact houtput.writeAndMove_readBack_idle + +theorem entryUpdateTM_step_miss_halt_internal + (tapes : EntryUpdateTapes n) + (cfg : Complexity.Cfg n (entryMissCopyTM tapes.entry).Q) + (hhalt : (entryMissCopyTM tapes.entry).halted cfg) + (hinput : TM.Parked cfg.input) (hwork : ∀ i, TM.Parked (cfg.work i)) + (houtput : TM.Parked cfg.output) : + (entryUpdateTM tapes).step (entryUpdateMissWrap tapes cfg) = + some (entryUpdateRemainingWrap tapes + { state := (TM.binaryPredTM tapes.remaining).qstart + input := cfg.input, work := cfg.work, output := cfg.output }) := by + rw [TM.step, if_neg (by simp [entryUpdateMissWrap, entryUpdateTM])] + simp only [entryUpdateMissWrap, entryUpdateRemainingWrap, entryUpdateTM, + hhalt, ↓reduceIte] + refine congrArg some (Complexity.Cfg.ext rfl ?_ ?_ ?_) + · exact hinput.move_idle + · funext i + exact (hwork i).writeAndMove_readBack_idle + · exact houtput.writeAndMove_readBack_idle + +theorem entryUpdateTM_step_delete_halt_internal + (tapes : EntryUpdateTapes n) + (cfg : Complexity.Cfg n (entryMissCleanupTM tapes.entry).Q) + (hhalt : (entryMissCleanupTM tapes.entry).halted cfg) + (hinput : TM.Parked cfg.input) (hwork : ∀ i, TM.Parked (cfg.work i)) + (houtput : TM.Parked cfg.output) : + (entryUpdateTM tapes).step (entryUpdateDeleteWrap tapes cfg) = + some (entryUpdateDeleteCountWrap tapes + { state := (TM.binaryPredTM tapes.resultCount).qstart + input := cfg.input, work := cfg.work, output := cfg.output }) := by + rw [TM.step, if_neg (by simp [entryUpdateDeleteWrap, entryUpdateTM])] + simp only [entryUpdateDeleteWrap, entryUpdateDeleteCountWrap, + entryUpdateTM, hhalt, ↓reduceIte] + refine congrArg some (Complexity.Cfg.ext rfl ?_ ?_ ?_) + · exact hinput.move_idle + · funext i + exact (hwork i).writeAndMove_readBack_idle + · exact houtput.writeAndMove_readBack_idle + +theorem entryUpdateTM_step_replace_halt_internal + (tapes : EntryUpdateTapes n) + (cfg : Complexity.Cfg n (entryReplaceCleanupTM tapes.replace).Q) + (hhalt : (entryReplaceCleanupTM tapes.replace).halted cfg) + (hinput : TM.Parked cfg.input) (hwork : ∀ i, TM.Parked (cfg.work i)) + (houtput : TM.Parked cfg.output) : + (entryUpdateTM tapes).step (entryUpdateReplaceWrap tapes cfg) = + some (entryUpdateRemainingWrap tapes + { state := (TM.binaryPredTM tapes.remaining).qstart + input := cfg.input, work := cfg.work, output := cfg.output }) := by + rw [TM.step, if_neg (by simp [entryUpdateReplaceWrap, entryUpdateTM])] + simp only [entryUpdateReplaceWrap, entryUpdateRemainingWrap, entryUpdateTM, + hhalt, ↓reduceIte] + refine congrArg some (Complexity.Cfg.ext rfl ?_ ?_ ?_) + · exact hinput.move_idle + · funext i + exact (hwork i).writeAndMove_readBack_idle + · exact houtput.writeAndMove_readBack_idle + +theorem entryUpdateTM_step_append_halt_internal + (tapes : EntryUpdateTapes n) + (cfg : Complexity.Cfg n (entryAppendRestoreTM tapes.replace).Q) + (hhalt : (entryAppendRestoreTM tapes.replace).halted cfg) + (hinput : TM.Parked cfg.input) (hwork : ∀ i, TM.Parked (cfg.work i)) + (houtput : TM.Parked cfg.output) : + (entryUpdateTM tapes).step (entryUpdateAppendWrap tapes cfg) = + some (entryUpdateAppendCountWrap tapes + { state := (TM.binarySuccTM tapes.resultCount).qstart + input := cfg.input, work := cfg.work, output := cfg.output }) := by + rw [TM.step, if_neg (by simp [entryUpdateAppendWrap, entryUpdateTM])] + simp only [entryUpdateAppendWrap, entryUpdateAppendCountWrap, entryUpdateTM, + hhalt, ↓reduceIte] + refine congrArg some (Complexity.Cfg.ext rfl ?_ ?_ ?_) + · exact hinput.move_idle + · funext i + exact (hwork i).writeAndMove_readBack_idle + · exact houtput.writeAndMove_readBack_idle + +theorem entryUpdateTM_step_remaining_halt_internal + (tapes : EntryUpdateTapes n) + (cfg : Complexity.Cfg n (TM.binaryPredTM tapes.remaining).Q) + (hhalt : (TM.binaryPredTM tapes.remaining).halted cfg) + (hinput : TM.Parked cfg.input) (hwork : ∀ i, TM.Parked (cfg.work i)) + (houtput : TM.Parked cfg.output) : + (entryUpdateTM tapes).step (entryUpdateRemainingWrap tapes cfg) = + some (entryUpdateTestCfg tapes cfg.input cfg.work cfg.output) := by + rw [TM.step, if_neg (by simp [entryUpdateRemainingWrap, entryUpdateTM])] + simp only [entryUpdateRemainingWrap, entryUpdateTestCfg, entryUpdateTM, + hhalt, ↓reduceIte] + refine congrArg some (Complexity.Cfg.ext rfl ?_ ?_ ?_) + · exact hinput.move_idle + · funext i + exact (hwork i).writeAndMove_readBack_idle + · exact houtput.writeAndMove_readBack_idle + +theorem entryUpdateTM_step_deleteCount_halt_internal + (tapes : EntryUpdateTapes n) + (cfg : Complexity.Cfg n (TM.binaryPredTM tapes.resultCount).Q) + (hhalt : (TM.binaryPredTM tapes.resultCount).halted cfg) + (hinput : TM.Parked cfg.input) (hwork : ∀ i, TM.Parked (cfg.work i)) + (houtput : TM.Parked cfg.output) : + (entryUpdateTM tapes).step (entryUpdateDeleteCountWrap tapes cfg) = + some (entryUpdateRemainingWrap tapes + { state := (TM.binaryPredTM tapes.remaining).qstart + input := cfg.input, work := cfg.work, output := cfg.output }) := by + rw [TM.step, if_neg (by simp [entryUpdateDeleteCountWrap, entryUpdateTM])] + simp only [entryUpdateDeleteCountWrap, entryUpdateRemainingWrap, + entryUpdateTM, hhalt, ↓reduceIte] + refine congrArg some (Complexity.Cfg.ext rfl ?_ ?_ ?_) + · exact hinput.move_idle + · funext i + exact (hwork i).writeAndMove_readBack_idle + · exact houtput.writeAndMove_readBack_idle + +theorem entryUpdateTM_step_appendCount_halt_internal + (tapes : EntryUpdateTapes n) + (cfg : Complexity.Cfg n (TM.binarySuccTM tapes.resultCount).Q) + (hhalt : (TM.binarySuccTM tapes.resultCount).halted cfg) + (hinput : TM.Parked cfg.input) (hwork : ∀ i, TM.Parked (cfg.work i)) + (houtput : TM.Parked cfg.output) : + (entryUpdateTM tapes).step (entryUpdateAppendCountWrap tapes cfg) = + some (entryUpdateDoneCfg tapes cfg.input cfg.work cfg.output) := by + rw [TM.step, if_neg (by simp [entryUpdateAppendCountWrap, entryUpdateTM])] + simp only [entryUpdateAppendCountWrap, entryUpdateDoneCfg, entryUpdateTM, + hhalt, ↓reduceIte] + refine congrArg some (Complexity.Cfg.ext rfl ?_ ?_ ?_) + · exact hinput.move_idle + · funext i + exact (hwork i).writeAndMove_readBack_idle + · exact houtput.writeAndMove_readBack_idle + +end Machine + +end RegisterStore + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/End.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/End.lean new file mode 100644 index 0000000000..febd8243a0 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/End.lean @@ -0,0 +1,253 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import +LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Loop +import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Out +import +LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Time +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.WorkBranch + +/-! +# Bounded encoded sparse-store update -- terminal loop case + +This file closes the update loop once the old-entry counter is exhausted. A +previous hit and an absent zero write halt immediately; an absent nonzero write +runs the checked append and result-count successor subroutines. +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace RegisterStore + +namespace Machine + +variable {n : ℕ} + +/-- Once no old entries remain, the controller realizes the pure sparse-store +write and establishes the complete final tape contract. -/ +theorem entryUpdateTerminal_internal + (tapes : EntryUpdateTapes n) (store : Store) (address newValue : ℕ) + (processed emitted : Store) (found : Bool) (resultCount : ℕ) + (initialWork work : Fin n → Tape) (outPrefix : List Bool) + (inp out : Tape) + (hinv : EntryUpdateLoopInv tapes store address newValue processed [] + emitted found resultCount initialWork work) + (hinput : TM.Parked inp) + (houtput : out.HasBinaryPrefix + (outPrefix ++ emitted.flatMap Entry.encode)) : + ∃ final time, + time ≤ entryUpdateLoopTime tapes address newValue store.length [] ∧ + (entryUpdateTM tapes).reachesIn time + (entryUpdateTestCfg tapes inp work out) final ∧ + (entryUpdateTM tapes).halted final ∧ + final.input = inp ∧ + EntryUpdateOutcome tapes store address newValue initialWork final.work ∧ + final.output.HasBinaryPrefix + (outPrefix ++ (RegisterStore.write store address newValue).flatMap + Entry.encode) := by + have hremainingRead : (work tapes.remaining).read = Γ.blank := + hinv.remainingCount.read_eq_blank_iff.mpr rfl + have houtputParked : TM.Parked out := + parked_of_binaryPrefix_internal houtput + cases found with + | false => + have hfoundZero : (work tapes.found).HasBinaryNat 0 := by + simpa using hinv.foundCount + have hfoundRead : (work tapes.found).read ≠ Γ.one := by + rw [hfoundZero.read_eq_blank_iff.mpr rfl] + decide + have hnotmemProcessed : address ∉ processed.map Prod.fst := by + intro hmem + exact Bool.false_ne_true (hinv.progress.found_iff.mpr hmem) + have hnotmemStore : address ∉ store.map Prod.fst := by + rw [hinv.progress.store_eq] + simpa using hnotmemProcessed + by_cases hvalue : newValue = 0 + · subst newValue + have hreplacementRead : (work tapes.replacement).read = Γ.blank := + hinv.replacement.read_eq_blank_iff.mpr rfl + have hstep := entryUpdateTM_step_test_zero_internal tapes inp work out + hremainingRead hfoundRead hreplacementRead hinput hinv.ready.parked + houtputParked + obtain ⟨houtputEq, hcountEq⟩ := + hinv.progress.terminal_zero_internal + refine ⟨entryUpdateDoneCfg tapes inp work out, 1, ?_, + .step hstep .zero, rfl, rfl, ?_, ?_⟩ + · simp [entryUpdateLoopTime] + · exact + { ready := hinv.ready + replacement := hinv.replacement_eq + remaining := hinv.remainingCount + found := by simpa [hnotmemStore] using hfoundZero + resultCount := by + simpa [hcountEq] using hinv.resultCountTape + frame := hinv.frame } + · simpa [houtputEq] using houtput + · have hreplacementRead : + (work tapes.replacement).read ≠ Γ.blank := by + intro hblank + exact hvalue (hinv.replacement.read_eq_blank_iff.mp hblank) + have htest := entryUpdateTM_step_test_append_internal tapes inp work out + hremainingRead hfoundRead hreplacementRead hinput hinv.ready.parked + houtputParked + have happendContract := entryAppendRestoreTM_hoareTime_frame + tapes.replace address newValue + (outPrefix ++ emitted.flatMap Entry.encode) work work inp out + hinv.ready hinv.replacement hinput houtput + obtain ⟨appendDone, appendTime, happendTime, happendReach, + happendHalt, happendInput, happendWork, happendOutput⟩ := + happendContract inp work out ⟨rfl, rfl, rfl⟩ + have happendReach' := + entryUpdateTM_append_reachesIn_internal tapes happendReach + have happendInputParked : TM.Parked appendDone.input := by + rw [happendInput] + exact hinput + have happendWorkParked : ∀ i, TM.Parked (appendDone.work i) := by + intro i + rw [happendWork] + exact hinv.ready.parked i + have happendOutputParked : TM.Parked appendDone.output := + parked_of_binaryPrefix_internal happendOutput + have happendSeam := entryUpdateTM_step_append_halt_internal tapes + appendDone happendHalt happendInputParked happendWorkParked + happendOutputParked + have hresultCount : + (appendDone.work tapes.resultCount).HasBinaryNat resultCount := by + rw [happendWork] + exact hinv.resultCountTape + obtain ⟨succDone, hsuccReach, hsuccHalt, hsuccInput, hsuccOther, + hsuccCount, hsuccOutput⟩ := + TM.binarySuccTM_reachesIn_frame tapes.resultCount resultCount + appendDone.input appendDone.work appendDone.output hresultCount + happendInputParked.read_ne_start + (fun i _ => (happendWorkParked i).read_ne_start) + happendOutputParked.read_ne_start + have hsuccReach' := + entryUpdateTM_appendCount_reachesIn_internal tapes hsuccReach + have hsuccInputParked : TM.Parked succDone.input := by + rw [hsuccInput] + exact happendInputParked + have hsuccWorkParked : ∀ i, TM.Parked (succDone.work i) := by + intro i + by_cases hi : i = tapes.resultCount + · subst i + exact entryUpdateParked_of_hasBinaryNat_internal hsuccCount + · rw [hsuccOther i hi] + exact happendWorkParked i + have hsuccOutputParked : TM.Parked succDone.output := by + rw [hsuccOutput] + exact happendOutputParked + have hfinish := entryUpdateTM_step_appendCount_halt_internal tapes + succDone hsuccHalt hsuccInputParked hsuccWorkParked + hsuccOutputParked + have hprefixReach : (entryUpdateTM tapes).reachesIn + (appendTime + 1) (entryUpdateTestCfg tapes inp work out) + (entryUpdateAppendWrap tapes appendDone) := + .step htest happendReach' + have hsuccPrefix : (entryUpdateTM tapes).reachesIn + (TM.binarySuccTime resultCount + 1) + (entryUpdateAppendWrap tapes appendDone) + (entryUpdateAppendCountWrap tapes succDone) := + .step happendSeam hsuccReach' + have htotalReach : (entryUpdateTM tapes).reachesIn + ((appendTime + 1) + (TM.binarySuccTime resultCount + 1) + 1) + (entryUpdateTestCfg tapes inp work out) + (entryUpdateDoneCfg tapes succDone.input succDone.work + succDone.output) := + TM.reachesIn_trans _ + (TM.reachesIn_trans _ hprefixReach hsuccPrefix) + (.step hfinish .zero) + have hotherWork : ∀ i, i ≠ tapes.resultCount → + succDone.work i = work i := by + intro i hi + exact (hsuccOther i hi).trans (congrFun happendWork i) + have hreadyFinal := hinv.ready.change_resultCount_internal + hotherWork hsuccCount + obtain ⟨houtputEq, hcountEq⟩ := + hinv.progress.terminal_append_internal hvalue + have hfinalOutput : succDone.output.HasBinaryPrefix + (outPrefix ++ (RegisterStore.write store address newValue).flatMap + Entry.encode) := by + rw [hsuccOutput] + rw [← houtputEq] + simpa [List.flatMap_append, List.append_assoc] using + happendOutput + have hfinalFrame : EntryUpdateFrame tapes initialWork succDone.work := + EntryUpdateFrame.trans_single_internal hinv.frame (12 : Fin 13) + (by + intro i hi + exact hotherWork i (by + simpa [EntryUpdateTapes.resultCount] using hi)) + have hsuccTimeBound := + binarySuccTime_le_entryUpdateCountTime_internal hinv.resultCount_le + refine ⟨entryUpdateDoneCfg tapes succDone.input succDone.work + succDone.output, + (appendTime + 1) + (TM.binarySuccTime resultCount + 1) + 1, + ?_, htotalReach, rfl, ?_, ?_, ?_⟩ + · simp only [entryUpdateLoopTime] + omega + · simpa [entryUpdateDoneCfg] using hsuccInput.trans happendInput + · exact + { ready := hreadyFinal + replacement := by + exact (hotherWork tapes.replacement + tapes.replacement_ne_resultCount).trans + hinv.replacement_eq + remaining := by + change (succDone.work tapes.remaining).HasBinaryNat 0 + rw [hotherWork tapes.remaining + tapes.remaining_ne_resultCount] + exact hinv.remainingCount + found := by + change (succDone.work tapes.found).HasBinaryNat + (if address ∈ store.map Prod.fst then 1 else 0) + rw [hotherWork tapes.found tapes.found_ne_resultCount] + simpa [hnotmemStore] using hfoundZero + resultCount := by simpa [hcountEq] using hsuccCount + frame := hfinalFrame } + · simpa [entryUpdateDoneCfg] using hfinalOutput + | true => + have hfoundOne : (work tapes.found).HasBinaryNat 1 := by + simpa using hinv.foundCount + have hfoundRead : (work tapes.found).read = Γ.one := by + simpa [Nat.bits, Γ.ofBool] using + hfoundOne.2.hasBinarySuffix.read_cons + have hmemProcessed : address ∈ processed.map Prod.fst := + hinv.progress.found_iff.mp rfl + have hmemStore : address ∈ store.map Prod.fst := by + rw [hinv.progress.store_eq] + simpa using hmemProcessed + have hstep := entryUpdateTM_step_test_found_internal tapes inp work out + hremainingRead hfoundRead hinput hinv.ready.parked houtputParked + obtain ⟨houtputEq, hcountEq⟩ := + hinv.progress.terminal_found_internal + refine ⟨entryUpdateDoneCfg tapes inp work out, 1, ?_, + .step hstep .zero, rfl, rfl, ?_, ?_⟩ + · simp [entryUpdateLoopTime] + · exact + { ready := hinv.ready + replacement := hinv.replacement_eq + remaining := hinv.remainingCount + found := by simpa [hmemStore] using hfoundOne + resultCount := by simpa [hcountEq] using hinv.resultCountTape + frame := hinv.frame } + · simpa [houtputEq] using houtput + +end Machine + +end RegisterStore + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Hit.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Hit.lean new file mode 100644 index 0000000000..5cc510c686 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Hit.lean @@ -0,0 +1,598 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import +LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Loop +import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Out +import +LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Time +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.WorkBranch + +/-! +# Bounded encoded sparse-store update -- matching iterations + +This file composes the checked match, deletion or replacement, and counter +subroutines for the two branches in which the current old entry has the +requested address. +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace RegisterStore + +namespace Machine + +variable {n : ℕ} + +/-- A matching zero write deletes the current entry, decrements both runtime +counters, and returns to the loop test with no output contribution. -/ +theorem entryUpdateDeleteIteration_internal + (tapes : EntryUpdateTapes n) (store : Store) (address : ℕ) + (processed emitted : Store) (entry : Entry) (rest : Store) + (resultCount : ℕ) (initialWork work : Fin n → Tape) + (outPrefix : List Bool) (inp out : Tape) + (hinv : EntryUpdateLoopInv tapes store address 0 processed + (entry :: rest) emitted false resultCount initialWork work) + (haddress : address = entry.1) + (hinput : TM.Parked inp) + (houtput : out.HasBinaryPrefix + (outPrefix ++ emitted.flatMap Entry.encode)) : + ∃ nextWork nextOut time, + time ≤ entryUpdateIterationTime tapes entry rest address 0 + store.length ∧ + (entryUpdateTM tapes).reachesIn time + (entryUpdateTestCfg tapes inp work out) + (entryUpdateTestCfg tapes inp nextWork nextOut) ∧ + EntryUpdateLoopInv tapes store address 0 (processed ++ [entry]) rest + emitted true (resultCount - 1) initialWork nextWork ∧ + nextOut.HasBinaryPrefix + (outPrefix ++ emitted.flatMap Entry.encode) := by + have hready : EntryScanReady tapes.entry + (Entry.encode entry ++ rest.flatMap Entry.encode) address.bits work work := by + simpa using hinv.ready + have hremainingPositive : + (work tapes.remaining).HasBinaryNat (rest.length + 1) := by + simpa using hinv.remainingCount + have hremainingRead : (work tapes.remaining).read ≠ Γ.blank := by + intro hblank + have hzero := hremainingPositive.read_eq_blank_iff.mp hblank + omega + have houtputParked : TM.Parked out := + parked_of_binaryPrefix_internal houtput + have htest := entryUpdateTM_step_test_continue_internal tapes inp work out + hremainingRead hinput hready.parked houtputParked + have hmatchContract := entryMatchReadTM_reachesIn_frame tapes.entry entry + (rest.flatMap Entry.encode) address.bits inp work out hready.source + hready.address hready.value hready.addressStart hready.valueStart + hready.addressCounter hready.addressWidth hready.valueCounter + hready.valueWidth hready.query hready.queryStart hready.result + hready.resultStart hinput hready.parked houtputParked + obtain ⟨matchDone, matchTime, hmatchTime, hmatchReach, hmatchHalt, + hmatchInput, hmatchInv, hmatchOutput⟩ := hmatchContract + have hmatchReach' := + entryUpdateTM_match_reachesIn_internal tapes hmatchReach + have hmatchInputParked : TM.Parked matchDone.input := by + rw [hmatchInput] + exact hinput + have hmatchOutputParked : TM.Parked matchDone.output := by + rw [hmatchOutput] + exact houtputParked + have hmatchFound : matchDone.work tapes.found = work tapes.found := + hmatchInv.frame_outside_entry_internal tapes.found + tapes.found_ne_entry + have hfoundZero : (work tapes.found).HasBinaryNat 0 := by + simpa using hinv.foundCount + have hmatchFoundZero : + (matchDone.work tapes.found).HasBinaryNat 0 := by + rw [hmatchFound] + exact hfoundZero + have hresultOne : (matchDone.work tapes.entry.result).read = Γ.one := + hmatchInv.result_read_eq_one_iff.mpr (congrArg Nat.bits haddress.symm) + have hmatchReplacement : + matchDone.work tapes.replacement = work tapes.replacement := + hmatchInv.frame_outside_entry_internal tapes.replacement + tapes.replacement_ne_entry + have hreplacementBlank : + (matchDone.work tapes.replacement).read = Γ.blank := by + rw [hmatchReplacement] + exact hinv.replacement.read_eq_blank_iff.mpr rfl + have hdispatch := entryUpdateTM_step_match_delete_internal tapes matchDone + hmatchHalt hresultOne hreplacementBlank hmatchInputParked hmatchInv.parked + hmatchOutputParked + have hmatchMarked := hmatchInv.markFound_internal hmatchFoundZero + have hreadyMarked := hready.markFound_internal hfoundZero + have hcleanupContract := entryMissCleanupTM_hoareTime_frame tapes.entry entry + (rest.flatMap Entry.encode) address.bits + (entryUpdateMarkFoundWork tapes work) + (entryUpdateMarkFoundWork tapes matchDone.work) + matchDone.input matchDone.output hmatchMarked hmatchInputParked + hmatchOutputParked + obtain ⟨deleteDone, deleteTime, hdeleteTime, hdeleteReach, hdeleteHalt, + hdeleteInput, hdeleteReady, hdeleteOutput⟩ := + hcleanupContract matchDone.input + (entryUpdateMarkFoundWork tapes matchDone.work) matchDone.output + ⟨rfl, rfl, rfl⟩ + have hdeleteReach' := + entryUpdateTM_delete_reachesIn_internal tapes hdeleteReach + have hdeleteInputParked : TM.Parked deleteDone.input := by + rw [hdeleteInput] + exact hmatchInputParked + have hdeleteOutputParked : TM.Parked deleteDone.output := by + rw [hdeleteOutput] + exact hmatchOutputParked + have hdeleteSeam := entryUpdateTM_step_delete_halt_internal tapes + deleteDone hdeleteHalt hdeleteInputParked hdeleteReady.parked + hdeleteOutputParked + have hdeleteResultCount : + (deleteDone.work tapes.resultCount).HasBinaryNat resultCount := by + rw [hdeleteReady.frame_outside_entry_internal tapes.resultCount + tapes.resultCount_ne_entry] + rw [entryUpdateMarkFoundWork_apply_ne_internal tapes work + tapes.resultCount (Ne.symm tapes.found_ne_resultCount)] + exact hinv.resultCountTape + have hresultPositive : 0 < resultCount := by + rw [hinv.progress.resultCount_eq] + simp + have hdeleteResultCountPositive : + (deleteDone.work tapes.resultCount).HasBinaryNat + ((resultCount - 1) + 1) := by + convert hdeleteResultCount using 1 + omega + obtain ⟨countDone, hcountReach, hcountHalt, hcountInput, + hcountOther, hcountValue, hcountOutput⟩ := + TM.binaryPredTM_reachesIn_frame tapes.resultCount (resultCount - 1) + deleteDone.input deleteDone.work deleteDone.output + hdeleteResultCountPositive hdeleteInputParked.read_ne_start + (fun i _ => (hdeleteReady.parked i).read_ne_start) + hdeleteOutputParked.read_ne_start + have hcountReach' := + entryUpdateTM_deleteCount_reachesIn_internal tapes hcountReach + have hcountInputParked : TM.Parked countDone.input := by + rw [hcountInput] + exact hdeleteInputParked + have hcountWorkParked : ∀ i, TM.Parked (countDone.work i) := by + intro i + by_cases hi : i = tapes.resultCount + · subst i + exact entryUpdateParked_of_hasBinaryNat_internal hcountValue + · rw [hcountOther i hi] + exact hdeleteReady.parked i + have hcountOutputParked : TM.Parked countDone.output := by + rw [hcountOutput] + exact hdeleteOutputParked + have hcountSeam := entryUpdateTM_step_deleteCount_halt_internal tapes + countDone hcountHalt hcountInputParked hcountWorkParked + hcountOutputParked + have hreadyCount := hdeleteReady.change_resultCount_internal + hcountOther hcountValue + have hcountRemaining : + (countDone.work tapes.remaining).HasBinaryNat (rest.length + 1) := by + rw [hcountOther tapes.remaining tapes.remaining_ne_resultCount] + rw [hdeleteReady.frame_outside_entry_internal tapes.remaining + tapes.remaining_ne_entry] + rw [entryUpdateMarkFoundWork_apply_ne_internal tapes work + tapes.remaining tapes.remaining_ne_found] + exact hremainingPositive + obtain ⟨remainingDone, hremainingReach, hremainingHalt, + hremainingInput, hremainingOther, hremainingValue, + hremainingOutput⟩ := + TM.binaryPredTM_reachesIn_frame tapes.remaining rest.length + countDone.input countDone.work countDone.output hcountRemaining + hcountInputParked.read_ne_start + (fun i _ => (hcountWorkParked i).read_ne_start) + hcountOutputParked.read_ne_start + have hremainingReach' := + entryUpdateTM_remaining_reachesIn_internal tapes hremainingReach + have hremainingInputParked : TM.Parked remainingDone.input := by + rw [hremainingInput] + exact hcountInputParked + have hremainingWorkParked : ∀ i, TM.Parked (remainingDone.work i) := by + intro i + by_cases hi : i = tapes.remaining + · subst i + exact entryUpdateParked_of_hasBinaryNat_internal hremainingValue + · rw [hremainingOther i hi] + exact hcountWorkParked i + have hremainingOutputParked : TM.Parked remainingDone.output := by + rw [hremainingOutput] + exact hcountOutputParked + have hloop := entryUpdateTM_step_remaining_halt_internal tapes + remainingDone hremainingHalt hremainingInputParked hremainingWorkParked + hremainingOutputParked + have hreadyFinal := hreadyCount.change_remaining_internal + hremainingOther hremainingValue + have hprefix : (entryUpdateTM tapes).reachesIn (matchTime + 1) + (entryUpdateTestCfg tapes inp work out) + (entryUpdateMatchWrap tapes matchDone) := + .step htest hmatchReach' + have htoDelete : (entryUpdateTM tapes).reachesIn + (matchTime + 1 + 1) + (entryUpdateTestCfg tapes inp work out) + (entryUpdateDeleteWrap tapes + { state := (entryMissCleanupTM tapes.entry).qstart + input := matchDone.input + work := entryUpdateMarkFoundWork tapes matchDone.work + output := matchDone.output }) := + TM.reachesIn_trans _ hprefix (.step hdispatch .zero) + have hthroughDelete := TM.reachesIn_trans (entryUpdateTM tapes) + htoDelete hdeleteReach' + have htoCount := TM.reachesIn_trans (entryUpdateTM tapes) + hthroughDelete (.step hdeleteSeam .zero) + have hthroughCount := TM.reachesIn_trans (entryUpdateTM tapes) + htoCount hcountReach' + have htoRemaining := TM.reachesIn_trans (entryUpdateTM tapes) + hthroughCount (.step hcountSeam .zero) + have hthroughRemaining := TM.reachesIn_trans (entryUpdateTM tapes) + htoRemaining hremainingReach' + have htotalReach := TM.reachesIn_trans (entryUpdateTM tapes) + hthroughRemaining (.step hloop .zero) + have hinputEq : remainingDone.input = inp := + hremainingInput.trans (hcountInput.trans + (hdeleteInput.trans hmatchInput)) + have houtputEq : remainingDone.output = out := + hremainingOutput.trans (hcountOutput.trans + (hdeleteOutput.trans hmatchOutput)) + have hreplacementEq : + remainingDone.work tapes.replacement = + initialWork tapes.replacement := by + rw [hremainingOther tapes.replacement + (Ne.symm tapes.remaining_ne_replacement)] + rw [hcountOther tapes.replacement tapes.replacement_ne_resultCount] + rw [hdeleteReady.frame_outside_entry_internal tapes.replacement + tapes.replacement_ne_entry] + rw [entryUpdateMarkFoundWork_apply_ne_internal tapes work + tapes.replacement tapes.replacement_ne_found] + exact hinv.replacement_eq + have hreplacementFinal : + (remainingDone.work tapes.replacement).HasBinaryNat 0 := by + rw [hreplacementEq] + rw [← hinv.replacement_eq] + exact hinv.replacement + have hfoundFinal : + (remainingDone.work tapes.found).HasBinaryNat 1 := by + rw [hremainingOther tapes.found + (Ne.symm tapes.remaining_ne_found)] + rw [hcountOther tapes.found tapes.found_ne_resultCount] + rw [hdeleteReady.frame_outside_entry_internal tapes.found + tapes.found_ne_entry] + exact entryUpdateMarkFoundWork_found_one_internal tapes work hfoundZero + have hresultFinal : + (remainingDone.work tapes.resultCount).HasBinaryNat + (resultCount - 1) := by + rw [hremainingOther tapes.resultCount + (Ne.symm tapes.remaining_ne_resultCount)] + exact hcountValue + have hframeMarked := hinv.frame.markFound_internal + have hframeDelete := + EntryUpdateFrame.trans_ready_internal hframeMarked hdeleteReady + have hframeCount := EntryUpdateFrame.trans_single_internal hframeDelete + (12 : Fin 13) (by + intro i hi + exact hcountOther i (by + simpa [EntryUpdateTapes.resultCount] using hi)) + have hframeFinal := EntryUpdateFrame.trans_single_internal hframeCount + (9 : Fin 13) (by + intro i hi + exact hremainingOther i (by + simpa [EntryUpdateTapes.remaining] using hi)) + have hprogress := hinv.progress.delete_internal haddress + have hinvFinal : EntryUpdateLoopInv tapes store address 0 + (processed ++ [entry]) rest emitted true (resultCount - 1) + initialWork remainingDone.work := + { progress := hprogress + ready := hreadyFinal + replacement := hreplacementFinal + replacement_eq := hreplacementEq + remainingCount := hremainingValue + foundCount := by simpa using hfoundFinal + resultCountTape := hresultFinal + resultCount_le := (Nat.sub_le resultCount 1).trans hinv.resultCount_le + frame := hframeFinal } + have hcleanupBound : deleteTime ≤ + entryUpdateReadyCleanupTime tapes entry address := by + rw [← entryMissCleanupTime_eq_entryUpdateReadyCleanupTime_internal + tapes entry address hreadyMarked] + exact hdeleteTime + have hcountBound : TM.binaryPredTime (resultCount - 1) ≤ + entryUpdateCountTime store.length := by + apply binaryPredTime_le_entryUpdateCountTime_internal + calc + resultCount - 1 + 1 = resultCount := by omega + _ ≤ store.length := hinv.resultCount_le + have hdeleteBranchBound : + deleteTime + 1 + TM.binaryPredTime (resultCount - 1) + 1 ≤ + entryUpdateBranchTime tapes entry address 0 store.length := by + have hthird : entryUpdateReadyCleanupTime tapes entry address + 1 + + entryUpdateCountTime store.length + 1 ≤ + entryUpdateBranchTime tapes entry address 0 store.length := by + unfold entryUpdateBranchTime + exact (le_max_right _ _).trans (le_max_right _ _) + omega + refine ⟨remainingDone.work, remainingDone.output, + matchTime + 1 + 1 + deleteTime + 1 + + TM.binaryPredTime (resultCount - 1) + 1 + + TM.binaryPredTime rest.length + 1, + ?_, ?_, hinvFinal, ?_⟩ + · unfold entryUpdateIterationTime entryUpdateBranchTime + omega + · simpa [hinputEq, Nat.add_assoc] using htotalReach + · rw [houtputEq] + exact houtput + +/-- A matching nonzero write emits the replacement entry, records the hit, +decrements the remaining-entry counter, and returns to the loop test. -/ +theorem entryUpdateReplaceIteration_internal + (tapes : EntryUpdateTapes n) (store : Store) + (address newValue : ℕ) (processed emitted : Store) + (entry : Entry) (rest : Store) (resultCount : ℕ) + (initialWork work : Fin n → Tape) (outPrefix : List Bool) + (inp out : Tape) + (hinv : EntryUpdateLoopInv tapes store address newValue processed + (entry :: rest) emitted false resultCount initialWork work) + (haddress : address = entry.1) (hvalue : newValue ≠ 0) + (hinput : TM.Parked inp) + (houtput : out.HasBinaryPrefix + (outPrefix ++ emitted.flatMap Entry.encode)) : + ∃ nextWork nextOut time, + time ≤ entryUpdateIterationTime tapes entry rest address newValue + store.length ∧ + (entryUpdateTM tapes).reachesIn time + (entryUpdateTestCfg tapes inp work out) + (entryUpdateTestCfg tapes inp nextWork nextOut) ∧ + EntryUpdateLoopInv tapes store address newValue + (processed ++ [entry]) rest (emitted ++ [(address, newValue)]) true + resultCount initialWork nextWork ∧ + nextOut.HasBinaryPrefix + (outPrefix ++ (emitted ++ [(address, newValue)]).flatMap + Entry.encode) := by + have hready : EntryScanReady tapes.entry + (Entry.encode entry ++ rest.flatMap Entry.encode) address.bits work work := by + simpa using hinv.ready + have hremainingPositive : + (work tapes.remaining).HasBinaryNat (rest.length + 1) := by + simpa using hinv.remainingCount + have hremainingRead : (work tapes.remaining).read ≠ Γ.blank := by + intro hblank + have hzero := hremainingPositive.read_eq_blank_iff.mp hblank + omega + have houtputParked : TM.Parked out := + parked_of_binaryPrefix_internal houtput + have htest := entryUpdateTM_step_test_continue_internal tapes inp work out + hremainingRead hinput hready.parked houtputParked + have hmatchContract := entryMatchReadTM_reachesIn_frame tapes.entry entry + (rest.flatMap Entry.encode) address.bits inp work out hready.source + hready.address hready.value hready.addressStart hready.valueStart + hready.addressCounter hready.addressWidth hready.valueCounter + hready.valueWidth hready.query hready.queryStart hready.result + hready.resultStart hinput hready.parked houtputParked + obtain ⟨matchDone, matchTime, hmatchTime, hmatchReach, hmatchHalt, + hmatchInput, hmatchInv, hmatchOutput⟩ := hmatchContract + have hmatchReach' := + entryUpdateTM_match_reachesIn_internal tapes hmatchReach + have hmatchInputParked : TM.Parked matchDone.input := by + rw [hmatchInput] + exact hinput + have hmatchOutputParked : TM.Parked matchDone.output := by + rw [hmatchOutput] + exact houtputParked + have hmatchFound : matchDone.work tapes.found = work tapes.found := + hmatchInv.frame_outside_entry_internal tapes.found + tapes.found_ne_entry + have hfoundZero : (work tapes.found).HasBinaryNat 0 := by + simpa using hinv.foundCount + have hmatchFoundZero : + (matchDone.work tapes.found).HasBinaryNat 0 := by + rw [hmatchFound] + exact hfoundZero + have hresultOne : (matchDone.work tapes.entry.result).read = Γ.one := + hmatchInv.result_read_eq_one_iff.mpr (congrArg Nat.bits haddress.symm) + have hmatchReplacement : + matchDone.work tapes.replacement = work tapes.replacement := + hmatchInv.frame_outside_entry_internal tapes.replacement + tapes.replacement_ne_entry + have hmatchReplacementValue : + (matchDone.work tapes.replacement).HasBinaryNat newValue := by + rw [hmatchReplacement] + exact hinv.replacement + have hreplacementNonblank : + (matchDone.work tapes.replacement).read ≠ Γ.blank := by + intro hblank + exact hvalue (hmatchReplacementValue.read_eq_blank_iff.mp hblank) + have hdispatch := entryUpdateTM_step_match_replace_internal tapes matchDone + hmatchHalt hresultOne hreplacementNonblank hmatchInputParked + hmatchInv.parked hmatchOutputParked + have hmatchMarked := hmatchInv.markFound_internal hmatchFoundZero + have hreadyMarked := hready.markFound_internal hfoundZero + have hmarkedReplacement : + (entryUpdateMarkFoundWork tapes matchDone.work + tapes.replacement).HasBinaryNat newValue := by + rw [entryUpdateMarkFoundWork_apply_ne_internal tapes matchDone.work + tapes.replacement tapes.replacement_ne_found] + exact hmatchReplacementValue + have hmatchOutputPrefix : matchDone.output.HasBinaryPrefix + (outPrefix ++ emitted.flatMap Entry.encode) := by + rw [hmatchOutput] + exact houtput + have hreplaceContract := entryReplaceCleanupTM_hoareTime_frame + tapes.replace entry newValue (rest.flatMap Entry.encode) address.bits + (outPrefix ++ emitted.flatMap Entry.encode) + (entryUpdateMarkFoundWork tapes work) + (entryUpdateMarkFoundWork tapes matchDone.work) + matchDone.input matchDone.output hmatchMarked hmarkedReplacement + hmatchInputParked hmatchOutputPrefix + obtain ⟨replaceDone, replaceTime, hreplaceTime, hreplaceReach, + hreplaceHalt, hreplaceInput, hreplaceReady, hreplaceReplacement, + hreplaceOutput⟩ := + hreplaceContract matchDone.input + (entryUpdateMarkFoundWork tapes matchDone.work) matchDone.output + ⟨rfl, rfl, rfl⟩ + have hreplaceReach' := + entryUpdateTM_replace_reachesIn_internal tapes hreplaceReach + have hreplaceInputParked : TM.Parked replaceDone.input := by + rw [hreplaceInput] + exact hmatchInputParked + have hreplaceOutputParked : TM.Parked replaceDone.output := + parked_of_binaryPrefix_internal hreplaceOutput + have hreplaceSeam := entryUpdateTM_step_replace_halt_internal tapes + replaceDone hreplaceHalt hreplaceInputParked hreplaceReady.parked + hreplaceOutputParked + have hreplaceRemaining : + (replaceDone.work tapes.remaining).HasBinaryNat (rest.length + 1) := by + rw [hreplaceReady.frame_outside_entry_internal tapes.remaining + tapes.remaining_ne_entry] + rw [entryUpdateMarkFoundWork_apply_ne_internal tapes work + tapes.remaining tapes.remaining_ne_found] + exact hremainingPositive + obtain ⟨remainingDone, hremainingReach, hremainingHalt, + hremainingInput, hremainingOther, hremainingValue, + hremainingOutput⟩ := + TM.binaryPredTM_reachesIn_frame tapes.remaining rest.length + replaceDone.input replaceDone.work replaceDone.output hreplaceRemaining + hreplaceInputParked.read_ne_start + (fun i _ => (hreplaceReady.parked i).read_ne_start) + hreplaceOutputParked.read_ne_start + have hremainingReach' := + entryUpdateTM_remaining_reachesIn_internal tapes hremainingReach + have hremainingInputParked : TM.Parked remainingDone.input := by + rw [hremainingInput] + exact hreplaceInputParked + have hremainingWorkParked : ∀ i, TM.Parked (remainingDone.work i) := by + intro i + by_cases hi : i = tapes.remaining + · subst i + exact entryUpdateParked_of_hasBinaryNat_internal hremainingValue + · rw [hremainingOther i hi] + exact hreplaceReady.parked i + have hremainingOutputParked : TM.Parked remainingDone.output := by + rw [hremainingOutput] + exact hreplaceOutputParked + have hloop := entryUpdateTM_step_remaining_halt_internal tapes + remainingDone hremainingHalt hremainingInputParked hremainingWorkParked + hremainingOutputParked + have hreadyFinal := hreplaceReady.change_remaining_internal + hremainingOther hremainingValue + have hprefix : (entryUpdateTM tapes).reachesIn (matchTime + 1) + (entryUpdateTestCfg tapes inp work out) + (entryUpdateMatchWrap tapes matchDone) := + .step htest hmatchReach' + have htoReplace : (entryUpdateTM tapes).reachesIn + (matchTime + 1 + 1) + (entryUpdateTestCfg tapes inp work out) + (entryUpdateReplaceWrap tapes + { state := (entryReplaceCleanupTM tapes.replace).qstart + input := matchDone.input + work := entryUpdateMarkFoundWork tapes matchDone.work + output := matchDone.output }) := + TM.reachesIn_trans _ hprefix (.step hdispatch .zero) + have hthroughReplace := TM.reachesIn_trans (entryUpdateTM tapes) + htoReplace hreplaceReach' + have htoRemaining := TM.reachesIn_trans (entryUpdateTM tapes) + hthroughReplace (.step hreplaceSeam .zero) + have hthroughRemaining := TM.reachesIn_trans (entryUpdateTM tapes) + htoRemaining hremainingReach' + have htotalReach := TM.reachesIn_trans (entryUpdateTM tapes) + hthroughRemaining (.step hloop .zero) + have hinputEq : remainingDone.input = inp := + hremainingInput.trans (hreplaceInput.trans hmatchInput) + have hreplacementWorkEq : + remainingDone.work tapes.replacement = work tapes.replacement := by + rw [hremainingOther tapes.replacement + (Ne.symm tapes.remaining_ne_replacement)] + have hreplaceReplacement' : + replaceDone.work tapes.replacement = + entryUpdateMarkFoundWork tapes matchDone.work + tapes.replacement := by + simpa only [EntryUpdateTapes.replace_replacement] using + hreplaceReplacement + rw [hreplaceReplacement'] + rw [entryUpdateMarkFoundWork_apply_ne_internal tapes matchDone.work + tapes.replacement tapes.replacement_ne_found] + exact hmatchReplacement + have hreplacementEq : + remainingDone.work tapes.replacement = + initialWork tapes.replacement := + hreplacementWorkEq.trans hinv.replacement_eq + have hreplacementFinal : + (remainingDone.work tapes.replacement).HasBinaryNat newValue := by + rw [hreplacementWorkEq] + exact hinv.replacement + have hfoundFinal : + (remainingDone.work tapes.found).HasBinaryNat 1 := by + rw [hremainingOther tapes.found + (Ne.symm tapes.remaining_ne_found)] + rw [hreplaceReady.frame_outside_entry_internal tapes.found + tapes.found_ne_entry] + exact entryUpdateMarkFoundWork_found_one_internal tapes work hfoundZero + have hresultFinal : + (remainingDone.work tapes.resultCount).HasBinaryNat resultCount := by + rw [hremainingOther tapes.resultCount + (Ne.symm tapes.remaining_ne_resultCount)] + rw [hreplaceReady.frame_outside_entry_internal tapes.resultCount + tapes.resultCount_ne_entry] + rw [entryUpdateMarkFoundWork_apply_ne_internal tapes work + tapes.resultCount (Ne.symm tapes.found_ne_resultCount)] + exact hinv.resultCountTape + have hframeMarked := hinv.frame.markFound_internal + have hframeReplace := + EntryUpdateFrame.trans_ready_internal hframeMarked hreplaceReady + have hframeFinal := EntryUpdateFrame.trans_single_internal hframeReplace + (9 : Fin 13) (by + intro i hi + exact hremainingOther i (by + simpa [EntryUpdateTapes.remaining] using hi)) + have hprogress := hinv.progress.replace_internal haddress hvalue + have hinvFinal : EntryUpdateLoopInv tapes store address newValue + (processed ++ [entry]) rest (emitted ++ [(address, newValue)]) true + resultCount initialWork remainingDone.work := + { progress := hprogress + ready := hreadyFinal + replacement := hreplacementFinal + replacement_eq := hreplacementEq + remainingCount := hremainingValue + foundCount := by simpa using hfoundFinal + resultCountTape := hresultFinal + resultCount_le := hinv.resultCount_le + frame := hframeFinal } + have hreplaceBound : replaceTime ≤ + entryUpdateReplaceTime tapes entry address newValue := by + exact hreplaceTime.trans + (entryReplaceCleanupTime_le_entryUpdateReplaceTime_internal tapes entry + address newValue (rest.flatMap Entry.encode) + (entryUpdateMarkFoundWork tapes work) + (entryUpdateMarkFoundWork tapes work) + (entryUpdateMarkFoundWork tapes matchDone.work) + hreadyMarked hmatchMarked) + have hreplaceBranchBound : replaceTime + 1 ≤ + entryUpdateBranchTime tapes entry address newValue store.length := by + have hfixed : entryUpdateReplaceTime tapes entry address newValue + 1 ≤ + entryUpdateBranchTime tapes entry address newValue store.length := by + unfold entryUpdateBranchTime + exact (le_max_left _ _).trans (le_max_right _ _) + omega + refine ⟨remainingDone.work, remainingDone.output, + matchTime + 1 + 1 + replaceTime + 1 + + TM.binaryPredTime rest.length + 1, + ?_, ?_, hinvFinal, ?_⟩ + · unfold entryUpdateIterationTime entryUpdateBranchTime + omega + · simpa [hinputEq, Nat.add_assoc] using htotalReach + · simpa [List.flatMap_append, haddress, List.append_assoc, + hremainingOutput] using hreplaceOutput + +end Machine + +end RegisterStore + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Inv.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Inv.lean new file mode 100644 index 0000000000..2b8b5bbd2e --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Inv.lean @@ -0,0 +1,414 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import +LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Ctrl +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryScan.Internal.Inv +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinarySucc + +/-! +# Bounded encoded sparse-store update — invariant internals + +Tape-layout views and frame lemmas used by the semantic update loop. In +particular, this file isolates the only controller-local mutation: changing +the canonical zero-valued `found` tape to canonical one after a hit. +-/ + + +@[expose] public section + +namespace Complexity + +namespace RAM + +namespace RegisterStore + +namespace Machine + +variable {n : ℕ} + +namespace EntryUpdateTapes + +/-- View the update layout as an entry scanner whose count is `remaining`. -/ +def remainingScan (tapes : EntryUpdateTapes n) : EntryScanTapes n where + entry := tapes.entry + count := tapes.remaining + count_ne := by + intro i h + change tapes.idx 9 = tapes.idx ⟨i.val, by omega⟩ at h + have h' : (9 : Fin 13) = ⟨i.val, by omega⟩ := tapes.injective h + have hv := congrArg (fun k : Fin 13 => k.val) h' + change 9 = i.val at hv + omega + +/-- View the update layout as an entry scanner whose count is `resultCount`. -/ +def resultScan (tapes : EntryUpdateTapes n) : EntryScanTapes n where + entry := tapes.entry + count := tapes.resultCount + count_ne := by + intro i h + change tapes.idx 12 = tapes.idx ⟨i.val, by omega⟩ at h + have h' : (12 : Fin 13) = ⟨i.val, by omega⟩ := tapes.injective h + have hv := congrArg (fun k : Fin 13 => k.val) h' + change 12 = i.val at hv + omega + +@[simp] theorem remainingScan_entry (tapes : EntryUpdateTapes n) : + tapes.remainingScan.entry = tapes.entry := rfl + +@[simp] theorem remainingScan_count (tapes : EntryUpdateTapes n) : + tapes.remainingScan.count = tapes.remaining := rfl + +@[simp] theorem resultScan_entry (tapes : EntryUpdateTapes n) : + tapes.resultScan.entry = tapes.entry := rfl + +@[simp] theorem resultScan_count (tapes : EntryUpdateTapes n) : + tapes.resultScan.count = tapes.resultCount := rfl + +/-- The remaining count is outside every entry-machine tape. -/ +theorem remaining_ne_entry (tapes : EntryUpdateTapes n) (i : Fin 9) : + tapes.remaining ≠ tapes.entry.idx i := + tapes.remainingScan.count_ne i + +/-- The replacement source is outside every entry-machine tape. -/ +theorem replacement_ne_entry (tapes : EntryUpdateTapes n) (i : Fin 9) : + tapes.replacement ≠ tapes.entry.idx i := by + change tapes.idx 10 ≠ tapes.idx ⟨i.val, by omega⟩ + apply tapes.ne + intro h + have hv := congrArg (fun k : Fin 13 => k.val) h + change 10 = i.val at hv + omega + +/-- The found flag is outside every entry-machine tape. -/ +theorem found_ne_entry (tapes : EntryUpdateTapes n) (i : Fin 9) : + tapes.found ≠ tapes.entry.idx i := by + change tapes.idx 11 ≠ tapes.idx ⟨i.val, by omega⟩ + apply tapes.ne + intro h + have hv := congrArg (fun k : Fin 13 => k.val) h + change 11 = i.val at hv + omega + +/-- The result count is outside every entry-machine tape. -/ +theorem resultCount_ne_entry (tapes : EntryUpdateTapes n) (i : Fin 9) : + tapes.resultCount ≠ tapes.entry.idx i := + tapes.resultScan.count_ne i + +/-- The remaining count and replacement source are distinct. -/ +theorem remaining_ne_replacement (tapes : EntryUpdateTapes n) : + tapes.remaining ≠ tapes.replacement := + tapes.ne (by decide) + +/-- The remaining count and found flag are distinct. -/ +theorem remaining_ne_found (tapes : EntryUpdateTapes n) : + tapes.remaining ≠ tapes.found := + tapes.ne (by decide) + +/-- The remaining and result counts are distinct. -/ +theorem remaining_ne_resultCount (tapes : EntryUpdateTapes n) : + tapes.remaining ≠ tapes.resultCount := + tapes.ne (by decide) + +/-- The replacement source and found flag are distinct. -/ +theorem replacement_ne_found (tapes : EntryUpdateTapes n) : + tapes.replacement ≠ tapes.found := + tapes.ne (by decide) + +/-- The replacement source and result count are distinct. -/ +theorem replacement_ne_resultCount (tapes : EntryUpdateTapes n) : + tapes.replacement ≠ tapes.resultCount := + tapes.ne (by decide) + +/-- The found flag and result count are distinct. -/ +theorem found_ne_resultCount (tapes : EntryUpdateTapes n) : + tapes.found ≠ tapes.resultCount := + tapes.ne (by decide) + +end EntryUpdateTapes + +/-- The hit-marking update changes exactly the found tape. -/ +theorem entryUpdateMarkFoundWork_apply_eq_internal + (tapes : EntryUpdateTapes n) (work : Fin n → Tape) : + entryUpdateMarkFoundWork tapes work tapes.found = + (work tapes.found).writeAndMove Γ.one + (TM.idleDir (work tapes.found).read) := by + simp [entryUpdateMarkFoundWork] + +/-- The hit-marking update preserves every tape other than the found tape. -/ +theorem entryUpdateMarkFoundWork_apply_ne_internal + (tapes : EntryUpdateTapes n) (work : Fin n → Tape) + (i : Fin n) (hi : i ≠ tapes.found) : + entryUpdateMarkFoundWork tapes work i = work i := by + simp [entryUpdateMarkFoundWork, Function.update_of_ne hi] + +/-- Writing `1` over the parked canonical zero flag produces canonical one. -/ +theorem entryUpdateMarkFoundWork_found_one_internal + (tapes : EntryUpdateTapes n) (work : Fin n → Tape) + (hfound : (work tapes.found).HasBinaryNat 0) : + (entryUpdateMarkFoundWork tapes work tapes.found).HasBinaryNat 1 := by + rw [entryUpdateMarkFoundWork_apply_eq_internal] + rw [hfound.eq_init_move_right] + have heq : + (((Tape.init ((0 : ℕ).bits.map Γ.ofBool)).move Dir3.right).writeAndMove + Γ.one + (TM.idleDir + ((Tape.init ((0 : ℕ).bits.map Γ.ofBool)).move Dir3.right).read)) = + (Tape.init ((1 : ℕ).bits.map Γ.ofBool)).move Dir3.right := by + apply Tape.ext + · simp [TM.idleDir, Tape.read, Tape.write, Tape.move, Tape.init, + Nat.bits] + · funext i + cases i with + | zero => + simp [TM.idleDir, Tape.read, Tape.write, Tape.move, Tape.init, + Nat.bits] + | succ i => + cases i with + | zero => + simp [TM.idleDir, Tape.read, Tape.write, Tape.move, Tape.init, + Nat.bits, Γ.ofBool] + | succ i => + simp [TM.idleDir, Tape.read, Tape.write, Tape.move, Tape.init, + Nat.bits] + rw [heq] + exact Tape.init_move_right_hasBinaryNat 1 + +/-- Canonical natural-number tapes are parked away from the left marker. -/ +theorem entryUpdateParked_of_hasBinaryNat_internal {t : Tape} {value : ℕ} + (h : t.HasBinaryNat value) : TM.Parked t := by + exact ⟨by simp [Tape.HasBinaryNat, Tape.HasBinaryString] at h; omega, + h.2.hasBinaryContent.cells_ne_start⟩ + +/-- Marking a canonical zero found flag preserves parkedness of the complete +work family. -/ +theorem entryUpdateMarkFoundWork_parked_internal + (tapes : EntryUpdateTapes n) (work : Fin n → Tape) + (hfound : (work tapes.found).HasBinaryNat 0) + (hparked : ∀ i, TM.Parked (work i)) : + ∀ i, TM.Parked (entryUpdateMarkFoundWork tapes work i) := by + intro i + by_cases hi : i = tapes.found + · subst i + exact entryUpdateParked_of_hasBinaryNat_internal + (entryUpdateMarkFoundWork_found_one_internal tapes work hfound) + · rw [entryUpdateMarkFoundWork_apply_ne_internal tapes work i hi] + exact hparked i + +/-- The marked found flag exposes `1` directly under its parked head. -/ +theorem entryUpdateMarkFoundWork_found_read_one_internal + (tapes : EntryUpdateTapes n) (work : Fin n → Tape) + (hfound : (work tapes.found).HasBinaryNat 0) : + (entryUpdateMarkFoundWork tapes work tapes.found).read = Γ.one := by + have h := entryUpdateMarkFoundWork_found_one_internal tapes work hfound + simpa [Nat.bits, Γ.ofBool] using h.2.hasBinarySuffix.read_cons + +/-- The frame component of an entry-ready endpoint can be queried with one +uniform proof that an index lies outside the nine entry-machine tapes. -/ +theorem EntryScanReady.frame_outside_entry_internal + {tapes : EntryUpdateTapes n} {remaining queryBits : List Bool} + {initialWork finalWork : Fin n → Tape} + (h : EntryScanReady tapes.entry remaining queryBits initialWork finalWork) + (i : Fin n) (houtside : ∀ j : Fin 9, i ≠ tapes.entry.idx j) : + finalWork i = initialWork i := + h.frame i (houtside 0) (houtside 1) (houtside 2) (houtside 3) + (houtside 4) (houtside 5) (houtside 6) (houtside 7) (houtside 8) + +/-- The frame component of a readable match can be queried uniformly outside +the nine entry-machine tapes. -/ +theorem ReadableEntryMatch.frame_outside_entry_internal + {tapes : EntryUpdateTapes n} {entry : Entry} {rest queryBits : List Bool} + {initialWork finalWork : Fin n → Tape} + (h : ReadableEntryMatch tapes.entry entry rest queryBits + initialWork finalWork) + (i : Fin n) (houtside : ∀ j : Fin 9, i ≠ tapes.entry.idx j) : + finalWork i = initialWork i := + h.frame i (houtside 0) (houtside 1) (houtside 2) (houtside 3) + (houtside 4) (houtside 5) (houtside 6) (houtside 7) (houtside 8) + +/-- Marking the external found flag preserves an entry-ready invariant while +updating both sides of its exact frame. -/ +theorem EntryScanReady.markFound_internal + {tapes : EntryUpdateTapes n} {remaining queryBits : List Bool} + {initialWork finalWork : Fin n → Tape} + (h : EntryScanReady tapes.entry remaining queryBits initialWork finalWork) + (hfound : (finalWork tapes.found).HasBinaryNat 0) : + EntryScanReady tapes.entry remaining queryBits + (entryUpdateMarkFoundWork tapes initialWork) + (entryUpdateMarkFoundWork tapes finalWork) := by + have hfoundFrame : finalWork tapes.found = initialWork tapes.found := + h.frame_outside_entry_internal tapes.found tapes.found_ne_entry + have hsource : tapes.entry.source ≠ tapes.found := + Ne.symm (tapes.found_ne_entry 0) + have haddress : tapes.entry.address ≠ tapes.found := + Ne.symm (tapes.found_ne_entry 1) + have hvalue : tapes.entry.value ≠ tapes.found := + Ne.symm (tapes.found_ne_entry 2) + have haddressCounter : tapes.entry.addressCounter ≠ tapes.found := + Ne.symm (tapes.found_ne_entry 3) + have haddressWidth : tapes.entry.addressWidth ≠ tapes.found := + Ne.symm (tapes.found_ne_entry 4) + have hvalueCounter : tapes.entry.valueCounter ≠ tapes.found := + Ne.symm (tapes.found_ne_entry 5) + have hvalueWidth : tapes.entry.valueWidth ≠ tapes.found := + Ne.symm (tapes.found_ne_entry 6) + have hquery : tapes.entry.query ≠ tapes.found := + Ne.symm (tapes.found_ne_entry 7) + have hresult : tapes.entry.result ≠ tapes.found := + Ne.symm (tapes.found_ne_entry 8) + refine ⟨?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_⟩ + · rw [entryUpdateMarkFoundWork_apply_ne_internal _ _ _ hsource] + exact h.source + · rw [entryUpdateMarkFoundWork_apply_ne_internal _ _ _ haddress] + exact h.address + · rw [entryUpdateMarkFoundWork_apply_ne_internal _ _ _ haddress] + exact h.addressStart + · rw [entryUpdateMarkFoundWork_apply_ne_internal _ _ _ hvalue] + exact h.value + · rw [entryUpdateMarkFoundWork_apply_ne_internal _ _ _ hvalue] + exact h.valueStart + · rw [entryUpdateMarkFoundWork_apply_ne_internal _ _ _ haddressCounter] + exact h.addressCounter + · rw [entryUpdateMarkFoundWork_apply_ne_internal _ _ _ haddressWidth] + exact h.addressWidth + · rw [entryUpdateMarkFoundWork_apply_ne_internal _ _ _ hvalueCounter] + exact h.valueCounter + · rw [entryUpdateMarkFoundWork_apply_ne_internal _ _ _ hvalueWidth] + exact h.valueWidth + · rw [entryUpdateMarkFoundWork_apply_ne_internal _ _ _ hquery] + exact h.query + · rw [entryUpdateMarkFoundWork_apply_ne_internal _ _ _ hquery] + exact h.queryStart + · rw [entryUpdateMarkFoundWork_apply_ne_internal _ _ _ hresult] + exact h.result + · rw [entryUpdateMarkFoundWork_apply_ne_internal _ _ _ hresult] + exact h.resultStart + · exact entryUpdateMarkFoundWork_parked_internal tapes finalWork hfound h.parked + · intro i hsource haddress hvalue haddressCounter haddressWidth + hvalueCounter hvalueWidth hquery hresult + by_cases hi : i = tapes.found + · subst i + rw [entryUpdateMarkFoundWork_apply_eq_internal, + entryUpdateMarkFoundWork_apply_eq_internal, hfoundFrame] + · rw [entryUpdateMarkFoundWork_apply_ne_internal _ _ _ hi, + entryUpdateMarkFoundWork_apply_ne_internal _ _ _ hi] + exact h.frame i hsource haddress hvalue haddressCounter haddressWidth + hvalueCounter hvalueWidth hquery hresult + +/-- Marking the external found flag preserves a readable matched-entry +endpoint while updating both sides of its exact frame. -/ +theorem ReadableEntryMatch.markFound_internal + {tapes : EntryUpdateTapes n} {entry : Entry} {rest queryBits : List Bool} + {initialWork finalWork : Fin n → Tape} + (h : ReadableEntryMatch tapes.entry entry rest queryBits + initialWork finalWork) + (hfound : (finalWork tapes.found).HasBinaryNat 0) : + ReadableEntryMatch tapes.entry entry rest queryBits + (entryUpdateMarkFoundWork tapes initialWork) + (entryUpdateMarkFoundWork tapes finalWork) := by + have hfoundFrame : finalWork tapes.found = initialWork tapes.found := + h.frame_outside_entry_internal tapes.found tapes.found_ne_entry + have hsource : tapes.entry.source ≠ tapes.found := + Ne.symm (tapes.found_ne_entry 0) + have haddress : tapes.entry.address ≠ tapes.found := + Ne.symm (tapes.found_ne_entry 1) + have hvalue : tapes.entry.value ≠ tapes.found := + Ne.symm (tapes.found_ne_entry 2) + have haddressCounter : tapes.entry.addressCounter ≠ tapes.found := + Ne.symm (tapes.found_ne_entry 3) + have haddressWidth : tapes.entry.addressWidth ≠ tapes.found := + Ne.symm (tapes.found_ne_entry 4) + have hvalueCounter : tapes.entry.valueCounter ≠ tapes.found := + Ne.symm (tapes.found_ne_entry 5) + have hvalueWidth : tapes.entry.valueWidth ≠ tapes.found := + Ne.symm (tapes.found_ne_entry 6) + have hquery : tapes.entry.query ≠ tapes.found := + Ne.symm (tapes.found_ne_entry 7) + have hresult : tapes.entry.result ≠ tapes.found := + Ne.symm (tapes.found_ne_entry 8) + constructor + · rw [entryUpdateMarkFoundWork_apply_ne_internal _ _ _ hsource] + exact h.source + · rw [entryUpdateMarkFoundWork_apply_ne_internal _ _ _ haddress] + exact h.address + · rw [entryUpdateMarkFoundWork_apply_ne_internal _ _ _ haddress] + exact h.addressStart + · rw [entryUpdateMarkFoundWork_apply_ne_internal _ _ _ hvalue] + exact h.value + · rw [entryUpdateMarkFoundWork_apply_ne_internal _ _ _ hvalue] + exact h.valueStart + · rw [entryUpdateMarkFoundWork_apply_ne_internal _ _ _ haddressCounter] + exact h.addressCounter + · rw [entryUpdateMarkFoundWork_apply_ne_internal _ _ _ haddressCounter] + exact h.addressCounterStart + · rw [entryUpdateMarkFoundWork_apply_ne_internal _ _ _ haddressWidth] + exact h.addressWidth + · rw [entryUpdateMarkFoundWork_apply_ne_internal _ _ _ hvalueCounter] + exact h.valueCounter + · rw [entryUpdateMarkFoundWork_apply_ne_internal _ _ _ hvalueCounter] + exact h.valueCounterStart + · rw [entryUpdateMarkFoundWork_apply_ne_internal _ _ _ hvalueWidth] + exact h.valueWidth + · rw [entryUpdateMarkFoundWork_apply_ne_internal _ _ _ hquery] + exact h.query + · rw [entryUpdateMarkFoundWork_apply_ne_internal _ _ _ hquery] + exact h.queryStart + · rw [entryUpdateMarkFoundWork_apply_ne_internal _ _ _ hresult] + exact h.result + · rw [entryUpdateMarkFoundWork_apply_ne_internal _ _ _ hresult] + exact h.resultStart + · exact entryUpdateMarkFoundWork_parked_internal tapes finalWork hfound h.parked + · intro i + by_cases hi : i = tapes.found + · subst i + rw [entryUpdateMarkFoundWork_apply_eq_internal, + entryUpdateMarkFoundWork_apply_eq_internal, hfoundFrame] + exact Nat.le_add_right _ _ + · rw [entryUpdateMarkFoundWork_apply_ne_internal _ _ _ hi, + entryUpdateMarkFoundWork_apply_ne_internal _ _ _ hi] + exact h.headBound i + · intro i hsource haddress hvalue haddressCounter haddressWidth + hvalueCounter hvalueWidth hquery hresult + by_cases hi : i = tapes.found + · subst i + rw [entryUpdateMarkFoundWork_apply_eq_internal, + entryUpdateMarkFoundWork_apply_eq_internal, hfoundFrame] + · rw [entryUpdateMarkFoundWork_apply_ne_internal _ _ _ hi, + entryUpdateMarkFoundWork_apply_ne_internal _ _ _ hi] + exact h.frame i hsource haddress hvalue haddressCounter haddressWidth + hvalueCounter hvalueWidth hquery hresult + +/-- A frame-rich binary operation on the remaining-count tape preserves and +rebases the entry-ready invariant. -/ +theorem EntryScanReady.change_remaining_internal + {tapes : EntryUpdateTapes n} {remaining queryBits : List Bool} + {initialWork work finalWork : Fin n → Tape} {count : ℕ} + (h : EntryScanReady tapes.entry remaining queryBits initialWork work) + (hother : ∀ i, i ≠ tapes.remaining → finalWork i = work i) + (hcount : (finalWork tapes.remaining).HasBinaryNat count) : + EntryScanReady tapes.entry remaining queryBits finalWork finalWork := by + exact h.change_count_internal (tapes := tapes.remainingScan) hother hcount + +/-- A frame-rich binary operation on the result-count tape preserves and +rebases the entry-ready invariant. -/ +theorem EntryScanReady.change_resultCount_internal + {tapes : EntryUpdateTapes n} {remaining queryBits : List Bool} + {initialWork work finalWork : Fin n → Tape} {count : ℕ} + (h : EntryScanReady tapes.entry remaining queryBits initialWork work) + (hother : ∀ i, i ≠ tapes.resultCount → finalWork i = work i) + (hcount : (finalWork tapes.resultCount).HasBinaryNat count) : + EntryScanReady tapes.entry remaining queryBits finalWork finalWork := by + exact h.change_count_internal (tapes := tapes.resultScan) hother hcount + +end Machine + +end RegisterStore + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Loop.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Loop.lean new file mode 100644 index 0000000000..026665a107 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Loop.lean @@ -0,0 +1,127 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Progress +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Inv + +/-! +# Bounded encoded sparse-store update — loop invariant internals +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace RegisterStore + +namespace Machine + +variable {n : ℕ} + +/-- Tape and list semantics carried between controller iterations. -/ +structure EntryUpdateLoopInv (tapes : EntryUpdateTapes n) + (store : Store) (address newValue : ℕ) + (processed remaining emitted : Store) (found : Bool) + (resultCount : ℕ) (initialWork work : Fin n → Tape) : Prop where + progress : EntryUpdateProgress store address newValue processed remaining + emitted found resultCount + ready : EntryScanReady tapes.entry (remaining.flatMap Entry.encode) + address.bits work work + replacement : (work tapes.replacement).HasBinaryNat newValue + replacement_eq : work tapes.replacement = initialWork tapes.replacement + remainingCount : (work tapes.remaining).HasBinaryNat remaining.length + foundCount : (work tapes.found).HasBinaryNat + (if found = true then 1 else 0) + resultCountTape : (work tapes.resultCount).HasBinaryNat resultCount + resultCount_le : resultCount ≤ store.length + frame : EntryUpdateFrame tapes initialWork work + +/-- The controller frame is reflexive. -/ +theorem entryUpdateFrame_refl_internal (tapes : EntryUpdateTapes n) + (work : Fin n → Tape) : EntryUpdateFrame tapes work work := by + intro _ _ + rfl + +/-- Controller frames compose. -/ +theorem EntryUpdateFrame.trans_internal + {tapes : EntryUpdateTapes n} {work₀ work₁ work₂ : Fin n → Tape} + (h₁ : EntryUpdateFrame tapes work₀ work₁) + (h₂ : EntryUpdateFrame tapes work₁ work₂) : + EntryUpdateFrame tapes work₀ work₂ := by + intro i hi + exact (h₂ i hi).trans (h₁ i hi) + +/-- Changing the found flag preserves the frame outside all controller tapes. -/ +theorem EntryUpdateFrame.markFound_internal + {tapes : EntryUpdateTapes n} {initialWork work : Fin n → Tape} + (h : EntryUpdateFrame tapes initialWork work) : + EntryUpdateFrame tapes initialWork (entryUpdateMarkFoundWork tapes work) := by + intro i hi + have hfound : i ≠ tapes.found := by + simpa [EntryUpdateTapes.found] using hi (11 : Fin 13) + rw [entryUpdateMarkFoundWork_apply_ne_internal tapes work i hfound] + exact h i hi + +/-- An entry-machine frame extends an existing controller frame. -/ +theorem EntryUpdateFrame.trans_ready_internal + {tapes : EntryUpdateTapes n} {remaining queryBits : List Bool} + {initialWork work finalWork : Fin n → Tape} + (hframe : EntryUpdateFrame tapes initialWork work) + (hready : EntryScanReady tapes.entry remaining queryBits work finalWork) : + EntryUpdateFrame tapes initialWork finalWork := by + intro i hi + have hslot (slot : Fin 9) : i ≠ tapes.entry.idx slot := by + simpa [EntryUpdateTapes.entry] using hi ⟨slot, by omega⟩ + exact (hready.frame i + (by simpa [EntryMatchTapes.source] using hslot 0) + (by simpa [EntryMatchTapes.address] using hslot 1) + (by simpa [EntryMatchTapes.value] using hslot 2) + (by simpa [EntryMatchTapes.addressCounter] using hslot 3) + (by simpa [EntryMatchTapes.addressWidth] using hslot 4) + (by simpa [EntryMatchTapes.valueCounter] using hslot 5) + (by simpa [EntryMatchTapes.valueWidth] using hslot 6) + (by simpa [EntryMatchTapes.query] using hslot 7) + (by simpa [EntryMatchTapes.result] using hslot 8)).trans + (hframe i hi) + +/-- A one-tape arithmetic frame extends an existing controller frame. -/ +theorem EntryUpdateFrame.trans_single_internal + {tapes : EntryUpdateTapes n} {initialWork work finalWork : Fin n → Tape} + (hframe : EntryUpdateFrame tapes initialWork work) (slot : Fin 13) + (hother : ∀ i, i ≠ tapes.idx slot → finalWork i = work i) : + EntryUpdateFrame tapes initialWork finalWork := by + intro i hi + exact (hother i (hi slot)).trans (hframe i hi) + +/-- The public initial tape contract establishes the first loop invariant. -/ +theorem entryUpdateLoopInv_initial_internal + (tapes : EntryUpdateTapes n) (store : Store) (address newValue : ℕ) + (work : Fin n → Tape) + (hready : EntryScanReady tapes.entry (store.flatMap Entry.encode) + address.bits work work) + (hreplacement : (work tapes.replacement).HasBinaryNat newValue) + (hremaining : (work tapes.remaining).HasBinaryNat store.length) + (hfound : (work tapes.found).HasBinaryNat 0) + (hresultCount : (work tapes.resultCount).HasBinaryNat store.length) : + EntryUpdateLoopInv tapes store address newValue [] store [] false + store.length work work := by + exact ⟨entryUpdateProgress_initial_internal store address newValue, + hready, hreplacement, rfl, hremaining, by simpa using hfound, + hresultCount, le_rfl, entryUpdateFrame_refl_internal tapes work⟩ + +end Machine + +end RegisterStore + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Miss.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Miss.lean new file mode 100644 index 0000000000..057c102a88 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Miss.lean @@ -0,0 +1,241 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import +LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Loop +import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Out +import +LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Time +import Mathlib.Data.Nat.Bitwise +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.WorkBranch + +/-! +# Bounded encoded sparse-store update -- unmatched entry iteration +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace RegisterStore + +namespace Machine + +variable {n : ℕ} + +private theorem nat_eq_of_bits_eq {a b : ℕ} (h : a.bits = b.bits) : a = b := by + apply Nat.eq_of_testBit_eq + intro i + rw [Nat.testBit_eq_inth, Nat.testBit_eq_inth, h] + +/-- One unmatched old entry is copied to the output, its remaining-count unit +is consumed, and the update controller returns to its loop-test state. -/ +theorem entryUpdateIteration_miss_internal + (tapes : EntryUpdateTapes n) (store : Store) (address newValue : ℕ) + (processed emitted : Store) (entry : Entry) (rest : Store) + (found : Bool) (resultCount : ℕ) + (initialWork work : Fin n → Tape) (outPrefix : List Bool) + (inp out : Tape) + (hinv : EntryUpdateLoopInv tapes store address newValue processed + (entry :: rest) emitted found resultCount initialWork work) + (hne : entry.1 ≠ address) + (hinput : TM.Parked inp) + (houtput : out.HasBinaryPrefix + (outPrefix ++ emitted.flatMap Entry.encode)) : + ∃ nextWork nextOut time, + time ≤ entryUpdateIterationTime tapes entry rest address newValue + store.length ∧ + (entryUpdateTM tapes).reachesIn time + (entryUpdateTestCfg tapes inp work out) + (entryUpdateTestCfg tapes inp nextWork nextOut) ∧ + EntryUpdateLoopInv tapes store address newValue + (processed ++ [entry]) rest (emitted ++ [entry]) found resultCount + initialWork nextWork ∧ + nextOut.HasBinaryPrefix + (outPrefix ++ (emitted ++ [entry]).flatMap Entry.encode) := by + have hready : EntryScanReady tapes.entry + (Entry.encode entry ++ rest.flatMap Entry.encode) address.bits work work := by + simpa using hinv.ready + have hremainingPositive : + (work tapes.remaining).HasBinaryNat (rest.length + 1) := by + simpa using hinv.remainingCount + have hremainingRead : (work tapes.remaining).read ≠ Γ.blank := by + intro hblank + have hzero := hremainingPositive.read_eq_blank_iff.mp hblank + omega + have houtputParked : TM.Parked out := + parked_of_binaryPrefix_internal houtput + have htest := entryUpdateTM_step_test_continue_internal tapes inp work out + hremainingRead hinput hready.parked houtputParked + have hmatchContract := entryMatchReadTM_reachesIn_frame tapes.entry entry + (rest.flatMap Entry.encode) address.bits inp work out hready.source + hready.address hready.value hready.addressStart hready.valueStart + hready.addressCounter hready.addressWidth hready.valueCounter + hready.valueWidth hready.query hready.queryStart hready.result + hready.resultStart hinput hready.parked houtputParked + obtain ⟨matchDone, matchTime, hmatchTime, hmatchReach, hmatchHalt, + hmatchInput, hmatchInv, hmatchOutput⟩ := hmatchContract + have hmatchReach' := + entryUpdateTM_match_reachesIn_internal tapes hmatchReach + have hmatchInputParked : TM.Parked matchDone.input := by + rw [hmatchInput] + exact hinput + have hmatchOutputPrefix : matchDone.output.HasBinaryPrefix + (outPrefix ++ emitted.flatMap Entry.encode) := by + rw [hmatchOutput] + exact houtput + have hmatchOutputParked : TM.Parked matchDone.output := + parked_of_binaryPrefix_internal hmatchOutputPrefix + have hresultNotOne : + (matchDone.work tapes.entry.result).read ≠ Γ.one := by + intro hone + apply hne + exact nat_eq_of_bits_eq (hmatchInv.result_read_eq_one_iff.mp hone) + have hdispatch := entryUpdateTM_step_match_miss_internal tapes matchDone + hmatchHalt hresultNotOne hmatchInputParked hmatchInv.parked + hmatchOutputParked + have hmissContract := entryMissCopyTM_hoareTime_frame tapes.entry entry + (rest.flatMap Entry.encode) address.bits + (outPrefix ++ emitted.flatMap Entry.encode) work matchDone.work + matchDone.input matchDone.output hmatchInv hmatchInputParked + hmatchOutputPrefix + obtain ⟨missDone, missTime, hmissTime, hmissReach, hmissHalt, + hmissInput, hmissReady, hmissOutput⟩ := + hmissContract matchDone.input matchDone.work matchDone.output + ⟨rfl, rfl, rfl⟩ + have hmissReach' := entryUpdateTM_miss_reachesIn_internal tapes hmissReach + have hmissInputParked : TM.Parked missDone.input := by + rw [hmissInput, hmatchInput] + exact hinput + have hmissOutputParked : TM.Parked missDone.output := + parked_of_binaryPrefix_internal hmissOutput + have hmissExit := entryUpdateTM_step_miss_halt_internal tapes missDone + hmissHalt hmissInputParked hmissReady.parked hmissOutputParked + have hremainingMiss : + (missDone.work tapes.remaining).HasBinaryNat (rest.length + 1) := by + rw [hmissReady.frame_outside_entry_internal tapes.remaining + tapes.remaining_ne_entry] + exact hremainingPositive + obtain ⟨predDone, hpredReach, hpredHalt, hpredInput, hpredOther, + hpredCount, hpredOutput⟩ := + TM.binaryPredTM_reachesIn_frame tapes.remaining rest.length + missDone.input missDone.work missDone.output hremainingMiss + hmissInputParked.read_ne_start + (fun i _ => (hmissReady.parked i).read_ne_start) + hmissOutputParked.read_ne_start + have hpredReach' := + entryUpdateTM_remaining_reachesIn_internal tapes hpredReach + have hreadyPred := hmissReady.change_remaining_internal hpredOther hpredCount + have hpredInputParked : TM.Parked predDone.input := by + rw [hpredInput] + exact hmissInputParked + have hpredOutputParked : TM.Parked predDone.output := by + rw [hpredOutput] + exact hmissOutputParked + have hloop := entryUpdateTM_step_remaining_halt_internal tapes predDone + hpredHalt hpredInputParked hreadyPred.parked hpredOutputParked + have hinputFinal : predDone.input = inp := + hpredInput.trans (hmissInput.trans hmatchInput) + have hloop' : (entryUpdateTM tapes).step + (entryUpdateRemainingWrap tapes predDone) = + some (entryUpdateTestCfg tapes inp predDone.work predDone.output) := by + simpa [hinputFinal] using hloop + have hmatchPrefix : (entryUpdateTM tapes).reachesIn (matchTime + 1) + (entryUpdateTestCfg tapes inp work out) + (entryUpdateMatchWrap tapes matchDone) := + .step htest hmatchReach' + have htoMiss : (entryUpdateTM tapes).reachesIn (matchTime + 1 + 1) + (entryUpdateTestCfg tapes inp work out) + (entryUpdateMissWrap tapes + { state := (entryMissCopyTM tapes.entry).qstart + input := matchDone.input + work := matchDone.work + output := matchDone.output }) := + TM.reachesIn_trans _ hmatchPrefix (.step hdispatch .zero) + have hthroughMiss := + TM.reachesIn_trans (entryUpdateTM tapes) htoMiss hmissReach' + have htoPred := TM.reachesIn_trans (entryUpdateTM tapes) hthroughMiss + (.step hmissExit .zero) + have hthroughPred := + TM.reachesIn_trans (entryUpdateTM tapes) htoPred hpredReach' + have hreach := TM.reachesIn_trans (entryUpdateTM tapes) hthroughPred + (.step hloop' .zero) + have hmissStatic : + missTime ≤ entryUpdateMissTime tapes entry address := + le_trans hmissTime + (entryMissCopyTime_le_entryUpdateMissTime_internal tapes entry address + (rest.flatMap Entry.encode) work work matchDone.work hready hmatchInv) + have htime : + 1 + matchTime + 1 + missTime + 1 + + TM.binaryPredTime rest.length + 1 ≤ + entryUpdateIterationTime tapes entry rest address newValue + store.length := by + have hbranch : entryUpdateMissTime tapes entry address + 1 ≤ + entryUpdateBranchTime tapes entry address newValue store.length := + le_max_left _ _ + unfold entryUpdateIterationTime + omega + have hreplacementMiss : + missDone.work tapes.replacement = work tapes.replacement := + hmissReady.frame_outside_entry_internal tapes.replacement + tapes.replacement_ne_entry + have hfoundMiss : missDone.work tapes.found = work tapes.found := + hmissReady.frame_outside_entry_internal tapes.found tapes.found_ne_entry + have hresultCountMiss : + missDone.work tapes.resultCount = work tapes.resultCount := + hmissReady.frame_outside_entry_internal tapes.resultCount + tapes.resultCount_ne_entry + have hreplacementPred : + predDone.work tapes.replacement = missDone.work tapes.replacement := + hpredOther tapes.replacement + (Ne.symm tapes.remaining_ne_replacement) + have hfoundPred : predDone.work tapes.found = missDone.work tapes.found := + hpredOther tapes.found (Ne.symm tapes.remaining_ne_found) + have hresultCountPred : + predDone.work tapes.resultCount = missDone.work tapes.resultCount := + hpredOther tapes.resultCount (Ne.symm tapes.remaining_ne_resultCount) + have hframeMiss : EntryUpdateFrame tapes initialWork missDone.work := + hinv.frame.trans_ready_internal hmissReady + have hframePred : EntryUpdateFrame tapes initialWork predDone.work := + EntryUpdateFrame.trans_single_internal hframeMiss (9 : Fin 13) (by + intro i hi + apply hpredOther i + simpa [EntryUpdateTapes.remaining] using hi) + have hnextInv : EntryUpdateLoopInv tapes store address newValue + (processed ++ [entry]) rest (emitted ++ [entry]) found resultCount + initialWork predDone.work := by + refine ⟨hinv.progress.miss_internal hne, hreadyPred, ?_, ?_, hpredCount, + ?_, ?_, hinv.resultCount_le, hframePred⟩ + · rw [hreplacementPred, hreplacementMiss] + exact hinv.replacement + · exact hreplacementPred.trans + (hreplacementMiss.trans hinv.replacement_eq) + · rw [hfoundPred, hfoundMiss] + exact hinv.foundCount + · rw [hresultCountPred, hresultCountMiss] + exact hinv.resultCountTape + have hnextOutput : predDone.output.HasBinaryPrefix + (outPrefix ++ (emitted ++ [entry]).flatMap Entry.encode) := by + rw [hpredOutput] + simpa [List.flatMap_append, List.append_assoc] using hmissOutput + refine ⟨predDone.work, predDone.output, + 1 + matchTime + 1 + missTime + 1 + + TM.binaryPredTime rest.length + 1, htime, ?_, hnextInv, hnextOutput⟩ + convert hreach using 1 + omega + +end Machine + +end RegisterStore + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Out.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Out.lean new file mode 100644 index 0000000000..8ed24d7bc5 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Out.lean @@ -0,0 +1,107 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryAppend +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryMissCopy +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryReplace +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryPred +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryMatch + +/-! +# Bounded encoded sparse-store update — output safety internals + +The update controller delegates every nested phase to an independently checked +one-way-output machine. Its own dispatch transitions either read back or leave +the output head idle, so the complete controller remains a transducer. +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace RegisterStore + +namespace Machine + +/-- A canonical binary prefix parks its tape head away from the left endmarker +and contains no spurious left endmarkers. -/ +theorem parked_of_binaryPrefix_internal {t : Tape} {bits : List Bool} + (h : t.HasBinaryPrefix bits) : TM.Parked t := + ⟨by rw [h.1]; omega, + (show t.HasBinaryContent bits from h.2).cells_ne_start⟩ + +/-- The fixed sparse-store update controller never moves its output head left. -/ +theorem entryUpdateTM_isTransducer_internal {n : ℕ} + (tapes : EntryUpdateTapes n) : + (entryUpdateTM tapes).IsTransducer := by + intro state iHead wHeads oHead + cases state with + | test => + simp only [entryUpdateTM] + split + · split + · cases oHead <;> simp [TM.allReadBack, TM.idleDir] + · split <;> cases oHead <;> + simp [TM.allReadBack, TM.idleDir] + · cases oHead <;> simp [TM.allReadBack, TM.idleDir] + | matching q => + simp only [entryUpdateTM] + split + · split + · cases oHead <;> simp [TM.idleDir] + · cases oHead <;> simp [TM.allReadBack, TM.idleDir] + · exact entryMatchReadTM_isTransducer tapes.entry q iHead wHeads oHead + | miss q => + simp only [entryUpdateTM] + split + · cases oHead <;> simp [TM.allReadBack, TM.idleDir] + · exact entryMissCopyTM_isTransducer tapes.entry q iHead wHeads oHead + | delete q => + simp only [entryUpdateTM] + split + · cases oHead <;> simp [TM.allReadBack, TM.idleDir] + · exact entryMissCleanupTM_isTransducer tapes.entry q iHead wHeads oHead + | replace q => + simp only [entryUpdateTM] + split + · cases oHead <;> simp [TM.allReadBack, TM.idleDir] + · exact entryReplaceCleanupTM_isTransducer tapes.replace q iHead wHeads oHead + | append q => + simp only [entryUpdateTM] + split + · cases oHead <;> simp [TM.allReadBack, TM.idleDir] + · exact entryAppendRestoreTM_isTransducer tapes.replace q iHead wHeads oHead + | remaining q => + simp only [entryUpdateTM] + split + · cases oHead <;> simp [TM.allReadBack, TM.idleDir] + · exact TM.binaryPredTM_isTransducer tapes.remaining q iHead wHeads oHead + | deleteCount q => + simp only [entryUpdateTM] + split + · cases oHead <;> simp [TM.allReadBack, TM.idleDir] + · exact TM.binaryPredTM_isTransducer tapes.resultCount q iHead wHeads oHead + | appendCount q => + simp only [entryUpdateTM] + split + · cases oHead <;> simp [TM.allReadBack, TM.idleDir] + · exact TM.binarySuccTM_isTransducer tapes.resultCount q iHead wHeads oHead + | done => cases oHead <;> simp [entryUpdateTM, TM.allIdle, TM.idleDir] + +end Machine + +end RegisterStore + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Sem.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Sem.lean new file mode 100644 index 0000000000..c8b8af64ee --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Sem.lean @@ -0,0 +1,138 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import +LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Step +import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.End + +/-! +# Bounded encoded sparse-store update -- semantic composition + +This file composes the checked one-entry and terminal contracts into the +complete update loop. The induction is over the runtime-counted remaining +store, while the loop invariant carries the processed prefix and emitted +output needed to connect the concrete controller to `RegisterStore.write`. +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace RegisterStore + +namespace Machine + +variable {n : ℕ} + +/-- Starting from any valid loop boundary, the update controller finishes the +remaining suffix within its recursive static budget. -/ +theorem entryUpdateLoop_internal + (tapes : EntryUpdateTapes n) (store : Store) (address newValue : ℕ) + (processed remaining emitted : Store) (found : Bool) + (resultCount : ℕ) (initialWork work : Fin n → Tape) + (outPrefix : List Bool) (inp out : Tape) + (hinv : EntryUpdateLoopInv tapes store address newValue processed + remaining emitted found resultCount initialWork work) + (hnodup : AddressesNodup store) + (hinput : TM.Parked inp) + (houtput : out.HasBinaryPrefix + (outPrefix ++ emitted.flatMap Entry.encode)) : + ∃ final time, + time ≤ entryUpdateLoopTime tapes address newValue store.length + remaining ∧ + (entryUpdateTM tapes).reachesIn time + (entryUpdateTestCfg tapes inp work out) final ∧ + (entryUpdateTM tapes).halted final ∧ + final.input = inp ∧ + EntryUpdateOutcome tapes store address newValue initialWork final.work ∧ + final.output.HasBinaryPrefix + (outPrefix ++ (RegisterStore.write store address newValue).flatMap + Entry.encode) := by + induction remaining generalizing processed emitted found resultCount work out with + | nil => + exact entryUpdateTerminal_internal tapes store address newValue + processed emitted found resultCount initialWork work outPrefix inp out + hinv hinput houtput + | cons entry rest ih => + obtain ⟨processed', emitted', found', resultCount', nextWork, + nextOut, iterationTime, hiterationTime, hiterationReach, + hnextInv, hnextOutput⟩ := + entryUpdateIteration_internal tapes store address newValue processed + emitted entry rest found resultCount initialWork work outPrefix inp + out hinv hnodup hinput houtput + obtain ⟨final, recursiveTime, hrecursiveTime, hrecursiveReach, + hhalt, hfinalInput, houtcome, hfinalOutput⟩ := + ih processed' emitted' found' resultCount' nextWork nextOut hnextInv + hnextOutput + refine ⟨final, iterationTime + recursiveTime, ?_, ?_, hhalt, + hfinalInput, houtcome, hfinalOutput⟩ + · simp only [entryUpdateLoopTime] + omega + · exact TM.reachesIn_trans (entryUpdateTM tapes) hiterationReach + hrecursiveReach + +/-- A complete encoded sparse-store update realizes `RegisterStore.write`, +preserves input and the external work frame exactly, and appends precisely the +new store encoding to the caller's existing output prefix. -/ +theorem entryUpdateTM_hoareTime_frame_internal + (tapes : EntryUpdateTapes n) (store : Store) (address newValue : ℕ) + (emittedBits : List Bool) (initialWork : Fin n → Tape) + (inp₀ out₀ : Tape) + (hcanonical : Canonical store) + (hready : EntryScanReady tapes.entry (store.flatMap Entry.encode) + address.bits initialWork initialWork) + (hreplacement : + (initialWork tapes.replacement).HasBinaryNat newValue) + (hremaining : + (initialWork tapes.remaining).HasBinaryNat store.length) + (hfound : (initialWork tapes.found).HasBinaryNat 0) + (hresultCount : + (initialWork tapes.resultCount).HasBinaryNat store.length) + (hinput : TM.Parked inp₀) + (houtput : out₀.HasBinaryPrefix emittedBits) : + (entryUpdateTM tapes).HoareTime + (fun inp work out => + inp = inp₀ ∧ work = initialWork ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + EntryUpdateOutcome tapes store address newValue initialWork work ∧ + out.HasBinaryPrefix + (emittedBits ++ + (RegisterStore.write store address newValue).flatMap + Entry.encode)) + (entryUpdateTime tapes store address newValue) := by + intro inp work out hpre + rcases hpre with ⟨hinp, hwork, hout⟩ + subst inp + subst work + subst out + have hinv := entryUpdateLoopInv_initial_internal tapes store address + newValue initialWork hready hreplacement hremaining hfound hresultCount + have houtput' : out₀.HasBinaryPrefix + (emittedBits ++ ([] : Store).flatMap Entry.encode) := by + simpa using houtput + obtain ⟨final, time, htime, hreach, hhalt, hfinalInput, houtcome, + hfinalOutput⟩ := + entryUpdateLoop_internal tapes store address newValue [] store [] false + store.length initialWork initialWork emittedBits inp₀ out₀ hinv + hcanonical.1 hinput houtput' + refine ⟨final, time, ?_, ?_, hhalt, hfinalInput, houtcome, + hfinalOutput⟩ + · simpa [entryUpdateTime] using htime + · simpa [entryUpdateTestCfg, entryUpdateTM] using hreach + +end Machine + +end RegisterStore + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Step.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Step.lean new file mode 100644 index 0000000000..62ed78105d --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Step.lean @@ -0,0 +1,110 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Hit +public import +LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Miss + +/-! +# Bounded encoded sparse-store update -- one positive iteration +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace RegisterStore + +namespace Machine + +variable {n : ℕ} + +private theorem found_eq_false_of_current_eq + {tapes : EntryUpdateTapes n} {store : Store} {address newValue : ℕ} + {processed emitted : Store} {entry : Entry} {rest : Store} + {found : Bool} {resultCount : ℕ} + {initialWork work : Fin n → Tape} + (hinv : EntryUpdateLoopInv tapes store address newValue processed + (entry :: rest) emitted found resultCount initialWork work) + (hnodup : AddressesNodup store) (haddress : entry.1 = address) : + found = false := by + cases found with + | false => rfl + | true => + exfalso + have hnot := hinv.progress.not_mem_remaining_of_found_internal + hnodup rfl + apply hnot + simp [haddress] + +/-- One positive old-entry iteration advances the semantic and tape loop +invariant, returning to the controller's test state. -/ +theorem entryUpdateIteration_internal + (tapes : EntryUpdateTapes n) (store : Store) (address newValue : ℕ) + (processed emitted : Store) (entry : Entry) (rest : Store) + (found : Bool) (resultCount : ℕ) + (initialWork work : Fin n → Tape) (outPrefix : List Bool) + (inp out : Tape) + (hinv : EntryUpdateLoopInv tapes store address newValue processed + (entry :: rest) emitted found resultCount initialWork work) + (hnodup : AddressesNodup store) + (hinput : TM.Parked inp) + (houtput : out.HasBinaryPrefix + (outPrefix ++ emitted.flatMap Entry.encode)) : + ∃ processed' emitted' found' resultCount' nextWork nextOut time, + time ≤ entryUpdateIterationTime tapes entry rest address newValue + store.length ∧ + (entryUpdateTM tapes).reachesIn time + (entryUpdateTestCfg tapes inp work out) + (entryUpdateTestCfg tapes inp nextWork nextOut) ∧ + EntryUpdateLoopInv tapes store address newValue processed' rest emitted' + found' resultCount' initialWork nextWork ∧ + nextOut.HasBinaryPrefix + (outPrefix ++ emitted'.flatMap Entry.encode) := by + by_cases haddress : entry.1 = address + · have hfoundFalse := + found_eq_false_of_current_eq hinv hnodup haddress + have hinvFalse : EntryUpdateLoopInv tapes store address newValue + processed (entry :: rest) emitted false resultCount initialWork work := by + simpa [hfoundFalse] using hinv + by_cases hvalue : newValue = 0 + · subst newValue + obtain ⟨nextWork, nextOut, time, htime, hreach, hnextInv, + hnextOutput⟩ := + entryUpdateDeleteIteration_internal tapes store address processed + emitted entry rest resultCount initialWork work outPrefix inp out + hinvFalse haddress.symm hinput houtput + exact ⟨processed ++ [entry], emitted, true, resultCount - 1, + nextWork, nextOut, time, htime, hreach, hnextInv, hnextOutput⟩ + · obtain ⟨nextWork, nextOut, time, htime, hreach, hnextInv, + hnextOutput⟩ := + entryUpdateReplaceIteration_internal tapes store address newValue + processed emitted entry rest resultCount initialWork work outPrefix + inp out hinvFalse haddress.symm hvalue hinput houtput + exact ⟨processed ++ [entry], emitted ++ [(address, newValue)], true, + resultCount, nextWork, nextOut, time, htime, hreach, hnextInv, + hnextOutput⟩ + · + obtain ⟨nextWork, nextOut, time, htime, hreach, hnextInv, + hnextOutput⟩ := + entryUpdateIteration_miss_internal tapes store address newValue + processed emitted entry rest found resultCount initialWork work + outPrefix inp out hinv haddress hinput houtput + exact ⟨processed ++ [entry], emitted ++ [entry], found, resultCount, + nextWork, nextOut, time, htime, hreach, hnextInv, hnextOutput⟩ + +end Machine + +end RegisterStore + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Time.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Time.lean new file mode 100644 index 0000000000..48fcdfef90 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Time.lean @@ -0,0 +1,330 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryPred +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinarySucc +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.ResetBinaryMany +import Mathlib.Data.Rat.Cast.Order +import Mathlib.Tactic.FinCases +import Mathlib.Tactic.NormNum.Abs +import Mathlib.Tactic.NormNum.DivMod +import Mathlib.Tactic.NormNum.OfScientific + +/-! +# Bounded encoded sparse-store update — static runtime bounds + +The entry subroutines expose exact compositional times parameterized by the +current work family. This file discharges that dependency at the update-loop +boundary: a ready loop invariant fixes every owned starting head, while a +readable match bounds the one cursor whose endpoint is intentionally in-place. +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace RegisterStore + +namespace Machine + +variable {n : ℕ} + +/-- The preserved query is rewound at every update-loop boundary. -/ +theorem EntryScanReady.query_head_eq_one_internal + {tapes : EntryMatchTapes n} {remaining queryBits : List Bool} + {initialWork work : Fin n → Tape} + (h : EntryScanReady tapes remaining queryBits initialWork work) : + (work tapes.query).head = 1 := + h.query.1 + +/-- Every scratch target cleared by an update branch starts at cell one at a +ready loop boundary. -/ +theorem EntryScanReady.cleanup_target_head_eq_one_internal + {tapes : EntryMatchTapes n} {remaining queryBits : List Bool} + {initialWork work : Fin n → Tape} + (h : EntryScanReady tapes remaining queryBits initialWork work) : + ∀ i, i ∈ entryMissTargets tapes → (work i).head = 1 := by + intro i hi + obtain ⟨slot, rfl⟩ := List.mem_ofFn.mp hi + fin_cases slot + · simpa using h.address.1 + · simpa using h.value.1 + · exact h.addressCounter.2.1 + · exact h.addressWidth.2.1 + · exact h.valueCounter.2.1 + · exact h.valueWidth.2.1 + · simpa using h.result.1 + +/-- On a ready loop boundary, the exact deletion-cleanup time is the static +controller bound. -/ +theorem entryMissCleanupTime_eq_entryUpdateReadyCleanupTime_internal + (tapes : EntryUpdateTapes n) (entry : Entry) (address : ℕ) + {remaining : List Bool} {initialWork work : Fin n → Tape} + (hready : EntryScanReady tapes.entry remaining address.bits + initialWork work) : + entryMissCleanupTime tapes.entry entry address.bits work = + entryUpdateReadyCleanupTime tapes entry address := by + let matchTime := entryMatchReadTime entry address.bits + have hquery : + entryMissHeadBound entry address.bits work tapes.entry.query = + 1 + matchTime := by + simp [entryMissHeadBound, matchTime, hready.query_head_eq_one_internal] + have htargets : ∀ i, i ∈ entryMissTargets tapes.entry → + entryMissHeadBound entry address.bits work i = 1 + matchTime := by + intro i hi + simp [entryMissHeadBound, matchTime, + hready.cleanup_target_head_eq_one_internal i hi] + have hreset := TM.resetBinaryWorkManyTime_congr_headBound + (entryMissTargets tapes.entry) + (entryMissBits tapes.entry entry address.bits) + (entryMissHeadBound entry address.bits work) + (fun _ => 1 + matchTime) htargets + unfold entryMissCleanupTime entryUpdateReadyCleanupTime + rw [hquery, hreset] + +private theorem readable_other_cleanup_target_head + (tapes : EntryUpdateTapes n) (entry : Entry) (rest queryBits : List Bool) + (initialWork matchedWork : Fin n → Tape) + (hmatch : ReadableEntryMatch tapes.entry entry rest queryBits initialWork + matchedWork) (i : Fin n) (hi : i ∈ entryMissTargets tapes.entry) + (haddress : i ≠ tapes.entry.address) + (hvalue : i ≠ tapes.entry.value) : + (matchedWork i).head = entryUpdatePostEmitHead tapes entry i := by + obtain ⟨slot, rfl⟩ := List.mem_ofFn.mp hi + fin_cases slot + · simp at haddress + · simp at hvalue + · simpa [entryUpdatePostEmitHead, EntryMatchTapes.address, + EntryMatchTapes.value, EntryMatchTapes.addressCounter, + EntryMatchTapes.addressWidth, EntryMatchTapes.valueCounter, + EntryMatchTapes.valueWidth, EntryMatchTapes.result, + tapes.entry.injective.eq_iff] using + hmatch.addressCounter.1 + · simpa [entryUpdatePostEmitHead, EntryMatchTapes.address, + EntryMatchTapes.value, EntryMatchTapes.addressCounter, + EntryMatchTapes.addressWidth, EntryMatchTapes.valueCounter, + EntryMatchTapes.valueWidth, EntryMatchTapes.result, + tapes.entry.injective.eq_iff] using + hmatch.addressWidth.2.1 + · simpa [entryUpdatePostEmitHead, EntryMatchTapes.address, + EntryMatchTapes.value, EntryMatchTapes.addressCounter, + EntryMatchTapes.addressWidth, EntryMatchTapes.valueCounter, + EntryMatchTapes.valueWidth, EntryMatchTapes.result, + tapes.entry.injective.eq_iff] using + hmatch.valueCounter.1 + · simpa [entryUpdatePostEmitHead, EntryMatchTapes.address, + EntryMatchTapes.value, EntryMatchTapes.addressCounter, + EntryMatchTapes.addressWidth, EntryMatchTapes.valueCounter, + EntryMatchTapes.valueWidth, EntryMatchTapes.result, + tapes.entry.injective.eq_iff] using + hmatch.valueWidth.2.1 + · simpa [entryUpdatePostEmitHead, EntryMatchTapes.address, + EntryMatchTapes.value, EntryMatchTapes.addressCounter, + EntryMatchTapes.addressWidth, EntryMatchTapes.valueCounter, + EntryMatchTapes.valueWidth, EntryMatchTapes.result, + tapes.entry.injective.eq_iff] using + hmatch.result.1 + +private theorem entryMissCopiedWork_target_head + (tapes : EntryUpdateTapes n) (entry : Entry) (rest queryBits : List Bool) + (initialWork matchedWork : Fin n → Tape) + (hmatch : ReadableEntryMatch tapes.entry entry rest queryBits initialWork + matchedWork) : + ∀ i, i ∈ entryMissTargets tapes.entry → + (entryMissCopiedWork tapes.entry entry matchedWork i).head = + entryUpdatePostEmitHead tapes entry i := by + intro i hi + by_cases haddress : i = tapes.entry.address + · subst i + simp [entryMissCopiedWork, entryUpdatePostEmitHead] + · by_cases hvalue : i = tapes.entry.value + · subst i + simp [entryMissCopiedWork, entryUpdatePostEmitHead, haddress] + · simp only [entryMissCopiedWork, haddress, hvalue, if_false] + exact readable_other_cleanup_target_head tapes entry rest queryBits + initialWork matchedWork hmatch i hi haddress hvalue + +private theorem entryReplaceReadyWork_target_head + (tapes : EntryUpdateTapes n) (entry : Entry) (rest queryBits : List Bool) + (initialWork matchedWork : Fin n → Tape) + (hmatch : ReadableEntryMatch tapes.entry entry rest queryBits initialWork + matchedWork) : + ∀ i, i ∈ entryMissTargets tapes.entry → + (entryReplaceReadyWork tapes.replace entry matchedWork i).head = + entryUpdatePostEmitHead tapes entry i := by + intro i hi + by_cases haddress : i = tapes.entry.address + · subst i + simp [entryReplaceReadyWork, entryUpdatePostEmitHead] + · by_cases hvalue : i = tapes.entry.value + · subst i + simpa [entryReplaceReadyWork, entryUpdatePostEmitHead, haddress] using + hmatch.value.1 + · have haddress' : i ≠ tapes.replace.entry.address := by + simpa using haddress + rw [entryReplaceReadyWork, if_neg haddress'] + exact readable_other_cleanup_target_head tapes entry rest queryBits + initialWork matchedWork hmatch i hi haddress hvalue + +private theorem entryMissCleanupTime_postEmit_le + (tapes : EntryUpdateTapes n) (entry : Entry) (address : ℕ) + (rest : List Bool) + (initialWork readyWork matchedWork postEmitWork : Fin n → Tape) + (hready : EntryScanReady tapes.entry (Entry.encode entry ++ rest) + address.bits initialWork readyWork) + (hmatch : ReadableEntryMatch tapes.entry entry rest address.bits readyWork + matchedWork) + (hqueryEq : postEmitWork tapes.entry.query = + matchedWork tapes.entry.query) + (htargets : ∀ i, i ∈ entryMissTargets tapes.entry → + (postEmitWork i).head = entryUpdatePostEmitHead tapes entry i) : + entryMissCleanupTime tapes.entry entry address.bits postEmitWork ≤ + entryUpdatePostEmitCleanupTime tapes entry address := by + let matchTime := entryMatchReadTime entry address.bits + have hqueryMatched : (matchedWork tapes.entry.query).head ≤ + 1 + matchTime := by + simpa [matchTime, hready.query_head_eq_one_internal] using + hmatch.headBound tapes.entry.query + have hqueryPost : (postEmitWork tapes.entry.query).head ≤ + 1 + matchTime := by + rw [hqueryEq] + exact hqueryMatched + have hquery : + entryMissHeadBound entry address.bits postEmitWork tapes.entry.query ≤ + 1 + 2 * matchTime := by + simp only [entryMissHeadBound] + omega + have htargets' : ∀ i, i ∈ entryMissTargets tapes.entry → + entryMissHeadBound entry address.bits postEmitWork i = + entryUpdatePostEmitHead tapes entry i + matchTime := by + intro i hi + simp [entryMissHeadBound, matchTime, htargets i hi] + have hreset := TM.resetBinaryWorkManyTime_congr_headBound + (entryMissTargets tapes.entry) + (entryMissBits tapes.entry entry address.bits) + (entryMissHeadBound entry address.bits postEmitWork) + (fun i => entryUpdatePostEmitHead tapes entry i + matchTime) htargets' + simp only [matchTime] at hreset + dsimp only [entryMissCleanupTime, entryUpdatePostEmitCleanupTime] + rw [hreset] + omega + +/-- A ready comparison followed by miss emission has a work-independent +runtime bounded by the controller's static miss budget. -/ +theorem entryMissCopyTime_le_entryUpdateMissTime_internal + (tapes : EntryUpdateTapes n) (entry : Entry) (address : ℕ) + (rest : List Bool) (initialWork readyWork matchedWork : Fin n → Tape) + (hready : EntryScanReady tapes.entry (Entry.encode entry ++ rest) + address.bits initialWork readyWork) + (hmatch : ReadableEntryMatch tapes.entry entry rest address.bits readyWork + matchedWork) : + entryMissCopyTime tapes.entry entry address.bits readyWork matchedWork ≤ + entryUpdateMissTime tapes entry address := by + let matchTime := entryMatchReadTime entry address.bits + have haddress : + entryMissHeadBound entry address.bits readyWork tapes.entry.address = + 1 + matchTime := by + simp [entryMissHeadBound, matchTime, hready.address.1] + have hvalue : + entryMissHeadBound entry address.bits readyWork tapes.entry.value = + 1 + matchTime := by + simp [entryMissHeadBound, matchTime, hready.value.1] + have hqueryNeAddress : tapes.entry.query ≠ tapes.entry.address := + tapes.entry.ne (by decide) + have hqueryNeValue : tapes.entry.query ≠ tapes.entry.value := + tapes.entry.ne (by decide) + have hquery : + entryMissCopiedWork tapes.entry entry matchedWork tapes.entry.query = + matchedWork tapes.entry.query := by + simp [entryMissCopiedWork, hqueryNeAddress, hqueryNeValue] + have hcleanup := entryMissCleanupTime_postEmit_le tapes entry address rest + initialWork readyWork matchedWork + (entryMissCopiedWork tapes.entry entry matchedWork) hready hmatch hquery + (entryMissCopiedWork_target_head tapes entry rest address.bits readyWork + matchedWork hmatch) + dsimp only [entryMissCopyTime, entryUpdateMissTime] + rw [haddress, hvalue] + exact Nat.add_le_add_left hcleanup _ + +/-- A ready comparison followed by replacement emission has a work-independent +runtime bounded by the controller's static replacement budget. -/ +theorem entryReplaceCleanupTime_le_entryUpdateReplaceTime_internal + (tapes : EntryUpdateTapes n) (entry : Entry) (address newValue : ℕ) + (rest : List Bool) (initialWork readyWork matchedWork : Fin n → Tape) + (hready : EntryScanReady tapes.entry (Entry.encode entry ++ rest) + address.bits initialWork readyWork) + (hmatch : ReadableEntryMatch tapes.entry entry rest address.bits readyWork + matchedWork) : + entryReplaceCleanupTime tapes.replace entry newValue address.bits readyWork + matchedWork ≤ + entryUpdateReplaceTime tapes entry address newValue := by + let matchTime := entryMatchReadTime entry address.bits + have haddress : + entryMissHeadBound entry address.bits readyWork tapes.entry.address = + 1 + matchTime := by + simp [entryMissHeadBound, matchTime, hready.address.1] + have hqueryNeAddress : tapes.entry.query ≠ tapes.entry.address := + tapes.entry.ne (by decide) + have hquery : + entryReplaceReadyWork tapes.replace entry matchedWork tapes.entry.query = + matchedWork tapes.entry.query := by + simp [entryReplaceReadyWork, hqueryNeAddress] + have hcleanup := entryMissCleanupTime_postEmit_le tapes entry address rest + initialWork readyWork matchedWork + (entryReplaceReadyWork tapes.replace entry matchedWork) hready hmatch hquery + (entryReplaceReadyWork_target_head tapes entry rest address.bits readyWork + matchedWork hmatch) + have haddress' : + entryMissHeadBound entry address.bits readyWork + tapes.replace.entry.address = + 1 + matchTime := by + simpa only [EntryUpdateTapes.replace_entry] using haddress + have hcleanup' : + entryMissCleanupTime tapes.replace.entry entry address.bits + (entryReplaceReadyWork tapes.replace entry matchedWork) ≤ + entryUpdatePostEmitCleanupTime tapes entry address := by + simpa only [EntryUpdateTapes.replace_entry] using hcleanup + dsimp only [entryReplaceCleanupTime, entryUpdateReplaceTime] + rw [haddress'] + simp only [matchTime] + exact Nat.add_le_add_left + (Nat.add_le_add_left hcleanup' (newValue.bits.length + 1 + 2 + 1)) + (rewindEntryEncodeTime (entry.1, newValue) + (1 + entryMatchReadTime entry address.bits) 1 + 1) + +/-- A positive counter no larger than the initial store size can be +decremented within the update controller's uniform counter budget. -/ +theorem binaryPredTime_le_entryUpdateCountTime_internal + {value total : ℕ} (hvalue : value + 1 ≤ total) : + TM.binaryPredTime value ≤ entryUpdateCountTime total := by + have htime := TM.binaryPredTime_le value + have hsize := Nat.size_le_size hvalue + unfold entryUpdateCountTime + omega + +/-- A counter no larger than the initial store size can be incremented within +the update controller's uniform counter budget. -/ +theorem binarySuccTime_le_entryUpdateCountTime_internal + {value total : ℕ} (hvalue : value ≤ total) : + TM.binarySuccTime value ≤ entryUpdateCountTime total := by + have htime := TM.binarySuccTime_le value + have hsize := Nat.size_le_size hvalue + unfold entryUpdateCountTime + omega + +end Machine + +end RegisterStore + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Progress.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Progress.lean new file mode 100644 index 0000000000..3e4b649db4 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Progress.lean @@ -0,0 +1,195 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Defs + +/-! +# Bounded encoded sparse-store update — progress invariant internals + +This file isolates the pure list semantics of the entry-update loop. The +invariant relates the processed and remaining portions of the old store to the +entries already emitted by the machine, independently of the tape-level +simulation proof. +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace RegisterStore + +namespace Machine + +/-- Pure semantic progress of a left-to-right sparse-store update. + +The output equation is deliberately phrased as a completion equation. Before +the target address is found, completing the emitted prefix requires updating +the remaining suffix. Afterwards, the untouched remaining suffix is copied +verbatim. -/ +structure EntryUpdateProgress + (store : Store) (address newValue : ℕ) + (processed remaining emitted : Store) + (found : Bool) (resultCount : ℕ) : Prop where + /-- The scan decomposition still covers the original store. -/ + store_eq : store = processed ++ remaining + /-- The flag records exactly whether the processed prefix contains the + requested address. -/ + found_iff : found = true ↔ address ∈ processed.map Prod.fst + /-- Completing the emitted prefix produces the abstract sparse-store write. -/ + output_eq : + emitted ++ (if found = true then remaining + else RegisterStore.write remaining address newValue) = + RegisterStore.write store address newValue + /-- Until the optional final append, the runtime result count equals emitted + entries plus old entries still remaining. -/ + resultCount_eq : resultCount = emitted.length + remaining.length + +/-- Before scanning any entries, the empty emitted prefix satisfies the +progress invariant. -/ +theorem entryUpdateProgress_initial_internal + (store : Store) (address newValue : ℕ) : + EntryUpdateProgress store address newValue [] store [] false store.length := by + constructor <;> simp + +/-- Copying a nonmatching entry advances all three list frontiers without +changing either the found flag or the result count. -/ +theorem EntryUpdateProgress.miss_internal + {store : Store} {address newValue : ℕ} + {processed remaining emitted : Store} {entry : Entry} + {found : Bool} {resultCount : ℕ} + (h : EntryUpdateProgress store address newValue processed + (entry :: remaining) emitted found resultCount) + (hne : entry.1 ≠ address) : + EntryUpdateProgress store address newValue (processed ++ [entry]) + remaining (emitted ++ [entry]) found resultCount := by + constructor + · simpa [List.append_assoc] using h.store_eq + · simpa [List.map_append, hne, Ne.symm hne] using h.found_iff + · by_cases hfound : found = true + · simpa [hfound, List.append_assoc] using h.output_eq + · simpa [hfound, RegisterStore.write, Ne.symm hne, + List.append_assoc] using h.output_eq + · have hcount := h.resultCount_eq + simp only [List.length_cons] at hcount + simp only [List.length_append, List.length_singleton] + omega + +/-- Replacing the first matching entry emits the new nonzero pair and records +that the target address has been found. -/ +theorem EntryUpdateProgress.replace_internal + {store : Store} {address newValue : ℕ} + {processed remaining emitted : Store} {entry : Entry} + {resultCount : ℕ} + (h : EntryUpdateProgress store address newValue processed + (entry :: remaining) emitted false resultCount) + (haddress : address = entry.1) (hvalue : newValue ≠ 0) : + EntryUpdateProgress store address newValue (processed ++ [entry]) + remaining (emitted ++ [(address, newValue)]) true resultCount := by + constructor + · simpa [List.append_assoc] using h.store_eq + · simp [List.map_append, haddress] + · simpa [RegisterStore.write, haddress, hvalue, List.append_assoc] + using h.output_eq + · have hcount := h.resultCount_eq + simp only [List.length_cons] at hcount + simp only [List.length_append, List.length_singleton] + omega + +/-- Deleting the first matching entry emits nothing for it, records the hit, +and decrements the result count. -/ +theorem EntryUpdateProgress.delete_internal + {store : Store} {address : ℕ} + {processed remaining emitted : Store} {entry : Entry} + {resultCount : ℕ} + (h : EntryUpdateProgress store address 0 processed + (entry :: remaining) emitted false resultCount) + (haddress : address = entry.1) : + EntryUpdateProgress store address 0 (processed ++ [entry]) remaining + emitted true (resultCount - 1) := by + constructor + · simpa [List.append_assoc] using h.store_eq + · simp [List.map_append, haddress] + · simpa [RegisterStore.write, haddress] using h.output_eq + · have hcount := h.resultCount_eq + simp only [List.length_cons] at hcount + omega + +/-- Once the scan is exhausted after a hit, the emitted store and result count +are already the abstract write result. -/ +theorem EntryUpdateProgress.terminal_found_internal + {store : Store} {address newValue : ℕ} + {processed emitted : Store} {resultCount : ℕ} + (h : EntryUpdateProgress store address newValue processed [] emitted true + resultCount) : + emitted = RegisterStore.write store address newValue ∧ + resultCount = (RegisterStore.write store address newValue).length := by + have houtput : emitted = RegisterStore.write store address newValue := by + simpa using h.output_eq + exact ⟨houtput, by simpa [houtput] using h.resultCount_eq⟩ + +/-- An absent address written with zero requires no append; exhaustion already +produces the abstract empty write contribution. -/ +theorem EntryUpdateProgress.terminal_zero_internal + {store : Store} {address : ℕ} + {processed emitted : Store} {resultCount : ℕ} + (h : EntryUpdateProgress store address 0 processed [] emitted false + resultCount) : + emitted = RegisterStore.write store address 0 ∧ + resultCount = (RegisterStore.write store address 0).length := by + have houtput : emitted = RegisterStore.write store address 0 := by + simpa [RegisterStore.write] using h.output_eq + exact ⟨houtput, by simpa [houtput] using h.resultCount_eq⟩ + +/-- An absent address written with a nonzero value is completed by one final +append and one result-count increment. -/ +theorem EntryUpdateProgress.terminal_append_internal + {store : Store} {address newValue : ℕ} + {processed emitted : Store} {resultCount : ℕ} + (h : EntryUpdateProgress store address newValue processed [] emitted false + resultCount) + (hvalue : newValue ≠ 0) : + emitted ++ [(address, newValue)] = + RegisterStore.write store address newValue ∧ + resultCount + 1 = + (RegisterStore.write store address newValue).length := by + have houtput : emitted ++ [(address, newValue)] = + RegisterStore.write store address newValue := by + simpa [RegisterStore.write, hvalue] using h.output_eq + constructor + · exact houtput + · rw [← houtput] + have hcount := h.resultCount_eq + simp only [List.length_nil, Nat.add_zero] at hcount + simp only [List.length_append, List.length_singleton] + omega + +/-- In a store with unique addresses, finding the target in the processed +prefix excludes it from the unprocessed suffix. -/ +theorem EntryUpdateProgress.not_mem_remaining_of_found_internal + {store : Store} {address newValue : ℕ} + {processed remaining emitted : Store} {found : Bool} + {resultCount : ℕ} + (h : EntryUpdateProgress store address newValue processed remaining + emitted found resultCount) + (hnodup : AddressesNodup store) (hfound : found = true) : + address ∉ remaining.map Prod.fst := by + rw [h.store_eq] at hnodup + simp only [AddressesNodup, List.map_append] at hnodup + exact fun hremaining => + (List.nodup_append.mp hnodup).2.2 address + (h.found_iff.mp hfound) address hremaining rfl + +end Machine + +end RegisterStore + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Source.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Source.lean new file mode 100644 index 0000000000..d52829416f --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Source.lean @@ -0,0 +1,521 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Defs +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryScan.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.WorkReadOnly +public import Std.Tactic.BVDecide.Normalize.BitVec + +/-! +# Sparse-store update source preservation + +The update controller advances its encoded source cursor but never changes the +source cells. This file packages that local transition fact as a reusable +read-only certificate. +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace RegisterStore + +namespace Machine + +variable {n : ℕ} + +private theorem binarySuccTM_readOnly_of_ne (target other : Fin n) + (hne : other ≠ target) : + (TM.binarySuccTM target).WorkReadOnly other := by + intro state inputHead workHeads outputHead hstate + cases state with + | carry => + cases hread : workHeads target <;> + simp [TM.binarySuccTM, hread, hne] + | rewind => + by_cases hread : workHeads target = Γ.start <;> + simp [TM.binarySuccTM, hread] + | done => exact (hstate rfl).elim + +private theorem binaryPredTM_readOnly_of_ne (target other : Fin n) + (hne : other ≠ target) : + (TM.binaryPredTM target).WorkReadOnly other := by + intro state inputHead workHeads outputHead hstate + cases state with + | borrow | check => + cases hread : workHeads target <;> + simp [TM.binaryPredTM, hread, hne] + | erase | rewind => + by_cases hread : workHeads target = Γ.start <;> + simp [TM.binaryPredTM, hread, hne] + | done => exact (hstate rfl).elim + +private theorem rewindWorkTM_readOnly (target other : Fin n) : + (TM.rewindWorkTM target).WorkReadOnly other := by + intro state inputHead workHeads outputHead hstate + cases state with + | moveLeft => + by_cases hread : workHeads target = Γ.start <;> + simp [TM.rewindWorkTM, hread] + | moveRight => rfl + | done => exact (hstate rfl).elim + +private theorem blankWorkTM_readOnly_of_ne (target other : Fin n) + (hne : other ≠ target) : + (TM.blankWorkTM target).WorkReadOnly other := by + intro state inputHead workHeads outputHead hstate + cases state with + | scanning => + by_cases hread : workHeads target = Γ.blank <;> + simp [TM.blankWorkTM, hread, hne] + | done => exact (hstate rfl).elim + +private theorem clearWorkTM_readOnly_of_ne (target other : Fin n) + (hne : other ≠ target) : + (TM.clearWorkTM target).WorkReadOnly other := by + exact (blankWorkTM_readOnly_of_ne target other hne).seqTM + (rewindWorkTM_readOnly target other) + +private theorem resetBinaryWorkTM_readOnly_of_ne (target other : Fin n) + (hne : other ≠ target) : + (TM.resetBinaryWorkTM target).WorkReadOnly other := by + unfold TM.resetBinaryWorkTM + exact (rewindWorkTM_readOnly target other).seqTM + (clearWorkTM_readOnly_of_ne target other hne) + +private theorem skipTM_readOnly (other : Fin n) : + (TM.skipTM (n := n)).WorkReadOnly other := by + intro state inputHead workHeads outputHead hstate + rfl + +private theorem resetBinaryWorkManyTM_readOnly_of_not_mem + (targets : List (Fin n)) (other : Fin n) (hnotmem : other ∉ targets) : + (TM.resetBinaryWorkManyTM targets).WorkReadOnly other := by + induction targets with + | nil => exact skipTM_readOnly other + | cons target targets ih => + simp only [List.mem_cons, not_or] at hnotmem + exact (resetBinaryWorkTM_readOnly_of_ne target other hnotmem.1).seqTM + (ih hnotmem.2) + +private theorem forWorkOnesTM_readOnly (driver other : Fin n) (body : TM n) + (hbody : body.WorkReadOnly other) : + (TM.forWorkOnesTM driver body).WorkReadOnly other := by + intro state inputHead workHeads outputHead hstate + cases state with + | inl phase => + cases phase with + | scan => + by_cases hstart : workHeads driver = Γ.start + · simp [TM.forWorkOnesTM, hstart] + · by_cases hone : workHeads driver = Γ.one + · simp [TM.forWorkOnesTM, hone] + · simp only [TM.forWorkOnesTM, hstart, hone, ↓reduceIte] + rfl + | done => exact (hstate rfl).elim + | inr state => + by_cases hhalt : state = body.qhalt + · simp only [TM.forWorkOnesTM, hhalt, ↓reduceIte] + rfl + · simpa [TM.forWorkOnesTM, hhalt] using + hbody state inputHead workHeads outputHead hhalt + +private theorem binaryForTM_readOnly (body : TM n) + (counter limit other : Fin n) (hbody : body.WorkReadOnly other) + (hne : other ≠ counter) : + (TM.binaryForTM body counter limit).WorkReadOnly other := by + have hiteration : + (TM.binaryForIterationTM body counter).WorkReadOnly other := by + exact hbody.seqTM (binarySuccTM_readOnly_of_ne counter other hne) + intro state inputHead workHeads outputHead hstate + cases state with + | inl phase => + cases phase with + | scan equalSoFar => + by_cases hblank : + workHeads counter = Γ.blank ∧ workHeads limit = Γ.blank <;> + simp [TM.binaryForTM, hblank] + | rewind equalSoFar => + by_cases hstart : + workHeads counter = Γ.start ∧ workHeads limit = Γ.start <;> + simp [TM.binaryForTM, hstart] + | done => exact (hstate rfl).elim + | inr state => + by_cases hhalt : state = (TM.binaryForIterationTM body counter).qhalt + · simp only [TM.binaryForTM, hhalt, ↓reduceIte] + rfl + · simpa [TM.binaryForTM, hhalt] using + hiteration state inputHead workHeads outputHead hhalt + +private theorem workEmitTM_readOnly (target other : Fin n) + (mode : WorkEmitMode) : + (workEmitTM target mode).WorkReadOnly other := by + intro state inputHead workHeads outputHead hstate + cases state with + | scan => + cases hread : workHeads target with + | zero | one => simp [workEmitTM, hread] + | start => + simp only [workEmitTM, hread] + rfl + | blank => + by_cases hmode : mode = .width + · simp [workEmitTM, hread, hmode] + · simp only [workEmitTM, hread, hmode, ↓reduceIte] + rfl + | done => exact (hstate rfl).elim + +private theorem wordEncodeTM_readOnly (target other : Fin n) : + (wordEncodeTM target).WorkReadOnly other := by + unfold wordEncodeTM + exact (workEmitTM_readOnly target other .width).seqTM + ((rewindWorkTM_readOnly target other).seqTM + (workEmitTM_readOnly target other .payload)) + +private theorem rewindWordEncodeTM_readOnly (target other : Fin n) : + (rewindWordEncodeTM target).WorkReadOnly other := by + unfold rewindWordEncodeTM + exact (rewindWorkTM_readOnly target other).seqTM + (wordEncodeTM_readOnly target other) + +private theorem rewindEntryEncodeTM_readOnly + (tapes : EntryEncodeTapes n) (other : Fin n) : + (rewindEntryEncodeTM tapes).WorkReadOnly other := by + unfold rewindEntryEncodeTM + exact (rewindWordEncodeTM_readOnly tapes.address other).seqTM + (rewindWordEncodeTM_readOnly tapes.value other) + +private theorem payloadBitTM_source_readOnly (source target : Fin n) + (hne : source ≠ target) : + (payloadBitTM source target).WorkReadOnly source := by + intro state inputHead workHeads outputHead hstate + cases state with + | copy => + cases hread : workHeads source with + | zero | one => simp [payloadBitTM, hread, hne] + | blank => + simp [payloadBitTM, hread, TM.allReadBack] + | start => simp [payloadBitTM, hread, TM.allIdle, TM.readBackWrite] + | done => exact (hstate rfl).elim + +private theorem wordSeparatorTM_source_readOnly (source : Fin n) : + (wordSeparatorTM source).WorkReadOnly source := by + intro state inputHead workHeads outputHead hstate + cases state with + | skip => + by_cases hzero : workHeads source = Γ.zero + · simp [wordSeparatorTM, hzero] + · by_cases hstart : workHeads source = Γ.start + · simp [wordSeparatorTM, hstart, TM.allIdle, TM.readBackWrite] + · simp only [wordSeparatorTM, hzero, hstart, ↓reduceIte] + simp [TM.allReadBack] + | done => exact (hstate rfl).elim + +private theorem binaryEqTM_readOnly_of_ne_result + (lhs rhs result other : Fin n) (hne : other ≠ result) : + (TM.binaryEqTM lhs rhs result).WorkReadOnly other := by + intro state inputHead workHeads outputHead hstate + cases state with + | scan => + by_cases hblank : + workHeads lhs = Γ.blank ∧ workHeads rhs = Γ.blank + · simp [TM.binaryEqTM, hblank, hne] + · by_cases heq : workHeads lhs = workHeads rhs + · have hrhs : workHeads rhs ≠ Γ.blank := by + intro hrhs + apply hblank + exact ⟨heq.trans hrhs, hrhs⟩ + simp [TM.binaryEqTM, heq, hrhs] + · simp [TM.binaryEqTM, hblank, heq, hne] + | done => exact (hstate rfl).elim + +private theorem wordDecodeTM_source_readOnly + (source target counter width : Fin n) + (hsourceTarget : source ≠ target) + (hsourceCounter : source ≠ counter) + (hsourceWidth : source ≠ width) : + (wordDecodeTM source target counter width).WorkReadOnly source := by + have hwidth : (wordWidthTM source width).WorkReadOnly source := by + unfold wordWidthTM + exact forWorkOnesTM_readOnly source source (TM.binarySuccTM width) + (binarySuccTM_readOnly_of_ne width source hsourceWidth) + have hpayload : + (wordPayloadTM source target counter width).WorkReadOnly source := by + unfold wordPayloadTM + exact binaryForTM_readOnly (payloadBitTM source target) counter width source + (payloadBitTM_source_readOnly source target hsourceTarget) hsourceCounter + unfold wordDecodeTM + exact hwidth.seqTM + ((wordSeparatorTM_source_readOnly source).seqTM hpayload) + +private theorem entryDecodeTM_source_readOnly (tapes : EntryDecodeTapes n) : + (entryDecodeTM tapes).WorkReadOnly tapes.source := by + unfold entryDecodeTM + exact + (wordDecodeTM_source_readOnly tapes.source tapes.address + tapes.addressCounter tapes.addressWidth + (tapes.ne (by decide)) (tapes.ne (by decide)) + (tapes.ne (by decide))).seqTM + (wordDecodeTM_source_readOnly tapes.source tapes.value + tapes.valueCounter tapes.valueWidth + (tapes.ne (by decide)) (tapes.ne (by decide)) + (tapes.ne (by decide))) + +private theorem wordDecodeLinearTM_source_readOnly + (source target marker : Fin n) (hsourceTarget : source ≠ target) + (hsourceMarker : source ≠ marker) : + (wordDecodeLinearTM source target marker).WorkReadOnly source := by + intro phase inputHead workHeads outputHead hphase + cases phase with + | mark => + cases hsource : workHeads source <;> + simp [wordDecodeLinearTM, hsource, hsourceMarker, TM.allReadBack, + TM.allIdle, TM.readBackWrite] + | rewind => + by_cases hmarker : workHeads marker = Γ.start <;> + simp [wordDecodeLinearTM, hmarker] + | copy => + cases hmarker : workHeads marker with + | one => + cases hsource : workHeads source <;> + simp [wordDecodeLinearTM, hmarker, hsource, hsourceTarget, + TM.allReadBack] + | zero | blank => + simp [wordDecodeLinearTM, hmarker, TM.allReadBack] + | start => + simp [wordDecodeLinearTM, hmarker] + | done => exact (hphase rfl).elim + +private theorem entryDecodeLinearTM_source_readOnly + (tapes : EntryDecodeTapes n) : + (entryDecodeLinearTM tapes).WorkReadOnly tapes.source := by + unfold entryDecodeLinearTM + exact + (wordDecodeLinearTM_source_readOnly tapes.source tapes.address + tapes.addressCounter (tapes.ne (by decide)) + (tapes.ne (by decide))).seqTM + (wordDecodeLinearTM_source_readOnly tapes.source tapes.value + tapes.valueCounter (tapes.ne (by decide)) (tapes.ne (by decide))) + +private theorem decodedAddressEqTM_readOnly_of_ne_result + (address query result other : Fin n) (hne : other ≠ result) : + (decodedAddressEqTM address query result).WorkReadOnly other := by + unfold decodedAddressEqTM + exact (rewindWorkTM_readOnly address other).seqTM + (binaryEqTM_readOnly_of_ne_result address query result other hne) + +private theorem entryMatchReadTM_source_readOnly (tapes : EntryMatchTapes n) : + (entryMatchReadTM tapes).WorkReadOnly tapes.source := by + have hdecode : + (entryDecodeLinearTM tapes.decode).WorkReadOnly tapes.source := + entryDecodeLinearTM_source_readOnly tapes.decode + have heq : + (decodedAddressEqTM tapes.address tapes.query tapes.result).WorkReadOnly + tapes.source := + decodedAddressEqTM_readOnly_of_ne_result tapes.address tapes.query + tapes.result tapes.source (tapes.ne (by decide)) + unfold entryMatchReadTM entryMatchTM + exact (hdecode.seqTM heq).seqTM + (rewindWorkTM_readOnly tapes.result tapes.source) + +private theorem source_not_mem_entryMissTargets (tapes : EntryMatchTapes n) : + tapes.source ∉ entryMissTargets tapes := by + intro hmem + obtain ⟨slot, hslot⟩ := List.mem_ofFn.mp hmem + have hidx := tapes.injective hslot + have hval := congrArg Fin.val hidx + change (if slot.val = 6 then 8 else slot.val + 1) = 0 at hval + split at hval <;> omega + +private theorem entryMissCleanupTM_source_readOnly + (tapes : EntryMatchTapes n) : + (entryMissCleanupTM tapes).WorkReadOnly tapes.source := by + unfold entryMissCleanupTM + exact (rewindWorkTM_readOnly tapes.query tapes.source).seqTM + (resetBinaryWorkManyTM_readOnly_of_not_mem + (entryMissTargets tapes) tapes.source + (source_not_mem_entryMissTargets tapes)) + +private theorem entryMissCopyTM_source_readOnly (tapes : EntryMatchTapes n) : + (entryMissCopyTM tapes).WorkReadOnly tapes.source := by + unfold entryMissCopyTM + exact (rewindEntryEncodeTM_readOnly tapes.encodeTapes tapes.source).seqTM + (entryMissCleanupTM_source_readOnly tapes) + +private theorem entryReplaceCleanupTM_source_readOnly + (tapes : EntryReplaceTapes n) : + (entryReplaceCleanupTM tapes).WorkReadOnly tapes.entry.source := by + unfold entryReplaceCleanupTM + exact + (rewindEntryEncodeTM_readOnly tapes.encodeTapes tapes.entry.source).seqTM + ((rewindWorkTM_readOnly tapes.replacement tapes.entry.source).seqTM + (entryMissCleanupTM_source_readOnly tapes.entry)) + +private theorem entryAppendRestoreTM_source_readOnly + (tapes : EntryReplaceTapes n) : + (entryAppendRestoreTM tapes).WorkReadOnly tapes.entry.source := by + unfold entryAppendRestoreTM + exact + (rewindEntryEncodeTM_readOnly tapes.appendEncodeTapes + tapes.entry.source).seqTM + ((rewindWorkTM_readOnly tapes.entry.query tapes.entry.source).seqTM + (rewindWorkTM_readOnly tapes.replacement tapes.entry.source)) + +private theorem branchWorkSymbolTM_readOnly + (idx : Fin n) (symbol : Γ) (onEqual onDifferent : TM n) + (other : Fin n) (hequal : onEqual.WorkReadOnly other) + (hdifferent : onDifferent.WorkReadOnly other) : + (TM.branchWorkSymbolTM idx symbol onEqual onDifferent).WorkReadOnly + other := by + intro state inputHead workHeads outputHead hstate + cases state with + | inl phase => + cases phase with + | dispatch => + by_cases hread : workHeads idx = symbol <;> + simp [TM.branchWorkSymbolTM, hread, TM.allReadBack] + | done => exact (hstate rfl).elim + | inr branch => + cases branch with + | inl state => + by_cases hhalt : state = onEqual.qhalt + · simp [TM.branchWorkSymbolTM, hhalt, TM.allReadBack] + · simpa [TM.branchWorkSymbolTM, hhalt] using + hequal state inputHead workHeads outputHead hhalt + | inr state => + by_cases hhalt : state = onDifferent.qhalt + · simp [TM.branchWorkSymbolTM, hhalt, TM.allReadBack] + · simpa [TM.branchWorkSymbolTM, hhalt] using + hdifferent state inputHead workHeads outputHead hhalt + +private theorem entryScanStepTM_source_readOnly (tapes : EntryMatchTapes n) : + (entryScanStepTM tapes).WorkReadOnly tapes.source := by + have hbranch : + (entryScanBranchTM tapes).WorkReadOnly tapes.source := by + unfold entryScanBranchTM + exact branchWorkSymbolTM_readOnly tapes.result Γ.one TM.skipTM + (entryMissCleanupTM tapes) tapes.source + (skipTM_readOnly tapes.source) + (entryMissCleanupTM_source_readOnly tapes) + unfold entryScanStepTM + exact (entryMatchReadTM_source_readOnly tapes).seqTM hbranch + +/-- The bounded lookup scanner advances but never changes its encoded source +cells. -/ +theorem entryScanTM_source_readOnly_internal (tapes : EntryScanTapes n) : + (entryScanTM tapes).WorkReadOnly tapes.entry.source := by + have hstep := entryScanStepTM_source_readOnly tapes.entry + have hcount := binaryPredTM_readOnly_of_ne tapes.count tapes.entry.source + tapes.count_ne_source.symm + intro state inputHead workHeads outputHead hstate + cases state with + | inl phase => + cases phase with + | test => + by_cases hblank : workHeads tapes.count = Γ.blank <;> + simp [entryScanTM, hblank, TM.allReadBack] + | done => exact (hstate rfl).elim + | inr nested => + cases nested with + | inl state => + by_cases hhalt : state = (entryScanStepTM tapes.entry).qhalt + · by_cases hresult : workHeads tapes.entry.result = Γ.one <;> + simp [entryScanTM, hhalt, hresult, TM.allReadBack] + · simpa [entryScanTM, hhalt] using + hstep state inputHead workHeads outputHead hhalt + | inr state => + by_cases hhalt : state = (TM.binaryPredTM tapes.count).qhalt + · simp [entryScanTM, hhalt, TM.allReadBack] + · simpa [entryScanTM, hhalt] using + hcount state inputHead workHeads outputHead hhalt + +theorem entryUpdateTM_source_readOnly_internal + (tapes : EntryUpdateTapes n) : + (entryUpdateTM tapes).WorkReadOnly tapes.entry.source := by + have hmatching := entryMatchReadTM_source_readOnly tapes.entry + have hmiss := entryMissCopyTM_source_readOnly tapes.entry + have hdelete := entryMissCleanupTM_source_readOnly tapes.entry + have hreplace := entryReplaceCleanupTM_source_readOnly tapes.replace + have happend := entryAppendRestoreTM_source_readOnly tapes.replace + have hsourceRemaining : tapes.entry.source ≠ tapes.remaining := + tapes.ne (by decide) + have hsourceFound : tapes.entry.source ≠ tapes.found := + tapes.ne (by decide) + have hsourceResultCount : tapes.entry.source ≠ tapes.resultCount := + tapes.ne (by decide) + have hremaining := binaryPredTM_readOnly_of_ne tapes.remaining + tapes.entry.source hsourceRemaining + have hdeleteCount := binaryPredTM_readOnly_of_ne tapes.resultCount + tapes.entry.source hsourceResultCount + have happendCount := binarySuccTM_readOnly_of_ne tapes.resultCount + tapes.entry.source hsourceResultCount + intro state inputHead workHeads outputHead hstate + cases state with + | test => + by_cases hremainingBlank : workHeads tapes.remaining = Γ.blank + · by_cases hfoundOne : workHeads tapes.found = Γ.one + · simp [entryUpdateTM, hremainingBlank, hfoundOne, TM.allReadBack] + · by_cases hreplBlank : workHeads tapes.replacement = Γ.blank <;> + simp [entryUpdateTM, hremainingBlank, hfoundOne, hreplBlank, + TM.allReadBack] + · simp [entryUpdateTM, hremainingBlank, TM.allReadBack] + | matching state => + by_cases hhalt : state = (entryMatchReadTM tapes.entry).qhalt + · by_cases hresult : workHeads tapes.entry.result = Γ.one + · simp [entryUpdateTM, hhalt, hresult, hsourceFound] + · simp [entryUpdateTM, hhalt, hresult, TM.allReadBack] + · simpa [entryUpdateTM, hhalt] using + hmatching state inputHead workHeads outputHead hhalt + | miss state => + by_cases hhalt : state = (entryMissCopyTM tapes.entry).qhalt + · simp [entryUpdateTM, hhalt, TM.allReadBack] + · simpa [entryUpdateTM, hhalt] using + hmiss state inputHead workHeads outputHead hhalt + | delete state => + by_cases hhalt : state = (entryMissCleanupTM tapes.entry).qhalt + · simp [entryUpdateTM, hhalt, TM.allReadBack] + · simpa [entryUpdateTM, hhalt] using + hdelete state inputHead workHeads outputHead hhalt + | replace state => + by_cases hhalt : state = (entryReplaceCleanupTM tapes.replace).qhalt + · simp [entryUpdateTM, hhalt, TM.allReadBack] + · simpa [entryUpdateTM, hhalt] using + hreplace state inputHead workHeads outputHead hhalt + | append state => + by_cases hhalt : state = (entryAppendRestoreTM tapes.replace).qhalt + · simp [entryUpdateTM, hhalt, TM.allReadBack] + · simpa [entryUpdateTM, hhalt] using + happend state inputHead workHeads outputHead hhalt + | remaining state => + by_cases hhalt : state = (TM.binaryPredTM tapes.remaining).qhalt + · simp [entryUpdateTM, hhalt, TM.allReadBack] + · simpa [entryUpdateTM, hhalt] using + hremaining state inputHead workHeads outputHead hhalt + | deleteCount state => + by_cases hhalt : state = (TM.binaryPredTM tapes.resultCount).qhalt + · simp [entryUpdateTM, hhalt, TM.allReadBack] + · simpa [entryUpdateTM, hhalt] using + hdeleteCount state inputHead workHeads outputHead hhalt + | appendCount state => + by_cases hhalt : state = (TM.binarySuccTM tapes.resultCount).qhalt + · simp [entryUpdateTM, hhalt, TM.allReadBack] + · simpa [entryUpdateTM, hhalt] using + happendCount state inputHead workHeads outputHead hhalt + | done => exact (hstate rfl).elim + +end Machine + +end RegisterStore + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Tagged.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Tagged.lean new file mode 100644 index 0000000000..9426d6d5a2 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Tagged.lean @@ -0,0 +1,55 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.TaggedProof + +/-! +# Positive-tag sparse updates +-/ + + +public section + +namespace Complexity +namespace RAM +namespace RegisterStore +namespace Machine + +/-- Successor tagging followed by sparse update implements one dense-overlay +write and preserves the complete encoded-source frame. -/ +theorem taggedEntryUpdateTM_hoareTime_frame {n : ℕ} + (tapes : EntryUpdateTapes n) (overlay : Store) (address value : ℕ) + (emittedBits : List Bool) (initialWork : Fin n → Tape) + (inp₀ out₀ : Tape) (hcanonical : Canonical overlay) + (hready : EntryScanReady tapes.entry (overlay.flatMap Entry.encode) + address.bits initialWork initialWork) + (hreplacement : (initialWork tapes.replacement).HasBinaryNat value) + (hremaining : + (initialWork tapes.remaining).HasBinaryNat overlay.length) + (hfound : (initialWork tapes.found).HasBinaryNat 0) + (hresultCount : + (initialWork tapes.resultCount).HasBinaryNat overlay.length) + (hinput : TM.Parked inp₀) + (houtput : out₀.HasBinaryPrefix emittedBits) : + (taggedEntryUpdateTM tapes).HoareTime + (fun inp work out => inp = inp₀ ∧ work = initialWork ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + TaggedEntryUpdateResult tapes overlay address value initialWork work ∧ + out.HasBinaryPrefix + (emittedBits ++ + (DenseOverlay.write overlay address value).flatMap Entry.encode)) + (taggedEntryUpdateTime tapes overlay address value) := + taggedEntryUpdateTM_hoareTime_frame_internal tapes overlay address value + emittedBits initialWork inp₀ out₀ hcanonical hready hreplacement + hremaining hfound hresultCount hinput houtput + +end Machine +end RegisterStore +end RAM +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/TaggedDefs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/TaggedDefs.lean new file mode 100644 index 0000000000..a1a6403d2b --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/TaggedDefs.lean @@ -0,0 +1,52 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Defs + +/-! +# Positive-tag sparse updates + +Dense overlays encode an actual register value `v` by the positive sparse +value `v + 1`. This module packages successor followed by the existing sparse +update controller as one reusable write-side kernel. +-/ + + +@[expose] public section + +namespace Complexity +namespace RAM +namespace RegisterStore +namespace Machine + +/-- Convert an actual register value to its positive overlay tag, then update +the encoded sparse overlay. -/ +def taggedEntryUpdateTM {n : ℕ} (tapes : EntryUpdateTapes n) : TM n := + TM.seqTM (TM.binarySuccTM tapes.replacement) (entryUpdateTM tapes) + +/-- Exact compositional time budget for one positive-tag overlay write. -/ +def taggedEntryUpdateTime {n : ℕ} (tapes : EntryUpdateTapes n) + (overlay : Store) (address value : ℕ) : ℕ := + TM.binarySuccTime value + 1 + + entryUpdateTime tapes overlay address (value + 1) + +/-- Semantic boundary for successor tagging followed by sparse update. -/ +def TaggedEntryUpdateResult {n : ℕ} (tapes : EntryUpdateTapes n) + (overlay : Store) (address value : ℕ) + (initialWork finalWork : Fin n → Tape) : Prop := + ∃ taggedWork : Fin n → Tape, + (taggedWork tapes.replacement).HasBinaryNat (value + 1) ∧ + (∀ i, i ≠ tapes.replacement → taggedWork i = initialWork i) ∧ + EntryUpdateOutcome tapes overlay address (value + 1) taggedWork finalWork ∧ + (finalWork tapes.entry.source).cells = + (initialWork tapes.entry.source).cells + +end Machine +end RegisterStore +end RAM +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/TaggedProof.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/TaggedProof.lean new file mode 100644 index 0000000000..a50aae594c --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/TaggedProof.lean @@ -0,0 +1,199 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.TaggedDefs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.DenseOverlay.Defs + +/-! +# Positive-tag sparse updates -- proof internals +-/ + + +public section + +namespace Complexity +namespace RAM +namespace RegisterStore +namespace Machine + +variable {n : ℕ} + +private theorem hasBinaryPrefix_parked {t : Tape} {bits : List Bool} + (h : t.HasBinaryPrefix bits) : TM.Parked t := by + refine ⟨by rw [h.1]; omega, ?_⟩ + intro j hj + obtain ⟨i, rfl⟩ : ∃ i, j = i + 1 := ⟨j - 1, by omega⟩ + by_cases hi : i < bits.length + · rw [h.2.1 i hi] + exact Γ.ofBool_ne_start _ + · rw [h.2.2 i (Nat.le_of_not_gt hi)] + decide + +theorem taggedEntryUpdateTM_hoareTime_frame_internal + (tapes : EntryUpdateTapes n) (overlay : Store) (address value : ℕ) + (emittedBits : List Bool) (initialWork : Fin n → Tape) + (inp₀ out₀ : Tape) (hcanonical : Canonical overlay) + (hready : EntryScanReady tapes.entry (overlay.flatMap Entry.encode) + address.bits initialWork initialWork) + (hreplacement : (initialWork tapes.replacement).HasBinaryNat value) + (hremaining : + (initialWork tapes.remaining).HasBinaryNat overlay.length) + (hfound : (initialWork tapes.found).HasBinaryNat 0) + (hresultCount : + (initialWork tapes.resultCount).HasBinaryNat overlay.length) + (hinput : TM.Parked inp₀) + (houtput : out₀.HasBinaryPrefix emittedBits) : + (taggedEntryUpdateTM tapes).HoareTime + (fun inp work out => inp = inp₀ ∧ work = initialWork ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + TaggedEntryUpdateResult tapes overlay address value initialWork work ∧ + out.HasBinaryPrefix + (emittedBits ++ + (DenseOverlay.write overlay address value).flatMap Entry.encode)) + (taggedEntryUpdateTime tapes overlay address value) := by + have houtputParked := hasBinaryPrefix_parked houtput + have hsucc := TM.binarySuccTM_hoareTime_frame tapes.replacement value + inp₀ initialWork out₀ hreplacement hinput.read_ne_start + (fun i _ => (hready.parked i).read_ne_start) + houtputParked.read_ne_start + let taggedPost : TM.TapePred n := fun inp work out => + inp = inp₀ ∧ + (∀ i, i ≠ tapes.replacement → work i = initialWork i) ∧ + (work tapes.replacement).HasBinaryNat (value + 1) ∧ out = out₀ + let finalPost : TM.TapePred n := fun inp work out => + inp = inp₀ ∧ + TaggedEntryUpdateResult tapes overlay address value initialWork work ∧ + out.HasBinaryPrefix + (emittedBits ++ + (DenseOverlay.write overlay address value).flatMap Entry.encode) + have hupdate : (entryUpdateTM tapes).HoareTime taggedPost finalPost + (entryUpdateTime tapes overlay address (value + 1)) := by + rintro inp work out ⟨hinp, hother, htag, hout⟩ + have hslotEq (slot : Fin 13) (hne : slot ≠ 10) : + work (tapes.idx slot) = initialWork (tapes.idx slot) := + hother _ (tapes.ne hne) + have hready' : EntryScanReady tapes.entry + (overlay.flatMap Entry.encode) address.bits work work := by + refine + { source := ?_ + address := ?_ + addressStart := ?_ + value := ?_ + valueStart := ?_ + addressCounter := ?_ + addressWidth := ?_ + valueCounter := ?_ + valueWidth := ?_ + query := ?_ + queryStart := ?_ + result := ?_ + resultStart := ?_ + parked := ?_ + frame := by intro i _ _ _ _ _ _ _ _ _; rfl } + · change (work (tapes.idx 0)).HasBinarySuffix _ + rw [hslotEq 0 (by decide)] + exact hready.source + · change (work (tapes.idx 1)).HasBinaryPrefix [] + rw [hslotEq 1 (by decide)] + exact hready.address + · change (work (tapes.idx 1)).cells 0 = Γ.start + rw [hslotEq 1 (by decide)] + exact hready.addressStart + · change (work (tapes.idx 2)).HasBinaryPrefix [] + rw [hslotEq 2 (by decide)] + exact hready.value + · change (work (tapes.idx 2)).cells 0 = Γ.start + rw [hslotEq 2 (by decide)] + exact hready.valueStart + · change (work (tapes.idx 3)).HasBinaryNat 0 + rw [hslotEq 3 (by decide)] + exact hready.addressCounter + · change (work (tapes.idx 4)).HasBinaryNat 0 + rw [hslotEq 4 (by decide)] + exact hready.addressWidth + · change (work (tapes.idx 5)).HasBinaryNat 0 + rw [hslotEq 5 (by decide)] + exact hready.valueCounter + · change (work (tapes.idx 6)).HasBinaryNat 0 + rw [hslotEq 6 (by decide)] + exact hready.valueWidth + · change (work (tapes.idx 7)).HasBinaryString address.bits + rw [hslotEq 7 (by decide)] + exact hready.query + · change (work (tapes.idx 7)).cells 0 = Γ.start + rw [hslotEq 7 (by decide)] + exact hready.queryStart + · change (work (tapes.idx 8)).HasBinaryPrefix [] + rw [hslotEq 8 (by decide)] + exact hready.result + · change (work (tapes.idx 8)).cells 0 = Γ.start + rw [hslotEq 8 (by decide)] + exact hready.resultStart + · intro i + by_cases hi : i = tapes.replacement + · subst i + exact ⟨by rw [htag.2.1], + htag.2.hasBinaryContent.cells_ne_start⟩ + · rw [hother i hi] + exact hready.parked i + have hremaining' : (work tapes.remaining).HasBinaryNat overlay.length := by + change (work (tapes.idx 9)).HasBinaryNat _ + rw [hslotEq 9 (by decide)] + exact hremaining + have hfound' : (work tapes.found).HasBinaryNat 0 := by + change (work (tapes.idx 11)).HasBinaryNat 0 + rw [hslotEq 11 (by decide)] + exact hfound + have hresultCount' : + (work tapes.resultCount).HasBinaryNat overlay.length := by + change (work (tapes.idx 12)).HasBinaryNat _ + rw [hslotEq 12 (by decide)] + exact hresultCount + have hrun := entryUpdateTM_hoareTime_frame tapes overlay address + (value + 1) emittedBits work inp₀ out₀ hcanonical hready' htag + hremaining' hfound' hresultCount' hinput houtput + obtain ⟨final, time, htime, hreach, hhalt, hfinalInput, + houtcome, hfinalOutput, hsource⟩ := + hrun inp work out ⟨hinp, rfl, hout⟩ + have hsourceInitial : + work tapes.entry.source = initialWork tapes.entry.source := + hother _ (tapes.ne (by decide)) + exact ⟨final, time, htime, hreach, hhalt, hfinalInput, + ⟨work, htag, hother, houtcome, + hsource.trans (congrArg Tape.cells hsourceInitial)⟩, + by simpa only [DenseOverlay.write] using hfinalOutput⟩ + have htransition : ∀ inp work out, taggedPost inp work out → + taggedPost (TM.transitionInput inp) + (fun i => TM.transitionTape (work i)) (TM.transitionTape out) := by + rintro inp work out ⟨hinp, hother, htag, hout⟩ + have hworkParked : ∀ i, TM.Parked (work i) := by + intro i + by_cases hi : i = tapes.replacement + · subst i + exact ⟨by rw [htag.2.1], + htag.2.hasBinaryContent.cells_ne_start⟩ + · rw [hother i hi] + exact hready.parked i + obtain ⟨hi, hw, ho⟩ := TM.phaseTransition_eq_self_of_reads_ne_start + (inp := inp) (work := work) (out := out) + (by simpa [hinp] using hinput.read_ne_start) + (fun i => (hworkParked i).read_ne_start) + (by simpa [hout] using houtputParked.read_ne_start) + rw [hi, hw, ho] + exact ⟨hinp, hother, htag, hout⟩ + have hall := TM.seqTM_hoareTime (TM.binarySuccTM tapes.replacement) + (entryUpdateTM tapes) hsucc htransition hupdate + simpa [taggedEntryUpdateTM, taggedEntryUpdateTime, taggedPost, finalPost] + using hall + +end Machine +end RegisterStore +end RAM +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction.lean new file mode 100644 index 0000000000..b523fad979 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction.lean @@ -0,0 +1,557 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Defs +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Internal +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Direct +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Load +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Immediate +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Store +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Control + +/-! +# Concrete sparse-store arithmetic instruction kernel + +This surface exposes the first complete instruction-level composition in the +RAM-to-TM direction: two canonical operands are combined by a width-efficient +binary machine and the result is committed by the fixed encoded-store update +controller. A redirected form writes the new store to a fresh work buffer. +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace RegisterStore + +namespace Machine + +/-- Uniform framed contract for the selected arithmetic operation. -/ +theorem binaryInstructionArithmeticTM_hoareTime_frame {n : ℕ} + (tapes : BinaryInstructionTapes n) (op : BinaryInstrOp) (lhs rhs : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hlhs : (work₀ tapes.lhs).HasBinaryNat lhs) + (hrhs : (work₀ tapes.rhs).HasBinaryNat rhs) + (hresult : (work₀ tapes.update.replacement).HasBinaryNat 0) + (hshift : (work₀ tapes.shift).HasBinaryNat 0) + (htmp : (work₀ tapes.tmp).HasBinaryNat 0) + (hdbl : (work₀ tapes.dbl).HasBinaryNat 0) + (hinput : TM.Parked inp₀) (hwork : ∀ i, TM.Parked (work₀ i)) + (houtput : TM.Parked out₀) : + (binaryInstructionArithmeticTM tapes op).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + BinaryInstructionArithmeticResult tapes op lhs rhs work₀ work ∧ + out = out₀) + (binaryInstructionArithmeticTime op lhs rhs) := + binaryInstructionArithmeticTM_hoareTime_frame_internal tapes op lhs rhs + inp₀ work₀ out₀ hlhs hrhs hresult hshift htmp hdbl hinput hwork + houtput + +/-- Width-efficient arithmetic followed by a semantics-exact sparse write. -/ +theorem binaryInstructionUpdateTM_hoareTime_frame {n : ℕ} + (tapes : BinaryInstructionTapes n) (op : BinaryInstrOp) + (store : Store) (address lhs rhs : ℕ) + (emittedBits : List Bool) (initialWork : Fin n → Tape) + (inp₀ out₀ : Tape) + (hcanonical : Canonical store) + (hready : EntryScanReady tapes.update.entry + (store.flatMap Entry.encode) address.bits initialWork initialWork) + (hlhs : (initialWork tapes.lhs).HasBinaryNat lhs) + (hrhs : (initialWork tapes.rhs).HasBinaryNat rhs) + (hresult : (initialWork tapes.update.replacement).HasBinaryNat 0) + (hshift : (initialWork tapes.shift).HasBinaryNat 0) + (htmp : (initialWork tapes.tmp).HasBinaryNat 0) + (hdbl : (initialWork tapes.dbl).HasBinaryNat 0) + (hremaining : + (initialWork tapes.update.remaining).HasBinaryNat store.length) + (hfound : (initialWork tapes.update.found).HasBinaryNat 0) + (hresultCount : + (initialWork tapes.update.resultCount).HasBinaryNat store.length) + (hinput : TM.Parked inp₀) (hwork : ∀ i, TM.Parked (initialWork i)) + (houtput : out₀.HasBinaryPrefix emittedBits) : + (binaryInstructionUpdateTM tapes op).HoareTime + (fun inp work out => + inp = inp₀ ∧ work = initialWork ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + BinaryInstructionUpdateResult tapes op store address lhs rhs + initialWork work ∧ + out.HasBinaryPrefix + (emittedBits ++ + (RegisterStore.write store address (op.eval lhs rhs)).flatMap + Entry.encode)) + (binaryInstructionUpdateTime tapes op store address lhs rhs) := + binaryInstructionUpdateTM_hoareTime_frame_internal tapes op store address + lhs rhs emittedBits initialWork inp₀ out₀ hcanonical hready hlhs hrhs + hresult hshift htmp hdbl hremaining hfound hresultCount hinput hwork + houtput + +/-- Redirect the updated encoded store into a fresh last work tape while the +real output remains the standard blank parked tape. -/ +theorem binaryInstructionUpdateTM_retargetOutput_hoareTime_frame {n : ℕ} + (tapes : BinaryInstructionTapes n) (op : BinaryInstrOp) + (store : Store) (address lhs rhs : ℕ) + (emittedBits : List Bool) (initialWork : Fin (n + 1) → Tape) + (inp₀ : Tape) + (hcanonical : Canonical store) + (hready : EntryScanReady tapes.update.entry + (store.flatMap Entry.encode) address.bits + (fun i => initialWork (Fin.castSucc i)) + (fun i => initialWork (Fin.castSucc i))) + (hlhs : (initialWork (Fin.castSucc tapes.lhs)).HasBinaryNat lhs) + (hrhs : (initialWork (Fin.castSucc tapes.rhs)).HasBinaryNat rhs) + (hresult : + (initialWork (Fin.castSucc tapes.update.replacement)).HasBinaryNat 0) + (hshift : (initialWork (Fin.castSucc tapes.shift)).HasBinaryNat 0) + (htmp : (initialWork (Fin.castSucc tapes.tmp)).HasBinaryNat 0) + (hdbl : (initialWork (Fin.castSucc tapes.dbl)).HasBinaryNat 0) + (hremaining : + (initialWork (Fin.castSucc tapes.update.remaining)).HasBinaryNat + store.length) + (hfound : + (initialWork (Fin.castSucc tapes.update.found)).HasBinaryNat 0) + (hresultCount : + (initialWork (Fin.castSucc tapes.update.resultCount)).HasBinaryNat + store.length) + (hinput : TM.Parked inp₀) + (hwork : ∀ i : Fin n, TM.Parked (initialWork (Fin.castSucc i))) + (hbuffer : + (initialWork (Fin.last n)).HasBinaryPrefix emittedBits) : + (binaryInstructionUpdateTM tapes op).retargetOutput.HoareTime + (fun inp work out => + inp = inp₀ ∧ work = initialWork ∧ + out = (Tape.init []).move Dir3.right) + (fun inp work out => + inp = inp₀ ∧ + BinaryInstructionUpdateResult tapes op store address lhs rhs + (fun i => initialWork (Fin.castSucc i)) + (fun i => work (Fin.castSucc i)) ∧ + (work (Fin.last n)).HasBinaryPrefix + (emittedBits ++ + (RegisterStore.write store address (op.eval lhs rhs)).flatMap + Entry.encode) ∧ + out = (Tape.init []).move Dir3.right) + (binaryInstructionUpdateTime tapes op store address lhs rhs) := by + let baseWork : Fin n → Tape := fun i => initialWork (Fin.castSucc i) + let buffer := initialWork (Fin.last n) + have hbase := binaryInstructionUpdateTM_hoareTime_frame tapes op store + address lhs rhs emittedBits baseWork inp₀ buffer hcanonical hready hlhs + hrhs hresult hshift htmp hdbl hremaining hfound hresultCount hinput hwork + hbuffer + have hlift := TM.retargetOutput_hoareTime + (binaryInstructionUpdateTM tapes op) hbase + apply hlift.consequence + · rintro inp work out ⟨hinp, hworkEq, hout⟩ + subst inp + subst work + exact ⟨⟨rfl, rfl, rfl⟩, hout⟩ + · rintro inp work out ⟨⟨hinp, hresult, hbuffer'⟩, hout⟩ + exact ⟨hinp, hresult, hbuffer', hout⟩ + · exact le_rfl + +/-- Arithmetic and sparse update are both one-way-output machines. -/ +theorem binaryInstructionUpdateTM_isTransducer {n : ℕ} + (tapes : BinaryInstructionTapes n) (op : BinaryInstrOp) : + (binaryInstructionUpdateTM tapes op).IsTransducer := by + apply TM.IsTransducer.seqTM + · cases op with + | add => exact TM.binaryRippleAddTM_isTransducer _ _ _ + | sub => exact TM.binaryRippleSubTM_isTransducer _ _ _ + | mul => exact TM.binaryShiftMulTM_isTransducer _ + · exact entryUpdateTM_isTransducer tapes.update + +/-- Two direct sparse-register reads, arithmetic, and the destination write +realize one complete direct `add`, `sub`, or `mul` instruction. -/ +theorem directBinaryInstructionTM_hoareTime_frame {n : ℕ} + (tapes : BinaryInstructionTapes n) (op : BinaryInstrOp) + (store : Store) (destination source₀ source₁ : ℕ) + (emittedBits : List Bool) (initialWork : Fin n → Tape) + (inp₀ out₀ : Tape) + (hcanonical : Canonical store) + (hinitial : EntryLookupStaticReady tapes.lhsLookup store initialWork) + (hrhs₀ : (initialWork tapes.rhs).HasBinaryNat 0) + (hreplacement : (initialWork tapes.update.replacement).HasBinaryNat 0) + (htmp : (initialWork tapes.tmp).HasBinaryNat 0) + (hdbl : (initialWork tapes.dbl).HasBinaryNat 0) + (hinput : TM.Parked inp₀) + (houtput : out₀.HasBinaryPrefix emittedBits) : + (directBinaryInstructionTM tapes op destination source₀ source₁).HoareTime + (fun inp work out => inp = inp₀ ∧ work = initialWork ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + DirectBinaryInstructionResult tapes op store destination source₀ + source₁ initialWork work ∧ + out.HasBinaryPrefix + (emittedBits ++ + (RegisterStore.write store destination + (op.eval (RegisterStore.read store source₀) + (RegisterStore.read store source₁))).flatMap Entry.encode)) + (directBinaryInstructionTime tapes op store destination source₀ + source₁) := + directBinaryInstructionTM_hoareTime_frame_internal tapes op store + destination source₀ source₁ emittedBits initialWork inp₀ out₀ + hcanonical hinitial hrhs₀ hreplacement htmp hdbl hinput houtput + +/-- Direct arithmetic instruction simulation never moves the output head left. -/ +theorem directBinaryInstructionTM_isTransducer {n : ℕ} + (tapes : BinaryInstructionTapes n) (op : BinaryInstrOp) + (destination source₀ source₁ : ℕ) : + (directBinaryInstructionTM tapes op destination source₀ + source₁).IsTransducer := by + exact + (entryLookupStaticTM_isTransducer tapes.lhsLookup source₀).seqTM + ((entryLookupStaticTM_isTransducer tapes.rhsLookup source₁).seqTM + ((TM.binaryAddConstTM_isTransducer tapes.update.entry.query + destination).seqTM + (binaryInstructionUpdateTM_isTransducer tapes op))) + +/-- Every prefix of a direct arithmetic instruction respects the coarse +initial-space-plus-total-time auxiliary-space envelope. -/ +theorem directBinaryInstructionTM_prefix_withinAuxSpace {n : ℕ} + (tapes : BinaryInstructionTapes n) (op : BinaryInstrOp) + (store : Store) (destination source₀ source₁ : ℕ) + (inputLength initialSpace time : ℕ) + (start current : Complexity.Cfg n + (directBinaryInstructionTM tapes op destination source₀ source₁).Q) + (hinitial : start.WithinAuxSpace inputLength initialSpace) + (hreach : (directBinaryInstructionTM tapes op destination source₀ + source₁).reachesIn time start current) + (htime : time ≤ directBinaryInstructionTime tapes op store destination + source₀ source₁) : + current.WithinAuxSpace inputLength + (initialSpace + directBinaryInstructionTime tapes op store destination + source₀ source₁) := + (hinitial.reachesIn hreach).mono le_rfl (by omega) + +/-- A fixed-address lookup followed by a loaded runtime-address lookup and +sparse update realizes one indirect `load`. -/ +theorem indirectLoadInstructionTM_hoareTime_frame {n : ℕ} + (tapes : BinaryInstructionTapes n) (store : Store) + (destination addressRegister : ℕ) (emittedBits : List Bool) + (initialWork : Fin n → Tape) (inp₀ out₀ : Tape) + (hcanonical : Canonical store) + (hinitial : EntryLookupStaticReady tapes.lhsLookup store initialWork) + (hreplacement : (initialWork tapes.update.replacement).HasBinaryNat 0) + (hinput : TM.Parked inp₀) + (houtput : out₀.HasBinaryPrefix emittedBits) : + (indirectLoadInstructionTM tapes destination addressRegister).HoareTime + (fun inp work out => inp = inp₀ ∧ work = initialWork ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + IndirectLoadInstructionResult tapes store destination addressRegister + initialWork work ∧ + out.HasBinaryPrefix + (emittedBits ++ + (RegisterStore.write store destination + (RegisterStore.read store + (RegisterStore.read store addressRegister))).flatMap + Entry.encode)) + (indirectLoadInstructionTime tapes store destination addressRegister) := + indirectLoadInstructionTM_hoareTime_frame_internal tapes store destination + addressRegister emittedBits initialWork inp₀ out₀ hcanonical hinitial + hreplacement hinput houtput + +/-- Indirect-load simulation never moves the output head left. -/ +theorem indirectLoadInstructionTM_isTransducer {n : ℕ} + (tapes : BinaryInstructionTapes n) (destination addressRegister : ℕ) : + (indirectLoadInstructionTM tapes destination + addressRegister).IsTransducer := by + exact + (entryLookupStaticTM_isTransducer tapes.lhsLookup addressRegister).seqTM + ((entryLookupLoadedTM_isTransducer tapes.indirectLoadLookup).seqTM + ((TM.binaryAddConstTM_isTransducer tapes.update.entry.query + destination).seqTM + (entryUpdateTM_isTransducer tapes.update))) + +/-- Every indirect-load prefix respects the coarse +initial-space-plus-total-time auxiliary-space envelope. -/ +theorem indirectLoadInstructionTM_prefix_withinAuxSpace {n : ℕ} + (tapes : BinaryInstructionTapes n) (store : Store) + (destination addressRegister inputLength initialSpace time : ℕ) + (start current : Complexity.Cfg n + (indirectLoadInstructionTM tapes destination addressRegister).Q) + (hinitial : start.WithinAuxSpace inputLength initialSpace) + (hreach : (indirectLoadInstructionTM tapes destination + addressRegister).reachesIn time start current) + (htime : time ≤ indirectLoadInstructionTime tapes store destination + addressRegister) : + current.WithinAuxSpace inputLength + (initialSpace + indirectLoadInstructionTime tapes store destination + addressRegister) := + (hinitial.reachesIn hreach).mono le_rfl (by omega) + +/-- Immediate-value and destination synthesis followed by sparse update +realizes one `imm` instruction. -/ +theorem immediateInstructionTM_hoareTime_frame {n : ℕ} + (tapes : BinaryInstructionTapes n) (store : Store) + (destination value : ℕ) (emittedBits : List Bool) + (initialWork : Fin n → Tape) (inp₀ out₀ : Tape) + (hcanonical : Canonical store) + (hinitial : EntryLookupStaticReady tapes.lhsLookup store initialWork) + (hreplacement : (initialWork tapes.update.replacement).HasBinaryNat 0) + (hinput : TM.Parked inp₀) + (houtput : out₀.HasBinaryPrefix emittedBits) : + (immediateInstructionTM tapes destination value).HoareTime + (fun inp work out => inp = inp₀ ∧ work = initialWork ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + ImmediateInstructionResult tapes store destination value initialWork + work ∧ + out.HasBinaryPrefix + (emittedBits ++ + (RegisterStore.write store destination value).flatMap Entry.encode)) + (immediateInstructionTime tapes store destination value) := + immediateInstructionTM_hoareTime_frame_internal tapes store destination value + emittedBits initialWork inp₀ out₀ hcanonical hinitial hreplacement + hinput houtput + +/-- Immediate-instruction simulation never moves the output head left. -/ +theorem immediateInstructionTM_isTransducer {n : ℕ} + (tapes : BinaryInstructionTapes n) (destination value : ℕ) : + (immediateInstructionTM tapes destination value).IsTransducer := by + exact + (TM.binaryAddConstTM_isTransducer tapes.update.replacement value).seqTM + ((TM.binaryAddConstTM_isTransducer tapes.update.entry.query + destination).seqTM + (entryUpdateTM_isTransducer tapes.update)) + +/-- Every immediate-instruction prefix respects the coarse +initial-space-plus-total-time auxiliary-space envelope. -/ +theorem immediateInstructionTM_prefix_withinAuxSpace {n : ℕ} + (tapes : BinaryInstructionTapes n) (store : Store) + (destination value inputLength initialSpace time : ℕ) + (start current : Complexity.Cfg n + (immediateInstructionTM tapes destination value).Q) + (hinitial : start.WithinAuxSpace inputLength initialSpace) + (hreach : (immediateInstructionTM tapes destination value).reachesIn time + start current) + (htime : time ≤ immediateInstructionTime tapes store destination value) : + current.WithinAuxSpace inputLength + (initialSpace + immediateInstructionTime tapes store destination value) := + (hinitial.reachesIn hreach).mono le_rfl (by omega) + +/-- Two direct lookups followed by framed binary copies into the update ABI +realize one indirect `store`. -/ +theorem indirectStoreInstructionTM_hoareTime_frame {n : ℕ} + (tapes : BinaryInstructionTapes n) (store : Store) + (addressRegister source : ℕ) (emittedBits : List Bool) + (initialWork : Fin n → Tape) (inp₀ out₀ : Tape) + (hcanonical : Canonical store) + (hinitial : EntryLookupStaticReady tapes.lhsLookup store initialWork) + (hrhs₀ : (initialWork tapes.rhs).HasBinaryNat 0) + (hreplacement : (initialWork tapes.update.replacement).HasBinaryNat 0) + (hinput : TM.Parked inp₀) + (houtput : out₀.HasBinaryPrefix emittedBits) : + (indirectStoreInstructionTM tapes addressRegister source).HoareTime + (fun inp work out => inp = inp₀ ∧ work = initialWork ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + IndirectStoreInstructionResult tapes store addressRegister source + initialWork work ∧ + out.HasBinaryPrefix + (emittedBits ++ + (RegisterStore.write store + (RegisterStore.read store addressRegister) + (RegisterStore.read store source)).flatMap Entry.encode)) + (indirectStoreInstructionTime tapes store addressRegister source) := + indirectStoreInstructionTM_hoareTime_frame_internal tapes store + addressRegister source emittedBits initialWork inp₀ out₀ hcanonical + hinitial hrhs₀ hreplacement hinput houtput + +/-- Indirect-store simulation never moves the output head left. -/ +theorem indirectStoreInstructionTM_isTransducer {n : ℕ} + (tapes : BinaryInstructionTapes n) (addressRegister source : ℕ) : + (indirectStoreInstructionTM tapes addressRegister source).IsTransducer := by + exact + ((entryLookupStaticTM_isTransducer tapes.lhsLookup + addressRegister).seqTM + (entryLookupStaticTM_isTransducer tapes.rhsLookup source)).seqTM + ((TM.binaryCopyIntoTM_isTransducer tapes.lhs tapes.update.entry.query + tapes.update.found).seqTM + ((TM.binaryCopyIntoTM_isTransducer tapes.rhs tapes.update.replacement + tapes.update.found).seqTM + (entryUpdateTM_isTransducer tapes.update))) + +/-- Every indirect-store prefix respects the coarse +initial-space-plus-total-time auxiliary-space envelope. -/ +theorem indirectStoreInstructionTM_prefix_withinAuxSpace {n : ℕ} + (tapes : BinaryInstructionTapes n) (store : Store) + (addressRegister source inputLength initialSpace time : ℕ) + (start current : Complexity.Cfg n + (indirectStoreInstructionTM tapes addressRegister source).Q) + (hinitial : start.WithinAuxSpace inputLength initialSpace) + (hreach : (indirectStoreInstructionTM tapes addressRegister + source).reachesIn time start current) + (htime : time ≤ indirectStoreInstructionTime tapes store addressRegister + source) : + current.WithinAuxSpace inputLength + (initialSpace + indirectStoreInstructionTime tapes store addressRegister + source) := + (hinitial.reachesIn hreach).mono le_rfl (by omega) + +/-- Reset and replace a canonical binary program counter by a fixed literal. -/ +theorem setProgramCounterTM_hoareTime_frame {n : ℕ} + (pc : Fin n) (pcValue target : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hpc : (work₀ pc).HasBinaryNat pcValue) + (hinput : TM.Parked inp₀) (hwork : ∀ i, TM.Parked (work₀ i)) + (houtput : TM.Parked out₀) : + (setProgramCounterTM pc target).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + work = Function.update work₀ pc + ((Tape.init (target.bits.map Γ.ofBool)).move Dir3.right) ∧ + out = out₀) + (setProgramCounterTime pcValue target) := + setProgramCounterTM_hoareTime_frame_internal pc pcValue target inp₀ work₀ + out₀ hpc hinput hwork houtput + +/-- Conditional-zero control realizes sparse `jz` and restores its loaded +operand to the clean lookup ABI. -/ +theorem zeroJumpInstructionTM_hoareTime_frame {n : ℕ} + (tapes : ControlInstructionTapes n) (store : Store) + (pcValue source target : ℕ) (initialWork : Fin n → Tape) + (inp₀ out₀ : Tape) + (hready : ControlInstructionReady tapes store pcValue initialWork) + (hinput : TM.Parked inp₀) (houtput : TM.Parked out₀) : + (zeroJumpInstructionTM tapes source target).HoareTime + (fun inp work out => inp = inp₀ ∧ work = initialWork ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + ControlInstructionResult tapes store + (if RegisterStore.read store source = 0 then target + else pcValue + 1) + initialWork work ∧ + out = out₀) + (zeroJumpInstructionTime tapes store pcValue source target) := + zeroJumpInstructionTM_hoareTime_frame_internal tapes store pcValue source + target initialWork inp₀ out₀ hready hinput houtput + +/-- Unconditional control replaces the program counter by its jump target. -/ +theorem jumpInstructionTM_hoareTime_frame {n : ℕ} + (tapes : ControlInstructionTapes n) (store : Store) + (pcValue target : ℕ) (initialWork : Fin n → Tape) + (inp₀ out₀ : Tape) + (hready : ControlInstructionReady tapes store pcValue initialWork) + (hinput : TM.Parked inp₀) (houtput : TM.Parked out₀) : + (jumpInstructionTM tapes target).HoareTime + (fun inp work out => inp = inp₀ ∧ work = initialWork ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + ControlInstructionResult tapes store target initialWork work ∧ + out = out₀) + (jumpInstructionTime pcValue target) := + jumpInstructionTM_hoareTime_frame_internal tapes store pcValue target + initialWork inp₀ out₀ hready hinput houtput + +/-- Halt is an exact no-op at the clean control boundary. -/ +theorem haltInstructionTM_hoareTime_frame {n : ℕ} + (tapes : ControlInstructionTapes n) (store : Store) + (pcValue : ℕ) (initialWork : Fin n → Tape) + (inp₀ out₀ : Tape) + (hready : ControlInstructionReady tapes store pcValue initialWork) + (hinput : TM.Parked inp₀) (houtput : TM.Parked out₀) : + (haltInstructionTM (n := n)).HoareTime + (fun inp work out => inp = inp₀ ∧ work = initialWork ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + ControlInstructionResult tapes store pcValue initialWork work ∧ + out = out₀) + haltInstructionTime := + haltInstructionTM_hoareTime_frame_internal tapes store pcValue initialWork + inp₀ out₀ hready hinput houtput + +/-- Program-counter replacement never moves the output head left. -/ +theorem setProgramCounterTM_isTransducer {n : ℕ} (pc : Fin n) + (target : ℕ) : (setProgramCounterTM pc target).IsTransducer := + (TM.resetBinaryWorkTM_isTransducer pc).seqTM + (TM.binaryAddConstTM_isTransducer pc target) + +/-- Conditional-zero control never moves the output head left. -/ +theorem zeroJumpInstructionTM_isTransducer {n : ℕ} + (tapes : ControlInstructionTapes n) (source target : ℕ) : + (zeroJumpInstructionTM tapes source target).IsTransducer := by + exact + (entryLookupStaticTM_isTransducer tapes.data.lhsLookup source).seqTM + (((setProgramCounterTM_isTransducer tapes.pc target).branchWorkBlankTM + (TM.binarySuccTM_isTransducer tapes.pc)).seqTM + (TM.resetBinaryWorkTM_isTransducer tapes.data.lhs)) + +/-- Unconditional jump control never moves the output head left. -/ +theorem jumpInstructionTM_isTransducer {n : ℕ} + (tapes : ControlInstructionTapes n) (target : ℕ) : + (jumpInstructionTM tapes target).IsTransducer := + setProgramCounterTM_isTransducer tapes.pc target + +/-- Halt control never moves the output head left. -/ +theorem haltInstructionTM_isTransducer {n : ℕ} : + (haltInstructionTM (n := n)).IsTransducer := by + intro state iHead wHeads oHead + cases state <;> cases oHead <;> simp [haltInstructionTM, TM.skipTM, + TM.idleDir] + +/-- Every conditional-zero prefix respects the coarse +initial-space-plus-total-time auxiliary-space envelope. -/ +theorem zeroJumpInstructionTM_prefix_withinAuxSpace {n : ℕ} + (tapes : ControlInstructionTapes n) (store : Store) + (pcValue source target inputLength initialSpace time : ℕ) + (start current : Complexity.Cfg n + (zeroJumpInstructionTM tapes source target).Q) + (hinitial : start.WithinAuxSpace inputLength initialSpace) + (hreach : (zeroJumpInstructionTM tapes source target).reachesIn time start + current) + (htime : time ≤ + zeroJumpInstructionTime tapes store pcValue source target) : + current.WithinAuxSpace inputLength + (initialSpace + + zeroJumpInstructionTime tapes store pcValue source target) := + (hinitial.reachesIn hreach).mono le_rfl (by omega) + +/-- Every unconditional-jump prefix respects the coarse +initial-space-plus-total-time auxiliary-space envelope. -/ +theorem jumpInstructionTM_prefix_withinAuxSpace {n : ℕ} + (tapes : ControlInstructionTapes n) + (pcValue target inputLength initialSpace time : ℕ) + (start current : Complexity.Cfg n (jumpInstructionTM tapes target).Q) + (hinitial : start.WithinAuxSpace inputLength initialSpace) + (hreach : (jumpInstructionTM tapes target).reachesIn time start current) + (htime : time ≤ jumpInstructionTime pcValue target) : + current.WithinAuxSpace inputLength + (initialSpace + jumpInstructionTime pcValue target) := + (hinitial.reachesIn hreach).mono le_rfl (by omega) + +/-- Every halt prefix respects its one-step auxiliary-space envelope. -/ +theorem haltInstructionTM_prefix_withinAuxSpace {n : ℕ} + (inputLength initialSpace time : ℕ) + (start current : Complexity.Cfg n (haltInstructionTM (n := n)).Q) + (hinitial : start.WithinAuxSpace inputLength initialSpace) + (hreach : (haltInstructionTM (n := n)).reachesIn time start current) + (htime : time ≤ haltInstructionTime) : + current.WithinAuxSpace inputLength + (initialSpace + haltInstructionTime) := + (hinitial.reachesIn hreach).mono le_rfl (by omega) + +end Machine + +end RegisterStore + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Control.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Control.lean new file mode 100644 index 0000000000..035985aad6 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Control.lean @@ -0,0 +1,633 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Defs +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryLookupRestore + +/-! +# Sparse-store control instructions + +This proof layer realizes conditional-zero jump, unconditional jump, and halt +over the reusable sparse-lookup ABI and a disjoint canonical binary program- +counter tape. +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace RegisterStore + +namespace Machine + +variable {n : ℕ} + +private theorem hasBinaryNat_parked {t : Tape} {value : ℕ} + (h : t.HasBinaryNat value) : TM.Parked t := by + refine ⟨by rw [h.2.1], ?_⟩ + exact Tape.HasBinaryContent.cells_ne_start h.2.2 + +private theorem phaseTransition_of_parked + {inp out : Tape} {work : Fin n → Tape} + (hinput : TM.Parked inp) (hwork : ∀ i, TM.Parked (work i)) + (houtput : TM.Parked out) : + TM.transitionInput inp = inp ∧ + (fun i => TM.transitionTape (work i)) = work ∧ + TM.transitionTape out = out := + TM.phaseTransition_eq_self_of_reads_ne_start hinput.read_ne_start + (fun i => (hwork i).read_ne_start) houtput.read_ne_start + +private theorem controlReady_update_pc + (tapes : ControlInstructionTapes n) (store : Store) + (oldPC newPC : ℕ) (work : Fin n → Tape) (newTape : Tape) + (hready : ControlInstructionReady tapes store oldPC work) + (hnewTape : newTape.HasBinaryNat newPC) : + ControlInstructionReady tapes store newPC + (Function.update work tapes.pc newTape) := by + let finalWork := Function.update work tapes.pc newTape + have hsourceNe : tapes.data.lhsLookup.scan.entry.source ≠ tapes.pc := by + exact tapes.lookup_ne_pc 0 + have haddressNe : tapes.data.lhsLookup.scan.entry.address ≠ tapes.pc := by + exact tapes.lookup_ne_pc 1 + have hvalueNe : tapes.data.lhsLookup.scan.entry.value ≠ tapes.pc := by + exact tapes.lookup_ne_pc 2 + have haddressCounterNe : + tapes.data.lhsLookup.scan.entry.addressCounter ≠ tapes.pc := by + exact tapes.lookup_ne_pc 3 + have haddressWidthNe : + tapes.data.lhsLookup.scan.entry.addressWidth ≠ tapes.pc := by + exact tapes.lookup_ne_pc 4 + have hvalueCounterNe : + tapes.data.lhsLookup.scan.entry.valueCounter ≠ tapes.pc := by + exact tapes.lookup_ne_pc 5 + have hvalueWidthNe : + tapes.data.lhsLookup.scan.entry.valueWidth ≠ tapes.pc := by + exact tapes.lookup_ne_pc 6 + have hqueryNe : tapes.data.lhsLookup.scan.entry.query ≠ tapes.pc := by + exact tapes.lookup_ne_pc 7 + have hresultNe : tapes.data.lhsLookup.scan.entry.result ≠ tapes.pc := by + exact tapes.lookup_ne_pc 8 + have hcountNe : tapes.data.lhsLookup.scan.count ≠ tapes.pc := by + exact tapes.lookup_ne_pc 9 + have hcountSourceNe : tapes.data.lhsLookup.countSource ≠ tapes.pc := by + exact tapes.lookup_ne_pc 10 + have hquerySourceNe : tapes.data.lhsLookup.querySource ≠ tapes.pc := by + exact tapes.lookup_ne_pc 11 + have hdestinationNe : tapes.data.lhsLookup.destination ≠ tapes.pc := by + exact tapes.lookup_ne_pc 12 + have hcopyScratchNe : tapes.data.lhsLookup.copyScratch ≠ tapes.pc := by + exact tapes.lookup_ne_pc 13 + have hscanner : EntryScanReady tapes.data.lhsLookup.scan.entry + (store.flatMap Entry.encode) [] finalWork finalWork := by + refine + { source := ?_ + address := ?_ + addressStart := ?_ + value := ?_ + valueStart := ?_ + addressCounter := ?_ + addressWidth := ?_ + valueCounter := ?_ + valueWidth := ?_ + query := ?_ + queryStart := ?_ + result := ?_ + resultStart := ?_ + parked := ?_ + frame := by intro i _ _ _ _ _ _ _ _ _; rfl } + · simpa only [finalWork, Function.update_of_ne hsourceNe] using + hready.lookup.scanner.source + · simpa only [finalWork, Function.update_of_ne haddressNe] using + hready.lookup.scanner.address + · simpa only [finalWork, Function.update_of_ne haddressNe] using + hready.lookup.scanner.addressStart + · simpa only [finalWork, Function.update_of_ne hvalueNe] using + hready.lookup.scanner.value + · simpa only [finalWork, Function.update_of_ne hvalueNe] using + hready.lookup.scanner.valueStart + · simpa only [finalWork, Function.update_of_ne haddressCounterNe] using + hready.lookup.scanner.addressCounter + · simpa only [finalWork, Function.update_of_ne haddressWidthNe] using + hready.lookup.scanner.addressWidth + · simpa only [finalWork, Function.update_of_ne hvalueCounterNe] using + hready.lookup.scanner.valueCounter + · simpa only [finalWork, Function.update_of_ne hvalueWidthNe] using + hready.lookup.scanner.valueWidth + · simpa only [finalWork, Function.update_of_ne hqueryNe] using + hready.lookup.scanner.query + · simpa only [finalWork, Function.update_of_ne hqueryNe] using + hready.lookup.scanner.queryStart + · simpa only [finalWork, Function.update_of_ne hresultNe] using + hready.lookup.scanner.result + · simpa only [finalWork, Function.update_of_ne hresultNe] using + hready.lookup.scanner.resultStart + · intro i + by_cases hi : i = tapes.pc + · subst i + simpa only [finalWork, Function.update_self] using + hasBinaryNat_parked hnewTape + · simpa only [finalWork, Function.update_of_ne hi] using + hready.lookup.scanner.parked i + refine + { lookup := + { scanner := hscanner + sourceStart := ?_ + sourceHead := ?_ + count := ?_ + countSource := ?_ + querySource := ?_ + destination := ?_ + copyScratch := ?_ } + pc := ?_ } + · simpa only [finalWork, Function.update_of_ne hsourceNe] using + hready.lookup.sourceStart + · simpa only [finalWork, Function.update_of_ne hsourceNe] using + hready.lookup.sourceHead + · simpa only [finalWork, Function.update_of_ne hcountNe] using + hready.lookup.count + · simpa only [finalWork, Function.update_of_ne hcountSourceNe] using + hready.lookup.countSource + · simpa only [finalWork, Function.update_of_ne hquerySourceNe] using + hready.lookup.querySource + · simpa only [finalWork, Function.update_of_ne hdestinationNe] using + hready.lookup.destination + · simpa only [finalWork, Function.update_of_ne hcopyScratchNe] using + hready.lookup.copyScratch + · simpa only [finalWork, Function.update_self] using hnewTape + +private def ZeroJumpBranchResult + (tapes : ControlInstructionTapes n) (store : Store) + (source newPC : ℕ) (initialWork finalWork : Fin n → Tape) : + Prop := + ∃ lookupWork : Fin n → Tape, + EntryLookupStaticResult tapes.data.lhsLookup store source + initialWork lookupWork ∧ + (finalWork tapes.data.lhs).HasBinaryNat + (RegisterStore.read store source) ∧ + (finalWork tapes.pc).HasBinaryNat newPC ∧ + (∀ i, TM.Parked (finalWork i)) ∧ + ∀ i, i ≠ tapes.pc → finalWork i = lookupWork i + +private theorem controlResult_of_zeroJumpReset + (tapes : ControlInstructionTapes n) (store : Store) + (oldPC source newPC : ℕ) (initialWork branchWork : Fin n → Tape) + (hinitial : ControlInstructionReady tapes store oldPC initialWork) + (hbranch : ZeroJumpBranchResult tapes store source newPC + initialWork branchWork) : + ControlInstructionResult tapes store newPC initialWork + (Function.update branchWork tapes.data.lhs + ((Tape.init []).move Dir3.right)) := by + obtain ⟨lookupWork, hlookup, hoperand, hpc, hparked, hframe⟩ := hbranch + let finalWork := Function.update branchWork tapes.data.lhs + ((Tape.init []).move Dir3.right) + have hrole (slot : Fin 14) (hslot : slot ≠ 12) : + finalWork (tapes.data.lhsLookup.idx slot) = + lookupWork (tapes.data.lhsLookup.idx slot) := by + have hneLhs : tapes.data.lhsLookup.idx slot ≠ tapes.data.lhs := by + intro heq + apply hslot + apply tapes.data.lhsLookup.injective + exact heq + simp only [finalWork, Function.update_of_ne hneLhs] + exact hframe _ (tapes.lookup_ne_pc slot) + have hfinalParked : ∀ i, TM.Parked (finalWork i) := by + intro i + by_cases hi : i = tapes.data.lhs + · subst i + simp only [finalWork, Function.update_self] + exact hasBinaryNat_parked (Tape.init_move_right_hasBinaryNat 0) + · simpa only [finalWork, Function.update_of_ne hi] using hparked i + have hscanner : EntryScanReady tapes.data.lhsLookup.scan.entry + (store.flatMap Entry.encode) [] finalWork finalWork := by + refine + { source := ?_ + address := ?_ + addressStart := ?_ + value := ?_ + valueStart := ?_ + addressCounter := ?_ + addressWidth := ?_ + valueCounter := ?_ + valueWidth := ?_ + query := ?_ + queryStart := ?_ + result := ?_ + resultStart := ?_ + parked := hfinalParked + frame := by intro i _ _ _ _ _ _ _ _ _; rfl } + · change (finalWork (tapes.data.lhsLookup.idx 0)).HasBinarySuffix _ + rw [hrole 0 (by decide)] + exact hlookup.scanner.source + · change (finalWork (tapes.data.lhsLookup.idx 1)).HasBinaryPrefix [] + rw [hrole 1 (by decide)] + exact hlookup.scanner.address + · change (finalWork (tapes.data.lhsLookup.idx 1)).cells 0 = Γ.start + rw [hrole 1 (by decide)] + exact hlookup.scanner.addressStart + · change (finalWork (tapes.data.lhsLookup.idx 2)).HasBinaryPrefix [] + rw [hrole 2 (by decide)] + exact hlookup.scanner.value + · change (finalWork (tapes.data.lhsLookup.idx 2)).cells 0 = Γ.start + rw [hrole 2 (by decide)] + exact hlookup.scanner.valueStart + · change (finalWork (tapes.data.lhsLookup.idx 3)).HasBinaryNat 0 + rw [hrole 3 (by decide)] + exact hlookup.scanner.addressCounter + · change (finalWork (tapes.data.lhsLookup.idx 4)).HasBinaryNat 0 + rw [hrole 4 (by decide)] + exact hlookup.scanner.addressWidth + · change (finalWork (tapes.data.lhsLookup.idx 5)).HasBinaryNat 0 + rw [hrole 5 (by decide)] + exact hlookup.scanner.valueCounter + · change (finalWork (tapes.data.lhsLookup.idx 6)).HasBinaryNat 0 + rw [hrole 6 (by decide)] + exact hlookup.scanner.valueWidth + · change (finalWork (tapes.data.lhsLookup.idx 7)).HasBinaryString [] + rw [hrole 7 (by decide)] + exact hlookup.scanner.query + · change (finalWork (tapes.data.lhsLookup.idx 7)).cells 0 = Γ.start + rw [hrole 7 (by decide)] + exact hlookup.scanner.queryStart + · change (finalWork (tapes.data.lhsLookup.idx 8)).HasBinaryPrefix [] + rw [hrole 8 (by decide)] + exact hlookup.scanner.result + · change (finalWork (tapes.data.lhsLookup.idx 8)).cells 0 = Γ.start + rw [hrole 8 (by decide)] + exact hlookup.scanner.resultStart + have hfinalReady : ControlInstructionReady tapes store newPC finalWork := by + refine + { lookup := + { scanner := hscanner + sourceStart := ?_ + sourceHead := ?_ + count := ?_ + countSource := ?_ + querySource := ?_ + destination := ?_ + copyScratch := ?_ } + pc := ?_ } + · change (finalWork (tapes.data.lhsLookup.idx 0)).cells 0 = Γ.start + rw [hrole 0 (by decide)] + exact hlookup.sourceStart + · change (finalWork (tapes.data.lhsLookup.idx 0)).head = 1 + rw [hrole 0 (by decide)] + exact hlookup.sourceHead + · change (finalWork (tapes.data.lhsLookup.idx 9)).HasBinaryNat _ + rw [hrole 9 (by decide)] + exact hlookup.count + · change (finalWork (tapes.data.lhsLookup.idx 10)).HasBinaryNat _ + rw [hrole 10 (by decide)] + have hcountSource := hlookup.countSource + change lookupWork (tapes.data.lhsLookup.idx 10) = + initialWork (tapes.data.lhsLookup.idx 10) at hcountSource + rw [hcountSource] + exact hinitial.lookup.countSource + · change (finalWork (tapes.data.lhsLookup.idx 11)).HasBinaryNat 0 + rw [hrole 11 (by decide)] + exact hlookup.querySource + · change (finalWork tapes.data.lhs).HasBinaryNat 0 + simp only [finalWork, Function.update_self] + exact Tape.init_move_right_hasBinaryNat 0 + · change (finalWork (tapes.data.lhsLookup.idx 13)).HasBinaryNat 0 + rw [hrole 13 (by decide)] + exact hlookup.copyScratch + · simpa only [finalWork, + Function.update_of_ne tapes.pc_ne_lhs] using hpc + refine + { ready := hfinalReady + sourceCells := ?_ + frame := ?_ } + · change (finalWork (tapes.data.lhsLookup.idx 0)).cells = + (initialWork (tapes.data.lhsLookup.idx 0)).cells + rw [hrole 0 (by decide)] + exact hlookup.sourceCells + intro i hipc hdata + have hiLhs : i ≠ tapes.data.lhs := hdata 12 + simp only [Function.update_of_ne hiLhs] + rw [hframe i hipc] + exact hlookup.frame i hdata + +/-- Reset a canonical PC and load a fixed target, preserving the literal +external frame. -/ +theorem setProgramCounterTM_hoareTime_frame_internal + (pc : Fin n) (pcValue target : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hpc : (work₀ pc).HasBinaryNat pcValue) + (hinput : TM.Parked inp₀) (hwork : ∀ i, TM.Parked (work₀ i)) + (houtput : TM.Parked out₀) : + (setProgramCounterTM pc target).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + work = Function.update work₀ pc + ((Tape.init (target.bits.map Γ.ofBool)).move Dir3.right) ∧ + out = out₀) + (setProgramCounterTime pcValue target) := by + let midWork := Function.update work₀ pc + ((Tape.init []).move Dir3.right) + have hreset := TM.resetBinaryWorkTM_hoareTime_frame pc pcValue.bits 1 + inp₀ work₀ out₀ hpc.2.hasBinaryContent hpc.1 + ⟨by rw [hpc.2.1], by rw [hpc.2.1]⟩ hinput + (fun i _ => hwork i) houtput + have hreset' : (TM.resetBinaryWorkTM pc).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => inp = inp₀ ∧ work = midWork ∧ out = out₀) + (TM.resetBinaryWorkTime 1 pcValue.bits.length) := by + simpa only [midWork] using hreset + have hzero : (midWork pc).HasBinaryNat 0 := by + simp only [midWork, Function.update_self] + exact Tape.init_move_right_hasBinaryNat 0 + have hmidWork : ∀ i, TM.Parked (midWork i) := by + intro i + by_cases hi : i = pc + · subst i + exact hasBinaryNat_parked hzero + · simpa only [midWork, Function.update_of_ne hi] using hwork i + have hadd := TM.binaryAddConstTM_hoareTime_frame pc target 0 inp₀ + midWork out₀ hzero hinput (fun i _ => hmidWork i) houtput + have hseq := TM.seqTM_hoareTime (TM.resetBinaryWorkTM pc) + (TM.binaryAddConstTM pc target) hreset' + (by + rintro inp work out ⟨hinp, hworkEq, hout⟩ + obtain ⟨hi, hw, ho⟩ := phaseTransition_of_parked + (inp := inp) (work := work) (out := out) + (by simpa [hinp] using hinput) + (by simpa [hworkEq] using hmidWork) + (by simpa [hout] using houtput) + rw [hi, hw, ho] + exact ⟨hinp, hworkEq, hout⟩) + hadd + simpa only [setProgramCounterTM, setProgramCounterTime, midWork, + Function.update_idem, Nat.zero_add] using hseq + +/-- Unconditional jump replaces the PC and preserves the clean sparse-lookup +boundary. -/ +theorem jumpInstructionTM_hoareTime_frame_internal + (tapes : ControlInstructionTapes n) (store : Store) + (pcValue target : ℕ) (initialWork : Fin n → Tape) + (inp₀ out₀ : Tape) + (hready : ControlInstructionReady tapes store pcValue initialWork) + (hinput : TM.Parked inp₀) (houtput : TM.Parked out₀) : + (jumpInstructionTM tapes target).HoareTime + (fun inp work out => inp = inp₀ ∧ work = initialWork ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + ControlInstructionResult tapes store target initialWork work ∧ + out = out₀) + (jumpInstructionTime pcValue target) := by + have hset := setProgramCounterTM_hoareTime_frame_internal tapes.pc + pcValue target inp₀ initialWork out₀ hready.pc hinput + hready.lookup.scanner.parked houtput + apply hset.consequence + · exact fun _ _ _ h => h + · rintro inp work out ⟨hinp, hworkEq, hout⟩ + let targetTape := + (Tape.init (target.bits.map Γ.ofBool)).move Dir3.right + have htarget : targetTape.HasBinaryNat target := by + exact Tape.init_move_right_hasBinaryNat target + have hfinalReady := controlReady_update_pc tapes store pcValue target + initialWork targetTape hready htarget + refine ⟨hinp, ?_, hout⟩ + rw [hworkEq] + refine + { ready := hfinalReady + sourceCells := ?_ + frame := ?_ } + · exact congrArg Tape.cells + (Function.update_of_ne (tapes.lookup_ne_pc 0) targetTape initialWork) + · intro i hipc _ + simp only [Function.update_of_ne hipc] + · exact le_rfl + +/-- Conditional-zero lookup and PC update realize the sparse interpreter's +`jz` semantics and restore the lookup operand to zero. -/ +theorem zeroJumpInstructionTM_hoareTime_frame_internal + (tapes : ControlInstructionTapes n) (store : Store) + (pcValue source target : ℕ) (initialWork : Fin n → Tape) + (inp₀ out₀ : Tape) + (hready : ControlInstructionReady tapes store pcValue initialWork) + (hinput : TM.Parked inp₀) (houtput : TM.Parked out₀) : + (zeroJumpInstructionTM tapes source target).HoareTime + (fun inp work out => inp = inp₀ ∧ work = initialWork ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + ControlInstructionResult tapes store + (if RegisterStore.read store source = 0 then target + else pcValue + 1) + initialWork work ∧ + out = out₀) + (zeroJumpInstructionTime tapes store pcValue source target) := by + let value := RegisterStore.read store source + let newPC := if value = 0 then target else pcValue + 1 + let lookupPost : TM.TapePred n := fun inp work out => + inp = inp₀ ∧ + EntryLookupStaticResult tapes.data.lhsLookup store source + initialWork work ∧ + out = out₀ + let branchPost : TM.TapePred n := fun inp work out => + inp = inp₀ ∧ + ZeroJumpBranchResult tapes store source newPC + initialWork work ∧ + out = out₀ + have hlookup := entryLookupStaticTM_hoareTime_frame + tapes.data.lhsLookup store source initialWork inp₀ out₀ hready.lookup + hinput houtput + have hbranch : + (TM.branchWorkBlankTM tapes.data.lhs + (setProgramCounterTM tapes.pc target) + (TM.binarySuccTM tapes.pc)).HoareTime lookupPost branchPost + (TM.branchWorkBlankTime (setProgramCounterTime pcValue target) + (TM.binarySuccTime pcValue)) := by + let blankPre : TM.TapePred n := fun inp work out => + lookupPost inp work out ∧ value = 0 + let nonblankPre : TM.TapePred n := fun inp work out => + lookupPost inp work out ∧ value ≠ 0 + have hblank : (setProgramCounterTM tapes.pc target).HoareTime + blankPre branchPost (setProgramCounterTime pcValue target) := by + rintro inp work out ⟨⟨hinp, hlookupResult, hout⟩, hzero⟩ + have hpcWork : (work tapes.pc).HasBinaryNat pcValue := by + have hpcEq := hlookupResult.frame tapes.pc + (fun slot => (tapes.lookup_ne_pc slot).symm) + rw [hpcEq] + exact hready.pc + have hset := setProgramCounterTM_hoareTime_frame_internal tapes.pc + pcValue target inp work out hpcWork + (by simpa [hinp] using hinput) + hlookupResult.parked (by simpa [hout] using houtput) + obtain ⟨final, time, htime, hreach, hhalt, hfinalInput, + hfinalWork, hfinalOutput⟩ := + hset inp work out ⟨rfl, rfl, rfl⟩ + refine ⟨final, time, htime, hreach, hhalt, ?_, ?_, ?_⟩ + · exact hfinalInput.trans hinp + · rw [hfinalWork] + let targetTape := + (Tape.init (target.bits.map Γ.ofBool)).move Dir3.right + have htarget : targetTape.HasBinaryNat target := + Tape.init_move_right_hasBinaryNat target + refine ⟨work, hlookupResult, ?_, ?_, ?_, ?_⟩ + · have hoperand := hlookupResult.destination + change (work tapes.data.lhs).HasBinaryNat value at hoperand + simpa only [Function.update_of_ne tapes.lhs_ne_pc] using hoperand + · simpa only [targetTape, Function.update_self, newPC, value, + hzero, if_pos] using htarget + · intro i + by_cases hi : i = tapes.pc + · subst i + simpa only [targetTape, Function.update_self] using + hasBinaryNat_parked htarget + · simpa only [targetTape, Function.update_of_ne hi] using + hlookupResult.parked i + · intro i hi + simp only [Function.update_of_ne hi] + · exact hfinalOutput.trans hout + have hnonblank : (TM.binarySuccTM tapes.pc).HoareTime + nonblankPre branchPost (TM.binarySuccTime pcValue) := by + rintro inp work out ⟨⟨hinp, hlookupResult, hout⟩, hnonzero⟩ + have hpcWork : (work tapes.pc).HasBinaryNat pcValue := by + have hpcEq := hlookupResult.frame tapes.pc + (fun slot => (tapes.lookup_ne_pc slot).symm) + rw [hpcEq] + exact hready.pc + have hinpParked : TM.Parked inp := by simpa [hinp] using hinput + have houtParked : TM.Parked out := by simpa [hout] using houtput + have hsucc := TM.binarySuccTM_hoareTime_frame tapes.pc pcValue inp + work out hpcWork hinpParked.read_ne_start + (fun i _ => (hlookupResult.parked i).read_ne_start) + houtParked.read_ne_start + obtain ⟨final, time, htime, hreach, hhalt, hfinalInput, + hframe, hfinalPC, hfinalOutput⟩ := + hsucc inp work out ⟨rfl, rfl, rfl⟩ + refine ⟨final, time, htime, hreach, hhalt, ?_, ?_, ?_⟩ + · exact hfinalInput.trans hinp + · refine ⟨work, hlookupResult, ?_, ?_, ?_, hframe⟩ + · rw [hframe tapes.data.lhs tapes.lhs_ne_pc] + change (work tapes.data.lhs).HasBinaryNat value + exact hlookupResult.destination + · simpa only [newPC, value, if_neg hnonzero] using hfinalPC + · intro i + by_cases hi : i = tapes.pc + · subst i + exact hasBinaryNat_parked hfinalPC + · rw [hframe i hi] + exact hlookupResult.parked i + · exact hfinalOutput.trans hout + have hdispatch := TM.branchWorkBlankTM_hoareTime tapes.data.lhs + (setProgramCounterTM tapes.pc target) (TM.binarySuccTM tapes.pc) + (pre := lookupPost) (blankPre := blankPre) + (nonblankPre := nonblankPre) (blankPost := branchPost) + (nonblankPost := branchPost) + (fun inp work out hpre => by + have hinpParked : TM.Parked inp := by simpa [hpre.1] using hinput + have houtParked : TM.Parked out := by simpa [hpre.2.2] using houtput + exact ⟨hinpParked.read_ne_start, + fun i => (hpre.2.1.parked i).read_ne_start, + houtParked.read_ne_start⟩) + (fun _ work _ hpre hread => + ⟨hpre, + hpre.2.1.destination.read_eq_blank_iff.mp hread⟩) + (fun _ work _ hpre hread => + ⟨hpre, fun hzero => + hread (hpre.2.1.destination.read_eq_blank_iff.mpr hzero)⟩) + hblank hnonblank + exact hdispatch.consequence (fun _ _ _ h => h) + (fun _ _ _ h => h.elim id id) le_rfl + have hreset : (TM.resetBinaryWorkTM tapes.data.lhs).HoareTime + branchPost + (fun inp work out => + inp = inp₀ ∧ + ControlInstructionResult tapes store newPC initialWork work ∧ + out = out₀) + (TM.resetBinaryWorkTime 1 value.bits.length) := by + rintro inp work out ⟨hinp, hbranchResult, hout⟩ + obtain ⟨lookupWork, hlookupResult, hoperand, hpcResult, + hparked, hframe⟩ := hbranchResult + have hinpParked : TM.Parked inp := by simpa [hinp] using hinput + have hrun := TM.resetBinaryWorkTM_hoareTime_frame tapes.data.lhs + value.bits 1 inp work out hoperand.2.hasBinaryContent + hoperand.1 + ⟨by rw [hoperand.2.1], by rw [hoperand.2.1]⟩ + hinpParked (fun i _ => hparked i) + (by simpa [hout] using houtput) + obtain ⟨final, time, htime, hreach, hhalt, hfinalInput, + hfinalWork, hfinalOutput⟩ := hrun inp work out ⟨rfl, rfl, rfl⟩ + refine ⟨final, time, htime, hreach, hhalt, ?_, ?_, ?_⟩ + · exact hfinalInput.trans hinp + · rw [hfinalWork] + exact controlResult_of_zeroJumpReset tapes store pcValue source newPC + initialWork work hready + ⟨lookupWork, hlookupResult, hoperand, hpcResult, hparked, hframe⟩ + · exact hfinalOutput.trans hout + have hbranchReset := TM.seqTM_hoareTime + (TM.branchWorkBlankTM tapes.data.lhs + (setProgramCounterTM tapes.pc target) (TM.binarySuccTM tapes.pc)) + (TM.resetBinaryWorkTM tapes.data.lhs) hbranch + (by + rintro inp work out ⟨hinp, hbranchResult, hout⟩ + obtain ⟨lookupWork, hlookupResult, hoperand, hpcResult, + hparked, hframe⟩ := hbranchResult + obtain ⟨hi, hw, ho⟩ := phaseTransition_of_parked + (inp := inp) (work := work) (out := out) + (by simpa [hinp] using hinput) hparked + (by simpa [hout] using houtput) + rw [hi, hw, ho] + exact ⟨hinp, + ⟨lookupWork, hlookupResult, hoperand, hpcResult, hparked, hframe⟩, + hout⟩) + hreset + have hall := TM.seqTM_hoareTime + (entryLookupStaticTM tapes.data.lhsLookup source) + (TM.seqTM + (TM.branchWorkBlankTM tapes.data.lhs + (setProgramCounterTM tapes.pc target) (TM.binarySuccTM tapes.pc)) + (TM.resetBinaryWorkTM tapes.data.lhs)) hlookup + (by + rintro inp work out ⟨hinp, hlookupResult, hout⟩ + obtain ⟨hi, hw, ho⟩ := phaseTransition_of_parked + (inp := inp) (work := work) (out := out) + (by simpa [hinp] using hinput) hlookupResult.parked + (by simpa [hout] using houtput) + rw [hi, hw, ho] + exact ⟨hinp, hlookupResult, hout⟩) + hbranchReset + simpa only [zeroJumpInstructionTM, zeroJumpInstructionTime, value, newPC] + using hall + +/-- Halt is an exact one-step no-op at the clean control boundary. -/ +theorem haltInstructionTM_hoareTime_frame_internal + (tapes : ControlInstructionTapes n) (store : Store) + (pcValue : ℕ) (initialWork : Fin n → Tape) + (inp₀ out₀ : Tape) + (hready : ControlInstructionReady tapes store pcValue initialWork) + (hinput : TM.Parked inp₀) (houtput : TM.Parked out₀) : + (haltInstructionTM (n := n)).HoareTime + (fun inp work out => inp = inp₀ ∧ work = initialWork ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + ControlInstructionResult tapes store pcValue initialWork work ∧ + out = out₀) + haltInstructionTime := by + have hskip := TM.skipTM_hoareTime_frame inp₀ initialWork out₀ hinput + hready.lookup.scanner.parked houtput + apply hskip.consequence + · exact fun _ _ _ h => h + · rintro inp work out ⟨hinp, hworkEq, hout⟩ + subst work + exact ⟨hinp, ⟨hready, rfl, by intros; rfl⟩, hout⟩ + · exact le_rfl + +end Machine + +end RegisterStore + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Defs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Defs.lean new file mode 100644 index 0000000000..7c4bb11bdd --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Defs.lean @@ -0,0 +1,732 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleSub.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryShiftMul.Defs + +/-! +# Concrete sparse-store arithmetic instruction kernel + +This layer joins the width-efficient arithmetic machines to encoded sparse +update. The destination address and two looked-up operands are supplied on +canonical work tapes; the arithmetic result is written directly to the update +controller's replacement tape, so no value-sized bridge is hidden between the +two phases. +-/ + + +@[expose] public section + +namespace Complexity + +namespace RAM + +namespace RegisterStore + +namespace Machine + +/-- The three arithmetic operations shared by RAM register instructions. -/ +inductive BinaryInstrOp where + | add + | sub + | mul + deriving DecidableEq + +/-- Eighteen pairwise-distinct tapes used by arithmetic followed by sparse +update. Slots `0..12` are the update controller, slots `13` and `14` are the +operands, and slots `15..17` are multiplication scratch. -/ +structure BinaryInstructionTapes (n : ℕ) where + /-- Complete injective physical assignment. -/ + idx : Fin 18 → Fin n + /-- No two semantic roles alias. -/ + injective : Function.Injective idx + +namespace BinaryInstructionTapes + +/-- The thirteen-tape sparse-update view. -/ +def update {n : ℕ} (tapes : BinaryInstructionTapes n) : EntryUpdateTapes n where + idx := fun i => tapes.idx ⟨i, by omega⟩ + injective := by + intro i j h + apply Fin.ext + simpa using congrArg Fin.val (tapes.injective h) + +/-- First looked-up arithmetic operand. -/ +def lhs {n : ℕ} (tapes : BinaryInstructionTapes n) : Fin n := tapes.idx 13 + +/-- Second looked-up arithmetic operand. -/ +def rhs {n : ℕ} (tapes : BinaryInstructionTapes n) : Fin n := tapes.idx 14 + +/-- Multiplication's shifted-multiplicand scratch tape. -/ +def shift {n : ℕ} (tapes : BinaryInstructionTapes n) : Fin n := tapes.idx 15 + +/-- Multiplication's first alternating scratch tape. -/ +def tmp {n : ℕ} (tapes : BinaryInstructionTapes n) : Fin n := tapes.idx 16 + +/-- Multiplication's second alternating scratch tape. -/ +def dbl {n : ℕ} (tapes : BinaryInstructionTapes n) : Fin n := tapes.idx 17 + +/-- Parent-slot inequality gives physical tape inequality. -/ +theorem ne {n : ℕ} (tapes : BinaryInstructionTapes n) + {i j : Fin 18} (hne : i ≠ j) : tapes.idx i ≠ tapes.idx j := + fun heq => hne (tapes.injective heq) + +theorem update_ne_lhs {n : ℕ} (tapes : BinaryInstructionTapes n) + (slot : Fin 13) : tapes.update.idx slot ≠ tapes.lhs := by + apply tapes.ne + intro h + have hval := congrArg Fin.val h + change slot.val = 13 at hval + omega + +theorem update_ne_rhs {n : ℕ} (tapes : BinaryInstructionTapes n) + (slot : Fin 13) : tapes.update.idx slot ≠ tapes.rhs := by + apply tapes.ne + intro h + have hval := congrArg Fin.val h + change slot.val = 14 at hval + omega + +theorem update_ne_shift {n : ℕ} (tapes : BinaryInstructionTapes n) + (slot : Fin 13) : tapes.update.idx slot ≠ tapes.shift := by + apply tapes.ne + intro h + have hval := congrArg Fin.val h + change slot.val = 15 at hval + omega + +theorem update_ne_tmp {n : ℕ} (tapes : BinaryInstructionTapes n) + (slot : Fin 13) : tapes.update.idx slot ≠ tapes.tmp := by + apply tapes.ne + intro h + have hval := congrArg Fin.val h + change slot.val = 16 at hval + omega + +theorem update_ne_dbl {n : ℕ} (tapes : BinaryInstructionTapes n) + (slot : Fin 13) : tapes.update.idx slot ≠ tapes.dbl := by + apply tapes.ne + intro h + have hval := congrArg Fin.val h + change slot.val = 17 at hval + omega + +/-- Parent slots for a reusable lookup whose destination is `lhs`. -/ +def lhsLookupSlot (i : Fin 14) : Fin 18 := + match i.val with + | 0 => 0 + | 1 => 1 + | 2 => 2 + | 3 => 3 + | 4 => 4 + | 5 => 5 + | 6 => 6 + | 7 => 7 + | 8 => 8 + | 9 => 9 + | 10 => 12 + | 11 => 15 + | 12 => 13 + | _ => 11 + +private theorem lhsLookupSlot_injective : Function.Injective lhsLookupSlot := by + intro i j h + fin_cases i <;> fin_cases j <;> simp [lhsLookupSlot] at h ⊢ + +/-- Reusable sparse lookup view targeting the first operand. -/ +def lhsLookup {n : ℕ} (tapes : BinaryInstructionTapes n) : + EntryLookupRestoreTapes n where + idx := fun i => tapes.idx (lhsLookupSlot i) + injective := fun _ _ h => by + exact lhsLookupSlot_injective (tapes.injective h) + +/-- Parent slots for a reusable lookup whose destination is `rhs`. -/ +def rhsLookupSlot (i : Fin 14) : Fin 18 := + match i.val with + | 0 => 0 + | 1 => 1 + | 2 => 2 + | 3 => 3 + | 4 => 4 + | 5 => 5 + | 6 => 6 + | 7 => 7 + | 8 => 8 + | 9 => 9 + | 10 => 12 + | 11 => 15 + | 12 => 14 + | _ => 11 + +private theorem rhsLookupSlot_injective : Function.Injective rhsLookupSlot := by + intro i j h + fin_cases i <;> fin_cases j <;> simp [rhsLookupSlot] at h ⊢ + +/-- Reusable sparse lookup view targeting the second operand. -/ +def rhsLookup {n : ℕ} (tapes : BinaryInstructionTapes n) : + EntryLookupRestoreTapes n where + idx := fun i => tapes.idx (rhsLookupSlot i) + injective := fun _ _ h => by + exact rhsLookupSlot_injective (tapes.injective h) + +@[simp] theorem lhsLookup_count {n : ℕ} (tapes : BinaryInstructionTapes n) : + tapes.lhsLookup.idx 9 = tapes.update.remaining := rfl + +@[simp] theorem rhsLookup_count {n : ℕ} (tapes : BinaryInstructionTapes n) : + tapes.rhsLookup.idx 9 = tapes.update.remaining := rfl + +@[simp] theorem lhsLookup_countSource {n : ℕ} + (tapes : BinaryInstructionTapes n) : + tapes.lhsLookup.countSource = tapes.update.resultCount := rfl + +@[simp] theorem rhsLookup_countSource {n : ℕ} + (tapes : BinaryInstructionTapes n) : + tapes.rhsLookup.countSource = tapes.update.resultCount := rfl + +@[simp] theorem lhsLookup_querySource {n : ℕ} + (tapes : BinaryInstructionTapes n) : + tapes.lhsLookup.querySource = tapes.shift := rfl + +@[simp] theorem rhsLookup_querySource {n : ℕ} + (tapes : BinaryInstructionTapes n) : + tapes.rhsLookup.querySource = tapes.shift := rfl + +@[simp] theorem lhsLookup_destination {n : ℕ} + (tapes : BinaryInstructionTapes n) : + tapes.lhsLookup.destination = tapes.lhs := rfl + +@[simp] theorem rhsLookup_destination {n : ℕ} + (tapes : BinaryInstructionTapes n) : + tapes.rhsLookup.destination = tapes.rhs := rfl + +@[simp] theorem lhsLookup_copyScratch {n : ℕ} + (tapes : BinaryInstructionTapes n) : + tapes.lhsLookup.copyScratch = tapes.update.found := rfl + +@[simp] theorem rhsLookup_copyScratch {n : ℕ} + (tapes : BinaryInstructionTapes n) : + tapes.rhsLookup.copyScratch = tapes.update.found := rfl + +theorem lhsLookup_ne_rhs {n : ℕ} (tapes : BinaryInstructionTapes n) + (slot : Fin 14) : tapes.lhsLookup.idx slot ≠ tapes.rhs := by + apply tapes.ne + fin_cases slot <;> decide + +theorem rhsLookup_ne_lhs {n : ℕ} (tapes : BinaryInstructionTapes n) + (slot : Fin 14) : tapes.rhsLookup.idx slot ≠ tapes.lhs := by + apply tapes.ne + fin_cases slot <;> decide + +theorem lhsLookup_ne_tmp {n : ℕ} (tapes : BinaryInstructionTapes n) + (slot : Fin 14) : tapes.lhsLookup.idx slot ≠ tapes.tmp := by + apply tapes.ne + fin_cases slot <;> decide + +theorem rhsLookup_ne_tmp {n : ℕ} (tapes : BinaryInstructionTapes n) + (slot : Fin 14) : tapes.rhsLookup.idx slot ≠ tapes.tmp := by + apply tapes.ne + fin_cases slot <;> decide + +theorem lhsLookup_ne_dbl {n : ℕ} (tapes : BinaryInstructionTapes n) + (slot : Fin 14) : tapes.lhsLookup.idx slot ≠ tapes.dbl := by + apply tapes.ne + fin_cases slot <;> decide + +theorem rhsLookup_ne_dbl {n : ℕ} (tapes : BinaryInstructionTapes n) + (slot : Fin 14) : tapes.rhsLookup.idx slot ≠ tapes.dbl := by + apply tapes.ne + fin_cases slot <;> decide + +theorem lhsLookup_ne_replacement {n : ℕ} + (tapes : BinaryInstructionTapes n) (slot : Fin 14) : + tapes.lhsLookup.idx slot ≠ tapes.update.replacement := by + apply tapes.ne + fin_cases slot <;> decide + +theorem rhsLookup_ne_replacement {n : ℕ} + (tapes : BinaryInstructionTapes n) (slot : Fin 14) : + tapes.rhsLookup.idx slot ≠ tapes.update.replacement := by + apply tapes.ne + fin_cases slot <;> decide + +/-- Parent slots for a loaded indirect read. The first operand supplies the +runtime address and the update replacement tape receives the loaded value. -/ +def indirectLoadLookupSlot (i : Fin 14) : Fin 18 := + match i.val with + | 0 => 0 + | 1 => 1 + | 2 => 2 + | 3 => 3 + | 4 => 4 + | 5 => 5 + | 6 => 6 + | 7 => 7 + | 8 => 8 + | 9 => 9 + | 10 => 12 + | 11 => 13 + | 12 => 10 + | _ => 11 + +private theorem indirectLoadLookupSlot_injective : + Function.Injective indirectLoadLookupSlot := by + intro i j h + fin_cases i <;> fin_cases j <;> simp [indirectLoadLookupSlot] at h ⊢ + +/-- Reusable loaded lookup view for indirect `load`. -/ +def indirectLoadLookup {n : ℕ} (tapes : BinaryInstructionTapes n) : + EntryLookupRestoreTapes n where + idx := fun i => tapes.idx (indirectLoadLookupSlot i) + injective := fun _ _ h => by + exact indirectLoadLookupSlot_injective (tapes.injective h) + +@[simp] theorem indirectLoadLookup_count {n : ℕ} + (tapes : BinaryInstructionTapes n) : + tapes.indirectLoadLookup.idx 9 = tapes.update.remaining := rfl + +@[simp] theorem indirectLoadLookup_countSource {n : ℕ} + (tapes : BinaryInstructionTapes n) : + tapes.indirectLoadLookup.countSource = tapes.update.resultCount := rfl + +@[simp] theorem indirectLoadLookup_querySource {n : ℕ} + (tapes : BinaryInstructionTapes n) : + tapes.indirectLoadLookup.querySource = tapes.lhs := rfl + +@[simp] theorem indirectLoadLookup_destination {n : ℕ} + (tapes : BinaryInstructionTapes n) : + tapes.indirectLoadLookup.destination = tapes.update.replacement := rfl + +@[simp] theorem indirectLoadLookup_copyScratch {n : ℕ} + (tapes : BinaryInstructionTapes n) : + tapes.indirectLoadLookup.copyScratch = tapes.update.found := rfl + +/-- Multiplication-role parent slots. The accumulator deliberately aliases the +update replacement slot `10`. -/ +def mulSlot (i : Fin 6) : Fin 18 := + match i.val with + | 0 => 13 + | 1 => 14 + | 2 => 10 + | 3 => 15 + | 4 => 16 + | _ => 17 + +private theorem mulSlot_injective : Function.Injective mulSlot := by + intro i j hij + fin_cases i <;> fin_cases j <;> simp [mulSlot] at hij ⊢ + +/-- Six-tape multiplication view, with its accumulator on update replacement. -/ +def mul {n : ℕ} (tapes : BinaryInstructionTapes n) : TM.BinaryShiftMulABI n where + tape := + ⟨fun i => tapes.idx (mulSlot i), fun _ _ h => + by exact mulSlot_injective (tapes.injective h)⟩ + +@[simp] theorem mul_lhs {n : ℕ} (tapes : BinaryInstructionTapes n) : + tapes.mul.lhs = tapes.lhs := rfl + +@[simp] theorem mul_rhs {n : ℕ} (tapes : BinaryInstructionTapes n) : + tapes.mul.rhs = tapes.rhs := rfl + +@[simp] theorem mul_acc {n : ℕ} (tapes : BinaryInstructionTapes n) : + tapes.mul.acc = tapes.update.replacement := rfl + +@[simp] theorem mul_shift {n : ℕ} (tapes : BinaryInstructionTapes n) : + tapes.mul.shift = tapes.shift := rfl + +@[simp] theorem mul_tmp {n : ℕ} (tapes : BinaryInstructionTapes n) : + tapes.mul.tmp = tapes.tmp := rfl + +@[simp] theorem mul_dbl {n : ℕ} (tapes : BinaryInstructionTapes n) : + tapes.mul.dbl = tapes.dbl := rfl + +/-- The addition/subtraction operands and result are pairwise distinct. -/ +theorem arithmeticDistinct {n : ℕ} (tapes : BinaryInstructionTapes n) : + TM.BinaryRippleAddDistinct tapes.lhs tapes.rhs + tapes.update.replacement := by + exact ⟨tapes.ne (by decide), tapes.ne (by decide), + tapes.ne (by decide)⟩ + +/-- The same physical inequalities as a subtraction certificate. -/ +theorem subtractionDistinct {n : ℕ} (tapes : BinaryInstructionTapes n) : + TM.BinaryRippleSubDistinct tapes.lhs tapes.rhs + tapes.update.replacement := by + exact ⟨tapes.ne (by decide), tapes.ne (by decide), + tapes.ne (by decide)⟩ + +end BinaryInstructionTapes + +/-- The arithmetic/store ABI together with one disjoint canonical program- +counter tape. Nineteen work tapes suffice for every RAM instruction. -/ +structure ControlInstructionTapes (n : ℕ) where + /-- The complete data-instruction assignment. -/ + data : BinaryInstructionTapes n + /-- Canonical binary program counter. -/ + pc : Fin n + /-- The program counter aliases no data-instruction role. -/ + pc_ne : ∀ slot, pc ≠ data.idx slot + +namespace ControlInstructionTapes + +/-- Every data-instruction role is distinct from the program counter. -/ +theorem data_ne_pc {n : ℕ} (tapes : ControlInstructionTapes n) + (slot : Fin 18) : tapes.data.idx slot ≠ tapes.pc := + (tapes.pc_ne slot).symm + +/-- The first loaded operand is distinct from the program counter. -/ +theorem lhs_ne_pc {n : ℕ} (tapes : ControlInstructionTapes n) : + tapes.data.lhs ≠ tapes.pc := tapes.data_ne_pc 13 + +/-- The program counter is distinct from the first loaded operand. -/ +theorem pc_ne_lhs {n : ℕ} (tapes : ControlInstructionTapes n) : + tapes.pc ≠ tapes.data.lhs := tapes.pc_ne 13 + +/-- No tape owned by the first lookup aliases the program counter. -/ +theorem lookup_ne_pc {n : ℕ} (tapes : ControlInstructionTapes n) + (slot : Fin 14) : tapes.data.lhsLookup.idx slot ≠ tapes.pc := by + exact tapes.data_ne_pc (BinaryInstructionTapes.lhsLookupSlot slot) + +end ControlInstructionTapes + +/-- Pure result of the selected arithmetic operation. -/ +def BinaryInstrOp.eval : BinaryInstrOp → ℕ → ℕ → ℕ + | .add, lhs, rhs => lhs + rhs + | .sub, lhs, rhs => lhs - rhs + | .mul, lhs, rhs => lhs * rhs + +/-- Concrete arithmetic phase selected in finite control. -/ +def binaryInstructionArithmeticTM {n : ℕ} + (tapes : BinaryInstructionTapes n) : BinaryInstrOp → TM n + | .add => TM.binaryRippleAddTM tapes.lhs tapes.rhs tapes.update.replacement + | .sub => TM.binaryRippleSubTM tapes.lhs tapes.rhs tapes.update.replacement + | .mul => TM.binaryShiftMulTM tapes.mul + +/-- Uniform endpoint of the selected arithmetic phase. -/ +structure BinaryInstructionArithmeticResult {n : ℕ} + (tapes : BinaryInstructionTapes n) (op : BinaryInstrOp) + (lhs rhs : ℕ) (initialWork finalWork : Fin n → Tape) : Prop where + /-- First operand is restored canonically. -/ + lhsValue : (finalWork tapes.lhs).HasBinaryNat lhs + /-- Second operand is restored canonically. -/ + rhsValue : (finalWork tapes.rhs).HasBinaryNat rhs + /-- The update replacement tape contains the selected result. -/ + result : (finalWork tapes.update.replacement).HasBinaryNat (op.eval lhs rhs) + /-- Multiplication scratch is reset. -/ + shift : (finalWork tapes.shift).HasBinaryNat 0 + /-- First alternating scratch is reset. -/ + tmp : (finalWork tapes.tmp).HasBinaryNat 0 + /-- Second alternating scratch is reset. -/ + dbl : (finalWork tapes.dbl).HasBinaryNat 0 + /-- Every work head is parked at the phase boundary. -/ + parked : ∀ i, TM.Parked (finalWork i) + /-- Tapes outside the six arithmetic roles are literally preserved. -/ + frame : ∀ i, i ≠ tapes.lhs → i ≠ tapes.rhs → + i ≠ tapes.update.replacement → i ≠ tapes.shift → + i ≠ tapes.tmp → i ≠ tapes.dbl → + finalWork i = initialWork i + +/-- Uniform endpoint of arithmetic followed by encoded sparse update. -/ +def BinaryInstructionUpdateResult {n : ℕ} + (tapes : BinaryInstructionTapes n) (op : BinaryInstrOp) + (store : Store) (address lhs rhs : ℕ) + (initialWork finalWork : Fin n → Tape) : Prop := + ∃ arithmeticWork : Fin n → Tape, + BinaryInstructionArithmeticResult tapes op lhs rhs + initialWork arithmeticWork ∧ + EntryUpdateOutcome tapes.update store address (op.eval lhs rhs) + arithmeticWork finalWork ∧ + (finalWork tapes.update.entry.source).cells = + (initialWork tapes.update.entry.source).cells + +/-- Arithmetic followed immediately by the fixed sparse update controller. -/ +def binaryInstructionUpdateTM {n : ℕ} + (tapes : BinaryInstructionTapes n) (op : BinaryInstrOp) : TM n := + TM.seqTM (binaryInstructionArithmeticTM tapes op) + (entryUpdateTM tapes.update) + +/-- Load two direct register operands, prepare the direct destination address, +then run arithmetic and sparse update. -/ +def directBinaryInstructionTM {n : ℕ} + (tapes : BinaryInstructionTapes n) (op : BinaryInstrOp) + (destination source₀ source₁ : ℕ) : TM n := + TM.seqTM (entryLookupStaticTM tapes.lhsLookup source₀) + (TM.seqTM (entryLookupStaticTM tapes.rhsLookup source₁) + (TM.seqTM (TM.binaryAddConstTM tapes.update.entry.query destination) + (binaryInstructionUpdateTM tapes op))) + +/-- Load an address register, perform the loaded indirect read into the update +replacement tape, synthesize the direct destination, and update the store. -/ +def indirectLoadInstructionTM {n : ℕ} + (tapes : BinaryInstructionTapes n) (destination addressRegister : ℕ) : + TM n := + TM.seqTM (entryLookupStaticTM tapes.lhsLookup addressRegister) + (TM.seqTM (entryLookupLoadedTM tapes.indirectLoadLookup) + (TM.seqTM (TM.binaryAddConstTM tapes.update.entry.query destination) + (entryUpdateTM tapes.update))) + +/-- Synthesize an immediate value and direct destination, then update the +sparse store. -/ +def immediateInstructionTM {n : ℕ} + (tapes : BinaryInstructionTapes n) (destination value : ℕ) : TM n := + TM.seqTM (TM.binaryAddConstTM tapes.update.replacement value) + (TM.seqTM (TM.binaryAddConstTM tapes.update.entry.query destination) + (entryUpdateTM tapes.update)) + +/-- Load the indirect destination and direct source, copy both into the update +ABI, and update the sparse store. -/ +def indirectStoreInstructionTM {n : ℕ} + (tapes : BinaryInstructionTapes n) + (addressRegister source : ℕ) : TM n := + TM.seqTM + (TM.seqTM (entryLookupStaticTM tapes.lhsLookup addressRegister) + (entryLookupStaticTM tapes.rhsLookup source)) + (TM.seqTM + (TM.binaryCopyIntoTM tapes.lhs tapes.update.entry.query + tapes.update.found) + (TM.seqTM + (TM.binaryCopyIntoTM tapes.rhs tapes.update.replacement + tapes.update.found) + (entryUpdateTM tapes.update))) + +/-- Replace the canonical binary program counter by a fixed literal. -/ +def setProgramCounterTM {n : ℕ} (pc : Fin n) (target : ℕ) : TM n := + TM.seqTM (TM.resetBinaryWorkTM pc) (TM.binaryAddConstTM pc target) + +/-- Conditional-zero control instruction. The fixed sparse read is cleared +after branching so the reusable lookup ABI is restored at the endpoint. -/ +def zeroJumpInstructionTM {n : ℕ} (tapes : ControlInstructionTapes n) + (source target : ℕ) : TM n := + TM.seqTM (entryLookupStaticTM tapes.data.lhsLookup source) + (TM.seqTM + (TM.branchWorkBlankTM tapes.data.lhs + (setProgramCounterTM tapes.pc target) + (TM.binarySuccTM tapes.pc)) + (TM.resetBinaryWorkTM tapes.data.lhs)) + +/-- Unconditional jump control instruction. -/ +def jumpInstructionTM {n : ℕ} (tapes : ControlInstructionTapes n) + (target : ℕ) : TM n := + setProgramCounterTM tapes.pc target + +/-- Halt is represented by a one-step exact no-op instruction kernel. The +outer run controller detects halt before beginning another iteration. -/ +def haltInstructionTM {n : ℕ} : TM n := TM.skipTM + +/-- Canonical entry boundary for a control instruction. -/ +structure ControlInstructionReady {n : ℕ} + (tapes : ControlInstructionTapes n) (store : Store) (pcValue : ℕ) + (work : Fin n → Tape) : Prop where + /-- The fixed sparse-lookup ABI is ready. -/ + lookup : EntryLookupStaticReady tapes.data.lhsLookup store work + /-- The program counter contains the represented value. -/ + pc : (work tapes.pc).HasBinaryNat pcValue + +/-- Semantic endpoint shared by the three control-only instruction forms. -/ +structure ControlInstructionResult {n : ℕ} + (tapes : ControlInstructionTapes n) (store : Store) (pcValue : ℕ) + (initialWork finalWork : Fin n → Tape) : Prop where + /-- The clean control ABI is restored with the new program counter. -/ + ready : ControlInstructionReady tapes store pcValue finalWork + /-- The encoded source cells are read-only. -/ + sourceCells : (finalWork tapes.data.update.entry.source).cells = + (initialWork tapes.data.update.entry.source).cells + /-- Every tape outside the lookup ABI and PC assignment is preserved. -/ + frame : ∀ i, i ≠ tapes.pc → + (∀ slot, i ≠ tapes.data.lhsLookup.idx slot) → + finalWork i = initialWork i + +/-- Runtime for replacing a canonical program counter by a literal. -/ +def setProgramCounterTime (pcValue target : ℕ) : ℕ := + TM.resetBinaryWorkTime 1 pcValue.bits.length + 1 + + TM.binaryAddConstTime target 0 + +/-- Runtime for conditional-zero control, including lookup and operand reset. -/ +def zeroJumpInstructionTime {n : ℕ} (tapes : ControlInstructionTapes n) + (store : Store) (pcValue source target : ℕ) : ℕ := + entryLookupStaticTime tapes.data.lhsLookup store source + 1 + + (TM.branchWorkBlankTime (setProgramCounterTime pcValue target) + (TM.binarySuccTime pcValue) + 1 + + TM.resetBinaryWorkTime 1 + (RegisterStore.read store source).bits.length) + +/-- Runtime for an unconditional jump. -/ +def jumpInstructionTime (pcValue target : ℕ) : ℕ := + setProgramCounterTime pcValue target + +/-- Runtime for the exact halt no-op. -/ +def haltInstructionTime : ℕ := 1 + +/-- Boundary after the two direct source-register lookups. -/ +def DirectBinaryOperandsResult {n : ℕ} + (tapes : BinaryInstructionTapes n) (store : Store) + (source₀ source₁ : ℕ) (initialWork finalWork : Fin n → Tape) : + Prop := + ∃ lhsWork, + EntryLookupStaticResult tapes.lhsLookup store source₀ + initialWork lhsWork ∧ + EntryLookupStaticResult tapes.rhsLookup store source₁ + lhsWork finalWork + +/-- Boundary after the direct destination literal has been synthesized on the +update query tape. -/ +def DirectBinaryAddressResult {n : ℕ} + (tapes : BinaryInstructionTapes n) (store : Store) + (destination source₀ source₁ : ℕ) + (initialWork finalWork : Fin n → Tape) : Prop := + ∃ operandsWork, + DirectBinaryOperandsResult tapes store source₀ source₁ + initialWork operandsWork ∧ + finalWork = Function.update operandsWork tapes.update.entry.query + ((Tape.init (destination.bits.map Γ.ofBool)).move Dir3.right) + +/-- Exact update-controller ABI established by the lookup and address-loading +prefix of a direct arithmetic instruction. -/ +structure DirectBinaryUpdateReady {n : ℕ} + (tapes : BinaryInstructionTapes n) (store : Store) + (destination source₀ source₁ : ℕ) (work : Fin n → Tape) : Prop where + scanner : EntryScanReady tapes.update.entry (store.flatMap Entry.encode) + destination.bits work work + lhs : (work tapes.lhs).HasBinaryNat (RegisterStore.read store source₀) + rhs : (work tapes.rhs).HasBinaryNat (RegisterStore.read store source₁) + replacement : (work tapes.update.replacement).HasBinaryNat 0 + shift : (work tapes.shift).HasBinaryNat 0 + tmp : (work tapes.tmp).HasBinaryNat 0 + dbl : (work tapes.dbl).HasBinaryNat 0 + remaining : (work tapes.update.remaining).HasBinaryNat store.length + found : (work tapes.update.found).HasBinaryNat 0 + resultCount : (work tapes.update.resultCount).HasBinaryNat store.length + parked : ∀ i, TM.Parked (work i) + +/-- Semantic endpoint of a complete direct arithmetic instruction. -/ +def DirectBinaryInstructionResult {n : ℕ} + (tapes : BinaryInstructionTapes n) (op : BinaryInstrOp) + (store : Store) (destination source₀ source₁ : ℕ) + (initialWork finalWork : Fin n → Tape) : Prop := + ∃ updateWork, + DirectBinaryAddressResult tapes store destination source₀ source₁ + initialWork updateWork ∧ + BinaryInstructionUpdateResult tapes op store destination + (RegisterStore.read store source₀) + (RegisterStore.read store source₁) updateWork finalWork + +/-- Semantic endpoint of a complete indirect load. -/ +def IndirectLoadInstructionResult {n : ℕ} + (tapes : BinaryInstructionTapes n) (store : Store) + (destination addressRegister : ℕ) + (initialWork finalWork : Fin n → Tape) : Prop := + ∃ addressWork loadedWork updateWork, + EntryLookupStaticResult tapes.lhsLookup store addressRegister + initialWork addressWork ∧ + EntryLookupRestoreResult tapes.indirectLoadLookup store + (RegisterStore.read store addressRegister) addressWork loadedWork ∧ + updateWork = Function.update loadedWork tapes.update.entry.query + ((Tape.init (destination.bits.map Γ.ofBool)).move Dir3.right) ∧ + EntryUpdateOutcome tapes.update store destination + (RegisterStore.read store (RegisterStore.read store addressRegister)) + updateWork finalWork ∧ + (finalWork tapes.update.entry.source).cells = + (initialWork tapes.update.entry.source).cells + +/-- Semantic endpoint of one immediate assignment. -/ +def ImmediateInstructionResult {n : ℕ} + (tapes : BinaryInstructionTapes n) (store : Store) + (destination value : ℕ) (initialWork finalWork : Fin n → Tape) : Prop := + ∃ valueWork updateWork, + valueWork = Function.update initialWork tapes.update.replacement + ((Tape.init (value.bits.map Γ.ofBool)).move Dir3.right) ∧ + updateWork = Function.update valueWork tapes.update.entry.query + ((Tape.init (destination.bits.map Γ.ofBool)).move Dir3.right) ∧ + EntryUpdateOutcome tapes.update store destination value updateWork finalWork ∧ + (finalWork tapes.update.entry.source).cells = + (initialWork tapes.update.entry.source).cells + +/-- Semantic endpoint of one indirect store. -/ +def IndirectStoreInstructionResult {n : ℕ} + (tapes : BinaryInstructionTapes n) (store : Store) + (addressRegister source : ℕ) + (initialWork finalWork : Fin n → Tape) : Prop := + ∃ operandsWork queryWork updateWork, + DirectBinaryOperandsResult tapes store addressRegister source initialWork + operandsWork ∧ + queryWork = Function.update operandsWork tapes.update.entry.query + ((Tape.init ((RegisterStore.read store addressRegister).bits.map + Γ.ofBool)).move Dir3.right) ∧ + updateWork = Function.update queryWork tapes.update.replacement + ((Tape.init ((RegisterStore.read store source).bits.map Γ.ofBool)).move + Dir3.right) ∧ + EntryUpdateOutcome tapes.update store + (RegisterStore.read store addressRegister) + (RegisterStore.read store source) updateWork finalWork ∧ + (finalWork tapes.update.entry.source).cells = + (initialWork tapes.update.entry.source).cells + +/-- Operation-specific arithmetic budget. -/ +def binaryInstructionArithmeticTime (op : BinaryInstrOp) (lhs rhs : ℕ) : ℕ := + match op with + | .add => TM.binaryRippleAddTime lhs rhs + | .sub => TM.binaryRippleSubTime lhs rhs + | .mul => TM.binaryShiftMulTime lhs rhs + +/-- Complete arithmetic-plus-update budget, including the composition seam. -/ +def binaryInstructionUpdateTime {n : ℕ} + (tapes : BinaryInstructionTapes n) (op : BinaryInstrOp) + (store : Store) (address lhs rhs : ℕ) : ℕ := + binaryInstructionArithmeticTime op lhs rhs + 1 + + entryUpdateTime tapes.update store address (op.eval lhs rhs) + +/-- Complete direct arithmetic-instruction budget. -/ +def directBinaryInstructionTime {n : ℕ} + (tapes : BinaryInstructionTapes n) (op : BinaryInstrOp) + (store : Store) (destination source₀ source₁ : ℕ) : ℕ := + entryLookupStaticTime tapes.lhsLookup store source₀ + 1 + + (entryLookupStaticTime tapes.rhsLookup store source₁ + 1 + + (TM.binaryAddConstTime destination 0 + 1 + + binaryInstructionUpdateTime tapes op store destination + (RegisterStore.read store source₀) + (RegisterStore.read store source₁))) + +/-- Complete indirect-load instruction budget. -/ +def indirectLoadInstructionTime {n : ℕ} + (tapes : BinaryInstructionTapes n) (store : Store) + (destination addressRegister : ℕ) : ℕ := + entryLookupStaticTime tapes.lhsLookup store addressRegister + 1 + + (entryLookupLoadedTime tapes.indirectLoadLookup store + (RegisterStore.read store addressRegister) + 1 + + (TM.binaryAddConstTime destination 0 + 1 + + entryUpdateTime tapes.update store destination + (RegisterStore.read store + (RegisterStore.read store addressRegister)))) + +/-- Complete immediate-assignment instruction budget. -/ +def immediateInstructionTime {n : ℕ} + (tapes : BinaryInstructionTapes n) (store : Store) + (destination value : ℕ) : ℕ := + TM.binaryAddConstTime value 0 + 1 + + (TM.binaryAddConstTime destination 0 + 1 + + entryUpdateTime tapes.update store destination value) + +/-- Complete indirect-store instruction budget. -/ +def indirectStoreInstructionTime {n : ℕ} + (tapes : BinaryInstructionTapes n) (store : Store) + (addressRegister source : ℕ) : ℕ := + (entryLookupStaticTime tapes.lhsLookup store addressRegister + 1 + + entryLookupStaticTime tapes.rhsLookup store source) + 1 + + (TM.binaryCopyTime (RegisterStore.read store addressRegister) 0 + 1 + + (TM.binaryCopyTime (RegisterStore.read store source) 0 + 1 + + entryUpdateTime tapes.update store + (RegisterStore.read store addressRegister) + (RegisterStore.read store source))) + +end Machine + +end RegisterStore + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Dense.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Dense.lean new file mode 100644 index 0000000000..2da1c473b2 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Dense.lean @@ -0,0 +1,20 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import Mathlib.Data.Finset.Attr +public import Mathlib.Data.Rat.Cast.Order +public import Mathlib.Tactic.NormNum.Abs +public import Mathlib.Tactic.NormNum.DivMod +public import Mathlib.Tactic.NormNum.OfScientific +public import Mathlib.Tactic.NormNum.Pow + +/-! +# Dense-overlay RAM instruction kernels + +This module collects the concrete positive-tag instruction simulators and +their exact Hoare/time contracts. +-/ diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseControl.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseControl.lean new file mode 100644 index 0000000000..ee592a585d --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseControl.lean @@ -0,0 +1,377 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.DenseDefs +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Control + +/-! +# Dense-overlay control instructions +-/ + + +public section + +namespace Complexity +namespace RAM +namespace RegisterStore +namespace Machine + +variable {n : ℕ} + +private theorem hasBinaryNat_parked {t : Tape} {value : ℕ} + (h : t.HasBinaryNat value) : TM.Parked t := + ⟨by rw [h.2.1], h.2.hasBinaryContent.cells_ne_start⟩ + +private theorem phaseTransition_of_parked + {inp out : Tape} {work : Fin n → Tape} + (hinput : TM.Parked inp) (hwork : ∀ i, TM.Parked (work i)) + (houtput : TM.Parked out) : + TM.transitionInput inp = inp ∧ + (fun i => TM.transitionTape (work i)) = work ∧ + TM.transitionTape out = out := + TM.phaseTransition_eq_self_of_reads_ne_start hinput.read_ne_start + (fun i => (hwork i).read_ne_start) houtput.read_ne_start + +private def DenseZeroJumpBranchResult + (tapes : ControlInstructionTapes n) (input : List Bool) + (overlay : Store) (source newPC : ℕ) + (initialWork finalWork : Fin n → Tape) : Prop := + ∃ lookupWork : Fin n → Tape, + DenseOverlayLookupStaticResult tapes.data.lhsLookup input overlay source + initialWork lookupWork ∧ + (finalWork tapes.data.lhs).HasBinaryNat + (DenseOverlay.read input overlay source) ∧ + (finalWork tapes.pc).HasBinaryNat newPC ∧ + (∀ i, TM.Parked (finalWork i)) ∧ + ∀ i, i ≠ tapes.pc → finalWork i = lookupWork i + +private theorem denseControlResult_of_zeroJumpReset + (tapes : ControlInstructionTapes n) (input : List Bool) + (overlay : Store) (oldPC source newPC : ℕ) + (initialWork branchWork : Fin n → Tape) + (hinitial : ControlInstructionReady tapes overlay oldPC initialWork) + (hbranch : DenseZeroJumpBranchResult tapes input overlay source newPC + initialWork branchWork) : + ControlInstructionResult tapes overlay newPC initialWork + (Function.update branchWork tapes.data.lhs + ((Tape.init []).move Dir3.right)) := by + obtain ⟨lookupWork, hlookup, hoperand, hpc, hparked, hframe⟩ := hbranch + let finalWork := Function.update branchWork tapes.data.lhs + ((Tape.init []).move Dir3.right) + have hrole (slot : Fin 14) (hslot : slot ≠ 12) : + finalWork (tapes.data.lhsLookup.idx slot) = + lookupWork (tapes.data.lhsLookup.idx slot) := by + have hneLhs : tapes.data.lhsLookup.idx slot ≠ tapes.data.lhs := by + intro heq + apply hslot + apply tapes.data.lhsLookup.injective + exact heq + simp only [finalWork, Function.update_of_ne hneLhs] + exact hframe _ (tapes.lookup_ne_pc slot) + have hfinalParked : ∀ i, TM.Parked (finalWork i) := by + intro i + by_cases hi : i = tapes.data.lhs + · subst i + simp only [finalWork, Function.update_self] + exact hasBinaryNat_parked (Tape.init_move_right_hasBinaryNat 0) + · simpa only [finalWork, Function.update_of_ne hi] using hparked i + have hscanner : EntryScanReady tapes.data.lhsLookup.scan.entry + (overlay.flatMap Entry.encode) [] finalWork finalWork := by + refine + { source := ?_ + address := ?_ + addressStart := ?_ + value := ?_ + valueStart := ?_ + addressCounter := ?_ + addressWidth := ?_ + valueCounter := ?_ + valueWidth := ?_ + query := ?_ + queryStart := ?_ + result := ?_ + resultStart := ?_ + parked := hfinalParked + frame := by intro i _ _ _ _ _ _ _ _ _; rfl } + · change (finalWork (tapes.data.lhsLookup.idx 0)).HasBinarySuffix _ + rw [hrole 0 (by decide)] + exact hlookup.scanner.source + · change (finalWork (tapes.data.lhsLookup.idx 1)).HasBinaryPrefix [] + rw [hrole 1 (by decide)] + exact hlookup.scanner.address + · change (finalWork (tapes.data.lhsLookup.idx 1)).cells 0 = Γ.start + rw [hrole 1 (by decide)] + exact hlookup.scanner.addressStart + · change (finalWork (tapes.data.lhsLookup.idx 2)).HasBinaryPrefix [] + rw [hrole 2 (by decide)] + exact hlookup.scanner.value + · change (finalWork (tapes.data.lhsLookup.idx 2)).cells 0 = Γ.start + rw [hrole 2 (by decide)] + exact hlookup.scanner.valueStart + · change (finalWork (tapes.data.lhsLookup.idx 3)).HasBinaryNat 0 + rw [hrole 3 (by decide)] + exact hlookup.scanner.addressCounter + · change (finalWork (tapes.data.lhsLookup.idx 4)).HasBinaryNat 0 + rw [hrole 4 (by decide)] + exact hlookup.scanner.addressWidth + · change (finalWork (tapes.data.lhsLookup.idx 5)).HasBinaryNat 0 + rw [hrole 5 (by decide)] + exact hlookup.scanner.valueCounter + · change (finalWork (tapes.data.lhsLookup.idx 6)).HasBinaryNat 0 + rw [hrole 6 (by decide)] + exact hlookup.scanner.valueWidth + · change (finalWork (tapes.data.lhsLookup.idx 7)).HasBinaryString [] + rw [hrole 7 (by decide)] + exact hlookup.scanner.query + · change (finalWork (tapes.data.lhsLookup.idx 7)).cells 0 = Γ.start + rw [hrole 7 (by decide)] + exact hlookup.scanner.queryStart + · change (finalWork (tapes.data.lhsLookup.idx 8)).HasBinaryPrefix [] + rw [hrole 8 (by decide)] + exact hlookup.scanner.result + · change (finalWork (tapes.data.lhsLookup.idx 8)).cells 0 = Γ.start + rw [hrole 8 (by decide)] + exact hlookup.scanner.resultStart + have hfinalReady : ControlInstructionReady tapes overlay newPC finalWork := by + refine + { lookup := + { scanner := hscanner + sourceStart := ?_ + sourceHead := ?_ + count := ?_ + countSource := ?_ + querySource := ?_ + destination := ?_ + copyScratch := ?_ } + pc := ?_ } + · change (finalWork (tapes.data.lhsLookup.idx 0)).cells 0 = Γ.start + rw [hrole 0 (by decide)] + exact hlookup.sourceStart + · change (finalWork (tapes.data.lhsLookup.idx 0)).head = 1 + rw [hrole 0 (by decide)] + exact hlookup.sourceHead + · change (finalWork (tapes.data.lhsLookup.idx 9)).HasBinaryNat _ + rw [hrole 9 (by decide)] + exact hlookup.count + · change (finalWork (tapes.data.lhsLookup.idx 10)).HasBinaryNat _ + rw [hrole 10 (by decide)] + rw [show lookupWork (tapes.data.lhsLookup.idx 10) = + initialWork (tapes.data.lhsLookup.idx 10) by + simpa using hlookup.countSource] + exact hinitial.lookup.countSource + · change (finalWork (tapes.data.lhsLookup.idx 11)).HasBinaryNat 0 + rw [hrole 11 (by decide)] + exact hlookup.querySource + · change (finalWork tapes.data.lhs).HasBinaryNat 0 + simp only [finalWork, Function.update_self] + exact Tape.init_move_right_hasBinaryNat 0 + · change (finalWork (tapes.data.lhsLookup.idx 13)).HasBinaryNat 0 + rw [hrole 13 (by decide)] + exact hlookup.copyScratch + · simpa only [finalWork, Function.update_of_ne tapes.pc_ne_lhs] using hpc + refine + { ready := hfinalReady + sourceCells := ?_ + frame := ?_ } + · change (finalWork (tapes.data.lhsLookup.idx 0)).cells = + (initialWork (tapes.data.lhsLookup.idx 0)).cells + rw [hrole 0 (by decide)] + exact hlookup.sourceCells + · intro i hipc hdata + have hiLhs : i ≠ tapes.data.lhs := hdata 12 + simp only [Function.update_of_ne hiLhs] + rw [hframe i hipc] + exact hlookup.frame i hdata + +/-- A dense-overlay conditional read implements `jz` and restores the shared +lookup ABI after the program-counter branch. -/ +theorem denseZeroJumpInstructionTM_hoareTime_frame + (tapes : ControlInstructionTapes n) (input : List Bool) + (overlay : Store) (pcValue source target : ℕ) + (initialWork : Fin n → Tape) (out₀ : Tape) + (hvalid : DenseOverlay.Valid overlay) + (hready : ControlInstructionReady tapes overlay pcValue initialWork) + (houtput : TM.Parked out₀) : + (denseZeroJumpInstructionTM tapes source target).HoareTime + (fun inp work out => + inp = (Tape.init (input.map Γ.ofBool)).move Dir3.right ∧ + work = initialWork ∧ out = out₀) + (fun inp work out => + inp = (Tape.init (input.map Γ.ofBool)).move Dir3.right ∧ + ControlInstructionResult tapes overlay + (if DenseOverlay.read input overlay source = 0 then target + else pcValue + 1) + initialWork work ∧ out = out₀) + (denseZeroJumpInstructionTime tapes input overlay pcValue source + target) := by + let inp₀ := (Tape.init (input.map Γ.ofBool)).move Dir3.right + let value := DenseOverlay.read input overlay source + let newPC := if value = 0 then target else pcValue + 1 + let lookupPost : TM.TapePred n := fun inp work out => + inp = inp₀ ∧ + DenseOverlayLookupStaticResult tapes.data.lhsLookup input overlay source + initialWork work ∧ out = out₀ + let branchPost : TM.TapePred n := fun inp work out => + inp = inp₀ ∧ + DenseZeroJumpBranchResult tapes input overlay source newPC initialWork + work ∧ out = out₀ + have hinput : TM.Parked inp₀ := by + refine ⟨by simp [inp₀, Tape.move], ?_⟩ + simpa [inp₀] using Tape.init_ofBool_move_right_cells_ne_start input + have hlookup := denseOverlayLookupStaticTM_hoareTime_frame + tapes.data.lhsLookup input overlay source initialWork out₀ hvalid + hready.lookup houtput + have hbranch : + (TM.branchWorkBlankTM tapes.data.lhs + (setProgramCounterTM tapes.pc target) + (TM.binarySuccTM tapes.pc)).HoareTime lookupPost branchPost + (TM.branchWorkBlankTime (setProgramCounterTime pcValue target) + (TM.binarySuccTime pcValue)) := by + let blankPre : TM.TapePred n := fun inp work out => + lookupPost inp work out ∧ value = 0 + let nonblankPre : TM.TapePred n := fun inp work out => + lookupPost inp work out ∧ value ≠ 0 + have hblank : (setProgramCounterTM tapes.pc target).HoareTime + blankPre branchPost (setProgramCounterTime pcValue target) := by + rintro inp work out ⟨⟨hinp, hlookupResult, hout⟩, hzero⟩ + have hpcWork : (work tapes.pc).HasBinaryNat pcValue := by + rw [hlookupResult.frame tapes.pc + (fun slot => (tapes.lookup_ne_pc slot).symm)] + exact hready.pc + have hset := setProgramCounterTM_hoareTime_frame_internal tapes.pc + pcValue target inp work out hpcWork + (by simpa [hinp] using hinput) + hlookupResult.parked (by simpa [hout] using houtput) + obtain ⟨final, time, htime, hreach, hhalt, hfinalInput, + hfinalWork, hfinalOutput⟩ := hset inp work out ⟨rfl, rfl, rfl⟩ + refine ⟨final, time, htime, hreach, hhalt, + hfinalInput.trans hinp, ?_, hfinalOutput.trans hout⟩ + rw [hfinalWork] + let targetTape := + (Tape.init (target.bits.map Γ.ofBool)).move Dir3.right + have htarget : targetTape.HasBinaryNat target := + Tape.init_move_right_hasBinaryNat target + refine ⟨work, hlookupResult, ?_, ?_, ?_, ?_⟩ + · simpa only [Function.update_of_ne tapes.lhs_ne_pc, value] using + hlookupResult.destination + · simpa only [targetTape, Function.update_self, newPC, hzero, if_pos] + using htarget + · intro i + by_cases hi : i = tapes.pc + · subst i + simpa only [targetTape, Function.update_self] using + hasBinaryNat_parked htarget + · simpa only [targetTape, Function.update_of_ne hi] using + hlookupResult.parked i + · intro i hi + exact Function.update_of_ne hi _ work + have hnonblank : (TM.binarySuccTM tapes.pc).HoareTime + nonblankPre branchPost (TM.binarySuccTime pcValue) := by + rintro inp work out ⟨⟨hinp, hlookupResult, hout⟩, hnonzero⟩ + have hpcWork : (work tapes.pc).HasBinaryNat pcValue := by + rw [hlookupResult.frame tapes.pc + (fun slot => (tapes.lookup_ne_pc slot).symm)] + exact hready.pc + have hsucc := TM.binarySuccTM_hoareTime_frame tapes.pc pcValue inp + work out hpcWork (by simpa [hinp] using hinput.read_ne_start) + (fun i _ => (hlookupResult.parked i).read_ne_start) + (by simpa [hout] using houtput.read_ne_start) + obtain ⟨final, time, htime, hreach, hhalt, hfinalInput, + hframe, hfinalPC, hfinalOutput⟩ := + hsucc inp work out ⟨rfl, rfl, rfl⟩ + refine ⟨final, time, htime, hreach, hhalt, + hfinalInput.trans hinp, ?_, hfinalOutput.trans hout⟩ + refine ⟨work, hlookupResult, ?_, ?_, ?_, hframe⟩ + · rw [hframe tapes.data.lhs tapes.lhs_ne_pc] + simpa only [value] using hlookupResult.destination + · simpa only [newPC, if_neg hnonzero] using hfinalPC + · intro i + by_cases hi : i = tapes.pc + · subst i + exact hasBinaryNat_parked hfinalPC + · rw [hframe i hi] + exact hlookupResult.parked i + have hdispatch := TM.branchWorkBlankTM_hoareTime tapes.data.lhs + (setProgramCounterTM tapes.pc target) (TM.binarySuccTM tapes.pc) + (pre := lookupPost) (blankPre := blankPre) + (nonblankPre := nonblankPre) (blankPost := branchPost) + (nonblankPost := branchPost) + (fun inp work out hpre => + ⟨(by simpa [hpre.1] using hinput.read_ne_start), + fun i => (hpre.2.1.parked i).read_ne_start, + by simpa [hpre.2.2] using houtput.read_ne_start⟩) + (fun _ _ _ hpre hread => + ⟨hpre, hpre.2.1.destination.read_eq_blank_iff.mp hread⟩) + (fun _ _ _ hpre hread => + ⟨hpre, fun hzero => + hread (hpre.2.1.destination.read_eq_blank_iff.mpr hzero)⟩) + hblank hnonblank + exact hdispatch.consequence (fun _ _ _ h => h) + (fun _ _ _ h => h.elim id id) le_rfl + have hreset : (TM.resetBinaryWorkTM tapes.data.lhs).HoareTime branchPost + (fun inp work out => + inp = inp₀ ∧ + ControlInstructionResult tapes overlay newPC initialWork work ∧ + out = out₀) + (TM.resetBinaryWorkTime 1 value.bits.length) := by + rintro inp work out ⟨hinp, hbranchResult, hout⟩ + obtain ⟨lookupWork, hlookupResult, hoperand, hpcResult, + hparked, hframe⟩ := hbranchResult + have hrun := TM.resetBinaryWorkTM_hoareTime_frame tapes.data.lhs + value.bits 1 inp work out hoperand.2.hasBinaryContent hoperand.1 + ⟨by rw [hoperand.2.1], by rw [hoperand.2.1]⟩ + (by simpa [hinp] using hinput) + (fun i _ => hparked i) (by simpa [hout] using houtput) + obtain ⟨final, time, htime, hreach, hhalt, hfinalInput, + hfinalWork, hfinalOutput⟩ := hrun inp work out ⟨rfl, rfl, rfl⟩ + refine ⟨final, time, htime, hreach, hhalt, + hfinalInput.trans hinp, ?_, hfinalOutput.trans hout⟩ + rw [hfinalWork] + exact denseControlResult_of_zeroJumpReset tapes input overlay pcValue + source newPC initialWork work hready + ⟨lookupWork, hlookupResult, hoperand, hpcResult, hparked, hframe⟩ + have hbranchReset := TM.seqTM_hoareTime + (TM.branchWorkBlankTM tapes.data.lhs + (setProgramCounterTM tapes.pc target) (TM.binarySuccTM tapes.pc)) + (TM.resetBinaryWorkTM tapes.data.lhs) hbranch + (by + rintro inp work out ⟨hinp, hbranchResult, hout⟩ + obtain ⟨lookupWork, hlookupResult, hoperand, hpcResult, + hparked, hframe⟩ := hbranchResult + obtain ⟨hi, hw, ho⟩ := phaseTransition_of_parked + (inp := inp) (work := work) (out := out) + (by simpa [hinp] using hinput) hparked + (by simpa [hout] using houtput) + rw [hi, hw, ho] + exact ⟨hinp, + ⟨lookupWork, hlookupResult, hoperand, hpcResult, hparked, hframe⟩, + hout⟩) + hreset + have hall := TM.seqTM_hoareTime + (denseOverlayLookupStaticTM tapes.data.lhsLookup source) + (TM.seqTM + (TM.branchWorkBlankTM tapes.data.lhs + (setProgramCounterTM tapes.pc target) (TM.binarySuccTM tapes.pc)) + (TM.resetBinaryWorkTM tapes.data.lhs)) hlookup + (by + rintro inp work out ⟨hinp, hlookupResult, hout⟩ + obtain ⟨hi, hw, ho⟩ := phaseTransition_of_parked + (inp := inp) (work := work) (out := out) + (by simpa [inp₀, hinp] using hinput) hlookupResult.parked + (by simpa [hout] using houtput) + rw [hi, hw, ho] + exact ⟨hinp, hlookupResult, hout⟩) + hbranchReset + simpa [denseZeroJumpInstructionTM, denseZeroJumpInstructionTime, inp₀, + value, newPC] using hall + +end Machine +end RegisterStore +end RAM +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseCtrlSim.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseCtrlSim.lean new file mode 100644 index 0000000000..2772ef5911 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseCtrlSim.lean @@ -0,0 +1,171 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.DenseControl +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.DenseSimDefs +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Sim.Control + +/-! +# Dense-overlay control-instruction simulation +-/ + + +public section + +namespace Complexity +namespace RAM +namespace RegisterStore +namespace Machine + +variable {n : ℕ} + +private theorem denseInput_parked (input : List Bool) : + TM.Parked ((Tape.init (input.map Γ.ofBool)).move Dir3.right) := by + refine ⟨by simp [Tape.move], ?_⟩ + simpa using Tape.init_ofBool_move_right_cells_ne_start input + +private theorem blankOutput_parked : + TM.Parked ((Tape.init []).move Dir3.right) := by + refine ⟨by simp [Tape.move], ?_⟩ + intro j hj + simp [Tape.init, Tape.move] + omega + +/-- Dense conditional-zero execution preserves the overlay and exposes the +generic buffered endpoint. -/ +theorem denseExecuteInstructionTM_jz_hoareTime_frame + (tapes : ControlInstructionTapes n) (input : List Bool) + (overlay : Store) (pcValue source target : ℕ) + (initialWork : Fin (n + 1) → Tape) + (hvalid : DenseOverlay.Valid overlay) + (hready : InstructionExecutionReady tapes overlay pcValue initialWork) : + (denseExecuteInstructionTM tapes (.jz source target)).HoareTime + (fun inp work out => + inp = (Tape.init (input.map Γ.ofBool)).move Dir3.right ∧ + work = initialWork ∧ out = (Tape.init []).move Dir3.right) + (fun inp work out => + inp = (Tape.init (input.map Γ.ofBool)).move Dir3.right ∧ + DenseInstructionExecutionResult tapes input (.jz source target) + pcValue overlay work ∧ + out = (Tape.init []).move Dir3.right) + (denseExecuteInstructionTime tapes input (.jz source target) + pcValue overlay) := by + let inp₀ := (Tape.init (input.map Γ.ofBool)).move Dir3.right + let out₀ := (Tape.init []).move Dir3.right + let newPC := if DenseOverlay.read input overlay source = 0 then target + else pcValue + 1 + have hcontrol := denseZeroJumpInstructionTM_hoareTime_frame tapes.lifted + input overlay pcValue source target initialWork out₀ hvalid + hready.control blankOutput_parked + have hfinish := + finishBufferedControlInstructionTM_hoareTime_frame_internal tapes overlay + pcValue newPC initialWork inp₀ out₀ + (denseZeroJumpInstructionTM tapes.lifted source target) + (denseZeroJumpInstructionTime tapes.lifted input overlay pcValue source + target) + hready (denseInput_parked input) blankOutput_parked + (by simpa [inp₀, newPC] using hcontrol) + have hcleanup : + denseInstructionCleanupValue input (.jz source target) overlay = + fun _ => 0 := by + funext slot + fin_cases slot <;> rfl + by_cases hzero : DenseOverlay.read input overlay source = 0 + · simpa [inp₀, out₀, newPC, denseExecuteInstructionTM, + denseExecuteInstructionTime, DenseInstructionExecutionResult, + denseInstructionStore, denseInstructionPC, hcleanup, + denseInstructionRemainingValue, DenseOverlay.Snapshot.stepInstr, + hzero] using hfinish + · simpa [inp₀, out₀, newPC, denseExecuteInstructionTM, + denseExecuteInstructionTime, DenseInstructionExecutionResult, + denseInstructionStore, denseInstructionPC, hcleanup, + denseInstructionRemainingValue, DenseOverlay.Snapshot.stepInstr, + hzero] using hfinish + +/-- Dense unconditional-jump execution preserves the overlay and exposes the +generic buffered endpoint. -/ +theorem denseExecuteInstructionTM_jmp_hoareTime_frame + (tapes : ControlInstructionTapes n) (input : List Bool) + (overlay : Store) (pcValue target : ℕ) + (initialWork : Fin (n + 1) → Tape) + (hready : InstructionExecutionReady tapes overlay pcValue initialWork) : + (denseExecuteInstructionTM tapes (.jmp target)).HoareTime + (fun inp work out => + inp = (Tape.init (input.map Γ.ofBool)).move Dir3.right ∧ + work = initialWork ∧ out = (Tape.init []).move Dir3.right) + (fun inp work out => + inp = (Tape.init (input.map Γ.ofBool)).move Dir3.right ∧ + DenseInstructionExecutionResult tapes input (.jmp target) + pcValue overlay work ∧ + out = (Tape.init []).move Dir3.right) + (denseExecuteInstructionTime tapes input (.jmp target) + pcValue overlay) := by + let inp₀ := (Tape.init (input.map Γ.ofBool)).move Dir3.right + let out₀ := (Tape.init []).move Dir3.right + have hcontrol := jumpInstructionTM_hoareTime_frame_internal tapes.lifted + overlay pcValue target initialWork inp₀ out₀ hready.control + (denseInput_parked input) blankOutput_parked + have hfinish := + finishBufferedControlInstructionTM_hoareTime_frame_internal tapes overlay + pcValue target initialWork inp₀ out₀ + (jumpInstructionTM tapes.lifted target) + (jumpInstructionTime pcValue target) hready (denseInput_parked input) + blankOutput_parked hcontrol + have hcleanup : denseInstructionCleanupValue input (.jmp target) overlay = + fun _ => 0 := by + funext slot + fin_cases slot <;> rfl + simpa [inp₀, out₀, denseExecuteInstructionTM, + denseExecuteInstructionTime, DenseInstructionExecutionResult, + denseInstructionStore, denseInstructionPC, hcleanup, + denseInstructionRemainingValue, + DenseOverlay.Snapshot.stepInstr] using hfinish + +/-- Dense halt execution preserves both the overlay and program counter and +exposes the generic buffered endpoint. -/ +theorem denseExecuteInstructionTM_halt_hoareTime_frame + (tapes : ControlInstructionTapes n) (input : List Bool) + (overlay : Store) (pcValue : ℕ) + (initialWork : Fin (n + 1) → Tape) + (hready : InstructionExecutionReady tapes overlay pcValue initialWork) : + (denseExecuteInstructionTM tapes .halt).HoareTime + (fun inp work out => + inp = (Tape.init (input.map Γ.ofBool)).move Dir3.right ∧ + work = initialWork ∧ out = (Tape.init []).move Dir3.right) + (fun inp work out => + inp = (Tape.init (input.map Γ.ofBool)).move Dir3.right ∧ + DenseInstructionExecutionResult tapes input .halt pcValue overlay + work ∧ + out = (Tape.init []).move Dir3.right) + (denseExecuteInstructionTime tapes input .halt pcValue overlay) := by + let inp₀ := (Tape.init (input.map Γ.ofBool)).move Dir3.right + let out₀ := (Tape.init []).move Dir3.right + have hcontrol := haltInstructionTM_hoareTime_frame_internal tapes.lifted + overlay pcValue initialWork inp₀ out₀ hready.control + (denseInput_parked input) blankOutput_parked + have hfinish := + finishBufferedControlInstructionTM_hoareTime_frame_internal tapes overlay + pcValue pcValue initialWork inp₀ out₀ + (haltInstructionTM (n := n + 1)) haltInstructionTime hready + (denseInput_parked input) blankOutput_parked hcontrol + have hcleanup : denseInstructionCleanupValue input .halt overlay = + fun _ => 0 := by + funext slot + fin_cases slot <;> rfl + simpa [inp₀, out₀, denseExecuteInstructionTM, + denseExecuteInstructionTime, DenseInstructionExecutionResult, + denseInstructionStore, denseInstructionPC, hcleanup, + denseInstructionRemainingValue, + DenseOverlay.Snapshot.stepInstr] using hfinish + +end Machine +end RegisterStore +end RAM +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseDefs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseDefs.lean new file mode 100644 index 0000000000..a3f1505e12 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseDefs.lean @@ -0,0 +1,246 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Defs +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.TaggedDefs + +/-! +# Dense-overlay RAM instruction kernels -- definitions + +These kernels retain the checked sparse scanner/update ABI while interpreting +the immutable public input in place. Reads use the dense-overlay lookup and +writes successor-tag their actual value before sparse update. +-/ + + +@[expose] public section + +namespace Complexity +namespace RAM +namespace RegisterStore +namespace Machine + +/-- Arithmetic followed by positive tagging and sparse overlay update. -/ +def denseBinaryInstructionUpdateTM {n : ℕ} + (tapes : BinaryInstructionTapes n) (op : BinaryInstrOp) : TM n := + TM.seqTM (binaryInstructionArithmeticTM tapes op) + (taggedEntryUpdateTM tapes.update) + +/-- Two direct dense-overlay reads, arithmetic, and a tagged destination write. -/ +def denseDirectBinaryInstructionTM {n : ℕ} + (tapes : BinaryInstructionTapes n) (op : BinaryInstrOp) + (destination source₀ source₁ : ℕ) : TM n := + TM.seqTM + (TM.seqTM (denseOverlayLookupStaticTM tapes.lhsLookup source₀) + (denseOverlayLookupStaticTM tapes.rhsLookup source₁)) + (TM.seqTM (TM.binaryAddConstTM tapes.update.entry.query destination) + (denseBinaryInstructionUpdateTM tapes op)) + +/-- Dense-overlay indirect read followed by a tagged direct destination write. -/ +def denseIndirectLoadInstructionTM {n : ℕ} + (tapes : BinaryInstructionTapes n) + (destination addressRegister : ℕ) : TM n := + TM.seqTM + (TM.seqTM (denseOverlayLookupStaticTM tapes.lhsLookup addressRegister) + (denseOverlayLookupTM tapes.indirectLoadLookup)) + (TM.seqTM (TM.binaryAddConstTM tapes.update.entry.query destination) + (taggedEntryUpdateTM tapes.update)) + +/-- Immediate assignment with its value converted to a positive overlay tag. -/ +def denseImmediateInstructionTM {n : ℕ} + (tapes : BinaryInstructionTapes n) (destination value : ℕ) : TM n := + TM.seqTM (TM.binaryAddConstTM tapes.update.replacement value) + (TM.seqTM (TM.binaryAddConstTM tapes.update.entry.query destination) + (taggedEntryUpdateTM tapes.update)) + +/-- Dense-overlay indirect destination/source reads followed by a tagged write. -/ +def denseIndirectStoreInstructionTM {n : ℕ} + (tapes : BinaryInstructionTapes n) + (addressRegister source : ℕ) : TM n := + TM.seqTM + (TM.seqTM (denseOverlayLookupStaticTM tapes.lhsLookup addressRegister) + (denseOverlayLookupStaticTM tapes.rhsLookup source)) + (TM.seqTM + (TM.binaryCopyIntoTM tapes.lhs tapes.update.entry.query + tapes.update.found) + (TM.seqTM + (TM.binaryCopyIntoTM tapes.rhs tapes.update.replacement + tapes.update.found) + (taggedEntryUpdateTM tapes.update))) + +/-- Conditional jump whose tested register is read through the dense overlay. -/ +def denseZeroJumpInstructionTM {n : ℕ} + (tapes : ControlInstructionTapes n) (source target : ℕ) : TM n := + TM.seqTM (denseOverlayLookupStaticTM tapes.data.lhsLookup source) + (TM.seqTM + (TM.branchWorkBlankTM tapes.data.lhs + (setProgramCounterTM tapes.pc target) + (TM.binarySuccTM tapes.pc)) + (TM.resetBinaryWorkTM tapes.data.lhs)) + +/-- Semantic endpoint of arithmetic and one tagged overlay update. -/ +def DenseBinaryInstructionUpdateResult {n : ℕ} + (tapes : BinaryInstructionTapes n) (op : BinaryInstrOp) + (overlay : Store) (address lhs rhs : ℕ) + (initialWork finalWork : Fin n → Tape) : Prop := + ∃ arithmeticWork : Fin n → Tape, + BinaryInstructionArithmeticResult tapes op lhs rhs + initialWork arithmeticWork ∧ + TaggedEntryUpdateResult tapes.update overlay address (op.eval lhs rhs) + arithmeticWork finalWork + +/-- Boundary after two fixed-address dense-overlay reads. -/ +def DenseDirectBinaryOperandsResult {n : ℕ} + (tapes : BinaryInstructionTapes n) (input : List Bool) + (overlay : Store) (source₀ source₁ : ℕ) + (initialWork finalWork : Fin n → Tape) : Prop := + ∃ lhsWork, + DenseOverlayLookupStaticResult tapes.lhsLookup input overlay source₀ + initialWork lhsWork ∧ + DenseOverlayLookupStaticResult tapes.rhsLookup input overlay source₁ + lhsWork finalWork + +/-- Boundary after dense operands and direct destination synthesis. -/ +def DenseDirectBinaryAddressResult {n : ℕ} + (tapes : BinaryInstructionTapes n) (input : List Bool) + (overlay : Store) (destination source₀ source₁ : ℕ) + (initialWork finalWork : Fin n → Tape) : Prop := + ∃ operandsWork, + DenseDirectBinaryOperandsResult tapes input overlay source₀ source₁ + initialWork operandsWork ∧ + finalWork = Function.update operandsWork tapes.update.entry.query + ((Tape.init (destination.bits.map Γ.ofBool)).move Dir3.right) + +/-- Semantic endpoint of a complete dense direct arithmetic instruction. -/ +def DenseDirectBinaryInstructionResult {n : ℕ} + (tapes : BinaryInstructionTapes n) (op : BinaryInstrOp) + (input : List Bool) (overlay : Store) + (destination source₀ source₁ : ℕ) + (initialWork finalWork : Fin n → Tape) : Prop := + ∃ updateWork, + DenseDirectBinaryAddressResult tapes input overlay destination source₀ + source₁ initialWork updateWork ∧ + DenseBinaryInstructionUpdateResult tapes op overlay destination + (DenseOverlay.read input overlay source₀) + (DenseOverlay.read input overlay source₁) updateWork finalWork + +/-- Semantic endpoint of one dense immediate assignment. -/ +def DenseImmediateInstructionResult {n : ℕ} + (tapes : BinaryInstructionTapes n) (overlay : Store) + (destination value : ℕ) (initialWork finalWork : Fin n → Tape) : Prop := + ∃ valueWork updateWork, + valueWork = Function.update initialWork tapes.update.replacement + ((Tape.init (value.bits.map Γ.ofBool)).move Dir3.right) ∧ + updateWork = Function.update valueWork tapes.update.entry.query + ((Tape.init (destination.bits.map Γ.ofBool)).move Dir3.right) ∧ + TaggedEntryUpdateResult tapes.update overlay destination value updateWork + finalWork + +/-- Semantic endpoint of a complete dense indirect load. -/ +def DenseIndirectLoadInstructionResult {n : ℕ} + (tapes : BinaryInstructionTapes n) (input : List Bool) + (overlay : Store) (destination addressRegister : ℕ) + (initialWork finalWork : Fin n → Tape) : Prop := + ∃ addressWork loadedWork updateWork, + DenseOverlayLookupStaticResult tapes.lhsLookup input overlay + addressRegister initialWork addressWork ∧ + DenseOverlayLookupResult tapes.indirectLoadLookup input overlay + (DenseOverlay.read input overlay addressRegister) addressWork loadedWork ∧ + updateWork = Function.update loadedWork tapes.update.entry.query + ((Tape.init (destination.bits.map Γ.ofBool)).move Dir3.right) ∧ + TaggedEntryUpdateResult tapes.update overlay destination + (DenseOverlay.read input overlay + (DenseOverlay.read input overlay addressRegister)) + updateWork finalWork + +/-- Semantic endpoint of a complete dense indirect store. -/ +def DenseIndirectStoreInstructionResult {n : ℕ} + (tapes : BinaryInstructionTapes n) (input : List Bool) + (overlay : Store) (addressRegister source : ℕ) + (initialWork finalWork : Fin n → Tape) : Prop := + ∃ operandsWork queryWork updateWork, + DenseDirectBinaryOperandsResult tapes input overlay addressRegister source + initialWork operandsWork ∧ + queryWork = Function.update operandsWork tapes.update.entry.query + ((Tape.init ((DenseOverlay.read input overlay addressRegister).bits.map + Γ.ofBool)).move Dir3.right) ∧ + updateWork = Function.update queryWork tapes.update.replacement + ((Tape.init ((DenseOverlay.read input overlay source).bits.map Γ.ofBool)).move + Dir3.right) ∧ + TaggedEntryUpdateResult tapes.update overlay + (DenseOverlay.read input overlay addressRegister) + (DenseOverlay.read input overlay source) updateWork finalWork + +/-- Runtime of arithmetic followed by positive tagging and overlay update. -/ +def denseBinaryInstructionUpdateTime {n : ℕ} + (tapes : BinaryInstructionTapes n) (op : BinaryInstrOp) + (overlay : Store) (address lhs rhs : ℕ) : ℕ := + binaryInstructionArithmeticTime op lhs rhs + 1 + + taggedEntryUpdateTime tapes.update overlay address (op.eval lhs rhs) + +/-- Complete direct dense arithmetic-instruction budget. -/ +def denseDirectBinaryInstructionTime {n : ℕ} + (tapes : BinaryInstructionTapes n) (op : BinaryInstrOp) + (input : List Bool) (overlay : Store) + (destination source₀ source₁ : ℕ) : ℕ := + (denseOverlayLookupStaticTime tapes.lhsLookup input.length overlay source₀ + 1 + + denseOverlayLookupStaticTime tapes.rhsLookup input.length overlay source₁) + 1 + + (TM.binaryAddConstTime destination 0 + 1 + + denseBinaryInstructionUpdateTime tapes op overlay destination + (DenseOverlay.read input overlay source₀) + (DenseOverlay.read input overlay source₁)) + +/-- Complete immediate dense assignment budget. -/ +def denseImmediateInstructionTime {n : ℕ} + (tapes : BinaryInstructionTapes n) (overlay : Store) + (destination value : ℕ) : ℕ := + TM.binaryAddConstTime value 0 + 1 + + (TM.binaryAddConstTime destination 0 + 1 + + taggedEntryUpdateTime tapes.update overlay destination value) + +/-- Complete dense indirect-load instruction budget. -/ +def denseIndirectLoadInstructionTime {n : ℕ} + (tapes : BinaryInstructionTapes n) (input : List Bool) + (overlay : Store) (destination addressRegister : ℕ) : ℕ := + (denseOverlayLookupStaticTime tapes.lhsLookup input.length overlay + addressRegister + 1 + + denseOverlayLookupTime tapes.indirectLoadLookup input.length overlay + (DenseOverlay.read input overlay addressRegister)) + 1 + + (TM.binaryAddConstTime destination 0 + 1 + + taggedEntryUpdateTime tapes.update overlay destination + (DenseOverlay.read input overlay + (DenseOverlay.read input overlay addressRegister))) + +/-- Complete dense indirect-store instruction budget. -/ +def denseIndirectStoreInstructionTime {n : ℕ} + (tapes : BinaryInstructionTapes n) (input : List Bool) + (overlay : Store) (addressRegister source : ℕ) : ℕ := + (denseOverlayLookupStaticTime tapes.lhsLookup input.length overlay + addressRegister + 1 + + denseOverlayLookupStaticTime tapes.rhsLookup input.length overlay source) + 1 + + (TM.binaryCopyTime (DenseOverlay.read input overlay addressRegister) 0 + 1 + + (TM.binaryCopyTime (DenseOverlay.read input overlay source) 0 + 1 + + taggedEntryUpdateTime tapes.update overlay + (DenseOverlay.read input overlay addressRegister) + (DenseOverlay.read input overlay source))) + +/-- Runtime for a conditional jump using one dense-overlay register read. -/ +def denseZeroJumpInstructionTime {n : ℕ} + (tapes : ControlInstructionTapes n) (input : List Bool) + (overlay : Store) (pcValue source target : ℕ) : ℕ := + denseOverlayLookupStaticTime tapes.data.lhsLookup input.length overlay source + 1 + + (TM.branchWorkBlankTime (setProgramCounterTime pcValue target) + (TM.binarySuccTime pcValue) + 1 + + TM.resetBinaryWorkTime 1 + (DenseOverlay.read input overlay source).bits.length) + +end Machine +end RegisterStore +end RAM +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseDirect.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseDirect.lean new file mode 100644 index 0000000000..618442e810 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseDirect.lean @@ -0,0 +1,547 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.DenseDefs +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Direct +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Tagged +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.DenseInternal + +/-! +# Dense-overlay direct arithmetic instructions +-/ + + +public section + +namespace Complexity +namespace RAM +namespace RegisterStore +namespace Machine + +variable {n : ℕ} + +private theorem hasBinaryNat_parked {t : Tape} {value : ℕ} + (h : t.HasBinaryNat value) : TM.Parked t := + ⟨by rw [h.2.1], h.2.hasBinaryContent.cells_ne_start⟩ + +private theorem hasBinaryPrefix_parked {t : Tape} {bits : List Bool} + (h : t.HasBinaryPrefix bits) : TM.Parked t := by + refine ⟨by rw [h.1]; omega, ?_⟩ + intro j hj + obtain ⟨i, rfl⟩ : ∃ i, j = i + 1 := ⟨j - 1, by omega⟩ + by_cases hi : i < bits.length + · rw [h.2.1 i hi] + exact Γ.ofBool_ne_start _ + · rw [h.2.2 i (Nat.le_of_not_gt hi)] + decide + +private theorem phaseTransition_of_parked + {inp out : Tape} {work : Fin n → Tape} + (hinput : TM.Parked inp) (hwork : ∀ i, TM.Parked (work i)) + (houtput : TM.Parked out) : + TM.transitionInput inp = inp ∧ + (fun i => TM.transitionTape (work i)) = work ∧ + TM.transitionTape out = out := + TM.phaseTransition_eq_self_of_reads_ne_start hinput.read_ne_start + (fun i => (hwork i).read_ne_start) houtput.read_ne_start + +private theorem denseScanner_rhs_of_lhs + (tapes : BinaryInstructionTapes n) (input : List Bool) + (overlay : Store) (source : ℕ) + (initialWork finalWork : Fin n → Tape) + (hlookup : DenseOverlayLookupStaticResult tapes.lhsLookup input overlay + source initialWork finalWork) : + EntryScanReady tapes.rhsLookup.scan.entry (overlay.flatMap Entry.encode) [] + finalWork finalWork := by + exact + { source := hlookup.scanner.source + address := hlookup.scanner.address + addressStart := hlookup.scanner.addressStart + value := hlookup.scanner.value + valueStart := hlookup.scanner.valueStart + addressCounter := hlookup.scanner.addressCounter + addressWidth := hlookup.scanner.addressWidth + valueCounter := hlookup.scanner.valueCounter + valueWidth := hlookup.scanner.valueWidth + query := hlookup.scanner.query + queryStart := hlookup.scanner.queryStart + result := hlookup.scanner.result + resultStart := hlookup.scanner.resultStart + parked := hlookup.parked + frame := by intro i _ _ _ _ _ _ _ _ _; rfl } + +private theorem denseRhsReady_of_lhs + (tapes : BinaryInstructionTapes n) (input : List Bool) + (overlay : Store) (source : ℕ) + (initialWork finalWork : Fin n → Tape) + (hinitial : EntryLookupStaticReady tapes.lhsLookup overlay initialWork) + (hrhs : (initialWork tapes.rhs).HasBinaryNat 0) + (hlookup : DenseOverlayLookupStaticResult tapes.lhsLookup input overlay + source initialWork finalWork) : + EntryLookupStaticReady tapes.rhsLookup overlay finalWork := by + have hrhsEq : finalWork tapes.rhs = initialWork tapes.rhs := + hlookup.frame tapes.rhs (fun slot => (tapes.lhsLookup_ne_rhs slot).symm) + refine + { scanner := denseScanner_rhs_of_lhs tapes input overlay source initialWork + finalWork hlookup + sourceStart := hlookup.sourceStart + sourceHead := hlookup.sourceHead + count := by simpa using hlookup.count + countSource := ?_ + querySource := by simpa using hlookup.querySource + destination := by + change (finalWork tapes.rhs).HasBinaryNat 0 + rw [hrhsEq] + exact hrhs + copyScratch := by simpa using hlookup.copyScratch } + change (finalWork tapes.update.resultCount).HasBinaryNat overlay.length + rw [show finalWork tapes.update.resultCount = + initialWork tapes.update.resultCount by simpa using hlookup.countSource] + simpa using hinitial.countSource + +/-- Two fixed dense-overlay reads compose while retaining the shared scanner +ABI and the immutable input tape. -/ +theorem denseDirectBinaryOperands_hoareTime + (tapes : BinaryInstructionTapes n) (input : List Bool) + (overlay : Store) (source₀ source₁ : ℕ) + (initialWork : Fin n → Tape) (out₀ : Tape) + (hvalid : DenseOverlay.Valid overlay) + (hinitial : EntryLookupStaticReady tapes.lhsLookup overlay initialWork) + (hrhs₀ : (initialWork tapes.rhs).HasBinaryNat 0) + (houtput : TM.Parked out₀) : + (TM.seqTM (denseOverlayLookupStaticTM tapes.lhsLookup source₀) + (denseOverlayLookupStaticTM tapes.rhsLookup source₁)).HoareTime + (fun inp work out => + inp = (Tape.init (input.map Γ.ofBool)).move Dir3.right ∧ + work = initialWork ∧ out = out₀) + (fun inp work out => + inp = (Tape.init (input.map Γ.ofBool)).move Dir3.right ∧ + DenseDirectBinaryOperandsResult tapes input overlay source₀ source₁ + initialWork work ∧ out = out₀) + (denseOverlayLookupStaticTime tapes.lhsLookup input.length overlay + source₀ + 1 + + denseOverlayLookupStaticTime tapes.rhsLookup input.length overlay + source₁) := by + let inp₀ := (Tape.init (input.map Γ.ofBool)).move Dir3.right + have hinput : TM.Parked inp₀ := by + refine ⟨by simp [inp₀, Tape.move], ?_⟩ + simpa [inp₀] using Tape.init_ofBool_move_right_cells_ne_start input + have hlhs := denseOverlayLookupStaticTM_hoareTime_internal tapes.lhsLookup + input overlay source₀ initialWork out₀ hvalid hinitial houtput + have hrhs : (denseOverlayLookupStaticTM tapes.rhsLookup source₁).HoareTime + (fun inp work out => + inp = inp₀ ∧ + DenseOverlayLookupStaticResult tapes.lhsLookup input overlay source₀ + initialWork work ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + DenseDirectBinaryOperandsResult tapes input overlay source₀ source₁ + initialWork work ∧ out = out₀) + (denseOverlayLookupStaticTime tapes.rhsLookup input.length overlay + source₁) := by + rintro inp work out ⟨hinp, hlhsResult, hout⟩ + have hready := denseRhsReady_of_lhs tapes input overlay source₀ initialWork + work hinitial hrhs₀ hlhsResult + have hrun := denseOverlayLookupStaticTM_hoareTime_internal tapes.rhsLookup + input overlay source₁ work out₀ hvalid hready houtput + obtain ⟨final, time, htime, hreach, hhalt, hfinalInput, + hrhsResult, hfinalOutput⟩ := + hrun inp work out ⟨hinp, rfl, hout⟩ + exact ⟨final, time, htime, hreach, hhalt, hfinalInput, + ⟨work, hlhsResult, hrhsResult⟩, hfinalOutput⟩ + have hall := TM.seqTM_hoareTime + (denseOverlayLookupStaticTM tapes.lhsLookup source₀) + (denseOverlayLookupStaticTM tapes.rhsLookup source₁) hlhs + (by + rintro inp work out ⟨hinp, hlhsResult, hout⟩ + obtain ⟨hi, hw, ho⟩ := phaseTransition_of_parked + (inp := inp) (work := work) (out := out) + (by simpa [inp₀, hinp] using hinput) hlhsResult.parked + (by simpa [hout] using houtput) + rw [hi, hw, ho] + exact ⟨hinp, hlhsResult, hout⟩) + hrhs + simpa only [inp₀] using hall + +private theorem denseDirectAddress_ready + (tapes : BinaryInstructionTapes n) (input : List Bool) + (overlay : Store) (destination source₀ source₁ : ℕ) + (initialWork finalWork : Fin n → Tape) + (hinitial : EntryLookupStaticReady tapes.lhsLookup overlay initialWork) + (hreplacement : (initialWork tapes.update.replacement).HasBinaryNat 0) + (htmp : (initialWork tapes.tmp).HasBinaryNat 0) + (hdbl : (initialWork tapes.dbl).HasBinaryNat 0) + (haddress : DenseDirectBinaryAddressResult tapes input overlay destination + source₀ source₁ initialWork finalWork) : + EntryScanReady tapes.update.entry (overlay.flatMap Entry.encode) + destination.bits finalWork finalWork ∧ + (finalWork tapes.lhs).HasBinaryNat + (DenseOverlay.read input overlay source₀) ∧ + (finalWork tapes.rhs).HasBinaryNat + (DenseOverlay.read input overlay source₁) ∧ + (finalWork tapes.update.replacement).HasBinaryNat 0 ∧ + (finalWork tapes.shift).HasBinaryNat 0 ∧ + (finalWork tapes.tmp).HasBinaryNat 0 ∧ + (finalWork tapes.dbl).HasBinaryNat 0 ∧ + (finalWork tapes.update.remaining).HasBinaryNat overlay.length ∧ + (finalWork tapes.update.found).HasBinaryNat 0 ∧ + (finalWork tapes.update.resultCount).HasBinaryNat overlay.length ∧ + ∀ i, TM.Parked (finalWork i) := by + rcases haddress with ⟨operandsWork, ⟨lhsWork, hlhs, hrhs⟩, rfl⟩ + have hlhsEq : operandsWork tapes.lhs = lhsWork tapes.lhs := + hrhs.frame tapes.lhs (fun slot => (tapes.rhsLookup_ne_lhs slot).symm) + have hreplacementEq : operandsWork tapes.update.replacement = + initialWork tapes.update.replacement := by + rw [hrhs.frame tapes.update.replacement + (fun slot => (tapes.rhsLookup_ne_replacement slot).symm)] + exact hlhs.frame tapes.update.replacement + (fun slot => (tapes.lhsLookup_ne_replacement slot).symm) + have htmpEq : operandsWork tapes.tmp = initialWork tapes.tmp := by + rw [hrhs.frame tapes.tmp (fun slot => (tapes.rhsLookup_ne_tmp slot).symm)] + exact hlhs.frame tapes.tmp (fun slot => (tapes.lhsLookup_ne_tmp slot).symm) + have hdblEq : operandsWork tapes.dbl = initialWork tapes.dbl := by + rw [hrhs.frame tapes.dbl (fun slot => (tapes.rhsLookup_ne_dbl slot).symm)] + exact hlhs.frame tapes.dbl (fun slot => (tapes.lhsLookup_ne_dbl slot).symm) + have hresultCount : + (operandsWork tapes.update.resultCount).HasBinaryNat overlay.length := by + rw [show operandsWork tapes.update.resultCount = + lhsWork tapes.update.resultCount by simpa using hrhs.countSource] + rw [show lhsWork tapes.update.resultCount = + initialWork tapes.update.resultCount by simpa using hlhs.countSource] + simpa using hinitial.countSource + have hqueryNe (i : Fin n) (h : i ≠ tapes.update.entry.query) : + Function.update operandsWork tapes.update.entry.query + ((Tape.init (destination.bits.map Γ.ofBool)).move Dir3.right) i = + operandsWork i := Function.update_of_ne h _ _ + have hscanner := scanner_updateQuery_internal tapes overlay destination + operandsWork hrhs.scanner + refine ⟨hscanner, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_, hscanner.parked⟩ + · rw [hqueryNe tapes.lhs (tapes.ne (by decide)), hlhsEq] + exact hlhs.destination + · rw [hqueryNe tapes.rhs (tapes.ne (by decide))] + exact hrhs.destination + · rw [hqueryNe tapes.update.replacement (tapes.update.ne (by decide)), + hreplacementEq] + exact hreplacement + · rw [hqueryNe tapes.shift ((tapes.update_ne_shift 7).symm)] + exact hrhs.querySource + · rw [hqueryNe tapes.tmp ((tapes.update_ne_tmp 7).symm), htmpEq] + exact htmp + · rw [hqueryNe tapes.dbl ((tapes.update_ne_dbl 7).symm), hdblEq] + exact hdbl + · rw [hqueryNe tapes.update.remaining (tapes.update.ne (by decide))] + exact hrhs.count + · rw [hqueryNe tapes.update.found (tapes.update.ne (by decide))] + exact hrhs.copyScratch + · rw [hqueryNe tapes.update.resultCount (tapes.update.ne (by decide))] + exact hresultCount + +private theorem denseArithmetic_update_ready + (tapes : BinaryInstructionTapes n) (op : BinaryInstrOp) + (overlay : Store) (address lhs rhs : ℕ) + (initialWork work : Fin n → Tape) + (hready : EntryScanReady tapes.update.entry + (overlay.flatMap Entry.encode) address.bits initialWork initialWork) + (hremaining : + (initialWork tapes.update.remaining).HasBinaryNat overlay.length) + (hfound : (initialWork tapes.update.found).HasBinaryNat 0) + (hresultCount : + (initialWork tapes.update.resultCount).HasBinaryNat overlay.length) + (harith : BinaryInstructionArithmeticResult tapes op lhs rhs + initialWork work) : + EntryScanReady tapes.update.entry (overlay.flatMap Entry.encode) + address.bits work work ∧ + (work tapes.update.remaining).HasBinaryNat overlay.length ∧ + (work tapes.update.found).HasBinaryNat 0 ∧ + (work tapes.update.resultCount).HasBinaryNat overlay.length := by + have hslotEq (slot : Fin 13) (hne : slot ≠ 10) : + work (tapes.update.idx slot) = initialWork (tapes.update.idx slot) := + harith.frame (tapes.update.idx slot) + (tapes.update_ne_lhs slot) (tapes.update_ne_rhs slot) + (tapes.update.ne hne) (tapes.update_ne_shift slot) + (tapes.update_ne_tmp slot) (tapes.update_ne_dbl slot) + have hready' : EntryScanReady tapes.update.entry + (overlay.flatMap Entry.encode) address.bits work work := by + refine + { source := ?_ + address := ?_ + addressStart := ?_ + value := ?_ + valueStart := ?_ + addressCounter := ?_ + addressWidth := ?_ + valueCounter := ?_ + valueWidth := ?_ + query := ?_ + queryStart := ?_ + result := ?_ + resultStart := ?_ + parked := harith.parked + frame := by intro i _ _ _ _ _ _ _ _ _; rfl } + · change (work (tapes.update.idx 0)).HasBinarySuffix _ + rw [hslotEq 0 (by decide)] + exact hready.source + · change (work (tapes.update.idx 1)).HasBinaryPrefix [] + rw [hslotEq 1 (by decide)] + exact hready.address + · change (work (tapes.update.idx 1)).cells 0 = Γ.start + rw [hslotEq 1 (by decide)] + exact hready.addressStart + · change (work (tapes.update.idx 2)).HasBinaryPrefix [] + rw [hslotEq 2 (by decide)] + exact hready.value + · change (work (tapes.update.idx 2)).cells 0 = Γ.start + rw [hslotEq 2 (by decide)] + exact hready.valueStart + · change (work (tapes.update.idx 3)).HasBinaryNat 0 + rw [hslotEq 3 (by decide)] + exact hready.addressCounter + · change (work (tapes.update.idx 4)).HasBinaryNat 0 + rw [hslotEq 4 (by decide)] + exact hready.addressWidth + · change (work (tapes.update.idx 5)).HasBinaryNat 0 + rw [hslotEq 5 (by decide)] + exact hready.valueCounter + · change (work (tapes.update.idx 6)).HasBinaryNat 0 + rw [hslotEq 6 (by decide)] + exact hready.valueWidth + · change (work (tapes.update.idx 7)).HasBinaryString address.bits + rw [hslotEq 7 (by decide)] + exact hready.query + · change (work (tapes.update.idx 7)).cells 0 = Γ.start + rw [hslotEq 7 (by decide)] + exact hready.queryStart + · change (work (tapes.update.idx 8)).HasBinaryPrefix [] + rw [hslotEq 8 (by decide)] + exact hready.result + · change (work (tapes.update.idx 8)).cells 0 = Γ.start + rw [hslotEq 8 (by decide)] + exact hready.resultStart + refine ⟨hready', ?_, ?_, ?_⟩ + · change (work (tapes.update.idx 9)).HasBinaryNat _ + rw [hslotEq 9 (by decide)] + exact hremaining + · change (work (tapes.update.idx 11)).HasBinaryNat 0 + rw [hslotEq 11 (by decide)] + exact hfound + · change (work (tapes.update.idx 12)).HasBinaryNat _ + rw [hslotEq 12 (by decide)] + exact hresultCount + +/-- Arithmetic feeds its canonical result through successor tagging and into +the sparse overlay update controller. -/ +theorem denseBinaryInstructionUpdateTM_hoareTime_frame + (tapes : BinaryInstructionTapes n) (op : BinaryInstrOp) + (overlay : Store) (address lhs rhs : ℕ) + (emittedBits : List Bool) (initialWork : Fin n → Tape) + (inp₀ out₀ : Tape) (hcanonical : Canonical overlay) + (hready : EntryScanReady tapes.update.entry + (overlay.flatMap Entry.encode) address.bits initialWork initialWork) + (hlhs : (initialWork tapes.lhs).HasBinaryNat lhs) + (hrhs : (initialWork tapes.rhs).HasBinaryNat rhs) + (hresult : (initialWork tapes.update.replacement).HasBinaryNat 0) + (hshift : (initialWork tapes.shift).HasBinaryNat 0) + (htmp : (initialWork tapes.tmp).HasBinaryNat 0) + (hdbl : (initialWork tapes.dbl).HasBinaryNat 0) + (hremaining : + (initialWork tapes.update.remaining).HasBinaryNat overlay.length) + (hfound : (initialWork tapes.update.found).HasBinaryNat 0) + (hresultCount : + (initialWork tapes.update.resultCount).HasBinaryNat overlay.length) + (hinput : TM.Parked inp₀) (hwork : ∀ i, TM.Parked (initialWork i)) + (houtput : out₀.HasBinaryPrefix emittedBits) : + (denseBinaryInstructionUpdateTM tapes op).HoareTime + (fun inp work out => inp = inp₀ ∧ work = initialWork ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + DenseBinaryInstructionUpdateResult tapes op overlay address lhs rhs + initialWork work ∧ + out.HasBinaryPrefix + (emittedBits ++ + (DenseOverlay.write overlay address (op.eval lhs rhs)).flatMap + Entry.encode)) + (denseBinaryInstructionUpdateTime tapes op overlay address lhs rhs) := by + have harithmetic := binaryInstructionArithmeticTM_hoareTime_frame_internal + tapes op lhs rhs inp₀ initialWork out₀ hlhs hrhs hresult hshift htmp hdbl + hinput hwork (hasBinaryPrefix_parked houtput) + have hupdate : (taggedEntryUpdateTM tapes.update).HoareTime + (fun inp work out => + inp = inp₀ ∧ + BinaryInstructionArithmeticResult tapes op lhs rhs initialWork work ∧ + out = out₀) + (fun inp work out => + inp = inp₀ ∧ + DenseBinaryInstructionUpdateResult tapes op overlay address lhs rhs + initialWork work ∧ + out.HasBinaryPrefix + (emittedBits ++ + (DenseOverlay.write overlay address (op.eval lhs rhs)).flatMap + Entry.encode)) + (taggedEntryUpdateTime tapes.update overlay address (op.eval lhs rhs)) := by + rintro inp work out ⟨hinp, harith, hout⟩ + have hready' := denseArithmetic_update_ready tapes op overlay address lhs + rhs initialWork work hready hremaining hfound hresultCount harith + have hrun := taggedEntryUpdateTM_hoareTime_frame tapes.update overlay + address (op.eval lhs rhs) emittedBits work inp₀ out₀ hcanonical + hready'.1 harith.result hready'.2.1 hready'.2.2.1 hready'.2.2.2 + hinput houtput + obtain ⟨final, time, htime, hreach, hhalt, hfinalInput, + htagged, hfinalOutput⟩ := + hrun inp work out ⟨hinp, rfl, hout⟩ + exact ⟨final, time, htime, hreach, hhalt, hfinalInput, + ⟨work, harith, htagged⟩, hfinalOutput⟩ + have hall := TM.seqTM_hoareTime (binaryInstructionArithmeticTM tapes op) + (taggedEntryUpdateTM tapes.update) harithmetic + (by + rintro inp work out ⟨hinp, harith, hout⟩ + obtain ⟨hi, hw, ho⟩ := phaseTransition_of_parked + (inp := inp) (work := work) (out := out) + (by simpa [hinp] using hinput) harith.parked + (by simpa [hout] using hasBinaryPrefix_parked houtput) + rw [hi, hw, ho] + exact ⟨hinp, harith, hout⟩) + hupdate + simpa [denseBinaryInstructionUpdateTM, + denseBinaryInstructionUpdateTime] using hall + +/-- Two dense reads, direct destination synthesis, arithmetic, successor +tagging, and sparse update implement one RAM arithmetic instruction. -/ +theorem denseDirectBinaryInstructionTM_hoareTime_frame + (tapes : BinaryInstructionTapes n) (op : BinaryInstrOp) + (input : List Bool) (overlay : Store) + (destination source₀ source₁ : ℕ) (emittedBits : List Bool) + (initialWork : Fin n → Tape) (out₀ : Tape) + (hvalid : DenseOverlay.Valid overlay) + (hinitial : EntryLookupStaticReady tapes.lhsLookup overlay initialWork) + (hrhs₀ : (initialWork tapes.rhs).HasBinaryNat 0) + (hreplacement : (initialWork tapes.update.replacement).HasBinaryNat 0) + (htmp : (initialWork tapes.tmp).HasBinaryNat 0) + (hdbl : (initialWork tapes.dbl).HasBinaryNat 0) + (houtput : out₀.HasBinaryPrefix emittedBits) : + (denseDirectBinaryInstructionTM tapes op destination source₀ source₁).HoareTime + (fun inp work out => + inp = (Tape.init (input.map Γ.ofBool)).move Dir3.right ∧ + work = initialWork ∧ out = out₀) + (fun inp work out => + inp = (Tape.init (input.map Γ.ofBool)).move Dir3.right ∧ + DenseDirectBinaryInstructionResult tapes op input overlay destination + source₀ source₁ initialWork work ∧ + out.HasBinaryPrefix + (emittedBits ++ + (DenseOverlay.write overlay destination + (op.eval (DenseOverlay.read input overlay source₀) + (DenseOverlay.read input overlay source₁))).flatMap Entry.encode)) + (denseDirectBinaryInstructionTime tapes op input overlay destination + source₀ source₁) := by + let inp₀ := (Tape.init (input.map Γ.ofBool)).move Dir3.right + have hinput : TM.Parked inp₀ := by + refine ⟨by simp [inp₀, Tape.move], ?_⟩ + simpa [inp₀] using Tape.init_ofBool_move_right_cells_ne_start input + have houtputParked := hasBinaryPrefix_parked houtput + have hoperands := denseDirectBinaryOperands_hoareTime tapes input overlay + source₀ source₁ initialWork out₀ hvalid hinitial hrhs₀ houtputParked + have haddress : (TM.binaryAddConstTM tapes.update.entry.query + destination).HoareTime + (fun inp work out => + inp = inp₀ ∧ + DenseDirectBinaryOperandsResult tapes input overlay source₀ source₁ + initialWork work ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + DenseDirectBinaryAddressResult tapes input overlay destination source₀ + source₁ initialWork work ∧ out = out₀) + (TM.binaryAddConstTime destination 0) := by + rintro inp work out ⟨hinp, operands, hout⟩ + rcases operands with ⟨lhsWork, hlhsResult, hrhsResult⟩ + have hquery : (work tapes.update.entry.query).HasBinaryNat 0 := + ⟨hrhsResult.scanner.queryStart, by simpa using hrhsResult.scanner.query⟩ + have hrun := TM.binaryAddConstTM_hoareTime_frame + tapes.update.entry.query destination 0 inp work out hquery + (by simpa [hinp] using hinput) + (fun i _ => hrhsResult.parked i) + (by simpa [hout] using houtputParked) + obtain ⟨final, time, htime, hreach, hhalt, hfinalInput, + hfinalWork, hfinalOutput⟩ := hrun inp work out ⟨rfl, rfl, rfl⟩ + exact ⟨final, time, htime, hreach, hhalt, hfinalInput.trans hinp, + ⟨work, ⟨lhsWork, hlhsResult, hrhsResult⟩, + by simpa only [zero_add] using hfinalWork⟩, + hfinalOutput.trans hout⟩ + have hupdate : (denseBinaryInstructionUpdateTM tapes op).HoareTime + (fun inp work out => + inp = inp₀ ∧ + DenseDirectBinaryAddressResult tapes input overlay destination source₀ + source₁ initialWork work ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + DenseDirectBinaryInstructionResult tapes op input overlay destination + source₀ source₁ initialWork work ∧ + out.HasBinaryPrefix + (emittedBits ++ + (DenseOverlay.write overlay destination + (op.eval (DenseOverlay.read input overlay source₀) + (DenseOverlay.read input overlay source₁))).flatMap Entry.encode)) + (denseBinaryInstructionUpdateTime tapes op overlay destination + (DenseOverlay.read input overlay source₀) + (DenseOverlay.read input overlay source₁)) := by + rintro inp work out ⟨hinp, haddressResult, hout⟩ + have hready := denseDirectAddress_ready tapes input overlay destination + source₀ source₁ initialWork work hinitial hreplacement htmp hdbl + haddressResult + rcases hready with ⟨hscanner, hlhs, hrhs, hrepl, hshift, htmp', hdbl', + hremaining, hfound, hresultCount, hparked⟩ + have hrun := denseBinaryInstructionUpdateTM_hoareTime_frame tapes op + overlay destination (DenseOverlay.read input overlay source₀) + (DenseOverlay.read input overlay source₁) emittedBits work inp₀ out₀ + hvalid.1 hscanner hlhs hrhs hrepl hshift htmp' hdbl' hremaining hfound + hresultCount hinput hparked houtput + obtain ⟨final, time, htime, hreach, hhalt, hfinalInput, + hupdateResult, hfinalOutput⟩ := hrun inp work out ⟨hinp, rfl, hout⟩ + exact ⟨final, time, htime, hreach, hhalt, hfinalInput, + ⟨work, haddressResult, hupdateResult⟩, hfinalOutput⟩ + have haddressUpdate := TM.seqTM_hoareTime + (TM.binaryAddConstTM tapes.update.entry.query destination) + (denseBinaryInstructionUpdateTM tapes op) haddress + (by + rintro inp work out ⟨hinp, haddressResult, hout⟩ + have hready := denseDirectAddress_ready tapes input overlay destination + source₀ source₁ initialWork work hinitial hreplacement htmp hdbl + haddressResult + rcases hready with ⟨_, _, _, _, _, _, _, _, _, _, hparked⟩ + obtain ⟨hi, hw, ho⟩ := phaseTransition_of_parked + (inp := inp) (work := work) (out := out) + (by simpa [hinp] using hinput) + hparked + (by simpa [hout] using houtputParked) + rw [hi, hw, ho] + exact ⟨hinp, haddressResult, hout⟩) + hupdate + have hall := TM.seqTM_hoareTime + (TM.seqTM (denseOverlayLookupStaticTM tapes.lhsLookup source₀) + (denseOverlayLookupStaticTM tapes.rhsLookup source₁)) + (TM.seqTM (TM.binaryAddConstTM tapes.update.entry.query destination) + (denseBinaryInstructionUpdateTM tapes op)) hoperands + (by + rintro inp work out ⟨hinp, operands, hout⟩ + rcases operands with ⟨lhsWork, hlhsResult, hrhsResult⟩ + obtain ⟨hi, hw, ho⟩ := phaseTransition_of_parked + (inp := inp) (work := work) (out := out) + (by simpa [hinp] using hinput) hrhsResult.parked + (by simpa [hout] using houtputParked) + rw [hi, hw, ho] + exact ⟨hinp, ⟨lhsWork, hlhsResult, hrhsResult⟩, hout⟩) + haddressUpdate + simpa [denseDirectBinaryInstructionTM, denseDirectBinaryInstructionTime, + inp₀] using hall + +end Machine +end RegisterStore +end RAM +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseDispatch.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseDispatch.lean new file mode 100644 index 0000000000..d6fb561552 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseDispatch.lean @@ -0,0 +1,523 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.DenseSim +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.DenseOverlay +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Sim.Internal + +/-! +# Fixed-program dense-overlay dispatch +-/ + + +public section + +namespace Complexity +namespace RAM +namespace RegisterStore +namespace Machine + +variable {n : ℕ} + +private theorem hasBinaryNat_parked {t : Tape} {value : ℕ} + (h : t.HasBinaryNat value) : TM.Parked t := + ⟨by rw [h.2.1], h.2.hasBinaryContent.cells_ne_start⟩ + +private theorem denseInput_parked (input : List Bool) : + TM.Parked ((Tape.init (input.map Γ.ofBool)).move Dir3.right) := by + refine ⟨by simp [Tape.move], ?_⟩ + simpa using Tape.init_ofBool_move_right_cells_ne_start input + +private theorem blankOutput_parked : + TM.Parked ((Tape.init []).move Dir3.right) := by + refine ⟨by simp [Tape.move], ?_⟩ + intro j hj + simp [Tape.init, Tape.move] + omega + +private theorem phaseTransition_of_parked + {inp out : Tape} {work : Fin n → Tape} + (hinput : TM.Parked inp) (hwork : ∀ i, TM.Parked (work i)) + (houtput : TM.Parked out) : + TM.transitionInput inp = inp ∧ + (fun i => TM.transitionTape (work i)) = work ∧ + TM.transitionTape out = out := + TM.phaseTransition_eq_self_of_reads_ne_start hinput.read_ne_start + (fun i => (hwork i).read_ne_start) houtput.read_ne_start + +/-- The decrementing branch tree selects the corresponding dense instruction, +including the out-of-range halt convention. -/ +theorem denseDispatchProgramTM_hoareTime_frame + (tapes : ControlInstructionTapes n) (program : Program) + (input : List Bool) (overlay : Store) (pcValue selector : ℕ) + (cleanWork work₀ : Fin (n + 1) → Tape) + (hvalid : DenseOverlay.Valid overlay) + (hready : DispatchReady tapes overlay pcValue selector cleanWork work₀) : + (denseDispatchProgramTM tapes program).HoareTime + (fun inp work out => + inp = (Tape.init (input.map Γ.ofBool)).move Dir3.right ∧ + work = work₀ ∧ out = (Tape.init []).move Dir3.right) + (fun inp work out => + inp = (Tape.init (input.map Γ.ofBool)).move Dir3.right ∧ + DenseInstructionExecutionResult tapes input + (selectedInstruction program selector) pcValue overlay work ∧ + out = (Tape.init []).move Dir3.right) + (denseDispatchProgramTime tapes input overlay pcValue program + selector) := by + let inp₀ := (Tape.init (input.map Γ.ofBool)).move Dir3.right + let out₀ := (Tape.init []).move Dir3.right + have hinput : TM.Parked inp₀ := by + simpa only [inp₀] using denseInput_parked input + have houtput : TM.Parked out₀ := by + simpa only [out₀] using blankOutput_parked + induction program generalizing selector work₀ with + | nil => + let blankTape := (Tape.init []).move Dir3.right + have hselector : (work₀ tapes.liftedLhs).HasBinaryNat selector := by + rw [hready.2] + simp only [Function.update_self] + exact Tape.init_move_right_hasBinaryNat selector + have hcleanLhs : cleanWork tapes.liftedLhs = blankTape := by + have hzero := hready.1.control.lookup.destination + change (cleanWork tapes.liftedLhs).HasBinaryNat 0 at hzero + simpa only [blankTape] using + Tape.HasBinaryNat.eq_init_move_right hzero + have hwork₀Parked : ∀ i, TM.Parked (work₀ i) := by + intro i + rw [hready.2] + by_cases hi : i = tapes.liftedLhs + · subst i + simp only [Function.update_self] + exact hasBinaryNat_parked + (Tape.init_move_right_hasBinaryNat selector) + · simp only [Function.update_of_ne hi] + exact hready.1.control.lookup.scanner.parked i + have hreset := TM.resetBinaryWorkTM_hoareTime_frame tapes.liftedLhs + selector.bits 1 inp₀ work₀ out₀ + hselector.2.hasBinaryContent hselector.1 + ⟨by rw [hselector.2.1], by rw [hselector.2.1]⟩ + hinput (fun i _ => hwork₀Parked i) houtput + have hreset' : (TM.resetBinaryWorkTM tapes.liftedLhs).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ work = cleanWork ∧ out = out₀) + (TM.resetBinaryWorkTime 1 selector.bits.length) := by + apply hreset.consequence + · exact fun _ _ _ h => h + · rintro inp work out ⟨hinp, hworkEq, hout⟩ + refine ⟨hinp, ?_, hout⟩ + rw [hworkEq, hready.2, Function.update_idem] + change Function.update cleanWork tapes.liftedLhs blankTape = + cleanWork + rw [← hcleanLhs, Function.update_eq_self] + · exact le_rfl + have hhalt := denseExecuteInstructionTM_hoareTime_frame tapes input + .halt overlay pcValue cleanWork hvalid hready.1 + have hseq := TM.seqTM_hoareTime + (TM.resetBinaryWorkTM tapes.liftedLhs) + (denseExecuteInstructionTM tapes .halt) hreset' + (by + rintro inp work out ⟨hinp, hworkEq, hout⟩ + obtain ⟨hi, hw, ho⟩ := phaseTransition_of_parked + (inp := inp) (work := work) (out := out) + (by simpa [hinp] using hinput) + (by simpa [hworkEq] using + hready.1.control.lookup.scanner.parked) + (by simpa [hout] using houtput) + rw [hi, hw, ho] + exact ⟨hinp, hworkEq, hout⟩) + hhalt + simpa only [denseDispatchProgramTM, dispatchWithTM, + denseDispatchProgramTime, dispatchWithTime, + selectedInstruction, inp₀, out₀] using hseq + | cons instruction program ih => + let pre : TM.TapePred (n + 1) := fun inp work out => + inp = inp₀ ∧ work = work₀ ∧ out = out₀ + let post : TM.TapePred (n + 1) := fun inp work out => + inp = inp₀ ∧ + DenseInstructionExecutionResult tapes input + (selectedInstruction (instruction :: program) selector) + pcValue overlay work ∧ + out = out₀ + let blankPre : TM.TapePred (n + 1) := fun inp work out => + pre inp work out ∧ selector = 0 + let nonblankPre : TM.TapePred (n + 1) := fun inp work out => + pre inp work out ∧ selector ≠ 0 + have hselector : (work₀ tapes.liftedLhs).HasBinaryNat selector := by + rw [hready.2] + simp only [Function.update_self] + exact Tape.init_move_right_hasBinaryNat selector + have hwork₀Parked : ∀ i, TM.Parked (work₀ i) := by + intro i + rw [hready.2] + by_cases hi : i = tapes.liftedLhs + · subst i + simp only [Function.update_self] + exact hasBinaryNat_parked + (Tape.init_move_right_hasBinaryNat selector) + · simp only [Function.update_of_ne hi] + exact hready.1.control.lookup.scanner.parked i + have hblank : (denseExecuteInstructionTM tapes instruction).HoareTime + blankPre post + (denseExecuteInstructionTime tapes input instruction pcValue + overlay) := by + rintro inp work out ⟨⟨hinp, hworkEq, hout⟩, hzero⟩ + subst selector + have hcleanLhs := Tape.HasBinaryNat.eq_init_move_right + hready.1.control.lookup.destination + change cleanWork tapes.liftedLhs = + (Tape.init []).move Dir3.right at hcleanLhs + have hworkClean : work = cleanWork := by + rw [hworkEq, hready.2] + funext i + by_cases hi : i = tapes.liftedLhs + · subst i + simp only [Function.update_self] + exact hcleanLhs.symm + · simp only [Function.update_of_ne hi] + obtain ⟨final, time, htime, hreach, hhalt, hfinalInput, + hresult, hfinalOutput⟩ := + denseExecuteInstructionTM_hoareTime_frame tapes input instruction + overlay pcValue cleanWork hvalid hready.1 inp cleanWork out + ⟨hinp, rfl, hout⟩ + refine ⟨final, time, htime, ?_, hhalt, hfinalInput, ?_, + hfinalOutput⟩ + · simpa [hworkClean] using hreach + · simpa only [selectedInstruction] using hresult + have hnonblank : + (TM.seqTM (TM.binaryPredTM tapes.liftedLhs) + (denseDispatchProgramTM tapes program)).HoareTime + nonblankPre post + (TM.binaryPredTime (selector - 1) + 1 + + denseDispatchProgramTime tapes input overlay pcValue program + (selector - 1)) := by + rintro inp work out ⟨⟨hinp, hworkEq, hout⟩, hnonzero⟩ + have hsucc : selector = (selector - 1) + 1 := by omega + have hvalue : (work tapes.liftedLhs).HasBinaryNat + ((selector - 1) + 1) := by + rw [hworkEq] + rw [hsucc] at hselector + exact hselector + have hinpParked : TM.Parked inp := by simpa [hinp] using hinput + have houtParked : TM.Parked out := by simpa [hout] using houtput + have hworkParked : ∀ i, TM.Parked (work i) := by + intro i + simpa [hworkEq] using hwork₀Parked i + have hpred := TM.binaryPredTM_hoareTime_frame tapes.liftedLhs + (selector - 1) inp work out hvalue hinpParked.read_ne_start + (fun i _ => (hworkParked i).read_ne_start) + houtParked.read_ne_start + let nextWork := Function.update cleanWork tapes.liftedLhs + ((Tape.init ((selector - 1).bits.map Γ.ofBool)).move Dir3.right) + have hpred' : (TM.binaryPredTM tapes.liftedLhs).HoareTime + (fun inp' work' out' => + inp' = inp ∧ work' = work ∧ out' = out) + (fun inp' work' out' => + inp' = inp ∧ work' = nextWork ∧ out' = out) + (TM.binaryPredTime (selector - 1)) := by + apply hpred.consequence + · exact fun _ _ _ h => h + · rintro inp' work' out' ⟨hinp', hframe, hvalue', hout'⟩ + refine ⟨hinp', ?_, hout'⟩ + funext i + by_cases hi : i = tapes.liftedLhs + · subst i + simp only [nextWork, Function.update_self] + exact Tape.HasBinaryNat.eq_init_move_right hvalue' + · simp only [nextWork, Function.update_of_ne hi] + rw [hframe i hi, hworkEq, hready.2, + Function.update_of_ne hi] + · exact le_rfl + have hnextReady : DispatchReady tapes overlay pcValue + (selector - 1) cleanWork nextWork := ⟨hready.1, rfl⟩ + have hrecursive := ih (selector - 1) nextWork hnextReady + have hrecursive' : + (denseDispatchProgramTM tapes program).HoareTime + (fun inp' work' out' => + inp' = inp ∧ work' = nextWork ∧ out' = out) + post + (denseDispatchProgramTime tapes input overlay pcValue program + (selector - 1)) := by + apply hrecursive.consequence + · rintro inp' work' out' ⟨hinp', hwork', hout'⟩ + exact ⟨hinp'.trans hinp, hwork', hout'.trans hout⟩ + · rintro inp' work' out' ⟨hinp', hresult, hout'⟩ + have hselected : + selectedInstruction (instruction :: program) selector = + selectedInstruction program (selector - 1) := by + rw [hsucc] + rfl + exact ⟨hinp', by simpa only [hselected] using hresult, hout'⟩ + · exact le_rfl + have hseq := TM.seqTM_hoareTime + (TM.binaryPredTM tapes.liftedLhs) + (denseDispatchProgramTM tapes program) hpred' + (by + rintro inp' work' out' ⟨hinp', hwork', hout'⟩ + obtain ⟨hi, hw, ho⟩ := phaseTransition_of_parked + (inp := inp') (work := work') (out := out') + (by simpa [hinp', hinp] using hinput) + (by + intro i + rw [hwork'] + by_cases hidx : i = tapes.liftedLhs + · subst i + simp only [nextWork, Function.update_self] + exact hasBinaryNat_parked + (Tape.init_move_right_hasBinaryNat (selector - 1)) + · simp only [nextWork, Function.update_of_ne hidx] + exact hready.1.control.lookup.scanner.parked i) + (by simpa [hout', hout] using houtput) + rw [hi, hw, ho] + exact ⟨hinp', hwork', hout'⟩) + hrecursive' + exact hseq inp work out ⟨rfl, rfl, rfl⟩ + by_cases hzero : selector = 0 + · subst selector + intro inp work out hpre + obtain ⟨branchDone, time, htime, hreach, hhalt, hpost⟩ := + hblank inp work out ⟨hpre, rfl⟩ + have hread : (work tapes.liftedLhs).read = Γ.blank := by + rw [hpre.2.1] + exact hselector.read_eq_blank_iff.mpr rfl + have hinpRead : inp.read ≠ Γ.start := by + simpa [hpre.1] using hinput.read_ne_start + have hworkRead : ∀ i, (work i).read ≠ Γ.start := by + intro i + simpa [hpre.2.1] using (hwork₀Parked i).read_ne_start + have houtRead : out.read ≠ Γ.start := by + simp [hpre.2.2] + obtain ⟨done, hreach', hhalt', hdoneInput, hdoneWork, + hdoneOutput⟩ := + TM.branchWorkBlankTM_reachesIn_blank_frame tapes.liftedLhs + (denseExecuteInstructionTM tapes instruction) + (TM.seqTM (TM.binaryPredTM tapes.liftedLhs) + (denseDispatchProgramTM tapes program)) + inp work out hread hinpRead hworkRead houtRead hreach hhalt + refine ⟨done, time + 1, ?_, ?_, hhalt', ?_⟩ + · simpa only [denseDispatchProgramTime, dispatchWithTime] using + Nat.add_le_add_right htime 1 + · simpa only [denseDispatchProgramTM, dispatchWithTM] using hreach' + · rw [hdoneInput, hdoneWork, hdoneOutput] + exact hpost + · intro inp work out hpre + obtain ⟨branchDone, time, htime, hreach, hhalt, hpost⟩ := + hnonblank inp work out ⟨hpre, hzero⟩ + have hread : (work tapes.liftedLhs).read ≠ Γ.blank := by + intro hblankRead + apply hzero + exact hselector.read_eq_blank_iff.mp (by + simpa [hpre.2.1] using hblankRead) + have hinpRead : inp.read ≠ Γ.start := by + simpa [hpre.1] using hinput.read_ne_start + have hworkRead : ∀ i, (work i).read ≠ Γ.start := by + intro i + simpa [hpre.2.1] using (hwork₀Parked i).read_ne_start + have houtRead : out.read ≠ Γ.start := by + simp [hpre.2.2] + obtain ⟨done, hreach', hhalt', hdoneInput, hdoneWork, + hdoneOutput⟩ := + TM.branchWorkBlankTM_reachesIn_nonblank_frame tapes.liftedLhs + (denseExecuteInstructionTM tapes instruction) + (TM.seqTM (TM.binaryPredTM tapes.liftedLhs) + (denseDispatchProgramTM tapes program)) + inp work out hread hinpRead hworkRead houtRead hreach hhalt + refine ⟨done, time + 1, ?_, ?_, hhalt', ?_⟩ + · rw [show selector = selector - 1 + 1 by omega] + simpa only [denseDispatchProgramTime, dispatchWithTime] using + Nat.add_le_add_right htime 1 + · simpa only [denseDispatchProgramTM, dispatchWithTM] using hreach' + · rw [hdoneInput, hdoneWork, hdoneOutput] + exact hpost + +/-- Copy the canonical PC into dispatch scratch and execute the selected dense +instruction. -/ +theorem denseProgramInstructionTM_hoareTime_frame + (tapes : ControlInstructionTapes n) (program : Program) + (input : List Bool) (overlay : Store) (pcValue : ℕ) + (initialWork : Fin (n + 1) → Tape) + (hvalid : DenseOverlay.Valid overlay) + (hready : InstructionExecutionReady tapes overlay pcValue initialWork) : + (denseProgramInstructionTM tapes program).HoareTime + (fun inp work out => + inp = (Tape.init (input.map Γ.ofBool)).move Dir3.right ∧ + work = initialWork ∧ out = (Tape.init []).move Dir3.right) + (fun inp work out => + inp = (Tape.init (input.map Γ.ofBool)).move Dir3.right ∧ + DenseInstructionExecutionResult tapes input + (selectedInstruction program pcValue) pcValue overlay work ∧ + out = (Tape.init []).move Dir3.right) + (denseProgramInstructionTime tapes program input pcValue overlay) := by + let inp₀ := (Tape.init (input.map Γ.ofBool)).move Dir3.right + let out₀ := (Tape.init []).move Dir3.right + let selectorTape := + (Tape.init (pcValue.bits.map Γ.ofBool)).move Dir3.right + let selectorWork := + Function.update initialWork tapes.liftedLhs selectorTape + have hinput : TM.Parked inp₀ := by + simpa only [inp₀] using denseInput_parked input + have houtput : TM.Parked out₀ := by + simpa only [out₀] using blankOutput_parked + have hcopy := TM.binaryCopyIntoTM_hoareTime_frame tapes.liftedPC + tapes.liftedLhs tapes.liftedFound tapes.lifted.pc_ne_lhs + (tapes.lifted.pc_ne 11) (tapes.lifted.data.ne (by decide)) pcValue 0 + inp₀ initialWork out₀ hready.control.pc + hready.control.lookup.destination hready.control.lookup.copyScratch + hinput (fun i _ _ _ => hready.control.lookup.scanner.parked i) houtput + have hselectorReady : DispatchReady tapes overlay pcValue pcValue + initialWork selectorWork := ⟨hready, rfl⟩ + have hdispatch := denseDispatchProgramTM_hoareTime_frame tapes program + input overlay pcValue pcValue initialWork selectorWork hvalid + hselectorReady + have hselectorParked : ∀ i, TM.Parked (selectorWork i) := by + intro i + by_cases hi : i = tapes.liftedLhs + · subst i + simp only [selectorWork, Function.update_self] + exact hasBinaryNat_parked (Tape.init_move_right_hasBinaryNat pcValue) + · simp only [selectorWork, Function.update_of_ne hi] + exact hready.control.lookup.scanner.parked i + have hseq := TM.seqTM_hoareTime + (TM.binaryCopyIntoTM tapes.liftedPC tapes.liftedLhs tapes.liftedFound) + (denseDispatchProgramTM tapes program) hcopy + (by + rintro inp work out ⟨hinp, hworkEq, hout⟩ + have hinpParked : TM.Parked inp := by simpa [hinp] using hinput + have houtParked : TM.Parked out := by simpa [hout] using houtput + have hworkParked : ∀ i, TM.Parked (work i) := by + simpa [hworkEq, selectorWork, selectorTape] using hselectorParked + obtain ⟨hi, hw, ho⟩ := phaseTransition_of_parked + hinpParked hworkParked houtParked + rw [hi, hw, ho] + exact ⟨hinp, by simpa [selectorWork, selectorTape] using hworkEq, + hout⟩) + hdispatch + simpa only [denseProgramInstructionTM, denseProgramInstructionTime, + selectorWork, selectorTape, inp₀, out₀] using hseq + +/-- One fixed-program dense RAM step returns to the reusable clean ABI for the +exact successor overlay snapshot. -/ +theorem denseProgramStepTM_hoareTime_frame + (tapes : ControlInstructionTapes n) (program : Program) + (input : List Bool) (overlay : Store) (pcValue : ℕ) + (initialWork : Fin (n + 1) → Tape) + (hvalid : DenseOverlay.Valid overlay) + (hready : InstructionExecutionReady tapes overlay pcValue initialWork) : + (denseProgramStepTM tapes program).HoareTime + (fun inp work out => + inp = (Tape.init (input.map Γ.ofBool)).move Dir3.right ∧ + work = initialWork ∧ out = (Tape.init []).move Dir3.right) + (fun inp work out => + inp = (Tape.init (input.map Γ.ofBool)).move Dir3.right ∧ + InstructionExecutionReady tapes + (denseInstructionStore input + (selectedInstruction program pcValue) pcValue overlay) + (denseInstructionPC input + (selectedInstruction program pcValue) pcValue overlay) + work ∧ + out = (Tape.init []).move Dir3.right) + (denseProgramStepTime tapes program input pcValue overlay) := by + let inp₀ := (Tape.init (input.map Γ.ofBool)).move Dir3.right + let blank := (Tape.init []).move Dir3.right + let instruction := selectedInstruction program pcValue + let nextStore := denseInstructionStore input instruction pcValue overlay + let nextPC := denseInstructionPC input instruction pcValue overlay + let cleanupValues := + denseInstructionCleanupValue input instruction overlay + let remainingValue := denseInstructionRemainingValue instruction overlay + let sourceBound := + denseProgramStepSourceHeadBound tapes program input pcValue overlay + have hinput : TM.Parked inp₀ := by + simpa only [inp₀] using denseInput_parked input + have hprogram := denseProgramInstructionTM_hoareTime_frame tapes program + input overlay pcValue initialWork hvalid hready + have hprogramCleanup : + (denseProgramInstructionTM tapes program).HoareTime + (fun inp work out => + inp = inp₀ ∧ work = initialWork ∧ out = blank) + (fun inp work out => + inp = inp₀ ∧ + BufferedCleanupReady tapes overlay nextStore nextPC cleanupValues + remainingValue sourceBound work ∧ + out = blank) + (denseProgramInstructionTime tapes program input pcValue + overlay) := by + intro inp work out hpre + obtain ⟨c, time, htime, hreach, hhalt, hinp, hresult, hout⟩ := + hprogram inp work out (by simpa [inp₀, blank] using hpre) + have hsourceStart₀ : + (work tapes.liftedSource).cells 0 = Γ.start := by + simpa [hpre.2.1] using hready.control.lookup.sourceStart + have hsourceStart := TM.work_cells_zero_eq_start_of_reachesIn + tapes.liftedSource hreach hsourceStart₀ + have hbufferStart₀ : + (work tapes.buffer).cells 0 = Γ.start := by + rw [hpre.2.1, hready.buffer] + simp [Tape.move, Tape.init] + have hbufferStart := TM.work_cells_zero_eq_start_of_reachesIn + tapes.buffer hreach hbufferStart₀ + have hsourceHead := + (denseProgramInstructionTM tapes program).work_head_reachesIn_bound + hreach tapes.liftedSource + refine ⟨c, time, htime, hreach, hhalt, hinp, ?_, hout⟩ + refine + { nextCanonical := ?_ + result := ?_ + sourceStart := hsourceStart + bufferStart := hbufferStart + sourceHead := ?_ } + · simpa [nextStore, denseInstructionStore, instruction] using + DenseOverlay.Snapshot.stepInstr_canonical input instruction + { pc := pcValue, overlay := overlay } hvalid.1 + · simpa only [instruction, nextStore, nextPC, cleanupValues, + remainingValue] using hresult + · have hsourceHead₀ : (work tapes.liftedSource).head = 1 := by + simpa [hpre.2.1] using hready.control.lookup.sourceHead + rw [hsourceHead₀] at hsourceHead + simp only [sourceBound, denseProgramStepSourceHeadBound] + omega + have hcleanup : + (instructionCleanupTM tapes).HoareTime + (fun inp work out => + inp = inp₀ ∧ + BufferedCleanupReady tapes overlay nextStore nextPC cleanupValues + remainingValue sourceBound work ∧ + out = blank) + (fun inp work out => + inp = inp₀ ∧ + InstructionExecutionReady tapes nextStore nextPC work ∧ + out = blank) + (bufferedCleanupTime tapes overlay nextStore cleanupValues + remainingValue sourceBound) := by + intro inp work out hpre + have hcleanupWork := bufferedCleanupTM_hoareTime_frame_internal tapes + overlay nextStore nextPC cleanupValues remainingValue sourceBound work + inp₀ blank hpre.2.1 hinput blankOutput_parked + exact hcleanupWork inp work out ⟨hpre.1, rfl, hpre.2.2⟩ + have hseq := TM.seqTM_hoareTime + (denseProgramInstructionTM tapes program) (instructionCleanupTM tapes) + hprogramCleanup + (by + rintro inp work out ⟨hinp, hcleanupReady, hout⟩ + have hinpParked : TM.Parked inp := by simpa [hinp] using hinput + have houtParked : TM.Parked out := by + simpa [hout, blank] using blankOutput_parked + obtain ⟨hi, hw, ho⟩ := phaseTransition_of_parked hinpParked + hcleanupReady.result.parked houtParked + rw [hi, hw, ho] + exact ⟨hinp, hcleanupReady, hout⟩) + hcleanup + simpa only [denseProgramStepTM, denseProgramStepTime, instruction, + nextStore, nextPC, cleanupValues, remainingValue, sourceBound, inp₀, + blank] using hseq + +end Machine +end RegisterStore +end RAM +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseImm.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseImm.lean new file mode 100644 index 0000000000..d0a4ca5ebd --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseImm.lean @@ -0,0 +1,173 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.DenseDefs +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Immediate +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Tagged + +/-! +# Dense-overlay immediate instruction +-/ + + +public section + +namespace Complexity +namespace RAM +namespace RegisterStore +namespace Machine + +variable {n : ℕ} + +private theorem hasBinaryPrefix_parked {t : Tape} {bits : List Bool} + (h : t.HasBinaryPrefix bits) : TM.Parked t := by + refine ⟨by rw [h.1]; omega, ?_⟩ + intro j hj + obtain ⟨i, rfl⟩ : ∃ i, j = i + 1 := ⟨j - 1, by omega⟩ + by_cases hi : i < bits.length + · rw [h.2.1 i hi] + exact Γ.ofBool_ne_start _ + · rw [h.2.2 i (Nat.le_of_not_gt hi)] + decide + +private theorem phaseTransition_of_parked + {inp out : Tape} {work : Fin n → Tape} + (hinput : TM.Parked inp) (hwork : ∀ i, TM.Parked (work i)) + (houtput : TM.Parked out) : + TM.transitionInput inp = inp ∧ + (fun i => TM.transitionTape (work i)) = work ∧ + TM.transitionTape out = out := + TM.phaseTransition_eq_self_of_reads_ne_start hinput.read_ne_start + (fun i => (hwork i).read_ne_start) houtput.read_ne_start + +/-- Exact semantic and time contract for one immediate dense-overlay write. -/ +theorem denseImmediateInstructionTM_hoareTime_frame + (tapes : BinaryInstructionTapes n) (overlay : Store) + (destination value : ℕ) (emittedBits : List Bool) + (initialWork : Fin n → Tape) (inp₀ out₀ : Tape) + (hcanonical : Canonical overlay) + (hinitial : EntryLookupStaticReady tapes.lhsLookup overlay initialWork) + (hreplacement : (initialWork tapes.update.replacement).HasBinaryNat 0) + (hinput : TM.Parked inp₀) + (houtput : out₀.HasBinaryPrefix emittedBits) : + (denseImmediateInstructionTM tapes destination value).HoareTime + (fun inp work out => inp = inp₀ ∧ work = initialWork ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + DenseImmediateInstructionResult tapes overlay destination value + initialWork work ∧ + out.HasBinaryPrefix + (emittedBits ++ + (DenseOverlay.write overlay destination value).flatMap Entry.encode)) + (denseImmediateInstructionTime tapes overlay destination value) := by + let valueWork := Function.update initialWork tapes.update.replacement + ((Tape.init (value.bits.map Γ.ofBool)).move Dir3.right) + let updateWork := Function.update valueWork tapes.update.entry.query + ((Tape.init (destination.bits.map Γ.ofBool)).move Dir3.right) + have houtputParked := hasBinaryPrefix_parked houtput + have hvalue := TM.binaryAddConstTM_hoareTime_frame + tapes.update.replacement value 0 inp₀ initialWork out₀ hreplacement + hinput (fun i _ => hinitial.scanner.parked i) houtputParked + have hvalue' : (TM.binaryAddConstTM tapes.update.replacement value).HoareTime + (fun inp work out => inp = inp₀ ∧ work = initialWork ∧ out = out₀) + (fun inp work out => inp = inp₀ ∧ work = valueWork ∧ out = out₀) + (TM.binaryAddConstTime value 0) := by + simpa only [valueWork, zero_add] using hvalue + have hquery : (TM.binaryAddConstTM tapes.update.entry.query + destination).HoareTime + (fun inp work out => inp = inp₀ ∧ work = valueWork ∧ out = out₀) + (fun inp work out => inp = inp₀ ∧ work = updateWork ∧ out = out₀) + (TM.binaryAddConstTime destination 0) := by + have hqueryZero : (valueWork tapes.update.entry.query).HasBinaryNat 0 := by + have hqueryReplacement : + tapes.update.entry.query ≠ tapes.update.replacement := + tapes.update.ne (by decide) + rw [show valueWork tapes.update.entry.query = + initialWork tapes.update.entry.query by + exact Function.update_of_ne hqueryReplacement _ initialWork] + exact ⟨hinitial.scanner.queryStart, by simpa using hinitial.scanner.query⟩ + have hrun := TM.binaryAddConstTM_hoareTime_frame + tapes.update.entry.query destination 0 inp₀ valueWork out₀ hqueryZero + hinput + (fun i _ => by + by_cases hi : i = tapes.update.replacement + · subst i + have hnat := Tape.init_move_right_hasBinaryNat value + simpa only [valueWork, Function.update_self] using + (show TM.Parked + ((Tape.init (value.bits.map Γ.ofBool)).move Dir3.right) from + ⟨by rw [hnat.2.1], + hnat.2.hasBinaryContent.cells_ne_start⟩) + · simpa only [valueWork, Function.update_of_ne hi] using + hinitial.scanner.parked i) + houtputParked + simpa only [updateWork, zero_add] using hrun + have hready := immediateUpdate_ready_internal tapes overlay destination value + initialWork hinitial + have hupdate := taggedEntryUpdateTM_hoareTime_frame tapes.update overlay + destination value emittedBits updateWork inp₀ out₀ hcanonical hready.1 + hready.2.1 hready.2.2.1 hready.2.2.2.1 hready.2.2.2.2.1 hinput houtput + have hupdate' : (taggedEntryUpdateTM tapes.update).HoareTime + (fun inp work out => inp = inp₀ ∧ work = updateWork ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + DenseImmediateInstructionResult tapes overlay destination value + initialWork work ∧ + out.HasBinaryPrefix + (emittedBits ++ + (DenseOverlay.write overlay destination value).flatMap Entry.encode)) + (taggedEntryUpdateTime tapes.update overlay destination value) := + hupdate.strengthen_post (by + rintro inp work out ⟨hinp, houtcome, hout⟩ + exact ⟨hinp, ⟨valueWork, updateWork, rfl, rfl, houtcome⟩, hout⟩) + have hqueryUpdate := TM.seqTM_hoareTime + (TM.binaryAddConstTM tapes.update.entry.query destination) + (taggedEntryUpdateTM tapes.update) hquery + (by + rintro inp work out ⟨hinp, hwork, hout⟩ + subst work + obtain ⟨hi, hw, ho⟩ := phaseTransition_of_parked + (inp := inp) (work := updateWork) (out := out) + (by simpa [hinp] using hinput) hready.2.2.2.2.2 + (by simpa [hout] using houtputParked) + rw [hi, hw, ho] + exact ⟨hinp, rfl, hout⟩) + hupdate' + have hall := TM.seqTM_hoareTime + (TM.binaryAddConstTM tapes.update.replacement value) + (TM.seqTM (TM.binaryAddConstTM tapes.update.entry.query destination) + (taggedEntryUpdateTM tapes.update)) hvalue' + (by + rintro inp work out ⟨hinp, hwork, hout⟩ + subst work + have hparked : ∀ i, TM.Parked (valueWork i) := by + intro i + by_cases hi : i = tapes.update.replacement + · subst i + have hnat := Tape.init_move_right_hasBinaryNat value + simpa only [valueWork, Function.update_self] using + (show TM.Parked + ((Tape.init (value.bits.map Γ.ofBool)).move Dir3.right) from + ⟨by rw [hnat.2.1], hnat.2.hasBinaryContent.cells_ne_start⟩) + · simpa only [valueWork, Function.update_of_ne hi] using + hinitial.scanner.parked i + obtain ⟨hi, hw, ho⟩ := phaseTransition_of_parked + (inp := inp) (work := valueWork) (out := out) + (by simpa [hinp] using hinput) hparked + (by simpa [hout] using houtputParked) + rw [hi, hw, ho] + exact ⟨hinp, rfl, hout⟩) + hqueryUpdate + simpa [denseImmediateInstructionTM, denseImmediateInstructionTime] using hall + +end Machine +end RegisterStore +end RAM +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseLoad.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseLoad.lean new file mode 100644 index 0000000000..0d4417ff26 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseLoad.lean @@ -0,0 +1,365 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.DenseDefs +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Load +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Tagged +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.DenseInternal + +/-! +# Dense-overlay indirect load +-/ + + +public section + +namespace Complexity +namespace RAM +namespace RegisterStore +namespace Machine + +variable {n : ℕ} + +private theorem hasBinaryPrefix_parked {t : Tape} {bits : List Bool} + (h : t.HasBinaryPrefix bits) : TM.Parked t := by + refine ⟨by rw [h.1]; omega, ?_⟩ + intro j hj + obtain ⟨i, rfl⟩ : ∃ i, j = i + 1 := ⟨j - 1, by omega⟩ + by_cases hi : i < bits.length + · rw [h.2.1 i hi] + exact Γ.ofBool_ne_start _ + · rw [h.2.2 i (Nat.le_of_not_gt hi)] + decide + +private theorem phaseTransition_of_parked + {inp out : Tape} {work : Fin n → Tape} + (hinput : TM.Parked inp) (hwork : ∀ i, TM.Parked (work i)) + (houtput : TM.Parked out) : + TM.transitionInput inp = inp ∧ + (fun i => TM.transitionTape (work i)) = work ∧ + TM.transitionTape out = out := + TM.phaseTransition_eq_self_of_reads_ne_start hinput.read_ne_start + (fun i => (hwork i).read_ne_start) houtput.read_ne_start + +private theorem denseScanner_indirect_of_lhs + (tapes : BinaryInstructionTapes n) (input : List Bool) + (overlay : Store) (source : ℕ) + (initialWork finalWork : Fin n → Tape) + (hlookup : DenseOverlayLookupStaticResult tapes.lhsLookup input overlay + source initialWork finalWork) : + EntryScanReady tapes.indirectLoadLookup.scan.entry + (overlay.flatMap Entry.encode) [] finalWork finalWork := + { source := hlookup.scanner.source + address := hlookup.scanner.address + addressStart := hlookup.scanner.addressStart + value := hlookup.scanner.value + valueStart := hlookup.scanner.valueStart + addressCounter := hlookup.scanner.addressCounter + addressWidth := hlookup.scanner.addressWidth + valueCounter := hlookup.scanner.valueCounter + valueWidth := hlookup.scanner.valueWidth + query := hlookup.scanner.query + queryStart := hlookup.scanner.queryStart + result := hlookup.scanner.result + resultStart := hlookup.scanner.resultStart + parked := hlookup.parked + frame := by intro i _ _ _ _ _ _ _ _ _; rfl } + +private theorem denseIndirectLoaded_ready + (tapes : BinaryInstructionTapes n) (input : List Bool) + (overlay : Store) (addressRegister : ℕ) + (initialWork addressWork : Fin n → Tape) + (hinitial : EntryLookupStaticReady tapes.lhsLookup overlay initialWork) + (hreplacement : (initialWork tapes.update.replacement).HasBinaryNat 0) + (haddress : DenseOverlayLookupStaticResult tapes.lhsLookup input overlay + addressRegister initialWork addressWork) : + EntryLookupRestoreReady tapes.indirectLoadLookup overlay + (DenseOverlay.read input overlay addressRegister) addressWork := by + have hreplacementEq : addressWork tapes.update.replacement = + initialWork tapes.update.replacement := + haddress.frame tapes.update.replacement + (fun slot => (tapes.lhsLookup_ne_replacement slot).symm) + have hcountSource : + (addressWork tapes.update.resultCount).HasBinaryNat overlay.length := by + rw [show addressWork tapes.update.resultCount = + initialWork tapes.update.resultCount by simpa using haddress.countSource] + simpa using hinitial.countSource + refine + { scanner := denseScanner_indirect_of_lhs tapes input overlay + addressRegister initialWork addressWork haddress + sourceStart := haddress.sourceStart + sourceHead := haddress.sourceHead + count := by simpa using haddress.count + countSource := by simpa using hcountSource + querySource := by simpa using haddress.destination + destination := ?_ + copyScratch := by simpa using haddress.copyScratch } + change (addressWork tapes.update.replacement).HasBinaryNat 0 + rw [hreplacementEq] + exact hreplacement + +/-- One static dense-overlay address read followed by a loaded dense-overlay +read leaves the indirect value in the update replacement tape. -/ +private theorem denseIndirectReads_hoareTime + (tapes : BinaryInstructionTapes n) (input : List Bool) + (overlay : Store) (addressRegister : ℕ) + (initialWork : Fin n → Tape) (out₀ : Tape) + (hvalid : DenseOverlay.Valid overlay) + (hinitial : EntryLookupStaticReady tapes.lhsLookup overlay initialWork) + (hreplacement : (initialWork tapes.update.replacement).HasBinaryNat 0) + (houtput : TM.Parked out₀) : + (TM.seqTM (denseOverlayLookupStaticTM tapes.lhsLookup addressRegister) + (denseOverlayLookupTM tapes.indirectLoadLookup)).HoareTime + (fun inp work out => + inp = (Tape.init (input.map Γ.ofBool)).move Dir3.right ∧ + work = initialWork ∧ out = out₀) + (fun inp work out => + inp = (Tape.init (input.map Γ.ofBool)).move Dir3.right ∧ + (∃ addressWork, + DenseOverlayLookupStaticResult tapes.lhsLookup input overlay + addressRegister initialWork addressWork ∧ + DenseOverlayLookupResult tapes.indirectLoadLookup input overlay + (DenseOverlay.read input overlay addressRegister) addressWork work) ∧ + out = out₀) + (denseOverlayLookupStaticTime tapes.lhsLookup input.length overlay + addressRegister + 1 + + denseOverlayLookupTime tapes.indirectLoadLookup input.length overlay + (DenseOverlay.read input overlay addressRegister)) := by + let inp₀ := (Tape.init (input.map Γ.ofBool)).move Dir3.right + have hinput : TM.Parked inp₀ := by + refine ⟨by simp [inp₀, Tape.move], ?_⟩ + simpa [inp₀] using Tape.init_ofBool_move_right_cells_ne_start input + have haddress := denseOverlayLookupStaticTM_hoareTime_internal + tapes.lhsLookup input overlay addressRegister initialWork out₀ hvalid + hinitial houtput + have hloaded : (denseOverlayLookupTM tapes.indirectLoadLookup).HoareTime + (fun inp work out => + inp = inp₀ ∧ + DenseOverlayLookupStaticResult tapes.lhsLookup input overlay + addressRegister initialWork work ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + (∃ addressWork, + DenseOverlayLookupStaticResult tapes.lhsLookup input overlay + addressRegister initialWork addressWork ∧ + DenseOverlayLookupResult tapes.indirectLoadLookup input overlay + (DenseOverlay.read input overlay addressRegister) addressWork work) ∧ + out = out₀) + (denseOverlayLookupTime tapes.indirectLoadLookup input.length overlay + (DenseOverlay.read input overlay addressRegister)) := by + rintro inp work out ⟨hinp, haddressResult, hout⟩ + have hready := denseIndirectLoaded_ready tapes input overlay addressRegister + initialWork work hinitial hreplacement haddressResult + have hrun := denseOverlayLookupTM_hoareTime_internal + tapes.indirectLoadLookup input overlay + (DenseOverlay.read input overlay addressRegister) work out₀ hvalid hready + houtput + obtain ⟨final, time, htime, hreach, hhalt, hfinalInput, + hloadedResult, hfinalOutput⟩ := + hrun inp work out ⟨hinp, rfl, hout⟩ + exact ⟨final, time, htime, hreach, hhalt, hfinalInput, + ⟨work, haddressResult, hloadedResult⟩, hfinalOutput⟩ + have hall := TM.seqTM_hoareTime + (denseOverlayLookupStaticTM tapes.lhsLookup addressRegister) + (denseOverlayLookupTM tapes.indirectLoadLookup) haddress + (by + rintro inp work out ⟨hinp, haddressResult, hout⟩ + obtain ⟨hi, hw, ho⟩ := phaseTransition_of_parked + (inp := inp) (work := work) (out := out) + (by simpa [inp₀, hinp] using hinput) haddressResult.parked + (by simpa [hout] using houtput) + rw [hi, hw, ho] + exact ⟨hinp, haddressResult, hout⟩) + hloaded + simpa only [inp₀] using hall + +/-- Exact semantic and time contract for one dense-overlay indirect load. -/ +theorem denseIndirectLoadInstructionTM_hoareTime_frame + (tapes : BinaryInstructionTapes n) (input : List Bool) + (overlay : Store) (destination addressRegister : ℕ) + (emittedBits : List Bool) (initialWork : Fin n → Tape) (out₀ : Tape) + (hvalid : DenseOverlay.Valid overlay) + (hinitial : EntryLookupStaticReady tapes.lhsLookup overlay initialWork) + (hreplacement : (initialWork tapes.update.replacement).HasBinaryNat 0) + (houtput : out₀.HasBinaryPrefix emittedBits) : + (denseIndirectLoadInstructionTM tapes destination addressRegister).HoareTime + (fun inp work out => + inp = (Tape.init (input.map Γ.ofBool)).move Dir3.right ∧ + work = initialWork ∧ out = out₀) + (fun inp work out => + inp = (Tape.init (input.map Γ.ofBool)).move Dir3.right ∧ + DenseIndirectLoadInstructionResult tapes input overlay destination + addressRegister initialWork work ∧ + out.HasBinaryPrefix + (emittedBits ++ + (DenseOverlay.write overlay destination + (DenseOverlay.read input overlay + (DenseOverlay.read input overlay addressRegister))).flatMap + Entry.encode)) + (denseIndirectLoadInstructionTime tapes input overlay destination + addressRegister) := by + let inp₀ := (Tape.init (input.map Γ.ofBool)).move Dir3.right + have hinput : TM.Parked inp₀ := by + refine ⟨by simp [inp₀, Tape.move], ?_⟩ + simpa [inp₀] using Tape.init_ofBool_move_right_cells_ne_start input + have houtputParked := hasBinaryPrefix_parked houtput + have hreads := denseIndirectReads_hoareTime tapes input overlay + addressRegister initialWork out₀ hvalid hinitial hreplacement houtputParked + have hquery : (TM.binaryAddConstTM tapes.update.entry.query + destination).HoareTime + (fun inp work out => + inp = inp₀ ∧ + (∃ addressWork, + DenseOverlayLookupStaticResult tapes.lhsLookup input overlay + addressRegister initialWork addressWork ∧ + DenseOverlayLookupResult tapes.indirectLoadLookup input overlay + (DenseOverlay.read input overlay addressRegister) addressWork work) ∧ + out = out₀) + (fun inp work out => + inp = inp₀ ∧ + (∃ addressWork loadedWork, + DenseOverlayLookupStaticResult tapes.lhsLookup input overlay + addressRegister initialWork addressWork ∧ + DenseOverlayLookupResult tapes.indirectLoadLookup input overlay + (DenseOverlay.read input overlay addressRegister) addressWork + loadedWork ∧ + work = Function.update loadedWork tapes.update.entry.query + ((Tape.init (destination.bits.map Γ.ofBool)).move Dir3.right)) ∧ + out = out₀) + (TM.binaryAddConstTime destination 0) := by + rintro inp work out ⟨hinp, ⟨addressWork, haddressResult, + hloadedResult⟩, hout⟩ + have hqueryZero : (work tapes.update.entry.query).HasBinaryNat 0 := + ⟨hloadedResult.scanner.queryStart, by + simpa using hloadedResult.scanner.query⟩ + have hrun := TM.binaryAddConstTM_hoareTime_frame + tapes.update.entry.query destination 0 inp work out hqueryZero + (by simpa [hinp] using hinput) + (fun i _ => hloadedResult.parked i) + (by simpa [hout] using houtputParked) + obtain ⟨final, time, htime, hreach, hhalt, hfinalInput, + hfinalWork, hfinalOutput⟩ := hrun inp work out ⟨rfl, rfl, rfl⟩ + exact ⟨final, time, htime, hreach, hhalt, hfinalInput.trans hinp, + ⟨addressWork, work, haddressResult, hloadedResult, + by simpa only [zero_add] using hfinalWork⟩, + hfinalOutput.trans hout⟩ + have hupdate : (taggedEntryUpdateTM tapes.update).HoareTime + (fun inp work out => + inp = inp₀ ∧ + (∃ addressWork loadedWork, + DenseOverlayLookupStaticResult tapes.lhsLookup input overlay + addressRegister initialWork addressWork ∧ + DenseOverlayLookupResult tapes.indirectLoadLookup input overlay + (DenseOverlay.read input overlay addressRegister) addressWork + loadedWork ∧ + work = Function.update loadedWork tapes.update.entry.query + ((Tape.init (destination.bits.map Γ.ofBool)).move Dir3.right)) ∧ + out = out₀) + (fun inp work out => + inp = inp₀ ∧ + DenseIndirectLoadInstructionResult tapes input overlay destination + addressRegister initialWork work ∧ + out.HasBinaryPrefix + (emittedBits ++ + (DenseOverlay.write overlay destination + (DenseOverlay.read input overlay + (DenseOverlay.read input overlay addressRegister))).flatMap + Entry.encode)) + (taggedEntryUpdateTime tapes.update overlay destination + (DenseOverlay.read input overlay + (DenseOverlay.read input overlay addressRegister))) := by + rintro inp work out ⟨hinp, ⟨addressWork, loadedWork, haddressResult, + hloadedResult, hwork⟩, hout⟩ + subst work + let updateWork := Function.update loadedWork tapes.update.entry.query + ((Tape.init (destination.bits.map Γ.ofBool)).move Dir3.right) + have hscanner := scanner_updateQuery_of_indirect_internal tapes overlay + destination loadedWork hloadedResult.scanner + have hreplacementNe : + tapes.update.replacement ≠ tapes.update.entry.query := + tapes.update.ne (by decide) + have hremainingNe : tapes.update.remaining ≠ tapes.update.entry.query := + tapes.update.ne (by decide) + have hfoundNe : tapes.update.found ≠ tapes.update.entry.query := + tapes.update.ne (by decide) + have hresultCountNe : + tapes.update.resultCount ≠ tapes.update.entry.query := + tapes.update.ne (by decide) + have hresultCount : + (loadedWork tapes.update.resultCount).HasBinaryNat overlay.length := by + rw [show loadedWork tapes.update.resultCount = + addressWork tapes.update.resultCount by + simpa using hloadedResult.countSource] + rw [show addressWork tapes.update.resultCount = + initialWork tapes.update.resultCount by + simpa using haddressResult.countSource] + simpa using hinitial.countSource + have hrun := taggedEntryUpdateTM_hoareTime_frame tapes.update overlay + destination + (DenseOverlay.read input overlay + (DenseOverlay.read input overlay addressRegister)) + emittedBits updateWork inp₀ out₀ hvalid.1 hscanner + (by simpa only [updateWork, Function.update_of_ne hreplacementNe] using + hloadedResult.value) + (by simpa only [updateWork, Function.update_of_ne hremainingNe] using + hloadedResult.count) + (by simpa only [updateWork, Function.update_of_ne hfoundNe] using + hloadedResult.copyScratch) + (by simpa only [updateWork, Function.update_of_ne hresultCountNe] using + hresultCount) + hinput houtput + obtain ⟨final, time, htime, hreach, hhalt, hfinalInput, + hupdateResult, hfinalOutput⟩ := + hrun inp updateWork out ⟨hinp, rfl, hout⟩ + exact ⟨final, time, htime, hreach, hhalt, hfinalInput, + ⟨addressWork, loadedWork, updateWork, haddressResult, hloadedResult, + rfl, hupdateResult⟩, hfinalOutput⟩ + have hqueryUpdate := TM.seqTM_hoareTime + (TM.binaryAddConstTM tapes.update.entry.query destination) + (taggedEntryUpdateTM tapes.update) hquery + (by + rintro inp work out ⟨hinp, ⟨addressWork, loadedWork, haddressResult, + hloadedResult, hwork⟩, hout⟩ + subst work + have hparked := (scanner_updateQuery_of_indirect_internal tapes overlay + destination loadedWork hloadedResult.scanner).parked + obtain ⟨hi, hw, ho⟩ := phaseTransition_of_parked + (inp := inp) + (work := Function.update loadedWork tapes.update.entry.query + ((Tape.init (destination.bits.map Γ.ofBool)).move Dir3.right)) + (out := out) (by simpa [hinp] using hinput) hparked + (by simpa [hout] using houtputParked) + rw [hi, hw, ho] + exact ⟨hinp, ⟨addressWork, loadedWork, haddressResult, + hloadedResult, rfl⟩, hout⟩) + hupdate + have hall := TM.seqTM_hoareTime + (TM.seqTM (denseOverlayLookupStaticTM tapes.lhsLookup addressRegister) + (denseOverlayLookupTM tapes.indirectLoadLookup)) + (TM.seqTM (TM.binaryAddConstTM tapes.update.entry.query destination) + (taggedEntryUpdateTM tapes.update)) hreads + (by + rintro inp work out ⟨hinp, ⟨addressWork, haddressResult, + hloadedResult⟩, hout⟩ + obtain ⟨hi, hw, ho⟩ := phaseTransition_of_parked + (inp := inp) (work := work) (out := out) + (by simpa [hinp] using hinput) hloadedResult.parked + (by simpa [hout] using houtputParked) + rw [hi, hw, ho] + exact ⟨hinp, ⟨addressWork, haddressResult, hloadedResult⟩, hout⟩) + hqueryUpdate + simpa [denseIndirectLoadInstructionTM, denseIndirectLoadInstructionTime, + inp₀] using hall + +end Machine +end RegisterStore +end RAM +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseSim.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseSim.lean new file mode 100644 index 0000000000..196ae385ee --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseSim.lean @@ -0,0 +1,76 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.DenseCtrlSim +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.DenseSimData + +/-! +# Dense-overlay instruction simulation +-/ + + +public section + +namespace Complexity +namespace RAM +namespace RegisterStore +namespace Machine + +/-- Every statically selected RAM instruction realizes the common dense +buffered snapshot-step contract. -/ +theorem denseExecuteInstructionTM_hoareTime_frame {n : ℕ} + (tapes : ControlInstructionTapes n) (input : List Bool) + (instruction : Instr) (overlay : Store) (pcValue : ℕ) + (initialWork : Fin (n + 1) → Tape) + (hvalid : DenseOverlay.Valid overlay) + (hready : InstructionExecutionReady tapes overlay pcValue initialWork) : + (denseExecuteInstructionTM tapes instruction).HoareTime + (fun inp work out => + inp = (Tape.init (input.map Γ.ofBool)).move Dir3.right ∧ + work = initialWork ∧ out = (Tape.init []).move Dir3.right) + (fun inp work out => + inp = (Tape.init (input.map Γ.ofBool)).move Dir3.right ∧ + DenseInstructionExecutionResult tapes input instruction pcValue + overlay work ∧ + out = (Tape.init []).move Dir3.right) + (denseExecuteInstructionTime tapes input instruction pcValue + overlay) := by + cases instruction with + | imm destination value => + exact denseExecuteInstructionTM_imm_hoareTime_frame tapes input overlay + pcValue destination value initialWork hvalid hready + | add destination source₀ source₁ => + exact denseExecuteInstructionTM_add_hoareTime_frame tapes input overlay + pcValue destination source₀ source₁ initialWork hvalid hready + | sub destination source₀ source₁ => + exact denseExecuteInstructionTM_sub_hoareTime_frame tapes input overlay + pcValue destination source₀ source₁ initialWork hvalid hready + | mul destination source₀ source₁ => + exact denseExecuteInstructionTM_mul_hoareTime_frame tapes input overlay + pcValue destination source₀ source₁ initialWork hvalid hready + | load destination addressRegister => + exact denseExecuteInstructionTM_load_hoareTime_frame tapes input overlay + pcValue destination addressRegister initialWork hvalid hready + | store addressRegister source => + exact denseExecuteInstructionTM_store_hoareTime_frame tapes input overlay + pcValue addressRegister source initialWork hvalid hready + | jz source target => + exact denseExecuteInstructionTM_jz_hoareTime_frame tapes input overlay + pcValue source target initialWork hvalid hready + | jmp target => + exact denseExecuteInstructionTM_jmp_hoareTime_frame tapes input overlay + pcValue target initialWork hready + | halt => + exact denseExecuteInstructionTM_halt_hoareTime_frame tapes input overlay + pcValue initialWork hready + +end Machine +end RegisterStore +end RAM +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseSimData.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseSimData.lean new file mode 100644 index 0000000000..8513e6498a --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseSimData.lean @@ -0,0 +1,991 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.DenseSimDefs +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Sim.Data +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.DenseImm +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.DenseLoad +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.DenseStore + +/-! +# Dense-overlay data-instruction simulation +-/ + + +public section + +namespace Complexity +namespace RAM +namespace RegisterStore +namespace Machine + +variable {n : ℕ} + +/-- A dense immediate write produces the generic buffered endpoint and advances +the program counter. -/ +theorem denseExecuteInstructionTM_imm_hoareTime_frame + (tapes : ControlInstructionTapes n) (input : List Bool) + (overlay : Store) (pcValue destination value : ℕ) + (initialWork : Fin (n + 1) → Tape) + (hvalid : DenseOverlay.Valid overlay) + (hready : InstructionExecutionReady tapes overlay pcValue initialWork) : + (denseExecuteInstructionTM tapes (.imm destination value)).HoareTime + (fun inp work out => + inp = (Tape.init (input.map Γ.ofBool)).move Dir3.right ∧ + work = initialWork ∧ out = (Tape.init []).move Dir3.right) + (fun inp work out => + inp = (Tape.init (input.map Γ.ofBool)).move Dir3.right ∧ + DenseInstructionExecutionResult tapes input (.imm destination value) + pcValue overlay work ∧ + out = (Tape.init []).move Dir3.right) + (denseExecuteInstructionTime tapes input (.imm destination value) + pcValue overlay) := by + let inp₀ := (Tape.init (input.map Γ.ofBool)).move Dir3.right + let baseWork : Fin n → Tape := fun i => initialWork (Fin.castSucc i) + let nextStore := DenseOverlay.write overlay destination value + let cleanupValues := + denseInstructionCleanupValue input (.imm destination value) overlay + have hinput : TM.Parked inp₀ := by + refine ⟨by simp [inp₀, Tape.move], ?_⟩ + simpa [inp₀] using Tape.init_ofBool_move_right_cells_ne_start input + have hlookup : EntryLookupStaticReady tapes.data.lhsLookup overlay + baseWork := + instructionExecutionReady_baseLookup_internal tapes overlay pcValue + initialWork hready + have hreplacement : + (baseWork tapes.data.update.replacement).HasBinaryNat 0 := + hready.replacement + have hbuffer : (initialWork tapes.buffer).HasBinaryPrefix [] := by + rw [hready.buffer] + exact Tape.init_nil_move_right_hasBinaryPrefix_nil + have hbaseRaw := denseImmediateInstructionTM_hoareTime_frame tapes.data + overlay destination value [] baseWork inp₀ (initialWork tapes.buffer) + hvalid.1 hlookup hreplacement hinput hbuffer + let Result : (Fin n → Tape) → Prop := fun work => + DenseImmediateInstructionResult tapes.data overlay destination value + baseWork work + have hbase : (denseImmediateInstructionTM tapes.data destination value).HoareTime + (fun inp work out => + inp = inp₀ ∧ work = baseWork ∧ out = initialWork tapes.buffer) + (fun inp work out => + inp = inp₀ ∧ Result work ∧ + out.HasBinaryPrefix (nextStore.flatMap Entry.encode)) + (denseImmediateInstructionTime tapes.data overlay destination value) := by + simpa [Result, nextStore] using hbaseRaw + have hresult : ∀ work, Result work → + work tapes.pc = initialWork (Fin.castSucc tapes.pc) ∧ + (work tapes.data.update.resultCount).HasBinaryNat nextStore.length ∧ + (work tapes.data.update.entry.source).HasBinaryContent + (overlay.flatMap Entry.encode) ∧ + (∀ slot, + (work (tapes.data.idx (instructionCleanupParentSlot slot))).HasBinaryNat + (cleanupValues slot)) ∧ + (work tapes.data.update.remaining).HasBinaryNat 0 ∧ + EntryScanReady tapes.data.update.entry [] (cleanupValues 0).bits + work work ∧ + (work tapes.data.shift).HasBinaryNat 0 ∧ + (work tapes.data.tmp).HasBinaryNat 0 ∧ + (work tapes.data.dbl).HasBinaryNat 0 ∧ + ∀ i, TM.Parked (work i) := by + intro work hsemantic + obtain ⟨valueWork, updateWork, hvalueWork, hupdateWork, + taggedWork, htagValue, htagFrame, houtcome, hsourceCells⟩ := hsemantic + have hpc : work tapes.pc = baseWork tapes.pc := by + have hpcQuery : + tapes.pc ≠ tapes.data.update.entry.query := tapes.pc_ne 7 + have hpcReplacement : + tapes.pc ≠ tapes.data.update.replacement := tapes.pc_ne 10 + calc + work tapes.pc = taggedWork tapes.pc := + houtcome.frame tapes.pc (fun slot => by + exact tapes.pc_ne ⟨slot, by omega⟩) + _ = updateWork tapes.pc := + htagFrame tapes.pc (tapes.pc_ne 10) + _ = valueWork tapes.pc := by + rw [hupdateWork, Function.update_of_ne hpcQuery] + _ = baseWork tapes.pc := by + rw [hvalueWork, Function.update_of_ne hpcReplacement] + have hsourceContent : + (work tapes.data.update.entry.source).HasBinaryContent + (overlay.flatMap Entry.encode) := by + have hcells : (work tapes.data.update.entry.source).cells = + (baseWork tapes.data.update.entry.source).cells := by + calc + (work tapes.data.update.entry.source).cells = + (updateWork tapes.data.update.entry.source).cells := hsourceCells + _ = (valueWork tapes.data.update.entry.source).cells := by + congr 1 + rw [hupdateWork] + exact Function.update_of_ne + (tapes.data.update.ne (by decide)) _ _ + _ = (baseWork tapes.data.update.entry.source).cells := by + congr 1 + rw [hvalueWork] + exact Function.update_of_ne + (tapes.data.update.ne (by decide)) _ _ + unfold Tape.HasBinaryContent + rw [hcells] + exact hready.sourceContent + have hcleanup : ∀ slot, + (work (tapes.data.idx (instructionCleanupParentSlot slot))).HasBinaryNat + (cleanupValues slot) := by + intro slot + fin_cases slot + · exact ⟨houtcome.ready.queryStart, by + simpa [cleanupValues, denseInstructionCleanupValue, + instructionCleanupParentSlot] using houtcome.ready.query⟩ + · change (work tapes.data.update.replacement).HasBinaryNat (value + 1) + rw [houtcome.replacement] + exact htagValue + · simpa [cleanupValues, denseInstructionCleanupValue, + instructionCleanupParentSlot] using houtcome.found + · change (work tapes.data.lhs).HasBinaryNat 0 + rw [houtcome.frame tapes.data.lhs (fun role => + (tapes.data.update_ne_lhs role).symm), + htagFrame tapes.data.lhs + (tapes.data.update_ne_lhs 10).symm, + show updateWork tapes.data.lhs = valueWork tapes.data.lhs by + rw [hupdateWork] + exact Function.update_of_ne + (tapes.data.update_ne_lhs 7).symm _ _, + show valueWork tapes.data.lhs = baseWork tapes.data.lhs by + rw [hvalueWork] + exact Function.update_of_ne + (tapes.data.update_ne_lhs 10).symm _ _] + exact hready.control.lookup.destination + · change (work tapes.data.rhs).HasBinaryNat 0 + rw [houtcome.frame tapes.data.rhs (fun role => + (tapes.data.update_ne_rhs role).symm), + htagFrame tapes.data.rhs + (tapes.data.update_ne_rhs 10).symm, + show updateWork tapes.data.rhs = valueWork tapes.data.rhs by + rw [hupdateWork] + exact Function.update_of_ne + (tapes.data.update_ne_rhs 7).symm _ _, + show valueWork tapes.data.rhs = baseWork tapes.data.rhs by + rw [hvalueWork] + exact Function.update_of_ne + (tapes.data.update_ne_rhs 10).symm _ _] + exact hready.rhs + have hshift : (work tapes.data.shift).HasBinaryNat 0 := by + rw [houtcome.frame tapes.data.shift (fun slot => + (tapes.data.update_ne_shift slot).symm), + htagFrame tapes.data.shift (tapes.data.update_ne_shift 10).symm, + show updateWork tapes.data.shift = valueWork tapes.data.shift by + rw [hupdateWork] + exact Function.update_of_ne + (tapes.data.update_ne_shift 7).symm _ _, + show valueWork tapes.data.shift = baseWork tapes.data.shift by + rw [hvalueWork] + exact Function.update_of_ne + (tapes.data.update_ne_shift 10).symm _ _] + exact hready.control.lookup.querySource + have htmp : (work tapes.data.tmp).HasBinaryNat 0 := by + rw [houtcome.frame tapes.data.tmp (fun slot => + (tapes.data.update_ne_tmp slot).symm), + htagFrame tapes.data.tmp (tapes.data.update_ne_tmp 10).symm, + show updateWork tapes.data.tmp = valueWork tapes.data.tmp by + rw [hupdateWork] + exact Function.update_of_ne + (tapes.data.update_ne_tmp 7).symm _ _, + show valueWork tapes.data.tmp = baseWork tapes.data.tmp by + rw [hvalueWork] + exact Function.update_of_ne + (tapes.data.update_ne_tmp 10).symm _ _] + exact hready.tmp + have hdbl : (work tapes.data.dbl).HasBinaryNat 0 := by + rw [houtcome.frame tapes.data.dbl (fun slot => + (tapes.data.update_ne_dbl slot).symm), + htagFrame tapes.data.dbl (tapes.data.update_ne_dbl 10).symm, + show updateWork tapes.data.dbl = valueWork tapes.data.dbl by + rw [hupdateWork] + exact Function.update_of_ne + (tapes.data.update_ne_dbl 7).symm _ _, + show valueWork tapes.data.dbl = baseWork tapes.data.dbl by + rw [hvalueWork] + exact Function.update_of_ne + (tapes.data.update_ne_dbl 10).symm _ _] + exact hready.dbl + refine ⟨hpc, ?_, hsourceContent, hcleanup, ?_, ?_, hshift, htmp, + hdbl, houtcome.ready.parked⟩ + · simpa [nextStore] using houtcome.resultCount + · simpa using houtcome.remaining + · simpa [cleanupValues, denseInstructionCleanupValue] using + houtcome.ready + have hdata := retargetBufferedDataKernel_hoareTime_frame_internal tapes + overlay nextStore cleanupValues 0 pcValue initialWork inp₀ + (denseImmediateInstructionTM tapes.data destination value) + (denseImmediateInstructionTime tapes.data overlay destination value) + Result hready hbase hresult + have hall := finishBufferedDataTM_hoareTime_frame_internal tapes overlay + nextStore (pcValue + 1) pcValue cleanupValues 0 initialWork inp₀ + (denseImmediateInstructionTM tapes.data destination value) + (denseImmediateInstructionTime tapes.data overlay destination value) + rfl hinput hdata + simpa [denseExecuteInstructionTM, denseExecuteInstructionTime, + DenseInstructionExecutionResult, denseInstructionStore, + denseInstructionPC, DenseOverlay.Snapshot.stepInstr, nextStore, + cleanupValues] using hall + +/-- Instruction constructor corresponding to a dense direct arithmetic +kernel. -/ +def denseDirectInstruction (op : BinaryInstrOp) + (destination source₀ source₁ : ℕ) : Instr := + match op with + | .add => .add destination source₀ source₁ + | .sub => .sub destination source₀ source₁ + | .mul => .mul destination source₀ source₁ + +/-- A dense direct arithmetic instruction produces the generic buffered +endpoint and advances the program counter. -/ +theorem denseExecuteInstructionTM_direct_hoareTime_frame + (tapes : ControlInstructionTapes n) (op : BinaryInstrOp) + (input : List Bool) (overlay : Store) + (pcValue destination source₀ source₁ : ℕ) + (initialWork : Fin (n + 1) → Tape) + (hvalid : DenseOverlay.Valid overlay) + (hready : InstructionExecutionReady tapes overlay pcValue initialWork) : + (denseExecuteInstructionTM tapes + (denseDirectInstruction op destination source₀ source₁)).HoareTime + (fun inp work out => + inp = (Tape.init (input.map Γ.ofBool)).move Dir3.right ∧ + work = initialWork ∧ out = (Tape.init []).move Dir3.right) + (fun inp work out => + inp = (Tape.init (input.map Γ.ofBool)).move Dir3.right ∧ + DenseInstructionExecutionResult tapes input + (denseDirectInstruction op destination source₀ source₁) + pcValue overlay work ∧ + out = (Tape.init []).move Dir3.right) + (denseExecuteInstructionTime tapes input + (denseDirectInstruction op destination source₀ source₁) + pcValue overlay) := by + let inp₀ := (Tape.init (input.map Γ.ofBool)).move Dir3.right + let baseWork : Fin n → Tape := fun i => initialWork (Fin.castSucc i) + let instruction := denseDirectInstruction op destination source₀ source₁ + let lhs := DenseOverlay.read input overlay source₀ + let rhs := DenseOverlay.read input overlay source₁ + let nextStore := DenseOverlay.write overlay destination (op.eval lhs rhs) + let cleanupValues := denseInstructionCleanupValue input instruction overlay + have hinput : TM.Parked inp₀ := by + refine ⟨by simp [inp₀, Tape.move], ?_⟩ + simpa [inp₀] using Tape.init_ofBool_move_right_cells_ne_start input + have hlookup : EntryLookupStaticReady tapes.data.lhsLookup overlay + baseWork := + instructionExecutionReady_baseLookup_internal tapes overlay pcValue + initialWork hready + have hrhs : (baseWork tapes.data.rhs).HasBinaryNat 0 := hready.rhs + have hreplacement : + (baseWork tapes.data.update.replacement).HasBinaryNat 0 := + hready.replacement + have htmp : (baseWork tapes.data.tmp).HasBinaryNat 0 := hready.tmp + have hdbl : (baseWork tapes.data.dbl).HasBinaryNat 0 := hready.dbl + have hbuffer : (initialWork tapes.buffer).HasBinaryPrefix [] := by + rw [hready.buffer] + exact Tape.init_nil_move_right_hasBinaryPrefix_nil + have hbaseRaw := denseDirectBinaryInstructionTM_hoareTime_frame tapes.data + op input overlay destination source₀ source₁ [] baseWork + (initialWork tapes.buffer) hvalid hlookup hrhs hreplacement htmp hdbl + hbuffer + let Result : (Fin n → Tape) → Prop := fun work => + DenseDirectBinaryInstructionResult tapes.data op input overlay destination + source₀ source₁ baseWork work + have hbase : (denseDirectBinaryInstructionTM tapes.data op destination + source₀ source₁).HoareTime + (fun inp work out => + inp = inp₀ ∧ work = baseWork ∧ out = initialWork tapes.buffer) + (fun inp work out => + inp = inp₀ ∧ Result work ∧ + out.HasBinaryPrefix (nextStore.flatMap Entry.encode)) + (denseDirectBinaryInstructionTime tapes.data op input overlay destination + source₀ source₁) := by + simpa [Result, lhs, rhs, nextStore] using hbaseRaw + have hresult : ∀ work, Result work → + work tapes.pc = initialWork (Fin.castSucc tapes.pc) ∧ + (work tapes.data.update.resultCount).HasBinaryNat nextStore.length ∧ + (work tapes.data.update.entry.source).HasBinaryContent + (overlay.flatMap Entry.encode) ∧ + (∀ slot, + (work (tapes.data.idx (instructionCleanupParentSlot slot))).HasBinaryNat + (cleanupValues slot)) ∧ + (work tapes.data.update.remaining).HasBinaryNat 0 ∧ + EntryScanReady tapes.data.update.entry [] (cleanupValues 0).bits + work work ∧ + (work tapes.data.shift).HasBinaryNat 0 ∧ + (work tapes.data.tmp).HasBinaryNat 0 ∧ + (work tapes.data.dbl).HasBinaryNat 0 ∧ + ∀ i, TM.Parked (work i) := by + intro work hsemantic + obtain ⟨updateWork, haddress, hbinary⟩ := hsemantic + obtain ⟨operandsWork, hoperands, hupdateWork⟩ := haddress + obtain ⟨lhsWork, hlhs, hrhsResult⟩ := hoperands + obtain ⟨arithmeticWork, harithmetic, htagged⟩ := hbinary + obtain ⟨taggedWork, htagValue, htagFrame, houtcome, + hsourceCells⟩ := htagged + have hpcUpdate : work tapes.pc = taggedWork tapes.pc := + houtcome.frame tapes.pc (fun slot => by + exact tapes.pc_ne ⟨slot, by omega⟩) + have hpcTag : taggedWork tapes.pc = arithmeticWork tapes.pc := + htagFrame tapes.pc (tapes.pc_ne 10) + have hpcArithmetic : arithmeticWork tapes.pc = updateWork tapes.pc := + harithmetic.frame tapes.pc (tapes.pc_ne 13) (tapes.pc_ne 14) + (tapes.pc_ne 10) (tapes.pc_ne 15) (tapes.pc_ne 16) + (tapes.pc_ne 17) + have hpcQuery : + tapes.pc ≠ tapes.data.update.entry.query := tapes.pc_ne 7 + have hpcAddress : updateWork tapes.pc = operandsWork tapes.pc := by + rw [hupdateWork, Function.update_of_ne hpcQuery] + have hpcRhs : operandsWork tapes.pc = lhsWork tapes.pc := + hrhsResult.frame tapes.pc (fun slot => by + exact tapes.pc_ne (BinaryInstructionTapes.rhsLookupSlot slot)) + have hpcLhs : lhsWork tapes.pc = baseWork tapes.pc := + hlhs.frame tapes.pc (fun slot => by + exact tapes.pc_ne (BinaryInstructionTapes.lhsLookupSlot slot)) + have hsourceContent : + (work tapes.data.update.entry.source).HasBinaryContent + (overlay.flatMap Entry.encode) := by + have harithmeticSource : + arithmeticWork tapes.data.update.entry.source = + updateWork tapes.data.update.entry.source := + harithmetic.frame tapes.data.update.entry.source + (tapes.data.update_ne_lhs 0) + (tapes.data.update_ne_rhs 0) + (tapes.data.update.ne (by decide)) + (tapes.data.update_ne_shift 0) + (tapes.data.update_ne_tmp 0) + (tapes.data.update_ne_dbl 0) + have hcells : (work tapes.data.update.entry.source).cells = + (baseWork tapes.data.update.entry.source).cells := by + calc + (work tapes.data.update.entry.source).cells = + (arithmeticWork tapes.data.update.entry.source).cells := + hsourceCells + _ = (updateWork tapes.data.update.entry.source).cells := by + rw [harithmeticSource] + _ = (operandsWork tapes.data.update.entry.source).cells := by + congr 1 + rw [hupdateWork] + exact Function.update_of_ne + (tapes.data.update.ne (by decide)) _ _ + _ = (lhsWork tapes.data.update.entry.source).cells := + hrhsResult.sourceCells + _ = (baseWork tapes.data.update.entry.source).cells := + hlhs.sourceCells + unfold Tape.HasBinaryContent + rw [hcells] + exact hready.sourceContent + have hcleanup : ∀ slot, + (work (tapes.data.idx (instructionCleanupParentSlot slot))).HasBinaryNat + (cleanupValues slot) := by + intro slot + fin_cases slot + · exact ⟨houtcome.ready.queryStart, by + cases op <;> + simpa [instruction, denseDirectInstruction, cleanupValues, + denseInstructionCleanupValue, instructionCleanupParentSlot] + using houtcome.ready.query⟩ + · change (work tapes.data.update.replacement).HasBinaryNat _ + rw [houtcome.replacement] + cases op <;> + simpa [instruction, denseDirectInstruction, cleanupValues, + denseInstructionCleanupValue, lhs, rhs, BinaryInstrOp.eval] + using htagValue + · cases op <;> + simpa [instruction, denseDirectInstruction, cleanupValues, + denseInstructionCleanupValue, instructionCleanupParentSlot] + using houtcome.found + · change (work tapes.data.lhs).HasBinaryNat _ + rw [houtcome.frame tapes.data.lhs (fun role => + (tapes.data.update_ne_lhs role).symm), + htagFrame tapes.data.lhs + (tapes.data.update_ne_lhs 10).symm] + cases op <;> + simpa [instruction, denseDirectInstruction, cleanupValues, + denseInstructionCleanupValue, lhs] using harithmetic.lhsValue + · change (work tapes.data.rhs).HasBinaryNat _ + rw [houtcome.frame tapes.data.rhs (fun role => + (tapes.data.update_ne_rhs role).symm), + htagFrame tapes.data.rhs + (tapes.data.update_ne_rhs 10).symm] + cases op <;> + simpa [instruction, denseDirectInstruction, cleanupValues, + denseInstructionCleanupValue, rhs] using harithmetic.rhsValue + have hshift : (work tapes.data.shift).HasBinaryNat 0 := by + rw [houtcome.frame tapes.data.shift (fun slot => + (tapes.data.update_ne_shift slot).symm), + htagFrame tapes.data.shift (tapes.data.update_ne_shift 10).symm] + exact harithmetic.shift + have htmp' : (work tapes.data.tmp).HasBinaryNat 0 := by + rw [houtcome.frame tapes.data.tmp (fun slot => + (tapes.data.update_ne_tmp slot).symm), + htagFrame tapes.data.tmp (tapes.data.update_ne_tmp 10).symm] + exact harithmetic.tmp + have hdbl' : (work tapes.data.dbl).HasBinaryNat 0 := by + rw [houtcome.frame tapes.data.dbl (fun slot => + (tapes.data.update_ne_dbl slot).symm), + htagFrame tapes.data.dbl (tapes.data.update_ne_dbl 10).symm] + exact harithmetic.dbl + refine ⟨hpcUpdate.trans (hpcTag.trans (hpcArithmetic.trans + (hpcAddress.trans (hpcRhs.trans hpcLhs)))), ?_, hsourceContent, + hcleanup, ?_, ?_, hshift, htmp', hdbl', houtcome.ready.parked⟩ + · simpa [nextStore, DenseOverlay.write] using houtcome.resultCount + · simpa using houtcome.remaining + · cases op <;> + simpa [instruction, denseDirectInstruction, cleanupValues, + denseInstructionCleanupValue] using houtcome.ready + have hdata := retargetBufferedDataKernel_hoareTime_frame_internal tapes + overlay nextStore cleanupValues 0 pcValue initialWork inp₀ + (denseDirectBinaryInstructionTM tapes.data op destination source₀ source₁) + (denseDirectBinaryInstructionTime tapes.data op input overlay destination + source₀ source₁) Result hready hbase hresult + have hall := finishBufferedDataTM_hoareTime_frame_internal tapes overlay + nextStore (pcValue + 1) pcValue cleanupValues 0 initialWork inp₀ + (denseDirectBinaryInstructionTM tapes.data op destination source₀ source₁) + (denseDirectBinaryInstructionTime tapes.data op input overlay destination + source₀ source₁) rfl hinput hdata + cases op <;> + simpa [instruction, denseDirectInstruction, denseExecuteInstructionTM, + denseExecuteInstructionTime, DenseInstructionExecutionResult, + denseInstructionStore, denseInstructionPC, + DenseOverlay.Snapshot.stepInstr, nextStore, cleanupValues, lhs, rhs, + BinaryInstrOp.eval] using hall + +/-- Dense direct addition has the common buffered instruction contract. -/ +theorem denseExecuteInstructionTM_add_hoareTime_frame + (tapes : ControlInstructionTapes n) (input : List Bool) + (overlay : Store) (pcValue destination source₀ source₁ : ℕ) + (initialWork : Fin (n + 1) → Tape) + (hvalid : DenseOverlay.Valid overlay) + (hready : InstructionExecutionReady tapes overlay pcValue initialWork) : + (denseExecuteInstructionTM tapes + (.add destination source₀ source₁)).HoareTime + (fun inp work out => + inp = (Tape.init (input.map Γ.ofBool)).move Dir3.right ∧ + work = initialWork ∧ out = (Tape.init []).move Dir3.right) + (fun inp work out => + inp = (Tape.init (input.map Γ.ofBool)).move Dir3.right ∧ + DenseInstructionExecutionResult tapes input + (.add destination source₀ source₁) pcValue overlay work ∧ + out = (Tape.init []).move Dir3.right) + (denseExecuteInstructionTime tapes input + (.add destination source₀ source₁) pcValue overlay) := by + simpa [denseDirectInstruction] using + denseExecuteInstructionTM_direct_hoareTime_frame tapes .add input overlay + pcValue destination source₀ source₁ initialWork hvalid hready + +/-- Dense direct subtraction has the common buffered instruction contract. -/ +theorem denseExecuteInstructionTM_sub_hoareTime_frame + (tapes : ControlInstructionTapes n) (input : List Bool) + (overlay : Store) (pcValue destination source₀ source₁ : ℕ) + (initialWork : Fin (n + 1) → Tape) + (hvalid : DenseOverlay.Valid overlay) + (hready : InstructionExecutionReady tapes overlay pcValue initialWork) : + (denseExecuteInstructionTM tapes + (.sub destination source₀ source₁)).HoareTime + (fun inp work out => + inp = (Tape.init (input.map Γ.ofBool)).move Dir3.right ∧ + work = initialWork ∧ out = (Tape.init []).move Dir3.right) + (fun inp work out => + inp = (Tape.init (input.map Γ.ofBool)).move Dir3.right ∧ + DenseInstructionExecutionResult tapes input + (.sub destination source₀ source₁) pcValue overlay work ∧ + out = (Tape.init []).move Dir3.right) + (denseExecuteInstructionTime tapes input + (.sub destination source₀ source₁) pcValue overlay) := by + simpa [denseDirectInstruction] using + denseExecuteInstructionTM_direct_hoareTime_frame tapes .sub input overlay + pcValue destination source₀ source₁ initialWork hvalid hready + +/-- Dense direct multiplication has the common buffered instruction contract. -/ +theorem denseExecuteInstructionTM_mul_hoareTime_frame + (tapes : ControlInstructionTapes n) (input : List Bool) + (overlay : Store) (pcValue destination source₀ source₁ : ℕ) + (initialWork : Fin (n + 1) → Tape) + (hvalid : DenseOverlay.Valid overlay) + (hready : InstructionExecutionReady tapes overlay pcValue initialWork) : + (denseExecuteInstructionTM tapes + (.mul destination source₀ source₁)).HoareTime + (fun inp work out => + inp = (Tape.init (input.map Γ.ofBool)).move Dir3.right ∧ + work = initialWork ∧ out = (Tape.init []).move Dir3.right) + (fun inp work out => + inp = (Tape.init (input.map Γ.ofBool)).move Dir3.right ∧ + DenseInstructionExecutionResult tapes input + (.mul destination source₀ source₁) pcValue overlay work ∧ + out = (Tape.init []).move Dir3.right) + (denseExecuteInstructionTime tapes input + (.mul destination source₀ source₁) pcValue overlay) := by + simpa [denseDirectInstruction] using + denseExecuteInstructionTM_direct_hoareTime_frame tapes .mul input overlay + pcValue destination source₀ source₁ initialWork hvalid hready + +/-- A dense indirect load produces the generic buffered endpoint and advances +the program counter. -/ +theorem denseExecuteInstructionTM_load_hoareTime_frame + (tapes : ControlInstructionTapes n) (input : List Bool) + (overlay : Store) (pcValue destination addressRegister : ℕ) + (initialWork : Fin (n + 1) → Tape) + (hvalid : DenseOverlay.Valid overlay) + (hready : InstructionExecutionReady tapes overlay pcValue initialWork) : + (denseExecuteInstructionTM tapes + (.load destination addressRegister)).HoareTime + (fun inp work out => + inp = (Tape.init (input.map Γ.ofBool)).move Dir3.right ∧ + work = initialWork ∧ out = (Tape.init []).move Dir3.right) + (fun inp work out => + inp = (Tape.init (input.map Γ.ofBool)).move Dir3.right ∧ + DenseInstructionExecutionResult tapes input + (.load destination addressRegister) pcValue overlay work ∧ + out = (Tape.init []).move Dir3.right) + (denseExecuteInstructionTime tapes input + (.load destination addressRegister) pcValue overlay) := by + let inp₀ := (Tape.init (input.map Γ.ofBool)).move Dir3.right + let baseWork : Fin n → Tape := fun i => initialWork (Fin.castSucc i) + let instruction : Instr := .load destination addressRegister + let address := DenseOverlay.read input overlay addressRegister + let value := DenseOverlay.read input overlay address + let nextStore := DenseOverlay.write overlay destination value + let cleanupValues := denseInstructionCleanupValue input instruction overlay + have hinput : TM.Parked inp₀ := by + refine ⟨by simp [inp₀, Tape.move], ?_⟩ + simpa [inp₀] using Tape.init_ofBool_move_right_cells_ne_start input + have hlookup : EntryLookupStaticReady tapes.data.lhsLookup overlay + baseWork := + instructionExecutionReady_baseLookup_internal tapes overlay pcValue + initialWork hready + have hreplacement : + (baseWork tapes.data.update.replacement).HasBinaryNat 0 := + hready.replacement + have hbuffer : (initialWork tapes.buffer).HasBinaryPrefix [] := by + rw [hready.buffer] + exact Tape.init_nil_move_right_hasBinaryPrefix_nil + have hbaseRaw := denseIndirectLoadInstructionTM_hoareTime_frame tapes.data + input overlay destination addressRegister [] baseWork + (initialWork tapes.buffer) hvalid hlookup hreplacement hbuffer + let Result : (Fin n → Tape) → Prop := fun work => + DenseIndirectLoadInstructionResult tapes.data input overlay destination + addressRegister baseWork work + have hbase : (denseIndirectLoadInstructionTM tapes.data destination + addressRegister).HoareTime + (fun inp work out => + inp = inp₀ ∧ work = baseWork ∧ out = initialWork tapes.buffer) + (fun inp work out => + inp = inp₀ ∧ Result work ∧ + out.HasBinaryPrefix (nextStore.flatMap Entry.encode)) + (denseIndirectLoadInstructionTime tapes.data input overlay destination + addressRegister) := by + simpa [Result, address, value, nextStore] using hbaseRaw + have hresult : ∀ work, Result work → + work tapes.pc = initialWork (Fin.castSucc tapes.pc) ∧ + (work tapes.data.update.resultCount).HasBinaryNat nextStore.length ∧ + (work tapes.data.update.entry.source).HasBinaryContent + (overlay.flatMap Entry.encode) ∧ + (∀ slot, + (work (tapes.data.idx (instructionCleanupParentSlot slot))).HasBinaryNat + (cleanupValues slot)) ∧ + (work tapes.data.update.remaining).HasBinaryNat 0 ∧ + EntryScanReady tapes.data.update.entry [] (cleanupValues 0).bits + work work ∧ + (work tapes.data.shift).HasBinaryNat 0 ∧ + (work tapes.data.tmp).HasBinaryNat 0 ∧ + (work tapes.data.dbl).HasBinaryNat 0 ∧ + ∀ i, TM.Parked (work i) := by + intro work hsemantic + obtain ⟨addressWork, loadedWork, updateWork, haddress, hloaded, + hupdateWork, htagged⟩ := hsemantic + obtain ⟨taggedWork, htagValue, htagFrame, houtcome, + hsourceCells⟩ := htagged + have hpcOutcome : work tapes.pc = taggedWork tapes.pc := + houtcome.frame tapes.pc (fun slot => by + exact tapes.pc_ne ⟨slot, by omega⟩) + have hpcTag : taggedWork tapes.pc = updateWork tapes.pc := + htagFrame tapes.pc (tapes.pc_ne 10) + have hpcQuery : + tapes.pc ≠ tapes.data.update.entry.query := tapes.pc_ne 7 + have hpcUpdate : updateWork tapes.pc = loadedWork tapes.pc := by + rw [hupdateWork, Function.update_of_ne hpcQuery] + have hpcLoaded : loadedWork tapes.pc = addressWork tapes.pc := + hloaded.frame tapes.pc (fun slot => by + exact tapes.pc_ne + (BinaryInstructionTapes.indirectLoadLookupSlot slot)) + have hpcAddress : addressWork tapes.pc = baseWork tapes.pc := + haddress.frame tapes.pc (fun slot => by + exact tapes.pc_ne (BinaryInstructionTapes.lhsLookupSlot slot)) + have hsourceContent : + (work tapes.data.update.entry.source).HasBinaryContent + (overlay.flatMap Entry.encode) := by + have hcells : (work tapes.data.update.entry.source).cells = + (baseWork tapes.data.update.entry.source).cells := by + calc + (work tapes.data.update.entry.source).cells = + (updateWork tapes.data.update.entry.source).cells := + hsourceCells + _ = (loadedWork tapes.data.update.entry.source).cells := by + congr 1 + rw [hupdateWork] + exact Function.update_of_ne + (tapes.data.update.ne (by decide)) _ _ + _ = (addressWork tapes.data.update.entry.source).cells := + hloaded.sourceCells + _ = (baseWork tapes.data.update.entry.source).cells := + haddress.sourceCells + unfold Tape.HasBinaryContent + rw [hcells] + exact hready.sourceContent + have hcleanup : ∀ slot, + (work (tapes.data.idx (instructionCleanupParentSlot slot))).HasBinaryNat + (cleanupValues slot) := by + intro slot + fin_cases slot + · exact ⟨houtcome.ready.queryStart, by + simpa [instruction, cleanupValues, denseInstructionCleanupValue, + instructionCleanupParentSlot] using houtcome.ready.query⟩ + · change (work tapes.data.update.replacement).HasBinaryNat _ + rw [houtcome.replacement] + simpa [instruction, cleanupValues, denseInstructionCleanupValue, + address, value] using htagValue + · simpa [instruction, cleanupValues, denseInstructionCleanupValue, + instructionCleanupParentSlot] using houtcome.found + · change (work tapes.data.lhs).HasBinaryNat _ + rw [houtcome.frame tapes.data.lhs (fun role => + (tapes.data.update_ne_lhs role).symm), + htagFrame tapes.data.lhs + (tapes.data.update_ne_lhs 10).symm, + show updateWork tapes.data.lhs = loadedWork tapes.data.lhs by + rw [hupdateWork] + exact Function.update_of_ne + (tapes.data.update_ne_lhs 7).symm _ _, + show loadedWork tapes.data.lhs = addressWork tapes.data.lhs from + hloaded.querySource] + simpa [instruction, cleanupValues, denseInstructionCleanupValue, + address] using haddress.destination + · change (work tapes.data.rhs).HasBinaryNat _ + rw [houtcome.frame tapes.data.rhs (fun role => + (tapes.data.update_ne_rhs role).symm), + htagFrame tapes.data.rhs + (tapes.data.update_ne_rhs 10).symm, + show updateWork tapes.data.rhs = loadedWork tapes.data.rhs by + rw [hupdateWork] + exact Function.update_of_ne + (tapes.data.update_ne_rhs 7).symm _ _, + hloaded.frame tapes.data.rhs (fun role => by + apply tapes.data.ne + fin_cases role <;> decide), + haddress.frame tapes.data.rhs (fun role => + (tapes.data.lhsLookup_ne_rhs role).symm)] + exact hready.rhs + have hshift : (work tapes.data.shift).HasBinaryNat 0 := by + have hqueryNe : + tapes.data.shift ≠ tapes.data.update.entry.query := + (tapes.data.update_ne_shift 7).symm + rw [houtcome.frame tapes.data.shift (fun slot => + (tapes.data.update_ne_shift slot).symm), + htagFrame tapes.data.shift (tapes.data.update_ne_shift 10).symm, + hupdateWork, Function.update_of_ne hqueryNe, + hloaded.frame tapes.data.shift (fun slot => by + apply tapes.data.ne + fin_cases slot <;> decide)] + simpa using haddress.querySource + have htmp' : (work tapes.data.tmp).HasBinaryNat 0 := by + have hqueryNe : tapes.data.tmp ≠ + tapes.data.update.entry.query := + (tapes.data.update_ne_tmp 7).symm + rw [houtcome.frame tapes.data.tmp (fun slot => + (tapes.data.update_ne_tmp slot).symm), + htagFrame tapes.data.tmp (tapes.data.update_ne_tmp 10).symm, + hupdateWork, Function.update_of_ne hqueryNe, + hloaded.frame tapes.data.tmp (fun slot => by + apply tapes.data.ne + fin_cases slot <;> decide), + haddress.frame tapes.data.tmp (fun slot => + (tapes.data.lhsLookup_ne_tmp slot).symm)] + exact hready.tmp + have hdbl' : (work tapes.data.dbl).HasBinaryNat 0 := by + have hqueryNe : tapes.data.dbl ≠ + tapes.data.update.entry.query := + (tapes.data.update_ne_dbl 7).symm + rw [houtcome.frame tapes.data.dbl (fun slot => + (tapes.data.update_ne_dbl slot).symm), + htagFrame tapes.data.dbl (tapes.data.update_ne_dbl 10).symm, + hupdateWork, Function.update_of_ne hqueryNe, + hloaded.frame tapes.data.dbl (fun slot => by + apply tapes.data.ne + fin_cases slot <;> decide), + haddress.frame tapes.data.dbl (fun slot => + (tapes.data.lhsLookup_ne_dbl slot).symm)] + exact hready.dbl + refine ⟨hpcOutcome.trans (hpcTag.trans (hpcUpdate.trans + (hpcLoaded.trans hpcAddress))), ?_, hsourceContent, hcleanup, + ?_, ?_, hshift, htmp', hdbl', houtcome.ready.parked⟩ + · simpa [nextStore, DenseOverlay.write] using houtcome.resultCount + · simpa using houtcome.remaining + · simpa [instruction, cleanupValues, denseInstructionCleanupValue] + using houtcome.ready + have hdata := retargetBufferedDataKernel_hoareTime_frame_internal tapes + overlay nextStore cleanupValues 0 pcValue initialWork inp₀ + (denseIndirectLoadInstructionTM tapes.data destination addressRegister) + (denseIndirectLoadInstructionTime tapes.data input overlay destination + addressRegister) Result hready hbase hresult + have hall := finishBufferedDataTM_hoareTime_frame_internal tapes overlay + nextStore (pcValue + 1) pcValue cleanupValues 0 initialWork inp₀ + (denseIndirectLoadInstructionTM tapes.data destination addressRegister) + (denseIndirectLoadInstructionTime tapes.data input overlay destination + addressRegister) rfl hinput hdata + simpa [instruction, denseExecuteInstructionTM, + denseExecuteInstructionTime, DenseInstructionExecutionResult, + denseInstructionStore, denseInstructionPC, + DenseOverlay.Snapshot.stepInstr, nextStore, cleanupValues, address, + value] using hall + +/-- A dense indirect store produces the generic buffered endpoint and advances +the program counter. -/ +theorem denseExecuteInstructionTM_store_hoareTime_frame + (tapes : ControlInstructionTapes n) (input : List Bool) + (overlay : Store) (pcValue addressRegister source : ℕ) + (initialWork : Fin (n + 1) → Tape) + (hvalid : DenseOverlay.Valid overlay) + (hready : InstructionExecutionReady tapes overlay pcValue initialWork) : + (denseExecuteInstructionTM tapes + (.store addressRegister source)).HoareTime + (fun inp work out => + inp = (Tape.init (input.map Γ.ofBool)).move Dir3.right ∧ + work = initialWork ∧ out = (Tape.init []).move Dir3.right) + (fun inp work out => + inp = (Tape.init (input.map Γ.ofBool)).move Dir3.right ∧ + DenseInstructionExecutionResult tapes input + (.store addressRegister source) pcValue overlay work ∧ + out = (Tape.init []).move Dir3.right) + (denseExecuteInstructionTime tapes input + (.store addressRegister source) pcValue overlay) := by + let inp₀ := (Tape.init (input.map Γ.ofBool)).move Dir3.right + let baseWork : Fin n → Tape := fun i => initialWork (Fin.castSucc i) + let instruction : Instr := .store addressRegister source + let address := DenseOverlay.read input overlay addressRegister + let value := DenseOverlay.read input overlay source + let nextStore := DenseOverlay.write overlay address value + let cleanupValues := denseInstructionCleanupValue input instruction overlay + have hinput : TM.Parked inp₀ := by + refine ⟨by simp [inp₀, Tape.move], ?_⟩ + simpa [inp₀] using Tape.init_ofBool_move_right_cells_ne_start input + have hlookup : EntryLookupStaticReady tapes.data.lhsLookup overlay + baseWork := + instructionExecutionReady_baseLookup_internal tapes overlay pcValue + initialWork hready + have hrhs : (baseWork tapes.data.rhs).HasBinaryNat 0 := hready.rhs + have hreplacement : + (baseWork tapes.data.update.replacement).HasBinaryNat 0 := + hready.replacement + have hbuffer : (initialWork tapes.buffer).HasBinaryPrefix [] := by + rw [hready.buffer] + exact Tape.init_nil_move_right_hasBinaryPrefix_nil + have hbaseRaw := denseIndirectStoreInstructionTM_hoareTime_frame tapes.data + input overlay addressRegister source [] baseWork + (initialWork tapes.buffer) hvalid hlookup hrhs hreplacement hbuffer + let Result : (Fin n → Tape) → Prop := fun work => + DenseIndirectStoreInstructionResult tapes.data input overlay + addressRegister source baseWork work + have hbase : (denseIndirectStoreInstructionTM tapes.data addressRegister + source).HoareTime + (fun inp work out => + inp = inp₀ ∧ work = baseWork ∧ out = initialWork tapes.buffer) + (fun inp work out => + inp = inp₀ ∧ Result work ∧ + out.HasBinaryPrefix (nextStore.flatMap Entry.encode)) + (denseIndirectStoreInstructionTime tapes.data input overlay + addressRegister source) := by + simpa [Result, address, value, nextStore] using hbaseRaw + have hresult : ∀ work, Result work → + work tapes.pc = initialWork (Fin.castSucc tapes.pc) ∧ + (work tapes.data.update.resultCount).HasBinaryNat nextStore.length ∧ + (work tapes.data.update.entry.source).HasBinaryContent + (overlay.flatMap Entry.encode) ∧ + (∀ slot, + (work (tapes.data.idx (instructionCleanupParentSlot slot))).HasBinaryNat + (cleanupValues slot)) ∧ + (work tapes.data.update.remaining).HasBinaryNat 0 ∧ + EntryScanReady tapes.data.update.entry [] (cleanupValues 0).bits + work work ∧ + (work tapes.data.shift).HasBinaryNat 0 ∧ + (work tapes.data.tmp).HasBinaryNat 0 ∧ + (work tapes.data.dbl).HasBinaryNat 0 ∧ + ∀ i, TM.Parked (work i) := by + intro work hsemantic + obtain ⟨operandsWork, queryWork, updateWork, hoperands, hqueryWork, + hupdateWork, htagged⟩ := hsemantic + obtain ⟨lhsWork, hlhs, hrhsResult⟩ := hoperands + obtain ⟨taggedWork, htagValue, htagFrame, houtcome, + hsourceCells⟩ := htagged + have hpcOutcome : work tapes.pc = taggedWork tapes.pc := + houtcome.frame tapes.pc (fun slot => by + exact tapes.pc_ne ⟨slot, by omega⟩) + have hpcTag : taggedWork tapes.pc = updateWork tapes.pc := + htagFrame tapes.pc (tapes.pc_ne 10) + have hpcReplacement : + tapes.pc ≠ tapes.data.update.replacement := tapes.pc_ne 10 + have hpcUpdate : updateWork tapes.pc = queryWork tapes.pc := by + rw [hupdateWork, Function.update_of_ne hpcReplacement] + have hpcQuery : + tapes.pc ≠ tapes.data.update.entry.query := tapes.pc_ne 7 + have hpcQueryWork : queryWork tapes.pc = operandsWork tapes.pc := by + rw [hqueryWork, Function.update_of_ne hpcQuery] + have hpcRhs : operandsWork tapes.pc = lhsWork tapes.pc := + hrhsResult.frame tapes.pc (fun slot => by + exact tapes.pc_ne (BinaryInstructionTapes.rhsLookupSlot slot)) + have hpcLhs : lhsWork tapes.pc = baseWork tapes.pc := + hlhs.frame tapes.pc (fun slot => by + exact tapes.pc_ne (BinaryInstructionTapes.lhsLookupSlot slot)) + have hsourceContent : + (work tapes.data.update.entry.source).HasBinaryContent + (overlay.flatMap Entry.encode) := by + have hcells : (work tapes.data.update.entry.source).cells = + (baseWork tapes.data.update.entry.source).cells := by + calc + (work tapes.data.update.entry.source).cells = + (updateWork tapes.data.update.entry.source).cells := + hsourceCells + _ = (queryWork tapes.data.update.entry.source).cells := by + congr 1 + rw [hupdateWork] + exact Function.update_of_ne + (tapes.data.update.ne (by decide)) _ _ + _ = (operandsWork tapes.data.update.entry.source).cells := by + congr 1 + rw [hqueryWork] + exact Function.update_of_ne + (tapes.data.update.ne (by decide)) _ _ + _ = (lhsWork tapes.data.update.entry.source).cells := + hrhsResult.sourceCells + _ = (baseWork tapes.data.update.entry.source).cells := + hlhs.sourceCells + unfold Tape.HasBinaryContent + rw [hcells] + exact hready.sourceContent + have hcleanup : ∀ slot, + (work (tapes.data.idx (instructionCleanupParentSlot slot))).HasBinaryNat + (cleanupValues slot) := by + intro slot + fin_cases slot + · exact ⟨houtcome.ready.queryStart, by + simpa [instruction, cleanupValues, denseInstructionCleanupValue, + instructionCleanupParentSlot, address] using + houtcome.ready.query⟩ + · change (work tapes.data.update.replacement).HasBinaryNat _ + rw [houtcome.replacement] + simpa [instruction, cleanupValues, denseInstructionCleanupValue, + value] using htagValue + · simpa [instruction, cleanupValues, denseInstructionCleanupValue, + instructionCleanupParentSlot, address] using houtcome.found + · change (work tapes.data.lhs).HasBinaryNat _ + rw [houtcome.frame tapes.data.lhs (fun role => + (tapes.data.update_ne_lhs role).symm), + htagFrame tapes.data.lhs + (tapes.data.update_ne_lhs 10).symm, + show updateWork tapes.data.lhs = queryWork tapes.data.lhs by + rw [hupdateWork] + exact Function.update_of_ne + (tapes.data.update_ne_lhs 10).symm _ _, + show queryWork tapes.data.lhs = operandsWork tapes.data.lhs by + rw [hqueryWork] + exact Function.update_of_ne + (tapes.data.update_ne_lhs 7).symm _ _, + hrhsResult.frame tapes.data.lhs (fun role => + (tapes.data.rhsLookup_ne_lhs role).symm)] + simpa [instruction, cleanupValues, denseInstructionCleanupValue, + address] using hlhs.destination + · change (work tapes.data.rhs).HasBinaryNat _ + rw [houtcome.frame tapes.data.rhs (fun role => + (tapes.data.update_ne_rhs role).symm), + htagFrame tapes.data.rhs + (tapes.data.update_ne_rhs 10).symm, + show updateWork tapes.data.rhs = queryWork tapes.data.rhs by + rw [hupdateWork] + exact Function.update_of_ne + (tapes.data.update_ne_rhs 10).symm _ _, + show queryWork tapes.data.rhs = operandsWork tapes.data.rhs by + rw [hqueryWork] + exact Function.update_of_ne + (tapes.data.update_ne_rhs 7).symm _ _] + simpa [instruction, cleanupValues, denseInstructionCleanupValue, + value] using hrhsResult.destination + have hshift : (work tapes.data.shift).HasBinaryNat 0 := by + have hreplacementNe : + tapes.data.shift ≠ tapes.data.update.replacement := + (tapes.data.update_ne_shift 10).symm + have hqueryNe : + tapes.data.shift ≠ tapes.data.update.entry.query := + (tapes.data.update_ne_shift 7).symm + rw [houtcome.frame tapes.data.shift (fun slot => + (tapes.data.update_ne_shift slot).symm), + htagFrame tapes.data.shift hreplacementNe, + hupdateWork, Function.update_of_ne hreplacementNe, + hqueryWork, Function.update_of_ne hqueryNe] + simpa using hrhsResult.querySource + have htmp' : (work tapes.data.tmp).HasBinaryNat 0 := by + have hreplacementNe : + tapes.data.tmp ≠ tapes.data.update.replacement := + (tapes.data.update_ne_tmp 10).symm + have hqueryNe : tapes.data.tmp ≠ + tapes.data.update.entry.query := + (tapes.data.update_ne_tmp 7).symm + rw [houtcome.frame tapes.data.tmp (fun slot => + (tapes.data.update_ne_tmp slot).symm), + htagFrame tapes.data.tmp hreplacementNe, + hupdateWork, Function.update_of_ne hreplacementNe, + hqueryWork, Function.update_of_ne hqueryNe, + hrhsResult.frame tapes.data.tmp (fun slot => + (tapes.data.rhsLookup_ne_tmp slot).symm), + hlhs.frame tapes.data.tmp (fun slot => + (tapes.data.lhsLookup_ne_tmp slot).symm)] + exact hready.tmp + have hdbl' : (work tapes.data.dbl).HasBinaryNat 0 := by + have hreplacementNe : + tapes.data.dbl ≠ tapes.data.update.replacement := + (tapes.data.update_ne_dbl 10).symm + have hqueryNe : tapes.data.dbl ≠ + tapes.data.update.entry.query := + (tapes.data.update_ne_dbl 7).symm + rw [houtcome.frame tapes.data.dbl (fun slot => + (tapes.data.update_ne_dbl slot).symm), + htagFrame tapes.data.dbl hreplacementNe, + hupdateWork, Function.update_of_ne hreplacementNe, + hqueryWork, Function.update_of_ne hqueryNe, + hrhsResult.frame tapes.data.dbl (fun slot => + (tapes.data.rhsLookup_ne_dbl slot).symm), + hlhs.frame tapes.data.dbl (fun slot => + (tapes.data.lhsLookup_ne_dbl slot).symm)] + exact hready.dbl + refine ⟨hpcOutcome.trans (hpcTag.trans (hpcUpdate.trans + (hpcQueryWork.trans (hpcRhs.trans hpcLhs)))), ?_, hsourceContent, + hcleanup, ?_, ?_, hshift, htmp', hdbl', houtcome.ready.parked⟩ + · simpa [nextStore, DenseOverlay.write] using houtcome.resultCount + · simpa using houtcome.remaining + · simpa [instruction, cleanupValues, denseInstructionCleanupValue, + address] using houtcome.ready + have hdata := retargetBufferedDataKernel_hoareTime_frame_internal tapes + overlay nextStore cleanupValues 0 pcValue initialWork inp₀ + (denseIndirectStoreInstructionTM tapes.data addressRegister source) + (denseIndirectStoreInstructionTime tapes.data input overlay + addressRegister source) Result hready hbase hresult + have hall := finishBufferedDataTM_hoareTime_frame_internal tapes overlay + nextStore (pcValue + 1) pcValue cleanupValues 0 initialWork inp₀ + (denseIndirectStoreInstructionTM tapes.data addressRegister source) + (denseIndirectStoreInstructionTime tapes.data input overlay + addressRegister source) rfl hinput hdata + simpa [instruction, denseExecuteInstructionTM, + denseExecuteInstructionTime, DenseInstructionExecutionResult, + denseInstructionStore, denseInstructionPC, + DenseOverlay.Snapshot.stepInstr, nextStore, cleanupValues, address, + value] using hall + +end Machine +end RegisterStore +end RAM +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseSimDefs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseSimDefs.lean new file mode 100644 index 0000000000..022e3d8bad --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseSimDefs.lean @@ -0,0 +1,249 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.DenseDefs +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Sim.Defs + +/-! +# Dense-overlay instruction simulation -- controller definitions + +These definitions connect the dense instruction kernels to the existing +fixed-program selector and representation-independent buffered cleanup pass. +-/ + + +@[expose] public section + +namespace Complexity +namespace RAM +namespace RegisterStore +namespace Machine + +/-- Execute one selected instruction against the dense public-input overlay. -/ +def denseExecuteInstructionTM {n : ℕ} (tapes : ControlInstructionTapes n) : + Instr → TM (n + 1) + | .imm destination value => + TM.seqTM + (denseImmediateInstructionTM tapes.data destination value).retargetOutput + (TM.binarySuccTM tapes.liftedPC) + | .add destination source₀ source₁ => + TM.seqTM + (denseDirectBinaryInstructionTM tapes.data .add destination source₀ + source₁).retargetOutput + (TM.binarySuccTM tapes.liftedPC) + | .sub destination source₀ source₁ => + TM.seqTM + (denseDirectBinaryInstructionTM tapes.data .sub destination source₀ + source₁).retargetOutput + (TM.binarySuccTM tapes.liftedPC) + | .mul destination source₀ source₁ => + TM.seqTM + (denseDirectBinaryInstructionTM tapes.data .mul destination source₀ + source₁).retargetOutput + (TM.binarySuccTM tapes.liftedPC) + | .load destination addressRegister => + TM.seqTM + (denseIndirectLoadInstructionTM tapes.data destination + addressRegister).retargetOutput + (TM.binarySuccTM tapes.liftedPC) + | .store addressRegister source => + TM.seqTM + (denseIndirectStoreInstructionTM tapes.data addressRegister + source).retargetOutput + (TM.binarySuccTM tapes.liftedPC) + | .jz source target => + finishControlInstructionTM tapes + (denseZeroJumpInstructionTM tapes.lifted source target) + | .jmp target => + finishControlInstructionTM tapes (jumpInstructionTM tapes.lifted target) + | .halt => + finishControlInstructionTM tapes (haltInstructionTM (n := n + 1)) + +/-- Dense finite branch tree selected by a decrementing PC copy. -/ +def denseDispatchProgramTM {n : ℕ} (tapes : ControlInstructionTapes n) + (program : Program) : TM (n + 1) := + dispatchWithTM tapes (denseExecuteInstructionTM tapes) program + +/-- Copy the dense snapshot PC into selector scratch and dispatch once. -/ +def denseProgramInstructionTM {n : ℕ} (tapes : ControlInstructionTapes n) + (program : Program) : TM (n + 1) := + TM.seqTM + (TM.binaryCopyIntoTM tapes.liftedPC tapes.liftedLhs tapes.liftedFound) + (denseDispatchProgramTM tapes program) + +/-- Mutable overlay after one dense instruction. -/ +def denseInstructionStore (input : List Bool) (instruction : Instr) + (pcValue : ℕ) (overlay : Store) : Store := + (DenseOverlay.Snapshot.stepInstr input instruction + { pc := pcValue, overlay := overlay }).overlay + +/-- Program counter after one dense instruction. -/ +def denseInstructionPC (input : List Bool) (instruction : Instr) + (pcValue : ℕ) (overlay : Store) : ℕ := + (DenseOverlay.Snapshot.stepInstr input instruction + { pc := pcValue, overlay := overlay }).pc + +/-- Exact values left on the five physical cleanup roles by a dense kernel. -/ +def denseInstructionCleanupValue (input : List Bool) + (instruction : Instr) (overlay : Store) : Fin 5 → ℕ + | 0 => + match instruction with + | .imm destination _ | .add destination _ _ | + .sub destination _ _ | .mul destination _ _ | + .load destination _ => destination + | .store addressRegister _ => + DenseOverlay.read input overlay addressRegister + | .jz _ _ | .jmp _ | .halt => 0 + | 1 => + match instruction with + | .imm _ value => value + 1 + | .add _ source₀ source₁ => + DenseOverlay.read input overlay source₀ + + DenseOverlay.read input overlay source₁ + 1 + | .sub _ source₀ source₁ => + (DenseOverlay.read input overlay source₀ - + DenseOverlay.read input overlay source₁) + 1 + | .mul _ source₀ source₁ => + DenseOverlay.read input overlay source₀ * + DenseOverlay.read input overlay source₁ + 1 + | .load _ addressRegister => + DenseOverlay.read input overlay + (DenseOverlay.read input overlay addressRegister) + 1 + | .store _ source => DenseOverlay.read input overlay source + 1 + | .jz _ _ | .jmp _ | .halt => 0 + | 2 => + match instruction with + | .imm destination _ | .add destination _ _ | + .sub destination _ _ | .mul destination _ _ | + .load destination _ => + if destination ∈ overlay.map Prod.fst then 1 else 0 + | .store addressRegister _ => + if DenseOverlay.read input overlay addressRegister ∈ + overlay.map Prod.fst then 1 else 0 + | .jz _ _ | .jmp _ | .halt => 0 + | 3 => + match instruction with + | .add _ source₀ _ | .sub _ source₀ _ | .mul _ source₀ _ => + DenseOverlay.read input overlay source₀ + | .load _ addressRegister | .store addressRegister _ => + DenseOverlay.read input overlay addressRegister + | .imm _ _ | .jz _ _ | .jmp _ | .halt => 0 + | _ => + match instruction with + | .add _ _ source₁ | .sub _ _ source₁ | .mul _ _ source₁ => + DenseOverlay.read input overlay source₁ + | .store _ source => DenseOverlay.read input overlay source + | .imm _ _ | .load _ _ | .jz _ _ | .jmp _ | .halt => 0 + +/-- Old overlay counter state before generic buffered cleanup. -/ +def denseInstructionRemainingValue (instruction : Instr) + (overlay : Store) : ℕ := + match instruction with + | .imm _ _ | .add _ _ _ | .sub _ _ _ | .mul _ _ _ | + .load _ _ | .store _ _ => 0 + | .jz _ _ | .jmp _ | .halt => overlay.length + +/-- Common dense semantic endpoint before representation cleanup. -/ +abbrev DenseInstructionExecutionResult {n : ℕ} + (tapes : ControlInstructionTapes n) (input : List Bool) + (instruction : Instr) (pcValue : ℕ) (overlay : Store) + (work : Fin (n + 1) → Tape) : Prop := + BufferedInstructionResult tapes overlay + (denseInstructionStore input instruction pcValue overlay) + (denseInstructionPC input instruction pcValue overlay) + (denseInstructionCleanupValue input instruction overlay) + (denseInstructionRemainingValue instruction overlay) work + +/-- Dense endpoint plus the marker and source-cursor bounds needed by cleanup. -/ +abbrev DenseInstructionCleanupReady {n : ℕ} + (tapes : ControlInstructionTapes n) (input : List Bool) + (instruction : Instr) (pcValue : ℕ) (overlay : Store) + (sourceHeadBound : ℕ) (work : Fin (n + 1) → Tape) : Prop := + BufferedCleanupReady tapes overlay + (denseInstructionStore input instruction pcValue overlay) + (denseInstructionPC input instruction pcValue overlay) + (denseInstructionCleanupValue input instruction overlay) + (denseInstructionRemainingValue instruction overlay) + sourceHeadBound work + +/-- Runtime of one statically selected dense instruction before cleanup. -/ +def denseExecuteInstructionTime {n : ℕ} + (tapes : ControlInstructionTapes n) (input : List Bool) + (instruction : Instr) (pcValue : ℕ) (overlay : Store) : ℕ := + match instruction with + | .imm destination value => + denseImmediateInstructionTime tapes.data overlay destination value + 1 + + TM.binarySuccTime pcValue + | .add destination source₀ source₁ => + denseDirectBinaryInstructionTime tapes.data .add input overlay destination + source₀ source₁ + 1 + TM.binarySuccTime pcValue + | .sub destination source₀ source₁ => + denseDirectBinaryInstructionTime tapes.data .sub input overlay destination + source₀ source₁ + 1 + TM.binarySuccTime pcValue + | .mul destination source₀ source₁ => + denseDirectBinaryInstructionTime tapes.data .mul input overlay destination + source₀ source₁ + 1 + TM.binarySuccTime pcValue + | .load destination addressRegister => + denseIndirectLoadInstructionTime tapes.data input overlay destination + addressRegister + 1 + TM.binarySuccTime pcValue + | .store addressRegister source => + denseIndirectStoreInstructionTime tapes.data input overlay addressRegister + source + 1 + TM.binarySuccTime pcValue + | .jz source target => + denseZeroJumpInstructionTime tapes.lifted input overlay pcValue source + target + 1 + (overlay.flatMap Entry.encode).length + 1 + | .jmp target => + jumpInstructionTime pcValue target + 1 + + (overlay.flatMap Entry.encode).length + 1 + | .halt => + haltInstructionTime + 1 + (overlay.flatMap Entry.encode).length + 1 + +/-- Dense branch-tree runtime for a represented selector. -/ +def denseDispatchProgramTime {n : ℕ} (tapes : ControlInstructionTapes n) + (input : List Bool) (overlay : Store) (pcValue : ℕ) : + Program → ℕ → ℕ := + dispatchWithTime tapes + (fun instruction => + denseExecuteInstructionTime tapes input instruction pcValue overlay) + +/-- Complete dense selection and selected-instruction runtime. -/ +def denseProgramInstructionTime {n : ℕ} + (tapes : ControlInstructionTapes n) (program : Program) + (input : List Bool) (pcValue : ℕ) (overlay : Store) : ℕ := + TM.binaryCopyTime pcValue 0 + 1 + + denseDispatchProgramTime tapes input overlay pcValue program pcValue + +/-- Select, execute, and clean one dense RAM instruction. -/ +def denseProgramStepTM {n : ℕ} (tapes : ControlInstructionTapes n) + (program : Program) : TM (n + 1) := + TM.seqTM (denseProgramInstructionTM tapes program) + (instructionCleanupTM tapes) + +/-- Source-head bound after dense selection and execution. -/ +def denseProgramStepSourceHeadBound {n : ℕ} + (tapes : ControlInstructionTapes n) (program : Program) + (input : List Bool) (pcValue : ℕ) (overlay : Store) : ℕ := + 1 + denseProgramInstructionTime tapes program input pcValue overlay + +/-- Exact compositional time for one selected and cleaned dense RAM step. -/ +noncomputable def denseProgramStepTime {n : ℕ} + (tapes : ControlInstructionTapes n) (program : Program) + (input : List Bool) (pcValue : ℕ) (overlay : Store) : ℕ := + let instruction := selectedInstruction program pcValue + let nextStore := denseInstructionStore input instruction pcValue overlay + denseProgramInstructionTime tapes program input pcValue overlay + 1 + + bufferedCleanupTime tapes overlay nextStore + (denseInstructionCleanupValue input instruction overlay) + (denseInstructionRemainingValue instruction overlay) + (denseProgramStepSourceHeadBound tapes program input pcValue overlay) + +end Machine +end RegisterStore +end RAM +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseStore.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseStore.lean new file mode 100644 index 0000000000..e2a0f339fa --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseStore.lean @@ -0,0 +1,483 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.DenseDirect + +/-! +# Dense-overlay indirect store +-/ + + +public section + +namespace Complexity +namespace RAM +namespace RegisterStore +namespace Machine + +variable {n : ℕ} + +private theorem hasBinaryPrefix_parked {t : Tape} {bits : List Bool} + (h : t.HasBinaryPrefix bits) : TM.Parked t := by + refine ⟨by rw [h.1]; omega, ?_⟩ + intro j hj + obtain ⟨i, rfl⟩ : ∃ i, j = i + 1 := ⟨j - 1, by omega⟩ + by_cases hi : i < bits.length + · rw [h.2.1 i hi] + exact Γ.ofBool_ne_start _ + · rw [h.2.2 i (Nat.le_of_not_gt hi)] + decide + +private theorem phaseTransition_of_parked + {inp out : Tape} {work : Fin n → Tape} + (hinput : TM.Parked inp) (hwork : ∀ i, TM.Parked (work i)) + (houtput : TM.Parked out) : + TM.transitionInput inp = inp ∧ + (fun i => TM.transitionTape (work i)) = work ∧ + TM.transitionTape out = out := + TM.phaseTransition_eq_self_of_reads_ne_start hinput.read_ne_start + (fun i => (hwork i).read_ne_start) houtput.read_ne_start + +private theorem denseStoreOperands_values + (tapes : BinaryInstructionTapes n) (input : List Bool) + (overlay : Store) (addressRegister source : ℕ) + (initialWork operandsWork : Fin n → Tape) + (hoperands : DenseDirectBinaryOperandsResult tapes input overlay + addressRegister source initialWork operandsWork) : + (operandsWork tapes.lhs).HasBinaryNat + (DenseOverlay.read input overlay addressRegister) ∧ + (operandsWork tapes.rhs).HasBinaryNat + (DenseOverlay.read input overlay source) ∧ + (operandsWork tapes.update.found).HasBinaryNat 0 ∧ + ∀ i, TM.Parked (operandsWork i) := by + rcases hoperands with ⟨lhsWork, hlhs, hrhs⟩ + have hlhsEq : operandsWork tapes.lhs = lhsWork tapes.lhs := + hrhs.frame tapes.lhs (fun slot => (tapes.rhsLookup_ne_lhs slot).symm) + refine ⟨?_, by simpa using hrhs.destination, + by simpa using hrhs.copyScratch, hrhs.parked⟩ + rw [hlhsEq] + exact hlhs.destination + +private theorem scanner_after_replacement + (tapes : BinaryInstructionTapes n) (overlay : Store) (address value : ℕ) + (work : Fin n → Tape) + (hscanner : EntryScanReady tapes.update.entry + (overlay.flatMap Entry.encode) address.bits work work) : + EntryScanReady tapes.update.entry (overlay.flatMap Entry.encode) + address.bits + (Function.update work tapes.update.replacement + ((Tape.init (value.bits.map Γ.ofBool)).move Dir3.right)) + (Function.update work tapes.update.replacement + ((Tape.init (value.bits.map Γ.ofBool)).move Dir3.right)) := by + let finalWork := Function.update work tapes.update.replacement + ((Tape.init (value.bits.map Γ.ofBool)).move Dir3.right) + have hsource : tapes.update.entry.source ≠ tapes.update.replacement := + tapes.update.ne (by decide) + have haddress : tapes.update.entry.address ≠ tapes.update.replacement := + tapes.update.ne (by decide) + have hvalue : tapes.update.entry.value ≠ tapes.update.replacement := + tapes.update.ne (by decide) + have haddressCounter : + tapes.update.entry.addressCounter ≠ tapes.update.replacement := + tapes.update.ne (by decide) + have haddressWidth : + tapes.update.entry.addressWidth ≠ tapes.update.replacement := + tapes.update.ne (by decide) + have hvalueCounter : + tapes.update.entry.valueCounter ≠ tapes.update.replacement := + tapes.update.ne (by decide) + have hvalueWidth : + tapes.update.entry.valueWidth ≠ tapes.update.replacement := + tapes.update.ne (by decide) + have hquery : tapes.update.entry.query ≠ tapes.update.replacement := + tapes.update.ne (by decide) + have hresult : tapes.update.entry.result ≠ tapes.update.replacement := + tapes.update.ne (by decide) + have hnat := Tape.init_move_right_hasBinaryNat value + refine + { source := by + simpa only [finalWork, Function.update_of_ne hsource] using + hscanner.source + address := by + simpa only [finalWork, Function.update_of_ne haddress] using + hscanner.address + addressStart := by + simpa only [finalWork, Function.update_of_ne haddress] using + hscanner.addressStart + value := by + simpa only [finalWork, Function.update_of_ne hvalue] using + hscanner.value + valueStart := by + simpa only [finalWork, Function.update_of_ne hvalue] using + hscanner.valueStart + addressCounter := by + simpa only [finalWork, Function.update_of_ne haddressCounter] using + hscanner.addressCounter + addressWidth := by + simpa only [finalWork, Function.update_of_ne haddressWidth] using + hscanner.addressWidth + valueCounter := by + simpa only [finalWork, Function.update_of_ne hvalueCounter] using + hscanner.valueCounter + valueWidth := by + simpa only [finalWork, Function.update_of_ne hvalueWidth] using + hscanner.valueWidth + query := by + simpa only [finalWork, Function.update_of_ne hquery] using + hscanner.query + queryStart := by + simpa only [finalWork, Function.update_of_ne hquery] using + hscanner.queryStart + result := by + simpa only [finalWork, Function.update_of_ne hresult] using + hscanner.result + resultStart := by + simpa only [finalWork, Function.update_of_ne hresult] using + hscanner.resultStart + parked := ?_ + frame := by intro i _ _ _ _ _ _ _ _ _; rfl } + intro i + by_cases hi : i = tapes.update.replacement + · subst i + simpa only [finalWork, Function.update_self] using + (show TM.Parked + ((Tape.init (value.bits.map Γ.ofBool)).move Dir3.right) from + ⟨by rw [hnat.2.1], hnat.2.hasBinaryContent.cells_ne_start⟩) + · simpa only [finalWork, Function.update_of_ne hi] using hscanner.parked i + +private theorem denseStoreUpdate_ready + (tapes : BinaryInstructionTapes n) (input : List Bool) + (overlay : Store) (addressRegister source : ℕ) + (initialWork operandsWork : Fin n → Tape) + (hinitial : EntryLookupStaticReady tapes.lhsLookup overlay initialWork) + (hoperands : DenseDirectBinaryOperandsResult tapes input overlay + addressRegister source initialWork operandsWork) : + let address := DenseOverlay.read input overlay addressRegister + let value := DenseOverlay.read input overlay source + let queryWork := Function.update operandsWork tapes.update.entry.query + ((Tape.init (address.bits.map Γ.ofBool)).move Dir3.right) + let updateWork := Function.update queryWork tapes.update.replacement + ((Tape.init (value.bits.map Γ.ofBool)).move Dir3.right) + EntryScanReady tapes.update.entry (overlay.flatMap Entry.encode) + address.bits updateWork updateWork ∧ + (updateWork tapes.update.replacement).HasBinaryNat value ∧ + (updateWork tapes.update.remaining).HasBinaryNat overlay.length ∧ + (updateWork tapes.update.found).HasBinaryNat 0 ∧ + (updateWork tapes.update.resultCount).HasBinaryNat overlay.length ∧ + ∀ i, TM.Parked (updateWork i) := by + dsimp only + rcases hoperands with ⟨lhsWork, hlhs, hrhs⟩ + let address := DenseOverlay.read input overlay addressRegister + let value := DenseOverlay.read input overlay source + let queryWork := Function.update operandsWork tapes.update.entry.query + ((Tape.init (address.bits.map Γ.ofBool)).move Dir3.right) + let updateWork := Function.update queryWork tapes.update.replacement + ((Tape.init (value.bits.map Γ.ofBool)).move Dir3.right) + have hqueryScanner := scanner_updateQuery_internal tapes overlay address + operandsWork hrhs.scanner + have hscanner : EntryScanReady tapes.update.entry + (overlay.flatMap Entry.encode) address.bits updateWork updateWork := by + simpa only [queryWork, updateWork] using + scanner_after_replacement tapes overlay address value queryWork + hqueryScanner + have hvalueNat := Tape.init_move_right_hasBinaryNat value + have hresultCount : + (operandsWork tapes.update.resultCount).HasBinaryNat overlay.length := by + rw [show operandsWork tapes.update.resultCount = + lhsWork tapes.update.resultCount by simpa using hrhs.countSource] + rw [show lhsWork tapes.update.resultCount = + initialWork tapes.update.resultCount by simpa using hlhs.countSource] + simpa using hinitial.countSource + have hremainingReplacement : + tapes.update.remaining ≠ tapes.update.replacement := + tapes.update.ne (by decide) + have hremainingQuery : + tapes.update.remaining ≠ tapes.update.entry.query := + tapes.update.ne (by decide) + have hfoundReplacement : tapes.update.found ≠ tapes.update.replacement := + tapes.update.ne (by decide) + have hfoundQuery : tapes.update.found ≠ tapes.update.entry.query := + tapes.update.ne (by decide) + have hresultCountReplacement : + tapes.update.resultCount ≠ tapes.update.replacement := + tapes.update.ne (by decide) + have hresultCountQuery : + tapes.update.resultCount ≠ tapes.update.entry.query := + tapes.update.ne (by decide) + refine ⟨hscanner, ?_, ?_, ?_, ?_, hscanner.parked⟩ + · simpa only [updateWork, Function.update_self] using hvalueNat + · simpa only [updateWork, Function.update_of_ne hremainingReplacement, + queryWork, Function.update_of_ne hremainingQuery] using hrhs.count + · simpa only [updateWork, Function.update_of_ne hfoundReplacement, + queryWork, Function.update_of_ne hfoundQuery] using hrhs.copyScratch + · simpa only [updateWork, Function.update_of_ne hresultCountReplacement, + queryWork, Function.update_of_ne hresultCountQuery] using hresultCount + +/-- Exact semantic and time contract for one dense-overlay indirect store. -/ +theorem denseIndirectStoreInstructionTM_hoareTime_frame + (tapes : BinaryInstructionTapes n) (input : List Bool) + (overlay : Store) (addressRegister source : ℕ) + (emittedBits : List Bool) (initialWork : Fin n → Tape) (out₀ : Tape) + (hvalid : DenseOverlay.Valid overlay) + (hinitial : EntryLookupStaticReady tapes.lhsLookup overlay initialWork) + (hrhs₀ : (initialWork tapes.rhs).HasBinaryNat 0) + (hreplacement : (initialWork tapes.update.replacement).HasBinaryNat 0) + (houtput : out₀.HasBinaryPrefix emittedBits) : + (denseIndirectStoreInstructionTM tapes addressRegister source).HoareTime + (fun inp work out => + inp = (Tape.init (input.map Γ.ofBool)).move Dir3.right ∧ + work = initialWork ∧ out = out₀) + (fun inp work out => + inp = (Tape.init (input.map Γ.ofBool)).move Dir3.right ∧ + DenseIndirectStoreInstructionResult tapes input overlay addressRegister + source initialWork work ∧ + out.HasBinaryPrefix + (emittedBits ++ + (DenseOverlay.write overlay + (DenseOverlay.read input overlay addressRegister) + (DenseOverlay.read input overlay source)).flatMap Entry.encode)) + (denseIndirectStoreInstructionTime tapes input overlay addressRegister + source) := by + let inp₀ := (Tape.init (input.map Γ.ofBool)).move Dir3.right + let address := DenseOverlay.read input overlay addressRegister + let value := DenseOverlay.read input overlay source + have hinput : TM.Parked inp₀ := by + refine ⟨by simp [inp₀, Tape.move], ?_⟩ + simpa [inp₀] using Tape.init_ofBool_move_right_cells_ne_start input + have houtputParked := hasBinaryPrefix_parked houtput + have hoperands := denseDirectBinaryOperands_hoareTime tapes input overlay + addressRegister source initialWork out₀ hvalid hinitial hrhs₀ houtputParked + have hquery : + (TM.binaryCopyIntoTM tapes.lhs tapes.update.entry.query + tapes.update.found).HoareTime + (fun inp work out => + inp = inp₀ ∧ + DenseDirectBinaryOperandsResult tapes input overlay addressRegister + source initialWork work ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + (∃ operandsWork, + DenseDirectBinaryOperandsResult tapes input overlay addressRegister + source initialWork operandsWork ∧ + work = Function.update operandsWork tapes.update.entry.query + ((Tape.init (address.bits.map Γ.ofBool)).move Dir3.right)) ∧ + out = out₀) + (TM.binaryCopyTime address 0) := by + rintro inp work out ⟨hinp, hops, hout⟩ + have hvalues := denseStoreOperands_values tapes input overlay + addressRegister source initialWork work hops + have hrun := TM.binaryCopyIntoTM_hoareTime_frame tapes.lhs + tapes.update.entry.query tapes.update.found (tapes.ne (by decide)) + (tapes.ne (by decide)) (tapes.update.ne (by decide)) address 0 inp work + out (by simpa [address] using hvalues.1) + ⟨(by rcases hops with ⟨_, _, hrhs⟩; exact hrhs.scanner.queryStart), + (by rcases hops with ⟨_, _, hrhs⟩; + simpa using hrhs.scanner.query)⟩ + hvalues.2.2.1 (by simpa [hinp] using hinput) + (fun i _ _ _ => hvalues.2.2.2 i) + (by simpa [hout] using houtputParked) + obtain ⟨final, time, htime, hreach, hhalt, hfinalInput, + hfinalWork, hfinalOutput⟩ := hrun inp work out ⟨rfl, rfl, rfl⟩ + exact ⟨final, time, htime, hreach, hhalt, hfinalInput.trans hinp, + ⟨work, hops, by simpa [address] using hfinalWork⟩, + hfinalOutput.trans hout⟩ + have hvalue : + (TM.binaryCopyIntoTM tapes.rhs tapes.update.replacement + tapes.update.found).HoareTime + (fun inp work out => + inp = inp₀ ∧ + (∃ operandsWork, + DenseDirectBinaryOperandsResult tapes input overlay addressRegister + source initialWork operandsWork ∧ + work = Function.update operandsWork tapes.update.entry.query + ((Tape.init (address.bits.map Γ.ofBool)).move Dir3.right)) ∧ + out = out₀) + (fun inp work out => + inp = inp₀ ∧ + (∃ operandsWork queryWork, + DenseDirectBinaryOperandsResult tapes input overlay addressRegister + source initialWork operandsWork ∧ + queryWork = Function.update operandsWork tapes.update.entry.query + ((Tape.init (address.bits.map Γ.ofBool)).move Dir3.right) ∧ + work = Function.update queryWork tapes.update.replacement + ((Tape.init (value.bits.map Γ.ofBool)).move Dir3.right)) ∧ + out = out₀) + (TM.binaryCopyTime value 0) := by + rintro inp work out ⟨hinp, ⟨operandsWork, hops, hwork⟩, hout⟩ + subst work + have hvalues := denseStoreOperands_values tapes input overlay + addressRegister source initialWork operandsWork hops + let queryWork := Function.update operandsWork tapes.update.entry.query + ((Tape.init (address.bits.map Γ.ofBool)).move Dir3.right) + have hrhsQuery : tapes.rhs ≠ tapes.update.entry.query := + tapes.ne (by decide) + have hreplacementQuery : + tapes.update.replacement ≠ tapes.update.entry.query := + tapes.update.ne (by decide) + have hfoundQuery : tapes.update.found ≠ tapes.update.entry.query := + tapes.update.ne (by decide) + have hrun := TM.binaryCopyIntoTM_hoareTime_frame tapes.rhs + tapes.update.replacement tapes.update.found (tapes.ne (by decide)) + (tapes.ne (by decide)) (tapes.update.ne (by decide)) value 0 inp + queryWork out + (by simpa only [queryWork, Function.update_of_ne hrhsQuery, value] using + hvalues.2.1) + (by + have hreplEq : operandsWork tapes.update.replacement = + initialWork tapes.update.replacement := by + rcases hops with ⟨lhsWork, hlhs, hrhs⟩ + rw [hrhs.frame tapes.update.replacement + (fun slot => (tapes.rhsLookup_ne_replacement slot).symm)] + exact hlhs.frame tapes.update.replacement + (fun slot => (tapes.lhsLookup_ne_replacement slot).symm) + simpa only [queryWork, Function.update_of_ne hreplacementQuery, + hreplEq] using hreplacement) + (by simpa only [queryWork, Function.update_of_ne hfoundQuery] using + hvalues.2.2.1) + (by simpa [hinp] using hinput) + (fun i _ _ _ => by + by_cases hi : i = tapes.update.entry.query + · subst i + have hnat := Tape.init_move_right_hasBinaryNat address + simpa only [queryWork, Function.update_self] using + (show TM.Parked + ((Tape.init (address.bits.map Γ.ofBool)).move Dir3.right) from + ⟨by rw [hnat.2.1], hnat.2.hasBinaryContent.cells_ne_start⟩) + · simpa only [queryWork, Function.update_of_ne hi] using + hvalues.2.2.2 i) + (by simpa [hout] using houtputParked) + obtain ⟨final, time, htime, hreach, hhalt, hfinalInput, + hfinalWork, hfinalOutput⟩ := + hrun inp queryWork out ⟨rfl, rfl, rfl⟩ + exact ⟨final, time, htime, hreach, hhalt, hfinalInput.trans hinp, + ⟨operandsWork, queryWork, hops, rfl, + by simpa [value] using hfinalWork⟩, + hfinalOutput.trans hout⟩ + have hupdate : (taggedEntryUpdateTM tapes.update).HoareTime + (fun inp work out => + inp = inp₀ ∧ + (∃ operandsWork queryWork, + DenseDirectBinaryOperandsResult tapes input overlay addressRegister + source initialWork operandsWork ∧ + queryWork = Function.update operandsWork tapes.update.entry.query + ((Tape.init (address.bits.map Γ.ofBool)).move Dir3.right) ∧ + work = Function.update queryWork tapes.update.replacement + ((Tape.init (value.bits.map Γ.ofBool)).move Dir3.right)) ∧ + out = out₀) + (fun inp work out => + inp = inp₀ ∧ + DenseIndirectStoreInstructionResult tapes input overlay addressRegister + source initialWork work ∧ + out.HasBinaryPrefix + (emittedBits ++ + (DenseOverlay.write overlay address value).flatMap Entry.encode)) + (taggedEntryUpdateTime tapes.update overlay address value) := by + rintro inp work out ⟨hinp, ⟨operandsWork, queryWork, hops, + hqueryWork, hwork⟩, hout⟩ + subst queryWork + subst work + have hready := denseStoreUpdate_ready tapes input overlay addressRegister + source initialWork operandsWork hinitial hops + let updateWork := Function.update + (Function.update operandsWork tapes.update.entry.query + ((Tape.init (address.bits.map Γ.ofBool)).move Dir3.right)) + tapes.update.replacement + ((Tape.init (value.bits.map Γ.ofBool)).move Dir3.right) + have hrun := taggedEntryUpdateTM_hoareTime_frame tapes.update overlay + address value emittedBits updateWork inp₀ out₀ hvalid.1 hready.1 + hready.2.1 hready.2.2.1 hready.2.2.2.1 hready.2.2.2.2.1 hinput + houtput + obtain ⟨final, time, htime, hreach, hhalt, hfinalInput, + houtcome, hfinalOutput⟩ := + hrun inp updateWork out ⟨hinp, rfl, hout⟩ + exact ⟨final, time, htime, hreach, hhalt, hfinalInput, + ⟨operandsWork, + Function.update operandsWork tapes.update.entry.query + ((Tape.init (address.bits.map Γ.ofBool)).move Dir3.right), + updateWork, hops, rfl, rfl, by simpa [address, value] using houtcome⟩, + by simpa [address, value] using hfinalOutput⟩ + have hvalueUpdate := TM.seqTM_hoareTime + (TM.binaryCopyIntoTM tapes.rhs tapes.update.replacement tapes.update.found) + (taggedEntryUpdateTM tapes.update) hvalue + (by + rintro inp work out ⟨hinp, ⟨operandsWork, queryWork, hops, + hqueryWork, hwork⟩, hout⟩ + subst queryWork + subst work + have hready := denseStoreUpdate_ready tapes input overlay addressRegister + source initialWork operandsWork hinitial hops + obtain ⟨hi, hw, ho⟩ := phaseTransition_of_parked + (inp := inp) + (work := Function.update + (Function.update operandsWork tapes.update.entry.query + ((Tape.init (address.bits.map Γ.ofBool)).move Dir3.right)) + tapes.update.replacement + ((Tape.init (value.bits.map Γ.ofBool)).move Dir3.right)) + (out := out) (by simpa [hinp] using hinput) hready.2.2.2.2.2 + (by simpa [hout] using houtputParked) + rw [hi, hw, ho] + exact ⟨hinp, ⟨operandsWork, _, hops, rfl, rfl⟩, hout⟩) + hupdate + have hqueryRest := TM.seqTM_hoareTime + (TM.binaryCopyIntoTM tapes.lhs tapes.update.entry.query tapes.update.found) + (TM.seqTM + (TM.binaryCopyIntoTM tapes.rhs tapes.update.replacement tapes.update.found) + (taggedEntryUpdateTM tapes.update)) hquery + (by + rintro inp work out ⟨hinp, ⟨operandsWork, hops, hwork⟩, hout⟩ + subst work + have hvalues := denseStoreOperands_values tapes input overlay + addressRegister source initialWork operandsWork hops + have hparked : ∀ i, TM.Parked + (Function.update operandsWork tapes.update.entry.query + ((Tape.init (address.bits.map Γ.ofBool)).move Dir3.right) i) := by + intro i + by_cases hi : i = tapes.update.entry.query + · subst i + have hnat := Tape.init_move_right_hasBinaryNat address + simpa only [Function.update_self] using + (show TM.Parked + ((Tape.init (address.bits.map Γ.ofBool)).move Dir3.right) from + ⟨by rw [hnat.2.1], hnat.2.hasBinaryContent.cells_ne_start⟩) + · simpa only [Function.update_of_ne hi] using hvalues.2.2.2 i + obtain ⟨hi, hw, ho⟩ := phaseTransition_of_parked + (inp := inp) + (work := Function.update operandsWork tapes.update.entry.query + ((Tape.init (address.bits.map Γ.ofBool)).move Dir3.right)) + (out := out) (by simpa [hinp] using hinput) hparked + (by simpa [hout] using houtputParked) + rw [hi, hw, ho] + exact ⟨hinp, ⟨operandsWork, hops, rfl⟩, hout⟩) + hvalueUpdate + have hall := TM.seqTM_hoareTime + (TM.seqTM (denseOverlayLookupStaticTM tapes.lhsLookup addressRegister) + (denseOverlayLookupStaticTM tapes.rhsLookup source)) + (TM.seqTM + (TM.binaryCopyIntoTM tapes.lhs tapes.update.entry.query tapes.update.found) + (TM.seqTM + (TM.binaryCopyIntoTM tapes.rhs tapes.update.replacement + tapes.update.found) + (taggedEntryUpdateTM tapes.update))) hoperands + (by + rintro inp work out ⟨hinp, hops, hout⟩ + have hvalues := denseStoreOperands_values tapes input overlay + addressRegister source initialWork work hops + obtain ⟨hi, hw, ho⟩ := phaseTransition_of_parked + (inp := inp) (work := work) (out := out) + (by simpa [hinp] using hinput) hvalues.2.2.2 + (by simpa [hout] using houtputParked) + rw [hi, hw, ho] + exact ⟨hinp, hops, hout⟩) + hqueryRest + simpa [denseIndirectStoreInstructionTM, denseIndirectStoreInstructionTime, + inp₀, address, value] using hall + +end Machine +end RegisterStore +end RAM +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Direct.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Direct.lean new file mode 100644 index 0000000000..bd0d26ade5 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Direct.lean @@ -0,0 +1,513 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Internal +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Internal.Static + +/-! +# Direct sparse-store arithmetic instructions -- proof internals +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace RegisterStore + +namespace Machine + +variable {n : ℕ} + +theorem scanner_rhs_of_lhs_internal + (tapes : BinaryInstructionTapes n) (store : Store) (source : ℕ) + (initialWork finalWork : Fin n → Tape) + (hlookup : EntryLookupStaticResult tapes.lhsLookup store source + initialWork finalWork) : + EntryScanReady tapes.rhsLookup.scan.entry (store.flatMap Entry.encode) [] + finalWork finalWork := by + refine + { source := ?_ + address := ?_ + addressStart := ?_ + value := ?_ + valueStart := ?_ + addressCounter := ?_ + addressWidth := ?_ + valueCounter := ?_ + valueWidth := ?_ + query := ?_ + queryStart := ?_ + result := ?_ + resultStart := ?_ + parked := hlookup.parked + frame := by intro i _ _ _ _ _ _ _ _ _; rfl } + · exact hlookup.scanner.source + · exact hlookup.scanner.address + · exact hlookup.scanner.addressStart + · exact hlookup.scanner.value + · exact hlookup.scanner.valueStart + · exact hlookup.scanner.addressCounter + · exact hlookup.scanner.addressWidth + · exact hlookup.scanner.valueCounter + · exact hlookup.scanner.valueWidth + · exact hlookup.scanner.query + · exact hlookup.scanner.queryStart + · exact hlookup.scanner.result + · exact hlookup.scanner.resultStart + +theorem rhsReady_of_lhs_internal + (tapes : BinaryInstructionTapes n) (store : Store) (source : ℕ) + (initialWork finalWork : Fin n → Tape) + (hinitial : EntryLookupStaticReady tapes.lhsLookup store initialWork) + (hrhs : (initialWork tapes.rhs).HasBinaryNat 0) + (hlookup : EntryLookupStaticResult tapes.lhsLookup store source + initialWork finalWork) : + EntryLookupStaticReady tapes.rhsLookup store finalWork := by + have hrhsEq : finalWork tapes.rhs = initialWork tapes.rhs := + hlookup.frame tapes.rhs + (fun slot => (tapes.lhsLookup_ne_rhs slot).symm) + refine + { scanner := scanner_rhs_of_lhs_internal tapes store source initialWork finalWork + hlookup + sourceStart := hlookup.sourceStart + sourceHead := hlookup.sourceHead + count := by simpa using hlookup.count + countSource := ?_ + querySource := by simpa using hlookup.querySource + destination := by + change (finalWork tapes.rhs).HasBinaryNat 0 + rw [hrhsEq] + exact hrhs + copyScratch := by simpa using hlookup.copyScratch } + change (finalWork tapes.update.resultCount).HasBinaryNat store.length + have hcountSource : finalWork tapes.update.resultCount = + initialWork tapes.update.resultCount := by + simpa using hlookup.countSource + rw [hcountSource] + simpa using hinitial.countSource + +theorem scanner_updateQuery_internal + (tapes : BinaryInstructionTapes n) (store : Store) (destination : ℕ) + (work : Fin n → Tape) + (hscanner : EntryScanReady tapes.rhsLookup.scan.entry + (store.flatMap Entry.encode) [] work work) : + EntryScanReady tapes.update.entry (store.flatMap Entry.encode) + destination.bits + (Function.update work tapes.update.entry.query + ((Tape.init (destination.bits.map Γ.ofBool)).move Dir3.right)) + (Function.update work tapes.update.entry.query + ((Tape.init (destination.bits.map Γ.ofBool)).move Dir3.right)) := by + let finalWork := Function.update work tapes.update.entry.query + ((Tape.init (destination.bits.map Γ.ofBool)).move Dir3.right) + have hsource : tapes.update.entry.source ≠ tapes.update.entry.query := + tapes.update.ne (by decide) + have haddress : tapes.update.entry.address ≠ tapes.update.entry.query := + tapes.update.ne (by decide) + have hvalue : tapes.update.entry.value ≠ tapes.update.entry.query := + tapes.update.ne (by decide) + have haddressCounter : + tapes.update.entry.addressCounter ≠ tapes.update.entry.query := + tapes.update.ne (by decide) + have haddressWidth : + tapes.update.entry.addressWidth ≠ tapes.update.entry.query := + tapes.update.ne (by decide) + have hvalueCounter : + tapes.update.entry.valueCounter ≠ tapes.update.entry.query := + tapes.update.ne (by decide) + have hvalueWidth : + tapes.update.entry.valueWidth ≠ tapes.update.entry.query := + tapes.update.ne (by decide) + have hresult : tapes.update.entry.result ≠ tapes.update.entry.query := + tapes.update.ne (by decide) + have hnat := Tape.init_move_right_hasBinaryNat destination + refine + { source := ?_ + address := ?_ + addressStart := ?_ + value := ?_ + valueStart := ?_ + addressCounter := ?_ + addressWidth := ?_ + valueCounter := ?_ + valueWidth := ?_ + query := ?_ + queryStart := ?_ + result := ?_ + resultStart := ?_ + parked := ?_ + frame := by intro i _ _ _ _ _ _ _ _ _; rfl } + · simpa only [finalWork, Function.update_of_ne hsource] using hscanner.source + · simpa only [finalWork, Function.update_of_ne haddress] using hscanner.address + · simpa only [finalWork, Function.update_of_ne haddress] using + hscanner.addressStart + · simpa only [finalWork, Function.update_of_ne hvalue] using hscanner.value + · simpa only [finalWork, Function.update_of_ne hvalue] using + hscanner.valueStart + · simpa only [finalWork, Function.update_of_ne haddressCounter] using + hscanner.addressCounter + · simpa only [finalWork, Function.update_of_ne haddressWidth] using + hscanner.addressWidth + · simpa only [finalWork, Function.update_of_ne hvalueCounter] using + hscanner.valueCounter + · simpa only [finalWork, Function.update_of_ne hvalueWidth] using + hscanner.valueWidth + · simpa only [finalWork, Function.update_self] using hnat.2 + · simpa only [finalWork, Function.update_self] using hnat.1 + · simpa only [finalWork, Function.update_of_ne hresult] using hscanner.result + · simpa only [finalWork, Function.update_of_ne hresult] using + hscanner.resultStart + · intro i + by_cases hi : i = tapes.update.entry.query + · subst i + simpa only [finalWork, Function.update_self] using + (show TM.Parked + ((Tape.init (destination.bits.map Γ.ofBool)).move Dir3.right) from + ⟨by rw [hnat.2.1], hnat.2.hasBinaryContent.cells_ne_start⟩) + · simpa only [finalWork, Function.update_of_ne hi] using hscanner.parked i + +private theorem directAddress_ready + (tapes : BinaryInstructionTapes n) (store : Store) + (destination source₀ source₁ : ℕ) + (initialWork finalWork : Fin n → Tape) + (hinitial : EntryLookupStaticReady tapes.lhsLookup store initialWork) + (hreplacement : (initialWork tapes.update.replacement).HasBinaryNat 0) + (htmp : (initialWork tapes.tmp).HasBinaryNat 0) + (hdbl : (initialWork tapes.dbl).HasBinaryNat 0) + (haddress : DirectBinaryAddressResult tapes store destination source₀ + source₁ initialWork finalWork) : + DirectBinaryUpdateReady tapes store destination source₀ source₁ + finalWork := by + rcases haddress with ⟨operandsWork, ⟨lhsWork, hlhs, hrhs⟩, rfl⟩ + have hlhsEq : operandsWork tapes.lhs = lhsWork tapes.lhs := + hrhs.frame tapes.lhs + (fun slot => (tapes.rhsLookup_ne_lhs slot).symm) + have hlhsValue : + (operandsWork tapes.lhs).HasBinaryNat + (RegisterStore.read store source₀) := by + rw [hlhsEq] + simpa using hlhs.destination + have hreplacementEq : + operandsWork tapes.update.replacement = + initialWork tapes.update.replacement := by + rw [hrhs.frame tapes.update.replacement + (fun slot => (tapes.rhsLookup_ne_replacement slot).symm)] + exact hlhs.frame tapes.update.replacement + (fun slot => (tapes.lhsLookup_ne_replacement slot).symm) + have htmpEq : operandsWork tapes.tmp = initialWork tapes.tmp := by + rw [hrhs.frame tapes.tmp + (fun slot => (tapes.rhsLookup_ne_tmp slot).symm)] + exact hlhs.frame tapes.tmp + (fun slot => (tapes.lhsLookup_ne_tmp slot).symm) + have hdblEq : operandsWork tapes.dbl = initialWork tapes.dbl := by + rw [hrhs.frame tapes.dbl + (fun slot => (tapes.rhsLookup_ne_dbl slot).symm)] + exact hlhs.frame tapes.dbl + (fun slot => (tapes.lhsLookup_ne_dbl slot).symm) + have hresultCount : + (operandsWork tapes.update.resultCount).HasBinaryNat store.length := by + rw [show operandsWork tapes.update.resultCount = + lhsWork tapes.update.resultCount by simpa using hrhs.countSource] + rw [show lhsWork tapes.update.resultCount = + initialWork tapes.update.resultCount by simpa using hlhs.countSource] + simpa using hinitial.countSource + have hqueryNeLhs : tapes.lhs ≠ tapes.update.entry.query := + tapes.ne (by decide) + have hqueryNeRhs : tapes.rhs ≠ tapes.update.entry.query := + tapes.ne (by decide) + have hqueryNeReplacement : + tapes.update.replacement ≠ tapes.update.entry.query := + tapes.update.ne (by decide) + have hqueryNeShift : tapes.shift ≠ tapes.update.entry.query := + (tapes.update_ne_shift 7).symm + have hqueryNeTmp : tapes.tmp ≠ tapes.update.entry.query := + (tapes.update_ne_tmp 7).symm + have hqueryNeDbl : tapes.dbl ≠ tapes.update.entry.query := + (tapes.update_ne_dbl 7).symm + have hqueryNeRemaining : + tapes.update.remaining ≠ tapes.update.entry.query := + tapes.update.ne (by decide) + have hqueryNeFound : tapes.update.found ≠ tapes.update.entry.query := + tapes.update.ne (by decide) + have hqueryNeResultCount : + tapes.update.resultCount ≠ tapes.update.entry.query := + tapes.update.ne (by decide) + refine + { scanner := scanner_updateQuery_internal tapes store destination operandsWork + hrhs.scanner + lhs := ?_ + rhs := ?_ + replacement := ?_ + shift := ?_ + tmp := ?_ + dbl := ?_ + remaining := ?_ + found := ?_ + resultCount := ?_ + parked := ?_ } + · simpa only [Function.update_of_ne hqueryNeLhs] using hlhsValue + · simpa only [Function.update_of_ne hqueryNeRhs] using hrhs.destination + · simpa only [Function.update_of_ne hqueryNeReplacement, hreplacementEq] + using hreplacement + · simpa only [Function.update_of_ne hqueryNeShift] using hrhs.querySource + · simpa only [Function.update_of_ne hqueryNeTmp, htmpEq] using htmp + · simpa only [Function.update_of_ne hqueryNeDbl, hdblEq] using hdbl + · simpa only [Function.update_of_ne hqueryNeRemaining] using hrhs.count + · simpa only [Function.update_of_ne hqueryNeFound] using hrhs.copyScratch + · simpa only [Function.update_of_ne hqueryNeResultCount] using hresultCount + · exact (scanner_updateQuery_internal tapes store destination operandsWork + hrhs.scanner).parked + +private theorem hasBinaryPrefix_parked {t : Tape} {bits : List Bool} + (h : t.HasBinaryPrefix bits) : TM.Parked t := by + refine ⟨by rw [h.1]; omega, ?_⟩ + intro j hj + obtain ⟨i, rfl⟩ : ∃ i, j = i + 1 := ⟨j - 1, by omega⟩ + by_cases hi : i < bits.length + · rw [h.2.1 i hi] + exact Γ.ofBool_ne_start _ + · rw [h.2.2 i (Nat.le_of_not_gt hi)] + decide + +private theorem phaseTransition_of_parked + {inp out : Tape} {work : Fin n → Tape} + (hinput : TM.Parked inp) (hwork : ∀ i, TM.Parked (work i)) + (houtput : TM.Parked out) : + TM.transitionInput inp = inp ∧ + (fun i => TM.transitionTape (work i)) = work ∧ + TM.transitionTape out = out := + TM.phaseTransition_eq_self_of_reads_ne_start hinput.read_ne_start + (fun i => (hwork i).read_ne_start) houtput.read_ne_start + +/-- The shared two-direct-operand prefix used by arithmetic and indirect +store instructions. -/ +theorem directBinaryOperands_hoareTime_internal + (tapes : BinaryInstructionTapes n) (store : Store) + (source₀ source₁ : ℕ) (initialWork : Fin n → Tape) + (inp₀ out₀ : Tape) + (hinitial : EntryLookupStaticReady tapes.lhsLookup store initialWork) + (hrhs₀ : (initialWork tapes.rhs).HasBinaryNat 0) + (hinput : TM.Parked inp₀) (houtput : TM.Parked out₀) : + (TM.seqTM (entryLookupStaticTM tapes.lhsLookup source₀) + (entryLookupStaticTM tapes.rhsLookup source₁)).HoareTime + (fun inp work out => inp = inp₀ ∧ work = initialWork ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + DirectBinaryOperandsResult tapes store source₀ source₁ + initialWork work ∧ + out = out₀) + (entryLookupStaticTime tapes.lhsLookup store source₀ + 1 + + entryLookupStaticTime tapes.rhsLookup store source₁) := by + have hlhs := entryLookupStatic_hoareTime_internal tapes.lhsLookup store + source₀ initialWork inp₀ out₀ hinitial hinput houtput + have hrhs : (entryLookupStaticTM tapes.rhsLookup source₁).HoareTime + (fun inp work out => + inp = inp₀ ∧ + EntryLookupStaticResult tapes.lhsLookup store source₀ + initialWork work ∧ + out = out₀) + (fun inp work out => + inp = inp₀ ∧ + DirectBinaryOperandsResult tapes store source₀ source₁ + initialWork work ∧ + out = out₀) + (entryLookupStaticTime tapes.rhsLookup store source₁) := by + rintro inp work out ⟨hinp, hlhsResult, hout⟩ + have hready := rhsReady_of_lhs_internal tapes store source₀ initialWork + work hinitial hrhs₀ hlhsResult + have hrun := entryLookupStatic_hoareTime_internal tapes.rhsLookup store + source₁ work inp₀ out₀ hready hinput houtput + obtain ⟨final, time, htime, hreach, hhalt, hfinalInput, + hrhsResult, hfinalOutput⟩ := + hrun inp work out ⟨hinp, rfl, hout⟩ + exact ⟨final, time, htime, hreach, hhalt, hfinalInput, + ⟨work, hlhsResult, hrhsResult⟩, hfinalOutput⟩ + exact TM.seqTM_hoareTime + (entryLookupStaticTM tapes.lhsLookup source₀) + (entryLookupStaticTM tapes.rhsLookup source₁) hlhs + (by + rintro inp work out ⟨hinp, hlhsResult, hout⟩ + obtain ⟨hi, hw, ho⟩ := phaseTransition_of_parked + (inp := inp) (work := work) (out := out) + (by simpa [hinp] using hinput) hlhsResult.parked + (by simpa [hout] using houtput) + rw [hi, hw, ho] + exact ⟨hinp, hlhsResult, hout⟩) + hrhs + +/-- Two fixed sparse reads, direct destination synthesis, width-efficient +arithmetic, and sparse update compose to the pure direct RAM operation. -/ +theorem directBinaryInstructionTM_hoareTime_frame_internal + (tapes : BinaryInstructionTapes n) (op : BinaryInstrOp) + (store : Store) (destination source₀ source₁ : ℕ) + (emittedBits : List Bool) (initialWork : Fin n → Tape) + (inp₀ out₀ : Tape) + (hcanonical : Canonical store) + (hinitial : EntryLookupStaticReady tapes.lhsLookup store initialWork) + (hrhs₀ : (initialWork tapes.rhs).HasBinaryNat 0) + (hreplacement : (initialWork tapes.update.replacement).HasBinaryNat 0) + (htmp : (initialWork tapes.tmp).HasBinaryNat 0) + (hdbl : (initialWork tapes.dbl).HasBinaryNat 0) + (hinput : TM.Parked inp₀) + (houtput : out₀.HasBinaryPrefix emittedBits) : + (directBinaryInstructionTM tapes op destination source₀ source₁).HoareTime + (fun inp work out => inp = inp₀ ∧ work = initialWork ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + DirectBinaryInstructionResult tapes op store destination source₀ + source₁ initialWork work ∧ + out.HasBinaryPrefix + (emittedBits ++ + (RegisterStore.write store destination + (op.eval (RegisterStore.read store source₀) + (RegisterStore.read store source₁))).flatMap Entry.encode)) + (directBinaryInstructionTime tapes op store destination source₀ + source₁) := by + have houtputParked := hasBinaryPrefix_parked houtput + have hlhs := entryLookupStatic_hoareTime_internal tapes.lhsLookup store + source₀ initialWork inp₀ out₀ hinitial hinput houtputParked + have hrhs : (entryLookupStaticTM tapes.rhsLookup source₁).HoareTime + (fun inp work out => + inp = inp₀ ∧ + EntryLookupStaticResult tapes.lhsLookup store source₀ + initialWork work ∧ + out = out₀) + (fun inp work out => + inp = inp₀ ∧ + DirectBinaryOperandsResult tapes store source₀ source₁ + initialWork work ∧ + out = out₀) + (entryLookupStaticTime tapes.rhsLookup store source₁) := by + rintro inp work out ⟨hinp, hlhsResult, hout⟩ + have hready := rhsReady_of_lhs_internal tapes store source₀ initialWork work + hinitial hrhs₀ hlhsResult + have hrun := entryLookupStatic_hoareTime_internal tapes.rhsLookup store + source₁ work inp₀ out₀ hready hinput houtputParked + obtain ⟨final, time, htime, hreach, hhalt, hfinalInput, + hrhsResult, hfinalOutput⟩ := + hrun inp work out ⟨hinp, rfl, hout⟩ + exact ⟨final, time, htime, hreach, hhalt, hfinalInput, + ⟨work, hlhsResult, hrhsResult⟩, hfinalOutput⟩ + have haddress : + (TM.binaryAddConstTM tapes.update.entry.query destination).HoareTime + (fun inp work out => + inp = inp₀ ∧ + DirectBinaryOperandsResult tapes store source₀ source₁ + initialWork work ∧ + out = out₀) + (fun inp work out => + inp = inp₀ ∧ + DirectBinaryAddressResult tapes store destination source₀ source₁ + initialWork work ∧ + out = out₀) + (TM.binaryAddConstTime destination 0) := by + rintro inp work out ⟨hinp, operands, hout⟩ + rcases operands with ⟨lhsWork, hlhsResult, hrhsResult⟩ + have hquery : (work tapes.update.entry.query).HasBinaryNat 0 := by + refine ⟨?_, ?_⟩ + · exact hrhsResult.scanner.queryStart + · simpa using hrhsResult.scanner.query + have hrun := TM.binaryAddConstTM_hoareTime_frame + tapes.update.entry.query destination 0 inp work out hquery + (by simpa [hinp] using hinput) + (fun i _ => hrhsResult.parked i) + (by simpa [hout] using houtputParked) + obtain ⟨final, time, htime, hreach, hhalt, hfinalInput, + hfinalWork, hfinalOutput⟩ := + hrun inp work out ⟨rfl, rfl, rfl⟩ + refine ⟨final, time, htime, hreach, hhalt, + hfinalInput.trans hinp, ?_, hfinalOutput.trans hout⟩ + exact ⟨work, ⟨lhsWork, hlhsResult, hrhsResult⟩, + by simpa only [zero_add] using hfinalWork⟩ + have hupdate : (binaryInstructionUpdateTM tapes op).HoareTime + (fun inp work out => + inp = inp₀ ∧ + DirectBinaryAddressResult tapes store destination source₀ source₁ + initialWork work ∧ + out = out₀) + (fun inp work out => + inp = inp₀ ∧ + DirectBinaryInstructionResult tapes op store destination source₀ + source₁ initialWork work ∧ + out.HasBinaryPrefix + (emittedBits ++ + (RegisterStore.write store destination + (op.eval (RegisterStore.read store source₀) + (RegisterStore.read store source₁))).flatMap Entry.encode)) + (binaryInstructionUpdateTime tapes op store destination + (RegisterStore.read store source₀) + (RegisterStore.read store source₁)) := by + rintro inp work out ⟨hinp, haddressResult, hout⟩ + have hready := directAddress_ready tapes store destination source₀ + source₁ initialWork work hinitial hreplacement htmp hdbl haddressResult + have hrun := binaryInstructionUpdateTM_hoareTime_frame_internal tapes op + store destination (RegisterStore.read store source₀) + (RegisterStore.read store source₁) emittedBits work inp₀ out₀ + hcanonical hready.scanner hready.lhs hready.rhs hready.replacement + hready.shift hready.tmp hready.dbl hready.remaining hready.found + hready.resultCount hinput hready.parked houtput + obtain ⟨final, time, htime, hreach, hhalt, hfinalInput, + hupdateResult, hfinalOutput⟩ := + hrun inp work out ⟨hinp, rfl, hout⟩ + exact ⟨final, time, htime, hreach, hhalt, hfinalInput, + ⟨work, haddressResult, hupdateResult⟩, hfinalOutput⟩ + have haddressUpdate := TM.seqTM_hoareTime + (TM.binaryAddConstTM tapes.update.entry.query destination) + (binaryInstructionUpdateTM tapes op) haddress + (by + rintro inp work out ⟨hinp, haddressResult, hout⟩ + have hready := directAddress_ready tapes store destination source₀ + source₁ initialWork work hinitial hreplacement htmp hdbl + haddressResult + obtain ⟨hi, hw, ho⟩ := phaseTransition_of_parked + (inp := inp) (work := work) (out := out) + (by simpa [hinp] using hinput) hready.parked + (by simpa [hout] using houtputParked) + rw [hi, hw, ho] + exact ⟨hinp, haddressResult, hout⟩) + hupdate + have hrhsRest := TM.seqTM_hoareTime + (entryLookupStaticTM tapes.rhsLookup source₁) + (TM.seqTM (TM.binaryAddConstTM tapes.update.entry.query destination) + (binaryInstructionUpdateTM tapes op)) hrhs + (by + rintro inp work out ⟨hinp, operands, hout⟩ + rcases operands with ⟨lhsWork, hlhsResult, hrhsResult⟩ + obtain ⟨hi, hw, ho⟩ := phaseTransition_of_parked + (inp := inp) (work := work) (out := out) + (by simpa [hinp] using hinput) hrhsResult.parked + (by simpa [hout] using houtputParked) + rw [hi, hw, ho] + exact ⟨hinp, ⟨lhsWork, hlhsResult, hrhsResult⟩, hout⟩) + haddressUpdate + have hall := TM.seqTM_hoareTime + (entryLookupStaticTM tapes.lhsLookup source₀) + (TM.seqTM (entryLookupStaticTM tapes.rhsLookup source₁) + (TM.seqTM (TM.binaryAddConstTM tapes.update.entry.query destination) + (binaryInstructionUpdateTM tapes op))) hlhs + (by + rintro inp work out ⟨hinp, hlhsResult, hout⟩ + obtain ⟨hi, hw, ho⟩ := phaseTransition_of_parked + (inp := inp) (work := work) (out := out) + (by simpa [hinp] using hinput) hlhsResult.parked + (by simpa [hout] using houtputParked) + rw [hi, hw, ho] + exact ⟨hinp, hlhsResult, hout⟩) + hrhsRest + simpa [directBinaryInstructionTM, directBinaryInstructionTime] using hall + +end Machine + +end RegisterStore + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Dispatch.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Dispatch.lean new file mode 100644 index 0000000000..cca78d58ec --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Dispatch.lean @@ -0,0 +1,347 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Sim.Defs +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Sim.Control +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Sim.Data +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Sim.Internal + +/-! +# Fixed-program sparse RAM dispatch + +The dispatch machine copies the canonical PC, walks a fixed decrementing +branch tree, and runs the selected instruction with a uniform next-store work +buffer. This surface currently exposes its structural transducer and coarse +all-prefix space certificates; semantic selection is proved in the internal +execution layer. +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace RegisterStore + +namespace Machine + +private theorem parked_blank : + TM.Parked ((Tape.init []).move Dir3.right) := by + refine ⟨by simp [Tape.move], ?_⟩ + intro j hj + simp [Tape.move, Tape.init, show j ≠ 0 by omega] + +private theorem hasBinaryNat_parked {t : Tape} {value : ℕ} + (h : t.HasBinaryNat value) : TM.Parked t := by + refine ⟨by rw [h.2.1], ?_⟩ + exact Tape.HasBinaryContent.cells_ne_start h.2.2 + +private theorem copyWorkToWorkTM_isTransducer {n : ℕ} + (source destination : Fin n) : + (TM.copyWorkToWorkTM source destination).IsTransducer := by + intro state iHead wHeads oHead + cases state <;> dsimp only [TM.copyWorkToWorkTM, TM.allIdle] + · split <;> simp only [TM.idleDir] <;> split <;> decide + · simp only [TM.idleDir] + split <;> decide + +/-- Pure branch-tree selection agrees with list lookup and the RAM model's +out-of-range `halt` convention. -/ +theorem selectedInstruction_eq_getElem?_getD (program : Program) + (selector : ℕ) : + selectedInstruction program selector = + (program[selector]?).getD Instr.halt := by + induction program generalizing selector with + | nil => simp [selectedInstruction] + | cons instruction program ih => + cases selector with + | zero => simp [selectedInstruction] + | succ selector => simp [selectedInstruction, ih] + +/-- Public generic correctness rule for the finite decrementing dispatch +tree. -/ +theorem dispatchProgramTM_hoareTime_of_execute {n : ℕ} + (tapes : ControlInstructionTapes n) (program : Program) + (store : Store) (pcValue selector : ℕ) + (cleanWork work₀ : Fin (n + 1) → Tape) (inp₀ out₀ : Tape) + (hready : DispatchReady tapes store pcValue selector cleanWork work₀) + (hinput : TM.Parked inp₀) (houtput : TM.Parked out₀) + (hexecute : ∀ instruction, + (executeInstructionTM tapes instruction).HoareTime + (fun inp work out => + inp = inp₀ ∧ work = cleanWork ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + InstructionExecutionResult tapes instruction pcValue store work ∧ + out = out₀) + (executeInstructionTime tapes instruction pcValue store)) : + (dispatchProgramTM tapes program).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + InstructionExecutionResult tapes + (selectedInstruction program selector) pcValue store work ∧ + out = out₀) + (dispatchProgramTime tapes store pcValue program selector) := + dispatchProgramTM_hoareTime_of_execute_internal tapes program store pcValue + selector cleanWork work₀ inp₀ out₀ hready hinput houtput hexecute + +/-- Every statically selected RAM instruction realizes the common buffered +snapshot-step contract. -/ +theorem executeInstructionTM_hoareTime_frame {n : ℕ} + (tapes : ControlInstructionTapes n) (instruction : Instr) + (store : Store) (pcValue : ℕ) (initialWork : Fin (n + 1) → Tape) + (inp₀ : Tape) + (hready : InstructionExecutionReady tapes store pcValue initialWork) + (hinput : TM.Parked inp₀) : + (executeInstructionTM tapes instruction).HoareTime + (fun inp work out => + inp = inp₀ ∧ work = initialWork ∧ + out = (Tape.init []).move Dir3.right) + (fun inp work out => + inp = inp₀ ∧ + InstructionExecutionResult tapes instruction pcValue store work ∧ + out = (Tape.init []).move Dir3.right) + (executeInstructionTime tapes instruction pcValue store) := by + have hblank := parked_blank + cases instruction with + | imm destination value => + exact executeInstructionTM_imm_hoareTime_frame tapes store pcValue + destination value initialWork inp₀ hready hinput + | add destination source₀ source₁ => + exact executeInstructionTM_add_hoareTime_frame tapes store pcValue + destination source₀ source₁ initialWork inp₀ hready hinput + | sub destination source₀ source₁ => + exact executeInstructionTM_sub_hoareTime_frame tapes store pcValue + destination source₀ source₁ initialWork inp₀ hready hinput + | mul destination source₀ source₁ => + exact executeInstructionTM_mul_hoareTime_frame tapes store pcValue + destination source₀ source₁ initialWork inp₀ hready hinput + | load destination addressRegister => + exact executeInstructionTM_load_hoareTime_frame tapes store pcValue + destination addressRegister initialWork inp₀ hready hinput + | store addressRegister source => + exact executeInstructionTM_store_hoareTime_frame tapes store pcValue + addressRegister source initialWork inp₀ hready hinput + | jz source target => + exact executeInstructionTM_jz_hoareTime_frame tapes store pcValue source + target initialWork inp₀ ((Tape.init []).move Dir3.right) hready hinput + hblank + | jmp target => + exact executeInstructionTM_jmp_hoareTime_frame tapes store pcValue target + initialWork inp₀ ((Tape.init []).move Dir3.right) hready hinput hblank + | halt => + exact executeInstructionTM_halt_hoareTime_frame tapes store pcValue + initialWork inp₀ ((Tape.init []).move Dir3.right) hready hinput hblank + +/-- Copy the canonical PC into dispatch scratch, select the fixed program +instruction, and realize one exact sparse snapshot step. -/ +theorem programInstructionTM_hoareTime_frame {n : ℕ} + (tapes : ControlInstructionTapes n) (program : Program) + (store : Store) (pcValue : ℕ) (initialWork : Fin (n + 1) → Tape) + (inp₀ : Tape) + (hready : InstructionExecutionReady tapes store pcValue initialWork) + (hinput : TM.Parked inp₀) : + (programInstructionTM tapes program).HoareTime + (fun inp work out => + inp = inp₀ ∧ work = initialWork ∧ + out = (Tape.init []).move Dir3.right) + (fun inp work out => + inp = inp₀ ∧ + InstructionExecutionResult tapes + (selectedInstruction program pcValue) pcValue store work ∧ + out = (Tape.init []).move Dir3.right) + (programInstructionTime tapes program pcValue store) := by + let selectorTape := + (Tape.init (pcValue.bits.map Γ.ofBool)).move Dir3.right + let selectorWork := + Function.update initialWork tapes.liftedLhs selectorTape + have hcopy := TM.binaryCopyIntoTM_hoareTime_frame tapes.liftedPC + tapes.liftedLhs tapes.liftedFound tapes.lifted.pc_ne_lhs + (tapes.lifted.pc_ne 11) (tapes.lifted.data.ne (by decide)) pcValue 0 + inp₀ initialWork ((Tape.init []).move Dir3.right) hready.control.pc + hready.control.lookup.destination hready.control.lookup.copyScratch hinput + (fun i _ _ _ => hready.control.lookup.scanner.parked i) parked_blank + have hselectorReady : DispatchReady tapes store pcValue pcValue initialWork + selectorWork := by + exact ⟨hready, rfl⟩ + have hdispatch := dispatchProgramTM_hoareTime_of_execute tapes program store + pcValue pcValue initialWork selectorWork inp₀ + ((Tape.init []).move Dir3.right) hselectorReady hinput parked_blank + (fun instruction => executeInstructionTM_hoareTime_frame tapes instruction + store pcValue initialWork inp₀ hready hinput) + have hselectorParked : ∀ i, TM.Parked (selectorWork i) := by + intro i + by_cases hi : i = tapes.liftedLhs + · subst i + simp only [selectorWork, Function.update_self] + exact hasBinaryNat_parked (Tape.init_move_right_hasBinaryNat pcValue) + · simp only [selectorWork, Function.update_of_ne hi] + exact hready.control.lookup.scanner.parked i + have hseq := TM.seqTM_hoareTime + (TM.binaryCopyIntoTM tapes.liftedPC tapes.liftedLhs tapes.liftedFound) + (dispatchProgramTM tapes program) hcopy + (by + rintro inp work out ⟨hinp, hworkEq, hout⟩ + have hinpParked : TM.Parked inp := by simpa [hinp] using hinput + have houtParked : TM.Parked out := by simpa [hout] using parked_blank + have hworkParked : ∀ i, TM.Parked (work i) := by + simpa [hworkEq, selectorWork, selectorTape] using hselectorParked + obtain ⟨hi, hw, ho⟩ := + TM.phaseTransition_eq_self_of_reads_ne_start + hinpParked.read_ne_start + (fun i => (hworkParked i).read_ne_start) + houtParked.read_ne_start + rw [hi, hw, ho] + exact ⟨hinp, by simpa [selectorWork, selectorTape] using hworkEq, hout⟩) + hdispatch + simpa only [programInstructionTM, programInstructionTime, selectorWork, + selectorTape] using hseq + +/-- Restore the clean instruction ABI after a buffered instruction result. -/ +theorem instructionCleanupTM_hoareTime_frame {n : ℕ} + (tapes : ControlInstructionTapes n) (instruction : Instr) + (pcValue : ℕ) (store : Store) (sourceHeadBound : ℕ) + (initialWork : Fin (n + 1) → Tape) (inp₀ out₀ : Tape) + (hready : InstructionCleanupReady tapes instruction pcValue store + sourceHeadBound initialWork) + (hinput : TM.Parked inp₀) (houtput : TM.Parked out₀) : + (instructionCleanupTM tapes).HoareTime + (fun inp work out => + inp = inp₀ ∧ work = initialWork ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + InstructionExecutionReady tapes + (instructionStore instruction pcValue store) + (instructionPC instruction pcValue store) work ∧ + out = out₀) + (instructionCleanupTime tapes instruction pcValue store + sourceHeadBound) := + instructionCleanupTM_hoareTime_frame_internal tapes instruction pcValue + store sourceHeadBound initialWork inp₀ out₀ hready hinput houtput + +/-- One fixed-program RAM step returns directly to the reusable clean ABI for +the exact successor sparse snapshot. -/ +theorem programStepTM_hoareTime_frame {n : ℕ} + (tapes : ControlInstructionTapes n) (program : Program) + (store : Store) (pcValue : ℕ) + (initialWork : Fin (n + 1) → Tape) (inp₀ : Tape) + (hready : InstructionExecutionReady tapes store pcValue initialWork) + (hinput : TM.Parked inp₀) : + (programStepTM tapes program).HoareTime + (fun inp work out => + inp = inp₀ ∧ work = initialWork ∧ + out = (Tape.init []).move Dir3.right) + (fun inp work out => + let next := + ({ pc := pcValue, store := store } : Snapshot).step program + inp = inp₀ ∧ + InstructionExecutionReady tapes next.store next.pc work ∧ + out = (Tape.init []).move Dir3.right) + (programStepTime tapes program pcValue store) := by + have hstep := programStepTM_hoareTime_frame_internal tapes program store + pcValue initialWork inp₀ hready hinput + (programInstructionTM_hoareTime_frame tapes program store pcValue + initialWork inp₀ hready hinput) + refine hstep.consequence (fun _ _ _ h => h) ?_ le_rfl + rintro inp work out ⟨hinp, hnext, hout⟩ + refine ⟨hinp, ?_, hout⟩ + simpa [instructionStore, instructionPC, Snapshot.step, Snapshot.curInstr, + selectedInstruction_eq_getElem?_getD] using hnext + +/-- Control execution followed by unchanged-store copying is append-only on +the real output tape. -/ +theorem finishControlInstructionTM_isTransducer {n : ℕ} + (tapes : ControlInstructionTapes n) (control : TM (n + 1)) + (hcontrol : control.IsTransducer) : + (finishControlInstructionTM tapes control).IsTransducer := + hcontrol.seqTM + (copyWorkToWorkTM_isTransducer tapes.liftedSource tapes.buffer) + +/-- Every statically selected RAM instruction is append-only on real output. -/ +theorem executeInstructionTM_isTransducer {n : ℕ} + (tapes : ControlInstructionTapes n) (instruction : Instr) : + (executeInstructionTM tapes instruction).IsTransducer := by + cases instruction with + | imm destination value => + exact (TM.retargetOutput_isTransducer _).seqTM + (TM.binarySuccTM_isTransducer tapes.liftedPC) + | add destination source₀ source₁ => + exact (TM.retargetOutput_isTransducer _).seqTM + (TM.binarySuccTM_isTransducer tapes.liftedPC) + | sub destination source₀ source₁ => + exact (TM.retargetOutput_isTransducer _).seqTM + (TM.binarySuccTM_isTransducer tapes.liftedPC) + | mul destination source₀ source₁ => + exact (TM.retargetOutput_isTransducer _).seqTM + (TM.binarySuccTM_isTransducer tapes.liftedPC) + | load destination addressRegister => + exact (TM.retargetOutput_isTransducer _).seqTM + (TM.binarySuccTM_isTransducer tapes.liftedPC) + | store addressRegister source => + exact (TM.retargetOutput_isTransducer _).seqTM + (TM.binarySuccTM_isTransducer tapes.liftedPC) + | jz source target => + exact finishControlInstructionTM_isTransducer tapes _ + (zeroJumpInstructionTM_isTransducer tapes.lifted source target) + | jmp target => + exact finishControlInstructionTM_isTransducer tapes _ + (jumpInstructionTM_isTransducer tapes.lifted target) + | halt => + exact finishControlInstructionTM_isTransducer tapes _ + haltInstructionTM_isTransducer + +/-- Every node of the fixed finite dispatch tree preserves one-way output. -/ +theorem dispatchProgramTM_isTransducer {n : ℕ} + (tapes : ControlInstructionTapes n) (program : Program) : + (dispatchProgramTM tapes program).IsTransducer := by + induction program with + | nil => + simpa only [dispatchProgramTM] using + ((TM.resetBinaryWorkTM_isTransducer tapes.liftedLhs).seqTM + (executeInstructionTM_isTransducer tapes .halt)) + | cons instruction program ih => + simpa only [dispatchProgramTM] using + ((executeInstructionTM_isTransducer tapes instruction).branchWorkBlankTM + ((TM.binaryPredTM_isTransducer tapes.liftedLhs).seqTM ih)) + +/-- Fixed-program selection followed by selected execution preserves one-way +output. -/ +theorem programInstructionTM_isTransducer {n : ℕ} + (tapes : ControlInstructionTapes n) (program : Program) : + (programInstructionTM tapes program).IsTransducer := + (TM.binaryCopyIntoTM_isTransducer tapes.liftedPC tapes.liftedLhs + tapes.liftedFound).seqTM (dispatchProgramTM_isTransducer tapes program) + +/-- Every prefix of fixed-program selection and execution stays within the +initial auxiliary space plus its advertised total running-time bound. -/ +theorem programInstructionTM_prefix_withinAuxSpace {n : ℕ} + (tapes : ControlInstructionTapes n) (program : Program) + (pcValue : ℕ) (store : Store) + (inputLength initialSpace time : ℕ) + (start current : Complexity.Cfg (n + 1) + (programInstructionTM tapes program).Q) + (hinitial : start.WithinAuxSpace inputLength initialSpace) + (hreach : (programInstructionTM tapes program).reachesIn time start current) + (htime : time ≤ programInstructionTime tapes program pcValue store) : + current.WithinAuxSpace inputLength + (initialSpace + programInstructionTime tapes program pcValue store) := + (hinitial.reachesIn hreach).mono le_rfl (by omega) + +end Machine + +end RegisterStore + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Immediate.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Immediate.lean new file mode 100644 index 0000000000..0674c3c0a2 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Immediate.lean @@ -0,0 +1,366 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryAddConst +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Defs + +/-! +# Immediate sparse-store instructions -- proof internals +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace RegisterStore + +namespace Machine + +variable {n : ℕ} + +private theorem hasBinaryPrefix_parked {t : Tape} {bits : List Bool} + (h : t.HasBinaryPrefix bits) : TM.Parked t := by + refine ⟨by rw [h.1]; omega, ?_⟩ + intro j hj + obtain ⟨i, rfl⟩ : ∃ i, j = i + 1 := ⟨j - 1, by omega⟩ + by_cases hi : i < bits.length + · rw [h.2.1 i hi] + exact Γ.ofBool_ne_start _ + · rw [h.2.2 i (Nat.le_of_not_gt hi)] + decide + +private theorem phaseTransition_of_parked + {inp out : Tape} {work : Fin n → Tape} + (hinput : TM.Parked inp) (hwork : ∀ i, TM.Parked (work i)) + (houtput : TM.Parked out) : + TM.transitionInput inp = inp ∧ + (fun i => TM.transitionTape (work i)) = work ∧ + TM.transitionTape out = out := + TM.phaseTransition_eq_self_of_reads_ne_start hinput.read_ne_start + (fun i => (hwork i).read_ne_start) houtput.read_ne_start + +theorem immediateUpdate_ready_internal + (tapes : BinaryInstructionTapes n) (store : Store) + (destination value : ℕ) (initialWork : Fin n → Tape) + (hinitial : EntryLookupStaticReady tapes.lhsLookup store initialWork) : + let valueWork := Function.update initialWork tapes.update.replacement + ((Tape.init (value.bits.map Γ.ofBool)).move Dir3.right) + let updateWork := Function.update valueWork tapes.update.entry.query + ((Tape.init (destination.bits.map Γ.ofBool)).move Dir3.right) + EntryScanReady tapes.update.entry (store.flatMap Entry.encode) + destination.bits updateWork updateWork ∧ + (updateWork tapes.update.replacement).HasBinaryNat value ∧ + (updateWork tapes.update.remaining).HasBinaryNat store.length ∧ + (updateWork tapes.update.found).HasBinaryNat 0 ∧ + (updateWork tapes.update.resultCount).HasBinaryNat store.length ∧ + ∀ i, TM.Parked (updateWork i) := by + dsimp only + let valueTape := + (Tape.init (value.bits.map Γ.ofBool)).move Dir3.right + let queryTape := + (Tape.init (destination.bits.map Γ.ofBool)).move Dir3.right + let valueWork := Function.update initialWork tapes.update.replacement valueTape + let updateWork := Function.update valueWork tapes.update.entry.query queryTape + have hsourceReplacement : + tapes.update.entry.source ≠ tapes.update.replacement := + tapes.update.ne (by decide) + have hsourceQuery : + tapes.update.entry.source ≠ tapes.update.entry.query := + tapes.update.ne (by decide) + have haddressReplacement : + tapes.update.entry.address ≠ tapes.update.replacement := + tapes.update.ne (by decide) + have haddressQuery : + tapes.update.entry.address ≠ tapes.update.entry.query := + tapes.update.ne (by decide) + have hvalueReplacement : + tapes.update.entry.value ≠ tapes.update.replacement := + tapes.update.ne (by decide) + have hvalueQuery : + tapes.update.entry.value ≠ tapes.update.entry.query := + tapes.update.ne (by decide) + have haddressCounterReplacement : + tapes.update.entry.addressCounter ≠ tapes.update.replacement := + tapes.update.ne (by decide) + have haddressCounterQuery : + tapes.update.entry.addressCounter ≠ tapes.update.entry.query := + tapes.update.ne (by decide) + have haddressWidthReplacement : + tapes.update.entry.addressWidth ≠ tapes.update.replacement := + tapes.update.ne (by decide) + have haddressWidthQuery : + tapes.update.entry.addressWidth ≠ tapes.update.entry.query := + tapes.update.ne (by decide) + have hvalueCounterReplacement : + tapes.update.entry.valueCounter ≠ tapes.update.replacement := + tapes.update.ne (by decide) + have hvalueCounterQuery : + tapes.update.entry.valueCounter ≠ tapes.update.entry.query := + tapes.update.ne (by decide) + have hvalueWidthReplacement : + tapes.update.entry.valueWidth ≠ tapes.update.replacement := + tapes.update.ne (by decide) + have hvalueWidthQuery : + tapes.update.entry.valueWidth ≠ tapes.update.entry.query := + tapes.update.ne (by decide) + have hqueryReplacement : + tapes.update.entry.query ≠ tapes.update.replacement := + tapes.update.ne (by decide) + have hresultReplacement : + tapes.update.entry.result ≠ tapes.update.replacement := + tapes.update.ne (by decide) + have hresultQuery : + tapes.update.entry.result ≠ tapes.update.entry.query := + tapes.update.ne (by decide) + have hreplacementQuery : + tapes.update.replacement ≠ tapes.update.entry.query := + tapes.update.ne (by decide) + have hremainingReplacement : + tapes.update.remaining ≠ tapes.update.replacement := + tapes.update.ne (by decide) + have hremainingQuery : + tapes.update.remaining ≠ tapes.update.entry.query := + tapes.update.ne (by decide) + have hfoundReplacement : + tapes.update.found ≠ tapes.update.replacement := + tapes.update.ne (by decide) + have hfoundQuery : tapes.update.found ≠ tapes.update.entry.query := + tapes.update.ne (by decide) + have hresultCountReplacement : + tapes.update.resultCount ≠ tapes.update.replacement := + tapes.update.ne (by decide) + have hresultCountQuery : + tapes.update.resultCount ≠ tapes.update.entry.query := + tapes.update.ne (by decide) + have hvalueNat := Tape.init_move_right_hasBinaryNat value + have hqueryNat := Tape.init_move_right_hasBinaryNat destination + have hscanner : EntryScanReady tapes.update.entry + (store.flatMap Entry.encode) destination.bits updateWork updateWork := by + refine + { source := ?_ + address := ?_ + addressStart := ?_ + value := ?_ + valueStart := ?_ + addressCounter := ?_ + addressWidth := ?_ + valueCounter := ?_ + valueWidth := ?_ + query := ?_ + queryStart := ?_ + result := ?_ + resultStart := ?_ + parked := ?_ + frame := by intro i _ _ _ _ _ _ _ _ _; rfl } + · simpa only [updateWork, valueWork, Function.update_of_ne hsourceQuery, + Function.update_of_ne hsourceReplacement] using hinitial.scanner.source + · simpa only [updateWork, valueWork, Function.update_of_ne haddressQuery, + Function.update_of_ne haddressReplacement] using hinitial.scanner.address + · simpa only [updateWork, valueWork, Function.update_of_ne haddressQuery, + Function.update_of_ne haddressReplacement] using + hinitial.scanner.addressStart + · simpa only [updateWork, valueWork, Function.update_of_ne hvalueQuery, + Function.update_of_ne hvalueReplacement] using hinitial.scanner.value + · simpa only [updateWork, valueWork, Function.update_of_ne hvalueQuery, + Function.update_of_ne hvalueReplacement] using + hinitial.scanner.valueStart + · simpa only [updateWork, valueWork, + Function.update_of_ne haddressCounterQuery, + Function.update_of_ne haddressCounterReplacement] using + hinitial.scanner.addressCounter + · simpa only [updateWork, valueWork, + Function.update_of_ne haddressWidthQuery, + Function.update_of_ne haddressWidthReplacement] using + hinitial.scanner.addressWidth + · simpa only [updateWork, valueWork, + Function.update_of_ne hvalueCounterQuery, + Function.update_of_ne hvalueCounterReplacement] using + hinitial.scanner.valueCounter + · simpa only [updateWork, valueWork, + Function.update_of_ne hvalueWidthQuery, + Function.update_of_ne hvalueWidthReplacement] using + hinitial.scanner.valueWidth + · simpa only [updateWork, Function.update_self, queryTape] using + hqueryNat.2 + · simpa only [updateWork, Function.update_self, queryTape] using + hqueryNat.1 + · simpa only [updateWork, valueWork, Function.update_of_ne hresultQuery, + Function.update_of_ne hresultReplacement] using hinitial.scanner.result + · simpa only [updateWork, valueWork, Function.update_of_ne hresultQuery, + Function.update_of_ne hresultReplacement] using + hinitial.scanner.resultStart + · intro i + by_cases hiQuery : i = tapes.update.entry.query + · subst i + simpa only [updateWork, Function.update_self, queryTape] using + (show TM.Parked queryTape from + ⟨by rw [hqueryNat.2.1], + hqueryNat.2.hasBinaryContent.cells_ne_start⟩) + · have hiEq : updateWork i = valueWork i := + Function.update_of_ne hiQuery _ valueWork + rw [hiEq] + by_cases hiReplacement : i = tapes.update.replacement + · subst i + simpa only [valueWork, Function.update_self, valueTape] using + (show TM.Parked valueTape from + ⟨by rw [hvalueNat.2.1], + hvalueNat.2.hasBinaryContent.cells_ne_start⟩) + · simpa only [valueWork, Function.update_of_ne hiReplacement] using + hinitial.scanner.parked i + refine ⟨hscanner, ?_, ?_, ?_, ?_, hscanner.parked⟩ + · simpa only [updateWork, Function.update_of_ne hreplacementQuery, + valueWork, Function.update_self, valueTape] using hvalueNat + · simpa only [updateWork, Function.update_of_ne hremainingQuery, + valueWork, Function.update_of_ne hremainingReplacement] using + hinitial.count + · simpa only [updateWork, Function.update_of_ne hfoundQuery, valueWork, + Function.update_of_ne hfoundReplacement] using hinitial.copyScratch + · simpa only [updateWork, Function.update_of_ne hresultCountQuery, + valueWork, Function.update_of_ne hresultCountReplacement] using + hinitial.countSource + +/-- Exact semantic and time contract for one immediate sparse assignment. -/ +theorem immediateInstructionTM_hoareTime_frame_internal + (tapes : BinaryInstructionTapes n) (store : Store) + (destination value : ℕ) (emittedBits : List Bool) + (initialWork : Fin n → Tape) (inp₀ out₀ : Tape) + (hcanonical : Canonical store) + (hinitial : EntryLookupStaticReady tapes.lhsLookup store initialWork) + (hreplacement : (initialWork tapes.update.replacement).HasBinaryNat 0) + (hinput : TM.Parked inp₀) + (houtput : out₀.HasBinaryPrefix emittedBits) : + (immediateInstructionTM tapes destination value).HoareTime + (fun inp work out => inp = inp₀ ∧ work = initialWork ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + ImmediateInstructionResult tapes store destination value initialWork + work ∧ + out.HasBinaryPrefix + (emittedBits ++ + (RegisterStore.write store destination value).flatMap Entry.encode)) + (immediateInstructionTime tapes store destination value) := by + let valueWork := Function.update initialWork tapes.update.replacement + ((Tape.init (value.bits.map Γ.ofBool)).move Dir3.right) + let updateWork := Function.update valueWork tapes.update.entry.query + ((Tape.init (destination.bits.map Γ.ofBool)).move Dir3.right) + have houtputParked := hasBinaryPrefix_parked houtput + have hvalue := TM.binaryAddConstTM_hoareTime_frame + tapes.update.replacement value 0 inp₀ initialWork out₀ hreplacement + hinput (fun i _ => hinitial.scanner.parked i) houtputParked + have hvalue' : (TM.binaryAddConstTM tapes.update.replacement value).HoareTime + (fun inp work out => inp = inp₀ ∧ work = initialWork ∧ out = out₀) + (fun inp work out => inp = inp₀ ∧ work = valueWork ∧ out = out₀) + (TM.binaryAddConstTime value 0) := by + simpa only [valueWork, zero_add] using hvalue + have hquery : (TM.binaryAddConstTM tapes.update.entry.query + destination).HoareTime + (fun inp work out => inp = inp₀ ∧ work = valueWork ∧ out = out₀) + (fun inp work out => inp = inp₀ ∧ work = updateWork ∧ out = out₀) + (TM.binaryAddConstTime destination 0) := by + have hqueryZero : (valueWork tapes.update.entry.query).HasBinaryNat 0 := by + have hqueryReplacement : + tapes.update.entry.query ≠ tapes.update.replacement := + tapes.update.ne (by decide) + have heq : valueWork tapes.update.entry.query = + initialWork tapes.update.entry.query := + Function.update_of_ne hqueryReplacement _ initialWork + rw [heq] + exact ⟨hinitial.scanner.queryStart, by simpa using hinitial.scanner.query⟩ + have hrun := TM.binaryAddConstTM_hoareTime_frame + tapes.update.entry.query destination 0 inp₀ valueWork out₀ hqueryZero + hinput + (fun i _ => by + by_cases hi : i = tapes.update.replacement + · subst i + exact ⟨by simp [valueWork, Tape.init, Tape.move], by + simpa [valueWork] using + (Tape.init_move_right_hasBinaryNat value).2.hasBinaryContent.cells_ne_start⟩ + · simpa only [valueWork, Function.update_of_ne hi] using + hinitial.scanner.parked i) + houtputParked + simpa only [updateWork, zero_add] using hrun + have hready := immediateUpdate_ready_internal tapes store destination value initialWork + hinitial + have hupdate := entryUpdateTM_hoareTime_frame tapes.update store destination + value emittedBits updateWork inp₀ out₀ hcanonical hready.1 hready.2.1 + hready.2.2.1 hready.2.2.2.1 hready.2.2.2.2.1 hinput houtput + have hupdate' : (entryUpdateTM tapes.update).HoareTime + (fun inp work out => inp = inp₀ ∧ work = updateWork ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + ImmediateInstructionResult tapes store destination value initialWork + work ∧ + out.HasBinaryPrefix + (emittedBits ++ + (RegisterStore.write store destination value).flatMap Entry.encode)) + (entryUpdateTime tapes.update store destination value) := + hupdate.strengthen_post (by + rintro inp work out ⟨hinp, houtcome, hout, hsourceCells⟩ + refine ⟨hinp, ⟨valueWork, updateWork, rfl, rfl, houtcome, ?_⟩, hout⟩ + calc + (work tapes.update.entry.source).cells = + (updateWork tapes.update.entry.source).cells := hsourceCells + _ = (valueWork tapes.update.entry.source).cells := by + rw [show updateWork tapes.update.entry.source = + valueWork tapes.update.entry.source by + exact Function.update_of_ne (tapes.update.ne (by decide)) _ _] + _ = (initialWork tapes.update.entry.source).cells := by + rw [show valueWork tapes.update.entry.source = + initialWork tapes.update.entry.source by + exact Function.update_of_ne (tapes.update.ne (by decide)) _ _]) + have hqueryUpdate := TM.seqTM_hoareTime + (TM.binaryAddConstTM tapes.update.entry.query destination) + (entryUpdateTM tapes.update) hquery + (by + rintro inp work out ⟨hinp, hwork, hout⟩ + subst work + obtain ⟨hi, hw, ho⟩ := phaseTransition_of_parked + (inp := inp) (work := updateWork) (out := out) + (by simpa [hinp] using hinput) hready.2.2.2.2.2 + (by simpa [hout] using houtputParked) + rw [hi, hw, ho] + exact ⟨hinp, rfl, hout⟩) + hupdate' + have hall := TM.seqTM_hoareTime + (TM.binaryAddConstTM tapes.update.replacement value) + (TM.seqTM (TM.binaryAddConstTM tapes.update.entry.query destination) + (entryUpdateTM tapes.update)) hvalue' + (by + rintro inp work out ⟨hinp, hwork, hout⟩ + subst work + have hparked : ∀ i, TM.Parked (valueWork i) := by + intro i + by_cases hi : i = tapes.update.replacement + · subst i + have hnat := Tape.init_move_right_hasBinaryNat value + simpa only [valueWork, Function.update_self] using + (show TM.Parked + ((Tape.init (value.bits.map Γ.ofBool)).move Dir3.right) from + ⟨by rw [hnat.2.1], hnat.2.hasBinaryContent.cells_ne_start⟩) + · simpa only [valueWork, Function.update_of_ne hi] using + hinitial.scanner.parked i + obtain ⟨hi, hw, ho⟩ := phaseTransition_of_parked + (inp := inp) (work := valueWork) (out := out) + (by simpa [hinp] using hinput) hparked + (by simpa [hout] using houtputParked) + rw [hi, hw, ho] + exact ⟨hinp, rfl, hout⟩) + hqueryUpdate + simpa [immediateInstructionTM, immediateInstructionTime] using hall + +end Machine + +end RegisterStore + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Internal.lean new file mode 100644 index 0000000000..70afdd66f6 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Internal.lean @@ -0,0 +1,366 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleSub +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryShiftMul + +/-! +# Concrete sparse-store arithmetic instruction kernel -- proof internals +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace RegisterStore + +namespace Machine + +variable {n : ℕ} + +private theorem hasBinaryNat_parked {t : Tape} {value : ℕ} + (h : t.HasBinaryNat value) : TM.Parked t := + ⟨by rw [h.2.1], h.2.hasBinaryContent.cells_ne_start⟩ + +private theorem hasBinaryPrefix_parked {t : Tape} {bits : List Bool} + (h : t.HasBinaryPrefix bits) : TM.Parked t := by + refine ⟨by rw [h.1]; omega, ?_⟩ + intro j hj + obtain ⟨i, rfl⟩ : ∃ i, j = i + 1 := ⟨j - 1, by omega⟩ + by_cases hi : i < bits.length + · rw [h.2.1 i hi] + exact Γ.ofBool_ne_start _ + · rw [h.2.2 i (Nat.le_of_not_gt hi)] + decide + +private theorem arithmeticResult_of_threeTape + (tapes : BinaryInstructionTapes n) (op : BinaryInstrOp) (lhs rhs : ℕ) + (initialWork finalWork : Fin n → Tape) + (hlhs : (finalWork tapes.lhs).HasBinaryNat lhs) + (hrhs : (finalWork tapes.rhs).HasBinaryNat rhs) + (hresult : + (finalWork tapes.update.replacement).HasBinaryNat (op.eval lhs rhs)) + (hframe : ∀ i, i ≠ tapes.lhs → i ≠ tapes.rhs → + i ≠ tapes.update.replacement → finalWork i = initialWork i) + (hwork : ∀ i, TM.Parked (initialWork i)) + (hshift : (initialWork tapes.shift).HasBinaryNat 0) + (htmp : (initialWork tapes.tmp).HasBinaryNat 0) + (hdbl : (initialWork tapes.dbl).HasBinaryNat 0) : + BinaryInstructionArithmeticResult tapes op lhs rhs initialWork + finalWork := by + have hshift' : (finalWork tapes.shift).HasBinaryNat 0 := by + rw [hframe tapes.shift (tapes.ne (by decide)) (tapes.ne (by decide)) + (tapes.ne (by decide))] + exact hshift + have htmp' : (finalWork tapes.tmp).HasBinaryNat 0 := by + rw [hframe tapes.tmp (tapes.ne (by decide)) (tapes.ne (by decide)) + (tapes.ne (by decide))] + exact htmp + have hdbl' : (finalWork tapes.dbl).HasBinaryNat 0 := by + rw [hframe tapes.dbl (tapes.ne (by decide)) (tapes.ne (by decide)) + (tapes.ne (by decide))] + exact hdbl + refine ⟨hlhs, hrhs, hresult, hshift', htmp', hdbl', ?_, ?_⟩ + · intro i + by_cases hilhs : i = tapes.lhs + · subst i + exact hasBinaryNat_parked hlhs + · by_cases hirhs : i = tapes.rhs + · subst i + exact hasBinaryNat_parked hrhs + · by_cases hires : i = tapes.update.replacement + · subst i + exact hasBinaryNat_parked hresult + · rw [hframe i hilhs hirhs hires] + exact hwork i + · intro i hilhs hirhs hires _ _ _ + exact hframe i hilhs hirhs hires + +private theorem arithmeticResult_of_sub + (tapes : BinaryInstructionTapes n) (lhs rhs : ℕ) + (initialWork finalWork : Fin n → Tape) + (hlhs : (finalWork tapes.lhs).HasBinaryNat lhs) + (hrhs : (finalWork tapes.rhs).HasBinaryNat rhs) + (hresult : + (finalWork tapes.update.replacement).HasBinaryNat (lhs - rhs)) + (hframe : ∀ i, i ≠ tapes.lhs → i ≠ tapes.rhs → + i ≠ tapes.update.replacement → finalWork i = initialWork i) + (hwork : ∀ i, TM.Parked (initialWork i)) + (hshift : (initialWork tapes.shift).HasBinaryNat 0) + (htmp : (initialWork tapes.tmp).HasBinaryNat 0) + (hdbl : (initialWork tapes.dbl).HasBinaryNat 0) : + BinaryInstructionArithmeticResult tapes .sub lhs rhs initialWork + finalWork := by + exact arithmeticResult_of_threeTape tapes .sub lhs rhs initialWork finalWork hlhs hrhs + hresult hframe hwork hshift htmp hdbl + +/-- The selected width-efficient arithmetic phase has one uniform framed +contract. -/ +theorem binaryInstructionArithmeticTM_hoareTime_frame_internal + (tapes : BinaryInstructionTapes n) (op : BinaryInstrOp) (lhs rhs : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hlhs : (work₀ tapes.lhs).HasBinaryNat lhs) + (hrhs : (work₀ tapes.rhs).HasBinaryNat rhs) + (hresult : (work₀ tapes.update.replacement).HasBinaryNat 0) + (hshift : (work₀ tapes.shift).HasBinaryNat 0) + (htmp : (work₀ tapes.tmp).HasBinaryNat 0) + (hdbl : (work₀ tapes.dbl).HasBinaryNat 0) + (hinput : TM.Parked inp₀) (hwork : ∀ i, TM.Parked (work₀ i)) + (houtput : TM.Parked out₀) : + (binaryInstructionArithmeticTM tapes op).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + BinaryInstructionArithmeticResult tapes op lhs rhs work₀ work ∧ + out = out₀) + (binaryInstructionArithmeticTime op lhs rhs) := by + cases op with + | add => + exact (TM.binaryRippleAddTM_hoareTime_frame tapes.lhs tapes.rhs + tapes.update.replacement tapes.arithmeticDistinct lhs rhs inp₀ work₀ + out₀ hlhs hrhs hresult hinput + (fun i _ _ _ => hwork i) houtput).strengthen_post (by + rintro inp work out ⟨hinp, hlhs', hrhs', hresult', hframe, hout⟩ + exact ⟨hinp, arithmeticResult_of_threeTape tapes .add lhs rhs work₀ work + hlhs' hrhs' hresult' hframe hwork hshift htmp hdbl, hout⟩) + | sub => + exact (TM.binaryRippleSubTM_hoareTime_frame tapes.lhs tapes.rhs + tapes.update.replacement tapes.subtractionDistinct lhs rhs inp₀ work₀ + out₀ hlhs hrhs hresult hinput + (fun i _ _ _ => hwork i) houtput).strengthen_post (by + rintro inp work out ⟨hinp, hlhs', hrhs', hresult', hframe, hout⟩ + exact ⟨hinp, arithmeticResult_of_sub tapes lhs rhs work₀ work + hlhs' hrhs' hresult' hframe hwork hshift htmp hdbl, hout⟩) + | mul => + exact (TM.binaryShiftMulTM_hoareTime_frame tapes.mul lhs rhs inp₀ work₀ + out₀ (by simpa using hlhs) (by simpa using hrhs) + (by simpa using hresult) (by simpa using hshift) + (by simpa using htmp) (by simpa using hdbl) hinput hwork + houtput).strengthen_post (by + rintro inp work out + ⟨hinp, hlhs', hrhs', hresult', hshift', htmp', hdbl', hframe, + hout⟩ + refine ⟨hinp, ⟨?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_⟩, hout⟩ + · simpa using hlhs' + · simpa using hrhs' + · simpa using hresult' + · simpa using hshift' + · simpa using htmp' + · simpa using hdbl' + · intro i + by_cases hilhs : i = tapes.lhs + · subst i + exact hasBinaryNat_parked (by simpa using hlhs') + · by_cases hirhs : i = tapes.rhs + · subst i + exact hasBinaryNat_parked (by simpa using hrhs') + · by_cases hires : i = tapes.update.replacement + · subst i + exact hasBinaryNat_parked (by simpa using hresult') + · by_cases hishift : i = tapes.shift + · subst i + exact hasBinaryNat_parked (by simpa using hshift') + · by_cases hitmp : i = tapes.tmp + · subst i + exact hasBinaryNat_parked (by simpa using htmp') + · by_cases hidbl : i = tapes.dbl + · subst i + exact hasBinaryNat_parked (by simpa using hdbl') + · rw [hframe i (by simpa using hilhs) + (by simpa using hirhs) (by simpa using hires) + (by simpa using hishift) (by simpa using hitmp) + (by simpa using hidbl)] + exact hwork i + · intro i hilhs hirhs hires hishift hitmp hidbl + exact hframe i (by simpa using hilhs) (by simpa using hirhs) + (by simpa using hires) (by simpa using hishift) + (by simpa using hitmp) (by simpa using hidbl)) + +/-- Arithmetic feeds its canonical result directly into sparse update. -/ +theorem binaryInstructionUpdateTM_hoareTime_frame_internal + (tapes : BinaryInstructionTapes n) (op : BinaryInstrOp) + (store : Store) (address lhs rhs : ℕ) + (emittedBits : List Bool) (initialWork : Fin n → Tape) + (inp₀ out₀ : Tape) + (hcanonical : Canonical store) + (hready : EntryScanReady tapes.update.entry + (store.flatMap Entry.encode) address.bits initialWork initialWork) + (hlhs : (initialWork tapes.lhs).HasBinaryNat lhs) + (hrhs : (initialWork tapes.rhs).HasBinaryNat rhs) + (hresult : (initialWork tapes.update.replacement).HasBinaryNat 0) + (hshift : (initialWork tapes.shift).HasBinaryNat 0) + (htmp : (initialWork tapes.tmp).HasBinaryNat 0) + (hdbl : (initialWork tapes.dbl).HasBinaryNat 0) + (hremaining : + (initialWork tapes.update.remaining).HasBinaryNat store.length) + (hfound : (initialWork tapes.update.found).HasBinaryNat 0) + (hresultCount : + (initialWork tapes.update.resultCount).HasBinaryNat store.length) + (hinput : TM.Parked inp₀) (hwork : ∀ i, TM.Parked (initialWork i)) + (houtput : out₀.HasBinaryPrefix emittedBits) : + (binaryInstructionUpdateTM tapes op).HoareTime + (fun inp work out => + inp = inp₀ ∧ work = initialWork ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + BinaryInstructionUpdateResult tapes op store address lhs rhs + initialWork work ∧ + out.HasBinaryPrefix + (emittedBits ++ + (RegisterStore.write store address (op.eval lhs rhs)).flatMap + Entry.encode)) + (binaryInstructionUpdateTime tapes op store address lhs rhs) := by + have harithmetic := + binaryInstructionArithmeticTM_hoareTime_frame_internal tapes op lhs rhs + inp₀ initialWork out₀ hlhs hrhs hresult hshift htmp hdbl hinput + hwork (hasBinaryPrefix_parked houtput) + have hupdate : (entryUpdateTM tapes.update).HoareTime + (fun inp work out => + inp = inp₀ ∧ + BinaryInstructionArithmeticResult tapes op lhs rhs initialWork work ∧ + out = out₀) + (fun inp work out => + inp = inp₀ ∧ + BinaryInstructionUpdateResult tapes op store address lhs rhs + initialWork work ∧ + out.HasBinaryPrefix + (emittedBits ++ + (RegisterStore.write store address (op.eval lhs rhs)).flatMap + Entry.encode)) + (entryUpdateTime tapes.update store address (op.eval lhs rhs)) := by + rintro inp work out ⟨hinp, harith, hout⟩ + subst inp + subst out + have hslotEq (slot : Fin 13) (hne : slot ≠ 10) : + work (tapes.update.idx slot) = initialWork (tapes.update.idx slot) := + harith.frame (tapes.update.idx slot) + (tapes.update_ne_lhs slot) (tapes.update_ne_rhs slot) + (tapes.update.ne hne) (tapes.update_ne_shift slot) + (tapes.update_ne_tmp slot) (tapes.update_ne_dbl slot) + have hready' : EntryScanReady tapes.update.entry + (store.flatMap Entry.encode) address.bits work work := by + refine + { source := ?_ + address := ?_ + addressStart := ?_ + value := ?_ + valueStart := ?_ + addressCounter := ?_ + addressWidth := ?_ + valueCounter := ?_ + valueWidth := ?_ + query := ?_ + queryStart := ?_ + result := ?_ + resultStart := ?_ + parked := harith.parked + frame := by intro i _ _ _ _ _ _ _ _ _; rfl } + · change (work (tapes.update.idx 0)).HasBinarySuffix _ + rw [hslotEq 0 (by decide)] + exact hready.source + · change (work (tapes.update.idx 1)).HasBinaryPrefix [] + rw [hslotEq 1 (by decide)] + exact hready.address + · change (work (tapes.update.idx 1)).cells 0 = _ + rw [hslotEq 1 (by decide)] + exact hready.addressStart + · change (work (tapes.update.idx 2)).HasBinaryPrefix [] + rw [hslotEq 2 (by decide)] + exact hready.value + · change (work (tapes.update.idx 2)).cells 0 = _ + rw [hslotEq 2 (by decide)] + exact hready.valueStart + · change (work (tapes.update.idx 3)).HasBinaryNat 0 + rw [hslotEq 3 (by decide)] + exact hready.addressCounter + · change (work (tapes.update.idx 4)).HasBinaryNat 0 + rw [hslotEq 4 (by decide)] + exact hready.addressWidth + · change (work (tapes.update.idx 5)).HasBinaryNat 0 + rw [hslotEq 5 (by decide)] + exact hready.valueCounter + · change (work (tapes.update.idx 6)).HasBinaryNat 0 + rw [hslotEq 6 (by decide)] + exact hready.valueWidth + · change (work (tapes.update.idx 7)).HasBinaryString address.bits + rw [hslotEq 7 (by decide)] + exact hready.query + · change (work (tapes.update.idx 7)).cells 0 = _ + rw [hslotEq 7 (by decide)] + exact hready.queryStart + · change (work (tapes.update.idx 8)).HasBinaryPrefix [] + rw [hslotEq 8 (by decide)] + exact hready.result + · change (work (tapes.update.idx 8)).cells 0 = _ + rw [hslotEq 8 (by decide)] + exact hready.resultStart + have hremaining' : + (work tapes.update.remaining).HasBinaryNat store.length := by + change (work (tapes.update.idx 9)).HasBinaryNat _ + rw [hslotEq 9 (by decide)] + exact hremaining + have hfound' : (work tapes.update.found).HasBinaryNat 0 := by + change (work (tapes.update.idx 11)).HasBinaryNat 0 + rw [hslotEq 11 (by decide)] + exact hfound + have hresultCount' : + (work tapes.update.resultCount).HasBinaryNat store.length := by + change (work (tapes.update.idx 12)).HasBinaryNat _ + rw [hslotEq 12 (by decide)] + exact hresultCount + have hrun := entryUpdateTM_hoareTime_frame tapes.update store address + (op.eval lhs rhs) emittedBits work inp₀ out₀ hcanonical hready' + harith.result hremaining' hfound' hresultCount' hinput houtput + obtain ⟨final, time, htime, hreach, hhalt, hfinalInput, houtcome, + hfinalOutput, hsource⟩ := + hrun inp₀ work out₀ ⟨rfl, rfl, rfl⟩ + have hsourceInitial : + work tapes.update.entry.source = + initialWork tapes.update.entry.source := + hslotEq 0 (by decide) + refine ⟨final, time, htime, hreach, hhalt, hfinalInput, ?_, + hfinalOutput⟩ + exact ⟨work, harith, houtcome, hsource.trans + (congrArg Tape.cells hsourceInitial)⟩ + refine TM.seqTM_hoareTime (binaryInstructionArithmeticTM tapes op) + (entryUpdateTM tapes.update) + (mid := fun inp work out => + inp = inp₀ ∧ + BinaryInstructionArithmeticResult tapes op lhs rhs initialWork work ∧ + out = out₀) + (mid' := fun inp work out => + inp = inp₀ ∧ + BinaryInstructionArithmeticResult tapes op lhs rhs initialWork work ∧ + out = out₀) + harithmetic ?_ hupdate + rintro inp work out ⟨hinp, harith, hout⟩ + have hinread : inp.read ≠ Γ.start := by + rw [hinp] + exact hinput.read_ne_start + have hworkread : ∀ i, (work i).read ≠ Γ.start := + fun i => (harith.parked i).read_ne_start + have houtread : out.read ≠ Γ.start := by + rw [hout] + exact (hasBinaryPrefix_parked houtput).read_ne_start + have htransition := TM.phaseTransition_eq_self_of_reads_ne_start + hinread hworkread houtread + rw [htransition.1, htransition.2.1, htransition.2.2] + exact ⟨hinp, harith, hout⟩ + +end Machine + +end RegisterStore + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Load.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Load.lean new file mode 100644 index 0000000000..e05c46070a --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Load.lean @@ -0,0 +1,419 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Defs +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Internal.Static + +/-! +# Indirect sparse-store load instructions -- proof internals +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace RegisterStore + +namespace Machine + +variable {n : ℕ} + +private theorem scanner_indirect_of_lhs + (tapes : BinaryInstructionTapes n) (store : Store) (source : ℕ) + (initialWork finalWork : Fin n → Tape) + (hlookup : EntryLookupStaticResult tapes.lhsLookup store source + initialWork finalWork) : + EntryScanReady tapes.indirectLoadLookup.scan.entry + (store.flatMap Entry.encode) [] finalWork finalWork := by + refine + { source := hlookup.scanner.source + address := hlookup.scanner.address + addressStart := hlookup.scanner.addressStart + value := hlookup.scanner.value + valueStart := hlookup.scanner.valueStart + addressCounter := hlookup.scanner.addressCounter + addressWidth := hlookup.scanner.addressWidth + valueCounter := hlookup.scanner.valueCounter + valueWidth := hlookup.scanner.valueWidth + query := hlookup.scanner.query + queryStart := hlookup.scanner.queryStart + result := hlookup.scanner.result + resultStart := hlookup.scanner.resultStart + parked := hlookup.parked + frame := by intro i _ _ _ _ _ _ _ _ _; rfl } + +private theorem indirectLoaded_ready + (tapes : BinaryInstructionTapes n) (store : Store) + (addressRegister : ℕ) (initialWork addressWork : Fin n → Tape) + (hinitial : EntryLookupStaticReady tapes.lhsLookup store initialWork) + (hreplacement : (initialWork tapes.update.replacement).HasBinaryNat 0) + (haddress : EntryLookupStaticResult tapes.lhsLookup store addressRegister + initialWork addressWork) : + EntryLookupRestoreReady tapes.indirectLoadLookup store + (RegisterStore.read store addressRegister) addressWork := by + have hreplacementEq : addressWork tapes.update.replacement = + initialWork tapes.update.replacement := + haddress.frame tapes.update.replacement + (fun slot => (tapes.lhsLookup_ne_replacement slot).symm) + have hcountSource : + (addressWork tapes.update.resultCount).HasBinaryNat store.length := by + rw [show addressWork tapes.update.resultCount = + initialWork tapes.update.resultCount by + simpa using haddress.countSource] + simpa using hinitial.countSource + refine + { scanner := scanner_indirect_of_lhs tapes store addressRegister + initialWork addressWork haddress + sourceStart := haddress.sourceStart + sourceHead := haddress.sourceHead + count := by simpa using haddress.count + countSource := by simpa using hcountSource + querySource := by simpa using haddress.destination + destination := by + change (addressWork tapes.update.replacement).HasBinaryNat 0 + rw [hreplacementEq] + exact hreplacement + copyScratch := by simpa using haddress.copyScratch } + +theorem scanner_updateQuery_of_indirect_internal + (tapes : BinaryInstructionTapes n) (store : Store) (destination : ℕ) + (work : Fin n → Tape) + (hscanner : EntryScanReady tapes.indirectLoadLookup.scan.entry + (store.flatMap Entry.encode) [] work work) : + EntryScanReady tapes.update.entry (store.flatMap Entry.encode) + destination.bits + (Function.update work tapes.update.entry.query + ((Tape.init (destination.bits.map Γ.ofBool)).move Dir3.right)) + (Function.update work tapes.update.entry.query + ((Tape.init (destination.bits.map Γ.ofBool)).move Dir3.right)) := by + let finalWork := Function.update work tapes.update.entry.query + ((Tape.init (destination.bits.map Γ.ofBool)).move Dir3.right) + have hsource : tapes.update.entry.source ≠ tapes.update.entry.query := + tapes.update.ne (by decide) + have haddress : tapes.update.entry.address ≠ tapes.update.entry.query := + tapes.update.ne (by decide) + have hvalue : tapes.update.entry.value ≠ tapes.update.entry.query := + tapes.update.ne (by decide) + have haddressCounter : + tapes.update.entry.addressCounter ≠ tapes.update.entry.query := + tapes.update.ne (by decide) + have haddressWidth : + tapes.update.entry.addressWidth ≠ tapes.update.entry.query := + tapes.update.ne (by decide) + have hvalueCounter : + tapes.update.entry.valueCounter ≠ tapes.update.entry.query := + tapes.update.ne (by decide) + have hvalueWidth : + tapes.update.entry.valueWidth ≠ tapes.update.entry.query := + tapes.update.ne (by decide) + have hresult : tapes.update.entry.result ≠ tapes.update.entry.query := + tapes.update.ne (by decide) + have hnat := Tape.init_move_right_hasBinaryNat destination + refine + { source := by + simpa only [finalWork, Function.update_of_ne hsource] using + hscanner.source + address := by + simpa only [finalWork, Function.update_of_ne haddress] using + hscanner.address + addressStart := by + simpa only [finalWork, Function.update_of_ne haddress] using + hscanner.addressStart + value := by + simpa only [finalWork, Function.update_of_ne hvalue] using + hscanner.value + valueStart := by + simpa only [finalWork, Function.update_of_ne hvalue] using + hscanner.valueStart + addressCounter := by + simpa only [finalWork, Function.update_of_ne haddressCounter] using + hscanner.addressCounter + addressWidth := by + simpa only [finalWork, Function.update_of_ne haddressWidth] using + hscanner.addressWidth + valueCounter := by + simpa only [finalWork, Function.update_of_ne hvalueCounter] using + hscanner.valueCounter + valueWidth := by + simpa only [finalWork, Function.update_of_ne hvalueWidth] using + hscanner.valueWidth + query := by + simpa only [finalWork, Function.update_self] using hnat.2 + queryStart := by + simpa only [finalWork, Function.update_self] using hnat.1 + result := by + simpa only [finalWork, Function.update_of_ne hresult] using + hscanner.result + resultStart := by + simpa only [finalWork, Function.update_of_ne hresult] using + hscanner.resultStart + parked := ?_ + frame := by intro i _ _ _ _ _ _ _ _ _; rfl } + intro i + by_cases hi : i = tapes.update.entry.query + · subst i + simpa only [finalWork, Function.update_self] using + (show TM.Parked + ((Tape.init (destination.bits.map Γ.ofBool)).move Dir3.right) from + ⟨by rw [hnat.2.1], hnat.2.hasBinaryContent.cells_ne_start⟩) + · simpa only [finalWork, Function.update_of_ne hi] using hscanner.parked i + +private theorem hasBinaryPrefix_parked {t : Tape} {bits : List Bool} + (h : t.HasBinaryPrefix bits) : TM.Parked t := by + refine ⟨by rw [h.1]; omega, ?_⟩ + intro j hj + obtain ⟨i, rfl⟩ : ∃ i, j = i + 1 := ⟨j - 1, by omega⟩ + by_cases hi : i < bits.length + · rw [h.2.1 i hi] + exact Γ.ofBool_ne_start _ + · rw [h.2.2 i (Nat.le_of_not_gt hi)] + decide + +private theorem phaseTransition_of_parked + {inp out : Tape} {work : Fin n → Tape} + (hinput : TM.Parked inp) (hwork : ∀ i, TM.Parked (work i)) + (houtput : TM.Parked out) : + TM.transitionInput inp = inp ∧ + (fun i => TM.transitionTape (work i)) = work ∧ + TM.transitionTape out = out := + TM.phaseTransition_eq_self_of_reads_ne_start hinput.read_ne_start + (fun i => (hwork i).read_ne_start) houtput.read_ne_start + +/-- Exact semantic and time contract for one indirect sparse-register load. -/ +theorem indirectLoadInstructionTM_hoareTime_frame_internal + (tapes : BinaryInstructionTapes n) (store : Store) + (destination addressRegister : ℕ) (emittedBits : List Bool) + (initialWork : Fin n → Tape) (inp₀ out₀ : Tape) + (hcanonical : Canonical store) + (hinitial : EntryLookupStaticReady tapes.lhsLookup store initialWork) + (hreplacement : (initialWork tapes.update.replacement).HasBinaryNat 0) + (hinput : TM.Parked inp₀) + (houtput : out₀.HasBinaryPrefix emittedBits) : + (indirectLoadInstructionTM tapes destination addressRegister).HoareTime + (fun inp work out => inp = inp₀ ∧ work = initialWork ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + IndirectLoadInstructionResult tapes store destination addressRegister + initialWork work ∧ + out.HasBinaryPrefix + (emittedBits ++ + (RegisterStore.write store destination + (RegisterStore.read store + (RegisterStore.read store addressRegister))).flatMap + Entry.encode)) + (indirectLoadInstructionTime tapes store destination addressRegister) := by + have houtputParked := hasBinaryPrefix_parked houtput + have haddress := entryLookupStatic_hoareTime_internal tapes.lhsLookup store + addressRegister initialWork inp₀ out₀ hinitial hinput houtputParked + have hloaded : (entryLookupLoadedTM tapes.indirectLoadLookup).HoareTime + (fun inp work out => + inp = inp₀ ∧ + EntryLookupStaticResult tapes.lhsLookup store addressRegister + initialWork work ∧ + out = out₀) + (fun inp work out => + inp = inp₀ ∧ + (∃ addressWork, + EntryLookupStaticResult tapes.lhsLookup store addressRegister + initialWork addressWork ∧ + EntryLookupRestoreResult tapes.indirectLoadLookup store + (RegisterStore.read store addressRegister) addressWork work) ∧ + out = out₀) + (entryLookupLoadedTime tapes.indirectLoadLookup store + (RegisterStore.read store addressRegister)) := by + rintro inp work out ⟨hinp, haddressResult, hout⟩ + have hready := indirectLoaded_ready tapes store addressRegister initialWork + work hinitial hreplacement haddressResult + have hrun := entryLookupLoaded_hoareTime_internal + tapes.indirectLoadLookup store (RegisterStore.read store addressRegister) + work inp₀ out₀ hready hinput houtputParked + obtain ⟨final, time, htime, hreach, hhalt, hfinalInput, + hloadedResult, hfinalOutput⟩ := + hrun inp work out ⟨hinp, rfl, hout⟩ + exact ⟨final, time, htime, hreach, hhalt, hfinalInput, + ⟨work, haddressResult, hloadedResult⟩, hfinalOutput⟩ + have hquery : + (TM.binaryAddConstTM tapes.update.entry.query destination).HoareTime + (fun inp work out => + inp = inp₀ ∧ + (∃ addressWork, + EntryLookupStaticResult tapes.lhsLookup store addressRegister + initialWork addressWork ∧ + EntryLookupRestoreResult tapes.indirectLoadLookup store + (RegisterStore.read store addressRegister) addressWork work) ∧ + out = out₀) + (fun inp work out => + inp = inp₀ ∧ + (∃ addressWork loadedWork, + EntryLookupStaticResult tapes.lhsLookup store addressRegister + initialWork addressWork ∧ + EntryLookupRestoreResult tapes.indirectLoadLookup store + (RegisterStore.read store addressRegister) addressWork loadedWork ∧ + work = Function.update loadedWork tapes.update.entry.query + ((Tape.init (destination.bits.map Γ.ofBool)).move Dir3.right)) ∧ + out = out₀) + (TM.binaryAddConstTime destination 0) := by + rintro inp work out ⟨hinp, ⟨addressWork, haddressResult, + hloadedResult⟩, hout⟩ + have hqueryZero : (work tapes.update.entry.query).HasBinaryNat 0 := + ⟨hloadedResult.scanner.queryStart, by + simpa using hloadedResult.scanner.query⟩ + have hrun := TM.binaryAddConstTM_hoareTime_frame + tapes.update.entry.query destination 0 inp work out hqueryZero + (by simpa [hinp] using hinput) + (fun i _ => hloadedResult.parked i) + (by simpa [hout] using houtputParked) + obtain ⟨final, time, htime, hreach, hhalt, hfinalInput, + hfinalWork, hfinalOutput⟩ := + hrun inp work out ⟨rfl, rfl, rfl⟩ + exact ⟨final, time, htime, hreach, hhalt, hfinalInput.trans hinp, + ⟨addressWork, work, haddressResult, hloadedResult, + by simpa only [zero_add] using hfinalWork⟩, + hfinalOutput.trans hout⟩ + have hupdate : (entryUpdateTM tapes.update).HoareTime + (fun inp work out => + inp = inp₀ ∧ + (∃ addressWork loadedWork, + EntryLookupStaticResult tapes.lhsLookup store addressRegister + initialWork addressWork ∧ + EntryLookupRestoreResult tapes.indirectLoadLookup store + (RegisterStore.read store addressRegister) addressWork loadedWork ∧ + work = Function.update loadedWork tapes.update.entry.query + ((Tape.init (destination.bits.map Γ.ofBool)).move Dir3.right)) ∧ + out = out₀) + (fun inp work out => + inp = inp₀ ∧ + IndirectLoadInstructionResult tapes store destination addressRegister + initialWork work ∧ + out.HasBinaryPrefix + (emittedBits ++ + (RegisterStore.write store destination + (RegisterStore.read store + (RegisterStore.read store addressRegister))).flatMap + Entry.encode)) + (entryUpdateTime tapes.update store destination + (RegisterStore.read store + (RegisterStore.read store addressRegister))) := by + rintro inp work out ⟨hinp, ⟨addressWork, loadedWork, haddressResult, + hloadedResult, hwork⟩, hout⟩ + subst work + let updateWork := Function.update loadedWork tapes.update.entry.query + ((Tape.init (destination.bits.map Γ.ofBool)).move Dir3.right) + have hscanner := scanner_updateQuery_of_indirect_internal tapes store destination + loadedWork hloadedResult.scanner + have hreplacementNe : + tapes.update.replacement ≠ tapes.update.entry.query := + tapes.update.ne (by decide) + have hremainingNe : + tapes.update.remaining ≠ tapes.update.entry.query := + tapes.update.ne (by decide) + have hfoundNe : tapes.update.found ≠ tapes.update.entry.query := + tapes.update.ne (by decide) + have hresultCountNe : + tapes.update.resultCount ≠ tapes.update.entry.query := + tapes.update.ne (by decide) + have hresultCount : + (loadedWork tapes.update.resultCount).HasBinaryNat store.length := by + rw [show loadedWork tapes.update.resultCount = + addressWork tapes.update.resultCount by + simpa using hloadedResult.countSource] + rw [show addressWork tapes.update.resultCount = + initialWork tapes.update.resultCount by + simpa using haddressResult.countSource] + simpa using hinitial.countSource + have hrun := entryUpdateTM_hoareTime_frame tapes.update store destination + (RegisterStore.read store (RegisterStore.read store addressRegister)) + emittedBits updateWork inp₀ out₀ hcanonical hscanner + (by simpa only [updateWork, Function.update_of_ne hreplacementNe] using + hloadedResult.value) + (by simpa only [updateWork, Function.update_of_ne hremainingNe] using + hloadedResult.count) + (by simpa only [updateWork, Function.update_of_ne hfoundNe] using + hloadedResult.copyScratch) + (by simpa only [updateWork, Function.update_of_ne hresultCountNe] using + hresultCount) + hinput houtput + obtain ⟨final, time, htime, hreach, hhalt, hfinalInput, + hupdateResult, hfinalOutput, hsourceCells⟩ := + hrun inp updateWork out ⟨hinp, rfl, hout⟩ + exact ⟨final, time, htime, hreach, hhalt, hfinalInput, + ⟨addressWork, loadedWork, updateWork, haddressResult, hloadedResult, + rfl, hupdateResult, by + calc + (final.work tapes.update.entry.source).cells = + (updateWork tapes.update.entry.source).cells := hsourceCells + _ = (loadedWork tapes.update.entry.source).cells := by + rw [show updateWork tapes.update.entry.source = + loadedWork tapes.update.entry.source by + exact Function.update_of_ne (tapes.update.ne (by decide)) _ _] + _ = (addressWork tapes.update.entry.source).cells := + hloadedResult.sourceCells + _ = (initialWork tapes.update.entry.source).cells := + haddressResult.sourceCells⟩, + hfinalOutput⟩ + have hqueryUpdate := TM.seqTM_hoareTime + (TM.binaryAddConstTM tapes.update.entry.query destination) + (entryUpdateTM tapes.update) hquery + (by + rintro inp work out ⟨hinp, ⟨addressWork, loadedWork, haddressResult, + hloadedResult, hwork⟩, hout⟩ + subst work + have hparked := (scanner_updateQuery_of_indirect_internal tapes store destination + loadedWork hloadedResult.scanner).parked + obtain ⟨hi, hw, ho⟩ := phaseTransition_of_parked + (inp := inp) (work := Function.update loadedWork + tapes.update.entry.query + ((Tape.init (destination.bits.map Γ.ofBool)).move Dir3.right)) + (out := out) (by simpa [hinp] using hinput) hparked + (by simpa [hout] using houtputParked) + rw [hi, hw, ho] + exact ⟨hinp, ⟨addressWork, loadedWork, haddressResult, + hloadedResult, rfl⟩, hout⟩) + hupdate + have hloadedRest := TM.seqTM_hoareTime + (entryLookupLoadedTM tapes.indirectLoadLookup) + (TM.seqTM (TM.binaryAddConstTM tapes.update.entry.query destination) + (entryUpdateTM tapes.update)) hloaded + (by + rintro inp work out ⟨hinp, ⟨addressWork, haddressResult, + hloadedResult⟩, hout⟩ + obtain ⟨hi, hw, ho⟩ := phaseTransition_of_parked + (inp := inp) (work := work) (out := out) + (by simpa [hinp] using hinput) hloadedResult.parked + (by simpa [hout] using houtputParked) + rw [hi, hw, ho] + exact ⟨hinp, ⟨addressWork, haddressResult, hloadedResult⟩, hout⟩) + hqueryUpdate + have hall := TM.seqTM_hoareTime + (entryLookupStaticTM tapes.lhsLookup addressRegister) + (TM.seqTM (entryLookupLoadedTM tapes.indirectLoadLookup) + (TM.seqTM (TM.binaryAddConstTM tapes.update.entry.query destination) + (entryUpdateTM tapes.update))) haddress + (by + rintro inp work out ⟨hinp, haddressResult, hout⟩ + obtain ⟨hi, hw, ho⟩ := phaseTransition_of_parked + (inp := inp) (work := work) (out := out) + (by simpa [hinp] using hinput) haddressResult.parked + (by simpa [hout] using houtputParked) + rw [hi, hw, ho] + exact ⟨hinp, haddressResult, hout⟩) + hloadedRest + simpa [indirectLoadInstructionTM, indirectLoadInstructionTime] using hall + +end Machine + +end RegisterStore + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Sim.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Sim.lean new file mode 100644 index 0000000000..26ce89a0f6 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Sim.lean @@ -0,0 +1,12 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Sim.Control +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Sim.Data +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Sim.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Sim.Internal + +/-! Supporting modules for Beyond the Bethe approximation of the permanent. -/ diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Sim/Control.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Sim/Control.lean new file mode 100644 index 0000000000..9cdd064da9 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Sim/Control.lean @@ -0,0 +1,565 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Sim.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.CopyWorkOutput + +/-! +# Uniform next-store buffering for control instructions +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace RegisterStore + +namespace Machine + +variable {n : ℕ} + +private theorem hasBinaryNat_parked {t : Tape} {value : ℕ} + (h : t.HasBinaryNat value) : TM.Parked t := by + refine ⟨by rw [h.2.1], ?_⟩ + exact Tape.HasBinaryContent.cells_ne_start h.2.2 + +private theorem hasBinaryPrefix_parked {t : Tape} {bits : List Bool} + (h : t.HasBinaryPrefix bits) : TM.Parked t := by + refine ⟨by rw [h.1]; omega, ?_⟩ + intro j hj + obtain ⟨i, rfl⟩ : ∃ i, j = i + 1 := ⟨j - 1, by omega⟩ + by_cases hi : i < bits.length + · rw [h.2.1 i hi] + exact Γ.ofBool_ne_start _ + · rw [h.2.2 i (Nat.le_of_not_gt hi)] + decide + +private theorem finishControlInstructionTM_hoareTime_frame_internal + (tapes : ControlInstructionTapes n) (store : Store) + (pcValue newPC : ℕ) (initialWork : Fin (n + 1) → Tape) + (inp₀ out₀ : Tape) (control : TM (n + 1)) (controlTime : ℕ) + (hready : InstructionExecutionReady tapes store pcValue initialWork) + (hinput : TM.Parked inp₀) (houtput : TM.Parked out₀) + (hcontrol : control.HoareTime + (fun inp work out => inp = inp₀ ∧ work = initialWork ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + ControlInstructionResult tapes.lifted store newPC initialWork work ∧ + out = out₀) + controlTime) : + (finishControlInstructionTM tapes control).HoareTime + (fun inp work out => inp = inp₀ ∧ work = initialWork ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + (work tapes.buffer).HasBinaryPrefix + (store.flatMap Entry.encode) ∧ + (work tapes.liftedPC).HasBinaryNat newPC ∧ + (work tapes.lifted.data.update.resultCount).HasBinaryNat + store.length ∧ + (work tapes.liftedSource).HasBinaryContent + (store.flatMap Entry.encode) ∧ + (∀ slot, (work (instructionCleanupTape tapes slot)).HasBinaryNat 0) ∧ + (work tapes.lifted.data.update.remaining).HasBinaryNat store.length ∧ + EntryScanReady tapes.lifted.data.update.entry [] [] work work ∧ + (work tapes.lifted.data.shift).HasBinaryNat 0 ∧ + (work tapes.lifted.data.tmp).HasBinaryNat 0 ∧ + (work tapes.lifted.data.dbl).HasBinaryNat 0 ∧ + (∀ i, TM.Parked (work i)) ∧ + out = out₀) + (controlTime + 1 + (store.flatMap Entry.encode).length + 1) := by + let bits := store.flatMap Entry.encode + let source := tapes.liftedSource + let buffer := tapes.buffer + have hsourceBuffer : source ≠ buffer := tapes.liftedSource_ne_buffer + have hcopy : (TM.copyWorkToWorkTM source buffer).HoareTime + (fun inp work out => + inp = inp₀ ∧ + ControlInstructionResult tapes.lifted store newPC initialWork work ∧ + out = out₀) + (fun inp work out => + inp = inp₀ ∧ + (work buffer).HasBinaryPrefix bits ∧ + (work tapes.liftedPC).HasBinaryNat newPC ∧ + (work tapes.lifted.data.update.resultCount).HasBinaryNat store.length ∧ + (work tapes.liftedSource).HasBinaryContent bits ∧ + (∀ slot, (work (instructionCleanupTape tapes slot)).HasBinaryNat 0) ∧ + (work tapes.lifted.data.update.remaining).HasBinaryNat store.length ∧ + EntryScanReady tapes.lifted.data.update.entry [] [] work work ∧ + (work tapes.lifted.data.shift).HasBinaryNat 0 ∧ + (work tapes.lifted.data.tmp).HasBinaryNat 0 ∧ + (work tapes.lifted.data.dbl).HasBinaryNat 0 ∧ + (∀ i, TM.Parked (work i)) ∧ + out = out₀) + (bits.length + 1) := by + rintro inp work out ⟨hinp, hcontrolResult, hout⟩ + have hsourceHead : (work source).head = 1 := by + exact hcontrolResult.ready.lookup.sourceHead + have hsourceSuffix : (work source).HasBinarySuffix bits := by + exact hcontrolResult.ready.lookup.scanner.source + have hsourceOutput : (work source).HasOutput bits := by + refine ⟨?_, ?_⟩ + · intro i hi + simpa [hsourceHead, Nat.add_comm] using hsourceSuffix.2.1 i hi + · simpa [hsourceHead, Nat.add_comm] using hsourceSuffix.2.2.1 + have hbufferEq : work buffer = (Tape.init []).move Dir3.right := by + rw [hcontrolResult.frame buffer + tapes.liftedPC_ne_buffer.symm + (fun slot => (tapes.liftedData_ne_buffer + (BinaryInstructionTapes.lhsLookupSlot slot)).symm)] + exact hready.buffer + have hcleanup : ∀ slot, + (work (instructionCleanupTape tapes slot)).HasBinaryNat 0 := by + intro slot + fin_cases slot + · exact ⟨hcontrolResult.ready.lookup.scanner.queryStart, + by simpa [instructionCleanupTape, instructionCleanupParentSlot] using + hcontrolResult.ready.lookup.scanner.query⟩ + · change (work tapes.lifted.data.update.replacement).HasBinaryNat 0 + rw [show work tapes.lifted.data.update.replacement = + initialWork tapes.lifted.data.update.replacement from + hcontrolResult.frame _ (tapes.lifted.data_ne_pc 10) + (fun role => + (tapes.lifted.data.lhsLookup_ne_replacement role).symm)] + exact hready.replacement + · simpa [instructionCleanupTape, instructionCleanupParentSlot] using + hcontrolResult.ready.lookup.copyScratch + · simpa [instructionCleanupTape, instructionCleanupParentSlot] using + hcontrolResult.ready.lookup.destination + · change (work tapes.lifted.data.rhs).HasBinaryNat 0 + rw [show work tapes.lifted.data.rhs = initialWork tapes.lifted.data.rhs + from hcontrolResult.frame _ (tapes.lifted.data_ne_pc 14) + (fun role => (tapes.lifted.data.lhsLookup_ne_rhs role).symm)] + exact hready.rhs + let P : TM.TapePred (n + 1) := fun inp' work' out' => + inp' = inp₀ ∧ out' = out₀ ∧ + (work' tapes.liftedPC).HasBinaryNat newPC ∧ + (work' tapes.lifted.data.update.resultCount).HasBinaryNat store.length ∧ + (∀ slot, (work' (instructionCleanupTape tapes slot)).HasBinaryNat 0) ∧ + (work' tapes.lifted.data.update.remaining).HasBinaryNat store.length ∧ + (∀ i, i ≠ source → i ≠ buffer → TM.Parked (work' i)) ∧ + ∀ i, i ≠ source → i ≠ buffer → work' i = work i + have hP : P inp work out := by + refine ⟨hinp, hout, hcontrolResult.ready.pc, ?_, hcleanup, + hcontrolResult.ready.lookup.count, ?_, ?_⟩ + · exact hcontrolResult.ready.lookup.countSource + · intro i _ _ + exact hcontrolResult.ready.lookup.scanner.parked i + · intro i _ _ + rfl + have hframe := TM.copyWorkToWorkTM_hoareTime_frame_of_hasOutput + source buffer hsourceBuffer bits (work source) + (P := P) + (by + intro inp' work' out' inp'' work'' out'' hPred _ _ _ _ _ + hinpEq houtEq hworkFrame + obtain ⟨hPredInput, hPredOutput, hPredPC, hPredCount, + hPredCleanup, hPredRemaining, hPredParked, hPredFrame⟩ := hPred + refine ⟨hinpEq.trans hPredInput, houtEq.trans hPredOutput, ?_, ?_, + ?_, ?_, ?_, ?_⟩ + · rw [hworkFrame tapes.liftedPC tapes.liftedPC_ne_source + tapes.liftedPC_ne_buffer] + exact hPredPC + · have hpcResultCount : + tapes.lifted.data.update.resultCount ≠ source := by + exact tapes.lifted.data.ne (by decide) + have hresultBuffer : + tapes.lifted.data.update.resultCount ≠ buffer := by + exact tapes.liftedData_ne_buffer 12 + rw [hworkFrame _ hpcResultCount hresultBuffer] + exact hPredCount + · intro slot + rw [hworkFrame _ (instructionCleanupTape_ne_source tapes slot) + (instructionCleanupTape_ne_buffer tapes slot)] + exact hPredCleanup slot + · rw [hworkFrame tapes.lifted.data.update.remaining + (tapes.lifted.data.ne (by decide)) + (tapes.liftedData_ne_buffer 9)] + exact hPredRemaining + · intro i hiSource hiBuffer + rw [hworkFrame i hiSource hiBuffer] + exact hPredParked i hiSource hiBuffer + · intro i hiSource hiBuffer + rw [hworkFrame i hiSource hiBuffer] + exact hPredFrame i hiSource hiBuffer) + have hinpParked : TM.Parked inp := by simpa [hinp] using hinput + have houtParked : TM.Parked out := by simpa [hout] using houtput + obtain ⟨final, time, htime, hreach, hhalt, hsourceCells, + hsourceFinalHead, hsourceFinalOutput, hbufferPrefix, _hbufferStart, + hfinalInput, hfinalOutput, hfinalPC, hfinalCount, hfinalCleanup, + hfinalRemaining, hotherParked, hotherFrame⟩ := + hframe inp work out + ⟨rfl, hsourceHead, hsourceOutput, hbufferEq, + hinpParked.read_ne_start, + houtParked.read_ne_start, + houtParked.1, + (fun i hiSource hiBuffer => + ⟨(hcontrolResult.ready.lookup.scanner.parked i).read_ne_start, + (hcontrolResult.ready.lookup.scanner.parked i).1⟩), + hP⟩ + have hfinalSourceContent : + (final.work source).HasBinaryContent bits := by + have hsourceInitial : (work source).cells = + (initialWork source).cells := hcontrolResult.sourceCells + unfold Tape.HasBinaryContent + rw [hsourceCells, hsourceInitial] + exact hready.sourceContent + have hfinalParked : ∀ i, TM.Parked (final.work i) := by + intro i + by_cases hiSource : i = source + · subst i + refine ⟨by omega, ?_⟩ + intro j hj + rw [hsourceCells] + exact hsourceSuffix.2.2.2 j hj + by_cases hiBuffer : i = buffer + · subst i + exact hasBinaryPrefix_parked hbufferPrefix + · exact hotherParked i hiSource hiBuffer + have hfinalScanner : EntryScanReady + tapes.lifted.data.update.entry [] [] final.work final.work := by + let entry := tapes.lifted.data.update.entry + have hrole (slot : Fin 9) (hne : slot ≠ 0) : + final.work (entry.idx slot) = work (entry.idx slot) := by + exact hotherFrame _ (entry.ne hne) + (tapes.liftedData_ne_buffer ⟨slot, by omega⟩) + refine + { source := ?_ + address := by + change (final.work (entry.idx 1)).HasBinaryPrefix [] + rw [hrole 1 (by decide)] + exact hcontrolResult.ready.lookup.scanner.address + addressStart := by + change (final.work (entry.idx 1)).cells 0 = Γ.start + rw [hrole 1 (by decide)] + exact hcontrolResult.ready.lookup.scanner.addressStart + value := by + change (final.work (entry.idx 2)).HasBinaryPrefix [] + rw [hrole 2 (by decide)] + exact hcontrolResult.ready.lookup.scanner.value + valueStart := by + change (final.work (entry.idx 2)).cells 0 = Γ.start + rw [hrole 2 (by decide)] + exact hcontrolResult.ready.lookup.scanner.valueStart + addressCounter := by + change (final.work (entry.idx 3)).HasBinaryNat 0 + rw [hrole 3 (by decide)] + exact hcontrolResult.ready.lookup.scanner.addressCounter + addressWidth := by + change (final.work (entry.idx 4)).HasBinaryNat 0 + rw [hrole 4 (by decide)] + exact hcontrolResult.ready.lookup.scanner.addressWidth + valueCounter := by + change (final.work (entry.idx 5)).HasBinaryNat 0 + rw [hrole 5 (by decide)] + exact hcontrolResult.ready.lookup.scanner.valueCounter + valueWidth := by + change (final.work (entry.idx 6)).HasBinaryNat 0 + rw [hrole 6 (by decide)] + exact hcontrolResult.ready.lookup.scanner.valueWidth + query := by + change (final.work (entry.idx 7)).HasBinaryString [] + rw [hrole 7 (by decide)] + exact hcontrolResult.ready.lookup.scanner.query + queryStart := by + change (final.work (entry.idx 7)).cells 0 = Γ.start + rw [hrole 7 (by decide)] + exact hcontrolResult.ready.lookup.scanner.queryStart + result := by + change (final.work (entry.idx 8)).HasBinaryPrefix [] + rw [hrole 8 (by decide)] + exact hcontrolResult.ready.lookup.scanner.result + resultStart := by + change (final.work (entry.idx 8)).cells 0 = Γ.start + rw [hrole 8 (by decide)] + exact hcontrolResult.ready.lookup.scanner.resultStart + parked := hfinalParked + frame := by intro i _ _ _ _ _ _ _ _ _; rfl } + change (final.work source).HasBinarySuffix [] + refine ⟨by omega, ?_, ?_, ?_⟩ + · intro i hi + simp at hi + · simpa [hsourceFinalHead, Nat.add_comm] using hsourceFinalOutput.2 + · intro j hj + rw [hsourceCells] + exact hsourceSuffix.2.2.2 j hj + have hfinalShift : + (final.work tapes.lifted.data.shift).HasBinaryNat 0 := by + change (final.work (tapes.lifted.data.idx 15)).HasBinaryNat 0 + rw [hotherFrame _ (tapes.lifted.data.ne (by decide)) + (tapes.liftedData_ne_buffer 15)] + exact hcontrolResult.ready.lookup.querySource + have hfinalTmp : + (final.work tapes.lifted.data.tmp).HasBinaryNat 0 := by + change (final.work (tapes.lifted.data.idx 16)).HasBinaryNat 0 + rw [hotherFrame _ (tapes.lifted.data.ne (by decide)) + (tapes.liftedData_ne_buffer 16)] + rw [hcontrolResult.frame _ (tapes.lifted.data_ne_pc 16) + (fun slot => (tapes.lifted.data.lhsLookup_ne_tmp slot).symm)] + exact hready.tmp + have hfinalDbl : + (final.work tapes.lifted.data.dbl).HasBinaryNat 0 := by + change (final.work (tapes.lifted.data.idx 17)).HasBinaryNat 0 + rw [hotherFrame _ (tapes.lifted.data.ne (by decide)) + (tapes.liftedData_ne_buffer 17)] + rw [hcontrolResult.frame _ (tapes.lifted.data_ne_pc 17) + (fun slot => (tapes.lifted.data.lhsLookup_ne_dbl slot).symm)] + exact hready.dbl + refine ⟨final, time, htime, hreach, hhalt, hfinalInput, + hbufferPrefix, hfinalPC, hfinalCount, hfinalSourceContent, + hfinalCleanup, hfinalRemaining, hfinalScanner, hfinalShift, hfinalTmp, + hfinalDbl, hfinalParked, hfinalOutput⟩ + have hseq := TM.seqTM_hoareTime control + (TM.copyWorkToWorkTM source buffer) hcontrol + (by + rintro inp work out ⟨hinp, hcontrolResult, hout⟩ + have hworkParked := hcontrolResult.ready.lookup.scanner.parked + have hinpParked : TM.Parked inp := by simpa [hinp] using hinput + have houtParked : TM.Parked out := by simpa [hout] using houtput + obtain ⟨hi, hw, ho⟩ := + TM.phaseTransition_eq_self_of_reads_ne_start + hinpParked.read_ne_start + (fun i => (hworkParked i).read_ne_start) + houtParked.read_ne_start + rw [hi, hw, ho] + exact ⟨hinp, hcontrolResult, hout⟩) + hcopy + simpa only [finishControlInstructionTM, bits, source, buffer] using hseq + +/-- Representation-independent form of the control-instruction finisher. +Control instructions preserve the encoded store, leave zero on every cleanup +role, and retain the old entry count for the generic cleanup pass. -/ +theorem finishBufferedControlInstructionTM_hoareTime_frame_internal + (tapes : ControlInstructionTapes n) (store : Store) + (pcValue newPC : ℕ) (initialWork : Fin (n + 1) → Tape) + (inp₀ out₀ : Tape) (control : TM (n + 1)) (controlTime : ℕ) + (hready : InstructionExecutionReady tapes store pcValue initialWork) + (hinput : TM.Parked inp₀) (houtput : TM.Parked out₀) + (hcontrol : control.HoareTime + (fun inp work out => inp = inp₀ ∧ work = initialWork ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + ControlInstructionResult tapes.lifted store newPC initialWork work ∧ + out = out₀) + controlTime) : + (finishControlInstructionTM tapes control).HoareTime + (fun inp work out => inp = inp₀ ∧ work = initialWork ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + BufferedInstructionResult tapes store store newPC (fun _ => 0) + store.length work ∧ + out = out₀) + (controlTime + 1 + (store.flatMap Entry.encode).length + 1) := by + have hfinish := finishControlInstructionTM_hoareTime_frame_internal tapes + store pcValue newPC initialWork inp₀ out₀ control controlTime hready + hinput houtput hcontrol + apply hfinish.consequence + · exact fun _ _ _ h => h + · rintro inp work out + ⟨hinp, hbuffer, hpc, hcount, hsourceContent, hcleanup, hremaining, + hscanner, hshift, htmp, hdbl, hparked, hout⟩ + exact ⟨hinp, + { buffer := hbuffer + pc := hpc + resultCount := hcount + sourceContent := hsourceContent + cleanup := hcleanup + remaining := hremaining + scanner := hscanner + shift := hshift + tmp := htmp + dbl := hdbl + parked := hparked }, + hout⟩ + · exact le_rfl + +/-- Conditional-zero execution has the common one-buffer instruction +contract. -/ +theorem executeInstructionTM_jz_hoareTime_frame + (tapes : ControlInstructionTapes n) (store : Store) + (pcValue source target : ℕ) (initialWork : Fin (n + 1) → Tape) + (inp₀ out₀ : Tape) + (hready : InstructionExecutionReady tapes store pcValue initialWork) + (hinput : TM.Parked inp₀) (houtput : TM.Parked out₀) : + (executeInstructionTM tapes (.jz source target)).HoareTime + (fun inp work out => inp = inp₀ ∧ work = initialWork ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + InstructionExecutionResult tapes (.jz source target) pcValue store + work ∧ + out = out₀) + (executeInstructionTime tapes (.jz source target) pcValue store) := by + have hcontrol := zeroJumpInstructionTM_hoareTime_frame tapes.lifted store + pcValue source target initialWork inp₀ out₀ hready.control hinput houtput + have hfinish := finishControlInstructionTM_hoareTime_frame_internal tapes + store pcValue + (if RegisterStore.read store source = 0 then target else pcValue + 1) + initialWork inp₀ out₀ _ _ hready hinput houtput hcontrol + apply hfinish.consequence + · exact fun _ _ _ h => h + · rintro inp work out + ⟨hinp, hbuffer, hpc, hcount, hsourceContent, hcleanup, hremaining, + hscanner, hshift, htmp, hdbl, hparked, hout⟩ + by_cases hzero : RegisterStore.read store source = 0 + · exact ⟨hinp, + { buffer := by + simpa [instructionStore, Snapshot.stepInstr, hzero] using hbuffer + pc := by + simpa [instructionPC, Snapshot.stepInstr, hzero] using hpc + resultCount := by + simpa [instructionStore, Snapshot.stepInstr, hzero] using hcount + sourceContent := hsourceContent + cleanup := by + intro slot + have hvalue : instructionCleanupValue (.jz source target) store + slot = 0 := by + fin_cases slot <;> rfl + rw [hvalue] + exact hcleanup slot + remaining := by + simpa [instructionRemainingValue] using hremaining + scanner := by + simpa [instructionCleanupValue] using hscanner + shift := hshift + tmp := htmp + dbl := hdbl + parked := hparked }, + hout⟩ + · exact ⟨hinp, + { buffer := by + simpa [instructionStore, Snapshot.stepInstr, hzero] using hbuffer + pc := by + simpa [instructionPC, Snapshot.stepInstr, hzero] using hpc + resultCount := by + simpa [instructionStore, Snapshot.stepInstr, hzero] using hcount + sourceContent := hsourceContent + cleanup := by + intro slot + have hvalue : instructionCleanupValue (.jz source target) store + slot = 0 := by + fin_cases slot <;> rfl + rw [hvalue] + exact hcleanup slot + remaining := by + simpa [instructionRemainingValue] using hremaining + scanner := by + simpa [instructionCleanupValue] using hscanner + shift := hshift + tmp := htmp + dbl := hdbl + parked := hparked }, + hout⟩ + · exact le_rfl + +/-- Unconditional-jump execution has the common one-buffer instruction +contract. -/ +theorem executeInstructionTM_jmp_hoareTime_frame + (tapes : ControlInstructionTapes n) (store : Store) + (pcValue target : ℕ) (initialWork : Fin (n + 1) → Tape) + (inp₀ out₀ : Tape) + (hready : InstructionExecutionReady tapes store pcValue initialWork) + (hinput : TM.Parked inp₀) (houtput : TM.Parked out₀) : + (executeInstructionTM tapes (.jmp target)).HoareTime + (fun inp work out => inp = inp₀ ∧ work = initialWork ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + InstructionExecutionResult tapes (.jmp target) pcValue store work ∧ + out = out₀) + (executeInstructionTime tapes (.jmp target) pcValue store) := by + have hcontrol := jumpInstructionTM_hoareTime_frame tapes.lifted store + pcValue target initialWork inp₀ out₀ hready.control hinput houtput + have hfinish := finishControlInstructionTM_hoareTime_frame_internal tapes + store pcValue target initialWork inp₀ out₀ _ _ hready hinput houtput + hcontrol + apply hfinish.consequence + · exact fun _ _ _ h => h + · rintro inp work out + ⟨hinp, hbuffer, hpc, hcount, hsourceContent, hcleanup, hremaining, + hscanner, hshift, htmp, hdbl, hparked, hout⟩ + exact ⟨hinp, + { buffer := by + simpa [instructionStore, Snapshot.stepInstr] using hbuffer + pc := by simpa [instructionPC, Snapshot.stepInstr] using hpc + resultCount := by + simpa [instructionStore, Snapshot.stepInstr] using hcount + sourceContent := hsourceContent + cleanup := by + intro slot + have hvalue : instructionCleanupValue (.jmp target) store slot = 0 := by + fin_cases slot <;> rfl + rw [hvalue] + exact hcleanup slot + remaining := by + simpa [instructionRemainingValue] using hremaining + scanner := by + simpa [instructionCleanupValue] using hscanner + shift := hshift + tmp := htmp + dbl := hdbl + parked := hparked }, + hout⟩ + · exact le_rfl + +/-- Halt execution has the common one-buffer instruction contract. -/ +theorem executeInstructionTM_halt_hoareTime_frame + (tapes : ControlInstructionTapes n) (store : Store) + (pcValue : ℕ) (initialWork : Fin (n + 1) → Tape) + (inp₀ out₀ : Tape) + (hready : InstructionExecutionReady tapes store pcValue initialWork) + (hinput : TM.Parked inp₀) (houtput : TM.Parked out₀) : + (executeInstructionTM tapes .halt).HoareTime + (fun inp work out => inp = inp₀ ∧ work = initialWork ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + InstructionExecutionResult tapes .halt pcValue store work ∧ + out = out₀) + (executeInstructionTime tapes .halt pcValue store) := by + have hcontrol := haltInstructionTM_hoareTime_frame tapes.lifted store + pcValue initialWork inp₀ out₀ hready.control hinput houtput + have hfinish := finishControlInstructionTM_hoareTime_frame_internal tapes + store pcValue pcValue initialWork inp₀ out₀ _ _ hready hinput houtput + hcontrol + apply hfinish.consequence + · exact fun _ _ _ h => h + · rintro inp work out + ⟨hinp, hbuffer, hpc, hcount, hsourceContent, hcleanup, hremaining, + hscanner, hshift, htmp, hdbl, hparked, hout⟩ + exact ⟨hinp, + { buffer := by + simpa [instructionStore, Snapshot.stepInstr] using hbuffer + pc := by simpa [instructionPC, Snapshot.stepInstr] using hpc + resultCount := by + simpa [instructionStore, Snapshot.stepInstr] using hcount + sourceContent := hsourceContent + cleanup := by + intro slot + have hvalue : instructionCleanupValue .halt store slot = 0 := by + fin_cases slot <;> rfl + rw [hvalue] + exact hcleanup slot + remaining := by + simpa [instructionRemainingValue] using hremaining + scanner := by + simpa [instructionCleanupValue] using hscanner + shift := hshift + tmp := htmp + dbl := hdbl + parked := hparked }, + hout⟩ + · exact le_rfl + +end Machine + +end RegisterStore + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Sim/Data.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Sim/Data.lean new file mode 100644 index 0000000000..0021d00f96 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Sim/Data.lean @@ -0,0 +1,1423 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Sim.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction + +/-! +# Uniform next-store buffering for data instructions +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace RegisterStore + +namespace Machine + +variable {n : ℕ} + +private theorem hasBinaryNat_parked {t : Tape} {value : ℕ} + (h : t.HasBinaryNat value) : TM.Parked t := by + refine ⟨by rw [h.2.1], ?_⟩ + exact Tape.HasBinaryContent.cells_ne_start h.2.2 + +private theorem hasBinaryPrefix_parked {t : Tape} {bits : List Bool} + (h : t.HasBinaryPrefix bits) : TM.Parked t := by + refine ⟨by rw [h.1]; omega, ?_⟩ + intro j hj + obtain ⟨i, rfl⟩ : ∃ i, j = i + 1 := ⟨j - 1, by omega⟩ + by_cases hi : i < bits.length + · rw [h.2.1 i hi] + exact Γ.ofBool_ne_start _ + · rw [h.2.2 i (Nat.le_of_not_gt hi)] + decide + +/-- Restrict the lifted clean lookup ABI to the original data-tape family. -/ +theorem instructionExecutionReady_baseLookup_internal + (tapes : ControlInstructionTapes n) (store : Store) (pcValue : ℕ) + (work : Fin (n + 1) → Tape) + (hready : InstructionExecutionReady tapes store pcValue work) : + EntryLookupStaticReady tapes.data.lhsLookup store + (fun i => work (Fin.castSucc i)) := by + let baseWork : Fin n → Tape := fun i => work (Fin.castSucc i) + have hcastNe {i j : Fin n} (h : i ≠ j) : + Fin.castSucc i ≠ Fin.castSucc j := by + intro hij + exact h (Fin.castSucc_injective _ hij) + have hscanner : EntryScanReady tapes.data.lhsLookup.scan.entry + (store.flatMap Entry.encode) [] baseWork baseWork := by + let hs := hready.control.lookup.scanner + refine + { source := hs.source + address := hs.address + addressStart := hs.addressStart + value := hs.value + valueStart := hs.valueStart + addressCounter := hs.addressCounter + addressWidth := hs.addressWidth + valueCounter := hs.valueCounter + valueWidth := hs.valueWidth + query := hs.query + queryStart := hs.queryStart + result := hs.result + resultStart := hs.resultStart + parked := fun i => hs.parked (Fin.castSucc i) + frame := ?_ } + intro i hsource haddress hvalue haddressCounter haddressWidth + hvalueCounter hvalueWidth hquery hresult + exact hs.frame (Fin.castSucc i) (hcastNe hsource) (hcastNe haddress) + (hcastNe hvalue) (hcastNe haddressCounter) (hcastNe haddressWidth) + (hcastNe hvalueCounter) (hcastNe hvalueWidth) (hcastNe hquery) + (hcastNe hresult) + exact + { scanner := hscanner + sourceStart := hready.control.lookup.sourceStart + sourceHead := hready.control.lookup.sourceHead + count := hready.control.lookup.count + countSource := hready.control.lookup.countSource + querySource := hready.control.lookup.querySource + destination := hready.control.lookup.destination + copyScratch := hready.control.lookup.copyScratch } + +private theorem entryScanReady_of_role_frame {m : ℕ} + (tapes : EntryMatchTapes m) (sourceBits queryBits : List Bool) + (initialWork finalWork : Fin m → Tape) + (hready : EntryScanReady tapes sourceBits queryBits initialWork initialWork) + (hframe : ∀ slot, finalWork (tapes.idx slot) = + initialWork (tapes.idx slot)) + (hparked : ∀ i, TM.Parked (finalWork i)) : + EntryScanReady tapes sourceBits queryBits finalWork finalWork := by + refine + { source := by rw [show finalWork tapes.source = initialWork tapes.source + from hframe 0]; exact hready.source + address := by rw [show finalWork tapes.address = initialWork tapes.address + from hframe 1]; exact hready.address + addressStart := by + rw [show finalWork tapes.address = initialWork tapes.address + from hframe 1]; exact hready.addressStart + value := by rw [show finalWork tapes.value = initialWork tapes.value + from hframe 2]; exact hready.value + valueStart := by rw [show finalWork tapes.value = initialWork tapes.value + from hframe 2]; exact hready.valueStart + addressCounter := by + rw [show finalWork tapes.addressCounter = + initialWork tapes.addressCounter from hframe 3] + exact hready.addressCounter + addressWidth := by + rw [show finalWork tapes.addressWidth = initialWork tapes.addressWidth + from hframe 4] + exact hready.addressWidth + valueCounter := by + rw [show finalWork tapes.valueCounter = initialWork tapes.valueCounter + from hframe 5] + exact hready.valueCounter + valueWidth := by + rw [show finalWork tapes.valueWidth = initialWork tapes.valueWidth + from hframe 6] + exact hready.valueWidth + query := by rw [show finalWork tapes.query = initialWork tapes.query + from hframe 7]; exact hready.query + queryStart := by rw [show finalWork tapes.query = initialWork tapes.query + from hframe 7]; exact hready.queryStart + result := by rw [show finalWork tapes.result = initialWork tapes.result + from hframe 8]; exact hready.result + resultStart := by + rw [show finalWork tapes.result = initialWork tapes.result + from hframe 8]; exact hready.resultStart + parked := hparked + frame := by intro i _ _ _ _ _ _ _ _ _; rfl } + +/-- Lift a scanner-ready state on the initial tape family to the one-buffer +layout. The scanner roles all live below the fresh final tape. -/ +private theorem entryScanReady_lifted {m : ℕ} + (tapes : EntryMatchTapes m) (sourceBits queryBits : List Bool) + (work : Fin (m + 1) → Tape) + (hready : EntryScanReady tapes sourceBits queryBits + (fun i => work (Fin.castSucc i)) (fun i => work (Fin.castSucc i))) + (hparked : ∀ i, TM.Parked (work i)) : + EntryScanReady + { idx := fun slot => Fin.castSucc (tapes.idx slot) + injective := by + intro i j h + apply tapes.injective + exact Fin.castSucc_injective _ h } + sourceBits queryBits work work := by + refine + { source := hready.source + address := hready.address + addressStart := hready.addressStart + value := hready.value + valueStart := hready.valueStart + addressCounter := hready.addressCounter + addressWidth := hready.addressWidth + valueCounter := hready.valueCounter + valueWidth := hready.valueWidth + query := hready.query + queryStart := hready.queryStart + result := hready.result + resultStart := hready.resultStart + parked := hparked + frame := by intro i _ _ _ _ _ _ _ _ _; rfl } + +/-- Increment the PC after a redirected data kernel satisfying the common +pre-successor boundary. -/ +theorem finishBufferedDataTM_hoareTime_frame_internal + (tapes : ControlInstructionTapes n) (oldStore nextStore : Store) + (nextPC pcValue : ℕ) (cleanupValues : Fin 5 → ℕ) + (remainingValue : ℕ) (initialWork : Fin (n + 1) → Tape) + (inp₀ : Tape) (dataTM : TM n) (dataTime : ℕ) + (hpcNext : nextPC = pcValue + 1) + (hinput : TM.Parked inp₀) + (hdata : dataTM.retargetOutput.HoareTime + (fun inp work out => + inp = inp₀ ∧ work = initialWork ∧ + out = (Tape.init []).move Dir3.right) + (fun inp work out => + inp = inp₀ ∧ + (work tapes.buffer).HasBinaryPrefix + (nextStore.flatMap Entry.encode) ∧ + (work tapes.liftedPC).HasBinaryNat pcValue ∧ + (work tapes.lifted.data.update.resultCount).HasBinaryNat + nextStore.length ∧ + (work tapes.liftedSource).HasBinaryContent + (oldStore.flatMap Entry.encode) ∧ + (∀ slot, + (work (instructionCleanupTape tapes slot)).HasBinaryNat + (cleanupValues slot)) ∧ + (work tapes.lifted.data.update.remaining).HasBinaryNat + remainingValue ∧ + EntryScanReady tapes.lifted.data.update.entry [] + (cleanupValues 0).bits work work ∧ + (work tapes.lifted.data.shift).HasBinaryNat 0 ∧ + (work tapes.lifted.data.tmp).HasBinaryNat 0 ∧ + (work tapes.lifted.data.dbl).HasBinaryNat 0 ∧ + (∀ i, TM.Parked (work i)) ∧ + out = (Tape.init []).move Dir3.right) + dataTime) : + (TM.seqTM dataTM.retargetOutput + (TM.binarySuccTM tapes.liftedPC)).HoareTime + (fun inp work out => + inp = inp₀ ∧ work = initialWork ∧ + out = (Tape.init []).move Dir3.right) + (fun inp work out => + inp = inp₀ ∧ + BufferedInstructionResult tapes oldStore nextStore nextPC + cleanupValues remainingValue work ∧ + out = (Tape.init []).move Dir3.right) + (dataTime + 1 + TM.binarySuccTime pcValue) := by + let out₀ := (Tape.init []).move Dir3.right + have hout : TM.Parked out₀ := + hasBinaryPrefix_parked Tape.init_nil_move_right_hasBinaryPrefix_nil + have hsucc : (TM.binarySuccTM tapes.liftedPC).HoareTime + (fun inp work out => + inp = inp₀ ∧ + (work tapes.buffer).HasBinaryPrefix + (nextStore.flatMap Entry.encode) ∧ + (work tapes.liftedPC).HasBinaryNat pcValue ∧ + (work tapes.lifted.data.update.resultCount).HasBinaryNat + nextStore.length ∧ + (work tapes.liftedSource).HasBinaryContent + (oldStore.flatMap Entry.encode) ∧ + (∀ slot, + (work (instructionCleanupTape tapes slot)).HasBinaryNat + (cleanupValues slot)) ∧ + (work tapes.lifted.data.update.remaining).HasBinaryNat + remainingValue ∧ + EntryScanReady tapes.lifted.data.update.entry [] + (cleanupValues 0).bits work work ∧ + (work tapes.lifted.data.shift).HasBinaryNat 0 ∧ + (work tapes.lifted.data.tmp).HasBinaryNat 0 ∧ + (work tapes.lifted.data.dbl).HasBinaryNat 0 ∧ + (∀ i, TM.Parked (work i)) ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + BufferedInstructionResult tapes oldStore nextStore nextPC + cleanupValues remainingValue work ∧ + out = out₀) + (TM.binarySuccTime pcValue) := by + rintro inp work out + ⟨hinp, hbuffer, hpc, hcount, hsourceContent, hcleanup, hremaining, + hscanner, hshift, htmp, hdbl, hparked, houtEq⟩ + have hinpParked : TM.Parked inp := by simpa [hinp] using hinput + have houtParked : TM.Parked out := by simpa [houtEq] using hout + have hrun := TM.binarySuccTM_hoareTime_frame tapes.liftedPC pcValue + inp work out hpc hinpParked.read_ne_start + (fun i _ => (hparked i).read_ne_start) houtParked.read_ne_start + obtain ⟨final, time, htime, hreach, hhalt, hfinalInput, hframe, + hfinalPC, hfinalOutput⟩ := hrun inp work out ⟨rfl, rfl, rfl⟩ + refine ⟨final, time, htime, hreach, hhalt, hfinalInput.trans hinp, + ?_, hfinalOutput.trans houtEq⟩ + refine + { buffer := ?_ + pc := ?_ + resultCount := ?_ + sourceContent := ?_ + cleanup := ?_ + remaining := ?_ + scanner := ?_ + shift := ?_ + tmp := ?_ + dbl := ?_ + parked := ?_ } + · rw [hframe tapes.buffer tapes.liftedPC_ne_buffer.symm] + exact hbuffer + · rw [hpcNext] + exact hfinalPC + · rw [hframe tapes.lifted.data.update.resultCount + (tapes.lifted.data_ne_pc 12)] + exact hcount + · rw [hframe tapes.liftedSource tapes.liftedPC_ne_source.symm] + exact hsourceContent + · intro slot + rw [show final.work (instructionCleanupTape tapes slot) = + work (instructionCleanupTape tapes slot) from + hframe _ (tapes.lifted.data_ne_pc + (instructionCleanupParentSlot slot))] + exact hcleanup slot + · rw [hframe tapes.lifted.data.update.remaining + (tapes.lifted.data_ne_pc 9)] + exact hremaining + · exact entryScanReady_of_role_frame _ _ _ _ _ hscanner + (fun slot => hframe _ (tapes.lifted.pc_ne ⟨slot, by omega⟩).symm) + (by + intro i + by_cases hi : i = tapes.liftedPC + · subst i + exact hasBinaryNat_parked hfinalPC + · rw [hframe i hi] + exact hparked i) + · rw [hframe tapes.lifted.data.shift (tapes.lifted.data_ne_pc 15)] + exact hshift + · rw [hframe tapes.lifted.data.tmp (tapes.lifted.data_ne_pc 16)] + exact htmp + · rw [hframe tapes.lifted.data.dbl (tapes.lifted.data_ne_pc 17)] + exact hdbl + · intro i + by_cases hi : i = tapes.liftedPC + · subst i + exact hasBinaryNat_parked hfinalPC + · rw [hframe i hi] + exact hparked i + have hseq := TM.seqTM_hoareTime dataTM.retargetOutput + (TM.binarySuccTM tapes.liftedPC) hdata + (by + rintro inp work out + ⟨hinp, hbuffer, hpc, hcount, hsourceContent, hcleanup, hremaining, + hscanner, hshift, htmp, hdbl, hparked, houtEq⟩ + have hinpParked : TM.Parked inp := by simpa [hinp] using hinput + have houtParked : TM.Parked out := by simpa [houtEq] using hout + obtain ⟨hi, hw, ho⟩ := + TM.phaseTransition_eq_self_of_reads_ne_start + hinpParked.read_ne_start + (fun i => (hparked i).read_ne_start) + houtParked.read_ne_start + rw [hi, hw, ho] + exact ⟨hinp, hbuffer, hpc, hcount, hsourceContent, hcleanup, + hremaining, hscanner, hshift, htmp, hdbl, hparked, houtEq⟩) + hsucc + simpa only [out₀] using hseq + +/-- Sparse-instruction specialization of buffered data finalization. -/ +private theorem finishDataInstructionTM_hoareTime_frame_internal + (tapes : ControlInstructionTapes n) (instruction : Instr) + (store : Store) (pcValue : ℕ) (initialWork : Fin (n + 1) → Tape) + (inp₀ : Tape) (dataTM : TM n) (dataTime : ℕ) + (hpcNext : instructionPC instruction pcValue store = pcValue + 1) + (hinput : TM.Parked inp₀) + (hdata : dataTM.retargetOutput.HoareTime + (fun inp work out => + inp = inp₀ ∧ work = initialWork ∧ + out = (Tape.init []).move Dir3.right) + (fun inp work out => + inp = inp₀ ∧ + (work tapes.buffer).HasBinaryPrefix + ((instructionStore instruction pcValue store).flatMap Entry.encode) ∧ + (work tapes.liftedPC).HasBinaryNat pcValue ∧ + (work tapes.lifted.data.update.resultCount).HasBinaryNat + (instructionStore instruction pcValue store).length ∧ + (work tapes.liftedSource).HasBinaryContent + (store.flatMap Entry.encode) ∧ + (∀ slot, + (work (instructionCleanupTape tapes slot)).HasBinaryNat + (instructionCleanupValue instruction store slot)) ∧ + (work tapes.lifted.data.update.remaining).HasBinaryNat + (instructionRemainingValue instruction store) ∧ + EntryScanReady tapes.lifted.data.update.entry [] + (instructionCleanupValue instruction store 0).bits work work ∧ + (work tapes.lifted.data.shift).HasBinaryNat 0 ∧ + (work tapes.lifted.data.tmp).HasBinaryNat 0 ∧ + (work tapes.lifted.data.dbl).HasBinaryNat 0 ∧ + (∀ i, TM.Parked (work i)) ∧ + out = (Tape.init []).move Dir3.right) + dataTime) : + (TM.seqTM dataTM.retargetOutput + (TM.binarySuccTM tapes.liftedPC)).HoareTime + (fun inp work out => + inp = inp₀ ∧ work = initialWork ∧ + out = (Tape.init []).move Dir3.right) + (fun inp work out => + inp = inp₀ ∧ + InstructionExecutionResult tapes instruction pcValue store work ∧ + out = (Tape.init []).move Dir3.right) + (dataTime + 1 + TM.binarySuccTime pcValue) := by + have hrun := finishBufferedDataTM_hoareTime_frame_internal tapes store + (instructionStore instruction pcValue store) + (instructionPC instruction pcValue store) pcValue + (instructionCleanupValue instruction store) + (instructionRemainingValue instruction store) initialWork inp₀ dataTM + dataTime hpcNext hinput hdata + exact hrun.strengthen_post (by + rintro inp work out ⟨hinp, hresult, hout⟩ + exact ⟨hinp, + { buffer := hresult.buffer + pc := hresult.pc + resultCount := hresult.resultCount + sourceContent := hresult.sourceContent + cleanup := hresult.cleanup + remaining := hresult.remaining + scanner := hresult.scanner + shift := hresult.shift + tmp := hresult.tmp + dbl := hresult.dbl + parked := hresult.parked }, + hout⟩) + +/-- Lift a base data-kernel contract through output redirection once its +semantic result exposes PC framing, the next-store count, and parked heads. -/ +theorem retargetBufferedDataKernel_hoareTime_frame_internal + (tapes : ControlInstructionTapes n) (oldStore nextStore : Store) + (cleanupValues : Fin 5 → ℕ) (remainingValue pcValue : ℕ) + (initialWork : Fin (n + 1) → Tape) + (inp₀ : Tape) (dataTM : TM n) (dataTime : ℕ) + (Result : (Fin n → Tape) → Prop) + (hready : InstructionExecutionReady tapes oldStore pcValue initialWork) + (hbase : dataTM.HoareTime + (fun inp work out => + inp = inp₀ ∧ + work = (fun i => initialWork (Fin.castSucc i)) ∧ + out = initialWork tapes.buffer) + (fun inp work out => + inp = inp₀ ∧ Result work ∧ + out.HasBinaryPrefix + (nextStore.flatMap Entry.encode)) + dataTime) + (hresult : ∀ work, Result work → + work tapes.pc = initialWork (Fin.castSucc tapes.pc) ∧ + (work tapes.data.update.resultCount).HasBinaryNat + nextStore.length ∧ + (work tapes.data.update.entry.source).HasBinaryContent + (oldStore.flatMap Entry.encode) ∧ + (∀ slot, + (work (tapes.data.idx (instructionCleanupParentSlot slot))).HasBinaryNat + (cleanupValues slot)) ∧ + (work tapes.data.update.remaining).HasBinaryNat + remainingValue ∧ + EntryScanReady tapes.data.update.entry [] + (cleanupValues 0).bits work work ∧ + (work tapes.data.shift).HasBinaryNat 0 ∧ + (work tapes.data.tmp).HasBinaryNat 0 ∧ + (work tapes.data.dbl).HasBinaryNat 0 ∧ + ∀ i, TM.Parked (work i)) : + dataTM.retargetOutput.HoareTime + (fun inp work out => + inp = inp₀ ∧ work = initialWork ∧ + out = (Tape.init []).move Dir3.right) + (fun inp work out => + inp = inp₀ ∧ + (work tapes.buffer).HasBinaryPrefix + (nextStore.flatMap Entry.encode) ∧ + (work tapes.liftedPC).HasBinaryNat pcValue ∧ + (work tapes.lifted.data.update.resultCount).HasBinaryNat + nextStore.length ∧ + (work tapes.liftedSource).HasBinaryContent + (oldStore.flatMap Entry.encode) ∧ + (∀ slot, + (work (instructionCleanupTape tapes slot)).HasBinaryNat + (cleanupValues slot)) ∧ + (work tapes.lifted.data.update.remaining).HasBinaryNat + remainingValue ∧ + EntryScanReady tapes.lifted.data.update.entry [] + (cleanupValues 0).bits work work ∧ + (work tapes.lifted.data.shift).HasBinaryNat 0 ∧ + (work tapes.lifted.data.tmp).HasBinaryNat 0 ∧ + (work tapes.lifted.data.dbl).HasBinaryNat 0 ∧ + (∀ i, TM.Parked (work i)) ∧ + out = (Tape.init []).move Dir3.right) + dataTime := by + have hlift := TM.retargetOutput_hoareTime dataTM hbase + apply hlift.consequence + · rintro inp work out ⟨hinp, hwork, hout⟩ + subst work + exact ⟨⟨hinp, rfl, rfl⟩, hout⟩ + · rintro inp work out ⟨⟨hinp, hsemantic, hbuffer⟩, hout⟩ + obtain ⟨hpcEq, hcount, hsourceContent, hcleanup, hremaining, hscanner, + hshift, htmp, hdbl, hparkedBase⟩ := + hresult _ hsemantic + have hpc : (work tapes.liftedPC).HasBinaryNat pcValue := by + change (work (Fin.castSucc tapes.pc)).HasBinaryNat pcValue + rw [hpcEq] + exact hready.control.pc + have hparked : ∀ i, TM.Parked (work i) := by + intro i + exact Fin.lastCases (hasBinaryPrefix_parked hbuffer) + (fun j => hparkedBase j) i + exact ⟨hinp, hbuffer, hpc, hcount, hsourceContent, hcleanup, + hremaining, by + simpa [ControlInstructionTapes.lifted] using + entryScanReady_lifted tapes.data.update.entry _ _ work hscanner + hparked, + hshift, htmp, hdbl, hparked, hout⟩ + · exact le_rfl + +/-- Sparse specialization of representation-independent output retargeting. -/ +private theorem retargetDataKernel_hoareTime_frame_internal + (tapes : ControlInstructionTapes n) (instruction : Instr) + (store : Store) (pcValue : ℕ) (initialWork : Fin (n + 1) → Tape) + (inp₀ : Tape) (dataTM : TM n) (dataTime : ℕ) + (Result : (Fin n → Tape) → Prop) + (hready : InstructionExecutionReady tapes store pcValue initialWork) + (hbase : dataTM.HoareTime + (fun inp work out => + inp = inp₀ ∧ + work = (fun i => initialWork (Fin.castSucc i)) ∧ + out = initialWork tapes.buffer) + (fun inp work out => + inp = inp₀ ∧ Result work ∧ + out.HasBinaryPrefix + ((instructionStore instruction pcValue store).flatMap Entry.encode)) + dataTime) + (hresult : ∀ work, Result work → + work tapes.pc = initialWork (Fin.castSucc tapes.pc) ∧ + (work tapes.data.update.resultCount).HasBinaryNat + (instructionStore instruction pcValue store).length ∧ + (work tapes.data.update.entry.source).HasBinaryContent + (store.flatMap Entry.encode) ∧ + (∀ slot, + (work (tapes.data.idx (instructionCleanupParentSlot slot))).HasBinaryNat + (instructionCleanupValue instruction store slot)) ∧ + (work tapes.data.update.remaining).HasBinaryNat + (instructionRemainingValue instruction store) ∧ + EntryScanReady tapes.data.update.entry [] + (instructionCleanupValue instruction store 0).bits work work ∧ + (work tapes.data.shift).HasBinaryNat 0 ∧ + (work tapes.data.tmp).HasBinaryNat 0 ∧ + (work tapes.data.dbl).HasBinaryNat 0 ∧ + ∀ i, TM.Parked (work i)) : + dataTM.retargetOutput.HoareTime + (fun inp work out => + inp = inp₀ ∧ work = initialWork ∧ + out = (Tape.init []).move Dir3.right) + (fun inp work out => + inp = inp₀ ∧ + (work tapes.buffer).HasBinaryPrefix + ((instructionStore instruction pcValue store).flatMap Entry.encode) ∧ + (work tapes.liftedPC).HasBinaryNat pcValue ∧ + (work tapes.lifted.data.update.resultCount).HasBinaryNat + (instructionStore instruction pcValue store).length ∧ + (work tapes.liftedSource).HasBinaryContent + (store.flatMap Entry.encode) ∧ + (∀ slot, + (work (instructionCleanupTape tapes slot)).HasBinaryNat + (instructionCleanupValue instruction store slot)) ∧ + (work tapes.lifted.data.update.remaining).HasBinaryNat + (instructionRemainingValue instruction store) ∧ + EntryScanReady tapes.lifted.data.update.entry [] + (instructionCleanupValue instruction store 0).bits work work ∧ + (work tapes.lifted.data.shift).HasBinaryNat 0 ∧ + (work tapes.lifted.data.tmp).HasBinaryNat 0 ∧ + (work tapes.lifted.data.dbl).HasBinaryNat 0 ∧ + (∀ i, TM.Parked (work i)) ∧ + out = (Tape.init []).move Dir3.right) + dataTime := + retargetBufferedDataKernel_hoareTime_frame_internal tapes store + (instructionStore instruction pcValue store) + (instructionCleanupValue instruction store) + (instructionRemainingValue instruction store) pcValue initialWork inp₀ + dataTM dataTime Result hready hbase hresult + +/-- Instruction constructor corresponding to a direct arithmetic kernel. -/ +def directInstruction (op : BinaryInstrOp) (destination source₀ + source₁ : ℕ) : Instr := + match op with + | .add => .add destination source₀ source₁ + | .sub => .sub destination source₀ source₁ + | .mul => .mul destination source₀ source₁ + +/-- Immediate execution redirects the new sparse store and increments the +program counter. -/ +theorem executeInstructionTM_imm_hoareTime_frame + (tapes : ControlInstructionTapes n) (store : Store) + (pcValue destination value : ℕ) + (initialWork : Fin (n + 1) → Tape) (inp₀ : Tape) + (hready : InstructionExecutionReady tapes store pcValue initialWork) + (hinput : TM.Parked inp₀) : + (executeInstructionTM tapes (.imm destination value)).HoareTime + (fun inp work out => + inp = inp₀ ∧ work = initialWork ∧ + out = (Tape.init []).move Dir3.right) + (fun inp work out => + inp = inp₀ ∧ + InstructionExecutionResult tapes (.imm destination value) pcValue + store work ∧ + out = (Tape.init []).move Dir3.right) + (executeInstructionTime tapes (.imm destination value) pcValue store) := by + let baseWork : Fin n → Tape := fun i => initialWork (Fin.castSucc i) + have hlookup : EntryLookupStaticReady tapes.data.lhsLookup store baseWork := by + exact instructionExecutionReady_baseLookup_internal tapes store pcValue + initialWork + hready + have hreplacement : + (baseWork tapes.data.update.replacement).HasBinaryNat 0 := by + exact hready.replacement + have hbuffer : + (initialWork tapes.buffer).HasBinaryPrefix [] := by + rw [hready.buffer] + exact Tape.init_nil_move_right_hasBinaryPrefix_nil + have hbase := immediateInstructionTM_hoareTime_frame tapes.data store + destination value [] baseWork inp₀ (initialWork tapes.buffer) + hready.canonical hlookup hreplacement hinput hbuffer + have hlift := TM.retargetOutput_hoareTime + (immediateInstructionTM tapes.data destination value) hbase + have hdata : + (immediateInstructionTM tapes.data destination value).retargetOutput.HoareTime + (fun inp work out => + inp = inp₀ ∧ work = initialWork ∧ + out = (Tape.init []).move Dir3.right) + (fun inp work out => + inp = inp₀ ∧ + (work tapes.buffer).HasBinaryPrefix + ((instructionStore (.imm destination value) pcValue store).flatMap + Entry.encode) ∧ + (work tapes.liftedPC).HasBinaryNat pcValue ∧ + (work tapes.lifted.data.update.resultCount).HasBinaryNat + (instructionStore (.imm destination value) pcValue store).length ∧ + (work tapes.liftedSource).HasBinaryContent + (store.flatMap Entry.encode) ∧ + (∀ slot, + (work (instructionCleanupTape tapes slot)).HasBinaryNat + (instructionCleanupValue (.imm destination value) store slot)) ∧ + (work tapes.lifted.data.update.remaining).HasBinaryNat + (instructionRemainingValue (.imm destination value) store) ∧ + EntryScanReady tapes.lifted.data.update.entry [] destination.bits + work work ∧ + (work tapes.lifted.data.shift).HasBinaryNat 0 ∧ + (work tapes.lifted.data.tmp).HasBinaryNat 0 ∧ + (work tapes.lifted.data.dbl).HasBinaryNat 0 ∧ + (∀ i, TM.Parked (work i)) ∧ + out = (Tape.init []).move Dir3.right) + (immediateInstructionTime tapes.data store destination value) := by + apply hlift.consequence + · rintro inp work out ⟨hinp, hwork, hout⟩ + subst work + exact ⟨⟨hinp, rfl, rfl⟩, hout⟩ + · rintro inp work out ⟨⟨hinp, hresult, hbuffer'⟩, hout⟩ + obtain ⟨valueWork, updateWork, hvalueWork, hupdateWork, houtcome, + hsourceCells⟩ := hresult + have hpcBase : + (fun i => work (Fin.castSucc i)) tapes.pc = baseWork tapes.pc := by + have hpcQuery : + tapes.pc ≠ tapes.data.update.entry.query := tapes.pc_ne 7 + have hpcReplacement : + tapes.pc ≠ tapes.data.update.replacement := tapes.pc_ne 10 + calc + work (Fin.castSucc tapes.pc) = updateWork tapes.pc := + houtcome.frame tapes.pc (fun slot => by + exact tapes.pc_ne ⟨slot, by omega⟩) + _ = valueWork tapes.pc := by + rw [hupdateWork, Function.update_of_ne hpcQuery] + _ = baseWork tapes.pc := by + rw [hvalueWork, Function.update_of_ne hpcReplacement] + have hpc : (work tapes.liftedPC).HasBinaryNat pcValue := by + change ((fun i => work (Fin.castSucc i)) tapes.pc).HasBinaryNat pcValue + rw [hpcBase] + exact hready.control.pc + have hcount : + (work tapes.lifted.data.update.resultCount).HasBinaryNat + (RegisterStore.write store destination value).length := by + exact houtcome.resultCount + have hparked : ∀ i, TM.Parked (work i) := by + intro i + exact Fin.lastCases (hasBinaryPrefix_parked hbuffer') + (fun j => houtcome.ready.parked j) i + have hsourceContent : + (work tapes.liftedSource).HasBinaryContent + (store.flatMap Entry.encode) := by + change ((fun i => work (Fin.castSucc i)) + tapes.data.update.entry.source).HasBinaryContent _ + unfold Tape.HasBinaryContent + rw [hsourceCells] + exact hready.sourceContent + have hcleanup : ∀ slot, + (work (instructionCleanupTape tapes slot)).HasBinaryNat + (instructionCleanupValue (.imm destination value) store slot) := by + intro slot + fin_cases slot + · exact ⟨houtcome.ready.queryStart, by + simpa [instructionCleanupValue, instructionCleanupTape, + instructionCleanupParentSlot] using houtcome.ready.query⟩ + · change ((fun i => work (Fin.castSucc i)) + tapes.data.update.replacement).HasBinaryNat value + rw [show (fun i => work (Fin.castSucc i)) + tapes.data.update.replacement = + updateWork tapes.data.update.replacement from + houtcome.replacement] + rw [show updateWork tapes.data.update.replacement = + valueWork tapes.data.update.replacement by + rw [hupdateWork] + exact Function.update_of_ne + (tapes.data.update.ne (by decide)) _ _] + rw [show valueWork tapes.data.update.replacement = + (Tape.init (value.bits.map Γ.ofBool)).move Dir3.right by + rw [hvalueWork] + exact Function.update_self _ _ _] + exact Tape.init_move_right_hasBinaryNat value + · simpa [instructionCleanupValue, instructionCleanupTape, + instructionCleanupParentSlot] using houtcome.found + · change ((fun i => work (Fin.castSucc i)) tapes.data.lhs).HasBinaryNat 0 + rw [show (fun i => work (Fin.castSucc i)) tapes.data.lhs = + updateWork tapes.data.lhs from + houtcome.frame tapes.data.lhs (fun role => + (tapes.data.update_ne_lhs role).symm), + show updateWork tapes.data.lhs = valueWork tapes.data.lhs by + rw [hupdateWork] + exact Function.update_of_ne + (tapes.data.update_ne_lhs 7).symm _ _, + show valueWork tapes.data.lhs = baseWork tapes.data.lhs by + rw [hvalueWork] + exact Function.update_of_ne + (tapes.data.update_ne_lhs 10).symm _ _] + exact hready.control.lookup.destination + · change ((fun i => work (Fin.castSucc i)) tapes.data.rhs).HasBinaryNat 0 + rw [show (fun i => work (Fin.castSucc i)) tapes.data.rhs = + updateWork tapes.data.rhs from + houtcome.frame tapes.data.rhs (fun role => + (tapes.data.update_ne_rhs role).symm), + show updateWork tapes.data.rhs = valueWork tapes.data.rhs by + rw [hupdateWork] + exact Function.update_of_ne + (tapes.data.update_ne_rhs 7).symm _ _, + show valueWork tapes.data.rhs = baseWork tapes.data.rhs by + rw [hvalueWork] + exact Function.update_of_ne + (tapes.data.update_ne_rhs 10).symm _ _] + exact hready.rhs + have hshift : (work tapes.lifted.data.shift).HasBinaryNat 0 := by + change ((fun i => work (Fin.castSucc i)) + tapes.data.shift).HasBinaryNat 0 + have hqueryNe : tapes.data.shift ≠ + tapes.data.update.entry.query := + (tapes.data.update_ne_shift 7).symm + have hreplacementNe : tapes.data.shift ≠ + tapes.data.update.replacement := + (tapes.data.update_ne_shift 10).symm + rw [houtcome.frame tapes.data.shift (fun slot => + (tapes.data.update_ne_shift slot).symm), + hupdateWork, Function.update_of_ne hqueryNe, + hvalueWork, Function.update_of_ne hreplacementNe] + exact hready.control.lookup.querySource + have htmp' : (work tapes.lifted.data.tmp).HasBinaryNat 0 := by + change ((fun i => work (Fin.castSucc i)) + tapes.data.tmp).HasBinaryNat 0 + have hqueryNe : tapes.data.tmp ≠ + tapes.data.update.entry.query := + (tapes.data.update_ne_tmp 7).symm + have hreplacementNe : tapes.data.tmp ≠ + tapes.data.update.replacement := + (tapes.data.update_ne_tmp 10).symm + rw [houtcome.frame tapes.data.tmp (fun slot => + (tapes.data.update_ne_tmp slot).symm), + hupdateWork, Function.update_of_ne hqueryNe, + hvalueWork, Function.update_of_ne hreplacementNe] + exact hready.tmp + have hdbl' : (work tapes.lifted.data.dbl).HasBinaryNat 0 := by + change ((fun i => work (Fin.castSucc i)) + tapes.data.dbl).HasBinaryNat 0 + have hqueryNe : tapes.data.dbl ≠ + tapes.data.update.entry.query := + (tapes.data.update_ne_dbl 7).symm + have hreplacementNe : tapes.data.dbl ≠ + tapes.data.update.replacement := + (tapes.data.update_ne_dbl 10).symm + rw [houtcome.frame tapes.data.dbl (fun slot => + (tapes.data.update_ne_dbl slot).symm), + hupdateWork, Function.update_of_ne hqueryNe, + hvalueWork, Function.update_of_ne hreplacementNe] + exact hready.dbl + refine ⟨hinp, ?_, hpc, ?_, hsourceContent, hcleanup, ?_, ?_, hshift, + htmp', hdbl', hparked, hout⟩ + · simpa [instructionStore, Snapshot.stepInstr] using hbuffer' + · simpa [instructionStore, Snapshot.stepInstr] using hcount + · simpa [instructionRemainingValue] using houtcome.remaining + · simpa [ControlInstructionTapes.lifted] using + entryScanReady_lifted tapes.data.update.entry _ _ work + houtcome.ready hparked + · exact le_rfl + simpa only [executeInstructionTM, executeInstructionTime] using + finishDataInstructionTM_hoareTime_frame_internal tapes + (.imm destination value) store pcValue initialWork inp₀ + (immediateInstructionTM tapes.data destination value) + (immediateInstructionTime tapes.data store destination value) rfl hinput + hdata + +/-- A direct arithmetic kernel redirects its next sparse store and increments +the program counter. -/ +theorem executeInstructionTM_direct_hoareTime_frame + (tapes : ControlInstructionTapes n) (op : BinaryInstrOp) (store : Store) + (pcValue destination source₀ source₁ : ℕ) + (initialWork : Fin (n + 1) → Tape) (inp₀ : Tape) + (hready : InstructionExecutionReady tapes store pcValue initialWork) + (hinput : TM.Parked inp₀) : + (executeInstructionTM tapes + (directInstruction op destination source₀ source₁)).HoareTime + (fun inp work out => + inp = inp₀ ∧ work = initialWork ∧ + out = (Tape.init []).move Dir3.right) + (fun inp work out => + inp = inp₀ ∧ + InstructionExecutionResult tapes + (directInstruction op destination source₀ source₁) pcValue store + work ∧ + out = (Tape.init []).move Dir3.right) + (executeInstructionTime tapes + (directInstruction op destination source₀ source₁) pcValue store) := by + let baseWork : Fin n → Tape := fun i => initialWork (Fin.castSucc i) + have hlookup : EntryLookupStaticReady tapes.data.lhsLookup store baseWork := + instructionExecutionReady_baseLookup_internal tapes store pcValue + initialWork hready + have hrhs : (baseWork tapes.data.rhs).HasBinaryNat 0 := hready.rhs + have hreplacement : + (baseWork tapes.data.update.replacement).HasBinaryNat 0 := + hready.replacement + have htmp : (baseWork tapes.data.tmp).HasBinaryNat 0 := hready.tmp + have hdbl : (baseWork tapes.data.dbl).HasBinaryNat 0 := hready.dbl + have hbuffer : (initialWork tapes.buffer).HasBinaryPrefix [] := by + rw [hready.buffer] + exact Tape.init_nil_move_right_hasBinaryPrefix_nil + have hbaseRaw := directBinaryInstructionTM_hoareTime_frame tapes.data op store + destination source₀ source₁ [] baseWork inp₀ + (initialWork tapes.buffer) hready.canonical hlookup hrhs hreplacement htmp + hdbl hinput hbuffer + let Result : (Fin n → Tape) → Prop := fun work => + DirectBinaryInstructionResult tapes.data op store destination source₀ + source₁ baseWork work + have hbase : (directBinaryInstructionTM tapes.data op destination source₀ + source₁).HoareTime + (fun inp work out => inp = inp₀ ∧ work = baseWork ∧ + out = initialWork tapes.buffer) + (fun inp work out => + inp = inp₀ ∧ Result work ∧ + out.HasBinaryPrefix + ((instructionStore + (directInstruction op destination source₀ source₁) pcValue store).flatMap + Entry.encode)) + (directBinaryInstructionTime tapes.data op store destination source₀ + source₁) := by + cases op <;> + simpa [Result, directInstruction, instructionStore, Snapshot.stepInstr, + BinaryInstrOp.eval] using hbaseRaw + have hresult : ∀ work, Result work → + work tapes.pc = initialWork (Fin.castSucc tapes.pc) ∧ + (work tapes.data.update.resultCount).HasBinaryNat + (instructionStore (directInstruction op destination source₀ source₁) + pcValue store).length ∧ + (work tapes.data.update.entry.source).HasBinaryContent + (store.flatMap Entry.encode) ∧ + (∀ slot, + (work (tapes.data.idx (instructionCleanupParentSlot slot))).HasBinaryNat + (instructionCleanupValue + (directInstruction op destination source₀ source₁) store slot)) ∧ + (work tapes.data.update.remaining).HasBinaryNat + (instructionRemainingValue + (directInstruction op destination source₀ source₁) store) ∧ + EntryScanReady tapes.data.update.entry [] + (instructionCleanupValue + (directInstruction op destination source₀ source₁) store 0).bits + work work ∧ + (work tapes.data.shift).HasBinaryNat 0 ∧ + (work tapes.data.tmp).HasBinaryNat 0 ∧ + (work tapes.data.dbl).HasBinaryNat 0 ∧ + ∀ i, TM.Parked (work i) := by + intro work hsemantic + obtain ⟨updateWork, haddress, hbinary⟩ := hsemantic + obtain ⟨operandsWork, hoperands, hupdateWork⟩ := haddress + obtain ⟨lhsWork, hlhs, hrhsResult⟩ := hoperands + obtain ⟨arithmeticWork, harithmetic, houtcome, hsourceCells⟩ := hbinary + have hpcUpdate : work tapes.pc = arithmeticWork tapes.pc := by + exact houtcome.frame tapes.pc (fun slot => by + exact tapes.pc_ne ⟨slot, by omega⟩) + have hpcArithmetic : arithmeticWork tapes.pc = updateWork tapes.pc := by + exact harithmetic.frame tapes.pc (tapes.pc_ne 13) (tapes.pc_ne 14) + (tapes.pc_ne 10) (tapes.pc_ne 15) (tapes.pc_ne 16) + (tapes.pc_ne 17) + have hpcQuery : tapes.pc ≠ tapes.data.update.entry.query := tapes.pc_ne 7 + have hpcAddress : updateWork tapes.pc = operandsWork tapes.pc := by + rw [hupdateWork, Function.update_of_ne hpcQuery] + have hpcRhs : operandsWork tapes.pc = lhsWork tapes.pc := by + exact hrhsResult.frame tapes.pc (fun slot => by + exact tapes.pc_ne (BinaryInstructionTapes.rhsLookupSlot slot)) + have hpcLhs : lhsWork tapes.pc = baseWork tapes.pc := by + exact hlhs.frame tapes.pc (fun slot => by + exact tapes.pc_ne (BinaryInstructionTapes.lhsLookupSlot slot)) + have hsourceContent : + (work tapes.data.update.entry.source).HasBinaryContent + (store.flatMap Entry.encode) := by + have hcells : (work tapes.data.update.entry.source).cells = + (baseWork tapes.data.update.entry.source).cells := by + calc + (work tapes.data.update.entry.source).cells = + (updateWork tapes.data.update.entry.source).cells := hsourceCells + _ = (operandsWork tapes.data.update.entry.source).cells := by + rw [show updateWork tapes.data.update.entry.source = + operandsWork tapes.data.update.entry.source by + rw [hupdateWork] + exact Function.update_of_ne + (tapes.data.update.ne (by decide)) _ _] + _ = (lhsWork tapes.data.update.entry.source).cells := + hrhsResult.sourceCells + _ = (baseWork tapes.data.update.entry.source).cells := + hlhs.sourceCells + unfold Tape.HasBinaryContent + rw [hcells] + exact hready.sourceContent + have hcleanup : ∀ slot, + (work (tapes.data.idx (instructionCleanupParentSlot slot))).HasBinaryNat + (instructionCleanupValue + (directInstruction op destination source₀ source₁) store slot) := by + intro slot + fin_cases slot + · exact ⟨houtcome.ready.queryStart, by + cases op <;> + simpa [directInstruction, instructionCleanupValue, + instructionCleanupParentSlot] using houtcome.ready.query⟩ + · change (work tapes.data.update.replacement).HasBinaryNat _ + rw [show work tapes.data.update.replacement = + arithmeticWork tapes.data.update.replacement from + houtcome.replacement] + cases op <;> + simpa [directInstruction, instructionCleanupValue, + BinaryInstrOp.eval] using harithmetic.result + · cases op <;> + simpa [directInstruction, instructionCleanupValue, + instructionCleanupParentSlot] using houtcome.found + · change (work tapes.data.lhs).HasBinaryNat _ + rw [houtcome.frame tapes.data.lhs (fun role => + (tapes.data.update_ne_lhs role).symm)] + cases op <;> + simpa [directInstruction, instructionCleanupValue, + instructionCleanupParentSlot] using harithmetic.lhsValue + · change (work tapes.data.rhs).HasBinaryNat _ + rw [houtcome.frame tapes.data.rhs (fun role => + (tapes.data.update_ne_rhs role).symm)] + cases op <;> + simpa [directInstruction, instructionCleanupValue, + instructionCleanupParentSlot] using harithmetic.rhsValue + have hshift : (work tapes.data.shift).HasBinaryNat 0 := by + rw [houtcome.frame tapes.data.shift (fun slot => + (tapes.data.update_ne_shift slot).symm)] + exact harithmetic.shift + have htmp' : (work tapes.data.tmp).HasBinaryNat 0 := by + rw [houtcome.frame tapes.data.tmp (fun slot => + (tapes.data.update_ne_tmp slot).symm)] + exact harithmetic.tmp + have hdbl' : (work tapes.data.dbl).HasBinaryNat 0 := by + rw [houtcome.frame tapes.data.dbl (fun slot => + (tapes.data.update_ne_dbl slot).symm)] + exact harithmetic.dbl + refine ⟨hpcUpdate.trans (hpcArithmetic.trans + (hpcAddress.trans (hpcRhs.trans hpcLhs))), ?_, hsourceContent, + hcleanup, ?_, ?_, hshift, htmp', hdbl', houtcome.ready.parked⟩ + · cases op <;> + simpa [directInstruction, instructionStore, Snapshot.stepInstr, + BinaryInstrOp.eval] using houtcome.resultCount + · cases op <;> + simpa [directInstruction, instructionRemainingValue] using + houtcome.remaining + · cases op <;> + simpa [directInstruction, instructionCleanupValue] using + houtcome.ready + have hdata := retargetDataKernel_hoareTime_frame_internal tapes + (directInstruction op destination source₀ source₁) store pcValue + initialWork inp₀ + (directBinaryInstructionTM tapes.data op destination source₀ source₁) + (directBinaryInstructionTime tapes.data op store destination source₀ + source₁) Result hready hbase hresult + have hall := finishDataInstructionTM_hoareTime_frame_internal tapes + (directInstruction op destination source₀ source₁) store pcValue + initialWork inp₀ + (directBinaryInstructionTM tapes.data op destination source₀ source₁) + (directBinaryInstructionTime tapes.data op store destination source₀ + source₁) (by cases op <;> rfl) hinput hdata + cases op <;> + simpa [directInstruction, executeInstructionTM, executeInstructionTime] + using hall + +/-- Direct addition has the common one-buffer instruction contract. -/ +theorem executeInstructionTM_add_hoareTime_frame + (tapes : ControlInstructionTapes n) (store : Store) + (pcValue destination source₀ source₁ : ℕ) + (initialWork : Fin (n + 1) → Tape) (inp₀ : Tape) + (hready : InstructionExecutionReady tapes store pcValue initialWork) + (hinput : TM.Parked inp₀) : + (executeInstructionTM tapes (.add destination source₀ source₁)).HoareTime + (fun inp work out => + inp = inp₀ ∧ work = initialWork ∧ + out = (Tape.init []).move Dir3.right) + (fun inp work out => + inp = inp₀ ∧ + InstructionExecutionResult tapes (.add destination source₀ source₁) + pcValue store work ∧ + out = (Tape.init []).move Dir3.right) + (executeInstructionTime tapes (.add destination source₀ source₁) + pcValue store) := by + simpa [directInstruction] using + executeInstructionTM_direct_hoareTime_frame tapes .add store pcValue + destination source₀ source₁ initialWork inp₀ hready hinput + +/-- Direct subtraction has the common one-buffer instruction contract. -/ +theorem executeInstructionTM_sub_hoareTime_frame + (tapes : ControlInstructionTapes n) (store : Store) + (pcValue destination source₀ source₁ : ℕ) + (initialWork : Fin (n + 1) → Tape) (inp₀ : Tape) + (hready : InstructionExecutionReady tapes store pcValue initialWork) + (hinput : TM.Parked inp₀) : + (executeInstructionTM tapes (.sub destination source₀ source₁)).HoareTime + (fun inp work out => + inp = inp₀ ∧ work = initialWork ∧ + out = (Tape.init []).move Dir3.right) + (fun inp work out => + inp = inp₀ ∧ + InstructionExecutionResult tapes (.sub destination source₀ source₁) + pcValue store work ∧ + out = (Tape.init []).move Dir3.right) + (executeInstructionTime tapes (.sub destination source₀ source₁) + pcValue store) := by + simpa [directInstruction] using + executeInstructionTM_direct_hoareTime_frame tapes .sub store pcValue + destination source₀ source₁ initialWork inp₀ hready hinput + +/-- Direct multiplication has the common one-buffer instruction contract. -/ +theorem executeInstructionTM_mul_hoareTime_frame + (tapes : ControlInstructionTapes n) (store : Store) + (pcValue destination source₀ source₁ : ℕ) + (initialWork : Fin (n + 1) → Tape) (inp₀ : Tape) + (hready : InstructionExecutionReady tapes store pcValue initialWork) + (hinput : TM.Parked inp₀) : + (executeInstructionTM tapes (.mul destination source₀ source₁)).HoareTime + (fun inp work out => + inp = inp₀ ∧ work = initialWork ∧ + out = (Tape.init []).move Dir3.right) + (fun inp work out => + inp = inp₀ ∧ + InstructionExecutionResult tapes (.mul destination source₀ source₁) + pcValue store work ∧ + out = (Tape.init []).move Dir3.right) + (executeInstructionTime tapes (.mul destination source₀ source₁) + pcValue store) := by + simpa [directInstruction] using + executeInstructionTM_direct_hoareTime_frame tapes .mul store pcValue + destination source₀ source₁ initialWork inp₀ hready hinput + +/-- Indirect-load execution redirects its next sparse store and increments +the program counter. -/ +theorem executeInstructionTM_load_hoareTime_frame + (tapes : ControlInstructionTapes n) (store : Store) + (pcValue destination addressRegister : ℕ) + (initialWork : Fin (n + 1) → Tape) (inp₀ : Tape) + (hready : InstructionExecutionReady tapes store pcValue initialWork) + (hinput : TM.Parked inp₀) : + (executeInstructionTM tapes (.load destination addressRegister)).HoareTime + (fun inp work out => + inp = inp₀ ∧ work = initialWork ∧ + out = (Tape.init []).move Dir3.right) + (fun inp work out => + inp = inp₀ ∧ + InstructionExecutionResult tapes (.load destination addressRegister) + pcValue store work ∧ + out = (Tape.init []).move Dir3.right) + (executeInstructionTime tapes (.load destination addressRegister) + pcValue store) := by + let baseWork : Fin n → Tape := fun i => initialWork (Fin.castSucc i) + have hlookup : EntryLookupStaticReady tapes.data.lhsLookup store baseWork := + instructionExecutionReady_baseLookup_internal tapes store pcValue + initialWork hready + have hreplacement : + (baseWork tapes.data.update.replacement).HasBinaryNat 0 := + hready.replacement + have hbuffer : (initialWork tapes.buffer).HasBinaryPrefix [] := by + rw [hready.buffer] + exact Tape.init_nil_move_right_hasBinaryPrefix_nil + have hbaseRaw := indirectLoadInstructionTM_hoareTime_frame tapes.data store + destination addressRegister [] baseWork inp₀ (initialWork tapes.buffer) + hready.canonical hlookup hreplacement hinput hbuffer + let instruction : Instr := .load destination addressRegister + let Result : (Fin n → Tape) → Prop := fun work => + IndirectLoadInstructionResult tapes.data store destination addressRegister + baseWork work + have hbase : (indirectLoadInstructionTM tapes.data destination + addressRegister).HoareTime + (fun inp work out => inp = inp₀ ∧ work = baseWork ∧ + out = initialWork tapes.buffer) + (fun inp work out => + inp = inp₀ ∧ Result work ∧ + out.HasBinaryPrefix + ((instructionStore instruction pcValue store).flatMap Entry.encode)) + (indirectLoadInstructionTime tapes.data store destination + addressRegister) := by + simpa [Result, instruction, instructionStore, Snapshot.stepInstr] using + hbaseRaw + have hresult : ∀ work, Result work → + work tapes.pc = initialWork (Fin.castSucc tapes.pc) ∧ + (work tapes.data.update.resultCount).HasBinaryNat + (instructionStore instruction pcValue store).length ∧ + (work tapes.data.update.entry.source).HasBinaryContent + (store.flatMap Entry.encode) ∧ + (∀ slot, + (work (tapes.data.idx (instructionCleanupParentSlot slot))).HasBinaryNat + (instructionCleanupValue instruction store slot)) ∧ + (work tapes.data.update.remaining).HasBinaryNat + (instructionRemainingValue instruction store) ∧ + EntryScanReady tapes.data.update.entry [] + (instructionCleanupValue instruction store 0).bits work work ∧ + (work tapes.data.shift).HasBinaryNat 0 ∧ + (work tapes.data.tmp).HasBinaryNat 0 ∧ + (work tapes.data.dbl).HasBinaryNat 0 ∧ + ∀ i, TM.Parked (work i) := by + intro work hsemantic + obtain ⟨addressWork, loadedWork, updateWork, haddress, hloaded, + hupdateWork, houtcome, hsourceCells⟩ := hsemantic + have hpcOutcome : work tapes.pc = updateWork tapes.pc := by + exact houtcome.frame tapes.pc (fun slot => by + exact tapes.pc_ne ⟨slot, by omega⟩) + have hpcQuery : tapes.pc ≠ tapes.data.update.entry.query := tapes.pc_ne 7 + have hpcUpdate : updateWork tapes.pc = loadedWork tapes.pc := by + rw [hupdateWork, Function.update_of_ne hpcQuery] + have hpcLoaded : loadedWork tapes.pc = addressWork tapes.pc := by + exact hloaded.frame tapes.pc (fun slot => by + exact tapes.pc_ne + (BinaryInstructionTapes.indirectLoadLookupSlot slot)) + have hpcAddress : addressWork tapes.pc = baseWork tapes.pc := by + exact haddress.frame tapes.pc (fun slot => by + exact tapes.pc_ne (BinaryInstructionTapes.lhsLookupSlot slot)) + have hsourceContent : + (work tapes.data.update.entry.source).HasBinaryContent + (store.flatMap Entry.encode) := by + unfold Tape.HasBinaryContent + rw [hsourceCells] + exact hready.sourceContent + have hcleanup : ∀ slot, + (work (tapes.data.idx (instructionCleanupParentSlot slot))).HasBinaryNat + (instructionCleanupValue instruction store slot) := by + intro slot + fin_cases slot + · exact ⟨houtcome.ready.queryStart, by + simpa [instruction, instructionCleanupValue, + instructionCleanupParentSlot] using houtcome.ready.query⟩ + · change (work tapes.data.update.replacement).HasBinaryNat _ + rw [show work tapes.data.update.replacement = + updateWork tapes.data.update.replacement from houtcome.replacement, + show updateWork tapes.data.update.replacement = + loadedWork tapes.data.update.replacement by + rw [hupdateWork] + exact Function.update_of_ne + (tapes.data.update.ne (by decide)) _ _] + exact hloaded.value + · simpa [instruction, instructionCleanupValue, + instructionCleanupParentSlot] using houtcome.found + · change (work tapes.data.lhs).HasBinaryNat _ + rw [show work tapes.data.lhs = updateWork tapes.data.lhs from + houtcome.frame tapes.data.lhs (fun role => + (tapes.data.update_ne_lhs role).symm), + show updateWork tapes.data.lhs = loadedWork tapes.data.lhs by + rw [hupdateWork] + exact Function.update_of_ne + (tapes.data.update_ne_lhs 7).symm _ _] + rw [show loadedWork tapes.data.lhs = addressWork tapes.data.lhs from + hloaded.querySource] + simpa [instruction, instructionCleanupValue] using haddress.destination + · change (work tapes.data.rhs).HasBinaryNat _ + rw [show work tapes.data.rhs = updateWork tapes.data.rhs from + houtcome.frame tapes.data.rhs (fun role => + (tapes.data.update_ne_rhs role).symm), + show updateWork tapes.data.rhs = loadedWork tapes.data.rhs by + rw [hupdateWork] + exact Function.update_of_ne + (tapes.data.update_ne_rhs 7).symm _ _, + hloaded.frame tapes.data.rhs (fun role => by + apply tapes.data.ne + fin_cases role <;> decide), + haddress.frame tapes.data.rhs (fun role => + (tapes.data.lhsLookup_ne_rhs role).symm)] + exact hready.rhs + have hshift : (work tapes.data.shift).HasBinaryNat 0 := by + have hqueryNe : tapes.data.shift ≠ + tapes.data.update.entry.query := + (tapes.data.update_ne_shift 7).symm + rw [houtcome.frame tapes.data.shift (fun slot => + (tapes.data.update_ne_shift slot).symm), + hupdateWork, Function.update_of_ne hqueryNe, + hloaded.frame tapes.data.shift (fun slot => by + apply tapes.data.ne + fin_cases slot <;> decide)] + simpa using haddress.querySource + have htmp' : (work tapes.data.tmp).HasBinaryNat 0 := by + have hqueryNe : tapes.data.tmp ≠ + tapes.data.update.entry.query := + (tapes.data.update_ne_tmp 7).symm + rw [houtcome.frame tapes.data.tmp (fun slot => + (tapes.data.update_ne_tmp slot).symm), + hupdateWork, Function.update_of_ne hqueryNe, + hloaded.frame tapes.data.tmp (fun slot => by + apply tapes.data.ne + fin_cases slot <;> decide), + haddress.frame tapes.data.tmp (fun slot => + (tapes.data.lhsLookup_ne_tmp slot).symm)] + exact hready.tmp + have hdbl' : (work tapes.data.dbl).HasBinaryNat 0 := by + have hqueryNe : tapes.data.dbl ≠ + tapes.data.update.entry.query := + (tapes.data.update_ne_dbl 7).symm + rw [houtcome.frame tapes.data.dbl (fun slot => + (tapes.data.update_ne_dbl slot).symm), + hupdateWork, Function.update_of_ne hqueryNe, + hloaded.frame tapes.data.dbl (fun slot => by + apply tapes.data.ne + fin_cases slot <;> decide), + haddress.frame tapes.data.dbl (fun slot => + (tapes.data.lhsLookup_ne_dbl slot).symm)] + exact hready.dbl + refine ⟨hpcOutcome.trans (hpcUpdate.trans + (hpcLoaded.trans hpcAddress)), ?_, hsourceContent, hcleanup, + ?_, ?_, hshift, htmp', hdbl', houtcome.ready.parked⟩ + · simpa [instruction, instructionStore, Snapshot.stepInstr] using + houtcome.resultCount + · simpa [instruction, instructionRemainingValue] using + houtcome.remaining + · simpa [instruction, instructionCleanupValue] using houtcome.ready + have hdata := retargetDataKernel_hoareTime_frame_internal tapes instruction + store pcValue initialWork inp₀ + (indirectLoadInstructionTM tapes.data destination addressRegister) + (indirectLoadInstructionTime tapes.data store destination addressRegister) + Result hready hbase hresult + simpa only [instruction, executeInstructionTM, executeInstructionTime] using + finishDataInstructionTM_hoareTime_frame_internal tapes instruction store + pcValue initialWork inp₀ + (indirectLoadInstructionTM tapes.data destination addressRegister) + (indirectLoadInstructionTime tapes.data store destination addressRegister) + rfl hinput hdata + +/-- Indirect-store execution redirects its next sparse store and increments +the program counter. -/ +theorem executeInstructionTM_store_hoareTime_frame + (tapes : ControlInstructionTapes n) (store : Store) + (pcValue addressRegister source : ℕ) + (initialWork : Fin (n + 1) → Tape) (inp₀ : Tape) + (hready : InstructionExecutionReady tapes store pcValue initialWork) + (hinput : TM.Parked inp₀) : + (executeInstructionTM tapes (.store addressRegister source)).HoareTime + (fun inp work out => + inp = inp₀ ∧ work = initialWork ∧ + out = (Tape.init []).move Dir3.right) + (fun inp work out => + inp = inp₀ ∧ + InstructionExecutionResult tapes (.store addressRegister source) + pcValue store work ∧ + out = (Tape.init []).move Dir3.right) + (executeInstructionTime tapes (.store addressRegister source) + pcValue store) := by + let baseWork : Fin n → Tape := fun i => initialWork (Fin.castSucc i) + have hlookup : EntryLookupStaticReady tapes.data.lhsLookup store baseWork := + instructionExecutionReady_baseLookup_internal tapes store pcValue + initialWork hready + have hrhs : (baseWork tapes.data.rhs).HasBinaryNat 0 := hready.rhs + have hreplacement : + (baseWork tapes.data.update.replacement).HasBinaryNat 0 := + hready.replacement + have hbuffer : (initialWork tapes.buffer).HasBinaryPrefix [] := by + rw [hready.buffer] + exact Tape.init_nil_move_right_hasBinaryPrefix_nil + have hbaseRaw := indirectStoreInstructionTM_hoareTime_frame tapes.data store + addressRegister source [] baseWork inp₀ (initialWork tapes.buffer) + hready.canonical hlookup hrhs hreplacement hinput hbuffer + let instruction : Instr := .store addressRegister source + let Result : (Fin n → Tape) → Prop := fun work => + IndirectStoreInstructionResult tapes.data store addressRegister source + baseWork work + have hbase : (indirectStoreInstructionTM tapes.data addressRegister + source).HoareTime + (fun inp work out => inp = inp₀ ∧ work = baseWork ∧ + out = initialWork tapes.buffer) + (fun inp work out => + inp = inp₀ ∧ Result work ∧ + out.HasBinaryPrefix + ((instructionStore instruction pcValue store).flatMap Entry.encode)) + (indirectStoreInstructionTime tapes.data store addressRegister source) := by + simpa [Result, instruction, instructionStore, Snapshot.stepInstr] using + hbaseRaw + have hresult : ∀ work, Result work → + work tapes.pc = initialWork (Fin.castSucc tapes.pc) ∧ + (work tapes.data.update.resultCount).HasBinaryNat + (instructionStore instruction pcValue store).length ∧ + (work tapes.data.update.entry.source).HasBinaryContent + (store.flatMap Entry.encode) ∧ + (∀ slot, + (work (tapes.data.idx (instructionCleanupParentSlot slot))).HasBinaryNat + (instructionCleanupValue instruction store slot)) ∧ + (work tapes.data.update.remaining).HasBinaryNat + (instructionRemainingValue instruction store) ∧ + EntryScanReady tapes.data.update.entry [] + (instructionCleanupValue instruction store 0).bits work work ∧ + (work tapes.data.shift).HasBinaryNat 0 ∧ + (work tapes.data.tmp).HasBinaryNat 0 ∧ + (work tapes.data.dbl).HasBinaryNat 0 ∧ + ∀ i, TM.Parked (work i) := by + intro work hsemantic + obtain ⟨operandsWork, queryWork, updateWork, hoperands, hqueryWork, + hupdateWork, houtcome, hsourceCells⟩ := hsemantic + obtain ⟨lhsWork, hlhs, hrhsResult⟩ := hoperands + have hpcOutcome : work tapes.pc = updateWork tapes.pc := by + exact houtcome.frame tapes.pc (fun slot => by + exact tapes.pc_ne ⟨slot, by omega⟩) + have hpcReplacement : + tapes.pc ≠ tapes.data.update.replacement := tapes.pc_ne 10 + have hpcUpdate : updateWork tapes.pc = queryWork tapes.pc := by + rw [hupdateWork, Function.update_of_ne hpcReplacement] + have hpcQuery : tapes.pc ≠ tapes.data.update.entry.query := tapes.pc_ne 7 + have hpcQueryWork : queryWork tapes.pc = operandsWork tapes.pc := by + rw [hqueryWork, Function.update_of_ne hpcQuery] + have hpcRhs : operandsWork tapes.pc = lhsWork tapes.pc := by + exact hrhsResult.frame tapes.pc (fun slot => by + exact tapes.pc_ne (BinaryInstructionTapes.rhsLookupSlot slot)) + have hpcLhs : lhsWork tapes.pc = baseWork tapes.pc := by + exact hlhs.frame tapes.pc (fun slot => by + exact tapes.pc_ne (BinaryInstructionTapes.lhsLookupSlot slot)) + have hsourceContent : + (work tapes.data.update.entry.source).HasBinaryContent + (store.flatMap Entry.encode) := by + unfold Tape.HasBinaryContent + rw [hsourceCells] + exact hready.sourceContent + have hcleanup : ∀ slot, + (work (tapes.data.idx (instructionCleanupParentSlot slot))).HasBinaryNat + (instructionCleanupValue instruction store slot) := by + intro slot + fin_cases slot + · exact ⟨houtcome.ready.queryStart, by + simpa [instruction, instructionCleanupValue, + instructionCleanupParentSlot] using houtcome.ready.query⟩ + · change (work tapes.data.update.replacement).HasBinaryNat _ + rw [show work tapes.data.update.replacement = + updateWork tapes.data.update.replacement from houtcome.replacement, + hupdateWork, Function.update_self] + exact Tape.init_move_right_hasBinaryNat + (RegisterStore.read store source) + · simpa [instruction, instructionCleanupValue, + instructionCleanupParentSlot] using houtcome.found + · change (work tapes.data.lhs).HasBinaryNat _ + rw [show work tapes.data.lhs = updateWork tapes.data.lhs from + houtcome.frame tapes.data.lhs (fun role => + (tapes.data.update_ne_lhs role).symm), + show updateWork tapes.data.lhs = queryWork tapes.data.lhs by + rw [hupdateWork] + exact Function.update_of_ne + (tapes.data.update_ne_lhs 10).symm _ _, + show queryWork tapes.data.lhs = operandsWork tapes.data.lhs by + rw [hqueryWork] + exact Function.update_of_ne + (tapes.data.update_ne_lhs 7).symm _ _, + hrhsResult.frame tapes.data.lhs (fun role => + (tapes.data.rhsLookup_ne_lhs role).symm)] + exact hlhs.destination + · change (work tapes.data.rhs).HasBinaryNat _ + rw [show work tapes.data.rhs = updateWork tapes.data.rhs from + houtcome.frame tapes.data.rhs (fun role => + (tapes.data.update_ne_rhs role).symm), + show updateWork tapes.data.rhs = queryWork tapes.data.rhs by + rw [hupdateWork] + exact Function.update_of_ne + (tapes.data.update_ne_rhs 10).symm _ _, + show queryWork tapes.data.rhs = operandsWork tapes.data.rhs by + rw [hqueryWork] + exact Function.update_of_ne + (tapes.data.update_ne_rhs 7).symm _ _] + exact hrhsResult.destination + have hshift : (work tapes.data.shift).HasBinaryNat 0 := by + have hreplacementNe : tapes.data.shift ≠ + tapes.data.update.replacement := + (tapes.data.update_ne_shift 10).symm + have hqueryNe : tapes.data.shift ≠ + tapes.data.update.entry.query := + (tapes.data.update_ne_shift 7).symm + rw [houtcome.frame tapes.data.shift (fun slot => + (tapes.data.update_ne_shift slot).symm), + hupdateWork, Function.update_of_ne hreplacementNe, + hqueryWork, Function.update_of_ne hqueryNe] + simpa using hrhsResult.querySource + have htmp' : (work tapes.data.tmp).HasBinaryNat 0 := by + have hreplacementNe : tapes.data.tmp ≠ + tapes.data.update.replacement := + (tapes.data.update_ne_tmp 10).symm + have hqueryNe : tapes.data.tmp ≠ + tapes.data.update.entry.query := + (tapes.data.update_ne_tmp 7).symm + rw [houtcome.frame tapes.data.tmp (fun slot => + (tapes.data.update_ne_tmp slot).symm), + hupdateWork, Function.update_of_ne hreplacementNe, + hqueryWork, Function.update_of_ne hqueryNe, + hrhsResult.frame tapes.data.tmp (fun slot => + (tapes.data.rhsLookup_ne_tmp slot).symm), + hlhs.frame tapes.data.tmp (fun slot => + (tapes.data.lhsLookup_ne_tmp slot).symm)] + exact hready.tmp + have hdbl' : (work tapes.data.dbl).HasBinaryNat 0 := by + have hreplacementNe : tapes.data.dbl ≠ + tapes.data.update.replacement := + (tapes.data.update_ne_dbl 10).symm + have hqueryNe : tapes.data.dbl ≠ + tapes.data.update.entry.query := + (tapes.data.update_ne_dbl 7).symm + rw [houtcome.frame tapes.data.dbl (fun slot => + (tapes.data.update_ne_dbl slot).symm), + hupdateWork, Function.update_of_ne hreplacementNe, + hqueryWork, Function.update_of_ne hqueryNe, + hrhsResult.frame tapes.data.dbl (fun slot => + (tapes.data.rhsLookup_ne_dbl slot).symm), + hlhs.frame tapes.data.dbl (fun slot => + (tapes.data.lhsLookup_ne_dbl slot).symm)] + exact hready.dbl + refine ⟨hpcOutcome.trans (hpcUpdate.trans + (hpcQueryWork.trans (hpcRhs.trans hpcLhs))), ?_, hsourceContent, + hcleanup, ?_, ?_, hshift, htmp', hdbl', houtcome.ready.parked⟩ + · simpa [instruction, instructionStore, Snapshot.stepInstr] using + houtcome.resultCount + · simpa [instruction, instructionRemainingValue] using + houtcome.remaining + · simpa [instruction, instructionCleanupValue] using houtcome.ready + have hdata := retargetDataKernel_hoareTime_frame_internal tapes instruction + store pcValue initialWork inp₀ + (indirectStoreInstructionTM tapes.data addressRegister source) + (indirectStoreInstructionTime tapes.data store addressRegister source) + Result hready hbase hresult + simpa only [instruction, executeInstructionTM, executeInstructionTime] using + finishDataInstructionTM_hoareTime_frame_internal tapes instruction store + pcValue initialWork inp₀ + (indirectStoreInstructionTM tapes.data addressRegister source) + (indirectStoreInstructionTime tapes.data store addressRegister source) + rfl hinput hdata + +end Machine + +end RegisterStore + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Sim/Defs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Sim/Defs.lean new file mode 100644 index 0000000000..4dea455678 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Sim/Defs.lean @@ -0,0 +1,616 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Lift + +/-! +# Fixed-program sparse RAM instruction dispatch -- definitions + +One fresh last work tape is the next-store buffer. Data instructions redirect +their encoded output there; control instructions copy the unchanged read-only +store there. A binary copy of the program counter is then decremented through a +fixed finite branch tree, so the resulting TM depends only on the RAM program. +-/ + + +@[expose] public section + +namespace Complexity + +namespace RAM + +namespace RegisterStore + +namespace Machine + +namespace ControlInstructionTapes + +/-- Embed every control/data role into the initial `n` tapes of the one-buffer +layout. -/ +def lifted {n : ℕ} (tapes : ControlInstructionTapes n) : + ControlInstructionTapes (n + 1) where + data := + { idx := fun slot => Fin.castSucc (tapes.data.idx slot) + injective := by + intro i j h + apply tapes.data.injective + exact Fin.castSucc_injective _ h } + pc := Fin.castSucc tapes.pc + pc_ne := by + intro slot h + exact tapes.pc_ne slot (Fin.castSucc_injective _ h) + +/-- Program counter in the one-buffer execution layout. -/ +def liftedPC {n : ℕ} (tapes : ControlInstructionTapes n) : Fin (n + 1) := + tapes.lifted.pc + +/-- First temporary operand in the one-buffer execution layout. -/ +def liftedLhs {n : ℕ} (tapes : ControlInstructionTapes n) : Fin (n + 1) := + tapes.lifted.data.lhs + +/-- Zero scratch used while copying the dispatch selector. -/ +def liftedFound {n : ℕ} (tapes : ControlInstructionTapes n) : Fin (n + 1) := + tapes.lifted.data.update.found + +/-- Read-only encoded-store source in the one-buffer execution layout. -/ +def liftedSource {n : ℕ} (tapes : ControlInstructionTapes n) : Fin (n + 1) := + tapes.lifted.data.update.entry.source + +/-- Fresh last work tape receiving the next encoded store. -/ +def buffer {n : ℕ} (_tapes : ControlInstructionTapes n) : Fin (n + 1) := + Fin.last n + +theorem liftedSource_ne_buffer {n : ℕ} + (tapes : ControlInstructionTapes n) : + tapes.liftedSource ≠ tapes.buffer := by + intro h + have hval : tapes.data.update.entry.source.val = n := by + simpa [liftedSource, buffer, lifted] using congrArg Fin.val h + have hlt := tapes.data.update.entry.source.isLt + omega + +theorem liftedPC_ne_buffer {n : ℕ} + (tapes : ControlInstructionTapes n) : + tapes.liftedPC ≠ tapes.buffer := by + intro h + have hval : tapes.pc.val = n := by + simpa [liftedPC, buffer, lifted] using congrArg Fin.val h + exact Nat.ne_of_lt tapes.pc.isLt hval + +/-- The lifted program counter is disjoint from the encoded-store source. -/ +theorem liftedPC_ne_source {n : ℕ} + (tapes : ControlInstructionTapes n) : + tapes.liftedPC ≠ tapes.liftedSource := by + exact tapes.lifted.pc_ne 0 + +theorem liftedData_ne_buffer {n : ℕ} + (tapes : ControlInstructionTapes n) (slot : Fin 18) : + tapes.lifted.data.idx slot ≠ tapes.buffer := by + intro h + have hval : (tapes.data.idx slot).val = n := by + simpa [buffer, lifted] using congrArg Fin.val h + exact Nat.ne_of_lt (tapes.data.idx slot).isLt hval + +end ControlInstructionTapes + +/-- Emit the unchanged store from the read-only source into the fresh buffer +after executing a control-only instruction. -/ +def finishControlInstructionTM {n : ℕ} + (tapes : ControlInstructionTapes n) (control : TM (n + 1)) : TM (n + 1) := + TM.seqTM control + (TM.copyWorkToWorkTM tapes.liftedSource tapes.buffer) + +/-- Execute one statically selected RAM instruction. Every case writes the +next encoded store to the fresh last work tape and leaves real output blank. -/ +def executeInstructionTM {n : ℕ} (tapes : ControlInstructionTapes n) : + Instr → TM (n + 1) + | .imm destination value => + TM.seqTM + (immediateInstructionTM tapes.data destination value).retargetOutput + (TM.binarySuccTM tapes.liftedPC) + | .add destination source₀ source₁ => + TM.seqTM + (directBinaryInstructionTM tapes.data .add destination source₀ + source₁).retargetOutput + (TM.binarySuccTM tapes.liftedPC) + | .sub destination source₀ source₁ => + TM.seqTM + (directBinaryInstructionTM tapes.data .sub destination source₀ + source₁).retargetOutput + (TM.binarySuccTM tapes.liftedPC) + | .mul destination source₀ source₁ => + TM.seqTM + (directBinaryInstructionTM tapes.data .mul destination source₀ + source₁).retargetOutput + (TM.binarySuccTM tapes.liftedPC) + | .load destination addressRegister => + TM.seqTM + (indirectLoadInstructionTM tapes.data destination + addressRegister).retargetOutput + (TM.binarySuccTM tapes.liftedPC) + | .store addressRegister source => + TM.seqTM + (indirectStoreInstructionTM tapes.data addressRegister + source).retargetOutput + (TM.binarySuccTM tapes.liftedPC) + | .jz source target => + finishControlInstructionTM tapes + (zeroJumpInstructionTM tapes.lifted source target) + | .jmp target => + finishControlInstructionTM tapes (jumpInstructionTM tapes.lifted target) + | .halt => + finishControlInstructionTM tapes (haltInstructionTM (n := n + 1)) + +/-- Representation-independent finite branch tree for any family of static +instruction executors sharing the standard decrementing selector tape. -/ +def dispatchWithTM {n : ℕ} (tapes : ControlInstructionTapes n) + (execute : Instr → TM (n + 1)) : Program → TM (n + 1) + | [] => TM.seqTM (TM.resetBinaryWorkTM tapes.liftedLhs) (execute .halt) + | instruction :: program => + TM.branchWorkBlankTM tapes.liftedLhs + (execute instruction) + (TM.seqTM (TM.binaryPredTM tapes.liftedLhs) + (dispatchWithTM tapes execute program)) + +/-- Finite branch tree selected by a decrementing canonical PC copy. -/ +def dispatchProgramTM {n : ℕ} (tapes : ControlInstructionTapes n) : + Program → TM (n + 1) + | [] => TM.seqTM (TM.resetBinaryWorkTM tapes.liftedLhs) + (executeInstructionTM tapes .halt) + | instruction :: program => + TM.branchWorkBlankTM tapes.liftedLhs + (executeInstructionTM tapes instruction) + (TM.seqTM (TM.binaryPredTM tapes.liftedLhs) + (dispatchProgramTM tapes program)) + +/-- Pure instruction selected by the same finite branch-tree recursion. -/ +def selectedInstruction : Program → ℕ → Instr + | [], _ => .halt + | instruction :: _, 0 => instruction + | _ :: program, selector + 1 => selectedInstruction program selector + +/-- Copy the preserved PC into zero scratch and enter the fixed branch tree. -/ +def programInstructionTM {n : ℕ} (tapes : ControlInstructionTapes n) + (program : Program) : TM (n + 1) := + TM.seqTM + (TM.binaryCopyIntoTM tapes.liftedPC tapes.liftedLhs tapes.liftedFound) + (dispatchProgramTM tapes program) + +/-- Pure next store selected by one RAM instruction. -/ +def instructionStore (instruction : Instr) (pcValue : ℕ) + (store : Store) : Store := + (Snapshot.stepInstr instruction { pc := pcValue, store := store }).store + +/-- Pure next program counter selected by one RAM instruction. -/ +def instructionPC (instruction : Instr) (pcValue : ℕ) + (store : Store) : ℕ := + (Snapshot.stepInstr instruction { pc := pcValue, store := store }).pc + +/-- Parent data slots cleared between simulated RAM instructions. -/ +def instructionCleanupParentSlot : Fin 5 → Fin 18 + | 0 => 7 + | 1 => 10 + | 2 => 11 + | 3 => 13 + | _ => 14 + +/-- Five canonical data roles that must be cleared between simulated RAM +instructions: update query, replacement, found flag, and the two operands. -/ +def instructionCleanupTape {n : ℕ} (tapes : ControlInstructionTapes n) + (slot : Fin 5) : Fin (n + 1) := + tapes.lifted.data.idx (instructionCleanupParentSlot slot) + +theorem instructionCleanupTape_ne_source {n : ℕ} + (tapes : ControlInstructionTapes n) (slot : Fin 5) : + instructionCleanupTape tapes slot ≠ tapes.liftedSource := by + exact tapes.lifted.data.ne (by fin_cases slot <;> decide) + +theorem instructionCleanupTape_ne_buffer {n : ℕ} + (tapes : ControlInstructionTapes n) (slot : Fin 5) : + instructionCleanupTape tapes slot ≠ tapes.buffer := + tapes.liftedData_ne_buffer (instructionCleanupParentSlot slot) + +/-- Exact values left on the five cleanup roles by one instruction kernel. -/ +def instructionCleanupValue (instruction : Instr) (store : Store) : + Fin 5 → ℕ + | 0 => + match instruction with + | .imm destination _ => destination + | .add destination _ _ => destination + | .sub destination _ _ => destination + | .mul destination _ _ => destination + | .load destination _ => destination + | .store addressRegister _ => RegisterStore.read store addressRegister + | .jz _ _ | .jmp _ | .halt => 0 + | 1 => + match instruction with + | .imm _ value => value + | .add _ source₀ source₁ => + RegisterStore.read store source₀ + RegisterStore.read store source₁ + | .sub _ source₀ source₁ => + RegisterStore.read store source₀ - RegisterStore.read store source₁ + | .mul _ source₀ source₁ => + RegisterStore.read store source₀ * RegisterStore.read store source₁ + | .load _ addressRegister => + RegisterStore.read store (RegisterStore.read store addressRegister) + | .store _ source => RegisterStore.read store source + | .jz _ _ | .jmp _ | .halt => 0 + | 2 => + match instruction with + | .imm destination _ | .add destination _ _ | + .sub destination _ _ | .mul destination _ _ | + .load destination _ => + if destination ∈ store.map Prod.fst then 1 else 0 + | .store addressRegister _ => + if RegisterStore.read store addressRegister ∈ store.map Prod.fst then + 1 + else 0 + | .jz _ _ | .jmp _ | .halt => 0 + | 3 => + match instruction with + | .add _ source₀ _ | .sub _ source₀ _ | .mul _ source₀ _ => + RegisterStore.read store source₀ + | .load _ addressRegister | .store addressRegister _ => + RegisterStore.read store addressRegister + | .imm _ _ | .jz _ _ | .jmp _ | .halt => 0 + | _ => + match instruction with + | .add _ _ source₁ | .sub _ _ source₁ | .mul _ _ source₁ => + RegisterStore.read store source₁ + | .store _ source => RegisterStore.read store source + | .imm _ _ | .load _ _ | .jz _ _ | .jmp _ | .halt => 0 + +/-- The old-entry counter is exhausted by data updates and untouched by +control instructions. Cleanup resets either canonical value uniformly. -/ +def instructionRemainingValue (instruction : Instr) (store : Store) : ℕ := + match instruction with + | .imm _ _ | .add _ _ _ | .sub _ _ _ | .mul _ _ _ | + .load _ _ | .store _ _ => 0 + | .jz _ _ | .jmp _ | .halt => store.length + +/-- Clean one-buffer entry boundary shared by every selected instruction. -/ +structure InstructionExecutionReady {n : ℕ} + (tapes : ControlInstructionTapes n) (store : Store) (pcValue : ℕ) + (work : Fin (n + 1) → Tape) : Prop where + /-- The sparse representation contains one nonzero entry per address. -/ + canonical : Canonical store + /-- The lifted control/lookup ABI is ready. -/ + control : ControlInstructionReady tapes.lifted store pcValue work + /-- The read-only source has the complete canonical sparse-store image. -/ + sourceContent : (work tapes.liftedSource).HasBinaryContent + (store.flatMap Entry.encode) + /-- The second direct operand starts at zero. -/ + rhs : (work tapes.lifted.data.rhs).HasBinaryNat 0 + /-- Sparse-update replacement starts at zero. -/ + replacement : + (work tapes.lifted.data.update.replacement).HasBinaryNat 0 + /-- First multiplication alternating scratch starts at zero. -/ + tmp : (work tapes.lifted.data.tmp).HasBinaryNat 0 + /-- Second multiplication alternating scratch starts at zero. -/ + dbl : (work tapes.lifted.data.dbl).HasBinaryNat 0 + /-- The next-store buffer is fresh. -/ + buffer : work tapes.buffer = (Tape.init []).move Dir3.right + +/-- Dispatch boundary obtained by replacing the clean zero `lhs` tape by a +canonical decrementing selector. -/ +def DispatchReady {n : ℕ} (tapes : ControlInstructionTapes n) + (store : Store) (pcValue selector : ℕ) + (cleanWork work : Fin (n + 1) → Tape) : Prop := + InstructionExecutionReady tapes store pcValue cleanWork ∧ + work = Function.update cleanWork tapes.liftedLhs + ((Tape.init (selector.bits.map Γ.ofBool)).move Dir3.right) + +/-- Common semantic endpoint of every selected instruction before cleanup. -/ +structure InstructionExecutionResult {n : ℕ} + (tapes : ControlInstructionTapes n) (instruction : Instr) + (pcValue : ℕ) (store : Store) (work : Fin (n + 1) → Tape) : Prop where + /-- The fresh buffer contains exactly the pure next sparse store. -/ + buffer : (work tapes.buffer).HasBinaryPrefix + ((instructionStore instruction pcValue store).flatMap Entry.encode) + /-- The canonical PC equals the pure instruction successor. -/ + pc : (work tapes.liftedPC).HasBinaryNat + (instructionPC instruction pcValue store) + /-- The preserved output-entry count equals the next store cardinality. -/ + resultCount : + (work tapes.lifted.data.update.resultCount).HasBinaryNat + (instructionStore instruction pcValue store).length + /-- The old encoded source remains available for bounded clearing. -/ + sourceContent : (work tapes.liftedSource).HasBinaryContent + (store.flatMap Entry.encode) + /-- Every instruction leaves the cleanup roles as canonical binary naturals. -/ + cleanup : ∀ slot, (work (instructionCleanupTape tapes slot)).HasBinaryNat + (instructionCleanupValue instruction store slot) + /-- The runtime old-entry counter has a canonical value before reset. -/ + remaining : (work tapes.lifted.data.update.remaining).HasBinaryNat + (instructionRemainingValue instruction store) + /-- Decode/match scratch is clean; only the update query remains loaded. -/ + scanner : EntryScanReady tapes.lifted.data.update.entry [] + (instructionCleanupValue instruction store 0).bits work work + /-- Lookup query-source scratch is restored. -/ + shift : (work tapes.lifted.data.shift).HasBinaryNat 0 + /-- First multiplication scratch is restored. -/ + tmp : (work tapes.lifted.data.tmp).HasBinaryNat 0 + /-- Second multiplication scratch is restored. -/ + dbl : (work tapes.lifted.data.dbl).HasBinaryNat 0 + /-- Every work head is parked at the instruction/cleanup boundary. -/ + parked : ∀ i, TM.Parked (work i) + +/-- Instruction-independent buffered endpoint. This is the semantic interface +needed by physical cleanup; sparse and dense register representations provide +their own next-store, next-PC, and scratch-value witnesses. -/ +structure BufferedInstructionResult {n : ℕ} + (tapes : ControlInstructionTapes n) (oldStore nextStore : Store) + (nextPC : ℕ) (cleanupValues : Fin 5 → ℕ) (remainingValue : ℕ) + (work : Fin (n + 1) → Tape) : Prop where + buffer : (work tapes.buffer).HasBinaryPrefix + (nextStore.flatMap Entry.encode) + pc : (work tapes.liftedPC).HasBinaryNat nextPC + resultCount : + (work tapes.lifted.data.update.resultCount).HasBinaryNat nextStore.length + sourceContent : (work tapes.liftedSource).HasBinaryContent + (oldStore.flatMap Entry.encode) + cleanup : ∀ slot, + (work (instructionCleanupTape tapes slot)).HasBinaryNat + (cleanupValues slot) + remaining : (work tapes.lifted.data.update.remaining).HasBinaryNat + remainingValue + scanner : EntryScanReady tapes.lifted.data.update.entry [] + (cleanupValues 0).bits work work + shift : (work tapes.lifted.data.shift).HasBinaryNat 0 + tmp : (work tapes.lifted.data.tmp).HasBinaryNat 0 + dbl : (work tapes.lifted.data.dbl).HasBinaryNat 0 + parked : ∀ i, TM.Parked (work i) + +/-- Parent roles reset before the buffered successor store is installed. The +first five are instruction-specific data, followed by the old remaining count +and the old encoded source. -/ +def instructionCleanupResetParentSlot : Fin 7 → Fin 18 + | 0 => 7 + | 1 => 10 + | 2 => 11 + | 3 => 13 + | 4 => 14 + | 5 => 9 + | _ => 0 + +/-- Physical reset target in the one-buffer instruction layout. -/ +def instructionCleanupResetTape {n : ℕ} + (tapes : ControlInstructionTapes n) (slot : Fin 7) : Fin (n + 1) := + tapes.lifted.data.idx (instructionCleanupResetParentSlot slot) + +theorem instructionCleanupResetTape_injective {n : ℕ} + (tapes : ControlInstructionTapes n) : + Function.Injective (instructionCleanupResetTape tapes) := by + intro i j h + apply Fin.ext + have hparent := tapes.lifted.data.injective h + fin_cases i <;> fin_cases j <;> + simp [instructionCleanupResetParentSlot] at hparent ⊢ + +/-- Fixed distinct list consumed by the bulk binary reset. -/ +def instructionCleanupResetTargets {n : ℕ} + (tapes : ControlInstructionTapes n) : List (Fin (n + 1)) := + List.ofFn (instructionCleanupResetTape tapes) + +/-- Binary contents advertised at each reset target. -/ +def instructionCleanupResetBits (instruction : Instr) (store : Store) : + Fin 7 → List Bool + | 0 => (instructionCleanupValue instruction store 0).bits + | 1 => (instructionCleanupValue instruction store 1).bits + | 2 => (instructionCleanupValue instruction store 2).bits + | 3 => (instructionCleanupValue instruction store 3).bits + | 4 => (instructionCleanupValue instruction store 4).bits + | 5 => (instructionRemainingValue instruction store).bits + | _ => store.flatMap Entry.encode + +/-- Head bounds at the seven bulk-reset targets. Canonical natural tapes are +at cell one; only the scanned old source needs an external bound. -/ +def instructionCleanupResetHeadBound (sourceHeadBound : ℕ) : Fin 7 → ℕ + | 0 | 1 | 2 | 3 | 4 | 5 => 1 + | _ => sourceHeadBound + +/-- Extend the indexed reset contents to the whole physical work family. -/ +noncomputable def instructionCleanupResetBitsAt {n : ℕ} + (tapes : ControlInstructionTapes n) (instruction : Instr) + (store : Store) : Fin (n + 1) → List Bool := + Function.extend (instructionCleanupResetTape tapes) + (instructionCleanupResetBits instruction store) (fun _ => []) + +/-- Extend the indexed reset head bounds to the whole work family. -/ +noncomputable def instructionCleanupResetHeadBoundAt {n : ℕ} + (tapes : ControlInstructionTapes n) (sourceHeadBound : ℕ) : + Fin (n + 1) → ℕ := + Function.extend (instructionCleanupResetTape tapes) + (instructionCleanupResetHeadBound sourceHeadBound) (fun _ => 0) + +/-- Binary contents reset by representation-independent buffered cleanup. -/ +def bufferedCleanupResetBits (cleanupValues : Fin 5 → ℕ) + (remainingValue : ℕ) (oldStore : Store) : Fin 7 → List Bool + | 0 => (cleanupValues 0).bits + | 1 => (cleanupValues 1).bits + | 2 => (cleanupValues 2).bits + | 3 => (cleanupValues 3).bits + | 4 => (cleanupValues 4).bits + | 5 => remainingValue.bits + | _ => oldStore.flatMap Entry.encode + +/-- Extend generic buffered-cleanup contents to all physical work tapes. -/ +noncomputable def bufferedCleanupResetBitsAt {n : ℕ} + (tapes : ControlInstructionTapes n) (cleanupValues : Fin 5 → ℕ) + (remainingValue : ℕ) (oldStore : Store) : Fin (n + 1) → List Bool := + Function.extend (instructionCleanupResetTape tapes) + (bufferedCleanupResetBits cleanupValues remainingValue oldStore) + (fun _ => []) + +/-- Canonical tape with `bits` and its head immediately after the payload. -/ +def instructionCleanupPrefixTape (bits : List Bool) : Tape where + head := bits.length + 1 + cells := (Tape.init (bits.map Γ.ofBool)).cells + +/-- Buffered post-state plus the two left markers and old-source cursor bound +needed by the executable cleanup pass. -/ +structure InstructionCleanupReady {n : ℕ} + (tapes : ControlInstructionTapes n) (instruction : Instr) + (pcValue : ℕ) (store : Store) (sourceHeadBound : ℕ) + (work : Fin (n + 1) → Tape) : Prop where + canonical : Canonical store + result : InstructionExecutionResult tapes instruction pcValue store work + sourceStart : (work tapes.liftedSource).cells 0 = Γ.start + bufferStart : (work tapes.buffer).cells 0 = Γ.start + sourceHead : (work tapes.liftedSource).head ≤ sourceHeadBound + +/-- Representation-independent input boundary for the physical cleanup pass. -/ +structure BufferedCleanupReady {n : ℕ} + (tapes : ControlInstructionTapes n) (oldStore nextStore : Store) + (nextPC : ℕ) (cleanupValues : Fin 5 → ℕ) (remainingValue : ℕ) + (sourceHeadBound : ℕ) (work : Fin (n + 1) → Tape) : Prop where + nextCanonical : Canonical nextStore + result : BufferedInstructionResult tapes oldStore nextStore nextPC + cleanupValues remainingValue work + sourceStart : (work tapes.liftedSource).cells 0 = Γ.start + bufferStart : (work tapes.buffer).cells 0 = Γ.start + sourceHead : (work tapes.liftedSource).head ≤ sourceHeadBound + +/-- Restore the clean instruction ABI around the buffered successor store. -/ +def instructionCleanupTM {n : ℕ} + (tapes : ControlInstructionTapes n) : TM (n + 1) := + TM.seqTM + (TM.resetBinaryWorkManyTM (instructionCleanupResetTargets tapes)) + (TM.seqTM (TM.rewindWorkTM tapes.buffer) + (TM.seqTM + (TM.copyWorkToWorkTM tapes.buffer tapes.liftedSource) + (TM.seqTM (TM.resetBinaryWorkTM tapes.buffer) + (TM.seqTM (TM.rewindWorkTM tapes.liftedSource) + (TM.binaryCopyIntoTM + tapes.lifted.data.update.resultCount + tapes.lifted.data.update.remaining + tapes.lifted.data.update.found))))) + +/-- Exact compositional cleanup bound for one buffered instruction result. -/ +noncomputable def instructionCleanupTime {n : ℕ} + (tapes : ControlInstructionTapes n) (instruction : Instr) + (pcValue : ℕ) (store : Store) (sourceHeadBound : ℕ) : ℕ := + let nextStore := instructionStore instruction pcValue store + let nextBits := nextStore.flatMap Entry.encode + TM.resetBinaryWorkManyTime + (instructionCleanupResetBitsAt tapes instruction store) + (instructionCleanupResetHeadBoundAt tapes sourceHeadBound) + (instructionCleanupResetTargets tapes) + 1 + + ((nextBits.length + 1 + 2) + 1 + + ((nextBits.length + 1) + 1 + + (TM.resetBinaryWorkTime (nextBits.length + 1) nextBits.length + 1 + + ((nextBits.length + 1 + 2) + 1 + + TM.binaryCopyTime nextStore.length 0)))) + +/-- Exact cleanup budget expressed only through the buffered representation +boundary, independent of the instruction semantics that produced it. -/ +noncomputable def bufferedCleanupTime {n : ℕ} + (tapes : ControlInstructionTapes n) (oldStore nextStore : Store) + (cleanupValues : Fin 5 → ℕ) (remainingValue sourceHeadBound : ℕ) : ℕ := + let nextBits := nextStore.flatMap Entry.encode + TM.resetBinaryWorkManyTime + (bufferedCleanupResetBitsAt tapes cleanupValues remainingValue oldStore) + (instructionCleanupResetHeadBoundAt tapes sourceHeadBound) + (instructionCleanupResetTargets tapes) + 1 + + ((nextBits.length + 1 + 2) + 1 + + ((nextBits.length + 1) + 1 + + (TM.resetBinaryWorkTime (nextBits.length + 1) nextBits.length + 1 + + ((nextBits.length + 1 + 2) + 1 + + TM.binaryCopyTime nextStore.length 0)))) + +/-- Runtime bound for a statically selected instruction before iteration +cleanup. -/ +def executeInstructionTime {n : ℕ} (tapes : ControlInstructionTapes n) + (instruction : Instr) (pcValue : ℕ) (store : Store) : ℕ := + match instruction with + | .imm destination value => + immediateInstructionTime tapes.data store destination value + 1 + + TM.binarySuccTime pcValue + | .add destination source₀ source₁ => + directBinaryInstructionTime tapes.data .add store destination source₀ + source₁ + 1 + TM.binarySuccTime pcValue + | .sub destination source₀ source₁ => + directBinaryInstructionTime tapes.data .sub store destination source₀ + source₁ + 1 + TM.binarySuccTime pcValue + | .mul destination source₀ source₁ => + directBinaryInstructionTime tapes.data .mul store destination source₀ + source₁ + 1 + TM.binarySuccTime pcValue + | .load destination addressRegister => + indirectLoadInstructionTime tapes.data store destination addressRegister + + 1 + TM.binarySuccTime pcValue + | .store addressRegister source => + indirectStoreInstructionTime tapes.data store addressRegister source + 1 + + TM.binarySuccTime pcValue + | .jz source target => + zeroJumpInstructionTime tapes.lifted store pcValue source target + 1 + + (store.flatMap Entry.encode).length + 1 + | .jmp target => + jumpInstructionTime pcValue target + 1 + + (store.flatMap Entry.encode).length + 1 + | .halt => + haltInstructionTime + 1 + (store.flatMap Entry.encode).length + 1 + +/-- Representation-independent path-sensitive branch-tree time. Unlike the +coarse branch combinator bound, this charges only the instruction selected by +the represented selector. -/ +def dispatchWithTime {n : ℕ} (tapes : ControlInstructionTapes n) + (executeTime : Instr → ℕ) : Program → ℕ → ℕ + | [], selector => + TM.resetBinaryWorkTime 1 selector.bits.length + 1 + executeTime .halt + | instruction :: _, 0 => executeTime instruction + 1 + | _ :: program, selector + 1 => + TM.binaryPredTime selector + 1 + + dispatchWithTime tapes executeTime program selector + 1 + +/-- Branch-tree bound for a selector currently represented by `selector`. -/ +def dispatchProgramTime {n : ℕ} (tapes : ControlInstructionTapes n) + (store : Store) (pcValue : ℕ) : Program → ℕ → ℕ + | [], selector => + TM.resetBinaryWorkTime 1 selector.bits.length + 1 + + executeInstructionTime tapes .halt pcValue store + | instruction :: program, selector => + TM.branchWorkBlankTime + (executeInstructionTime tapes instruction pcValue store) + (TM.binaryPredTime (selector - 1) + 1 + + dispatchProgramTime tapes store pcValue program (selector - 1)) + +/-- Complete fixed-program selection and selected-instruction bound. -/ +def programInstructionTime {n : ℕ} (tapes : ControlInstructionTapes n) + (program : Program) (pcValue : ℕ) (store : Store) : ℕ := + TM.binaryCopyTime pcValue 0 + 1 + + dispatchProgramTime tapes store pcValue program pcValue + +/-- Select and execute one RAM instruction, then restore the clean instruction +ABI for the successor snapshot. -/ +def programStepTM {n : ℕ} (tapes : ControlInstructionTapes n) + (program : Program) : TM (n + 1) := + TM.seqTM (programInstructionTM tapes program) (instructionCleanupTM tapes) + +/-- Source-head bound available after fixed-program selection and execution. -/ +def programStepSourceHeadBound {n : ℕ} + (tapes : ControlInstructionTapes n) (program : Program) + (pcValue : ℕ) (store : Store) : ℕ := + 1 + programInstructionTime tapes program pcValue store + +/-- Exact compositional time bound for one selected and cleaned RAM step. -/ +noncomputable def programStepTime {n : ℕ} + (tapes : ControlInstructionTapes n) (program : Program) + (pcValue : ℕ) (store : Store) : ℕ := + let instruction := selectedInstruction program pcValue + programInstructionTime tapes program pcValue store + 1 + + instructionCleanupTime tapes instruction pcValue store + (programStepSourceHeadBound tapes program pcValue store) + +end Machine + +end RegisterStore + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Sim/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Sim/Internal.lean new file mode 100644 index 0000000000..c4442d0fa3 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Sim/Internal.lean @@ -0,0 +1,1203 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Sim.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.WorkBranch +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryCopy +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryPred +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.ResetBinaryMany + +/-! +# Fixed-program dispatch -- proof internals +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace RegisterStore + +namespace Machine + +variable {n : ℕ} + +private theorem hasBinaryNat_parked {t : Tape} {value : ℕ} + (h : t.HasBinaryNat value) : TM.Parked t := by + refine ⟨by rw [h.2.1], ?_⟩ + exact Tape.HasBinaryContent.cells_ne_start h.2.2 + +private theorem hasBinaryPrefix_parked {t : Tape} {bits : List Bool} + (h : t.HasBinaryPrefix bits) : TM.Parked t := by + refine ⟨by rw [h.1]; omega, ?_⟩ + intro j hj + obtain ⟨i, rfl⟩ : ∃ i, j = i + 1 := ⟨j - 1, by omega⟩ + by_cases hi : i < bits.length + · rw [h.2.1 i hi] + exact Γ.ofBool_ne_start _ + · rw [h.2.2 i (Nat.le_of_not_gt hi)] + decide + +private theorem instructionCleanupPrefixTape_hasBinaryPrefix + (bits : List Bool) : + (instructionCleanupPrefixTape bits).HasBinaryPrefix bits := by + refine ⟨rfl, ?_, ?_⟩ + · intro i hi + exact Tape.init_ofBool_cells_lt bits i hi + · intro i hi + exact Tape.init_ofBool_cells_ge bits i hi + +private theorem instructionCleanupPrefixTape_start (bits : List Bool) : + (instructionCleanupPrefixTape bits).cells 0 = Γ.start := by + simp [instructionCleanupPrefixTape, Tape.init] + +private theorem instructionCleanupPrefixTape_parked (bits : List Bool) : + TM.Parked (instructionCleanupPrefixTape bits) := + hasBinaryPrefix_parked (instructionCleanupPrefixTape_hasBinaryPrefix bits) + +private theorem hasBinaryString_parked {t : Tape} {bits : List Bool} + (h : t.HasBinaryString bits) : TM.Parked t := by + exact ⟨by rw [h.1], Tape.cells_ne_start_of_hasBinaryString h⟩ + +private theorem blank_parked : + TM.Parked ((Tape.init []).move Dir3.right) := by + refine ⟨by simp [Tape.move], ?_⟩ + intro j hj + simp [Tape.move, Tape.init, show j ≠ 0 by omega] + +private theorem phaseTransition_of_parked + {inp out : Tape} {work : Fin n → Tape} + (hinput : TM.Parked inp) (hwork : ∀ i, TM.Parked (work i)) + (houtput : TM.Parked out) : + TM.transitionInput inp = inp ∧ + (fun i => TM.transitionTape (work i)) = work ∧ + TM.transitionTape out = out := + TM.phaseTransition_eq_self_of_reads_ne_start hinput.read_ne_start + (fun i => (hwork i).read_ne_start) houtput.read_ne_start + +/-- The finite decrementing branch tree selects the corresponding static +instruction, assuming the individual instruction kernels satisfy their common +semantic contract. -/ +theorem dispatchProgramTM_hoareTime_of_execute_internal + (tapes : ControlInstructionTapes n) (program : Program) + (store : Store) (pcValue selector : ℕ) + (cleanWork work₀ : Fin (n + 1) → Tape) (inp₀ out₀ : Tape) + (hready : DispatchReady tapes store pcValue selector cleanWork work₀) + (hinput : TM.Parked inp₀) (houtput : TM.Parked out₀) + (hexecute : ∀ instruction, + (executeInstructionTM tapes instruction).HoareTime + (fun inp work out => + inp = inp₀ ∧ work = cleanWork ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + InstructionExecutionResult tapes instruction pcValue store work ∧ + out = out₀) + (executeInstructionTime tapes instruction pcValue store)) : + (dispatchProgramTM tapes program).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + InstructionExecutionResult tapes + (selectedInstruction program selector) pcValue store work ∧ + out = out₀) + (dispatchProgramTime tapes store pcValue program selector) := by + induction program generalizing selector work₀ with + | nil => + let blankTape := (Tape.init []).move Dir3.right + have hselector : (work₀ tapes.liftedLhs).HasBinaryNat selector := by + rw [hready.2] + simp only [Function.update_self] + exact Tape.init_move_right_hasBinaryNat selector + have hcleanLhs : cleanWork tapes.liftedLhs = blankTape := by + have hzero := hready.1.control.lookup.destination + change (cleanWork tapes.liftedLhs).HasBinaryNat 0 at hzero + simpa only [blankTape] using + Tape.HasBinaryNat.eq_init_move_right hzero + have hwork₀Parked : ∀ i, TM.Parked (work₀ i) := by + intro i + rw [hready.2] + by_cases hi : i = tapes.liftedLhs + · subst i + simp only [Function.update_self] + exact hasBinaryNat_parked (Tape.init_move_right_hasBinaryNat selector) + · simp only [Function.update_of_ne hi] + exact hready.1.control.lookup.scanner.parked i + have hreset := TM.resetBinaryWorkTM_hoareTime_frame tapes.liftedLhs + selector.bits 1 inp₀ work₀ out₀ + hselector.2.hasBinaryContent hselector.1 + ⟨by rw [hselector.2.1], by rw [hselector.2.1]⟩ + hinput (fun i _ => hwork₀Parked i) houtput + have hreset' : (TM.resetBinaryWorkTM tapes.liftedLhs).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => inp = inp₀ ∧ work = cleanWork ∧ out = out₀) + (TM.resetBinaryWorkTime 1 selector.bits.length) := by + apply hreset.consequence + · exact fun _ _ _ h => h + · rintro inp work out ⟨hinp, hworkEq, hout⟩ + refine ⟨hinp, ?_, hout⟩ + rw [hworkEq, hready.2, Function.update_idem] + change Function.update cleanWork tapes.liftedLhs blankTape = cleanWork + rw [← hcleanLhs, Function.update_eq_self] + · exact le_rfl + have hseq := TM.seqTM_hoareTime + (TM.resetBinaryWorkTM tapes.liftedLhs) + (executeInstructionTM tapes .halt) hreset' + (by + rintro inp work out ⟨hinp, hworkEq, hout⟩ + obtain ⟨hi, hw, ho⟩ := phaseTransition_of_parked + (inp := inp) (work := work) (out := out) + (by simpa [hinp] using hinput) + (by simpa [hworkEq] using + hready.1.control.lookup.scanner.parked) + (by simpa [hout] using houtput) + rw [hi, hw, ho] + exact ⟨hinp, hworkEq, hout⟩) + (hexecute .halt) + simpa only [dispatchProgramTM, dispatchProgramTime, + selectedInstruction] using hseq + | cons instruction program ih => + let pre : TM.TapePred (n + 1) := fun inp work out => + inp = inp₀ ∧ work = work₀ ∧ out = out₀ + let post : TM.TapePred (n + 1) := fun inp work out => + inp = inp₀ ∧ + InstructionExecutionResult tapes + (selectedInstruction (instruction :: program) selector) + pcValue store work ∧ + out = out₀ + let blankPre : TM.TapePred (n + 1) := fun inp work out => + pre inp work out ∧ selector = 0 + let nonblankPre : TM.TapePred (n + 1) := fun inp work out => + pre inp work out ∧ selector ≠ 0 + have hselector : (work₀ tapes.liftedLhs).HasBinaryNat selector := by + rw [hready.2] + simp only [Function.update_self] + exact Tape.init_move_right_hasBinaryNat selector + have hwork₀Parked : ∀ i, TM.Parked (work₀ i) := by + intro i + rw [hready.2] + by_cases hi : i = tapes.liftedLhs + · subst i + simp only [Function.update_self] + exact hasBinaryNat_parked (Tape.init_move_right_hasBinaryNat selector) + · simp only [Function.update_of_ne hi] + exact hready.1.control.lookup.scanner.parked i + have hblank : (executeInstructionTM tapes instruction).HoareTime + blankPre post + (executeInstructionTime tapes instruction pcValue store) := by + rintro inp work out ⟨⟨hinp, hworkEq, hout⟩, hzero⟩ + subst selector + have hcleanLhs := Tape.HasBinaryNat.eq_init_move_right + hready.1.control.lookup.destination + change cleanWork tapes.liftedLhs = + (Tape.init []).move Dir3.right at hcleanLhs + have hworkClean : work = cleanWork := by + rw [hworkEq, hready.2] + funext i + by_cases hi : i = tapes.liftedLhs + · subst i + simp only [Function.update_self] + exact hcleanLhs.symm + · simp only [Function.update_of_ne hi] + obtain ⟨final, time, htime, hreach, hhalt, hfinalInput, + hresult, hfinalOutput⟩ := + hexecute instruction inp cleanWork out ⟨hinp, rfl, hout⟩ + refine ⟨final, time, htime, ?_, hhalt, hfinalInput, ?_, hfinalOutput⟩ + · simpa [hworkClean] using hreach + · simpa only [selectedInstruction] using hresult + have hnonblank : + (TM.seqTM (TM.binaryPredTM tapes.liftedLhs) + (dispatchProgramTM tapes program)).HoareTime + nonblankPre post + (TM.binaryPredTime (selector - 1) + 1 + + dispatchProgramTime tapes store pcValue program (selector - 1)) := by + rintro inp work out ⟨⟨hinp, hworkEq, hout⟩, hnonzero⟩ + have hsucc : selector = (selector - 1) + 1 := by omega + have hvalue : (work tapes.liftedLhs).HasBinaryNat + ((selector - 1) + 1) := by + rw [hworkEq] + rw [hsucc] at hselector + exact hselector + have hinpParked : TM.Parked inp := by simpa [hinp] using hinput + have houtParked : TM.Parked out := by simpa [hout] using houtput + have hworkParked : ∀ i, TM.Parked (work i) := by + intro i + simpa [hworkEq] using hwork₀Parked i + have hpred := TM.binaryPredTM_hoareTime_frame tapes.liftedLhs + (selector - 1) inp work out hvalue hinpParked.read_ne_start + (fun i _ => (hworkParked i).read_ne_start) + houtParked.read_ne_start + let nextWork := Function.update cleanWork tapes.liftedLhs + ((Tape.init ((selector - 1).bits.map Γ.ofBool)).move Dir3.right) + have hpred' : (TM.binaryPredTM tapes.liftedLhs).HoareTime + (fun inp' work' out' => inp' = inp ∧ work' = work ∧ out' = out) + (fun inp' work' out' => inp' = inp ∧ work' = nextWork ∧ out' = out) + (TM.binaryPredTime (selector - 1)) := by + apply hpred.consequence + · exact fun _ _ _ h => h + · rintro inp' work' out' ⟨hinp', hframe, hvalue', hout'⟩ + refine ⟨hinp', ?_, hout'⟩ + funext i + by_cases hi : i = tapes.liftedLhs + · subst i + simp only [nextWork, Function.update_self] + exact Tape.HasBinaryNat.eq_init_move_right hvalue' + · simp only [nextWork, Function.update_of_ne hi] + rw [hframe i hi, hworkEq, hready.2, + Function.update_of_ne hi] + · exact le_rfl + have hnextReady : DispatchReady tapes store pcValue (selector - 1) + cleanWork nextWork := ⟨hready.1, rfl⟩ + have hrecursive := ih (selector - 1) nextWork hnextReady + have hrecursive' : (dispatchProgramTM tapes program).HoareTime + (fun inp' work' out' => inp' = inp ∧ work' = nextWork ∧ out' = out) + post + (dispatchProgramTime tapes store pcValue program + (selector - 1)) := by + apply hrecursive.consequence + · rintro inp' work' out' ⟨hinp', hwork', hout'⟩ + exact ⟨hinp'.trans hinp, hwork', hout'.trans hout⟩ + · rintro inp' work' out' ⟨hinp', hresult, hout'⟩ + have hselected : + selectedInstruction (instruction :: program) selector = + selectedInstruction program (selector - 1) := by + rw [hsucc] + rfl + exact ⟨hinp', by simpa only [hselected] using hresult, hout'⟩ + · exact le_rfl + have hseq := TM.seqTM_hoareTime (TM.binaryPredTM tapes.liftedLhs) + (dispatchProgramTM tapes program) hpred' + (by + rintro inp' work' out' ⟨hinp', hwork', hout'⟩ + obtain ⟨hi, hw, ho⟩ := phaseTransition_of_parked + (inp := inp') (work := work') (out := out') + (by simpa [hinp', hinp] using hinput) + (by + intro i + rw [hwork'] + by_cases hidx : i = tapes.liftedLhs + · subst i + simp only [nextWork, Function.update_self] + exact hasBinaryNat_parked + (Tape.init_move_right_hasBinaryNat (selector - 1)) + · simp only [nextWork, Function.update_of_ne hidx] + exact hready.1.control.lookup.scanner.parked i) + (by simpa [hout', hout] using houtput) + rw [hi, hw, ho] + exact ⟨hinp', hwork', hout'⟩) + hrecursive' + exact hseq inp work out ⟨rfl, rfl, rfl⟩ + have hdispatch := TM.branchWorkBlankTM_hoareTime tapes.liftedLhs + (executeInstructionTM tapes instruction) + (TM.seqTM (TM.binaryPredTM tapes.liftedLhs) + (dispatchProgramTM tapes program)) + (pre := pre) (blankPre := blankPre) (nonblankPre := nonblankPre) + (blankPost := post) (nonblankPost := post) + (fun inp work out hpre => by + have hinpParked : TM.Parked inp := by simpa [hpre.1] using hinput + have houtParked : TM.Parked out := by simpa [hpre.2.2] using houtput + have hworkParked : ∀ i, TM.Parked (work i) := by + intro i + simpa [hpre.2.1] using hwork₀Parked i + exact ⟨hinpParked.read_ne_start, + fun i => (hworkParked i).read_ne_start, + houtParked.read_ne_start⟩) + (fun _ work _ hpre hread => + ⟨hpre, hselector.read_eq_blank_iff.mp (by simpa [hpre.2.1] using hread)⟩) + (fun _ work _ hpre hread => + ⟨hpre, fun hzero => hread (by + rw [hpre.2.1] + exact hselector.read_eq_blank_iff.mpr hzero)⟩) + hblank hnonblank + simpa only [dispatchProgramTM, dispatchProgramTime, pre, post] using + hdispatch.consequence (fun _ _ _ h => h) + (fun _ _ _ h => h.elim id id) le_rfl + +/-- Any buffered representation endpoint is restored to the reusable clean ABI. -/ +theorem bufferedCleanupTM_hoareTime_frame_internal + (tapes : ControlInstructionTapes n) (oldStore nextStore : Store) + (nextPC : ℕ) (cleanupValues : Fin 5 → ℕ) (remainingValue : ℕ) + (sourceHeadBound : ℕ) + (initialWork : Fin (n + 1) → Tape) (inp₀ out₀ : Tape) + (hready : BufferedCleanupReady tapes oldStore nextStore nextPC + cleanupValues remainingValue sourceHeadBound initialWork) + (hinput : TM.Parked inp₀) (houtput : TM.Parked out₀) : + (instructionCleanupTM tapes).HoareTime + (fun inp work out => + inp = inp₀ ∧ work = initialWork ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + InstructionExecutionReady tapes nextStore nextPC work ∧ + out = out₀) + (bufferedCleanupTime tapes oldStore nextStore cleanupValues + remainingValue sourceHeadBound) := by + let nextBits := nextStore.flatMap Entry.encode + let targets := instructionCleanupResetTargets tapes + let resetBits := bufferedCleanupResetBitsAt tapes cleanupValues + remainingValue oldStore + let resetHeads := + instructionCleanupResetHeadBoundAt tapes sourceHeadBound + let resetWork := TM.resetBinaryWorkManyResult initialWork targets + let nextTape := (Tape.init (nextBits.map Γ.ofBool)).move Dir3.right + have hresetContentIndexed : ∀ slot, + (initialWork (instructionCleanupResetTape tapes slot)).HasBinaryContent + (bufferedCleanupResetBits cleanupValues remainingValue oldStore + slot) := by + intro slot + fin_cases slot + · exact (hready.result.cleanup 0).2.hasBinaryContent + · exact (hready.result.cleanup 1).2.hasBinaryContent + · exact (hready.result.cleanup 2).2.hasBinaryContent + · exact (hready.result.cleanup 3).2.hasBinaryContent + · exact (hready.result.cleanup 4).2.hasBinaryContent + · exact hready.result.remaining.2.hasBinaryContent + · exact hready.result.sourceContent + have hresetStartIndexed : ∀ slot, + (initialWork (instructionCleanupResetTape tapes slot)).cells 0 = + Γ.start := by + intro slot + fin_cases slot + · exact (hready.result.cleanup 0).1 + · exact (hready.result.cleanup 1).1 + · exact (hready.result.cleanup 2).1 + · exact (hready.result.cleanup 3).1 + · exact (hready.result.cleanup 4).1 + · exact hready.result.remaining.1 + · exact hready.sourceStart + have hresetHeadIndexed : ∀ slot, + (initialWork (instructionCleanupResetTape tapes slot)).head ≤ + instructionCleanupResetHeadBound sourceHeadBound slot := by + intro slot + fin_cases slot + · simpa using (hready.result.cleanup 0).2.1.le + · simpa using (hready.result.cleanup 1).2.1.le + · simpa using (hready.result.cleanup 2).2.1.le + · simpa using (hready.result.cleanup 3).2.1.le + · simpa using (hready.result.cleanup 4).2.1.le + · simpa using hready.result.remaining.2.1.le + · exact hready.sourceHead + have hreset := TM.resetBinaryWorkManyTM_hoareTime_frame targets resetBits + resetHeads inp₀ initialWork out₀ + (by + exact List.nodup_ofFn_ofInjective + (instructionCleanupResetTape_injective tapes)) + (by + intro i hi + obtain ⟨slot, rfl⟩ := List.mem_ofFn.mp hi + change (initialWork (instructionCleanupResetTape tapes slot)).HasBinaryContent + (bufferedCleanupResetBitsAt tapes cleanupValues remainingValue oldStore + (instructionCleanupResetTape tapes slot)) + rw [bufferedCleanupResetBitsAt, + (instructionCleanupResetTape_injective tapes).extend_apply] + exact hresetContentIndexed slot) + (by + intro i hi + obtain ⟨slot, rfl⟩ := List.mem_ofFn.mp hi + exact hresetStartIndexed slot) + (by + intro i hi + obtain ⟨slot, rfl⟩ := List.mem_ofFn.mp hi + change (initialWork (instructionCleanupResetTape tapes slot)).head ≤ + instructionCleanupResetHeadBoundAt tapes sourceHeadBound + (instructionCleanupResetTape tapes slot) + rw [instructionCleanupResetHeadBoundAt, + (instructionCleanupResetTape_injective tapes).extend_apply] + exact hresetHeadIndexed slot) + hinput hready.result.parked houtput + have hdataNotMem (role : Fin 18) + (hrole : ∀ slot : Fin 7, + role ≠ instructionCleanupResetParentSlot slot) : + tapes.lifted.data.idx role ∉ targets := by + intro hi + obtain ⟨slot, hslot⟩ := List.mem_ofFn.mp hi + exact tapes.lifted.data.ne (hrole slot) hslot.symm + have hbufferNotMem : tapes.buffer ∉ targets := by + intro hi + obtain ⟨slot, hslot⟩ := List.mem_ofFn.mp hi + exact tapes.liftedData_ne_buffer + (instructionCleanupResetParentSlot slot) hslot + have hresetDataOutside (role : Fin 18) + (hrole : ∀ slot : Fin 7, + role ≠ instructionCleanupResetParentSlot slot) : + resetWork (tapes.lifted.data.idx role) = + initialWork (tapes.lifted.data.idx role) := by + exact TM.resetBinaryWorkManyResult_eq_of_not_mem initialWork targets _ + (hdataNotMem role hrole) + have hresetBuffer : resetWork tapes.buffer = initialWork tapes.buffer := by + exact TM.resetBinaryWorkManyResult_eq_of_not_mem initialWork targets _ + hbufferNotMem + have hresetParked : ∀ i, TM.Parked (resetWork i) := by + exact TM.resetBinaryWorkManyResult_parked initialWork targets + hready.result.parked + have hresetBufferContent : + (resetWork tapes.buffer).HasBinaryContent nextBits := by + rw [hresetBuffer] + exact hready.result.buffer.2 + have hresetBufferStart : (resetWork tapes.buffer).cells 0 = Γ.start := by + rw [hresetBuffer] + exact hready.bufferStart + have hresetBufferHead : + (resetWork tapes.buffer).head = nextBits.length + 1 := by + rw [hresetBuffer] + exact hready.result.buffer.1 + have hrewindRaw := TM.rewindBinaryWorkTM_hoareTime_frame tapes.buffer + nextBits (nextBits.length + 1) inp₀ resetWork out₀ + hresetBufferContent hresetBufferStart + ⟨by rw [hresetBufferHead]; omega, hresetBufferHead.le⟩ hinput + (fun i _ => hresetParked i) houtput + let rewoundWork := Function.update resetWork tapes.buffer nextTape + have hrewind : (TM.rewindWorkTM tapes.buffer).HoareTime + (fun inp work out => inp = inp₀ ∧ work = resetWork ∧ out = out₀) + (fun inp work out => inp = inp₀ ∧ work = rewoundWork ∧ out = out₀) + (nextBits.length + 1 + 2) := hrewindRaw.strengthen_post (by + rintro inp work out ⟨hinp, htarget, hframe, hout⟩ + have hwork : work = rewoundWork := by + funext i + by_cases hi : i = tapes.buffer + · subst i + simpa [rewoundWork, nextTape] using htarget + · simp [rewoundWork, hi, hframe i hi] + exact ⟨hinp, hwork, hout⟩) + have hresetTarget (slot : Fin 7) : + resetWork (instructionCleanupResetTape tapes slot) = + TM.resetBinaryBlank := by + exact TM.resetBinaryWorkManyResult_eq_blank_of_mem initialWork targets _ + (List.mem_ofFn.mpr ⟨slot, rfl⟩) + have hresetSource : resetWork tapes.liftedSource = TM.resetBinaryBlank := by + simpa [instructionCleanupResetTape, instructionCleanupResetParentSlot, + ControlInstructionTapes.liftedSource] using hresetTarget 6 + have hrewoundSource : + rewoundWork tapes.liftedSource = TM.resetBinaryBlank := by + simp [rewoundWork, tapes.liftedSource_ne_buffer, hresetSource] + have hrewoundParked : ∀ i, TM.Parked (rewoundWork i) := by + intro i + by_cases hi : i = tapes.buffer + · subst i + simp only [rewoundWork, Function.update_self, nextTape] + exact hasBinaryString_parked + (Tape.init_move_right_hasBinaryString nextBits) + · simp only [rewoundWork, Function.update_of_ne hi] + exact hresetParked i + let copyFrame : TM.TapePred (n + 1) := fun inp work out => + inp = inp₀ ∧ out = out₀ ∧ + ∀ i, i ≠ tapes.buffer → i ≠ tapes.liftedSource → + work i = rewoundWork i + have hcopyBase := TM.copyWorkToWorkTM_hoareTime_frame_of_binaryString + tapes.buffer tapes.liftedSource tapes.liftedSource_ne_buffer.symm + nextBits (P := copyFrame) + (by + rintro inp work out inp' work' out' + ⟨hinp, hout, hframe⟩ _ _ _ _ hinpEq houtEq hworkFrame + refine ⟨hinpEq.trans hinp, houtEq.trans hout, ?_⟩ + intro i hiBuffer hiSource + rw [hworkFrame i hiBuffer hiSource] + exact hframe i hiBuffer hiSource) + have hcopyReady : + (TM.copyWorkToWorkTM tapes.buffer tapes.liftedSource).HoareTime + (fun inp work out => + inp = inp₀ ∧ work = rewoundWork ∧ out = out₀) + (fun inp work out => + (work tapes.buffer).cells = + (Tape.init (nextBits.map Γ.ofBool)).cells ∧ + (work tapes.buffer).head = nextBits.length + 1 ∧ + (work tapes.liftedSource).HasBinaryPrefix nextBits ∧ + (work tapes.liftedSource).cells 0 = Γ.start ∧ + copyFrame inp work out) + (nextBits.length + 1) := hcopyBase.consequence + (by + rintro inp work out ⟨hinp, hwork, hout⟩ + subst work + refine ⟨?_, hrewoundSource, ?_, ?_, ?_, ?_, ?_⟩ + · simp [rewoundWork, nextTape] + · simpa [hinp] using hinput.read_ne_start + · simpa [hout] using houtput.read_ne_start + · simpa [hout] using houtput.1 + · intro i _ _ + exact ⟨(hrewoundParked i).read_ne_start, (hrewoundParked i).1⟩ + · exact ⟨hinp, hout, fun _ _ _ => rfl⟩) + (fun _ _ _ h => h) le_rfl + let prefixTape := instructionCleanupPrefixTape nextBits + let copiedWork := Function.update + (Function.update rewoundWork tapes.buffer prefixTape) + tapes.liftedSource prefixTape + have hcopy : + (TM.copyWorkToWorkTM tapes.buffer tapes.liftedSource).HoareTime + (fun inp work out => + inp = inp₀ ∧ work = rewoundWork ∧ out = out₀) + (fun inp work out => inp = inp₀ ∧ work = copiedWork ∧ out = out₀) + (nextBits.length + 1) := hcopyReady.strengthen_post (by + rintro inp work out ⟨hsrcCells, hsrcHead, hdstPrefix, hdstStart, + hinp, hout, hframe⟩ + have hsrc : work tapes.buffer = prefixTape := by + exact Tape.ext (by simpa [prefixTape, instructionCleanupPrefixTape] + using hsrcHead) (by simpa [prefixTape, instructionCleanupPrefixTape] + using hsrcCells) + have hdst : work tapes.liftedSource = prefixTape := by + exact Tape.ext (by simpa [prefixTape, instructionCleanupPrefixTape] + using hdstPrefix.1) (by + simpa [prefixTape, instructionCleanupPrefixTape] using + hdstPrefix.cells_eq_init hdstStart) + have hwork : work = copiedWork := by + funext i + by_cases hiSource : i = tapes.liftedSource + · subst i + simp [copiedWork, hdst] + by_cases hiBuffer : i = tapes.buffer + · subst i + simpa only [copiedWork, + Function.update_of_ne tapes.liftedSource_ne_buffer.symm, + Function.update_self] using hsrc + · simp [copiedWork, hiSource, hiBuffer, + hframe i hiBuffer hiSource] + exact ⟨hinp, hwork, hout⟩) + have hcopiedBuffer : copiedWork tapes.buffer = prefixTape := by + simp [copiedWork, tapes.liftedSource_ne_buffer.symm] + have hcopiedSource : copiedWork tapes.liftedSource = prefixTape := by + simp [copiedWork] + have hcopiedParked : ∀ i, TM.Parked (copiedWork i) := by + intro i + by_cases hiSource : i = tapes.liftedSource + · subst i + simpa [hcopiedSource] using + instructionCleanupPrefixTape_parked nextBits + by_cases hiBuffer : i = tapes.buffer + · subst i + simpa [hcopiedBuffer] using + instructionCleanupPrefixTape_parked nextBits + · simp [copiedWork, hiSource, hiBuffer] + exact hrewoundParked i + have hresetBufferRaw := TM.resetBinaryWorkTM_hoareTime_frame tapes.buffer + nextBits (nextBits.length + 1) inp₀ copiedWork out₀ + (by + rw [hcopiedBuffer] + exact (instructionCleanupPrefixTape_hasBinaryPrefix nextBits).2) + (by + rw [hcopiedBuffer] + exact instructionCleanupPrefixTape_start nextBits) + (by + rw [hcopiedBuffer] + exact ⟨by simp [prefixTape, instructionCleanupPrefixTape], le_rfl⟩) + hinput (fun i _ => hcopiedParked i) houtput + let bufferResetWork := Function.update copiedWork tapes.buffer + ((Tape.init []).move Dir3.right) + have hresetBufferPhase : (TM.resetBinaryWorkTM tapes.buffer).HoareTime + (fun inp work out => inp = inp₀ ∧ work = copiedWork ∧ out = out₀) + (fun inp work out => inp = inp₀ ∧ work = bufferResetWork ∧ out = out₀) + (TM.resetBinaryWorkTime (nextBits.length + 1) nextBits.length) := by + simpa only [bufferResetWork] using hresetBufferRaw + have hbufferResetSource : + bufferResetWork tapes.liftedSource = prefixTape := by + simp [bufferResetWork, tapes.liftedSource_ne_buffer, hcopiedSource] + have hbufferResetParked : ∀ i, TM.Parked (bufferResetWork i) := by + intro i + by_cases hi : i = tapes.buffer + · subst i + simp only [bufferResetWork, Function.update_self] + exact hasBinaryString_parked + (Tape.init_move_right_hasBinaryString []) + · simp only [bufferResetWork, Function.update_of_ne hi] + exact hcopiedParked i + have hrewindSourceRaw := TM.rewindBinaryWorkTM_hoareTime_frame + tapes.liftedSource nextBits (nextBits.length + 1) inp₀ bufferResetWork + out₀ + (by + rw [hbufferResetSource] + exact (instructionCleanupPrefixTape_hasBinaryPrefix nextBits).2) + (by + rw [hbufferResetSource] + exact instructionCleanupPrefixTape_start nextBits) + (by + rw [hbufferResetSource] + exact ⟨by simp [prefixTape, instructionCleanupPrefixTape], le_rfl⟩) + hinput (fun i _ => hbufferResetParked i) houtput + let sourceReadyWork := Function.update bufferResetWork tapes.liftedSource + nextTape + have hrewindSource : (TM.rewindWorkTM tapes.liftedSource).HoareTime + (fun inp work out => + inp = inp₀ ∧ work = bufferResetWork ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ work = sourceReadyWork ∧ out = out₀) + (nextBits.length + 1 + 2) := + hrewindSourceRaw.strengthen_post (by + rintro inp work out ⟨hinp, htarget, hframe, hout⟩ + have hwork : work = sourceReadyWork := by + funext i + by_cases hi : i = tapes.liftedSource + · subst i + simpa [sourceReadyWork, nextTape] using htarget + · simp [sourceReadyWork, hi, hframe i hi] + exact ⟨hinp, hwork, hout⟩) + have hsourceReadyOutside (i : Fin (n + 1)) + (hiSource : i ≠ tapes.liftedSource) (hiBuffer : i ≠ tapes.buffer) : + sourceReadyWork i = resetWork i := by + simp [sourceReadyWork, bufferResetWork, copiedWork, rewoundWork, + hiSource, hiBuffer] + have hsourceReadyParked : ∀ i, TM.Parked (sourceReadyWork i) := by + intro i + by_cases hiSource : i = tapes.liftedSource + · subst i + simp only [sourceReadyWork, Function.update_self, nextTape] + exact hasBinaryString_parked + (Tape.init_move_right_hasBinaryString nextBits) + by_cases hiBuffer : i = tapes.buffer + · subst i + simp only [sourceReadyWork, Function.update_of_ne + tapes.liftedSource_ne_buffer.symm] + exact hbufferResetParked tapes.buffer + · rw [hsourceReadyOutside i hiSource hiBuffer] + exact hresetParked i + have hresultCount : + (sourceReadyWork tapes.lifted.data.update.resultCount).HasBinaryNat + nextStore.length := by + change (sourceReadyWork (tapes.lifted.data.idx 12)).HasBinaryNat _ + rw [hsourceReadyOutside _ (tapes.lifted.data.ne (by decide)) + (tapes.liftedData_ne_buffer 12), + hresetDataOutside 12 (by intro slot; fin_cases slot <;> decide)] + exact hready.result.resultCount + have hremainingZero : + (sourceReadyWork tapes.lifted.data.update.remaining).HasBinaryNat 0 := by + change (sourceReadyWork (tapes.lifted.data.idx 9)).HasBinaryNat 0 + rw [hsourceReadyOutside _ (tapes.lifted.data.ne (by decide)) + (tapes.liftedData_ne_buffer 9)] + have htarget : resetWork (tapes.lifted.data.idx 9) = + TM.resetBinaryBlank := by + simpa [instructionCleanupResetTape, + instructionCleanupResetParentSlot] using hresetTarget 5 + rw [htarget] + simpa [TM.resetBinaryBlank] using Tape.init_move_right_hasBinaryNat 0 + have hfoundZero : + (sourceReadyWork tapes.lifted.data.update.found).HasBinaryNat 0 := by + change (sourceReadyWork (tapes.lifted.data.idx 11)).HasBinaryNat 0 + rw [hsourceReadyOutside _ (tapes.lifted.data.ne (by decide)) + (tapes.liftedData_ne_buffer 11)] + have htarget : resetWork (tapes.lifted.data.idx 11) = + TM.resetBinaryBlank := by + simpa [instructionCleanupResetTape, + instructionCleanupResetParentSlot] using hresetTarget 2 + rw [htarget] + simpa [TM.resetBinaryBlank] using Tape.init_move_right_hasBinaryNat 0 + have hcountCopyRaw := TM.binaryCopyIntoTM_hoareTime_frame + tapes.lifted.data.update.resultCount + tapes.lifted.data.update.remaining tapes.lifted.data.update.found + (tapes.lifted.data.ne (by decide)) + (tapes.lifted.data.ne (by decide)) + (tapes.lifted.data.ne (by decide)) nextStore.length 0 inp₀ + sourceReadyWork out₀ hresultCount hremainingZero hfoundZero hinput + (fun i _ _ _ => hsourceReadyParked i) houtput + let countTape := + (Tape.init (nextStore.length.bits.map Γ.ofBool)).move Dir3.right + let finalWork := Function.update sourceReadyWork + tapes.lifted.data.update.remaining countTape + have hcountCopy : + (TM.binaryCopyIntoTM tapes.lifted.data.update.resultCount + tapes.lifted.data.update.remaining + tapes.lifted.data.update.found).HoareTime + (fun inp work out => + inp = inp₀ ∧ work = sourceReadyWork ∧ out = out₀) + (fun inp work out => inp = inp₀ ∧ work = finalWork ∧ out = out₀) + (TM.binaryCopyTime nextStore.length 0) := by + simpa only [finalWork, countTape] using hcountCopyRaw + have hfinalDataOutside (role : Fin 18) (hremaining : role ≠ 9) + (hsource : role ≠ 0) : + finalWork (tapes.lifted.data.idx role) = + resetWork (tapes.lifted.data.idx role) := by + rw [show finalWork (tapes.lifted.data.idx role) = + sourceReadyWork (tapes.lifted.data.idx role) from + Function.update_of_ne (tapes.lifted.data.ne hremaining) _ _] + exact hsourceReadyOutside _ (tapes.lifted.data.ne hsource) + (tapes.liftedData_ne_buffer role) + have hfinalPreservedData (role : Fin 18) + (hremaining : role ≠ 9) (hsource : role ≠ 0) + (hreset : ∀ slot : Fin 7, + role ≠ instructionCleanupResetParentSlot slot) : + finalWork (tapes.lifted.data.idx role) = + initialWork (tapes.lifted.data.idx role) := by + rw [hfinalDataOutside role hremaining hsource, + hresetDataOutside role hreset] + have hfinalReset (slot : Fin 5) : + finalWork (instructionCleanupTape tapes slot) = + TM.resetBinaryBlank := by + fin_cases slot + · change finalWork (tapes.lifted.data.idx 7) = _ + rw [hfinalDataOutside 7 (by decide) (by decide)] + simpa [instructionCleanupTape, instructionCleanupResetTape, + instructionCleanupParentSlot, instructionCleanupResetParentSlot] + using hresetTarget 0 + · change finalWork (tapes.lifted.data.idx 10) = _ + rw [hfinalDataOutside 10 (by decide) (by decide)] + simpa [instructionCleanupTape, instructionCleanupResetTape, + instructionCleanupParentSlot, instructionCleanupResetParentSlot] + using hresetTarget 1 + · change finalWork (tapes.lifted.data.idx 11) = _ + rw [hfinalDataOutside 11 (by decide) (by decide)] + simpa [instructionCleanupTape, instructionCleanupResetTape, + instructionCleanupParentSlot, instructionCleanupResetParentSlot] + using hresetTarget 2 + · change finalWork (tapes.lifted.data.idx 13) = _ + rw [hfinalDataOutside 13 (by decide) (by decide)] + simpa [instructionCleanupTape, instructionCleanupResetTape, + instructionCleanupParentSlot, instructionCleanupResetParentSlot] + using hresetTarget 3 + · change finalWork (tapes.lifted.data.idx 14) = _ + rw [hfinalDataOutside 14 (by decide) (by decide)] + simpa [instructionCleanupTape, instructionCleanupResetTape, + instructionCleanupParentSlot, instructionCleanupResetParentSlot] + using hresetTarget 4 + have hblankNat : TM.resetBinaryBlank.HasBinaryNat 0 := by + simpa [TM.resetBinaryBlank] using Tape.init_move_right_hasBinaryNat 0 + have hfinalSource : finalWork tapes.liftedSource = nextTape := by + change finalWork (tapes.lifted.data.idx 0) = nextTape + rw [show finalWork (tapes.lifted.data.idx 0) = + sourceReadyWork (tapes.lifted.data.idx 0) from + Function.update_of_ne (tapes.lifted.data.ne (by decide)) _ _] + exact Function.update_self _ _ _ + have hfinalBuffer : + finalWork tapes.buffer = (Tape.init []).move Dir3.right := by + rw [show finalWork tapes.buffer = sourceReadyWork tapes.buffer from + Function.update_of_ne (tapes.liftedData_ne_buffer 9).symm _ _] + rw [show sourceReadyWork tapes.buffer = bufferResetWork tapes.buffer from + Function.update_of_ne tapes.liftedSource_ne_buffer.symm _ _] + exact Function.update_self _ _ _ + have hfinalParked : ∀ i, TM.Parked (finalWork i) := by + intro i + by_cases hi : i = tapes.lifted.data.update.remaining + · subst i + simp only [finalWork, Function.update_self, countTape] + exact hasBinaryNat_parked + (Tape.init_move_right_hasBinaryNat nextStore.length) + · simp only [finalWork, Function.update_of_ne hi] + exact hsourceReadyParked i + have hfinalScanner : EntryScanReady tapes.lifted.data.update.entry + nextBits [] finalWork finalWork := by + let entry := tapes.lifted.data.update.entry + refine + { source := by + change (finalWork tapes.liftedSource).HasBinarySuffix nextBits + rw [hfinalSource] + exact (Tape.init_move_right_hasBinaryString nextBits).hasBinarySuffix + address := by + change (finalWork (tapes.lifted.data.idx 1)).HasBinaryPrefix [] + rw [hfinalPreservedData 1 (by decide) (by decide) + (by intro slot; fin_cases slot <;> decide)] + exact hready.result.scanner.address + addressStart := by + change (finalWork (tapes.lifted.data.idx 1)).cells 0 = Γ.start + rw [hfinalPreservedData 1 (by decide) (by decide) + (by intro slot; fin_cases slot <;> decide)] + exact hready.result.scanner.addressStart + value := by + change (finalWork (tapes.lifted.data.idx 2)).HasBinaryPrefix [] + rw [hfinalPreservedData 2 (by decide) (by decide) + (by intro slot; fin_cases slot <;> decide)] + exact hready.result.scanner.value + valueStart := by + change (finalWork (tapes.lifted.data.idx 2)).cells 0 = Γ.start + rw [hfinalPreservedData 2 (by decide) (by decide) + (by intro slot; fin_cases slot <;> decide)] + exact hready.result.scanner.valueStart + addressCounter := by + change (finalWork (tapes.lifted.data.idx 3)).HasBinaryNat 0 + rw [hfinalPreservedData 3 (by decide) (by decide) + (by intro slot; fin_cases slot <;> decide)] + exact hready.result.scanner.addressCounter + addressWidth := by + change (finalWork (tapes.lifted.data.idx 4)).HasBinaryNat 0 + rw [hfinalPreservedData 4 (by decide) (by decide) + (by intro slot; fin_cases slot <;> decide)] + exact hready.result.scanner.addressWidth + valueCounter := by + change (finalWork (tapes.lifted.data.idx 5)).HasBinaryNat 0 + rw [hfinalPreservedData 5 (by decide) (by decide) + (by intro slot; fin_cases slot <;> decide)] + exact hready.result.scanner.valueCounter + valueWidth := by + change (finalWork (tapes.lifted.data.idx 6)).HasBinaryNat 0 + rw [hfinalPreservedData 6 (by decide) (by decide) + (by intro slot; fin_cases slot <;> decide)] + exact hready.result.scanner.valueWidth + query := by + change (finalWork (instructionCleanupTape tapes 0)).HasBinaryString [] + rw [hfinalReset 0] + exact hblankNat.2 + queryStart := by + change (finalWork (instructionCleanupTape tapes 0)).cells 0 = Γ.start + rw [hfinalReset 0] + exact hblankNat.1 + result := by + change (finalWork (tapes.lifted.data.idx 8)).HasBinaryPrefix [] + rw [hfinalPreservedData 8 (by decide) (by decide) + (by intro slot; fin_cases slot <;> decide)] + exact hready.result.scanner.result + resultStart := by + change (finalWork (tapes.lifted.data.idx 8)).cells 0 = Γ.start + rw [hfinalPreservedData 8 (by decide) (by decide) + (by intro slot; fin_cases slot <;> decide)] + exact hready.result.scanner.resultStart + parked := hfinalParked + frame := by intro i _ _ _ _ _ _ _ _ _; rfl } + have hfinalPC : finalWork tapes.liftedPC = initialWork tapes.liftedPC := by + rw [show finalWork tapes.liftedPC = sourceReadyWork tapes.liftedPC by + exact Function.update_of_ne (tapes.lifted.pc_ne 9) _ _] + rw [hsourceReadyOutside _ tapes.liftedPC_ne_source + tapes.liftedPC_ne_buffer] + exact TM.resetBinaryWorkManyResult_eq_of_not_mem initialWork targets _ (by + intro hi + obtain ⟨slot, hslot⟩ := List.mem_ofFn.mp hi + exact tapes.lifted.pc_ne (instructionCleanupResetParentSlot slot) + hslot.symm) + have hfinalLookupScanner : EntryScanReady + tapes.lifted.data.lhsLookup.scan.entry nextBits [] finalWork + finalWork := by + refine + { source := by + change (finalWork (tapes.lifted.data.idx 0)).HasBinarySuffix nextBits + exact hfinalScanner.source + address := by + change (finalWork (tapes.lifted.data.idx 1)).HasBinaryPrefix [] + exact hfinalScanner.address + addressStart := by + change (finalWork (tapes.lifted.data.idx 1)).cells 0 = Γ.start + exact hfinalScanner.addressStart + value := by + change (finalWork (tapes.lifted.data.idx 2)).HasBinaryPrefix [] + exact hfinalScanner.value + valueStart := by + change (finalWork (tapes.lifted.data.idx 2)).cells 0 = Γ.start + exact hfinalScanner.valueStart + addressCounter := by + change (finalWork (tapes.lifted.data.idx 3)).HasBinaryNat 0 + exact hfinalScanner.addressCounter + addressWidth := by + change (finalWork (tapes.lifted.data.idx 4)).HasBinaryNat 0 + exact hfinalScanner.addressWidth + valueCounter := by + change (finalWork (tapes.lifted.data.idx 5)).HasBinaryNat 0 + exact hfinalScanner.valueCounter + valueWidth := by + change (finalWork (tapes.lifted.data.idx 6)).HasBinaryNat 0 + exact hfinalScanner.valueWidth + query := by + change (finalWork (tapes.lifted.data.idx 7)).HasBinaryString [] + exact hfinalScanner.query + queryStart := by + change (finalWork (tapes.lifted.data.idx 7)).cells 0 = Γ.start + exact hfinalScanner.queryStart + result := by + change (finalWork (tapes.lifted.data.idx 8)).HasBinaryPrefix [] + exact hfinalScanner.result + resultStart := by + change (finalWork (tapes.lifted.data.idx 8)).cells 0 = Γ.start + exact hfinalScanner.resultStart + parked := hfinalParked + frame := by intro i _ _ _ _ _ _ _ _ _; rfl } + have hfinalReady : InstructionExecutionReady tapes nextStore + nextPC finalWork := by + refine + { canonical := hready.nextCanonical + control := + { lookup := + { scanner := by simpa [nextBits] using hfinalLookupScanner + sourceStart := by + change (finalWork tapes.liftedSource).cells 0 = Γ.start + rw [hfinalSource] + simp [nextTape, Tape.init, Tape.move] + sourceHead := by + change (finalWork tapes.liftedSource).head = 1 + rw [hfinalSource] + simp [nextTape, Tape.move] + count := by + change (finalWork (tapes.lifted.data.idx 9)).HasBinaryNat _ + rw [show finalWork (tapes.lifted.data.idx 9) = countTape from + Function.update_self _ _ _] + exact Tape.init_move_right_hasBinaryNat nextStore.length + countSource := by + change (finalWork (tapes.lifted.data.idx 12)).HasBinaryNat _ + rw [hfinalPreservedData 12 (by decide) (by decide) + (by intro slot; fin_cases slot <;> decide)] + exact hready.result.resultCount + querySource := by + change (finalWork (tapes.lifted.data.idx 15)).HasBinaryNat 0 + rw [hfinalPreservedData 15 (by decide) (by decide) + (by intro slot; fin_cases slot <;> decide)] + exact hready.result.shift + destination := by + change (finalWork (instructionCleanupTape tapes 3)).HasBinaryNat 0 + rw [hfinalReset 3] + exact hblankNat + copyScratch := by + change (finalWork (instructionCleanupTape tapes 2)).HasBinaryNat 0 + rw [hfinalReset 2] + exact hblankNat } + pc := by + change (finalWork tapes.liftedPC).HasBinaryNat _ + rw [hfinalPC] + exact hready.result.pc } + sourceContent := by + rw [hfinalSource] + exact (Tape.init_move_right_hasBinaryString nextBits).hasBinaryContent + rhs := by + rw [show tapes.lifted.data.rhs = instructionCleanupTape tapes 4 by rfl, + hfinalReset 4] + exact hblankNat + replacement := by + rw [show tapes.lifted.data.update.replacement = + instructionCleanupTape tapes 1 by rfl, + hfinalReset 1] + exact hblankNat + tmp := by + change (finalWork (tapes.lifted.data.idx 16)).HasBinaryNat 0 + rw [hfinalPreservedData 16 (by decide) (by decide) + (by intro slot; fin_cases slot <;> decide)] + exact hready.result.tmp + dbl := by + change (finalWork (tapes.lifted.data.idx 17)).HasBinaryNat 0 + rw [hfinalPreservedData 17 (by decide) (by decide) + (by intro slot; fin_cases slot <;> decide)] + exact hready.result.dbl + buffer := hfinalBuffer } + have hcountFinal : + (TM.binaryCopyIntoTM tapes.lifted.data.update.resultCount + tapes.lifted.data.update.remaining + tapes.lifted.data.update.found).HoareTime + (fun inp work out => + inp = inp₀ ∧ work = sourceReadyWork ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + InstructionExecutionReady tapes nextStore nextPC work ∧ + out = out₀) + (TM.binaryCopyTime nextStore.length 0) := + hcountCopy.strengthen_post (by + rintro inp work out ⟨hinp, hwork, hout⟩ + subst work + exact ⟨hinp, hfinalReady, hout⟩) + have hseam (work₀ : Fin (n + 1) → Tape) + (hwork₀ : ∀ i, TM.Parked (work₀ i)) : + ∀ inp work out, + (inp = inp₀ ∧ work = work₀ ∧ out = out₀) → + TM.transitionInput inp = inp₀ ∧ + (fun i => TM.transitionTape (work i)) = work₀ ∧ + TM.transitionTape out = out₀ := by + rintro inp work out ⟨hinp, hwork, hout⟩ + have hinpParked : TM.Parked inp := by simpa [hinp] using hinput + have houtParked : TM.Parked out := by simpa [hout] using houtput + have hworkParked : ∀ i, TM.Parked (work i) := by + simpa [hwork] using hwork₀ + obtain ⟨hi, hw, ho⟩ := phaseTransition_of_parked hinpParked + hworkParked houtParked + rw [hi, hw, ho] + exact ⟨hinp, hwork, hout⟩ + have htail₀ := TM.seqTM_hoareTime + (TM.rewindWorkTM tapes.liftedSource) + (TM.binaryCopyIntoTM tapes.lifted.data.update.resultCount + tapes.lifted.data.update.remaining tapes.lifted.data.update.found) + hrewindSource (hseam sourceReadyWork hsourceReadyParked) hcountFinal + have htail₁ := TM.seqTM_hoareTime + (TM.resetBinaryWorkTM tapes.buffer) + (TM.seqTM (TM.rewindWorkTM tapes.liftedSource) + (TM.binaryCopyIntoTM tapes.lifted.data.update.resultCount + tapes.lifted.data.update.remaining tapes.lifted.data.update.found)) + hresetBufferPhase (hseam bufferResetWork hbufferResetParked) htail₀ + have htail₂ := TM.seqTM_hoareTime + (TM.copyWorkToWorkTM tapes.buffer tapes.liftedSource) + (TM.seqTM (TM.resetBinaryWorkTM tapes.buffer) + (TM.seqTM (TM.rewindWorkTM tapes.liftedSource) + (TM.binaryCopyIntoTM tapes.lifted.data.update.resultCount + tapes.lifted.data.update.remaining tapes.lifted.data.update.found))) + hcopy (hseam copiedWork hcopiedParked) htail₁ + have htail₃ := TM.seqTM_hoareTime + (TM.rewindWorkTM tapes.buffer) + (TM.seqTM (TM.copyWorkToWorkTM tapes.buffer tapes.liftedSource) + (TM.seqTM (TM.resetBinaryWorkTM tapes.buffer) + (TM.seqTM (TM.rewindWorkTM tapes.liftedSource) + (TM.binaryCopyIntoTM tapes.lifted.data.update.resultCount + tapes.lifted.data.update.remaining tapes.lifted.data.update.found)))) + hrewind (hseam rewoundWork hrewoundParked) htail₂ + have hall := TM.seqTM_hoareTime + (TM.resetBinaryWorkManyTM targets) + (TM.seqTM (TM.rewindWorkTM tapes.buffer) + (TM.seqTM (TM.copyWorkToWorkTM tapes.buffer tapes.liftedSource) + (TM.seqTM (TM.resetBinaryWorkTM tapes.buffer) + (TM.seqTM (TM.rewindWorkTM tapes.liftedSource) + (TM.binaryCopyIntoTM tapes.lifted.data.update.resultCount + tapes.lifted.data.update.remaining + tapes.lifted.data.update.found))))) + hreset (hseam resetWork hresetParked) htail₃ + simpa only [instructionCleanupTM, bufferedCleanupTime, + nextBits, targets, resetBits, resetHeads] using hall + +/-- The ordinary sparse instruction endpoint is an instance of generic +buffered cleanup. -/ +theorem instructionCleanupTM_hoareTime_frame_internal + (tapes : ControlInstructionTapes n) (instruction : Instr) + (pcValue : ℕ) (store : Store) (sourceHeadBound : ℕ) + (initialWork : Fin (n + 1) → Tape) (inp₀ out₀ : Tape) + (hready : InstructionCleanupReady tapes instruction pcValue store + sourceHeadBound initialWork) + (hinput : TM.Parked inp₀) (houtput : TM.Parked out₀) : + (instructionCleanupTM tapes).HoareTime + (fun inp work out => + inp = inp₀ ∧ work = initialWork ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + InstructionExecutionReady tapes + (instructionStore instruction pcValue store) + (instructionPC instruction pcValue store) work ∧ + out = out₀) + (instructionCleanupTime tapes instruction pcValue store + sourceHeadBound) := by + let nextStore := instructionStore instruction pcValue store + let nextPC := instructionPC instruction pcValue store + let cleanupValues := instructionCleanupValue instruction store + let remainingValue := instructionRemainingValue instruction store + have hgenericReady : BufferedCleanupReady tapes store nextStore nextPC + cleanupValues remainingValue sourceHeadBound initialWork := + { nextCanonical := by + simpa [nextStore, instructionStore] using + Snapshot.stepInstr_canonical instruction + { pc := pcValue, store := store } hready.canonical + result := + { buffer := hready.result.buffer + pc := hready.result.pc + resultCount := hready.result.resultCount + sourceContent := hready.result.sourceContent + cleanup := hready.result.cleanup + remaining := hready.result.remaining + scanner := hready.result.scanner + shift := hready.result.shift + tmp := hready.result.tmp + dbl := hready.result.dbl + parked := hready.result.parked } + sourceStart := hready.sourceStart + bufferStart := hready.bufferStart + sourceHead := hready.sourceHead } + have hgeneric := bufferedCleanupTM_hoareTime_frame_internal tapes store + nextStore nextPC cleanupValues remainingValue sourceHeadBound initialWork + inp₀ out₀ hgenericReady hinput houtput + simpa only [nextStore, nextPC, cleanupValues, remainingValue, + instructionCleanupTime, bufferedCleanupTime, + instructionCleanupResetBitsAt, bufferedCleanupResetBitsAt, + instructionCleanupResetBits, bufferedCleanupResetBits] using hgeneric + +/-- One selected instruction followed by cleanup realizes the next reusable +sparse-snapshot boundary. -/ +theorem programStepTM_hoareTime_frame_internal + (tapes : ControlInstructionTapes n) (program : Program) + (store : Store) (pcValue : ℕ) + (initialWork : Fin (n + 1) → Tape) (inp₀ : Tape) + (hready : InstructionExecutionReady tapes store pcValue initialWork) + (hinput : TM.Parked inp₀) + (hprogram : (programInstructionTM tapes program).HoareTime + (fun inp work out => + inp = inp₀ ∧ work = initialWork ∧ + out = (Tape.init []).move Dir3.right) + (fun inp work out => + inp = inp₀ ∧ + InstructionExecutionResult tapes + (selectedInstruction program pcValue) pcValue store work ∧ + out = (Tape.init []).move Dir3.right) + (programInstructionTime tapes program pcValue store)) : + (programStepTM tapes program).HoareTime + (fun inp work out => + inp = inp₀ ∧ work = initialWork ∧ + out = (Tape.init []).move Dir3.right) + (fun inp work out => + inp = inp₀ ∧ + InstructionExecutionReady tapes + (instructionStore (selectedInstruction program pcValue) + pcValue store) + (instructionPC (selectedInstruction program pcValue) + pcValue store) work ∧ + out = (Tape.init []).move Dir3.right) + (programStepTime tapes program pcValue store) := by + let instruction := selectedInstruction program pcValue + let sourceBound := + programStepSourceHeadBound tapes program pcValue store + let blank := (Tape.init []).move Dir3.right + have hprogramCleanup : + (programInstructionTM tapes program).HoareTime + (fun inp work out => + inp = inp₀ ∧ work = initialWork ∧ out = blank) + (fun inp work out => + inp = inp₀ ∧ + InstructionCleanupReady tapes instruction pcValue store + sourceBound work ∧ + out = blank) + (programInstructionTime tapes program pcValue store) := by + intro inp work out hpre + obtain ⟨c, time, htime, hreach, hhalt, hinp, hresult, hout⟩ := + hprogram inp work out hpre + have hsourceStart₀ : + (work tapes.liftedSource).cells 0 = Γ.start := by + simpa [hpre.2.1] using hready.control.lookup.sourceStart + have hsourceStart := TM.work_cells_zero_eq_start_of_reachesIn + tapes.liftedSource hreach hsourceStart₀ + have hbufferStart₀ : + (work tapes.buffer).cells 0 = Γ.start := by + rw [hpre.2.1, hready.buffer] + simp [Tape.move, Tape.init] + have hbufferStart := TM.work_cells_zero_eq_start_of_reachesIn + tapes.buffer hreach hbufferStart₀ + have hsourceHead := + (programInstructionTM tapes program).work_head_reachesIn_bound + hreach tapes.liftedSource + refine ⟨c, time, htime, hreach, hhalt, hinp, ?_, hout⟩ + refine + { canonical := hready.canonical + result := by simpa only [instruction] using hresult + sourceStart := hsourceStart + bufferStart := hbufferStart + sourceHead := ?_ } + have hsourceHead₀ : (work tapes.liftedSource).head = 1 := by + simpa [hpre.2.1] using hready.control.lookup.sourceHead + rw [hsourceHead₀] at hsourceHead + simp only [sourceBound, programStepSourceHeadBound] + omega + have hcleanup : + (instructionCleanupTM tapes).HoareTime + (fun inp work out => + inp = inp₀ ∧ + InstructionCleanupReady tapes instruction pcValue store + sourceBound work ∧ + out = blank) + (fun inp work out => + inp = inp₀ ∧ + InstructionExecutionReady tapes + (instructionStore instruction pcValue store) + (instructionPC instruction pcValue store) work ∧ + out = blank) + (instructionCleanupTime tapes instruction pcValue store + sourceBound) := by + intro inp work out hpre + have hcleanupWork := instructionCleanupTM_hoareTime_frame_internal + tapes instruction pcValue store sourceBound work inp₀ blank + hpre.2.1 hinput blank_parked + exact hcleanupWork inp work out ⟨hpre.1, rfl, hpre.2.2⟩ + have hseq := TM.seqTM_hoareTime + (programInstructionTM tapes program) (instructionCleanupTM tapes) + hprogramCleanup + (by + rintro inp work out ⟨hinp, hcleanupReady, hout⟩ + have hinpParked : TM.Parked inp := by simpa [hinp] using hinput + have houtParked : TM.Parked out := by simpa [hout, blank] using blank_parked + obtain ⟨hi, hw, ho⟩ := phaseTransition_of_parked hinpParked + hcleanupReady.result.parked houtParked + rw [hi, hw, ho] + exact ⟨hinp, hcleanupReady, hout⟩) + hcleanup + simpa only [programStepTM, programStepTime, instruction, sourceBound, + blank] using hseq + +end Machine + +end RegisterStore + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Store.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Store.lean new file mode 100644 index 0000000000..f02bef4fbe --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Store.lean @@ -0,0 +1,552 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Direct + +/-! +# Indirect sparse-store instructions -- proof internals +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace RegisterStore + +namespace Machine + +variable {n : ℕ} + +private theorem hasBinaryPrefix_parked {t : Tape} {bits : List Bool} + (h : t.HasBinaryPrefix bits) : TM.Parked t := by + refine ⟨by rw [h.1]; omega, ?_⟩ + intro j hj + obtain ⟨i, rfl⟩ : ∃ i, j = i + 1 := ⟨j - 1, by omega⟩ + by_cases hi : i < bits.length + · rw [h.2.1 i hi] + exact Γ.ofBool_ne_start _ + · rw [h.2.2 i (Nat.le_of_not_gt hi)] + decide + +private theorem phaseTransition_of_parked + {inp out : Tape} {work : Fin n → Tape} + (hinput : TM.Parked inp) (hwork : ∀ i, TM.Parked (work i)) + (houtput : TM.Parked out) : + TM.transitionInput inp = inp ∧ + (fun i => TM.transitionTape (work i)) = work ∧ + TM.transitionTape out = out := + TM.phaseTransition_eq_self_of_reads_ne_start hinput.read_ne_start + (fun i => (hwork i).read_ne_start) houtput.read_ne_start + +private theorem storeOperands_values + (tapes : BinaryInstructionTapes n) (store : Store) + (addressRegister source : ℕ) (initialWork operandsWork : Fin n → Tape) + (hoperands : DirectBinaryOperandsResult tapes store addressRegister source + initialWork operandsWork) : + (operandsWork tapes.lhs).HasBinaryNat + (RegisterStore.read store addressRegister) ∧ + (operandsWork tapes.rhs).HasBinaryNat (RegisterStore.read store source) ∧ + (operandsWork tapes.update.found).HasBinaryNat 0 ∧ + ∀ i, TM.Parked (operandsWork i) := by + rcases hoperands with ⟨lhsWork, hlhs, hrhs⟩ + have hlhsEq : operandsWork tapes.lhs = lhsWork tapes.lhs := + hrhs.frame tapes.lhs + (fun slot => (tapes.rhsLookup_ne_lhs slot).symm) + refine ⟨?_, by simpa using hrhs.destination, by simpa using hrhs.copyScratch, + hrhs.parked⟩ + rw [hlhsEq] + simpa using hlhs.destination + +private theorem storeUpdate_ready + (tapes : BinaryInstructionTapes n) (store : Store) + (addressRegister source : ℕ) (initialWork operandsWork : Fin n → Tape) + (hinitial : EntryLookupStaticReady tapes.lhsLookup store initialWork) + (hoperands : DirectBinaryOperandsResult tapes store addressRegister source + initialWork operandsWork) : + let queryWork := Function.update operandsWork tapes.update.entry.query + ((Tape.init ((RegisterStore.read store addressRegister).bits.map + Γ.ofBool)).move Dir3.right) + let updateWork := Function.update queryWork tapes.update.replacement + ((Tape.init ((RegisterStore.read store source).bits.map Γ.ofBool)).move + Dir3.right) + EntryScanReady tapes.update.entry (store.flatMap Entry.encode) + (RegisterStore.read store addressRegister).bits updateWork updateWork ∧ + (updateWork tapes.update.replacement).HasBinaryNat + (RegisterStore.read store source) ∧ + (updateWork tapes.update.remaining).HasBinaryNat store.length ∧ + (updateWork tapes.update.found).HasBinaryNat 0 ∧ + (updateWork tapes.update.resultCount).HasBinaryNat store.length ∧ + ∀ i, TM.Parked (updateWork i) := by + dsimp only + rcases hoperands with ⟨lhsWork, hlhs, hrhs⟩ + let queryTape := + (Tape.init ((RegisterStore.read store addressRegister).bits.map Γ.ofBool)).move + Dir3.right + let valueTape := + (Tape.init ((RegisterStore.read store source).bits.map Γ.ofBool)).move + Dir3.right + let queryWork := Function.update operandsWork tapes.update.entry.query queryTape + let updateWork := Function.update queryWork tapes.update.replacement valueTape + have hqueryNat := Tape.init_move_right_hasBinaryNat + (RegisterStore.read store addressRegister) + have hvalueNat := Tape.init_move_right_hasBinaryNat + (RegisterStore.read store source) + have hqueryReplacement : + tapes.update.entry.query ≠ tapes.update.replacement := + tapes.update.ne (by decide) + have hscanner : EntryScanReady tapes.update.entry + (store.flatMap Entry.encode) + (RegisterStore.read store addressRegister).bits updateWork updateWork := by + have hsourceQuery : + tapes.update.entry.source ≠ tapes.update.entry.query := + tapes.update.ne (by decide) + have hsourceReplacement : + tapes.update.entry.source ≠ tapes.update.replacement := + tapes.update.ne (by decide) + have haddressQuery : + tapes.update.entry.address ≠ tapes.update.entry.query := + tapes.update.ne (by decide) + have haddressReplacement : + tapes.update.entry.address ≠ tapes.update.replacement := + tapes.update.ne (by decide) + have hvalueQuery : tapes.update.entry.value ≠ tapes.update.entry.query := + tapes.update.ne (by decide) + have hvalueReplacement : + tapes.update.entry.value ≠ tapes.update.replacement := + tapes.update.ne (by decide) + have haddressCounterQuery : + tapes.update.entry.addressCounter ≠ tapes.update.entry.query := + tapes.update.ne (by decide) + have haddressCounterReplacement : + tapes.update.entry.addressCounter ≠ tapes.update.replacement := + tapes.update.ne (by decide) + have haddressWidthQuery : + tapes.update.entry.addressWidth ≠ tapes.update.entry.query := + tapes.update.ne (by decide) + have haddressWidthReplacement : + tapes.update.entry.addressWidth ≠ tapes.update.replacement := + tapes.update.ne (by decide) + have hvalueCounterQuery : + tapes.update.entry.valueCounter ≠ tapes.update.entry.query := + tapes.update.ne (by decide) + have hvalueCounterReplacement : + tapes.update.entry.valueCounter ≠ tapes.update.replacement := + tapes.update.ne (by decide) + have hvalueWidthQuery : + tapes.update.entry.valueWidth ≠ tapes.update.entry.query := + tapes.update.ne (by decide) + have hvalueWidthReplacement : + tapes.update.entry.valueWidth ≠ tapes.update.replacement := + tapes.update.ne (by decide) + have hresultQuery : + tapes.update.entry.result ≠ tapes.update.entry.query := + tapes.update.ne (by decide) + have hresultReplacement : + tapes.update.entry.result ≠ tapes.update.replacement := + tapes.update.ne (by decide) + refine + { source := by + simpa only [updateWork, queryWork, + Function.update_of_ne hsourceReplacement, + Function.update_of_ne hsourceQuery] using hrhs.scanner.source + address := by + simpa only [updateWork, queryWork, + Function.update_of_ne haddressReplacement, + Function.update_of_ne haddressQuery] using hrhs.scanner.address + addressStart := by + simpa only [updateWork, queryWork, + Function.update_of_ne haddressReplacement, + Function.update_of_ne haddressQuery] using + hrhs.scanner.addressStart + value := by + simpa only [updateWork, queryWork, + Function.update_of_ne hvalueReplacement, + Function.update_of_ne hvalueQuery] using hrhs.scanner.value + valueStart := by + simpa only [updateWork, queryWork, + Function.update_of_ne hvalueReplacement, + Function.update_of_ne hvalueQuery] using hrhs.scanner.valueStart + addressCounter := by + simpa only [updateWork, queryWork, + Function.update_of_ne haddressCounterReplacement, + Function.update_of_ne haddressCounterQuery] using + hrhs.scanner.addressCounter + addressWidth := by + simpa only [updateWork, queryWork, + Function.update_of_ne haddressWidthReplacement, + Function.update_of_ne haddressWidthQuery] using + hrhs.scanner.addressWidth + valueCounter := by + simpa only [updateWork, queryWork, + Function.update_of_ne hvalueCounterReplacement, + Function.update_of_ne hvalueCounterQuery] using + hrhs.scanner.valueCounter + valueWidth := by + simpa only [updateWork, queryWork, + Function.update_of_ne hvalueWidthReplacement, + Function.update_of_ne hvalueWidthQuery] using + hrhs.scanner.valueWidth + query := by + simpa only [updateWork, + Function.update_of_ne hqueryReplacement, queryWork, + Function.update_self, queryTape] using hqueryNat.2 + queryStart := by + simpa only [updateWork, + Function.update_of_ne hqueryReplacement, queryWork, + Function.update_self, queryTape] using hqueryNat.1 + result := by + simpa only [updateWork, queryWork, + Function.update_of_ne hresultReplacement, + Function.update_of_ne hresultQuery] using hrhs.scanner.result + resultStart := by + simpa only [updateWork, queryWork, + Function.update_of_ne hresultReplacement, + Function.update_of_ne hresultQuery] using + hrhs.scanner.resultStart + parked := ?_ + frame := by intro i _ _ _ _ _ _ _ _ _; rfl } + intro i + by_cases hiReplacement : i = tapes.update.replacement + · subst i + simpa only [updateWork, Function.update_self, valueTape] using + (show TM.Parked valueTape from + ⟨by rw [hvalueNat.2.1], + hvalueNat.2.hasBinaryContent.cells_ne_start⟩) + · have hiUpdate : updateWork i = queryWork i := + Function.update_of_ne hiReplacement _ queryWork + rw [hiUpdate] + by_cases hiQuery : i = tapes.update.entry.query + · subst i + simpa only [queryWork, Function.update_self, queryTape] using + (show TM.Parked queryTape from + ⟨by rw [hqueryNat.2.1], + hqueryNat.2.hasBinaryContent.cells_ne_start⟩) + · simpa only [queryWork, Function.update_of_ne hiQuery] using + hrhs.parked i + have hresultCount : + (operandsWork tapes.update.resultCount).HasBinaryNat store.length := by + rw [show operandsWork tapes.update.resultCount = + lhsWork tapes.update.resultCount by simpa using hrhs.countSource] + rw [show lhsWork tapes.update.resultCount = + initialWork tapes.update.resultCount by simpa using hlhs.countSource] + simpa using hinitial.countSource + have hremainingReplacement : + tapes.update.remaining ≠ tapes.update.replacement := + tapes.update.ne (by decide) + have hremainingQuery : + tapes.update.remaining ≠ tapes.update.entry.query := + tapes.update.ne (by decide) + have hfoundReplacement : + tapes.update.found ≠ tapes.update.replacement := + tapes.update.ne (by decide) + have hfoundQuery : tapes.update.found ≠ tapes.update.entry.query := + tapes.update.ne (by decide) + have hresultCountReplacement : + tapes.update.resultCount ≠ tapes.update.replacement := + tapes.update.ne (by decide) + have hresultCountQuery : + tapes.update.resultCount ≠ tapes.update.entry.query := + tapes.update.ne (by decide) + refine ⟨hscanner, ?_, ?_, ?_, ?_, hscanner.parked⟩ + · simpa only [updateWork, Function.update_self, valueTape] using hvalueNat + · simpa only [updateWork, + Function.update_of_ne hremainingReplacement, queryWork, + Function.update_of_ne hremainingQuery] using hrhs.count + · simpa only [updateWork, + Function.update_of_ne hfoundReplacement, queryWork, + Function.update_of_ne hfoundQuery] using + hrhs.copyScratch + · simpa only [updateWork, + Function.update_of_ne hresultCountReplacement, queryWork, + Function.update_of_ne hresultCountQuery] using hresultCount + +/-- Exact semantic and time contract for one indirect sparse store. -/ +theorem indirectStoreInstructionTM_hoareTime_frame_internal + (tapes : BinaryInstructionTapes n) (store : Store) + (addressRegister source : ℕ) (emittedBits : List Bool) + (initialWork : Fin n → Tape) (inp₀ out₀ : Tape) + (hcanonical : Canonical store) + (hinitial : EntryLookupStaticReady tapes.lhsLookup store initialWork) + (hrhs₀ : (initialWork tapes.rhs).HasBinaryNat 0) + (hreplacement : (initialWork tapes.update.replacement).HasBinaryNat 0) + (hinput : TM.Parked inp₀) + (houtput : out₀.HasBinaryPrefix emittedBits) : + (indirectStoreInstructionTM tapes addressRegister source).HoareTime + (fun inp work out => inp = inp₀ ∧ work = initialWork ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + IndirectStoreInstructionResult tapes store addressRegister source + initialWork work ∧ + out.HasBinaryPrefix + (emittedBits ++ + (RegisterStore.write store + (RegisterStore.read store addressRegister) + (RegisterStore.read store source)).flatMap Entry.encode)) + (indirectStoreInstructionTime tapes store addressRegister source) := by + let address := RegisterStore.read store addressRegister + let value := RegisterStore.read store source + have houtputParked := hasBinaryPrefix_parked houtput + have hoperands := directBinaryOperands_hoareTime_internal tapes store + addressRegister source initialWork inp₀ out₀ hinitial hrhs₀ hinput + houtputParked + have hquery : + (TM.binaryCopyIntoTM tapes.lhs tapes.update.entry.query + tapes.update.found).HoareTime + (fun inp work out => + inp = inp₀ ∧ + DirectBinaryOperandsResult tapes store addressRegister source + initialWork work ∧ + out = out₀) + (fun inp work out => + inp = inp₀ ∧ + (∃ operandsWork, + DirectBinaryOperandsResult tapes store addressRegister source + initialWork operandsWork ∧ + work = Function.update operandsWork tapes.update.entry.query + ((Tape.init (address.bits.map Γ.ofBool)).move Dir3.right)) ∧ + out = out₀) + (TM.binaryCopyTime address 0) := by + rintro inp work out ⟨hinp, hops, hout⟩ + have hvalues := storeOperands_values tapes store addressRegister source + initialWork work hops + have hrun := TM.binaryCopyIntoTM_hoareTime_frame tapes.lhs + tapes.update.entry.query tapes.update.found (tapes.ne (by decide)) + (tapes.ne (by decide)) (tapes.update.ne (by decide)) address 0 inp work + out (by simpa [address] using hvalues.1) + ⟨(by rcases hops with ⟨_, _, hrhs⟩; exact hrhs.scanner.queryStart), + (by rcases hops with ⟨_, _, hrhs⟩; + simpa using hrhs.scanner.query)⟩ + hvalues.2.2.1 (by simpa [hinp] using hinput) + (fun i _ _ _ => hvalues.2.2.2 i) + (by simpa [hout] using houtputParked) + obtain ⟨final, time, htime, hreach, hhalt, hfinalInput, + hfinalWork, hfinalOutput⟩ := + hrun inp work out ⟨rfl, rfl, rfl⟩ + exact ⟨final, time, htime, hreach, hhalt, hfinalInput.trans hinp, + ⟨work, hops, by simpa [address] using hfinalWork⟩, + hfinalOutput.trans hout⟩ + have hvalue : + (TM.binaryCopyIntoTM tapes.rhs tapes.update.replacement + tapes.update.found).HoareTime + (fun inp work out => + inp = inp₀ ∧ + (∃ operandsWork, + DirectBinaryOperandsResult tapes store addressRegister source + initialWork operandsWork ∧ + work = Function.update operandsWork tapes.update.entry.query + ((Tape.init (address.bits.map Γ.ofBool)).move Dir3.right)) ∧ + out = out₀) + (fun inp work out => + inp = inp₀ ∧ + (∃ operandsWork queryWork, + DirectBinaryOperandsResult tapes store addressRegister source + initialWork operandsWork ∧ + queryWork = Function.update operandsWork tapes.update.entry.query + ((Tape.init (address.bits.map Γ.ofBool)).move Dir3.right) ∧ + work = Function.update queryWork tapes.update.replacement + ((Tape.init (value.bits.map Γ.ofBool)).move Dir3.right)) ∧ + out = out₀) + (TM.binaryCopyTime value 0) := by + rintro inp work out ⟨hinp, ⟨operandsWork, hops, hwork⟩, hout⟩ + subst work + have hvalues := storeOperands_values tapes store addressRegister source + initialWork operandsWork hops + let queryWork := Function.update operandsWork tapes.update.entry.query + ((Tape.init (address.bits.map Γ.ofBool)).move Dir3.right) + have hrhsQuery : tapes.rhs ≠ tapes.update.entry.query := + tapes.ne (by decide) + have hreplacementQuery : + tapes.update.replacement ≠ tapes.update.entry.query := + tapes.update.ne (by decide) + have hfoundQuery : tapes.update.found ≠ tapes.update.entry.query := + tapes.update.ne (by decide) + have hrun := TM.binaryCopyIntoTM_hoareTime_frame tapes.rhs + tapes.update.replacement tapes.update.found (tapes.ne (by decide)) + (tapes.ne (by decide)) (tapes.update.ne (by decide)) value 0 inp + queryWork out + (by simpa only [queryWork, + Function.update_of_ne hrhsQuery, value] using hvalues.2.1) + (by + have hreplEq : operandsWork tapes.update.replacement = + initialWork tapes.update.replacement := by + rcases hops with ⟨lhsWork, hlhs, hrhs⟩ + rw [hrhs.frame tapes.update.replacement + (fun slot => (tapes.rhsLookup_ne_replacement slot).symm)] + exact hlhs.frame tapes.update.replacement + (fun slot => (tapes.lhsLookup_ne_replacement slot).symm) + simpa only [queryWork, + Function.update_of_ne hreplacementQuery, hreplEq] using + hreplacement) + (by simpa only [queryWork, + Function.update_of_ne hfoundQuery] using hvalues.2.2.1) + (by simpa [hinp] using hinput) + (fun i _ _ _ => by + by_cases hi : i = tapes.update.entry.query + · subst i + have hnat := Tape.init_move_right_hasBinaryNat address + simpa only [queryWork, Function.update_self] using + (show TM.Parked + ((Tape.init (address.bits.map Γ.ofBool)).move Dir3.right) from + ⟨by rw [hnat.2.1], hnat.2.hasBinaryContent.cells_ne_start⟩) + · simpa only [queryWork, Function.update_of_ne hi] using + hvalues.2.2.2 i) + (by simpa [hout] using houtputParked) + obtain ⟨final, time, htime, hreach, hhalt, hfinalInput, + hfinalWork, hfinalOutput⟩ := + hrun inp queryWork out ⟨rfl, rfl, rfl⟩ + exact ⟨final, time, htime, hreach, hhalt, hfinalInput.trans hinp, + ⟨operandsWork, queryWork, hops, rfl, + by simpa [value] using hfinalWork⟩, + hfinalOutput.trans hout⟩ + have hupdate : (entryUpdateTM tapes.update).HoareTime + (fun inp work out => + inp = inp₀ ∧ + (∃ operandsWork queryWork, + DirectBinaryOperandsResult tapes store addressRegister source + initialWork operandsWork ∧ + queryWork = Function.update operandsWork tapes.update.entry.query + ((Tape.init (address.bits.map Γ.ofBool)).move Dir3.right) ∧ + work = Function.update queryWork tapes.update.replacement + ((Tape.init (value.bits.map Γ.ofBool)).move Dir3.right)) ∧ + out = out₀) + (fun inp work out => + inp = inp₀ ∧ + IndirectStoreInstructionResult tapes store addressRegister source + initialWork work ∧ + out.HasBinaryPrefix + (emittedBits ++ + (RegisterStore.write store address value).flatMap Entry.encode)) + (entryUpdateTime tapes.update store address value) := by + rintro inp work out ⟨hinp, ⟨operandsWork, queryWork, hops, + hqueryWork, hwork⟩, hout⟩ + subst queryWork + subst work + have hready := storeUpdate_ready tapes store addressRegister source + initialWork operandsWork hinitial hops + let updateWork := Function.update + (Function.update operandsWork tapes.update.entry.query + ((Tape.init (address.bits.map Γ.ofBool)).move Dir3.right)) + tapes.update.replacement + ((Tape.init (value.bits.map Γ.ofBool)).move Dir3.right) + have hrun := entryUpdateTM_hoareTime_frame tapes.update store address value + emittedBits updateWork inp₀ out₀ hcanonical hready.1 hready.2.1 + hready.2.2.1 hready.2.2.2.1 hready.2.2.2.2.1 hinput houtput + obtain ⟨final, time, htime, hreach, hhalt, hfinalInput, + houtcome, hfinalOutput, hsourceCells⟩ := + hrun inp updateWork out ⟨hinp, rfl, hout⟩ + exact ⟨final, time, htime, hreach, hhalt, hfinalInput, + ⟨operandsWork, + Function.update operandsWork tapes.update.entry.query + ((Tape.init (address.bits.map Γ.ofBool)).move Dir3.right), + updateWork, hops, rfl, rfl, by simpa [address, value] using houtcome, + by + rcases hops with ⟨lhsWork, hlhs, hrhs⟩ + calc + (final.work tapes.update.entry.source).cells = + (updateWork tapes.update.entry.source).cells := hsourceCells + _ = (operandsWork tapes.update.entry.source).cells := by + rw [show updateWork tapes.update.entry.source = + (Function.update operandsWork tapes.update.entry.query + ((Tape.init (address.bits.map Γ.ofBool)).move + Dir3.right)) tapes.update.entry.source by + exact Function.update_of_ne (tapes.update.ne (by decide)) _ _] + rw [show (Function.update operandsWork + tapes.update.entry.query + ((Tape.init (address.bits.map Γ.ofBool)).move Dir3.right)) + tapes.update.entry.source = + operandsWork tapes.update.entry.source by + exact Function.update_of_ne (tapes.update.ne (by decide)) _ _] + _ = (lhsWork tapes.update.entry.source).cells := hrhs.sourceCells + _ = (initialWork tapes.update.entry.source).cells := + hlhs.sourceCells⟩, + by simpa [address, value] using hfinalOutput⟩ + have hvalueUpdate := TM.seqTM_hoareTime + (TM.binaryCopyIntoTM tapes.rhs tapes.update.replacement tapes.update.found) + (entryUpdateTM tapes.update) hvalue + (by + rintro inp work out ⟨hinp, ⟨operandsWork, queryWork, hops, + hqueryWork, hwork⟩, hout⟩ + subst queryWork + subst work + have hready := storeUpdate_ready tapes store addressRegister source + initialWork operandsWork hinitial hops + obtain ⟨hi, hw, ho⟩ := phaseTransition_of_parked + (inp := inp) + (work := Function.update + (Function.update operandsWork tapes.update.entry.query + ((Tape.init (address.bits.map Γ.ofBool)).move Dir3.right)) + tapes.update.replacement + ((Tape.init (value.bits.map Γ.ofBool)).move Dir3.right)) + (out := out) (by simpa [hinp] using hinput) hready.2.2.2.2.2 + (by simpa [hout] using houtputParked) + rw [hi, hw, ho] + exact ⟨hinp, ⟨operandsWork, _, hops, rfl, rfl⟩, hout⟩) + hupdate + have hqueryRest := TM.seqTM_hoareTime + (TM.binaryCopyIntoTM tapes.lhs tapes.update.entry.query tapes.update.found) + (TM.seqTM + (TM.binaryCopyIntoTM tapes.rhs tapes.update.replacement tapes.update.found) + (entryUpdateTM tapes.update)) hquery + (by + rintro inp work out ⟨hinp, ⟨operandsWork, hops, hwork⟩, hout⟩ + subst work + have hvalues := storeOperands_values tapes store addressRegister source + initialWork operandsWork hops + have hparked : ∀ i, TM.Parked + (Function.update operandsWork tapes.update.entry.query + ((Tape.init (address.bits.map Γ.ofBool)).move Dir3.right) i) := by + intro i + by_cases hi : i = tapes.update.entry.query + · subst i + have hnat := Tape.init_move_right_hasBinaryNat address + simpa only [Function.update_self] using + (show TM.Parked + ((Tape.init (address.bits.map Γ.ofBool)).move Dir3.right) from + ⟨by rw [hnat.2.1], hnat.2.hasBinaryContent.cells_ne_start⟩) + · simpa only [Function.update_of_ne hi] using hvalues.2.2.2 i + obtain ⟨hi, hw, ho⟩ := phaseTransition_of_parked + (inp := inp) + (work := Function.update operandsWork tapes.update.entry.query + ((Tape.init (address.bits.map Γ.ofBool)).move Dir3.right)) + (out := out) (by simpa [hinp] using hinput) hparked + (by simpa [hout] using houtputParked) + rw [hi, hw, ho] + exact ⟨hinp, ⟨operandsWork, hops, rfl⟩, hout⟩) + hvalueUpdate + have hall := TM.seqTM_hoareTime + (TM.seqTM (entryLookupStaticTM tapes.lhsLookup addressRegister) + (entryLookupStaticTM tapes.rhsLookup source)) + (TM.seqTM + (TM.binaryCopyIntoTM tapes.lhs tapes.update.entry.query tapes.update.found) + (TM.seqTM + (TM.binaryCopyIntoTM tapes.rhs tapes.update.replacement tapes.update.found) + (entryUpdateTM tapes.update))) hoperands + (by + rintro inp work out ⟨hinp, hops, hout⟩ + have hvalues := storeOperands_values tapes store addressRegister source + initialWork work hops + obtain ⟨hi, hw, ho⟩ := phaseTransition_of_parked + (inp := inp) (work := work) (out := out) + (by simpa [hinp] using hinput) hvalues.2.2.2 + (by simpa [hout] using houtputParked) + rw [hi, hw, ho] + exact ⟨hinp, hops, hout⟩) + hqueryRest + simpa [indirectStoreInstructionTM, indirectStoreInstructionTime, address, + value] using hall + +end Machine + +end RegisterStore + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup.lean new file mode 100644 index 0000000000..4ba1b3893d --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup.lean @@ -0,0 +1,11 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.DenseInternal +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Internal + +/-! Supporting modules for Beyond the Bethe approximation of the permanent. -/ diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/Defs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/Defs.lean new file mode 100644 index 0000000000..011116a30a --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/Defs.lean @@ -0,0 +1,779 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryLookup.Defs +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.DenseInputLookup.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.DenseOverlay.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryAddConst.Defs +public import Mathlib.Tactic.FinCases + +/-! +# Reusable sparse-register operand lookup -- definitions + +One RAM instruction may need several direct or indirect register reads. This +module gives lookup a reusable phase boundary: it loads a query from a +canonical source, scans the encoded store, copies out the decoded value, resets +all scanner scratch, rewinds the source, and restores the runtime entry count. +-/ + + +@[expose] public section + +namespace Complexity + +namespace RAM + +namespace RegisterStore + +namespace Machine + +/-- Fourteen pairwise-distinct tapes for a reusable sparse operand lookup. +Slots `0..9` are the bounded scanner; the final four slots preserve the entry +count, supply the query, receive the value, and provide zero copy scratch. -/ +structure EntryLookupRestoreTapes (n : ℕ) where + /-- Physical work tape assigned to each logical lookup role. -/ + idx : Fin 14 → Fin n + /-- Distinct logical lookup roles occupy distinct physical tapes. -/ + injective : Function.Injective idx + +namespace EntryLookupRestoreTapes + +/-- Bounded scanner view of the reusable lookup assignment. -/ +def scan {n : ℕ} (tapes : EntryLookupRestoreTapes n) : EntryScanTapes n where + entry := + { idx := fun i => tapes.idx ⟨i, by omega⟩ + injective := by + intro i j h + apply Fin.ext + simpa using congrArg Fin.val (tapes.injective h) } + count := tapes.idx 9 + count_ne := by + intro i h + have h' : (9 : Fin 14) = ⟨i.val, by omega⟩ := tapes.injective h + have hval := congrArg Fin.val h' + change (9 : ℕ) = i.val at hval + omega + +@[simp] theorem scan_entry_idx {n : ℕ} (tapes : EntryLookupRestoreTapes n) + (slot : Fin 9) : + tapes.scan.entry.idx slot = tapes.idx ⟨slot.val, by omega⟩ := rfl + +@[simp] theorem scan_count {n : ℕ} (tapes : EntryLookupRestoreTapes n) : + tapes.scan.count = tapes.idx 9 := rfl + +/-- Preserved canonical copy of the store cardinality. -/ +def countSource {n : ℕ} (tapes : EntryLookupRestoreTapes n) : Fin n := + tapes.idx 10 + +/-- Canonical address supplied to this lookup. -/ +def querySource {n : ℕ} (tapes : EntryLookupRestoreTapes n) : Fin n := + tapes.idx 11 + +/-- Canonical destination receiving the looked-up register value. -/ +def destination {n : ℕ} (tapes : EntryLookupRestoreTapes n) : Fin n := + tapes.idx 12 + +/-- Preserved zero tape used by width-linear binary copying. -/ +def copyScratch {n : ℕ} (tapes : EntryLookupRestoreTapes n) : Fin n := + tapes.idx 13 + +/-- Inequality of logical slots gives inequality of physical tapes. -/ +theorem ne {n : ℕ} (tapes : EntryLookupRestoreTapes n) + {i j : Fin 14} (hne : i ≠ j) : tapes.idx i ≠ tapes.idx j := + fun heq => hne (tapes.injective heq) + +/-- Every scanner tape is distinct from an external reusable-lookup role. -/ +theorem scan_ne_external {n : ℕ} (tapes : EntryLookupRestoreTapes n) + (slot : Fin 10) (external : Fin 4) : + tapes.idx ⟨slot.val, by omega⟩ ≠ + tapes.idx ⟨external.val + 10, by omega⟩ := by + apply tapes.ne + intro h + have hval := congrArg Fin.val h + change slot.val = external.val + 10 at hval + omega + +theorem countSource_ne_querySource {n : ℕ} + (tapes : EntryLookupRestoreTapes n) : + tapes.countSource ≠ tapes.querySource := tapes.ne (by decide) + +theorem countSource_ne_destination {n : ℕ} + (tapes : EntryLookupRestoreTapes n) : + tapes.countSource ≠ tapes.destination := tapes.ne (by decide) + +theorem countSource_ne_copyScratch {n : ℕ} + (tapes : EntryLookupRestoreTapes n) : + tapes.countSource ≠ tapes.copyScratch := tapes.ne (by decide) + +theorem querySource_ne_destination {n : ℕ} + (tapes : EntryLookupRestoreTapes n) : + tapes.querySource ≠ tapes.destination := tapes.ne (by decide) + +theorem querySource_ne_copyScratch {n : ℕ} + (tapes : EntryLookupRestoreTapes n) : + tapes.querySource ≠ tapes.copyScratch := tapes.ne (by decide) + +theorem destination_ne_copyScratch {n : ℕ} + (tapes : EntryLookupRestoreTapes n) : + tapes.destination ≠ tapes.copyScratch := tapes.ne (by decide) + +/-- Logical parent slots reset after one lookup. -/ +def resetSlot (slot : Fin 9) : Fin 14 := + match slot.val with + | 0 => 1 + | 1 => 2 + | 2 => 3 + | 3 => 4 + | 4 => 5 + | 5 => 6 + | 6 => 8 + | 7 => 7 + | _ => 9 + +private theorem resetSlot_injective : Function.Injective resetSlot := by + intro i j h + fin_cases i <;> fin_cases j <;> simp [resetSlot] at h ⊢ + +/-- Physical reset target selected by a finite logical slot. -/ +def resetIdx {n : ℕ} (tapes : EntryLookupRestoreTapes n) + (slot : Fin 9) : Fin n := tapes.idx (resetSlot slot) + +theorem resetIdx_injective {n : ℕ} (tapes : EntryLookupRestoreTapes n) : + Function.Injective tapes.resetIdx := + fun _ _ h => resetSlot_injective (tapes.injective h) + +@[simp] theorem resetIdx_zero {n : ℕ} (tapes : EntryLookupRestoreTapes n) : + tapes.resetIdx 0 = tapes.scan.entry.address := rfl + +@[simp] theorem resetIdx_one {n : ℕ} (tapes : EntryLookupRestoreTapes n) : + tapes.resetIdx 1 = tapes.scan.entry.value := rfl + +@[simp] theorem resetIdx_two {n : ℕ} (tapes : EntryLookupRestoreTapes n) : + tapes.resetIdx 2 = tapes.scan.entry.addressCounter := rfl + +@[simp] theorem resetIdx_three {n : ℕ} (tapes : EntryLookupRestoreTapes n) : + tapes.resetIdx 3 = tapes.scan.entry.addressWidth := rfl + +@[simp] theorem resetIdx_four {n : ℕ} (tapes : EntryLookupRestoreTapes n) : + tapes.resetIdx 4 = tapes.scan.entry.valueCounter := rfl + +@[simp] theorem resetIdx_five {n : ℕ} (tapes : EntryLookupRestoreTapes n) : + tapes.resetIdx 5 = tapes.scan.entry.valueWidth := rfl + +@[simp] theorem resetIdx_six {n : ℕ} (tapes : EntryLookupRestoreTapes n) : + tapes.resetIdx 6 = tapes.scan.entry.result := rfl + +@[simp] theorem resetIdx_seven {n : ℕ} (tapes : EntryLookupRestoreTapes n) : + tapes.resetIdx 7 = tapes.scan.entry.query := rfl + +@[simp] theorem resetIdx_eight {n : ℕ} (tapes : EntryLookupRestoreTapes n) : + tapes.resetIdx 8 = tapes.scan.count := rfl + +end EntryLookupRestoreTapes + +/-- Scanner-owned tapes reset after copying out a lookup result. The encoded +source is deliberately excluded because it is read-only and merely rewound. -/ +def entryLookupResetTargets {n : ℕ} (tapes : EntryLookupRestoreTapes n) : + List (Fin n) := + List.ofFn tapes.resetIdx + +/-- Width envelope for every binary scratch value at a successful hit on one +entry. -/ +def entryLookupEntryWidth (entry : Entry) (address : ℕ) : ℕ := + max address.bits.length + (max entry.1.bits.length + (max entry.2.bits.length + (max (bitlen entry.1) + (max (bitlen entry.2) 1)))) + +/-- Width envelope contributed by possible hit entries in a complete store. -/ +def entryLookupStoreWidth (address : ℕ) : Store → ℕ + | [] => address.bits.length + | entry :: rest => + max (entryLookupEntryWidth entry address) + (entryLookupStoreWidth address rest) + +/-- Width envelope for every hit or miss reset target in a complete store. -/ +def entryLookupResetWidth (store : Store) (address : ℕ) : ℕ := + max store.length.bits.length (entryLookupStoreWidth address store) + +/-- Exact reset contents at a successful lookup endpoint. -/ +def entryLookupFoundBits {n : ℕ} (tapes : EntryLookupRestoreTapes n) + (entry : Entry) (remaining address : ℕ) (i : Fin n) : List Bool := + if i = tapes.scan.entry.query then address.bits + else if i = tapes.scan.count then remaining.bits + else entryMissBits tapes.scan.entry entry address.bits i + +/-- Exact reset contents at an unsuccessful lookup endpoint. -/ +def entryLookupMissBits {n : ℕ} (tapes : EntryLookupRestoreTapes n) + (address : ℕ) (i : Fin n) : List Bool := + if i = tapes.scan.entry.query then address.bits else [] + +-- These repetitive projection simplifications intentionally share one stable +-- simp set; individual cases use different subsets of it. +@[simp] theorem entryLookupFoundBits_zero {n : ℕ} + (tapes : EntryLookupRestoreTapes n) (entry : Entry) + (remaining address : ℕ) : + entryLookupFoundBits tapes entry remaining address + tapes.scan.entry.address = + entry.1.bits := by + simp [entryLookupFoundBits, entryMissBits, EntryLookupRestoreTapes.resetIdx, + EntryLookupRestoreTapes.resetSlot, EntryMatchTapes.address, + EntryMatchTapes.value, EntryMatchTapes.addressCounter, + EntryMatchTapes.addressWidth, EntryMatchTapes.valueCounter, + EntryMatchTapes.valueWidth, EntryMatchTapes.query, EntryMatchTapes.result, + tapes.injective.eq_iff] + +@[simp] theorem entryLookupFoundBits_one {n : ℕ} + (tapes : EntryLookupRestoreTapes n) (entry : Entry) + (remaining address : ℕ) : + entryLookupFoundBits tapes entry remaining address tapes.scan.entry.value = + entry.2.bits := by + simp [entryLookupFoundBits, entryMissBits, EntryLookupRestoreTapes.resetIdx, + EntryLookupRestoreTapes.resetSlot, EntryMatchTapes.address, + EntryMatchTapes.value, EntryMatchTapes.addressCounter, + EntryMatchTapes.addressWidth, EntryMatchTapes.valueCounter, + EntryMatchTapes.valueWidth, EntryMatchTapes.query, EntryMatchTapes.result, + tapes.injective.eq_iff] + +@[simp] theorem entryLookupFoundBits_two {n : ℕ} + (tapes : EntryLookupRestoreTapes n) (entry : Entry) + (remaining address : ℕ) : + entryLookupFoundBits tapes entry remaining address + tapes.scan.entry.addressCounter = + List.replicate (bitlen entry.1) true := by + simp [entryLookupFoundBits, entryMissBits, EntryLookupRestoreTapes.resetIdx, + EntryLookupRestoreTapes.resetSlot, EntryMatchTapes.address, + EntryMatchTapes.value, EntryMatchTapes.addressCounter, + EntryMatchTapes.addressWidth, EntryMatchTapes.valueCounter, + EntryMatchTapes.valueWidth, EntryMatchTapes.query, EntryMatchTapes.result, + tapes.injective.eq_iff] + +@[simp] theorem entryLookupFoundBits_three {n : ℕ} + (tapes : EntryLookupRestoreTapes n) (entry : Entry) + (remaining address : ℕ) : + entryLookupFoundBits tapes entry remaining address + tapes.scan.entry.addressWidth = + [] := by + simp [entryLookupFoundBits, entryMissBits, EntryLookupRestoreTapes.resetIdx, + EntryLookupRestoreTapes.resetSlot, EntryMatchTapes.address, + EntryMatchTapes.value, EntryMatchTapes.addressCounter, + EntryMatchTapes.addressWidth, EntryMatchTapes.valueCounter, + EntryMatchTapes.valueWidth, EntryMatchTapes.query, EntryMatchTapes.result, + tapes.injective.eq_iff] + +@[simp] theorem entryLookupFoundBits_four {n : ℕ} + (tapes : EntryLookupRestoreTapes n) (entry : Entry) + (remaining address : ℕ) : + entryLookupFoundBits tapes entry remaining address + tapes.scan.entry.valueCounter = + List.replicate (bitlen entry.2) true := by + simp [entryLookupFoundBits, entryMissBits, EntryLookupRestoreTapes.resetIdx, + EntryLookupRestoreTapes.resetSlot, EntryMatchTapes.address, + EntryMatchTapes.value, EntryMatchTapes.addressCounter, + EntryMatchTapes.addressWidth, EntryMatchTapes.valueCounter, + EntryMatchTapes.valueWidth, EntryMatchTapes.query, EntryMatchTapes.result, + tapes.injective.eq_iff] + +@[simp] theorem entryLookupFoundBits_five {n : ℕ} + (tapes : EntryLookupRestoreTapes n) (entry : Entry) + (remaining address : ℕ) : + entryLookupFoundBits tapes entry remaining address + tapes.scan.entry.valueWidth = + [] := by + simp [entryLookupFoundBits, entryMissBits, EntryLookupRestoreTapes.resetIdx, + EntryLookupRestoreTapes.resetSlot, EntryMatchTapes.address, + EntryMatchTapes.value, EntryMatchTapes.addressCounter, + EntryMatchTapes.addressWidth, EntryMatchTapes.valueCounter, + EntryMatchTapes.valueWidth, EntryMatchTapes.query, EntryMatchTapes.result, + tapes.injective.eq_iff] + +@[simp] theorem entryLookupFoundBits_six {n : ℕ} + (tapes : EntryLookupRestoreTapes n) (entry : Entry) + (remaining address : ℕ) : + entryLookupFoundBits tapes entry remaining address tapes.scan.entry.result = + [decide (entry.1.bits = address.bits)] := by + simp [entryLookupFoundBits, entryMissBits, EntryLookupRestoreTapes.resetIdx, + EntryLookupRestoreTapes.resetSlot, EntryMatchTapes.address, + EntryMatchTapes.value, EntryMatchTapes.addressCounter, + EntryMatchTapes.addressWidth, EntryMatchTapes.valueCounter, + EntryMatchTapes.valueWidth, EntryMatchTapes.query, EntryMatchTapes.result, + tapes.injective.eq_iff] + +@[simp] theorem entryLookupFoundBits_seven {n : ℕ} + (tapes : EntryLookupRestoreTapes n) (entry : Entry) + (remaining address : ℕ) : + entryLookupFoundBits tapes entry remaining address tapes.scan.entry.query = + address.bits := by + simp [entryLookupFoundBits, EntryLookupRestoreTapes.resetIdx, + EntryLookupRestoreTapes.resetSlot, EntryMatchTapes.query, + tapes.injective.eq_iff] + +@[simp] theorem entryLookupFoundBits_eight {n : ℕ} + (tapes : EntryLookupRestoreTapes n) (entry : Entry) + (remaining address : ℕ) : + entryLookupFoundBits tapes entry remaining address (tapes.idx 9) = + remaining.bits := by + simp [entryLookupFoundBits, EntryLookupRestoreTapes.resetIdx, + EntryLookupRestoreTapes.resetSlot, EntryMatchTapes.query, + tapes.injective.eq_iff] + +@[simp] theorem entryLookupMissBits_seven {n : ℕ} + (tapes : EntryLookupRestoreTapes n) (address : ℕ) : + entryLookupMissBits tapes address tapes.scan.entry.query = address.bits := by + simp [entryLookupMissBits, EntryLookupRestoreTapes.resetIdx, + EntryLookupRestoreTapes.resetSlot, EntryMatchTapes.query, + tapes.injective.eq_iff] + +@[simp] theorem entryLookupMissBits_zero {n : ℕ} + (tapes : EntryLookupRestoreTapes n) (address : ℕ) : + entryLookupMissBits tapes address tapes.scan.entry.address = [] := by + simp [entryLookupMissBits, EntryMatchTapes.address, EntryMatchTapes.query, + tapes.injective.eq_iff] + +@[simp] theorem entryLookupMissBits_one {n : ℕ} + (tapes : EntryLookupRestoreTapes n) (address : ℕ) : + entryLookupMissBits tapes address tapes.scan.entry.value = [] := by + simp [entryLookupMissBits, EntryMatchTapes.value, EntryMatchTapes.query, + tapes.injective.eq_iff] + +@[simp] theorem entryLookupMissBits_two {n : ℕ} + (tapes : EntryLookupRestoreTapes n) (address : ℕ) : + entryLookupMissBits tapes address tapes.scan.entry.addressCounter = [] := by + simp [entryLookupMissBits, EntryMatchTapes.addressCounter, + EntryMatchTapes.query, tapes.injective.eq_iff] + +@[simp] theorem entryLookupMissBits_three {n : ℕ} + (tapes : EntryLookupRestoreTapes n) (address : ℕ) : + entryLookupMissBits tapes address tapes.scan.entry.addressWidth = [] := by + simp [entryLookupMissBits, EntryMatchTapes.addressWidth, + EntryMatchTapes.query, tapes.injective.eq_iff] + +@[simp] theorem entryLookupMissBits_four {n : ℕ} + (tapes : EntryLookupRestoreTapes n) (address : ℕ) : + entryLookupMissBits tapes address tapes.scan.entry.valueCounter = [] := by + simp [entryLookupMissBits, EntryMatchTapes.valueCounter, + EntryMatchTapes.query, tapes.injective.eq_iff] + +@[simp] theorem entryLookupMissBits_five {n : ℕ} + (tapes : EntryLookupRestoreTapes n) (address : ℕ) : + entryLookupMissBits tapes address tapes.scan.entry.valueWidth = [] := by + simp [entryLookupMissBits, EntryMatchTapes.valueWidth, + EntryMatchTapes.query, tapes.injective.eq_iff] + +@[simp] theorem entryLookupMissBits_six {n : ℕ} + (tapes : EntryLookupRestoreTapes n) (address : ℕ) : + entryLookupMissBits tapes address tapes.scan.entry.result = [] := by + simp [entryLookupMissBits, EntryMatchTapes.result, EntryMatchTapes.query, + tapes.injective.eq_iff] + +@[simp] theorem entryLookupMissBits_eight {n : ℕ} + (tapes : EntryLookupRestoreTapes n) (address : ℕ) : + entryLookupMissBits tapes address (tapes.idx 9) = [] := by + simp [entryLookupMissBits, EntryMatchTapes.query, tapes.injective.eq_iff] + +@[simp] theorem entryLookupMissBits_other {n : ℕ} + (tapes : EntryLookupRestoreTapes n) (address : ℕ) (slot : Fin 9) + (hslot : slot ≠ 7) : + entryLookupMissBits tapes address (tapes.resetIdx slot) = [] := by + fin_cases slot <;> + simp_all [entryLookupMissBits, EntryLookupRestoreTapes.resetIdx, + EntryLookupRestoreTapes.resetSlot, EntryMatchTapes.query, + tapes.injective.eq_iff] +/-- Uniform scanner-head bound from a canonical cell-one start. -/ +def entryLookupRestoreHeadBound {n : ℕ} + (tapes : EntryLookupRestoreTapes n) (store : Store) (address : ℕ) : ℕ := + 1 + entryLookupTime tapes.scan address store + +/-- Reset budget obtained from the nine fixed owned targets and the common +head/width envelopes. -/ +def entryLookupResetTime {n : ℕ} (tapes : EntryLookupRestoreTapes n) + (store : Store) (address : ℕ) : ℕ := + 9 * (entryLookupRestoreHeadBound tapes store address + + 2 * entryLookupResetWidth store address + 9) + 1 + +/-- Restore scanner scratch, source cursor, and runtime count after a completed +lookup whose value has already been copied out. -/ +def entryLookupRestoreTailTM {n : ℕ} + (tapes : EntryLookupRestoreTapes n) : TM n := + TM.seqTM (TM.resetBinaryWorkManyTM (entryLookupResetTargets tapes)) + (TM.seqTM (TM.rewindWorkTM tapes.scan.entry.source) + (TM.binaryCopyIntoTM tapes.countSource tapes.scan.count + tapes.copyScratch)) + +/-- Copy out a lookup result, then restore the complete reusable scanner ABI. -/ +def entryLookupCopyRestoreTM {n : ℕ} + (tapes : EntryLookupRestoreTapes n) : TM n := + TM.seqTM (entryLookupTM tapes.scan) + (TM.seqTM (TM.rewindWorkTM tapes.scan.entry.value) + (TM.seqTM + (TM.binaryCopyIntoTM tapes.scan.entry.value tapes.destination + tapes.copyScratch) + (entryLookupRestoreTailTM tapes))) + +/-- Load the supplied query, perform one sparse lookup, copy out its value, and +return to the same reusable blank-query scanner boundary. -/ +def entryLookupLoadedTM {n : ℕ} (tapes : EntryLookupRestoreTapes n) : TM n := + TM.seqTM + (TM.binaryCopyIntoTM tapes.querySource tapes.scan.entry.query + tapes.copyScratch) + (entryLookupCopyRestoreTM tapes) + +/-- Time bound for scanner reset, source rewind, and count restoration. -/ +def entryLookupRestoreTailTime {n : ℕ} + (tapes : EntryLookupRestoreTapes n) (store : Store) (address : ℕ) : ℕ := + entryLookupResetTime tapes store address + 1 + + (entryLookupRestoreHeadBound tapes store address + 2 + 1 + + TM.binaryCopyTime store.length 0) + +/-- Time bound after the query has been prepared. -/ +def entryLookupCopyRestoreTime {n : ℕ} + (tapes : EntryLookupRestoreTapes n) (store : Store) (address : ℕ) : ℕ := + entryLookupTime tapes.scan address store + 1 + + (entryLookupRestoreHeadBound tapes store address + 2 + 1 + + (TM.binaryCopyTime (RegisterStore.read store address) 0 + 1 + + entryLookupRestoreTailTime tapes store address)) + +/-- Complete reusable loaded-lookup time bound. -/ +def entryLookupLoadedTime {n : ℕ} + (tapes : EntryLookupRestoreTapes n) (store : Store) (address : ℕ) : ℕ := + TM.binaryCopyTime address 0 + 1 + + entryLookupCopyRestoreTime tapes store address + +/-- Read a positive-tag sparse overlay and either decode the tag or fall back +to the immutable public-input bank on a sparse miss. -/ +def denseOverlayLookupTM {n : ℕ} (tapes : EntryLookupRestoreTapes n) : TM n := + TM.seqTM (entryLookupLoadedTM tapes) + (TM.branchWorkBlankTM tapes.destination + (denseInputLookupTM tapes.querySource tapes.scan.entry.address + tapes.destination tapes.copyScratch) + (TM.binaryPredTM tapes.destination)) + +/-- Complete reusable dense-overlay lookup budget. -/ +def denseOverlayLookupTime {n : ℕ} (tapes : EntryLookupRestoreTapes n) + (inputLength : ℕ) (overlay : Store) (address : ℕ) : ℕ := + entryLookupLoadedTime tapes overlay address + 1 + + TM.branchWorkBlankTime (denseInputLookupTime inputLength address) + (TM.binaryPredTime (RegisterStore.read overlay address - 1)) + +/-- Load one fixed address from canonical zero, read through the dense input +and sparse overlay, then clear the fixed-address source back to zero. -/ +def denseOverlayLookupStaticTM {n : ℕ} + (tapes : EntryLookupRestoreTapes n) (address : ℕ) : TM n := + TM.seqTM (TM.binaryAddConstTM tapes.querySource address) + (TM.seqTM (denseOverlayLookupTM tapes) + (TM.resetBinaryWorkTM tapes.querySource)) + +/-- Complete fixed-address dense-overlay lookup budget. -/ +def denseOverlayLookupStaticTime {n : ℕ} + (tapes : EntryLookupRestoreTapes n) (inputLength : ℕ) + (overlay : Store) (address : ℕ) : ℕ := + TM.binaryAddConstTime address 0 + 1 + + (denseOverlayLookupTime tapes inputLength overlay address + 1 + + TM.resetBinaryWorkTime 1 address.bits.length) + +/-- Load one fixed address from canonical zero, run a reusable lookup, then +clear the fixed-address source back to zero. -/ +def entryLookupStaticTM {n : ℕ} (tapes : EntryLookupRestoreTapes n) + (address : ℕ) : TM n := + TM.seqTM (TM.binaryAddConstTM tapes.querySource address) + (TM.seqTM (entryLookupLoadedTM tapes) + (TM.resetBinaryWorkTM tapes.querySource)) + +/-- Complete fixed-address lookup budget. -/ +def entryLookupStaticTime {n : ℕ} (tapes : EntryLookupRestoreTapes n) + (store : Store) (address : ℕ) : ℕ := + TM.binaryAddConstTime address 0 + 1 + + (entryLookupLoadedTime tapes store address + 1 + + TM.resetBinaryWorkTime 1 address.bits.length) + +/-- Canonical precondition for one reusable loaded lookup. -/ +structure EntryLookupRestoreReady {n : ℕ} + (tapes : EntryLookupRestoreTapes n) (store : Store) (address : ℕ) + (work : Fin n → Tape) : Prop where + scanner : EntryScanReady tapes.scan.entry (store.flatMap Entry.encode) [] + work work + sourceStart : (work tapes.scan.entry.source).cells 0 = Γ.start + sourceHead : (work tapes.scan.entry.source).head = 1 + count : (work tapes.scan.count).HasBinaryNat store.length + countSource : (work tapes.countSource).HasBinaryNat store.length + querySource : (work tapes.querySource).HasBinaryNat address + destination : (work tapes.destination).HasBinaryNat 0 + copyScratch : (work tapes.copyScratch).HasBinaryNat 0 + +/-- Canonical precondition for a fixed-address lookup whose query source starts +at zero and is restored to zero. -/ +structure EntryLookupStaticReady {n : ℕ} + (tapes : EntryLookupRestoreTapes n) (store : Store) + (work : Fin n → Tape) : Prop where + scanner : EntryScanReady tapes.scan.entry (store.flatMap Entry.encode) [] + work work + sourceStart : (work tapes.scan.entry.source).cells 0 = Γ.start + sourceHead : (work tapes.scan.entry.source).head = 1 + count : (work tapes.scan.count).HasBinaryNat store.length + countSource : (work tapes.countSource).HasBinaryNat store.length + querySource : (work tapes.querySource).HasBinaryNat 0 + destination : (work tapes.destination).HasBinaryNat 0 + copyScratch : (work tapes.copyScratch).HasBinaryNat 0 + +/-- Boundary after the external query has been copied into scanner storage. -/ +structure EntryLookupPrepared {n : ℕ} + (tapes : EntryLookupRestoreTapes n) (store : Store) (address : ℕ) + (initialWork work : Fin n → Tape) : Prop where + scanner : EntryScanReady tapes.scan.entry (store.flatMap Entry.encode) + address.bits work work + sourceStart : (work tapes.scan.entry.source).cells 0 = Γ.start + sourceHead : (work tapes.scan.entry.source).head = 1 + count : (work tapes.scan.count).HasBinaryNat store.length + countSource : work tapes.countSource = initialWork tapes.countSource + countSourceNat : (work tapes.countSource).HasBinaryNat store.length + querySource : work tapes.querySource = initialWork tapes.querySource + querySourceNat : (work tapes.querySource).HasBinaryNat address + destination : (work tapes.destination).HasBinaryNat 0 + copyScratch : (work tapes.copyScratch).HasBinaryNat 0 + parked : ∀ i, TM.Parked (work i) + frame : ∀ i, i ≠ tapes.scan.entry.query → work i = initialWork i + +/-- Uniform cleanup certificate extracted from either scanner outcome. -/ +def EntryLookupResetReady {n : ℕ} + (tapes : EntryLookupRestoreTapes n) (store : Store) (address : ℕ) + (work : Fin n → Tape) : Prop := + ∃ bits : Fin n → List Bool, + (∀ i, i ∈ entryLookupResetTargets tapes → + (work i).HasBinaryContent (bits i)) ∧ + (∀ i, i ∈ entryLookupResetTargets tapes → + (work i).cells 0 = Γ.start) ∧ + (∀ i, i ∈ entryLookupResetTargets tapes → + (bits i).length ≤ entryLookupResetWidth store address) ∧ + ∀ i, TM.Parked (work i) + +/-- Boundary after the bounded scanner has produced a semantic lookup result. +It retains the exact cleanup certificate, the read-only source image, a +uniform cursor bound, and the complete external frame needed by restoration. -/ +structure EntryLookupScanned {n : ℕ} + (tapes : EntryLookupRestoreTapes n) (store : Store) (address : ℕ) + (initialWork preparedWork work : Fin n → Tape) : Prop where + result : EntryLookupResult tapes.scan store address preparedWork work + resetReady : EntryLookupResetReady tapes store address work + sourceCells : (work tapes.scan.entry.source).cells = + (initialWork tapes.scan.entry.source).cells + sourceStart : (work tapes.scan.entry.source).cells 0 = Γ.start + sourceHeadBound : (work tapes.scan.entry.source).head ≤ + entryLookupRestoreHeadBound tapes store address + resetHeadBound : ∀ i, i ∈ entryLookupResetTargets tapes → + (work i).head ≤ entryLookupRestoreHeadBound tapes store address + countSource : work tapes.countSource = initialWork tapes.countSource + querySource : work tapes.querySource = initialWork tapes.querySource + destination : work tapes.destination = initialWork tapes.destination + copyScratch : work tapes.copyScratch = initialWork tapes.copyScratch + frame : ∀ i, (∀ slot, i ≠ tapes.idx slot) → + work i = initialWork i + +/-- Existentially packages the concrete prepared work family between query +copying and scanning, so subsequent phases can use a semantic Hoare boundary. -/ +def EntryLookupScannedReady {n : ℕ} + (tapes : EntryLookupRestoreTapes n) (store : Store) (address : ℕ) + (initialWork work : Fin n → Tape) : Prop := + ∃ preparedWork, + EntryLookupPrepared tapes store address initialWork preparedWork ∧ + EntryLookupScanned tapes store address initialWork preparedWork work + +/-- Stable semantic state carried through value rewind, value copy, scratch +reset, source rewind, and count restoration. -/ +structure EntryLookupRestoreInvariant {n : ℕ} + (tapes : EntryLookupRestoreTapes n) (store : Store) (address : ℕ) + (initialWork work : Fin n → Tape) : Prop where + valueContent : (work tapes.scan.entry.value).HasBinaryContent + (RegisterStore.read store address).bits + valueStart : (work tapes.scan.entry.value).cells 0 = Γ.start + resetReady : EntryLookupResetReady tapes store address work + sourceCells : (work tapes.scan.entry.source).cells = + (initialWork tapes.scan.entry.source).cells + sourceStart : (work tapes.scan.entry.source).cells 0 = Γ.start + sourceHeadBound : (work tapes.scan.entry.source).head ≤ + entryLookupRestoreHeadBound tapes store address + resetHeadBound : ∀ i, i ∈ entryLookupResetTargets tapes → + (work i).head ≤ entryLookupRestoreHeadBound tapes store address + countSource : work tapes.countSource = initialWork tapes.countSource + countSourceNat : (work tapes.countSource).HasBinaryNat store.length + querySource : work tapes.querySource = initialWork tapes.querySource + querySourceNat : (work tapes.querySource).HasBinaryNat address + copyScratch : work tapes.copyScratch = initialWork tapes.copyScratch + copyScratchNat : (work tapes.copyScratch).HasBinaryNat 0 + parked : ∀ i, TM.Parked (work i) + frame : ∀ i, (∀ slot, i ≠ tapes.idx slot) → + work i = initialWork i + +/-- The decoded value has been rewound to the canonical read boundary. -/ +structure EntryLookupValueReady {n : ℕ} + (tapes : EntryLookupRestoreTapes n) (store : Store) (address : ℕ) + (initialWork work : Fin n → Tape) : Prop where + restore : EntryLookupRestoreInvariant tapes store address initialWork work + value : (work tapes.scan.entry.value).HasBinaryNat + (RegisterStore.read store address) + destination : (work tapes.destination).HasBinaryNat 0 + +/-- The decoded value has been copied to the instruction operand tape while +all scanner restoration data remains available. -/ +structure EntryLookupCopied {n : ℕ} + (tapes : EntryLookupRestoreTapes n) (store : Store) (address : ℕ) + (initialWork work : Fin n → Tape) : Prop where + restore : EntryLookupRestoreInvariant tapes store address initialWork work + value : (work tapes.scan.entry.value).HasBinaryNat + (RegisterStore.read store address) + destination : (work tapes.destination).HasBinaryNat + (RegisterStore.read store address) + +/-- Exact boundary after all nine scanner-owned binary tapes have been reset. -/ +structure EntryLookupResetDone {n : ℕ} + (tapes : EntryLookupRestoreTapes n) (store : Store) (address : ℕ) + (initialWork copiedWork work : Fin n → Tape) : Prop where + copied : EntryLookupCopied tapes store address initialWork copiedWork + work_eq : work = TM.resetBinaryWorkManyResult copiedWork + (entryLookupResetTargets tapes) + +/-- Semantic form of the reset endpoint, stable while the encoded source is +rewound. -/ +structure EntryLookupScratchReset {n : ℕ} + (tapes : EntryLookupRestoreTapes n) (store : Store) (address : ℕ) + (initialWork work : Fin n → Tape) : Prop where + sourceCells : (work tapes.scan.entry.source).cells = + (initialWork tapes.scan.entry.source).cells + sourceStart : (work tapes.scan.entry.source).cells 0 = Γ.start + sourceHeadBound : (work tapes.scan.entry.source).head ≤ + entryLookupRestoreHeadBound tapes store address + targetsBlank : ∀ i, i ∈ entryLookupResetTargets tapes → + work i = TM.resetBinaryBlank + countSource : work tapes.countSource = initialWork tapes.countSource + countSourceNat : (work tapes.countSource).HasBinaryNat store.length + querySource : work tapes.querySource = initialWork tapes.querySource + querySourceNat : (work tapes.querySource).HasBinaryNat address + destination : (work tapes.destination).HasBinaryNat + (RegisterStore.read store address) + copyScratch : work tapes.copyScratch = initialWork tapes.copyScratch + copyScratchNat : (work tapes.copyScratch).HasBinaryNat 0 + parked : ∀ i, TM.Parked (work i) + frame : ∀ i, (∀ slot, i ≠ tapes.idx slot) → + work i = initialWork i + +/-- Boundary after scanner reset and encoded-source rewind, immediately before +the runtime entry count is copied back. -/ +structure EntryLookupSourceReady {n : ℕ} + (tapes : EntryLookupRestoreTapes n) (store : Store) (address : ℕ) + (initialWork work : Fin n → Tape) : Prop where + scanner : EntryScanReady tapes.scan.entry (store.flatMap Entry.encode) [] + work work + sourceCells : (work tapes.scan.entry.source).cells = + (initialWork tapes.scan.entry.source).cells + sourceStart : (work tapes.scan.entry.source).cells 0 = Γ.start + sourceHead : (work tapes.scan.entry.source).head = 1 + countZero : (work tapes.scan.count).HasBinaryNat 0 + countSource : work tapes.countSource = initialWork tapes.countSource + countSourceNat : (work tapes.countSource).HasBinaryNat store.length + querySource : work tapes.querySource = initialWork tapes.querySource + destination : (work tapes.destination).HasBinaryNat + (RegisterStore.read store address) + copyScratch : work tapes.copyScratch = initialWork tapes.copyScratch + copyScratchNat : (work tapes.copyScratch).HasBinaryNat 0 + parked : ∀ i, TM.Parked (work i) + frame : ∀ i, (∀ slot, i ≠ tapes.idx slot) → + work i = initialWork i + +/-- Reusable endpoint after one loaded sparse-register read. -/ +structure EntryLookupRestoreResult {n : ℕ} + (tapes : EntryLookupRestoreTapes n) (store : Store) (address : ℕ) + (initialWork finalWork : Fin n → Tape) : Prop where + scanner : EntryScanReady tapes.scan.entry (store.flatMap Entry.encode) [] + finalWork finalWork + sourceCells : (finalWork tapes.scan.entry.source).cells = + (initialWork tapes.scan.entry.source).cells + sourceStart : (finalWork tapes.scan.entry.source).cells 0 = Γ.start + sourceHead : (finalWork tapes.scan.entry.source).head = 1 + count : (finalWork tapes.scan.count).HasBinaryNat store.length + countSource : finalWork tapes.countSource = initialWork tapes.countSource + querySource : finalWork tapes.querySource = initialWork tapes.querySource + value : (finalWork tapes.destination).HasBinaryNat + (RegisterStore.read store address) + copyScratch : (finalWork tapes.copyScratch).HasBinaryNat 0 + parked : ∀ i, TM.Parked (finalWork i) + frame : ∀ i, (∀ slot, i ≠ tapes.idx slot) → + finalWork i = initialWork i + +/-- Reusable endpoint after reading through a tagged mutable overlay into the +immutable public-input bank. -/ +structure DenseOverlayLookupResult {n : ℕ} + (tapes : EntryLookupRestoreTapes n) (input : List Bool) + (overlay : Store) (address : ℕ) + (initialWork finalWork : Fin n → Tape) : Prop where + scanner : EntryScanReady tapes.scan.entry (overlay.flatMap Entry.encode) [] + finalWork finalWork + sourceCells : (finalWork tapes.scan.entry.source).cells = + (initialWork tapes.scan.entry.source).cells + sourceStart : (finalWork tapes.scan.entry.source).cells 0 = Γ.start + sourceHead : (finalWork tapes.scan.entry.source).head = 1 + count : (finalWork tapes.scan.count).HasBinaryNat overlay.length + countSource : finalWork tapes.countSource = initialWork tapes.countSource + querySource : finalWork tapes.querySource = initialWork tapes.querySource + value : (finalWork tapes.destination).HasBinaryNat + (DenseOverlay.read input overlay address) + copyScratch : (finalWork tapes.copyScratch).HasBinaryNat 0 + parked : ∀ i, TM.Parked (finalWork i) + frame : ∀ i, (∀ slot, i ≠ tapes.idx slot) → + finalWork i = initialWork i + +/-- Reusable fixed-address dense-overlay endpoint. The destination contains +the decoded register value and the temporary query source is zero again. -/ +structure DenseOverlayLookupStaticResult {n : ℕ} + (tapes : EntryLookupRestoreTapes n) (input : List Bool) + (overlay : Store) (address : ℕ) + (initialWork finalWork : Fin n → Tape) : Prop where + scanner : EntryScanReady tapes.scan.entry (overlay.flatMap Entry.encode) [] + finalWork finalWork + sourceCells : (finalWork tapes.scan.entry.source).cells = + (initialWork tapes.scan.entry.source).cells + sourceStart : (finalWork tapes.scan.entry.source).cells 0 = Γ.start + sourceHead : (finalWork tapes.scan.entry.source).head = 1 + count : (finalWork tapes.scan.count).HasBinaryNat overlay.length + countSource : finalWork tapes.countSource = initialWork tapes.countSource + querySource : (finalWork tapes.querySource).HasBinaryNat 0 + destination : (finalWork tapes.destination).HasBinaryNat + (DenseOverlay.read input overlay address) + copyScratch : (finalWork tapes.copyScratch).HasBinaryNat 0 + parked : ∀ i, TM.Parked (finalWork i) + frame : ∀ i, (∀ slot, i ≠ tapes.idx slot) → + finalWork i = initialWork i + +/-- Reusable fixed-address endpoint. The destination holds the semantic read, +the scanner is restored, and the fixed query source is zero again. -/ +structure EntryLookupStaticResult {n : ℕ} + (tapes : EntryLookupRestoreTapes n) (store : Store) (address : ℕ) + (initialWork finalWork : Fin n → Tape) : Prop where + scanner : EntryScanReady tapes.scan.entry (store.flatMap Entry.encode) [] + finalWork finalWork + sourceCells : (finalWork tapes.scan.entry.source).cells = + (initialWork tapes.scan.entry.source).cells + sourceStart : (finalWork tapes.scan.entry.source).cells 0 = Γ.start + sourceHead : (finalWork tapes.scan.entry.source).head = 1 + count : (finalWork tapes.scan.count).HasBinaryNat store.length + countSource : finalWork tapes.countSource = initialWork tapes.countSource + querySource : (finalWork tapes.querySource).HasBinaryNat 0 + destination : (finalWork tapes.destination).HasBinaryNat + (RegisterStore.read store address) + copyScratch : (finalWork tapes.copyScratch).HasBinaryNat 0 + parked : ∀ i, TM.Parked (finalWork i) + frame : ∀ i, (∀ slot, i ≠ tapes.idx slot) → + finalWork i = initialWork i + +end Machine + +end RegisterStore + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/DenseInternal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/DenseInternal.lean new file mode 100644 index 0000000000..0443ceabaf --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/DenseInternal.lean @@ -0,0 +1,586 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Internal.Static +public import +LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.DenseInputLookup.Internal + +/-! +# Dense overlay lookup -- proof internals +-/ + + +public section + +namespace Complexity +namespace RAM +namespace RegisterStore +namespace Machine + +variable {n : ℕ} + +private theorem denseOverlayResult_of_destination_update + (tapes : EntryLookupRestoreTapes n) (input : List Bool) + (overlay : Store) (address : ℕ) + (initialWork loadedWork finalWork : Fin n → Tape) + (hloaded : EntryLookupRestoreResult tapes overlay address initialWork + loadedWork) + (hvalue : (finalWork tapes.destination).HasBinaryNat + (DenseOverlay.read input overlay address)) + (hother : ∀ i, i ≠ tapes.destination → + finalWork i = loadedWork i) + (hparked : ∀ i, TM.Parked (finalWork i)) : + DenseOverlayLookupResult tapes input overlay address initialWork + finalWork := by + constructor + · constructor + · rw [hother tapes.scan.entry.source (tapes.scan_ne_external 0 2)] + exact hloaded.scanner.source + · rw [hother tapes.scan.entry.address (tapes.scan_ne_external 1 2)] + exact hloaded.scanner.address + · rw [hother tapes.scan.entry.address (tapes.scan_ne_external 1 2)] + exact hloaded.scanner.addressStart + · rw [hother tapes.scan.entry.value (tapes.scan_ne_external 2 2)] + exact hloaded.scanner.value + · rw [hother tapes.scan.entry.value (tapes.scan_ne_external 2 2)] + exact hloaded.scanner.valueStart + · rw [hother tapes.scan.entry.addressCounter + (tapes.scan_ne_external 3 2)] + exact hloaded.scanner.addressCounter + · rw [hother tapes.scan.entry.addressWidth + (tapes.scan_ne_external 4 2)] + exact hloaded.scanner.addressWidth + · rw [hother tapes.scan.entry.valueCounter + (tapes.scan_ne_external 5 2)] + exact hloaded.scanner.valueCounter + · rw [hother tapes.scan.entry.valueWidth + (tapes.scan_ne_external 6 2)] + exact hloaded.scanner.valueWidth + · rw [hother tapes.scan.entry.query (tapes.scan_ne_external 7 2)] + exact hloaded.scanner.query + · rw [hother tapes.scan.entry.query (tapes.scan_ne_external 7 2)] + exact hloaded.scanner.queryStart + · rw [hother tapes.scan.entry.result (tapes.scan_ne_external 8 2)] + exact hloaded.scanner.result + · rw [hother tapes.scan.entry.result (tapes.scan_ne_external 8 2)] + exact hloaded.scanner.resultStart + · exact hparked + · intro i _ _ _ _ _ _ _ _ _ + rfl + · rw [hother tapes.scan.entry.source (tapes.scan_ne_external 0 2)] + exact hloaded.sourceCells + · rw [hother tapes.scan.entry.source (tapes.scan_ne_external 0 2)] + exact hloaded.sourceStart + · rw [hother tapes.scan.entry.source (tapes.scan_ne_external 0 2)] + exact hloaded.sourceHead + · rw [hother tapes.scan.count (tapes.scan_ne_external 9 2)] + exact hloaded.count + · rw [hother tapes.countSource tapes.countSource_ne_destination] + exact hloaded.countSource + · rw [hother tapes.querySource tapes.querySource_ne_destination] + exact hloaded.querySource + · exact hvalue + · rw [hother tapes.copyScratch tapes.destination_ne_copyScratch.symm] + exact hloaded.copyScratch + · exact hparked + · intro i hi + rw [hother i (hi 12)] + exact hloaded.frame i hi + +private theorem denseOverlayResult_of_fallback + (tapes : EntryLookupRestoreTapes n) (input : List Bool) + (overlay : Store) (address : ℕ) + (initialWork loadedWork finalWork : Fin n → Tape) + (hloaded : EntryLookupRestoreResult tapes overlay address initialWork + loadedWork) + (htagZero : RegisterStore.read overlay address = 0) + (hfallback : DenseInputLookupResult tapes.querySource + tapes.scan.entry.address tapes.destination tapes.copyScratch input address + loadedWork finalWork) : + DenseOverlayLookupResult tapes input overlay address initialWork + finalWork := by + have hscanFrame : ∀ slot : Fin 9, slot ≠ 1 → + finalWork (tapes.scan.entry.idx slot) = + loadedWork (tapes.scan.entry.idx slot) := by + intro slot hslot + exact hfallback.frame _ + (tapes.scan_ne_external ⟨slot.val, by omega⟩ 1) + (tapes.scan.entry.ne hslot) + (tapes.scan_ne_external ⟨slot.val, by omega⟩ 2) + (tapes.scan_ne_external ⟨slot.val, by omega⟩ 3) + have hcountFrame : finalWork tapes.scan.count = + loadedWork tapes.scan.count := by + exact hfallback.frame _ (tapes.scan_ne_external 9 1) + (tapes.scan.count_ne 1) (tapes.scan_ne_external 9 2) + (tapes.scan_ne_external 9 3) + have hsourceFrame : finalWork tapes.scan.entry.source = + loadedWork tapes.scan.entry.source := by + exact hscanFrame 0 (by decide) + have hvalueFrame : finalWork tapes.scan.entry.value = + loadedWork tapes.scan.entry.value := by + exact hscanFrame 2 (by decide) + have haddressCounterFrame : finalWork tapes.scan.entry.addressCounter = + loadedWork tapes.scan.entry.addressCounter := by + exact hscanFrame 3 (by decide) + have haddressWidthFrame : finalWork tapes.scan.entry.addressWidth = + loadedWork tapes.scan.entry.addressWidth := by + exact hscanFrame 4 (by decide) + have hvalueCounterFrame : finalWork tapes.scan.entry.valueCounter = + loadedWork tapes.scan.entry.valueCounter := by + exact hscanFrame 5 (by decide) + have hvalueWidthFrame : finalWork tapes.scan.entry.valueWidth = + loadedWork tapes.scan.entry.valueWidth := by + exact hscanFrame 6 (by decide) + have hqueryFrame : finalWork tapes.scan.entry.query = + loadedWork tapes.scan.entry.query := by + exact hscanFrame 7 (by decide) + have hresultFrame : finalWork tapes.scan.entry.result = + loadedWork tapes.scan.entry.result := by + exact hscanFrame 8 (by decide) + constructor + · constructor + · rw [hsourceFrame] + exact hloaded.scanner.source + · exact hfallback.counter_zero.2 + · exact hfallback.counter_zero.1 + · rw [hvalueFrame] + exact hloaded.scanner.value + · rw [hvalueFrame] + exact hloaded.scanner.valueStart + · rw [haddressCounterFrame] + exact hloaded.scanner.addressCounter + · rw [haddressWidthFrame] + exact hloaded.scanner.addressWidth + · rw [hvalueCounterFrame] + exact hloaded.scanner.valueCounter + · rw [hvalueWidthFrame] + exact hloaded.scanner.valueWidth + · rw [hqueryFrame] + exact hloaded.scanner.query + · rw [hqueryFrame] + exact hloaded.scanner.queryStart + · rw [hresultFrame] + exact hloaded.scanner.result + · rw [hresultFrame] + exact hloaded.scanner.resultStart + · exact hfallback.parked + · intro i _ _ _ _ _ _ _ _ _ + rfl + · rw [hsourceFrame] + exact hloaded.sourceCells + · rw [hsourceFrame] + exact hloaded.sourceStart + · rw [hsourceFrame] + exact hloaded.sourceHead + · rw [hcountFrame] + exact hloaded.count + · rw [hfallback.frame tapes.countSource + tapes.countSource_ne_querySource + (tapes.scan_ne_external 1 0).symm + tapes.countSource_ne_destination + tapes.countSource_ne_copyScratch] + exact hloaded.countSource + · exact hfallback.query_eq.trans hloaded.querySource + · simpa [DenseOverlay.read, htagZero] using hfallback.result_value + · rw [hfallback.scratch_eq] + exact hloaded.copyScratch + · exact hfallback.parked + · intro i hi + rw [hfallback.frame i (hi 11) (hi 1) (hi 12) (hi 13)] + exact hloaded.frame i hi + +theorem denseOverlayLookupTM_hoareTime_internal + (tapes : EntryLookupRestoreTapes n) (input : List Bool) + (overlay : Store) (address : ℕ) (initialWork : Fin n → Tape) + (out₀ : Tape) (hvalid : DenseOverlay.Valid overlay) + (hready : EntryLookupRestoreReady tapes overlay address initialWork) + (houtput : TM.Parked out₀) : + (denseOverlayLookupTM tapes).HoareTime + (fun inp work out => + inp = (Tape.init (input.map Γ.ofBool)).move Dir3.right ∧ + work = initialWork ∧ out = out₀) + (fun inp work out => + inp = (Tape.init (input.map Γ.ofBool)).move Dir3.right ∧ + DenseOverlayLookupResult tapes input overlay address initialWork work ∧ + out = out₀) + (denseOverlayLookupTime tapes input.length overlay address) := by + let inp₀ := (Tape.init (input.map Γ.ofBool)).move Dir3.right + let lookupPost : TM.TapePred n := fun inp work out => + inp = inp₀ ∧ + EntryLookupRestoreResult tapes overlay address initialWork work ∧ + out = out₀ + let finalPost : TM.TapePred n := fun inp work out => + inp = inp₀ ∧ + DenseOverlayLookupResult tapes input overlay address initialWork work ∧ + out = out₀ + let blankPre : TM.TapePred n := fun inp work out => + lookupPost inp work out ∧ (work tapes.destination).read = Γ.blank + let nonblankPre : TM.TapePred n := fun inp work out => + lookupPost inp work out ∧ (work tapes.destination).read ≠ Γ.blank + have hinput : TM.Parked inp₀ := by + refine ⟨by simp [inp₀, Tape.move], ?_⟩ + simpa [inp₀] using Tape.init_ofBool_move_right_cells_ne_start input + have hlookup := entryLookupLoaded_hoareTime_internal tapes overlay address + initialWork inp₀ out₀ hready hinput houtput + have hblank : + (denseInputLookupTM tapes.querySource tapes.scan.entry.address + tapes.destination tapes.copyScratch).HoareTime + blankPre finalPost (denseInputLookupTime input.length address) := by + intro inp work out ⟨⟨hinp, hloaded, hout⟩, hread⟩ + have htagZero : RegisterStore.read overlay address = 0 := + hloaded.value.read_eq_blank_iff.mp hread + have haddress : address ≠ 0 := by + intro hzero + subst address + exact hvalid.2 htagZero + have hcounter : + (work tapes.scan.entry.address).HasBinaryNat 0 := by + refine ⟨hloaded.scanner.addressStart, ?_⟩ + simpa [Tape.HasBinaryString, Tape.HasBinaryPrefix] using + hloaded.scanner.address + have hdenseReady : DenseInputLookupReady tapes.querySource + tapes.scan.entry.address tapes.destination tapes.copyScratch address + work := by + constructor + · rw [hloaded.querySource] + exact hready.querySource + · exact hcounter + · simpa [htagZero] using hloaded.value + · exact hloaded.copyScratch + · exact hloaded.parked + have hdense := denseInputLookupTM_hoareTime_internal + tapes.querySource tapes.scan.entry.address tapes.destination + tapes.copyScratch (tapes.scan_ne_external 1 1).symm + tapes.querySource_ne_destination tapes.querySource_ne_copyScratch + (tapes.scan_ne_external 1 2) (tapes.scan_ne_external 1 3) + tapes.destination_ne_copyScratch input address work out haddress + hdenseReady (by simpa [hout] using houtput) + obtain ⟨done, time, htime, hreach, hhalt, hdoneInput, + hdenseResult, hdoneOutput⟩ := + hdense inp work out ⟨hinp, rfl, rfl⟩ + exact ⟨done, time, htime, hreach, hhalt, hdoneInput, + denseOverlayResult_of_fallback tapes input overlay address initialWork + work done.work hloaded htagZero hdenseResult, + hdoneOutput.trans hout⟩ + have hnonblank : (TM.binaryPredTM tapes.destination).HoareTime + nonblankPre finalPost + (TM.binaryPredTime (RegisterStore.read overlay address - 1)) := by + intro inp work out ⟨⟨hinp, hloaded, hout⟩, hread⟩ + have htagNonzero : RegisterStore.read overlay address ≠ 0 := by + intro hzero + have hblankRead := hloaded.value.read_eq_blank_iff.mpr hzero + exact hread hblankRead + have htagSucc : RegisterStore.read overlay address - 1 + 1 = + RegisterStore.read overlay address := by omega + have hpredValue : (work tapes.destination).HasBinaryNat + (RegisterStore.read overlay address - 1 + 1) := by + rw [htagSucc] + exact hloaded.value + have hpred := TM.binaryPredTM_hoareTime_frame tapes.destination + (RegisterStore.read overlay address - 1) inp work out hpredValue + (by simpa [hinp] using hinput.read_ne_start) + (fun i _ => (hloaded.parked i).read_ne_start) + (by simpa [hout] using houtput.read_ne_start) + obtain ⟨done, time, htime, hreach, hhalt, hdoneInput, + hdoneOther, hdoneValue, hdoneOutput⟩ := + hpred inp work out ⟨rfl, rfl, rfl⟩ + have hdenseValue : (done.work tapes.destination).HasBinaryNat + (DenseOverlay.read input overlay address) := by + simpa [DenseOverlay.read, htagNonzero] using hdoneValue + have hdoneParked : ∀ i, TM.Parked (done.work i) := by + intro i + by_cases hi : i = tapes.destination + · subst i + exact ⟨by rw [hdoneValue.2.1], + hdoneValue.2.hasBinaryContent.cells_ne_start⟩ + · rw [hdoneOther i hi] + exact hloaded.parked i + exact ⟨done, time, htime, hreach, hhalt, + hdoneInput.trans hinp, + denseOverlayResult_of_destination_update tapes input overlay address + initialWork work done.work hloaded hdenseValue hdoneOther hdoneParked, + hdoneOutput.trans hout⟩ + have hbranchRaw := TM.branchWorkBlankTM_hoareTime tapes.destination + (denseInputLookupTM tapes.querySource tapes.scan.entry.address + tapes.destination tapes.copyScratch) + (TM.binaryPredTM tapes.destination) + (pre := lookupPost) (blankPre := blankPre) + (nonblankPre := nonblankPre) + (blankPost := finalPost) (nonblankPost := finalPost) + (by + intro inp work out ⟨hinp, hloaded, hout⟩ + exact ⟨by simpa [hinp] using hinput.read_ne_start, + fun i => (hloaded.parked i).read_ne_start, + by simpa [hout] using houtput.read_ne_start⟩) + (by + intro inp work out hpost hread + exact ⟨hpost, hread⟩) + (by + intro inp work out hpost hread + exact ⟨hpost, hread⟩) + hblank hnonblank + have hbranch : + (TM.branchWorkBlankTM tapes.destination + (denseInputLookupTM tapes.querySource tapes.scan.entry.address + tapes.destination tapes.copyScratch) + (TM.binaryPredTM tapes.destination)).HoareTime + lookupPost finalPost + (TM.branchWorkBlankTime (denseInputLookupTime input.length address) + (TM.binaryPredTime + (RegisterStore.read overlay address - 1))) := by + intro inp work out hpost + obtain ⟨done, time, htime, hreach, hhalt, hfinal⟩ := + hbranchRaw inp work out hpost + exact ⟨done, time, htime, hreach, hhalt, hfinal.elim id id⟩ + have htransition : ∀ inp work out, lookupPost inp work out → + lookupPost (TM.transitionInput inp) + (fun i => TM.transitionTape (work i)) (TM.transitionTape out) := by + intro inp work out ⟨hinp, hloaded, hout⟩ + subst inp + subst out + obtain ⟨hi, hw, ho⟩ := TM.phaseTransition_eq_self_of_reads_ne_start + hinput.read_ne_start + (fun i => (hloaded.parked i).read_ne_start) + houtput.read_ne_start + rw [hi, hw, ho] + exact ⟨rfl, hloaded, rfl⟩ + have hall := TM.seqTM_hoareTime (entryLookupLoadedTM tapes) + (TM.branchWorkBlankTM tapes.destination + (denseInputLookupTM tapes.querySource tapes.scan.entry.address + tapes.destination tapes.copyScratch) + (TM.binaryPredTM tapes.destination)) + hlookup htransition hbranch + simpa [denseOverlayLookupTM, denseOverlayLookupTime, inp₀, lookupPost, + finalPost] using hall + +private theorem denseStaticReset_result + (tapes : EntryLookupRestoreTapes n) (input : List Bool) + (overlay : Store) (address : ℕ) + (initialWork loadedWork : Fin n → Tape) + (hloaded : DenseOverlayLookupResult tapes input overlay address + (Function.update initialWork tapes.querySource + ((Tape.init (address.bits.map Γ.ofBool)).move Dir3.right)) + loadedWork) : + DenseOverlayLookupStaticResult tapes input overlay address initialWork + (Function.update loadedWork tapes.querySource + ((Tape.init []).move Dir3.right)) := by + let finalWork := Function.update loadedWork tapes.querySource + ((Tape.init []).move Dir3.right) + have hsource : tapes.scan.entry.source ≠ tapes.querySource := + tapes.ne (by decide) + have haddress : tapes.scan.entry.address ≠ tapes.querySource := + tapes.ne (by decide) + have hvalue : tapes.scan.entry.value ≠ tapes.querySource := + tapes.ne (by decide) + have haddressCounter : + tapes.scan.entry.addressCounter ≠ tapes.querySource := + tapes.ne (by decide) + have haddressWidth : tapes.scan.entry.addressWidth ≠ tapes.querySource := + tapes.ne (by decide) + have hvalueCounter : tapes.scan.entry.valueCounter ≠ tapes.querySource := + tapes.ne (by decide) + have hvalueWidth : tapes.scan.entry.valueWidth ≠ tapes.querySource := + tapes.ne (by decide) + have hquery : tapes.scan.entry.query ≠ tapes.querySource := + tapes.ne (by decide) + have hresult : tapes.scan.entry.result ≠ tapes.querySource := + tapes.ne (by decide) + have hcount : tapes.scan.count ≠ tapes.querySource := + tapes.ne (by decide) + have hcountSource : tapes.countSource ≠ tapes.querySource := + tapes.countSource_ne_querySource + have hdestination : tapes.destination ≠ tapes.querySource := + tapes.querySource_ne_destination.symm + have hcopyScratch : tapes.copyScratch ≠ tapes.querySource := + tapes.querySource_ne_copyScratch.symm + have hzero : ((Tape.init []).move Dir3.right).HasBinaryNat 0 := by + simpa using Tape.init_move_right_hasBinaryNat 0 + have hscanner : EntryScanReady tapes.scan.entry + (overlay.flatMap Entry.encode) [] finalWork finalWork := by + refine + { source := ?_ + address := ?_ + addressStart := ?_ + value := ?_ + valueStart := ?_ + addressCounter := ?_ + addressWidth := ?_ + valueCounter := ?_ + valueWidth := ?_ + query := ?_ + queryStart := ?_ + result := ?_ + resultStart := ?_ + parked := ?_ + frame := by intro i _ _ _ _ _ _ _ _ _; rfl } + · simpa only [finalWork, Function.update_of_ne hsource] using + hloaded.scanner.source + · simpa only [finalWork, Function.update_of_ne haddress] using + hloaded.scanner.address + · simpa only [finalWork, Function.update_of_ne haddress] using + hloaded.scanner.addressStart + · simpa only [finalWork, Function.update_of_ne hvalue] using + hloaded.scanner.value + · simpa only [finalWork, Function.update_of_ne hvalue] using + hloaded.scanner.valueStart + · simpa only [finalWork, Function.update_of_ne haddressCounter] using + hloaded.scanner.addressCounter + · simpa only [finalWork, Function.update_of_ne haddressWidth] using + hloaded.scanner.addressWidth + · simpa only [finalWork, Function.update_of_ne hvalueCounter] using + hloaded.scanner.valueCounter + · simpa only [finalWork, Function.update_of_ne hvalueWidth] using + hloaded.scanner.valueWidth + · simpa only [finalWork, Function.update_of_ne hquery] using + hloaded.scanner.query + · simpa only [finalWork, Function.update_of_ne hquery] using + hloaded.scanner.queryStart + · simpa only [finalWork, Function.update_of_ne hresult] using + hloaded.scanner.result + · simpa only [finalWork, Function.update_of_ne hresult] using + hloaded.scanner.resultStart + · intro i + by_cases hi : i = tapes.querySource + · subst i + exact ⟨by + simpa only [finalWork, Function.update_self] using + (show 1 ≤ ((Tape.init []).move Dir3.right).head by + rw [hzero.2.1]), + by simpa only [finalWork, Function.update_self] using + hzero.2.hasBinaryContent.cells_ne_start⟩ + · simpa only [finalWork, Function.update_of_ne hi] using hloaded.parked i + refine + { scanner := hscanner + sourceCells := ?_ + sourceStart := ?_ + sourceHead := ?_ + count := ?_ + countSource := ?_ + querySource := ?_ + destination := ?_ + copyScratch := ?_ + parked := hscanner.parked + frame := ?_ } + · simpa only [finalWork, Function.update_of_ne hsource] using + hloaded.sourceCells + · simpa only [finalWork, Function.update_of_ne hsource] using + hloaded.sourceStart + · simpa only [finalWork, Function.update_of_ne hsource] using + hloaded.sourceHead + · simpa only [finalWork, Function.update_of_ne hcount] using hloaded.count + · simp only [hloaded.countSource, Function.update_of_ne hcountSource] + · simpa only [finalWork, Function.update_self] using hzero + · simpa only [finalWork, Function.update_of_ne hdestination] using + hloaded.value + · simpa only [finalWork, Function.update_of_ne hcopyScratch] using + hloaded.copyScratch + · intro i hi + have hquerySource : i ≠ tapes.querySource := hi 11 + rw [Function.update_of_ne hquerySource] + rw [hloaded.frame i hi] + exact Function.update_of_ne hquerySource _ initialWork + +theorem denseOverlayLookupStaticTM_hoareTime_internal + (tapes : EntryLookupRestoreTapes n) (input : List Bool) + (overlay : Store) (address : ℕ) (initialWork : Fin n → Tape) + (out₀ : Tape) (hvalid : DenseOverlay.Valid overlay) + (hready : EntryLookupStaticReady tapes overlay initialWork) + (houtput : TM.Parked out₀) : + (denseOverlayLookupStaticTM tapes address).HoareTime + (fun inp work out => + inp = (Tape.init (input.map Γ.ofBool)).move Dir3.right ∧ + work = initialWork ∧ out = out₀) + (fun inp work out => + inp = (Tape.init (input.map Γ.ofBool)).move Dir3.right ∧ + DenseOverlayLookupStaticResult tapes input overlay address initialWork + work ∧ out = out₀) + (denseOverlayLookupStaticTime tapes input.length overlay address) := by + let inp₀ := (Tape.init (input.map Γ.ofBool)).move Dir3.right + let loadedInitial := Function.update initialWork tapes.querySource + ((Tape.init (address.bits.map Γ.ofBool)).move Dir3.right) + have hinput : TM.Parked inp₀ := by + refine ⟨by simp [inp₀, Tape.move], ?_⟩ + simpa [inp₀] using Tape.init_ofBool_move_right_cells_ne_start input + have hadd := TM.binaryAddConstTM_hoareTime_frame tapes.querySource address 0 + inp₀ initialWork out₀ hready.querySource hinput + (fun i _ => hready.scanner.parked i) houtput + have hadd' : (TM.binaryAddConstTM tapes.querySource address).HoareTime + (fun inp work out => inp = inp₀ ∧ work = initialWork ∧ out = out₀) + (fun inp work out => inp = inp₀ ∧ work = loadedInitial ∧ out = out₀) + (TM.binaryAddConstTime address 0) := by + simpa only [loadedInitial, zero_add] using hadd + have hloadedReady : + EntryLookupRestoreReady tapes overlay address loadedInitial := by + simpa only [loadedInitial, zero_add] using + staticAdd_ready_internal tapes overlay address initialWork hready + have hloaded := denseOverlayLookupTM_hoareTime_internal tapes input overlay + address loadedInitial out₀ hvalid hloadedReady houtput + have hreset : (TM.resetBinaryWorkTM tapes.querySource).HoareTime + (fun inp work out => + inp = inp₀ ∧ + DenseOverlayLookupResult tapes input overlay address loadedInitial work ∧ + out = out₀) + (fun inp work out => + inp = inp₀ ∧ + DenseOverlayLookupStaticResult tapes input overlay address initialWork + work ∧ out = out₀) + (TM.resetBinaryWorkTime 1 address.bits.length) := by + rintro inp work out ⟨hinp, hlookup, hout⟩ + have hqueryNat : (work tapes.querySource).HasBinaryNat address := by + rw [hlookup.querySource] + simpa only [loadedInitial, Function.update_self] using + Tape.init_move_right_hasBinaryNat address + have hrun := TM.resetBinaryWorkTM_hoareTime_frame tapes.querySource + address.bits 1 inp work out hqueryNat.2.hasBinaryContent hqueryNat.1 + ⟨by rw [hqueryNat.2.1], by rw [hqueryNat.2.1]⟩ + (by simpa [hinp] using hinput) + (fun i _ => hlookup.parked i) + (by simpa [hout] using houtput) + obtain ⟨final, time, htime, hreach, hhalt, hfinalInput, + hfinalWork, hfinalOutput⟩ := + hrun inp work out ⟨rfl, rfl, rfl⟩ + exact ⟨final, time, htime, hreach, hhalt, hfinalInput.trans hinp, + (by + rw [hfinalWork] + exact denseStaticReset_result tapes input overlay address initialWork + work hlookup), + hfinalOutput.trans hout⟩ + have hloadedReset := TM.seqTM_hoareTime (denseOverlayLookupTM tapes) + (TM.resetBinaryWorkTM tapes.querySource) hloaded + (by + rintro inp work out ⟨hinp, hlookup, hout⟩ + subst inp + subst out + obtain ⟨hi, hw, ho⟩ := TM.phaseTransition_eq_self_of_reads_ne_start + hinput.read_ne_start (fun i => (hlookup.parked i).read_ne_start) + houtput.read_ne_start + rw [hi, hw, ho] + exact ⟨rfl, hlookup, rfl⟩) + hreset + have hall := TM.seqTM_hoareTime + (TM.binaryAddConstTM tapes.querySource address) + (TM.seqTM (denseOverlayLookupTM tapes) + (TM.resetBinaryWorkTM tapes.querySource)) hadd' + (by + rintro inp work out ⟨hinp, hwork, hout⟩ + subst work + obtain ⟨hi, hw, ho⟩ := TM.phaseTransition_eq_self_of_reads_ne_start + (inp := inp) (work := loadedInitial) (out := out) + (by simpa [hinp] using hinput.read_ne_start) + (fun i => (hloadedReady.scanner.parked i).read_ne_start) + (by simpa [hout] using houtput.read_ne_start) + rw [hi, hw, ho] + exact ⟨hinp, rfl, hout⟩) + hloadedReset + simpa [denseOverlayLookupStaticTM, denseOverlayLookupStaticTime, inp₀, + loadedInitial] using hall + +end Machine +end RegisterStore +end RAM +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/Internal.lean new file mode 100644 index 0000000000..2eabefe7f6 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/Internal.lean @@ -0,0 +1,16 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Internal.Assemble +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Internal.Bounds +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Internal.Prepare +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Internal.Reset +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Internal.Restore +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Internal.Scan +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Internal.Static +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Internal.Value + +/-! Supporting modules for Beyond the Bethe approximation of the permanent. -/ diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/Internal/Assemble.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/Internal/Assemble.lean new file mode 100644 index 0000000000..caaf2ede60 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/Internal/Assemble.lean @@ -0,0 +1,272 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Internal.Prepare +import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Internal.Restore +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Internal.Scan +import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Internal.Value + +/-! +# Reusable sparse-register lookup -- phase assembly +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace RegisterStore + +namespace Machine + +variable {n : ℕ} + +private theorem entryLookupScan_ready_hoareTime + (tapes : EntryLookupRestoreTapes n) (store : Store) (address : ℕ) + (initialWork : Fin n → Tape) (inp₀ out₀ : Tape) + (hinput : TM.Parked inp₀) (houtput : TM.Parked out₀) : + (entryLookupTM tapes.scan).HoareTime + (fun inp work out => + inp = inp₀ ∧ + EntryLookupPrepared tapes store address initialWork work ∧ + out = out₀) + (fun inp work out => + inp = inp₀ ∧ + EntryLookupScannedReady tapes store address initialWork work ∧ + out = out₀) + (entryLookupTime tapes.scan address store) := by + intro inp work out ⟨hinp, hprepared, hout⟩ + have hrun := entryLookupScan_hoareTime_internal tapes store address + initialWork work inp₀ out₀ hprepared hinput houtput + obtain ⟨final, time, htime, hreach, hhalt, hfinalInput, hscanned, + hfinalOutput⟩ := hrun inp work out ⟨hinp, rfl, hout⟩ + exact ⟨final, time, htime, hreach, hhalt, hfinalInput, + ⟨work, hprepared, hscanned⟩, hfinalOutput⟩ + +private theorem entryLookupValueRewind_ready_hoareTime + (tapes : EntryLookupRestoreTapes n) (store : Store) (address : ℕ) + (initialWork : Fin n → Tape) (inp₀ out₀ : Tape) + (hinput : TM.Parked inp₀) (houtput : TM.Parked out₀) : + (TM.rewindWorkTM tapes.scan.entry.value).HoareTime + (fun inp work out => + inp = inp₀ ∧ + EntryLookupScannedReady tapes store address initialWork work ∧ + out = out₀) + (fun inp work out => + inp = inp₀ ∧ + EntryLookupValueReady tapes store address initialWork work ∧ + out = out₀) + (entryLookupRestoreHeadBound tapes store address + 2) := by + intro inp work out ⟨hinp, hscanned, hout⟩ + rcases hscanned with ⟨preparedWork, hprepared, hscanned⟩ + exact entryLookupValueRewind_hoareTime_internal tapes store address + initialWork preparedWork work inp₀ out₀ hprepared hscanned hinput + houtput inp work out ⟨hinp, rfl, hout⟩ + +private theorem entryLookupValueCopy_ready_hoareTime + (tapes : EntryLookupRestoreTapes n) (store : Store) (address : ℕ) + (initialWork : Fin n → Tape) (inp₀ out₀ : Tape) + (hinput : TM.Parked inp₀) (houtput : TM.Parked out₀) : + (TM.binaryCopyIntoTM tapes.scan.entry.value tapes.destination + tapes.copyScratch).HoareTime + (fun inp work out => + inp = inp₀ ∧ + EntryLookupValueReady tapes store address initialWork work ∧ + out = out₀) + (fun inp work out => + inp = inp₀ ∧ + EntryLookupCopied tapes store address initialWork work ∧ + out = out₀) + (TM.binaryCopyTime (RegisterStore.read store address) 0) := by + intro inp work out ⟨hinp, hready, hout⟩ + exact entryLookupValueCopy_hoareTime_internal tapes store address + initialWork work inp₀ out₀ hready hinput houtput inp work out + ⟨hinp, rfl, hout⟩ + +private theorem phaseTransition_of_parked + {inp out : Tape} {work : Fin n → Tape} + (hinput : TM.Parked inp) (hwork : ∀ i, TM.Parked (work i)) + (houtput : TM.Parked out) : + TM.transitionInput inp = inp ∧ + (fun i => TM.transitionTape (work i)) = work ∧ + TM.transitionTape out = out := + TM.phaseTransition_eq_self_of_reads_ne_start hinput.read_ne_start + (fun i => (hwork i).read_ne_start) houtput.read_ne_start + +/-- Scanner reset, source rewind, and count restoration form one reusable tail +whose endpoint is the original blank-query scanner ABI. -/ +theorem entryLookupRestoreTail_hoareTime_internal + (tapes : EntryLookupRestoreTapes n) (store : Store) (address : ℕ) + (initialWork : Fin n → Tape) (inp₀ out₀ : Tape) + (hinitial : EntryLookupRestoreReady tapes store address initialWork) + (hinput : TM.Parked inp₀) (houtput : TM.Parked out₀) : + (entryLookupRestoreTailTM tapes).HoareTime + (fun inp work out => + inp = inp₀ ∧ + EntryLookupCopied tapes store address initialWork work ∧ + out = out₀) + (fun inp work out => + inp = inp₀ ∧ + EntryLookupRestoreResult tapes store address initialWork work ∧ + out = out₀) + (entryLookupRestoreTailTime tapes store address) := by + have hreset := entryLookupReset_ready_hoareTime_internal tapes store address + initialWork inp₀ out₀ hinput houtput + have hsource := entryLookupSourceRewind_ready_hoareTime_internal tapes store + address initialWork inp₀ out₀ hinitial hinput houtput + have hcount := entryLookupCountRestore_ready_hoareTime_internal tapes store + address initialWork inp₀ out₀ hinput houtput + have hsourceCount := TM.seqTM_hoareTime + (TM.rewindWorkTM tapes.scan.entry.source) + (TM.binaryCopyIntoTM tapes.countSource tapes.scan.count + tapes.copyScratch) + hsource + (by + rintro inp work out ⟨hinp, hready, hout⟩ + obtain ⟨hi, hw, ho⟩ := phaseTransition_of_parked + (inp := inp) (work := work) (out := out) + (by simpa [hinp] using hinput) hready.parked + (by simpa [hout] using houtput) + rw [hi, hw, ho] + exact ⟨hinp, hready, hout⟩) + hcount + have hall := TM.seqTM_hoareTime + (TM.resetBinaryWorkManyTM (entryLookupResetTargets tapes)) + (TM.seqTM (TM.rewindWorkTM tapes.scan.entry.source) + (TM.binaryCopyIntoTM tapes.countSource tapes.scan.count + tapes.copyScratch)) + hreset + (by + rintro inp work out ⟨hinp, hready, hout⟩ + obtain ⟨hi, hw, ho⟩ := phaseTransition_of_parked + (inp := inp) (work := work) (out := out) + (by simpa [hinp] using hinput) hready.parked + (by simpa [hout] using houtput) + rw [hi, hw, ho] + exact ⟨hinp, hready, hout⟩) + hsourceCount + simpa [entryLookupRestoreTailTM, entryLookupRestoreTailTime] using hall + +/-- Once the external query has been prepared, scanning, value extraction, +and complete restoration form one reusable lookup. -/ +theorem entryLookupCopyRestore_hoareTime_internal + (tapes : EntryLookupRestoreTapes n) (store : Store) (address : ℕ) + (initialWork : Fin n → Tape) (inp₀ out₀ : Tape) + (hinitial : EntryLookupRestoreReady tapes store address initialWork) + (hinput : TM.Parked inp₀) (houtput : TM.Parked out₀) : + (entryLookupCopyRestoreTM tapes).HoareTime + (fun inp work out => + inp = inp₀ ∧ + EntryLookupPrepared tapes store address initialWork work ∧ + out = out₀) + (fun inp work out => + inp = inp₀ ∧ + EntryLookupRestoreResult tapes store address initialWork work ∧ + out = out₀) + (entryLookupCopyRestoreTime tapes store address) := by + have hscan := entryLookupScan_ready_hoareTime tapes store address initialWork + inp₀ out₀ hinput houtput + have hrewind := entryLookupValueRewind_ready_hoareTime tapes store address + initialWork inp₀ out₀ hinput houtput + have hcopy := entryLookupValueCopy_ready_hoareTime tapes store address + initialWork inp₀ out₀ hinput houtput + have htail := entryLookupRestoreTail_hoareTime_internal tapes store address + initialWork inp₀ out₀ hinitial hinput houtput + have hcopyTail := TM.seqTM_hoareTime + (TM.binaryCopyIntoTM tapes.scan.entry.value tapes.destination + tapes.copyScratch) + (entryLookupRestoreTailTM tapes) hcopy + (by + rintro inp work out ⟨hinp, hready, hout⟩ + obtain ⟨hi, hw, ho⟩ := phaseTransition_of_parked + (inp := inp) (work := work) (out := out) + (by simpa [hinp] using hinput) hready.restore.parked + (by simpa [hout] using houtput) + rw [hi, hw, ho] + exact ⟨hinp, hready, hout⟩) + htail + have hrewindRest := TM.seqTM_hoareTime + (TM.rewindWorkTM tapes.scan.entry.value) + (TM.seqTM + (TM.binaryCopyIntoTM tapes.scan.entry.value tapes.destination + tapes.copyScratch) + (entryLookupRestoreTailTM tapes)) + hrewind + (by + rintro inp work out ⟨hinp, hready, hout⟩ + obtain ⟨hi, hw, ho⟩ := phaseTransition_of_parked + (inp := inp) (work := work) (out := out) + (by simpa [hinp] using hinput) hready.restore.parked + (by simpa [hout] using houtput) + rw [hi, hw, ho] + exact ⟨hinp, hready, hout⟩) + hcopyTail + have hall := TM.seqTM_hoareTime (entryLookupTM tapes.scan) + (TM.seqTM (TM.rewindWorkTM tapes.scan.entry.value) + (TM.seqTM + (TM.binaryCopyIntoTM tapes.scan.entry.value tapes.destination + tapes.copyScratch) + (entryLookupRestoreTailTM tapes))) + hscan + (by + rintro inp work out ⟨hinp, hready, hout⟩ + rcases hready with ⟨preparedWork, hprepared, hscanned⟩ + obtain ⟨hi, hw, ho⟩ := phaseTransition_of_parked + (inp := inp) (work := work) (out := out) + (by simpa [hinp] using hinput) hscanned.result.parked + (by simpa [hout] using houtput) + rw [hi, hw, ho] + exact ⟨hinp, ⟨preparedWork, hprepared, hscanned⟩, hout⟩) + hrewindRest + simpa [entryLookupCopyRestoreTM, entryLookupCopyRestoreTime] using hall + +/-- Complete semantic and time contract for one reusable loaded sparse-register +lookup. -/ +theorem entryLookupLoaded_hoareTime_internal + (tapes : EntryLookupRestoreTapes n) (store : Store) (address : ℕ) + (initialWork : Fin n → Tape) (inp₀ out₀ : Tape) + (hready : EntryLookupRestoreReady tapes store address initialWork) + (hinput : TM.Parked inp₀) (houtput : TM.Parked out₀) : + (entryLookupLoadedTM tapes).HoareTime + (fun inp work out => inp = inp₀ ∧ work = initialWork ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + EntryLookupRestoreResult tapes store address initialWork work ∧ + out = out₀) + (entryLookupLoadedTime tapes store address) := by + have hprepare := entryLookupPrepare_hoareTime_internal tapes store address + initialWork inp₀ out₀ hready hinput houtput + have hrest := entryLookupCopyRestore_hoareTime_internal tapes store address + initialWork inp₀ out₀ hready hinput houtput + have hall := TM.seqTM_hoareTime + (TM.binaryCopyIntoTM tapes.querySource tapes.scan.entry.query + tapes.copyScratch) + (entryLookupCopyRestoreTM tapes) hprepare + (by + rintro inp work out ⟨hinp, hprepared, hout⟩ + obtain ⟨hi, hw, ho⟩ := phaseTransition_of_parked + (inp := inp) (work := work) (out := out) + (by simpa [hinp] using hinput) hprepared.parked + (by simpa [hout] using houtput) + rw [hi, hw, ho] + exact ⟨hinp, hprepared, hout⟩) + hrest + simpa [entryLookupLoadedTM, entryLookupLoadedTime] using hall + +end Machine + +end RegisterStore + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/Internal/Bounds.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/Internal/Bounds.lean new file mode 100644 index 0000000000..4d4458a00e --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/Internal/Bounds.lean @@ -0,0 +1,106 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Defs + +/-! +# Reusable sparse-register lookup -- reset bounds +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace RegisterStore + +namespace Machine + +theorem entryLookupEntryWidth_le_storeWidth_internal + (store : Store) (address : ℕ) (entry : Entry) (hentry : entry ∈ store) : + entryLookupEntryWidth entry address ≤ + entryLookupStoreWidth address store := by + induction store with + | nil => simp at hentry + | cons current rest ih => + simp only [List.mem_cons] at hentry + simp only [entryLookupStoreWidth] + rcases hentry with rfl | hentry + · exact le_max_left _ _ + · exact le_trans (ih hentry) (le_max_right _ _) + +theorem entryLookupEntryWidth_le_resetWidth_internal + (store : Store) (address : ℕ) (entry : Entry) (hentry : entry ∈ store) : + entryLookupEntryWidth entry address ≤ + entryLookupResetWidth store address := + le_trans (entryLookupEntryWidth_le_storeWidth_internal store address entry hentry) + (le_max_right _ _) + +theorem entryLookupAddressWidth_le_resetWidth_internal + (store : Store) (address : ℕ) : + address.bits.length ≤ entryLookupResetWidth store address := by + apply le_trans _ (le_max_right _ _) + induction store with + | nil => exact le_rfl + | cons entry rest ih => + exact le_trans ih (le_max_right _ _) + +theorem entryLookupRemainingWidth_le_resetWidth_internal + (store : Store) (address remaining : ℕ) (hle : remaining ≤ store.length) : + remaining.bits.length ≤ entryLookupResetWidth store address := by + have hsize := Nat.size_le_size hle + have hbits : remaining.bits.length ≤ store.length.bits.length := by + simpa only [Nat.size_eq_bits_len] using hsize + exact le_trans hbits (le_max_left _ _) + +theorem entryLookupEntryAddressWidth_le_internal + (entry : Entry) (address : ℕ) : + entry.1.bits.length ≤ entryLookupEntryWidth entry address := by + simp only [entryLookupEntryWidth] + exact le_trans (le_max_left _ _) (le_max_right _ _) + +theorem entryLookupEntryValueWidth_le_internal + (entry : Entry) (address : ℕ) : + entry.2.bits.length ≤ entryLookupEntryWidth entry address := by + simp only [entryLookupEntryWidth] + exact le_trans (le_max_left _ _) + (le_trans (le_max_right _ _) (le_max_right _ _)) + +theorem entryLookupEntryAddressCounterWidth_le_internal + (entry : Entry) (address : ℕ) : + bitlen entry.1 ≤ entryLookupEntryWidth entry address := by + simp only [entryLookupEntryWidth] + exact le_trans (le_max_left _ _) + (le_trans (le_max_right _ _) + (le_trans (le_max_right _ _) (le_max_right _ _))) + +theorem entryLookupEntryValueCounterWidth_le_internal + (entry : Entry) (address : ℕ) : + bitlen entry.2 ≤ entryLookupEntryWidth entry address := by + simp only [entryLookupEntryWidth] + exact le_trans (le_max_left _ _) + (le_trans (le_max_right _ _) + (le_trans (le_max_right _ _) + (le_trans (le_max_right _ _) (le_max_right _ _)))) + +theorem entryLookupResultWidth_le_internal (entry : Entry) (address : ℕ) : + 1 ≤ entryLookupEntryWidth entry address := by + simp only [entryLookupEntryWidth] + exact le_trans (le_max_right _ _) + (le_trans (le_max_right _ _) + (le_trans (le_max_right _ _) + (le_trans (le_max_right _ _) (le_max_right _ _)))) + +end Machine + +end RegisterStore + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/Internal/Prepare.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/Internal/Prepare.lean new file mode 100644 index 0000000000..1d066dc752 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/Internal/Prepare.lean @@ -0,0 +1,191 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryCopy + +/-! +# Reusable sparse-register lookup -- query preparation +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace RegisterStore + +namespace Machine + +variable {n : ℕ} + +private theorem hasBinaryNat_parked {t : Tape} {value : ℕ} + (h : t.HasBinaryNat value) : TM.Parked t := + ⟨by rw [h.2.1], h.2.hasBinaryContent.cells_ne_start⟩ + +private theorem query_ne_external (tapes : EntryLookupRestoreTapes n) + (external : Fin 4) : + tapes.scan.entry.query ≠ tapes.idx ⟨external.val + 10, by omega⟩ := + tapes.scan_ne_external 7 external + +/-- Copying the external query source into the blank scanner query tape +establishes the exact lookup-ready boundary and changes no other tape. -/ +theorem entryLookupPrepare_hoareTime_internal + (tapes : EntryLookupRestoreTapes n) (store : Store) (address : ℕ) + (work₀ : Fin n → Tape) (inp₀ out₀ : Tape) + (hready : EntryLookupRestoreReady tapes store address work₀) + (hinput : TM.Parked inp₀) (houtput : TM.Parked out₀) : + (TM.binaryCopyIntoTM tapes.querySource tapes.scan.entry.query + tapes.copyScratch).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + EntryLookupPrepared tapes store address work₀ work ∧ + out = out₀) + (TM.binaryCopyTime address 0) := by + have hcopy := TM.binaryCopyIntoTM_hoareTime_frame + tapes.querySource tapes.scan.entry.query tapes.copyScratch + (Ne.symm (query_ne_external tapes 1)) + tapes.querySource_ne_copyScratch + (query_ne_external tapes 3) address 0 inp₀ work₀ out₀ + hready.querySource + ⟨hready.scanner.queryStart, by simpa using hready.scanner.query⟩ + hready.copyScratch hinput + (fun i _ _ _ => hready.scanner.parked i) houtput + exact hcopy.strengthen_post (by + rintro inp work out ⟨hinp, hwork, hout⟩ + let queryTape := (Tape.init (address.bits.map Γ.ofBool)).move Dir3.right + let preparedWork := Function.update work₀ tapes.scan.entry.query queryTape + have hwork' : work = preparedWork := by + simpa [preparedWork, queryTape] using hwork + clear hwork + subst work + have hquery : + preparedWork tapes.scan.entry.query = queryTape := by + simp [preparedWork] + have hother : ∀ i, i ≠ tapes.scan.entry.query → + preparedWork i = work₀ i := by + intro i hi + simp [preparedWork, Function.update_of_ne hi] + have hsourceQuery : + tapes.scan.entry.source ≠ tapes.scan.entry.query := + tapes.scan.entry.ne (by decide) + have haddressQuery : + tapes.scan.entry.address ≠ tapes.scan.entry.query := + tapes.scan.entry.ne (by decide) + have hvalueQuery : + tapes.scan.entry.value ≠ tapes.scan.entry.query := + tapes.scan.entry.ne (by decide) + have haddressCounterQuery : + tapes.scan.entry.addressCounter ≠ tapes.scan.entry.query := + tapes.scan.entry.ne (by decide) + have haddressWidthQuery : + tapes.scan.entry.addressWidth ≠ tapes.scan.entry.query := + tapes.scan.entry.ne (by decide) + have hvalueCounterQuery : + tapes.scan.entry.valueCounter ≠ tapes.scan.entry.query := + tapes.scan.entry.ne (by decide) + have hvalueWidthQuery : + tapes.scan.entry.valueWidth ≠ tapes.scan.entry.query := + tapes.scan.entry.ne (by decide) + have hresultQuery : + tapes.scan.entry.result ≠ tapes.scan.entry.query := + tapes.scan.entry.ne (by decide) + have hdestinationQuery : + tapes.destination ≠ tapes.scan.entry.query := by + exact Ne.symm (query_ne_external tapes 2) + have hcopyScratchQuery : + tapes.copyScratch ≠ tapes.scan.entry.query := by + exact Ne.symm (query_ne_external tapes 3) + have hscanner : EntryScanReady tapes.scan.entry + (store.flatMap Entry.encode) address.bits preparedWork + preparedWork := by + refine + { source := ?_ + address := ?_ + addressStart := ?_ + value := ?_ + valueStart := ?_ + addressCounter := ?_ + addressWidth := ?_ + valueCounter := ?_ + valueWidth := ?_ + query := ?_ + queryStart := ?_ + result := ?_ + resultStart := ?_ + parked := ?_ + frame := by intro i _ _ _ _ _ _ _ _ _; rfl } + · rw [hother _ hsourceQuery] + exact hready.scanner.source + · rw [hother _ haddressQuery] + exact hready.scanner.address + · rw [hother _ haddressQuery] + exact hready.scanner.addressStart + · rw [hother _ hvalueQuery] + exact hready.scanner.value + · rw [hother _ hvalueQuery] + exact hready.scanner.valueStart + · rw [hother _ haddressCounterQuery] + exact hready.scanner.addressCounter + · rw [hother _ haddressWidthQuery] + exact hready.scanner.addressWidth + · rw [hother _ hvalueCounterQuery] + exact hready.scanner.valueCounter + · rw [hother _ hvalueWidthQuery] + exact hready.scanner.valueWidth + · rw [hquery] + exact Tape.init_move_right_hasBinaryString address.bits + · rw [hquery] + simp [queryTape, Tape.init, Tape.move] + · rw [hother _ hresultQuery] + exact hready.scanner.result + · rw [hother _ hresultQuery] + exact hready.scanner.resultStart + · intro i + by_cases hi : i = tapes.scan.entry.query + · subst i + rw [hquery] + exact hasBinaryNat_parked + (Tape.init_move_right_hasBinaryNat address) + · rw [hother i hi] + exact hready.scanner.parked i + refine ⟨hinp, ⟨hscanner, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_, + hscanner.parked, + hother⟩, hout⟩ + · rw [hother _ hsourceQuery] + exact hready.sourceStart + · rw [hother _ hsourceQuery] + exact hready.sourceHead + · rw [hother _ (tapes.scan.count_ne 7)] + exact hready.count + · exact hother _ (Ne.symm (query_ne_external tapes 0)) + · have heq : preparedWork tapes.countSource = + work₀ tapes.countSource := + hother _ (Ne.symm (query_ne_external tapes 0)) + rw [heq] + exact hready.countSource + · exact hother _ (Ne.symm (query_ne_external tapes 1)) + · have heq : preparedWork tapes.querySource = + work₀ tapes.querySource := + hother _ (Ne.symm (query_ne_external tapes 1)) + rw [heq] + exact hready.querySource + · rw [hother _ hdestinationQuery] + exact hready.destination + · rw [hother _ hcopyScratchQuery] + exact hready.copyScratch) + +end Machine + +end RegisterStore + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/Internal/Reset.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/Internal/Reset.lean new file mode 100644 index 0000000000..05b68ea182 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/Internal/Reset.lean @@ -0,0 +1,327 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Internal.Bounds +import Mathlib.Data.Rat.Cast.Order +import Mathlib.Tactic.NormNum.Abs +import Mathlib.Tactic.NormNum.DivMod +import Mathlib.Tactic.NormNum.OfScientific + +/-! +# Reusable sparse-register lookup -- reset certificates +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace RegisterStore + +namespace Machine + +variable {n : ℕ} + +private theorem matched_mem_store + (tapes : EntryScanTapes n) (store scanned : Store) + (matched : Entry) (rest : Store) (queryBits : List Bool) + (initialWork hitBase finalWork : Fin n → Tape) + (hfound : EntryScanFound tapes store scanned matched rest queryBits + initialWork hitBase finalWork) : + matched ∈ store := by + rw [hfound.store_eq] + simp + +private theorem found_reset_content + (tapes : EntryLookupRestoreTapes n) (store scanned : Store) + (matched : Entry) (rest : Store) (address : ℕ) + (initialWork hitBase finalWork : Fin n → Tape) + (hfound : EntryScanFound tapes.scan store scanned matched rest address.bits + initialWork hitBase finalWork) : + ∀ i, i ∈ entryLookupResetTargets tapes → + (finalWork i).HasBinaryContent + (entryLookupFoundBits tapes matched (rest.length + 1) address i) := by + obtain ⟨iterationWork, hreadable⟩ := hfound.hit.readable + intro i hi + obtain ⟨slot, rfl⟩ := List.mem_ofFn.mp hi + fin_cases slot + · change (finalWork tapes.scan.entry.address).HasBinaryContent + (entryLookupFoundBits tapes matched (rest.length + 1) address + tapes.scan.entry.address) + simpa only [entryLookupFoundBits_zero] using hreadable.address + · change (finalWork tapes.scan.entry.value).HasBinaryContent + (entryLookupFoundBits tapes matched (rest.length + 1) address + tapes.scan.entry.value) + simpa only [entryLookupFoundBits_one] using hreadable.value.2 + · change (finalWork tapes.scan.entry.addressCounter).HasBinaryContent + (entryLookupFoundBits tapes matched (rest.length + 1) address + tapes.scan.entry.addressCounter) + simpa only [entryLookupFoundBits_two] using + hreadable.addressCounter.2 + · change (finalWork tapes.scan.entry.addressWidth).HasBinaryContent + (entryLookupFoundBits tapes matched (rest.length + 1) address + tapes.scan.entry.addressWidth) + simpa only [entryLookupFoundBits_three] using + hreadable.addressWidth.2.hasBinaryContent + · change (finalWork tapes.scan.entry.valueCounter).HasBinaryContent + (entryLookupFoundBits tapes matched (rest.length + 1) address + tapes.scan.entry.valueCounter) + simpa only [entryLookupFoundBits_four] using + hreadable.valueCounter.2 + · change (finalWork tapes.scan.entry.valueWidth).HasBinaryContent + (entryLookupFoundBits tapes matched (rest.length + 1) address + tapes.scan.entry.valueWidth) + simpa only [entryLookupFoundBits_five] using + hreadable.valueWidth.2.hasBinaryContent + · change (finalWork tapes.scan.entry.result).HasBinaryContent + (entryLookupFoundBits tapes matched (rest.length + 1) address + tapes.scan.entry.result) + simpa only [entryLookupFoundBits_six] using + hreadable.result.hasBinaryContent + · change (finalWork tapes.scan.entry.query).HasBinaryContent + (entryLookupFoundBits tapes matched (rest.length + 1) address + tapes.scan.entry.query) + simpa only [entryLookupFoundBits_seven] using hreadable.query + · change (finalWork tapes.scan.count).HasBinaryContent + (entryLookupFoundBits tapes matched (rest.length + 1) address + tapes.scan.count) + simpa only [EntryLookupRestoreTapes.scan_count, + entryLookupFoundBits_eight] using + hfound.count.2.hasBinaryContent + +private theorem found_reset_start + (tapes : EntryLookupRestoreTapes n) (store scanned : Store) + (matched : Entry) (rest : Store) (address : ℕ) + (initialWork hitBase finalWork : Fin n → Tape) + (hfound : EntryScanFound tapes.scan store scanned matched rest address.bits + initialWork hitBase finalWork) : + ∀ i, i ∈ entryLookupResetTargets tapes → + (finalWork i).cells 0 = Γ.start := by + obtain ⟨iterationWork, hreadable⟩ := hfound.hit.readable + intro i hi + obtain ⟨slot, rfl⟩ := List.mem_ofFn.mp hi + fin_cases slot + · exact hreadable.addressStart + · exact hreadable.valueStart + · exact hreadable.addressCounterStart + · exact hreadable.addressWidth.1 + · exact hreadable.valueCounterStart + · exact hreadable.valueWidth.1 + · exact hreadable.resultStart + · exact hreadable.queryStart + · exact hfound.count.1 + +private theorem found_reset_width + (tapes : EntryLookupRestoreTapes n) (store scanned : Store) + (matched : Entry) (rest : Store) (address : ℕ) + (initialWork hitBase finalWork : Fin n → Tape) + (hfound : EntryScanFound tapes.scan store scanned matched rest address.bits + initialWork hitBase finalWork) : + ∀ i, i ∈ entryLookupResetTargets tapes → + (entryLookupFoundBits tapes matched (rest.length + 1) address i).length ≤ + entryLookupResetWidth store address := by + have hmem := matched_mem_store tapes.scan store scanned matched rest + address.bits initialWork hitBase finalWork hfound + have hentry := entryLookupEntryWidth_le_resetWidth_internal store address + matched hmem + intro i hi + obtain ⟨slot, rfl⟩ := List.mem_ofFn.mp hi + fin_cases slot + · change (entryLookupFoundBits tapes matched (rest.length + 1) address + tapes.scan.entry.address).length ≤ _ + rw [entryLookupFoundBits_zero] + exact le_trans (entryLookupEntryAddressWidth_le_internal matched address) + hentry + · change (entryLookupFoundBits tapes matched (rest.length + 1) address + tapes.scan.entry.value).length ≤ _ + rw [entryLookupFoundBits_one] + exact le_trans (entryLookupEntryValueWidth_le_internal matched address) + hentry + · change (entryLookupFoundBits tapes matched (rest.length + 1) address + tapes.scan.entry.addressCounter).length ≤ _ + rw [entryLookupFoundBits_two] + simpa using le_trans + (entryLookupEntryAddressCounterWidth_le_internal matched address) hentry + · change (entryLookupFoundBits tapes matched (rest.length + 1) address + tapes.scan.entry.addressWidth).length ≤ _ + rw [entryLookupFoundBits_three] + simp + · change (entryLookupFoundBits tapes matched (rest.length + 1) address + tapes.scan.entry.valueCounter).length ≤ _ + rw [entryLookupFoundBits_four] + simpa using le_trans + (entryLookupEntryValueCounterWidth_le_internal matched address) hentry + · change (entryLookupFoundBits tapes matched (rest.length + 1) address + tapes.scan.entry.valueWidth).length ≤ _ + rw [entryLookupFoundBits_five] + simp + · change (entryLookupFoundBits tapes matched (rest.length + 1) address + tapes.scan.entry.result).length ≤ _ + rw [entryLookupFoundBits_six] + simpa using le_trans (entryLookupResultWidth_le_internal matched address) + hentry + · change (entryLookupFoundBits tapes matched (rest.length + 1) address + tapes.scan.entry.query).length ≤ _ + rw [entryLookupFoundBits_seven] + exact entryLookupAddressWidth_le_resetWidth_internal store address + · change (entryLookupFoundBits tapes matched (rest.length + 1) address + tapes.scan.count).length ≤ _ + simp only [EntryLookupRestoreTapes.scan_count, + entryLookupFoundBits_eight] + apply entryLookupRemainingWidth_le_resetWidth_internal + rw [hfound.store_eq] + simp + +private theorem miss_reset_content + (tapes : EntryLookupRestoreTapes n) (store : Store) (address : ℕ) + (initialWork readyBase finalWork : Fin n → Tape) + (hmiss : EntryScanMiss tapes.scan store address.bits initialWork readyBase + finalWork) : + ∀ i, i ∈ entryLookupResetTargets tapes → + (finalWork i).HasBinaryContent (entryLookupMissBits tapes address i) := by + intro i hi + obtain ⟨slot, rfl⟩ := List.mem_ofFn.mp hi + fin_cases slot + · change (finalWork tapes.scan.entry.address).HasBinaryContent + (entryLookupMissBits tapes address tapes.scan.entry.address) + rw [entryLookupMissBits_zero] + exact hmiss.ready.address.2 + · change (finalWork tapes.scan.entry.value).HasBinaryContent + (entryLookupMissBits tapes address tapes.scan.entry.value) + rw [entryLookupMissBits_one] + exact hmiss.ready.value.2 + · change (finalWork tapes.scan.entry.addressCounter).HasBinaryContent + (entryLookupMissBits tapes address tapes.scan.entry.addressCounter) + rw [entryLookupMissBits_two] + exact hmiss.ready.addressCounter.2.hasBinaryContent + · change (finalWork tapes.scan.entry.addressWidth).HasBinaryContent + (entryLookupMissBits tapes address tapes.scan.entry.addressWidth) + rw [entryLookupMissBits_three] + exact hmiss.ready.addressWidth.2.hasBinaryContent + · change (finalWork tapes.scan.entry.valueCounter).HasBinaryContent + (entryLookupMissBits tapes address tapes.scan.entry.valueCounter) + rw [entryLookupMissBits_four] + exact hmiss.ready.valueCounter.2.hasBinaryContent + · change (finalWork tapes.scan.entry.valueWidth).HasBinaryContent + (entryLookupMissBits tapes address tapes.scan.entry.valueWidth) + rw [entryLookupMissBits_five] + exact hmiss.ready.valueWidth.2.hasBinaryContent + · change (finalWork tapes.scan.entry.result).HasBinaryContent + (entryLookupMissBits tapes address tapes.scan.entry.result) + rw [entryLookupMissBits_six] + exact hmiss.ready.result.2 + · change (finalWork tapes.scan.entry.query).HasBinaryContent + (entryLookupMissBits tapes address tapes.scan.entry.query) + rw [entryLookupMissBits_seven] + exact hmiss.ready.query.hasBinaryContent + · change (finalWork tapes.scan.count).HasBinaryContent + (entryLookupMissBits tapes address tapes.scan.count) + simpa only [EntryLookupRestoreTapes.scan_count, + entryLookupMissBits_eight] using hmiss.count.2.hasBinaryContent + +private theorem miss_reset_start + (tapes : EntryLookupRestoreTapes n) (store : Store) (address : ℕ) + (initialWork readyBase finalWork : Fin n → Tape) + (hmiss : EntryScanMiss tapes.scan store address.bits initialWork readyBase + finalWork) : + ∀ i, i ∈ entryLookupResetTargets tapes → + (finalWork i).cells 0 = Γ.start := by + intro i hi + obtain ⟨slot, rfl⟩ := List.mem_ofFn.mp hi + fin_cases slot + · exact hmiss.ready.addressStart + · exact hmiss.ready.valueStart + · exact hmiss.ready.addressCounter.1 + · exact hmiss.ready.addressWidth.1 + · exact hmiss.ready.valueCounter.1 + · exact hmiss.ready.valueWidth.1 + · exact hmiss.ready.resultStart + · exact hmiss.ready.queryStart + · exact hmiss.count.1 + +private theorem miss_reset_width + (tapes : EntryLookupRestoreTapes n) (store : Store) (address : ℕ) : + ∀ i, i ∈ entryLookupResetTargets tapes → + (entryLookupMissBits tapes address i).length ≤ + entryLookupResetWidth store address := by + intro i hi + obtain ⟨slot, rfl⟩ := List.mem_ofFn.mp hi + fin_cases slot + · change (entryLookupMissBits tapes address + tapes.scan.entry.address).length ≤ _ + rw [entryLookupMissBits_zero] + simp + · change (entryLookupMissBits tapes address + tapes.scan.entry.value).length ≤ _ + rw [entryLookupMissBits_one] + simp + · change (entryLookupMissBits tapes address + tapes.scan.entry.addressCounter).length ≤ _ + rw [entryLookupMissBits_two] + simp + · change (entryLookupMissBits tapes address + tapes.scan.entry.addressWidth).length ≤ _ + rw [entryLookupMissBits_three] + simp + · change (entryLookupMissBits tapes address + tapes.scan.entry.valueCounter).length ≤ _ + rw [entryLookupMissBits_four] + simp + · change (entryLookupMissBits tapes address + tapes.scan.entry.valueWidth).length ≤ _ + rw [entryLookupMissBits_five] + simp + · change (entryLookupMissBits tapes address + tapes.scan.entry.result).length ≤ _ + rw [entryLookupMissBits_six] + simp + · change (entryLookupMissBits tapes address + tapes.scan.entry.query).length ≤ _ + rw [entryLookupMissBits_seven] + exact entryLookupAddressWidth_le_resetWidth_internal store address + · change (entryLookupMissBits tapes address tapes.scan.count).length ≤ _ + simp only [EntryLookupRestoreTapes.scan_count, + entryLookupMissBits_eight] + simp + +/-- Every semantic scanner result determines exact bounded contents for all +nine reset targets. -/ +theorem EntryLookupResult.resetReady_internal + (tapes : EntryLookupRestoreTapes n) (store : Store) (address : ℕ) + (initialWork finalWork : Fin n → Tape) + (hresult : EntryLookupResult tapes.scan store address initialWork + finalWork) : + EntryLookupResetReady tapes store address finalWork := by + rcases hresult.outcome with hfound | hmiss + · rcases hfound with ⟨scanned, matched, rest, hitBase, hfound⟩ + exact ⟨entryLookupFoundBits tapes matched (rest.length + 1) address, + found_reset_content tapes store scanned matched rest address initialWork + hitBase finalWork hfound, + found_reset_start tapes store scanned matched rest address initialWork + hitBase finalWork hfound, + found_reset_width tapes store scanned matched rest address initialWork + hitBase finalWork hfound, + hresult.parked⟩ + · rcases hmiss with ⟨readyBase, hmiss⟩ + exact ⟨entryLookupMissBits tapes address, + miss_reset_content tapes store address initialWork readyBase finalWork + hmiss, + miss_reset_start tapes store address initialWork readyBase finalWork + hmiss, + miss_reset_width tapes store address, + hresult.parked⟩ + +end Machine + +end RegisterStore + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/Internal/Restore.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/Internal/Restore.lean new file mode 100644 index 0000000000..cc7d04e317 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/Internal/Restore.lean @@ -0,0 +1,709 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.ResetBinaryMany +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryCopy +import Mathlib.Data.Rat.Cast.Order +import Mathlib.Tactic.NormNum.Abs +import Mathlib.Tactic.NormNum.DivMod +import Mathlib.Tactic.NormNum.OfScientific + +/-! +# Reusable sparse-register lookup -- scanner restoration +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace RegisterStore + +namespace Machine + +variable {n : ℕ} + +/-- Reset all nine scanner-owned binary tapes under one uniform width and +cursor envelope. -/ +theorem entryLookupReset_hoareTime_internal + (tapes : EntryLookupRestoreTapes n) (store : Store) (address : ℕ) + (initialWork copiedWork : Fin n → Tape) (inp₀ out₀ : Tape) + (hcopied : EntryLookupCopied tapes store address initialWork copiedWork) + (hinput : TM.Parked inp₀) (houtput : TM.Parked out₀) : + (TM.resetBinaryWorkManyTM (entryLookupResetTargets tapes)).HoareTime + (fun inp work out => inp = inp₀ ∧ work = copiedWork ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + EntryLookupResetDone tapes store address initialWork copiedWork work ∧ + out = out₀) + (entryLookupResetTime tapes store address) := by + rcases hcopied.restore.resetReady with + ⟨bits, hcontent, hstart, hwidth, hparked⟩ + let headBound : Fin n → ℕ := + fun _ => entryLookupRestoreHeadBound tapes store address + have hreset := TM.resetBinaryWorkManyTM_hoareTime_frame + (entryLookupResetTargets tapes) bits headBound inp₀ copiedWork out₀ + (List.nodup_ofFn_ofInjective tapes.resetIdx_injective) + hcontent hstart + (by + intro i hi + exact hcopied.restore.resetHeadBound i hi) + hinput hparked houtput + have htime : TM.resetBinaryWorkManyTime bits headBound + (entryLookupResetTargets tapes) ≤ + entryLookupResetTime tapes store address := by + have hcoarse := TM.resetBinaryWorkManyTime_le + (entryLookupResetTargets tapes) bits headBound + (entryLookupRestoreHeadBound tapes store address) + (entryLookupResetWidth store address) + (by intro i hi; exact le_rfl) hwidth + simpa [entryLookupResetTime, entryLookupResetTargets] using hcoarse + exact (hreset.mono_bound htime).strengthen_post (by + rintro inp work out ⟨hinp, hwork, hout⟩ + exact ⟨hinp, ⟨hcopied, hwork⟩, hout⟩) + +private theorem reset_source_not_mem + (tapes : EntryLookupRestoreTapes n) : + tapes.scan.entry.source ∉ entryLookupResetTargets tapes := by + intro hi + obtain ⟨slot, hslot⟩ := List.mem_ofFn.mp hi + fin_cases slot + · change tapes.scan.entry.address = tapes.scan.entry.source at hslot + exact tapes.scan.entry.ne (i := 1) (j := 0) (by decide) hslot + · change tapes.scan.entry.value = tapes.scan.entry.source at hslot + exact tapes.scan.entry.ne (i := 2) (j := 0) (by decide) hslot + · change tapes.scan.entry.addressCounter = + tapes.scan.entry.source at hslot + exact tapes.scan.entry.ne (i := 3) (j := 0) (by decide) hslot + · change tapes.scan.entry.addressWidth = + tapes.scan.entry.source at hslot + exact tapes.scan.entry.ne (i := 4) (j := 0) (by decide) hslot + · change tapes.scan.entry.valueCounter = + tapes.scan.entry.source at hslot + exact tapes.scan.entry.ne (i := 5) (j := 0) (by decide) hslot + · change tapes.scan.entry.valueWidth = tapes.scan.entry.source at hslot + exact tapes.scan.entry.ne (i := 6) (j := 0) (by decide) hslot + · change tapes.scan.entry.result = tapes.scan.entry.source at hslot + exact tapes.scan.entry.ne (i := 8) (j := 0) (by decide) hslot + · change tapes.scan.entry.query = tapes.scan.entry.source at hslot + exact tapes.scan.entry.ne (i := 7) (j := 0) (by decide) hslot + · change tapes.scan.count = tapes.scan.entry.source at hslot + exact tapes.scan.count_ne_source hslot + +private theorem reset_external_not_mem + (tapes : EntryLookupRestoreTapes n) (external : Fin 4) : + tapes.idx ⟨external.val + 10, by omega⟩ ∉ + entryLookupResetTargets tapes := by + intro hi + obtain ⟨slot, hslot⟩ := List.mem_ofFn.mp hi + fin_cases slot + · change tapes.scan.entry.address = + tapes.idx ⟨external.val + 10, by omega⟩ at hslot + exact tapes.scan_ne_external 1 external hslot + · change tapes.scan.entry.value = + tapes.idx ⟨external.val + 10, by omega⟩ at hslot + exact tapes.scan_ne_external 2 external hslot + · change tapes.scan.entry.addressCounter = + tapes.idx ⟨external.val + 10, by omega⟩ at hslot + exact tapes.scan_ne_external 3 external hslot + · change tapes.scan.entry.addressWidth = + tapes.idx ⟨external.val + 10, by omega⟩ at hslot + exact tapes.scan_ne_external 4 external hslot + · change tapes.scan.entry.valueCounter = + tapes.idx ⟨external.val + 10, by omega⟩ at hslot + exact tapes.scan_ne_external 5 external hslot + · change tapes.scan.entry.valueWidth = + tapes.idx ⟨external.val + 10, by omega⟩ at hslot + exact tapes.scan_ne_external 6 external hslot + · change tapes.scan.entry.result = + tapes.idx ⟨external.val + 10, by omega⟩ at hslot + exact tapes.scan_ne_external 8 external hslot + · change tapes.scan.entry.query = + tapes.idx ⟨external.val + 10, by omega⟩ at hslot + exact tapes.scan_ne_external 7 external hslot + · change tapes.scan.count = + tapes.idx ⟨external.val + 10, by omega⟩ at hslot + exact tapes.scan_ne_external 9 external hslot + +private theorem not_mem_resetTargets_of_outside + (tapes : EntryLookupRestoreTapes n) (i : Fin n) + (hall : ∀ slot, i ≠ tapes.idx slot) : + i ∉ entryLookupResetTargets tapes := by + intro hi + obtain ⟨slot, hslot⟩ := List.mem_ofFn.mp hi + exact hall (EntryLookupRestoreTapes.resetSlot slot) hslot.symm + +private theorem resetDone_scratchReset + (tapes : EntryLookupRestoreTapes n) (store : Store) (address : ℕ) + (initialWork copiedWork resetWork : Fin n → Tape) + (hdone : EntryLookupResetDone tapes store address initialWork copiedWork + resetWork) : + EntryLookupScratchReset tapes store address initialWork resetWork := by + rw [hdone.work_eq] + let targets := entryLookupResetTargets tapes + let work := TM.resetBinaryWorkManyResult copiedWork targets + have hsource : work tapes.scan.entry.source = + copiedWork tapes.scan.entry.source := by + exact TM.resetBinaryWorkManyResult_eq_of_not_mem copiedWork targets _ + (reset_source_not_mem tapes) + have hcountSource : TM.resetBinaryWorkManyResult copiedWork + (entryLookupResetTargets tapes) tapes.countSource = + copiedWork tapes.countSource := + TM.resetBinaryWorkManyResult_eq_of_not_mem copiedWork targets _ + (reset_external_not_mem tapes 0) + have hquerySource : TM.resetBinaryWorkManyResult copiedWork + (entryLookupResetTargets tapes) tapes.querySource = + copiedWork tapes.querySource := + TM.resetBinaryWorkManyResult_eq_of_not_mem copiedWork targets _ + (reset_external_not_mem tapes 1) + have hdestination : TM.resetBinaryWorkManyResult copiedWork + (entryLookupResetTargets tapes) tapes.destination = + copiedWork tapes.destination := + TM.resetBinaryWorkManyResult_eq_of_not_mem copiedWork targets _ + (reset_external_not_mem tapes 2) + have hcopyScratch : TM.resetBinaryWorkManyResult copiedWork + (entryLookupResetTargets tapes) tapes.copyScratch = + copiedWork tapes.copyScratch := + TM.resetBinaryWorkManyResult_eq_of_not_mem copiedWork targets _ + (reset_external_not_mem tapes 3) + refine + { sourceCells := by + rw [TM.resetBinaryWorkManyResult_eq_of_not_mem copiedWork + (entryLookupResetTargets tapes) _ (reset_source_not_mem tapes)] + exact hdone.copied.restore.sourceCells + sourceStart := by + rw [TM.resetBinaryWorkManyResult_eq_of_not_mem copiedWork + (entryLookupResetTargets tapes) _ (reset_source_not_mem tapes)] + exact hdone.copied.restore.sourceStart + sourceHeadBound := by + rw [TM.resetBinaryWorkManyResult_eq_of_not_mem copiedWork + (entryLookupResetTargets tapes) _ (reset_source_not_mem tapes)] + exact hdone.copied.restore.sourceHeadBound + targetsBlank := by + intro i hi + exact TM.resetBinaryWorkManyResult_eq_blank_of_mem copiedWork targets i hi + countSource := hcountSource.trans hdone.copied.restore.countSource + countSourceNat := by + rw [hcountSource] + exact hdone.copied.restore.countSourceNat + querySource := hquerySource.trans hdone.copied.restore.querySource + querySourceNat := by + rw [hquerySource] + exact hdone.copied.restore.querySourceNat + destination := by + rw [hdestination] + exact hdone.copied.destination + copyScratch := hcopyScratch.trans hdone.copied.restore.copyScratch + copyScratchNat := by + rw [hcopyScratch] + exact hdone.copied.restore.copyScratchNat + parked := TM.resetBinaryWorkManyResult_parked copiedWork targets + hdone.copied.restore.parked + frame := ?_ } + intro i hall + rw [TM.resetBinaryWorkManyResult_eq_of_not_mem copiedWork targets i + (not_mem_resetTargets_of_outside tapes i hall)] + exact hdone.copied.restore.frame i hall + +private theorem scratchReset_rewindSource + (tapes : EntryLookupRestoreTapes n) (store : Store) (address : ℕ) + (initialWork work work' : Fin n → Tape) + (hreset : EntryLookupScratchReset tapes store address initialWork work) + (hcells : (work' tapes.scan.entry.source).cells = + (work tapes.scan.entry.source).cells) + (hhead : (work' tapes.scan.entry.source).head = 1) + (hother : ∀ i, i ≠ tapes.scan.entry.source → work' i = work i) : + EntryLookupScratchReset tapes store address initialWork work' := by + have hcountSource : tapes.countSource ≠ tapes.scan.entry.source := + Ne.symm (tapes.scan_ne_external 0 0) + have hquerySource : tapes.querySource ≠ tapes.scan.entry.source := + Ne.symm (tapes.scan_ne_external 0 1) + have hdestination : tapes.destination ≠ tapes.scan.entry.source := + Ne.symm (tapes.scan_ne_external 0 2) + have hcopyScratch : tapes.copyScratch ≠ tapes.scan.entry.source := + Ne.symm (tapes.scan_ne_external 0 3) + refine + { sourceCells := by + rw [hcells] + exact hreset.sourceCells + sourceStart := by + rw [hcells] + exact hreset.sourceStart + sourceHeadBound := by + simp only [entryLookupRestoreHeadBound] + omega + targetsBlank := ?_ + countSource := by + rw [hother _ hcountSource] + exact hreset.countSource + countSourceNat := by + rw [hother _ hcountSource] + exact hreset.countSourceNat + querySource := by + rw [hother _ hquerySource] + exact hreset.querySource + querySourceNat := by + rw [hother _ hquerySource] + exact hreset.querySourceNat + destination := by + rw [hother _ hdestination] + exact hreset.destination + copyScratch := by + rw [hother _ hcopyScratch] + exact hreset.copyScratch + copyScratchNat := by + rw [hother _ hcopyScratch] + exact hreset.copyScratchNat + parked := ?_ + frame := ?_ } + · intro i hi + have hne : i ≠ tapes.scan.entry.source := by + intro heq + exact reset_source_not_mem tapes (heq ▸ hi) + rw [hother i hne] + exact hreset.targetsBlank i hi + · intro i + by_cases hi : i = tapes.scan.entry.source + · subst i + exact ⟨by omega, by simpa only [hcells] using (hreset.parked _).2⟩ + · rw [hother i hi] + exact hreset.parked i + · intro i hall + rw [hother i (hall 0)] + exact hreset.frame i hall + +private theorem reset_target_mem + (tapes : EntryLookupRestoreTapes n) (slot : Fin 9) : + tapes.resetIdx slot ∈ entryLookupResetTargets tapes := + List.mem_ofFn.mpr ⟨slot, rfl⟩ + +private theorem blank_hasBinaryNat_zero : + TM.resetBinaryBlank.HasBinaryNat 0 := by + simpa [TM.resetBinaryBlank] using Tape.init_move_right_hasBinaryNat 0 + +private theorem blank_hasBinaryPrefix_nil : + TM.resetBinaryBlank.HasBinaryPrefix [] := by + have hstring : TM.resetBinaryBlank.HasBinaryString [] := by + simpa using blank_hasBinaryNat_zero.2 + exact ⟨by simpa using hstring.1, hstring.2⟩ + +private theorem blank_parked : TM.Parked TM.resetBinaryBlank := + ⟨by rw [blank_hasBinaryNat_zero.2.1], + blank_hasBinaryNat_zero.2.hasBinaryContent.cells_ne_start⟩ + +private theorem scratchReset_sourceReady + (tapes : EntryLookupRestoreTapes n) (store : Store) (address : ℕ) + (initialWork work : Fin n → Tape) + (hinitial : EntryLookupRestoreReady tapes store address initialWork) + (hreset : EntryLookupScratchReset tapes store address initialWork work) + (hsourceHead : (work tapes.scan.entry.source).head = 1) : + EntryLookupSourceReady tapes store address initialWork work := by + have hsource : (work tapes.scan.entry.source).HasBinarySuffix + (store.flatMap Entry.encode) := by + rw [Tape.HasBinarySuffix, hreset.sourceCells, hsourceHead] + have hinitialSource := hinitial.scanner.source + rw [Tape.HasBinarySuffix, hinitial.sourceHead] at hinitialSource + exact hinitialSource + have hblank := hreset.targetsBlank + have haddress : work tapes.scan.entry.address = TM.resetBinaryBlank := by + change work (tapes.resetIdx 0) = TM.resetBinaryBlank + exact hblank _ (reset_target_mem tapes 0) + have hvalue : work tapes.scan.entry.value = TM.resetBinaryBlank := by + change work (tapes.resetIdx 1) = TM.resetBinaryBlank + exact hblank _ (reset_target_mem tapes 1) + have haddressCounter : work tapes.scan.entry.addressCounter = + TM.resetBinaryBlank := by + change work (tapes.resetIdx 2) = TM.resetBinaryBlank + exact hblank _ (reset_target_mem tapes 2) + have haddressWidth : work tapes.scan.entry.addressWidth = + TM.resetBinaryBlank := by + change work (tapes.resetIdx 3) = TM.resetBinaryBlank + exact hblank _ (reset_target_mem tapes 3) + have hvalueCounter : work tapes.scan.entry.valueCounter = + TM.resetBinaryBlank := by + change work (tapes.resetIdx 4) = TM.resetBinaryBlank + exact hblank _ (reset_target_mem tapes 4) + have hvalueWidth : work tapes.scan.entry.valueWidth = + TM.resetBinaryBlank := by + change work (tapes.resetIdx 5) = TM.resetBinaryBlank + exact hblank _ (reset_target_mem tapes 5) + have hresult : work tapes.scan.entry.result = TM.resetBinaryBlank := by + change work (tapes.resetIdx 6) = TM.resetBinaryBlank + exact hblank _ (reset_target_mem tapes 6) + have hquery : work tapes.scan.entry.query = TM.resetBinaryBlank := by + change work (tapes.resetIdx 7) = TM.resetBinaryBlank + exact hblank _ (reset_target_mem tapes 7) + have hcount : work tapes.scan.count = TM.resetBinaryBlank := by + change work (tapes.resetIdx 8) = TM.resetBinaryBlank + exact hblank _ (reset_target_mem tapes 8) + have hscanner : EntryScanReady tapes.scan.entry + (store.flatMap Entry.encode) [] work work := by + refine + { source := hsource + address := by rw [haddress]; exact blank_hasBinaryPrefix_nil + addressStart := by rw [haddress]; exact blank_hasBinaryNat_zero.1 + value := by rw [hvalue]; exact blank_hasBinaryPrefix_nil + valueStart := by rw [hvalue]; exact blank_hasBinaryNat_zero.1 + addressCounter := by rw [haddressCounter]; exact blank_hasBinaryNat_zero + addressWidth := by rw [haddressWidth]; exact blank_hasBinaryNat_zero + valueCounter := by rw [hvalueCounter]; exact blank_hasBinaryNat_zero + valueWidth := by rw [hvalueWidth]; exact blank_hasBinaryNat_zero + query := by + rw [hquery] + simpa using blank_hasBinaryNat_zero.2 + queryStart := by rw [hquery]; exact blank_hasBinaryNat_zero.1 + result := by rw [hresult]; exact blank_hasBinaryPrefix_nil + resultStart := by rw [hresult]; exact blank_hasBinaryNat_zero.1 + parked := hreset.parked + frame := by intro i _ _ _ _ _ _ _ _ _; rfl } + exact + { scanner := hscanner + sourceCells := hreset.sourceCells + sourceStart := hreset.sourceStart + sourceHead := hsourceHead + countZero := by rw [hcount]; exact blank_hasBinaryNat_zero + countSource := hreset.countSource + countSourceNat := hreset.countSourceNat + querySource := hreset.querySource + destination := hreset.destination + copyScratch := hreset.copyScratch + copyScratchNat := hreset.copyScratchNat + parked := hreset.parked + frame := hreset.frame } + +/-- Rewind the read-only encoded store after resetting scanner scratch. -/ +theorem entryLookupSourceRewind_hoareTime_internal + (tapes : EntryLookupRestoreTapes n) (store : Store) (address : ℕ) + (initialWork copiedWork resetWork : Fin n → Tape) + (inp₀ out₀ : Tape) + (hinitial : EntryLookupRestoreReady tapes store address initialWork) + (hdone : EntryLookupResetDone tapes store address initialWork copiedWork + resetWork) + (hinput : TM.Parked inp₀) (houtput : TM.Parked out₀) : + (TM.rewindWorkTM tapes.scan.entry.source).HoareTime + (fun inp work out => inp = inp₀ ∧ work = resetWork ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + EntryLookupSourceReady tapes store address initialWork work ∧ + out = out₀) + (entryLookupRestoreHeadBound tapes store address + 2) := by + let P : Tape → (Fin n → Tape) → Tape → Prop := + fun inp work out => inp = inp₀ ∧ + EntryLookupScratchReset tapes store address initialWork work ∧ + out = out₀ + have hpreserved : ∀ (inp : Tape) (work : Fin n → Tape) (out : Tape) + (inp' : Tape) (work' : Fin n → Tape) (out' : Tape), + P inp work out → + (work' tapes.scan.entry.source).cells = + (work tapes.scan.entry.source).cells → + (work' tapes.scan.entry.source).head = 1 → + (∀ i, i ≠ tapes.scan.entry.source → work' i = work i) → + inp' = inp → out'.cells = out.cells → out'.head = out.head → + P inp' work' out' := by + rintro inp work out inp' work' out' ⟨hinp, hreset, hout⟩ + hcells hhead hother hinp' houtCells houtHead + exact ⟨hinp'.trans hinp, + scratchReset_rewindSource tapes store address initialWork work work' + hreset hcells hhead hother, + (Tape.ext houtHead houtCells).trans hout⟩ + have hrewind := TM.rewindWorkTM_hoareTime_frame + tapes.scan.entry.source + (entryLookupRestoreHeadBound tapes store address) hpreserved + exact hrewind.consequence + (by + rintro inp work out ⟨hinp, hwork, hout⟩ + rw [hinp, hwork, hout] + have hreset := resetDone_scratchReset tapes store address initialWork + copiedWork resetWork hdone + refine ⟨hreset.sourceStart, (hreset.parked _).2, + hreset.sourceHeadBound, hinput.read_ne_start, + houtput.read_ne_start, houtput.1, ?_, ⟨rfl, hreset, rfl⟩⟩ + intro i hi + exact ⟨(hreset.parked i).read_ne_start, (hreset.parked i).1⟩) + (by + rintro inp work out ⟨hsourceHead, hinp, hreset, hout⟩ + exact ⟨hinp, + scratchReset_sourceReady tapes store address initialWork work hinitial + hreset hsourceHead, + hout⟩) + le_rfl + +private theorem hasBinaryNat_parked {t : Tape} {value : ℕ} + (h : t.HasBinaryNat value) : TM.Parked t := + ⟨by rw [h.2.1], h.2.hasBinaryContent.cells_ne_start⟩ + +/-- Restore the runtime entry count from its preserved canonical copy. This is +the final phase returning the scanner to its reusable blank-query boundary. -/ +theorem entryLookupCountRestore_hoareTime_internal + (tapes : EntryLookupRestoreTapes n) (store : Store) (address : ℕ) + (initialWork work₀ : Fin n → Tape) (inp₀ out₀ : Tape) + (hready : EntryLookupSourceReady tapes store address initialWork work₀) + (hinput : TM.Parked inp₀) (houtput : TM.Parked out₀) : + (TM.binaryCopyIntoTM tapes.countSource tapes.scan.count + tapes.copyScratch).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + EntryLookupRestoreResult tapes store address initialWork work ∧ + out = out₀) + (TM.binaryCopyTime store.length 0) := by + have hcopy := TM.binaryCopyIntoTM_hoareTime_frame + tapes.countSource tapes.scan.count tapes.copyScratch + (Ne.symm (tapes.scan_ne_external 9 0)) + tapes.countSource_ne_copyScratch + (tapes.scan_ne_external 9 3) store.length 0 inp₀ work₀ out₀ + hready.countSourceNat hready.countZero hready.copyScratchNat hinput + (fun i _ _ _ => hready.parked i) houtput + exact hcopy.strengthen_post (by + rintro inp work out ⟨hinp, hwork, hout⟩ + let countTape := + (Tape.init (store.length.bits.map Γ.ofBool)).move Dir3.right + let restoredWork := Function.update work₀ tapes.scan.count countTape + have hwork' : work = restoredWork := by + simpa [restoredWork, countTape] using hwork + clear hwork + subst work + have hother : ∀ i, i ≠ tapes.scan.count → + restoredWork i = work₀ i := by + intro i hi + have hi' : i ≠ tapes.scan.count := hi + exact Function.update_of_ne hi' countTape work₀ + have hcount : + (restoredWork tapes.scan.count).HasBinaryNat store.length := by + rw [show restoredWork tapes.scan.count = countTape by + simp [restoredWork]] + simpa [countTape] using Tape.init_move_right_hasBinaryNat store.length + have hscanner : EntryScanReady tapes.scan.entry + (store.flatMap Entry.encode) [] restoredWork restoredWork := by + have hcountNe : ∀ slot, tapes.scan.entry.idx slot ≠ + tapes.scan.count := by + intro slot + exact Ne.symm (tapes.scan.count_ne slot) + have hentryOther : ∀ slot, restoredWork (tapes.scan.entry.idx slot) = + work₀ (tapes.scan.entry.idx slot) := by + intro slot + exact hother _ (hcountNe slot) + refine + { source := by + change (restoredWork (tapes.scan.entry.idx 0)).HasBinarySuffix _ + rw [hentryOther 0] + exact hready.scanner.source + address := by + change (restoredWork (tapes.scan.entry.idx 1)).HasBinaryPrefix [] + rw [hentryOther 1] + exact hready.scanner.address + addressStart := by + change (restoredWork (tapes.scan.entry.idx 1)).cells 0 = Γ.start + rw [hentryOther 1] + exact hready.scanner.addressStart + value := by + change (restoredWork (tapes.scan.entry.idx 2)).HasBinaryPrefix [] + rw [hentryOther 2] + exact hready.scanner.value + valueStart := by + change (restoredWork (tapes.scan.entry.idx 2)).cells 0 = Γ.start + rw [hentryOther 2] + exact hready.scanner.valueStart + addressCounter := by + change (restoredWork (tapes.scan.entry.idx 3)).HasBinaryNat 0 + rw [hentryOther 3] + exact hready.scanner.addressCounter + addressWidth := by + change (restoredWork (tapes.scan.entry.idx 4)).HasBinaryNat 0 + rw [hentryOther 4] + exact hready.scanner.addressWidth + valueCounter := by + change (restoredWork (tapes.scan.entry.idx 5)).HasBinaryNat 0 + rw [hentryOther 5] + exact hready.scanner.valueCounter + valueWidth := by + change (restoredWork (tapes.scan.entry.idx 6)).HasBinaryNat 0 + rw [hentryOther 6] + exact hready.scanner.valueWidth + query := by + change (restoredWork (tapes.scan.entry.idx 7)).HasBinaryString [] + rw [hentryOther 7] + exact hready.scanner.query + queryStart := by + change (restoredWork (tapes.scan.entry.idx 7)).cells 0 = Γ.start + rw [hentryOther 7] + exact hready.scanner.queryStart + result := by + change (restoredWork (tapes.scan.entry.idx 8)).HasBinaryPrefix [] + rw [hentryOther 8] + exact hready.scanner.result + resultStart := by + change (restoredWork (tapes.scan.entry.idx 8)).cells 0 = Γ.start + rw [hentryOther 8] + exact hready.scanner.resultStart + parked := by + intro i + by_cases hi : i = tapes.scan.count + · subst i + exact hasBinaryNat_parked hcount + · rw [hother i hi] + exact hready.parked i + frame := by intro i _ _ _ _ _ _ _ _ _; rfl } + have hcountSource : restoredWork tapes.countSource = + initialWork tapes.countSource := by + have heq : restoredWork tapes.countSource = work₀ tapes.countSource := + hother _ (Ne.symm (tapes.scan_ne_external 9 0)) + exact heq.trans hready.countSource + have hquerySource : restoredWork tapes.querySource = + initialWork tapes.querySource := by + have heq : restoredWork tapes.querySource = work₀ tapes.querySource := + hother _ (Ne.symm (tapes.scan_ne_external 9 1)) + exact heq.trans hready.querySource + have hdestination : + (restoredWork tapes.destination).HasBinaryNat + (RegisterStore.read store address) := by + have heq : restoredWork tapes.destination = work₀ tapes.destination := + hother _ (Ne.symm (tapes.scan_ne_external 9 2)) + rw [heq] + exact hready.destination + have hcopyScratch : restoredWork tapes.copyScratch = + initialWork tapes.copyScratch := by + have heq : restoredWork tapes.copyScratch = work₀ tapes.copyScratch := + hother _ (Ne.symm (tapes.scan_ne_external 9 3)) + exact heq.trans hready.copyScratch + have hcopyScratchNat : + (restoredWork tapes.copyScratch).HasBinaryNat 0 := by + have heq : restoredWork tapes.copyScratch = work₀ tapes.copyScratch := + hother _ (Ne.symm (tapes.scan_ne_external 9 3)) + rw [heq] + exact hready.copyScratchNat + have hparked : ∀ i, TM.Parked (restoredWork i) := hscanner.parked + have hsourceStart : + (restoredWork tapes.scan.entry.source).cells 0 = Γ.start := by + rw [hother _ (Ne.symm tapes.scan.count_ne_source)] + exact hready.sourceStart + have hsourceHead : + (restoredWork tapes.scan.entry.source).head = 1 := by + rw [hother _ (Ne.symm tapes.scan.count_ne_source)] + exact hready.sourceHead + refine ⟨hinp, ⟨hscanner, ?_, hsourceStart, hsourceHead, hcount, + hcountSource, hquerySource, + hdestination, hcopyScratchNat, hparked, ?_⟩, hout⟩ + · rw [hother _ (Ne.symm tapes.scan.count_ne_source)] + exact hready.sourceCells + intro i hall + rw [hother i (hall 9)] + exact hready.frame i hall) + +/-- Semantic reset boundary used by sequential lookup composition. -/ +theorem entryLookupReset_ready_hoareTime_internal + (tapes : EntryLookupRestoreTapes n) (store : Store) (address : ℕ) + (initialWork : Fin n → Tape) (inp₀ out₀ : Tape) + (hinput : TM.Parked inp₀) (houtput : TM.Parked out₀) : + (TM.resetBinaryWorkManyTM (entryLookupResetTargets tapes)).HoareTime + (fun inp work out => + inp = inp₀ ∧ + EntryLookupCopied tapes store address initialWork work ∧ + out = out₀) + (fun inp work out => + inp = inp₀ ∧ + EntryLookupScratchReset tapes store address initialWork work ∧ + out = out₀) + (entryLookupResetTime tapes store address) := by + intro inp work out ⟨hinp, hcopied, hout⟩ + have hrun := entryLookupReset_hoareTime_internal tapes store address + initialWork work inp₀ out₀ hcopied hinput houtput + obtain ⟨final, time, htime, hreach, hhalt, hfinalInput, hdone, + hfinalOutput⟩ := + hrun inp work out ⟨hinp, rfl, hout⟩ + exact ⟨final, time, htime, hreach, hhalt, hfinalInput, + resetDone_scratchReset tapes store address initialWork work final.work + hdone, + hfinalOutput⟩ + +/-- Semantic encoded-source rewind boundary used by sequential composition. -/ +theorem entryLookupSourceRewind_ready_hoareTime_internal + (tapes : EntryLookupRestoreTapes n) (store : Store) (address : ℕ) + (initialWork : Fin n → Tape) (inp₀ out₀ : Tape) + (hinitial : EntryLookupRestoreReady tapes store address initialWork) + (hinput : TM.Parked inp₀) (houtput : TM.Parked out₀) : + (TM.rewindWorkTM tapes.scan.entry.source).HoareTime + (fun inp work out => + inp = inp₀ ∧ + EntryLookupScratchReset tapes store address initialWork work ∧ + out = out₀) + (fun inp work out => + inp = inp₀ ∧ + EntryLookupSourceReady tapes store address initialWork work ∧ + out = out₀) + (entryLookupRestoreHeadBound tapes store address + 2) := by + let P : Tape → (Fin n → Tape) → Tape → Prop := + fun inp work out => inp = inp₀ ∧ + EntryLookupScratchReset tapes store address initialWork work ∧ + out = out₀ + have hpreserved : ∀ (inp : Tape) (work : Fin n → Tape) (out : Tape) + (inp' : Tape) (work' : Fin n → Tape) (out' : Tape), + P inp work out → + (work' tapes.scan.entry.source).cells = + (work tapes.scan.entry.source).cells → + (work' tapes.scan.entry.source).head = 1 → + (∀ i, i ≠ tapes.scan.entry.source → work' i = work i) → + inp' = inp → out'.cells = out.cells → out'.head = out.head → + P inp' work' out' := by + rintro inp work out inp' work' out' ⟨hinp, hreset, hout⟩ + hcells hhead hother hinp' houtCells houtHead + exact ⟨hinp'.trans hinp, + scratchReset_rewindSource tapes store address initialWork work work' + hreset hcells hhead hother, + (Tape.ext houtHead houtCells).trans hout⟩ + have hrewind := TM.rewindWorkTM_hoareTime_frame + tapes.scan.entry.source + (entryLookupRestoreHeadBound tapes store address) hpreserved + exact hrewind.consequence + (by + rintro inp work out ⟨hinp, hreset, hout⟩ + refine ⟨hreset.sourceStart, (hreset.parked _).2, + hreset.sourceHeadBound, ?_, ?_, ?_, ?_, ⟨hinp, hreset, hout⟩⟩ + · simpa [hinp] using hinput.read_ne_start + · simpa [hout] using houtput.read_ne_start + · simpa [hout] using houtput.1 + · intro i hi + exact ⟨(hreset.parked i).read_ne_start, (hreset.parked i).1⟩) + (by + rintro inp work out ⟨hsourceHead, hinp, hreset, hout⟩ + exact ⟨hinp, + scratchReset_sourceReady tapes store address initialWork work hinitial + hreset hsourceHead, + hout⟩) + le_rfl + +/-- Semantic count-copy boundary used by sequential composition. -/ +theorem entryLookupCountRestore_ready_hoareTime_internal + (tapes : EntryLookupRestoreTapes n) (store : Store) (address : ℕ) + (initialWork : Fin n → Tape) (inp₀ out₀ : Tape) + (hinput : TM.Parked inp₀) (houtput : TM.Parked out₀) : + (TM.binaryCopyIntoTM tapes.countSource tapes.scan.count + tapes.copyScratch).HoareTime + (fun inp work out => + inp = inp₀ ∧ + EntryLookupSourceReady tapes store address initialWork work ∧ + out = out₀) + (fun inp work out => + inp = inp₀ ∧ + EntryLookupRestoreResult tapes store address initialWork work ∧ + out = out₀) + (TM.binaryCopyTime store.length 0) := by + intro inp work out ⟨hinp, hready, hout⟩ + exact entryLookupCountRestore_hoareTime_internal tapes store address + initialWork work inp₀ out₀ hready hinput houtput inp work out + ⟨hinp, rfl, hout⟩ + +end Machine + +end RegisterStore + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/Internal/Scan.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/Internal/Scan.lean new file mode 100644 index 0000000000..9554371b07 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/Internal/Scan.lean @@ -0,0 +1,148 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryLookup +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Internal.Reset + +/-! +# Reusable sparse-register lookup -- bounded scan phase +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace RegisterStore + +namespace Machine + +variable {n : ℕ} + +private theorem external_frame + (tapes : EntryLookupRestoreTapes n) (external : Fin 4) + (initialWork finalWork : Fin n → Tape) + (hframe : EntryScanFrame tapes.scan initialWork finalWork) : + finalWork (tapes.idx ⟨external.val + 10, by omega⟩) = + initialWork (tapes.idx ⟨external.val + 10, by omega⟩) := by + apply hframe + · exact Ne.symm (tapes.scan_ne_external 9 external) + · exact Ne.symm (tapes.scan_ne_external 0 external) + · exact Ne.symm (tapes.scan_ne_external 1 external) + · exact Ne.symm (tapes.scan_ne_external 2 external) + · exact Ne.symm (tapes.scan_ne_external 3 external) + · exact Ne.symm (tapes.scan_ne_external 4 external) + · exact Ne.symm (tapes.scan_ne_external 5 external) + · exact Ne.symm (tapes.scan_ne_external 6 external) + · exact Ne.symm (tapes.scan_ne_external 7 external) + · exact Ne.symm (tapes.scan_ne_external 8 external) + +private theorem prepared_reset_head + (tapes : EntryLookupRestoreTapes n) (store : Store) (address : ℕ) + (initialWork preparedWork : Fin n → Tape) + (hprepared : EntryLookupPrepared tapes store address initialWork + preparedWork) : + ∀ i, i ∈ entryLookupResetTargets tapes → + (preparedWork i).head = 1 := by + intro i hi + obtain ⟨slot, rfl⟩ := List.mem_ofFn.mp hi + fin_cases slot + · simpa using hprepared.scanner.address.1 + · simpa using hprepared.scanner.value.1 + · exact hprepared.scanner.addressCounter.2.1 + · exact hprepared.scanner.addressWidth.2.1 + · exact hprepared.scanner.valueCounter.2.1 + · exact hprepared.scanner.valueWidth.2.1 + · simpa using hprepared.scanner.result.1 + · exact hprepared.scanner.query.1 + · exact hprepared.count.2.1 + +/-- The scanner phase preserves the reusable external ABI and packages every +fact needed to copy the value and restore the scanner-owned tapes. -/ +theorem entryLookupScan_hoareTime_internal + (tapes : EntryLookupRestoreTapes n) (store : Store) (address : ℕ) + (initialWork preparedWork : Fin n → Tape) (inp₀ out₀ : Tape) + (hprepared : EntryLookupPrepared tapes store address initialWork + preparedWork) + (hinput : TM.Parked inp₀) (houtput : TM.Parked out₀) : + (entryLookupTM tapes.scan).HoareTime + (fun inp work out => + inp = inp₀ ∧ work = preparedWork ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + EntryLookupScanned tapes store address initialWork preparedWork work ∧ + out = out₀) + (entryLookupTime tapes.scan address store) := by + have hlookup := entryLookupTM_hoareTime_frame_source tapes.scan store address + preparedWork inp₀ out₀ hprepared.scanner hprepared.count hinput houtput + exact hlookup.strengthen_post (by + rintro inp work out + ⟨hinp, hresult, hsourceCells, hheads, hout⟩ + have hsourcePrepared : + preparedWork tapes.scan.entry.source = + initialWork tapes.scan.entry.source := + hprepared.frame _ (tapes.scan.entry.ne (by decide)) + have hsourceInitial : (work tapes.scan.entry.source).cells = + (initialWork tapes.scan.entry.source).cells := + hsourceCells.trans + (congrArg Tape.cells hsourcePrepared) + have hsourceHead : (work tapes.scan.entry.source).head ≤ + entryLookupRestoreHeadBound tapes store address := by + have hhead := hheads tapes.scan.entry.source + simp only [entryLookupRestoreHeadBound] + rw [hprepared.sourceHead] at hhead + omega + have hresetHead : ∀ i, i ∈ entryLookupResetTargets tapes → + (work i).head ≤ + entryLookupRestoreHeadBound tapes store address := by + intro i hi + have hhead := hheads i + rw [prepared_reset_head tapes store address initialWork preparedWork + hprepared i hi] at hhead + simpa only [entryLookupRestoreHeadBound] using hhead + have hcountSource : work tapes.countSource = + initialWork tapes.countSource := + (external_frame tapes 0 preparedWork work hresult.frame).trans + hprepared.countSource + have hquerySource : work tapes.querySource = + initialWork tapes.querySource := + (external_frame tapes 1 preparedWork work hresult.frame).trans + hprepared.querySource + have hdestination : work tapes.destination = + initialWork tapes.destination := + (external_frame tapes 2 preparedWork work hresult.frame).trans (by + exact hprepared.frame _ + (Ne.symm (tapes.scan_ne_external 7 2))) + have hcopyScratch : work tapes.copyScratch = + initialWork tapes.copyScratch := + (external_frame tapes 3 preparedWork work hresult.frame).trans (by + exact hprepared.frame _ + (Ne.symm (tapes.scan_ne_external 7 3))) + refine ⟨hinp, ⟨hresult, + hresult.resetReady_internal tapes store address preparedWork work, + hsourceInitial, by + rw [hsourceCells] + exact hprepared.sourceStart, + hsourceHead, hresetHead, hcountSource, hquerySource, + hdestination, hcopyScratch, ?_⟩, hout⟩ + intro i hall + calc + work i = preparedWork i := hresult.frame i + (hall 9) (hall 0) (hall 1) (hall 2) (hall 3) (hall 4) + (hall 5) (hall 6) (hall 7) (hall 8) + _ = initialWork i := hprepared.frame i (hall 7)) + +end Machine + +end RegisterStore + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/Internal/Static.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/Internal/Static.lean new file mode 100644 index 0000000000..19d506e9ed --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/Internal/Static.lean @@ -0,0 +1,383 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Internal.Assemble +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryAddConst + +/-! +# Fixed-address sparse-register lookup -- proof internals +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace RegisterStore + +namespace Machine + +variable {n : ℕ} + +private theorem phaseTransition_of_parked + {inp out : Tape} {work : Fin n → Tape} + (hinput : TM.Parked inp) (hwork : ∀ i, TM.Parked (work i)) + (houtput : TM.Parked out) : + TM.transitionInput inp = inp ∧ + (fun i => TM.transitionTape (work i)) = work ∧ + TM.transitionTape out = out := + TM.phaseTransition_eq_self_of_reads_ne_start hinput.read_ne_start + (fun i => (hwork i).read_ne_start) houtput.read_ne_start + +private theorem staticAddress_parked (address : ℕ) : + TM.Parked + ((Tape.init (address.bits.map Γ.ofBool)).move Dir3.right) := by + have hnat := Tape.init_move_right_hasBinaryNat address + exact ⟨by rw [hnat.2.1], hnat.2.hasBinaryContent.cells_ne_start⟩ + +private theorem staticBlank_hasBinaryNat : + ((Tape.init []).move Dir3.right).HasBinaryNat 0 := by + simpa using Tape.init_move_right_hasBinaryNat 0 + +theorem staticAdd_ready_internal + (tapes : EntryLookupRestoreTapes n) (store : Store) (address : ℕ) + (initialWork : Fin n → Tape) + (hready : EntryLookupStaticReady tapes store initialWork) : + EntryLookupRestoreReady tapes store address + (Function.update initialWork tapes.querySource + ((Tape.init (address.bits.map Γ.ofBool)).move Dir3.right)) := by + let work₁ := Function.update initialWork tapes.querySource + ((Tape.init (address.bits.map Γ.ofBool)).move Dir3.right) + have hsource : tapes.scan.entry.source ≠ tapes.querySource := by + exact tapes.ne (by decide) + have haddress : tapes.scan.entry.address ≠ tapes.querySource := by + exact tapes.ne (by decide) + have hvalue : tapes.scan.entry.value ≠ tapes.querySource := by + exact tapes.ne (by decide) + have haddressCounter : + tapes.scan.entry.addressCounter ≠ tapes.querySource := by + exact tapes.ne (by decide) + have haddressWidth : + tapes.scan.entry.addressWidth ≠ tapes.querySource := by + exact tapes.ne (by decide) + have hvalueCounter : + tapes.scan.entry.valueCounter ≠ tapes.querySource := by + exact tapes.ne (by decide) + have hvalueWidth : tapes.scan.entry.valueWidth ≠ tapes.querySource := by + exact tapes.ne (by decide) + have hquery : tapes.scan.entry.query ≠ tapes.querySource := by + exact tapes.ne (by decide) + have hresult : tapes.scan.entry.result ≠ tapes.querySource := by + exact tapes.ne (by decide) + have hcount : tapes.scan.count ≠ tapes.querySource := by + exact tapes.ne (by decide) + have hcountSource : tapes.countSource ≠ tapes.querySource := + tapes.countSource_ne_querySource + have hdestination : tapes.destination ≠ tapes.querySource := + tapes.querySource_ne_destination.symm + have hcopyScratch : tapes.copyScratch ≠ tapes.querySource := + tapes.querySource_ne_copyScratch.symm + have hscanner : EntryScanReady tapes.scan.entry + (store.flatMap Entry.encode) [] work₁ work₁ := by + refine + { source := ?_ + address := ?_ + addressStart := ?_ + value := ?_ + valueStart := ?_ + addressCounter := ?_ + addressWidth := ?_ + valueCounter := ?_ + valueWidth := ?_ + query := ?_ + queryStart := ?_ + result := ?_ + resultStart := ?_ + parked := ?_ + frame := ?_ } + · simpa only [work₁, Function.update_of_ne hsource] using + hready.scanner.source + · simpa only [work₁, Function.update_of_ne haddress] using + hready.scanner.address + · simpa only [work₁, Function.update_of_ne haddress] using + hready.scanner.addressStart + · simpa only [work₁, Function.update_of_ne hvalue] using + hready.scanner.value + · simpa only [work₁, Function.update_of_ne hvalue] using + hready.scanner.valueStart + · simpa only [work₁, Function.update_of_ne haddressCounter] using + hready.scanner.addressCounter + · simpa only [work₁, Function.update_of_ne haddressWidth] using + hready.scanner.addressWidth + · simpa only [work₁, Function.update_of_ne hvalueCounter] using + hready.scanner.valueCounter + · simpa only [work₁, Function.update_of_ne hvalueWidth] using + hready.scanner.valueWidth + · simpa only [work₁, Function.update_of_ne hquery] using + hready.scanner.query + · simpa only [work₁, Function.update_of_ne hquery] using + hready.scanner.queryStart + · simpa only [work₁, Function.update_of_ne hresult] using + hready.scanner.result + · simpa only [work₁, Function.update_of_ne hresult] using + hready.scanner.resultStart + · intro i + by_cases hi : i = tapes.querySource + · subst i + simpa only [work₁, Function.update_self] using + staticAddress_parked address + · simpa only [work₁, Function.update_of_ne hi] using + hready.scanner.parked i + · intro i _ _ _ _ _ _ _ _ _ + rfl + refine + { scanner := hscanner + sourceStart := ?_ + sourceHead := ?_ + count := ?_ + countSource := ?_ + querySource := ?_ + destination := ?_ + copyScratch := ?_ } + · simpa only [work₁, Function.update_of_ne hsource] using + hready.sourceStart + · simpa only [work₁, Function.update_of_ne hsource] using + hready.sourceHead + · simpa only [work₁, Function.update_of_ne hcount] using hready.count + · simpa only [work₁, Function.update_of_ne + hcountSource] using hready.countSource + · simpa only [work₁, Function.update_self] using + Tape.init_move_right_hasBinaryNat address + · simpa only [work₁, Function.update_of_ne hdestination] using + hready.destination + · simpa only [work₁, Function.update_of_ne hcopyScratch] using + hready.copyScratch + +private theorem staticReset_result + (tapes : EntryLookupRestoreTapes n) (store : Store) (address : ℕ) + (initialWork loadedWork : Fin n → Tape) + (hloaded : EntryLookupRestoreResult tapes store address + (Function.update initialWork tapes.querySource + ((Tape.init (address.bits.map Γ.ofBool)).move Dir3.right)) + loadedWork) : + EntryLookupStaticResult tapes store address initialWork + (Function.update loadedWork tapes.querySource + ((Tape.init []).move Dir3.right)) := by + let finalWork := Function.update loadedWork tapes.querySource + ((Tape.init []).move Dir3.right) + have hsource : tapes.scan.entry.source ≠ tapes.querySource := by + exact tapes.ne (by decide) + have haddress : tapes.scan.entry.address ≠ tapes.querySource := by + exact tapes.ne (by decide) + have hvalue : tapes.scan.entry.value ≠ tapes.querySource := by + exact tapes.ne (by decide) + have haddressCounter : + tapes.scan.entry.addressCounter ≠ tapes.querySource := by + exact tapes.ne (by decide) + have haddressWidth : + tapes.scan.entry.addressWidth ≠ tapes.querySource := by + exact tapes.ne (by decide) + have hvalueCounter : + tapes.scan.entry.valueCounter ≠ tapes.querySource := by + exact tapes.ne (by decide) + have hvalueWidth : tapes.scan.entry.valueWidth ≠ tapes.querySource := by + exact tapes.ne (by decide) + have hquery : tapes.scan.entry.query ≠ tapes.querySource := by + exact tapes.ne (by decide) + have hresult : tapes.scan.entry.result ≠ tapes.querySource := by + exact tapes.ne (by decide) + have hcount : tapes.scan.count ≠ tapes.querySource := by + exact tapes.ne (by decide) + have hcountSource : tapes.countSource ≠ tapes.querySource := + tapes.countSource_ne_querySource + have hdestination : tapes.destination ≠ tapes.querySource := + tapes.querySource_ne_destination.symm + have hcopyScratch : tapes.copyScratch ≠ tapes.querySource := + tapes.querySource_ne_copyScratch.symm + have hscanner : EntryScanReady tapes.scan.entry + (store.flatMap Entry.encode) [] finalWork finalWork := by + refine + { source := ?_ + address := ?_ + addressStart := ?_ + value := ?_ + valueStart := ?_ + addressCounter := ?_ + addressWidth := ?_ + valueCounter := ?_ + valueWidth := ?_ + query := ?_ + queryStart := ?_ + result := ?_ + resultStart := ?_ + parked := ?_ + frame := ?_ } + · simpa only [finalWork, Function.update_of_ne hsource] using + hloaded.scanner.source + · simpa only [finalWork, Function.update_of_ne haddress] using + hloaded.scanner.address + · simpa only [finalWork, Function.update_of_ne haddress] using + hloaded.scanner.addressStart + · simpa only [finalWork, Function.update_of_ne hvalue] using + hloaded.scanner.value + · simpa only [finalWork, Function.update_of_ne hvalue] using + hloaded.scanner.valueStart + · simpa only [finalWork, Function.update_of_ne haddressCounter] using + hloaded.scanner.addressCounter + · simpa only [finalWork, Function.update_of_ne haddressWidth] using + hloaded.scanner.addressWidth + · simpa only [finalWork, Function.update_of_ne hvalueCounter] using + hloaded.scanner.valueCounter + · simpa only [finalWork, Function.update_of_ne hvalueWidth] using + hloaded.scanner.valueWidth + · simpa only [finalWork, Function.update_of_ne hquery] using + hloaded.scanner.query + · simpa only [finalWork, Function.update_of_ne hquery] using + hloaded.scanner.queryStart + · simpa only [finalWork, Function.update_of_ne hresult] using + hloaded.scanner.result + · simpa only [finalWork, Function.update_of_ne hresult] using + hloaded.scanner.resultStart + · intro i + by_cases hi : i = tapes.querySource + · subst i + have hzero := staticBlank_hasBinaryNat + simpa only [finalWork, Function.update_self] using + (show TM.Parked ((Tape.init []).move Dir3.right) from + ⟨by rw [hzero.2.1], hzero.2.hasBinaryContent.cells_ne_start⟩) + · simpa only [finalWork, Function.update_of_ne hi] using hloaded.parked i + · intro i _ _ _ _ _ _ _ _ _ + rfl + refine + { scanner := hscanner + sourceCells := by + simpa only [finalWork, Function.update_of_ne hsource] using + hloaded.sourceCells + sourceStart := ?_ + sourceHead := ?_ + count := ?_ + countSource := ?_ + querySource := ?_ + destination := ?_ + copyScratch := ?_ + parked := hscanner.parked + frame := ?_ } + · simpa only [finalWork, Function.update_of_ne hsource] using + hloaded.sourceStart + · simpa only [finalWork, Function.update_of_ne hsource] using + hloaded.sourceHead + · simpa only [finalWork, Function.update_of_ne hcount] using hloaded.count + · simp only [hloaded.countSource, Function.update_of_ne hcountSource] + · simpa only [finalWork, Function.update_self] using staticBlank_hasBinaryNat + · simpa only [finalWork, Function.update_of_ne hdestination] using + hloaded.value + · simpa only [finalWork, Function.update_of_ne hcopyScratch] using + hloaded.copyScratch + · intro i hi + have hquery : i ≠ tapes.querySource := hi 11 + rw [Function.update_of_ne hquery] + have houtside : ∀ slot, i ≠ tapes.idx slot := by + intro slot + exact hi slot + rw [hloaded.frame i houtside] + exact Function.update_of_ne hquery _ initialWork + +theorem entryLookupStatic_hoareTime_internal + (tapes : EntryLookupRestoreTapes n) (store : Store) (address : ℕ) + (initialWork : Fin n → Tape) (inp₀ out₀ : Tape) + (hready : EntryLookupStaticReady tapes store initialWork) + (hinput : TM.Parked inp₀) (houtput : TM.Parked out₀) : + (entryLookupStaticTM tapes address).HoareTime + (fun inp work out => inp = inp₀ ∧ work = initialWork ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + EntryLookupStaticResult tapes store address initialWork work ∧ + out = out₀) + (entryLookupStaticTime tapes store address) := by + let loadedInitial := Function.update initialWork tapes.querySource + ((Tape.init (address.bits.map Γ.ofBool)).move Dir3.right) + have hadd := TM.binaryAddConstTM_hoareTime_frame tapes.querySource address 0 + inp₀ initialWork out₀ hready.querySource hinput + (fun i _ => hready.scanner.parked i) houtput + have hadd' : (TM.binaryAddConstTM tapes.querySource address).HoareTime + (fun inp work out => inp = inp₀ ∧ work = initialWork ∧ out = out₀) + (fun inp work out => inp = inp₀ ∧ work = loadedInitial ∧ out = out₀) + (TM.binaryAddConstTime address 0) := by + simpa only [loadedInitial, zero_add] using hadd + have hloadedReady : EntryLookupRestoreReady tapes store address loadedInitial := by + simpa only [loadedInitial, zero_add] using + staticAdd_ready_internal tapes store address initialWork hready + have hloaded := entryLookupLoaded_hoareTime_internal tapes store address + loadedInitial inp₀ out₀ hloadedReady hinput houtput + have hreset : (TM.resetBinaryWorkTM tapes.querySource).HoareTime + (fun inp work out => + inp = inp₀ ∧ + EntryLookupRestoreResult tapes store address loadedInitial work ∧ + out = out₀) + (fun inp work out => + inp = inp₀ ∧ + EntryLookupStaticResult tapes store address initialWork work ∧ + out = out₀) + (TM.resetBinaryWorkTime 1 address.bits.length) := by + rintro inp work out ⟨hinp, hlookup, hout⟩ + have hqueryNat : (work tapes.querySource).HasBinaryNat address := by + rw [hlookup.querySource] + simpa only [loadedInitial, Function.update_self] using + Tape.init_move_right_hasBinaryNat address + have hrun := TM.resetBinaryWorkTM_hoareTime_frame tapes.querySource + address.bits 1 inp work out hqueryNat.2.hasBinaryContent hqueryNat.1 + ⟨by rw [hqueryNat.2.1], by rw [hqueryNat.2.1]⟩ + (by simpa [hinp] using hinput) + (fun i _ => hlookup.parked i) + (by simpa [hout] using houtput) + obtain ⟨final, time, htime, hreach, hhalt, hfinalInput, + hfinalWork, hfinalOutput⟩ := + hrun inp work out ⟨rfl, rfl, rfl⟩ + exact ⟨final, time, htime, hreach, hhalt, + hfinalInput.trans hinp, + (by + rw [hfinalWork] + exact staticReset_result tapes store address initialWork work hlookup), + hfinalOutput.trans hout⟩ + have hloadedReset := TM.seqTM_hoareTime + (entryLookupLoadedTM tapes) + (TM.resetBinaryWorkTM tapes.querySource) hloaded + (by + rintro inp work out ⟨hinp, hlookup, hout⟩ + obtain ⟨hi, hw, ho⟩ := phaseTransition_of_parked + (inp := inp) (work := work) (out := out) + (by simpa [hinp] using hinput) hlookup.parked + (by simpa [hout] using houtput) + rw [hi, hw, ho] + exact ⟨hinp, hlookup, hout⟩) + hreset + have hall := TM.seqTM_hoareTime + (TM.binaryAddConstTM tapes.querySource address) + (TM.seqTM (entryLookupLoadedTM tapes) + (TM.resetBinaryWorkTM tapes.querySource)) hadd' + (by + rintro inp work out ⟨hinp, hwork, hout⟩ + subst work + obtain ⟨hi, hw, ho⟩ := phaseTransition_of_parked + (inp := inp) (work := loadedInitial) (out := out) + (by simpa [hinp] using hinput) hloadedReady.scanner.parked + (by simpa [hout] using houtput) + rw [hi, hw, ho] + exact ⟨hinp, rfl, hout⟩) + hloadedReset + simpa [entryLookupStaticTM, entryLookupStaticTime, loadedInitial] using hall + +end Machine + +end RegisterStore + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/Internal/Value.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/Internal/Value.lean new file mode 100644 index 0000000000..bbfa317046 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/Internal/Value.lean @@ -0,0 +1,440 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryCopy +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Defs +import Mathlib.Data.Rat.Cast.Order +import Mathlib.Tactic.NormNum.Abs +import Mathlib.Tactic.NormNum.DivMod +import Mathlib.Tactic.NormNum.OfScientific + +/-! +# Reusable sparse-register lookup -- value rewind and copy +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace RegisterStore + +namespace Machine + +variable {n : ℕ} + +private theorem reset_value_mem (tapes : EntryLookupRestoreTapes n) : + tapes.scan.entry.value ∈ entryLookupResetTargets tapes := by + apply List.mem_ofFn.mpr + exact ⟨1, EntryLookupRestoreTapes.resetIdx_one tapes⟩ + +private theorem scanned_restoreInvariant + (tapes : EntryLookupRestoreTapes n) (store : Store) (address : ℕ) + (initialWork preparedWork scannedWork : Fin n → Tape) + (hprepared : EntryLookupPrepared tapes store address initialWork + preparedWork) + (hscanned : EntryLookupScanned tapes store address initialWork + preparedWork scannedWork) : + EntryLookupRestoreInvariant tapes store address initialWork scannedWork := by + have hpreparedScratch : preparedWork tapes.copyScratch = + initialWork tapes.copyScratch := + hprepared.frame _ (Ne.symm (tapes.scan_ne_external 7 3)) + refine + { valueContent := hscanned.result.value.2 + valueStart := hscanned.result.valueStart + resetReady := hscanned.resetReady + sourceCells := hscanned.sourceCells + sourceStart := hscanned.sourceStart + sourceHeadBound := hscanned.sourceHeadBound + resetHeadBound := hscanned.resetHeadBound + countSource := hscanned.countSource + countSourceNat := ?_ + querySource := hscanned.querySource + querySourceNat := ?_ + copyScratch := hscanned.copyScratch + copyScratchNat := ?_ + parked := hscanned.result.parked + frame := hscanned.frame } + · rw [hscanned.countSource, ← hprepared.countSource] + exact hprepared.countSourceNat + · rw [hscanned.querySource, ← hprepared.querySource] + exact hprepared.querySourceNat + · rw [hscanned.copyScratch, ← hpreparedScratch] + exact hprepared.copyScratch + +private theorem restoreInvariant_rewindValue + (tapes : EntryLookupRestoreTapes n) (store : Store) (address : ℕ) + (initialWork work work' : Fin n → Tape) + (hrestore : EntryLookupRestoreInvariant tapes store address initialWork + work) + (hcells : (work' tapes.scan.entry.value).cells = + (work tapes.scan.entry.value).cells) + (hhead : (work' tapes.scan.entry.value).head = 1) + (hother : ∀ i, i ≠ tapes.scan.entry.value → work' i = work i) : + EntryLookupRestoreInvariant tapes store address initialWork work' := by + have hsourceValue : + tapes.scan.entry.source ≠ tapes.scan.entry.value := + tapes.scan.entry.ne (by decide) + have hcountSourceValue : tapes.countSource ≠ + tapes.scan.entry.value := + Ne.symm (tapes.scan_ne_external 2 0) + have hquerySourceValue : tapes.querySource ≠ + tapes.scan.entry.value := + Ne.symm (tapes.scan_ne_external 2 1) + have hcopyScratchValue : tapes.copyScratch ≠ + tapes.scan.entry.value := + Ne.symm (tapes.scan_ne_external 2 3) + have hreset : EntryLookupResetReady tapes store address work' := by + rcases hrestore.resetReady with + ⟨bits, hcontent, hstart, hwidth, hparked⟩ + refine ⟨bits, ?_, ?_, hwidth, ?_⟩ + · intro i hi + by_cases hivalue : i = tapes.scan.entry.value + · subst i + simpa only [Tape.HasBinaryContent, hcells] using hcontent _ hi + · rw [hother i hivalue] + exact hcontent i hi + · intro i hi + by_cases hivalue : i = tapes.scan.entry.value + · subst i + simpa only [hcells] using hstart _ hi + · rw [hother i hivalue] + exact hstart i hi + · intro i + by_cases hivalue : i = tapes.scan.entry.value + · subst i + exact ⟨by omega, by + simpa only [hcells] using + hrestore.valueContent.cells_ne_start⟩ + · rw [hother i hivalue] + exact hparked i + refine + { valueContent := by + simpa only [Tape.HasBinaryContent, hcells] using + hrestore.valueContent + valueStart := by simpa only [hcells] using hrestore.valueStart + resetReady := hreset + sourceCells := by + rw [hother _ hsourceValue] + exact hrestore.sourceCells + sourceStart := by + rw [hother _ hsourceValue] + exact hrestore.sourceStart + sourceHeadBound := by + rw [hother _ hsourceValue] + exact hrestore.sourceHeadBound + resetHeadBound := ?_ + countSource := by + rw [hother _ hcountSourceValue] + exact hrestore.countSource + countSourceNat := by + rw [hother _ hcountSourceValue] + exact hrestore.countSourceNat + querySource := by + rw [hother _ hquerySourceValue] + exact hrestore.querySource + querySourceNat := by + rw [hother _ hquerySourceValue] + exact hrestore.querySourceNat + copyScratch := by + rw [hother _ hcopyScratchValue] + exact hrestore.copyScratch + copyScratchNat := by + rw [hother _ hcopyScratchValue] + exact hrestore.copyScratchNat + parked := hreset.choose_spec.2.2.2 + frame := ?_ } + · intro i hi + by_cases hivalue : i = tapes.scan.entry.value + · subst i + simp only [entryLookupRestoreHeadBound] + omega + · rw [hother i hivalue] + exact hrestore.resetHeadBound i hi + · intro i hall + rw [hother i (hall 2)] + exact hrestore.frame i hall + +private theorem destination_zero_of_scanned + (tapes : EntryLookupRestoreTapes n) (store : Store) (address : ℕ) + (initialWork preparedWork scannedWork : Fin n → Tape) + (hprepared : EntryLookupPrepared tapes store address initialWork + preparedWork) + (hscanned : EntryLookupScanned tapes store address initialWork + preparedWork scannedWork) : + (scannedWork tapes.destination).HasBinaryNat 0 := by + have hpreparedDestination : preparedWork tapes.destination = + initialWork tapes.destination := + hprepared.frame _ (Ne.symm (tapes.scan_ne_external 7 2)) + rw [hscanned.destination, ← hpreparedDestination] + exact hprepared.destination + +/-- Rewinding the decoded value converts its append-position prefix into a +canonical binary natural without losing any cleanup or frame information. -/ +theorem entryLookupValueRewind_hoareTime_internal + (tapes : EntryLookupRestoreTapes n) (store : Store) (address : ℕ) + (initialWork preparedWork scannedWork : Fin n → Tape) + (inp₀ out₀ : Tape) + (hprepared : EntryLookupPrepared tapes store address initialWork + preparedWork) + (hscanned : EntryLookupScanned tapes store address initialWork + preparedWork scannedWork) + (hinput : TM.Parked inp₀) (houtput : TM.Parked out₀) : + (TM.rewindWorkTM tapes.scan.entry.value).HoareTime + (fun inp work out => inp = inp₀ ∧ work = scannedWork ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + EntryLookupValueReady tapes store address initialWork work ∧ + out = out₀) + (entryLookupRestoreHeadBound tapes store address + 2) := by + let P : Tape → (Fin n → Tape) → Tape → Prop := + fun inp work out => + inp = inp₀ ∧ + EntryLookupRestoreInvariant tapes store address initialWork work ∧ + (work tapes.destination).HasBinaryNat 0 ∧ + out = out₀ + have hpreserved : ∀ (inp : Tape) (work : Fin n → Tape) (out : Tape) + (inp' : Tape) (work' : Fin n → Tape) (out' : Tape), + P inp work out → + (work' tapes.scan.entry.value).cells = + (work tapes.scan.entry.value).cells → + (work' tapes.scan.entry.value).head = 1 → + (∀ i, i ≠ tapes.scan.entry.value → work' i = work i) → + inp' = inp → out'.cells = out.cells → out'.head = out.head → + P inp' work' out' := by + rintro inp work out inp' work' out' + ⟨hinp, hrestore, hdestination, hout⟩ hcells hhead hother + hinp' houtCells houtHead + have hdestinationValue : tapes.destination ≠ + tapes.scan.entry.value := + Ne.symm (tapes.scan_ne_external 2 2) + refine ⟨hinp'.trans hinp, + restoreInvariant_rewindValue tapes store address initialWork work work' + hrestore hcells hhead hother, ?_, ?_⟩ + · rw [hother _ hdestinationValue] + exact hdestination + · exact (Tape.ext houtHead houtCells).trans hout + have hrewind := TM.rewindWorkTM_hoareTime_frame + tapes.scan.entry.value + (entryLookupRestoreHeadBound tapes store address) hpreserved + exact hrewind.consequence + (by + rintro inp work out ⟨hinp, hwork, hout⟩ + rw [hinp, hwork, hout] + have hrestore := scanned_restoreInvariant tapes store address initialWork + preparedWork scannedWork hprepared hscanned + refine ⟨hrestore.valueStart, + hrestore.valueContent.cells_ne_start, + hrestore.resetHeadBound _ (reset_value_mem tapes), + hinput.read_ne_start, houtput.read_ne_start, houtput.1, ?_, ?_⟩ + · intro i hi + exact ⟨(hrestore.parked i).read_ne_start, + (hrestore.parked i).1⟩ + · exact ⟨rfl, hrestore, + destination_zero_of_scanned tapes store address initialWork + preparedWork scannedWork hprepared hscanned, + rfl⟩) + (by + rintro inp work out ⟨hvalueHead, hinp, hrestore, hdestination, hout⟩ + exact ⟨hinp, ⟨hrestore, + ⟨hrestore.valueStart, + hrestore.valueContent.hasBinaryString hvalueHead⟩, + hdestination⟩, hout⟩) + le_rfl + +private theorem reset_destination_not_mem + (tapes : EntryLookupRestoreTapes n) : + tapes.destination ∉ entryLookupResetTargets tapes := by + intro hi + obtain ⟨slot, hslot⟩ := List.mem_ofFn.mp hi + fin_cases slot + · change tapes.scan.entry.address = tapes.destination at hslot + exact tapes.scan_ne_external 1 2 hslot + · change tapes.scan.entry.value = tapes.destination at hslot + exact tapes.scan_ne_external 2 2 hslot + · change tapes.scan.entry.addressCounter = tapes.destination at hslot + exact tapes.scan_ne_external 3 2 hslot + · change tapes.scan.entry.addressWidth = tapes.destination at hslot + exact tapes.scan_ne_external 4 2 hslot + · change tapes.scan.entry.valueCounter = tapes.destination at hslot + exact tapes.scan_ne_external 5 2 hslot + · change tapes.scan.entry.valueWidth = tapes.destination at hslot + exact tapes.scan_ne_external 6 2 hslot + · change tapes.scan.entry.result = tapes.destination at hslot + exact tapes.scan_ne_external 8 2 hslot + · change tapes.scan.entry.query = tapes.destination at hslot + exact tapes.scan_ne_external 7 2 hslot + · change tapes.scan.count = tapes.destination at hslot + exact tapes.scan_ne_external 9 2 hslot + +private theorem restoreInvariant_update_destination + (tapes : EntryLookupRestoreTapes n) (store : Store) (address : ℕ) + (initialWork work : Fin n → Tape) (destinationTape : Tape) + (hrestore : EntryLookupRestoreInvariant tapes store address initialWork + work) + (hdestinationParked : TM.Parked destinationTape) : + EntryLookupRestoreInvariant tapes store address initialWork + (Function.update work tapes.destination destinationTape) := by + let work' := Function.update work tapes.destination destinationTape + have hsourceDestination : tapes.scan.entry.source ≠ tapes.destination := + tapes.scan_ne_external 0 2 + have hvalueDestination : tapes.scan.entry.value ≠ tapes.destination := + tapes.scan_ne_external 2 2 + have hcountSourceDestination : + tapes.countSource ≠ tapes.destination := + tapes.countSource_ne_destination + have hquerySourceDestination : + tapes.querySource ≠ tapes.destination := + tapes.querySource_ne_destination + have hcopyScratchDestination : + tapes.copyScratch ≠ tapes.destination := + Ne.symm tapes.destination_ne_copyScratch + have hreset : EntryLookupResetReady tapes store address work' := by + rcases hrestore.resetReady with + ⟨bits, hcontent, hstart, hwidth, hparked⟩ + refine ⟨bits, ?_, ?_, hwidth, ?_⟩ + · intro i hi + have hne : i ≠ tapes.destination := by + intro heq + exact reset_destination_not_mem tapes (heq ▸ hi) + simp only [work', Function.update_of_ne hne] + exact hcontent i hi + · intro i hi + have hne : i ≠ tapes.destination := by + intro heq + exact reset_destination_not_mem tapes (heq ▸ hi) + simp only [work', Function.update_of_ne hne] + exact hstart i hi + · intro i + by_cases hi : i = tapes.destination + · subst i + simpa only [work', Function.update_self] using hdestinationParked + · simp only [work', Function.update_of_ne hi] + exact hparked i + refine + { valueContent := by + simpa only [work', Function.update_of_ne hvalueDestination] using + hrestore.valueContent + valueStart := by + simpa only [work', Function.update_of_ne hvalueDestination] using + hrestore.valueStart + resetReady := hreset + sourceCells := by + simpa only [work', Function.update_of_ne hsourceDestination] using + hrestore.sourceCells + sourceStart := by + simpa only [work', Function.update_of_ne hsourceDestination] using + hrestore.sourceStart + sourceHeadBound := by + simpa only [work', Function.update_of_ne hsourceDestination] using + hrestore.sourceHeadBound + resetHeadBound := ?_ + countSource := by + simpa only [work', Function.update_of_ne hcountSourceDestination] using + hrestore.countSource + countSourceNat := by + simpa only [work', Function.update_of_ne hcountSourceDestination] using + hrestore.countSourceNat + querySource := by + simpa only [work', Function.update_of_ne hquerySourceDestination] using + hrestore.querySource + querySourceNat := by + simpa only [work', Function.update_of_ne hquerySourceDestination] using + hrestore.querySourceNat + copyScratch := by + simpa only [work', Function.update_of_ne hcopyScratchDestination] using + hrestore.copyScratch + copyScratchNat := by + simpa only [work', Function.update_of_ne hcopyScratchDestination] using + hrestore.copyScratchNat + parked := hreset.choose_spec.2.2.2 + frame := ?_ } + · intro i hi + have hne : i ≠ tapes.destination := by + intro heq + exact reset_destination_not_mem tapes (heq ▸ hi) + simpa only [work', Function.update_of_ne hne] using + hrestore.resetHeadBound i hi + · intro i hall + have hne : i ≠ tapes.destination := hall 12 + change Function.update work tapes.destination destinationTape i = + initialWork i + rw [Function.update_of_ne hne] + exact hrestore.frame i hall + +private theorem hasBinaryNat_parked {t : Tape} {value : ℕ} + (h : t.HasBinaryNat value) : TM.Parked t := + ⟨by rw [h.2.1], h.2.hasBinaryContent.cells_ne_start⟩ + +/-- Copy the rewound decoded value into the instruction operand tape. The +source value and zero scratch stay canonical, and all restoration data is +preserved. -/ +theorem entryLookupValueCopy_hoareTime_internal + (tapes : EntryLookupRestoreTapes n) (store : Store) (address : ℕ) + (initialWork work₀ : Fin n → Tape) (inp₀ out₀ : Tape) + (hready : EntryLookupValueReady tapes store address initialWork work₀) + (hinput : TM.Parked inp₀) (houtput : TM.Parked out₀) : + (TM.binaryCopyIntoTM tapes.scan.entry.value tapes.destination + tapes.copyScratch).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + EntryLookupCopied tapes store address initialWork work ∧ + out = out₀) + (TM.binaryCopyTime (RegisterStore.read store address) 0) := by + let value := RegisterStore.read store address + have hcopy := TM.binaryCopyIntoTM_hoareTime_frame + tapes.scan.entry.value tapes.destination tapes.copyScratch + (tapes.scan_ne_external 2 2) (tapes.scan_ne_external 2 3) + tapes.destination_ne_copyScratch value 0 inp₀ work₀ out₀ + hready.value hready.destination hready.restore.copyScratchNat hinput + (fun i _ _ _ => hready.restore.parked i) houtput + exact hcopy.strengthen_post (by + rintro inp work out ⟨hinp, hwork, hout⟩ + let destinationTape := + (Tape.init (value.bits.map Γ.ofBool)).move Dir3.right + let copiedWork := Function.update work₀ tapes.destination destinationTape + have hwork' : work = copiedWork := by + simpa [copiedWork, destinationTape, value] using hwork + clear hwork + subst work + have hdestinationNat : + (copiedWork tapes.destination).HasBinaryNat value := by + rw [show copiedWork tapes.destination = destinationTape by + simp [copiedWork]] + simpa [destinationTape] using + Tape.init_move_right_hasBinaryNat value + have hrestore : EntryLookupRestoreInvariant tapes store address + initialWork copiedWork := by + exact restoreInvariant_update_destination tapes store address initialWork + work₀ destinationTape hready.restore + (hasBinaryNat_parked (by + simpa [destinationTape] using + Tape.init_move_right_hasBinaryNat value)) + have hvalueNat : + (copiedWork tapes.scan.entry.value).HasBinaryNat value := by + have heq : copiedWork tapes.scan.entry.value = + work₀ tapes.scan.entry.value := by + have hne : tapes.scan.entry.value ≠ tapes.destination := + tapes.scan_ne_external 2 2 + change Function.update work₀ tapes.destination destinationTape + tapes.scan.entry.value = work₀ tapes.scan.entry.value + rw [Function.update_of_ne hne] + rw [heq] + simpa [value] using hready.value + exact ⟨hinp, ⟨hrestore, by simpa [value] using hvalueNat, + by simpa [value] using hdestinationNat⟩, hout⟩) + +end Machine + +end RegisterStore + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program.lean new file mode 100644 index 0000000000..dc17253ad1 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program.lean @@ -0,0 +1,168 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Defs +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Internal + +/-! +# Sparse RAM program controller + +The fixed-program halt test copies the canonical sparse-snapshot PC, walks a +finite decrementing selector, restores its scratch, and writes `1` exactly when +the selected instruction is `halt`. +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace RegisterStore + +namespace Machine + +@[simp] theorem instructionHaltOutput_head (instruction : Instr) : + (instructionHaltOutput instruction).head = 1 := + instructionHaltOutput_head_internal instruction + +@[simp] theorem instructionHaltOutput_cells_zero (instruction : Instr) : + (instructionHaltOutput instruction).cells 0 = Γ.start := + instructionHaltOutput_cells_zero_internal instruction + +theorem instructionHaltOutput_cells_ne_start (instruction : Instr) : + ∀ j, j ≥ 1 → (instructionHaltOutput instruction).cells j ≠ Γ.start := + instructionHaltOutput_cells_ne_start_internal instruction + +@[simp] theorem instructionHaltOutput_cell_one_eq_one_iff + (instruction : Instr) : + (instructionHaltOutput instruction).cells 1 = Γ.one ↔ + instruction = .halt := + instructionHaltOutput_cell_one_eq_one_iff_internal instruction + +@[simp] theorem instructionHaltOutput_eq_blank_of_ne_halt + {instruction : Instr} (h : instruction ≠ .halt) : + instructionHaltOutput instruction = + (Tape.init []).move Dir3.right := + instructionHaltOutput_eq_blank_of_ne_halt_internal h + +/-- The canonical work-tape image of a sparse snapshot satisfies the complete +reusable instruction ABI. -/ +theorem programSnapshotWork_ready {n : ℕ} + (tapes : ControlInstructionTapes n) (snapshot : Snapshot) + (hcanonical : Canonical snapshot.store) : + InstructionExecutionReady tapes snapshot.store snapshot.pc + (programSnapshotWork tapes snapshot) := + programSnapshotWork_ready_internal tapes snapshot hcanonical + +@[simp] theorem registerVerdictOutput_cell_one (value : ℕ) : + (registerVerdictOutput value).cells 1 = + if value = 0 then Γ.zero else Γ.one := + registerVerdictOutput_cell_one_internal value + +/-- Final sparse lookup recovers `R₀` and emits zero exactly for value zero, +or one for any nonzero value. -/ +theorem programOutputTM_hoareTime {n : ℕ} + (tapes : ControlInstructionTapes n) (store : Store) (pcValue : ℕ) + (initialWork : Fin (n + 1) → Tape) (inp₀ : Tape) + (hready : InstructionExecutionReady tapes store pcValue initialWork) + (hinput : TM.Parked inp₀) : + (programOutputTM tapes).HoareTime + (fun inp work out => + inp = inp₀ ∧ work = initialWork ∧ + out = (Tape.init []).move Dir3.right) + (fun inp _work out => + inp = inp₀ ∧ + out = registerVerdictOutput (RegisterStore.read store 0)) + (programOutputTime tapes store) := + programOutputTM_hoareTime_internal tapes store pcValue initialWork inp₀ + hready hinput + +/-- Final sparse lookup overwrites the loop's halt-test bit with the RAM +verdict, allowing direct controller/extractor composition. -/ +theorem programOutputTM_hoareTime_haltOutput {n : ℕ} + (tapes : ControlInstructionTapes n) (store : Store) (pcValue : ℕ) + (initialWork : Fin (n + 1) → Tape) (inp₀ : Tape) + (hready : InstructionExecutionReady tapes store pcValue initialWork) + (hinput : TM.Parked inp₀) : + (programOutputTM tapes).HoareTime + (fun inp work out => + inp = inp₀ ∧ work = initialWork ∧ + out = instructionHaltOutput .halt) + (fun inp _work out => + inp = inp₀ ∧ + out = registerVerdictOutput (RegisterStore.read store 0)) + (programOutputTime tapes store) := + programOutputTM_hoareTime_haltOutput_internal tapes store pcValue + initialWork inp₀ hready hinput + +/-- The fixed-program test preserves the complete clean instruction ABI and +emits the exact sparse snapshot's halt status. -/ +theorem programHaltTM_hoareTime_frame {n : ℕ} + (tapes : ControlInstructionTapes n) (program : Program) + (store : Store) (pcValue : ℕ) + (initialWork : Fin (n + 1) → Tape) (inp₀ : Tape) + (hready : InstructionExecutionReady tapes store pcValue initialWork) + (hinput : TM.Parked inp₀) : + (programHaltTM tapes program).HoareTime + (fun inp work out => + inp = inp₀ ∧ work = initialWork ∧ + out = (Tape.init []).move Dir3.right) + (fun inp work out => + let snapshot : Snapshot := { pc := pcValue, store := store } + inp = inp₀ ∧ work = initialWork ∧ + out = instructionHaltOutput (snapshot.curInstr program)) + (programHaltTime tapes program pcValue) := by + simpa [Snapshot.curInstr, selectedInstruction_eq_getElem?_getD] using + programHaltTM_hoareTime_frame_internal tapes program store pcValue + initialWork inp₀ hready hinput + +/-- A halted sparse snapshot is stationary under both one pure step and every +fuel-bounded run. -/ +theorem Snapshot.step_eq_self_of_halted (program : Program) + (snapshot : Snapshot) (hhalted : snapshot.Halted program) : + snapshot.step program = snapshot := + snapshot_step_eq_self_of_halted_internal program snapshot hhalted + +/-- Running a halted sparse snapshot for arbitrary additional fuel is a no-op. -/ +theorem Snapshot.run_halted (program : Program) (snapshot : Snapshot) + (hhalted : snapshot.Halted program) (fuel : ℕ) : + snapshot.run program fuel = snapshot := + snapshot_run_halted_internal program snapshot hhalted fuel + +/-- If the pure fuel-bounded sparse run is halted, the fixed controller loop +reaches that exact reusable snapshot and exposes its halt verdict. -/ +theorem programLoopTM_hoareTime_run {n : ℕ} + (tapes : ControlInstructionTapes n) (program : Program) + (fuel : ℕ) (snapshot : Snapshot) + (initialWork : Fin (n + 1) → Tape) (inp₀ : Tape) + (hready : InstructionExecutionReady tapes snapshot.store snapshot.pc + initialWork) + (hinput : TM.Parked inp₀) + (hhalted : (snapshot.run program fuel).Halted program) : + (programLoopTM tapes program).HoareTime + (fun inp work out => + inp = inp₀ ∧ work = initialWork ∧ + out = (Tape.init []).move Dir3.right) + (fun inp work out => + let final := snapshot.run program fuel + inp = inp₀ ∧ + InstructionExecutionReady tapes final.store final.pc work ∧ + out = instructionHaltOutput (final.curInstr program)) + (programLoopTime tapes program (fuel + 1) snapshot) := + programLoopTM_hoareTime_run_internal tapes program fuel snapshot + initialWork inp₀ hready hinput hhalted + +end Machine + +end RegisterStore + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Bounds.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Bounds.lean new file mode 100644 index 0000000000..886c5a4156 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Bounds.lean @@ -0,0 +1,79 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Bounds.Defs +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Bounds.Internal + +/-! +# Sparse RAM decision-machine resource bounds +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace RegisterStore + +namespace Machine + +/-- The fixed program magnitude is positive. -/ +theorem programResourceMagnitude_pos (program : Program) : + 1 ≤ programResourceMagnitude program := + programResourceMagnitude_pos_internal program + +/-- The fixed program length is absorbed by its resource magnitude. -/ +theorem program_length_le_resourceMagnitude (program : Program) : + program.length ≤ programResourceMagnitude program := + program_length_le_resourceMagnitude_internal program + +/-- Every fixed program literal width is absorbed by the resource magnitude. -/ +theorem programStaticWidth_le_resourceMagnitude (program : Program) : + programStaticWidth program ≤ programResourceMagnitude program := + programStaticWidth_le_resourceMagnitude_internal program + +/-- The common run scale is positive. -/ +theorem programDecisionScale_pos (program : Program) + (inputLength cost : ℕ) : + 1 ≤ programDecisionScale program inputLength cost := + programDecisionScale_pos_internal program inputLength cost + +/-- A fuel-bounded halted RAM run whose fuel is charged by logarithmic time is +simulated by the concrete decision TM within the checked fourth-degree +envelope. -/ +theorem programDecisionTime_le_envelope {n : ℕ} + (tapes : ControlInstructionTapes n) (program : Program) + (input : List Bool) (fuel : ℕ) + (hhalted : RAM.Halted program + (RAM.run program fuel (RAM.initCfg input))) + (hfuel : fuel ≤ + RAM.logTimeUpto program fuel (RAM.initCfg input)) : + programDecisionTime tapes program input fuel ≤ + programDecisionEnvelope program input.length + (RAM.logTimeUpto program fuel (RAM.initCfg input)) := + programDecisionTime_le_envelope_internal tapes program input fuel + hhalted hfuel + +/-- Increasing the charged RAM-time argument can only increase the concrete +simulation envelope. -/ +theorem programDecisionEnvelope_mono_cost (program : Program) + (inputLength left right : ℕ) (hle : left ≤ right) : + programDecisionEnvelope program inputLength left ≤ + programDecisionEnvelope program inputLength right := + programDecisionEnvelope_mono_cost_internal program inputLength left right hle + +end Machine + +end RegisterStore + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Bounds/Defs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Bounds/Defs.lean new file mode 100644 index 0000000000..3c99e8dccd --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Bounds/Defs.lean @@ -0,0 +1,69 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Defs +import Mathlib.Tactic.NormNum.Inv +import Mathlib.Tactic.NormNum.Pow + +/-! +# Sparse RAM decision-machine resource-bound definitions + +The concrete simulator has fixed control once its RAM program is fixed. The +only program-dependent quantities that matter asymptotically are therefore +collected in `programResourceMagnitude`. `programDecisionScale` combines +that fixedValue with the public input length and the charged logarithmic RAM +time. The fourth-power envelope is deliberately coarse: it keeps the public +class-transfer theorem independent of low-level controller constants while +still recording a genuine polynomial simulation. +-/ + + +@[expose] public section + +namespace Complexity + +namespace RAM + +namespace RegisterStore + +namespace Machine + +/-- A positive magnitude containing every natural literal of one instruction. -/ +def instructionResourceMagnitude : Instr → ℕ + | .imm destination value => destination + value + 1 + | .add destination source₀ source₁ + | .sub destination source₀ source₁ + | .mul destination source₀ source₁ => + destination + source₀ + source₁ + 1 + | .load destination addressRegister + | .store destination addressRegister => destination + addressRegister + 1 + | .jz source target => source + target + 1 + | .jmp target => target + 1 + | .halt => 1 + +/-- One positive fixed fixedValue containing the program length and every +hardwired register, immediate, and jump literal. -/ +def programResourceMagnitude (program : Program) : ℕ := + program.length + (program.map instructionResourceMagnitude).sum + 1 + +/-- Common width/count scale for a run with charged logarithmic time `cost`. -/ +def programDecisionScale (program : Program) (inputLength cost : ℕ) : ℕ := + inputLength + cost * (programResourceMagnitude program + 2) + + programResourceMagnitude program + 3 + +/-- Coarse checked polynomial envelope for the complete concrete simulation. -/ +def programDecisionEnvelope (program : Program) (inputLength cost : ℕ) : ℕ := + 1000000000 * programResourceMagnitude program * + (programDecisionScale program inputLength cost + 1) ^ 4 + +end Machine + +end RegisterStore + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Bounds/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Bounds/Internal.lean new file mode 100644 index 0000000000..de0b0fd07b --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Bounds/Internal.lean @@ -0,0 +1,2293 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Bounds.Defs +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Decision.Defs +import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Init.Internal +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Internal + +/-! +# Sparse RAM decision-machine resource-bound proof internals +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace RegisterStore + +namespace Machine + +variable {n : ℕ} + +private theorem size_le_self (value : ℕ) : value.size ≤ value := by + rw [Nat.size_le] + exact Nat.lt_pow_self (by decide) + +private theorem bitlen_le_succ (value : ℕ) : bitlen value ≤ value + 1 := by + unfold bitlen + exact le_trans (size_le_self value) (Nat.le_succ value) + +private theorem instructionStaticWidth_le_resourceMagnitude + (instruction : Instr) : + RegisterStore.Instr.staticWidth instruction ≤ + instructionResourceMagnitude instruction := by + cases instruction with + | imm destination value => + simp only [RegisterStore.Instr.staticWidth, + instructionResourceMagnitude] + exact max_le (le_trans (bitlen_le_succ destination) (by omega)) + (le_trans (bitlen_le_succ value) (by omega)) + | add destination source₀ source₁ => + simp only [RegisterStore.Instr.staticWidth, + instructionResourceMagnitude] + exact max_le (le_trans (bitlen_le_succ destination) (by omega)) + (max_le (le_trans (bitlen_le_succ source₀) (by omega)) + (le_trans (bitlen_le_succ source₁) (by omega))) + | sub destination source₀ source₁ => + simp only [RegisterStore.Instr.staticWidth, + instructionResourceMagnitude] + exact max_le (le_trans (bitlen_le_succ destination) (by omega)) + (max_le (le_trans (bitlen_le_succ source₀) (by omega)) + (le_trans (bitlen_le_succ source₁) (by omega))) + | mul destination source₀ source₁ => + simp only [RegisterStore.Instr.staticWidth, + instructionResourceMagnitude] + exact max_le (le_trans (bitlen_le_succ destination) (by omega)) + (max_le (le_trans (bitlen_le_succ source₀) (by omega)) + (le_trans (bitlen_le_succ source₁) (by omega))) + | load destination addressRegister => + simp only [RegisterStore.Instr.staticWidth, + instructionResourceMagnitude] + exact max_le (le_trans (bitlen_le_succ destination) (by omega)) + (le_trans (bitlen_le_succ addressRegister) (by omega)) + | store destination addressRegister => + simp only [RegisterStore.Instr.staticWidth, + instructionResourceMagnitude] + exact max_le (le_trans (bitlen_le_succ destination) (by omega)) + (le_trans (bitlen_le_succ addressRegister) (by omega)) + | jz source target => + simp only [RegisterStore.Instr.staticWidth, + instructionResourceMagnitude] + exact max_le (le_trans (bitlen_le_succ source) (by omega)) + (le_trans (bitlen_le_succ target) (by omega)) + | jmp target => + exact le_trans (bitlen_le_succ target) (by + simp [instructionResourceMagnitude]) + | halt => simp [RegisterStore.Instr.staticWidth, + instructionResourceMagnitude] + +theorem programResourceMagnitude_pos_internal (program : Program) : + 1 ≤ programResourceMagnitude program := by + simp [programResourceMagnitude] + +theorem program_length_le_resourceMagnitude_internal (program : Program) : + program.length ≤ programResourceMagnitude program := by + unfold programResourceMagnitude + omega + +theorem programStaticWidth_le_resourceMagnitude_internal (program : Program) : + programStaticWidth program ≤ programResourceMagnitude program := by + induction program with + | nil => simp [programStaticWidth, programResourceMagnitude] + | cons instruction rest ih => + have hinstruction := + instructionStaticWidth_le_resourceMagnitude instruction + simp only [programStaticWidth, programResourceMagnitude, + List.length_cons, List.map_cons, List.sum_cons] + apply max_le + · omega + · unfold programResourceMagnitude at ih + omega + +theorem programDecisionScale_pos_internal (program : Program) + (inputLength cost : ℕ) : + 1 ≤ programDecisionScale program inputLength cost := by + simp [programDecisionScale] + +private theorem binarySuccTime_le_width (value width : ℕ) + (hvalue : value.size ≤ width) : + TM.binarySuccTime value ≤ 2 * width + 2 := by + exact le_trans (TM.binarySuccTime_le value) (by omega) + +private theorem binaryPredTime_le_width (value width : ℕ) + (hvalue : (value + 1).size ≤ width) : + TM.binaryPredTime value ≤ 2 * width + 2 := by + exact le_trans (TM.binaryPredTime_le value) (by omega) + +private theorem binaryCopyTime_le_width (srcValue dstValue width : ℕ) + (hsrc : srcValue.size ≤ width) (hdst : dstValue.size ≤ width) : + TM.binaryCopyTime srcValue dstValue ≤ 5 * width + 20 := by + exact le_trans (TM.binaryCopyTime_le srcValue dstValue) (by omega) + +private theorem binaryAddConstTime_zero_le (fixedValue : ℕ) : + TM.binaryAddConstTime fixedValue 0 ≤ 4 * (fixedValue + 1) ^ 2 := by + induction fixedValue with + | zero => simp [TM.binaryAddConstTime] + | succ fixedValue ih => + rw [TM.binaryAddConstTime] + have hsucc := TM.binarySuccTime_le fixedValue + have hsize := size_le_self fixedValue + calc + TM.binaryAddConstTime fixedValue 0 + 1 + + TM.binarySuccTime (0 + fixedValue) ≤ + 4 * (fixedValue + 1) ^ 2 + 1 + (2 * fixedValue + 2) := by + simp only [Nat.zero_add] + exact Nat.add_le_add (Nat.add_le_add ih le_rfl) + (le_trans hsucc (by omega)) + _ ≤ 4 * (fixedValue + 1 + 1) ^ 2 := by nlinarith + +private theorem binaryAddConstTime_zero_le_width (fixedValue width : ℕ) + (hconstant : fixedValue ≤ width) : + TM.binaryAddConstTime fixedValue 0 ≤ 5 * (width + 1) ^ 2 := by + have htime := binaryAddConstTime_zero_le fixedValue + nlinarith [Nat.mul_le_mul (Nat.add_le_add_right hconstant 1) + (Nat.add_le_add_right hconstant 1)] + +private theorem forWorkOnesLoopTime_succ_le + (limit value count : ℕ) (hsum : value + count ≤ limit) : + TM.forWorkOnesLoopTime TM.binarySuccTime value count ≤ + 1 + count * (2 * limit + 4) := by + induction count generalizing value with + | zero => simp [TM.forWorkOnesLoopTime] + | succ count ih => + rw [TM.forWorkOnesLoopTime] + have hvalue : value ≤ limit := by omega + have hsize : value.size ≤ limit := + le_trans (size_le_self value) hvalue + have hsucc := binarySuccTime_le_width value limit hsize + have htail := ih (value + 1) (by omega) + rw [Nat.succ_mul] + omega + +private theorem wordWidthTime_le (width : ℕ) : + wordWidthTime width ≤ 4 * (width + 1) ^ 2 := by + have hloop := forWorkOnesLoopTime_succ_le width 0 width (by omega) + unfold wordWidthTime + nlinarith + +private theorem binaryForLoopTime_one_le + (limit value count : ℕ) (hsum : value + count ≤ limit) : + TM.binaryForLoopTime (fun _ => 1) limit value count ≤ + (count + 1) * (4 * limit + 8) := by + induction count generalizing value with + | zero => + simp only [TM.binaryForLoopTime, TM.binaryForCompareTime] + have hsize := size_le_self limit + omega + | succ count ih => + rw [TM.binaryForLoopTime] + have hvalue : value ≤ limit := by omega + have hsize : value.size ≤ limit := + le_trans (size_le_self value) hvalue + have hsucc := binarySuccTime_le_width value limit hsize + have hlimitSize := size_le_self limit + have htail := ih (value + 1) (by omega) + simp only [TM.binaryForCompareTime, TM.binaryForIterationTime] + nlinarith + +private theorem wordPayloadTime_le (width : ℕ) : + wordPayloadTime width ≤ 8 * (width + 1) ^ 2 := by + have hloop := binaryForLoopTime_one_le width 0 width (by omega) + unfold wordPayloadTime + nlinarith + +private theorem wordDecodeTime_le (width bound : ℕ) + (hwidth : width ≤ bound) : + wordDecodeTime width ≤ 20 * (bound + 1) ^ 2 := by + have hprefix := wordWidthTime_le width + have hpayload := wordPayloadTime_le width + unfold wordDecodeTime + nlinarith [Nat.mul_le_mul hwidth hwidth] + +private theorem entryMatchReadTime_le (entry : Entry) + (queryBits : List Bool) (bound : ℕ) + (haddress : entry.1.bits.length ≤ bound) + (hvalue : entry.2.bits.length ≤ bound) + (hquery : queryBits.length ≤ bound) : + entryMatchReadTime entry queryBits ≤ 100 * (bound + 1) ^ 2 := by + have hlinear := entryMatchReadTime_le_linear entry queryBits + have hboundSq : bound ≤ (bound + 1) ^ 2 := by nlinarith + have honeSq : 1 ≤ (bound + 1) ^ 2 := by nlinarith + omega + +private theorem entryMissBits_length_le {m : ℕ} + (tapes : EntryMatchTapes m) (entry : Entry) + (queryBits : List Bool) (bound : ℕ) + (hbound : 1 ≤ bound) + (haddress : entry.1.bits.length ≤ bound) + (hvalue : entry.2.bits.length ≤ bound) (i : Fin m) : + (entryMissBits tapes entry queryBits i).length ≤ bound := by + have haddressWidth : bitlen entry.1 ≤ bound := by + simpa only [bitlen, Nat.size_eq_bits_len] using haddress + have hvalueWidth : bitlen entry.2 ≤ bound := by + simpa only [bitlen, Nat.size_eq_bits_len] using hvalue + unfold entryMissBits + split_ifs <;> + (try simp only [List.length_nil, List.length_replicate, + List.length_singleton]) <;> omega + +private theorem entryMissCleanupTime_canonical_le {m : ℕ} + (tapes : EntryMatchTapes m) (entry : Entry) + (queryBits : List Bool) (bound : ℕ) + (hbound : 1 ≤ bound) + (haddress : entry.1.bits.length ≤ bound) + (hvalue : entry.2.bits.length ≤ bound) + (hquery : queryBits.length ≤ bound) : + entryMissCleanupTime tapes entry queryBits + (entryScanCanonicalWork (n := m)) ≤ + 1000 * (bound + 1) ^ 2 := by + let matchTime := entryMatchReadTime entry queryBits + have hmatch : matchTime ≤ 100 * (bound + 1) ^ 2 := + entryMatchReadTime_le entry queryBits bound haddress hvalue hquery + have hreset := TM.resetBinaryWorkManyTime_le + (entryMissTargets tapes) (entryMissBits tapes entry queryBits) + (entryMissHeadBound entry queryBits (entryScanCanonicalWork (n := m))) + (1 + matchTime) bound + (fun i _ => by + unfold entryMissHeadBound entryScanCanonicalWork + simp only [Function.const_apply] + dsimp only [matchTime] + simp [TM.resetBinaryBlank, Tape.move, Tape.init]) + (fun i _ => entryMissBits_length_le tapes entry queryBits bound hbound + haddress hvalue i) + have htargets : (entryMissTargets tapes).length = 7 := by + simp [entryMissTargets] + rw [htargets] at hreset + dsimp only [matchTime] at hmatch hreset + have hreset' : + TM.resetBinaryWorkManyTime (entryMissBits tapes entry queryBits) + (fun _ => 1 + entryMatchReadTime entry queryBits) + (entryMissTargets tapes) ≤ + 7 * (1 + entryMatchReadTime entry queryBits + 2 * bound + 9) + 1 := by + simpa [entryMissHeadBound, entryScanCanonicalWork, + TM.resetBinaryBlank, Tape.move, Tape.init] using hreset + unfold entryMissCleanupTime entryMissHeadBound entryScanCanonicalWork + simp only [Function.const_apply] + simp only [TM.resetBinaryBlank, Tape.move, Tape.init] + simp only [Nat.zero_add] + have hboundSq : bound ≤ (bound + 1) ^ 2 := by nlinarith + have honeSq : 1 ≤ (bound + 1) ^ 2 := by nlinarith + omega + +private theorem entryScanOneTime_le {m : ℕ} + (tapes : EntryScanTapes m) (entry : Entry) + (queryBits : List Bool) (bound : ℕ) + (hbound : 1 ≤ bound) + (haddress : entry.1.bits.length ≤ bound) + (hvalue : entry.2.bits.length ≤ bound) + (hquery : queryBits.length ≤ bound) : + entryScanOneTime tapes entry queryBits ≤ + 1200 * (bound + 1) ^ 2 := by + have hmatch := entryMatchReadTime_le entry queryBits bound + haddress hvalue hquery + have hcleanup := entryMissCleanupTime_canonical_le tapes.entry entry + queryBits bound hbound haddress hvalue hquery + unfold entryScanOneTime entryScanStepTime entryScanBranchTime + TM.branchWorkSymbolTime + have hbranch : 1 + max 1 + (entryMissCleanupTime tapes.entry entry queryBits + (entryScanCanonicalWork (n := m))) ≤ + 1 + 1000 * (bound + 1) ^ 2 := by + apply Nat.add_le_add_left + apply max_le + · have honeSq : 1 ≤ (bound + 1) ^ 2 := by nlinarith + omega + · exact hcleanup + have honeSq : 1 ≤ (bound + 1) ^ 2 := by nlinarith + omega + +private theorem entryScanTime_le {m : ℕ} (tapes : EntryScanTapes m) + (queryBits : List Bool) (store : Store) (bound : ℕ) + (hbound : 1 ≤ bound) (hstoreLength : store.length ≤ bound) + (hentries : ∀ entry ∈ store, + entry.1.bits.length ≤ bound ∧ entry.2.bits.length ≤ bound) + (hquery : queryBits.length ≤ bound) : + entryScanTime tapes queryBits store ≤ + 1300 * (store.length + 1) * (bound + 1) ^ 2 := by + induction store with + | nil => + simp [entryScanTime] + nlinarith + | cons entry rest ih => + have hentry := hentries entry (by simp) + have hrestEntries : ∀ current ∈ rest, + current.1.bits.length ≤ bound ∧ + current.2.bits.length ≤ bound := by + intro current hcurrent + exact hentries current (by simp [hcurrent]) + have hrestLength : rest.length ≤ bound := by + simp only [List.length_cons] at hstoreLength + omega + have hone := entryScanOneTime_le tapes entry queryBits bound hbound + hentry.1 hentry.2 hquery + have hpred := TM.binaryPredTime_le rest.length + have hpredSize : (rest.length + 1).size ≤ bound := by + exact le_trans (size_le_self (rest.length + 1)) (by simp_all) + have hpred' : TM.binaryPredTime rest.length ≤ 2 * bound + 2 := + le_trans hpred (by omega) + have htail := ih hrestLength hrestEntries + simp only [entryScanTime, List.length_cons] + have hboundSq : bound ≤ (bound + 1) ^ 2 := by nlinarith + have honeSq : 1 ≤ (bound + 1) ^ 2 := by nlinarith + nlinarith + +private theorem entryScanTime_le_cube {m : ℕ} + (tapes : EntryScanTapes m) (queryBits : List Bool) + (store : Store) (bound : ℕ) + (hbound : 1 ≤ bound) (hstoreLength : store.length ≤ bound) + (hentries : ∀ entry ∈ store, + entry.1.bits.length ≤ bound ∧ entry.2.bits.length ≤ bound) + (hquery : queryBits.length ≤ bound) : + entryScanTime tapes queryBits store ≤ 1300 * (bound + 1) ^ 3 := by + have htime := entryScanTime_le tapes queryBits store bound hbound + hstoreLength hentries hquery + have hfactor : store.length + 1 ≤ bound + 1 := by omega + calc + entryScanTime tapes queryBits store ≤ + 1300 * (store.length + 1) * (bound + 1) ^ 2 := htime + _ ≤ 1300 * (bound + 1) * (bound + 1) ^ 2 := by + exact Nat.mul_le_mul_right _ (Nat.mul_le_mul_left 1300 hfactor) + _ = 1300 * (bound + 1) ^ 3 := by ring + +private theorem encodedStoreLength_le_uniform (store : Store) (bound : ℕ) + (hentries : ∀ entry ∈ store, + entry.1.bits.length ≤ bound ∧ entry.2.bits.length ≤ bound) : + encodedStoreLength store ≤ store.length * (4 * bound + 2) := by + induction store with + | nil => simp [encodedStoreLength] + | cons entry rest ih => + have hentry := hentries entry (by simp) + have hrest : ∀ current ∈ rest, + current.1.bits.length ≤ bound ∧ + current.2.bits.length ≤ bound := by + intro current hcurrent + exact hentries current (by simp [hcurrent]) + have htail := ih hrest + have hhead : (Entry.encode entry).length ≤ 4 * bound + 2 := by + rw [Entry.encode_length] + have haddressWidth : bitlen entry.1 ≤ bound := by + simpa only [bitlen, Nat.size_eq_bits_len] using hentry.1 + have hvalueWidth : bitlen entry.2 ≤ bound := by + simpa only [bitlen, Nat.size_eq_bits_len] using hentry.2 + omega + unfold encodedStoreLength at htail ⊢ + simp only [List.flatMap_cons, List.length_append, List.length_cons, + Nat.succ_mul] + ring_nf at htail ⊢ + omega + +private theorem entryScanTime_le_square {m : ℕ} + (tapes : EntryScanTapes m) (queryBits : List Bool) + (store : Store) (bound : ℕ) + (hbound : 1 ≤ bound) (hstoreLength : store.length ≤ bound) + (hentries : ∀ entry ∈ store, + entry.1.bits.length ≤ bound ∧ entry.2.bits.length ≤ bound) + (hquery : queryBits.length ≤ bound) : + entryScanTime tapes queryBits store ≤ 7000 * (bound + 1) ^ 2 := by + have hscan := entryScanTime_le_encoded tapes queryBits store + have hencoded := encodedStoreLength_le_uniform store bound hentries + have hcount : bitlen store.length ≤ bound := by + unfold bitlen + exact le_trans (size_le_self store.length) hstoreLength + have hfactor : queryBits.length + bitlen store.length + 2 ≤ + 2 * bound + 2 := by omega + have hencoded' : encodedStoreLength store ≤ + bound * (4 * bound + 2) := + le_trans hencoded (Nat.mul_le_mul_right _ hstoreLength) + have hqueryTerm : store.length * + (queryBits.length + bitlen store.length + 2) ≤ + bound * (2 * bound + 2) := + Nat.mul_le_mul hstoreLength hfactor + have hinside : encodedStoreLength store + + store.length * (queryBits.length + bitlen store.length + 2) + 1 ≤ + 7 * (bound + 1) ^ 2 := by + nlinarith + exact le_trans hscan (by + calc + 1000 * (encodedStoreLength store + + store.length * + (queryBits.length + bitlen store.length + 2) + 1) + ≤ 1000 * (7 * (bound + 1) ^ 2) := + Nat.mul_le_mul_left 1000 hinside + _ = 7000 * (bound + 1) ^ 2 := by ring) + +private theorem read_bits_length_le (store : Store) (address bound : ℕ) + (hentries : ∀ entry ∈ store, entry.2.bits.length ≤ bound) : + (RegisterStore.read store address).bits.length ≤ bound := by + induction store with + | nil => simp [RegisterStore.read] + | cons entry rest ih => + have hentry := hentries entry (by simp) + have hrest : ∀ current ∈ rest, + current.2.bits.length ≤ bound := by + intro current hcurrent + exact hentries current (by simp [hcurrent]) + simp only [RegisterStore.read] + split + · exact hentry + · exact ih hrest + +private theorem entryLookupEntryWidth_le (entry : Entry) + (address bound : ℕ) (hbound : 1 ≤ bound) + (haddress : address.bits.length ≤ bound) + (hentryAddress : entry.1.bits.length ≤ bound) + (hentryValue : entry.2.bits.length ≤ bound) : + entryLookupEntryWidth entry address ≤ bound := by + have haddressWidth : bitlen entry.1 ≤ bound := by + simpa only [bitlen, Nat.size_eq_bits_len] using hentryAddress + have hvalueWidth : bitlen entry.2 ≤ bound := by + simpa only [bitlen, Nat.size_eq_bits_len] using hentryValue + unfold entryLookupEntryWidth + omega + +private theorem entryLookupStoreWidth_le (store : Store) + (address bound : ℕ) (hbound : 1 ≤ bound) + (haddress : address.bits.length ≤ bound) + (hentries : ∀ entry ∈ store, + entry.1.bits.length ≤ bound ∧ entry.2.bits.length ≤ bound) : + entryLookupStoreWidth address store ≤ bound := by + induction store with + | nil => simpa [entryLookupStoreWidth] using haddress + | cons entry rest ih => + have hentry := hentries entry (by simp) + have hrest : ∀ current ∈ rest, + current.1.bits.length ≤ bound ∧ + current.2.bits.length ≤ bound := by + intro current hcurrent + exact hentries current (by simp [hcurrent]) + simp only [entryLookupStoreWidth] + exact max_le + (entryLookupEntryWidth_le entry address bound hbound haddress + hentry.1 hentry.2) + (ih hrest) + +private theorem entryLookupResetWidth_le (store : Store) + (address bound : ℕ) (hbound : 1 ≤ bound) + (hstoreLength : store.length ≤ bound) + (haddress : address.bits.length ≤ bound) + (hentries : ∀ entry ∈ store, + entry.1.bits.length ≤ bound ∧ entry.2.bits.length ≤ bound) : + entryLookupResetWidth store address ≤ bound := by + have hlengthBits : store.length.bits.length ≤ bound := by + rw [Nat.size_eq_bits_len store.length] + exact le_trans (size_le_self store.length) hstoreLength + unfold entryLookupResetWidth + exact max_le hlengthBits + (entryLookupStoreWidth_le store address bound hbound haddress hentries) + +private theorem entryLookupLoadedTime_le {m : ℕ} + (tapes : EntryLookupRestoreTapes m) (store : Store) + (address bound : ℕ) (hbound : 1 ≤ bound) + (hstoreLength : store.length ≤ bound) + (haddress : address.bits.length ≤ bound) + (hentries : ∀ entry ∈ store, + entry.1.bits.length ≤ bound ∧ entry.2.bits.length ≤ bound) : + entryLookupLoadedTime tapes store address ≤ + 20000 * (bound + 1) ^ 3 := by + have hscan := entryScanTime_le_cube tapes.scan address.bits store bound + hbound hstoreLength hentries haddress + have hlookup : entryLookupTime tapes.scan address store ≤ + 1300 * (bound + 1) ^ 3 := hscan + have hwidth := entryLookupResetWidth_le store address bound hbound + hstoreLength haddress hentries + have hread := read_bits_length_le store address bound + (fun entry hentry => (hentries entry hentry).2) + have hcopyAddress := binaryCopyTime_le_width address 0 bound + (by simpa [Nat.size_eq_bits_len] using haddress) (by simp) + have hcopyRead := binaryCopyTime_le_width + (RegisterStore.read store address) 0 bound + (by simpa [Nat.size_eq_bits_len] using hread) (by simp) + have hcopyCount := binaryCopyTime_le_width store.length 0 bound + (le_trans (size_le_self store.length) hstoreLength) (by simp) + unfold entryLookupLoadedTime entryLookupCopyRestoreTime + entryLookupRestoreTailTime entryLookupResetTime + entryLookupRestoreHeadBound + have hboundCube : bound ≤ (bound + 1) ^ 3 := by + exact le_trans (by omega) + (Nat.le_self_pow (by decide : (3 : ℕ) ≠ 0) (bound + 1)) + have honeCube : 1 ≤ (bound + 1) ^ 3 := by + exact le_trans (by omega) hboundCube + omega + +private theorem entryLookupStaticTime_le {m : ℕ} + (tapes : EntryLookupRestoreTapes m) (store : Store) + (address bound : ℕ) (hbound : 1 ≤ bound) + (hstoreLength : store.length ≤ bound) + (haddressValue : address ≤ bound) + (hentries : ∀ entry ∈ store, + entry.1.bits.length ≤ bound ∧ entry.2.bits.length ≤ bound) : + entryLookupStaticTime tapes store address ≤ + 21000 * (bound + 1) ^ 3 := by + have haddress : address.bits.length ≤ bound := by + rw [Nat.size_eq_bits_len address] + exact le_trans (size_le_self address) haddressValue + have hloaded := entryLookupLoadedTime_le tapes store address bound hbound + hstoreLength haddress hentries + have hadd := binaryAddConstTime_zero_le_width address bound haddressValue + unfold entryLookupStaticTime + have hreset : TM.resetBinaryWorkTime 1 address.bits.length ≤ + 2 * bound + 9 := by + unfold TM.resetBinaryWorkTime TM.clearWorkTimeBound + omega + have hboundCube : bound ≤ (bound + 1) ^ 3 := by + exact le_trans (by omega) + (Nat.le_self_pow (by decide : (3 : ℕ) ≠ 0) (bound + 1)) + have honeCube : 1 ≤ (bound + 1) ^ 3 := by + exact le_trans (by omega) hboundCube + have hsqCube : (bound + 1) ^ 2 ≤ (bound + 1) ^ 3 := by + calc + (bound + 1) ^ 2 = (bound + 1) ^ 2 * 1 := by simp + _ ≤ (bound + 1) ^ 2 * (bound + 1) := + Nat.mul_le_mul_left _ (by omega) + _ = (bound + 1) ^ 3 := by ring + omega + +private theorem rewindEntryEncodeTime_le (entry : Entry) + (addressHead valueHead bound : ℕ) + (haddress : entry.1.bits.length ≤ bound) + (hvalue : entry.2.bits.length ≤ bound) + (haddressHead : addressHead ≤ bound) + (hvalueHead : valueHead ≤ bound) : + rewindEntryEncodeTime entry addressHead valueHead ≤ 10 * bound + 21 := by + unfold rewindEntryEncodeTime rewindWordEncodeTime wordEncodeTime + omega + +private theorem entryUpdatePostEmitHead_le {m : ℕ} + (tapes : EntryUpdateTapes m) (entry : Entry) (i : Fin m) + (bound : ℕ) (haddress : entry.1.bits.length ≤ bound) + (hvalue : entry.2.bits.length ≤ bound) : + entryUpdatePostEmitHead tapes entry i ≤ bound + 1 := by + have haddressWidth : bitlen entry.1 ≤ bound := by + simpa only [bitlen, Nat.size_eq_bits_len] using haddress + have hvalueWidth : bitlen entry.2 ≤ bound := by + simpa only [bitlen, Nat.size_eq_bits_len] using hvalue + unfold entryUpdatePostEmitHead + split_ifs <;> omega + +private theorem entryUpdateReadyCleanupTime_le {m : ℕ} + (tapes : EntryUpdateTapes m) (entry : Entry) (address bound : ℕ) + (hbound : 1 ≤ bound) + (hentryAddress : entry.1.bits.length ≤ bound) + (hentryValue : entry.2.bits.length ≤ bound) + (haddress : address.bits.length ≤ bound) : + entryUpdateReadyCleanupTime tapes entry address ≤ + 1000 * (bound + 1) ^ 2 := by + let matchTime := entryMatchReadTime entry address.bits + have hmatch : matchTime ≤ 100 * (bound + 1) ^ 2 := + entryMatchReadTime_le entry address.bits bound hentryAddress hentryValue + haddress + have hreset := TM.resetBinaryWorkManyTime_le + (entryMissTargets tapes.entry) (entryMissBits tapes.entry entry address.bits) + (fun _ => 1 + matchTime) (1 + matchTime) bound + (fun _ _ => le_rfl) + (fun i _ => entryMissBits_length_le tapes.entry entry address.bits bound + hbound hentryAddress hentryValue i) + have htargets : (entryMissTargets tapes.entry).length = 7 := by + simp [entryMissTargets] + rw [htargets] at hreset + unfold entryUpdateReadyCleanupTime + dsimp only [matchTime] at hmatch hreset ⊢ + have hboundSq : bound ≤ (bound + 1) ^ 2 := by nlinarith + have honeSq : 1 ≤ (bound + 1) ^ 2 := by nlinarith + omega + +private theorem entryUpdatePostEmitCleanupTime_le {m : ℕ} + (tapes : EntryUpdateTapes m) (entry : Entry) (address bound : ℕ) + (hbound : 1 ≤ bound) + (hentryAddress : entry.1.bits.length ≤ bound) + (hentryValue : entry.2.bits.length ≤ bound) + (haddress : address.bits.length ≤ bound) : + entryUpdatePostEmitCleanupTime tapes entry address ≤ + 2000 * (bound + 1) ^ 2 := by + let matchTime := entryMatchReadTime entry address.bits + have hmatch : matchTime ≤ 100 * (bound + 1) ^ 2 := + entryMatchReadTime_le entry address.bits bound hentryAddress hentryValue + haddress + have hreset := TM.resetBinaryWorkManyTime_le + (entryMissTargets tapes.entry) (entryMissBits tapes.entry entry address.bits) + (fun i => entryUpdatePostEmitHead tapes entry i + matchTime) + (bound + 1 + matchTime) bound + (fun i _ => Nat.add_le_add_right + (entryUpdatePostEmitHead_le tapes entry i bound hentryAddress hentryValue) + matchTime) + (fun i _ => entryMissBits_length_le tapes.entry entry address.bits bound + hbound hentryAddress hentryValue i) + have htargets : (entryMissTargets tapes.entry).length = 7 := by + simp [entryMissTargets] + rw [htargets] at hreset + unfold entryUpdatePostEmitCleanupTime + dsimp only [matchTime] at hmatch hreset ⊢ + have hboundSq : bound ≤ (bound + 1) ^ 2 := by nlinarith + have honeSq : 1 ≤ (bound + 1) ^ 2 := by nlinarith + omega + +private theorem entryUpdateBranchTime_le {m : ℕ} + (tapes : EntryUpdateTapes m) (entry : Entry) + (address newValue total bound : ℕ) (hbound : 1 ≤ bound) + (hentryAddress : entry.1.bits.length ≤ bound) + (hentryValue : entry.2.bits.length ≤ bound) + (haddress : address.bits.length ≤ bound) + (hnewValue : newValue.bits.length ≤ bound) + (htotal : total ≤ bound) : + entryUpdateBranchTime tapes entry address newValue total ≤ + 4000 * (bound + 1) ^ 2 := by + let matchTime := entryMatchReadTime entry address.bits + have hmatch : matchTime ≤ 100 * (bound + 1) ^ 2 := + entryMatchReadTime_le entry address.bits bound hentryAddress hentryValue + haddress + have hpost := entryUpdatePostEmitCleanupTime_le tapes entry address bound + hbound hentryAddress hentryValue haddress + have hready := entryUpdateReadyCleanupTime_le tapes entry address bound + hbound hentryAddress hentryValue haddress + have hrewindMiss := rewindEntryEncodeTime_le entry (1 + matchTime) + (1 + matchTime) (1 + 100 * (bound + 1) ^ 2) + (le_trans hentryAddress (by nlinarith)) + (le_trans hentryValue (by nlinarith)) (by omega) (by omega) + have hrewindReplace := rewindEntryEncodeTime_le (entry.1, newValue) + (1 + matchTime) 1 (1 + 100 * (bound + 1) ^ 2) + (le_trans hentryAddress (by nlinarith)) + (le_trans hnewValue (by nlinarith)) (by omega) (by omega) + have hcount : entryUpdateCountTime total ≤ 2 * bound + 2 := by + unfold entryUpdateCountTime + exact Nat.add_le_add_right + (Nat.mul_le_mul_left 2 (le_trans (size_le_self total) htotal)) 2 + unfold entryUpdateBranchTime entryUpdateMissTime entryUpdateReplaceTime + dsimp only [matchTime] at hmatch hpost hready hrewindMiss hrewindReplace ⊢ + have hboundSq : bound ≤ (bound + 1) ^ 2 := by nlinarith + have honeSq : 1 ≤ (bound + 1) ^ 2 := by nlinarith + apply max_le + · omega + · apply max_le <;> omega + +private theorem entryUpdateTime_le {m : ℕ} (tapes : EntryUpdateTapes m) + (store : Store) (address newValue bound : ℕ) + (hbound : 1 ≤ bound) (hstoreLength : store.length ≤ bound) + (hentries : ∀ entry ∈ store, + entry.1.bits.length ≤ bound ∧ entry.2.bits.length ≤ bound) + (haddress : address.bits.length ≤ bound) + (hnewValue : newValue.bits.length ≤ bound) : + entryUpdateTime tapes store address newValue ≤ + 5000 * (bound + 1) ^ 3 := by + have hloop : ∀ remaining : Store, remaining.length ≤ bound → + (∀ entry ∈ remaining, + entry.1.bits.length ≤ bound ∧ entry.2.bits.length ≤ bound) → + entryUpdateLoopTime tapes address newValue store.length remaining ≤ + 5000 * (remaining.length + 1) * (bound + 1) ^ 2 := by + intro remaining + induction remaining with + | nil => + intro _ _ + have hrewind := rewindEntryEncodeTime_le (address, newValue) 1 1 + bound haddress hnewValue hbound hbound + have hcount : entryUpdateCountTime store.length ≤ 2 * bound + 2 := by + unfold entryUpdateCountTime + exact Nat.add_le_add_right + (Nat.mul_le_mul_left 2 + (le_trans (size_le_self store.length) hstoreLength)) 2 + unfold entryUpdateLoopTime entryAppendRestoreTime + simp only [List.length_nil, Nat.zero_add, Nat.mul_one] + have hboundSq : bound ≤ (bound + 1) ^ 2 := by nlinarith + have honeSq : 1 ≤ (bound + 1) ^ 2 := by nlinarith + omega + | cons entry rest ih => + intro hremainingLength hremainingEntries + have hentry := hremainingEntries entry (by simp) + have hrestEntries : ∀ current ∈ rest, + current.1.bits.length ≤ bound ∧ + current.2.bits.length ≤ bound := by + intro current hcurrent + exact hremainingEntries current (by simp [hcurrent]) + have hrestLength : rest.length ≤ bound := by + simp only [List.length_cons] at hremainingLength + omega + have hmatch := entryMatchReadTime_le entry address.bits bound + hentry.1 hentry.2 haddress + have hbranch := entryUpdateBranchTime_le tapes entry address newValue + store.length bound hbound hentry.1 hentry.2 haddress hnewValue + hstoreLength + have hpred := TM.binaryPredTime_le rest.length + have hpredSize : (rest.length + 1).size ≤ bound := + le_trans (size_le_self (rest.length + 1)) (by + simp only [List.length_cons] at hremainingLength + omega) + have hpred' : TM.binaryPredTime rest.length ≤ 2 * bound + 2 := + le_trans hpred (by omega) + have htail := ih hrestLength hrestEntries + unfold entryUpdateLoopTime entryUpdateIterationTime + have hboundSq : bound ≤ (bound + 1) ^ 2 := by nlinarith + have honeSq : 1 ≤ (bound + 1) ^ 2 := by nlinarith + simp only [List.length_cons] + nlinarith + unfold entryUpdateTime + have htime := hloop store hstoreLength hentries + have hfactor : store.length + 1 ≤ bound + 1 := by omega + calc + entryUpdateLoopTime tapes address newValue store.length store ≤ + 5000 * (store.length + 1) * (bound + 1) ^ 2 := htime + _ ≤ 5000 * (bound + 1) * (bound + 1) ^ 2 := by + exact Nat.mul_le_mul_right _ (Nat.mul_le_mul_left 5000 hfactor) + _ = 5000 * (bound + 1) ^ 3 := by ring + +private theorem entriesEncode_length_le (store : Store) (bound : ℕ) + (hentries : ∀ entry ∈ store, + entry.1.bits.length ≤ bound ∧ entry.2.bits.length ≤ bound) : + (store.flatMap Entry.encode).length ≤ store.length * (4 * bound + 2) := by + induction store with + | nil => simp + | cons entry rest ih => + have hentry := hentries entry (by simp) + have hrest : ∀ current ∈ rest, + current.1.bits.length ≤ bound ∧ + current.2.bits.length ≤ bound := by + intro current hcurrent + exact hentries current (by simp [hcurrent]) + have htail := ih hrest + have hhead : (Entry.encode entry).length ≤ 4 * bound + 2 := by + rw [Entry.encode_length] + simpa [bitlen, Nat.size_eq_bits_len] using + (show 2 * entry.1.bits.length + 2 * entry.2.bits.length + 2 ≤ + 4 * bound + 2 by omega) + simp only [List.flatMap_cons, List.length_append, List.length_cons] + rw [Nat.succ_mul] + omega + +private theorem binaryInstructionArithmeticTime_le + (op : BinaryInstrOp) (lhs rhs bound : ℕ) + (hlhs : lhs.bits.length ≤ bound) + (hrhs : rhs.bits.length ≤ bound) : + binaryInstructionArithmeticTime op lhs rhs ≤ + 1000 * (bound + 1) ^ 2 := by + have hlhsSize : lhs.size ≤ bound := by + simpa [Nat.size_eq_bits_len] using hlhs + have hrhsSize : rhs.size ≤ bound := by + simpa [Nat.size_eq_bits_len] using hrhs + cases op with + | add => + have htime := TM.binaryRippleAddTime_le lhs rhs + have honeSq : 1 ≤ (bound + 1) ^ 2 := by nlinarith + have hboundSq : bound ≤ (bound + 1) ^ 2 := by nlinarith + change TM.binaryRippleAddTime lhs rhs ≤ 1000 * (bound + 1) ^ 2 + omega + | sub => + have htime := TM.binaryRippleSubTime_le lhs rhs + have honeSq : 1 ≤ (bound + 1) ^ 2 := by nlinarith + have hboundSq : bound ≤ (bound + 1) ^ 2 := by nlinarith + change TM.binaryRippleSubTime lhs rhs ≤ 1000 * (bound + 1) ^ 2 + omega + | mul => + change TM.binaryShiftMulTime lhs rhs ≤ 1000 * (bound + 1) ^ 2 + unfold TM.binaryShiftMulTime TM.binaryShiftMulWidth + nlinarith + +private theorem binaryInstrResult_bits_length_le + (op : BinaryInstrOp) (lhs rhs bound : ℕ) + (hlhs : lhs.bits.length ≤ bound) + (hrhs : rhs.bits.length ≤ bound) : + (op.eval lhs rhs).bits.length ≤ 2 * bound + 1 := by + have hlhsSize : lhs.size ≤ bound := by + simpa [Nat.size_eq_bits_len] using hlhs + have hrhsSize : rhs.size ≤ bound := by + simpa [Nat.size_eq_bits_len] using hrhs + rw [Nat.size_eq_bits_len (op.eval lhs rhs)] + cases op with + | add => + exact le_trans (TM.binaryRippleAdd_sum_size_le lhs rhs) (by omega) + | sub => + exact le_trans (Nat.size_le_size (Nat.sub_le lhs rhs)) (by omega) + | mul => + exact le_trans (BinaryShiftMul.size_mul_le_add lhs rhs) (by omega) + +private theorem directBinaryInstructionTime_le {m : ℕ} + (tapes : BinaryInstructionTapes m) (op : BinaryInstrOp) + (store : Store) (destination source₀ source₁ bound : ℕ) + (hbound : 1 ≤ bound) (hstoreLength : store.length ≤ bound) + (hentries : ∀ entry ∈ store, + entry.1.bits.length ≤ bound ∧ entry.2.bits.length ≤ bound) + (hdestination : destination ≤ bound) + (hsource₀ : source₀ ≤ bound) (hsource₁ : source₁ ≤ bound) : + directBinaryInstructionTime tapes op store destination source₀ source₁ ≤ + 100000 * (bound + 1) ^ 3 := by + let lhs := RegisterStore.read store source₀ + let rhs := RegisterStore.read store source₁ + have hlhs : lhs.bits.length ≤ bound := read_bits_length_le store source₀ bound + (fun entry hentry => (hentries entry hentry).2) + have hrhs : rhs.bits.length ≤ bound := read_bits_length_le store source₁ bound + (fun entry hentry => (hentries entry hentry).2) + have hlookup₀ := entryLookupStaticTime_le tapes.lhsLookup store source₀ + bound hbound hstoreLength hsource₀ hentries + have hlookup₁ := entryLookupStaticTime_le tapes.rhsLookup store source₁ + bound hbound hstoreLength hsource₁ hentries + have hadd := binaryAddConstTime_zero_le_width destination bound hdestination + have harithmetic := binaryInstructionArithmeticTime_le op lhs rhs bound hlhs hrhs + let wide := 2 * bound + 1 + have hwide : 1 ≤ wide := by omega + have hresult : (op.eval lhs rhs).bits.length ≤ wide := + binaryInstrResult_bits_length_le op lhs rhs bound hlhs hrhs + have hdestinationBitsWide : destination.bits.length ≤ wide := by + rw [Nat.size_eq_bits_len destination] + exact le_trans (size_le_self destination) (by omega) + have hupdate := entryUpdateTime_le tapes.update store destination + (op.eval lhs rhs) wide hwide (by omega) + (fun entry hentry => ⟨le_trans (hentries entry hentry).1 (by omega), + le_trans (hentries entry hentry).2 (by omega)⟩) + hdestinationBitsWide hresult + have hwideCube : (wide + 1) ^ 3 = 8 * (bound + 1) ^ 3 := by + simp only [wide] + ring + rw [hwideCube] at hupdate + dsimp only [lhs, rhs] at hlhs hrhs harithmetic hupdate ⊢ + unfold directBinaryInstructionTime binaryInstructionUpdateTime + have hsqCube : (bound + 1) ^ 2 ≤ (bound + 1) ^ 3 := by + calc + (bound + 1) ^ 2 = (bound + 1) ^ 2 * 1 := by simp + _ ≤ (bound + 1) ^ 2 * (bound + 1) := + Nat.mul_le_mul_left _ (by omega) + _ = (bound + 1) ^ 3 := by ring + have honeCube : 1 ≤ (bound + 1) ^ 3 := by + exact le_trans (by omega) + (Nat.le_self_pow (by decide : (3 : ℕ) ≠ 0) (bound + 1)) + omega + +private theorem immediateInstructionTime_le {m : ℕ} + (tapes : BinaryInstructionTapes m) (store : Store) + (destination value bound : ℕ) (hbound : 1 ≤ bound) + (hstoreLength : store.length ≤ bound) + (hentries : ∀ entry ∈ store, + entry.1.bits.length ≤ bound ∧ entry.2.bits.length ≤ bound) + (hdestination : destination ≤ bound) (hvalue : value ≤ bound) : + immediateInstructionTime tapes store destination value ≤ + 30000 * (bound + 1) ^ 3 := by + have hvalueBits : value.bits.length ≤ bound := by + rw [Nat.size_eq_bits_len value] + exact le_trans (size_le_self value) hvalue + have hdestinationBits : destination.bits.length ≤ bound := by + rw [Nat.size_eq_bits_len destination] + exact le_trans (size_le_self destination) hdestination + have hupdate := entryUpdateTime_le tapes.update store destination value bound + hbound hstoreLength hentries hdestinationBits hvalueBits + have hvalueAdd := binaryAddConstTime_zero_le_width value bound hvalue + have hdestinationAdd := binaryAddConstTime_zero_le_width destination bound + hdestination + unfold immediateInstructionTime + have hsqCube : (bound + 1) ^ 2 ≤ (bound + 1) ^ 3 := by + calc + (bound + 1) ^ 2 = (bound + 1) ^ 2 * 1 := by simp + _ ≤ (bound + 1) ^ 2 * (bound + 1) := + Nat.mul_le_mul_left _ (by omega) + _ = (bound + 1) ^ 3 := by ring + have honeCube : 1 ≤ (bound + 1) ^ 3 := by + exact le_trans (by omega) + (Nat.le_self_pow (by decide : (3 : ℕ) ≠ 0) (bound + 1)) + omega + +private theorem indirectLoadInstructionTime_le {m : ℕ} + (tapes : BinaryInstructionTapes m) (store : Store) + (destination addressRegister bound : ℕ) (hbound : 1 ≤ bound) + (hstoreLength : store.length ≤ bound) + (hentries : ∀ entry ∈ store, + entry.1.bits.length ≤ bound ∧ entry.2.bits.length ≤ bound) + (hdestination : destination ≤ bound) + (haddressRegister : addressRegister ≤ bound) : + indirectLoadInstructionTime tapes store destination addressRegister ≤ + 80000 * (bound + 1) ^ 3 := by + let address := RegisterStore.read store addressRegister + let value := RegisterStore.read store address + have haddress : address.bits.length ≤ bound := read_bits_length_le store + addressRegister bound (fun entry hentry => (hentries entry hentry).2) + have hvalue : value.bits.length ≤ bound := read_bits_length_le store address + bound (fun entry hentry => (hentries entry hentry).2) + have hlookup := entryLookupStaticTime_le tapes.lhsLookup store addressRegister + bound hbound hstoreLength haddressRegister hentries + have hloaded := entryLookupLoadedTime_le tapes.indirectLoadLookup store address + bound hbound hstoreLength haddress hentries + have hadd := binaryAddConstTime_zero_le_width destination bound hdestination + have hdestinationBits : destination.bits.length ≤ bound := by + rw [Nat.size_eq_bits_len destination] + exact le_trans (size_le_self destination) hdestination + have hupdate := entryUpdateTime_le tapes.update store destination value bound + hbound hstoreLength hentries hdestinationBits hvalue + dsimp only [address, value] at hloaded hupdate ⊢ + unfold indirectLoadInstructionTime + have hsqCube : (bound + 1) ^ 2 ≤ (bound + 1) ^ 3 := by + calc + (bound + 1) ^ 2 = (bound + 1) ^ 2 * 1 := by simp + _ ≤ (bound + 1) ^ 2 * (bound + 1) := + Nat.mul_le_mul_left _ (by omega) + _ = (bound + 1) ^ 3 := by ring + have honeCube : 1 ≤ (bound + 1) ^ 3 := by + exact le_trans (by omega) + (Nat.le_self_pow (by decide : (3 : ℕ) ≠ 0) (bound + 1)) + omega + +private theorem indirectStoreInstructionTime_le {m : ℕ} + (tapes : BinaryInstructionTapes m) (store : Store) + (addressRegister source bound : ℕ) (hbound : 1 ≤ bound) + (hstoreLength : store.length ≤ bound) + (hentries : ∀ entry ∈ store, + entry.1.bits.length ≤ bound ∧ entry.2.bits.length ≤ bound) + (haddressRegister : addressRegister ≤ bound) (hsource : source ≤ bound) : + indirectStoreInstructionTime tapes store addressRegister source ≤ + 80000 * (bound + 1) ^ 3 := by + let address := RegisterStore.read store addressRegister + let value := RegisterStore.read store source + have haddress : address.bits.length ≤ bound := read_bits_length_le store + addressRegister bound (fun entry hentry => (hentries entry hentry).2) + have hvalue : value.bits.length ≤ bound := read_bits_length_le store source + bound (fun entry hentry => (hentries entry hentry).2) + have hlookupAddress := entryLookupStaticTime_le tapes.lhsLookup store + addressRegister bound hbound hstoreLength haddressRegister hentries + have hlookupValue := entryLookupStaticTime_le tapes.rhsLookup store source + bound hbound hstoreLength hsource hentries + have hcopyAddress := binaryCopyTime_le_width address 0 bound + (by simpa [Nat.size_eq_bits_len] using haddress) (by simp) + have hcopyValue := binaryCopyTime_le_width value 0 bound + (by simpa [Nat.size_eq_bits_len] using hvalue) (by simp) + have hupdate := entryUpdateTime_le tapes.update store address value bound + hbound hstoreLength hentries haddress hvalue + dsimp only [address, value] at hcopyAddress hcopyValue hupdate ⊢ + unfold indirectStoreInstructionTime + have hboundCube : bound ≤ (bound + 1) ^ 3 := by + exact le_trans (by omega) + (Nat.le_self_pow (by decide : (3 : ℕ) ≠ 0) (bound + 1)) + have honeCube : 1 ≤ (bound + 1) ^ 3 := by + exact le_trans (by omega) hboundCube + omega + +private theorem executeInstructionTime_le {m : ℕ} + (tapes : ControlInstructionTapes m) (instruction : Instr) + (pcValue : ℕ) (store : Store) (bound : ℕ) + (hbound : 1 ≤ bound) (hstoreLength : store.length ≤ bound) + (hentries : ∀ entry ∈ store, + entry.1.bits.length ≤ bound ∧ entry.2.bits.length ≤ bound) + (hpc : pcValue.bits.length ≤ bound) + (hinstruction : instructionResourceMagnitude instruction ≤ bound) : + executeInstructionTime tapes instruction pcValue store ≤ + 200000 * (bound + 1) ^ 3 := by + have hpcSucc : TM.binarySuccTime pcValue ≤ 2 * bound + 2 := + binarySuccTime_le_width pcValue bound (by + simpa [Nat.size_eq_bits_len] using hpc) + have hencoded := entriesEncode_length_le store bound hentries + have hencodedCube : (store.flatMap Entry.encode).length ≤ + 6 * (bound + 1) ^ 3 := by + have hproduct := Nat.mul_le_mul hstoreLength (show 4 * bound + 2 ≤ + 6 * (bound + 1) by omega) + have hsqCube : (bound + 1) ^ 2 ≤ (bound + 1) ^ 3 := by + calc + (bound + 1) ^ 2 = (bound + 1) ^ 2 * 1 := by simp + _ ≤ (bound + 1) ^ 2 * (bound + 1) := + Nat.mul_le_mul_left _ (by omega) + _ = (bound + 1) ^ 3 := by ring + calc + (store.flatMap Entry.encode).length ≤ store.length * (4 * bound + 2) := + hencoded + _ ≤ bound * (6 * (bound + 1)) := hproduct + _ ≤ 6 * (bound + 1) ^ 2 := by nlinarith + _ ≤ 6 * (bound + 1) ^ 3 := Nat.mul_le_mul_left 6 hsqCube + have hresetPC : TM.resetBinaryWorkTime 1 pcValue.bits.length ≤ + 2 * bound + 9 := by + unfold TM.resetBinaryWorkTime TM.clearWorkTimeBound + omega + have hboundCube : bound ≤ (bound + 1) ^ 3 := by + exact le_trans (by omega) + (Nat.le_self_pow (by decide : (3 : ℕ) ≠ 0) (bound + 1)) + have honeCube : 1 ≤ (bound + 1) ^ 3 := by + exact le_trans (by omega) hboundCube + cases instruction with + | imm destination value => + simp only [instructionResourceMagnitude] at hinstruction + have htime := immediateInstructionTime_le tapes.data store destination value + bound hbound hstoreLength hentries (by omega) (by omega) + simp only [executeInstructionTime] + omega + | add destination source₀ source₁ => + simp only [instructionResourceMagnitude] at hinstruction + have htime := directBinaryInstructionTime_le tapes.data .add store + destination source₀ source₁ bound hbound hstoreLength hentries + (by omega) (by omega) (by omega) + simp only [executeInstructionTime] + omega + | sub destination source₀ source₁ => + simp only [instructionResourceMagnitude] at hinstruction + have htime := directBinaryInstructionTime_le tapes.data .sub store + destination source₀ source₁ bound hbound hstoreLength hentries + (by omega) (by omega) (by omega) + simp only [executeInstructionTime] + omega + | mul destination source₀ source₁ => + simp only [instructionResourceMagnitude] at hinstruction + have htime := directBinaryInstructionTime_le tapes.data .mul store + destination source₀ source₁ bound hbound hstoreLength hentries + (by omega) (by omega) (by omega) + simp only [executeInstructionTime] + omega + | load destination addressRegister => + simp only [instructionResourceMagnitude] at hinstruction + have htime := indirectLoadInstructionTime_le tapes.data store destination + addressRegister bound hbound hstoreLength hentries (by omega) (by omega) + simp only [executeInstructionTime] + omega + | store addressRegister source => + simp only [instructionResourceMagnitude] at hinstruction + have htime := indirectStoreInstructionTime_le tapes.data store + addressRegister source bound hbound hstoreLength hentries (by omega) + (by omega) + simp only [executeInstructionTime] + omega + | jz source target => + simp only [instructionResourceMagnitude] at hinstruction + have hlookup := entryLookupStaticTime_le tapes.lifted.data.lhsLookup store + source bound hbound hstoreLength (by omega) hentries + have hadd := binaryAddConstTime_zero_le_width target bound (by omega) + have hread := read_bits_length_le store source bound + (fun entry hentry => (hentries entry hentry).2) + have hresetRead : TM.resetBinaryWorkTime 1 + (RegisterStore.read store source).bits.length ≤ 2 * bound + 9 := by + unfold TM.resetBinaryWorkTime TM.clearWorkTimeBound + omega + change zeroJumpInstructionTime tapes.lifted store pcValue source target + 1 + + (store.flatMap Entry.encode).length + 1 ≤ + 200000 * (bound + 1) ^ 3 + unfold zeroJumpInstructionTime setProgramCounterTime + TM.branchWorkBlankTime + have hsqCube : (bound + 1) ^ 2 ≤ (bound + 1) ^ 3 := by + calc + (bound + 1) ^ 2 = (bound + 1) ^ 2 * 1 := by simp + _ ≤ (bound + 1) ^ 2 * (bound + 1) := + Nat.mul_le_mul_left _ (by omega) + _ = (bound + 1) ^ 3 := by ring + omega + | jmp target => + simp only [instructionResourceMagnitude] at hinstruction + have hadd := binaryAddConstTime_zero_le_width target bound (by omega) + change jumpInstructionTime pcValue target + 1 + + (store.flatMap Entry.encode).length + 1 ≤ + 200000 * (bound + 1) ^ 3 + unfold jumpInstructionTime setProgramCounterTime + have hsqCube : (bound + 1) ^ 2 ≤ (bound + 1) ^ 3 := by + calc + (bound + 1) ^ 2 = (bound + 1) ^ 2 * 1 := by simp + _ ≤ (bound + 1) ^ 2 * (bound + 1) := + Nat.mul_le_mul_left _ (by omega) + _ = (bound + 1) ^ 3 := by ring + omega + | halt => + change haltInstructionTime + 1 + (store.flatMap Entry.encode).length + 1 ≤ + 200000 * (bound + 1) ^ 3 + unfold haltInstructionTime + omega + +private theorem instructionResourceMagnitude_le_program + (instruction : Instr) (program : Program) (hinstruction : instruction ∈ program) : + instructionResourceMagnitude instruction ≤ programResourceMagnitude program := by + induction program with + | nil => simp at hinstruction + | cons head rest ih => + simp only [List.mem_cons] at hinstruction + unfold programResourceMagnitude + simp only [List.length_cons, List.map_cons, List.sum_cons] + rcases hinstruction with rfl | hinstruction + · omega + · have htail := ih hinstruction + unfold programResourceMagnitude at htail + omega + +private theorem dispatchProgramTime_le {m : ℕ} + (tapes : ControlInstructionTapes m) (store : Store) (pcValue : ℕ) + (program : Program) (selector bound : ℕ) + (hbound : 1 ≤ bound) (hstoreLength : store.length ≤ bound) + (hentries : ∀ entry ∈ store, + entry.1.bits.length ≤ bound ∧ entry.2.bits.length ≤ bound) + (hpc : pcValue.bits.length ≤ bound) (hselector : selector ≤ pcValue) + (hprogram : ∀ instruction ∈ program, + instructionResourceMagnitude instruction ≤ bound) : + dispatchProgramTime tapes store pcValue program selector ≤ + 210000 * (program.length + 1) * (bound + 1) ^ 3 := by + induction program generalizing selector with + | nil => + have hselectorBits : selector.bits.length ≤ bound := by + rw [Nat.size_eq_bits_len selector] + have hsize := Nat.size_le_size hselector + simpa [Nat.size_eq_bits_len] using le_trans hsize (by + simpa [Nat.size_eq_bits_len] using hpc) + have hreset : TM.resetBinaryWorkTime 1 selector.bits.length ≤ + 2 * bound + 9 := by + unfold TM.resetBinaryWorkTime TM.clearWorkTimeBound + omega + have hexecute := executeInstructionTime_le tapes .halt pcValue store bound + hbound hstoreLength hentries hpc (by + simpa [instructionResourceMagnitude] using hbound) + simp only [dispatchProgramTime, List.length_nil, Nat.zero_add] + have hboundCube : bound ≤ (bound + 1) ^ 3 := by + exact le_trans (by omega) + (Nat.le_self_pow (by decide : (3 : ℕ) ≠ 0) (bound + 1)) + have honeCube : 1 ≤ (bound + 1) ^ 3 := by + exact le_trans (by omega) hboundCube + omega + | cons instruction rest ih => + have hinstruction := hprogram instruction (by simp) + have hrest : ∀ current ∈ rest, + instructionResourceMagnitude current ≤ bound := by + intro current hcurrent + exact hprogram current (by simp [hcurrent]) + have hexecute := executeInstructionTime_le tapes instruction pcValue store + bound hbound hstoreLength hentries hpc hinstruction + have hrecursive := ih (selector - 1) (Nat.sub_le selector 1 |>.trans hselector) + hrest + have hpred := TM.binaryPredTime_le (selector - 1) + have hpredSize : (selector - 1 + 1).size ≤ bound + 1 := by + have hvalue : selector - 1 + 1 ≤ pcValue + 1 := by omega + have hsize := Nat.size_le_size hvalue + have hpcSize : pcValue.size ≤ bound := by + simpa [Nat.size_eq_bits_len] using hpc + have hpcSucc : (pcValue + 1).size ≤ bound + 1 := by + rw [Nat.size_le] + have hlt := Nat.lt_size_self pcValue + have hpow := Nat.pow_le_pow_right (by decide : 1 ≤ 2) hpcSize + rw [pow_succ] + omega + exact le_trans hsize hpcSucc + have hpred' : TM.binaryPredTime (selector - 1) ≤ + 2 * (bound + 1) + 2 := le_trans hpred (by omega) + simp only [dispatchProgramTime, TM.branchWorkBlankTime, + List.length_cons] + have hboundCube : bound ≤ (bound + 1) ^ 3 := by + exact le_trans (by omega) + (Nat.le_self_pow (by decide : (3 : ℕ) ≠ 0) (bound + 1)) + have honeCube : 1 ≤ (bound + 1) ^ 3 := by + exact le_trans (by omega) hboundCube + have hmax : max (executeInstructionTime tapes instruction pcValue store) + (TM.binaryPredTime (selector - 1) + 1 + + dispatchProgramTime tapes store pcValue rest (selector - 1)) ≤ + 200000 * (bound + 1) ^ 3 + 1 + + 210000 * (rest.length + 1) * (bound + 1) ^ 3 := by + apply max_le + · omega + · omega + nlinarith + +private theorem programInstructionTime_le {m : ℕ} + (tapes : ControlInstructionTapes m) (program : Program) + (pcValue : ℕ) (store : Store) (bound : ℕ) + (hbound : 1 ≤ bound) (hstoreLength : store.length ≤ bound) + (hentries : ∀ entry ∈ store, + entry.1.bits.length ≤ bound ∧ entry.2.bits.length ≤ bound) + (hpc : pcValue.bits.length ≤ bound) + (hprogram : programResourceMagnitude program ≤ bound) : + programInstructionTime tapes program pcValue store ≤ + 220000 * (program.length + 1) * (bound + 1) ^ 3 := by + have hdispatch := dispatchProgramTime_le tapes store pcValue program pcValue + bound hbound hstoreLength hentries hpc le_rfl + (fun instruction hinstruction => le_trans + (instructionResourceMagnitude_le_program instruction program hinstruction) + hprogram) + have hcopy := binaryCopyTime_le_width pcValue 0 bound + (by simpa [Nat.size_eq_bits_len] using hpc) (by simp) + unfold programInstructionTime + have hboundCube : bound ≤ (bound + 1) ^ 3 := by + exact le_trans (by omega) + (Nat.le_self_pow (by decide : (3 : ℕ) ≠ 0) (bound + 1)) + have honeCube : 1 ≤ (bound + 1) ^ 3 := by + exact le_trans (by omega) hboundCube + nlinarith + +private theorem bits_length_le_of_value_le (value bound : ℕ) + (hvalue : value ≤ bound) : value.bits.length ≤ bound := by + rw [Nat.size_eq_bits_len value] + exact le_trans (size_le_self value) hvalue + +private theorem maxWidth_le_of_entries (store : Store) (bound : ℕ) + (hentries : ∀ entry ∈ store, + entry.1.bits.length ≤ bound ∧ entry.2.bits.length ≤ bound) : + maxWidth store ≤ bound := by + induction store with + | nil => simp [maxWidth] + | cons entry rest ih => + have hentry := hentries entry (by simp) + have hrest : ∀ current ∈ rest, + current.1.bits.length ≤ bound ∧ current.2.bits.length ≤ bound := by + intro current hcurrent + exact hentries current (by simp [hcurrent]) + simpa [maxWidth, bitlen, Nat.size_eq_bits_len] using + (max_le hentry.1 (max_le hentry.2 (ih hrest))) + +private theorem snapshotWidth_le_of_bounds (pcValue : ℕ) (store : Store) + (bound : ℕ) (hstoreLength : store.length ≤ bound) + (hentries : ∀ entry ∈ store, + entry.1.bits.length ≤ bound ∧ entry.2.bits.length ≤ bound) + (hpc : pcValue.bits.length ≤ bound) : + Snapshot.width { pc := pcValue, store := store } ≤ bound := by + have hcount : store.length.bits.length ≤ bound := + bits_length_le_of_value_le store.length bound hstoreLength + have hwidth := maxWidth_le_of_entries store bound hentries + simpa [Snapshot.width, bitlen, Nat.size_eq_bits_len] using + (max_le hpc (max_le hcount hwidth)) + +private theorem entryBitlen_le_maxWidth (store : Store) (entry : Entry) + (hentry : entry ∈ store) : + max (bitlen entry.1) (bitlen entry.2) ≤ maxWidth store := by + induction store with + | nil => simp at hentry + | cons head rest ih => + simp only [List.mem_cons] at hentry + rcases hentry with rfl | hentry + · simp only [maxWidth] + exact max_le (le_max_left _ _) + (le_trans (le_max_left _ _) (le_max_right _ _)) + · exact le_trans (ih hentry) + (le_trans (le_max_right _ _) (le_max_right _ _)) + +private theorem snapshotEntryBits_le_width (snapshot : Snapshot) + (entry : Entry) (hentry : entry ∈ snapshot.store) : + entry.1.bits.length ≤ snapshot.width ∧ + entry.2.bits.length ≤ snapshot.width := by + have hstore : maxWidth snapshot.store ≤ snapshot.width := + le_trans (le_max_right _ _) (le_max_right _ _) + have hmember : max (bitlen entry.1) (bitlen entry.2) ≤ + maxWidth snapshot.store := + entryBitlen_le_maxWidth snapshot.store entry hentry + have hboth := le_trans hmember hstore + simpa [bitlen, Nat.size_eq_bits_len] using + (show bitlen entry.1 ≤ snapshot.width ∧ + bitlen entry.2 ≤ snapshot.width from + ⟨le_trans (le_max_left _ _) hboth, + le_trans (le_max_right _ _) hboth⟩) + +private theorem instructionLogCost_le (instruction : Instr) + (pcValue : ℕ) (store : Store) (bound : ℕ) + (hentries : ∀ entry ∈ store, + entry.1.bits.length ≤ bound ∧ entry.2.bits.length ≤ bound) + (hinstruction : instructionResourceMagnitude instruction ≤ bound) : + instruction.logCost + (Snapshot.decode { pc := pcValue, store := store }) ≤ + 6 * (bound + 1) := by + have hread (address : ℕ) : + (RegisterStore.read store address).bits.length ≤ bound := + read_bits_length_le store address bound + (fun entry hentry => (hentries entry hentry).2) + cases instruction with + | imm destination value => + simp only [instructionResourceMagnitude] at hinstruction + simp only [Instr.logCost] + have hvalue := bits_length_le_of_value_le value bound (by omega) + simpa [bitlen, Nat.size_eq_bits_len] using + (show value.bits.length + 1 ≤ 6 * (bound + 1) by omega) + | add destination source₀ source₁ => + simp only [instructionResourceMagnitude] at hinstruction + have hlhs := hread source₀ + have hrhs := hread source₁ + have hresult := binaryInstrResult_bits_length_le .add + (RegisterStore.read store source₀) + (RegisterStore.read store source₁) bound hlhs hrhs + have hresult' : (RegisterStore.read store source₀ + + RegisterStore.read store source₁).bits.length ≤ 2 * bound + 1 := by + simpa [BinaryInstrOp.eval] using hresult + simpa [Instr.logCost, Snapshot.decode, RegisterStore.decode, bitlen, + Nat.size_eq_bits_len, BinaryInstrOp.eval] using + (show (RegisterStore.read store source₀).bits.length + + (RegisterStore.read store source₁).bits.length + + (RegisterStore.read store source₀ + + RegisterStore.read store source₁).bits.length + 1 ≤ + 6 * (bound + 1) by omega) + | sub destination source₀ source₁ => + have hlhs := hread source₀ + have hrhs := hread source₁ + simpa [Instr.logCost, Snapshot.decode, RegisterStore.decode, bitlen, + Nat.size_eq_bits_len] using + (show (RegisterStore.read store source₀).bits.length + + (RegisterStore.read store source₁).bits.length + 1 ≤ + 6 * (bound + 1) by omega) + | mul destination source₀ source₁ => + have hlhs := hread source₀ + have hrhs := hread source₁ + have hresult := binaryInstrResult_bits_length_le .mul + (RegisterStore.read store source₀) + (RegisterStore.read store source₁) bound hlhs hrhs + have hresult' : (RegisterStore.read store source₀ * + RegisterStore.read store source₁).bits.length ≤ 2 * bound + 1 := by + simpa [BinaryInstrOp.eval] using hresult + simpa [Instr.logCost, Snapshot.decode, RegisterStore.decode, bitlen, + Nat.size_eq_bits_len, BinaryInstrOp.eval] using + (show (RegisterStore.read store source₀).bits.length + + (RegisterStore.read store source₁).bits.length + + (RegisterStore.read store source₀ * + RegisterStore.read store source₁).bits.length + 1 ≤ + 6 * (bound + 1) by omega) + | load destination addressRegister => + have haddress := hread addressRegister + have hvalue := hread (RegisterStore.read store addressRegister) + simpa [Instr.logCost, Snapshot.decode, RegisterStore.decode, bitlen, + Nat.size_eq_bits_len] using + (show (RegisterStore.read store addressRegister).bits.length + + (RegisterStore.read store + (RegisterStore.read store addressRegister)).bits.length + 1 ≤ + 6 * (bound + 1) by omega) + | store addressRegister source => + have haddress := hread addressRegister + have hvalue := hread source + simpa [Instr.logCost, Snapshot.decode, RegisterStore.decode, bitlen, + Nat.size_eq_bits_len] using + (show (RegisterStore.read store addressRegister).bits.length + + (RegisterStore.read store source).bits.length + 1 ≤ + 6 * (bound + 1) by omega) + | jz source target => + have hvalue := hread source + simpa [Instr.logCost, Snapshot.decode, RegisterStore.decode, bitlen, + Nat.size_eq_bits_len] using + (show (RegisterStore.read store source).bits.length + 1 ≤ + 6 * (bound + 1) by omega) + | jmp target => simp only [Instr.logCost]; omega + | halt => simp only [Instr.logCost]; omega + +private theorem write_length_le (store : Store) (address value : ℕ) : + (RegisterStore.write store address value).length ≤ store.length + 1 := by + induction store with + | nil => + by_cases hvalue : value = 0 <;> + simp [RegisterStore.write, hvalue] + | cons entry rest ih => + rcases entry with ⟨storedAddress, storedValue⟩ + by_cases haddress : address = storedAddress + · subst address + by_cases hvalue : value = 0 + · simp [RegisterStore.write, hvalue] + omega + · simp [RegisterStore.write, hvalue] + · simp only [RegisterStore.write, haddress, ↓reduceIte, + List.length_cons] + omega + +private theorem instructionStoreBounds (instruction : Instr) + (pcValue : ℕ) (store : Store) (bound : ℕ) (hbound : 1 ≤ bound) + (hstoreLength : store.length ≤ bound) + (hentries : ∀ entry ∈ store, + entry.1.bits.length ≤ bound ∧ entry.2.bits.length ≤ bound) + (hpc : pcValue.bits.length ≤ bound) + (hinstruction : instructionResourceMagnitude instruction ≤ bound) : + (instructionStore instruction pcValue store).length ≤ bound + 1 ∧ + ∀ entry ∈ instructionStore instruction pcValue store, + entry.1.bits.length ≤ 6 * (bound + 1) ∧ + entry.2.bits.length ≤ 6 * (bound + 1) := by + let snapshot : Snapshot := { pc := pcValue, store := store } + let next := Snapshot.stepInstr instruction snapshot + have hsnapshot : snapshot.width ≤ bound := + snapshotWidth_le_of_bounds pcValue store bound hstoreLength hentries hpc + have hstatic := instructionStaticWidth_le_resourceMagnitude instruction + have hcost := instructionLogCost_le instruction pcValue store bound hentries + hinstruction + have hnextWidth : next.width ≤ 6 * (bound + 1) := by + exact le_trans (Snapshot.width_stepInstr_le instruction snapshot) (by + unfold Snapshot.stepWidthBound + exact max_le (by omega) + (max_le (le_trans (le_trans hstatic hinstruction) (by omega)) hcost)) + have hnextLength : next.store.length ≤ bound + 1 := by + cases instruction with + | imm destination value => + exact le_trans (write_length_le store destination value) (by omega) + | add destination source₀ source₁ => + exact le_trans (write_length_le store destination _) (by omega) + | sub destination source₀ source₁ => + exact le_trans (write_length_le store destination _) (by omega) + | mul destination source₀ source₁ => + exact le_trans (write_length_le store destination _) (by omega) + | load destination addressRegister => + exact le_trans (write_length_le store destination _) (by omega) + | store addressRegister source => + exact le_trans (write_length_le store _ _) (by omega) + | jz source target => + simp only [next, snapshot, Snapshot.stepInstr] + split <;> simp_all <;> omega + | jmp target => simp [next, snapshot, Snapshot.stepInstr]; omega + | halt => simp [next, snapshot, Snapshot.stepInstr]; omega + constructor + · simpa [next, snapshot, instructionStore] using hnextLength + · intro entry hentry + have := snapshotEntryBits_le_width next entry (by + simpa [next, snapshot, instructionStore] using hentry) + exact ⟨le_trans this.1 hnextWidth, le_trans this.2 hnextWidth⟩ + +private theorem instructionCleanupResetBits_le + (instruction : Instr) (store : Store) (bound : ℕ) (hbound : 1 ≤ bound) + (hstoreLength : store.length ≤ bound) + (hentries : ∀ entry ∈ store, + entry.1.bits.length ≤ bound ∧ entry.2.bits.length ≤ bound) + (hinstruction : instructionResourceMagnitude instruction ≤ bound) + (slot : Fin 7) : + (instructionCleanupResetBits instruction store slot).length ≤ + 6 * (bound + 1) ^ 2 := by + have hread (address : ℕ) : + (RegisterStore.read store address).bits.length ≤ bound := + read_bits_length_le store address bound + (fun entry hentry => (hentries entry hentry).2) + have hencoded := entriesEncode_length_le store bound hentries + have hencodedWide : (store.flatMap Entry.encode).length ≤ + 6 * (bound + 1) ^ 2 := by + have hproduct := Nat.mul_le_mul hstoreLength (show 4 * bound + 2 ≤ + 6 * (bound + 1) by omega) + exact le_trans hencoded (le_trans hproduct (by nlinarith)) + have hencodedWide' : (store.map (fun entry => entry.encode.length)).sum ≤ + 6 * (bound + 1) ^ 2 := by + simpa only [List.length_flatMap] using hencodedWide + have hboundWide : bound ≤ 6 * (bound + 1) ^ 2 := by nlinarith + have hstoreLengthBitsWide : store.length.bits.length ≤ + 6 * (bound + 1) ^ 2 := by + exact le_trans (by + rw [Nat.size_eq_bits_len store.length] + exact le_trans (size_le_self store.length) hstoreLength) hboundWide + have hsmall (width : ℕ) (hwidth : width ≤ 2 * bound + 1) : + width ≤ 6 * (bound + 1) ^ 2 := by nlinarith + cases instruction with + | imm destination value => + simp only [instructionResourceMagnitude] at hinstruction + have hdestination := bits_length_le_of_value_le destination bound (by omega) + have hvalue := bits_length_le_of_value_le value bound (by omega) + have hdestinationWide := le_trans hdestination hboundWide + have hvalueWide := le_trans hvalue hboundWide + fin_cases slot <;> + simp [instructionCleanupResetBits, instructionCleanupValue, + instructionRemainingValue] <;> + (try split_ifs) <;> simp_all + | add destination source₀ source₁ => + simp only [instructionResourceMagnitude] at hinstruction + have hdestination := bits_length_le_of_value_le destination bound (by omega) + have hlhs := hread source₀ + have hrhs := hread source₁ + have hresult := binaryInstrResult_bits_length_le .add + (RegisterStore.read store source₀) (RegisterStore.read store source₁) + bound hlhs hrhs + have hdestinationWide := le_trans hdestination hboundWide + have hlhsWide := le_trans hlhs hboundWide + have hrhsWide := le_trans hrhs hboundWide + have hresultWide : + (RegisterStore.read store source₀ + + RegisterStore.read store source₁).bits.length ≤ + 6 * (bound + 1) ^ 2 := by + simpa [BinaryInstrOp.eval] using hsmall _ hresult + fin_cases slot <;> + simp [instructionCleanupResetBits, instructionCleanupValue, + instructionRemainingValue] <;> + (try split_ifs) <;> simp_all + | sub destination source₀ source₁ => + simp only [instructionResourceMagnitude] at hinstruction + have hdestination := bits_length_le_of_value_le destination bound (by omega) + have hlhs := hread source₀ + have hrhs := hread source₁ + have hresult := binaryInstrResult_bits_length_le .sub + (RegisterStore.read store source₀) (RegisterStore.read store source₁) + bound hlhs hrhs + have hdestinationWide := le_trans hdestination hboundWide + have hlhsWide := le_trans hlhs hboundWide + have hrhsWide := le_trans hrhs hboundWide + have hresultWide : + (RegisterStore.read store source₀ - + RegisterStore.read store source₁).bits.length ≤ + 6 * (bound + 1) ^ 2 := by + simpa [BinaryInstrOp.eval] using hsmall _ hresult + fin_cases slot <;> + simp [instructionCleanupResetBits, instructionCleanupValue, + instructionRemainingValue] <;> + (try split_ifs) <;> simp_all + | mul destination source₀ source₁ => + simp only [instructionResourceMagnitude] at hinstruction + have hdestination := bits_length_le_of_value_le destination bound (by omega) + have hlhs := hread source₀ + have hrhs := hread source₁ + have hresult := binaryInstrResult_bits_length_le .mul + (RegisterStore.read store source₀) (RegisterStore.read store source₁) + bound hlhs hrhs + have hdestinationWide := le_trans hdestination hboundWide + have hlhsWide := le_trans hlhs hboundWide + have hrhsWide := le_trans hrhs hboundWide + have hresultWide : + (RegisterStore.read store source₀ * + RegisterStore.read store source₁).bits.length ≤ + 6 * (bound + 1) ^ 2 := by + simpa [BinaryInstrOp.eval] using hsmall _ hresult + fin_cases slot <;> + simp [instructionCleanupResetBits, instructionCleanupValue, + instructionRemainingValue] <;> + (try split_ifs) <;> simp_all + | load destination addressRegister => + simp only [instructionResourceMagnitude] at hinstruction + have hdestination := bits_length_le_of_value_le destination bound (by omega) + have haddress := hread addressRegister + have hvalue := hread (RegisterStore.read store addressRegister) + have hdestinationWide := le_trans hdestination hboundWide + have haddressWide := le_trans haddress hboundWide + have hvalueWide := le_trans hvalue hboundWide + fin_cases slot <;> + simp [instructionCleanupResetBits, instructionCleanupValue, + instructionRemainingValue] <;> + (try split_ifs) <;> simp_all + | store addressRegister source => + simp only [instructionResourceMagnitude] at hinstruction + have haddress := hread addressRegister + have hvalue := hread source + have haddressWide := le_trans haddress hboundWide + have hvalueWide := le_trans hvalue hboundWide + fin_cases slot <;> + simp [instructionCleanupResetBits, instructionCleanupValue, + instructionRemainingValue] <;> + (try split_ifs) <;> simp_all + | jz source target => + fin_cases slot <;> + simp [instructionCleanupResetBits, instructionCleanupValue, + instructionRemainingValue] <;> try nlinarith + | jmp target => + fin_cases slot <;> + simp [instructionCleanupResetBits, instructionCleanupValue, + instructionRemainingValue] <;> try nlinarith + | halt => + fin_cases slot <;> + simp [instructionCleanupResetBits, instructionCleanupValue, + instructionRemainingValue] <;> try nlinarith + +private theorem instructionCleanupTime_le {m : ℕ} + (tapes : ControlInstructionTapes m) (instruction : Instr) + (pcValue : ℕ) (store : Store) (sourceHeadBound bound : ℕ) + (hbound : 1 ≤ bound) (hsourceHead : 1 ≤ sourceHeadBound) + (hstoreLength : store.length ≤ bound) + (hentries : ∀ entry ∈ store, + entry.1.bits.length ≤ bound ∧ entry.2.bits.length ≤ bound) + (hpc : pcValue.bits.length ≤ bound) + (hinstruction : instructionResourceMagnitude instruction ≤ bound) : + instructionCleanupTime tapes instruction pcValue store sourceHeadBound ≤ + 1000 * (sourceHeadBound + (bound + 1) ^ 2 + 1) := by + let nextStore := instructionStore instruction pcValue store + let nextBits := nextStore.flatMap Entry.encode + have hnext := instructionStoreBounds instruction pcValue store bound hbound + hstoreLength hentries hpc hinstruction + have hnextLength : nextStore.length ≤ bound + 1 := by + simpa only [nextStore] using hnext.1 + have hnextEntries : ∀ entry ∈ nextStore, + entry.1.bits.length ≤ 6 * (bound + 1) ∧ + entry.2.bits.length ≤ 6 * (bound + 1) := by + simpa only [nextStore] using hnext.2 + have hnextEncoded := entriesEncode_length_le nextStore (6 * (bound + 1)) + hnextEntries + have hnextBits : nextBits.length ≤ 26 * (bound + 1) ^ 2 := by + dsimp only [nextBits] + exact le_trans hnextEncoded (by + have hfactor : 4 * (6 * (bound + 1)) + 2 ≤ 26 * (bound + 1) := by + omega + have hproduct := Nat.mul_le_mul hnextLength hfactor + nlinarith) + have hreset := TM.resetBinaryWorkManyTime_le + (instructionCleanupResetTargets tapes) + (instructionCleanupResetBitsAt tapes instruction store) + (instructionCleanupResetHeadBoundAt tapes sourceHeadBound) + sourceHeadBound (6 * (bound + 1) ^ 2) + (by + intro i hi + obtain ⟨slot, rfl⟩ := List.mem_ofFn.mp hi + rw [instructionCleanupResetHeadBoundAt, + (instructionCleanupResetTape_injective tapes).extend_apply] + fin_cases slot <;> + simp [instructionCleanupResetHeadBound, hsourceHead]) + (by + intro i hi + obtain ⟨slot, rfl⟩ := List.mem_ofFn.mp hi + rw [instructionCleanupResetBitsAt, + (instructionCleanupResetTape_injective tapes).extend_apply] + exact instructionCleanupResetBits_le instruction store bound hbound + hstoreLength hentries hinstruction slot) + have htargets : (instructionCleanupResetTargets tapes).length = 7 := by + simp [instructionCleanupResetTargets] + rw [htargets] at hreset + have hcopy := TM.binaryCopyTime_le nextStore.length 0 + have hcopy' : TM.binaryCopyTime nextStore.length 0 ≤ + 3 * (bound + 1) + 20 := by + exact le_trans hcopy (by + have hsize := le_trans (size_le_self nextStore.length) hnextLength + simp only [Nat.size_zero] + omega) + have hresetNext : TM.resetBinaryWorkTime (nextBits.length + 1) + nextBits.length ≤ 3 * (26 * (bound + 1) ^ 2) + 9 := by + unfold TM.resetBinaryWorkTime TM.clearWorkTimeBound + omega + unfold instructionCleanupTime + dsimp only [nextStore, nextBits] at hnextBits hcopy' hresetNext ⊢ + have hboundSq : bound ≤ (bound + 1) ^ 2 := by nlinarith + have honeSq : 1 ≤ (bound + 1) ^ 2 := by nlinarith + nlinarith + +private theorem selectedInstructionResourceMagnitude_le + (program : Program) (pcValue : ℕ) : + instructionResourceMagnitude (selectedInstruction program pcValue) ≤ + programResourceMagnitude program := by + induction program generalizing pcValue with + | nil => simp [selectedInstruction, instructionResourceMagnitude, + programResourceMagnitude] + | cons instruction rest ih => + cases pcValue with + | zero => + simp only [selectedInstruction, programResourceMagnitude, + List.length_cons, List.map_cons, List.sum_cons] + omega + | succ pcValue => + have htail := ih pcValue + simp only [selectedInstruction, programResourceMagnitude, + List.length_cons, List.map_cons, List.sum_cons] + unfold programResourceMagnitude at htail + omega + +private theorem programStepTime_le {m : ℕ} + (tapes : ControlInstructionTapes m) (program : Program) + (pcValue : ℕ) (store : Store) (bound : ℕ) + (hbound : 1 ≤ bound) (hstoreLength : store.length ≤ bound) + (hentries : ∀ entry ∈ store, + entry.1.bits.length ≤ bound ∧ entry.2.bits.length ≤ bound) + (hpc : pcValue.bits.length ≤ bound) + (hprogram : programResourceMagnitude program ≤ bound) : + programStepTime tapes program pcValue store ≤ + 300000000 * (program.length + 1) * (bound + 1) ^ 3 := by + let instruction := selectedInstruction program pcValue + let instructionTime := programInstructionTime tapes program pcValue store + have hinstruction : instructionResourceMagnitude instruction ≤ bound := + le_trans (selectedInstructionResourceMagnitude_le program pcValue) hprogram + have hinstructionTime : instructionTime ≤ + 220000 * (program.length + 1) * (bound + 1) ^ 3 := by + exact programInstructionTime_le tapes program pcValue store bound hbound + hstoreLength hentries hpc hprogram + have hcleanup := instructionCleanupTime_le tapes instruction pcValue store + (1 + instructionTime) bound hbound (by omega) hstoreLength hentries hpc + hinstruction + have hsqCube : (bound + 1) ^ 2 ≤ (bound + 1) ^ 3 := by + calc + (bound + 1) ^ 2 = (bound + 1) ^ 2 * 1 := by simp + _ ≤ (bound + 1) ^ 2 * (bound + 1) := + Nat.mul_le_mul_left _ (by omega) + _ = (bound + 1) ^ 3 := by ring + have honeCube : 1 ≤ (bound + 1) ^ 3 := by + exact le_trans (by omega : 1 ≤ bound + 1) (Nat.le_self_pow + (by decide : (3 : ℕ) ≠ 0) (bound + 1)) + unfold programStepTime programStepSourceHeadBound + dsimp only [instruction, instructionTime] at hinstructionTime hcleanup ⊢ + nlinarith + +private theorem dispatchHaltTime_le {m : ℕ} + (tapes : ControlInstructionTapes m) (program : Program) + (selector bound : ℕ) (hbound : 1 ≤ bound) + (hselector : selector.bits.length ≤ bound) : + dispatchHaltTime tapes program selector ≤ + 20 * (program.length + 1) * (bound + 1) := by + induction program generalizing selector with + | nil => + have hreset : TM.resetBinaryWorkTime 1 selector.bits.length ≤ + 2 * bound + 9 := by + unfold TM.resetBinaryWorkTime TM.clearWorkTimeBound + omega + simp only [dispatchHaltTime, List.length_nil, Nat.zero_add, + Nat.mul_one] + omega + | cons instruction rest ih => + have hselectorPred : (selector - 1).bits.length ≤ bound := by + simpa only [Nat.size_eq_bits_len] using + (le_trans (Nat.size_le_size (Nat.sub_le selector 1)) (by + simpa [Nat.size_eq_bits_len] using hselector)) + have htail := ih (selector - 1) hselectorPred + have hpred := TM.binaryPredTime_le (selector - 1) + have hpredSize : (selector - 1 + 1).size ≤ bound + 1 := by + have hvalue : selector - 1 + 1 ≤ selector + 1 := by omega + have hsize := Nat.size_le_size hvalue + have hselectorSize : selector.size ≤ bound := by + simpa [Nat.size_eq_bits_len] using hselector + have hsucc : (selector + 1).size ≤ bound + 1 := by + rw [Nat.size_le] + have hlt := Nat.lt_size_self selector + have hpow := Nat.pow_le_pow_right (by decide : 1 ≤ 2) hselectorSize + rw [pow_succ] + omega + exact le_trans hsize hsucc + have hpred' : TM.binaryPredTime (selector - 1) ≤ + 2 * (bound + 1) + 2 := le_trans hpred (by omega) + simp only [dispatchHaltTime, TM.branchWorkBlankTime, List.length_cons] + have hmax : max 1 + (TM.binaryPredTime (selector - 1) + 1 + + dispatchHaltTime tapes rest (selector - 1)) ≤ + 2 * (bound + 1) + 3 + + 20 * (rest.length + 1) * (bound + 1) := by + apply max_le <;> omega + nlinarith + +private theorem programHaltTime_le {m : ℕ} + (tapes : ControlInstructionTapes m) (program : Program) + (pcValue bound : ℕ) (hbound : 1 ≤ bound) + (hpc : pcValue.bits.length ≤ bound) : + programHaltTime tapes program pcValue ≤ + 40 * (program.length + 1) * (bound + 1) := by + have hdispatch := dispatchHaltTime_le tapes program pcValue bound hbound hpc + have hcopy := binaryCopyTime_le_width pcValue 0 bound + (by simpa [Nat.size_eq_bits_len] using hpc) (by simp) + unfold programHaltTime + nlinarith + +private theorem programOutputTime_le {m : ℕ} + (tapes : ControlInstructionTapes m) (store : Store) (bound : ℕ) + (hbound : 1 ≤ bound) (hstoreLength : store.length ≤ bound) + (hentries : ∀ entry ∈ store, + entry.1.bits.length ≤ bound ∧ entry.2.bits.length ≤ bound) : + programOutputTime tapes store ≤ 22000 * (bound + 1) ^ 3 := by + have hlookup := entryLookupStaticTime_le tapes.lifted.data.lhsLookup store + 0 bound hbound hstoreLength (by omega) hentries + unfold programOutputTime + have honeCube : 1 ≤ (bound + 1) ^ 3 := by + exact le_trans (by omega : 1 ≤ bound + 1) (Nat.le_self_pow + (by decide : (3 : ℕ) ≠ 0) (bound + 1)) + omega + +private def SnapshotBounded (snapshot : Snapshot) (bound : ℕ) : Prop := + snapshot.store.length ≤ bound ∧ + (∀ entry ∈ snapshot.store, + entry.1.bits.length ≤ bound ∧ entry.2.bits.length ≤ bound) ∧ + snapshot.pc.bits.length ≤ bound + +private theorem snapshotSteps_eq_run (program : Program) (fuel : ℕ) + (snapshot : Snapshot) : + snapshotSteps program fuel snapshot = snapshot.run program fuel := by + induction fuel generalizing snapshot with + | zero => rfl + | succ fuel ih => + rw [snapshotSteps, ih] + by_cases hhalted : snapshot.Halted program + · rw [snapshot_step_eq_self_of_halted_internal program snapshot hhalted, + snapshot_run_halted_internal program snapshot hhalted] + simp [Snapshot.run, hhalted] + · simp [Snapshot.run, hhalted] + +private theorem programLoopIterationTime_le {m : ℕ} + (tapes : ControlInstructionTapes m) (program : Program) + (snapshot : Snapshot) (bound : ℕ) (hbound : 1 ≤ bound) + (hcurrent : SnapshotBounded snapshot bound) + (hnext : SnapshotBounded (snapshot.step program) bound) + (hprogram : programResourceMagnitude program ≤ bound) : + programLoopIterationTime tapes program snapshot ≤ + 301000000 * (program.length + 1) * (bound + 1) ^ 3 := by + have hstep := programStepTime_le tapes program snapshot.pc snapshot.store + bound hbound hcurrent.1 hcurrent.2.1 hcurrent.2.2 hprogram + have hhalt := programHaltTime_le tapes program (snapshot.step program).pc + bound hbound hnext.2.2 + unfold programLoopIterationTime + have hlinearCube : bound + 1 ≤ (bound + 1) ^ 3 := by + exact Nat.le_self_pow (by decide : (3 : ℕ) ≠ 0) (bound + 1) + have honeCube : 1 ≤ (bound + 1) ^ 3 := + le_trans (by omega) hlinearCube + nlinarith + +private theorem programLoopTime_le {m : ℕ} + (tapes : ControlInstructionTapes m) (program : Program) + (fuel : ℕ) (snapshot : Snapshot) (bound : ℕ) + (hbound : 1 ≤ bound) + (hall : ∀ k, k ≤ fuel → + SnapshotBounded (snapshotSteps program k snapshot) bound) + (hprogram : programResourceMagnitude program ≤ bound) : + programLoopTime tapes program fuel snapshot ≤ + fuel * (301000000 * (program.length + 1) * (bound + 1) ^ 3) := by + induction fuel generalizing snapshot with + | zero => simp [programLoopTime] + | succ fuel ih => + have hcurrent : SnapshotBounded snapshot bound := by + simpa [snapshotSteps] using hall 0 (by omega) + have hnext : SnapshotBounded (snapshot.step program) bound := by + simpa [snapshotSteps] using hall 1 (by omega) + have hiteration := programLoopIterationTime_le tapes program snapshot + bound hbound hcurrent hnext hprogram + have htail := ih (snapshot.step program) (by + intro k hk + simpa [snapshotSteps] using hall (k + 1) (by omega)) + simp only [programLoopTime] + rw [Nat.succ_mul] + omega + +private theorem write_entries_le (store : Store) (address value bound : ℕ) + (hentries : ∀ entry ∈ store, + entry.1.bits.length ≤ bound ∧ entry.2.bits.length ≤ bound) + (haddress : address.bits.length ≤ bound) + (hvalue : value.bits.length ≤ bound) : + ∀ entry ∈ RegisterStore.write store address value, + entry.1.bits.length ≤ bound ∧ entry.2.bits.length ≤ bound := by + intro entry hentry + induction store with + | nil => + by_cases hvalueZero : value = 0 + · simp [RegisterStore.write, hvalueZero] at hentry + · simp [RegisterStore.write, hvalueZero] at hentry + subst entry + exact ⟨haddress, hvalue⟩ + | cons head rest ih => + rcases head with ⟨storedAddress, storedValue⟩ + have hhead := hentries (storedAddress, storedValue) (by simp) + have hrest : ∀ current ∈ rest, + current.1.bits.length ≤ bound ∧ + current.2.bits.length ≤ bound := by + intro current hcurrent + exact hentries current (by simp [hcurrent]) + by_cases haddressEq : address = storedAddress + · subst address + by_cases hvalueZero : value = 0 + · simp [RegisterStore.write, hvalueZero] at hentry + exact hrest entry hentry + · simp [RegisterStore.write, hvalueZero] at hentry + rcases hentry with rfl | hentry + · exact ⟨haddress, hvalue⟩ + · exact hrest entry hentry + · simp only [RegisterStore.write, haddressEq, ↓reduceIte, + List.mem_cons] at hentry + rcases hentry with rfl | hentry + · exact hhead + · exact ih hrest hentry + +private theorem inputBitStoreFrom_bounds (address : ℕ) (input : List Bool) + (bound : ℕ) (hsum : address + input.length ≤ bound) : + (inputBitStoreFrom address input).length ≤ input.length ∧ + ∀ entry ∈ inputBitStoreFrom address input, + entry.1.bits.length ≤ bound ∧ entry.2.bits.length ≤ bound := by + induction input generalizing address with + | nil => simp [inputBitStoreFrom] + | cons bit rest ih => + have htail := ih (address + 1) (by simp only [List.length_cons] at hsum; omega) + have haddress : address.bits.length ≤ bound := + bits_length_le_of_value_le address bound (by + simp only [List.length_cons] at hsum + omega) + have hone : (1 : ℕ).bits.length ≤ bound := by + simpa using (show 1 ≤ bound by + simp only [List.length_cons] at hsum + omega) + cases bit with + | false => + change (inputBitStoreFrom (address + 1) rest).length ≤ + rest.length + 1 ∧ + ∀ entry ∈ inputBitStoreFrom (address + 1) rest, + entry.1.bits.length ≤ bound ∧ entry.2.bits.length ≤ bound + exact ⟨by omega, htail.2⟩ + | true => + change ((address, 1) :: inputBitStoreFrom (address + 1) rest).length ≤ + rest.length + 1 ∧ + ∀ entry ∈ (address, 1) :: inputBitStoreFrom (address + 1) rest, + entry.1.bits.length ≤ bound ∧ entry.2.bits.length ≤ bound + constructor + · simp only [List.length_cons] + omega + · intro entry hentry + simp only [List.mem_cons] at hentry + rcases hentry with rfl | hentry + · exact ⟨haddress, hone⟩ + · exact htail.2 entry hentry + +private theorem programInitialSnapshot_bounded (input : List Bool) : + SnapshotBounded (programInitialSnapshot input) (input.length + 1) := by + have hprefix := inputBitStoreFrom_bounds 1 input (input.length + 1) (by omega) + have hlength := write_length_le (inputBitStoreFrom 1 input) 0 input.length + have hentries := write_entries_le (inputBitStoreFrom 1 input) 0 input.length + (input.length + 1) hprefix.2 (by simp) (by + exact bits_length_le_of_value_le input.length (input.length + 1) (by omega)) + refine ⟨?_, ?_, by simp [programInitialSnapshot]⟩ + · change (RegisterStore.write (inputBitStoreFrom 1 input) 0 + input.length).length ≤ input.length + 1 + omega + · simpa [programInitialSnapshot, programInitialStore] using hentries + +private theorem rewindEntryEncodeRestoreTime_bound (entry : Entry) (bound : ℕ) + (hbound : 1 ≤ bound) (haddress : entry.1.bits.length ≤ bound) + (hvalue : entry.2.bits.length ≤ bound) : + rewindEntryEncodeRestoreTime entry ≤ 30 * (bound + 1) := by + have hrewind := rewindEntryEncodeTime_le entry 1 1 bound haddress hvalue + hbound hbound + unfold Machine.rewindEntryEncodeRestoreTime + omega + +private theorem inputTrueCount_le_length (input : List Bool) : + inputTrueCount input ≤ input.length := by + induction input with + | nil => simp [inputTrueCount] + | cons bit rest ih => + cases bit <;> simp [inputTrueCount] <;> omega + +private theorem initialInputLoopTime_le {m : ℕ} + (tapes : ControlInstructionTapes m) (address count : ℕ) + (input : List Bool) (bound : ℕ) (hbound : 1 ≤ bound) + (haddress : address + input.length ≤ bound) + (hcount : count + input.length ≤ bound) : + initialInputLoopTime tapes address count input ≤ + (input.length + 1) * (100 * (bound + 1) ^ 2) := by + induction input generalizing address count with + | nil => + simp only [initialInputLoopTime, List.length_nil, Nat.zero_add, + Nat.one_mul] + nlinarith + | cons bit rest ih => + have haddressValue : address.bits.length ≤ bound := + bits_length_le_of_value_le address bound (by + simp only [List.length_cons] at haddress + omega) + have hone : (1 : ℕ).bits.length ≤ bound := by simp [hbound] + have hrewind := rewindEntryEncodeRestoreTime_bound (address, 1) bound + hbound haddressValue hone + have hsuccAddress := binarySuccTime_le_width address bound (by + simpa [Nat.size_eq_bits_len] using haddressValue) + have hsuccCount := binarySuccTime_le_width count bound (by + exact le_trans (size_le_self count) (by omega)) + cases bit with + | false => + have htail := ih (address + 1) count (by + simp only [List.length_cons] at haddress ⊢ + omega) (by + simp only [List.length_cons] at hcount + omega) + simp [initialInputLoopTime] + have hbody : 1 + TM.binarySuccTime address + 1 ≤ + 100 * (bound + 1) ^ 2 := by nlinarith + nlinarith + | true => + have htail := ih (address + 1) (count + 1) (by + simp only [List.length_cons] at haddress ⊢ + omega) (by + simp only [List.length_cons] at hcount + omega) + simp [initialInputLoopTime] + have hbody : 1 + + (rewindEntryEncodeRestoreTime (address, 1) + 1 + + TM.binarySuccTime count + 1 + TM.binarySuccTime address) + 1 ≤ + 100 * (bound + 1) ^ 2 := by nlinarith + nlinarith + +private theorem initialLengthTime_le (length count : ℕ) + (hcount : count ≤ length) : + initialLengthTime length count ≤ 100 * (length + 2) ^ 2 := by + have hbound : 1 ≤ length + 1 := by omega + have hlength : length.bits.length ≤ length + 1 := + bits_length_le_of_value_le length (length + 1) (by omega) + have hzero : (0 : ℕ).bits.length ≤ length + 1 := by simp + have hrewind := rewindEntryEncodeRestoreTime_bound (0, length) + (length + 1) hbound hzero hlength + have hsucc := binarySuccTime_le_width count (length + 1) (by + exact le_trans (size_le_self count) (by omega)) + unfold initialLengthTime + split <;> nlinarith + +private theorem initialCleanupBits_le {m : ℕ} + (tapes : ControlInstructionTapes m) (length bound : ℕ) + (hlength : length.bits.length ≤ bound) (hbound : 1 ≤ bound) + (i : Fin (m + 1)) : + (initialCleanupBits tapes length i).length ≤ bound := by + unfold initialCleanupBits + split + · exact hlength + · split + · simpa using hbound + · simp + +private theorem initialAbiInstallTime_le {m : ℕ} + (tapes : ControlInstructionTapes m) (store : Store) (length bound : ℕ) + (hbound : 1 ≤ bound) (hstoreLength : store.length ≤ bound) + (hentries : ∀ entry ∈ store, + entry.1.bits.length ≤ bound ∧ entry.2.bits.length ≤ bound) + (hlength : length.bits.length ≤ bound) : + initialAbiInstallTime tapes store length ≤ 100 * (bound + 1) ^ 2 := by + let encoded := store.flatMap Entry.encode + have hencodedBase := entriesEncode_length_le store bound hentries + have hencoded : encoded.length ≤ 6 * (bound + 1) ^ 2 := by + dsimp only [encoded] + have hfactor : 4 * bound + 2 ≤ 6 * (bound + 1) := by omega + have hproduct := Nat.mul_le_mul hstoreLength hfactor + exact le_trans hencodedBase (by nlinarith) + have hcopy := binaryCopyTime_le_width store.length 0 bound + (le_trans (size_le_self store.length) hstoreLength) (by simp) + have hresetEncoded : TM.resetBinaryWorkTime (encoded.length + 1) + encoded.length ≤ 3 * (6 * (bound + 1) ^ 2) + 9 := by + unfold TM.resetBinaryWorkTime TM.clearWorkTimeBound + omega + have hresetMany := TM.resetBinaryWorkManyTime_le + (initialCleanupTargets tapes) (initialCleanupBits tapes length) + (fun _ => 1) 1 bound (fun _ _ => le_rfl) + (fun i _ => initialCleanupBits_le tapes length bound hlength hbound i) + have htargets : (initialCleanupTargets tapes).length = 2 := by + simp [initialCleanupTargets] + rw [htargets] at hresetMany + unfold initialAbiInstallTime + dsimp only [encoded] at hencoded hresetEncoded ⊢ + have hboundSq : bound ≤ (bound + 1) ^ 2 := by nlinarith + have honeSq : 1 ≤ (bound + 1) ^ 2 := by nlinarith + nlinarith + +private theorem programInitTime_le {m : ℕ} + (tapes : ControlInstructionTapes m) (input : List Bool) : + programInitTime tapes input ≤ 1000 * (input.length + 2) ^ 3 := by + let bound := input.length + 1 + have hbound : 1 ≤ bound := by simp [bound] + have hloop := initialInputLoopTime_le tapes 1 0 input bound hbound + (by dsimp only [bound]; omega) (by dsimp only [bound]; omega) + have htrueCount := inputTrueCount_le_length input + have hlengthTime := initialLengthTime_le input.length (inputTrueCount input) + htrueCount + have hinitial := programInitialSnapshot_bounded input + have hlengthBits : input.length.bits.length ≤ bound := + bits_length_le_of_value_le input.length bound (by simp [bound]) + have habi := initialAbiInstallTime_le tapes (programInitialStore input) + input.length bound hbound hinitial.1 hinitial.2.1 hlengthBits + have hpred := TM.binaryPredTime_le input.length + have hpred' : TM.binaryPredTime input.length ≤ + 2 * (input.length + 1) + 2 := by + exact le_trans hpred (by + have hsize := size_le_self (input.length + 1) + omega) + have hsuccZero := TM.binarySuccTime_le 0 + have hsuccZero' : TM.binarySuccTime 0 ≤ 2 := by + simpa using hsuccZero + unfold programInitTime + dsimp only [bound] at hloop habi hlengthBits hbound ⊢ + have hsqCube : (input.length + 2) ^ 2 ≤ + (input.length + 2) ^ 3 := by + calc + (input.length + 2) ^ 2 = (input.length + 2) ^ 2 * 1 := by simp + _ ≤ (input.length + 2) ^ 2 * (input.length + 2) := + Nat.mul_le_mul_left _ (by omega) + _ = (input.length + 2) ^ 3 := by ring + have honeCube : 1 ≤ (input.length + 2) ^ 3 := by nlinarith + have hloopCube : initialInputLoopTime tapes 1 0 input ≤ + 100 * (input.length + 2) ^ 3 := by + calc + initialInputLoopTime tapes 1 0 input ≤ + (input.length + 1) * (100 * (input.length + 2) ^ 2) := by + simpa only [Nat.add_assoc] using hloop + _ ≤ (input.length + 2) * (100 * (input.length + 2) ^ 2) := + Nat.mul_le_mul_right _ (by omega) + _ = 100 * (input.length + 2) ^ 3 := by ring + have habi' : initialAbiInstallTime tapes (programInitialStore input) + input.length ≤ 100 * (input.length + 2) ^ 2 := by + simpa only [Nat.add_assoc] using habi + nlinarith + +theorem programDecisionTime_le_envelope_internal {m : ℕ} + (tapes : ControlInstructionTapes m) (program : Program) + (input : List Bool) (fuel : ℕ) + (hhalted : RAM.Halted program + (RAM.run program fuel (RAM.initCfg input))) + (hfuel : fuel ≤ + RAM.logTimeUpto program fuel (RAM.initCfg input)) : + programDecisionTime tapes program input fuel ≤ + programDecisionEnvelope program input.length + (RAM.logTimeUpto program fuel (RAM.initCfg input)) := by + let initial := programInitialSnapshot input + let cost := RAM.logTimeUpto program fuel (RAM.initCfg input) + let scale := programDecisionScale program input.length cost + let magnitude := programResourceMagnitude program + have hmagnitude : 1 ≤ magnitude := by + exact programResourceMagnitude_pos_internal program + have hprogramLength : program.length ≤ magnitude := by + exact program_length_le_resourceMagnitude_internal program + have hstatic : programStaticWidth program ≤ magnitude := by + exact programStaticWidth_le_resourceMagnitude_internal program + have hscale : 1 ≤ scale := by + exact programDecisionScale_pos_internal program input.length cost + have hinitial := programInitialSnapshot_bounded input + have hinitialRep : initial.Represents (RAM.initCfg input) := by + simpa only [initial] using programInitialSnapshot_represents_internal input + have hinitialWidth : initial.width ≤ input.length + 1 := by + exact snapshotWidth_le_of_bounds initial.pc initial.store + (input.length + 1) hinitial.1 hinitial.2.1 hinitial.2.2 + have hhaltedInitial : RAM.Halted program + (RAM.run program fuel initial.decode) := by + rw [hinitialRep.2] + exact hhalted + have hcostSucc : RAM.logTimeUpto program (fuel + 1) initial.decode = cost := by + have hsame := RAM.logTimeUpto_eq_of_halted_le program + (Nat.le_succ fuel) hhaltedInitial + calc + RAM.logTimeUpto program (fuel + 1) initial.decode = + RAM.logTimeUpto program fuel initial.decode := by + simpa only [Nat.succ_eq_add_one] using hsame + _ = cost := by rw [hinitialRep.2] + have hcanonical : Canonical initial.store := hinitialRep.1 + have hall : ∀ k, k ≤ fuel + 1 → + SnapshotBounded (snapshotSteps program k initial) scale := by + intro k hk + let current := initial.run program k + have hlog := RAM.logTimeUpto_mono program (c := initial.decode) hk + rw [hcostSucc] at hlog + have hunit := RAM.unitTimeUpto_le_logTimeUpto program k initial.decode + have hunitCost : RAM.unitTimeUpto program k initial.decode ≤ cost := + le_trans hunit hlog + have hlength := Snapshot.length_run_le_internal program k initial hcanonical + have hwidth := Snapshot.width_run_le_internal program k initial hcanonical + have hstaticMagnitude : programStaticWidth program + 1 ≤ magnitude + 1 := + Nat.add_le_add_right hstatic 1 + have hwidthProduct : + RAM.unitTimeUpto program k initial.decode * + (programStaticWidth program + 1) ≤ + cost * (magnitude + 1) := + Nat.mul_le_mul hunitCost hstaticMagnitude + have hlengthScale : current.store.length ≤ scale := by + have hinitialLength : initial.store.length ≤ input.length + 1 := by + simpa only [initial] using hinitial.1 + have hlengthBase : current.store.length ≤ + input.length + 1 + RAM.unitTimeUpto program k initial.decode := by + dsimp only [current] + exact le_trans hlength + (Nat.add_le_add_right hinitialLength _) + have hcostFactor : cost ≤ cost * (magnitude + 2) := by + calc + cost = cost * 1 := by simp + _ ≤ cost * (magnitude + 2) := + Nat.mul_le_mul_left cost (by omega) + change current.store.length ≤ + input.length + cost * (magnitude + 2) + magnitude + 3 + omega + have hwidthScale : current.width ≤ scale := by + have hwidthBase : current.width ≤ + input.length + 1 + cost * (magnitude + 1) + cost := by + dsimp only [current] + exact le_trans hwidth (by omega) + have hcostSplit : cost * (magnitude + 1) + cost = + cost * (magnitude + 2) := by ring + calc + current.width ≤ input.length + 1 + + (cost * (magnitude + 1) + cost) := by omega + _ = input.length + 1 + cost * (magnitude + 2) := by rw [hcostSplit] + _ ≤ scale := by + change input.length + 1 + cost * (magnitude + 2) ≤ + input.length + cost * (magnitude + 2) + magnitude + 3 + omega + have hentriesScale : ∀ entry ∈ current.store, + entry.1.bits.length ≤ scale ∧ + entry.2.bits.length ≤ scale := by + intro entry hentry + have hentryWidth := snapshotEntryBits_le_width current entry hentry + exact ⟨le_trans hentryWidth.1 hwidthScale, + le_trans hentryWidth.2 hwidthScale⟩ + have hpcWidth : current.pc.bits.length ≤ current.width := by + have hpc : bitlen current.pc ≤ current.width := + le_max_left (bitlen current.pc) + (max (bitlen current.store.length) (maxWidth current.store)) + unfold bitlen at hpc + rw [← Nat.size_eq_bits_len] at hpc + exact hpc + rw [snapshotSteps_eq_run] + exact ⟨hlengthScale, hentriesScale, le_trans hpcWidth hwidthScale⟩ + have hprogramScale : magnitude ≤ scale := by + unfold scale programDecisionScale + omega + have hloop := programLoopTime_le tapes program (fuel + 1) initial scale + hscale hall hprogramScale + have hfinalBound : SnapshotBounded (initial.run program fuel) scale := by + rw [← snapshotSteps_eq_run] + exact hall fuel (by omega) + have houtput := programOutputTime_le tapes (initial.run program fuel).store + scale hscale hfinalBound.1 hfinalBound.2.1 + have hinit := programInitTime_le tapes input + have hinputScale : input.length + 2 ≤ scale + 1 := by + unfold scale programDecisionScale + omega + have hinit' : programInitTime tapes input ≤ + 1000 * (scale + 1) ^ 3 := + le_trans hinit (Nat.mul_le_mul_left 1000 + (Nat.pow_le_pow_left hinputScale 3)) + have hfuelScale : fuel + 1 ≤ scale + 1 := by + have hfuelCost : fuel ≤ cost := by simpa only [cost] using hfuel + have hcostScale : cost ≤ scale := by + change cost ≤ input.length + cost * (magnitude + 2) + magnitude + 3 + have hfactor : cost * 1 ≤ cost * (magnitude + 2) := + Nat.mul_le_mul_left cost (by omega) + omega + omega + have hlengthMagnitude : program.length + 1 ≤ 2 * magnitude := by omega + have hloopProduct : (fuel + 1) * (program.length + 1) ≤ + (scale + 1) * (2 * magnitude) := + Nat.mul_le_mul hfuelScale hlengthMagnitude + have hloop' : programLoopTime tapes program (fuel + 1) initial ≤ + 602000000 * magnitude * (scale + 1) ^ 4 := by + calc + programLoopTime tapes program (fuel + 1) initial ≤ + (fuel + 1) * + (301000000 * (program.length + 1) * (scale + 1) ^ 3) := hloop + _ = 301000000 * ((fuel + 1) * (program.length + 1)) * + (scale + 1) ^ 3 := by ring + _ ≤ 301000000 * ((scale + 1) * (2 * magnitude)) * + (scale + 1) ^ 3 := + Nat.mul_le_mul_right _ (Nat.mul_le_mul_left 301000000 hloopProduct) + _ = 602000000 * magnitude * (scale + 1) ^ 4 := by ring + have hcubeFourth : (scale + 1) ^ 3 ≤ (scale + 1) ^ 4 := by + calc + (scale + 1) ^ 3 = (scale + 1) ^ 3 * 1 := by simp + _ ≤ (scale + 1) ^ 3 * (scale + 1) := + Nat.mul_le_mul_left _ (by omega) + _ = (scale + 1) ^ 4 := by ring + have hinitEnvelope : programInitTime tapes input ≤ + 1000 * magnitude * (scale + 1) ^ 4 := by + exact le_trans hinit' (by + have hmultiply := Nat.mul_le_mul hmagnitude hcubeFourth + nlinarith) + have houtputEnvelope : programOutputTime tapes + (initial.run program fuel).store ≤ + 22000 * magnitude * (scale + 1) ^ 4 := by + exact le_trans houtput (by + have hmultiply := Nat.mul_le_mul hmagnitude hcubeFourth + nlinarith) + let envelopeUnit := magnitude * (scale + 1) ^ 4 + have hunitPos : 1 ≤ envelopeUnit := by + dsimp only [envelopeUnit] + exact Nat.mul_pos hmagnitude (pow_pos (by omega) 4) + have hinitUnit : programInitTime tapes input ≤ 1000 * envelopeUnit := by + simpa only [envelopeUnit, Nat.mul_assoc] using hinitEnvelope + have hloopUnit : programLoopTime tapes program (fuel + 1) initial ≤ + 602000000 * envelopeUnit := by + simpa only [envelopeUnit, Nat.mul_assoc] using hloop' + have houtputUnit : programOutputTime tapes + (initial.run program fuel).store ≤ 22000 * envelopeUnit := by + simpa only [envelopeUnit, Nat.mul_assoc] using houtputEnvelope + have hloopUnit' : programLoopTime tapes program (fuel + 1) + (programInitialSnapshot input) ≤ 602000000 * envelopeUnit := by + simpa only [initial] using hloopUnit + have houtputUnit' : programOutputTime tapes + ((programInitialSnapshot input).run program fuel).store ≤ + 22000 * envelopeUnit := by + simpa only [initial] using houtputUnit + have htotal : programDecisionTime tapes program input fuel ≤ + 602023002 * envelopeUnit := by + unfold programDecisionTime + dsimp only + omega + apply le_trans htotal + unfold programDecisionEnvelope + change 602023002 * envelopeUnit ≤ + 1000000000 * magnitude * (scale + 1) ^ 4 + simpa only [envelopeUnit, Nat.mul_assoc] using + (Nat.mul_le_mul_right envelopeUnit + (show 602023002 ≤ 1000000000 by decide)) + +theorem programDecisionEnvelope_mono_cost_internal (program : Program) + (inputLength left right : ℕ) (hle : left ≤ right) : + programDecisionEnvelope program inputLength left ≤ + programDecisionEnvelope program inputLength right := by + have hscale : programDecisionScale program inputLength left ≤ + programDecisionScale program inputLength right := by + unfold programDecisionScale + exact Nat.add_le_add_right + (Nat.add_le_add_left + (Nat.mul_le_mul_right (programResourceMagnitude program + 2) hle) + inputLength) + (programResourceMagnitude program + 3) + unfold programDecisionEnvelope + exact Nat.mul_le_mul_left + (1000000000 * programResourceMagnitude program) + (Nat.pow_le_pow_left (Nat.add_le_add_right hscale 1) 4) + +end Machine + +end RegisterStore + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Decision.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Decision.lean new file mode 100644 index 0000000000..dcc10264c7 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Decision.lean @@ -0,0 +1,67 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Decision.Defs +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.DecisionInternal + +/-! +# Complete sparse RAM decision machine +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace RegisterStore + +namespace Machine + +/-- The complete concrete machine realizes one halted pure sparse RAM run and +emits its `R₀` verdict. -/ +theorem programDecisionTM_hoareTime_run {n : ℕ} + (tapes : ControlInstructionTapes n) (program : Program) + (input : List Bool) (fuel : ℕ) + (hhalted : ((programInitialSnapshot input).run program fuel).Halted program) : + (programDecisionTM tapes program).HoareTime + (fun inp work out => + inp = Tape.init (input.map Γ.ofBool) ∧ + work = (fun _ => Tape.init []) ∧ out = Tape.init []) + (fun _inp _work out => + let final := (programInitialSnapshot input).run program fuel + out = registerVerdictOutput (RegisterStore.read final.store 0)) + (programDecisionTime tapes program input fuel) := + programDecisionTM_hoareTime_run_internal tapes program input fuel hhalted + +/-- The complete machine realizes a halted executable RAM run and emits its +public `R₀` verdict. -/ +theorem programDecisionTM_hoareTime_ramRun {n : ℕ} + (tapes : ControlInstructionTapes n) (program : Program) + (input : List Bool) (fuel : ℕ) + (hhalted : RAM.Halted program + (RAM.run program fuel (RAM.initCfg input))) : + (programDecisionTM tapes program).HoareTime + (fun inp work out => + inp = Tape.init (input.map Γ.ofBool) ∧ + work = (fun _ => Tape.init []) ∧ out = Tape.init []) + (fun _inp _work out => + out = registerVerdictOutput + (RAM.run program fuel (RAM.initCfg input)).verdict) + (programDecisionTime tapes program input fuel) := + programDecisionTM_hoareTime_ramRun_internal tapes program input fuel hhalted + +end Machine + +end RegisterStore + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Decision/Defs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Decision/Defs.lean new file mode 100644 index 0000000000..2b00000367 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Decision/Defs.lean @@ -0,0 +1,49 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Init.Defs + +/-! +# Complete sparse RAM decision machine -- definitions +-/ + + +@[expose] public section + +namespace Complexity + +namespace RAM + +namespace RegisterStore + +namespace Machine + +/-- Initialize the public RAM configuration, execute one fixed program through +its first halt, and extract the Boolean verdict from sparse register `R₀`. -/ +def programDecisionTM {n : ℕ} (tapes : ControlInstructionTapes n) + (program : Program) : TM (n + 1) := + TM.seqTM (programInitTM tapes) + (TM.seqTM (programLoopTM tapes program) (programOutputTM tapes)) + +/-- Exact compositional bound for one fuel-certified RAM decision run. -/ +noncomputable def programDecisionTime {n : ℕ} + (tapes : ControlInstructionTapes n) (program : Program) + (input : List Bool) (fuel : ℕ) : ℕ := + let initial := programInitialSnapshot input + let final := initial.run program fuel + programInitTime tapes input + 1 + + (programLoopTime tapes program (fuel + 1) initial + 1 + + programOutputTime tapes final.store) + +end Machine + +end RegisterStore + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DecisionInternal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DecisionInternal.lean new file mode 100644 index 0000000000..fb24d915f7 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DecisionInternal.lean @@ -0,0 +1,200 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Decision.Defs +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Init.Internal +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Internal + +/-! +# Complete sparse RAM decision-machine proof internals +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace RegisterStore + +namespace Machine + +variable {n : ℕ} + +/-- The complete concrete machine realizes one halted pure sparse RAM run and +emits its `R₀` verdict. -/ +theorem programDecisionTM_hoareTime_run_internal + (tapes : ControlInstructionTapes n) (program : Program) + (input : List Bool) (fuel : ℕ) + (hhalted : ((programInitialSnapshot input).run program fuel).Halted program) : + (programDecisionTM tapes program).HoareTime + (fun inp work out => + inp = Tape.init (input.map Γ.ofBool) ∧ + work = (fun _ => Tape.init []) ∧ out = Tape.init []) + (fun _inp _work out => + let final := (programInitialSnapshot input).run program fuel + out = registerVerdictOutput (RegisterStore.read final.store 0)) + (programDecisionTime tapes program input fuel) := by + intro inp work out hpre + rcases hpre with ⟨hinp, hwork, hout⟩ + subst inp + subst work + subst out + let initial := programInitialSnapshot input + let final := initial.run program fuel + have hinit := programInitTM_hoareTime_internal tapes input + obtain ⟨initDone, initTime, hinitTime, hinitReach, hinitHalt, + hinitInput, hinitWork, hinitOutput⟩ := + hinit _ _ _ ⟨rfl, rfl, rfl⟩ + have hinitialCanonical : Canonical initial.store := by + simpa only [initial, programInitialSnapshot] using + programInitialStore_canonical_internal input + have hready : InstructionExecutionReady tapes initial.store initial.pc + initDone.work := by + rw [hinitWork] + exact programSnapshotWork_ready_internal tapes initial hinitialCanonical + have hinitInputParked : TM.Parked initDone.input := + ⟨hinitInput.1, hinitInput.2.2.2⟩ + have hloop := programLoopTM_hoareTime_run_internal tapes program fuel initial + initDone.work initDone.input hready hinitInputParked hhalted + obtain ⟨loopDone, loopTime, hloopTime, hloopReach, hloopHalt, + hloopInput, hloopReady, hloopOutput⟩ := + hloop _ _ _ ⟨rfl, rfl, by simpa [TM.resetBinaryBlank] using hinitOutput⟩ + have hloopInputParked : TM.Parked loopDone.input := by + rw [hloopInput] + exact hinitInputParked + have hloopOutputHalt : loopDone.output = instructionHaltOutput .halt := by + change loopDone.output = instructionHaltOutput (final.curInstr program) at hloopOutput + rw [show final.curInstr program = .halt from hhalted] at hloopOutput + exact hloopOutput + have houtputRun := programOutputTM_hoareTime_haltOutput_internal tapes + final.store final.pc loopDone.work loopDone.input hloopReady + hloopInputParked + obtain ⟨outputDone, outputTime, houtputTime, houtputReach, + houtputHalt, houtputInput, houtputVerdict⟩ := + houtputRun _ _ _ ⟨rfl, rfl, hloopOutputHalt⟩ + have hloopOutputParked : TM.Parked loopDone.output := by + rw [hloopOutputHalt] + refine ⟨?_, instructionHaltOutput_cells_ne_start_internal .halt⟩ + rw [instructionHaltOutput_head_internal] + have houtputReach' : (programOutputTM tapes).reachesIn outputTime + { state := (programOutputTM tapes).qstart + input := TM.transitionInput loopDone.input + work := fun i => TM.transitionTape (loopDone.work i) + output := TM.transitionTape loopDone.output } + outputDone := by + obtain ⟨hi, hw, ho⟩ := TM.phaseTransition_eq_self_of_reads_ne_start + hloopInputParked.read_ne_start + (fun i => (hloopReady.control.lookup.scanner.parked i).read_ne_start) + hloopOutputParked.read_ne_start + simpa only [hi, hw, ho] using houtputReach + have htailReach := TM.seqTM_reachesIn_of_reachesIn + (programLoopTM tapes program) (programOutputTM tapes) + hloopReach hloopHalt houtputReach' + let tailDone := TM.phase2Wrap (programLoopTM tapes program) + (programOutputTM tapes) outputDone + have htailHalt : + (TM.seqTM (programLoopTM tapes program) + (programOutputTM tapes)).halted tailDone := by + rw [TM.phase2Wrap_halted_iff] + exact houtputHalt + have hinitWorkParked : ∀ i, TM.Parked (initDone.work i) := by + rw [hinitWork] + exact (programSnapshotWork_ready_internal tapes initial + hinitialCanonical).control.lookup.scanner.parked + have hinitOutputParked : TM.Parked initDone.output := by + rw [hinitOutput] + have hblankNat : TM.resetBinaryBlank.HasBinaryNat 0 := by + simpa [TM.resetBinaryBlank] using Tape.init_move_right_hasBinaryNat 0 + exact ⟨by rw [hblankNat.2.1], + hblankNat.2.hasBinaryContent.cells_ne_start⟩ + have htailReach' : + (TM.seqTM (programLoopTM tapes program) + (programOutputTM tapes)).reachesIn + (loopTime + 1 + outputTime) + { state := (TM.seqTM (programLoopTM tapes program) + (programOutputTM tapes)).qstart + input := TM.transitionInput initDone.input + work := fun i => TM.transitionTape (initDone.work i) + output := TM.transitionTape initDone.output } + tailDone := by + obtain ⟨hi, hw, ho⟩ := TM.phaseTransition_eq_self_of_reads_ne_start + hinitInputParked.read_ne_start + (fun i => (hinitWorkParked i).read_ne_start) + hinitOutputParked.read_ne_start + simpa only [hi, hw, ho] using htailReach + have hreach := TM.seqTM_reachesIn_of_reachesIn + (programInitTM tapes) + (TM.seqTM (programLoopTM tapes program) (programOutputTM tapes)) + hinitReach hinitHalt htailReach' + let done := TM.phase2Wrap (programInitTM tapes) + (TM.seqTM (programLoopTM tapes program) (programOutputTM tapes)) tailDone + refine ⟨done, initTime + 1 + (loopTime + 1 + outputTime), + ?_, hreach, ?_, ?_⟩ + · unfold programDecisionTime + dsimp only [initial, final] at hloopTime houtputTime ⊢ + omega + · change (programDecisionTM tapes program).halted done + unfold programDecisionTM + rw [TM.phase2Wrap_halted_iff] + exact htailHalt + · change outputDone.output = registerVerdictOutput + (RegisterStore.read final.store 0) + exact houtputVerdict + +/-- The complete machine realizes a halted executable RAM run, with the public +RAM verdict rewritten through the sparse representation theorem. -/ +theorem programDecisionTM_hoareTime_ramRun_internal + (tapes : ControlInstructionTapes n) (program : Program) + (input : List Bool) (fuel : ℕ) + (hhalted : RAM.Halted program + (RAM.run program fuel (RAM.initCfg input))) : + (programDecisionTM tapes program).HoareTime + (fun inp work out => + inp = Tape.init (input.map Γ.ofBool) ∧ + work = (fun _ => Tape.init []) ∧ out = Tape.init []) + (fun _inp _work out => + out = registerVerdictOutput + (RAM.run program fuel (RAM.initCfg input)).verdict) + (programDecisionTime tapes program input fuel) := by + let initial := programInitialSnapshot input + let final := initial.run program fuel + have hinitialRep : initial.Represents (RAM.initCfg input) := by + simpa only [initial] using programInitialSnapshot_represents_internal input + have hdecode : final.decode = RAM.run program fuel (RAM.initCfg input) := by + have hrun := Snapshot.decode_run_internal program fuel initial hinitialRep.1 + rw [hinitialRep.2] at hrun + exact hrun + have hfinalHalted : final.Halted program := by + apply (Snapshot.halted_decode_iff_internal program final).mp + rw [hdecode] + exact hhalted + have hrun := programDecisionTM_hoareTime_run_internal tapes program input + fuel hfinalHalted + apply hrun.consequence + · exact fun _ _ _ h => h + · intro inp work out hpost + change out = registerVerdictOutput (RegisterStore.read final.store 0) + at hpost + rw [hpost] + congr 1 + change final.decode.regs 0 = + (RAM.run program fuel (RAM.initCfg input)).regs 0 + rw [hdecode] + · exact le_rfl + +end Machine + +end RegisterStore + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Defs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Defs.lean new file mode 100644 index 0000000000..0f50392d51 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Defs.lean @@ -0,0 +1,206 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Sim.Defs + +/-! +# Sparse RAM program controller -- definitions + +This layer adds the fixed-program halt test needed to iterate the checked +single-instruction simulator. The test copies the canonical program counter, +walks the same decrementing finite branch tree as instruction dispatch, and +writes `1` exactly for a selected `halt`; every continuing branch writes blank. +-/ + + +@[expose] public section + +namespace Complexity + +namespace RAM + +namespace RegisterStore + +namespace Machine + +/-- Two-state leaf that writes one halt verdict at the current output head. -/ +inductive HaltVerdictPhase where + | write + | done + deriving DecidableEq + +instance : Fintype HaltVerdictPhase where + elems := {.write, .done} + complete := fun state => by cases state <;> simp + +/-- Output symbol used by the fixed-program halt test. Continuing instructions +write blank so the instruction body regains its blank-output ABI. -/ +def instructionHaltVerdict : Instr → Γw + | .halt => .one + | _ => .blank + +/-- Canonical output tape produced by one halt-verdict leaf. -/ +def instructionHaltOutput (instruction : Instr) : Tape := + let blank := (Tape.init []).move Dir3.right + blank.writeAndMove (instructionHaltVerdict instruction).toΓ + (TM.idleDir blank.read) + +/-- Write the selected instruction's halt verdict in one transition while +preserving input and work tapes. -/ +def instructionHaltVerdictTM {n : ℕ} (instruction : Instr) : TM n where + Q := HaltVerdictPhase + qstart := .write + qhalt := .done + δ := fun state iHead wHeads oHead => + match state with + | .write => + (.done, fun i => TM.readBackWrite (wHeads i), + instructionHaltVerdict instruction, + TM.idleDir iHead, fun i => TM.idleDir (wHeads i), + TM.idleDir oHead) + | .done => TM.allIdle .done iHead wHeads oHead + δ_right_of_start := by + intro state iHead wHeads oHead + cases state <;> exact TM.rightOfStart_allIdle iHead wHeads oHead + +/-- Decrementing fixed-program branch tree for the halt verdict. -/ +def dispatchHaltTM {n : ℕ} (tapes : ControlInstructionTapes n) : + Program → TM (n + 1) + | [] => TM.seqTM (TM.resetBinaryWorkTM tapes.liftedLhs) + (instructionHaltVerdictTM .halt) + | instruction :: program => + TM.branchWorkBlankTM tapes.liftedLhs + (instructionHaltVerdictTM instruction) + (TM.seqTM (TM.binaryPredTM tapes.liftedLhs) + (dispatchHaltTM tapes program)) + +/-- Copy the canonical PC and emit whether its fixed-program instruction is +`halt`. -/ +def programHaltTM {n : ℕ} (tapes : ControlInstructionTapes n) + (program : Program) : TM (n + 1) := + TM.seqTM + (TM.binaryCopyIntoTM tapes.liftedPC tapes.liftedLhs tapes.liftedFound) + (dispatchHaltTM tapes program) + +/-- Branch-tree bound for a selector represented by `selector`. -/ +def dispatchHaltTime {n : ℕ} (tapes : ControlInstructionTapes n) : + Program → ℕ → ℕ + | [], selector => + TM.resetBinaryWorkTime 1 selector.bits.length + 1 + 1 + | _ :: program, selector => + TM.branchWorkBlankTime 1 + (TM.binaryPredTime (selector - 1) + 1 + + dispatchHaltTime tapes program (selector - 1)) + +/-- Complete fixed-program halt-test bound. -/ +def programHaltTime {n : ℕ} (tapes : ControlInstructionTapes n) + (program : Program) (pcValue : ℕ) : ℕ := + TM.binaryCopyTime pcValue 0 + 1 + + dispatchHaltTime tapes program pcValue + +/-- Repeated pure sparse-snapshot stepping without an explicit halt check. +Because the selected `halt` instruction is a no-op, this agrees with +`Snapshot.run`. -/ +def snapshotSteps (program : Program) : ℕ → Snapshot → Snapshot + | 0, snapshot => snapshot + | fuel + 1, snapshot => snapshotSteps program fuel (snapshot.step program) + +/-- Canonical parked tape containing one Boolean string. -/ +def programBinaryTape (bits : List Bool) : Tape := + (Tape.init (bits.map Γ.ofBool)).move Dir3.right + +/-- Exact clean work-tape image of one sparse RAM snapshot. The store stream, +runtime count, preserved count, and program counter occupy their established +instruction-ABI roles; every other tape is the standard parked blank tape. -/ +def programSnapshotWork {n : ℕ} (tapes : ControlInstructionTapes n) + (snapshot : Snapshot) : Fin (n + 1) → Tape := + Function.update + (Function.update + (Function.update + (Function.update (Function.const (Fin (n + 1)) TM.resetBinaryBlank) + tapes.liftedSource + (programBinaryTape (snapshot.store.flatMap Entry.encode))) + tapes.lifted.data.update.remaining + (programBinaryTape snapshot.store.length.bits)) + tapes.lifted.data.update.resultCount + (programBinaryTape snapshot.store.length.bits)) + tapes.liftedPC (programBinaryTape snapshot.pc.bits) + +/-- Boolean output symbol obtained from the RAM verdict convention. -/ +def registerVerdictSymbol (value : ℕ) : Γw := + if value = 0 then .zero else .one + +/-- Exact output tape emitted from one RAM register value. -/ +def registerVerdictOutput (value : ℕ) : Tape := + let blank := (Tape.init []).move Dir3.right + blank.writeAndMove (registerVerdictSymbol value).toΓ + (TM.idleDir blank.read) + +/-- Read a canonical register-value tape and emit zero exactly for value zero, +or one for any nonzero value. -/ +def registerVerdictTM {n : ℕ} (idx : Fin n) : TM n where + Q := HaltVerdictPhase + qstart := .write + qhalt := .done + δ := fun state iHead wHeads oHead => + match state with + | .write => + (.done, fun i => TM.readBackWrite (wHeads i), + if wHeads idx = Γ.blank then .zero else .one, + TM.idleDir iHead, fun i => TM.idleDir (wHeads i), + TM.idleDir oHead) + | .done => TM.allIdle .done iHead wHeads oHead + δ_right_of_start := by + intro state iHead wHeads oHead + cases state + · dsimp only + exact TM.rightOfStart_allIdle iHead wHeads oHead + · exact TM.rightOfStart_allIdle iHead wHeads oHead + +/-- Recover register `R₀` through the reusable sparse lookup and emit its +Boolean verdict on the real output tape. -/ +def programOutputTM {n : ℕ} (tapes : ControlInstructionTapes n) : + TM (n + 1) := + TM.seqTM (entryLookupStaticTM tapes.lifted.data.lhsLookup 0) + (registerVerdictTM tapes.liftedLhs) + +/-- Complete final-verdict extraction bound. -/ +def programOutputTime {n : ℕ} (tapes : ControlInstructionTapes n) + (store : Store) : ℕ := + entryLookupStaticTime tapes.lifted.data.lhsLookup store 0 + 1 + 1 + +/-- Fixed halt-aware loop for one concrete RAM program. -/ +def programLoopTM {n : ℕ} (tapes : ControlInstructionTapes n) + (program : Program) : TM (n + 1) := + TM.loopTM (programStepTM tapes program) (programHaltTM tapes program) + +/-- Bound for one loop body, body/test seams, halt test, and the three-step +rewind/check tail. -/ +noncomputable def programLoopIterationTime {n : ℕ} + (tapes : ControlInstructionTapes n) (program : Program) + (snapshot : Snapshot) : ℕ := + let next := snapshot.step program + programStepTime tapes program snapshot.pc snapshot.store + 1 + + programHaltTime tapes program next.pc + 1 + 3 + +/-- Sum of the first `fuel` loop-iteration bounds. -/ +noncomputable def programLoopTime {n : ℕ} + (tapes : ControlInstructionTapes n) (program : Program) : + ℕ → Snapshot → ℕ + | 0, _ => 0 + | fuel + 1, snapshot => + programLoopIterationTime tapes program snapshot + + programLoopTime tapes program fuel (snapshot.step program) + +end Machine + +end RegisterStore + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseBounds.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseBounds.lean new file mode 100644 index 0000000000..ce64ed7fb9 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseBounds.lean @@ -0,0 +1,82 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.DenseBoundsDefs +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.DenseBoundsProof + +/-! +# Dense-overlay RAM decision-machine resource bounds + +This surface exposes the selected-width one-step bound, the amortized +quadratic loop bound, and the complete quadratic decision bound for the +optimized dense-input RAM simulator. +-/ + + +public section + +namespace Complexity +namespace RAM +namespace RegisterStore +namespace Machine + +/-- One selected dense RAM instruction is simulated in time proportional to +the live serialized volume times that instruction's actual charged width. -/ +theorem denseProgramStepTime_le_envelope {n : ℕ} + (tapes : ControlInstructionTapes n) (program : Program) + (input : List Bool) (snapshot : DenseOverlay.Snapshot) + (hvalid : DenseOverlay.Valid snapshot.overlay) + (hpc : snapshot.pc ≤ programResourceMagnitude program) : + denseProgramStepTime tapes program input snapshot.pc snapshot.overlay ≤ + denseStepEnvelope program input snapshot := + denseProgramStepTime_le_envelope_internal tapes program input snapshot + hvalid hpc + +/-- The complete conservative dense loop timer is bounded by the square of a +potential containing live data, remaining fuel, and remaining RAM cost. -/ +theorem denseProgramLoopTime_le_envelope {n : ℕ} + (tapes : ControlInstructionTapes n) (program : Program) + (input : List Bool) (fuel : ℕ) + (snapshot : DenseOverlay.Snapshot) + (hvalid : DenseOverlay.Valid snapshot.overlay) + (hpc : snapshot.pc ≤ programResourceMagnitude program) : + denseProgramLoopTime tapes program input fuel snapshot ≤ + denseProgramLoopEnvelope program input fuel snapshot := + denseProgramLoopTime_le_envelope_internal tapes program input fuel snapshot + hvalid hpc + +/-- A halted dense RAM run whose fuel is charged by logarithmic time is +simulated within a quadratic envelope in input length plus charged RAM time. -/ +theorem denseProgramDecisionTime_le_envelope {n : ℕ} + (tapes : ControlInstructionTapes n) (program : Program) + (input : List Bool) (fuel : ℕ) + (hhalted : RAM.Halted program + (RAM.run program fuel (RAM.initCfg input))) + (hfuel : fuel ≤ + RAM.logTimeUpto program fuel (RAM.initCfg input)) : + denseProgramDecisionTime tapes program input fuel ≤ + denseProgramDecisionEnvelope program input.length + (RAM.logTimeUpto program fuel (RAM.initCfg input)) := + denseProgramDecisionTime_le_envelope_internal tapes program input fuel + hhalted hfuel + +/-- Increasing the charged RAM-time argument can only enlarge the optimized +quadratic decision envelope. -/ +theorem denseProgramDecisionEnvelope_mono_cost (program : Program) + (inputLength left right : ℕ) (hle : left ≤ right) : + denseProgramDecisionEnvelope program inputLength left ≤ + denseProgramDecisionEnvelope program inputLength right := by + unfold denseProgramDecisionEnvelope + exact Nat.mul_le_mul_left _ + (Nat.pow_le_pow_left (by omega) 2) + +end Machine +end RegisterStore +end RAM +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseBoundsDefs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseBoundsDefs.lean new file mode 100644 index 0000000000..3b68417237 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseBoundsDefs.lean @@ -0,0 +1,80 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Bounds.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.DenseOverlay.Defs +public import Mathlib.Data.Rat.Cast.Order +public import Mathlib.Tactic.NormNum.Abs +public import Mathlib.Tactic.NormNum.DivMod +public import Mathlib.Tactic.NormNum.OfScientific + +/-! +# Dense-overlay RAM decision-machine resource-bound definitions + +The optimized accounting keeps the live serialized overlay separate from the +width charged by the instruction actually selected at the current program +counter. This is the local product that sums quadratically over a run. +-/ + + +@[expose] public section + +namespace Complexity +namespace RAM +namespace RegisterStore +namespace Machine + +/-- Width charged by the selected instruction, including the fixed program +literals. -/ +def denseStepWidth (program : Program) (input : List Bool) + (snapshot : DenseOverlay.Snapshot) : ℕ := + programStaticWidth program + + RAM.stepLogCost program (snapshot.decode input) + 1 + +/-- Local amount of serialized data exposed to one dense simulated step. -/ +def denseStepVolume (program : Program) (input : List Bool) + (snapshot : DenseOverlay.Snapshot) : ℕ := + encodedStoreLength snapshot.overlay + input.length + + denseStepWidth program input snapshot + 1 + +/-- Width-sensitive envelope for one selected dense step. The program +magnitude is fixed once the simulated RAM program is fixed. -/ +def denseStepEnvelope (program : Program) (input : List Bool) + (snapshot : DenseOverlay.Snapshot) : ℕ := + 1000000000 * (programResourceMagnitude program + 1) ^ 2 * + denseStepVolume program input snapshot * + (denseStepWidth program input snapshot + 1) + +/-- Potential controlling a complete dense run. Its square absorbs both live +overlay growth and the sum of selected-instruction widths. The explicit fuel +reserve also pays for the conservative loop timer after an early halt, when +the semantic RAM costs have become stationary. -/ +def denseRunScale (program : Program) (input : List Bool) (fuel : ℕ) + (snapshot : DenseOverlay.Snapshot) : ℕ := + encodedStoreLength snapshot.overlay + input.length + 2 + + 3 * ((programStaticWidth program + 1) * + (fuel + RAM.unitTimeUpto program fuel (snapshot.decode input)) + + RAM.logTimeUpto program fuel (snapshot.decode input)) + +/-- Quadratic envelope for a complete dense loop from an arbitrary valid +snapshot. -/ +def denseProgramLoopEnvelope (program : Program) (input : List Bool) + (fuel : ℕ) (snapshot : DenseOverlay.Snapshot) : ℕ := + 2000000000 * (programResourceMagnitude program + 1) ^ 2 * + (denseRunScale program input fuel snapshot) ^ 2 + +/-- Public-ABI quadratic envelope in input length and charged RAM time. -/ +def denseProgramDecisionEnvelope (program : Program) + (inputLength cost : ℕ) : ℕ := + 500000000000 * (programResourceMagnitude program + 1) ^ 4 * + (inputLength + cost + 1) ^ 2 + +end Machine +end RegisterStore +end RAM +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseBoundsProof.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseBoundsProof.lean new file mode 100644 index 0000000000..374917b7b3 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseBoundsProof.lean @@ -0,0 +1,2054 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.DenseBoundsDefs +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Bounds +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.DenseInputLookup +public import Mathlib.Algebra.Order.BigOperators.Group.Finset +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.DenseOverlay +public import +LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.DenseDecisionDefs + +/-! +# Dense-overlay RAM decision-machine resource-bound proof internals +-/ + + +public section + +namespace Complexity +namespace RAM +namespace RegisterStore +namespace Machine + +private theorem encodedStoreLength_eq_sums (store : Store) : + encodedStoreLength store = + 2 * (store.map fun entry => bitlen entry.1).sum + + 2 * (store.map fun entry => bitlen entry.2).sum + + 2 * store.length := by + induction store with + | nil => simp [encodedStoreLength] + | cons entry rest ih => + rw [encodedStoreLength, List.flatMap_cons, List.length_append, + Entry.encode_length] + simp only [List.map_cons, List.sum_cons, List.length_cons] + have ih' : (rest.flatMap Entry.encode).length = + 2 * (rest.map fun entry => bitlen entry.1).sum + + 2 * (rest.map fun entry => bitlen entry.2).sum + + 2 * rest.length := by + simpa only [encodedStoreLength] using ih + rw [ih'] + omega + +private theorem address_count_width_le_encodedStoreLength + (store : Store) (hcanonical : Canonical store) : + store.length * bitlen store.length ≤ encodedStoreLength store := by + let addresses := store.map Prod.fst + let addressWidths := addresses.map bitlen + have hnodup : addresses.Nodup := hcanonical.1 + have hlength : addresses.length = store.length := by + simp [addresses] + have hsum : addressWidths.sum = + (store.map fun entry => bitlen entry.1).sum := by + simp [addressWidths, addresses, Function.comp_def] + have hencoded : + 2 * addressWidths.sum + 2 * store.length ≤ + encodedStoreLength store := by + rw [encodedStoreLength_eq_sums] + rw [hsum] + omega + generalize hsize : store.length.size = width + cases width with + | zero => + have hzero : store.length = 0 := by + have := Nat.size_pos.not.mp (by omega : ¬0 < store.length.size) + omega + simp [hzero] + | succ width => + cases width with + | zero => + have hsmall : store.length ≤ 1 := by + have hlt := Nat.lt_size_self store.length + rw [hsize] at hlt + norm_num at hlt + omega + have hbits : bitlen store.length = 1 := by + simpa [bitlen] using hsize + rw [hbits] + omega + | succ width => + let addressSet := addresses.toFinset + let threshold := 2 ^ width + let low := addressSet.filter fun address => address < threshold + let high := addressSet.filter fun address => threshold ≤ address + have hcard : addressSet.card = store.length := by + rw [List.toFinset_card_of_nodup hnodup, hlength] + have hlowSubset : low ⊆ Finset.range threshold := by + intro address haddress + have := (Finset.mem_filter.mp haddress).2 + simpa [Finset.mem_range] using this + have hlow : low.card ≤ threshold := by + exact le_trans (Finset.card_le_card hlowSubset) (by simp) + have hpartition : low.card + high.card = store.length := by + have hparts := Finset.card_filter_add_card_filter_not + (s := addressSet) (p := fun address => address < threshold) + simpa [low, high, Nat.not_lt, hcard] using hparts + have hthresholdTwice : 2 * threshold ≤ store.length := by + have hpow : 2 ^ (width + 1) ≤ store.length := by + rw [← Nat.lt_size] + omega + simpa [threshold, pow_succ, Nat.mul_comm] using hpow + have hmanyHigh : store.length ≤ 2 * high.card := by omega + have hhighWidth : ∀ address ∈ high, width + 1 ≤ bitlen address := by + intro address haddress + have hge := (Finset.mem_filter.mp haddress).2 + unfold bitlen + have hlt : width < address.size := Nat.lt_size.mpr (by + simpa [threshold] using hge) + omega + have hhighSum : high.card * (width + 1) ≤ + ∑ address ∈ high, bitlen address := by + exact Finset.card_nsmul_le_sum high (fun address => bitlen address) + (width + 1) hhighWidth + have hhighSubset : high ⊆ addressSet := Finset.filter_subset _ _ + have hsumSubset : (∑ address ∈ high, bitlen address) ≤ + ∑ address ∈ addressSet, bitlen address := by + exact Finset.sum_le_sum_of_subset hhighSubset + have hsetSum : (∑ address ∈ addressSet, bitlen address) = + addressWidths.sum := by + rw [← List.sum_toFinset (fun address => bitlen address) hnodup] + have hwidth : bitlen store.length = width + 2 := by + simpa [bitlen] using hsize + rw [hwidth] + have hmain : store.length * (width + 2) ≤ + 2 * addressWidths.sum + store.length := by + rw [show store.length * (width + 2) = + store.length * (width + 1) + store.length by ring] + have hproduct : store.length * (width + 1) ≤ + 2 * (high.card * (width + 1)) := + by simpa [Nat.mul_assoc] using + Nat.mul_le_mul_right (width + 1) hmanyHigh + omega + omega + +private theorem store_length_le_encodedStoreLength (store : Store) : + store.length ≤ encodedStoreLength store := by + rw [encodedStoreLength_eq_sums] + omega + +private theorem entry_bits_le_encodedStoreLength (store : Store) + (entry : Entry) (hentry : entry ∈ store) : + entry.1.bits.length ≤ encodedStoreLength store ∧ + entry.2.bits.length ≤ encodedStoreLength store := by + induction store with + | nil => simp at hentry + | cons head rest ih => + simp only [List.mem_cons] at hentry + have hcode : (Entry.encode head).length + encodedStoreLength rest = + encodedStoreLength (head :: rest) := by + simp [encodedStoreLength] + rcases hentry with rfl | hentry + · rw [Entry.encode_length] at hcode + rw [Nat.size_eq_bits_len, Nat.size_eq_bits_len] + unfold bitlen at hcode + omega + · have htail := ih hentry + omega + +private theorem read_bits_le_encodedStoreLength (store : Store) + (address : ℕ) : + (RegisterStore.read store address).bits.length ≤ encodedStoreLength store := by + induction store with + | nil => simp [RegisterStore.read, encodedStoreLength] + | cons entry rest ih => + rcases entry with ⟨storedAddress, storedValue⟩ + by_cases haddress : address = storedAddress + · subst address + simp only [RegisterStore.read, ↓reduceIte] + exact (entry_bits_le_encodedStoreLength + ((storedAddress, storedValue) :: rest) (storedAddress, storedValue) + (by simp)).2 + · simp only [RegisterStore.read, haddress, ↓reduceIte] + exact le_trans ih (by + simp [encodedStoreLength]) + +private theorem count_bits_le_encodedStoreLength (store : Store) + (hcanonical : Canonical store) : + store.length.bits.length ≤ encodedStoreLength store := by + rw [Nat.size_eq_bits_len] + change bitlen store.length ≤ encodedStoreLength store + have hproduct := + address_count_width_le_encodedStoreLength store hcanonical + by_cases hzero : store.length = 0 + · simp [hzero, bitlen] + · have hpos : 1 ≤ store.length := Nat.one_le_iff_ne_zero.mpr hzero + have hle : bitlen store.length ≤ store.length * bitlen store.length := by + simpa only [one_mul] using + Nat.mul_le_mul_right (bitlen store.length) hpos + exact le_trans hle hproduct + +private theorem entryLookupStoreWidth_le_encoded (store : Store) + (address : ℕ) : + entryLookupStoreWidth address store ≤ + encodedStoreLength store + address.bits.length := by + induction store with + | nil => simp [entryLookupStoreWidth, encodedStoreLength] + | cons entry rest ih => + have hentry := entry_bits_le_encodedStoreLength (entry :: rest) + entry (by simp) + have hrestEncoded : encodedStoreLength rest ≤ + encodedStoreLength (entry :: rest) := by + simp [encodedStoreLength] + simp only [entryLookupStoreWidth] + apply max_le + · unfold entryLookupEntryWidth + apply max_le + · exact Nat.le_add_left _ _ + · apply max_le + · exact le_trans hentry.1 (Nat.le_add_right _ _) + · apply max_le + · exact le_trans hentry.2 (Nat.le_add_right _ _) + · apply max_le + · simpa [bitlen, Nat.size_eq_bits_len] using + le_trans hentry.1 (Nat.le_add_right + (encodedStoreLength (entry :: rest)) address.bits.length) + · apply max_le + · simpa [bitlen, Nat.size_eq_bits_len] using + le_trans hentry.2 (Nat.le_add_right + (encodedStoreLength (entry :: rest)) address.bits.length) + · have hpositive : 1 ≤ encodedStoreLength (entry :: rest) := by + rw [encodedStoreLength_eq_sums] + simp only [List.map_cons, List.sum_cons, List.length_cons] + omega + exact le_trans hpositive (Nat.le_add_right _ _) + · exact le_trans ih (Nat.add_le_add_right hrestEncoded _) + +private theorem entryLookupResetWidth_le_encoded + (store : Store) (address : ℕ) (hcanonical : Canonical store) : + entryLookupResetWidth store address ≤ + encodedStoreLength store + address.bits.length := by + unfold entryLookupResetWidth + exact max_le (le_trans (count_bits_le_encodedStoreLength store hcanonical) + (Nat.le_add_right _ _)) + (entryLookupStoreWidth_le_encoded store address) + +private def denseLookupVolume (inputLength : ℕ) (store : Store) + (address : ℕ) : ℕ := + encodedStoreLength store + + store.length * (bitlen address + 1) + + inputLength * (bitlen address + 1) + bitlen address + 1 + +private theorem denseLookupVolume_pos (inputLength : ℕ) + (store : Store) (address : ℕ) : + 1 ≤ denseLookupVolume inputLength store address := by + simp [denseLookupVolume] + +private theorem entryLookupTime_le_volume {m : ℕ} + (tapes : EntryLookupRestoreTapes m) (inputLength : ℕ) + (store : Store) (address : ℕ) (hcanonical : Canonical store) : + entryLookupTime tapes.scan address store ≤ + 3000 * denseLookupVolume inputLength store address := by + have hscan := entryScanTime_le_encoded tapes.scan address.bits store + have hcount := address_count_width_le_encodedStoreLength store hcanonical + have hlength := store_length_le_encodedStoreLength store + have haddress : address.bits.length = bitlen address := by + simp [bitlen, Nat.size_eq_bits_len] + rw [haddress] at hscan + unfold denseLookupVolume + nlinarith + +private theorem entryLookupLoadedTime_le_volume {m : ℕ} + (tapes : EntryLookupRestoreTapes m) (inputLength : ℕ) + (store : Store) (address : ℕ) (hcanonical : Canonical store) : + entryLookupLoadedTime tapes store address ≤ + 100000 * denseLookupVolume inputLength store address := by + let volume := denseLookupVolume inputLength store address + have hvolume : 1 ≤ volume := denseLookupVolume_pos inputLength store address + have hencoded : encodedStoreLength store ≤ volume := by + dsimp only [volume] + unfold denseLookupVolume + omega + have haddressWidth : bitlen address ≤ volume := by + dsimp only [volume] + unfold denseLookupVolume + omega + have hlookup := entryLookupTime_le_volume tapes inputLength store address + hcanonical + have hresetWidth := entryLookupResetWidth_le_encoded store address hcanonical + have hread := read_bits_le_encodedStoreLength store address + have hcount := count_bits_le_encodedStoreLength store hcanonical + have hcopyAddress := TM.binaryCopyTime_le address 0 + have hcopyRead := TM.binaryCopyTime_le + (RegisterStore.read store address) 0 + have hcopyCount := TM.binaryCopyTime_le store.length 0 + have haddress : address.size = bitlen address := rfl + have hreadSize : (RegisterStore.read store address).size = + (RegisterStore.read store address).bits.length := + (Nat.size_eq_bits_len _).symm + have hcountSize : store.length.size = store.length.bits.length := + (Nat.size_eq_bits_len _).symm + rw [haddress, Nat.size_zero] at hcopyAddress + rw [hreadSize, Nat.size_zero] at hcopyRead + rw [hcountSize, Nat.size_zero] at hcopyCount + have hhead : entryLookupRestoreHeadBound tapes store address ≤ + 3000 * volume + 1 := by + unfold entryLookupRestoreHeadBound + omega + have hreset : entryLookupResetTime tapes store address ≤ + 30000 * volume := by + unfold entryLookupResetTime + have haddressBits : address.bits.length = bitlen address := by + simp [bitlen, Nat.size_eq_bits_len] + rw [haddressBits] at hresetWidth + have hresetWidth' : entryLookupResetWidth store address ≤ + 2 * volume := le_trans hresetWidth (by omega) + omega + have htail : entryLookupRestoreTailTime tapes store address ≤ + 40000 * volume := by + unfold entryLookupRestoreTailTime + omega + have hcopyRestore : entryLookupCopyRestoreTime tapes store address ≤ + 70000 * volume := by + unfold entryLookupCopyRestoreTime + omega + unfold entryLookupLoadedTime + omega + +private theorem denseInputLookupTime_le_volume + (inputLength address : ℕ) : + denseInputLookupTime inputLength address ≤ + 50 * (inputLength * (bitlen address + 1) + bitlen address + 1) := by + have hscan := denseInputScanTime_le_width inputLength address + have hcopy := TM.binaryCopyTime_le address 0 + have hsubSize : (address - inputLength).bits.length ≤ bitlen address := by + rw [Nat.size_eq_bits_len] + exact Nat.size_le_size (Nat.sub_le address inputLength) + rw [show address.size = bitlen address from rfl] at hscan + rw [show address.size = bitlen address from rfl, Nat.size_zero] at hcopy + unfold denseInputLookupTime TM.resetBinaryWorkTime TM.clearWorkTimeBound + nlinarith + +private theorem denseOverlayLookupTime_le_volume {m : ℕ} + (tapes : EntryLookupRestoreTapes m) (inputLength : ℕ) + (overlay : Store) (address : ℕ) + (hvalid : DenseOverlay.Valid overlay) : + denseOverlayLookupTime tapes inputLength overlay address ≤ + 200000 * denseLookupVolume inputLength overlay address := by + have hvolume := denseLookupVolume_pos inputLength overlay address + have hloaded := entryLookupLoadedTime_le_volume tapes inputLength overlay + address hvalid.1 + have hfallback := denseInputLookupTime_le_volume inputLength address + have htag := read_bits_le_encodedStoreLength overlay address + have hpred := TM.binaryPredTime_le + (RegisterStore.read overlay address - 1) + have hpredSize : + (RegisterStore.read overlay address - 1 + 1).size ≤ + encodedStoreLength overlay + 1 := by + have hreadSize : (RegisterStore.read overlay address).size ≤ + encodedStoreLength overlay := by + simpa [Nat.size_eq_bits_len] using htag + have hvalue : RegisterStore.read overlay address - 1 + 1 ≤ + RegisterStore.read overlay address + 1 := by omega + have hsize := Nat.size_le_size hvalue + have hsucc : (RegisterStore.read overlay address + 1).size ≤ + (RegisterStore.read overlay address).size + 1 := by + rw [Nat.size_le] + have hlt := Nat.lt_size_self (RegisterStore.read overlay address) + have hpow := Nat.pow_le_pow_right (by decide : 1 ≤ 2) (by + simpa [Nat.size_eq_bits_len] using htag) + rw [pow_succ] + omega + exact le_trans hsize (le_trans hsucc (by omega)) + have hpred' : TM.binaryPredTime + (RegisterStore.read overlay address - 1) ≤ + 2 * (encodedStoreLength overlay + 1) + 2 := by + exact le_trans hpred (by omega) + have hbranch : max (denseInputLookupTime inputLength address) + (TM.binaryPredTime (RegisterStore.read overlay address - 1)) ≤ + 90000 * denseLookupVolume inputLength overlay address := by + apply max_le + · dsimp only at hvolume hfallback ⊢ + unfold denseLookupVolume at hvolume ⊢ + omega + · dsimp only at hvolume hpred' ⊢ + unfold denseLookupVolume at hvolume ⊢ + omega + unfold denseOverlayLookupTime TM.branchWorkBlankTime + omega + +private theorem size_le_self (value : ℕ) : value.size ≤ value := by + rw [Nat.size_le] + exact Nat.lt_pow_self (by decide) + +private theorem bitlen_le_succ (value : ℕ) : bitlen value ≤ value + 1 := by + unfold bitlen + exact le_trans (size_le_self value) (Nat.le_succ value) + +private theorem bitlen_succ_le (value : ℕ) : + bitlen (value + 1) ≤ bitlen value + 1 := by + rw [bitlen, bitlen, Nat.size_le] + have hvalue := Nat.lt_size_self value + have hpowPos : 0 < 2 ^ value.size := pow_pos (by omega) _ + rw [pow_succ] + omega + +private theorem binaryAddConstTime_zero_le (fixedValue : ℕ) : + TM.binaryAddConstTime fixedValue 0 ≤ 4 * (fixedValue + 1) ^ 2 := by + induction fixedValue with + | zero => simp [TM.binaryAddConstTime] + | succ fixedValue ih => + rw [TM.binaryAddConstTime] + have hsucc := TM.binarySuccTime_le fixedValue + have hsize := size_le_self fixedValue + calc + TM.binaryAddConstTime fixedValue 0 + 1 + + TM.binarySuccTime (0 + fixedValue) ≤ + 4 * (fixedValue + 1) ^ 2 + 1 + (2 * fixedValue + 2) := by + simp only [Nat.zero_add] + exact Nat.add_le_add (Nat.add_le_add ih le_rfl) + (le_trans hsucc (by omega)) + _ ≤ 4 * (fixedValue + 1 + 1) ^ 2 := by nlinarith + +private theorem binaryInstructionArithmeticTime_le_width + (op : BinaryInstrOp) (lhs rhs width : ℕ) + (hlhs : bitlen lhs ≤ width) (hrhs : bitlen rhs ≤ width) : + binaryInstructionArithmeticTime op lhs rhs ≤ + 1000 * (width + 1) ^ 2 := by + have hlhsSize : lhs.size ≤ width := by simpa [bitlen] using hlhs + have hrhsSize : rhs.size ≤ width := by simpa [bitlen] using hrhs + cases op with + | add => + have htime := TM.binaryRippleAddTime_le lhs rhs + have honeSq : 1 ≤ (width + 1) ^ 2 := by nlinarith + have hwidthSq : width ≤ (width + 1) ^ 2 := by nlinarith + change TM.binaryRippleAddTime lhs rhs ≤ 1000 * (width + 1) ^ 2 + omega + | sub => + have htime := TM.binaryRippleSubTime_le lhs rhs + have honeSq : 1 ≤ (width + 1) ^ 2 := by nlinarith + have hwidthSq : width ≤ (width + 1) ^ 2 := by nlinarith + change TM.binaryRippleSubTime lhs rhs ≤ 1000 * (width + 1) ^ 2 + omega + | mul => + change TM.binaryShiftMulTime lhs rhs ≤ 1000 * (width + 1) ^ 2 + unfold TM.binaryShiftMulTime TM.binaryShiftMulWidth + nlinarith + +private theorem binaryInstrResult_bitlen_le + (op : BinaryInstrOp) (lhs rhs : ℕ) : + bitlen (op.eval lhs rhs) ≤ bitlen lhs + bitlen rhs + 1 := by + unfold bitlen + cases op with + | add => + exact le_trans (TM.binaryRippleAdd_sum_size_le lhs rhs) (by omega) + | sub => + exact le_trans (Nat.size_le_size (Nat.sub_le lhs rhs)) (by omega) + | mul => + exact le_trans (BinaryShiftMul.size_mul_le_add lhs rhs) (by omega) + +private theorem denseLookupVolume_le_product + (inputLength : ℕ) (store : Store) (address width : ℕ) + (haddress : bitlen address ≤ width) : + denseLookupVolume inputLength store address ≤ + 4 * (encodedStoreLength store + inputLength + width + 1) * + (width + 1) := by + have hlength := store_length_le_encodedStoreLength store + have hstoreProduct : store.length * (bitlen address + 1) ≤ + encodedStoreLength store * (width + 1) := + Nat.mul_le_mul hlength (Nat.add_le_add_right haddress 1) + have hinputProduct : inputLength * (bitlen address + 1) ≤ + inputLength * (width + 1) := + Nat.mul_le_mul_left inputLength (Nat.add_le_add_right haddress 1) + unfold denseLookupVolume + nlinarith + +private theorem denseOverlayLookupTime_le_product {m : ℕ} + (tapes : EntryLookupRestoreTapes m) (inputLength : ℕ) + (overlay : Store) (address width : ℕ) + (hvalid : DenseOverlay.Valid overlay) (haddress : bitlen address ≤ width) : + denseOverlayLookupTime tapes inputLength overlay address ≤ + 800000 * (encodedStoreLength overlay + inputLength + width + 1) * + (width + 1) := by + have hlookup := denseOverlayLookupTime_le_volume tapes inputLength overlay + address hvalid + have hvolume := denseLookupVolume_le_product inputLength overlay address width + haddress + calc + denseOverlayLookupTime tapes inputLength overlay address ≤ + 200000 * denseLookupVolume inputLength overlay address := hlookup + _ ≤ 200000 * + (4 * (encodedStoreLength overlay + inputLength + width + 1) * + (width + 1)) := Nat.mul_le_mul_left 200000 hvolume + _ = 800000 * (encodedStoreLength overlay + inputLength + width + 1) * + (width + 1) := by ring + +private theorem denseOverlayLookupStaticTime_le_product {m : ℕ} + (tapes : EntryLookupRestoreTapes m) (inputLength : ℕ) + (overlay : Store) (address width magnitude : ℕ) + (hvalid : DenseOverlay.Valid overlay) (haddress : bitlen address ≤ width) + (hfixed : address ≤ magnitude) : + denseOverlayLookupStaticTime tapes inputLength overlay address ≤ + 1000000 * (magnitude + 1) ^ 2 * + (encodedStoreLength overlay + inputLength + width + 1) * + (width + 1) := by + let volume := encodedStoreLength overlay + inputLength + width + 1 + let unit := (magnitude + 1) ^ 2 * volume * (width + 1) + have hvolume : 1 ≤ volume := by + dsimp only [volume] + omega + have hmagnitudeSq : 1 ≤ (magnitude + 1) ^ 2 := by nlinarith + have hunitPos : 0 < unit := by + dsimp only [unit] + positivity + have hunit : 1 ≤ unit := hunitPos + have hadd := binaryAddConstTime_zero_le address + have hadd' : TM.binaryAddConstTime address 0 ≤ 4 * unit := by + have hfixedSq : (address + 1) ^ 2 ≤ (magnitude + 1) ^ 2 := + Nat.pow_le_pow_left (Nat.add_le_add_right hfixed 1) 2 + have hfactor : (magnitude + 1) ^ 2 ≤ unit := by + dsimp only [unit] + calc + (magnitude + 1) ^ 2 = (magnitude + 1) ^ 2 * 1 * 1 := by ring + _ ≤ (magnitude + 1) ^ 2 * volume * (width + 1) := + Nat.mul_le_mul (Nat.mul_le_mul_left _ hvolume) (by omega) + exact le_trans hadd (by nlinarith) + have hlookup := denseOverlayLookupTime_le_product tapes inputLength overlay + address width hvalid haddress + have hlookup' : denseOverlayLookupTime tapes inputLength overlay address ≤ + 800000 * unit := by + have hbase : volume * (width + 1) ≤ unit := by + dsimp only [unit] + calc + volume * (width + 1) = (1 * volume) * (width + 1) := by simp + _ ≤ ((magnitude + 1) ^ 2 * volume) * (width + 1) := + Nat.mul_le_mul_right (width + 1) + (Nat.mul_le_mul_right volume hmagnitudeSq) + calc + denseOverlayLookupTime tapes inputLength overlay address ≤ + 800000 * (volume * (width + 1)) := by + simpa only [volume, Nat.mul_assoc] using hlookup + _ ≤ 800000 * unit := Nat.mul_le_mul_left 800000 hbase + have hreset : TM.resetBinaryWorkTime 1 address.bits.length ≤ + 2 * width + 9 := by + unfold TM.resetBinaryWorkTime TM.clearWorkTimeBound + simpa [bitlen, Nat.size_eq_bits_len] using + (show 1 + 2 + 1 + (2 * bitlen address + 5) ≤ + 2 * width + 9 by omega) + have hwidthUnit : width + 1 ≤ unit := by + dsimp only [unit] + calc + width + 1 = (1 * 1) * (width + 1) := by simp + _ ≤ ((magnitude + 1) ^ 2 * volume) * (width + 1) := + Nat.mul_le_mul_right (width + 1) (Nat.mul_le_mul hmagnitudeSq hvolume) + have hreset' : TM.resetBinaryWorkTime 1 address.bits.length ≤ + 11 * unit := le_trans hreset (by nlinarith) + unfold denseOverlayLookupStaticTime + calc + TM.binaryAddConstTime address 0 + 1 + + (denseOverlayLookupTime tapes inputLength overlay address + 1 + + TM.resetBinaryWorkTime 1 address.bits.length) ≤ + 1000000 * unit := by omega + _ = 1000000 * (magnitude + 1) ^ 2 * + (encodedStoreLength overlay + inputLength + width + 1) * + (width + 1) := by + dsimp only [unit, volume] + ring + +private theorem taggedEntryUpdateTime_le_product {m : ℕ} + (tapes : EntryUpdateTapes m) (inputLength : ℕ) + (overlay : Store) (address value width : ℕ) + (hcanonical : Canonical overlay) (haddress : bitlen address ≤ width) + (hvalue : bitlen value ≤ width) : + taggedEntryUpdateTime tapes overlay address value ≤ + 20000 * (encodedStoreLength overlay + inputLength + width + 1) * + (width + 1) := by + let volume := encodedStoreLength overlay + inputLength + width + 1 + have hvolume : 1 ≤ volume := by + dsimp only [volume] + omega + have hencoded : encodedStoreLength overlay ≤ volume := by + dsimp only [volume] + omega + have hwidthVolume : width + 1 ≤ volume := by + dsimp only [volume] + omega + have hvolumeFactor : volume ≤ volume * (width + 1) := by + calc + volume = volume * 1 := by simp + _ ≤ volume * (width + 1) := Nat.mul_le_mul_left volume (by omega) + have hlengthEncoded := store_length_le_encodedStoreLength overlay + have hlength : overlay.length ≤ volume := le_trans hlengthEncoded hencoded + have hcountBits := count_bits_le_encodedStoreLength overlay hcanonical + have hcount : bitlen overlay.length ≤ encodedStoreLength overlay := by + simpa [bitlen, Nat.size_eq_bits_len] using hcountBits + have hcountProduct := + address_count_width_le_encodedStoreLength overlay hcanonical + have htag : bitlen (value + 1) ≤ width + 1 := + le_trans (bitlen_succ_le value) (Nat.add_le_add_right hvalue 1) + have hlengthAddress : overlay.length * bitlen address ≤ + volume * width := Nat.mul_le_mul hlength haddress + have hlengthTag : overlay.length * bitlen (value + 1) ≤ + volume * (width + 1) := Nat.mul_le_mul hlength htag + have hupdate := entryUpdateTime_le_encoded tapes overlay address (value + 1) + have hupdateVolume : entryUpdateTime tapes overlay address (value + 1) ≤ + 12000 * volume * (width + 1) := by + calc + entryUpdateTime tapes overlay address (value + 1) ≤ + 1000 * (encodedStoreLength overlay + + (overlay.length + 1) * + (bitlen address + bitlen (value + 1) + + bitlen overlay.length + 1) + 1) := hupdate + _ ≤ 1000 * (12 * volume * (width + 1)) := by + apply Nat.mul_le_mul_left 1000 + rw [show (overlay.length + 1) * + (bitlen address + bitlen (value + 1) + bitlen overlay.length + 1) = + overlay.length * bitlen address + + overlay.length * bitlen (value + 1) + + overlay.length * bitlen overlay.length + overlay.length + + bitlen address + bitlen (value + 1) + + bitlen overlay.length + 1 by ring] + dsimp only [volume] at hvolumeFactor ⊢ + nlinarith + _ = 12000 * volume * (width + 1) := by ring + have hsucc := TM.binarySuccTime_le value + have hsucc' : TM.binarySuccTime value ≤ + 3 * volume * (width + 1) := by + have hsize : value.size ≤ width := by simpa [bitlen] using hvalue + exact le_trans hsucc (by nlinarith) + unfold taggedEntryUpdateTime + dsimp only [volume] at hupdateVolume hsucc' ⊢ + nlinarith + +private def denseResourceUnit (magnitude inputLength : ℕ) + (overlay : Store) (width : ℕ) : ℕ := + (magnitude + 1) ^ 2 * + (encodedStoreLength overlay + inputLength + width + 1) * (width + 1) + +private theorem denseResourceUnit_pos (magnitude inputLength : ℕ) + (overlay : Store) (width : ℕ) : + 1 ≤ denseResourceUnit magnitude inputLength overlay width := by + have hpos : 0 < denseResourceUnit magnitude inputLength overlay width := by + unfold denseResourceUnit + positivity + omega + +private theorem denseResourceBase_le_unit (magnitude inputLength : ℕ) + (overlay : Store) (width : ℕ) : + (encodedStoreLength overlay + inputLength + width + 1) * (width + 1) ≤ + denseResourceUnit magnitude inputLength overlay width := by + unfold denseResourceUnit + have hmagnitudePos : 0 < (magnitude + 1) ^ 2 := pow_pos (by omega) _ + have hmagnitude : 1 ≤ (magnitude + 1) ^ 2 := by omega + calc + (encodedStoreLength overlay + inputLength + width + 1) * (width + 1) = + (1 * (encodedStoreLength overlay + inputLength + width + 1)) * + (width + 1) := by simp + _ ≤ ((magnitude + 1) ^ 2 * + (encodedStoreLength overlay + inputLength + width + 1)) * + (width + 1) := Nat.mul_le_mul_right (width + 1) + (Nat.mul_le_mul_right _ hmagnitude) + +private theorem denseResourceVolume_le_unit (magnitude inputLength : ℕ) + (overlay : Store) (width : ℕ) : + encodedStoreLength overlay + inputLength + width + 1 ≤ + denseResourceUnit magnitude inputLength overlay width := by + exact le_trans (by + have := Nat.mul_le_mul_left + (encodedStoreLength overlay + inputLength + width + 1) + (show 1 ≤ width + 1 by omega) + simpa only [Nat.mul_one] using this) + (denseResourceBase_le_unit magnitude inputLength overlay width) + +private theorem denseResourceWidthSq_le_unit (magnitude inputLength : ℕ) + (overlay : Store) (width : ℕ) : + (width + 1) ^ 2 ≤ + denseResourceUnit magnitude inputLength overlay width := by + apply le_trans _ (denseResourceBase_le_unit magnitude inputLength overlay width) + calc + (width + 1) ^ 2 = (width + 1) * (width + 1) := by ring + _ ≤ (encodedStoreLength overlay + inputLength + width + 1) * + (width + 1) := Nat.mul_le_mul_right (width + 1) (by omega) + +private theorem denseResourceMagnitudeSq_le_unit + (magnitude inputLength : ℕ) (overlay : Store) (width : ℕ) : + (magnitude + 1) ^ 2 ≤ + denseResourceUnit magnitude inputLength overlay width := by + unfold denseResourceUnit + calc + (magnitude + 1) ^ 2 = (magnitude + 1) ^ 2 * 1 * 1 := by ring + _ ≤ (magnitude + 1) ^ 2 * + (encodedStoreLength overlay + inputLength + width + 1) * + (width + 1) := Nat.mul_le_mul + (Nat.mul_le_mul_left _ (by omega)) (by omega) +private theorem denseExecuteInstructionTime_le_product {m : ℕ} + (tapes : ControlInstructionTapes m) (input : List Bool) + (instruction : Instr) (pcValue : ℕ) (overlay : Store) + (width magnitude : ℕ) (hvalid : DenseOverlay.Valid overlay) + (hstatic : RegisterStore.Instr.staticWidth instruction ≤ width) + (hcost : instruction.logCost + (DenseOverlay.Snapshot.decode input { pc := pcValue, overlay }) ≤ width) + (hfixed : instructionResourceMagnitude instruction ≤ magnitude) + (hpc : pcValue ≤ magnitude) : + denseExecuteInstructionTime tapes input instruction pcValue overlay ≤ + 6000000 * denseResourceUnit magnitude input.length overlay width := by + let unit := denseResourceUnit magnitude input.length overlay width + have hunit : 1 ≤ unit := denseResourceUnit_pos magnitude input.length + overlay width + have hbase : (encodedStoreLength overlay + input.length + width + 1) * + (width + 1) ≤ unit := denseResourceBase_le_unit magnitude input.length + overlay width + have hvolume : encodedStoreLength overlay + input.length + width + 1 ≤ + unit := denseResourceVolume_le_unit magnitude input.length overlay width + have hwidthSq : (width + 1) ^ 2 ≤ unit := + denseResourceWidthSq_le_unit magnitude input.length overlay width + have hmagnitudeSq : (magnitude + 1) ^ 2 ≤ unit := + denseResourceMagnitudeSq_le_unit magnitude input.length overlay width + have hencoded : encodedStoreLength overlay ≤ unit := by + exact le_trans (by omega) hvolume + have hencodedBits : (overlay.flatMap Entry.encode).length ≤ unit := by + simpa only [encodedStoreLength] using hencoded + have hfixedAdd : ∀ fixedValue, fixedValue ≤ magnitude → + TM.binaryAddConstTime fixedValue 0 ≤ 4 * unit := by + intro fixedValue hconstant + have hadd := binaryAddConstTime_zero_le fixedValue + have hsquare : (fixedValue + 1) ^ 2 ≤ (magnitude + 1) ^ 2 := + Nat.pow_le_pow_left (Nat.add_le_add_right hconstant 1) 2 + exact le_trans hadd (by nlinarith) + have hstaticLookup : ∀ address, bitlen address ≤ width → + address ≤ magnitude → + denseOverlayLookupStaticTime tapes.data.lhsLookup input.length overlay + address ≤ 1000000 * unit := by + intro address haddress haddressFixed + have hlookup := denseOverlayLookupStaticTime_le_product + tapes.data.lhsLookup input.length overlay address width magnitude hvalid + haddress haddressFixed + calc + denseOverlayLookupStaticTime tapes.data.lhsLookup input.length overlay + address ≤ 1000000 * (magnitude + 1) ^ 2 * + (encodedStoreLength overlay + input.length + width + 1) * + (width + 1) := hlookup + _ = 1000000 * unit := by + dsimp only [unit, denseResourceUnit] + ring + have hstaticLookupRhs : ∀ address, bitlen address ≤ width → + address ≤ magnitude → + denseOverlayLookupStaticTime tapes.data.rhsLookup input.length overlay + address ≤ 1000000 * unit := by + intro address haddress haddressFixed + have hlookup := denseOverlayLookupStaticTime_le_product + tapes.data.rhsLookup input.length overlay address width magnitude hvalid + haddress haddressFixed + calc + denseOverlayLookupStaticTime tapes.data.rhsLookup input.length overlay + address ≤ 1000000 * (magnitude + 1) ^ 2 * + (encodedStoreLength overlay + input.length + width + 1) * + (width + 1) := hlookup + _ = 1000000 * unit := by + dsimp only [unit, denseResourceUnit] + ring + have hdynamicLookup : ∀ address, bitlen address ≤ width → + denseOverlayLookupTime tapes.data.indirectLoadLookup input.length overlay + address ≤ 800000 * unit := by + intro address haddress + have hlookup := denseOverlayLookupTime_le_product + tapes.data.indirectLoadLookup input.length overlay address width hvalid + haddress + calc + denseOverlayLookupTime tapes.data.indirectLoadLookup input.length overlay + address ≤ 800000 * + ((encodedStoreLength overlay + input.length + width + 1) * + (width + 1)) := by simpa only [Nat.mul_assoc] using hlookup + _ ≤ 800000 * unit := Nat.mul_le_mul_left 800000 hbase + have htaggedUpdate : ∀ address value, + bitlen address ≤ width → bitlen value ≤ width → + taggedEntryUpdateTime tapes.data.update overlay address value ≤ + 20000 * unit := by + intro address value haddress hvalue + have hupdate := taggedEntryUpdateTime_le_product tapes.data.update + input.length overlay address value width hvalid.1 haddress hvalue + calc + taggedEntryUpdateTime tapes.data.update overlay address value ≤ + 20000 * ((encodedStoreLength overlay + input.length + width + 1) * + (width + 1)) := by simpa only [Nat.mul_assoc] using hupdate + _ ≤ 20000 * unit := Nat.mul_le_mul_left 20000 hbase + have harithmetic : ∀ op lhs rhs, bitlen lhs ≤ width → + bitlen rhs ≤ width → + binaryInstructionArithmeticTime op lhs rhs ≤ 1000 * unit := by + intro op lhs rhs hlhs hrhs + exact le_trans (binaryInstructionArithmeticTime_le_width op lhs rhs width + hlhs hrhs) (Nat.mul_le_mul_left 1000 hwidthSq) + have hcopy : ∀ value, bitlen value ≤ width → + TM.binaryCopyTime value 0 ≤ 23 * unit := by + intro value hvalue + have htime := TM.binaryCopyTime_le value 0 + have hsize : value.size ≤ width := by simpa [bitlen] using hvalue + rw [Nat.size_zero] at htime + exact le_trans htime (by nlinarith) + have hreset : ∀ value, bitlen value ≤ width → + TM.resetBinaryWorkTime 1 value.bits.length ≤ 11 * unit := by + intro value hvalue + unfold TM.resetBinaryWorkTime TM.clearWorkTimeBound + have hbits : value.bits.length ≤ width := by + simpa [bitlen, Nat.size_eq_bits_len] using hvalue + nlinarith + have hpcSize : pcValue.size ≤ magnitude := + le_trans (size_le_self pcValue) hpc + have hpcSucc := TM.binarySuccTime_le pcValue + have hpcSucc' : TM.binarySuccTime pcValue ≤ 4 * unit := + le_trans hpcSucc (by nlinarith) + have hpcReset : TM.resetBinaryWorkTime 1 pcValue.bits.length ≤ + 11 * unit := by + unfold TM.resetBinaryWorkTime TM.clearWorkTimeBound + have hbits : pcValue.bits.length ≤ magnitude := by + simpa [Nat.size_eq_bits_len] using hpcSize + nlinarith + cases instruction with + | imm destination value => + simp only [RegisterStore.Instr.staticWidth] at hstatic + simp only [instructionResourceMagnitude] at hfixed + simp only [Instr.logCost] at hcost + have hdestinationWidth : bitlen destination ≤ width := + le_trans (le_max_left _ _) hstatic + have hvalueWidth : bitlen value ≤ width := by omega + have hvalueAdd := hfixedAdd value (by omega) + have hdestinationAdd := hfixedAdd destination (by omega) + have hupdate := htaggedUpdate destination value hdestinationWidth hvalueWidth + simp only [denseExecuteInstructionTime, denseImmediateInstructionTime] + omega + | add destination source₀ source₁ => + simp only [RegisterStore.Instr.staticWidth] at hstatic + simp only [instructionResourceMagnitude] at hfixed + simp only [Instr.logCost, DenseOverlay.Snapshot.decode, + DenseOverlay.decode] at hcost + have hdestinationWidth : bitlen destination ≤ width := + le_trans (le_max_left _ _) hstatic + have hsource₀Width : bitlen source₀ ≤ width := + le_trans (le_max_left _ _) (le_trans (le_max_right _ _) hstatic) + have hsource₁Width : bitlen source₁ ≤ width := + le_trans (le_max_right _ _) (le_trans (le_max_right _ _) hstatic) + have hlhs : bitlen (DenseOverlay.read input overlay source₀) ≤ width := + by omega + have hrhs : bitlen (DenseOverlay.read input overlay source₁) ≤ width := + by omega + have hresult : bitlen (DenseOverlay.read input overlay source₀ + + DenseOverlay.read input overlay source₁) ≤ width := by omega + have hlookup₀ := hstaticLookup source₀ hsource₀Width (by omega) + have hlookup₁ := hstaticLookupRhs source₁ hsource₁Width (by omega) + have hadd := hfixedAdd destination (by omega) + have hop := harithmetic .add (DenseOverlay.read input overlay source₀) + (DenseOverlay.read input overlay source₁) hlhs hrhs + have hupdate := htaggedUpdate destination + (DenseOverlay.read input overlay source₀ + + DenseOverlay.read input overlay source₁) + hdestinationWidth hresult + simp only [denseExecuteInstructionTime, denseDirectBinaryInstructionTime, + denseBinaryInstructionUpdateTime, BinaryInstrOp.eval] + omega + | sub destination source₀ source₁ => + simp only [RegisterStore.Instr.staticWidth] at hstatic + simp only [instructionResourceMagnitude] at hfixed + simp only [Instr.logCost, DenseOverlay.Snapshot.decode, + DenseOverlay.decode] at hcost + have hdestinationWidth : bitlen destination ≤ width := + le_trans (le_max_left _ _) hstatic + have hsource₀Width : bitlen source₀ ≤ width := + le_trans (le_max_left _ _) (le_trans (le_max_right _ _) hstatic) + have hsource₁Width : bitlen source₁ ≤ width := + le_trans (le_max_right _ _) (le_trans (le_max_right _ _) hstatic) + have hlhs : bitlen (DenseOverlay.read input overlay source₀) ≤ width := + by omega + have hrhs : bitlen (DenseOverlay.read input overlay source₁) ≤ width := + by omega + have hresultRaw := binaryInstrResult_bitlen_le .sub + (DenseOverlay.read input overlay source₀) + (DenseOverlay.read input overlay source₁) + have hresult : bitlen (DenseOverlay.read input overlay source₀ - + DenseOverlay.read input overlay source₁) ≤ width := + le_trans hresultRaw (by omega) + have hlookup₀ := hstaticLookup source₀ hsource₀Width (by omega) + have hlookup₁ := hstaticLookupRhs source₁ hsource₁Width (by omega) + have hadd := hfixedAdd destination (by omega) + have hop := harithmetic .sub (DenseOverlay.read input overlay source₀) + (DenseOverlay.read input overlay source₁) hlhs hrhs + have hupdate := htaggedUpdate destination + (DenseOverlay.read input overlay source₀ - + DenseOverlay.read input overlay source₁) + hdestinationWidth hresult + simp only [denseExecuteInstructionTime, denseDirectBinaryInstructionTime, + denseBinaryInstructionUpdateTime, BinaryInstrOp.eval] + omega + | mul destination source₀ source₁ => + simp only [RegisterStore.Instr.staticWidth] at hstatic + simp only [instructionResourceMagnitude] at hfixed + simp only [Instr.logCost, DenseOverlay.Snapshot.decode, + DenseOverlay.decode] at hcost + have hdestinationWidth : bitlen destination ≤ width := + le_trans (le_max_left _ _) hstatic + have hsource₀Width : bitlen source₀ ≤ width := + le_trans (le_max_left _ _) (le_trans (le_max_right _ _) hstatic) + have hsource₁Width : bitlen source₁ ≤ width := + le_trans (le_max_right _ _) (le_trans (le_max_right _ _) hstatic) + have hlhs : bitlen (DenseOverlay.read input overlay source₀) ≤ width := + by omega + have hrhs : bitlen (DenseOverlay.read input overlay source₁) ≤ width := + by omega + have hresult : bitlen (DenseOverlay.read input overlay source₀ * + DenseOverlay.read input overlay source₁) ≤ width := by omega + have hlookup₀ := hstaticLookup source₀ hsource₀Width (by omega) + have hlookup₁ := hstaticLookupRhs source₁ hsource₁Width (by omega) + have hadd := hfixedAdd destination (by omega) + have hop := harithmetic .mul (DenseOverlay.read input overlay source₀) + (DenseOverlay.read input overlay source₁) hlhs hrhs + have hupdate := htaggedUpdate destination + (DenseOverlay.read input overlay source₀ * + DenseOverlay.read input overlay source₁) + hdestinationWidth hresult + simp only [denseExecuteInstructionTime, denseDirectBinaryInstructionTime, + denseBinaryInstructionUpdateTime, BinaryInstrOp.eval] + omega + | load destination addressRegister => + simp only [RegisterStore.Instr.staticWidth] at hstatic + simp only [instructionResourceMagnitude] at hfixed + simp only [Instr.logCost, DenseOverlay.Snapshot.decode, + DenseOverlay.decode] at hcost + have hdestinationWidth : bitlen destination ≤ width := + le_trans (le_max_left _ _) hstatic + have hregisterWidth : bitlen addressRegister ≤ width := + le_trans (le_max_right _ _) hstatic + have haddress : bitlen + (DenseOverlay.read input overlay addressRegister) ≤ width := by omega + have hvalue : bitlen (DenseOverlay.read input overlay + (DenseOverlay.read input overlay addressRegister)) ≤ width := by omega + have hlookup := hstaticLookup addressRegister hregisterWidth (by omega) + have hindirect := hdynamicLookup + (DenseOverlay.read input overlay addressRegister) haddress + have hadd := hfixedAdd destination (by omega) + have hupdate := htaggedUpdate destination + (DenseOverlay.read input overlay + (DenseOverlay.read input overlay addressRegister)) + hdestinationWidth hvalue + simp only [denseExecuteInstructionTime, denseIndirectLoadInstructionTime] + omega + | store addressRegister source => + simp only [RegisterStore.Instr.staticWidth] at hstatic + simp only [instructionResourceMagnitude] at hfixed + simp only [Instr.logCost, DenseOverlay.Snapshot.decode, + DenseOverlay.decode] at hcost + have hregisterWidth : bitlen addressRegister ≤ width := + le_trans (le_max_left _ _) hstatic + have hsourceWidth : bitlen source ≤ width := + le_trans (le_max_right _ _) hstatic + have haddress : bitlen + (DenseOverlay.read input overlay addressRegister) ≤ width := by omega + have hvalue : bitlen (DenseOverlay.read input overlay source) ≤ width := + by omega + have hlookupAddress := hstaticLookup addressRegister hregisterWidth + (by omega) + have hlookupValue := hstaticLookupRhs source hsourceWidth (by omega) + have hcopyAddress := hcopy + (DenseOverlay.read input overlay addressRegister) haddress + have hcopyValue := hcopy (DenseOverlay.read input overlay source) hvalue + have hupdate := htaggedUpdate + (DenseOverlay.read input overlay addressRegister) + (DenseOverlay.read input overlay source) haddress hvalue + simp only [denseExecuteInstructionTime, denseIndirectStoreInstructionTime] + omega + | jz source target => + simp only [RegisterStore.Instr.staticWidth] at hstatic + simp only [instructionResourceMagnitude] at hfixed + simp only [Instr.logCost, DenseOverlay.Snapshot.decode, + DenseOverlay.decode] at hcost + have hsourceWidth : bitlen source ≤ width := + le_trans (le_max_left _ _) hstatic + have hvalue : bitlen (DenseOverlay.read input overlay source) ≤ width := + by omega + have hlookupRaw := denseOverlayLookupStaticTime_le_product + tapes.lifted.data.lhsLookup input.length overlay source width magnitude + hvalid hsourceWidth (by omega) + have hlookup : denseOverlayLookupStaticTime + tapes.lifted.data.lhsLookup input.length overlay source ≤ + 1000000 * unit := by + calc + denseOverlayLookupStaticTime tapes.lifted.data.lhsLookup input.length + overlay source ≤ 1000000 * (magnitude + 1) ^ 2 * + (encodedStoreLength overlay + input.length + width + 1) * + (width + 1) := hlookupRaw + _ = 1000000 * unit := by + dsimp only [unit, denseResourceUnit] + ring + have htargetAdd := hfixedAdd target (by omega) + have hset : setProgramCounterTime pcValue target ≤ 16 * unit := by + unfold setProgramCounterTime + omega + have hbranch : max (setProgramCounterTime pcValue target) + (TM.binarySuccTime pcValue) ≤ 16 * unit := + max_le hset (by omega) + have hresetValue := hreset (DenseOverlay.read input overlay source) hvalue + simp only [denseExecuteInstructionTime, denseZeroJumpInstructionTime, + TM.branchWorkBlankTime] + omega + | jmp target => + simp only [instructionResourceMagnitude] at hfixed + have htargetAdd := hfixedAdd target (by omega) + have hset : setProgramCounterTime pcValue target ≤ 16 * unit := by + unfold setProgramCounterTime + omega + simp only [denseExecuteInstructionTime, jumpInstructionTime] + omega + | halt => + simp only [denseExecuteInstructionTime, haltInstructionTime] + omega + +private theorem dispatchWithTime_le_selected {m : ℕ} + (tapes : ControlInstructionTapes m) (executeTime : Instr → ℕ) + (program : Program) (selector : ℕ) : + dispatchWithTime tapes executeTime program selector ≤ + executeTime (selectedInstruction program selector) + + 20 * (selector + 1) ^ 2 + 20 := by + induction program generalizing selector with + | nil => + have hsize := size_le_self selector + simp only [dispatchWithTime, selectedInstruction] + unfold TM.resetBinaryWorkTime TM.clearWorkTimeBound + rw [Nat.size_eq_bits_len] + nlinarith + | cons instruction rest ih => + cases selector with + | zero => + simp [dispatchWithTime, selectedInstruction] + | succ selector => + have htail := ih selector + have hpred := TM.binaryPredTime_le selector + have hsize := size_le_self (selector + 1) + simp only [dispatchWithTime, selectedInstruction] + nlinarith + +private theorem selectedInstructionResourceMagnitude_le + (program : Program) (selector : ℕ) : + instructionResourceMagnitude (selectedInstruction program selector) ≤ + programResourceMagnitude program := by + induction program generalizing selector with + | nil => simp [selectedInstruction, instructionResourceMagnitude, + programResourceMagnitude] + | cons instruction rest ih => + cases selector with + | zero => + simp only [selectedInstruction, programResourceMagnitude, + List.length_cons, List.map_cons, List.sum_cons] + omega + | succ selector => + have htail := ih selector + simp only [selectedInstruction, programResourceMagnitude, + List.length_cons, List.map_cons, List.sum_cons] + unfold programResourceMagnitude at htail + omega + +private theorem selectedInstructionStaticWidth_le + (program : Program) (selector : ℕ) : + RegisterStore.Instr.staticWidth (selectedInstruction program selector) ≤ + programStaticWidth program := by + induction program generalizing selector with + | nil => simp [selectedInstruction, RegisterStore.Instr.staticWidth, + programStaticWidth] + | cons instruction rest ih => + cases selector with + | zero => simp [selectedInstruction, programStaticWidth] + | succ selector => + exact le_trans (ih selector) (by + simp [programStaticWidth]) +private theorem denseProgramInstructionTime_le_product {m : ℕ} + (tapes : ControlInstructionTapes m) (program : Program) + (input : List Bool) (snapshot : DenseOverlay.Snapshot) + (hvalid : DenseOverlay.Valid snapshot.overlay) + (hpc : snapshot.pc ≤ programResourceMagnitude program) : + denseProgramInstructionTime tapes program input snapshot.pc + snapshot.overlay ≤ + 7000000 * denseResourceUnit (programResourceMagnitude program) + input.length snapshot.overlay (denseStepWidth program input snapshot) := by + let width := denseStepWidth program input snapshot + let magnitude := programResourceMagnitude program + let unit := denseResourceUnit magnitude input.length snapshot.overlay width + let instruction := selectedInstruction program snapshot.pc + have hunit : 1 ≤ unit := denseResourceUnit_pos magnitude input.length + snapshot.overlay width + have hmagnitudeSq : (magnitude + 1) ^ 2 ≤ unit := + denseResourceMagnitudeSq_le_unit magnitude input.length snapshot.overlay width + have hstatic : RegisterStore.Instr.staticWidth instruction ≤ width := by + exact le_trans (selectedInstructionStaticWidth_le program snapshot.pc) (by + unfold width denseStepWidth + omega) + have hselectedCost : instruction.logCost (snapshot.decode input) = + RAM.stepLogCost program (snapshot.decode input) := by + unfold instruction RAM.stepLogCost RAM.curInstr + rw [selectedInstruction_eq_getElem?_getD] + simp [DenseOverlay.Snapshot.decode] + have hcost : instruction.logCost (snapshot.decode input) ≤ width := by + rw [hselectedCost] + unfold width denseStepWidth + omega + have hfixed : instructionResourceMagnitude instruction ≤ magnitude := by + exact selectedInstructionResourceMagnitude_le program snapshot.pc + have hexecute := denseExecuteInstructionTime_le_product tapes input instruction + snapshot.pc snapshot.overlay width magnitude hvalid hstatic hcost hfixed (by + simpa only [magnitude] using hpc) + have hdispatchRaw := dispatchWithTime_le_selected tapes + (fun current => denseExecuteInstructionTime tapes input current snapshot.pc + snapshot.overlay) program snapshot.pc + have hselectorSquare : (snapshot.pc + 1) ^ 2 ≤ + (magnitude + 1) ^ 2 := + Nat.pow_le_pow_left (Nat.add_le_add_right (by + simpa only [magnitude] using hpc) 1) 2 + have hdispatch : denseDispatchProgramTime tapes input snapshot.overlay + snapshot.pc program snapshot.pc ≤ 6100000 * unit := by + unfold denseDispatchProgramTime + apply le_trans hdispatchRaw + dsimp only [instruction] at hexecute ⊢ + nlinarith + have hcopyRaw := TM.binaryCopyTime_le snapshot.pc 0 + have hpcSize : snapshot.pc.size ≤ magnitude := + le_trans (size_le_self snapshot.pc) (by simpa only [magnitude] using hpc) + have hcopy : TM.binaryCopyTime snapshot.pc 0 ≤ 23 * unit := by + rw [Nat.size_zero] at hcopyRaw + exact le_trans hcopyRaw (by nlinarith) + unfold denseProgramInstructionTime + dsimp only [unit, width, magnitude] at hdispatch hcopy hunit ⊢ + omega + +private theorem bufferedCleanupTime_le_linear {m : ℕ} + (tapes : ControlInstructionTapes m) (oldStore nextStore : Store) + (cleanupValues : Fin 5 → ℕ) (remainingValue sourceHeadBound bound : ℕ) + (hsource : 1 ≤ sourceHeadBound) + (hcleanup : ∀ slot, (cleanupValues slot).bits.length ≤ bound) + (hremaining : remainingValue.bits.length ≤ bound) + (hold : encodedStoreLength oldStore ≤ bound) + (hnext : encodedStoreLength nextStore ≤ bound) : + bufferedCleanupTime tapes oldStore nextStore cleanupValues remainingValue + sourceHeadBound ≤ + 100 * (sourceHeadBound + bound + 1) := by + let nextBits := nextStore.flatMap Entry.encode + have hreset := TM.resetBinaryWorkManyTime_le + (instructionCleanupResetTargets tapes) + (bufferedCleanupResetBitsAt tapes cleanupValues remainingValue oldStore) + (instructionCleanupResetHeadBoundAt tapes sourceHeadBound) + sourceHeadBound bound + (by + intro i hi + obtain ⟨slot, rfl⟩ := List.mem_ofFn.mp hi + rw [instructionCleanupResetHeadBoundAt, + (instructionCleanupResetTape_injective tapes).extend_apply] + fin_cases slot <;> + simp [instructionCleanupResetHeadBound, hsource]) + (by + intro i hi + obtain ⟨slot, rfl⟩ := List.mem_ofFn.mp hi + rw [bufferedCleanupResetBitsAt, + (instructionCleanupResetTape_injective tapes).extend_apply] + fin_cases slot + · simpa [bufferedCleanupResetBits] using hcleanup 0 + · simpa [bufferedCleanupResetBits] using hcleanup 1 + · simpa [bufferedCleanupResetBits] using hcleanup 2 + · simpa [bufferedCleanupResetBits] using hcleanup 3 + · simpa [bufferedCleanupResetBits] using hcleanup 4 + · simpa [bufferedCleanupResetBits] using hremaining + · simpa [bufferedCleanupResetBits, encodedStoreLength] using hold) + have htargets : (instructionCleanupResetTargets tapes).length = 7 := by + simp [instructionCleanupResetTargets] + rw [htargets] at hreset + have hnextBits : nextBits.length ≤ bound := by + simpa only [nextBits, encodedStoreLength] using hnext + have hnextLength : nextStore.length ≤ bound := + le_trans (store_length_le_encodedStoreLength nextStore) hnext + have hresetNext : TM.resetBinaryWorkTime (nextBits.length + 1) + nextBits.length ≤ 3 * bound + 9 := by + unfold TM.resetBinaryWorkTime TM.clearWorkTimeBound + omega + have hcopyRaw := TM.binaryCopyTime_le nextStore.length 0 + have hcopy : TM.binaryCopyTime nextStore.length 0 ≤ 3 * bound + 20 := by + rw [Nat.size_zero] at hcopyRaw + exact le_trans hcopyRaw (by + have hsize := le_trans (size_le_self nextStore.length) hnextLength + omega) + unfold bufferedCleanupTime + dsimp only [nextBits] at hnextBits hresetNext ⊢ + omega + +private theorem denseInstructionCleanupValue_bits_le + (input : List Bool) (instruction : Instr) (pcValue : ℕ) + (overlay : Store) (width : ℕ) + (hstatic : RegisterStore.Instr.staticWidth instruction ≤ width) + (hcost : instruction.logCost + (DenseOverlay.Snapshot.decode input { pc := pcValue, overlay }) ≤ width) : + ∀ slot, (denseInstructionCleanupValue input instruction overlay slot).bits.length + ≤ width + 1 := by + have hbits (value : ℕ) (hvalue : bitlen value ≤ width + 1) : + value.bits.length ≤ width + 1 := by + simpa [bitlen, Nat.size_eq_bits_len] using hvalue + cases instruction with + | imm destination value => + simp only [RegisterStore.Instr.staticWidth] at hstatic + simp only [Instr.logCost] at hcost + have hdestination : bitlen destination ≤ width + 1 := by omega + have htag : bitlen (value + 1) ≤ width + 1 := + le_trans (bitlen_succ_le value) (by omega) + intro slot + fin_cases slot + · exact hbits destination hdestination + · exact hbits (value + 1) htag + · simp only [denseInstructionCleanupValue] + split <;> simp + · simp [denseInstructionCleanupValue] + · simp [denseInstructionCleanupValue] + | add destination source₀ source₁ => + simp only [RegisterStore.Instr.staticWidth] at hstatic + simp only [Instr.logCost, DenseOverlay.Snapshot.decode, + DenseOverlay.decode] at hcost + let lhs := DenseOverlay.read input overlay source₀ + let rhs := DenseOverlay.read input overlay source₁ + have hdestination : bitlen destination ≤ width + 1 := by omega + have hlhs : bitlen lhs ≤ width + 1 := by + dsimp only [lhs] + omega + have hrhs : bitlen rhs ≤ width + 1 := by + dsimp only [rhs] + omega + have htag : bitlen (lhs + rhs + 1) ≤ width + 1 := by + exact le_trans (bitlen_succ_le (lhs + rhs)) (by + dsimp only [lhs, rhs] + omega) + intro slot + fin_cases slot + · exact hbits destination hdestination + · simpa only [lhs, rhs] using hbits (lhs + rhs + 1) htag + · simp only [denseInstructionCleanupValue] + split <;> simp + · simpa only [lhs] using hbits lhs hlhs + · simpa only [rhs] using hbits rhs hrhs + | sub destination source₀ source₁ => + simp only [RegisterStore.Instr.staticWidth] at hstatic + simp only [Instr.logCost, DenseOverlay.Snapshot.decode, + DenseOverlay.decode] at hcost + let lhs := DenseOverlay.read input overlay source₀ + let rhs := DenseOverlay.read input overlay source₁ + have hdestination : bitlen destination ≤ width + 1 := by omega + have hlhs : bitlen lhs ≤ width := by + dsimp only [lhs] + omega + have hrhs : bitlen rhs ≤ width := by + dsimp only [rhs] + omega + have hresult := binaryInstrResult_bitlen_le .sub lhs rhs + have hresult' : bitlen (lhs - rhs) ≤ bitlen lhs + bitlen rhs + 1 := by + simpa [BinaryInstrOp.eval] using hresult + have hresultWidth : bitlen (lhs - rhs) ≤ width := by + apply le_trans hresult' + dsimp only [lhs, rhs] at hcost ⊢ + exact hcost + have htag : bitlen (lhs - rhs + 1) ≤ width + 1 := + le_trans (bitlen_succ_le (lhs - rhs)) + (Nat.add_le_add_right hresultWidth 1) + intro slot + fin_cases slot + · exact hbits destination hdestination + · simpa only [lhs, rhs] using hbits (lhs - rhs + 1) htag + · simp only [denseInstructionCleanupValue] + split <;> simp + · exact hbits lhs (by omega) + · exact hbits rhs (by omega) + | mul destination source₀ source₁ => + simp only [RegisterStore.Instr.staticWidth] at hstatic + simp only [Instr.logCost, DenseOverlay.Snapshot.decode, + DenseOverlay.decode] at hcost + let lhs := DenseOverlay.read input overlay source₀ + let rhs := DenseOverlay.read input overlay source₁ + have hdestination : bitlen destination ≤ width + 1 := by omega + have hlhs : bitlen lhs ≤ width + 1 := by + dsimp only [lhs] + omega + have hrhs : bitlen rhs ≤ width + 1 := by + dsimp only [rhs] + omega + have htag : bitlen (lhs * rhs + 1) ≤ width + 1 := + le_trans (bitlen_succ_le (lhs * rhs)) (by + dsimp only [lhs, rhs] + omega) + intro slot + fin_cases slot + · exact hbits destination hdestination + · simpa only [lhs, rhs] using hbits (lhs * rhs + 1) htag + · simp only [denseInstructionCleanupValue] + split <;> simp + · simpa only [lhs] using hbits lhs hlhs + · simpa only [rhs] using hbits rhs hrhs + | load destination addressRegister => + simp only [RegisterStore.Instr.staticWidth] at hstatic + simp only [Instr.logCost, DenseOverlay.Snapshot.decode, + DenseOverlay.decode] at hcost + let address := DenseOverlay.read input overlay addressRegister + let value := DenseOverlay.read input overlay address + have hdestination : bitlen destination ≤ width + 1 := by omega + have haddress : bitlen address ≤ width + 1 := by + dsimp only [address] + omega + have htag : bitlen (value + 1) ≤ width + 1 := + le_trans (bitlen_succ_le value) (by + dsimp only [address, value] + omega) + intro slot + fin_cases slot + · exact hbits destination hdestination + · simpa only [address, value] using hbits (value + 1) htag + · simp only [denseInstructionCleanupValue] + split <;> simp + · simpa only [address] using hbits address haddress + · simp [denseInstructionCleanupValue] + | store addressRegister source => + simp only [RegisterStore.Instr.staticWidth] at hstatic + simp only [Instr.logCost, DenseOverlay.Snapshot.decode, + DenseOverlay.decode] at hcost + let address := DenseOverlay.read input overlay addressRegister + let value := DenseOverlay.read input overlay source + have haddress : bitlen address ≤ width + 1 := by + dsimp only [address] + omega + have hvalue : bitlen value ≤ width := by + dsimp only [value] + omega + have htag : bitlen (value + 1) ≤ width + 1 := + le_trans (bitlen_succ_le value) (by omega) + intro slot + fin_cases slot + · simpa only [address] using hbits address haddress + · simpa only [value] using hbits (value + 1) htag + · simp only [denseInstructionCleanupValue] + split <;> simp + · simpa only [address] using hbits address haddress + · simpa only [value] using hbits value (by omega) + | jz source target => + intro slot + fin_cases slot <;> simp [denseInstructionCleanupValue] + | jmp target => + intro slot + fin_cases slot <;> simp [denseInstructionCleanupValue] + | halt => + intro slot + fin_cases slot <;> simp [denseInstructionCleanupValue] + +private theorem denseInstructionRemainingValue_bits_le + (instruction : Instr) (overlay : Store) (hcanonical : Canonical overlay) : + (denseInstructionRemainingValue instruction overlay).bits.length ≤ + encodedStoreLength overlay := by + have hcount := count_bits_le_encodedStoreLength overlay hcanonical + cases instruction <;> + simp only [denseInstructionRemainingValue] <;> simp_all +theorem denseProgramStepTime_le_envelope_internal {m : ℕ} + (tapes : ControlInstructionTapes m) (program : Program) + (input : List Bool) (snapshot : DenseOverlay.Snapshot) + (hvalid : DenseOverlay.Valid snapshot.overlay) + (hpc : snapshot.pc ≤ programResourceMagnitude program) : + denseProgramStepTime tapes program input snapshot.pc snapshot.overlay ≤ + denseStepEnvelope program input snapshot := by + let width := denseStepWidth program input snapshot + let magnitude := programResourceMagnitude program + let unit := denseResourceUnit magnitude input.length snapshot.overlay width + let instruction := selectedInstruction program snapshot.pc + let nextStore := denseInstructionStore input instruction snapshot.pc + snapshot.overlay + let instructionTime := denseProgramInstructionTime tapes program input + snapshot.pc snapshot.overlay + let cleanupBound := encodedStoreLength snapshot.overlay + 2 * width + 2 + have hunit : 1 ≤ unit := denseResourceUnit_pos magnitude input.length + snapshot.overlay width + have hvolume : encodedStoreLength snapshot.overlay + input.length + width + 1 ≤ + unit := denseResourceVolume_le_unit magnitude input.length snapshot.overlay + width + have hinstruction : instructionTime ≤ 7000000 * unit := by + have htime := denseProgramInstructionTime_le_product tapes program input + snapshot hvalid hpc + simpa only [instructionTime, unit, width, magnitude] using htime + have hstatic : RegisterStore.Instr.staticWidth instruction ≤ width := by + exact le_trans (selectedInstructionStaticWidth_le program snapshot.pc) (by + unfold width denseStepWidth + omega) + have hselectedCost : instruction.logCost (snapshot.decode input) = + RAM.stepLogCost program (snapshot.decode input) := by + unfold instruction RAM.stepLogCost RAM.curInstr + rw [selectedInstruction_eq_getElem?_getD] + simp [DenseOverlay.Snapshot.decode] + have hcost : instruction.logCost (snapshot.decode input) ≤ width := by + rw [hselectedCost] + unfold width denseStepWidth + omega + have hcleanupValues : ∀ slot, + (denseInstructionCleanupValue input instruction snapshot.overlay slot).bits.length + ≤ cleanupBound := by + intro slot + apply le_trans (denseInstructionCleanupValue_bits_le input instruction + snapshot.pc snapshot.overlay width hstatic hcost slot) + unfold cleanupBound + omega + have hremaining : + (denseInstructionRemainingValue instruction snapshot.overlay).bits.length ≤ + cleanupBound := by + apply le_trans (denseInstructionRemainingValue_bits_le instruction + snapshot.overlay hvalid.1) + unfold cleanupBound + omega + have hold : encodedStoreLength snapshot.overlay ≤ cleanupBound := by + unfold cleanupBound + omega + have hnextRaw := DenseOverlay.Snapshot.encodedStoreLength_stepInstr_le input + instruction snapshot + have hnext : encodedStoreLength nextStore ≤ cleanupBound := by + have hincrement : RegisterStore.Instr.staticWidth instruction + + instruction.logCost (snapshot.decode input) + 1 ≤ width := by + rw [hselectedCost] + unfold width denseStepWidth + have hselectedStatic := selectedInstructionStaticWidth_le program snapshot.pc + change RegisterStore.Instr.staticWidth instruction ≤ + programStaticWidth program at hselectedStatic + omega + dsimp only [nextStore] + unfold denseInstructionStore + exact le_trans hnextRaw (by + unfold cleanupBound + omega) + have hcleanup := bufferedCleanupTime_le_linear tapes snapshot.overlay nextStore + (denseInstructionCleanupValue input instruction snapshot.overlay) + (denseInstructionRemainingValue instruction snapshot.overlay) + (denseProgramStepSourceHeadBound tapes program input snapshot.pc + snapshot.overlay) + cleanupBound (by + unfold denseProgramStepSourceHeadBound + omega) + hcleanupValues hremaining hold hnext + have hcleanupBoundUnit : cleanupBound ≤ 3 * unit := by + unfold cleanupBound + nlinarith + have hcleanup' : bufferedCleanupTime tapes snapshot.overlay nextStore + (denseInstructionCleanupValue input instruction snapshot.overlay) + (denseInstructionRemainingValue instruction snapshot.overlay) + (denseProgramStepSourceHeadBound tapes program input snapshot.pc + snapshot.overlay) ≤ + 800000000 * unit := by + apply le_trans hcleanup + unfold denseProgramStepSourceHeadBound + dsimp only [instructionTime] at hinstruction ⊢ + nlinarith + unfold denseProgramStepTime + dsimp only [instruction, nextStore, instructionTime] + apply le_trans (by omega : instructionTime + 1 + + bufferedCleanupTime tapes snapshot.overlay nextStore + (denseInstructionCleanupValue input instruction snapshot.overlay) + (denseInstructionRemainingValue instruction snapshot.overlay) + (denseProgramStepSourceHeadBound tapes program input snapshot.pc + snapshot.overlay) ≤ 1000000000 * unit) + apply le_of_eq + dsimp only [unit, width, magnitude, denseResourceUnit, denseStepEnvelope, + denseStepVolume] + ring + +private theorem denseSnapshot_step_pc_le_resourceMagnitude + (program : Program) (input : List Bool) + (snapshot : DenseOverlay.Snapshot) + (hpc : snapshot.pc ≤ programResourceMagnitude program) : + (snapshot.step program input).pc ≤ programResourceMagnitude program := by + by_cases hinRange : snapshot.pc < program.length + · have hfallthrough : snapshot.pc + 1 ≤ + programResourceMagnitude program := by + exact le_trans (by omega) (program_length_le_resourceMagnitude program) + have hselected := selectedInstructionResourceMagnitude_le program snapshot.pc + unfold DenseOverlay.Snapshot.step DenseOverlay.Snapshot.curInstr + rw [← selectedInstruction_eq_getElem?_getD] + generalize hinstruction : selectedInstruction program snapshot.pc = instruction + rw [hinstruction] at hselected + cases instruction <;> + simp only [DenseOverlay.Snapshot.stepInstr, + instructionResourceMagnitude] at hselected ⊢ + · exact hfallthrough + · exact hfallthrough + · exact hfallthrough + · exact hfallthrough + · exact hfallthrough + · exact hfallthrough + · split <;> dsimp only <;> omega + · omega + · exact hpc + · have houtOfRange : program[snapshot.pc]? = none := + List.getElem?_eq_none (by omega) + unfold DenseOverlay.Snapshot.step DenseOverlay.Snapshot.curInstr + rw [houtOfRange] + simpa [DenseOverlay.Snapshot.stepInstr] using hpc + +private theorem denseStepVolume_le_runScale_succ + (program : Program) (input : List Bool) (fuel : ℕ) + (snapshot : DenseOverlay.Snapshot) : + denseStepVolume program input snapshot ≤ + denseRunScale program input (fuel + 1) snapshot := by + have hhalted : snapshot.Halted program ↔ + RAM.Halted program (snapshot.decode input) := Iff.rfl + by_cases hhalt : snapshot.Halted program + · have hramHalt := hhalted.mp hhalt + have hcost : RAM.stepLogCost program (snapshot.decode input) = 1 := by + unfold RAM.stepLogCost RAM.curInstr + change (snapshot.curInstr program).logCost (snapshot.decode input) = 1 + rw [hhalt] + rfl + unfold denseStepVolume denseStepWidth denseRunScale + rw [RAM.unitTimeUpto_succ, if_pos hramHalt, + RAM.logTimeUpto_succ, if_pos hramHalt] + rw [hcost] + nlinarith + · have hramNotHalt : ¬RAM.Halted program (snapshot.decode input) := + fun h => hhalt (hhalted.mpr h) + unfold denseStepVolume denseStepWidth denseRunScale + rw [RAM.unitTimeUpto_succ, if_neg hramNotHalt, + RAM.logTimeUpto_succ, if_neg hramNotHalt] + nlinarith + +private theorem denseRunScale_step_add_width_le + (program : Program) (input : List Bool) (fuel : ℕ) + (snapshot : DenseOverlay.Snapshot) + (hvalid : DenseOverlay.Valid snapshot.overlay) : + denseRunScale program input fuel (snapshot.step program input) + + (denseStepWidth program input snapshot + 1) ≤ + denseRunScale program input (fuel + 1) snapshot := by + have hhalted : snapshot.Halted program ↔ + RAM.Halted program (snapshot.decode input) := Iff.rfl + by_cases hhalt : snapshot.Halted program + · have hramHalt := hhalted.mp hhalt + have hstep : snapshot.step program input = snapshot := by + change snapshot.stepInstr input (snapshot.curInstr program) = snapshot + rw [hhalt] + rfl + have hcost : RAM.stepLogCost program (snapshot.decode input) = 1 := by + unfold RAM.stepLogCost RAM.curInstr + change (snapshot.curInstr program).logCost (snapshot.decode input) = 1 + rw [hhalt] + rfl + rw [hstep] + unfold denseRunScale denseStepWidth + rw [RAM.unitTimeUpto_halted program hramHalt, + RAM.logTimeUpto_halted program hramHalt] + rw [hcost] + nlinarith + · have hramNotHalt : ¬RAM.Halted program (snapshot.decode input) := + fun h => hhalt (hhalted.mpr h) + have hstore := DenseOverlay.Snapshot.encodedStoreLength_step_le + program input snapshot + have hdecode := DenseOverlay.Snapshot.decode_step program input snapshot + hvalid.1 + unfold denseRunScale denseStepWidth + rw [RAM.unitTimeUpto_succ, if_neg hramNotHalt, + RAM.logTimeUpto_succ, if_neg hramNotHalt, hdecode] + nlinarith + +private theorem denseDispatchHaltTime_le_width {m : ℕ} + (tapes : ControlInstructionTapes m) (program : Program) + (selector bound : ℕ) (hbound : 1 ≤ bound) + (hselector : selector.bits.length ≤ bound) : + dispatchHaltTime tapes program selector ≤ + 20 * (program.length + 1) * (bound + 1) := by + induction program generalizing selector with + | nil => + have hreset : TM.resetBinaryWorkTime 1 selector.bits.length ≤ + 2 * bound + 9 := by + unfold TM.resetBinaryWorkTime TM.clearWorkTimeBound + omega + simp only [dispatchHaltTime, List.length_nil, Nat.zero_add, + Nat.mul_one] + omega + | cons instruction rest ih => + have hselectorPred : (selector - 1).bits.length ≤ bound := by + simpa only [Nat.size_eq_bits_len] using + (le_trans (Nat.size_le_size (Nat.sub_le selector 1)) (by + simpa [Nat.size_eq_bits_len] using hselector)) + have htail := ih (selector - 1) hselectorPred + have hpred := TM.binaryPredTime_le (selector - 1) + have hpredSize : (selector - 1 + 1).size ≤ bound + 1 := by + have hvalue : selector - 1 + 1 ≤ selector + 1 := by omega + have hsize := Nat.size_le_size hvalue + have hselectorSize : selector.size ≤ bound := by + simpa [Nat.size_eq_bits_len] using hselector + have hsucc : (selector + 1).size ≤ bound + 1 := by + rw [Nat.size_le] + have hlt := Nat.lt_size_self selector + have hpow := Nat.pow_le_pow_right (by decide : 1 ≤ 2) hselectorSize + rw [pow_succ] + omega + exact le_trans hsize hsucc + have hpred' : TM.binaryPredTime (selector - 1) ≤ + 2 * (bound + 1) + 2 := le_trans hpred (by omega) + simp only [dispatchHaltTime, TM.branchWorkBlankTime, List.length_cons] + have hmax : max 1 + (TM.binaryPredTime (selector - 1) + 1 + + dispatchHaltTime tapes rest (selector - 1)) ≤ + 2 * (bound + 1) + 3 + + 20 * (rest.length + 1) * (bound + 1) := by + apply max_le <;> omega + nlinarith + +private theorem denseProgramHaltTime_le_magnitude {m : ℕ} + (tapes : ControlInstructionTapes m) (program : Program) + (pcValue : ℕ) (hpc : pcValue ≤ programResourceMagnitude program) : + programHaltTime tapes program pcValue ≤ + 40 * (programResourceMagnitude program + 1) ^ 2 := by + let magnitude := programResourceMagnitude program + have hmagnitude : 1 ≤ magnitude := programResourceMagnitude_pos program + have hpcSize : pcValue.size ≤ magnitude := + le_trans (size_le_self pcValue) hpc + have hpcBits : pcValue.bits.length ≤ magnitude := by + simpa only [Nat.size_eq_bits_len] using hpcSize + have hdispatch := denseDispatchHaltTime_le_width tapes program pcValue + magnitude hmagnitude hpcBits + have hcopyRaw := TM.binaryCopyTime_le pcValue 0 + have hcopy : TM.binaryCopyTime pcValue 0 ≤ 3 * magnitude + 20 := by + apply le_trans hcopyRaw + simp only [Nat.size_zero, Nat.mul_zero] + omega + have hlength := program_length_le_resourceMagnitude program + unfold programHaltTime + dsimp only [magnitude] at hmagnitude hdispatch hcopy ⊢ + nlinarith + +private theorem denseProgramLoopIterationTime_le_product {m : ℕ} + (tapes : ControlInstructionTapes m) (program : Program) + (input : List Bool) (snapshot : DenseOverlay.Snapshot) + (hvalid : DenseOverlay.Valid snapshot.overlay) + (hpc : snapshot.pc ≤ programResourceMagnitude program) : + denseProgramLoopIterationTime tapes program input snapshot ≤ + 2000000000 * (programResourceMagnitude program + 1) ^ 2 * + denseStepVolume program input snapshot * + (denseStepWidth program input snapshot + 1) := by + let magnitude := programResourceMagnitude program + let volume := denseStepVolume program input snapshot + let width := denseStepWidth program input snapshot + let unit := (magnitude + 1) ^ 2 * volume * (width + 1) + have hstep := denseProgramStepTime_le_envelope_internal tapes program input + snapshot hvalid hpc + have hnextPc := denseSnapshot_step_pc_le_resourceMagnitude program input + snapshot hpc + have hhalt := denseProgramHaltTime_le_magnitude tapes program + (snapshot.step program input).pc hnextPc + have hvolume : 1 ≤ volume := by + unfold volume denseStepVolume + omega + have hwidth : 1 ≤ width + 1 := by omega + have hfixed : (magnitude + 1) ^ 2 ≤ unit := by + calc + (magnitude + 1) ^ 2 = (magnitude + 1) ^ 2 * 1 * 1 := by ring + _ ≤ (magnitude + 1) ^ 2 * volume * (width + 1) := + Nat.mul_le_mul (Nat.mul_le_mul_left _ hvolume) hwidth + unfold denseProgramLoopIterationTime + dsimp only [magnitude, volume, width, unit] at hstep hhalt hfixed ⊢ + unfold denseStepEnvelope at hstep + nlinarith +theorem denseProgramLoopTime_le_envelope_internal {m : ℕ} + (tapes : ControlInstructionTapes m) (program : Program) + (input : List Bool) (fuel : ℕ) + (snapshot : DenseOverlay.Snapshot) + (hvalid : DenseOverlay.Valid snapshot.overlay) + (hpc : snapshot.pc ≤ programResourceMagnitude program) : + denseProgramLoopTime tapes program input fuel snapshot ≤ + denseProgramLoopEnvelope program input fuel snapshot := by + induction fuel generalizing snapshot with + | zero => + simp [denseProgramLoopTime, denseProgramLoopEnvelope] + | succ fuel ih => + let next := snapshot.step program input + let fixed := 2000000000 * (programResourceMagnitude program + 1) ^ 2 + let volume := denseStepVolume program input snapshot + let width := denseStepWidth program input snapshot + let currentScale := denseRunScale program input (fuel + 1) snapshot + let nextScale := denseRunScale program input fuel next + have hiteration := denseProgramLoopIterationTime_le_product tapes program + input snapshot hvalid hpc + have hnextValid : DenseOverlay.Valid next.overlay := by + dsimp only [next] + exact DenseOverlay.Snapshot.step_valid program input snapshot hvalid + have hnextPc : next.pc ≤ programResourceMagnitude program := by + dsimp only [next] + exact denseSnapshot_step_pc_le_resourceMagnitude program input snapshot hpc + have htail := ih next hnextValid hnextPc + have hvolume : volume ≤ currentScale := by + dsimp only [volume, currentScale] + exact denseStepVolume_le_runScale_succ program input fuel snapshot + have hdrop : nextScale + (width + 1) ≤ currentScale := by + dsimp only [nextScale, next, width, currentScale] + exact denseRunScale_step_add_width_le program input fuel snapshot hvalid + have hnextCurrent : nextScale ≤ currentScale := by omega + have hvolumeProduct : volume * (width + 1) ≤ + currentScale * (width + 1) := + Nat.mul_le_mul_right (width + 1) hvolume + have hnextSquare : nextScale * nextScale ≤ + currentScale * nextScale := + Nat.mul_le_mul_right nextScale hnextCurrent + have hcurrentProduct : + currentScale * (nextScale + (width + 1)) ≤ + currentScale * currentScale := + Nat.mul_le_mul_left currentScale hdrop + have hquadratic : volume * (width + 1) + nextScale ^ 2 ≤ + currentScale ^ 2 := by + nlinarith + have hiteration' : + denseProgramLoopIterationTime tapes program input snapshot ≤ + fixed * volume * (width + 1) := by + simpa only [fixed, volume, width] using hiteration + have htail' : denseProgramLoopTime tapes program input fuel next ≤ + fixed * nextScale ^ 2 := by + simpa only [denseProgramLoopEnvelope, fixed, nextScale] using htail + rw [denseProgramLoopTime] + unfold denseProgramLoopEnvelope + dsimp only [next, fixed, currentScale] at hiteration' htail' ⊢ + calc + denseProgramLoopIterationTime tapes program input snapshot + + denseProgramLoopTime tapes program input fuel + (snapshot.step program input) ≤ + (2000000000 * (programResourceMagnitude program + 1) ^ 2) * + volume * (width + 1) + + (2000000000 * (programResourceMagnitude program + 1) ^ 2) * + nextScale ^ 2 := Nat.add_le_add hiteration' htail' + _ = (2000000000 * (programResourceMagnitude program + 1) ^ 2) * + (volume * (width + 1) + nextScale ^ 2) := by ring + _ ≤ (2000000000 * (programResourceMagnitude program + 1) ^ 2) * + currentScale ^ 2 := + Nat.mul_le_mul_left _ hquadratic + +private theorem denseInitialLengthLoopTime_le + (address : ℕ) (input : List Bool) (bound : ℕ) + (haddress : address + input.length ≤ bound) : + denseInitialLengthLoopTime address input ≤ + (input.length + 1) * (2 * bound + 5) := by + induction input generalizing address with + | nil => + simp [denseInitialLengthLoopTime] + | cons bit rest ih => + have haddressLe : address ≤ bound := by + simp only [List.length_cons] at haddress + omega + have hsuccRaw := TM.binarySuccTime_le address + have hsucc : TM.binarySuccTime address ≤ 2 * bound + 2 := by + exact le_trans hsuccRaw (by + have hsize := le_trans (size_le_self address) haddressLe + omega) + have htail := ih (address + 1) (by + simp only [List.length_cons] at haddress + omega) + simp only [denseInitialLengthLoopTime, List.length_cons] + rw [Nat.succ_add, Nat.succ_mul] + omega + +private theorem denseEntriesEncode_length_le (store : Store) (bound : ℕ) + (hentries : ∀ entry ∈ store, + entry.1.bits.length ≤ bound ∧ entry.2.bits.length ≤ bound) : + (store.flatMap Entry.encode).length ≤ + store.length * (4 * bound + 2) := by + induction store with + | nil => simp + | cons entry rest ih => + have hentry := hentries entry (by simp) + have hrest : ∀ current ∈ rest, + current.1.bits.length ≤ bound ∧ + current.2.bits.length ≤ bound := by + intro current hcurrent + exact hentries current (by simp [hcurrent]) + have htail := ih hrest + have hhead : (Entry.encode entry).length ≤ 4 * bound + 2 := by + rw [Entry.encode_length] + simpa [bitlen, Nat.size_eq_bits_len] using + (show 2 * entry.1.bits.length + 2 * entry.2.bits.length + 2 ≤ + 4 * bound + 2 by omega) + simp only [List.flatMap_cons, List.length_append, List.length_cons] + rw [Nat.succ_mul] + omega + +private theorem denseInitialCleanupBits_le {m : ℕ} + (tapes : ControlInstructionTapes m) (length bound : ℕ) + (hlength : length.bits.length ≤ bound) (hbound : 1 ≤ bound) + (i : Fin (m + 1)) : + (initialCleanupBits tapes length i).length ≤ bound := by + unfold initialCleanupBits + split + · exact hlength + · split + · simpa using hbound + · simp + +private theorem denseInitialAbiInstallTime_le {m : ℕ} + (tapes : ControlInstructionTapes m) (store : Store) + (length bound : ℕ) (hbound : 1 ≤ bound) + (hstoreLength : store.length ≤ bound) + (hentries : ∀ entry ∈ store, + entry.1.bits.length ≤ bound ∧ entry.2.bits.length ≤ bound) + (hlength : length.bits.length ≤ bound) : + initialAbiInstallTime tapes store length ≤ 100 * (bound + 1) ^ 2 := by + let encoded := store.flatMap Entry.encode + have hencodedBase := denseEntriesEncode_length_le store bound hentries + have hencoded : encoded.length ≤ 6 * (bound + 1) ^ 2 := by + dsimp only [encoded] + have hfactor : 4 * bound + 2 ≤ 6 * (bound + 1) := by omega + have hproduct := Nat.mul_le_mul hstoreLength hfactor + exact le_trans hencodedBase (by nlinarith) + have hcopyRaw := TM.binaryCopyTime_le store.length 0 + have hcopy : TM.binaryCopyTime store.length 0 ≤ 3 * bound + 20 := by + apply le_trans hcopyRaw + simp only [Nat.size_zero, Nat.mul_zero] + have hsize := le_trans (size_le_self store.length) hstoreLength + omega + have hresetEncoded : TM.resetBinaryWorkTime (encoded.length + 1) + encoded.length ≤ 3 * (6 * (bound + 1) ^ 2) + 9 := by + unfold TM.resetBinaryWorkTime TM.clearWorkTimeBound + omega + have hresetMany := TM.resetBinaryWorkManyTime_le + (initialCleanupTargets tapes) (initialCleanupBits tapes length) + (fun _ => 1) 1 bound (fun _ _ => le_rfl) + (fun i _ => denseInitialCleanupBits_le tapes length bound hlength hbound i) + have htargets : (initialCleanupTargets tapes).length = 2 := by + simp [initialCleanupTargets] + rw [htargets] at hresetMany + unfold initialAbiInstallTime + dsimp only [encoded] at hencoded hresetEncoded ⊢ + have hboundSq : bound ≤ (bound + 1) ^ 2 := by nlinarith + have honeSq : 1 ≤ (bound + 1) ^ 2 := by nlinarith + nlinarith + +private theorem denseRewindEntryEncodeRestoreTime_bound + (entry : Entry) (bound : ℕ) + (hbound : 1 ≤ bound) (haddress : entry.1.bits.length ≤ bound) + (hvalue : entry.2.bits.length ≤ bound) : + rewindEntryEncodeRestoreTime entry ≤ 30 * (bound + 1) := by + unfold rewindEntryEncodeRestoreTime rewindEntryEncodeTime + rewindWordEncodeTime wordEncodeTime + have haddressSize : entry.1.size = entry.1.bits.length := + (Nat.size_eq_bits_len entry.1).symm + have hvalueSize : entry.2.size = entry.2.bits.length := + (Nat.size_eq_bits_len entry.2).symm + omega + +private theorem denseProgramInitTime_le_quadratic {m : ℕ} + (tapes : ControlInstructionTapes m) (input : List Bool) : + denseProgramInitTime tapes input ≤ 1000 * (input.length + 3) ^ 2 := by + let bound := input.length + 2 + have hbound : 1 ≤ bound := by simp [bound] + have hloop := denseInitialLengthLoopTime_le 1 input (input.length + 1) + (by omega) + have htagBits : (input.length + 1).bits.length ≤ bound := by + simpa only [Nat.size_eq_bits_len] using + (le_trans (size_le_self (input.length + 1)) (by + dsimp only [bound] + omega)) + have hrewind := denseRewindEntryEncodeRestoreTime_bound + (0, input.length + 1) bound hbound (by simp) htagBits + have hstoreLength : (denseProgramInitialStore input).length ≤ bound := by + simp [denseProgramInitialStore, DenseOverlay.Snapshot.initial, + DenseOverlay.write, RegisterStore.write, bound] + have hentries : ∀ entry ∈ denseProgramInitialStore input, + entry.1.bits.length ≤ bound ∧ entry.2.bits.length ≤ bound := by + intro entry hentry + simp [denseProgramInitialStore, DenseOverlay.Snapshot.initial, + DenseOverlay.write, RegisterStore.write] at hentry + subst entry + exact ⟨by simp, htagBits⟩ + have habi := denseInitialAbiInstallTime_le tapes + (denseProgramInitialStore input) (input.length + 1) bound hbound + hstoreLength hentries htagBits + have hsuccZero := TM.binarySuccTime_le 0 + have hsuccZero' : TM.binarySuccTime 0 ≤ 2 := by + simpa using hsuccZero + unfold denseProgramInitTime + dsimp only [bound] at hrewind habi htagBits hbound ⊢ + nlinarith + +private theorem denseProgramOutputTime_le_encoded {m : ℕ} + (tapes : ControlInstructionTapes m) (input : List Bool) + (overlay : Store) (hvalid : DenseOverlay.Valid overlay) : + denseProgramOutputTime tapes input overlay ≤ + 2000000 * (encodedStoreLength overlay + input.length + 1) := by + have hlookup := denseOverlayLookupStaticTime_le_product + tapes.lifted.data.lhsLookup input.length overlay 0 0 0 hvalid + (by simp [bitlen]) (by simp) + unfold denseProgramOutputTime + nlinarith + +private theorem denseRunScale_initial_succ_le + (program : Program) (input : List Bool) (fuel : ℕ) + (hhalted : RAM.Halted program + (RAM.run program fuel (RAM.initCfg input))) + (hfuel : fuel ≤ + RAM.logTimeUpto program fuel (RAM.initCfg input)) : + denseRunScale program input (fuel + 1) + (DenseOverlay.Snapshot.initial input) ≤ + 10 * (programResourceMagnitude program + 1) * + (input.length + + RAM.logTimeUpto program fuel (RAM.initCfg input) + 1) := by + let initial := DenseOverlay.Snapshot.initial input + let cost := RAM.logTimeUpto program fuel (RAM.initCfg input) + let magnitude := programResourceMagnitude program + have hdecode : initial.decode input = RAM.initCfg input := by + simpa only [initial] using DenseOverlay.Snapshot.initial_decode input + have hhaltedInitial : RAM.Halted program + (RAM.run program fuel (initial.decode input)) := by + rw [hdecode] + exact hhalted + have hcostSucc : + RAM.logTimeUpto program (fuel + 1) (initial.decode input) = cost := by + have hsame := RAM.logTimeUpto_eq_of_halted_le program + (Nat.le_succ fuel) hhaltedInitial + calc + RAM.logTimeUpto program (fuel + 1) (initial.decode input) = + RAM.logTimeUpto program fuel (initial.decode input) := by + simpa only [Nat.succ_eq_add_one] using hsame + _ = cost := by rw [hdecode] + have hunit := RAM.unitTimeUpto_le_logTimeUpto program (fuel + 1) + (initial.decode input) + rw [hcostSucc] at hunit + have hstatic := programStaticWidth_le_resourceMagnitude program + have hmagnitude : 1 ≤ magnitude := by + simpa only [magnitude] using programResourceMagnitude_pos program + have hencodedRaw := DenseOverlay.Snapshot.initial_encodedStoreLength_run_le + program input 0 + have hencoded : encodedStoreLength initial.overlay ≤ + 2 * bitlen (input.length + 1) + 2 := by + simpa only [initial, DenseOverlay.Snapshot.run, + RAM.unitTimeUpto_zero, RAM.logTimeUpto_zero, Nat.zero_mul, + Nat.zero_add, Nat.mul_zero, Nat.add_zero] using hencodedRaw + have hbitlen : bitlen (input.length + 1) ≤ input.length + 1 := + size_le_self (input.length + 1) + have htime : fuel + 1 + + RAM.unitTimeUpto program (fuel + 1) (initial.decode input) ≤ + 2 * cost + 1 := by + dsimp only [cost] at hfuel ⊢ + omega + have hstatic' : programStaticWidth program + 1 ≤ magnitude + 1 := by + dsimp only [magnitude] + omega + have hproduct := Nat.mul_le_mul hstatic' htime + unfold denseRunScale + dsimp only [initial, cost, magnitude] at hcostSucc hencoded hbitlen hmagnitude hproduct ⊢ + rw [hcostSucc] + nlinarith + +private theorem denseFinalEncodedStoreLength_le + (program : Program) (input : List Bool) (fuel : ℕ) : + encodedStoreLength + ((DenseOverlay.Snapshot.initial input).run program input fuel).overlay ≤ + 6 * (programResourceMagnitude program + 1) * + (input.length + + RAM.logTimeUpto program fuel (RAM.initCfg input) + 1) := by + let cost := RAM.logTimeUpto program fuel (RAM.initCfg input) + let magnitude := programResourceMagnitude program + have hencoded := DenseOverlay.Snapshot.initial_encodedStoreLength_run_le + program input fuel + have hunit := RAM.unitTimeUpto_le_logTimeUpto program fuel + (RAM.initCfg input) + have hstatic := programStaticWidth_le_resourceMagnitude program + have hbitlen : bitlen (input.length + 1) ≤ input.length + 1 := + size_le_self (input.length + 1) + have hproduct : + RAM.unitTimeUpto program fuel (RAM.initCfg input) * + (programStaticWidth program + 1) ≤ + cost * (magnitude + 1) := by + exact Nat.mul_le_mul hunit (by + dsimp only [magnitude] + omega) + dsimp only [cost, magnitude] at hproduct ⊢ + nlinarith +theorem denseProgramDecisionTime_le_envelope_internal {m : ℕ} + (tapes : ControlInstructionTapes m) (program : Program) + (input : List Bool) (fuel : ℕ) + (hhalted : RAM.Halted program + (RAM.run program fuel (RAM.initCfg input))) + (hfuel : fuel ≤ + RAM.logTimeUpto program fuel (RAM.initCfg input)) : + denseProgramDecisionTime tapes program input fuel ≤ + denseProgramDecisionEnvelope program input.length + (RAM.logTimeUpto program fuel (RAM.initCfg input)) := by + let initial := DenseOverlay.Snapshot.initial input + let final := initial.run program input fuel + let cost := RAM.logTimeUpto program fuel (RAM.initCfg input) + let magnitude := programResourceMagnitude program + let scale := input.length + cost + 1 + let fixed := (magnitude + 1) ^ 4 * scale ^ 2 + have hmagnitude : 1 ≤ magnitude := by + simpa only [magnitude] using programResourceMagnitude_pos program + have hscale : 1 ≤ scale := by + dsimp only [scale] + omega + have hinitialValid : DenseOverlay.Valid initial.overlay := by + simpa only [initial] using DenseOverlay.Snapshot.initial_valid input + have hinitialPc : initial.pc ≤ magnitude := by + dsimp only [initial, DenseOverlay.Snapshot.initial, magnitude] + omega + have hloopRaw := denseProgramLoopTime_le_envelope_internal tapes program + input (fuel + 1) initial hinitialValid hinitialPc + have hrunScale := denseRunScale_initial_succ_le program input fuel + hhalted hfuel + have hloop : denseProgramLoopTime tapes program input (fuel + 1) initial ≤ + 200000000000 * fixed := by + apply le_trans hloopRaw + unfold denseProgramLoopEnvelope + have hsquare := Nat.pow_le_pow_left hrunScale 2 + dsimp only [initial, cost, magnitude, scale, fixed] at hsquare ⊢ + nlinarith + have hinitRaw := denseProgramInitTime_le_quadratic tapes input + have hinit : denseProgramInitTime tapes input ≤ 9000 * fixed := by + apply le_trans hinitRaw + have hlength : input.length + 3 ≤ 3 * scale := by + dsimp only [scale] + omega + have hsquare := Nat.pow_le_pow_left hlength 2 + have hfixedOne : scale ^ 2 ≤ fixed := by + dsimp only [fixed] + have honePos : 0 < (magnitude + 1) ^ 4 := by positivity + have hone : 1 ≤ (magnitude + 1) ^ 4 := by omega + calc + scale ^ 2 = 1 * scale ^ 2 := by simp + _ ≤ (magnitude + 1) ^ 4 * scale ^ 2 := + Nat.mul_le_mul_right _ hone + nlinarith + have hfinalValid : DenseOverlay.Valid final.overlay := by + dsimp only [final, initial] + exact DenseOverlay.Snapshot.run_valid program input fuel + (DenseOverlay.Snapshot.initial input) + (DenseOverlay.Snapshot.initial_valid input) + have houtputRaw := denseProgramOutputTime_le_encoded tapes input + final.overlay hfinalValid + have hfinalEncoded := denseFinalEncodedStoreLength_le program input fuel + have houtput : denseProgramOutputTime tapes input final.overlay ≤ + 20000000 * fixed := by + apply le_trans houtputRaw + have hvolume : encodedStoreLength final.overlay + input.length + 1 ≤ + 7 * (magnitude + 1) * scale := by + dsimp only [final, initial, cost, magnitude, scale] at hfinalEncoded ⊢ + nlinarith + have hlinearFixed : (magnitude + 1) * scale ≤ fixed := by + dsimp only [fixed] + have hmagnitudePow : magnitude + 1 ≤ (magnitude + 1) ^ 4 := by + exact Nat.le_self_pow (by decide : (4 : ℕ) ≠ 0) (magnitude + 1) + have hscaleSq : scale ≤ scale ^ 2 := by + exact Nat.le_self_pow (by decide : (2 : ℕ) ≠ 0) scale + exact Nat.mul_le_mul hmagnitudePow hscaleSq + nlinarith + unfold denseProgramDecisionTime denseProgramDecisionEnvelope + dsimp only [initial, final, cost, magnitude, scale, fixed] at hloop hinit houtput ⊢ + have hfixedPos : 1 ≤ + (programResourceMagnitude program + 1) ^ 4 * + (input.length + + RAM.logTimeUpto program fuel (RAM.initCfg input) + 1) ^ 2 := by + have hpos : 0 < + (programResourceMagnitude program + 1) ^ 4 * + (input.length + + RAM.logTimeUpto program fuel (RAM.initCfg input) + 1) ^ 2 := by + positivity + omega + nlinarith +end Machine +end RegisterStore +end RAM +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseDecision.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseDecision.lean new file mode 100644 index 0000000000..10d6c44488 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseDecision.lean @@ -0,0 +1,64 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import +LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.DenseDecisionDefs +public import +LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.DenseDecisionProof + +/-! +# Complete dense-overlay RAM decision machine +-/ + + +public section + +namespace Complexity +namespace RAM +namespace RegisterStore +namespace Machine + +/-- The complete dense machine realizes one halted overlay run and emits its +decoded `R₀` verdict. -/ +theorem denseProgramDecisionTM_hoareTime_run {n : ℕ} + (tapes : ControlInstructionTapes n) (program : Program) + (input : List Bool) (fuel : ℕ) + (hhalted : ((DenseOverlay.Snapshot.initial input).run program input fuel).Halted + program) : + (denseProgramDecisionTM tapes program).HoareTime + (fun inp work out => + inp = Tape.init (input.map Γ.ofBool) ∧ + work = (fun _ => Tape.init []) ∧ out = Tape.init []) + (fun _inp _work out => + let final := (DenseOverlay.Snapshot.initial input).run program input fuel + out = registerVerdictOutput + (DenseOverlay.read input final.overlay 0)) + (denseProgramDecisionTime tapes program input fuel) := + denseProgramDecisionTM_hoareTime_run_internal tapes program input fuel hhalted + +/-- The fixed dense machine realizes a halted executable RAM run and emits its +public `R₀` verdict. -/ +theorem denseProgramDecisionTM_hoareTime_ramRun {n : ℕ} + (tapes : ControlInstructionTapes n) (program : Program) + (input : List Bool) (fuel : ℕ) + (hhalted : RAM.Halted program + (RAM.run program fuel (RAM.initCfg input))) : + (denseProgramDecisionTM tapes program).HoareTime + (fun inp work out => + inp = Tape.init (input.map Γ.ofBool) ∧ + work = (fun _ => Tape.init []) ∧ out = Tape.init []) + (fun _inp _work out => + out = registerVerdictOutput + (RAM.run program fuel (RAM.initCfg input)).verdict) + (denseProgramDecisionTime tapes program input fuel) := + denseProgramDecisionTM_hoareTime_ramRun_internal tapes program input fuel + hhalted + +end Machine +end RegisterStore +end RAM +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseDecisionDefs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseDecisionDefs.lean new file mode 100644 index 0000000000..87dbcc30ed --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseDecisionDefs.lean @@ -0,0 +1,46 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.DenseDefs +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.DenseInitDefs + +/-! +# Complete dense-overlay RAM decision machine -- definitions +-/ + + +@[expose] public section + +namespace Complexity +namespace RAM +namespace RegisterStore +namespace Machine + +/-- Initialize the immutable public-input bank and one-entry overlay, execute +one fixed program through its first halt, and extract decoded `R₀`. -/ +def denseProgramDecisionTM {n : ℕ} (tapes : ControlInstructionTapes n) + (program : Program) : TM (n + 1) := + TM.seqTM (denseProgramInitTM tapes) + (TM.seqTM (denseProgramLoopTM tapes program) + (denseProgramOutputTM tapes)) + +/-- Exact compositional bound for one fuel-certified dense RAM decision run. -/ +noncomputable def denseProgramDecisionTime {n : ℕ} + (tapes : ControlInstructionTapes n) (program : Program) + (input : List Bool) (fuel : ℕ) : ℕ := + let initial := DenseOverlay.Snapshot.initial input + let final := initial.run program input fuel + denseProgramInitTime tapes input + 1 + + (denseProgramLoopTime tapes program input (fuel + 1) initial + 1 + + denseProgramOutputTime tapes input final.overlay) + +end Machine +end RegisterStore +end RAM +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseDecisionProof.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseDecisionProof.lean new file mode 100644 index 0000000000..1259ffbab7 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseDecisionProof.lean @@ -0,0 +1,207 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import +LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.DenseDecisionDefs +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.DenseInitProof +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.DenseInternal + +/-! +# Complete dense-overlay RAM decision-machine proof internals +-/ + + +public section + +namespace Complexity +namespace RAM +namespace RegisterStore +namespace Machine + +variable {n : ℕ} + +/-- The complete dense machine realizes one halted overlay run and emits its +decoded `R₀` verdict. -/ +theorem denseProgramDecisionTM_hoareTime_run_internal + (tapes : ControlInstructionTapes n) (program : Program) + (input : List Bool) (fuel : ℕ) + (hhalted : ((DenseOverlay.Snapshot.initial input).run program input fuel).Halted + program) : + (denseProgramDecisionTM tapes program).HoareTime + (fun inp work out => + inp = Tape.init (input.map Γ.ofBool) ∧ + work = (fun _ => Tape.init []) ∧ out = Tape.init []) + (fun _inp _work out => + let final := (DenseOverlay.Snapshot.initial input).run program input fuel + out = registerVerdictOutput + (DenseOverlay.read input final.overlay 0)) + (denseProgramDecisionTime tapes program input fuel) := by + intro inp work out hpre + rcases hpre with ⟨hinp, hwork, hout⟩ + subst inp + subst work + subst out + let initial := DenseOverlay.Snapshot.initial input + let final := initial.run program input fuel + have hinit := denseProgramInitTM_hoareTime_internal tapes input + obtain ⟨initDone, initTime, hinitTime, hinitReach, hinitHalt, + hinitInput, hinitWork, hinitOutput⟩ := + hinit _ _ _ ⟨rfl, rfl, rfl⟩ + have hinitialValid : DenseOverlay.Valid initial.overlay := by + simpa only [initial] using DenseOverlay.Snapshot.initial_valid input + let sparseInitial : Snapshot := + { pc := initial.pc, store := initial.overlay } + have hready : InstructionExecutionReady tapes initial.overlay initial.pc + initDone.work := by + rw [hinitWork] + simpa only [denseProgramSnapshotWork, sparseInitial] using + programSnapshotWork_ready_internal tapes sparseInitial hinitialValid.1 + have hinitInputParked : TM.Parked initDone.input := by + rw [hinitInput] + refine ⟨by simp [Tape.move], ?_⟩ + simpa using Tape.init_ofBool_move_right_cells_ne_start input + have hloop := denseProgramLoopTM_hoareTime_run_internal tapes program input + fuel initial initDone.work hinitialValid hready hhalted + obtain ⟨loopDone, loopTime, hloopTime, hloopReach, hloopHalt, + hloopInput, hloopReady, hloopOutput⟩ := + hloop _ _ _ ⟨rfl, rfl, by simpa [TM.resetBinaryBlank] using hinitOutput⟩ + have hloopInputParked : TM.Parked loopDone.input := by + rw [hloopInput] + rw [← hinitInput] + exact hinitInputParked + have hloopOutputHalt : loopDone.output = instructionHaltOutput .halt := by + change loopDone.output = instructionHaltOutput (final.curInstr program) + at hloopOutput + rw [show final.curInstr program = .halt from hhalted] at hloopOutput + exact hloopOutput + have hfinalValid : DenseOverlay.Valid final.overlay := by + simpa only [final, initial] using DenseOverlay.Snapshot.run_valid + program input fuel (DenseOverlay.Snapshot.initial input) + (DenseOverlay.Snapshot.initial_valid input) + have houtputRun := denseProgramOutputTM_hoareTime_haltOutput_internal tapes + input final.overlay final.pc loopDone.work hfinalValid hloopReady + obtain ⟨outputDone, outputTime, houtputTime, houtputReach, + houtputHalt, houtputInput, houtputVerdict⟩ := + houtputRun _ _ _ ⟨hloopInput, rfl, hloopOutputHalt⟩ + have hloopOutputParked : TM.Parked loopDone.output := by + rw [hloopOutputHalt] + refine ⟨?_, instructionHaltOutput_cells_ne_start_internal .halt⟩ + rw [instructionHaltOutput_head_internal] + have houtputReach' : (denseProgramOutputTM tapes).reachesIn outputTime + { state := (denseProgramOutputTM tapes).qstart + input := TM.transitionInput loopDone.input + work := fun i => TM.transitionTape (loopDone.work i) + output := TM.transitionTape loopDone.output } + outputDone := by + obtain ⟨hi, hw, ho⟩ := TM.phaseTransition_eq_self_of_reads_ne_start + hloopInputParked.read_ne_start + (fun i => (hloopReady.control.lookup.scanner.parked i).read_ne_start) + hloopOutputParked.read_ne_start + simpa only [hi, hw, ho] using houtputReach + have htailReach := TM.seqTM_reachesIn_of_reachesIn + (denseProgramLoopTM tapes program) (denseProgramOutputTM tapes) + hloopReach hloopHalt houtputReach' + let tailDone := TM.phase2Wrap (denseProgramLoopTM tapes program) + (denseProgramOutputTM tapes) outputDone + have htailHalt : + (TM.seqTM (denseProgramLoopTM tapes program) + (denseProgramOutputTM tapes)).halted tailDone := by + rw [TM.phase2Wrap_halted_iff] + exact houtputHalt + have hinitWorkParked : ∀ i, TM.Parked (initDone.work i) := by + exact hready.control.lookup.scanner.parked + have hinitOutputParked : TM.Parked initDone.output := by + rw [hinitOutput] + have hblankNat : TM.resetBinaryBlank.HasBinaryNat 0 := by + simpa [TM.resetBinaryBlank] using Tape.init_move_right_hasBinaryNat 0 + exact ⟨by rw [hblankNat.2.1], + hblankNat.2.hasBinaryContent.cells_ne_start⟩ + have htailReach' : + (TM.seqTM (denseProgramLoopTM tapes program) + (denseProgramOutputTM tapes)).reachesIn + (loopTime + 1 + outputTime) + { state := (TM.seqTM (denseProgramLoopTM tapes program) + (denseProgramOutputTM tapes)).qstart + input := TM.transitionInput initDone.input + work := fun i => TM.transitionTape (initDone.work i) + output := TM.transitionTape initDone.output } + tailDone := by + obtain ⟨hi, hw, ho⟩ := TM.phaseTransition_eq_self_of_reads_ne_start + hinitInputParked.read_ne_start + (fun i => (hinitWorkParked i).read_ne_start) + hinitOutputParked.read_ne_start + rw [hi, hw, ho] + simpa only [hinitInput] using htailReach + have hreach := TM.seqTM_reachesIn_of_reachesIn + (denseProgramInitTM tapes) + (TM.seqTM (denseProgramLoopTM tapes program) + (denseProgramOutputTM tapes)) + hinitReach hinitHalt htailReach' + let done := TM.phase2Wrap (denseProgramInitTM tapes) + (TM.seqTM (denseProgramLoopTM tapes program) + (denseProgramOutputTM tapes)) tailDone + refine ⟨done, initTime + 1 + (loopTime + 1 + outputTime), + ?_, hreach, ?_, ?_⟩ + · unfold denseProgramDecisionTime + dsimp only [initial, final] at hloopTime houtputTime ⊢ + omega + · change (denseProgramDecisionTM tapes program).halted done + unfold denseProgramDecisionTM + rw [TM.phase2Wrap_halted_iff] + exact htailHalt + · change outputDone.output = registerVerdictOutput + (DenseOverlay.read input final.overlay 0) + exact houtputVerdict + +/-- The complete dense machine realizes a halted executable RAM run, with its +verdict rewritten through the overlay decoding theorem. -/ +theorem denseProgramDecisionTM_hoareTime_ramRun_internal + (tapes : ControlInstructionTapes n) (program : Program) + (input : List Bool) (fuel : ℕ) + (hhalted : RAM.Halted program + (RAM.run program fuel (RAM.initCfg input))) : + (denseProgramDecisionTM tapes program).HoareTime + (fun inp work out => + inp = Tape.init (input.map Γ.ofBool) ∧ + work = (fun _ => Tape.init []) ∧ out = Tape.init []) + (fun _inp _work out => + out = registerVerdictOutput + (RAM.run program fuel (RAM.initCfg input)).verdict) + (denseProgramDecisionTime tapes program input fuel) := by + let initial := DenseOverlay.Snapshot.initial input + let final := initial.run program input fuel + have hdecode : final.decode input = + RAM.run program fuel (RAM.initCfg input) := by + rw [show RAM.initCfg input = initial.decode input by + simpa only [initial] using (DenseOverlay.Snapshot.initial_decode input).symm] + simpa only [final] using DenseOverlay.Snapshot.decode_run + program input fuel initial (by + simpa only [initial] using DenseOverlay.Snapshot.initial_canonical input) + have hfinalHalted : final.Halted program := by + change RAM.Halted program (final.decode input) + rw [hdecode] + exact hhalted + have hrun := denseProgramDecisionTM_hoareTime_run_internal tapes program + input fuel hfinalHalted + apply hrun.consequence + · exact fun _ _ _ h => h + · intro inp work out hpost + change out = registerVerdictOutput + (DenseOverlay.read input final.overlay 0) at hpost + rw [hpost] + congr 1 + change (final.decode input).regs 0 = + (RAM.run program fuel (RAM.initCfg input)).regs 0 + rw [hdecode] + · exact le_rfl + +end Machine +end RegisterStore +end RAM +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseDefs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseDefs.lean new file mode 100644 index 0000000000..14297b119d --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseDefs.lean @@ -0,0 +1,69 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Defs +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.DenseSimDefs +public import Mathlib.Data.Rat.Cast.Order +public import Mathlib.Tactic.NormNum.Abs +public import Mathlib.Tactic.NormNum.DivMod +public import Mathlib.Tactic.NormNum.OfScientific + +/-! +# Dense-overlay RAM program controller -- definitions +-/ + + +@[expose] public section + +namespace Complexity +namespace RAM +namespace RegisterStore +namespace Machine + +/-- Recover dense register `R₀` through the overlay-aware lookup and emit its +Boolean verdict on the real output tape. -/ +def denseProgramOutputTM {n : ℕ} (tapes : ControlInstructionTapes n) : + TM (n + 1) := + TM.seqTM (denseOverlayLookupStaticTM tapes.lifted.data.lhsLookup 0) + (registerVerdictTM tapes.liftedLhs) + +/-- Exact dense final-verdict extraction bound. -/ +def denseProgramOutputTime {n : ℕ} (tapes : ControlInstructionTapes n) + (input : List Bool) (overlay : Store) : ℕ := + denseOverlayLookupStaticTime tapes.lifted.data.lhsLookup input.length + overlay 0 + 1 + 1 + +/-- Fixed halt-aware loop for one concrete RAM program using dense overlay +steps and the representation-independent halt test. -/ +def denseProgramLoopTM {n : ℕ} (tapes : ControlInstructionTapes n) + (program : Program) : TM (n + 1) := + TM.loopTM (denseProgramStepTM tapes program) (programHaltTM tapes program) + +/-- Bound for one dense loop body, halt test, their seams, and the three-step +rewind/check tail. -/ +noncomputable def denseProgramLoopIterationTime {n : ℕ} + (tapes : ControlInstructionTapes n) (program : Program) + (input : List Bool) (snapshot : DenseOverlay.Snapshot) : ℕ := + let next := snapshot.step program input + denseProgramStepTime tapes program input snapshot.pc snapshot.overlay + 1 + + programHaltTime tapes program next.pc + 1 + 3 + +/-- Sum of the first `fuel` dense loop-iteration bounds. -/ +noncomputable def denseProgramLoopTime {n : ℕ} + (tapes : ControlInstructionTapes n) (program : Program) + (input : List Bool) : ℕ → DenseOverlay.Snapshot → ℕ + | 0, _ => 0 + | fuel + 1, snapshot => + denseProgramLoopIterationTime tapes program input snapshot + + denseProgramLoopTime tapes program input fuel + (snapshot.step program input) + +end Machine +end RegisterStore +end RAM +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseInit.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseInit.lean new file mode 100644 index 0000000000..d023128c83 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseInit.lean @@ -0,0 +1,48 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.DenseInitDefs +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.DenseInitProof + +/-! +# Dense-overlay public-input initialization + +The optimized initializer retains the public bits on the immutable input tape, +materializes only the positive-tagged length register, installs the reusable +program ABI, and rewinds the input for dense fallback reads. +-/ + + +public section + +namespace Complexity +namespace RAM +namespace RegisterStore +namespace Machine + +/-- Complete dense public-input initialization reaches the exact one-entry +snapshot image with the immutable input bank parked at cell one. -/ +theorem denseProgramInitTM_hoareTime {n : ℕ} + (tapes : ControlInstructionTapes n) (input : List Bool) : + (denseProgramInitTM tapes).HoareTime + (fun inp work out => + inp = Tape.init (input.map Γ.ofBool) ∧ + work = (fun _ => Tape.init []) ∧ out = Tape.init []) + (fun inp work out => + inp = (Tape.init (input.map Γ.ofBool)).move Dir3.right ∧ + work = denseProgramSnapshotWork tapes + (DenseOverlay.Snapshot.initial input) ∧ + out = TM.resetBinaryBlank) + (denseProgramInitTime tapes input) := + denseProgramInitTM_hoareTime_internal tapes input + +end Machine +end RegisterStore +end RAM +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseInitDefs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseInitDefs.lean new file mode 100644 index 0000000000..0ffbc02100 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseInitDefs.lean @@ -0,0 +1,119 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Init.Defs + +/-! +# Dense-overlay public-input initialization -- definitions + +The optimized initializer counts the immutable input in binary but emits only +the tagged `R₀` overlay entry. It then installs the ordinary sparse scanner ABI +and rewinds the real input for dense fallback reads. +-/ + + +@[expose] public section + +namespace Complexity +namespace RAM +namespace RegisterStore +namespace Machine + +/-- Phases of the input-length counter. -/ +inductive DenseInitialLengthPhase where + | scan + | done + deriving DecidableEq + +instance : Fintype DenseInitialLengthPhase where + elems := {.scan, .done} + complete := fun phase => by cases phase <;> simp + +/-- State space for input scanning with one binary-successor body. -/ +abbrev DenseInitialLengthQ {n : ℕ} (tapes : ControlInstructionTapes n) := + DenseInitialLengthPhase ⊕ (initialZeroBitTM tapes).Q + +/-- Count every input symbol into the existing initialization address tape. -/ +def denseInitialLengthLoopTM {n : ℕ} + (tapes : ControlInstructionTapes n) : TM (n + 1) where + Q := DenseInitialLengthQ tapes + qstart := .inl .scan + qhalt := .inl .done + δ := fun state iHead wHeads oHead => + match state with + | .inl .scan => + if iHead = Γ.blank then + TM.allReadBack (.inl .done) iHead wHeads oHead + else + TM.allReadBack (.inr (initialZeroBitTM tapes).qstart) + iHead wHeads oHead + | .inl .done => TM.allIdle (.inl .done) iHead wHeads oHead + | .inr state => + if state = (initialZeroBitTM tapes).qhalt then + (.inl .scan, fun i => TM.readBackWrite (wHeads i), + TM.readBackWrite oHead, Dir3.right, + fun i => TM.idleDir (wHeads i), TM.idleDir oHead) + else + let action := (initialZeroBitTM tapes).δ state iHead wHeads oHead + (.inr action.1, action.2.1, action.2.2.1, action.2.2.2.1, + action.2.2.2.2.1, action.2.2.2.2.2) + δ_right_of_start := by + intro state iHead wHeads oHead + match state with + | .inl .scan => + dsimp only + split <;> exact TM.rightOfStart_allReadBack iHead wHeads oHead + | .inl .done => exact TM.rightOfStart_allIdle iHead wHeads oHead + | .inr state => + dsimp only + split + · exact ⟨fun _ => rfl, fun _ => TM.idleDir_right_of_start, + TM.idleDir_right_of_start⟩ + · exact (initialZeroBitTM tapes).δ_right_of_start state + iHead wHeads oHead + +/-- Exact recursive time budget for binary input-length counting. -/ +def denseInitialLengthLoopTime : ℕ → List Bool → ℕ + | _, [] => 1 + | address, _ :: rest => + 1 + TM.binarySuccTime address + 1 + + denseInitialLengthLoopTime (address + 1) rest + +/-- The lone positive-tag overlay installed for the public input. -/ +def denseProgramInitialStore (input : List Bool) : Store := + (DenseOverlay.Snapshot.initial input).overlay + +/-- Exact clean work image of a dense-overlay snapshot. -/ +def denseProgramSnapshotWork {n : ℕ} (tapes : ControlInstructionTapes n) + (snapshot : DenseOverlay.Snapshot) : Fin (n + 1) → Tape := + programSnapshotWork tapes { pc := snapshot.pc, store := snapshot.overlay } + +/-- Count the input, emit its positive `R₀` tag, install the sparse ABI, and +rewind the immutable input bank to cell one. -/ +def denseProgramInitTM {n : ℕ} (tapes : ControlInstructionTapes n) : + TM (n + 1) := + TM.seqTM (initialSetupTM tapes) + (TM.seqTM (denseInitialLengthLoopTM tapes) + (TM.seqTM (initialLengthEmitTM tapes) + (TM.seqTM (initialAbiInstallTM tapes) TM.rewindInputTM))) + +/-- Exact compositional time budget for dense-overlay initialization. -/ +def denseProgramInitTime {n : ℕ} (tapes : ControlInstructionTapes n) + (input : List Bool) : ℕ := + (1 + 1 + (TM.binarySuccTime 0 + 1 + TM.binarySuccTime 0)) + 1 + + (denseInitialLengthLoopTime 1 input + 1 + + ((rewindEntryEncodeRestoreTime (0, input.length + 1) + 1 + + TM.binarySuccTime 0) + 1 + + (initialAbiInstallTime tapes (denseProgramInitialStore input) + (input.length + 1) + 1 + + (input.length + 1 + 2)))) + +end Machine +end RegisterStore +end RAM +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseInitProof.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseInitProof.lean new file mode 100644 index 0000000000..af7a54fce9 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseInitProof.lean @@ -0,0 +1,583 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.DenseInitDefs +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Init.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.DenseOverlay +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Internal + +/-! +# Dense-overlay public-input initialization -- proofs +-/ + + +public section + +namespace Complexity +namespace RAM +namespace RegisterStore +namespace Machine + +variable {n : ℕ} + +private theorem parked_of_binaryNat {t : Tape} {value : ℕ} + (h : t.HasBinaryNat value) : TM.Parked t := + ⟨by rw [h.2.1], h.2.hasBinaryContent.cells_ne_start⟩ + +private theorem parked_of_binarySuffix {t : Tape} {bits : List Bool} + (h : t.HasBinarySuffix bits) : TM.Parked t := + ⟨h.1, h.2.2.2⟩ + +private def denseInitialLengthWrap (tapes : ControlInstructionTapes n) + (c : Complexity.Cfg (n + 1) (initialZeroBitTM tapes).Q) : + Complexity.Cfg (n + 1) (denseInitialLengthLoopTM tapes).Q := + { state := .inr c.state + input := c.input + work := c.work + output := c.output } + +private theorem denseInitialLengthLoopTM_body_step + (tapes : ControlInstructionTapes n) + {c c' : Complexity.Cfg (n + 1) (initialZeroBitTM tapes).Q} + (hstep : (initialZeroBitTM tapes).step c = some c') : + (denseInitialLengthLoopTM tapes).step (denseInitialLengthWrap tapes c) = + some (denseInitialLengthWrap tapes c') := by + have hne : c.state ≠ (initialZeroBitTM tapes).qhalt := + TM.state_ne_qhalt_of_step hstep + rw [TM.step, + if_neg (by simp [denseInitialLengthWrap, denseInitialLengthLoopTM])] + simp only [denseInitialLengthWrap, denseInitialLengthLoopTM, hne, + ↓reduceIte] + rw [TM.step, if_neg hne] at hstep + revert hstep + generalize (initialZeroBitTM tapes).δ c.state c.input.read + (fun i => (c.work i).read) c.output.read = action + obtain ⟨state, workWrites, outputWrite, inputDir, workDirs, outputDir⟩ := + action + intro hstep + cases Option.some.inj hstep + rfl + +private theorem denseInitialLengthLoopTM_body_reachesIn + (tapes : ControlInstructionTapes n) + {time : ℕ} {c c' : Complexity.Cfg (n + 1) (initialZeroBitTM tapes).Q} + (hreach : (initialZeroBitTM tapes).reachesIn time c c') : + (denseInitialLengthLoopTM tapes).reachesIn time + (denseInitialLengthWrap tapes c) (denseInitialLengthWrap tapes c') := + TM.reachesIn_map (denseInitialLengthWrap tapes) + (fun _ _ => denseInitialLengthLoopTM_body_step tapes) hreach + +private theorem denseInitialLengthLoopTM_step_scan_data + (tapes : ControlInstructionTapes n) + (c : Complexity.Cfg (n + 1) (denseInitialLengthLoopTM tapes).Q) + (hstate : c.state = .inl .scan) (hblank : c.input.read ≠ Γ.blank) + (hstart : c.input.read ≠ Γ.start) + (hwork : ∀ i, (c.work i).read ≠ Γ.start) + (houtput : c.output.read ≠ Γ.start) : + (denseInitialLengthLoopTM tapes).step c = some + { state := .inr (initialZeroBitTM tapes).qstart + input := c.input + work := c.work + output := c.output } := by + rw [TM.step, + if_neg (by rw [hstate]; simp [denseInitialLengthLoopTM])] + simp only [denseInitialLengthLoopTM, hstate, hblank, TM.allReadBack, + ↓reduceIte] + refine congrArg some ((Complexity.Cfg.mk.injEq ..).mpr + ⟨rfl, ?_, ?_, ?_⟩) + · simp [TM.idleDir, hstart, Tape.move] + · funext i + rw [TM.writeAndMove_readBack _ (hwork i), TM.idleDir, + if_neg (hwork i)] + rfl + · rw [TM.writeAndMove_readBack _ houtput, TM.idleDir, if_neg houtput] + rfl + +private theorem denseInitialLengthLoopTM_step_scan_blank + (tapes : ControlInstructionTapes n) + (c : Complexity.Cfg (n + 1) (denseInitialLengthLoopTM tapes).Q) + (hstate : c.state = .inl .scan) (hblank : c.input.read = Γ.blank) + (hwork : ∀ i, (c.work i).read ≠ Γ.start) + (houtput : c.output.read ≠ Γ.start) : + (denseInitialLengthLoopTM tapes).step c = some + { state := .inl .done + input := c.input + work := c.work + output := c.output } := by + rw [TM.step, + if_neg (by rw [hstate]; simp [denseInitialLengthLoopTM])] + simp only [denseInitialLengthLoopTM, hstate, hblank, TM.allReadBack, + ↓reduceIte] + refine congrArg some ((Complexity.Cfg.mk.injEq ..).mpr + ⟨rfl, ?_, ?_, ?_⟩) + · simp [TM.idleDir, Tape.move] + · funext i + rw [TM.writeAndMove_readBack _ (hwork i), TM.idleDir, + if_neg (hwork i)] + rfl + · rw [TM.writeAndMove_readBack _ houtput, TM.idleDir, if_neg houtput] + rfl + +private theorem denseInitialLengthLoopTM_step_body_halt + (tapes : ControlInstructionTapes n) + (c : Complexity.Cfg (n + 1) (initialZeroBitTM tapes).Q) + (hhalt : (initialZeroBitTM tapes).halted c) + (hwork : ∀ i, (c.work i).read ≠ Γ.start) + (houtput : c.output.read ≠ Γ.start) : + (denseInitialLengthLoopTM tapes).step + (denseInitialLengthWrap tapes c) = some + { state := .inl .scan + input := c.input.move Dir3.right + work := c.work + output := c.output } := by + rw [TM.step, + if_neg (by simp [denseInitialLengthWrap, denseInitialLengthLoopTM])] + simp only [denseInitialLengthWrap, denseInitialLengthLoopTM, hhalt, + ↓reduceIte] + refine congrArg some ((Complexity.Cfg.mk.injEq ..).mpr + ⟨rfl, rfl, ?_, ?_⟩) + · funext i + rw [TM.writeAndMove_readBack _ (hwork i), TM.idleDir, + if_neg (hwork i)] + rfl + · rw [TM.writeAndMove_readBack _ houtput, TM.idleDir, if_neg houtput] + rfl + +theorem denseInitialLengthLoopTM_hoareTime_internal + (tapes : ControlInstructionTapes n) (input : List Bool) + (address count : ℕ) (entries : Store) + (inp₀ : Tape) (work₀ : Fin (n + 1) → Tape) (out₀ : Tape) + (hinput : inp₀.HasBinarySuffix input) + (hready : InitialLoopReady tapes address count entries work₀) + (houtput : out₀ = TM.resetBinaryBlank) : + (denseInitialLengthLoopTM tapes).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp.HasBinarySuffix [] ∧ + inp.head = inp₀.head + input.length ∧ + InitialLoopReady tapes (address + input.length) count entries work ∧ + out = out₀) + (denseInitialLengthLoopTime address input) := by + induction input generalizing address inp₀ work₀ out₀ with + | nil => + intro inp work out hpre + rcases hpre with ⟨hinp, hwork, hout⟩ + subst inp + subst work + subst out + let done : Complexity.Cfg (n + 1) (denseInitialLengthLoopTM tapes).Q := + { state := .inl .done + input := inp₀ + work := work₀ + output := out₀ } + have hstep := denseInitialLengthLoopTM_step_scan_blank tapes + ({ state := (denseInitialLengthLoopTM tapes).qstart + input := inp₀ + work := work₀ + output := out₀ } : + Complexity.Cfg (n + 1) (denseInitialLengthLoopTM tapes).Q) + rfl hinput.read_nil + (fun i => (hready.parked i).read_ne_start) + (by + rw [houtput] + have hblankNat : TM.resetBinaryBlank.HasBinaryNat 0 := by + simpa [TM.resetBinaryBlank] using Tape.init_move_right_hasBinaryNat 0 + exact (parked_of_binaryNat hblankNat).read_ne_start) + refine ⟨done, 1, by simp [denseInitialLengthLoopTime], + .step (by simpa [done] using hstep) .zero, ?_, ?_⟩ + · rfl + · exact ⟨hinput, rfl, by simpa, rfl⟩ + | cons bit rest ih => + intro inp work out hpre + rcases hpre with ⟨hinp, hwork, hout⟩ + subst inp + subst work + subst out + let scan : Complexity.Cfg (n + 1) (denseInitialLengthLoopTM tapes).Q := + { state := (denseInitialLengthLoopTM tapes).qstart + input := inp₀ + work := work₀ + output := out₀ } + let bodyStart : Complexity.Cfg (n + 1) (initialZeroBitTM tapes).Q := + { state := (initialZeroBitTM tapes).qstart + input := inp₀ + work := work₀ + output := out₀ } + have hinputParked : TM.Parked inp₀ := parked_of_binarySuffix hinput + have houtputParked : TM.Parked out₀ := by + rw [houtput] + have hblankNat : TM.resetBinaryBlank.HasBinaryNat 0 := by + simpa [TM.resetBinaryBlank] using Tape.init_move_right_hasBinaryNat 0 + exact parked_of_binaryNat hblankNat + have hreadNonblank : inp₀.read ≠ Γ.blank := by + rw [hinput.read_cons] + exact Γ.ofBool_ne_blank bit + have hreadNonstart : inp₀.read ≠ Γ.start := by + rw [hinput.read_cons] + exact Γ.ofBool_ne_start bit + have hscanStep := denseInitialLengthLoopTM_step_scan_data tapes scan + rfl hreadNonblank hreadNonstart + (fun i => (hready.parked i).read_ne_start) + houtputParked.read_ne_start + have hscanReach : (denseInitialLengthLoopTM tapes).reachesIn 1 scan + (denseInitialLengthWrap tapes bodyStart) := + .step (by simpa [scan, bodyStart, denseInitialLengthWrap] using + hscanStep) .zero + have hbody := initialZeroBitTM_hoareTime_internal tapes address count + entries inp₀ work₀ out₀ hready hinputParked houtputParked + obtain ⟨bodyDone, bodyTime, hbodyTime, hbodyReach, hbodyHalt, + hbodyInput, hbodyReady, hbodyOutput⟩ := + hbody inp₀ work₀ out₀ ⟨rfl, rfl, rfl⟩ + have hbodyLift := + denseInitialLengthLoopTM_body_reachesIn tapes hbodyReach + let nextScan : + Complexity.Cfg (n + 1) (denseInitialLengthLoopTM tapes).Q := + { state := .inl .scan + input := bodyDone.input.move Dir3.right + work := bodyDone.work + output := bodyDone.output } + have hseamStep := denseInitialLengthLoopTM_step_body_halt tapes bodyDone + hbodyHalt (fun i => (hbodyReady.parked i).read_ne_start) + (by rw [hbodyOutput]; exact houtputParked.read_ne_start) + have hseamReach : (denseInitialLengthLoopTM tapes).reachesIn 1 + (denseInitialLengthWrap tapes bodyDone) nextScan := + .step (by simpa [nextScan] using hseamStep) .zero + have hnextInput : + (bodyDone.input.move Dir3.right).HasBinarySuffix rest := by + rw [hbodyInput] + exact hinput.move_right_cons + have hnextOutput : bodyDone.output = TM.resetBinaryBlank := + hbodyOutput.trans houtput + have htail := ih (address + 1) (bodyDone.input.move Dir3.right) + bodyDone.work bodyDone.output hnextInput hbodyReady hnextOutput + obtain ⟨tailDone, tailTime, htailTime, htailReach, htailHalt, + htailInput, htailHead, htailReady, htailOutput⟩ := + htail _ _ _ ⟨rfl, rfl, rfl⟩ + have hreach := TM.reachesIn_trans (denseInitialLengthLoopTM tapes) + hscanReach (TM.reachesIn_trans (denseInitialLengthLoopTM tapes) + hbodyLift (TM.reachesIn_trans (denseInitialLengthLoopTM tapes) + hseamReach htailReach)) + refine ⟨tailDone, 1 + bodyTime + 1 + tailTime, ?_, ?_, + htailHalt, ?_⟩ + · simp only [denseInitialLengthLoopTime] + omega + · simpa [Nat.add_assoc] using hreach + · refine ⟨htailInput, ?_, ?_, htailOutput.trans hbodyOutput⟩ + · rw [htailHead, hbodyInput] + simp only [Tape.move, List.length_cons] + omega + · simpa [Nat.add_assoc, Nat.add_comm, Nat.add_left_comm] using htailReady + +private theorem denseProgramInitialStore_eq (input : List Bool) : + denseProgramInitialStore input = [(0, input.length + 1)] := by + simp [denseProgramInitialStore, DenseOverlay.Snapshot.initial, + DenseOverlay.write, RegisterStore.write] + +/-- Complete dense public-input initialization reaches the exact one-entry +snapshot image and rewinds the immutable input bank to cell one. -/ +theorem denseProgramInitTM_hoareTime_internal + (tapes : ControlInstructionTapes n) (input : List Bool) : + (denseProgramInitTM tapes).HoareTime + (fun inp work out => + inp = Tape.init (input.map Γ.ofBool) ∧ + work = (fun _ => Tape.init []) ∧ out = Tape.init []) + (fun inp work out => + inp = (Tape.init (input.map Γ.ofBool)).move Dir3.right ∧ + work = denseProgramSnapshotWork tapes + (DenseOverlay.Snapshot.initial input) ∧ + out = TM.resetBinaryBlank) + (denseProgramInitTime tapes input) := by + intro inp work out hpre + rcases hpre with ⟨hinp, hwork, hout⟩ + subst inp + subst work + subst out + have hsetup := initialSetupTM_hoareTime_internal tapes input + obtain ⟨setupDone, setupTime, hsetupTime, hsetupReach, hsetupHalt, + hsetupInput, hsetupInputEq, hsetupReady, hsetupOutput⟩ := + hsetup _ _ _ ⟨rfl, rfl, rfl⟩ + have hsetupBufferStart : + (setupDone.work tapes.buffer).cells 0 = Γ.start := by + apply TM.work_cells_zero_eq_start_of_reachesIn tapes.buffer hsetupReach + simp [Tape.init] + have hsetupInputParked : TM.Parked setupDone.input := + parked_of_binarySuffix hsetupInput + have hsetupOutputParked : TM.Parked setupDone.output := by + rw [hsetupOutput] + have hblankNat : TM.resetBinaryBlank.HasBinaryNat 0 := by + simpa [TM.resetBinaryBlank] using Tape.init_move_right_hasBinaryNat 0 + exact parked_of_binaryNat hblankNat + have hloop := denseInitialLengthLoopTM_hoareTime_internal tapes input + 1 0 [] setupDone.input setupDone.work setupDone.output hsetupInput + hsetupReady hsetupOutput + obtain ⟨loopDone, loopTime, hloopTime, hloopReach, hloopHalt, + hloopInput, hloopHead, hloopReadyRaw, hloopOutput⟩ := + hloop _ _ _ ⟨rfl, rfl, rfl⟩ + have hloopReady : InitialLoopReady tapes (input.length + 1) 0 [] + loopDone.work := by + simpa [Nat.add_comm] using hloopReadyRaw + have hloopBufferStart : + (loopDone.work tapes.buffer).cells 0 = Γ.start := + TM.work_cells_zero_eq_start_of_reachesIn tapes.buffer hloopReach + hsetupBufferStart + have hloopInputParked : TM.Parked loopDone.input := + parked_of_binarySuffix hloopInput + have hloopOutputBlank : loopDone.output = TM.resetBinaryBlank := + hloopOutput.trans hsetupOutput + have hloopOutputParked : TM.Parked loopDone.output := by + rw [hloopOutputBlank] + have hblankNat : TM.resetBinaryBlank.HasBinaryNat 0 := by + simpa [TM.resetBinaryBlank] using Tape.init_move_right_hasBinaryNat 0 + exact parked_of_binaryNat hblankNat + have hemit := initialLengthEmitTM_hoareTime_internal tapes + (input.length + 1) 0 [] loopDone.input loopDone.work loopDone.output + hloopReady hloopInputParked hloopOutputBlank + obtain ⟨emitDone, emitTime, hemitTime, hemitReach, hemitHalt, + hemitInput, hemitReadyRaw, hemitOutput⟩ := + hemit _ _ _ ⟨rfl, rfl, rfl⟩ + have hemitBufferStart : + (emitDone.work tapes.buffer).cells 0 = Γ.start := + TM.work_cells_zero_eq_start_of_reachesIn tapes.buffer hemitReach + hloopBufferStart + have hemitReady : InitialLoopReady tapes (input.length + 1) + (denseProgramInitialStore input).length + (denseProgramInitialStore input) emitDone.work := by + rw [denseProgramInitialStore_eq] + simpa using hemitReadyRaw + have hemitInputParked : TM.Parked emitDone.input := by + rw [hemitInput] + exact hloopInputParked + have hemitOutputBlank : emitDone.output = TM.resetBinaryBlank := + hemitOutput.trans hloopOutputBlank + have hemitOutputParked : TM.Parked emitDone.output := by + rw [hemitOutputBlank] + have hblankNat : TM.resetBinaryBlank.HasBinaryNat 0 := by + simpa [TM.resetBinaryBlank] using Tape.init_move_right_hasBinaryNat 0 + exact parked_of_binaryNat hblankNat + have habi := initialAbiInstallTM_hoareTime_internal tapes + (denseProgramInitialStore input) (input.length + 1) emitDone.input + emitDone.work emitDone.output hemitReady hemitBufferStart + hemitInputParked hemitOutputBlank + obtain ⟨abiDone, abiTime, habiTime, habiReach, habiHalt, + habiInput, habiWork, habiOutput⟩ := + habi _ _ _ ⟨rfl, rfl, rfl⟩ + have habiInputCells : abiDone.input.cells = + (Tape.init (input.map Γ.ofBool)).cells := by + rw [habiInput, hemitInput, + TM.input_cells_eq_of_reachesIn hloopReach, hsetupInputEq] + rfl + have habiInputHead : abiDone.input.head = input.length + 1 := by + rw [habiInput, hemitInput, hloopHead, hsetupInputEq] + simp [Tape.move] + omega + let sparseInitial : Snapshot := + { pc := 0, store := denseProgramInitialStore input } + have hsparseCanonical : Canonical sparseInitial.store := by + simpa [sparseInitial, denseProgramInitialStore] using + DenseOverlay.Snapshot.initial_canonical input + have habiReady : InstructionExecutionReady tapes sparseInitial.store 0 + (programSnapshotWork tapes sparseInitial) := + programSnapshotWork_ready_internal tapes sparseInitial hsparseCanonical + have hrewind := TM.rewindInputTM_hoareTime_frame + (n := n + 1) (input.length + 1) + (P := fun inp work out => + inp.cells = (Tape.init (input.map Γ.ofBool)).cells ∧ + work = denseProgramSnapshotWork tapes + (DenseOverlay.Snapshot.initial input) ∧ + out = TM.resetBinaryBlank) + (by + intro inp work out inp' work' out' hP hcells _hhead hwork' hout' + exact ⟨hcells.trans hP.1, + hwork'.trans hP.2.1, hout'.trans hP.2.2⟩) + have hrewindPre : + abiDone.input.cells 0 = Γ.start ∧ + (∀ j, j ≥ 1 → abiDone.input.cells j ≠ Γ.start) ∧ + abiDone.input.head ≤ input.length + 1 ∧ + abiDone.output.read ≠ Γ.start ∧ abiDone.output.head ≥ 1 ∧ + (∀ i, (abiDone.work i).read ≠ Γ.start ∧ + (abiDone.work i).head ≥ 1) ∧ + (abiDone.input.cells = (Tape.init (input.map Γ.ofBool)).cells ∧ + abiDone.work = denseProgramSnapshotWork tapes + (DenseOverlay.Snapshot.initial input) ∧ + abiDone.output = TM.resetBinaryBlank) := by + refine ⟨?_, ?_, by omega, ?_, ?_, ?_, habiInputCells, ?_, ?_⟩ + · rw [habiInputCells] + simp [Tape.init] + · intro j hj + rw [habiInputCells] + exact Tape.init_ofBool_cells_ne_start input j hj + · rw [habiOutput] + exact hemitOutputParked.read_ne_start + · rw [habiOutput] + exact hemitOutputParked.1 + · intro i + have hiParked := habiReady.control.lookup.scanner.parked i + have hworkEq : abiDone.work = programSnapshotWork tapes sparseInitial := + habiWork + rw [hworkEq] + exact ⟨hiParked.read_ne_start, hiParked.1⟩ + · simpa [denseProgramSnapshotWork, sparseInitial] using habiWork + · exact habiOutput.trans hemitOutputBlank + obtain ⟨rewindDone, rewindTime, hrewindTime, hrewindReach, + hrewindHalt, hrewindHead, hrewindCells, hrewindWork, + hrewindOutput⟩ := hrewind _ _ _ hrewindPre + have habiInputParked : TM.Parked abiDone.input := + ⟨by omega, hrewindPre.2.1⟩ + have habiOutputParked : TM.Parked abiDone.output := by + rw [habiOutput] + exact hemitOutputParked + have habiWorkParked : ∀ i, TM.Parked (abiDone.work i) := by + intro i + rw [habiWork] + exact habiReady.control.lookup.scanner.parked i + obtain ⟨habiInputTransition, habiWorkTransition, + habiOutputTransition⟩ := + TM.phaseTransition_eq_self_of_reads_ne_start + habiInputParked.read_ne_start + (fun i => (habiWorkParked i).read_ne_start) + habiOutputParked.read_ne_start + have hrewindReach' : TM.rewindInputTM.reachesIn rewindTime + { state := TM.rewindInputTM.qstart + input := TM.transitionInput abiDone.input + work := fun i => TM.transitionTape (abiDone.work i) + output := TM.transitionTape abiDone.output } + rewindDone := by + simpa only [habiInputTransition, habiWorkTransition, + habiOutputTransition] using hrewindReach + have habiRewindReach := TM.seqTM_reachesIn_of_reachesIn + (initialAbiInstallTM tapes) TM.rewindInputTM habiReach habiHalt + hrewindReach' + let abiRewindDone := TM.phase2Wrap (initialAbiInstallTM tapes) + TM.rewindInputTM rewindDone + have habiRewindHalt : + (TM.seqTM (initialAbiInstallTM tapes) TM.rewindInputTM).halted + abiRewindDone := by + rw [TM.phase2Wrap_halted_iff] + exact hrewindHalt + obtain ⟨hemitInputTransition, hemitWorkTransition, + hemitOutputTransition⟩ := + TM.phaseTransition_eq_self_of_reads_ne_start + hemitInputParked.read_ne_start + (fun i => (hemitReady.parked i).read_ne_start) + hemitOutputParked.read_ne_start + have habiRewindReach' : + (TM.seqTM (initialAbiInstallTM tapes) TM.rewindInputTM).reachesIn + (abiTime + 1 + rewindTime) + { state := + (TM.seqTM (initialAbiInstallTM tapes) TM.rewindInputTM).qstart + input := TM.transitionInput emitDone.input + work := fun i => TM.transitionTape (emitDone.work i) + output := TM.transitionTape emitDone.output } + abiRewindDone := by + simpa only [hemitInputTransition, hemitWorkTransition, + hemitOutputTransition] using habiRewindReach + have emitTailReach := TM.seqTM_reachesIn_of_reachesIn + (initialLengthEmitTM tapes) + (TM.seqTM (initialAbiInstallTM tapes) TM.rewindInputTM) + hemitReach hemitHalt habiRewindReach' + let emitTailDone := TM.phase2Wrap (initialLengthEmitTM tapes) + (TM.seqTM (initialAbiInstallTM tapes) TM.rewindInputTM) + abiRewindDone + have emitTailHalt : + (TM.seqTM (initialLengthEmitTM tapes) + (TM.seqTM (initialAbiInstallTM tapes) TM.rewindInputTM)).halted + emitTailDone := by + rw [TM.phase2Wrap_halted_iff] + exact habiRewindHalt + obtain ⟨hloopInputTransition, hloopWorkTransition, + hloopOutputTransition⟩ := + TM.phaseTransition_eq_self_of_reads_ne_start + hloopInputParked.read_ne_start + (fun i => (hloopReady.parked i).read_ne_start) + hloopOutputParked.read_ne_start + have emitTailReach' : + (TM.seqTM (initialLengthEmitTM tapes) + (TM.seqTM (initialAbiInstallTM tapes) TM.rewindInputTM)).reachesIn + (emitTime + 1 + (abiTime + 1 + rewindTime)) + { state := + (TM.seqTM (initialLengthEmitTM tapes) + (TM.seqTM (initialAbiInstallTM tapes) + TM.rewindInputTM)).qstart + input := TM.transitionInput loopDone.input + work := fun i => TM.transitionTape (loopDone.work i) + output := TM.transitionTape loopDone.output } + emitTailDone := by + simpa only [hloopInputTransition, hloopWorkTransition, + hloopOutputTransition] using emitTailReach + have loopTailReach := TM.seqTM_reachesIn_of_reachesIn + (denseInitialLengthLoopTM tapes) + (TM.seqTM (initialLengthEmitTM tapes) + (TM.seqTM (initialAbiInstallTM tapes) TM.rewindInputTM)) + hloopReach hloopHalt emitTailReach' + let loopTailDone := TM.phase2Wrap (denseInitialLengthLoopTM tapes) + (TM.seqTM (initialLengthEmitTM tapes) + (TM.seqTM (initialAbiInstallTM tapes) TM.rewindInputTM)) + emitTailDone + have loopTailHalt : + (TM.seqTM (denseInitialLengthLoopTM tapes) + (TM.seqTM (initialLengthEmitTM tapes) + (TM.seqTM (initialAbiInstallTM tapes) TM.rewindInputTM))).halted + loopTailDone := by + rw [TM.phase2Wrap_halted_iff] + exact emitTailHalt + obtain ⟨hsetupInputTransition, hsetupWorkTransition, + hsetupOutputTransition⟩ := + TM.phaseTransition_eq_self_of_reads_ne_start + hsetupInputParked.read_ne_start + (fun i => (hsetupReady.parked i).read_ne_start) + hsetupOutputParked.read_ne_start + have loopTailReach' : + (TM.seqTM (denseInitialLengthLoopTM tapes) + (TM.seqTM (initialLengthEmitTM tapes) + (TM.seqTM (initialAbiInstallTM tapes) TM.rewindInputTM))).reachesIn + (loopTime + 1 + + (emitTime + 1 + (abiTime + 1 + rewindTime))) + { state := + (TM.seqTM (denseInitialLengthLoopTM tapes) + (TM.seqTM (initialLengthEmitTM tapes) + (TM.seqTM (initialAbiInstallTM tapes) + TM.rewindInputTM))).qstart + input := TM.transitionInput setupDone.input + work := fun i => TM.transitionTape (setupDone.work i) + output := TM.transitionTape setupDone.output } + loopTailDone := by + simpa only [hsetupInputTransition, hsetupWorkTransition, + hsetupOutputTransition] using loopTailReach + have hreach := TM.seqTM_reachesIn_of_reachesIn + (initialSetupTM tapes) + (TM.seqTM (denseInitialLengthLoopTM tapes) + (TM.seqTM (initialLengthEmitTM tapes) + (TM.seqTM (initialAbiInstallTM tapes) TM.rewindInputTM))) + hsetupReach hsetupHalt loopTailReach' + let finalCfg := TM.phase2Wrap (initialSetupTM tapes) + (TM.seqTM (denseInitialLengthLoopTM tapes) + (TM.seqTM (initialLengthEmitTM tapes) + (TM.seqTM (initialAbiInstallTM tapes) TM.rewindInputTM))) + loopTailDone + refine ⟨finalCfg, + setupTime + 1 + + (loopTime + 1 + (emitTime + 1 + (abiTime + 1 + rewindTime))), + ?_, hreach, ?_, ?_⟩ + · unfold denseProgramInitTime + omega + · change (denseProgramInitTM tapes).halted finalCfg + unfold denseProgramInitTM + rw [TM.phase2Wrap_halted_iff] + exact loopTailHalt + · refine ⟨?_, hrewindWork, hrewindOutput⟩ + change rewindDone.input = + (Tape.init (input.map Γ.ofBool)).move Dir3.right + exact Tape.ext (by simpa [Tape.move] using hrewindHead) + (by simpa [Tape.move] using hrewindCells) + +end Machine +end RegisterStore +end RAM +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseInternal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseInternal.lean new file mode 100644 index 0000000000..26a971adc5 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseInternal.lean @@ -0,0 +1,520 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.DenseDefs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program +public import +LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.DenseDispatch + +/-! +# Dense-overlay RAM program controller -- proof internals +-/ + + +public section + +namespace Complexity +namespace RAM +namespace RegisterStore +namespace Machine + +variable {n : ℕ} + +private theorem denseInput_parked (input : List Bool) : + TM.Parked ((Tape.init (input.map Γ.ofBool)).move Dir3.right) := by + refine ⟨by simp [Tape.move], ?_⟩ + simpa using Tape.init_ofBool_move_right_cells_ne_start input + +private theorem blankOutput_parked : + TM.Parked ((Tape.init []).move Dir3.right) := by + refine ⟨by simp [Tape.move], ?_⟩ + intro j hj + simp [Tape.init, Tape.move] + omega + +private theorem phaseTransition_of_parked + {inp out : Tape} {work : Fin n → Tape} + (hinput : TM.Parked inp) (hwork : ∀ i, TM.Parked (work i)) + (houtput : TM.Parked out) : + TM.transitionInput inp = inp ∧ + (fun i => TM.transitionTape (work i)) = work ∧ + TM.transitionTape out = out := + TM.phaseTransition_eq_self_of_reads_ne_start hinput.read_ne_start + (fun i => (hwork i).read_ne_start) houtput.read_ne_start + +/-- Final dense lookup and Boolean emission recover the decoded RAM verdict +register. -/ +theorem denseProgramOutputTM_hoareTime_internal + (tapes : ControlInstructionTapes n) (input : List Bool) + (overlay : Store) (pcValue : ℕ) + (initialWork : Fin (n + 1) → Tape) + (hvalid : DenseOverlay.Valid overlay) + (hready : InstructionExecutionReady tapes overlay pcValue initialWork) : + (denseProgramOutputTM tapes).HoareTime + (fun inp work out => + inp = (Tape.init (input.map Γ.ofBool)).move Dir3.right ∧ + work = initialWork ∧ out = (Tape.init []).move Dir3.right) + (fun inp _work out => + inp = (Tape.init (input.map Γ.ofBool)).move Dir3.right ∧ + out = registerVerdictOutput (DenseOverlay.read input overlay 0)) + (denseProgramOutputTime tapes input overlay) := by + let inp₀ := (Tape.init (input.map Γ.ofBool)).move Dir3.right + let blank := (Tape.init []).move Dir3.right + have hinput : TM.Parked inp₀ := by + simpa only [inp₀] using denseInput_parked input + have hlookup := denseOverlayLookupStaticTM_hoareTime_frame + tapes.lifted.data.lhsLookup input overlay 0 initialWork blank hvalid + hready.control.lookup blankOutput_parked + let mid : TM.TapePred (n + 1) := fun inp work out => + inp = inp₀ ∧ + DenseOverlayLookupStaticResult tapes.lifted.data.lhsLookup input + overlay 0 initialWork work ∧ + out = blank + have hverdict : (registerVerdictTM tapes.liftedLhs).HoareTime mid + (fun inp _work out => + inp = inp₀ ∧ + out = registerVerdictOutput (DenseOverlay.read input overlay 0)) + 1 := by + rintro inp work out ⟨hinp, hresult, hout⟩ + have hleaf := registerVerdictTM_hoareTime_frame_internal + tapes.liftedLhs (DenseOverlay.read input overlay 0) inp₀ work + hresult.destination hinput hresult.parked + obtain ⟨final, time, htime, hreach, hhalt, hfinalInput, + _hfinalWork, hfinalOutput⟩ := + hleaf inp work out ⟨hinp, rfl, by simpa only [blank] using hout⟩ + exact ⟨final, time, htime, hreach, hhalt, hfinalInput, hfinalOutput⟩ + have hseq := TM.seqTM_hoareTime + (denseOverlayLookupStaticTM tapes.lifted.data.lhsLookup 0) + (registerVerdictTM tapes.liftedLhs) hlookup + (by + rintro inp work out ⟨hinp, hresult, hout⟩ + obtain ⟨hi, hw, ho⟩ := phaseTransition_of_parked + (inp := inp) (work := work) (out := out) + (by simpa [hinp] using hinput) hresult.parked + (by simpa [hout, blank] using blankOutput_parked) + rw [hi, hw, ho] + exact ⟨hinp, hresult, by simpa only [blank] using hout⟩) + hverdict + simpa only [denseProgramOutputTM, denseProgramOutputTime, mid, inp₀, + blank] using hseq + +/-- Final dense lookup overwrites the loop's halt-test bit with the decoded +RAM verdict. -/ +theorem denseProgramOutputTM_hoareTime_haltOutput_internal + (tapes : ControlInstructionTapes n) (input : List Bool) + (overlay : Store) (pcValue : ℕ) + (initialWork : Fin (n + 1) → Tape) + (hvalid : DenseOverlay.Valid overlay) + (hready : InstructionExecutionReady tapes overlay pcValue initialWork) : + (denseProgramOutputTM tapes).HoareTime + (fun inp work out => + inp = (Tape.init (input.map Γ.ofBool)).move Dir3.right ∧ + work = initialWork ∧ out = instructionHaltOutput .halt) + (fun inp _work out => + inp = (Tape.init (input.map Γ.ofBool)).move Dir3.right ∧ + out = registerVerdictOutput (DenseOverlay.read input overlay 0)) + (denseProgramOutputTime tapes input overlay) := by + let inp₀ := (Tape.init (input.map Γ.ofBool)).move Dir3.right + let haltOut := instructionHaltOutput .halt + have hinput : TM.Parked inp₀ := by + simpa only [inp₀] using denseInput_parked input + have hhaltOutParked : TM.Parked haltOut := by + refine ⟨?_, ?_⟩ + · simp [haltOut, instructionHaltOutput, instructionHaltVerdict, + TM.idleDir, Tape.writeAndMove, Tape.move, Tape.write, Tape.read, + Tape.init] + · intro j hj + exact instructionHaltOutput_cells_ne_start .halt j hj + have hlookup := denseOverlayLookupStaticTM_hoareTime_frame + tapes.lifted.data.lhsLookup input overlay 0 initialWork haltOut hvalid + hready.control.lookup hhaltOutParked + let mid : TM.TapePred (n + 1) := fun inp work out => + inp = inp₀ ∧ + DenseOverlayLookupStaticResult tapes.lifted.data.lhsLookup input + overlay 0 initialWork work ∧ + out = haltOut + have hverdict : (registerVerdictTM tapes.liftedLhs).HoareTime mid + (fun inp _work out => + inp = inp₀ ∧ + out = registerVerdictOutput (DenseOverlay.read input overlay 0)) + 1 := by + rintro inp work out ⟨hinp, hresult, hout⟩ + have hleaf := registerVerdictTM_hoareTime_haltOutput_internal + tapes.liftedLhs (DenseOverlay.read input overlay 0) inp₀ work + hresult.destination hinput hresult.parked + obtain ⟨final, time, htime, hreach, hhalt, hfinalInput, + _hfinalWork, hfinalOutput⟩ := + hleaf inp work out ⟨hinp, rfl, by simpa only [haltOut] using hout⟩ + exact ⟨final, time, htime, hreach, hhalt, hfinalInput, hfinalOutput⟩ + have hseq := TM.seqTM_hoareTime + (denseOverlayLookupStaticTM tapes.lifted.data.lhsLookup 0) + (registerVerdictTM tapes.liftedLhs) hlookup + (by + rintro inp work out ⟨hinp, hresult, hout⟩ + obtain ⟨hi, hw, ho⟩ := phaseTransition_of_parked + (inp := inp) (work := work) (out := out) + (by simpa [hinp] using hinput) hresult.parked + (by simpa [hout, haltOut] using hhaltOutParked) + rw [hi, hw, ho] + exact ⟨hinp, hresult, by simpa only [haltOut] using hout⟩) + hverdict + simpa only [denseProgramOutputTM, denseProgramOutputTime, mid, inp₀, + haltOut] using hseq + +/-- One dense loop iteration realizes one overlay step and either halts on the +successor's selected instruction or returns to the body start. -/ +theorem denseProgramLoopTM_iteration_internal + (tapes : ControlInstructionTapes n) (program : Program) + (input : List Bool) (snapshot : DenseOverlay.Snapshot) + (initialWork : Fin (n + 1) → Tape) + (hvalid : DenseOverlay.Valid snapshot.overlay) + (hready : InstructionExecutionReady tapes snapshot.overlay snapshot.pc + initialWork) : + let next := snapshot.step program input + ∃ (nextWork : Fin (n + 1) → Tape) (time : ℕ), + time ≤ denseProgramLoopIterationTime tapes program input snapshot ∧ + InstructionExecutionReady tapes next.overlay next.pc nextWork ∧ + ((next.Halted program ∧ + (denseProgramLoopTM tapes program).reachesIn time + { state := (denseProgramLoopTM tapes program).qstart + input := (Tape.init (input.map Γ.ofBool)).move Dir3.right + work := initialWork + output := (Tape.init []).move Dir3.right } + { state := Sum.inr (Sum.inl TM.LoopPhase.done) + input := (Tape.init (input.map Γ.ofBool)).move Dir3.right + work := nextWork + output := instructionHaltOutput (next.curInstr program) }) ∨ + (¬next.Halted program ∧ + (denseProgramLoopTM tapes program).reachesIn time + { state := (denseProgramLoopTM tapes program).qstart + input := (Tape.init (input.map Γ.ofBool)).move Dir3.right + work := initialWork + output := (Tape.init []).move Dir3.right } + { state := (denseProgramLoopTM tapes program).qstart + input := (Tape.init (input.map Γ.ofBool)).move Dir3.right + work := nextWork + output := (Tape.init []).move Dir3.right })) := by + let next := snapshot.step program input + let body := denseProgramStepTM tapes program + let test := programHaltTM tapes program + let inp₀ := (Tape.init (input.map Γ.ofBool)).move Dir3.right + let blank := (Tape.init []).move Dir3.right + have hinput : TM.Parked inp₀ := by + simpa only [inp₀] using denseInput_parked input + have hbody := denseProgramStepTM_hoareTime_frame tapes program input + snapshot.overlay snapshot.pc initialWork hvalid hready + obtain ⟨cbody, bodyTime, hbodyTime, hbodyReach, hbodyHalt, + hbodyInput, hnextReadyRaw, hbodyOutput⟩ := + hbody inp₀ initialWork blank ⟨rfl, rfl, rfl⟩ + have hnextReady : InstructionExecutionReady tapes next.overlay next.pc + cbody.work := by + simpa [next, DenseOverlay.Snapshot.step, + DenseOverlay.Snapshot.curInstr, denseInstructionStore, + denseInstructionPC, selectedInstruction_eq_getElem?_getD] using + hnextReadyRaw + have hbodyInputParked : TM.Parked cbody.input := by + simpa [hbodyInput] using hinput + have hbodyWorkParked : ∀ i, TM.Parked (cbody.work i) := + hnextReady.control.lookup.scanner.parked + have hbodyOutputParked : TM.Parked cbody.output := by + simpa [hbodyOutput, blank] using blankOutput_parked + have hbodyLoop := TM.loopTM_body_simulation body test hbodyReach + have hbodyTransition : + (⟨test.qstart, TM.transitionInput cbody.input, + fun i => TM.transitionTape (cbody.work i), + TM.transitionTape cbody.output⟩ : Complexity.Cfg (n + 1) test.Q) = + ⟨test.qstart, inp₀, cbody.work, blank⟩ := by + have hi : TM.transitionInput cbody.input = inp₀ := by + rw [hbodyInput] + exact hinput.transitionInput_eq_self + have hw : (fun i => TM.transitionTape (cbody.work i)) = cbody.work := + funext fun i => (hbodyWorkParked i).transitionTape_eq_self + have ho : TM.transitionTape cbody.output = blank := by + rw [hbodyOutput] + exact blankOutput_parked.transitionTape_eq_self + rw [hi, hw, ho] + have hbodyToTest := TM.loopTM_body_to_test body test hbodyHalt + rw [hbodyTransition] at hbodyToTest + have htest := programHaltTM_hoareTime_frame_internal tapes program + next.overlay next.pc cbody.work inp₀ hnextReady hinput + obtain ⟨ctest, testTime, htestTime, htestReach, htestHalt, + htestInput, htestWork, htestOutput⟩ := + htest inp₀ cbody.work blank ⟨rfl, rfl, rfl⟩ + have hselected : + selectedInstruction program next.pc = next.curInstr program := + selectedInstruction_eq_getElem?_getD program next.pc + have htestOutput' : + ctest.output = instructionHaltOutput (next.curInstr program) := by + simpa only [hselected] using htestOutput + have htestInputParked : TM.Parked ctest.input := by + simpa [htestInput] using hinput + have htestWorkParked : ∀ i, TM.Parked (ctest.work i) := by + simpa [htestWork] using hbodyWorkParked + have htestOutputParked : TM.Parked ctest.output := by + refine ⟨?_, ?_⟩ + · rw [htestOutput', instructionHaltOutput_head] + · rw [htestOutput'] + exact instructionHaltOutput_cells_ne_start _ + have htestTransition : + (⟨(Sum.inr (Sum.inl TM.LoopPhase.rewindOut) : + TM.LoopQ body.Q test.Q), + TM.transitionInput ctest.input, + fun i => TM.transitionTape (ctest.work i), + TM.transitionTape ctest.output⟩ : + Complexity.Cfg (n + 1) (TM.LoopQ body.Q test.Q)) = + ⟨Sum.inr (Sum.inl TM.LoopPhase.rewindOut), inp₀, + cbody.work, ctest.output⟩ := by + have hi : TM.transitionInput ctest.input = inp₀ := by + rw [htestInput] + exact hinput.transitionInput_eq_self + have hw : (fun i => TM.transitionTape (ctest.work i)) = cbody.work := by + funext i + rw [htestWork] + exact (hbodyWorkParked i).transitionTape_eq_self + have ho : TM.transitionTape ctest.output = ctest.output := + htestOutputParked.transitionTape_eq_self + rw [hi, hw, ho] + have htestToRewind := + (TM.loopTM_test_to_rewind body test htestHalt).trans + (congrArg some htestTransition) + obtain ⟨ctail, htailReach, htailState, htailInput, htailWork, + htailOutput⟩ := programLoop_rewind_check_internal body test + ⟨Sum.inr (Sum.inl TM.LoopPhase.rewindOut), inp₀, + cbody.work, ctest.output⟩ rfl hinput.read_ne_start + (fun i => (hbodyWorkParked i).read_ne_start) + (by rw [htestOutput', instructionHaltOutput_head]) + (by rw [htestOutput', instructionHaltOutput_cells_zero]) + (by rw [htestOutput']; exact instructionHaltOutput_cells_ne_start _) + have hreach := TM.reachesIn_trans _ + (TM.reachesIn_trans _ + (TM.reachesIn_trans _ + (TM.reachesIn_trans _ hbodyLoop (.step hbodyToTest .zero)) + (TM.loopTM_test_simulation body test htestReach)) + (.step htestToRewind .zero)) htailReach + have htime : bodyTime + 1 + testTime + 1 + 3 ≤ + denseProgramLoopIterationTime tapes program input snapshot := by + dsimp only [next] at htestTime + simp only [denseProgramLoopIterationTime] + omega + refine ⟨cbody.work, bodyTime + 1 + testTime + 1 + 3, htime, + hnextReady, ?_⟩ + by_cases hhalted : next.Halted program + · left + refine ⟨hhalted, ?_⟩ + have hone : ctest.output.cells 1 = Γ.one := by + rw [htestOutput'] + exact instructionHaltOutput_cell_one_eq_one_iff _ |>.2 hhalted + have htailDone : ctail.state = + Sum.inr (Sum.inl TM.LoopPhase.done) := by + simpa [hone] using htailState + have hcTail : ctail = + { state := Sum.inr (Sum.inl TM.LoopPhase.done) + input := inp₀ + work := cbody.work + output := instructionHaltOutput (next.curInstr program) } := by + cases ctail + simp only [Complexity.Cfg.mk.injEq] + exact ⟨htailDone, htailInput, htailWork, + htailOutput.trans htestOutput'⟩ + simpa only [denseProgramLoopTM, body, test, inp₀, blank, hcTail] using + hreach + · right + refine ⟨hhalted, ?_⟩ + have hcur : next.curInstr program ≠ .halt := hhalted + have hblankOutput : ctest.output = blank := by + rw [htestOutput'] + simpa only [blank] using + instructionHaltOutput_eq_blank_of_ne_halt hcur + have hone : ctest.output.cells 1 ≠ Γ.one := by + rw [htestOutput'] + exact fun h => hhalted + (instructionHaltOutput_cell_one_eq_one_iff _ |>.1 h) + have htailStart : ctail.state = Sum.inl body.qstart := by + simpa [hone] using htailState + have hcTail : ctail = + { state := Sum.inl body.qstart + input := inp₀ + work := cbody.work + output := blank } := by + cases ctail + simp only [Complexity.Cfg.mk.injEq] + exact ⟨htailStart, htailInput, htailWork, + htailOutput.trans hblankOutput⟩ + simpa only [denseProgramLoopTM, body, test, inp₀, blank, hcTail] using + hreach + +/-- A halted dense snapshot is stationary under one selected step. -/ +theorem denseSnapshot_step_eq_self_of_halted_internal + (program : Program) (input : List Bool) + (snapshot : DenseOverlay.Snapshot) + (hhalted : snapshot.Halted program) : + snapshot.step program input = snapshot := by + change snapshot.curInstr program = .halt at hhalted + rw [DenseOverlay.Snapshot.step, hhalted] + rfl + +/-- Running a halted dense snapshot for arbitrary additional fuel is a no-op. -/ +theorem denseSnapshot_run_halted_internal + (program : Program) (input : List Bool) + (snapshot : DenseOverlay.Snapshot) + (hhalted : snapshot.Halted program) : + ∀ fuel, snapshot.run program input fuel = snapshot + | 0 => rfl + | fuel + 1 => by + rw [DenseOverlay.Snapshot.run, if_pos hhalted] + +/-- A halted fuel-bounded dense run is realized by the fixed controller loop. +The extra iteration handles a snapshot already halted at fuel zero. -/ +theorem denseProgramLoopTM_hoareTime_run_internal + (tapes : ControlInstructionTapes n) (program : Program) + (input : List Bool) : + ∀ (fuel : ℕ) (snapshot : DenseOverlay.Snapshot) + (initialWork : Fin (n + 1) → Tape), + DenseOverlay.Valid snapshot.overlay → + InstructionExecutionReady tapes snapshot.overlay snapshot.pc + initialWork → + (snapshot.run program input fuel).Halted program → + (denseProgramLoopTM tapes program).HoareTime + (fun inp work out => + inp = (Tape.init (input.map Γ.ofBool)).move Dir3.right ∧ + work = initialWork ∧ out = (Tape.init []).move Dir3.right) + (fun inp work out => + let final := snapshot.run program input fuel + inp = (Tape.init (input.map Γ.ofBool)).move Dir3.right ∧ + InstructionExecutionReady tapes final.overlay final.pc work ∧ + out = instructionHaltOutput (final.curInstr program)) + (denseProgramLoopTime tapes program input (fuel + 1) + snapshot) := by + intro fuel + induction fuel with + | zero => + intro snapshot initialWork hvalid hready hhalted + rintro inp work out ⟨hinp, hwork, hout⟩ + subst inp + subst work + subst out + have hsnapshotHalted : snapshot.Halted program := by + simpa [DenseOverlay.Snapshot.run] using hhalted + have hstepSelf := denseSnapshot_step_eq_self_of_halted_internal + program input snapshot hsnapshotHalted + obtain ⟨nextWork, time, htime, hnextReady, hbranch⟩ := + denseProgramLoopTM_iteration_internal tapes program input snapshot + initialWork hvalid hready + rcases hbranch with ⟨hnextHalted, hreach⟩ | + ⟨hnextRunning, _⟩ + · have hready' : InstructionExecutionReady tapes snapshot.overlay + snapshot.pc nextWork := by + simpa only [hstepSelf] using hnextReady + have hreach' : (denseProgramLoopTM tapes program).reachesIn time + { state := (denseProgramLoopTM tapes program).qstart + input := (Tape.init (input.map Γ.ofBool)).move Dir3.right + work := initialWork + output := (Tape.init []).move Dir3.right } + { state := Sum.inr (Sum.inl TM.LoopPhase.done) + input := (Tape.init (input.map Γ.ofBool)).move Dir3.right + work := nextWork + output := instructionHaltOutput + (snapshot.curInstr program) } := by + simpa only [hstepSelf] using hreach + refine ⟨_, time, ?_, hreach', rfl, rfl, ?_, ?_⟩ + · simpa [denseProgramLoopTime] using htime + · simpa [DenseOverlay.Snapshot.run] using hready' + · simp [DenseOverlay.Snapshot.run] + · exact (hnextRunning (by simpa only [hstepSelf] using + hsnapshotHalted)).elim + | succ fuel ih => + intro snapshot initialWork hvalid hready hhalted + by_cases hsnapshotHalted : snapshot.Halted program + · rintro inp work out ⟨hinp, hwork, hout⟩ + subst inp + subst work + subst out + have hstepSelf := denseSnapshot_step_eq_self_of_halted_internal + program input snapshot hsnapshotHalted + obtain ⟨nextWork, time, htime, hnextReady, hbranch⟩ := + denseProgramLoopTM_iteration_internal tapes program input snapshot + initialWork hvalid hready + rcases hbranch with ⟨_, hreach⟩ | ⟨hnextRunning, _⟩ + · have hfinal : snapshot.run program input (fuel + 1) = snapshot := + denseSnapshot_run_halted_internal program input snapshot + hsnapshotHalted _ + have hready' : InstructionExecutionReady tapes snapshot.overlay + snapshot.pc nextWork := by + simpa only [hstepSelf] using hnextReady + have hreach' : (denseProgramLoopTM tapes program).reachesIn time + { state := (denseProgramLoopTM tapes program).qstart + input := (Tape.init (input.map Γ.ofBool)).move Dir3.right + work := initialWork + output := (Tape.init []).move Dir3.right } + { state := Sum.inr (Sum.inl TM.LoopPhase.done) + input := (Tape.init (input.map Γ.ofBool)).move Dir3.right + work := nextWork + output := instructionHaltOutput + (snapshot.curInstr program) } := by + simpa only [hstepSelf] using hreach + refine ⟨_, time, ?_, hreach', rfl, rfl, ?_, ?_⟩ + · simp only [denseProgramLoopTime] + omega + · simpa only [hfinal] using hready' + · simp only [hfinal] + · exact (hnextRunning (by simpa only [hstepSelf] using + hsnapshotHalted)).elim + · have hrunHalted : + ((snapshot.step program input).run program input fuel).Halted + program := by + simpa [DenseOverlay.Snapshot.run, hsnapshotHalted] using hhalted + have hiter := denseProgramLoopTM_iteration_internal tapes program + input snapshot initialWork hvalid hready + obtain ⟨nextWork, time₁, htime₁, hnextReady, hbranch⟩ := hiter + rcases hbranch with ⟨hnextHalted, hreach₁⟩ | + ⟨hnextRunning, hreach₁⟩ + · rintro inp work out ⟨hinp, hwork, hout⟩ + subst inp + subst work + subst out + have hfinal : + (snapshot.step program input).run program input fuel = + snapshot.step program input := + denseSnapshot_run_halted_internal program input + (snapshot.step program input) hnextHalted fuel + refine ⟨_, time₁, ?_, hreach₁, rfl, rfl, ?_, ?_⟩ + · simp only [denseProgramLoopTime] + omega + · simpa [DenseOverlay.Snapshot.run, hsnapshotHalted, hfinal] + using hnextReady + · simp [DenseOverlay.Snapshot.run, hsnapshotHalted, hfinal] + · have hnextValid := DenseOverlay.Snapshot.step_valid program input + snapshot hvalid + have hrecursive := ih (snapshot.step program input) nextWork + hnextValid hnextReady hrunHalted + rintro inp work out ⟨hinp, hwork, hout⟩ + subst inp + subst work + subst out + obtain ⟨cfinal, time₂, htime₂, hreach₂, hhalt₂, + hfinalInput, hfinalReady, hfinalOutput⟩ := + hrecursive + ((Tape.init (input.map Γ.ofBool)).move Dir3.right) + nextWork ((Tape.init []).move Dir3.right) ⟨rfl, rfl, rfl⟩ + refine ⟨cfinal, time₁ + time₂, ?_, + TM.reachesIn_trans _ hreach₁ hreach₂, hhalt₂, + hfinalInput, ?_, ?_⟩ + · change time₁ + time₂ ≤ + denseProgramLoopIterationTime tapes program input snapshot + + denseProgramLoopTime tapes program input (fuel + 1) + (snapshot.step program input) + exact Nat.add_le_add htime₁ htime₂ + · simpa [DenseOverlay.Snapshot.run, hsnapshotHalted] using + hfinalReady + · simpa [DenseOverlay.Snapshot.run, hsnapshotHalted] using + hfinalOutput + +end Machine +end RegisterStore +end RAM +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Init.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Init.lean new file mode 100644 index 0000000000..914e2e63e4 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Init.lean @@ -0,0 +1,10 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Init.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Init.Internal + +/-! Supporting modules for Beyond the Bethe approximation of the permanent. -/ diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Init/Defs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Init/Defs.lean new file mode 100644 index 0000000000..4af42069d0 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Init/Defs.lean @@ -0,0 +1,310 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Defs + +/-! +# Sparse RAM public-input initialization definitions + +This layer constructs the reusable sparse-snapshot ABI from the standard TM +input tape. It emits nonzero bit registers in increasing address order, then +appends the nonzero length register `R₀`. The resulting order need not equal +`initialStore`; it is a canonical sparse store representing the same total +RAM register file. +-/ + + +@[expose] public section + +namespace Complexity + +namespace RAM + +namespace RegisterStore + +namespace Machine + +/-- Nonzero public-input bit registers, beginning at `address`. -/ +def inputBitStoreFrom : ℕ → List Bool → Store + | _, [] => [] + | address, bit :: rest => + (if bit then [(address, 1)] else []) ++ + inputBitStoreFrom (address + 1) rest + +/-- Streaming-friendly public-input store: bit registers first and the +nonzero length register last. -/ +def programInitialStore (input : List Bool) : Store := + RegisterStore.write (inputBitStoreFrom 1 input) 0 input.length + +/-- Sparse initial snapshot used by the concrete initialization machine. -/ +def programInitialSnapshot (input : List Bool) : Snapshot := + { pc := 0, store := programInitialStore input } + +/-- Number of nonzero entries emitted by the bit-register prefix. -/ +def inputTrueCount : List Bool → ℕ + | [] => 0 + | bit :: rest => (if bit then 1 else 0) + inputTrueCount rest + +/-- Append-positioned binary tape for an emitted store prefix. -/ +def programBinaryPrefixTape (bits : List Bool) : Tape := + { head := bits.length + 1 + cells := (Tape.init (bits.map Γ.ofBool)).cells } + +/-- Exact work family at a streaming input-loop boundary. -/ +def initialLoopWork {n : ℕ} (tapes : ControlInstructionTapes n) + (address count : ℕ) (entries : Store) : Fin (n + 1) → Tape := + Function.update + (Function.update + (Function.update + (Function.update + (Function.const (Fin (n + 1)) TM.resetBinaryBlank) + tapes.liftedLhs (programBinaryTape address.bits)) + tapes.lifted.data.rhs (programBinaryTape (1 : ℕ).bits)) + tapes.lifted.data.update.remaining + (programBinaryTape count.bits)) + tapes.buffer + (programBinaryPrefixTape (entries.flatMap Entry.encode)) + +/-- Streaming input-loop invariant. Only the current address, fixed value one, +runtime entry count, and append buffer differ from the standard blank frame. -/ +structure InitialLoopReady {n : ℕ} (tapes : ControlInstructionTapes n) + (address count : ℕ) (entries : Store) + (work : Fin (n + 1) → Tape) : Prop where + address : (work tapes.liftedLhs).HasBinaryNat address + value : (work tapes.lifted.data.rhs).HasBinaryNat 1 + count : (work tapes.lifted.data.update.remaining).HasBinaryNat count + buffer : (work tapes.buffer).HasBinaryPrefix + (entries.flatMap Entry.encode) + parked : ∀ i, TM.Parked (work i) + frame : ∀ i, i ≠ tapes.liftedLhs → i ≠ tapes.lifted.data.rhs → + i ≠ tapes.lifted.data.update.remaining → i ≠ tapes.buffer → + work i = TM.resetBinaryBlank + +/-- Recursive work-independent streaming-loop bound. -/ +def initialInputLoopTime {n : ℕ} (tapes : ControlInstructionTapes n) : + ℕ → ℕ → List Bool → ℕ + | _, _, [] => 1 + | address, count, bit :: rest => + let bodyTime := if bit then + rewindEntryEncodeRestoreTime (address, 1) + 1 + + TM.binarySuccTime count + 1 + TM.binarySuccTime address + else TM.binarySuccTime address + 1 + bodyTime + 1 + + initialInputLoopTime tapes (address + 1) + (count + if bit then 1 else 0) rest + +/-- Dynamic address/value assignment for one nonzero input bit. -/ +def initialBitEntryTapes {n : ℕ} (tapes : ControlInstructionTapes n) : + EntryEncodeTapes n where + address := tapes.data.lhs + value := tapes.data.rhs + ne := tapes.data.ne (by decide) + +/-- Address-zero/length assignment for the final `R₀` entry. -/ +def initialLengthEntryTapes {n : ℕ} (tapes : ControlInstructionTapes n) : + EntryEncodeTapes n where + address := tapes.data.update.entry.query + value := tapes.data.lhs + ne := tapes.data.ne (by decide) + +/-- Emit one nonzero bit entry, restore both entry sources to cell one, then +increment the runtime entry count and current input address. -/ +def initialOneBitTM {n : ℕ} (tapes : ControlInstructionTapes n) : + TM (n + 1) := + TM.seqTM + (rewindEntryEncodeRestoreTM (initialBitEntryTapes tapes)).retargetOutput + (TM.seqTM (TM.binarySuccTM tapes.lifted.data.update.remaining) + (TM.binarySuccTM tapes.liftedLhs)) + +/-- A zero input bit emits no entry and only advances the current address. -/ +def initialZeroBitTM {n : ℕ} (tapes : ControlInstructionTapes n) : + TM (n + 1) := + TM.binarySuccTM tapes.liftedLhs + +/-- Driver phases for streaming over the real Boolean input. -/ +inductive InitialInputPhase where + | scan + | done + deriving DecidableEq + +instance : Fintype InitialInputPhase where + elems := {.scan, .done} + complete := fun phase => by cases phase <;> simp + +/-- State space of the public-input bit loop. -/ +abbrev InitialInputQ {n : ℕ} (tapes : ControlInstructionTapes n) := + InitialInputPhase ⊕ ((initialOneBitTM tapes).Q ⊕ (initialZeroBitTM tapes).Q) + +/-- Scan the real input without moving before body entry. Each `1` invokes the +entry-emitting body, each `0` invokes the address-only body, and the preserving +body seam advances the input by one cell. -/ +def initialInputLoopTM {n : ℕ} (tapes : ControlInstructionTapes n) : + TM (n + 1) where + Q := InitialInputQ tapes + qstart := .inl .scan + qhalt := .inl .done + δ := fun state iHead wHeads oHead => + match state with + | .inl .scan => + if iHead = Γ.blank then + TM.allReadBack (.inl .done) iHead wHeads oHead + else if iHead = Γ.one then + TM.allReadBack (.inr (.inl (initialOneBitTM tapes).qstart)) + iHead wHeads oHead + else + TM.allReadBack (.inr (.inr (initialZeroBitTM tapes).qstart)) + iHead wHeads oHead + | .inl .done => TM.allIdle (.inl .done) iHead wHeads oHead + | .inr (.inl state) => + if state = (initialOneBitTM tapes).qhalt then + (.inl .scan, fun i => TM.readBackWrite (wHeads i), + TM.readBackWrite oHead, Dir3.right, + fun i => TM.idleDir (wHeads i), TM.idleDir oHead) + else + let action := (initialOneBitTM tapes).δ state iHead wHeads oHead + (.inr (.inl action.1), action.2.1, action.2.2.1, + action.2.2.2.1, action.2.2.2.2.1, action.2.2.2.2.2) + | .inr (.inr state) => + if state = (initialZeroBitTM tapes).qhalt then + (.inl .scan, fun i => TM.readBackWrite (wHeads i), + TM.readBackWrite oHead, Dir3.right, + fun i => TM.idleDir (wHeads i), TM.idleDir oHead) + else + let action := (initialZeroBitTM tapes).δ state iHead wHeads oHead + (.inr (.inr action.1), action.2.1, action.2.2.1, + action.2.2.2.1, action.2.2.2.2.1, action.2.2.2.2.2) + δ_right_of_start := by + intro state iHead wHeads oHead + match state with + | .inl .scan => + dsimp only + split + · exact TM.rightOfStart_allReadBack iHead wHeads oHead + · split <;> exact TM.rightOfStart_allReadBack iHead wHeads oHead + | .inl .done => exact TM.rightOfStart_allIdle iHead wHeads oHead + | .inr (.inl state) => + dsimp only + split + · exact ⟨fun _ => rfl, fun _ => TM.idleDir_right_of_start, + TM.idleDir_right_of_start⟩ + · exact (initialOneBitTM tapes).δ_right_of_start state + iHead wHeads oHead + | .inr (.inr state) => + dsimp only + split + · exact ⟨fun _ => rfl, fun _ => TM.idleDir_right_of_start, + TM.idleDir_right_of_start⟩ + · exact (initialZeroBitTM tapes).δ_right_of_start state + iHead wHeads oHead + +/-- Emit the nonzero `R₀ = |input|` entry and increment the entry count. -/ +def initialLengthEmitTM {n : ℕ} (tapes : ControlInstructionTapes n) : + TM (n + 1) := + TM.seqTM + (rewindEntryEncodeRestoreTM + (initialLengthEntryTapes tapes)).retargetOutput + (TM.binarySuccTM tapes.lifted.data.update.remaining) + +/-- Skip the length entry at zero; otherwise append it to the buffer. -/ +def initialLengthTM {n : ℕ} (tapes : ControlInstructionTapes n) : + TM (n + 1) := + TM.branchWorkBlankTM tapes.liftedLhs TM.skipTM + (initialLengthEmitTM tapes) + +/-- Selected-branch bound for optional length-register emission. -/ +def initialLengthTime (length count : ℕ) : ℕ := + 1 + if length = 0 then 1 else + rewindEntryEncodeRestoreTime (0, length) + 1 + + TM.binarySuccTime count + +/-- Cleanup targets used after the complete input store has been copied into +the read-only source role. -/ +def initialCleanupTargets {n : ℕ} + (tapes : ControlInstructionTapes n) : List (Fin (n + 1)) := + [tapes.liftedLhs, tapes.lifted.data.rhs] + +/-- Canonical contents reset by the final two-target cleanup. -/ +def initialCleanupBits {n : ℕ} (tapes : ControlInstructionTapes n) + (length : ℕ) (i : Fin (n + 1)) : List Bool := + if i = tapes.liftedLhs then length.bits + else if i = tapes.lifted.data.rhs then (1 : ℕ).bits + else [] + +/-- Exact compositional bound for installing a completed store into the +program-loop ABI. -/ +def initialAbiInstallTime {n : ℕ} (tapes : ControlInstructionTapes n) + (store : Store) (length : ℕ) : ℕ := + let encodedLength := (store.flatMap Entry.encode).length + TM.binaryCopyTime store.length 0 + 1 + + (encodedLength + 1 + 2) + 1 + + (encodedLength + 1) + 1 + + (encodedLength + 1 + 2) + 1 + + TM.resetBinaryWorkTime (encodedLength + 1) encodedLength + 1 + + TM.resetBinaryWorkManyTime (initialCleanupBits tapes length) + (fun _ => 1) (initialCleanupTargets tapes) + +/-- Park the standard initial tapes and seed the streaming address/value +sources with one. -/ +def initialSetupTM {n : ℕ} (tapes : ControlInstructionTapes n) : + TM (n + 1) := + TM.seqTM TM.skipTM + (TM.seqTM (TM.binarySuccTM tapes.liftedLhs) + (TM.binarySuccTM tapes.lifted.data.rhs)) + +/-- Restore the address cursor from `|input| + 1` to `|input|`, then append +the optional nonzero length register. -/ +def initialLengthInstallTM {n : ℕ} + (tapes : ControlInstructionTapes n) : TM (n + 1) := + TM.seqTM (TM.binaryPredTM tapes.liftedLhs) + (initialLengthTM tapes) + +/-- Copy the completed buffer into the reusable source/count roles and clear +the remaining initialization temporaries. -/ +def initialAbiInstallTM {n : ℕ} + (tapes : ControlInstructionTapes n) : TM (n + 1) := + TM.seqTM + (TM.binaryCopyIntoTM + tapes.lifted.data.update.remaining + tapes.lifted.data.update.resultCount + tapes.lifted.data.update.found) + (TM.seqTM (TM.rewindWorkTM tapes.buffer) + (TM.seqTM + (TM.copyWorkToWorkTM tapes.buffer tapes.liftedSource) + (TM.seqTM (TM.rewindWorkTM tapes.liftedSource) + (TM.seqTM (TM.resetBinaryWorkTM tapes.buffer) + (TM.resetBinaryWorkManyTM + (initialCleanupTargets tapes)))))) + +/-- Install the length entry, source/count ABI, and clean loop temporaries. -/ +def initialFinalizeTM {n : ℕ} (tapes : ControlInstructionTapes n) : + TM (n + 1) := + TM.seqTM (initialLengthInstallTM tapes) (initialAbiInstallTM tapes) + +/-- Complete public-input initialization. A leading skip parks every standard +initial tape, the streaming loop writes the sparse store into the last buffer, +and the tail installs the reusable source/count ABI and clears temporary roles. -/ +def programInitTM {n : ℕ} (tapes : ControlInstructionTapes n) : + TM (n + 1) := + TM.seqTM (initialSetupTM tapes) + (TM.seqTM (initialInputLoopTM tapes) (initialFinalizeTM tapes)) + +/-- Exact compositional time bound for complete public-input initialization. -/ +def programInitTime {n : ℕ} (tapes : ControlInstructionTapes n) + (input : List Bool) : ℕ := + (1 + 1 + (TM.binarySuccTime 0 + 1 + TM.binarySuccTime 0)) + 1 + + (initialInputLoopTime tapes 1 0 input + 1 + + ((TM.binaryPredTime input.length + 1 + + initialLengthTime input.length (inputTrueCount input)) + 1 + + initialAbiInstallTime tapes (programInitialStore input) input.length)) + +end Machine + +end RegisterStore + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Init/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Init/Internal.lean new file mode 100644 index 0000000000..bc27c96f95 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Init/Internal.lean @@ -0,0 +1,2336 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Init.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryEncode +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.WorkBranch +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryCopy +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryPred +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.ResetBinaryMany +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore +import Mathlib.Data.Rat.Cast.Order +import Mathlib.Tactic.NormNum.Abs +import Mathlib.Tactic.NormNum.DivMod +import Mathlib.Tactic.NormNum.OfScientific + +/-! +# Sparse RAM public-input initialization -- proof internals +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace RegisterStore + +namespace Machine + +variable {n : ℕ} + +private theorem programBinaryPrefixTape_hasBinaryPrefix (bits : List Bool) : + (programBinaryPrefixTape bits).HasBinaryPrefix bits := by + refine ⟨rfl, ?_, ?_⟩ + · intro i hi + exact Tape.init_ofBool_cells_lt bits i hi + · intro i hi + exact Tape.init_ofBool_cells_ge bits i hi + +private theorem programBinaryPrefixTape_parked (bits : List Bool) : + TM.Parked (programBinaryPrefixTape bits) := by + refine ⟨by simp [programBinaryPrefixTape], ?_⟩ + exact (show (programBinaryPrefixTape bits).HasBinaryContent bits from + (programBinaryPrefixTape_hasBinaryPrefix bits).2).cells_ne_start + +private theorem binaryTape_parked (bits : List Bool) : + TM.Parked (programBinaryTape bits) := by + have hstring : (programBinaryTape bits).HasBinaryString bits := by + simpa only [programBinaryTape] using + Tape.init_move_right_hasBinaryString bits + exact ⟨by rw [hstring.1], hstring.hasBinaryContent.cells_ne_start⟩ + +private theorem initialLoopWork_lhs + (tapes : ControlInstructionTapes n) (address count : ℕ) + (entries : Store) : + initialLoopWork tapes address count entries tapes.liftedLhs = + programBinaryTape address.bits := by + have hlhsRhs : tapes.liftedLhs ≠ tapes.lifted.data.rhs := + tapes.lifted.data.ne (by decide) + have hlhsCount : tapes.liftedLhs ≠ + tapes.lifted.data.update.remaining := + tapes.lifted.data.ne (by decide) + have hlhsBuffer : tapes.liftedLhs ≠ tapes.buffer := by + exact tapes.liftedData_ne_buffer 13 + unfold initialLoopWork + rw [Function.update_of_ne hlhsBuffer, + Function.update_of_ne hlhsCount, + Function.update_of_ne hlhsRhs, Function.update_self] + +private theorem initialLoopWork_rhs + (tapes : ControlInstructionTapes n) (address count : ℕ) + (entries : Store) : + initialLoopWork tapes address count entries tapes.lifted.data.rhs = + programBinaryTape (1 : ℕ).bits := by + have hrhsCount : tapes.lifted.data.rhs ≠ + tapes.lifted.data.update.remaining := + tapes.lifted.data.ne (by decide) + have hrhsBuffer : tapes.lifted.data.rhs ≠ tapes.buffer := by + exact tapes.liftedData_ne_buffer 14 + unfold initialLoopWork + rw [Function.update_of_ne hrhsBuffer, + Function.update_of_ne hrhsCount, Function.update_self] + +private theorem initialLoopWork_count + (tapes : ControlInstructionTapes n) (address count : ℕ) + (entries : Store) : + initialLoopWork tapes address count entries + tapes.lifted.data.update.remaining = + programBinaryTape count.bits := by + have hcountBuffer : tapes.lifted.data.update.remaining ≠ tapes.buffer := by + exact tapes.liftedData_ne_buffer 9 + unfold initialLoopWork + rw [Function.update_of_ne hcountBuffer, + Function.update_self] + +private theorem initialLoopWork_buffer + (tapes : ControlInstructionTapes n) (address count : ℕ) + (entries : Store) : + initialLoopWork tapes address count entries tapes.buffer = + programBinaryPrefixTape (entries.flatMap Entry.encode) := by + simp [initialLoopWork] + +private theorem initialLoopWork_other + (tapes : ControlInstructionTapes n) (address count : ℕ) + (entries : Store) (i : Fin (n + 1)) + (hlhs : i ≠ tapes.liftedLhs) (hrhs : i ≠ tapes.lifted.data.rhs) + (hcount : i ≠ tapes.lifted.data.update.remaining) + (hbuffer : i ≠ tapes.buffer) : + initialLoopWork tapes address count entries i = TM.resetBinaryBlank := by + unfold initialLoopWork + rw [Function.update_of_ne hbuffer, Function.update_of_ne hcount, + Function.update_of_ne hrhs, Function.update_of_ne hlhs] + rfl + +theorem initialLoopWork_ready_internal + (tapes : ControlInstructionTapes n) (address count : ℕ) + (entries : Store) : + InitialLoopReady tapes address count entries + (initialLoopWork tapes address count entries) := by + have haddress := Tape.init_move_right_hasBinaryNat address + have hvalue := Tape.init_move_right_hasBinaryNat 1 + have hcount := Tape.init_move_right_hasBinaryNat count + have hblankNat : TM.resetBinaryBlank.HasBinaryNat 0 := by + simpa [TM.resetBinaryBlank] using Tape.init_move_right_hasBinaryNat 0 + have hblankParked : TM.Parked TM.resetBinaryBlank := + ⟨by rw [hblankNat.2.1], hblankNat.2.hasBinaryContent.cells_ne_start⟩ + refine + { address := by + rw [initialLoopWork_lhs] + simpa only [programBinaryTape] using haddress + value := by + rw [initialLoopWork_rhs] + simpa only [programBinaryTape] using hvalue + count := by + rw [initialLoopWork_count] + simpa only [programBinaryTape] using hcount + buffer := by + rw [initialLoopWork_buffer] + exact programBinaryPrefixTape_hasBinaryPrefix _ + parked := ?_ + frame := initialLoopWork_other tapes address count entries } + intro i + by_cases hlhs : i = tapes.liftedLhs + · subst i + rw [initialLoopWork_lhs] + exact binaryTape_parked _ + by_cases hrhs : i = tapes.lifted.data.rhs + · subst i + rw [initialLoopWork_rhs] + exact binaryTape_parked _ + by_cases hcountIdx : i = tapes.lifted.data.update.remaining + · subst i + rw [initialLoopWork_count] + exact binaryTape_parked _ + by_cases hbuffer : i = tapes.buffer + · subst i + rw [initialLoopWork_buffer] + exact programBinaryPrefixTape_parked _ + · rw [initialLoopWork_other tapes address count entries i hlhs hrhs + hcountIdx hbuffer] + exact hblankParked + +private theorem parked_of_binaryNat {t : Tape} {value : ℕ} + (h : t.HasBinaryNat value) : TM.Parked t := + ⟨by rw [h.2.1], h.2.hasBinaryContent.cells_ne_start⟩ + +private theorem parked_of_binaryPrefix {t : Tape} {bits : List Bool} + (h : t.HasBinaryPrefix bits) : TM.Parked t := + ⟨by rw [h.1]; omega, + (show t.HasBinaryContent bits from h.2).cells_ne_start⟩ + +private theorem parked_of_binarySuffix {t : Tape} {bits : List Bool} + (h : t.HasBinarySuffix bits) : TM.Parked t := + ⟨h.1, h.2.2.2⟩ + +private def initialInputOneWrap (tapes : ControlInstructionTapes n) + (c : Complexity.Cfg (n + 1) (initialOneBitTM tapes).Q) : + Complexity.Cfg (n + 1) (initialInputLoopTM tapes).Q := + { state := .inr (.inl c.state) + input := c.input + work := c.work + output := c.output } + +private def initialInputZeroWrap (tapes : ControlInstructionTapes n) + (c : Complexity.Cfg (n + 1) (initialZeroBitTM tapes).Q) : + Complexity.Cfg (n + 1) (initialInputLoopTM tapes).Q := + { state := .inr (.inr c.state) + input := c.input + work := c.work + output := c.output } + +private theorem initialInputLoopTM_one_step + (tapes : ControlInstructionTapes n) + {c c' : Complexity.Cfg (n + 1) (initialOneBitTM tapes).Q} + (hstep : (initialOneBitTM tapes).step c = some c') : + (initialInputLoopTM tapes).step (initialInputOneWrap tapes c) = + some (initialInputOneWrap tapes c') := by + have hne : c.state ≠ (initialOneBitTM tapes).qhalt := + TM.state_ne_qhalt_of_step hstep + rw [TM.step, if_neg (by simp [initialInputOneWrap, initialInputLoopTM])] + simp only [initialInputOneWrap, initialInputLoopTM, hne, ↓reduceIte] + rw [TM.step, if_neg hne] at hstep + revert hstep + generalize (initialOneBitTM tapes).δ c.state c.input.read + (fun i => (c.work i).read) c.output.read = action + obtain ⟨state, workWrites, outputWrite, inputDir, workDirs, outputDir⟩ := + action + intro hstep + cases Option.some.inj hstep + rfl + +private theorem initialInputLoopTM_zero_step + (tapes : ControlInstructionTapes n) + {c c' : Complexity.Cfg (n + 1) (initialZeroBitTM tapes).Q} + (hstep : (initialZeroBitTM tapes).step c = some c') : + (initialInputLoopTM tapes).step (initialInputZeroWrap tapes c) = + some (initialInputZeroWrap tapes c') := by + have hne : c.state ≠ (initialZeroBitTM tapes).qhalt := + TM.state_ne_qhalt_of_step hstep + rw [TM.step, if_neg (by simp [initialInputZeroWrap, initialInputLoopTM])] + simp only [initialInputZeroWrap, initialInputLoopTM, hne, ↓reduceIte] + rw [TM.step, if_neg hne] at hstep + revert hstep + generalize (initialZeroBitTM tapes).δ c.state c.input.read + (fun i => (c.work i).read) c.output.read = action + obtain ⟨state, workWrites, outputWrite, inputDir, workDirs, outputDir⟩ := + action + intro hstep + cases Option.some.inj hstep + rfl + +private theorem initialInputLoopTM_one_reachesIn + (tapes : ControlInstructionTapes n) + {time : ℕ} {c c' : Complexity.Cfg (n + 1) (initialOneBitTM tapes).Q} + (hreach : (initialOneBitTM tapes).reachesIn time c c') : + (initialInputLoopTM tapes).reachesIn time + (initialInputOneWrap tapes c) (initialInputOneWrap tapes c') := + TM.reachesIn_map (initialInputOneWrap tapes) + (fun _ _ => initialInputLoopTM_one_step tapes) hreach + +private theorem initialInputLoopTM_zero_reachesIn + (tapes : ControlInstructionTapes n) + {time : ℕ} {c c' : Complexity.Cfg (n + 1) (initialZeroBitTM tapes).Q} + (hreach : (initialZeroBitTM tapes).reachesIn time c c') : + (initialInputLoopTM tapes).reachesIn time + (initialInputZeroWrap tapes c) (initialInputZeroWrap tapes c') := + TM.reachesIn_map (initialInputZeroWrap tapes) + (fun _ _ => initialInputLoopTM_zero_step tapes) hreach + +private theorem initialInputLoopTM_step_scan_one + (tapes : ControlInstructionTapes n) + (c : Complexity.Cfg (n + 1) (initialInputLoopTM tapes).Q) + (hstate : c.state = .inl .scan) (hone : c.input.read = Γ.one) + (hwork : ∀ i, (c.work i).read ≠ Γ.start) + (houtput : c.output.read ≠ Γ.start) : + (initialInputLoopTM tapes).step c = some + { state := .inr (.inl (initialOneBitTM tapes).qstart) + input := c.input + work := c.work + output := c.output } := by + rw [TM.step, if_neg (by rw [hstate]; simp [initialInputLoopTM])] + simp only [initialInputLoopTM, hstate, hone, TM.allReadBack, + reduceCtorEq, ↓reduceIte] + refine congrArg some ((Complexity.Cfg.mk.injEq ..).mpr + ⟨rfl, ?_, ?_, ?_⟩) + · simp [TM.idleDir, Tape.move] + · funext i + rw [TM.writeAndMove_readBack _ (hwork i), TM.idleDir, + if_neg (hwork i)] + rfl + · rw [TM.writeAndMove_readBack _ houtput, TM.idleDir, + if_neg houtput] + rfl + +private theorem initialInputLoopTM_step_scan_zero + (tapes : ControlInstructionTapes n) + (c : Complexity.Cfg (n + 1) (initialInputLoopTM tapes).Q) + (hstate : c.state = .inl .scan) (hzero : c.input.read = Γ.zero) + (hwork : ∀ i, (c.work i).read ≠ Γ.start) + (houtput : c.output.read ≠ Γ.start) : + (initialInputLoopTM tapes).step c = some + { state := .inr (.inr (initialZeroBitTM tapes).qstart) + input := c.input + work := c.work + output := c.output } := by + have hstart : c.input.read ≠ Γ.start := by rw [hzero]; decide + have hblank : c.input.read ≠ Γ.blank := by rw [hzero]; decide + have hone : c.input.read ≠ Γ.one := by rw [hzero]; decide + rw [TM.step, if_neg (by rw [hstate]; simp [initialInputLoopTM])] + simp only [initialInputLoopTM, hstate, hblank, hone, TM.allReadBack, + ↓reduceIte] + refine congrArg some ((Complexity.Cfg.mk.injEq ..).mpr + ⟨rfl, ?_, ?_, ?_⟩) + · simp [TM.idleDir, hstart, Tape.move] + · funext i + rw [TM.writeAndMove_readBack _ (hwork i), TM.idleDir, + if_neg (hwork i)] + rfl + · rw [TM.writeAndMove_readBack _ houtput, TM.idleDir, + if_neg houtput] + rfl + +private theorem initialInputLoopTM_step_scan_blank + (tapes : ControlInstructionTapes n) + (c : Complexity.Cfg (n + 1) (initialInputLoopTM tapes).Q) + (hstate : c.state = .inl .scan) (hblank : c.input.read = Γ.blank) + (hwork : ∀ i, (c.work i).read ≠ Γ.start) + (houtput : c.output.read ≠ Γ.start) : + (initialInputLoopTM tapes).step c = some + { state := .inl .done + input := c.input + work := c.work + output := c.output } := by + rw [TM.step, if_neg (by rw [hstate]; simp [initialInputLoopTM])] + simp only [initialInputLoopTM, hstate, hblank, TM.allReadBack, + ↓reduceIte] + refine congrArg some ((Complexity.Cfg.mk.injEq ..).mpr + ⟨rfl, ?_, ?_, ?_⟩) + · simp [TM.idleDir, Tape.move] + · funext i + rw [TM.writeAndMove_readBack _ (hwork i), TM.idleDir, + if_neg (hwork i)] + rfl + · rw [TM.writeAndMove_readBack _ houtput, TM.idleDir, + if_neg houtput] + rfl + +private theorem initialInputLoopTM_step_one_halt + (tapes : ControlInstructionTapes n) + (c : Complexity.Cfg (n + 1) (initialOneBitTM tapes).Q) + (hhalt : (initialOneBitTM tapes).halted c) + (hwork : ∀ i, (c.work i).read ≠ Γ.start) + (houtput : c.output.read ≠ Γ.start) : + (initialInputLoopTM tapes).step (initialInputOneWrap tapes c) = some + { state := .inl .scan + input := c.input.move Dir3.right + work := c.work + output := c.output } := by + rw [TM.step, + if_neg (by simp [initialInputOneWrap, initialInputLoopTM])] + simp only [initialInputOneWrap, initialInputLoopTM, hhalt, ↓reduceIte] + refine congrArg some ((Complexity.Cfg.mk.injEq ..).mpr + ⟨rfl, ?_, ?_, ?_⟩) + · rfl + · funext i + rw [TM.writeAndMove_readBack _ (hwork i), TM.idleDir, + if_neg (hwork i)] + rfl + · rw [TM.writeAndMove_readBack _ houtput, TM.idleDir, + if_neg houtput] + rfl + +private theorem initialInputLoopTM_step_zero_halt + (tapes : ControlInstructionTapes n) + (c : Complexity.Cfg (n + 1) (initialZeroBitTM tapes).Q) + (hhalt : (initialZeroBitTM tapes).halted c) + (hwork : ∀ i, (c.work i).read ≠ Γ.start) + (houtput : c.output.read ≠ Γ.start) : + (initialInputLoopTM tapes).step (initialInputZeroWrap tapes c) = some + { state := .inl .scan + input := c.input.move Dir3.right + work := c.work + output := c.output } := by + rw [TM.step, + if_neg (by simp [initialInputZeroWrap, initialInputLoopTM])] + simp only [initialInputZeroWrap, initialInputLoopTM, hhalt, ↓reduceIte] + refine congrArg some ((Complexity.Cfg.mk.injEq ..).mpr + ⟨rfl, ?_, ?_, ?_⟩) + · rfl + · funext i + rw [TM.writeAndMove_readBack _ (hwork i), TM.idleDir, + if_neg (hwork i)] + rfl + · rw [TM.writeAndMove_readBack _ houtput, TM.idleDir, + if_neg houtput] + rfl + +private theorem copyWorkToWorkTM_exact_hoareTime + (src dst : Fin n) (hne : src ≠ dst) (bits : List Bool) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hsrc : work₀ src = programBinaryTape bits) + (hdst : work₀ dst = TM.resetBinaryBlank) + (hinput : TM.Parked inp₀) (hwork : ∀ i, TM.Parked (work₀ i)) + (houtput : TM.Parked out₀) : + (TM.copyWorkToWorkTM src dst).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + work = Function.update + (Function.update work₀ src (programBinaryPrefixTape bits)) + dst (programBinaryPrefixTape bits) ∧ + out = out₀) + (bits.length + 1) := by + let P : Tape → (Fin n → Tape) → Tape → Prop := + fun inp work out => + inp = inp₀ ∧ out = out₀ ∧ + ∀ i, i ≠ src → i ≠ dst → work i = work₀ i + have hraw := TM.copyWorkToWorkTM_hoareTime_frame_of_binaryString + src dst hne bits (P := P) (by + intro inp work out inp' work' out' hP _ _ _ _ hinp' hout' hframe + rcases hP with ⟨hinp, hout, hworkFrame⟩ + exact ⟨hinp'.trans hinp, hout'.trans hout, + fun i hisrc hidst => (hframe i hisrc hidst).trans + (hworkFrame i hisrc hidst)⟩) + apply hraw.consequence + · rintro inp work out ⟨hinp, hworkEq, hout⟩ + subst inp + subst work + subst out + refine ⟨?_, ?_, hinput.read_ne_start, houtput.read_ne_start, + houtput.1, ?_, rfl, rfl, ?_⟩ + · simpa only [programBinaryTape] using hsrc + · simpa [TM.resetBinaryBlank] using hdst + · intro i _ _ + exact ⟨(hwork i).read_ne_start, (hwork i).1⟩ + · intro i _ _ + rfl + · intro inp work out hpost + rcases hpost with ⟨hsrcCells, hsrcHead, hdstPrefix, hdstStart, + hinp, hout, hframe⟩ + have hsrcEq : work src = programBinaryPrefixTape bits := by + apply Tape.ext + · simpa [programBinaryPrefixTape] using hsrcHead + · simpa [programBinaryPrefixTape] using hsrcCells + have hdstEq : work dst = programBinaryPrefixTape bits := by + apply Tape.ext + · simpa [programBinaryPrefixTape] using hdstPrefix.1 + · rw [programBinaryPrefixTape] + exact hdstPrefix.cells_eq_init hdstStart + refine ⟨hinp, ?_, hout⟩ + funext i + by_cases hidst : i = dst + · subst i + simp [hdstEq] + · by_cases hisrc : i = src + · subst i + simp [hne, hsrcEq] + · simp [hidst, hisrc, hframe i hisrc hidst] + · exact le_rfl + +private def initialAbiCountWork (tapes : ControlInstructionTapes n) + (work : Fin (n + 1) → Tape) (count : ℕ) : Fin (n + 1) → Tape := + Function.update work tapes.lifted.data.update.resultCount + (programBinaryTape count.bits) + +private def initialAbiBufferWork (tapes : ControlInstructionTapes n) + (work : Fin (n + 1) → Tape) (store : Store) : Fin (n + 1) → Tape := + Function.update work tapes.buffer + (programBinaryTape (store.flatMap Entry.encode)) + +private def initialAbiCopiedWork (tapes : ControlInstructionTapes n) + (work : Fin (n + 1) → Tape) (store : Store) : Fin (n + 1) → Tape := + Function.update + (Function.update work tapes.buffer + (programBinaryPrefixTape (store.flatMap Entry.encode))) + tapes.liftedSource + (programBinaryPrefixTape (store.flatMap Entry.encode)) + +private def initialAbiSourceWork (tapes : ControlInstructionTapes n) + (work : Fin (n + 1) → Tape) (store : Store) : Fin (n + 1) → Tape := + Function.update work tapes.liftedSource + (programBinaryTape (store.flatMap Entry.encode)) + +private def initialAbiBufferResetWork (tapes : ControlInstructionTapes n) + (work : Fin (n + 1) → Tape) : Fin (n + 1) → Tape := + Function.update work tapes.buffer TM.resetBinaryBlank + +private def initialAbiFinalWork (tapes : ControlInstructionTapes n) + (work : Fin (n + 1) → Tape) : Fin (n + 1) → Tape := + TM.resetBinaryWorkManyResult work (initialCleanupTargets tapes) + +private theorem eq_programBinaryPrefixTape_of_hasBinaryPrefix + {t : Tape} {bits : List Bool} (hprefix : t.HasBinaryPrefix bits) + (hstart : t.cells 0 = Γ.start) : + t = programBinaryPrefixTape bits := by + apply Tape.ext + · simpa [programBinaryPrefixTape] using hprefix.1 + · rw [programBinaryPrefixTape] + exact hprefix.cells_eq_init hstart + +private theorem parked_update {work : Fin n → Tape} {idx : Fin n} + {tape : Tape} (hwork : ∀ i, TM.Parked (work i)) + (htape : TM.Parked tape) : + ∀ i, TM.Parked (Function.update work idx tape i) := by + intro i + by_cases hi : i = idx + · subst i + simp [htape] + · simp [hi, hwork i] + +private theorem exact_phaseTransition_of_parked + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hinput : TM.Parked inp₀) (hwork : ∀ i, TM.Parked (work₀ i)) + (houtput : TM.Parked out₀) : + ∀ inp work out, + (inp = inp₀ ∧ work = work₀ ∧ out = out₀) → + TM.transitionInput inp = inp₀ ∧ + (fun i => TM.transitionTape (work i)) = work₀ ∧ + TM.transitionTape out = out₀ := by + rintro inp work out ⟨rfl, rfl, rfl⟩ + exact TM.phaseTransition_eq_self_of_reads_ne_start + hinput.read_ne_start (fun i => (hwork i).read_ne_start) + houtput.read_ne_start + +private theorem rewindPrefixWorkTM_exact_hoareTime + (idx : Fin n) (bits : List Bool) (inp₀ : Tape) + (work₀ : Fin n → Tape) (out₀ : Tape) + (htarget : work₀ idx = programBinaryPrefixTape bits) + (hinput : TM.Parked inp₀) (hwork : ∀ i, TM.Parked (work₀ i)) + (houtput : TM.Parked out₀) : + (TM.rewindWorkTM idx).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + work = Function.update work₀ idx (programBinaryTape bits) ∧ + out = out₀) + (bits.length + 1 + 2) := by + have hprefix := programBinaryPrefixTape_hasBinaryPrefix bits + have hraw := TM.rewindBinaryWorkTM_hoareTime_frame idx bits + (bits.length + 1) inp₀ work₀ out₀ + (by rw [htarget]; exact hprefix.2) + (by rw [htarget]; simp [programBinaryPrefixTape]) + (by rw [htarget]; simp [programBinaryPrefixTape]) + hinput (fun i _ => hwork i) houtput + apply hraw.consequence + · exact fun _ _ _ h => h + · rintro inp work out ⟨hinp, hidx, hframe, hout⟩ + refine ⟨hinp, ?_, hout⟩ + funext i + by_cases hi : i = idx + · subst i + simp [hidx, programBinaryTape] + · simp [hi, hframe i hi] + · exact le_rfl + +private theorem initialAbiFinalWork_eq_programSnapshotWork + (tapes : ControlInstructionTapes n) (store : Store) (length : ℕ) + (work₀ : Fin (n + 1) → Tape) + (hready : InitialLoopReady tapes length store.length store work₀) : + initialAbiFinalWork tapes + (initialAbiBufferResetWork tapes + (initialAbiSourceWork tapes + (initialAbiCopiedWork tapes + (initialAbiBufferWork tapes + (initialAbiCountWork tapes work₀ store.length) store) + store) + store)) = + programSnapshotWork tapes { pc := 0, store := store } := by + have hsourceLhs : tapes.liftedSource ≠ tapes.liftedLhs := + tapes.lifted.data.ne (by decide) + have hsourceRhs : tapes.liftedSource ≠ tapes.lifted.data.rhs := + tapes.lifted.data.ne (by decide) + have hsourceRemaining : tapes.liftedSource ≠ + tapes.lifted.data.update.remaining := tapes.lifted.data.ne (by decide) + have hsourceResult : tapes.liftedSource ≠ + tapes.lifted.data.update.resultCount := tapes.lifted.data.ne (by decide) + have hlhsRhs : tapes.liftedLhs ≠ tapes.lifted.data.rhs := + tapes.lifted.data.ne (by decide) + have hlhsRemaining : tapes.liftedLhs ≠ + tapes.lifted.data.update.remaining := tapes.lifted.data.ne (by decide) + have hlhsResult : tapes.liftedLhs ≠ + tapes.lifted.data.update.resultCount := tapes.lifted.data.ne (by decide) + have hrhsRemaining : tapes.lifted.data.rhs ≠ + tapes.lifted.data.update.remaining := tapes.lifted.data.ne (by decide) + have hrhsResult : tapes.lifted.data.rhs ≠ + tapes.lifted.data.update.resultCount := tapes.lifted.data.ne (by decide) + have hremainingResult : tapes.lifted.data.update.remaining ≠ + tapes.lifted.data.update.resultCount := tapes.lifted.data.ne (by decide) + have hlhsSource := hsourceLhs.symm + have hrhsSource := hsourceRhs.symm + have hremainingSource := hsourceRemaining.symm + have hresultSource := hsourceResult.symm + have hrhsLhs := hlhsRhs.symm + have hremainingLhs := hlhsRemaining.symm + have hresultLhs := hlhsResult.symm + have hremainingRhs := hrhsRemaining.symm + have hresultRhs := hrhsResult.symm + have hresultRemaining := hremainingResult.symm + have hsourcePC : tapes.liftedSource ≠ tapes.liftedPC := + tapes.liftedPC_ne_source.symm + have hlhsPC : tapes.liftedLhs ≠ tapes.liftedPC := + tapes.lifted.lhs_ne_pc + have hrhsPC : tapes.lifted.data.rhs ≠ tapes.liftedPC := + tapes.lifted.data_ne_pc 14 + have hremainingPC : tapes.lifted.data.update.remaining ≠ + tapes.liftedPC := tapes.lifted.data_ne_pc 9 + have hresultPC : tapes.lifted.data.update.resultCount ≠ + tapes.liftedPC := tapes.lifted.data_ne_pc 12 + have hsourceBuffer : tapes.liftedSource ≠ tapes.buffer := + tapes.liftedSource_ne_buffer + have hlhsBuffer : tapes.liftedLhs ≠ tapes.buffer := + tapes.liftedData_ne_buffer 13 + have hrhsBuffer : tapes.lifted.data.rhs ≠ tapes.buffer := + tapes.liftedData_ne_buffer 14 + have hremainingBuffer : tapes.lifted.data.update.remaining ≠ + tapes.buffer := tapes.liftedData_ne_buffer 9 + have hresultBuffer : tapes.lifted.data.update.resultCount ≠ + tapes.buffer := tapes.liftedData_ne_buffer 12 + have hpcBuffer : tapes.liftedPC ≠ tapes.buffer := + tapes.liftedPC_ne_buffer + have hcountEq : + work₀ tapes.lifted.data.update.remaining = + programBinaryTape store.length.bits := by + simpa only [programBinaryTape] using hready.count.eq_init_move_right + funext i + by_cases hlhs : i = tapes.liftedLhs + · subst i + simp_all [initialAbiFinalWork, initialAbiBufferResetWork, + initialAbiSourceWork, initialAbiCopiedWork, initialAbiBufferWork, + initialAbiCountWork, initialCleanupTargets, + TM.resetBinaryWorkManyResult, programSnapshotWork, + programBinaryTape, TM.resetBinaryBlank] + by_cases hrhs : i = tapes.lifted.data.rhs + · subst i + simp_all [initialAbiFinalWork, initialAbiBufferResetWork, + initialAbiSourceWork, initialAbiCopiedWork, initialAbiBufferWork, + initialAbiCountWork, initialCleanupTargets, + TM.resetBinaryWorkManyResult, programSnapshotWork, + programBinaryTape, TM.resetBinaryBlank] + by_cases hsource : i = tapes.liftedSource + · subst i + simp_all [initialAbiFinalWork, initialAbiBufferResetWork, + initialAbiSourceWork, initialAbiCopiedWork, initialAbiBufferWork, + initialAbiCountWork, initialCleanupTargets, + TM.resetBinaryWorkManyResult, programSnapshotWork] + by_cases hremaining : i = tapes.lifted.data.update.remaining + · subst i + simp_all [initialAbiFinalWork, initialAbiBufferResetWork, + initialAbiSourceWork, initialAbiCopiedWork, initialAbiBufferWork, + initialAbiCountWork, initialCleanupTargets, + TM.resetBinaryWorkManyResult, programSnapshotWork] + by_cases hresult : i = tapes.lifted.data.update.resultCount + · subst i + simp_all [initialAbiFinalWork, initialAbiBufferResetWork, + initialAbiSourceWork, initialAbiCopiedWork, initialAbiBufferWork, + initialAbiCountWork, initialCleanupTargets, + TM.resetBinaryWorkManyResult, programSnapshotWork] + by_cases hpc : i = tapes.liftedPC + · subst i + have hpcBlank : work₀ tapes.liftedPC = TM.resetBinaryBlank := + hready.frame _ tapes.lifted.lhs_ne_pc.symm + (tapes.lifted.data_ne_pc 14).symm + (tapes.lifted.data_ne_pc 9).symm tapes.liftedPC_ne_buffer + simp_all [initialAbiFinalWork, initialAbiBufferResetWork, + initialAbiSourceWork, initialAbiCopiedWork, initialAbiBufferWork, + initialAbiCountWork, initialCleanupTargets, + TM.resetBinaryWorkManyResult, programSnapshotWork, programBinaryTape, + TM.resetBinaryBlank] + by_cases hbuffer : i = tapes.buffer + · subst i + simp_all [initialAbiFinalWork, initialAbiBufferResetWork, + initialAbiSourceWork, initialAbiCopiedWork, initialAbiBufferWork, + initialAbiCountWork, initialCleanupTargets, + TM.resetBinaryWorkManyResult, programSnapshotWork, + programBinaryTape, TM.resetBinaryBlank] + have hblank := hready.frame i hlhs hrhs hremaining hbuffer + simp_all [initialAbiFinalWork, initialAbiBufferResetWork, + initialAbiSourceWork, initialAbiCopiedWork, initialAbiBufferWork, + initialAbiCountWork, initialCleanupTargets, + TM.resetBinaryWorkManyResult, programSnapshotWork] + +/-- A zero input bit preserves the streaming frame and advances only the +current register address. -/ +theorem initialZeroBitTM_hoareTime_internal + (tapes : ControlInstructionTapes n) (address count : ℕ) + (entries : Store) (inp₀ : Tape) (work₀ : Fin (n + 1) → Tape) + (out₀ : Tape) (hready : InitialLoopReady tapes address count entries work₀) + (hinput : TM.Parked inp₀) (houtput : TM.Parked out₀) : + (initialZeroBitTM tapes).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + InitialLoopReady tapes (address + 1) count entries work ∧ + out = out₀) + (TM.binarySuccTime address) := by + have hrun := TM.binarySuccTM_hoareTime_frame tapes.liftedLhs address + inp₀ work₀ out₀ hready.address hinput.read_ne_start + (fun i _ => (hready.parked i).read_ne_start) houtput.read_ne_start + intro inp work out hpre + obtain ⟨c, time, htime, hreach, hhalt, hinputEq, hframe, + haddress, houtputEq⟩ := hrun inp work out hpre + refine ⟨c, time, htime, hreach, hhalt, hinputEq, ?_, houtputEq⟩ + refine + { address := haddress + value := by + rw [hframe tapes.lifted.data.rhs (tapes.lifted.data.ne (by decide))] + exact hready.value + count := by + rw [hframe tapes.lifted.data.update.remaining + (tapes.lifted.data.ne (by decide))] + exact hready.count + buffer := by + rw [hframe tapes.buffer (tapes.liftedData_ne_buffer 13).symm] + exact hready.buffer + parked := ?_ + frame := ?_ } + · intro i + by_cases hi : i = tapes.liftedLhs + · subst i + exact parked_of_binaryNat haddress + · rw [hframe i hi] + exact hready.parked i + · intro i hlhs hrhs hcount hbuffer + rw [hframe i hlhs] + exact hready.frame i hlhs hrhs hcount hbuffer + +/-- A one input bit appends the current `(address, 1)` entry and advances the +entry count and current address, restoring every reusable source cursor. -/ +theorem initialOneBitTM_hoareTime_internal + (tapes : ControlInstructionTapes n) (address count : ℕ) + (entries : Store) (inp₀ : Tape) (work₀ : Fin (n + 1) → Tape) + (out₀ : Tape) (hready : InitialLoopReady tapes address count entries work₀) + (hinput : TM.Parked inp₀) (houtput : out₀ = TM.resetBinaryBlank) : + (initialOneBitTM tapes).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + InitialLoopReady tapes (address + 1) (count + 1) + (entries ++ [(address, 1)]) work ∧ + out = out₀) + (rewindEntryEncodeRestoreTime (address, 1) + 1 + + (TM.binarySuccTime count + 1 + TM.binarySuccTime address)) := by + intro inp work out hpre + rcases hpre with ⟨hinp, hwork, hout⟩ + subst inp + subst work + subst out + let baseWork : Fin n → Tape := fun i => work₀ (Fin.castSucc i) + have hbaseAddress : + (baseWork (initialBitEntryTapes tapes).address).HasBinaryNat address := by + exact hready.address + have hbaseValue : + (baseWork (initialBitEntryTapes tapes).value).HasBinaryNat 1 := by + exact hready.value + have hbase := rewindEntryEncodeRestoreTM_hoareTime_frame + (initialBitEntryTapes tapes) (address, 1) + (entries.flatMap Entry.encode) inp₀ baseWork (work₀ tapes.buffer) + hbaseAddress hbaseValue hinput + (fun i _ _ => hready.parked (Fin.castSucc i)) hready.buffer + have hlift := TM.retargetOutput_hoareTime + (rewindEntryEncodeRestoreTM (initialBitEntryTapes tapes)) hbase + obtain ⟨emitted, emitTime, hemitTime, hemitReach, hemitHalt, + hemitPost, hemitOutput⟩ := + hlift inp₀ work₀ out₀ + ⟨⟨rfl, rfl, rfl⟩, by simpa [TM.resetBinaryBlank] using houtput⟩ + rcases hemitPost with ⟨hemitInput, hemitBaseWork, hemitBuffer⟩ + have hemitOutput' : emitted.output = out₀ := by + exact hemitOutput.trans (by simpa [TM.resetBinaryBlank] using houtput.symm) + have hemitFrame (i : Fin (n + 1)) (hi : i ≠ tapes.buffer) : + emitted.work i = work₀ i := by + have hil : i.val < n := by + have hle : i.val ≤ n := by omega + have hne : i.val ≠ n := by + intro hval + apply hi + apply Fin.ext + simpa [ControlInstructionTapes.buffer] using hval + omega + let j : Fin n := ⟨i.val, hil⟩ + have hij : i = Fin.castSucc j := by + apply Fin.ext + rfl + rw [hij] + exact congrFun hemitBaseWork j + have hemitInputParked : TM.Parked emitted.input := by + rw [hemitInput] + exact hinput + have hemitOutputParked : TM.Parked emitted.output := by + rw [hemitOutput'] + rw [houtput] + have hblankNat : TM.resetBinaryBlank.HasBinaryNat 0 := by + simpa [TM.resetBinaryBlank] using Tape.init_move_right_hasBinaryNat 0 + exact parked_of_binaryNat hblankNat + have hemitWorkParked : ∀ i, TM.Parked (emitted.work i) := by + intro i + by_cases hi : i = tapes.buffer + · subst i + exact parked_of_binaryPrefix hemitBuffer + · rw [hemitFrame i hi] + exact hready.parked i + have hremainingBuffer : tapes.lifted.data.update.remaining ≠ + tapes.buffer := tapes.liftedData_ne_buffer 9 + have hlhsBuffer : tapes.liftedLhs ≠ tapes.buffer := + tapes.liftedData_ne_buffer 13 + have hrhsBuffer : tapes.lifted.data.rhs ≠ tapes.buffer := + tapes.liftedData_ne_buffer 14 + have hlhsRemaining : tapes.liftedLhs ≠ + tapes.lifted.data.update.remaining := + tapes.lifted.data.ne (by decide) + have hremainingLhs : tapes.lifted.data.update.remaining ≠ + tapes.liftedLhs := hlhsRemaining.symm + have hrhsLhs : tapes.lifted.data.rhs ≠ tapes.liftedLhs := + tapes.lifted.data.ne (by decide) + have hrhsRemaining : tapes.lifted.data.rhs ≠ + tapes.lifted.data.update.remaining := + tapes.lifted.data.ne (by decide) + have hemitCount : + (emitted.work tapes.lifted.data.update.remaining).HasBinaryNat count := by + rw [hemitFrame _ hremainingBuffer] + exact hready.count + have hcountRun := TM.binarySuccTM_hoareTime_frame + tapes.lifted.data.update.remaining count emitted.input emitted.work + emitted.output hemitCount hemitInputParked.read_ne_start + (fun i _ => (hemitWorkParked i).read_ne_start) + hemitOutputParked.read_ne_start + obtain ⟨counted, countTime, hcountTime, hcountReach, hcountHalt, + hcountInput, hcountFrame, hcountValue, hcountOutput⟩ := + hcountRun emitted.input emitted.work emitted.output ⟨rfl, rfl, rfl⟩ + have hcountInputParked : TM.Parked counted.input := by + rw [hcountInput] + exact hemitInputParked + have hcountOutputParked : TM.Parked counted.output := by + rw [hcountOutput] + exact hemitOutputParked + have hcountWorkParked : ∀ i, TM.Parked (counted.work i) := by + intro i + by_cases hi : i = tapes.lifted.data.update.remaining + · subst i + exact parked_of_binaryNat hcountValue + · rw [hcountFrame i hi] + exact hemitWorkParked i + have hcountAddress : + (counted.work tapes.liftedLhs).HasBinaryNat address := by + rw [hcountFrame _ hlhsRemaining] + rw [hemitFrame _ hlhsBuffer] + exact hready.address + have haddressRun := TM.binarySuccTM_hoareTime_frame tapes.liftedLhs + address counted.input counted.work counted.output hcountAddress + hcountInputParked.read_ne_start + (fun i _ => (hcountWorkParked i).read_ne_start) + hcountOutputParked.read_ne_start + obtain ⟨advanced, addressTime, haddressTime, haddressReach, + haddressHalt, haddressInput, haddressFrame, haddressValue, + haddressOutput⟩ := + haddressRun counted.input counted.work counted.output ⟨rfl, rfl, rfl⟩ + obtain ⟨hcountInputTransition, hcountWorkTransition, + hcountOutputTransition⟩ := + TM.phaseTransition_eq_self_of_reads_ne_start + hcountInputParked.read_ne_start + (fun i => (hcountWorkParked i).read_ne_start) + hcountOutputParked.read_ne_start + have haddressReach' : (TM.binarySuccTM tapes.liftedLhs).reachesIn + addressTime + { state := (TM.binarySuccTM tapes.liftedLhs).qstart + input := TM.transitionInput counted.input + work := fun i => TM.transitionTape (counted.work i) + output := TM.transitionTape counted.output } + advanced := by + simpa only [hcountInputTransition, hcountWorkTransition, + hcountOutputTransition] using haddressReach + have htailReach := TM.seqTM_reachesIn_of_reachesIn + (TM.binarySuccTM tapes.lifted.data.update.remaining) + (TM.binarySuccTM tapes.liftedLhs) hcountReach hcountHalt haddressReach' + let tailFinal := TM.phase2Wrap + (TM.binarySuccTM tapes.lifted.data.update.remaining) + (TM.binarySuccTM tapes.liftedLhs) advanced + have htailHalt : + (TM.seqTM (TM.binarySuccTM tapes.lifted.data.update.remaining) + (TM.binarySuccTM tapes.liftedLhs)).halted tailFinal := by + rw [TM.phase2Wrap_halted_iff] + exact haddressHalt + obtain ⟨hemitInputTransition, hemitWorkTransition, + hemitOutputTransition⟩ := + TM.phaseTransition_eq_self_of_reads_ne_start + hemitInputParked.read_ne_start + (fun i => (hemitWorkParked i).read_ne_start) + hemitOutputParked.read_ne_start + have htailReach' : + (TM.seqTM (TM.binarySuccTM tapes.lifted.data.update.remaining) + (TM.binarySuccTM tapes.liftedLhs)).reachesIn + (countTime + 1 + addressTime) + { state := + (TM.seqTM (TM.binarySuccTM tapes.lifted.data.update.remaining) + (TM.binarySuccTM tapes.liftedLhs)).qstart + input := TM.transitionInput emitted.input + work := fun i => TM.transitionTape (emitted.work i) + output := TM.transitionTape emitted.output } + tailFinal := by + simpa only [hemitInputTransition, hemitWorkTransition, + hemitOutputTransition] using htailReach + have hreach := TM.seqTM_reachesIn_of_reachesIn + (rewindEntryEncodeRestoreTM (initialBitEntryTapes tapes)).retargetOutput + (TM.seqTM (TM.binarySuccTM tapes.lifted.data.update.remaining) + (TM.binarySuccTM tapes.liftedLhs)) + hemitReach hemitHalt htailReach' + let finalCfg := TM.phase2Wrap + (rewindEntryEncodeRestoreTM (initialBitEntryTapes tapes)).retargetOutput + (TM.seqTM (TM.binarySuccTM tapes.lifted.data.update.remaining) + (TM.binarySuccTM tapes.liftedLhs)) tailFinal + refine ⟨finalCfg, emitTime + 1 + (countTime + 1 + addressTime), + ?_, hreach, ?_, ?_⟩ + · omega + · change (initialOneBitTM tapes).halted finalCfg + unfold initialOneBitTM + rw [TM.phase2Wrap_halted_iff] + exact htailHalt + · refine ⟨?_, ?_, ?_⟩ + · change advanced.input = inp₀ + exact haddressInput.trans (hcountInput.trans hemitInput) + · refine + { address := by + change (advanced.work tapes.liftedLhs).HasBinaryNat (address + 1) + exact haddressValue + value := ?_ + count := ?_ + buffer := ?_ + parked := ?_ + frame := ?_ } + · change (advanced.work tapes.lifted.data.rhs).HasBinaryNat 1 + rw [haddressFrame _ hrhsLhs, hcountFrame _ hrhsRemaining, + hemitFrame _ hrhsBuffer] + exact hready.value + · change (advanced.work + tapes.lifted.data.update.remaining).HasBinaryNat (count + 1) + rw [haddressFrame _ hremainingLhs] + exact hcountValue + · change (advanced.work tapes.buffer).HasBinaryPrefix + ((entries ++ [(address, 1)]).flatMap Entry.encode) + rw [haddressFrame _ hlhsBuffer.symm, + hcountFrame _ hremainingBuffer.symm] + simpa [List.flatMap_append] using hemitBuffer + · intro i + change TM.Parked (advanced.work i) + by_cases hi : i = tapes.liftedLhs + · subst i + exact parked_of_binaryNat haddressValue + · rw [haddressFrame i hi] + exact hcountWorkParked i + · intro i hlhs hrhs hcountIdx hbuffer + change advanced.work i = TM.resetBinaryBlank + rw [haddressFrame i hlhs, hcountFrame i hcountIdx, + hemitFrame i hbuffer] + exact hready.frame i hlhs hrhs hcountIdx hbuffer + · change advanced.output = out₀ + exact haddressOutput.trans (hcountOutput.trans hemitOutput') + +/-- The custom scanner consumes exactly the advertised Boolean suffix, +streaming its nonzero entries into the sparse-store buffer. -/ +theorem initialInputLoopTM_hoareTime_internal + (tapes : ControlInstructionTapes n) (input : List Bool) + (address count : ℕ) (entries : Store) + (inp₀ : Tape) (work₀ : Fin (n + 1) → Tape) (out₀ : Tape) + (hinput : inp₀.HasBinarySuffix input) + (hready : InitialLoopReady tapes address count entries work₀) + (houtput : out₀ = TM.resetBinaryBlank) : + (initialInputLoopTM tapes).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp.HasBinarySuffix [] ∧ + InitialLoopReady tapes (address + input.length) + (count + inputTrueCount input) + (entries ++ inputBitStoreFrom address input) work ∧ + out = out₀) + (initialInputLoopTime tapes address count input) := by + induction input generalizing address count entries inp₀ work₀ out₀ with + | nil => + intro inp work out hpre + rcases hpre with ⟨hinp, hwork, hout⟩ + subst inp + subst work + subst out + let done : Complexity.Cfg (n + 1) (initialInputLoopTM tapes).Q := + { state := .inl .done + input := inp₀ + work := work₀ + output := out₀ } + have hstep := initialInputLoopTM_step_scan_blank tapes + ({ state := (initialInputLoopTM tapes).qstart + input := inp₀ + work := work₀ + output := out₀ } : + Complexity.Cfg (n + 1) (initialInputLoopTM tapes).Q) + rfl hinput.read_nil + (fun i => (hready.parked i).read_ne_start) + (by + rw [houtput] + have hblankNat : TM.resetBinaryBlank.HasBinaryNat 0 := by + simpa [TM.resetBinaryBlank] using + Tape.init_move_right_hasBinaryNat 0 + exact (parked_of_binaryNat hblankNat).read_ne_start) + refine ⟨done, 1, by simp [initialInputLoopTime], + .step (by simpa [done] using hstep) .zero, ?_, ?_⟩ + · change done.state = (initialInputLoopTM tapes).qhalt + rfl + · exact ⟨hinput, by simpa [inputTrueCount, inputBitStoreFrom], rfl⟩ + | cons bit rest ih => + intro inp work out hpre + rcases hpre with ⟨hinp, hwork, hout⟩ + subst inp + subst work + subst out + let scan : Complexity.Cfg (n + 1) (initialInputLoopTM tapes).Q := + { state := (initialInputLoopTM tapes).qstart + input := inp₀ + work := work₀ + output := out₀ } + have hinputParked : TM.Parked inp₀ := parked_of_binarySuffix hinput + have houtputParked : TM.Parked out₀ := by + rw [houtput] + have hblankNat : TM.resetBinaryBlank.HasBinaryNat 0 := by + simpa [TM.resetBinaryBlank] using Tape.init_move_right_hasBinaryNat 0 + exact parked_of_binaryNat hblankNat + cases bit with + | false => + let bodyStart : Complexity.Cfg (n + 1) + (initialZeroBitTM tapes).Q := + { state := (initialZeroBitTM tapes).qstart + input := inp₀ + work := work₀ + output := out₀ } + have hread : inp₀.read = Γ.zero := by + simpa [Γ.ofBool] using hinput.read_cons + have hscanStep := initialInputLoopTM_step_scan_zero tapes scan + rfl hread (fun i => (hready.parked i).read_ne_start) + houtputParked.read_ne_start + have hscanReach : (initialInputLoopTM tapes).reachesIn 1 scan + (initialInputZeroWrap tapes bodyStart) := + .step (by simpa [scan, bodyStart, initialInputZeroWrap] using + hscanStep) .zero + have hbody := initialZeroBitTM_hoareTime_internal tapes address + count entries inp₀ work₀ out₀ hready hinputParked + houtputParked + obtain ⟨bodyDone, bodyTime, hbodyTime, hbodyReach, hbodyHalt, + hbodyInput, hbodyReady, hbodyOutput⟩ := + hbody inp₀ work₀ out₀ ⟨rfl, rfl, rfl⟩ + have hbodyLift := initialInputLoopTM_zero_reachesIn tapes hbodyReach + let nextScan : Complexity.Cfg (n + 1) + (initialInputLoopTM tapes).Q := + { state := .inl .scan + input := bodyDone.input.move Dir3.right + work := bodyDone.work + output := bodyDone.output } + have hseamStep := initialInputLoopTM_step_zero_halt tapes bodyDone + hbodyHalt (fun i => (hbodyReady.parked i).read_ne_start) + (by rw [hbodyOutput]; exact houtputParked.read_ne_start) + have hseamReach : (initialInputLoopTM tapes).reachesIn 1 + (initialInputZeroWrap tapes bodyDone) nextScan := + .step (by simpa [nextScan] using hseamStep) .zero + have hnextInput : + (bodyDone.input.move Dir3.right).HasBinarySuffix rest := by + rw [hbodyInput] + exact hinput.move_right_cons + have hnextOutput : bodyDone.output = TM.resetBinaryBlank := + hbodyOutput.trans houtput + have htail := ih (address + 1) count entries + (bodyDone.input.move Dir3.right) bodyDone.work bodyDone.output + hnextInput hbodyReady hnextOutput + obtain ⟨tailDone, tailTime, htailTime, htailReach, htailHalt, + htailInput, htailReady, htailOutput⟩ := + htail _ _ _ ⟨rfl, rfl, rfl⟩ + have hreach := TM.reachesIn_trans (initialInputLoopTM tapes) + hscanReach (TM.reachesIn_trans (initialInputLoopTM tapes) + hbodyLift (TM.reachesIn_trans (initialInputLoopTM tapes) + hseamReach htailReach)) + refine ⟨tailDone, 1 + bodyTime + 1 + tailTime, ?_, ?_, + htailHalt, ?_⟩ + · simp only [initialInputLoopTime, Bool.false_eq_true, + if_false, Nat.add_zero] + omega + · simpa [Nat.add_assoc] using hreach + · refine ⟨htailInput, ?_, htailOutput.trans hbodyOutput⟩ + simpa [inputTrueCount, inputBitStoreFrom, Nat.add_assoc, + Nat.add_comm, Nat.add_left_comm] using htailReady + | true => + let bodyStart : Complexity.Cfg (n + 1) + (initialOneBitTM tapes).Q := + { state := (initialOneBitTM tapes).qstart + input := inp₀ + work := work₀ + output := out₀ } + have hread : inp₀.read = Γ.one := by + simpa [Γ.ofBool] using hinput.read_cons + have hscanStep := initialInputLoopTM_step_scan_one tapes scan + rfl hread (fun i => (hready.parked i).read_ne_start) + houtputParked.read_ne_start + have hscanReach : (initialInputLoopTM tapes).reachesIn 1 scan + (initialInputOneWrap tapes bodyStart) := + .step (by simpa [scan, bodyStart, initialInputOneWrap] using + hscanStep) .zero + have hbody := initialOneBitTM_hoareTime_internal tapes address + count entries inp₀ work₀ out₀ hready hinputParked houtput + obtain ⟨bodyDone, bodyTime, hbodyTime, hbodyReach, hbodyHalt, + hbodyInput, hbodyReady, hbodyOutput⟩ := + hbody inp₀ work₀ out₀ ⟨rfl, rfl, rfl⟩ + have hbodyLift := initialInputLoopTM_one_reachesIn tapes hbodyReach + let nextScan : Complexity.Cfg (n + 1) + (initialInputLoopTM tapes).Q := + { state := .inl .scan + input := bodyDone.input.move Dir3.right + work := bodyDone.work + output := bodyDone.output } + have hseamStep := initialInputLoopTM_step_one_halt tapes bodyDone + hbodyHalt (fun i => (hbodyReady.parked i).read_ne_start) + (by rw [hbodyOutput]; exact houtputParked.read_ne_start) + have hseamReach : (initialInputLoopTM tapes).reachesIn 1 + (initialInputOneWrap tapes bodyDone) nextScan := + .step (by simpa [nextScan] using hseamStep) .zero + have hnextInput : + (bodyDone.input.move Dir3.right).HasBinarySuffix rest := by + rw [hbodyInput] + exact hinput.move_right_cons + have hnextOutput : bodyDone.output = TM.resetBinaryBlank := + hbodyOutput.trans houtput + have htail := ih (address + 1) (count + 1) + (entries ++ [(address, 1)]) + (bodyDone.input.move Dir3.right) bodyDone.work bodyDone.output + hnextInput hbodyReady hnextOutput + obtain ⟨tailDone, tailTime, htailTime, htailReach, htailHalt, + htailInput, htailReady, htailOutput⟩ := + htail _ _ _ ⟨rfl, rfl, rfl⟩ + have hreach := TM.reachesIn_trans (initialInputLoopTM tapes) + hscanReach (TM.reachesIn_trans (initialInputLoopTM tapes) + hbodyLift (TM.reachesIn_trans (initialInputLoopTM tapes) + hseamReach htailReach)) + refine ⟨tailDone, 1 + bodyTime + 1 + tailTime, ?_, ?_, + htailHalt, ?_⟩ + · simp only [initialInputLoopTime, if_true] + omega + · simpa [Nat.add_assoc] using hreach + · refine ⟨htailInput, ?_, htailOutput.trans hbodyOutput⟩ + simpa [inputTrueCount, inputBitStoreFrom, List.append_assoc, + Nat.add_assoc, Nat.add_comm, Nat.add_left_comm] using htailReady + +/-- The setup phase turns the standard all-heads-on-marker configuration into +the exact address-one/count-zero streaming boundary. -/ +theorem initialSetupTM_hoareTime_internal + (tapes : ControlInstructionTapes n) (input : List Bool) : + (initialSetupTM tapes).HoareTime + (fun inp work out => + inp = Tape.init (input.map Γ.ofBool) ∧ + work = (fun _ => Tape.init []) ∧ out = Tape.init []) + (fun inp work out => + inp.HasBinarySuffix input ∧ + inp = (Tape.init (input.map Γ.ofBool)).move Dir3.right ∧ + InitialLoopReady tapes 1 0 [] work ∧ + out = TM.resetBinaryBlank) + (1 + 1 + (TM.binarySuccTime 0 + 1 + TM.binarySuccTime 0)) := by + intro inp work out hpre + rcases hpre with ⟨hinp, hwork, hout⟩ + subst inp + subst work + subst out + let parkedInput := (Tape.init (input.map Γ.ofBool)).move Dir3.right + let parkedWork : Fin (n + 1) → Tape := fun _ => TM.resetBinaryBlank + let skipped : Complexity.Cfg (n + 1) (TM.skipTM (n := n + 1)).Q := + { state := (TM.skipTM (n := n + 1)).qhalt + input := parkedInput + work := parkedWork + output := TM.resetBinaryBlank } + have hskipStep : (TM.skipTM (n := n + 1)).step + { state := (TM.skipTM (n := n + 1)).qstart + input := Tape.init (input.map Γ.ofBool) + work := fun _ => Tape.init [] + output := Tape.init [] } = some skipped := by + rw [TM.step, if_neg (by simp [TM.skipTM])] + simp only [TM.skipTM] + refine congrArg some (Complexity.Cfg.ext rfl ?_ ?_ ?_) + · simp [skipped, parkedInput, TM.idleDir, Tape.read, Tape.move] + · funext i + simp [skipped, parkedWork, TM.resetBinaryBlank, TM.idleDir, + TM.readBackWrite, Tape.read, Tape.write, Tape.move] + · simp [skipped, TM.resetBinaryBlank, TM.idleDir, + TM.readBackWrite, Tape.read, Tape.write, Tape.move] + have hskipReach : (TM.skipTM (n := n + 1)).reachesIn 1 + { state := (TM.skipTM (n := n + 1)).qstart + input := Tape.init (input.map Γ.ofBool) + work := fun _ => Tape.init [] + output := Tape.init [] } skipped := + .step hskipStep .zero + have hblankNat : TM.resetBinaryBlank.HasBinaryNat 0 := by + simpa [TM.resetBinaryBlank] using Tape.init_move_right_hasBinaryNat 0 + have hblankParked : TM.Parked TM.resetBinaryBlank := + parked_of_binaryNat hblankNat + have hparkedInput : TM.Parked parkedInput := + parked_of_binarySuffix (by + simpa only [parkedInput] using Tape.init_move_right_hasBinarySuffix input) + have hlhsRun := TM.binarySuccTM_hoareTime_frame tapes.liftedLhs 0 + skipped.input skipped.work skipped.output + (by simpa [skipped, parkedWork] using hblankNat) + (by simpa [skipped] using hparkedInput.read_ne_start) + (fun i _ => by simpa [skipped, parkedWork] using + hblankParked.read_ne_start) + (by simpa [skipped] using hblankParked.read_ne_start) + obtain ⟨lhsDone, lhsTime, hlhsTime, hlhsReach, hlhsHalt, + hlhsInput, hlhsFrame, hlhsValue, hlhsOutput⟩ := + hlhsRun skipped.input skipped.work skipped.output ⟨rfl, rfl, rfl⟩ + have hlhsRhs : tapes.liftedLhs ≠ tapes.lifted.data.rhs := + tapes.lifted.data.ne (by decide) + have hrhsZero : + (lhsDone.work tapes.lifted.data.rhs).HasBinaryNat 0 := by + rw [hlhsFrame _ hlhsRhs.symm] + simpa [skipped, parkedWork] using hblankNat + have hlhsInputParked : TM.Parked lhsDone.input := by + rw [hlhsInput] + simpa [skipped] using hparkedInput + have hlhsOutputParked : TM.Parked lhsDone.output := by + rw [hlhsOutput] + simpa [skipped] using hblankParked + have hlhsWorkParked : ∀ i, TM.Parked (lhsDone.work i) := by + intro i + by_cases hi : i = tapes.liftedLhs + · subst i + exact parked_of_binaryNat hlhsValue + · rw [hlhsFrame i hi] + simpa [skipped, parkedWork] using hblankParked + have hrhsRun := TM.binarySuccTM_hoareTime_frame + tapes.lifted.data.rhs 0 lhsDone.input lhsDone.work lhsDone.output + hrhsZero hlhsInputParked.read_ne_start + (fun i _ => (hlhsWorkParked i).read_ne_start) + hlhsOutputParked.read_ne_start + obtain ⟨rhsDone, rhsTime, hrhsTime, hrhsReach, hrhsHalt, + hrhsInput, hrhsFrame, hrhsValue, hrhsOutput⟩ := + hrhsRun lhsDone.input lhsDone.work lhsDone.output ⟨rfl, rfl, rfl⟩ + obtain ⟨hlhsInputTransition, hlhsWorkTransition, + hlhsOutputTransition⟩ := + TM.phaseTransition_eq_self_of_reads_ne_start + hlhsInputParked.read_ne_start + (fun i => (hlhsWorkParked i).read_ne_start) + hlhsOutputParked.read_ne_start + have hrhsReach' : (TM.binarySuccTM tapes.lifted.data.rhs).reachesIn + rhsTime + { state := (TM.binarySuccTM tapes.lifted.data.rhs).qstart + input := TM.transitionInput lhsDone.input + work := fun i => TM.transitionTape (lhsDone.work i) + output := TM.transitionTape lhsDone.output } + rhsDone := by + simpa only [hlhsInputTransition, hlhsWorkTransition, + hlhsOutputTransition] using hrhsReach + have htailReach := TM.seqTM_reachesIn_of_reachesIn + (TM.binarySuccTM tapes.liftedLhs) + (TM.binarySuccTM tapes.lifted.data.rhs) + hlhsReach hlhsHalt hrhsReach' + let tailDone := TM.phase2Wrap (TM.binarySuccTM tapes.liftedLhs) + (TM.binarySuccTM tapes.lifted.data.rhs) rhsDone + have htailHalt : + (TM.seqTM (TM.binarySuccTM tapes.liftedLhs) + (TM.binarySuccTM tapes.lifted.data.rhs)).halted tailDone := by + rw [TM.phase2Wrap_halted_iff] + exact hrhsHalt + obtain ⟨hskipInputTransition, hskipWorkTransition, + hskipOutputTransition⟩ := + TM.phaseTransition_eq_self_of_reads_ne_start + hparkedInput.read_ne_start (fun _ => hblankParked.read_ne_start) + hblankParked.read_ne_start + have hskipInputTransition' : + TM.transitionInput skipped.input = skipped.input := by + simpa [skipped] using hskipInputTransition + have hskipWorkTransition' : + (fun i => TM.transitionTape (skipped.work i)) = skipped.work := by + simpa [skipped] using hskipWorkTransition + have hskipOutputTransition' : + TM.transitionTape skipped.output = skipped.output := by + simpa [skipped] using hskipOutputTransition + have htailReach' : + (TM.seqTM (TM.binarySuccTM tapes.liftedLhs) + (TM.binarySuccTM tapes.lifted.data.rhs)).reachesIn + (lhsTime + 1 + rhsTime) + { state := (TM.seqTM (TM.binarySuccTM tapes.liftedLhs) + (TM.binarySuccTM tapes.lifted.data.rhs)).qstart + input := TM.transitionInput skipped.input + work := fun i => TM.transitionTape (skipped.work i) + output := TM.transitionTape skipped.output } + tailDone := by + simpa only [hskipInputTransition', hskipWorkTransition', + hskipOutputTransition'] using htailReach + have hreach := TM.seqTM_reachesIn_of_reachesIn + (TM.skipTM (n := n + 1)) + (TM.seqTM (TM.binarySuccTM tapes.liftedLhs) + (TM.binarySuccTM tapes.lifted.data.rhs)) + hskipReach rfl htailReach' + let finalCfg := TM.phase2Wrap (TM.skipTM (n := n + 1)) + (TM.seqTM (TM.binarySuccTM tapes.liftedLhs) + (TM.binarySuccTM tapes.lifted.data.rhs)) tailDone + have hrhsInputSuffix : rhsDone.input.HasBinarySuffix input := by + rw [hrhsInput, hlhsInput] + simpa [skipped, parkedInput] using Tape.init_move_right_hasBinarySuffix input + have hrhsOutputBlank : rhsDone.output = TM.resetBinaryBlank := by + exact hrhsOutput.trans (hlhsOutput.trans (by rfl)) + have hrhsWorkParked : ∀ i, TM.Parked (rhsDone.work i) := by + intro i + by_cases hi : i = tapes.lifted.data.rhs + · subst i + exact parked_of_binaryNat hrhsValue + · rw [hrhsFrame i hi] + exact hlhsWorkParked i + have hrhsRemaining : tapes.lifted.data.update.remaining ≠ + tapes.lifted.data.rhs := tapes.lifted.data.ne (by decide) + have hlhsRemaining : tapes.lifted.data.update.remaining ≠ + tapes.liftedLhs := tapes.lifted.data.ne (by decide) + refine ⟨finalCfg, 1 + 1 + (lhsTime + 1 + rhsTime), ?_, hreach, + ?_, ?_⟩ + · omega + · change (initialSetupTM tapes).halted finalCfg + unfold initialSetupTM + rw [TM.phase2Wrap_halted_iff] + exact htailHalt + · refine ⟨?_, ?_, ?_, ?_⟩ + · change rhsDone.input.HasBinarySuffix input + exact hrhsInputSuffix + · change rhsDone.input = + (Tape.init (input.map Γ.ofBool)).move Dir3.right + rw [hrhsInput, hlhsInput] + · refine + { address := ?_ + value := ?_ + count := ?_ + buffer := ?_ + parked := ?_ + frame := ?_ } + · change (rhsDone.work tapes.liftedLhs).HasBinaryNat 1 + rw [hrhsFrame _ hlhsRhs] + simpa using hlhsValue + · change (rhsDone.work tapes.lifted.data.rhs).HasBinaryNat 1 + simpa using hrhsValue + · change (rhsDone.work + tapes.lifted.data.update.remaining).HasBinaryNat 0 + rw [hrhsFrame _ hrhsRemaining, hlhsFrame _ hlhsRemaining] + simpa [skipped, parkedWork] using hblankNat + · change (rhsDone.work tapes.buffer).HasBinaryPrefix [] + rw [hrhsFrame _ (tapes.liftedData_ne_buffer 14).symm, + hlhsFrame _ (tapes.liftedData_ne_buffer 13).symm] + have hblankString : TM.resetBinaryBlank.HasBinaryString [] := + hblankNat.2 + simpa [skipped, parkedWork] using + (show TM.resetBinaryBlank.HasBinaryPrefix [] from + ⟨by simpa using hblankString.1, hblankString.2⟩) + · intro i + change TM.Parked (rhsDone.work i) + exact hrhsWorkParked i + · intro i hlhs hrhs hcount hbuffer + change rhsDone.work i = TM.resetBinaryBlank + rw [hrhsFrame i hrhs, hlhsFrame i hlhs] + · change rhsDone.output = TM.resetBinaryBlank + exact hrhsOutputBlank + +/-- Emit the length register into the sparse buffer and increment the runtime +entry count, restoring both encoder sources exactly. -/ +theorem initialLengthEmitTM_hoareTime_internal + (tapes : ControlInstructionTapes n) (length count : ℕ) + (entries : Store) (inp₀ : Tape) (work₀ : Fin (n + 1) → Tape) + (out₀ : Tape) (hready : InitialLoopReady tapes length count entries work₀) + (hinput : TM.Parked inp₀) (houtput : out₀ = TM.resetBinaryBlank) : + (initialLengthEmitTM tapes).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + InitialLoopReady tapes length (count + 1) + (entries ++ [(0, length)]) work ∧ + out = out₀) + (rewindEntryEncodeRestoreTime (0, length) + 1 + + TM.binarySuccTime count) := by + intro inp work out hpre + rcases hpre with ⟨hinp, hwork, hout⟩ + subst inp + subst work + subst out + have hqueryLhs : tapes.lifted.data.update.entry.query ≠ + tapes.liftedLhs := tapes.lifted.data.ne (by decide) + have hqueryRhs : tapes.lifted.data.update.entry.query ≠ + tapes.lifted.data.rhs := tapes.lifted.data.ne (by decide) + have hqueryCount : tapes.lifted.data.update.entry.query ≠ + tapes.lifted.data.update.remaining := tapes.lifted.data.ne (by decide) + have hqueryBuffer : tapes.lifted.data.update.entry.query ≠ + tapes.buffer := tapes.liftedData_ne_buffer 7 + have hblankNat : TM.resetBinaryBlank.HasBinaryNat 0 := by + simpa [TM.resetBinaryBlank] using Tape.init_move_right_hasBinaryNat 0 + have hqueryZero : + (work₀ tapes.lifted.data.update.entry.query).HasBinaryNat 0 := by + rw [hready.frame _ hqueryLhs hqueryRhs hqueryCount hqueryBuffer] + exact hblankNat + have haddress : + (work₀ (Fin.castSucc (initialLengthEntryTapes tapes).address)).HasBinaryNat 0 := by + exact hqueryZero + have hvalue : + (work₀ (Fin.castSucc (initialLengthEntryTapes tapes).value)).HasBinaryNat + length := by + exact hready.address + have hemit := + rewindEntryEncodeRestoreTM_retargetOutput_hoareTime_frame + (initialLengthEntryTapes tapes) (0, length) + (entries.flatMap Entry.encode) inp₀ work₀ haddress hvalue hinput + (fun i _ _ => hready.parked (Fin.castSucc i)) hready.buffer + obtain ⟨emitted, emitTime, hemitTime, hemitReach, hemitHalt, + hemitInput, hemitFrame, hemitBuffer, hemitOutput⟩ := + hemit inp₀ work₀ out₀ + ⟨rfl, rfl, by simpa [TM.resetBinaryBlank] using houtput⟩ + have hemitOutput' : emitted.output = out₀ := by + exact hemitOutput.trans (by simpa [TM.resetBinaryBlank] using houtput.symm) + have hemitInputParked : TM.Parked emitted.input := by + rw [hemitInput] + exact hinput + have hemitOutputParked : TM.Parked emitted.output := by + rw [hemitOutput'] + rw [houtput] + exact parked_of_binaryNat hblankNat + have hemitWorkParked : ∀ i, TM.Parked (emitted.work i) := by + intro i + by_cases hi : i = tapes.buffer + · subst i + exact parked_of_binaryPrefix hemitBuffer + · rw [hemitFrame i hi] + exact hready.parked i + have hcountBuffer : tapes.lifted.data.update.remaining ≠ tapes.buffer := + tapes.liftedData_ne_buffer 9 + have hemitCount : + (emitted.work tapes.lifted.data.update.remaining).HasBinaryNat count := by + rw [hemitFrame _ hcountBuffer] + exact hready.count + have hcountRun := TM.binarySuccTM_hoareTime_frame + tapes.lifted.data.update.remaining count emitted.input emitted.work + emitted.output hemitCount hemitInputParked.read_ne_start + (fun i _ => (hemitWorkParked i).read_ne_start) + hemitOutputParked.read_ne_start + obtain ⟨counted, countTime, hcountTime, hcountReach, hcountHalt, + hcountInput, hcountFrame, hcountValue, hcountOutput⟩ := + hcountRun emitted.input emitted.work emitted.output ⟨rfl, rfl, rfl⟩ + obtain ⟨hemitInputTransition, hemitWorkTransition, + hemitOutputTransition⟩ := + TM.phaseTransition_eq_self_of_reads_ne_start + hemitInputParked.read_ne_start + (fun i => (hemitWorkParked i).read_ne_start) + hemitOutputParked.read_ne_start + have hcountReach' : + (TM.binarySuccTM tapes.lifted.data.update.remaining).reachesIn + countTime + { state := (TM.binarySuccTM + tapes.lifted.data.update.remaining).qstart + input := TM.transitionInput emitted.input + work := fun i => TM.transitionTape (emitted.work i) + output := TM.transitionTape emitted.output } + counted := by + simpa only [hemitInputTransition, hemitWorkTransition, + hemitOutputTransition] using hcountReach + have hreach := TM.seqTM_reachesIn_of_reachesIn + (rewindEntryEncodeRestoreTM + (initialLengthEntryTapes tapes)).retargetOutput + (TM.binarySuccTM tapes.lifted.data.update.remaining) + hemitReach hemitHalt hcountReach' + let finalCfg := TM.phase2Wrap + (rewindEntryEncodeRestoreTM + (initialLengthEntryTapes tapes)).retargetOutput + (TM.binarySuccTM tapes.lifted.data.update.remaining) counted + have hcountWorkParked : ∀ i, TM.Parked (counted.work i) := by + intro i + by_cases hi : i = tapes.lifted.data.update.remaining + · subst i + exact parked_of_binaryNat hcountValue + · rw [hcountFrame i hi] + exact hemitWorkParked i + have hlhsCount : tapes.liftedLhs ≠ + tapes.lifted.data.update.remaining := tapes.lifted.data.ne (by decide) + have hrhsCount : tapes.lifted.data.rhs ≠ + tapes.lifted.data.update.remaining := tapes.lifted.data.ne (by decide) + have hlhsBuffer : tapes.liftedLhs ≠ tapes.buffer := + tapes.liftedData_ne_buffer 13 + have hrhsBuffer : tapes.lifted.data.rhs ≠ tapes.buffer := + tapes.liftedData_ne_buffer 14 + refine ⟨finalCfg, emitTime + 1 + countTime, by omega, hreach, ?_, ?_⟩ + · change (initialLengthEmitTM tapes).halted finalCfg + unfold initialLengthEmitTM + rw [TM.phase2Wrap_halted_iff] + exact hcountHalt + · refine ⟨?_, ?_, ?_⟩ + · change counted.input = inp₀ + exact hcountInput.trans hemitInput + · refine + { address := ?_ + value := ?_ + count := hcountValue + buffer := ?_ + parked := ?_ + frame := ?_ } + · change (counted.work tapes.liftedLhs).HasBinaryNat length + rw [hcountFrame _ hlhsCount, hemitFrame _ hlhsBuffer] + exact hready.address + · change (counted.work tapes.lifted.data.rhs).HasBinaryNat 1 + rw [hcountFrame _ hrhsCount, hemitFrame _ hrhsBuffer] + exact hready.value + · change (counted.work tapes.buffer).HasBinaryPrefix + ((entries ++ [(0, length)]).flatMap Entry.encode) + rw [hcountFrame _ hcountBuffer.symm] + simpa [List.flatMap_append] using hemitBuffer + · intro i + change TM.Parked (counted.work i) + exact hcountWorkParked i + · intro i hlhs hrhs hcount hbuffer + change counted.work i = TM.resetBinaryBlank + rw [hcountFrame i hcount, hemitFrame i hbuffer] + exact hready.frame i hlhs hrhs hcount hbuffer + · change counted.output = out₀ + exact hcountOutput.trans hemitOutput' + +/-- Optional length emission skips zero and appends exactly one nonzero +`R₀` entry otherwise. -/ +theorem initialLengthTM_hoareTime_internal + (tapes : ControlInstructionTapes n) (length count : ℕ) + (entries : Store) (inp₀ : Tape) (work₀ : Fin (n + 1) → Tape) + (out₀ : Tape) (hready : InitialLoopReady tapes length count entries work₀) + (hinput : TM.Parked inp₀) (houtput : out₀ = TM.resetBinaryBlank) : + (initialLengthTM tapes).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + InitialLoopReady tapes length + (count + if length = 0 then 0 else 1) + (entries ++ if length = 0 then [] else [(0, length)]) work ∧ + out = out₀) + (initialLengthTime length count) := by + intro inp work out hpre + rcases hpre with ⟨hinp, hwork, hout⟩ + subst inp + subst work + subst out + by_cases hlength : length = 0 + · subst length + have hblank : (work₀ tapes.liftedLhs).read = Γ.blank := + hready.address.read_eq_blank_iff.mpr rfl + have hskip := TM.skipTM_hoareTime_frame inp₀ work₀ out₀ hinput + hready.parked (by + rw [houtput] + have hblankNat : TM.resetBinaryBlank.HasBinaryNat 0 := by + simpa [TM.resetBinaryBlank] using Tape.init_move_right_hasBinaryNat 0 + exact parked_of_binaryNat hblankNat) + obtain ⟨skipDone, skipTime, hskipTime, hskipReach, hskipHalt, + hskipInput, hskipWork, hskipOutput⟩ := + hskip inp₀ work₀ out₀ ⟨rfl, rfl, rfl⟩ + obtain ⟨done, hreach, hhalt, hdoneInput, hdoneWork, hdoneOutput⟩ := + TM.branchWorkBlankTM_reachesIn_blank_frame tapes.liftedLhs + (TM.skipTM (n := n + 1)) (initialLengthEmitTM tapes) + inp₀ work₀ out₀ hblank hinput.read_ne_start + (fun i => (hready.parked i).read_ne_start) + (by + rw [houtput] + have hblankNat : TM.resetBinaryBlank.HasBinaryNat 0 := by + simpa [TM.resetBinaryBlank] using Tape.init_move_right_hasBinaryNat 0 + exact (parked_of_binaryNat hblankNat).read_ne_start) + hskipReach hskipHalt + refine ⟨done, skipTime + 1, ?_, hreach, hhalt, ?_⟩ + · simp [initialLengthTime] + omega + · refine ⟨?_, ?_, ?_⟩ + · exact hdoneInput.trans hskipInput + · simpa [hdoneWork, hskipWork] using hready + · exact hdoneOutput.trans (hskipOutput.trans rfl) + · have hnonblank : (work₀ tapes.liftedLhs).read ≠ Γ.blank := by + intro hblank + exact hlength (hready.address.read_eq_blank_iff.mp hblank) + have hemit := initialLengthEmitTM_hoareTime_internal tapes length count + entries inp₀ work₀ out₀ hready hinput houtput + obtain ⟨emitDone, emitTime, hemitTime, hemitReach, hemitHalt, + hemitInput, hemitReady, hemitOutput⟩ := + hemit inp₀ work₀ out₀ ⟨rfl, rfl, rfl⟩ + obtain ⟨done, hreach, hhalt, hdoneInput, hdoneWork, hdoneOutput⟩ := + TM.branchWorkBlankTM_reachesIn_nonblank_frame tapes.liftedLhs + (TM.skipTM (n := n + 1)) (initialLengthEmitTM tapes) + inp₀ work₀ out₀ hnonblank hinput.read_ne_start + (fun i => (hready.parked i).read_ne_start) + (by + rw [houtput] + have hblankNat : TM.resetBinaryBlank.HasBinaryNat 0 := by + simpa [TM.resetBinaryBlank] using Tape.init_move_right_hasBinaryNat 0 + exact (parked_of_binaryNat hblankNat).read_ne_start) + hemitReach hemitHalt + refine ⟨done, emitTime + 1, ?_, hreach, hhalt, ?_⟩ + · simp [initialLengthTime, hlength] + omega + · refine ⟨?_, ?_, ?_⟩ + · exact hdoneInput.trans hemitInput + · simpa [hlength, hdoneWork] using hemitReady + · exact hdoneOutput.trans hemitOutput + +/-- Restore the post-loop address and install the optional length entry. -/ +theorem initialLengthInstallTM_hoareTime_internal + (tapes : ControlInstructionTapes n) (length count : ℕ) + (entries : Store) (inp₀ : Tape) (work₀ : Fin (n + 1) → Tape) + (out₀ : Tape) + (hready : InitialLoopReady tapes (length + 1) count entries work₀) + (hinput : TM.Parked inp₀) (houtput : out₀ = TM.resetBinaryBlank) : + (initialLengthInstallTM tapes).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + InitialLoopReady tapes length + (count + if length = 0 then 0 else 1) + (entries ++ if length = 0 then [] else [(0, length)]) work ∧ + out = out₀) + (TM.binaryPredTime length + 1 + initialLengthTime length count) := by + intro inp work out hpre + rcases hpre with ⟨hinp, hwork, hout⟩ + subst inp + subst work + subst out + have hpred := TM.binaryPredTM_hoareTime_frame tapes.liftedLhs length + inp₀ work₀ out₀ hready.address hinput.read_ne_start + (fun i _ => (hready.parked i).read_ne_start) + (by + rw [houtput] + have hblankNat : TM.resetBinaryBlank.HasBinaryNat 0 := by + simpa [TM.resetBinaryBlank] using Tape.init_move_right_hasBinaryNat 0 + exact (parked_of_binaryNat hblankNat).read_ne_start) + obtain ⟨predDone, predTime, hpredTime, hpredReach, hpredHalt, + hpredInput, hpredFrame, hpredValue, hpredOutput⟩ := + hpred inp₀ work₀ out₀ ⟨rfl, rfl, rfl⟩ + have hpredInputParked : TM.Parked predDone.input := by + rw [hpredInput] + exact hinput + have hpredOutputBlank : predDone.output = TM.resetBinaryBlank := + hpredOutput.trans houtput + have hpredOutputParked : TM.Parked predDone.output := by + rw [hpredOutputBlank] + have hblankNat : TM.resetBinaryBlank.HasBinaryNat 0 := by + simpa [TM.resetBinaryBlank] using Tape.init_move_right_hasBinaryNat 0 + exact parked_of_binaryNat hblankNat + have hpredWorkParked : ∀ i, TM.Parked (predDone.work i) := by + intro i + by_cases hi : i = tapes.liftedLhs + · subst i + exact parked_of_binaryNat hpredValue + · rw [hpredFrame i hi] + exact hready.parked i + have hrhsLhs : tapes.lifted.data.rhs ≠ tapes.liftedLhs := + tapes.lifted.data.ne (by decide) + have hcountLhs : tapes.lifted.data.update.remaining ≠ + tapes.liftedLhs := tapes.lifted.data.ne (by decide) + have hbufferLhs : tapes.buffer ≠ tapes.liftedLhs := + (tapes.liftedData_ne_buffer 13).symm + have hpredReady : InitialLoopReady tapes length count entries predDone.work := + { address := hpredValue + value := by + rw [hpredFrame _ hrhsLhs] + exact hready.value + count := by + rw [hpredFrame _ hcountLhs] + exact hready.count + buffer := by + rw [hpredFrame _ hbufferLhs] + exact hready.buffer + parked := hpredWorkParked + frame := by + intro i hlhs hrhs hcount hbuffer + rw [hpredFrame i hlhs] + exact hready.frame i hlhs hrhs hcount hbuffer } + have hlength := initialLengthTM_hoareTime_internal tapes length count entries + predDone.input predDone.work predDone.output hpredReady hpredInputParked + hpredOutputBlank + obtain ⟨lengthDone, lengthTime, hlengthTime, hlengthReach, + hlengthHalt, hlengthInput, hlengthReady, hlengthOutput⟩ := + hlength predDone.input predDone.work predDone.output ⟨rfl, rfl, rfl⟩ + obtain ⟨hpredInputTransition, hpredWorkTransition, + hpredOutputTransition⟩ := + TM.phaseTransition_eq_self_of_reads_ne_start + hpredInputParked.read_ne_start + (fun i => (hpredWorkParked i).read_ne_start) + hpredOutputParked.read_ne_start + have hlengthReach' : (initialLengthTM tapes).reachesIn lengthTime + { state := (initialLengthTM tapes).qstart + input := TM.transitionInput predDone.input + work := fun i => TM.transitionTape (predDone.work i) + output := TM.transitionTape predDone.output } + lengthDone := by + simpa only [hpredInputTransition, hpredWorkTransition, + hpredOutputTransition] using hlengthReach + have hreach := TM.seqTM_reachesIn_of_reachesIn + (TM.binaryPredTM tapes.liftedLhs) (initialLengthTM tapes) + hpredReach hpredHalt hlengthReach' + let finalCfg := TM.phase2Wrap (TM.binaryPredTM tapes.liftedLhs) + (initialLengthTM tapes) lengthDone + refine ⟨finalCfg, predTime + 1 + lengthTime, by omega, hreach, ?_, ?_⟩ + · change (initialLengthInstallTM tapes).halted finalCfg + unfold initialLengthInstallTM + rw [TM.phase2Wrap_halted_iff] + exact hlengthHalt + · refine ⟨?_, ?_, ?_⟩ + · change lengthDone.input = inp₀ + exact hlengthInput.trans hpredInput + · change InitialLoopReady tapes length + (count + if length = 0 then 0 else 1) + (entries ++ if length = 0 then [] else [(0, length)]) + lengthDone.work + exact hlengthReady + · change lengthDone.output = out₀ + exact hlengthOutput.trans hpredOutput + +/-- Install the completed sparse buffer into the exact clean program-loop +snapshot image. -/ +theorem initialAbiInstallTM_hoareTime_internal + (tapes : ControlInstructionTapes n) (store : Store) (length : ℕ) + (inp₀ : Tape) (work₀ : Fin (n + 1) → Tape) (out₀ : Tape) + (hready : InitialLoopReady tapes length store.length store work₀) + (hbufferStart : (work₀ tapes.buffer).cells 0 = Γ.start) + (hinput : TM.Parked inp₀) (houtput : out₀ = TM.resetBinaryBlank) : + (initialAbiInstallTM tapes).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + work = programSnapshotWork tapes { pc := 0, store := store } ∧ + out = out₀) + (initialAbiInstallTime tapes store length) := by + let storeBits := store.flatMap Entry.encode + let W₁ := initialAbiCountWork tapes work₀ store.length + let W₂ := initialAbiBufferWork tapes W₁ store + let W₃ := initialAbiCopiedWork tapes W₂ store + let W₄ := initialAbiSourceWork tapes W₃ store + let W₅ := initialAbiBufferResetWork tapes W₄ + let W₆ := initialAbiFinalWork tapes W₅ + have hblankNat : TM.resetBinaryBlank.HasBinaryNat 0 := by + simpa [TM.resetBinaryBlank] using Tape.init_move_right_hasBinaryNat 0 + have houtputParked : TM.Parked out₀ := by + rw [houtput] + exact parked_of_binaryNat hblankNat + have hremainingResult : tapes.lifted.data.update.remaining ≠ + tapes.lifted.data.update.resultCount := + tapes.lifted.data.ne (by decide) + have hremainingFound : tapes.lifted.data.update.remaining ≠ + tapes.lifted.data.update.found := tapes.lifted.data.ne (by decide) + have hresultFound : tapes.lifted.data.update.resultCount ≠ + tapes.lifted.data.update.found := tapes.lifted.data.ne (by decide) + have hresultLhs : tapes.lifted.data.update.resultCount ≠ + tapes.liftedLhs := tapes.lifted.data.ne (by decide) + have hresultRhs : tapes.lifted.data.update.resultCount ≠ + tapes.lifted.data.rhs := tapes.lifted.data.ne (by decide) + have hresultBuffer : tapes.lifted.data.update.resultCount ≠ + tapes.buffer := tapes.liftedData_ne_buffer 12 + have hfoundLhs : tapes.lifted.data.update.found ≠ + tapes.liftedLhs := tapes.lifted.data.ne (by decide) + have hfoundRhs : tapes.lifted.data.update.found ≠ + tapes.lifted.data.rhs := tapes.lifted.data.ne (by decide) + have hfoundRemaining : tapes.lifted.data.update.found ≠ + tapes.lifted.data.update.remaining := tapes.lifted.data.ne (by decide) + have hfoundBuffer : tapes.lifted.data.update.found ≠ tapes.buffer := + tapes.liftedData_ne_buffer 11 + have hsourceLhs : tapes.liftedSource ≠ tapes.liftedLhs := + tapes.lifted.data.ne (by decide) + have hsourceRhs : tapes.liftedSource ≠ tapes.lifted.data.rhs := + tapes.lifted.data.ne (by decide) + have hsourceRemaining : tapes.liftedSource ≠ + tapes.lifted.data.update.remaining := tapes.lifted.data.ne (by decide) + have hsourceResult : tapes.liftedSource ≠ + tapes.lifted.data.update.resultCount := tapes.lifted.data.ne (by decide) + have hsourceBuffer : tapes.liftedSource ≠ tapes.buffer := + tapes.liftedSource_ne_buffer + have hlhsRhs : tapes.liftedLhs ≠ tapes.lifted.data.rhs := + tapes.lifted.data.ne (by decide) + have hlhsRemaining : tapes.liftedLhs ≠ + tapes.lifted.data.update.remaining := tapes.lifted.data.ne (by decide) + have hlhsResult : tapes.liftedLhs ≠ + tapes.lifted.data.update.resultCount := tapes.lifted.data.ne (by decide) + have hlhsSource := hsourceLhs.symm + have hlhsBuffer : tapes.liftedLhs ≠ tapes.buffer := + tapes.liftedData_ne_buffer 13 + have hrhsRemaining : tapes.lifted.data.rhs ≠ + tapes.lifted.data.update.remaining := tapes.lifted.data.ne (by decide) + have hrhsResult : tapes.lifted.data.rhs ≠ + tapes.lifted.data.update.resultCount := tapes.lifted.data.ne (by decide) + have hrhsSource := hsourceRhs.symm + have hrhsBuffer : tapes.lifted.data.rhs ≠ tapes.buffer := + tapes.liftedData_ne_buffer 14 + have hremainingBuffer : tapes.lifted.data.update.remaining ≠ + tapes.buffer := tapes.liftedData_ne_buffer 9 + have hcountEq : work₀ tapes.lifted.data.update.remaining = + programBinaryTape store.length.bits := by + simpa only [programBinaryTape] using hready.count.eq_init_move_right + have hbufferEq : work₀ tapes.buffer = programBinaryPrefixTape storeBits := by + exact eq_programBinaryPrefixTape_of_hasBinaryPrefix hready.buffer + hbufferStart + have hresultZero : + (work₀ tapes.lifted.data.update.resultCount).HasBinaryNat 0 := by + rw [hready.frame _ hresultLhs hresultRhs hremainingResult.symm + hresultBuffer] + exact hblankNat + have hfoundZero : + (work₀ tapes.lifted.data.update.found).HasBinaryNat 0 := by + rw [hready.frame _ hfoundLhs hfoundRhs hfoundRemaining hfoundBuffer] + exact hblankNat + have hcopy := TM.binaryCopyIntoTM_hoareTime_frame + tapes.lifted.data.update.remaining + tapes.lifted.data.update.resultCount + tapes.lifted.data.update.found hremainingResult hremainingFound + hresultFound store.length 0 inp₀ work₀ out₀ hready.count + hresultZero hfoundZero hinput + (fun i _ _ _ => hready.parked i) houtputParked + have hcopy' : + (TM.binaryCopyIntoTM + tapes.lifted.data.update.remaining + tapes.lifted.data.update.resultCount + tapes.lifted.data.update.found).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => inp = inp₀ ∧ work = W₁ ∧ out = out₀) + (TM.binaryCopyTime store.length 0) := by + simpa only [W₁, initialAbiCountWork] using hcopy + have hW₁Parked : ∀ i, TM.Parked (W₁ i) := by + exact parked_update hready.parked (binaryTape_parked store.length.bits) + have hW₁Buffer : W₁ tapes.buffer = programBinaryPrefixTape storeBits := by + simp [W₁, initialAbiCountWork, hresultBuffer.symm, hbufferEq] + have hrewindBuffer := rewindPrefixWorkTM_exact_hoareTime tapes.buffer + storeBits inp₀ W₁ out₀ hW₁Buffer hinput hW₁Parked houtputParked + have hrewindBuffer' : (TM.rewindWorkTM tapes.buffer).HoareTime + (fun inp work out => inp = inp₀ ∧ work = W₁ ∧ out = out₀) + (fun inp work out => inp = inp₀ ∧ work = W₂ ∧ out = out₀) + (storeBits.length + 1 + 2) := by + simpa only [W₂, initialAbiBufferWork] using hrewindBuffer + have hW₂Parked : ∀ i, TM.Parked (W₂ i) := by + exact parked_update hW₁Parked (binaryTape_parked storeBits) + have hW₂Buffer : W₂ tapes.buffer = programBinaryTape storeBits := by + simp [W₂, initialAbiBufferWork, storeBits] + have hsourceBlank : work₀ tapes.liftedSource = TM.resetBinaryBlank := by + exact hready.frame _ hsourceLhs hsourceRhs hsourceRemaining hsourceBuffer + have hW₂Source : W₂ tapes.liftedSource = TM.resetBinaryBlank := by + simp [W₂, W₁, initialAbiBufferWork, initialAbiCountWork, + hsourceBuffer, hsourceResult, hsourceBlank] + have hcopyStore := copyWorkToWorkTM_exact_hoareTime tapes.buffer + tapes.liftedSource hsourceBuffer.symm storeBits inp₀ W₂ out₀ + hW₂Buffer hW₂Source hinput hW₂Parked houtputParked + have hcopyStore' : + (TM.copyWorkToWorkTM tapes.buffer tapes.liftedSource).HoareTime + (fun inp work out => inp = inp₀ ∧ work = W₂ ∧ out = out₀) + (fun inp work out => inp = inp₀ ∧ work = W₃ ∧ out = out₀) + (storeBits.length + 1) := by + simpa only [W₃, initialAbiCopiedWork] using hcopyStore + have hprefixParked : TM.Parked (programBinaryPrefixTape storeBits) := + programBinaryPrefixTape_parked storeBits + have hW₃Parked : ∀ i, TM.Parked (W₃ i) := by + exact parked_update (parked_update hW₂Parked hprefixParked) + hprefixParked + have hW₃Source : + W₃ tapes.liftedSource = programBinaryPrefixTape storeBits := by + simp [W₃, initialAbiCopiedWork, storeBits] + have hrewindSource := rewindPrefixWorkTM_exact_hoareTime + tapes.liftedSource storeBits inp₀ W₃ out₀ hW₃Source + hinput hW₃Parked houtputParked + have hrewindSource' : (TM.rewindWorkTM tapes.liftedSource).HoareTime + (fun inp work out => inp = inp₀ ∧ work = W₃ ∧ out = out₀) + (fun inp work out => inp = inp₀ ∧ work = W₄ ∧ out = out₀) + (storeBits.length + 1 + 2) := by + simpa only [W₄, initialAbiSourceWork] using hrewindSource + have hW₄Parked : ∀ i, TM.Parked (W₄ i) := by + exact parked_update hW₃Parked (binaryTape_parked storeBits) + have hW₄Buffer : + W₄ tapes.buffer = programBinaryPrefixTape storeBits := by + simp [W₄, W₃, initialAbiSourceWork, initialAbiCopiedWork, + hsourceBuffer.symm, storeBits] + have hresetBuffer := TM.resetBinaryWorkTM_hoareTime_frame tapes.buffer + storeBits (storeBits.length + 1) inp₀ W₄ out₀ + (by rw [hW₄Buffer]; exact + (programBinaryPrefixTape_hasBinaryPrefix storeBits).2) + (by rw [hW₄Buffer]; simp [programBinaryPrefixTape]) + (by rw [hW₄Buffer]; simp [programBinaryPrefixTape]) + hinput (fun i _ => hW₄Parked i) houtputParked + have hresetBuffer' : (TM.resetBinaryWorkTM tapes.buffer).HoareTime + (fun inp work out => inp = inp₀ ∧ work = W₄ ∧ out = out₀) + (fun inp work out => inp = inp₀ ∧ work = W₅ ∧ out = out₀) + (TM.resetBinaryWorkTime (storeBits.length + 1) storeBits.length) := by + simpa only [W₅, initialAbiBufferResetWork, TM.resetBinaryBlank] + using hresetBuffer + have hW₅Parked : ∀ i, TM.Parked (W₅ i) := by + exact parked_update hW₄Parked (parked_of_binaryNat hblankNat) + have hW₅Lhs : W₅ tapes.liftedLhs = work₀ tapes.liftedLhs := by + simp [W₅, W₄, W₃, W₂, W₁, initialAbiBufferResetWork, + initialAbiSourceWork, initialAbiCopiedWork, initialAbiBufferWork, + initialAbiCountWork, hlhsBuffer, hlhsSource, hlhsResult] + have hW₅Rhs : + W₅ tapes.lifted.data.rhs = work₀ tapes.lifted.data.rhs := by + simp [W₅, W₄, W₃, W₂, W₁, initialAbiBufferResetWork, + initialAbiSourceWork, initialAbiCopiedWork, initialAbiBufferWork, + initialAbiCountWork, hrhsBuffer, hrhsSource, hrhsResult] + have htargetsNodup : (initialCleanupTargets tapes).Nodup := by + simp [initialCleanupTargets, hlhsRhs] + have htargetsContent : ∀ i, i ∈ initialCleanupTargets tapes → + (W₅ i).HasBinaryContent (initialCleanupBits tapes length i) := by + intro i hi + simp [initialCleanupTargets] at hi + rcases hi with rfl | rfl + · rw [hW₅Lhs] + simpa [initialCleanupBits] using hready.address.2.hasBinaryContent + · rw [hW₅Rhs] + simpa [initialCleanupBits, hlhsRhs.symm] using + hready.value.2.hasBinaryContent + have htargetsStart : ∀ i, i ∈ initialCleanupTargets tapes → + (W₅ i).cells 0 = Γ.start := by + intro i hi + simp [initialCleanupTargets] at hi + rcases hi with rfl | rfl + · rw [hW₅Lhs] + exact hready.address.1 + · rw [hW₅Rhs] + exact hready.value.1 + have htargetsHead : ∀ i, i ∈ initialCleanupTargets tapes → + (W₅ i).head ≤ 1 := by + intro i hi + simp [initialCleanupTargets] at hi + rcases hi with rfl | rfl + · rw [hW₅Lhs, hready.address.2.1] + · rw [hW₅Rhs, hready.value.2.1] + have hresetMany := TM.resetBinaryWorkManyTM_hoareTime_frame + (initialCleanupTargets tapes) (initialCleanupBits tapes length) + (fun _ => 1) inp₀ W₅ out₀ htargetsNodup htargetsContent + htargetsStart htargetsHead hinput hW₅Parked houtputParked + have hresetMany' : + (TM.resetBinaryWorkManyTM (initialCleanupTargets tapes)).HoareTime + (fun inp work out => inp = inp₀ ∧ work = W₅ ∧ out = out₀) + (fun inp work out => inp = inp₀ ∧ work = W₆ ∧ out = out₀) + (TM.resetBinaryWorkManyTime (initialCleanupBits tapes length) + (fun _ => 1) (initialCleanupTargets tapes)) := by + simpa only [W₆, initialAbiFinalWork] using hresetMany + have htail₅ := TM.seqTM_hoareTime + (TM.resetBinaryWorkTM tapes.buffer) + (TM.resetBinaryWorkManyTM (initialCleanupTargets tapes)) + hresetBuffer' + (exact_phaseTransition_of_parked inp₀ W₅ out₀ hinput + hW₅Parked houtputParked) + hresetMany' + have htail₄ := TM.seqTM_hoareTime + (TM.rewindWorkTM tapes.liftedSource) + (TM.seqTM (TM.resetBinaryWorkTM tapes.buffer) + (TM.resetBinaryWorkManyTM (initialCleanupTargets tapes))) + hrewindSource' + (exact_phaseTransition_of_parked inp₀ W₄ out₀ hinput + hW₄Parked houtputParked) + htail₅ + have htail₃ := TM.seqTM_hoareTime + (TM.copyWorkToWorkTM tapes.buffer tapes.liftedSource) + (TM.seqTM (TM.rewindWorkTM tapes.liftedSource) + (TM.seqTM (TM.resetBinaryWorkTM tapes.buffer) + (TM.resetBinaryWorkManyTM (initialCleanupTargets tapes)))) + hcopyStore' + (exact_phaseTransition_of_parked inp₀ W₃ out₀ hinput + hW₃Parked houtputParked) + htail₄ + have htail₂ := TM.seqTM_hoareTime + (TM.rewindWorkTM tapes.buffer) + (TM.seqTM (TM.copyWorkToWorkTM tapes.buffer tapes.liftedSource) + (TM.seqTM (TM.rewindWorkTM tapes.liftedSource) + (TM.seqTM (TM.resetBinaryWorkTM tapes.buffer) + (TM.resetBinaryWorkManyTM (initialCleanupTargets tapes))))) + hrewindBuffer' + (exact_phaseTransition_of_parked inp₀ W₂ out₀ hinput + hW₂Parked houtputParked) + htail₃ + have hfull := TM.seqTM_hoareTime + (TM.binaryCopyIntoTM + tapes.lifted.data.update.remaining + tapes.lifted.data.update.resultCount + tapes.lifted.data.update.found) + (TM.seqTM (TM.rewindWorkTM tapes.buffer) + (TM.seqTM (TM.copyWorkToWorkTM tapes.buffer tapes.liftedSource) + (TM.seqTM (TM.rewindWorkTM tapes.liftedSource) + (TM.seqTM (TM.resetBinaryWorkTM tapes.buffer) + (TM.resetBinaryWorkManyTM (initialCleanupTargets tapes)))))) + hcopy' + (exact_phaseTransition_of_parked inp₀ W₁ out₀ hinput + hW₁Parked houtputParked) + htail₂ + have hfinal : W₆ = + programSnapshotWork tapes { pc := 0, store := store } := by + exact initialAbiFinalWork_eq_programSnapshotWork tapes store length + work₀ hready + apply hfull.consequence + · exact fun _ _ _ h => h + · rintro inp work out ⟨hinp, hwork, hout⟩ + exact ⟨hinp, hwork.trans hfinal, hout⟩ + · simp only [initialAbiInstallTime, storeBits] + omega + +private theorem inputBitStoreFrom_address_lower + {start : ℕ} {input : List Bool} {entry : Entry} + (hentry : entry ∈ inputBitStoreFrom start input) : + start ≤ entry.1 := by + induction input generalizing start with + | nil => simp [inputBitStoreFrom] at hentry + | cons bit rest ih => + by_cases hbit : bit + · simp only [inputBitStoreFrom, hbit, if_true, List.singleton_append, + List.mem_cons] at hentry + rcases hentry with rfl | hentry + · simp + · exact le_trans (by omega) (ih hentry) + · simp only [inputBitStoreFrom, hbit] at hentry + exact le_trans (by omega) (ih hentry) + +private theorem inputBitStoreFrom_addressesNodup + (start : ℕ) (input : List Bool) : + AddressesNodup (inputBitStoreFrom start input) := by + induction input generalizing start with + | nil => simp [inputBitStoreFrom, AddressesNodup] + | cons bit rest ih => + by_cases hbit : bit + · simp only [inputBitStoreFrom, hbit, if_true, List.singleton_append] + change (start :: (inputBitStoreFrom (start + 1) rest).map Prod.fst).Nodup + rw [List.nodup_cons] + refine ⟨?_, ih (start + 1)⟩ + intro hmem + obtain ⟨entry, hentry, heq⟩ := List.mem_map.mp hmem + have hlower := inputBitStoreFrom_address_lower hentry + change entry.1 = start at heq + omega + · simpa [inputBitStoreFrom, hbit] using ih (start + 1) + +private theorem inputBitStoreFrom_valuesNonzero + (start : ℕ) (input : List Bool) : + ValuesNonzero (inputBitStoreFrom start input) := by + induction input generalizing start with + | nil => simp [inputBitStoreFrom, ValuesNonzero] + | cons bit rest ih => + by_cases hbit : bit + · simp only [inputBitStoreFrom, hbit, if_true, List.singleton_append] + intro entry hentry + simp only [List.mem_cons] at hentry + rcases hentry with rfl | hentry + · exact Nat.one_ne_zero + · exact ih (start + 1) entry hentry + · simpa [inputBitStoreFrom, hbit] using ih (start + 1) + +private theorem zero_not_mem_inputBitStoreFrom_addresses + (input : List Bool) : + 0 ∉ (inputBitStoreFrom 1 input).map Prod.fst := by + intro hmem + obtain ⟨entry, hentry, heq⟩ := List.mem_map.mp hmem + have hlower := inputBitStoreFrom_address_lower hentry + change entry.1 = 0 at heq + omega + +private theorem write_eq_append_of_address_not_mem + (store : Store) (address value : ℕ) + (haddress : address ∉ store.map Prod.fst) : + RegisterStore.write store address value = + store ++ if value = 0 then [] else [(address, value)] := by + induction store with + | nil => simp [RegisterStore.write] + | cons entry rest ih => + have hhead : address ≠ entry.1 := by + intro heq + apply haddress + simp [heq] + have hrest : address ∉ rest.map Prod.fst := by + intro hmem + exact haddress (by simp [hmem]) + simp [RegisterStore.write, hhead, ih hrest] + +theorem programInitialStore_eq_append_internal (input : List Bool) : + programInitialStore input = + inputBitStoreFrom 1 input ++ + if input.length = 0 then [] else [(0, input.length)] := by + unfold programInitialStore + exact write_eq_append_of_address_not_mem _ _ _ + (zero_not_mem_inputBitStoreFrom_addresses input) + +private theorem inputBitStoreFrom_length (start : ℕ) (input : List Bool) : + (inputBitStoreFrom start input).length = inputTrueCount input := by + induction input generalizing start with + | nil => simp [inputBitStoreFrom, inputTrueCount] + | cons bit rest ih => + cases bit + · simp [inputBitStoreFrom, inputTrueCount, ih] + · simp [inputBitStoreFrom, inputTrueCount, ih] + omega + +theorem programInitialStore_length_internal (input : List Bool) : + (programInitialStore input).length = + inputTrueCount input + if input.length = 0 then 0 else 1 := by + rw [programInitialStore_eq_append_internal, List.length_append, + inputBitStoreFrom_length] + split <;> simp_all + +theorem programInitialStore_canonical_internal (input : List Bool) : + Canonical (programInitialStore input) := by + apply RegisterStore.write_canonical + exact ⟨inputBitStoreFrom_addressesNodup 1 input, + inputBitStoreFrom_valuesNonzero 1 input⟩ + +private theorem read_inputBitStoreFrom (start target : ℕ) + (input : List Bool) : + read (inputBitStoreFrom start input) target = + if start ≤ target then + match input[target - start]? with + | some bit => if bit then 1 else 0 + | none => 0 + else 0 := by + induction input generalizing start target with + | nil => simp [inputBitStoreFrom, read] + | cons bit rest ih => + cases bit + · simp only [inputBitStoreFrom, Bool.false_eq_true, if_false, + List.nil_append] + by_cases htarget : target = start + · subst target + rw [ih] + simp + · by_cases hlt : target < start + · rw [ih] + simp only [if_neg (by omega : ¬start + 1 ≤ target), + if_neg (by omega : ¬start ≤ target)] + · have hge : start + 1 ≤ target := by omega + have hsub : target - start = (target - (start + 1)) + 1 := by + omega + rw [ih, if_pos hge, if_pos (by omega : start ≤ target)] + simp [hsub] + · simp only [inputBitStoreFrom, if_true, List.singleton_append] + by_cases htarget : target = start + · subst target + simp [read] + · by_cases hlt : target < start + · rw [read, if_neg htarget, ih] + simp only [if_neg (by omega : ¬start + 1 ≤ target), + if_neg (by omega : ¬start ≤ target)] + · have hge : start + 1 ≤ target := by omega + have hsub : target - start = (target - (start + 1)) + 1 := by + omega + rw [read, if_neg htarget, ih, if_pos hge, + if_pos (by omega : start ≤ target)] + simp [hsub] + +private theorem read_inputBitStoreFrom_zero (input : List Bool) : + read (inputBitStoreFrom 1 input) 0 = 0 := by + simp [read_inputBitStoreFrom] + +private theorem read_programInitialStore (input : List Bool) (target : ℕ) : + read (programInitialStore input) target = initRegs input target := by + rw [programInitialStore, RegisterStore.read_write] + by_cases htarget : target = 0 + · subst target + simp [initRegs] + · have hone : 1 ≤ target := Nat.one_le_iff_ne_zero.mpr htarget + simp [Function.update, htarget, read_inputBitStoreFrom, hone, initRegs] + rfl + exact inputBitStoreFrom_addressesNodup 1 input + +theorem programInitialSnapshot_represents_internal (input : List Bool) : + (programInitialSnapshot input).Represents (RAM.initCfg input) := by + refine ⟨programInitialStore_canonical_internal input, ?_⟩ + apply RAM.Cfg.ext + · rfl + · funext target + exact read_programInitialStore input target + +/-- Complete public-input initialization reaches the exact sparse snapshot +image consumed by the reusable program loop. -/ +theorem programInitTM_hoareTime_internal + (tapes : ControlInstructionTapes n) (input : List Bool) : + (programInitTM tapes).HoareTime + (fun inp work out => + inp = Tape.init (input.map Γ.ofBool) ∧ + work = (fun _ => Tape.init []) ∧ out = Tape.init []) + (fun inp work out => + inp.HasBinarySuffix [] ∧ + work = programSnapshotWork tapes (programInitialSnapshot input) ∧ + out = TM.resetBinaryBlank) + (programInitTime tapes input) := by + intro inp work out hpre + rcases hpre with ⟨hinp, hwork, hout⟩ + subst inp + subst work + subst out + have hsetup := initialSetupTM_hoareTime_internal tapes input + obtain ⟨setupDone, setupTime, hsetupTime, hsetupReach, hsetupHalt, + hsetupInput, _hsetupInputEq, hsetupReady, hsetupOutput⟩ := + hsetup _ _ _ ⟨rfl, rfl, rfl⟩ + have hsetupBufferStart : + (setupDone.work tapes.buffer).cells 0 = Γ.start := by + apply TM.work_cells_zero_eq_start_of_reachesIn tapes.buffer hsetupReach + simp [Tape.init] + have hsetupInputParked : TM.Parked setupDone.input := + parked_of_binarySuffix hsetupInput + have hsetupOutputParked : TM.Parked setupDone.output := by + rw [hsetupOutput] + have hblankNat : TM.resetBinaryBlank.HasBinaryNat 0 := by + simpa [TM.resetBinaryBlank] using Tape.init_move_right_hasBinaryNat 0 + exact parked_of_binaryNat hblankNat + have hloop := initialInputLoopTM_hoareTime_internal tapes input 1 0 [] + setupDone.input setupDone.work setupDone.output hsetupInput hsetupReady + hsetupOutput + obtain ⟨loopDone, loopTime, hloopTime, hloopReach, hloopHalt, + hloopInput, hloopReadyRaw, hloopOutput⟩ := + hloop _ _ _ ⟨rfl, rfl, rfl⟩ + have hloopBufferStart : + (loopDone.work tapes.buffer).cells 0 = Γ.start := + TM.work_cells_zero_eq_start_of_reachesIn tapes.buffer hloopReach + hsetupBufferStart + have hloopReady : InitialLoopReady tapes (input.length + 1) + (inputTrueCount input) (inputBitStoreFrom 1 input) loopDone.work := by + simpa [Nat.add_comm] using hloopReadyRaw + have hloopInputParked : TM.Parked loopDone.input := + parked_of_binarySuffix hloopInput + have hloopOutputBlank : loopDone.output = TM.resetBinaryBlank := + hloopOutput.trans hsetupOutput + have hloopOutputParked : TM.Parked loopDone.output := by + rw [hloopOutputBlank] + have hblankNat : TM.resetBinaryBlank.HasBinaryNat 0 := by + simpa [TM.resetBinaryBlank] using Tape.init_move_right_hasBinaryNat 0 + exact parked_of_binaryNat hblankNat + have hlength := initialLengthInstallTM_hoareTime_internal tapes + input.length (inputTrueCount input) (inputBitStoreFrom 1 input) + loopDone.input loopDone.work loopDone.output hloopReady hloopInputParked + hloopOutputBlank + obtain ⟨lengthDone, lengthTime, hlengthTime, hlengthReach, + hlengthHalt, hlengthInput, hlengthReadyRaw, hlengthOutput⟩ := + hlength _ _ _ ⟨rfl, rfl, rfl⟩ + have hlengthBufferStart : + (lengthDone.work tapes.buffer).cells 0 = Γ.start := + TM.work_cells_zero_eq_start_of_reachesIn tapes.buffer hlengthReach + hloopBufferStart + have hlengthReady : InitialLoopReady tapes input.length + (programInitialStore input).length (programInitialStore input) + lengthDone.work := by + rw [programInitialStore_length_internal, + programInitialStore_eq_append_internal] + exact hlengthReadyRaw + have hlengthInputParked : TM.Parked lengthDone.input := by + rw [hlengthInput] + exact hloopInputParked + have hlengthOutputBlank : lengthDone.output = TM.resetBinaryBlank := + hlengthOutput.trans hloopOutputBlank + have hlengthOutputParked : TM.Parked lengthDone.output := by + rw [hlengthOutputBlank] + have hblankNat : TM.resetBinaryBlank.HasBinaryNat 0 := by + simpa [TM.resetBinaryBlank] using Tape.init_move_right_hasBinaryNat 0 + exact parked_of_binaryNat hblankNat + have habi := initialAbiInstallTM_hoareTime_internal tapes + (programInitialStore input) input.length lengthDone.input + lengthDone.work lengthDone.output hlengthReady hlengthBufferStart + hlengthInputParked hlengthOutputBlank + obtain ⟨abiDone, abiTime, habiTime, habiReach, habiHalt, + habiInput, habiWork, habiOutput⟩ := + habi _ _ _ ⟨rfl, rfl, rfl⟩ + obtain ⟨hlengthInputTransition, hlengthWorkTransition, + hlengthOutputTransition⟩ := + TM.phaseTransition_eq_self_of_reads_ne_start + hlengthInputParked.read_ne_start + (fun i => (hlengthReady.parked i).read_ne_start) + hlengthOutputParked.read_ne_start + have habiReach' : (initialAbiInstallTM tapes).reachesIn abiTime + { state := (initialAbiInstallTM tapes).qstart + input := TM.transitionInput lengthDone.input + work := fun i => TM.transitionTape (lengthDone.work i) + output := TM.transitionTape lengthDone.output } + abiDone := by + simpa only [hlengthInputTransition, hlengthWorkTransition, + hlengthOutputTransition] using habiReach + have hfinalizeReach := TM.seqTM_reachesIn_of_reachesIn + (initialLengthInstallTM tapes) (initialAbiInstallTM tapes) + hlengthReach hlengthHalt habiReach' + let finalizeDone := TM.phase2Wrap (initialLengthInstallTM tapes) + (initialAbiInstallTM tapes) abiDone + have hfinalizeHalt : (initialFinalizeTM tapes).halted finalizeDone := by + unfold initialFinalizeTM + rw [TM.phase2Wrap_halted_iff] + exact habiHalt + have hloopInputTransition : + TM.transitionInput loopDone.input = loopDone.input := + TM.transitionInput_eq_self hloopInputParked.read_ne_start + have hloopWorkTransition : + (fun i => TM.transitionTape (loopDone.work i)) = loopDone.work := + funext fun i => TM.transitionTape_eq_self + (hloopReady.parked i).read_ne_start + have hloopOutputTransition : + TM.transitionTape loopDone.output = loopDone.output := + TM.transitionTape_eq_self hloopOutputParked.read_ne_start + have hfinalizeReach' : (initialFinalizeTM tapes).reachesIn + (lengthTime + 1 + abiTime) + { state := (initialFinalizeTM tapes).qstart + input := TM.transitionInput loopDone.input + work := fun i => TM.transitionTape (loopDone.work i) + output := TM.transitionTape loopDone.output } + finalizeDone := by + simpa only [hloopInputTransition, hloopWorkTransition, + hloopOutputTransition] using hfinalizeReach + have hloopTailReach := TM.seqTM_reachesIn_of_reachesIn + (initialInputLoopTM tapes) (initialFinalizeTM tapes) + hloopReach hloopHalt hfinalizeReach' + let loopTailDone := TM.phase2Wrap (initialInputLoopTM tapes) + (initialFinalizeTM tapes) finalizeDone + have hloopTailHalt : + (TM.seqTM (initialInputLoopTM tapes) + (initialFinalizeTM tapes)).halted loopTailDone := by + rw [TM.phase2Wrap_halted_iff] + exact hfinalizeHalt + have hsetupInputTransition : + TM.transitionInput setupDone.input = setupDone.input := + TM.transitionInput_eq_self hsetupInputParked.read_ne_start + have hsetupWorkTransition : + (fun i => TM.transitionTape (setupDone.work i)) = setupDone.work := + funext fun i => TM.transitionTape_eq_self + (hsetupReady.parked i).read_ne_start + have hsetupOutputTransition : + TM.transitionTape setupDone.output = setupDone.output := + TM.transitionTape_eq_self hsetupOutputParked.read_ne_start + have hloopTailReach' : + (TM.seqTM (initialInputLoopTM tapes) + (initialFinalizeTM tapes)).reachesIn + (loopTime + 1 + (lengthTime + 1 + abiTime)) + { state := (TM.seqTM (initialInputLoopTM tapes) + (initialFinalizeTM tapes)).qstart + input := TM.transitionInput setupDone.input + work := fun i => TM.transitionTape (setupDone.work i) + output := TM.transitionTape setupDone.output } + loopTailDone := by + simpa only [hsetupInputTransition, hsetupWorkTransition, + hsetupOutputTransition] using hloopTailReach + have hreach := TM.seqTM_reachesIn_of_reachesIn + (initialSetupTM tapes) + (TM.seqTM (initialInputLoopTM tapes) (initialFinalizeTM tapes)) + hsetupReach hsetupHalt hloopTailReach' + let finalCfg := TM.phase2Wrap (initialSetupTM tapes) + (TM.seqTM (initialInputLoopTM tapes) (initialFinalizeTM tapes)) + loopTailDone + refine ⟨finalCfg, + setupTime + 1 + (loopTime + 1 + (lengthTime + 1 + abiTime)), + ?_, hreach, ?_, ?_⟩ + · unfold programInitTime + omega + · change (programInitTM tapes).halted finalCfg + unfold programInitTM + rw [TM.phase2Wrap_halted_iff] + exact hloopTailHalt + · refine ⟨?_, ?_, ?_⟩ + · change abiDone.input.HasBinarySuffix [] + rw [habiInput, hlengthInput] + exact hloopInput + · change abiDone.work = + programSnapshotWork tapes (programInitialSnapshot input) + exact habiWork + · change abiDone.output = TM.resetBinaryBlank + exact habiOutput.trans hlengthOutputBlank + +end Machine + +end RegisterStore + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Initialization.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Initialization.lean new file mode 100644 index 0000000000..c2737b4569 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Initialization.lean @@ -0,0 +1,79 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Init.Defs +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Init.Internal + +/-! +# Sparse RAM public-input initialization + +The concrete initializer streams nonzero public-input bits into a canonical +sparse store, installs the optional length register, and produces the exact +clean work-tape image consumed by the reusable RAM program controller. +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace RegisterStore + +namespace Machine + +/-- The concrete initializer's sparse store is the streamed nonzero input +entries followed by the optional nonzero length register. -/ +theorem programInitialStore_eq_append (input : List Bool) : + programInitialStore input = + inputBitStoreFrom 1 input ++ + if input.length = 0 then [] else [(0, input.length)] := + programInitialStore_eq_append_internal input + +/-- The concrete initializer emits one entry per true input bit and one more +exactly when the input is nonempty. -/ +theorem programInitialStore_length (input : List Bool) : + (programInitialStore input).length = + inputTrueCount input + if input.length = 0 then 0 else 1 := + programInitialStore_length_internal input + +/-- The sparse store produced from public input is canonical. -/ +theorem programInitialStore_canonical (input : List Bool) : + Canonical (programInitialStore input) := + programInitialStore_canonical_internal input + +/-- The initializer's pure sparse snapshot represents the RAM public-input +configuration exactly. -/ +theorem programInitialSnapshot_represents (input : List Bool) : + (programInitialSnapshot input).Represents (RAM.initCfg input) := + programInitialSnapshot_represents_internal input + +/-- Complete public-input initialization reaches the exact sparse snapshot +image consumed by the reusable program loop. -/ +theorem programInitTM_hoareTime {n : ℕ} + (tapes : ControlInstructionTapes n) (input : List Bool) : + (programInitTM tapes).HoareTime + (fun inp work out => + inp = Tape.init (input.map Γ.ofBool) ∧ + work = (fun _ => Tape.init []) ∧ out = Tape.init []) + (fun inp work out => + inp.HasBinarySuffix [] ∧ + work = programSnapshotWork tapes (programInitialSnapshot input) ∧ + out = TM.resetBinaryBlank) + (programInitTime tapes input) := + programInitTM_hoareTime_internal tapes input + +end Machine + +end RegisterStore + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Internal.lean new file mode 100644 index 0000000000..2655b8a6cc --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Internal.lean @@ -0,0 +1,1402 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Defs +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Dispatch +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.Internal.Loop + +/-! +# Sparse RAM program controller -- proof internals +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace RegisterStore + +namespace Machine + +variable {n : ℕ} + +private theorem blank_parked : + TM.Parked ((Tape.init []).move Dir3.right) := by + refine ⟨by simp [Tape.move], ?_⟩ + intro j hj + simp [Tape.move, Tape.init, show j ≠ 0 by omega] + +private theorem hasBinaryNat_parked {t : Tape} {value : ℕ} + (h : t.HasBinaryNat value) : TM.Parked t := by + refine ⟨by rw [h.2.1], ?_⟩ + exact Tape.HasBinaryContent.cells_ne_start h.2.2 + +private theorem programBinaryTape_hasBinaryString (bits : List Bool) : + (programBinaryTape bits).HasBinaryString bits := by + simpa only [programBinaryTape] using + Tape.init_move_right_hasBinaryString bits + +private theorem programBinaryTape_hasBinaryNat (value : ℕ) : + (programBinaryTape value.bits).HasBinaryNat value := by + simpa only [programBinaryTape] using + Tape.init_move_right_hasBinaryNat value + +private theorem programBinaryTape_parked (bits : List Bool) : + TM.Parked (programBinaryTape bits) := by + refine ⟨by rw [(programBinaryTape_hasBinaryString bits).1], ?_⟩ + exact (programBinaryTape_hasBinaryString bits).hasBinaryContent.cells_ne_start + +private theorem programSnapshotWork_source + (tapes : ControlInstructionTapes n) (snapshot : Snapshot) : + programSnapshotWork tapes snapshot tapes.liftedSource = + programBinaryTape (snapshot.store.flatMap Entry.encode) := by + have hsourceRemaining : tapes.liftedSource ≠ + tapes.lifted.data.update.remaining := + tapes.lifted.data.ne (by decide) + have hsourceResult : tapes.liftedSource ≠ + tapes.lifted.data.update.resultCount := + tapes.lifted.data.ne (by decide) + unfold programSnapshotWork + rw [Function.update_of_ne tapes.liftedPC_ne_source.symm, + Function.update_of_ne hsourceResult, + Function.update_of_ne hsourceRemaining, + Function.update_self] + +private theorem programSnapshotWork_remaining + (tapes : ControlInstructionTapes n) (snapshot : Snapshot) : + programSnapshotWork tapes snapshot + tapes.lifted.data.update.remaining = + programBinaryTape snapshot.store.length.bits := by + have hremainingSource : tapes.lifted.data.update.remaining ≠ + tapes.liftedSource := tapes.lifted.data.ne (by decide) + have hremainingResult : tapes.lifted.data.update.remaining ≠ + tapes.lifted.data.update.resultCount := + tapes.lifted.data.ne (by decide) + have hremainingPC : tapes.lifted.data.update.remaining ≠ + tapes.liftedPC := tapes.lifted.data_ne_pc 9 + unfold programSnapshotWork + rw [Function.update_of_ne hremainingPC, + Function.update_of_ne hremainingResult, + Function.update_self] + +private theorem programSnapshotWork_resultCount + (tapes : ControlInstructionTapes n) (snapshot : Snapshot) : + programSnapshotWork tapes snapshot + tapes.lifted.data.update.resultCount = + programBinaryTape snapshot.store.length.bits := by + have hresultPC : tapes.lifted.data.update.resultCount ≠ + tapes.liftedPC := tapes.lifted.data_ne_pc 12 + unfold programSnapshotWork + rw [Function.update_of_ne hresultPC, Function.update_self] + +private theorem programSnapshotWork_pc + (tapes : ControlInstructionTapes n) (snapshot : Snapshot) : + programSnapshotWork tapes snapshot tapes.liftedPC = + programBinaryTape snapshot.pc.bits := by + simp [programSnapshotWork] + +private theorem programSnapshotWork_other + (tapes : ControlInstructionTapes n) (snapshot : Snapshot) + (i : Fin (n + 1)) + (hsource : i ≠ tapes.liftedSource) + (hremaining : i ≠ tapes.lifted.data.update.remaining) + (hresult : i ≠ tapes.lifted.data.update.resultCount) + (hpc : i ≠ tapes.liftedPC) : + programSnapshotWork tapes snapshot i = TM.resetBinaryBlank := by + unfold programSnapshotWork + rw [Function.update_of_ne hpc, + Function.update_of_ne hresult, + Function.update_of_ne hremaining, + Function.update_of_ne hsource] + rfl + +/-- The exact snapshot work image satisfies the complete reusable instruction +ABI whenever its sparse store is canonical. -/ +theorem programSnapshotWork_ready_internal + (tapes : ControlInstructionTapes n) (snapshot : Snapshot) + (hcanonical : Canonical snapshot.store) : + InstructionExecutionReady tapes snapshot.store snapshot.pc + (programSnapshotWork tapes snapshot) := by + let work := programSnapshotWork tapes snapshot + let entry := tapes.lifted.data.lhsLookup.scan.entry + change InstructionExecutionReady tapes snapshot.store snapshot.pc work + have hblankNat : TM.resetBinaryBlank.HasBinaryNat 0 := by + simpa [TM.resetBinaryBlank] using Tape.init_move_right_hasBinaryNat 0 + have hblankString : TM.resetBinaryBlank.HasBinaryString [] := hblankNat.2 + have hblankPrefix : TM.resetBinaryBlank.HasBinaryPrefix [] := + ⟨by simpa using hblankString.1, hblankString.2⟩ + have hblankStart : TM.resetBinaryBlank.cells 0 = Γ.start := hblankNat.1 + have hsource : work tapes.liftedSource = + programBinaryTape (snapshot.store.flatMap Entry.encode) := by + exact programSnapshotWork_source tapes snapshot + have hremaining : work tapes.lifted.data.update.remaining = + programBinaryTape snapshot.store.length.bits := by + exact programSnapshotWork_remaining tapes snapshot + have hresultCount : work tapes.lifted.data.update.resultCount = + programBinaryTape snapshot.store.length.bits := by + exact programSnapshotWork_resultCount tapes snapshot + have hpc : work tapes.liftedPC = programBinaryTape snapshot.pc.bits := by + exact programSnapshotWork_pc tapes snapshot + have hother (i : Fin (n + 1)) + (hsourceIdx : i ≠ tapes.liftedSource) + (hremainingIdx : i ≠ tapes.lifted.data.update.remaining) + (hresultIdx : i ≠ tapes.lifted.data.update.resultCount) + (hpcIdx : i ≠ tapes.liftedPC) : + work i = TM.resetBinaryBlank := by + exact programSnapshotWork_other tapes snapshot i hsourceIdx + hremainingIdx hresultIdx hpcIdx + have hdataBlank (slot : Fin 18) (hsourceSlot : slot ≠ 0) + (hremainingSlot : slot ≠ 9) (hresultSlot : slot ≠ 12) : + work (tapes.lifted.data.idx slot) = TM.resetBinaryBlank := by + exact hother _ (tapes.lifted.data.ne hsourceSlot) + (tapes.lifted.data.ne hremainingSlot) + (tapes.lifted.data.ne hresultSlot) + (tapes.lifted.data_ne_pc slot) + have hparked : ∀ i, TM.Parked (work i) := by + intro i + by_cases hsi : i = tapes.liftedSource + · subst i + rw [hsource] + exact programBinaryTape_parked _ + by_cases hri : i = tapes.lifted.data.update.remaining + · subst i + rw [hremaining] + exact programBinaryTape_parked _ + by_cases hci : i = tapes.lifted.data.update.resultCount + · subst i + rw [hresultCount] + exact programBinaryTape_parked _ + by_cases hpi : i = tapes.liftedPC + · subst i + rw [hpc] + exact programBinaryTape_parked _ + · rw [hother i hsi hri hci hpi] + exact blank_parked + have hscanner : EntryScanReady entry + (snapshot.store.flatMap Entry.encode) [] work work := by + have hslotOther (slot : Fin 9) (hslot : slot ≠ 0) : + work (entry.idx slot) = TM.resetBinaryBlank := by + fin_cases slot + · exact (hslot rfl).elim + · simpa [entry, BinaryInstructionTapes.lhsLookup, + BinaryInstructionTapes.lhsLookupSlot] using + hdataBlank 1 (by decide) (by decide) (by decide) + · simpa [entry, BinaryInstructionTapes.lhsLookup, + BinaryInstructionTapes.lhsLookupSlot] using + hdataBlank 2 (by decide) (by decide) (by decide) + · simpa [entry, BinaryInstructionTapes.lhsLookup, + BinaryInstructionTapes.lhsLookupSlot] using + hdataBlank 3 (by decide) (by decide) (by decide) + · simpa [entry, BinaryInstructionTapes.lhsLookup, + BinaryInstructionTapes.lhsLookupSlot] using + hdataBlank 4 (by decide) (by decide) (by decide) + · simpa [entry, BinaryInstructionTapes.lhsLookup, + BinaryInstructionTapes.lhsLookupSlot] using + hdataBlank 5 (by decide) (by decide) (by decide) + · simpa [entry, BinaryInstructionTapes.lhsLookup, + BinaryInstructionTapes.lhsLookupSlot] using + hdataBlank 6 (by decide) (by decide) (by decide) + · simpa [entry, BinaryInstructionTapes.lhsLookup, + BinaryInstructionTapes.lhsLookupSlot] using + hdataBlank 7 (by decide) (by decide) (by decide) + · simpa [entry, BinaryInstructionTapes.lhsLookup, + BinaryInstructionTapes.lhsLookupSlot] using + hdataBlank 8 (by decide) (by decide) (by decide) + refine + { source := by + change (work tapes.liftedSource).HasBinarySuffix _ + rw [hsource] + exact Tape.init_move_right_hasBinarySuffix _ + address := by + rw [show work entry.address = TM.resetBinaryBlank by + simpa only [EntryMatchTapes.address] using + hslotOther 1 (by decide)] + exact hblankPrefix + addressStart := by + rw [show work entry.address = TM.resetBinaryBlank by + simpa only [EntryMatchTapes.address] using + hslotOther 1 (by decide)] + exact hblankStart + value := by + rw [show work entry.value = TM.resetBinaryBlank by + simpa only [EntryMatchTapes.value] using + hslotOther 2 (by decide)] + exact hblankPrefix + valueStart := by + rw [show work entry.value = TM.resetBinaryBlank by + simpa only [EntryMatchTapes.value] using + hslotOther 2 (by decide)] + exact hblankStart + addressCounter := by + rw [show work entry.addressCounter = TM.resetBinaryBlank by + simpa only [EntryMatchTapes.addressCounter] using + hslotOther 3 (by decide)] + exact hblankNat + addressWidth := by + rw [show work entry.addressWidth = TM.resetBinaryBlank by + simpa only [EntryMatchTapes.addressWidth] using + hslotOther 4 (by decide)] + exact hblankNat + valueCounter := by + rw [show work entry.valueCounter = TM.resetBinaryBlank by + simpa only [EntryMatchTapes.valueCounter] using + hslotOther 5 (by decide)] + exact hblankNat + valueWidth := by + rw [show work entry.valueWidth = TM.resetBinaryBlank by + simpa only [EntryMatchTapes.valueWidth] using + hslotOther 6 (by decide)] + exact hblankNat + query := by + rw [show work entry.query = TM.resetBinaryBlank by + simpa only [EntryMatchTapes.query] using + hslotOther 7 (by decide)] + exact hblankString + queryStart := by + rw [show work entry.query = TM.resetBinaryBlank by + simpa only [EntryMatchTapes.query] using + hslotOther 7 (by decide)] + exact hblankStart + result := by + rw [show work entry.result = TM.resetBinaryBlank by + simpa only [EntryMatchTapes.result] using + hslotOther 8 (by decide)] + exact hblankPrefix + resultStart := by + rw [show work entry.result = TM.resetBinaryBlank by + simpa only [EntryMatchTapes.result] using + hslotOther 8 (by decide)] + exact hblankStart + parked := hparked + frame := by intros; rfl } + have hlookup : EntryLookupStaticReady tapes.lifted.data.lhsLookup + snapshot.store work := by + refine + { scanner := by + change EntryScanReady entry + (snapshot.store.flatMap Entry.encode) [] work work + exact hscanner + sourceStart := by + change (work tapes.liftedSource).cells 0 = Γ.start + rw [hsource] + simp [programBinaryTape, Tape.move, Tape.init] + sourceHead := by + change (work tapes.liftedSource).head = 1 + rw [hsource] + exact (programBinaryTape_hasBinaryString _).1 + count := by + change (work tapes.lifted.data.update.remaining).HasBinaryNat _ + rw [hremaining] + exact programBinaryTape_hasBinaryNat _ + countSource := by + change (work tapes.lifted.data.update.resultCount).HasBinaryNat _ + rw [hresultCount] + exact programBinaryTape_hasBinaryNat _ + querySource := by + change (work (tapes.lifted.data.idx 15)).HasBinaryNat 0 + rw [hdataBlank 15 (by decide) (by decide) (by decide)] + exact hblankNat + destination := by + change (work (tapes.lifted.data.idx 13)).HasBinaryNat 0 + rw [hdataBlank 13 (by decide) (by decide) (by decide)] + exact hblankNat + copyScratch := by + change (work (tapes.lifted.data.idx 11)).HasBinaryNat 0 + rw [hdataBlank 11 (by decide) (by decide) (by decide)] + exact hblankNat } + refine + { canonical := hcanonical + control := + { lookup := hlookup + pc := by + change (work tapes.liftedPC).HasBinaryNat snapshot.pc + rw [hpc] + exact programBinaryTape_hasBinaryNat _ } + sourceContent := by + rw [hsource] + exact (programBinaryTape_hasBinaryString _).hasBinaryContent + rhs := by + change (work (tapes.lifted.data.idx 14)).HasBinaryNat 0 + rw [hdataBlank 14 (by decide) (by decide) (by decide)] + exact hblankNat + replacement := by + change (work (tapes.lifted.data.idx 10)).HasBinaryNat 0 + rw [hdataBlank 10 (by decide) (by decide) (by decide)] + exact hblankNat + tmp := by + change (work (tapes.lifted.data.idx 16)).HasBinaryNat 0 + rw [hdataBlank 16 (by decide) (by decide) (by decide)] + exact hblankNat + dbl := by + change (work (tapes.lifted.data.idx 17)).HasBinaryNat 0 + rw [hdataBlank 17 (by decide) (by decide) (by decide)] + exact hblankNat + buffer := by + rw [hother tapes.buffer tapes.liftedSource_ne_buffer.symm + (tapes.liftedData_ne_buffer 9).symm + (tapes.liftedData_ne_buffer 12).symm + tapes.liftedPC_ne_buffer.symm] + rfl } + +theorem registerVerdictOutput_cell_one_internal (value : ℕ) : + (registerVerdictOutput value).cells 1 = + if value = 0 then Γ.zero else Γ.one := by + by_cases hzero : value = 0 <;> + simp [registerVerdictOutput, registerVerdictSymbol, hzero, TM.idleDir, + Tape.writeAndMove, Tape.move, Tape.write, Tape.read, Tape.init] + +theorem registerVerdictTM_hoareTime_frame_internal + (idx : Fin n) (value : ℕ) (inp₀ : Tape) (work₀ : Fin n → Tape) + (hvalue : (work₀ idx).HasBinaryNat value) + (hinput : TM.Parked inp₀) (hwork : ∀ i, TM.Parked (work₀ i)) : + (registerVerdictTM idx).HoareTime + (fun inp work out => + inp = inp₀ ∧ work = work₀ ∧ + out = (Tape.init []).move Dir3.right) + (fun inp work out => + inp = inp₀ ∧ work = work₀ ∧ + out = registerVerdictOutput value) + 1 := by + intro inp work out hpre + obtain ⟨rfl, rfl, rfl⟩ := hpre + have hinp := hinput.move_idle + have hworkEq : + (fun i => (work i).writeAndMove + (TM.readBackWrite (work i).read) + (TM.idleDir (work i).read)) = work := by + funext i + exact (hwork i).writeAndMove_readBack_idle + have hsymbol : + (if (work idx).read = Γ.blank then Γw.zero else Γw.one) = + registerVerdictSymbol value := by + rw [registerVerdictSymbol] + exact if_congr hvalue.read_eq_blank_iff rfl rfl + have hout : + ((Tape.init []).move Dir3.right).writeAndMove + (if (work idx).read = Γ.blank then Γw.zero else Γw.one).toΓ + (TM.idleDir ((Tape.init []).move Dir3.right).read) = + registerVerdictOutput value := by + rw [hsymbol] + rfl + let final : Complexity.Cfg n (registerVerdictTM idx).Q := + { state := .done + input := inp + work := work + output := registerVerdictOutput value } + have hstep : + (registerVerdictTM idx).step + { state := (registerVerdictTM idx).qstart + input := inp + work := work + output := (Tape.init []).move Dir3.right } = some final := by + simp only [TM.step, registerVerdictTM, reduceCtorEq, ↓reduceIte, final] + rw [hinp, hworkEq, hout] + exact ⟨final, 1, le_rfl, .step hstep .zero, rfl, rfl, rfl, rfl⟩ + +/-- Final sparse lookup and Boolean emission recover the RAM verdict register. -/ +theorem programOutputTM_hoareTime_internal + (tapes : ControlInstructionTapes n) (store : Store) (pcValue : ℕ) + (initialWork : Fin (n + 1) → Tape) (inp₀ : Tape) + (hready : InstructionExecutionReady tapes store pcValue initialWork) + (hinput : TM.Parked inp₀) : + (programOutputTM tapes).HoareTime + (fun inp work out => + inp = inp₀ ∧ work = initialWork ∧ + out = (Tape.init []).move Dir3.right) + (fun inp _work out => + inp = inp₀ ∧ + out = registerVerdictOutput (RegisterStore.read store 0)) + (programOutputTime tapes store) := by + let blank := (Tape.init []).move Dir3.right + have hlookup := entryLookupStaticTM_hoareTime_frame + tapes.lifted.data.lhsLookup store 0 initialWork inp₀ blank + hready.control.lookup hinput blank_parked + let mid : TM.TapePred (n + 1) := fun inp work out => + inp = inp₀ ∧ + EntryLookupStaticResult tapes.lifted.data.lhsLookup store 0 + initialWork work ∧ + out = blank + have hverdict : (registerVerdictTM tapes.liftedLhs).HoareTime mid + (fun inp _work out => + inp = inp₀ ∧ + out = registerVerdictOutput (RegisterStore.read store 0)) + 1 := by + rintro inp work out ⟨hinp, hresult, hout⟩ + have hleaf := registerVerdictTM_hoareTime_frame_internal + tapes.liftedLhs (RegisterStore.read store 0) inp₀ work + hresult.destination hinput hresult.parked + obtain ⟨final, time, htime, hreach, hhalt, hfinalInput, + _hfinalWork, hfinalOutput⟩ := + hleaf inp work out ⟨hinp, rfl, by simpa only [blank] using hout⟩ + exact ⟨final, time, htime, hreach, hhalt, hfinalInput, hfinalOutput⟩ + have hseq := TM.seqTM_hoareTime + (entryLookupStaticTM tapes.lifted.data.lhsLookup 0) + (registerVerdictTM tapes.liftedLhs) hlookup + (by + rintro inp work out ⟨hinp, hresult, hout⟩ + have hi : TM.transitionInput inp = inp := + TM.transitionInput_eq_self + (by simpa [hinp] using hinput.read_ne_start) + have hw : (fun i => TM.transitionTape (work i)) = work := by + funext i + exact TM.transitionTape_eq_self (hresult.parked i).read_ne_start + have ho : TM.transitionTape out = out := + TM.transitionTape_eq_self + (by rw [hout]; exact blank_parked.read_ne_start) + rw [hi, hw, ho] + exact ⟨hinp, hresult, by simpa only [blank] using hout⟩) + hverdict + simpa only [programOutputTM, programOutputTime, mid, blank] using hseq + +theorem registerVerdictTM_hoareTime_haltOutput_internal + (idx : Fin n) (value : ℕ) (inp₀ : Tape) (work₀ : Fin n → Tape) + (hvalue : (work₀ idx).HasBinaryNat value) + (hinput : TM.Parked inp₀) (hwork : ∀ i, TM.Parked (work₀ i)) : + (registerVerdictTM idx).HoareTime + (fun inp work out => + inp = inp₀ ∧ work = work₀ ∧ out = instructionHaltOutput .halt) + (fun inp work out => + inp = inp₀ ∧ work = work₀ ∧ + out = registerVerdictOutput value) + 1 := by + intro inp work out hpre + obtain ⟨rfl, rfl, rfl⟩ := hpre + have hinp := hinput.move_idle + have hworkEq : + (fun i => (work i).writeAndMove + (TM.readBackWrite (work i).read) + (TM.idleDir (work i).read)) = work := by + funext i + exact (hwork i).writeAndMove_readBack_idle + have hsymbol : + (if (work idx).read = Γ.blank then Γw.zero else Γw.one) = + registerVerdictSymbol value := by + rw [registerVerdictSymbol] + exact if_congr hvalue.read_eq_blank_iff rfl rfl + have hout : + (instructionHaltOutput .halt).writeAndMove + (if (work idx).read = Γ.blank then Γw.zero else Γw.one).toΓ + (TM.idleDir (instructionHaltOutput .halt).read) = + registerVerdictOutput value := by + rw [hsymbol] + simp [instructionHaltOutput, instructionHaltVerdict, + registerVerdictOutput, TM.idleDir, Tape.writeAndMove, Tape.move, + Tape.write, Tape.read, Tape.init] + let final : Complexity.Cfg n (registerVerdictTM idx).Q := + { state := .done + input := inp + work := work + output := registerVerdictOutput value } + have hstep : + (registerVerdictTM idx).step + { state := (registerVerdictTM idx).qstart + input := inp + work := work + output := instructionHaltOutput .halt } = some final := by + simp only [TM.step, registerVerdictTM, reduceCtorEq, ↓reduceIte, final] + rw [hinp, hworkEq, hout] + exact ⟨final, 1, le_rfl, .step hstep .zero, rfl, rfl, rfl, rfl⟩ + +/-- Final sparse lookup overwrites the loop's halt-test bit with the RAM +verdict, so the controller and extractor compose without an output reset. -/ +theorem programOutputTM_hoareTime_haltOutput_internal + (tapes : ControlInstructionTapes n) (store : Store) (pcValue : ℕ) + (initialWork : Fin (n + 1) → Tape) (inp₀ : Tape) + (hready : InstructionExecutionReady tapes store pcValue initialWork) + (hinput : TM.Parked inp₀) : + (programOutputTM tapes).HoareTime + (fun inp work out => + inp = inp₀ ∧ work = initialWork ∧ + out = instructionHaltOutput .halt) + (fun inp _work out => + inp = inp₀ ∧ + out = registerVerdictOutput (RegisterStore.read store 0)) + (programOutputTime tapes store) := by + let haltOut := instructionHaltOutput .halt + have hhaltOutParked : TM.Parked haltOut := by + refine ⟨?_, ?_⟩ + · simp [haltOut, instructionHaltOutput, instructionHaltVerdict, + TM.idleDir, Tape.writeAndMove, Tape.move, Tape.write, Tape.read, + Tape.init] + · intro j hj + by_cases hjone : j = 1 + · subst j + simp [haltOut, instructionHaltOutput, instructionHaltVerdict, + TM.idleDir, Tape.writeAndMove, Tape.move, Tape.write, Tape.read, + Tape.init] + · have hjzero : j ≠ 0 := by omega + simp [haltOut, instructionHaltOutput, instructionHaltVerdict, + TM.idleDir, Tape.writeAndMove, Tape.move, Tape.write, Tape.read, + Tape.init, Function.update, hjone, hjzero] + have hlookup := entryLookupStaticTM_hoareTime_frame + tapes.lifted.data.lhsLookup store 0 initialWork inp₀ haltOut + hready.control.lookup hinput hhaltOutParked + let mid : TM.TapePred (n + 1) := fun inp work out => + inp = inp₀ ∧ + EntryLookupStaticResult tapes.lifted.data.lhsLookup store 0 + initialWork work ∧ + out = haltOut + have hverdict : (registerVerdictTM tapes.liftedLhs).HoareTime mid + (fun inp _work out => + inp = inp₀ ∧ + out = registerVerdictOutput (RegisterStore.read store 0)) + 1 := by + rintro inp work out ⟨hinp, hresult, hout⟩ + have hleaf := registerVerdictTM_hoareTime_haltOutput_internal + tapes.liftedLhs (RegisterStore.read store 0) inp₀ work + hresult.destination hinput hresult.parked + obtain ⟨final, time, htime, hreach, hhalt, hfinalInput, + _hfinalWork, hfinalOutput⟩ := + hleaf inp work out ⟨hinp, rfl, by simpa only [haltOut] using hout⟩ + exact ⟨final, time, htime, hreach, hhalt, hfinalInput, hfinalOutput⟩ + have hseq := TM.seqTM_hoareTime + (entryLookupStaticTM tapes.lifted.data.lhsLookup 0) + (registerVerdictTM tapes.liftedLhs) hlookup + (by + rintro inp work out ⟨hinp, hresult, hout⟩ + have hi : TM.transitionInput inp = inp := + TM.transitionInput_eq_self + (by simpa [hinp] using hinput.read_ne_start) + have hw : (fun i => TM.transitionTape (work i)) = work := by + funext i + exact TM.transitionTape_eq_self (hresult.parked i).read_ne_start + have ho : TM.transitionTape out = out := + TM.transitionTape_eq_self + (by rw [hout]; exact hhaltOutParked.read_ne_start) + rw [hi, hw, ho] + exact ⟨hinp, hresult, by simpa only [haltOut] using hout⟩) + hverdict + simpa only [programOutputTM, programOutputTime, mid, haltOut] using hseq + +theorem instructionHaltOutput_head_internal (instruction : Instr) : + (instructionHaltOutput instruction).head = 1 := by + cases instruction <;> + simp [instructionHaltOutput, instructionHaltVerdict, TM.idleDir, + Tape.writeAndMove, Tape.move, Tape.write, Tape.read, Tape.init] + +theorem instructionHaltOutput_cells_zero_internal (instruction : Instr) : + (instructionHaltOutput instruction).cells 0 = Γ.start := by + cases instruction <;> + simp [instructionHaltOutput, instructionHaltVerdict, TM.idleDir, + Tape.writeAndMove, Tape.move, Tape.write, Tape.read, Tape.init] + +theorem instructionHaltOutput_cells_ne_start_internal + (instruction : Instr) : + ∀ j, j ≥ 1 → (instructionHaltOutput instruction).cells j ≠ Γ.start := by + intro j hj + by_cases h1 : j = 1 + · subst j + cases instruction <;> + simp [instructionHaltOutput, instructionHaltVerdict, TM.idleDir, + Tape.writeAndMove, Tape.move, Tape.write, Tape.read, Tape.init] + · cases instruction <;> + simp [instructionHaltOutput, instructionHaltVerdict, TM.idleDir, + Tape.writeAndMove, Tape.move, Tape.write, Tape.read, Tape.init, h1, + show j ≠ 0 by omega] + +theorem instructionHaltOutput_cell_one_eq_one_iff_internal + (instruction : Instr) : + (instructionHaltOutput instruction).cells 1 = Γ.one ↔ + instruction = .halt := by + cases instruction <;> + simp [instructionHaltOutput, instructionHaltVerdict, TM.idleDir, + Tape.writeAndMove, Tape.move, Tape.write, Tape.read, Tape.init] + +theorem instructionHaltOutput_eq_blank_of_ne_halt_internal + {instruction : Instr} (h : instruction ≠ .halt) : + instructionHaltOutput instruction = + (Tape.init []).move Dir3.right := by + cases instruction <;> + simp_all [instructionHaltOutput, instructionHaltVerdict, TM.idleDir, + Tape.writeAndMove, Tape.move, Tape.write, Tape.read, Tape.init] + +private theorem phaseTransition_of_parked + {inp out : Tape} {work : Fin n → Tape} + (hinput : TM.Parked inp) (hwork : ∀ i, TM.Parked (work i)) + (houtput : TM.Parked out) : + TM.transitionInput inp = inp ∧ + (fun i => TM.transitionTape (work i)) = work ∧ + TM.transitionTape out = out := + TM.phaseTransition_eq_self_of_reads_ne_start hinput.read_ne_start + (fun i => (hwork i).read_ne_start) houtput.read_ne_start + +/-- The loop's fixed three-step rewind/check tail preserves every tape exactly. -/ +theorem programLoop_rewind_check_internal (tmBody tmTest : TM n) + (c : Complexity.Cfg n (TM.LoopQ tmBody.Q tmTest.Q)) + (hstate : c.state = Sum.inr (Sum.inl TM.LoopPhase.rewindOut)) + (hin : c.input.read ≠ Γ.start) + (hwork : ∀ i, (c.work i).read ≠ Γ.start) + (hhead : c.output.head = 1) + (hstart : c.output.cells 0 = Γ.start) + (hnoStart : ∀ j, 1 ≤ j → c.output.cells j ≠ Γ.start) : + ∃ c', (TM.loopTM tmBody tmTest).reachesIn 3 c c' ∧ + c'.state = (if c.output.cells 1 = Γ.one then + (Sum.inr (Sum.inl TM.LoopPhase.done) : + TM.LoopQ tmBody.Q tmTest.Q) + else Sum.inl tmBody.qstart) ∧ + c'.input = c.input ∧ c'.work = c.work ∧ c'.output = c.output := by + have hread₁ : c.output.read ≠ Γ.start := by + rw [Tape.read, hhead] + exact hnoStart 1 le_rfl + obtain ⟨c₁, hstep₁, hstate₁, hinput₁, hwork₁, hhead₁, hcells₁⟩ : + ∃ c₁, (TM.loopTM tmBody tmTest).step c = some c₁ ∧ + c₁.state = Sum.inr (Sum.inl TM.LoopPhase.rewindOut) ∧ + c₁.input = c.input ∧ c₁.work = c.work ∧ + c₁.output.head = 0 ∧ c₁.output.cells = c.output.cells := by + simp only [TM.step, ↓reduceIte, hstate, TM.loopTM, hread₁] + refine ⟨_, rfl, rfl, ?_, ?_, ?_, ?_⟩ + · exact TM.transitionInput_eq_self hin + · exact funext fun i => TM.transitionTape_eq_self (hwork i) + · simp [Tape.writeAndMove, Tape.move, Tape.write_head, hhead] + · exact TM.tape_readBackWrite_preserves _ _ (Or.inr hread₁) + have hread₂ : c₁.output.read = Γ.start := by + rw [Tape.read, hhead₁, hcells₁] + exact hstart + obtain ⟨c₂, hstep₂, hstate₂, hinput₂, hwork₂, hhead₂, hcells₂⟩ : + ∃ c₂, (TM.loopTM tmBody tmTest).step c₁ = some c₂ ∧ + c₂.state = Sum.inr (Sum.inl TM.LoopPhase.check) ∧ + c₂.input = c₁.input ∧ c₂.work = c₁.work ∧ + c₂.output.head = 1 ∧ c₂.output.cells = c₁.output.cells := by + simp only [TM.step, ↓reduceIte, hstate₁, TM.loopTM, hread₂] + refine ⟨_, rfl, rfl, ?_, ?_, ?_, ?_⟩ + · exact TM.transitionInput_eq_self (by rw [hinput₁]; exact hin) + · refine funext fun i => TM.transitionTape_eq_self ?_ + rw [hwork₁] + exact hwork i + · simp [Tape.writeAndMove, Tape.move, Tape.write_head, hhead₁] + · show ((c₁.output.write (Γw.blank).toΓ).move Dir3.right).cells = + c₁.output.cells + rw [Tape.move_cells] + simp only [Tape.write, hhead₁, ↓reduceIte] + have houtput₂ : c₂.output = c.output := + Tape.ext (by rw [hhead₂, hhead]) + (by rw [hcells₂, hcells₁]) + by_cases hone : c.output.cells 1 = Γ.one + · have hread₃ : c₂.output.read = Γ.one := by + rw [Tape.read, hhead₂, hcells₂, hcells₁] + exact hone + obtain ⟨c₃, hstep₃, hstate₃, hinput₃, hwork₃, houtput₃⟩ : + ∃ c₃, (TM.loopTM tmBody tmTest).step c₂ = some c₃ ∧ + c₃.state = Sum.inr (Sum.inl TM.LoopPhase.done) ∧ + c₃.input = c₂.input ∧ c₃.work = c₂.work ∧ + c₃.output = c₂.output := by + simp only [TM.step, ↓reduceIte, hstate₂, TM.loopTM, hread₃] + refine ⟨_, rfl, rfl, ?_, ?_, ?_⟩ + · exact TM.transitionInput_eq_self + (by rw [hinput₂, hinput₁]; exact hin) + · refine funext fun i => TM.transitionTape_eq_self ?_ + rw [hwork₂, hwork₁] + exact hwork i + · rw [← hread₃] + exact TM.transitionTape_eq_self (by rw [hread₃]; simp) + refine ⟨c₃, .step hstep₁ (.step hstep₂ (.step hstep₃ .zero)), + ?_, ?_, ?_, ?_⟩ + · rw [hstate₃, if_pos hone] + · rw [hinput₃, hinput₂, hinput₁] + · rw [hwork₃, hwork₂, hwork₁] + · rw [houtput₃, houtput₂] + · have hread₃ : c₂.output.read ≠ Γ.one := by + rw [Tape.read, hhead₂, hcells₂, hcells₁] + exact hone + have hread₃Start : c₂.output.read ≠ Γ.start := by + rw [Tape.read, hhead₂, hcells₂, hcells₁] + exact hnoStart 1 le_rfl + obtain ⟨c₃, hstep₃, hstate₃, hinput₃, hwork₃, houtput₃⟩ : + ∃ c₃, (TM.loopTM tmBody tmTest).step c₂ = some c₃ ∧ + c₃.state = Sum.inl tmBody.qstart ∧ + c₃.input = c₂.input ∧ c₃.work = c₂.work ∧ + c₃.output = c₂.output := by + simp only [TM.step, ↓reduceIte, hstate₂, TM.loopTM, hread₃] + refine ⟨_, rfl, rfl, ?_, ?_, ?_⟩ + · exact TM.transitionInput_eq_self + (by rw [hinput₂, hinput₁]; exact hin) + · refine funext fun i => TM.transitionTape_eq_self ?_ + rw [hwork₂, hwork₁] + exact hwork i + · exact TM.transitionTape_eq_self hread₃Start + refine ⟨c₃, .step hstep₁ (.step hstep₂ (.step hstep₃ .zero)), + ?_, ?_, ?_, ?_⟩ + · rw [hstate₃, if_neg hone] + · rw [hinput₃, hinput₂, hinput₁] + · rw [hwork₃, hwork₂, hwork₁] + · rw [houtput₃, houtput₂] + +/-- The verdict leaf has a literal one-step frame. -/ +theorem instructionHaltVerdictTM_hoareTime_frame_internal + (instruction : Instr) (inp₀ : Tape) (work₀ : Fin n → Tape) + (hinput : TM.Parked inp₀) (hwork : ∀ i, TM.Parked (work₀ i)) : + (instructionHaltVerdictTM instruction).HoareTime + (fun inp work out => + inp = inp₀ ∧ work = work₀ ∧ + out = (Tape.init []).move Dir3.right) + (fun inp work out => + inp = inp₀ ∧ work = work₀ ∧ + out = instructionHaltOutput instruction) + 1 := by + intro inp work out hpre + obtain ⟨rfl, rfl, rfl⟩ := hpre + have hinp := hinput.move_idle + have hworkEq : + (fun i => (work i).writeAndMove + (TM.readBackWrite (work i).read) + (TM.idleDir (work i).read)) = work := by + funext i + exact (hwork i).writeAndMove_readBack_idle + have hout : + ((Tape.init []).move Dir3.right).writeAndMove + (instructionHaltVerdict instruction).toΓ + (TM.idleDir ((Tape.init []).move Dir3.right).read) = + instructionHaltOutput instruction := rfl + let final : Complexity.Cfg n + (instructionHaltVerdictTM (n := n) instruction).Q := + { state := .done + input := inp + work := work + output := instructionHaltOutput instruction } + have hstep : + (instructionHaltVerdictTM instruction).step + { state := (instructionHaltVerdictTM instruction).qstart + input := inp + work := work + output := (Tape.init []).move Dir3.right } = some final := by + simp only [TM.step, instructionHaltVerdictTM, reduceCtorEq, + ↓reduceIte, final] + rw [hinp, hworkEq, hout] + exact ⟨final, 1, le_rfl, .step hstep .zero, rfl, rfl, rfl, rfl⟩ + +/-- The decrementing selector emits the verdict of the selected instruction +and restores its scratch tape to the clean ABI. -/ +theorem dispatchHaltTM_hoareTime_frame_internal + (tapes : ControlInstructionTapes n) (program : Program) + (store : Store) (pcValue selector : ℕ) + (cleanWork work₀ : Fin (n + 1) → Tape) (inp₀ : Tape) + (hready : DispatchReady tapes store pcValue selector cleanWork work₀) + (hinput : TM.Parked inp₀) : + (dispatchHaltTM tapes program).HoareTime + (fun inp work out => + inp = inp₀ ∧ work = work₀ ∧ + out = (Tape.init []).move Dir3.right) + (fun inp work out => + inp = inp₀ ∧ work = cleanWork ∧ + out = instructionHaltOutput + (selectedInstruction program selector)) + (dispatchHaltTime tapes program selector) := by + induction program generalizing selector work₀ with + | nil => + let blankTape := (Tape.init []).move Dir3.right + have hselector : (work₀ tapes.liftedLhs).HasBinaryNat selector := by + rw [hready.2] + simp only [Function.update_self] + exact Tape.init_move_right_hasBinaryNat selector + have hcleanLhs : cleanWork tapes.liftedLhs = blankTape := by + have hzero := hready.1.control.lookup.destination + change (cleanWork tapes.liftedLhs).HasBinaryNat 0 at hzero + simpa only [blankTape] using + Tape.HasBinaryNat.eq_init_move_right hzero + have hwork₀Parked : ∀ i, TM.Parked (work₀ i) := by + intro i + rw [hready.2] + by_cases hi : i = tapes.liftedLhs + · subst i + simp only [Function.update_self] + exact hasBinaryNat_parked + (Tape.init_move_right_hasBinaryNat selector) + · simp only [Function.update_of_ne hi] + exact hready.1.control.lookup.scanner.parked i + have hreset := TM.resetBinaryWorkTM_hoareTime_frame tapes.liftedLhs + selector.bits 1 inp₀ work₀ ((Tape.init []).move Dir3.right) + hselector.2.hasBinaryContent hselector.1 + ⟨by rw [hselector.2.1], by rw [hselector.2.1]⟩ + hinput (fun i _ => hwork₀Parked i) blank_parked + have hreset' : (TM.resetBinaryWorkTM tapes.liftedLhs).HoareTime + (fun inp work out => + inp = inp₀ ∧ work = work₀ ∧ + out = (Tape.init []).move Dir3.right) + (fun inp work out => + inp = inp₀ ∧ work = cleanWork ∧ + out = (Tape.init []).move Dir3.right) + (TM.resetBinaryWorkTime 1 selector.bits.length) := by + apply hreset.consequence + · exact fun _ _ _ h => h + · rintro inp work out ⟨hinp, hworkEq, hout⟩ + refine ⟨hinp, ?_, hout⟩ + rw [hworkEq, hready.2, Function.update_idem] + change Function.update cleanWork tapes.liftedLhs blankTape = cleanWork + rw [← hcleanLhs, Function.update_eq_self] + · exact le_rfl + have hverdict := instructionHaltVerdictTM_hoareTime_frame_internal + (.halt : Instr) inp₀ cleanWork hinput + hready.1.control.lookup.scanner.parked + have hseq := TM.seqTM_hoareTime + (TM.resetBinaryWorkTM tapes.liftedLhs) + (instructionHaltVerdictTM (.halt : Instr)) hreset' + (by + rintro inp work out ⟨hinp, hworkEq, hout⟩ + obtain ⟨hi, hw, ho⟩ := phaseTransition_of_parked + (inp := inp) (work := work) (out := out) + (by simpa [hinp] using hinput) + (by simpa [hworkEq] using + hready.1.control.lookup.scanner.parked) + (by simpa [hout] using blank_parked) + rw [hi, hw, ho] + exact ⟨hinp, hworkEq, hout⟩) + hverdict + simpa only [dispatchHaltTM, dispatchHaltTime, + selectedInstruction] using hseq + | cons instruction program ih => + let pre : TM.TapePred (n + 1) := fun inp work out => + inp = inp₀ ∧ work = work₀ ∧ + out = (Tape.init []).move Dir3.right + let post : TM.TapePred (n + 1) := fun inp work out => + inp = inp₀ ∧ work = cleanWork ∧ + out = instructionHaltOutput + (selectedInstruction (instruction :: program) selector) + let blankPre : TM.TapePred (n + 1) := fun inp work out => + pre inp work out ∧ selector = 0 + let nonblankPre : TM.TapePred (n + 1) := fun inp work out => + pre inp work out ∧ selector ≠ 0 + have hselector : (work₀ tapes.liftedLhs).HasBinaryNat selector := by + rw [hready.2] + simp only [Function.update_self] + exact Tape.init_move_right_hasBinaryNat selector + have hwork₀Parked : ∀ i, TM.Parked (work₀ i) := by + intro i + rw [hready.2] + by_cases hi : i = tapes.liftedLhs + · subst i + simp only [Function.update_self] + exact hasBinaryNat_parked + (Tape.init_move_right_hasBinaryNat selector) + · simp only [Function.update_of_ne hi] + exact hready.1.control.lookup.scanner.parked i + have hblank : (instructionHaltVerdictTM instruction).HoareTime + blankPre post 1 := by + rintro inp work out ⟨⟨hinp, hworkEq, hout⟩, hzero⟩ + subst selector + have hcleanLhs := Tape.HasBinaryNat.eq_init_move_right + hready.1.control.lookup.destination + change cleanWork tapes.liftedLhs = + (Tape.init []).move Dir3.right at hcleanLhs + have hworkClean : work = cleanWork := by + rw [hworkEq, hready.2] + funext i + by_cases hi : i = tapes.liftedLhs + · subst i + simp only [Function.update_self] + exact hcleanLhs.symm + · simp only [Function.update_of_ne hi] + have hverdict := instructionHaltVerdictTM_hoareTime_frame_internal + instruction inp₀ cleanWork hinput + hready.1.control.lookup.scanner.parked + obtain ⟨final, time, htime, hreach, hhalt, hfinalInput, + hfinalWork, hfinalOutput⟩ := + hverdict inp cleanWork out ⟨hinp, rfl, hout⟩ + refine ⟨final, time, htime, ?_, hhalt, hfinalInput, hfinalWork, ?_⟩ + · simpa [hworkClean] using hreach + · simpa only [selectedInstruction] using hfinalOutput + have hnonblank : + (TM.seqTM (TM.binaryPredTM tapes.liftedLhs) + (dispatchHaltTM tapes program)).HoareTime + nonblankPre post + (TM.binaryPredTime (selector - 1) + 1 + + dispatchHaltTime tapes program (selector - 1)) := by + rintro inp work out ⟨⟨hinp, hworkEq, hout⟩, hnonzero⟩ + have hsucc : selector = (selector - 1) + 1 := by omega + have hvalue : (work tapes.liftedLhs).HasBinaryNat + ((selector - 1) + 1) := by + rw [hworkEq] + rw [hsucc] at hselector + exact hselector + have hinpParked : TM.Parked inp := by simpa [hinp] using hinput + have houtParked : TM.Parked out := by simpa [hout] using blank_parked + have hworkParked : ∀ i, TM.Parked (work i) := by + intro i + simpa [hworkEq] using hwork₀Parked i + have hpred := TM.binaryPredTM_hoareTime_frame tapes.liftedLhs + (selector - 1) inp work out hvalue hinpParked.read_ne_start + (fun i _ => (hworkParked i).read_ne_start) + houtParked.read_ne_start + let nextWork := Function.update cleanWork tapes.liftedLhs + ((Tape.init ((selector - 1).bits.map Γ.ofBool)).move Dir3.right) + have hpred' : (TM.binaryPredTM tapes.liftedLhs).HoareTime + (fun inp' work' out' => + inp' = inp ∧ work' = work ∧ out' = out) + (fun inp' work' out' => + inp' = inp ∧ work' = nextWork ∧ out' = out) + (TM.binaryPredTime (selector - 1)) := by + apply hpred.consequence + · exact fun _ _ _ h => h + · rintro inp' work' out' ⟨hinp', hframe, hvalue', hout'⟩ + refine ⟨hinp', ?_, hout'⟩ + funext i + by_cases hi : i = tapes.liftedLhs + · subst i + simp only [nextWork, Function.update_self] + exact Tape.HasBinaryNat.eq_init_move_right hvalue' + · simp only [nextWork, Function.update_of_ne hi] + rw [hframe i hi, hworkEq, hready.2, + Function.update_of_ne hi] + · exact le_rfl + have hnextReady : DispatchReady tapes store pcValue (selector - 1) + cleanWork nextWork := ⟨hready.1, rfl⟩ + have hrecursive := ih (selector - 1) nextWork hnextReady + have hrecursive' : (dispatchHaltTM tapes program).HoareTime + (fun inp' work' out' => + inp' = inp ∧ work' = nextWork ∧ out' = out) + post + (dispatchHaltTime tapes program (selector - 1)) := by + apply hrecursive.consequence + · rintro inp' work' out' ⟨hinp', hwork', hout'⟩ + exact ⟨hinp'.trans hinp, hwork', hout'.trans hout⟩ + · rintro inp' work' out' ⟨hinp', hwork', hout'⟩ + have hselected : + selectedInstruction (instruction :: program) selector = + selectedInstruction program (selector - 1) := by + rw [hsucc] + rfl + exact ⟨hinp', hwork', by simpa only [hselected] using hout'⟩ + · exact le_rfl + have hseq := TM.seqTM_hoareTime (TM.binaryPredTM tapes.liftedLhs) + (dispatchHaltTM tapes program) hpred' + (by + rintro inp' work' out' ⟨hinp', hwork', hout'⟩ + obtain ⟨hi, hw, ho⟩ := phaseTransition_of_parked + (inp := inp') (work := work') (out := out') + (by simpa [hinp', hinp] using hinput) + (by + intro i + rw [hwork'] + by_cases hidx : i = tapes.liftedLhs + · subst i + simp only [nextWork, Function.update_self] + exact hasBinaryNat_parked + (Tape.init_move_right_hasBinaryNat (selector - 1)) + · simp only [nextWork, Function.update_of_ne hidx] + exact hready.1.control.lookup.scanner.parked i) + (by simpa [hout', hout] using blank_parked) + rw [hi, hw, ho] + exact ⟨hinp', hwork', hout'⟩) + hrecursive' + exact hseq inp work out ⟨rfl, rfl, rfl⟩ + have hdispatch := TM.branchWorkBlankTM_hoareTime tapes.liftedLhs + (instructionHaltVerdictTM instruction) + (TM.seqTM (TM.binaryPredTM tapes.liftedLhs) + (dispatchHaltTM tapes program)) + (pre := pre) (blankPre := blankPre) (nonblankPre := nonblankPre) + (blankPost := post) (nonblankPost := post) + (fun inp work out hpre => by + have hinpParked : TM.Parked inp := by + simpa [hpre.1] using hinput + have houtParked : TM.Parked out := by + simpa [hpre.2.2] using blank_parked + have hworkParked : ∀ i, TM.Parked (work i) := by + intro i + simpa [hpre.2.1] using hwork₀Parked i + exact ⟨hinpParked.read_ne_start, + fun i => (hworkParked i).read_ne_start, + houtParked.read_ne_start⟩) + (fun _ work _ hpre hread => + ⟨hpre, hselector.read_eq_blank_iff.mp + (by simpa [hpre.2.1] using hread)⟩) + (fun _ work _ hpre hread => + ⟨hpre, fun hzero => hread (by + rw [hpre.2.1] + exact hselector.read_eq_blank_iff.mpr hzero)⟩) + hblank hnonblank + simpa only [dispatchHaltTM, dispatchHaltTime, pre, post] using + hdispatch.consequence (fun _ _ _ h => h) + (fun _ _ _ h => h.elim id id) le_rfl + +/-- Copy the canonical PC, select its fixed-program instruction, and emit its +halt verdict while restoring the complete instruction ABI. -/ +theorem programHaltTM_hoareTime_frame_internal + (tapes : ControlInstructionTapes n) (program : Program) + (store : Store) (pcValue : ℕ) + (initialWork : Fin (n + 1) → Tape) (inp₀ : Tape) + (hready : InstructionExecutionReady tapes store pcValue initialWork) + (hinput : TM.Parked inp₀) : + (programHaltTM tapes program).HoareTime + (fun inp work out => + inp = inp₀ ∧ work = initialWork ∧ + out = (Tape.init []).move Dir3.right) + (fun inp work out => + inp = inp₀ ∧ work = initialWork ∧ + out = instructionHaltOutput + (selectedInstruction program pcValue)) + (programHaltTime tapes program pcValue) := by + let selectorTape := + (Tape.init (pcValue.bits.map Γ.ofBool)).move Dir3.right + let selectorWork := + Function.update initialWork tapes.liftedLhs selectorTape + have hcopy := TM.binaryCopyIntoTM_hoareTime_frame tapes.liftedPC + tapes.liftedLhs tapes.liftedFound tapes.lifted.pc_ne_lhs + (tapes.lifted.pc_ne 11) (tapes.lifted.data.ne (by decide)) pcValue 0 + inp₀ initialWork ((Tape.init []).move Dir3.right) hready.control.pc + hready.control.lookup.destination hready.control.lookup.copyScratch hinput + (fun i _ _ _ => hready.control.lookup.scanner.parked i) blank_parked + have hselectorReady : DispatchReady tapes store pcValue pcValue initialWork + selectorWork := by + exact ⟨hready, rfl⟩ + have hdispatch := dispatchHaltTM_hoareTime_frame_internal tapes program store + pcValue pcValue initialWork selectorWork inp₀ hselectorReady hinput + have hselectorParked : ∀ i, TM.Parked (selectorWork i) := by + intro i + by_cases hi : i = tapes.liftedLhs + · subst i + simp only [selectorWork, Function.update_self] + exact hasBinaryNat_parked + (Tape.init_move_right_hasBinaryNat pcValue) + · simp only [selectorWork, Function.update_of_ne hi] + exact hready.control.lookup.scanner.parked i + have hseq := TM.seqTM_hoareTime + (TM.binaryCopyIntoTM tapes.liftedPC tapes.liftedLhs tapes.liftedFound) + (dispatchHaltTM tapes program) hcopy + (by + rintro inp work out ⟨hinp, hworkEq, hout⟩ + obtain ⟨hi, hw, ho⟩ := phaseTransition_of_parked + (inp := inp) (work := work) (out := out) + (by simpa [hinp] using hinput) + (by simpa [hworkEq, selectorWork, selectorTape] using hselectorParked) + (by simpa [hout] using blank_parked) + rw [hi, hw, ho] + exact ⟨hinp, by simpa [selectorWork, selectorTape] using hworkEq, hout⟩) + hdispatch + simpa only [programHaltTM, programHaltTime, selectorWork, + selectorTape] using hseq + +/-- One loop iteration realizes one pure sparse step and either halts on the +successor's `halt` instruction or returns to the body start with blank output. -/ +theorem programLoopTM_iteration_internal + (tapes : ControlInstructionTapes n) (program : Program) + (snapshot : Snapshot) (initialWork : Fin (n + 1) → Tape) + (inp₀ : Tape) + (hready : InstructionExecutionReady tapes snapshot.store snapshot.pc + initialWork) + (hinput : TM.Parked inp₀) : + let next := snapshot.step program + ∃ (nextWork : Fin (n + 1) → Tape) (time : ℕ), + time ≤ programLoopIterationTime tapes program snapshot ∧ + InstructionExecutionReady tapes next.store next.pc nextWork ∧ + ((next.Halted program ∧ + (programLoopTM tapes program).reachesIn time + { state := (programLoopTM tapes program).qstart + input := inp₀ + work := initialWork + output := (Tape.init []).move Dir3.right } + { state := Sum.inr (Sum.inl TM.LoopPhase.done) + input := inp₀ + work := nextWork + output := instructionHaltOutput (next.curInstr program) }) ∨ + (¬next.Halted program ∧ + (programLoopTM tapes program).reachesIn time + { state := (programLoopTM tapes program).qstart + input := inp₀ + work := initialWork + output := (Tape.init []).move Dir3.right } + { state := (programLoopTM tapes program).qstart + input := inp₀ + work := nextWork + output := (Tape.init []).move Dir3.right })) := by + let next := snapshot.step program + let body := programStepTM tapes program + let test := programHaltTM tapes program + let blank := (Tape.init []).move Dir3.right + have hbody := programStepTM_hoareTime_frame tapes program snapshot.store + snapshot.pc initialWork inp₀ hready hinput + obtain ⟨cbody, bodyTime, hbodyTime, hbodyReach, hbodyHalt, + hbodyInput, hnextReady, hbodyOutput⟩ := + hbody inp₀ initialWork blank ⟨rfl, rfl, rfl⟩ + have hbodyInputParked : TM.Parked cbody.input := by + simpa [hbodyInput] using hinput + have hbodyWorkParked : ∀ i, TM.Parked (cbody.work i) := by + exact hnextReady.control.lookup.scanner.parked + have hbodyOutputParked : TM.Parked cbody.output := by + simpa [hbodyOutput, blank] using blank_parked + have hbodyLoop := TM.loopTM_body_simulation body test hbodyReach + have hbodyTransition : + (⟨test.qstart, TM.transitionInput cbody.input, + fun i => TM.transitionTape (cbody.work i), + TM.transitionTape cbody.output⟩ : Complexity.Cfg (n + 1) test.Q) = + ⟨test.qstart, inp₀, cbody.work, blank⟩ := by + have hi : TM.transitionInput cbody.input = inp₀ := by + rw [hbodyInput] + exact hinput.transitionInput_eq_self + have hw : (fun i => TM.transitionTape (cbody.work i)) = cbody.work := + funext fun i => (hbodyWorkParked i).transitionTape_eq_self + have ho : TM.transitionTape cbody.output = blank := by + rw [hbodyOutput] + exact blank_parked.transitionTape_eq_self + rw [hi, hw, ho] + have hbodyToTest := TM.loopTM_body_to_test body test hbodyHalt + rw [hbodyTransition] at hbodyToTest + have htest := programHaltTM_hoareTime_frame_internal tapes program + next.store next.pc cbody.work inp₀ hnextReady hinput + obtain ⟨ctest, testTime, htestTime, htestReach, htestHalt, + htestInput, htestWork, htestOutput⟩ := + htest inp₀ cbody.work blank ⟨rfl, rfl, rfl⟩ + have hselected : + selectedInstruction program next.pc = next.curInstr program := + selectedInstruction_eq_getElem?_getD program next.pc + have htestOutput' : + ctest.output = instructionHaltOutput (next.curInstr program) := by + simpa only [hselected] using htestOutput + have htestInputParked : TM.Parked ctest.input := by + simpa [htestInput] using hinput + have htestWorkParked : ∀ i, TM.Parked (ctest.work i) := by + simpa [htestWork] using hbodyWorkParked + have htestOutputParked : TM.Parked ctest.output := by + refine ⟨?_, ?_⟩ + · rw [htestOutput', instructionHaltOutput_head_internal] + · rw [htestOutput'] + exact instructionHaltOutput_cells_ne_start_internal _ + have htestTransition : + (⟨(Sum.inr (Sum.inl TM.LoopPhase.rewindOut) : + TM.LoopQ body.Q test.Q), + TM.transitionInput ctest.input, + fun i => TM.transitionTape (ctest.work i), + TM.transitionTape ctest.output⟩ : + Complexity.Cfg (n + 1) (TM.LoopQ body.Q test.Q)) = + ⟨Sum.inr (Sum.inl TM.LoopPhase.rewindOut), inp₀, + cbody.work, ctest.output⟩ := by + have hi : TM.transitionInput ctest.input = inp₀ := by + rw [htestInput] + exact hinput.transitionInput_eq_self + have hw : (fun i => TM.transitionTape (ctest.work i)) = cbody.work := by + funext i + rw [htestWork] + exact (hbodyWorkParked i).transitionTape_eq_self + have ho : TM.transitionTape ctest.output = ctest.output := + htestOutputParked.transitionTape_eq_self + rw [hi, hw, ho] + have htestToRewind := + (TM.loopTM_test_to_rewind body test htestHalt).trans + (congrArg some htestTransition) + obtain ⟨ctail, htailReach, htailState, htailInput, htailWork, + htailOutput⟩ := programLoop_rewind_check_internal body test + ⟨Sum.inr (Sum.inl TM.LoopPhase.rewindOut), inp₀, + cbody.work, ctest.output⟩ rfl hinput.read_ne_start + (fun i => (hbodyWorkParked i).read_ne_start) + (by rw [htestOutput', instructionHaltOutput_head_internal]) + (by rw [htestOutput', instructionHaltOutput_cells_zero_internal]) + (by rw [htestOutput']; exact + instructionHaltOutput_cells_ne_start_internal _) + have hreach := TM.reachesIn_trans _ + (TM.reachesIn_trans _ + (TM.reachesIn_trans _ + (TM.reachesIn_trans _ hbodyLoop (.step hbodyToTest .zero)) + (TM.loopTM_test_simulation body test htestReach)) + (.step htestToRewind .zero)) htailReach + have htime : bodyTime + 1 + testTime + 1 + 3 ≤ + programLoopIterationTime tapes program snapshot := by + dsimp only [next] at htestTime + simp only [programLoopIterationTime] + omega + refine ⟨cbody.work, bodyTime + 1 + testTime + 1 + 3, htime, + hnextReady, ?_⟩ + by_cases hhalted : next.Halted program + · left + refine ⟨hhalted, ?_⟩ + have hone : ctest.output.cells 1 = Γ.one := by + rw [htestOutput'] + exact instructionHaltOutput_cell_one_eq_one_iff_internal _ |>.2 hhalted + have htailDone : ctail.state = Sum.inr (Sum.inl TM.LoopPhase.done) := by + simpa [hone] using htailState + have hcTail : ctail = + { state := Sum.inr (Sum.inl TM.LoopPhase.done) + input := inp₀ + work := cbody.work + output := instructionHaltOutput (next.curInstr program) } := by + cases ctail + simp only [Complexity.Cfg.mk.injEq] + exact ⟨htailDone, htailInput, htailWork, + htailOutput.trans htestOutput'⟩ + simpa only [programLoopTM, body, test, blank, hcTail] using hreach + · right + refine ⟨hhalted, ?_⟩ + have hcur : next.curInstr program ≠ .halt := hhalted + have hblankOutput : ctest.output = blank := by + rw [htestOutput'] + simpa only [blank] using + instructionHaltOutput_eq_blank_of_ne_halt_internal hcur + have hone : ctest.output.cells 1 ≠ Γ.one := by + rw [htestOutput'] + exact fun h => hhalted + (instructionHaltOutput_cell_one_eq_one_iff_internal _ |>.1 h) + have htailStart : ctail.state = Sum.inl body.qstart := by + simpa [hone] using htailState + have hcTail : ctail = + { state := Sum.inl body.qstart + input := inp₀ + work := cbody.work + output := blank } := by + cases ctail + simp only [Complexity.Cfg.mk.injEq] + exact ⟨htailStart, htailInput, htailWork, + htailOutput.trans hblankOutput⟩ + simpa only [programLoopTM, body, test, blank, hcTail] using hreach + +theorem snapshot_step_eq_self_of_halted_internal + (program : Program) (snapshot : Snapshot) + (hhalted : snapshot.Halted program) : + snapshot.step program = snapshot := by + change snapshot.curInstr program = .halt at hhalted + rw [Snapshot.step, hhalted] + rfl + +theorem snapshot_run_halted_internal + (program : Program) (snapshot : Snapshot) + (hhalted : snapshot.Halted program) : + ∀ fuel, snapshot.run program fuel = snapshot + | 0 => rfl + | fuel + 1 => by + rw [Snapshot.run, if_pos hhalted] + +/-- A halted fuel-bounded sparse run is realized by the fixed controller loop. +The extra iteration handles a snapshot that is already halted at fuel zero. -/ +theorem programLoopTM_hoareTime_run_internal + (tapes : ControlInstructionTapes n) (program : Program) : + ∀ (fuel : ℕ) (snapshot : Snapshot) + (initialWork : Fin (n + 1) → Tape) (inp₀ : Tape), + InstructionExecutionReady tapes snapshot.store snapshot.pc initialWork → + TM.Parked inp₀ → + (snapshot.run program fuel).Halted program → + (programLoopTM tapes program).HoareTime + (fun inp work out => + inp = inp₀ ∧ work = initialWork ∧ + out = (Tape.init []).move Dir3.right) + (fun inp work out => + let final := snapshot.run program fuel + inp = inp₀ ∧ + InstructionExecutionReady tapes final.store final.pc work ∧ + out = instructionHaltOutput (final.curInstr program)) + (programLoopTime tapes program (fuel + 1) snapshot) := by + intro fuel + induction fuel with + | zero => + intro snapshot initialWork inp₀ hready hinput hhalted + rintro inp work out ⟨hinp, hwork, hout⟩ + subst inp + subst work + subst out + have hsnapshotHalted : snapshot.Halted program := by + simpa [Snapshot.run] using hhalted + have hstepSelf := snapshot_step_eq_self_of_halted_internal program + snapshot hsnapshotHalted + obtain ⟨nextWork, time, htime, hnextReady, hbranch⟩ := + programLoopTM_iteration_internal tapes program snapshot initialWork + inp₀ hready hinput + rcases hbranch with ⟨hnextHalted, hreach⟩ | + ⟨hnextRunning, _⟩ + · have hready' : InstructionExecutionReady tapes snapshot.store + snapshot.pc nextWork := by + simpa only [hstepSelf] using hnextReady + have hreach' : (programLoopTM tapes program).reachesIn time + { state := (programLoopTM tapes program).qstart + input := inp₀ + work := initialWork + output := (Tape.init []).move Dir3.right } + { state := Sum.inr (Sum.inl TM.LoopPhase.done) + input := inp₀ + work := nextWork + output := instructionHaltOutput + (snapshot.curInstr program) } := by + simpa only [hstepSelf] using hreach + refine ⟨_, time, ?_, hreach', rfl, rfl, ?_, ?_⟩ + · simpa [programLoopTime] using htime + · simpa [Snapshot.run] using hready' + · simp [Snapshot.run] + · exact (hnextRunning (by simpa only [hstepSelf] using + hsnapshotHalted)).elim + | succ fuel ih => + intro snapshot initialWork inp₀ hready hinput hhalted + by_cases hsnapshotHalted : snapshot.Halted program + · rintro inp work out ⟨hinp, hwork, hout⟩ + subst inp + subst work + subst out + have hstepSelf := snapshot_step_eq_self_of_halted_internal program + snapshot hsnapshotHalted + obtain ⟨nextWork, time, htime, hnextReady, hbranch⟩ := + programLoopTM_iteration_internal tapes program snapshot initialWork + inp₀ hready hinput + rcases hbranch with ⟨_, hreach⟩ | ⟨hnextRunning, _⟩ + · have hfinal : snapshot.run program (fuel + 1) = snapshot := + snapshot_run_halted_internal program snapshot hsnapshotHalted _ + have hready' : InstructionExecutionReady tapes snapshot.store + snapshot.pc nextWork := by + simpa only [hstepSelf] using hnextReady + have hreach' : (programLoopTM tapes program).reachesIn time + { state := (programLoopTM tapes program).qstart + input := inp₀ + work := initialWork + output := (Tape.init []).move Dir3.right } + { state := Sum.inr (Sum.inl TM.LoopPhase.done) + input := inp₀ + work := nextWork + output := instructionHaltOutput + (snapshot.curInstr program) } := by + simpa only [hstepSelf] using hreach + refine ⟨_, time, ?_, hreach', rfl, rfl, ?_, ?_⟩ + · simp only [programLoopTime] + omega + · simpa only [hfinal] using hready' + · simp only [hfinal] + · exact (hnextRunning (by simpa only [hstepSelf] using + hsnapshotHalted)).elim + · have hrunHalted : + ((snapshot.step program).run program fuel).Halted program := by + simpa [Snapshot.run, hsnapshotHalted] using hhalted + have hiter := programLoopTM_iteration_internal tapes program snapshot + initialWork inp₀ hready hinput + obtain ⟨nextWork, time₁, htime₁, hnextReady, hbranch⟩ := hiter + rcases hbranch with ⟨hnextHalted, hreach₁⟩ | + ⟨hnextRunning, hreach₁⟩ + · rintro inp work out ⟨hinp, hwork, hout⟩ + subst inp + subst work + subst out + have hfinal : + (snapshot.step program).run program fuel = + snapshot.step program := + snapshot_run_halted_internal program (snapshot.step program) + hnextHalted fuel + refine ⟨_, time₁, ?_, hreach₁, rfl, rfl, ?_, ?_⟩ + · simp only [programLoopTime] + omega + · simpa [Snapshot.run, hsnapshotHalted, hfinal] using hnextReady + · simp [Snapshot.run, hsnapshotHalted, hfinal] + · have hrecursive := ih (snapshot.step program) nextWork inp₀ + hnextReady hinput hrunHalted + rintro inp work out ⟨hinp, hwork, hout⟩ + subst inp + subst work + subst out + obtain ⟨cfinal, time₂, htime₂, hreach₂, hhalt₂, + hfinalInput, hfinalReady, hfinalOutput⟩ := + hrecursive inp₀ nextWork ((Tape.init []).move Dir3.right) + ⟨rfl, rfl, rfl⟩ + refine ⟨cfinal, time₁ + time₂, ?_, + TM.reachesIn_trans _ hreach₁ hreach₂, hhalt₂, + hfinalInput, ?_, ?_⟩ + · change time₁ + time₂ ≤ + programLoopIterationTime tapes program snapshot + + programLoopTime tapes program (fuel + 1) + (snapshot.step program) + exact Nat.add_le_add htime₁ htime₂ + · simpa [Snapshot.run, hsnapshotHalted] using hfinalReady + · simpa [Snapshot.run, hsnapshotHalted] using hfinalOutput + +end Machine + +end RegisterStore + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/WordDecode.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/WordDecode.lean new file mode 100644 index 0000000000..d1ca36fc4a --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/WordDecode.lean @@ -0,0 +1,397 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.WordDecode.Defs +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.WordDecode.Internal +public import +LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.WordDecode.LinearInternal +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Defs + +/-! +# RAM snapshot word-width decoder + +This module exposes the exact framed semantics of the first concrete snapshot +decoder phase. Starting on a self-delimiting word, `wordWidthTM` stops on its +zero separator and leaves the unary-prefix length as a canonical binary +natural on a separate work tape. +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace RegisterStore + +namespace Machine + +/-- Rewind a decoded append-position target to cell one without changing its +binary contents or any framed tape. This converts `HasBinaryPrefix` into the +read-position convention `HasBinaryString` in at most `|bits| + 3` steps. -/ +theorem wordTargetRewind_reachesIn_frame {n : ℕ} + (targetIdx : Fin n) (bits : List Bool) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (htarget : (work₀ targetIdx).HasBinaryPrefix bits) + (htargetStart : (work₀ targetIdx).cells 0 = Γ.start) + (hinput : inp₀.read ≠ Γ.start) + (hother : ∀ i, i ≠ targetIdx → + (work₀ i).read ≠ Γ.start ∧ 1 ≤ (work₀ i).head) + (houtput : out₀.read ≠ Γ.start) (houtputHead : 1 ≤ out₀.head) : + ∃ c' t, + t ≤ bits.length + 3 ∧ + (TM.rewindWorkTM targetIdx).reachesIn t + { state := (TM.rewindWorkTM targetIdx).qstart + input := inp₀ + work := work₀ + output := out₀ } c' ∧ + (TM.rewindWorkTM targetIdx).halted c' ∧ + c'.input = inp₀ ∧ + (c'.work targetIdx).HasBinaryString bits ∧ + (∀ i, i ≠ targetIdx → c'.work i = work₀ i) ∧ + c'.output = out₀ := + wordTargetRewind_reachesIn_frame_internal targetIdx bits inp₀ work₀ out₀ + htarget htargetStart hinput hother houtput houtputHead + +/-- Exact framed execution of unary-width decoding. The source begins at the +first prefix bit, the width counter begins at canonical zero, and all unrelated +tapes are preserved exactly. -/ +theorem wordWidthTM_reachesIn_frame {n : ℕ} + (sourceIdx widthIdx : Fin n) (hindices : sourceIdx ≠ widthIdx) + (width : ℕ) (payload : List Bool) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hsource : (work₀ sourceIdx).HasBinarySuffix + (List.replicate width true ++ false :: payload)) + (hwidth : (work₀ widthIdx).HasBinaryNat 0) + (hinput : inp₀.read ≠ Γ.start) + (hother : ∀ i, i ≠ sourceIdx → i ≠ widthIdx → + (work₀ i).read ≠ Γ.start) + (houtput : out₀.read ≠ Γ.start) : + ∃ c', + (wordWidthTM sourceIdx widthIdx).reachesIn (wordWidthTime width) + { state := (wordWidthTM sourceIdx widthIdx).qstart + input := inp₀ + work := work₀ + output := out₀ } c' ∧ + (wordWidthTM sourceIdx widthIdx).halted c' ∧ + c'.input = inp₀ ∧ + (c'.work sourceIdx).HasBinarySuffix (false :: payload) ∧ + (c'.work widthIdx).HasBinaryNat width ∧ + (∀ i, i ≠ sourceIdx → i ≠ widthIdx → c'.work i = work₀ i) ∧ + c'.output = out₀ := + wordWidthTM_reachesIn_frame_internal sourceIdx widthIdx hindices width + payload inp₀ work₀ out₀ hsource hwidth hinput hother houtput + +/-- Unary-width decoding is safe for one-way-output composition. -/ +theorem wordWidthTM_isTransducer {n : ℕ} (sourceIdx widthIdx : Fin n) : + (wordWidthTM sourceIdx widthIdx).IsTransducer := + wordWidthTM_isTransducer_internal sourceIdx widthIdx + +/-- Exact one-step framed execution of the payload-copy leaf. It consumes one +source bit, appends it to the target, and preserves every unrelated tape. -/ +theorem payloadBitTM_reachesIn_frame {n : ℕ} + (sourceIdx targetIdx : Fin n) (hindices : sourceIdx ≠ targetIdx) + (bit : Bool) (suffix pre : List Bool) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hsource : (work₀ sourceIdx).HasBinarySuffix (bit :: suffix)) + (htarget : (work₀ targetIdx).HasBinaryPrefix pre) + (hinput : inp₀.read ≠ Γ.start) + (hother : ∀ i, i ≠ sourceIdx → i ≠ targetIdx → + (work₀ i).read ≠ Γ.start) + (houtput : out₀.read ≠ Γ.start) : + ∃ c', + (payloadBitTM sourceIdx targetIdx).reachesIn 1 + { state := (payloadBitTM sourceIdx targetIdx).qstart + input := inp₀ + work := work₀ + output := out₀ } c' ∧ + (payloadBitTM sourceIdx targetIdx).halted c' ∧ + c'.input = inp₀ ∧ + (c'.work sourceIdx).HasBinarySuffix suffix ∧ + (c'.work targetIdx).HasBinaryPrefix (pre ++ [bit]) ∧ + (∀ i, i ≠ sourceIdx → i ≠ targetIdx → c'.work i = work₀ i) ∧ + c'.output = out₀ := + payloadBitTM_reachesIn_frame_internal sourceIdx targetIdx hindices bit + suffix pre inp₀ work₀ out₀ hsource htarget hinput hother houtput + +/-- The one-bit payload copier never moves the output head left. -/ +theorem payloadBitTM_isTransducer {n : ℕ} (sourceIdx targetIdx : Fin n) : + (payloadBitTM sourceIdx targetIdx).IsTransducer := + payloadBitTM_isTransducer_internal sourceIdx targetIdx + +/-- The separator phase consumes one zero and otherwise preserves the frame. -/ +theorem wordSeparatorTM_reachesIn_frame {n : ℕ} + (sourceIdx : Fin n) (bits : List Bool) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hsource : (work₀ sourceIdx).HasBinarySuffix (false :: bits)) + (hinput : inp₀.read ≠ Γ.start) + (hother : ∀ i, i ≠ sourceIdx → (work₀ i).read ≠ Γ.start) + (houtput : out₀.read ≠ Γ.start) : + ∃ c', + (wordSeparatorTM sourceIdx).reachesIn 1 + { state := (wordSeparatorTM sourceIdx).qstart + input := inp₀ + work := work₀ + output := out₀ } c' ∧ + (wordSeparatorTM sourceIdx).halted c' ∧ + c'.input = inp₀ ∧ + (c'.work sourceIdx).HasBinarySuffix bits ∧ + (∀ i, i ≠ sourceIdx → c'.work i = work₀ i) ∧ + c'.output = out₀ := + wordSeparatorTM_reachesIn_frame_internal sourceIdx bits inp₀ work₀ out₀ + hsource hinput hother houtput + +/-- Exact framed execution of the bounded payload loop. The source begins on +the first payload bit, the target is an empty appendable prefix, the counter is +zero, and the preserved width tape equals the payload length. The machine +copies the complete payload and leaves the source at the next encoded word. -/ +theorem wordPayloadTM_reachesIn_frame {n : ℕ} + (sourceIdx targetIdx counterIdx widthIdx : Fin n) + (hdistinct : PayloadLoopDistinct sourceIdx targetIdx counterIdx widthIdx) + (payload rest : List Bool) (width : ℕ) (hwidthLength : payload.length = width) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hsource : (work₀ sourceIdx).HasBinarySuffix (payload ++ rest)) + (htarget : (work₀ targetIdx).HasBinaryPrefix []) + (hcounter : (work₀ counterIdx).HasBinaryNat 0) + (hwidth : (work₀ widthIdx).HasBinaryNat width) + (hinput : inp₀.read ≠ Γ.start) + (hother : ∀ i, i ≠ sourceIdx → i ≠ targetIdx → i ≠ counterIdx → + i ≠ widthIdx → (work₀ i).read ≠ Γ.start) + (houtput : out₀.read ≠ Γ.start) : + ∃ c', + (wordPayloadTM sourceIdx targetIdx counterIdx widthIdx).reachesIn + (wordPayloadTime width) + { state := (wordPayloadTM sourceIdx targetIdx counterIdx widthIdx).qstart + input := inp₀ + work := work₀ + output := out₀ } c' ∧ + (wordPayloadTM sourceIdx targetIdx counterIdx widthIdx).halted c' ∧ + c'.input = inp₀ ∧ + (c'.work sourceIdx).HasBinarySuffix rest ∧ + (c'.work targetIdx).HasBinaryPrefix payload ∧ + (c'.work counterIdx).HasBinaryNat width ∧ + (c'.work widthIdx).HasBinaryNat width ∧ + (∀ i, i ≠ sourceIdx → i ≠ targetIdx → i ≠ counterIdx → + i ≠ widthIdx → c'.work i = work₀ i) ∧ + c'.output = out₀ := + wordPayloadTM_reachesIn_frame_internal sourceIdx targetIdx counterIdx widthIdx + hdistinct payload rest width hwidthLength inp₀ work₀ out₀ hsource htarget + hcounter hwidth hinput hother houtput + +/-- The bounded payload loop preserves one-way-output safety. -/ +theorem wordPayloadTM_isTransducer {n : ℕ} + (sourceIdx targetIdx counterIdx widthIdx : Fin n) : + (wordPayloadTM sourceIdx targetIdx counterIdx widthIdx).IsTransducer := + wordPayloadTM_isTransducer_internal sourceIdx targetIdx counterIdx widthIdx + +/-- Exact end-to-end decoding of one self-delimiting width/payload layout. +The source is left at the next word and the target contains the complete +payload as an appendable binary prefix. -/ +theorem wordDecodeTM_reachesIn_frame {n : ℕ} + (sourceIdx targetIdx counterIdx widthIdx : Fin n) + (hdistinct : PayloadLoopDistinct sourceIdx targetIdx counterIdx widthIdx) + (payload rest : List Bool) (width : ℕ) (hwidthLength : payload.length = width) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hsource : (work₀ sourceIdx).HasBinarySuffix + (List.replicate width true ++ false :: (payload ++ rest))) + (htarget : (work₀ targetIdx).HasBinaryPrefix []) + (hcounter : (work₀ counterIdx).HasBinaryNat 0) + (hwidth : (work₀ widthIdx).HasBinaryNat 0) + (hinput : inp₀.read ≠ Γ.start) + (hother : ∀ i, i ≠ sourceIdx → i ≠ targetIdx → i ≠ counterIdx → + i ≠ widthIdx → (work₀ i).read ≠ Γ.start) + (houtput : out₀.read ≠ Γ.start) : + ∃ c', + (wordDecodeTM sourceIdx targetIdx counterIdx widthIdx).reachesIn + (wordDecodeTime width) + { state := (wordDecodeTM sourceIdx targetIdx counterIdx widthIdx).qstart + input := inp₀ + work := work₀ + output := out₀ } c' ∧ + (wordDecodeTM sourceIdx targetIdx counterIdx widthIdx).halted c' ∧ + c'.input = inp₀ ∧ + (c'.work sourceIdx).HasBinarySuffix rest ∧ + (c'.work targetIdx).HasBinaryPrefix payload ∧ + (c'.work counterIdx).HasBinaryNat width ∧ + (c'.work widthIdx).HasBinaryNat width ∧ + (∀ i, i ≠ sourceIdx → i ≠ targetIdx → i ≠ counterIdx → + i ≠ widthIdx → c'.work i = work₀ i) ∧ + c'.output = out₀ := + wordDecodeTM_reachesIn_frame_internal sourceIdx targetIdx counterIdx widthIdx + hdistinct payload rest width hwidthLength inp₀ work₀ out₀ hsource htarget + hcounter hwidth hinput hother houtput + +/-- Coarse all-prefix space envelope for complete word decoding. Starting from +auxiliary-space budget `initialSpace`, no prefix of the exact decoder run can +use more than `initialSpace + wordDecodeTime width`; this follows from the +one-cell-per-transition head-growth bound and is independent of endpoint +correctness. -/ +theorem wordDecodeTM_prefix_withinAuxSpace {n : ℕ} + (sourceIdx targetIdx counterIdx widthIdx : Fin n) + (width inputLength initialSpace time : ℕ) + (start current : Complexity.Cfg n + (wordDecodeTM sourceIdx targetIdx counterIdx widthIdx).Q) + (hinitial : start.WithinAuxSpace inputLength initialSpace) + (hreach : (wordDecodeTM sourceIdx targetIdx counterIdx widthIdx).reachesIn + time start current) + (htime : time ≤ wordDecodeTime width) : + current.WithinAuxSpace inputLength (initialSpace + wordDecodeTime width) := + (hinitial.reachesIn hreach).mono le_rfl (by omega) + +/-- A canonical `WordCode.encode` prefix decodes to the natural's canonical +little-endian bit string and leaves the following encoded stream untouched. -/ +theorem wordDecodeTM_reachesIn_frame_encode {n : ℕ} + (sourceIdx targetIdx counterIdx widthIdx : Fin n) + (hdistinct : PayloadLoopDistinct sourceIdx targetIdx counterIdx widthIdx) + (value : ℕ) (rest : List Bool) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hsource : (work₀ sourceIdx).HasBinarySuffix (WordCode.encode value ++ rest)) + (htarget : (work₀ targetIdx).HasBinaryPrefix []) + (hcounter : (work₀ counterIdx).HasBinaryNat 0) + (hwidth : (work₀ widthIdx).HasBinaryNat 0) + (hinput : inp₀.read ≠ Γ.start) + (hother : ∀ i, i ≠ sourceIdx → i ≠ targetIdx → i ≠ counterIdx → + i ≠ widthIdx → (work₀ i).read ≠ Γ.start) + (houtput : out₀.read ≠ Γ.start) : + ∃ c', + (wordDecodeTM sourceIdx targetIdx counterIdx widthIdx).reachesIn + (wordDecodeTime (bitlen value)) + { state := (wordDecodeTM sourceIdx targetIdx counterIdx widthIdx).qstart + input := inp₀ + work := work₀ + output := out₀ } c' ∧ + (wordDecodeTM sourceIdx targetIdx counterIdx widthIdx).halted c' ∧ + c'.input = inp₀ ∧ + (c'.work sourceIdx).HasBinarySuffix rest ∧ + (c'.work targetIdx).HasBinaryPrefix value.bits ∧ + (c'.work counterIdx).HasBinaryNat (bitlen value) ∧ + (c'.work widthIdx).HasBinaryNat (bitlen value) ∧ + (∀ i, i ≠ sourceIdx → i ≠ targetIdx → i ≠ counterIdx → + i ≠ widthIdx → c'.work i = work₀ i) ∧ + c'.output = out₀ := by + have hsource' : (work₀ sourceIdx).HasBinarySuffix + (List.replicate (bitlen value) true ++ + false :: (Nat.toBitsLE (bitlen value) value ++ rest)) := by + simpa [WordCode.encode, List.append_assoc] using hsource + obtain ⟨c', hreach, hhalt, hinput', hsource'', htarget', hcounter', + hwidth', hframe, houtput'⟩ := + wordDecodeTM_reachesIn_frame sourceIdx targetIdx counterIdx widthIdx + hdistinct (Nat.toBitsLE (bitlen value) value) rest (bitlen value) + (by simp) inp₀ work₀ out₀ hsource' htarget hcounter hwidth hinput hother houtput + refine ⟨c', hreach, hhalt, hinput', hsource'', ?_, hcounter', hwidth', + hframe, houtput'⟩ + simpa [bitlen, Nat.toBitsLE_size] using htarget' + +/-- The existing checked decoder is quasi-linear in the decoded word width. +This tightens the former quadratic charging by retaining the bit-width of the +binary loop limit instead of replacing it by the limit's numeric value. -/ +theorem wordDecodeTime_le_size (width : ℕ) : + wordDecodeTime width ≤ + 8 * (width + 1) * (width.size + 2) := + wordDecodeTime_le_size_internal width + +/-- Complete word decoding preserves one-way-output safety. -/ +theorem wordDecodeTM_isTransducer {n : ℕ} + (sourceIdx targetIdx counterIdx widthIdx : Fin n) : + (wordDecodeTM sourceIdx targetIdx counterIdx widthIdx).IsTransducer := + wordDecodeTM_isTransducer_internal sourceIdx targetIdx counterIdx widthIdx + +/-! ## Linear unary-marker decoder -/ + +/-- Exact framed execution of the optimized decoder. It uses one unary marker +instead of a binary width/counter pair and takes exactly `3 * width + 3` +transitions. -/ +theorem wordDecodeLinearTM_reachesIn_frame {n : ℕ} + (sourceIdx targetIdx markerIdx : Fin n) + (hdistinct : LinearWordDistinct sourceIdx targetIdx markerIdx) + (payload rest : List Bool) (width : ℕ) (hwidth : payload.length = width) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hsource : (work₀ sourceIdx).HasBinarySuffix + (List.replicate width true ++ false :: (payload ++ rest))) + (htarget : (work₀ targetIdx).HasBinaryPrefix []) + (hmarker : (work₀ markerIdx).HasBinaryPrefix []) + (hmarkerStart : (work₀ markerIdx).cells 0 = Γ.start) + (hinput : inp₀.read ≠ Γ.start) + (hreads : ∀ i, (work₀ i).read ≠ Γ.start) + (houtput : out₀.read ≠ Γ.start) : + ∃ c', + (wordDecodeLinearTM sourceIdx targetIdx markerIdx).reachesIn + (wordDecodeLinearTime width) + { state := (wordDecodeLinearTM sourceIdx targetIdx markerIdx).qstart + input := inp₀ + work := work₀ + output := out₀ } c' ∧ + (wordDecodeLinearTM sourceIdx targetIdx markerIdx).halted c' ∧ + c'.input = inp₀ ∧ + (c'.work sourceIdx).HasBinarySuffix rest ∧ + (c'.work targetIdx).HasBinaryPrefix payload ∧ + (c'.work markerIdx).HasBinaryPrefix (List.replicate width true) ∧ + (∀ i, i ≠ sourceIdx → i ≠ targetIdx → i ≠ markerIdx → + c'.work i = work₀ i) ∧ + c'.output = out₀ := + wordDecodeLinearTM_reachesIn_frame_internal sourceIdx targetIdx markerIdx + hdistinct payload rest width hwidth inp₀ work₀ out₀ hsource htarget + hmarker hmarkerStart hinput hreads houtput + +/-- The optimized decoder handles a canonical natural-number word in time +linear in the encoded word width. -/ +theorem wordDecodeLinearTM_reachesIn_frame_encode {n : ℕ} + (sourceIdx targetIdx markerIdx : Fin n) + (hdistinct : LinearWordDistinct sourceIdx targetIdx markerIdx) + (value : ℕ) (rest : List Bool) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hsource : (work₀ sourceIdx).HasBinarySuffix (WordCode.encode value ++ rest)) + (htarget : (work₀ targetIdx).HasBinaryPrefix []) + (hmarker : (work₀ markerIdx).HasBinaryPrefix []) + (hmarkerStart : (work₀ markerIdx).cells 0 = Γ.start) + (hinput : inp₀.read ≠ Γ.start) + (hreads : ∀ i, (work₀ i).read ≠ Γ.start) + (houtput : out₀.read ≠ Γ.start) : + ∃ c', + (wordDecodeLinearTM sourceIdx targetIdx markerIdx).reachesIn + (wordDecodeLinearTime (bitlen value)) + { state := (wordDecodeLinearTM sourceIdx targetIdx markerIdx).qstart + input := inp₀ + work := work₀ + output := out₀ } c' ∧ + (wordDecodeLinearTM sourceIdx targetIdx markerIdx).halted c' ∧ + c'.input = inp₀ ∧ + (c'.work sourceIdx).HasBinarySuffix rest ∧ + (c'.work targetIdx).HasBinaryPrefix value.bits ∧ + (c'.work markerIdx).HasBinaryPrefix + (List.replicate (bitlen value) true) ∧ + (∀ i, i ≠ sourceIdx → i ≠ targetIdx → i ≠ markerIdx → + c'.work i = work₀ i) ∧ + c'.output = out₀ := by + have hsource' : (work₀ sourceIdx).HasBinarySuffix + (List.replicate (bitlen value) true ++ + false :: (Nat.toBitsLE (bitlen value) value ++ rest)) := by + simpa [WordCode.encode, List.append_assoc] using hsource + obtain ⟨c', hreach, hhalt, hinput', hsource'', htarget', hmarker', + hframe, houtput'⟩ := + wordDecodeLinearTM_reachesIn_frame sourceIdx targetIdx markerIdx hdistinct + (Nat.toBitsLE (bitlen value) value) rest (bitlen value) (by simp) + inp₀ work₀ out₀ hsource' htarget hmarker hmarkerStart hinput hreads houtput + refine ⟨c', hreach, hhalt, hinput', hsource'', ?_, hmarker', hframe, houtput'⟩ + simpa [bitlen, Nat.toBitsLE_size] using htarget' + +/-- The optimized decoder never moves the output head left. -/ +theorem wordDecodeLinearTM_isTransducer {n : ℕ} + (sourceIdx targetIdx markerIdx : Fin n) : + (wordDecodeLinearTM sourceIdx targetIdx markerIdx).IsTransducer := + wordDecodeLinearTM_isTransducer_internal sourceIdx targetIdx markerIdx + +end Machine + +end RegisterStore + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/WordDecode/Defs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/WordDecode/Defs.lean new file mode 100644 index 0000000000..c0551b3702 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/WordDecode/Defs.lean @@ -0,0 +1,368 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.ForWorkOnes.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryFor.Defs + +/-! +# RAM snapshot word-width decoder — definitions + +`RAM.RegisterStore.Machine.wordWidthTM` is the first concrete Turing-machine +phase of the reverse RAM simulation. It scans the unary-width prefix of one +self-delimiting snapshot word and increments a canonical binary counter once +per `1`. The source head stops on the zero separator, ready for the payload +copy phase. +-/ + + +@[expose] public section + +namespace Complexity + +namespace RAM + +namespace RegisterStore + +namespace Machine + +/-- Scan the unary prefix on work tape `sourceIdx` and store its length in +canonical little-endian binary on work tape `widthIdx`. The two indices must +be distinct for the semantic theorem. -/ +def wordWidthTM {n : ℕ} (sourceIdx widthIdx : Fin n) : TM n := + TM.forWorkOnesTM sourceIdx (TM.binarySuccTM widthIdx) + +/-- Exact transition count for decoding a unary prefix of length `width`. -/ +def wordWidthTime (width : ℕ) : ℕ := + TM.forWorkOnesLoopTime TM.binarySuccTime 0 width + +/-- Control states for copying one fixed-width payload bit. -/ +inductive PayloadBitPhase where + | copy + | done + deriving DecidableEq + +/-- `PayloadBitPhase` has exactly two states. -/ +instance instFintypePayloadBitPhase : Fintype PayloadBitPhase where + elems := {.copy, .done} + complete := fun phase => by cases phase <;> simp + +/-- Copy the bit under `sourceIdx` to the append position on `targetIdx`, +advancing both heads once. The semantic theorem assumes distinct indices and +that the source reads a bit. -/ +def payloadBitTM {n : ℕ} (sourceIdx targetIdx : Fin n) : TM n where + Q := PayloadBitPhase + qstart := .copy + qhalt := .done + δ := fun state iHead wHeads oHead => + match state with + | .copy => + match wHeads sourceIdx with + | .zero | .one => + (.done, + fun i => + if i = targetIdx then Γw.ofBool (wHeads sourceIdx = Γ.one) + else TM.readBackWrite (wHeads i), + TM.readBackWrite oHead, + TM.idleDir iHead, + fun i => + if i = sourceIdx then Dir3.right + else if i = targetIdx then Dir3.right + else TM.idleDir (wHeads i), + TM.idleDir oHead) + | .blank => TM.allReadBack .done iHead wHeads oHead + | .start => TM.allIdle .copy iHead wHeads oHead + | .done => TM.allIdle .done iHead wHeads oHead + δ_right_of_start := by + intro state iHead wHeads oHead + cases state with + | copy => + cases hsource : wHeads sourceIdx with + | zero | one => + refine ⟨TM.idleDir_right_of_start, ?_, TM.idleDir_right_of_start⟩ + intro i hi + by_cases his : i = sourceIdx + · simp [his] + · by_cases hit : i = targetIdx + · simp [hit] + · simp [his, hit, TM.idleDir_right_of_start hi] + | blank => exact TM.rightOfStart_allReadBack iHead wHeads oHead + | start => exact TM.rightOfStart_allIdle iHead wHeads oHead + | done => exact TM.rightOfStart_allIdle iHead wHeads oHead + +/-- Pairwise distinct work tapes used by the bounded payload decoder. -/ +structure PayloadLoopDistinct {n : ℕ} + (sourceIdx targetIdx counterIdx widthIdx : Fin n) : Prop where + /-- Source and target tapes are distinct. -/ + source_target : sourceIdx ≠ targetIdx + /-- Source and loop-counter tapes are distinct. -/ + source_counter : sourceIdx ≠ counterIdx + /-- Source and width-limit tapes are distinct. -/ + source_width : sourceIdx ≠ widthIdx + /-- Target and loop-counter tapes are distinct. -/ + target_counter : targetIdx ≠ counterIdx + /-- Target and width-limit tapes are distinct. -/ + target_width : targetIdx ≠ widthIdx + /-- Counter and width-limit tapes are distinct. -/ + counter_width : counterIdx ≠ widthIdx + +/-- Copy exactly the number of payload bits recorded on `widthIdx`. +`counterIdx` is the canonical binary loop counter and `targetIdx` is an +appendable binary prefix. -/ +def wordPayloadTM {n : ℕ} + (sourceIdx targetIdx counterIdx widthIdx : Fin n) : TM n := + TM.binaryForTM (payloadBitTM sourceIdx targetIdx) counterIdx widthIdx + +/-- Exact transition count for a complete fixed-width payload copy. -/ +def wordPayloadTime (width : ℕ) : ℕ := + TM.binaryForLoopTime (fun _ => 1) width 0 width + +/-- Control states for consuming the zero separator between a word's unary +width and fixed-width payload. -/ +inductive WordSeparatorPhase where + | skip + | done + deriving DecidableEq + +/-- `WordSeparatorPhase` has exactly two states. -/ +instance instFintypeWordSeparatorPhase : Fintype WordSeparatorPhase where + elems := {.skip, .done} + complete := fun phase => by cases phase <;> simp + +/-- Consume exactly one zero separator on the selected source work tape. -/ +def wordSeparatorTM {n : ℕ} (sourceIdx : Fin n) : TM n where + Q := WordSeparatorPhase + qstart := .skip + qhalt := .done + δ := fun state iHead wHeads oHead => + match state with + | .skip => + if wHeads sourceIdx = Γ.zero then + (.done, fun i => TM.readBackWrite (wHeads i), TM.readBackWrite oHead, + TM.idleDir iHead, + fun i => if i = sourceIdx then Dir3.right else TM.idleDir (wHeads i), + TM.idleDir oHead) + else if wHeads sourceIdx = Γ.start then + TM.allIdle .skip iHead wHeads oHead + else + TM.allReadBack .done iHead wHeads oHead + | .done => TM.allIdle .done iHead wHeads oHead + δ_right_of_start := by + intro state iHead wHeads oHead + cases state with + | skip => + dsimp only + split + · refine ⟨TM.idleDir_right_of_start, ?_, TM.idleDir_right_of_start⟩ + intro i hi + by_cases his : i = sourceIdx + · simp [his] + · simp [his, TM.idleDir_right_of_start hi] + · split + · exact TM.rightOfStart_allIdle iHead wHeads oHead + · exact TM.rightOfStart_allReadBack iHead wHeads oHead + | done => exact TM.rightOfStart_allIdle iHead wHeads oHead + +/-- Decode one complete self-delimiting word by scanning its unary width, +consuming the separator, and copying exactly that many payload bits. -/ +def wordDecodeTM {n : ℕ} + (sourceIdx targetIdx counterIdx widthIdx : Fin n) : TM n := + TM.seqTM (wordWidthTM sourceIdx widthIdx) + (TM.seqTM (wordSeparatorTM sourceIdx) + (wordPayloadTM sourceIdx targetIdx counterIdx widthIdx)) + +/-- Exact transition count for complete word decoding, including both +sequential-composition seams. -/ +def wordDecodeTime (width : ℕ) : ℕ := + wordWidthTime width + 1 + (1 + 1 + wordPayloadTime width) + +/-! ## Linear unary-marker decoder -/ + +/-- Pairwise-distinct source, target, and unary-marker tapes for the optimized +word decoder. -/ +structure LinearWordDistinct {n : ℕ} + (sourceIdx targetIdx markerIdx : Fin n) : Prop where + /-- Source and target tapes are distinct. -/ + source_target : sourceIdx ≠ targetIdx + /-- Source and marker tapes are distinct. -/ + source_marker : sourceIdx ≠ markerIdx + /-- Target and marker tapes are distinct. -/ + target_marker : targetIdx ≠ markerIdx + +/-- Control phases of the optimized self-delimiting word decoder. -/ +inductive LinearWordPhase where + /-- Copy the unary width prefix to the marker tape. -/ + | mark + /-- Rewind the copied unary marker while parking the payload cursor. -/ + | rewind + /-- Consume one marker and copy one payload bit per transition. -/ + | copy + /-- Halt after the marker is exhausted. -/ + | done + deriving DecidableEq + +/-- `LinearWordPhase` has exactly four states. -/ +instance instFintypeLinearWordPhase : Fintype LinearWordPhase where + elems := {.mark, .rewind, .copy, .done} + complete := fun phase => by cases phase <;> simp + +/-- Decode one unary-width/fixed-payload word in a single linear pass. + +The prefix pass copies one unary marker per width bit. After rewinding that +marker tape, the payload pass advances source, target, and marker together. +This removes the old payload loop's repeated full binary-counter comparison. +The marker tape starts as an empty appendable prefix and finishes containing +`width` ones with its head on the following blank. -/ +def wordDecodeLinearTM {n : ℕ} + (sourceIdx targetIdx markerIdx : Fin n) : TM n where + Q := LinearWordPhase + qstart := .mark + qhalt := .done + δ := fun phase iHead wHeads oHead => + match phase with + | .mark => + match wHeads sourceIdx with + | .one => + (.mark, + fun i => + if i = markerIdx then Γw.one else TM.readBackWrite (wHeads i), + TM.readBackWrite oHead, + TM.idleDir iHead, + fun i => + if i = sourceIdx then Dir3.right + else if i = markerIdx then Dir3.right + else TM.idleDir (wHeads i), + TM.idleDir oHead) + | .zero => + (.rewind, fun i => TM.readBackWrite (wHeads i), + TM.readBackWrite oHead, TM.idleDir iHead, + fun i => + if i = sourceIdx then Dir3.right + else if i = markerIdx then TM.moveLeftDir (wHeads i) + else TM.idleDir (wHeads i), + TM.idleDir oHead) + | .blank => TM.allReadBack .done iHead wHeads oHead + | .start => TM.allIdle .mark iHead wHeads oHead + | .rewind => + if wHeads markerIdx = Γ.start then + (.copy, fun i => TM.readBackWrite (wHeads i), + TM.readBackWrite oHead, TM.idleDir iHead, + fun i => + if i = markerIdx then Dir3.right else TM.idleDir (wHeads i), + TM.idleDir oHead) + else + (.rewind, fun i => TM.readBackWrite (wHeads i), + TM.readBackWrite oHead, TM.idleDir iHead, + fun i => + if i = markerIdx then TM.moveLeftDir (wHeads i) + else TM.idleDir (wHeads i), + TM.idleDir oHead) + | .copy => + match wHeads markerIdx with + | .one => + match wHeads sourceIdx with + | .zero | .one => + (.copy, + fun i => + if i = targetIdx then + Γw.ofBool (wHeads sourceIdx = Γ.one) + else TM.readBackWrite (wHeads i), + TM.readBackWrite oHead, TM.idleDir iHead, + fun i => + if i = sourceIdx then Dir3.right + else if i = targetIdx then Dir3.right + else if i = markerIdx then Dir3.right + else TM.idleDir (wHeads i), + TM.idleDir oHead) + | .blank | .start => TM.allReadBack .done iHead wHeads oHead + | .start => + (.copy, fun i => TM.readBackWrite (wHeads i), + TM.readBackWrite oHead, TM.idleDir iHead, + fun i => + if i = markerIdx then Dir3.right else TM.idleDir (wHeads i), + TM.idleDir oHead) + | .zero | .blank => TM.allReadBack .done iHead wHeads oHead + | .done => TM.allIdle .done iHead wHeads oHead + δ_right_of_start := by + intro phase iHead wHeads oHead + cases phase with + | mark => + cases hsource : wHeads sourceIdx with + | one => + refine ⟨TM.idleDir_right_of_start, ?_, + TM.idleDir_right_of_start⟩ + intro i hi + by_cases his : i = sourceIdx + · simp [his] + · by_cases him : i = markerIdx + · simp [him] + · simp [his, him, TM.idleDir_right_of_start hi] + | zero => + refine ⟨TM.idleDir_right_of_start, ?_, + TM.idleDir_right_of_start⟩ + intro i hi + by_cases his : i = sourceIdx + · simp [his] + · by_cases him : i = markerIdx + · subst i + simp [his, TM.moveLeftDir_right_of_start hi] + · simp [his, him, TM.idleDir_right_of_start hi] + | blank => exact TM.rightOfStart_allReadBack iHead wHeads oHead + | start => exact TM.rightOfStart_allIdle iHead wHeads oHead + | rewind => + dsimp only + split + · refine ⟨TM.idleDir_right_of_start, ?_, + TM.idleDir_right_of_start⟩ + intro i hi + by_cases him : i = markerIdx + · simp [him] + · simp [him, TM.idleDir_right_of_start hi] + · refine ⟨TM.idleDir_right_of_start, ?_, + TM.idleDir_right_of_start⟩ + intro i hi + by_cases him : i = markerIdx + · subst i + simpa only [if_pos] using TM.moveLeftDir_right_of_start hi + · simp [him, TM.idleDir_right_of_start hi] + | copy => + cases hmarker : wHeads markerIdx with + | one => + cases hsource : wHeads sourceIdx with + | zero | one => + refine ⟨TM.idleDir_right_of_start, ?_, + TM.idleDir_right_of_start⟩ + intro i hi + by_cases his : i = sourceIdx + · simp [his] + · by_cases hit : i = targetIdx + · simp [hit] + · by_cases him : i = markerIdx + · simp [him] + · simp [his, hit, him, TM.idleDir_right_of_start hi] + | blank | start => exact TM.rightOfStart_allReadBack iHead wHeads oHead + | start => + refine ⟨TM.idleDir_right_of_start, ?_, + TM.idleDir_right_of_start⟩ + intro i hi + by_cases him : i = markerIdx + · simp [him] + · simp [him, TM.idleDir_right_of_start hi] + | zero | blank => exact TM.rightOfStart_allReadBack iHead wHeads oHead + | done => exact TM.rightOfStart_allIdle iHead wHeads oHead + +/-- Exact transition count of the optimized decoder on a well-formed width +`width` word. -/ +def wordDecodeLinearTime (width : ℕ) : ℕ := + 3 * width + 3 + +end Machine + +end RegisterStore + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/WordDecode/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/WordDecode/Internal.lean new file mode 100644 index 0000000000..35da749133 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/WordDecode/Internal.lean @@ -0,0 +1,1528 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.WordDecode.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.ForWorkOnes.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinarySucc +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryFor.Internal.Comparison +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryFor.Internal.Loop +public import Mathlib.Data.Rat.Cast.Order +public import Mathlib.Tactic.Linarith.Frontend +public import Mathlib.Tactic.NormNum.Abs +public import Mathlib.Tactic.NormNum.DivMod +public import Mathlib.Tactic.NormNum.OfScientific + +/-! +# RAM snapshot word-width decoder — proof internals + +The proof constructs the exact scanner, successor-body, and loopback frames +needed by `TM.ForWorkOnesLoopSpec`. The only changed tapes are the source +cursor and the canonical binary width counter. +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace RegisterStore + +namespace Machine + +variable {n : ℕ} + +theorem wordTargetRewind_reachesIn_frame_internal {n : ℕ} + (targetIdx : Fin n) (bits : List Bool) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (htarget : (work₀ targetIdx).HasBinaryPrefix bits) + (htargetStart : (work₀ targetIdx).cells 0 = Γ.start) + (hinput : inp₀.read ≠ Γ.start) + (hother : ∀ i, i ≠ targetIdx → + (work₀ i).read ≠ Γ.start ∧ 1 ≤ (work₀ i).head) + (houtput : out₀.read ≠ Γ.start) (houtputHead : 1 ≤ out₀.head) : + ∃ c' t, + t ≤ bits.length + 3 ∧ + (TM.rewindWorkTM targetIdx).reachesIn t + { state := (TM.rewindWorkTM targetIdx).qstart + input := inp₀ + work := work₀ + output := out₀ } c' ∧ + (TM.rewindWorkTM targetIdx).halted c' ∧ + c'.input = inp₀ ∧ + (c'.work targetIdx).HasBinaryString bits ∧ + (∀ i, i ≠ targetIdx → c'.work i = work₀ i) ∧ + c'.output = out₀ := by + let Frame : TapePred n := fun inp work out => + inp = inp₀ ∧ + (work targetIdx).HasBinaryContent bits ∧ + (∀ i, i ≠ targetIdx → work i = work₀ i) ∧ + out = out₀ + have hrewind := TM.rewindWorkTM_hoareTime_frame targetIdx (bits.length + 1) + (P := Frame) (by + intro inp work out inp' work' out' hframe htargetCells htargetHead + hotherWork hinputEq houtputCells houtputHeadEq + rcases hframe with ⟨hframeInput, hframeTarget, hframeOther, hframeOutput⟩ + refine ⟨hinputEq.trans hframeInput, ?_, ?_, ?_⟩ + · simpa only [Tape.HasBinaryContent, htargetCells] using hframeTarget + · intro i hi + exact (hotherWork i hi).trans (hframeOther i hi) + · exact (Tape.ext houtputHeadEq houtputCells).trans hframeOutput) + obtain ⟨c', t, htime, hreach, hhalt, hhead, hframe⟩ := + hrewind inp₀ work₀ out₀ (by + refine ⟨htargetStart, Tape.cells_ne_start_of_hasBinaryPrefix htarget, + ?_, hinput, houtput, houtputHead, hother, rfl, htarget.2, + (fun _ _ => rfl), rfl⟩ + rw [htarget.1]) + rcases hframe with ⟨hfinalInput, hfinalTarget, hfinalOther, hfinalOutput⟩ + exact ⟨c', t, by omega, hreach, hhalt, hfinalInput, + hfinalTarget.hasBinaryString hhead, hfinalOther, hfinalOutput⟩ + +private def advanceRight (tape : Tape) : ℕ → Tape + | 0 => tape + | steps + 1 => (advanceRight tape steps).move Dir3.right + +private def binaryNatTape (value : ℕ) : Tape := + (Tape.init (value.bits.map Γ.ofBool)).move Dir3.right + +private def wordWidthWork (sourceIdx widthIdx : Fin n) + (work₀ : Fin n → Tape) (sourceSteps value : ℕ) : Fin n → Tape := + Function.update + (Function.update work₀ sourceIdx (advanceRight (work₀ sourceIdx) sourceSteps)) + widthIdx (binaryNatTape value) + +private def scanCfg (sourceIdx widthIdx : Fin n) (inp₀ : Tape) + (work₀ : Fin n → Tape) (out₀ : Tape) (value : ℕ) : + Cfg n (wordWidthTM sourceIdx widthIdx).Q := + { state := .inl .scan + input := inp₀ + work := wordWidthWork sourceIdx widthIdx work₀ value value + output := out₀ } + +private def bodyStartCfg (sourceIdx widthIdx : Fin n) (inp₀ : Tape) + (work₀ : Fin n → Tape) (out₀ : Tape) (value : ℕ) : + Cfg n (TM.binarySuccTM widthIdx).Q := + { state := (TM.binarySuccTM widthIdx).qstart + input := inp₀ + work := wordWidthWork sourceIdx widthIdx work₀ (value + 1) value + output := out₀ } + +private def bodyDoneCfg (sourceIdx widthIdx : Fin n) (inp₀ : Tape) + (work₀ : Fin n → Tape) (out₀ : Tape) (value : ℕ) : + Cfg n (TM.binarySuccTM widthIdx).Q := + { state := (TM.binarySuccTM widthIdx).qhalt + input := inp₀ + work := wordWidthWork sourceIdx widthIdx work₀ (value + 1) (value + 1) + output := out₀ } + +private def doneCfg (sourceIdx widthIdx : Fin n) (width : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) : + Cfg n (wordWidthTM sourceIdx widthIdx).Q := + { state := .inl .done + input := inp₀ + work := wordWidthWork sourceIdx widthIdx work₀ width width + output := out₀ } + +private theorem advanceRight_add (tape : Tape) (first second : ℕ) : + advanceRight tape (first + second) = + advanceRight (advanceRight tape first) second := by + induction second with + | zero => simp [advanceRight] + | succ second ih => + simpa [advanceRight, Nat.add_assoc] using + congrArg (fun t => t.move Dir3.right) ih + +private theorem advanceRight_hasBinarySuffix_append (tape : Tape) + (pre suffix : List Bool) + (h : tape.HasBinarySuffix (pre ++ suffix)) : + (advanceRight tape pre.length).HasBinarySuffix suffix := by + induction pre generalizing tape with + | nil => simpa [advanceRight] using h + | cons bit pre ih => + have hmove : (tape.move Dir3.right).HasBinarySuffix (pre ++ suffix) := + h.move_right_cons + have htail := ih (tape := tape.move Dir3.right) hmove + change (advanceRight tape (pre.length + 1)).HasBinarySuffix suffix + rw [Nat.add_comm pre.length 1, advanceRight_add tape 1 pre.length] + simpa [advanceRight] using htail + +private theorem replicate_split (width value : ℕ) (hvalue : value ≤ width) : + List.replicate width true = + List.replicate value true ++ List.replicate (width - value) true := by + rw [← List.replicate_add] + congr + omega + +private theorem source_suffix (sourceIdx : Fin n) (work₀ : Fin n → Tape) + (width value : ℕ) (payload : List Bool) (hvalue : value ≤ width) + (hsource : (work₀ sourceIdx).HasBinarySuffix + (List.replicate width true ++ false :: payload)) : + (advanceRight (work₀ sourceIdx) value).HasBinarySuffix + (List.replicate (width - value) true ++ false :: payload) := by + have hsplit : + List.replicate width true ++ false :: payload = + List.replicate value true ++ + (List.replicate (width - value) true ++ false :: payload) := by + rw [replicate_split width value hvalue, List.append_assoc] + rw [hsplit] at hsource + simpa using advanceRight_hasBinarySuffix_append + (work₀ sourceIdx) (List.replicate value true) + (List.replicate (width - value) true ++ false :: payload) hsource + +private theorem source_read_one (sourceIdx : Fin n) (work₀ : Fin n → Tape) + (width value : ℕ) (payload : List Bool) (hvalue : value < width) + (hsource : (work₀ sourceIdx).HasBinarySuffix + (List.replicate width true ++ false :: payload)) : + (advanceRight (work₀ sourceIdx) value).read = Γ.one := by + have hsuffix := source_suffix sourceIdx work₀ width value payload + (Nat.le_of_lt hvalue) hsource + have hpositive : 0 < width - value := by omega + have hshape : List.replicate (width - value) true = + true :: List.replicate (width - value - 1) true := by + cases hremaining : width - value with + | zero => omega + | succ remaining => + simp [List.replicate_succ] + rw [hshape, List.cons_append] at hsuffix + exact hsuffix.read_cons + +private theorem source_final_suffix (sourceIdx : Fin n) + (work₀ : Fin n → Tape) (width : ℕ) (payload : List Bool) + (hsource : (work₀ sourceIdx).HasBinarySuffix + (List.replicate width true ++ false :: payload)) : + (advanceRight (work₀ sourceIdx) width).HasBinarySuffix + (false :: payload) := by + simpa using source_suffix sourceIdx work₀ width width payload le_rfl hsource + +private theorem binaryNatTape_hasBinaryNat (value : ℕ) : + (binaryNatTape value).HasBinaryNat value := + Tape.init_move_right_hasBinaryNat value + +private theorem wordWidthWork_source (sourceIdx widthIdx : Fin n) + (hindices : sourceIdx ≠ widthIdx) (work₀ : Fin n → Tape) + (sourceSteps value : ℕ) : + wordWidthWork sourceIdx widthIdx work₀ sourceSteps value sourceIdx = + advanceRight (work₀ sourceIdx) sourceSteps := by + simp [wordWidthWork, hindices] + +private theorem wordWidthWork_width (sourceIdx widthIdx : Fin n) + (work₀ : Fin n → Tape) (sourceSteps value : ℕ) : + wordWidthWork sourceIdx widthIdx work₀ sourceSteps value widthIdx = + binaryNatTape value := by + simp [wordWidthWork] + +private theorem wordWidthWork_other (sourceIdx widthIdx : Fin n) + (work₀ : Fin n → Tape) (sourceSteps value : ℕ) (i : Fin n) + (hsourceIdx : i ≠ sourceIdx) (hwidthIdx : i ≠ widthIdx) : + wordWidthWork sourceIdx widthIdx work₀ sourceSteps value i = work₀ i := by + simp [wordWidthWork, hsourceIdx, hwidthIdx] + +private theorem wordWidthWork_read_ne_start (sourceIdx widthIdx : Fin n) + (hindices : sourceIdx ≠ widthIdx) (work₀ : Fin n → Tape) + (sourceSteps value : ℕ) (suffix : List Bool) + (hsource : (advanceRight (work₀ sourceIdx) sourceSteps).HasBinarySuffix suffix) + (hother : ∀ i, i ≠ sourceIdx → i ≠ widthIdx → + (work₀ i).read ≠ Γ.start) : + ∀ i, (wordWidthWork sourceIdx widthIdx work₀ sourceSteps value i).read ≠ + Γ.start := by + intro i + by_cases hiSource : i = sourceIdx + · subst i + rw [wordWidthWork_source sourceIdx widthIdx hindices] + exact hsource.read_ne_start + · by_cases hiWidth : i = widthIdx + · subst i + rw [wordWidthWork_width] + exact Tape.init_ofBool_move_right_read_ne_start value.bits + · rw [wordWidthWork_other sourceIdx widthIdx work₀ sourceSteps value i + hiSource hiWidth] + exact hother i hiSource hiWidth + +private theorem scan_step (sourceIdx widthIdx : Fin n) + (hindices : sourceIdx ≠ widthIdx) (width : ℕ) (payload : List Bool) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hsource : (work₀ sourceIdx).HasBinarySuffix + (List.replicate width true ++ false :: payload)) + (hinput : inp₀.read ≠ Γ.start) + (hother : ∀ i, i ≠ sourceIdx → i ≠ widthIdx → + (work₀ i).read ≠ Γ.start) + (houtput : out₀.read ≠ Γ.start) (value : ℕ) (hvalue : value < width) : + (wordWidthTM sourceIdx widthIdx).step + (scanCfg sourceIdx widthIdx inp₀ work₀ out₀ value) = + some (TM.forWorkOnesBodyWrap sourceIdx (TM.binarySuccTM widthIdx) + (bodyStartCfg sourceIdx widthIdx inp₀ work₀ out₀ value)) := by + have hsuffix := source_suffix sourceIdx work₀ width value payload + (Nat.le_of_lt hvalue) hsource + have hone := source_read_one sourceIdx work₀ width value payload hvalue hsource + have hstep := TM.forWorkOnesTM_step_scan_one_internal sourceIdx + (TM.binarySuccTM widthIdx) + (scanCfg sourceIdx widthIdx inp₀ work₀ out₀ value) rfl + (by + change + (wordWidthWork sourceIdx widthIdx work₀ value value sourceIdx).read = Γ.one + rw [wordWidthWork_source sourceIdx widthIdx hindices] + exact hone) + hinput + (wordWidthWork_read_ne_start sourceIdx widthIdx hindices work₀ value value + (List.replicate (width - value) true ++ false :: payload) hsuffix hother) + houtput + change + (TM.forWorkOnesTM sourceIdx (TM.binarySuccTM widthIdx)).step + (scanCfg sourceIdx widthIdx inp₀ work₀ out₀ value) = _ + rw [hstep] + congr 2 + funext i + by_cases hi : i = sourceIdx + · subst i + simp [bodyStartCfg, scanCfg, wordWidthWork, + hindices, advanceRight] + · by_cases hiWidth : i = widthIdx + · subst i + simp [bodyStartCfg, scanCfg, wordWidthWork, hi] + · simp [bodyStartCfg, scanCfg, wordWidthWork, hi, hiWidth] + +private theorem body_run (sourceIdx widthIdx : Fin n) + (hindices : sourceIdx ≠ widthIdx) (width : ℕ) (payload : List Bool) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hsource : (work₀ sourceIdx).HasBinarySuffix + (List.replicate width true ++ false :: payload)) + (hinput : inp₀.read ≠ Γ.start) + (hother : ∀ i, i ≠ sourceIdx → i ≠ widthIdx → + (work₀ i).read ≠ Γ.start) + (houtput : out₀.read ≠ Γ.start) (value : ℕ) (hvalue : value < width) : + (TM.binarySuccTM widthIdx).reachesIn (TM.binarySuccTime value) + (bodyStartCfg sourceIdx widthIdx inp₀ work₀ out₀ value) + (bodyDoneCfg sourceIdx widthIdx inp₀ work₀ out₀ value) := by + have hsuffix := source_suffix sourceIdx work₀ width (value + 1) payload + (by omega) hsource + let work := wordWidthWork sourceIdx widthIdx work₀ (value + 1) value + obtain ⟨c', hreach, hhalt, hinput', hwork, hvalue', houtput'⟩ := + TM.binarySuccTM_reachesIn_frame widthIdx value inp₀ work out₀ + (by + change (wordWidthWork sourceIdx widthIdx work₀ (value + 1) value + widthIdx).HasBinaryNat value + rw [wordWidthWork_width] + exact binaryNatTape_hasBinaryNat value) + hinput + (by + intro i hi + exact wordWidthWork_read_ne_start sourceIdx widthIdx hindices work₀ + (value + 1) value + (List.replicate (width - (value + 1)) true ++ false :: payload) + hsuffix hother i) + houtput + have hc' : c' = bodyDoneCfg sourceIdx widthIdx inp₀ work₀ out₀ value := by + refine Cfg.ext hhalt hinput' ?_ houtput' + funext i + by_cases hi : i = widthIdx + · subst i + change c'.work widthIdx = + wordWidthWork sourceIdx widthIdx work₀ (value + 1) (value + 1) widthIdx + rw [wordWidthWork_width] + exact hvalue'.eq_init_move_right + · change c'.work i = + wordWidthWork sourceIdx widthIdx work₀ (value + 1) (value + 1) i + rw [hwork i hi] + dsimp [work] + by_cases his : i = sourceIdx + · subst i + rw [wordWidthWork_source sourceIdx widthIdx hindices, + wordWidthWork_source sourceIdx widthIdx hindices] + · rw [wordWidthWork_other sourceIdx widthIdx work₀ (value + 1) value i + his hi, + wordWidthWork_other sourceIdx widthIdx work₀ (value + 1) (value + 1) i + his hi] + rw [← hc'] + simpa [bodyStartCfg, work] using hreach + +private theorem loopback_step (sourceIdx widthIdx : Fin n) + (hindices : sourceIdx ≠ widthIdx) (width : ℕ) (payload : List Bool) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hsource : (work₀ sourceIdx).HasBinarySuffix + (List.replicate width true ++ false :: payload)) + (hinput : inp₀.read ≠ Γ.start) + (hother : ∀ i, i ≠ sourceIdx → i ≠ widthIdx → + (work₀ i).read ≠ Γ.start) + (houtput : out₀.read ≠ Γ.start) (value : ℕ) (hvalue : value < width) : + (wordWidthTM sourceIdx widthIdx).step + (TM.forWorkOnesBodyWrap sourceIdx (TM.binarySuccTM widthIdx) + (bodyDoneCfg sourceIdx widthIdx inp₀ work₀ out₀ value)) = + some (scanCfg sourceIdx widthIdx inp₀ work₀ out₀ (value + 1)) := by + have hsuffix := source_suffix sourceIdx work₀ width (value + 1) payload + (by omega) hsource + have hstep := TM.forWorkOnesTM_step_body_halt_internal sourceIdx + (TM.binarySuccTM widthIdx) + (bodyDoneCfg sourceIdx widthIdx inp₀ work₀ out₀ value) rfl hinput + (wordWidthWork_read_ne_start sourceIdx widthIdx hindices work₀ + (value + 1) (value + 1) + (List.replicate (width - (value + 1)) true ++ false :: payload) + hsuffix hother) + houtput + simpa [wordWidthTM, bodyDoneCfg, scanCfg, TM.forWorkOnesBodyWrap] using hstep + +private theorem stop_step (sourceIdx widthIdx : Fin n) + (hindices : sourceIdx ≠ widthIdx) (width : ℕ) (payload : List Bool) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hsource : (work₀ sourceIdx).HasBinarySuffix + (List.replicate width true ++ false :: payload)) + (hinput : inp₀.read ≠ Γ.start) + (hother : ∀ i, i ≠ sourceIdx → i ≠ widthIdx → + (work₀ i).read ≠ Γ.start) + (houtput : out₀.read ≠ Γ.start) : + (wordWidthTM sourceIdx widthIdx).step + (scanCfg sourceIdx widthIdx inp₀ work₀ out₀ width) = + some (doneCfg sourceIdx widthIdx width inp₀ work₀ out₀) := by + have hsuffix := source_final_suffix sourceIdx work₀ width payload hsource + have hstep := TM.forWorkOnesTM_step_scan_zero_internal sourceIdx + (TM.binarySuccTM widthIdx) + (scanCfg sourceIdx widthIdx inp₀ work₀ out₀ width) rfl + (by + change + (wordWidthWork sourceIdx widthIdx work₀ width width sourceIdx).read = Γ.zero + rw [wordWidthWork_source sourceIdx widthIdx hindices] + exact hsuffix.read_cons) + hinput + (wordWidthWork_read_ne_start sourceIdx widthIdx hindices work₀ width width + (false :: payload) hsuffix hother) + houtput + simpa [wordWidthTM, scanCfg, doneCfg] using hstep + +private def loopSpec (sourceIdx widthIdx : Fin n) + (hindices : sourceIdx ≠ widthIdx) (width : ℕ) (payload : List Bool) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hsource : (work₀ sourceIdx).HasBinarySuffix + (List.replicate width true ++ false :: payload)) + (hinput : inp₀.read ≠ Γ.start) + (hother : ∀ i, i ≠ sourceIdx → i ≠ widthIdx → + (work₀ i).read ≠ Γ.start) + (houtput : out₀.read ≠ Γ.start) : + TM.ForWorkOnesLoopSpec sourceIdx (TM.binarySuccTM widthIdx) + TM.binarySuccTime width where + scanCfg := scanCfg sourceIdx widthIdx inp₀ work₀ out₀ + bodyStartCfg := fun value => + TM.forWorkOnesBodyWrap sourceIdx (TM.binarySuccTM widthIdx) + (bodyStartCfg sourceIdx widthIdx inp₀ work₀ out₀ value) + bodyDoneCfg := fun value => + TM.forWorkOnesBodyWrap sourceIdx (TM.binarySuccTM widthIdx) + (bodyDoneCfg sourceIdx widthIdx inp₀ work₀ out₀ value) + doneCfg := doneCfg sourceIdx widthIdx width inp₀ work₀ out₀ + scanStep := scan_step sourceIdx widthIdx hindices width payload inp₀ work₀ out₀ + hsource hinput hother houtput + bodyRun := fun value hvalue => + TM.forWorkOnesTM_body_reachesIn_internal sourceIdx (TM.binarySuccTM widthIdx) + (body_run sourceIdx widthIdx hindices width payload inp₀ work₀ out₀ + hsource hinput hother houtput value hvalue) + loopbackStep := loopback_step sourceIdx widthIdx hindices width payload inp₀ work₀ + out₀ hsource hinput hother houtput + stopStep := stop_step sourceIdx widthIdx hindices width payload inp₀ work₀ out₀ + hsource hinput hother houtput + +private theorem initial_work (sourceIdx widthIdx : Fin n) + (hindices : sourceIdx ≠ widthIdx) (work₀ : Fin n → Tape) + (hwidth : (work₀ widthIdx).HasBinaryNat 0) : + wordWidthWork sourceIdx widthIdx work₀ 0 0 = work₀ := by + funext i + by_cases hiWidth : i = widthIdx + · subst i + rw [wordWidthWork_width] + exact (hwidth.eq_init_move_right).symm + · by_cases hiSource : i = sourceIdx + · subst i + rw [wordWidthWork_source sourceIdx widthIdx hindices] + rfl + · exact wordWidthWork_other sourceIdx widthIdx work₀ 0 0 i hiSource hiWidth + +private def payloadBitWork (sourceIdx targetIdx : Fin n) + (work₀ : Fin n → Tape) (bit : Bool) : Fin n → Tape := + fun i => + if i = sourceIdx then (work₀ i).move Dir3.right + else if i = targetIdx then + (work₀ i).writeAndMove (Γw.ofBool bit) Dir3.right + else work₀ i + +private theorem payloadBitTM_step (sourceIdx targetIdx : Fin n) + (hindices : sourceIdx ≠ targetIdx) (bit : Bool) {suffix : List Bool} + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hsource : (work₀ sourceIdx).HasBinarySuffix (bit :: suffix)) + (hinput : inp₀.read ≠ Γ.start) + (hwork : ∀ i, (work₀ i).read ≠ Γ.start) + (houtput : out₀.read ≠ Γ.start) : + (payloadBitTM sourceIdx targetIdx).step + { state := (payloadBitTM sourceIdx targetIdx).qstart + input := inp₀ + work := work₀ + output := out₀ } = + some + { state := (payloadBitTM sourceIdx targetIdx).qhalt + input := inp₀ + work := payloadBitWork sourceIdx targetIdx work₀ bit + output := out₀ } := by + have hread := hsource.read_cons + rw [TM.step, if_neg (by simp [payloadBitTM])] + cases bit <;> + simp only [payloadBitTM, hread, Γ.ofBool, reduceCtorEq] + all_goals + refine congrArg some (Cfg.ext rfl ?_ ?_ ?_) + · dsimp only + simp [TM.idleDir, hinput, Tape.move] + · dsimp only + funext i + by_cases his : i = sourceIdx + · subst i + simpa [payloadBitWork, hindices] using + TM.writeAndMove_readBack (work₀ sourceIdx) (hwork sourceIdx) Dir3.right + · by_cases hit : i = targetIdx + · subst i + simp [payloadBitWork, his] + · simpa [payloadBitWork, his, hit, TM.idleDir, hwork i, Tape.move] using + TM.writeAndMove_readBack (work₀ i) (hwork i) Dir3.stay + · dsimp only + simpa [TM.idleDir, houtput, Tape.move] using + TM.writeAndMove_readBack out₀ houtput Dir3.stay + +theorem payloadBitTM_reachesIn_frame_internal {n : ℕ} + (sourceIdx targetIdx : Fin n) (hindices : sourceIdx ≠ targetIdx) + (bit : Bool) (suffix pre : List Bool) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hsource : (work₀ sourceIdx).HasBinarySuffix (bit :: suffix)) + (htarget : (work₀ targetIdx).HasBinaryPrefix pre) + (hinput : inp₀.read ≠ Γ.start) + (hother : ∀ i, i ≠ sourceIdx → i ≠ targetIdx → + (work₀ i).read ≠ Γ.start) + (houtput : out₀.read ≠ Γ.start) : + ∃ c', + (payloadBitTM sourceIdx targetIdx).reachesIn 1 + { state := (payloadBitTM sourceIdx targetIdx).qstart + input := inp₀ + work := work₀ + output := out₀ } c' ∧ + (payloadBitTM sourceIdx targetIdx).halted c' ∧ + c'.input = inp₀ ∧ + (c'.work sourceIdx).HasBinarySuffix suffix ∧ + (c'.work targetIdx).HasBinaryPrefix (pre ++ [bit]) ∧ + (∀ i, i ≠ sourceIdx → i ≠ targetIdx → c'.work i = work₀ i) ∧ + c'.output = out₀ := by + let work' := payloadBitWork sourceIdx targetIdx work₀ bit + have hwork : ∀ i, (work₀ i).read ≠ Γ.start := by + intro i + by_cases his : i = sourceIdx + · subst i + exact hsource.read_ne_start + · by_cases hit : i = targetIdx + · subst i + rw [htarget.read_blank] + decide + · exact hother i his hit + have hstep : + (payloadBitTM sourceIdx targetIdx).step + { state := (payloadBitTM sourceIdx targetIdx).qstart + input := inp₀ + work := work₀ + output := out₀ } = + some + { state := (payloadBitTM sourceIdx targetIdx).qhalt + input := inp₀ + work := work' + output := out₀ } := by + apply payloadBitTM_step sourceIdx targetIdx hindices bit inp₀ work₀ out₀ + hsource hinput hwork houtput + refine ⟨({ state := (payloadBitTM sourceIdx targetIdx).qhalt + input := inp₀ + work := work' + output := out₀ } : Cfg n (payloadBitTM sourceIdx targetIdx).Q), + .step hstep .zero, rfl, rfl, ?_, ?_, ?_, rfl⟩ + · change (payloadBitWork sourceIdx targetIdx work₀ bit sourceIdx).HasBinarySuffix suffix + simp [payloadBitWork] + exact hsource.move_right_cons + · change (payloadBitWork sourceIdx targetIdx work₀ bit targetIdx).HasBinaryPrefix + (pre ++ [bit]) + simp [payloadBitWork, Ne.symm hindices] + cases bit with + | false => + simpa [Γw.ofBool, Γ.ofBool, Γw.toΓ] using + Tape.hasBinaryPrefix_write_bit (t := work₀ targetIdx) false htarget + | true => + simpa [Γw.ofBool, Γ.ofBool, Γw.toΓ] using + Tape.hasBinaryPrefix_write_bit (t := work₀ targetIdx) true htarget + · intro i his hit + change payloadBitWork sourceIdx targetIdx work₀ bit i = work₀ i + simp [payloadBitWork, his, hit] + +private def wordSeparatorWork (sourceIdx : Fin n) + (work₀ : Fin n → Tape) : Fin n → Tape := + Function.update work₀ sourceIdx ((work₀ sourceIdx).move Dir3.right) + +private theorem wordSeparatorTM_step (sourceIdx : Fin n) + (bits : List Bool) (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hsource : (work₀ sourceIdx).HasBinarySuffix (false :: bits)) + (hinput : inp₀.read ≠ Γ.start) + (hwork : ∀ i, (work₀ i).read ≠ Γ.start) + (houtput : out₀.read ≠ Γ.start) : + (wordSeparatorTM sourceIdx).step + { state := (wordSeparatorTM sourceIdx).qstart + input := inp₀ + work := work₀ + output := out₀ } = + some + { state := (wordSeparatorTM sourceIdx).qhalt + input := inp₀ + work := wordSeparatorWork sourceIdx work₀ + output := out₀ } := by + have hread := hsource.read_cons + have hzero : (work₀ sourceIdx).read = Γ.zero := by + simpa [Γ.ofBool] using hread + rw [TM.step, if_neg (by simp [wordSeparatorTM])] + simp only [wordSeparatorTM, hzero, ↓reduceIte] + refine congrArg some (Cfg.ext rfl ?_ ?_ ?_) + · dsimp only + simp [TM.idleDir, hinput, Tape.move] + · dsimp only + funext i + by_cases his : i = sourceIdx + · subst i + simpa [wordSeparatorWork] using + TM.writeAndMove_readBack (work₀ sourceIdx) (hwork sourceIdx) Dir3.right + · simpa [wordSeparatorWork, his, TM.idleDir, hwork i, Tape.move] using + TM.writeAndMove_readBack (work₀ i) (hwork i) Dir3.stay + · dsimp only + simpa [TM.idleDir, houtput, Tape.move] using + TM.writeAndMove_readBack out₀ houtput Dir3.stay + +theorem wordSeparatorTM_reachesIn_frame_internal {n : ℕ} + (sourceIdx : Fin n) (bits : List Bool) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hsource : (work₀ sourceIdx).HasBinarySuffix (false :: bits)) + (hinput : inp₀.read ≠ Γ.start) + (hother : ∀ i, i ≠ sourceIdx → (work₀ i).read ≠ Γ.start) + (houtput : out₀.read ≠ Γ.start) : + ∃ c', + (wordSeparatorTM sourceIdx).reachesIn 1 + { state := (wordSeparatorTM sourceIdx).qstart + input := inp₀ + work := work₀ + output := out₀ } c' ∧ + (wordSeparatorTM sourceIdx).halted c' ∧ + c'.input = inp₀ ∧ + (c'.work sourceIdx).HasBinarySuffix bits ∧ + (∀ i, i ≠ sourceIdx → c'.work i = work₀ i) ∧ + c'.output = out₀ := by + have hwork : ∀ i, (work₀ i).read ≠ Γ.start := by + intro i + by_cases his : i = sourceIdx + · subst i + exact hsource.read_ne_start + · exact hother i his + let c' : Cfg n (wordSeparatorTM sourceIdx).Q := + { state := (wordSeparatorTM sourceIdx).qhalt + input := inp₀ + work := wordSeparatorWork sourceIdx work₀ + output := out₀ } + have hstep := wordSeparatorTM_step sourceIdx bits inp₀ work₀ out₀ hsource + hinput hwork houtput + refine ⟨c', .step hstep .zero, rfl, rfl, ?_, ?_, rfl⟩ + · change (wordSeparatorWork sourceIdx work₀ sourceIdx).HasBinarySuffix bits + simp [wordSeparatorWork] + exact hsource.move_right_cons + · intro i his + change wordSeparatorWork sourceIdx work₀ i = work₀ i + simp [wordSeparatorWork, his] + +private def appendPayload (tape : Tape) : List Bool → Tape + | [] => tape + | bit :: bits => + appendPayload (tape.writeAndMove (Γw.ofBool bit) Dir3.right) bits + +private theorem appendPayload_append (tape : Tape) (first second : List Bool) : + appendPayload tape (first ++ second) = + appendPayload (appendPayload tape first) second := by + induction first generalizing tape with + | nil => rfl + | cons bit bits ih => + simp only [List.cons_append, appendPayload] + exact ih _ + +private theorem appendPayload_hasBinaryPrefix (tape : Tape) + (pre bits : List Bool) (hpre : tape.HasBinaryPrefix pre) : + (appendPayload tape bits).HasBinaryPrefix (pre ++ bits) := by + induction bits generalizing tape pre with + | nil => simpa [appendPayload] + | cons bit bits ih => + have hbit : + (tape.writeAndMove (Γw.ofBool bit) Dir3.right).HasBinaryPrefix + (pre ++ [bit]) := by + cases bit with + | false => + simpa [Γw.ofBool, Γ.ofBool, Γw.toΓ] using + Tape.hasBinaryPrefix_write_bit (t := tape) false hpre + | true => + simpa [Γw.ofBool, Γ.ofBool, Γw.toΓ] using + Tape.hasBinaryPrefix_write_bit (t := tape) true hpre + simpa [appendPayload, List.append_assoc] using + ih (tape.writeAndMove (Γw.ofBool bit) Dir3.right) (pre ++ [bit]) hbit + +private theorem appendPayload_take_succ (tape : Tape) (bits : List Bool) + (value : ℕ) (hvalue : value < bits.length) : + appendPayload tape (bits.take (value + 1)) = + (appendPayload tape (bits.take value)).writeAndMove + (Γw.ofBool bits[value]) Dir3.right := by + rw [List.take_succ_eq_append_getElem hvalue, appendPayload_append] + rfl + +private def payloadLoopWork (sourceIdx targetIdx counterIdx widthIdx : Fin n) + (payload : List Bool) (width : ℕ) (work₀ : Fin n → Tape) + (copied counterValue : ℕ) : Fin n → Tape := + fun i => + if i = sourceIdx then advanceRight (work₀ i) copied + else if i = targetIdx then appendPayload (work₀ i) (payload.take copied) + else if i = counterIdx then binaryNatTape counterValue + else if i = widthIdx then binaryNatTape width + else work₀ i + +private theorem payloadLoopWork_source + (sourceIdx targetIdx counterIdx widthIdx : Fin n) + (payload : List Bool) (width : ℕ) (work₀ : Fin n → Tape) + (copied counterValue : ℕ) : + payloadLoopWork sourceIdx targetIdx counterIdx widthIdx payload width work₀ + copied counterValue sourceIdx = advanceRight (work₀ sourceIdx) copied := by + simp [payloadLoopWork] + +private theorem payloadLoopWork_target + (sourceIdx targetIdx counterIdx widthIdx : Fin n) + (hdistinct : PayloadLoopDistinct sourceIdx targetIdx counterIdx widthIdx) + (payload : List Bool) (width : ℕ) (work₀ : Fin n → Tape) + (copied counterValue : ℕ) : + payloadLoopWork sourceIdx targetIdx counterIdx widthIdx payload width work₀ + copied counterValue targetIdx = + appendPayload (work₀ targetIdx) (payload.take copied) := by + simp [payloadLoopWork, Ne.symm hdistinct.source_target] + +private theorem payloadLoopWork_counter + (sourceIdx targetIdx counterIdx widthIdx : Fin n) + (hdistinct : PayloadLoopDistinct sourceIdx targetIdx counterIdx widthIdx) + (payload : List Bool) (width : ℕ) (work₀ : Fin n → Tape) + (copied counterValue : ℕ) : + payloadLoopWork sourceIdx targetIdx counterIdx widthIdx payload width work₀ + copied counterValue counterIdx = binaryNatTape counterValue := by + simp [payloadLoopWork, Ne.symm hdistinct.source_counter, + Ne.symm hdistinct.target_counter] + +private theorem payloadLoopWork_width + (sourceIdx targetIdx counterIdx widthIdx : Fin n) + (hdistinct : PayloadLoopDistinct sourceIdx targetIdx counterIdx widthIdx) + (payload : List Bool) (width : ℕ) (work₀ : Fin n → Tape) + (copied counterValue : ℕ) : + payloadLoopWork sourceIdx targetIdx counterIdx widthIdx payload width work₀ + copied counterValue widthIdx = binaryNatTape width := by + simp [payloadLoopWork, Ne.symm hdistinct.source_width, + Ne.symm hdistinct.target_width, Ne.symm hdistinct.counter_width] + +private theorem payloadLoopWork_other + (sourceIdx targetIdx counterIdx widthIdx : Fin n) + (payload : List Bool) (width : ℕ) (work₀ : Fin n → Tape) + (copied counterValue : ℕ) (i : Fin n) + (his : i ≠ sourceIdx) (hit : i ≠ targetIdx) + (hic : i ≠ counterIdx) (hiw : i ≠ widthIdx) : + payloadLoopWork sourceIdx targetIdx counterIdx widthIdx payload width work₀ + copied counterValue i = work₀ i := by + simp [payloadLoopWork, his, hit, hic, hiw] + +private theorem payloadSource_suffix (sourceIdx : Fin n) + (payload rest : List Bool) (work₀ : Fin n → Tape) (value : ℕ) + (hvalue : value ≤ payload.length) + (hsource : (work₀ sourceIdx).HasBinarySuffix (payload ++ rest)) : + (advanceRight (work₀ sourceIdx) value).HasBinarySuffix + (payload.drop value ++ rest) := by + have hsplit : payload ++ rest = + payload.take value ++ (payload.drop value ++ rest) := by + rw [← List.append_assoc, List.take_append_drop] + rw [hsplit] at hsource + have h := advanceRight_hasBinarySuffix_append (work₀ sourceIdx) + (payload.take value) (payload.drop value ++ rest) hsource + simpa [List.length_take, Nat.min_eq_left hvalue] using h + +private theorem payloadTarget_prefix (targetIdx : Fin n) + (payload : List Bool) (work₀ : Fin n → Tape) (value : ℕ) + (htarget : (work₀ targetIdx).HasBinaryPrefix []) : + (appendPayload (work₀ targetIdx) (payload.take value)).HasBinaryPrefix + (payload.take value) := by + simpa using appendPayload_hasBinaryPrefix (work₀ targetIdx) [] + (payload.take value) htarget + +private theorem payloadLoopWork_read_ne_start + (sourceIdx targetIdx counterIdx widthIdx : Fin n) + (hdistinct : PayloadLoopDistinct sourceIdx targetIdx counterIdx widthIdx) + (payload rest : List Bool) (width : ℕ) (work₀ : Fin n → Tape) + (copied counterValue : ℕ) (hcopied : copied ≤ payload.length) + (hsource : (work₀ sourceIdx).HasBinarySuffix (payload ++ rest)) + (htarget : (work₀ targetIdx).HasBinaryPrefix []) + (hother : ∀ i, i ≠ sourceIdx → i ≠ targetIdx → i ≠ counterIdx → + i ≠ widthIdx → (work₀ i).read ≠ Γ.start) : + ∀ i, (payloadLoopWork sourceIdx targetIdx counterIdx widthIdx payload width + work₀ copied counterValue i).read ≠ Γ.start := by + intro i + by_cases his : i = sourceIdx + · subst i + rw [payloadLoopWork_source sourceIdx targetIdx counterIdx widthIdx] + exact (payloadSource_suffix sourceIdx payload rest work₀ copied hcopied hsource).read_ne_start + · by_cases hit : i = targetIdx + · subst i + rw [payloadLoopWork_target sourceIdx targetIdx counterIdx widthIdx hdistinct] + rw [(payloadTarget_prefix targetIdx payload work₀ copied htarget).read_blank] + decide + · by_cases hic : i = counterIdx + · subst i + rw [payloadLoopWork_counter sourceIdx targetIdx counterIdx widthIdx hdistinct] + exact Tape.init_ofBool_move_right_read_ne_start counterValue.bits + · by_cases hiw : i = widthIdx + · subst i + rw [payloadLoopWork_width sourceIdx targetIdx counterIdx widthIdx hdistinct] + exact Tape.init_ofBool_move_right_read_ne_start width.bits + · rw [payloadLoopWork_other sourceIdx targetIdx counterIdx widthIdx payload + width work₀ copied counterValue i his hit hic hiw] + exact hother i his hit hic hiw + +private def payloadScanCfg + (sourceIdx targetIdx counterIdx widthIdx : Fin n) + (payload : List Bool) (width : ℕ) (inp₀ : Tape) + (work₀ : Fin n → Tape) (out₀ : Tape) (value : ℕ) : + Cfg n (wordPayloadTM sourceIdx targetIdx counterIdx widthIdx).Q := + { state := .inl (.scan true) + input := inp₀ + work := payloadLoopWork sourceIdx targetIdx counterIdx widthIdx payload width + work₀ value value + output := out₀ } + +private def payloadIterationStartCfg + (sourceIdx targetIdx counterIdx widthIdx : Fin n) + (payload : List Bool) (width : ℕ) (inp₀ : Tape) + (work₀ : Fin n → Tape) (out₀ : Tape) (value : ℕ) : + Cfg n (wordPayloadTM sourceIdx targetIdx counterIdx widthIdx).Q := + { state := .inr + (TM.binaryForIterationTM (payloadBitTM sourceIdx targetIdx) counterIdx).qstart + input := inp₀ + work := payloadLoopWork sourceIdx targetIdx counterIdx widthIdx payload width + work₀ value value + output := out₀ } + +private def payloadIterationDoneCfg + (sourceIdx targetIdx counterIdx widthIdx : Fin n) + (payload : List Bool) (width : ℕ) (inp₀ : Tape) + (work₀ : Fin n → Tape) (out₀ : Tape) (value : ℕ) : + Cfg n (wordPayloadTM sourceIdx targetIdx counterIdx widthIdx).Q := + { state := .inr + (TM.binaryForIterationTM (payloadBitTM sourceIdx targetIdx) counterIdx).qhalt + input := inp₀ + work := payloadLoopWork sourceIdx targetIdx counterIdx widthIdx payload width + work₀ (value + 1) (value + 1) + output := out₀ } + +private def payloadDoneCfg + (sourceIdx targetIdx counterIdx widthIdx : Fin n) + (payload : List Bool) (width : ℕ) (inp₀ : Tape) + (work₀ : Fin n → Tape) (out₀ : Tape) : + Cfg n (wordPayloadTM sourceIdx targetIdx counterIdx widthIdx).Q := + { state := .inl .done + input := inp₀ + work := payloadLoopWork sourceIdx targetIdx counterIdx widthIdx payload width + work₀ width width + output := out₀ } + +private theorem payloadBitWork_eq_next + (sourceIdx targetIdx counterIdx widthIdx : Fin n) + (hdistinct : PayloadLoopDistinct sourceIdx targetIdx counterIdx widthIdx) + (payload : List Bool) (width : ℕ) (work₀ : Fin n → Tape) + (copied counterValue : ℕ) (hcopied : copied < payload.length) : + payloadBitWork sourceIdx targetIdx + (payloadLoopWork sourceIdx targetIdx counterIdx widthIdx payload width + work₀ copied counterValue) payload[copied] = + payloadLoopWork sourceIdx targetIdx counterIdx widthIdx payload width + work₀ (copied + 1) counterValue := by + funext i + by_cases his : i = sourceIdx + · subst i + simp only [payloadBitWork, ↓reduceIte] + rw [payloadLoopWork_source sourceIdx targetIdx counterIdx widthIdx, + payloadLoopWork_source sourceIdx targetIdx counterIdx widthIdx] + rfl + · by_cases hit : i = targetIdx + · subst i + simp only [payloadBitWork, his, ↓reduceIte] + rw [payloadLoopWork_target sourceIdx targetIdx counterIdx widthIdx hdistinct, + payloadLoopWork_target sourceIdx targetIdx counterIdx widthIdx hdistinct] + exact (appendPayload_take_succ (work₀ targetIdx) payload copied hcopied).symm + · by_cases hic : i = counterIdx + · subst i + simp only [payloadBitWork, his, hit, ↓reduceIte] + rw [payloadLoopWork_counter sourceIdx targetIdx counterIdx widthIdx hdistinct, + payloadLoopWork_counter sourceIdx targetIdx counterIdx widthIdx hdistinct] + · by_cases hiw : i = widthIdx + · subst i + simp only [payloadBitWork, his, hit, ↓reduceIte] + rw [payloadLoopWork_width sourceIdx targetIdx counterIdx widthIdx hdistinct, + payloadLoopWork_width sourceIdx targetIdx counterIdx widthIdx hdistinct] + · simp only [payloadBitWork, his, hit, ↓reduceIte] + rw [payloadLoopWork_other sourceIdx targetIdx counterIdx widthIdx payload + width work₀ copied counterValue i his hit hic hiw, + payloadLoopWork_other sourceIdx targetIdx counterIdx widthIdx payload + width work₀ (copied + 1) counterValue i his hit hic hiw] + +private theorem payloadTestRun + (sourceIdx targetIdx counterIdx widthIdx : Fin n) + (hdistinct : PayloadLoopDistinct sourceIdx targetIdx counterIdx widthIdx) + (payload rest : List Bool) (width : ℕ) (hwidth : payload.length = width) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hsource : (work₀ sourceIdx).HasBinarySuffix (payload ++ rest)) + (htarget : (work₀ targetIdx).HasBinaryPrefix []) + (hinput : inp₀.read ≠ Γ.start) + (hother : ∀ i, i ≠ sourceIdx → i ≠ targetIdx → i ≠ counterIdx → + i ≠ widthIdx → (work₀ i).read ≠ Γ.start) + (houtput : out₀.read ≠ Γ.start) (value : ℕ) (hvalue : value < width) : + (wordPayloadTM sourceIdx targetIdx counterIdx widthIdx).reachesIn + (TM.binaryForCompareTime width) + (payloadScanCfg sourceIdx targetIdx counterIdx widthIdx payload width inp₀ + work₀ out₀ value) + (payloadIterationStartCfg sourceIdx targetIdx counterIdx widthIdx payload + width inp₀ work₀ out₀ value) := by + let work := payloadLoopWork sourceIdx targetIdx counterIdx widthIdx payload width + work₀ value value + have hwork := payloadLoopWork_read_ne_start sourceIdx targetIdx counterIdx widthIdx + hdistinct payload rest width work₀ value value (by omega) hsource htarget hother + have hrun := TM.binaryForTM_compare_reachesIn_frame_of_lt_internal + (payloadBitTM sourceIdx targetIdx) counterIdx widthIdx hdistinct.counter_width + value width hvalue inp₀ work out₀ + (by + dsimp only [work] + rw [payloadLoopWork_counter sourceIdx targetIdx counterIdx widthIdx hdistinct] + exact binaryNatTape_hasBinaryNat value) + (by + dsimp only [work] + rw [payloadLoopWork_width sourceIdx targetIdx counterIdx widthIdx hdistinct] + exact binaryNatTape_hasBinaryNat width) + hinput + (by + intro i _ _ + exact hwork i) + houtput + simpa [wordPayloadTM, payloadScanCfg, payloadIterationStartCfg, work] using hrun + +private theorem payloadDoneRun + (sourceIdx targetIdx counterIdx widthIdx : Fin n) + (hdistinct : PayloadLoopDistinct sourceIdx targetIdx counterIdx widthIdx) + (payload rest : List Bool) (width : ℕ) (hwidth : payload.length = width) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hsource : (work₀ sourceIdx).HasBinarySuffix (payload ++ rest)) + (htarget : (work₀ targetIdx).HasBinaryPrefix []) + (hinput : inp₀.read ≠ Γ.start) + (hother : ∀ i, i ≠ sourceIdx → i ≠ targetIdx → i ≠ counterIdx → + i ≠ widthIdx → (work₀ i).read ≠ Γ.start) + (houtput : out₀.read ≠ Γ.start) : + (wordPayloadTM sourceIdx targetIdx counterIdx widthIdx).reachesIn + (TM.binaryForCompareTime width) + (payloadScanCfg sourceIdx targetIdx counterIdx widthIdx payload width inp₀ + work₀ out₀ width) + (payloadDoneCfg sourceIdx targetIdx counterIdx widthIdx payload width inp₀ + work₀ out₀) := by + let work := payloadLoopWork sourceIdx targetIdx counterIdx widthIdx payload width + work₀ width width + have hwork := payloadLoopWork_read_ne_start sourceIdx targetIdx counterIdx widthIdx + hdistinct payload rest width work₀ width width (by omega) hsource htarget hother + have hrun := TM.binaryForTM_compare_reachesIn_frame_of_eq_internal + (payloadBitTM sourceIdx targetIdx) counterIdx widthIdx hdistinct.counter_width + width inp₀ work out₀ + (by + dsimp only [work] + rw [payloadLoopWork_counter sourceIdx targetIdx counterIdx widthIdx hdistinct] + exact binaryNatTape_hasBinaryNat width) + (by + dsimp only [work] + rw [payloadLoopWork_width sourceIdx targetIdx counterIdx widthIdx hdistinct] + exact binaryNatTape_hasBinaryNat width) + hinput + (by + intro i _ _ + exact hwork i) + houtput + simpa [wordPayloadTM, payloadScanCfg, payloadDoneCfg, work] using hrun + +private theorem payloadIterationRun + (sourceIdx targetIdx counterIdx widthIdx : Fin n) + (hdistinct : PayloadLoopDistinct sourceIdx targetIdx counterIdx widthIdx) + (payload rest : List Bool) (width : ℕ) (hwidth : payload.length = width) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hsource : (work₀ sourceIdx).HasBinarySuffix (payload ++ rest)) + (htarget : (work₀ targetIdx).HasBinaryPrefix []) + (hinput : inp₀.read ≠ Γ.start) + (hother : ∀ i, i ≠ sourceIdx → i ≠ targetIdx → i ≠ counterIdx → + i ≠ widthIdx → (work₀ i).read ≠ Γ.start) + (houtput : out₀.read ≠ Γ.start) (value : ℕ) (hvalue : value < width) : + (wordPayloadTM sourceIdx targetIdx counterIdx widthIdx).reachesIn + (TM.binaryForIterationTime (fun _ => 1) value) + (payloadIterationStartCfg sourceIdx targetIdx counterIdx widthIdx payload + width inp₀ work₀ out₀ value) + (payloadIterationDoneCfg sourceIdx targetIdx counterIdx widthIdx payload + width inp₀ work₀ out₀ value) := by + let body := payloadBitTM sourceIdx targetIdx + let beforeWork := payloadLoopWork sourceIdx targetIdx counterIdx widthIdx + payload width work₀ value value + let afterBodyWork := payloadLoopWork sourceIdx targetIdx counterIdx widthIdx + payload width work₀ (value + 1) value + let afterWork := payloadLoopWork sourceIdx targetIdx counterIdx widthIdx + payload width work₀ (value + 1) (value + 1) + have hvaluePayload : value < payload.length := by omega + have hsourceAt := payloadSource_suffix sourceIdx payload rest work₀ value + (Nat.le_of_lt hvaluePayload) hsource + have hsourceShape : payload.drop value ++ rest = + payload[value] :: (payload.drop (value + 1) ++ rest) := by + rw [← List.cons_append, List.getElem_cons_drop hvaluePayload] + rw [hsourceShape] at hsourceAt + have hworkBefore := payloadLoopWork_read_ne_start sourceIdx targetIdx counterIdx + widthIdx hdistinct payload rest width work₀ value value + (Nat.le_of_lt hvaluePayload) hsource htarget hother + have hbodyStep := payloadBitTM_step sourceIdx targetIdx hdistinct.source_target + payload[value] inp₀ beforeWork out₀ + (by + dsimp only [beforeWork] + rw [payloadLoopWork_source sourceIdx targetIdx counterIdx widthIdx] + exact hsourceAt) + hinput hworkBefore houtput + have hbodyWork : payloadBitWork sourceIdx targetIdx beforeWork payload[value] = + afterBodyWork := by + dsimp only [beforeWork, afterBodyWork] + exact payloadBitWork_eq_next sourceIdx targetIdx counterIdx widthIdx hdistinct + payload width work₀ value value hvaluePayload + have hbodyReach : body.reachesIn 1 + { state := body.qstart + input := inp₀ + work := beforeWork + output := out₀ } + { state := body.qhalt + input := inp₀ + work := afterBodyWork + output := out₀ } := by + apply TM.reachesIn.step + · simpa [body, hbodyWork] using hbodyStep + · exact .zero + have hworkAfterBody := payloadLoopWork_read_ne_start sourceIdx targetIdx counterIdx + widthIdx hdistinct payload rest width work₀ (value + 1) value + (by omega) hsource htarget hother + obtain ⟨succDone, hsuccReach, hsuccHalt, hsuccInput, hsuccOther, + hsuccCounter, hsuccOutput⟩ := + TM.binarySuccTM_reachesIn_frame counterIdx value inp₀ afterBodyWork out₀ + (by + dsimp only [afterBodyWork] + rw [payloadLoopWork_counter sourceIdx targetIdx counterIdx widthIdx hdistinct] + exact binaryNatTape_hasBinaryNat value) + hinput (fun i _ => hworkAfterBody i) houtput + have hsuccDoneEq : succDone = + { state := (TM.binarySuccTM counterIdx).qhalt + input := inp₀ + work := afterWork + output := out₀ } := by + refine Cfg.ext hsuccHalt hsuccInput ?_ hsuccOutput + funext i + by_cases hic : i = counterIdx + · subst i + change succDone.work counterIdx = afterWork counterIdx + dsimp only [afterWork] + rw [payloadLoopWork_counter sourceIdx targetIdx counterIdx widthIdx hdistinct] + exact hsuccCounter.eq_init_move_right + · rw [hsuccOther i hic] + dsimp only [afterBodyWork, afterWork] + simp [payloadLoopWork, hic] + have htransitionInput : TM.transitionInput inp₀ = inp₀ := + TM.transitionInput_eq_self hinput + have htransitionWork : (fun i => TM.transitionTape (afterBodyWork i)) = + afterBodyWork := by + funext i + exact TM.transitionTape_eq_self (hworkAfterBody i) + have htransitionOutput : TM.transitionTape out₀ = out₀ := + TM.transitionTape_eq_self houtput + have hsuccReach' : (TM.binarySuccTM counterIdx).reachesIn + (TM.binarySuccTime value) + { state := (TM.binarySuccTM counterIdx).qstart + input := TM.transitionInput inp₀ + work := fun i => TM.transitionTape (afterBodyWork i) + output := TM.transitionTape out₀ } + { state := (TM.binarySuccTM counterIdx).qhalt + input := inp₀ + work := afterWork + output := out₀ } := by + rw [htransitionInput, htransitionWork, htransitionOutput] + simpa [hsuccDoneEq] using hsuccReach + have hseq := TM.seqTM_reachesIn_of_reachesIn body + (TM.binarySuccTM counterIdx) hbodyReach rfl hsuccReach' + have hlift := TM.binaryForTM_iteration_reachesIn_internal body counterIdx + widthIdx hseq + simpa [body, wordPayloadTM, payloadIterationStartCfg, + payloadIterationDoneCfg, TM.binaryForIterationTime, + TM.binaryForIterationTM, TM.binaryForIterationWrap, TM.phase1Wrap, + TM.phase2Wrap, beforeWork, afterWork] using hlift + +private theorem payloadLoopbackStep + (sourceIdx targetIdx counterIdx widthIdx : Fin n) + (hdistinct : PayloadLoopDistinct sourceIdx targetIdx counterIdx widthIdx) + (payload rest : List Bool) (width : ℕ) (hwidth : payload.length = width) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hsource : (work₀ sourceIdx).HasBinarySuffix (payload ++ rest)) + (htarget : (work₀ targetIdx).HasBinaryPrefix []) + (hinput : inp₀.read ≠ Γ.start) + (hother : ∀ i, i ≠ sourceIdx → i ≠ targetIdx → i ≠ counterIdx → + i ≠ widthIdx → (work₀ i).read ≠ Γ.start) + (houtput : out₀.read ≠ Γ.start) (value : ℕ) (hvalue : value < width) : + (wordPayloadTM sourceIdx targetIdx counterIdx widthIdx).step + (payloadIterationDoneCfg sourceIdx targetIdx counterIdx widthIdx payload + width inp₀ work₀ out₀ value) = + some (payloadScanCfg sourceIdx targetIdx counterIdx widthIdx payload width + inp₀ work₀ out₀ (value + 1)) := by + let body := payloadBitTM sourceIdx targetIdx + let work := payloadLoopWork sourceIdx targetIdx counterIdx widthIdx payload width + work₀ (value + 1) (value + 1) + let cfg : Cfg n (TM.binaryForIterationTM body counterIdx).Q := + { state := (TM.binaryForIterationTM body counterIdx).qhalt + input := inp₀ + work := work + output := out₀ } + have hwork := payloadLoopWork_read_ne_start sourceIdx targetIdx counterIdx widthIdx + hdistinct payload rest width work₀ (value + 1) (value + 1) + (by omega) hsource htarget hother + have hstep := TM.binaryForTM_step_iteration_halt_internal body counterIdx widthIdx + cfg rfl hinput hwork houtput + simpa [body, cfg, work, wordPayloadTM, payloadIterationDoneCfg, + payloadScanCfg, TM.binaryForIterationWrap] using hstep + +private def payloadLoopSpec + (sourceIdx targetIdx counterIdx widthIdx : Fin n) + (hdistinct : PayloadLoopDistinct sourceIdx targetIdx counterIdx widthIdx) + (payload rest : List Bool) (width : ℕ) (hwidth : payload.length = width) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hsource : (work₀ sourceIdx).HasBinarySuffix (payload ++ rest)) + (htarget : (work₀ targetIdx).HasBinaryPrefix []) + (hinput : inp₀.read ≠ Γ.start) + (hother : ∀ i, i ≠ sourceIdx → i ≠ targetIdx → i ≠ counterIdx → + i ≠ widthIdx → (work₀ i).read ≠ Γ.start) + (houtput : out₀.read ≠ Γ.start) : + TM.BinaryForLoopSpec (payloadBitTM sourceIdx targetIdx) counterIdx widthIdx + (fun _ => 1) width where + counter_ne_limit := hdistinct.counter_width + scanCfg := payloadScanCfg sourceIdx targetIdx counterIdx widthIdx payload width + inp₀ work₀ out₀ + iterationStartCfg := payloadIterationStartCfg sourceIdx targetIdx counterIdx + widthIdx payload width inp₀ work₀ out₀ + iterationDoneCfg := payloadIterationDoneCfg sourceIdx targetIdx counterIdx + widthIdx payload width inp₀ work₀ out₀ + doneCfg := payloadDoneCfg sourceIdx targetIdx counterIdx widthIdx payload width + inp₀ work₀ out₀ + testRun := payloadTestRun sourceIdx targetIdx counterIdx widthIdx hdistinct + payload rest width hwidth inp₀ work₀ out₀ hsource htarget hinput hother houtput + iterationRun := payloadIterationRun sourceIdx targetIdx counterIdx widthIdx + hdistinct payload rest width hwidth inp₀ work₀ out₀ hsource htarget hinput hother + houtput + loopbackStep := payloadLoopbackStep sourceIdx targetIdx counterIdx widthIdx + hdistinct payload rest width hwidth inp₀ work₀ out₀ hsource htarget hinput hother + houtput + doneRun := payloadDoneRun sourceIdx targetIdx counterIdx widthIdx hdistinct + payload rest width hwidth inp₀ work₀ out₀ hsource htarget hinput hother houtput + +private theorem payloadInitialWork + (sourceIdx targetIdx counterIdx widthIdx : Fin n) + (hdistinct : PayloadLoopDistinct sourceIdx targetIdx counterIdx widthIdx) + (payload : List Bool) (width : ℕ) (work₀ : Fin n → Tape) + (hcounter : (work₀ counterIdx).HasBinaryNat 0) + (hwidth : (work₀ widthIdx).HasBinaryNat width) : + payloadLoopWork sourceIdx targetIdx counterIdx widthIdx payload width work₀ + 0 0 = work₀ := by + funext i + by_cases his : i = sourceIdx + · subst i + rw [payloadLoopWork_source sourceIdx targetIdx counterIdx widthIdx] + rfl + · by_cases hit : i = targetIdx + · subst i + rw [payloadLoopWork_target sourceIdx targetIdx counterIdx widthIdx hdistinct] + rfl + · by_cases hic : i = counterIdx + · subst i + rw [payloadLoopWork_counter sourceIdx targetIdx counterIdx widthIdx hdistinct] + exact (hcounter.eq_init_move_right).symm + · by_cases hiw : i = widthIdx + · subst i + rw [payloadLoopWork_width sourceIdx targetIdx counterIdx widthIdx hdistinct] + exact (hwidth.eq_init_move_right).symm + · exact payloadLoopWork_other sourceIdx targetIdx counterIdx widthIdx + payload width work₀ 0 0 i his hit hic hiw + +theorem wordPayloadTM_reachesIn_frame_internal {n : ℕ} + (sourceIdx targetIdx counterIdx widthIdx : Fin n) + (hdistinct : PayloadLoopDistinct sourceIdx targetIdx counterIdx widthIdx) + (payload rest : List Bool) (width : ℕ) (hwidthLength : payload.length = width) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hsource : (work₀ sourceIdx).HasBinarySuffix (payload ++ rest)) + (htarget : (work₀ targetIdx).HasBinaryPrefix []) + (hcounter : (work₀ counterIdx).HasBinaryNat 0) + (hwidth : (work₀ widthIdx).HasBinaryNat width) + (hinput : inp₀.read ≠ Γ.start) + (hother : ∀ i, i ≠ sourceIdx → i ≠ targetIdx → i ≠ counterIdx → + i ≠ widthIdx → (work₀ i).read ≠ Γ.start) + (houtput : out₀.read ≠ Γ.start) : + ∃ c', + (wordPayloadTM sourceIdx targetIdx counterIdx widthIdx).reachesIn + (wordPayloadTime width) + { state := (wordPayloadTM sourceIdx targetIdx counterIdx widthIdx).qstart + input := inp₀ + work := work₀ + output := out₀ } c' ∧ + (wordPayloadTM sourceIdx targetIdx counterIdx widthIdx).halted c' ∧ + c'.input = inp₀ ∧ + (c'.work sourceIdx).HasBinarySuffix rest ∧ + (c'.work targetIdx).HasBinaryPrefix payload ∧ + (c'.work counterIdx).HasBinaryNat width ∧ + (c'.work widthIdx).HasBinaryNat width ∧ + (∀ i, i ≠ sourceIdx → i ≠ targetIdx → i ≠ counterIdx → + i ≠ widthIdx → c'.work i = work₀ i) ∧ + c'.output = out₀ := by + let spec := payloadLoopSpec sourceIdx targetIdx counterIdx widthIdx hdistinct + payload rest width hwidthLength inp₀ work₀ out₀ hsource htarget hinput hother houtput + have hreach := spec.reachesIn_internal width 0 (by omega) + have hinitial := payloadInitialWork sourceIdx targetIdx counterIdx widthIdx + hdistinct payload width work₀ hcounter hwidth + refine ⟨payloadDoneCfg sourceIdx targetIdx counterIdx widthIdx payload width + inp₀ work₀ out₀, ?_, rfl, rfl, ?_, ?_, ?_, ?_, ?_, rfl⟩ + · simpa [spec, payloadLoopSpec, wordPayloadTime, wordPayloadTM, + payloadScanCfg, hinitial] using hreach + · change (payloadLoopWork sourceIdx targetIdx counterIdx widthIdx payload width + work₀ width width sourceIdx).HasBinarySuffix rest + rw [payloadLoopWork_source sourceIdx targetIdx counterIdx widthIdx] + have hsuffix := payloadSource_suffix sourceIdx payload rest work₀ width + (by omega) hsource + simpa [← hwidthLength] using hsuffix + · change (payloadLoopWork sourceIdx targetIdx counterIdx widthIdx payload width + work₀ width width targetIdx).HasBinaryPrefix payload + rw [payloadLoopWork_target sourceIdx targetIdx counterIdx widthIdx hdistinct] + have hprefix := payloadTarget_prefix targetIdx payload work₀ width htarget + simpa [← hwidthLength] using hprefix + · change (payloadLoopWork sourceIdx targetIdx counterIdx widthIdx payload width + work₀ width width counterIdx).HasBinaryNat width + rw [payloadLoopWork_counter sourceIdx targetIdx counterIdx widthIdx hdistinct] + exact binaryNatTape_hasBinaryNat width + · change (payloadLoopWork sourceIdx targetIdx counterIdx widthIdx payload width + work₀ width width widthIdx).HasBinaryNat width + rw [payloadLoopWork_width sourceIdx targetIdx counterIdx widthIdx hdistinct] + exact binaryNatTape_hasBinaryNat width + · intro i his hit hic hiw + exact payloadLoopWork_other sourceIdx targetIdx counterIdx widthIdx payload + width work₀ width width i his hit hic hiw + +theorem wordWidthTM_reachesIn_frame_internal {n : ℕ} + (sourceIdx widthIdx : Fin n) (hindices : sourceIdx ≠ widthIdx) + (width : ℕ) (payload : List Bool) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hsource : (work₀ sourceIdx).HasBinarySuffix + (List.replicate width true ++ false :: payload)) + (hwidth : (work₀ widthIdx).HasBinaryNat 0) + (hinput : inp₀.read ≠ Γ.start) + (hother : ∀ i, i ≠ sourceIdx → i ≠ widthIdx → + (work₀ i).read ≠ Γ.start) + (houtput : out₀.read ≠ Γ.start) : + ∃ c', + (wordWidthTM sourceIdx widthIdx).reachesIn (wordWidthTime width) + { state := (wordWidthTM sourceIdx widthIdx).qstart + input := inp₀ + work := work₀ + output := out₀ } c' ∧ + (wordWidthTM sourceIdx widthIdx).halted c' ∧ + c'.input = inp₀ ∧ + (c'.work sourceIdx).HasBinarySuffix (false :: payload) ∧ + (c'.work widthIdx).HasBinaryNat width ∧ + (∀ i, i ≠ sourceIdx → i ≠ widthIdx → c'.work i = work₀ i) ∧ + c'.output = out₀ := by + let spec := loopSpec sourceIdx widthIdx hindices width payload inp₀ work₀ out₀ + hsource hinput hother houtput + have hreach := spec.reachesIn_internal width 0 (by omega) + have hinit := initial_work sourceIdx widthIdx hindices work₀ hwidth + refine ⟨doneCfg sourceIdx widthIdx width inp₀ work₀ out₀, ?_, rfl, rfl, ?_, ?_, ?_, rfl⟩ + · simpa [spec, loopSpec, wordWidthTime, scanCfg, hinit] using hreach + · change + (wordWidthWork sourceIdx widthIdx work₀ width width sourceIdx).HasBinarySuffix + (false :: payload) + rw [wordWidthWork_source sourceIdx widthIdx hindices] + exact source_final_suffix sourceIdx work₀ width payload hsource + · change + (wordWidthWork sourceIdx widthIdx work₀ width width widthIdx).HasBinaryNat width + rw [wordWidthWork_width] + exact binaryNatTape_hasBinaryNat width + · intro i hiSource hiWidth + exact wordWidthWork_other sourceIdx widthIdx work₀ width width i hiSource hiWidth + +theorem wordDecodeTM_reachesIn_frame_internal {n : ℕ} + (sourceIdx targetIdx counterIdx widthIdx : Fin n) + (hdistinct : PayloadLoopDistinct sourceIdx targetIdx counterIdx widthIdx) + (payload rest : List Bool) (width : ℕ) (hwidthLength : payload.length = width) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hsource : (work₀ sourceIdx).HasBinarySuffix + (List.replicate width true ++ false :: (payload ++ rest))) + (htarget : (work₀ targetIdx).HasBinaryPrefix []) + (hcounter : (work₀ counterIdx).HasBinaryNat 0) + (hwidth : (work₀ widthIdx).HasBinaryNat 0) + (hinput : inp₀.read ≠ Γ.start) + (hother : ∀ i, i ≠ sourceIdx → i ≠ targetIdx → i ≠ counterIdx → + i ≠ widthIdx → (work₀ i).read ≠ Γ.start) + (houtput : out₀.read ≠ Γ.start) : + ∃ c', + (wordDecodeTM sourceIdx targetIdx counterIdx widthIdx).reachesIn + (wordDecodeTime width) + { state := (wordDecodeTM sourceIdx targetIdx counterIdx widthIdx).qstart + input := inp₀ + work := work₀ + output := out₀ } c' ∧ + (wordDecodeTM sourceIdx targetIdx counterIdx widthIdx).halted c' ∧ + c'.input = inp₀ ∧ + (c'.work sourceIdx).HasBinarySuffix rest ∧ + (c'.work targetIdx).HasBinaryPrefix payload ∧ + (c'.work counterIdx).HasBinaryNat width ∧ + (c'.work widthIdx).HasBinaryNat width ∧ + (∀ i, i ≠ sourceIdx → i ≠ targetIdx → i ≠ counterIdx → + i ≠ widthIdx → c'.work i = work₀ i) ∧ + c'.output = out₀ := by + let widthTM := wordWidthTM sourceIdx widthIdx + let separatorTM := wordSeparatorTM sourceIdx + let payloadTM := wordPayloadTM sourceIdx targetIdx counterIdx widthIdx + let tailTM := TM.seqTM separatorTM payloadTM + have hwidthOther : ∀ i, i ≠ sourceIdx → i ≠ widthIdx → + (work₀ i).read ≠ Γ.start := by + intro i his hiw + by_cases hit : i = targetIdx + · subst i + rw [htarget.read_blank] + decide + · by_cases hic : i = counterIdx + · subst i + rw [hcounter.eq_init_move_right] + exact Tape.init_ofBool_move_right_read_ne_start (0 : ℕ).bits + · exact hother i his hit hic hiw + obtain ⟨widthDone, hwidthReach, hwidthHalt, hwidthInput, + hwidthSource, hwidthValue, hwidthFrame, hwidthOutput⟩ := + wordWidthTM_reachesIn_frame_internal sourceIdx widthIdx + hdistinct.source_width width (payload ++ rest) inp₀ work₀ out₀ hsource + hwidth hinput hwidthOther houtput + have hwidthWork : ∀ i, (widthDone.work i).read ≠ Γ.start := by + intro i + by_cases his : i = sourceIdx + · subst i + exact hwidthSource.read_ne_start + · by_cases hiw : i = widthIdx + · subst i + rw [hwidthValue.eq_init_move_right] + exact Tape.init_ofBool_move_right_read_ne_start width.bits + · rw [hwidthFrame i his hiw] + exact hwidthOther i his hiw + obtain ⟨separatorDone, hseparatorReach, hseparatorHalt, hseparatorInput, + hseparatorSource, hseparatorFrame, hseparatorOutput⟩ := + wordSeparatorTM_reachesIn_frame_internal sourceIdx (payload ++ rest) + widthDone.input widthDone.work widthDone.output hwidthSource + (by rw [hwidthInput]; exact hinput) + (fun i _ => hwidthWork i) + (by rw [hwidthOutput]; exact houtput) + have hseparatorTarget : + (separatorDone.work targetIdx).HasBinaryPrefix [] := by + rw [hseparatorFrame targetIdx (Ne.symm hdistinct.source_target), + hwidthFrame targetIdx (Ne.symm hdistinct.source_target) + hdistinct.target_width] + exact htarget + have hseparatorCounter : + (separatorDone.work counterIdx).HasBinaryNat 0 := by + rw [hseparatorFrame counterIdx (Ne.symm hdistinct.source_counter), + hwidthFrame counterIdx (Ne.symm hdistinct.source_counter) + hdistinct.counter_width] + exact hcounter + have hseparatorWidth : + (separatorDone.work widthIdx).HasBinaryNat width := by + rw [hseparatorFrame widthIdx (Ne.symm hdistinct.source_width)] + exact hwidthValue + have hseparatorOther : ∀ i, i ≠ sourceIdx → i ≠ targetIdx → + i ≠ counterIdx → i ≠ widthIdx → (separatorDone.work i).read ≠ Γ.start := by + intro i his hit hic hiw + rw [hseparatorFrame i his, hwidthFrame i his hiw] + exact hother i his hit hic hiw + obtain ⟨payloadDone, hpayloadReach, hpayloadHalt, hpayloadInput, + hpayloadSource, hpayloadTarget, hpayloadCounter, hpayloadWidth, + hpayloadFrame, hpayloadOutput⟩ := + wordPayloadTM_reachesIn_frame_internal sourceIdx targetIdx counterIdx widthIdx + hdistinct payload rest width hwidthLength separatorDone.input + separatorDone.work separatorDone.output hseparatorSource hseparatorTarget + hseparatorCounter hseparatorWidth + (by rw [hseparatorInput, hwidthInput]; exact hinput) + hseparatorOther + (by rw [hseparatorOutput, hwidthOutput]; exact houtput) + have hseparatorWork : ∀ i, (separatorDone.work i).read ≠ Γ.start := by + intro i + by_cases his : i = sourceIdx + · subst i + exact hseparatorSource.read_ne_start + · exact hseparatorFrame i his ▸ hwidthWork i + have hsepTransitionInput : TM.transitionInput separatorDone.input = + separatorDone.input := + TM.transitionInput_eq_self (by rw [hseparatorInput, hwidthInput]; exact hinput) + have hsepTransitionWork : + (fun i => TM.transitionTape (separatorDone.work i)) = separatorDone.work := by + funext i + exact TM.transitionTape_eq_self (hseparatorWork i) + have hsepTransitionOutput : TM.transitionTape separatorDone.output = + separatorDone.output := + TM.transitionTape_eq_self + (by rw [hseparatorOutput, hwidthOutput]; exact houtput) + have hpayloadReach' : payloadTM.reachesIn (wordPayloadTime width) + { state := payloadTM.qstart + input := TM.transitionInput separatorDone.input + work := fun i => TM.transitionTape (separatorDone.work i) + output := TM.transitionTape separatorDone.output } + payloadDone := by + rw [hsepTransitionInput, hsepTransitionWork, hsepTransitionOutput] + simpa [payloadTM] using hpayloadReach + have htailReach := TM.seqTM_reachesIn_of_reachesIn separatorTM payloadTM + (by simpa [separatorTM] using hseparatorReach) hseparatorHalt hpayloadReach' + have hwidthTransitionInput : TM.transitionInput widthDone.input = widthDone.input := + TM.transitionInput_eq_self (by rw [hwidthInput]; exact hinput) + have hwidthTransitionWork : + (fun i => TM.transitionTape (widthDone.work i)) = widthDone.work := by + funext i + exact TM.transitionTape_eq_self (hwidthWork i) + have hwidthTransitionOutput : TM.transitionTape widthDone.output = + widthDone.output := + TM.transitionTape_eq_self (by rw [hwidthOutput]; exact houtput) + have htailReach' : tailTM.reachesIn (1 + 1 + wordPayloadTime width) + { state := tailTM.qstart + input := TM.transitionInput widthDone.input + work := fun i => TM.transitionTape (widthDone.work i) + output := TM.transitionTape widthDone.output } + (TM.phase2Wrap separatorTM payloadTM payloadDone) := by + rw [hwidthTransitionInput, hwidthTransitionWork, hwidthTransitionOutput] + simpa [tailTM, separatorTM, payloadTM, TM.phase1Wrap] using htailReach + have hfull := TM.seqTM_reachesIn_of_reachesIn widthTM tailTM + (by simpa [widthTM] using hwidthReach) hwidthHalt htailReach' + let finalCfg := TM.phase2Wrap widthTM tailTM + (TM.phase2Wrap separatorTM payloadTM payloadDone) + refine ⟨finalCfg, ?_, ?_, hpayloadInput.trans (hseparatorInput.trans hwidthInput), + hpayloadSource, hpayloadTarget, hpayloadCounter, hpayloadWidth, ?_, + hpayloadOutput.trans (hseparatorOutput.trans hwidthOutput)⟩ + · simpa [finalCfg, wordDecodeTM, wordDecodeTime, widthTM, tailTM, + separatorTM, payloadTM] using hfull + · change finalCfg.state = + (wordDecodeTM sourceIdx targetIdx counterIdx widthIdx).qhalt + change Sum.inr (Sum.inr payloadDone.state) = + Sum.inr (Sum.inr (wordPayloadTM sourceIdx targetIdx counterIdx widthIdx).qhalt) + exact congrArg (fun q => Sum.inr (Sum.inr q)) hpayloadHalt + · intro i his hit hic hiw + change payloadDone.work i = work₀ i + rw [hpayloadFrame i his hit hic hiw, + hseparatorFrame i his, hwidthFrame i his hiw] + +private theorem forWorkOnesLoopTime_succ_le_size + (limit value count : ℕ) (hsum : value + count ≤ limit) : + TM.forWorkOnesLoopTime TM.binarySuccTime value count ≤ + 1 + count * (2 * limit.size + 4) := by + induction count generalizing value with + | zero => simp [TM.forWorkOnesLoopTime] + | succ count ih => + rw [TM.forWorkOnesLoopTime] + have hvalue : value ≤ limit := by omega + have hsize : value.size ≤ limit.size := Nat.size_le_size hvalue + have hsucc := TM.binarySuccTime_le value + have htail := ih (value + 1) (by omega) + rw [Nat.succ_mul] + omega + +private theorem binaryForLoopTime_one_le_size + (limit value count : ℕ) (hsum : value + count ≤ limit) : + TM.binaryForLoopTime (fun _ => 1) limit value count ≤ + (count + 1) * (4 * limit.size + 8) := by + induction count generalizing value with + | zero => + simp only [TM.binaryForLoopTime, TM.binaryForCompareTime] + omega + | succ count ih => + rw [TM.binaryForLoopTime] + have hvalue : value ≤ limit := by omega + have hsize : value.size ≤ limit.size := Nat.size_le_size hvalue + have hsucc := TM.binarySuccTime_le value + have htail := ih (value + 1) (by omega) + simp only [TM.binaryForCompareTime, TM.binaryForIterationTime] + nlinarith + +theorem wordDecodeTime_le_size_internal (width : ℕ) : + wordDecodeTime width ≤ + 8 * (width + 1) * (width.size + 2) := by + have hwidthLoop := forWorkOnesLoopTime_succ_le_size width 0 width (by omega) + have hpayloadLoop := binaryForLoopTime_one_le_size width 0 width (by omega) + have hwidth : wordWidthTime width ≤ + (width + 1) * (2 * width.size + 4) := by + unfold wordWidthTime + nlinarith + have hpayload : wordPayloadTime width ≤ + (width + 1) * (4 * width.size + 8) := by + unfold wordPayloadTime + simpa only [Nat.zero_add] using hpayloadLoop + unfold wordDecodeTime + nlinarith + +theorem wordWidthTM_isTransducer_internal {n : ℕ} + (sourceIdx widthIdx : Fin n) : + (wordWidthTM sourceIdx widthIdx).IsTransducer := by + exact TM.IsTransducer.forWorkOnesTM_internal + (TM.binarySuccTM_isTransducer widthIdx) + +theorem payloadBitTM_isTransducer_internal {n : ℕ} + (sourceIdx targetIdx : Fin n) : + (payloadBitTM sourceIdx targetIdx).IsTransducer := by + intro state iHead wHeads oHead + cases state with + | copy => + cases hsource : wHeads sourceIdx <;> + cases oHead <;> + simp [payloadBitTM, hsource, TM.allReadBack, TM.allIdle, TM.idleDir] + | done => + cases oHead <;> simp [payloadBitTM, TM.allIdle, TM.idleDir] + +theorem wordSeparatorTM_isTransducer_internal {n : ℕ} (sourceIdx : Fin n) : + (wordSeparatorTM sourceIdx).IsTransducer := by + intro state iHead wHeads oHead + cases state with + | skip => + by_cases hzero : wHeads sourceIdx = Γ.zero + · cases oHead <;> simp [wordSeparatorTM, hzero, TM.idleDir] + · by_cases hstart : wHeads sourceIdx = Γ.start + · cases oHead <;> + simp [wordSeparatorTM, hstart, TM.allIdle, TM.idleDir] + · cases oHead <;> + simp [wordSeparatorTM, hzero, hstart, TM.allReadBack, TM.idleDir] + | done => + cases oHead <;> simp [wordSeparatorTM, TM.allIdle, TM.idleDir] + +theorem wordPayloadTM_isTransducer_internal {n : ℕ} + (sourceIdx targetIdx counterIdx widthIdx : Fin n) : + (wordPayloadTM sourceIdx targetIdx counterIdx widthIdx).IsTransducer := by + exact TM.IsTransducer.binaryForTM_internal + (payloadBitTM_isTransducer_internal sourceIdx targetIdx) counterIdx widthIdx + +theorem wordDecodeTM_isTransducer_internal {n : ℕ} + (sourceIdx targetIdx counterIdx widthIdx : Fin n) : + (wordDecodeTM sourceIdx targetIdx counterIdx widthIdx).IsTransducer := by + exact TM.IsTransducer.seqTM_internal + (wordWidthTM_isTransducer_internal sourceIdx widthIdx) + (TM.IsTransducer.seqTM_internal + (wordSeparatorTM_isTransducer_internal sourceIdx) + (wordPayloadTM_isTransducer_internal sourceIdx targetIdx counterIdx widthIdx)) + +end Machine + +end RegisterStore + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/WordDecode/LinearInternal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/WordDecode/LinearInternal.lean new file mode 100644 index 0000000000..2d7d8791df --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/WordDecode/LinearInternal.lean @@ -0,0 +1,838 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.WordDecode.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Internal +public import Std.Tactic.BVDecide.Normalize.BitVec + +/-! +# Linear RAM snapshot word decoder — proof internals + +This file proves the exact three-pass behavior of `wordDecodeLinearTM`: copy +the unary width to a marker tape, rewind those markers, then consume one marker +while copying one payload bit. Each pass is linear in the encoded word width. +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace RegisterStore + +namespace Machine + +variable {n : ℕ} + +private def linearMarkWork (sourceIdx markerIdx : Fin n) + (work : Fin n → Tape) : Fin n → Tape := fun i => + if i = sourceIdx then (work i).move Dir3.right + else if i = markerIdx then + (work i).writeAndMove Γ.one Dir3.right + else work i + +private theorem linearMarkStep + (sourceIdx targetIdx markerIdx : Fin n) + (hdistinct : LinearWordDistinct sourceIdx targetIdx markerIdx) + (suffix pre : List Bool) (inp : Tape) (work : Fin n → Tape) (out : Tape) + (hsource : (work sourceIdx).HasBinarySuffix (true :: suffix)) + (hmarker : (work markerIdx).HasBinaryPrefix pre) + (hinput : inp.read ≠ Γ.start) + (hreads : ∀ i, (work i).read ≠ Γ.start) + (houtput : out.read ≠ Γ.start) : + let work' := linearMarkWork sourceIdx markerIdx work + ∃ c', + (wordDecodeLinearTM sourceIdx targetIdx markerIdx).step + { state := .mark, input := inp, work := work, output := out } = some c' ∧ + c'.state = .mark ∧ c'.input = inp ∧ + (c'.work sourceIdx).HasBinarySuffix suffix ∧ + (c'.work markerIdx).HasBinaryPrefix (pre ++ [true]) ∧ + (∀ i, i ≠ sourceIdx → i ≠ markerIdx → c'.work i = work i) ∧ + c'.work = work' ∧ c'.output = out := by + dsimp only + let work' := linearMarkWork sourceIdx markerIdx work + let c' : Cfg n (wordDecodeLinearTM sourceIdx targetIdx markerIdx).Q := + { state := .mark, input := inp, work := work', output := out } + have hread : (work sourceIdx).read = Γ.one := hsource.read_cons + have hstep : + (wordDecodeLinearTM sourceIdx targetIdx markerIdx).step + { state := .mark, input := inp, work := work, output := out } = some c' := by + rw [TM.step, if_neg (by simp [wordDecodeLinearTM])] + simp only [wordDecodeLinearTM, hread] + apply congrArg some + refine Cfg.ext rfl ?_ ?_ ?_ + · dsimp only [c'] + simp [TM.idleDir, hinput, Tape.move] + · dsimp only [c', work'] + funext i + by_cases his : i = sourceIdx + · subst i + simpa [linearMarkWork, hdistinct.source_marker] using + TM.writeAndMove_readBack (work sourceIdx) (hreads sourceIdx) Dir3.right + · by_cases him : i = markerIdx + · subst i + simp [linearMarkWork, his] + · simpa [linearMarkWork, his, him, TM.idleDir, hreads i, + Tape.move] using + TM.writeAndMove_readBack (work i) (hreads i) Dir3.stay + · dsimp only [c'] + simpa [TM.idleDir, houtput, Tape.move] using + TM.writeAndMove_readBack out houtput Dir3.stay + refine ⟨c', hstep, rfl, rfl, ?_, ?_, ?_, rfl, rfl⟩ + · dsimp only [c', work', linearMarkWork] + rw [if_pos rfl] + exact hsource.move_right_cons + · dsimp only [c', work', linearMarkWork] + rw [if_neg (Ne.symm hdistinct.source_marker), if_pos rfl] + simpa [Γw.ofBool, Γ.ofBool, Γw.toΓ] using + Tape.hasBinaryPrefix_write_bit true hmarker + · intro i his him + simp [c', work', linearMarkWork, his, him] + +private theorem linearMarkLoop + (sourceIdx targetIdx markerIdx : Fin n) + (hdistinct : LinearWordDistinct sourceIdx targetIdx markerIdx) + (width : ℕ) (payload rest pre : List Bool) + (inp : Tape) (work : Fin n → Tape) (out : Tape) + (hsource : (work sourceIdx).HasBinarySuffix + (List.replicate width true ++ false :: (payload ++ rest))) + (hmarker : (work markerIdx).HasBinaryPrefix pre) + (hinput : inp.read ≠ Γ.start) + (hreads : ∀ i, (work i).read ≠ Γ.start) + (houtput : out.read ≠ Γ.start) : + ∃ c', + (wordDecodeLinearTM sourceIdx targetIdx markerIdx).reachesIn width + { state := .mark, input := inp, work := work, output := out } c' ∧ + c'.state = .mark ∧ c'.input = inp ∧ + (c'.work sourceIdx).HasBinarySuffix (false :: (payload ++ rest)) ∧ + (c'.work markerIdx).HasBinaryPrefix + (pre ++ List.replicate width true) ∧ + (∀ i, i ≠ sourceIdx → i ≠ markerIdx → c'.work i = work i) ∧ + c'.output = out := by + induction width generalizing inp work out pre with + | zero => + refine ⟨_, .zero, rfl, rfl, ?_, ?_, ?_, rfl⟩ + · simpa using hsource + · simpa using hmarker + · intro i _ _ + rfl + | succ width ih => + have hshape : + List.replicate (width + 1) true ++ false :: (payload ++ rest) = + true :: (List.replicate width true ++ false :: (payload ++ rest)) := by + simp [List.replicate_succ] + rw [hshape] at hsource + obtain ⟨first, hfirstStep, hfirstState, hfirstInput, hfirstSource, + hfirstMarker, hfirstFrame, hfirstWork, hfirstOutput⟩ := + linearMarkStep sourceIdx targetIdx markerIdx hdistinct + (List.replicate width true ++ false :: (payload ++ rest)) pre + inp work out hsource hmarker hinput hreads houtput + have hfirstReads : ∀ i, (first.work i).read ≠ Γ.start := by + intro i + by_cases his : i = sourceIdx + · subst i + exact hfirstSource.read_ne_start + · by_cases him : i = markerIdx + · subst i + rw [hfirstMarker.read_blank] + decide + · rw [hfirstFrame i his him] + exact hreads i + obtain ⟨done, htailReach, hdoneState, hdoneInput, hdoneSource, + hdoneMarker, hdoneFrame, hdoneOutput⟩ := + ih (pre ++ [true]) first.input first.work first.output hfirstSource + hfirstMarker (by rw [hfirstInput]; exact hinput) hfirstReads + (by rw [hfirstOutput]; exact houtput) + refine ⟨done, TM.reachesIn.step hfirstStep ?_, hdoneState, + hdoneInput.trans hfirstInput, hdoneSource, ?_, ?_, + hdoneOutput.trans hfirstOutput⟩ + · have hfirstEq : first = + { state := LinearWordPhase.mark + input := first.input + work := first.work + output := first.output } := + Cfg.ext hfirstState rfl rfl rfl + rw [hfirstEq] + exact htailReach + · simpa [List.replicate_succ, List.append_assoc] using hdoneMarker + · intro i his him + rw [hdoneFrame i his him, hfirstFrame i his him] + +private def linearSeparatorWork (sourceIdx markerIdx : Fin n) + (work : Fin n → Tape) : Fin n → Tape := fun i => + if i = sourceIdx then (work i).move Dir3.right + else if i = markerIdx then (work i).move Dir3.left + else work i + +private theorem linearSeparatorStep + (sourceIdx targetIdx markerIdx : Fin n) + (hdistinct : LinearWordDistinct sourceIdx targetIdx markerIdx) + (payload rest : List Bool) (inp : Tape) (work : Fin n → Tape) (out : Tape) + (hsource : (work sourceIdx).HasBinarySuffix (false :: (payload ++ rest))) + (hmarker : (work markerIdx).HasBinaryPrefix (List.replicate payload.length true)) + (hinput : inp.read ≠ Γ.start) + (hreads : ∀ i, (work i).read ≠ Γ.start) + (houtput : out.read ≠ Γ.start) : + ∃ c', + (wordDecodeLinearTM sourceIdx targetIdx markerIdx).step + { state := .mark, input := inp, work := work, output := out } = some c' ∧ + c'.state = .rewind ∧ c'.input = inp ∧ + (c'.work sourceIdx).HasBinarySuffix (payload ++ rest) ∧ + (c'.work markerIdx).head = payload.length ∧ + (c'.work markerIdx).cells = (work markerIdx).cells ∧ + (∀ i, i ≠ sourceIdx → i ≠ markerIdx → c'.work i = work i) ∧ + c'.output = out := by + let work' := linearSeparatorWork sourceIdx markerIdx work + let c' : Cfg n (wordDecodeLinearTM sourceIdx targetIdx markerIdx).Q := + { state := .rewind, input := inp, work := work', output := out } + have hread : (work sourceIdx).read = Γ.zero := hsource.read_cons + have hmarkerRead : (work markerIdx).read = Γ.blank := hmarker.read_blank + have hstep : + (wordDecodeLinearTM sourceIdx targetIdx markerIdx).step + { state := .mark, input := inp, work := work, output := out } = some c' := by + rw [TM.step, if_neg (by simp [wordDecodeLinearTM])] + simp only [wordDecodeLinearTM, hread] + apply congrArg some + refine Cfg.ext rfl ?_ ?_ ?_ + · dsimp only [c'] + simp [TM.idleDir, hinput, Tape.move] + · dsimp only [c', work'] + funext i + by_cases his : i = sourceIdx + · subst i + simpa [linearSeparatorWork, hdistinct.source_marker] using + TM.writeAndMove_readBack (work sourceIdx) (hreads sourceIdx) Dir3.right + · by_cases him : i = markerIdx + · subst i + have hmarkerNe : (work markerIdx).read ≠ Γ.start := by + rw [hmarkerRead] + decide + simpa [linearSeparatorWork, his, hmarkerRead, TM.moveLeftDir] using + TM.writeAndMove_readBack (work markerIdx) hmarkerNe Dir3.left + · simpa [linearSeparatorWork, his, him, TM.idleDir, hreads i, + Tape.move] using + TM.writeAndMove_readBack (work i) (hreads i) Dir3.stay + · dsimp only [c'] + simpa [TM.idleDir, houtput, Tape.move] using + TM.writeAndMove_readBack out houtput Dir3.stay + refine ⟨c', hstep, rfl, rfl, ?_, ?_, ?_, ?_, rfl⟩ + · dsimp only [c', work', linearSeparatorWork] + rw [if_pos rfl] + exact hsource.move_right_cons + · dsimp only [c', work', linearSeparatorWork] + rw [if_neg (Ne.symm hdistinct.source_marker), if_pos rfl] + simp only [Tape.move] + rw [hmarker.1] + simp + · dsimp only [c', work', linearSeparatorWork] + rw [if_neg (Ne.symm hdistinct.source_marker), if_pos rfl, + Tape.move_cells] + · intro i his him + simp [c', work', linearSeparatorWork, his, him] + +private def linearRewindLeftWork (markerIdx : Fin n) + (work : Fin n → Tape) : Fin n → Tape := fun i => + if i = markerIdx then (work i).move Dir3.left else work i + +private theorem linearRewindLeftStep + (sourceIdx targetIdx markerIdx : Fin n) (head : ℕ) + (inp : Tape) (work : Fin n → Tape) (out : Tape) + (hmarker : (work markerIdx).StartInvariant) + (hhead : (work markerIdx).head = head + 1) + (hinput : inp.read ≠ Γ.start) + (hreads : ∀ i, i ≠ markerIdx → (work i).read ≠ Γ.start) + (houtput : out.read ≠ Γ.start) : + let work' := linearRewindLeftWork markerIdx work + ∃ c', + (wordDecodeLinearTM sourceIdx targetIdx markerIdx).step + { state := .rewind, input := inp, work := work, output := out } = some c' ∧ + c'.state = .rewind ∧ c'.input = inp ∧ + (c'.work markerIdx).head = head ∧ + (c'.work markerIdx).cells = (work markerIdx).cells ∧ + (∀ i, i ≠ markerIdx → c'.work i = work i) ∧ + c'.work = work' ∧ c'.output = out := by + dsimp only + let work' := linearRewindLeftWork markerIdx work + let c' : Cfg n (wordDecodeLinearTM sourceIdx targetIdx markerIdx).Q := + { state := .rewind, input := inp, work := work', output := out } + have hmarkerRead : (work markerIdx).read ≠ Γ.start := + hmarker.read_ne_start (by omega) + have hstep : + (wordDecodeLinearTM sourceIdx targetIdx markerIdx).step + { state := .rewind, input := inp, work := work, output := out } = some c' := by + rw [TM.step, if_neg (by simp [wordDecodeLinearTM])] + simp only [wordDecodeLinearTM, hmarkerRead, ↓reduceIte] + apply congrArg some + refine Cfg.ext rfl ?_ ?_ ?_ + · dsimp only [c'] + simp [TM.idleDir, hinput, Tape.move] + · dsimp only [c', work'] + funext i + by_cases him : i = markerIdx + · subst i + simpa [linearRewindLeftWork, hmarkerRead, TM.moveLeftDir] using + TM.writeAndMove_readBack (work markerIdx) hmarkerRead Dir3.left + · simpa [linearRewindLeftWork, him, TM.idleDir, hreads i him, + Tape.move] using + TM.writeAndMove_readBack (work i) (hreads i him) Dir3.stay + · dsimp only [c'] + simpa [TM.idleDir, houtput, Tape.move] using + TM.writeAndMove_readBack out houtput Dir3.stay + refine ⟨c', hstep, rfl, rfl, ?_, ?_, ?_, rfl, rfl⟩ + · simp [c', work', linearRewindLeftWork, Tape.move, hhead] + · simp [c', work', linearRewindLeftWork, Tape.move_cells] + · intro i him + simp [c', work', linearRewindLeftWork, him] + +private def linearRewindBaseWork (markerIdx : Fin n) + (work : Fin n → Tape) : Fin n → Tape := fun i => + if i = markerIdx then (work i).move Dir3.right else work i + +private theorem linearRewindBaseStep + (sourceIdx targetIdx markerIdx : Fin n) + (inp : Tape) (work : Fin n → Tape) (out : Tape) + (hmarker : (work markerIdx).StartInvariant) + (hhead : (work markerIdx).head = 0) + (hinput : inp.read ≠ Γ.start) + (hreads : ∀ i, i ≠ markerIdx → (work i).read ≠ Γ.start) + (houtput : out.read ≠ Γ.start) : + let work' := linearRewindBaseWork markerIdx work + ∃ c', + (wordDecodeLinearTM sourceIdx targetIdx markerIdx).step + { state := .rewind, input := inp, work := work, output := out } = some c' ∧ + c'.state = .copy ∧ c'.input = inp ∧ + (c'.work markerIdx).head = 1 ∧ + (c'.work markerIdx).cells = (work markerIdx).cells ∧ + (∀ i, i ≠ markerIdx → c'.work i = work i) ∧ + c'.work = work' ∧ c'.output = out := by + dsimp only + let work' := linearRewindBaseWork markerIdx work + let c' : Cfg n (wordDecodeLinearTM sourceIdx targetIdx markerIdx).Q := + { state := .copy, input := inp, work := work', output := out } + have hmarkerRead : (work markerIdx).read = Γ.start := by + rw [Tape.read, hhead] + exact hmarker.1 + have hstep : + (wordDecodeLinearTM sourceIdx targetIdx markerIdx).step + { state := .rewind, input := inp, work := work, output := out } = some c' := by + rw [TM.step, if_neg (by simp [wordDecodeLinearTM])] + simp only [wordDecodeLinearTM, hmarkerRead, ↓reduceIte] + apply congrArg some + refine Cfg.ext rfl ?_ ?_ ?_ + · dsimp only [c'] + simp [TM.idleDir, hinput, Tape.move] + · dsimp only [c', work'] + funext i + by_cases him : i = markerIdx + · subst i + simp [linearRewindBaseWork, Tape.writeAndMove, Tape.write, + Tape.move, hhead] + · simpa [linearRewindBaseWork, him, TM.idleDir, hreads i him, + Tape.move] using + TM.writeAndMove_readBack (work i) (hreads i him) Dir3.stay + · dsimp only [c'] + simpa [TM.idleDir, houtput, Tape.move] using + TM.writeAndMove_readBack out houtput Dir3.stay + refine ⟨c', hstep, rfl, rfl, ?_, ?_, ?_, rfl, rfl⟩ + · simp [c', work', linearRewindBaseWork, Tape.move, hhead] + · simp [c', work', linearRewindBaseWork, Tape.move_cells] + · intro i him + simp [c', work', linearRewindBaseWork, him] + +private theorem linearRewindLoop + (sourceIdx targetIdx markerIdx : Fin n) (head : ℕ) + (inp : Tape) (work : Fin n → Tape) (out : Tape) + (hmarker : (work markerIdx).StartInvariant) + (hhead : (work markerIdx).head = head) + (hinput : inp.read ≠ Γ.start) + (hreads : ∀ i, i ≠ markerIdx → (work i).read ≠ Γ.start) + (houtput : out.read ≠ Γ.start) : + ∃ c', + (wordDecodeLinearTM sourceIdx targetIdx markerIdx).reachesIn (head + 1) + { state := .rewind, input := inp, work := work, output := out } c' ∧ + c'.state = .copy ∧ c'.input = inp ∧ + (c'.work markerIdx).head = 1 ∧ + (c'.work markerIdx).cells = (work markerIdx).cells ∧ + (∀ i, i ≠ markerIdx → c'.work i = work i) ∧ + c'.output = out := by + induction head generalizing inp work out with + | zero => + obtain ⟨done, hstep, hstate, hdoneInput, hdoneHead, hdoneCells, + hdoneFrame, _, hdoneOutput⟩ := + linearRewindBaseStep sourceIdx targetIdx markerIdx inp work out hmarker + hhead hinput hreads houtput + exact ⟨done, TM.reachesIn.step hstep .zero, hstate, hdoneInput, + hdoneHead, hdoneCells, hdoneFrame, hdoneOutput⟩ + | succ head ih => + obtain ⟨first, hstep, hfirstState, hfirstInput, hfirstHead, + hfirstCells, hfirstFrame, hfirstWork, hfirstOutput⟩ := + linearRewindLeftStep sourceIdx targetIdx markerIdx head inp work out + hmarker hhead hinput hreads houtput + have hfirstMarker : (first.work markerIdx).StartInvariant := by + simpa only [Tape.StartInvariant, hfirstCells] using hmarker + have hfirstReads : ∀ i, i ≠ markerIdx → + (first.work i).read ≠ Γ.start := by + intro i him + rw [hfirstFrame i him] + exact hreads i him + obtain ⟨done, htail, hdoneState, hdoneInput, hdoneHead, hdoneCells, + hdoneFrame, hdoneOutput⟩ := + ih first.input first.work first.output hfirstMarker hfirstHead + (by rw [hfirstInput]; exact hinput) hfirstReads + (by rw [hfirstOutput]; exact houtput) + have hfirstEq : first = + { state := LinearWordPhase.rewind + input := first.input + work := first.work + output := first.output } := + Cfg.ext hfirstState rfl rfl rfl + refine ⟨done, TM.reachesIn.step hstep ?_, hdoneState, + hdoneInput.trans hfirstInput, hdoneHead, hdoneCells.trans hfirstCells, + ?_, hdoneOutput.trans hfirstOutput⟩ + · rw [hfirstEq] + exact htail + · intro i him + rw [hdoneFrame i him, hfirstFrame i him] + +private def linearCopyWork (sourceIdx targetIdx markerIdx : Fin n) + (bit : Bool) (work : Fin n → Tape) : Fin n → Tape := fun i => + if i = sourceIdx then (work i).move Dir3.right + else if i = targetIdx then + (work i).writeAndMove (Γw.ofBool bit) Dir3.right + else if i = markerIdx then (work i).move Dir3.right + else work i + +private theorem linearCopyStep + (sourceIdx targetIdx markerIdx : Fin n) + (hdistinct : LinearWordDistinct sourceIdx targetIdx markerIdx) + (bit : Bool) (payload markers pre : List Bool) + (inp : Tape) (work : Fin n → Tape) (out : Tape) + (hsource : (work sourceIdx).HasBinarySuffix (bit :: payload)) + (hmarker : (work markerIdx).HasBinarySuffix (true :: markers)) + (htarget : (work targetIdx).HasBinaryPrefix pre) + (hinput : inp.read ≠ Γ.start) + (hreads : ∀ i, (work i).read ≠ Γ.start) + (houtput : out.read ≠ Γ.start) : + let work' := linearCopyWork sourceIdx targetIdx markerIdx bit work + ∃ c', + (wordDecodeLinearTM sourceIdx targetIdx markerIdx).step + { state := .copy, input := inp, work := work, output := out } = some c' ∧ + c'.state = .copy ∧ c'.input = inp ∧ + (c'.work sourceIdx).HasBinarySuffix payload ∧ + (c'.work markerIdx).HasBinarySuffix markers ∧ + (c'.work targetIdx).HasBinaryPrefix (pre ++ [bit]) ∧ + (∀ i, i ≠ sourceIdx → i ≠ targetIdx → i ≠ markerIdx → + c'.work i = work i) ∧ + c'.work = work' ∧ c'.output = out := by + dsimp only + let work' := linearCopyWork sourceIdx targetIdx markerIdx bit work + let c' : Cfg n (wordDecodeLinearTM sourceIdx targetIdx markerIdx).Q := + { state := .copy, input := inp, work := work', output := out } + have hsourceRead : (work sourceIdx).read = Γ.ofBool bit := hsource.read_cons + have hmarkerRead : (work markerIdx).read = Γ.one := hmarker.read_cons + have hstep : + (wordDecodeLinearTM sourceIdx targetIdx markerIdx).step + { state := .copy, input := inp, work := work, output := out } = some c' := by + rw [TM.step, if_neg (by simp [wordDecodeLinearTM])] + cases bit <;> + simp only [wordDecodeLinearTM, hmarkerRead, hsourceRead, Γ.ofBool, + reduceCtorEq] + all_goals + apply congrArg some + refine Cfg.ext rfl ?_ ?_ ?_ + · dsimp only [c'] + simp [TM.idleDir, hinput, Tape.move] + · dsimp only [c', work'] + funext i + by_cases his : i = sourceIdx + · subst i + simpa [linearCopyWork, hdistinct.source_target, + hdistinct.source_marker] using + TM.writeAndMove_readBack (work sourceIdx) (hreads sourceIdx) + Dir3.right + · by_cases hit : i = targetIdx + · subst i + simp [linearCopyWork, his] + · by_cases him : i = markerIdx + · subst i + simpa [linearCopyWork, his, Ne.symm hdistinct.target_marker] using + TM.writeAndMove_readBack (work markerIdx) (hreads markerIdx) + Dir3.right + · simpa [linearCopyWork, his, hit, him, TM.idleDir, hreads i, + Tape.move] using + TM.writeAndMove_readBack (work i) (hreads i) Dir3.stay + · dsimp only [c'] + simpa [TM.idleDir, houtput, Tape.move] using + TM.writeAndMove_readBack out houtput Dir3.stay + refine ⟨c', hstep, rfl, rfl, ?_, ?_, ?_, ?_, rfl, rfl⟩ + · dsimp only [c', work', linearCopyWork] + rw [if_pos rfl] + exact hsource.move_right_cons + · dsimp only [c', work', linearCopyWork] + rw [if_neg (Ne.symm hdistinct.source_marker), + if_neg (Ne.symm hdistinct.target_marker), if_pos rfl] + exact hmarker.move_right_cons + · dsimp only [c', work', linearCopyWork] + rw [if_neg (Ne.symm hdistinct.source_target), if_pos rfl] + cases bit with + | false => + simpa [Γw.ofBool, Γ.ofBool, Γw.toΓ] using + Tape.hasBinaryPrefix_write_bit false htarget + | true => + simpa [Γw.ofBool, Γ.ofBool, Γw.toΓ] using + Tape.hasBinaryPrefix_write_bit true htarget + · intro i his hit him + simp [c', work', linearCopyWork, his, hit, him] + +private theorem linearCopyDoneStep + (sourceIdx targetIdx markerIdx : Fin n) + (inp : Tape) (work : Fin n → Tape) (out : Tape) + (hmarker : (work markerIdx).HasBinarySuffix []) + (hinput : inp.read ≠ Γ.start) + (hreads : ∀ i, (work i).read ≠ Γ.start) + (houtput : out.read ≠ Γ.start) : + ∃ c', + (wordDecodeLinearTM sourceIdx targetIdx markerIdx).step + { state := .copy, input := inp, work := work, output := out } = some c' ∧ + c'.state = .done ∧ c'.input = inp ∧ c'.work = work ∧ + c'.output = out := by + let c' : Cfg n (wordDecodeLinearTM sourceIdx targetIdx markerIdx).Q := + { state := .done, input := inp, work := work, output := out } + have hmarkerRead : (work markerIdx).read = Γ.blank := hmarker.read_nil + have hstep : + (wordDecodeLinearTM sourceIdx targetIdx markerIdx).step + { state := .copy, input := inp, work := work, output := out } = some c' := by + rw [TM.step, if_neg (by simp [wordDecodeLinearTM])] + simp only [wordDecodeLinearTM, hmarkerRead, TM.allReadBack] + apply congrArg some + refine Cfg.ext rfl ?_ ?_ ?_ + · dsimp only [c'] + simp [TM.idleDir, hinput, Tape.move] + · dsimp only [c'] + funext i + simpa [TM.idleDir, hreads i, Tape.move] using + TM.writeAndMove_readBack (work i) (hreads i) Dir3.stay + · dsimp only [c'] + simpa [TM.idleDir, houtput, Tape.move] using + TM.writeAndMove_readBack out houtput Dir3.stay + exact ⟨c', hstep, rfl, rfl, rfl, rfl⟩ + +private theorem linearCopyLoop + (sourceIdx targetIdx markerIdx : Fin n) + (hdistinct : LinearWordDistinct sourceIdx targetIdx markerIdx) + (payload rest pre : List Bool) + (inp : Tape) (work : Fin n → Tape) (out : Tape) + (hsource : (work sourceIdx).HasBinarySuffix (payload ++ rest)) + (hmarker : (work markerIdx).HasBinarySuffix + (List.replicate payload.length true)) + (htarget : (work targetIdx).HasBinaryPrefix pre) + (hinput : inp.read ≠ Γ.start) + (hreads : ∀ i, (work i).read ≠ Γ.start) + (houtput : out.read ≠ Γ.start) : + ∃ c', + (wordDecodeLinearTM sourceIdx targetIdx markerIdx).reachesIn + (payload.length + 1) + { state := .copy, input := inp, work := work, output := out } c' ∧ + c'.state = .done ∧ c'.input = inp ∧ + (c'.work sourceIdx).HasBinarySuffix rest ∧ + (c'.work markerIdx).HasBinarySuffix [] ∧ + (c'.work markerIdx).head = (work markerIdx).head + payload.length ∧ + (c'.work markerIdx).cells = (work markerIdx).cells ∧ + (c'.work targetIdx).HasBinaryPrefix (pre ++ payload) ∧ + (∀ i, i ≠ sourceIdx → i ≠ targetIdx → i ≠ markerIdx → + c'.work i = work i) ∧ + c'.output = out := by + induction payload generalizing inp work out pre with + | nil => + have hsource' : (work sourceIdx).HasBinarySuffix rest := by + simpa using hsource + have hmarker' : (work markerIdx).HasBinarySuffix [] := by + simpa using hmarker + obtain ⟨done, hstep, hstate, hdoneInput, hdoneWork, hdoneOutput⟩ := + linearCopyDoneStep sourceIdx targetIdx markerIdx inp work out hmarker' + hinput hreads houtput + refine ⟨done, TM.reachesIn.step hstep .zero, hstate, hdoneInput, + ?_, ?_, ?_, ?_, ?_, ?_, hdoneOutput⟩ + · rw [hdoneWork] + exact hsource' + · rw [hdoneWork] + exact hmarker' + · rw [hdoneWork] + simp + · rw [hdoneWork] + · simpa [hdoneWork] using htarget + · intro i _ _ _ + rw [hdoneWork] + | cons bit payload ih => + have hsourceShape : (work sourceIdx).HasBinarySuffix + (bit :: (payload ++ rest)) := by + simpa [List.cons_append] using hsource + have hmarkerShape : (work markerIdx).HasBinarySuffix + (true :: List.replicate payload.length true) := by + simpa [List.replicate_succ] using hmarker + obtain ⟨first, hstep, hfirstState, hfirstInput, hfirstSource, + hfirstMarker, hfirstTarget, hfirstFrame, hfirstWork, hfirstOutput⟩ := + linearCopyStep sourceIdx targetIdx markerIdx hdistinct bit + (payload ++ rest) + (List.replicate payload.length true) pre inp work out hsourceShape + hmarkerShape htarget hinput hreads houtput + have hfirstReads : ∀ i, (first.work i).read ≠ Γ.start := by + intro i + by_cases his : i = sourceIdx + · subst i + exact hfirstSource.read_ne_start + · by_cases hit : i = targetIdx + · subst i + rw [hfirstTarget.read_blank] + decide + · by_cases him : i = markerIdx + · subst i + exact hfirstMarker.read_ne_start + · rw [hfirstFrame i his hit him] + exact hreads i + obtain ⟨done, htail, hdoneState, hdoneInput, hdoneSource, + hdoneMarker, hdoneMarkerHead, hdoneMarkerCells, hdoneTarget, + hdoneFrame, hdoneOutput⟩ := + ih (pre ++ [bit]) first.input first.work first.output hfirstSource + hfirstMarker hfirstTarget (by rw [hfirstInput]; exact hinput) + hfirstReads (by rw [hfirstOutput]; exact houtput) + have hfirstEq : first = + { state := LinearWordPhase.copy + input := first.input + work := first.work + output := first.output } := + Cfg.ext hfirstState rfl rfl rfl + refine ⟨done, TM.reachesIn.step hstep ?_, hdoneState, + hdoneInput.trans hfirstInput, hdoneSource, hdoneMarker, ?_, ?_, ?_, + ?_, hdoneOutput.trans hfirstOutput⟩ + · rw [hfirstEq] + exact htail + · rw [hdoneMarkerHead] + rw [hfirstWork] + simp [linearCopyWork, Ne.symm hdistinct.source_marker, + Ne.symm hdistinct.target_marker, Tape.move] + omega + · rw [hdoneMarkerCells] + rw [hfirstWork] + simp [linearCopyWork, Ne.symm hdistinct.source_marker, + Ne.symm hdistinct.target_marker, Tape.move_cells] + · simpa [List.append_assoc] using hdoneTarget + · intro i his hit him + rw [hdoneFrame i his hit him, hfirstFrame i his hit him] + +theorem wordDecodeLinearTM_reachesIn_frame_internal + (sourceIdx targetIdx markerIdx : Fin n) + (hdistinct : LinearWordDistinct sourceIdx targetIdx markerIdx) + (payload rest : List Bool) (width : ℕ) (hwidth : payload.length = width) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hsource : (work₀ sourceIdx).HasBinarySuffix + (List.replicate width true ++ false :: (payload ++ rest))) + (htarget : (work₀ targetIdx).HasBinaryPrefix []) + (hmarker : (work₀ markerIdx).HasBinaryPrefix []) + (hmarkerStart : (work₀ markerIdx).cells 0 = Γ.start) + (hinput : inp₀.read ≠ Γ.start) + (hreads : ∀ i, (work₀ i).read ≠ Γ.start) + (houtput : out₀.read ≠ Γ.start) : + ∃ c', + (wordDecodeLinearTM sourceIdx targetIdx markerIdx).reachesIn + (wordDecodeLinearTime width) + { state := (wordDecodeLinearTM sourceIdx targetIdx markerIdx).qstart + input := inp₀ + work := work₀ + output := out₀ } c' ∧ + (wordDecodeLinearTM sourceIdx targetIdx markerIdx).halted c' ∧ + c'.input = inp₀ ∧ + (c'.work sourceIdx).HasBinarySuffix rest ∧ + (c'.work targetIdx).HasBinaryPrefix payload ∧ + (c'.work markerIdx).HasBinaryPrefix (List.replicate width true) ∧ + (∀ i, i ≠ sourceIdx → i ≠ targetIdx → i ≠ markerIdx → + c'.work i = work₀ i) ∧ + c'.output = out₀ := by + obtain ⟨marked, hmarkReach, hmarkedState, hmarkedInput, hmarkedSource, + hmarkedMarker, hmarkedFrame, hmarkedOutput⟩ := + linearMarkLoop sourceIdx targetIdx markerIdx hdistinct width payload rest [] + inp₀ work₀ out₀ hsource hmarker hinput hreads houtput + have hmarkedMarker' : (marked.work markerIdx).HasBinaryPrefix + (List.replicate payload.length true) := by + simpa [hwidth] using hmarkedMarker + have hmarkedReads : ∀ i, (marked.work i).read ≠ Γ.start := by + intro i + by_cases his : i = sourceIdx + · subst i + exact hmarkedSource.read_ne_start + · by_cases him : i = markerIdx + · subst i + rw [hmarkedMarker.read_blank] + decide + · rw [hmarkedFrame i his him] + exact hreads i + obtain ⟨separated, hseparatorStep, hseparatedState, hseparatedInput, + hseparatedSource, hseparatedMarkerHead, hseparatedMarkerCells, + hseparatedFrame, hseparatedOutput⟩ := + linearSeparatorStep sourceIdx targetIdx markerIdx hdistinct payload rest + marked.input marked.work marked.output hmarkedSource hmarkedMarker' + (by rw [hmarkedInput]; exact hinput) hmarkedReads + (by rw [hmarkedOutput]; exact houtput) + have hmarkedEq : marked = + { state := LinearWordPhase.mark + input := marked.input + work := marked.work + output := marked.output } := + Cfg.ext hmarkedState rfl rfl rfl + have hseparatorReach : + (wordDecodeLinearTM sourceIdx targetIdx markerIdx).reachesIn 1 marked + separated := by + rw [hmarkedEq] + exact TM.reachesIn.step hseparatorStep .zero + have hmarkedMarkerStart : (marked.work markerIdx).cells 0 = Γ.start := + TM.work_cells_zero_eq_start_of_reachesIn markerIdx hmarkReach hmarkerStart + have hseparatedMarkerInv : (separated.work markerIdx).StartInvariant := by + constructor + · rw [hseparatedMarkerCells] + exact hmarkedMarkerStart + · intro j hj + rw [hseparatedMarkerCells] + exact Tape.cells_ne_start_of_hasBinaryPrefix hmarkedMarker j hj + have hseparatedReads : ∀ i, i ≠ markerIdx → + (separated.work i).read ≠ Γ.start := by + intro i him + by_cases his : i = sourceIdx + · subst i + exact hseparatedSource.read_ne_start + · rw [hseparatedFrame i his him] + exact hmarkedReads i + obtain ⟨rewound, hrewindReach, hrewoundState, hrewoundInput, + hrewoundMarkerHead, hrewoundMarkerCells, hrewoundFrame, + hrewoundOutput⟩ := + linearRewindLoop sourceIdx targetIdx markerIdx payload.length + separated.input separated.work separated.output hseparatedMarkerInv + hseparatedMarkerHead + (by rw [hseparatedInput, hmarkedInput]; exact hinput) + hseparatedReads + (by rw [hseparatedOutput, hmarkedOutput]; exact houtput) + have hseparatedEq : separated = + { state := LinearWordPhase.rewind + input := separated.input + work := separated.work + output := separated.output } := + Cfg.ext hseparatedState rfl rfl rfl + have hrewindReach' : + (wordDecodeLinearTM sourceIdx targetIdx markerIdx).reachesIn + (payload.length + 1) separated rewound := by + rw [hseparatedEq] + exact hrewindReach + have hrewoundSource : (rewound.work sourceIdx).HasBinarySuffix + (payload ++ rest) := by + rw [hrewoundFrame sourceIdx hdistinct.source_marker] + exact hseparatedSource + have hrewoundTarget : (rewound.work targetIdx).HasBinaryPrefix [] := by + rw [hrewoundFrame targetIdx hdistinct.target_marker, + hseparatedFrame targetIdx (Ne.symm hdistinct.source_target) + hdistinct.target_marker, + hmarkedFrame targetIdx (Ne.symm hdistinct.source_target) + hdistinct.target_marker] + exact htarget + have hrewoundMarkerString : (rewound.work markerIdx).HasBinaryString + (List.replicate width true) := by + apply Tape.hasBinaryString_of_hasBinaryPrefix hmarkedMarker hrewoundMarkerHead + exact hrewoundMarkerCells.trans hseparatedMarkerCells + have hrewoundMarkerSuffix := hrewoundMarkerString.hasBinarySuffix + have hrewoundReads : ∀ i, (rewound.work i).read ≠ Γ.start := by + intro i + by_cases him : i = markerIdx + · subst i + exact hrewoundMarkerSuffix.read_ne_start + · rw [hrewoundFrame i him] + exact hseparatedReads i him + obtain ⟨done, hcopyReach, hdoneState, hdoneInput, hdoneSource, + hdoneMarkerSuffix, hdoneMarkerHead, hdoneMarkerCells, hdoneTarget, + hdoneFrame, hdoneOutput⟩ := + linearCopyLoop sourceIdx targetIdx markerIdx hdistinct payload rest [] + rewound.input rewound.work rewound.output hrewoundSource + (by simpa [hwidth] using hrewoundMarkerSuffix) hrewoundTarget + (by rw [hrewoundInput, hseparatedInput, hmarkedInput]; exact hinput) + hrewoundReads + (by rw [hrewoundOutput, hseparatedOutput, hmarkedOutput]; exact houtput) + have hrewoundEq : rewound = + { state := LinearWordPhase.copy + input := rewound.input + work := rewound.work + output := rewound.output } := + Cfg.ext hrewoundState rfl rfl rfl + have hcopyReach' : + (wordDecodeLinearTM sourceIdx targetIdx markerIdx).reachesIn + (payload.length + 1) rewound done := by + rw [hrewoundEq] + exact hcopyReach + let tm := wordDecodeLinearTM sourceIdx targetIdx markerIdx + have hfull := TM.reachesIn_trans tm + (TM.reachesIn_trans tm (TM.reachesIn_trans tm hmarkReach hseparatorReach) + hrewindReach') hcopyReach' + have htime : + width + 1 + (payload.length + 1) + (payload.length + 1) = + wordDecodeLinearTime width := by + simp only [wordDecodeLinearTime, hwidth] + omega + have hdoneMarker : (done.work markerIdx).HasBinaryPrefix + (List.replicate width true) := by + apply Tape.hasBinaryPrefix_of_hasBinaryString hrewoundMarkerString + · rw [hdoneMarkerHead, hrewoundMarkerHead, hwidth] + simp + omega + · exact hdoneMarkerCells + refine ⟨done, ?_, hdoneState, ?_, hdoneSource, ?_, hdoneMarker, ?_, ?_⟩ + · rw [← htime] + exact hfull + · exact hdoneInput.trans + (hrewoundInput.trans (hseparatedInput.trans hmarkedInput)) + · simpa using hdoneTarget + · intro i his hit him + rw [hdoneFrame i his hit him, hrewoundFrame i him, + hseparatedFrame i his him, hmarkedFrame i his him] + · exact hdoneOutput.trans + (hrewoundOutput.trans (hseparatedOutput.trans hmarkedOutput)) + +theorem wordDecodeLinearTM_isTransducer_internal + (sourceIdx targetIdx markerIdx : Fin n) : + (wordDecodeLinearTM sourceIdx targetIdx markerIdx).IsTransducer := by + intro phase iHead wHeads oHead + cases phase with + | mark => + cases hsource : wHeads sourceIdx <;> + cases oHead <;> + simp [wordDecodeLinearTM, hsource, TM.allReadBack, TM.allIdle, + TM.idleDir] + | rewind => + by_cases hmarker : wHeads markerIdx = Γ.start <;> + cases oHead <;> + simp [wordDecodeLinearTM, hmarker, TM.idleDir] + | copy => + cases hmarker : wHeads markerIdx with + | one => + cases hsource : wHeads sourceIdx <;> + cases oHead <;> + simp [wordDecodeLinearTM, hmarker, hsource, TM.allReadBack, + TM.idleDir] + | zero | blank => + cases oHead <;> + simp [wordDecodeLinearTM, hmarker, TM.allReadBack, TM.idleDir] + | start => + cases oHead <;> + simp [wordDecodeLinearTM, hmarker, TM.idleDir] + | done => + cases oHead <;> simp [wordDecodeLinearTM, TM.allIdle, TM.idleDir] + +end Machine + +end RegisterStore + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/WordEncode.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/WordEncode.lean new file mode 100644 index 0000000000..5406ae4932 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/WordEncode.lean @@ -0,0 +1,162 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.WordEncode.Defs +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.WordEncode.Internal + +/-! +# Self-delimiting word emission +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace RegisterStore + +namespace Machine + +/-- One generic work-tape pass appends either the unary width header or the +payload bits while preserving input and every unrelated work tape exactly. -/ +theorem workEmitTM_hoareTime_frame {n : ℕ} + (idx : Fin n) (mode : WorkEmitMode) (bits emitted : List Bool) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hsource : (work₀ idx).HasBinarySuffix bits) + (hinput : TM.Parked inp₀) + (hother : ∀ i, i ≠ idx → TM.Parked (work₀ i)) + (houtput : out₀.HasBinaryPrefix emitted) : + (workEmitTM idx mode).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + (work idx).HasBinarySuffix [] ∧ + (work idx).cells = (work₀ idx).cells ∧ + (work idx).head = (work₀ idx).head + bits.length ∧ + (∀ i, i ≠ idx → work i = work₀ i) ∧ + out.HasBinaryPrefix (emitted ++ workEmitBits mode bits)) + (workEmitTime bits) := + workEmitTM_hoareTime_frame_internal idx mode bits emitted inp₀ work₀ + out₀ hsource hinput hother houtput + +/-- Emit `WordCode.encode value` from a canonical natural-number work tape, +preserving the input, source cells, and every unrelated work tape exactly. -/ +theorem wordEncodeTM_hoareTime_frame {n : ℕ} + (idx : Fin n) (value : ℕ) (emitted : List Bool) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hvalue : (work₀ idx).HasBinaryNat value) + (hinput : TM.Parked inp₀) + (hother : ∀ i, i ≠ idx → TM.Parked (work₀ i)) + (houtput : out₀.HasBinaryPrefix emitted) : + (wordEncodeTM idx).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + (work idx).HasBinarySuffix [] ∧ + (work idx).cells = (work₀ idx).cells ∧ + (work idx).head = value.bits.length + 1 ∧ + (∀ i, i ≠ idx → work i = work₀ i) ∧ + out.HasBinaryPrefix (emitted ++ WordCode.encode value)) + (wordEncodeTime value) := + wordEncodeTM_hoareTime_frame_internal idx value emitted inp₀ work₀ out₀ + hvalue hinput hother houtput + +/-- Rewind any bounded cursor over canonical binary contents and emit the +complete self-delimiting word, retaining a literal external frame. -/ +theorem rewindWordEncodeTM_hoareTime_frame {n : ℕ} + (idx : Fin n) (value headBound : ℕ) (emitted : List Bool) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hcontent : (work₀ idx).HasBinaryContent value.bits) + (hstart : (work₀ idx).cells 0 = Γ.start) + (hhead : 1 ≤ (work₀ idx).head ∧ (work₀ idx).head ≤ headBound) + (hinput : TM.Parked inp₀) + (hother : ∀ i, i ≠ idx → TM.Parked (work₀ i)) + (houtput : out₀.HasBinaryPrefix emitted) : + (rewindWordEncodeTM idx).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + (work idx).HasBinarySuffix [] ∧ + (work idx).cells = (work₀ idx).cells ∧ + (work idx).head = value.bits.length + 1 ∧ + (∀ i, i ≠ idx → work i = work₀ i) ∧ + out.HasBinaryPrefix (emitted ++ WordCode.encode value)) + (rewindWordEncodeTime value headBound) := + rewindWordEncodeTM_hoareTime_frame_internal idx value headBound emitted + inp₀ work₀ out₀ hcontent hstart hhead hinput hother houtput + +/-- Each emission pass is append-only on the output tape. -/ +theorem workEmitTM_isTransducer {n : ℕ} + (idx : Fin n) (mode : WorkEmitMode) : + (workEmitTM idx mode).IsTransducer := by + intro phase iHead wHeads oHead + cases phase with + | scan => + cases hread : wHeads idx <;> + simp [workEmitTM, hread, TM.allReadBack, TM.idleDir] <;> + split <;> cases oHead <;> simp + | done => + cases oHead <;> simp [workEmitTM, TM.allIdle, TM.idleDir] + +/-- Complete word emission is append-only on the output tape. -/ +theorem wordEncodeTM_isTransducer {n : ℕ} (idx : Fin n) : + (wordEncodeTM idx).IsTransducer := + (workEmitTM_isTransducer idx .width).seqTM + ((TM.rewindWorkTM_isTransducer idx).seqTM + (workEmitTM_isTransducer idx .payload)) + +/-- Rewind-and-emit word encoding is append-only on the output tape. -/ +theorem rewindWordEncodeTM_isTransducer {n : ℕ} (idx : Fin n) : + (rewindWordEncodeTM idx).IsTransducer := + (TM.rewindWorkTM_isTransducer idx).seqTM + (wordEncodeTM_isTransducer idx) + +/-- Coarse all-prefix auxiliary-space envelope for one emission pass. -/ +theorem workEmitTM_prefix_withinAuxSpace {n : ℕ} + (idx : Fin n) (mode : WorkEmitMode) (bits : List Bool) + (inputLength initialSpace time : ℕ) + (start current : Complexity.Cfg n (workEmitTM idx mode).Q) + (hinitial : start.WithinAuxSpace inputLength initialSpace) + (hreach : (workEmitTM idx mode).reachesIn time start current) + (htime : time ≤ workEmitTime bits) : + current.WithinAuxSpace inputLength + (initialSpace + workEmitTime bits) := + (hinitial.reachesIn hreach).mono le_rfl (by omega) + +/-- Coarse all-prefix auxiliary-space envelope for complete word emission. -/ +theorem wordEncodeTM_prefix_withinAuxSpace {n : ℕ} + (idx : Fin n) (value inputLength initialSpace time : ℕ) + (start current : Complexity.Cfg n (wordEncodeTM idx).Q) + (hinitial : start.WithinAuxSpace inputLength initialSpace) + (hreach : (wordEncodeTM idx).reachesIn time start current) + (htime : time ≤ wordEncodeTime value) : + current.WithinAuxSpace inputLength + (initialSpace + wordEncodeTime value) := + (hinitial.reachesIn hreach).mono le_rfl (by omega) + +/-- Coarse all-prefix envelope for rewind followed by word emission. -/ +theorem rewindWordEncodeTM_prefix_withinAuxSpace {n : ℕ} + (idx : Fin n) (value headBound inputLength initialSpace time : ℕ) + (start current : Complexity.Cfg n (rewindWordEncodeTM idx).Q) + (hinitial : start.WithinAuxSpace inputLength initialSpace) + (hreach : (rewindWordEncodeTM idx).reachesIn time start current) + (htime : time ≤ rewindWordEncodeTime value headBound) : + current.WithinAuxSpace inputLength + (initialSpace + rewindWordEncodeTime value headBound) := + (hinitial.reachesIn hreach).mono le_rfl (by omega) + +end Machine + +end RegisterStore + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/WordEncode/Defs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/WordEncode/Defs.lean new file mode 100644 index 0000000000..ff612cef46 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/WordEncode/Defs.lean @@ -0,0 +1,139 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines +public import Mathlib.Data.Nat.Bits +public import Mathlib.Tactic.NormNum.Inv +public import Mathlib.Tactic.NormNum.Pow + +/-! +# Self-delimiting word emission — definitions + +The encoded-store update path needs to re-emit decoded entries. A generic +work-tape pass either emits one unary width mark per source bit or copies the +payload bits themselves. `wordEncodeTM` composes those passes around a rewind. +-/ + + +@[expose] public section + +namespace Complexity + +namespace RAM + +namespace RegisterStore + +namespace Machine + +/-- Which half of a self-delimiting word a work-tape pass emits. -/ +inductive WorkEmitMode where + | width + | payload + deriving DecidableEq + +/-- `WorkEmitMode` is a finite controller parameter. -/ +instance instFintypeWorkEmitMode : Fintype WorkEmitMode where + elems := {.width, .payload} + complete := fun mode => by cases mode <;> simp + +/-- Finite phases of one work-tape emission pass. -/ +inductive WorkEmitPhase where + | scan + | done + deriving DecidableEq + +/-- `WorkEmitPhase` has exactly two states. -/ +instance instFintypeWorkEmitPhase : Fintype WorkEmitPhase where + elems := {.scan, .done} + complete := fun phase => by cases phase <;> simp + +/-- Bits emitted by one complete pass. Width mode emits unary length followed +by its zero separator; payload mode copies the source bits verbatim. -/ +def workEmitBits : WorkEmitMode → List Bool → List Bool + | .width, bits => List.replicate bits.length true ++ [false] + | .payload, bits => bits + +/-- Scan one canonical Boolean work tape and append either its unary-width +header or its payload to the output. -/ +def workEmitTM {n : ℕ} (idx : Fin n) (mode : WorkEmitMode) : TM n where + Q := WorkEmitPhase + qstart := .scan + qhalt := .done + δ := fun phase iHead wHeads oHead => + match phase with + | .scan => + match wHeads idx with + | .zero => + (.scan, fun i => TM.readBackWrite (wHeads i), + if mode = .width then .one else .zero, + TM.idleDir iHead, + fun i => if i = idx then .right else TM.idleDir (wHeads i), + .right) + | .one => + (.scan, fun i => TM.readBackWrite (wHeads i), .one, + TM.idleDir iHead, + fun i => if i = idx then .right else TM.idleDir (wHeads i), + .right) + | .blank => + if mode = .width then + (.done, fun i => TM.readBackWrite (wHeads i), .zero, + TM.idleDir iHead, fun i => TM.idleDir (wHeads i), .right) + else + TM.allReadBack .done iHead wHeads oHead + | .start => TM.allReadBack .scan iHead wHeads oHead + | .done => TM.allIdle .done iHead wHeads oHead + δ_right_of_start := by + intro phase iHead wHeads oHead + cases phase with + | scan => + cases hread : wHeads idx + · exact ⟨TM.idleDir_right_of_start, by + intro i hi + by_cases hidx : i = idx + · simp [hidx] + · simp [hidx, TM.idleDir_right_of_start hi], fun _ => rfl⟩ + · exact ⟨TM.idleDir_right_of_start, by + intro i hi + by_cases hidx : i = idx + · simp [hidx] + · simp [hidx, TM.idleDir_right_of_start hi], fun _ => rfl⟩ + · dsimp only + split + · exact ⟨TM.idleDir_right_of_start, + fun _ => TM.idleDir_right_of_start, fun _ => rfl⟩ + · exact TM.rightOfStart_allReadBack iHead wHeads oHead + · exact TM.rightOfStart_allReadBack iHead wHeads oHead + | done => exact TM.rightOfStart_allIdle iHead wHeads oHead + +/-- Exact time of one work-tape emission pass. -/ +def workEmitTime (bits : List Bool) : ℕ := bits.length + 1 + +/-- Emit one complete self-delimiting word from a canonical binary work tape. -/ +def wordEncodeTM {n : ℕ} (idx : Fin n) : TM n := + TM.seqTM (workEmitTM idx .width) + (TM.seqTM (TM.rewindWorkTM idx) (workEmitTM idx .payload)) + +/-- Conservative exact-composition bound for one emitted natural. -/ +def wordEncodeTime (value : ℕ) : ℕ := + 3 * value.bits.length + 7 + +/-- Rewind an arbitrary positive cursor over canonical binary contents, then +emit the complete self-delimiting word. -/ +def rewindWordEncodeTM {n : ℕ} (idx : Fin n) : TM n := + TM.seqTM (TM.rewindWorkTM idx) (wordEncodeTM idx) + +/-- Composition bound for rewind followed by complete word emission. -/ +def rewindWordEncodeTime (value headBound : ℕ) : ℕ := + headBound + 2 + 1 + wordEncodeTime value + +end Machine + +end RegisterStore + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/WordEncode/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/WordEncode/Internal.lean new file mode 100644 index 0000000000..fc7ea40bc1 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/WordEncode/Internal.lean @@ -0,0 +1,495 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.WordEncode.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.ResetBinary +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinarySucc.Defs + +/-! +# Self-delimiting word emission — proof internals +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace RegisterStore + +namespace Machine + +variable {n : ℕ} + +private def workEmitBit (mode : WorkEmitMode) (bit : Bool) : Bool := + match mode with + | .width => true + | .payload => bit + +private theorem workEmitBits_cons (mode : WorkEmitMode) + (bit : Bool) (bits : List Bool) : + workEmitBits mode (bit :: bits) = + workEmitBit mode bit :: workEmitBits mode bits := by + cases mode <;> simp [workEmitBits, workEmitBit, List.replicate_succ] + +private theorem parked_of_binarySuffix {t : Tape} {bits : List Bool} + (h : t.HasBinarySuffix bits) : TM.Parked t := + ⟨h.1, h.2.2.2⟩ + +private theorem parked_of_binaryPrefix {t : Tape} {bits : List Bool} + (h : t.HasBinaryPrefix bits) : TM.Parked t := + ⟨by rw [h.1]; omega, + (show t.HasBinaryContent bits from h.2).cells_ne_start⟩ + +private theorem cells_eq_init_of_binaryContent {t : Tape} {bits : List Bool} + (h : t.HasBinaryContent bits) (hstart : t.cells 0 = Γ.start) : + t.cells = (Tape.init (bits.map Γ.ofBool)).cells := by + let parked : Tape := { head := bits.length + 1, cells := t.cells } + have hprefix : parked.HasBinaryPrefix bits := ⟨rfl, h⟩ + simpa [parked] using hprefix.cells_eq_init hstart + +theorem workEmitTM_reachesIn_frame_internal + (idx : Fin n) (mode : WorkEmitMode) : + ∀ (bits emitted : List Bool) + (c : Complexity.Cfg n (workEmitTM idx mode).Q), + c.state = WorkEmitPhase.scan → + (c.work idx).HasBinarySuffix bits → + TM.Parked c.input → + (∀ i, i ≠ idx → TM.Parked (c.work i)) → + c.output.HasBinaryPrefix emitted → + ∃ c', + (workEmitTM idx mode).reachesIn (workEmitTime bits) c c' ∧ + (workEmitTM idx mode).halted c' ∧ + c'.input = c.input ∧ + (c'.work idx).HasBinarySuffix [] ∧ + (c'.work idx).cells = (c.work idx).cells ∧ + (c'.work idx).head = (c.work idx).head + bits.length ∧ + (∀ i, i ≠ idx → c'.work i = c.work i) ∧ + c'.output.HasBinaryPrefix (emitted ++ workEmitBits mode bits) := by + intro bits + induction bits with + | nil => + intro emitted c hstate hsource hinput hother houtput + have hsourceRead : (c.work idx).read = Γ.blank := hsource.read_nil + cases mode with + | width => + let c' : Complexity.Cfg n (workEmitTM idx .width).Q := + { state := WorkEmitPhase.done + input := TM.transitionInput c.input + work := fun i => TM.transitionTape (c.work i) + output := c.output.writeAndMove Γ.zero Dir3.right } + have hstep : (workEmitTM idx .width).step c = some c' := by + simp [TM.step, hstate, workEmitTM, hsourceRead, c', + TM.transitionInput, TM.transitionTape] + have hinputKeep : c'.input = c.input := by + simpa [c'] using TM.transitionInput_eq_self hinput.read_ne_start + have hsourceKeep : c'.work idx = c.work idx := by + simpa [c'] using TM.transitionTape_eq_self (by + rw [hsourceRead] + decide) + have hotherKeep (i) (hi : i ≠ idx) : c'.work i = c.work i := by + simpa [c'] using TM.transitionTape_eq_self (hother i hi).read_ne_start + have houtput' : + c'.output.HasBinaryPrefix (emitted ++ [false]) := by + simpa [c'] using Tape.hasBinaryPrefix_write_bit false houtput + refine ⟨c', .step hstep .zero, rfl, hinputKeep, ?_, ?_, ?_, + hotherKeep, ?_⟩ + · rw [hsourceKeep] + exact hsource + · rw [hsourceKeep] + · rw [hsourceKeep] + simp + · simpa [workEmitBits] using houtput' + | payload => + let c' : Complexity.Cfg n (workEmitTM idx .payload).Q := + { state := WorkEmitPhase.done + input := TM.transitionInput c.input + work := fun i => TM.transitionTape (c.work i) + output := TM.transitionTape c.output } + have hstep : (workEmitTM idx .payload).step c = some c' := by + simp [TM.step, hstate, workEmitTM, hsourceRead, c', + TM.allReadBack, TM.transitionInput, TM.transitionTape] + have hinputKeep : c'.input = c.input := by + simpa [c'] using TM.transitionInput_eq_self hinput.read_ne_start + have hsourceKeep : c'.work idx = c.work idx := by + simpa [c'] using TM.transitionTape_eq_self (by + rw [hsourceRead] + decide) + have hotherKeep (i) (hi : i ≠ idx) : c'.work i = c.work i := by + simpa [c'] using TM.transitionTape_eq_self (hother i hi).read_ne_start + have houtputKeep : c'.output = c.output := by + simpa [c'] using TM.transitionTape_eq_self (by + rw [houtput.read_blank] + decide) + refine ⟨c', .step hstep .zero, rfl, hinputKeep, ?_, ?_, ?_, + hotherKeep, ?_⟩ + · rw [hsourceKeep] + exact hsource + · rw [hsourceKeep] + · rw [hsourceKeep] + simp + · rw [houtputKeep] + simpa [workEmitBits] + | cons bit bits ih => + intro emitted c hstate hsource hinput hother houtput + have hsourceRead : (c.work idx).read = Γ.ofBool bit := + hsource.read_cons + let c₁ : Complexity.Cfg n (workEmitTM idx mode).Q := + { state := WorkEmitPhase.scan + input := TM.transitionInput c.input + work := fun i => + (c.work i).writeAndMove (TM.readBackWrite (c.work i).read) + (if i = idx then Dir3.right else TM.idleDir (c.work i).read) + output := c.output.writeAndMove + (Γ.ofBool (workEmitBit mode bit)) Dir3.right } + have hstep : (workEmitTM idx mode).step c = some c₁ := by + cases mode <;> cases bit <;> + simp [TM.step, hstate, workEmitTM, hsourceRead, c₁, + TM.transitionInput, workEmitBit, Γ.ofBool] + have hinputKeep : c₁.input = c.input := by + simpa [c₁] using TM.transitionInput_eq_self hinput.read_ne_start + have hsourceMove : c₁.work idx = (c.work idx).move Dir3.right := by + rw [show c₁.work idx = + (c.work idx).writeAndMove (TM.readBackWrite (c.work idx).read) + Dir3.right by simp [c₁]] + exact TM.writeAndMove_readBack _ hsource.read_ne_start Dir3.right + have hotherKeep (i) (hi : i ≠ idx) : c₁.work i = c.work i := by + have htransition : c₁.work i = TM.transitionTape (c.work i) := by + simp [c₁, hi, TM.transitionTape] + rw [htransition] + exact TM.transitionTape_eq_self (hother i hi).read_ne_start + have hsource₁ : (c₁.work idx).HasBinarySuffix bits := by + rw [hsourceMove] + exact hsource.move_right_cons + have houtput₁ : c₁.output.HasBinaryPrefix + (emitted ++ [workEmitBit mode bit]) := by + simpa [c₁] using Tape.hasBinaryPrefix_write_bit + (workEmitBit mode bit) houtput + obtain ⟨c', hreach, hhalt, hinput', hsource', hsourceCells, + hsourceHead, hother', houtput'⟩ := + ih (emitted ++ [workEmitBit mode bit]) c₁ rfl hsource₁ + (hinputKeep ▸ hinput) + (fun i hi => hotherKeep i hi ▸ hother i hi) houtput₁ + refine ⟨c', ?_, hhalt, hinput'.trans hinputKeep, hsource', ?_, ?_, + ?_, ?_⟩ + · simpa [workEmitTime] using TM.reachesIn.step hstep hreach + · rw [hsourceCells, hsourceMove, Tape.move_cells] + · rw [hsourceHead, hsourceMove] + simp [Tape.move] + omega + · intro i hi + exact (hother' i hi).trans (hotherKeep i hi) + · rw [workEmitBits_cons] + simpa [List.append_assoc] using houtput' + +theorem workEmitTM_hoareTime_frame_internal + (idx : Fin n) (mode : WorkEmitMode) (bits emitted : List Bool) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hsource : (work₀ idx).HasBinarySuffix bits) + (hinput : TM.Parked inp₀) + (hother : ∀ i, i ≠ idx → TM.Parked (work₀ i)) + (houtput : out₀.HasBinaryPrefix emitted) : + (workEmitTM idx mode).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + (work idx).HasBinarySuffix [] ∧ + (work idx).cells = (work₀ idx).cells ∧ + (work idx).head = (work₀ idx).head + bits.length ∧ + (∀ i, i ≠ idx → work i = work₀ i) ∧ + out.HasBinaryPrefix (emitted ++ workEmitBits mode bits)) + (workEmitTime bits) := by + intro inp work out hpre + rcases hpre with ⟨hinp, hwork, hout⟩ + subst inp + subst work + subst out + obtain ⟨c', hreach, hhalt, hinput', hsource', hcells, hhead, + hframe, houtput'⟩ := + workEmitTM_reachesIn_frame_internal idx mode bits emitted + { state := WorkEmitPhase.scan + input := inp₀ + work := work₀ + output := out₀ } + rfl hsource hinput hother houtput + exact ⟨c', workEmitTime bits, le_rfl, hreach, hhalt, hinput', + hsource', hcells, hhead, hframe, houtput'⟩ + +theorem wordEncodeTM_hoareTime_frame_internal + (idx : Fin n) (value : ℕ) (emitted : List Bool) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hvalue : (work₀ idx).HasBinaryNat value) + (hinput : TM.Parked inp₀) + (hother : ∀ i, i ≠ idx → TM.Parked (work₀ i)) + (houtput : out₀.HasBinaryPrefix emitted) : + (wordEncodeTM idx).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + (work idx).HasBinarySuffix [] ∧ + (work idx).cells = (work₀ idx).cells ∧ + (work idx).head = value.bits.length + 1 ∧ + (∀ i, i ≠ idx → work i = work₀ i) ∧ + out.HasBinaryPrefix (emitted ++ WordCode.encode value)) + (wordEncodeTime value) := by + intro inp work out hpre + rcases hpre with ⟨hinp, hwork, hout⟩ + subst inp + subst work + subst out + have hwidthContract := workEmitTM_hoareTime_frame_internal idx .width + value.bits emitted inp₀ work₀ out₀ hvalue.2.hasBinarySuffix hinput + hother houtput + obtain ⟨widthDone, widthTime, hwidthTime, hwidthReach, hwidthHalt, + hwidthInput, hwidthSuffix, hwidthCells, hwidthHead, + hwidthFrame, hwidthOutput⟩ := + hwidthContract inp₀ work₀ out₀ ⟨rfl, rfl, rfl⟩ + have hwidthSourceParked : TM.Parked (widthDone.work idx) := + parked_of_binarySuffix hwidthSuffix + have hwidthWorkParked : ∀ i, TM.Parked (widthDone.work i) := by + intro i + by_cases hi : i = idx + · subst i + exact hwidthSourceParked + · rw [hwidthFrame i hi] + exact hother i hi + have hwidthOutputParked : TM.Parked widthDone.output := + parked_of_binaryPrefix hwidthOutput + obtain ⟨hwidthInputTransition, hwidthWorkTransition, + hwidthOutputTransition⟩ := + TM.phaseTransition_eq_self_of_reads_ne_start + (hwidthInput ▸ hinput.read_ne_start) + (fun i => (hwidthWorkParked i).read_ne_start) + hwidthOutputParked.read_ne_start + have hwidthContent : + (widthDone.work idx).HasBinaryContent value.bits := by + simpa only [Tape.HasBinaryContent, hwidthCells] using + hvalue.2.hasBinaryContent + have hwidthStart : (widthDone.work idx).cells 0 = Γ.start := by + rw [hwidthCells] + exact hvalue.1 + have hwidthHeadBound : + 1 ≤ (widthDone.work idx).head ∧ + (widthDone.work idx).head ≤ value.bits.length + 1 := by + rw [hwidthHead, hvalue.2.1] + omega + have hrewindContract := TM.rewindBinaryWorkTM_hoareTime_frame idx + value.bits (value.bits.length + 1) widthDone.input widthDone.work + widthDone.output hwidthContent hwidthStart hwidthHeadBound + (hwidthInput ▸ hinput) (fun i hi => hwidthWorkParked i) + hwidthOutputParked + obtain ⟨rewindDone, rewindTime, hrewindTime, hrewindReach, + hrewindHalt, hrewindInput, hrewindTarget, hrewindFrame, + hrewindOutput⟩ := + hrewindContract widthDone.input widthDone.work widthDone.output + ⟨rfl, rfl, rfl⟩ + have hrewindSourceString : + (rewindDone.work idx).HasBinaryString value.bits := by + rw [hrewindTarget] + exact Tape.init_move_right_hasBinaryString value.bits + have hrewindWorkParked : ∀ i, TM.Parked (rewindDone.work i) := by + intro i + by_cases hi : i = idx + · subst i + exact ⟨by rw [hrewindSourceString.1], + hrewindSourceString.hasBinaryContent.cells_ne_start⟩ + · rw [hrewindFrame i hi] + exact hwidthWorkParked i + have hrewindOutputPrefix : rewindDone.output.HasBinaryPrefix + (emitted ++ workEmitBits .width value.bits) := by + rw [hrewindOutput] + exact hwidthOutput + have hrewindOutputParked : TM.Parked rewindDone.output := + parked_of_binaryPrefix hrewindOutputPrefix + have hrewindInputParked : TM.Parked rewindDone.input := by + rw [hrewindInput, hwidthInput] + exact hinput + obtain ⟨hrewindInputTransition, hrewindWorkTransition, + hrewindOutputTransition⟩ := + TM.phaseTransition_eq_self_of_reads_ne_start + hrewindInputParked.read_ne_start + (fun i => (hrewindWorkParked i).read_ne_start) + hrewindOutputParked.read_ne_start + have hpayloadContract := workEmitTM_hoareTime_frame_internal idx .payload + value.bits (emitted ++ workEmitBits .width value.bits) + rewindDone.input rewindDone.work rewindDone.output + hrewindSourceString.hasBinarySuffix + (by rw [hrewindInput, hwidthInput]; exact hinput) + (fun i hi => hrewindWorkParked i) hrewindOutputPrefix + obtain ⟨payloadDone, payloadTime, hpayloadTime, hpayloadReach, + hpayloadHalt, hpayloadInput, hpayloadSuffix, hpayloadCells, + hpayloadHead, hpayloadFrame, hpayloadOutput⟩ := + hpayloadContract rewindDone.input rewindDone.work rewindDone.output + ⟨rfl, rfl, rfl⟩ + have hpayloadReach' : (workEmitTM idx .payload).reachesIn payloadTime + { state := (workEmitTM idx .payload).qstart + input := TM.transitionInput rewindDone.input + work := fun i => TM.transitionTape (rewindDone.work i) + output := TM.transitionTape rewindDone.output } + payloadDone := by + simpa [hrewindInputTransition, hrewindWorkTransition, + hrewindOutputTransition] using hpayloadReach + have hrestReach := TM.seqTM_reachesIn_of_reachesIn + (TM.rewindWorkTM idx) (workEmitTM idx .payload) + hrewindReach hrewindHalt hpayloadReach' + have hrestReach' : + (TM.seqTM (TM.rewindWorkTM idx) (workEmitTM idx .payload)).reachesIn + (rewindTime + 1 + payloadTime) + { state := + (TM.seqTM (TM.rewindWorkTM idx) + (workEmitTM idx .payload)).qstart + input := TM.transitionInput widthDone.input + work := fun i => TM.transitionTape (widthDone.work i) + output := TM.transitionTape widthDone.output } + (TM.phase2Wrap (TM.rewindWorkTM idx) + (workEmitTM idx .payload) payloadDone) := by + simpa [hwidthInputTransition, hwidthWorkTransition, + hwidthOutputTransition] using hrestReach + have hfullReach := TM.seqTM_reachesIn_of_reachesIn + (workEmitTM idx .width) + (TM.seqTM (TM.rewindWorkTM idx) (workEmitTM idx .payload)) + hwidthReach hwidthHalt hrestReach' + let finalCfg := TM.phase2Wrap (workEmitTM idx .width) + (TM.seqTM (TM.rewindWorkTM idx) (workEmitTM idx .payload)) + (TM.phase2Wrap (TM.rewindWorkTM idx) + (workEmitTM idx .payload) payloadDone) + refine ⟨finalCfg, + widthTime + 1 + (rewindTime + 1 + payloadTime), ?_, ?_, ?_, ?_⟩ + · unfold wordEncodeTime workEmitTime at * + omega + · exact hfullReach + · change + (TM.seqTM (workEmitTM idx .width) + (TM.seqTM (TM.rewindWorkTM idx) + (workEmitTM idx .payload))).halted finalCfg + rw [TM.phase2Wrap_halted_iff, TM.phase2Wrap_halted_iff] + exact hpayloadHalt + · refine ⟨?_, hpayloadSuffix, ?_, ?_, ?_, ?_⟩ + · simpa [finalCfg] using + hpayloadInput.trans (hrewindInput.trans hwidthInput) + · have hcanonical := + Tape.eq_init_move_right_of_hasBinaryString hvalue.2 hvalue.1 + change (payloadDone.work idx).cells = (work₀ idx).cells + rw [hpayloadCells, hrewindTarget] + exact congrArg Tape.cells hcanonical.symm + · have hrewindHead : (rewindDone.work idx).head = 1 := by + rw [hrewindTarget] + simp [Tape.move] + simpa [finalCfg, hrewindHead, Nat.add_comm] using hpayloadHead + · intro i hi + simpa [finalCfg] using + (hpayloadFrame i hi).trans + ((hrewindFrame i hi).trans (hwidthFrame i hi)) + · simpa [finalCfg, WordCode.encode, workEmitBits, bitlen, + Nat.toBitsLE_size, Nat.size_eq_bits_len, List.append_assoc] using + hpayloadOutput + +theorem rewindWordEncodeTM_hoareTime_frame_internal + (idx : Fin n) (value headBound : ℕ) (emitted : List Bool) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hcontent : (work₀ idx).HasBinaryContent value.bits) + (hstart : (work₀ idx).cells 0 = Γ.start) + (hhead : 1 ≤ (work₀ idx).head ∧ (work₀ idx).head ≤ headBound) + (hinput : TM.Parked inp₀) + (hother : ∀ i, i ≠ idx → TM.Parked (work₀ i)) + (houtput : out₀.HasBinaryPrefix emitted) : + (rewindWordEncodeTM idx).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + (work idx).HasBinarySuffix [] ∧ + (work idx).cells = (work₀ idx).cells ∧ + (work idx).head = value.bits.length + 1 ∧ + (∀ i, i ≠ idx → work i = work₀ i) ∧ + out.HasBinaryPrefix (emitted ++ WordCode.encode value)) + (rewindWordEncodeTime value headBound) := by + intro inp work out hpre + rcases hpre with ⟨hinp, hwork, hout⟩ + subst inp + subst work + subst out + have hrewindContract := TM.rewindBinaryWorkTM_hoareTime_frame idx + value.bits headBound inp₀ work₀ out₀ hcontent hstart hhead hinput + hother (parked_of_binaryPrefix houtput) + obtain ⟨rewindDone, rewindTime, hrewindTime, hrewindReach, + hrewindHalt, hrewindInput, hrewindTarget, hrewindFrame, + hrewindOutput⟩ := + hrewindContract inp₀ work₀ out₀ ⟨rfl, rfl, rfl⟩ + have hrewindString : + (rewindDone.work idx).HasBinaryString value.bits := by + rw [hrewindTarget] + exact Tape.init_move_right_hasBinaryString value.bits + have hrewindWorkParked : ∀ i, TM.Parked (rewindDone.work i) := by + intro i + by_cases hi : i = idx + · subst i + exact ⟨by rw [hrewindString.1], + hrewindString.hasBinaryContent.cells_ne_start⟩ + · rw [hrewindFrame i hi] + exact hother i hi + have hrewindOutputPrefix : rewindDone.output.HasBinaryPrefix emitted := by + rw [hrewindOutput] + exact houtput + have hrewindInputParked : TM.Parked rewindDone.input := by + rw [hrewindInput] + exact hinput + obtain ⟨hinputTransition, hworkTransition, houtputTransition⟩ := + TM.phaseTransition_eq_self_of_reads_ne_start + hrewindInputParked.read_ne_start + (fun i => (hrewindWorkParked i).read_ne_start) + (parked_of_binaryPrefix hrewindOutputPrefix).read_ne_start + have hencodeContract := wordEncodeTM_hoareTime_frame_internal idx value emitted + rewindDone.input rewindDone.work rewindDone.output + ⟨by rw [hrewindTarget]; simp [Tape.init, Tape.move], hrewindString⟩ + (by rw [hrewindInput]; exact hinput) + (fun i _ => hrewindWorkParked i) hrewindOutputPrefix + obtain ⟨encodeDone, encodeTime, hencodeTime, hencodeReach, + hencodeHalt, hencodeInput, hencodeSuffix, hencodeCells, + hencodeHead, hencodeFrame, hencodeOutput⟩ := + hencodeContract rewindDone.input rewindDone.work rewindDone.output + ⟨rfl, rfl, rfl⟩ + have hencodeReach' : (wordEncodeTM idx).reachesIn encodeTime + { state := (wordEncodeTM idx).qstart + input := TM.transitionInput rewindDone.input + work := fun i => TM.transitionTape (rewindDone.work i) + output := TM.transitionTape rewindDone.output } + encodeDone := by + simpa [hinputTransition, hworkTransition, houtputTransition] using + hencodeReach + have hreach := TM.seqTM_reachesIn_of_reachesIn + (TM.rewindWorkTM idx) (wordEncodeTM idx) + hrewindReach hrewindHalt hencodeReach' + let finalCfg := TM.phase2Wrap (TM.rewindWorkTM idx) + (wordEncodeTM idx) encodeDone + refine ⟨finalCfg, rewindTime + 1 + encodeTime, ?_, hreach, ?_, ?_⟩ + · unfold rewindWordEncodeTime + omega + · change (rewindWordEncodeTM idx).halted finalCfg + unfold rewindWordEncodeTM + rw [TM.phase2Wrap_halted_iff] + exact hencodeHalt + · refine ⟨?_, hencodeSuffix, ?_, ?_, ?_, ?_⟩ + · simpa [finalCfg] using hencodeInput.trans hrewindInput + · change (encodeDone.work idx).cells = (work₀ idx).cells + rw [hencodeCells, hrewindTarget] + exact (cells_eq_init_of_binaryContent hcontent hstart).symm + · simpa [finalCfg] using hencodeHead + · intro i hi + change encodeDone.work i = work₀ i + exact (hencodeFrame i hi).trans (hrewindFrame i hi) + · simpa [finalCfg] using hencodeOutput + +end Machine + +end RegisterStore + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig.lean new file mode 100644 index 0000000000..472236fdba --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig.lean @@ -0,0 +1,111 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Internal + +/-! +# Bounded Turing-machine configurations in RAM registers + +This module exposes the first representation layer of the Turing-machine to RAM +simulation. The register layout is explicit, blank cells use value zero, and +`decode_encode` states the exact condition under which bounded decoding loses no +information. +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace TMConfig + +/-- The state field is register zero. -/ +@[simp] theorem fieldReg_state : + fieldReg (stateField (n := n) (bound := bound)) = 0 := + fieldReg_state_internal + +/-- Head registers immediately follow the state, in input/work/output order. -/ +@[simp] theorem fieldReg_head (tape : Fin (n + 2)) : + fieldReg (headField (bound := bound) tape) = 1 + tape.val := + fieldReg_head_internal tape + +/-- Cell blocks follow all head registers, ordered by tape and position. -/ +@[simp] theorem fieldReg_cell (tape : Fin (n + 2)) + (position : Fin (bound + 1)) : + fieldReg (cellField tape position) = + 1 + (n + 2) + tape.val * (bound + 1) + position.val := + fieldReg_cell_internal tape position + +/-- Symbol coding is lossless on the four-symbol tape alphabet. -/ +theorem symbolDecode_code (symbol : Γ) : + symbolDecode (symbolCode symbol) = symbol := + symbolDecode_code_internal symbol + +/-- Canonical finite-state coding is lossless. -/ +theorem stateDecode_code (tm : TM n) (state : tm.Q) : + stateDecode tm (stateCode tm state) = state := + stateDecode_code_internal tm state + +/-- Reading an encoded field returns exactly that field's value. -/ +theorem encodeRegs_field (tm : TM n) (bound : ℕ) + (cfg : Complexity.Cfg n tm.Q) (field : Field n bound) : + encodeRegs tm bound cfg (fieldReg field) = fieldValue tm bound cfg field := + encodeRegs_field_internal tm bound cfg field + +/-- Every field address lies inside the explicit configuration prefix. -/ +theorem fieldReg_lt (field : Field n bound) : + fieldReg field < registerCount n bound := + fieldReg_lt_internal field + +/-- Distinct configuration fields occupy distinct registers. -/ +theorem fieldReg_injective : Function.Injective (@fieldReg n bound) := + fieldReg_injective_internal + +/-- Updating a scratch register beyond the configuration prefix preserves every +represented field. -/ +theorem Represents.update_outside {tm : TM n} {bound reg value : ℕ} + {cfg : Complexity.Cfg n tm.Q} {regs : ℕ → ℕ} + (hrepresents : Represents tm bound cfg regs) + (hreg : registerCount n bound ≤ reg) : + Represents tm bound cfg (Function.update regs reg value) := + hrepresents.update_outside_internal hreg + +/-- The canonical bounded encoding represents every one of its fields. -/ +theorem encodeRegs_represents (tm : TM n) (bound : ℕ) + (cfg : Complexity.Cfg n tm.Q) : + Represents tm bound cfg (encodeRegs tm bound cfg) := + encodeRegs_represents_internal tm bound cfg + +/-- Any representing store decodes to its configuration when the omitted tape +suffixes are blank. Scratch registers do not affect decoding. -/ +theorem decode_of_represents (tm : TM n) (bound : ℕ) + (cfg : Complexity.Cfg n tm.Q) (regs : ℕ → ℕ) + (hrepresents : Represents tm bound cfg regs) + (hbounded : Bounded cfg bound) : decode tm bound regs = cfg := + decode_of_represents_internal tm bound cfg regs hrepresents hbounded + +/-- Decoding an encoded bounded configuration recovers it exactly. -/ +theorem decode_encode (tm : TM n) (bound : ℕ) + (cfg : Complexity.Cfg n tm.Q) (hbounded : Bounded cfg bound) : + decode tm bound (encode tm bound cfg).regs = cfg := + decode_encode_internal tm bound cfg hbounded + +/-- Registers beyond the explicit bounded layout are zero. -/ +theorem encodeRegs_outside (tm : TM n) (bound : ℕ) + (cfg : Complexity.Cfg n tm.Q) {reg : ℕ} + (hreg : registerCount n bound ≤ reg) : + encodeRegs tm bound cfg reg = 0 := + encodeRegs_outside_internal tm bound cfg hreg + +end TMConfig + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Defs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Defs.lean new file mode 100644 index 0000000000..c3fa5cb179 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Defs.lean @@ -0,0 +1,162 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Defs +public import Mathlib.Logic.Equiv.Fin.Basic + +/-! +# Bounded Turing-machine configurations in RAM registers + +This file fixes the register representation used by the Turing-machine to RAM +simulation. Register zero stores the finite-state code, the next `n + 2` +registers store the input/work/output head positions, and the remaining +registers store a dense bounded window of every named tape. + +Blank symbols use code zero. Consequently registers outside the representation +and blank cells inside it agree with the RAM's finite-support convention. +-/ + + +@[expose] public section + +namespace Complexity + +namespace RAM + +namespace TMConfig + +/-- A field in a bounded configuration: state, a named tape head, or a named +tape cell. Named tapes use input/work/output indices `0, 1..n, n+1`. -/ +abbrev Field (n bound : ℕ) := + Fin 1 ⊕ (Fin (n + 2) ⊕ (Fin (n + 2) × Fin (bound + 1))) + +/-- Number of registers occupied by a configuration with cells `0..bound`. -/ +def registerCount (n bound : ℕ) : ℕ := + 1 + ((n + 2) + (n + 2) * (bound + 1)) + +/-- Explicit contiguous ordering of all fields in the bounded representation. -/ +noncomputable def fieldEquiv (n bound : ℕ) : + Field n bound ≃ Fin (registerCount n bound) := + (Equiv.sumCongr (Equiv.refl (Fin 1)) + ((Equiv.sumCongr (Equiv.refl (Fin (n + 2))) finProdFinEquiv).trans + finSumFinEquiv)).trans + finSumFinEquiv + +/-- The field holding the Turing-machine state. -/ +def stateField : Field n bound := Sum.inl ⟨0, by omega⟩ + +/-- The field holding one named tape's head position. -/ +def headField (tape : Fin (n + 2)) : Field n bound := + Sum.inr (Sum.inl tape) + +/-- The field holding one cell of one named tape. -/ +def cellField (tape : Fin (n + 2)) (position : Fin (bound + 1)) : + Field n bound := + Sum.inr (Sum.inr (tape, position)) + +/-- Concrete register address of a bounded-configuration field. -/ +noncomputable def fieldReg (field : Field n bound) : ℕ := + (fieldEquiv n bound field).val + +/-- Code the tape alphabet with blank represented by zero. -/ +def symbolCode : Γ → ℕ + | .blank => 0 + | .zero => 1 + | .one => 2 + | .start => 3 + +/-- Decode a RAM word as a tape symbol; invalid words decode to blank. -/ +def symbolDecode : ℕ → Γ + | 1 => .zero + | 2 => .one + | 3 => .start + | _ => .blank + +/-- Canonical numeric code of a finite Turing-machine state. -/ +noncomputable def stateCode (tm : TM n) (state : tm.Q) : ℕ := + (Fintype.equivFin tm.Q state).val + +/-- Decode a valid state code, using the start state as the default for an +invalid RAM word. -/ +noncomputable def stateDecode (tm : TM n) (code : ℕ) : tm.Q := + if h : code < Fintype.card tm.Q then + (Fintype.equivFin tm.Q).symm ⟨code, h⟩ + else tm.qstart + +/-- Select a named tape by its input/work/output index. -/ +def tapeAt (cfg : Complexity.Cfg n Q) (tape : Fin (n + 2)) : Tape := + if hinput : tape.val = 0 then cfg.input + else if houtput : tape.val = n + 1 then cfg.output + else cfg.work ⟨tape.val - 1, by omega⟩ + +/-- A tape is contained in the encoded window when every later cell is blank. -/ +def TapeBounded (tape : Tape) (bound : ℕ) : Prop := + ∀ position, bound < position → tape.cells position = Γ.blank + +/-- Every named tape in a configuration is contained in the encoded window. -/ +def Bounded (cfg : Complexity.Cfg n Q) (bound : ℕ) : Prop := + ∀ tape, TapeBounded (tapeAt cfg tape) bound + +/-- Every named head lies inside the encoded cell window. -/ +def HeadsBounded (cfg : Complexity.Cfg n Q) (bound : ℕ) : Prop := + ∀ tape, (tapeAt cfg tape).head ≤ bound + +/-- A configuration can be stepped inside a bounded representation when both +its nonblank cells and every named head lie in the represented window. -/ +def WithinWindow (cfg : Complexity.Cfg n Q) (bound : ℕ) : Prop := + Bounded cfg bound ∧ HeadsBounded cfg bound + +/-- Natural-number value stored for one representation field. -/ +noncomputable def fieldValue (tm : TM n) (bound : ℕ) + (cfg : Complexity.Cfg n tm.Q) : Field n bound → ℕ + | Sum.inl _ => stateCode tm cfg.state + | Sum.inr (Sum.inl tape) => (tapeAt cfg tape).head + | Sum.inr (Sum.inr (tape, position)) => + symbolCode ((tapeAt cfg tape).cells position.val) + +/-- Register store containing a bounded Turing-machine configuration. -/ +noncomputable def encodeRegs (tm : TM n) (bound : ℕ) + (cfg : Complexity.Cfg n tm.Q) : ℕ → ℕ := + fun reg => + if h : reg < registerCount n bound then + fieldValue tm bound cfg ((fieldEquiv n bound).symm ⟨reg, h⟩) + else 0 + +/-- A RAM store represents a bounded TM configuration when every state/head/cell +field has its prescribed value. Scratch registers outside this interface are +deliberately unconstrained, allowing successive simulation blocks to compose. -/ +def Represents (tm : TM n) (bound : ℕ) (cfg : Complexity.Cfg n tm.Q) + (regs : ℕ → ℕ) : Prop := + ∀ field, regs (fieldReg field) = fieldValue tm bound cfg field + +/-- RAM configuration positioned at the beginning of a simulation block. -/ +noncomputable def encode (tm : TM n) (bound : ℕ) + (cfg : Complexity.Cfg n tm.Q) : RAM.Cfg := + { pc := 0, regs := encodeRegs tm bound cfg } + +/-- Decode one tape from its head register and bounded cell block. -/ +noncomputable def decodeTape (bound : ℕ) (regs : ℕ → ℕ) + (tape : Fin (n + 2)) : Tape where + head := regs (fieldReg (headField (bound := bound) tape)) + cells := fun position => + if h : position < bound + 1 then + symbolDecode (regs (fieldReg (cellField tape ⟨position, h⟩))) + else Γ.blank + +/-- Decode a bounded register layout into a Turing-machine configuration. -/ +noncomputable def decode (tm : TM n) (bound : ℕ) (regs : ℕ → ℕ) : + Complexity.Cfg n tm.Q where + state := stateDecode tm (regs (fieldReg (stateField (n := n) (bound := bound)))) + input := decodeTape (n := n) bound regs ⟨0, by omega⟩ + work := fun i => decodeTape (n := n) bound regs ⟨i.val + 1, by omega⟩ + output := decodeTape (n := n) bound regs ⟨n + 1, by omega⟩ + +end TMConfig + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Internal.lean new file mode 100644 index 0000000000..b1e6b83259 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Internal.lean @@ -0,0 +1,153 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Defs + +/-! +# Bounded Turing-machine configuration encoding -- proof internals +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace TMConfig + +theorem fieldReg_state_internal : + fieldReg (stateField (n := n) (bound := bound)) = 0 := by + rfl + +theorem fieldReg_head_internal (tape : Fin (n + 2)) : + fieldReg (headField (bound := bound) tape) = 1 + tape.val := by + rfl + +theorem fieldReg_cell_internal (tape : Fin (n + 2)) + (position : Fin (bound + 1)) : + fieldReg (cellField tape position) = + 1 + (n + 2) + tape.val * (bound + 1) + position.val := by + simp [fieldReg, cellField, fieldEquiv, finProdFinEquiv, Nat.mul_comm] + simp [finSumFinEquiv] + change 1 + (n + 2 + (position.val + tape.val * (bound + 1))) = _ + omega + +theorem symbolDecode_code_internal (symbol : Γ) : + symbolDecode (symbolCode symbol) = symbol := by + cases symbol <;> rfl + +theorem stateDecode_code_internal (tm : TM n) (state : tm.Q) : + stateDecode tm (stateCode tm state) = state := by + simp [stateDecode, stateCode] + +theorem tapeAt_input_internal (cfg : Complexity.Cfg n Q) : + tapeAt cfg ⟨0, by omega⟩ = cfg.input := by + simp [tapeAt] + +theorem tapeAt_work_internal (cfg : Complexity.Cfg n Q) (i : Fin n) : + tapeAt cfg ⟨i.val + 1, by omega⟩ = cfg.work i := by + simp only [tapeAt] + rw [dif_neg (by omega), dif_neg (by omega)] + congr 1 + +theorem tapeAt_output_internal (cfg : Complexity.Cfg n Q) : + tapeAt cfg ⟨n + 1, by omega⟩ = cfg.output := by + simp [tapeAt] + +theorem encodeRegs_field_internal (tm : TM n) (bound : ℕ) + (cfg : Complexity.Cfg n tm.Q) (field : Field n bound) : + encodeRegs tm bound cfg (fieldReg field) = fieldValue tm bound cfg field := by + have hreg : fieldReg field < registerCount n bound := + (fieldEquiv n bound field).isLt + unfold encodeRegs + rw [dif_pos hreg] + have hfield : + (⟨fieldReg field, hreg⟩ : Fin (registerCount n bound)) = + fieldEquiv n bound field := by + apply Fin.ext + rfl + rw [hfield, Equiv.symm_apply_apply] + +theorem fieldReg_lt_internal (field : Field n bound) : + fieldReg field < registerCount n bound := + (fieldEquiv n bound field).isLt + +theorem fieldReg_injective_internal : + Function.Injective (@fieldReg n bound) := by + intro first second heq + apply (fieldEquiv n bound).injective + exact Fin.ext heq + +theorem Represents.update_outside_internal {tm : TM n} {bound reg value : ℕ} + {cfg : Complexity.Cfg n tm.Q} {regs : ℕ → ℕ} + (hrepresents : Represents tm bound cfg regs) + (hreg : registerCount n bound ≤ reg) : + Represents tm bound cfg (Function.update regs reg value) := by + intro field + rw [Function.update_of_ne] + · exact hrepresents field + · exact fun heq => (not_lt_of_ge hreg) (heq ▸ fieldReg_lt_internal field) + +theorem encodeRegs_represents_internal (tm : TM n) (bound : ℕ) + (cfg : Complexity.Cfg n tm.Q) : + Represents tm bound cfg (encodeRegs tm bound cfg) := + encodeRegs_field_internal tm bound cfg + +private theorem decodeTape_of_represents (tm : TM n) (bound : ℕ) + (cfg : Complexity.Cfg n tm.Q) (regs : ℕ → ℕ) + (hrepresents : Represents tm bound cfg regs) + (hbounded : Bounded cfg bound) (tape : Fin (n + 2)) : + decodeTape bound regs tape = tapeAt cfg tape := by + apply Tape.ext + · simp only [decodeTape] + rw [hrepresents (headField (bound := bound) tape)] + rfl + · funext position + by_cases hposition : position < bound + 1 + · simp only [decodeTape, hposition, dif_pos] + rw [hrepresents (cellField tape ⟨position, hposition⟩)] + exact symbolDecode_code_internal _ + · simp only [decodeTape, hposition] + exact (hbounded tape position (by omega)).symm + +theorem decode_of_represents_internal (tm : TM n) (bound : ℕ) + (cfg : Complexity.Cfg n tm.Q) (regs : ℕ → ℕ) + (hrepresents : Represents tm bound cfg regs) + (hbounded : Bounded cfg bound) : decode tm bound regs = cfg := by + apply Complexity.Cfg.ext + · simp only [decode] + rw [hrepresents (stateField (n := n) (bound := bound))] + exact stateDecode_code_internal tm cfg.state + · simpa [decode, tapeAt_input_internal] using + decodeTape_of_represents tm bound cfg regs hrepresents hbounded + ⟨0, by omega⟩ + · funext i + simpa [decode, tapeAt_work_internal] using + decodeTape_of_represents tm bound cfg regs hrepresents hbounded + ⟨i.val + 1, by omega⟩ + · simpa [decode, tapeAt_output_internal] using + decodeTape_of_represents tm bound cfg regs hrepresents hbounded + ⟨n + 1, by omega⟩ + +theorem decode_encode_internal (tm : TM n) (bound : ℕ) + (cfg : Complexity.Cfg n tm.Q) (hbounded : Bounded cfg bound) : + decode tm bound (encode tm bound cfg).regs = cfg := by + exact decode_of_represents_internal tm bound cfg (encode tm bound cfg).regs + (encodeRegs_represents_internal tm bound cfg) hbounded + +theorem encodeRegs_outside_internal (tm : TM n) (bound : ℕ) + (cfg : Complexity.Cfg n tm.Q) {reg : ℕ} + (hreg : registerCount n bound ≤ reg) : + encodeRegs tm bound cfg reg = 0 := by + simp [encodeRegs, Nat.not_lt.mpr hreg] + +end TMConfig + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse.lean new file mode 100644 index 0000000000..6d9da0e681 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse.lean @@ -0,0 +1,58 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.Internal + +/-! +# Sparse unbounded TM configurations in RAM registers + +This is the fixed-layout representation used for the uniform TM-to-RAM +simulation. Unlike the bounded dense layout, its addresses do not depend on an +input length or running-time bound. +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace TMConfig + +namespace Sparse + + +/-- Distinct sparse fields occupy distinct RAM registers. -/ +theorem fieldReg_injective : Function.Injective (@fieldReg n) := + fieldReg_injective_internal + +/-- The canonical sparse encoding represents every state, head, and cell. -/ +theorem encodeRegs_represents (tm : TM n) (cfg : Complexity.Cfg n tm.Q) : + Represents tm cfg (encodeRegs tm cfg) := + encodeRegs_represents_internal tm cfg + +/-- Any representing sparse store decodes to its complete configuration; no +external cell-window premise is needed. -/ +theorem decode_of_represents (tm : TM n) (cfg : Complexity.Cfg n tm.Q) + (store : Structured.Store) (hrepresents : Represents tm cfg store) : + decode tm store = cfg := + decode_of_represents_internal tm cfg store hrepresents + +/-- Sparse encoding followed by decoding is exact for every configuration. -/ +theorem decode_encode (tm : TM n) (cfg : Complexity.Cfg n tm.Q) : + decode tm (encodeRegs tm cfg) = cfg := + decode_encode_internal tm cfg + +end Sparse + +end TMConfig + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/ABI.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/ABI.lean new file mode 100644 index 0000000000..a27cbd2075 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/ABI.lean @@ -0,0 +1,108 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.ABI.Defs +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.ABI.Internal.Resources + +/-! +# Public RAM ABI for the fixed sparse TM simulator + +The public RAM convention stores the input length in `R₀` and its raw bits in +`R₁, …, Rₙ`. The fixed marshaller relocates that unbounded prefix into the +sparse TM layout without assuming a length bound, despite its scratch registers +potentially overlapping the raw input. The complete decision program then runs +the fixed sparse simulator to a halted TM configuration and returns a public +Boolean verdict in `R₀`. +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace TMConfig + +namespace Sparse + + +/-- The fixed marshaller converts the public RAM input store into a complete +sparse representation of the TM's initial configuration. -/ +theorem marshalInput_correct (tm : TM n) (x : List Bool) : + ∃ final steps cost space, + Structured.Exec (marshalInput tm) (initRegs x) final steps cost space ∧ + Represents tm (tm.initCfg x) final := + marshalInput_exec_internal tm x + +/-- The complete fixed source program follows any exact halting TM run and +returns its output bit using the public RAM verdict convention `0/1`. -/ +theorem decisionProgram_correct {tm : TM n} {steps : ℕ} + {x : List Bool} {halted : Complexity.Cfg n tm.Q} + (hreach : tm.reachesIn steps (tm.initCfg x) halted) + (hhalted : tm.halted halted) : + ∃ final sourceSteps cost space, + Structured.Exec (decisionProgram tm) (initRegs x) final + sourceSteps cost space ∧ + final stateReg = symbolCode (halted.output.cells 1) - 1 := + decisionProgram_exec_internal hreach hhalted + +/-- Exact concrete-RAM transfer for the complete public-ABI simulator. Source +and target agree on final registers, logarithmic cost, and peak space. -/ +theorem compiledDecision_correct {tm : TM n} {steps : ℕ} + {x : List Bool} {halted : Complexity.Cfg n tm.Q} + (hreach : tm.reachesIn steps (tm.initCfg x) halted) + (hhalted : tm.halted halted) : + ∃ final sourceSteps cost space, + Structured.Exec (decisionProgram tm) (initRegs x) final + sourceSteps cost space ∧ + run (compiledDecision tm) sourceSteps (initCfg x) = + { pc := (decisionProgram tm).codeSize, regs := final } ∧ + Halted (compiledDecision tm) + (run (compiledDecision tm) sourceSteps (initCfg x)) ∧ + logTimeUpto (compiledDecision tm) sourceSteps (initCfg x) = cost ∧ + spaceUpto (compiledDecision tm) sourceSteps (initCfg x) = space ∧ + final stateReg = symbolCode (halted.output.cells 1) - 1 := + compiledDecision_exec_internal hreach hhalted + +/-- Concrete end-to-end resource transfer from the public RAM input ABI. The +program depends only on `tm`; a `steps`-step halting TM run determines bounded +RAM fuel, logarithmic cost, sparse-store space, and the same verdict. -/ +theorem compiledDecision_resourceBound {tm : TM n} {steps : ℕ} + {x : List Bool} {halted : Complexity.Cfg n tm.Q} + (hreach : tm.reachesIn steps (tm.initCfg x) halted) + (hhalted : tm.halted halted) : + ∃ final sourceSteps cost space, + Structured.Exec (decisionProgram tm) (initRegs x) final + sourceSteps cost space ∧ + cost ≤ decisionTimeBound tm x.length steps ∧ + space ≤ spaceBound tm (marshalBound n x.length + steps) ∧ + run (compiledDecision tm) sourceSteps (initCfg x) = + { pc := (decisionProgram tm).codeSize, regs := final } ∧ + Halted (compiledDecision tm) + (run (compiledDecision tm) sourceSteps (initCfg x)) ∧ + logTimeUpto (compiledDecision tm) sourceSteps (initCfg x) = cost ∧ + spaceUpto (compiledDecision tm) sourceSteps (initCfg x) = space ∧ + final stateReg = symbolCode (halted.output.cells 1) - 1 := + compiledDecision_resourceBound_internal hreach hhalted + +/-- Increasing the simulated TM step budget only increases the advertised +end-to-end public-ABI cost bound. -/ +theorem decisionTimeBound_mono_steps (tm : TM n) (inputLength : ℕ) + {steps larger : ℕ} (hle : steps ≤ larger) : + decisionTimeBound tm inputLength steps ≤ + decisionTimeBound tm inputLength larger := + decisionTimeBound_mono_steps_internal tm inputLength hle + +end Sparse + +end TMConfig + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/ABI/Defs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/ABI/Defs.lean new file mode 100644 index 0000000000..175130f67f --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/ABI/Defs.lean @@ -0,0 +1,215 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.Step.Defs + +/-! +# Public RAM input/output ABI for the sparse TM simulator + +The public RAM input occupies the unbounded prefix `R₁, …, Rₙ`, so no fixed +scratch register is initially disjoint from every input. The marshaller first +captures the six registers it must clobber in finite control flow. Each leaf +then copies the raw input backward into the sparse input tape while clearing the +old prefix, repairs those six statically remembered bits, and initializes the +state, heads, and left-end markers. +-/ + + +@[expose] public section + +namespace Complexity + +namespace RAM + +namespace TMConfig + +namespace Sparse + + +/-- Fixed registers clobbered before the backward input-copy loop reaches them. -/ +def captureRegs (n : ℕ) : List ℕ := + [zeroReg n, oneReg n, tapeCountReg n, stateScratchReg n, + addressReg n, valueReg n] + +/-- Constants needed by each backward-copy iteration. They are restored inside +the loop because clearing the raw prefix eventually visits these registers. -/ +def marshalConstants (n : ℕ) : List Structured.Basic := + [.imm (zeroReg n) 0, + .imm (oneReg n) 1, + .imm (tapeCountReg n) (n + 2), + .imm (stateScratchReg n) (cellBase n)] + +/-- Copy and clear the raw input cell selected by the cursor in `R₀`, convert +its public-ABI Boolean code `0/1` to the sparse tape-symbol code `1/2`, write it +to the sparse input-tape address, and decrement the cursor. -/ +def marshalLoopOps (n : ℕ) : List Structured.Basic := + [.add (addressReg n) stateReg (zeroReg n), + .load (valueReg n) (addressReg n), + .store (addressReg n) (zeroReg n), + .imm (zeroReg n) 0, + .imm (oneReg n) 1, + .imm (tapeCountReg n) (n + 2), + .imm (stateScratchReg n) (cellBase n), + .add (valueReg n) (valueReg n) (oneReg n), + .mul (addressReg n) stateReg (tapeCountReg n), + .add (addressReg n) (addressReg n) (stateScratchReg n), + .store (addressReg n) (valueReg n), + .sub stateReg stateReg (oneReg n)] + +/-- Backward raw-input copy. -/ +def marshalLoop (n : ℕ) : Structured.Cmd := + .whileNonzero stateReg (.basics (marshalLoopOps n)) + +/-- Exact source/compiled instruction count of the backward-copy loop. -/ +def marshalLoopSteps (n inputLength : ℕ) : ℕ := + inputLength * ((marshalLoopOps n).length + 2) + 1 + +/-- Initial numeric allowance for public-input marshalling. It contains every +raw input register and every sparse destination address used by the copy. -/ +def marshalBaseBound (n inputLength : ℕ) : ℕ := + registerBound n (inputLength + 1) + +/-- Common sparse position/resource bound used after marshalling. The additive +input-length slack absorbs the one-unit value growth of every loop body. -/ +def marshalBound (n inputLength : ℕ) : ℕ := + marshalBaseBound n inputLength + inputLength + +/-- Logarithmic-cost width used by the public-input marshaller. -/ +def marshalWidth (n inputLength : ℕ) : ℕ := + bitlen (marshalBound n inputLength) + 1 + +/-- Width of the smaller envelope used before the copy loop starts. -/ +def marshalBaseWidth (n inputLength : ℕ) : ℕ := + bitlen (marshalBaseBound n inputLength) + 1 + +/-- Sparse-store space envelope used throughout public-input marshalling. -/ +def marshalSpaceBound (n inputLength : ℕ) : ℕ := + registerBound n (marshalBound n inputLength + 1) * + (bitlen (registerBound n (marshalBound n inputLength + 1)) + + bitlen (marshalBound n inputLength)) + +/-- Concrete logarithmic-cost bound for the backward-copy loop. -/ +def marshalLoopTimeBound (n inputLength : ℕ) : ℕ := + (inputLength * (3 + 4 * (marshalLoopOps n).length) + 1) * + marshalWidth n inputLength + +/-- Restore one input bit remembered in the capture tree, but only when the +copy loop actually visited that position. A visited destination is necessarily +positive because the loop writes `rawBit + 1`; an absent position remains the +initial zero beyond the raw input prefix. -/ +def repairBit (n : ℕ) (captured : ℕ × ℕ) : Structured.Cmd := + .seq + (.basics + [.imm (addressReg n) (cellReg n (inputTape n) captured.1), + .load (valueReg n) (addressReg n)]) + (.ifZero (valueReg n) .skip + (.basics + [.imm (valueReg n) (captured.2 + 1), + .store (addressReg n) (valueReg n)])) + +/-- Restore all visited scratch-position input bits remembered by a +capture-tree leaf. -/ +def repairCaptured (n : ℕ) (captured : List (ℕ × ℕ)) : + Structured.Cmd := + match captured with + | [] => .skip + | entry :: rest => .seq (repairBit n entry) (repairCaptured n rest) + +/-- Values accumulated by the capture tree, in the same reverse order used by +`captureInput`. -/ +def captureValues (store : Structured.Store) : + List ℕ → List (ℕ × ℕ) → List (ℕ × ℕ) + | [], captured => captured + | reg :: rest, captured => + captureValues store rest ((reg, store reg) :: captured) + +/-- Immediate writes that initialize the semantic fields of `tm.initCfg` after +the raw input prefix has been relocated and cleared. -/ +noncomputable def initializeConfigWrites (tm : TM n) : List (ℕ × ℕ) := + [(stateReg, stateCode tm tm.qstart)] ++ + (List.finRange (n + 2)).map (fun tape => (headReg tape, 0)) ++ + (List.finRange (n + 2)).map (fun tape => + (cellReg n tape 0, symbolCode Γ.start)) + +/-- Straight-line realization of the initial-configuration writes. -/ +noncomputable def initializeConfigOps (tm : TM n) : List Structured.Basic := + (initializeConfigWrites tm).map fun write => + .imm write.1 write.2 + +/-- Concrete cost bound for one selected capture-tree leaf. -/ +noncomputable def marshalLeafTimeBound (tm : TM n) (inputLength : ℕ) : ℕ := + 4 * (marshalConstants n).length * marshalBaseWidth n inputLength + + marshalLoopTimeBound n inputLength + + (captureRegs n).length * (27 * wordWidth tm (marshalBound n inputLength)) + + 4 * (initializeConfigOps tm).length * + wordWidth tm (marshalBound n inputLength) + +/-- Concrete cost bound for the full public-input marshaller, including the +fixed capture tree. -/ +noncomputable def marshalTimeBound (tm : TM n) (inputLength : ℕ) : ℕ := + 3 * (captureRegs n).length * wordWidth tm (marshalBound n inputLength) + + marshalLeafTimeBound tm inputLength + +/-- One capture-tree leaf: initialize scratch constants, copy backward, repair +captured positions, and establish the sparse initial configuration. -/ +noncomputable def marshalLeaf (tm : TM n) + (captured : List (ℕ × ℕ)) : Structured.Cmd := + .seq (.basics (marshalConstants n)) + (.seq (marshalLoop n) + (.seq (repairCaptured n captured) + (.basics (initializeConfigOps tm)))) + +/-- Capture the initial Boolean contents of a finite register list in control +flow. The zero/nonzero branches record canonical numeric values `0` and `1`. -/ +noncomputable def captureInput (tm : TM n) : + List ℕ → List (ℕ × ℕ) → Structured.Cmd + | [], captured => marshalLeaf tm captured + | reg :: rest, captured => + .ifZero reg + (captureInput tm rest ((reg, 0) :: captured)) + (captureInput tm rest ((reg, 1) :: captured)) + +/-- Fixed public-ABI marshaller for `tm`. -/ +noncomputable def marshalInput (tm : TM n) : Structured.Cmd := + captureInput tm (captureRegs n) [] + +/-- Copy the halted TM output symbol at cell one into public verdict register +`R₀` and shift the sparse symbol codes `1/2` back to public verdicts `0/1`. +This intentionally destroys the final sparse state code. -/ +def extractVerdictOps (n : ℕ) : List Structured.Basic := + [.imm (addressReg n) (cellReg n (outputTape n) 1), + .load stateReg (addressReg n), + .imm (oneReg n) 1, + .sub stateReg stateReg (oneReg n)] + +/-- End-to-end logarithmic-cost bound from the public ABI through verdict +extraction for a halting run of the given length. -/ +noncomputable def decisionTimeBound (tm : TM n) + (inputLength steps : ℕ) : ℕ := + marshalTimeBound tm inputLength + + ((steps + 1) * runFactor tm) * + wordWidth tm (marshalBound n inputLength + steps) + + 4 * (extractVerdictOps n).length * + wordWidth tm (marshalBound n inputLength + steps) + +/-- Complete fixed source program from the public RAM input ABI to verdict +register `R₀`. -/ +noncomputable def decisionProgram (tm : TM n) : Structured.Cmd := + .seq (marshalInput tm) + (.seq (runUntilHalt tm) (.basics (extractVerdictOps n))) + +/-- Concrete compiled public-ABI simulator. -/ +noncomputable def compiledDecision (tm : TM n) : Program := + (decisionProgram tm).compile + +end Sparse + +end TMConfig + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/ABI/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/ABI/Internal.lean new file mode 100644 index 0000000000..6c7291a403 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/ABI/Internal.lean @@ -0,0 +1,13 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.ABI.Internal.Capture +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.ABI.Internal.Decision +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.ABI.Internal.Loop +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.ABI.Internal.Marshal +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.ABI.Internal.Resources + +/-! Supporting modules for Beyond the Bethe approximation of the permanent. -/ diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/ABI/Internal/Capture.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/ABI/Internal/Capture.lean new file mode 100644 index 0000000000..77bc7a44e8 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/ABI/Internal/Capture.lean @@ -0,0 +1,101 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.ABI.Defs +import Mathlib.Tactic.NormNum.Inv +import Mathlib.Tactic.NormNum.Pow + +/-! +# Capturing raw-input scratch bits in finite control -- proof internals +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace TMConfig + +namespace Sparse + + +theorem initRegs_bool_of_pos_internal (x : List Bool) {reg : ℕ} + (hpos : 0 < reg) : initRegs x reg = 0 ∨ initRegs x reg = 1 := by + rw [initRegs, if_neg (by omega)] + cases hbit : x[reg - 1]? with + | none => simp + | some bit => + cases bit <;> simp + +theorem captureRegs_positive_internal (n : ℕ) {reg : ℕ} + (hmem : reg ∈ captureRegs n) : 0 < reg := by + simp [captureRegs, zeroReg, oneReg, tapeCountReg, stateScratchReg, + addressReg, valueReg] at hmem + rcases hmem with h | h | h | h | h | h <;> omega + +/-- If the selected leaf executes, the generated capture tree executes that +same leaf without changing the store. Branch costs are left existential here; +the later resource layer assigns their common envelope. -/ +theorem captureInput_exec_of_leaf_internal (tm : TM n) + (store : Structured.Store) (regs : List ℕ) + (captured : List (ℕ × ℕ)) {final : Structured.Store} + (hbits : ∀ reg, reg ∈ regs → store reg = 0 ∨ store reg = 1) + (hleaf : ∃ steps cost space, + Structured.Exec (marshalLeaf tm (captureValues store regs captured)) + store final steps cost space) : + ∃ steps cost space, + Structured.Exec (captureInput tm regs captured) + store final steps cost space := by + induction regs generalizing captured with + | nil => + simpa [captureInput, captureValues] using hleaf + | cons reg rest ih => + have hreg := hbits reg (by simp) + have hrest : ∀ candidate, candidate ∈ rest → + store candidate = 0 ∨ store candidate = 1 := by + intro candidate hmem + exact hbits candidate (by simp [hmem]) + simp only [captureValues] at hleaf + obtain ⟨steps, cost, space, hbranch⟩ := + ih ((reg, store reg) :: captured) hrest hleaf + rcases hreg with hzero | hone + · refine ⟨steps + 1, bitlen (store reg) + 1 + cost, + max store.space space, ?_⟩ + simpa [captureInput, hzero] using + (Structured.Exec.ifZero (onNonzero := + captureInput tm rest ((reg, 1) :: captured)) hzero hbranch) + · have hnonzero : store reg ≠ 0 := by omega + refine ⟨steps + 2, bitlen (store reg) + 1 + cost + 1, + max store.space space, ?_⟩ + simpa [captureInput, hone] using + (Structured.Exec.ifNonzero (onZero := + captureInput tm rest ((reg, 0) :: captured)) hnonzero hbranch) + +/-- Specialization of finite capture to the public RAM input store. -/ +theorem marshalInput_exec_of_leaf_internal (tm : TM n) (x : List Bool) + {final : Structured.Store} + (hleaf : ∃ steps cost space, + Structured.Exec + (marshalLeaf tm (captureValues (initRegs x) (captureRegs n) [])) + (initRegs x) final steps cost space) : + ∃ steps cost space, + Structured.Exec (marshalInput tm) (initRegs x) final steps cost space := by + apply captureInput_exec_of_leaf_internal tm (initRegs x) (captureRegs n) [] + · intro reg hmem + exact initRegs_bool_of_pos_internal x + (captureRegs_positive_internal n hmem) + · exact hleaf + +end Sparse + +end TMConfig + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/ABI/Internal/Decision.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/ABI/Internal/Decision.lean new file mode 100644 index 0000000000..543205737e --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/ABI/Internal/Decision.lean @@ -0,0 +1,137 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.ABI.Internal.Marshal +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.Step.Internal.Iteration +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured + +/-! +# End-to-end public-ABI sparse simulation -- proof internals +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace TMConfig + +namespace Sparse + + +/-- The verdict extractor copies the represented halted output cell one into +the public verdict register. -/ +theorem extractVerdict_exec_internal {tm : TM n} + {halted : Complexity.Cfg n tm.Q} {store : Structured.Store} + (hrepresents : Represents tm halted store) : + let final := Structured.Basic.execList (extractVerdictOps n) store + ∃ cost space, + Structured.Exec (.basics (extractVerdictOps n)) store final + (extractVerdictOps n).length cost space ∧ + final stateReg = symbolCode (halted.output.cells 1) - 1 := by + let final := Structured.Basic.execList (extractVerdictOps n) store + obtain ⟨cost, space, hexec⟩ := + Structured.Internal.exec_basics_exists (extractVerdictOps n) store + have hcell : store (cellReg n (outputTape n) 1) = + symbolCode (halted.output.cells 1) := by + have hfield := hrepresents + (Sum.inr (Sum.inr (outputTape n, 1))) + simpa [fieldReg, fieldValue, tapeAt, outputTape] using hfield + refine ⟨cost, space, hexec, ?_⟩ + let addressed := + (Structured.Basic.imm (addressReg n) + (cellReg n (outputTape n) 1)).exec store + have haddress : addressed (addressReg n) = + cellReg n (outputTape n) 1 := by + simp [addressed, Structured.Basic.exec] + have hsource : addressed (cellReg n (outputTape n) 1) = + store (cellReg n (outputTape n) 1) := by + simp only [addressed, Structured.Basic.exec] + rw [Function.update_of_ne] + simp [cellReg, outputTape, cellBase, addressReg] + omega + let loaded := + (Structured.Basic.load stateReg (addressReg n)).exec addressed + let oned := (Structured.Basic.imm (oneReg n) 1).exec loaded + have hloadedState : loaded stateReg = + symbolCode (halted.output.cells 1) := by + simp only [loaded, Structured.Basic.exec, Function.update_self] + rw [haddress, hsource, hcell] + have honedState : oned stateReg = symbolCode (halted.output.cells 1) := by + simp only [oned, Structured.Basic.exec] + rw [Function.update_of_ne (by simp [stateReg, oneReg])] + exact hloadedState + have honedOne : oned (oneReg n) = 1 := by + simp [oned, Structured.Basic.exec] + change (Structured.Basic.sub stateReg stateReg (oneReg n)).exec + oned stateReg = _ + simp [Structured.Basic.exec, honedState, honedOne] + +/-- From the public RAM input store, the complete fixed source program follows +any exact halting TM run and returns the halted output symbol in `R₀`. -/ +theorem decisionProgram_exec_internal {tm : TM n} {steps : ℕ} + {x : List Bool} {halted : Complexity.Cfg n tm.Q} + (hreach : tm.reachesIn steps (tm.initCfg x) halted) + (hhalted : tm.halted halted) : + ∃ final sourceSteps cost space, + Structured.Exec (decisionProgram tm) (initRegs x) final + sourceSteps cost space ∧ + final stateReg = symbolCode (halted.output.cells 1) - 1 := by + obtain ⟨marshaled, marshalSteps, marshalCost, marshalSpace, + hmarshal, hrepresents⟩ := marshalInput_exec_internal tm x + obtain ⟨simulated, simulationCost, simulationSpace, + hsimulation, hhaltedRepresents⟩ := + runUntilHalt_exec_internal hreach hhalted hrepresents + (fun _ => rfl) rfl + let extracted := Structured.Basic.execList (extractVerdictOps n) simulated + obtain ⟨extractCost, extractSpace, hextract, hverdict⟩ := + extractVerdict_exec_internal hhaltedRepresents + have htail := Structured.Exec.seq hsimulation hextract + have hexec := Structured.Exec.seq hmarshal htail + refine ⟨extracted, + marshalSteps + (runSteps tm steps (tm.initCfg x) + + (extractVerdictOps n).length), + marshalCost + (simulationCost + extractCost), + max marshalSpace (max simulationSpace extractSpace), ?_, hverdict⟩ + simpa [decisionProgram, extracted] using hexec + +/-- Exact transfer of the public-ABI decision program to its concrete compiled +RAM, including source/target store agreement, cost, and space. -/ +theorem compiledDecision_exec_internal {tm : TM n} {steps : ℕ} + {x : List Bool} {halted : Complexity.Cfg n tm.Q} + (hreach : tm.reachesIn steps (tm.initCfg x) halted) + (hhalted : tm.halted halted) : + ∃ final sourceSteps cost space, + Structured.Exec (decisionProgram tm) (initRegs x) final + sourceSteps cost space ∧ + run (compiledDecision tm) sourceSteps (initCfg x) = + { pc := (decisionProgram tm).codeSize, regs := final } ∧ + Halted (compiledDecision tm) + (run (compiledDecision tm) sourceSteps (initCfg x)) ∧ + logTimeUpto (compiledDecision tm) sourceSteps (initCfg x) = cost ∧ + spaceUpto (compiledDecision tm) sourceSteps (initCfg x) = space ∧ + final stateReg = symbolCode (halted.output.cells 1) - 1 := by + obtain ⟨final, sourceSteps, cost, space, hexec, hverdict⟩ := + decisionProgram_exec_internal hreach hhalted + have hcompiled := Structured.Exec.compile_correct hexec + refine ⟨final, sourceSteps, cost, space, hexec, ?_, ?_, ?_, ?_, hverdict⟩ + · simpa [compiledDecision, initCfg] using hcompiled.1 + · simpa [compiledDecision, initCfg] using + Structured.Exec.compile_halted hexec + · simpa [compiledDecision, initCfg] using hcompiled.2.1 + · simpa [compiledDecision, initCfg] using hcompiled.2.2 + +end Sparse + +end TMConfig + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/ABI/Internal/Loop.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/ABI/Internal/Loop.lean new file mode 100644 index 0000000000..3e4ad88612 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/ABI/Internal/Loop.lean @@ -0,0 +1,691 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.Internal.Resources +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.ABI.Defs + +/-! +# Backward public-input copy -- proof internals +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace TMConfig + +namespace Sparse + + +/-- The backward-copy body always decrements its cursor and restores all four +loop constants, even when the cursor itself visits one of their registers. -/ +theorem marshalLoopOps_control_internal (n : ℕ) (store : Structured.Store) + (hcursor : 0 < store stateReg) + (hzero : store (zeroReg n) = 0) : + let final := Structured.Basic.execList (marshalLoopOps n) store + final stateReg = store stateReg - 1 ∧ + final (zeroReg n) = 0 ∧ + final (oneReg n) = 1 ∧ + final (tapeCountReg n) = n + 2 ∧ + final (stateScratchReg n) = cellBase n ∧ + 0 < final (cellReg n (inputTape n) (store stateReg)) := by + let sourceAddressed := + (Structured.Basic.add (addressReg n) stateReg (zeroReg n)).exec store + let sourceLoaded := + (Structured.Basic.load (valueReg n) (addressReg n)).exec sourceAddressed + let sourceCleared := + (Structured.Basic.store (addressReg n) (zeroReg n)).exec sourceLoaded + let zeroed := (Structured.Basic.imm (zeroReg n) 0).exec sourceCleared + let oned := (Structured.Basic.imm (oneReg n) 1).exec zeroed + let counted := (Structured.Basic.imm (tapeCountReg n) (n + 2)).exec oned + let based := + (Structured.Basic.imm (stateScratchReg n) (cellBase n)).exec counted + let encoded := + (Structured.Basic.add (valueReg n) (valueReg n) (oneReg n)).exec based + let multiplied := + (Structured.Basic.mul (addressReg n) stateReg (tapeCountReg n)).exec encoded + let destinationAddressed := + (Structured.Basic.add (addressReg n) (addressReg n) + (stateScratchReg n)).exec multiplied + let destinationStored := + (Structured.Basic.store (addressReg n) (valueReg n)).exec + destinationAddressed + let final := + (Structured.Basic.sub stateReg stateReg (oneReg n)).exec destinationStored + have hsourceAddress : sourceAddressed (addressReg n) = store stateReg := by + simp [sourceAddressed, Structured.Basic.exec, hzero] + have hsourceAddressZero : sourceAddressed (zeroReg n) = 0 := by + simp only [sourceAddressed, Structured.Basic.exec] + rw [Function.update_of_ne (by simp [zeroReg, addressReg])] + exact hzero + have hloadedAddress : sourceLoaded (addressReg n) = store stateReg := by + simp only [sourceLoaded, Structured.Basic.exec] + rw [Function.update_of_ne (by simp [addressReg, valueReg])] + exact hsourceAddress + have hloadedZero : sourceLoaded (zeroReg n) = 0 := by + simp only [sourceLoaded, Structured.Basic.exec] + rw [Function.update_of_ne (by simp [zeroReg, valueReg])] + exact hsourceAddressZero + have hloadedState : sourceLoaded stateReg = store stateReg := by + simp only [sourceLoaded, Structured.Basic.exec] + rw [Function.update_of_ne (by simp [stateReg, valueReg])] + simp only [sourceAddressed, Structured.Basic.exec] + rw [Function.update_of_ne (by simp [stateReg, addressReg])] + have hclearedState : sourceCleared stateReg = store stateReg := by + simp only [sourceCleared, Structured.Basic.exec] + have hne : stateReg ≠ sourceLoaded (addressReg n) := by + have hpositive : 0 < sourceLoaded (addressReg n) := by + rw [hloadedAddress] + exact hcursor + simp only [stateReg] + omega + rw [Function.update_of_ne hne] + exact hloadedState + have hbasedState : based stateReg = store stateReg := by + simp only [based, counted, oned, zeroed, Structured.Basic.exec] + rw [Function.update_of_ne (by simp [stateReg, stateScratchReg]), + Function.update_of_ne (by simp [stateReg, tapeCountReg]), + Function.update_of_ne (by simp [stateReg, oneReg]), + Function.update_of_ne (by simp [stateReg, zeroReg])] + exact hclearedState + have hbasedZero : based (zeroReg n) = 0 := by + simp [based, counted, oned, zeroed, Structured.Basic.exec, zeroReg, + oneReg, tapeCountReg, stateScratchReg, Function.update_of_ne] + have hbasedOne : based (oneReg n) = 1 := by + simp [based, counted, oned, Structured.Basic.exec, oneReg, + tapeCountReg, stateScratchReg, Function.update_of_ne] + have hbasedCount : based (tapeCountReg n) = n + 2 := by + simp [based, counted, Structured.Basic.exec, tapeCountReg, + stateScratchReg, Function.update_of_ne] + have hbasedBase : based (stateScratchReg n) = cellBase n := by + simp [based, Structured.Basic.exec] + have hencodedState : encoded stateReg = store stateReg := by + simp only [encoded, Structured.Basic.exec] + rw [Function.update_of_ne (by simp [stateReg, valueReg])] + exact hbasedState + have hencodedZero : encoded (zeroReg n) = 0 := by + simp only [encoded, Structured.Basic.exec] + rw [Function.update_of_ne (by simp [zeroReg, valueReg])] + exact hbasedZero + have hencodedOne : encoded (oneReg n) = 1 := by + simp only [encoded, Structured.Basic.exec] + rw [Function.update_of_ne (by simp [oneReg, valueReg])] + exact hbasedOne + have hencodedCount : encoded (tapeCountReg n) = n + 2 := by + simp only [encoded, Structured.Basic.exec] + rw [Function.update_of_ne (by simp [tapeCountReg, valueReg])] + exact hbasedCount + have hencodedBase : encoded (stateScratchReg n) = cellBase n := by + simp only [encoded, Structured.Basic.exec] + rw [Function.update_of_ne (by simp [stateScratchReg, valueReg])] + exact hbasedBase + have hencodedValue : encoded (valueReg n) = based (valueReg n) + 1 := by + simp [encoded, Structured.Basic.exec, hbasedOne] + have hmultipliedAddress : multiplied (addressReg n) = + store stateReg * (n + 2) := by + simp [multiplied, Structured.Basic.exec, hencodedState, hencodedCount] + have hmultipliedBase : multiplied (stateScratchReg n) = cellBase n := by + simp only [multiplied, Structured.Basic.exec] + rw [Function.update_of_ne (by simp [stateScratchReg, addressReg])] + exact hencodedBase + have hmultipliedValue : multiplied (valueReg n) = + based (valueReg n) + 1 := by + simp only [multiplied, Structured.Basic.exec] + rw [Function.update_of_ne (by simp [valueReg, addressReg])] + exact hencodedValue + have hdestinationAddress : destinationAddressed (addressReg n) = + store stateReg * (n + 2) + cellBase n := by + simp [destinationAddressed, Structured.Basic.exec, hmultipliedAddress, + hmultipliedBase] + have htargetHigh : stateScratchReg n < + store stateReg * (n + 2) + cellBase n := by + simp [stateScratchReg, cellBase] + omega + have hstoredApply (reg : ℕ) + (hreg : reg ≤ stateScratchReg n) : + destinationStored reg = destinationAddressed reg := by + simp only [destinationStored, Structured.Basic.exec] + rw [Function.update_of_ne] + intro heq + rw [hdestinationAddress] at heq + omega + have hmultipliedState : multiplied stateReg = store stateReg := by + simp only [multiplied, Structured.Basic.exec] + rw [Function.update_of_ne (by simp [stateReg, addressReg])] + exact hencodedState + have hmultipliedZero : multiplied (zeroReg n) = 0 := by + simp only [multiplied, Structured.Basic.exec] + rw [Function.update_of_ne (by simp [zeroReg, addressReg])] + exact hencodedZero + have hmultipliedOne : multiplied (oneReg n) = 1 := by + simp only [multiplied, Structured.Basic.exec] + rw [Function.update_of_ne (by simp [oneReg, addressReg])] + exact hencodedOne + have hmultipliedCount : multiplied (tapeCountReg n) = n + 2 := by + simp only [multiplied, Structured.Basic.exec] + rw [Function.update_of_ne (by simp [tapeCountReg, addressReg])] + exact hencodedCount + have haddressedState : destinationAddressed stateReg = store stateReg := by + simp only [destinationAddressed, Structured.Basic.exec] + rw [Function.update_of_ne (by simp [stateReg, addressReg])] + exact hmultipliedState + have haddressedZero : destinationAddressed (zeroReg n) = 0 := by + simp only [destinationAddressed, Structured.Basic.exec] + rw [Function.update_of_ne (by simp [zeroReg, addressReg])] + exact hmultipliedZero + have haddressedOne : destinationAddressed (oneReg n) = 1 := by + simp only [destinationAddressed, Structured.Basic.exec] + rw [Function.update_of_ne (by simp [oneReg, addressReg])] + exact hmultipliedOne + have haddressedCount : destinationAddressed (tapeCountReg n) = n + 2 := by + simp only [destinationAddressed, Structured.Basic.exec] + rw [Function.update_of_ne (by simp [tapeCountReg, addressReg])] + exact hmultipliedCount + have haddressedBase : destinationAddressed (stateScratchReg n) = cellBase n := by + simp only [destinationAddressed, Structured.Basic.exec] + rw [Function.update_of_ne (by simp [stateScratchReg, addressReg])] + exact hmultipliedBase + have haddressedValue : destinationAddressed (valueReg n) = + based (valueReg n) + 1 := by + simp only [destinationAddressed, Structured.Basic.exec] + rw [Function.update_of_ne (by simp [valueReg, addressReg])] + exact hmultipliedValue + have hstoredState : destinationStored stateReg = store stateReg := by + rw [hstoredApply stateReg (by simp [stateReg, stateScratchReg]), + haddressedState] + have hstoredZero : destinationStored (zeroReg n) = 0 := by + rw [hstoredApply (zeroReg n) (by simp [zeroReg, stateScratchReg]), + haddressedZero] + have hstoredOne : destinationStored (oneReg n) = 1 := by + rw [hstoredApply (oneReg n) (by simp [oneReg, stateScratchReg]), + haddressedOne] + have hstoredCount : destinationStored (tapeCountReg n) = n + 2 := by + rw [hstoredApply (tapeCountReg n) (by simp [tapeCountReg, stateScratchReg]), + haddressedCount] + have hstoredBase : destinationStored (stateScratchReg n) = cellBase n := by + rw [hstoredApply (stateScratchReg n) le_rfl, haddressedBase] + have hdestinationAddress' : destinationAddressed (addressReg n) = + cellReg n (inputTape n) (store stateReg) := by + rw [hdestinationAddress] + simp [cellReg, inputTape] + omega + have hstoredDestination : destinationStored + (cellReg n (inputTape n) (store stateReg)) = + based (valueReg n) + 1 := by + simp only [destinationStored, Structured.Basic.exec] + rw [hdestinationAddress', Function.update_self, haddressedValue] + have hfinalState : final stateReg = store stateReg - 1 := by + simp [final, Structured.Basic.exec, hstoredState, hstoredOne] + have hfinalZero : final (zeroReg n) = 0 := by + simp only [final, Structured.Basic.exec] + rw [Function.update_of_ne (by simp [zeroReg, stateReg])] + exact hstoredZero + have hfinalOne : final (oneReg n) = 1 := by + simp only [final, Structured.Basic.exec] + rw [Function.update_of_ne (by simp [oneReg, stateReg])] + exact hstoredOne + have hfinalCount : final (tapeCountReg n) = n + 2 := by + simp only [final, Structured.Basic.exec] + rw [Function.update_of_ne (by simp [tapeCountReg, stateReg])] + exact hstoredCount + have hfinalBase : final (stateScratchReg n) = cellBase n := by + simp only [final, Structured.Basic.exec] + rw [Function.update_of_ne (by simp [stateScratchReg, stateReg])] + exact hstoredBase + have hfinalDestination : 0 < + final (cellReg n (inputTape n) (store stateReg)) := by + simp only [final, Structured.Basic.exec] + rw [Function.update_of_ne] + · rw [hstoredDestination] + omega + · simp [stateReg, cellReg, inputTape, cellBase] + simpa [marshalLoopOps, sourceAddressed, sourceLoaded, sourceCleared, + zeroed, oned, counted, based, encoded, multiplied, destinationAddressed, + destinationStored, final] using + And.intro hfinalState (And.intro hfinalZero + (And.intro hfinalOne + (And.intro hfinalCount (And.intro hfinalBase hfinalDestination)))) + +/-- One backward-copy body has an exact structured execution. -/ +theorem marshalLoopOps_exec_internal (n : ℕ) (store : Structured.Store) : + ∃ cost space, + Structured.Exec (.basics (marshalLoopOps n)) store + (Structured.Basic.execList (marshalLoopOps n) store) + (marshalLoopOps n).length cost space := + Structured.Internal.exec_basics_exists (marshalLoopOps n) store + +/-- Away from the six captured scratch positions, one loop body clears the raw +source cell and writes its Boolean value, shifted to the sparse symbol code, to +the corresponding input cell. This is the relocation induction step. -/ +theorem marshalLoopOps_data_internal (n : ℕ) (store : Structured.Store) + (reg : ℕ) (hcursor : 0 < store stateReg) + (hzero : store (zeroReg n) = 0) + (hfree : store stateReg ∉ captureRegs n) + (hdata : cellBase n ≤ reg) : + Structured.Basic.execList (marshalLoopOps n) store reg = + Function.update + (Function.update store (store stateReg) 0) + (cellReg n (inputTape n) (store stateReg)) + (store (store stateReg) + 1) reg := by + have hcursorAddress : store stateReg ≠ addressReg n := by + intro heq + apply hfree + simp [captureRegs, heq] + have hcursorValue : store stateReg ≠ valueReg n := by + intro heq + apply hfree + simp [captureRegs, heq] + let sourceAddressed := + (Structured.Basic.add (addressReg n) stateReg (zeroReg n)).exec store + let sourceLoaded := + (Structured.Basic.load (valueReg n) (addressReg n)).exec sourceAddressed + let sourceCleared := + (Structured.Basic.store (addressReg n) (zeroReg n)).exec sourceLoaded + let zeroed := (Structured.Basic.imm (zeroReg n) 0).exec sourceCleared + let oned := (Structured.Basic.imm (oneReg n) 1).exec zeroed + let counted := (Structured.Basic.imm (tapeCountReg n) (n + 2)).exec oned + let based := + (Structured.Basic.imm (stateScratchReg n) (cellBase n)).exec counted + let encoded := + (Structured.Basic.add (valueReg n) (valueReg n) (oneReg n)).exec based + let multiplied := + (Structured.Basic.mul (addressReg n) stateReg (tapeCountReg n)).exec encoded + let destinationAddressed := + (Structured.Basic.add (addressReg n) (addressReg n) + (stateScratchReg n)).exec multiplied + let destinationStored := + (Structured.Basic.store (addressReg n) (valueReg n)).exec + destinationAddressed + let final := + (Structured.Basic.sub stateReg stateReg (oneReg n)).exec destinationStored + have hsourceAddress : sourceAddressed (addressReg n) = store stateReg := by + simp [sourceAddressed, Structured.Basic.exec, hzero] + have hsourceCursor : sourceAddressed (store stateReg) = + store (store stateReg) := by + simp only [sourceAddressed, Structured.Basic.exec] + rw [Function.update_of_ne hcursorAddress] + have hloadedValue : sourceLoaded (valueReg n) = store (store stateReg) := by + simp [sourceLoaded, Structured.Basic.exec, hsourceAddress, hsourceCursor] + have hloadedAddress : sourceLoaded (addressReg n) = store stateReg := by + simp only [sourceLoaded, Structured.Basic.exec] + rw [Function.update_of_ne (by simp [addressReg, valueReg])] + exact hsourceAddress + have hloadedZero : sourceLoaded (zeroReg n) = 0 := by + simp only [sourceLoaded, Structured.Basic.exec] + rw [Function.update_of_ne (by simp [zeroReg, valueReg])] + simp only [sourceAddressed, Structured.Basic.exec] + rw [Function.update_of_ne (by simp [zeroReg, addressReg])] + exact hzero + have hclearedState : sourceCleared stateReg = store stateReg := by + simp only [sourceCleared, Structured.Basic.exec] + have hne : stateReg ≠ sourceLoaded (addressReg n) := by + rw [hloadedAddress] + simpa [stateReg] using (Nat.ne_of_lt hcursor) + rw [Function.update_of_ne hne] + simp only [sourceLoaded, Structured.Basic.exec] + rw [Function.update_of_ne (by simp [stateReg, valueReg])] + simp only [sourceAddressed, Structured.Basic.exec] + rw [Function.update_of_ne (by simp [stateReg, addressReg])] + have hclearedValue : sourceCleared (valueReg n) = + store (store stateReg) := by + simp only [sourceCleared, Structured.Basic.exec] + rw [Function.update_of_ne] + · exact hloadedValue + · rw [hloadedAddress] + exact Ne.symm hcursorValue + have hbasedState : based stateReg = store stateReg := by + simp only [based, counted, oned, zeroed, Structured.Basic.exec] + rw [Function.update_of_ne (by simp [stateReg, stateScratchReg]), + Function.update_of_ne (by simp [stateReg, tapeCountReg]), + Function.update_of_ne (by simp [stateReg, oneReg]), + Function.update_of_ne (by simp [stateReg, zeroReg])] + exact hclearedState + have hbasedCount : based (tapeCountReg n) = n + 2 := by + simp [based, counted, Structured.Basic.exec, tapeCountReg, + stateScratchReg, Function.update_of_ne] + have hbasedBase : based (stateScratchReg n) = cellBase n := by + simp [based, Structured.Basic.exec] + have hbasedOne : based (oneReg n) = 1 := by + simp [based, counted, oned, Structured.Basic.exec, oneReg, + tapeCountReg, stateScratchReg, Function.update_of_ne] + have hbasedValue : based (valueReg n) = store (store stateReg) := by + simp only [based, counted, oned, zeroed, Structured.Basic.exec] + rw [Function.update_of_ne (by simp [valueReg, stateScratchReg]), + Function.update_of_ne (by simp [valueReg, tapeCountReg]), + Function.update_of_ne (by simp [valueReg, oneReg]), + Function.update_of_ne (by simp [valueReg, zeroReg])] + exact hclearedValue + have hencodedState : encoded stateReg = store stateReg := by + simp only [encoded, Structured.Basic.exec] + rw [Function.update_of_ne (by simp [stateReg, valueReg])] + exact hbasedState + have hencodedCount : encoded (tapeCountReg n) = n + 2 := by + simp only [encoded, Structured.Basic.exec] + rw [Function.update_of_ne (by simp [tapeCountReg, valueReg])] + exact hbasedCount + have hencodedBase : encoded (stateScratchReg n) = cellBase n := by + simp only [encoded, Structured.Basic.exec] + rw [Function.update_of_ne (by simp [stateScratchReg, valueReg])] + exact hbasedBase + have hencodedValue : encoded (valueReg n) = + store (store stateReg) + 1 := by + simp [encoded, Structured.Basic.exec, hbasedValue, hbasedOne] + have hmultipliedAddress : multiplied (addressReg n) = + store stateReg * (n + 2) := by + simp [multiplied, Structured.Basic.exec, hencodedState, hencodedCount] + have hmultipliedBase : multiplied (stateScratchReg n) = cellBase n := by + simp only [multiplied, Structured.Basic.exec] + rw [Function.update_of_ne (by simp [stateScratchReg, addressReg])] + exact hencodedBase + have hmultipliedValue : multiplied (valueReg n) = + store (store stateReg) + 1 := by + simp only [multiplied, Structured.Basic.exec] + rw [Function.update_of_ne (by simp [valueReg, addressReg])] + exact hencodedValue + have hdestinationAddress : destinationAddressed (addressReg n) = + cellReg n (inputTape n) (store stateReg) := by + simp [destinationAddressed, Structured.Basic.exec, hmultipliedAddress, + hmultipliedBase, cellReg, inputTape] + omega + have hdestinationValue : destinationAddressed (valueReg n) = + store (store stateReg) + 1 := by + simp only [destinationAddressed, Structured.Basic.exec] + rw [Function.update_of_ne (by simp [valueReg, addressReg])] + exact hmultipliedValue + have hregState : reg ≠ stateReg := by + intro heq + rw [heq] at hdata + simp [stateReg, cellBase] at hdata + have hregAddress : reg ≠ addressReg n := by + intro heq + rw [heq] at hdata + simp [addressReg, cellBase] at hdata + omega + have hregValue : reg ≠ valueReg n := by + intro heq + rw [heq] at hdata + simp [valueReg, cellBase] at hdata + omega + have hregZero : reg ≠ zeroReg n := by + intro heq + rw [heq] at hdata + simp [zeroReg, cellBase] at hdata + omega + have hregOne : reg ≠ oneReg n := by + intro heq + rw [heq] at hdata + simp [oneReg, cellBase] at hdata + omega + have hregCount : reg ≠ tapeCountReg n := by + intro heq + rw [heq] at hdata + simp [tapeCountReg, cellBase] at hdata + omega + have hregBase : reg ≠ stateScratchReg n := by + intro heq + rw [heq] at hdata + simp [stateScratchReg, cellBase] at hdata + omega + have hloadedData : sourceLoaded reg = store reg := by + simp only [sourceLoaded, Structured.Basic.exec] + rw [Function.update_of_ne hregValue] + simp only [sourceAddressed, Structured.Basic.exec] + rw [Function.update_of_ne hregAddress] + have hclearedData : sourceCleared reg = + Function.update store (store stateReg) 0 reg := by + simp only [sourceCleared, Structured.Basic.exec] + rw [hloadedAddress, hloadedZero] + by_cases heq : reg = store stateReg + · subst reg + rw [Function.update_self, Function.update_self] + · rw [Function.update_of_ne heq, Function.update_of_ne heq] + exact hloadedData + have hbasedData : based reg = + Function.update store (store stateReg) 0 reg := by + simp only [based, counted, oned, zeroed, Structured.Basic.exec] + rw [Function.update_of_ne hregBase, Function.update_of_ne hregCount, + Function.update_of_ne hregOne, Function.update_of_ne hregZero] + exact hclearedData + have hencodedData : encoded reg = + Function.update store (store stateReg) 0 reg := by + simp only [encoded, Structured.Basic.exec] + rw [Function.update_of_ne hregValue] + exact hbasedData + have hmultipliedData : multiplied reg = + Function.update store (store stateReg) 0 reg := by + simp only [multiplied, Structured.Basic.exec] + rw [Function.update_of_ne hregAddress] + exact hencodedData + have haddressedData : destinationAddressed reg = + Function.update store (store stateReg) 0 reg := by + simp only [destinationAddressed, Structured.Basic.exec] + rw [Function.update_of_ne hregAddress] + exact hmultipliedData + change final reg = _ + simp only [final, Structured.Basic.exec] + rw [Function.update_of_ne hregState] + simp only [destinationStored, Structured.Basic.exec] + rw [hdestinationAddress, hdestinationValue] + by_cases heq : reg = cellReg n (inputTape n) (store stateReg) + · subst reg + rw [Function.update_self, Function.update_self] + · rw [Function.update_of_ne heq, Function.update_of_ne heq] + exact haddressedData + +/-- Apart from the raw source, sparse destination, state, and six scratch +registers, a loop body preserves every register. This form does not assume that +the cursor avoids scratch, so it carries both future raw sources and previously +relocated cells across captured iterations. -/ +theorem marshalLoopOps_of_ne_internal (n : ℕ) + (store : Structured.Store) (reg : ℕ) + (hcursor : 0 < store stateReg) + (hzero : store (zeroReg n) = 0) + (hstate : reg ≠ stateReg) + (hfree : reg ∉ captureRegs n) + (hsource : reg ≠ store stateReg) + (hdestination : + reg ≠ cellReg n (inputTape n) (store stateReg)) : + Structured.Basic.execList (marshalLoopOps n) store reg = store reg := by + let sourceAddressed := + (Structured.Basic.add (addressReg n) stateReg (zeroReg n)).exec store + let sourceLoaded := + (Structured.Basic.load (valueReg n) (addressReg n)).exec sourceAddressed + let sourceCleared := + (Structured.Basic.store (addressReg n) (zeroReg n)).exec sourceLoaded + let zeroed := (Structured.Basic.imm (zeroReg n) 0).exec sourceCleared + let oned := (Structured.Basic.imm (oneReg n) 1).exec zeroed + let counted := (Structured.Basic.imm (tapeCountReg n) (n + 2)).exec oned + let based := + (Structured.Basic.imm (stateScratchReg n) (cellBase n)).exec counted + let encoded := + (Structured.Basic.add (valueReg n) (valueReg n) (oneReg n)).exec based + let multiplied := + (Structured.Basic.mul (addressReg n) stateReg (tapeCountReg n)).exec encoded + let destinationAddressed := + (Structured.Basic.add (addressReg n) (addressReg n) + (stateScratchReg n)).exec multiplied + let destinationStored := + (Structured.Basic.store (addressReg n) (valueReg n)).exec + destinationAddressed + let final := + (Structured.Basic.sub stateReg stateReg (oneReg n)).exec destinationStored + have hsourceAddress : sourceAddressed (addressReg n) = store stateReg := by + simp [sourceAddressed, Structured.Basic.exec, hzero] + have hloadedAddress : sourceLoaded (addressReg n) = store stateReg := by + simp only [sourceLoaded, Structured.Basic.exec] + rw [Function.update_of_ne (by simp [addressReg, valueReg])] + exact hsourceAddress + have hloadedZero : sourceLoaded (zeroReg n) = 0 := by + simp only [sourceLoaded, Structured.Basic.exec] + rw [Function.update_of_ne (by simp [zeroReg, valueReg])] + simp only [sourceAddressed, Structured.Basic.exec] + rw [Function.update_of_ne (by simp [zeroReg, addressReg])] + exact hzero + have hclearedState : sourceCleared stateReg = store stateReg := by + simp only [sourceCleared, Structured.Basic.exec] + rw [Function.update_of_ne] + · simp only [sourceLoaded, Structured.Basic.exec] + rw [Function.update_of_ne (by simp [stateReg, valueReg])] + simp only [sourceAddressed, Structured.Basic.exec] + rw [Function.update_of_ne (by simp [stateReg, addressReg])] + · rw [hloadedAddress] + simpa [stateReg] using (Nat.ne_of_lt hcursor) + have hbasedState : based stateReg = store stateReg := by + simp only [based, counted, oned, zeroed, Structured.Basic.exec] + rw [Function.update_of_ne (by simp [stateReg, stateScratchReg]), + Function.update_of_ne (by simp [stateReg, tapeCountReg]), + Function.update_of_ne (by simp [stateReg, oneReg]), + Function.update_of_ne (by simp [stateReg, zeroReg])] + exact hclearedState + have hbasedCount : based (tapeCountReg n) = n + 2 := by + simp [based, counted, Structured.Basic.exec, tapeCountReg, + stateScratchReg, Function.update_of_ne] + have hbasedBase : based (stateScratchReg n) = cellBase n := by + simp [based, Structured.Basic.exec] + have hencodedState : encoded stateReg = store stateReg := by + simp only [encoded, Structured.Basic.exec] + rw [Function.update_of_ne (by simp [stateReg, valueReg])] + exact hbasedState + have hencodedCount : encoded (tapeCountReg n) = n + 2 := by + simp only [encoded, Structured.Basic.exec] + rw [Function.update_of_ne (by simp [tapeCountReg, valueReg])] + exact hbasedCount + have hencodedBase : encoded (stateScratchReg n) = cellBase n := by + simp only [encoded, Structured.Basic.exec] + rw [Function.update_of_ne (by simp [stateScratchReg, valueReg])] + exact hbasedBase + have hmultipliedAddress : multiplied (addressReg n) = + store stateReg * (n + 2) := by + simp [multiplied, Structured.Basic.exec, hencodedState, hencodedCount] + have hmultipliedBase : multiplied (stateScratchReg n) = cellBase n := by + simp only [multiplied, Structured.Basic.exec] + rw [Function.update_of_ne (by simp [stateScratchReg, addressReg])] + exact hencodedBase + have hdestinationAddress : destinationAddressed (addressReg n) = + cellReg n (inputTape n) (store stateReg) := by + simp [destinationAddressed, Structured.Basic.exec, hmultipliedAddress, + hmultipliedBase, cellReg, inputTape] + omega + have hregState : reg ≠ stateReg := hstate + have hregAddress : reg ≠ addressReg n := by + intro heq + apply hfree + simp [captureRegs, heq] + have hregValue : reg ≠ valueReg n := by + intro heq + apply hfree + simp [captureRegs, heq] + have hregZero : reg ≠ zeroReg n := by + intro heq + apply hfree + simp [captureRegs, heq] + have hregOne : reg ≠ oneReg n := by + intro heq + apply hfree + simp [captureRegs, heq] + have hregCount : reg ≠ tapeCountReg n := by + intro heq + apply hfree + simp [captureRegs, heq] + have hregBase : reg ≠ stateScratchReg n := by + intro heq + apply hfree + simp [captureRegs, heq] + have hloadedData : sourceLoaded reg = store reg := by + simp only [sourceLoaded, Structured.Basic.exec] + rw [Function.update_of_ne hregValue] + simp only [sourceAddressed, Structured.Basic.exec] + rw [Function.update_of_ne hregAddress] + have hclearedData : sourceCleared reg = store reg := by + simp only [sourceCleared, Structured.Basic.exec] + rw [Function.update_of_ne] + · exact hloadedData + · rw [hloadedAddress] + exact hsource + have hbasedData : based reg = store reg := by + simp only [based, counted, oned, zeroed, Structured.Basic.exec] + rw [Function.update_of_ne hregBase, Function.update_of_ne hregCount, + Function.update_of_ne hregOne, Function.update_of_ne hregZero] + exact hclearedData + have hencodedData : encoded reg = store reg := by + simp only [encoded, Structured.Basic.exec] + rw [Function.update_of_ne hregValue] + exact hbasedData + have hmultipliedData : multiplied reg = store reg := by + simp only [multiplied, Structured.Basic.exec] + rw [Function.update_of_ne hregAddress] + exact hencodedData + have haddressedData : destinationAddressed reg = store reg := by + simp only [destinationAddressed, Structured.Basic.exec] + rw [Function.update_of_ne hregAddress] + exact hmultipliedData + change final reg = store reg + simp only [final, Structured.Basic.exec] + rw [Function.update_of_ne hregState] + simp only [destinationStored, Structured.Basic.exec] + rw [hdestinationAddress, Function.update_of_ne hdestination] + exact haddressedData + +/-- The backward-copy loop executes exactly once per raw input cell and exits +with cursor zero and all constants restored. -/ +theorem marshalLoop_exec_internal (n cursor : ℕ) + (store : Structured.Store) + (hcursor : store stateReg = cursor) + (hzero : store (zeroReg n) = 0) + (hone : store (oneReg n) = 1) + (hcount : store (tapeCountReg n) = n + 2) + (hbase : store (stateScratchReg n) = cellBase n) : + ∃ final cost space, + Structured.Exec (marshalLoop n) store final + (marshalLoopSteps n cursor) cost space ∧ + final stateReg = 0 ∧ + final (zeroReg n) = 0 ∧ + final (oneReg n) = 1 ∧ + final (tapeCountReg n) = n + 2 ∧ + final (stateScratchReg n) = cellBase n := by + induction cursor generalizing store with + | zero => + have hcursorZero : store stateReg = 0 := by simpa using hcursor + refine ⟨store, bitlen (store stateReg) + 1, store.space, ?_, + hcursorZero, hzero, hone, hcount, hbase⟩ + simpa [marshalLoop, marshalLoopSteps] using + (Structured.Exec.whileZero + (body := .basics (marshalLoopOps n)) hcursorZero) + | succ cursor ih => + have hpositive : 0 < store stateReg := by omega + have hnonzero : store stateReg ≠ 0 := by omega + let middle := Structured.Basic.execList (marshalLoopOps n) store + obtain ⟨bodyCost, bodySpace, hbody⟩ := + marshalLoopOps_exec_internal n store + have hcontrol := marshalLoopOps_control_internal n store hpositive hzero + have hmiddleCursor : middle stateReg = cursor := by + change Structured.Basic.execList (marshalLoopOps n) store stateReg = cursor + rw [hcontrol.1, hcursor] + omega + obtain ⟨final, loopCost, loopSpace, hloop, hfinalCursor, + hfinalZero, hfinalOne, hfinalCount, hfinalBase⟩ := + ih middle hmiddleCursor hcontrol.2.1 hcontrol.2.2.1 + hcontrol.2.2.2.1 hcontrol.2.2.2.2.1 + refine ⟨final, + bitlen (store stateReg) + 1 + bodyCost + 1 + loopCost, + max bodySpace loopSpace, ?_, hfinalCursor, hfinalZero, hfinalOne, + hfinalCount, hfinalBase⟩ + have hexec := Structured.Exec.whileNonzero hnonzero hbody hloop + convert hexec using 1 + simp [marshalLoopSteps, Nat.succ_mul] + omega + +end Sparse + +end TMConfig + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/ABI/Internal/Marshal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/ABI/Internal/Marshal.lean new file mode 100644 index 0000000000..0487c5e558 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/ABI/Internal/Marshal.lean @@ -0,0 +1,940 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.ABI.Internal.Loop +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.Internal +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.ABI.Internal.Capture +import Mathlib.Algebra.Order.Sub.Basic + +/-! +# Public-input marshalling correctness -- proof internals + +This file lifts the pointwise backward-copy facts to a loop invariant, repairs +the finitely many captured scratch positions, and establishes the complete +sparse representation of the Turing machine's initial configuration. +-/ + + +@[expose] public section + +namespace Complexity + +namespace RAM + +namespace TMConfig + +namespace Sparse + + +/-- Store after installing the constants used by the backward-copy loop. -/ +def marshalStart (n : ℕ) (x : List Bool) : Structured.Store := + Structured.Basic.execList (marshalConstants n) (initRegs x) + +/-- Semantic invariant after relocating positions `|x|, …, cursor + 1`. +Uncaptured destinations are exact, captured destinations are at least marked +positive, future uncaptured raw sources retain their public-ABI value, and all +other data registers have their expected raw-or-zero contents. -/ +def MarshalInvariant (n : ℕ) (x : List Bool) (cursor : ℕ) + (store : Structured.Store) : Prop := + store stateReg = cursor ∧ + cursor ≤ x.length ∧ + store (zeroReg n) = 0 ∧ + store (oneReg n) = 1 ∧ + store (tapeCountReg n) = n + 2 ∧ + store (stateScratchReg n) = cellBase n ∧ + (∀ position, 0 < position → position ≤ cursor → + position ∉ captureRegs n → store position = initRegs x position) ∧ + (∀ position, cursor < position → position ≤ x.length → + position ∉ captureRegs n → + store (cellReg n (inputTape n) position) = + initRegs x position + 1) ∧ + (∀ position, cursor < position → position ≤ x.length → + 0 < store (cellReg n (inputTape n) position)) ∧ + (∀ reg, cellBase n ≤ reg → + (∀ position, cursor < position → position ≤ x.length → + reg ≠ cellReg n (inputTape n) position) → + store reg = if reg ≤ cursor then initRegs x reg else 0) + +private theorem marshalStart_of_not_captured (n : ℕ) (x : List Bool) + {reg : ℕ} (hfree : reg ∉ captureRegs n) : + marshalStart n x reg = initRegs x reg := by + simp only [marshalStart, marshalConstants, Structured.Basic.execList, + Structured.Basic.exec] + have hzero : reg ≠ zeroReg n := by + intro heq + apply hfree + simp [captureRegs, heq] + have hone : reg ≠ oneReg n := by + intro heq + apply hfree + simp [captureRegs, heq] + have hcount : reg ≠ tapeCountReg n := by + intro heq + apply hfree + simp [captureRegs, heq] + have hbase : reg ≠ stateScratchReg n := by + intro heq + apply hfree + simp [captureRegs, heq] + rw [Function.update_of_ne hbase, Function.update_of_ne hcount, + Function.update_of_ne hone, Function.update_of_ne hzero] + +private theorem initRegs_eq_zero_of_length_lt (x : List Bool) {reg : ℕ} + (hreg : x.length < reg) : initRegs x reg = 0 := by + rw [initRegs, if_neg (by omega)] + rw [List.getElem?_eq_none (by omega)] + +/-- Installing loop constants establishes the invariant before any input +position has been relocated. -/ +theorem marshalStart_invariant_internal (n : ℕ) (x : List Bool) : + MarshalInvariant n x x.length (marshalStart n x) := by + have hstate : marshalStart n x stateReg = x.length := by + rw [marshalStart_of_not_captured] + · simp [initRegs, stateReg] + · simp [captureRegs, stateReg, zeroReg, oneReg, tapeCountReg, + stateScratchReg, addressReg, valueReg] + have hzero : marshalStart n x (zeroReg n) = 0 := by + simp [marshalStart, marshalConstants, Structured.Basic.execList, + Structured.Basic.exec, zeroReg, oneReg, tapeCountReg, stateScratchReg, + Function.update_of_ne] + have hone : marshalStart n x (oneReg n) = 1 := by + simp [marshalStart, marshalConstants, Structured.Basic.execList, + Structured.Basic.exec, oneReg, tapeCountReg, stateScratchReg, + Function.update_of_ne] + have hcount : marshalStart n x (tapeCountReg n) = n + 2 := by + simp [marshalStart, marshalConstants, Structured.Basic.execList, + Structured.Basic.exec, tapeCountReg, stateScratchReg, + Function.update_of_ne] + have hbase : marshalStart n x (stateScratchReg n) = cellBase n := by + simp [marshalStart, marshalConstants, Structured.Basic.execList, + Structured.Basic.exec] + refine ⟨hstate, le_rfl, hzero, hone, hcount, hbase, ?_, ?_, ?_, ?_⟩ + · intro position _ _ hfree + exact marshalStart_of_not_captured n x hfree + · intro position hposition _ _ + omega + · intro position hposition _ + omega + · intro reg hdata _ + rw [marshalStart_of_not_captured] + · by_cases hreg : reg ≤ x.length + · simp [hreg] + · have hz : initRegs x reg = 0 := + initRegs_eq_zero_of_length_lt x (reg := reg) (by omega) + simp [hreg, hz] + · simp [captureRegs, zeroReg, oneReg, tapeCountReg, stateScratchReg, + addressReg, valueReg, cellBase] at * + omega + +private theorem position_lt_inputCell (n position : ℕ) : + position < cellReg n (inputTape n) position := by + simp [cellReg, inputTape, cellBase, Nat.mul_add] + omega + +private theorem inputCell_injective (n : ℕ) : + Function.Injective (cellReg n (inputTape n)) := by + intro left right heq + simp [cellReg, inputTape] at heq + omega + +private theorem inputCell_not_captured (n position : ℕ) : + cellReg n (inputTape n) position ∉ captureRegs n := by + simp [captureRegs, zeroReg, oneReg, tapeCountReg, stateScratchReg, + addressReg, valueReg, cellReg, inputTape, cellBase] + omega + +private theorem inputCell_data (n position : ℕ) : + cellBase n ≤ cellReg n (inputTape n) position := by + simp [cellReg, inputTape] + +/-- One positive-cursor body advances the complete relocation invariant by one +position, including an exact value for ordinary sources and a positive visited +marker for captured scratch sources. -/ +theorem marshalLoopOps_invariant_internal (n : ℕ) (x : List Bool) + (cursor : ℕ) (store : Structured.Store) (hcursor : 0 < cursor) + (hinvariant : MarshalInvariant n x cursor store) : + MarshalInvariant n x (cursor - 1) + (Structured.Basic.execList (marshalLoopOps n) store) := by + rcases hinvariant with + ⟨hstate, hcursorLength, hzero, hone, hcount, hbase, hsource, hexact, + hpositive, hother⟩ + let middle := Structured.Basic.execList (marshalLoopOps n) store + have hstorePositive : 0 < store stateReg := by omega + have hcontrol := + marshalLoopOps_control_internal n store hstorePositive hzero + have hmiddleState : middle stateReg = cursor - 1 := by + change Structured.Basic.execList (marshalLoopOps n) store stateReg = _ + rw [hcontrol.1, hstate] + refine ⟨hmiddleState, by omega, hcontrol.2.1, hcontrol.2.2.1, + hcontrol.2.2.2.1, hcontrol.2.2.2.2.1, ?_, ?_, ?_, ?_⟩ + · intro position hposition hpositionCursor hfree + have hpositionState : position ≠ stateReg := by + simp [stateReg] + omega + have hpositionSource : position ≠ store stateReg := by + rw [hstate] + omega + have hpositionDestination : + position ≠ cellReg n (inputTape n) (store stateReg) := by + rw [hstate] + have hhigh := position_lt_inputCell n cursor + omega + change Structured.Basic.execList (marshalLoopOps n) store position = _ + rw [marshalLoopOps_of_ne_internal n store position hstorePositive + hzero hpositionState hfree hpositionSource hpositionDestination] + exact hsource position hposition (by omega) hfree + · intro position hposition hlength hfree + by_cases heq : position = cursor + · subst position + have hfreeStore : store stateReg ∉ captureRegs n := by + simpa [hstate] using hfree + have hbody := marshalLoopOps_data_internal n store + (cellReg n (inputTape n) cursor) hstorePositive hzero hfreeStore + (inputCell_data n cursor) + change Structured.Basic.execList (marshalLoopOps n) store + (cellReg n (inputTape n) cursor) = _ + rw [hbody, hstate, Function.update_self, + hsource cursor hcursor le_rfl hfree] + · have hcursorPosition : cursor < position := by omega + have hregState : cellReg n (inputTape n) position ≠ stateReg := by + simp [stateReg, cellReg, inputTape, cellBase] + have hregSource : + cellReg n (inputTape n) position ≠ store stateReg := by + rw [hstate] + have hhigh := position_lt_inputCell n position + omega + have hregDestination : cellReg n (inputTape n) position ≠ + cellReg n (inputTape n) (store stateReg) := by + intro hcells + have := inputCell_injective n hcells + rw [hstate] at this + omega + change Structured.Basic.execList (marshalLoopOps n) store + (cellReg n (inputTape n) position) = _ + rw [marshalLoopOps_of_ne_internal n store + (cellReg n (inputTape n) position) hstorePositive hzero hregState + (inputCell_not_captured n position) hregSource hregDestination] + exact hexact position hcursorPosition hlength hfree + · intro position hposition hlength + by_cases heq : position = cursor + · subst position + simpa [hstate] using hcontrol.2.2.2.2.2 + · have hcursorPosition : cursor < position := by omega + have hregState : cellReg n (inputTape n) position ≠ stateReg := by + simp [stateReg, cellReg, inputTape, cellBase] + have hregSource : + cellReg n (inputTape n) position ≠ store stateReg := by + rw [hstate] + have hhigh := position_lt_inputCell n position + omega + have hregDestination : cellReg n (inputTape n) position ≠ + cellReg n (inputTape n) (store stateReg) := by + intro hcells + have := inputCell_injective n hcells + rw [hstate] at this + omega + change 0 < Structured.Basic.execList (marshalLoopOps n) store + (cellReg n (inputTape n) position) + rw [marshalLoopOps_of_ne_internal n store + (cellReg n (inputTape n) position) hstorePositive hzero hregState + (inputCell_not_captured n position) hregSource hregDestination] + exact hpositive position hcursorPosition hlength + · intro reg hdata hnotDestination + have hregState : reg ≠ stateReg := by + intro heq + rw [heq] at hdata + simp [stateReg, cellBase] at hdata + have hregFree : reg ∉ captureRegs n := by + intro hmem + simp [captureRegs, zeroReg, oneReg, tapeCountReg, stateScratchReg, + addressReg, valueReg] at hmem + rcases hmem with h | h | h | h | h | h <;> + rw [h] at hdata <;> simp [cellBase] at hdata <;> omega + have hregDestination : + reg ≠ cellReg n (inputTape n) (store stateReg) := by + rw [hstate] + apply hnotDestination cursor + · omega + · omega + by_cases hregSource : reg = cursor + · subst reg + have hfreeStore : store stateReg ∉ captureRegs n := by + simpa [hstate] using hregFree + have hbody := marshalLoopOps_data_internal n store cursor + hstorePositive hzero hfreeStore hdata + have hregDestinationCursor : + cursor ≠ cellReg n (inputTape n) cursor := by + exact Nat.ne_of_lt (position_lt_inputCell n cursor) + change Structured.Basic.execList (marshalLoopOps n) store cursor = _ + rw [hbody, hstate, Function.update_of_ne hregDestinationCursor, + Function.update_self] + simp [hcursor] + · have hregSource' : reg ≠ store stateReg := by + rw [hstate] + exact hregSource + have hpreserved := marshalLoopOps_of_ne_internal n store reg + hstorePositive hzero hregState hregFree hregSource' + hregDestination + change Structured.Basic.execList (marshalLoopOps n) store reg = _ + rw [hpreserved] + have holdNotDestination : ∀ position, cursor < position → + position ≤ x.length → + reg ≠ cellReg n (inputTape n) position := by + intro position hposition hlength + exact hnotDestination position (by omega) hlength + rw [hother reg hdata holdNotDestination] + by_cases hregLow : reg ≤ cursor - 1 + · simp [hregLow, show reg ≤ cursor by omega] + · simp [hregLow, show ¬ reg ≤ cursor by omega] + +/-- The complete backward loop executes once per input position and leaves the +relocation invariant at cursor zero. -/ +theorem marshalLoop_invariant_exec_internal (n : ℕ) (x : List Bool) + (cursor : ℕ) (store : Structured.Store) + (hinvariant : MarshalInvariant n x cursor store) : + ∃ final cost space, + Structured.Exec (marshalLoop n) store final + (marshalLoopSteps n cursor) cost space ∧ + MarshalInvariant n x 0 final := by + induction cursor generalizing store with + | zero => + have hstateZero : store stateReg = 0 := hinvariant.1 + refine ⟨store, bitlen (store stateReg) + 1, store.space, ?_, ?_⟩ + · simpa [marshalLoop, marshalLoopSteps] using + (Structured.Exec.whileZero + (body := .basics (marshalLoopOps n)) hstateZero) + · exact hinvariant + | succ cursor ih => + have hpositive : 0 < cursor + 1 := by omega + have hstoreNonzero : store stateReg ≠ 0 := by + rw [hinvariant.1] + omega + let middle := Structured.Basic.execList (marshalLoopOps n) store + obtain ⟨bodyCost, bodySpace, hbody⟩ := + marshalLoopOps_exec_internal n store + have hmiddleInvariant : MarshalInvariant n x cursor middle := by + have hstep := marshalLoopOps_invariant_internal n x (cursor + 1) + store hpositive hinvariant + simpa [middle] using hstep + obtain ⟨final, loopCost, loopSpace, hloop, hfinalInvariant⟩ := + ih middle hmiddleInvariant + refine ⟨final, + bitlen (store stateReg) + 1 + bodyCost + 1 + loopCost, + max bodySpace loopSpace, ?_, hfinalInvariant⟩ + have hexec := Structured.Exec.whileNonzero hstoreNonzero hbody hloop + convert hexec using 1 + simp [marshalLoopSteps, Nat.succ_mul] + omega + +/-- Exact store selected by one captured-position repair command. -/ +def repairBitStore (n : ℕ) (entry : ℕ × ℕ) + (store : Structured.Store) : Structured.Store := + let loaded := Structured.Basic.execList + [.imm (addressReg n) (cellReg n (inputTape n) entry.1), + .load (valueReg n) (addressReg n)] store + if loaded (valueReg n) = 0 then loaded + else Structured.Basic.execList + [.imm (valueReg n) (entry.2 + 1), + .store (addressReg n) (valueReg n)] loaded + +/-- Exact store selected by the recursive captured-position repair pass. -/ +def repairStore (n : ℕ) : + List (ℕ × ℕ) → Structured.Store → Structured.Store + | [], store => store + | entry :: rest, store => + repairStore n rest (repairBitStore n entry store) + +private theorem repairBit_exec_internal (n : ℕ) (entry : ℕ × ℕ) + (store : Structured.Store) : + ∃ steps cost space, + Structured.Exec (repairBit n entry) store + (repairBitStore n entry store) steps cost space := by + let setup : List Structured.Basic := + [.imm (addressReg n) (cellReg n (inputTape n) entry.1), + .load (valueReg n) (addressReg n)] + let loaded := Structured.Basic.execList setup store + obtain ⟨setupCost, setupSpace, hsetup⟩ := + Structured.Internal.exec_basics_exists setup store + by_cases hzero : loaded (valueReg n) = 0 + · have hbranch := Structured.Exec.ifZero + (onNonzero := .basics + [.imm (valueReg n) (entry.2 + 1), + .store (addressReg n) (valueReg n)]) + hzero (Structured.Exec.skip loaded) + refine ⟨setup.length + 1, setupCost + (bitlen (loaded (valueReg n)) + 1), + max setupSpace loaded.space, ?_⟩ + have hexec := Structured.Exec.seq hsetup hbranch + simpa [repairBit, repairBitStore, setup, loaded, hzero, + Nat.add_comm, Nat.add_left_comm, Nat.add_assoc] using hexec + · let writes : List Structured.Basic := + [.imm (valueReg n) (entry.2 + 1), + .store (addressReg n) (valueReg n)] + let final := Structured.Basic.execList writes loaded + obtain ⟨writeCost, writeSpace, hwrites⟩ := + Structured.Internal.exec_basics_exists writes loaded + have hbranch := Structured.Exec.ifNonzero + (onZero := Structured.Cmd.skip) hzero hwrites + refine ⟨setup.length + (writes.length + 2), + setupCost + (bitlen (loaded (valueReg n)) + 1 + writeCost + 1), + max setupSpace (max loaded.space writeSpace), ?_⟩ + have hexec := Structured.Exec.seq hsetup hbranch + simpa [repairBit, repairBitStore, setup, loaded, writes, final, hzero, + Nat.add_comm, Nat.add_left_comm, Nat.add_assoc] using hexec + +/-- The recursive repair command has an exact structured execution. -/ +theorem repairCaptured_exec_internal (n : ℕ) + (captured : List (ℕ × ℕ)) (store : Structured.Store) : + ∃ steps cost space, + Structured.Exec (repairCaptured n captured) store + (repairStore n captured store) steps cost space := by + induction captured generalizing store with + | nil => + exact ⟨0, 0, store.space, Structured.Exec.skip store⟩ + | cons entry rest ih => + obtain ⟨firstSteps, firstCost, firstSpace, hfirst⟩ := + repairBit_exec_internal n entry store + obtain ⟨restSteps, restCost, restSpace, hrest⟩ := + ih (repairBitStore n entry store) + exact ⟨firstSteps + restSteps, firstCost + restCost, + max firstSpace restSpace, Structured.Exec.seq hfirst hrest⟩ + +/-- On data registers, one repair either preserves the store or updates exactly +the selected input-cell destination. -/ +theorem repairBitStore_data_internal (n : ℕ) (entry : ℕ × ℕ) + (store : Structured.Store) (reg : ℕ) (hdata : cellBase n ≤ reg) : + repairBitStore n entry store reg = + if store (cellReg n (inputTape n) entry.1) = 0 then store reg + else Function.update store (cellReg n (inputTape n) entry.1) + (entry.2 + 1) reg := by + let addressed := + (Structured.Basic.imm (addressReg n) + (cellReg n (inputTape n) entry.1)).exec store + let loaded := + (Structured.Basic.load (valueReg n) (addressReg n)).exec addressed + have haddress : addressed (addressReg n) = + cellReg n (inputTape n) entry.1 := by + simp [addressed, Structured.Basic.exec] + have hloadedValue : loaded (valueReg n) = + store (cellReg n (inputTape n) entry.1) := by + have hdestinationAddress : + cellReg n (inputTape n) entry.1 ≠ addressReg n := by + simp [cellReg, inputTape, cellBase, addressReg] + omega + have haddressedDestination : addressed + (cellReg n (inputTape n) entry.1) = + store (cellReg n (inputTape n) entry.1) := by + simp only [addressed, Structured.Basic.exec] + rw [Function.update_of_ne hdestinationAddress] + simp only [loaded, Structured.Basic.exec, Function.update_self] + rw [haddress, haddressedDestination] + have hloadedAddress : loaded (addressReg n) = + cellReg n (inputTape n) entry.1 := by + simp only [loaded, Structured.Basic.exec] + rw [Function.update_of_ne (by simp [addressReg, valueReg])] + exact haddress + have hregAddress : reg ≠ addressReg n := by + intro heq + rw [heq] at hdata + simp [addressReg, cellBase] at hdata + omega + have hregValue : reg ≠ valueReg n := by + intro heq + rw [heq] at hdata + simp [valueReg, cellBase] at hdata + omega + have hloadedData : loaded reg = store reg := by + simp only [loaded, Structured.Basic.exec] + rw [Function.update_of_ne hregValue] + simp only [addressed, Structured.Basic.exec] + rw [Function.update_of_ne hregAddress] + unfold repairBitStore + change (if loaded (valueReg n) = 0 then loaded else + Structured.Basic.execList + [.imm (valueReg n) (entry.2 + 1), + .store (addressReg n) (valueReg n)] loaded) reg = _ + rw [hloadedValue] + by_cases hzero : store (cellReg n (inputTape n) entry.1) = 0 + · simp [hzero, hloadedData] + · simp only [hzero, if_false] + let valued := + (Structured.Basic.imm (valueReg n) (entry.2 + 1)).exec loaded + have hvaluedAddress : valued (addressReg n) = + cellReg n (inputTape n) entry.1 := by + simp only [valued, Structured.Basic.exec] + rw [Function.update_of_ne (by simp [addressReg, valueReg])] + exact hloadedAddress + have hvaluedValue : valued (valueReg n) = entry.2 + 1 := by + simp [valued, Structured.Basic.exec] + change (Structured.Basic.store (addressReg n) (valueReg n)).exec + valued reg = _ + simp only [Structured.Basic.exec] + rw [hvaluedAddress, hvaluedValue] + by_cases heq : reg = cellReg n (inputTape n) entry.1 + · subst reg + rw [Function.update_self, Function.update_self] + · rw [Function.update_of_ne heq, Function.update_of_ne heq] + simp only [valued, Structured.Basic.exec] + rw [Function.update_of_ne hregValue] + exact hloadedData + +/-- A repair list preserves a data register that is not one of its selected +input-cell destinations. -/ +theorem repairStore_data_of_not_mem_internal (n : ℕ) + (captured : List (ℕ × ℕ)) (store : Structured.Store) (reg : ℕ) + (hdata : cellBase n ≤ reg) + (hnot : ∀ entry, entry ∈ captured → + reg ≠ cellReg n (inputTape n) entry.1) : + repairStore n captured store reg = store reg := by + induction captured generalizing store with + | nil => rfl + | cons entry rest ih => + have hhead : reg ≠ cellReg n (inputTape n) entry.1 := + hnot entry (by simp) + have hrest : ∀ candidate, candidate ∈ rest → + reg ≠ cellReg n (inputTape n) candidate.1 := by + intro candidate hmem + exact hnot candidate (by simp [hmem]) + simp only [repairStore] + rw [ih (repairBitStore n entry store) hrest, + repairBitStore_data_internal n entry store reg hdata] + by_cases hzero : store (cellReg n (inputTape n) entry.1) = 0 + · simp [hzero] + · simp [hzero, Function.update_of_ne hhead] + +/-- A visited destination selected exactly once by a repair list receives its +captured Boolean value shifted to the sparse symbol code. -/ +theorem repairStore_selected_internal (n : ℕ) + (captured : List (ℕ × ℕ)) (store : Structured.Store) + (position value : ℕ) (hmem : (position, value) ∈ captured) + (hnodup : (captured.map Prod.fst).Nodup) + (hpositive : 0 < store (cellReg n (inputTape n) position)) : + repairStore n captured store (cellReg n (inputTape n) position) = + value + 1 := by + induction captured generalizing store with + | nil => simp at hmem + | cons entry rest ih => + simp only [List.map_cons, List.nodup_cons] at hnodup + rcases hnodup with ⟨hheadFresh, hrestNodup⟩ + simp only [List.mem_cons] at hmem + rcases hmem with heq | hmem + · cases heq + have hupdated : repairBitStore n (position, value) store + (cellReg n (inputTape n) position) = value + 1 := by + rw [repairBitStore_data_internal n (position, value) store + (cellReg n (inputTape n) position) (inputCell_data n position)] + simp [show store (cellReg n (inputTape n) position) ≠ 0 by omega] + have hrestPreserves := repairStore_data_of_not_mem_internal n rest + (repairBitStore n (position, value) store) + (cellReg n (inputTape n) position) (inputCell_data n position) + (by + intro candidate hcandidate heqCell + apply hheadFresh + rw [List.mem_map] + refine ⟨candidate, hcandidate, ?_⟩ + exact (inputCell_injective n heqCell).symm) + simp only [repairStore] + rw [hrestPreserves, hupdated] + · have hentryDifferent : position ≠ entry.1 := by + intro heq + subst position + apply hheadFresh + rw [List.mem_map] + exact ⟨(entry.1, value), hmem, rfl⟩ + have hheadPreserves : repairBitStore n entry store + (cellReg n (inputTape n) position) = + store (cellReg n (inputTape n) position) := by + rw [repairBitStore_data_internal n entry store + (cellReg n (inputTape n) position) (inputCell_data n position)] + by_cases hzero : store (cellReg n (inputTape n) entry.1) = 0 + · simp [hzero] + · have hcells : cellReg n (inputTape n) position ≠ + cellReg n (inputTape n) entry.1 := by + intro heqCell + exact hentryDifferent (inputCell_injective n heqCell) + simp [hzero, Function.update_of_ne hcells] + have hnextPositive : 0 < repairBitStore n entry store + (cellReg n (inputTape n) position) := by + rw [hheadPreserves] + exact hpositive + simp only [repairStore] + exact ih (repairBitStore n entry store) hmem hrestNodup hnextPositive + +/-- A zero data register stays zero throughout every conditional repair, +including when it is an unvisited captured destination. -/ +theorem repairStore_data_zero_internal (n : ℕ) + (captured : List (ℕ × ℕ)) (store : Structured.Store) (reg : ℕ) + (hdata : cellBase n ≤ reg) (hzero : store reg = 0) : + repairStore n captured store reg = 0 := by + induction captured generalizing store with + | nil => exact hzero + | cons entry rest ih => + have hnextZero : repairBitStore n entry store reg = 0 := by + rw [repairBitStore_data_internal n entry store reg hdata] + by_cases hentryZero : + store (cellReg n (inputTape n) entry.1) = 0 + · simp [hentryZero, hzero] + · have hne : reg ≠ cellReg n (inputTape n) entry.1 := by + intro heq + subst reg + exact hentryZero hzero + simp [hentryZero, Function.update_of_ne hne, hzero] + simp only [repairStore] + exact ih (repairBitStore n entry store) hnextZero + +/-- Closed form of the accumulator-style capture traversal. -/ +private theorem captureValues_eq_reverse_append (store : Structured.Store) + (regs : List ℕ) (captured : List (ℕ × ℕ)) : + captureValues store regs captured = + (regs.map (fun reg => (reg, store reg))).reverse ++ captured := by + induction regs generalizing captured with + | nil => simp [captureValues] + | cons reg rest ih => + rw [captureValues, ih] + simp [List.reverse_cons, List.append_assoc] + +/-- Captured values selected for a public input. -/ +def capturedInput (n : ℕ) (x : List Bool) : List (ℕ × ℕ) := + captureValues (initRegs x) (captureRegs n) [] + +private theorem capturedInput_mem_iff (n : ℕ) (x : List Bool) + (position : ℕ) : + (position, initRegs x position) ∈ capturedInput n x ↔ + position ∈ captureRegs n := by + rw [capturedInput, captureValues_eq_reverse_append] + simp + +private theorem capturedInput_fst_nodup (n : ℕ) (x : List Bool) : + ((capturedInput n x).map Prod.fst).Nodup := by + have hregs : (captureRegs n).Nodup := by + simp [captureRegs, zeroReg, oneReg, tapeCountReg, stateScratchReg, + addressReg, valueReg] + rw [capturedInput, captureValues_eq_reverse_append] + simp only [List.append_nil, List.map_reverse, List.map_map] + simpa [Function.comp_def] using hregs + +private theorem capturedInput_positions (n : ℕ) (x : List Bool) + {entry : ℕ × ℕ} (hmem : entry ∈ capturedInput n x) : + entry.1 ∈ captureRegs n ∧ entry.2 = initRegs x entry.1 := by + rw [capturedInput, captureValues_eq_reverse_append] at hmem + simp only [List.append_nil, List.mem_reverse, List.mem_map] at hmem + obtain ⟨position, hposition, rfl⟩ := hmem + exact ⟨hposition, rfl⟩ + +private theorem initRegs_add_one_eq_input_symbol (x : List Bool) + {position : ℕ} (hpositive : 0 < position) + (hlength : position ≤ x.length) : + initRegs x position + 1 = + symbolCode ((Tape.init (x.map Γ.ofBool)).cells position) := by + obtain ⟨index, rfl⟩ : ∃ index, position = index + 1 := + ⟨position - 1, by omega⟩ + have hindex : index < x.length := by omega + rw [Tape.init_ofBool_cells_lt x index hindex] + simp only [initRegs, show index + 1 ≠ 0 by omega, if_false] + rw [show index + 1 - 1 = index by omega, + List.getElem?_eq_getElem hindex] + cases x[index] <;> simp [Γ.ofBool, symbolCode] + +/-- After captured-position repair, every positive input cell has its exact TM +symbol code, cell zero is still temporarily blank, and all non-input tapes are +still blank. -/ +theorem repairStore_cells_internal (n : ℕ) (x : List Bool) + (store : Structured.Store) + (hinvariant : MarshalInvariant n x 0 store) : + let repaired := repairStore n (capturedInput n x) store + (∀ position, 0 < position → + repaired (cellReg n (inputTape n) position) = + symbolCode ((Tape.init (x.map Γ.ofBool)).cells position)) ∧ + repaired (cellReg n (inputTape n) 0) = 0 ∧ + (∀ (tape : Fin (n + 2)) (position : ℕ), tape ≠ inputTape n → + repaired (cellReg n tape position) = 0) := by + rcases hinvariant with + ⟨_, _, _, _, _, _, _, hexact, hpositive, hother⟩ + let captured := capturedInput n x + let repaired := repairStore n captured store + have hcapturedNodup : (captured.map Prod.fst).Nodup := by + exact capturedInput_fst_nodup n x + refine ⟨?_, ?_, ?_⟩ + · intro position hposition + by_cases hlength : position ≤ x.length + · by_cases hcaptured : position ∈ captureRegs n + · have hmem : (position, initRegs x position) ∈ captured := by + exact (capturedInput_mem_iff n x position).2 hcaptured + have hrepaired := repairStore_selected_internal n captured store + position (initRegs x position) hmem hcapturedNodup + (hpositive position hposition hlength) + exact hrepaired.trans + (initRegs_add_one_eq_input_symbol x hposition hlength) + · have hnot : ∀ entry, entry ∈ captured → + cellReg n (inputTape n) position ≠ + cellReg n (inputTape n) entry.1 := by + intro entry hentry heq + have hentryInfo := capturedInput_positions n x hentry + apply hcaptured + rw [inputCell_injective n heq] + exact hentryInfo.1 + have hpreserved := repairStore_data_of_not_mem_internal n captured + store (cellReg n (inputTape n) position) + (inputCell_data n position) hnot + rw [hpreserved, hexact position hposition hlength hcaptured] + exact initRegs_add_one_eq_input_symbol x hposition hlength + · have hloopZero : store (cellReg n (inputTape n) position) = 0 := by + have hnot : ∀ candidate, 0 < candidate → + candidate ≤ x.length → + cellReg n (inputTape n) position ≠ + cellReg n (inputTape n) candidate := by + intro candidate _ hcandidate heq + have := inputCell_injective n heq + omega + rw [hother (cellReg n (inputTape n) position) + (inputCell_data n position) hnot] + have hpositiveReg : 0 < cellReg n (inputTape n) position := by + simp [cellReg, inputTape, cellBase] + simp [show ¬ cellReg n (inputTape n) position ≤ 0 by omega] + have hrepaired := repairStore_data_zero_internal n captured store + (cellReg n (inputTape n) position) (inputCell_data n position) + hloopZero + rw [hrepaired] + obtain ⟨index, rfl⟩ : ∃ index, position = index + 1 := + ⟨position - 1, by omega⟩ + rw [Tape.init_ofBool_cells_ge x index (by omega)] + rfl + · have hloopZero : store (cellReg n (inputTape n) 0) = 0 := by + have hnot : ∀ candidate, 0 < candidate → + candidate ≤ x.length → + cellReg n (inputTape n) 0 ≠ + cellReg n (inputTape n) candidate := by + intro candidate hcandidate _ heq + have := inputCell_injective n heq + omega + rw [hother (cellReg n (inputTape n) 0) (inputCell_data n 0) hnot] + simp [cellReg, inputTape, cellBase] + exact repairStore_data_zero_internal n captured store + (cellReg n (inputTape n) 0) (inputCell_data n 0) hloopZero + · intro tape position htape + have hdata : cellBase n ≤ cellReg n tape position := by + unfold cellReg + omega + have hnot : ∀ candidate, 0 < candidate → + candidate ≤ x.length → + cellReg n tape position ≠ + cellReg n (inputTape n) candidate := by + intro candidate _ _ heq + have hpairs : (tape, position) = (inputTape n, candidate) := + cellReg_injective_internal (n := n) heq + exact htape (congrArg Prod.fst hpairs) + have hloopZero : store (cellReg n tape position) = 0 := by + rw [hother (cellReg n tape position) hdata hnot] + have hpositiveReg : 0 < cellReg n tape position := by + simp [cellReg, cellBase] + simp [show ¬ cellReg n tape position ≤ 0 by omega] + exact repairStore_data_zero_internal n captured store + (cellReg n tape position) hdata hloopZero + +/-- Exact store after initializing state, heads, and all cell-zero markers. -/ +noncomputable def initializeStore (tm : TM n) + (store : Structured.Store) : Structured.Store := + Structured.Basic.execList (initializeConfigOps tm) store + +private theorem initializeConfigWrites_fst_nodup (tm : TM n) : + ((initializeConfigWrites tm).map Prod.fst).Nodup := by + let heads := (List.finRange (n + 2)).map headReg + let starts := (List.finRange (n + 2)).map fun tape => cellReg n tape 0 + have hheadInjective : Function.Injective (@headReg n) := by + intro left right heq + apply Fin.ext + simp [headReg] at heq + omega + have hstartInjective : Function.Injective + (fun tape : Fin (n + 2) => cellReg n tape 0) := by + intro left right heq + have hpairs : (left, 0) = (right, 0) := + cellReg_injective_internal (n := n) heq + exact congrArg Prod.fst hpairs + have hheads : heads.Nodup := + List.Nodup.map hheadInjective (List.nodup_finRange (n + 2)) + have hstarts : starts.Nodup := + List.Nodup.map hstartInjective (List.nodup_finRange (n + 2)) + have hdisjoint : ∀ head ∈ heads, ∀ start ∈ starts, head ≠ start := by + intro head hhead start hstart heq + simp only [heads, List.mem_map] at hhead + simp only [starts, List.mem_map] at hstart + obtain ⟨headTape, _, rfl⟩ := hhead + obtain ⟨startTape, _, rfl⟩ := hstart + simp [headReg, cellReg, cellBase] at heq + omega + have hcontrol : stateReg ∉ heads ++ starts := by + intro hmem + rw [List.mem_append] at hmem + rcases hmem with hmem | hmem + · simp only [heads, List.mem_map] at hmem + obtain ⟨tape, _, heq⟩ := hmem + simp [stateReg, headReg] at heq + · simp only [starts, List.mem_map] at hmem + obtain ⟨tape, _, heq⟩ := hmem + simp [stateReg, cellReg, cellBase] at heq + have hresult : (stateReg :: heads ++ starts).Nodup := + List.nodup_cons.mpr + ⟨hcontrol, List.nodup_append.mpr ⟨hheads, hstarts, hdisjoint⟩⟩ + simpa [initializeConfigWrites, heads, starts, Function.comp_def] using hresult + +private theorem initializeConfigWrites_cell_pos_not_mem (tm : TM n) + (tape : Fin (n + 2)) (position : ℕ) (hposition : 0 < position) : + cellReg n tape position ∉ (initializeConfigWrites tm).map Prod.fst := by + intro hmem + rw [List.mem_map] at hmem + obtain ⟨write, hwrite, heq⟩ := hmem + simp only [initializeConfigWrites, List.mem_append, List.mem_cons, + List.not_mem_nil, or_false, List.mem_map] at hwrite + rcases hwrite with hstateOrHead | hstart + · rcases hstateOrHead with heqState | hhead + · subst write + simp [stateReg, cellReg, cellBase] at heq + omega + · obtain ⟨headTape, _, rfl⟩ := hhead + simp [headReg, cellReg, cellBase] at heq + omega + · obtain ⟨startTape, _, rfl⟩ := hstart + have hpairs : (tape, position) = (startTape, 0) := + cellReg_injective_internal (n := n) heq.symm + have := congrArg Prod.snd hpairs + omega + +/-- State, head, and left-marker initialization turns repaired tape data into +the complete sparse representation of `tm.initCfg x`. -/ +theorem initializeStore_represents_internal (tm : TM n) (x : List Bool) + (store : Structured.Store) + (hinvariant : MarshalInvariant n x 0 store) : + Represents tm (tm.initCfg x) + (initializeStore tm (repairStore n (capturedInput n x) store)) := by + let repaired := repairStore n (capturedInput n x) store + have hcells := repairStore_cells_internal n x store hinvariant + have hnodup := initializeConfigWrites_fst_nodup tm + intro field + rcases field with state | headOrCell + · rcases state with ⟨state, hstate⟩ + have hstateZero : state = 0 := by omega + subst state + change initializeStore tm repaired stateReg = stateCode tm tm.qstart + unfold initializeStore initializeConfigOps + apply Structured.Internal.Basic.execList_imm_apply_of_mem + (initializeConfigWrites tm) repaired hnodup + simp [initializeConfigWrites] + · rcases headOrCell with tape | cell + · change initializeStore tm repaired (headReg tape) = + (tapeAt (tm.initCfg x) tape).head + have hwrite : initializeStore tm repaired (headReg tape) = 0 := by + unfold initializeStore initializeConfigOps + apply Structured.Internal.Basic.execList_imm_apply_of_mem + (initializeConfigWrites tm) repaired hnodup + simp [initializeConfigWrites] + rw [hwrite] + unfold tapeAt + split + · rfl + · split <;> rfl + · rcases cell with ⟨tape, position⟩ + change initializeStore tm repaired (cellReg n tape position) = + symbolCode ((tapeAt (tm.initCfg x) tape).cells position) + by_cases hposition : position = 0 + · subst position + have hwrite : initializeStore tm repaired (cellReg n tape 0) = + symbolCode Γ.start := by + unfold initializeStore initializeConfigOps + apply Structured.Internal.Basic.execList_imm_apply_of_mem + (initializeConfigWrites tm) repaired hnodup + simp [initializeConfigWrites] + rw [hwrite] + unfold tapeAt + split <;> simp [Tape.init] + · have hpositive : 0 < position := by omega + have hpreserved : initializeStore tm repaired + (cellReg n tape position) = repaired (cellReg n tape position) := by + unfold initializeStore initializeConfigOps + exact Structured.Internal.Basic.execList_imm_apply_of_not_mem + (initializeConfigWrites tm) repaired (cellReg n tape position) + (initializeConfigWrites_cell_pos_not_mem tm tape position hpositive) + rw [hpreserved] + by_cases htape : tape = inputTape n + · subst tape + have hinput := hcells.1 position hpositive + change repaired (cellReg n (inputTape n) position) = _ at hinput + rw [hinput] + simp [tapeAt, inputTape] + · have hblank := hcells.2.2 tape position htape + change repaired (cellReg n tape position) = 0 at hblank + rw [hblank] + unfold tapeAt + split + · rename_i hinput + exfalso + apply htape + apply Fin.ext + simpa [inputTape] using hinput + · split <;> simp [Tape.init, hposition, symbolCode] + +/-- The selected capture-tree leaf executes the fixedValue setup, exact backward +copy, conditional repair, and semantic initialization, ending in a complete +sparse representation of the TM's initial configuration. -/ +theorem marshalLeaf_exec_internal (tm : TM n) (x : List Bool) : + ∃ final steps cost space, + Structured.Exec (marshalLeaf tm (capturedInput n x)) + (initRegs x) final steps cost space ∧ + Represents tm (tm.initCfg x) final := by + obtain ⟨setupCost, setupSpace, hsetup⟩ := + Structured.Internal.exec_basics_exists (marshalConstants n) (initRegs x) + have hstartInvariant := marshalStart_invariant_internal n x + obtain ⟨looped, loopCost, loopSpace, hloop, hloopInvariant⟩ := + marshalLoop_invariant_exec_internal n x x.length (marshalStart n x) + hstartInvariant + obtain ⟨repairSteps, repairCost, repairSpace, hrepair⟩ := + repairCaptured_exec_internal n (capturedInput n x) looped + obtain ⟨initializeCost, initializeSpace, hinitialize⟩ := + Structured.Internal.exec_basics_exists (initializeConfigOps tm) + (repairStore n (capturedInput n x) looped) + have hrepresents := initializeStore_represents_internal tm x looped + hloopInvariant + let repaired := repairStore n (capturedInput n x) looped + let final := initializeStore tm repaired + have htail := Structured.Exec.seq hrepair hinitialize + have hcopy := Structured.Exec.seq hloop htail + have hexec := Structured.Exec.seq hsetup hcopy + refine ⟨final, + (marshalConstants n).length + + (marshalLoopSteps n x.length + + (repairSteps + (initializeConfigOps tm).length)), + setupCost + (loopCost + (repairCost + initializeCost)), + max setupSpace (max loopSpace (max repairSpace initializeSpace)), ?_, ?_⟩ + · simpa [marshalLeaf, capturedInput, marshalStart, repaired, final, + initializeStore] using hexec + · simpa [repaired, final] using hrepresents + +/-- The fixed public-ABI marshaller follows the unique capture-tree path for +the input and establishes the sparse initial TM configuration. -/ +theorem marshalInput_exec_internal (tm : TM n) (x : List Bool) : + ∃ final steps cost space, + Structured.Exec (marshalInput tm) (initRegs x) final steps cost space ∧ + Represents tm (tm.initCfg x) final := by + obtain ⟨final, leafSteps, leafCost, leafSpace, hleaf, hrepresents⟩ := + marshalLeaf_exec_internal tm x + have hselected : ∃ steps cost space, + Structured.Exec + (marshalLeaf tm + (captureValues (initRegs x) (captureRegs n) [])) + (initRegs x) final steps cost space := by + exact ⟨leafSteps, leafCost, leafSpace, by simpa [capturedInput] using hleaf⟩ + obtain ⟨steps, cost, space, hexec⟩ := + marshalInput_exec_of_leaf_internal tm x hselected + exact ⟨final, steps, cost, space, hexec, hrepresents⟩ + +end Sparse + +end TMConfig + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/ABI/Internal/Resources.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/ABI/Internal/Resources.lean new file mode 100644 index 0000000000..0b66d51804 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/ABI/Internal/Resources.lean @@ -0,0 +1,1230 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.ABI.Internal.Decision +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.Step.Internal.Resources + +/-! +# Resource bounds for the public sparse-simulator ABI -- proof internals + +The simulation core uses `StepEnvelope`. During the backward input copy only +the writable value scratch register can temporarily exceed the core word bound; +`MarshalEnvelope` records that exception while retaining the same finite index +support. The first captured-position repair reloads that scratch register from +the sparse data region, returning to the core envelope before simulation. +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace TMConfig + +namespace Sparse + + +/-- Temporary marshalling envelope. Every register except `valueReg` already +fits the core word bound; the value scratch may use the larger `valueLimit`. -/ +structure MarshalEnvelope (tm : TM n) (bound valueLimit : ℕ) + (store : Structured.Store) : Prop where + index_lt : ∀ index, store index ≠ 0 → index < registerBound n (bound + 1) + value_le : ∀ index, store index ≤ valueLimit + value_le_of_ne : ∀ index, index ≠ valueReg n → + store index ≤ wordBound tm bound + +theorem MarshalEnvelope.storeEnvelope {tm : TM n} {bound valueLimit : ℕ} + {store : Structured.Store} (henvelope : MarshalEnvelope tm bound valueLimit store) : + Structured.Internal.StoreEnvelope (registerBound n (bound + 1)) + valueLimit store := + ⟨henvelope.index_lt, henvelope.value_le⟩ + +theorem StepEnvelope.toMarshalEnvelope {tm : TM n} {bound valueLimit : ℕ} + {store : Structured.Store} (henvelope : StepEnvelope tm bound store) + (hlimit : wordBound tm bound ≤ valueLimit) : + MarshalEnvelope tm bound valueLimit store where + index_lt := henvelope.index_lt + value_le index := le_trans (henvelope.value_le index) hlimit + value_le_of_ne index _ := henvelope.value_le index + +private theorem control_lt_registerBound (n bound : ℕ) : + cellBase n < registerBound n (bound + 1) := + control_lt_registerBound_internal n bound + +private theorem smallValue_le_wordBound (tm : TM n) (bound value : ℕ) + (hvalue : value ≤ 4) : value ≤ wordBound tm bound := by + have hfour : 4 ≤ registerBound n (bound + 1) := by + have hcontrol := control_lt_registerBound n bound + simp [cellBase] at hcontrol + omega + exact le_trans hvalue + (le_trans hfour (registerBound_le_wordBound_internal tm bound)) + +private theorem cellReg_le_wordBound (tm : TM n) (bound : ℕ) + (tape : Fin (n + 2)) {position : ℕ} (hposition : position ≤ bound + 1) : + cellReg n tape position ≤ wordBound tm bound := + le_trans (Nat.le_of_lt + (cellReg_lt_registerBound_internal tape (bound := bound) hposition)) + (registerBound_le_wordBound_internal tm bound) + +private theorem registerBound_mono (n : ℕ) {bound larger : ℕ} + (hle : bound ≤ larger) : + registerBound n bound ≤ registerBound n larger := by + have hmul := Nat.mul_le_mul_right (n + 2) hle + simp only [registerBound, cellReg, outputTape, Fin.val_mk] + omega + +private theorem wordBound_mono (tm : TM n) {bound larger : ℕ} + (hle : bound ≤ larger) : wordBound tm bound ≤ wordBound tm larger := by + simp only [wordBound] + apply Nat.max_le.mpr + constructor + · exact le_trans (registerBound_mono n (Nat.add_le_add_right hle 1)) + (Nat.le_max_left _ _) + · apply Nat.max_le.mpr + constructor + · exact le_trans (Nat.le_max_left _ _) (Nat.le_max_right _ _) + · exact le_trans (Nat.add_le_add_right hle 1) + (le_trans (Nat.le_max_right _ _) (Nat.le_max_right _ _)) + +private theorem StepEnvelope.monoBound {tm : TM n} {bound larger : ℕ} + {store : Structured.Store} (henvelope : StepEnvelope tm bound store) + (hle : bound ≤ larger) : StepEnvelope tm larger store := + henvelope.mono + (registerBound_mono n (Nat.add_le_add_right hle 1)) + (wordBound_mono tm hle) + +private theorem spaceBound_mono (tm : TM n) {bound larger : ℕ} + (hle : bound ≤ larger) : spaceBound tm bound ≤ spaceBound tm larger := by + have hregister := registerBound_mono n (Nat.add_le_add_right hle 1) + have hword := wordBound_mono tm hle + have hregisterSize := Nat.size_le_size hregister + have hwordSize := Nat.size_le_size hword + simp only [spaceBound, bitlen] + exact Nat.mul_le_mul hregister + (Nat.add_le_add hregisterSize hwordSize) + +theorem decisionTimeBound_mono_steps_internal (tm : TM n) + (inputLength : ℕ) {steps larger : ℕ} (hle : steps ≤ larger) : + decisionTimeBound tm inputLength steps ≤ + decisionTimeBound tm inputLength larger := by + have hbound : marshalBound n inputLength + steps ≤ + marshalBound n inputLength + larger := Nat.add_le_add_left hle _ + have hword := wordBound_mono tm hbound + have hwidth : wordWidth tm (marshalBound n inputLength + steps) ≤ + wordWidth tm (marshalBound n inputLength + larger) := by + have hsize := Nat.size_le_size hword + simpa [wordWidth, bitlen] using Nat.add_le_add_right hsize 1 + have hfactor : (steps + 1) * runFactor tm ≤ + (larger + 1) * runFactor tm := + Nat.mul_le_mul_right _ (Nat.add_le_add_right hle 1) + simp only [decisionTimeBound] + exact Nat.add_le_add + (Nat.add_le_add_left (Nat.mul_le_mul hfactor hwidth) _) + (Nat.mul_le_mul_left (4 * (extractVerdictOps n).length) hwidth) + +private theorem inputLength_succ_le_marshalBaseBound (n inputLength : ℕ) : + inputLength + 1 ≤ marshalBaseBound n inputLength := by + have hmul : inputLength + 1 ≤ (inputLength + 1) * (n + 2) := + le_mul_of_one_le_right (Nat.zero_le _) (by omega) + simp only [marshalBaseBound, registerBound, cellReg, outputTape, + Fin.val_mk] + omega + +private theorem cellBase_le_marshalBaseBound (n inputLength : ℕ) : + cellBase n ≤ marshalBaseBound n inputLength := by + simp only [marshalBaseBound, registerBound, cellReg, outputTape, + Fin.val_mk] + omega + +private theorem marshalBaseBound_le_wordBound (tm : TM n) + (inputLength : ℕ) : + marshalBaseBound n inputLength ≤ wordBound tm (marshalBound n inputLength) := by + apply le_trans (show marshalBaseBound n inputLength ≤ + marshalBound n inputLength + 1 by simp [marshalBound]; omega) + exact bound_succ_le_wordBound_internal tm (marshalBound n inputLength) + +private theorem marshalValue_le_wordBound (tm : TM n) + {inputLength processed : ℕ} (hprocessed : processed ≤ inputLength) : + marshalBaseBound n inputLength + processed ≤ + wordBound tm (marshalBound n inputLength) := by + apply le_trans (show marshalBaseBound n inputLength + processed ≤ + marshalBound n inputLength + 1 by simp [marshalBound]; omega) + exact bound_succ_le_wordBound_internal tm (marshalBound n inputLength) + +private theorem initRegs_marshalEnvelope (n : ℕ) (x : List Bool) : + Structured.Internal.StoreEnvelope + (registerBound n (marshalBound n x.length + 1)) + (marshalBaseBound n x.length) (initRegs x) := by + have hinput := Structured.Internal.Input.bitStoreEnvelope + (lengthReg := 0) (inputBase := 1) + (indexBound := registerBound n (marshalBound n x.length + 1)) + (valueBound := marshalBaseBound n x.length) x + (by + have hbound := bound_lt_registerBound_internal n + (marshalBound n x.length) + omega) + (by + have hlength := inputLength_succ_le_marshalBaseBound n x.length + have hbound := bound_lt_registerBound_internal n + (marshalBound n x.length) + have hmarshal : 1 + x.length ≤ marshalBound n x.length := by + simp only [marshalBound] + omega + exact Nat.le_of_lt (lt_of_le_of_lt hmarshal hbound)) + (by + have := inputLength_succ_le_marshalBaseBound n x.length + omega) + (by + have := inputLength_succ_le_marshalBaseBound n x.length + omega) + have hinit : initRegs x = Structured.Input.bitStore 0 1 x := by + funext index + by_cases hzero : index = 0 + · subst index + simp [initRegs, Structured.Input.bitStore] + · have hone : 1 ≤ index := Nat.one_le_iff_ne_zero.mpr hzero + simp [initRegs, Structured.Input.bitStore, Structured.Input.bitValue, + hzero, hone] + rfl + rw [hinit] + exact hinput + +/-- Installing the four copy-loop constants has a uniform marshalling +envelope and establishes the semantic loop invariant. -/ +theorem marshalConstants_measured_internal (tm : TM n) (x : List Bool) : + Structured.Internal.MeasuredRuns (.basics (marshalConstants n)) + (initRegs x) (marshalStart n x) (marshalConstants n).length + (4 * (marshalConstants n).length * + Structured.Internal.valueWidth (marshalBaseBound n x.length)) + (Structured.Internal.envelopeSpace + (registerBound n (marshalBound n x.length + 1)) + (marshalBaseBound n x.length)) ∧ + MarshalEnvelope tm (marshalBound n x.length) + (marshalBaseBound n x.length) (marshalStart n x) ∧ + MarshalInvariant n x x.length (marshalStart n x) := by + have hinitial := initRegs_marshalEnvelope n x + have hpreserve : ∀ op, op ∈ marshalConstants n → + ∀ store, Structured.Internal.StoreEnvelope + (registerBound n (marshalBound n x.length + 1)) + (marshalBaseBound n x.length) store → + Structured.Internal.StoreEnvelope + (registerBound n (marshalBound n x.length + 1)) + (marshalBaseBound n x.length) (op.exec store) := by + intro op hop store henvelope + simp [marshalConstants] at hop + rcases hop with rfl | rfl | rfl | rfl + · apply henvelope.execBasic + · exact lt_trans (scratch_range_internal n).1.2 + (control_lt_registerBound n (marshalBound n x.length)) + · simp + · apply henvelope.execBasic + · exact lt_trans (scratch_range_internal n).2.1.2 + (control_lt_registerBound n (marshalBound n x.length)) + · have hbase := cellBase_le_marshalBaseBound n x.length + simp [cellBase] at hbase ⊢ + omega + · apply henvelope.execBasic + · exact lt_trans (scratch_range_internal n).2.2.1.2 + (control_lt_registerBound n (marshalBound n x.length)) + · exact le_trans (by simp [cellBase]; omega) + (cellBase_le_marshalBaseBound n x.length) + · apply henvelope.execBasic + · exact lt_trans (scratch_range_internal n).2.2.2.1.2 + (control_lt_registerBound n (marshalBound n x.length)) + · exact cellBase_le_marshalBaseBound n x.length + have hmeasured := Structured.Internal.MeasuredRuns.basicsEnvelope + (marshalConstants n) (initRegs x) hinitial hpreserve + have hbaseWord := marshalBaseBound_le_wordBound tm x.length + have hmarshal : MarshalEnvelope tm (marshalBound n x.length) + (marshalBaseBound n x.length) (marshalStart n x) := by + have hfinal := hmeasured.2 + exact ⟨hfinal.index_lt, hfinal.value_le, + fun index _ => le_trans (hfinal.value_le index) hbaseWord⟩ + simpa [marshalStart] using And.intro hmeasured.1 + (And.intro hmarshal (marshalStart_invariant_internal n x)) + +private theorem marshalLoopOps_envelopeChain (n : ℕ) (x : List Bool) + {cursor processed : ℕ} {store : Structured.Store} + (hcursor : 0 < cursor) + (hinvariant : MarshalInvariant n x cursor store) + (henvelope : Structured.Internal.StoreEnvelope + (registerBound n (marshalBound n x.length + 1)) + (marshalBaseBound n x.length + processed) store) : + Structured.Internal.Basic.EnvelopeChain + (registerBound n (marshalBound n x.length + 1)) + (marshalBaseBound n x.length + processed + 1) + (marshalLoopOps n) store := by + let limit := marshalBaseBound n x.length + processed + 1 + let sourceAddressed := + (Structured.Basic.add (addressReg n) stateReg (zeroReg n)).exec store + let sourceLoaded := + (Structured.Basic.load (valueReg n) (addressReg n)).exec sourceAddressed + let sourceCleared := + (Structured.Basic.store (addressReg n) (zeroReg n)).exec sourceLoaded + let zeroed := (Structured.Basic.imm (zeroReg n) 0).exec sourceCleared + let oned := (Structured.Basic.imm (oneReg n) 1).exec zeroed + let counted := + (Structured.Basic.imm (tapeCountReg n) (n + 2)).exec oned + let based := + (Structured.Basic.imm (stateScratchReg n) (cellBase n)).exec counted + let encoded := + (Structured.Basic.add (valueReg n) (valueReg n) (oneReg n)).exec based + let multiplied := + (Structured.Basic.mul (addressReg n) stateReg (tapeCountReg n)).exec encoded + let destinationAddressed := + (Structured.Basic.add (addressReg n) (addressReg n) + (stateScratchReg n)).exec multiplied + let destinationStored := + (Structured.Basic.store (addressReg n) (valueReg n)).exec + destinationAddressed + let final := + (Structured.Basic.sub stateReg stateReg (oneReg n)).exec destinationStored + have hindexControl := control_lt_registerBound n (marshalBound n x.length) + have hstore : Structured.Internal.StoreEnvelope + (registerBound n (marshalBound n x.length + 1)) limit store := + henvelope.mono le_rfl (by omega) + have hstate : store stateReg = cursor := hinvariant.1 + have hcursorLength : cursor ≤ x.length := hinvariant.2.1 + have hzero : store (zeroReg n) = 0 := hinvariant.2.2.1 + have hsourceAddressedCurrent : Structured.Internal.StoreEnvelope + (registerBound n (marshalBound n x.length + 1)) + (marshalBaseBound n x.length + processed) + sourceAddressed := by + apply henvelope.execBasic + · exact lt_trans (scratch_range_internal n).2.2.2.2.1.2 hindexControl + · simp [Structured.Internal.Basic.writeValue, hstate, hzero] + exact le_trans hcursorLength + (le_trans (show x.length ≤ marshalBaseBound n x.length by + have := inputLength_succ_le_marshalBaseBound n x.length + omega) (by omega)) + have hsourceAddress : sourceAddressed (addressReg n) = cursor := by + simp [sourceAddressed, Structured.Basic.exec, hstate, hzero] + have hsourceAddressed : Structured.Internal.StoreEnvelope + (registerBound n (marshalBound n x.length + 1)) limit sourceAddressed := + hsourceAddressedCurrent.mono le_rfl (by omega) + have hsourceLoadedCurrent : Structured.Internal.StoreEnvelope + (registerBound n (marshalBound n x.length + 1)) + (marshalBaseBound n x.length + processed) + sourceLoaded := by + apply hsourceAddressedCurrent.execBasic + · exact lt_trans (scratch_range_internal n).2.2.2.2.2.1.2 hindexControl + · exact hsourceAddressedCurrent.value_le _ + have hsourceLoaded : Structured.Internal.StoreEnvelope + (registerBound n (marshalBound n x.length + 1)) limit sourceLoaded := + hsourceLoadedCurrent.mono le_rfl (by omega) + have hloadedAddress : sourceLoaded (addressReg n) = cursor := by + simp only [sourceLoaded, Structured.Basic.exec] + rw [Function.update_of_ne (by simp [addressReg, valueReg])] + exact hsourceAddress + have hloadedZero : sourceLoaded (zeroReg n) = 0 := by + simp only [sourceLoaded, Structured.Basic.exec] + rw [Function.update_of_ne (by simp [zeroReg, valueReg])] + simp only [sourceAddressed, Structured.Basic.exec] + rw [Function.update_of_ne (by simp [zeroReg, addressReg])] + exact hzero + have hsourceClearedCurrent : Structured.Internal.StoreEnvelope + (registerBound n (marshalBound n x.length + 1)) + (marshalBaseBound n x.length + processed) + sourceCleared := by + apply hsourceLoadedCurrent.execBasic + · simp only [Structured.Internal.Basic.writeIndex] + rw [hloadedAddress] + apply lt_of_le_of_lt hcursorLength + apply lt_of_le_of_lt (show x.length ≤ marshalBound n x.length by + simp [marshalBound]) + exact bound_lt_registerBound_internal n (marshalBound n x.length) + · simp [Structured.Internal.Basic.writeValue, hloadedZero] + have hsourceCleared : Structured.Internal.StoreEnvelope + (registerBound n (marshalBound n x.length + 1)) limit sourceCleared := + hsourceClearedCurrent.mono le_rfl (by omega) + have hzeroedCurrent : Structured.Internal.StoreEnvelope + (registerBound n (marshalBound n x.length + 1)) + (marshalBaseBound n x.length + processed) zeroed := by + apply hsourceClearedCurrent.execBasic + · exact lt_trans (scratch_range_internal n).1.2 hindexControl + · simp + have hzeroed : Structured.Internal.StoreEnvelope + (registerBound n (marshalBound n x.length + 1)) limit zeroed := + hzeroedCurrent.mono le_rfl (by omega) + have honedCurrent : Structured.Internal.StoreEnvelope + (registerBound n (marshalBound n x.length + 1)) + (marshalBaseBound n x.length + processed) oned := by + apply hzeroedCurrent.execBasic + · exact lt_trans (scratch_range_internal n).2.1.2 hindexControl + · have hbase := inputLength_succ_le_marshalBaseBound n x.length + simp + omega + have honed : Structured.Internal.StoreEnvelope + (registerBound n (marshalBound n x.length + 1)) limit oned := + honedCurrent.mono le_rfl (by omega) + have hcountedCurrent : Structured.Internal.StoreEnvelope + (registerBound n (marshalBound n x.length + 1)) + (marshalBaseBound n x.length + processed) counted := by + apply honedCurrent.execBasic + · exact lt_trans (scratch_range_internal n).2.2.1.2 hindexControl + · have hbase := cellBase_le_marshalBaseBound n x.length + simp [Structured.Internal.Basic.writeValue, cellBase] at hbase ⊢ + omega + have hcounted : Structured.Internal.StoreEnvelope + (registerBound n (marshalBound n x.length + 1)) limit counted := + hcountedCurrent.mono le_rfl (by omega) + have hbasedCurrent : Structured.Internal.StoreEnvelope + (registerBound n (marshalBound n x.length + 1)) + (marshalBaseBound n x.length + processed) based := by + apply hcountedCurrent.execBasic + · exact lt_trans (scratch_range_internal n).2.2.2.1.2 hindexControl + · exact le_trans (cellBase_le_marshalBaseBound n x.length) (by + simp) + have hbased : Structured.Internal.StoreEnvelope + (registerBound n (marshalBound n x.length + 1)) limit based := + hbasedCurrent.mono le_rfl (by omega) + have hbasedValue : based (valueReg n) ≤ + marshalBaseBound n x.length + processed := + hbasedCurrent.value_le _ + have hbasedOne : based (oneReg n) = 1 := by + simp [based, counted, oned, Structured.Basic.exec, oneReg, + tapeCountReg, stateScratchReg, Function.update_of_ne] + have hencoded : Structured.Internal.StoreEnvelope + (registerBound n (marshalBound n x.length + 1)) limit encoded := by + apply hbased.execBasic + · exact lt_trans (scratch_range_internal n).2.2.2.2.2.1.2 hindexControl + · simp only [Structured.Internal.Basic.writeValue] + rw [hbasedOne] + exact Nat.add_le_add_right hbasedValue 1 + have hsourceAddressedState : sourceAddressed stateReg = cursor := by + simp only [sourceAddressed, Structured.Basic.exec] + rw [Function.update_of_ne (by simp [stateReg, addressReg])] + exact hstate + have hsourceLoadedState : sourceLoaded stateReg = cursor := by + simp only [sourceLoaded, Structured.Basic.exec] + rw [Function.update_of_ne (by simp [stateReg, valueReg])] + exact hsourceAddressedState + have hsourceClearedState : sourceCleared stateReg = cursor := by + simp only [sourceCleared, Structured.Basic.exec] + rw [Function.update_of_ne] + · exact hsourceLoadedState + · rw [hloadedAddress] + simp [stateReg] + omega + have hbasedState : based stateReg = cursor := by + simp only [based, counted, oned, zeroed, Structured.Basic.exec] + rw [Function.update_of_ne (by simp [stateReg, stateScratchReg]), + Function.update_of_ne (by simp [stateReg, tapeCountReg]), + Function.update_of_ne (by simp [stateReg, oneReg]), + Function.update_of_ne (by simp [stateReg, zeroReg])] + exact hsourceClearedState + have hencodedState : encoded stateReg = cursor := by + simp only [encoded, Structured.Basic.exec] + rw [Function.update_of_ne (by simp [stateReg, valueReg])] + exact hbasedState + have hencodedCount : encoded (tapeCountReg n) = n + 2 := by + simp [encoded, based, counted, Structured.Basic.exec, tapeCountReg, + stateScratchReg, valueReg, Function.update_of_ne] + have hcursorCellBase : cursor * (n + 2) + cellBase n ≤ + marshalBaseBound n x.length := by + have hmul := Nat.mul_le_mul_right (n + 2) hcursorLength + have hmulSucc := Nat.mul_le_mul_right (n + 2) + (show x.length ≤ x.length + 1 by omega) + simp only [marshalBaseBound, registerBound, cellReg, outputTape, + Fin.val_mk] + omega + have hmultiplied : Structured.Internal.StoreEnvelope + (registerBound n (marshalBound n x.length + 1)) limit multiplied := by + apply hencoded.execBasic + · exact lt_trans (scratch_range_internal n).2.2.2.2.1.2 hindexControl + · change encoded stateReg * encoded (tapeCountReg n) ≤ limit + rw [hencodedState, hencodedCount] + exact le_trans (show cursor * (n + 2) ≤ + cursor * (n + 2) + cellBase n by omega) + (le_trans hcursorCellBase (by omega)) + have hmultipliedAddress : multiplied (addressReg n) = cursor * (n + 2) := by + simp [multiplied, Structured.Basic.exec, hencodedState, hencodedCount] + have hmultipliedBase : multiplied (stateScratchReg n) = cellBase n := by + simp [multiplied, encoded, based, Structured.Basic.exec, + stateScratchReg, addressReg, valueReg, Function.update_of_ne] + have hdestinationAddressed : Structured.Internal.StoreEnvelope + (registerBound n (marshalBound n x.length + 1)) limit + destinationAddressed := by + apply hmultiplied.execBasic + · exact lt_trans (scratch_range_internal n).2.2.2.2.1.2 hindexControl + · simp only [Structured.Internal.Basic.writeValue] + rw [hmultipliedAddress, hmultipliedBase] + exact le_trans hcursorCellBase (by omega) + have hdestinationAddress : destinationAddressed (addressReg n) = + cellReg n (inputTape n) cursor := by + simp [destinationAddressed, Structured.Basic.exec, hmultipliedAddress, + hmultipliedBase, cellReg, inputTape, Nat.add_comm] + have hdestinationStored : Structured.Internal.StoreEnvelope + (registerBound n (marshalBound n x.length + 1)) limit + destinationStored := by + apply hdestinationAddressed.execBasic + · simp only [Structured.Internal.Basic.writeIndex] + rw [hdestinationAddress] + exact cellReg_lt_registerBound_internal (inputTape n) + (show cursor ≤ marshalBound n x.length + 1 by + simp [marshalBound] + omega) + · exact hdestinationAddressed.value_le _ + have hfinal : Structured.Internal.StoreEnvelope + (registerBound n (marshalBound n x.length + 1)) limit final := by + apply hdestinationStored.execBasic + · simp [stateReg, registerBound, cellReg, outputTape, cellBase] + · exact le_trans (Nat.sub_le _ _) + (hdestinationStored.value_le stateReg) + simp only [marshalLoopOps, Structured.Internal.Basic.EnvelopeChain] + exact ⟨hstore, hsourceAddressed, hsourceLoaded, hsourceCleared, hzeroed, + honed, hcounted, hbased, hencoded, hmultiplied, + hdestinationAddressed, hdestinationStored, hfinal⟩ + +private theorem envelopeChain_monoValue {indexBound valueBound largerValue : ℕ} + {ops : List Structured.Basic} {store : Structured.Store} + (hchain : Structured.Internal.Basic.EnvelopeChain + indexBound valueBound ops store) + (hvalue : valueBound ≤ largerValue) : + Structured.Internal.Basic.EnvelopeChain + indexBound largerValue ops store := by + induction ops generalizing store with + | nil => exact hchain.mono le_rfl hvalue + | cons op rest ih => + exact ⟨hchain.1.mono le_rfl hvalue, ih hchain.2⟩ + +private theorem marshalLoop_measured_aux (n : ℕ) (x : List Bool) + {cursor processed : ℕ} {store : Structured.Store} + (hbalance : processed + cursor = x.length) + (hinvariant : MarshalInvariant n x cursor store) + (henvelope : Structured.Internal.StoreEnvelope + (registerBound n (marshalBound n x.length + 1)) + (marshalBaseBound n x.length + processed) store) : + ∃ final, + Structured.Internal.MeasuredRuns (marshalLoop n) store final + (marshalLoopSteps n cursor) + ((cursor * (3 + 4 * (marshalLoopOps n).length) + 1) * + marshalWidth n x.length) + (marshalSpaceBound n x.length) ∧ + MarshalInvariant n x 0 final ∧ + Structured.Internal.StoreEnvelope + (registerBound n (marshalBound n x.length + 1)) + (marshalBaseBound n x.length + processed + cursor) final := by + induction cursor generalizing processed store with + | zero => + have hzero : store stateReg = 0 := hinvariant.1 + have hglobal : Structured.Internal.StoreEnvelope + (registerBound n (marshalBound n x.length + 1)) + (marshalBound n x.length) store := by + have hp : processed = x.length := by omega + simpa [marshalBound, hp] using henvelope + have hrun := Structured.Internal.MeasuredRuns.whileZeroEnvelope + (body := .basics (marshalLoopOps n)) hzero hglobal + refine ⟨store, ?_, hinvariant, ?_⟩ + · simpa [marshalLoop, marshalLoopSteps, marshalLoopTimeBound, + marshalWidth, marshalSpaceBound, + Structured.Internal.valueWidth, + Structured.Internal.envelopeSpace] using hrun + · simpa using henvelope + | succ cursor ih => + have hpositive : 0 < cursor + 1 := by omega + have hnonzero : store stateReg ≠ 0 := by + rw [hinvariant.1] + omega + have hprocessed : processed + 1 ≤ x.length := by omega + have hchain := marshalLoopOps_envelopeChain n x hpositive hinvariant + henvelope + have hchainGlobal := envelopeChain_monoValue hchain + (show marshalBaseBound n x.length + processed + 1 ≤ + marshalBound n x.length by + simp [marshalBound] + omega) + let middle := Structured.Basic.execList (marshalLoopOps n) store + have hbody := Structured.Internal.MeasuredRuns.basicsEnvelopeChain + (marshalLoopOps n) store hchainGlobal |>.1 + have hmiddleInvariant : MarshalInvariant n x cursor middle := by + have hstep := marshalLoopOps_invariant_internal n x (cursor + 1) + store hpositive hinvariant + simpa [middle] using hstep + have hmiddleEnvelope : Structured.Internal.StoreEnvelope + (registerBound n (marshalBound n x.length + 1)) + (marshalBaseBound n x.length + (processed + 1)) middle := by + have hfinal := hchain.final + simpa [middle, Nat.add_assoc] using hfinal + obtain ⟨final, hloop, hfinalInvariant, hfinalEnvelope⟩ := + ih (processed := processed + 1) (store := middle) + (by omega) hmiddleInvariant hmiddleEnvelope + have hinitialGlobal : Structured.Internal.StoreEnvelope + (registerBound n (marshalBound n x.length + 1)) + (marshalBound n x.length) store := + henvelope.mono le_rfl (by simp [marshalBound]; omega) + have hrun := Structured.Internal.MeasuredRuns.whileNonzeroEnvelope + hnonzero hinitialGlobal hbody hloop + refine ⟨final, ?_, hfinalInvariant, ?_⟩ + · convert hrun using 1 + all_goals simp [marshalLoopSteps, marshalWidth, + Structured.Internal.valueWidth, Nat.succ_mul] + all_goals ring + · convert hfinalEnvelope using 1 + omega + +/-- The backward-copy loop has an exact source-step count, linear logarithmic +cost, and a finite sparse-store envelope. -/ +theorem marshalLoop_measured_internal {tm : TM n} (x : List Bool) : + ∃ final, + Structured.Internal.MeasuredRuns (marshalLoop n) (marshalStart n x) final + (marshalLoopSteps n x.length) (marshalLoopTimeBound n x.length) + (marshalSpaceBound n x.length) ∧ + MarshalInvariant n x 0 final ∧ + StepEnvelope tm (marshalBound n x.length) final := by + obtain ⟨_hconstants, hmarshal, hinvariant⟩ := + marshalConstants_measured_internal tm x + obtain ⟨final, hrun, hfinalInvariant, hfinalEnvelope⟩ := + marshalLoop_measured_aux n x (processed := 0) (store := marshalStart n x) + (by simp) hinvariant hmarshal.storeEnvelope + refine ⟨final, ?_, hfinalInvariant, ?_⟩ + · simpa using hrun + · apply hfinalEnvelope.mono le_rfl + (show marshalBaseBound n x.length + 0 + x.length ≤ + wordBound tm (marshalBound n x.length) by + simpa [marshalBound] using + (marshalValue_le_wordBound tm (processed := x.length) le_rfl)) + +/-- The verdict extractor stays in the core envelope and has the standard +four-width-per-basic-instruction cost bound. -/ +theorem extractVerdict_measured_internal {tm : TM n} {bound : ℕ} + {halted : Complexity.Cfg n tm.Q} {store : Structured.Store} + (hrepresents : Represents tm halted store) + (henvelope : StepEnvelope tm bound store) : + let final := Structured.Basic.execList (extractVerdictOps n) store + Structured.Internal.MeasuredRuns (.basics (extractVerdictOps n)) store final + (extractVerdictOps n).length + (4 * (extractVerdictOps n).length * wordWidth tm bound) + (spaceBound tm bound) ∧ + StepEnvelope tm bound final ∧ + final stateReg = symbolCode (halted.output.cells 1) - 1 := by + let addressed := (Structured.Basic.imm (addressReg n) + (cellReg n (outputTape n) 1)).exec store + let loaded := (Structured.Basic.load stateReg (addressReg n)).exec addressed + let oned := (Structured.Basic.imm (oneReg n) 1).exec loaded + let final := (Structured.Basic.sub stateReg stateReg (oneReg n)).exec oned + have hrange := scratch_range_internal n + have haddressValue := cellReg_le_wordBound tm bound (outputTape n) + (position := 1) (by omega) + have haddressed : StepEnvelope tm bound addressed := by + apply henvelope.execBasic + · exact lt_trans hrange.2.2.2.2.1.2 + (control_lt_registerBound n bound) + · simpa [Structured.Internal.Basic.writeValue] using haddressValue + have hloaded : StepEnvelope tm bound loaded := by + apply haddressed.execBasic + · simp [stateReg, registerBound, cellReg, outputTape, cellBase] + · exact haddressed.value_le (addressed (addressReg n)) + have honeBound : 1 ≤ wordBound tm bound := + smallValue_le_wordBound tm bound 1 (by omega) + have honed : StepEnvelope tm bound oned := by + apply hloaded.execBasic + · exact lt_trans hrange.2.1.2 (control_lt_registerBound n bound) + · simpa [Structured.Internal.Basic.writeValue] using honeBound + have hfinal : StepEnvelope tm bound final := by + apply honed.execBasic + · simp [stateReg, registerBound, cellReg, outputTape, cellBase] + · exact le_trans (Nat.sub_le _ _) (honed.value_le stateReg) + have hchain : Structured.Internal.Basic.EnvelopeChain + (registerBound n (bound + 1)) (wordBound tm bound) + (extractVerdictOps n) store := by + simpa [extractVerdictOps, addressed, loaded, oned, final] using + And.intro henvelope + (And.intro haddressed (And.intro hloaded (And.intro honed hfinal))) + have hmeasured := Structured.Internal.MeasuredRuns.basicsEnvelopeChain + (extractVerdictOps n) store hchain + have hverdict := extractVerdict_exec_internal hrepresents + refine ⟨?_, hfinal, ?_⟩ + · simpa [wordWidth, spaceBound, Structured.Internal.valueWidth, + Structured.Internal.envelopeSpace] using hmeasured.1 + · obtain ⟨_cost, _space, _hexec, hvalue⟩ := hverdict + simpa [final] using hvalue + +private theorem repairBit_measured_internal {tm : TM n} {bound valueLimit : ℕ} + {entry : ℕ × ℕ} {store : Structured.Store} + (hposition : entry.1 ≤ bound + 1) (hvalue : entry.2 ≤ 1) + (henvelope : MarshalEnvelope tm bound valueLimit store) + (hwordLimit : wordBound tm bound ≤ valueLimit) : + ∃ steps, + Structured.Internal.MeasuredRuns (repairBit n entry) store + (repairBitStore n entry store) steps + (27 * (bitlen valueLimit + 1)) + (Structured.Internal.envelopeSpace + (registerBound n (bound + 1)) valueLimit) ∧ + StepEnvelope tm bound (repairBitStore n entry store) := by + let addressed := (Structured.Basic.imm (addressReg n) + (cellReg n (inputTape n) entry.1)).exec store + let loaded := (Structured.Basic.load (valueReg n) (addressReg n)).exec addressed + have hrange := scratch_range_internal n + have haddressBound := cellReg_le_wordBound tm bound (inputTape n) hposition + have haddressedMarshal : MarshalEnvelope tm bound valueLimit addressed := by + refine ⟨?_, ?_, ?_⟩ + · intro index hnonzero + by_cases heq : index = addressReg n + · subst index + exact lt_trans hrange.2.2.2.2.1.2 + (control_lt_registerBound n bound) + · exact henvelope.index_lt index (by + simpa [addressed, Structured.Basic.exec, + Function.update_of_ne heq] using hnonzero) + · intro index + by_cases heq : index = addressReg n + · subst index + simpa [addressed, Structured.Basic.exec] using + le_trans haddressBound hwordLimit + · simpa [addressed, Structured.Basic.exec, + Function.update_of_ne heq] using henvelope.value_le index + · intro index hne + by_cases heq : index = addressReg n + · subst index + simpa [addressed, Structured.Basic.exec] using haddressBound + · simpa [addressed, Structured.Basic.exec, + Function.update_of_ne heq] using henvelope.value_le_of_ne index hne + have haddressedStore := haddressedMarshal.storeEnvelope + have haddress : addressed (addressReg n) = + cellReg n (inputTape n) entry.1 := by + simp [addressed, Structured.Basic.exec] + have haddressNeValue : addressed (addressReg n) ≠ valueReg n := by + rw [haddress] + simp [cellReg, inputTape, cellBase, valueReg] + omega + have hloadedEnvelope : StepEnvelope tm bound loaded := by + constructor + · intro index hnonzero + by_cases heq : index = valueReg n + · subst index + exact lt_trans hrange.2.2.2.2.2.1.2 + (control_lt_registerBound n bound) + · exact haddressedMarshal.index_lt index (by + simpa [loaded, Structured.Basic.exec, + Function.update_of_ne heq] using hnonzero) + · intro index + by_cases heq : index = valueReg n + · subst index + simp only [loaded, Structured.Basic.exec, Function.update_self] + exact haddressedMarshal.value_le_of_ne + (addressed (addressReg n)) haddressNeValue + · simpa [loaded, Structured.Basic.exec, + Function.update_of_ne heq] using + haddressedMarshal.value_le_of_ne index heq + have hloadedLarge := hloadedEnvelope.mono le_rfl hwordLimit + have hsetupChain : Structured.Internal.Basic.EnvelopeChain + (registerBound n (bound + 1)) valueLimit + [.imm (addressReg n) (cellReg n (inputTape n) entry.1), + .load (valueReg n) (addressReg n)] store := by + exact ⟨henvelope.storeEnvelope, haddressedStore, hloadedLarge⟩ + have hsetup := Structured.Internal.MeasuredRuns.basicsEnvelopeChain + [.imm (addressReg n) (cellReg n (inputTape n) entry.1), + .load (valueReg n) (addressReg n)] store hsetupChain |>.1 + by_cases hzero : loaded (valueReg n) = 0 + · have hskip := Structured.Internal.MeasuredRuns.skipEnvelope hloadedLarge + have hbranch := Structured.Internal.MeasuredRuns.ifZeroEnvelope + (onNonzero := .basics + [.imm (valueReg n) (entry.2 + 1), + .store (addressReg n) (valueReg n)]) + hzero hloadedLarge hskip + have hrun := hsetup.seq hbranch + have hrun' := hrun.weakenCost (show + 8 * (bitlen valueLimit + 1) + (bitlen valueLimit + 1) ≤ + 27 * (bitlen valueLimit + 1) by omega) + have hrepairStore : repairBitStore n entry store = loaded := by + unfold repairBitStore + change (if loaded (valueReg n) = 0 then loaded else _) = loaded + rw [if_pos hzero] + refine ⟨3, ?_, ?_⟩ + · rw [hrepairStore] + simpa [repairBit] using hrun' + · rw [hrepairStore] + exact hloadedEnvelope + · let valued := (Structured.Basic.imm (valueReg n) (entry.2 + 1)).exec loaded + let final := (Structured.Basic.store (addressReg n) (valueReg n)).exec valued + have hsmall : entry.2 + 1 ≤ wordBound tm bound := by + apply smallValue_le_wordBound tm bound + omega + have hvalued : StepEnvelope tm bound valued := by + apply hloadedEnvelope.execBasic + · exact lt_trans hrange.2.2.2.2.2.1.2 + (control_lt_registerBound n bound) + · simpa [Structured.Internal.Basic.writeValue] using hsmall + have hvaluedAddress : valued (addressReg n) = + cellReg n (inputTape n) entry.1 := by + simp [valued, loaded, addressed, Structured.Basic.exec, addressReg, + valueReg, Function.update_of_ne] + have hvaluedValue : valued (valueReg n) = entry.2 + 1 := by + simp [valued, Structured.Basic.exec] + have hfinal : StepEnvelope tm bound final := by + apply hvalued.execBasic + · simp only [Structured.Internal.Basic.writeIndex] + rw [hvaluedAddress] + exact cellReg_lt_registerBound_internal (inputTape n) hposition + · simp only [Structured.Internal.Basic.writeValue] + rw [hvaluedValue] + exact hsmall + have hwritesChain : Structured.Internal.Basic.EnvelopeChain + (registerBound n (bound + 1)) valueLimit + [.imm (valueReg n) (entry.2 + 1), + .store (addressReg n) (valueReg n)] loaded := by + exact ⟨hloadedLarge, hvalued.mono le_rfl hwordLimit, + hfinal.mono le_rfl hwordLimit⟩ + have hwrites := Structured.Internal.MeasuredRuns.basicsEnvelopeChain + [.imm (valueReg n) (entry.2 + 1), + .store (addressReg n) (valueReg n)] loaded hwritesChain |>.1 + have hbranch := Structured.Internal.MeasuredRuns.ifNonzeroEnvelope + (onZero := .skip) hzero hloadedLarge hwrites + have hrun := hsetup.seq hbranch + have hrun' := hrun.weakenCost (show + 8 * (bitlen valueLimit + 1) + + (3 * (bitlen valueLimit + 1) + + 8 * (bitlen valueLimit + 1)) ≤ + 27 * (bitlen valueLimit + 1) by omega) + have hrepairStore : repairBitStore n entry store = final := by + unfold repairBitStore + change (if loaded (valueReg n) = 0 then loaded else + Structured.Basic.execList + [.imm (valueReg n) (entry.2 + 1), + .store (addressReg n) (valueReg n)] loaded) = final + rw [if_neg hzero] + rfl + refine ⟨6, ?_, ?_⟩ + · rw [hrepairStore] + simpa [repairBit] using hrun' + · rw [hrepairStore] + exact hfinal + +private theorem repairCaptured_fromStep_measured {tm : TM n} + {bound valueLimit : ℕ} (captured : List (ℕ × ℕ)) + {store : Structured.Store} + (hentries : ∀ entry, entry ∈ captured → + entry.1 ≤ bound + 1 ∧ entry.2 ≤ 1) + (henvelope : StepEnvelope tm bound store) + (hwordLimit : wordBound tm bound ≤ valueLimit) : + ∃ final steps, + Structured.Internal.MeasuredRuns (repairCaptured n captured) store final + steps (captured.length * (27 * (bitlen valueLimit + 1))) + (Structured.Internal.envelopeSpace + (registerBound n (bound + 1)) valueLimit) ∧ + final = repairStore n captured store ∧ StepEnvelope tm bound final := by + induction captured generalizing store with + | nil => + have hskip := Structured.Internal.MeasuredRuns.skipEnvelope + (henvelope.mono le_rfl hwordLimit) + exact ⟨store, 0, by simpa [repairCaptured] using hskip, rfl, henvelope⟩ + | cons entry rest ih => + have hentry := hentries entry (by simp) + obtain ⟨firstSteps, hfirst, hfirstEnvelope⟩ := + repairBit_measured_internal hentry.1 hentry.2 + (henvelope.toMarshalEnvelope hwordLimit) hwordLimit + let first := repairBitStore n entry store + have hrestEntries : ∀ candidate, candidate ∈ rest → + candidate.1 ≤ bound + 1 ∧ candidate.2 ≤ 1 := by + intro candidate hmem + exact hentries candidate (by simp [hmem]) + obtain ⟨final, restSteps, hrest, hrestStore, hfinalEnvelope⟩ := + ih hrestEntries (by simpa [first] using hfirstEnvelope) + have hrun := hfirst.seq hrest + refine ⟨final, firstSteps + restSteps, ?_, ?_, hfinalEnvelope⟩ + · convert hrun using 1 + simp only [List.length_cons] + ring + · simp [repairStore] at hrestStore ⊢ + exact hrestStore + +theorem repairCaptured_measured_internal {tm : TM n} {bound valueLimit : ℕ} + {captured : List (ℕ × ℕ)} {store : Structured.Store} + (hentries : ∀ entry, entry ∈ captured → + entry.1 ≤ bound + 1 ∧ entry.2 ≤ 1) + (hnonempty : captured ≠ []) + (henvelope : MarshalEnvelope tm bound valueLimit store) + (hwordLimit : wordBound tm bound ≤ valueLimit) : + ∃ final steps, + Structured.Internal.MeasuredRuns (repairCaptured n captured) store final + steps (captured.length * (27 * (bitlen valueLimit + 1))) + (Structured.Internal.envelopeSpace + (registerBound n (bound + 1)) valueLimit) ∧ + final = repairStore n captured store ∧ StepEnvelope tm bound final := by + obtain ⟨entry, rest, rfl⟩ := List.exists_cons_of_ne_nil hnonempty + have hentry := hentries entry (by simp) + obtain ⟨firstSteps, hfirst, hfirstEnvelope⟩ := + repairBit_measured_internal hentry.1 hentry.2 henvelope hwordLimit + have hrestEntries : ∀ candidate, candidate ∈ rest → + candidate.1 ≤ bound + 1 ∧ candidate.2 ≤ 1 := by + intro candidate hmem + exact hentries candidate (by simp [hmem]) + obtain ⟨final, restSteps, hrest, hrestStore, hfinalEnvelope⟩ := + repairCaptured_fromStep_measured rest hrestEntries hfirstEnvelope hwordLimit + have hrun := hfirst.seq hrest + refine ⟨final, firstSteps + restSteps, ?_, ?_, hfinalEnvelope⟩ + · convert hrun using 1 + simp only [List.length_cons] + ring + · simp [repairStore] at hrestStore ⊢ + exact hrestStore + +private theorem immWrites_envelopeChain {tm : TM n} {bound : ℕ} + (writes : List (ℕ × ℕ)) {store : Structured.Store} + (hfits : ∀ write, write ∈ writes → + write.1 < registerBound n (bound + 1) ∧ + write.2 ≤ wordBound tm bound) + (henvelope : StepEnvelope tm bound store) : + Structured.Internal.Basic.EnvelopeChain + (registerBound n (bound + 1)) (wordBound tm bound) + (writes.map fun write => Structured.Basic.imm write.1 write.2) store := by + induction writes generalizing store with + | nil => exact henvelope + | cons write rest ih => + have hwrite := hfits write (by simp) + have hnext : StepEnvelope tm bound + ((Structured.Basic.imm write.1 write.2).exec store) := by + apply henvelope.execBasic + · exact hwrite.1 + · simpa [Structured.Internal.Basic.writeValue] using hwrite.2 + have hrestFits : ∀ candidate, candidate ∈ rest → + candidate.1 < registerBound n (bound + 1) ∧ + candidate.2 ≤ wordBound tm bound := by + intro candidate hmem + exact hfits candidate (by simp [hmem]) + exact ⟨henvelope, ih hrestFits hnext⟩ + +private theorem initializeConfigWrite_fits (tm : TM n) (bound : ℕ) + {write : ℕ × ℕ} (hmem : write ∈ initializeConfigWrites tm) : + write.1 < registerBound n (bound + 1) ∧ + write.2 ≤ wordBound tm bound := by + simp only [initializeConfigWrites, List.mem_append, List.mem_cons, + List.not_mem_nil, or_false, List.mem_map] at hmem + rcases hmem with hstateOrHead | hstart + · rcases hstateOrHead with hstate | hhead + · subst write + constructor + · simp [stateReg, registerBound, cellReg, outputTape, cellBase] + · have hcode : stateCode tm tm.qstart < Fintype.card tm.Q := by + simp [stateCode] + exact le_trans (Nat.le_of_lt hcode) + (card_le_wordBound_internal tm bound) + · obtain ⟨tape, _hfin, rfl⟩ := hhead + constructor + · have hcontrol := headReg_lt_control_internal tape + exact lt_of_lt_of_le hcontrol + (le_trans (by simp [cellBase]; omega) + (Nat.le_of_lt (control_lt_registerBound n bound))) + · exact Nat.zero_le _ + · obtain ⟨tape, _hfin, rfl⟩ := hstart + constructor + · exact cellReg_lt_registerBound_internal tape (position := 0) (by omega) + · change symbolCode Γ.start ≤ wordBound tm bound + exact smallValue_le_wordBound tm bound _ (by decide) + +theorem initializeConfigOps_measured_internal {tm : TM n} {bound : ℕ} + {store : Structured.Store} (henvelope : StepEnvelope tm bound store) : + let final := Structured.Basic.execList (initializeConfigOps tm) store + Structured.Internal.MeasuredRuns (.basics (initializeConfigOps tm)) store final + (initializeConfigOps tm).length + (4 * (initializeConfigOps tm).length * wordWidth tm bound) + (spaceBound tm bound) ∧ StepEnvelope tm bound final := by + have hchain := immWrites_envelopeChain (tm := tm) (bound := bound) + (initializeConfigWrites tm) (fun write hmem => + initializeConfigWrite_fits tm bound hmem) henvelope + have hmeasured := Structured.Internal.MeasuredRuns.basicsEnvelopeChain + (initializeConfigOps tm) store (by + simpa [initializeConfigOps] using hchain) + simpa [wordWidth, spaceBound, Structured.Internal.valueWidth, + Structured.Internal.envelopeSpace] using hmeasured + +private theorem captureValues_eq_reverse_append (store : Structured.Store) + (regs : List ℕ) (captured : List (ℕ × ℕ)) : + captureValues store regs captured = + (regs.map (fun reg => (reg, store reg))).reverse ++ captured := by + induction regs generalizing captured with + | nil => simp [captureValues] + | cons reg rest ih => + rw [captureValues, ih] + simp [List.reverse_cons, List.append_assoc] + +private theorem capturedInput_entry (n : ℕ) (x : List Bool) + {entry : ℕ × ℕ} (hmem : entry ∈ capturedInput n x) : + entry.1 ∈ captureRegs n ∧ entry.2 = initRegs x entry.1 := by + rw [capturedInput, captureValues_eq_reverse_append] at hmem + simp only [List.append_nil, List.mem_reverse, List.mem_map] at hmem + obtain ⟨reg, hreg, rfl⟩ := hmem + exact ⟨hreg, rfl⟩ + +private theorem capturedInput_entries_fit (n : ℕ) (x : List Bool) + {bound : ℕ} (hcontrol : valueReg n ≤ bound + 1) : + ∀ entry, entry ∈ capturedInput n x → + entry.1 ≤ bound + 1 ∧ entry.2 ≤ 1 := by + intro entry hmem + have hentry := capturedInput_entry n x hmem + have hposition : entry.1 ≤ valueReg n := by + have hreg := hentry.1 + simp [captureRegs, zeroReg, oneReg, tapeCountReg, stateScratchReg, + addressReg, valueReg] at hreg + rcases hreg with h | h | h | h | h | h + all_goals rw [h] + all_goals simp [valueReg] + have hpositive := captureRegs_positive_internal n hentry.1 + have hbit := initRegs_bool_of_pos_internal x hpositive + constructor + · exact le_trans hposition hcontrol + · rw [hentry.2] + omega + +private theorem capturedInput_nonempty (n : ℕ) (x : List Bool) : + capturedInput n x ≠ [] := by + rw [capturedInput, captureValues_eq_reverse_append] + simp [captureRegs] + +private theorem marshalBaseSpace_le_spaceBound (tm : TM n) + (inputLength : ℕ) : + Structured.Internal.envelopeSpace + (registerBound n (marshalBound n inputLength + 1)) + (marshalBaseBound n inputLength) ≤ + spaceBound tm (marshalBound n inputLength) := by + have hvalue := marshalBaseBound_le_wordBound tm inputLength + have hsize := Nat.size_le_size hvalue + simp only [Structured.Internal.envelopeSpace, spaceBound, bitlen] + exact Nat.mul_le_mul_left _ (Nat.add_le_add_left hsize _) + +private theorem marshalSpace_le_spaceBound (tm : TM n) + (inputLength : ℕ) : + marshalSpaceBound n inputLength ≤ + spaceBound tm (marshalBound n inputLength) := by + have hvalue := marshalValue_le_wordBound tm + (inputLength := inputLength) (processed := inputLength) le_rfl + have hsize := Nat.size_le_size (by + simpa [marshalBound] using hvalue) + simp only [marshalSpaceBound, spaceBound, bitlen] + exact Nat.mul_le_mul_left _ (Nat.add_le_add_left hsize _) + +/-- A selected capture-tree leaf carries the public input through copy, +repair, and initialization within one concrete resource envelope. -/ +theorem marshalLeaf_measured_internal (tm : TM n) (x : List Bool) : + ∃ final steps, + Structured.Internal.MeasuredRuns + (marshalLeaf tm (capturedInput n x)) (initRegs x) final steps + (marshalLeafTimeBound tm x.length) + (spaceBound tm (marshalBound n x.length)) ∧ + Represents tm (tm.initCfg x) final ∧ + StepEnvelope tm (marshalBound n x.length) final := by + obtain ⟨hconstants, _hmarshal, _hstartInvariant⟩ := + marshalConstants_measured_internal tm x + have hconstants' := hconstants.weakenSpace + (marshalBaseSpace_le_spaceBound tm x.length) + obtain ⟨looped, hloop, hloopInvariant, hloopEnvelope⟩ := + marshalLoop_measured_internal (tm := tm) x + have hloop' := hloop.weakenSpace (marshalSpace_le_spaceBound tm x.length) + have hcontrol : valueReg n ≤ marshalBound n x.length + 1 := by + have hrange := (scratch_range_internal n).2.2.2.2.2.1.2 + have hbase := cellBase_le_marshalBaseBound n x.length + simp [marshalBound] at * + omega + have hentries := capturedInput_entries_fit n x hcontrol + have hnonempty := capturedInput_nonempty n x + obtain ⟨repaired, repairSteps, hrepair, hrepairStore, + hrepairEnvelope⟩ := + repairCaptured_measured_internal hentries hnonempty + (hloopEnvelope.toMarshalEnvelope le_rfl) le_rfl + have hrepair' : Structured.Internal.MeasuredRuns + (repairCaptured n (capturedInput n x)) looped repaired repairSteps + ((capturedInput n x).length * + (27 * wordWidth tm (marshalBound n x.length))) + (spaceBound tm (marshalBound n x.length)) := by + simpa [wordWidth, spaceBound, Structured.Internal.envelopeSpace] using + hrepair + subst repaired + let final := Structured.Basic.execList (initializeConfigOps tm) + (repairStore n (capturedInput n x) looped) + obtain ⟨hinitialize, hinitializeEnvelope⟩ := + initializeConfigOps_measured_internal hrepairEnvelope + have hrepresents := initializeStore_represents_internal tm x looped + hloopInvariant + have hrun := hconstants'.seq (hloop'.seq (hrepair'.seq hinitialize)) + refine ⟨final, + (marshalConstants n).length + + (marshalLoopSteps n x.length + + (repairSteps + (initializeConfigOps tm).length)), ?_, ?_, ?_⟩ + · convert hrun using 1 + simp [marshalLeafTimeBound, marshalBaseWidth, + Structured.Internal.valueWidth, capturedInput, + captureValues_eq_reverse_append] + ring + · simpa [final, initializeStore] using hrepresents + · simpa [final] using hinitializeEnvelope + +private theorem captureInput_measured_of_leaf {tm : TM n} (x : List Bool) + (regs : List ℕ) (captured : List (ℕ × ℕ)) + {final : Structured.Store} {leafSteps leafCost : ℕ} + (hbits : ∀ reg, reg ∈ regs → + initRegs x reg = 0 ∨ initRegs x reg = 1) + (hleaf : Structured.Internal.MeasuredRuns + (marshalLeaf tm (captureValues (initRegs x) regs captured)) + (initRegs x) final leafSteps leafCost + (spaceBound tm (marshalBound n x.length))) : + ∃ steps, + Structured.Internal.MeasuredRuns + (captureInput tm regs captured) (initRegs x) final steps + (3 * regs.length * wordWidth tm (marshalBound n x.length) + leafCost) + (spaceBound tm (marshalBound n x.length)) := by + induction regs generalizing captured with + | nil => + exact ⟨leafSteps, by simpa [captureInput, captureValues] using hleaf⟩ + | cons reg rest ih => + have hrestBits : ∀ candidate, candidate ∈ rest → + initRegs x candidate = 0 ∨ initRegs x candidate = 1 := by + intro candidate hmem + exact hbits candidate (by simp [hmem]) + simp only [captureValues] at hleaf + obtain ⟨restSteps, hrest⟩ := ih ((reg, initRegs x reg) :: captured) + hrestBits hleaf + have henvelope := initRegs_envelope_internal tm x + (marshalBound n x.length) (by simp [marshalBound]) + rcases hbits reg (by simp) with hzero | hone + · have hbranch := Structured.Internal.MeasuredRuns.ifZeroEnvelope + (onNonzero := captureInput tm rest ((reg, 1) :: captured)) + hzero henvelope hrest + have hweakened := hbranch.weakenCost (show + wordWidth tm (marshalBound n x.length) + + (3 * rest.length * wordWidth tm (marshalBound n x.length) + + leafCost) ≤ + 3 * (reg :: rest).length * + wordWidth tm (marshalBound n x.length) + leafCost by + simp only [List.length_cons] + have hw : 1 ≤ wordWidth tm (marshalBound n x.length) := by + simp [wordWidth] + calc + wordWidth tm (marshalBound n x.length) + + (3 * rest.length * wordWidth tm (marshalBound n x.length) + + leafCost) ≤ + 3 * wordWidth tm (marshalBound n x.length) + + (3 * rest.length * wordWidth tm (marshalBound n x.length) + + leafCost) := Nat.add_le_add_right (by omega) _ + _ = 3 * (rest.length + 1) * + wordWidth tm (marshalBound n x.length) + leafCost := by ring) + exact ⟨restSteps + 1, by + simpa [captureInput, hzero, spaceBound, + Structured.Internal.envelopeSpace] using hweakened⟩ + · have hnonzero : initRegs x reg ≠ 0 := by omega + have hbranch := Structured.Internal.MeasuredRuns.ifNonzeroEnvelope + (onZero := captureInput tm rest ((reg, 0) :: captured)) + hnonzero henvelope hrest + refine ⟨restSteps + 2, ?_⟩ + convert hbranch using 1 + all_goals simp [captureInput, hone, wordWidth, + Structured.Internal.valueWidth] + all_goals ring + +/-- The full public-input marshaller has a concrete resource certificate and +hands the simulation core an exact sparse representation. -/ +theorem marshalInput_measured_internal (tm : TM n) (x : List Bool) : + ∃ final steps, + Structured.Internal.MeasuredRuns (marshalInput tm) (initRegs x) final + steps (marshalTimeBound tm x.length) + (spaceBound tm (marshalBound n x.length)) ∧ + Represents tm (tm.initCfg x) final ∧ + StepEnvelope tm (marshalBound n x.length) final := by + obtain ⟨final, leafSteps, hleaf, hrepresents, henvelope⟩ := + marshalLeaf_measured_internal tm x + have hselected : Structured.Internal.MeasuredRuns + (marshalLeaf tm + (captureValues (initRegs x) (captureRegs n) [])) + (initRegs x) final leafSteps (marshalLeafTimeBound tm x.length) + (spaceBound tm (marshalBound n x.length)) := by + simpa [capturedInput] using hleaf + have hbits : ∀ reg, reg ∈ captureRegs n → + initRegs x reg = 0 ∨ initRegs x reg = 1 := by + intro reg hmem + have hpositive := captureRegs_positive_internal n hmem + have hbit := initRegs_bool_of_pos_internal x hpositive + omega + obtain ⟨steps, hrun⟩ := captureInput_measured_of_leaf x + (captureRegs n) [] hbits hselected + refine ⟨final, steps, ?_, hrepresents, henvelope⟩ + simpa [marshalInput, marshalTimeBound, Nat.add_comm, Nat.add_left_comm, + Nat.add_assoc] using hrun + +/-- End-to-end public-ABI execution with concrete time and space bounds. -/ +theorem decisionProgram_measured_internal {tm : TM n} {steps : ℕ} + {x : List Bool} {halted : Complexity.Cfg n tm.Q} + (hreach : tm.reachesIn steps (tm.initCfg x) halted) + (hhalted : tm.halted halted) : + ∃ final sourceSteps, + Structured.Internal.MeasuredRuns (decisionProgram tm) (initRegs x) final + sourceSteps (decisionTimeBound tm x.length steps) + (spaceBound tm (marshalBound n x.length + steps)) ∧ + final stateReg = symbolCode (halted.output.cells 1) - 1 := by + obtain ⟨marshaled, marshalSteps, hmarshal, hrepresents, + hmarshalEnvelope⟩ := marshalInput_measured_internal tm x + have hbaseLe : marshalBound n x.length ≤ + marshalBound n x.length + steps := Nat.le_add_right _ _ + have hmarshal' := hmarshal.weakenSpace (spaceBound_mono tm hbaseLe) + have hheads : HeadsBounded (tm.initCfg x) (marshalBound n x.length) := by + intro tape + simp only [tapeAt] + split <;> simp [Tape.init] + have hworkStart : ∀ i, ((tm.initCfg x).work i).cells 0 = Γ.start := by + intro i + simp [Tape.init] + have houtputStart : (tm.initCfg x).output.cells 0 = Γ.start := by + simp [Tape.init] + have hlargeEnvelope := hmarshalEnvelope.monoBound hbaseLe + obtain ⟨simulated, hsimulation, hhaltedRepresents, + hsimulationEnvelope⟩ := + runUntilHalt_measured_internal hreach hhalted hrepresents hheads + hworkStart houtputStart hlargeEnvelope + have hsimulation' := hsimulation.weakenCost + (runTimeBound_le_linear_internal tm (marshalBound n x.length) steps + (tm.initCfg x)) + obtain ⟨hextract, _hextractEnvelope, hverdict⟩ := + extractVerdict_measured_internal hhaltedRepresents hsimulationEnvelope + have hrun := hmarshal'.seq (hsimulation'.seq hextract) + refine ⟨Structured.Basic.execList (extractVerdictOps n) simulated, + marshalSteps + + (runSteps tm steps (tm.initCfg x) + (extractVerdictOps n).length), + ?_, hverdict⟩ + convert hrun using 1 + simp [decisionTimeBound] + ring + +/-- Concrete compiled-RAM transfer of the end-to-end resource certificate. -/ +theorem compiledDecision_resourceBound_internal {tm : TM n} {steps : ℕ} + {x : List Bool} {halted : Complexity.Cfg n tm.Q} + (hreach : tm.reachesIn steps (tm.initCfg x) halted) + (hhalted : tm.halted halted) : + ∃ final sourceSteps cost space, + Structured.Exec (decisionProgram tm) (initRegs x) final + sourceSteps cost space ∧ + cost ≤ decisionTimeBound tm x.length steps ∧ + space ≤ spaceBound tm (marshalBound n x.length + steps) ∧ + run (compiledDecision tm) sourceSteps (initCfg x) = + { pc := (decisionProgram tm).codeSize, regs := final } ∧ + Halted (compiledDecision tm) + (run (compiledDecision tm) sourceSteps (initCfg x)) ∧ + logTimeUpto (compiledDecision tm) sourceSteps (initCfg x) = cost ∧ + spaceUpto (compiledDecision tm) sourceSteps (initCfg x) = space ∧ + final stateReg = symbolCode (halted.output.cells 1) - 1 := by + obtain ⟨final, sourceSteps, hrun, hverdict⟩ := + decisionProgram_measured_internal hreach hhalted + obtain ⟨cost, space, hexec, hcost, hspace⟩ := hrun + have hcompiled := Structured.Exec.compile_correct hexec + refine ⟨final, sourceSteps, cost, space, hexec, hcost, hspace, ?_, ?_, ?_, + ?_, hverdict⟩ + · simpa [compiledDecision, initCfg] using hcompiled.1 + · simpa [compiledDecision, initCfg] using + Structured.Exec.compile_halted hexec + · simpa [compiledDecision, initCfg] using hcompiled.2.1 + · simpa [compiledDecision, initCfg] using hcompiled.2.2 + +end Sparse + +end TMConfig + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Containment.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Containment.lean new file mode 100644 index 0000000000..41f4007a06 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Containment.lean @@ -0,0 +1,67 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.Containment.Internal + +/-! +# TM-to-RAM time-class containment + +The fixed sparse simulator transfers deterministic Turing deciders to +logarithmic-cost RAM deciders through the public input/output ABI. Polynomial +Turing time is therefore contained in polynomial RAM time. +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace TMConfig + +namespace Sparse + + +/-- A deterministic TM time bound transfers to the fixed compiled sparse RAM +simulator through the complete public input/output ABI. -/ +theorem compiledDecision_decidesInTime + {tm : TM n} {L : Language} {T : ℕ → ℕ} + (hdecides : tm.DecidesInTime L T) : + (compiledDecision tm).DecidesInTime L + (fun inputLength => decisionTimeBound tm inputLength (T inputLength)) := + compiledDecision_decidesInTime_internal hdecides + +/-- The explicit transferred bound packages the fixed simulator as a member of +the corresponding RAM time class. -/ +theorem mem_DTIME_of_decidesInTime + {tm : TM n} {L : Language} {T : ℕ → ℕ} + (hdecides : tm.DecidesInTime L T) : + L ∈ RAM.DTIME (fun inputLength => + decisionTimeBound tm inputLength (T inputLength)) := + mem_DTIME_of_decidesInTime_internal hdecides + +/-- Every polynomial-time Turing language is decidable in polynomial +logarithmic-cost RAM time. -/ +theorem P_subset_RAM_P : Complexity.P ⊆ RAM.P := + P_subset_internal + +/-- Every fixed polynomial Turing-time class embeds into polynomial RAM time. -/ +theorem DTIME_pow_subset_RAM_P (degree : ℕ) : + Complexity.DTIME (· ^ degree) ⊆ RAM.P := by + intro L hL + apply P_subset_RAM_P + exact Set.mem_iUnion.mpr ⟨degree, hL⟩ + +end Sparse + +end TMConfig + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Containment/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Containment/Internal.lean new file mode 100644 index 0000000000..c893a7f7ff --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Containment/Internal.lean @@ -0,0 +1,203 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Asymptotics.PolyBound +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.NormalForm +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Classes.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.ABI + +/-! +# TM-to-RAM time-class containment -- proof internals + +This module lifts the checked public-ABI sparse simulation from one halting run +to deciders and then discharges the polynomial-bound arithmetic needed for the +forward machine-model robustness theorem. +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace TMConfig + +namespace Sparse + + +theorem compiledDecision_decidesInTime_internal + {tm : TM n} {L : Language} {T : ℕ → ℕ} + (hdecides : tm.DecidesInTime L T) : + (compiledDecision tm).DecidesInTime L + (fun inputLength => decisionTimeBound tm inputLength (T inputLength)) := by + intro x + obtain ⟨halted, steps, hsteps, hreach, hhalted, hyes, hno⟩ := hdecides x + obtain ⟨final, fuel, cost, _space, _hexec, hcost, _hspace, hrun, + hramHalted, hlogCost, _hspaceExact, hverdict⟩ := + compiledDecision_resourceBound hreach hhalted + refine ⟨fuel, hramHalted, ?_, ?_, ?_⟩ + · rw [hlogCost] + exact le_trans hcost (decisionTimeBound_mono_steps tm x.length hsteps) + · intro hx + rw [hrun] + change final stateReg = 1 + rw [hverdict, hyes hx] + decide + · intro hx + rw [hrun] + change final stateReg = 0 + rw [hverdict, hno hx] + decide + +theorem mem_DTIME_of_decidesInTime_internal + {tm : TM n} {L : Language} {T : ℕ → ℕ} + (hdecides : tm.DecidesInTime L T) : + L ∈ RAM.DTIME (fun inputLength => + decisionTimeBound tm inputLength (T inputLength)) := + ⟨compiledDecision tm, + (fun inputLength => decisionTimeBound tm inputLength (T inputLength)), + compiledDecision_decidesInTime_internal hdecides, BigO.refl _⟩ + +end Sparse + +end TMConfig + +end RAM + +/-! ## Polynomial bounds on the sparse simulation's resource functions + +Extensions of the generic `PolyBound` API of `Complexitylib.Asymptotics.PolyBound` +to the register, word, marshalling, and running-time bounds of this simulation. +They live in the root `PolyBound` namespace so that dot notation reaches them. -/ + +namespace PolyBound + +open RAM RAM.TMConfig.Sparse + +private theorem size_le_self (value : ℕ) : value.size ≤ value := by + rw [Nat.size_le] + exact Nat.lt_pow_self (by decide) + +theorem width {f : ℕ → ℕ} (hf : PolyBound f) : + PolyBound (fun inputLength => bitlen (f inputLength) + 1) := by + apply (hf.add (const 1)).mono + intro inputLength + simpa [bitlen] using Nat.add_le_add_right (size_le_self (f inputLength)) 1 + +theorem registerBound (workTapes : ℕ) {f : ℕ → ℕ} + (hf : PolyBound f) : + PolyBound (fun inputLength => + RAM.TMConfig.Sparse.registerBound workTapes (f inputLength)) := by + have h := (((const (cellBase workTapes)).add + (hf.mul (const (workTapes + 2)))).add (const (workTapes + 1))).add + (const 1) + simpa [RAM.TMConfig.Sparse.registerBound, cellReg, outputTape, + Nat.add_assoc] using h + +theorem wordBound (tm : TM n) {f : ℕ → ℕ} (hf : PolyBound f) : + PolyBound (fun inputLength => + RAM.TMConfig.Sparse.wordBound tm (f inputLength)) := by + have hsucc := hf.add (const 1) + have hregister := registerBound n hsucc + have hcard := const (Fintype.card tm.Q) + simpa only [RAM.TMConfig.Sparse.wordBound] using + hregister.max (hcard.max hsucc) + +theorem wordWidth (tm : TM n) {f : ℕ → ℕ} (hf : PolyBound f) : + PolyBound (fun inputLength => + RAM.TMConfig.Sparse.wordWidth tm (f inputLength)) := by + simpa only [RAM.TMConfig.Sparse.wordWidth] using (wordBound tm hf).width + +theorem marshalBaseBound (workTapes : ℕ) : + PolyBound (fun inputLength => + RAM.TMConfig.Sparse.marshalBaseBound workTapes inputLength) := by + simpa only [RAM.TMConfig.Sparse.marshalBaseBound] using + registerBound workTapes (id.add (const 1)) + +theorem marshalBound (workTapes : ℕ) : + PolyBound (fun inputLength => + RAM.TMConfig.Sparse.marshalBound workTapes inputLength) := by + simpa only [RAM.TMConfig.Sparse.marshalBound] using + (marshalBaseBound workTapes).add id + +theorem marshalBaseWidth (workTapes : ℕ) : + PolyBound (fun inputLength => + RAM.TMConfig.Sparse.marshalBaseWidth workTapes inputLength) := by + simpa only [RAM.TMConfig.Sparse.marshalBaseWidth] using + (marshalBaseBound workTapes).width + +theorem marshalWidth (workTapes : ℕ) : + PolyBound (fun inputLength => + RAM.TMConfig.Sparse.marshalWidth workTapes inputLength) := by + simpa only [RAM.TMConfig.Sparse.marshalWidth] using + (marshalBound workTapes).width + +theorem marshalLoopTimeBound (workTapes : ℕ) : + PolyBound (fun inputLength => + RAM.TMConfig.Sparse.marshalLoopTimeBound workTapes inputLength) := by + have hfactor := (id.mul (const + (3 + 4 * (marshalLoopOps workTapes).length))).add (const 1) + simpa only [RAM.TMConfig.Sparse.marshalLoopTimeBound] using + hfactor.mul (marshalWidth workTapes) + +theorem marshalLeafTimeBound (tm : TM n) : + PolyBound (fun inputLength => + RAM.TMConfig.Sparse.marshalLeafTimeBound tm inputLength) := by + have hconstants := (const (4 * (marshalConstants n).length)).mul + (marshalBaseWidth n) + have hloop := marshalLoopTimeBound n + have hword := wordWidth tm (marshalBound n) + have hrepair := (const ((captureRegs n).length * 27)).mul hword + have hinitialize := (const (4 * (initializeConfigOps tm).length)).mul hword + simpa [RAM.TMConfig.Sparse.marshalLeafTimeBound, Nat.mul_assoc] using + ((hconstants.add hloop).add hrepair).add hinitialize + +theorem marshalTimeBound (tm : TM n) : + PolyBound (fun inputLength => + RAM.TMConfig.Sparse.marshalTimeBound tm inputLength) := by + have hcapture := (const (3 * (captureRegs n).length)).mul + (wordWidth tm (marshalBound n)) + simpa only [RAM.TMConfig.Sparse.marshalTimeBound] using + hcapture.add (marshalLeafTimeBound tm) + +theorem decisionTimeBound (tm : TM n) {T : ℕ → ℕ} (hT : PolyBound T) : + PolyBound (fun inputLength => + RAM.TMConfig.Sparse.decisionTimeBound tm inputLength (T inputLength)) := by + have hbound := (marshalBound n).add hT + have hword := wordWidth tm hbound + have hrun := ((hT.add (const 1)).mul (const (runFactor tm))).mul hword + have hextract := (const (4 * (extractVerdictOps n).length)).mul hword + simpa [RAM.TMConfig.Sparse.decisionTimeBound, Nat.mul_assoc] using + ((marshalTimeBound tm).add hrun).add hextract + +end PolyBound + +namespace RAM + +namespace TMConfig + +namespace Sparse + +theorem P_subset_internal : Complexity.P ⊆ RAM.P := by + intro L hL + obtain ⟨workTapes, tm, p, hdecides⟩ := + mem_P_iff_decidesInTime_polynomial.mp hL + have hram := compiledDecision_decidesInTime_internal hdecides + obtain ⟨q, hq⟩ := PolyBound.decisionTimeBound tm (PolyBound.eval p) + apply Set.mem_iUnion.mpr + exact ⟨q.natDegree, compiledDecision tm, + (fun inputLength => decisionTimeBound tm inputLength (p.eval inputLength)), + hram, BigO.of_polynomial_bound q hq⟩ + +end Sparse + +end TMConfig + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Defs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Defs.lean new file mode 100644 index 0000000000..5aa864f89e --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Defs.lean @@ -0,0 +1,133 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.Defs + +/-! +# Sparse unbounded TM configurations in RAM registers + +This layout is independent of an input-length or time bound. State, heads, and +scratch occupy a fixed prefix determined only by the machine's tape count. +Tape cells are interleaved after that prefix at +`cellBase + position * (n + 2) + tape`. A fixed RAM program can therefore +compute every cell address using multiplication and addition while allocating +new tape positions on demand. +-/ + + +@[expose] public section + +namespace Complexity + +namespace RAM + +namespace TMConfig + +namespace Sparse + + +/-- State field followed by every named head and every named tape cell. -/ +abbrev Field (n : ℕ) := + Fin 1 ⊕ (Fin (n + 2) ⊕ (Fin (n + 2) × ℕ)) + +/-- State register. -/ +def stateReg : ℕ := 0 + +/-- Fixed head register for one named tape. -/ +def headReg (tape : Fin (n + 2)) : ℕ := 1 + tape.val + +/-- Constant-zero scratch register. -/ +def zeroReg (n : ℕ) : ℕ := n + 3 + +/-- Constant-one scratch register. -/ +def oneReg (n : ℕ) : ℕ := n + 4 + +/-- Constant `n + 2`, used to compute interleaved cell addresses. -/ +def tapeCountReg (n : ℕ) : ℕ := n + 5 + +/-- Destructive finite-state dispatch register. -/ +def stateScratchReg (n : ℕ) : ℕ := n + 6 + +/-- Indirect cell-address scratch register. -/ +def addressReg (n : ℕ) : ℕ := n + 7 + +/-- Writable-symbol scratch register. -/ +def valueReg (n : ℕ) : ℕ := n + 8 + +/-- Loaded head-symbol register for one named tape. -/ +def symbolReg (n : ℕ) (tape : Fin (n + 2)) : ℕ := + n + 9 + tape.val + +/-- Exclusive end of the fixed control/scratch prefix and first tape-cell +register. -/ +def cellBase (n : ℕ) : ℕ := 2 * n + 11 + +/-- Address of one tape cell in the fixed interleaved layout. -/ +def cellReg (n : ℕ) (tape : Fin (n + 2)) (position : ℕ) : ℕ := + cellBase n + position * (n + 2) + tape.val + +/-- Concrete address of a sparse configuration field. -/ +def fieldReg : Field n → ℕ + | Sum.inl _ => stateReg + | Sum.inr (Sum.inl tape) => headReg tape + | Sum.inr (Sum.inr (tape, position)) => cellReg n tape position + +/-- Semantic value of one sparse configuration field. -/ +noncomputable def fieldValue (tm : TM n) (cfg : Complexity.Cfg n tm.Q) : + Field n → ℕ + | Sum.inl _ => stateCode tm cfg.state + | Sum.inr (Sum.inl tape) => (tapeAt cfg tape).head + | Sum.inr (Sum.inr (tape, position)) => + symbolCode ((tapeAt cfg tape).cells position) + +/-- A store represents the complete unbounded TM configuration. Scratch +registers in the fixed gap are deliberately unconstrained. -/ +def Represents (tm : TM n) (cfg : Complexity.Cfg n tm.Q) + (store : Structured.Store) : Prop := + ∀ field, store (fieldReg field) = fieldValue tm cfg field + +/-- Decode the tape slot of an interleaved cell register. -/ +def decodeCellTape (n reg : ℕ) : Fin (n + 2) := + ⟨(reg - cellBase n) % (n + 2), Nat.mod_lt _ (by omega)⟩ + +/-- Decode the position of an interleaved cell register. -/ +def decodeCellPosition (n reg : ℕ) : ℕ := + (reg - cellBase n) / (n + 2) + +/-- Canonical sparse register encoding. -/ +noncomputable def encodeRegs (tm : TM n) (cfg : Complexity.Cfg n tm.Q) : + Structured.Store := fun reg => + if hstate : reg = stateReg then stateCode tm cfg.state + else if hhead : reg < n + 3 then + (tapeAt cfg ⟨reg - 1, by omega⟩).head + else if cellBase n ≤ reg then + symbolCode ((tapeAt cfg (decodeCellTape n reg)).cells + (decodeCellPosition n reg)) + else 0 + +/-- Decode one complete sparse tape. -/ +noncomputable def decodeTape (n : ℕ) (store : Structured.Store) + (tape : Fin (n + 2)) : Tape where + head := store (headReg tape) + cells := fun position => symbolDecode (store (cellReg n tape position)) + +/-- Decode a complete sparse store into a TM configuration. -/ +noncomputable def decode (tm : TM n) (store : Structured.Store) : + Complexity.Cfg n tm.Q where + state := stateDecode tm (store stateReg) + input := decodeTape n store ⟨0, by omega⟩ + work := fun i => decodeTape n store ⟨i.val + 1, by omega⟩ + output := decodeTape n store ⟨n + 1, by omega⟩ + +end Sparse + +end TMConfig + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Internal.lean new file mode 100644 index 0000000000..c532b4bef0 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Internal.lean @@ -0,0 +1,291 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Internal + +/-! +# Sparse unbounded TM configuration encoding -- proof internals +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace TMConfig + +namespace Sparse + + +theorem control_lt_cellBase_internal (n : ℕ) : + valueReg n < cellBase n ∧ ∀ tape, symbolReg n tape < cellBase n := by + constructor + · simp [valueReg, cellBase] + omega + · intro tape + simp [symbolReg, cellBase] + omega + +theorem headReg_lt_control_internal (tape : Fin (n + 2)) : + headReg tape < n + 3 := by + simp [headReg] + omega + +theorem cellBase_le_cellReg_internal (tape : Fin (n + 2)) (position : ℕ) : + cellBase n ≤ cellReg n tape position := by + simp [cellReg] + omega + +private theorem headPrefix_lt_cellBase (n : ℕ) : n + 3 < cellBase n := by + simp [cellBase] + omega + +theorem decodeCellTape_cellReg_internal (tape : Fin (n + 2)) (position : ℕ) : + decodeCellTape n (cellReg n tape position) = tape := by + have hoffset : cellReg n tape position - cellBase n = + position * (n + 2) + tape.val := by + simp [cellReg] + omega + apply Fin.ext + change (cellReg n tape position - cellBase n) % (n + 2) = tape.val + rw [hoffset] + simp [Nat.add_mod, Nat.mod_eq_of_lt tape.isLt] + +theorem decodeCellPosition_cellReg_internal (tape : Fin (n + 2)) + (position : ℕ) : + decodeCellPosition n (cellReg n tape position) = position := by + have hoffset : cellReg n tape position - cellBase n = + position * (n + 2) + tape.val := by + simp [cellReg] + omega + rw [decodeCellPosition, hoffset, Nat.add_comm, + Nat.add_mul_div_right tape.val position (by omega), + Nat.div_eq_of_lt tape.isLt, Nat.zero_add] + +theorem cellReg_injective_internal : + Function.Injective (fun field : Fin (n + 2) × ℕ => + cellReg n field.1 field.2) := by + intro first second heq + have htape := congrArg (decodeCellTape n) heq + have hposition := congrArg (decodeCellPosition n) heq + rw [decodeCellTape_cellReg_internal, decodeCellTape_cellReg_internal] at htape + rw [decodeCellPosition_cellReg_internal, + decodeCellPosition_cellReg_internal] at hposition + exact Prod.ext htape hposition + +theorem fieldReg_injective_internal : Function.Injective (@fieldReg n) := by + intro first second heq + rcases first with state | headOrCell + · rcases state with ⟨state, hstate⟩ + have hzero : state = 0 := by omega + subst state + rcases second with state' | headOrCell' + · rcases state' with ⟨state', hstate'⟩ + have hzero' : state' = 0 := by omega + subst state' + rfl + · rcases headOrCell' with tape | cell + · simp [fieldReg, stateReg, headReg] at heq + omega + · rcases cell with ⟨tape, position⟩ + have hbase := cellBase_le_cellReg_internal tape position + simp [fieldReg, stateReg, cellBase] at heq hbase + omega + · rcases headOrCell with tape | cell + · rcases second with state' | headOrCell' + · rcases state' with ⟨state', hstate'⟩ + have hzero : state' = 0 := by omega + subst state' + simp [fieldReg, stateReg, headReg] at heq + · rcases headOrCell' with tape' | cell' + · apply congrArg Sum.inr + apply congrArg Sum.inl + apply Fin.ext + simp [fieldReg, headReg] at heq + omega + · rcases cell' with ⟨tape', position'⟩ + have hhead := headReg_lt_control_internal tape + have hcell := cellBase_le_cellReg_internal tape' position' + have hcontrol := headPrefix_lt_cellBase n + simp [fieldReg] at heq + omega + · rcases cell with ⟨tape, position⟩ + rcases second with state' | headOrCell' + · rcases state' with ⟨state', hstate'⟩ + have hzero : state' = 0 := by omega + subst state' + have hcell := cellBase_le_cellReg_internal tape position + simp [fieldReg, stateReg, cellBase] at heq hcell + omega + · rcases headOrCell' with tape' | cell' + · have hhead := headReg_lt_control_internal tape' + have hcell := cellBase_le_cellReg_internal tape position + simp [fieldReg, cellBase] at heq hcell + omega + · rcases cell' with ⟨tape', position'⟩ + have hpairs : (tape, position) = (tape', position') := + cellReg_injective_internal heq + exact congrArg (fun pair => Sum.inr (Sum.inr pair)) hpairs + +theorem fieldReg_ne_control_internal (field : Field n) {reg : ℕ} + (hlow : n + 3 ≤ reg) (hhigh : reg < cellBase n) : + fieldReg field ≠ reg := by + intro heq + rcases field with state | headOrCell + · rcases state with ⟨state, hstate⟩ + have hzero : state = 0 := by omega + subst state + simp [fieldReg, stateReg] at heq + omega + · rcases headOrCell with tape | cell + · have hhead := headReg_lt_control_internal tape + simp [fieldReg] at heq + omega + · have hcell := cellBase_le_cellReg_internal cell.1 cell.2 + simp [fieldReg] at heq + omega + +theorem Represents.update_control_internal {tm : TM n} + {cfg : Complexity.Cfg n tm.Q} {store : Structured.Store} {reg value : ℕ} + (hrepresents : Represents tm cfg store) + (hlow : n + 3 ≤ reg) (hhigh : reg < cellBase n) : + Represents tm cfg (Function.update store reg value) := by + intro field + rw [Function.update_of_ne (fieldReg_ne_control_internal field hlow hhigh)] + exact hrepresents field + +theorem scratch_range_internal (n : ℕ) : + (n + 3 ≤ zeroReg n ∧ zeroReg n < cellBase n) ∧ + (n + 3 ≤ oneReg n ∧ oneReg n < cellBase n) ∧ + (n + 3 ≤ tapeCountReg n ∧ tapeCountReg n < cellBase n) ∧ + (n + 3 ≤ stateScratchReg n ∧ stateScratchReg n < cellBase n) ∧ + (n + 3 ≤ addressReg n ∧ addressReg n < cellBase n) ∧ + (n + 3 ≤ valueReg n ∧ valueReg n < cellBase n) ∧ + ∀ tape, n + 3 ≤ symbolReg n tape ∧ symbolReg n tape < cellBase n := by + constructor + · simp [zeroReg, cellBase] + omega + constructor + · simp [oneReg, cellBase] + omega + constructor + · simp [tapeCountReg, cellBase] + omega + constructor + · simp [stateScratchReg, cellBase] + omega + constructor + · simp [addressReg, cellBase] + omega + constructor + · simp [valueReg, cellBase] + omega + · intro tape + have htape := tape.isLt + simp [symbolReg, cellBase] + omega + +theorem encodeRegs_state_internal (tm : TM n) (cfg : Complexity.Cfg n tm.Q) : + encodeRegs tm cfg stateReg = stateCode tm cfg.state := by + simp [encodeRegs, stateReg] + +theorem encodeRegs_head_internal (tm : TM n) (cfg : Complexity.Cfg n tm.Q) + (tape : Fin (n + 2)) : + encodeRegs tm cfg (headReg tape) = (tapeAt cfg tape).head := by + have hstate : headReg tape ≠ stateReg := by + simp [headReg, stateReg] + rw [encodeRegs, dif_neg hstate, + dif_pos (headReg_lt_control_internal tape)] + congr 2 + apply Fin.ext + simp [headReg] + +theorem encodeRegs_cell_internal (tm : TM n) (cfg : Complexity.Cfg n tm.Q) + (tape : Fin (n + 2)) (position : ℕ) : + encodeRegs tm cfg (cellReg n tape position) = + symbolCode ((tapeAt cfg tape).cells position) := by + have hbase := cellBase_le_cellReg_internal tape position + have hcontrol := headPrefix_lt_cellBase n + have hnotState : cellReg n tape position ≠ stateReg := by + simp [stateReg] + omega + have hnotHead : ¬ cellReg n tape position < n + 3 := by omega + rw [encodeRegs, dif_neg hnotState, dif_neg hnotHead, if_pos hbase, + decodeCellTape_cellReg_internal, decodeCellPosition_cellReg_internal] + +theorem encodeRegs_represents_internal (tm : TM n) + (cfg : Complexity.Cfg n tm.Q) : Represents tm cfg (encodeRegs tm cfg) := by + intro field + rcases field with state | headOrCell + · rcases state with ⟨state, hstate⟩ + have hzero : state = 0 := by omega + subst state + exact encodeRegs_state_internal tm cfg + · rcases headOrCell with tape | cell + · exact encodeRegs_head_internal tm cfg tape + · exact encodeRegs_cell_internal tm cfg cell.1 cell.2 + +theorem decode_of_represents_internal (tm : TM n) + (cfg : Complexity.Cfg n tm.Q) (store : Structured.Store) + (hrepresents : Represents tm cfg store) : decode tm store = cfg := by + apply Complexity.Cfg.ext + · simp only [decode] + have hstate := hrepresents (Sum.inl ⟨0, by omega⟩) + change store stateReg = stateCode tm cfg.state at hstate + rw [hstate] + exact stateDecode_code_internal tm cfg.state + · apply Tape.ext + · simpa [decode, decodeTape, tapeAt_input_internal] using + hrepresents (Sum.inr (Sum.inl ⟨0, by omega⟩)) + · funext position + simp only [decode, decodeTape] + have hcell := hrepresents + (Sum.inr (Sum.inr (⟨0, by omega⟩, position))) + change store (cellReg n ⟨0, by omega⟩ position) = + symbolCode ((tapeAt cfg ⟨0, by omega⟩).cells position) at hcell + rw [hcell, symbolDecode_code_internal, tapeAt_input_internal] + · funext i + apply Tape.ext + · have hhead := hrepresents (Sum.inr (Sum.inl ⟨i.val + 1, by omega⟩)) + change store (headReg ⟨i.val + 1, by omega⟩) = + (tapeAt cfg ⟨i.val + 1, by omega⟩).head at hhead + simpa [decode, decodeTape, tapeAt_work_internal] using hhead + · funext position + simp only [decode, decodeTape] + have hcell := hrepresents + (Sum.inr (Sum.inr (⟨i.val + 1, by omega⟩, position))) + change store (cellReg n ⟨i.val + 1, by omega⟩ position) = + symbolCode ((tapeAt cfg ⟨i.val + 1, by omega⟩).cells position) at hcell + rw [hcell, symbolDecode_code_internal, tapeAt_work_internal] + · apply Tape.ext + · have hhead := hrepresents (Sum.inr (Sum.inl ⟨n + 1, by omega⟩)) + change store (headReg ⟨n + 1, by omega⟩) = + (tapeAt cfg ⟨n + 1, by omega⟩).head at hhead + simpa [decode, decodeTape, tapeAt_output_internal] using hhead + · funext position + simp only [decode, decodeTape] + have hcell := hrepresents + (Sum.inr (Sum.inr (⟨n + 1, by omega⟩, position))) + change store (cellReg n ⟨n + 1, by omega⟩ position) = + symbolCode ((tapeAt cfg ⟨n + 1, by omega⟩).cells position) at hcell + rw [hcell, symbolDecode_code_internal, tapeAt_output_internal] + +theorem decode_encode_internal (tm : TM n) (cfg : Complexity.Cfg n tm.Q) : + decode tm (encodeRegs tm cfg) = cfg := + decode_of_represents_internal tm cfg (encodeRegs tm cfg) + (encodeRegs_represents_internal tm cfg) + +end Sparse + +end TMConfig + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Step.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Step.lean new file mode 100644 index 0000000000..05c18eb005 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Step.lean @@ -0,0 +1,354 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.Step.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.Step.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured +public import LeanPool.BeyondBethe.Complexitylib.Asymptotics +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse + +/-! +# A fixed sparse-RAM block for one Turing-machine transition + +The generated program depends only on the Turing machine. Its interleaved +layout computes cell addresses at runtime, so no tape or time bound is baked +into the program. The exact address/loading layers, selected action, complete +nested dispatch, fixed iteration controller, and transfer to concrete compiled +RAM execution are checked. The separate `Sparse.ABI` surface supplies the +public input/output marshalling layer. +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace TMConfig + +namespace Sparse + + +/-- Computing a named tape's current-cell address preserves the represented +configuration and returns the exact sparse cell register. -/ +theorem addressOps_correct {tm : TM n} {cfg : Complexity.Cfg n tm.Q} + {store : Structured.Store} (hrepresents : Represents tm cfg store) + (tape : Fin (n + 2)) (htapeCount : store (tapeCountReg n) = n + 2) : + let final := Structured.Basic.execList (addressOps n tape) store + Represents tm cfg final ∧ + final (addressReg n) = cellReg n tape (tapeAt cfg tape).head := + ⟨addressOps_represents_internal hrepresents tape, + addressOps_address_internal hrepresents tape htapeCount⟩ + +/-- The fixed loading prelude preserves the complete sparse representation, +initializes its constants, and recovers the state and every head symbol. -/ +theorem loadOps_correct {tm : TM n} {cfg : Complexity.Cfg n tm.Q} + {store : Structured.Store} (hrepresents : Represents tm cfg store) : + let final := Structured.Basic.execList (loadOps n) store + Represents tm cfg final ∧ + final (zeroReg n) = 0 ∧ + final (oneReg n) = 1 ∧ + final (tapeCountReg n) = n + 2 ∧ + final (stateScratchReg n) = stateCode tm cfg.state ∧ + ∀ tape, final (symbolReg n tape) = symbolCode (readSymbols cfg tape) := + loadOps_loaded_internal hrepresents + +/-- Once the loaded finite state and symbols select an action, the fixed sparse +operations represent the exact TM successor. -/ +theorem actionOps_correct {tm : TM n} + {cfg next : Complexity.Cfg n tm.Q} {store : Structured.Store} + (hstep : tm.step cfg = some next) + (hrepresents : Represents tm cfg store) + (hworkStart : ∀ i, (cfg.work i).StartInvariant) + (houtputStart : cfg.output.StartInvariant) + (hone : store (oneReg n) = 1) + (htapeCount : store (tapeCountReg n) = n + 2) : + Represents tm next + (Structured.Basic.execList + (actionOps tm cfg.state (readSymbols cfg)) store) := + actionOps_represents_internal hstep hrepresents + (fun i => (hworkStart i).1) houtputStart.1 hone htapeCount + +/-- The fixed structured program, determined solely by `tm`, performs exactly +one nonhalting TM transition with the advertised source instruction count. -/ +theorem program_correct {tm : TM n} + {cfg next : Complexity.Cfg n tm.Q} {store : Structured.Store} + (hstep : tm.step cfg = some next) + (hrepresents : Represents tm cfg store) + (hworkStart : ∀ i, (cfg.work i).StartInvariant) + (houtputStart : cfg.output.StartInvariant) : + ∃ final cost space, + Structured.Exec (program tm) store final + (stepCount tm cfg) cost space ∧ + Represents tm next final := + program_exec_internal hstep hrepresents + (fun i => (hworkStart i).1) houtputStart.1 + +/-- The complete fixed source block decodes to the exact successor without a +tape-window premise. -/ +theorem program_decodes {tm : TM n} + {cfg next : Complexity.Cfg n tm.Q} {store : Structured.Store} + (hstep : tm.step cfg = some next) + (hrepresents : Represents tm cfg store) + (hworkStart : ∀ i, (cfg.work i).StartInvariant) + (houtputStart : cfg.output.StartInvariant) : + ∃ final cost space, + Structured.Exec (program tm) store final + (stepCount tm cfg) cost space ∧ + decode tm final = next := by + obtain ⟨final, cost, space, hexec, hfinal⟩ := + program_correct hstep hrepresents hworkStart houtputStart + exact ⟨final, cost, space, hexec, + decode_of_represents tm next final hfinal⟩ + +/-- Exact transfer of the uniform one-step theorem to the concrete compiled +RAM block, including the compiler's logarithmic cost and peak space. -/ +theorem compiled_correct {tm : TM n} + {cfg next : Complexity.Cfg n tm.Q} {store : Structured.Store} + (hstep : tm.step cfg = some next) + (hrepresents : Represents tm cfg store) + (hworkStart : ∀ i, (cfg.work i).StartInvariant) + (houtputStart : cfg.output.StartInvariant) : + ∃ final cost space, + Structured.Exec (program tm) store final + (stepCount tm cfg) cost space ∧ + run (compiled tm) (stepCount tm cfg) { pc := 0, regs := store } = + { pc := (program tm).codeSize, regs := final } ∧ + Halted (compiled tm) + (run (compiled tm) (stepCount tm cfg) { pc := 0, regs := store }) ∧ + logTimeUpto (compiled tm) (stepCount tm cfg) + { pc := 0, regs := store } = cost ∧ + spaceUpto (compiled tm) (stepCount tm cfg) + { pc := 0, regs := store } = space ∧ + decode tm final = next := by + obtain ⟨final, cost, space, hexec, hfinal⟩ := + program_correct hstep hrepresents hworkStart houtputStart + have hcompiled := Structured.Exec.compile_correct hexec + refine ⟨final, cost, space, hexec, ?_, ?_, ?_, ?_, + decode_of_represents tm next final hfinal⟩ + · simpa [compiled] using hcompiled.1 + · simpa [compiled] using Structured.Exec.compile_halted hexec + · simpa [compiled] using hcompiled.2.1 + · simpa [compiled] using hcompiled.2.2 + +/-- The fixed loop controller follows any exact halting TM run and retains a +complete representation of its halted configuration. -/ +theorem runUntilHalt_correct {tm : TM n} {steps : ℕ} + {cfg halted : Complexity.Cfg n tm.Q} {store : Structured.Store} + (hreach : tm.reachesIn steps cfg halted) + (hhalted : tm.halted halted) + (hrepresents : Represents tm cfg store) + (hworkStart : ∀ i, (cfg.work i).StartInvariant) + (houtputStart : cfg.output.StartInvariant) : + ∃ final cost space, + Structured.Exec (runUntilHalt tm) store final + (runSteps tm steps cfg) cost space ∧ + Represents tm halted final := + runUntilHalt_exec_internal hreach hhalted hrepresents + (fun i => (hworkStart i).1) houtputStart.1 + +/-- The same fixed loop decodes to the exact halted TM configuration. -/ +theorem runUntilHalt_decodes {tm : TM n} {steps : ℕ} + {cfg halted : Complexity.Cfg n tm.Q} {store : Structured.Store} + (hreach : tm.reachesIn steps cfg halted) + (hhalted : tm.halted halted) + (hrepresents : Represents tm cfg store) + (hworkStart : ∀ i, (cfg.work i).StartInvariant) + (houtputStart : cfg.output.StartInvariant) : + ∃ final cost space, + Structured.Exec (runUntilHalt tm) store final + (runSteps tm steps cfg) cost space ∧ + decode tm final = halted := by + obtain ⟨final, cost, space, hexec, hfinal⟩ := + runUntilHalt_correct hreach hhalted hrepresents hworkStart houtputStart + exact ⟨final, cost, space, hexec, + decode_of_represents tm halted final hfinal⟩ + +/-- Exact compiled-RAM transfer for the complete fixed simulation loop. -/ +theorem compiledUntilHalt_correct {tm : TM n} {steps : ℕ} + {cfg halted : Complexity.Cfg n tm.Q} {store : Structured.Store} + (hreach : tm.reachesIn steps cfg halted) + (hhalted : tm.halted halted) + (hrepresents : Represents tm cfg store) + (hworkStart : ∀ i, (cfg.work i).StartInvariant) + (houtputStart : cfg.output.StartInvariant) : + ∃ final cost space, + Structured.Exec (runUntilHalt tm) store final + (runSteps tm steps cfg) cost space ∧ + run (compiledUntilHalt tm) (runSteps tm steps cfg) + { pc := 0, regs := store } = + { pc := (runUntilHalt tm).codeSize, regs := final } ∧ + Halted (compiledUntilHalt tm) + (run (compiledUntilHalt tm) (runSteps tm steps cfg) + { pc := 0, regs := store }) ∧ + logTimeUpto (compiledUntilHalt tm) (runSteps tm steps cfg) + { pc := 0, regs := store } = cost ∧ + spaceUpto (compiledUntilHalt tm) (runSteps tm steps cfg) + { pc := 0, regs := store } = space ∧ + decode tm final = halted := by + obtain ⟨final, cost, space, hexec, hfinal⟩ := + runUntilHalt_correct hreach hhalted hrepresents hworkStart houtputStart + have hcompiled := Structured.Exec.compile_correct hexec + refine ⟨final, cost, space, hexec, ?_, ?_, ?_, ?_, + decode_of_represents tm halted final hfinal⟩ + · simpa [compiledUntilHalt] using hcompiled.1 + · simpa [compiledUntilHalt] using Structured.Exec.compile_halted hexec + · simpa [compiledUntilHalt] using hcompiled.2.1 + · simpa [compiledUntilHalt] using hcompiled.2.2 + +/-- Quantitative one-step theorem for the fixed sparse program. The exact +source step count, logarithmic time, and peak sparse-store space are all +checked against one explicit envelope. -/ +theorem program_resourceBound {tm : TM n} {bound : ℕ} + {cfg next : Complexity.Cfg n tm.Q} {store : Structured.Store} + (hstep : tm.step cfg = some next) + (hrepresents : Represents tm cfg store) + (hheads : HeadsBounded cfg bound) + (hworkStart : ∀ i, (cfg.work i).StartInvariant) + (houtputStart : cfg.output.StartInvariant) + (henvelope : StepEnvelope tm bound store) : + ∃ final, + Structured.Internal.MeasuredRuns (program tm) store final + (stepCount tm cfg) (timeBound tm bound cfg) (spaceBound tm bound) ∧ + Represents tm next final ∧ StepEnvelope tm bound final := + program_measured_internal hstep hrepresents hheads + (fun i => (hworkStart i).1) houtputStart.1 henvelope + +/-- Quantitative iteration theorem for the fixed sparse simulator. Starting +with heads bounded by `base`, `steps` transitions fit one envelope at +`base + steps`; costs compose into `runTimeBound`. -/ +theorem runUntilHalt_resourceBound {tm : TM n} {steps base : ℕ} + {cfg halted : Complexity.Cfg n tm.Q} {store : Structured.Store} + (hreach : tm.reachesIn steps cfg halted) + (hhalted : tm.halted halted) + (hrepresents : Represents tm cfg store) + (hheads : HeadsBounded cfg base) + (hworkStart : ∀ i, (cfg.work i).StartInvariant) + (houtputStart : cfg.output.StartInvariant) + (henvelope : StepEnvelope tm (base + steps) store) : + ∃ final, + Structured.Internal.MeasuredRuns (runUntilHalt tm) store final + (runSteps tm steps cfg) (runTimeBound tm base steps cfg) + (spaceBound tm (base + steps)) ∧ + Represents tm halted final ∧ + StepEnvelope tm (base + steps) final := + runUntilHalt_measured_internal hreach hhalted hrepresents hheads + (fun i => (hworkStart i).1) houtputStart.1 henvelope + +/-- The accumulated exact cost expression is linear in the number of simulated +steps and logarithmic in the common sparse word bound. -/ +theorem runTimeBound_le_linear (tm : TM n) (base steps : ℕ) + (cfg : Complexity.Cfg n tm.Q) : + runTimeBound tm base steps cfg ≤ + ((steps + 1) * runFactor tm) * wordWidth tm (base + steps) := + runTimeBound_le_linear_internal tm base steps cfg + +/-- Sparse word width is logarithmic in the head allowance; all dependence on +the fixed machine is absorbed into the big-O constant. -/ +theorem wordWidth_bigO_log (tm : TM n) : + (fun bound => wordWidth tm bound) =O (fun bound => Nat.log 2 bound) := by + let C := cellBase n + 3 * n + 10 + Fintype.card tm.Q + let p : Polynomial ℕ := Polynomial.C C * Polynomial.X + Polynomial.C C + have hword : ∀ bound, wordBound tm bound ≤ p.eval bound := by + intro bound + have hcoef : n + 2 ≤ C := by + simp [C, cellBase] + omega + have hconstant : cellBase n + (n + 2) + (n + 1) + 1 ≤ C := by + simp [C] + omega + have hregister : registerBound n (bound + 1) ≤ C * bound + C := by + rw [registerBound, cellReg] + simp only [outputTape] + have hproduct := Nat.mul_le_mul_left bound hcoef + have hproduct' : bound * (n + 2) ≤ C * bound := by + simpa [Nat.mul_comm] using hproduct + rw [show (bound + 1) * (n + 2) = bound * (n + 2) + (n + 2) by ring] + omega + have hcard : Fintype.card tm.Q ≤ C * bound + C := by + have hle : Fintype.card tm.Q ≤ C := by + simp [C] + omega + have hbound : bound + 1 ≤ C * bound + C := by + have hone : 1 ≤ C := by + simp [C, cellBase] + omega + have hmul := Nat.mul_le_mul_left bound hone + have hmul' : bound ≤ C * bound := by + simpa [Nat.mul_comm] using hmul + omega + simp only [wordBound, p, Polynomial.eval_add, Polynomial.eval_mul, + Polynomial.eval_C, Polynomial.eval_X] + rw [show C * bound + C = C * bound + C by rfl] + exact Nat.max_le.mpr ⟨hregister, Nat.max_le.mpr ⟨hcard, hbound⟩⟩ + have hsize : (fun bound => (wordBound tm bound).size) =O + (fun bound => Nat.log 2 bound) := + BigO.natSize_of_polynomial_bound p hword + have hone : (fun _ : ℕ => 1) =O (fun bound => Nat.log 2 bound) := + BigO.const_le_logTwo 1 + simpa [wordWidth, bitlen] using BigO.add hsize hone + +private theorem bounded_mono {cfg : Complexity.Cfg n Q} + {bound larger : ℕ} (hbounded : Bounded cfg bound) + (hle : bound ≤ larger) : Bounded cfg larger := by + intro tape position hposition + exact hbounded tape position (lt_of_le_of_lt hle hposition) + +private theorem headsBounded_mono {cfg : Complexity.Cfg n Q} + {bound larger : ℕ} (hheads : HeadsBounded cfg bound) + (hle : bound ≤ larger) : HeadsBounded cfg larger := by + intro tape + exact le_trans (hheads tape) hle + +/-- Concrete compiled-RAM resource transfer from a canonical sparse encoding. +This is the finite, directly checkable core of the forward containment: a +`steps`-step halting TM run is simulated by one program depending only on +`tm`, with the stated logarithmic time and sparse-store space bounds. -/ +theorem compiledUntilHalt_resourceBound {tm : TM n} {steps base : ℕ} + {cfg halted : Complexity.Cfg n tm.Q} + (hreach : tm.reachesIn steps cfg halted) + (hhalted : tm.halted halted) + (hbounded : Bounded cfg base) + (hheads : HeadsBounded cfg base) + (hworkStart : ∀ i, (cfg.work i).StartInvariant) + (houtputStart : cfg.output.StartInvariant) : + let store := encodeRegs tm cfg + ∃ final cost space, + Structured.Exec (runUntilHalt tm) store final + (runSteps tm steps cfg) cost space ∧ + cost ≤ runTimeBound tm base steps cfg ∧ + space ≤ spaceBound tm (base + steps) ∧ + run (compiledUntilHalt tm) (runSteps tm steps cfg) + { pc := 0, regs := store } = + { pc := (runUntilHalt tm).codeSize, regs := final } ∧ + Halted (compiledUntilHalt tm) + (run (compiledUntilHalt tm) (runSteps tm steps cfg) + { pc := 0, regs := store }) ∧ + decode tm final = halted := by + let store := encodeRegs tm cfg + have hboundLe : base ≤ base + steps := Nat.le_add_right _ _ + have henvelope := encodeRegs_envelope_internal tm cfg (base + steps) + (bounded_mono hbounded hboundLe) (headsBounded_mono hheads hboundLe) + obtain ⟨final, hmeasured, hfinalRepresents, _hfinalEnvelope⟩ := + runUntilHalt_resourceBound hreach hhalted (encodeRegs_represents tm cfg) + hheads hworkStart houtputStart henvelope + obtain ⟨cost, space, hexec, hcost, hspace⟩ := hmeasured + have hcompiled := Structured.Exec.compile_correct hexec + refine ⟨final, cost, space, hexec, hcost, hspace, ?_, ?_, + decode_of_represents tm halted final hfinalRepresents⟩ + · simpa [compiledUntilHalt, store] using hcompiled.1 + · simpa [compiledUntilHalt, store] using + Structured.Exec.compile_halted hexec + +end Sparse + +end TMConfig + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Step/Defs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Step/Defs.lean new file mode 100644 index 0000000000..f90a06e8c9 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Step/Defs.lean @@ -0,0 +1,294 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.Switch.Defs + +/-! +# A fixed sparse-RAM block for one Turing-machine transition + +Unlike the bounded dense block, this program is determined solely by `tm`. +It computes an interleaved tape-cell address as +`cellBase + head * (n + 2) + tape`, so the same finite RAM program can follow +an unbounded computation. +-/ + + +@[expose] public section + +namespace Complexity + +namespace RAM + +namespace TMConfig + +namespace Sparse + + +/-- Input tape slot. -/ +def inputTape (n : ℕ) : Fin (n + 2) := ⟨0, by omega⟩ + +/-- Work-tape slot. -/ +def workTape (i : Fin n) : Fin (n + 2) := ⟨i.val + 1, by omega⟩ + +/-- Output tape slot. -/ +def outputTape (n : ℕ) : Fin (n + 2) := ⟨n + 1, by omega⟩ + +/-- Symbols currently read by all named TM heads. -/ +def readSymbols (cfg : Complexity.Cfg n Q) : Fin (n + 2) → Γ := + fun tape => (tapeAt cfg tape).read + +/-- Compute the indirect address of the cell under one named head. `valueReg` +temporarily holds the tape-specific base constant. -/ +def addressOps (n : ℕ) (tape : Fin (n + 2)) : List Structured.Basic := + [.imm (valueReg n) (cellBase n + tape.val), + .mul (addressReg n) (headReg tape) (tapeCountReg n), + .add (addressReg n) (addressReg n) (valueReg n)] + +/-- Load the symbol under one named head. -/ +def loadTapeOps (n : ℕ) (tape : Fin (n + 2)) : List Structured.Basic := + addressOps n tape ++ [.load (symbolReg n tape) (addressReg n)] + +/-- Initialize fixed constants and copy the finite-state code. -/ +def setupOps (n : ℕ) : List Structured.Basic := + [.imm (zeroReg n) 0, + .imm (oneReg n) 1, + .imm (tapeCountReg n) (n + 2), + .add (stateScratchReg n) stateReg (zeroReg n)] + +/-- Initialize scratch state and load every named head symbol. -/ +def loadOps (n : ℕ) : List Structured.Basic := + setupOps n ++ (List.finRange (n + 2)).flatMap (loadTapeOps n) + +/-- Update one represented head. -/ +def moveOps (n : ℕ) (tape : Fin (n + 2)) : Dir3 → List Structured.Basic + | .left => [.sub (headReg tape) (headReg tape) (oneReg n)] + | .right => [.add (headReg tape) (headReg tape) (oneReg n)] + | .stay => [] + +/-- Write the cell under one represented head and restore its immutable cell +zero to the left-end marker. -/ +def writeOps (n : ℕ) (tape : Fin (n + 2)) (write : Γw) : + List Structured.Basic := + addressOps n tape ++ + [.imm (valueReg n) (symbolCode write.toΓ), + .store (addressReg n) (valueReg n), + .imm (cellReg n tape 0) (symbolCode Γ.start)] + +/-- Write and move one represented work/output tape. -/ +def writeMoveOps (n : ℕ) (tape : Fin (n + 2)) + (write : Γw) (direction : Dir3) : List Structured.Basic := + writeOps n tape write ++ moveOps n tape direction + +/-- Straight-line operations for one statically selected transition. -/ +noncomputable def actionOps (tm : TM n) (state : tm.Q) + (symbols : Fin (n + 2) → Γ) : List Structured.Basic := + match tm.δ state (symbols (inputTape n)) + (fun i => symbols (workTape i)) (symbols (outputTape n)) with + | (nextState, workWrites, outputWrite, inputDirection, + workDirections, outputDirection) => + [.imm stateReg (stateCode tm nextState)] ++ + moveOps n (inputTape n) inputDirection ++ + (List.finRange n).flatMap (fun i => + writeMoveOps n (workTape i) (workWrites i) (workDirections i)) ++ + writeMoveOps n (outputTape n) outputWrite outputDirection + +/-- Structured selected-transition command. -/ +noncomputable def action (tm : TM n) (state : tm.Q) + (symbols : Fin (n + 2) → Γ) : Structured.Cmd := + .basics (actionOps tm state symbols) + +/-- Recursively dispatch on loaded tape symbols. -/ +noncomputable def dispatchSymbols (tm : TM n) (state : tm.Q) : + List (Fin (n + 2)) → (Fin (n + 2) → Γ) → Structured.Cmd + | [], symbols => action tm state symbols + | tape :: rest, symbols => + Structured.Switch.select 4 (symbolReg n tape) (oneReg n) + (fun code => dispatchSymbols tm state rest + (Function.update symbols tape (symbolDecode code.val))) + +/-- Dispatch on the state code and every loaded symbol. -/ +noncomputable def dispatchState (tm : TM n) : Structured.Cmd := + Structured.Switch.select (Fintype.card tm.Q) (stateScratchReg n) (oneReg n) + (fun stateCode => + dispatchSymbols tm ((Fintype.equivFin tm.Q).symm stateCode) + (List.finRange (n + 2)) (fun _ => Γ.blank)) + +/-- Fixed uniform structured-RAM block for one nonhalting TM transition. -/ +noncomputable def program (tm : TM n) : Structured.Cmd := + .seq (.basics (loadOps n)) (dispatchState tm) + +/-- Concrete compiled uniform transition block. -/ +noncomputable def compiled (tm : TM n) : Program := + (program tm).compile + +/-- Runtime loop flag: zero exactly in the designated halt state. -/ +def runningFlag (tm : TM n) (state : tm.Q) : ℕ := + if state = tm.qhalt then 0 else 1 + +/-- Finite-state branch that writes the runtime loop flag. -/ +noncomputable def continueDispatch (tm : TM n) : Structured.Cmd := + Structured.Switch.select (Fintype.card tm.Q) (stateScratchReg n) (oneReg n) + (fun code => .basics + [.imm (valueReg n) (runningFlag tm ((Fintype.equivFin tm.Q).symm code))]) + +/-- Reload the represented state and set the runtime loop flag. The full load +prelude is deliberately reused so this fixed controller inherits its framing +theorem. -/ +noncomputable def continueCheck (tm : TM n) : Structured.Cmd := + .seq (.basics (loadOps n)) (continueDispatch tm) + +/-- One loop iteration: perform one TM transition, then recompute whether the +successor is halted. -/ +noncomputable def loopBody (tm : TM n) : Structured.Cmd := + .seq (program tm) (continueCheck tm) + +/-- Fixed structured program that repeats transitions until the represented TM +enters `qhalt`. -/ +noncomputable def runUntilHalt (tm : TM n) : Structured.Cmd := + .seq (continueCheck tm) + (.whileNonzero (valueReg n) (loopBody tm)) + +/-- Concrete compiled fixed program that simulates until `qhalt`. -/ +noncomputable def compiledUntilHalt (tm : TM n) : Program := + (runUntilHalt tm).compile + +/-- Exact instruction count of one continuation check. -/ +noncomputable def continueSteps (tm : TM n) (cfg : Complexity.Cfg n tm.Q) : ℕ := + (loadOps n).length + + Structured.Switch.stepCount (stateCode tm cfg.state) 1 + +/-- Largest cell-register index needed when heads stay at most `bound`. -/ +def registerBound (n bound : ℕ) : ℕ := + cellReg n (outputTape n) bound + 1 + +/-- Uniform value bound for a transition whose input heads are at most +`bound`; it includes a possible right move. -/ +def wordBound (tm : TM n) (bound : ℕ) : ℕ := + max (registerBound n (bound + 1)) + (max (Fintype.card tm.Q) (bound + 1)) + +/-- One-bit-cushioned resource width. -/ +def wordWidth (tm : TM n) (bound : ℕ) : ℕ := + bitlen (wordBound tm bound) + 1 + +/-- Peak sparse-store space envelope through one transition. -/ +def spaceBound (tm : TM n) (bound : ℕ) : ℕ := + registerBound n (bound + 1) * + (bitlen (registerBound n (bound + 1)) + bitlen (wordBound tm bound)) + +/-- Exact transition count through symbol dispatch. -/ +noncomputable def dispatchSteps (tm : TM n) (state : tm.Q) + (actual : Fin (n + 2) → Γ) : List (Fin (n + 2)) → ℕ + | [] => (actionOps tm state actual).length + | tape :: rest => Structured.Switch.stepCount (symbolCode (actual tape)) + (dispatchSteps tm state actual rest) + +/-- Exact source/compiled instruction count for one sparse TM step. -/ +noncomputable def stepCount (tm : TM n) (cfg : Complexity.Cfg n tm.Q) : ℕ := + (loadOps n).length + + Structured.Switch.stepCount (stateCode tm cfg.state) + (dispatchSteps tm cfg.state (readSymbols cfg) (List.finRange (n + 2))) + +/-- Exact instruction count of the while-loop suffix along `steps` TM +transitions. The `none` branch is unreachable in the corresponding simulation +theorem. -/ +noncomputable def loopSteps (tm : TM n) : + ℕ → Complexity.Cfg n tm.Q → ℕ + | 0, _ => 1 + | steps + 1, cfg => + match tm.step cfg with + | none => 0 + | some next => stepCount tm cfg + continueSteps tm next + + loopSteps tm steps next + 2 + +/-- Exact instruction count of the complete fixed simulator along a known +halting run. -/ +noncomputable def runSteps (tm : TM n) (steps : ℕ) + (cfg : Complexity.Cfg n tm.Q) : ℕ := + continueSteps tm cfg + loopSteps tm steps cfg + +/-- Logarithmic-cost bound through symbol dispatch. -/ +noncomputable def dispatchCost (tm : TM n) (bound : ℕ) (state : tm.Q) + (actual : Fin (n + 2) → Γ) : List (Fin (n + 2)) → ℕ + | [] => 4 * (actionOps tm state actual).length * wordWidth tm bound + | tape :: rest => Structured.Switch.costBound (symbolCode (actual tape)) + (dispatchCost tm bound state actual rest) (wordWidth tm bound) + +/-- Explicit logarithmic cost bound for one sparse TM step. -/ +noncomputable def timeBound (tm : TM n) (bound : ℕ) + (cfg : Complexity.Cfg n tm.Q) : ℕ := + 4 * (loadOps n).length * wordWidth tm bound + + Structured.Switch.costBound (stateCode tm cfg.state) + (dispatchCost tm bound cfg.state (readSymbols cfg) (List.finRange (n + 2))) + (wordWidth tm bound) + +/-- Explicit logarithmic cost bound for one continuation check under a fixed +store envelope. -/ +noncomputable def continueTimeBound (tm : TM n) (bound : ℕ) + (cfg : Complexity.Cfg n tm.Q) : ℕ := + 4 * (loadOps n).length * wordWidth tm bound + + Structured.Switch.costBound (stateCode tm cfg.state) + (4 * wordWidth tm bound) (wordWidth tm bound) + +/-- Accumulated logarithmic cost bound for the while-loop suffix. `base` bounds +the current heads; the remaining-step allowance supplies the common envelope. -/ +noncomputable def loopTimeBound (tm : TM n) : + ℕ → ℕ → Complexity.Cfg n tm.Q → ℕ + | base, 0, _ => wordWidth tm base + | base, steps + 1, cfg => + match tm.step cfg with + | none => 0 + | some next => + let bound := base + steps + 1 + 3 * wordWidth tm bound + timeBound tm bound cfg + + continueTimeBound tm bound next + + loopTimeBound tm (base + 1) steps next + +/-- Accumulated logarithmic cost bound for the complete fixed simulator. -/ +noncomputable def runTimeBound (tm : TM n) (base steps : ℕ) + (cfg : Complexity.Cfg n tm.Q) : ℕ := + continueTimeBound tm (base + steps) cfg + + loopTimeBound tm base steps cfg + +/-- Width multiplier through the symbol-dispatch suffix. -/ +noncomputable def dispatchFactor (tm : TM n) (state : tm.Q) + (actual : Fin (n + 2) → Γ) : List (Fin (n + 2)) → ℕ + | [] => 4 * (actionOps tm state actual).length + | tape :: rest => 7 * symbolCode (actual tape) + 1 + + dispatchFactor tm state actual rest + +/-- Configuration-independent multiplier for one sparse transition, obtained +by taking the finite maximum over states and currently scanned symbols. -/ +noncomputable def stepFactor (tm : TM n) : ℕ := + 4 * (loadOps n).length + + Finset.univ.sup fun state : tm.Q => + Finset.univ.sup fun actual : Fin (n + 2) → Γ => + 7 * stateCode tm state + 1 + + dispatchFactor tm state actual (List.finRange (n + 2)) + +/-- Configuration-independent multiplier for one continuation check. -/ +def continueFactor (tm : TM n) : ℕ := + 4 * (loadOps n).length + (7 * Fintype.card tm.Q + 5) + +/-- Per-iteration multiplier including loop control, transition, and +continuation check. -/ +noncomputable def iterationFactor (tm : TM n) : ℕ := + 3 + stepFactor tm + continueFactor tm + +/-- Coarse multiplier for a complete run, including the initial continuation +check and final zero test. -/ +noncomputable def runFactor (tm : TM n) : ℕ := + continueFactor tm + iterationFactor tm + 1 + +end Sparse + +end TMConfig + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Step/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Step/Internal.lean new file mode 100644 index 0000000000..eff98e7a7b --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Step/Internal.lean @@ -0,0 +1,25 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.Step.Internal.Layout +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.Step.Internal.Load +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.Step.Internal.Action +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.Step.Internal.Dispatch +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.Step.Internal.Iteration +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.Step.Internal.Resources + +/-! +# Fixed sparse TM-transition block -- proof internals + +This aggregation module collects the checked semantic and resource layers of +the uniform sparse transition block. +-/ diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Step/Internal/Action.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Step/Internal/Action.lean new file mode 100644 index 0000000000..ad3ed4c786 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Step/Internal/Action.lean @@ -0,0 +1,1231 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.Internal.Resources +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.Step.Internal.Layout + +/-! +# Selected sparse TM transition actions -- proof internals +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace TMConfig + +namespace Sparse + + +private theorem execList_append (first second : List Structured.Basic) + (store : Structured.Store) : + Structured.Basic.execList (first ++ second) store = + Structured.Basic.execList second (Structured.Basic.execList first store) := by + induction first generalizing store with + | nil => rfl + | cons op rest ih => simp [Structured.Basic.execList, ih] + +/-- Representation restricted to one named sparse tape. -/ +private def RepresentsTape (slot : Fin (n + 2)) + (tape : Tape) (store : Structured.Store) : Prop := + store (headReg slot) = tape.head ∧ + ∀ position, store (cellReg n slot position) = + symbolCode (tape.cells position) + +private theorem Represents.tape {tm : TM n} + {cfg : Complexity.Cfg n tm.Q} {store : Structured.Store} + (hrepresents : Represents tm cfg store) (slot : Fin (n + 2)) : + RepresentsTape slot (tapeAt cfg slot) store := by + constructor + · exact hrepresents (Sum.inr (Sum.inl slot)) + · intro position + exact hrepresents (Sum.inr (Sum.inr (slot, position))) + +private theorem headReg_ne_cellReg (headSlot cellSlot : Fin (n + 2)) + (position : ℕ) : + headReg headSlot ≠ cellReg n cellSlot position := by + intro heq + have hfield : + fieldReg (Sum.inr (Sum.inl headSlot)) = + fieldReg (Sum.inr (Sum.inr (cellSlot, position))) := heq + have := fieldReg_injective_internal hfield + cases this + +private theorem headReg_ne_headReg_of_slot_ne {first second : Fin (n + 2)} + (hne : first ≠ second) : headReg first ≠ headReg second := by + intro heq + apply hne + apply Fin.ext + simp [headReg] at heq + omega + +private theorem cellReg_ne_cellReg_of_slot_ne {first second : Fin (n + 2)} + (hne : first ≠ second) (firstPosition secondPosition : ℕ) : + cellReg n first firstPosition ≠ cellReg n second secondPosition := by + intro heq + have hpairs : (first, firstPosition) = (second, secondPosition) := + cellReg_injective_internal heq + exact hne (congrArg Prod.fst hpairs) + +private theorem cellReg_ne_cellReg_of_position_ne (slot : Fin (n + 2)) + {first second : ℕ} (hne : first ≠ second) : + cellReg n slot first ≠ cellReg n slot second := by + intro heq + have hpairs : (slot, first) = (slot, second) := + cellReg_injective_internal heq + exact hne (congrArg Prod.snd hpairs) + +private theorem addressOps_apply_of_ne (n : ℕ) (slot : Fin (n + 2)) + (store : Structured.Store) (reg : ℕ) + (hvalue : reg ≠ valueReg n) (haddress : reg ≠ addressReg n) : + Structured.Basic.execList (addressOps n slot) store reg = store reg := by + simp [addressOps, Structured.Basic.execList, Structured.Basic.exec, + Function.update_of_ne hvalue, Function.update_of_ne haddress] + +/-- On configuration registers, a sparse write is exactly an update at the +represented head followed by restoration of cell zero. -/ +private theorem writeOps_apply {tm : TM n} {cfg : Complexity.Cfg n tm.Q} + (slot : Fin (n + 2)) (write : Γw) (store : Structured.Store) + (hrepresents : Represents tm cfg store) + (htapeCount : store (tapeCountReg n) = n + 2) (reg : ℕ) + (hregValue : reg ≠ valueReg n) (hregAddress : reg ≠ addressReg n) : + Structured.Basic.execList (writeOps n slot write) store reg = + Function.update + (Function.update (Structured.Basic.execList (addressOps n slot) store) + (cellReg n slot (tapeAt cfg slot).head) (symbolCode write.toΓ)) + (cellReg n slot 0) (symbolCode Γ.start) reg := by + let addressed := Structured.Basic.execList (addressOps n slot) store + have haddress : addressed (addressReg n) = + cellReg n slot (tapeAt cfg slot).head := + addressOps_address_internal hrepresents slot htapeCount + have haddressValue : addressReg n ≠ valueReg n := by + simp [addressReg, valueReg] + have hvaluedAddress : + ((Structured.Basic.imm (valueReg n) (symbolCode write.toΓ)).exec addressed) + (addressReg n) = addressed (addressReg n) := by + simp [Structured.Basic.exec, Function.update_of_ne haddressValue] + have hvaluedValue : + ((Structured.Basic.imm (valueReg n) (symbolCode write.toΓ)).exec addressed) + (valueReg n) = symbolCode write.toΓ := by + simp [Structured.Basic.exec] + simp only [writeOps, execList_append, Structured.Basic.execList] + change Function.update + (Function.update + ((Structured.Basic.imm (valueReg n) (symbolCode write.toΓ)).exec addressed) + (((Structured.Basic.imm (valueReg n) (symbolCode write.toΓ)).exec addressed) + (addressReg n)) + (((Structured.Basic.imm (valueReg n) (symbolCode write.toΓ)).exec addressed) + (valueReg n))) + (cellReg n slot 0) (symbolCode Γ.start) reg = _ + rw [hvaluedAddress, hvaluedValue, haddress] + by_cases hzero : reg = cellReg n slot 0 + · subst reg + rw [Function.update_self, Function.update_self] + · by_cases htarget : reg = cellReg n slot (tapeAt cfg slot).head + · rw [Function.update_of_ne hzero, Function.update_of_ne hzero] + subst reg + rw [Function.update_self, Function.update_self] + · rw [Function.update_of_ne hzero, Function.update_of_ne hzero, + Function.update_of_ne htarget, Function.update_of_ne htarget] + rw [show + ((Structured.Basic.imm (valueReg n) (symbolCode write.toΓ)).exec + addressed) reg = addressed reg by + simp [Structured.Basic.exec, Function.update_of_ne hregValue]] + +private theorem writeOps_tape {tm : TM n} {cfg : Complexity.Cfg n tm.Q} + (slot : Fin (n + 2)) (write : Γw) (store : Structured.Store) + (hrepresents : Represents tm cfg store) + (htapeCount : store (tapeCountReg n) = n + 2) + (hstart : (tapeAt cfg slot).cells 0 = Γ.start) : + RepresentsTape slot ((tapeAt cfg slot).write write.toΓ) + (Structured.Basic.execList (writeOps n slot write) store) := by + let addressed := Structured.Basic.execList (addressOps n slot) store + have haddressed := addressOps_represents_internal hrepresents slot + have htape := Represents.tape haddressed slot + constructor + · rw [writeOps_apply slot write store hrepresents htapeCount + (headReg slot)] + · rw [Function.update_of_ne + (headReg_ne_cellReg slot slot 0), + Function.update_of_ne + (headReg_ne_cellReg slot slot (tapeAt cfg slot).head)] + simpa [Tape.write_head] using htape.1 + · simp [headReg, valueReg] + omega + · simp [headReg, addressReg] + omega + · intro position + rw [writeOps_apply slot write store hrepresents htapeCount + (cellReg n slot position)] + · by_cases hheadZero : (tapeAt cfg slot).head = 0 + · by_cases hpositionZero : position = 0 + · subst position + simp [Tape.write, hheadZero, hstart] + · have hcellZero := + cellReg_ne_cellReg_of_position_ne (n := n) slot hpositionZero + simp [Tape.write, hheadZero, hcellZero, + htape.2 position] + · by_cases hpositionHead : position = (tapeAt cfg slot).head + · subst position + have hcellZero := cellReg_ne_cellReg_of_position_ne (n := n) slot + hheadZero + simp [Tape.write, hheadZero, hcellZero] + · by_cases hpositionZero : position = 0 + · subst position + rw [Function.update_self] + rw [Tape.write, if_neg hheadZero] + change symbolCode Γ.start = symbolCode + (Function.update (tapeAt cfg slot).cells + (tapeAt cfg slot).head write.toΓ 0) + rw [Function.update_of_ne hpositionHead, hstart] + · have hcellZero := + cellReg_ne_cellReg_of_position_ne (n := n) slot hpositionZero + have hcellHead := cellReg_ne_cellReg_of_position_ne (n := n) slot + hpositionHead + simp [Tape.write, hheadZero, hpositionHead, + hcellZero, hcellHead, htape.2 position] + · simp [cellReg, valueReg, cellBase] + omega + · simp [cellReg, addressReg, cellBase] + omega + +private theorem moveOps_apply_of_ne (n : ℕ) (slot : Fin (n + 2)) + (direction : Dir3) (store : Structured.Store) {reg : ℕ} + (hne : reg ≠ headReg slot) : + Structured.Basic.execList (moveOps n slot direction) store reg = store reg := by + cases direction <;> + simp [moveOps, Structured.Basic.execList, Structured.Basic.exec, + Function.update_of_ne hne] + +private theorem moveOps_tape (n : ℕ) (slot : Fin (n + 2)) + (direction : Dir3) (tape : Tape) (store : Structured.Store) + (hrepresents : RepresentsTape slot tape store) + (hone : store (oneReg n) = 1) : + RepresentsTape slot (tape.move direction) + (Structured.Basic.execList (moveOps n slot direction) store) := by + constructor + · cases direction <;> + simp [moveOps, Structured.Basic.execList, Structured.Basic.exec, Tape.move, + hrepresents.1, hone] + · intro position + rw [moveOps_apply_of_ne n slot direction store + (headReg_ne_cellReg slot slot position).symm] + rw [Tape.move_cells] + exact hrepresents.2 position + +private theorem controlReg_ne_cellReg (n reg : ℕ) + (hhigh : reg < cellBase n) + (slot : Fin (n + 2)) (position : ℕ) : + reg ≠ cellReg n slot position := by + intro heq + have hcell := cellBase_le_cellReg_internal slot position + omega + +private theorem writeOps_control {tm : TM n} {cfg : Complexity.Cfg n tm.Q} + (slot : Fin (n + 2)) (write : Γw) (store : Structured.Store) + (hrepresents : Represents tm cfg store) + (htapeCount : store (tapeCountReg n) = n + 2) (reg : ℕ) + (hhigh : reg < cellBase n) + (hvalue : reg ≠ valueReg n) (haddress : reg ≠ addressReg n) : + Structured.Basic.execList (writeOps n slot write) store reg = store reg := by + rw [writeOps_apply slot write store hrepresents htapeCount reg hvalue haddress] + rw [Function.update_of_ne + (controlReg_ne_cellReg n reg hhigh slot 0), + Function.update_of_ne + (controlReg_ne_cellReg n reg hhigh slot (tapeAt cfg slot).head)] + exact addressOps_apply_of_ne n slot store reg hvalue haddress + +private theorem moveOps_control (n : ℕ) (slot : Fin (n + 2)) + (direction : Dir3) (store : Structured.Store) (reg : ℕ) + (hlow : n + 3 ≤ reg) : + Structured.Basic.execList (moveOps n slot direction) store reg = store reg := by + apply moveOps_apply_of_ne + intro heq + have hhead := headReg_lt_control_internal slot + omega + +private theorem writeMoveOps_control {tm : TM n} + {cfg : Complexity.Cfg n tm.Q} (slot : Fin (n + 2)) + (write : Γw) (direction : Dir3) (store : Structured.Store) + (hrepresents : Represents tm cfg store) + (htapeCount : store (tapeCountReg n) = n + 2) (reg : ℕ) + (hlow : n + 3 ≤ reg) (hhigh : reg < cellBase n) + (hvalue : reg ≠ valueReg n) (haddress : reg ≠ addressReg n) : + Structured.Basic.execList (writeMoveOps n slot write direction) store reg = + store reg := by + let written := Structured.Basic.execList (writeOps n slot write) store + rw [writeMoveOps, execList_append, + moveOps_control n slot direction written reg hlow] + exact writeOps_control slot write store hrepresents htapeCount reg + hhigh hvalue haddress + +private theorem writeMoveOps_tape_internal {tm : TM n} + {cfg : Complexity.Cfg n tm.Q} (slot : Fin (n + 2)) + (write : Γw) (direction : Dir3) (store : Structured.Store) + (hrepresents : Represents tm cfg store) + (htapeCount : store (tapeCountReg n) = n + 2) + (hone : store (oneReg n) = 1) + (hstart : (tapeAt cfg slot).cells 0 = Γ.start) : + RepresentsTape slot + ((tapeAt cfg slot).writeAndMove write.toΓ direction) + (Structured.Basic.execList (writeMoveOps n slot write direction) store) := by + let written := Structured.Basic.execList (writeOps n slot write) store + have hwritten := writeOps_tape slot write store hrepresents htapeCount hstart + have hrange := scratch_range_internal n + have honeWritten : written (oneReg n) = 1 := by + exact (writeOps_control slot write store hrepresents htapeCount + (oneReg n) hrange.2.1.2 (by simp [oneReg, valueReg]) + (by simp [oneReg, addressReg])).trans hone + rw [writeMoveOps, execList_append] + exact moveOps_tape n slot direction ((tapeAt cfg slot).write write.toΓ) + written hwritten honeWritten + +private theorem writeMoveOps_otherTape_internal {tm : TM n} + {cfg : Complexity.Cfg n tm.Q} {slot other : Fin (n + 2)} + (hne : slot ≠ other) (write : Γw) (direction : Dir3) + (store : Structured.Store) (hrepresents : Represents tm cfg store) + (htapeCount : store (tapeCountReg n) = n + 2) : + RepresentsTape other (tapeAt cfg other) + (Structured.Basic.execList (writeMoveOps n slot write direction) store) := by + let addressed := Structured.Basic.execList (addressOps n slot) store + let written := Structured.Basic.execList (writeOps n slot write) store + have haddressed := addressOps_represents_internal hrepresents slot + have hother := Represents.tape haddressed other + have hheadWritten : written (headReg other) = addressed (headReg other) := by + change Structured.Basic.execList (writeOps n slot write) store + (headReg other) = addressed (headReg other) + rw [writeOps_apply slot write store hrepresents htapeCount (headReg other)] + · rw [Function.update_of_ne (headReg_ne_cellReg other slot 0), + Function.update_of_ne + (headReg_ne_cellReg other slot (tapeAt cfg slot).head)] + · simp [headReg, valueReg] + omega + · simp [headReg, addressReg] + omega + constructor + · rw [writeMoveOps, execList_append, + moveOps_apply_of_ne n slot direction written + (headReg_ne_headReg_of_slot_ne (Ne.symm hne)), + hheadWritten] + exact hother.1 + · intro position + have hcellWritten : written (cellReg n other position) = + addressed (cellReg n other position) := by + change Structured.Basic.execList (writeOps n slot write) store + (cellReg n other position) = addressed (cellReg n other position) + rw [writeOps_apply slot write store hrepresents htapeCount + (cellReg n other position)] + · rw [Function.update_of_ne + (cellReg_ne_cellReg_of_slot_ne (Ne.symm hne) position 0), + Function.update_of_ne + (cellReg_ne_cellReg_of_slot_ne (Ne.symm hne) position + (tapeAt cfg slot).head)] + · simp [cellReg, valueReg, cellBase] + omega + · simp [cellReg, addressReg, cellBase] + omega + rw [writeMoveOps, execList_append, + moveOps_apply_of_ne n slot direction written + (headReg_ne_cellReg slot other position).symm, + hcellWritten] + exact hother.2 position + +private theorem RepresentsTape.stateUpdate (slot : Fin (n + 2)) + (tape : Tape) (store : Structured.Store) (state : ℕ) + (hrepresents : RepresentsTape slot tape store) : + RepresentsTape slot tape + ((Structured.Basic.imm stateReg state).exec store) := by + constructor + · simpa [Structured.Basic.exec, stateReg, headReg, + Function.update_of_ne] using hrepresents.1 + · intro position + simpa [Structured.Basic.exec, stateReg, cellReg, cellBase, + Function.update_of_ne] using hrepresents.2 position + +private theorem moveOps_otherTape (n : ℕ) + {slot other : Fin (n + 2)} (hne : slot ≠ other) + (direction : Dir3) (otherTape : Tape) (store : Structured.Store) + (hother : RepresentsTape other otherTape store) : + RepresentsTape other otherTape + (Structured.Basic.execList (moveOps n slot direction) store) := by + constructor + · rw [moveOps_apply_of_ne n slot direction store + (headReg_ne_headReg_of_slot_ne (Ne.symm hne))] + exact hother.1 + · intro position + rw [moveOps_apply_of_ne n slot direction store + (headReg_ne_cellReg slot other position).symm] + exact hother.2 position + +private theorem workTape_injective (n : ℕ) : + Function.Injective (workTape : Fin n → Fin (n + 2)) := by + intro first second heq + apply Fin.ext + simpa [workTape] using congrArg Fin.val heq + +private theorem inputTape_ne_workTape (n : ℕ) (i : Fin n) : + inputTape n ≠ workTape i := by + intro heq + have := congrArg Fin.val heq + simp [inputTape, workTape] at this + +private theorem outputTape_ne_workTape (n : ℕ) (i : Fin n) : + outputTape n ≠ workTape i := by + intro heq + have hi := i.isLt + have := congrArg Fin.val heq + simp [outputTape, workTape] at this + omega + +private theorem inputTape_ne_outputTape (n : ℕ) : + inputTape n ≠ outputTape n := by + intro heq + have := congrArg Fin.val heq + simp [inputTape, outputTape] at this + +/-- Reassemble the complete sparse representation from the state and named +tape blocks. -/ +private theorem represents_of_named_tapes {tm : TM n} + {cfg : Complexity.Cfg n tm.Q} {store : Structured.Store} + (hstate : store stateReg = stateCode tm cfg.state) + (hinput : RepresentsTape (inputTape n) cfg.input store) + (hwork : ∀ i, RepresentsTape (workTape i) (cfg.work i) store) + (houtput : RepresentsTape (outputTape n) cfg.output store) : + Represents tm cfg store := by + intro field + rcases field with state | headOrCell + · rcases state with ⟨state, hstateFin⟩ + have hzero : state = 0 := by omega + subst state + simpa [fieldReg, fieldValue] using hstate + · rcases headOrCell with head | cell + · change store (headReg head) = (tapeAt cfg head).head + by_cases hinputSlot : head = inputTape n + · subst head + rw [hinput.1] + simpa [inputTape] using + congrArg Tape.head (tapeAt_input_internal cfg).symm + · by_cases houtputSlot : head = outputTape n + · subst head + rw [houtput.1] + simpa [outputTape] using + congrArg Tape.head (tapeAt_output_internal cfg).symm + · let i : Fin n := ⟨head.val - 1, by + have hpositive : 0 < head.val := by + have hnezero : head.val ≠ 0 := by + intro hzero + apply hinputSlot + apply Fin.ext + simpa [inputTape] using hzero + omega + have hnotOutput : head.val ≠ n + 1 := by + intro heq + apply houtputSlot + apply Fin.ext + simpa [outputTape] using heq + omega⟩ + have hhead : head = workTape i := by + apply Fin.ext + simp [i, workTape] + have hpositive : 0 < head.val := by + have hnezero : head.val ≠ 0 := by + intro hzero + apply hinputSlot + apply Fin.ext + simpa [inputTape] using hzero + omega + omega + rw [hhead, (hwork i).1] + simpa [workTape] using + congrArg Tape.head (tapeAt_work_internal cfg i).symm + · rcases cell with ⟨tape, position⟩ + change store (cellReg n tape position) = + symbolCode ((tapeAt cfg tape).cells position) + by_cases hinputSlot : tape = inputTape n + · subst tape + rw [hinput.2 position] + simpa [inputTape] using + congrArg (fun t => symbolCode (t.cells position)) + (tapeAt_input_internal cfg).symm + · by_cases houtputSlot : tape = outputTape n + · subst tape + rw [houtput.2 position] + simpa [outputTape] using + congrArg (fun t => symbolCode (t.cells position)) + (tapeAt_output_internal cfg).symm + · let i : Fin n := ⟨tape.val - 1, by + have hpositive : 0 < tape.val := by + have hnezero : tape.val ≠ 0 := by + intro hzero + apply hinputSlot + apply Fin.ext + simpa [inputTape] using hzero + omega + have hnotOutput : tape.val ≠ n + 1 := by + intro heq + apply houtputSlot + apply Fin.ext + simpa [outputTape] using heq + omega⟩ + have htape : tape = workTape i := by + apply Fin.ext + simp [i, workTape] + have hpositive : 0 < tape.val := by + have hnezero : tape.val ≠ 0 := by + intro hzero + apply hinputSlot + apply Fin.ext + simpa [inputTape] using hzero + omega + omega + rw [htape, (hwork i).2 position] + simpa [workTape] using + congrArg (fun t => symbolCode (t.cells position)) + (tapeAt_work_internal cfg i).symm + +/-- Invariant after updating a prefix of the work tapes. -/ +private structure WorkPrefix (tm : TM n) (cfg : Complexity.Cfg n tm.Q) + (nextState : tm.Q) (inputDirection : Dir3) + (workWrites : Fin n → Γw) (workDirections : Fin n → Dir3) + (processed : List (Fin n)) (store : Structured.Store) : Prop where + state : store stateReg = stateCode tm nextState + one : store (oneReg n) = 1 + tapeCount : store (tapeCountReg n) = n + 2 + input : RepresentsTape (inputTape n) (cfg.input.move inputDirection) store + work : ∀ i, RepresentsTape (workTape i) + (if i ∈ processed then + (cfg.work i).writeAndMove (workWrites i).toΓ (workDirections i) + else cfg.work i) store + output : RepresentsTape (outputTape n) cfg.output store + +private theorem actionPrelude_workPrefix {tm : TM n} + {cfg : Complexity.Cfg n tm.Q} {store : Structured.Store} + (nextState : tm.Q) (inputDirection : Dir3) + (workWrites : Fin n → Γw) (workDirections : Fin n → Dir3) + (hrepresents : Represents tm cfg store) + (hone : store (oneReg n) = 1) + (htapeCount : store (tapeCountReg n) = n + 2) : + let initialized := + (Structured.Basic.imm stateReg (stateCode tm nextState)).exec store + let final := Structured.Basic.execList + (moveOps n (inputTape n) inputDirection) initialized + WorkPrefix tm cfg nextState inputDirection workWrites workDirections [] final := by + let initialized := + (Structured.Basic.imm stateReg (stateCode tm nextState)).exec store + let final := Structured.Basic.execList + (moveOps n (inputTape n) inputDirection) initialized + have honeInitialized : initialized (oneReg n) = 1 := by + simpa [initialized, Structured.Basic.exec, stateReg, oneReg, + Function.update_of_ne] using hone + have hcountInitialized : initialized (tapeCountReg n) = n + 2 := by + simpa [initialized, Structured.Basic.exec, stateReg, tapeCountReg, + Function.update_of_ne] using htapeCount + have hinputInitialized : RepresentsTape (inputTape n) cfg.input initialized := by + have htape := (Represents.tape hrepresents (inputTape n)).stateUpdate + (inputTape n) (tapeAt cfg (inputTape n)) store (stateCode tm nextState) + rw [show tapeAt cfg (inputTape n) = cfg.input by + simpa [inputTape] using tapeAt_input_internal cfg] at htape + exact htape + have hworkInitialized : ∀ i, + RepresentsTape (workTape i) (cfg.work i) initialized := by + intro i + have htape := (Represents.tape hrepresents (workTape i)).stateUpdate + (workTape i) (tapeAt cfg (workTape i)) store (stateCode tm nextState) + rw [show tapeAt cfg (workTape i) = cfg.work i by + simpa [workTape] using tapeAt_work_internal cfg i] at htape + exact htape + have houtputInitialized : + RepresentsTape (outputTape n) cfg.output initialized := by + have htape := (Represents.tape hrepresents (outputTape n)).stateUpdate + (outputTape n) (tapeAt cfg (outputTape n)) store (stateCode tm nextState) + rw [show tapeAt cfg (outputTape n) = cfg.output by + simpa [outputTape] using tapeAt_output_internal cfg] at htape + exact htape + refine ⟨?_, ?_, ?_, ?_, ?_, ?_⟩ + · rw [moveOps_apply_of_ne n (inputTape n) inputDirection initialized] + · simp [initialized, Structured.Basic.exec] + · simp [stateReg, headReg, inputTape] + · exact (moveOps_control n (inputTape n) inputDirection initialized + (oneReg n) (by simp [oneReg])).trans honeInitialized + · exact (moveOps_control n (inputTape n) inputDirection initialized + (tapeCountReg n) (by simp [tapeCountReg])).trans hcountInitialized + · exact moveOps_tape n (inputTape n) inputDirection cfg.input initialized + hinputInitialized honeInitialized + · intro i + simpa using moveOps_otherTape n (inputTape_ne_workTape n i) + inputDirection (cfg.work i) initialized (hworkInitialized i) + · exact moveOps_otherTape n (inputTape_ne_outputTape n) inputDirection + cfg.output initialized houtputInitialized + +private theorem writeMoveOps_state {tm : TM n} + {cfg : Complexity.Cfg n tm.Q} (slot : Fin (n + 2)) + (write : Γw) (direction : Dir3) (store : Structured.Store) + (hrepresents : Represents tm cfg store) + (htapeCount : store (tapeCountReg n) = n + 2) : + Structured.Basic.execList (writeMoveOps n slot write direction) store + stateReg = store stateReg := by + let written := Structured.Basic.execList (writeOps n slot write) store + rw [writeMoveOps, execList_append, + moveOps_apply_of_ne n slot direction written] + · change Structured.Basic.execList (writeOps n slot write) store stateReg = + store stateReg + rw [writeOps_apply slot write store hrepresents htapeCount stateReg] + · have hzero : stateReg ≠ cellReg n slot 0 := by + simp [stateReg, cellReg, cellBase] + omega + have htarget : stateReg ≠ + cellReg n slot (tapeAt cfg slot).head := by + simp [stateReg, cellReg, cellBase] + omega + rw [Function.update_of_ne hzero, Function.update_of_ne htarget] + exact addressOps_apply_of_ne n slot store stateReg + (by simp [stateReg, valueReg]) (by simp [stateReg, addressReg]) + · simp [stateReg, valueReg] + · simp [stateReg, addressReg] + · simp [stateReg, headReg] + omega + +private theorem workPrefix_step {tm : TM n} + {cfg : Complexity.Cfg n tm.Q} {nextState : tm.Q} + {inputDirection : Dir3} {workWrites : Fin n → Γw} + {workDirections : Fin n → Dir3} {processed : List (Fin n)} + {store : Structured.Store} + (hprefix : WorkPrefix tm cfg nextState inputDirection + workWrites workDirections processed store) + (i : Fin n) (hfresh : i ∉ processed) + (hstart : (cfg.work i).cells 0 = Γ.start) : + WorkPrefix tm cfg nextState inputDirection workWrites workDirections + (i :: processed) + (Structured.Basic.execList + (writeMoveOps n (workTape i) (workWrites i) (workDirections i)) store) := by + let current : Complexity.Cfg n tm.Q := + { state := nextState + input := cfg.input.move inputDirection + work := fun j => if j ∈ processed then + (cfg.work j).writeAndMove (workWrites j).toΓ (workDirections j) + else cfg.work j + output := cfg.output } + have hcurrent : Represents tm current store := by + exact represents_of_named_tapes hprefix.state hprefix.input hprefix.work + hprefix.output + have hselectedTape : tapeAt current (workTape i) = cfg.work i := by + simp [current, workTape, hfresh, tapeAt_work_internal] + have hselected : RepresentsTape (workTape i) (cfg.work i) store := by + simpa [hselectedTape] using Represents.tape hcurrent (workTape i) + have hselectedFinal := writeMoveOps_tape_internal (tm := tm) + (cfg := current) (workTape i) (workWrites i) (workDirections i) store + hcurrent hprefix.tapeCount hprefix.one (by simpa [hselectedTape] using hstart) + have hrange := scratch_range_internal n + refine ⟨?_, ?_, ?_, ?_, ?_, ?_⟩ + · exact (writeMoveOps_state (workTape i) (workWrites i) + (workDirections i) store hcurrent hprefix.tapeCount).trans hprefix.state + · exact (writeMoveOps_control (workTape i) (workWrites i) + (workDirections i) store hcurrent hprefix.tapeCount (oneReg n) + hrange.2.1.1 hrange.2.1.2 (by simp [oneReg, valueReg]) + (by simp [oneReg, addressReg])).trans hprefix.one + · exact (writeMoveOps_control (workTape i) (workWrites i) + (workDirections i) store hcurrent hprefix.tapeCount (tapeCountReg n) + hrange.2.2.1.1 hrange.2.2.1.2 (by simp [tapeCountReg, valueReg]) + (by simp [tapeCountReg, addressReg])).trans hprefix.tapeCount + · have hother := writeMoveOps_otherTape_internal + (tm := tm) (cfg := current) (Ne.symm (inputTape_ne_workTape n i)) + (workWrites i) (workDirections i) store hcurrent hprefix.tapeCount + simpa [current, inputTape] using hother + · intro j + by_cases hji : j = i + · subst j + simpa [hselectedTape] using hselectedFinal + · have hslots : workTape i ≠ workTape j := by + exact fun heq => hji ((workTape_injective n) heq).symm + have hother := writeMoveOps_otherTape_internal + (tm := tm) (cfg := current) hslots (workWrites i) + (workDirections i) store hcurrent hprefix.tapeCount + have htape : tapeAt current (workTape j) = + (if j ∈ processed then + (cfg.work j).writeAndMove (workWrites j).toΓ (workDirections j) + else cfg.work j) := by + simpa [current, workTape] using tapeAt_work_internal current j + rw [htape] at hother + simpa [hji] using hother + · have hother := writeMoveOps_otherTape_internal + (tm := tm) (cfg := current) (outputTape_ne_workTape n i).symm + (workWrites i) (workDirections i) store hcurrent hprefix.tapeCount + have htape : tapeAt current (outputTape n) = cfg.output := by + simpa [current, outputTape] using tapeAt_output_internal current + rw [htape] at hother + exact hother + +private theorem workPrefix_list {tm : TM n} + {cfg : Complexity.Cfg n tm.Q} {nextState : tm.Q} + {inputDirection : Dir3} {workWrites : Fin n → Γw} + {workDirections : Fin n → Dir3} + (items processed : List (Fin n)) {store : Structured.Store} + (hprefix : WorkPrefix tm cfg nextState inputDirection + workWrites workDirections processed store) + (hfresh : ∀ i, i ∈ items → i ∉ processed) + (hnodup : items.Nodup) + (hstarts : ∀ i, (cfg.work i).cells 0 = Γ.start) : + WorkPrefix tm cfg nextState inputDirection workWrites workDirections + (items.reverse ++ processed) + (Structured.Basic.execList + (items.flatMap (fun i => writeMoveOps n (workTape i) + (workWrites i) (workDirections i))) store) := by + induction items generalizing processed store with + | nil => simpa using hprefix + | cons i rest ih => + have hinot : i ∉ processed := hfresh i (by simp) + have hnext := workPrefix_step hprefix i hinot (hstarts i) + have hrestFresh : ∀ j, j ∈ rest → j ∉ i :: processed := by + intro j hj hmem + rcases List.mem_cons.mp hmem with heq | hprocessed + · subst j + exact (List.nodup_cons.mp hnodup).1 hj + · exact hfresh j (by simp [hj]) hprocessed + have hfinal := ih (processed := i :: processed) hnext hrestFresh + (List.nodup_cons.mp hnodup).2 + simpa [List.flatMap_cons, execList_append, List.reverse_cons, + List.append_assoc] using hfinal + +theorem actionOps_represents_internal {tm : TM n} + {cfg next : Complexity.Cfg n tm.Q} {store : Structured.Store} + (hstep : tm.step cfg = some next) + (hrepresents : Represents tm cfg store) + (hworkStart : ∀ i, (cfg.work i).cells 0 = Γ.start) + (houtputStart : cfg.output.cells 0 = Γ.start) + (hone : store (oneReg n) = 1) + (htapeCount : store (tapeCountReg n) = n + 2) : + Represents tm next + (Structured.Basic.execList + (actionOps tm cfg.state (readSymbols cfg)) store) := by + have hnotHalted := TM.state_ne_qhalt_of_step hstep + rcases hdelta : tm.δ cfg.state cfg.input.read + (fun i => (cfg.work i).read) cfg.output.read with + ⟨nextState, workWrites, outputWrite, inputDirection, + workDirections, outputDirection⟩ + rw [TM.step, if_neg hnotHalted, hdelta] at hstep + dsimp only at hstep + injection hstep with hnext + subst next + have hreadInput : + readSymbols cfg (inputTape n) = cfg.input.read := by + simpa [readSymbols, inputTape] using + congrArg Tape.read (tapeAt_input_internal cfg) + have hreadWork : + (fun i => readSymbols cfg (workTape i)) = + (fun i => (cfg.work i).read) := by + funext i + simpa [readSymbols, workTape] using + congrArg Tape.read (tapeAt_work_internal cfg i) + have hreadOutput : + readSymbols cfg (outputTape n) = cfg.output.read := by + simpa [readSymbols, outputTape] using + congrArg Tape.read (tapeAt_output_internal cfg) + let initialized := + (Structured.Basic.imm stateReg (stateCode tm nextState)).exec store + let afterInput := Structured.Basic.execList + (moveOps n (inputTape n) inputDirection) initialized + have hprefix : WorkPrefix tm cfg nextState inputDirection + workWrites workDirections [] afterInput := by + exact actionPrelude_workPrefix nextState inputDirection workWrites + workDirections hrepresents hone htapeCount + let afterWork := Structured.Basic.execList + ((List.finRange n).flatMap (fun i => + writeMoveOps n (workTape i) (workWrites i) (workDirections i))) + afterInput + have hworkPrefix : WorkPrefix tm cfg nextState inputDirection + workWrites workDirections ((List.finRange n).reverse ++ []) afterWork := by + exact workPrefix_list (List.finRange n) [] hprefix (by simp) + (List.nodup_finRange n) hworkStart + have hworkFinal : ∀ i, + RepresentsTape (workTape i) + ((cfg.work i).writeAndMove (workWrites i).toΓ (workDirections i)) + afterWork := by + intro i + simpa using hworkPrefix.work i + let current : Complexity.Cfg n tm.Q := + { state := nextState + input := cfg.input.move inputDirection + work := fun i => + (cfg.work i).writeAndMove (workWrites i).toΓ (workDirections i) + output := cfg.output } + have hcurrent : Represents tm current afterWork := by + exact represents_of_named_tapes hworkPrefix.state hworkPrefix.input + hworkFinal hworkPrefix.output + have houtputTape : tapeAt current (outputTape n) = cfg.output := by + simpa [current, outputTape] using tapeAt_output_internal current + let final := Structured.Basic.execList + (writeMoveOps n (outputTape n) outputWrite outputDirection) afterWork + have houtputFinalRaw := writeMoveOps_tape_internal (tm := tm) + (cfg := current) (outputTape n) outputWrite outputDirection afterWork + hcurrent hworkPrefix.tapeCount hworkPrefix.one + (by simpa [houtputTape] using houtputStart) + have houtputFinal : RepresentsTape (outputTape n) + (cfg.output.writeAndMove outputWrite.toΓ outputDirection) final := by + simpa [final, houtputTape] using houtputFinalRaw + have hinputFinalRaw := writeMoveOps_otherTape_internal + (tm := tm) (cfg := current) (inputTape_ne_outputTape n).symm + outputWrite outputDirection afterWork hcurrent hworkPrefix.tapeCount + have hinputTape : tapeAt current (inputTape n) = + cfg.input.move inputDirection := by + simpa [current, inputTape] using tapeAt_input_internal current + have hinputFinal : RepresentsTape (inputTape n) + (cfg.input.move inputDirection) final := by + rw [hinputTape] at hinputFinalRaw + exact hinputFinalRaw + have hworkFinal' : ∀ i, RepresentsTape (workTape i) + ((cfg.work i).writeAndMove (workWrites i).toΓ (workDirections i)) + final := by + intro i + have hother := writeMoveOps_otherTape_internal + (tm := tm) (cfg := current) (outputTape_ne_workTape n i) + outputWrite outputDirection afterWork hcurrent hworkPrefix.tapeCount + have htape : tapeAt current (workTape i) = + (cfg.work i).writeAndMove (workWrites i).toΓ (workDirections i) := by + simpa [current, workTape] using tapeAt_work_internal current i + rw [htape] at hother + exact hother + have hstateFinal : final stateReg = stateCode tm nextState := by + exact (writeMoveOps_state (outputTape n) outputWrite outputDirection + afterWork hcurrent hworkPrefix.tapeCount).trans hworkPrefix.state + have hfinalRepresents : + Represents tm + { state := nextState + input := cfg.input.move inputDirection + work := fun i => + (cfg.work i).writeAndMove (workWrites i).toΓ (workDirections i) + output := cfg.output.writeAndMove outputWrite.toΓ outputDirection } + final := by + exact represents_of_named_tapes hstateFinal hinputFinal hworkFinal' + houtputFinal + simpa [actionOps, hreadInput, hreadWork, hreadOutput, hdelta, + initialized, afterInput, afterWork, final, execList_append, + Structured.Basic.execList, List.append_assoc] using hfinalRepresents + +private abbrev ResourceEnvelope (tm : TM n) (bound : ℕ) := + Structured.Internal.StoreEnvelope (registerBound n (bound + 1)) + (wordBound tm bound) + +private abbrev ResourceEnvelopeChain (tm : TM n) (bound : ℕ) := + Structured.Internal.Basic.EnvelopeChain (registerBound n (bound + 1)) + (wordBound tm bound) + +private theorem control_lt_registerBound (n bound : ℕ) : + cellBase n < registerBound n (bound + 1) := by + simp [registerBound, cellReg, outputTape] + omega + +private theorem registerBound_le_wordBound (tm : TM n) (bound : ℕ) : + registerBound n (bound + 1) ≤ wordBound tm bound := + le_max_left _ _ + +private theorem headReg_lt_registerBound (n bound : ℕ) + (tape : Fin (n + 2)) : headReg tape < registerBound n (bound + 1) := by + have hfixed : n + 3 ≤ cellBase n := by + simp [cellBase] + omega + exact lt_of_lt_of_le (headReg_lt_control_internal tape) + (le_trans hfixed (Nat.le_of_lt (control_lt_registerBound n bound))) + +private theorem cellReg_lt_registerBound (tape : Fin (n + 2)) + {position bound : ℕ} (hposition : position ≤ bound + 1) : + cellReg n tape position < registerBound n (bound + 1) := by + have hmul := Nat.mul_le_mul_right (n + 2) hposition + simp only [cellReg, registerBound, outputTape] + omega + +private theorem smallValue_le_wordBound (tm : TM n) (bound value : ℕ) + (hvalue : value ≤ 4) : value ≤ wordBound tm bound := by + have hfour : 4 ≤ registerBound n (bound + 1) := by + have hcontrol := control_lt_registerBound n bound + simp [cellBase] at hcontrol + omega + exact le_trans hvalue + (le_trans hfour (registerBound_le_wordBound tm bound)) + +private theorem moveOps_envelopeChain (tm : TM n) (bound : ℕ) + (tape : Fin (n + 2)) (direction : Dir3) (store : Structured.Store) + (henvelope : ResourceEnvelope tm bound store) + (hhead : store (headReg tape) ≤ bound) + (hone : store (oneReg n) = 1) : + ResourceEnvelopeChain tm bound (moveOps n tape direction) store := by + have hindex := headReg_lt_registerBound n bound tape + have hbound : bound + 1 ≤ wordBound tm bound := by + exact le_trans (le_max_right _ _) (le_max_right _ _) + cases direction with + | stay => exact henvelope + | left => + have hfinal : ResourceEnvelope tm bound + ((Structured.Basic.sub (headReg tape) (headReg tape) + (oneReg n)).exec store) := by + apply henvelope.execBasic + · exact hindex + · simp only [Structured.Internal.Basic.writeValue] + omega + exact ⟨henvelope, hfinal⟩ + | right => + have hfinal : ResourceEnvelope tm bound + ((Structured.Basic.add (headReg tape) (headReg tape) + (oneReg n)).exec store) := by + apply henvelope.execBasic + · exact hindex + · simp only [Structured.Internal.Basic.writeValue] + rw [hone] + omega + exact ⟨henvelope, hfinal⟩ + +private theorem writeOps_envelopeChain {tm : TM n} {bound : ℕ} + {cfg : Complexity.Cfg n tm.Q} (tape : Fin (n + 2)) (write : Γw) + (store : Structured.Store) (hrepresents : Represents tm cfg store) + (htapeCount : store (tapeCountReg n) = n + 2) + (henvelope : ResourceEnvelope tm bound store) + (hhead : (tapeAt cfg tape).head ≤ bound) : + ResourceEnvelopeChain tm bound (writeOps n tape write) store := by + let first := (Structured.Basic.imm (valueReg n) + (cellBase n + tape.val)).exec store + let multiplied := (Structured.Basic.mul (addressReg n) (headReg tape) + (tapeCountReg n)).exec first + let addressed := (Structured.Basic.add (addressReg n) (addressReg n) + (valueReg n)).exec multiplied + let valued := (Structured.Basic.imm (valueReg n) + (symbolCode write.toΓ)).exec addressed + let stored := (Structured.Basic.store (addressReg n) (valueReg n)).exec valued + let final := (Structured.Basic.imm (cellReg n tape 0) + (symbolCode Γ.start)).exec stored + have hrange := scratch_range_internal n + have hbaseLt : cellBase n + tape.val < registerBound n (bound + 1) := by + simpa [cellReg] using + (cellReg_lt_registerBound tape (bound := bound) + (position := 0) (by omega)) + have hbaseBound : cellBase n + tape.val ≤ wordBound tm bound := + le_trans (Nat.le_of_lt hbaseLt) (registerBound_le_wordBound tm bound) + have hfirst : ResourceEnvelope tm bound first := by + apply henvelope.execBasic + · exact lt_trans hrange.2.2.2.2.2.1.2 + (control_lt_registerBound n bound) + · simpa [Structured.Internal.Basic.writeValue] using hbaseBound + have hstoreHead : store (headReg tape) = (tapeAt cfg tape).head := + hrepresents (Sum.inr (Sum.inl tape)) + have hfirstHead : first (headReg tape) = store (headReg tape) := by + have hne : headReg tape ≠ valueReg n := by + simp [headReg, valueReg] + omega + simp [first, Structured.Basic.exec, Function.update_of_ne hne] + have hfirstCount : first (tapeCountReg n) = store (tapeCountReg n) := by + simp [first, Structured.Basic.exec, tapeCountReg, valueReg, + Function.update_of_ne] + have hproductBound : (tapeAt cfg tape).head * (n + 2) ≤ + wordBound tm bound := by + have htarget := cellReg_lt_registerBound tape + (position := (tapeAt cfg tape).head) (bound := bound) (by omega) + have hproduct : (tapeAt cfg tape).head * (n + 2) < + registerBound n (bound + 1) := by + simp [cellReg] at htarget + omega + exact le_trans (Nat.le_of_lt hproduct) + (registerBound_le_wordBound tm bound) + have hmultiplied : ResourceEnvelope tm bound multiplied := by + apply hfirst.execBasic + · exact lt_trans hrange.2.2.2.2.1.2 + (control_lt_registerBound n bound) + · simp only [Structured.Internal.Basic.writeValue] + rw [hfirstHead, hfirstCount, hstoreHead, htapeCount] + exact hproductBound + have hmultipliedAddress : multiplied (addressReg n) = + (tapeAt cfg tape).head * (n + 2) := by + simp only [multiplied, Structured.Basic.exec, Function.update_self] + rw [hfirstHead, hfirstCount, hstoreHead, htapeCount] + have hmultipliedValue : multiplied (valueReg n) = + cellBase n + tape.val := by + simp [multiplied, first, Structured.Basic.exec, valueReg, addressReg, + Function.update_of_ne] + have htargetLt : cellReg n tape (tapeAt cfg tape).head < + registerBound n (bound + 1) := + cellReg_lt_registerBound tape (bound := bound) (by omega) + have htargetBound : cellReg n tape (tapeAt cfg tape).head ≤ + wordBound tm bound := + le_trans (Nat.le_of_lt htargetLt) (registerBound_le_wordBound tm bound) + have haddressed : ResourceEnvelope tm bound addressed := by + apply hmultiplied.execBasic + · exact lt_trans hrange.2.2.2.2.1.2 + (control_lt_registerBound n bound) + · simp only [Structured.Internal.Basic.writeValue] + rw [hmultipliedAddress, hmultipliedValue] + simp [cellReg] at htargetBound + omega + have hwriteBound : symbolCode write.toΓ ≤ wordBound tm bound := by + apply smallValue_le_wordBound tm bound + cases write <;> decide + have hvalued : ResourceEnvelope tm bound valued := by + apply haddressed.execBasic + · exact lt_trans hrange.2.2.2.2.2.1.2 + (control_lt_registerBound n bound) + · simpa [Structured.Internal.Basic.writeValue] using hwriteBound + have hvaluedAddress : valued (addressReg n) = + cellReg n tape (tapeAt cfg tape).head := by + simp only [valued, Structured.Basic.exec] + rw [Function.update_of_ne] + · simp [addressed, Structured.Basic.exec, hmultipliedAddress, + hmultipliedValue, cellReg] + omega + · simp [addressReg, valueReg] + have hvaluedValue : valued (valueReg n) = symbolCode write.toΓ := by + simp [valued, Structured.Basic.exec] + have hstored : ResourceEnvelope tm bound stored := by + apply hvalued.execBasic + · simp only [Structured.Internal.Basic.writeIndex] + rw [hvaluedAddress] + exact htargetLt + · simp only [Structured.Internal.Basic.writeValue] + rw [hvaluedValue] + exact hwriteBound + have hstartBound : symbolCode Γ.start ≤ wordBound tm bound := + smallValue_le_wordBound tm bound _ (by decide) + have hfinal : ResourceEnvelope tm bound final := by + apply hstored.execBasic + · exact cellReg_lt_registerBound tape (bound := bound) + (position := 0) (by omega) + · simpa [Structured.Internal.Basic.writeValue] using hstartBound + simpa [writeOps, addressOps, first, multiplied, addressed, valued, stored, + final] using And.intro henvelope (And.intro hfirst + (And.intro hmultiplied (And.intro haddressed + (And.intro hvalued (And.intro hstored hfinal))))) + +private theorem writeMoveOps_envelopeChain {tm : TM n} {bound : ℕ} + {cfg : Complexity.Cfg n tm.Q} (tape : Fin (n + 2)) (write : Γw) + (direction : Dir3) (store : Structured.Store) + (hrepresents : Represents tm cfg store) + (htapeCount : store (tapeCountReg n) = n + 2) + (hone : store (oneReg n) = 1) + (hstart : (tapeAt cfg tape).cells 0 = Γ.start) + (hhead : (tapeAt cfg tape).head ≤ bound) + (henvelope : Structured.Internal.StoreEnvelope + (registerBound n (bound + 1)) (wordBound tm bound) store) : + ResourceEnvelopeChain tm bound + (writeMoveOps n tape write direction) store := by + let written := Structured.Basic.execList (writeOps n tape write) store + have hwrite := writeOps_envelopeChain tape write store hrepresents + htapeCount henvelope hhead + have hwrittenTape := writeOps_tape tape write store hrepresents + htapeCount hstart + have hwrittenHead : written (headReg tape) ≤ bound := by + change Structured.Basic.execList (writeOps n tape write) store + (headReg tape) ≤ bound + rw [hwrittenTape.1, Tape.write_head] + exact hhead + have hrange := scratch_range_internal n + have hwrittenOne : written (oneReg n) = 1 := by + exact (writeOps_control tape write store hrepresents htapeCount + (oneReg n) hrange.2.1.2 (by simp [oneReg, valueReg]) + (by simp [oneReg, addressReg])).trans hone + have hmove := moveOps_envelopeChain tm bound tape direction written + hwrite.final hwrittenHead hwrittenOne + simpa [writeMoveOps] using hwrite.append hmove + +private theorem workPrefix_list_envelope {tm : TM n} {bound : ℕ} + {cfg : Complexity.Cfg n tm.Q} {nextState : tm.Q} + {inputDirection : Dir3} {workWrites : Fin n → Γw} + {workDirections : Fin n → Dir3} + (items processed : List (Fin n)) {store : Structured.Store} + (hprefix : WorkPrefix tm cfg nextState inputDirection + workWrites workDirections processed store) + (henvelope : ResourceEnvelope tm bound store) + (hfresh : ∀ i, i ∈ items → i ∉ processed) + (hnodup : items.Nodup) + (hheads : ∀ i, (cfg.work i).head ≤ bound) + (hstarts : ∀ i, (cfg.work i).cells 0 = Γ.start) : + let ops := items.flatMap (fun i => writeMoveOps n (workTape i) + (workWrites i) (workDirections i)) + WorkPrefix tm cfg nextState inputDirection workWrites workDirections + (items.reverse ++ processed) (Structured.Basic.execList ops store) ∧ + ResourceEnvelopeChain tm bound ops store := by + induction items generalizing processed store with + | nil => exact ⟨by simpa using hprefix, henvelope⟩ + | cons i rest ih => + have hinot : i ∉ processed := hfresh i (by simp) + let current : Complexity.Cfg n tm.Q := + { state := nextState + input := cfg.input.move inputDirection + work := fun j => if j ∈ processed then + (cfg.work j).writeAndMove (workWrites j).toΓ (workDirections j) + else cfg.work j + output := cfg.output } + have hcurrent : Represents tm current store := by + exact represents_of_named_tapes hprefix.state hprefix.input hprefix.work + hprefix.output + have hselectedTape : tapeAt current (workTape i) = cfg.work i := by + simp [current, workTape, hinot, tapeAt_work_internal] + have hblock := writeMoveOps_envelopeChain (tm := tm) (bound := bound) + (cfg := current) (workTape i) (workWrites i) (workDirections i) store + hcurrent hprefix.tapeCount hprefix.one + (by simpa [hselectedTape] using hstarts i) + (by simpa [hselectedTape] using hheads i) henvelope + have hnext := workPrefix_step hprefix i hinot (hstarts i) + have hrestFresh : ∀ j, j ∈ rest → j ∉ i :: processed := by + intro j hj hmem + rcases List.mem_cons.mp hmem with heq | hprocessed + · subst j + exact (List.nodup_cons.mp hnodup).1 hj + · exact hfresh j (by simp [hj]) hprocessed + obtain ⟨hfinalPrefix, hrestChain⟩ := + ih (processed := i :: processed) hnext hblock.final hrestFresh + (List.nodup_cons.mp hnodup).2 + refine ⟨?_, ?_⟩ + · simpa [List.flatMap_cons, execList_append, List.reverse_cons, + List.append_assoc] using hfinalPrefix + · simpa [List.flatMap_cons] using hblock.append hrestChain + +private theorem actionOps_envelopeChain_internal {tm : TM n} {bound : ℕ} + {cfg : Complexity.Cfg n tm.Q} {store : Structured.Store} + (hrepresents : Represents tm cfg store) + (hheads : HeadsBounded cfg bound) + (hworkStart : ∀ i, (cfg.work i).cells 0 = Γ.start) + (houtputStart : cfg.output.cells 0 = Γ.start) + (hone : store (oneReg n) = 1) + (htapeCount : store (tapeCountReg n) = n + 2) + (henvelope : ResourceEnvelope tm bound store) : + ResourceEnvelopeChain tm bound + (actionOps tm cfg.state (readSymbols cfg)) store := by + rcases hdelta : tm.δ cfg.state cfg.input.read + (fun i => (cfg.work i).read) cfg.output.read with + ⟨nextState, workWrites, outputWrite, inputDirection, + workDirections, outputDirection⟩ + have hreadInput : readSymbols cfg (inputTape n) = cfg.input.read := by + simpa [readSymbols, inputTape] using + congrArg Tape.read (tapeAt_input_internal cfg) + have hreadWork : (fun i => readSymbols cfg (workTape i)) = + (fun i => (cfg.work i).read) := by + funext i + simpa [readSymbols, workTape] using + congrArg Tape.read (tapeAt_work_internal cfg i) + have hreadOutput : readSymbols cfg (outputTape n) = cfg.output.read := by + simpa [readSymbols, outputTape] using + congrArg Tape.read (tapeAt_output_internal cfg) + let initialized := + (Structured.Basic.imm stateReg (stateCode tm nextState)).exec store + have hstateBound : stateCode tm nextState ≤ wordBound tm bound := by + have hstateLt : stateCode tm nextState < Fintype.card tm.Q := by + simp [stateCode] + exact le_trans (Nat.le_of_lt hstateLt) + (le_trans (le_max_left _ _) (le_max_right _ _)) + have hinitialized : ResourceEnvelope tm bound initialized := by + apply henvelope.execBasic + · simp [stateReg, registerBound, cellReg, outputTape, cellBase] + · simpa [Structured.Internal.Basic.writeValue] using hstateBound + have hstateChain : ResourceEnvelopeChain tm bound + [.imm stateReg (stateCode tm nextState)] store := + ⟨henvelope, hinitialized⟩ + have hinputHead : initialized (headReg (inputTape n)) ≤ bound := by + have hhead := hheads (inputTape n) + have hstored := hrepresents (Sum.inr (Sum.inl (inputTape n))) + change store (headReg (inputTape n)) = + (tapeAt cfg (inputTape n)).head at hstored + rw [show tapeAt cfg (inputTape n) = cfg.input by + simpa [inputTape] using tapeAt_input_internal cfg] at hhead hstored + rw [show initialized (headReg (inputTape n)) = + store (headReg (inputTape n)) by + simp [initialized, Structured.Basic.exec, stateReg, headReg, inputTape, + Function.update_of_ne]] + rw [hstored] + exact hhead + have honeInitialized : initialized (oneReg n) = 1 := by + simpa [initialized, Structured.Basic.exec, stateReg, oneReg, + Function.update_of_ne] using hone + let afterInput := Structured.Basic.execList + (moveOps n (inputTape n) inputDirection) initialized + have hinputChain := moveOps_envelopeChain tm bound (inputTape n) + inputDirection initialized hinitialized hinputHead honeInitialized + have hprefix : WorkPrefix tm cfg nextState inputDirection + workWrites workDirections [] afterInput := by + exact actionPrelude_workPrefix nextState inputDirection workWrites + workDirections hrepresents hone htapeCount + have hworkHeads : ∀ i, (cfg.work i).head ≤ bound := by + intro i + have hhead := hheads (workTape i) + rwa [show tapeAt cfg (workTape i) = cfg.work i by + simpa [workTape] using tapeAt_work_internal cfg i] at hhead + obtain ⟨hworkPrefix, hworkChain⟩ := workPrefix_list_envelope + (bound := bound) (List.finRange n) [] hprefix hinputChain.final + (by simp) (List.nodup_finRange n) hworkHeads hworkStart + let workOps := (List.finRange n).flatMap (fun i => + writeMoveOps n (workTape i) (workWrites i) (workDirections i)) + let afterWork := Structured.Basic.execList workOps afterInput + let current : Complexity.Cfg n tm.Q := + { state := nextState + input := cfg.input.move inputDirection + work := fun i => + (cfg.work i).writeAndMove (workWrites i).toΓ (workDirections i) + output := cfg.output } + have hworkFinal : ∀ i, RepresentsTape (workTape i) + ((cfg.work i).writeAndMove (workWrites i).toΓ (workDirections i)) + afterWork := by + intro i + simpa [afterWork, workOps] using hworkPrefix.work i + have hcurrent : Represents tm current afterWork := by + exact represents_of_named_tapes hworkPrefix.state hworkPrefix.input + hworkFinal hworkPrefix.output + have houtputTape : tapeAt current (outputTape n) = cfg.output := by + simpa [current, outputTape] using tapeAt_output_internal current + have houtputHead : (tapeAt current (outputTape n)).head ≤ bound := by + rw [houtputTape] + have hhead := hheads (outputTape n) + rwa [show tapeAt cfg (outputTape n) = cfg.output by + simpa [outputTape] using tapeAt_output_internal cfg] at hhead + have houtputStartCurrent : + (tapeAt current (outputTape n)).cells 0 = Γ.start := by + rw [houtputTape] + exact houtputStart + have houtputChain := writeMoveOps_envelopeChain + (tm := tm) (bound := bound) (cfg := current) (outputTape n) + outputWrite outputDirection afterWork hcurrent hworkPrefix.tapeCount + hworkPrefix.one houtputStartCurrent houtputHead hworkChain.final + have hcombined := hstateChain.append (hinputChain.append + (hworkChain.append houtputChain)) + simpa [actionOps, hreadInput, hreadWork, hreadOutput, hdelta, initialized, + afterInput, workOps, afterWork, List.append_assoc] using hcombined + +theorem actionOps_measured_internal {tm : TM n} {bound : ℕ} + {cfg next : Complexity.Cfg n tm.Q} {store : Structured.Store} + (hstep : tm.step cfg = some next) + (hrepresents : Represents tm cfg store) + (hheads : HeadsBounded cfg bound) + (hworkStart : ∀ i, (cfg.work i).cells 0 = Γ.start) + (houtputStart : cfg.output.cells 0 = Γ.start) + (hone : store (oneReg n) = 1) + (htapeCount : store (tapeCountReg n) = n + 2) + (henvelope : Structured.Internal.StoreEnvelope + (registerBound n (bound + 1)) (wordBound tm bound) store) : + let final := Structured.Basic.execList + (actionOps tm cfg.state (readSymbols cfg)) store + Structured.Internal.MeasuredRuns + (action tm cfg.state (readSymbols cfg)) store final + (actionOps tm cfg.state (readSymbols cfg)).length + (4 * (actionOps tm cfg.state (readSymbols cfg)).length * + wordWidth tm bound) (spaceBound tm bound) ∧ + Represents tm next final ∧ + Structured.Internal.StoreEnvelope + (registerBound n (bound + 1)) (wordBound tm bound) final := by + have hchain := actionOps_envelopeChain_internal hrepresents hheads + hworkStart houtputStart hone htapeCount henvelope + have hmeasured := Structured.Internal.MeasuredRuns.basicsEnvelopeChain + (actionOps tm cfg.state (readSymbols cfg)) store hchain + refine ⟨?_, actionOps_represents_internal hstep hrepresents hworkStart + houtputStart hone htapeCount, hmeasured.2⟩ + simpa [action, wordWidth, spaceBound, Structured.Internal.valueWidth, + Structured.Internal.envelopeSpace] using hmeasured.1 + + +end Sparse + +end TMConfig + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Step/Internal/Dispatch.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Step/Internal/Dispatch.lean new file mode 100644 index 0000000000..07ed783843 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Step/Internal/Dispatch.lean @@ -0,0 +1,463 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.Step.Internal.Action +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.Switch +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.Step.Internal.Load + +/-! +# Nested finite dispatch for the fixed sparse TM transition -- proof internals +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace TMConfig + +namespace Sparse + + +private theorem cleared_represents {tm : TM n} {test : ℕ} + {cfg : Complexity.Cfg n tm.Q} {store : Structured.Store} + (hrepresents : Represents tm cfg store) + (hlow : n + 3 ≤ test) (hhigh : test < cellBase n) : + Represents tm cfg (Structured.Switch.cleared store test) := by + exact hrepresents.update_control_internal hlow hhigh + +private theorem cleared_apply_of_ne (store : Structured.Store) {test reg : ℕ} + (hne : reg ≠ test) : + Structured.Switch.cleared store test reg = store reg := by + simp [Structured.Switch.cleared, Function.update_of_ne hne] + +private theorem symbolReg_injective (n : ℕ) : + Function.Injective (symbolReg n) := by + intro first second heq + apply Fin.ext + simp [symbolReg] at heq + omega + +private theorem symbolReg_ne_one (n : ℕ) (tape : Fin (n + 2)) : + symbolReg n tape ≠ oneReg n := by + simp [symbolReg, oneReg] + omega + +private theorem stateScratchReg_ne_one (n : ℕ) : + stateScratchReg n ≠ oneReg n := by + simp [stateScratchReg, oneReg] + +private theorem stateScratchReg_ne_symbolReg (n : ℕ) + (tape : Fin (n + 2)) : + symbolReg n tape ≠ stateScratchReg n := by + simp [symbolReg, stateScratchReg] + omega + +private theorem stateCode_lt_internal (tm : TM n) (state : tm.Q) : + stateCode tm state < Fintype.card tm.Q := by + exact (Fintype.equivFin tm.Q state).isLt + +theorem dispatchSymbols_exec_internal {tm : TM n} + {cfg next : Complexity.Cfg n tm.Q} {store : Structured.Store} + (state : tm.Q) (actual symbols : Fin (n + 2) → Γ) + (remaining : List (Fin (n + 2))) + (hstate : state = cfg.state) + (hstep : tm.step cfg = some next) + (hrepresents : Represents tm cfg store) + (hworkStart : ∀ i, (cfg.work i).cells 0 = Γ.start) + (houtputStart : cfg.output.cells 0 = Γ.start) + (hone : store (oneReg n) = 1) + (htapeCount : store (tapeCountReg n) = n + 2) + (hactual : actual = readSymbols cfg) + (hloaded : ∀ tape, tape ∈ remaining → + store (symbolReg n tape) = symbolCode (actual tape)) + (hassigned : ∀ tape, tape ∉ remaining → symbols tape = actual tape) + (hnodup : remaining.Nodup) : + ∃ final cost space, + Structured.Exec (dispatchSymbols tm state remaining symbols) + store final (dispatchSteps tm state actual remaining) cost space ∧ + Represents tm next final := by + subst state + subst actual + induction remaining generalizing symbols store with + | nil => + have hsymbols : symbols = readSymbols cfg := by + funext tape + exact hassigned tape (by simp) + subst symbols + obtain ⟨cost, space, hexec⟩ := + Structured.Internal.exec_basics_exists + (actionOps tm cfg.state (readSymbols cfg)) store + refine ⟨Structured.Basic.execList + (actionOps tm cfg.state (readSymbols cfg)) store, + cost, space, ?_, ?_⟩ + · simpa [dispatchSymbols, action, dispatchSteps] using hexec + · exact actionOps_represents_internal hstep hrepresents hworkStart + houtputStart hone htapeCount + | cons tape rest ih => + have htapeCode := hloaded tape (by simp) + have htestOne : symbolReg n tape ≠ oneReg n := + symbolReg_ne_one n tape + let cleared := Structured.Switch.cleared store (symbolReg n tape) + have hrange := scratch_range_internal n + have hclearedRepresents : Represents tm cfg cleared := + cleared_represents hrepresents (hrange.2.2.2.2.2.2 tape).1 + (hrange.2.2.2.2.2.2 tape).2 + have hclearedOne : cleared (oneReg n) = 1 := by + exact (cleared_apply_of_ne store htestOne.symm).trans hone + have hclearedCount : cleared (tapeCountReg n) = n + 2 := by + have hne : tapeCountReg n ≠ symbolReg n tape := by + simp [tapeCountReg, symbolReg] + omega + exact (cleared_apply_of_ne store hne).trans htapeCount + have hclearedLoaded : ∀ candidate, candidate ∈ rest → + cleared (symbolReg n candidate) = + symbolCode (readSymbols cfg candidate) := by + intro candidate hcandidate + have hne : candidate ≠ tape := by + intro heq + subst candidate + exact (List.nodup_cons.mp hnodup).1 hcandidate + have hregs : symbolReg n candidate ≠ symbolReg n tape := + fun heq => hne ((symbolReg_injective n) heq) + exact (cleared_apply_of_ne store hregs).trans + (hloaded candidate (by simp [hcandidate])) + have hclearedAssigned : ∀ candidate, candidate ∉ rest → + Function.update symbols tape (readSymbols cfg tape) candidate = + readSymbols cfg candidate := by + intro candidate hnot + by_cases heq : candidate = tape + · subst candidate + simp + · rw [Function.update_of_ne heq] + exact hassigned candidate (by simp [heq, hnot]) + obtain ⟨final, branchCost, branchSpace, hbranch, hfinalRepresents⟩ := + ih (symbols := Function.update symbols tape (readSymbols cfg tape)) + (store := cleared) hclearedRepresents hclearedOne hclearedCount + (List.nodup_cons.mp hnodup).2 hclearedLoaded hclearedAssigned + have hselectedBranch : + ∃ cost space, + Structured.Exec + ((fun code : Fin 4 => + dispatchSymbols tm cfg.state rest + (Function.update symbols tape (symbolDecode code.val))) + ⟨symbolCode (readSymbols cfg tape), + symbolCode_lt_internal (readSymbols cfg tape)⟩) + cleared final + (dispatchSteps tm cfg.state (readSymbols cfg) rest) + cost space := by + refine ⟨branchCost, branchSpace, ?_⟩ + simpa [symbolDecode_code_internal] using hbranch + obtain ⟨cost, space, hexec⟩ := Structured.Switch.select_exec + (fun code : Fin 4 => + dispatchSymbols tm cfg.state rest + (Function.update symbols tape (symbolDecode code.val))) + store final (symbolCode_lt_internal (readSymbols cfg tape)) + htapeCode hone htestOne hselectedBranch + refine ⟨final, cost, space, ?_, hfinalRepresents⟩ + simpa [dispatchSymbols, dispatchSteps] using hexec + +theorem dispatchState_exec_internal {tm : TM n} + {cfg next : Complexity.Cfg n tm.Q} {store : Structured.Store} + (hstep : tm.step cfg = some next) + (hrepresents : Represents tm cfg store) + (hworkStart : ∀ i, (cfg.work i).cells 0 = Γ.start) + (houtputStart : cfg.output.cells 0 = Γ.start) + (hone : store (oneReg n) = 1) + (htapeCount : store (tapeCountReg n) = n + 2) + (hstate : store (stateScratchReg n) = stateCode tm cfg.state) + (hloaded : ∀ tape, store (symbolReg n tape) = + symbolCode (readSymbols cfg tape)) : + ∃ final cost space, + Structured.Exec (dispatchState tm) store final + (Structured.Switch.stepCount (stateCode tm cfg.state) + (dispatchSteps tm cfg.state (readSymbols cfg) + (List.finRange (n + 2)))) cost space ∧ + Represents tm next final := by + let cleared := Structured.Switch.cleared store (stateScratchReg n) + have hrange := scratch_range_internal n + have hclearedRepresents : Represents tm cfg cleared := + cleared_represents hrepresents hrange.2.2.2.1.1 hrange.2.2.2.1.2 + have hclearedOne : cleared (oneReg n) = 1 := by + exact (cleared_apply_of_ne store (stateScratchReg_ne_one n).symm).trans hone + have hclearedCount : cleared (tapeCountReg n) = n + 2 := by + have hne : tapeCountReg n ≠ stateScratchReg n := by + simp [tapeCountReg, stateScratchReg] + exact (cleared_apply_of_ne store hne).trans htapeCount + have hclearedLoaded : ∀ tape, + cleared (symbolReg n tape) = symbolCode (readSymbols cfg tape) := by + intro tape + exact (cleared_apply_of_ne store + (stateScratchReg_ne_symbolReg n tape)).trans (hloaded tape) + have hbranchState : + (Fintype.equivFin tm.Q).symm + ⟨stateCode tm cfg.state, stateCode_lt_internal tm cfg.state⟩ = + cfg.state := by + exact (Fintype.equivFin tm.Q).symm_apply_apply cfg.state + obtain ⟨final, branchCost, branchSpace, hbranch, hfinalRepresents⟩ := + dispatchSymbols_exec_internal + ((Fintype.equivFin tm.Q).symm + ⟨stateCode tm cfg.state, stateCode_lt_internal tm cfg.state⟩) + (readSymbols cfg) (fun _ => Γ.blank) (List.finRange (n + 2)) + hbranchState hstep hclearedRepresents hworkStart houtputStart + hclearedOne hclearedCount rfl (fun tape _ => hclearedLoaded tape) + (by simp) (List.nodup_finRange (n + 2)) + have hselectedBranch : + ∃ cost space, + Structured.Exec + ((fun stateCode : Fin (Fintype.card tm.Q) => + dispatchSymbols tm ((Fintype.equivFin tm.Q).symm stateCode) + (List.finRange (n + 2)) (fun _ => Γ.blank)) + ⟨stateCode tm cfg.state, stateCode_lt_internal tm cfg.state⟩) + cleared final + (dispatchSteps tm cfg.state (readSymbols cfg) + (List.finRange (n + 2))) cost space := by + refine ⟨branchCost, branchSpace, ?_⟩ + simpa [hbranchState] using hbranch + obtain ⟨cost, space, hexec⟩ := Structured.Switch.select_exec + (fun stateCode : Fin (Fintype.card tm.Q) => + dispatchSymbols tm ((Fintype.equivFin tm.Q).symm stateCode) + (List.finRange (n + 2)) (fun _ => Γ.blank)) + store final (stateCode_lt_internal tm cfg.state) hstate hone + (stateScratchReg_ne_one n) hselectedBranch + refine ⟨final, cost, space, ?_, hfinalRepresents⟩ + simpa [dispatchState] using hexec + +theorem program_exec_internal {tm : TM n} + {cfg next : Complexity.Cfg n tm.Q} {store : Structured.Store} + (hstep : tm.step cfg = some next) + (hrepresents : Represents tm cfg store) + (hworkStart : ∀ i, (cfg.work i).cells 0 = Γ.start) + (houtputStart : cfg.output.cells 0 = Γ.start) : + ∃ final cost space, + Structured.Exec (program tm) store final + (stepCount tm cfg) cost space ∧ + Represents tm next final := by + let loaded := Structured.Basic.execList (loadOps n) store + obtain ⟨loadCost, loadSpace, hloadExec⟩ := + Structured.Internal.exec_basics_exists (loadOps n) store + have hloaded := loadOps_loaded_internal hrepresents + obtain ⟨final, dispatchCost, dispatchSpace, hdispatch, + hfinalRepresents⟩ := dispatchState_exec_internal hstep hloaded.1 + hworkStart houtputStart hloaded.2.2.1 hloaded.2.2.2.1 + hloaded.2.2.2.2.1 hloaded.2.2.2.2.2 + refine ⟨final, loadCost + dispatchCost, max loadSpace dispatchSpace, ?_, + hfinalRepresents⟩ + simpa [program, stepCount, loaded] using Structured.Exec.seq hloadExec hdispatch + +/-- Register and word bounds preserved by sparse step dispatch. -/ +abbrev ResourceEnvelope (tm : TM n) (bound : ℕ) := + Structured.Internal.StoreEnvelope (registerBound n (bound + 1)) + (wordBound tm bound) + +private theorem control_lt_registerBound (n bound : ℕ) : + cellBase n < registerBound n (bound + 1) := by + simp [registerBound, cellReg, outputTape] + omega + +private theorem cleared_envelope {tm : TM n} {bound test : ℕ} + {store : Structured.Store} (henvelope : ResourceEnvelope tm bound store) + (htest : test < registerBound n (bound + 1)) : + ResourceEnvelope tm bound (Structured.Switch.cleared store test) := by + exact henvelope.update htest (by simp) + +theorem dispatchSymbols_measured_internal {tm : TM n} {bound : ℕ} + {cfg next : Complexity.Cfg n tm.Q} {store : Structured.Store} + (state : tm.Q) (actual symbols : Fin (n + 2) → Γ) + (remaining : List (Fin (n + 2))) + (hstate : state = cfg.state) + (hstep : tm.step cfg = some next) + (hrepresents : Represents tm cfg store) + (hheads : HeadsBounded cfg bound) + (hworkStart : ∀ i, (cfg.work i).cells 0 = Γ.start) + (houtputStart : cfg.output.cells 0 = Γ.start) + (hone : store (oneReg n) = 1) + (htapeCount : store (tapeCountReg n) = n + 2) + (hactual : actual = readSymbols cfg) + (hloaded : ∀ tape, tape ∈ remaining → + store (symbolReg n tape) = symbolCode (actual tape)) + (hassigned : ∀ tape, tape ∉ remaining → symbols tape = actual tape) + (hnodup : remaining.Nodup) + (henvelope : ResourceEnvelope tm bound store) : + ∃ final, + Structured.Internal.MeasuredRuns + (dispatchSymbols tm state remaining symbols) store final + (dispatchSteps tm state actual remaining) + (dispatchCost tm bound state actual remaining) + (spaceBound tm bound) ∧ + Represents tm next final ∧ ResourceEnvelope tm bound final := by + subst state + subst actual + induction remaining generalizing symbols store with + | nil => + have hsymbols : symbols = readSymbols cfg := by + funext tape + exact hassigned tape (by simp) + subst symbols + let final := Structured.Basic.execList + (actionOps tm cfg.state (readSymbols cfg)) store + have haction := actionOps_measured_internal hstep hrepresents hheads + hworkStart houtputStart hone htapeCount henvelope + refine ⟨final, ?_, haction.2.1, haction.2.2⟩ + simpa [dispatchSymbols, dispatchSteps, dispatchCost, final] using haction.1 + | cons tape rest ih => + have htapeCode := hloaded tape (by simp) + have htestOne : symbolReg n tape ≠ oneReg n := + symbolReg_ne_one n tape + let cleared := Structured.Switch.cleared store (symbolReg n tape) + have hrange := scratch_range_internal n + have hclearedRepresents : Represents tm cfg cleared := + cleared_represents hrepresents (hrange.2.2.2.2.2.2 tape).1 + (hrange.2.2.2.2.2.2 tape).2 + have hclearedOne : cleared (oneReg n) = 1 := by + exact (cleared_apply_of_ne store htestOne.symm).trans hone + have hclearedCount : cleared (tapeCountReg n) = n + 2 := by + have hne : tapeCountReg n ≠ symbolReg n tape := by + simp [tapeCountReg, symbolReg] + omega + exact (cleared_apply_of_ne store hne).trans htapeCount + have hclearedEnvelope : ResourceEnvelope tm bound cleared := + cleared_envelope henvelope + (lt_trans (hrange.2.2.2.2.2.2 tape).2 + (control_lt_registerBound n bound)) + have hclearedLoaded : ∀ candidate, candidate ∈ rest → + cleared (symbolReg n candidate) = + symbolCode (readSymbols cfg candidate) := by + intro candidate hcandidate + have hne : candidate ≠ tape := by + intro heq + subst candidate + exact (List.nodup_cons.mp hnodup).1 hcandidate + have hregs : symbolReg n candidate ≠ symbolReg n tape := + fun heq => hne ((symbolReg_injective n) heq) + exact (cleared_apply_of_ne store hregs).trans + (hloaded candidate (by simp [hcandidate])) + have hclearedAssigned : ∀ candidate, candidate ∉ rest → + Function.update symbols tape (readSymbols cfg tape) candidate = + readSymbols cfg candidate := by + intro candidate hnot + by_cases heq : candidate = tape + · subst candidate + simp + · rw [Function.update_of_ne heq] + exact hassigned candidate (by simp [heq, hnot]) + obtain ⟨final, hbranch, hfinalRepresents, hfinalEnvelope⟩ := + ih (symbols := Function.update symbols tape (readSymbols cfg tape)) + (store := cleared) hclearedRepresents hclearedOne hclearedCount + (List.nodup_cons.mp hnodup).2 hclearedEnvelope hclearedLoaded + hclearedAssigned + have hselectedBranch : Structured.Internal.MeasuredRuns + ((fun code : Fin 4 => + dispatchSymbols tm cfg.state rest + (Function.update symbols tape (symbolDecode code.val))) + ⟨symbolCode (readSymbols cfg tape), + symbolCode_lt_internal (readSymbols cfg tape)⟩) + cleared final + (dispatchSteps tm cfg.state (readSymbols cfg) rest) + (dispatchCost tm bound cfg.state (readSymbols cfg) rest) + (spaceBound tm bound) := by + simpa [symbolDecode_code_internal] using hbranch + have hrun := Structured.Switch.select_measured + (fun code : Fin 4 => + dispatchSymbols tm cfg.state rest + (Function.update symbols tape (symbolDecode code.val))) + store final (symbolCode_lt_internal (readSymbols cfg tape)) + htapeCode hone htestOne + (lt_trans (hrange.2.2.2.2.2.2 tape).2 + (control_lt_registerBound n bound)) + henvelope hselectedBranch + refine ⟨final, ?_, hfinalRepresents, hfinalEnvelope⟩ + simpa [dispatchSymbols, dispatchSteps, dispatchCost, wordWidth, + Structured.Internal.valueWidth, spaceBound, + Structured.Internal.envelopeSpace] using hrun + +theorem dispatchState_measured_internal {tm : TM n} {bound : ℕ} + {cfg next : Complexity.Cfg n tm.Q} {store : Structured.Store} + (hstep : tm.step cfg = some next) + (hrepresents : Represents tm cfg store) + (hheads : HeadsBounded cfg bound) + (hworkStart : ∀ i, (cfg.work i).cells 0 = Γ.start) + (houtputStart : cfg.output.cells 0 = Γ.start) + (hone : store (oneReg n) = 1) + (htapeCount : store (tapeCountReg n) = n + 2) + (hstate : store (stateScratchReg n) = stateCode tm cfg.state) + (hloaded : ∀ tape, store (symbolReg n tape) = + symbolCode (readSymbols cfg tape)) + (henvelope : ResourceEnvelope tm bound store) : + ∃ final, + Structured.Internal.MeasuredRuns (dispatchState tm) store final + (Structured.Switch.stepCount (stateCode tm cfg.state) + (dispatchSteps tm cfg.state (readSymbols cfg) + (List.finRange (n + 2)))) + (Structured.Switch.costBound (stateCode tm cfg.state) + (dispatchCost tm bound cfg.state (readSymbols cfg) + (List.finRange (n + 2))) (wordWidth tm bound)) + (spaceBound tm bound) ∧ + Represents tm next final ∧ ResourceEnvelope tm bound final := by + let cleared := Structured.Switch.cleared store (stateScratchReg n) + have hrange := scratch_range_internal n + have hclearedRepresents : Represents tm cfg cleared := + cleared_represents hrepresents hrange.2.2.2.1.1 hrange.2.2.2.1.2 + have hclearedOne : cleared (oneReg n) = 1 := by + exact (cleared_apply_of_ne store (stateScratchReg_ne_one n).symm).trans hone + have hclearedCount : cleared (tapeCountReg n) = n + 2 := by + have hne : tapeCountReg n ≠ stateScratchReg n := by + simp [tapeCountReg, stateScratchReg] + exact (cleared_apply_of_ne store hne).trans htapeCount + have hclearedEnvelope : ResourceEnvelope tm bound cleared := + cleared_envelope henvelope + (lt_trans hrange.2.2.2.1.2 (control_lt_registerBound n bound)) + have hclearedLoaded : ∀ tape, + cleared (symbolReg n tape) = symbolCode (readSymbols cfg tape) := by + intro tape + exact (cleared_apply_of_ne store + (stateScratchReg_ne_symbolReg n tape)).trans (hloaded tape) + have hbranchState : + (Fintype.equivFin tm.Q).symm + ⟨stateCode tm cfg.state, stateCode_lt_internal tm cfg.state⟩ = + cfg.state := + (Fintype.equivFin tm.Q).symm_apply_apply cfg.state + obtain ⟨final, hbranch, hfinalRepresents, hfinalEnvelope⟩ := + dispatchSymbols_measured_internal + ((Fintype.equivFin tm.Q).symm + ⟨stateCode tm cfg.state, stateCode_lt_internal tm cfg.state⟩) + (readSymbols cfg) (fun _ => Γ.blank) (List.finRange (n + 2)) + hbranchState hstep hclearedRepresents hheads hworkStart houtputStart + hclearedOne hclearedCount rfl (fun tape _ => hclearedLoaded tape) + (by simp) (List.nodup_finRange (n + 2)) hclearedEnvelope + have hselectedBranch : Structured.Internal.MeasuredRuns + ((fun stateCode : Fin (Fintype.card tm.Q) => + dispatchSymbols tm ((Fintype.equivFin tm.Q).symm stateCode) + (List.finRange (n + 2)) (fun _ => Γ.blank)) + ⟨stateCode tm cfg.state, stateCode_lt_internal tm cfg.state⟩) + cleared final + (dispatchSteps tm cfg.state (readSymbols cfg) (List.finRange (n + 2))) + (dispatchCost tm bound cfg.state (readSymbols cfg) + (List.finRange (n + 2))) + (spaceBound tm bound) := by + simpa [hbranchState] using hbranch + have hrun := Structured.Switch.select_measured + (fun stateCode : Fin (Fintype.card tm.Q) => + dispatchSymbols tm ((Fintype.equivFin tm.Q).symm stateCode) + (List.finRange (n + 2)) (fun _ => Γ.blank)) + store final (stateCode_lt_internal tm cfg.state) hstate hone + (stateScratchReg_ne_one n) + (lt_trans hrange.2.2.2.1.2 (control_lt_registerBound n bound)) + henvelope hselectedBranch + refine ⟨final, ?_, hfinalRepresents, hfinalEnvelope⟩ + simpa [dispatchState, wordWidth, Structured.Internal.valueWidth, spaceBound, + Structured.Internal.envelopeSpace] using hrun + +end Sparse + +end TMConfig + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Step/Internal/Iteration.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Step/Internal/Iteration.lean new file mode 100644 index 0000000000..1942ca4a3b --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Step/Internal/Iteration.lean @@ -0,0 +1,215 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.Step.Internal.Dispatch + +/-! +# Iterating the fixed sparse TM transition -- proof internals +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace TMConfig + +namespace Sparse + + +private theorem stateCode_lt (tm : TM n) (state : tm.Q) : + stateCode tm state < Fintype.card tm.Q := + (Fintype.equivFin tm.Q state).isLt + +private theorem stateScratchReg_ne_one (n : ℕ) : + stateScratchReg n ≠ oneReg n := by + simp [stateScratchReg, oneReg] + +private theorem cleared_apply_of_ne (store : Structured.Store) {test reg : ℕ} + (hne : reg ≠ test) : + Structured.Switch.cleared store test reg = store reg := by + simp [Structured.Switch.cleared, Function.update_of_ne hne] + +theorem continueCheck_exec_internal {tm : TM n} + {cfg : Complexity.Cfg n tm.Q} {store : Structured.Store} + (hrepresents : Represents tm cfg store) : + ∃ final cost space, + Structured.Exec (continueCheck tm) store final + (continueSteps tm cfg) cost space ∧ + Represents tm cfg final ∧ + final (valueReg n) = runningFlag tm cfg.state ∧ + final (oneReg n) = 1 ∧ + final (tapeCountReg n) = n + 2 := by + let loaded := Structured.Basic.execList (loadOps n) store + obtain ⟨loadCost, loadSpace, hloadExec⟩ := + Structured.Internal.exec_basics_exists (loadOps n) store + have hloaded := loadOps_loaded_internal hrepresents + let cleared := Structured.Switch.cleared loaded (stateScratchReg n) + have hrange := scratch_range_internal n + have hclearedRepresents : Represents tm cfg cleared := + hloaded.1.update_control_internal hrange.2.2.2.1.1 + hrange.2.2.2.1.2 + have hclearedOne : cleared (oneReg n) = 1 := by + exact (cleared_apply_of_ne loaded (stateScratchReg_ne_one n).symm).trans + hloaded.2.2.1 + have hclearedCount : cleared (tapeCountReg n) = n + 2 := by + have hne : tapeCountReg n ≠ stateScratchReg n := by + simp [tapeCountReg, stateScratchReg] + exact (cleared_apply_of_ne loaded hne).trans hloaded.2.2.2.1 + let final := (Structured.Basic.imm (valueReg n) + (runningFlag tm cfg.state)).exec cleared + obtain ⟨branchCost, branchSpace, hbranchExec⟩ := + Structured.Internal.exec_basics_exists + [.imm (valueReg n) (runningFlag tm cfg.state)] cleared + have hfinalRepresents : Represents tm cfg final := by + exact hclearedRepresents.update_control_internal + hrange.2.2.2.2.2.1.1 hrange.2.2.2.2.2.1.2 + have hfinalValue : final (valueReg n) = runningFlag tm cfg.state := by + simp [final, Structured.Basic.exec] + have hfinalOne : final (oneReg n) = 1 := by + simpa [final, Structured.Basic.exec, oneReg, valueReg, + Function.update_of_ne] using hclearedOne + have hfinalCount : final (tapeCountReg n) = n + 2 := by + simpa [final, Structured.Basic.exec, tapeCountReg, valueReg, + Function.update_of_ne] using hclearedCount + have hbranchState : + (Fintype.equivFin tm.Q).symm + ⟨stateCode tm cfg.state, stateCode_lt tm cfg.state⟩ = cfg.state := + (Fintype.equivFin tm.Q).symm_apply_apply cfg.state + have hselectedBranch : + ∃ cost space, + Structured.Exec + ((fun code : Fin (Fintype.card tm.Q) => .basics + [.imm (valueReg n) + (runningFlag tm ((Fintype.equivFin tm.Q).symm code))]) + ⟨stateCode tm cfg.state, stateCode_lt tm cfg.state⟩) + cleared final 1 cost space := by + refine ⟨branchCost, branchSpace, ?_⟩ + simpa [hbranchState, final] using hbranchExec + obtain ⟨dispatchCost, dispatchSpace, hdispatch⟩ := + Structured.Switch.select_exec + (fun code : Fin (Fintype.card tm.Q) => .basics + [.imm (valueReg n) + (runningFlag tm ((Fintype.equivFin tm.Q).symm code))]) + loaded final (stateCode_lt tm cfg.state) hloaded.2.2.2.2.1 + hloaded.2.2.1 (stateScratchReg_ne_one n) hselectedBranch + refine ⟨final, loadCost + dispatchCost, max loadSpace dispatchSpace, + ?_, hfinalRepresents, hfinalValue, hfinalOne, hfinalCount⟩ + simpa [continueCheck, continueDispatch, continueSteps, loaded] using + Structured.Exec.seq hloadExec hdispatch + +theorem starts_of_step_internal {tm : TM n} + {cfg next : Complexity.Cfg n tm.Q} (hstep : tm.step cfg = some next) + (hwork : ∀ i, (cfg.work i).cells 0 = Γ.start) + (houtput : cfg.output.cells 0 = Γ.start) : + (∀ i, (next.work i).cells 0 = Γ.start) ∧ + next.output.cells 0 = Γ.start := by + have hnotHalted := TM.state_ne_qhalt_of_step hstep + rcases hdelta : tm.δ cfg.state cfg.input.read + (fun i => (cfg.work i).read) cfg.output.read with + ⟨nextState, workWrites, outputWrite, inputDirection, + workDirections, outputDirection⟩ + rw [TM.step, if_neg hnotHalted, hdelta] at hstep + dsimp only at hstep + injection hstep with hnext + subst next + constructor + · intro i + rw [Tape.writeAndMove, Tape.move_cells] + simp only [Tape.write] + split + · exact hwork i + · change Function.update (cfg.work i).cells (cfg.work i).head + (workWrites i).toΓ 0 = Γ.start + rw [Function.update_of_ne] + · exact hwork i + · exact Ne.symm (by assumption) + · rw [Tape.writeAndMove, Tape.move_cells] + simp only [Tape.write] + split + · exact houtput + · change Function.update cfg.output.cells cfg.output.head + outputWrite.toΓ 0 = Γ.start + rw [Function.update_of_ne] + · exact houtput + · exact Ne.symm (by assumption) + +theorem loop_exec_internal {tm : TM n} {steps : ℕ} + {cfg halted : Complexity.Cfg n tm.Q} {store : Structured.Store} + (hreach : tm.reachesIn steps cfg halted) + (hhalted : tm.halted halted) + (hrepresents : Represents tm cfg store) + (hflag : store (valueReg n) = runningFlag tm cfg.state) + (hworkStart : ∀ i, (cfg.work i).cells 0 = Γ.start) + (houtputStart : cfg.output.cells 0 = Γ.start) : + ∃ final cost space, + Structured.Exec (.whileNonzero (valueReg n) (loopBody tm)) + store final (loopSteps tm steps cfg) cost space ∧ + Represents tm halted final := by + induction hreach generalizing store with + | zero => + have hzero : store (valueReg n) = 0 := by + rw [hflag] + simp [runningFlag, hhalted] + refine ⟨store, bitlen (store (valueReg n)) + 1, store.space, ?_, + hrepresents⟩ + simpa [loopSteps] using + (Structured.Exec.whileZero (body := loopBody tm) hzero) + | @step current successor tail finalCfg hstep htail ih => + have hnotHalted := TM.state_ne_qhalt_of_step hstep + have hnonzero : store (valueReg n) ≠ 0 := by + rw [hflag] + simp [runningFlag, hnotHalted] + obtain ⟨middle, stepCost, stepSpace, hprogram, hmiddleRepresents⟩ := + program_exec_internal hstep hrepresents hworkStart houtputStart + obtain ⟨checked, checkCost, checkSpace, hcheck, + hcheckedRepresents, hcheckedFlag, _hcheckedOne, _hcheckedCount⟩ := + continueCheck_exec_internal hmiddleRepresents + have hstarts := starts_of_step_internal hstep hworkStart houtputStart + obtain ⟨final, loopCost, loopSpace, hloop, hfinalRepresents⟩ := + ih hhalted hcheckedRepresents hcheckedFlag hstarts.1 hstarts.2 + have hbody : Structured.Exec (loopBody tm) store checked + (stepCount tm current + continueSteps tm successor) + (stepCost + checkCost) (max stepSpace checkSpace) := by + simpa [loopBody] using Structured.Exec.seq hprogram hcheck + refine ⟨final, + bitlen (store (valueReg n)) + 1 + (stepCost + checkCost) + 1 + loopCost, + max (max stepSpace checkSpace) loopSpace, ?_, hfinalRepresents⟩ + have hexec := Structured.Exec.whileNonzero hnonzero hbody hloop + simpa [loopSteps, hstep, Nat.add_assoc] using hexec + +theorem runUntilHalt_exec_internal {tm : TM n} {steps : ℕ} + {cfg halted : Complexity.Cfg n tm.Q} {store : Structured.Store} + (hreach : tm.reachesIn steps cfg halted) + (hhalted : tm.halted halted) + (hrepresents : Represents tm cfg store) + (hworkStart : ∀ i, (cfg.work i).cells 0 = Γ.start) + (houtputStart : cfg.output.cells 0 = Γ.start) : + ∃ final cost space, + Structured.Exec (runUntilHalt tm) store final + (runSteps tm steps cfg) cost space ∧ + Represents tm halted final := by + obtain ⟨checked, checkCost, checkSpace, hcheck, hcheckedRepresents, + hcheckedFlag, _hcheckedOne, _hcheckedCount⟩ := + continueCheck_exec_internal hrepresents + obtain ⟨final, loopCost, loopSpace, hloop, hfinalRepresents⟩ := + loop_exec_internal hreach hhalted hcheckedRepresents hcheckedFlag + hworkStart houtputStart + refine ⟨final, checkCost + loopCost, max checkSpace loopSpace, ?_, + hfinalRepresents⟩ + simpa [runUntilHalt, runSteps] using Structured.Exec.seq hcheck hloop + +end Sparse + +end TMConfig + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Step/Internal/Layout.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Step/Internal/Layout.lean new file mode 100644 index 0000000000..7269afa211 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Step/Internal/Layout.lean @@ -0,0 +1,130 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.Step.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.Internal + +/-! +# Sparse TM-step address and loading layout -- proof internals +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace TMConfig + +namespace Sparse + + +private theorem execList_append (first second : List Structured.Basic) + (store : Structured.Store) : + Structured.Basic.execList (first ++ second) store = + Structured.Basic.execList second (Structured.Basic.execList first store) := by + induction first generalizing store with + | nil => rfl + | cons op rest ih => simp [Structured.Basic.execList, ih] + +theorem symbolCode_lt_internal (symbol : Γ) : symbolCode symbol < 4 := by + cases symbol <;> decide + +theorem addressOps_represents_internal {tm : TM n} + {cfg : Complexity.Cfg n tm.Q} {store : Structured.Store} + (hrepresents : Represents tm cfg store) (tape : Fin (n + 2)) : + Represents tm cfg (Structured.Basic.execList (addressOps n tape) store) := by + have hrange := scratch_range_internal n + simp only [addressOps, Structured.Basic.execList] + apply Represents.update_control_internal + · apply Represents.update_control_internal + · exact hrepresents.update_control_internal hrange.2.2.2.2.2.1.1 + hrange.2.2.2.2.2.1.2 + · exact hrange.2.2.2.2.1.1 + · exact hrange.2.2.2.2.1.2 + · exact hrange.2.2.2.2.1.1 + · exact hrange.2.2.2.2.1.2 + +theorem loadTapeOps_represents_internal {tm : TM n} + {cfg : Complexity.Cfg n tm.Q} {store : Structured.Store} + (hrepresents : Represents tm cfg store) (tape : Fin (n + 2)) : + Represents tm cfg (Structured.Basic.execList (loadTapeOps n tape) store) := by + have hrange := scratch_range_internal n + rw [loadTapeOps, execList_append] + simp only [Structured.Basic.execList, Structured.Basic.exec] + exact (addressOps_represents_internal hrepresents tape).update_control_internal + (hrange.2.2.2.2.2.2 tape).1 (hrange.2.2.2.2.2.2 tape).2 + +theorem addressOps_address_internal {tm : TM n} + {cfg : Complexity.Cfg n tm.Q} {store : Structured.Store} + (hrepresents : Represents tm cfg store) (tape : Fin (n + 2)) + (htapeCount : store (tapeCountReg n) = n + 2) : + Structured.Basic.execList (addressOps n tape) store (addressReg n) = + cellReg n tape (tapeAt cfg tape).head := by + have hhead := hrepresents (Sum.inr (Sum.inl tape)) + change store (headReg tape) = (tapeAt cfg tape).head at hhead + have hvalueHead : valueReg n ≠ headReg tape := by + simp [valueReg, headReg] + omega + have hvalueCount : valueReg n ≠ tapeCountReg n := by + simp [valueReg, tapeCountReg] + have haddressValue : addressReg n ≠ valueReg n := by + simp [addressReg, valueReg] + let first := (Structured.Basic.imm (valueReg n) + (cellBase n + tape.val)).exec store + let multiplied := (Structured.Basic.mul (addressReg n) (headReg tape) + (tapeCountReg n)).exec first + have hfirstHead : first (headReg tape) = store (headReg tape) := by + simp [first, Structured.Basic.exec, Function.update_of_ne (Ne.symm hvalueHead)] + have hfirstCount : first (tapeCountReg n) = store (tapeCountReg n) := by + simp [first, Structured.Basic.exec, Function.update_of_ne (Ne.symm hvalueCount)] + have hfirstValue : first (valueReg n) = cellBase n + tape.val := by + simp [first, Structured.Basic.exec] + have hmultipliedAddress : multiplied (addressReg n) = + (tapeAt cfg tape).head * (n + 2) := by + simp only [multiplied, Structured.Basic.exec, Function.update_self] + rw [hfirstHead, hfirstCount, hhead, htapeCount] + have hmultipliedValue : multiplied (valueReg n) = cellBase n + tape.val := by + simp only [multiplied, Structured.Basic.exec] + rw [Function.update_of_ne (Ne.symm haddressValue), hfirstValue] + simp only [addressOps, Structured.Basic.execList] + change ((Structured.Basic.add (addressReg n) (addressReg n) + (valueReg n)).exec multiplied) (addressReg n) = _ + simp only [Structured.Basic.exec, Function.update_self] + rw [hmultipliedAddress, hmultipliedValue] + simp [cellReg] + omega + +theorem loadTapeOps_symbol_internal {tm : TM n} + {cfg : Complexity.Cfg n tm.Q} {store : Structured.Store} + (hrepresents : Represents tm cfg store) (tape : Fin (n + 2)) + (htapeCount : store (tapeCountReg n) = n + 2) : + Structured.Basic.execList (loadTapeOps n tape) store (symbolReg n tape) = + symbolCode ((tapeAt cfg tape).read) := by + let addressed := Structured.Basic.execList (addressOps n tape) store + have haddress : addressed (addressReg n) = + cellReg n tape (tapeAt cfg tape).head := + addressOps_address_internal hrepresents tape htapeCount + have haddressedRepresents := addressOps_represents_internal hrepresents tape + have hcell := haddressedRepresents + (Sum.inr (Sum.inr (tape, (tapeAt cfg tape).head))) + change addressed (cellReg n tape (tapeAt cfg tape).head) = + symbolCode ((tapeAt cfg tape).cells (tapeAt cfg tape).head) at hcell + rw [loadTapeOps, execList_append] + simp only [Structured.Basic.execList, Structured.Basic.exec, Function.update_self] + change addressed (addressed (addressReg n)) = _ + rw [haddress, hcell] + rfl + +end Sparse + +end TMConfig + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Step/Internal/Load.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Step/Internal/Load.lean new file mode 100644 index 0000000000..270746f95d --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Step/Internal/Load.lean @@ -0,0 +1,193 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.Step.Internal.Layout + +/-! +# Loading sparse TM states and head symbols -- proof internals +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace TMConfig + +namespace Sparse + + +private theorem execList_append (first second : List Structured.Basic) + (store : Structured.Store) : + Structured.Basic.execList (first ++ second) store = + Structured.Basic.execList second (Structured.Basic.execList first store) := by + induction first generalizing store with + | nil => rfl + | cons op rest ih => simp [Structured.Basic.execList, ih] + +private theorem loadTapeOps_apply_of_ne (n : ℕ) (tape : Fin (n + 2)) + (store : Structured.Store) (reg : ℕ) + (hvalue : reg ≠ valueReg n) (haddress : reg ≠ addressReg n) + (hsymbol : reg ≠ symbolReg n tape) : + Structured.Basic.execList (loadTapeOps n tape) store reg = store reg := by + simp [loadTapeOps, addressOps, Structured.Basic.execList, + Structured.Basic.exec, Function.update_of_ne hvalue, + Function.update_of_ne haddress, Function.update_of_ne hsymbol] + +private theorem symbolReg_injective (n : ℕ) : + Function.Injective (symbolReg n) := by + intro first second heq + apply Fin.ext + simp [symbolReg] at heq + omega + +private structure LoadedPrefix (tm : TM n) (cfg : Complexity.Cfg n tm.Q) + (processed : List (Fin (n + 2))) (store : Structured.Store) : Prop where + represents : Represents tm cfg store + zero : store (zeroReg n) = 0 + one : store (oneReg n) = 1 + tapeCount : store (tapeCountReg n) = n + 2 + state : store (stateScratchReg n) = stateCode tm cfg.state + symbols : ∀ tape, tape ∈ processed → + store (symbolReg n tape) = symbolCode (readSymbols cfg tape) + +private theorem setup_loadedPrefix {tm : TM n} {cfg : Complexity.Cfg n tm.Q} + {store : Structured.Store} (hrepresents : Represents tm cfg store) : + LoadedPrefix tm cfg [] + (Structured.Basic.execList (setupOps n) store) := by + let first := (Structured.Basic.imm (zeroReg n) 0).exec store + let second := (Structured.Basic.imm (oneReg n) 1).exec first + let third := (Structured.Basic.imm (tapeCountReg n) (n + 2)).exec second + let final := (Structured.Basic.add (stateScratchReg n) stateReg + (zeroReg n)).exec third + have hrange := scratch_range_internal n + have hfirstRep : Represents tm cfg first := by + exact hrepresents.update_control_internal hrange.1.1 hrange.1.2 + have hsecondRep : Represents tm cfg second := by + exact hfirstRep.update_control_internal hrange.2.1.1 hrange.2.1.2 + have hthirdRep : Represents tm cfg third := by + exact hsecondRep.update_control_internal hrange.2.2.1.1 hrange.2.2.1.2 + have hfinalRep : Represents tm cfg final := by + exact hthirdRep.update_control_internal + hrange.2.2.2.1.1 hrange.2.2.2.1.2 + have hzero : final (zeroReg n) = 0 := by + simp [final, third, second, first, Structured.Basic.exec, zeroReg, oneReg, + tapeCountReg, stateScratchReg, Function.update_of_ne] + have hone : final (oneReg n) = 1 := by + simp [final, third, second, first, Structured.Basic.exec, zeroReg, oneReg, + tapeCountReg, stateScratchReg, Function.update_of_ne] + have hcount : final (tapeCountReg n) = n + 2 := by + simp [final, third, second, first, Structured.Basic.exec, zeroReg, oneReg, + tapeCountReg, stateScratchReg, Function.update_of_ne] + have hstateStore : store stateReg = stateCode tm cfg.state := by + have hstate := hrepresents (Sum.inl ⟨0, by omega⟩) + change store stateReg = stateCode tm cfg.state at hstate + exact hstate + have hstate : final (stateScratchReg n) = stateCode tm cfg.state := by + simp only [final, Structured.Basic.exec, Function.update_self] + have hthirdState : third stateReg = store stateReg := by + simp [third, second, first, Structured.Basic.exec, stateReg, zeroReg, + oneReg, tapeCountReg, Function.update_of_ne] + have hthirdZero : third (zeroReg n) = 0 := by + simp [third, second, first, Structured.Basic.exec, zeroReg, oneReg, + tapeCountReg, Function.update_of_ne] + rw [hthirdState, hthirdZero, hstateStore, Nat.add_zero] + simpa [setupOps, first, second, third, final] using + LoadedPrefix.mk hfinalRep hzero hone hcount hstate (by simp) + +private theorem loadTape_loadedPrefix {tm : TM n} + {cfg : Complexity.Cfg n tm.Q} {processed : List (Fin (n + 2))} + {store : Structured.Store} (hloaded : LoadedPrefix tm cfg processed store) + (tape : Fin (n + 2)) : + LoadedPrefix tm cfg (tape :: processed) + (Structured.Basic.execList (loadTapeOps n tape) store) := by + have hzeroValue : zeroReg n ≠ valueReg n := by simp [zeroReg, valueReg] + have hzeroAddress : zeroReg n ≠ addressReg n := by simp [zeroReg, addressReg] + have hzeroSymbol : zeroReg n ≠ symbolReg n tape := by + simp [zeroReg, symbolReg] + omega + have honeValue : oneReg n ≠ valueReg n := by simp [oneReg, valueReg] + have honeAddress : oneReg n ≠ addressReg n := by simp [oneReg, addressReg] + have honeSymbol : oneReg n ≠ symbolReg n tape := by + simp [oneReg, symbolReg] + omega + have hcountValue : tapeCountReg n ≠ valueReg n := by simp [tapeCountReg, valueReg] + have hcountAddress : tapeCountReg n ≠ addressReg n := by + simp [tapeCountReg, addressReg] + have hcountSymbol : tapeCountReg n ≠ symbolReg n tape := by + simp [tapeCountReg, symbolReg] + omega + have hstateValue : stateScratchReg n ≠ valueReg n := by + simp [stateScratchReg, valueReg] + have hstateAddress : stateScratchReg n ≠ addressReg n := by + simp [stateScratchReg, addressReg] + have hstateSymbol : stateScratchReg n ≠ symbolReg n tape := by + simp [stateScratchReg, symbolReg] + omega + refine ⟨loadTapeOps_represents_internal hloaded.represents tape, + loadTapeOps_apply_of_ne n tape store (zeroReg n) hzeroValue hzeroAddress + hzeroSymbol ▸ hloaded.zero, + loadTapeOps_apply_of_ne n tape store (oneReg n) honeValue honeAddress + honeSymbol ▸ hloaded.one, + loadTapeOps_apply_of_ne n tape store (tapeCountReg n) hcountValue + hcountAddress hcountSymbol ▸ hloaded.tapeCount, + loadTapeOps_apply_of_ne n tape store (stateScratchReg n) hstateValue + hstateAddress hstateSymbol ▸ hloaded.state, ?_⟩ + intro candidate hmem + rcases List.mem_cons.mp hmem with heq | hprocessed + · subst candidate + exact loadTapeOps_symbol_internal hloaded.represents tape hloaded.tapeCount + · by_cases heq : candidate = tape + · subst candidate + exact loadTapeOps_symbol_internal hloaded.represents tape hloaded.tapeCount + · rw [loadTapeOps_apply_of_ne n tape store (symbolReg n candidate)] + · exact hloaded.symbols candidate hprocessed + · simp [symbolReg, valueReg] + omega + · simp [symbolReg, addressReg] + omega + · exact fun hregs => heq (symbolReg_injective n hregs) + +private theorem loadTapes_loadedPrefix {tm : TM n} + {cfg : Complexity.Cfg n tm.Q} (tapes processed : List (Fin (n + 2))) + {store : Structured.Store} (hloaded : LoadedPrefix tm cfg processed store) : + LoadedPrefix tm cfg (tapes.reverse ++ processed) + (Structured.Basic.execList (tapes.flatMap (loadTapeOps n)) store) := by + induction tapes generalizing processed store with + | nil => simpa using hloaded + | cons tape rest ih => + have hnext := loadTape_loadedPrefix hloaded tape + have hfinal := ih (processed := tape :: processed) hnext + simpa [List.flatMap_cons, Structured.Basic.execList, execList_append, + List.reverse_cons, List.append_assoc] using hfinal + +theorem loadOps_loaded_internal {tm : TM n} {cfg : Complexity.Cfg n tm.Q} + {store : Structured.Store} (hrepresents : Represents tm cfg store) : + let final := Structured.Basic.execList (loadOps n) store + Represents tm cfg final ∧ + final (zeroReg n) = 0 ∧ + final (oneReg n) = 1 ∧ + final (tapeCountReg n) = n + 2 ∧ + final (stateScratchReg n) = stateCode tm cfg.state ∧ + ∀ tape, final (symbolReg n tape) = symbolCode (readSymbols cfg tape) := by + let setup := Structured.Basic.execList (setupOps n) store + have hsetup := setup_loadedPrefix hrepresents + have hloaded := loadTapes_loadedPrefix (List.finRange (n + 2)) [] hsetup + rw [loadOps, execList_append] + exact ⟨hloaded.represents, hloaded.zero, hloaded.one, hloaded.tapeCount, + hloaded.state, fun tape => hloaded.symbols tape (by simp)⟩ + +end Sparse + +end TMConfig + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Step/Internal/Resources.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Step/Internal/Resources.lean new file mode 100644 index 0000000000..a4706348c2 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Step/Internal/Resources.lean @@ -0,0 +1,889 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.Step.Internal.Iteration +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.Internal.Resources + +/-! +# Resource envelopes for the fixed sparse TM simulator -- proof internals + +The semantic simulation already records exact source steps, cost, and space. +This layer supplies the uniform finite-store envelope needed to turn those +measurements into explicit bounds depending only on input length and TM steps. +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace TMConfig + +namespace Sparse + + +/-- Shared envelope used by marshalling and repeated sparse simulation. -/ +abbrev StepEnvelope (tm : TM n) (bound : ℕ) := + Structured.Internal.StoreEnvelope (registerBound n (bound + 1)) + (wordBound tm bound) + +theorem bound_lt_registerBound_internal (n bound : ℕ) : + bound < registerBound n (bound + 1) := by + simp [registerBound, cellReg, outputTape, cellBase, Nat.mul_add] + omega + +theorem control_lt_registerBound_internal (n bound : ℕ) : + cellBase n < registerBound n (bound + 1) := by + simp [registerBound, cellReg, outputTape] + omega + +theorem cellReg_lt_registerBound_internal (tape : Fin (n + 2)) + {position bound : ℕ} (hposition : position ≤ bound + 1) : + cellReg n tape position < registerBound n (bound + 1) := by + have hmul := Nat.mul_le_mul_right (n + 2) hposition + simp only [cellReg, registerBound, outputTape] + omega + +theorem cellReg_decode_internal (n reg : ℕ) (hreg : cellBase n ≤ reg) : + cellReg n (decodeCellTape n reg) (decodeCellPosition n reg) = reg := by + have hdivision := Nat.mod_add_div (reg - cellBase n) (n + 2) + rw [Nat.mul_comm (n + 2)] at hdivision + simp only [cellReg, decodeCellTape, decodeCellPosition] + omega + +theorem registerBound_le_wordBound_internal (tm : TM n) (bound : ℕ) : + registerBound n (bound + 1) ≤ wordBound tm bound := by + exact le_max_left _ _ + +theorem card_le_wordBound_internal (tm : TM n) (bound : ℕ) : + Fintype.card tm.Q ≤ wordBound tm bound := by + exact le_trans (le_max_left _ _) (le_max_right _ _) + +theorem bound_succ_le_wordBound_internal (tm : TM n) (bound : ℕ) : + bound + 1 ≤ wordBound tm bound := by + exact le_trans (le_max_right _ _) (le_max_right _ _) + +private theorem tapeCount_le_wordBound (tm : TM n) (bound : ℕ) : + n + 2 ≤ wordBound tm bound := by + have hcontrol := control_lt_registerBound_internal n bound + have hregister := registerBound_le_wordBound_internal tm bound + simp [cellBase] at hcontrol + omega + +private theorem initRegs_index_le_length {x : List Bool} {reg : ℕ} + (hnonzero : initRegs x reg ≠ 0) : reg ≤ x.length := by + by_cases hreg : reg = 0 + · omega + rw [initRegs, if_neg hreg] at hnonzero + cases hbit : x[reg - 1]? with + | none => simp [hbit] at hnonzero + | some bit => + have hindex : reg - 1 < x.length := + (List.getElem?_eq_some_iff.mp hbit).1 + omega + +private theorem initRegs_value_le_length_succ (x : List Bool) (reg : ℕ) : + initRegs x reg ≤ x.length + 1 := by + rw [initRegs] + split + · omega + · cases x[reg - 1]? with + | none => simp + | some bit => cases bit <;> simp + +/-- The public RAM input store fits every sparse execution envelope whose bound +contains the input length. -/ +theorem initRegs_envelope_internal (tm : TM n) (x : List Bool) (bound : ℕ) + (hlength : x.length ≤ bound) : StepEnvelope tm bound (initRegs x) where + index_lt _reg hnonzero := + lt_of_le_of_lt + (le_trans (initRegs_index_le_length hnonzero) hlength) + (bound_lt_registerBound_internal n bound) + value_le reg := + le_trans (initRegs_value_le_length_succ x reg) + (le_trans (Nat.add_le_add_right hlength 1) + (bound_succ_le_wordBound_internal tm bound)) + +/-- The canonical sparse encoding fits the common execution envelope whenever +all heads and nonblank tape cells lie within the chosen bound. -/ +theorem encodeRegs_envelope_internal (tm : TM n) + (cfg : Complexity.Cfg n tm.Q) (bound : ℕ) + (hbounded : Bounded cfg bound) (hheads : HeadsBounded cfg bound) : + StepEnvelope tm bound (encodeRegs tm cfg) where + index_lt reg hnonzero := by + by_contra houtside + have hindex : registerBound n (bound + 1) ≤ reg := by omega + rw [encodeRegs] at hnonzero + split at hnonzero + · subst reg + have := bound_lt_registerBound_internal n bound + simp [stateReg] at hindex + omega + next hstate => + split at hnonzero + · have hcontrol := control_lt_registerBound_internal n bound + simp [cellBase] at hcontrol + omega + next hhead => + split at hnonzero + · rename_i hcell + have hreconstruct := cellReg_decode_internal n reg hcell + have hposition : bound < decodeCellPosition n reg := by + by_contra hlow + have hpositionLe : decodeCellPosition n reg ≤ bound := + Nat.le_of_not_gt hlow + have hcellLt := cellReg_lt_registerBound_internal + (decodeCellTape n reg) (bound := bound) + (show decodeCellPosition n reg ≤ bound + 1 by omega) + rw [hreconstruct] at hcellLt + omega + rw [hbounded (decodeCellTape n reg) (decodeCellPosition n reg) + hposition] at hnonzero + simp [symbolCode] at hnonzero + · simp at hnonzero + value_le reg := by + rw [encodeRegs] + split + · have hstateCode : stateCode tm cfg.state < Fintype.card tm.Q := by + simp [stateCode] + exact le_trans (Nat.le_of_lt hstateCode) + (card_le_wordBound_internal tm bound) + next hstate => + split + · exact le_trans (hheads ⟨reg - 1, by omega⟩) + (le_trans (Nat.le_succ bound) + (bound_succ_le_wordBound_internal tm bound)) + next hhead => + split + · have hsymbol := symbolCode_lt_internal + ((tapeAt cfg (decodeCellTape n reg)).cells + (decodeCellPosition n reg)) + have hfour : 4 ≤ registerBound n (bound + 1) := by + have hcontrol := control_lt_registerBound_internal n bound + simp [cellBase] at hcontrol + omega + exact le_trans (Nat.le_of_lt hsymbol) + (le_trans hfour (registerBound_le_wordBound_internal tm bound)) + · exact Nat.zero_le _ + +private theorem setupOps_envelopeChain {tm : TM n} {bound : ℕ} + {cfg : Complexity.Cfg n tm.Q} {store : Structured.Store} + (hrepresents : Represents tm cfg store) + (henvelope : StepEnvelope tm bound store) : + Structured.Internal.Basic.EnvelopeChain + (registerBound n (bound + 1)) (wordBound tm bound) + (setupOps n) store := by + let first := (Structured.Basic.imm (zeroReg n) 0).exec store + let second := (Structured.Basic.imm (oneReg n) 1).exec first + let third := (Structured.Basic.imm (tapeCountReg n) (n + 2)).exec second + let final := (Structured.Basic.add (stateScratchReg n) stateReg + (zeroReg n)).exec third + have hrange := scratch_range_internal n + have hfirst : StepEnvelope tm bound first := by + apply henvelope.execBasic + · exact lt_trans hrange.1.2 (control_lt_registerBound_internal n bound) + · simp [Structured.Internal.Basic.writeValue] + have hone : 1 ≤ wordBound tm bound := by + exact le_trans (show 1 ≤ n + 2 by omega) + (tapeCount_le_wordBound tm bound) + have hsecond : StepEnvelope tm bound second := by + apply hfirst.execBasic + · exact lt_trans hrange.2.1.2 + (control_lt_registerBound_internal n bound) + · simpa [Structured.Internal.Basic.writeValue] using hone + have hthird : StepEnvelope tm bound third := by + apply hsecond.execBasic + · exact lt_trans hrange.2.2.1.2 + (control_lt_registerBound_internal n bound) + · simpa [Structured.Internal.Basic.writeValue] using + tapeCount_le_wordBound tm bound + have hstoreState : store stateReg = stateCode tm cfg.state := by + have hstate := hrepresents (Sum.inl ⟨0, by omega⟩) + exact hstate + have hthirdState : third stateReg = store stateReg := by + simp [third, second, first, Structured.Basic.exec, stateReg, zeroReg, + oneReg, tapeCountReg, Function.update_of_ne] + have hthirdZero : third (zeroReg n) = 0 := by + simp [third, second, first, Structured.Basic.exec, zeroReg, oneReg, + tapeCountReg, Function.update_of_ne] + have hstateBound : stateCode tm cfg.state ≤ wordBound tm bound := by + have hstateLt : stateCode tm cfg.state < Fintype.card tm.Q := by + simp [stateCode] + exact le_trans (Nat.le_of_lt hstateLt) + (card_le_wordBound_internal tm bound) + have hfinal : StepEnvelope tm bound final := by + apply hthird.execBasic + · exact lt_trans hrange.2.2.2.1.2 + (control_lt_registerBound_internal n bound) + · simp only [Structured.Internal.Basic.writeValue] + rw [hthirdState, hthirdZero, hstoreState, Nat.add_zero] + exact hstateBound + simpa [setupOps, first, second, third, final] using + And.intro henvelope + (And.intro hfirst (And.intro hsecond (And.intro hthird hfinal))) + +private theorem setupOps_represents {tm : TM n} + {cfg : Complexity.Cfg n tm.Q} {store : Structured.Store} + (hrepresents : Represents tm cfg store) : + Represents tm cfg (Structured.Basic.execList (setupOps n) store) := by + have hrange := scratch_range_internal n + simp only [setupOps, Structured.Basic.execList] + apply Represents.update_control_internal + · apply Represents.update_control_internal + · apply Represents.update_control_internal + · exact hrepresents.update_control_internal hrange.1.1 hrange.1.2 + · exact hrange.2.1.1 + · exact hrange.2.1.2 + · exact hrange.2.2.1.1 + · exact hrange.2.2.1.2 + · exact hrange.2.2.2.1.1 + · exact hrange.2.2.2.1.2 + +private theorem setupOps_tapeCount (n : ℕ) (store : Structured.Store) : + Structured.Basic.execList (setupOps n) store (tapeCountReg n) = n + 2 := by + simp [setupOps, Structured.Basic.execList, Structured.Basic.exec, zeroReg, + oneReg, tapeCountReg, stateScratchReg, Function.update_of_ne] + +private theorem loadTapeOps_envelopeChain {tm : TM n} {bound : ℕ} + {cfg : Complexity.Cfg n tm.Q} {store : Structured.Store} + (hrepresents : Represents tm cfg store) (tape : Fin (n + 2)) + (htapeCount : store (tapeCountReg n) = n + 2) + (hhead : (tapeAt cfg tape).head ≤ bound) + (henvelope : StepEnvelope tm bound store) : + Structured.Internal.Basic.EnvelopeChain + (registerBound n (bound + 1)) (wordBound tm bound) + (loadTapeOps n tape) store := by + let first := (Structured.Basic.imm (valueReg n) + (cellBase n + tape.val)).exec store + let multiplied := (Structured.Basic.mul (addressReg n) (headReg tape) + (tapeCountReg n)).exec first + let addressed := (Structured.Basic.add (addressReg n) (addressReg n) + (valueReg n)).exec multiplied + let final := (Structured.Basic.load (symbolReg n tape) + (addressReg n)).exec addressed + have hrange := scratch_range_internal n + have hbaseLt : cellBase n + tape.val < registerBound n (bound + 1) := by + have hcell := cellReg_lt_registerBound_internal tape + (position := 0) (bound := bound) (by omega) + simpa [cellReg] using hcell + have hbaseBound : cellBase n + tape.val ≤ wordBound tm bound := + le_trans (Nat.le_of_lt hbaseLt) + (registerBound_le_wordBound_internal tm bound) + have hfirst : StepEnvelope tm bound first := by + apply henvelope.execBasic + · exact lt_trans hrange.2.2.2.2.2.1.2 + (control_lt_registerBound_internal n bound) + · simpa [Structured.Internal.Basic.writeValue] using hbaseBound + have hstoreHead : store (headReg tape) = (tapeAt cfg tape).head := by + exact hrepresents (Sum.inr (Sum.inl tape)) + have hfirstHead : first (headReg tape) = store (headReg tape) := by + have hne : headReg tape ≠ valueReg n := by + simp [headReg, valueReg] + omega + simp [first, Structured.Basic.exec, Function.update_of_ne hne] + have hfirstCount : first (tapeCountReg n) = store (tapeCountReg n) := by + have hne : tapeCountReg n ≠ valueReg n := by + simp [tapeCountReg, valueReg] + simp [first, Structured.Basic.exec, Function.update_of_ne hne] + have hproductBound : (tapeAt cfg tape).head * (n + 2) ≤ + wordBound tm bound := by + have hcell := cellReg_lt_registerBound_internal tape + (position := (tapeAt cfg tape).head) (bound := bound) (by omega) + have hproduct : (tapeAt cfg tape).head * (n + 2) < + registerBound n (bound + 1) := by + simp [cellReg] at hcell + omega + exact le_trans (Nat.le_of_lt hproduct) + (registerBound_le_wordBound_internal tm bound) + have hmultiplied : StepEnvelope tm bound multiplied := by + apply hfirst.execBasic + · exact lt_trans hrange.2.2.2.2.1.2 + (control_lt_registerBound_internal n bound) + · simp only [Structured.Internal.Basic.writeValue] + rw [hfirstHead, hfirstCount, hstoreHead, htapeCount] + exact hproductBound + have hmultipliedAddress : multiplied (addressReg n) = + (tapeAt cfg tape).head * (n + 2) := by + simp only [multiplied, Structured.Basic.exec, Function.update_self] + rw [hfirstHead, hfirstCount, hstoreHead, htapeCount] + have hmultipliedValue : multiplied (valueReg n) = + cellBase n + tape.val := by + have hne : valueReg n ≠ addressReg n := by + simp [valueReg, addressReg] + simp [multiplied, first, Structured.Basic.exec, + Function.update_of_ne hne] + have hcellBound : cellReg n tape (tapeAt cfg tape).head ≤ + wordBound tm bound := by + exact le_trans (Nat.le_of_lt + (cellReg_lt_registerBound_internal tape (bound := bound) (by omega))) + (registerBound_le_wordBound_internal tm bound) + have haddressed : StepEnvelope tm bound addressed := by + apply hmultiplied.execBasic + · exact lt_trans hrange.2.2.2.2.1.2 + (control_lt_registerBound_internal n bound) + · simp only [Structured.Internal.Basic.writeValue] + rw [hmultipliedAddress, hmultipliedValue] + simp [cellReg] at hcellBound + omega + have hfinal : StepEnvelope tm bound final := by + apply haddressed.execBasic + · exact lt_trans (hrange.2.2.2.2.2.2 tape).2 + (control_lt_registerBound_internal n bound) + · exact haddressed.value_le (addressed (addressReg n)) + simpa [loadTapeOps, addressOps, first, multiplied, addressed, final] using + And.intro henvelope + (And.intro hfirst (And.intro hmultiplied (And.intro haddressed hfinal))) + +private theorem loadTapes_envelopeChain {tm : TM n} {bound : ℕ} + {cfg : Complexity.Cfg n tm.Q} (tapes : List (Fin (n + 2))) + {store : Structured.Store} (hrepresents : Represents tm cfg store) + (htapeCount : store (tapeCountReg n) = n + 2) + (hheads : HeadsBounded cfg bound) + (henvelope : StepEnvelope tm bound store) : + Structured.Internal.Basic.EnvelopeChain + (registerBound n (bound + 1)) (wordBound tm bound) + (tapes.flatMap (loadTapeOps n)) store := by + induction tapes generalizing store with + | nil => exact henvelope + | cons tape rest ih => + have hfirst := loadTapeOps_envelopeChain hrepresents tape htapeCount + (hheads tape) henvelope + have hfirstRepresents := loadTapeOps_represents_internal hrepresents tape + have hcountPreserved : + Structured.Basic.execList (loadTapeOps n tape) store + (tapeCountReg n) = n + 2 := by + have hvalue : tapeCountReg n ≠ valueReg n := by + simp [tapeCountReg, valueReg] + have haddress : tapeCountReg n ≠ addressReg n := by + simp [tapeCountReg, addressReg] + have hsymbol : tapeCountReg n ≠ symbolReg n tape := by + simp [tapeCountReg, symbolReg] + omega + simpa [loadTapeOps, addressOps, Structured.Basic.execList, + Structured.Basic.exec, Function.update_of_ne hvalue, + Function.update_of_ne haddress, Function.update_of_ne hsymbol] + using htapeCount + have hrest := ih hfirstRepresents hcountPreserved hfirst.final + simpa [List.flatMap_cons] using hfirst.append hrest + +theorem loadOps_measured_internal {tm : TM n} {bound : ℕ} + {cfg : Complexity.Cfg n tm.Q} {store : Structured.Store} + (hrepresents : Represents tm cfg store) + (hheads : HeadsBounded cfg bound) + (henvelope : StepEnvelope tm bound store) : + let final := Structured.Basic.execList (loadOps n) store + Structured.Internal.MeasuredRuns (.basics (loadOps n)) store final + (loadOps n).length + (4 * (loadOps n).length * wordWidth tm bound) + (spaceBound tm bound) ∧ StepEnvelope tm bound final := by + have hsetup := setupOps_envelopeChain hrepresents henvelope + have hsetupRepresents : Represents tm cfg + (Structured.Basic.execList (setupOps n) store) := by + exact setupOps_represents hrepresents + have hsetupCount : + Structured.Basic.execList (setupOps n) store (tapeCountReg n) = n + 2 := by + exact setupOps_tapeCount n store + have htapes := loadTapes_envelopeChain (List.finRange (n + 2)) + hsetupRepresents hsetupCount hheads hsetup.final + have hchain : Structured.Internal.Basic.EnvelopeChain + (registerBound n (bound + 1)) (wordBound tm bound) + (loadOps n) store := by + simpa [loadOps] using hsetup.append htapes + have hmeasured := Structured.Internal.MeasuredRuns.basicsEnvelopeChain + (loadOps n) store hchain + simpa [wordWidth, spaceBound, Structured.Internal.valueWidth, + Structured.Internal.envelopeSpace] using hmeasured + +private theorem cleared_apply_of_ne (store : Structured.Store) {test reg : ℕ} + (hne : reg ≠ test) : + Structured.Switch.cleared store test reg = store reg := by + simp [Structured.Switch.cleared, Function.update_of_ne hne] + +private theorem stateScratchReg_ne_one (n : ℕ) : + stateScratchReg n ≠ oneReg n := by + simp [stateScratchReg, oneReg] + +theorem continueCheck_measured_internal {tm : TM n} {bound : ℕ} + {cfg : Complexity.Cfg n tm.Q} {store : Structured.Store} + (hrepresents : Represents tm cfg store) + (hheads : HeadsBounded cfg bound) + (henvelope : StepEnvelope tm bound store) : + ∃ final, + Structured.Internal.MeasuredRuns (continueCheck tm) store final + (continueSteps tm cfg) (continueTimeBound tm bound cfg) + (spaceBound tm bound) ∧ + Represents tm cfg final ∧ + final (valueReg n) = runningFlag tm cfg.state ∧ + final (oneReg n) = 1 ∧ + final (tapeCountReg n) = n + 2 ∧ + StepEnvelope tm bound final := by + let loaded := Structured.Basic.execList (loadOps n) store + have hload := loadOps_measured_internal hrepresents hheads henvelope + have hloaded := loadOps_loaded_internal hrepresents + let cleared := Structured.Switch.cleared loaded (stateScratchReg n) + have hrange := scratch_range_internal n + have hclearedRepresents : Represents tm cfg cleared := + hloaded.1.update_control_internal hrange.2.2.2.1.1 + hrange.2.2.2.1.2 + have hclearedOne : cleared (oneReg n) = 1 := by + exact (cleared_apply_of_ne loaded (stateScratchReg_ne_one n).symm).trans + hloaded.2.2.1 + have hclearedCount : cleared (tapeCountReg n) = n + 2 := by + have hne : tapeCountReg n ≠ stateScratchReg n := by + simp [tapeCountReg, stateScratchReg] + exact (cleared_apply_of_ne loaded hne).trans hloaded.2.2.2.1 + have hclearedEnvelope : StepEnvelope tm bound cleared := by + exact hload.2.update + (lt_trans hrange.2.2.2.1.2 + (control_lt_registerBound_internal n bound)) (by simp) + let final := (Structured.Basic.imm (valueReg n) + (runningFlag tm cfg.state)).exec cleared + have hflagBound : runningFlag tm cfg.state ≤ wordBound tm bound := by + have hone : 1 ≤ wordBound tm bound := by + exact le_trans (show 1 ≤ n + 2 by omega) + (tapeCount_le_wordBound tm bound) + simp [runningFlag] + split <;> omega + have hfinalEnvelope : StepEnvelope tm bound final := by + apply hclearedEnvelope.execBasic + · exact lt_trans hrange.2.2.2.2.2.1.2 + (control_lt_registerBound_internal n bound) + · simpa [Structured.Internal.Basic.writeValue] using hflagBound + have hbranch := Structured.Internal.MeasuredRuns.basicEnvelope + (Structured.Basic.imm (valueReg n) (runningFlag tm cfg.state)) + cleared hclearedEnvelope hfinalEnvelope + have hbranchState : + (Fintype.equivFin tm.Q).symm + ⟨stateCode tm cfg.state, by simp [stateCode]⟩ = cfg.state := + (Fintype.equivFin tm.Q).symm_apply_apply cfg.state + have hselectedBranch : Structured.Internal.MeasuredRuns + ((fun code : Fin (Fintype.card tm.Q) => .basics + [.imm (valueReg n) + (runningFlag tm ((Fintype.equivFin tm.Q).symm code))]) + ⟨stateCode tm cfg.state, by simp [stateCode]⟩) + cleared final 1 (4 * wordWidth tm bound) (spaceBound tm bound) := by + simpa [hbranchState, final, wordWidth, Structured.Internal.valueWidth, + spaceBound, Structured.Internal.envelopeSpace] using hbranch + have hdispatch := Structured.Switch.select_measured + (fun code : Fin (Fintype.card tm.Q) => .basics + [.imm (valueReg n) + (runningFlag tm ((Fintype.equivFin tm.Q).symm code))]) + loaded final (by simp [stateCode]) hloaded.2.2.2.2.1 + hloaded.2.2.1 (stateScratchReg_ne_one n) + (lt_trans hrange.2.2.2.1.2 + (control_lt_registerBound_internal n bound)) + hload.2 hselectedBranch + have hrun := hload.1.seq hdispatch + have hfinalRepresents : Represents tm cfg final := by + exact hclearedRepresents.update_control_internal + hrange.2.2.2.2.2.1.1 hrange.2.2.2.2.2.1.2 + have hfinalValue : final (valueReg n) = runningFlag tm cfg.state := by + simp [final, Structured.Basic.exec] + have hfinalOne : final (oneReg n) = 1 := by + simpa [final, Structured.Basic.exec, oneReg, valueReg, + Function.update_of_ne] using hclearedOne + have hfinalCount : final (tapeCountReg n) = n + 2 := by + simpa [final, Structured.Basic.exec, tapeCountReg, valueReg, + Function.update_of_ne] using hclearedCount + refine ⟨final, ?_, hfinalRepresents, hfinalValue, hfinalOne, hfinalCount, + hfinalEnvelope⟩ + simpa [continueCheck, continueDispatch, continueSteps, continueTimeBound, + loaded, wordWidth, Structured.Internal.valueWidth, spaceBound, + Structured.Internal.envelopeSpace] using hrun + +theorem headsBounded_step_internal {tm : TM n} {bound : ℕ} + {cfg next : Complexity.Cfg n tm.Q} (hstep : tm.step cfg = some next) + (hheads : HeadsBounded cfg bound) : HeadsBounded next (bound + 1) := by + have hnotHalted := TM.state_ne_qhalt_of_step hstep + rcases hdelta : tm.δ cfg.state cfg.input.read + (fun i => (cfg.work i).read) cfg.output.read with + ⟨nextState, workWrites, outputWrite, inputDirection, + workDirections, outputDirection⟩ + rw [TM.step, if_neg hnotHalted, hdelta] at hstep + dsimp only at hstep + injection hstep with hnext + subst next + intro tape + by_cases hinput : tape = inputTape n + · subst tape + rw [show tapeAt + { state := nextState + input := cfg.input.move inputDirection + work := fun i => (cfg.work i).writeAndMove + (workWrites i).toΓ (workDirections i) + output := cfg.output.writeAndMove outputWrite.toΓ outputDirection } + (inputTape n) = cfg.input.move inputDirection by + simpa [inputTape] using tapeAt_input_internal + ({ state := nextState + input := cfg.input.move inputDirection + work := fun i => (cfg.work i).writeAndMove + (workWrites i).toΓ (workDirections i) + output := cfg.output.writeAndMove outputWrite.toΓ outputDirection } : + Complexity.Cfg n tm.Q)] + have h := hheads (inputTape n) + rw [show tapeAt cfg (inputTape n) = cfg.input by + simpa [inputTape] using tapeAt_input_internal cfg] at h + cases inputDirection <;> simp [Tape.move] <;> omega + · by_cases houtput : tape = outputTape n + · subst tape + rw [show tapeAt + { state := nextState + input := cfg.input.move inputDirection + work := fun i => (cfg.work i).writeAndMove + (workWrites i).toΓ (workDirections i) + output := cfg.output.writeAndMove outputWrite.toΓ outputDirection } + (outputTape n) = cfg.output.writeAndMove outputWrite.toΓ outputDirection by + simpa [outputTape] using tapeAt_output_internal + ({ state := nextState + input := cfg.input.move inputDirection + work := fun i => (cfg.work i).writeAndMove + (workWrites i).toΓ (workDirections i) + output := cfg.output.writeAndMove outputWrite.toΓ outputDirection } : + Complexity.Cfg n tm.Q)] + have h := hheads (outputTape n) + rw [show tapeAt cfg (outputTape n) = cfg.output by + simpa [outputTape] using tapeAt_output_internal cfg] at h + cases outputDirection <;> + simp [Tape.writeAndMove, Tape.move, Tape.write_head] <;> omega + · let i : Fin n := ⟨tape.val - 1, by + have hpositive : 0 < tape.val := by + have hnezero : tape.val ≠ 0 := by + intro hzero + apply hinput + apply Fin.ext + simpa [inputTape] using hzero + omega + have hnotOutput : tape.val ≠ n + 1 := by + intro heq + apply houtput + apply Fin.ext + simpa [outputTape] using heq + omega⟩ + have htape : tape = workTape i := by + apply Fin.ext + simp [i, workTape] + have hpositive : 0 < tape.val := by + have hnezero : tape.val ≠ 0 := by + intro hzero + apply hinput + apply Fin.ext + simpa [inputTape] using hzero + omega + omega + rw [htape] + rw [show tapeAt + { state := nextState + input := cfg.input.move inputDirection + work := fun i => (cfg.work i).writeAndMove + (workWrites i).toΓ (workDirections i) + output := cfg.output.writeAndMove outputWrite.toΓ outputDirection } + (workTape i) = (cfg.work i).writeAndMove + (workWrites i).toΓ (workDirections i) by + simpa [workTape] using tapeAt_work_internal + ({ state := nextState + input := cfg.input.move inputDirection + work := fun i => (cfg.work i).writeAndMove + (workWrites i).toΓ (workDirections i) + output := cfg.output.writeAndMove outputWrite.toΓ outputDirection } : + Complexity.Cfg n tm.Q) i] + have h := hheads (workTape i) + rw [show tapeAt cfg (workTape i) = cfg.work i by + simpa [workTape] using tapeAt_work_internal cfg i] at h + cases workDirections i <;> + simp [Tape.writeAndMove, Tape.move, Tape.write_head] <;> omega + +theorem program_measured_internal {tm : TM n} {bound : ℕ} + {cfg next : Complexity.Cfg n tm.Q} {store : Structured.Store} + (hstep : tm.step cfg = some next) + (hrepresents : Represents tm cfg store) + (hheads : HeadsBounded cfg bound) + (hworkStart : ∀ i, (cfg.work i).cells 0 = Γ.start) + (houtputStart : cfg.output.cells 0 = Γ.start) + (henvelope : StepEnvelope tm bound store) : + ∃ final, + Structured.Internal.MeasuredRuns (program tm) store final + (stepCount tm cfg) (timeBound tm bound cfg) (spaceBound tm bound) ∧ + Represents tm next final ∧ StepEnvelope tm bound final := by + let loaded := Structured.Basic.execList (loadOps n) store + have hload := loadOps_measured_internal hrepresents hheads henvelope + have hloaded := loadOps_loaded_internal hrepresents + obtain ⟨final, hdispatch, hfinalRepresents, hfinalEnvelope⟩ := + dispatchState_measured_internal hstep hloaded.1 hheads hworkStart + houtputStart hloaded.2.2.1 hloaded.2.2.2.1 hloaded.2.2.2.2.1 + hloaded.2.2.2.2.2 hload.2 + have hrun := hload.1.seq hdispatch + refine ⟨final, ?_, hfinalRepresents, hfinalEnvelope⟩ + simpa [program, stepCount, timeBound, loaded] using hrun + +private theorem headsBounded_mono {cfg : Complexity.Cfg n Q} + {bound larger : ℕ} (hheads : HeadsBounded cfg bound) + (hle : bound ≤ larger) : HeadsBounded cfg larger := by + intro tape + exact le_trans (hheads tape) hle + +theorem loop_measured_internal {tm : TM n} {steps base : ℕ} + {cfg halted : Complexity.Cfg n tm.Q} {store : Structured.Store} + (hreach : tm.reachesIn steps cfg halted) + (hhalted : tm.halted halted) + (hrepresents : Represents tm cfg store) + (hflag : store (valueReg n) = runningFlag tm cfg.state) + (hheads : HeadsBounded cfg base) + (hworkStart : ∀ i, (cfg.work i).cells 0 = Γ.start) + (houtputStart : cfg.output.cells 0 = Γ.start) + (henvelope : StepEnvelope tm (base + steps) store) : + ∃ final, + Structured.Internal.MeasuredRuns + (.whileNonzero (valueReg n) (loopBody tm)) store final + (loopSteps tm steps cfg) (loopTimeBound tm base steps cfg) + (spaceBound tm (base + steps)) ∧ + Represents tm halted final ∧ + StepEnvelope tm (base + steps) final := by + induction hreach generalizing store base with + | zero => + have hzero : store (valueReg n) = 0 := by + rw [hflag] + simp [runningFlag, hhalted] + have hrun := Structured.Internal.MeasuredRuns.whileZeroEnvelope + (body := loopBody tm) hzero henvelope + refine ⟨store, ?_, hrepresents, henvelope⟩ + simpa [loopSteps, loopTimeBound, wordWidth, spaceBound, + Structured.Internal.valueWidth, + Structured.Internal.envelopeSpace] using hrun + | @step current successor tail finalCfg hstep htail ih => + have hnotHalted := TM.state_ne_qhalt_of_step hstep + have hnonzero : store (valueReg n) ≠ 0 := by + rw [hflag] + simp [runningFlag, hnotHalted] + let bound := base + tail + 1 + have hheadsBound : HeadsBounded current bound := + headsBounded_mono hheads (by simp [bound]; omega) + obtain ⟨middle, hprogram, hmiddleRepresents, hmiddleEnvelope⟩ := + program_measured_internal (bound := bound) hstep hrepresents + hheadsBound hworkStart houtputStart (by + simpa [bound, Nat.add_assoc] using henvelope) + have hsuccessorHeads : HeadsBounded successor (base + 1) := + headsBounded_step_internal hstep hheads + have hsuccessorHeadsBound : HeadsBounded successor bound := + headsBounded_mono hsuccessorHeads (by simp [bound]) + obtain ⟨checked, hcheck, hcheckedRepresents, hcheckedFlag, + _hcheckedOne, _hcheckedCount, hcheckedEnvelope⟩ := + continueCheck_measured_internal (bound := bound) hmiddleRepresents + hsuccessorHeadsBound hmiddleEnvelope + have hstarts := starts_of_step_internal hstep hworkStart houtputStart + have hboundEq : (base + 1) + tail = bound := by + simp [bound] + omega + obtain ⟨final, hloop, hfinalRepresents, hfinalEnvelope⟩ := + ih (base := base + 1) hhalted hcheckedRepresents hcheckedFlag + hsuccessorHeads hstarts.1 hstarts.2 (by + rw [hboundEq] + exact hcheckedEnvelope) + rw [hboundEq] at hloop hfinalEnvelope + have hbody := hprogram.seq hcheck + have hloop' : Structured.Internal.MeasuredRuns + (.whileNonzero (valueReg n) (loopBody tm)) checked final + (loopSteps tm tail successor) + (loopTimeBound tm (base + 1) tail successor) + (spaceBound tm bound) := by + exact hloop + have hbody' : Structured.Internal.MeasuredRuns (loopBody tm) store checked + (stepCount tm current + continueSteps tm successor) + (timeBound tm bound current + continueTimeBound tm bound successor) + (spaceBound tm bound) := by + simpa [loopBody] using hbody + have hrun := Structured.Internal.MeasuredRuns.whileNonzeroEnvelope + hnonzero (by simpa [bound, Nat.add_assoc] using henvelope) hbody' hloop' + refine ⟨final, ?_, hfinalRepresents, ?_⟩ + · simpa [loopSteps, loopTimeBound, hstep, bound, wordWidth, + Structured.Internal.valueWidth, spaceBound, + Structured.Internal.envelopeSpace, Nat.add_assoc] using hrun + · simpa [bound, Nat.add_assoc] using hfinalEnvelope + +theorem runUntilHalt_measured_internal {tm : TM n} {steps base : ℕ} + {cfg halted : Complexity.Cfg n tm.Q} {store : Structured.Store} + (hreach : tm.reachesIn steps cfg halted) + (hhalted : tm.halted halted) + (hrepresents : Represents tm cfg store) + (hheads : HeadsBounded cfg base) + (hworkStart : ∀ i, (cfg.work i).cells 0 = Γ.start) + (houtputStart : cfg.output.cells 0 = Γ.start) + (henvelope : StepEnvelope tm (base + steps) store) : + ∃ final, + Structured.Internal.MeasuredRuns (runUntilHalt tm) store final + (runSteps tm steps cfg) (runTimeBound tm base steps cfg) + (spaceBound tm (base + steps)) ∧ + Represents tm halted final ∧ + StepEnvelope tm (base + steps) final := by + have hheadsBound : HeadsBounded cfg (base + steps) := + headsBounded_mono hheads (by omega) + obtain ⟨checked, hcheck, hcheckedRepresents, hcheckedFlag, + _hcheckedOne, _hcheckedCount, hcheckedEnvelope⟩ := + continueCheck_measured_internal (bound := base + steps) hrepresents + hheadsBound henvelope + obtain ⟨final, hloop, hfinalRepresents, hfinalEnvelope⟩ := + loop_measured_internal hreach hhalted hcheckedRepresents hcheckedFlag + hheads hworkStart houtputStart hcheckedEnvelope + have hrun := hcheck.seq hloop + refine ⟨final, ?_, hfinalRepresents, hfinalEnvelope⟩ + simpa [runUntilHalt, runSteps, runTimeBound] using hrun + +private theorem dispatchCost_eq_factor (tm : TM n) (bound : ℕ) + (state : tm.Q) (actual : Fin (n + 2) → Γ) + (remaining : List (Fin (n + 2))) : + dispatchCost tm bound state actual remaining = + dispatchFactor tm state actual remaining * wordWidth tm bound := by + induction remaining with + | nil => simp [dispatchCost, dispatchFactor] + | cons tape rest ih => + simp [dispatchCost, dispatchFactor, Structured.Switch.costBound, ih] + ring + +theorem timeBound_le_stepFactor_internal (tm : TM n) (bound : ℕ) + (cfg : Complexity.Cfg n tm.Q) : + timeBound tm bound cfg ≤ stepFactor tm * wordWidth tm bound := by + have hfactor : 7 * stateCode tm cfg.state + 1 + + dispatchFactor tm cfg.state (readSymbols cfg) + (List.finRange (n + 2)) ≤ + Finset.univ.sup fun state : tm.Q => + Finset.univ.sup fun actual : Fin (n + 2) → Γ => + 7 * stateCode tm state + 1 + + dispatchFactor tm state actual (List.finRange (n + 2)) := by + apply le_trans + (Finset.le_sup + (f := fun actual : Fin (n + 2) → Γ => + 7 * stateCode tm cfg.state + 1 + + dispatchFactor tm cfg.state actual (List.finRange (n + 2))) + (Finset.mem_univ (readSymbols cfg))) + exact Finset.le_sup + (f := fun state : tm.Q => + Finset.univ.sup fun actual : Fin (n + 2) → Γ => + 7 * stateCode tm state + 1 + + dispatchFactor tm state actual (List.finRange (n + 2))) + (Finset.mem_univ cfg.state) + rw [timeBound, dispatchCost_eq_factor] + simp only [Structured.Switch.costBound] + calc + 4 * (loadOps n).length * wordWidth tm bound + + ((7 * stateCode tm cfg.state + 1) * wordWidth tm bound + + dispatchFactor tm cfg.state (readSymbols cfg) + (List.finRange (n + 2)) * wordWidth tm bound) + = (4 * (loadOps n).length + + (7 * stateCode tm cfg.state + 1 + + dispatchFactor tm cfg.state (readSymbols cfg) + (List.finRange (n + 2)))) * wordWidth tm bound := by ring + _ ≤ (4 * (loadOps n).length + + Finset.univ.sup fun state : tm.Q => + Finset.univ.sup fun actual : Fin (n + 2) → Γ => + 7 * stateCode tm state + 1 + + dispatchFactor tm state actual (List.finRange (n + 2))) * + wordWidth tm bound := Nat.mul_le_mul_right _ + (Nat.add_le_add_left hfactor _) + _ = stepFactor tm * wordWidth tm bound := by rfl + +theorem continueTimeBound_le_factor_internal (tm : TM n) (bound : ℕ) + (cfg : Complexity.Cfg n tm.Q) : + continueTimeBound tm bound cfg ≤ + continueFactor tm * wordWidth tm bound := by + have hstate : stateCode tm cfg.state < Fintype.card tm.Q := by + simp [stateCode] + simp only [continueTimeBound, Structured.Switch.costBound, continueFactor] + calc + 4 * (loadOps n).length * wordWidth tm bound + + ((7 * stateCode tm cfg.state + 1) * wordWidth tm bound + + 4 * wordWidth tm bound) + = (4 * (loadOps n).length + + (7 * stateCode tm cfg.state + 5)) * wordWidth tm bound := by ring + _ ≤ (4 * (loadOps n).length + + (7 * Fintype.card tm.Q + 5)) * wordWidth tm bound := by + apply Nat.mul_le_mul_right + omega + +theorem loopTimeBound_le_linear_internal (tm : TM n) (base steps : ℕ) + (cfg : Complexity.Cfg n tm.Q) : + loopTimeBound tm base steps cfg ≤ + (steps * iterationFactor tm + 1) * wordWidth tm (base + steps) := by + induction steps generalizing base cfg with + | zero => simp [loopTimeBound] + | succ steps ih => + rw [loopTimeBound] + split + · exact Nat.zero_le _ + · rename_i next hstep + have hstepBound := timeBound_le_stepFactor_internal tm + (base + steps + 1) cfg + have hcheckBound := continueTimeBound_le_factor_internal tm + (base + steps + 1) next + have htail := ih (base := base + 1) (cfg := next) + have hwidth : wordWidth tm ((base + 1) + steps) = + wordWidth tm (base + (steps + 1)) := by + congr 1 + omega + rw [hwidth] at htail + have hboundWidth : wordWidth tm (base + steps + 1) = + wordWidth tm (base + (steps + 1)) := by + congr 1 + rw [hboundWidth] at hstepBound hcheckBound + calc + 3 * wordWidth tm (base + steps + 1) + + timeBound tm (base + steps + 1) cfg + + continueTimeBound tm (base + steps + 1) next + + loopTimeBound tm (base + 1) steps next + ≤ 3 * wordWidth tm (base + (steps + 1)) + + stepFactor tm * wordWidth tm (base + (steps + 1)) + + continueFactor tm * wordWidth tm (base + (steps + 1)) + + (steps * iterationFactor tm + 1) * + wordWidth tm (base + (steps + 1)) := by + rw [hboundWidth] + omega + _ = ((steps + 1) * iterationFactor tm + 1) * + wordWidth tm (base + (steps + 1)) := by + simp [iterationFactor] + ring + +theorem runTimeBound_le_linear_internal (tm : TM n) (base steps : ℕ) + (cfg : Complexity.Cfg n tm.Q) : + runTimeBound tm base steps cfg ≤ + ((steps + 1) * runFactor tm) * wordWidth tm (base + steps) := by + have hcheck := continueTimeBound_le_factor_internal tm (base + steps) cfg + have hloop := loopTimeBound_le_linear_internal tm base steps cfg + rw [runTimeBound] + calc + continueTimeBound tm (base + steps) cfg + loopTimeBound tm base steps cfg + ≤ continueFactor tm * wordWidth tm (base + steps) + + (steps * iterationFactor tm + 1) * + wordWidth tm (base + steps) := Nat.add_le_add hcheck hloop + _ ≤ ((steps + 1) * runFactor tm) * wordWidth tm (base + steps) := by + have hc : continueFactor tm ≤ (steps + 1) * continueFactor tm := by + simpa only [one_mul] using + Nat.mul_le_mul_right (continueFactor tm) (show 1 ≤ steps + 1 by omega) + have hi : steps * iterationFactor tm ≤ + (steps + 1) * iterationFactor tm := + Nat.mul_le_mul_right (iterationFactor tm) (Nat.le_succ steps) + have hone : 1 ≤ steps + 1 := by omega + rw [show continueFactor tm * wordWidth tm (base + steps) + + (steps * iterationFactor tm + 1) * wordWidth tm (base + steps) = + (continueFactor tm + steps * iterationFactor tm + 1) * + wordWidth tm (base + steps) by ring] + apply Nat.mul_le_mul_right + simp only [runFactor] + calc + continueFactor tm + steps * iterationFactor tm + 1 + ≤ (steps + 1) * continueFactor tm + + (steps + 1) * iterationFactor tm + (steps + 1) := by omega + _ = (steps + 1) * + (continueFactor tm + iterationFactor tm + 1) := by ring + +end Sparse + +end TMConfig + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Step.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Step.lean new file mode 100644 index 0000000000..474a2b5800 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Step.lean @@ -0,0 +1,240 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Step.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Step.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured + +/-! +# Fixed RAM transition blocks for bounded Turing-machine configurations + +The public layer exposes the exact register layout, verified loading and action +phases, and the composed nested state/symbol dispatcher. Thus the fixed +structured program has exact one-step source semantics; its common resource +envelope and compiled-RAM transfer are the next M6 layer. +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace TMConfig + +namespace Step + + +/-- Every alphabet symbol is a valid four-way dispatch code. -/ +theorem symbolCode_lt (symbol : Γ) : symbolCode symbol < 4 := + symbolCode_lt_internal symbol + +/-- Dispatching on an encoded alphabet symbol recovers that symbol. -/ +theorem symbolAt_code (symbol : Γ) : + symbolAt ⟨symbolCode symbol, symbolCode_lt symbol⟩ = symbol := + symbolAt_code_internal symbol + +/-- Every canonical state code is valid for the machine's finite state count. -/ +theorem stateCode_lt (tm : TM n) (state : tm.Q) : + stateCode tm state < Fintype.card tm.Q := + stateCode_lt_internal tm state + +/-- The arithmetic head address agrees with the configuration-field layout. -/ +theorem headReg_eq_fieldReg (tape : Fin (n + 2)) : + headReg tape = fieldReg (headField (bound := bound) tape) := + headReg_eq_fieldReg_internal tape + +/-- A tape-block base plus an in-window position agrees with the corresponding +configuration-field address. -/ +theorem cellBase_add_eq_fieldReg (tape : Fin (n + 2)) + (position : Fin (bound + 1)) : + cellBase n bound tape + position.val = fieldReg (cellField tape position) := + cellBase_add_eq_fieldReg_internal tape position + +/-- The canonical register encoding fits the one-step program's explicit store +envelope whenever all represented heads lie in the chosen window. -/ +theorem encodeRegs_storeBounded (tm : TM n) (bound : ℕ) + (cfg : Complexity.Cfg n tm.Q) (hheads : HeadsBounded cfg bound) : + StoreBounded tm bound (encodeRegs tm bound cfg) := + encodeRegs_storeBounded_internal tm bound cfg hheads + +/-- The generated load block preserves the represented configuration and loads +the state and every symbol needed by the finite transition dispatcher. -/ +theorem loadOps_correct {tm : TM n} {bound : ℕ} + {cfg : Complexity.Cfg n tm.Q} {store : Structured.Store} + (hrepresents : Represents tm bound cfg store) + (hheads : HeadsBounded cfg bound) : + let final := Structured.Basic.execList (loadOps n bound) store + Represents tm bound cfg final ∧ + final (zeroReg n bound) = 0 ∧ + final (oneReg n bound) = 1 ∧ + final (stateScratchReg n bound) = stateCode tm cfg.state ∧ + ∀ tape, final (symbolReg n bound tape) = + symbolCode (readSymbols cfg tape) := + loadOps_loaded_internal hrepresents hheads + +/-- Once the state and head symbols select a concrete transition, its generated +straight-line action maps any represented configuration to the exact TM +successor. The assumptions are precisely those needed by the bounded tape +layout: all heads are in range, writable tapes retain the left-end marker, and +the loading phase has initialized the fixedValue-one scratch register. -/ +theorem actionOps_correct {tm : TM n} {bound : ℕ} + {cfg next : Complexity.Cfg n tm.Q} {store : Structured.Store} + (hstep : tm.step cfg = some next) + (hrepresents : Represents tm bound cfg store) + (hheads : HeadsBounded cfg bound) + (hworkStart : ∀ i, (cfg.work i).cells 0 = Γ.start) + (houtputStart : cfg.output.cells 0 = Γ.start) + (hone : store (oneReg n bound) = 1) : + Represents tm bound next + (Structured.Basic.execList + (actionOps tm bound cfg.state (readSymbols cfg)) store) := + actionOps_represents_internal hstep hrepresents hheads hworkStart + houtputStart hone + +/-- The complete fixed structured program performs exactly one nonhalting TM +transition. The source execution has the advertised exact instruction count and +its final store represents the successor configuration. -/ +theorem program_correct {tm : TM n} {bound : ℕ} + {cfg next : Complexity.Cfg n tm.Q} {store : Structured.Store} + (hstep : tm.step cfg = some next) + (hrepresents : Represents tm bound cfg store) + (hwindow : WithinWindow cfg bound) + (hworkStart : ∀ i, (cfg.work i).StartInvariant) + (houtputStart : cfg.output.StartInvariant) : + ∃ final cost space, + Structured.Exec (program tm bound) store final + (stepCount tm bound cfg) cost space ∧ + Represents tm bound next final := + program_exec_internal hstep hrepresents hwindow + (fun i => (hworkStart i).1) houtputStart.1 + +/-- If the successor also fits the chosen cell window, decoding the complete +program's final store returns that successor exactly. -/ +theorem program_decodes {tm : TM n} {bound : ℕ} + {cfg next : Complexity.Cfg n tm.Q} {store : Structured.Store} + (hstep : tm.step cfg = some next) + (hrepresents : Represents tm bound cfg store) + (hwindow : WithinWindow cfg bound) + (hnextBounded : Bounded next bound) + (hworkStart : ∀ i, (cfg.work i).StartInvariant) + (houtputStart : cfg.output.StartInvariant) : + ∃ final cost space, + Structured.Exec (program tm bound) store final + (stepCount tm bound cfg) cost space ∧ + decode tm bound final = next := by + obtain ⟨final, cost, space, hexec, hfinal⟩ := + program_correct hstep hrepresents hwindow hworkStart houtputStart + exact ⟨final, cost, space, hexec, + decode_of_represents tm bound next final hfinal hnextBounded⟩ + +/-- The complete one-step source block satisfies its exact transition count, +explicit logarithmic-cost bound, and peak-space bound while preserving both the +successor representation and the store envelope needed for composition. -/ +theorem program_performance {tm : TM n} {bound : ℕ} + {cfg next : Complexity.Cfg n tm.Q} {store : Structured.Store} + (hstep : tm.step cfg = some next) + (hrepresents : Represents tm bound cfg store) + (hwindow : WithinWindow cfg bound) + (hworkStart : ∀ i, (cfg.work i).StartInvariant) + (houtputStart : cfg.output.StartInvariant) + (hstore : StoreBounded tm bound store) : + ∃ final cost space, + Structured.Exec (program tm bound) store final + (stepCount tm bound cfg) cost space ∧ + cost ≤ timeBound tm bound cfg ∧ space ≤ spaceBound tm bound ∧ + Represents tm bound next final ∧ StoreBounded tm bound final := by + let henvelope : Structured.Internal.StoreEnvelope + (registerLimit n bound) (wordBound tm bound) store := + ⟨hstore.1, hstore.2⟩ + obtain ⟨final, hrun, hfinalRepresents, hfinalEnvelope⟩ := + program_measured_internal hstep hrepresents hwindow + (fun i => (hworkStart i).1) houtputStart.1 henvelope + obtain ⟨cost, space, hexec, hcost, hspace⟩ := hrun + exact ⟨final, cost, space, hexec, hcost, hspace, hfinalRepresents, + hfinalEnvelope.index_lt, hfinalEnvelope.value_le⟩ + +/-- End-to-end transfer of the measured source theorem to the concrete compiled +RAM block. After the exact step count, the RAM is stopped at the compiler's +terminal halt instruction with the successor represented in its registers. -/ +theorem compiled_correct {tm : TM n} {bound : ℕ} + {cfg next : Complexity.Cfg n tm.Q} {store : Structured.Store} + (hstep : tm.step cfg = some next) + (hrepresents : Represents tm bound cfg store) + (hwindow : WithinWindow cfg bound) + (hworkStart : ∀ i, (cfg.work i).StartInvariant) + (houtputStart : cfg.output.StartInvariant) + (hstore : StoreBounded tm bound store) : + ∃ final cost space, + Structured.Exec (program tm bound) store final + (stepCount tm bound cfg) cost space ∧ + run (compiled tm bound) (stepCount tm bound cfg) { pc := 0, regs := store } = + { pc := (program tm bound).codeSize, regs := final } ∧ + Halted (compiled tm bound) + (run (compiled tm bound) (stepCount tm bound cfg) { pc := 0, regs := store }) ∧ + logTimeUpto (compiled tm bound) (stepCount tm bound cfg) + { pc := 0, regs := store } ≤ timeBound tm bound cfg ∧ + spaceUpto (compiled tm bound) (stepCount tm bound cfg) + { pc := 0, regs := store } ≤ spaceBound tm bound ∧ + Represents tm bound next final ∧ StoreBounded tm bound final := by + obtain ⟨final, cost, space, hexec, hcost, hspace, hfinal, hfinalStore⟩ := + program_performance hstep hrepresents hwindow hworkStart houtputStart hstore + have hcompiled := Structured.Exec.compile_correct hexec + refine ⟨final, cost, space, hexec, ?_, ?_, ?_, ?_, hfinal, hfinalStore⟩ + · simpa [compiled] using hcompiled.1 + · simpa [compiled] using Structured.Exec.compile_halted hexec + · change logTimeUpto (program tm bound).compile (stepCount tm bound cfg) + { pc := 0, regs := store } ≤ timeBound tm bound cfg + rw [hcompiled.2.1] + exact hcost + · change spaceUpto (program tm bound).compile (stepCount tm bound cfg) + { pc := 0, regs := store } ≤ spaceBound tm bound + rw [hcompiled.2.2] + exact hspace + +/-- The canonical encoded configuration therefore runs through the concrete +compiled block and decodes to the exact TM successor. -/ +theorem compiled_encode_decodes {tm : TM n} {bound : ℕ} + {cfg next : Complexity.Cfg n tm.Q} + (hstep : tm.step cfg = some next) + (hwindow : WithinWindow cfg bound) + (hnextBounded : Bounded next bound) + (hworkStart : ∀ i, (cfg.work i).StartInvariant) + (houtputStart : cfg.output.StartInvariant) : + let initial := encodeRegs tm bound cfg + ∃ final cost space, + Structured.Exec (program tm bound) initial final + (stepCount tm bound cfg) cost space ∧ + run (compiled tm bound) (stepCount tm bound cfg) { pc := 0, regs := initial } = + { pc := (program tm bound).codeSize, regs := final } ∧ + Halted (compiled tm bound) + (run (compiled tm bound) (stepCount tm bound cfg) + { pc := 0, regs := initial }) ∧ + logTimeUpto (compiled tm bound) (stepCount tm bound cfg) + { pc := 0, regs := initial } ≤ timeBound tm bound cfg ∧ + spaceUpto (compiled tm bound) (stepCount tm bound cfg) + { pc := 0, regs := initial } ≤ spaceBound tm bound ∧ + decode tm bound + (run (compiled tm bound) (stepCount tm bound cfg) + { pc := 0, regs := initial }).regs = next := by + let initial := encodeRegs tm bound cfg + obtain ⟨final, cost, space, hexec, hrun, hhalted, htime, hspace, + hfinal, _hfinalStore⟩ := compiled_correct hstep + (encodeRegs_represents tm bound cfg) hwindow hworkStart houtputStart + (encodeRegs_storeBounded tm bound cfg hwindow.2) + refine ⟨final, cost, space, hexec, hrun, hhalted, htime, hspace, ?_⟩ + rw [hrun] + exact decode_of_represents tm bound next final hfinal hnextBounded + +end Step + +end TMConfig + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Step/Defs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Step/Defs.lean new file mode 100644 index 0000000000..4183aec0b9 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Step/Defs.lean @@ -0,0 +1,228 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.Switch.Defs + +/-! +# A fixed structured-RAM block for one Turing-machine transition + +The finite transition function is compiled as a decision tree. The program +first loads the symbols under all named heads, dispatches on the finite-state +code and the `n + 2` four-symbol codes, then performs the selected transition +using indirect stores into the bounded tape blocks. + +The construction is fixed once `tm` and the cell-window bound are fixed. It +does not install or consult an untrusted transition-table oracle. +-/ + + +@[expose] public section + +namespace Complexity + +namespace RAM + +namespace TMConfig + +namespace Step + + +/-- Input tape index. -/ +def inputTape (n : ℕ) : Fin (n + 2) := ⟨0, by omega⟩ + +/-- Work-tape index in the named input/work/output order. -/ +def workTape (i : Fin n) : Fin (n + 2) := ⟨i.val + 1, by omega⟩ + +/-- Output tape index. -/ +def outputTape (n : ℕ) : Fin (n + 2) := ⟨n + 1, by omega⟩ + +/-- Direct head register for one named tape. -/ +def headReg (tape : Fin (n + 2)) : ℕ := 1 + tape.val + +/-- First cell register of one named tape's bounded block. -/ +def cellBase (n bound : ℕ) (tape : Fin (n + 2)) : ℕ := + 1 + (n + 2) + tape.val * (bound + 1) + +/-- First scratch register beyond the represented configuration. -/ +def scratchBase (n bound : ℕ) : ℕ := registerCount n bound + +/-- Constant-zero scratch register. -/ +def zeroReg (n bound : ℕ) : ℕ := scratchBase n bound + +/-- Constant-one scratch register used by decrementing switches and head moves. -/ +def oneReg (n bound : ℕ) : ℕ := scratchBase n bound + 1 + +/-- Destructive copy of the finite-state code used by the outer switch. -/ +def stateScratchReg (n bound : ℕ) : ℕ := scratchBase n bound + 2 + +/-- Scratch register holding an indirect cell address. -/ +def addressReg (n bound : ℕ) : ℕ := scratchBase n bound + 3 + +/-- Scratch register holding a writable symbol code. -/ +def valueReg (n bound : ℕ) : ℕ := scratchBase n bound + 4 + +/-- Scratch register holding the symbol loaded under one named head. -/ +def symbolReg (n bound : ℕ) (tape : Fin (n + 2)) : ℕ := + scratchBase n bound + 5 + tape.val + +/-- Exclusive upper bound on every configuration and scratch register. -/ +def registerLimit (n bound : ℕ) : ℕ := scratchBase n bound + n + 7 + +/-- A uniform value bound large enough for addresses, states, symbols, and a +single rightward head move. -/ +def wordBound (tm : TM n) (bound : ℕ) : ℕ := + max (registerLimit n bound) (max (Fintype.card tm.Q) (bound + 1)) + +/-- One-bit-cushioned width used in logarithmic-cost bounds. -/ +def wordWidth (tm : TM n) (bound : ℕ) : ℕ := + bitlen (wordBound tm bound) + 1 + +/-- Peak-space envelope for one transition block. -/ +def spaceBound (tm : TM n) (bound : ℕ) : ℕ := + registerLimit n bound * + (bitlen (registerLimit n bound) + bitlen (wordBound tm bound)) + +/-- A store fits the explicit register/value envelope used by one transition +block. This public predicate states the concrete boundary directly without +exposing the internal resource-certificate structure. -/ +def StoreBounded (tm : TM n) (bound : ℕ) (store : Structured.Store) : Prop := + (∀ reg, store reg ≠ 0 → reg < registerLimit n bound) ∧ + ∀ reg, store reg ≤ wordBound tm bound + +/-- Decode one valid four-way switch branch as a tape symbol. -/ +def symbolAt (code : Fin 4) : Γ := symbolDecode code.val + +/-- Symbols currently read by all named TM heads. -/ +def readSymbols (cfg : Complexity.Cfg n Q) : Fin (n + 2) → Γ := + fun tape => (tapeAt cfg tape).read + +/-- Load the symbol under one represented head into its dedicated scratch +register. -/ +def loadTapeOps (n bound : ℕ) (tape : Fin (n + 2)) : List Structured.Basic := + [.imm (addressReg n bound) (cellBase n bound tape), + .add (addressReg n bound) (addressReg n bound) (headReg tape), + .load (symbolReg n bound tape) (addressReg n bound)] + +/-- Initialize constants and copy the represented finite-state code. -/ +def setupOps (n bound : ℕ) : List Structured.Basic := + [.imm (zeroReg n bound) 0, + .imm (oneReg n bound) 1, + .add (stateScratchReg n bound) 0 (zeroReg n bound)] + +/-- Initialize scratch state and load every represented head symbol. -/ +def loadOps (n bound : ℕ) : List Structured.Basic := + setupOps n bound ++ + (List.finRange (n + 2)).flatMap (loadTapeOps n bound) + +/-- Encode a writable tape symbol with the same zero-blank convention as the +configuration representation. -/ +def writeCode (symbol : Γw) : ℕ := symbolCode symbol.toΓ + +/-- Update a represented head in the indicated direction. -/ +def moveOps (n bound : ℕ) (tape : Fin (n + 2)) : Dir3 → List Structured.Basic + | .left => [.sub (headReg tape) (headReg tape) (oneReg n bound)] + | .right => [.add (headReg tape) (headReg tape) (oneReg n bound)] + | .stay => [] + +/-- Write one represented work/output tape and restore the left-end marker. -/ +def writeOps (n bound : ℕ) (tape : Fin (n + 2)) + (write : Γw) : List Structured.Basic := + [.imm (addressReg n bound) (cellBase n bound tape), + .add (addressReg n bound) (addressReg n bound) (headReg tape), + .imm (valueReg n bound) (writeCode write), + .store (addressReg n bound) (valueReg n bound), + .imm (cellBase n bound tape) (symbolCode Γ.start)] + +/-- Write one represented work/output tape and move its head. + +The direct write restoring cell zero to `▷` makes this branch-free while +matching `Tape.write`, whose write at head zero is a no-op. -/ +def writeMoveOps (n bound : ℕ) (tape : Fin (n + 2)) + (write : Γw) (direction : Dir3) : List Structured.Basic := + writeOps n bound tape write ++ moveOps n bound tape direction + +/-- Straight-line register operations implementing a statically selected TM +transition case. -/ +noncomputable def actionOps (tm : TM n) (bound : ℕ) (state : tm.Q) + (symbols : Fin (n + 2) → Γ) : List Structured.Basic := + match tm.δ state (symbols (inputTape n)) + (fun i => symbols (workTape i)) (symbols (outputTape n)) with + | (nextState, workWrites, outputWrite, inputDirection, + workDirections, outputDirection) => + [.imm 0 (stateCode tm nextState)] ++ + moveOps n bound (inputTape n) inputDirection ++ + (List.finRange n).flatMap (fun i => + writeMoveOps n bound (workTape i) (workWrites i) (workDirections i)) ++ + writeMoveOps n bound (outputTape n) outputWrite outputDirection + +/-- Structured command for one statically selected transition case. -/ +noncomputable def action (tm : TM n) (bound : ℕ) (state : tm.Q) + (symbols : Fin (n + 2) → Γ) : Structured.Cmd := + Structured.Cmd.basics (actionOps tm bound state symbols) + +/-- Recursively dispatch on the loaded symbols for the listed named tapes. -/ +noncomputable def dispatchSymbols (tm : TM n) (bound : ℕ) (state : tm.Q) : + List (Fin (n + 2)) → (Fin (n + 2) → Γ) → Structured.Cmd + | [], symbols => action tm bound state symbols + | tape :: rest, symbols => + Structured.Switch.select 4 (symbolReg n bound tape) (oneReg n bound) + (fun code => dispatchSymbols tm bound state rest + (Function.update symbols tape (symbolAt code))) + +/-- Dispatch on the finite-state code, then on every loaded tape symbol. -/ +noncomputable def dispatchState (tm : TM n) (bound : ℕ) : Structured.Cmd := + Structured.Switch.select (Fintype.card tm.Q) (stateScratchReg n bound) + (oneReg n bound) (fun stateCode => + dispatchSymbols tm bound ((Fintype.equivFin tm.Q).symm stateCode) + (List.finRange (n + 2)) (fun _ => Γ.blank)) + +/-- Fixed structured-RAM program implementing one nonhalting TM transition. -/ +noncomputable def program (tm : TM n) (bound : ℕ) : Structured.Cmd := + .seq (.basics (loadOps n bound)) (dispatchState tm bound) + +/-- Concrete compiled RAM block for one nonhalting TM transition. -/ +noncomputable def compiled (tm : TM n) (bound : ℕ) : Program := + (program tm bound).compile + +/-- Exact transition count through symbol dispatch for the actually read case. -/ +noncomputable def dispatchSteps (tm : TM n) (bound : ℕ) (state : tm.Q) + (actual : Fin (n + 2) → Γ) : List (Fin (n + 2)) → ℕ + | [] => (actionOps tm bound state actual).length + | tape :: rest => Structured.Switch.stepCount (symbolCode (actual tape)) + (dispatchSteps tm bound state actual rest) + +/-- Exact source/compiled transition count for one represented TM step. -/ +noncomputable def stepCount (tm : TM n) (bound : ℕ) + (cfg : Complexity.Cfg n tm.Q) : ℕ := + (loadOps n bound).length + + Structured.Switch.stepCount (stateCode tm cfg.state) + (dispatchSteps tm bound cfg.state (readSymbols cfg) + (List.finRange (n + 2))) + +/-- Logarithmic-cost bound through symbol dispatch. -/ +noncomputable def dispatchCost (tm : TM n) (bound : ℕ) (state : tm.Q) + (actual : Fin (n + 2) → Γ) : List (Fin (n + 2)) → ℕ + | [] => 4 * (actionOps tm bound state actual).length * wordWidth tm bound + | tape :: rest => Structured.Switch.costBound (symbolCode (actual tape)) + (dispatchCost tm bound state actual rest) (wordWidth tm bound) + +/-- Explicit logarithmic-cost bound for one represented TM step. -/ +noncomputable def timeBound (tm : TM n) (bound : ℕ) + (cfg : Complexity.Cfg n tm.Q) : ℕ := + 4 * (loadOps n bound).length * wordWidth tm bound + + Structured.Switch.costBound (stateCode tm cfg.state) + (dispatchCost tm bound cfg.state (readSymbols cfg) + (List.finRange (n + 2))) (wordWidth tm bound) + +end Step + +end TMConfig + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Step/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Step/Internal.lean new file mode 100644 index 0000000000..87e6d1ebdf --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Step/Internal.lean @@ -0,0 +1,20 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Step.Internal.Layout +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Step.Internal.Load +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Step.Internal.Action +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Step.Internal.Dispatch +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Step.Internal.Resources + +/-! +# One-step TM-to-RAM simulation -- proof internals + +This aggregation module contains the checked layout, head-symbol loading, +selected transition-action, nested finite-dispatch, and source-resource layers. +The public surface transfers the resulting measured execution to compiled RAM. +-/ diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Step/Internal/Action.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Step/Internal/Action.lean new file mode 100644 index 0000000000..1a8c6e91b8 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Step/Internal/Action.lean @@ -0,0 +1,1181 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Step.Internal.Layout +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.Internal.Resources + +/-! +# Selected TM transition actions -- proof internals +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace TMConfig + +namespace Step + + +private theorem execList_append (first second : List Structured.Basic) + (store : Structured.Store) : + Structured.Basic.execList (first ++ second) store = + Structured.Basic.execList second (Structured.Basic.execList first store) := by + induction first generalizing store with + | nil => rfl + | cons op rest ih => simp [Structured.Basic.execList, ih] + +/-- Representation restricted to one named tape block. -/ +private def RepresentsTape (bound : ℕ) (slot : Fin (n + 2)) + (tape : Tape) (store : Structured.Store) : Prop := + store (headReg slot) = tape.head ∧ + ∀ position : Fin (bound + 1), + store (cellBase n bound slot + position.val) = + symbolCode (tape.cells position.val) + +private theorem Represents.tape {tm : TM n} {bound : ℕ} + {cfg : Complexity.Cfg n tm.Q} {store : Structured.Store} + (hrepresents : Represents tm bound cfg store) (slot : Fin (n + 2)) : + RepresentsTape bound slot (tapeAt cfg slot) store := by + constructor + · have hhead := hrepresents (headField (bound := bound) slot) + rwa [← headReg_eq_fieldReg_internal] at hhead + · intro position + have hcell := hrepresents (cellField slot position) + rwa [← cellBase_add_eq_fieldReg_internal] at hcell + +private theorem configReg_ne_address {n bound reg : ℕ} + (hreg : reg < registerCount n bound) : reg ≠ addressReg n bound := + fun heq => not_lt_of_ge (addressReg_ge_internal n bound) (heq ▸ hreg) + +private theorem configReg_ne_value {n bound reg : ℕ} + (hreg : reg < registerCount n bound) : reg ≠ valueReg n bound := + fun heq => not_lt_of_ge (valueReg_ge_internal n bound) (heq ▸ hreg) + +/-- On configuration registers, the concrete write block is exactly an update +at the represented head followed by restoration of cell zero. -/ +private theorem writeOps_apply (n bound : ℕ) (slot : Fin (n + 2)) + (write : Γw) (store : Structured.Store) {reg : ℕ} + (hregAddress : reg ≠ addressReg n bound) + (hregValue : reg ≠ valueReg n bound) : + Structured.Basic.execList (writeOps n bound slot write) store reg = + Function.update + (Function.update store + (cellBase n bound slot + store (headReg slot)) (writeCode write)) + (cellBase n bound slot) (symbolCode Γ.start) reg := by + let first := + (Structured.Basic.imm (addressReg n bound) (cellBase n bound slot)).exec store + let addressed := + (Structured.Basic.add (addressReg n bound) (addressReg n bound) + (headReg slot)).exec first + let valued := (Structured.Basic.imm (valueReg n bound) (writeCode write)).exec addressed + have haddressHead : addressReg n bound ≠ headReg slot := by + intro heq + have hfield := fieldReg_lt_internal (headField (bound := bound) slot) + rw [← headReg_eq_fieldReg_internal] at hfield + have hscratch := addressReg_ge_internal n bound + omega + have haddressValue : addressReg n bound ≠ valueReg n bound := by + simp [addressReg, valueReg] + have hfirstAddress : first (addressReg n bound) = cellBase n bound slot := by + simp [first, Structured.Basic.exec] + have hfirstHead : first (headReg slot) = store (headReg slot) := by + simp [first, Structured.Basic.exec, Function.update_of_ne (Ne.symm haddressHead)] + have haddressedAddress : + addressed (addressReg n bound) = + cellBase n bound slot + store (headReg slot) := by + simp only [addressed, Structured.Basic.exec, Function.update_self] + rw [hfirstAddress, hfirstHead] + have hvaluedAddress : + valued (addressReg n bound) = + cellBase n bound slot + store (headReg slot) := by + simp only [valued, Structured.Basic.exec] + rw [Function.update_of_ne haddressValue, haddressedAddress] + have hvaluedValue : valued (valueReg n bound) = writeCode write := by + simp [valued, Structured.Basic.exec] + have hvaluedConfig : valued reg = store reg := by + simp [valued, addressed, first, Structured.Basic.exec, + Function.update_of_ne hregAddress, Function.update_of_ne hregValue] + simp only [writeOps, Structured.Basic.execList] + change Function.update + (Function.update valued (valued (addressReg n bound)) + (valued (valueReg n bound))) + (cellBase n bound slot) (symbolCode Γ.start) reg = _ + rw [hvaluedAddress, hvaluedValue] + by_cases hzero : reg = cellBase n bound slot + · subst reg + rw [Function.update_self, Function.update_self] + · by_cases htarget : reg = cellBase n bound slot + store (headReg slot) + · rw [Function.update_of_ne hzero, Function.update_of_ne hzero] + subst reg + rw [Function.update_self, Function.update_self] + · rw [Function.update_of_ne hzero, Function.update_of_ne hzero, + Function.update_of_ne htarget, Function.update_of_ne htarget] + exact hvaluedConfig + +private theorem headReg_ne_cellReg (headSlot cellSlot : Fin (n + 2)) + (position : Fin (bound + 1)) : + headReg headSlot ≠ cellBase n bound cellSlot + position.val := by + intro heq + rw [headReg_eq_fieldReg_internal, + cellBase_add_eq_fieldReg_internal] at heq + have hfield := fieldReg_injective_internal heq + cases hfield + +private theorem cellReg_ne_cellReg_of_slot_ne {first second : Fin (n + 2)} + (hne : first ≠ second) (firstPosition secondPosition : Fin (bound + 1)) : + cellBase n bound first + firstPosition.val ≠ + cellBase n bound second + secondPosition.val := by + intro heq + rw [cellBase_add_eq_fieldReg_internal, + cellBase_add_eq_fieldReg_internal] at heq + have hfield := fieldReg_injective_internal heq + change Sum.inr (Sum.inr (first, firstPosition)) = + Sum.inr (Sum.inr (second, secondPosition)) at hfield + have hpairs := Sum.inr.inj (Sum.inr.inj hfield) + exact hne (congrArg Prod.fst hpairs) + +private theorem writeOps_head (n bound : ℕ) (slot : Fin (n + 2)) + (write : Γw) (store : Structured.Store) : + Structured.Basic.execList (writeOps n bound slot write) store (headReg slot) = + store (headReg slot) := by + have hreg : headReg slot < registerCount n bound := by + rw [headReg_eq_fieldReg_internal] + exact fieldReg_lt_internal _ + rw [writeOps_apply n bound slot write store + (configReg_ne_address hreg) (configReg_ne_value hreg)] + have hzero : headReg slot ≠ cellBase n bound slot := by + simp [headReg, cellBase] + omega + have htarget : + headReg slot ≠ cellBase n bound slot + store (headReg slot) := by + simp [headReg, cellBase] + omega + rw [Function.update_of_ne hzero, Function.update_of_ne htarget] + +private theorem writeOps_cells (n bound : ℕ) (slot : Fin (n + 2)) + (write : Γw) (tape : Tape) (store : Structured.Store) + (hrepresents : RepresentsTape bound slot tape store) + (hstart : tape.cells 0 = Γ.start) + (position : Fin (bound + 1)) : + Structured.Basic.execList (writeOps n bound slot write) store + (cellBase n bound slot + position.val) = + symbolCode ((tape.write write.toΓ).cells position.val) := by + have hstoreHead : store (headReg slot) = tape.head := hrepresents.1 + have hstoreCell := hrepresents.2 position + have hreg : cellBase n bound slot + position.val < registerCount n bound := by + rw [cellBase_add_eq_fieldReg_internal] + exact fieldReg_lt_internal _ + rw [writeOps_apply n bound slot write store + (configReg_ne_address hreg) (configReg_ne_value hreg)] + rw [hstoreHead] + by_cases hheadZero : tape.head = 0 + · rw [Tape.write, if_pos hheadZero] + by_cases hpositionZero : position.val = 0 + · rw [hheadZero, hpositionZero, Nat.add_zero, Function.update_self, hstart] + · have htarget : + cellBase n bound slot + position.val ≠ cellBase n bound slot + tape.head := by + omega + have hbase : + cellBase n bound slot + position.val ≠ cellBase n bound slot := by + omega + rw [Function.update_of_ne hbase, Function.update_of_ne htarget, hstoreCell] + · rw [Tape.write, if_neg hheadZero] + change Function.update + (Function.update store (cellBase n bound slot + tape.head) (writeCode write)) + (cellBase n bound slot) (symbolCode Γ.start) + (cellBase n bound slot + position.val) = + symbolCode (Function.update tape.cells tape.head write.toΓ position.val) + by_cases hpositionHead : position.val = tape.head + · have hpositionZero : position.val ≠ 0 := by omega + have hbase : + cellBase n bound slot + position.val ≠ cellBase n bound slot := by + omega + rw [Function.update_of_ne hbase] + have htarget : + cellBase n bound slot + position.val = cellBase n bound slot + tape.head := by + omega + rw [htarget, Function.update_self, hpositionHead, Function.update_self] + rfl + · by_cases hpositionZero : position.val = 0 + · rw [hpositionZero, Nat.add_zero, Function.update_self, + Function.update_of_ne (Ne.symm hheadZero), hstart] + · have htarget : + cellBase n bound slot + position.val ≠ cellBase n bound slot + tape.head := by + omega + have hbase : + cellBase n bound slot + position.val ≠ cellBase n bound slot := by + omega + rw [Function.update_of_ne hbase, Function.update_of_ne htarget, + Function.update_of_ne hpositionHead, hstoreCell] + +private theorem writeOps_tape (n bound : ℕ) (slot : Fin (n + 2)) + (write : Γw) (tape : Tape) (store : Structured.Store) + (hrepresents : RepresentsTape bound slot tape store) + (hstart : tape.cells 0 = Γ.start) : + RepresentsTape bound slot (tape.write write.toΓ) + (Structured.Basic.execList (writeOps n bound slot write) store) := by + constructor + · rw [Tape.write_head] + exact (writeOps_head n bound slot write store).trans + hrepresents.1 + · exact writeOps_cells n bound slot write tape store hrepresents hstart + +private theorem moveOps_apply_of_ne (n bound : ℕ) (slot : Fin (n + 2)) + (direction : Dir3) (store : Structured.Store) {reg : ℕ} + (hne : reg ≠ headReg slot) : + Structured.Basic.execList (moveOps n bound slot direction) store reg = store reg := by + cases direction <;> + simp [moveOps, Structured.Basic.execList, Structured.Basic.exec, + Function.update_of_ne hne] + +private theorem moveOps_tape (n bound : ℕ) (slot : Fin (n + 2)) + (direction : Dir3) (tape : Tape) (store : Structured.Store) + (hrepresents : RepresentsTape bound slot tape store) + (hone : store (oneReg n bound) = 1) : + RepresentsTape bound slot (tape.move direction) + (Structured.Basic.execList (moveOps n bound slot direction) store) := by + constructor + · cases direction <;> + simp [moveOps, Structured.Basic.execList, Structured.Basic.exec, Tape.move, + hrepresents.1, hone] + · intro position + rw [moveOps_apply_of_ne n bound slot direction store + (headReg_ne_cellReg slot slot position).symm] + rw [Tape.move_cells] + exact hrepresents.2 position + +private theorem writeOps_one (n bound : ℕ) (slot : Fin (n + 2)) + (write : Γw) (store : Structured.Store) + (hhead : store (headReg slot) ≤ bound) : + Structured.Basic.execList (writeOps n bound slot write) store + (oneReg n bound) = store (oneReg n bound) := by + have honeAddress : oneReg n bound ≠ addressReg n bound := by + simp [oneReg, addressReg] + have honeValue : oneReg n bound ≠ valueReg n bound := by + simp [oneReg, valueReg] + have honeBase : oneReg n bound ≠ cellBase n bound slot := by + intro heq + have hcell := fieldReg_lt_internal + (cellField slot (⟨0, by omega⟩ : Fin (bound + 1))) + rw [← cellBase_add_eq_fieldReg_internal] at hcell + simp only [Nat.add_zero] at hcell + have hone := oneReg_ge_internal n bound + omega + let position : Fin (bound + 1) := ⟨store (headReg slot), by omega⟩ + have htargetLt : + cellBase n bound slot + store (headReg slot) < registerCount n bound := by + change cellBase n bound slot + position.val < registerCount n bound + rw [cellBase_add_eq_fieldReg_internal] + exact fieldReg_lt_internal _ + have honeTarget : + oneReg n bound ≠ cellBase n bound slot + store (headReg slot) := by + intro heq + have hone := oneReg_ge_internal n bound + omega + rw [writeOps_apply n bound slot write store honeAddress honeValue, + Function.update_of_ne honeBase, Function.update_of_ne honeTarget] + +private theorem writeMoveOps_tape_internal (n bound : ℕ) (slot : Fin (n + 2)) + (write : Γw) (direction : Dir3) (tape : Tape) (store : Structured.Store) + (hrepresents : RepresentsTape bound slot tape store) + (hhead : tape.head ≤ bound) (hstart : tape.cells 0 = Γ.start) + (hone : store (oneReg n bound) = 1) : + RepresentsTape bound slot (tape.writeAndMove write.toΓ direction) + (Structured.Basic.execList (writeMoveOps n bound slot write direction) store) := by + let written := Structured.Basic.execList (writeOps n bound slot write) store + have hwritten := writeOps_tape n bound slot write tape store hrepresents hstart + have honeWritten : written (oneReg n bound) = 1 := by + exact (writeOps_one n bound slot write store (hrepresents.1 ▸ hhead)).trans hone + rw [writeMoveOps, execList_append] + exact moveOps_tape n bound slot direction (tape.write write.toΓ) written + hwritten honeWritten + +private theorem headReg_ne_headReg_of_slot_ne {first second : Fin (n + 2)} + (hne : first ≠ second) : headReg first ≠ headReg second := by + intro heq + apply hne + apply Fin.ext + simp [headReg] at heq + omega + +theorem writeMoveOps_one_internal (n bound : ℕ) (slot : Fin (n + 2)) + (write : Γw) (direction : Dir3) (store : Structured.Store) + (hhead : store (headReg slot) ≤ bound) : + Structured.Basic.execList (writeMoveOps n bound slot write direction) store + (oneReg n bound) = store (oneReg n bound) := by + let written := Structured.Basic.execList (writeOps n bound slot write) store + have honeWritten : written (oneReg n bound) = store (oneReg n bound) := by + change Structured.Basic.execList (writeOps n bound slot write) store + (oneReg n bound) = store (oneReg n bound) + exact writeOps_one n bound slot write store hhead + have honeHead : oneReg n bound ≠ headReg slot := by + intro heq + have hheadReg := fieldReg_lt_internal (headField (bound := bound) slot) + rw [← headReg_eq_fieldReg_internal] at hheadReg + have hone := oneReg_ge_internal n bound + omega + rw [writeMoveOps, execList_append, + moveOps_apply_of_ne n bound slot direction written honeHead, honeWritten] + +private theorem writeMoveOps_otherTape_internal (n bound : ℕ) + {slot other : Fin (n + 2)} (hne : slot ≠ other) + (write : Γw) (direction : Dir3) (otherTape : Tape) + (store : Structured.Store) + (hother : RepresentsTape bound other otherTape store) + (hhead : store (headReg slot) ≤ bound) : + RepresentsTape bound other otherTape + (Structured.Basic.execList (writeMoveOps n bound slot write direction) store) := by + let written := Structured.Basic.execList (writeOps n bound slot write) store + let selectedPosition : Fin (bound + 1) := + ⟨store (headReg slot), by omega⟩ + have hotherHeadReg : headReg other < registerCount n bound := by + rw [headReg_eq_fieldReg_internal] + exact fieldReg_lt_internal _ + have hwriteHead : written (headReg other) = store (headReg other) := by + change Structured.Basic.execList (writeOps n bound slot write) store + (headReg other) = store (headReg other) + rw [writeOps_apply n bound slot write store + (configReg_ne_address hotherHeadReg) (configReg_ne_value hotherHeadReg)] + have hbase : headReg other ≠ cellBase n bound slot := by + simpa using + (headReg_ne_cellReg other slot (⟨0, by omega⟩ : Fin (bound + 1))) + have htarget : + headReg other ≠ cellBase n bound slot + store (headReg slot) := by + simpa [selectedPosition] using + (headReg_ne_cellReg other slot selectedPosition) + rw [Function.update_of_ne hbase, Function.update_of_ne htarget] + have hmoveHead : + Structured.Basic.execList (moveOps n bound slot direction) written + (headReg other) = written (headReg other) := + moveOps_apply_of_ne n bound slot direction written + (headReg_ne_headReg_of_slot_ne (Ne.symm hne)) + constructor + · rw [writeMoveOps, execList_append, hmoveHead, hwriteHead] + exact hother.1 + · intro position + have hotherCellReg : + cellBase n bound other + position.val < registerCount n bound := by + rw [cellBase_add_eq_fieldReg_internal] + exact fieldReg_lt_internal _ + have hwriteCell : + written (cellBase n bound other + position.val) = + store (cellBase n bound other + position.val) := by + change Structured.Basic.execList (writeOps n bound slot write) store + (cellBase n bound other + position.val) = + store (cellBase n bound other + position.val) + rw [writeOps_apply n bound slot write store + (configReg_ne_address hotherCellReg) (configReg_ne_value hotherCellReg)] + have hbase : + cellBase n bound other + position.val ≠ cellBase n bound slot := by + simpa using + (cellReg_ne_cellReg_of_slot_ne (Ne.symm hne) position + (⟨0, by omega⟩ : Fin (bound + 1))) + have htarget : + cellBase n bound other + position.val ≠ + cellBase n bound slot + store (headReg slot) := by + simpa [selectedPosition] using + (cellReg_ne_cellReg_of_slot_ne (Ne.symm hne) position selectedPosition) + rw [Function.update_of_ne hbase, Function.update_of_ne htarget] + have hmoveCell : + Structured.Basic.execList (moveOps n bound slot direction) written + (cellBase n bound other + position.val) = + written (cellBase n bound other + position.val) := + moveOps_apply_of_ne n bound slot direction written + (headReg_ne_cellReg slot other position).symm + rw [writeMoveOps, execList_append, hmoveCell, hwriteCell] + exact hother.2 position + +private theorem RepresentsTape.stateUpdate (bound : ℕ) (slot : Fin (n + 2)) + (tape : Tape) (store : Structured.Store) (state : ℕ) + (hrepresents : RepresentsTape bound slot tape store) : + RepresentsTape bound slot tape + ((Structured.Basic.imm 0 state).exec store) := by + constructor + · simpa [Structured.Basic.exec, headReg, Function.update_of_ne] using + hrepresents.1 + · intro position + simpa [Structured.Basic.exec, cellBase, Function.update_of_ne] using + hrepresents.2 position + +private theorem moveOps_one (n bound : ℕ) (slot : Fin (n + 2)) + (direction : Dir3) (store : Structured.Store) : + Structured.Basic.execList (moveOps n bound slot direction) store + (oneReg n bound) = store (oneReg n bound) := by + apply moveOps_apply_of_ne + intro heq + have hhead := fieldReg_lt_internal (headField (bound := bound) slot) + rw [← headReg_eq_fieldReg_internal] at hhead + have hone := oneReg_ge_internal n bound + omega + +private theorem moveOps_zero (n bound : ℕ) (slot : Fin (n + 2)) + (direction : Dir3) (store : Structured.Store) : + Structured.Basic.execList (moveOps n bound slot direction) store 0 = store 0 := by + apply moveOps_apply_of_ne + simp [headReg] + omega + +private theorem moveOps_otherTape (n bound : ℕ) + {slot other : Fin (n + 2)} (hne : slot ≠ other) + (direction : Dir3) (otherTape : Tape) (store : Structured.Store) + (hother : RepresentsTape bound other otherTape store) : + RepresentsTape bound other otherTape + (Structured.Basic.execList (moveOps n bound slot direction) store) := by + constructor + · rw [moveOps_apply_of_ne n bound slot direction store + (headReg_ne_headReg_of_slot_ne (Ne.symm hne))] + exact hother.1 + · intro position + rw [moveOps_apply_of_ne n bound slot direction store + (headReg_ne_cellReg slot other position).symm] + exact hother.2 position + +private theorem writeMoveOps_zero (n bound : ℕ) (slot : Fin (n + 2)) + (write : Γw) (direction : Dir3) (store : Structured.Store) : + Structured.Basic.execList (writeMoveOps n bound slot write direction) store 0 = + store 0 := by + let written := Structured.Basic.execList (writeOps n bound slot write) store + have hzeroAddress : 0 ≠ addressReg n bound := by + simp [addressReg, scratchBase, registerCount] + have hzeroValue : 0 ≠ valueReg n bound := by + simp [valueReg, scratchBase, registerCount] + have hzeroWritten : written 0 = store 0 := by + change Structured.Basic.execList (writeOps n bound slot write) store 0 = store 0 + rw [writeOps_apply n bound slot write store hzeroAddress hzeroValue] + have hbase : 0 ≠ cellBase n bound slot := by + simp [cellBase] + omega + have htarget : 0 ≠ cellBase n bound slot + store (headReg slot) := by + simp [cellBase] + omega + rw [Function.update_of_ne hbase, Function.update_of_ne htarget] + rw [writeMoveOps, execList_append, + moveOps_zero n bound slot direction written, hzeroWritten] + +private theorem workTape_injective (n : ℕ) : + Function.Injective (workTape : Fin n → Fin (n + 2)) := by + intro first second heq + apply Fin.ext + simpa [workTape] using congrArg Fin.val heq + +private theorem inputTape_ne_workTape (n : ℕ) (i : Fin n) : + inputTape n ≠ workTape i := by + intro heq + have := congrArg Fin.val heq + simp [inputTape, workTape] at this + +private theorem outputTape_ne_workTape (n : ℕ) (i : Fin n) : + outputTape n ≠ workTape i := by + intro heq + have hi := i.isLt + have := congrArg Fin.val heq + simp [outputTape, workTape] at this + omega + +private theorem inputTape_ne_outputTape (n : ℕ) : + inputTape n ≠ outputTape n := by + intro heq + have := congrArg Fin.val heq + simp [inputTape, outputTape] at this + +/-- Reassemble the fieldwise configuration representation from the state and +the three kinds of named tape blocks. -/ +private theorem represents_of_named_tapes {tm : TM n} {bound : ℕ} + {cfg : Complexity.Cfg n tm.Q} {store : Structured.Store} + (hstate : store 0 = stateCode tm cfg.state) + (hinput : RepresentsTape bound (inputTape n) cfg.input store) + (hwork : ∀ i, RepresentsTape bound (workTape i) (cfg.work i) store) + (houtput : RepresentsTape bound (outputTape n) cfg.output store) : + Represents tm bound cfg store := by + intro field + rcases field with state | headOrCell + · rcases state with ⟨state, hstateFin⟩ + have hzero : state = 0 := by omega + subst state + simpa [fieldReg_state_internal, fieldValue] using hstate + · rcases headOrCell with head | cell + · change store (headReg head) = (tapeAt cfg head).head + by_cases hinputSlot : head = inputTape n + · subst head + rw [hinput.1] + simpa [inputTape] using + congrArg Tape.head (tapeAt_input_internal cfg).symm + · by_cases houtputSlot : head = outputTape n + · subst head + rw [houtput.1] + simpa [outputTape] using + congrArg Tape.head (tapeAt_output_internal cfg).symm + · let i : Fin n := ⟨head.val - 1, by + have hpositive : 0 < head.val := by + have hnezero : head.val ≠ 0 := by + intro hzero + apply hinputSlot + apply Fin.ext + simpa [inputTape] using hzero + omega + have hnotOutput : head.val ≠ n + 1 := by + intro heq + apply houtputSlot + apply Fin.ext + simpa [outputTape] using heq + omega⟩ + have hhead : head = workTape i := by + apply Fin.ext + simp [i, workTape] + have hpositive : 0 < head.val := by + have hnezero : head.val ≠ 0 := by + intro hzero + apply hinputSlot + apply Fin.ext + simpa [inputTape] using hzero + omega + omega + rw [hhead, (hwork i).1] + simpa [workTape] using + congrArg Tape.head (tapeAt_work_internal cfg i).symm + · rcases cell with ⟨tape, position⟩ + simp only [fieldValue] + change store (fieldReg (cellField tape position)) = + symbolCode ((tapeAt cfg tape).cells position.val) + rw [← cellBase_add_eq_fieldReg_internal] + by_cases hinputSlot : tape = inputTape n + · subst tape + rw [hinput.2 position] + simpa [inputTape] using congrArg (fun t => symbolCode (t.cells position.val)) + (tapeAt_input_internal cfg).symm + · by_cases houtputSlot : tape = outputTape n + · subst tape + rw [houtput.2 position] + simpa [outputTape] using congrArg (fun t => symbolCode (t.cells position.val)) + (tapeAt_output_internal cfg).symm + · let i : Fin n := ⟨tape.val - 1, by + have hpositive : 0 < tape.val := by + have hnezero : tape.val ≠ 0 := by + intro hzero + apply hinputSlot + apply Fin.ext + simpa [inputTape] using hzero + omega + have hnotOutput : tape.val ≠ n + 1 := by + intro heq + apply houtputSlot + apply Fin.ext + simpa [outputTape] using heq + omega⟩ + have htape : tape = workTape i := by + apply Fin.ext + simp [i, workTape] + have hpositive : 0 < tape.val := by + have hnezero : tape.val ≠ 0 := by + intro hzero + apply hinputSlot + apply Fin.ext + simpa [inputTape] using hzero + omega + omega + rw [htape, (hwork i).2 position] + simpa [workTape] using congrArg (fun t => symbolCode (t.cells position.val)) + (tapeAt_work_internal cfg i).symm + +/-- Invariant after updating a prefix of the work tapes for one selected +transition. -/ +private structure WorkPrefix (tm : TM n) (bound : ℕ) + (cfg : Complexity.Cfg n tm.Q) (nextState : tm.Q) + (inputDirection : Dir3) (workWrites : Fin n → Γw) + (workDirections : Fin n → Dir3) (processed : List (Fin n)) + (store : Structured.Store) : Prop where + state : store 0 = stateCode tm nextState + one : store (oneReg n bound) = 1 + input : RepresentsTape bound (inputTape n) + (cfg.input.move inputDirection) store + work : ∀ i, RepresentsTape bound (workTape i) + (if i ∈ processed then + (cfg.work i).writeAndMove (workWrites i).toΓ (workDirections i) + else cfg.work i) store + output : RepresentsTape bound (outputTape n) cfg.output store + +private theorem actionPrelude_workPrefix {tm : TM n} {bound : ℕ} + {cfg : Complexity.Cfg n tm.Q} {store : Structured.Store} + (nextState : tm.Q) (inputDirection : Dir3) + (workWrites : Fin n → Γw) (workDirections : Fin n → Dir3) + (hrepresents : Represents tm bound cfg store) + (hone : store (oneReg n bound) = 1) : + let initialized := (Structured.Basic.imm 0 (stateCode tm nextState)).exec store + let final := Structured.Basic.execList + (moveOps n bound (inputTape n) inputDirection) initialized + WorkPrefix tm bound cfg nextState inputDirection workWrites workDirections [] final := by + let initialized := (Structured.Basic.imm 0 (stateCode tm nextState)).exec store + let final := Structured.Basic.execList + (moveOps n bound (inputTape n) inputDirection) initialized + have honeReg : oneReg n bound ≠ 0 := by + simp [oneReg, scratchBase, registerCount] + have honeInitialized : initialized (oneReg n bound) = 1 := by + simpa [initialized, Structured.Basic.exec, + Function.update_of_ne honeReg] using hone + have hinputStore : RepresentsTape bound (inputTape n) cfg.input store := by + have htape := Represents.tape hrepresents (inputTape n) + simpa [inputTape] using htape + have hinputInitialized : + RepresentsTape bound (inputTape n) cfg.input initialized := + hinputStore.stateUpdate bound (inputTape n) cfg.input store + (stateCode tm nextState) + have hworkInitialized : ∀ i, + RepresentsTape bound (workTape i) (cfg.work i) initialized := by + intro i + have htape := Represents.tape hrepresents (workTape i) + have hnamed : RepresentsTape bound (workTape i) (cfg.work i) store := by + rw [show tapeAt cfg (workTape i) = cfg.work i by + simpa [workTape] using tapeAt_work_internal cfg i] at htape + exact htape + exact hnamed.stateUpdate bound (workTape i) (cfg.work i) store + (stateCode tm nextState) + have houtputStore : RepresentsTape bound (outputTape n) cfg.output store := by + have htape := Represents.tape hrepresents (outputTape n) + rw [show tapeAt cfg (outputTape n) = cfg.output by + simpa [outputTape] using tapeAt_output_internal cfg] at htape + exact htape + have houtputInitialized : + RepresentsTape bound (outputTape n) cfg.output initialized := + houtputStore.stateUpdate bound (outputTape n) cfg.output store + (stateCode tm nextState) + refine ⟨?_, ?_, ?_, ?_, ?_⟩ + · rw [moveOps_zero n bound (inputTape n) inputDirection initialized] + simp [initialized, Structured.Basic.exec] + · exact (moveOps_one n bound (inputTape n) inputDirection initialized).trans + honeInitialized + · exact moveOps_tape n bound (inputTape n) inputDirection cfg.input initialized + hinputInitialized honeInitialized + · intro i + simpa using moveOps_otherTape n bound + (inputTape_ne_workTape n i) inputDirection (cfg.work i) initialized + (hworkInitialized i) + · exact moveOps_otherTape n bound (inputTape_ne_outputTape n) inputDirection + cfg.output initialized houtputInitialized + +private theorem workPrefix_step {tm : TM n} {bound : ℕ} + {cfg : Complexity.Cfg n tm.Q} {nextState : tm.Q} + {inputDirection : Dir3} {workWrites : Fin n → Γw} + {workDirections : Fin n → Dir3} {processed : List (Fin n)} + {store : Structured.Store} + (hprefix : WorkPrefix tm bound cfg nextState inputDirection + workWrites workDirections processed store) + (i : Fin n) (hfresh : i ∉ processed) + (hhead : (cfg.work i).head ≤ bound) + (hstart : (cfg.work i).cells 0 = Γ.start) : + WorkPrefix tm bound cfg nextState inputDirection workWrites workDirections + (i :: processed) + (Structured.Basic.execList + (writeMoveOps n bound (workTape i) (workWrites i) (workDirections i)) store) := by + have hselected : RepresentsTape bound (workTape i) (cfg.work i) store := by + simpa [hfresh] using hprefix.work i + refine ⟨?_, ?_, ?_, ?_, ?_⟩ + · exact (writeMoveOps_zero n bound (workTape i) (workWrites i) + (workDirections i) store).trans hprefix.state + · exact (writeMoveOps_one_internal n bound (workTape i) (workWrites i) + (workDirections i) store (hselected.1 ▸ hhead)).trans hprefix.one + · exact writeMoveOps_otherTape_internal n bound + (Ne.symm (inputTape_ne_workTape n i)) (workWrites i) (workDirections i) + (cfg.input.move inputDirection) store hprefix.input (hselected.1 ▸ hhead) + · intro j + by_cases hji : j = i + · subst j + simpa using writeMoveOps_tape_internal n bound (workTape i) + (workWrites i) (workDirections i) (cfg.work i) store hselected hhead + hstart hprefix.one + · have hslots : workTape i ≠ workTape j := by + exact fun heq => hji ((workTape_injective n) heq).symm + simpa [hji] using writeMoveOps_otherTape_internal n bound hslots + (workWrites i) (workDirections i) + (if j ∈ processed then + (cfg.work j).writeAndMove (workWrites j).toΓ (workDirections j) + else cfg.work j) store (hprefix.work j) (hselected.1 ▸ hhead) + · exact writeMoveOps_otherTape_internal n bound + (outputTape_ne_workTape n i).symm (workWrites i) (workDirections i) + cfg.output store hprefix.output (hselected.1 ▸ hhead) + +private theorem workPrefix_list {tm : TM n} {bound : ℕ} + {cfg : Complexity.Cfg n tm.Q} {nextState : tm.Q} + {inputDirection : Dir3} {workWrites : Fin n → Γw} + {workDirections : Fin n → Dir3} + (items processed : List (Fin n)) {store : Structured.Store} + (hprefix : WorkPrefix tm bound cfg nextState inputDirection + workWrites workDirections processed store) + (hfresh : ∀ i, i ∈ items → i ∉ processed) + (hnodup : items.Nodup) + (hheads : ∀ i, (cfg.work i).head ≤ bound) + (hstarts : ∀ i, (cfg.work i).cells 0 = Γ.start) : + WorkPrefix tm bound cfg nextState inputDirection workWrites workDirections + (items.reverse ++ processed) + (Structured.Basic.execList + (items.flatMap (fun i => writeMoveOps n bound (workTape i) + (workWrites i) (workDirections i))) store) := by + induction items generalizing processed store with + | nil => simpa using hprefix + | cons i rest ih => + have hinot : i ∉ processed := hfresh i (by simp) + have hnext := workPrefix_step hprefix i hinot (hheads i) (hstarts i) + have hrestFresh : ∀ j, j ∈ rest → j ∉ i :: processed := by + intro j hj hmem + rcases List.mem_cons.mp hmem with heq | hprocessed + · subst j + exact (List.nodup_cons.mp hnodup).1 hj + · exact hfresh j (by simp [hj]) hprocessed + have hfinal := ih (processed := i :: processed) hnext hrestFresh + (List.nodup_cons.mp hnodup).2 + simpa [List.flatMap_cons, execList_append, List.reverse_cons, + List.append_assoc] using hfinal + +theorem actionOps_represents_internal {tm : TM n} {bound : ℕ} + {cfg next : Complexity.Cfg n tm.Q} {store : Structured.Store} + (hstep : tm.step cfg = some next) + (hrepresents : Represents tm bound cfg store) + (hheads : HeadsBounded cfg bound) + (hworkStart : ∀ i, (cfg.work i).cells 0 = Γ.start) + (houtputStart : cfg.output.cells 0 = Γ.start) + (hone : store (oneReg n bound) = 1) : + Represents tm bound next + (Structured.Basic.execList + (actionOps tm bound cfg.state (readSymbols cfg)) store) := by + have hnotHalted := TM.state_ne_qhalt_of_step hstep + rcases hdelta : tm.δ cfg.state cfg.input.read + (fun i => (cfg.work i).read) cfg.output.read with + ⟨nextState, workWrites, outputWrite, inputDirection, + workDirections, outputDirection⟩ + rw [TM.step, if_neg hnotHalted, hdelta] at hstep + dsimp only at hstep + injection hstep with hnext + subst next + have hreadInput : + readSymbols cfg (inputTape n) = cfg.input.read := by + simpa [readSymbols, inputTape] using + congrArg Tape.read (tapeAt_input_internal cfg) + have hreadWork : + (fun i => readSymbols cfg (workTape i)) = + (fun i => (cfg.work i).read) := by + funext i + simpa [readSymbols, workTape] using + congrArg Tape.read (tapeAt_work_internal cfg i) + have hreadOutput : + readSymbols cfg (outputTape n) = cfg.output.read := by + simpa [readSymbols, outputTape] using + congrArg Tape.read (tapeAt_output_internal cfg) + let initialized := + (Structured.Basic.imm 0 (stateCode tm nextState)).exec store + let afterInput := Structured.Basic.execList + (moveOps n bound (inputTape n) inputDirection) initialized + have hprefix : WorkPrefix tm bound cfg nextState inputDirection + workWrites workDirections [] afterInput := by + exact actionPrelude_workPrefix nextState inputDirection workWrites + workDirections hrepresents hone + have hworkHeads : ∀ i, (cfg.work i).head ≤ bound := by + intro i + have hhead := hheads (workTape i) + rw [show tapeAt cfg (workTape i) = cfg.work i by + simpa [workTape] using tapeAt_work_internal cfg i] at hhead + exact hhead + let afterWork := Structured.Basic.execList + ((List.finRange n).flatMap (fun i => + writeMoveOps n bound (workTape i) (workWrites i) (workDirections i))) + afterInput + have hworkPrefix : WorkPrefix tm bound cfg nextState inputDirection + workWrites workDirections ((List.finRange n).reverse ++ []) afterWork := by + exact workPrefix_list (List.finRange n) [] hprefix (by simp) + (List.nodup_finRange n) hworkHeads hworkStart + have hworkFinal : ∀ i, + RepresentsTape bound (workTape i) + ((cfg.work i).writeAndMove (workWrites i).toΓ (workDirections i)) + afterWork := by + intro i + simpa using hworkPrefix.work i + have houtputHead : cfg.output.head ≤ bound := by + have hhead := hheads (outputTape n) + rw [show tapeAt cfg (outputTape n) = cfg.output by + simpa [outputTape] using tapeAt_output_internal cfg] at hhead + exact hhead + let final := Structured.Basic.execList + (writeMoveOps n bound (outputTape n) outputWrite outputDirection) afterWork + have hstateFinal : final 0 = stateCode tm nextState := by + exact (writeMoveOps_zero n bound (outputTape n) outputWrite outputDirection + afterWork).trans hworkPrefix.state + have honeFinal : final (oneReg n bound) = 1 := by + exact (writeMoveOps_one_internal n bound (outputTape n) outputWrite + outputDirection afterWork (hworkPrefix.output.1 ▸ houtputHead)).trans + hworkPrefix.one + have hinputFinal : RepresentsTape bound (inputTape n) + (cfg.input.move inputDirection) final := by + exact writeMoveOps_otherTape_internal n bound + (inputTape_ne_outputTape n).symm outputWrite outputDirection + (cfg.input.move inputDirection) afterWork hworkPrefix.input + (hworkPrefix.output.1 ▸ houtputHead) + have hworkFinal' : ∀ i, RepresentsTape bound (workTape i) + ((cfg.work i).writeAndMove (workWrites i).toΓ (workDirections i)) final := by + intro i + exact writeMoveOps_otherTape_internal n bound + (outputTape_ne_workTape n i) outputWrite outputDirection + ((cfg.work i).writeAndMove (workWrites i).toΓ (workDirections i)) + afterWork (hworkFinal i) (hworkPrefix.output.1 ▸ houtputHead) + have houtputFinal : RepresentsTape bound (outputTape n) + (cfg.output.writeAndMove outputWrite.toΓ outputDirection) final := by + exact writeMoveOps_tape_internal n bound (outputTape n) outputWrite + outputDirection cfg.output afterWork hworkPrefix.output houtputHead + houtputStart hworkPrefix.one + have hfinalRepresents : + Represents tm bound + { state := nextState + input := cfg.input.move inputDirection + work := fun i => + (cfg.work i).writeAndMove (workWrites i).toΓ (workDirections i) + output := cfg.output.writeAndMove outputWrite.toΓ outputDirection } + final := by + exact represents_of_named_tapes hstateFinal hinputFinal hworkFinal' + houtputFinal + simpa [actionOps, hreadInput, hreadWork, hreadOutput, hdelta, + initialized, afterInput, afterWork, final, execList_append, + Structured.Basic.execList, List.append_assoc] using + hfinalRepresents + +private abbrev StepEnvelope (tm : TM n) (bound : ℕ) := + Structured.Internal.StoreEnvelope (registerLimit n bound) (wordBound tm bound) + +private abbrev StepEnvelopeChain (tm : TM n) (bound : ℕ) := + Structured.Internal.Basic.EnvelopeChain (registerLimit n bound) (wordBound tm bound) + +private theorem registerCount_lt_registerLimit' (n bound : ℕ) : + registerCount n bound < registerLimit n bound := by + simp [registerLimit, scratchBase] + omega + +private theorem registerLimit_le_wordBound' (tm : TM n) (bound : ℕ) : + registerLimit n bound ≤ wordBound tm bound := + le_max_left _ _ + +private theorem headReg_lt_registerLimit (n bound : ℕ) + (tape : Fin (n + 2)) : headReg tape < registerLimit n bound := by + have hhead := fieldReg_lt_internal (headField (bound := bound) tape) + rw [← headReg_eq_fieldReg_internal] at hhead + exact lt_trans hhead (registerCount_lt_registerLimit' n bound) + +private theorem cellBase_lt_registerLimit (n bound : ℕ) + (tape : Fin (n + 2)) : cellBase n bound tape < registerLimit n bound := by + have hcell := fieldReg_lt_internal + (cellField tape (⟨0, by omega⟩ : Fin (bound + 1))) + rw [← cellBase_add_eq_fieldReg_internal] at hcell + simpa using lt_trans hcell (registerCount_lt_registerLimit' n bound) + +private theorem smallValue_le_wordBound (tm : TM n) (bound value : ℕ) + (hvalue : value ≤ 3) : value ≤ wordBound tm bound := by + have hthree : 3 ≤ registerLimit n bound := by + simp [registerLimit, scratchBase, registerCount] + exact le_trans hvalue (le_trans hthree (registerLimit_le_wordBound' tm bound)) + +private theorem moveOps_envelopeChain (tm : TM n) (bound : ℕ) + (tape : Fin (n + 2)) (direction : Dir3) (store : Structured.Store) + (henvelope : StepEnvelope tm bound store) + (hhead : store (headReg tape) ≤ bound) + (hone : store (oneReg n bound) = 1) : + StepEnvelopeChain tm bound (moveOps n bound tape direction) store := by + have hindex := headReg_lt_registerLimit n bound tape + have hbound : bound + 1 ≤ wordBound tm bound := by + exact le_trans (le_max_right _ _) + (le_max_right (registerLimit n bound) _) + cases direction with + | stay => exact henvelope + | left => + have hfinal : StepEnvelope tm bound + ((Structured.Basic.sub (headReg tape) (headReg tape) + (oneReg n bound)).exec store) := by + apply henvelope.execBasic + · exact hindex + · simp only [Structured.Internal.Basic.writeValue] + omega + exact ⟨henvelope, hfinal⟩ + | right => + have hfinal : StepEnvelope tm bound + ((Structured.Basic.add (headReg tape) (headReg tape) + (oneReg n bound)).exec store) := by + apply henvelope.execBasic + · exact hindex + · simp only [Structured.Internal.Basic.writeValue] + rw [hone] + omega + exact ⟨henvelope, hfinal⟩ + +private theorem writeOps_envelopeChain (tm : TM n) (bound : ℕ) + (tape : Fin (n + 2)) (write : Γw) (store : Structured.Store) + (henvelope : StepEnvelope tm bound store) + (hhead : store (headReg tape) ≤ bound) : + StepEnvelopeChain tm bound (writeOps n bound tape write) store := by + let first := + (Structured.Basic.imm (addressReg n bound) (cellBase n bound tape)).exec store + let addressed := + (Structured.Basic.add (addressReg n bound) (addressReg n bound) + (headReg tape)).exec first + let valued := (Structured.Basic.imm (valueReg n bound) (writeCode write)).exec addressed + let stored := (Structured.Basic.store (addressReg n bound) + (valueReg n bound)).exec valued + let final := + (Structured.Basic.imm (cellBase n bound tape) (symbolCode Γ.start)).exec stored + have hscratch := scratch_lt_registerLimit_internal n bound + have hbaseLt := cellBase_lt_registerLimit n bound tape + have hbaseBound : cellBase n bound tape ≤ wordBound tm bound := + le_trans (Nat.le_of_lt hbaseLt) (registerLimit_le_wordBound' tm bound) + have hfirst : StepEnvelope tm bound first := by + apply henvelope.execBasic + · exact hscratch.2.2.2.1 + · simpa [Structured.Internal.Basic.writeValue] using hbaseBound + have haddressHead : addressReg n bound ≠ headReg tape := by + intro heq + have haddress := addressReg_ge_internal n bound + have hheadReg := fieldReg_lt_internal (headField (bound := bound) tape) + rw [← headReg_eq_fieldReg_internal] at hheadReg + omega + have hfirstAddress : first (addressReg n bound) = cellBase n bound tape := by + simp [first, Structured.Basic.exec] + have hfirstHead : first (headReg tape) = store (headReg tape) := by + simp [first, Structured.Basic.exec, Function.update_of_ne (Ne.symm haddressHead)] + let position : Fin (bound + 1) := ⟨store (headReg tape), by omega⟩ + have htargetLt : + cellBase n bound tape + store (headReg tape) < registerCount n bound := by + change cellBase n bound tape + position.val < registerCount n bound + rw [cellBase_add_eq_fieldReg_internal] + exact fieldReg_lt_internal _ + have htargetBound : + cellBase n bound tape + store (headReg tape) ≤ wordBound tm bound := by + exact le_trans (Nat.le_of_lt htargetLt) + (le_trans (Nat.le_of_lt (registerCount_lt_registerLimit' n bound)) + (registerLimit_le_wordBound' tm bound)) + have haddressed : StepEnvelope tm bound addressed := by + apply hfirst.execBasic + · exact hscratch.2.2.2.1 + · simp only [Structured.Internal.Basic.writeValue] + rw [hfirstAddress, hfirstHead] + exact htargetBound + have hwriteBound : writeCode write ≤ wordBound tm bound := by + apply smallValue_le_wordBound tm bound + cases write <;> decide + have hvalued : StepEnvelope tm bound valued := by + apply haddressed.execBasic + · exact hscratch.2.2.2.2.1 + · simpa [Structured.Internal.Basic.writeValue] using hwriteBound + have hvaluedAddress : + valued (addressReg n bound) = + cellBase n bound tape + store (headReg tape) := by + simp only [valued, Structured.Basic.exec] + rw [Function.update_of_ne] + · simp [addressed, Structured.Basic.exec, hfirstAddress, hfirstHead] + · simp [addressReg, valueReg] + have hvaluedValue : valued (valueReg n bound) = writeCode write := by + simp [valued, Structured.Basic.exec] + have hstored : StepEnvelope tm bound stored := by + apply hvalued.execBasic + · simp only [Structured.Internal.Basic.writeIndex] + rw [hvaluedAddress] + exact lt_trans htargetLt (registerCount_lt_registerLimit' n bound) + · simp only [Structured.Internal.Basic.writeValue] + rw [hvaluedValue] + exact hwriteBound + have hstartBound : symbolCode Γ.start ≤ wordBound tm bound := + smallValue_le_wordBound tm bound _ (by decide) + have hfinal : StepEnvelope tm bound final := by + apply hstored.execBasic + · exact hbaseLt + · simpa [Structured.Internal.Basic.writeValue] using hstartBound + simpa [writeOps, first, addressed, valued, stored, final] using + And.intro henvelope (And.intro hfirst + (And.intro haddressed (And.intro hvalued (And.intro hstored hfinal)))) + +private theorem writeMoveOps_envelopeChain (tm : TM n) (bound : ℕ) + (tape : Fin (n + 2)) (write : Γw) (direction : Dir3) + (store : Structured.Store) (henvelope : StepEnvelope tm bound store) + (hhead : store (headReg tape) ≤ bound) + (hone : store (oneReg n bound) = 1) : + StepEnvelopeChain tm bound (writeMoveOps n bound tape write direction) store := by + let written := Structured.Basic.execList (writeOps n bound tape write) store + have hwrite := writeOps_envelopeChain tm bound tape write store henvelope hhead + have hwrittenEnvelope : StepEnvelope tm bound written := hwrite.final + have hwrittenHead : written (headReg tape) ≤ bound := by + change Structured.Basic.execList (writeOps n bound tape write) store + (headReg tape) ≤ bound + rw [writeOps_head n bound tape write store] + exact hhead + have hwrittenOne : written (oneReg n bound) = 1 := by + exact (writeOps_one n bound tape write store hhead).trans hone + have hmove := moveOps_envelopeChain tm bound tape direction written + hwrittenEnvelope hwrittenHead hwrittenOne + simpa [writeMoveOps] using hwrite.append hmove + +private theorem workPrefix_list_envelope {tm : TM n} {bound : ℕ} + {cfg : Complexity.Cfg n tm.Q} {nextState : tm.Q} + {inputDirection : Dir3} {workWrites : Fin n → Γw} + {workDirections : Fin n → Dir3} + (items processed : List (Fin n)) {store : Structured.Store} + (hprefix : WorkPrefix tm bound cfg nextState inputDirection + workWrites workDirections processed store) + (henvelope : StepEnvelope tm bound store) + (hfresh : ∀ i, i ∈ items → i ∉ processed) + (hnodup : items.Nodup) + (hheads : ∀ i, (cfg.work i).head ≤ bound) + (hstarts : ∀ i, (cfg.work i).cells 0 = Γ.start) : + let ops := items.flatMap (fun i => writeMoveOps n bound (workTape i) + (workWrites i) (workDirections i)) + WorkPrefix tm bound cfg nextState inputDirection workWrites workDirections + (items.reverse ++ processed) (Structured.Basic.execList ops store) ∧ + StepEnvelopeChain tm bound ops store := by + induction items generalizing processed store with + | nil => exact ⟨by simpa using hprefix, henvelope⟩ + | cons i rest ih => + have hinot : i ∉ processed := hfresh i (by simp) + have hselected : RepresentsTape bound (workTape i) (cfg.work i) store := by + simpa [hinot] using hprefix.work i + have hblock := writeMoveOps_envelopeChain tm bound (workTape i) + (workWrites i) (workDirections i) store henvelope + (hselected.1 ▸ hheads i) hprefix.one + have hnext := workPrefix_step hprefix i hinot (hheads i) (hstarts i) + have hrestFresh : ∀ j, j ∈ rest → j ∉ i :: processed := by + intro j hj hmem + rcases List.mem_cons.mp hmem with heq | hprocessed + · subst j + exact (List.nodup_cons.mp hnodup).1 hj + · exact hfresh j (by simp [hj]) hprocessed + obtain ⟨hfinalPrefix, hrestChain⟩ := + ih (processed := i :: processed) hnext hblock.final hrestFresh + (List.nodup_cons.mp hnodup).2 + refine ⟨?_, ?_⟩ + · simpa [List.flatMap_cons, execList_append, List.reverse_cons, + List.append_assoc] using hfinalPrefix + · simpa [List.flatMap_cons] using hblock.append hrestChain + +private theorem actionOps_envelopeChain_internal {tm : TM n} {bound : ℕ} + {cfg : Complexity.Cfg n tm.Q} {store : Structured.Store} + (hrepresents : Represents tm bound cfg store) + (hheads : HeadsBounded cfg bound) + (hworkStart : ∀ i, (cfg.work i).cells 0 = Γ.start) + (hone : store (oneReg n bound) = 1) + (henvelope : Structured.Internal.StoreEnvelope + (registerLimit n bound) (wordBound tm bound) store) : + StepEnvelopeChain tm bound + (actionOps tm bound cfg.state (readSymbols cfg)) store := by + rcases hdelta : tm.δ cfg.state cfg.input.read + (fun i => (cfg.work i).read) cfg.output.read with + ⟨nextState, workWrites, outputWrite, inputDirection, + workDirections, outputDirection⟩ + have hreadInput : readSymbols cfg (inputTape n) = cfg.input.read := by + simpa [readSymbols, inputTape] using + congrArg Tape.read (tapeAt_input_internal cfg) + have hreadWork : (fun i => readSymbols cfg (workTape i)) = + (fun i => (cfg.work i).read) := by + funext i + simpa [readSymbols, workTape] using + congrArg Tape.read (tapeAt_work_internal cfg i) + have hreadOutput : readSymbols cfg (outputTape n) = cfg.output.read := by + simpa [readSymbols, outputTape] using + congrArg Tape.read (tapeAt_output_internal cfg) + let initialized := + (Structured.Basic.imm 0 (stateCode tm nextState)).exec store + have hstateBound : stateCode tm nextState ≤ wordBound tm bound := by + exact le_trans (Nat.le_of_lt (stateCode_lt_internal tm nextState)) + (le_trans (le_max_left _ _) (le_max_right _ _)) + have hinitialized : StepEnvelope tm bound initialized := by + apply henvelope.execBasic + · simp [registerLimit, scratchBase, registerCount] + · simpa [Structured.Internal.Basic.writeValue] using hstateBound + have hstateChain : StepEnvelopeChain tm bound + [.imm 0 (stateCode tm nextState)] store := ⟨henvelope, hinitialized⟩ + have hinputStore : RepresentsTape bound (inputTape n) cfg.input store := by + have htape := Represents.tape hrepresents (inputTape n) + simpa [inputTape] using htape + have hinputHead : initialized (headReg (inputTape n)) ≤ bound := by + have hhead := hheads (inputTape n) + rw [show tapeAt cfg (inputTape n) = cfg.input by + simpa [inputTape] using tapeAt_input_internal cfg] at hhead + rw [show initialized (headReg (inputTape n)) = store (headReg (inputTape n)) by + simp [initialized, Structured.Basic.exec, headReg, inputTape, + Function.update_of_ne]] + exact hinputStore.1.symm ▸ hhead + have honeInitialized : initialized (oneReg n bound) = 1 := by + rw [show initialized (oneReg n bound) = store (oneReg n bound) by + simp [initialized, Structured.Basic.exec, oneReg, scratchBase, registerCount, + Function.update_of_ne]] + exact hone + let afterInput := Structured.Basic.execList + (moveOps n bound (inputTape n) inputDirection) initialized + have hinputChain := moveOps_envelopeChain tm bound (inputTape n) + inputDirection initialized hinitialized hinputHead honeInitialized + have hprefix : WorkPrefix tm bound cfg nextState inputDirection + workWrites workDirections [] afterInput := by + exact actionPrelude_workPrefix nextState inputDirection workWrites + workDirections hrepresents hone + have hworkHeads : ∀ i, (cfg.work i).head ≤ bound := by + intro i + have hhead := hheads (workTape i) + rw [show tapeAt cfg (workTape i) = cfg.work i by + simpa [workTape] using tapeAt_work_internal cfg i] at hhead + exact hhead + obtain ⟨hworkPrefix, hworkChain⟩ := workPrefix_list_envelope + (List.finRange n) [] hprefix hinputChain.final (by simp) + (List.nodup_finRange n) hworkHeads hworkStart + let workOps := (List.finRange n).flatMap (fun i => + writeMoveOps n bound (workTape i) (workWrites i) (workDirections i)) + let afterWork := Structured.Basic.execList workOps afterInput + have houtputHead : afterWork (headReg (outputTape n)) ≤ bound := by + have houtput := hworkPrefix.output.1 + have hhead := hheads (outputTape n) + rw [show tapeAt cfg (outputTape n) = cfg.output by + simpa [outputTape] using tapeAt_output_internal cfg] at hhead + change Structured.Basic.execList + ((List.finRange n).flatMap (fun i => writeMoveOps n bound (workTape i) + (workWrites i) (workDirections i))) afterInput + (headReg (outputTape n)) ≤ bound + rw [houtput] + exact hhead + have houtputChain := writeMoveOps_envelopeChain tm bound (outputTape n) + outputWrite outputDirection afterWork hworkChain.final houtputHead hworkPrefix.one + have hcombined := hstateChain.append (hinputChain.append + (hworkChain.append houtputChain)) + simpa [actionOps, hreadInput, hreadWork, hreadOutput, hdelta, initialized, + afterInput, workOps, afterWork, List.append_assoc] using hcombined + +theorem actionOps_measured_internal {tm : TM n} {bound : ℕ} + {cfg next : Complexity.Cfg n tm.Q} {store : Structured.Store} + (hstep : tm.step cfg = some next) + (hrepresents : Represents tm bound cfg store) + (hheads : HeadsBounded cfg bound) + (hworkStart : ∀ i, (cfg.work i).cells 0 = Γ.start) + (houtputStart : cfg.output.cells 0 = Γ.start) + (hone : store (oneReg n bound) = 1) + (henvelope : Structured.Internal.StoreEnvelope + (registerLimit n bound) (wordBound tm bound) store) : + let final := Structured.Basic.execList + (actionOps tm bound cfg.state (readSymbols cfg)) store + Structured.Internal.MeasuredRuns + (action tm bound cfg.state (readSymbols cfg)) store final + (actionOps tm bound cfg.state (readSymbols cfg)).length + (4 * (actionOps tm bound cfg.state (readSymbols cfg)).length * + wordWidth tm bound) (spaceBound tm bound) ∧ + Represents tm bound next final ∧ + Structured.Internal.StoreEnvelope + (registerLimit n bound) (wordBound tm bound) final := by + have hchain := actionOps_envelopeChain_internal hrepresents hheads + hworkStart hone henvelope + have hmeasured := Structured.Internal.MeasuredRuns.basicsEnvelopeChain + (actionOps tm bound cfg.state (readSymbols cfg)) store hchain + refine ⟨?_, actionOps_represents_internal hstep hrepresents hheads + hworkStart houtputStart hone, hmeasured.2⟩ + simpa [action, wordWidth, spaceBound, Structured.Internal.valueWidth, + Structured.Internal.envelopeSpace] using hmeasured.1 + +end Step + +end TMConfig + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Step/Internal/Dispatch.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Step/Internal/Dispatch.lean new file mode 100644 index 0000000000..55d8729259 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Step/Internal/Dispatch.lean @@ -0,0 +1,245 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Step.Internal.Action +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.Switch +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Step.Internal.Load + +/-! +# Nested finite dispatch for one TM transition -- proof internals +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace TMConfig + +namespace Step + + +private theorem cleared_represents {tm : TM n} {bound test : ℕ} + {cfg : Complexity.Cfg n tm.Q} {store : Structured.Store} + (hrepresents : Represents tm bound cfg store) + (htest : registerCount n bound ≤ test) : + Represents tm bound cfg (Structured.Switch.cleared store test) := by + exact hrepresents.update_outside_internal htest + +private theorem cleared_apply_of_ne (store : Structured.Store) {test reg : ℕ} + (hne : reg ≠ test) : + Structured.Switch.cleared store test reg = store reg := by + simp [Structured.Switch.cleared, Function.update_of_ne hne] + +private theorem symbolReg_injective (n bound : ℕ) : + Function.Injective (symbolReg n bound) := by + intro first second heq + apply Fin.ext + simp [symbolReg] at heq + omega + +private theorem symbolReg_ne_one (n bound : ℕ) (tape : Fin (n + 2)) : + symbolReg n bound tape ≠ oneReg n bound := by + simp [symbolReg, oneReg] + omega + +private theorem stateScratchReg_ne_one (n bound : ℕ) : + stateScratchReg n bound ≠ oneReg n bound := by + simp [stateScratchReg, oneReg] + +private theorem stateScratchReg_ne_symbolReg (n bound : ℕ) + (tape : Fin (n + 2)) : + symbolReg n bound tape ≠ stateScratchReg n bound := by + simp [symbolReg, stateScratchReg] + omega + +theorem dispatchSymbols_exec_internal {tm : TM n} {bound : ℕ} + {cfg next : Complexity.Cfg n tm.Q} {store : Structured.Store} + (state : tm.Q) (actual symbols : Fin (n + 2) → Γ) + (remaining : List (Fin (n + 2))) + (hstate : state = cfg.state) + (hstep : tm.step cfg = some next) + (hrepresents : Represents tm bound cfg store) + (hheads : HeadsBounded cfg bound) + (hworkStart : ∀ i, (cfg.work i).cells 0 = Γ.start) + (houtputStart : cfg.output.cells 0 = Γ.start) + (hone : store (oneReg n bound) = 1) + (hactual : actual = readSymbols cfg) + (hloaded : ∀ tape, tape ∈ remaining → + store (symbolReg n bound tape) = symbolCode (actual tape)) + (hassigned : ∀ tape, tape ∉ remaining → symbols tape = actual tape) + (hnodup : remaining.Nodup) : + ∃ final cost space, + Structured.Exec (dispatchSymbols tm bound state remaining symbols) + store final (dispatchSteps tm bound state actual remaining) cost space ∧ + Represents tm bound next final := by + subst state + subst actual + induction remaining generalizing symbols store with + | nil => + have hsymbols : symbols = readSymbols cfg := by + funext tape + exact hassigned tape (by simp) + subst symbols + obtain ⟨cost, space, hexec⟩ := + Structured.Internal.exec_basics_exists + (actionOps tm bound cfg.state (readSymbols cfg)) store + refine ⟨Structured.Basic.execList + (actionOps tm bound cfg.state (readSymbols cfg)) store, + cost, space, ?_, ?_⟩ + · simpa [dispatchSymbols, action, dispatchSteps] using hexec + · exact actionOps_represents_internal hstep hrepresents hheads + hworkStart houtputStart hone + | cons tape rest ih => + have htapeCode := hloaded tape (by simp) + have htestOne : symbolReg n bound tape ≠ oneReg n bound := + symbolReg_ne_one n bound tape + let cleared := Structured.Switch.cleared store (symbolReg n bound tape) + have hclearedRepresents : Represents tm bound cfg cleared := + cleared_represents hrepresents (symbolReg_ge_internal n bound tape) + have hclearedOne : cleared (oneReg n bound) = 1 := by + exact (cleared_apply_of_ne store htestOne.symm).trans hone + have hclearedLoaded : ∀ candidate, candidate ∈ rest → + cleared (symbolReg n bound candidate) = + symbolCode (readSymbols cfg candidate) := by + intro candidate hcandidate + have hne : candidate ≠ tape := by + intro heq + subst candidate + exact (List.nodup_cons.mp hnodup).1 hcandidate + have hregs : symbolReg n bound candidate ≠ symbolReg n bound tape := + fun heq => hne ((symbolReg_injective n bound) heq) + exact (cleared_apply_of_ne store hregs).trans + (hloaded candidate (by simp [hcandidate])) + have hclearedAssigned : ∀ candidate, candidate ∉ rest → + Function.update symbols tape (readSymbols cfg tape) candidate = + readSymbols cfg candidate := by + intro candidate hnot + by_cases heq : candidate = tape + · subst candidate + simp + · rw [Function.update_of_ne heq] + exact hassigned candidate (by simp [heq, hnot]) + obtain ⟨final, branchCost, branchSpace, hbranch, hfinalRepresents⟩ := + ih (symbols := Function.update symbols tape (readSymbols cfg tape)) + (store := cleared) hclearedRepresents hclearedOne + (List.nodup_cons.mp hnodup).2 hclearedLoaded hclearedAssigned + have hselectedBranch : + ∃ cost space, + Structured.Exec + ((fun code : Fin 4 => + dispatchSymbols tm bound cfg.state rest + (Function.update symbols tape (symbolAt code))) + ⟨symbolCode (readSymbols cfg tape), + symbolCode_lt_internal (readSymbols cfg tape)⟩) + cleared final + (dispatchSteps tm bound cfg.state (readSymbols cfg) rest) + cost space := by + refine ⟨branchCost, branchSpace, ?_⟩ + simpa [symbolAt_code_internal] using hbranch + obtain ⟨cost, space, hexec⟩ := Structured.Switch.select_exec + (fun code : Fin 4 => + dispatchSymbols tm bound cfg.state rest + (Function.update symbols tape (symbolAt code))) + store final (symbolCode_lt_internal (readSymbols cfg tape)) + htapeCode hone htestOne hselectedBranch + refine ⟨final, cost, space, ?_, hfinalRepresents⟩ + simpa [dispatchSymbols, dispatchSteps] using hexec + +theorem dispatchState_exec_internal {tm : TM n} {bound : ℕ} + {cfg next : Complexity.Cfg n tm.Q} {store : Structured.Store} + (hstep : tm.step cfg = some next) + (hrepresents : Represents tm bound cfg store) + (hheads : HeadsBounded cfg bound) + (hworkStart : ∀ i, (cfg.work i).cells 0 = Γ.start) + (houtputStart : cfg.output.cells 0 = Γ.start) + (hone : store (oneReg n bound) = 1) + (hstate : store (stateScratchReg n bound) = stateCode tm cfg.state) + (hloaded : ∀ tape, store (symbolReg n bound tape) = + symbolCode (readSymbols cfg tape)) : + ∃ final cost space, + Structured.Exec (dispatchState tm bound) store final + (Structured.Switch.stepCount (stateCode tm cfg.state) + (dispatchSteps tm bound cfg.state (readSymbols cfg) + (List.finRange (n + 2)))) cost space ∧ + Represents tm bound next final := by + let cleared := Structured.Switch.cleared store (stateScratchReg n bound) + have hclearedRepresents : Represents tm bound cfg cleared := + cleared_represents hrepresents (stateScratchReg_ge_internal n bound) + have hclearedOne : cleared (oneReg n bound) = 1 := by + exact (cleared_apply_of_ne store (stateScratchReg_ne_one n bound).symm).trans hone + have hclearedLoaded : ∀ tape, + cleared (symbolReg n bound tape) = symbolCode (readSymbols cfg tape) := by + intro tape + exact (cleared_apply_of_ne store + (stateScratchReg_ne_symbolReg n bound tape)).trans (hloaded tape) + have hbranchState : + (Fintype.equivFin tm.Q).symm + ⟨stateCode tm cfg.state, stateCode_lt_internal tm cfg.state⟩ = + cfg.state := by + exact (Fintype.equivFin tm.Q).symm_apply_apply cfg.state + obtain ⟨final, branchCost, branchSpace, hbranch, hfinalRepresents⟩ := + dispatchSymbols_exec_internal + ((Fintype.equivFin tm.Q).symm + ⟨stateCode tm cfg.state, stateCode_lt_internal tm cfg.state⟩) + (readSymbols cfg) (fun _ => Γ.blank) (List.finRange (n + 2)) + hbranchState hstep hclearedRepresents hheads hworkStart houtputStart + hclearedOne rfl (fun tape _ => hclearedLoaded tape) (by simp) + (List.nodup_finRange (n + 2)) + have hselectedBranch : + ∃ cost space, + Structured.Exec + ((fun stateCode : Fin (Fintype.card tm.Q) => + dispatchSymbols tm bound ((Fintype.equivFin tm.Q).symm stateCode) + (List.finRange (n + 2)) (fun _ => Γ.blank)) + ⟨stateCode tm cfg.state, stateCode_lt_internal tm cfg.state⟩) + cleared final + (dispatchSteps tm bound cfg.state (readSymbols cfg) + (List.finRange (n + 2))) cost space := by + refine ⟨branchCost, branchSpace, ?_⟩ + simpa [hbranchState] using hbranch + obtain ⟨cost, space, hexec⟩ := Structured.Switch.select_exec + (fun stateCode : Fin (Fintype.card tm.Q) => + dispatchSymbols tm bound ((Fintype.equivFin tm.Q).symm stateCode) + (List.finRange (n + 2)) (fun _ => Γ.blank)) + store final (stateCode_lt_internal tm cfg.state) hstate hone + (stateScratchReg_ne_one n bound) hselectedBranch + refine ⟨final, cost, space, ?_, hfinalRepresents⟩ + simpa [dispatchState] using hexec + +theorem program_exec_internal {tm : TM n} {bound : ℕ} + {cfg next : Complexity.Cfg n tm.Q} {store : Structured.Store} + (hstep : tm.step cfg = some next) + (hrepresents : Represents tm bound cfg store) + (hwindow : WithinWindow cfg bound) + (hworkStart : ∀ i, (cfg.work i).cells 0 = Γ.start) + (houtputStart : cfg.output.cells 0 = Γ.start) : + ∃ final cost space, + Structured.Exec (program tm bound) store final + (stepCount tm bound cfg) cost space ∧ + Represents tm bound next final := by + let loaded := Structured.Basic.execList (loadOps n bound) store + obtain ⟨loadCost, loadSpace, hloadExec⟩ := + Structured.Internal.exec_basics_exists (loadOps n bound) store + have hloaded := loadOps_loaded_internal hrepresents hwindow.2 + obtain ⟨final, dispatchCost, dispatchSpace, hdispatch, + hfinalRepresents⟩ := dispatchState_exec_internal hstep hloaded.1 + hwindow.2 hworkStart houtputStart hloaded.2.2.1 hloaded.2.2.2.1 + hloaded.2.2.2.2 + refine ⟨final, loadCost + dispatchCost, max loadSpace dispatchSpace, ?_, + hfinalRepresents⟩ + simpa [program, stepCount, loaded] using Structured.Exec.seq hloadExec hdispatch + +end Step + +end TMConfig + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Step/Internal/Layout.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Step/Internal/Layout.lean new file mode 100644 index 0000000000..bf612b57ac --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Step/Internal/Layout.lean @@ -0,0 +1,201 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Step.Defs + +/-! +# TM-to-RAM step layout -- proof internals +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace TMConfig + +namespace Step + + +theorem symbolCode_lt_internal (symbol : Γ) : symbolCode symbol < 4 := by + cases symbol <;> decide + +theorem symbolAt_code_internal (symbol : Γ) : + symbolAt ⟨symbolCode symbol, symbolCode_lt_internal symbol⟩ = symbol := by + exact symbolDecode_code_internal symbol + +theorem stateCode_lt_internal (tm : TM n) (state : tm.Q) : + stateCode tm state < Fintype.card tm.Q := + (Fintype.equivFin tm.Q state).isLt + +theorem headReg_eq_fieldReg_internal (tape : Fin (n + 2)) : + headReg tape = fieldReg (headField (bound := bound) tape) := by + simp [headReg] + +theorem cellBase_add_eq_fieldReg_internal (tape : Fin (n + 2)) + (position : Fin (bound + 1)) : + cellBase n bound tape + position.val = fieldReg (cellField tape position) := by + simp [cellBase] + +theorem zeroReg_ge_internal (n bound : ℕ) : + registerCount n bound ≤ zeroReg n bound := by + simp [zeroReg, scratchBase] + +theorem oneReg_ge_internal (n bound : ℕ) : + registerCount n bound ≤ oneReg n bound := by + simp [oneReg, scratchBase] + +theorem stateScratchReg_ge_internal (n bound : ℕ) : + registerCount n bound ≤ stateScratchReg n bound := by + simp [stateScratchReg, scratchBase] + +theorem addressReg_ge_internal (n bound : ℕ) : + registerCount n bound ≤ addressReg n bound := by + simp [addressReg, scratchBase] + +theorem valueReg_ge_internal (n bound : ℕ) : + registerCount n bound ≤ valueReg n bound := by + simp [valueReg, scratchBase] + +theorem symbolReg_ge_internal (n bound : ℕ) (tape : Fin (n + 2)) : + registerCount n bound ≤ symbolReg n bound tape := by + simp [symbolReg, scratchBase] + omega + +theorem scratch_lt_registerLimit_internal (n bound : ℕ) : + zeroReg n bound < registerLimit n bound ∧ + oneReg n bound < registerLimit n bound ∧ + stateScratchReg n bound < registerLimit n bound ∧ + addressReg n bound < registerLimit n bound ∧ + valueReg n bound < registerLimit n bound ∧ + ∀ tape, symbolReg n bound tape < registerLimit n bound := by + constructor + · simp [zeroReg, scratchBase, registerLimit] + omega + constructor + · simp [oneReg, scratchBase, registerLimit] + omega + constructor + · simp [stateScratchReg, scratchBase, registerLimit] + omega + constructor + · simp [addressReg, scratchBase, registerLimit] + omega + constructor + · simp [valueReg, scratchBase, registerLimit] + omega + · intro tape + simp [symbolReg, scratchBase, registerLimit] + omega + +theorem encodeRegs_storeBounded_internal (tm : TM n) (bound : ℕ) + (cfg : Complexity.Cfg n tm.Q) (hheads : HeadsBounded cfg bound) : + StoreBounded tm bound (encodeRegs tm bound cfg) := by + constructor + · intro reg hnonzero + have hreg : reg < registerCount n bound := by + by_contra hnot + have hzero := encodeRegs_outside_internal tm bound cfg (Nat.le_of_not_gt hnot) + exact hnonzero hzero + exact lt_trans hreg (by + simp [registerLimit, scratchBase] + omega) + · intro reg + by_cases hreg : reg < registerCount n bound + · rw [encodeRegs, dif_pos hreg] + let field := (fieldEquiv n bound).symm ⟨reg, hreg⟩ + change fieldValue tm bound cfg field ≤ wordBound tm bound + rcases field with state | headOrCell + · exact le_trans (Nat.le_of_lt (stateCode_lt_internal tm cfg.state)) + (le_trans (le_max_left _ _) (le_max_right _ _)) + · rcases headOrCell with tape | cell + · exact le_trans (hheads tape) (le_trans (Nat.le_succ bound) + (le_trans (le_max_right _ _) (le_max_right _ _))) + · rcases cell with ⟨tape, position⟩ + have hcode : symbolCode ((tapeAt cfg tape).cells position.val) ≤ 3 := by + cases (tapeAt cfg tape).cells position.val <;> decide + have hthree : 3 ≤ registerLimit n bound := by + simp [registerLimit, scratchBase, registerCount] + exact le_trans hcode + (le_trans hthree (le_max_left _ _)) + · simp [encodeRegs, hreg] + +theorem loadTapeOps_represents_internal {tm : TM n} {bound : ℕ} + {cfg : Complexity.Cfg n tm.Q} {store : Structured.Store} + (hrepresents : Represents tm bound cfg store) (tape : Fin (n + 2)) : + Represents tm bound cfg + (Structured.Basic.execList (loadTapeOps n bound tape) store) := by + simp only [loadTapeOps, Structured.Basic.execList, Structured.Basic.exec] + apply Represents.update_outside_internal + · apply Represents.update_outside_internal + · exact hrepresents.update_outside_internal (addressReg_ge_internal n bound) + · exact addressReg_ge_internal n bound + · exact symbolReg_ge_internal n bound tape + +theorem loadTapeOps_symbol_internal {tm : TM n} {bound : ℕ} + {cfg : Complexity.Cfg n tm.Q} {store : Structured.Store} + (hrepresents : Represents tm bound cfg store) + (hhead : (tapeAt cfg tape).head ≤ bound) : + Structured.Basic.execList (loadTapeOps n bound tape) store + (symbolReg n bound tape) = + symbolCode ((tapeAt cfg tape).read) := by + have hheadValue := hrepresents (headField (bound := bound) tape) + rw [← headReg_eq_fieldReg_internal] at hheadValue + change store (headReg tape) = (tapeAt cfg tape).head at hheadValue + let position : Fin (bound + 1) := ⟨(tapeAt cfg tape).head, by omega⟩ + have hcellValue := hrepresents (cellField tape position) + rw [← cellBase_add_eq_fieldReg_internal] at hcellValue + change store (cellBase n bound tape + position.val) = + symbolCode ((tapeAt cfg tape).cells position.val) at hcellValue + have haddressHead : addressReg n bound ≠ headReg tape := by + intro heq + have hfield := fieldReg_lt_internal + (headField (bound := bound) tape) + rw [← headReg_eq_fieldReg_internal] at hfield + have hscratch := addressReg_ge_internal n bound + omega + have haddressCell : + addressReg n bound ≠ cellBase n bound tape + position.val := by + rw [cellBase_add_eq_fieldReg_internal] + exact ne_of_gt (lt_of_lt_of_le (fieldReg_lt_internal _) (addressReg_ge_internal n bound)) + let first := + (Structured.Basic.imm (addressReg n bound) (cellBase n bound tape)).exec store + let addressed := + (Structured.Basic.add (addressReg n bound) (addressReg n bound) + (headReg tape)).exec first + have hfirstHead : first (headReg tape) = store (headReg tape) := by + simp [first, Structured.Basic.exec, Function.update_of_ne (Ne.symm haddressHead)] + have hfirstAddress : first (addressReg n bound) = cellBase n bound tape := by + simp [first, Structured.Basic.exec] + have haddressedAddress : + addressed (addressReg n bound) = + cellBase n bound tape + (tapeAt cfg tape).head := by + simp only [addressed, Structured.Basic.exec, Function.update_self] + rw [hfirstAddress, hfirstHead, hheadValue] + have haddressedCell : + addressed (cellBase n bound tape + position.val) = + store (cellBase n bound tape + position.val) := by + simp [addressed, first, Structured.Basic.exec, + Function.update_of_ne (Ne.symm haddressCell)] + change ((Structured.Basic.load (symbolReg n bound tape) (addressReg n bound)).exec + addressed) (symbolReg n bound tape) = _ + simp only [Structured.Basic.exec, Function.update_self] + rw [haddressedAddress] + change addressed (cellBase n bound tape + position.val) = _ + rw [haddressedCell, hcellValue] + rfl + +end Step + +end TMConfig + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Step/Internal/Load.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Step/Internal/Load.lean new file mode 100644 index 0000000000..1b44813f33 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Step/Internal/Load.lean @@ -0,0 +1,362 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Step.Internal.Layout +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.Internal.Resources + +/-! +# Loading represented TM states and head symbols -- proof internals +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace TMConfig + +namespace Step + + +private theorem execList_append (first second : List Structured.Basic) + (store : Structured.Store) : + Structured.Basic.execList (first ++ second) store = + Structured.Basic.execList second (Structured.Basic.execList first store) := by + induction first generalizing store with + | nil => rfl + | cons op rest ih => + simp [Structured.Basic.execList, ih] + +private theorem loadTapeOps_apply_of_ne (n bound : ℕ) + (tape : Fin (n + 2)) (store : Structured.Store) (reg : ℕ) + (haddress : reg ≠ addressReg n bound) + (hsymbol : reg ≠ symbolReg n bound tape) : + Structured.Basic.execList (loadTapeOps n bound tape) store reg = store reg := by + simp [loadTapeOps, Structured.Basic.execList, Structured.Basic.exec, + Function.update_of_ne haddress, Function.update_of_ne hsymbol] + +private theorem symbolReg_injective (n bound : ℕ) : + Function.Injective (symbolReg n bound) := by + intro first second heq + apply Fin.ext + simp [symbolReg] at heq + omega + +/-- Semantic facts established for a processed prefix of named tapes. -/ +private structure LoadedPrefix (tm : TM n) (bound : ℕ) + (cfg : Complexity.Cfg n tm.Q) (processed : List (Fin (n + 2))) + (store : Structured.Store) : Prop where + represents : Represents tm bound cfg store + zero : store (zeroReg n bound) = 0 + one : store (oneReg n bound) = 1 + state : store (stateScratchReg n bound) = stateCode tm cfg.state + symbols : ∀ tape, tape ∈ processed → + store (symbolReg n bound tape) = symbolCode (readSymbols cfg tape) + +private theorem setup_loadedPrefix {tm : TM n} {bound : ℕ} + {cfg : Complexity.Cfg n tm.Q} {store : Structured.Store} + (hrepresents : Represents tm bound cfg store) : + LoadedPrefix tm bound cfg [] + (Structured.Basic.execList (setupOps n bound) store) := by + have hstate := hrepresents (stateField (n := n) (bound := bound)) + rw [fieldReg_state_internal] at hstate + change store 0 = stateCode tm cfg.state at hstate + let first := (Structured.Basic.imm (zeroReg n bound) 0).exec store + let second := (Structured.Basic.imm (oneReg n bound) 1).exec first + let final := (Structured.Basic.add (stateScratchReg n bound) 0 + (zeroReg n bound)).exec second + have hzeroOne : zeroReg n bound ≠ oneReg n bound := by + simp [zeroReg, oneReg] + have hzeroState : zeroReg n bound ≠ stateScratchReg n bound := by + simp [zeroReg, stateScratchReg] + have honeState : oneReg n bound ≠ stateScratchReg n bound := by + simp [oneReg, stateScratchReg] + have hzeroNonzero : zeroReg n bound ≠ 0 := by + simp [zeroReg, scratchBase, registerCount] + have honeNonzero : oneReg n bound ≠ 0 := by + simp [oneReg, scratchBase, registerCount] + have hrepFirst : Represents tm bound cfg first := by + exact hrepresents.update_outside_internal (zeroReg_ge_internal n bound) + have hrepSecond : Represents tm bound cfg second := by + exact hrepFirst.update_outside_internal (oneReg_ge_internal n bound) + have hrepFinal : Represents tm bound cfg final := by + exact hrepSecond.update_outside_internal (stateScratchReg_ge_internal n bound) + have hzeroFinal : final (zeroReg n bound) = 0 := by + simp [final, second, first, Structured.Basic.exec, + Function.update_of_ne hzeroState, + Function.update_of_ne hzeroOne] + have honeFinal : final (oneReg n bound) = 1 := by + simp [final, second, first, Structured.Basic.exec, + Function.update_of_ne honeState] + have hstateFinal : final (stateScratchReg n bound) = stateCode tm cfg.state := by + have hsecondSource : second 0 = store 0 := by + simp [second, first, Structured.Basic.exec, + Function.update_of_ne (Ne.symm hzeroNonzero), + Function.update_of_ne (Ne.symm honeNonzero)] + have hsecondZero : second (zeroReg n bound) = 0 := by + simp [second, first, Structured.Basic.exec, + Function.update_of_ne hzeroOne] + simp only [final, Structured.Basic.exec, Function.update_self] + rw [hsecondSource, hsecondZero, hstate] + rfl + simpa [setupOps, Structured.Basic.execList, first, second, final] using + LoadedPrefix.mk hrepFinal hzeroFinal honeFinal hstateFinal (by simp) + +private theorem loadTape_loadedPrefix {tm : TM n} {bound : ℕ} + {cfg : Complexity.Cfg n tm.Q} {processed : List (Fin (n + 2))} + {store : Structured.Store} (hloaded : LoadedPrefix tm bound cfg processed store) + (tape : Fin (n + 2)) + (hhead : (tapeAt cfg tape).head ≤ bound) : + LoadedPrefix tm bound cfg (tape :: processed) + (Structured.Basic.execList (loadTapeOps n bound tape) store) := by + let final := Structured.Basic.execList (loadTapeOps n bound tape) store + have haddressZero : zeroReg n bound ≠ addressReg n bound := by + simp [zeroReg, addressReg] + have hsymbolZero : zeroReg n bound ≠ symbolReg n bound tape := by + simp [zeroReg, symbolReg] + omega + have haddressOne : oneReg n bound ≠ addressReg n bound := by + simp [oneReg, addressReg] + have hsymbolOne : oneReg n bound ≠ symbolReg n bound tape := by + simp [oneReg, symbolReg] + omega + have haddressState : stateScratchReg n bound ≠ addressReg n bound := by + simp [stateScratchReg, addressReg] + have hsymbolState : stateScratchReg n bound ≠ symbolReg n bound tape := by + simp [stateScratchReg, symbolReg] + omega + refine ⟨loadTapeOps_represents_internal hloaded.represents tape, + loadTapeOps_apply_of_ne n bound tape store (zeroReg n bound) + haddressZero hsymbolZero ▸ hloaded.zero, + loadTapeOps_apply_of_ne n bound tape store (oneReg n bound) + haddressOne hsymbolOne ▸ hloaded.one, + loadTapeOps_apply_of_ne n bound tape store (stateScratchReg n bound) + haddressState hsymbolState ▸ hloaded.state, ?_⟩ + intro candidate hmem + rcases List.mem_cons.mp hmem with heq | hprocessed + · subst candidate + exact loadTapeOps_symbol_internal hloaded.represents hhead + · by_cases heq : candidate = tape + · subst candidate + exact loadTapeOps_symbol_internal hloaded.represents hhead + · rw [loadTapeOps_apply_of_ne n bound tape store (symbolReg n bound candidate)] + · exact hloaded.symbols candidate hprocessed + · simp [symbolReg, addressReg] + omega + · exact fun hregs => heq (symbolReg_injective n bound hregs) + +private theorem loadTapes_loadedPrefix {tm : TM n} {bound : ℕ} + {cfg : Complexity.Cfg n tm.Q} (tapes processed : List (Fin (n + 2))) + {store : Structured.Store} (hloaded : LoadedPrefix tm bound cfg processed store) + (hheads : HeadsBounded cfg bound) : + LoadedPrefix tm bound cfg (tapes.reverse ++ processed) + (Structured.Basic.execList (tapes.flatMap (loadTapeOps n bound)) store) := by + induction tapes generalizing processed store with + | nil => simpa using hloaded + | cons tape rest ih => + have hnext := loadTape_loadedPrefix hloaded tape (hheads tape) + have hfinal := ih (processed := tape :: processed) hnext + simpa [List.flatMap_cons, Structured.Basic.execList, execList_append, + List.reverse_cons, List.append_assoc] using hfinal + +theorem loadOps_loaded_internal {tm : TM n} {bound : ℕ} + {cfg : Complexity.Cfg n tm.Q} {store : Structured.Store} + (hrepresents : Represents tm bound cfg store) + (hheads : HeadsBounded cfg bound) : + let final := Structured.Basic.execList (loadOps n bound) store + Represents tm bound cfg final ∧ + final (zeroReg n bound) = 0 ∧ + final (oneReg n bound) = 1 ∧ + final (stateScratchReg n bound) = stateCode tm cfg.state ∧ + ∀ tape, final (symbolReg n bound tape) = + symbolCode (readSymbols cfg tape) := by + let setup := Structured.Basic.execList (setupOps n bound) store + have hsetup := setup_loadedPrefix hrepresents + have hloaded := loadTapes_loadedPrefix (List.finRange (n + 2)) [] hsetup + hheads + rw [loadOps, execList_append] + exact ⟨hloaded.represents, hloaded.zero, hloaded.one, hloaded.state, + fun tape => hloaded.symbols tape (by simp)⟩ + +private theorem registerCount_lt_registerLimit (n bound : ℕ) : + registerCount n bound < registerLimit n bound := by + simp [registerLimit, scratchBase] + omega + +private theorem registerLimit_le_wordBound (tm : TM n) (bound : ℕ) : + registerLimit n bound ≤ wordBound tm bound := + le_max_left _ _ + +private theorem setupOps_envelopeChain {tm : TM n} {bound : ℕ} + {cfg : Complexity.Cfg n tm.Q} {store : Structured.Store} + (hrepresents : Represents tm bound cfg store) + (henvelope : Structured.Internal.StoreEnvelope + (registerLimit n bound) (wordBound tm bound) store) : + Structured.Internal.Basic.EnvelopeChain (registerLimit n bound) + (wordBound tm bound) (setupOps n bound) store := by + let first := (Structured.Basic.imm (zeroReg n bound) 0).exec store + let second := (Structured.Basic.imm (oneReg n bound) 1).exec first + let final := (Structured.Basic.add (stateScratchReg n bound) 0 + (zeroReg n bound)).exec second + have hscratch := scratch_lt_registerLimit_internal n bound + have hfirst : Structured.Internal.StoreEnvelope (registerLimit n bound) + (wordBound tm bound) first := by + apply henvelope.execBasic + · exact hscratch.1 + · simp [Structured.Internal.Basic.writeValue] + have honeValue : 1 ≤ wordBound tm bound := by + have hpositive : 1 ≤ registerLimit n bound := by + simp [registerLimit, scratchBase, registerCount] + exact le_trans hpositive (registerLimit_le_wordBound tm bound) + have hsecond : Structured.Internal.StoreEnvelope (registerLimit n bound) + (wordBound tm bound) second := by + apply hfirst.execBasic + · exact hscratch.2.1 + · simpa [Structured.Internal.Basic.writeValue] using honeValue + have hstateStore : store 0 = stateCode tm cfg.state := by + have hstate := hrepresents (stateField (n := n) (bound := bound)) + simpa [fieldReg_state_internal, fieldValue] using hstate + have hsecondSource : second 0 = store 0 := by + simp [second, first, Structured.Basic.exec, zeroReg, oneReg, scratchBase, + registerCount, Function.update_of_ne] + have hsecondZero : second (zeroReg n bound) = 0 := by + simp [second, first, Structured.Basic.exec, zeroReg, oneReg, + Function.update_of_ne] + have hstateBound : stateCode tm cfg.state ≤ wordBound tm bound := by + exact le_trans (Nat.le_of_lt (stateCode_lt_internal tm cfg.state)) + (le_trans (le_max_left _ _) (le_max_right _ _)) + have hfinal : Structured.Internal.StoreEnvelope (registerLimit n bound) + (wordBound tm bound) final := by + apply hsecond.execBasic + · exact hscratch.2.2.1 + · simp only [Structured.Internal.Basic.writeValue] + rw [hsecondSource, hsecondZero, hstateStore, Nat.add_zero] + exact hstateBound + simpa [setupOps, first, second, final] using + And.intro henvelope (And.intro hfirst (And.intro hsecond hfinal)) + +private theorem loadTapeOps_envelopeChain {tm : TM n} {bound : ℕ} + {cfg : Complexity.Cfg n tm.Q} {store : Structured.Store} + (hrepresents : Represents tm bound cfg store) + (tape : Fin (n + 2)) (hhead : (tapeAt cfg tape).head ≤ bound) + (henvelope : Structured.Internal.StoreEnvelope + (registerLimit n bound) (wordBound tm bound) store) : + Structured.Internal.Basic.EnvelopeChain (registerLimit n bound) + (wordBound tm bound) (loadTapeOps n bound tape) store := by + let first := + (Structured.Basic.imm (addressReg n bound) (cellBase n bound tape)).exec store + let addressed := + (Structured.Basic.add (addressReg n bound) (addressReg n bound) + (headReg tape)).exec first + let final := + (Structured.Basic.load (symbolReg n bound tape) (addressReg n bound)).exec addressed + have hscratch := scratch_lt_registerLimit_internal n bound + have hbaseLt : cellBase n bound tape < registerCount n bound := by + have hfield := fieldReg_lt_internal + (cellField tape (⟨0, by omega⟩ : Fin (bound + 1))) + rw [← cellBase_add_eq_fieldReg_internal] at hfield + simpa using hfield + have hbaseBound : cellBase n bound tape ≤ wordBound tm bound := by + exact le_trans (Nat.le_of_lt hbaseLt) + (le_trans (Nat.le_of_lt (registerCount_lt_registerLimit n bound)) + (registerLimit_le_wordBound tm bound)) + have hfirst : Structured.Internal.StoreEnvelope (registerLimit n bound) + (wordBound tm bound) first := by + apply henvelope.execBasic + · exact hscratch.2.2.2.1 + · simpa [Structured.Internal.Basic.writeValue] using hbaseBound + have hstoreHead : store (headReg tape) = (tapeAt cfg tape).head := by + have hvalue := hrepresents (headField (bound := bound) tape) + rwa [← headReg_eq_fieldReg_internal] at hvalue + have hfirstAddress : first (addressReg n bound) = cellBase n bound tape := by + simp [first, Structured.Basic.exec] + have hfirstHead : first (headReg tape) = store (headReg tape) := by + have hne : headReg tape ≠ addressReg n bound := by + intro heq + have hheadReg := fieldReg_lt_internal (headField (bound := bound) tape) + rw [← headReg_eq_fieldReg_internal] at hheadReg + have haddress := addressReg_ge_internal n bound + omega + simp [first, Structured.Basic.exec, Function.update_of_ne hne] + let position : Fin (bound + 1) := ⟨(tapeAt cfg tape).head, by omega⟩ + have haddressedLt : + cellBase n bound tape + (tapeAt cfg tape).head < registerCount n bound := by + change cellBase n bound tape + position.val < registerCount n bound + rw [cellBase_add_eq_fieldReg_internal] + exact fieldReg_lt_internal _ + have haddressedBound : + cellBase n bound tape + (tapeAt cfg tape).head ≤ wordBound tm bound := by + exact le_trans (Nat.le_of_lt haddressedLt) + (le_trans (Nat.le_of_lt (registerCount_lt_registerLimit n bound)) + (registerLimit_le_wordBound tm bound)) + have haddressed : Structured.Internal.StoreEnvelope (registerLimit n bound) + (wordBound tm bound) addressed := by + apply hfirst.execBasic + · exact hscratch.2.2.2.1 + · simp only [Structured.Internal.Basic.writeValue] + rw [hfirstAddress, hfirstHead, hstoreHead] + exact haddressedBound + have hfinal : Structured.Internal.StoreEnvelope (registerLimit n bound) + (wordBound tm bound) final := by + apply haddressed.execBasic + · exact hscratch.2.2.2.2.2 tape + · exact haddressed.value_le (addressed (addressReg n bound)) + simpa [loadTapeOps, first, addressed, final] using + And.intro henvelope (And.intro hfirst (And.intro haddressed hfinal)) + +private theorem loadTapes_envelopeChain {tm : TM n} {bound : ℕ} + {cfg : Complexity.Cfg n tm.Q} (tapes : List (Fin (n + 2))) + {store : Structured.Store} + (hrepresents : Represents tm bound cfg store) + (hheads : HeadsBounded cfg bound) + (henvelope : Structured.Internal.StoreEnvelope + (registerLimit n bound) (wordBound tm bound) store) : + Structured.Internal.Basic.EnvelopeChain (registerLimit n bound) + (wordBound tm bound) (tapes.flatMap (loadTapeOps n bound)) store := by + induction tapes generalizing store with + | nil => exact henvelope + | cons tape rest ih => + have hfirst := loadTapeOps_envelopeChain hrepresents tape (hheads tape) henvelope + have hfirstEnvelope := hfirst.final + have hfirstRepresents := loadTapeOps_represents_internal hrepresents tape + have hrest := ih hfirstRepresents hfirstEnvelope + simpa [List.flatMap_cons] using hfirst.append hrest + +theorem loadOps_measured_internal {tm : TM n} {bound : ℕ} + {cfg : Complexity.Cfg n tm.Q} {store : Structured.Store} + (hrepresents : Represents tm bound cfg store) + (hheads : HeadsBounded cfg bound) + (henvelope : Structured.Internal.StoreEnvelope + (registerLimit n bound) (wordBound tm bound) store) : + let final := Structured.Basic.execList (loadOps n bound) store + Structured.Internal.MeasuredRuns (.basics (loadOps n bound)) store final + (loadOps n bound).length + (4 * (loadOps n bound).length * wordWidth tm bound) + (spaceBound tm bound) ∧ + Structured.Internal.StoreEnvelope (registerLimit n bound) + (wordBound tm bound) final := by + have hsetup := setupOps_envelopeChain hrepresents henvelope + have hsetupRepresents := (setup_loadedPrefix hrepresents).represents + have htapes := loadTapes_envelopeChain (List.finRange (n + 2)) + hsetupRepresents hheads hsetup.final + have hchain : Structured.Internal.Basic.EnvelopeChain (registerLimit n bound) + (wordBound tm bound) (loadOps n bound) store := by + simpa [loadOps] using hsetup.append htapes + have hmeasured := Structured.Internal.MeasuredRuns.basicsEnvelopeChain + (loadOps n bound) store hchain + simpa [wordWidth, spaceBound, Structured.Internal.valueWidth, + Structured.Internal.envelopeSpace] using hmeasured + +end Step + +end TMConfig + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Step/Internal/Resources.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Step/Internal/Resources.lean new file mode 100644 index 0000000000..b066cacfb7 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Step/Internal/Resources.lean @@ -0,0 +1,261 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Step.Internal.Action +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Step.Internal.Load +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.Switch + +/-! +# Resource bounds for one TM-to-RAM transition -- proof internals +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace TMConfig + +namespace Step + + +/-- Register and word bounds preserved by a simulated Turing-machine step. -/ +abbrev StepEnvelope (tm : TM n) (bound : ℕ) := + Structured.Internal.StoreEnvelope (registerLimit n bound) (wordBound tm bound) + +private theorem cleared_envelope {tm : TM n} {bound test : ℕ} + {store : Structured.Store} (henvelope : StepEnvelope tm bound store) + (htest : test < registerLimit n bound) : + StepEnvelope tm bound (Structured.Switch.cleared store test) := by + exact henvelope.update htest (by simp) + +private theorem cleared_apply_of_ne' (store : Structured.Store) {test reg : ℕ} + (hne : reg ≠ test) : + Structured.Switch.cleared store test reg = store reg := by + simp [Structured.Switch.cleared, Function.update_of_ne hne] + +private theorem symbolReg_injective' (n bound : ℕ) : + Function.Injective (symbolReg n bound) := by + intro first second heq + apply Fin.ext + simp [symbolReg] at heq + omega + +private theorem symbolReg_ne_one' (n bound : ℕ) (tape : Fin (n + 2)) : + symbolReg n bound tape ≠ oneReg n bound := by + simp [symbolReg, oneReg] + omega + +private theorem stateScratchReg_ne_one' (n bound : ℕ) : + stateScratchReg n bound ≠ oneReg n bound := by + simp [stateScratchReg, oneReg] + +private theorem stateScratchReg_ne_symbolReg' (n bound : ℕ) + (tape : Fin (n + 2)) : + symbolReg n bound tape ≠ stateScratchReg n bound := by + simp [symbolReg, stateScratchReg] + omega + +theorem dispatchSymbols_measured_internal {tm : TM n} {bound : ℕ} + {cfg next : Complexity.Cfg n tm.Q} {store : Structured.Store} + (state : tm.Q) (actual symbols : Fin (n + 2) → Γ) + (remaining : List (Fin (n + 2))) + (hstate : state = cfg.state) + (hstep : tm.step cfg = some next) + (hrepresents : Represents tm bound cfg store) + (hheads : HeadsBounded cfg bound) + (hworkStart : ∀ i, (cfg.work i).cells 0 = Γ.start) + (houtputStart : cfg.output.cells 0 = Γ.start) + (hone : store (oneReg n bound) = 1) + (hactual : actual = readSymbols cfg) + (hloaded : ∀ tape, tape ∈ remaining → + store (symbolReg n bound tape) = symbolCode (actual tape)) + (hassigned : ∀ tape, tape ∉ remaining → symbols tape = actual tape) + (hnodup : remaining.Nodup) + (henvelope : StepEnvelope tm bound store) : + ∃ final, + Structured.Internal.MeasuredRuns + (dispatchSymbols tm bound state remaining symbols) store final + (dispatchSteps tm bound state actual remaining) + (dispatchCost tm bound state actual remaining) (spaceBound tm bound) ∧ + Represents tm bound next final ∧ StepEnvelope tm bound final := by + subst state + subst actual + induction remaining generalizing symbols store with + | nil => + have hsymbols : symbols = readSymbols cfg := by + funext tape + exact hassigned tape (by simp) + subst symbols + let final := Structured.Basic.execList + (actionOps tm bound cfg.state (readSymbols cfg)) store + have haction := actionOps_measured_internal hstep hrepresents hheads + hworkStart houtputStart hone henvelope + refine ⟨final, ?_, haction.2.1, haction.2.2⟩ + simpa [dispatchSymbols, dispatchSteps, dispatchCost, final] using haction.1 + | cons tape rest ih => + have htapeCode := hloaded tape (by simp) + have htestOne : symbolReg n bound tape ≠ oneReg n bound := + symbolReg_ne_one' n bound tape + let cleared := Structured.Switch.cleared store (symbolReg n bound tape) + have hclearedRepresents : Represents tm bound cfg cleared := by + exact hrepresents.update_outside_internal (symbolReg_ge_internal n bound tape) + have hclearedOne : cleared (oneReg n bound) = 1 := by + exact (cleared_apply_of_ne' store htestOne.symm).trans hone + have hclearedEnvelope : StepEnvelope tm bound cleared := + cleared_envelope henvelope + ((scratch_lt_registerLimit_internal n bound).2.2.2.2.2 tape) + have hclearedLoaded : ∀ candidate, candidate ∈ rest → + cleared (symbolReg n bound candidate) = + symbolCode (readSymbols cfg candidate) := by + intro candidate hcandidate + have hne : candidate ≠ tape := by + intro heq + subst candidate + exact (List.nodup_cons.mp hnodup).1 hcandidate + have hregs : symbolReg n bound candidate ≠ symbolReg n bound tape := + fun heq => hne ((symbolReg_injective' n bound) heq) + exact (cleared_apply_of_ne' store hregs).trans + (hloaded candidate (by simp [hcandidate])) + have hclearedAssigned : ∀ candidate, candidate ∉ rest → + Function.update symbols tape (readSymbols cfg tape) candidate = + readSymbols cfg candidate := by + intro candidate hnot + by_cases heq : candidate = tape + · subst candidate + simp + · rw [Function.update_of_ne heq] + exact hassigned candidate (by simp [heq, hnot]) + obtain ⟨final, hbranch, hfinalRepresents, hfinalEnvelope⟩ := + ih (symbols := Function.update symbols tape (readSymbols cfg tape)) + (store := cleared) hclearedRepresents hclearedOne + (hnodup := (List.nodup_cons.mp hnodup).2) + (henvelope := hclearedEnvelope) hclearedLoaded hclearedAssigned + have hselectedBranch : Structured.Internal.MeasuredRuns + ((fun code : Fin 4 => + dispatchSymbols tm bound cfg.state rest + (Function.update symbols tape (symbolAt code))) + ⟨symbolCode (readSymbols cfg tape), + symbolCode_lt_internal (readSymbols cfg tape)⟩) + cleared final + (dispatchSteps tm bound cfg.state (readSymbols cfg) rest) + (dispatchCost tm bound cfg.state (readSymbols cfg) rest) + (spaceBound tm bound) := by + simpa [symbolAt_code_internal] using hbranch + have hrun := Structured.Switch.select_measured + (fun code : Fin 4 => + dispatchSymbols tm bound cfg.state rest + (Function.update symbols tape (symbolAt code))) + store final (symbolCode_lt_internal (readSymbols cfg tape)) + htapeCode hone htestOne + ((scratch_lt_registerLimit_internal n bound).2.2.2.2.2 tape) + henvelope hselectedBranch + refine ⟨final, ?_, hfinalRepresents, hfinalEnvelope⟩ + simpa [dispatchSymbols, dispatchSteps, dispatchCost, wordWidth, + Structured.Internal.valueWidth, spaceBound, + Structured.Internal.envelopeSpace] using hrun + +theorem dispatchState_measured_internal {tm : TM n} {bound : ℕ} + {cfg next : Complexity.Cfg n tm.Q} {store : Structured.Store} + (hstep : tm.step cfg = some next) + (hrepresents : Represents tm bound cfg store) + (hheads : HeadsBounded cfg bound) + (hworkStart : ∀ i, (cfg.work i).cells 0 = Γ.start) + (houtputStart : cfg.output.cells 0 = Γ.start) + (hone : store (oneReg n bound) = 1) + (hstate : store (stateScratchReg n bound) = stateCode tm cfg.state) + (hloaded : ∀ tape, store (symbolReg n bound tape) = + symbolCode (readSymbols cfg tape)) + (henvelope : StepEnvelope tm bound store) : + ∃ final, + Structured.Internal.MeasuredRuns (dispatchState tm bound) store final + (Structured.Switch.stepCount (stateCode tm cfg.state) + (dispatchSteps tm bound cfg.state (readSymbols cfg) + (List.finRange (n + 2)))) + (Structured.Switch.costBound (stateCode tm cfg.state) + (dispatchCost tm bound cfg.state (readSymbols cfg) + (List.finRange (n + 2))) (wordWidth tm bound)) + (spaceBound tm bound) ∧ + Represents tm bound next final ∧ StepEnvelope tm bound final := by + let cleared := Structured.Switch.cleared store (stateScratchReg n bound) + have hclearedRepresents : Represents tm bound cfg cleared := by + exact hrepresents.update_outside_internal (stateScratchReg_ge_internal n bound) + have hclearedOne : cleared (oneReg n bound) = 1 := by + exact (cleared_apply_of_ne' store (stateScratchReg_ne_one' n bound).symm).trans hone + have hclearedEnvelope : StepEnvelope tm bound cleared := + cleared_envelope henvelope + (scratch_lt_registerLimit_internal n bound).2.2.1 + have hclearedLoaded : ∀ tape, + cleared (symbolReg n bound tape) = symbolCode (readSymbols cfg tape) := by + intro tape + exact (cleared_apply_of_ne' store + (stateScratchReg_ne_symbolReg' n bound tape)).trans (hloaded tape) + have hbranchState : + (Fintype.equivFin tm.Q).symm + ⟨stateCode tm cfg.state, stateCode_lt_internal tm cfg.state⟩ = + cfg.state := + (Fintype.equivFin tm.Q).symm_apply_apply cfg.state + obtain ⟨final, hbranch, hfinalRepresents, hfinalEnvelope⟩ := + dispatchSymbols_measured_internal + ((Fintype.equivFin tm.Q).symm + ⟨stateCode tm cfg.state, stateCode_lt_internal tm cfg.state⟩) + (readSymbols cfg) (fun _ => Γ.blank) (List.finRange (n + 2)) + hbranchState hstep hclearedRepresents hheads hworkStart houtputStart + hclearedOne rfl (fun tape _ => hclearedLoaded tape) (by simp) + (List.nodup_finRange (n + 2)) hclearedEnvelope + have hselectedBranch : Structured.Internal.MeasuredRuns + ((fun stateCode : Fin (Fintype.card tm.Q) => + dispatchSymbols tm bound ((Fintype.equivFin tm.Q).symm stateCode) + (List.finRange (n + 2)) (fun _ => Γ.blank)) + ⟨stateCode tm cfg.state, stateCode_lt_internal tm cfg.state⟩) + cleared final + (dispatchSteps tm bound cfg.state (readSymbols cfg) (List.finRange (n + 2))) + (dispatchCost tm bound cfg.state (readSymbols cfg) (List.finRange (n + 2))) + (spaceBound tm bound) := by + simpa [hbranchState] using hbranch + have hrun := Structured.Switch.select_measured + (fun stateCode : Fin (Fintype.card tm.Q) => + dispatchSymbols tm bound ((Fintype.equivFin tm.Q).symm stateCode) + (List.finRange (n + 2)) (fun _ => Γ.blank)) + store final (stateCode_lt_internal tm cfg.state) hstate hone + (stateScratchReg_ne_one' n bound) + (scratch_lt_registerLimit_internal n bound).2.2.1 henvelope hselectedBranch + refine ⟨final, ?_, hfinalRepresents, hfinalEnvelope⟩ + simpa [dispatchState, wordWidth, Structured.Internal.valueWidth, spaceBound, + Structured.Internal.envelopeSpace] using hrun + +theorem program_measured_internal {tm : TM n} {bound : ℕ} + {cfg next : Complexity.Cfg n tm.Q} {store : Structured.Store} + (hstep : tm.step cfg = some next) + (hrepresents : Represents tm bound cfg store) + (hwindow : WithinWindow cfg bound) + (hworkStart : ∀ i, (cfg.work i).cells 0 = Γ.start) + (houtputStart : cfg.output.cells 0 = Γ.start) + (henvelope : StepEnvelope tm bound store) : + ∃ final, + Structured.Internal.MeasuredRuns (program tm bound) store final + (stepCount tm bound cfg) (timeBound tm bound cfg) (spaceBound tm bound) ∧ + Represents tm bound next final ∧ StepEnvelope tm bound final := by + let loaded := Structured.Basic.execList (loadOps n bound) store + have hload := loadOps_measured_internal hrepresents hwindow.2 henvelope + have hloaded := loadOps_loaded_internal hrepresents hwindow.2 + obtain ⟨final, hdispatch, hfinalRepresents, hfinalEnvelope⟩ := + dispatchState_measured_internal hstep hloaded.1 hwindow.2 hworkStart + houtputStart hloaded.2.2.1 hloaded.2.2.2.1 hloaded.2.2.2.2 hload.2 + have hrun := hload.1.seq hdispatch + refine ⟨final, ?_, hfinalRepresents, hfinalEnvelope⟩ + simpa [program, stepCount, timeBound, loaded] using hrun + +end Step + +end TMConfig + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Soundness.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Soundness.lean new file mode 100644 index 0000000000..a85c848bc7 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Soundness.lean @@ -0,0 +1,188 @@ +/- +Copyright (c) 2025 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Internal +public import Mathlib.Data.Nat.Size + +/-! +# Why the RAM must use logarithmic cost: a formal soundness theorem + +This module turns the model's central design decision into a theorem. A RAM +stores unbounded natural numbers in each register. Under the **unit-cost** +measure (one time unit per instruction, `RAM.unitTimeUpto`) a program can +repeatedly *square* a register, reaching `2 ^ (2 ^ k)` in `k + 1` steps. That +number has `2 ^ k + 1` binary digits, so any Turing machine needs at least +`2 ^ k` steps merely to write it: unit-cost RAM time is super-polynomially +stronger than Turing time, and the two models are **not** polynomially +equivalent. + +`RAM.logGap_squaring` proves exactly this gap for the squaring program family +`RAM.sqProg`: on the same run, the unit time is `k + 1` while the logarithmic +time (`RAM.logTimeUpto`, which charges each instruction the bit-length of the +numbers it manipulates) is at least `2 ^ k`. This is why the library adopts the +logarithmic cost measure and never the unit-cost one — the difference is not a +convention but the boundary between a sound Turing-equivalent model and a +"reward-hacked" one that decides more than it should in polynomial time. +-/ + + +public section + +namespace Complexity + +namespace RAM + +/-- The `k`-fold squaring program: load `2` into register `1`, then square + register `1` a total of `k` times. After `j + 1` steps register `1` holds + `2 ^ (2 ^ j)`. -/ +def sqProg (k : ℕ) : Program := + Instr.imm 1 2 :: List.replicate k (Instr.mul 1 1 1) + +/-- The start configuration for the squaring family: program counter `0`, all + registers `0`. -/ +def sqStart : Cfg := ⟨0, fun _ => 0⟩ + +/-- The configuration after `j + 1` steps of `sqProg`: program counter `j + 1`, + register `1` holding `2 ^ (2 ^ j)`, all other registers `0`. -/ +private def sqCfg (j : ℕ) : Cfg := ⟨j + 1, fun i => if i = 1 then 2 ^ (2 ^ j) else 0⟩ + +private theorem sqProg_length (k : ℕ) : (sqProg k).length = k + 1 := by + simp [sqProg] + +private theorem sqProg_getElem_zero (k : ℕ) : + (sqProg k)[(0 : ℕ)]? = some (Instr.imm 1 2) := rfl + +private theorem sqProg_getElem_succ {k j : ℕ} (hj : j < k) : + (sqProg k)[j + 1]? = some (Instr.mul 1 1 1) := by + simp only [sqProg, List.getElem?_cons_succ, List.getElem?_replicate, if_pos hj] + +/-- Squaring `2 ^ (2 ^ j)` yields `2 ^ (2 ^ (j + 1))`. -/ +private theorem sq_pow (j : ℕ) : 2 ^ 2 ^ j * 2 ^ 2 ^ j = 2 ^ 2 ^ (j + 1) := by + rw [← pow_add] + congr 1 + rw [pow_succ] + ring + +/-- One step from the start runs the `imm` instruction, reaching `sqCfg 0`. -/ +private theorem step_sqStart (k : ℕ) : step (sqProg k) sqStart = sqCfg 0 := by + have hcur : curInstr (sqProg k) sqStart = Instr.imm 1 2 := by + unfold curInstr; rw [show sqStart.pc = 0 from rfl, sqProg_getElem_zero]; rfl + unfold step + rw [hcur] + ext i + · rfl + · show Function.update sqStart.regs 1 2 i = (sqCfg 0).regs i + by_cases hi : i = 1 + · subst hi; rw [Function.update_self]; rfl + · rw [Function.update_of_ne hi] + simp only [sqStart, sqCfg, if_neg hi] + +/-- One squaring step from `sqCfg j` reaches `sqCfg (j + 1)`, provided the + `(j + 1)`-th instruction is a `mul` (i.e. `j < k`). -/ +private theorem step_sqCfg {k j : ℕ} (hj : j < k) : + step (sqProg k) (sqCfg j) = sqCfg (j + 1) := by + have hcur : curInstr (sqProg k) (sqCfg j) = Instr.mul 1 1 1 := by + unfold curInstr + rw [show (sqCfg j).pc = j + 1 from rfl, sqProg_getElem_succ hj]; rfl + unfold step + rw [hcur] + ext i + · rfl + · show Function.update (sqCfg j).regs 1 ((sqCfg j).regs 1 * (sqCfg j).regs 1) i + = (sqCfg (j + 1)).regs i + by_cases hi : i = 1 + · subst hi; rw [Function.update_self]; exact sq_pow j + · rw [Function.update_of_ne hi] + simp only [sqCfg, if_neg hi] + +/-- The run invariant: `j + 1` steps of `sqProg k` from the start reach + `sqCfg j`, for every `j ≤ k`. -/ +private theorem sqRun {k : ℕ} : ∀ j, j ≤ k → run (sqProg k) (j + 1) sqStart = sqCfg j := by + intro j + induction j with + | zero => + intro _ + rw [run_one, step_sqStart] + | succ j ih => + intro hj + rw [run_succ_step, ih (by omega), step_sqCfg (by omega)] + +/-- The program counter after `j` steps is exactly `j`, for `j ≤ k`. -/ +private theorem sqRun_pc {k : ℕ} {j : ℕ} (hj : j ≤ k) : + (run (sqProg k) j sqStart).pc = j := by + cases j with + | zero => rfl + | succ j => rw [sqRun j (by omega)]; rfl + +/-- No halt occurs during the first `k + 1` steps: every visited program counter + `≤ k` points at an `imm` or `mul` instruction. -/ +private theorem sqRun_not_halted {k : ℕ} {j : ℕ} (hj : j ≤ k) : + ¬ Halted (sqProg k) (run (sqProg k) j sqStart) := by + unfold Halted curInstr + rw [sqRun_pc hj] + cases j with + | zero => rw [sqProg_getElem_zero]; decide + | succ j => rw [sqProg_getElem_succ (by omega)]; decide + +/-- The **unit-vs-logarithmic gap** for the squaring family. On the run of the + `k`-fold squaring program `sqProg k` for `k + 1` steps: + + * the machine halts; + * the **unit** time is `k + 1` (linear in `k`); + * the **logarithmic** time is at least `2 ^ k` (exponential in `k`). + + Hence any complexity measure based on unit cost differs super-polynomially + from logarithmic cost, and only the logarithmic measure is polynomially + related to Turing-machine time. This is the formal justification for the + library's cost convention. -/ +theorem logGap_squaring {k : ℕ} (hk : 1 ≤ k) : + ∃ (P : Program) (c : Cfg), + Halted P (run P (k + 1) c) ∧ + unitTimeUpto P (k + 1) c = k + 1 ∧ + 2 ^ k ≤ logTimeUpto P (k + 1) c := by + obtain ⟨m, rfl⟩ : ∃ m, k = m + 1 := ⟨k - 1, by omega⟩ + refine ⟨sqProg (m + 1), sqStart, ?_, ?_, ?_⟩ + · -- Halted after m + 2 steps: program counter reaches the end. + rw [sqRun (m + 1) (le_refl _)] + show curInstr (sqProg (m + 1)) (sqCfg (m + 1)) = Instr.halt + unfold curInstr + have hlen : (sqProg (m + 1)).length ≤ m + 2 := by rw [sqProg_length] + rw [show (sqCfg (m + 1)).pc = m + 2 from rfl, List.getElem?_eq_none hlen] + rfl + · -- Unit time is exactly the fuel: no halt in the first m + 2 steps. + exact unitTimeUpto_eq_of_not_halted _ _ _ (fun j hj => sqRun_not_halted (by omega)) + · -- Logarithmic time is at least 2 ^ (m + 1): the final squaring step alone + -- costs at least the bit-length of 2 ^ (2 ^ (m + 1)) = 2 ^ (m + 1) + 1. + have hsplit : logTimeUpto (sqProg (m + 1)) (m + 1 + 1) sqStart = + logTimeUpto (sqProg (m + 1)) (m + 1) sqStart + + logTimeUpto (sqProg (m + 1)) 1 (run (sqProg (m + 1)) (m + 1) sqStart) := + logTimeUpto_add _ (m + 1) 1 sqStart + have hcfg : run (sqProg (m + 1)) (m + 1) sqStart = sqCfg m := sqRun m (by omega) + have hnh : ¬ Halted (sqProg (m + 1)) (sqCfg m) := by + rw [← hcfg]; exact sqRun_not_halted (by omega) + have hcur : curInstr (sqProg (m + 1)) (sqCfg m) = Instr.mul 1 1 1 := by + unfold curInstr + rw [show (sqCfg m).pc = m + 1 from rfl, sqProg_getElem_succ (by omega)]; rfl + -- Evaluate the one-step logarithmic cost of the final `mul`. + have hstep1 : logTimeUpto (sqProg (m + 1)) 1 (sqCfg m) = + stepLogCost (sqProg (m + 1)) (sqCfg m) := by + rw [show (1 : ℕ) = 0 + 1 from rfl, logTimeUpto_succ, if_neg hnh, logTimeUpto_zero, + Nat.add_zero] + have hval : (sqCfg m).regs 1 = 2 ^ 2 ^ m := by simp [sqCfg] + have hcost : stepLogCost (sqProg (m + 1)) (sqCfg m) = + bitlen (2 ^ 2 ^ m) + bitlen (2 ^ 2 ^ m) + bitlen (2 ^ 2 ^ (m + 1)) + 1 := by + unfold stepLogCost + rw [hcur] + simp only [Instr.logCost, hval, sq_pow] + have hbit : bitlen (2 ^ 2 ^ (m + 1)) = 2 ^ (m + 1) + 1 := by + unfold bitlen; rw [Nat.size_pow] + rw [hsplit, hcfg, hstep1, hcost, hbit] + omega + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured.lean new file mode 100644 index 0000000000..fcc6701dd9 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured.lean @@ -0,0 +1,72 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.Switch + +/-! +# Structured logarithmic-cost RAM programs + +This module exposes a minimal imperative authoring language above the concrete +logarithmic-cost RAM. Source commands have independent register-store semantics; +`Cmd.compile` lowers structured conditionals and loops to absolute RAM jumps. + +The main transfer theorem, `Exec.compile_correct`, is exact in all three +dimensions carried by `Exec`: final registers, operand-sensitive logarithmic +time, and peak register space. Thus source proofs can remain at the structured +level without weakening the concrete RAM resource statement. + +`Switch.select` supplies the verified finite numeric case split used by the +Turing-machine transition compiler. Its branch selection has exact step +accounting and preserves explicit logarithmic-cost and space envelopes. +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace Structured + +namespace Cmd + +/-- A closed compiled command consists of its generated code followed by one +halt instruction. -/ +theorem length_compile (cmd : Cmd) : cmd.compile.length = cmd.codeSize + 1 := by + simp [compile, length_compileAt] + +end Cmd + +namespace Exec + +/-- Exact semantic and resource preservation for closed compilation. -/ +theorem compile_correct {cmd : Cmd} {initial final : Store} {steps cost space : ℕ} + (hexec : Exec cmd initial final steps cost space) : + run cmd.compile steps { pc := 0, regs := initial } = + { pc := cmd.codeSize, regs := final } ∧ + logTimeUpto cmd.compile steps { pc := 0, regs := initial } = cost ∧ + spaceUpto cmd.compile steps { pc := 0, regs := initial } = space := by + simpa [Cmd.compile] using + compileAt_correct_internal hexec ([] : Program) [Instr.halt] + +/-- A source execution reaches the halt instruction appended by `Cmd.compile`. -/ +theorem compile_halted {cmd : Cmd} {initial final : Store} {steps cost space : ℕ} + (hexec : Exec cmd initial final steps cost space) : + Halted cmd.compile (run cmd.compile steps { pc := 0, regs := initial }) := by + rw [(compile_correct hexec).1] + simp [Halted, curInstr, Cmd.compile, Cmd.length_compileAt] + +end Exec + +end Structured + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Defs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Defs.lean new file mode 100644 index 0000000000..3e75f5705e --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Defs.lean @@ -0,0 +1,215 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Defs + +/-! +# Structured logarithmic-cost RAM programs — definitions + +This file defines a minimal first-order imperative language over RAM register +stores. Atomic commands are the data-manipulating RAM instructions; sequencing, +conditionals, and loops are structured syntax rather than program-counter +arithmetic. The source semantics is independent of compilation and records the +same operand-sensitive logarithmic cost and finite-support space measure as the +target RAM. + +`Cmd.compileAt` erases structured control flow into absolute `jz`/`jmp` targets. +The compiler appends no hidden data operations: source and target executions +therefore have equal register effects, logarithmic cost, and peak register space. +-/ + + +@[expose] public section + +namespace Complexity + +namespace RAM + +namespace Structured + +/-- A source store maps register indices to natural-number contents. -/ +abbrev Store := ℕ → ℕ + +/-- Logarithmic space occupied by a source store. This deliberately matches +`RAM.Cfg.space`, but does not mention a target program counter. -/ +noncomputable def Store.space (store : Store) : ℕ := + ∑ᶠ i, (if store i = 0 then 0 else bitlen i + bitlen (store i)) + +namespace Input + +/-- Natural-number representation of one input bit. -/ +@[simp] +def bitValue (bit : Bool) : ℕ := if bit then 1 else 0 + +/-- Store a bit string above a reserved register prefix, with its length in a +distinguished register. -/ +def bitStore (lengthReg inputBase : ℕ) (bits : List Bool) : Store := fun index => + if index = lengthReg then bits.length + else if inputBase ≤ index then + match bits[index - inputBase]? with + | some bit => bitValue bit + | none => 0 + else 0 + +end Input + +/-- Data-manipulating instructions of the structured source language. Control +flow is represented by `Cmd`, so arbitrary jumps and halt are not source atoms. -/ +inductive Basic where + | imm (dst value : ℕ) + | add (dst left right : ℕ) + | sub (dst left right : ℕ) + | mul (dst left right : ℕ) + | load (dst address : ℕ) + | store (address src : ℕ) + deriving Repr, DecidableEq, Inhabited + +namespace Basic + +/-- Execute one source-level basic instruction on a register store. -/ +def exec : Basic → Store → Store + | .imm dst value, regs => Function.update regs dst value + | .add dst left right, regs => + Function.update regs dst (regs left + regs right) + | .sub dst left right, regs => + Function.update regs dst (regs left - regs right) + | .mul dst left right, regs => + Function.update regs dst (regs left * regs right) + | .load dst address, regs => + Function.update regs dst (regs (regs address)) + | .store address src, regs => + Function.update regs (regs address) (regs src) + +/-- Erase a source basic instruction to the corresponding RAM instruction. -/ +def instr : Basic → Instr + | .imm dst value => .imm dst value + | .add dst left right => .add dst left right + | .sub dst left right => .sub dst left right + | .mul dst left right => .mul dst left right + | .load dst address => .load dst address + | .store address src => .store address src + +/-- Operand-sensitive source cost of one basic instruction. -/ +def logCost : Basic → Store → ℕ + | .imm _ value, _ => bitlen value + 1 + | .add _ left right, regs => + bitlen (regs left) + bitlen (regs right) + + bitlen (regs left + regs right) + 1 + | .sub _ left right, regs => + bitlen (regs left) + bitlen (regs right) + 1 + | .mul _ left right, regs => + bitlen (regs left) + bitlen (regs right) + + bitlen (regs left * regs right) + 1 + | .load _ address, regs => + bitlen (regs address) + bitlen (regs (regs address)) + 1 + | .store address src, regs => + bitlen (regs address) + bitlen (regs src) + 1 + +/-- Execute a straight-line list of basic instructions. -/ +def execList : List Basic → Store → Store + | [], regs => regs + | op :: rest, regs => execList rest (op.exec regs) + +end Basic + +/-- Minimal structured imperative syntax over RAM stores. -/ +inductive Cmd where + | skip + | basic (op : Basic) + | seq (first second : Cmd) + | ifZero (test : ℕ) (onZero onNonzero : Cmd) + | whileNonzero (test : ℕ) (body : Cmd) + deriving Repr, DecidableEq, Inhabited + +namespace Cmd + +/-- Number of RAM instructions emitted for a structured command. -/ +def codeSize : Cmd → ℕ + | .skip => 0 + | .basic _ => 1 + | .seq first second => first.codeSize + second.codeSize + | .ifZero _ onZero onNonzero => + 2 + onZero.codeSize + onNonzero.codeSize + | .whileNonzero _ body => body.codeSize + 2 + +/-- Compile a command whose first instruction will be placed at `start`. +All generated branch destinations are absolute RAM program counters. -/ +def compileAt : (start : ℕ) → Cmd → Program + | _, .skip => [] + | _, .basic op => [op.instr] + | start, .seq first second => + first.compileAt start ++ second.compileAt (start + first.codeSize) + | start, .ifZero test onZero onNonzero => + let nonzeroStart := start + 1 + let zeroStart := nonzeroStart + onNonzero.codeSize + 1 + let done := start + (Cmd.ifZero test onZero onNonzero).codeSize + [Instr.jz test zeroStart] ++ + onNonzero.compileAt nonzeroStart ++ [Instr.jmp done] ++ + onZero.compileAt zeroStart + | start, .whileNonzero test body => + let done := start + (Cmd.whileNonzero test body).codeSize + [Instr.jz test done] ++ body.compileAt (start + 1) ++ + [Instr.jmp start] + +/-- Compile a closed source command and halt immediately after it finishes. -/ +def compile (cmd : Cmd) : Program := cmd.compileAt 0 ++ [Instr.halt] + +/-- Right-associated sequential composition of a list of commands. -/ +def seqList : List Cmd → Cmd + | [] => .skip + | [cmd] => cmd + | cmd :: next :: rest => .seq cmd (seqList (next :: rest)) + +/-- Embed a straight-line list of basic instructions as one structured command. -/ +def basics (ops : List Basic) : Cmd := + seqList (ops.map Cmd.basic) + +end Cmd + +/-- Independent big-step semantics for structured commands. Besides the final +store, the relation records target instruction steps, exact logarithmic cost, +and peak source-store space. Branch and loop-control costs are explicit. -/ +inductive Exec : Cmd → Store → Store → ℕ → ℕ → ℕ → Prop where + | skip (store : Store) : + Exec .skip store store 0 0 store.space + | basic (op : Basic) (store : Store) : + Exec (.basic op) store (op.exec store) 1 (op.logCost store) + (max store.space (op.exec store).space) + | seq {first second : Cmd} {store middle final : Store} + {firstSteps secondSteps firstCost secondCost firstSpace secondSpace : ℕ} + (hfirst : Exec first store middle firstSteps firstCost firstSpace) + (hsecond : Exec second middle final secondSteps secondCost secondSpace) : + Exec (.seq first second) store final (firstSteps + secondSteps) + (firstCost + secondCost) (max firstSpace secondSpace) + | ifZero {test : ℕ} {onZero onNonzero : Cmd} {store final : Store} + {steps cost space : ℕ} (htest : store test = 0) + (hbranch : Exec onZero store final steps cost space) : + Exec (.ifZero test onZero onNonzero) store final (steps + 1) + (bitlen (store test) + 1 + cost) (max store.space space) + | ifNonzero {test : ℕ} {onZero onNonzero : Cmd} {store final : Store} + {steps cost space : ℕ} (htest : store test ≠ 0) + (hbranch : Exec onNonzero store final steps cost space) : + Exec (.ifZero test onZero onNonzero) store final (steps + 2) + (bitlen (store test) + 1 + cost + 1) (max store.space space) + | whileZero {test : ℕ} {body : Cmd} {store : Store} + (htest : store test = 0) : + Exec (.whileNonzero test body) store store 1 + (bitlen (store test) + 1) store.space + | whileNonzero {test : ℕ} {body : Cmd} {store middle final : Store} + {bodySteps loopSteps bodyCost loopCost bodySpace loopSpace : ℕ} + (htest : store test ≠ 0) + (hbody : Exec body store middle bodySteps bodyCost bodySpace) + (hloop : Exec (.whileNonzero test body) middle final loopSteps loopCost loopSpace) : + Exec (.whileNonzero test body) store final + (bodySteps + loopSteps + 2) (bitlen (store test) + 1 + bodyCost + 1 + loopCost) + (max bodySpace loopSpace) + +end Structured + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/GateEval.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/GateEval.lean new file mode 100644 index 0000000000..70cef9df35 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/GateEval.lean @@ -0,0 +1,129 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.GateEval.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.GateEval.Internal +public import LeanPool.BeyondBethe.Complexitylib.Asymptotics +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured + +/-! +# Verified structured RAM decoded-gate evaluator + +This module exposes the mutable-data kernel used by the serialized-circuit +evaluator. Given an already-decoded, topologically valid gate, it performs two +indirect memo reads, evaluates the gate with branch-free Boolean arithmetic, +and indirectly appends the result in exactly twenty RAM transitions. +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace Structured + +namespace GateEval + +/-- Evaluate a decoded gate in any store satisfying the routine ABI. + +The memo may be located above an arbitrary base address; the result is appended +there and every prior memo cell is preserved. -/ +theorem routine_correct {base : ℕ} {gate : CircuitCode.RawGate} + {wires : List Bool} {store : Store} (hready : ReadyAt base gate wires store) + (value0 value1 : Bool) (hvalue0 : wires[gate.input₀]? = some value0) + (hvalue1 : wires[gate.input₁]? = some value1) : + ∃ final cost space, + Exec program store final stepCount cost space ∧ + final outputReg = Input.bitValue (gate.eval value0 value1) ∧ + final (base + wires.length) = Input.bitValue (gate.eval value0 value1) ∧ + final baseReg = base ∧ final wireCountReg = wires.length ∧ + (∀ index (hindex : index < wires.length), + final (base + index) = Input.bitValue wires[index]) ∧ + ∀ index, wireBase ≤ index → index ≠ base + wires.length → + final index = store index := + routine_exec_internal hready value0 value1 hvalue0 hvalue1 + +/-- Source-level correctness with exact transitions and explicit resources. -/ +theorem program_performance (gate : CircuitCode.RawGate) (wires : List Bool) + (value0 value1 : Bool) (hvalue0 : wires[gate.input₀]? = some value0) + (hvalue1 : wires[gate.input₁]? = some value1) + (hgate : gate.WellFormedAt wires.length) : + ∃ final cost space, + Exec program (inputStore gate wires) final stepCount cost space ∧ + cost ≤ timeBound wires.length ∧ space ≤ spaceBound wires.length ∧ + final outputReg = Input.bitValue (gate.eval value0 value1) ∧ + final (wireBase + wires.length) = Input.bitValue (gate.eval value0 value1) ∧ + ∀ index (hindex : index < wires.length), + final (wireBase + index) = Input.bitValue wires[index] := + program_measured_internal gate wires value0 value1 hvalue0 hvalue1 hgate + +/-- End-to-end concrete RAM performance and decoded-gate correctness. -/ +theorem compiled_performance (gate : CircuitCode.RawGate) (wires : List Bool) + (value0 value1 : Bool) (hvalue0 : wires[gate.input₀]? = some value0) + (hvalue1 : wires[gate.input₁]? = some value1) + (hgate : gate.WellFormedAt wires.length) : + ∃ final cost space, + Exec program (inputStore gate wires) final stepCount cost space ∧ + run compiled stepCount { pc := 0, regs := inputStore gate wires } = + { pc := program.codeSize, regs := final } ∧ + Halted compiled + (run compiled stepCount { pc := 0, regs := inputStore gate wires }) ∧ + logTimeUpto compiled stepCount + { pc := 0, regs := inputStore gate wires } ≤ timeBound wires.length ∧ + spaceUpto compiled stepCount + { pc := 0, regs := inputStore gate wires } ≤ spaceBound wires.length ∧ + final outputReg = Input.bitValue (gate.eval value0 value1) ∧ + final (wireBase + wires.length) = Input.bitValue (gate.eval value0 value1) ∧ + ∀ index (hindex : index < wires.length), + final (wireBase + index) = Input.bitValue wires[index] := by + obtain ⟨final, cost, space, hexec, hcost, hspace, hresult, happended, + hpreserved⟩ := + program_performance gate wires value0 value1 hvalue0 hvalue1 hgate + have hcompiled := Exec.compile_correct hexec + refine ⟨final, cost, space, hexec, hcompiled.1, Exec.compile_halted hexec, + ?_, ?_, hresult, happended, hpreserved⟩ + · change logTimeUpto program.compile stepCount + { pc := 0, regs := inputStore gate wires } ≤ timeBound wires.length + rw [hcompiled.2.1] + exact hcost + · change spaceUpto program.compile stepCount + { pc := 0, regs := inputStore gate wires } ≤ spaceBound wires.length + rw [hcompiled.2.2] + exact hspace + +/-- One decoded gate takes logarithmic time in the current memo length. -/ +theorem timeBound_bigO_logarithmic : timeBound =O logarithmicBound := by + have hpoint : ∀ n, timeBound n ≤ 80 * logarithmicBound n := by + intro n + simp [timeBound, logarithmicBound] + exact (BigO.of_le hpoint).trans + (BigO.const_mul_left 80 (BigO.refl logarithmicBound)) + +/-- The explicit memo-space budget is quasilinear. -/ +theorem spaceBound_bigO_quasilinear : spaceBound =O quasilinearBound := by + have hpoint : ∀ n, spaceBound n ≤ 2 * quasilinearBound n := by + intro n + simp only [spaceBound, quasilinearBound] + calc + (n + wireBase + 1) * (2 * bitlen (n + wireBase + 1)) = + 2 * ((n + wireBase + 1) * bitlen (n + wireBase + 1)) := by ring + _ ≤ 2 * ((n + wireBase + 1) * + (bitlen (n + wireBase + 1) + 1)) := + Nat.mul_le_mul_left 2 + (Nat.mul_le_mul_left (n + wireBase + 1) (by omega)) + exact (BigO.of_le hpoint).trans + (BigO.const_mul_left 2 (BigO.refl quasilinearBound)) + +end GateEval + +end Structured + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/GateEval/Defs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/GateEval/Defs.lean new file mode 100644 index 0000000000..f99ff40bee --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/GateEval/Defs.lean @@ -0,0 +1,169 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.Defs +public import LeanPool.BeyondBethe.Complexitylib.Circuits.Encoding.Defs + +/-! +# Structured RAM decoded-gate evaluator — definitions + +This kernel evaluates one already-decoded fan-in-two gate against a mutable +wire memo. It uses indirect reads for both references and an indirect write to +append the result. Boolean negation, AND, and OR are implemented arithmetically, +so the instruction count is independent of the gate and wire values. +-/ + + +@[expose] public section + +namespace Complexity + +namespace RAM + +namespace Structured + +namespace GateEval + +/-- Encoded gate-operation bit: zero for AND and one for OR. -/ +def opReg : ℕ := 0 +/-- Negation bit for the first gate input. -/ +def negated0Reg : ℕ := 1 +/-- Negation bit for the second gate input. -/ +def negated1Reg : ℕ := 2 +/-- First gate-input index, then its physical memo address. -/ +def address0Reg : ℕ := 3 +/-- Second gate-input index, then the append address. -/ +def address1Reg : ℕ := 4 +/-- Number of wire values already present in the memo. -/ +def wireCountReg : ℕ := 5 +/-- Loaded and optionally negated first input value. -/ +def value0Reg : ℕ := 6 +/-- Loaded and optionally negated second input value. -/ +def value1Reg : ℕ := 7 +/-- Final gate value. -/ +def outputReg : ℕ := 8 +/-- Arithmetic scratch register. -/ +def scratchReg : ℕ := 9 +/-- Physical base address of the wire memo. -/ +def baseReg : ℕ := 10 +/-- First register occupied by memoized wire bits. -/ +def wireBase : ℕ := 11 + +/-- Register representation of a decoded gate and its incoming wire memo. -/ +def inputStore (gate : CircuitCode.RawGate) (wires : List Bool) : Store := + let store := Input.bitStore wireCountReg wireBase wires + let store := Function.update store opReg (Input.bitValue gate.opBit) + let store := Function.update store negated0Reg (Input.bitValue gate.negated₀) + let store := Function.update store negated1Reg (Input.bitValue gate.negated₁) + let store := Function.update store address0Reg gate.input₀ + let store := Function.update store address1Reg gate.input₁ + Function.update store baseReg wireBase + +/-- Branch-free arithmetic implementation of Boolean XOR. -/ +def xorOps (value negated : ℕ) : List Basic := + [.add outputReg value negated, + .mul scratchReg value negated, + .add scratchReg scratchReg scratchReg, + .sub value outputReg scratchReg] + +/-- Convert the two absolute wire indices to physical memo addresses. -/ +def addressOps : List Basic := + [.add address0Reg address0Reg baseReg, + .add address1Reg address1Reg baseReg] + +/-- Indirectly read the gate's two inputs. -/ +def loadOps : List Basic := + [.load value0Reg address0Reg, + .load value1Reg address1Reg] + +/-- Branch-free AND/OR selection. Both candidate values are formed and the +operation bit arithmetically selects the result. -/ +def evalOps : List Basic := + [.mul scratchReg value0Reg value1Reg, + .add outputReg value0Reg value1Reg, + .sub outputReg outputReg scratchReg, + .sub address0Reg outputReg scratchReg, + .mul address0Reg opReg address0Reg, + .sub outputReg outputReg address0Reg] + +/-- Compute the next memo address and append the result indirectly. -/ +def appendOps : List Basic := + [.add address1Reg baseReg wireCountReg, + .store address1Reg outputReg] + +/-- Evaluate one gate and append its Boolean result to the wire memo. -/ +def ops : List Basic := + addressOps ++ loadOps ++ xorOps value0Reg negated0Reg ++ + xorOps value1Reg negated1Reg ++ evalOps ++ appendOps + +/-- Straight-line decoded-gate evaluator, grouped at semantic proof boundaries. -/ +def program : Cmd := Cmd.seqList + [.basics addressOps, + .basics loadOps, + .basics (xorOps value0Reg negated0Reg), + .basics (xorOps value1Reg negated1Reg), + .basics evalOps, + .basics appendOps] + +/-- Semantic calling convention for evaluating a decoded gate in an existing +store. The memo may begin at any address above the evaluator's control prefix. -/ +structure ReadyAt (base : ℕ) (gate : CircuitCode.RawGate) (wires : List Bool) + (store : Store) : Prop where + /-- The memo is disjoint from the evaluator's control registers. -/ + base_ge : wireBase ≤ base + /-- The operation register contains the canonical gate-operation bit. -/ + op_eq : store opReg = Input.bitValue gate.opBit + /-- The first negation register contains its canonical bit. -/ + negated0_eq : store negated0Reg = Input.bitValue gate.negated₀ + /-- The second negation register contains its canonical bit. -/ + negated1_eq : store negated1Reg = Input.bitValue gate.negated₁ + /-- The first address register contains the first absolute wire reference. -/ + address0_eq : store address0Reg = gate.input₀ + /-- The second address register contains the second absolute wire reference. -/ + address1_eq : store address1Reg = gate.input₁ + /-- The wire-count register contains the current memo length. -/ + wireCount_eq : store wireCountReg = wires.length + /-- The base register points to the physical memo. -/ + base_eq : store baseReg = base + /-- Physical memo cells contain the semantic wire bits. -/ + wire_eq : ∀ index, index < wires.length → + store (base + index) = + match wires[index]? with + | some bit => Input.bitValue bit + | none => 0 + +/-- Concrete compiled RAM kernel. -/ +def compiled : Program := program.compile + +/-- The branch-free kernel always takes twenty source and compiled steps. -/ +def stepCount : ℕ := 20 + +/-- Uniform logarithmic-cost budget for one gate. -/ +def timeBound (wireCount : ℕ) : ℕ := + 80 * (bitlen (wireCount + wireBase + 1) + 1) + +/-- Peak-space budget including the appended wire. -/ +def spaceBound (wireCount : ℕ) : ℕ := + (wireCount + wireBase + 1) * + (2 * bitlen (wireCount + wireBase + 1)) + +/-- Shifted logarithmic comparison function for one-gate time. -/ +def logarithmicBound (wireCount : ℕ) : ℕ := + bitlen (wireCount + wireBase + 1) + 1 + +/-- Shifted quasilinear comparison function for the explicit memo space. -/ +def quasilinearBound (wireCount : ℕ) : ℕ := + (wireCount + wireBase + 1) * + (bitlen (wireCount + wireBase + 1) + 1) + +end GateEval + +end Structured + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/GateEval/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/GateEval/Internal.lean new file mode 100644 index 0000000000..9dccca46e3 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/GateEval/Internal.lean @@ -0,0 +1,1694 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.GateEval.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.Internal.Resources +public import Mathlib.Algebra.Order.Sub.Basic +public import Std.Tactic.BVDecide.Normalize.Bool + +/-! +# Structured RAM decoded-gate evaluator — proof internals +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace Structured + +namespace GateEval + +open Internal + +private abbrev StoreBound (wireCount : ℕ) (store : Store) : Prop := + StoreEnvelope (wireCount + wireBase + 1) (wireCount + wireBase + 1) store + +private abbrev width (wireCount : ℕ) : ℕ := + valueWidth (wireCount + wireBase + 1) + +private abbrev resourceSpace (wireCount : ℕ) : ℕ := + envelopeSpace (wireCount + wireBase + 1) (wireCount + wireBase + 1) + +private theorem envelopeSpace_eq_spaceBound (wireCount : ℕ) : + resourceSpace wireCount = spaceBound wireCount := by + simp [resourceSpace, envelopeSpace, spaceBound, two_mul] + +private theorem inputStore_bound (gate : CircuitCode.RawGate) (wires : List Bool) + (hgate : gate.WellFormedAt wires.length) : + StoreBound wires.length (inputStore gate wires) := by + have hbits : StoreBound wires.length + (Input.bitStore wireCountReg wireBase wires) := by + apply Input.bitStoreEnvelope + · simp [wireCountReg, wireBase] + · simp [wireBase] + omega + · omega + · simp [wireBase] + have hop := hbits.update (index := opReg) (value := Input.bitValue gate.opBit) + (by simp [opReg, wireBase]) (by cases gate.opBit <;> simp [wireBase]) + have hneg0 := hop.update (index := negated0Reg) + (value := Input.bitValue gate.negated₀) (by simp [negated0Reg, wireBase]) + (by cases gate.negated₀ <;> simp [wireBase]) + have hneg1 := hneg0.update (index := negated1Reg) + (value := Input.bitValue gate.negated₁) (by simp [negated1Reg, wireBase]) + (by cases gate.negated₁ <;> simp [wireBase]) + have haddress0 := hneg1.update (index := address0Reg) (value := gate.input₀) + (by simp [address0Reg, wireBase]) (by + have hinput := hgate.1 + simp [wireBase] + omega) + have haddress1 := haddress0.update (index := address1Reg) (value := gate.input₁) + (by simp [address1Reg, wireBase]) (by + have hinput := hgate.2 + simp [wireBase] + omega) + have hbase := haddress1.update (index := baseReg) (value := wireBase) + (by simp [baseReg, wireBase]) (by simp [wireBase]) + simpa [inputStore] using hbase + +private def addressed0 (gate : CircuitCode.RawGate) (wires : List Bool) : Store := + (Basic.add address0Reg address0Reg baseReg).exec (inputStore gate wires) + +private def addressed (gate : CircuitCode.RawGate) (wires : List Bool) : Store := + Basic.execList addressOps (inputStore gate wires) + +private def loaded0 (gate : CircuitCode.RawGate) (wires : List Bool) : Store := + (Basic.load value0Reg address0Reg).exec (addressed gate wires) + +private def loaded (gate : CircuitCode.RawGate) (wires : List Bool) : Store := + Basic.execList loadOps (addressed gate wires) + +private def negated0Sum (gate : CircuitCode.RawGate) (wires : List Bool) : Store := + (Basic.add outputReg value0Reg negated0Reg).exec (loaded gate wires) + +private def negated0Product (gate : CircuitCode.RawGate) (wires : List Bool) : Store := + (Basic.mul scratchReg value0Reg negated0Reg).exec (negated0Sum gate wires) + +private def negated0Twice (gate : CircuitCode.RawGate) (wires : List Bool) : Store := + (Basic.add scratchReg scratchReg scratchReg).exec (negated0Product gate wires) + +private def negated0 (gate : CircuitCode.RawGate) (wires : List Bool) : Store := + Basic.execList (xorOps value0Reg negated0Reg) (loaded gate wires) + +private def negated1Sum (gate : CircuitCode.RawGate) (wires : List Bool) : Store := + (Basic.add outputReg value1Reg negated1Reg).exec (negated0 gate wires) + +private def negated1Product (gate : CircuitCode.RawGate) (wires : List Bool) : Store := + (Basic.mul scratchReg value1Reg negated1Reg).exec (negated1Sum gate wires) + +private def negated1Twice (gate : CircuitCode.RawGate) (wires : List Bool) : Store := + (Basic.add scratchReg scratchReg scratchReg).exec (negated1Product gate wires) + +private def negated1 (gate : CircuitCode.RawGate) (wires : List Bool) : Store := + Basic.execList (xorOps value1Reg negated1Reg) (negated0 gate wires) + +private def evalProduct (gate : CircuitCode.RawGate) (wires : List Bool) : Store := + (Basic.mul scratchReg value0Reg value1Reg).exec (negated1 gate wires) + +private def evalSum (gate : CircuitCode.RawGate) (wires : List Bool) : Store := + (Basic.add outputReg value0Reg value1Reg).exec (evalProduct gate wires) + +private def evalOr (gate : CircuitCode.RawGate) (wires : List Bool) : Store := + (Basic.sub outputReg outputReg scratchReg).exec (evalSum gate wires) + +private def evalDelta (gate : CircuitCode.RawGate) (wires : List Bool) : Store := + (Basic.sub address0Reg outputReg scratchReg).exec (evalOr gate wires) + +private def evalSelected (gate : CircuitCode.RawGate) (wires : List Bool) : Store := + (Basic.mul address0Reg opReg address0Reg).exec (evalDelta gate wires) + +private def evaluated (gate : CircuitCode.RawGate) (wires : List Bool) : Store := + Basic.execList evalOps (negated1 gate wires) + +private def appendAddressed (gate : CircuitCode.RawGate) (wires : List Bool) : Store := + (Basic.add address1Reg baseReg wireCountReg).exec (evaluated gate wires) + +private def finalStore (gate : CircuitCode.RawGate) (wires : List Bool) : Store := + (Basic.store address1Reg outputReg).exec (appendAddressed gate wires) + +private def routineAddressed (store : Store) : Store := + Basic.execList addressOps store + +private def routineLoaded (store : Store) : Store := + Basic.execList loadOps (routineAddressed store) + +private def routineNegated0 (store : Store) : Store := + Basic.execList (xorOps value0Reg negated0Reg) (routineLoaded store) + +private def routineNegated1 (store : Store) : Store := + Basic.execList (xorOps value1Reg negated1Reg) (routineNegated0 store) + +private def routineEvaluated (store : Store) : Store := + Basic.execList evalOps (routineNegated1 store) + +private def routineFinal (store : Store) : Store := + Basic.execList appendOps (routineEvaluated store) + +private theorem inputStore_wire (gate : CircuitCode.RawGate) (wires : List Bool) + (index : ℕ) : + inputStore gate wires (wireBase + index) = + match wires[index]? with + | some bit => Input.bitValue bit + | none => 0 := by + have h1 : 11 + index ≠ 1 := by omega + have h2 : 11 + index ≠ 2 := by omega + have h3 : 11 + index ≠ 3 := by omega + have h4 : 11 + index ≠ 4 := by omega + have h5 : 11 + index ≠ 5 := by omega + have h10 : 11 + index ≠ 10 := by omega + simp [inputStore, h1, h2, h3, h4, h5, h10, Input.bitStore, + wireBase, wireCountReg, opReg, negated0Reg, negated1Reg, address0Reg, + address1Reg, baseReg] + rfl + +private theorem addressed_address0 (gate : CircuitCode.RawGate) + (wires : List Bool) : + addressed gate wires address0Reg = gate.input₀ + wireBase := by + simp [addressed, addressOps, Basic.execList, Basic.exec, inputStore, + address0Reg, address1Reg, baseReg, wireBase] + +private theorem addressed_address1 (gate : CircuitCode.RawGate) + (wires : List Bool) : + addressed gate wires address1Reg = gate.input₁ + wireBase := by + simp [addressed, addressOps, Basic.execList, Basic.exec, inputStore, + address0Reg, address1Reg, baseReg, wireBase] + +private theorem addressed_apply_of_ne (gate : CircuitCode.RawGate) + (wires : List Bool) (index : ℕ) (h0 : index ≠ address0Reg) + (h1 : index ≠ address1Reg) : + addressed gate wires index = inputStore gate wires index := by + simp [addressed, addressOps, Basic.execList, Basic.exec, + Function.update_of_ne, h0, h1] + +private theorem loaded_value0 (gate : CircuitCode.RawGate) (wires : List Bool) + (value : Bool) (hvalue : wires[gate.input₀]? = some value) : + loaded gate wires value0Reg = Input.bitValue value := by + have hwire := inputStore_wire gate wires gate.input₀ + have hphysical : inputStore gate wires (gate.input₀ + wireBase) = + Input.bitValue value := by + rw [Nat.add_comm] + simpa [hvalue] using hwire + have haddress : addressed gate wires 3 = gate.input₀ + 11 := by + simpa [address0Reg, wireBase] using addressed_address0 gate wires + have hread : addressed gate wires (gate.input₀ + 11) = + Input.bitValue value := by + rw [addressed_apply_of_ne gate wires] + · simpa [wireBase] using hphysical + · simp [address0Reg] + · simp [address1Reg] + simp [loaded, loadOps, Basic.execList, Basic.exec, value0Reg, value1Reg, + address0Reg, address1Reg, haddress, hread] + +private theorem loaded_value1 (gate : CircuitCode.RawGate) (wires : List Bool) + (value : Bool) (hvalue : wires[gate.input₁]? = some value) : + loaded gate wires value1Reg = Input.bitValue value := by + have hwire := inputStore_wire gate wires gate.input₁ + have hphysical : inputStore gate wires (gate.input₁ + wireBase) = + Input.bitValue value := by + rw [Nat.add_comm] + simpa [hvalue] using hwire + have haddress : addressed gate wires 4 = gate.input₁ + 11 := by + simpa [address1Reg, wireBase] using addressed_address1 gate wires + have hread : addressed gate wires (gate.input₁ + 11) = + Input.bitValue value := by + rw [addressed_apply_of_ne gate wires] + · simpa [wireBase] using hphysical + · simp [address0Reg] + · simp [address1Reg] + simp [loaded, loadOps, Basic.execList, Basic.exec, value0Reg, value1Reg, + address0Reg, address1Reg, haddress, hread] + +private theorem inputStore_op (gate : CircuitCode.RawGate) (wires : List Bool) : + inputStore gate wires opReg = Input.bitValue gate.opBit := by + simp [inputStore, opReg, negated0Reg, negated1Reg, address0Reg, address1Reg, + baseReg, Input.bitValue] + +private theorem inputStore_negated0 (gate : CircuitCode.RawGate) + (wires : List Bool) : + inputStore gate wires negated0Reg = Input.bitValue gate.negated₀ := by + simp [inputStore, opReg, negated0Reg, negated1Reg, address0Reg, address1Reg, + baseReg, Input.bitValue] + +private theorem inputStore_negated1 (gate : CircuitCode.RawGate) + (wires : List Bool) : + inputStore gate wires negated1Reg = Input.bitValue gate.negated₁ := by + simp [inputStore, opReg, negated0Reg, negated1Reg, address0Reg, address1Reg, + baseReg, Input.bitValue] + +private theorem address_measured (gate : CircuitCode.RawGate) (wires : List Bool) + (hgate : gate.WellFormedAt wires.length) : + MeasuredRuns (.basics addressOps) (inputStore gate wires) + (addressed gate wires) 2 (8 * width wires.length) + (resourceSpace wires.length) ∧ + StoreBound wires.length (addressed gate wires) := by + have hinitial := inputStore_bound gate wires hgate + have hfirst : StoreBound wires.length (addressed0 gate wires) := by + apply hinitial.execBasic (.add address0Reg address0Reg baseReg) + · simp [address0Reg, wireBase] + · have hinput := hgate.1 + simp [Internal.Basic.writeValue, inputStore, address0Reg, address1Reg, + baseReg, wireBase, opReg, negated0Reg, negated1Reg] + omega + have hfinal : StoreBound wires.length (addressed gate wires) := by + have heq : addressed gate wires = + (Basic.add address1Reg address1Reg baseReg).exec (addressed0 gate wires) := by + rfl + rw [heq] + apply hfirst.execBasic (.add address1Reg address1Reg baseReg) + · simp [address1Reg, wireBase] + · have hinput := hgate.2 + simp [Internal.Basic.writeValue, addressed0, Basic.exec, inputStore, + address0Reg, address1Reg, baseReg, wireBase, opReg, negated0Reg, + negated1Reg] + omega + have hrun0 := MeasuredRuns.basicEnvelope + (.add address0Reg address0Reg baseReg) (inputStore gate wires) hinitial hfirst + have hrun1 := MeasuredRuns.basicEnvelope + (.add address1Reg address1Reg baseReg) (addressed0 gate wires) hfirst (by + simpa only [addressed, addressOps, Basic.execList] using hfinal) + refine ⟨?_, hfinal⟩ + have hrun := hrun0.seq hrun1 + convert hrun using 1 + ring + +private theorem load_measured (gate : CircuitCode.RawGate) (wires : List Bool) + (hgate : gate.WellFormedAt wires.length) : + MeasuredRuns (.basics loadOps) (addressed gate wires) (loaded gate wires) + 2 (8 * width wires.length) (resourceSpace wires.length) ∧ + StoreBound wires.length (loaded gate wires) := by + have hinitial := (address_measured gate wires hgate).2 + have hfirst : StoreBound wires.length (loaded0 gate wires) := by + apply hinitial.execBasic (.load value0Reg address0Reg) + · simp [value0Reg, wireBase] + · simpa [Internal.Basic.writeValue] using + hinitial.value_le (addressed gate wires address0Reg) + have hfinal : StoreBound wires.length (loaded gate wires) := by + have heq : loaded gate wires = + (Basic.load value1Reg address1Reg).exec (loaded0 gate wires) := by rfl + rw [heq] + apply hfirst.execBasic (.load value1Reg address1Reg) + · simp [value1Reg, wireBase] + · simpa [Internal.Basic.writeValue] using + hfirst.value_le (loaded0 gate wires address1Reg) + have hrun0 := MeasuredRuns.basicEnvelope (.load value0Reg address0Reg) + (addressed gate wires) hinitial hfirst + have hrun1 := MeasuredRuns.basicEnvelope (.load value1Reg address1Reg) + (loaded0 gate wires) hfirst (by + simpa only [loaded, loadOps, Basic.execList] using hfinal) + refine ⟨?_, hfinal⟩ + have hrun := hrun0.seq hrun1 + convert hrun using 1 + ring + +private theorem negated0_measured (gate : CircuitCode.RawGate) (wires : List Bool) + (value : Bool) (hvalue : wires[gate.input₀]? = some value) + (hgate : gate.WellFormedAt wires.length) : + MeasuredRuns (.basics (xorOps value0Reg negated0Reg)) (loaded gate wires) + (negated0 gate wires) 4 (16 * width wires.length) + (resourceSpace wires.length) ∧ + StoreBound wires.length (negated0 gate wires) := by + have hinitial := (load_measured gate wires hgate).2 + have hvalueEq := loaded_value0 gate wires value hvalue + have hnegatedEq : loaded gate wires negated0Reg = + Input.bitValue gate.negated₀ := by + rw [show loaded gate wires negated0Reg = addressed gate wires negated0Reg by + simp [loaded, loadOps, Basic.execList, Basic.exec, negated0Reg, + value0Reg, value1Reg]] + rw [addressed_apply_of_ne gate wires] + · exact inputStore_negated0 gate wires + · simp [negated0Reg, address0Reg] + · simp [negated0Reg, address1Reg] + have hvalueEq' : loaded gate wires 6 = Input.bitValue value := by + simpa [value0Reg] using hvalueEq + have hnegatedEq' : loaded gate wires 1 = Input.bitValue gate.negated₀ := by + simpa [negated0Reg] using hnegatedEq + have hsum : StoreBound wires.length (negated0Sum gate wires) := by + apply hinitial.execBasic (.add outputReg value0Reg negated0Reg) + · simp [outputReg, wireBase] + · change loaded gate wires 6 + loaded gate wires 1 ≤ + wires.length + wireBase + 1 + rw [hvalueEq', hnegatedEq'] + cases value <;> cases gate.negated₀ <;> simp [wireBase] + have hproduct : StoreBound wires.length (negated0Product gate wires) := by + apply hsum.execBasic (.mul scratchReg value0Reg negated0Reg) + · simp [scratchReg, wireBase] + · change negated0Sum gate wires value0Reg * + negated0Sum gate wires negated0Reg ≤ wires.length + wireBase + 1 + simp [negated0Sum, Basic.exec, value0Reg, negated0Reg, outputReg, + hvalueEq', hnegatedEq'] + cases value <;> cases gate.negated₀ <;> simp [wireBase] + have htwice : StoreBound wires.length (negated0Twice gate wires) := by + apply hproduct.execBasic (.add scratchReg scratchReg scratchReg) + · simp [scratchReg, wireBase] + · change negated0Product gate wires scratchReg + + negated0Product gate wires scratchReg ≤ wires.length + wireBase + 1 + simp [negated0Product, negated0Sum, Basic.exec, value0Reg, negated0Reg, + outputReg, scratchReg, hvalueEq', hnegatedEq'] + cases value <;> cases gate.negated₀ <;> simp [wireBase] + have hfinal : StoreBound wires.length (negated0 gate wires) := by + have heq : negated0 gate wires = + (Basic.sub value0Reg outputReg scratchReg).exec + (negated0Twice gate wires) := by rfl + rw [heq] + apply htwice.execBasic (.sub value0Reg outputReg scratchReg) + · simp [value0Reg, wireBase] + · exact Nat.le_trans (Nat.sub_le _ _) (htwice.value_le outputReg) + have hrun0 := MeasuredRuns.basicEnvelope (.add outputReg value0Reg negated0Reg) + (loaded gate wires) hinitial hsum + have hrun1 := MeasuredRuns.basicEnvelope (.mul scratchReg value0Reg negated0Reg) + (negated0Sum gate wires) hsum hproduct + have hrun2 := MeasuredRuns.basicEnvelope (.add scratchReg scratchReg scratchReg) + (negated0Product gate wires) hproduct htwice + have hrun3 := MeasuredRuns.basicEnvelope (.sub value0Reg outputReg scratchReg) + (negated0Twice gate wires) htwice (by + simpa only [negated0, xorOps, Basic.execList] using hfinal) + refine ⟨?_, hfinal⟩ + have hrun := hrun0.seq (hrun1.seq (hrun2.seq hrun3)) + convert hrun using 1 + ring + +private theorem loaded_apply_of_ne (gate : CircuitCode.RawGate) (wires : List Bool) + (index : ℕ) (h0 : index ≠ value0Reg) (h1 : index ≠ value1Reg) + (ha0 : index ≠ address0Reg) (ha1 : index ≠ address1Reg) : + loaded gate wires index = inputStore gate wires index := by + rw [show loaded gate wires index = addressed gate wires index by + simp [loaded, loadOps, Basic.execList, Basic.exec, Function.update_of_ne, + h0, h1]] + exact addressed_apply_of_ne gate wires index ha0 ha1 + +private theorem negated0_value (gate : CircuitCode.RawGate) (wires : List Bool) + (value : Bool) (hvalue : wires[gate.input₀]? = some value) : + negated0 gate wires value0Reg = + Input.bitValue (gate.negated₀.xor value) := by + have hloadedValue := loaded_value0 gate wires value hvalue + have hloadedNegated : loaded gate wires negated0Reg = + Input.bitValue gate.negated₀ := by + rw [loaded_apply_of_ne gate wires] + · exact inputStore_negated0 gate wires + · simp [negated0Reg, value0Reg] + · simp [negated0Reg, value1Reg] + · simp [negated0Reg, address0Reg] + · simp [negated0Reg, address1Reg] + have hloadedValue' : loaded gate wires 6 = Input.bitValue value := by + simpa [value0Reg] using hloadedValue + have hloadedNegated' : loaded gate wires 1 = Input.bitValue gate.negated₀ := by + simpa [negated0Reg] using hloadedNegated + generalize hnegated : gate.negated₀ = negated + cases negated <;> cases value <;> + simp [negated0, xorOps, Basic.execList, Basic.exec, Input.bitValue, + value0Reg, outputReg, scratchReg, negated0Reg, hnegated, + hloadedValue', hloadedNegated'] + +private theorem negated0_apply_of_ne (gate : CircuitCode.RawGate) + (wires : List Bool) (index : ℕ) (hvalue : index ≠ value0Reg) + (houtput : index ≠ outputReg) (hscratch : index ≠ scratchReg) : + negated0 gate wires index = loaded gate wires index := by + simp [negated0, xorOps, Basic.execList, Basic.exec, Function.update_of_ne, + hvalue, houtput, hscratch] + +private theorem negated1_value (gate : CircuitCode.RawGate) (wires : List Bool) + (value : Bool) (hvalue : wires[gate.input₁]? = some value) : + negated1 gate wires value1Reg = + Input.bitValue (gate.negated₁.xor value) := by + have hloadedValue := loaded_value1 gate wires value hvalue + have hnegated0Value : negated0 gate wires value1Reg = Input.bitValue value := by + rw [negated0_apply_of_ne gate wires] + · exact hloadedValue + · simp [value0Reg, value1Reg] + · simp [value1Reg, outputReg] + · simp [value1Reg, scratchReg] + have hloadedNegated : loaded gate wires negated1Reg = + Input.bitValue gate.negated₁ := by + rw [loaded_apply_of_ne gate wires] + · exact inputStore_negated1 gate wires + · simp [negated1Reg, value0Reg] + · simp [negated1Reg, value1Reg] + · simp [negated1Reg, address0Reg] + · simp [negated1Reg, address1Reg] + have hnegatedBit : negated0 gate wires negated1Reg = + Input.bitValue gate.negated₁ := by + rw [negated0_apply_of_ne gate wires] + · exact hloadedNegated + · simp [negated1Reg, value0Reg] + · simp [negated1Reg, outputReg] + · simp [negated1Reg, scratchReg] + have hnegated0Value' : negated0 gate wires 7 = Input.bitValue value := by + simpa [value1Reg] using hnegated0Value + have hnegatedBit' : negated0 gate wires 2 = Input.bitValue gate.negated₁ := by + simpa [negated1Reg] using hnegatedBit + generalize hnegated : gate.negated₁ = negated + cases negated <;> cases value <;> + simp [negated1, xorOps, Basic.execList, Basic.exec, Input.bitValue, + value1Reg, outputReg, scratchReg, negated1Reg, hnegated, + hnegated0Value', hnegatedBit'] + +private theorem negated1_measured (gate : CircuitCode.RawGate) (wires : List Bool) + (value0 value1 : Bool) (hvalue0 : wires[gate.input₀]? = some value0) + (hvalue1 : wires[gate.input₁]? = some value1) + (hgate : gate.WellFormedAt wires.length) : + MeasuredRuns (.basics (xorOps value1Reg negated1Reg)) (negated0 gate wires) + (negated1 gate wires) 4 (16 * width wires.length) + (resourceSpace wires.length) ∧ + StoreBound wires.length (negated1 gate wires) := by + have hinitial := (negated0_measured gate wires value0 hvalue0 hgate).2 + have hloadedValue := loaded_value1 gate wires value1 hvalue1 + have hvalueEq : negated0 gate wires value1Reg = Input.bitValue value1 := by + rw [negated0_apply_of_ne gate wires] + · exact hloadedValue + · simp [value1Reg, value0Reg] + · simp [value1Reg, outputReg] + · simp [value1Reg, scratchReg] + have hloadedNegated : loaded gate wires negated1Reg = + Input.bitValue gate.negated₁ := by + rw [loaded_apply_of_ne gate wires] + · exact inputStore_negated1 gate wires + · simp [negated1Reg, value0Reg] + · simp [negated1Reg, value1Reg] + · simp [negated1Reg, address0Reg] + · simp [negated1Reg, address1Reg] + have hnegatedEq : negated0 gate wires negated1Reg = + Input.bitValue gate.negated₁ := by + rw [negated0_apply_of_ne gate wires] + · exact hloadedNegated + · simp [negated1Reg, value0Reg] + · simp [negated1Reg, outputReg] + · simp [negated1Reg, scratchReg] + have hvalueEq' : negated0 gate wires 7 = Input.bitValue value1 := by + simpa [value1Reg] using hvalueEq + have hnegatedEq' : negated0 gate wires 2 = Input.bitValue gate.negated₁ := by + simpa [negated1Reg] using hnegatedEq + have hsum : StoreBound wires.length (negated1Sum gate wires) := by + apply hinitial.execBasic (.add outputReg value1Reg negated1Reg) + · simp [outputReg, wireBase] + · change negated0 gate wires 7 + negated0 gate wires 2 ≤ + wires.length + wireBase + 1 + rw [hvalueEq', hnegatedEq'] + cases value1 <;> cases gate.negated₁ <;> simp [wireBase] + have hproduct : StoreBound wires.length (negated1Product gate wires) := by + apply hsum.execBasic (.mul scratchReg value1Reg negated1Reg) + · simp [scratchReg, wireBase] + · change negated1Sum gate wires value1Reg * + negated1Sum gate wires negated1Reg ≤ wires.length + wireBase + 1 + simp [negated1Sum, Basic.exec, value1Reg, negated1Reg, outputReg, + hvalueEq', hnegatedEq'] + cases value1 <;> cases gate.negated₁ <;> simp [wireBase] + have htwice : StoreBound wires.length (negated1Twice gate wires) := by + apply hproduct.execBasic (.add scratchReg scratchReg scratchReg) + · simp [scratchReg, wireBase] + · change negated1Product gate wires scratchReg + + negated1Product gate wires scratchReg ≤ wires.length + wireBase + 1 + simp [negated1Product, negated1Sum, Basic.exec, value1Reg, negated1Reg, + outputReg, scratchReg, hvalueEq', hnegatedEq'] + cases value1 <;> cases gate.negated₁ <;> simp [wireBase] + have hfinal : StoreBound wires.length (negated1 gate wires) := by + have heq : negated1 gate wires = + (Basic.sub value1Reg outputReg scratchReg).exec + (negated1Twice gate wires) := by rfl + rw [heq] + apply htwice.execBasic (.sub value1Reg outputReg scratchReg) + · simp [value1Reg, wireBase] + · exact Nat.le_trans (Nat.sub_le _ _) (htwice.value_le outputReg) + have hrun0 := MeasuredRuns.basicEnvelope (.add outputReg value1Reg negated1Reg) + (negated0 gate wires) hinitial hsum + have hrun1 := MeasuredRuns.basicEnvelope (.mul scratchReg value1Reg negated1Reg) + (negated1Sum gate wires) hsum hproduct + have hrun2 := MeasuredRuns.basicEnvelope (.add scratchReg scratchReg scratchReg) + (negated1Product gate wires) hproduct htwice + have hrun3 := MeasuredRuns.basicEnvelope (.sub value1Reg outputReg scratchReg) + (negated1Twice gate wires) htwice (by + simpa only [negated1, xorOps, Basic.execList] using hfinal) + refine ⟨?_, hfinal⟩ + have hrun := hrun0.seq (hrun1.seq (hrun2.seq hrun3)) + convert hrun using 1 + ring + +private theorem negated1_value0 (gate : CircuitCode.RawGate) (wires : List Bool) + (value : Bool) (hvalue : wires[gate.input₀]? = some value) : + negated1 gate wires value0Reg = + Input.bitValue (gate.negated₀.xor value) := by + rw [show negated1 gate wires value0Reg = negated0 gate wires value0Reg by + simp [negated1, xorOps, Basic.execList, Basic.exec, value0Reg, value1Reg, + outputReg, scratchReg]] + exact negated0_value gate wires value hvalue + +private theorem negated1_apply_of_ne (gate : CircuitCode.RawGate) + (wires : List Bool) (index : ℕ) (hvalue : index ≠ value1Reg) + (houtput : index ≠ outputReg) (hscratch : index ≠ scratchReg) : + negated1 gate wires index = negated0 gate wires index := by + simp [negated1, xorOps, Basic.execList, Basic.exec, Function.update_of_ne, + hvalue, houtput, hscratch] + +private theorem negated1_op (gate : CircuitCode.RawGate) (wires : List Bool) : + negated1 gate wires opReg = Input.bitValue gate.opBit := by + rw [negated1_apply_of_ne gate wires] + · rw [negated0_apply_of_ne gate wires] + · rw [loaded_apply_of_ne gate wires] + · exact inputStore_op gate wires + · simp [opReg, value0Reg] + · simp [opReg, value1Reg] + · simp [opReg, address0Reg] + · simp [opReg, address1Reg] + · simp [opReg, value0Reg] + · simp [opReg, outputReg] + · simp [opReg, scratchReg] + · simp [opReg, value1Reg] + · simp [opReg, outputReg] + · simp [opReg, scratchReg] + +private theorem evaluated_output (gate : CircuitCode.RawGate) (wires : List Bool) + (value0 value1 : Bool) (hvalue0 : wires[gate.input₀]? = some value0) + (hvalue1 : wires[gate.input₁]? = some value1) : + evaluated gate wires outputReg = Input.bitValue (gate.eval value0 value1) := by + have hvalue0' := negated1_value0 gate wires value0 hvalue0 + have hvalue1' := negated1_value gate wires value1 hvalue1 + have hop := negated1_op gate wires + have hvalue0'' : negated1 gate wires 6 = + Input.bitValue (gate.negated₀.xor value0) := by + simpa [value0Reg] using hvalue0' + have hvalue1'' : negated1 gate wires 7 = + Input.bitValue (gate.negated₁.xor value1) := by + simpa [value1Reg] using hvalue1' + have hop' : negated1 gate wires 0 = Input.bitValue gate.opBit := by + simpa [opReg] using hop + rcases gate with ⟨op, input0, input1, negated0, negated1⟩ + cases op <;> cases negated0 <;> cases negated1 <;> + cases value0 <;> cases value1 <;> + simp [evaluated, evalOps, Basic.execList, Basic.exec, Input.bitValue, + CircuitCode.RawGate.eval, CircuitCode.RawGate.opBit, opReg, value0Reg, + value1Reg, outputReg, scratchReg, address0Reg, hvalue0'', hvalue1'', hop'] + +private theorem eval_measured (gate : CircuitCode.RawGate) (wires : List Bool) + (value0 value1 : Bool) (hvalue0 : wires[gate.input₀]? = some value0) + (hvalue1 : wires[gate.input₁]? = some value1) + (hgate : gate.WellFormedAt wires.length) : + MeasuredRuns (.basics evalOps) (negated1 gate wires) (evaluated gate wires) + 6 (24 * width wires.length) (resourceSpace wires.length) ∧ + StoreBound wires.length (evaluated gate wires) := by + have hinitial := + (negated1_measured gate wires value0 value1 hvalue0 hvalue1 hgate).2 + have hvalue0Eq := negated1_value0 gate wires value0 hvalue0 + have hvalue1Eq := negated1_value gate wires value1 hvalue1 + have hopEq := negated1_op gate wires + have hvalue0Eq' : negated1 gate wires 6 = + Input.bitValue (gate.negated₀.xor value0) := by + simpa [value0Reg] using hvalue0Eq + have hvalue1Eq' : negated1 gate wires 7 = + Input.bitValue (gate.negated₁.xor value1) := by + simpa [value1Reg] using hvalue1Eq + have hopEq' : negated1 gate wires 0 = Input.bitValue gate.opBit := by + simpa [opReg] using hopEq + have hproduct : StoreBound wires.length (evalProduct gate wires) := by + apply hinitial.execBasic (.mul scratchReg value0Reg value1Reg) + · simp [scratchReg, wireBase] + · change negated1 gate wires value0Reg * negated1 gate wires value1Reg ≤ + wires.length + wireBase + 1 + rw [hvalue0Eq, hvalue1Eq] + cases gate.negated₀ <;> cases gate.negated₁ <;> + cases value0 <;> cases value1 <;> simp [wireBase] + have hsum : StoreBound wires.length (evalSum gate wires) := by + apply hproduct.execBasic (.add outputReg value0Reg value1Reg) + · simp [outputReg, wireBase] + · change evalProduct gate wires value0Reg + evalProduct gate wires value1Reg ≤ + wires.length + wireBase + 1 + simp [evalProduct, Basic.exec, value0Reg, value1Reg, scratchReg, + hvalue0Eq', hvalue1Eq'] + cases gate.negated₀ <;> cases gate.negated₁ <;> + cases value0 <;> cases value1 <;> simp [wireBase] + have hsumOutput : evalSum gate wires outputReg ≤ 2 := by + simp [evalSum, evalProduct, Basic.exec, outputReg, value0Reg, value1Reg, + scratchReg, hvalue0Eq', hvalue1Eq'] + cases gate.negated₀ <;> cases gate.negated₁ <;> + cases value0 <;> cases value1 <;> simp + have hor : StoreBound wires.length (evalOr gate wires) := by + apply hsum.execBasic (.sub outputReg outputReg scratchReg) + · simp [outputReg, wireBase] + · exact le_trans (Nat.sub_le _ _) (le_trans hsumOutput (by simp [wireBase])) + have horOutput : evalOr gate wires outputReg ≤ 2 := by + exact le_trans (Nat.sub_le _ _) hsumOutput + have hdelta : StoreBound wires.length (evalDelta gate wires) := by + apply hor.execBasic (.sub address0Reg outputReg scratchReg) + · simp [address0Reg, wireBase] + · exact le_trans (Nat.sub_le _ _) (le_trans horOutput (by simp [wireBase])) + have hdeltaValue : evalDelta gate wires address0Reg ≤ 2 := by + exact le_trans (Nat.sub_le _ _) horOutput + have hselected : StoreBound wires.length (evalSelected gate wires) := by + apply hdelta.execBasic (.mul address0Reg opReg address0Reg) + · simp [address0Reg, wireBase] + · have hop : evalDelta gate wires opReg = Input.bitValue gate.opBit := by + simp [evalDelta, evalOr, evalSum, evalProduct, Basic.exec, opReg, + address0Reg, outputReg, scratchReg, value0Reg, value1Reg, hopEq'] + change evalDelta gate wires opReg * evalDelta gate wires address0Reg ≤ + wires.length + wireBase + 1 + rw [hop] + cases gate.opBit <;> simp [Input.bitValue] + exact le_trans hdeltaValue (by simp [wireBase]) + have hfinal : StoreBound wires.length (evaluated gate wires) := by + have heq : evaluated gate wires = + (Basic.sub outputReg outputReg address0Reg).exec + (evalSelected gate wires) := by rfl + rw [heq] + apply hselected.execBasic (.sub outputReg outputReg address0Reg) + · simp [outputReg, wireBase] + · exact Nat.le_trans (Nat.sub_le _ _) (hselected.value_le outputReg) + have hrun0 := MeasuredRuns.basicEnvelope (.mul scratchReg value0Reg value1Reg) + (negated1 gate wires) hinitial hproduct + have hrun1 := MeasuredRuns.basicEnvelope (.add outputReg value0Reg value1Reg) + (evalProduct gate wires) hproduct hsum + have hrun2 := MeasuredRuns.basicEnvelope (.sub outputReg outputReg scratchReg) + (evalSum gate wires) hsum hor + have hrun3 := MeasuredRuns.basicEnvelope (.sub address0Reg outputReg scratchReg) + (evalOr gate wires) hor hdelta + have hrun4 := MeasuredRuns.basicEnvelope (.mul address0Reg opReg address0Reg) + (evalDelta gate wires) hdelta hselected + have hrun5 := MeasuredRuns.basicEnvelope (.sub outputReg outputReg address0Reg) + (evalSelected gate wires) hselected (by + simpa only [evaluated, evalOps, Basic.execList] using hfinal) + refine ⟨?_, hfinal⟩ + have hrun := hrun0.seq (hrun1.seq (hrun2.seq (hrun3.seq (hrun4.seq hrun5)))) + convert hrun using 1 + ring + +private theorem evaluated_apply_of_ne (gate : CircuitCode.RawGate) + (wires : List Bool) (index : ℕ) (haddress : index ≠ address0Reg) + (houtput : index ≠ outputReg) (hscratch : index ≠ scratchReg) : + evaluated gate wires index = negated1 gate wires index := by + simp [evaluated, evalOps, Basic.execList, Basic.exec, Function.update_of_ne, + haddress, houtput, hscratch] + +private theorem inputStore_wireCount (gate : CircuitCode.RawGate) + (wires : List Bool) : inputStore gate wires wireCountReg = wires.length := by + simp [inputStore, opReg, negated0Reg, negated1Reg, address0Reg, address1Reg, + wireCountReg, baseReg, wireBase, Input.bitStore] + +private theorem inputStore_base (gate : CircuitCode.RawGate) (wires : List Bool) : + inputStore gate wires baseReg = wireBase := by + simp [inputStore, baseReg] + +private theorem evaluated_stable (gate : CircuitCode.RawGate) (wires : List Bool) + (index : ℕ) (ha0 : index ≠ address0Reg) (ha1 : index ≠ address1Reg) + (hv0 : index ≠ value0Reg) (hv1 : index ≠ value1Reg) + (hout : index ≠ outputReg) (hscratch : index ≠ scratchReg) : + evaluated gate wires index = inputStore gate wires index := by + rw [evaluated_apply_of_ne gate wires index ha0 hout hscratch] + rw [negated1_apply_of_ne gate wires index hv1 hout hscratch] + rw [negated0_apply_of_ne gate wires index hv0 hout hscratch] + exact loaded_apply_of_ne gate wires index hv0 hv1 ha0 ha1 + +private theorem evaluated_wireCount (gate : CircuitCode.RawGate) + (wires : List Bool) : evaluated gate wires wireCountReg = wires.length := by + rw [evaluated_stable gate wires] + · exact inputStore_wireCount gate wires + · simp [wireCountReg, address0Reg] + · simp [wireCountReg, address1Reg] + · simp [wireCountReg, value0Reg] + · simp [wireCountReg, value1Reg] + · simp [wireCountReg, outputReg] + · simp [wireCountReg, scratchReg] + +private theorem evaluated_base (gate : CircuitCode.RawGate) (wires : List Bool) : + evaluated gate wires baseReg = wireBase := by + rw [evaluated_stable gate wires] + · exact inputStore_base gate wires + · simp [baseReg, address0Reg] + · simp [baseReg, address1Reg] + · simp [baseReg, value0Reg] + · simp [baseReg, value1Reg] + · simp [baseReg, outputReg] + · simp [baseReg, scratchReg] + +private theorem finalStore_output (gate : CircuitCode.RawGate) (wires : List Bool) + (value0 value1 : Bool) (hvalue0 : wires[gate.input₀]? = some value0) + (hvalue1 : wires[gate.input₁]? = some value1) : + finalStore gate wires outputReg = Input.bitValue (gate.eval value0 value1) := by + have houtput := evaluated_output gate wires value0 value1 hvalue0 hvalue1 + have hcount := evaluated_wireCount gate wires + have hbase := evaluated_base gate wires + have houtput' : evaluated gate wires 8 = Input.bitValue (gate.eval value0 value1) := by + simpa [outputReg] using houtput + have hcount' : evaluated gate wires 5 = wires.length := by + simpa [wireCountReg] using hcount + have hbase' : evaluated gate wires 10 = 11 := by + simpa [baseReg, wireBase] using hbase + have happendAddress : appendAddressed gate wires 4 = 11 + wires.length := by + simp [appendAddressed, Basic.exec, address1Reg, baseReg, wireCountReg, + hcount', hbase'] + have happendOutput : appendAddressed gate wires 8 = + Input.bitValue (gate.eval value0 value1) := by + simpa [appendAddressed, Basic.exec, address1Reg, outputReg] using houtput' + rw [finalStore, Basic.exec] + change Function.update (appendAddressed gate wires) + (appendAddressed gate wires 4) (appendAddressed gate wires 8) 8 = _ + rw [happendAddress, happendOutput] + rw [Function.update_of_ne (by omega : 8 ≠ 11 + wires.length)] + exact happendOutput + +private theorem finalStore_appended (gate : CircuitCode.RawGate) (wires : List Bool) + (value0 value1 : Bool) (hvalue0 : wires[gate.input₀]? = some value0) + (hvalue1 : wires[gate.input₁]? = some value1) : + finalStore gate wires (wireBase + wires.length) = + Input.bitValue (gate.eval value0 value1) := by + have houtput := evaluated_output gate wires value0 value1 hvalue0 hvalue1 + have hbase' : evaluated gate wires 10 = 11 := by + simpa [baseReg, wireBase] using evaluated_base gate wires + have hcount' : evaluated gate wires 5 = wires.length := by + simpa [wireCountReg] using evaluated_wireCount gate wires + have haddress : appendAddressed gate wires address1Reg = + wireBase + wires.length := by + simp [appendAddressed, Basic.exec, address1Reg, baseReg, wireCountReg] + rw [hbase', hcount'] + simp [wireBase, Nat.add_comm] + have hsource : appendAddressed gate wires outputReg = + Input.bitValue (gate.eval value0 value1) := by + simpa [appendAddressed, Basic.exec, address1Reg, outputReg] using houtput + rw [finalStore, Basic.exec] + change Function.update (appendAddressed gate wires) + (appendAddressed gate wires address1Reg) + (appendAddressed gate wires outputReg) (wireBase + wires.length) = _ + rw [haddress, hsource, Function.update_self] + +private theorem finalStore_wire (gate : CircuitCode.RawGate) (wires : List Bool) + (index : ℕ) (hindex : index < wires.length) : + finalStore gate wires (wireBase + index) = Input.bitValue wires[index] := by + have hbase' : evaluated gate wires 10 = 11 := by + simpa [baseReg, wireBase] using evaluated_base gate wires + have hcount' : evaluated gate wires 5 = wires.length := by + simpa [wireCountReg] using evaluated_wireCount gate wires + have haddress : appendAddressed gate wires address1Reg = + wireBase + wires.length := by + simp [appendAddressed, Basic.exec, address1Reg, baseReg, wireCountReg] + rw [hbase', hcount'] + simp [wireBase, Nat.add_comm] + have hne : wireBase + index ≠ wireBase + wires.length := by omega + rw [finalStore, Basic.exec] + change Function.update (appendAddressed gate wires) + (appendAddressed gate wires address1Reg) + (appendAddressed gate wires outputReg) (wireBase + index) = _ + rw [haddress, Function.update_of_ne hne] + have happend : appendAddressed gate wires (wireBase + index) = + evaluated gate wires (wireBase + index) := by + rw [appendAddressed, Basic.exec] + simp only [wireBase, address1Reg] + rw [Function.update_of_ne (by omega : 11 + index ≠ 4)] + rw [happend] + rw [evaluated_stable gate wires] + · have hwire := inputStore_wire gate wires index + rw [List.getElem?_eq_getElem hindex] at hwire + exact hwire + all_goals simp only [wireBase, address0Reg, address1Reg, value0Reg, value1Reg, + outputReg, scratchReg] + all_goals omega + +private theorem append_measured (gate : CircuitCode.RawGate) (wires : List Bool) + (value0 value1 : Bool) (hvalue0 : wires[gate.input₀]? = some value0) + (hvalue1 : wires[gate.input₁]? = some value1) + (hgate : gate.WellFormedAt wires.length) : + MeasuredRuns (.basics appendOps) (evaluated gate wires) (finalStore gate wires) + 2 (8 * width wires.length) (resourceSpace wires.length) ∧ + StoreBound wires.length (finalStore gate wires) := by + have hinitial := (eval_measured gate wires value0 value1 hvalue0 hvalue1 hgate).2 + have hfirst : StoreBound wires.length (appendAddressed gate wires) := by + apply hinitial.execBasic (.add address1Reg baseReg wireCountReg) + · simp [address1Reg, wireBase] + · change evaluated gate wires baseReg + evaluated gate wires wireCountReg ≤ + wires.length + wireBase + 1 + rw [evaluated_base, evaluated_wireCount] + omega + have hbase' : evaluated gate wires 10 = 11 := by + simpa [baseReg, wireBase] using evaluated_base gate wires + have hcount' : evaluated gate wires 5 = wires.length := by + simpa [wireCountReg] using evaluated_wireCount gate wires + have hfinal : StoreBound wires.length (finalStore gate wires) := by + apply hfirst.execBasic (.store address1Reg outputReg) + · change appendAddressed gate wires address1Reg < + wires.length + wireBase + 1 + change evaluated gate wires 10 + evaluated gate wires 5 < + wires.length + wireBase + 1 + rw [hbase', hcount'] + simp [wireBase] + omega + · exact hfirst.value_le outputReg + have hrun0 := MeasuredRuns.basicEnvelope (.add address1Reg baseReg wireCountReg) + (evaluated gate wires) hinitial hfirst + have hrun1 := MeasuredRuns.basicEnvelope (.store address1Reg outputReg) + (appendAddressed gate wires) hfirst hfinal + refine ⟨?_, hfinal⟩ + have hrun := hrun0.seq hrun1 + convert hrun using 1 + ring + +private theorem routineAddressed_address0 {base : ℕ} {gate : CircuitCode.RawGate} + {wires : List Bool} {store : Store} (hready : ReadyAt base gate wires store) : + routineAddressed store address0Reg = gate.input₀ + base := by + change store address0Reg + store baseReg = gate.input₀ + base + rw [hready.address0_eq, hready.base_eq] + +private theorem routineAddressed_address1 {base : ℕ} {gate : CircuitCode.RawGate} + {wires : List Bool} {store : Store} (hready : ReadyAt base gate wires store) : + routineAddressed store address1Reg = gate.input₁ + base := by + change store address1Reg + store baseReg = gate.input₁ + base + rw [hready.address1_eq, hready.base_eq] + +private theorem routineAddressed_apply_of_ne (store : Store) (index : ℕ) + (h0 : index ≠ address0Reg) (h1 : index ≠ address1Reg) : + routineAddressed store index = store index := by + simp [routineAddressed, addressOps, Basic.execList, Basic.exec, + Function.update_of_ne, h0, h1] + +private theorem routineLoaded_value0 {base : ℕ} {gate : CircuitCode.RawGate} + {wires : List Bool} {store : Store} (hready : ReadyAt base gate wires store) + (value : Bool) (hvalue : wires[gate.input₀]? = some value) : + routineLoaded store value0Reg = Input.bitValue value := by + have hindex := List.getElem?_eq_some_iff.mp hvalue |>.1 + have hread := hready.wire_eq gate.input₀ hindex + simp [hvalue] at hread + have haddress := routineAddressed_address0 hready + have hbase : wireBase ≤ base := hready.base_ge + have hphysical : routineAddressed store (gate.input₀ + base) = + Input.bitValue value := by + rw [routineAddressed_apply_of_ne] + · simpa [Nat.add_comm] using hread + · simp only [address0Reg, wireBase] at hbase ⊢ + omega + · simp only [address1Reg, wireBase] at hbase ⊢ + omega + have haddress' : routineAddressed store 3 = gate.input₀ + base := by + simpa [address0Reg] using haddress + have hphysical' : routineAddressed store (gate.input₀ + base) = + Input.bitValue value := hphysical + simp [routineLoaded, loadOps, Basic.execList, Basic.exec, value0Reg, + value1Reg, address0Reg, address1Reg, haddress', hphysical'] + +private theorem routineLoaded_value1 {base : ℕ} {gate : CircuitCode.RawGate} + {wires : List Bool} {store : Store} (hready : ReadyAt base gate wires store) + (value : Bool) (hvalue : wires[gate.input₁]? = some value) : + routineLoaded store value1Reg = Input.bitValue value := by + have hindex := List.getElem?_eq_some_iff.mp hvalue |>.1 + have hread := hready.wire_eq gate.input₁ hindex + simp [hvalue] at hread + have haddress := routineAddressed_address1 hready + have hbase : wireBase ≤ base := hready.base_ge + have hphysical : routineAddressed store (gate.input₁ + base) = + Input.bitValue value := by + rw [routineAddressed_apply_of_ne] + · simpa [Nat.add_comm] using hread + · simp only [address0Reg, wireBase] at hbase ⊢ + omega + · simp only [address1Reg, wireBase] at hbase ⊢ + omega + have haddress' : routineAddressed store 4 = gate.input₁ + base := by + simpa [address1Reg] using haddress + have hphysical' : routineAddressed store (gate.input₁ + base) = + Input.bitValue value := hphysical + let after0 := (Basic.load value0Reg address0Reg).exec (routineAddressed store) + have hafterAddress : after0 address1Reg = gate.input₁ + base := by + simp [after0, Basic.exec, value0Reg, address1Reg, haddress'] + have hafterPhysical : after0 (gate.input₁ + base) = Input.bitValue value := by + have hne : gate.input₁ + base ≠ value0Reg := by + simp only [value0Reg, wireBase] at hbase ⊢ + omega + simp [after0, Basic.exec, Function.update_of_ne hne, hphysical'] + change (Basic.load value1Reg address1Reg).exec after0 value1Reg = + Input.bitValue value + simp [Basic.exec, hafterAddress, hafterPhysical] + +private theorem routineLoaded_apply_of_ne (store : Store) (index : ℕ) + (h0 : index ≠ value0Reg) (h1 : index ≠ value1Reg) + (ha0 : index ≠ address0Reg) (ha1 : index ≠ address1Reg) : + routineLoaded store index = store index := by + rw [show routineLoaded store index = routineAddressed store index by + simp [routineLoaded, loadOps, Basic.execList, Basic.exec, + Function.update_of_ne, h0, h1]] + exact routineAddressed_apply_of_ne store index ha0 ha1 + +private theorem xor_measured {bound value negated : ℕ} {store : Store} + (hstore : StoreEnvelope bound bound store) (hbound : 2 ≤ bound) + (hvalue : value < bound) (houtput : outputReg < bound) + (hscratch : scratchReg < bound) + (hvalueOutput : value ≠ outputReg) + (hnegatedOutput : negated ≠ outputReg) + (valueBit negatedBit : Bool) + (hvalueEq : store value = Input.bitValue valueBit) + (hnegatedEq : store negated = Input.bitValue negatedBit) : + MeasuredRuns (.basics (xorOps value negated)) store + (Basic.execList (xorOps value negated) store) 4 + (16 * valueWidth bound) (envelopeSpace bound bound) ∧ + StoreEnvelope bound bound (Basic.execList (xorOps value negated) store) := by + let sum := (Basic.add outputReg value negated).exec store + let product := (Basic.mul scratchReg value negated).exec sum + let twice := (Basic.add scratchReg scratchReg scratchReg).exec product + have hsum : StoreEnvelope bound bound sum := by + apply hstore.execBasic (.add outputReg value negated) + · exact houtput + · change store value + store negated ≤ bound + rw [hvalueEq, hnegatedEq] + cases valueBit <;> cases negatedBit <;> simp [Input.bitValue] <;> omega + have hproduct : StoreEnvelope bound bound product := by + apply hsum.execBasic (.mul scratchReg value negated) + · exact hscratch + · change sum value * sum negated ≤ bound + cases valueBit <;> cases negatedBit <;> + simp [sum, Basic.exec, Function.update_of_ne, hvalueOutput, + hnegatedOutput, hvalueEq, hnegatedEq, Input.bitValue] + all_goals omega + have htwice : StoreEnvelope bound bound twice := by + apply hproduct.execBasic (.add scratchReg scratchReg scratchReg) + · exact hscratch + · change product scratchReg + product scratchReg ≤ bound + cases valueBit <;> cases negatedBit <;> + simp [product, sum, Basic.exec, Function.update_of_ne, + hvalueOutput, hnegatedOutput, hvalueEq, hnegatedEq, + Input.bitValue] + all_goals omega + have hfinal : StoreEnvelope bound bound + (Basic.execList (xorOps value negated) store) := by + change StoreEnvelope bound bound + ((Basic.sub value outputReg scratchReg).exec twice) + apply htwice.execBasic (.sub value outputReg scratchReg) + · exact hvalue + · exact le_trans (Nat.sub_le _ _) (htwice.value_le outputReg) + have hrun0 := MeasuredRuns.basicEnvelope (.add outputReg value negated) + store hstore hsum + have hrun1 := MeasuredRuns.basicEnvelope (.mul scratchReg value negated) + sum hsum hproduct + have hrun2 := MeasuredRuns.basicEnvelope (.add scratchReg scratchReg scratchReg) + product hproduct htwice + have hrun3 := MeasuredRuns.basicEnvelope (.sub value outputReg scratchReg) + twice htwice hfinal + refine ⟨?_, hfinal⟩ + have hrun := hrun0.seq (hrun1.seq (hrun2.seq hrun3)) + convert hrun using 1 + ring + +private theorem routineNegated0_value {base : ℕ} {gate : CircuitCode.RawGate} + {wires : List Bool} {store : Store} (hready : ReadyAt base gate wires store) + (value : Bool) (hvalue : wires[gate.input₀]? = some value) : + routineNegated0 store value0Reg = + Input.bitValue (gate.negated₀.xor value) := by + have hloadedValue := routineLoaded_value0 hready value hvalue + have hloadedNegated : routineLoaded store negated0Reg = + Input.bitValue gate.negated₀ := by + rw [routineLoaded_apply_of_ne] + · exact hready.negated0_eq + · simp [negated0Reg, value0Reg] + · simp [negated0Reg, value1Reg] + · simp [negated0Reg, address0Reg] + · simp [negated0Reg, address1Reg] + have hloadedValue' : routineLoaded store 6 = Input.bitValue value := by + simpa [value0Reg] using hloadedValue + have hloadedNegated' : routineLoaded store 1 = + Input.bitValue gate.negated₀ := by + simpa [negated0Reg] using hloadedNegated + generalize hnegated : gate.negated₀ = negated + cases negated <;> cases value <;> + simp [routineNegated0, xorOps, Basic.execList, Basic.exec, Input.bitValue, + value0Reg, outputReg, scratchReg, negated0Reg, hnegated, + hloadedValue', hloadedNegated'] + +private theorem routineNegated0_apply_of_ne (store : Store) (index : ℕ) + (hvalue : index ≠ value0Reg) (houtput : index ≠ outputReg) + (hscratch : index ≠ scratchReg) : + routineNegated0 store index = routineLoaded store index := by + simp [routineNegated0, xorOps, Basic.execList, Basic.exec, + Function.update_of_ne, hvalue, houtput, hscratch] + +private theorem routineNegated1_value {base : ℕ} {gate : CircuitCode.RawGate} + {wires : List Bool} {store : Store} (hready : ReadyAt base gate wires store) + (value : Bool) (hvalue : wires[gate.input₁]? = some value) : + routineNegated1 store value1Reg = + Input.bitValue (gate.negated₁.xor value) := by + have hloadedValue := routineLoaded_value1 hready value hvalue + have hnegated0Value : routineNegated0 store value1Reg = Input.bitValue value := by + rw [routineNegated0_apply_of_ne] + · exact hloadedValue + · simp [value0Reg, value1Reg] + · simp [value1Reg, outputReg] + · simp [value1Reg, scratchReg] + have hloadedNegated : routineLoaded store negated1Reg = + Input.bitValue gate.negated₁ := by + rw [routineLoaded_apply_of_ne] + · exact hready.negated1_eq + · simp [negated1Reg, value0Reg] + · simp [negated1Reg, value1Reg] + · simp [negated1Reg, address0Reg] + · simp [negated1Reg, address1Reg] + have hnegatedBit : routineNegated0 store negated1Reg = + Input.bitValue gate.negated₁ := by + rw [routineNegated0_apply_of_ne] + · exact hloadedNegated + · simp [negated1Reg, value0Reg] + · simp [negated1Reg, outputReg] + · simp [negated1Reg, scratchReg] + have hvalue' : routineNegated0 store 7 = Input.bitValue value := by + simpa [value1Reg] using hnegated0Value + have hnegated' : routineNegated0 store 2 = Input.bitValue gate.negated₁ := by + simpa [negated1Reg] using hnegatedBit + generalize hnegatedEq : gate.negated₁ = negated + cases negated <;> cases value <;> + simp [routineNegated1, xorOps, Basic.execList, Basic.exec, Input.bitValue, + value1Reg, outputReg, scratchReg, negated1Reg, hnegatedEq, + hvalue', hnegated'] + +private theorem routineNegated1_apply_of_ne (store : Store) (index : ℕ) + (hvalue : index ≠ value1Reg) (houtput : index ≠ outputReg) + (hscratch : index ≠ scratchReg) : + routineNegated1 store index = routineNegated0 store index := by + simp [routineNegated1, xorOps, Basic.execList, Basic.exec, + Function.update_of_ne, hvalue, houtput, hscratch] + +private theorem routineNegated1_value0 {base : ℕ} {gate : CircuitCode.RawGate} + {wires : List Bool} {store : Store} (hready : ReadyAt base gate wires store) + (value : Bool) (hvalue : wires[gate.input₀]? = some value) : + routineNegated1 store value0Reg = + Input.bitValue (gate.negated₀.xor value) := by + rw [routineNegated1_apply_of_ne] + · exact routineNegated0_value hready value hvalue + · simp [value0Reg, value1Reg] + · simp [value0Reg, outputReg] + · simp [value0Reg, scratchReg] + +private theorem routineNegated1_op {base : ℕ} {gate : CircuitCode.RawGate} + {wires : List Bool} {store : Store} (hready : ReadyAt base gate wires store) : + routineNegated1 store opReg = Input.bitValue gate.opBit := by + rw [routineNegated1_apply_of_ne] + · rw [routineNegated0_apply_of_ne] + · rw [routineLoaded_apply_of_ne] + · exact hready.op_eq + · simp [opReg, value0Reg] + · simp [opReg, value1Reg] + · simp [opReg, address0Reg] + · simp [opReg, address1Reg] + · simp [opReg, value0Reg] + · simp [opReg, outputReg] + · simp [opReg, scratchReg] + · simp [opReg, value1Reg] + · simp [opReg, outputReg] + · simp [opReg, scratchReg] + +private theorem routineEvaluated_output {base : ℕ} {gate : CircuitCode.RawGate} + {wires : List Bool} {store : Store} (hready : ReadyAt base gate wires store) + (value0 value1 : Bool) (hvalue0 : wires[gate.input₀]? = some value0) + (hvalue1 : wires[gate.input₁]? = some value1) : + routineEvaluated store outputReg = + Input.bitValue (gate.eval value0 value1) := by + have hvalue0' := routineNegated1_value0 hready value0 hvalue0 + have hvalue1' := routineNegated1_value hready value1 hvalue1 + have hop := routineNegated1_op hready + have hvalue0'' : routineNegated1 store 6 = + Input.bitValue (gate.negated₀.xor value0) := by + simpa [value0Reg] using hvalue0' + have hvalue1'' : routineNegated1 store 7 = + Input.bitValue (gate.negated₁.xor value1) := by + simpa [value1Reg] using hvalue1' + have hop' : routineNegated1 store 0 = Input.bitValue gate.opBit := by + simpa [opReg] using hop + rcases gate with ⟨op, input0, input1, negated0, negated1⟩ + cases op <;> cases negated0 <;> cases negated1 <;> + cases value0 <;> cases value1 <;> + simp [routineEvaluated, evalOps, Basic.execList, Basic.exec, Input.bitValue, + CircuitCode.RawGate.eval, CircuitCode.RawGate.opBit, opReg, value0Reg, + value1Reg, outputReg, scratchReg, address0Reg, hvalue0'', hvalue1'', hop'] + +private theorem routineEvaluated_stable (store : Store) (index : ℕ) + (ha0 : index ≠ address0Reg) (ha1 : index ≠ address1Reg) + (hv0 : index ≠ value0Reg) (hv1 : index ≠ value1Reg) + (hout : index ≠ outputReg) (hscratch : index ≠ scratchReg) : + routineEvaluated store index = store index := by + rw [show routineEvaluated store index = routineNegated1 store index by + simp [routineEvaluated, evalOps, Basic.execList, Basic.exec, + Function.update_of_ne, ha0, hout, hscratch]] + rw [routineNegated1_apply_of_ne store index hv1 hout hscratch] + rw [routineNegated0_apply_of_ne store index hv0 hout hscratch] + exact routineLoaded_apply_of_ne store index hv0 hv1 ha0 ha1 + +private theorem routineEvaluated_wireCount {base : ℕ} + {gate : CircuitCode.RawGate} {wires : List Bool} {store : Store} + (hready : ReadyAt base gate wires store) : + routineEvaluated store wireCountReg = wires.length := by + rw [routineEvaluated_stable] + · exact hready.wireCount_eq + all_goals simp [wireCountReg, address0Reg, address1Reg, value0Reg, value1Reg, + outputReg, scratchReg] + +private theorem routineEvaluated_base {base : ℕ} {gate : CircuitCode.RawGate} + {wires : List Bool} {store : Store} (hready : ReadyAt base gate wires store) : + routineEvaluated store baseReg = base := by + rw [routineEvaluated_stable] + · exact hready.base_eq + all_goals simp [baseReg, address0Reg, address1Reg, value0Reg, value1Reg, + outputReg, scratchReg] + +private theorem routineEvaluated_wire {base : ℕ} {gate : CircuitCode.RawGate} + {wires : List Bool} {store : Store} (hready : ReadyAt base gate wires store) + (index : ℕ) (hindex : index < wires.length) : + routineEvaluated store (base + index) = + match wires[index]? with + | some bit => Input.bitValue bit + | none => 0 := by + rw [routineEvaluated_stable] + · exact hready.wire_eq index hindex + all_goals have hbase := hready.base_ge + all_goals simp only [wireBase, address0Reg, address1Reg, value0Reg, value1Reg, + outputReg, scratchReg] at hbase ⊢ + all_goals omega + +private theorem routineFinal_output {base : ℕ} {gate : CircuitCode.RawGate} + {wires : List Bool} {store : Store} (hready : ReadyAt base gate wires store) + (value0 value1 : Bool) (hvalue0 : wires[gate.input₀]? = some value0) + (hvalue1 : wires[gate.input₁]? = some value1) : + routineFinal store outputReg = Input.bitValue (gate.eval value0 value1) := by + have houtput := routineEvaluated_output hready value0 value1 hvalue0 hvalue1 + have hbase := routineEvaluated_base hready + have hcount := routineEvaluated_wireCount hready + have hbase' : routineEvaluated store 10 = base := by + simpa [baseReg] using hbase + have hcount' : routineEvaluated store 5 = wires.length := by + simpa [wireCountReg] using hcount + let addressed := + (Basic.add address1Reg baseReg wireCountReg).exec (routineEvaluated store) + have haddress : addressed address1Reg = base + wires.length := by + simp [addressed, Basic.exec, address1Reg, baseReg, wireCountReg, + hbase', hcount'] + have hsource : addressed outputReg = + Input.bitValue (gate.eval value0 value1) := by + simpa [addressed, Basic.exec, address1Reg, outputReg] using houtput + rw [routineFinal, appendOps, Basic.execList] + change Function.update addressed (addressed address1Reg) + (addressed outputReg) outputReg = _ + rw [haddress, hsource, Function.update_of_ne] + · exact hsource + · have hbaseGe := hready.base_ge + simp only [outputReg, wireBase] at hbaseGe ⊢ + omega + +private theorem routineFinal_appended {base : ℕ} {gate : CircuitCode.RawGate} + {wires : List Bool} {store : Store} (hready : ReadyAt base gate wires store) + (value0 value1 : Bool) (hvalue0 : wires[gate.input₀]? = some value0) + (hvalue1 : wires[gate.input₁]? = some value1) : + routineFinal store (base + wires.length) = + Input.bitValue (gate.eval value0 value1) := by + have houtput := routineEvaluated_output hready value0 value1 hvalue0 hvalue1 + have hbase := routineEvaluated_base hready + have hcount := routineEvaluated_wireCount hready + have hbase' : routineEvaluated store 10 = base := by + simpa [baseReg] using hbase + have hcount' : routineEvaluated store 5 = wires.length := by + simpa [wireCountReg] using hcount + let addressed := + (Basic.add address1Reg baseReg wireCountReg).exec (routineEvaluated store) + have haddress : addressed address1Reg = base + wires.length := by + simp [addressed, Basic.exec, address1Reg, baseReg, wireCountReg, + hbase', hcount'] + have hsource : addressed outputReg = + Input.bitValue (gate.eval value0 value1) := by + simpa [addressed, Basic.exec, address1Reg, outputReg] using houtput + rw [routineFinal, appendOps, Basic.execList] + change Function.update addressed (addressed address1Reg) + (addressed outputReg) (base + wires.length) = _ + rw [haddress, hsource, Function.update_self] + +private theorem routineFinal_wire {base : ℕ} {gate : CircuitCode.RawGate} + {wires : List Bool} {store : Store} (hready : ReadyAt base gate wires store) + (index : ℕ) (hindex : index < wires.length) : + routineFinal store (base + index) = Input.bitValue wires[index] := by + have hbase := routineEvaluated_base hready + have hcount := routineEvaluated_wireCount hready + have hwire := routineEvaluated_wire hready index hindex + rw [List.getElem?_eq_getElem hindex] at hwire + have hbase' : routineEvaluated store 10 = base := by + simpa [baseReg] using hbase + have hcount' : routineEvaluated store 5 = wires.length := by + simpa [wireCountReg] using hcount + have hne : base + index ≠ base + wires.length := by omega + let addressed := + (Basic.add address1Reg baseReg wireCountReg).exec (routineEvaluated store) + have haddress : addressed address1Reg = base + wires.length := by + simp [addressed, Basic.exec, address1Reg, baseReg, wireCountReg, + hbase', hcount'] + have hpreserved : addressed (base + index) = + routineEvaluated store (base + index) := by + have hbaseGe := hready.base_ge + have hnotAddress : base + index ≠ address1Reg := by + simp only [address1Reg, wireBase] at hbaseGe ⊢ + omega + simp [addressed, Basic.exec, Function.update_of_ne hnotAddress] + rw [routineFinal, appendOps, Basic.execList] + change Function.update addressed (addressed address1Reg) + (addressed outputReg) (base + index) = _ + rw [haddress, Function.update_of_ne hne, hpreserved, hwire] + +private theorem routineFinal_base {base : ℕ} {gate : CircuitCode.RawGate} + {wires : List Bool} {store : Store} (hready : ReadyAt base gate wires store) : + routineFinal store baseReg = base := by + have hbase := routineEvaluated_base hready + have hcount := routineEvaluated_wireCount hready + let addressed := + (Basic.add address1Reg baseReg wireCountReg).exec (routineEvaluated store) + have haddress : addressed address1Reg = base + wires.length := by + simp [addressed, Basic.exec, address1Reg, hbase, hcount] + have hpreserved : addressed baseReg = routineEvaluated store baseReg := by + simp [addressed, Basic.exec, Function.update_of_ne, address1Reg, baseReg] + rw [routineFinal, appendOps, Basic.execList] + change Function.update addressed (addressed address1Reg) + (addressed outputReg) baseReg = base + rw [haddress, Function.update_of_ne, hpreserved, hbase] + have hbaseGe := hready.base_ge + simp only [baseReg, wireBase] at hbaseGe ⊢ + omega + +private theorem routineFinal_wireCount {base : ℕ} {gate : CircuitCode.RawGate} + {wires : List Bool} {store : Store} (hready : ReadyAt base gate wires store) : + routineFinal store wireCountReg = wires.length := by + have hbase := routineEvaluated_base hready + have hcount := routineEvaluated_wireCount hready + let addressed := + (Basic.add address1Reg baseReg wireCountReg).exec (routineEvaluated store) + have haddress : addressed address1Reg = base + wires.length := by + simp [addressed, Basic.exec, address1Reg, hbase, hcount] + have hpreserved : addressed wireCountReg = + routineEvaluated store wireCountReg := by + simp [addressed, Basic.exec, Function.update_of_ne, address1Reg, + wireCountReg] + rw [routineFinal, appendOps, Basic.execList] + change Function.update addressed (addressed address1Reg) + (addressed outputReg) wireCountReg = wires.length + rw [haddress, Function.update_of_ne, hpreserved, hcount] + have hbaseGe := hready.base_ge + simp only [wireCountReg, wireBase] at hbaseGe ⊢ + omega + +private theorem routineFinal_frame {base : ℕ} {gate : CircuitCode.RawGate} + {wires : List Bool} {store : Store} (hready : ReadyAt base gate wires store) + (index : ℕ) (hhigh : wireBase ≤ index) + (happend : index ≠ base + wires.length) : + routineFinal store index = store index := by + have hevaluated : routineEvaluated store index = store index := by + rw [routineEvaluated_stable] + all_goals simp only [wireBase, address0Reg, address1Reg, value0Reg, + value1Reg, outputReg, scratchReg] at hhigh ⊢ + all_goals omega + have hbase := routineEvaluated_base hready + have hcount := routineEvaluated_wireCount hready + let addressed := + (Basic.add address1Reg baseReg wireCountReg).exec (routineEvaluated store) + have haddress : addressed address1Reg = base + wires.length := by + simp [addressed, Basic.exec, address1Reg, hbase, hcount] + have haddressed : addressed index = routineEvaluated store index := by + have hne : index ≠ address1Reg := by + simp only [wireBase, address1Reg] at hhigh ⊢ + omega + simp [addressed, Basic.exec, Function.update_of_ne hne] + rw [routineFinal, appendOps, Basic.execList] + change Function.update addressed (addressed address1Reg) + (addressed outputReg) index = store index + rw [haddress, Function.update_of_ne happend, haddressed, hevaluated] + +theorem routine_measured_internal {bound base : ℕ} + {gate : CircuitCode.RawGate} {wires : List Bool} {store : Store} + (hready : ReadyAt base gate wires store) + (hstore : StoreEnvelope bound bound store) + (value0 value1 : Bool) (hvalue0 : wires[gate.input₀]? = some value0) + (hvalue1 : wires[gate.input₁]? = some value1) + (happend : base + wires.length < bound) : + ∃ final, + MeasuredRuns program store final stepCount (80 * valueWidth bound) + (envelopeSpace bound bound) ∧ + StoreEnvelope bound bound final ∧ + final outputReg = Input.bitValue (gate.eval value0 value1) ∧ + final (base + wires.length) = Input.bitValue (gate.eval value0 value1) ∧ + final baseReg = base ∧ final wireCountReg = wires.length ∧ + (∀ index (hindex : index < wires.length), + final (base + index) = Input.bitValue wires[index]) ∧ + ∀ index, wireBase ≤ index → index ≠ base + wires.length → + final index = store index := by + have hinput0 : gate.input₀ < wires.length := + List.getElem?_eq_some_iff.mp hvalue0 |>.1 + have hinput1 : gate.input₁ < wires.length := + List.getElem?_eq_some_iff.mp hvalue1 |>.1 + have hsmall : 10 < bound := by + have hbase := hready.base_ge + simp only [wireBase] at hbase + omega + have htwo : 2 ≤ bound := by omega + let addressed0 := (Basic.add address0Reg address0Reg baseReg).exec store + have haddressed0 : StoreEnvelope bound bound addressed0 := by + apply hstore.execBasic (.add address0Reg address0Reg baseReg) + · simp [address0Reg] + omega + · change store address0Reg + store baseReg ≤ bound + rw [hready.address0_eq, hready.base_eq] + omega + have haddressed : StoreEnvelope bound bound (routineAddressed store) := by + change StoreEnvelope bound bound + ((Basic.add address1Reg address1Reg baseReg).exec addressed0) + apply haddressed0.execBasic (.add address1Reg address1Reg baseReg) + · simp [address1Reg] + omega + · change addressed0 address1Reg + addressed0 baseReg ≤ bound + have haddress1 : addressed0 address1Reg = gate.input₁ := by + simp [addressed0, Basic.exec, Function.update_of_ne, address0Reg, + address1Reg] + exact hready.address1_eq + have hbase : addressed0 baseReg = base := by + simp [addressed0, Basic.exec, Function.update_of_ne, address0Reg, + baseReg] + exact hready.base_eq + rw [haddress1, hbase] + omega + have haddressRun0 := MeasuredRuns.basicEnvelope + (.add address0Reg address0Reg baseReg) store hstore haddressed0 + have haddressRun1 := MeasuredRuns.basicEnvelope + (.add address1Reg address1Reg baseReg) addressed0 haddressed0 haddressed + have haddressRun : MeasuredRuns (.basics addressOps) store + (routineAddressed store) 2 (8 * valueWidth bound) + (envelopeSpace bound bound) := by + have hrun := haddressRun0.seq haddressRun1 + convert hrun using 1 + ring + let loaded0 := (Basic.load value0Reg address0Reg).exec (routineAddressed store) + have hloaded0 : StoreEnvelope bound bound loaded0 := by + apply haddressed.execBasic (.load value0Reg address0Reg) + · simp [value0Reg] + omega + · exact haddressed.value_le (routineAddressed store address0Reg) + have hloaded : StoreEnvelope bound bound (routineLoaded store) := by + change StoreEnvelope bound bound + ((Basic.load value1Reg address1Reg).exec loaded0) + apply hloaded0.execBasic (.load value1Reg address1Reg) + · simp [value1Reg] + omega + · exact hloaded0.value_le (loaded0 address1Reg) + have hloadRun0 := MeasuredRuns.basicEnvelope (.load value0Reg address0Reg) + (routineAddressed store) haddressed hloaded0 + have hloadRun1 := MeasuredRuns.basicEnvelope (.load value1Reg address1Reg) + loaded0 hloaded0 hloaded + have hloadRun : MeasuredRuns (.basics loadOps) (routineAddressed store) + (routineLoaded store) 2 (8 * valueWidth bound) + (envelopeSpace bound bound) := by + have hrun := hloadRun0.seq hloadRun1 + convert hrun using 1 + ring + have hloadedValue0 := routineLoaded_value0 hready value0 hvalue0 + have hloadedNegated0 : routineLoaded store negated0Reg = + Input.bitValue gate.negated₀ := by + rw [routineLoaded_apply_of_ne] + · exact hready.negated0_eq + all_goals simp [negated0Reg, value0Reg, value1Reg, address0Reg, address1Reg] + have hxor0 := xor_measured hloaded htwo + (value := value0Reg) (negated := negated0Reg) + (by simp [value0Reg]; omega) (by simp [outputReg]; omega) + (by simp [scratchReg]; omega) (by simp [value0Reg, outputReg]) + (by simp [negated0Reg, outputReg]) value0 gate.negated₀ + hloadedValue0 hloadedNegated0 + have hnegated0 := hxor0.2 + have hnegated0Run : MeasuredRuns (.basics (xorOps value0Reg negated0Reg)) + (routineLoaded store) (routineNegated0 store) 4 + (16 * valueWidth bound) (envelopeSpace bound bound) := by + simpa [routineNegated0] using hxor0.1 + have hnegated0Value1 : routineNegated0 store value1Reg = + Input.bitValue value1 := by + rw [routineNegated0_apply_of_ne] + · exact routineLoaded_value1 hready value1 hvalue1 + all_goals simp [value0Reg, value1Reg, outputReg, scratchReg] + have hnegated0Negated1 : routineNegated0 store negated1Reg = + Input.bitValue gate.negated₁ := by + rw [routineNegated0_apply_of_ne] + · rw [routineLoaded_apply_of_ne] + · exact hready.negated1_eq + all_goals simp [negated1Reg, value0Reg, value1Reg, address0Reg, address1Reg] + all_goals simp [negated1Reg, value0Reg, outputReg, scratchReg] + have hxor1 := xor_measured hnegated0 htwo + (value := value1Reg) (negated := negated1Reg) + (by simp [value1Reg]; omega) (by simp [outputReg]; omega) + (by simp [scratchReg]; omega) (by simp [value1Reg, outputReg]) + (by simp [negated1Reg, outputReg]) value1 gate.negated₁ + hnegated0Value1 hnegated0Negated1 + have hnegated1 := hxor1.2 + have hnegated1Run : MeasuredRuns (.basics (xorOps value1Reg negated1Reg)) + (routineNegated0 store) (routineNegated1 store) 4 + (16 * valueWidth bound) (envelopeSpace bound bound) := by + simpa [routineNegated1] using hxor1.1 + have hvalue0Eq := routineNegated1_value0 hready value0 hvalue0 + have hvalue1Eq := routineNegated1_value hready value1 hvalue1 + have hopEq := routineNegated1_op hready + let product := (Basic.mul scratchReg value0Reg value1Reg).exec + (routineNegated1 store) + let sum := (Basic.add outputReg value0Reg value1Reg).exec product + let orStore := (Basic.sub outputReg outputReg scratchReg).exec sum + let delta := (Basic.sub address0Reg outputReg scratchReg).exec orStore + let selected := (Basic.mul address0Reg opReg address0Reg).exec delta + have hproduct : StoreEnvelope bound bound product := by + apply hnegated1.execBasic (.mul scratchReg value0Reg value1Reg) + · simp [scratchReg] + omega + · change routineNegated1 store value0Reg * + routineNegated1 store value1Reg ≤ bound + rw [hvalue0Eq, hvalue1Eq] + cases gate.negated₀ <;> cases gate.negated₁ <;> + cases value0 <;> cases value1 <;> simp [Input.bitValue] <;> omega + have hproductValue0 : product value0Reg = + Input.bitValue (gate.negated₀.xor value0) := by + rw [show product value0Reg = routineNegated1 store value0Reg by + simp [product, Basic.exec, Function.update_of_ne, value0Reg, scratchReg]] + exact hvalue0Eq + have hproductValue1 : product value1Reg = + Input.bitValue (gate.negated₁.xor value1) := by + rw [show product value1Reg = routineNegated1 store value1Reg by + simp [product, Basic.exec, Function.update_of_ne, value1Reg, scratchReg]] + exact hvalue1Eq + have hsum : StoreEnvelope bound bound sum := by + apply hproduct.execBasic (.add outputReg value0Reg value1Reg) + · simp [outputReg] + omega + · change product value0Reg + product value1Reg ≤ bound + rw [hproductValue0, hproductValue1] + cases gate.negated₀ <;> cases gate.negated₁ <;> + cases value0 <;> cases value1 <;> simp [Input.bitValue] <;> omega + have hsumOutput : sum outputReg ≤ 2 := by + change product value0Reg + product value1Reg ≤ 2 + rw [hproductValue0, hproductValue1] + cases gate.negated₀ <;> cases gate.negated₁ <;> + cases value0 <;> cases value1 <;> simp [Input.bitValue] + have hor : StoreEnvelope bound bound orStore := by + apply hsum.execBasic (.sub outputReg outputReg scratchReg) + · simp [outputReg] + omega + · exact le_trans (Nat.sub_le _ _) (le_trans hsumOutput htwo) + have horOutput : orStore outputReg ≤ 2 := + le_trans (Nat.sub_le _ _) hsumOutput + have hdelta : StoreEnvelope bound bound delta := by + apply hor.execBasic (.sub address0Reg outputReg scratchReg) + · simp [address0Reg] + omega + · exact le_trans (Nat.sub_le _ _) (le_trans horOutput htwo) + have hdeltaValue : delta address0Reg ≤ 2 := + le_trans (Nat.sub_le _ _) horOutput + have hselected : StoreEnvelope bound bound selected := by + apply hdelta.execBasic (.mul address0Reg opReg address0Reg) + · simp [address0Reg] + omega + · have hop : delta opReg = Input.bitValue gate.opBit := by + rw [show delta opReg = routineNegated1 store opReg by + simp [delta, orStore, sum, product, Basic.exec, + Function.update_of_ne, opReg, address0Reg, outputReg, scratchReg, + value0Reg, value1Reg]] + exact hopEq + change delta opReg * delta address0Reg ≤ bound + rw [hop] + cases gate.opBit <;> simp [Input.bitValue] + exact le_trans hdeltaValue htwo + have hevaluated : StoreEnvelope bound bound (routineEvaluated store) := by + change StoreEnvelope bound bound + ((Basic.sub outputReg outputReg address0Reg).exec selected) + apply hselected.execBasic (.sub outputReg outputReg address0Reg) + · simp [outputReg] + omega + · exact le_trans (Nat.sub_le _ _) (hselected.value_le outputReg) + have hevalRun0 := MeasuredRuns.basicEnvelope + (.mul scratchReg value0Reg value1Reg) (routineNegated1 store) + hnegated1 hproduct + have hevalRun1 := MeasuredRuns.basicEnvelope + (.add outputReg value0Reg value1Reg) product hproduct hsum + have hevalRun2 := MeasuredRuns.basicEnvelope + (.sub outputReg outputReg scratchReg) sum hsum hor + have hevalRun3 := MeasuredRuns.basicEnvelope + (.sub address0Reg outputReg scratchReg) orStore hor hdelta + have hevalRun4 := MeasuredRuns.basicEnvelope + (.mul address0Reg opReg address0Reg) delta hdelta hselected + have hevalRun5 := MeasuredRuns.basicEnvelope + (.sub outputReg outputReg address0Reg) selected hselected hevaluated + have hevalRun : MeasuredRuns (.basics evalOps) (routineNegated1 store) + (routineEvaluated store) 6 (24 * valueWidth bound) + (envelopeSpace bound bound) := by + have hrun := hevalRun0.seq (hevalRun1.seq (hevalRun2.seq + (hevalRun3.seq (hevalRun4.seq hevalRun5)))) + convert hrun using 1 + ring + let appendAddressed := + (Basic.add address1Reg baseReg wireCountReg).exec (routineEvaluated store) + have happendAddressed : StoreEnvelope bound bound appendAddressed := by + apply hevaluated.execBasic (.add address1Reg baseReg wireCountReg) + · simp [address1Reg] + omega + · change routineEvaluated store baseReg + + routineEvaluated store wireCountReg ≤ bound + rw [routineEvaluated_base hready, routineEvaluated_wireCount hready] + omega + have hfinal : StoreEnvelope bound bound (routineFinal store) := by + change StoreEnvelope bound bound + ((Basic.store address1Reg outputReg).exec appendAddressed) + apply happendAddressed.execBasic (.store address1Reg outputReg) + · change appendAddressed address1Reg < bound + change routineEvaluated store baseReg + + routineEvaluated store wireCountReg < bound + rw [routineEvaluated_base hready, routineEvaluated_wireCount hready] + exact happend + · exact happendAddressed.value_le outputReg + have happendRun0 := MeasuredRuns.basicEnvelope + (.add address1Reg baseReg wireCountReg) (routineEvaluated store) + hevaluated happendAddressed + have happendRun1 := MeasuredRuns.basicEnvelope + (.store address1Reg outputReg) appendAddressed happendAddressed hfinal + have happendRun : MeasuredRuns (.basics appendOps) (routineEvaluated store) + (routineFinal store) 2 (8 * valueWidth bound) + (envelopeSpace bound bound) := by + have hrun := happendRun0.seq happendRun1 + convert hrun using 1 + ring + have hrun := haddressRun.seq (hloadRun.seq + (hnegated0Run.seq (hnegated1Run.seq (hevalRun.seq happendRun)))) + have hprogram : MeasuredRuns program store (routineFinal store) stepCount + (80 * valueWidth bound) (envelopeSpace bound bound) := by + convert hrun using 1 + all_goals ring + exact ⟨routineFinal store, hprogram, hfinal, + routineFinal_output hready value0 value1 hvalue0 hvalue1, + routineFinal_appended hready value0 value1 hvalue0 hvalue1, + routineFinal_base hready, routineFinal_wireCount hready, + routineFinal_wire hready, routineFinal_frame hready⟩ + +theorem routine_exec_internal {base : ℕ} {gate : CircuitCode.RawGate} + {wires : List Bool} {store : Store} (hready : ReadyAt base gate wires store) + (value0 value1 : Bool) (hvalue0 : wires[gate.input₀]? = some value0) + (hvalue1 : wires[gate.input₁]? = some value1) : + ∃ final cost space, + Exec program store final stepCount cost space ∧ + final outputReg = Input.bitValue (gate.eval value0 value1) ∧ + final (base + wires.length) = Input.bitValue (gate.eval value0 value1) ∧ + final baseReg = base ∧ final wireCountReg = wires.length ∧ + (∀ index (hindex : index < wires.length), + final (base + index) = Input.bitValue wires[index]) ∧ + ∀ index, wireBase ≤ index → index ≠ base + wires.length → + final index = store index := by + obtain ⟨addressCost, addressSpace, haddress⟩ := + exec_basics_exists addressOps store + obtain ⟨loadCost, loadSpace, hload⟩ := + exec_basics_exists loadOps (routineAddressed store) + obtain ⟨negated0Cost, negated0Space, hnegated0⟩ := + exec_basics_exists (xorOps value0Reg negated0Reg) (routineLoaded store) + obtain ⟨negated1Cost, negated1Space, hnegated1⟩ := + exec_basics_exists (xorOps value1Reg negated1Reg) (routineNegated0 store) + obtain ⟨evalCost, evalSpace, heval⟩ := + exec_basics_exists evalOps (routineNegated1 store) + obtain ⟨appendCost, appendSpace, happend⟩ := + exec_basics_exists appendOps (routineEvaluated store) + have hrun := haddress.seq (hload.seq + (hnegated0.seq (hnegated1.seq (heval.seq happend)))) + refine ⟨routineFinal store, + addressCost + (loadCost + (negated0Cost + + (negated1Cost + (evalCost + appendCost)))), + max addressSpace (max loadSpace (max negated0Space + (max negated1Space (max evalSpace appendSpace)))), ?_, + routineFinal_output hready value0 value1 hvalue0 hvalue1, + routineFinal_appended hready value0 value1 hvalue0 hvalue1, + routineFinal_base hready, routineFinal_wireCount hready, ?_, + routineFinal_frame hready⟩ + · rw [program] + convert hrun using 1 + · intro index hindex + exact routineFinal_wire hready index hindex + +private theorem finalStore_output_internal (gate : CircuitCode.RawGate) (wires : List Bool) + (value0 value1 : Bool) (hvalue0 : wires[gate.input₀]? = some value0) + (hvalue1 : wires[gate.input₁]? = some value1) : + finalStore gate wires outputReg = Input.bitValue (gate.eval value0 value1) := + finalStore_output gate wires value0 value1 hvalue0 hvalue1 + +theorem program_exec_internal (gate : CircuitCode.RawGate) (wires : List Bool) + (value0 value1 : Bool) (hvalue0 : wires[gate.input₀]? = some value0) + (hvalue1 : wires[gate.input₁]? = some value1) : + ∃ final cost space, + Exec program (inputStore gate wires) final stepCount cost space ∧ + final outputReg = Input.bitValue (gate.eval value0 value1) := by + obtain ⟨addressCost, addressSpace, haddress⟩ := + exec_basics_exists addressOps (inputStore gate wires) + obtain ⟨loadCost, loadSpace, hload⟩ := + exec_basics_exists loadOps (addressed gate wires) + obtain ⟨negated0Cost, negated0Space, hnegated0⟩ := + exec_basics_exists (xorOps value0Reg negated0Reg) (loaded gate wires) + obtain ⟨negated1Cost, negated1Space, hnegated1⟩ := + exec_basics_exists (xorOps value1Reg negated1Reg) (negated0 gate wires) + obtain ⟨evalCost, evalSpace, heval⟩ := + exec_basics_exists evalOps (negated1 gate wires) + obtain ⟨appendCost, appendSpace, happend⟩ := + exec_basics_exists appendOps (evaluated gate wires) + have hrun := haddress.seq (hload.seq + (hnegated0.seq (hnegated1.seq (heval.seq happend)))) + refine ⟨finalStore gate wires, + addressCost + (loadCost + (negated0Cost + + (negated1Cost + (evalCost + appendCost)))), + max addressSpace (max loadSpace (max negated0Space + (max negated1Space (max evalSpace appendSpace)))), ?_, ?_⟩ + · rw [program] + convert hrun using 1 + · exact finalStore_output gate wires value0 value1 hvalue0 hvalue1 + +theorem program_measured_internal (gate : CircuitCode.RawGate) (wires : List Bool) + (value0 value1 : Bool) (hvalue0 : wires[gate.input₀]? = some value0) + (hvalue1 : wires[gate.input₁]? = some value1) + (hgate : gate.WellFormedAt wires.length) : + ∃ final cost space, + Exec program (inputStore gate wires) final stepCount cost space ∧ + cost ≤ timeBound wires.length ∧ space ≤ spaceBound wires.length ∧ + final outputReg = Input.bitValue (gate.eval value0 value1) ∧ + final (wireBase + wires.length) = Input.bitValue (gate.eval value0 value1) ∧ + ∀ index (hindex : index < wires.length), + final (wireBase + index) = Input.bitValue wires[index] := by + have haddress := (address_measured gate wires hgate).1 + have hload := (load_measured gate wires hgate).1 + have hnegated0 := (negated0_measured gate wires value0 hvalue0 hgate).1 + have hnegated1 := + (negated1_measured gate wires value0 value1 hvalue0 hvalue1 hgate).1 + have heval := (eval_measured gate wires value0 value1 hvalue0 hvalue1 hgate).1 + have happend := + (append_measured gate wires value0 value1 hvalue0 hvalue1 hgate).1 + have hrun := haddress.seq (hload.seq + (hnegated0.seq (hnegated1.seq (heval.seq happend)))) + have hprogram : MeasuredRuns program (inputStore gate wires) + (finalStore gate wires) stepCount (timeBound wires.length) + (resourceSpace wires.length) := by + convert hrun using 1 + simp [timeBound, width, valueWidth] + ring + obtain ⟨cost, space, hexec, hcost, hspace⟩ := hprogram + have hspace' : space ≤ spaceBound wires.length := by + rw [← envelopeSpace_eq_spaceBound] + exact hspace + exact ⟨finalStore gate wires, cost, space, hexec, hcost, hspace', + finalStore_output gate wires value0 value1 hvalue0 hvalue1, + finalStore_appended gate wires value0 value1 hvalue0 hvalue1, + finalStore_wire gate wires⟩ + +end GateEval + +end Structured + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/GateStep.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/GateStep.lean new file mode 100644 index 0000000000..fcdce90311 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/GateStep.lean @@ -0,0 +1,120 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.GateStep.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.GateStep.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured + +/-! +# Verified structured RAM serialized-gate step + +This module is the first end-to-end composition of the structured RAM parser +and mutable-data APIs. One fixed program consumes a canonical gate encoding, +invokes the same cursor loop for both unary references, discovers the following +memo base at runtime, evaluates the decoded gate, and appends its result. +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace Structured + +namespace GateStep + +/-- Source correctness and exact transition count for one canonical gate. -/ +theorem program_correct (gate : CircuitCode.RawGate) (wires : List Bool) + (value0 value1 : Bool) (hvalue0 : wires[gate.input₀]? = some value0) + (hvalue1 : wires[gate.input₁]? = some value1) : + ∃ final cost space, + Exec program (inputStore gate wires) final (stepCount gate) cost space ∧ + final GateEval.outputReg = Input.bitValue (gate.eval value0 value1) ∧ + final (memoBase gate + wires.length) = + Input.bitValue (gate.eval value0 value1) ∧ + ∀ index (hindex : index < wires.length), + final (memoBase gate + index) = Input.bitValue wires[index] := + program_exec_internal gate wires value0 value1 hvalue0 hvalue1 + +/-- Source correctness, exact transitions, and closed-form logarithmic resource +bounds for one serialized gate and its current memo. -/ +theorem program_performance (gate : CircuitCode.RawGate) (wires : List Bool) + (value0 value1 : Bool) (hvalue0 : wires[gate.input₀]? = some value0) + (hvalue1 : wires[gate.input₁]? = some value1) : + ∃ final cost space, + Exec program (inputStore gate wires) final (stepCount gate) cost space ∧ + cost ≤ timeBound gate wires ∧ space ≤ spaceBound gate wires ∧ + final GateEval.outputReg = Input.bitValue (gate.eval value0 value1) ∧ + final (memoBase gate + wires.length) = + Input.bitValue (gate.eval value0 value1) ∧ + ∀ index (hindex : index < wires.length), + final (memoBase gate + index) = Input.bitValue wires[index] := + program_measured_internal gate wires value0 value1 hvalue0 hvalue1 + +/-- Compilation preserves the exact serialized-gate run and its memo result. -/ +theorem compiled_correct (gate : CircuitCode.RawGate) (wires : List Bool) + (value0 value1 : Bool) (hvalue0 : wires[gate.input₀]? = some value0) + (hvalue1 : wires[gate.input₁]? = some value1) : + ∃ final cost space, + Exec program (inputStore gate wires) final (stepCount gate) cost space ∧ + run compiled (stepCount gate) { pc := 0, regs := inputStore gate wires } = + { pc := program.codeSize, regs := final } ∧ + Halted compiled + (run compiled (stepCount gate) { pc := 0, regs := inputStore gate wires }) ∧ + logTimeUpto compiled (stepCount gate) + { pc := 0, regs := inputStore gate wires } = cost ∧ + spaceUpto compiled (stepCount gate) + { pc := 0, regs := inputStore gate wires } = space ∧ + final GateEval.outputReg = Input.bitValue (gate.eval value0 value1) ∧ + final (memoBase gate + wires.length) = + Input.bitValue (gate.eval value0 value1) ∧ + ∀ index (hindex : index < wires.length), + final (memoBase gate + index) = Input.bitValue wires[index] := by + obtain ⟨final, cost, space, hexec, houtput, happended, hpreserved⟩ := + program_correct gate wires value0 value1 hvalue0 hvalue1 + have hcompiled := Exec.compile_correct hexec + exact ⟨final, cost, space, hexec, hcompiled.1, Exec.compile_halted hexec, + hcompiled.2.1, hcompiled.2.2, houtput, happended, hpreserved⟩ + +/-- Compilation transfers the serialized-gate result and both source resource +bounds exactly to the concrete logarithmic-cost RAM. -/ +theorem compiled_performance (gate : CircuitCode.RawGate) (wires : List Bool) + (value0 value1 : Bool) (hvalue0 : wires[gate.input₀]? = some value0) + (hvalue1 : wires[gate.input₁]? = some value1) : + ∃ final cost space, + Exec program (inputStore gate wires) final (stepCount gate) cost space ∧ + cost ≤ timeBound gate wires ∧ space ≤ spaceBound gate wires ∧ + run compiled (stepCount gate) { pc := 0, regs := inputStore gate wires } = + { pc := program.codeSize, regs := final } ∧ + Halted compiled + (run compiled (stepCount gate) { pc := 0, regs := inputStore gate wires }) ∧ + logTimeUpto compiled (stepCount gate) + { pc := 0, regs := inputStore gate wires } = cost ∧ + spaceUpto compiled (stepCount gate) + { pc := 0, regs := inputStore gate wires } = space ∧ + final GateEval.outputReg = Input.bitValue (gate.eval value0 value1) ∧ + final (memoBase gate + wires.length) = + Input.bitValue (gate.eval value0 value1) ∧ + ∀ index (hindex : index < wires.length), + final (memoBase gate + index) = Input.bitValue wires[index] := by + obtain ⟨final, cost, space, hexec, hcost, hspace, + houtput, happended, hpreserved⟩ := + program_performance gate wires value0 value1 hvalue0 hvalue1 + have hcompiled := Exec.compile_correct hexec + exact ⟨final, cost, space, hexec, hcost, hspace, hcompiled.1, + Exec.compile_halted hexec, hcompiled.2.1, hcompiled.2.2, + houtput, happended, hpreserved⟩ + +end GateStep + +end Structured + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/GateStep/Defs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/GateStep/Defs.lean new file mode 100644 index 0000000000..0354fd8dca --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/GateStep/Defs.lean @@ -0,0 +1,119 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.GateEval.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.UnaryDecode.Defs + +/-! +# Structured RAM serialized-gate step — definitions + +This program composes the terminated-unary cursor routine with the decoded-gate +kernel. Its input is one canonical gate encoding followed immediately by the +current Boolean wire memo. The fixed three-bit header is consumed directly, +the two references are decoded by two calls to the same loop, and the resulting +gate is evaluated and appended without specializing the program to the input. +-/ + + +@[expose] public section + +namespace Complexity + +namespace RAM + +namespace Structured + +namespace GateStep + +/-- The operation header bit is retained in the consumed input prefix. -/ +def headerOpReg : ℕ := UnaryDecode.inputBase +/-- The first negation header bit is retained in the consumed input prefix. -/ +def headerNegated0Reg : ℕ := UnaryDecode.inputBase + 1 +/-- The second negation header bit is retained in the consumed input prefix. -/ +def headerNegated1Reg : ℕ := UnaryDecode.inputBase + 2 +/-- The first decoded reference is retained in the consumed input prefix. -/ +def savedInput0Reg : ℕ := UnaryDecode.inputBase + 3 + +/-- Canonical gate code followed by its current wire memo. -/ +def inputBits (gate : CircuitCode.RawGate) (wires : List Bool) : List Bool := + gate.encode ++ wires + +/-- First physical register occupied by the wire memo. -/ +def memoBase (gate : CircuitCode.RawGate) : ℕ := + UnaryDecode.inputBase + gate.encode.length + +/-- Machine input for one serialized gate and the current wire memo. -/ +def inputStore (gate : CircuitCode.RawGate) (wires : List Bool) : Store := + Input.bitStore UnaryDecode.remainingReg UnaryDecode.inputBase + (inputBits gate wires) + +/-- Consume and retain the fixed operation and negation header bits. -/ +def headerOps : List Basic := + [.load headerOpReg UnaryDecode.pointerReg, + .add UnaryDecode.pointerReg UnaryDecode.pointerReg UnaryDecode.oneReg, + .sub UnaryDecode.remainingReg UnaryDecode.remainingReg UnaryDecode.oneReg, + .load headerNegated0Reg UnaryDecode.pointerReg, + .add UnaryDecode.pointerReg UnaryDecode.pointerReg UnaryDecode.oneReg, + .sub UnaryDecode.remainingReg UnaryDecode.remainingReg UnaryDecode.oneReg, + .load headerNegated1Reg UnaryDecode.pointerReg, + .add UnaryDecode.pointerReg UnaryDecode.pointerReg UnaryDecode.oneReg, + .sub UnaryDecode.remainingReg UnaryDecode.remainingReg UnaryDecode.oneReg] + +/-- Save the first reference and restart the cursor accumulator for the second. -/ +def saveRestartOps : List Basic := + [.add savedInput0Reg UnaryDecode.valueReg UnaryDecode.activeReg, + .imm UnaryDecode.verdictReg 0, + .imm UnaryDecode.valueReg 0, + .imm UnaryDecode.activeReg 1] + +/-- Marshal the parsed cursor state into the decoded-gate evaluator ABI. -/ +def marshalOps : List Basic := + [.add GateEval.wireCountReg UnaryDecode.remainingReg UnaryDecode.activeReg, + .add GateEval.address1Reg UnaryDecode.valueReg UnaryDecode.activeReg, + .add GateEval.address0Reg savedInput0Reg UnaryDecode.activeReg, + .add GateEval.baseReg UnaryDecode.pointerReg UnaryDecode.activeReg, + .add GateEval.opReg headerOpReg UnaryDecode.activeReg, + .add GateEval.negated0Reg headerNegated0Reg UnaryDecode.activeReg, + .add GateEval.negated1Reg headerNegated1Reg UnaryDecode.activeReg] + +/-- Parse and evaluate one serialized gate, appending its result to the memo. -/ +def program : Cmd := Cmd.seqList + [UnaryDecode.setup, + .basics headerOps, + UnaryDecode.mainLoop, + .basics saveRestartOps, + UnaryDecode.mainLoop, + .basics marshalOps, + GateEval.program] + +/-- Concrete compiled serialized-gate step. -/ +def compiled : Program := program.compile + +/-- Exact transition count for a canonical serialized gate. -/ +def stepCount (gate : CircuitCode.RawGate) : ℕ := + 10 * (gate.input₀ + gate.input₁) + 67 + +/-- Uniform envelope including the newly appended wire. -/ +def storeBound (gate : CircuitCode.RawGate) (wires : List Bool) : ℕ := + (inputBits gate wires).length + UnaryDecode.inputBase + 1 + +/-- Explicit logarithmic-cost budget for one serialized-gate step. -/ +def timeBound (gate : CircuitCode.RawGate) (wires : List Bool) : ℕ := + 512 * ((inputBits gate wires).length + 1) * + (bitlen (storeBound gate wires) + 1) + +/-- Explicit peak-space budget including the appended memo cell. -/ +def spaceBound (gate : CircuitCode.RawGate) (wires : List Bool) : ℕ := + storeBound gate wires * (2 * bitlen (storeBound gate wires)) + +end GateStep + +end Structured + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/GateStep/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/GateStep/Internal.lean new file mode 100644 index 0000000000..6705ba7c38 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/GateStep/Internal.lean @@ -0,0 +1,1042 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Circuits.Encoding.Internal.Codec +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.GateEval.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.GateStep.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.UnaryDecode.Internal +public import Mathlib.Tactic.IntervalCases + +/-! +# Structured RAM serialized-gate step — proof internals +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace Structured + +namespace GateStep + +open Internal + +private abbrev cursorBound (gate : CircuitCode.RawGate) (wires : List Bool) : ℕ := + (inputBits gate wires).length + UnaryDecode.inputBase + +private abbrev CursorEnvelope (gate : CircuitCode.RawGate) (wires : List Bool) + (store : Store) : Prop := + StoreEnvelope (cursorBound gate wires) (cursorBound gate wires) store + +private def setupStore (gate : CircuitCode.RawGate) (wires : List Bool) : Store := + Basic.execList UnaryDecode.setupOps (inputStore gate wires) + +private def headerStore (gate : CircuitCode.RawGate) (wires : List Bool) : Store := + Basic.execList headerOps (setupStore gate wires) + +private def saveRestartStore (store : Store) : Store := + Basic.execList saveRestartOps store + +private def marshalStore (store : Store) : Store := + Basic.execList marshalOps store + +private theorem input_bound (gate : CircuitCode.RawGate) (wires : List Bool) : + CursorEnvelope gate wires (inputStore gate wires) := by + apply Input.bitStoreEnvelope + · simp [cursorBound, inputBits, UnaryDecode.remainingReg, + UnaryDecode.inputBase] + · simp [cursorBound, UnaryDecode.inputBase] + omega + · simp [cursorBound, UnaryDecode.inputBase] + · simp [cursorBound, inputBits, UnaryDecode.inputBase] + +private theorem setup_measured (gate : CircuitCode.RawGate) (wires : List Bool) : + MeasuredRuns UnaryDecode.setup (inputStore gate wires) + (setupStore gate wires) 5 + (20 * valueWidth (cursorBound gate wires)) + (envelopeSpace (cursorBound gate wires) (cursorBound gate wires)) ∧ + CursorEnvelope gate wires (setupStore gate wires) := by + have hinitial := input_bound gate wires + have hpreserve : ∀ op, op ∈ UnaryDecode.setupOps → ∀ store, + CursorEnvelope gate wires store → CursorEnvelope gate wires (op.exec store) := by + intro op hop store hstore + simp [UnaryDecode.setupOps] at hop + rcases hop with rfl | rfl | rfl | rfl | rfl + · apply hstore.execBasic (.imm UnaryDecode.verdictReg 0) <;> + simp [cursorBound, inputBits, UnaryDecode.verdictReg, + UnaryDecode.inputBase] + · apply hstore.execBasic (.imm UnaryDecode.valueReg 0) <;> + simp [cursorBound, inputBits, UnaryDecode.valueReg, + UnaryDecode.inputBase] + · apply hstore.execBasic (.imm UnaryDecode.pointerReg UnaryDecode.inputBase) + · simp [cursorBound, inputBits, UnaryDecode.pointerReg, + UnaryDecode.inputBase] + · simp [Basic.writeValue, cursorBound, inputBits, UnaryDecode.inputBase] + · apply hstore.execBasic (.imm UnaryDecode.oneReg 1) <;> + simp [cursorBound, inputBits, UnaryDecode.oneReg, UnaryDecode.inputBase] + · apply hstore.execBasic (.imm UnaryDecode.activeReg 1) <;> + simp [cursorBound, inputBits, UnaryDecode.activeReg, + UnaryDecode.inputBase] + simpa [UnaryDecode.setup, setupStore] using + MeasuredRuns.basicsEnvelope UnaryDecode.setupOps (inputStore gate wires) + hinitial hpreserve + +private theorem header_high (gate : CircuitCode.RawGate) (wires : List Bool) + (index : ℕ) (hindex : 10 ≤ index) : + headerStore gate wires index = inputStore gate wires index := by + have h0 : index ≠ 0 := by omega + have h1 : index ≠ 1 := by omega + have h2 : index ≠ 2 := by omega + have h3 : index ≠ 3 := by omega + have h4 : index ≠ 4 := by omega + have h6 : index ≠ 6 := by omega + have h7 : index ≠ 7 := by omega + have h8 : index ≠ 8 := by omega + have h9 : index ≠ 9 := by omega + simp [headerStore, headerOps, setupStore, UnaryDecode.setupOps, + Basic.execList, Basic.exec, Function.update_of_ne, h0, h1, h2, h3, h4, h6, + h7, h8, h9, headerOpReg, headerNegated0Reg, headerNegated1Reg, + UnaryDecode.verdictReg, UnaryDecode.valueReg, UnaryDecode.pointerReg, + UnaryDecode.remainingReg, UnaryDecode.oneReg, UnaryDecode.activeReg, + UnaryDecode.inputBase] + +private theorem header_bound (gate : CircuitCode.RawGate) (wires : List Bool) : + CursorEnvelope gate wires (headerStore gate wires) := by + have hinitial := input_bound gate wires + have hlarge : 10 < cursorBound gate wires := by + simp [cursorBound, inputBits, CircuitCode.RawGate.encode, + UnaryDecode.inputBase] + constructor + · intro index hnonzero + by_cases hindex : index < 10 + · omega + · rw [header_high gate wires index (by omega)] at hnonzero + exact hinitial.index_lt index hnonzero + · intro index + by_cases hindex : index < 10 + · interval_cases index <;> + simp [headerStore, headerOps, setupStore, UnaryDecode.setupOps, + Basic.execList, Basic.exec, inputStore, Input.bitStore, inputBits, + CircuitCode.RawGate.encode, cursorBound, headerOpReg, + headerNegated0Reg, headerNegated1Reg, UnaryDecode.verdictReg, + UnaryDecode.valueReg, UnaryDecode.pointerReg, + UnaryDecode.remainingReg, UnaryDecode.oneReg, UnaryDecode.activeReg, + UnaryDecode.inputBase] + all_goals try omega + all_goals split <;> simp + · rw [header_high gate wires index (by omega)] + exact hinitial.value_le index + +private theorem header_measured (gate : CircuitCode.RawGate) (wires : List Bool) : + MeasuredRuns (.basics headerOps) (setupStore gate wires) + (headerStore gate wires) 9 + (36 * valueWidth (cursorBound gate wires)) + (envelopeSpace (cursorBound gate wires) (cursorBound gate wires)) ∧ + CursorEnvelope gate wires (headerStore gate wires) := by + have hsetup := (setup_measured gate wires).2 + have hlarge : 10 < cursorBound gate wires := by + simp [cursorBound, inputBits, CircuitCode.RawGate.encode, + UnaryDecode.inputBase] + let s1 := (Basic.load headerOpReg UnaryDecode.pointerReg).exec + (setupStore gate wires) + let s2 := (Basic.add UnaryDecode.pointerReg UnaryDecode.pointerReg + UnaryDecode.oneReg).exec s1 + let s3 := (Basic.sub UnaryDecode.remainingReg UnaryDecode.remainingReg + UnaryDecode.oneReg).exec s2 + let s4 := (Basic.load headerNegated0Reg UnaryDecode.pointerReg).exec s3 + let s5 := (Basic.add UnaryDecode.pointerReg UnaryDecode.pointerReg + UnaryDecode.oneReg).exec s4 + let s6 := (Basic.sub UnaryDecode.remainingReg UnaryDecode.remainingReg + UnaryDecode.oneReg).exec s5 + let s7 := (Basic.load headerNegated1Reg UnaryDecode.pointerReg).exec s6 + let s8 := (Basic.add UnaryDecode.pointerReg UnaryDecode.pointerReg + UnaryDecode.oneReg).exec s7 + have hsetupPointer : setupStore gate wires UnaryDecode.pointerReg = + UnaryDecode.inputBase := by + simp [setupStore, UnaryDecode.setupOps, Basic.execList, Basic.exec, + UnaryDecode.pointerReg, UnaryDecode.oneReg, UnaryDecode.activeReg] + have hsetupOne : setupStore gate wires UnaryDecode.oneReg = 1 := by + simp [setupStore, UnaryDecode.setupOps, Basic.execList, Basic.exec, + UnaryDecode.pointerReg, UnaryDecode.oneReg, UnaryDecode.activeReg] + have h1 : CursorEnvelope gate wires s1 := by + apply hsetup.execBasic (.load headerOpReg UnaryDecode.pointerReg) + · simp [headerOpReg, UnaryDecode.inputBase] + omega + · exact hsetup.value_le (setupStore gate wires UnaryDecode.pointerReg) + have hs1Pointer : s1 UnaryDecode.pointerReg = UnaryDecode.inputBase := by + rw [show s1 UnaryDecode.pointerReg = + setupStore gate wires UnaryDecode.pointerReg by + simp [s1, Basic.exec, Function.update_of_ne, headerOpReg, + UnaryDecode.pointerReg, UnaryDecode.inputBase]] + exact hsetupPointer + have hs1One : s1 UnaryDecode.oneReg = 1 := by + rw [show s1 UnaryDecode.oneReg = setupStore gate wires UnaryDecode.oneReg by + simp [s1, Basic.exec, Function.update_of_ne, headerOpReg, + UnaryDecode.oneReg, UnaryDecode.inputBase]] + exact hsetupOne + have h2 : CursorEnvelope gate wires s2 := by + apply h1.execBasic (.add UnaryDecode.pointerReg UnaryDecode.pointerReg + UnaryDecode.oneReg) + · simp [UnaryDecode.pointerReg] + omega + · change s1 UnaryDecode.pointerReg + s1 UnaryDecode.oneReg ≤ + cursorBound gate wires + have hp := hs1Pointer + have ho := hs1One + simp only [UnaryDecode.pointerReg, UnaryDecode.oneReg, + UnaryDecode.inputBase] at hp ho ⊢ + omega + have h3 : CursorEnvelope gate wires s3 := by + apply h2.execBasic (.sub UnaryDecode.remainingReg UnaryDecode.remainingReg + UnaryDecode.oneReg) + · simp [UnaryDecode.remainingReg] + omega + · exact le_trans (Nat.sub_le _ _) (h2.value_le UnaryDecode.remainingReg) + have h4 : CursorEnvelope gate wires s4 := by + apply h3.execBasic (.load headerNegated0Reg UnaryDecode.pointerReg) + · simp [headerNegated0Reg, UnaryDecode.inputBase] + omega + · exact h3.value_le (s3 UnaryDecode.pointerReg) + have hs4Pointer : s4 UnaryDecode.pointerReg = UnaryDecode.inputBase + 1 := by + rw [show s4 UnaryDecode.pointerReg = + s1 UnaryDecode.pointerReg + s1 UnaryDecode.oneReg by + simp [s4, s3, s2, Basic.exec, Function.update_of_ne, + headerNegated0Reg, UnaryDecode.pointerReg, + UnaryDecode.remainingReg, UnaryDecode.oneReg, + UnaryDecode.inputBase]] + rw [hs1Pointer, hs1One] + have hs4One : s4 UnaryDecode.oneReg = 1 := by + rw [show s4 UnaryDecode.oneReg = s1 UnaryDecode.oneReg by + simp [s4, s3, s2, Basic.exec, Function.update_of_ne, + headerNegated0Reg, UnaryDecode.pointerReg, + UnaryDecode.remainingReg, UnaryDecode.oneReg, + UnaryDecode.inputBase]] + exact hs1One + have h5 : CursorEnvelope gate wires s5 := by + apply h4.execBasic (.add UnaryDecode.pointerReg UnaryDecode.pointerReg + UnaryDecode.oneReg) + · simp [UnaryDecode.pointerReg] + omega + · change s4 UnaryDecode.pointerReg + s4 UnaryDecode.oneReg ≤ + cursorBound gate wires + have hp := hs4Pointer + have ho := hs4One + simp only [UnaryDecode.pointerReg, UnaryDecode.oneReg, + UnaryDecode.inputBase] at hp ho ⊢ + omega + have h6 : CursorEnvelope gate wires s6 := by + apply h5.execBasic (.sub UnaryDecode.remainingReg UnaryDecode.remainingReg + UnaryDecode.oneReg) + · simp [UnaryDecode.remainingReg] + omega + · exact le_trans (Nat.sub_le _ _) (h5.value_le UnaryDecode.remainingReg) + have h7 : CursorEnvelope gate wires s7 := by + apply h6.execBasic (.load headerNegated1Reg UnaryDecode.pointerReg) + · simp [headerNegated1Reg, UnaryDecode.inputBase] + omega + · exact h6.value_le (s6 UnaryDecode.pointerReg) + have hs7Pointer : s7 UnaryDecode.pointerReg = UnaryDecode.inputBase + 2 := by + rw [show s7 UnaryDecode.pointerReg = + s4 UnaryDecode.pointerReg + s4 UnaryDecode.oneReg by + simp [s7, s6, s5, Basic.exec, Function.update_of_ne, + headerNegated1Reg, UnaryDecode.pointerReg, + UnaryDecode.remainingReg, UnaryDecode.oneReg, + UnaryDecode.inputBase]] + rw [hs4Pointer, hs4One] + have hs7One : s7 UnaryDecode.oneReg = 1 := by + rw [show s7 UnaryDecode.oneReg = s4 UnaryDecode.oneReg by + simp [s7, s6, s5, Basic.exec, Function.update_of_ne, + headerNegated1Reg, UnaryDecode.pointerReg, + UnaryDecode.remainingReg, UnaryDecode.oneReg, + UnaryDecode.inputBase]] + exact hs4One + have h8 : CursorEnvelope gate wires s8 := by + apply h7.execBasic (.add UnaryDecode.pointerReg UnaryDecode.pointerReg + UnaryDecode.oneReg) + · simp [UnaryDecode.pointerReg] + omega + · change s7 UnaryDecode.pointerReg + s7 UnaryDecode.oneReg ≤ + cursorBound gate wires + have hp := hs7Pointer + have ho := hs7One + simp only [UnaryDecode.pointerReg, UnaryDecode.oneReg, + UnaryDecode.inputBase] at hp ho ⊢ + omega + have h9 := header_bound gate wires + have r1 := MeasuredRuns.basicEnvelope + (.load headerOpReg UnaryDecode.pointerReg) (setupStore gate wires) hsetup h1 + have r2 := MeasuredRuns.basicEnvelope + (.add UnaryDecode.pointerReg UnaryDecode.pointerReg UnaryDecode.oneReg) + s1 h1 h2 + have r3 := MeasuredRuns.basicEnvelope + (.sub UnaryDecode.remainingReg UnaryDecode.remainingReg UnaryDecode.oneReg) + s2 h2 h3 + have r4 := MeasuredRuns.basicEnvelope + (.load headerNegated0Reg UnaryDecode.pointerReg) s3 h3 h4 + have r5 := MeasuredRuns.basicEnvelope + (.add UnaryDecode.pointerReg UnaryDecode.pointerReg UnaryDecode.oneReg) + s4 h4 h5 + have r6 := MeasuredRuns.basicEnvelope + (.sub UnaryDecode.remainingReg UnaryDecode.remainingReg UnaryDecode.oneReg) + s5 h5 h6 + have r7 := MeasuredRuns.basicEnvelope + (.load headerNegated1Reg UnaryDecode.pointerReg) s6 h6 h7 + have r8 := MeasuredRuns.basicEnvelope + (.add UnaryDecode.pointerReg UnaryDecode.pointerReg UnaryDecode.oneReg) + s7 h7 h8 + have r9 := MeasuredRuns.basicEnvelope + (.sub UnaryDecode.remainingReg UnaryDecode.remainingReg UnaryDecode.oneReg) + s8 h8 h9 + refine ⟨?_, h9⟩ + have hrun := r1.seq (r2.seq (r3.seq (r4.seq (r5.seq + (r6.seq (r7.seq (r8.seq r9))))))) + convert hrun using 1 + ring + +private theorem header_cursorReady (gate : CircuitCode.RawGate) (wires : List Bool) : + UnaryDecode.CursorReady (inputBits gate wires).length + (CircuitCode.NatCode.encode gate.input₀ ++ + CircuitCode.NatCode.encode gate.input₁ ++ wires) + 3 0 (headerStore gate wires) := by + constructor + · simp [inputBits, CircuitCode.RawGate.encode] + omega + · omega + · simp [headerStore, headerOps, setupStore, UnaryDecode.setupOps, + Basic.execList, Basic.exec, inputStore, Input.bitStore, + inputBits, CircuitCode.RawGate.encode, headerOpReg, headerNegated0Reg, + headerNegated1Reg, UnaryDecode.verdictReg, UnaryDecode.valueReg, + UnaryDecode.pointerReg, UnaryDecode.remainingReg, UnaryDecode.oneReg, + UnaryDecode.activeReg, UnaryDecode.inputBase] + · simp [headerStore, headerOps, setupStore, UnaryDecode.setupOps, + Basic.execList, Basic.exec, inputStore, Input.bitStore, + inputBits, CircuitCode.RawGate.encode, headerOpReg, headerNegated0Reg, + headerNegated1Reg, UnaryDecode.verdictReg, UnaryDecode.valueReg, + UnaryDecode.pointerReg, UnaryDecode.remainingReg, UnaryDecode.oneReg, + UnaryDecode.activeReg, UnaryDecode.inputBase] + · simp [headerStore, headerOps, setupStore, UnaryDecode.setupOps, + Basic.execList, Basic.exec, inputStore, Input.bitStore, + inputBits, CircuitCode.RawGate.encode, headerOpReg, headerNegated0Reg, + headerNegated1Reg, UnaryDecode.verdictReg, UnaryDecode.valueReg, + UnaryDecode.pointerReg, UnaryDecode.remainingReg, UnaryDecode.oneReg, + UnaryDecode.activeReg, UnaryDecode.inputBase] + · simp [headerStore, headerOps, setupStore, UnaryDecode.setupOps, + Basic.execList, Basic.exec, inputStore, Input.bitStore, + inputBits, CircuitCode.RawGate.encode, headerOpReg, headerNegated0Reg, + headerNegated1Reg, UnaryDecode.verdictReg, UnaryDecode.valueReg, + UnaryDecode.pointerReg, UnaryDecode.remainingReg, UnaryDecode.oneReg, + UnaryDecode.activeReg, UnaryDecode.inputBase] + · simp [headerStore, headerOps, setupStore, UnaryDecode.setupOps, + Basic.execList, Basic.exec, inputStore, Input.bitStore, + inputBits, CircuitCode.RawGate.encode, headerOpReg, headerNegated0Reg, + headerNegated1Reg, UnaryDecode.verdictReg, UnaryDecode.valueReg, + UnaryDecode.pointerReg, UnaryDecode.remainingReg, UnaryDecode.oneReg, + UnaryDecode.activeReg, UnaryDecode.inputBase] + · simp [headerStore, headerOps, setupStore, UnaryDecode.setupOps, + Basic.execList, Basic.exec, inputStore, Input.bitStore, + inputBits, CircuitCode.RawGate.encode, headerOpReg, headerNegated0Reg, + headerNegated1Reg, UnaryDecode.verdictReg, UnaryDecode.valueReg, + UnaryDecode.pointerReg, UnaryDecode.remainingReg, UnaryDecode.oneReg, + UnaryDecode.activeReg, UnaryDecode.inputBase] + · intro delta + have h1 : 10 + delta ≠ 1 := by omega + have h2 : 10 + delta ≠ 2 := by omega + have h3 : 10 + delta ≠ 3 := by omega + have h4 : 10 + delta ≠ 4 := by omega + have h6 : 10 + delta ≠ 6 := by omega + have h7 : 10 + delta ≠ 7 := by omega + have h8 : 10 + delta ≠ 8 := by omega + have h9 : 10 + delta ≠ 9 := by omega + have hpreserved : headerStore gate wires (10 + delta) = + inputStore gate wires (10 + delta) := by + simp [headerStore, headerOps, setupStore, UnaryDecode.setupOps, + Basic.execList, Basic.exec, Function.update_of_ne, h1, h2, h3, h4, + h6, h7, h8, h9, headerOpReg, headerNegated0Reg, headerNegated1Reg, + UnaryDecode.verdictReg, UnaryDecode.valueReg, UnaryDecode.pointerReg, + UnaryDecode.remainingReg, UnaryDecode.oneReg, UnaryDecode.activeReg, + UnaryDecode.inputBase] + change headerStore gate wires (10 + delta) = _ + rw [hpreserved] + simp only [inputStore, Input.bitStore, UnaryDecode.remainingReg, + UnaryDecode.inputBase] + rw [if_neg (by omega : 10 + delta ≠ 3), if_pos (by omega : 7 ≤ 10 + delta)] + have hoffset : 10 + delta - 7 = 3 + delta := by omega + rw [hoffset] + change + (match (inputBits gate wires)[3 + delta]? with + | some bit => Input.bitValue bit + | none => 0) = _ + rw [show inputBits gate wires = + [gate.opBit, gate.negated₀, gate.negated₁] ++ + (CircuitCode.NatCode.encode gate.input₀ ++ + CircuitCode.NatCode.encode gate.input₁ ++ wires) by + simp [inputBits, CircuitCode.RawGate.encode, List.append_assoc]] + rw [List.getElem?_append_right (by simp : + [gate.opBit, gate.negated₀, gate.negated₁].length ≤ 3 + delta)] + simp + rfl + +private theorem header_op (gate : CircuitCode.RawGate) (wires : List Bool) : + headerStore gate wires headerOpReg = Input.bitValue gate.opBit := by + simp [headerStore, headerOps, setupStore, UnaryDecode.setupOps, + Basic.execList, Basic.exec, inputStore, Input.bitStore, inputBits, + CircuitCode.RawGate.encode, headerOpReg, headerNegated0Reg, + headerNegated1Reg, UnaryDecode.verdictReg, UnaryDecode.valueReg, + UnaryDecode.pointerReg, UnaryDecode.remainingReg, UnaryDecode.oneReg, + UnaryDecode.activeReg, UnaryDecode.inputBase] + +private theorem header_negated0 (gate : CircuitCode.RawGate) (wires : List Bool) : + headerStore gate wires headerNegated0Reg = Input.bitValue gate.negated₀ := by + simp [headerStore, headerOps, setupStore, UnaryDecode.setupOps, + Basic.execList, Basic.exec, inputStore, Input.bitStore, inputBits, + CircuitCode.RawGate.encode, headerOpReg, headerNegated0Reg, + headerNegated1Reg, UnaryDecode.verdictReg, UnaryDecode.valueReg, + UnaryDecode.pointerReg, UnaryDecode.remainingReg, UnaryDecode.oneReg, + UnaryDecode.activeReg, UnaryDecode.inputBase] + +private theorem header_negated1 (gate : CircuitCode.RawGate) (wires : List Bool) : + headerStore gate wires headerNegated1Reg = Input.bitValue gate.negated₁ := by + simp [headerStore, headerOps, setupStore, UnaryDecode.setupOps, + Basic.execList, Basic.exec, inputStore, Input.bitStore, inputBits, + CircuitCode.RawGate.encode, headerOpReg, headerNegated0Reg, + headerNegated1Reg, UnaryDecode.verdictReg, UnaryDecode.valueReg, + UnaryDecode.pointerReg, UnaryDecode.remainingReg, UnaryDecode.oneReg, + UnaryDecode.activeReg, UnaryDecode.inputBase] + +private theorem saveRestart_high (store : Store) (index : ℕ) + (hindex : 11 ≤ index) : saveRestartStore store index = store index := by + have h0 : index ≠ UnaryDecode.verdictReg := by + simp only [UnaryDecode.verdictReg] at hindex ⊢ + omega + have h1 : index ≠ UnaryDecode.valueReg := by + simp only [UnaryDecode.valueReg] at hindex ⊢ + omega + have h6 : index ≠ UnaryDecode.activeReg := by + simp only [UnaryDecode.activeReg] at hindex ⊢ + omega + have h10 : index ≠ savedInput0Reg := by + simp only [savedInput0Reg, UnaryDecode.inputBase] at hindex ⊢ + omega + simp [saveRestartStore, saveRestartOps, Basic.execList, Basic.exec, + Function.update_of_ne, h0, h1, h6, h10] + +private theorem saveRestart_apply_of_ne (store : Store) (index : ℕ) + (hsaved : index ≠ savedInput0Reg) + (hverdict : index ≠ UnaryDecode.verdictReg) + (hvalue : index ≠ UnaryDecode.valueReg) + (hactive : index ≠ UnaryDecode.activeReg) : + saveRestartStore store index = store index := by + simp [saveRestartStore, saveRestartOps, Basic.execList, Basic.exec, + Function.update_of_ne, hsaved, hverdict, hvalue, hactive] + +private theorem saveRestart_saved (store : Store) : + saveRestartStore store savedInput0Reg = + store UnaryDecode.valueReg + store UnaryDecode.activeReg := by + simp [saveRestartStore, saveRestartOps, Basic.execList, Basic.exec, + savedInput0Reg, UnaryDecode.inputBase, UnaryDecode.verdictReg, + UnaryDecode.valueReg, UnaryDecode.activeReg] + +private theorem marshal_high (store : Store) (index : ℕ) + (hindex : 11 ≤ index) : marshalStore store index = store index := by + have h0 : index ≠ GateEval.opReg := by + simp only [GateEval.opReg] at hindex ⊢ + omega + have h1 : index ≠ GateEval.negated0Reg := by + simp only [GateEval.negated0Reg] at hindex ⊢ + omega + have h2 : index ≠ GateEval.negated1Reg := by + simp only [GateEval.negated1Reg] at hindex ⊢ + omega + have h3 : index ≠ GateEval.address0Reg := by + simp only [GateEval.address0Reg] at hindex ⊢ + omega + have h4 : index ≠ GateEval.address1Reg := by + simp only [GateEval.address1Reg] at hindex ⊢ + omega + have h5 : index ≠ GateEval.wireCountReg := by + simp only [GateEval.wireCountReg] at hindex ⊢ + omega + have h10 : index ≠ GateEval.baseReg := by + simp only [GateEval.baseReg] at hindex ⊢ + omega + simp [marshalStore, marshalOps, Basic.execList, Basic.exec, + Function.update_of_ne, h0, h1, h2, h3, h4, h5, h10] + +private theorem marshal_wireCount (store : Store) : + marshalStore store GateEval.wireCountReg = + store UnaryDecode.remainingReg + store UnaryDecode.activeReg := by + simp [marshalStore, marshalOps, Basic.execList, Basic.exec, + GateEval.opReg, GateEval.negated0Reg, GateEval.negated1Reg, + GateEval.address0Reg, GateEval.address1Reg, GateEval.wireCountReg, + GateEval.baseReg, UnaryDecode.remainingReg, UnaryDecode.activeReg] + +private theorem marshal_address1 (store : Store) : + marshalStore store GateEval.address1Reg = + store UnaryDecode.valueReg + store UnaryDecode.activeReg := by + simp [marshalStore, marshalOps, Basic.execList, Basic.exec, + GateEval.opReg, GateEval.negated0Reg, GateEval.negated1Reg, + GateEval.address0Reg, GateEval.address1Reg, GateEval.wireCountReg, + GateEval.baseReg, UnaryDecode.valueReg, UnaryDecode.activeReg] + +private theorem marshal_address0 (store : Store) : + marshalStore store GateEval.address0Reg = + store savedInput0Reg + store UnaryDecode.activeReg := by + simp [marshalStore, marshalOps, Basic.execList, Basic.exec, + GateEval.opReg, GateEval.negated0Reg, GateEval.negated1Reg, + GateEval.address0Reg, GateEval.address1Reg, GateEval.wireCountReg, + GateEval.baseReg, savedInput0Reg, UnaryDecode.inputBase, + UnaryDecode.activeReg] + +private theorem marshal_base (store : Store) : + marshalStore store GateEval.baseReg = + store UnaryDecode.pointerReg + store UnaryDecode.activeReg := by + simp [marshalStore, marshalOps, Basic.execList, Basic.exec, + GateEval.opReg, GateEval.negated0Reg, GateEval.negated1Reg, + GateEval.address0Reg, GateEval.address1Reg, GateEval.wireCountReg, + GateEval.baseReg, UnaryDecode.pointerReg, UnaryDecode.activeReg] + +private theorem marshal_op (store : Store) : + marshalStore store GateEval.opReg = + store headerOpReg + store UnaryDecode.activeReg := by + simp [marshalStore, marshalOps, Basic.execList, Basic.exec, + GateEval.opReg, GateEval.negated0Reg, GateEval.negated1Reg, + GateEval.address0Reg, GateEval.address1Reg, GateEval.wireCountReg, + GateEval.baseReg, headerOpReg, UnaryDecode.inputBase, + UnaryDecode.activeReg] + +private theorem marshal_negated0 (store : Store) : + marshalStore store GateEval.negated0Reg = + store headerNegated0Reg + store UnaryDecode.activeReg := by + simp [marshalStore, marshalOps, Basic.execList, Basic.exec, + GateEval.opReg, GateEval.negated0Reg, GateEval.negated1Reg, + GateEval.address0Reg, GateEval.address1Reg, GateEval.wireCountReg, + GateEval.baseReg, headerNegated0Reg, UnaryDecode.inputBase, + UnaryDecode.activeReg] + +private theorem marshal_negated1 (store : Store) : + marshalStore store GateEval.negated1Reg = + store headerNegated1Reg + store UnaryDecode.activeReg := by + simp [marshalStore, marshalOps, Basic.execList, Basic.exec, + GateEval.opReg, GateEval.negated0Reg, GateEval.negated1Reg, + GateEval.address0Reg, GateEval.address1Reg, GateEval.wireCountReg, + GateEval.baseReg, headerNegated1Reg, UnaryDecode.inputBase, + UnaryDecode.activeReg] + +private theorem copyAdd_measured {bound dst src active : ℕ} {store : Store} + (hstore : StoreEnvelope bound bound store) (hdst : dst < bound) + (hactive : store active = 0) (hne : dst ≠ active) : + MeasuredRuns (.basic (.add dst src active)) store + ((Basic.add dst src active).exec store) 1 + (4 * valueWidth bound) (envelopeSpace bound bound) ∧ + StoreEnvelope bound bound ((Basic.add dst src active).exec store) ∧ + (Basic.add dst src active).exec store active = 0 := by + have hnext : StoreEnvelope bound bound + ((Basic.add dst src active).exec store) := by + apply hstore.execBasic (.add dst src active) + · exact hdst + · change store src + store active ≤ bound + rw [hactive, Nat.add_zero] + exact hstore.value_le src + refine ⟨MeasuredRuns.basicEnvelope (.add dst src active) store hstore hnext, + hnext, ?_⟩ + simp [Basic.exec, Function.update_of_ne (Ne.symm hne), hactive] + +private theorem saveRestart_measured {bound : ℕ} {store : Store} + (hstore : StoreEnvelope bound bound store) (hsmall : 10 < bound) + (hactive : store UnaryDecode.activeReg = 0) : + MeasuredRuns (.basics saveRestartOps) store (saveRestartStore store) 4 + (16 * valueWidth bound) (envelopeSpace bound bound) ∧ + StoreEnvelope bound bound (saveRestartStore store) := by + let s1 := (Basic.add savedInput0Reg UnaryDecode.valueReg + UnaryDecode.activeReg).exec store + let s2 := (Basic.imm UnaryDecode.verdictReg 0).exec s1 + let s3 := (Basic.imm UnaryDecode.valueReg 0).exec s2 + have h1 := copyAdd_measured hstore + (dst := savedInput0Reg) (src := UnaryDecode.valueReg) + (active := UnaryDecode.activeReg) + (by simp [savedInput0Reg, UnaryDecode.inputBase]; omega) hactive + (by simp [savedInput0Reg, UnaryDecode.activeReg, UnaryDecode.inputBase]) + have h2 : StoreEnvelope bound bound s2 := by + apply h1.2.1.execBasic (.imm UnaryDecode.verdictReg 0) + · simp [UnaryDecode.verdictReg] + omega + · simp [Basic.writeValue] + have h3 : StoreEnvelope bound bound s3 := by + apply h2.execBasic (.imm UnaryDecode.valueReg 0) + · simp [UnaryDecode.valueReg] + omega + · simp [Basic.writeValue] + have h4 : StoreEnvelope bound bound (saveRestartStore store) := by + change StoreEnvelope bound bound + ((Basic.imm UnaryDecode.activeReg 1).exec s3) + apply h3.execBasic (.imm UnaryDecode.activeReg 1) + · simp [UnaryDecode.activeReg] + omega + · simp [Basic.writeValue] + omega + have r2 := MeasuredRuns.basicEnvelope (.imm UnaryDecode.verdictReg 0) + s1 h1.2.1 h2 + have r3 := MeasuredRuns.basicEnvelope (.imm UnaryDecode.valueReg 0) s2 h2 h3 + have r4 := MeasuredRuns.basicEnvelope (.imm UnaryDecode.activeReg 1) s3 h3 h4 + refine ⟨?_, h4⟩ + have hrun := h1.1.seq (r2.seq (r3.seq r4)) + convert hrun using 1 + ring + +private theorem marshal_measured {bound : ℕ} {store : Store} + (hstore : StoreEnvelope bound bound store) (hsmall : 10 < bound) + (hactive : store UnaryDecode.activeReg = 0) : + MeasuredRuns (.basics marshalOps) store (marshalStore store) 7 + (28 * valueWidth bound) (envelopeSpace bound bound) ∧ + StoreEnvelope bound bound (marshalStore store) := by + let s1 := (Basic.add GateEval.wireCountReg UnaryDecode.remainingReg + UnaryDecode.activeReg).exec store + let s2 := (Basic.add GateEval.address1Reg UnaryDecode.valueReg + UnaryDecode.activeReg).exec s1 + let s3 := (Basic.add GateEval.address0Reg savedInput0Reg + UnaryDecode.activeReg).exec s2 + let s4 := (Basic.add GateEval.baseReg UnaryDecode.pointerReg + UnaryDecode.activeReg).exec s3 + let s5 := (Basic.add GateEval.opReg headerOpReg + UnaryDecode.activeReg).exec s4 + let s6 := (Basic.add GateEval.negated0Reg headerNegated0Reg + UnaryDecode.activeReg).exec s5 + have r1 := copyAdd_measured hstore + (dst := GateEval.wireCountReg) (src := UnaryDecode.remainingReg) + (active := UnaryDecode.activeReg) (by simp [GateEval.wireCountReg]; omega) + hactive (by simp [GateEval.wireCountReg, UnaryDecode.activeReg]) + have r2 := copyAdd_measured r1.2.1 + (dst := GateEval.address1Reg) (src := UnaryDecode.valueReg) + (active := UnaryDecode.activeReg) (by simp [GateEval.address1Reg]; omega) + r1.2.2 (by simp [GateEval.address1Reg, UnaryDecode.activeReg]) + have r3 := copyAdd_measured r2.2.1 + (dst := GateEval.address0Reg) (src := savedInput0Reg) + (active := UnaryDecode.activeReg) (by simp [GateEval.address0Reg]; omega) + r2.2.2 (by simp [GateEval.address0Reg, UnaryDecode.activeReg]) + have r4 := copyAdd_measured r3.2.1 + (dst := GateEval.baseReg) (src := UnaryDecode.pointerReg) + (active := UnaryDecode.activeReg) (by simp [GateEval.baseReg]; omega) + r3.2.2 (by simp [GateEval.baseReg, UnaryDecode.activeReg]) + have r5 := copyAdd_measured r4.2.1 + (dst := GateEval.opReg) (src := headerOpReg) + (active := UnaryDecode.activeReg) (by simp [GateEval.opReg]; omega) + r4.2.2 (by simp [GateEval.opReg, UnaryDecode.activeReg]) + have r6 := copyAdd_measured r5.2.1 + (dst := GateEval.negated0Reg) (src := headerNegated0Reg) + (active := UnaryDecode.activeReg) (by simp [GateEval.negated0Reg]; omega) + r5.2.2 (by simp [GateEval.negated0Reg, UnaryDecode.activeReg]) + have r7 := copyAdd_measured r6.2.1 + (dst := GateEval.negated1Reg) (src := headerNegated1Reg) + (active := UnaryDecode.activeReg) (by simp [GateEval.negated1Reg]; omega) + r6.2.2 (by simp [GateEval.negated1Reg, UnaryDecode.activeReg]) + refine ⟨?_, ?_⟩ + · have hrun := r1.1.seq (r2.1.seq (r3.1.seq + (r4.1.seq (r5.1.seq (r6.1.seq r7.1))))) + convert hrun using 1 + ring + · simpa [marshalStore, marshalOps, s1, s2, s3, s4, s5, s6] using r7.2.1 + +private theorem input_wire (gate : CircuitCode.RawGate) (wires : List Bool) + (index : ℕ) : + inputStore gate wires (memoBase gate + index) = + match wires[index]? with + | some bit => Input.bitValue bit + | none => 0 := by + have hbase : UnaryDecode.inputBase ≤ memoBase gate + index := by + simp [memoBase] + omega + have hlength : memoBase gate + index ≠ UnaryDecode.remainingReg := by + simp only [memoBase, UnaryDecode.inputBase, UnaryDecode.remainingReg] + omega + simp only [inputStore, Input.bitStore] + rw [if_neg hlength, if_pos hbase] + have hoffset : memoBase gate + index - UnaryDecode.inputBase = + gate.encode.length + index := by + simp [memoBase] + omega + rw [hoffset, inputBits, List.getElem?_append_right (by omega)] + simp + rfl + +theorem program_measured_internal (gate : CircuitCode.RawGate) (wires : List Bool) + (value0 value1 : Bool) (hvalue0 : wires[gate.input₀]? = some value0) + (hvalue1 : wires[gate.input₁]? = some value1) : + ∃ final cost space, + Exec program (inputStore gate wires) final (stepCount gate) cost space ∧ + cost ≤ timeBound gate wires ∧ space ≤ spaceBound gate wires ∧ + final GateEval.outputReg = Input.bitValue (gate.eval value0 value1) ∧ + final (memoBase gate + wires.length) = + Input.bitValue (gate.eval value0 value1) ∧ + ∀ index (hindex : index < wires.length), + final (memoBase gate + index) = Input.bitValue wires[index] := by + let firstRemaining := CircuitCode.NatCode.encode gate.input₀ ++ + CircuitCode.NatCode.encode gate.input₁ ++ wires + let secondRemaining := CircuitCode.NatCode.encode gate.input₁ ++ wires + have hheaderReady : UnaryDecode.CursorReady (inputBits gate wires).length + firstRemaining 3 0 (headerStore gate wires) := by + simpa [firstRemaining] using header_cursorReady gate wires + have hheaderBound : StoreEnvelope + ((inputBits gate wires).length + UnaryDecode.inputBase) + ((inputBits gate wires).length + UnaryDecode.inputBase) + (headerStore gate wires) := by + simpa [cursorBound] using header_bound gate wires + obtain ⟨first, firstCost, firstSpace, hfirst, hfirstCost, hfirstSpace, + hfirstResult, hfirstActive, hfirstOne, hfirstFrame, hfirstBound⟩ := + UnaryDecode.mainLoop_measured_internal hheaderReady hheaderBound + have hdecode0 : CircuitCode.NatCode.decodePrefix? firstRemaining = + some (gate.input₀, secondRemaining) := by + simp [firstRemaining, secondRemaining, List.append_assoc] + rw [hdecode0] at hfirstResult + simp only at hfirstResult + have hfirstVerdict : first UnaryDecode.verdictReg = 1 := hfirstResult.1 + have hfirstValue : first UnaryDecode.valueReg = gate.input₀ := by + simpa using hfirstResult.2.1 + have hfirstPointer : first UnaryDecode.pointerReg = + UnaryDecode.inputBase + 3 + gate.input₀ + 1 := hfirstResult.2.2.1 + have hfirstRemaining : first UnaryDecode.remainingReg = secondRemaining.length := + hfirstResult.2.2.2 + let saved := saveRestartStore first + have hlarge : 10 < cursorBound gate wires := by + simp [cursorBound, inputBits, CircuitCode.RawGate.encode, + UnaryDecode.inputBase] + have hsaved0 : CursorEnvelope gate wires + ((Basic.add savedInput0Reg UnaryDecode.valueReg + UnaryDecode.activeReg).exec first) := by + apply hfirstBound.execBasic + · simpa [savedInput0Reg, UnaryDecode.inputBase] using hlarge + · change first UnaryDecode.valueReg + first UnaryDecode.activeReg ≤ + cursorBound gate wires + rw [hfirstValue, hfirstActive] + simp [cursorBound, inputBits, CircuitCode.RawGate.encode, + UnaryDecode.inputBase] + omega + have hsaved1 := hsaved0.execBasic (.imm UnaryDecode.verdictReg 0) + (by simpa [Basic.writeIndex, UnaryDecode.verdictReg] using + (lt_trans (by decide : 0 < 10) hlarge)) (by simp [Basic.writeValue]) + have hsaved2 := hsaved1.execBasic (.imm UnaryDecode.valueReg 0) + (by simpa [Basic.writeIndex, UnaryDecode.valueReg] using + (lt_trans (by decide : 1 < 10) hlarge)) (by simp [Basic.writeValue]) + have hsavedBound : CursorEnvelope gate wires saved := by + have hsaved3 := hsaved2.execBasic (.imm UnaryDecode.activeReg 1) + (by simpa [Basic.writeIndex, UnaryDecode.activeReg] using + (lt_trans (by decide : 6 < 10) hlarge)) (by + have h := hlarge + simp only [Basic.writeValue] + omega) + simpa [saved, saveRestartStore, saveRestartOps, Basic.execList] using hsaved3 + have hsecondReady : UnaryDecode.CursorReady (inputBits gate wires).length + secondRemaining (4 + gate.input₀) 0 saved := by + constructor + · simp [secondRemaining, inputBits, CircuitCode.RawGate.encode] + omega + · omega + · simp [saved, saveRestartStore, saveRestartOps, Basic.execList, Basic.exec, + UnaryDecode.verdictReg, UnaryDecode.valueReg, UnaryDecode.activeReg] + · simp [saved, saveRestartStore, saveRestartOps, Basic.execList, Basic.exec, + UnaryDecode.verdictReg, UnaryDecode.valueReg, UnaryDecode.activeReg] + · change saved UnaryDecode.pointerReg = _ + rw [show saved UnaryDecode.pointerReg = first UnaryDecode.pointerReg by + apply saveRestart_apply_of_ne <;> + simp [savedInput0Reg, UnaryDecode.verdictReg, UnaryDecode.valueReg, + UnaryDecode.pointerReg, UnaryDecode.activeReg, + UnaryDecode.inputBase]] + rw [hfirstPointer] + omega + · change saved UnaryDecode.remainingReg = secondRemaining.length + rw [show saved UnaryDecode.remainingReg = first UnaryDecode.remainingReg by + apply saveRestart_apply_of_ne <;> + simp [savedInput0Reg, UnaryDecode.verdictReg, UnaryDecode.valueReg, + UnaryDecode.remainingReg, UnaryDecode.activeReg, + UnaryDecode.inputBase]] + exact hfirstRemaining + · change saved UnaryDecode.oneReg = 1 + rw [show saved UnaryDecode.oneReg = first UnaryDecode.oneReg by + apply saveRestart_apply_of_ne <;> + simp [savedInput0Reg, UnaryDecode.verdictReg, UnaryDecode.valueReg, + UnaryDecode.oneReg, UnaryDecode.activeReg, + UnaryDecode.inputBase]] + exact hfirstOne + · simp [saved, saveRestartStore, saveRestartOps, Basic.execList, Basic.exec, + UnaryDecode.verdictReg, UnaryDecode.valueReg, UnaryDecode.activeReg] + · intro delta + have hsavedHigh : saved + (UnaryDecode.inputBase + (4 + gate.input₀) + delta) = + first (UnaryDecode.inputBase + (4 + gate.input₀) + delta) := by + apply saveRestart_high + simp [UnaryDecode.inputBase] + omega + rw [hsavedHigh, hfirstFrame _ (by + simp [UnaryDecode.inputBase] + omega)] + have hinput := hheaderReady.input_eq (gate.input₀ + 1 + delta) + have hlookup : firstRemaining[gate.input₀ + 1 + delta]? = + secondRemaining[delta]? := by + rw [show firstRemaining = CircuitCode.NatCode.encode gate.input₀ ++ + secondRemaining by simp [firstRemaining, secondRemaining, + List.append_assoc]] + rw [List.getElem?_append_right (by simp)] + simp + rw [hlookup] at hinput + simpa [Nat.add_assoc, Nat.add_comm, Nat.add_left_comm] using hinput + have hsecondBound : StoreEnvelope + ((inputBits gate wires).length + UnaryDecode.inputBase) + ((inputBits gate wires).length + UnaryDecode.inputBase) saved := by + simpa [cursorBound] using hsavedBound + obtain ⟨second, secondCost, secondSpace, hsecond, hsecondCost, hsecondSpace, + hsecondResult, hsecondActive, _hsecondOne, hsecondFrame, hsecondFinalBound⟩ := + UnaryDecode.mainLoop_measured_internal hsecondReady hsecondBound + have hdecode1 : CircuitCode.NatCode.decodePrefix? secondRemaining = + some (gate.input₁, wires) := by + simp [secondRemaining] + rw [hdecode1] at hsecondResult + simp only at hsecondResult + have hsecondValue : second UnaryDecode.valueReg = gate.input₁ := by + simpa using hsecondResult.2.1 + have hsecondPointer : second UnaryDecode.pointerReg = memoBase gate := by + have hp := hsecondResult.2.2.1 + rw [hp] + simp [memoBase, CircuitCode.RawGate.length_encode, + UnaryDecode.inputBase] + omega + have hsecondRemaining : second UnaryDecode.remainingReg = wires.length := + hsecondResult.2.2.2 + have hsecondOp : second headerOpReg = Input.bitValue gate.opBit := by + rw [hsecondFrame _ (by simp [headerOpReg, UnaryDecode.inputBase])] + rw [show saved headerOpReg = first headerOpReg by + apply saveRestart_apply_of_ne <;> + simp [headerOpReg, savedInput0Reg, UnaryDecode.verdictReg, + UnaryDecode.valueReg, UnaryDecode.activeReg, UnaryDecode.inputBase]] + rw [hfirstFrame _ (by simp [headerOpReg, UnaryDecode.inputBase])] + exact header_op gate wires + have hsecondNegated0 : second headerNegated0Reg = + Input.bitValue gate.negated₀ := by + rw [hsecondFrame _ (by simp [headerNegated0Reg, UnaryDecode.inputBase])] + rw [show saved headerNegated0Reg = first headerNegated0Reg by + apply saveRestart_apply_of_ne <;> + simp [headerNegated0Reg, savedInput0Reg, UnaryDecode.verdictReg, + UnaryDecode.valueReg, UnaryDecode.activeReg, UnaryDecode.inputBase]] + rw [hfirstFrame _ (by simp [headerNegated0Reg, UnaryDecode.inputBase])] + exact header_negated0 gate wires + have hsecondNegated1 : second headerNegated1Reg = + Input.bitValue gate.negated₁ := by + rw [hsecondFrame _ (by simp [headerNegated1Reg, UnaryDecode.inputBase])] + rw [show saved headerNegated1Reg = first headerNegated1Reg by + apply saveRestart_apply_of_ne <;> + simp [headerNegated1Reg, savedInput0Reg, UnaryDecode.verdictReg, + UnaryDecode.valueReg, UnaryDecode.activeReg, UnaryDecode.inputBase]] + rw [hfirstFrame _ (by simp [headerNegated1Reg, UnaryDecode.inputBase])] + exact header_negated1 gate wires + have hsecondInput0 : second savedInput0Reg = gate.input₀ := by + rw [hsecondFrame _ (by simp [savedInput0Reg, UnaryDecode.inputBase])] + rw [show saved savedInput0Reg = + first UnaryDecode.valueReg + first UnaryDecode.activeReg by + exact saveRestart_saved first] + rw [hfirstValue, hfirstActive] + omega + let marshaled := marshalStore second + have hready : GateEval.ReadyAt (memoBase gate) gate wires marshaled := by + constructor + · simp [memoBase, CircuitCode.RawGate.length_encode, GateEval.wireBase, + UnaryDecode.inputBase] + omega + · change marshalStore second GateEval.opReg = _ + rw [marshal_op, hsecondOp, hsecondActive] + omega + · change marshalStore second GateEval.negated0Reg = _ + rw [marshal_negated0, hsecondNegated0, hsecondActive] + omega + · change marshalStore second GateEval.negated1Reg = _ + rw [marshal_negated1, hsecondNegated1, hsecondActive] + omega + · change marshalStore second GateEval.address0Reg = gate.input₀ + rw [marshal_address0, hsecondInput0, hsecondActive] + omega + · change marshalStore second GateEval.address1Reg = gate.input₁ + rw [marshal_address1, hsecondValue, hsecondActive] + omega + · change marshalStore second GateEval.wireCountReg = wires.length + rw [marshal_wireCount, hsecondRemaining, hsecondActive] + omega + · change marshalStore second GateEval.baseReg = memoBase gate + rw [marshal_base, hsecondPointer, hsecondActive] + omega + · intro index hindex + change marshalStore second (memoBase gate + index) = _ + rw [marshal_high second _ (by + simp [memoBase, CircuitCode.RawGate.length_encode, + UnaryDecode.inputBase] + omega)] + rw [hsecondFrame _ (by + simp [memoBase, CircuitCode.RawGate.length_encode, + UnaryDecode.inputBase] + omega)] + change saveRestartStore first (memoBase gate + index) = _ + rw [saveRestart_high first _ (by + simp [memoBase, CircuitCode.RawGate.length_encode, + UnaryDecode.inputBase] + omega)] + rw [hfirstFrame _ (by + simp [memoBase, CircuitCode.RawGate.length_encode, + UnaryDecode.inputBase] + omega)] + rw [header_high gate wires _ (by + simp [memoBase, CircuitCode.RawGate.length_encode, + UnaryDecode.inputBase] + omega)] + exact input_wire gate wires index + have hcursorLe : cursorBound gate wires ≤ storeBound gate wires := by + simp [cursorBound, storeBound] + have hwidthLe : valueWidth (cursorBound gate wires) ≤ + valueWidth (storeBound gate wires) := by + have hsize := Nat.size_le_size hcursorLe + simpa [valueWidth, bitlen] using Nat.add_le_add_right hsize 1 + have hspaceLe : envelopeSpace (cursorBound gate wires) + (cursorBound gate wires) ≤ + envelopeSpace (storeBound gate wires) (storeBound gate wires) := by + unfold envelopeSpace + have hsize := Nat.size_le_size hcursorLe + apply Nat.mul_le_mul hcursorLe + simpa [bitlen] using Nat.add_le_add hsize hsize + have hsetup := (setup_measured gate wires).1 + have hheader := (header_measured gate wires).1 + have hsave := (saveRestart_measured hfirstBound hlarge hfirstActive).1 + have hmarshal := + (marshal_measured hsecondFinalBound hlarge hsecondActive).1 + have hmarshaledBound : StoreEnvelope (storeBound gate wires) + (storeBound gate wires) marshaled := by + apply (marshal_measured hsecondFinalBound hlarge hsecondActive).2.mono + · exact hcursorLe + · exact hcursorLe + have happendAddress : memoBase gate + wires.length < + storeBound gate wires := by + simp [memoBase, storeBound, inputBits, CircuitCode.RawGate.length_encode, + UnaryDecode.inputBase] + omega + obtain ⟨final, hgate, hfinalBound, houtput, happended, _hbase, _hcount, + hpreserved, _hframe⟩ := + GateEval.routine_measured_internal hready hmarshaledBound + value0 value1 hvalue0 hvalue1 happendAddress + have hsetup' := hsetup.weaken + (Nat.mul_le_mul_left 20 hwidthLe) hspaceLe + have hheader' := hheader.weaken + (Nat.mul_le_mul_left 36 hwidthLe) hspaceLe + have hfirstCost' : UnaryDecode.timeBound (inputBits gate wires).length ≤ + 96 * ((inputBits gate wires).length + 1) * + valueWidth (storeBound gate wires) := by + rw [UnaryDecode.timeBound] + apply Nat.mul_le_mul_left + exact hwidthLe + have hfirst' : MeasuredRuns UnaryDecode.mainLoop (headerStore gate wires) + first (UnaryDecode.loopStepCount firstRemaining) + (96 * ((inputBits gate wires).length + 1) * + valueWidth (storeBound gate wires)) + (envelopeSpace (storeBound gate wires) (storeBound gate wires)) := + ⟨firstCost, firstSpace, hfirst, le_trans hfirstCost hfirstCost', + le_trans hfirstSpace (by + simpa [UnaryDecode.spaceBound, envelopeSpace, cursorBound, two_mul] + using hspaceLe)⟩ + have hsave' := hsave.weaken + (Nat.mul_le_mul_left 16 hwidthLe) hspaceLe + have hsecond' : MeasuredRuns UnaryDecode.mainLoop saved + second (UnaryDecode.loopStepCount secondRemaining) + (96 * ((inputBits gate wires).length + 1) * + valueWidth (storeBound gate wires)) + (envelopeSpace (storeBound gate wires) (storeBound gate wires)) := + ⟨secondCost, secondSpace, hsecond, le_trans hsecondCost hfirstCost', + le_trans hsecondSpace (by + simpa [UnaryDecode.spaceBound, envelopeSpace, cursorBound, two_mul] + using hspaceLe)⟩ + have hmarshal' := hmarshal.weaken + (Nat.mul_le_mul_left 28 hwidthLe) hspaceLe + have hrun := hsetup'.seq (hheader'.seq (hfirst'.seq + (hsave'.seq (hsecond'.seq (hmarshal'.seq hgate))))) + have hsteps : + UnaryDecode.setupOps.length + + (headerOps.length + (UnaryDecode.loopStepCount firstRemaining + + (saveRestartOps.length + + (UnaryDecode.loopStepCount secondRemaining + + (marshalOps.length + GateEval.stepCount))))) = + stepCount gate := by + simp [UnaryDecode.setupOps, headerOps, saveRestartOps, marshalOps, + UnaryDecode.loopStepCount, hdecode0, hdecode1, GateEval.stepCount, + stepCount] + omega + have hrun' : MeasuredRuns program (inputStore gate wires) final + (UnaryDecode.setupOps.length + + (headerOps.length + (UnaryDecode.loopStepCount firstRemaining + + (saveRestartOps.length + + (UnaryDecode.loopStepCount secondRemaining + + (marshalOps.length + GateEval.stepCount)))))) + (20 * valueWidth (storeBound gate wires) + + (36 * valueWidth (storeBound gate wires) + + (96 * ((inputBits gate wires).length + 1) * + valueWidth (storeBound gate wires) + + (16 * valueWidth (storeBound gate wires) + + (96 * ((inputBits gate wires).length + 1) * + valueWidth (storeBound gate wires) + + (28 * valueWidth (storeBound gate wires) + + 80 * valueWidth (storeBound gate wires))))))) + (envelopeSpace (storeBound gate wires) (storeBound gate wires)) := by + simpa [program, UnaryDecode.setup, setupStore, saved, marshaled, + saveRestartStore, marshalStore] using hrun + have hcostLe : + 20 * valueWidth (storeBound gate wires) + + (36 * valueWidth (storeBound gate wires) + + (96 * ((inputBits gate wires).length + 1) * + valueWidth (storeBound gate wires) + + (16 * valueWidth (storeBound gate wires) + + (96 * ((inputBits gate wires).length + 1) * + valueWidth (storeBound gate wires) + + (28 * valueWidth (storeBound gate wires) + + 80 * valueWidth (storeBound gate wires)))))) ≤ + timeBound gate wires := by + rw [timeBound] + change _ ≤ 512 * ((inputBits gate wires).length + 1) * + valueWidth (storeBound gate wires) + calc + _ = (192 * ((inputBits gate wires).length + 1) + 180) * + valueWidth (storeBound gate wires) := by ring + _ ≤ (512 * ((inputBits gate wires).length + 1)) * + valueWidth (storeBound gate wires) := + Nat.mul_le_mul_right _ (by omega) + _ = _ := by ring + have hprogram : MeasuredRuns program (inputStore gate wires) final + (stepCount gate) (timeBound gate wires) + (envelopeSpace (storeBound gate wires) (storeBound gate wires)) := by + rw [← hsteps] + exact hrun'.weakenCost hcostLe + obtain ⟨cost, space, hexec, hcost, hspace⟩ := hprogram + have hspaceBound : space ≤ spaceBound gate wires := by + simpa [spaceBound, envelopeSpace, two_mul] using hspace + exact ⟨final, cost, space, hexec, hcost, hspaceBound, + houtput, happended, hpreserved⟩ + +theorem program_exec_internal (gate : CircuitCode.RawGate) (wires : List Bool) + (value0 value1 : Bool) (hvalue0 : wires[gate.input₀]? = some value0) + (hvalue1 : wires[gate.input₁]? = some value1) : + ∃ final cost space, + Exec program (inputStore gate wires) final (stepCount gate) cost space ∧ + final GateEval.outputReg = Input.bitValue (gate.eval value0 value1) ∧ + final (memoBase gate + wires.length) = + Input.bitValue (gate.eval value0 value1) ∧ + ∀ index (hindex : index < wires.length), + final (memoBase gate + index) = Input.bitValue wires[index] := by + obtain ⟨final, cost, space, hexec, _hcost, _hspace, + houtput, happended, hpreserved⟩ := + program_measured_internal gate wires value0 value1 hvalue0 hvalue1 + exact ⟨final, cost, space, hexec, houtput, happended, hpreserved⟩ + +end GateStep + +end Structured + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/GateStreamStep.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/GateStreamStep.lean new file mode 100644 index 0000000000..8f040761b6 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/GateStreamStep.lean @@ -0,0 +1,101 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.GateStreamStep.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.GateStreamStep.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured + +/-! +# Verified structured RAM iterable serialized-gate step + +This module exposes the split-layout gate routine used by the serialized-circuit +experiment. Code and mutable memo occupy disjoint regions, so the exact same +routine can be invoked again at the returned cursor. +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace Structured + +namespace GateStreamStep + +/-- Consume and evaluate one gate while preserving the unread code tail and +advancing the independent mutable memo. -/ +theorem routine_correct {gateStart base : ℕ} {gate : CircuitCode.RawGate} + {tail wires : List Bool} {store : Store} + (hready : Ready gateStart base gate tail wires store) + (hbound : Internal.StoreEnvelope (codeEnd gateStart gate tail) + (codeEnd gateStart gate tail) store) + (value0 value1 : Bool) (hvalue0 : wires[gate.input₀]? = some value0) + (hvalue1 : wires[gate.input₁]? = some value1) : + ∃ final cost space, + Exec routine store final (stepCount gate) cost space ∧ + final UnaryDecode.pointerReg = gateStart + gate.encode.length ∧ + final UnaryDecode.remainingReg = tail.length ∧ + final memoBaseReg = base ∧ + final wireCountMetaReg = wires.length + 1 ∧ + final (base + wires.length) = + Input.bitValue (gate.eval value0 value1) ∧ + (∀ index (hindex : index < wires.length), + final (base + index) = Input.bitValue wires[index]) ∧ + ∀ delta, + final (gateStart + gate.encode.length + delta) = + match tail[delta]? with + | some bit => Input.bitValue bit + | none => 0 := + routine_exec_internal hready hbound value0 value1 hvalue0 hvalue1 + +/-- Structural compilation transfers the exact iterable-gate execution, +including its logarithmic cost and peak-space measurements. -/ +theorem compiled_correct {gateStart base : ℕ} {gate : CircuitCode.RawGate} + {tail wires : List Bool} {store : Store} + (hready : Ready gateStart base gate tail wires store) + (hbound : Internal.StoreEnvelope (codeEnd gateStart gate tail) + (codeEnd gateStart gate tail) store) + (value0 value1 : Bool) (hvalue0 : wires[gate.input₀]? = some value0) + (hvalue1 : wires[gate.input₁]? = some value1) : + ∃ final cost space, + Exec routine store final (stepCount gate) cost space ∧ + run compiled (stepCount gate) { pc := 0, regs := store } = + { pc := routine.codeSize, regs := final } ∧ + Halted compiled + (run compiled (stepCount gate) { pc := 0, regs := store }) ∧ + logTimeUpto compiled (stepCount gate) { pc := 0, regs := store } = cost ∧ + spaceUpto compiled (stepCount gate) { pc := 0, regs := store } = space ∧ + final UnaryDecode.pointerReg = gateStart + gate.encode.length ∧ + final UnaryDecode.remainingReg = tail.length ∧ + final memoBaseReg = base ∧ + final wireCountMetaReg = wires.length + 1 ∧ + final (base + wires.length) = + Input.bitValue (gate.eval value0 value1) ∧ + (∀ index (hindex : index < wires.length), + final (base + index) = Input.bitValue wires[index]) ∧ + ∀ delta, + final (gateStart + gate.encode.length + delta) = + match tail[delta]? with + | some bit => Input.bitValue bit + | none => 0 := by + obtain ⟨final, cost, space, hexec, hpointer, hremaining, hbase, + hcount, happended, hwires, htail⟩ := + routine_correct hready hbound value0 value1 hvalue0 hvalue1 + have hcompiled := Exec.compile_correct hexec + exact ⟨final, cost, space, hexec, hcompiled.1, Exec.compile_halted hexec, + hcompiled.2.1, hcompiled.2.2, hpointer, hremaining, hbase, hcount, + happended, hwires, htail⟩ + +end GateStreamStep + +end Structured + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/GateStreamStep/Defs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/GateStreamStep/Defs.lean new file mode 100644 index 0000000000..4597ae3380 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/GateStreamStep/Defs.lean @@ -0,0 +1,209 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.GateEval.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.UnaryDecode.Defs + +/-! +# Structured RAM iterable serialized-gate step — definitions + +Unlike the compact `GateStep` benchmark, this routine keeps the code cursor and +mutable wire memo physically separate. Registers `7` and `8` carry the memo base +and current wire count while the parser consumes a gate from a higher code +region. Two fixed continuation cells lie between the evaluator's control prefix +and the memo, so cursor state survives gate evaluation without aliasing either +mutable wires or unread code. +-/ + + +@[expose] public section + +namespace Complexity + +namespace RAM + +namespace Structured + +namespace GateStreamStep + +/-- Physical base of the mutable wire memo. -/ +def memoBaseReg : ℕ := 7 +/-- Number of semantic entries currently in the wire memo. -/ +def wireCountMetaReg : ℕ := 8 +/-- Address of the current gate's first header bit. -/ +def gateStartReg : ℕ := 9 +/-- First decoded reference retained across the second unary decode. -/ +def savedInput0Reg : ℕ := 10 +/-- Fixed spill cell for the next code pointer. -/ +def spillPointerReg : ℕ := 11 +/-- Fixed spill cell for the unread-code count. -/ +def spillRemainingReg : ℕ := 12 + +/-- Initialize parser scratch and remember the current gate start. -/ +def setupOps : List Basic := + [.imm UnaryDecode.verdictReg 0, + .imm UnaryDecode.valueReg 0, + .imm UnaryDecode.oneReg 1, + .imm UnaryDecode.activeReg 1, + .imm gateStartReg 0, + .add gateStartReg UnaryDecode.pointerReg gateStartReg] + +/-- Consume the fixed three-bit gate header without copying it. The header is +loaded from its saved code address only after both references are decoded. -/ +def headerOps : List Basic := + [.add UnaryDecode.pointerReg UnaryDecode.pointerReg UnaryDecode.oneReg, + .sub UnaryDecode.remainingReg UnaryDecode.remainingReg UnaryDecode.oneReg, + .add UnaryDecode.pointerReg UnaryDecode.pointerReg UnaryDecode.oneReg, + .sub UnaryDecode.remainingReg UnaryDecode.remainingReg UnaryDecode.oneReg, + .add UnaryDecode.pointerReg UnaryDecode.pointerReg UnaryDecode.oneReg, + .sub UnaryDecode.remainingReg UnaryDecode.remainingReg UnaryDecode.oneReg] + +/-- Save the first reference and restart the unary accumulator. -/ +def saveRestartOps : List Basic := + [.add savedInput0Reg UnaryDecode.valueReg UnaryDecode.activeReg, + .imm UnaryDecode.verdictReg 0, + .imm UnaryDecode.valueReg 0, + .imm UnaryDecode.activeReg 1] + +/-- Spill the continuation cursor, load the saved header, and marshal the gate +and independent memo metadata into `GateEval`'s calling convention. -/ +def marshalOps : List Basic := + [.add GateEval.wireCountReg wireCountMetaReg UnaryDecode.activeReg, + .imm wireCountMetaReg spillPointerReg, + .store wireCountMetaReg UnaryDecode.pointerReg, + .imm wireCountMetaReg spillRemainingReg, + .store wireCountMetaReg UnaryDecode.remainingReg, + .add GateEval.address1Reg UnaryDecode.valueReg UnaryDecode.activeReg, + .add GateEval.address0Reg savedInput0Reg UnaryDecode.activeReg, + .add GateEval.baseReg memoBaseReg UnaryDecode.activeReg, + .imm wireCountMetaReg 1, + .load GateEval.opReg gateStartReg, + .add gateStartReg gateStartReg wireCountMetaReg, + .load GateEval.negated0Reg gateStartReg, + .add gateStartReg gateStartReg wireCountMetaReg, + .load GateEval.negated1Reg gateStartReg] + +/-- Recover the next code cursor and rebuild persistent memo metadata after the +gate kernel has appended its result. -/ +def restoreOps : List Basic := + [.imm UnaryDecode.activeReg 0, + .add memoBaseReg GateEval.baseReg UnaryDecode.activeReg, + .imm wireCountMetaReg 1, + .imm UnaryDecode.activeReg spillPointerReg, + .load UnaryDecode.pointerReg UnaryDecode.activeReg, + .imm UnaryDecode.activeReg spillRemainingReg, + .load UnaryDecode.remainingReg UnaryDecode.activeReg, + .add wireCountMetaReg GateEval.wireCountReg wireCountMetaReg] + +/-- Parse and evaluate one gate while retaining an independent code cursor and +memo base for the next call. -/ +def routine : Cmd := Cmd.seqList + [.basics setupOps, + .basics headerOps, + UnaryDecode.mainLoop, + .basics saveRestartOps, + UnaryDecode.mainLoop, + .basics marshalOps, + GateEval.program, + .basics restoreOps] + +/-- Concrete compiled iterable gate routine. -/ +def compiled : Program := routine.compile + +/-- Exact transition count on one canonical gate. -/ +def stepCount (gate : CircuitCode.RawGate) : ℕ := + 10 * (gate.input₀ + gate.input₁) + 80 + +/-- Serialized bits beginning at the current gate and continuing with unread +code. -/ +def codeBits (gate : CircuitCode.RawGate) (tail : List Bool) : List Bool := + gate.encode ++ tail + +/-- Absolute address immediately after all code visible to this invocation. -/ +def codeEnd (gateStart : ℕ) (gate : CircuitCode.RawGate) + (tail : List Bool) : ℕ := + gateStart + (codeBits gate tail).length + +/-- Unary-decoder input length corresponding to the absolute code region. -/ +def cursorLength (gateStart : ℕ) (gate : CircuitCode.RawGate) + (tail : List Bool) : ℕ := + gateStart - UnaryDecode.inputBase + (codeBits gate tail).length + +/-- Calling convention at the beginning of an iterable gate invocation. -/ +structure Ready (gateStart base : ℕ) (gate : CircuitCode.RawGate) + (tail : List Bool) (wires : List Bool) (store : Store) : Prop where + /-- The memo lies strictly above the fixed continuation cells. -/ + base_ge : spillRemainingReg < base + /-- The append cell lies strictly before the current gate. -/ + memo_before_code : base + wires.length < gateStart + /-- The parser cursor points at the current gate header. -/ + pointer_eq : store UnaryDecode.pointerReg = gateStart + /-- The parser sees the complete current gate followed by unread code. -/ + remaining_eq : store UnaryDecode.remainingReg = (codeBits gate tail).length + /-- Persistent physical memo base. -/ + memoBase_eq : store memoBaseReg = base + /-- Persistent semantic memo length. -/ + wireCount_eq : store wireCountMetaReg = wires.length + /-- Current gate and unread tail are encoded at the cursor. -/ + code_eq : ∀ delta, + store (gateStart + delta) = + match (codeBits gate tail)[delta]? with + | some bit => Input.bitValue bit + | none => 0 + /-- Existing memo contents. -/ + wire_eq : ∀ index, + store (base + index) = + match wires[index]? with + | some bit => Input.bitValue bit + | none => 0 + +/-- Calling convention immediately before `marshalOps`, after both references +have been decoded successfully. -/ +structure Parsed (gateStart nextPointer remaining base : ℕ) + (gate : CircuitCode.RawGate) (wires : List Bool) (store : Store) : Prop where + /-- The memo lies strictly above the fixed continuation cells. -/ + base_ge : spillRemainingReg < base + /-- The append cell lies strictly before unread gate code. -/ + memo_before_code : base + wires.length < gateStart + /-- The second unary decoder recorded success. -/ + verdict_eq : store UnaryDecode.verdictReg = 1 + /-- The second decoded reference remains in the accumulator. -/ + value_eq : store UnaryDecode.valueReg = gate.input₁ + /-- The next unread code address. -/ + pointer_eq : store UnaryDecode.pointerReg = nextPointer + /-- Number of unread code bits. -/ + remaining_eq : store UnaryDecode.remainingReg = remaining + /-- The second unary loop is inactive. -/ + active_eq : store UnaryDecode.activeReg = 0 + /-- Persistent physical memo base. -/ + memoBase_eq : store memoBaseReg = base + /-- Persistent semantic memo length. -/ + wireCount_eq : store wireCountMetaReg = wires.length + /-- Saved address of the current gate header. -/ + gateStart_eq : store gateStartReg = gateStart + /-- Retained first decoded reference. -/ + input0_eq : store savedInput0Reg = gate.input₀ + /-- Operation header bit at the saved gate address. -/ + op_eq : store gateStart = Input.bitValue gate.opBit + /-- First-negation header bit. -/ + negated0_eq : store (gateStart + 1) = Input.bitValue gate.negated₀ + /-- Second-negation header bit. -/ + negated1_eq : store (gateStart + 2) = Input.bitValue gate.negated₁ + /-- Existing memo contents. -/ + wire_eq : ∀ index, + store (base + index) = + match wires[index]? with + | some bit => Input.bitValue bit + | none => 0 + +end GateStreamStep + +end Structured + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/GateStreamStep/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/GateStreamStep/Internal.lean new file mode 100644 index 0000000000..c3dc99d09f --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/GateStreamStep/Internal.lean @@ -0,0 +1,1068 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Circuits.Encoding.Internal.Codec +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.GateEval.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.GateStreamStep.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.UnaryDecode.Internal +public import Mathlib.Tactic.IntervalCases + +/-! +# Structured RAM iterable serialized-gate step — proof internals +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace Structured + +namespace GateStreamStep + +open Internal + +private def marshalStore (store : Store) : Store := + Basic.execList marshalOps store + +private def marshalPrefix (store : Store) : Store := + Basic.execList + [.add GateEval.wireCountReg wireCountMetaReg UnaryDecode.activeReg, + .imm wireCountMetaReg spillPointerReg, + .store wireCountMetaReg UnaryDecode.pointerReg, + .imm wireCountMetaReg spillRemainingReg, + .store wireCountMetaReg UnaryDecode.remainingReg, + .add GateEval.address1Reg UnaryDecode.valueReg UnaryDecode.activeReg, + .add GateEval.address0Reg savedInput0Reg UnaryDecode.activeReg, + .add GateEval.baseReg memoBaseReg UnaryDecode.activeReg, + .imm wireCountMetaReg 1] + store + +private def loadedOp (store : Store) : Store := + (Basic.load GateEval.opReg gateStartReg).exec (marshalPrefix store) + +private def advanced0 (store : Store) : Store := + (Basic.add gateStartReg gateStartReg wireCountMetaReg).exec (loadedOp store) + +private def loadedNegated0 (store : Store) : Store := + (Basic.load GateEval.negated0Reg gateStartReg).exec (advanced0 store) + +private def advanced1 (store : Store) : Store := + (Basic.add gateStartReg gateStartReg wireCountMetaReg).exec + (loadedNegated0 store) + +private def loadedNegated1 (store : Store) : Store := + (Basic.load GateEval.negated1Reg gateStartReg).exec (advanced1 store) + +private theorem marshalStore_eq (store : Store) : + marshalStore store = loadedNegated1 store := by rfl + +private theorem marshalPrefix_high (store : Store) (index : ℕ) + (hindex : spillRemainingReg < index) : + marshalPrefix store index = store index := by + simp only [spillRemainingReg] at hindex + simp (disch := omega) [marshalPrefix, Basic.execList, Basic.exec, + Function.update_of_ne, GateEval.address0Reg, GateEval.address1Reg, + GateEval.wireCountReg, GateEval.baseReg, memoBaseReg, wireCountMetaReg, + savedInput0Reg, spillPointerReg, spillRemainingReg] + +private theorem marshal_high (store : Store) (index : ℕ) + (hindex : spillRemainingReg < index) : + marshalStore store index = store index := by + simp only [spillRemainingReg] at hindex + have h0 : index ≠ GateEval.opReg := by + simp only [GateEval.opReg] + omega + have h1 : index ≠ GateEval.negated0Reg := by + simp only [GateEval.negated0Reg] + omega + have h2 : index ≠ GateEval.negated1Reg := by + simp only [GateEval.negated1Reg] + omega + have h3 : index ≠ GateEval.address0Reg := by + simp only [GateEval.address0Reg] + omega + have h4 : index ≠ GateEval.address1Reg := by + simp only [GateEval.address1Reg] + omega + have h5 : index ≠ GateEval.wireCountReg := by + simp only [GateEval.wireCountReg] + omega + have h8 : index ≠ wireCountMetaReg := by + simp only [wireCountMetaReg] + omega + have h9 : index ≠ gateStartReg := by + simp only [gateStartReg] + omega + have h10 : index ≠ GateEval.baseReg := by + simp only [GateEval.baseReg] + omega + have h11 : index ≠ spillPointerReg := by + simp only [spillPointerReg] + omega + have h12 : index ≠ spillRemainingReg := by + simp only [spillRemainingReg] + omega + simp [marshalStore, marshalOps, Basic.execList, Basic.exec, + Function.update_of_ne, h0, h1, h2, h3, h4, h5, h8, h9, h10, h11, + h12] + +private theorem marshal_wireCount {gateStart nextPointer remaining base : ℕ} + {gate : CircuitCode.RawGate} {wires : List Bool} {store : Store} + (h : Parsed gateStart nextPointer remaining base gate wires store) : + marshalStore store GateEval.wireCountReg = wires.length := by + have hcount : store 8 = wires.length := by + simpa [wireCountMetaReg] using h.wireCount_eq + have hactive : store 6 = 0 := by + simpa [UnaryDecode.activeReg] using h.active_eq + simp [marshalStore, marshalOps, Basic.execList, Basic.exec, + GateEval.opReg, GateEval.negated0Reg, GateEval.negated1Reg, + GateEval.address0Reg, GateEval.address1Reg, GateEval.wireCountReg, + GateEval.baseReg, memoBaseReg, wireCountMetaReg, gateStartReg, + savedInput0Reg, spillPointerReg, spillRemainingReg, + UnaryDecode.activeReg, hcount, hactive] + +private theorem marshal_address1 {gateStart nextPointer remaining base : ℕ} + {gate : CircuitCode.RawGate} {wires : List Bool} {store : Store} + (h : Parsed gateStart nextPointer remaining base gate wires store) : + marshalStore store GateEval.address1Reg = gate.input₁ := by + have hvalue : store 1 = gate.input₁ := by + simpa [UnaryDecode.valueReg] using h.value_eq + have hactive : store 6 = 0 := by + simpa [UnaryDecode.activeReg] using h.active_eq + simp [marshalStore, marshalOps, Basic.execList, Basic.exec, + GateEval.opReg, GateEval.negated0Reg, GateEval.negated1Reg, + GateEval.address0Reg, GateEval.address1Reg, GateEval.wireCountReg, + GateEval.baseReg, memoBaseReg, wireCountMetaReg, gateStartReg, + savedInput0Reg, spillPointerReg, spillRemainingReg, + UnaryDecode.valueReg, UnaryDecode.activeReg, hvalue, hactive] + +private theorem marshal_address0 {gateStart nextPointer remaining base : ℕ} + {gate : CircuitCode.RawGate} {wires : List Bool} {store : Store} + (h : Parsed gateStart nextPointer remaining base gate wires store) : + marshalStore store GateEval.address0Reg = gate.input₀ := by + have hinput0 : store 10 = gate.input₀ := by + simpa [savedInput0Reg] using h.input0_eq + have hactive : store 6 = 0 := by + simpa [UnaryDecode.activeReg] using h.active_eq + simp [marshalStore, marshalOps, Basic.execList, Basic.exec, + GateEval.opReg, GateEval.negated0Reg, GateEval.negated1Reg, + GateEval.address0Reg, GateEval.address1Reg, GateEval.wireCountReg, + GateEval.baseReg, memoBaseReg, wireCountMetaReg, gateStartReg, + savedInput0Reg, spillPointerReg, spillRemainingReg, + UnaryDecode.activeReg, hinput0, hactive] + +private theorem marshal_base {gateStart nextPointer remaining base : ℕ} + {gate : CircuitCode.RawGate} {wires : List Bool} {store : Store} + (h : Parsed gateStart nextPointer remaining base gate wires store) : + marshalStore store GateEval.baseReg = base := by + have hbase : store 7 = base := by + simpa [memoBaseReg] using h.memoBase_eq + have hactive : store 6 = 0 := by + simpa [UnaryDecode.activeReg] using h.active_eq + simp [marshalStore, marshalOps, Basic.execList, Basic.exec, + GateEval.opReg, GateEval.negated0Reg, GateEval.negated1Reg, + GateEval.address0Reg, GateEval.address1Reg, GateEval.wireCountReg, + GateEval.baseReg, memoBaseReg, wireCountMetaReg, gateStartReg, + savedInput0Reg, spillPointerReg, spillRemainingReg, + UnaryDecode.activeReg, hbase, hactive] + +private theorem marshal_spillPointer + {gateStart nextPointer remaining base : ℕ} {gate : CircuitCode.RawGate} + {wires : List Bool} {store : Store} + (h : Parsed gateStart nextPointer remaining base gate wires store) : + marshalStore store spillPointerReg = nextPointer := by + have hpointer : store 2 = nextPointer := by + simpa [UnaryDecode.pointerReg] using h.pointer_eq + simp [marshalStore, marshalOps, Basic.execList, Basic.exec, + GateEval.opReg, GateEval.negated0Reg, GateEval.negated1Reg, + GateEval.address0Reg, GateEval.address1Reg, GateEval.wireCountReg, + GateEval.baseReg, memoBaseReg, wireCountMetaReg, gateStartReg, + savedInput0Reg, spillPointerReg, spillRemainingReg, + UnaryDecode.pointerReg, hpointer] + +private theorem marshal_spillRemaining + {gateStart nextPointer remaining base : ℕ} {gate : CircuitCode.RawGate} + {wires : List Bool} {store : Store} + (h : Parsed gateStart nextPointer remaining base gate wires store) : + marshalStore store spillRemainingReg = remaining := by + have hremaining : store 3 = remaining := by + simpa [UnaryDecode.remainingReg] using h.remaining_eq + simp [marshalStore, marshalOps, Basic.execList, Basic.exec, + GateEval.opReg, GateEval.negated0Reg, GateEval.negated1Reg, + GateEval.address0Reg, GateEval.address1Reg, GateEval.wireCountReg, + GateEval.baseReg, memoBaseReg, wireCountMetaReg, gateStartReg, + savedInput0Reg, spillPointerReg, spillRemainingReg, + UnaryDecode.remainingReg, hremaining] + +private theorem marshal_op {gateStart nextPointer remaining base : ℕ} + {gate : CircuitCode.RawGate} {wires : List Bool} {store : Store} + (h : Parsed gateStart nextPointer remaining base gate wires store) : + marshalStore store GateEval.opReg = Input.bitValue gate.opBit := by + have hlarge : spillRemainingReg < gateStart := by + have hbase := h.base_ge + have hcode := h.memo_before_code + omega + have hprefixStart : marshalPrefix store gateStartReg = gateStart := by + simpa [marshalPrefix, Basic.execList, Basic.exec, Function.update_of_ne, + GateEval.address0Reg, GateEval.address1Reg, GateEval.wireCountReg, + GateEval.baseReg, gateStartReg, wireCountMetaReg, spillPointerReg, + spillRemainingReg] using h.gateStart_eq + have hprefixHeader : marshalPrefix store gateStart = + Input.bitValue gate.opBit := by + rw [marshalPrefix_high store gateStart hlarge, h.op_eq] + have hloaded : loadedOp store GateEval.opReg = + Input.bitValue gate.opBit := by + simp [loadedOp, Basic.exec, hprefixStart, hprefixHeader] + rw [marshalStore_eq] + simpa [loadedNegated1, advanced1, loadedNegated0, advanced0, Basic.exec, + Function.update_of_ne, GateEval.opReg, GateEval.negated0Reg, + GateEval.negated1Reg, gateStartReg] using hloaded + +private theorem marshal_negated0 {gateStart nextPointer remaining base : ℕ} + {gate : CircuitCode.RawGate} {wires : List Bool} {store : Store} + (h : Parsed gateStart nextPointer remaining base gate wires store) : + marshalStore store GateEval.negated0Reg = + Input.bitValue gate.negated₀ := by + have hlarge : spillRemainingReg < gateStart + 1 := by + have hbase := h.base_ge + have hcode := h.memo_before_code + omega + have hprefixStart : marshalPrefix store gateStartReg = gateStart := by + simpa [marshalPrefix, Basic.execList, Basic.exec, Function.update_of_ne, + GateEval.address0Reg, GateEval.address1Reg, GateEval.wireCountReg, + GateEval.baseReg, gateStartReg, wireCountMetaReg, spillPointerReg, + spillRemainingReg] using h.gateStart_eq + have hprefixOne : marshalPrefix store wireCountMetaReg = 1 := by + simp [marshalPrefix, Basic.execList, Basic.exec, wireCountMetaReg] + have hprefixStart' : marshalPrefix store 9 = gateStart := by + simpa [gateStartReg] using hprefixStart + have hprefixOne' : marshalPrefix store 8 = 1 := by + simpa [wireCountMetaReg] using hprefixOne + have hloadedStart : loadedOp store gateStartReg = gateStart := by + simpa [loadedOp, Basic.exec, Function.update_of_ne, GateEval.opReg, + gateStartReg] using hprefixStart' + have hloadedOne : loadedOp store wireCountMetaReg = 1 := by + simpa [loadedOp, Basic.exec, Function.update_of_ne, GateEval.opReg, + wireCountMetaReg] using hprefixOne' + have hadvancedStart : advanced0 store gateStartReg = gateStart + 1 := by + change loadedOp store gateStartReg + loadedOp store wireCountMetaReg = _ + rw [hloadedStart, hloadedOne] + have hprefixHeader : marshalPrefix store (gateStart + 1) = + Input.bitValue gate.negated₀ := by + rw [marshalPrefix_high store (gateStart + 1) hlarge, h.negated0_eq] + have hloadedHeader : loadedOp store (gateStart + 1) = + Input.bitValue gate.negated₀ := by + rw [show loadedOp store (gateStart + 1) = + marshalPrefix store (gateStart + 1) by + simp [loadedOp, Basic.exec, Function.update_of_ne, GateEval.opReg]] + exact hprefixHeader + have hadvancedHeader : advanced0 store (gateStart + 1) = + Input.bitValue gate.negated₀ := by + rw [advanced0, Basic.exec, Function.update_of_ne] + · exact hloadedHeader + · simp only [gateStartReg, spillRemainingReg] at hlarge ⊢ + omega + have hloaded : loadedNegated0 store GateEval.negated0Reg = + Input.bitValue gate.negated₀ := by + simp [loadedNegated0, Basic.exec, hadvancedStart, hadvancedHeader] + rw [marshalStore_eq] + simpa [loadedNegated1, advanced1, Basic.exec, Function.update_of_ne, + GateEval.negated0Reg, GateEval.negated1Reg, gateStartReg] using hloaded + +private theorem marshal_negated1 {gateStart nextPointer remaining base : ℕ} + {gate : CircuitCode.RawGate} {wires : List Bool} {store : Store} + (h : Parsed gateStart nextPointer remaining base gate wires store) : + marshalStore store GateEval.negated1Reg = + Input.bitValue gate.negated₁ := by + have hlarge : spillRemainingReg < gateStart + 2 := by + have hbase := h.base_ge + have hcode := h.memo_before_code + omega + have hprefixStart : marshalPrefix store gateStartReg = gateStart := by + simpa [marshalPrefix, Basic.execList, Basic.exec, Function.update_of_ne, + GateEval.address0Reg, GateEval.address1Reg, GateEval.wireCountReg, + GateEval.baseReg, gateStartReg, wireCountMetaReg, spillPointerReg, + spillRemainingReg] using h.gateStart_eq + have hprefixOne : marshalPrefix store wireCountMetaReg = 1 := by + simp [marshalPrefix, Basic.execList, Basic.exec, wireCountMetaReg] + have hprefixStart' : marshalPrefix store 9 = gateStart := by + simpa [gateStartReg] using hprefixStart + have hprefixOne' : marshalPrefix store 8 = 1 := by + simpa [wireCountMetaReg] using hprefixOne + have hloadedStart : loadedOp store gateStartReg = gateStart := by + simpa [loadedOp, Basic.exec, Function.update_of_ne, GateEval.opReg, + gateStartReg] using hprefixStart' + have hloadedOne : loadedOp store wireCountMetaReg = 1 := by + simpa [loadedOp, Basic.exec, Function.update_of_ne, GateEval.opReg, + wireCountMetaReg] using hprefixOne' + have hadvanced0Start : advanced0 store gateStartReg = gateStart + 1 := by + change loadedOp store gateStartReg + loadedOp store wireCountMetaReg = _ + rw [hloadedStart, hloadedOne] + have hloaded0Start : loadedNegated0 store gateStartReg = gateStart + 1 := by + simpa [loadedNegated0, Basic.exec, Function.update_of_ne, + GateEval.negated0Reg, gateStartReg] using hadvanced0Start + have hloaded0One : loadedNegated0 store wireCountMetaReg = 1 := by + have hadvancedOne : advanced0 store wireCountMetaReg = 1 := by + simpa [advanced0, Basic.exec, Function.update_of_ne, gateStartReg, + wireCountMetaReg] using hloadedOne + simpa [loadedNegated0, Basic.exec, Function.update_of_ne, + GateEval.negated0Reg, wireCountMetaReg] using hadvancedOne + have hadvanced1Start : advanced1 store gateStartReg = gateStart + 2 := by + change loadedNegated0 store gateStartReg + + loadedNegated0 store wireCountMetaReg = _ + rw [hloaded0Start, hloaded0One] + have hprefixHeader : marshalPrefix store (gateStart + 2) = + Input.bitValue gate.negated₁ := by + rw [marshalPrefix_high store (gateStart + 2) hlarge, h.negated1_eq] + have hadvancedHeader : advanced1 store (gateStart + 2) = + Input.bitValue gate.negated₁ := by + rw [advanced1, Basic.exec, Function.update_of_ne] + · rw [loadedNegated0, Basic.exec, Function.update_of_ne] + · rw [advanced0, Basic.exec, Function.update_of_ne] + · rw [loadedOp, Basic.exec, Function.update_of_ne] + · exact hprefixHeader + · simp only [GateEval.opReg, spillRemainingReg] at hlarge ⊢ + omega + · simp only [gateStartReg, spillRemainingReg] at hlarge ⊢ + omega + · simp only [GateEval.negated0Reg, spillRemainingReg] at hlarge ⊢ + omega + · simp only [gateStartReg, spillRemainingReg] at hlarge ⊢ + omega + rw [marshalStore_eq] + simp [loadedNegated1, Basic.exec, hadvanced1Start, hadvancedHeader] + +theorem marshal_ready_internal {gateStart nextPointer remaining base : ℕ} + {gate : CircuitCode.RawGate} {wires : List Bool} {store : Store} + (hparsed : Parsed gateStart nextPointer remaining base gate wires store) : + GateEval.ReadyAt base gate wires (Basic.execList marshalOps store) ∧ + Basic.execList marshalOps store spillPointerReg = nextPointer ∧ + Basic.execList marshalOps store spillRemainingReg = remaining := by + change GateEval.ReadyAt base gate wires (marshalStore store) ∧ + marshalStore store spillPointerReg = nextPointer ∧ + marshalStore store spillRemainingReg = remaining + refine ⟨?_, marshal_spillPointer hparsed, marshal_spillRemaining hparsed⟩ + constructor + · have hbase := hparsed.base_ge + simp only [GateEval.wireBase, spillRemainingReg] at hbase ⊢ + omega + · exact marshal_op hparsed + · exact marshal_negated0 hparsed + · exact marshal_negated1 hparsed + · exact marshal_address0 hparsed + · exact marshal_address1 hparsed + · exact marshal_wireCount hparsed + · exact marshal_base hparsed + · intro index hindex + rw [marshal_high store (base + index)] + · exact hparsed.wire_eq index + · have hbase := hparsed.base_ge + omega + +private def setupStore (store : Store) : Store := + Basic.execList setupOps store + +private def headerStore (store : Store) : Store := + Basic.execList headerOps (setupStore store) + +private def saveRestartStore (store : Store) : Store := + Basic.execList saveRestartOps store + +private def restoreStore (store : Store) : Store := + Basic.execList restoreOps store + +private def firstRemaining (gate : CircuitCode.RawGate) + (tail : List Bool) : List Bool := + CircuitCode.NatCode.encode gate.input₀ ++ + CircuitCode.NatCode.encode gate.input₁ ++ tail + +private def secondRemaining (gate : CircuitCode.RawGate) + (tail : List Bool) : List Bool := + CircuitCode.NatCode.encode gate.input₁ ++ tail + +private def firstOffset (gateStart : ℕ) : ℕ := + gateStart - UnaryDecode.inputBase + 3 + +private def secondOffset (gateStart : ℕ) + (gate : CircuitCode.RawGate) : ℕ := + gateStart - UnaryDecode.inputBase + 4 + gate.input₀ + +private theorem setup_high (store : Store) (index : ℕ) (hindex : 10 < index) : + setupStore store index = store index := by + simp (disch := omega) [setupStore, setupOps, Basic.execList, Basic.exec, + Function.update_of_ne, gateStartReg, UnaryDecode.verdictReg, + UnaryDecode.valueReg, UnaryDecode.pointerReg, UnaryDecode.oneReg, + UnaryDecode.activeReg] + +private theorem header_high (store : Store) (index : ℕ) (hindex : 10 < index) : + headerStore store index = store index := by + rw [headerStore] + have hsetup := setup_high store index hindex + simpa (disch := omega) [headerOps, Basic.execList, Basic.exec, + Function.update_of_ne, UnaryDecode.pointerReg, + UnaryDecode.remainingReg] using hsetup + +private theorem first_ready {gateStart base : ℕ} {gate : CircuitCode.RawGate} + {tail : List Bool} {wires : List Bool} {store : Store} + (hready : Ready gateStart base gate tail wires store) : + UnaryDecode.CursorReady (cursorLength gateStart gate tail) + (firstRemaining gate tail) (firstOffset gateStart) 0 + (headerStore store) := by + have hstart : UnaryDecode.inputBase ≤ gateStart := by + have hbase := hready.base_ge + have hcode := hready.memo_before_code + simp only [UnaryDecode.inputBase, spillRemainingReg] at hbase ⊢ + omega + constructor + · simp [cursorLength, firstOffset, firstRemaining, codeBits, + CircuitCode.RawGate.encode] + omega + · omega + · simp [headerStore, headerOps, setupStore, setupOps, Basic.execList, + Basic.exec, UnaryDecode.verdictReg, UnaryDecode.pointerReg, + UnaryDecode.remainingReg, UnaryDecode.valueReg, UnaryDecode.oneReg, + UnaryDecode.activeReg, gateStartReg] + · simp [headerStore, headerOps, setupStore, setupOps, Basic.execList, + Basic.exec, UnaryDecode.valueReg, UnaryDecode.pointerReg, + UnaryDecode.remainingReg, UnaryDecode.verdictReg, UnaryDecode.oneReg, + UnaryDecode.activeReg, gateStartReg] + · have hp : store 2 = gateStart := by + simpa [UnaryDecode.pointerReg] using hready.pointer_eq + simp [headerStore, headerOps, setupStore, setupOps, Basic.execList, + Basic.exec, UnaryDecode.pointerReg, UnaryDecode.remainingReg, + UnaryDecode.verdictReg, UnaryDecode.valueReg, UnaryDecode.oneReg, + UnaryDecode.activeReg, gateStartReg, hp, firstOffset] + omega + · have hr : store 3 = + (codeBits gate tail).length := hready.remaining_eq + simp [headerStore, headerOps, setupStore, setupOps, Basic.execList, + Basic.exec, UnaryDecode.pointerReg, UnaryDecode.remainingReg, + UnaryDecode.verdictReg, UnaryDecode.valueReg, UnaryDecode.oneReg, + UnaryDecode.activeReg, gateStartReg, hr, firstRemaining, codeBits, + CircuitCode.RawGate.encode] + · simp [headerStore, headerOps, setupStore, setupOps, Basic.execList, + Basic.exec, UnaryDecode.oneReg, UnaryDecode.pointerReg, + UnaryDecode.remainingReg, UnaryDecode.verdictReg, UnaryDecode.valueReg, + UnaryDecode.activeReg, gateStartReg] + · simp [headerStore, headerOps, setupStore, setupOps, Basic.execList, + Basic.exec, UnaryDecode.activeReg, UnaryDecode.pointerReg, + UnaryDecode.remainingReg, UnaryDecode.verdictReg, UnaryDecode.valueReg, + UnaryDecode.oneReg, gateStartReg] + · intro delta + have haddress : UnaryDecode.inputBase + firstOffset gateStart + delta = + gateStart + (3 + delta) := by + simp [firstOffset] + omega + rw [haddress, header_high store] + · rw [hready.code_eq (3 + delta)] + rw [show 3 + delta = Nat.succ (Nat.succ (Nat.succ delta)) by omega] + simp [codeBits, firstRemaining, CircuitCode.RawGate.encode] + rfl + · have hbase := hready.base_ge + have hcode := hready.memo_before_code + simp only [spillRemainingReg] at hbase + omega + +private theorem header_bound {gateStart base : ℕ} + {gate : CircuitCode.RawGate} {tail wires : List Bool} {store : Store} + (hready : Ready gateStart base gate tail wires store) + (hbound : Internal.StoreEnvelope (codeEnd gateStart gate tail) + (codeEnd gateStart gate tail) store) : + Internal.StoreEnvelope (codeEnd gateStart gate tail) + (codeEnd gateStart gate tail) (headerStore store) := by + have hlarge : 10 < codeEnd gateStart gate tail := by + have hbase := hready.base_ge + have hcode := hready.memo_before_code + simp only [spillRemainingReg] at hbase + simp [codeEnd, codeBits, CircuitCode.RawGate.length_encode] + omega + have hheaderEnd : gateStart + 3 ≤ codeEnd gateStart gate tail := by + simp [codeEnd, codeBits, CircuitCode.RawGate.length_encode] + omega + have hcodeLength : (codeBits gate tail).length ≤ + codeEnd gateStart gate tail := by + simp [codeEnd] + have hserialized : 5 + gate.input₀ + gate.input₁ + tail.length ≤ + codeEnd gateStart gate tail := by + simpa [codeBits, CircuitCode.RawGate.length_encode, Nat.add_assoc, + Nat.add_comm, Nat.add_left_comm] using hcodeLength + have hp : store 2 = gateStart := by + simpa [UnaryDecode.pointerReg] using hready.pointer_eq + have hr : store 3 = (codeBits gate tail).length := by + simpa [UnaryDecode.remainingReg] using hready.remaining_eq + constructor + · intro index hnonzero + by_cases hindex : index ≤ 10 + · omega + · rw [header_high store index (by omega)] at hnonzero + exact hbound.index_lt index hnonzero + · intro index + by_cases hindex : index ≤ 10 + · interval_cases index <;> + simp [headerStore, headerOps, setupStore, setupOps, Basic.execList, + Basic.exec, UnaryDecode.verdictReg, UnaryDecode.valueReg, + UnaryDecode.pointerReg, UnaryDecode.remainingReg, + UnaryDecode.oneReg, UnaryDecode.activeReg, gateStartReg, hp, hr, + codeBits] + all_goals try omega + all_goals exact hbound.value_le _ + · rw [header_high store index (by omega)] + exact hbound.value_le index + +private theorem saveRestart_high (store : Store) (index : ℕ) + (hindex : 10 < index) : + saveRestartStore store index = store index := by + simp (disch := omega) [saveRestartStore, saveRestartOps, Basic.execList, + Basic.exec, Function.update_of_ne, savedInput0Reg, + UnaryDecode.verdictReg, UnaryDecode.valueReg, UnaryDecode.activeReg] + +private theorem saveRestart_apply_of_ne (store : Store) (index : ℕ) + (hsaved : index ≠ savedInput0Reg) + (hverdict : index ≠ UnaryDecode.verdictReg) + (hvalue : index ≠ UnaryDecode.valueReg) + (hactive : index ≠ UnaryDecode.activeReg) : + saveRestartStore store index = store index := by + simp [saveRestartStore, saveRestartOps, Basic.execList, Basic.exec, + Function.update_of_ne, hsaved, hverdict, hvalue, hactive] + +private theorem saveRestart_bound {bound : ℕ} {store : Store} + (hbound : Internal.StoreEnvelope bound bound store) + (hlarge : 10 < bound) (hactive : store UnaryDecode.activeReg = 0) : + Internal.StoreEnvelope bound bound (saveRestartStore store) := by + let saved0 := (Basic.add savedInput0Reg UnaryDecode.valueReg + UnaryDecode.activeReg).exec store + have h0 : Internal.StoreEnvelope bound bound saved0 := by + apply hbound.execBasic + · simpa [Basic.writeIndex, savedInput0Reg] using hlarge + · change store UnaryDecode.valueReg + store UnaryDecode.activeReg ≤ bound + rw [hactive, Nat.add_zero] + exact hbound.value_le UnaryDecode.valueReg + have h1 := h0.execBasic (.imm UnaryDecode.verdictReg 0) + (by simp [Basic.writeIndex, UnaryDecode.verdictReg]; omega) + (by simp [Basic.writeValue]) + have h2 := h1.execBasic (.imm UnaryDecode.valueReg 0) + (by simp [Basic.writeIndex, UnaryDecode.valueReg]; omega) + (by simp [Basic.writeValue]) + have h3 := h2.execBasic (.imm UnaryDecode.activeReg 1) + (by simp [Basic.writeIndex, UnaryDecode.activeReg]; omega) + (by simp [Basic.writeValue]; omega) + simpa [saveRestartStore, saveRestartOps, Basic.execList, saved0] using h3 + +private theorem header_op {gateStart base : ℕ} {gate : CircuitCode.RawGate} + {tail wires : List Bool} {store : Store} + (hready : Ready gateStart base gate tail wires store) : + headerStore store gateStart = Input.bitValue gate.opBit := by + have hlarge : 10 < gateStart := by + have hbase := hready.base_ge + have hcode := hready.memo_before_code + simp only [spillRemainingReg] at hbase + omega + rw [header_high store gateStart hlarge] + have hcode := hready.code_eq 0 + simpa [codeBits, CircuitCode.RawGate.encode] using hcode + +private theorem header_negated0 {gateStart base : ℕ} + {gate : CircuitCode.RawGate} {tail wires : List Bool} {store : Store} + (hready : Ready gateStart base gate tail wires store) : + headerStore store (gateStart + 1) = + Input.bitValue gate.negated₀ := by + have hlarge : 10 < gateStart + 1 := by + have hbase := hready.base_ge + have hcode := hready.memo_before_code + simp only [spillRemainingReg] at hbase + omega + rw [header_high store (gateStart + 1) hlarge, hready.code_eq 1] + simp [codeBits, CircuitCode.RawGate.encode] + +private theorem header_negated1 {gateStart base : ℕ} + {gate : CircuitCode.RawGate} {tail wires : List Bool} {store : Store} + (hready : Ready gateStart base gate tail wires store) : + headerStore store (gateStart + 2) = + Input.bitValue gate.negated₁ := by + have hlarge : 10 < gateStart + 2 := by + have hbase := hready.base_ge + have hcode := hready.memo_before_code + simp only [spillRemainingReg] at hbase + omega + rw [header_high store (gateStart + 2) hlarge, hready.code_eq 2] + simp [codeBits, CircuitCode.RawGate.encode] + +private theorem decoders_internal {gateStart base : ℕ} {gate : CircuitCode.RawGate} + {tail wires : List Bool} {store : Store} + (hready : Ready gateStart base gate tail wires store) + (hbound : StoreEnvelope (codeEnd gateStart gate tail) + (codeEnd gateStart gate tail) store) : + ∃ first saved second firstCost firstSpace secondCost secondSpace, + Exec UnaryDecode.mainLoop (headerStore store) first + (UnaryDecode.loopStepCount (firstRemaining gate tail)) + firstCost firstSpace ∧ + saved = saveRestartStore first ∧ + Exec UnaryDecode.mainLoop saved second + (UnaryDecode.loopStepCount (secondRemaining gate tail)) + secondCost secondSpace ∧ + Parsed gateStart (gateStart + gate.encode.length) tail.length base + gate wires second ∧ + (∀ delta, second (gateStart + gate.encode.length + delta) = + match tail[delta]? with + | some bit => Input.bitValue bit + | none => 0) ∧ + StoreEnvelope (codeEnd gateStart gate tail) + (codeEnd gateStart gate tail) second := by + have hstart : UnaryDecode.inputBase ≤ gateStart := by + have hbase := hready.base_ge + have hcode := hready.memo_before_code + simp only [spillRemainingReg, UnaryDecode.inputBase] at hbase ⊢ + omega + have hcursorEnd : cursorLength gateStart gate tail + + UnaryDecode.inputBase = codeEnd gateStart gate tail := by + simp [cursorLength, codeEnd] + omega + have hheaderBound : StoreEnvelope (cursorLength gateStart gate tail + + UnaryDecode.inputBase) (cursorLength gateStart gate tail + + UnaryDecode.inputBase) (headerStore store) := by + rw [hcursorEnd] + exact header_bound hready hbound + have hfirstReady := first_ready hready + obtain ⟨first, firstCost, firstSpace, hfirst, _hfirstCost, _hfirstSpace, + hfirstResult, hfirstActive, hfirstOne, hfirstFrame, hfirstBound⟩ := + UnaryDecode.mainLoop_measured_internal hfirstReady hheaderBound + have hdecode0 : CircuitCode.NatCode.decodePrefix? + (firstRemaining gate tail) = + some (gate.input₀, secondRemaining gate tail) := by + simp [firstRemaining, secondRemaining] + rw [hdecode0] at hfirstResult + simp only at hfirstResult + have hfirstValue : first UnaryDecode.valueReg = gate.input₀ := + by simpa using hfirstResult.2.1 + have hfirstPointer : first UnaryDecode.pointerReg = + gateStart + 4 + gate.input₀ := by + have hp := hfirstResult.2.2.1 + rw [hp] + simp [firstOffset] + omega + have hfirstRemaining : first UnaryDecode.remainingReg = + (secondRemaining gate tail).length := hfirstResult.2.2.2 + let saved := saveRestartStore first + have hlarge : 10 < codeEnd gateStart gate tail := by + have hbase := hready.base_ge + have hcode := hready.memo_before_code + simp only [spillRemainingReg] at hbase + simp [codeEnd] + omega + have hsavedBound : StoreEnvelope (codeEnd gateStart gate tail) + (codeEnd gateStart gate tail) saved := by + apply saveRestart_bound + · simpa [hcursorEnd] using hfirstBound + · exact hlarge + · exact hfirstActive + have hsecondReady : UnaryDecode.CursorReady + (cursorLength gateStart gate tail) (secondRemaining gate tail) + (secondOffset gateStart gate) 0 saved := by + constructor + · simp [cursorLength, secondOffset, secondRemaining, codeBits, + CircuitCode.RawGate.length_encode] + omega + · omega + · simp [saved, saveRestartStore, saveRestartOps, Basic.execList, + Basic.exec, UnaryDecode.verdictReg, UnaryDecode.valueReg, + UnaryDecode.activeReg] + · simp [saved, saveRestartStore, saveRestartOps, Basic.execList, + Basic.exec, UnaryDecode.verdictReg, UnaryDecode.valueReg, + UnaryDecode.activeReg] + · change saved UnaryDecode.pointerReg = _ + rw [show saved UnaryDecode.pointerReg = + first UnaryDecode.pointerReg by + apply saveRestart_apply_of_ne <;> + simp [savedInput0Reg, UnaryDecode.verdictReg, + UnaryDecode.valueReg, UnaryDecode.pointerReg, + UnaryDecode.activeReg]] + rw [hfirstPointer] + simp [secondOffset] + omega + · change saved UnaryDecode.remainingReg = + (secondRemaining gate tail).length + rw [show saved UnaryDecode.remainingReg = + first UnaryDecode.remainingReg by + apply saveRestart_apply_of_ne <;> + simp [savedInput0Reg, UnaryDecode.verdictReg, + UnaryDecode.valueReg, UnaryDecode.remainingReg, + UnaryDecode.activeReg]] + exact hfirstRemaining + · change saved UnaryDecode.oneReg = 1 + rw [show saved UnaryDecode.oneReg = first UnaryDecode.oneReg by + apply saveRestart_apply_of_ne <;> + simp [savedInput0Reg, UnaryDecode.verdictReg, + UnaryDecode.valueReg, UnaryDecode.oneReg, + UnaryDecode.activeReg]] + exact hfirstOne + · simp [saved, saveRestartStore, saveRestartOps, Basic.execList, + Basic.exec, UnaryDecode.verdictReg, UnaryDecode.valueReg, + UnaryDecode.activeReg] + · intro delta + have haddress : UnaryDecode.inputBase + secondOffset gateStart gate + + delta = UnaryDecode.inputBase + firstOffset gateStart + + (gate.input₀ + 1 + delta) := by + simp [secondOffset, firstOffset] + omega + rw [haddress] + rw [show saved (UnaryDecode.inputBase + firstOffset gateStart + + (gate.input₀ + 1 + delta)) = + first (UnaryDecode.inputBase + firstOffset gateStart + + (gate.input₀ + 1 + delta)) by + apply saveRestart_high + simp [firstOffset, UnaryDecode.inputBase] + omega] + rw [hfirstFrame _ (by simp [UnaryDecode.inputBase]; omega)] + have hinput := hfirstReady.input_eq (gate.input₀ + 1 + delta) + have hlookup : (firstRemaining gate tail)[gate.input₀ + 1 + delta]? = + (secondRemaining gate tail)[delta]? := by + rw [show firstRemaining gate tail = + CircuitCode.NatCode.encode gate.input₀ ++ + secondRemaining gate tail by + simp [firstRemaining, secondRemaining, List.append_assoc]] + rw [List.getElem?_append_right (by simp)] + simp + rw [hlookup] at hinput + exact hinput + have hsavedCursorBound : StoreEnvelope + (cursorLength gateStart gate tail + UnaryDecode.inputBase) + (cursorLength gateStart gate tail + UnaryDecode.inputBase) saved := by + rw [hcursorEnd] + exact hsavedBound + obtain ⟨second, secondCost, secondSpace, hsecond, _hsecondCost, + _hsecondSpace, hsecondResult, hsecondActive, _hsecondOne, + hsecondFrame, hsecondBound⟩ := + UnaryDecode.mainLoop_measured_internal hsecondReady hsavedCursorBound + have hdecode1 : CircuitCode.NatCode.decodePrefix? + (secondRemaining gate tail) = some (gate.input₁, tail) := by + simp [secondRemaining] + rw [hdecode1] at hsecondResult + simp only at hsecondResult + have hsecondValue : second UnaryDecode.valueReg = gate.input₁ := + by simpa using hsecondResult.2.1 + have hsecondPointer : second UnaryDecode.pointerReg = + gateStart + gate.encode.length := by + have hp := hsecondResult.2.2.1 + rw [hp] + simp [secondOffset, CircuitCode.RawGate.length_encode] + omega + have hsecondRemaining : second UnaryDecode.remainingReg = tail.length := + hsecondResult.2.2.2 + have hpreserved (index : ℕ) (hindex : 10 < index) : + second index = store index := by + rw [hsecondFrame index (by + simp only [UnaryDecode.inputBase] + omega)] + change saveRestartStore first index = store index + rw [saveRestart_high first index hindex] + rw [hfirstFrame index (by + simp only [UnaryDecode.inputBase] + omega)] + exact header_high store index hindex + have hmeta (index : ℕ) (h7 : UnaryDecode.inputBase ≤ index) + (hsaved : index ≠ savedInput0Reg) : + second index = headerStore store index := by + rw [hsecondFrame index h7] + change saveRestartStore first index = headerStore store index + rw [saveRestart_apply_of_ne] + · exact hfirstFrame index h7 + · exact hsaved + · simp only [UnaryDecode.inputBase] at h7 + simp only [UnaryDecode.verdictReg] + omega + · simp only [UnaryDecode.inputBase] at h7 + simp only [UnaryDecode.valueReg] + omega + · simp only [UnaryDecode.inputBase] at h7 + simp only [UnaryDecode.activeReg] + omega + have hinput0 : second savedInput0Reg = gate.input₀ := by + rw [hsecondFrame _ (by simp [savedInput0Reg, UnaryDecode.inputBase])] + change saveRestartStore first savedInput0Reg = gate.input₀ + have hvalue : first 1 = gate.input₀ := by + simpa [UnaryDecode.valueReg] using hfirstValue + have hactive : first 6 = 0 := by + simpa [UnaryDecode.activeReg] using hfirstActive + simp [saveRestartStore, saveRestartOps, Basic.execList, Basic.exec, + savedInput0Reg, UnaryDecode.verdictReg, UnaryDecode.valueReg, + UnaryDecode.activeReg, hvalue, hactive] + have hparsed : Parsed gateStart (gateStart + gate.encode.length) + tail.length base gate wires second := by + constructor + · exact hready.base_ge + · exact hready.memo_before_code + · exact hsecondResult.1 + · exact hsecondValue + · exact hsecondPointer + · exact hsecondRemaining + · exact hsecondActive + · rw [hmeta memoBaseReg] + · simpa [headerStore, headerOps, setupStore, setupOps, Basic.execList, + Basic.exec, memoBaseReg, UnaryDecode.verdictReg, + UnaryDecode.valueReg, UnaryDecode.pointerReg, + UnaryDecode.remainingReg, UnaryDecode.oneReg, + UnaryDecode.activeReg, gateStartReg] using hready.memoBase_eq + · simp [memoBaseReg, UnaryDecode.inputBase] + · simp [memoBaseReg, savedInput0Reg] + · rw [hmeta wireCountMetaReg] + · simpa [headerStore, headerOps, setupStore, setupOps, Basic.execList, + Basic.exec, wireCountMetaReg, UnaryDecode.verdictReg, + UnaryDecode.valueReg, UnaryDecode.pointerReg, + UnaryDecode.remainingReg, UnaryDecode.oneReg, + UnaryDecode.activeReg, gateStartReg] using hready.wireCount_eq + · simp [wireCountMetaReg, UnaryDecode.inputBase] + · simp [wireCountMetaReg, savedInput0Reg] + · rw [hmeta gateStartReg] + · simp [headerStore, headerOps, setupStore, setupOps, Basic.execList, + Basic.exec, gateStartReg, UnaryDecode.pointerReg, + UnaryDecode.remainingReg] + exact hready.pointer_eq + · simp [gateStartReg, UnaryDecode.inputBase] + · simp [gateStartReg, savedInput0Reg] + · exact hinput0 + · rw [hpreserved gateStart] + · exact hready.code_eq 0 |>.trans (by + simp [codeBits, CircuitCode.RawGate.encode]) + · have hbase := hready.base_ge + have hcode := hready.memo_before_code + simp only [spillRemainingReg] at hbase + omega + · rw [hpreserved (gateStart + 1)] + · simpa [codeBits, CircuitCode.RawGate.encode] using + hready.code_eq 1 + · have hbase := hready.base_ge + have hcode := hready.memo_before_code + simp only [spillRemainingReg] at hbase + omega + · rw [hpreserved (gateStart + 2)] + · simpa [codeBits, CircuitCode.RawGate.encode] using + hready.code_eq 2 + · have hbase := hready.base_ge + have hcode := hready.memo_before_code + simp only [spillRemainingReg] at hbase + omega + · intro index + rw [hpreserved (base + index)] + · exact hready.wire_eq index + · have hbase := hready.base_ge + simp only [spillRemainingReg] at hbase + omega + have hsecondCode : ∀ delta, + second (gateStart + gate.encode.length + delta) = + match tail[delta]? with + | some bit => Input.bitValue bit + | none => 0 := by + intro delta + rw [hpreserved (gateStart + gate.encode.length + delta)] + · have hcode := hready.code_eq (gate.encode.length + delta) + rw [show gateStart + (gate.encode.length + delta) = + gateStart + gate.encode.length + delta by omega] at hcode + rw [show (codeBits gate tail)[gate.encode.length + delta]? = + tail[delta]? by + rw [codeBits, List.getElem?_append_right (by simp)] + simp] at hcode + exact hcode + · have hbase := hready.base_ge + have hcode := hready.memo_before_code + simp only [spillRemainingReg] at hbase + omega + refine ⟨first, saved, second, firstCost, firstSpace, secondCost, + secondSpace, hfirst, rfl, hsecond, hparsed, hsecondCode, ?_⟩ + simpa [hcursorEnd] using hsecondBound + +private theorem restore_high (store : Store) (index : ℕ) + (hindex : spillRemainingReg < index) : + restoreStore store index = store index := by + simp only [spillRemainingReg] at hindex + simp (disch := omega) [restoreStore, restoreOps, Basic.execList, Basic.exec, + Function.update_of_ne, memoBaseReg, wireCountMetaReg, spillPointerReg, + spillRemainingReg, GateEval.wireCountReg, GateEval.baseReg, + UnaryDecode.pointerReg, UnaryDecode.remainingReg, + UnaryDecode.activeReg] + +theorem routine_exec_internal {gateStart base : ℕ} + {gate : CircuitCode.RawGate} {tail wires : List Bool} {store : Store} + (hready : Ready gateStart base gate tail wires store) + (hbound : StoreEnvelope (codeEnd gateStart gate tail) + (codeEnd gateStart gate tail) store) + (value0 value1 : Bool) (hvalue0 : wires[gate.input₀]? = some value0) + (hvalue1 : wires[gate.input₁]? = some value1) : + ∃ final cost space, + Exec routine store final (stepCount gate) cost space ∧ + final UnaryDecode.pointerReg = gateStart + gate.encode.length ∧ + final UnaryDecode.remainingReg = tail.length ∧ + final memoBaseReg = base ∧ + final wireCountMetaReg = wires.length + 1 ∧ + final (base + wires.length) = + Input.bitValue (gate.eval value0 value1) ∧ + (∀ index (hindex : index < wires.length), + final (base + index) = Input.bitValue wires[index]) ∧ + ∀ delta, + final (gateStart + gate.encode.length + delta) = + match tail[delta]? with + | some bit => Input.bitValue bit + | none => 0 := by + obtain ⟨first, saved, second, firstCost, firstSpace, secondCost, + secondSpace, hfirst, rfl, hsecond, hparsed, hsecondCode, + _hsecondBound⟩ := + decoders_internal hready hbound + let marshaled := Basic.execList marshalOps second + obtain ⟨hgateReady, hspillPointer, hspillRemaining⟩ := + marshal_ready_internal hparsed + change GateEval.ReadyAt base gate wires marshaled at hgateReady + change marshaled spillPointerReg = gateStart + gate.encode.length at hspillPointer + change marshaled spillRemainingReg = tail.length at hspillRemaining + obtain ⟨evaluated, gateCost, gateSpace, hgate, houtput, happended, + hbase, hcount, hwires, hgateFrame⟩ := + GateEval.routine_exec_internal hgateReady value0 value1 hvalue0 hvalue1 + have hevalSpillPointer : evaluated spillPointerReg = + gateStart + gate.encode.length := by + rw [hgateFrame spillPointerReg] + · exact hspillPointer + · simp [GateEval.wireBase, spillPointerReg] + · have hbaseGe := hready.base_ge + simp only [spillPointerReg, spillRemainingReg] at hbaseGe ⊢ + omega + have hevalSpillRemaining : evaluated spillRemainingReg = tail.length := by + rw [hgateFrame spillRemainingReg] + · exact hspillRemaining + · simp [GateEval.wireBase, spillRemainingReg] + · have hbaseGe := hready.base_ge + simp only [spillRemainingReg] at hbaseGe ⊢ + omega + let final := restoreStore evaluated + have hfinalPointer : final UnaryDecode.pointerReg = + gateStart + gate.encode.length := by + have hbase' : evaluated 10 = base := by + simpa [GateEval.baseReg] using hbase + have hcount' : evaluated 5 = wires.length := by + simpa [GateEval.wireCountReg] using hcount + have hspillPointer' : evaluated 11 = + gateStart + gate.encode.length := by + simpa [spillPointerReg] using hevalSpillPointer + have hspillRemaining' : evaluated 12 = tail.length := by + simpa [spillRemainingReg] using hevalSpillRemaining + simp [final, restoreStore, restoreOps, Basic.execList, Basic.exec, + memoBaseReg, wireCountMetaReg, spillPointerReg, spillRemainingReg, + GateEval.wireCountReg, GateEval.baseReg, UnaryDecode.pointerReg, + UnaryDecode.remainingReg, UnaryDecode.activeReg, hbase', hcount', + hspillPointer', hspillRemaining'] + have hfinalRemaining : final UnaryDecode.remainingReg = tail.length := by + have hbase' : evaluated 10 = base := by + simpa [GateEval.baseReg] using hbase + have hcount' : evaluated 5 = wires.length := by + simpa [GateEval.wireCountReg] using hcount + have hspillPointer' : evaluated 11 = + gateStart + gate.encode.length := by + simpa [spillPointerReg] using hevalSpillPointer + have hspillRemaining' : evaluated 12 = tail.length := by + simpa [spillRemainingReg] using hevalSpillRemaining + simp [final, restoreStore, restoreOps, Basic.execList, Basic.exec, + memoBaseReg, wireCountMetaReg, spillPointerReg, spillRemainingReg, + GateEval.wireCountReg, GateEval.baseReg, UnaryDecode.pointerReg, + UnaryDecode.remainingReg, UnaryDecode.activeReg, hbase', hcount', + hspillPointer', hspillRemaining'] + have hfinalBase : final memoBaseReg = base := by + have hbase' : evaluated 10 = base := by + simpa [GateEval.baseReg] using hbase + simp [final, restoreStore, restoreOps, Basic.execList, Basic.exec, + memoBaseReg, wireCountMetaReg, spillPointerReg, spillRemainingReg, + GateEval.wireCountReg, GateEval.baseReg, UnaryDecode.pointerReg, + UnaryDecode.remainingReg, UnaryDecode.activeReg, hbase'] + have hfinalCount : final wireCountMetaReg = wires.length + 1 := by + have hcount' : evaluated 5 = wires.length := by + simpa [GateEval.wireCountReg] using hcount + simp [final, restoreStore, restoreOps, Basic.execList, Basic.exec, + memoBaseReg, wireCountMetaReg, spillPointerReg, spillRemainingReg, + GateEval.wireCountReg, GateEval.baseReg, UnaryDecode.pointerReg, + UnaryDecode.remainingReg, UnaryDecode.activeReg, hcount'] + have hfinalAppended : final (base + wires.length) = + Input.bitValue (gate.eval value0 value1) := by + rw [show final (base + wires.length) = + evaluated (base + wires.length) by + apply restore_high + have hbaseGe := hready.base_ge + simp only [spillRemainingReg] at hbaseGe ⊢ + omega] + exact happended + have hfinalWires : ∀ index (hindex : index < wires.length), + final (base + index) = Input.bitValue wires[index] := by + intro index hindex + rw [show final (base + index) = evaluated (base + index) by + apply restore_high + have hbaseGe := hready.base_ge + simp only [spillRemainingReg] at hbaseGe ⊢ + omega] + exact hwires index hindex + have hfinalCode : ∀ delta, + final (gateStart + gate.encode.length + delta) = + match tail[delta]? with + | some bit => Input.bitValue bit + | none => 0 := by + intro delta + have hcodeAddress : spillRemainingReg < + gateStart + gate.encode.length + delta := by + have hbaseGe := hready.base_ge + have hcode := hready.memo_before_code + simp only [spillRemainingReg] at hbaseGe ⊢ + omega + change restoreStore evaluated + (gateStart + gate.encode.length + delta) = _ + rw [restore_high evaluated _ hcodeAddress] + rw [hgateFrame _] + · change marshalStore second + (gateStart + gate.encode.length + delta) = _ + rw [marshal_high second _ hcodeAddress] + exact hsecondCode delta + · simp only [GateEval.wireBase, spillRemainingReg] at hcodeAddress ⊢ + omega + · have hcode := hready.memo_before_code + omega + obtain ⟨setupCost, setupSpace, hsetup⟩ := exec_basics_exists setupOps store + obtain ⟨headerCost, headerSpace, hheader⟩ := + exec_basics_exists headerOps (setupStore store) + obtain ⟨saveCost, saveSpace, hsave⟩ := exec_basics_exists saveRestartOps first + obtain ⟨marshalCost, marshalSpace, hmarshal⟩ := + exec_basics_exists marshalOps second + obtain ⟨restoreCost, restoreSpace, hrestore⟩ := + exec_basics_exists restoreOps evaluated + have hrun := hsetup.seq (hheader.seq (hfirst.seq + (hsave.seq (hsecond.seq (hmarshal.seq (hgate.seq hrestore)))))) + have hsteps : setupOps.length + + (headerOps.length + (UnaryDecode.loopStepCount (firstRemaining gate tail) + + (saveRestartOps.length + + (UnaryDecode.loopStepCount (secondRemaining gate tail) + + (marshalOps.length + (GateEval.stepCount + restoreOps.length)))))) = + stepCount gate := by + simp [setupOps, headerOps, saveRestartOps, marshalOps, restoreOps, + UnaryDecode.loopStepCount, firstRemaining, secondRemaining, + GateEval.stepCount, stepCount] + omega + have hexec : ∃ cost space, + Exec routine store final (stepCount gate) cost space := by + refine ⟨setupCost + (headerCost + (firstCost + + (saveCost + (secondCost + (marshalCost + (gateCost + restoreCost)))))), + max setupSpace (max headerSpace (max firstSpace + (max saveSpace (max secondSpace + (max marshalSpace (max gateSpace restoreSpace)))))), ?_⟩ + rw [← hsteps] + simpa [routine, setupStore, headerStore, saveRestartStore, marshaled, + final, restoreStore] using hrun + obtain ⟨cost, space, hexec⟩ := hexec + exact ⟨final, cost, space, hexec, hfinalPointer, hfinalRemaining, + hfinalBase, hfinalCount, hfinalAppended, hfinalWires, hfinalCode⟩ + +end GateStreamStep + +end Structured + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Hamming.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Hamming.lean new file mode 100644 index 0000000000..8675096739 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Hamming.lean @@ -0,0 +1,113 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.Hamming.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.Hamming.Internal +public import LeanPool.BeyondBethe.Complexitylib.Asymptotics +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured + +/-! +# Verified structured RAM Hamming weight + +`Hamming.program` is a structured imperative program over the reserved-register +layout `Hamming.inputStore`. Its correctness and resource bounds are proved in +the independent source semantics. `Hamming.compiled_performance` then applies +the generic compiler theorem, carrying the result to the concrete logarithmic-cost +RAM with an exact transition count, explicit length-indexed budgets, and +quasilinear asymptotic corollaries. +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace Structured + +namespace Hamming + +/-- Source-level correctness with an exact transition count and explicit +logarithmic-cost time and peak-space bounds. -/ +theorem program_performance (bits : List Bool) : + ∃ final cost space, + Exec program (inputStore bits) final (stepCount bits) cost space ∧ + cost ≤ timeBound bits.length ∧ space ≤ spaceBound bits.length ∧ + final lengthReg = weight bits := + program_measured_internal bits + +/-- End-to-end compiled performance theorem. The concrete RAM reaches its halt +instruction after exactly `stepCount bits` transitions, within the explicit +logarithmic-cost time and peak-space budgets, and returns the Hamming weight. -/ +theorem compiled_performance (bits : List Bool) : + ∃ final cost space, + Exec program (inputStore bits) final (stepCount bits) cost space ∧ + run compiled (stepCount bits) { pc := 0, regs := inputStore bits } = + { pc := program.codeSize, regs := final } ∧ + Halted compiled + (run compiled (stepCount bits) { pc := 0, regs := inputStore bits }) ∧ + logTimeUpto compiled (stepCount bits) + { pc := 0, regs := inputStore bits } ≤ timeBound bits.length ∧ + spaceUpto compiled (stepCount bits) + { pc := 0, regs := inputStore bits } ≤ spaceBound bits.length ∧ + (run compiled (stepCount bits) { pc := 0, regs := inputStore bits }).regs + lengthReg = weight bits := by + obtain ⟨final, cost, space, hexec, hcost, hspace, hresult⟩ := + program_performance bits + have hcompiled := Exec.compile_correct hexec + refine ⟨final, cost, space, hexec, hcompiled.1, Exec.compile_halted hexec, + ?_, ?_, ?_⟩ + · change logTimeUpto program.compile (stepCount bits) + { pc := 0, regs := inputStore bits } ≤ timeBound bits.length + rw [hcompiled.2.1] + exact hcost + · change spaceUpto program.compile (stepCount bits) + { pc := 0, regs := inputStore bits } ≤ spaceBound bits.length + rw [hcompiled.2.2] + exact hspace + · change (run program.compile (stepCount bits) + { pc := 0, regs := inputStore bits }).regs lengthReg = weight bits + rw [hcompiled.1] + exact hresult + +/-- The explicit logarithmic-cost time budget is quasilinear. -/ +theorem timeBound_bigO_quasilinear : timeBound =O quasilinearBound := by + have hpoint : ∀ n, timeBound n ≤ 64 * quasilinearBound n := by + intro n + simp only [timeBound, quasilinearBound] + have hshift : n + 1 ≤ n + 5 := by omega + calc + 64 * (n + 1) * (bitlen (n + 5) + 1) + = 64 * ((n + 1) * (bitlen (n + 5) + 1)) := by ring + _ ≤ 64 * ((n + 5) * (bitlen (n + 5) + 1)) := + Nat.mul_le_mul_left 64 + (Nat.mul_le_mul_right (bitlen (n + 5) + 1) hshift) + exact (BigO.of_le hpoint).trans + (BigO.const_mul_left 64 (BigO.refl quasilinearBound)) + +/-- The explicit peak-space budget is quasilinear under the reserved-register +input representation. -/ +theorem spaceBound_bigO_quasilinear : spaceBound =O quasilinearBound := by + have hpoint : ∀ n, spaceBound n ≤ 2 * quasilinearBound n := by + intro n + simp only [spaceBound, quasilinearBound] + calc + (n + 5) * (2 * bitlen (n + 5)) + = 2 * ((n + 5) * bitlen (n + 5)) := by ring + _ ≤ 2 * ((n + 5) * (bitlen (n + 5) + 1)) := + Nat.mul_le_mul_left 2 (Nat.mul_le_mul_left (n + 5) (by omega)) + exact (BigO.of_le hpoint).trans + (BigO.const_mul_left 2 (BigO.refl quasilinearBound)) + +end Hamming + +end Structured + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Hamming/Defs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Hamming/Defs.lean new file mode 100644 index 0000000000..f609d31699 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Hamming/Defs.lean @@ -0,0 +1,111 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.Defs + +/-! +# Structured RAM Hamming-weight program — definitions + +The benchmark uses a small reserved-register ABI: registers `R₀` through `R₄` +hold loop state and input bits start at `R₅`. This avoids the existing raw RAM +input convention's overlap between an unbounded input and fixed scratch registers. +-/ + + +@[expose] public section + +namespace Complexity + +namespace RAM + +namespace Structured + +namespace Hamming + +/-- Remaining input length and final-result register. -/ +def lengthReg : ℕ := 0 +/-- Hamming-weight accumulator register. -/ +def countReg : ℕ := 1 +/-- Address of the next input bit. -/ +def pointerReg : ℕ := 2 +/-- Constant-one register used for increments and decrements. -/ +def oneReg : ℕ := 3 +/-- Temporary register receiving the current input bit. -/ +def scratchReg : ℕ := 4 +/-- First register occupied by input data under the reserved-register ABI. -/ +def inputBase : ℕ := 5 + +/-- Natural-number representation of one input bit. -/ +@[simp] +def bitValue (bit : Bool) : ℕ := Input.bitValue bit + +/-- Mathematical Hamming weight of a Boolean list. -/ +def weight : List Bool → ℕ + | [] => 0 + | bit :: rest => bitValue bit + weight rest + +/-- Reserved-register input layout for the structured benchmark. -/ +def inputStore (bits : List Bool) : Store := + Input.bitStore lengthReg inputBase bits + +/-- Basic instructions that initialize the accumulator, input pointer, and +fixedValue-one register. -/ +def setupOps : List Basic := + [.imm countReg 0, .imm pointerReg inputBase, .imm oneReg 1] + +/-- Initialize the Hamming loop registers. -/ +def setup : Cmd := Cmd.basics setupOps + +/-- One Hamming-weight loop iteration. -/ +def body : Cmd := Cmd.seqList + [Cmd.basic (.load scratchReg pointerReg), + Cmd.ifZero scratchReg Cmd.skip (Cmd.basic (.add countReg countReg oneReg)), + Cmd.basic (.add pointerReg pointerReg oneReg), + Cmd.basic (.sub lengthReg lengthReg oneReg)] + +/-- Process input bits until the remaining-length register reaches zero. -/ +def mainLoop : Cmd := Cmd.whileNonzero lengthReg body + +/-- Copy the accumulator to the result register `R₀`. -/ +def finalize : Cmd := Cmd.seqList + [Cmd.basic (.imm oneReg 0), Cmd.basic (.add lengthReg countReg oneReg)] + +/-- Complete structured Hamming-weight program. -/ +def program : Cmd := Cmd.seq setup (.seq mainLoop finalize) + +/-- Concrete compiled RAM program for Hamming weight. -/ +def compiled : Program := program.compile + +/-- Exact number of target RAM transitions needed to reach the compiled halt +instruction. A zero bit uses six loop transitions and a one bit uses eight. -/ +def stepCount (bits : List Bool) : ℕ := + 6 + 6 * bits.length + 2 * weight bits + +/-- Explicit logarithmic-cost time budget as a function of input length. The +fixedValue is deliberately simple: the important content is the linear number +of operations, each on values of `O(bitlen n)` bits. -/ +def timeBound (inputLength : ℕ) : ℕ := + 64 * (inputLength + 1) * (bitlen (inputLength + 5) + 1) + +/-- Explicit peak-space budget for the reserved-register input representation. +There are at most `inputLength + 5` nonzero registers, and both an occupied +register index and its value have at most `bitlen (inputLength + 5)` bits. -/ +def spaceBound (inputLength : ℕ) : ℕ := + (inputLength + 5) * (2 * bitlen (inputLength + 5)) + +/-- A shifted `n · bitlen n` comparison function used to state the benchmark's +quasilinear time and space bounds without hiding small-input behavior. -/ +def quasilinearBound (inputLength : ℕ) : ℕ := + (inputLength + 5) * (bitlen (inputLength + 5) + 1) + +end Hamming + +end Structured + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Hamming/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Hamming/Internal.lean new file mode 100644 index 0000000000..60b63074db --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Hamming/Internal.lean @@ -0,0 +1,475 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.Hamming.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.Internal.Resources + +/-! +# Structured RAM Hamming-weight program — proof internals +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace Structured + +namespace Hamming + +open Internal + +private abbrev StoreBound (inputLength : ℕ) (store : Store) : Prop := + StoreEnvelope (inputLength + 5) (inputLength + 5) store + +private abbrev width (inputLength : ℕ) : ℕ := + valueWidth (inputLength + 5) + +private abbrev resourceSpace (inputLength : ℕ) : ℕ := + envelopeSpace (inputLength + 5) (inputLength + 5) + +private theorem envelopeSpace_eq_spaceBound (inputLength : ℕ) : + envelopeSpace (inputLength + 5) (inputLength + 5) = spaceBound inputLength := by + simp [envelopeSpace, spaceBound, two_mul] + +private theorem inputStore_bound (bits : List Bool) : + StoreBound bits.length (inputStore bits) := by + apply Internal.Input.bitStoreEnvelope + · simp [lengthReg] + · simp [inputBase] + omega + · omega + · omega + +private structure LoopInv (inputLength : ℕ) (remaining : List Bool) + (consumed acc : ℕ) (store : Store) : Prop where + total_eq : consumed + remaining.length = inputLength + acc_le : acc ≤ consumed + store_bound : StoreBound inputLength store + length_eq : store lengthReg = remaining.length + count_eq : store countReg = acc + pointer_eq : store pointerReg = inputBase + consumed + one_eq : store oneReg = 1 + input_eq : ∀ offset, + store (inputBase + consumed + offset) = + match remaining[offset]? with + | some bit => bitValue bit + | none => 0 + +private def loaded (store : Store) : Store := + (Basic.load scratchReg pointerReg).exec store + +private def branched (bit : Bool) (store : Store) : Store := + if bit then (Basic.add countReg countReg oneReg).exec (loaded store) + else loaded store + +private def advanced (bit : Bool) (store : Store) : Store := + (Basic.add pointerReg pointerReg oneReg).exec (branched bit store) + +private def iterated (bit : Bool) (store : Store) : Store := + (Basic.sub lengthReg lengthReg oneReg).exec (advanced bit store) + +private theorem bitValue_le_one (bit : Bool) : bitValue bit ≤ 1 := by + cases bit <;> simp [bitValue] + +private theorem loaded_bound {inputLength : ℕ} {store : Store} + (hstore : StoreBound inputLength store) : + StoreBound inputLength (loaded store) := by + apply hstore.execBasic (.load scratchReg pointerReg) + · simp [scratchReg] + · simpa [Internal.Basic.writeValue] using hstore.value_le (store pointerReg) + +private theorem branched_bound {bit : Bool} {rest : List Bool} + {inputLength consumed acc : ℕ} {store : Store} + (hinv : LoopInv inputLength (bit :: rest) consumed acc store) : + StoreBound inputLength (branched bit store) := by + cases bit with + | false => simpa [branched] using loaded_bound hinv.store_bound + | true => + rw [branched, if_pos rfl] + apply (loaded_bound hinv.store_bound).execBasic + (.add countReg countReg oneReg) + · simp [countReg] + · have hcount : loaded store countReg = acc := by + have hcount₀ : store 1 = acc := by + simpa [countReg] using hinv.count_eq + simp [loaded, Basic.exec, countReg, scratchReg, hcount₀] + have hone : loaded store oneReg = 1 := by + have hone₀ : store 3 = 1 := by simpa [oneReg] using hinv.one_eq + simp [loaded, Basic.exec, oneReg, scratchReg, hone₀] + change loaded store countReg + loaded store oneReg ≤ inputLength + 5 + rw [hcount, hone] + have htotal := hinv.total_eq + have hacc := hinv.acc_le + omega + +private theorem advanced_bound {bit : Bool} {rest : List Bool} + {inputLength consumed acc : ℕ} {store : Store} + (hinv : LoopInv inputLength (bit :: rest) consumed acc store) : + StoreBound inputLength (advanced bit store) := by + apply (branched_bound hinv).execBasic (.add pointerReg pointerReg oneReg) + · simp [pointerReg] + · have hpointer : branched bit store pointerReg = inputBase + consumed := by + have hpointer₀ : store 2 = inputBase + consumed := by + simpa [pointerReg] using hinv.pointer_eq + cases bit <;> + simp [branched, loaded, Basic.exec, pointerReg, oneReg, scratchReg, + countReg, hpointer₀] + have hone : branched bit store oneReg = 1 := by + have hone₀ : store 3 = 1 := by simpa [oneReg] using hinv.one_eq + cases bit <;> + simp [branched, loaded, Basic.exec, pointerReg, oneReg, scratchReg, + countReg, hone₀] + change branched bit store pointerReg + branched bit store oneReg ≤ inputLength + 5 + rw [hpointer, hone] + have htotal := hinv.total_eq + simp [inputBase] at htotal ⊢ + omega + +private theorem iterated_bound {bit : Bool} {rest : List Bool} + {inputLength consumed acc : ℕ} {store : Store} + (hinv : LoopInv inputLength (bit :: rest) consumed acc store) : + StoreBound inputLength (iterated bit store) := by + apply (advanced_bound hinv).execBasic (.sub lengthReg lengthReg oneReg) + · simp [lengthReg] + · have hlength : advanced bit store lengthReg = (bit :: rest).length := by + have hlength₀ : store 0 = rest.length + 1 := by + simpa [lengthReg] using hinv.length_eq + cases bit <;> + simp [advanced, branched, loaded, Basic.exec, lengthReg, pointerReg, + oneReg, scratchReg, countReg, hlength₀] + have hone : advanced bit store oneReg = 1 := by + have hone₀ : store 3 = 1 := by simpa [oneReg] using hinv.one_eq + cases bit <;> + simp [advanced, branched, loaded, Basic.exec, pointerReg, + oneReg, scratchReg, countReg, hone₀] + change advanced bit store lengthReg - advanced bit store oneReg ≤ inputLength + 5 + rw [hlength, hone] + have htotal := hinv.total_eq + omega + +private theorem loaded_scratch {bit : Bool} {rest : List Bool} + {inputLength consumed acc : ℕ} {store : Store} + (hinv : LoopInv inputLength (bit :: rest) consumed acc store) : + loaded store scratchReg = bitValue bit := by + simp only [loaded, Basic.exec, Function.update_self] + rw [hinv.pointer_eq] + simpa using hinv.input_eq 0 + +private theorem body_measured {bit : Bool} {rest : List Bool} + {inputLength consumed acc : ℕ} {store : Store} + (hinv : LoopInv inputLength (bit :: rest) consumed acc store) : + MeasuredRuns body store (iterated bit store) (4 + 2 * bitValue bit) + (20 * width inputLength) (resourceSpace inputLength) := by + have hloadedBound := loaded_bound hinv.store_bound + have hbranchedBound := branched_bound hinv + have hadvancedBound := advanced_bound hinv + have hiteratedBound := iterated_bound hinv + have hload : MeasuredRuns (.basic (.load scratchReg pointerReg)) + store (loaded store) 1 (4 * width inputLength) (resourceSpace inputLength) := + MeasuredRuns.basicEnvelope _ _ hinv.store_bound hloadedBound + have hbranch : MeasuredRuns + (.ifZero scratchReg Cmd.skip (.basic (.add countReg countReg oneReg))) + (loaded store) (branched bit store) (1 + 2 * bitValue bit) + (8 * width inputLength) (resourceSpace inputLength) := by + cases bit with + | false => + have hzero : loaded store scratchReg = 0 := by + simpa [bitValue] using loaded_scratch hinv + have hrun := MeasuredRuns.ifZeroEnvelope + (onNonzero := .basic (.add countReg countReg oneReg)) hzero hloadedBound + (MeasuredRuns.skipEnvelope hloadedBound) + apply MeasuredRuns.weakenCost (by simpa [branched, bitValue] using hrun) + change width inputLength ≤ 8 * width inputLength + omega + | true => + have hnonzero : loaded store scratchReg ≠ 0 := by + have hscratch := loaded_scratch hinv + simp [bitValue, hscratch] + let op := Basic.add countReg countReg oneReg + have hop : op.exec (loaded store) = branched true store := by + simp [op, branched] + have hadd := MeasuredRuns.basicEnvelope op (loaded store) hloadedBound + (by simpa [hop] using hbranchedBound) + have hrun := MeasuredRuns.ifNonzeroEnvelope (onZero := Cmd.skip) + hnonzero hloadedBound hadd + apply MeasuredRuns.weakenCost (by simpa [branched, bitValue, op] using hrun) + change 3 * width inputLength + 4 * width inputLength ≤ + 8 * width inputLength + omega + have hadvance : MeasuredRuns (.basic (.add pointerReg pointerReg oneReg)) + (branched bit store) (advanced bit store) 1 (4 * width inputLength) + (resourceSpace inputLength) := + MeasuredRuns.basicEnvelope _ _ hbranchedBound hadvancedBound + have hdecrement : MeasuredRuns (.basic (.sub lengthReg lengthReg oneReg)) + (advanced bit store) (iterated bit store) 1 (4 * width inputLength) + (resourceSpace inputLength) := + MeasuredRuns.basicEnvelope _ _ hadvancedBound hiteratedBound + have hrun := hload.seq (hbranch.seq (hadvance.seq hdecrement)) + rw [body, Cmd.seqList] + convert hrun using 1 + · cases bit <;> simp [bitValue] + · ring + +private theorem iterated_high (bit : Bool) (store : Store) (index : ℕ) + (hindex : inputBase ≤ index) : iterated bit store index = store index := by + have hlength : index ≠ lengthReg := by + simp [inputBase, lengthReg] at hindex ⊢ + omega + have hcount : index ≠ countReg := by + simp [inputBase, countReg] at hindex ⊢ + omega + have hpointer : index ≠ pointerReg := by + simp [inputBase, pointerReg] at hindex ⊢ + omega + have hscratch : index ≠ scratchReg := by + simp [inputBase, scratchReg] at hindex ⊢ + omega + cases bit <;> simp [iterated, advanced, branched, loaded, Basic.exec, + Function.update_of_ne, hlength, hcount, hpointer, hscratch] + +private theorem iterated_inv {bit : Bool} {rest : List Bool} + {inputLength consumed acc : ℕ} {store : Store} + (hinv : LoopInv inputLength (bit :: rest) consumed acc store) : + LoopInv inputLength rest (consumed + 1) (acc + bitValue bit) + (iterated bit store) := by + constructor + · have htotal := hinv.total_eq + simp only [List.length_cons] at htotal + omega + · have hbit := bitValue_le_one bit + have hacc := hinv.acc_le + omega + · exact iterated_bound hinv + · cases bit <;> + simp [iterated, advanced, branched, loaded, Basic.exec, lengthReg, + countReg, pointerReg, oneReg, scratchReg] + all_goals + have hlength : store 0 = (Bool.false :: rest).length := by + simpa [lengthReg] using hinv.length_eq + have hone : store 3 = 1 := by simpa [oneReg] using hinv.one_eq + rw [hlength, hone] + simp + · cases bit <;> + simp [iterated, advanced, branched, loaded, Basic.exec, lengthReg, + countReg, pointerReg, oneReg, scratchReg, bitValue] + all_goals + have hcount : store 1 = acc := by simpa [countReg] using hinv.count_eq + have hone : store 3 = 1 := by simpa [oneReg] using hinv.one_eq + simp [hcount, hone] + · cases bit <;> + simp [iterated, advanced, branched, loaded, Basic.exec, lengthReg, + countReg, pointerReg, oneReg, scratchReg, inputBase] + all_goals + have hpointer : store 2 = 5 + consumed := by + simpa [pointerReg, inputBase] using hinv.pointer_eq + have hone : store 3 = 1 := by simpa [oneReg] using hinv.one_eq + rw [hpointer, hone] + omega + · cases bit <;> + simp [iterated, advanced, branched, loaded, Basic.exec, lengthReg, + countReg, pointerReg, oneReg, scratchReg] <;> exact hinv.one_eq + · intro offset + rw [iterated_high bit store _ (by simp [inputBase]; omega)] + have hinput := hinv.input_eq (offset + 1) + convert hinput using 1 + all_goals simp [Nat.add_assoc, Nat.add_comm, Nat.add_left_comm] + +private def loopAdvance (state : ℕ × ℕ) (bit : Bool) : ℕ × ℕ := + (state.1 + 1, state.2 + bitValue bit) + +private theorem foldl_loopAdvance (bits : List Bool) (consumed acc : ℕ) : + bits.foldl loopAdvance (consumed, acc) = + (consumed + bits.length, acc + weight bits) := by + induction bits generalizing consumed acc with + | nil => simp [weight] + | cons bit rest ih => + simp only [List.foldl_cons, loopAdvance] + rw [ih] + simp only [List.length_cons, weight] + cases bit <;> simp [bitValue] <;> omega + +private theorem whileFoldSteps_eq (bits : List Bool) : + MeasuredRuns.whileFoldSteps (fun bit => 4 + 2 * bitValue bit) bits = + 1 + 6 * bits.length + 2 * weight bits := by + induction bits with + | nil => simp [MeasuredRuns.whileFoldSteps, weight] + | cons bit rest ih => + rw [MeasuredRuns.whileFoldSteps, ih] + cases bit <;> simp [weight, bitValue] <;> omega + +private theorem whileFoldCost_eq (bits : List Bool) (w : ℕ) : + MeasuredRuns.whileFoldCost w (fun _ : Bool => 20 * w) bits = + (23 * bits.length + 1) * w := by + induction bits with + | nil => simp [MeasuredRuns.whileFoldCost] + | cons bit rest ih => + rw [MeasuredRuns.whileFoldCost, ih] + simp only [List.length_cons] + ring + +private theorem loop_measured {remaining : List Bool} {inputLength consumed acc : ℕ} + {store : Store} (hinv : LoopInv inputLength remaining consumed acc store) : + ∃ final, + MeasuredRuns mainLoop store final + (1 + 6 * remaining.length + 2 * weight remaining) + ((23 * remaining.length + 1) * width inputLength) + (resourceSpace inputLength) ∧ + final countReg = acc + weight remaining ∧ final lengthReg = 0 ∧ + StoreBound inputLength final := by + let bodySteps : Bool → ℕ := fun bit => 4 + 2 * bitValue bit + let bodyCost : Bool → ℕ := fun _ => 20 * width inputLength + have hrun := MeasuredRuns.whileFoldEnvelope + (Inv := fun items state store => + LoopInv inputLength items state.1 state.2 store) + (advance := loopAdvance) (bodySteps := bodySteps) (bodyCost := bodyCost) + (test := lengthReg) (body := body) + (hstore := by intro _ _ _ h; exact h.store_bound) + (hnil := by intro _ _ h; simpa using h.length_eq) + (hcons := by intro _ _ _ _ h; rw [h.length_eq]; simp) + (hbody := by + intro bit rest state current h + exact ⟨iterated bit current, body_measured h, by + simpa [loopAdvance] using iterated_inv h⟩) + (items := remaining) (state := (consumed, acc)) (initial := store) hinv + obtain ⟨final, hloop, hfinal⟩ := hrun + have hsteps : MeasuredRuns.whileFoldSteps bodySteps remaining = + 1 + 6 * remaining.length + 2 * weight remaining := by + simpa [bodySteps] using whileFoldSteps_eq remaining + have hcost : MeasuredRuns.whileFoldCost (width inputLength) bodyCost remaining = + (23 * remaining.length + 1) * width inputLength := by + simpa [bodyCost] using whileFoldCost_eq remaining (width inputLength) + have hstate := foldl_loopAdvance remaining consumed acc + rw [hstate] at hfinal + refine ⟨final, ?_, hfinal.count_eq, hfinal.length_eq, hfinal.store_bound⟩ + simpa [mainLoop, hsteps, hcost] using hloop + +private def setupStore (bits : List Bool) : Store := + Basic.execList setupOps (inputStore bits) + +private theorem setup_measured (bits : List Bool) : + MeasuredRuns setup (inputStore bits) (setupStore bits) 3 + (12 * width bits.length) (resourceSpace bits.length) ∧ + StoreBound bits.length (setupStore bits) := by + have hinitial := inputStore_bound bits + have hpreserve : ∀ op, op ∈ setupOps → ∀ current, + StoreBound bits.length current → + StoreBound bits.length (op.exec current) := by + intro op hop current hcurrent + simp [setupOps] at hop + rcases hop with rfl | rfl | rfl + · apply hcurrent.execBasic (.imm countReg 0) <;> simp [countReg] + · apply hcurrent.execBasic (.imm pointerReg inputBase) + · simp [pointerReg] + · simp [inputBase] + · apply hcurrent.execBasic (.imm oneReg 1) <;> simp [oneReg] + obtain ⟨hrun, hfinal⟩ := + MeasuredRuns.basicsEnvelope setupOps (inputStore bits) hinitial hpreserve + constructor + · simpa [setup, setupStore, setupOps] using hrun + · simpa [setupStore] using hfinal + +private theorem setup_inv (bits : List Bool) + (hbound : StoreBound bits.length (setupStore bits)) : + LoopInv bits.length bits 0 0 (setupStore bits) := by + constructor + · simp + · simp + · exact hbound + · simp [setupStore, setupOps, Basic.execList, Basic.exec, inputStore, + Input.bitStore, lengthReg, countReg, pointerReg, oneReg, inputBase] + · simp [setupStore, setupOps, Basic.execList, Basic.exec, countReg, pointerReg, oneReg] + · simp [setupStore, setupOps, Basic.execList, Basic.exec, pointerReg, oneReg, inputBase] + · simp [setupStore, setupOps, Basic.execList, Basic.exec, oneReg] + · intro offset + have hcount : 5 + offset ≠ 1 := by omega + have hpointer : 5 + offset ≠ 2 := by omega + have hone : 5 + offset ≠ 3 := by omega + simp [setupStore, setupOps, Basic.execList, Basic.exec, Function.update_of_ne, + hcount, hpointer, hone, inputStore, Input.bitStore, bitValue, lengthReg, + countReg, pointerReg, oneReg, inputBase] + rfl + +private def finalStore (store : Store) : Store := + (Basic.add lengthReg countReg oneReg).exec + ((Basic.imm oneReg 0).exec store) + +private theorem finalize_measured {inputLength : ℕ} {store : Store} + (hstore : StoreBound inputLength store) : + MeasuredRuns finalize store (finalStore store) 2 + (8 * width inputLength) (resourceSpace inputLength) := by + let zeroed := (Basic.imm oneReg 0).exec store + have hzeroed : StoreBound inputLength zeroed := by + apply hstore.execBasic (.imm oneReg 0) + · simp [oneReg] + · simp [Internal.Basic.writeValue] + have hfinal : StoreBound inputLength (finalStore store) := by + apply hzeroed.execBasic (.add lengthReg countReg oneReg) + · simp [lengthReg] + · have hcount := hstore.value_le countReg + simpa [zeroed, Basic.exec, countReg, oneReg] using hcount + have hzero : MeasuredRuns (.basic (.imm oneReg 0)) store zeroed 1 + (4 * width inputLength) (resourceSpace inputLength) := + MeasuredRuns.basicEnvelope _ _ hstore hzeroed + have hadd : MeasuredRuns (.basic (.add lengthReg countReg oneReg)) zeroed + (finalStore store) 1 (4 * width inputLength) (resourceSpace inputLength) := + MeasuredRuns.basicEnvelope _ _ hzeroed hfinal + have hrun := hzero.seq hadd + rw [finalize, Cmd.seqList] + convert hrun using 1 + all_goals ring + +theorem program_measured_internal (bits : List Bool) : + ∃ final cost space, + Exec program (inputStore bits) final (stepCount bits) cost space ∧ + cost ≤ timeBound bits.length ∧ space ≤ spaceBound bits.length ∧ + final lengthReg = weight bits := by + obtain ⟨hsetup, hsetupStore⟩ := setup_measured bits + have hsetupInv := setup_inv bits hsetupStore + obtain ⟨loopFinal, hloop, hcount, hlength, hloopStore⟩ := + loop_measured hsetupInv + have hfinalize := finalize_measured hloopStore + have hseq := hsetup.seq (hloop.seq hfinalize) + have hcostLe : + 12 * width bits.length + + ((23 * bits.length + 1) * width bits.length + 8 * width bits.length) + ≤ timeBound bits.length := by + rw [timeBound] + change _ ≤ 64 * (bits.length + 1) * width bits.length + calc + 12 * width bits.length + + ((23 * bits.length + 1) * width bits.length + 8 * width bits.length) + = (23 * bits.length + 21) * width bits.length := by ring + _ ≤ (64 * (bits.length + 1)) * width bits.length := + Nat.mul_le_mul_right _ (by omega) + _ = 64 * (bits.length + 1) * width bits.length := by ring + have hprogram := hseq.weakenCost hcostLe + rw [program] + have hprogram' : MeasuredRuns (setup.seq (mainLoop.seq finalize)) + (inputStore bits) (finalStore loopFinal) (stepCount bits) + (timeBound bits.length) (resourceSpace bits.length) := by + convert hprogram using 1 + unfold stepCount + ring + obtain ⟨cost, space, hexec, hcost, hspace⟩ := hprogram' + have hspace' : space ≤ spaceBound bits.length := by + rw [← envelopeSpace_eq_spaceBound] + exact hspace + refine ⟨finalStore loopFinal, cost, space, hexec, hcost, hspace', ?_⟩ + have hcount' : loopFinal 1 = weight bits := by + simpa [countReg] using hcount + simp [finalStore, Basic.exec, hcount', lengthReg, countReg, oneReg] + +end Hamming + +end Structured + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Internal.lean new file mode 100644 index 0000000000..514638dadb --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Internal.lean @@ -0,0 +1,401 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.Defs +public import Mathlib.Algebra.Order.Group.Nat +public import Mathlib.Algebra.Order.Sub.Basic + +/-! +# Structured logarithmic-cost RAM programs — proof internals + +This file proves that absolute-jump lowering preserves the independent source +semantics exactly: final registers, logarithmic cost, and peak register space. +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace Structured + +namespace Cmd + +theorem length_compileAt (cmd : Cmd) (start : ℕ) : + (cmd.compileAt start).length = cmd.codeSize := by + induction cmd generalizing start with + | skip => rfl + | basic op => rfl + | seq first second ihFirst ihSecond => + simp only [compileAt, List.length_append, ihFirst, ihSecond, codeSize] + | ifZero test onZero onNonzero ihZero ihNonzero => + simp only [compileAt, List.length_append, List.length_cons, List.length_nil, + ihZero, ihNonzero, codeSize] + omega + | whileNonzero test body ih => + simp only [compileAt, List.length_append, List.length_cons, List.length_nil, + ih, codeSize] + omega + +end Cmd + +private theorem curInstr_append_head (pre suffix : Program) (instr : Instr) + (regs : Store) : + curInstr (pre ++ instr :: suffix) { pc := pre.length, regs := regs } = instr := by + simp [curInstr] + +private theorem not_halted_append_head (pre suffix : Program) (op : Basic) + (regs : Store) : + ¬Halted (pre ++ op.instr :: suffix) { pc := pre.length, regs := regs } := by + simp [Halted, curInstr_append_head] + cases op <;> simp [Basic.instr] + +private theorem not_halted_jz (pre suffix : Program) (test target : ℕ) + (regs : Store) : + ¬Halted (pre ++ Instr.jz test target :: suffix) + { pc := pre.length, regs := regs } := by + simp [Halted, curInstr_append_head] + +private theorem not_halted_jmp (pre suffix : Program) (target : ℕ) + (regs : Store) : + ¬Halted (pre ++ Instr.jmp target :: suffix) + { pc := pre.length, regs := regs } := by + simp [Halted, curInstr_append_head] + +private theorem cfg_space_eq_store_space (pc : ℕ) (regs : Store) : + (Cfg.mk pc regs).space = regs.space := rfl + +private theorem step_basic (pre suffix : Program) (op : Basic) (regs : Store) : + step (pre ++ op.instr :: suffix) { pc := pre.length, regs := regs } = + { pc := pre.length + 1, regs := op.exec regs } := by + unfold step + rw [curInstr_append_head] + cases op <;> simp [Basic.instr, Basic.exec, stepInstr] + +private theorem step_jz_zero (pre suffix : Program) (test target : ℕ) + (regs : Store) (htest : regs test = 0) : + step (pre ++ Instr.jz test target :: suffix) + { pc := pre.length, regs := regs } = + { pc := target, regs := regs } := by + unfold step + rw [curInstr_append_head] + simp [stepInstr, htest] + +private theorem step_jz_nonzero (pre suffix : Program) (test target : ℕ) + (regs : Store) (htest : regs test ≠ 0) : + step (pre ++ Instr.jz test target :: suffix) + { pc := pre.length, regs := regs } = + { pc := pre.length + 1, regs := regs } := by + unfold step + rw [curInstr_append_head] + simp [stepInstr, htest] + +private theorem step_jmp (pre suffix : Program) (target : ℕ) (regs : Store) : + step (pre ++ Instr.jmp target :: suffix) + { pc := pre.length, regs := regs } = + { pc := target, regs := regs } := by + unfold step + rw [curInstr_append_head] + rfl + +private theorem space_le_spaceUpto (P : Program) (fuel : ℕ) (cfg : Cfg) : + cfg.space ≤ spaceUpto P fuel cfg := by + cases fuel with + | zero => rfl + | succ fuel => + simp only [spaceUpto] + split + · rfl + · exact le_max_left _ _ + +private theorem spaceUpto_halted (P : Program) {cfg : Cfg} + (hhalt : Halted P cfg) (fuel : ℕ) : spaceUpto P fuel cfg = cfg.space := by + cases fuel with + | zero => rfl + | succ fuel => simp [spaceUpto, hhalt] + +private theorem spaceUpto_add (P : Program) (first second : ℕ) (cfg : Cfg) : + spaceUpto P (first + second) cfg = + max (spaceUpto P first cfg) (spaceUpto P second (run P first cfg)) := by + induction first generalizing cfg with + | zero => + simp only [Nat.zero_add, spaceUpto, run_zero] + exact (max_eq_right (space_le_spaceUpto P second cfg)).symm + | succ first ih => + rw [Nat.succ_add] + simp only [spaceUpto, run_succ] + by_cases hhalt : Halted P cfg + · simp [hhalt, spaceUpto_halted P hhalt] + · simp only [if_neg hhalt, ih] + omega + +private theorem run_space_le_spaceUpto (P : Program) (fuel : ℕ) (cfg : Cfg) : + (run P fuel cfg).space ≤ spaceUpto P fuel cfg := by + have hsplit := spaceUpto_add P fuel 0 cfg + simp only [Nat.add_zero, spaceUpto] at hsplit + calc + (run P fuel cfg).space ≤ + max (spaceUpto P fuel cfg) (run P fuel cfg).space := le_max_right _ _ + _ = spaceUpto P fuel cfg := hsplit.symm + +theorem compileAt_correct_internal + {cmd : Cmd} {initial final : Store} {steps cost space : ℕ} + (hexec : Exec cmd initial final steps cost space) + (pre suffix : Program) : + let P := pre ++ cmd.compileAt pre.length ++ suffix + let start : Cfg := { pc := pre.length, regs := initial } + run P steps start = + { pc := pre.length + cmd.codeSize, regs := final } ∧ + logTimeUpto P steps start = cost ∧ + spaceUpto P steps start = space := by + dsimp only + induction hexec generalizing pre suffix with + | skip store => + simp [Cmd.compileAt, Cmd.codeSize, spaceUpto, Store.space, Cfg.space] + | basic op store => + simp only [Cmd.compileAt, Cmd.codeSize, List.singleton_append, + List.append_assoc] + have hhalt := not_halted_append_head pre suffix op store + rw [run_one, step_basic] + constructor + · rfl + constructor + · simp [logTimeUpto, hhalt, Basic.logCost, stepLogCost, + curInstr_append_head] + cases op <;> rfl + · simp [spaceUpto, hhalt, step_basic, Store.space, Cfg.space] + | seq hfirst hsecond ihFirst ihSecond => + rename_i firstCmd secondCmd store middle final firstSteps secondSteps firstCost + secondCost firstSpace secondSpace + simp only [Cmd.compileAt, Cmd.codeSize] + let secondPre := pre ++ Cmd.compileAt pre.length firstCmd + have hSecondPre : secondPre.length = pre.length + firstCmd.codeSize := by + simp [secondPre, Cmd.length_compileAt] + have hfirstRun := + ihFirst pre (Cmd.compileAt (pre.length + firstCmd.codeSize) secondCmd ++ suffix) + have hsecondRun := ihSecond secondPre suffix + simp only [secondPre, hSecondPre] at hsecondRun + simp only [List.append_assoc] at hfirstRun hsecondRun ⊢ + rw [run_add, logTimeUpto_add, spaceUpto_add] + rw [hfirstRun.1, hfirstRun.2.1, hfirstRun.2.2] + rw [hsecondRun.1, hsecondRun.2.1, hsecondRun.2.2] + simp [Nat.add_assoc] + | ifZero htest hbranch ih => + rename_i test onZero onNonzero store final branchSteps branchCost branchSpace + simp only [Cmd.compileAt, Cmd.codeSize] + let zeroStart := pre.length + 1 + onNonzero.codeSize + 1 + let done := pre.length + (2 + onZero.codeSize + onNonzero.codeSize) + let zeroPre := pre ++ [Instr.jz test zeroStart] ++ + onNonzero.compileAt (pre.length + 1) ++ [Instr.jmp done] + have hZeroPre : zeroPre.length = zeroStart := by + simp [zeroPre, zeroStart, Cmd.length_compileAt] + omega + have hbranchRun := ih zeroPre suffix + simp only [hZeroPre] at hbranchRun + dsimp only [zeroPre, zeroStart, done] at hbranchRun ⊢ + simp only [List.nil_append, List.cons_append, List.append_assoc] + at hbranchRun ⊢ + rw [run_succ, logTimeUpto_succ] + simp [Halted, curInstr] + rw [step_jz_zero pre _ test _ store htest] + rw [spaceUpto] + simp [Halted, curInstr] + rw [step_jz_zero pre _ test _ store htest] + rw [hbranchRun.1, hbranchRun.2.1, hbranchRun.2.2] + simp [stepLogCost, curInstr_append_head, Instr.logCost, Store.space, + Cfg.space, Nat.add_assoc, Nat.add_comm, Nat.add_left_comm] + all_goals omega + | ifNonzero htest hbranch ih => + rename_i test onZero onNonzero store final branchSteps branchCost branchSpace + simp only [Cmd.compileAt, Cmd.codeSize] + let zeroStart := pre.length + 1 + onNonzero.codeSize + 1 + let done := pre.length + (2 + onZero.codeSize + onNonzero.codeSize) + let nonzeroPre := pre ++ [Instr.jz test zeroStart] + have hNonzeroPre : nonzeroPre.length = pre.length + 1 := by + simp [nonzeroPre] + have hbranchRun := ih nonzeroPre + (Instr.jmp done :: onZero.compileAt zeroStart ++ suffix) + simp only [hNonzeroPre] at hbranchRun + dsimp only [nonzeroPre, zeroStart, done] at hbranchRun ⊢ + simp only [List.nil_append, List.cons_append, List.append_assoc] + at hbranchRun ⊢ + let jmpPre := pre ++ + [Instr.jz test (pre.length + 1 + onNonzero.codeSize + 1)] ++ + onNonzero.compileAt (pre.length + 1) + have hjmp := step_jmp jmpPre + (onZero.compileAt (pre.length + 1 + onNonzero.codeSize + 1) ++ suffix) + (pre.length + (2 + onZero.codeSize + onNonzero.codeSize)) final + dsimp only [jmpPre] at hjmp + have hjmp' : + step + (pre ++ Instr.jz test (pre.length + 1 + onNonzero.codeSize + 1) :: + (onNonzero.compileAt (pre.length + 1) ++ + Instr.jmp (pre.length + (2 + onZero.codeSize + onNonzero.codeSize)) :: + (onZero.compileAt (pre.length + 1 + onNonzero.codeSize + 1) ++ suffix))) + { pc := pre.length + 1 + onNonzero.codeSize, regs := final } = + { pc := pre.length + (2 + onZero.codeSize + onNonzero.codeSize), + regs := final } := by + simpa [Cmd.length_compileAt, Nat.add_assoc, Nat.add_comm, + Nat.add_left_comm] using hjmp + have hjmpInstr := curInstr_append_head jmpPre + (onZero.compileAt (pre.length + 1 + onNonzero.codeSize + 1) ++ suffix) + (Instr.jmp (pre.length + (2 + onZero.codeSize + onNonzero.codeSize))) final + dsimp only [jmpPre] at hjmpInstr + have hjmpInstr' : + curInstr + (pre ++ Instr.jz test (pre.length + 1 + onNonzero.codeSize + 1) :: + (onNonzero.compileAt (pre.length + 1) ++ + Instr.jmp (pre.length + (2 + onZero.codeSize + onNonzero.codeSize)) :: + (onZero.compileAt (pre.length + 1 + onNonzero.codeSize + 1) ++ suffix))) + { pc := pre.length + 1 + onNonzero.codeSize, regs := final } = + Instr.jmp (pre.length + (2 + onZero.codeSize + onNonzero.codeSize)) := by + simpa [Cmd.length_compileAt, Nat.add_assoc, Nat.add_comm, + Nat.add_left_comm] using hjmpInstr + have hjmpHalt : + ¬Halted + (pre ++ Instr.jz test (pre.length + 1 + onNonzero.codeSize + 1) :: + (onNonzero.compileAt (pre.length + 1) ++ + Instr.jmp (pre.length + (2 + onZero.codeSize + onNonzero.codeSize)) :: + (onZero.compileAt (pre.length + 1 + onNonzero.codeSize + 1) ++ suffix))) + { pc := pre.length + 1 + onNonzero.codeSize, regs := final } := by + simp [Halted, hjmpInstr'] + rw [run_succ, logTimeUpto_succ] + simp [Halted, curInstr] + rw [step_jz_nonzero pre _ test _ store htest] + rw [run_succ_step, hbranchRun.1] + rw [hjmp'] + rw [logTimeUpto_add _ branchSteps 1] + rw [hbranchRun.2.1, hbranchRun.1] + rw [show (1 : ℕ) = 0 + 1 from rfl, logTimeUpto_succ] + rw [if_neg hjmpHalt] + simp [stepLogCost, hjmpInstr', Instr.logCost] + rw [spaceUpto] + simp [Halted, curInstr] + rw [step_jz_nonzero pre _ test _ store htest] + rw [spaceUpto_add _ branchSteps 1, hbranchRun.2.2, hbranchRun.1] + rw [show (1 : ℕ) = 0 + 1 from rfl, spaceUpto] + rw [if_neg hjmpHalt, hjmp'] + simp only [spaceUpto] + have hfinalSpace : final.space ≤ branchSpace := by + have hrunSpace := run_space_le_spaceUpto + (pre ++ Instr.jz test (pre.length + 1 + onNonzero.codeSize + 1) :: + (onNonzero.compileAt (pre.length + 1) ++ + Instr.jmp (pre.length + (2 + onZero.codeSize + onNonzero.codeSize)) :: + (onZero.compileAt (pre.length + 1 + onNonzero.codeSize + 1) ++ suffix))) + branchSteps { pc := pre.length + 1, regs := store } + rw [hbranchRun.1, hbranchRun.2.2] at hrunSpace + simpa [Store.space, Cfg.space] using hrunSpace + constructor + · omega + · change max store.space (max branchSpace (max final.space final.space)) = + max store.space branchSpace + rw [max_self, max_eq_left hfinalSpace] + | whileZero htest => + rename_i test body store + simp only [Cmd.compileAt, Cmd.codeSize, List.cons_append, List.append_assoc] + rw [run_one] + rw [step_jz_zero pre _ test _ store htest] + constructor + · rfl + constructor + · simp [logTimeUpto, Halted, curInstr, stepLogCost, Instr.logCost, + Nat.add_comm] + · simp [spaceUpto, Halted, curInstr, + step_jz_zero pre _ test _ store htest, Store.space, Cfg.space] + | whileNonzero htest hbody hloop ihBody ihLoop => + rename_i test body store middle final bodySteps loopSteps bodyCost loopCost + bodySpace loopSpace + simp only [Cmd.compileAt, Cmd.codeSize] + let done := pre.length + (body.codeSize + 2) + let bodyPre := pre ++ [Instr.jz test done] + have hBodyPre : bodyPre.length = pre.length + 1 := by + simp [bodyPre] + have hbodyRun := ihBody bodyPre (Instr.jmp pre.length :: suffix) + simp only [hBodyPre] at hbodyRun + have hloopRun := ihLoop pre suffix + simp only [Cmd.compileAt, Cmd.codeSize] at hloopRun + dsimp only [bodyPre, done] at hbodyRun hloopRun ⊢ + simp only [List.nil_append, List.cons_append, List.append_assoc] + at hbodyRun hloopRun ⊢ + let jmpPre := pre ++ [Instr.jz test (pre.length + (body.codeSize + 2))] ++ + body.compileAt (pre.length + 1) + have hjmp := step_jmp jmpPre suffix pre.length middle + dsimp only [jmpPre] at hjmp + have hjmp' : + step + (pre ++ Instr.jz test (pre.length + (body.codeSize + 2)) :: + (body.compileAt (pre.length + 1) ++ Instr.jmp pre.length :: suffix)) + { pc := pre.length + 1 + body.codeSize, regs := middle } = + { pc := pre.length, regs := middle } := by + simpa [Cmd.length_compileAt, Nat.add_assoc, Nat.add_comm, + Nat.add_left_comm] using hjmp + have hjmpInstr := curInstr_append_head jmpPre suffix + (Instr.jmp pre.length) middle + dsimp only [jmpPre] at hjmpInstr + have hjmpInstr' : + curInstr + (pre ++ Instr.jz test (pre.length + (body.codeSize + 2)) :: + (body.compileAt (pre.length + 1) ++ Instr.jmp pre.length :: suffix)) + { pc := pre.length + 1 + body.codeSize, regs := middle } = + Instr.jmp pre.length := by + simpa [Cmd.length_compileAt, Nat.add_assoc, Nat.add_comm, + Nat.add_left_comm] using hjmpInstr + have hjmpHalt : + ¬Halted + (pre ++ Instr.jz test (pre.length + (body.codeSize + 2)) :: + (body.compileAt (pre.length + 1) ++ Instr.jmp pre.length :: suffix)) + { pc := pre.length + 1 + body.codeSize, regs := middle } := by + simp [Halted, hjmpInstr'] + rw [run_succ, logTimeUpto_succ] + simp [Halted, curInstr] + rw [step_jz_nonzero pre _ test _ store htest] + rw [show bodySteps + loopSteps + 1 = bodySteps + (loopSteps + 1) by omega] + rw [run_add, hbodyRun.1] + rw [run_succ] + simp only [if_neg hjmpHalt] + rw [hjmp', hloopRun.1] + rw [logTimeUpto_add _ bodySteps (loopSteps + 1)] + rw [hbodyRun.2.1, hbodyRun.1] + rw [logTimeUpto_succ, if_neg hjmpHalt] + rw [hjmp', hloopRun.2.1] + simp [stepLogCost, hjmpInstr', Instr.logCost] + rw [spaceUpto] + simp [Halted, curInstr] + rw [step_jz_nonzero pre _ test _ store htest] + rw [show bodySteps + loopSteps + 1 = bodySteps + (loopSteps + 1) by omega] + rw [spaceUpto_add _ bodySteps (loopSteps + 1)] + rw [hbodyRun.2.2, hbodyRun.1] + rw [spaceUpto, if_neg hjmpHalt, hjmp', hloopRun.2.2] + have hinitialSpace : store.space ≤ bodySpace := by + have hstart := space_le_spaceUpto + (pre ++ Instr.jz test (pre.length + (body.codeSize + 2)) :: + (body.compileAt (pre.length + 1) ++ Instr.jmp pre.length :: suffix)) + bodySteps { pc := pre.length + 1, regs := store } + rw [hbodyRun.2.2] at hstart + simpa [Store.space, Cfg.space] using hstart + have hmiddleSpace : middle.space ≤ bodySpace := by + have hend := run_space_le_spaceUpto + (pre ++ Instr.jz test (pre.length + (body.codeSize + 2)) :: + (body.compileAt (pre.length + 1) ++ Instr.jmp pre.length :: suffix)) + bodySteps { pc := pre.length + 1, regs := store } + rw [hbodyRun.1, hbodyRun.2.2] at hend + simpa [Store.space, Cfg.space] using hend + constructor + · omega + · change max store.space (max bodySpace (max middle.space loopSpace)) = + max bodySpace loopSpace + rw [max_eq_right (hinitialSpace.trans (le_max_left _ _)), ← max_assoc, + max_eq_left hmiddleSpace] + +end Structured + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Internal/Resources.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Internal/Resources.lean new file mode 100644 index 0000000000..87f060437e --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Internal/Resources.lean @@ -0,0 +1,581 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.Defs +public import Mathlib.Algebra.Order.BigOperators.Group.Finset +public import Mathlib.Algebra.Order.Ring.Nat +public import Mathlib.Data.Nat.Size +public import Mathlib.Tactic.Ring.RingNF + +/-! +# Resource-proof infrastructure for structured RAM programs + +This internal module packages the generic proof obligations that arise when a +structured program is verified against the concrete logarithmic-cost RAM: +finite register envelopes, their induced `finsum` space bounds, and compositional +source executions carrying exact steps with upper bounds on time and space. +-/ + + +@[expose] public section + +namespace Complexity + +namespace RAM + +namespace Structured + +namespace Internal + +/-- A register store fits an index/value envelope. Every nonzero register lies +below `indexBound`, and every stored value is at most `valueBound`. -/ +structure StoreEnvelope (indexBound valueBound : ℕ) (store : Store) : Prop where + index_lt : ∀ index, store index ≠ 0 → index < indexBound + value_le : ∀ index, store index ≤ valueBound + +/-- Enlarging either side of a store envelope preserves the bound. -/ +theorem StoreEnvelope.mono {indexBound valueBound largerIndex largerValue : ℕ} + {store : Store} (hstore : StoreEnvelope indexBound valueBound store) + (hindex : indexBound ≤ largerIndex) (hvalue : valueBound ≤ largerValue) : + StoreEnvelope largerIndex largerValue store where + index_lt index hnonzero := lt_of_lt_of_le (hstore.index_lt index hnonzero) hindex + value_le index := le_trans (hstore.value_le index) hvalue + +/-- A reserved-prefix bit input fits any envelope containing its length register, +input interval, list length, and Boolean values. -/ +theorem Input.bitStoreEnvelope {lengthReg inputBase indexBound valueBound : ℕ} + (bits : List Bool) (hlengthReg : lengthReg < indexBound) + (hinputEnd : inputBase + bits.length ≤ indexBound) + (hlength : bits.length ≤ valueBound) (hone : 1 ≤ valueBound) : + StoreEnvelope indexBound valueBound (Input.bitStore lengthReg inputBase bits) := by + constructor + · intro index hnonzero + simp only [Input.bitStore] at hnonzero + split at hnonzero + · subst index + exact hlengthReg + · rename_i hlengthRegNe + split at hnonzero + · rename_i hbase + split at hnonzero + · rename_i bit hbit + have hoffset : index - inputBase < bits.length := + List.getElem?_eq_some_iff.mp hbit |>.1 + have hrecover : inputBase + (index - inputBase) = index := + Nat.add_sub_of_le hbase + omega + · simp at hnonzero + · simp at hnonzero + · intro index + by_cases hlengthRegEq : index = lengthReg + · simpa [Input.bitStore, hlengthRegEq] using hlength + · rw [Input.bitStore, if_neg hlengthRegEq] + by_cases hbase : inputBase ≤ index + · rw [if_pos hbase] + cases hlookup : bits[index - inputBase]? with + | none => simp + | some bit => + cases bit + · simp [Input.bitValue] + · simpa [Input.bitValue] using hone + · simp [hbase] + +/-- Logarithmic space occupied by the largest store admitted by an envelope. -/ +def envelopeSpace (indexBound valueBound : ℕ) : ℕ := + indexBound * (bitlen indexBound + bitlen valueBound) + +/-- A store envelope bounds the real finite-sum source-space measure. -/ +theorem StoreEnvelope.space_le {indexBound valueBound : ℕ} {store : Store} + (hstore : StoreEnvelope indexBound valueBound store) : + store.space ≤ envelopeSpace indexBound valueBound := by + rw [Store.space, envelopeSpace, + finsum_eq_finsetSum_of_support_subset (s := Finset.range indexBound)] + · calc + ∑ index ∈ Finset.range indexBound, + (if store index = 0 then 0 else bitlen index + bitlen (store index)) + ≤ ∑ _index ∈ Finset.range indexBound, + (bitlen indexBound + bitlen valueBound) := by + apply Finset.sum_le_sum + intro index hindex + split_ifs with hzero + · simp + · have hindexLe : index ≤ indexBound := by + exact Nat.le_of_lt (Finset.mem_range.mp hindex) + have hindexSize := Nat.size_le_size hindexLe + have hvalueSize := Nat.size_le_size (hstore.value_le index) + simpa [bitlen] using Nat.add_le_add hindexSize hvalueSize + _ = indexBound * (bitlen indexBound + bitlen valueBound) := by simp + · intro index hsupport + by_contra hindex + have hstoreZero : store index = 0 := by + by_contra hnonzero + exact hindex (Finset.mem_range.mpr (hstore.index_lt index hnonzero)) + simp [hstoreZero] at hsupport + +/-- Updating an in-envelope register with an in-envelope value preserves the +store envelope. -/ +theorem StoreEnvelope.update {indexBound valueBound index value : ℕ} + {store : Store} (hstore : StoreEnvelope indexBound valueBound store) + (hindex : index < indexBound) (hvalue : value ≤ valueBound) : + StoreEnvelope indexBound valueBound (Function.update store index value) := by + constructor + · intro candidate hnonzero + by_cases heq : candidate = index + · simpa [heq] using hindex + · exact hstore.index_lt candidate + (by simpa [Function.update_of_ne heq] using hnonzero) + · intro candidate + by_cases heq : candidate = index + · subst candidate + simpa using hvalue + · simpa [Function.update_of_ne heq] using hstore.value_le candidate + +namespace Basic + +/-- Register written by a basic instruction in a given store. The store argument +is relevant only for indirect writes. -/ +@[simp] +def writeIndex : Structured.Basic → Store → ℕ + | .imm dst _, _ | .add dst _ _, _ | .sub dst _ _, _ | .mul dst _ _, _ | + .load dst _, _ => dst + | .store address _, store => store address + +/-- Value written by a basic instruction in a given store. -/ +@[simp] +def writeValue : Structured.Basic → Store → ℕ + | .imm _ value, _ => value + | .add _ left right, store => store left + store right + | .sub _ left right, store => store left - store right + | .mul _ left right, store => store left * store right + | .load _ address, store => store (store address) + | .store _ src, store => store src + +/-- Basic execution is a single functional update, uniformly across direct and +indirect instructions. -/ +theorem exec_eq_update (op : Structured.Basic) (store : Store) : + op.exec store = Function.update store (writeIndex op store) (writeValue op store) := by + cases op <;> rfl + +/-- A concrete straight-line execution stays inside one store envelope at its +initial store and after every instruction. Unlike a uniform preservation +condition, this certificate can use semantic facts about the actual store at +each program point. -/ +def EnvelopeChain (indexBound valueBound : ℕ) : List Structured.Basic → Store → Prop + | [], store => StoreEnvelope indexBound valueBound store + | op :: rest, store => + StoreEnvelope indexBound valueBound store ∧ + EnvelopeChain indexBound valueBound rest (op.exec store) + +theorem EnvelopeChain.append {indexBound valueBound : ℕ} + {first second : List Structured.Basic} {store : Store} + (hfirst : EnvelopeChain indexBound valueBound first store) + (hsecond : EnvelopeChain indexBound valueBound second + (Structured.Basic.execList first store)) : + EnvelopeChain indexBound valueBound (first ++ second) store := by + induction first generalizing store with + | nil => simpa [Structured.Basic.execList] using hsecond + | cons op rest ih => + exact ⟨hfirst.1, ih hfirst.2 hsecond⟩ + +theorem EnvelopeChain.final {indexBound valueBound : ℕ} + {ops : List Structured.Basic} {store : Store} + (hchain : EnvelopeChain indexBound valueBound ops store) : + StoreEnvelope indexBound valueBound (Structured.Basic.execList ops store) := by + induction ops generalizing store with + | nil => exact hchain + | cons op rest ih => exact ih hchain.2 + +end Basic + +/-- A basic instruction preserves an envelope when its destination and written +value fit that envelope. -/ +theorem StoreEnvelope.execBasic {indexBound valueBound : ℕ} + {store : Store} (hstore : StoreEnvelope indexBound valueBound store) + (op : Structured.Basic) (hindex : Basic.writeIndex op store < indexBound) + (hvalue : Basic.writeValue op store ≤ valueBound) : + StoreEnvelope indexBound valueBound (op.exec store) := by + rw [Basic.exec_eq_update] + exact hstore.update hindex hvalue + +/-- A straight-line list of immediate writes preserves a register whose index +does not occur among the destinations. -/ +theorem Basic.execList_imm_apply_of_not_mem (writes : List (ℕ × ℕ)) + (store : Store) (index : ℕ) (hnot : index ∉ writes.map Prod.fst) : + Basic.execList (writes.map fun write => Basic.imm write.1 write.2) store index = + store index := by + induction writes generalizing store with + | nil => rfl + | cons write rest ih => + have hne : index ≠ write.1 := by + simpa using fun heq => hnot (by simp [heq]) + have htail : index ∉ rest.map Prod.fst := by + intro hmem + exact hnot (by simp [hmem]) + rw [List.map_cons, Basic.execList, ih _ htail] + simp [Basic.exec, Function.update_of_ne hne] + +/-- With distinct destinations, a listed immediate write determines the final +value at its destination. -/ +theorem Basic.execList_imm_apply_of_mem (writes : List (ℕ × ℕ)) + (store : Store) (hnodup : (writes.map Prod.fst).Nodup) + {index value : ℕ} (hmem : (index, value) ∈ writes) : + Basic.execList (writes.map fun write => Basic.imm write.1 write.2) store index = + value := by + induction writes generalizing store with + | nil => simp at hmem + | cons write rest ih => + obtain ⟨hhead, htail⟩ := List.nodup_cons.mp hnodup + rw [List.map_cons, Basic.execList] + rcases List.mem_cons.mp hmem with heq | hrest + · subst write + rw [Basic.execList_imm_apply_of_not_mem rest] + · simp [Basic.exec] + · simpa using hhead + · exact ih (store := (Basic.imm write.1 write.2).exec store) htail hrest + +/-- A one-bit cushion over the width of the envelope's largest value. -/ +def valueWidth (valueBound : ℕ) : ℕ := bitlen valueBound + 1 + +theorem bitlen_le_valueWidth {valueBound value : ℕ} (hvalue : value ≤ valueBound) : + bitlen value ≤ valueWidth valueBound := by + have hsize := Nat.size_le_size hvalue + simpa [bitlen, valueWidth] using le_trans hsize (Nat.le_add_right _ _) + +theorem one_le_valueWidth (valueBound : ℕ) : 1 ≤ valueWidth valueBound := by + simp [valueWidth] + +/-- Any basic instruction whose pre- and post-stores fit the same envelope has +logarithmic cost at most four times the envelope value width. -/ +theorem Basic.logCost_le_four_valueWidth {indexBound valueBound : ℕ} + (op : Basic) (store : Store) + (hstore : StoreEnvelope indexBound valueBound store) + (hnext : StoreEnvelope indexBound valueBound (op.exec store)) : + op.logCost store ≤ 4 * valueWidth valueBound := by + have hone := one_le_valueWidth valueBound + cases op with + | imm dst value => + have hvalue : value ≤ valueBound := by + simpa [Basic.exec] using hnext.value_le dst + have hvalueWidth := bitlen_le_valueWidth hvalue + simp only [Basic.logCost] + omega + | add dst left right => + have hleftWidth := bitlen_le_valueWidth (hstore.value_le left) + have hrightWidth := bitlen_le_valueWidth (hstore.value_le right) + have hresult : store left + store right ≤ valueBound := by + simpa [Basic.exec] using hnext.value_le dst + have hresultWidth := bitlen_le_valueWidth hresult + simp only [Basic.logCost] + omega + | sub dst left right => + have hleftWidth := bitlen_le_valueWidth (hstore.value_le left) + have hrightWidth := bitlen_le_valueWidth (hstore.value_le right) + simp only [Basic.logCost] + omega + | mul dst left right => + have hleftWidth := bitlen_le_valueWidth (hstore.value_le left) + have hrightWidth := bitlen_le_valueWidth (hstore.value_le right) + have hresult : store left * store right ≤ valueBound := by + simpa [Basic.exec] using hnext.value_le dst + have hresultWidth := bitlen_le_valueWidth hresult + simp only [Basic.logCost] + omega + | load dst address => + have haddressWidth := bitlen_le_valueWidth (hstore.value_le address) + have hvalueWidth := bitlen_le_valueWidth (hstore.value_le (store address)) + simp only [Basic.logCost] + omega + | store address src => + have haddressWidth := bitlen_le_valueWidth (hstore.value_le address) + have hsourceWidth := bitlen_le_valueWidth (hstore.value_le src) + simp only [Basic.logCost] + omega + +/-- A source execution with an exact transition count and upper bounds on its +logarithmic cost and peak space. -/ +def MeasuredRuns (cmd : Cmd) (initial final : Store) + (steps costBound spaceLimit : ℕ) : Prop := + ∃ cost space, Exec cmd initial final steps cost space ∧ + cost ≤ costBound ∧ space ≤ spaceLimit + +/-- A straight-line basic block always has an exact source execution. This +certificate deliberately leaves cost and space existential, allowing semantic +proofs to proceed before a client chooses a resource envelope. -/ +theorem exec_basics_exists (ops : List Basic) (initial : Store) : + ∃ cost space, + Exec (Cmd.basics ops) initial (Basic.execList ops initial) + ops.length cost space := by + induction ops generalizing initial with + | nil => + exact ⟨0, initial.space, by + simpa only [Cmd.basics, List.map_nil, Cmd.seqList, Basic.execList, + List.length_nil] using Exec.skip initial⟩ + | cons op rest ih => + cases rest with + | nil => + exact ⟨op.logCost initial, + max initial.space (op.exec initial).space, by + simpa [Cmd.basics, Basic.execList] using Exec.basic op initial⟩ + | cons next tail => + obtain ⟨cost, space, hrest⟩ := ih (initial := op.exec initial) + refine ⟨op.logCost initial + cost, + max (max initial.space (op.exec initial).space) space, ?_⟩ + have hrun := Exec.seq (Exec.basic op initial) hrest + convert hrun using 1 + all_goals simp + all_goals omega + +namespace MeasuredRuns + +theorem skipEnvelope {indexBound valueBound : ℕ} {store : Store} + (hstore : StoreEnvelope indexBound valueBound store) : + MeasuredRuns Cmd.skip store store 0 0 (envelopeSpace indexBound valueBound) := by + exact ⟨0, store.space, Exec.skip store, le_rfl, hstore.space_le⟩ + +theorem basicEnvelope {indexBound valueBound : ℕ} (op : Basic) (store : Store) + (hstore : StoreEnvelope indexBound valueBound store) + (hnext : StoreEnvelope indexBound valueBound (op.exec store)) : + MeasuredRuns (.basic op) store (op.exec store) 1 (4 * valueWidth valueBound) + (envelopeSpace indexBound valueBound) := by + exact ⟨op.logCost store, max store.space (op.exec store).space, + Exec.basic op store, Basic.logCost_le_four_valueWidth op store hstore hnext, + max_le hstore.space_le hnext.space_le⟩ + +theorem seq {first second : Cmd} {initial middle final : Store} + {firstSteps secondSteps firstCost secondCost spaceLimit : ℕ} + (hfirst : MeasuredRuns first initial middle firstSteps firstCost spaceLimit) + (hsecond : MeasuredRuns second middle final secondSteps secondCost spaceLimit) : + MeasuredRuns (.seq first second) initial final (firstSteps + secondSteps) + (firstCost + secondCost) spaceLimit := by + obtain ⟨cost₁, space₁, hexec₁, hcost₁, hspace₁⟩ := hfirst + obtain ⟨cost₂, space₂, hexec₂, hcost₂, hspace₂⟩ := hsecond + exact ⟨cost₁ + cost₂, max space₁ space₂, Exec.seq hexec₁ hexec₂, + Nat.add_le_add hcost₁ hcost₂, max_le hspace₁ hspace₂⟩ + +/-- A straight-line list of basic instructions inherits uniform resource bounds +when every listed instruction preserves the chosen store envelope. -/ +theorem basicsEnvelope {indexBound valueBound : ℕ} (ops : List Basic) + (initial : Store) (hinitial : StoreEnvelope indexBound valueBound initial) + (hpreserve : ∀ op, op ∈ ops → ∀ store, + StoreEnvelope indexBound valueBound store → + StoreEnvelope indexBound valueBound (op.exec store)) : + MeasuredRuns (Cmd.basics ops) initial (Basic.execList ops initial) + ops.length (4 * ops.length * valueWidth valueBound) + (envelopeSpace indexBound valueBound) ∧ + StoreEnvelope indexBound valueBound (Basic.execList ops initial) := by + induction ops generalizing initial with + | nil => + exact ⟨by simpa [Cmd.basics, Basic.execList] using skipEnvelope hinitial, + hinitial⟩ + | cons op rest ih => + have hnext := hpreserve op (by simp) initial hinitial + have hfirst := basicEnvelope op initial hinitial hnext + cases rest with + | nil => + exact ⟨by simpa [Cmd.basics, Basic.execList] using hfirst, hnext⟩ + | cons next tail => + obtain ⟨hrest, hfinal⟩ := ih (initial := op.exec initial) hnext (by + intro candidate hcandidate store hstore + exact hpreserve candidate (by simp [hcandidate]) store hstore) + have hrun := hfirst.seq hrest + refine ⟨?_, hfinal⟩ + · change MeasuredRuns (.seq (.basic op) (Cmd.basics (next :: tail))) + initial (Basic.execList (next :: tail) (op.exec initial)) + (tail.length + 2) (4 * (tail.length + 2) * valueWidth valueBound) + (envelopeSpace indexBound valueBound) + convert hrun using 1 + all_goals simp + all_goals ring + +/-- A concrete per-program-point envelope chain yields the same exact-step, +uniform-cost certificate as a globally uniform preservation proof. -/ +theorem basicsEnvelopeChain {indexBound valueBound : ℕ} (ops : List Basic) + (initial : Store) (hchain : Basic.EnvelopeChain indexBound valueBound ops initial) : + MeasuredRuns (Cmd.basics ops) initial (Basic.execList ops initial) + ops.length (4 * ops.length * valueWidth valueBound) + (envelopeSpace indexBound valueBound) ∧ + StoreEnvelope indexBound valueBound (Basic.execList ops initial) := by + induction ops generalizing initial with + | nil => + exact ⟨by simpa [Cmd.basics, Basic.execList] using skipEnvelope hchain, + hchain⟩ + | cons op rest ih => + have hinitial := hchain.1 + have htail := hchain.2 + have hnext : StoreEnvelope indexBound valueBound (op.exec initial) := by + cases rest with + | nil => exact htail + | cons next tail => exact htail.1 + have hfirst := basicEnvelope op initial hinitial hnext + cases rest with + | nil => + exact ⟨by simpa [Cmd.basics, Basic.execList] using hfirst, hnext⟩ + | cons next tail => + obtain ⟨hrest, hfinal⟩ := + ih (initial := op.exec initial) htail + have hrun := hfirst.seq hrest + refine ⟨?_, hfinal⟩ + change MeasuredRuns (.seq (.basic op) (Cmd.basics (next :: tail))) + initial (Basic.execList (next :: tail) (op.exec initial)) + (tail.length + 2) (4 * (tail.length + 2) * valueWidth valueBound) + (envelopeSpace indexBound valueBound) + convert hrun using 1 + all_goals simp + all_goals ring + +theorem weakenCost {cmd : Cmd} {initial final : Store} + {steps costBound largerBound spaceLimit : ℕ} + (hrun : MeasuredRuns cmd initial final steps costBound spaceLimit) + (hle : costBound ≤ largerBound) : + MeasuredRuns cmd initial final steps largerBound spaceLimit := by + obtain ⟨cost, space, hexec, hcost, hspace⟩ := hrun + exact ⟨cost, space, hexec, le_trans hcost hle, hspace⟩ + +theorem weakenSpace {cmd : Cmd} {initial final : Store} + {steps costBound spaceLimit largerLimit : ℕ} + (hrun : MeasuredRuns cmd initial final steps costBound spaceLimit) + (hle : spaceLimit ≤ largerLimit) : + MeasuredRuns cmd initial final steps costBound largerLimit := by + obtain ⟨cost, space, hexec, hcost, hspace⟩ := hrun + exact ⟨cost, space, hexec, hcost, le_trans hspace hle⟩ + +theorem weaken {cmd : Cmd} {initial final : Store} + {steps costBound largerCost spaceLimit largerSpace : ℕ} + (hrun : MeasuredRuns cmd initial final steps costBound spaceLimit) + (hcost : costBound ≤ largerCost) (hspace : spaceLimit ≤ largerSpace) : + MeasuredRuns cmd initial final steps largerCost largerSpace := + (hrun.weakenCost hcost).weakenSpace hspace + +theorem ifZeroEnvelope {indexBound valueBound test : ℕ} {onZero onNonzero : Cmd} + {initial final : Store} {steps costBound : ℕ} + (htest : initial test = 0) + (hstore : StoreEnvelope indexBound valueBound initial) + (hbranch : MeasuredRuns onZero initial final steps costBound + (envelopeSpace indexBound valueBound)) : + MeasuredRuns (.ifZero test onZero onNonzero) initial final (steps + 1) + (valueWidth valueBound + costBound) (envelopeSpace indexBound valueBound) := by + obtain ⟨cost, space, hexec, hcost, hspace⟩ := hbranch + refine ⟨bitlen (initial test) + 1 + cost, max initial.space space, + Exec.ifZero htest hexec, ?_, max_le hstore.space_le hspace⟩ + rw [htest] + have hone := one_le_valueWidth valueBound + simp only [bitlen, Nat.size_zero, zero_add] + omega + +theorem ifNonzeroEnvelope {indexBound valueBound test : ℕ} {onZero onNonzero : Cmd} + {initial final : Store} {steps costBound : ℕ} + (htest : initial test ≠ 0) + (hstore : StoreEnvelope indexBound valueBound initial) + (hbranch : MeasuredRuns onNonzero initial final steps costBound + (envelopeSpace indexBound valueBound)) : + MeasuredRuns (.ifZero test onZero onNonzero) initial final (steps + 2) + (3 * valueWidth valueBound + costBound) + (envelopeSpace indexBound valueBound) := by + obtain ⟨cost, space, hexec, hcost, hspace⟩ := hbranch + refine ⟨bitlen (initial test) + 1 + cost + 1, max initial.space space, + Exec.ifNonzero htest hexec, ?_, max_le hstore.space_le hspace⟩ + have htestWidth := bitlen_le_valueWidth (hstore.value_le test) + have hone := one_le_valueWidth valueBound + omega + +theorem whileZeroEnvelope {indexBound valueBound test : ℕ} {body : Cmd} + {store : Store} (htest : store test = 0) + (hstore : StoreEnvelope indexBound valueBound store) : + MeasuredRuns (.whileNonzero test body) store store 1 (valueWidth valueBound) + (envelopeSpace indexBound valueBound) := by + refine ⟨bitlen (store test) + 1, store.space, Exec.whileZero htest, ?_, + hstore.space_le⟩ + rw [htest] + simpa [bitlen] using one_le_valueWidth valueBound + +theorem whileNonzeroEnvelope {indexBound valueBound test : ℕ} {body : Cmd} + {initial middle final : Store} + {bodySteps loopSteps bodyCost loopCost : ℕ} + (htest : initial test ≠ 0) + (hstore : StoreEnvelope indexBound valueBound initial) + (hbody : MeasuredRuns body initial middle bodySteps bodyCost + (envelopeSpace indexBound valueBound)) + (hloop : MeasuredRuns (.whileNonzero test body) middle final loopSteps loopCost + (envelopeSpace indexBound valueBound)) : + MeasuredRuns (.whileNonzero test body) initial final + (bodySteps + loopSteps + 2) + (3 * valueWidth valueBound + bodyCost + loopCost) + (envelopeSpace indexBound valueBound) := by + obtain ⟨bodyActualCost, bodySpace, hbodyExec, hbodyCost, hbodySpace⟩ := hbody + obtain ⟨loopActualCost, loopSpace, hloopExec, hloopCost, hloopSpace⟩ := hloop + refine ⟨bitlen (initial test) + 1 + bodyActualCost + 1 + loopActualCost, + max bodySpace loopSpace, Exec.whileNonzero htest hbodyExec hloopExec, ?_, + max_le hbodySpace hloopSpace⟩ + have htestWidth := bitlen_le_valueWidth (hstore.value_le test) + have hone := one_le_valueWidth valueBound + omega + +/-- Exact source transition count obtained by iterating bodies with the given +per-element step count. Each nonempty iteration also pays two loop-control +transitions, and the final zero test pays one. -/ +def whileFoldSteps {α : Type*} (bodySteps : α → ℕ) : List α → ℕ + | [] => 1 + | item :: rest => bodySteps item + whileFoldSteps bodySteps rest + 2 + +/-- Compositional cost bound for a list-indexed loop. Each nonempty iteration +pays three envelope widths for its nonzero test and back edge; the final zero +test pays one envelope width. -/ +def whileFoldCost {α : Type*} (width : ℕ) (bodyCost : α → ℕ) : List α → ℕ + | [] => width + | item :: rest => 3 * width + bodyCost item + whileFoldCost width bodyCost rest + +/-- Verify a structured loop by folding an abstract state over a logical input +list. The client supplies only its invariant, one body certificate, and the +zero/nonzero interpretations of the test register; run stitching and resource +accounting are generic. -/ +theorem whileFoldEnvelope {α σ : Type*} {indexBound valueBound test : ℕ} + {body : Cmd} (Inv : List α → σ → Store → Prop) + (advance : σ → α → σ) (bodySteps bodyCost : α → ℕ) + (hstore : ∀ (items : List α) (state : σ) (store : Store), + Inv items state store → StoreEnvelope indexBound valueBound store) + (hnil : ∀ (state : σ) (store : Store), + Inv [] state store → store test = 0) + (hcons : ∀ (item : α) (rest : List α) (state : σ) (store : Store), + Inv (item :: rest) state store → store test ≠ 0) + (hbody : ∀ (item : α) (rest : List α) (state : σ) (store : Store), + Inv (item :: rest) state store → + ∃ next, + MeasuredRuns body store next (bodySteps item) (bodyCost item) + (envelopeSpace indexBound valueBound) ∧ + Inv rest (advance state item) next) + {items : List α} {state : σ} {initial : Store} + (hinv : Inv items state initial) : + ∃ final, + MeasuredRuns (.whileNonzero test body) initial final + (whileFoldSteps bodySteps items) + (whileFoldCost (valueWidth valueBound) bodyCost items) + (envelopeSpace indexBound valueBound) ∧ + Inv [] (items.foldl advance state) final := by + induction items generalizing state initial with + | nil => + exact ⟨initial, + MeasuredRuns.whileZeroEnvelope (hnil state initial hinv) + (hstore [] state initial hinv), hinv⟩ + | cons item rest ih => + obtain ⟨middle, hrun, hnext⟩ := hbody item rest state initial hinv + obtain ⟨final, hloop, hfinal⟩ := ih hnext + refine ⟨final, ?_, ?_⟩ + · simpa [whileFoldSteps, whileFoldCost] using + MeasuredRuns.whileNonzeroEnvelope + (hcons item rest state initial hinv) + (hstore (item :: rest) state initial hinv) hrun hloop + · simpa using hfinal + +end MeasuredRuns + +end Internal + +end Structured + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/LastBit.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/LastBit.lean new file mode 100644 index 0000000000..f5a68451ae --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/LastBit.lean @@ -0,0 +1,90 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.LastBit.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.Scanner +public import LeanPool.BeyondBethe.Complexitylib.Languages.LastBit + +/-! +# Verified structured RAM last-bit scanner + +The typed scanner compiler supplies the implementation, exact execution proof, +and resource bounds. This module adds only agreement with the existing +`Language.lastBitZero` and `Language.lastBitOne` specifications. +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace Structured + +namespace LastBit + +/-- The three-state last-bit scanner takes exactly `18 + 9n` transitions. -/ +@[simp] theorem stepCount_eq (target : Bool) (inputLength : ℕ) : + stepCount target inputLength = 18 + 9 * inputLength := by + rfl + +/-- Source correctness and explicit resource bounds for the last-bit scanner. -/ +theorem program_performance (target : Bool) (bits : List Bool) : + ∃ final cost space, + Exec (program target) (inputStore target bits) final + (stepCount target bits.length) cost space ∧ + cost ≤ timeBound target bits.length ∧ + space ≤ spaceBound target bits.length ∧ + final verdictReg = Input.bitValue (decide (bits.getLast? = some target)) := by + simpa [spec, lastBit_fold_eq_getLast?] using + Scanner.typed_program_performance (spec target) bits + +/-- End-to-end compiled performance and language correctness. -/ +theorem compiled_performance (target : Bool) (bits : List Bool) : + ∃ final cost space, + Exec (program target) (inputStore target bits) final + (stepCount target bits.length) cost space ∧ + run (compiled target) (stepCount target bits.length) + { pc := 0, regs := inputStore target bits } = + { pc := (program target).codeSize, regs := final } ∧ + Halted (compiled target) + (run (compiled target) (stepCount target bits.length) + { pc := 0, regs := inputStore target bits }) ∧ + logTimeUpto (compiled target) (stepCount target bits.length) + { pc := 0, regs := inputStore target bits } ≤ timeBound target bits.length ∧ + spaceUpto (compiled target) (stepCount target bits.length) + { pc := 0, regs := inputStore target bits } ≤ spaceBound target bits.length ∧ + ((run (compiled target) (stepCount target bits.length) + { pc := 0, regs := inputStore target bits }).regs verdictReg = 1 ↔ + bits.getLast? = some target) := by + obtain ⟨final, cost, space, hexec, hrun, hhalt, htime, hspace, hresult⟩ := + Scanner.typed_compiled_performance (spec target) bits + refine ⟨final, cost, space, hexec, hrun, hhalt, htime, hspace, ?_⟩ + rw [show (run (compiled target) (stepCount target bits.length) + { pc := 0, regs := inputStore target bits }).regs verdictReg = + Input.bitValue (decide (bits.getLast? = some target)) by + simpa [spec, lastBit_fold_eq_getLast?] using hresult] + simp [Input.bitValue] + +/-- The explicit time budget is quasilinear. -/ +theorem timeBound_bigO_quasilinear (target : Bool) : + timeBound target =O quasilinearBound target := + Scanner.typed_timeBound_bigO_quasilinear (spec target) + +/-- The explicit peak-space budget is quasilinear. -/ +theorem spaceBound_bigO_quasilinear (target : Bool) : + spaceBound target =O quasilinearBound target := + Scanner.typed_spaceBound_bigO_quasilinear (spec target) + +end LastBit + +end Structured + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/LastBit/Defs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/LastBit/Defs.lean new file mode 100644 index 0000000000..5bcf5358c3 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/LastBit/Defs.lean @@ -0,0 +1,72 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.Scanner.Defs + +/-! +# Structured RAM last-bit scanner — definitions + +This is a second consumer of the typed finite-state scanner API. Its state is +`Option Bool`: `none` before any input and `some bit` thereafter. +-/ + + +@[expose] public section + +namespace Complexity + +namespace RAM + +namespace Structured + +namespace LastBit + +instance optionBoolFinEnum : FinEnum (Option Bool) := + FinEnum.ofList [none, some false, some true] (by + intro state + rcases state with _ | bit + · simp + · cases bit <;> simp) + +/-- Typed scanner for whether the final input bit equals `target`. -/ +def spec (target : Bool) : Scanner.TypedSpec (Option Bool) where + initial := none + step := fun _ bit => some bit + accept := fun state => decide (state = some target) + +/-- Final verdict register inherited from the scanner layout. -/ +abbrev verdictReg : ℕ := Scanner.lengthReg + +/-- Reserved-prefix input store for the last-bit scanner. -/ +abbrev inputStore (target : Bool) : List Bool → Store := (spec target).inputStore + +/-- Structured RAM last-bit program. -/ +abbrev program (target : Bool) : Cmd := (spec target).program + +/-- Concrete compiled RAM last-bit program. -/ +abbrev compiled (target : Bool) : Program := (spec target).compiled + +/-- Exact compiled transition count. -/ +abbrev stepCount (target : Bool) : ℕ → ℕ := (spec target).stepCount + +/-- Explicit logarithmic-time budget. -/ +abbrev timeBound (target : Bool) : ℕ → ℕ := (spec target).timeBound + +/-- Explicit peak-space budget. -/ +abbrev spaceBound (target : Bool) : ℕ → ℕ := (spec target).spaceBound + +/-- Shifted quasilinear comparison function. -/ +abbrev quasilinearBound (target : Bool) : ℕ → ℕ := + (spec target).quasilinearBound + +end LastBit + +end Structured + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/PairValidate.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/PairValidate.lean new file mode 100644 index 0000000000..de8a819c29 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/PairValidate.lean @@ -0,0 +1,111 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.PairValidate.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.PairValidate.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.Scanner +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.PairValidate + +/-! +# Verified structured RAM pair validator + +This table-driven RAM program reimplements the same five-state automaton as +`TM.pairValidateTM`. Its proof gives an exact transition count, explicit +logarithmic-cost time and peak-space budgets, and an end-to-end compiled-RAM +correctness theorem for the canonical pair-encoding language. +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace Structured + +namespace PairValidate + +/-- The five-state pair validator takes exactly `24 + 9n` transitions. -/ +@[simp] theorem stepCount_eq (inputLength : ℕ) : + stepCount inputLength = 24 + 9 * inputLength := by + rfl + +/-- Source-level correctness and explicit resource bounds. -/ +theorem program_performance (bits : List Bool) : + ∃ final cost space, + Exec program (inputStore bits) final (stepCount bits.length) cost space ∧ + cost ≤ timeBound bits.length ∧ space ≤ spaceBound bits.length ∧ + final lengthReg = Input.bitValue + (TM.pairValidateAccept (bits.foldl TM.pairValidateStep .next)) := + program_measured_internal bits + +/-- End-to-end compiled performance and language correctness. -/ +theorem compiled_performance (bits : List Bool) : + ∃ final cost space, + Exec program (inputStore bits) final (stepCount bits.length) cost space ∧ + run compiled (stepCount bits.length) { pc := 0, regs := inputStore bits } = + { pc := program.codeSize, regs := final } ∧ + Halted compiled + (run compiled (stepCount bits.length) { pc := 0, regs := inputStore bits }) ∧ + logTimeUpto compiled (stepCount bits.length) + { pc := 0, regs := inputStore bits } ≤ timeBound bits.length ∧ + spaceUpto compiled (stepCount bits.length) + { pc := 0, regs := inputStore bits } ≤ spaceBound bits.length ∧ + (run compiled (stepCount bits.length) { pc := 0, regs := inputStore bits }).regs + lengthReg = Input.bitValue + (TM.pairValidateAccept (bits.foldl TM.pairValidateStep .next)) ∧ + ((run compiled (stepCount bits.length) + { pc := 0, regs := inputStore bits }).regs lengthReg = 1 ↔ + bits ∈ validPairEncoding) := by + obtain ⟨final, cost, space, hexec, hcost, hspace, hresult⟩ := + program_performance bits + have hcompiled := Exec.compile_correct hexec + refine ⟨final, cost, space, hexec, hcompiled.1, Exec.compile_halted hexec, + ?_, ?_, ?_, ?_⟩ + · change logTimeUpto program.compile (stepCount bits.length) + { pc := 0, regs := inputStore bits } ≤ timeBound bits.length + rw [hcompiled.2.1] + exact hcost + · change spaceUpto program.compile (stepCount bits.length) + { pc := 0, regs := inputStore bits } ≤ spaceBound bits.length + rw [hcompiled.2.2] + exact hspace + · change (run program.compile (stepCount bits.length) + { pc := 0, regs := inputStore bits }).regs lengthReg = _ + rw [hcompiled.1] + exact hresult + · change (run program.compile (stepCount bits.length) + { pc := 0, regs := inputStore bits }).regs lengthReg = 1 ↔ _ + rw [hcompiled.1] + change final lengthReg = 1 ↔ _ + rw [hresult] + calc + Input.bitValue (TM.pairValidateAccept + (bits.foldl TM.pairValidateStep .next)) = 1 ↔ + TM.pairValidateAccept (bits.foldl TM.pairValidateStep .next) = true := by + cases TM.pairValidateAccept (bits.foldl TM.pairValidateStep .next) <;> + simp [Input.bitValue] + _ ↔ (unpair? bits).isSome = true := + TM.pairValidateAccept_fold_eq_true_iff bits + _ ↔ bits ∈ validPairEncoding := Iff.rfl + +/-- The explicit logarithmic-cost time budget is quasilinear. -/ +theorem timeBound_bigO_quasilinear : timeBound =O quasilinearBound := by + exact Scanner.timeBound_bigO_quasilinear spec + +/-- The explicit peak-space budget is quasilinear. -/ +theorem spaceBound_bigO_quasilinear : spaceBound =O quasilinearBound := by + exact Scanner.spaceBound_bigO_quasilinear spec + +end PairValidate + +end Structured + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/PairValidate/Defs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/PairValidate/Defs.lean new file mode 100644 index 0000000000..f1bd17841c --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/PairValidate/Defs.lean @@ -0,0 +1,69 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.Scanner.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.PairValidate.Defs + +/-! +# Structured RAM pair-encoding validator — definitions + +The benchmark-specific implementation is just a numeric presentation of the +same five-state automaton used by `TM.pairValidateTM`. The generic scanner +compiler supplies the table-driven structured RAM program. +-/ + + +@[expose] public section + +namespace Complexity + +namespace RAM + +namespace Structured + +namespace PairValidate + +instance : FinEnum TM.PairValidateState := + FinEnum.ofList [.next, .afterZero, .afterOne, .suffix, .invalid] (by + intro state + cases state <;> simp) + +/-- Pair validation as a typed finite-state scanner specification. -/ +def typedSpec : Scanner.TypedSpec TM.PairValidateState where + initial := .next + step := TM.pairValidateStep + accept := TM.pairValidateAccept + +/-- Numeric lowering used by the generic structured RAM compiler. -/ +abbrev spec : Scanner.Spec := typedSpec.numeric + +/-- Final verdict register inherited from the scanner layout. -/ +abbrev lengthReg : ℕ := Scanner.lengthReg +/-- First input register for the five-state instance. -/ +abbrev inputBase : ℕ := Scanner.inputBase spec +/-- Reserved-prefix input store for pair validation. -/ +abbrev inputStore : List Bool → Store := Scanner.inputStore spec +/-- Structured RAM pair-validator program. -/ +abbrev program : Cmd := Scanner.program spec +/-- Concrete compiled RAM pair-validator program. -/ +abbrev compiled : Program := Scanner.compiled spec +/-- Exact compiled transition count. -/ +abbrev stepCount : ℕ → ℕ := Scanner.stepCount spec +/-- Explicit logarithmic-time budget. -/ +abbrev timeBound : ℕ → ℕ := Scanner.timeBound spec +/-- Explicit peak-space budget. -/ +abbrev spaceBound : ℕ → ℕ := Scanner.spaceBound spec +/-- Shifted quasilinear comparison function. -/ +abbrev quasilinearBound : ℕ → ℕ := Scanner.quasilinearBound spec + +end PairValidate + +end Structured + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/PairValidate/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/PairValidate/Internal.lean new file mode 100644 index 0000000000..983a91a797 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/PairValidate/Internal.lean @@ -0,0 +1,43 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.PairValidate.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.Scanner.Internal + +/-! +# Structured RAM pair validator — proof internals + +The benchmark supplies only its typed scanner specification. State encoding, +execution, correctness, and resource proofs are all in the generic scanner layer. +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace Structured + +namespace PairValidate + +theorem program_measured_internal (bits : List Bool) : + ∃ final cost space, + Exec program (inputStore bits) final (stepCount bits.length) cost space ∧ + cost ≤ timeBound bits.length ∧ space ≤ spaceBound bits.length ∧ + final lengthReg = Input.bitValue + (TM.pairValidateAccept (bits.foldl TM.pairValidateStep .next)) := by + exact Scanner.typed_program_measured_internal typedSpec bits + +end PairValidate + +end Structured + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Scanner.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Scanner.lean new file mode 100644 index 0000000000..5accfb0d93 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Scanner.lean @@ -0,0 +1,182 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.Scanner.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.Scanner.Internal +public import LeanPool.BeyondBethe.Complexitylib.Asymptotics +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured + +/-! +# Verified finite-state structured RAM scanners + +This module exposes a reusable compiler from numeric finite automata to the +structured RAM frontend. Its correctness theorem includes an exact transition +count and explicit logarithmic-time and peak-space bounds, all transferred to +the concrete compiled RAM. +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace Structured + +namespace Scanner + +/-- Source-level correctness and explicit resource bounds. -/ +theorem program_performance (spec : Spec) (bits : List Bool) : + ∃ final cost space, + Exec (program spec) (inputStore spec bits) final + (stepCount spec bits.length) cost space ∧ + cost ≤ timeBound spec bits.length ∧ + space ≤ spaceBound spec bits.length ∧ + final lengthReg = Input.bitValue + (spec.accept (bits.foldl spec.step spec.initial)) := + program_measured_internal spec bits + +/-- End-to-end performance and correctness of the compiled concrete RAM. -/ +theorem compiled_performance (spec : Spec) (bits : List Bool) : + ∃ final cost space, + Exec (program spec) (inputStore spec bits) final + (stepCount spec bits.length) cost space ∧ + run (compiled spec) (stepCount spec bits.length) + { pc := 0, regs := inputStore spec bits } = + { pc := (program spec).codeSize, regs := final } ∧ + Halted (compiled spec) + (run (compiled spec) (stepCount spec bits.length) + { pc := 0, regs := inputStore spec bits }) ∧ + logTimeUpto (compiled spec) (stepCount spec bits.length) + { pc := 0, regs := inputStore spec bits } ≤ timeBound spec bits.length ∧ + spaceUpto (compiled spec) (stepCount spec bits.length) + { pc := 0, regs := inputStore spec bits } ≤ spaceBound spec bits.length ∧ + (run (compiled spec) (stepCount spec bits.length) + { pc := 0, regs := inputStore spec bits }).regs lengthReg = + Input.bitValue (spec.accept (bits.foldl spec.step spec.initial)) := by + obtain ⟨final, cost, space, hexec, hcost, hspace, hresult⟩ := + program_performance spec bits + have hcompiled := Exec.compile_correct hexec + refine ⟨final, cost, space, hexec, hcompiled.1, Exec.compile_halted hexec, + ?_, ?_, ?_⟩ + · change logTimeUpto (program spec).compile (stepCount spec bits.length) + { pc := 0, regs := inputStore spec bits } ≤ timeBound spec bits.length + rw [hcompiled.2.1] + exact hcost + · change spaceUpto (program spec).compile (stepCount spec bits.length) + { pc := 0, regs := inputStore spec bits } ≤ spaceBound spec bits.length + rw [hcompiled.2.2] + exact hspace + · change (run (program spec).compile (stepCount spec bits.length) + { pc := 0, regs := inputStore spec bits }).regs lengthReg = _ + rw [hcompiled.1] + exact hresult + +/-- Source-level correctness and resource bounds for a typed scanner. -/ +theorem typed_program_performance {State : Type} [FinEnum State] + (typed : TypedSpec State) (bits : List Bool) : + ∃ final cost space, + Exec typed.program (typed.inputStore bits) final + (typed.stepCount bits.length) cost space ∧ + cost ≤ typed.timeBound bits.length ∧ + space ≤ typed.spaceBound bits.length ∧ + final lengthReg = Input.bitValue + (typed.accept (bits.foldl typed.step typed.initial)) := + typed_program_measured_internal typed bits + +/-- End-to-end concrete RAM correctness for a typed scanner. -/ +theorem typed_compiled_performance {State : Type} [FinEnum State] + (typed : TypedSpec State) (bits : List Bool) : + ∃ final cost space, + Exec typed.program (typed.inputStore bits) final + (typed.stepCount bits.length) cost space ∧ + run typed.compiled (typed.stepCount bits.length) + { pc := 0, regs := typed.inputStore bits } = + { pc := typed.program.codeSize, regs := final } ∧ + Halted typed.compiled + (run typed.compiled (typed.stepCount bits.length) + { pc := 0, regs := typed.inputStore bits }) ∧ + logTimeUpto typed.compiled (typed.stepCount bits.length) + { pc := 0, regs := typed.inputStore bits } ≤ typed.timeBound bits.length ∧ + spaceUpto typed.compiled (typed.stepCount bits.length) + { pc := 0, regs := typed.inputStore bits } ≤ typed.spaceBound bits.length ∧ + (run typed.compiled (typed.stepCount bits.length) + { pc := 0, regs := typed.inputStore bits }).regs lengthReg = + Input.bitValue (typed.accept (bits.foldl typed.step typed.initial)) := by + obtain ⟨final, cost, space, hexec, hcost, hspace, hresult⟩ := + typed_program_performance typed bits + have hcompiled := Exec.compile_correct hexec + refine ⟨final, cost, space, hexec, hcompiled.1, Exec.compile_halted hexec, + ?_, ?_, ?_⟩ + · change logTimeUpto typed.program.compile (typed.stepCount bits.length) + { pc := 0, regs := typed.inputStore bits } ≤ typed.timeBound bits.length + rw [hcompiled.2.1] + exact hcost + · change spaceUpto typed.program.compile (typed.stepCount bits.length) + { pc := 0, regs := typed.inputStore bits } ≤ typed.spaceBound bits.length + rw [hcompiled.2.2] + exact hspace + · change (run typed.program.compile (typed.stepCount bits.length) + { pc := 0, regs := typed.inputStore bits }).regs lengthReg = _ + rw [hcompiled.1] + exact hresult + +/-- For each fixed scanner, its explicit time budget is quasilinear. -/ +theorem timeBound_bigO_quasilinear (spec : Spec) : + timeBound spec =O quasilinearBound spec := by + have hpoint : ∀ n, timeBound spec n ≤ 64 * quasilinearBound spec n := by + intro n + simp only [timeBound, quasilinearBound] + have hshift : n + spec.stateCount + 1 ≤ n + inputBase spec := by + simp [inputBase, transitionBase] + omega + calc + 64 * (n + spec.stateCount + 1) * + (bitlen (n + inputBase spec) + 1) + = 64 * ((n + spec.stateCount + 1) * + (bitlen (n + inputBase spec) + 1)) := by ring + _ ≤ 64 * ((n + inputBase spec) * + (bitlen (n + inputBase spec) + 1)) := + Nat.mul_le_mul_left 64 + (Nat.mul_le_mul_right (bitlen (n + inputBase spec) + 1) hshift) + exact (BigO.of_le hpoint).trans + (BigO.const_mul_left 64 (BigO.refl (quasilinearBound spec))) + +/-- For each fixed scanner, its explicit peak-space budget is quasilinear. -/ +theorem spaceBound_bigO_quasilinear (spec : Spec) : + spaceBound spec =O quasilinearBound spec := by + have hpoint : ∀ n, spaceBound spec n ≤ 2 * quasilinearBound spec n := by + intro n + simp only [spaceBound, quasilinearBound] + calc + (n + inputBase spec) * (2 * bitlen (n + inputBase spec)) + = 2 * ((n + inputBase spec) * bitlen (n + inputBase spec)) := by ring + _ ≤ 2 * ((n + inputBase spec) * + (bitlen (n + inputBase spec) + 1)) := + Nat.mul_le_mul_left 2 + (Nat.mul_le_mul_left (n + inputBase spec) (by omega)) + exact (BigO.of_le hpoint).trans + (BigO.const_mul_left 2 (BigO.refl (quasilinearBound spec))) + +/-- The typed scanner's explicit time budget is quasilinear. -/ +theorem typed_timeBound_bigO_quasilinear {State : Type} [FinEnum State] + (typed : TypedSpec State) : typed.timeBound =O typed.quasilinearBound := + timeBound_bigO_quasilinear typed.numeric + +/-- The typed scanner's explicit peak-space budget is quasilinear. -/ +theorem typed_spaceBound_bigO_quasilinear {State : Type} [FinEnum State] + (typed : TypedSpec State) : typed.spaceBound =O typed.quasilinearBound := + spaceBound_bigO_quasilinear typed.numeric + +end Scanner + +end Structured + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Scanner/Defs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Scanner/Defs.lean new file mode 100644 index 0000000000..90d416efd8 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Scanner/Defs.lean @@ -0,0 +1,250 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.Defs +public import Mathlib.Data.FinEnum + +/-! +# Finite-state scanners for the structured RAM frontend + +`Scanner.Spec` describes a finite automaton using numeric state codes. The +compiler below realizes it as a table-driven structured RAM program. The state +bound and transition-closure fields are the complete trusted interface needed by +the generic correctness and resource proof. +-/ + + +@[expose] public section + +namespace Complexity + +namespace RAM + +namespace Structured + +namespace Scanner + +/-- A total finite-state Boolean scanner with contiguous numeric state codes. -/ +structure Spec where + /-- Number of valid state codes. -/ + stateCount : ℕ + /-- Initial state code. -/ + initial : ℕ + /-- The initial code is valid. -/ + initial_lt : initial < stateCount + /-- One state transition. -/ + step : ℕ → Bool → ℕ + /-- Transitions preserve valid state codes. -/ + step_lt : ∀ state, state < stateCount → ∀ bit, step state bit < stateCount + /-- Final Boolean verdict. -/ + accept : ℕ → Bool + +/-- A scanner specification over an explicitly enumerable Lean state type. + +`FinEnum` retains a concrete equivalence with an initial segment of natural +numbers, so lowering remains executable while consumers reason using their +domain-specific state type. -/ +structure TypedSpec (State : Type) [FinEnum State] where + /-- Initial typed state. -/ + initial : State + /-- One typed state transition. -/ + step : State → Bool → State + /-- Final Boolean verdict. -/ + accept : State → Bool + +namespace TypedSpec + +variable {State : Type} [FinEnum State] + +/-- Numeric state code chosen by the explicit enumeration. -/ +def code (state : State) : ℕ := (FinEnum.equiv state).val + +/-- Lower a typed scanner to the verified numeric scanner interface. -/ +def numeric (typed : TypedSpec State) : Spec where + stateCount := FinEnum.card State + initial := code typed.initial + initial_lt := (FinEnum.equiv typed.initial).isLt + step := fun state bit => + if hstate : state < FinEnum.card State then + code (typed.step (FinEnum.equiv.symm ⟨state, hstate⟩) bit) + else 0 + step_lt := by + intro state hstate bit + simp [hstate, code] + accept := fun state => + if hstate : state < FinEnum.card State then + typed.accept (FinEnum.equiv.symm ⟨state, hstate⟩) + else false + +end TypedSpec + +/-- Remaining input length and final verdict register. -/ +def lengthReg : ℕ := 0 +/-- Current numeric automaton state. -/ +def stateReg : ℕ := 1 +/-- Address of the next input bit. -/ +def pointerReg : ℕ := 2 +/-- Constant-one register. -/ +def oneReg : ℕ := 3 +/-- Current input bit. -/ +def bitReg : ℕ := 4 +/-- Scratch address used for table lookups. -/ +def addressReg : ℕ := 5 +/-- Constant-two register. -/ +def twoReg : ℕ := 6 +/-- Register containing the transition-table base address. -/ +def transitionBaseReg : ℕ := 7 +/-- Register containing the verdict-table base address. -/ +def acceptBaseReg : ℕ := 8 +/-- First transition-table register. -/ +def transitionBase : ℕ := 9 + +/-- First verdict-table register. -/ +def acceptBase (spec : Spec) : ℕ := + transitionBase + 2 * spec.stateCount + +/-- First input register. -/ +def inputBase (spec : Spec) : ℕ := + transitionBase + 3 * spec.stateCount + +/-- Address of one transition-table entry. -/ +def transitionAddress (state : ℕ) (bit : Bool) : ℕ := + transitionBase + 2 * state + Input.bitValue bit + +/-- Address of one verdict-table entry. -/ +def acceptAddress (spec : Spec) (state : ℕ) : ℕ := + acceptBase spec + state + +/-- Reserved-prefix input layout for a scanner. -/ +def inputStore (spec : Spec) (bits : List Bool) : Store := + Input.bitStore lengthReg (inputBase spec) bits + +/-- The six fixed setup destinations below the tables. -/ +def fixedSetupIndices : List ℕ := + [stateReg, pointerReg, oneReg, twoReg, transitionBaseReg, acceptBaseReg] + +/-- Every table destination, in increasing order. -/ +def tableIndices (spec : Spec) : List ℕ := + List.range' transitionBase (3 * spec.stateCount) + +/-- Every setup destination. -/ +def setupIndices (spec : Spec) : List ℕ := + fixedSetupIndices ++ tableIndices spec + +/-- Value written to one setup destination. -/ +def setupValue (spec : Spec) (index : ℕ) : ℕ := + if index = stateReg then spec.initial + else if index = pointerReg then inputBase spec + else if index = oneReg then 1 + else if index = twoReg then 2 + else if index = transitionBaseReg then transitionBase + else if index = acceptBaseReg then acceptBase spec + else if index < acceptBase spec then + let offset := index - transitionBase + spec.step (offset / 2) (offset % 2 = 1) + else + Input.bitValue (spec.accept (index - acceptBase spec)) + +/-- Constant and table writes performed before scanning. -/ +def setupWrites (spec : Spec) : List (ℕ × ℕ) := + (setupIndices spec).map fun index => (index, setupValue spec index) + +/-- Straight-line setup instruction list. -/ +def setupOps (spec : Spec) : List Basic := + (setupWrites spec).map fun write => .imm write.1 write.2 + +/-- Initialize constants and transition/verdict tables. -/ +def setup (spec : Spec) : Cmd := Cmd.basics (setupOps spec) + +/-- Seven-instruction scanner body, independent of the particular automaton. -/ +def bodyOps : List Basic := + [.load bitReg pointerReg, + .mul addressReg stateReg twoReg, + .add addressReg addressReg bitReg, + .add addressReg addressReg transitionBaseReg, + .load stateReg addressReg, + .add pointerReg pointerReg oneReg, + .sub lengthReg lengthReg oneReg] + +/-- Consume one input bit and update the encoded automaton state. -/ +def body : Cmd := Cmd.basics bodyOps + +/-- Scan all input bits. -/ +def mainLoop : Cmd := Cmd.whileNonzero lengthReg body + +/-- Two-instruction final verdict lookup. -/ +def finalizeOps : List Basic := + [.add addressReg stateReg acceptBaseReg, .load lengthReg addressReg] + +/-- Write the final verdict to `R₀`. -/ +def finalize : Cmd := Cmd.basics finalizeOps + +/-- Complete structured scanner. -/ +def program (spec : Spec) : Cmd := + Cmd.seq (setup spec) (.seq mainLoop finalize) + +/-- Concrete compiled RAM scanner. -/ +def compiled (spec : Spec) : Program := (program spec).compile + +/-- Exact compiled transition count. -/ +def stepCount (spec : Spec) (inputLength : ℕ) : ℕ := + 9 + 3 * spec.stateCount + 9 * inputLength + +/-- Explicit logarithmic-cost time budget. -/ +def timeBound (spec : Spec) (inputLength : ℕ) : ℕ := + 64 * (inputLength + spec.stateCount + 1) * + (bitlen (inputLength + inputBase spec) + 1) + +/-- Explicit peak-space budget. -/ +def spaceBound (spec : Spec) (inputLength : ℕ) : ℕ := + (inputLength + inputBase spec) * + (2 * bitlen (inputLength + inputBase spec)) + +/-- Shifted quasilinear comparison function. -/ +def quasilinearBound (spec : Spec) (inputLength : ℕ) : ℕ := + (inputLength + inputBase spec) * + (bitlen (inputLength + inputBase spec) + 1) + +namespace TypedSpec + +variable {State : Type} [FinEnum State] + +/-- Input store for a typed scanner. -/ +abbrev inputStore (typed : TypedSpec State) : List Bool → Store := + Scanner.inputStore typed.numeric + +/-- Structured RAM program generated from a typed scanner. -/ +abbrev program (typed : TypedSpec State) : Cmd := Scanner.program typed.numeric + +/-- Concrete RAM program generated from a typed scanner. -/ +abbrev compiled (typed : TypedSpec State) : Program := Scanner.compiled typed.numeric + +/-- Exact transition count for a typed scanner. -/ +abbrev stepCount (typed : TypedSpec State) : ℕ → ℕ := + Scanner.stepCount typed.numeric + +/-- Explicit logarithmic-time budget for a typed scanner. -/ +abbrev timeBound (typed : TypedSpec State) : ℕ → ℕ := + Scanner.timeBound typed.numeric + +/-- Explicit peak-space budget for a typed scanner. -/ +abbrev spaceBound (typed : TypedSpec State) : ℕ → ℕ := + Scanner.spaceBound typed.numeric + +/-- Shifted quasilinear comparison function for a typed scanner. -/ +abbrev quasilinearBound (typed : TypedSpec State) : ℕ → ℕ := + Scanner.quasilinearBound typed.numeric + +end TypedSpec + +end Scanner + +end Structured + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Scanner/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Scanner/Internal.lean new file mode 100644 index 0000000000..f49499925d --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Scanner/Internal.lean @@ -0,0 +1,857 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.Internal.Resources +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.Scanner.Defs +public import Std.Tactic.BVDecide.Normalize.BitVec + +/-! +# Finite-state structured RAM scanners — proof internals +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace Structured + +namespace Scanner + +open Internal + +private abbrev StoreBound (spec : Spec) (inputLength : ℕ) (store : Store) : Prop := + StoreEnvelope (inputLength + inputBase spec) (inputLength + inputBase spec) store + +private abbrev width (spec : Spec) (inputLength : ℕ) : ℕ := + valueWidth (inputLength + inputBase spec) + +private abbrev resourceSpace (spec : Spec) (inputLength : ℕ) : ℕ := + envelopeSpace (inputLength + inputBase spec) (inputLength + inputBase spec) + +private theorem envelopeSpace_eq_spaceBound (spec : Spec) (inputLength : ℕ) : + resourceSpace spec inputLength = spaceBound spec inputLength := by + simp [resourceSpace, envelopeSpace, spaceBound, two_mul] + +private theorem inputStore_bound (spec : Spec) (bits : List Bool) : + StoreBound spec bits.length (inputStore spec bits) := by + apply Internal.Input.bitStoreEnvelope + · simp [lengthReg, inputBase, transitionBase] + · simp [inputBase, transitionBase] + omega + · exact Nat.le_add_right _ _ + · have hinitial := spec.initial_lt + have hpositive : 0 < spec.stateCount := by omega + simp [inputBase, transitionBase] + omega + +private theorem setupIndices_nodup (spec : Spec) : + (setupIndices spec).Nodup := by + rw [setupIndices, List.nodup_append'] + refine ⟨by decide, List.nodup_range', ?_⟩ + rw [List.disjoint_left] + intro index hfixed htable + have hlt : index < transitionBase := by + simp [fixedSetupIndices, stateReg, pointerReg, oneReg, twoReg, transitionBaseReg, + acceptBaseReg] at hfixed + simp [transitionBase] + omega + have hle : transitionBase ≤ index := + List.left_le_of_mem_range' htable + omega + +private theorem setupWrites_nodup (spec : Spec) : + ((setupWrites spec).map Prod.fst).Nodup := by + have hmap : (setupWrites spec).map Prod.fst = setupIndices spec := by + simp [setupWrites, List.map_map, Function.comp_def] + rw [hmap] + exact setupIndices_nodup spec + +private theorem setupOps_length (spec : Spec) : + (setupOps spec).length = 6 + 3 * spec.stateCount := by + simp [setupOps, setupWrites, setupIndices, fixedSetupIndices, tableIndices] + ring + +private theorem transitionAddress_mem (spec : Spec) (state : ℕ) + (hstate : state < spec.stateCount) (bit : Bool) : + transitionAddress state bit ∈ setupIndices spec := by + rw [setupIndices, List.mem_append] + right + rw [tableIndices] + apply List.mem_range'.mpr + refine ⟨2 * state + Input.bitValue bit, ?_, ?_⟩ + · cases bit <;> simp [Input.bitValue] + all_goals omega + · simp [transitionAddress] + omega + +private theorem acceptAddress_mem (spec : Spec) (state : ℕ) + (hstate : state < spec.stateCount) : + acceptAddress spec state ∈ setupIndices spec := by + rw [setupIndices, List.mem_append] + right + rw [tableIndices] + apply List.mem_range'.mpr + refine ⟨2 * spec.stateCount + state, by omega, ?_⟩ + simp [acceptAddress, acceptBase] + omega + +private theorem setupValue_transition (spec : Spec) (state : ℕ) + (hstate : state < spec.stateCount) (bit : Bool) : + setupValue spec (transitionAddress state bit) = spec.step state bit := by + have hlt : transitionAddress state bit < acceptBase spec := by + cases bit <;> simp [transitionAddress, Input.bitValue, acceptBase] + all_goals omega + have hdiv : (transitionAddress state bit - transitionBase) / 2 = state := by + cases bit <;> simp [transitionAddress, Input.bitValue, transitionBase] + all_goals omega + have hbit : decide ((transitionAddress state bit - transitionBase) % 2 = 1) = bit := by + cases bit <;> simp [transitionAddress, Input.bitValue, transitionBase] + all_goals omega + unfold setupValue + split_ifs with hs hp ho ht htr ha + · simp [transitionAddress, Input.bitValue, stateReg, transitionBase] at hs + omega + · simp [transitionAddress, Input.bitValue, pointerReg, transitionBase] at hp + omega + · simp [transitionAddress, Input.bitValue, oneReg, transitionBase] at ho + omega + · simp [transitionAddress, Input.bitValue, twoReg, transitionBase] at ht + omega + · simp [transitionAddress, Input.bitValue, transitionBaseReg, transitionBase] at htr + omega + · simp [transitionAddress, Input.bitValue, acceptBaseReg, transitionBase] at ha + omega + · dsimp only + rw [hdiv, hbit] + +private theorem setupValue_accept (spec : Spec) (state : ℕ) + (hstate : state < spec.stateCount) : + setupValue spec (acceptAddress spec state) = Input.bitValue (spec.accept state) := by + have hnotLt : ¬acceptAddress spec state < acceptBase spec := by + simp [acceptAddress] + have hdiff : acceptAddress spec state - acceptBase spec = state := by + simp [acceptAddress] + unfold setupValue + split_ifs with hs hp ho ht htr ha + · simp [acceptAddress, acceptBase, stateReg, transitionBase] at hs + omega + · simp [acceptAddress, acceptBase, pointerReg, transitionBase] at hp + omega + · simp [acceptAddress, acceptBase, oneReg, transitionBase] at ho + omega + · simp [acceptAddress, acceptBase, twoReg, transitionBase] at ht + omega + · simp [acceptAddress, acceptBase, transitionBaseReg, transitionBase] at htr + omega + · simp [acceptAddress, acceptBase, acceptBaseReg, transitionBase] at ha + omega + · rw [hdiff] + +private theorem setupValue_le_inputBase (spec : Spec) (index : ℕ) + (hindex : index ∈ setupIndices spec) : + setupValue spec index ≤ inputBase spec := by + rcases List.mem_append.mp hindex with hfixed | htable + · simp [fixedSetupIndices] at hfixed + rcases hfixed with rfl | rfl | rfl | rfl | rfl | rfl + all_goals have hinitial := spec.initial_lt + all_goals simp [setupValue, stateReg, pointerReg, oneReg, twoReg, transitionBaseReg, + acceptBaseReg, inputBase, acceptBase, transitionBase] <;> omega + · obtain ⟨offset, hoffset, rfl⟩ := List.mem_range'.mp htable + unfold setupValue + split_ifs with hs hp ho ht htr ha htableLt + · simp [stateReg, transitionBase] at hs + omega + · simp [pointerReg, transitionBase] at hp + omega + · simp [oneReg, transitionBase] at ho + omega + · simp [twoReg, transitionBase] at ht + omega + · simp [transitionBaseReg, transitionBase] at htr + omega + · simp [acceptBaseReg, transitionBase] at ha + omega + · have hstate : offset / 2 < spec.stateCount := by + simp [acceptBase, transitionBase] at htableLt + omega + have hbase : spec.stateCount ≤ inputBase spec := by + simp [inputBase, transitionBase] + omega + dsimp only + simp only [Nat.add_sub_cancel_left, one_mul] + change spec.step (offset / 2) (decide (offset % 2 = 1)) ≤ inputBase spec + exact (spec.step_lt (offset / 2) hstate _).le.trans hbase + · have hpositive : 1 ≤ inputBase spec := by + have hinitial := spec.initial_lt + simp [inputBase, transitionBase] + omega + simp only [Input.bitValue] + split <;> omega + +private def setupStore (spec : Spec) (bits : List Bool) : Store := + Basic.execList (setupOps spec) (inputStore spec bits) + +private theorem setupStore_apply (spec : Spec) (bits : List Bool) (index : ℕ) + (hindex : index ∈ setupIndices spec) : + setupStore spec bits index = setupValue spec index := by + apply Basic.execList_imm_apply_of_mem (setupWrites spec) (inputStore spec bits) + (setupWrites_nodup spec) + simp [setupWrites, hindex] + +private theorem setupStore_unwritten (spec : Spec) (bits : List Bool) (index : ℕ) + (hindex : index ∉ setupIndices spec) : + setupStore spec bits index = inputStore spec bits index := by + apply Basic.execList_imm_apply_of_not_mem (setupWrites spec) + simpa [setupWrites, List.map_map, Function.comp_def] using hindex + +private theorem setupStore_high (spec : Spec) (bits : List Bool) (index : ℕ) + (hindex : inputBase spec ≤ index) : + setupStore spec bits index = inputStore spec bits index := by + apply Basic.execList_imm_apply_of_not_mem (setupWrites spec) + simp only [setupWrites, List.map_map] + intro hmem + have hsetup : index ∈ setupIndices spec := by simpa using hmem + rcases List.mem_append.mp hsetup with hfixed | htable + · have hlt : index < inputBase spec := by + simp [fixedSetupIndices, stateReg, pointerReg, oneReg, twoReg, transitionBaseReg, + acceptBaseReg] at hfixed + simp [inputBase, transitionBase] + omega + omega + · rcases List.mem_range'.mp htable with ⟨offset, hoffset, heq⟩ + have hlt : index < inputBase spec := by + calc + index = transitionBase + 1 * offset := heq + _ < inputBase spec := by + simp [inputBase, transitionBase] + omega + omega + +private theorem setup_measured (spec : Spec) (bits : List Bool) : + MeasuredRuns (setup spec) (inputStore spec bits) (setupStore spec bits) + (setupOps spec).length + (4 * (setupOps spec).length * width spec bits.length) + (resourceSpace spec bits.length) ∧ + StoreBound spec bits.length (setupStore spec bits) := by + have hinitial := inputStore_bound spec bits + have hpreserve : ∀ op, op ∈ setupOps spec → ∀ current, + StoreBound spec bits.length current → + StoreBound spec bits.length (op.exec current) := by + intro op hop current hcurrent + rw [setupOps] at hop + obtain ⟨write, hwrite, rfl⟩ := List.mem_map.mp hop + rw [setupWrites] at hwrite + obtain ⟨index, hindex, rfl⟩ := List.mem_map.mp hwrite + apply hcurrent.execBasic (.imm index (setupValue spec index)) + · have hlt : index < inputBase spec := by + rcases List.mem_append.mp hindex with hfixed | htable + · simp [fixedSetupIndices, stateReg, pointerReg, oneReg, twoReg, transitionBaseReg, + acceptBaseReg] at hfixed + simp [inputBase, transitionBase] + omega + · rcases List.mem_range'.mp htable with ⟨offset, hoffset, heq⟩ + calc + index = transitionBase + 1 * offset := heq + _ < inputBase spec := by + simp [inputBase, transitionBase] + omega + exact hlt.trans_le (Nat.le_add_left _ bits.length) + · exact (setupValue_le_inputBase spec index hindex).trans + (Nat.le_add_left _ bits.length) + simpa [setup, setupStore] using + MeasuredRuns.basicsEnvelope (setupOps spec) (inputStore spec bits) + hinitial hpreserve + +private structure LoopInv (spec : Spec) (inputLength : ℕ) + (remaining : List Bool) (state consumed : ℕ) (store : Store) : Prop where + total_eq : consumed + remaining.length = inputLength + state_lt : state < spec.stateCount + store_bound : StoreBound spec inputLength store + length_eq : store lengthReg = remaining.length + state_eq : store stateReg = state + pointer_eq : store pointerReg = inputBase spec + consumed + one_eq : store oneReg = 1 + two_eq : store twoReg = 2 + transitionBase_eq : store transitionBaseReg = transitionBase + acceptBase_eq : store acceptBaseReg = acceptBase spec + transition_eq : ∀ automaton, automaton < spec.stateCount → ∀ bit, + store (transitionAddress automaton bit) = spec.step automaton bit + accept_eq : ∀ automaton, automaton < spec.stateCount → + store (acceptAddress spec automaton) = Input.bitValue (spec.accept automaton) + input_eq : ∀ offset, + store (inputBase spec + consumed + offset) = + match remaining[offset]? with + | some bit => Input.bitValue bit + | none => 0 + +private theorem setup_inv (spec : Spec) (bits : List Bool) + (hbound : StoreBound spec bits.length (setupStore spec bits)) : + LoopInv spec bits.length bits spec.initial 0 (setupStore spec bits) := by + constructor + · simp + · exact spec.initial_lt + · exact hbound + · rw [setupStore_unwritten] + · simp [inputStore, Input.bitStore, lengthReg] + · simp [setupIndices, fixedSetupIndices, tableIndices, lengthReg, stateReg, + pointerReg, oneReg, twoReg, transitionBaseReg, acceptBaseReg, + transitionBase] + · rw [setupStore_apply spec bits stateReg] + · simp [setupValue, stateReg] + · simp [setupIndices, fixedSetupIndices] + · rw [setupStore_apply spec bits pointerReg] + · simp [setupValue, stateReg, pointerReg] + · simp [setupIndices, fixedSetupIndices] + · rw [setupStore_apply spec bits oneReg] + · simp [setupValue, stateReg, pointerReg, oneReg] + · simp [setupIndices, fixedSetupIndices] + · rw [setupStore_apply spec bits twoReg] + · simp [setupValue, stateReg, pointerReg, oneReg, twoReg] + · simp [setupIndices, fixedSetupIndices] + · rw [setupStore_apply spec bits transitionBaseReg] + · simp [setupValue, stateReg, pointerReg, oneReg, twoReg, transitionBaseReg] + · simp [setupIndices, fixedSetupIndices] + · rw [setupStore_apply spec bits acceptBaseReg] + · simp [setupValue, stateReg, pointerReg, oneReg, twoReg, transitionBaseReg, + acceptBaseReg] + · simp [setupIndices, fixedSetupIndices] + · intro state hstate bit + rw [setupStore_apply spec bits _ (transitionAddress_mem spec state hstate bit)] + exact setupValue_transition spec state hstate bit + · intro state hstate + rw [setupStore_apply spec bits _ (acceptAddress_mem spec state hstate)] + exact setupValue_accept spec state hstate + · intro offset + rw [setupStore_high spec bits _ (by omega)] + simp [inputStore, Input.bitStore, Input.bitValue, lengthReg, inputBase] + rfl + +private def loaded (store : Store) : Store := + (Basic.load bitReg pointerReg).exec store + +private def multiplied (store : Store) : Store := + (Basic.mul addressReg stateReg twoReg).exec (loaded store) + +private def indexed (store : Store) : Store := + (Basic.add addressReg addressReg bitReg).exec (multiplied store) + +private def addressed (store : Store) : Store := + (Basic.add addressReg addressReg transitionBaseReg).exec (indexed store) + +private def transitioned (store : Store) : Store := + (Basic.load stateReg addressReg).exec (addressed store) + +private def advanced (store : Store) : Store := + (Basic.add pointerReg pointerReg oneReg).exec (transitioned store) + +private def iterated (store : Store) : Store := + (Basic.sub lengthReg lengthReg oneReg).exec (advanced store) + +private theorem addressed_high (store : Store) (index : ℕ) + (hindex : transitionBase ≤ index) : + addressed store index = store index := by + have hbit : index ≠ bitReg := by + simp [transitionBase, bitReg] at hindex ⊢ + omega + have haddress : index ≠ addressReg := by + simp [transitionBase, addressReg] at hindex ⊢ + omega + simp [addressed, indexed, multiplied, loaded, Basic.exec, + Function.update_of_ne, hbit, haddress] + +private theorem iterated_high (store : Store) (index : ℕ) + (hindex : twoReg ≤ index) : + iterated store index = store index := by + have hlength : index ≠ lengthReg := by + simp [twoReg, lengthReg] at hindex ⊢ + omega + have hstate : index ≠ stateReg := by + simp [twoReg, stateReg] at hindex ⊢ + omega + have hpointer : index ≠ pointerReg := by + simp [twoReg, pointerReg] at hindex ⊢ + omega + have hbit : index ≠ bitReg := by + simp [twoReg, bitReg] at hindex ⊢ + omega + have haddress : index ≠ addressReg := by + simp [twoReg, addressReg] at hindex ⊢ + omega + simp [iterated, advanced, transitioned, addressed, indexed, multiplied, + loaded, Basic.exec, Function.update_of_ne, hlength, hstate, hpointer, + hbit, haddress] + +private theorem body_measured {spec : Spec} {bit : Bool} {rest : List Bool} + {inputLength consumed state : ℕ} {store : Store} + (hinv : LoopInv spec inputLength (bit :: rest) state consumed store) : + MeasuredRuns body store (iterated store) 7 (28 * width spec inputLength) + (resourceSpace spec inputLength) ∧ + StoreBound spec inputLength (iterated store) := by + have hstateLt := hinv.state_lt + have hpositive := spec.initial_lt + have htotal := hinv.total_eq + have hloaded : StoreBound spec inputLength (loaded store) := by + apply hinv.store_bound.execBasic (.load bitReg pointerReg) + · simp [bitReg, inputBase, transitionBase] + omega + · simpa [Internal.Basic.writeValue] using + hinv.store_bound.value_le (store pointerReg) + have hloadedBit : loaded store bitReg = Input.bitValue bit := by + simp only [loaded, Basic.exec, Function.update_self] + rw [hinv.pointer_eq] + simpa using hinv.input_eq 0 + have hloadedState : loaded store stateReg = state := by + have hne : stateReg ≠ bitReg := by decide + simpa [loaded, Basic.exec, stateReg, bitReg, Function.update_of_ne hne] using + hinv.state_eq + have hloadedTwo : loaded store twoReg = 2 := by + have hne : twoReg ≠ bitReg := by decide + simpa [loaded, Basic.exec, twoReg, bitReg, Function.update_of_ne hne] using + hinv.two_eq + have hmultiplied : StoreBound spec inputLength (multiplied store) := by + apply hloaded.execBasic (.mul addressReg stateReg twoReg) + · simp [addressReg, inputBase, transitionBase] + omega + · change loaded store stateReg * loaded store twoReg ≤ + inputLength + inputBase spec + rw [hloadedState, hloadedTwo] + simp [inputBase, transitionBase] + omega + have hmultipliedAddress : multiplied store addressReg = 2 * state := by + simp [multiplied, Basic.exec, hloadedState, hloadedTwo] + ring + have hmultipliedBit : multiplied store bitReg = Input.bitValue bit := by + have hne : bitReg ≠ addressReg := by decide + simpa [multiplied, Basic.exec, Function.update_of_ne hne] using hloadedBit + have hindexed : StoreBound spec inputLength (indexed store) := by + apply hmultiplied.execBasic (.add addressReg addressReg bitReg) + · simp [addressReg, inputBase, transitionBase] + omega + · change multiplied store addressReg + multiplied store bitReg ≤ + inputLength + inputBase spec + rw [hmultipliedAddress, hmultipliedBit] + cases bit <;> simp [Input.bitValue, inputBase, transitionBase] <;> omega + have hindexedAddress : indexed store addressReg = + 2 * state + Input.bitValue bit := by + simp [indexed, Basic.exec, hmultipliedAddress, hmultipliedBit] + have hindexedBase : indexed store transitionBaseReg = transitionBase := by + have hne : transitionBaseReg ≠ addressReg := by decide + simpa [indexed, multiplied, loaded, Basic.exec, Function.update_of_ne hne, + transitionBaseReg, addressReg, bitReg] using hinv.transitionBase_eq + have haddressed : StoreBound spec inputLength (addressed store) := by + apply hindexed.execBasic (.add addressReg addressReg transitionBaseReg) + · simp [addressReg, inputBase, transitionBase] + omega + · change indexed store addressReg + indexed store transitionBaseReg ≤ + inputLength + inputBase spec + rw [hindexedAddress, hindexedBase] + cases bit <;> simp [Input.bitValue, inputBase, transitionBase] <;> omega + have haddressedAddress : addressed store addressReg = + transitionAddress state bit := by + simp [addressed, Basic.exec, hindexedAddress, hindexedBase, + transitionAddress] + ring + have htransitioned : StoreBound spec inputLength (transitioned store) := by + apply haddressed.execBasic (.load stateReg addressReg) + · simp [stateReg, inputBase, transitionBase] + omega + · change addressed store (addressed store addressReg) ≤ + inputLength + inputBase spec + rw [haddressedAddress, addressed_high store _ (by + simp [transitionAddress, transitionBase] + omega)] + rw [hinv.transition_eq state hinv.state_lt bit] + have hstep := spec.step_lt state hinv.state_lt bit + simp [inputBase, transitionBase] + omega + have htransitionedPointer : transitioned store pointerReg = + inputBase spec + consumed := by + have hne : pointerReg ≠ stateReg := by decide + simpa [transitioned, addressed, indexed, multiplied, loaded, Basic.exec, + pointerReg, stateReg, addressReg, bitReg, Function.update_of_ne hne] using + hinv.pointer_eq + have htransitionedOne : transitioned store oneReg = 1 := by + have hne : oneReg ≠ stateReg := by decide + simpa [transitioned, addressed, indexed, multiplied, loaded, Basic.exec, + oneReg, stateReg, addressReg, bitReg, Function.update_of_ne hne] using + hinv.one_eq + have hadvanced : StoreBound spec inputLength (advanced store) := by + apply htransitioned.execBasic (.add pointerReg pointerReg oneReg) + · simp [pointerReg, inputBase, transitionBase] + omega + · change transitioned store pointerReg + transitioned store oneReg ≤ + inputLength + inputBase spec + rw [htransitionedPointer, htransitionedOne] + have htotal := hinv.total_eq + simp only [List.length_cons] at htotal + omega + have hadvancedLength : advanced store lengthReg = (bit :: rest).length := by + have hlength : store lengthReg = (bit :: rest).length := hinv.length_eq + simpa [advanced, transitioned, addressed, indexed, multiplied, loaded, + Basic.exec, lengthReg, pointerReg, stateReg, addressReg, bitReg] using hlength + have hadvancedOne : advanced store oneReg = 1 := by + simpa [advanced, transitioned, addressed, indexed, multiplied, loaded, + Basic.exec, oneReg, pointerReg, stateReg, addressReg, bitReg] using hinv.one_eq + have hiterated : StoreBound spec inputLength (iterated store) := by + apply hadvanced.execBasic (.sub lengthReg lengthReg oneReg) + · simp [lengthReg, inputBase, transitionBase] + · change advanced store lengthReg - advanced store oneReg ≤ + inputLength + inputBase spec + rw [hadvancedLength, hadvancedOne] + have htotal := hinv.total_eq + omega + have hload := MeasuredRuns.basicEnvelope (.load bitReg pointerReg) store + hinv.store_bound hloaded + have hmul := MeasuredRuns.basicEnvelope (.mul addressReg stateReg twoReg) + (loaded store) hloaded hmultiplied + have hindex := MeasuredRuns.basicEnvelope (.add addressReg addressReg bitReg) + (multiplied store) hmultiplied hindexed + have haddress := MeasuredRuns.basicEnvelope + (.add addressReg addressReg transitionBaseReg) (indexed store) hindexed haddressed + have htransition := MeasuredRuns.basicEnvelope (.load stateReg addressReg) + (addressed store) haddressed htransitioned + have hadvance := MeasuredRuns.basicEnvelope (.add pointerReg pointerReg oneReg) + (transitioned store) htransitioned hadvanced + have hdecrement := MeasuredRuns.basicEnvelope (.sub lengthReg lengthReg oneReg) + (advanced store) hadvanced hiterated + have hrun := hload.seq (hmul.seq + (hindex.seq (haddress.seq (htransition.seq (hadvance.seq hdecrement))))) + constructor + · simp only [body, Cmd.basics, bodyOps, List.map_cons, List.map_nil, Cmd.seqList] + convert hrun using 1 + ring + · exact hiterated + +private theorem addressed_address_of_inv {spec : Spec} {bit : Bool} + {rest : List Bool} {inputLength consumed state : ℕ} {store : Store} + (hinv : LoopInv spec inputLength (bit :: rest) state consumed store) : + addressed store addressReg = transitionAddress state bit := by + have hbit : loaded store bitReg = Input.bitValue bit := by + simp only [loaded, Basic.exec, Function.update_self] + rw [hinv.pointer_eq] + simpa using hinv.input_eq 0 + have hstate : loaded store stateReg = state := by + have hne : stateReg ≠ bitReg := by decide + simpa [loaded, Basic.exec, stateReg, bitReg, Function.update_of_ne hne] using + hinv.state_eq + have htwo : loaded store twoReg = 2 := by + have hne : twoReg ≠ bitReg := by decide + simpa [loaded, Basic.exec, twoReg, bitReg, Function.update_of_ne hne] using + hinv.two_eq + have hbase : indexed store transitionBaseReg = transitionBase := by + have hne : transitionBaseReg ≠ addressReg := by decide + simpa [indexed, multiplied, loaded, Basic.exec, Function.update_of_ne hne, + transitionBaseReg, addressReg, bitReg] using hinv.transitionBase_eq + have hmultipliedAddress : multiplied store addressReg = 2 * state := by + simp [multiplied, Basic.exec, hstate, htwo] + ring + have hmultipliedBit : multiplied store bitReg = Input.bitValue bit := by + have hne : bitReg ≠ addressReg := by decide + simpa [multiplied, Basic.exec, Function.update_of_ne hne] using hbit + have hindexedAddress : indexed store addressReg = + 2 * state + Input.bitValue bit := by + simp [indexed, Basic.exec, hmultipliedAddress, hmultipliedBit] + simp [addressed, Basic.exec, hindexedAddress, hbase, transitionAddress] + ring + +private theorem iterated_state {spec : Spec} {bit : Bool} {rest : List Bool} + {inputLength consumed state : ℕ} {store : Store} + (hinv : LoopInv spec inputLength (bit :: rest) state consumed store) : + iterated store stateReg = spec.step state bit := by + have haddress := addressed_address_of_inv hinv + have htable : addressed store (transitionAddress state bit) = + spec.step state bit := by + rw [addressed_high store _ (by + cases bit <;> simp [transitionAddress, transitionBase, Input.bitValue] + all_goals omega)] + exact hinv.transition_eq state hinv.state_lt bit + simp [iterated, advanced, transitioned, Basic.exec, lengthReg, pointerReg, + stateReg, haddress, htable] + +private theorem iterated_inv {spec : Spec} {bit : Bool} {rest : List Bool} + {inputLength consumed state : ℕ} {store : Store} + (hinv : LoopInv spec inputLength (bit :: rest) state consumed store) : + LoopInv spec inputLength rest (spec.step state bit) (consumed + 1) + (iterated store) := by + constructor + · have htotal := hinv.total_eq + simp only [List.length_cons] at htotal + omega + · exact spec.step_lt state hinv.state_lt bit + · exact (body_measured hinv).2 + · have hlength : store 0 = (bit :: rest).length := by + simpa [lengthReg] using hinv.length_eq + have hone : store 3 = 1 := by simpa [oneReg] using hinv.one_eq + simp [iterated, advanced, transitioned, addressed, indexed, multiplied, + loaded, Basic.exec, lengthReg, pointerReg, stateReg, addressReg, bitReg, + oneReg] + rw [hlength, hone] + simp + · exact iterated_state hinv + · have hpointer : store 2 = inputBase spec + consumed := by + simpa [pointerReg] using hinv.pointer_eq + have hone : store 3 = 1 := by simpa [oneReg] using hinv.one_eq + simp [iterated, advanced, transitioned, addressed, indexed, multiplied, + loaded, Basic.exec, lengthReg, pointerReg, stateReg, addressReg, bitReg, + oneReg] + rw [hpointer, hone] + omega + · simpa [iterated, advanced, transitioned, addressed, indexed, multiplied, + loaded, Basic.exec, lengthReg, pointerReg, stateReg, addressReg, bitReg, + oneReg] using hinv.one_eq + · rw [iterated_high store twoReg (by simp)] + exact hinv.two_eq + · rw [iterated_high store transitionBaseReg (by + simp [twoReg, transitionBaseReg])] + exact hinv.transitionBase_eq + · rw [iterated_high store acceptBaseReg (by simp [twoReg, acceptBaseReg])] + exact hinv.acceptBase_eq + · intro automaton hautomaton value + rw [iterated_high store _ (by + simp [transitionAddress, transitionBase, twoReg] + omega)] + exact hinv.transition_eq automaton hautomaton value + · intro automaton hautomaton + rw [iterated_high store _ (by + simp [acceptAddress, acceptBase, transitionBase, twoReg] + omega)] + exact hinv.accept_eq automaton hautomaton + · intro offset + rw [iterated_high store _ (by + simp [inputBase, transitionBase, twoReg] + omega)] + have hinput := hinv.input_eq (offset + 1) + convert hinput using 1 + all_goals simp [Nat.add_assoc, Nat.add_comm, Nat.add_left_comm] + +private def loopAdvance (spec : Spec) (state : ℕ × ℕ) (bit : Bool) : ℕ × ℕ := + (spec.step state.1 bit, state.2 + 1) + +private theorem foldl_loopAdvance (spec : Spec) (bits : List Bool) + (state consumed : ℕ) : + bits.foldl (loopAdvance spec) (state, consumed) = + (bits.foldl spec.step state, consumed + bits.length) := by + induction bits generalizing state consumed with + | nil => simp + | cons bit rest ih => + simp only [List.foldl_cons, loopAdvance] + rw [ih] + simp + omega + +private theorem whileFoldSteps_eq (bits : List Bool) : + MeasuredRuns.whileFoldSteps (fun _ : Bool => 7) bits = + 1 + 9 * bits.length := by + induction bits with + | nil => simp [MeasuredRuns.whileFoldSteps] + | cons bit rest ih => + rw [MeasuredRuns.whileFoldSteps, ih] + simp + omega + +private theorem whileFoldCost_eq (bits : List Bool) (w : ℕ) : + MeasuredRuns.whileFoldCost w (fun _ : Bool => 28 * w) bits = + (31 * bits.length + 1) * w := by + induction bits with + | nil => simp [MeasuredRuns.whileFoldCost] + | cons bit rest ih => + rw [MeasuredRuns.whileFoldCost, ih] + simp only [List.length_cons] + ring + +private theorem loop_measured {spec : Spec} {remaining : List Bool} + {inputLength consumed state : ℕ} {store : Store} + (hinv : LoopInv spec inputLength remaining state consumed store) : + ∃ final, + MeasuredRuns mainLoop store final (1 + 9 * remaining.length) + ((31 * remaining.length + 1) * width spec inputLength) + (resourceSpace spec inputLength) ∧ + LoopInv spec inputLength [] (remaining.foldl spec.step state) + (consumed + remaining.length) final := by + let bodySteps : Bool → ℕ := fun _ => 7 + let bodyCost : Bool → ℕ := fun _ => 28 * width spec inputLength + have hrun := MeasuredRuns.whileFoldEnvelope + (Inv := fun items foldState current => + LoopInv spec inputLength items foldState.1 foldState.2 current) + (advance := loopAdvance spec) (bodySteps := bodySteps) (bodyCost := bodyCost) + (test := lengthReg) (body := body) + (hstore := by intro _ _ _ h; exact h.store_bound) + (hnil := by intro _ _ h; simpa using h.length_eq) + (hcons := by intro _ _ _ _ h; rw [h.length_eq]; simp) + (hbody := by + intro bit rest foldState current h + exact ⟨iterated current, (body_measured h).1, by + simpa [loopAdvance] using iterated_inv h⟩) + (items := remaining) (state := (state, consumed)) (initial := store) hinv + obtain ⟨final, hloop, hfinal⟩ := hrun + have hsteps : MeasuredRuns.whileFoldSteps bodySteps remaining = + 1 + 9 * remaining.length := by + simpa [bodySteps] using whileFoldSteps_eq remaining + have hcost : MeasuredRuns.whileFoldCost (width spec inputLength) + bodyCost remaining = + (31 * remaining.length + 1) * width spec inputLength := by + simpa [bodyCost] using whileFoldCost_eq remaining (width spec inputLength) + have hstate := foldl_loopAdvance spec remaining state consumed + rw [hstate] at hfinal + refine ⟨final, ?_, hfinal⟩ + simpa [mainLoop, hsteps, hcost] using hloop + +private def finalStore (store : Store) : Store := + Basic.execList finalizeOps store + +private theorem finalize_measured {spec : Spec} {inputLength state : ℕ} + {store : Store} (hinv : LoopInv spec inputLength [] state inputLength store) : + MeasuredRuns finalize store (finalStore store) 2 + (8 * width spec inputLength) (resourceSpace spec inputLength) ∧ + finalStore store lengthReg = Input.bitValue (spec.accept state) := by + let indexed := (Basic.add addressReg stateReg acceptBaseReg).exec store + have hstate : store stateReg = state := hinv.state_eq + have hbase : store acceptBaseReg = acceptBase spec := hinv.acceptBase_eq + have hpositive := spec.initial_lt + have hstateLt := hinv.state_lt + have hindexed : StoreBound spec inputLength indexed := by + apply hinv.store_bound.execBasic (.add addressReg stateReg acceptBaseReg) + · simp [addressReg, inputBase, transitionBase] + omega + · change store stateReg + store acceptBaseReg ≤ + inputLength + inputBase spec + rw [hstate, hbase] + simp [acceptBase, inputBase, transitionBase] + omega + have haddress : indexed addressReg = acceptAddress spec state := by + simp [indexed, Basic.exec, hstate, hbase, acceptAddress] + ring + have htable : indexed (acceptAddress spec state) = + Input.bitValue (spec.accept state) := by + have hne : acceptAddress spec state ≠ addressReg := by + simp [acceptAddress, acceptBase, transitionBase, addressReg] + omega + rw [show indexed (acceptAddress spec state) = + store (acceptAddress spec state) by + simp [indexed, Basic.exec, Function.update_of_ne hne]] + exact hinv.accept_eq state hinv.state_lt + have hfinal : StoreBound spec inputLength (finalStore store) := by + change StoreBound spec inputLength + ((Basic.load lengthReg addressReg).exec indexed) + apply hindexed.execBasic (.load lengthReg addressReg) + · simp [lengthReg, inputBase, transitionBase] + · change indexed (indexed addressReg) ≤ inputLength + inputBase spec + rw [haddress, htable] + cases spec.accept state <;> simp [Input.bitValue, inputBase, transitionBase] + all_goals omega + have hfirst := MeasuredRuns.basicEnvelope + (.add addressReg stateReg acceptBaseReg) store hinv.store_bound hindexed + have hsecond := MeasuredRuns.basicEnvelope (.load lengthReg addressReg) + indexed hindexed hfinal + have hrun := hfirst.seq hsecond + constructor + · simp only [finalize, Cmd.basics, finalizeOps, List.map_cons, List.map_nil, + Cmd.seqList] + convert hrun using 1 + ring + · change ((Basic.load lengthReg addressReg).exec indexed) lengthReg = _ + simp [Basic.exec, haddress, htable] + +theorem program_measured_internal (spec : Spec) (bits : List Bool) : + ∃ final cost space, + Exec (program spec) (inputStore spec bits) final + (stepCount spec bits.length) cost space ∧ + cost ≤ timeBound spec bits.length ∧ + space ≤ spaceBound spec bits.length ∧ + final lengthReg = Input.bitValue + (spec.accept (bits.foldl spec.step spec.initial)) := by + obtain ⟨hsetup, hsetupBound⟩ := setup_measured spec bits + have hsetupInv := setup_inv spec bits hsetupBound + obtain ⟨loopFinal, hloop, hloopInv⟩ := loop_measured hsetupInv + have hloopInv' : LoopInv spec bits.length [] + (bits.foldl spec.step spec.initial) bits.length loopFinal := by + simpa using hloopInv + obtain ⟨hfinalize, hresult⟩ := finalize_measured hloopInv' + have hseq := hsetup.seq (hloop.seq hfinalize) + have hcostLe : + 4 * (setupOps spec).length * width spec bits.length + + ((31 * bits.length + 1) * width spec bits.length + + 8 * width spec bits.length) ≤ timeBound spec bits.length := by + rw [timeBound] + change _ ≤ 64 * (bits.length + spec.stateCount + 1) * width spec bits.length + calc + 4 * (setupOps spec).length * width spec bits.length + + ((31 * bits.length + 1) * width spec bits.length + + 8 * width spec bits.length) + = (31 * bits.length + 12 * spec.stateCount + 33) * + width spec bits.length := by + rw [setupOps_length] + ring + _ ≤ (64 * (bits.length + spec.stateCount + 1)) * + width spec bits.length := + Nat.mul_le_mul_right _ (by omega) + _ = 64 * (bits.length + spec.stateCount + 1) * + width spec bits.length := by ring + have hwide := hseq.weakenCost hcostLe + have hprogram : MeasuredRuns (program spec) (inputStore spec bits) + (finalStore loopFinal) (stepCount spec bits.length) + (timeBound spec bits.length) (resourceSpace spec bits.length) := by + rw [program] + convert hwide using 1 + rw [setupOps_length] + simp [stepCount] + ring + obtain ⟨cost, space, hexec, hcost, hspace⟩ := hprogram + have hspace' : space ≤ spaceBound spec bits.length := by + rw [← envelopeSpace_eq_spaceBound] + exact hspace + exact ⟨finalStore loopFinal, cost, space, hexec, hcost, hspace', hresult⟩ + +private theorem TypedSpec.numeric_step_code {State : Type} [FinEnum State] + (typed : TypedSpec State) (state : State) (bit : Bool) : + typed.numeric.step (TypedSpec.code state) bit = + TypedSpec.code (typed.step state bit) := by + simp [TypedSpec.numeric, TypedSpec.code] + +private theorem TypedSpec.numeric_accept_code {State : Type} [FinEnum State] + (typed : TypedSpec State) (state : State) : + typed.numeric.accept (TypedSpec.code state) = typed.accept state := by + simp [TypedSpec.numeric, TypedSpec.code] + +private theorem TypedSpec.foldl_numeric_step {State : Type} [FinEnum State] + (typed : TypedSpec State) (bits : List Bool) (state : State) : + bits.foldl typed.numeric.step (TypedSpec.code state) = + TypedSpec.code (bits.foldl typed.step state) := by + induction bits generalizing state with + | nil => rfl + | cons bit rest ih => + simp only [List.foldl_cons] + rw [typed.numeric_step_code, ih] + +theorem typed_program_measured_internal {State : Type} [FinEnum State] + (typed : TypedSpec State) (bits : List Bool) : + ∃ final cost space, + Exec (program typed.numeric) (inputStore typed.numeric bits) final + (stepCount typed.numeric bits.length) cost space ∧ + cost ≤ timeBound typed.numeric bits.length ∧ + space ≤ spaceBound typed.numeric bits.length ∧ + final lengthReg = Input.bitValue + (typed.accept (bits.foldl typed.step typed.initial)) := by + obtain ⟨final, cost, space, hexec, hcost, hspace, hresult⟩ := + program_measured_internal typed.numeric bits + refine ⟨final, cost, space, hexec, hcost, hspace, ?_⟩ + change final lengthReg = Input.bitValue + (typed.numeric.accept + (bits.foldl typed.numeric.step (TypedSpec.code typed.initial))) at hresult + rw [typed.foldl_numeric_step, typed.numeric_accept_code] at hresult + exact hresult + +end Scanner + +end Structured + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Switch.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Switch.lean new file mode 100644 index 0000000000..6aa484ba1c --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Switch.lean @@ -0,0 +1,73 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.Switch.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.Switch.Internal + +/-! +# Verified finite numeric switches for structured RAM programs + +The theorem in this module gives exact source step accounting and explicit +logarithmic-cost and peak-space bounds for a finite numeric switch. +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace Structured + +namespace Switch + + +open Internal + +/-- A valid numeric code selects its corresponding branch, without requiring a +resource envelope. This semantic form supports composition before a larger +program chooses a shared cost and space bound. -/ +theorem select_exec {count test one : ℕ} + (branch : Fin count → Cmd) (initial final : Store) + {code branchSteps : ℕ} + (hcode : code < count) (htest : initial test = code) + (hone : initial one = 1) (hne : test ≠ one) + (hbranch : ∃ cost space, + Exec (branch ⟨code, hcode⟩) (cleared initial test) final + branchSteps cost space) : + ∃ cost space, + Exec (select count test one branch) initial final + (stepCount code branchSteps) cost space := + select_exec_internal branch initial final hcode htest hone hne hbranch + +/-- A valid numeric code selects its corresponding branch. The selected branch +starts with the test register cleared, matching the decrementing implementation. +The result carries an exact transition count and envelope-based resource bounds. -/ +theorem select_measured {count test one indexBound valueBound : ℕ} + (branch : Fin count → Cmd) (initial final : Store) + {code branchSteps branchCost : ℕ} + (hcode : code < count) (htest : initial test = code) + (hone : initial one = 1) (hne : test ≠ one) + (htestIndex : test < indexBound) + (hinitial : StoreEnvelope indexBound valueBound initial) + (hbranch : MeasuredRuns (branch ⟨code, hcode⟩) (cleared initial test) + final branchSteps branchCost (envelopeSpace indexBound valueBound)) : + MeasuredRuns (select count test one branch) initial final + (stepCount code branchSteps) + (costBound code branchCost (valueWidth valueBound)) + (envelopeSpace indexBound valueBound) := + select_measured_internal branch initial final hcode htest hone hne + htestIndex hinitial hbranch + +end Switch + +end Structured + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Switch/Compiled.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Switch/Compiled.lean new file mode 100644 index 0000000000..e0eb832b17 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Switch/Compiled.lean @@ -0,0 +1,69 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured + +/-! +# Compilation theorem for finite numeric structured-RAM switches +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace Structured + +namespace Switch + + +open Internal + +/-- End-to-end compilation of a measured finite switch. -/ +theorem select_compiled {count test one indexBound valueBound : ℕ} + (branch : Fin count → Cmd) (initial final : Store) + {code branchSteps branchCost : ℕ} + (hcode : code < count) (htest : initial test = code) + (hone : initial one = 1) (hne : test ≠ one) + (htestIndex : test < indexBound) + (hinitial : StoreEnvelope indexBound valueBound initial) + (hbranch : MeasuredRuns (branch ⟨code, hcode⟩) (cleared initial test) + final branchSteps branchCost (envelopeSpace indexBound valueBound)) : + ∃ cost space, + Exec (select count test one branch) initial final + (stepCount code branchSteps) cost space ∧ + run (select count test one branch).compile (stepCount code branchSteps) + { pc := 0, regs := initial } = + { pc := (select count test one branch).codeSize, regs := final } ∧ + Halted (select count test one branch).compile + (run (select count test one branch).compile (stepCount code branchSteps) + { pc := 0, regs := initial }) ∧ + logTimeUpto (select count test one branch).compile + (stepCount code branchSteps) { pc := 0, regs := initial } ≤ + costBound code branchCost (valueWidth valueBound) ∧ + spaceUpto (select count test one branch).compile + (stepCount code branchSteps) { pc := 0, regs := initial } ≤ + envelopeSpace indexBound valueBound := by + obtain ⟨cost, space, hexec, hcost, hspace⟩ := + select_measured branch initial final hcode htest hone hne htestIndex + hinitial hbranch + have hcompiled := Exec.compile_correct hexec + refine ⟨cost, space, hexec, hcompiled.1, Exec.compile_halted hexec, ?_, ?_⟩ + · rw [hcompiled.2.1] + exact hcost + · rw [hcompiled.2.2] + exact hspace + +end Switch + +end Structured + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Switch/Defs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Switch/Defs.lean new file mode 100644 index 0000000000..fd436e17c5 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Switch/Defs.lean @@ -0,0 +1,61 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.Defs + +/-! +# Finite numeric switches for structured RAM programs + +`select` compiles a finite family of commands into a decrementing decision +tree. A valid numeric code in `test` selects the corresponding branch. The +register `one` must contain one and be distinct from `test`. +-/ + + +@[expose] public section + +namespace Complexity + +namespace RAM + +namespace Structured + +namespace Switch + + +/-- Store presented to the selected branch after the tested code has been +decremented to zero. -/ +def cleared (store : Store) (test : ℕ) : Store := + Function.update store test 0 + +/-- A finite numeric switch. Invalid codes fall through to `skip`; correctness +theorems use the explicit hypothesis `code < count`. -/ +def select : (count : ℕ) → (test one : ℕ) → (Fin count → Cmd) → Cmd + | 0, _, _, _ => .skip + | count + 1, test, one, branch => + .ifZero test (branch ⟨0, by omega⟩) + (.seq (.basic (.sub test test one)) + (select count test one (fun index => branch index.succ))) + +/-- Exact compiled/source transition count for selecting `code`. -/ +def stepCount (code branchSteps : ℕ) : ℕ := + 3 * code + branchSteps + 1 + +/-- Envelope-based logarithmic-cost bound for selecting `code`. + +Each skipped case pays at most seven envelope widths: three for the nonzero +conditional and four for the decrement. The selected zero case pays one. -/ +def costBound (code branchCost width : ℕ) : ℕ := + (7 * code + 1) * width + branchCost + +end Switch + +end Structured + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Switch/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Switch/Internal.lean new file mode 100644 index 0000000000..80eadb1857 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Switch/Internal.lean @@ -0,0 +1,180 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.Internal.Resources +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.Switch.Defs + +/-! +# Finite numeric structured-RAM switches -- proof internals +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace Structured + +namespace Switch + + +open Internal + +private theorem cleared_eq_self {store : Store} {test : ℕ} + (htest : store test = 0) : cleared store test = store := by + funext index + by_cases hindex : index = test + · subst index + simp [cleared, htest] + · simp [cleared, Function.update_of_ne hindex] + +private theorem cleared_sub_eq (store : Store) (test one : ℕ) : + cleared ((Basic.sub test test one).exec store) test = cleared store test := by + funext index + by_cases hindex : index = test + · subst index + simp [cleared] + · simp [cleared, Basic.exec, Function.update_of_ne hindex] + +theorem select_exec_internal {count test one : ℕ} + (branch : Fin count → Cmd) (initial final : Store) + {code branchSteps : ℕ} + (hcode : code < count) (htest : initial test = code) + (hone : initial one = 1) (hne : test ≠ one) + (hbranch : ∃ cost space, + Exec (branch ⟨code, hcode⟩) (cleared initial test) final + branchSteps cost space) : + ∃ cost space, + Exec (select count test one branch) initial final + (stepCount code branchSteps) cost space := by + induction count generalizing code initial with + | zero => omega + | succ count ih => + by_cases hzero : code = 0 + · have htestZero : initial test = 0 := htest.trans hzero + have hclear : cleared initial test = initial := cleared_eq_self htestZero + obtain ⟨branchCost, branchSpace, hbranchExec⟩ := hbranch + have hbranchZero : + Exec (branch ⟨0, by omega⟩) initial final branchSteps + branchCost branchSpace := by + rw [← hclear] + simpa [hzero] using hbranchExec + refine ⟨bitlen (initial test) + 1 + branchCost, + max initial.space branchSpace, ?_⟩ + simpa [select, stepCount, hzero] using + Exec.ifZero htestZero hbranchZero + · obtain ⟨predecessor, rfl⟩ := Nat.exists_eq_succ_of_ne_zero hzero + have hpredecessor : predecessor < count := by omega + let next := (Basic.sub test test one).exec initial + have hnextTest : next test = predecessor := by + simp [next, Basic.exec, htest, hone] + have hnextOne : next one = 1 := by + rw [show next one = initial one by + simp [next, Basic.exec, Function.update_of_ne (Ne.symm hne)]] + exact hone + have hclear : cleared next test = cleared initial test := by + exact cleared_sub_eq initial test one + have hrecursiveBranch : + ∃ cost space, + Exec ((fun index : Fin count => branch index.succ) + ⟨predecessor, hpredecessor⟩) + (cleared next test) final branchSteps cost space := by + rw [hclear] + simpa using hbranch + obtain ⟨recursiveCost, recursiveSpace, hrecursive⟩ := + ih (branch := fun index => branch index.succ) (initial := next) + hpredecessor hnextTest hnextOne hrecursiveBranch + have hdecrement := Exec.basic (.sub test test one) initial + have hsequence := Exec.seq hdecrement hrecursive + have hnonzero : initial test ≠ 0 := by omega + have hrun := Exec.ifNonzero + (onZero := branch ⟨0, by omega⟩) hnonzero hsequence + refine ⟨bitlen (initial test) + 1 + + ((Basic.sub test test one).logCost initial + recursiveCost) + 1, + max initial.space + (max (max initial.space + ((Basic.sub test test one).exec initial).space) recursiveSpace), ?_⟩ + convert hrun using 1 + all_goals simp [stepCount] + all_goals omega + +theorem select_measured_internal {count test one indexBound valueBound : ℕ} + (branch : Fin count → Cmd) (initial final : Store) + {code branchSteps branchCost : ℕ} + (hcode : code < count) (htest : initial test = code) + (hone : initial one = 1) (hne : test ≠ one) + (htestIndex : test < indexBound) + (hinitial : StoreEnvelope indexBound valueBound initial) + (hbranch : MeasuredRuns (branch ⟨code, hcode⟩) (cleared initial test) + final branchSteps branchCost (envelopeSpace indexBound valueBound)) : + MeasuredRuns (select count test one branch) initial final + (stepCount code branchSteps) + (costBound code branchCost (valueWidth valueBound)) + (envelopeSpace indexBound valueBound) := by + induction count generalizing code initial with + | zero => omega + | succ count ih => + by_cases hzero : code = 0 + · have htestZero : initial test = 0 := htest.trans hzero + have hclear : cleared initial test = initial := cleared_eq_self htestZero + have hcount : 0 < count + 1 := by omega + have hbranchZero : + MeasuredRuns (branch ⟨0, hcount⟩) initial final branchSteps + branchCost (envelopeSpace indexBound valueBound) := by + rw [← hclear] + simpa [hzero] using hbranch + have hrun := MeasuredRuns.ifZeroEnvelope + (onNonzero := .seq (.basic (.sub test test one)) + (select count test one (fun index => branch index.succ))) + htestZero hinitial hbranchZero + simpa [select, stepCount, costBound, hzero] using hrun + · obtain ⟨predecessor, rfl⟩ := Nat.exists_eq_succ_of_ne_zero hzero + have hpredecessor : predecessor < count := by omega + let next := (Basic.sub test test one).exec initial + have hnextTest : next test = predecessor := by + simp [next, Basic.exec, htest, hone] + have hnextOne : next one = 1 := by + rw [show next one = initial one by + simp [next, Basic.exec, Function.update_of_ne (Ne.symm hne)]] + exact hone + have hnextEnvelope : StoreEnvelope indexBound valueBound next := by + apply hinitial.execBasic (.sub test test one) + · simpa using htestIndex + · simp [Internal.Basic.writeValue, htest, hone] + have hvalue := hinitial.value_le test + omega + have hclear : cleared next test = cleared initial test := by + exact cleared_sub_eq initial test one + have hrecursiveBranch : + MeasuredRuns + ((fun index : Fin count => branch index.succ) + ⟨predecessor, hpredecessor⟩) + (cleared next test) final branchSteps branchCost + (envelopeSpace indexBound valueBound) := by + rw [hclear] + simpa using hbranch + have hrecursive := ih (branch := fun index => branch index.succ) + (initial := next) hpredecessor hnextTest hnextOne + hnextEnvelope hrecursiveBranch + have hdecrement := MeasuredRuns.basicEnvelope + (.sub test test one) initial hinitial hnextEnvelope + have hnonzero : initial test ≠ 0 := by omega + have hrun := MeasuredRuns.ifNonzeroEnvelope + (onZero := branch ⟨0, by omega⟩) hnonzero hinitial + (hdecrement.seq hrecursive) + convert hrun using 1 <;> simp [stepCount, costBound] + all_goals ring + +end Switch + +end Structured + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/ThreeSATSyntax.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/ThreeSATSyntax.lean new file mode 100644 index 0000000000..2a661b884e --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/ThreeSATSyntax.lean @@ -0,0 +1,84 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.ThreeSATSyntax.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.Scanner + +/-! +# Verified structured RAM exact-3-CNF syntax scanner + +The generic typed-scanner compiler supplies the entire implementation proof and +resource analysis for the existing 27-state `SAT.ThreeSAT.Syntax` automaton. +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace Structured + +namespace ThreeSATSyntax + +open SAT.ThreeSAT + +/-- The 27-state syntax scanner takes exactly `90 + 9n` transitions. -/ +@[simp] theorem stepCount_eq (inputLength : ℕ) : + stepCount inputLength = 90 + 9 * inputLength := by + rfl + +/-- Source correctness and explicit resource bounds for syntax recognition. -/ +theorem program_performance (bits : List Bool) : + ∃ final cost space, + Exec program (inputStore bits) final (stepCount bits.length) cost space ∧ + cost ≤ timeBound bits.length ∧ space ≤ spaceBound bits.length ∧ + final verdictReg = Input.bitValue + (Syntax.accept (bits.foldl Syntax.bitStep Syntax.bitStart)) := + Scanner.typed_program_performance spec bits + +/-- End-to-end compiled performance and syntax-language correctness. -/ +theorem compiled_performance (bits : List Bool) : + ∃ final cost space, + Exec program (inputStore bits) final (stepCount bits.length) cost space ∧ + run compiled (stepCount bits.length) { pc := 0, regs := inputStore bits } = + { pc := program.codeSize, regs := final } ∧ + Halted compiled + (run compiled (stepCount bits.length) { pc := 0, regs := inputStore bits }) ∧ + logTimeUpto compiled (stepCount bits.length) + { pc := 0, regs := inputStore bits } ≤ timeBound bits.length ∧ + spaceUpto compiled (stepCount bits.length) + { pc := 0, regs := inputStore bits } ≤ spaceBound bits.length ∧ + ((run compiled (stepCount bits.length) + { pc := 0, regs := inputStore bits }).regs verdictReg = 1 ↔ + bits ∈ Syntax.language) := by + obtain ⟨final, cost, space, hexec, hrun, hhalt, htime, hspace, hresult⟩ := + Scanner.typed_compiled_performance spec bits + refine ⟨final, cost, space, hexec, hrun, hhalt, htime, hspace, ?_⟩ + rw [hresult] + change Input.bitValue + (Syntax.accept (bits.foldl Syntax.bitStep Syntax.bitStart)) = 1 ↔ + Syntax.accept (bits.foldl Syntax.bitStep Syntax.bitStart) = true + cases Syntax.accept (bits.foldl Syntax.bitStep Syntax.bitStart) <;> + simp [Input.bitValue] + +/-- The explicit logarithmic-time budget is quasilinear. -/ +theorem timeBound_bigO_quasilinear : timeBound =O quasilinearBound := + Scanner.typed_timeBound_bigO_quasilinear spec + +/-- The explicit peak-space budget is quasilinear. -/ +theorem spaceBound_bigO_quasilinear : spaceBound =O quasilinearBound := + Scanner.typed_spaceBound_bigO_quasilinear spec + +end ThreeSATSyntax + +end Structured + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/ThreeSATSyntax/Defs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/ThreeSATSyntax/Defs.lean new file mode 100644 index 0000000000..dcab96ffe0 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/ThreeSATSyntax/Defs.lean @@ -0,0 +1,85 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.Scanner.Defs +public import LeanPool.BeyondBethe.Complexitylib.SAT.ThreeSAT.Syntax + +/-! +# Structured RAM exact-3-CNF syntax scanner — definitions + +This is the larger typed-scanner benchmark: the existing 27-state bit-level +3-CNF syntax automaton is compiled without a handwritten numeric transition +table or benchmark-specific execution invariant. +-/ + + +@[expose] public section + +namespace Complexity + +namespace RAM + +namespace Structured + +namespace ThreeSATSyntax + +open SAT.ThreeSAT + +instance : FinEnum Syntax.TokenState := + FinEnum.ofList + (((List.finRange 4).map Syntax.TokenState.between) ++ + ((List.finRange 4).map Syntax.TokenState.inLit) ++ [.invalid]) (by + intro state + cases state <;> simp) + +instance : FinEnum Syntax.BitState := + FinEnum.ofList + (((FinEnum.toList Syntax.TokenState).map Syntax.BitState.ready) ++ + (FinEnum.toList Syntax.TokenState).flatMap fun state => + [.half state false, .half state true]) (by + intro state + cases state with + | ready state => simp + | half state bit => cases bit <;> simp) + +/-- The existing exact-3-CNF syntax automaton as a typed scanner specification. -/ +def spec : Scanner.TypedSpec Syntax.BitState where + initial := Syntax.bitStart + step := Syntax.bitStep + accept := Syntax.accept + +/-- Final verdict register inherited from the scanner layout. -/ +abbrev verdictReg : ℕ := Scanner.lengthReg + +/-- Reserved-prefix input store for the syntax scanner. -/ +abbrev inputStore : List Bool → Store := spec.inputStore + +/-- Structured RAM exact-3-CNF syntax program. -/ +abbrev program : Cmd := spec.program + +/-- Concrete compiled RAM exact-3-CNF syntax program. -/ +abbrev compiled : Program := spec.compiled + +/-- Exact compiled transition count. -/ +abbrev stepCount : ℕ → ℕ := spec.stepCount + +/-- Explicit logarithmic-time budget. -/ +abbrev timeBound : ℕ → ℕ := spec.timeBound + +/-- Explicit peak-space budget. -/ +abbrev spaceBound : ℕ → ℕ := spec.spaceBound + +/-- Shifted quasilinear comparison function. -/ +abbrev quasilinearBound : ℕ → ℕ := spec.quasilinearBound + +end ThreeSATSyntax + +end Structured + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/UnaryDecode.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/UnaryDecode.lean new file mode 100644 index 0000000000..bdb429d2d2 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/UnaryDecode.lean @@ -0,0 +1,144 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.UnaryDecode.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.UnaryDecode.Internal +public import LeanPool.BeyondBethe.Complexitylib.Asymptotics +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured + +/-! +# Verified structured RAM terminated-unary decoder + +This module exposes a reusable cursor decoder for the unary fields used by the +serialized-circuit format. The source proof covers both successful termination +and input exhaustion, and compilation preserves its exact transition count, +logarithmic cost, peak space, decoded value, and suffix cursor. +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace Structured + +namespace UnaryDecode + +/-- Invoke the decoder loop as a resource-bounded cursor routine. + +Unlike `program_performance`, this theorem does not require the standalone +input initializer. It can therefore be sequenced after another parser step. +The loop preserves every data register at or above `inputBase`. -/ +theorem mainLoop_performance {remaining : List Bool} + {inputLength offset value : ℕ} {store : Store} + (hready : CursorReady inputLength remaining offset value store) + (hbound : Internal.StoreEnvelope (inputLength + inputBase) + (inputLength + inputBase) store) : + ∃ final cost space, + Exec mainLoop store final (loopStepCount remaining) cost space ∧ + cost ≤ timeBound inputLength ∧ space ≤ spaceBound inputLength ∧ + (match CircuitCode.NatCode.decodePrefix? remaining with + | none => + final verdictReg = 0 ∧ final valueReg = value + remaining.length ∧ + final pointerReg = inputBase + inputLength ∧ final remainingReg = 0 + | some (decoded, rest) => + final verdictReg = 1 ∧ final valueReg = value + decoded ∧ + final pointerReg = inputBase + offset + decoded + 1 ∧ + final remainingReg = rest.length) ∧ + final activeReg = 0 ∧ + final oneReg = 1 ∧ + (∀ index, inputBase ≤ index → final index = store index) ∧ + Internal.StoreEnvelope (inputLength + inputBase) + (inputLength + inputBase) final := + mainLoop_measured_internal hready hbound + +/-- Source-level correctness with exact transitions and explicit resources. -/ +theorem program_performance (bits : List Bool) : + ∃ final cost space, + Exec program (inputStore bits) final (stepCount bits) cost space ∧ + cost ≤ timeBound bits.length ∧ space ≤ spaceBound bits.length ∧ + match CircuitCode.NatCode.decodePrefix? bits with + | none => + final verdictReg = 0 ∧ final valueReg = bits.length ∧ + final pointerReg = inputBase + bits.length ∧ final remainingReg = 0 + | some (value, rest) => + final verdictReg = 1 ∧ final valueReg = value ∧ + final pointerReg = inputBase + value + 1 ∧ + final remainingReg = rest.length := + program_measured_internal bits + +/-- End-to-end concrete RAM performance and terminated-unary correctness. -/ +theorem compiled_performance (bits : List Bool) : + ∃ final cost space, + Exec program (inputStore bits) final (stepCount bits) cost space ∧ + run compiled (stepCount bits) { pc := 0, regs := inputStore bits } = + { pc := program.codeSize, regs := final } ∧ + Halted compiled + (run compiled (stepCount bits) { pc := 0, regs := inputStore bits }) ∧ + logTimeUpto compiled (stepCount bits) + { pc := 0, regs := inputStore bits } ≤ timeBound bits.length ∧ + spaceUpto compiled (stepCount bits) + { pc := 0, regs := inputStore bits } ≤ spaceBound bits.length ∧ + match CircuitCode.NatCode.decodePrefix? bits with + | none => + final verdictReg = 0 ∧ final valueReg = bits.length ∧ + final pointerReg = inputBase + bits.length ∧ final remainingReg = 0 + | some (value, rest) => + final verdictReg = 1 ∧ final valueReg = value ∧ + final pointerReg = inputBase + value + 1 ∧ + final remainingReg = rest.length := by + obtain ⟨final, cost, space, hexec, hcost, hspace, hresult⟩ := + program_performance bits + have hcompiled := Exec.compile_correct hexec + refine ⟨final, cost, space, hexec, hcompiled.1, Exec.compile_halted hexec, + ?_, ?_, hresult⟩ + · change logTimeUpto program.compile (stepCount bits) + { pc := 0, regs := inputStore bits } ≤ timeBound bits.length + rw [hcompiled.2.1] + exact hcost + · change spaceUpto program.compile (stepCount bits) + { pc := 0, regs := inputStore bits } ≤ spaceBound bits.length + rw [hcompiled.2.2] + exact hspace + +/-- The explicit logarithmic-cost time budget is quasilinear. -/ +theorem timeBound_bigO_quasilinear : timeBound =O quasilinearBound := by + have hpoint : ∀ n, timeBound n ≤ 96 * quasilinearBound n := by + intro n + simp only [timeBound, quasilinearBound] + have hshift : n + 1 ≤ n + inputBase := by simp [inputBase] + calc + 96 * (n + 1) * (bitlen (n + inputBase) + 1) + = 96 * ((n + 1) * (bitlen (n + inputBase) + 1)) := by ring + _ ≤ 96 * ((n + inputBase) * (bitlen (n + inputBase) + 1)) := + Nat.mul_le_mul_left 96 + (Nat.mul_le_mul_right (bitlen (n + inputBase) + 1) hshift) + exact (BigO.of_le hpoint).trans + (BigO.const_mul_left 96 (BigO.refl quasilinearBound)) + +/-- The explicit peak-space budget is quasilinear. -/ +theorem spaceBound_bigO_quasilinear : spaceBound =O quasilinearBound := by + have hpoint : ∀ n, spaceBound n ≤ 2 * quasilinearBound n := by + intro n + simp only [spaceBound, quasilinearBound] + calc + (n + inputBase) * (2 * bitlen (n + inputBase)) + = 2 * ((n + inputBase) * bitlen (n + inputBase)) := by ring + _ ≤ 2 * ((n + inputBase) * (bitlen (n + inputBase) + 1)) := + Nat.mul_le_mul_left 2 (Nat.mul_le_mul_left (n + inputBase) (by omega)) + exact (BigO.of_le hpoint).trans + (BigO.const_mul_left 2 (BigO.refl quasilinearBound)) + +end UnaryDecode + +end Structured + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/UnaryDecode/Defs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/UnaryDecode/Defs.lean new file mode 100644 index 0000000000..1c22b33bbc --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/UnaryDecode/Defs.lean @@ -0,0 +1,146 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.Defs +public import LeanPool.BeyondBethe.Complexitylib.Circuits.Encoding.Defs + +/-! +# Structured RAM terminated-unary cursor decoder — definitions + +This reusable parser consumes the first terminated-unary field of an input bit +array. It is the first nested-control component of the RAM circuit evaluator: +the loop can exit either successfully at a zero terminator or unsuccessfully at +the end of the available array. +-/ + + +@[expose] public section + +namespace Complexity + +namespace RAM + +namespace Structured + +namespace UnaryDecode + +/-- Success verdict: one exactly when a zero terminator was consumed. -/ +def verdictReg : ℕ := 0 +/-- Decoded unary value. -/ +def valueReg : ℕ := 1 +/-- Address of the next unconsumed input bit. -/ +def pointerReg : ℕ := 2 +/-- Number of unconsumed input bits. -/ +def remainingReg : ℕ := 3 +/-- Constant-one register. -/ +def oneReg : ℕ := 4 +/-- Current input bit. -/ +def bitReg : ℕ := 5 +/-- Loop activity flag. -/ +def activeReg : ℕ := 6 +/-- First register occupied by input bits. -/ +def inputBase : ℕ := 7 + +/-- Reserved-register input store for one unary field and its suffix. -/ +def inputStore (bits : List Bool) : Store := + Input.bitStore remainingReg inputBase bits + +/-- Initialize the parser cursor, accumulator, fixedValue, and activity flag. -/ +def setupOps : List Basic := + [.imm verdictReg 0, .imm valueReg 0, .imm pointerReg inputBase, + .imm oneReg 1, .imm activeReg 1] + +/-- Parser initialization. -/ +def setup : Cmd := Cmd.basics setupOps + +/-- Record an unterminated field after exhausting the available input. -/ +def stopTruncated : Cmd := Cmd.basics [.imm verdictReg 0, .imm activeReg 0] + +/-- Record a successfully consumed zero terminator. -/ +def stopSuccess : Cmd := Cmd.basics [.imm verdictReg 1, .imm activeReg 0] + +/-- Consume one available bit and either stop or increment the unary value. -/ +def consume : Cmd := Cmd.seqList + [.basic (.load bitReg pointerReg), + .basic (.add pointerReg pointerReg oneReg), + .basic (.sub remainingReg remainingReg oneReg), + .ifZero bitReg stopSuccess (.basic (.add valueReg valueReg oneReg))] + +/-- One parser iteration, including the exhausted-input case. -/ +def body : Cmd := Cmd.ifZero remainingReg stopTruncated consume + +/-- Iterate until the parser records success or truncation. -/ +def mainLoop : Cmd := Cmd.whileNonzero activeReg body + +/-- Semantic calling convention for invoking `mainLoop` at an existing cursor. + +The already-consumed prefix is represented by `offset`; `value` is the current +field's unary accumulator, and `remaining` is the still-readable suffix. +Registers at or above `inputBase` are data rather than parser scratch, so the +loop's routine theorem can frame them unchanged. -/ +structure CursorReady (inputLength : ℕ) (remaining : List Bool) + (offset value : ℕ) (store : Store) : Prop where + /-- Consumed and remaining bits account for the original input. -/ + total_eq : offset + remaining.length = inputLength + /-- The current field accumulator cannot exceed the absolute cursor offset. -/ + value_le_offset : value ≤ offset + /-- No successful terminator has been recorded yet. -/ + verdict_eq : store verdictReg = 0 + /-- The accumulator contains the current field's consumed one-bits. -/ + value_eq : store valueReg = value + /-- The cursor points to the first remaining bit. -/ + pointer_eq : store pointerReg = inputBase + offset + /-- The remaining-length register agrees with the semantic suffix. -/ + remaining_eq : store remainingReg = remaining.length + /-- The parser's fixedValue-one register is initialized. -/ + one_eq : store oneReg = 1 + /-- The loop is active. -/ + active_eq : store activeReg = 1 + /-- Physical input registers encode the remaining semantic suffix. -/ + input_eq : ∀ delta, + store (inputBase + offset + delta) = + match remaining[delta]? with + | some bit => Input.bitValue bit + | none => 0 + +/-- Exact transition count for invoking `mainLoop` at a semantic suffix. -/ +def loopStepCount (remaining : List Bool) : ℕ := + match CircuitCode.NatCode.decodePrefix? remaining with + | none => 10 * remaining.length + 6 + | some (value, _) => 10 * value + 11 + +/-- Complete terminated-unary decoder. -/ +def program : Cmd := Cmd.seq setup mainLoop + +/-- Concrete compiled RAM decoder. -/ +def compiled : Program := program.compile + +/-- Exact compiled transition count through the first terminator or exhaustion. -/ +def stepCount (bits : List Bool) : ℕ := + match CircuitCode.NatCode.decodePrefix? bits with + | none => 10 * bits.length + 11 + | some (value, _) => 10 * value + 16 + +/-- Explicit logarithmic-time budget. -/ +def timeBound (inputLength : ℕ) : ℕ := + 96 * (inputLength + 1) * (bitlen (inputLength + inputBase) + 1) + +/-- Explicit peak-space budget. -/ +def spaceBound (inputLength : ℕ) : ℕ := + (inputLength + inputBase) * (2 * bitlen (inputLength + inputBase)) + +/-- Shifted quasilinear comparison function. -/ +def quasilinearBound (inputLength : ℕ) : ℕ := + (inputLength + inputBase) * (bitlen (inputLength + inputBase) + 1) + +end UnaryDecode + +end Structured + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/UnaryDecode/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/UnaryDecode/Internal.lean new file mode 100644 index 0000000000..daa5fcc294 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/UnaryDecode/Internal.lean @@ -0,0 +1,761 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.Internal.Resources +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.UnaryDecode.Defs + +/-! +# Structured RAM terminated-unary decoder — proof internals +-/ + + +public section + +namespace Complexity + +namespace RAM + +namespace Structured + +namespace UnaryDecode + +open Internal + +private abbrev StoreBound (inputLength : ℕ) (store : Store) : Prop := + StoreEnvelope (inputLength + inputBase) (inputLength + inputBase) store + +private abbrev width (inputLength : ℕ) : ℕ := + valueWidth (inputLength + inputBase) + +private abbrev resourceSpace (inputLength : ℕ) : ℕ := + envelopeSpace (inputLength + inputBase) (inputLength + inputBase) + +private theorem envelopeSpace_eq_spaceBound (inputLength : ℕ) : + resourceSpace inputLength = spaceBound inputLength := by + simp [resourceSpace, envelopeSpace, spaceBound, two_mul] + +private theorem inputStore_bound (bits : List Bool) : + StoreBound bits.length (inputStore bits) := by + apply Internal.Input.bitStoreEnvelope + · simp [remainingReg, inputBase] + · simp [inputBase, Nat.add_comm] + · omega + · simp [inputBase] + +private def setupStore (bits : List Bool) : Store := + Basic.execList setupOps (inputStore bits) + +private theorem setup_measured (bits : List Bool) : + MeasuredRuns setup (inputStore bits) (setupStore bits) 5 + (20 * width bits.length) (resourceSpace bits.length) ∧ + StoreBound bits.length (setupStore bits) := by + have hinitial := inputStore_bound bits + have hpreserve : ∀ op, op ∈ setupOps → ∀ store, + StoreBound bits.length store → StoreBound bits.length (op.exec store) := by + intro op hop store hstore + simp [setupOps] at hop + rcases hop with rfl | rfl | rfl | rfl | rfl + · apply hstore.execBasic (.imm verdictReg 0) <;> simp [verdictReg, inputBase] + · apply hstore.execBasic (.imm valueReg 0) <;> simp [valueReg, inputBase] + · apply hstore.execBasic (.imm pointerReg inputBase) + · simp [pointerReg, inputBase] + · simp [Internal.Basic.writeValue, inputBase] + · apply hstore.execBasic (.imm oneReg 1) <;> simp [oneReg, inputBase] + · apply hstore.execBasic (.imm activeReg 1) <;> simp [activeReg, inputBase] + simpa [setup, setupStore, setupOps] using + MeasuredRuns.basicsEnvelope setupOps (inputStore bits) hinitial hpreserve + +private structure LoopInv (inputLength : ℕ) (remaining : List Bool) + (offset value : ℕ) (store : Store) : Prop where + total_eq : offset + remaining.length = inputLength + value_le_offset : value ≤ offset + store_bound : StoreBound inputLength store + verdict_eq : store verdictReg = 0 + value_eq : store valueReg = value + pointer_eq : store pointerReg = inputBase + offset + remaining_eq : store remainingReg = remaining.length + one_eq : store oneReg = 1 + active_eq : store activeReg = 1 + input_eq : ∀ delta, + store (inputBase + offset + delta) = + match remaining[delta]? with + | some bit => Input.bitValue bit + | none => 0 + +private theorem loopInv_of_cursorReady {inputLength offset value : ℕ} + {remaining : List Bool} {store : Store} + (hready : CursorReady inputLength remaining offset value store) + (hbound : StoreBound inputLength store) : + LoopInv inputLength remaining offset value store where + total_eq := hready.total_eq + value_le_offset := hready.value_le_offset + store_bound := hbound + verdict_eq := hready.verdict_eq + value_eq := hready.value_eq + pointer_eq := hready.pointer_eq + remaining_eq := hready.remaining_eq + one_eq := hready.one_eq + active_eq := hready.active_eq + input_eq := hready.input_eq + +private theorem setup_inv (bits : List Bool) + (hbound : StoreBound bits.length (setupStore bits)) : + LoopInv bits.length bits 0 0 (setupStore bits) := by + constructor + · simp + · simp + · exact hbound + · simp [setupStore, setupOps, Basic.execList, Basic.exec, verdictReg, + valueReg, pointerReg, oneReg, activeReg] + · simp [setupStore, setupOps, Basic.execList, Basic.exec, verdictReg, + valueReg, pointerReg, oneReg, activeReg] + · simp [setupStore, setupOps, Basic.execList, Basic.exec, verdictReg, + valueReg, pointerReg, oneReg, activeReg, inputBase] + · simp [setupStore, setupOps, Basic.execList, Basic.exec, verdictReg, + valueReg, pointerReg, remainingReg, oneReg, activeReg, + inputStore, Input.bitStore] + · simp [setupStore, setupOps, Basic.execList, Basic.exec, verdictReg, + valueReg, pointerReg, oneReg, activeReg] + · simp [setupStore, setupOps, Basic.execList, Basic.exec, verdictReg, + valueReg, pointerReg, oneReg, activeReg] + · intro offset + have h1 : 7 + offset ≠ 1 := by omega + have h2 : 7 + offset ≠ 2 := by omega + have h3 : 7 + offset ≠ 3 := by omega + have h4 : 7 + offset ≠ 4 := by omega + have h6 : 7 + offset ≠ 6 := by omega + simp [setupStore, setupOps, Basic.execList, Basic.exec, Function.update_of_ne, + h1, h2, h3, h4, h6, inputStore, Input.bitStore, + inputBase, verdictReg, valueReg, pointerReg, remainingReg, oneReg, + activeReg] + rfl + +private def truncatedStore (store : Store) : Store := + Basic.execList [.imm verdictReg 0, .imm activeReg 0] store + +private def loaded (store : Store) : Store := + (Basic.load bitReg pointerReg).exec store + +private def moved (store : Store) : Store := + (Basic.add pointerReg pointerReg oneReg).exec (loaded store) + +private def decremented (store : Store) : Store := + (Basic.sub remainingReg remainingReg oneReg).exec (moved store) + +private def successStore (store : Store) : Store := + Basic.execList [.imm verdictReg 1, .imm activeReg 0] (decremented store) + +private def continuedStore (store : Store) : Store := + (Basic.add valueReg valueReg oneReg).exec (decremented store) + +private theorem loaded_bound {inputLength : ℕ} {store : Store} + (hstore : StoreBound inputLength store) : + StoreBound inputLength (loaded store) := by + apply hstore.execBasic (.load bitReg pointerReg) + · simp [bitReg, inputBase] + · simpa [Internal.Basic.writeValue] using hstore.value_le (store pointerReg) + +private theorem loaded_bit {bit : Bool} {rest : List Bool} + {inputLength offset value : ℕ} {store : Store} + (hinv : LoopInv inputLength (bit :: rest) offset value store) : + loaded store bitReg = Input.bitValue bit := by + simp only [loaded, Basic.exec, Function.update_self] + rw [hinv.pointer_eq] + simpa using hinv.input_eq 0 + +private theorem moved_bound {bit : Bool} {rest : List Bool} + {inputLength offset value : ℕ} {store : Store} + (hinv : LoopInv inputLength (bit :: rest) offset value store) : + StoreBound inputLength (moved store) := by + have hloaded := loaded_bound hinv.store_bound + apply hloaded.execBasic (.add pointerReg pointerReg oneReg) + · simp [pointerReg, inputBase] + · have hpointer : loaded store pointerReg = inputBase + offset := by + simpa [loaded, Basic.exec, bitReg, pointerReg] using hinv.pointer_eq + have hone : loaded store oneReg = 1 := by + simpa [loaded, Basic.exec, bitReg, oneReg] using hinv.one_eq + change loaded store pointerReg + loaded store oneReg ≤ inputLength + inputBase + rw [hpointer, hone] + have htotal := hinv.total_eq + simp only [List.length_cons] at htotal + omega + +private theorem decremented_bound {bit : Bool} {rest : List Bool} + {inputLength offset value : ℕ} {store : Store} + (hinv : LoopInv inputLength (bit :: rest) offset value store) : + StoreBound inputLength (decremented store) := by + have hmoved := moved_bound hinv + apply hmoved.execBasic (.sub remainingReg remainingReg oneReg) + · simp [remainingReg, inputBase] + · exact Nat.le_trans (Nat.sub_le _ _) (hmoved.value_le remainingReg) + +private theorem success_bound {rest : List Bool} {inputLength offset value : ℕ} + {store : Store} + (hinv : LoopInv inputLength (false :: rest) offset value store) : + StoreBound inputLength (successStore store) := by + have hdecremented := decremented_bound hinv + have hverdict := hdecremented.execBasic (.imm verdictReg 1) + (by simp [verdictReg, inputBase]) (by simp [Internal.Basic.writeValue, inputBase]) + apply hverdict.execBasic (.imm activeReg 0) <;> + simp [activeReg, inputBase] + +private theorem continued_bound {rest : List Bool} {inputLength offset value : ℕ} + {store : Store} + (hinv : LoopInv inputLength (true :: rest) offset value store) : + StoreBound inputLength (continuedStore store) := by + have hdecremented := decremented_bound hinv + apply hdecremented.execBasic (.add valueReg valueReg oneReg) + · simp [valueReg, inputBase] + · have hvalue : decremented store valueReg = value := by + simpa [decremented, moved, loaded, Basic.exec, remainingReg, pointerReg, + bitReg, valueReg] using hinv.value_eq + have hone : decremented store oneReg = 1 := by + simpa [decremented, moved, loaded, Basic.exec, remainingReg, pointerReg, + bitReg, valueReg, oneReg] using hinv.one_eq + change decremented store valueReg + decremented store oneReg ≤ + inputLength + inputBase + rw [hvalue, hone] + have hvalueLe := hinv.value_le_offset + have htotal := hinv.total_eq + simp only [List.length_cons] at htotal + simp only [inputBase] + omega + +private theorem continued_high (store : Store) (index : ℕ) + (hindex : inputBase ≤ index) : continuedStore store index = store index := by + have hvalue : index ≠ valueReg := by + simp only [inputBase, valueReg] at hindex ⊢ + omega + have hpointer : index ≠ pointerReg := by + simp only [inputBase, pointerReg] at hindex ⊢ + omega + have hremaining : index ≠ remainingReg := by + simp only [inputBase, remainingReg] at hindex ⊢ + omega + have hbit : index ≠ bitReg := by + simp only [inputBase, bitReg] at hindex ⊢ + omega + simp [continuedStore, decremented, moved, loaded, Basic.exec, + Function.update_of_ne, hvalue, hpointer, hremaining, hbit] + +private theorem truncated_high (store : Store) (index : ℕ) + (hindex : inputBase ≤ index) : truncatedStore store index = store index := by + have hverdict : index ≠ verdictReg := by + simp only [inputBase, verdictReg] at hindex ⊢ + omega + have hactive : index ≠ activeReg := by + simp only [inputBase, activeReg] at hindex ⊢ + omega + simp [truncatedStore, Basic.execList, Basic.exec, Function.update_of_ne, + hverdict, hactive] + +private theorem success_high (store : Store) (index : ℕ) + (hindex : inputBase ≤ index) : successStore store index = store index := by + have hverdict : index ≠ verdictReg := by + simp only [inputBase, verdictReg] at hindex ⊢ + omega + have hpointer : index ≠ pointerReg := by + simp only [inputBase, pointerReg] at hindex ⊢ + omega + have hremaining : index ≠ remainingReg := by + simp only [inputBase, remainingReg] at hindex ⊢ + omega + have hbit : index ≠ bitReg := by + simp only [inputBase, bitReg] at hindex ⊢ + omega + have hactive : index ≠ activeReg := by + simp only [inputBase, activeReg] at hindex ⊢ + omega + simp [successStore, decremented, moved, loaded, Basic.execList, Basic.exec, + Function.update_of_ne, hverdict, hpointer, hremaining, hbit, hactive] + +private theorem truncated_measured {inputLength : ℕ} {store : Store} + (hstore : StoreBound inputLength store) : + MeasuredRuns stopTruncated store (truncatedStore store) 2 + (8 * width inputLength) (resourceSpace inputLength) ∧ + StoreBound inputLength (truncatedStore store) := by + have hpreserve : ∀ op, op ∈ ([Basic.imm verdictReg 0, + Basic.imm activeReg 0] : List Basic) → + ∀ current, StoreBound inputLength current → + StoreBound inputLength (op.exec current) := by + intro op hop current hcurrent + simp at hop + rcases hop with rfl | rfl + · apply hcurrent.execBasic (.imm verdictReg 0) <;> + simp [verdictReg, inputBase] + · apply hcurrent.execBasic (.imm activeReg 0) <;> + simp [activeReg, inputBase] + simpa [stopTruncated, truncatedStore] using + MeasuredRuns.basicsEnvelope [.imm verdictReg 0, .imm activeReg 0] + store hstore hpreserve + +private theorem false_body_measured {rest : List Bool} + {inputLength offset value : ℕ} {store : Store} + (hinv : LoopInv inputLength (false :: rest) offset value store) : + MeasuredRuns body store (successStore store) 8 + (32 * width inputLength) (resourceSpace inputLength) ∧ + StoreBound inputLength (successStore store) := by + have hloaded := loaded_bound hinv.store_bound + have hmoved := moved_bound hinv + have hdecremented := decremented_bound hinv + have hsuccess := success_bound hinv + have hload := MeasuredRuns.basicEnvelope (.load bitReg pointerReg) store + hinv.store_bound hloaded + have hmove := MeasuredRuns.basicEnvelope (.add pointerReg pointerReg oneReg) + (loaded store) hloaded hmoved + have hdecrement := MeasuredRuns.basicEnvelope + (.sub remainingReg remainingReg oneReg) (moved store) hmoved hdecremented + have hstop : MeasuredRuns stopSuccess (decremented store) (successStore store) 2 + (8 * width inputLength) (resourceSpace inputLength) := by + have hpreserve : ∀ op, op ∈ ([Basic.imm verdictReg 1, + Basic.imm activeReg 0] : List Basic) → + ∀ current, StoreBound inputLength current → + StoreBound inputLength (op.exec current) := by + intro op hop current hcurrent + simp at hop + rcases hop with rfl | rfl + · apply hcurrent.execBasic (.imm verdictReg 1) <;> + simp [verdictReg, inputBase] + · apply hcurrent.execBasic (.imm activeReg 0) <;> + simp [activeReg, inputBase] + exact (by simpa [stopSuccess, successStore] using + (MeasuredRuns.basicsEnvelope [Basic.imm verdictReg 1, + Basic.imm activeReg 0] (decremented store) hdecremented hpreserve).1) + have hbit : decremented store bitReg = 0 := by + have hloadedBit := loaded_bit hinv + simpa [decremented, moved, Basic.exec, remainingReg, pointerReg, bitReg, + oneReg, Input.bitValue] using hloadedBit + have hbranch := MeasuredRuns.ifZeroEnvelope (onNonzero := + .basic (.add valueReg valueReg oneReg)) hbit hdecremented hstop + have hconsume := hload.seq (hmove.seq (hdecrement.seq hbranch)) + have hremaining : store remainingReg ≠ 0 := by + rw [hinv.remaining_eq] + simp + have hrun := MeasuredRuns.ifNonzeroEnvelope (onZero := stopTruncated) + hremaining hinv.store_bound (by + simpa [consume, Cmd.seqList] using hconsume) + refine ⟨?_, hsuccess⟩ + apply MeasuredRuns.weakenCost (by simpa [body] using hrun) + change 3 * width inputLength + + (4 * width inputLength + + (4 * width inputLength + + (4 * width inputLength + + (width inputLength + 8 * width inputLength)))) ≤ + 32 * width inputLength + omega + +private theorem true_body_measured {rest : List Bool} + {inputLength offset value : ℕ} {store : Store} + (hinv : LoopInv inputLength (true :: rest) offset value store) : + MeasuredRuns body store (continuedStore store) 8 + (32 * width inputLength) (resourceSpace inputLength) ∧ + LoopInv inputLength rest (offset + 1) (value + 1) (continuedStore store) := by + have hloaded := loaded_bound hinv.store_bound + have hmoved := moved_bound hinv + have hdecremented := decremented_bound hinv + have hcontinued := continued_bound hinv + have hload := MeasuredRuns.basicEnvelope (.load bitReg pointerReg) store + hinv.store_bound hloaded + have hmove := MeasuredRuns.basicEnvelope (.add pointerReg pointerReg oneReg) + (loaded store) hloaded hmoved + have hdecrement := MeasuredRuns.basicEnvelope + (.sub remainingReg remainingReg oneReg) (moved store) hmoved hdecremented + have hadd := MeasuredRuns.basicEnvelope (.add valueReg valueReg oneReg) + (decremented store) hdecremented hcontinued + have hbit : decremented store bitReg ≠ 0 := by + have hloadedBit := loaded_bit hinv + have heq : decremented store bitReg = 1 := by + simpa [decremented, moved, Basic.exec, remainingReg, pointerReg, bitReg, + oneReg, Input.bitValue] using hloadedBit + omega + have hbranch := MeasuredRuns.ifNonzeroEnvelope (onZero := stopSuccess) + hbit hdecremented hadd + have hconsume := hload.seq (hmove.seq (hdecrement.seq hbranch)) + have hremaining : store remainingReg ≠ 0 := by + rw [hinv.remaining_eq] + simp + have hrun := MeasuredRuns.ifNonzeroEnvelope (onZero := stopTruncated) + hremaining hinv.store_bound (by + simpa [consume, Cmd.seqList] using hconsume) + constructor + · apply MeasuredRuns.weakenCost (by simpa [body] using hrun) + change 3 * width inputLength + + (4 * width inputLength + + (4 * width inputLength + + (4 * width inputLength + + (3 * width inputLength + 4 * width inputLength)))) ≤ + 32 * width inputLength + omega + · constructor + · have htotal := hinv.total_eq + simp only [List.length_cons] at htotal + omega + · have hvalueLe := hinv.value_le_offset + omega + · exact hcontinued + · simpa [continuedStore, decremented, moved, loaded, Basic.exec, + verdictReg, valueReg, pointerReg, remainingReg, oneReg, bitReg, + activeReg] using hinv.verdict_eq + · have hvalue : store valueReg = value := hinv.value_eq + have hone : store oneReg = 1 := hinv.one_eq + simp [continuedStore, decremented, moved, loaded, Basic.exec, + valueReg, pointerReg, remainingReg, oneReg, bitReg] + have hvalue' : store 1 = value := by simpa [valueReg] using hvalue + have hone' : store 4 = 1 := by simpa [oneReg] using hone + omega + · have hpointer : store pointerReg = inputBase + offset := hinv.pointer_eq + have hone : store oneReg = 1 := hinv.one_eq + simp [continuedStore, decremented, moved, loaded, Basic.exec, + valueReg, pointerReg, remainingReg, oneReg, bitReg] + have hpointer' : store 2 = inputBase + offset := by + simpa [pointerReg] using hpointer + have hone' : store 4 = 1 := by simpa [oneReg] using hone + omega + · have hremaining : store remainingReg = rest.length + 1 := by + simpa using hinv.remaining_eq + have hone : store oneReg = 1 := hinv.one_eq + simp [continuedStore, decremented, moved, loaded, Basic.exec, + valueReg, pointerReg, remainingReg, oneReg, bitReg] + have hremaining' : store 3 = rest.length + 1 := by + simpa [remainingReg] using hremaining + have hone' : store 4 = 1 := by simpa [oneReg] using hone + omega + · simpa [continuedStore, decremented, moved, loaded, Basic.exec, + verdictReg, valueReg, pointerReg, remainingReg, oneReg, bitReg, + activeReg] using hinv.one_eq + · simpa [continuedStore, decremented, moved, loaded, Basic.exec, + verdictReg, valueReg, pointerReg, remainingReg, oneReg, bitReg, + activeReg] using hinv.active_eq + · intro offset + rw [continued_high store _ (by simp [inputBase]; omega)] + have hinput := hinv.input_eq (offset + 1) + convert hinput using 1 + all_goals simp [Nat.add_assoc, Nat.add_comm, Nat.add_left_comm] + +private theorem decodeAux?_eq_map (bits : List Bool) (acc : ℕ) : + CircuitCode.NatCode.decodeAux? bits acc = + (CircuitCode.NatCode.decodePrefix? bits).map fun result => + (acc + result.1, result.2) := by + induction bits generalizing acc with + | nil => simp [CircuitCode.NatCode.decodeAux?, CircuitCode.NatCode.decodePrefix?] + | cons bit rest ih => + cases bit with + | false => + simp [CircuitCode.NatCode.decodeAux?, CircuitCode.NatCode.decodePrefix?] + | true => + rw [CircuitCode.NatCode.decodeAux?] + rw [ih (acc + 1)] + have htrue : CircuitCode.NatCode.decodePrefix? (true :: rest) = + CircuitCode.NatCode.decodeAux? rest 1 := rfl + rw [htrue] + rw [ih 1] + cases hdecode : CircuitCode.NatCode.decodePrefix? rest with + | none => simp + | some result => + rcases result with ⟨value, suffix⟩ + simp [Nat.add_assoc] + +private theorem decodePrefix?_true (rest : List Bool) : + CircuitCode.NatCode.decodePrefix? (true :: rest) = + (CircuitCode.NatCode.decodePrefix? rest).map fun result => + (result.1 + 1, result.2) := by + rw [CircuitCode.NatCode.decodePrefix?, CircuitCode.NatCode.decodeAux?] + rw [decodeAux?_eq_map] + cases hdecode : CircuitCode.NatCode.decodePrefix? rest with + | none => simp + | some result => + rcases result with ⟨value, suffix⟩ + simp [Nat.add_comm] + +private theorem loop_measured {remaining : List Bool} + {inputLength offset value : ℕ} {store : Store} + (hinv : LoopInv inputLength remaining offset value store) : + ∃ final, + MeasuredRuns mainLoop store final + (match CircuitCode.NatCode.decodePrefix? remaining with + | none => 10 * remaining.length + 6 + | some (value, _) => 10 * value + 11) + (64 * (remaining.length + 1) * width inputLength) + (resourceSpace inputLength) ∧ + (match CircuitCode.NatCode.decodePrefix? remaining with + | none => + final verdictReg = 0 ∧ final valueReg = value + remaining.length ∧ + final pointerReg = inputBase + inputLength ∧ final remainingReg = 0 + | some (decoded, rest) => + final verdictReg = 1 ∧ final valueReg = value + decoded ∧ + final pointerReg = inputBase + offset + decoded + 1 ∧ + final remainingReg = rest.length) ∧ + final activeReg = 0 ∧ + final oneReg = 1 ∧ + (∀ index, inputBase ≤ index → final index = store index) ∧ + StoreBound inputLength final := by + induction remaining generalizing offset value store with + | nil => + have hremaining : store remainingReg = 0 := by + simpa using hinv.remaining_eq + obtain ⟨hbody, htruncatedBound⟩ := truncated_measured hinv.store_bound + have hbodyRun := MeasuredRuns.ifZeroEnvelope (onNonzero := consume) + hremaining hinv.store_bound hbody + have hactive : store activeReg ≠ 0 := by rw [hinv.active_eq]; decide + have hfinalActive : truncatedStore store activeReg = 0 := by + simp [truncatedStore, Basic.execList, Basic.exec, activeReg, verdictReg] + have hstop := MeasuredRuns.whileZeroEnvelope (body := body) + hfinalActive htruncatedBound + have hrun := MeasuredRuns.whileNonzeroEnvelope hactive hinv.store_bound + (by simpa [body] using hbodyRun) hstop + refine ⟨truncatedStore store, ?_, ?_, ?_, ?_, ?_, htruncatedBound⟩ + · apply MeasuredRuns.weakenCost (by simpa [mainLoop] using hrun) + change 3 * width inputLength + + (width inputLength + 8 * width inputLength) + + width inputLength ≤ + 64 * ([].length + 1) * width inputLength + simp only [List.length_nil, zero_add] + omega + · simp only [CircuitCode.NatCode.decodePrefix?, + CircuitCode.NatCode.decodeAux?] + have htotal := hinv.total_eq + have hvalue := hinv.value_eq + have hpointer := hinv.pointer_eq + have hremainingStore := hinv.remaining_eq + simp only [List.length_nil, Nat.add_zero] at htotal + have hvalue' : store 1 = value := by simpa [valueReg] using hvalue + have hpointer' : store 2 = inputBase + offset := by + simpa [pointerReg] using hpointer + have hremaining' : store 3 = 0 := by + simpa [remainingReg] using hremainingStore + simp [truncatedStore, Basic.execList, Basic.exec, verdictReg, valueReg, + pointerReg, remainingReg, activeReg, hvalue', hpointer', hremaining'] + omega + · simp [truncatedStore, Basic.execList, Basic.exec, activeReg, verdictReg] + · simpa [truncatedStore, Basic.execList, Basic.exec, oneReg, activeReg, + verdictReg] using hinv.one_eq + · intro index hindex + exact truncated_high store index hindex + | cons bit rest ih => + cases bit with + | false => + obtain ⟨hbody, hsuccessBound⟩ := false_body_measured hinv + have hactive : store activeReg ≠ 0 := by rw [hinv.active_eq]; decide + have hfinalActive : successStore store activeReg = 0 := by + simp [successStore, Basic.execList, Basic.exec, activeReg, verdictReg, + decremented, moved, loaded, remainingReg, pointerReg, bitReg] + have hstop := MeasuredRuns.whileZeroEnvelope (body := body) + hfinalActive hsuccessBound + have hrun := MeasuredRuns.whileNonzeroEnvelope hactive hinv.store_bound + hbody hstop + refine ⟨successStore store, ?_, ?_, ?_, ?_, ?_, hsuccessBound⟩ + · apply MeasuredRuns.weakenCost (by simpa [mainLoop] using hrun) + change 3 * width inputLength + 32 * width inputLength + + width inputLength ≤ + 64 * ((false :: rest).length + 1) * width inputLength + calc + _ = 36 * width inputLength := by ring + _ ≤ (64 * (rest.length + 2)) * width inputLength := + Nat.mul_le_mul_right _ (by omega) + _ = _ := by simp only [List.length_cons] + · simp only [CircuitCode.NatCode.decodePrefix?, + CircuitCode.NatCode.decodeAux?] + have hvalue := hinv.value_eq + have hpointer := hinv.pointer_eq + have hremaining : store remainingReg = rest.length + 1 := by + simpa using hinv.remaining_eq + have hone := hinv.one_eq + simp [successStore, Basic.execList, decremented, moved, loaded, + Basic.exec, verdictReg, valueReg, pointerReg, remainingReg, oneReg, + bitReg, activeReg] + have hvalue' : store 1 = value := by simpa [valueReg] using hvalue + have hpointer' : store 2 = inputBase + offset := by + simpa [pointerReg] using hpointer + have hremaining' : store 3 = rest.length + 1 := by + simpa [remainingReg] using hremaining + have hone' : store 4 = 1 := by simpa [oneReg] using hone + omega + · simp [successStore, Basic.execList, Basic.exec, activeReg, + verdictReg, decremented, moved, loaded, remainingReg, pointerReg, + bitReg] + · simpa [successStore, Basic.execList, Basic.exec, oneReg, activeReg, + verdictReg, decremented, moved, loaded, remainingReg, pointerReg, + bitReg] using hinv.one_eq + · intro index hindex + exact success_high store index hindex + | true => + obtain ⟨hbody, hnextInv⟩ := true_body_measured hinv + obtain ⟨final, hloop, hfinal, hactiveFinal, honeFinal, hframe, + hfinalBound⟩ := ih hnextInv + have hactive : store activeReg ≠ 0 := by rw [hinv.active_eq]; decide + have hrun := MeasuredRuns.whileNonzeroEnvelope hactive hinv.store_bound + hbody hloop + refine ⟨final, ?_, ?_, hactiveFinal, honeFinal, ?_, hfinalBound⟩ + · rw [decodePrefix?_true] + cases hdecode : CircuitCode.NatCode.decodePrefix? rest with + | none => + rw [hdecode] at hrun + simp only at hrun + have hrun' : MeasuredRuns mainLoop store final + (10 * (rest.length + 1) + 6) + (3 * width inputLength + 32 * width inputLength + + 64 * (rest.length + 1) * width inputLength) + (resourceSpace inputLength) := by + rw [mainLoop] + convert hrun using 1 + all_goals omega + apply MeasuredRuns.weakenCost hrun' + change 3 * width inputLength + 32 * width inputLength + + (64 * (rest.length + 1) * width inputLength) ≤ + 64 * ((true :: rest).length + 1) * width inputLength + calc + _ = (64 * (rest.length + 1) + 35) * width inputLength := by ring + _ ≤ (64 * (rest.length + 2)) * width inputLength := + Nat.mul_le_mul_right _ (by omega) + _ = _ := by simp only [List.length_cons] + | some result => + rcases result with ⟨value, suffix⟩ + rw [hdecode] at hrun + simp only at hrun + have hrun' : MeasuredRuns mainLoop store final + (10 * (value + 1) + 11) + (3 * width inputLength + 32 * width inputLength + + 64 * (rest.length + 1) * width inputLength) + (resourceSpace inputLength) := by + rw [mainLoop] + convert hrun using 1 + all_goals omega + apply MeasuredRuns.weakenCost hrun' + change 3 * width inputLength + 32 * width inputLength + + (64 * (rest.length + 1) * width inputLength) ≤ + 64 * ((true :: rest).length + 1) * width inputLength + calc + _ = (64 * (rest.length + 1) + 35) * width inputLength := by ring + _ ≤ (64 * (rest.length + 2)) * width inputLength := + Nat.mul_le_mul_right _ (by omega) + _ = _ := by simp only [List.length_cons] + · rw [decodePrefix?_true] + cases hdecode : CircuitCode.NatCode.decodePrefix? rest with + | none => + simpa [hdecode, Nat.add_assoc, Nat.add_comm, Nat.add_left_comm] + using hfinal + | some result => + rcases result with ⟨decoded, suffix⟩ + rw [hdecode] at hfinal + simp only [Option.map_some] + simpa [Nat.add_assoc, Nat.add_comm, Nat.add_left_comm] using hfinal + · intro index hindex + rw [hframe index hindex] + exact continued_high store index hindex + +theorem mainLoop_measured_internal {remaining : List Bool} + {inputLength offset value : ℕ} {store : Store} + (hready : CursorReady inputLength remaining offset value store) + (hbound : Internal.StoreEnvelope (inputLength + inputBase) + (inputLength + inputBase) store) : + ∃ final cost space, + Exec mainLoop store final (loopStepCount remaining) cost space ∧ + cost ≤ timeBound inputLength ∧ space ≤ spaceBound inputLength ∧ + (match CircuitCode.NatCode.decodePrefix? remaining with + | none => + final verdictReg = 0 ∧ final valueReg = value + remaining.length ∧ + final pointerReg = inputBase + inputLength ∧ final remainingReg = 0 + | some (decoded, rest) => + final verdictReg = 1 ∧ final valueReg = value + decoded ∧ + final pointerReg = inputBase + offset + decoded + 1 ∧ + final remainingReg = rest.length) ∧ + final activeReg = 0 ∧ + final oneReg = 1 ∧ + (∀ index, inputBase ≤ index → final index = store index) ∧ + Internal.StoreEnvelope (inputLength + inputBase) + (inputLength + inputBase) final := by + have hinv := loopInv_of_cursorReady hready hbound + obtain ⟨final, hrun, hresult, hactive, hone, hframe, hfinalBound⟩ := + loop_measured hinv + obtain ⟨cost, space, hexec, hcost, hspace⟩ := hrun + have hremaining : remaining.length ≤ inputLength := by + have htotal := hready.total_eq + omega + have hcostBound : + 64 * (remaining.length + 1) * width inputLength ≤ + timeBound inputLength := by + rw [timeBound] + change 64 * (remaining.length + 1) * width inputLength ≤ + 96 * (inputLength + 1) * width inputLength + apply Nat.mul_le_mul_right + omega + have hspaceBound : space ≤ spaceBound inputLength := by + rw [← envelopeSpace_eq_spaceBound] + exact hspace + refine ⟨final, cost, space, ?_, le_trans hcost hcostBound, hspaceBound, + hresult, hactive, hone, hframe, hfinalBound⟩ + simpa [loopStepCount] using hexec + +theorem program_measured_internal (bits : List Bool) : + ∃ final cost space, + Exec program (inputStore bits) final (stepCount bits) cost space ∧ + cost ≤ timeBound bits.length ∧ space ≤ spaceBound bits.length ∧ + match CircuitCode.NatCode.decodePrefix? bits with + | none => + final verdictReg = 0 ∧ final valueReg = bits.length ∧ + final pointerReg = inputBase + bits.length ∧ final remainingReg = 0 + | some (value, rest) => + final verdictReg = 1 ∧ final valueReg = value ∧ + final pointerReg = inputBase + value + 1 ∧ + final remainingReg = rest.length := by + obtain ⟨hsetup, hsetupBound⟩ := setup_measured bits + have hsetupInv := setup_inv bits hsetupBound + obtain ⟨final, hloop, hfinal, _hactive, _hone, _hframe, _hfinalBound⟩ := + loop_measured hsetupInv + have hseq := hsetup.seq hloop + have hcostLe : + 20 * width bits.length + + 64 * (bits.length + 1) * width bits.length ≤ + timeBound bits.length := by + rw [timeBound] + change 20 * width bits.length + + 64 * (bits.length + 1) * width bits.length ≤ + 96 * (bits.length + 1) * width bits.length + calc + _ = (64 * (bits.length + 1) + 20) * width bits.length := by ring + _ ≤ (96 * (bits.length + 1)) * width bits.length := + Nat.mul_le_mul_right _ (by omega) + _ = _ := by ring + have hprogram := hseq.weakenCost hcostLe + have hprogram' : MeasuredRuns program (inputStore bits) final + (stepCount bits) (timeBound bits.length) (resourceSpace bits.length) := by + rw [program] + cases hdecode : CircuitCode.NatCode.decodePrefix? bits with + | none => + rw [hdecode] at hprogram + simp only at hprogram + convert hprogram using 1 + all_goals simp [stepCount, hdecode] + all_goals omega + | some result => + rcases result with ⟨value, suffix⟩ + rw [hdecode] at hprogram + simp only at hprogram + convert hprogram using 1 + all_goals simp [stepCount, hdecode] + all_goals omega + obtain ⟨cost, space, hexec, hcost, hspace⟩ := hprogram' + have hspace' : space ≤ spaceBound bits.length := by + rw [← envelopeSpace_eq_spaceBound] + exact hspace + refine ⟨final, cost, space, hexec, hcost, hspace', ?_⟩ + cases hdecode : CircuitCode.NatCode.decodePrefix? bits with + | none => + rw [hdecode] at hfinal + simpa [hdecode] using hfinal + | some result => + rcases result with ⟨value, suffix⟩ + rw [hdecode] at hfinal + simpa [hdecode] using hfinal + +end UnaryDecode + +end Structured + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine.lean new file mode 100644 index 0000000000..62ad7457dc --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine.lean @@ -0,0 +1,905 @@ +/- +Copyright (c) 2025 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import Mathlib.Data.Fintype.Pi +public import Mathlib.Data.Rat.Init +public import Std.Tactic.BVDecide.Normalize.Prop + +/-! +# Turing machines + +This file defines the library's base model of computation: multi-tape +deterministic and nondeterministic Turing machines over a fixed four-symbol +alphabet, with named input/work/output tapes. The model's shape follows +Arora–Barak (*Computational Complexity: A Modern Approach*, Definitions +1.1–1.4 and 2.1), with the conventions below enforced structurally. + +## Main definitions + +- `Γ` — the tape alphabet `{0, 1, □, ▷}` (read alphabet) +- `Γw` — the writable alphabet `{0, 1, □}` (write alphabet; `▷` cannot be written) +- `Dir3` — three-way tape head direction (left, right, stay) +- `Tape` — a one-sided infinite tape; cell 0 is leftmost and permanently `▷` +- `Cfg` — a machine configuration with named tapes (input, work, output) +- `TM` — a deterministic multi-tape Turing machine (AB Definition 1.1) +- `NTM` — a nondeterministic TM with two transition functions (AB Definition 2.1) +- `TM.stepRel`, `TM.reaches`, `TM.reachesIn` — deterministic step relation and reachability +- `NTM.trace` — execute an NTM for a fixed choice sequence (canonical NTM execution) +- `Tape.HasOutput` — predicate: tape contains a given binary string as output +- `TM.ComputesInTime` — computing a function in bounded time (AB Definition 1.4) +- `TM.Computes` — computing a function (existential over time bound) +- `TM.Accepts`, `TM.AcceptsInTime` — deterministic acceptance +- `NTM.Accepts`, `NTM.AcceptsInTime` — nondeterministic acceptance (existential) +- `Cfg.WithinAuxSpace`, `Cfg.WithinDecisionSpace` — honest tape-space bounds +- `TM.DecidesInTime`, `NTM.DecidesInTime` — deciding a language within a time bound +- `TM.DecidesInTimeSpace` — deciding with simultaneous time and space bounds +- `NTM.acceptCount`, `NTM.acceptProb` — counting/probabilistic acceptance +- `TM.toNTM` — embed a DTM into an NTM + +## Design notes + +- **One-sided tapes**: `Tape` uses `head : ℕ` and `cells : ℕ → Γ`. Cell 0 is leftmost; + moving left at position 0 is a no-op (`Nat` subtraction saturates). +- **Immutable cell 0**: `Tape.write` is a no-op when the head is at position 0, ensuring + `▷` at cell 0 is permanent. Combined with `Γw` (which excludes `▷`), this guarantees `▷` + appears only at cell 0 on every tape. +- **Read vs write alphabet**: The transition function reads `Γ = {0, 1, □, ▷}` but writes + `Γw = {0, 1, □}`, so `δ` structurally cannot write `▷`. +- **Finite state**: `Q` carries `[Fintype Q]`; the state space is finite. +- **Output**: Read from cell 1 of the output tape (first cell after `▷`); machine output + is the binary string written after `▷`. +- **Named tapes**: `Cfg` has `input`, `work`, `output` fields rather than `Fin k → Tape`, + making the read-only/read-write distinction structural. +- **NTM execution**: Defined via `trace` (a fixed choice sequence), not a relational step. +-/ + + +@[expose] public section + +namespace Complexity + +/-- The tape alphabet Γ = {0, 1, □, ▷}. -/ +inductive Γ where + | zero | one | blank | start + deriving Repr, DecidableEq + +instance : Fintype Γ where + elems := {.zero, .one, .blank, .start} + complete := fun x => by cases x <;> simp + +instance : Inhabited Γ := ⟨Γ.blank⟩ + +/-- The writable alphabet Γw = {0, 1, □}. The start symbol `▷` cannot be written by a + transition function — this is enforced structurally by using `Γw` in the output of `δ`. -/ +inductive Γw where + | zero | one | blank + deriving Repr, DecidableEq + +instance : Fintype Γw where + elems := {.zero, .one, .blank} + complete := fun x => by cases x <;> simp + +/-- Embed a writable symbol into the full alphabet. -/ +@[simp] def Γw.toΓ : Γw → Γ + | .zero => .zero + | .one => .one + | .blank => .blank + +instance : Coe Γw Γ where coe := Γw.toΓ + +/-- A writable symbol is never the left-end marker. -/ +theorem Γw.toΓ_ne_start (s : Γw) : s.toΓ ≠ Γ.start := by + cases s <;> decide + +/-- Convert a boolean to an alphabet symbol. -/ +def Γ.ofBool : Bool → Γ + | false => .zero + | true => .one + +/-- A Boolean tape symbol is never the left-end marker. -/ +theorem Γ.ofBool_ne_start (b : Bool) : Γ.ofBool b ≠ Γ.start := by + cases b <;> decide + +/-- A Boolean tape symbol is never blank. -/ +theorem Γ.ofBool_ne_blank (b : Bool) : Γ.ofBool b ≠ Γ.blank := by + cases b <;> decide + +/-- Convert a boolean to a writable symbol. -/ +def Γw.ofBool : Bool → Γw + | false => .zero + | true => .one + +theorem Γw.ofBool_toΓ (b : Bool) : (Γw.ofBool b).toΓ = Γ.ofBool b := by + cases b <;> rfl + +/-- Three-way tape head direction: left, right, or stay. -/ +inductive Dir3 where + | left | right | stay + deriving Repr, DecidableEq + +instance : Fintype Dir3 where + elems := {.left, .right, .stay} + complete := fun x => by cases x <;> simp + +/-- A one-sided infinite tape. Cell 0 is the leftmost cell and permanently + contains `▷`. The head cannot move left of cell 0 (moving left at position 0 + is a no-op via `Nat` subtraction). Writing at cell 0 is a no-op, + preserving `▷`. -/ +@[ext] +structure Tape where + /-- The head position; cell 0 is the leftmost cell. -/ + head : ℕ + /-- The tape contents, one symbol per cell. -/ + cells : ℕ → Γ + +namespace Tape + +/-- Read the symbol under the head. -/ +def read (t : Tape) : Γ := t.cells t.head + +/-- Write a symbol at the head position. Writing at cell 0 is a no-op, + preserving the start symbol `▷`. -/ +def write (t : Tape) (s : Γ) : Tape := + if t.head = 0 then t + else { t with cells := Function.update t.cells t.head s } + +/-- Writing changes tape contents but preserves the head position. -/ +theorem write_head (t : Tape) (s : Γ) : (t.write s).head = t.head := by + simp only [write] + split <;> rfl + +/-- Move the head according to a three-way direction. + Moving left at position 0 stays at 0 (`Nat` subtraction saturates). -/ +def move (t : Tape) (d : Dir3) : Tape := + match d with + | .left => { t with head := t.head - 1 } + | .right => { t with head := t.head + 1 } + | .stay => t + +/-- Moving changes the head position but preserves tape contents. -/ +theorem move_cells (t : Tape) (d : Dir3) : (t.move d).cells = t.cells := by + cases d <;> rfl + +/-- Moving changes the head position by at most one. -/ +theorem head_move_le (t : Tape) (d : Dir3) : (t.move d).head ≤ t.head + 1 := by + cases d <;> (simp only [move]; omega) + +/-- The tape contains output `y : List Bool` starting at cell 1: + cells 1 through |y| match `y`, and cell |y| + 1 is blank. + Output is the binary string written on the output tape after `▷`. -/ +def HasOutput (t : Tape) (y : List Bool) : Prop := + (∀ (i : ℕ) (h : i < y.length), + t.cells (i + 1) = Γ.ofBool (y[i]'h)) ∧ + t.cells (y.length + 1) = Γ.blank + +/-- `HasOutput` depends only on the tape cells, not the head position. -/ +theorem hasOutput_congr {t₁ t₂ : Tape} (h : t₁.cells = t₂.cells) (y : List Bool) : + t₁.HasOutput y ↔ t₂.HasOutput y := by + simp only [HasOutput, h] + +instance decidableHasOutput (t : Tape) (y : List Bool) : Decidable (t.HasOutput y) := + if h : (∀ i : Fin y.length, t.cells (i.val + 1) = Γ.ofBool (y[i.val]'i.isLt)) ∧ + t.cells (y.length + 1) = Γ.blank + then isTrue ⟨fun i hi => h.1 ⟨i, hi⟩, h.2⟩ + else isFalse (fun ⟨h1, h2⟩ => h ⟨fun i => h1 i.val i.isLt, h2⟩) + +/-- Write a symbol and move in one step. -/ +abbrev writeAndMove (t : Tape) (s : Γ) (d : Dir3) : Tape := + (t.write s).move d + +/-- `t.StartInvariant` says the left-end marker `▷` sits at cell 0 and + nowhere else — the standing shape of every tape reachable from an + initial configuration, since writes exclude `▷` and cell 0 is + immutable. -/ +def StartInvariant (t : Tape) : Prop := + t.cells 0 = Γ.start ∧ ∀ j, 1 ≤ j → t.cells j ≠ Γ.start + +/-- Under the invariant, a head at position ≥ 1 never reads `▷`. -/ +theorem StartInvariant.read_ne_start {t : Tape} (h : t.StartInvariant) + (hhead : 1 ≤ t.head) : t.read ≠ Γ.start := by + simp only [read]; exact h.2 t.head hhead + +/-- Writing (any `Γw` symbol) preserves the invariant. -/ +theorem StartInvariant.write {t : Tape} (h : t.StartInvariant) (s : Γw) : + (t.write s.toΓ).StartInvariant := by + unfold Tape.write + split + · exact h + · next hne => + refine ⟨?_, fun j hj => ?_⟩ + · show Function.update t.cells t.head s.toΓ 0 = Γ.start + rw [Function.update_of_ne (Ne.symm hne)]; exact h.1 + · show Function.update t.cells t.head s.toΓ j ≠ Γ.start + by_cases hje : j = t.head + · subst hje + rw [Function.update_self] + cases s <;> simp [Γw.toΓ] + · rw [Function.update_of_ne hje]; exact h.2 j hj + +/-- Moving preserves the invariant (cells unchanged). -/ +theorem StartInvariant.move {t : Tape} (h : t.StartInvariant) (d : Dir3) : + (t.move d).StartInvariant := by + cases d <;> exact h + +/-- Writing a `Γw` symbol and moving preserves the invariant. -/ +theorem StartInvariant.writeAndMove {t : Tape} (h : t.StartInvariant) + (s : Γw) (d : Dir3) : (t.writeAndMove s.toΓ d).StartInvariant := + (h.write s).move d + +/-- One write-and-move step advances the head by at most one. -/ +theorem head_writeAndMove_le (t : Tape) (s : Γ) (d : Dir3) : + (t.writeAndMove s d).head ≤ t.head + 1 := by + have h := head_move_le (t.write s) d + rwa [write_head] at h + +end Tape + +/-- Initialize a tape: `▷` at cell 0, `contents` at cells 1, 2, ..., `□` elsewhere. + Head starts at position 0 (on `▷`). -/ +def Tape.init (contents : List Γ) : Tape where + head := 0 + cells := fun i => + if i = 0 then Γ.start + else (contents[i - 1]?).getD Γ.blank + +/-- An initialized tape starts with its head on the left-end marker. -/ +@[simp] theorem Tape.init_head (contents : List Γ) : + (Tape.init contents).head = 0 := rfl + +/-- Cell zero of an initialized tape is the left-end marker. -/ +@[simp] theorem Tape.init_cells_zero (contents : List Γ) : + (Tape.init contents).cells 0 = Γ.start := by + simp [Tape.init] + +/-- Cell `i + 1` of an initialized tape contains item `i`, or blank when `i` + lies beyond the initialized contents. -/ +theorem Tape.init_cells_succ (contents : List Γ) (i : ℕ) : + (Tape.init contents).cells (i + 1) = (contents[i]?).getD Γ.blank := by + simp [Tape.init] + +/-- Cells beyond the initialized contents are blank. -/ +theorem Tape.init_cells_ge (contents : List Γ) (i : ℕ) + (h : contents.length ≤ i) : + (Tape.init contents).cells (i + 1) = Γ.blank := by + rw [Tape.init_cells_succ, List.getElem?_eq_none h] + rfl + +/-- Every positive-indexed cell of the empty initialized tape is blank. -/ +@[simp] theorem Tape.init_nil_cells_succ (i : ℕ) : + (Tape.init []).cells (i + 1) = Γ.blank := by + exact Tape.init_cells_ge [] i (by simp) + +/-- No positive-indexed cell of the empty initialized tape is a start marker. -/ +theorem Tape.init_nil_cells_ne_start (j : ℕ) (hj : 1 ≤ j) : + (Tape.init []).cells j ≠ Γ.start := by + obtain ⟨i, rfl⟩ : ∃ i, j = i + 1 := ⟨j - 1, by omega⟩ + rw [Tape.init_nil_cells_succ] + decide + +/-- Within the initialized Boolean contents, cell `i + 1` stores bit `i`. -/ +theorem Tape.init_ofBool_cells_lt (contents : List Bool) (i : ℕ) + (h : i < contents.length) : + (Tape.init (contents.map Γ.ofBool)).cells (i + 1) = Γ.ofBool (contents[i]'h) := by + rw [Tape.init_cells_succ] + have hmap : i < (contents.map Γ.ofBool).length := by simpa using h + rw [List.getElem?_eq_getElem hmap] + simp + +/-- Beyond the initialized Boolean contents, cell `i + 1` is blank. -/ +theorem Tape.init_ofBool_cells_ge (contents : List Bool) (i : ℕ) + (h : contents.length ≤ i) : + (Tape.init (contents.map Γ.ofBool)).cells (i + 1) = Γ.blank := by + exact Tape.init_cells_ge (contents.map Γ.ofBool) i (by simpa using h) + +/-- No positive-indexed cell of a Boolean-initialized tape contains the + left-end marker. -/ +theorem Tape.init_ofBool_cells_ne_start (contents : List Bool) (j : ℕ) (hj : 1 ≤ j) : + (Tape.init (contents.map Γ.ofBool)).cells j ≠ Γ.start := by + obtain ⟨i, rfl⟩ : ∃ i, j = i + 1 := ⟨j - 1, by omega⟩ + by_cases hi : i < contents.length + · rw [Tape.init_ofBool_cells_lt contents i hi] + exact Γ.ofBool_ne_start _ + · rw [Tape.init_ofBool_cells_ge contents i (Nat.le_of_not_gt hi)] + decide + +/-- Moving an empty initialized tape to cell one reads blank. -/ +@[simp] theorem Tape.init_nil_move_right_read : + ((Tape.init []).move Dir3.right).read = Γ.blank := by + simp [Tape.read, Tape.move] + +/-- A Boolean-initialized tape moved to its first data cell never reads the + left-end marker. -/ +theorem Tape.init_ofBool_move_right_read_ne_start (contents : List Bool) : + ((Tape.init (contents.map Γ.ofBool)).move Dir3.right).read ≠ Γ.start := by + simp only [Tape.read, Tape.move] + exact Tape.init_ofBool_cells_ne_start contents 1 (by omega) + +/-- An initialized tape whose contents avoid `▷` satisfies the invariant. -/ +theorem Tape.StartInvariant.init (xs : List Γ) (hxs : ∀ a ∈ xs, a ≠ Γ.start) : + (Tape.init xs).StartInvariant := by + refine ⟨rfl, ?_⟩ + intro j hj + simp only [Tape.init, show j ≠ 0 by omega, ↓reduceIte] + cases h : xs[j - 1]? with + | none => simp + | some a => + simp only [Option.getD_some] + exact hxs a (List.mem_of_getElem? h) + +/-- A Boolean-initialized tape satisfies the invariant. -/ +theorem Tape.StartInvariant.init_ofBool (xs : List Bool) : + (Tape.init (xs.map Γ.ofBool)).StartInvariant := by + refine Tape.StartInvariant.init _ ?_ + intro a ha + rw [List.mem_map] at ha + obtain ⟨b, _, rfl⟩ := ha + cases b <;> simp [Γ.ofBool] + +/-- The empty initialized tape satisfies the invariant. -/ +theorem Tape.StartInvariant.init_nil : (Tape.init []).StartInvariant := by + refine ⟨rfl, ?_⟩ + intro j hj + simp only [Tape.init, show j ≠ 0 by omega, ↓reduceIte] + simp + +/-- After stepping onto cell 1 of an empty initialized tape, no positive + cell holds the left-end marker. -/ +theorem Tape.init_nil_move_right_cells_ne_start (j : ℕ) (hj : j ≥ 1) : + ((Tape.init []).move Dir3.right).cells j ≠ Γ.start := by + rw [Tape.move_cells] + simp [Tape.init, show j ≠ 0 by omega] + +/-- Moving the head does not introduce a left-end marker in the positive cells + of a Boolean-initialized tape. -/ +theorem Tape.init_ofBool_move_right_cells_ne_start (contents : List Bool) : + ∀ j, 1 ≤ j → + ((Tape.init (contents.map Γ.ofBool)).move Dir3.right).cells j ≠ Γ.start := by + intro j hj + rw [Tape.move_cells] + exact Tape.init_ofBool_cells_ne_start contents j hj + +/-- A language is a set of binary strings. -/ +abbrev Language := Set (List Bool) + +/-- A configuration of a Turing machine with `n` work tapes: + a read-only input tape, `n` read-write work tapes, and a read-write output tape. -/ +structure Cfg (n : ℕ) (Q : Type) where + /-- The current machine state. -/ + state : Q + /-- The read-only input tape. -/ + input : Tape + /-- The `n` read-write work tapes. -/ + work : Fin n → Tape + /-- The read-write output tape. -/ + output : Tape + +namespace Cfg + +/-- Two machine configurations are equal when their named components agree. -/ +@[ext] theorem ext {c c' : Cfg n Q} + (hstate : c.state = c'.state) (hinput : c.input = c'.input) + (hwork : c.work = c'.work) (houtput : c.output = c'.output) : c = c' := by + cases c + cases c' + simp_all + +/-- Initial configuration for any TM: input on the input tape, all tapes start with `▷`. -/ +abbrev init (qstart : Q) (x : List Bool) : Cfg n Q := + { state := qstart + input := Tape.init (x.map Γ.ofBool) + work := fun _ => Tape.init [] + output := Tape.init [] } + +/-- A configuration is halted when its state equals the halt state. -/ +abbrev isHalted (qhalt : Q) (c : Cfg n Q) : Prop := + c.state = qhalt + +/-- The auxiliary-space bound for a configuration on an input of length + `inputLength`. Work-tape cells through `space` are available, while the + input itself and its first trailing blank are free; travel farther into the + input tape's blank tail is charged against `space`. + + This predicate deliberately omits the output tape. It is suitable for + function computation only when the machine also satisfies the one-way + output discipline `TM.IsTransducer`. -/ +def WithinAuxSpace (c : Cfg n Q) (inputLength space : ℕ) : Prop := + (∀ i, (c.work i).head ≤ space) ∧ + c.input.head ≤ inputLength + space + 1 + +/-- The space bound for a language-decider configuration. In addition to + `WithinAuxSpace`, the output head is bounded by `space + 1`: cell 1 is the + free verdict cell, and any farther two-way output-tape travel is charged. -/ +def WithinDecisionSpace (c : Cfg n Q) (inputLength space : ℕ) : Prop := + c.WithinAuxSpace inputLength space ∧ c.output.head ≤ space + 1 + +end Cfg + +/-- A deterministic Turing machine with `n` work tapes. + + The machine has a read-only input tape, `n` read-write work tapes, and a read-write + output tape. The transition function reads `Γ` from all tape heads but writes only + `Γw` (excluding `▷`) to work and output tapes. `Q` is finite. -/ +structure TM (n : ℕ) where + /-- The (finite) type of machine states. -/ + Q : Type + [decEq : DecidableEq Q] + [finQ : Fintype Q] + /-- The designated start state. -/ + qstart : Q + /-- The designated halt state. -/ + qhalt : Q + /-- The transition function: from the current state and the symbols under + the input, work, and output heads, produce the next state, the symbols + to write on the work and output tapes, and a direction for every head. -/ + δ : Q → Γ → (Fin n → Γ) → Γ → + Q × (Fin n → Γw) × Γw × Dir3 × (Fin n → Dir3) × Dir3 + /-- Reading the left-end marker forces that head to move right, so no head + ever falls off the left edge. -/ + δ_right_of_start : ∀ (q : Q) (iHead : Γ) (wHeads : Fin n → Γ) (oHead : Γ), + let (_, _, _, inDir, workDirs, outDir) := δ q iHead wHeads oHead + (iHead = Γ.start → inDir = Dir3.right) ∧ + (∀ i, wHeads i = Γ.start → workDirs i = Dir3.right) ∧ + (oHead = Γ.start → outDir = Dir3.right) + +attribute [instance] TM.decEq TM.finQ + +/-- A nondeterministic Turing machine with two transition functions. + + The same structure is used for probabilistic TMs — only the acceptance + criterion differs (existential for NTM, counting for PTM). `Q` is finite. -/ +structure NTM (n : ℕ) where + /-- The (finite) type of machine states. -/ + Q : Type + [decEq : DecidableEq Q] + [finQ : Fintype Q] + /-- The designated start state. -/ + qstart : Q + /-- The designated halt state. -/ + qhalt : Q + /-- The two transition functions, selected by the `Bool` choice bit; each + has the same shape as the deterministic `TM.δ`. -/ + δ : Bool → Q → Γ → (Fin n → Γ) → Γ → + Q × (Fin n → Γw) × Γw × Dir3 × (Fin n → Dir3) × Dir3 + /-- Reading the left-end marker forces that head to move right, on both + branches. -/ + δ_right_of_start : ∀ (b : Bool) (q : Q) (iHead : Γ) (wHeads : Fin n → Γ) (oHead : Γ), + let (_, _, _, inDir, workDirs, outDir) := δ b q iHead wHeads oHead + (iHead = Γ.start → inDir = Dir3.right) ∧ + (∀ i, wHeads i = Γ.start → workDirs i = Dir3.right) ∧ + (oHead = Γ.start → outDir = Dir3.right) + +attribute [instance] NTM.decEq NTM.finQ + +namespace TM + +variable {n : ℕ} + +/-- Step a deterministic TM by one step. Returns `none` if halted. -/ +def step (tm : TM n) (c : Cfg n tm.Q) : Option (Cfg n tm.Q) := + if c.state = tm.qhalt then none + else + let (q', workWrites, outWrite, inDir, workDirs, outDir) := + tm.δ c.state c.input.read (fun i => (c.work i).read) c.output.read + some + { state := q' + input := c.input.move inDir + work := fun i => (c.work i).writeAndMove (workWrites i) (workDirs i) + output := c.output.writeAndMove outWrite outDir } + +/-- Initial configuration: input on the input tape, all tapes start with `▷`. -/ +abbrev initCfg (tm : TM n) (x : List Bool) : Cfg n tm.Q := + Cfg.init tm.qstart x + +/-- A configuration is halted when its state is `qhalt`. -/ +abbrev halted (tm : TM n) (c : Cfg n tm.Q) : Prop := + Cfg.isHalted tm.qhalt c + +/-- If `step` returns `some`, the machine was not halted. -/ +theorem state_ne_qhalt_of_step {tm : TM n} {c c' : Cfg n tm.Q} + (h : tm.step c = some c') : c.state ≠ tm.qhalt := + fun heq => by simp [step, heq] at h + +/-- One-step relation for a deterministic TM. -/ +def stepRel (tm : TM n) (c c' : Cfg n tm.Q) : Prop := tm.step c = some c' + +/-- Reflexive-transitive closure of the step relation. -/ +def reaches (tm : TM n) : Cfg n tm.Q → Cfg n tm.Q → Prop := + Relation.ReflTransGen tm.stepRel + +/-- Reachability in exactly `t` steps. -/ +inductive reachesIn (tm : TM n) : ℕ → Cfg n tm.Q → Cfg n tm.Q → Prop where + | zero : reachesIn tm 0 c c + | step : tm.step c = some c'' → reachesIn tm t c'' c' → reachesIn tm (t + 1) c c' + +/-- DTM accepts `x`: reaches `qhalt` with output cell 1 (after `▷`) = `1`. -/ +def Accepts (tm : TM n) (x : List Bool) : Prop := + ∃ c', tm.reaches (tm.initCfg x) c' ∧ tm.halted c' ∧ c'.output.cells 1 = Γ.one + +/-- DTM accepts `x` within `T` steps. -/ +def AcceptsInTime (tm : TM n) (x : List Bool) (T : ℕ) : Prop := + ∃ c' t, t ≤ T ∧ tm.reachesIn t (tm.initCfg x) c' ∧ tm.halted c' ∧ + c'.output.cells 1 = Γ.one + +/-- DTM decides `L` within time bound `T(n)`: halts on all inputs within `T(|x|)` steps, + outputting `1` for `x ∈ L` and `0` for `x ∉ L`. -/ +def DecidesInTime (tm : TM n) (L : Language) (T : ℕ → ℕ) : Prop := + ∀ x, ∃ c' t, t ≤ T x.length ∧ tm.reachesIn t (tm.initCfg x) c' ∧ tm.halted c' ∧ + (x ∈ L → c'.output.cells 1 = Γ.one) ∧ (x ∉ L → c'.output.cells 1 = Γ.zero) + +/-- DTM computes function `f` in time `T(n)`: + for every input `x`, the machine halts within `T(|x|)` steps with `f(x)` + written on the output tape. -/ +def ComputesInTime (tm : TM n) (f : List Bool → List Bool) (T : ℕ → ℕ) : Prop := + ∀ x, ∃ c' t, t ≤ T x.length ∧ tm.reachesIn t (tm.initCfg x) c' ∧ tm.halted c' ∧ + c'.output.HasOutput (f x) + +/-- DTM computes function `f` (existential version of `ComputesInTime`). -/ +def Computes (tm : TM n) (f : List Bool → List Bool) : Prop := + ∃ T, tm.ComputesInTime f T + +/-- DTM decides `L` using at most `S(|x|)` auxiliary space. Every reachable + configuration has work heads at position at most `S(|x|)`, input head at + position at most `|x| + S(|x|) + 1`, and output head at position at most + `S(|x|) + 1`. Thus the input region, its first trailing blank, and output + verdict cell 1 are free, but neither infinite tape can become uncharged + two-way workspace. The machine halts on all inputs with correct output. -/ +def DecidesInSpace (tm : TM n) (L : Language) (S : ℕ → ℕ) : Prop := + (∀ x c', tm.reaches (tm.initCfg x) c' → + c'.WithinDecisionSpace x.length (S x.length)) ∧ + ∀ x, ∃ c', tm.reaches (tm.initCfg x) c' ∧ tm.halted c' ∧ + (x ∈ L → c'.output.cells 1 = Γ.one) ∧ (x ∉ L → c'.output.cells 1 = Γ.zero) + +/-- DTM decides `L` within time `T(|x|)` and space `S(|x|)` simultaneously: + a single machine halts in bounded time with correct output, and every + reachable configuration satisfies the honest auxiliary-space convention of + `Cfg.WithinDecisionSpace`. -/ +def DecidesInTimeSpace (tm : TM n) (L : Language) (T S : ℕ → ℕ) : Prop := + (∀ x c', tm.reaches (tm.initCfg x) c' → + c'.WithinDecisionSpace x.length (S x.length)) ∧ + ∀ x, ∃ c' t, t ≤ T x.length ∧ tm.reachesIn t (tm.initCfg x) c' ∧ tm.halted c' ∧ + (x ∈ L → c'.output.cells 1 = Γ.one) ∧ (x ∉ L → c'.output.cells 1 = Γ.zero) + +/-- The output tape head never moves left — the machine is a *transducer*. + This prevents earlier output from being reread as workspace while allowing + unbounded output length. `ComputesInSpace` requires this discipline; the + decision-space predicates separately bound two-way output-head travel. -/ +def IsTransducer (tm : TM n) : Prop := + ∀ q iHead wHeads oHead, + let (_, _, _, _, _, outDir) := tm.δ q iHead wHeads oHead + outDir ≠ Dir3.left + +/-- DTM computes function `f` using at most `S(|x|)` auxiliary space. + Work-tape travel and input-head travel beyond the input's first trailing + blank are bounded by `Cfg.WithinAuxSpace`. The output length is not bounded: + instead, `IsTransducer` makes the output one-way so it cannot serve as + read-write workspace. -/ +def ComputesInSpace (tm : TM n) (f : List Bool → List Bool) (S : ℕ → ℕ) : Prop := + tm.IsTransducer ∧ + (∀ x c', tm.reaches (tm.initCfg x) c' → c'.WithinAuxSpace x.length (S x.length)) ∧ + ∀ x, ∃ c', tm.reaches (tm.initCfg x) c' ∧ tm.halted c' ∧ c'.output.HasOutput (f x) + +/-- Transitivity: if `c₁` reaches `c₂` in `t₁` steps and `c₂` reaches `c₃` + in `t₂` steps, then `c₁` reaches `c₃` in `t₁ + t₂` steps. -/ +theorem reachesIn_trans (tm : TM n) {t₁ t₂ : ℕ} {c₁ c₂ c₃ : Cfg n tm.Q} + (h₁ : tm.reachesIn t₁ c₁ c₂) (h₂ : tm.reachesIn t₂ c₂ c₃) : + tm.reachesIn (t₁ + t₂) c₁ c₃ := by + induction h₁ with + | zero => simp; exact h₂ + | step hstep _ ih => + show tm.reachesIn (_ + 1 + t₂) _ _ + rw [Nat.add_right_comm] + exact reachesIn.step hstep (ih h₂) + +/-- Bounded reachability implies unbounded reachability. -/ +theorem reaches_of_reachesIn {tm : TM n} {t : ℕ} {c c' : Cfg n tm.Q} + (h : tm.reachesIn t c c') : tm.reaches c c' := by + induction h with + | zero => exact Relation.ReflTransGen.refl + | step hs _ ih => exact Relation.ReflTransGen.head hs ih + +/-- `step` returns `none` exactly when the configuration is halted. The two ways + a DTM can "stop" — no successor configuration and being in `qhalt` — + coincide. -/ +theorem step_eq_none_iff_halted {tm : TM n} {c : Cfg n tm.Q} : + tm.step c = none ↔ c.state = tm.qhalt := by + by_cases h : c.state = tm.qhalt <;> simp [step, h] + +/-- Append a single step to the end of a run: reaching `c'` in `t` steps and then + stepping once to `c''` gives a run of `t + 1` steps. The `snoc` counterpart to + the `cons`-shaped `reachesIn.step`. -/ +theorem reachesIn_snoc {tm : TM n} {t : ℕ} {c c' c'' : Cfg n tm.Q} + (h : tm.reachesIn t c c') (hstep : tm.step c' = some c'') : + tm.reachesIn (t + 1) c c'' := + tm.reachesIn_trans h (reachesIn.step hstep reachesIn.zero) + +/-- A zero-step run goes nowhere. Inversion form of `reachesIn.zero`, usable + when the machine is a compound expression on which `cases` cannot + abstract the configuration indices. -/ +theorem reachesIn_zero_iff {tm : TM n} {c c' : Cfg n tm.Q} : + tm.reachesIn 0 c c' ↔ c = c' := + ⟨fun h => by cases h; rfl, fun h => h ▸ reachesIn.zero⟩ + +/-- A run of `t + 1` steps factors as one step followed by a run of `t` + steps. Inversion form of `reachesIn.step`. -/ +theorem reachesIn_succ_iff {tm : TM n} {t : ℕ} {c c' : Cfg n tm.Q} : + tm.reachesIn (t + 1) c c' ↔ + ∃ c'', tm.step c = some c'' ∧ tm.reachesIn t c'' c' := + ⟨fun h => by cases h with | step hstep hrest => exact ⟨_, hstep, hrest⟩, + fun ⟨_, hstep, hrest⟩ => reachesIn.step hstep hrest⟩ + +/-- `AcceptsInTime` implies `Accepts` — forget the time bound. -/ +theorem accepts_of_acceptsInTime {tm : TM n} {x : List Bool} {T : ℕ} + (h : tm.AcceptsInTime x T) : tm.Accepts x := by + obtain ⟨c', t, _, hreach, hhalt, hcell⟩ := h + exact ⟨c', reaches_of_reachesIn hreach, hhalt, hcell⟩ + +/-- DTM acceptance is monotone in the time bound. -/ +theorem AcceptsInTime.mono {tm : TM n} {x : List Bool} {T T' : ℕ} (hle : T ≤ T') + (h : tm.AcceptsInTime x T) : tm.AcceptsInTime x T' := by + obtain ⟨c', t, ht, hreach, hhalt, hout⟩ := h + exact ⟨c', t, ht.trans hle, hreach, hhalt, hout⟩ + +/-- DTM decision is monotone under pointwise enlargement of the time bound. -/ +theorem DecidesInTime.mono {tm : TM n} {L : Language} {T T' : ℕ → ℕ} + (hle : ∀ m, T m ≤ T' m) (h : tm.DecidesInTime L T) : tm.DecidesInTime L T' := by + intro x + obtain ⟨c', t, ht, hreach, hhalt, hyes, hno⟩ := h x + exact ⟨c', t, ht.trans (hle x.length), hreach, hhalt, hyes, hno⟩ + +/-- DTM computation is monotone under pointwise enlargement of the time bound. -/ +theorem ComputesInTime.mono {tm : TM n} {f : List Bool → List Bool} + {T T' : ℕ → ℕ} (hle : ∀ m, T m ≤ T' m) (h : tm.ComputesInTime f T) : + tm.ComputesInTime f T' := by + intro x + obtain ⟨c', t, ht, hreach, hhalt, hout⟩ := h x + exact ⟨c', t, ht.trans (hle x.length), hreach, hhalt, hout⟩ + +end TM + +namespace NTM + +variable {n : ℕ} + +/-- Execute an NTM for `T` steps with a fixed choice sequence. + Stops early if the machine reaches `qhalt`. -/ +def trace (tm : NTM n) : + (T : ℕ) → (Fin T → Bool) → Cfg n tm.Q → Cfg n tm.Q + | 0, _, c => c + | T + 1, choices, c => + if c.state = tm.qhalt then c + else + let b := choices ⟨0, Nat.zero_lt_succ T⟩ + let (q', workWrites, outWrite, inDir, workDirs, outDir) := + tm.δ b c.state c.input.read (fun i => (c.work i).read) c.output.read + let c' : Cfg n tm.Q := + { state := q' + input := c.input.move inDir + work := fun i => (c.work i).writeAndMove (workWrites i) (workDirs i) + output := c.output.writeAndMove outWrite outDir } + tm.trace T (fun i => choices ⟨i.val + 1, by omega⟩) c' + +/-- Initial configuration: input on the input tape, all tapes start with `▷`. -/ +abbrev initCfg (tm : NTM n) (x : List Bool) : Cfg n tm.Q := + Cfg.init tm.qstart x + +/-- A configuration is halted when its state is `qhalt`. -/ +abbrev halted (tm : NTM n) (c : Cfg n tm.Q) : Prop := + Cfg.isHalted tm.qhalt c + +/-- Once halted, the NTM trace stays at the same configuration regardless of + the remaining choices. -/ +theorem trace_halted (tm : NTM n) {c : Cfg n tm.Q} + (T : ℕ) (choices : Fin T → Bool) (h : tm.halted c) : + tm.trace T choices c = c := by + induction T with + | zero => rfl + | succ T _ => simp [NTM.trace, h] + +/-- An NTM trace preserves the unique left-end marker on the input, work, + and output tapes. -/ +theorem trace_startInvariant (tm : NTM n) (T : ℕ) + (choices : Fin T → Bool) (c : Cfg n tm.Q) + (hinp : c.input.StartInvariant) + (hwork : ∀ i, (c.work i).StartInvariant) + (hout : c.output.StartInvariant) : + (tm.trace T choices c).input.StartInvariant ∧ + (∀ i, ((tm.trace T choices c).work i).StartInvariant) ∧ + (tm.trace T choices c).output.StartInvariant := by + induction T generalizing c with + | zero => exact ⟨hinp, hwork, hout⟩ + | succ T ih => + by_cases hhalt : c.state = tm.qhalt + · simpa [trace, hhalt] using And.intro hinp (And.intro hwork hout) + · simp only [trace, hhalt, if_false] + apply ih + · exact hinp.move _ + · intro i + exact (hwork i).writeAndMove _ _ + · exact hout.writeAndMove _ _ + +/-- Every tape in a trace from `initCfg` has a unique left-end marker. -/ +theorem trace_initCfg_startInvariant (tm : NTM n) (x : List Bool) (T : ℕ) + (choices : Fin T → Bool) : + (tm.trace T choices (tm.initCfg x)).input.StartInvariant ∧ + (∀ i, ((tm.trace T choices (tm.initCfg x)).work i).StartInvariant) ∧ + (tm.trace T choices (tm.initCfg x)).output.StartInvariant := + tm.trace_startInvariant T choices (tm.initCfg x) + (Tape.StartInvariant.init_ofBool x) (fun _ => Tape.StartInvariant.init_nil) + Tape.StartInvariant.init_nil + +/-- NTM accepts `x`: there exists a time bound and choice sequence leading to + `qhalt` with output cell 1 = `1`. -/ +def Accepts (tm : NTM n) (x : List Bool) : Prop := + ∃ (T : ℕ) (choices : Fin T → Bool), + let c' := tm.trace T choices (tm.initCfg x) + tm.halted c' ∧ c'.output.cells 1 = Γ.one + +/-- NTM accepts `x` within `T` steps: there exists a choice sequence of length `T` + leading to `qhalt` with output cell 1 = `1`. -/ +def AcceptsInTime (tm : NTM n) (x : List Bool) (T : ℕ) : Prop := + ∃ choices : Fin T → Bool, + let c' := tm.trace T choices (tm.initCfg x) + tm.halted c' ∧ c'.output.cells 1 = Γ.one + +/-- `AcceptsInTime` implies `Accepts` — package the time bound existentially. -/ +theorem accepts_of_acceptsInTime {tm : NTM n} {x : List Bool} {T : ℕ} + (h : tm.AcceptsInTime x T) : tm.Accepts x := + ⟨T, h⟩ + +/-- `Accepts` is exactly `∃ T, AcceptsInTime x T`. -/ +theorem accepts_iff_exists_acceptsInTime {tm : NTM n} {x : List Bool} : + tm.Accepts x ↔ ∃ T, tm.AcceptsInTime x T := Iff.rfl + +/-- Running the NTM trace for more steps preserves the final configuration: + if the machine halts within `T` steps and the extended choice sequence + agrees with the original on the first `T` positions, the extra steps are + no-ops. -/ +theorem trace_mono (tm : NTM n) {T T' : ℕ} (hle : T ≤ T') + {choices : Fin T → Bool} {choices' : Fin T' → Bool} {c : Cfg n tm.Q} + (hagree : ∀ i : Fin T, choices' ⟨i.val, by omega⟩ = choices i) + (h : tm.halted (tm.trace T choices c)) : + tm.trace T' choices' c = tm.trace T choices c := by + induction T generalizing T' choices' c with + | zero => + have hhalt : tm.halted c := by simpa [NTM.trace] using h + simpa [NTM.trace] using tm.trace_halted T' choices' hhalt + | succ T ih => + rcases T' with _ | T' + · omega + by_cases hc : c.state = tm.qhalt + · have hcT : tm.trace (T + 1) choices c = c := by simp [NTM.trace, hc] + have hcT' : tm.trace (T' + 1) choices' c = c := by simp [NTM.trace, hc] + rw [hcT, hcT'] + · have hch0 := hagree ⟨0, Nat.zero_lt_succ _⟩ + have hle' : T ≤ T' := Nat.le_of_succ_le_succ hle + simp only [NTM.trace, hc, hch0, if_false] at h ⊢ + exact ih hle' (fun i => hagree ⟨i.val + 1, by omega⟩) h + +/-- NTM acceptance is monotone in the time bound: `AcceptsInTime x T` implies + `AcceptsInTime x T'` for any `T' ≥ T`. Extra steps are no-ops once halted. -/ +theorem AcceptsInTime.mono {tm : NTM n} {x : List Bool} {T T' : ℕ} (hle : T ≤ T') + (h : tm.AcceptsInTime x T) : tm.AcceptsInTime x T' := by + obtain ⟨choices, hhalt, hout⟩ := h + let choices' : Fin T' → Bool := fun i => + if hi : i.val < T then choices ⟨i.val, hi⟩ else false + have heq := tm.trace_mono hle (choices := choices) (choices' := choices') + (c := tm.initCfg x) (fun i => by simp [choices', i.isLt]) hhalt + exact ⟨choices', heq ▸ hhalt, heq ▸ hout⟩ + +/-- All computation paths of the NTM halt within `T(|x|)` steps, for every + input `x` and every choice sequence. This is the core time-boundedness + condition shared by `DecidesInTime`, `BPTIME`, and `NTM.IsPPT`. -/ +def AllPathsHaltIn (tm : NTM n) (T : ℕ → ℕ) : Prop := + ∀ x (choices : Fin (T x.length) → Bool), + tm.halted (tm.trace (T x.length) choices (tm.initCfg x)) + +/-- NTM decides `L` within time bound `T(n)`: + all computation paths halt within `T(|x|)` steps, and accepting paths exist + iff `x ∈ L` (AB Definition 2.1). -/ +def DecidesInTime (tm : NTM n) (L : Language) (T : ℕ → ℕ) : Prop := + tm.AllPathsHaltIn T ∧ + (∀ x, x ∈ L ↔ tm.AcceptsInTime x (T x.length)) + +/-- All-paths halting is monotone in the time bound: once halted, the extra + steps are no-ops. -/ +theorem AllPathsHaltIn.mono {tm : NTM n} {T T' : ℕ → ℕ} (hle : ∀ m, T m ≤ T' m) + (h : tm.AllPathsHaltIn T) : tm.AllPathsHaltIn T' := by + intro x choices' + have heq := tm.trace_mono (hle x.length) + (choices := fun i => choices' ⟨i.val, lt_of_lt_of_le i.isLt (hle x.length)⟩) + (choices' := choices') (c := tm.initCfg x) (fun i => rfl) + (h x fun i => choices' ⟨i.val, lt_of_lt_of_le i.isLt (hle x.length)⟩) + rw [heq] + exact h x _ + +/-- With all paths halting within `T`, timed acceptance transfers DOWN from any + pointwise-larger bound: by `T(|x|)` every path is already frozen. -/ +theorem acceptsInTime_of_le_of_allPathsHaltIn {tm : NTM n} {T T' : ℕ → ℕ} + {x : List Bool} (hle : ∀ m, T m ≤ T' m) (hN : tm.AllPathsHaltIn T) + (h : tm.AcceptsInTime x (T' x.length)) : tm.AcceptsInTime x (T x.length) := by + obtain ⟨choices', hhalt', hout'⟩ := h + have heq := tm.trace_mono (hle x.length) + (choices := fun i => choices' ⟨i.val, lt_of_lt_of_le i.isLt (hle x.length)⟩) + (choices' := choices') (c := tm.initCfg x) (fun i => rfl) + (hN x fun i => choices' ⟨i.val, lt_of_lt_of_le i.isLt (hle x.length)⟩) + exact ⟨_, hN x _, by rw [heq] at hout'; exact hout'⟩ + +/-- Deciding within `T` transfers to any pointwise-larger bound `T'`: halting + is monotone, and acceptance transfers both ways (up by monotonicity, down + by the all-paths-halt freeze). -/ +theorem DecidesInTime.mono {tm : NTM n} {L : Language} {T T' : ℕ → ℕ} + (hle : ∀ m, T m ≤ T' m) (h : tm.DecidesInTime L T) : tm.DecidesInTime L T' := + ⟨h.1.mono hle, fun x => (h.2 x).trans + ⟨fun ha => AcceptsInTime.mono (hle x.length) ha, + fun ha => acceptsInTime_of_le_of_allPathsHaltIn hle h.1 ha⟩⟩ + +/-- Count of accepting choice sequences of length `T`. + + Meaningful when the machine halts on all paths within `T` steps — use in conjunction + with `NTM.DecidesInTime` or an explicit all-paths-halt hypothesis. -/ +noncomputable def acceptCount (tm : NTM n) (x : List Bool) (T : ℕ) : ℕ := + (Finset.univ.filter fun (choices : Fin T → Bool) => + let c' := tm.trace T choices (tm.initCfg x) + c'.state = tm.qhalt ∧ c'.output.cells 1 = Γ.one).card + +/-- Acceptance probability = |accepting paths| / 2^T. + + Meaningful when the machine halts on all paths within `T` steps. -/ +noncomputable def acceptProb (tm : NTM n) (x : List Bool) (T : ℕ) : ℚ := + (tm.acceptCount x T : ℚ) / (2 ^ T : ℚ) + +/-- Count of choice sequences of length `T` on which the machine halts with + output `y` (using `Tape.HasOutput`). + + Meaningful when the machine halts on all paths within `T` steps. -/ +noncomputable def outputCount (tm : NTM n) (x : List Bool) (T : ℕ) + (y : List Bool) : ℕ := + (Finset.univ.filter fun (choices : Fin T → Bool) => + let c' := tm.trace T choices (tm.initCfg x) + c'.state = tm.qhalt ∧ c'.output.HasOutput y).card + +/-- Probability that the machine outputs `y` on input `x` = + |output-matching paths| / 2^T. + + Meaningful when the machine halts on all paths within `T` steps. + This generalizes `acceptProb` from accept/reject to arbitrary output + strings, as needed for cryptographic definitions. -/ +noncomputable def outputProb (tm : NTM n) (x : List Bool) (T : ℕ) + (y : List Bool) : ℚ := + (tm.outputCount x T y : ℚ) / (2 ^ T : ℚ) + +/-- NTM decides `L` using at most `S(|x|)` auxiliary space. Every intermediate + configuration on every path obeys `Cfg.WithinDecisionSpace`: work heads are + bounded by `S`, the finite input plus first blank is free but farther input + travel is charged, and only output verdict cell 1 is free. There exists a + time bound within which all paths halt and decide correctly. -/ +def DecidesInSpace (tm : NTM n) (L : Language) (S : ℕ → ℕ) : Prop := + ∃ T, tm.DecidesInTime L T ∧ + ∀ x (choices : Fin (T x.length) → Bool) (t' : ℕ) (ht : t' ≤ T x.length), + (tm.trace t' (fun j => choices ⟨j.val, by omega⟩) (tm.initCfg x)).WithinDecisionSpace + x.length (S x.length) + +/-- The output tape head never moves left — the machine is a *transducer*. + This prevents earlier output from being reread as workspace while allowing + unbounded output length. Decision-space predicates separately bound two-way + output-head travel. -/ +def IsTransducer (tm : NTM n) : Prop := + ∀ b q iHead wHeads oHead, + let (_, _, _, _, _, outDir) := tm.δ b q iHead wHeads oHead + outDir ≠ Dir3.left + +end NTM + +/-- Embed a DTM into an NTM by using the same transition for both choices. -/ +def TM.toNTM (tm : TM n) : NTM n where + Q := tm.Q + qstart := tm.qstart + qhalt := tm.qhalt + δ := fun _ => tm.δ + δ_right_of_start := fun _ => tm.δ_right_of_start + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators.lean new file mode 100644 index 0000000000..db46051ae2 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators.lean @@ -0,0 +1,1034 @@ +/- +Copyright (c) 2025 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine +public import Mathlib.Data.Fintype.Sum + +/-! +# TM Combinators + +This file provides TM constructions for composing machines, used to prove +closure properties of complexity classes. + +## Main definitions + +- `TM.unionTM` — Given `tm₁ : TM n₁` deciding `L₁` and `tm₂ : TM n₂` deciding `L₂`, + construct a `TM (n₁ + 1 + n₂)` that decides `L₁ ∪ L₂`. +- `TM.complementTM` — Given a TM deciding `L`, construct a TM (with the same + number of work tapes) deciding `Lᶜ` by flipping the output bit. +- `TM.seqTM` — Sequential composition: run `tm₁` to completion, then `tm₂` + on the same tapes. +- `TM.ifTM` — Conditional branching: run a test machine, then branch to a + "then" or "else" machine based on its output. +- `TM.loopTM` — Loop combinator: repeatedly run a body machine then a test + machine, halting when the test outputs `Γ.one`. +- `TM.scannerTM` — Generic finite-state scanner: fold a finite-state + transition function over the input bits and emit a final symbol. +- `TM.retargetInput` — Given `M : TM k`, construct a `TM (k + 1)` that runs + `M` but reads its "input" from work tape `k` instead of the input tape. + +## Design + +The union machine has three phases: + +1. **Phase 1**: Simulate `tm₁`, redirecting its output to work tape `n₁` + (a "fake output" tape). The real output tape stays pristine. +2. **Transition**: Rewind the fake output to cell 1 and check the result. + If `Γ.one` (tm₁ accepted), write `Γ.one` to the real output and halt. + Otherwise rewind the input tape and reset Phase-2 tapes to cell 0. +3. **Phase 2**: Simulate `tm₂` using work tapes `n₁+1..n₁+n₂` + and the real output tape. + +### Work tape layout (0-indexed) + +- `0 .. n₁-1` — Phase 1's work tapes (mirrors `tm₁.work`) +- `n₁` — Phase 1's redirected output (mirrors `tm₁.output`) +- `n₁+1 .. n₁+n₂` — Phase 2's work tapes (mirrors `tm₂.work`) + +### State space + +`Q₁ ⊕ UnionPhase ⊕ Q₂` where `UnionPhase` encodes the four transition states +between Phase 1 and Phase 2. +-/ + + +@[expose] public section + +namespace Complexity + +variable {n₁ n₂ : ℕ} + +namespace TM + +-- ════════════════════════════════════════════════════════════════════════ +-- Helpers +-- ════════════════════════════════════════════════════════════════════════ + +/-- Direction for an idle tape: move right if reading `▷`, else stay. + Satisfies `δ_right_of_start` for tapes not involved in the current phase. -/ +def idleDir (head : Γ) : Dir3 := + if head = Γ.start then .right else .stay + +/-- Direction for a tape we want to move left: move left unless reading `▷`, + in which case move right to satisfy `δ_right_of_start`. During actual + execution the tape won't be at cell 0, so this always moves left. -/ +def moveLeftDir (head : Γ) : Dir3 := + if head = Γ.start then .right else .left + +/-- `idleDir` moves right when reading the start symbol `▷`. -/ +theorem idleDir_start : idleDir Γ.start = Dir3.right := rfl +private theorem moveLeftDir_start : moveLeftDir Γ.start = Dir3.right := rfl + +/-- If the head reads `▷`, then `idleDir` moves right — the shape of the + `δ_right_of_start` obligation for idle tapes. -/ +theorem idleDir_right_of_start (h : head = Γ.start) : idleDir head = Dir3.right := by + subst h; rfl + +/-- If the head reads `▷`, then `moveLeftDir` moves right — the shape of the + `δ_right_of_start` obligation for tapes being rewound. -/ +theorem moveLeftDir_right_of_start (h : head = Γ.start) : moveLeftDir head = Dir3.right := + by subst h; rfl + +/-- Write back the same symbol read from a tape, preserving cell contents. + Maps `▷` to `□` since `Tape.write` at position 0 is a no-op anyway. -/ +def readBackWrite (g : Γ) : Γw := + match g with + | .zero => .zero + | .one => .one + | .blank => .blank + | .start => .blank + +/-- `readBackWrite` recovers the original symbol away from the left-end marker. -/ +theorem toΓ_readBackWrite_of_ne_start {g : Γ} (h : g ≠ Γ.start) : + (readBackWrite g).toΓ = g := by + cases g <;> simp_all [readBackWrite, Γw.toΓ] + +/-- Writing back the symbol under an off-start head is a no-op. -/ +theorem write_readBack (t : Tape) (hread : t.read ≠ Γ.start) : + t.write (readBackWrite t.read) = t := by + rw [Tape.write] + split + · rfl + · refine Tape.ext rfl ?_ + show Function.update t.cells t.head (readBackWrite t.read).toΓ = t.cells + rw [toΓ_readBackWrite_of_ne_start hread, Tape.read, Function.update_eq_self] + +/-- Writing back the symbol under an off-start head and moving is just the move. -/ +theorem writeAndMove_readBack (t : Tape) (hread : t.read ≠ Γ.start) (d : Dir3) : + t.writeAndMove (readBackWrite t.read) d = t.move d := by + show (t.write _).move d = t.move d + rw [write_readBack t hread] + +/-- The "do nothing" transition output: all writes are `□`, all directions + are `idleDir`. Used for states that only change the control state. -/ +def allIdle {σ : Type} {k : ℕ} + (newState : σ) (iHead : Γ) (wHeads : Fin k → Γ) (oHead : Γ) : + σ × (Fin k → Γw) × Γw × Dir3 × (Fin k → Dir3) × Dir3 := + (newState, fun _ => .blank, .blank, idleDir iHead, fun i => idleDir (wHeads i), idleDir oHead) + +/-- The content-preserving driver action: write every currently read work and +output symbol back, and use `idleDir` on every tape. Every off-start tape is +preserved exactly; a head on `▷` takes the structurally mandatory move right. -/ +def allReadBack {σ : Type} {k : ℕ} + (newState : σ) (iHead : Γ) (wHeads : Fin k → Γ) (oHead : Γ) : + σ × (Fin k → Γw) × Γw × Dir3 × (Fin k → Dir3) × Dir3 := + (newState, fun i => readBackWrite (wHeads i), readBackWrite oHead, + idleDir iHead, fun i => idleDir (wHeads i), idleDir oHead) + +/-- Proof that all-idle directions satisfy `δ_right_of_start`. -/ +theorem rightOfStart_allIdle (iHead : Γ) (wHeads : Fin k → Γ) (oHead : Γ) : + (iHead = Γ.start → idleDir iHead = Dir3.right) ∧ + (∀ i, wHeads i = Γ.start → idleDir (wHeads i) = Dir3.right) ∧ + (oHead = Γ.start → idleDir oHead = Dir3.right) := + ⟨idleDir_right_of_start, fun _ => idleDir_right_of_start, idleDir_right_of_start⟩ + +/-- `allReadBack` satisfies the one-sided-tape direction invariant. -/ +theorem rightOfStart_allReadBack (iHead : Γ) (wHeads : Fin k → Γ) (oHead : Γ) : + (iHead = Γ.start → idleDir iHead = Dir3.right) ∧ + (∀ i, wHeads i = Γ.start → idleDir (wHeads i) = Dir3.right) ∧ + (oHead = Γ.start → idleDir oHead = Dir3.right) := + ⟨idleDir_right_of_start, fun _ => idleDir_right_of_start, idleDir_right_of_start⟩ + +-- ════════════════════════════════════════════════════════════════════════ +-- State type +-- ════════════════════════════════════════════════════════════════════════ + +/-- Intermediate states between Phase 1 and Phase 2 of the union machine. -/ +inductive UnionPhase where + | rewindOut -- rewind fake output (work tape n₁) to cell 0 + | checkResult -- at fake output cell 1: read and decide accept/continue + | rewindIn -- rewind input tape to cell 0 + | setup2 -- move Phase-2 tapes from cell 1 to cell 0 + deriving DecidableEq + +instance : Fintype UnionPhase where + elems := {.rewindOut, .checkResult, .rewindIn, .setup2} + complete := fun x => by cases x <;> simp + +/-- The state type for the union TM. -/ +abbrev UnionQ (Q₁ Q₂ : Type) := Q₁ ⊕ UnionPhase ⊕ Q₂ + +-- ════════════════════════════════════════════════════════════════════════ +-- Index helpers for the n₁ + 1 + n₂ work tapes +-- ════════════════════════════════════════════════════════════════════════ + +/-- Index of the fake output tape (work tape `n₁`). -/ +def fakeOutIdx : Fin (n₁ + 1 + n₂) := ⟨n₁, by omega⟩ + +/-- Read tm₁'s work tapes from the composite work tapes. -/ +def phase1WorkReads (wHeads : Fin (n₁ + 1 + n₂) → Γ) (i : Fin n₁) : Γ := + wHeads ⟨i.val, by omega⟩ + +/-- Read tm₂'s work tapes from the composite work tapes. -/ +def phase2WorkReads (wHeads : Fin (n₁ + 1 + n₂) → Γ) (j : Fin n₂) : Γ := + wHeads ⟨n₁ + 1 + j.val, by omega⟩ + +-- ════════════════════════════════════════════════════════════════════════ +-- The union TM +-- ════════════════════════════════════════════════════════════════════════ + +/-- Construct a TM deciding `L₁ ∪ L₂` from TMs deciding `L₁` and `L₂`. + + The composite machine has `n₁ + 1 + n₂` work tapes: + - `0 .. n₁-1` for `tm₁`'s work tapes + - `n₁` for `tm₁`'s redirected output + - `n₁+1 .. n₁+n₂` for `tm₂`'s work tapes -/ +def unionTM (tm₁ : TM n₁) (tm₂ : TM n₂) : TM (n₁ + 1 + n₂) := + haveI : Fintype tm₁.Q := tm₁.finQ + haveI : DecidableEq tm₁.Q := tm₁.decEq + haveI : Fintype tm₂.Q := tm₂.finQ + haveI : DecidableEq tm₂.Q := tm₂.decEq + { Q := UnionQ tm₁.Q tm₂.Q, + qstart := Sum.inl tm₁.qstart, + qhalt := Sum.inr (Sum.inr tm₂.qhalt), + δ := fun state iHead wHeads oHead => + match state with + -- ══════════════════════════════════════════════════════════════════ + -- Phase 1: simulate tm₁ with output redirected to work tape n₁ + -- ══════════════════════════════════════════════════════════════════ + | Sum.inl q => + if q = tm₁.qhalt then + -- Transition to rewind; preserve fake output value to avoid corrupting cell 1 + ( Sum.inr (Sum.inl .rewindOut), + fun i => if i.val = n₁ then readBackWrite (wHeads fakeOutIdx) else .blank, + .blank, + idleDir iHead, + fun i => idleDir (wHeads i), + idleDir oHead ) + else + let (q', wW, oW, iD, wD, oD) := + tm₁.δ q iHead (phase1WorkReads wHeads) (wHeads fakeOutIdx) + ( Sum.inl q', + fun i => + if h : i.val < n₁ then wW ⟨i.val, h⟩ + else if i.val = n₁ then oW + else .blank, + .blank, iD, + fun i => + if h : i.val < n₁ then wD ⟨i.val, h⟩ + else if i.val = n₁ then oD + else idleDir (wHeads i), + idleDir oHead ) + -- ══════════════════════════════════════════════════════════════════ + -- Transition states between phases + -- ══════════════════════════════════════════════════════════════════ + | Sum.inr (Sum.inl m) => + match m with + | .rewindOut => + if wHeads fakeOutIdx = Γ.start then + -- At cell 0 → move right to cell 1 + ( Sum.inr (Sum.inl .checkResult), + fun _ => .blank, .blank, idleDir iHead, + fun i => if i.val = n₁ then Dir3.right else idleDir (wHeads i), + idleDir oHead ) + else + -- Not at cell 0 → keep moving left; preserve fake output to avoid corrupting cell 1 + ( Sum.inr (Sum.inl .rewindOut), + fun i => if i.val = n₁ then readBackWrite (wHeads fakeOutIdx) else .blank, + .blank, idleDir iHead, + fun i => if i.val = n₁ then Dir3.left else idleDir (wHeads i), + idleDir oHead ) + | .checkResult => + if wHeads fakeOutIdx = Γ.one then + -- tm₁ accepted → write Γ.one to real output (at cell 1), halt + ( Sum.inr (Sum.inr tm₂.qhalt), + fun _ => .blank, .one, idleDir iHead, + fun i => idleDir (wHeads i), + idleDir oHead ) + else + -- tm₁ rejected → proceed to rewind input + allIdle (Sum.inr (Sum.inl .rewindIn)) iHead wHeads oHead + | .rewindIn => + if iHead = Γ.start then + -- At cell 0 → forced right by δ_right_of_start, then setup2 + ( Sum.inr (Sum.inl .setup2), + fun _ => .blank, .blank, Dir3.right, + fun i => idleDir (wHeads i), + idleDir oHead ) + else + -- Not at cell 0 → keep moving left + ( Sum.inr (Sum.inl .rewindIn), + fun _ => .blank, .blank, Dir3.left, + fun i => idleDir (wHeads i), + idleDir oHead ) + | .setup2 => + -- Move input, Phase-2 work tapes, and real output from cell 1 to cell 0 + ( Sum.inr (Sum.inr tm₂.qstart), + fun _ => .blank, .blank, moveLeftDir iHead, + fun i => if i.val ≤ n₁ then idleDir (wHeads i) else moveLeftDir (wHeads i), + moveLeftDir oHead ) + -- ══════════════════════════════════════════════════════════════════ + -- Phase 2: simulate tm₂ with the real output tape + -- ══════════════════════════════════════════════════════════════════ + | Sum.inr (Sum.inr q) => + if q = tm₂.qhalt then + -- Unreachable (step returns none), but δ is total + allIdle (Sum.inr (Sum.inr tm₂.qhalt)) iHead wHeads oHead + else + let (q', wW, oW, iD, wD, oD) := + tm₂.δ q iHead (phase2WorkReads wHeads) oHead + ( Sum.inr (Sum.inr q'), + fun i => + if h : i.val ≤ n₁ then .blank + else wW ⟨i.val - (n₁ + 1), by omega⟩, + oW, iD, + fun i => + if h : i.val ≤ n₁ then idleDir (wHeads i) + else wD ⟨i.val - (n₁ + 1), by omega⟩, + oD ), + δ_right_of_start := by + intro state iHead wHeads oHead + match state with + | Sum.inl q => + dsimp only [] + split + · exact rightOfStart_allIdle iHead wHeads oHead + · next hne => + have hδ := tm₁.δ_right_of_start q iHead (phase1WorkReads wHeads) (wHeads fakeOutIdx) + simp only [phase1WorkReads, fakeOutIdx] at hδ + refine ⟨hδ.1, ?_, idleDir_right_of_start⟩ + intro i hwi; simp only [] + split + · next hi => + exact hδ.2.1 ⟨i.val, hi⟩ (by + rwa [show wHeads ⟨↑i, by omega⟩ = wHeads i from by congr 1]) + · split + · next hi hn => + exact hδ.2.2 (by + rwa [show wHeads ⟨n₁, by omega⟩ = wHeads i from by congr 1; ext; simp [hn]]) + · exact idleDir_right_of_start hwi + | Sum.inr (Sum.inl m) => + match m with + | .rewindOut => + dsimp only [fakeOutIdx] + split + · refine ⟨idleDir_right_of_start, ?_, idleDir_right_of_start⟩ + intro i hwi; simp only []; split + · rfl + · exact idleDir_right_of_start hwi + · refine ⟨idleDir_right_of_start, ?_, idleDir_right_of_start⟩ + intro i hwi; simp only []; split + · next hn heq => + exfalso; apply hn + rwa [show wHeads ⟨n₁, by omega⟩ = wHeads i from by congr 1; ext; simp [heq]] + · exact idleDir_right_of_start hwi + | .checkResult => + dsimp only [fakeOutIdx] + split + · exact ⟨idleDir_right_of_start, fun _ => idleDir_right_of_start, idleDir_right_of_start⟩ + · exact rightOfStart_allIdle iHead wHeads oHead + | .rewindIn => + dsimp only [] + split + · exact ⟨fun _ => rfl, fun _ => idleDir_right_of_start, idleDir_right_of_start⟩ + · refine ⟨?_, fun _ => idleDir_right_of_start, idleDir_right_of_start⟩ + intro hiHead; next hn => exact absurd hiHead hn + | .setup2 => + refine ⟨moveLeftDir_right_of_start, ?_, moveLeftDir_right_of_start⟩ + intro i hwi; simp only []; split + · exact idleDir_right_of_start hwi + · exact moveLeftDir_right_of_start hwi + | Sum.inr (Sum.inr q) => + dsimp only [] + split + · exact rightOfStart_allIdle iHead wHeads oHead + · next hne => + have hδ := tm₂.δ_right_of_start q iHead (phase2WorkReads wHeads) oHead + simp only [phase2WorkReads] at hδ + refine ⟨hδ.1, ?_, hδ.2.2⟩ + intro i hwi; simp only []; split + · exact idleDir_right_of_start hwi + · next hi => + exact hδ.2.1 ⟨i.val - (n₁ + 1), by omega⟩ (by + rwa [show wHeads ⟨n₁ + 1 + (↑i - (n₁ + 1)), by omega⟩ = wHeads i from by + congr 1; ext; simp; omega]) } + +-- ════════════════════════════════════════════════════════════════════════ +-- Complement TM +-- ════════════════════════════════════════════════════════════════════════ + +/-- Intermediate states for the complement machine's output-flipping phase. -/ +inductive ComplementPhase where + | rewind -- rewind output head left to cell 0, then right to cell 1 + | flip -- at cell 1: flip the output bit and halt + | done -- halt state + deriving DecidableEq + +instance : Fintype ComplementPhase where + elems := {.rewind, .flip, .done} + complete := fun x => by cases x <;> simp + +/-- The state type for the complement TM. -/ +abbrev ComplementQ (Q : Type) := Q ⊕ ComplementPhase + +/-- Flip a readable symbol: `1 ↔ 0`, blanks stay blank. -/ +def flipBit (g : Γ) : Γw := + match g with + | .one => .zero + | .zero => .one + | .blank => .blank + | .start => .blank + +/-- Construct a TM deciding `Lᶜ` from a TM deciding `L`. + + The complement machine has the same number of work tapes as the original. + It runs in three stages: + + 1. **Simulate**: Run the original TM. When it halts, transition to `rewind`. + 2. **Rewind**: Move the output head left to `▷` (cell 0), then right to cell 1. + 3. **Flip**: Read output cell 1, write the flipped bit, and halt. -/ +def complementTM (tm : TM n) : TM n := + haveI : Fintype tm.Q := tm.finQ + haveI : DecidableEq tm.Q := tm.decEq + { Q := ComplementQ tm.Q, + qstart := Sum.inl tm.qstart, + qhalt := Sum.inr .done, + δ := fun state iHead wHeads oHead => + match state with + -- ══════════════════════════════════════════════════════════════════ + -- Simulation phase: run original TM + -- ══════════════════════════════════════════════════════════════════ + | Sum.inl q => + if q = tm.qhalt then + -- Original TM halted → begin rewinding output + -- Write back the current output symbol to preserve cell contents + ( Sum.inr .rewind, + fun _ => .blank, + readBackWrite oHead, + idleDir iHead, + fun i => idleDir (wHeads i), + idleDir oHead ) + else + -- Not halted → run original δ, wrapping state in Sum.inl + let (q', wW, oW, iD, wD, oD) := tm.δ q iHead wHeads oHead + ( Sum.inl q', wW, oW, iD, wD, oD ) + -- ══════════════════════════════════════════════════════════════════ + -- Rewind phase: move output head left to ▷, then right to cell 1 + -- ══════════════════════════════════════════════════════════════════ + | Sum.inr .rewind => + if oHead = Γ.start then + -- At cell 0 (▷) → move right to cell 1, enter flip state + ( Sum.inr .flip, + fun _ => .blank, + .blank, + idleDir iHead, + fun i => idleDir (wHeads i), + Dir3.right ) + else + -- Not at cell 0 → keep moving left, preserve output cell contents + ( Sum.inr .rewind, + fun _ => .blank, + readBackWrite oHead, + idleDir iHead, + fun i => idleDir (wHeads i), + Dir3.left ) + -- ══════════════════════════════════════════════════════════════════ + -- Flip phase: at cell 1, flip the output bit and halt + -- ══════════════════════════════════════════════════════════════════ + | Sum.inr .flip => + ( Sum.inr .done, + fun _ => .blank, + flipBit oHead, + idleDir iHead, + fun i => idleDir (wHeads i), + idleDir oHead ) + -- ══════════════════════════════════════════════════════════════════ + -- Done (= qhalt): unreachable by step, but δ is total + -- ══════════════════════════════════════════════════════════════════ + | Sum.inr .done => + allIdle (Sum.inr .done) iHead wHeads oHead, + δ_right_of_start := by + intro state iHead wHeads oHead + match state with + | Sum.inl q => + dsimp only [] + split + · exact ⟨idleDir_right_of_start, fun _ => idleDir_right_of_start, + idleDir_right_of_start⟩ + · exact tm.δ_right_of_start q iHead wHeads oHead + | Sum.inr .rewind => + dsimp only [] + split + · exact ⟨idleDir_right_of_start, fun _ => idleDir_right_of_start, fun _ => rfl⟩ + · refine ⟨idleDir_right_of_start, fun _ => idleDir_right_of_start, ?_⟩ + intro h; next hn => exact absurd h hn + | Sum.inr .flip => + exact ⟨idleDir_right_of_start, fun _ => idleDir_right_of_start, + idleDir_right_of_start⟩ + | Sum.inr .done => + exact rightOfStart_allIdle iHead wHeads oHead } + +-- ════════════════════════════════════════════════════════════════════════ +-- Conditional Branching +-- ════════════════════════════════════════════════════════════════════════ + +/-- Intermediate states for the conditional branching machine. -/ +inductive IfPhase where + | rewindOut -- rewind output head left to ▷ (cell 0) + | check -- at cell 0, move right to cell 1, read result, branch + | done -- halt state (reached when either branch halts) + deriving DecidableEq + +instance : Fintype IfPhase where + elems := {.rewindOut, .check, .done} + complete := fun x => by cases x <;> simp + +/-- The state type for the conditional branching TM. -/ +abbrev IfQ (QT QThen QElse : Type) := QT ⊕ IfPhase ⊕ QThen ⊕ QElse + +/-- Conditional branching: run `tmTest` to completion, read its output at + cell 1, then run `tmThen` (if output = `Γ.one`) or `tmElse` (otherwise). + + All three machines share the same `n` work tapes, input tape, and output + tape. Work tape contents are preserved across all transitions via + `readBackWrite`, maintaining shared state for the branch machines. + + ## Phases + + 1. **Test**: Simulate `tmTest`. When it halts, enter rewind. + 2. **Rewind output**: Move output head left to `▷` (cell 0). + 3. **Check**: Move output head right to cell 1, read the test result. + If `Γ.one`, enter `tmThen.qstart`. Otherwise, enter `tmElse.qstart`. + 4. **Branch**: Simulate `tmThen` or `tmElse`. When the branch machine + halts, transition to the `done` halt state. + + ## Time + + `t_test + (output_head_pos + 2) + 1 + t_branch + 1` where + `output_head_pos ≤ t_test`. Total: at most `2·t_test + t_branch + 4`. -/ +def ifTM (tmTest : TM n) (tmThen : TM n) (tmElse : TM n) : TM n := + haveI : Fintype tmTest.Q := tmTest.finQ + haveI : DecidableEq tmTest.Q := tmTest.decEq + haveI : Fintype tmThen.Q := tmThen.finQ + haveI : DecidableEq tmThen.Q := tmThen.decEq + haveI : Fintype tmElse.Q := tmElse.finQ + haveI : DecidableEq tmElse.Q := tmElse.decEq + { Q := IfQ tmTest.Q tmThen.Q tmElse.Q, + qstart := Sum.inl tmTest.qstart, + qhalt := Sum.inr (Sum.inl .done), + δ := fun state iHead wHeads oHead => + match state with + -- ══════════════════════════════════════════════════════════════════ + -- Test phase: simulate tmTest + -- ══════════════════════════════════════════════════════════════════ + | Sum.inl q => + if q = tmTest.qhalt then + -- tmTest halted → begin rewinding output, preserve all tapes + ( Sum.inr (Sum.inl .rewindOut), + fun i => readBackWrite (wHeads i), + readBackWrite oHead, + idleDir iHead, + fun i => idleDir (wHeads i), + idleDir oHead ) + else + let (q', wW, oW, iD, wD, oD) := tmTest.δ q iHead wHeads oHead + ( Sum.inl q', wW, oW, iD, wD, oD ) + -- ══════════════════════════════════════════════════════════════════ + -- Transition: rewind output and check result + -- ══════════════════════════════════════════════════════════════════ + | Sum.inr (Sum.inl phase) => + match phase with + | .rewindOut => + if oHead = Γ.start then + -- At ▷ (cell 0) → move right to cell 1, enter check + ( Sum.inr (Sum.inl .check), + fun i => readBackWrite (wHeads i), + .blank, + idleDir iHead, + fun i => idleDir (wHeads i), + Dir3.right ) + else + -- Not at cell 0 → keep moving left, preserve output + ( Sum.inr (Sum.inl .rewindOut), + fun i => readBackWrite (wHeads i), + readBackWrite oHead, + idleDir iHead, + fun i => idleDir (wHeads i), + Dir3.left ) + | .check => + -- At cell 1: read output and branch + if oHead = Γ.one then + ( Sum.inr (Sum.inr (Sum.inl tmThen.qstart)), + fun i => readBackWrite (wHeads i), + readBackWrite oHead, + idleDir iHead, + fun i => idleDir (wHeads i), + idleDir oHead ) + else + ( Sum.inr (Sum.inr (Sum.inr tmElse.qstart)), + fun i => readBackWrite (wHeads i), + readBackWrite oHead, + idleDir iHead, + fun i => idleDir (wHeads i), + idleDir oHead ) + | .done => + allIdle (Sum.inr (Sum.inl .done)) iHead wHeads oHead + -- ══════════════════════════════════════════════════════════════════ + -- Then branch: simulate tmThen + -- ══════════════════════════════════════════════════════════════════ + | Sum.inr (Sum.inr (Sum.inl q)) => + if q = tmThen.qhalt then + -- tmThen halted → transition to done, preserve tapes + ( Sum.inr (Sum.inl .done), + fun i => readBackWrite (wHeads i), + readBackWrite oHead, + idleDir iHead, + fun i => idleDir (wHeads i), + idleDir oHead ) + else + let (q', wW, oW, iD, wD, oD) := tmThen.δ q iHead wHeads oHead + ( Sum.inr (Sum.inr (Sum.inl q')), wW, oW, iD, wD, oD ) + -- ══════════════════════════════════════════════════════════════════ + -- Else branch: simulate tmElse + -- ══════════════════════════════════════════════════════════════════ + | Sum.inr (Sum.inr (Sum.inr q)) => + if q = tmElse.qhalt then + -- tmElse halted → transition to done, preserve tapes + ( Sum.inr (Sum.inl .done), + fun i => readBackWrite (wHeads i), + readBackWrite oHead, + idleDir iHead, + fun i => idleDir (wHeads i), + idleDir oHead ) + else + let (q', wW, oW, iD, wD, oD) := tmElse.δ q iHead wHeads oHead + ( Sum.inr (Sum.inr (Sum.inr q')), wW, oW, iD, wD, oD ), + δ_right_of_start := by + intro state iHead wHeads oHead + match state with + | Sum.inl q => + dsimp only [] + split + · exact ⟨idleDir_right_of_start, fun _ => idleDir_right_of_start, + idleDir_right_of_start⟩ + · exact tmTest.δ_right_of_start q iHead wHeads oHead + | Sum.inr (Sum.inl phase) => + match phase with + | .rewindOut => + dsimp only [] + split + · exact ⟨idleDir_right_of_start, fun _ => idleDir_right_of_start, + fun _ => rfl⟩ + · refine ⟨idleDir_right_of_start, fun _ => idleDir_right_of_start, ?_⟩ + intro h; next hn => exact absurd h hn + | .check => + dsimp only [] + split <;> exact ⟨idleDir_right_of_start, fun _ => idleDir_right_of_start, + idleDir_right_of_start⟩ + | .done => + exact rightOfStart_allIdle iHead wHeads oHead + | Sum.inr (Sum.inr (Sum.inl q)) => + dsimp only [] + split + · exact ⟨idleDir_right_of_start, fun _ => idleDir_right_of_start, + idleDir_right_of_start⟩ + · exact tmThen.δ_right_of_start q iHead wHeads oHead + | Sum.inr (Sum.inr (Sum.inr q)) => + dsimp only [] + split + · exact ⟨idleDir_right_of_start, fun _ => idleDir_right_of_start, + idleDir_right_of_start⟩ + · exact tmElse.δ_right_of_start q iHead wHeads oHead } + +-- ════════════════════════════════════════════════════════════════════════ +-- Sequential Composition +-- ════════════════════════════════════════════════════════════════════════ + +/-- The state type for the sequential composition TM. -/ +abbrev SeqQ (Q₁ Q₂ : Type) := Q₁ ⊕ Q₂ + +/-- Sequential composition: run tm₁ to completion, then tm₂ on the same tapes. + + Both machines share the same `n` work tapes, input tape, and output tape. + When tm₁ halts, there is one transition step that: + - Changes state from `Q₁` to `Q₂` (entering `tm₂.qstart`) + - Preserves all tape cell contents (via `readBackWrite`) + - Moves any tape head at position 0 to position 1 (forced by `δ_right_of_start`) + - Leaves all other tape head positions unchanged + + After the transition, tm₂ runs from the resulting tape state. + Total time: `t₁ + 1 + t₂` where `t₁` and `t₂` are the run times of + `tm₁` and `tm₂` respectively. -/ +def seqTM (tm₁ tm₂ : TM n) : TM n := + haveI : Fintype tm₁.Q := tm₁.finQ + haveI : DecidableEq tm₁.Q := tm₁.decEq + haveI : Fintype tm₂.Q := tm₂.finQ + haveI : DecidableEq tm₂.Q := tm₂.decEq + { Q := SeqQ tm₁.Q tm₂.Q, + qstart := Sum.inl tm₁.qstart, + qhalt := Sum.inr tm₂.qhalt, + δ := fun state iHead wHeads oHead => + match state with + -- ══════════════════════════════════════════════════════════════════ + -- Phase 1: simulate tm₁ + -- ══════════════════════════════════════════════════════════════════ + | Sum.inl q => + if q = tm₁.qhalt then + -- tm₁ halted → transition to tm₂.qstart, preserve tape contents + ( Sum.inr tm₂.qstart, + fun i => readBackWrite (wHeads i), + readBackWrite oHead, + idleDir iHead, + fun i => idleDir (wHeads i), + idleDir oHead ) + else + -- Not halted → run tm₁.δ, wrapping state in Sum.inl + let (q', wW, oW, iD, wD, oD) := tm₁.δ q iHead wHeads oHead + ( Sum.inl q', wW, oW, iD, wD, oD ) + -- ══════════════════════════════════════════════════════════════════ + -- Phase 2: simulate tm₂ + -- ══════════════════════════════════════════════════════════════════ + | Sum.inr q => + if q = tm₂.qhalt then + -- Unreachable by step, but δ is total + allIdle (Sum.inr tm₂.qhalt) iHead wHeads oHead + else + -- Not halted → run tm₂.δ, wrapping state in Sum.inr + let (q', wW, oW, iD, wD, oD) := tm₂.δ q iHead wHeads oHead + ( Sum.inr q', wW, oW, iD, wD, oD ), + δ_right_of_start := by + intro state iHead wHeads oHead + match state with + | Sum.inl q => + dsimp only [] + split + · exact ⟨idleDir_right_of_start, fun _ => idleDir_right_of_start, + idleDir_right_of_start⟩ + · exact tm₁.δ_right_of_start q iHead wHeads oHead + | Sum.inr q => + dsimp only [] + split + · exact rightOfStart_allIdle iHead wHeads oHead + · exact tm₂.δ_right_of_start q iHead wHeads oHead } + +-- ════════════════════════════════════════════════════════════════════════ +-- Loop Combinator +-- ════════════════════════════════════════════════════════════════════════ + +/-- Intermediate states for the loop machine's output-checking phase. -/ +inductive LoopPhase where + | rewindOut -- rewind output head left to ▷ (cell 0) + | check -- at cell 1: read output, decide continue/halt + | done -- halt state + deriving DecidableEq + +instance : Fintype LoopPhase where + elems := {.rewindOut, .check, .done} + complete := fun x => by cases x <;> simp + +/-- The state type for the loop TM. -/ +abbrev LoopQ (QBody QTest : Type) := QBody ⊕ LoopPhase ⊕ QTest + +/-- Loop combinator: repeatedly run `tmBody` then `tmTest`, halting when + the test's output at cell 1 is `Γ.one`. + + Both machines share the same `n` work tapes, input tape, and output tape. + Work tape contents are preserved across transitions (via `readBackWrite`), + allowing the body to accumulate state across iterations. + + ## Phases + + 1. **Body**: Simulate `tmBody`. When it halts, transition to test. + 2. **Test**: Simulate `tmTest`. When it halts, enter rewind. + 3. **Rewind output**: Move output head left to `▷` (cell 0). + 4. **Check**: Move right to cell 1, read the test result. + If `Γ.one`, enter `done` (halt). Otherwise, transition back to body. + + ## Use case + + The UTM's main loop: `loopTM simStepTM checkHaltTM` runs one simulation + step, then checks if the simulated machine has halted. -/ +def loopTM (tmBody : TM n) (tmTest : TM n) : TM n := + haveI : Fintype tmBody.Q := tmBody.finQ + haveI : DecidableEq tmBody.Q := tmBody.decEq + haveI : Fintype tmTest.Q := tmTest.finQ + haveI : DecidableEq tmTest.Q := tmTest.decEq + { Q := LoopQ tmBody.Q tmTest.Q, + qstart := Sum.inl tmBody.qstart, + qhalt := Sum.inr (Sum.inl .done), + δ := fun state iHead wHeads oHead => + match state with + -- ══════════════════════════════════════════════════════════════════ + -- Body phase: simulate tmBody + -- ══════════════════════════════════════════════════════════════════ + | Sum.inl q => + if q = tmBody.qhalt then + -- Body halted → transition to test, preserve tape contents + ( Sum.inr (Sum.inr tmTest.qstart), + fun i => readBackWrite (wHeads i), + readBackWrite oHead, + idleDir iHead, + fun i => idleDir (wHeads i), + idleDir oHead ) + else + let (q', wW, oW, iD, wD, oD) := tmBody.δ q iHead wHeads oHead + ( Sum.inl q', wW, oW, iD, wD, oD ) + -- ══════════════════════════════════════════════════════════════════ + -- Transition phases: rewind and check output + -- ══════════════════════════════════════════════════════════════════ + | Sum.inr (Sum.inl phase) => + match phase with + | .rewindOut => + if oHead = Γ.start then + -- At ▷ (cell 0) → move right to cell 1, enter check + ( Sum.inr (Sum.inl .check), + fun i => readBackWrite (wHeads i), + .blank, + idleDir iHead, + fun i => idleDir (wHeads i), + Dir3.right ) + else + -- Not at cell 0 → keep moving left, preserve output + ( Sum.inr (Sum.inl .rewindOut), + fun i => readBackWrite (wHeads i), + readBackWrite oHead, + idleDir iHead, + fun i => idleDir (wHeads i), + Dir3.left ) + | .check => + if oHead = Γ.one then + -- Test output = 1: halt the loop + ( Sum.inr (Sum.inl .done), + fun i => readBackWrite (wHeads i), + readBackWrite oHead, + idleDir iHead, + fun i => idleDir (wHeads i), + idleDir oHead ) + else + -- Test output ≠ 1: loop back to body + ( Sum.inl tmBody.qstart, + fun i => readBackWrite (wHeads i), + readBackWrite oHead, + idleDir iHead, + fun i => idleDir (wHeads i), + idleDir oHead ) + | .done => + allIdle (Sum.inr (Sum.inl .done)) iHead wHeads oHead + -- ══════════════════════════════════════════════════════════════════ + -- Test phase: simulate tmTest + -- ══════════════════════════════════════════════════════════════════ + | Sum.inr (Sum.inr q) => + if q = tmTest.qhalt then + -- Test halted → begin rewinding output, preserve tapes + ( Sum.inr (Sum.inl .rewindOut), + fun i => readBackWrite (wHeads i), + readBackWrite oHead, + idleDir iHead, + fun i => idleDir (wHeads i), + idleDir oHead ) + else + let (q', wW, oW, iD, wD, oD) := tmTest.δ q iHead wHeads oHead + ( Sum.inr (Sum.inr q'), wW, oW, iD, wD, oD ), + δ_right_of_start := by + intro state iHead wHeads oHead + match state with + | Sum.inl q => + dsimp only [] + split + · exact ⟨idleDir_right_of_start, fun _ => idleDir_right_of_start, + idleDir_right_of_start⟩ + · exact tmBody.δ_right_of_start q iHead wHeads oHead + | Sum.inr (Sum.inl phase) => + match phase with + | .rewindOut => + dsimp only [] + split + · exact ⟨idleDir_right_of_start, fun _ => idleDir_right_of_start, + fun _ => rfl⟩ + · refine ⟨idleDir_right_of_start, fun _ => idleDir_right_of_start, ?_⟩ + intro h; next hn => exact absurd h hn + | .check => + dsimp only [] + split <;> exact ⟨idleDir_right_of_start, fun _ => idleDir_right_of_start, + idleDir_right_of_start⟩ + | .done => + exact rightOfStart_allIdle iHead wHeads oHead + | Sum.inr (Sum.inr q) => + dsimp only [] + split + · exact ⟨idleDir_right_of_start, fun _ => idleDir_right_of_start, + idleDir_right_of_start⟩ + · exact tmTest.δ_right_of_start q iHead wHeads oHead } + +-- ════════════════════════════════════════════════════════════════════════ +-- Finite-state scanner +-- ════════════════════════════════════════════════════════════════════════ + +/-- Control states of a generic finite-state scanner parameterized by a + user-supplied scan-state type `S`. The machine has a one-time `start` + step that advances off cell 0, then a stream of `scan s` states holding + the current scan state, and finally a `done` halt state. -/ +inductive ScannerPhase (S : Type) where + | start + | scan (s : S) + | done + +instance {S : Type} [DecidableEq S] : DecidableEq (ScannerPhase S) + | .start, .start => isTrue rfl + | .start, .scan _ => isFalse (fun h => by cases h) + | .start, .done => isFalse (fun h => by cases h) + | .scan _, .start => isFalse (fun h => by cases h) + | .scan _, .done => isFalse (fun h => by cases h) + | .done, .start => isFalse (fun h => by cases h) + | .done, .scan _ => isFalse (fun h => by cases h) + | .done, .done => isTrue rfl + | .scan s₁, .scan s₂ => + if h : s₁ = s₂ then isTrue (by rw [h]) + else isFalse (fun heq => h (by cases heq; rfl)) + +instance {S : Type} [DecidableEq S] [Fintype S] : Fintype (ScannerPhase S) where + elems := insert ScannerPhase.start + (insert (ScannerPhase.done : ScannerPhase S) + (Finset.univ.image ScannerPhase.scan)) + complete := fun x => by + cases x with + | start => exact Finset.mem_insert_self _ _ + | done => exact Finset.mem_insert_of_mem (Finset.mem_insert_self _ _) + | scan s => + apply Finset.mem_insert_of_mem + apply Finset.mem_insert_of_mem + exact Finset.mem_image.mpr ⟨s, Finset.mem_univ s, rfl⟩ + +/-- **Generic finite-state scanner.** + + A 0-work-tape TM parameterized by a scan-state type `S`, an initial + state `s₀`, a transition function `scanStep : S → Bool → S` (called on + each input bit), and a finalizer `finalOutput : S → Γw` (the symbol to + emit when end-of-input is reached). + + Semantics: runs left-to-right through the input, folding `scanStep` over + the bits starting from `s₀`; when a blank is reached, writes + `finalOutput (finalState)` to output cell 1 and halts. + + This captures the common "read once, fold into a fixed-size state" + pattern used by `evenLength`, `allZeros`/`allOnes`, `containsZero`/`containsOne`, + `lengthDivBy k`, `lastBit`, and similar regular-language scanners. + + Halts in `|x| + 2` steps on every input (1 start + `|x|` scans + 1 halt). -/ +def scannerTM {S : Type} [DecidableEq S] [Fintype S] + (s₀ : S) (scanStep : S → Bool → S) (finalOutput : S → Γw) : TM 0 where + Q := ScannerPhase S + qstart := .start + qhalt := .done + δ := fun state iHead _wHeads oHead => + match state with + | .start => + -- Advance input and output from cell 0 (▷) to cell 1. Writes at cell 0 + -- are no-ops. Enter the initial scan state. + (.scan s₀, fun i => i.elim0, .blank, + .right, fun i => i.elim0, .right) + | .scan s => + if iHead = Γ.blank then + -- End of input. Emit `finalOutput s` and halt. + (.done, fun i => i.elim0, finalOutput s, + idleDir iHead, fun i => i.elim0, idleDir oHead) + else + -- Read a bit: `Γ.one ↦ true`, anything else (including the + -- structurally-unreachable `Γ.start`) ↦ `false`. + let b : Bool := decide (iHead = Γ.one) + (.scan (scanStep s b), fun i => i.elim0, readBackWrite oHead, + .right, fun i => i.elim0, idleDir oHead) + | .done => + allIdle .done iHead _wHeads oHead + δ_right_of_start := by + intro state iHead wHeads oHead + match state with + | .start => + refine ⟨fun _ => rfl, fun i => i.elim0, fun _ => rfl⟩ + | .scan _ => + dsimp only []; split + · exact ⟨idleDir_right_of_start, fun i => i.elim0, idleDir_right_of_start⟩ + · exact ⟨fun _ => rfl, fun i => i.elim0, idleDir_right_of_start⟩ + | .done => + exact rightOfStart_allIdle iHead wHeads oHead + +-- ════════════════════════════════════════════════════════════════════════ +-- retargetInput: read virtual input from work tape k instead of input tape +-- ════════════════════════════════════════════════════════════════════════ + +/-- Given a DTM `M : TM k`, construct a DTM `retargetInput M : TM (k + 1)` + that behaves like `M` but reads its "input" from work tape `k` (the last + work tape) instead of the real input tape. + + Tape layout: + - Real input tape: ignored (moved idly each step, never read). + - Work tapes `0..k-1`: mirror `M`'s work tapes. + - Work tape `k`: plays the role of `M`'s input tape (read-only, no + writes except a no-op `readBackWrite` that preserves cells). + + When work tape `k` is initialized with `Tape.init (z.map Γ.ofBool)`, the + machine simulates `M` on input `z`. + + Used in `witnessLang` NTM constructions where the verifier DTM's + "input" (e.g. `pair(x, y)`) is built on a work tape rather than + supplied on the real input tape. -/ +def retargetInput {k : ℕ} (M : TM k) : TM (k + 1) where + Q := M.Q + qstart := M.qstart + qhalt := M.qhalt + δ := fun q _iHead wHeads oHead => + let virtualInput : Γ := wHeads ⟨k, by omega⟩ + let innerWork : Fin k → Γ := fun i => wHeads ⟨i.val, by omega⟩ + let (q', workWrites, outWrite, inDir, workDirs, outDir) := + M.δ q virtualInput innerWork oHead + ( q', + fun i => + if h : i.val < k then workWrites ⟨i.val, h⟩ + else readBackWrite virtualInput, + outWrite, + idleDir _iHead, + fun i => + if h : i.val < k then workDirs ⟨i.val, h⟩ + else inDir, + outDir ) + δ_right_of_start := by + intro q iHead wHeads oHead + have hδ := M.δ_right_of_start q (wHeads ⟨k, by omega⟩) + (fun i => wHeads ⟨i.val, by omega⟩) oHead + obtain ⟨hinp, hwork, hout⟩ := hδ + refine ⟨idleDir_right_of_start, ?_, hout⟩ + intro i hwi + dsimp only [] + split + · next hi => + -- i.val < k: use M's work condition + exact hwork ⟨i.val, hi⟩ (by + change wHeads ⟨i.val, _⟩ = _ + rwa [show wHeads ⟨i.val, by omega⟩ = wHeads i from by congr 1]) + · next hi => + -- i.val = k: use M's input condition + have hik : i.val = k := by + have := i.isLt + omega + have : wHeads ⟨k, by omega⟩ = Γ.start := by + rw [show (⟨k, by omega⟩ : Fin (k + 1)) = i from by ext; simp [hik]] + exact hwi + exact hinp this + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/Apply.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/Apply.lean new file mode 100644 index 0000000000..cf31018bf8 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/Apply.lean @@ -0,0 +1,175 @@ +/- +Copyright (c) 2026 Bolton Bailey. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Bolton Bailey +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.RetargetCompute +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Frame +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Hoare.RetargetOutput + +/-! +# Running a machine from a work tape onto a work tape + +A loop body cannot compute into the real output tape — it is one-way, so it +cannot serve as scratch across iterations. `TM.retargetInputStarted` reads a +machine's input off a work tape and `TM.retargetOutput` writes its output onto a +fresh one; composing them gives `TM.applyTM`, a work-to-work evaluator, and +composing their Hoare rules gives its contract. + +## Main results + +- `TM.applyTM` — the work-to-work evaluator for a source machine +- `TM.applyTM_hoareTime` / `TM.applyTM_hoareTime_frame` — its time contract +-/ + + +@[expose] public section + +namespace Complexity + +namespace TM + +variable {k : ℕ} + +/-- **Work-tape-to-work-tape evaluation.** `applyTM M : TM (k + 2)` reads the +source machine's input off work tape `k`, runs `M` on it, and leaves the result +on work tape `k + 1`; the real input and output tapes are untouched. + +Work tapes `0, …, k-1` are `M`'s own scratch, so a caller that runs `applyTM M` +more than once has to restore them between calls — that is what the +precondition below demands. -/ +def applyTM (M : TM k) : TM (k + 2) := (retargetInputStarted M).retargetOutput + +/-- The tapes `applyTM M` expects at entry: `M`'s scratch blank, the virtual +input holding `y`, the result tape blank. -/ +def applyPre (M : TM k) (y : List Bool) (realInput : Tape) : + Fin (k + 2) → Tape := + Fin.snoc (retargetInputStartedCfg M y realInput).work parkedBlank + +/-- **The contract of the work-to-work evaluator.** Given `M`'s own time bound, +`applyTM M` halts within that bound with `f y` on its result tape — provided +`M`'s scratch tapes were blank, work tape `k` held `y`, and the result tape was +blank. -/ +theorem applyTM_hoareTime (M : TM k) {f : List Bool → List Bool} {T : ℕ → ℕ} + (hcomp : M.ComputesInTime f T) (y : List Bool) : + (applyTM M).HoareTime + (fun inp work out => + ((fun i : Fin (k + 1) => work (Fin.castSucc i)) + = (retargetInputStartedCfg M y inp).work) ∧ + work (Fin.last (k + 1)) = parkedBlank ∧ + out = parkedBlank) + (fun _inp work out => + (work (Fin.last (k + 1))).HasOutput (f y) ∧ out = parkedBlank) + (T y.length) := by + have h := retargetOutput_hoareTime (retargetInputStarted M) + (retargetInputStarted_hoareTime M hcomp y) + intro inp work out hpre + obtain ⟨h1, h2, h3⟩ := hpre + exact h inp work out ⟨⟨h1, h2⟩, h3⟩ + +/-- The entry tapes do satisfy the entry condition. -/ +theorem applyPre_spec (M : TM k) (y : List Bool) (realInput : Tape) : + ((fun i : Fin (k + 1) => applyPre M y realInput (Fin.castSucc i)) + = (retargetInputStartedCfg M y realInput).work) ∧ + applyPre M y realInput (Fin.last (k + 1)) = parkedBlank := by + refine ⟨funext fun i => ?_, ?_⟩ + · rw [applyPre, Fin.snoc_castSucc] + · rw [applyPre, Fin.snoc_last] + +/-- The work-to-work evaluator reads its input from a work tape, so it idles +the real input head. -/ +theorem applyTM_idlesInput (M : TM k) : IdlesInput (applyTM M) := fun _ _ _ _ => rfl + +/-- Every entry tape of the work-to-work evaluator is parked at cell `1`. -/ +theorem applyPre_head (M : TM k) (y : List Bool) (realInput : Tape) (i : Fin (k + 2)) : + (applyPre M y realInput i).head = 1 := by + refine Fin.lastCases ?_ ?_ i + · rw [applyPre, Fin.snoc_last]; rfl + · intro i' + rw [applyPre, Fin.snoc_castSucc] + show ((retargetInputStartedCfg M y realInput).work i').head = 1 + rw [retargetInputStartedCfg] + dsimp only + split <;> rfl + +/-- Every entry tape of the work-to-work evaluator satisfies the left-marker +invariant. -/ +theorem applyPre_startInvariant (M : TM k) (y : List Bool) (realInput : Tape) + (i : Fin (k + 2)) : Tape.StartInvariant (applyPre M y realInput i) := by + refine Fin.lastCases ?_ ?_ i + · rw [applyPre, Fin.snoc_last] + show Tape.StartInvariant ((Tape.init ([] : List Γ)).move Dir3.right) + exact startInvariant_initNil.move Dir3.right + · intro i' + rw [applyPre, Fin.snoc_castSucc] + show Tape.StartInvariant ((retargetInputStartedCfg M y realInput).work i') + rw [retargetInputStartedCfg] + dsimp only + split + · exact startInvariant_initNil.move Dir3.right + · exact (startInvariant_initOfBool y).move Dir3.right + +/-- Every entry tape of the work-to-work evaluator is blank beyond the virtual +input's length. -/ +theorem applyPre_cells_blank (M : TM k) (y : List Bool) (realInput : Tape) + (i : Fin (k + 2)) (j : ℕ) (hj : y.length < j) : + (applyPre M y realInput i).cells j = Γ.blank := by + have hj0 : j = (j - 1) + 1 := by omega + refine Fin.lastCases ?_ ?_ i + · rw [applyPre, Fin.snoc_last] + show ((Tape.init ([] : List Γ)).move Dir3.right).cells j = Γ.blank + rw [Tape.move_cells, hj0, Tape.init_cells_ge [] (j - 1) (by simp)] + · intro i' + rw [applyPre, Fin.snoc_castSucc] + show ((retargetInputStartedCfg M y realInput).work i').cells j = Γ.blank + rw [retargetInputStartedCfg] + dsimp only + split + · show ((Tape.init ([] : List Γ)).move Dir3.right).cells j = Γ.blank + rw [Tape.move_cells, hj0, Tape.init_cells_ge [] (j - 1) (by simp)] + · show ((Tape.init (y.map Γ.ofBool)).move Dir3.right).cells j = Γ.blank + rw [Tape.move_cells, hj0, + Tape.init_cells_ge (y.map Γ.ofBool) (j - 1) (by simp only [List.length_map]; omega)] + +/-- **The work-to-work evaluator, with its disturbance framed.** Beyond +computing `f y` onto the result tape, this records the two facts a caller needs +in order to reset the machine for a second call: every tape's head is still +within `H`, and every cell beyond `H` is still blank. Both follow from the run +being `T |y|`-bounded and every entry tape being parked and blank past `|y|`. -/ +theorem applyTM_hoareTime_frame (M : TM k) {f : List Bool → List Bool} {T : ℕ → ℕ} + (hcomp : M.ComputesInTime f T) (y : List Bool) (inp₀ : Tape) (hinp : Parked inp₀) + (hinpSI : Tape.StartInvariant inp₀) + (H : ℕ) (hHy : y.length ≤ H) (hHT : 1 + T y.length ≤ H) : + (applyTM M).HoareTime + (fun inp work out => inp = inp₀ ∧ work = applyPre M y inp₀ ∧ out = parkedBlank) + (fun inp work out => inp = inp₀ ∧ out = parkedBlank ∧ + (work (Fin.last (k + 1))).HasOutput (f y) ∧ + ∀ i, Tape.StartInvariant (work i) ∧ (work i).head ≤ H ∧ + ∀ j, H < j → (work i).cells j = Γ.blank) + (T y.length) := by + intro inp work out hpre + obtain ⟨hi, hw, ho⟩ := hpre + rw [hi, hw, ho] + obtain ⟨c', t, ht, hreach, hhalt, hOut, hOutEq⟩ := + applyTM_hoareTime M hcomp y inp₀ (applyPre M y inp₀) parkedBlank + ⟨(applyPre_spec M y inp₀).1, (applyPre_spec M y inp₀).2, rfl⟩ + have hinpEq : c'.input = inp₀ := + reachesIn_input_eq_of_idlesInput (applyTM_idlesInput M) hreach hinp + have hSI := reachesIn_startInvariant hreach hinpSI + (fun i => applyPre_startInvariant M y inp₀ i) + (show Tape.StartInvariant parkedBlank from startInvariant_initNil.move Dir3.right) + refine ⟨c', t, ht, hreach, hhalt, hinpEq, hOutEq, hOut, + fun i => ⟨hSI.2.1 i, ?_, fun j hj => ?_⟩⟩ + · have hh := (head_le_start_add_of_reachesIn (applyTM M) hreach).2.2 i + rw [show ((⟨(applyTM M).qstart, inp₀, applyPre M y inp₀, parkedBlank⟩ : + Cfg (k + 2) (applyTM M).Q).work i).head = 1 from applyPre_head M y inp₀ i] at hh + omega + · rw [reachesIn_work_cells_far hreach i j + (by rw [applyPre_head M y inp₀ i]; omega)] + exact applyPre_cells_blank M y inp₀ i j (by omega) + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/ForBinaryWork.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/ForBinaryWork.lean new file mode 100644 index 0000000000..6a3bd4e73f --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/ForBinaryWork.lean @@ -0,0 +1,73 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.ForBinaryWork.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.ForBinaryWork.Internal + +/-! +# Binary work-tape loop combinator + +`TM.forBinaryWorkTM driverIdx body` invokes `body` once per Boolean cell on a +designated work tape and stops at the first blank. The body sees the current +bit; the loopback seam advances the driver. This supplies width-driven control +for bitwise algorithms without iterating over the represented numeric value. + +## Main results + +- `TM.ForBinaryWorkLoopSpec.reachesIn` composes an indexed exact-execution + certificate for the complete loop. +- `TM.ForBinaryWorkLoopSpaceSpec.prefix_withinAuxSpace` bounds every prefix of + the certified loop run. +- `TM.IsTransducer.forBinaryWorkTM` preserves one-way output safety. +-/ + + +public section + +namespace Complexity + +namespace TM + +variable {n : ℕ} + +/-- Exact remaining execution of a certified binary work-tape loop. -/ +theorem ForBinaryWorkLoopSpec.reachesIn + {driverIdx : Fin n} {body : TM n} {bodyTime : ℕ → ℕ} + {total count value : ℕ} + (spec : ForBinaryWorkLoopSpec driverIdx body bodyTime total) + (htotal : value + count = total) : + (forBinaryWorkTM driverIdx body).reachesIn + (forBinaryWorkLoopTime bodyTime value count) + (spec.scanCfg value) spec.doneCfg := + spec.reachesIn_internal count value htotal + +/-- Every prefix up to the exact remaining runtime of a certified binary-work +loop respects its all-reachable auxiliary-space budget. -/ +theorem ForBinaryWorkLoopSpaceSpec.prefix_withinAuxSpace + {driverIdx : Fin n} {body : TM n} {bodyTime : ℕ → ℕ} + {total inputLength spaceBound count value t : ℕ} + {spec : ForBinaryWorkLoopSpec driverIdx body bodyTime total} + (spaceSpec : ForBinaryWorkLoopSpaceSpec spec inputLength spaceBound) + {c : Cfg n (forBinaryWorkTM driverIdx body).Q} + (htotal : value + count = total) + (hreach : (forBinaryWorkTM driverIdx body).reachesIn t + (spec.scanCfg value) c) + (htime : t ≤ forBinaryWorkLoopTime bodyTime value count) : + c.WithinAuxSpace inputLength spaceBound := + spaceSpec.prefix_withinAuxSpace_internal count value t c htotal hreach + htime + +/-- Iterating a one-way-output body over a binary work tape remains a +transducer. -/ +theorem IsTransducer.forBinaryWorkTM + {driverIdx : Fin n} {body : TM n} (hbody : body.IsTransducer) : + (forBinaryWorkTM driverIdx body).IsTransducer := + hbody.forBinaryWorkTM_internal + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/ForBinaryWork/Defs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/ForBinaryWork/Defs.lean new file mode 100644 index 0000000000..9e69933075 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/ForBinaryWork/Defs.lean @@ -0,0 +1,157 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators + +/-! +# Binary work-tape loop combinator -- definitions + +`TM.forBinaryWorkTM driverIdx body` invokes `body` once for each `0` or `1` +under a designated work-tape cursor and stops on the first blank. The body sees +the current bit; the loopback seam advances the driver by one cell. This is the +width-driven control needed by bitwise algorithms such as schoolbook +multiplication, without a numeric-value counter. +-/ + + +@[expose] public section + +namespace Complexity + +namespace TM + +/-- Scanner and terminal states outside the nested body machine. -/ +inductive ForBinaryWorkPhase where + | scan + | done + deriving DecidableEq + +/-- `ForBinaryWorkPhase` has exactly two states. -/ +instance instFintypeForBinaryWorkPhase : Fintype ForBinaryWorkPhase where + elems := {.scan, .done} + complete := fun phase => by cases phase <;> simp + +/-- Iterate `body` over the Boolean cells of work tape `driverIdx`. + +The scanner skips an initial left marker, halts on blank, and enters `body` +without moving on either Boolean symbol. When the body halts, one preserving +seam step advances only the driver and resumes scanning. Exact once-per-bit +semantics therefore requires the body to preserve the driver tape and head. -/ +def forBinaryWorkTM {n : ℕ} (driverIdx : Fin n) (body : TM n) : TM n where + Q := ForBinaryWorkPhase ⊕ body.Q + qstart := .inl .scan + qhalt := .inl .done + δ := fun state iHead wHeads oHead => + match state with + | .inl .scan => + if wHeads driverIdx = Γ.start then + (.inl .scan, fun i => readBackWrite (wHeads i), + readBackWrite oHead, idleDir iHead, + fun i => if i = driverIdx then Dir3.right + else idleDir (wHeads i), + idleDir oHead) + else if wHeads driverIdx = Γ.blank then + allReadBack (.inl .done) iHead wHeads oHead + else + allReadBack (.inr body.qstart) iHead wHeads oHead + | .inl .done => allIdle (.inl .done) iHead wHeads oHead + | .inr state => + if state = body.qhalt then + (.inl .scan, fun i => readBackWrite (wHeads i), + readBackWrite oHead, idleDir iHead, + fun i => if i = driverIdx then Dir3.right + else idleDir (wHeads i), + idleDir oHead) + else + ((Sum.inr (body.δ state iHead wHeads oHead).1 : + ForBinaryWorkPhase ⊕ body.Q), + (body.δ state iHead wHeads oHead).2.1, + (body.δ state iHead wHeads oHead).2.2.1, + (body.δ state iHead wHeads oHead).2.2.2.1, + (body.δ state iHead wHeads oHead).2.2.2.2.1, + (body.δ state iHead wHeads oHead).2.2.2.2.2) + δ_right_of_start := by + intro state iHead wHeads oHead + match state with + | .inl .scan => + dsimp only + split + · refine ⟨idleDir_right_of_start, ?_, idleDir_right_of_start⟩ + intro i hi + simp only + split + · rfl + · exact idleDir_right_of_start hi + · split <;> exact rightOfStart_allReadBack iHead wHeads oHead + | .inl .done => exact rightOfStart_allIdle iHead wHeads oHead + | .inr state => + dsimp only + split + · refine ⟨idleDir_right_of_start, ?_, idleDir_right_of_start⟩ + intro i hi + simp only + split + · rfl + · exact idleDir_right_of_start hi + · exact body.δ_right_of_start state iHead wHeads oHead + +/-- Exact remaining time for a bit-driven work loop. Each live iteration takes +one scanner step, the body run, and one advancing loopback step; the terminal +blank exit takes one step. -/ +def forBinaryWorkLoopTime (bodyTime : ℕ → ℕ) (value : ℕ) : ℕ → ℕ + | 0 => 1 + | count + 1 => + 1 + bodyTime value + 1 + + forBinaryWorkLoopTime bodyTime (value + 1) count + +/-- Wrapper-free exact-control certificate for a binary work-tape loop. -/ +structure ForBinaryWorkLoopSpec {n : ℕ} (driverIdx : Fin n) (body : TM n) + (bodyTime : ℕ → ℕ) (total : ℕ) where + /-- Canonical scanner configuration at iteration `value`. -/ + scanCfg : ℕ → Cfg n (forBinaryWorkTM driverIdx body).Q + /-- Canonical combined-machine configuration at body entry. -/ + bodyStartCfg : ℕ → Cfg n (forBinaryWorkTM driverIdx body).Q + /-- Canonical combined-machine configuration after the exact body run. -/ + bodyDoneCfg : ℕ → Cfg n (forBinaryWorkTM driverIdx body).Q + /-- Canonical final driver configuration. -/ + doneCfg : Cfg n (forBinaryWorkTM driverIdx body).Q + /-- One scanner step on a Boolean cell enters the body. -/ + scanStep : ∀ value, value < total → + (forBinaryWorkTM driverIdx body).step (scanCfg value) = + some (bodyStartCfg value) + /-- The body has the advertised exact runtime. -/ + bodyRun : ∀ value, value < total → + (forBinaryWorkTM driverIdx body).reachesIn (bodyTime value) + (bodyStartCfg value) (bodyDoneCfg value) + /-- The preserving loopback advances the driver to the next cell. -/ + loopbackStep : ∀ value, value < total → + (forBinaryWorkTM driverIdx body).step (bodyDoneCfg value) = + some (scanCfg (value + 1)) + /-- The scanner exits on the first blank. -/ + stopStep : + (forBinaryWorkTM driverIdx body).step (scanCfg total) = some doneCfg + +/-- Space obligations turning an exact binary-work loop certificate into an +all-prefix auxiliary-space certificate. -/ +structure ForBinaryWorkLoopSpaceSpec {n : ℕ} {driverIdx : Fin n} + {body : TM n} {bodyTime : ℕ → ℕ} {total : ℕ} + (spec : ForBinaryWorkLoopSpec driverIdx body bodyTime total) + (inputLength spaceBound : ℕ) where + /-- Every canonical scanner configuration is within the space budget. -/ + scanWithin : ∀ value, value ≤ total → + (spec.scanCfg value).WithinAuxSpace inputLength spaceBound + /-- The canonical terminal configuration is within the space budget. -/ + doneWithin : spec.doneCfg.WithinAuxSpace inputLength spaceBound + /-- Every prefix of each exact body run remains within the budget. -/ + bodyPrefixWithin : ∀ value t c, value < total → t ≤ bodyTime value → + (forBinaryWorkTM driverIdx body).reachesIn t + (spec.bodyStartCfg value) c → + c.WithinAuxSpace inputLength spaceBound + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/ForBinaryWork/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/ForBinaryWork/Internal.lean new file mode 100644 index 0000000000..4659eff31b --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/ForBinaryWork/Internal.lean @@ -0,0 +1,311 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.ForBinaryWork.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.Internal.Generic +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.SpaceTime.Internal.Reachability + +/-! +# Binary work-tape loop combinator -- proof internals + +This module proves exact body embedding, bit/blank scanner transitions, the +advancing loopback seam, certified finite iteration, and transducer closure. +-/ + + +@[expose] public section + +namespace Complexity + +namespace TM + +variable {n : ℕ} + +/-- Embed a body configuration in the body phase of `forBinaryWorkTM`. -/ +def forBinaryWorkBodyWrap (driverIdx : Fin n) (body : TM n) + (cfg : Cfg n body.Q) : Cfg n (forBinaryWorkTM driverIdx body).Q := + { state := .inr cfg.state + input := cfg.input + work := cfg.work + output := cfg.output } + +/-- Every nonhalting body step is simulated exactly. -/ +theorem forBinaryWorkTM_body_step_internal (driverIdx : Fin n) (body : TM n) + {cfg next : Cfg n body.Q} (hstep : body.step cfg = some next) : + (forBinaryWorkTM driverIdx body).step + (forBinaryWorkBodyWrap driverIdx body cfg) = + some (forBinaryWorkBodyWrap driverIdx body next) := by + have hne : cfg.state ≠ body.qhalt := state_ne_qhalt_of_step hstep + rw [TM.step, if_neg (by simp [forBinaryWorkBodyWrap, forBinaryWorkTM])] + simp only [forBinaryWorkBodyWrap, forBinaryWorkTM, hne, ↓reduceIte] + rw [TM.step, if_neg hne] at hstep + revert hstep + generalize body.δ cfg.state cfg.input.read (fun i => (cfg.work i).read) + cfg.output.read = action + obtain ⟨state, workWrites, outputWrite, inputDir, workDirs, outputDir⟩ := + action + intro hstep + cases Option.some.inj hstep + rfl + +/-- Exact body runs lift through the combined machine's body phase. -/ +theorem forBinaryWorkTM_body_reachesIn_internal + (driverIdx : Fin n) (body : TM n) + {time : ℕ} {cfg next : Cfg n body.Q} + (hreach : body.reachesIn time cfg next) : + (forBinaryWorkTM driverIdx body).reachesIn time + (forBinaryWorkBodyWrap driverIdx body cfg) + (forBinaryWorkBodyWrap driverIdx body next) := + reachesIn_map (forBinaryWorkBodyWrap driverIdx body) + (fun _ _ => forBinaryWorkTM_body_step_internal driverIdx body) hreach + +/-- On either Boolean symbol, the scanner enters the body without moving or +changing any tape. -/ +theorem forBinaryWorkTM_step_scan_bit_internal + (driverIdx : Fin n) (body : TM n) (bit : Bool) + (cfg : Cfg n (forBinaryWorkTM driverIdx body).Q) + (hstate : cfg.state = .inl .scan) + (hbit : (cfg.work driverIdx).read = Γ.ofBool bit) + (hinput : cfg.input.read ≠ Γ.start) + (hwork : ∀ i, (cfg.work i).read ≠ Γ.start) + (houtput : cfg.output.read ≠ Γ.start) : + (forBinaryWorkTM driverIdx body).step cfg = some + { state := .inr body.qstart + input := cfg.input + work := cfg.work + output := cfg.output } := by + have hstart : (cfg.work driverIdx).read ≠ Γ.start := by + rw [hbit] + exact Γ.ofBool_ne_start bit + have hblank : (cfg.work driverIdx).read ≠ Γ.blank := by + rw [hbit] + cases bit <;> decide + rw [TM.step, if_neg (by rw [hstate]; simp [forBinaryWorkTM])] + simp only [forBinaryWorkTM, hstate, hstart, hblank, allReadBack, + ↓reduceIte] + refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, ?_, ?_, ?_⟩) + · exact transitionInput_eq_self hinput + · funext i + exact transitionTape_eq_self (hwork i) + · exact transitionTape_eq_self houtput + +/-- On the first blank, the scanner halts without consuming it. -/ +theorem forBinaryWorkTM_step_scan_blank_internal + (driverIdx : Fin n) (body : TM n) + (cfg : Cfg n (forBinaryWorkTM driverIdx body).Q) + (hstate : cfg.state = .inl .scan) + (hblank : (cfg.work driverIdx).read = Γ.blank) + (hinput : cfg.input.read ≠ Γ.start) + (hwork : ∀ i, (cfg.work i).read ≠ Γ.start) + (houtput : cfg.output.read ≠ Γ.start) : + (forBinaryWorkTM driverIdx body).step cfg = some + { state := .inl .done + input := cfg.input + work := cfg.work + output := cfg.output } := by + rw [TM.step, if_neg (by rw [hstate]; simp [forBinaryWorkTM])] + simp only [forBinaryWorkTM, hstate, hblank, allReadBack, + ↓reduceIte] + refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, ?_, ?_, ?_⟩) + · exact transitionInput_eq_self hinput + · funext i + exact transitionTape_eq_self (hwork i) + · exact transitionTape_eq_self houtput + +/-- A halted body takes one preserving seam step that advances only the +selected driver head. -/ +theorem forBinaryWorkTM_step_body_halt_internal + (driverIdx : Fin n) (body : TM n) + (cfg : Cfg n body.Q) (hhalt : body.halted cfg) + (hinput : cfg.input.read ≠ Γ.start) + (hwork : ∀ i, (cfg.work i).read ≠ Γ.start) + (houtput : cfg.output.read ≠ Γ.start) : + (forBinaryWorkTM driverIdx body).step + (forBinaryWorkBodyWrap driverIdx body cfg) = some + { state := .inl .scan + input := cfg.input + work := fun i => + if i = driverIdx then (cfg.work i).move Dir3.right + else cfg.work i + output := cfg.output } := by + rw [TM.step, if_neg (by simp [forBinaryWorkBodyWrap, forBinaryWorkTM])] + simp only [forBinaryWorkBodyWrap, forBinaryWorkTM, hhalt, ↓reduceIte] + refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, ?_, ?_, ?_⟩) + · exact transitionInput_eq_self hinput + · funext i + rw [writeAndMove_readBack _ (hwork i)] + split + · rfl + · rw [idleDir, if_neg (hwork i)] + rfl + · rw [writeAndMove_readBack _ houtput, idleDir, if_neg houtput] + rfl + +/-- A certified bit-driven loop has its advertised exact remaining run. -/ +theorem ForBinaryWorkLoopSpec.reachesIn_internal + {driverIdx : Fin n} {body : TM n} {bodyTime : ℕ → ℕ} {total : ℕ} + (spec : ForBinaryWorkLoopSpec driverIdx body bodyTime total) : + ∀ count value, value + count = total → + (forBinaryWorkTM driverIdx body).reachesIn + (forBinaryWorkLoopTime bodyTime value count) + (spec.scanCfg value) spec.doneCfg := by + intro count + induction count with + | zero => + intro value htotal + have hvalue : value = total := by omega + subst value + exact .step spec.stopStep .zero + | succ count ih => + intro value htotal + have hvalue : value < total := by omega + have hscan : (forBinaryWorkTM driverIdx body).reachesIn 1 + (spec.scanCfg value) (spec.bodyStartCfg value) := + .step (spec.scanStep value hvalue) .zero + have hbody := spec.bodyRun value hvalue + have hloopback : (forBinaryWorkTM driverIdx body).reachesIn 1 + (spec.bodyDoneCfg value) (spec.scanCfg (value + 1)) := + .step (spec.loopbackStep value hvalue) .zero + have htail := ih (value + 1) (by omega) + have hreach := reachesIn_trans (forBinaryWorkTM driverIdx body) hscan + (reachesIn_trans (forBinaryWorkTM driverIdx body) hbody + (reachesIn_trans (forBinaryWorkTM driverIdx body) hloopback htail)) + convert hreach using 1 + simp only [forBinaryWorkLoopTime] + omega + +/-- Every prefix no longer than a certified loop's exact remaining runtime +respects its auxiliary-space budget. -/ +theorem ForBinaryWorkLoopSpaceSpec.prefix_withinAuxSpace_internal + {driverIdx : Fin n} {body : TM n} {bodyTime : ℕ → ℕ} + {total inputLength spaceBound : ℕ} + {spec : ForBinaryWorkLoopSpec driverIdx body bodyTime total} + (spaceSpec : + ForBinaryWorkLoopSpaceSpec spec inputLength spaceBound) : + ∀ count value t (c : Cfg n (forBinaryWorkTM driverIdx body).Q), + value + count = total → + (forBinaryWorkTM driverIdx body).reachesIn t + (spec.scanCfg value) c → + t ≤ forBinaryWorkLoopTime bodyTime value count → + c.WithinAuxSpace inputLength spaceBound := by + intro count + induction count with + | zero => + intro value t c htotal hreach ht + have hvalue : value = total := by omega + subst value + simp only [forBinaryWorkLoopTime] at ht + have ht' : t = 0 ∨ t = 1 := by omega + rcases ht' with rfl | rfl + · cases hreach + exact spaceSpec.scanWithin total le_rfl + · have hdone : (forBinaryWorkTM driverIdx body).reachesIn 1 + (spec.scanCfg total) spec.doneCfg := + .step spec.stopStep .zero + have hc := + (forBinaryWorkTM driverIdx body).reachesIn_right_unique hreach hdone + rw [hc] + exact spaceSpec.doneWithin + | succ count ih => + intro value t c htotal hreach ht + have hvalue : value < total := by omega + by_cases htzero : t = 0 + · subst t + cases hreach + exact spaceSpec.scanWithin value (Nat.le_of_lt hvalue) + · let u := t - 1 + have htu : 1 + u = t := by + dsimp only [u] + omega + by_cases hubody : u ≤ bodyTime value + · obtain ⟨d, hprefix, _hsuffix⟩ := reachesIn_prefix_internal + (spec.bodyRun value hvalue) hubody + have hcanonical : (forBinaryWorkTM driverIdx body).reachesIn t + (spec.scanCfg value) d := by + have hscan : (forBinaryWorkTM driverIdx body).reachesIn 1 + (spec.scanCfg value) (spec.bodyStartCfg value) := + .step (spec.scanStep value hvalue) .zero + have htotalRun := + reachesIn_trans (forBinaryWorkTM driverIdx body) hscan hprefix + simpa [htu] using htotalRun + have hc := + (forBinaryWorkTM driverIdx body).reachesIn_right_unique + hreach hcanonical + rw [hc] + exact spaceSpec.bodyPrefixWithin value u d hvalue hubody hprefix + · let prefixTime := 1 + bodyTime value + 1 + have hprefixTime : prefixTime ≤ t := by + dsimp only [prefixTime, u] at ⊢ hubody + omega + let tailTime := t - prefixTime + have htailEq : prefixTime + tailTime = t := by + dsimp only [tailTime] + exact Nat.add_sub_of_le hprefixTime + have htailBound : + tailTime ≤ + forBinaryWorkLoopTime bodyTime (value + 1) count := by + rw [forBinaryWorkLoopTime] at ht + dsimp only [prefixTime, tailTime] at ⊢ + omega + have htailFull := + spec.reachesIn_internal count (value + 1) (by omega) + obtain ⟨d, htail, _hsuffix⟩ := reachesIn_prefix_internal + htailFull htailBound + have hscan : (forBinaryWorkTM driverIdx body).reachesIn 1 + (spec.scanCfg value) (spec.bodyStartCfg value) := + .step (spec.scanStep value hvalue) .zero + have hloopback : (forBinaryWorkTM driverIdx body).reachesIn 1 + (spec.bodyDoneCfg value) (spec.scanCfg (value + 1)) := + .step (spec.loopbackStep value hvalue) .zero + have hcanonical := + reachesIn_trans (forBinaryWorkTM driverIdx body) hscan + (reachesIn_trans (forBinaryWorkTM driverIdx body) + (spec.bodyRun value hvalue) + (reachesIn_trans (forBinaryWorkTM driverIdx body) + hloopback htail)) + have hcanonical' : (forBinaryWorkTM driverIdx body).reachesIn t + (spec.scanCfg value) d := by + convert hcanonical using 1 + all_goals + dsimp only [prefixTime] at htailEq ⊢ + omega + have hc := + (forBinaryWorkTM driverIdx body).reachesIn_right_unique + hreach hcanonical' + rw [hc] + exact ih (value + 1) tailTime d (by omega) htail htailBound + +/-- Bit-driven work iteration preserves one-way output when the body does. -/ +theorem IsTransducer.forBinaryWorkTM_internal + {driverIdx : Fin n} {body : TM n} (hbody : body.IsTransducer) : + (forBinaryWorkTM driverIdx body).IsTransducer := by + intro state iHead wHeads oHead + cases state with + | inl phase => + cases phase with + | scan => + by_cases hstart : wHeads driverIdx = Γ.start + · cases iHead <;> cases oHead <;> + simp [forBinaryWorkTM, hstart, allReadBack, idleDir] + · by_cases hblank : wHeads driverIdx = Γ.blank + · cases iHead <;> cases oHead <;> + simp [forBinaryWorkTM, hblank, allReadBack, idleDir] + · cases iHead <;> cases oHead <;> + simp [forBinaryWorkTM, hstart, hblank, allReadBack, idleDir] + | done => + cases iHead <;> cases oHead <;> + simp [forBinaryWorkTM, allIdle, idleDir] + | inr state => + by_cases hstate : state = body.qhalt + · cases iHead <;> cases oHead <;> + simp [forBinaryWorkTM, hstate, allReadBack, idleDir] + · simpa [forBinaryWorkTM, hstate] using hbody state iHead wHeads oHead + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/ForInput.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/ForInput.lean new file mode 100644 index 0000000000..e3e328ec0a --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/ForInput.lean @@ -0,0 +1,10 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.ForInput.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.ForInput.Internal + +/-! Supporting modules for Beyond the Bethe approximation of the permanent. -/ diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/ForInput/Defs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/ForInput/Defs.lean new file mode 100644 index 0000000000..24a8e277b3 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/ForInput/Defs.lean @@ -0,0 +1,146 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators + +/-! +# Read-only-input loop combinator — definitions + +`TM.forInputTM body` scans the Boolean input from left to right and invokes +`body` after each bit. When `body` preserves the input tape, this is exactly one +invocation per original input bit. The input itself is the loop fuel, so the +combinator does not materialize a linear-size unary counter on an auxiliary tape. +-/ + + +@[expose] public section + +namespace Complexity + +namespace TM + +/-- Driver states for the read-only-input loop. -/ +inductive ForInputPhase where + | scan + | done + deriving DecidableEq + +/-- `ForInputPhase` has exactly two states. -/ +instance instFintypeForInputPhase : Fintype ForInputPhase where + elems := {.scan, .done} + complete := fun phase => by cases phase <;> simp + +/-- Advance over a Boolean input symbol and run `body`. + +The driver skips an initial left-end marker, advances the read-only input by +one cell before each body invocation, and halts whenever scanning encounters a +blank. Work and output tapes take the structurally safe read-back/idle action in +driver states. Nonhalting body transitions are embedded exactly, so the usual +once-per-original-symbol behavior requires the body to preserve the input tape. -/ +def forInputTM {n : ℕ} (body : TM n) : TM n where + Q := ForInputPhase ⊕ body.Q + qstart := .inl .scan + qhalt := .inl .done + δ := fun state iHead wHeads oHead => + match state with + | .inl .scan => + if iHead = Γ.start then + (.inl .scan, fun i => readBackWrite (wHeads i), readBackWrite oHead, + Dir3.right, fun i => idleDir (wHeads i), idleDir oHead) + else if iHead = Γ.blank then + allReadBack (.inl .done) iHead wHeads oHead + else + (.inr body.qstart, fun i => readBackWrite (wHeads i), readBackWrite oHead, + Dir3.right, fun i => idleDir (wHeads i), idleDir oHead) + | .inl .done => allIdle (.inl .done) iHead wHeads oHead + | .inr q => + if q = body.qhalt then + allReadBack (.inl .scan) iHead wHeads oHead + else + ((Sum.inr (body.δ q iHead wHeads oHead).1 : ForInputPhase ⊕ body.Q), + (body.δ q iHead wHeads oHead).2.1, + (body.δ q iHead wHeads oHead).2.2.1, + (body.δ q iHead wHeads oHead).2.2.2.1, + (body.δ q iHead wHeads oHead).2.2.2.2.1, + (body.δ q iHead wHeads oHead).2.2.2.2.2) + δ_right_of_start := by + intro state iHead wHeads oHead + match state with + | .inl .scan => + dsimp only + split + · exact ⟨fun _ => rfl, fun _ => idleDir_right_of_start, + idleDir_right_of_start⟩ + · split + · exact rightOfStart_allReadBack iHead wHeads oHead + · exact ⟨fun _ => rfl, fun _ => idleDir_right_of_start, + idleDir_right_of_start⟩ + | .inl .done => exact rightOfStart_allIdle iHead wHeads oHead + | .inr q => + dsimp only + split + · exact rightOfStart_allReadBack iHead wHeads oHead + · exact body.δ_right_of_start q iHead wHeads oHead + +/-- Exact remaining time for an input-driven loop whose body takes +`bodyTime value` steps on iteration `value`. The terminal input-blank exit +takes one step. Each nonterminal iteration takes one scanner step, the body +run, and one loopback step. -/ +def forInputLoopTime (bodyTime : ℕ → ℕ) (value : ℕ) : ℕ → ℕ + | 0 => 1 + | count + 1 => + 1 + bodyTime value + 1 + forInputLoopTime bodyTime (value + 1) count + +/-- Wrapper-free certificate for the exact control flow of an input-driven +loop. All configurations use the public state type of `forInputTM body`, so +clients need not mention the internal body-state embedding. + +`total` is the first scanner index whose input symbol is blank. -/ +structure ForInputLoopSpec {n : ℕ} (body : TM n) (bodyTime : ℕ → ℕ) + (total : ℕ) where + /-- Canonical scanner configuration at iteration `value`. -/ + scanCfg : ℕ → Cfg n (forInputTM body).Q + /-- Canonical combined-machine configuration at the start of the body. -/ + bodyStartCfg : ℕ → Cfg n (forInputTM body).Q + /-- Canonical combined-machine configuration after the exact body run. -/ + bodyDoneCfg : ℕ → Cfg n (forInputTM body).Q + /-- Canonical final driver configuration. -/ + doneCfg : Cfg n (forInputTM body).Q + /-- A nonterminal scanner step enters the body. -/ + scanStep : ∀ value, value < total → + (forInputTM body).step (scanCfg value) = some (bodyStartCfg value) + /-- The body has the advertised exact runtime. -/ + bodyRun : ∀ value, value < total → + (forInputTM body).reachesIn (bodyTime value) + (bodyStartCfg value) (bodyDoneCfg value) + /-- The preserving seam step advances to the next scanner configuration. -/ + loopbackStep : ∀ value, value < total → + (forInputTM body).step (bodyDoneCfg value) = some (scanCfg (value + 1)) + /-- The scanner exits on the first blank. -/ + blankStep : + (forInputTM body).step (scanCfg total) = some doneCfg + +/-- Space obligations needed to turn a `ForInputLoopSpec` into an +all-prefix auxiliary-space certificate. The body obligation concerns only +prefixes of its advertised exact run; later combined-machine execution may +already have crossed the loopback seam. -/ +structure ForInputLoopSpaceSpec {n : ℕ} {body : TM n} {bodyTime : ℕ → ℕ} + {total : ℕ} (spec : ForInputLoopSpec body bodyTime total) + (inputLength spaceBound : ℕ) where + /-- Every canonical scanner configuration is within the space budget. -/ + scanWithin : ∀ value, value ≤ total → + (spec.scanCfg value).WithinAuxSpace inputLength spaceBound + /-- The canonical final configuration is within the space budget. -/ + doneWithin : spec.doneCfg.WithinAuxSpace inputLength spaceBound + /-- Every prefix of each exact body run is within the space budget. -/ + bodyPrefixWithin : ∀ value t c, value < total → t ≤ bodyTime value → + (forInputTM body).reachesIn t (spec.bodyStartCfg value) c → + c.WithinAuxSpace inputLength spaceBound + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/ForInput/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/ForInput/Internal.lean new file mode 100644 index 0000000000..945cd8c67f --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/ForInput/Internal.lean @@ -0,0 +1,261 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.ForInput.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.Internal.Generic +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.SpaceTime.Internal.Reachability + +/-! +# Read-only-input loop combinator — proof internals + +This module supplies the exact body-simulation embedding and the structural +one-way-output proof for `TM.forInputTM`. +-/ + + +@[expose] public section + +namespace Complexity + +namespace TM + +variable {n : ℕ} + +/-- Embed a body configuration into the body phase of `forInputTM`. -/ +def forInputBodyWrap (body : TM n) (c : Cfg n body.Q) : + Cfg n (forInputTM body).Q := + { state := .inr c.state + input := c.input + work := c.work + output := c.output } + +/-- Every nonhalting body step is simulated exactly by one `forInputTM` step. -/ +theorem forInputTM_body_step_internal (body : TM n) + {c c' : Cfg n body.Q} (hstep : body.step c = some c') : + (forInputTM body).step (forInputBodyWrap body c) = + some (forInputBodyWrap body c') := by + have hne : c.state ≠ body.qhalt := state_ne_qhalt_of_step hstep + rw [TM.step, if_neg (by simp [forInputBodyWrap, forInputTM])] + simp only [forInputBodyWrap, forInputTM, hne, ↓reduceIte] + rw [TM.step, if_neg hne] at hstep + revert hstep + generalize body.δ c.state c.input.read (fun i => (c.work i).read) c.output.read = action + obtain ⟨q', workWrites, outputWrite, inputDir, workDirs, outputDir⟩ := action + intro hstep + cases Option.some.inj hstep + rfl + +/-- Exact body runs lift through the body phase of `forInputTM`. -/ +theorem forInputTM_body_reachesIn_internal (body : TM n) + {t : ℕ} {c c' : Cfg n body.Q} (hreach : body.reachesIn t c c') : + (forInputTM body).reachesIn t + (forInputBodyWrap body c) (forInputBodyWrap body c') := + reachesIn_map (forInputBodyWrap body) + (fun _ _ => forInputTM_body_step_internal body) hreach + +/-- On a Boolean input symbol, the driver advances the read-only input and +enters the body while preserving every off-start work and output tape. -/ +theorem forInputTM_step_scan_bit_internal (body : TM n) + (c : Cfg n (forInputTM body).Q) + (hstate : c.state = .inl .scan) + (hstart : c.input.read ≠ Γ.start) (hblank : c.input.read ≠ Γ.blank) + (hwork : ∀ i, (c.work i).read ≠ Γ.start) + (houtput : c.output.read ≠ Γ.start) : + (forInputTM body).step c = some + { state := .inr body.qstart + input := c.input.move Dir3.right + work := c.work + output := c.output } := by + rw [TM.step, if_neg (by rw [hstate]; simp [forInputTM])] + simp only [forInputTM, hstate, hstart, hblank, allReadBack, ↓reduceIte] + refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, rfl, ?_, ?_⟩) + · funext i + rw [writeAndMove_readBack _ (hwork i), idleDir, if_neg (hwork i)] + rfl + · rw [writeAndMove_readBack _ houtput, idleDir, if_neg houtput] + rfl + +/-- At the first input blank, the driver halts while preserving all off-start +tapes exactly. -/ +theorem forInputTM_step_scan_blank_internal (body : TM n) + (c : Cfg n (forInputTM body).Q) + (hstate : c.state = .inl .scan) (hblank : c.input.read = Γ.blank) + (hwork : ∀ i, (c.work i).read ≠ Γ.start) + (houtput : c.output.read ≠ Γ.start) : + (forInputTM body).step c = some + { state := .inl .done + input := c.input + work := c.work + output := c.output } := by + have hstart : c.input.read ≠ Γ.start := by rw [hblank]; decide + rw [TM.step, if_neg (by rw [hstate]; simp [forInputTM])] + simp only [forInputTM, hstate, hblank, allReadBack, reduceCtorEq, ↓reduceIte] + refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, ?_, ?_, ?_⟩) + · simp [idleDir, Tape.move] + · funext i + rw [writeAndMove_readBack _ (hwork i), idleDir, if_neg (hwork i)] + rfl + · rw [writeAndMove_readBack _ houtput, idleDir, if_neg houtput] + rfl + +/-- A halted body takes one preserving seam step back to the input scanner. -/ +theorem forInputTM_step_body_halt_internal (body : TM n) + (c : Cfg n body.Q) (hhalt : body.halted c) + (hinput : c.input.read ≠ Γ.start) + (hwork : ∀ i, (c.work i).read ≠ Γ.start) + (houtput : c.output.read ≠ Γ.start) : + (forInputTM body).step (forInputBodyWrap body c) = some + { state := .inl .scan + input := c.input + work := c.work + output := c.output } := by + rw [TM.step, if_neg (by simp [forInputBodyWrap, forInputTM])] + simp only [forInputBodyWrap, forInputTM, hhalt, allReadBack, ↓reduceIte] + refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, ?_, ?_, ?_⟩) + · exact transitionInput_eq_self hinput + · funext i + rw [writeAndMove_readBack _ (hwork i), idleDir, if_neg (hwork i)] + rfl + · rw [writeAndMove_readBack _ houtput, idleDir, if_neg houtput] + rfl + +/-- A certified input-driven loop has the advertised exact remaining run. -/ +theorem ForInputLoopSpec.reachesIn_internal {body : TM n} + {bodyTime : ℕ → ℕ} {total : ℕ} + (spec : ForInputLoopSpec body bodyTime total) : + ∀ count value, value + count = total → + (forInputTM body).reachesIn (forInputLoopTime bodyTime value count) + (spec.scanCfg value) spec.doneCfg := by + intro count + induction count with + | zero => + intro value htotal + have hvalue : value = total := by omega + subst value + exact .step spec.blankStep .zero + | succ count ih => + intro value htotal + have hvalue : value < total := by omega + have hscan : (forInputTM body).reachesIn 1 + (spec.scanCfg value) (spec.bodyStartCfg value) := + .step (spec.scanStep value hvalue) .zero + have hbody := spec.bodyRun value hvalue + have hloopback : (forInputTM body).reachesIn 1 + (spec.bodyDoneCfg value) (spec.scanCfg (value + 1)) := + .step (spec.loopbackStep value hvalue) .zero + have htail := ih (value + 1) (by omega) + have hreach := reachesIn_trans (forInputTM body) hscan + (reachesIn_trans (forInputTM body) hbody + (reachesIn_trans (forInputTM body) hloopback htail)) + convert hreach using 1 + simp only [forInputLoopTime] + omega + +/-- Every configuration reached no later than a certified loop's exact +remaining runtime satisfies its auxiliary-space budget. -/ +theorem ForInputLoopSpaceSpec.prefix_withinAuxSpace_internal + {body : TM n} {bodyTime : ℕ → ℕ} {total inputLength spaceBound : ℕ} + {spec : ForInputLoopSpec body bodyTime total} + (spaceSpec : ForInputLoopSpaceSpec spec inputLength spaceBound) : + ∀ count value t (c : Cfg n (forInputTM body).Q), + value + count = total → + (forInputTM body).reachesIn t (spec.scanCfg value) c → + t ≤ forInputLoopTime bodyTime value count → + c.WithinAuxSpace inputLength spaceBound := by + intro count + induction count with + | zero => + intro value t c htotal hreach ht + have hvalue : value = total := by omega + subst value + simp only [forInputLoopTime] at ht + have ht' : t = 0 ∨ t = 1 := by omega + rcases ht' with rfl | rfl + · cases hreach + exact spaceSpec.scanWithin total le_rfl + · have hdone : (forInputTM body).reachesIn 1 + (spec.scanCfg total) spec.doneCfg := + .step spec.blankStep .zero + have hc := (forInputTM body).reachesIn_right_unique hreach hdone + rw [hc] + exact spaceSpec.doneWithin + | succ count ih => + intro value t c htotal hreach ht + have hvalue : value < total := by omega + by_cases htzero : t = 0 + · subst t + cases hreach + exact spaceSpec.scanWithin value (Nat.le_of_lt hvalue) + · let u := t - 1 + have htu : 1 + u = t := by + dsimp only [u] + omega + by_cases hubody : u ≤ bodyTime value + · obtain ⟨d, hprefix, _hsuffix⟩ := reachesIn_prefix_internal + (spec.bodyRun value hvalue) hubody + have hcanonical : (forInputTM body).reachesIn t + (spec.scanCfg value) d := by + have hscan : (forInputTM body).reachesIn 1 + (spec.scanCfg value) (spec.bodyStartCfg value) := + .step (spec.scanStep value hvalue) .zero + have htotalRun := reachesIn_trans (forInputTM body) hscan hprefix + simpa [htu] using htotalRun + have hc := (forInputTM body).reachesIn_right_unique hreach hcanonical + rw [hc] + exact spaceSpec.bodyPrefixWithin value u d hvalue hubody hprefix + · let prefixTime := 1 + bodyTime value + 1 + have hprefixTime : prefixTime ≤ t := by + dsimp only [prefixTime, u] at ⊢ hubody + omega + let tailTime := t - prefixTime + have htailEq : prefixTime + tailTime = t := by + dsimp only [tailTime] + exact Nat.add_sub_of_le hprefixTime + have htailBound : + tailTime ≤ forInputLoopTime bodyTime (value + 1) count := by + rw [forInputLoopTime] at ht + dsimp only [prefixTime, tailTime] at ⊢ + omega + have htailFull := spec.reachesIn_internal count (value + 1) (by omega) + obtain ⟨d, htail, _hsuffix⟩ := reachesIn_prefix_internal + htailFull htailBound + have hscan : (forInputTM body).reachesIn 1 + (spec.scanCfg value) (spec.bodyStartCfg value) := + .step (spec.scanStep value hvalue) .zero + have hloopback : (forInputTM body).reachesIn 1 + (spec.bodyDoneCfg value) (spec.scanCfg (value + 1)) := + .step (spec.loopbackStep value hvalue) .zero + have hcanonical := reachesIn_trans (forInputTM body) hscan + (reachesIn_trans (forInputTM body) (spec.bodyRun value hvalue) + (reachesIn_trans (forInputTM body) hloopback htail)) + have hcanonical' : (forInputTM body).reachesIn t + (spec.scanCfg value) d := by + convert hcanonical using 1 + all_goals + dsimp only [prefixTime] at htailEq ⊢ + omega + have hc := (forInputTM body).reachesIn_right_unique hreach hcanonical' + rw [hc] + exact ih (value + 1) tailTime d (by omega) htail htailBound + +/-- A read-only-input loop preserves the body's one-way-output discipline. -/ +theorem IsTransducer.forInputTM_internal {body : TM n} + (hbody : body.IsTransducer) : (forInputTM body).IsTransducer := by + intro state iHead wHeads oHead + cases state with + | inl phase => + cases phase <;> cases iHead <;> cases oHead <;> + simp [forInputTM, allIdle, allReadBack, idleDir] + | inr q => + by_cases hq : q = body.qhalt + · cases oHead <;> simp [forInputTM, hq, allReadBack, idleDir] + · simpa [forInputTM, hq] using hbody q iHead wHeads oHead + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/ForWorkOnes.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/ForWorkOnes.lean new file mode 100644 index 0000000000..745aa25413 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/ForWorkOnes.lean @@ -0,0 +1,10 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.ForWorkOnes.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.ForWorkOnes.Internal + +/-! Supporting modules for Beyond the Bethe approximation of the permanent. -/ diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/ForWorkOnes/Defs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/ForWorkOnes/Defs.lean new file mode 100644 index 0000000000..39ab3b2128 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/ForWorkOnes/Defs.lean @@ -0,0 +1,139 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators + +/-! +# One-prefix work-tape loop combinator — definitions + +`TM.forWorkOnesTM driverIdx body` scans a work tape from left to right and +invokes `body` once for each consecutive `1` symbol. The driver advances before +each invocation and halts with its head on the first non-`1` symbol. This is the +machine-level control needed to consume the unary-width prefix of a +self-delimiting binary word without materializing the prefix elsewhere. + +Exact iteration semantics require `body` to preserve the already-advanced +driver tape and head. The combinator itself is a concrete `TM`; loop +certificates and proofs live in the adjacent internal and surface modules. +-/ + + +@[expose] public section + +namespace Complexity + +namespace TM + +/-- Driver states for a consecutive-one work-tape loop. -/ +inductive ForWorkOnesPhase where + | scan + | done + deriving DecidableEq + +/-- `ForWorkOnesPhase` has exactly two states. -/ +instance instFintypeForWorkOnesPhase : Fintype ForWorkOnesPhase where + elems := {.scan, .done} + complete := fun phase => by cases phase <;> simp + +/-- Advance over one `1` on work tape `driverIdx` and invoke `body`; halt on +the first non-`1` symbol. An initial left marker is skipped safely. -/ +def forWorkOnesTM {n : ℕ} (driverIdx : Fin n) (body : TM n) : TM n where + Q := ForWorkOnesPhase ⊕ body.Q + qstart := .inl .scan + qhalt := .inl .done + δ := fun state iHead wHeads oHead => + match state with + | .inl .scan => + if wHeads driverIdx = Γ.start then + (.inl .scan, fun i => readBackWrite (wHeads i), readBackWrite oHead, + idleDir iHead, + fun i => if i = driverIdx then Dir3.right else idleDir (wHeads i), + idleDir oHead) + else if wHeads driverIdx = Γ.one then + (.inr body.qstart, fun i => readBackWrite (wHeads i), readBackWrite oHead, + idleDir iHead, + fun i => if i = driverIdx then Dir3.right else idleDir (wHeads i), + idleDir oHead) + else + allReadBack (.inl .done) iHead wHeads oHead + | .inl .done => allIdle (.inl .done) iHead wHeads oHead + | .inr state => + if state = body.qhalt then + allReadBack (.inl .scan) iHead wHeads oHead + else + ((Sum.inr (body.δ state iHead wHeads oHead).1 : + ForWorkOnesPhase ⊕ body.Q), + (body.δ state iHead wHeads oHead).2.1, + (body.δ state iHead wHeads oHead).2.2.1, + (body.δ state iHead wHeads oHead).2.2.2.1, + (body.δ state iHead wHeads oHead).2.2.2.2.1, + (body.δ state iHead wHeads oHead).2.2.2.2.2) + δ_right_of_start := by + intro state iHead wHeads oHead + match state with + | .inl .scan => + dsimp only + split + · refine ⟨idleDir_right_of_start, ?_, idleDir_right_of_start⟩ + intro i hwi + simp only + split + · rfl + · exact idleDir_right_of_start hwi + · split + · refine ⟨idleDir_right_of_start, ?_, idleDir_right_of_start⟩ + intro i hwi + simp only + split + · rfl + · exact idleDir_right_of_start hwi + · exact rightOfStart_allReadBack iHead wHeads oHead + | .inl .done => exact rightOfStart_allIdle iHead wHeads oHead + | .inr state => + dsimp only + split + · exact rightOfStart_allReadBack iHead wHeads oHead + · exact body.δ_right_of_start state iHead wHeads oHead + +/-- Exact remaining time for a one-prefix loop whose body takes +`bodyTime value` steps on iteration `value`. The terminal non-one exit takes +one step. -/ +def forWorkOnesLoopTime (bodyTime : ℕ → ℕ) (value : ℕ) : ℕ → ℕ + | 0 => 1 + | count + 1 => + 1 + bodyTime value + 1 + forWorkOnesLoopTime bodyTime (value + 1) count + +/-- Wrapper-free exact-control certificate for a consecutive-one work loop. -/ +structure ForWorkOnesLoopSpec {n : ℕ} (driverIdx : Fin n) (body : TM n) + (bodyTime : ℕ → ℕ) (total : ℕ) where + /-- Canonical scanner configuration at iteration `value`. -/ + scanCfg : ℕ → Cfg n (forWorkOnesTM driverIdx body).Q + /-- Canonical combined-machine configuration at body entry. -/ + bodyStartCfg : ℕ → Cfg n (forWorkOnesTM driverIdx body).Q + /-- Canonical combined-machine configuration after the exact body run. -/ + bodyDoneCfg : ℕ → Cfg n (forWorkOnesTM driverIdx body).Q + /-- Canonical final driver configuration. -/ + doneCfg : Cfg n (forWorkOnesTM driverIdx body).Q + /-- One scanner step consumes a `1` and enters the body. -/ + scanStep : ∀ value, value < total → + (forWorkOnesTM driverIdx body).step (scanCfg value) = + some (bodyStartCfg value) + /-- The body has the advertised exact runtime. -/ + bodyRun : ∀ value, value < total → + (forWorkOnesTM driverIdx body).reachesIn (bodyTime value) + (bodyStartCfg value) (bodyDoneCfg value) + /-- The preserving seam returns to the scanner. -/ + loopbackStep : ∀ value, value < total → + (forWorkOnesTM driverIdx body).step (bodyDoneCfg value) = + some (scanCfg (value + 1)) + /-- The scanner exits on the first non-`1` symbol. -/ + stopStep : + (forWorkOnesTM driverIdx body).step (scanCfg total) = some doneCfg + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/ForWorkOnes/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/ForWorkOnes/Internal.lean new file mode 100644 index 0000000000..3d53e1abb4 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/ForWorkOnes/Internal.lean @@ -0,0 +1,199 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.ForWorkOnes.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.Internal.Generic + +/-! +# One-prefix work-tape loop combinator — proof internals + +This module proves exact body embedding, driver transitions, certified loop +execution, and one-way-output preservation for `TM.forWorkOnesTM`. +-/ + + +@[expose] public section + +namespace Complexity + +namespace TM + +variable {n : ℕ} + +/-- Embed a body configuration in the body phase of `forWorkOnesTM`. -/ +def forWorkOnesBodyWrap (driverIdx : Fin n) (body : TM n) + (cfg : Cfg n body.Q) : Cfg n (forWorkOnesTM driverIdx body).Q := + { state := .inr cfg.state + input := cfg.input + work := cfg.work + output := cfg.output } + +/-- Every nonhalting body step is simulated exactly. -/ +theorem forWorkOnesTM_body_step_internal (driverIdx : Fin n) (body : TM n) + {cfg next : Cfg n body.Q} (hstep : body.step cfg = some next) : + (forWorkOnesTM driverIdx body).step + (forWorkOnesBodyWrap driverIdx body cfg) = + some (forWorkOnesBodyWrap driverIdx body next) := by + have hne : cfg.state ≠ body.qhalt := state_ne_qhalt_of_step hstep + rw [TM.step, if_neg (by simp [forWorkOnesBodyWrap, forWorkOnesTM])] + simp only [forWorkOnesBodyWrap, forWorkOnesTM, hne, ↓reduceIte] + rw [TM.step, if_neg hne] at hstep + revert hstep + generalize body.δ cfg.state cfg.input.read (fun i => (cfg.work i).read) + cfg.output.read = action + obtain ⟨state, workWrites, outputWrite, inputDir, workDirs, outputDir⟩ := action + intro hstep + cases Option.some.inj hstep + rfl + +/-- Exact body runs lift through the combined machine's body phase. -/ +theorem forWorkOnesTM_body_reachesIn_internal (driverIdx : Fin n) (body : TM n) + {time : ℕ} {cfg next : Cfg n body.Q} + (hreach : body.reachesIn time cfg next) : + (forWorkOnesTM driverIdx body).reachesIn time + (forWorkOnesBodyWrap driverIdx body cfg) + (forWorkOnesBodyWrap driverIdx body next) := + reachesIn_map (forWorkOnesBodyWrap driverIdx body) + (fun _ _ => forWorkOnesTM_body_step_internal driverIdx body) hreach + +/-- On a `1`, the driver advances its selected work head and enters the body. -/ +theorem forWorkOnesTM_step_scan_one_internal (driverIdx : Fin n) (body : TM n) + (cfg : Cfg n (forWorkOnesTM driverIdx body).Q) + (hstate : cfg.state = .inl .scan) + (hone : (cfg.work driverIdx).read = Γ.one) + (hinput : cfg.input.read ≠ Γ.start) + (hwork : ∀ i, (cfg.work i).read ≠ Γ.start) + (houtput : cfg.output.read ≠ Γ.start) : + (forWorkOnesTM driverIdx body).step cfg = some + { state := .inr body.qstart + input := cfg.input + work := fun i => + if i = driverIdx then (cfg.work i).move Dir3.right else cfg.work i + output := cfg.output } := by + rw [TM.step, if_neg (by rw [hstate]; simp [forWorkOnesTM])] + simp only [forWorkOnesTM, hstate, hone, reduceCtorEq, ↓reduceIte] + refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, ?_, ?_, ?_⟩) + · rw [idleDir, if_neg hinput] + rfl + · funext i + rw [writeAndMove_readBack _ (hwork i)] + split + · rfl + · rw [idleDir, if_neg (hwork i)] + rfl + · rw [writeAndMove_readBack _ houtput, idleDir, if_neg houtput] + rfl + +/-- On the zero separator, the driver halts without consuming it. -/ +theorem forWorkOnesTM_step_scan_zero_internal (driverIdx : Fin n) (body : TM n) + (cfg : Cfg n (forWorkOnesTM driverIdx body).Q) + (hstate : cfg.state = .inl .scan) + (hzero : (cfg.work driverIdx).read = Γ.zero) + (hinput : cfg.input.read ≠ Γ.start) + (hwork : ∀ i, (cfg.work i).read ≠ Γ.start) + (houtput : cfg.output.read ≠ Γ.start) : + (forWorkOnesTM driverIdx body).step cfg = some + { state := .inl .done + input := cfg.input + work := cfg.work + output := cfg.output } := by + have hstart : (cfg.work driverIdx).read ≠ Γ.start := by rw [hzero]; decide + have hone : (cfg.work driverIdx).read ≠ Γ.one := by rw [hzero]; decide + rw [TM.step, if_neg (by rw [hstate]; simp [forWorkOnesTM])] + simp only [forWorkOnesTM, hstate, hstart, hone, allReadBack, ↓reduceIte] + refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, ?_, ?_, ?_⟩) + · rw [idleDir, if_neg hinput] + rfl + · funext i + rw [writeAndMove_readBack _ (hwork i), idleDir, if_neg (hwork i)] + rfl + · rw [writeAndMove_readBack _ houtput, idleDir, if_neg houtput] + rfl + +/-- A halted body takes one preserving seam step back to the scanner. -/ +theorem forWorkOnesTM_step_body_halt_internal (driverIdx : Fin n) (body : TM n) + (cfg : Cfg n body.Q) (hhalt : body.halted cfg) + (hinput : cfg.input.read ≠ Γ.start) + (hwork : ∀ i, (cfg.work i).read ≠ Γ.start) + (houtput : cfg.output.read ≠ Γ.start) : + (forWorkOnesTM driverIdx body).step + (forWorkOnesBodyWrap driverIdx body cfg) = some + { state := .inl .scan + input := cfg.input + work := cfg.work + output := cfg.output } := by + rw [TM.step, if_neg (by simp [forWorkOnesBodyWrap, forWorkOnesTM])] + simp only [forWorkOnesBodyWrap, forWorkOnesTM, hhalt, allReadBack, ↓reduceIte] + refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, ?_, ?_, ?_⟩) + · exact transitionInput_eq_self hinput + · funext i + rw [writeAndMove_readBack _ (hwork i), idleDir, if_neg (hwork i)] + rfl + · rw [writeAndMove_readBack _ houtput, idleDir, if_neg houtput] + rfl + +/-- A certified consecutive-one loop has its advertised exact remaining run. -/ +theorem ForWorkOnesLoopSpec.reachesIn_internal + {driverIdx : Fin n} {body : TM n} {bodyTime : ℕ → ℕ} {total : ℕ} + (spec : ForWorkOnesLoopSpec driverIdx body bodyTime total) : + ∀ count value, value + count = total → + (forWorkOnesTM driverIdx body).reachesIn + (forWorkOnesLoopTime bodyTime value count) + (spec.scanCfg value) spec.doneCfg := by + intro count + induction count with + | zero => + intro value htotal + have hvalue : value = total := by omega + subst value + exact .step spec.stopStep .zero + | succ count ih => + intro value htotal + have hvalue : value < total := by omega + have hscan : (forWorkOnesTM driverIdx body).reachesIn 1 + (spec.scanCfg value) (spec.bodyStartCfg value) := + .step (spec.scanStep value hvalue) .zero + have hbody := spec.bodyRun value hvalue + have hloopback : (forWorkOnesTM driverIdx body).reachesIn 1 + (spec.bodyDoneCfg value) (spec.scanCfg (value + 1)) := + .step (spec.loopbackStep value hvalue) .zero + have htail := ih (value + 1) (by omega) + have hreach := reachesIn_trans (forWorkOnesTM driverIdx body) hscan + (reachesIn_trans (forWorkOnesTM driverIdx body) hbody + (reachesIn_trans (forWorkOnesTM driverIdx body) hloopback htail)) + convert hreach using 1 + simp only [forWorkOnesLoopTime] + omega + +/-- Consecutive-one iteration preserves one-way output when the body does. -/ +theorem IsTransducer.forWorkOnesTM_internal {driverIdx : Fin n} {body : TM n} + (hbody : body.IsTransducer) : + (forWorkOnesTM driverIdx body).IsTransducer := by + intro state iHead wHeads oHead + cases state with + | inl phase => + cases phase with + | scan => + by_cases hstart : wHeads driverIdx = Γ.start + · cases iHead <;> cases oHead <;> + simp [forWorkOnesTM, hstart, allReadBack, idleDir] + · by_cases hone : wHeads driverIdx = Γ.one + · cases iHead <;> cases oHead <;> + simp [forWorkOnesTM, hone, allReadBack, idleDir] + · cases iHead <;> cases oHead <;> + simp [forWorkOnesTM, hstart, hone, allReadBack, idleDir] + | done => + cases iHead <;> cases oHead <;> + simp [forWorkOnesTM, allIdle, idleDir] + | inr state => + by_cases hstate : state = body.qhalt + · cases oHead <;> simp [forWorkOnesTM, hstate, allReadBack, idleDir] + · simpa [forWorkOnesTM, hstate] using hbody state iHead wHeads oHead + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/Internal.lean new file mode 100644 index 0000000000..6cfbf42765 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/Internal.lean @@ -0,0 +1,25 @@ +/- +Copyright (c) 2025 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.Internal.Complement +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.Internal.Seq +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.Internal.If +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.Internal.Loop +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.Internal.Retarget +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.Internal.Scanner +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.Internal.Generic +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.Internal.Union + +/-! +# Combinator proof internals (aggregation) + +This file aggregates the proof-internal modules for the Turing machine +combinators (`Complement`, `Seq`, `If`, `Loop`, `Retarget`, `Scanner`, +`Generic`, `Union`). It contains no definitions of its own; it exists so +that the surface module `Combinators.lean` can pull in all combinator +proof internals with a single import. +-/ diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/Internal/Complement.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/Internal/Complement.lean new file mode 100644 index 0000000000..504fd0bd60 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/Internal/Complement.lean @@ -0,0 +1,229 @@ +/- +Copyright (c) 2025 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.Internal.Generic +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Internal + +/-! +# Complement TM: proof internals + +This file provides the simulation lemmas for `TM.complementTM`, showing that +the complement machine correctly flips the output of the original TM. +-/ + + +@[expose] public section + +namespace Complexity + +variable {n : ℕ} + +namespace TM + +-- ════════════════════════════════════════════════════════════════════════ +-- Configuration embedding +-- ════════════════════════════════════════════════════════════════════════ + +/-- Embed a configuration of `tm` into `tm.complementTM` by tagging the state + with `Sum.inl` and keeping all tapes unchanged. -/ +def complementCfg (tm : TM n) (c : Cfg n tm.Q) : Cfg n (tm.complementTM.Q) := + { state := Sum.inl c.state, input := c.input, work := c.work, output := c.output } + +/-- Embedding the initial configuration of `tm` on input `x` yields the initial + configuration of `tm.complementTM` on `x`. -/ +theorem compCfg_initCfg (tm : TM n) (x : List Bool) : + complementCfg tm (tm.initCfg x) = tm.complementTM.initCfg x := rfl + +/-- The embedding sends configurations in `tm`'s start state to configurations in + `tm.complementTM`'s start state, preserving all tapes. -/ +theorem compCfg_qstart (tm : TM n) (inp : Tape) (work : Fin n → Tape) (out : Tape) : + complementCfg tm ⟨tm.qstart, inp, work, out⟩ = + ⟨tm.complementTM.qstart, inp, work, out⟩ := rfl + +-- ════════════════════════════════════════════════════════════════════════ +-- Phase 1: Simulation (via generic simulation lifting) +-- ════════════════════════════════════════════════════════════════════════ + +private theorem complementTM_step_sim (tm : TM n) {c c' : Cfg n tm.Q} + (hstep : tm.step c = some c') : + tm.complementTM.step (complementCfg tm c) = some (complementCfg tm c') := by + have hne := state_ne_qhalt_of_step hstep + simp only [TM.step, complementTM, complementCfg] at hstep ⊢ + have hne2 : (Sum.inl c.state : ComplementQ tm.Q) ≠ Sum.inr .done := nofun + simp only [hne, hne2, ↓reduceIte, Option.some.injEq] at hstep ⊢ + rw [← hstep] + +/-- `tm.complementTM` simulates `tm` step-for-step on embedded configurations: a + `t`-step run of `tm` lifts to a `t`-step run of the complement machine. -/ +theorem complementTM_simulation (tm : TM n) {c c' : Cfg n tm.Q} {t : ℕ} + (hreach : tm.reachesIn t c c') : + tm.complementTM.reachesIn t (complementCfg tm c) (complementCfg tm c') := + reachesIn_map (tm' := tm.complementTM) (complementCfg tm) + (fun _ _ => complementTM_step_sim tm) hreach + +-- ════════════════════════════════════════════════════════════════════════ +-- Rewind loop (via generic rewind) +-- ════════════════════════════════════════════════════════════════════════ + +/-- One rewind step: at head > 0, move left, preserve cells. -/ +private theorem complement_rewind_step_left (tm : TM n) (c : Cfg n tm.complementTM.Q) + (hstate : c.state = Sum.inr ComplementPhase.rewind) + (hread_ne : c.output.read ≠ Γ.start) + (_ : c.output.cells 0 = Γ.start) (_ : ∀ j, j ≥ 1 → c.output.cells j ≠ Γ.start) : + ∃ c', tm.complementTM.step c = some c' ∧ + c'.state = Sum.inr ComplementPhase.rewind ∧ + c'.output.head = c.output.head - 1 ∧ + c'.output.cells = c.output.cells := by + simp only [TM.step, ↓reduceIte, hstate, complementTM, hread_ne] + refine ⟨_, rfl, rfl, ?_, ?_⟩ + · simp only [Tape.writeAndMove, Tape.move] + rw [toΓ_readBackWrite_of_ne_start hread_ne] + simp only [Tape.write, Tape.read]; split + · omega + · simp + · simp only [Tape.writeAndMove, Tape.move_cells] + rw [toΓ_readBackWrite_of_ne_start hread_ne] + simp only [Tape.write, Tape.read]; split + · rfl + · exact Function.update_eq_self _ _ + +/-- Base rewind step: at head = 0 (reading ▷), move right to cell 1, enter flip. -/ +private theorem complement_rewind_step_base (tm : TM n) (c : Cfg n tm.complementTM.Q) + (hstate : c.state = Sum.inr ComplementPhase.rewind) + (hread : c.output.read = Γ.start) + (_ : c.output.cells 0 = Γ.start) + (hnostart : ∀ j, j ≥ 1 → c.output.cells j ≠ Γ.start) : + ∃ c', tm.complementTM.step c = some c' ∧ + c'.state = Sum.inr ComplementPhase.flip ∧ + c'.output.head = 1 ∧ + c'.output.cells = c.output.cells := by + have hhead : c.output.head = 0 := by + by_contra hne + have hge : c.output.head ≥ 1 := by omega + exact hnostart c.output.head hge (by simp only [Tape.read] at hread; exact hread) + simp only [TM.step, ↓reduceIte, hstate, complementTM, hread] + refine ⟨_, rfl, rfl, ?_, ?_⟩ + · simp [Tape.writeAndMove, Tape.move, Tape.write, hhead] + · simp [Tape.writeAndMove, Tape.move_cells, Tape.write, hhead] + +/-- From rewind state with output head at position `h`, reach flip state + at cell 1 with output cells preserved, in `h + 1` steps. -/ +private theorem rewind_loop (tm : TM n) : + ∀ (h : ℕ) (c : Cfg n tm.complementTM.Q), + c.state = Sum.inr ComplementPhase.rewind → + c.output.cells 0 = Γ.start → + (∀ j, j ≥ 1 → c.output.cells j ≠ Γ.start) → + c.output.head = h → + ∃ c_flip, + tm.complementTM.reachesIn (h + 1) c c_flip ∧ + c_flip.state = Sum.inr ComplementPhase.flip ∧ + c_flip.output.head = 1 ∧ + c_flip.output.cells = c.output.cells := + exists_reachesIn_of_rewindStep_output tm.complementTM + (fun c hst hread hc0 hns => complement_rewind_step_left tm c hst hread hc0 hns) + (fun c hst hread hc0 hns => complement_rewind_step_base tm c hst hread hc0 hns) + +-- ════════════════════════════════════════════════════════════════════════ +-- Combined: halt → rewind → flip → done +-- ════════════════════════════════════════════════════════════════════════ + +/-- From halted complementCfg, reach done state with flipped output. + Takes ≤ `output.head + 4` steps. -/ +theorem complementTM_rewind_and_flip (tm : TM n) + (c_halt : Cfg n tm.Q) + (hhalt : tm.halted c_halt) + (hcell0 : c_halt.output.cells 0 = Γ.start) + (hnostart : ∀ j, j ≥ 1 → c_halt.output.cells j ≠ Γ.start) : + ∃ c_done t_rw, + tm.complementTM.reachesIn t_rw (complementCfg tm c_halt) c_done ∧ + tm.complementTM.halted c_done ∧ + c_done.output.cells 1 = (flipBit (c_halt.output.cells 1)).toΓ ∧ + t_rw ≤ c_halt.output.head + 4 := by + -- Step 1: halt → rewind (1 step) + have hne : (complementCfg tm c_halt).state ≠ Sum.inr ComplementPhase.done := nofun + have hstep1 : ∃ c_rw, tm.complementTM.step (complementCfg tm c_halt) = some c_rw ∧ + c_rw.state = Sum.inr ComplementPhase.rewind ∧ + c_rw.output.cells = c_halt.output.cells ∧ + c_rw.output.head ≤ c_halt.output.head + 1 := by + simp only [TM.step, ↓reduceIte, + show (complementCfg tm c_halt).state = Sum.inl c_halt.state from rfl, + complementTM, hhalt] + refine ⟨_, rfl, rfl, ?_, ?_⟩ + · dsimp only [complementCfg] + simp only [Tape.writeAndMove, Tape.move_cells] + by_cases hread : c_halt.output.read = Γ.start + · have hh0 : c_halt.output.head = 0 := by + have h := hread; simp only [Tape.read] at h + by_contra hne; exact hnostart _ (by omega) h + simp [Tape.write, hh0] + · rw [toΓ_readBackWrite_of_ne_start hread] + simp only [Tape.write]; split + · rfl + · exact Function.update_eq_self _ _ + · dsimp only [complementCfg] + exact Tape.head_writeAndMove_le _ _ _ + obtain ⟨c_rw, hstep1', hst_rw, hcells_rw, hhead_rw⟩ := hstep1 + -- Step 2: rewind loop (c_rw.output.head + 1 steps) + have hcell0_rw : c_rw.output.cells 0 = Γ.start := by rw [hcells_rw]; exact hcell0 + have hnostart_rw : ∀ j, j ≥ 1 → c_rw.output.cells j ≠ Γ.start := by + intro j hj; rw [hcells_rw]; exact hnostart j hj + obtain ⟨c_flip, hreach_rw, hst_flip, hhead_flip, hcells_flip⟩ := + rewind_loop tm c_rw.output.head c_rw hst_rw hcell0_rw hnostart_rw rfl + -- Step 3: flip (1 step) + have hne_flip : c_flip.state ≠ Sum.inr ComplementPhase.done := by rw [hst_flip]; nofun + have hnostart_flip : c_flip.output.read ≠ Γ.start := by + simp [Tape.read, hhead_flip, hcells_flip, hcells_rw] + exact hnostart 1 (by omega) + have hne1 : c_halt.output.cells 1 ≠ Γ.start := hnostart 1 (by omega) + have hstep3 : ∃ c_done, tm.complementTM.step c_flip = some c_done ∧ + c_done.state = Sum.inr ComplementPhase.done ∧ + c_done.output.cells 1 = (flipBit (c_halt.output.cells 1)).toΓ := by + simp only [TM.step, hst_flip, complementTM] + refine ⟨_, rfl, rfl, ?_⟩ + simp only [Tape.writeAndMove, Tape.move, Tape.write, Tape.read, hhead_flip, + hcells_flip, hcells_rw] + have hdir2 : idleDir (c_halt.output.cells 1) = Dir3.stay := by + simp [idleDir, hne1] + simp [hdir2, Function.update_self] + obtain ⟨c_done, hstep3', hst_done, hflip⟩ := hstep3 + refine ⟨c_done, ((c_rw.output.head + 1) + 1) + 1, + reachesIn_trans tm.complementTM (.step hstep1' hreach_rw) (.step hstep3' .zero), + hst_done, hflip, by omega⟩ + +-- ════════════════════════════════════════════════════════════════════════ +-- Main theorem +-- ════════════════════════════════════════════════════════════════════════ + +/-- If `tm` decides `L` in time `f`, then `complementTM tm` decides `Lᶜ` + in time `2 * f + 4`. -/ +theorem complementTM_decidesInTime (tm : TM n) {L : Language} {f : ℕ → ℕ} + (hdec : tm.DecidesInTime L f) : + tm.complementTM.DecidesInTime Lᶜ (fun n => 2 * f n + 4) := by + intro x + obtain ⟨c', t, hle, hreach, hhalt, hyes, hno⟩ := hdec x + have hsim := complementTM_simulation tm hreach + rw [compCfg_initCfg] at hsim + have ⟨_, hout_head, _⟩ := head_le_of_reachesIn tm hreach + have hcell0 := output_cells_zero_eq_start_of_reachesIn hreach (by simp [Tape.init]) + have hnostart := output_cells_ne_start_of_reachesIn hreach (by + intro i hi; simp [Tape.init]; omega) + obtain ⟨c_done, t_rw, hreach_rw, hhalt_done, hflip, hle_rw⟩ := + complementTM_rewind_and_flip tm c' hhalt hcell0 hnostart + have htotal := reachesIn_trans tm.complementTM hsim hreach_rw + refine ⟨c_done, t + t_rw, ?_, htotal, hhalt_done, ?_, ?_⟩ + · show t + t_rw ≤ 2 * f x.length + 4 + have : t_rw ≤ t + 4 := le_trans hle_rw (by omega) + omega + · intro hxc; rw [hflip, hno hxc]; simp [flipBit] + · intro hxc + simp only [Set.mem_compl_iff, not_not] at hxc + rw [hflip, hyes hxc]; simp [flipBit] + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/Internal/Generic.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/Internal/Generic.lean new file mode 100644 index 0000000000..4033f5ae98 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/Internal/Generic.lean @@ -0,0 +1,366 @@ +/- +Copyright (c) 2025 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators + +/-! +# Generic proof tools for TM combinators + +This file provides reusable proof infrastructure for TM combinator proofs, +eliminating duplication across `SeqInternal`, `IfInternal`, `LoopInternal`, +and `ComplementInternal`. + +## Main results + +- `reachesIn_map` — generic simulation lifting: if a state embedding + commutes with `step`, then `reachesIn` lifts through the embedding +- `exists_reachesIn_of_rewindStep_tape` — generic rewind loop for an + arbitrary tape accessor: stepping from a "rewind state" moves the head + left (preserving cells) until cell 0, then enters a "target state" at + head 1 +- `exists_reachesIn_of_rewindStep_output` — the same rewind loop + specialized to the output tape +- `exists_reachesIn_of_rewindStep_frame` — the output-tape rewind loop, + additionally proving the input and work tapes are unchanged +- `transitionTape` / `transitionInput` — the standard tape operations + applied at combinator phase boundaries, with cell-preservation and + head-bound lemmas (`transitionTape_cells`, `transitionInput_cells`, + `one_le_head_transitionTape`, `transitionInput_head_ge`, + `head_transitionTape_le`) +- `transitionTape_eq_self` / `transitionInput_eq_self` — frame rules: + both operations are no-ops on tapes reading a non-▷ symbol + +## Shared tape stability lemmas + +These lemmas were previously duplicated across multiple Internal files. +-/ + + +@[expose] public section + +namespace Complexity + +variable {n : ℕ} + +namespace TM + +-- ════════════════════════════════════════════════════════════════════════ +-- Shared tape lemmas (deduplicated from Internal files) +-- ════════════════════════════════════════════════════════════════════════ + +/-- A tape with head ≥ 1 and cells ≥ 1 ≠ start is stable under + `writeAndMove(readBackWrite(read).toΓ, idleDir(read))`. -/ +theorem tape_writeAndMove_stable (t : Tape) + (hhead : t.head ≥ 1) (hns : ∀ j, j ≥ 1 → t.cells j ≠ Γ.start) : + t.writeAndMove (readBackWrite t.read).toΓ (idleDir t.read) = t := by + have hne : t.read ≠ Γ.start := by simp only [Tape.read]; exact hns t.head hhead + rw [toΓ_readBackWrite_of_ne_start hne] + show (t.write t.read).move (idleDir t.read) = t + simp only [idleDir, hne, ↓reduceIte] + show (t.write (t.cells t.head)).move .stay = t + simp only [Tape.write, show ¬(t.head = 0) by omega, ↓reduceIte, + Function.update_eq_self, Tape.move] + +/-- A tape with head ≥ 1 and cells ≥ 1 ≠ start is stable under `move(idleDir(read))`. -/ +theorem tape_move_idleDir_stable (t : Tape) + (hhead : t.head ≥ 1) (hns : ∀ j, j ≥ 1 → t.cells j ≠ Γ.start) : + t.move (idleDir t.read) = t := by + have hne : t.read ≠ Γ.start := by simp only [Tape.read]; exact hns t.head hhead + simp only [idleDir, hne, ↓reduceIte, Tape.move] + +/-- Helper: readBackWrite preserves tape cells when head = 0 or read ≠ start. -/ +theorem tape_readBackWrite_preserves (t : Tape) (d : Dir3) + (h : t.head = 0 ∨ t.read ≠ Γ.start) : + (t.writeAndMove (readBackWrite t.read).toΓ d).cells = t.cells := by + simp only [Tape.writeAndMove, Tape.move_cells] + rcases h with hh0 | hne + · simp only [Tape.write, hh0, ↓reduceIte] + · rw [toΓ_readBackWrite_of_ne_start hne] + simp only [Tape.write, Tape.read]; split + · rfl + · exact Function.update_eq_self _ _ + +-- ════════════════════════════════════════════════════════════════════════ +-- Generic simulation lifting +-- ════════════════════════════════════════════════════════════════════════ + +/-- If `wrap` commutes with `step` (i.e., one step of `tm` corresponds to + one step of `tm'` through the embedding), then `reachesIn` lifts. -/ +theorem reachesIn_map {tm tm' : TM n} + (wrap : Cfg n tm.Q → Cfg n tm'.Q) + (h_step : ∀ c c' : Cfg n tm.Q, tm.step c = some c' → + tm'.step (wrap c) = some (wrap c')) + {t : ℕ} {c c' : Cfg n tm.Q} + (hreach : tm.reachesIn t c c') : + tm'.reachesIn t (wrap c) (wrap c') := by + induction hreach with + | zero => exact .zero + | step hstep _ ih => exact .step (h_step _ _ hstep) ih + +-- ════════════════════════════════════════════════════════════════════════ +-- Generic tape rewind loop (parameterized by tape accessor) +-- ════════════════════════════════════════════════════════════════════════ + +/-- **Generic rewind loop (abstract tape accessor)**. + + For any TM with a designated "rewind state" where stepping: + - At head > 0: stays in rewind, moves head left by 1, preserves cells + - At head = 0: enters target state, moves head to 1, preserves cells + + Then from rewind state with tape head at `p`, the machine reaches the + target state with tape head at 1 in exactly `p + 1` steps. + + The `tape` parameter selects which tape to track (output, work, etc.). + This captures the common rewind pattern used in `complementTM`, `ifTM`, + `loopTM`, `writeTM`, and `rewindWorkTM`. -/ +theorem exists_reachesIn_of_rewindStep_tape (tm : TM n) (tape : Cfg n tm.Q → Tape) + {rewindState targetState : tm.Q} + (h_step_left : ∀ c : Cfg n tm.Q, + c.state = rewindState → + (tape c).read ≠ Γ.start → + (tape c).cells 0 = Γ.start → + (∀ j, j ≥ 1 → (tape c).cells j ≠ Γ.start) → + ∃ c', tm.step c = some c' ∧ + c'.state = rewindState ∧ + (tape c').head = (tape c).head - 1 ∧ + (tape c').cells = (tape c).cells) + (h_step_base : ∀ c : Cfg n tm.Q, + c.state = rewindState → + (tape c).read = Γ.start → + (tape c).cells 0 = Γ.start → + (∀ j, j ≥ 1 → (tape c).cells j ≠ Γ.start) → + ∃ c', tm.step c = some c' ∧ + c'.state = targetState ∧ + (tape c').head = 1 ∧ + (tape c').cells = (tape c).cells) : + ∀ (p : ℕ) (c : Cfg n tm.Q), + c.state = rewindState → + (tape c).cells 0 = Γ.start → + (∀ j, j ≥ 1 → (tape c).cells j ≠ Γ.start) → + (tape c).head = p → + ∃ c_target, + tm.reachesIn (p + 1) c c_target ∧ + c_target.state = targetState ∧ + (tape c_target).head = 1 ∧ + (tape c_target).cells = (tape c).cells := by + intro p + induction p with + | zero => + intro c hstate hcell0 _ hhead + have hread : (tape c).read = Γ.start := by simp [Tape.read, hhead, hcell0] + obtain ⟨c', hstep, hst, hh, hc⟩ := h_step_base c hstate hread hcell0 (by assumption) + exact ⟨c', .step hstep .zero, hst, hh, hc⟩ + | succ p ih => + intro c hstate hcell0 hnostart hhead + have hread_ne : (tape c).read ≠ Γ.start := by + simp [Tape.read, hhead]; exact hnostart (p + 1) (by omega) + obtain ⟨c', hstep, hst, hh, hcells⟩ := h_step_left c hstate hread_ne hcell0 hnostart + have hh' : (tape c').head = p := by rw [hh, hhead]; omega + obtain ⟨c_target, hreach, hst_t, hh_t, hcells_t⟩ := ih c' hst + (by rw [hcells]; exact hcell0) + (by intro j hj; rw [hcells]; exact hnostart j hj) hh' + exact ⟨c_target, .step hstep hreach, hst_t, hh_t, by rw [hcells_t, hcells]⟩ + +/-- Specialization of `exists_reachesIn_of_rewindStep_tape` for the output tape. -/ +theorem exists_reachesIn_of_rewindStep_output (tm : TM n) + {rewindState targetState : tm.Q} + (h_step_left : ∀ c : Cfg n tm.Q, + c.state = rewindState → + c.output.read ≠ Γ.start → + c.output.cells 0 = Γ.start → + (∀ j, j ≥ 1 → c.output.cells j ≠ Γ.start) → + ∃ c', tm.step c = some c' ∧ + c'.state = rewindState ∧ + c'.output.head = c.output.head - 1 ∧ + c'.output.cells = c.output.cells) + (h_step_base : ∀ c : Cfg n tm.Q, + c.state = rewindState → + c.output.read = Γ.start → + c.output.cells 0 = Γ.start → + (∀ j, j ≥ 1 → c.output.cells j ≠ Γ.start) → + ∃ c', tm.step c = some c' ∧ + c'.state = targetState ∧ + c'.output.head = 1 ∧ + c'.output.cells = c.output.cells) : + ∀ (p : ℕ) (c : Cfg n tm.Q), + c.state = rewindState → + c.output.cells 0 = Γ.start → + (∀ j, j ≥ 1 → c.output.cells j ≠ Γ.start) → + c.output.head = p → + ∃ c_target, + tm.reachesIn (p + 1) c c_target ∧ + c_target.state = targetState ∧ + c_target.output.head = 1 ∧ + c_target.output.cells = c.output.cells := + exists_reachesIn_of_rewindStep_tape tm (fun c => c.output) h_step_left h_step_base + +/-- **Generic rewind loop (full tape tracking)**. + + Same as `exists_reachesIn_of_rewindStep_output`, but the step hypotheses also guarantee + that input and work tapes are preserved (given stability conditions: + head ≥ 1 and cells ≥ 1 ≠ start). The conclusion additionally proves + `c_target.input = c.input` and `c_target.work = c.work`. -/ +theorem exists_reachesIn_of_rewindStep_frame (tm : TM n) + {rewindState targetState : tm.Q} + (h_step_left : ∀ c : Cfg n tm.Q, + c.state = rewindState → + c.output.read ≠ Γ.start → + c.output.cells 0 = Γ.start → (∀ j, j ≥ 1 → c.output.cells j ≠ Γ.start) → + c.input.head ≥ 1 → (∀ j, j ≥ 1 → c.input.cells j ≠ Γ.start) → + (∀ i, (c.work i).head ≥ 1) → (∀ i j, j ≥ 1 → (c.work i).cells j ≠ Γ.start) → + ∃ c', tm.step c = some c' ∧ + c'.state = rewindState ∧ + c'.output.head = c.output.head - 1 ∧ + c'.output.cells = c.output.cells ∧ + c'.input = c.input ∧ c'.work = c.work) + (h_step_base : ∀ c : Cfg n tm.Q, + c.state = rewindState → + c.output.read = Γ.start → + c.output.cells 0 = Γ.start → (∀ j, j ≥ 1 → c.output.cells j ≠ Γ.start) → + c.input.head ≥ 1 → (∀ j, j ≥ 1 → c.input.cells j ≠ Γ.start) → + (∀ i, (c.work i).head ≥ 1) → (∀ i j, j ≥ 1 → (c.work i).cells j ≠ Γ.start) → + ∃ c', tm.step c = some c' ∧ + c'.state = targetState ∧ + c'.output.head = 1 ∧ + c'.output.cells = c.output.cells ∧ + c'.input = c.input ∧ c'.work = c.work) : + ∀ (p : ℕ) (c : Cfg n tm.Q), + c.state = rewindState → + c.output.cells 0 = Γ.start → + (∀ j, j ≥ 1 → c.output.cells j ≠ Γ.start) → + c.output.head = p → + c.input.head ≥ 1 → (∀ j, j ≥ 1 → c.input.cells j ≠ Γ.start) → + (∀ i, (c.work i).head ≥ 1) → (∀ i j, j ≥ 1 → (c.work i).cells j ≠ Γ.start) → + ∃ c_target, + tm.reachesIn (p + 1) c c_target ∧ + c_target.state = targetState ∧ + c_target.output.head = 1 ∧ + c_target.output.cells = c.output.cells ∧ + c_target.input = c.input ∧ + c_target.work = c.work := by + intro p + induction p with + | zero => + intro c hstate hcell0 _ hhead h_ih h_ins h_wh h_wns + have hread : c.output.read = Γ.start := by simp [Tape.read, hhead, hcell0] + obtain ⟨c', hstep, hst, hh, hcells, hinp, hwork⟩ := + h_step_base c hstate hread hcell0 (by assumption) h_ih h_ins h_wh h_wns + exact ⟨c', .step hstep .zero, hst, hh, hcells, hinp, hwork⟩ + | succ p ih => + intro c hstate hcell0 hnostart hhead h_ih h_ins h_wh h_wns + have hread_ne : c.output.read ≠ Γ.start := by + simp [Tape.read, hhead]; exact hnostart (p + 1) (by omega) + obtain ⟨c', hstep, hst, hh, hcells, hinp, hwork⟩ := + h_step_left c hstate hread_ne hcell0 hnostart h_ih h_ins h_wh h_wns + have hh' : c'.output.head = p := by rw [hh, hhead]; omega + obtain ⟨c_target, hreach, hst_t, hh_t, hcells_t, hinp_t, hwork_t⟩ := ih c' hst + (by rw [hcells]; exact hcell0) + (by intro j hj; rw [hcells]; exact hnostart j hj) hh' + (by rw [hinp]; exact h_ih) (by rw [hinp]; exact h_ins) + (by intro i; rw [hwork]; exact h_wh i) + (by intro i j hj; rw [hwork]; exact h_wns i j hj) + exact ⟨c_target, .step hstep hreach, hst_t, hh_t, + by rw [hcells_t, hcells], + by rw [hinp_t, hinp], + by rw [hwork_t, hwork]⟩ + +-- ════════════════════════════════════════════════════════════════════════ +-- Standard phase-transition tape operations +-- ════════════════════════════════════════════════════════════════════════ + +/-- The standard tape transformation applied at combinator phase boundaries + (work tapes and output tape). Writes back the current symbol (preserving + cells) and stays in place; if at cell 0, `δ_right_of_start` forces a + right move to cell 1. + + Used by all combinators (`seqTM`, `ifTM`, `loopTM`, `complementTM`) + at transitions between phases. -/ +def transitionTape (t : Tape) : Tape := + t.writeAndMove (readBackWrite t.read).toΓ (idleDir t.read) + +/-- The standard input-tape transformation at combinator phase boundaries. + The input tape is read-only (no write), so only the head moves: stay + in place unless at cell 0, where `δ_right_of_start` forces right. -/ +def transitionInput (t : Tape) : Tape := + t.move (idleDir t.read) + +/-- `transitionTape` preserves cells when cells ≥ 1 ≠ start. -/ +theorem transitionTape_cells (t : Tape) + (hns : ∀ j, j ≥ 1 → t.cells j ≠ Γ.start) : + (transitionTape t).cells = t.cells := by + simp only [transitionTape, Tape.writeAndMove, Tape.move_cells] + by_cases hh : t.head = 0 + · simp only [Tape.write, hh, ↓reduceIte] + · have hge : t.head ≥ 1 := by omega + rw [toΓ_readBackWrite_of_ne_start (by simp only [Tape.read]; exact hns t.head hge)] + simp only [Tape.write, hh, ↓reduceIte, Tape.read, Function.update_eq_self] + +/-- `transitionInput` preserves cells (always, since input has no write). -/ +theorem transitionInput_cells (t : Tape) : + (transitionInput t).cells = t.cells := by + simp [transitionInput, Tape.move]; split <;> rfl + +/-- After `transitionTape`, head ≥ 1 when cell 0 = start. -/ +theorem one_le_head_transitionTape (t : Tape) (h0 : t.cells 0 = Γ.start) : + (transitionTape t).head ≥ 1 := by + unfold transitionTape Tape.writeAndMove + by_cases hh : t.head = 0 + · simp only [Tape.write, hh, ↓reduceIte, Tape.read, h0, idleDir, Tape.move]; omega + · cases hdir : idleDir t.read with + | stay => simp only [Tape.move, Tape.write, hh, ↓reduceIte]; omega + | right => simp only [Tape.move, Tape.write, hh, ↓reduceIte]; omega + | left => exfalso; revert hdir; simp only [idleDir]; split <;> simp + +/-- After `transitionInput`, head ≥ 1 when cell 0 = start. -/ +theorem transitionInput_head_ge (t : Tape) (h0 : t.cells 0 = Γ.start) : + (transitionInput t).head ≥ 1 := by + unfold transitionInput + by_cases hh : t.head = 0 + · simp only [Tape.read, hh, h0, idleDir, ↓reduceIte, Tape.move]; omega + · cases hdir : idleDir t.read with + | stay => simp only [Tape.move]; omega + | right => simp only [Tape.move]; omega + | left => exfalso; revert hdir; simp only [idleDir]; split <;> simp + +/-- Bound on `transitionTape` output head: ≤ original head + 1. -/ +theorem head_transitionTape_le {t : Tape} {p_bound : ℕ} + (hcell0 : t.cells 0 = Γ.start) (hhead : t.head ≤ p_bound) : + (transitionTape t).head ≤ p_bound + 1 := by + unfold transitionTape Tape.writeAndMove + by_cases hh : t.head = 0 + · simp only [Tape.write, hh, ↓reduceIte, Tape.read, hcell0, idleDir, Tape.move]; omega + · cases hdir : idleDir t.read with + | stay => simp only [Tape.move, Tape.write, hh, ↓reduceIte]; omega + | right => simp only [Tape.move, Tape.write, hh, ↓reduceIte]; omega + | left => exfalso; revert hdir; simp only [idleDir]; split <;> simp + +-- ════════════════════════════════════════════════════════════════════════ +-- Frame rules: transitionTape/transitionInput are identity on stable tapes +-- ════════════════════════════════════════════════════════════════════════ + +/-- **Frame rule**: `transitionTape` is the identity when the tape reads a + non-▷ symbol. This is the key lemma for threading invariants through + `seqTM` / `loopTM` / `ifTM` composition: tapes that are "stable" + (head not at cell 0) pass through phase transitions unchanged. -/ +theorem transitionTape_eq_self {t : Tape} (hread : t.read ≠ Γ.start) : + transitionTape t = t := by + unfold transitionTape Tape.writeAndMove + rw [toΓ_readBackWrite_of_ne_start hread] + simp only [idleDir, hread, ↓reduceIte, Tape.move, Tape.write] + split + · rfl + · simp only [Tape.read, Function.update_eq_self] + +/-- **Frame rule**: `transitionInput` is the identity when the tape reads a + non-▷ symbol. -/ +theorem transitionInput_eq_self {t : Tape} (hread : t.read ≠ Γ.start) : + transitionInput t = t := by + simp only [transitionInput, idleDir, hread, ↓reduceIte, Tape.move] + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/Internal/If.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/Internal/If.lean new file mode 100644 index 0000000000..63725be0ec --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/Internal/If.lean @@ -0,0 +1,361 @@ +/- +Copyright (c) 2025 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.Internal.Generic + +/-! +# ifTM simulation — proof internals + +This file contains the simulation lemmas for `ifTM tmTest tmThen tmElse`. + +## Key definitions + +- `ifTestWrap` — embed a `tmTest` config into the `ifTM` config space +- `ifThenWrap` — embed a `tmThen` config into the `ifTM` config space +- `ifElseWrap` — embed a `tmElse` config into the `ifTM` config space +-/ + + +@[expose] public section + +namespace Complexity + +variable {n : ℕ} + +namespace TM + +-- ════════════════════════════════════════════════════════════════════════ +-- Config wrapping +-- ════════════════════════════════════════════════════════════════════════ + +/-- Embed a `tmTest` config into the `ifTM` config space (test phase). -/ +def ifTestWrap (tmTest : TM n) (tmThen : TM n) (tmElse : TM n) + (c : Cfg n tmTest.Q) : Cfg n (IfQ tmTest.Q tmThen.Q tmElse.Q) where + state := Sum.inl c.state + input := c.input + work := c.work + output := c.output + +/-- Embed a `tmThen` config into the `ifTM` config space (then branch). -/ +def ifThenWrap (tmTest : TM n) (tmThen : TM n) (tmElse : TM n) + (c : Cfg n tmThen.Q) : Cfg n (IfQ tmTest.Q tmThen.Q tmElse.Q) where + state := Sum.inr (Sum.inr (Sum.inl c.state)) + input := c.input + work := c.work + output := c.output + +/-- Embed a `tmElse` config into the `ifTM` config space (else branch). -/ +def ifElseWrap (tmTest : TM n) (tmThen : TM n) (tmElse : TM n) + (c : Cfg n tmElse.Q) : Cfg n (IfQ tmTest.Q tmThen.Q tmElse.Q) where + state := Sum.inr (Sum.inr (Sum.inr c.state)) + input := c.input + work := c.work + output := c.output + +-- ════════════════════════════════════════════════════════════════════════ +-- Sum discrimination helpers +-- ════════════════════════════════════════════════════════════════════════ + +private theorem ifQ_test_ne_halt {QT QThen QElse : Type} {q : QT} : + (Sum.inl q : IfQ QT QThen QElse) ≠ Sum.inr (Sum.inl IfPhase.done) := nofun + +private theorem ifQ_then_ne_halt {QT QThen QElse : Type} {q : QThen} : + (Sum.inr (Sum.inr (Sum.inl q)) : IfQ QT QThen QElse) ≠ + Sum.inr (Sum.inl IfPhase.done) := nofun + +private theorem ifQ_else_ne_halt {QT QThen QElse : Type} {q : QElse} : + (Sum.inr (Sum.inr (Sum.inr q)) : IfQ QT QThen QElse) ≠ + Sum.inr (Sum.inl IfPhase.done) := nofun + +private theorem ifQ_phase_ne_halt {QT QThen QElse : Type} + {p : IfPhase} (hp : p ≠ .done) : + (Sum.inr (Sum.inl p) : IfQ QT QThen QElse) ≠ + Sum.inr (Sum.inl IfPhase.done) := + fun h => hp (Sum.inl.inj (Sum.inr.inj h)) + +-- ════════════════════════════════════════════════════════════════════════ +-- Test phase: ifTM simulates tmTest (via generic simulation lifting) +-- ════════════════════════════════════════════════════════════════════════ + +/-- One step of `tmTest` corresponds to one step of `ifTM` during the test phase. -/ +theorem ifTM_test_step (tmTest tmThen tmElse : TM n) {c c' : Cfg n tmTest.Q} + (hstep : tmTest.step c = some c') : + (ifTM tmTest tmThen tmElse).step (ifTestWrap tmTest tmThen tmElse c) = + some (ifTestWrap tmTest tmThen tmElse c') := by + have hne : c.state ≠ tmTest.qhalt := state_ne_qhalt_of_step hstep + simp only [step, hne, ↓reduceIte, Option.some.injEq] at hstep + subst hstep + show (if (ifTestWrap tmTest tmThen tmElse c).state = + (ifTM tmTest tmThen tmElse).qhalt then none else some _) = some _ + simp only [ifTestWrap, ifTM, if_neg ifQ_test_ne_halt, if_neg hne] + +/-- Multi-step test phase simulation. -/ +theorem ifTM_reachesIn_ifTestWrap (tmTest tmThen tmElse : TM n) {t : ℕ} + {c_start c_end : Cfg n tmTest.Q} + (hreach : tmTest.reachesIn t c_start c_end) : + (ifTM tmTest tmThen tmElse).reachesIn t + (ifTestWrap tmTest tmThen tmElse c_start) + (ifTestWrap tmTest tmThen tmElse c_end) := + reachesIn_map (tm' := ifTM tmTest tmThen tmElse) (ifTestWrap tmTest tmThen tmElse) + (fun _ _ => ifTM_test_step tmTest tmThen tmElse) hreach + +-- ════════════════════════════════════════════════════════════════════════ +-- Then branch: ifTM simulates tmThen (via generic simulation lifting) +-- ════════════════════════════════════════════════════════════════════════ + +/-- One step of `tmThen` corresponds to one step of `ifTM` during the then branch. -/ +theorem ifTM_then_step (tmTest tmThen tmElse : TM n) {c c' : Cfg n tmThen.Q} + (hstep : tmThen.step c = some c') : + (ifTM tmTest tmThen tmElse).step (ifThenWrap tmTest tmThen tmElse c) = + some (ifThenWrap tmTest tmThen tmElse c') := by + have hne : c.state ≠ tmThen.qhalt := state_ne_qhalt_of_step hstep + simp only [step, hne, ↓reduceIte, Option.some.injEq] at hstep + subst hstep + show (if (ifThenWrap tmTest tmThen tmElse c).state = + (ifTM tmTest tmThen tmElse).qhalt then none else some _) = some _ + simp only [ifThenWrap, ifTM, if_neg ifQ_then_ne_halt, if_neg hne] + +/-- Multi-step then-branch simulation. -/ +theorem ifTM_reachesIn_ifThenWrap (tmTest tmThen tmElse : TM n) {t : ℕ} + {c_start c_end : Cfg n tmThen.Q} + (hreach : tmThen.reachesIn t c_start c_end) : + (ifTM tmTest tmThen tmElse).reachesIn t + (ifThenWrap tmTest tmThen tmElse c_start) + (ifThenWrap tmTest tmThen tmElse c_end) := + reachesIn_map (tm' := ifTM tmTest tmThen tmElse) (ifThenWrap tmTest tmThen tmElse) + (fun _ _ => ifTM_then_step tmTest tmThen tmElse) hreach + +-- ════════════════════════════════════════════════════════════════════════ +-- Else branch: ifTM simulates tmElse (via generic simulation lifting) +-- ════════════════════════════════════════════════════════════════════════ + +/-- One step of `tmElse` corresponds to one step of `ifTM` during the else branch. -/ +theorem ifTM_else_step (tmTest tmThen tmElse : TM n) {c c' : Cfg n tmElse.Q} + (hstep : tmElse.step c = some c') : + (ifTM tmTest tmThen tmElse).step (ifElseWrap tmTest tmThen tmElse c) = + some (ifElseWrap tmTest tmThen tmElse c') := by + have hne : c.state ≠ tmElse.qhalt := state_ne_qhalt_of_step hstep + simp only [step, hne, ↓reduceIte, Option.some.injEq] at hstep + subst hstep + show (if (ifElseWrap tmTest tmThen tmElse c).state = + (ifTM tmTest tmThen tmElse).qhalt then none else some _) = some _ + simp only [ifElseWrap, ifTM, if_neg ifQ_else_ne_halt, if_neg hne] + +/-- Multi-step else-branch simulation. -/ +theorem ifTM_reachesIn_ifElseWrap (tmTest tmThen tmElse : TM n) {t : ℕ} + {c_start c_end : Cfg n tmElse.Q} + (hreach : tmElse.reachesIn t c_start c_end) : + (ifTM tmTest tmThen tmElse).reachesIn t + (ifElseWrap tmTest tmThen tmElse c_start) + (ifElseWrap tmTest tmThen tmElse c_end) := + reachesIn_map (tm' := ifTM tmTest tmThen tmElse) (ifElseWrap tmTest tmThen tmElse) + (fun _ _ => ifTM_else_step tmTest tmThen tmElse) hreach + +-- ════════════════════════════════════════════════════════════════════════ +-- Halt transitions: branch halt → done +-- ════════════════════════════════════════════════════════════════════════ + +/-- When `tmThen` halts, one step transitions to `done`. -/ +theorem ifTM_then_halt_step (tmTest tmThen tmElse : TM n) {c : Cfg n tmThen.Q} + (hhalt : c.state = tmThen.qhalt) : + (ifTM tmTest tmThen tmElse).step (ifThenWrap tmTest tmThen tmElse c) = + some { state := Sum.inr (Sum.inl IfPhase.done), + input := transitionInput c.input, + work := fun i => transitionTape (c.work i), + output := transitionTape c.output } := by + show (if (ifThenWrap tmTest tmThen tmElse c).state = + (ifTM tmTest tmThen tmElse).qhalt then none else some _) = some _ + simp only [ifThenWrap, ifTM, if_neg ifQ_then_ne_halt, hhalt, ↓reduceIte] + congr 1 + +/-- When `tmElse` halts, one step transitions to `done`. -/ +theorem ifTM_else_halt_step (tmTest tmThen tmElse : TM n) {c : Cfg n tmElse.Q} + (hhalt : c.state = tmElse.qhalt) : + (ifTM tmTest tmThen tmElse).step (ifElseWrap tmTest tmThen tmElse c) = + some { state := Sum.inr (Sum.inl IfPhase.done), + input := transitionInput c.input, + work := fun i => transitionTape (c.work i), + output := transitionTape c.output } := by + show (if (ifElseWrap tmTest tmThen tmElse c).state = + (ifTM tmTest tmThen tmElse).qhalt then none else some _) = some _ + simp only [ifElseWrap, ifTM, if_neg ifQ_else_ne_halt, hhalt, ↓reduceIte] + congr 1 + +-- ════════════════════════════════════════════════════════════════════════ +-- Test phase → rewind transition +-- ════════════════════════════════════════════════════════════════════════ + +/-- When `tmTest` halts, one step enters the rewindOut phase. -/ +theorem ifTM_test_to_rewind (tmTest tmThen tmElse : TM n) {c : Cfg n tmTest.Q} + (hhalt : c.state = tmTest.qhalt) : + (ifTM tmTest tmThen tmElse).step (ifTestWrap tmTest tmThen tmElse c) = + some { state := Sum.inr (Sum.inl IfPhase.rewindOut), + input := transitionInput c.input, + work := fun i => transitionTape (c.work i), + output := transitionTape c.output } := by + show (if (ifTestWrap tmTest tmThen tmElse c).state = + (ifTM tmTest tmThen tmElse).qhalt then none else some _) = some _ + simp only [ifTestWrap, ifTM, if_neg ifQ_test_ne_halt, hhalt, ↓reduceIte] + congr 1 + +-- ════════════════════════════════════════════════════════════════════════ +-- Halting +-- ════════════════════════════════════════════════════════════════════════ + +theorem ifTM_qhalt_eq_done (tmTest tmThen tmElse : TM n) : + (ifTM tmTest tmThen tmElse).qhalt = Sum.inr (Sum.inl IfPhase.done) := rfl + +/-- The `done` state is halted in `ifTM`. -/ +theorem ifTM_halted_of_state_eq_done (tmTest tmThen tmElse : TM n) + (c : Cfg n (IfQ tmTest.Q tmThen.Q tmElse.Q)) + (h : c.state = Sum.inr (Sum.inl IfPhase.done)) : + (ifTM tmTest tmThen tmElse).halted c := h + +-- ════════════════════════════════════════════════════════════════════════ +-- Rewind loop (full tape tracking, via generic rewind) +-- ════════════════════════════════════════════════════════════════════════ + +private theorem if_rewind_step_left_full (tmTest tmThen tmElse : TM n) + (c : Cfg n (IfQ tmTest.Q tmThen.Q tmElse.Q)) + (hstate : c.state = Sum.inr (Sum.inl IfPhase.rewindOut)) + (hread_ne : c.output.read ≠ Γ.start) + (_ : c.output.cells 0 = Γ.start) (_ : ∀ j, j ≥ 1 → c.output.cells j ≠ Γ.start) + (h_ih : c.input.head ≥ 1) (h_ins : ∀ j, j ≥ 1 → c.input.cells j ≠ Γ.start) + (h_wh : ∀ i, (c.work i).head ≥ 1) (h_wns : ∀ i j, j ≥ 1 → (c.work i).cells j ≠ Γ.start) : + ∃ c', (ifTM tmTest tmThen tmElse).step c = some c' ∧ + c'.state = Sum.inr (Sum.inl IfPhase.rewindOut) ∧ + c'.output.head = c.output.head - 1 ∧ + c'.output.cells = c.output.cells ∧ + c'.input = c.input ∧ c'.work = c.work := by + have hne : c.state ≠ (ifTM tmTest tmThen tmElse).qhalt := by rw [hstate]; nofun + simp only [TM.step, ↓reduceIte, hstate, ifTM, hread_ne] + refine ⟨_, rfl, rfl, ?_, ?_, ?_, ?_⟩ + · simp only [Tape.writeAndMove, Tape.move] + rw [toΓ_readBackWrite_of_ne_start hread_ne] + simp only [Tape.write, Tape.read]; split + · omega + · simp + · simp only [Tape.writeAndMove, Tape.move_cells] + rw [toΓ_readBackWrite_of_ne_start hread_ne] + simp only [Tape.write, Tape.read]; split + · rfl + · exact Function.update_eq_self _ _ + · exact tape_move_idleDir_stable _ h_ih h_ins + · funext i; exact tape_writeAndMove_stable _ (h_wh i) (h_wns i) + +private theorem if_rewind_step_base_full (tmTest tmThen tmElse : TM n) + (c : Cfg n (IfQ tmTest.Q tmThen.Q tmElse.Q)) + (hstate : c.state = Sum.inr (Sum.inl IfPhase.rewindOut)) + (hread : c.output.read = Γ.start) + (_ : c.output.cells 0 = Γ.start) + (hnostart : ∀ j, j ≥ 1 → c.output.cells j ≠ Γ.start) + (h_ih : c.input.head ≥ 1) (h_ins : ∀ j, j ≥ 1 → c.input.cells j ≠ Γ.start) + (h_wh : ∀ i, (c.work i).head ≥ 1) (h_wns : ∀ i j, j ≥ 1 → (c.work i).cells j ≠ Γ.start) : + ∃ c', (ifTM tmTest tmThen tmElse).step c = some c' ∧ + c'.state = Sum.inr (Sum.inl IfPhase.check) ∧ + c'.output.head = 1 ∧ + c'.output.cells = c.output.cells ∧ + c'.input = c.input ∧ c'.work = c.work := by + have hne : c.state ≠ (ifTM tmTest tmThen tmElse).qhalt := by rw [hstate]; nofun + have hhead : c.output.head = 0 := by + by_contra hne + exact hnostart c.output.head (by omega) (by simp only [Tape.read] at hread; exact hread) + simp only [TM.step, ↓reduceIte, hstate, ifTM, hread] + refine ⟨_, rfl, rfl, ?_, ?_, ?_, ?_⟩ + · simp [Tape.writeAndMove, Tape.move, Tape.write, hhead] + · simp [Tape.writeAndMove, Tape.move_cells, Tape.write, hhead] + · exact tape_move_idleDir_stable _ h_ih h_ins + · funext i; exact tape_writeAndMove_stable _ (h_wh i) (h_wns i) + +/-- Extended rewind loop: also tracks that input and work tapes are preserved + when they satisfy the stability condition (head ≥ 1, cells ≥ 1 ≠ start). -/ +theorem ifTM_rewindOut_reachesIn_check (tmTest tmThen tmElse : TM n) : + ∀ (p : ℕ) (c : Cfg n (IfQ tmTest.Q tmThen.Q tmElse.Q)), + c.state = Sum.inr (Sum.inl IfPhase.rewindOut) → + c.output.cells 0 = Γ.start → + (∀ j, j ≥ 1 → c.output.cells j ≠ Γ.start) → + c.output.head = p → + c.input.head ≥ 1 → (∀ j, j ≥ 1 → c.input.cells j ≠ Γ.start) → + (∀ i, (c.work i).head ≥ 1) → + (∀ i j, j ≥ 1 → (c.work i).cells j ≠ Γ.start) → + ∃ c_check, + (ifTM tmTest tmThen tmElse).reachesIn (p + 1) c c_check ∧ + c_check.state = Sum.inr (Sum.inl IfPhase.check) ∧ + c_check.output.head = 1 ∧ + c_check.output.cells = c.output.cells ∧ + c_check.input = c.input ∧ + c_check.work = c.work := + exists_reachesIn_of_rewindStep_frame (ifTM tmTest tmThen tmElse) + (fun c hst hread hc0 hns h_ih h_ins h_wh h_wns => + if_rewind_step_left_full tmTest tmThen tmElse c hst hread hc0 hns h_ih h_ins h_wh h_wns) + (fun c hst hread hc0 hns h_ih h_ins h_wh h_wns => + if_rewind_step_base_full tmTest tmThen tmElse c hst hread hc0 hns h_ih h_ins h_wh h_wns) + +-- ════════════════════════════════════════════════════════════════════════ +-- Check step (full tape tracking) +-- ════════════════════════════════════════════════════════════════════════ + +/-- Check step to then-branch, tracking all tapes. -/ +theorem ifTM_check_step_then_full (tmTest tmThen tmElse : TM n) + (c : Cfg n (IfQ tmTest.Q tmThen.Q tmElse.Q)) + (hstate : c.state = Sum.inr (Sum.inl IfPhase.check)) + (hhead : c.output.head = 1) + (hcell1 : c.output.cells 1 = Γ.one) + (h_ih : c.input.head ≥ 1) (h_ins : ∀ j, j ≥ 1 → c.input.cells j ≠ Γ.start) + (h_wh : ∀ i, (c.work i).head ≥ 1) + (h_wns : ∀ i j, j ≥ 1 → (c.work i).cells j ≠ Γ.start) : + ∃ c', (ifTM tmTest tmThen tmElse).step c = some c' ∧ + c'.state = Sum.inr (Sum.inr (Sum.inl tmThen.qstart)) ∧ + c'.output.cells = c.output.cells ∧ + c'.output.head = 1 ∧ + c'.input = c.input ∧ c'.work = c.work := by + have hne : c.state ≠ (ifTM tmTest tmThen tmElse).qhalt := by rw [hstate]; nofun + have hread : c.output.read = Γ.one := by simp [Tape.read, hhead, hcell1] + simp only [TM.step, ↓reduceIte, hstate, ifTM, hread] + refine ⟨_, rfl, rfl, ?_, ?_, ?_, ?_⟩ + · show (c.output.writeAndMove (readBackWrite Γ.one).toΓ (idleDir Γ.one)).cells = c.output.cells + simp only [readBackWrite, Γw.toΓ, idleDir, Tape.writeAndMove, Tape.move_cells] + simp only [Tape.write]; split + · omega + · dsimp only []; rw [hhead, ← hcell1]; exact Function.update_eq_self _ _ + · simp only [readBackWrite, Γw.toΓ, idleDir, Tape.writeAndMove, Tape.move, Tape.write] + split <;> simp_all + · exact tape_move_idleDir_stable _ h_ih h_ins + · funext i; exact tape_writeAndMove_stable _ (h_wh i) (h_wns i) + +/-- Check step to else-branch, tracking all tapes. -/ +theorem ifTM_check_step_else_full (tmTest tmThen tmElse : TM n) + (c : Cfg n (IfQ tmTest.Q tmThen.Q tmElse.Q)) + (hstate : c.state = Sum.inr (Sum.inl IfPhase.check)) + (hhead : c.output.head = 1) + (hcell1 : c.output.cells 1 ≠ Γ.one) + (hnostart_out : ∀ j, j ≥ 1 → c.output.cells j ≠ Γ.start) + (h_ih : c.input.head ≥ 1) (h_ins : ∀ j, j ≥ 1 → c.input.cells j ≠ Γ.start) + (h_wh : ∀ i, (c.work i).head ≥ 1) + (h_wns : ∀ i j, j ≥ 1 → (c.work i).cells j ≠ Γ.start) : + ∃ c', (ifTM tmTest tmThen tmElse).step c = some c' ∧ + c'.state = Sum.inr (Sum.inr (Sum.inr tmElse.qstart)) ∧ + c'.output.cells = c.output.cells ∧ + c'.output.head = 1 ∧ + c'.input = c.input ∧ c'.work = c.work := by + have hne : c.state ≠ (ifTM tmTest tmThen tmElse).qhalt := by rw [hstate]; nofun + have hread_ne_one : c.output.read ≠ Γ.one := by simp [Tape.read, hhead]; exact hcell1 + have hread_ne_start : c.output.read ≠ Γ.start := by + simp only [Tape.read, hhead]; exact hnostart_out 1 (by omega) + simp only [TM.step, ↓reduceIte, hstate, ifTM, hread_ne_one] + refine ⟨_, rfl, rfl, ?_, ?_, ?_, ?_⟩ + · apply tape_readBackWrite_preserves; right; exact hread_ne_start + · have hstable := tape_writeAndMove_stable c.output (by omega) hnostart_out + show (c.output.writeAndMove (readBackWrite c.output.read).toΓ + (idleDir c.output.read)).head = 1 + rw [hstable, hhead] + · exact tape_move_idleDir_stable _ h_ih h_ins + · funext i; exact tape_writeAndMove_stable _ (h_wh i) (h_wns i) + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/Internal/Loop.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/Internal/Loop.lean new file mode 100644 index 0000000000..384ef17885 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/Internal/Loop.lean @@ -0,0 +1,354 @@ +/- +Copyright (c) 2025 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.Internal.Generic + +/-! +# loopTM simulation — proof internals + +This file contains the simulation lemmas for `loopTM tmBody tmTest`. + +## Key definitions + +- `loopBodyWrap` — embed a `tmBody` config into the `loopTM` config space +- `loopTestWrap` — embed a `tmTest` config into the `loopTM` config space +- Tape transformations use the shared `transitionTape` / `transitionInput` +-/ + + +@[expose] public section + +namespace Complexity + +variable {n : ℕ} + +namespace TM + +-- ════════════════════════════════════════════════════════════════════════ +-- Config wrapping +-- ════════════════════════════════════════════════════════════════════════ + +/-- Embed a `tmBody` config into the `loopTM` config space (body phase). -/ +def loopBodyWrap (tmBody : TM n) (tmTest : TM n) (c : Cfg n tmBody.Q) : + Cfg n (LoopQ tmBody.Q tmTest.Q) where + state := Sum.inl c.state + input := c.input + work := c.work + output := c.output + +/-- Embed a `tmTest` config into the `loopTM` config space (test phase). -/ +def loopTestWrap (tmBody : TM n) (tmTest : TM n) (c : Cfg n tmTest.Q) : + Cfg n (LoopQ tmBody.Q tmTest.Q) where + state := Sum.inr (Sum.inr c.state) + input := c.input + work := c.work + output := c.output + +-- ════════════════════════════════════════════════════════════════════════ +-- Sum discrimination helpers +-- ════════════════════════════════════════════════════════════════════════ + +private theorem loopQ_body_ne_halt {QBody QTest : Type} {q : QBody} : + (Sum.inl q : LoopQ QBody QTest) ≠ Sum.inr (Sum.inl LoopPhase.done) := nofun + +private theorem loopQ_test_ne_halt {QBody QTest : Type} {q : QTest} : + (Sum.inr (Sum.inr q) : LoopQ QBody QTest) ≠ + Sum.inr (Sum.inl LoopPhase.done) := nofun + +-- ════════════════════════════════════════════════════════════════════════ +-- Body phase: loopTM simulates tmBody (via generic simulation lifting) +-- ════════════════════════════════════════════════════════════════════════ + +/-- A non-halting `tmBody` step is simulated by one `loopTM` step on +body-wrapped configurations. -/ +theorem loopTM_body_step (tmBody tmTest : TM n) {c c' : Cfg n tmBody.Q} + (hstep : tmBody.step c = some c') : + (loopTM tmBody tmTest).step (loopBodyWrap tmBody tmTest c) = + some (loopBodyWrap tmBody tmTest c') := by + have hne : c.state ≠ tmBody.qhalt := state_ne_qhalt_of_step hstep + simp only [step, hne, ↓reduceIte, Option.some.injEq] at hstep + subst hstep + show (if (loopBodyWrap tmBody tmTest c).state = + (loopTM tmBody tmTest).qhalt then none else some _) = some _ + simp only [loopBodyWrap, loopTM, if_neg loopQ_body_ne_halt, if_neg hne] + +/-- A `t`-step run of `tmBody` lifts to a `t`-step run of `loopTM` between the +body-wrapped configurations. -/ +theorem loopTM_body_simulation (tmBody tmTest : TM n) {t : ℕ} + {c_start c_end : Cfg n tmBody.Q} + (hreach : tmBody.reachesIn t c_start c_end) : + (loopTM tmBody tmTest).reachesIn t + (loopBodyWrap tmBody tmTest c_start) (loopBodyWrap tmBody tmTest c_end) := + reachesIn_map (tm' := loopTM tmBody tmTest) (loopBodyWrap tmBody tmTest) + (fun _ _ => loopTM_body_step tmBody tmTest) hreach + +-- ════════════════════════════════════════════════════════════════════════ +-- Body → test transition +-- ════════════════════════════════════════════════════════════════════════ + +/-- When `tmBody` has halted, one `loopTM` step moves from the body-wrapped +configuration to `tmTest`'s start state, applying the shared tape transition to +every tape. -/ +theorem loopTM_body_to_test (tmBody tmTest : TM n) {c : Cfg n tmBody.Q} + (hhalt : c.state = tmBody.qhalt) : + (loopTM tmBody tmTest).step (loopBodyWrap tmBody tmTest c) = + some (loopTestWrap tmBody tmTest + { state := tmTest.qstart, + input := transitionInput c.input, + work := fun i => transitionTape (c.work i), + output := transitionTape c.output }) := by + show (if (loopBodyWrap tmBody tmTest c).state = + (loopTM tmBody tmTest).qhalt then none else some _) = some _ + simp only [loopBodyWrap, loopTM, if_neg loopQ_body_ne_halt, hhalt, ↓reduceIte] + congr 1 + +-- ════════════════════════════════════════════════════════════════════════ +-- Test phase: loopTM simulates tmTest (via generic simulation lifting) +-- ════════════════════════════════════════════════════════════════════════ + +/-- A non-halting `tmTest` step is simulated by one `loopTM` step on +test-wrapped configurations. -/ +theorem loopTM_test_step (tmBody tmTest : TM n) {c c' : Cfg n tmTest.Q} + (hstep : tmTest.step c = some c') : + (loopTM tmBody tmTest).step (loopTestWrap tmBody tmTest c) = + some (loopTestWrap tmBody tmTest c') := by + have hne : c.state ≠ tmTest.qhalt := state_ne_qhalt_of_step hstep + simp only [step, hne, ↓reduceIte, Option.some.injEq] at hstep + subst hstep + show (if (loopTestWrap tmBody tmTest c).state = + (loopTM tmBody tmTest).qhalt then none else some _) = some _ + simp only [loopTestWrap, loopTM, if_neg loopQ_test_ne_halt, if_neg hne] + +/-- A `t`-step run of `tmTest` lifts to a `t`-step run of `loopTM` between the +test-wrapped configurations. -/ +theorem loopTM_test_simulation (tmBody tmTest : TM n) {t : ℕ} + {c_start c_end : Cfg n tmTest.Q} + (hreach : tmTest.reachesIn t c_start c_end) : + (loopTM tmBody tmTest).reachesIn t + (loopTestWrap tmBody tmTest c_start) (loopTestWrap tmBody tmTest c_end) := + reachesIn_map (tm' := loopTM tmBody tmTest) (loopTestWrap tmBody tmTest) + (fun _ _ => loopTM_test_step tmBody tmTest) hreach + +-- ════════════════════════════════════════════════════════════════════════ +-- Test → rewind transition +-- ════════════════════════════════════════════════════════════════════════ + +/-- When `tmTest` has halted, one `loopTM` step moves from the test-wrapped +configuration to the `rewindOut` phase, applying the shared tape transition to +every tape. -/ +theorem loopTM_test_to_rewind (tmBody tmTest : TM n) {c : Cfg n tmTest.Q} + (hhalt : c.state = tmTest.qhalt) : + (loopTM tmBody tmTest).step (loopTestWrap tmBody tmTest c) = + some { state := Sum.inr (Sum.inl LoopPhase.rewindOut), + input := transitionInput c.input, + work := fun i => transitionTape (c.work i), + output := transitionTape c.output } := by + show (if (loopTestWrap tmBody tmTest c).state = + (loopTM tmBody tmTest).qhalt then none else some _) = some _ + simp only [loopTestWrap, loopTM, if_neg loopQ_test_ne_halt, hhalt, ↓reduceIte] + congr 1 + +-- ════════════════════════════════════════════════════════════════════════ +-- Rewind loop (via generic rewind) +-- ════════════════════════════════════════════════════════════════════════ + +private theorem loop_rewind_step_left (tmBody tmTest : TM n) + (c : Cfg n (LoopQ tmBody.Q tmTest.Q)) + (hstate : c.state = Sum.inr (Sum.inl LoopPhase.rewindOut)) + (hread_ne : c.output.read ≠ Γ.start) + (_ : c.output.cells 0 = Γ.start) (_ : ∀ j, j ≥ 1 → c.output.cells j ≠ Γ.start) : + ∃ c', (loopTM tmBody tmTest).step c = some c' ∧ + c'.state = Sum.inr (Sum.inl LoopPhase.rewindOut) ∧ + c'.output.head = c.output.head - 1 ∧ + c'.output.cells = c.output.cells := by + have hne : c.state ≠ (loopTM tmBody tmTest).qhalt := by + rw [hstate]; nofun + simp only [TM.step, ↓reduceIte, hstate, loopTM, hread_ne] + refine ⟨_, rfl, rfl, ?_, ?_⟩ + · simp only [Tape.writeAndMove, Tape.move] + rw [toΓ_readBackWrite_of_ne_start hread_ne] + simp only [Tape.write, Tape.read]; split + · omega + · simp + · simp only [Tape.writeAndMove, Tape.move_cells] + rw [toΓ_readBackWrite_of_ne_start hread_ne] + simp only [Tape.write, Tape.read]; split + · rfl + · exact Function.update_eq_self _ _ + +private theorem loop_rewind_step_base (tmBody tmTest : TM n) + (c : Cfg n (LoopQ tmBody.Q tmTest.Q)) + (hstate : c.state = Sum.inr (Sum.inl LoopPhase.rewindOut)) + (hread : c.output.read = Γ.start) + (_ : c.output.cells 0 = Γ.start) + (hnostart : ∀ j, j ≥ 1 → c.output.cells j ≠ Γ.start) : + ∃ c', (loopTM tmBody tmTest).step c = some c' ∧ + c'.state = Sum.inr (Sum.inl LoopPhase.check) ∧ + c'.output.head = 1 ∧ + c'.output.cells = c.output.cells := by + have hne : c.state ≠ (loopTM tmBody tmTest).qhalt := by + rw [hstate]; nofun + have hhead : c.output.head = 0 := by + by_contra hne + have hge : c.output.head ≥ 1 := by omega + exact hnostart c.output.head hge (by simp only [Tape.read] at hread; exact hread) + simp only [TM.step, ↓reduceIte, hstate, loopTM, hread] + refine ⟨_, rfl, rfl, ?_, ?_⟩ + · simp [Tape.writeAndMove, Tape.move, Tape.write, hhead] + · simp [Tape.writeAndMove, Tape.move_cells, Tape.write, hhead] + +/-- From the `rewindOut` phase with the output head at position `p`, `loopTM` +reaches the `check` phase in `p + 1` steps with the output head at cell 1 and +the output cells unchanged. -/ +theorem loopTM_rewind_loop (tmBody tmTest : TM n) : + ∀ (p : ℕ) (c : Cfg n (LoopQ tmBody.Q tmTest.Q)), + c.state = Sum.inr (Sum.inl LoopPhase.rewindOut) → + c.output.cells 0 = Γ.start → + (∀ j, j ≥ 1 → c.output.cells j ≠ Γ.start) → + c.output.head = p → + ∃ c_check, + (loopTM tmBody tmTest).reachesIn (p + 1) c c_check ∧ + c_check.state = Sum.inr (Sum.inl LoopPhase.check) ∧ + c_check.output.head = 1 ∧ + c_check.output.cells = c.output.cells := + exists_reachesIn_of_rewindStep_output (loopTM tmBody tmTest) + (fun c hst hread hc0 hns => loop_rewind_step_left tmBody tmTest c hst hread hc0 hns) + (fun c hst hread hc0 hns => loop_rewind_step_base tmBody tmTest c hst hread hc0 hns) + +-- ════════════════════════════════════════════════════════════════════════ +-- Check step: halt (output = 1) or continue (output ≠ 1) +-- ════════════════════════════════════════════════════════════════════════ + +/-- In the `check` phase, if output cell 1 holds `1` then one `loopTM` step +enters the `done` phase, leaving the output cells unchanged. -/ +theorem loopTM_check_halt (tmBody tmTest : TM n) + (c : Cfg n (LoopQ tmBody.Q tmTest.Q)) + (hstate : c.state = Sum.inr (Sum.inl LoopPhase.check)) + (hhead : c.output.head = 1) + (hcell1 : c.output.cells 1 = Γ.one) : + ∃ c', (loopTM tmBody tmTest).step c = some c' ∧ + c'.state = Sum.inr (Sum.inl LoopPhase.done) ∧ + c'.output.cells = c.output.cells := by + have hne : c.state ≠ (loopTM tmBody tmTest).qhalt := by + rw [hstate]; nofun + have hread : c.output.read = Γ.one := by simp [Tape.read, hhead, hcell1] + simp only [TM.step, ↓reduceIte, hstate, loopTM, hread] + refine ⟨_, rfl, rfl, ?_⟩ + show (c.output.writeAndMove (readBackWrite Γ.one).toΓ (idleDir Γ.one)).cells = c.output.cells + simp only [readBackWrite, Γw.toΓ, idleDir, Tape.writeAndMove, Tape.move_cells] + simp only [Tape.write]; split + · omega + · dsimp only []; rw [hhead, ← hcell1]; exact Function.update_eq_self _ _ + +/-- In the `check` phase, if output cell 1 does not hold `1` then one `loopTM` +step restarts `tmBody` (state `Sum.inl tmBody.qstart`), leaving the output +cells unchanged. -/ +theorem loopTM_check_continue (tmBody tmTest : TM n) + (c : Cfg n (LoopQ tmBody.Q tmTest.Q)) + (hstate : c.state = Sum.inr (Sum.inl LoopPhase.check)) + (hhead : c.output.head = 1) + (hcell1 : c.output.cells 1 ≠ Γ.one) + (hnostart : ∀ j, j ≥ 1 → c.output.cells j ≠ Γ.start) : + ∃ c', (loopTM tmBody tmTest).step c = some c' ∧ + c'.state = Sum.inl tmBody.qstart ∧ + c'.output.cells = c.output.cells := by + have hne : c.state ≠ (loopTM tmBody tmTest).qhalt := by + rw [hstate]; nofun + have hread_ne : c.output.read ≠ Γ.one := by + simp [Tape.read, hhead]; exact hcell1 + have hread_ne_start : c.output.read ≠ Γ.start := by + simp only [Tape.read, hhead]; exact hnostart 1 (by omega) + simp only [TM.step, ↓reduceIte, hstate, loopTM, hread_ne] + refine ⟨_, rfl, rfl, ?_⟩ + simp only [Tape.writeAndMove, Tape.move_cells] + rw [toΓ_readBackWrite_of_ne_start hread_ne_start] + simp only [Tape.write, Tape.read]; split + · omega + · rw [hhead]; exact Function.update_eq_self _ _ + +-- ════════════════════════════════════════════════════════════════════════ +-- Halting +-- ════════════════════════════════════════════════════════════════════════ + +/-- A `loopTM` configuration in the `done` phase is halted. -/ +theorem loopTM_halted_done (tmBody tmTest : TM n) + (c : Cfg n (LoopQ tmBody.Q tmTest.Q)) + (h : c.state = Sum.inr (Sum.inl LoopPhase.done)) : + (loopTM tmBody tmTest).halted c := h + +-- ════════════════════════════════════════════════════════════════════════ +-- One full iteration ending in halt +-- ════════════════════════════════════════════════════════════════════════ + +/-- One full `loopTM` iteration ending in halt: if `tmBody` halts in `t_body` +steps, `tmTest` then halts in `t_test` steps, and the resulting output tape +(head at `p`, cell 1 = `1`, `▷` only at cell 0) passes the check, then `loopTM` +halts from the body-wrapped start in `t_body + 1 + t_test + 1 + (p + 1) + 1` +steps with output cell 1 equal to `1`. -/ +theorem loopTM_iteration_halt (tmBody tmTest : TM n) + {t_body : ℕ} {c_body_start c_body_end : Cfg n tmBody.Q} + (hreach_body : tmBody.reachesIn t_body c_body_start c_body_end) + (hhalt_body : c_body_end.state = tmBody.qhalt) + {t_test : ℕ} {c_test_end : Cfg n tmTest.Q} + (hreach_test : tmTest.reachesIn t_test + { state := tmTest.qstart, + input := transitionInput c_body_end.input, + work := fun i => transitionTape (c_body_end.work i), + output := transitionTape c_body_end.output } + c_test_end) + (hhalt_test : c_test_end.state = tmTest.qhalt) + {p : ℕ} + (hcell0 : (transitionTape c_test_end.output).cells 0 = Γ.start) + (hnostart : ∀ j, j ≥ 1 → + (transitionTape c_test_end.output).cells j ≠ Γ.start) + (hhead : (transitionTape c_test_end.output).head = p) + (hcell1 : (transitionTape c_test_end.output).cells 1 = Γ.one) : + ∃ c_final, + (loopTM tmBody tmTest).reachesIn (t_body + 1 + t_test + 1 + (p + 1) + 1) + (loopBodyWrap tmBody tmTest c_body_start) c_final ∧ + (loopTM tmBody tmTest).halted c_final ∧ + c_final.output.cells 1 = Γ.one := by + -- Phase 1: body simulation + have hp1 := loopTM_body_simulation tmBody tmTest hreach_body + -- Body → test transition (1 step) + have h_tr1 : (loopTM tmBody tmTest).reachesIn 1 + (loopBodyWrap tmBody tmTest c_body_end) (loopTestWrap tmBody tmTest _) := + .step (loopTM_body_to_test tmBody tmTest hhalt_body) .zero + -- Phase 2: test simulation + have hp2 := loopTM_test_simulation tmBody tmTest hreach_test + -- Test → rewind transition (1 step) + have h_tr2 : (loopTM tmBody tmTest).reachesIn 1 + (loopTestWrap tmBody tmTest c_test_end) + { state := Sum.inr (Sum.inl LoopPhase.rewindOut), + input := transitionInput c_test_end.input, + work := fun i => transitionTape (c_test_end.work i), + output := transitionTape c_test_end.output } := + .step (loopTM_test_to_rewind tmBody tmTest hhalt_test) .zero + -- Rewind (p + 1 steps) + obtain ⟨c_check, hreach_rw, hst_check, hh_check, hcells_check⟩ := + loopTM_rewind_loop tmBody tmTest p + { state := Sum.inr (Sum.inl LoopPhase.rewindOut), + input := transitionInput c_test_end.input, + work := fun i => transitionTape (c_test_end.work i), + output := transitionTape c_test_end.output } + rfl hcell0 hnostart hhead + -- Check: output at cell 1 is Γ.one + obtain ⟨c_done, hstep_done, hst_done, hcells_done⟩ := + loopTM_check_halt tmBody tmTest c_check hst_check hh_check + (by rw [hcells_check]; exact hcell1) + -- Combine all phases + have h_check : (loopTM tmBody tmTest).reachesIn 1 c_check c_done := + .step hstep_done .zero + have h_all := reachesIn_trans _ (reachesIn_trans _ (reachesIn_trans _ + (reachesIn_trans _ (reachesIn_trans _ hp1 h_tr1) hp2) h_tr2) hreach_rw) h_check + refine ⟨c_done, ?_, hst_done, ?_⟩ + · exact h_all + · rw [hcells_done, hcells_check]; exact hcell1 + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/Internal/Retarget.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/Internal/Retarget.lean new file mode 100644 index 0000000000..03d60e625a --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/Internal/Retarget.lean @@ -0,0 +1,714 @@ +/- +Copyright (c) 2025 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.Counter +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.Internal + +/-! +# retargetInput simulation — proof internals + +This file contains the simulation lemmas for `retargetInput M`, showing +that `retargetInput M` on a configuration where work tape `k` holds the +"virtual input" `z` faithfully simulates `M` on input `z`. + +## Key definitions and lemmas + +- `retargetWrap` — embed a config of `M : TM k` into a config of + `retargetInput M : TM (k+1)`, given a choice of real-input tape. +- `retargetInput_step_commute` — one step of `M` corresponds to one step + of `retargetInput M` under the wrap (assuming a structural invariant on + `c.input`: cells ≥ 1 are never `Γ.start`). +- `retargetInput_reachesIn_of_reachesIn` — multi-step simulation lifting. +- `retargetInput_reachesIn_halted_of_decidesInTime` — user-facing: if `M` decides `L` in + time `T`, then `retargetInput M` started with `z` on work tape `k` + reaches a halting configuration within `T(|z|)` steps with the correct + output. + +## The `startedCfg` family + +For phase-composed machines, the interesting entry point is not `initCfg` +but the configuration reached after `M`'s forced first move off the `▷` +cells. `startedCfg M z hne` names that configuration (well-defined once +`qstart ≠ qhalt`, which `qstart_ne_qhalt_of_decidesInTime` guarantees for +any deciding machine), and the `startedCfg_*` lemmas pin down each field: +state, work, and output are input-independent, while every tape sits one +cell right of `▷`. `retargetInput_decidesVirtual_started` restates the +user-facing simulation from this post-start configuration. + +## Hoare liftings + +- `retargetInput_hoareTime` — a `HoareTime` triple for `M` lifts to a + triple for `retargetInput M` in which the precondition reads `M`'s input + off work tape `k` and the postcondition existentially recovers `M`'s + final tapes. +- `retargetInput_copyInputToWorkTM_started_hoareTime`, + `retargetInput_inputLengthPlusOneCounterTM_started_hoareTime`, + `retargetInput_inputLengthPlusOneCounterTM_started_tracksInput_hoareTime` + — virtual-input instantiations of the corresponding subroutine triples. + +## The structural invariant + +Because `retargetInput M` writes back the read symbol on work tape `k` +(to preserve cells), the simulation only goes through cleanly when the +current write is a no-op. This requires: + + head = 0 OR read ≠ Γ.start + +The second disjunct is equivalent to "cells at positions ≥ 1 never +contain `Γ.start`". This is a *structural* invariant of any DTM run +(since `δ` writes only `Γw`, which excludes `Γ.start`, and writes at +cell 0 are no-ops) — captured by `Tape.StartInvariant` below and preserved +across `TM.step` by `Tape.StartInvariant.step`. +-/ + + +@[expose] public section + +namespace Complexity + +variable {k : ℕ} + +namespace TM + +-- ════════════════════════════════════════════════════════════════════════ +-- Config wrapping +-- ════════════════════════════════════════════════════════════════════════ + +/-- Embed a `Cfg k M.Q` into `Cfg (k+1) (retargetInput M).Q` by: + - putting `realInput` on the real input tape (ignored by the machine), + - putting `c.work i` on work tape `i` for `i < k`, + - putting `c.input` on work tape `k` (the virtual input). + State and output are shared. -/ +def retargetWrap (M : TM k) (realInput : Tape) (c : Cfg k M.Q) : + Cfg (k + 1) (retargetInput M).Q where + state := c.state + input := realInput + work := fun i => + if h : i.val < k then c.work ⟨i.val, h⟩ + else c.input + output := c.output + +/-- The state of a wrapped configuration is the state of the wrapped `M`-configuration. -/ +@[simp] theorem retargetWrap_state (M : TM k) (realInput : Tape) (c : Cfg k M.Q) : + (retargetWrap M realInput c).state = c.state := rfl + +/-- The output tape of a wrapped configuration is the output tape of the + wrapped `M`-configuration. -/ +@[simp] theorem retargetWrap_output (M : TM k) (realInput : Tape) (c : Cfg k M.Q) : + (retargetWrap M realInput c).output = c.output := rfl + +/-- The (ignored) real input tape of a wrapped configuration is exactly the + supplied `realInput`. -/ +@[simp] theorem retargetWrap_input (M : TM k) (realInput : Tape) (c : Cfg k M.Q) : + (retargetWrap M realInput c).input = realInput := rfl + +/-- For an index `i < k`, work tape `i` of a wrapped configuration is work + tape `i` of the wrapped `M`-configuration. -/ +theorem retargetWrap_work_lt (M : TM k) (realInput : Tape) (c : Cfg k M.Q) + (i : Fin (k + 1)) (h : i.val < k) : + (retargetWrap M realInput c).work i = c.work ⟨i.val, h⟩ := by + simp [retargetWrap, h] + +/-- The last work tape (index `k`) of a wrapped configuration holds the + wrapped `M`-configuration's input tape — the virtual input. -/ +theorem retargetWrap_work_last (M : TM k) (realInput : Tape) (c : Cfg k M.Q) : + (retargetWrap M realInput c).work ⟨k, by omega⟩ = c.input := by + simp [retargetWrap] + +-- ════════════════════════════════════════════════════════════════════════ +-- Core step commute +-- ════════════════════════════════════════════════════════════════════════ + +/-- Auxiliary: `writeAndMove` with `readBackWrite` of the current read + symbol equals `move` when the tape has either head = 0 or read ≠ start. -/ +private theorem tape_writeBack_eq_move (t : Tape) (d : Dir3) + (h : t.head = 0 ∨ t.read ≠ Γ.start) : + t.writeAndMove (readBackWrite t.read).toΓ d = t.move d := by + show (t.write (readBackWrite t.read).toΓ).move d = t.move d + have hwrite : t.write (readBackWrite t.read).toΓ = t := by + simp only [Tape.write] + rcases h with hh | hne + · simp [hh] + · split + · rfl + · rw [toΓ_readBackWrite_of_ne_start hne] + simp [Tape.read, Function.update_eq_self] + rw [hwrite] + +/-- One step of `M` corresponds to one step of `retargetInput M` through + `retargetWrap`. The real-input tape drifts by `move (idleDir · )`. + Requires the structural invariant on `c.input` (cells ≥ 1 ≠ start). -/ +theorem retargetInput_step_commute (M : TM k) {c c' : Cfg k M.Q} + (hstep : M.step c = some c') (realInput : Tape) + (hinp : Tape.StartInvariant c.input) : + (retargetInput M).step (retargetWrap M realInput c) = + some (retargetWrap M (realInput.move (idleDir realInput.read)) c') := by + have hne : c.state ≠ M.qhalt := state_ne_qhalt_of_step hstep + -- Extract c' from M.step c. + simp only [step, hne, ↓reduceIte, Option.some.injEq] at hstep + subst hstep + -- Key fact 1: wHeads ⟨k, _⟩ = c.input.read. + have hwHead_last : ((retargetWrap M realInput c).work ⟨k, by omega⟩).read + = c.input.read := by + show (if h : k < k then c.work ⟨k, h⟩ else c.input).read = c.input.read + simp + -- Key fact 2: fun i : Fin k => wHeads ⟨i.val, _⟩ equals fun i => (c.work i).read. + have hinner : (fun i : Fin k => + ((retargetWrap M realInput c).work ⟨i.val, by omega⟩).read) + = (fun i => (c.work i).read) := by + funext i + show (if h : i.val < k then c.work ⟨i.val, h⟩ else c.input).read = (c.work i).read + rw [dif_pos i.isLt] + -- Unfold step on the LHS. `split` reduces the halting ite (the stored + -- decidability instance blocks `simp`/`if_neg` post-v4.30). + simp only [step, show (retargetWrap M realInput c).state = c.state from rfl, + show (retargetInput M).qhalt = M.qhalt from rfl, + retargetWrap_input, retargetWrap_output] + split + · exact absurd ‹_› hne + simp only [Option.some.injEq] + -- Unfold retargetInput's δ. + dsimp only [retargetInput] + rw [hwHead_last, hinner] + -- Now show the Cfg equality field-by-field. + refine Cfg.mk.injEq _ _ _ _ _ _ _ _ |>.mpr ⟨rfl, rfl, ?_, rfl⟩ + funext i + by_cases hik : i.val < k + · -- i.val < k: matches M's work tape i. + -- LHS: ((retargetWrap...).work i).writeAndMove (M.workWrites ⟨i.val, _⟩).toΓ + -- (M.workDirs ⟨i.val, _⟩) + -- RHS: (retargetWrap... c').work i where c'.work ⟨i.val, _⟩ is the updated tape. + rw [retargetWrap_work_lt _ _ _ _ hik] + show (_ : Tape).writeAndMove _ _ = (if h : i.val < k then _ else _) + rw [dif_pos hik, dif_pos hik, dif_pos hik] + · -- i.val = k: virtual input case. + have hik_eq : i.val = k := by have := i.isLt; omega + have hwork_k : (retargetWrap M realInput c).work i = c.input := by + show (if h : i.val < k then c.work ⟨i.val, h⟩ else c.input) = c.input + rw [dif_neg hik] + have hcond : c.input.head = 0 ∨ c.input.read ≠ Γ.start := by + by_cases hh : c.input.head = 0 + · left; exact hh + · right + show c.input.cells c.input.head ≠ Γ.start + exact hinp.2 c.input.head (by omega) + -- Rewrite LHS via hwork_k, then use tape_writeBack_eq_move. + rw [hwork_k] + show _ = (if h : i.val < k then _ else _) + rw [dif_neg hik, dif_neg hik, dif_neg hik] + exact tape_writeBack_eq_move c.input _ hcond + +-- ════════════════════════════════════════════════════════════════════════ +-- Multi-step simulation +-- ════════════════════════════════════════════════════════════════════════ + +/-- Multi-step version: if `M` reaches `c'` in `t` steps, then + `retargetInput M` reaches *some* config (differing from `retargetWrap` + only in the real-input tape drift) in the same `t` steps. -/ +theorem retargetInput_reachesIn_of_reachesIn (M : TM k) + {c c' : Cfg k M.Q} {t : ℕ} (hreach : M.reachesIn t c c') + (hinp : Tape.StartInvariant c.input) (hwork : ∀ i, Tape.StartInvariant (c.work i)) + (hout : Tape.StartInvariant c.output) (realInput : Tape) : + ∃ finalReal : Tape, + (retargetInput M).reachesIn t + (retargetWrap M realInput c) + (retargetWrap M finalReal c') := by + induction hreach generalizing realInput with + | zero => exact ⟨realInput, .zero⟩ + | @step c₀ c_mid _ _ hstep hrest ih => + obtain ⟨hinp', hwork', hout'⟩ := + Tape.StartInvariant.step M hstep hinp hwork hout + have hcommute := retargetInput_step_commute M hstep realInput hinp + obtain ⟨finalReal', hreach'⟩ := ih hinp' hwork' hout' + (realInput.move (idleDir realInput.read)) + exact ⟨finalReal', .step hcommute hreach'⟩ + +-- ════════════════════════════════════════════════════════════════════════ +-- User-facing: retargetInput M decides on a virtual input +-- ════════════════════════════════════════════════════════════════════════ + +/-- Initial configuration for `retargetInput M` with virtual input `z` on + work tape `k` and an arbitrary `realInput` on the (ignored) real + input tape. Work tapes `0..k-1` are empty; output is empty. -/ +def retargetInitCfg (M : TM k) (z : List Bool) (realInput : Tape) : + Cfg (k + 1) (retargetInput M).Q where + state := M.qstart + input := realInput + work := fun i => + if i.val < k then Tape.init [] + else Tape.init (z.map Γ.ofBool) + output := Tape.init [] + +/-- `retargetInitCfg M z realInput` is exactly the `retargetWrap` of `M`'s + ordinary initial configuration on input `z`. -/ +theorem retargetInitCfg_eq_retargetWrap (M : TM k) (z : List Bool) (realInput : Tape) : + retargetInitCfg M z realInput = retargetWrap M realInput (M.initCfg z) := by + simp only [retargetInitCfg, retargetWrap] + refine Cfg.mk.injEq _ _ _ _ _ _ _ _ |>.mpr ⟨rfl, rfl, ?_, rfl⟩ + funext i + by_cases hik : i.val < k + · simp only [hik, ↓reduceIte, ↓reduceDIte] + · simp only [hik, ↓reduceIte, ↓reduceDIte] + +/-- **User-facing simulation**: if `M` decides `L` in time `T`, then + `retargetInput M` started with `z` on work tape `k` reaches a halted + configuration within `T(|z|)` steps whose output cell 1 indicates + membership of `z` in `L`. -/ +theorem retargetInput_reachesIn_halted_of_decidesInTime (M : TM k) {L : Language} {T : ℕ → ℕ} + (hM : M.DecidesInTime L T) (z : List Bool) (realInput : Tape) : + ∃ c' t, t ≤ T z.length ∧ + (retargetInput M).reachesIn t (retargetInitCfg M z realInput) c' ∧ + (retargetInput M).halted c' ∧ + (z ∈ L → c'.output.cells 1 = Γ.one) ∧ + (z ∉ L → c'.output.cells 1 = Γ.zero) := by + obtain ⟨c_M, t, ht, hreach, hhalt, hyes, hno⟩ := hM z + have hinp : Tape.StartInvariant (M.initCfg z).input := by + exact Tape.StartInvariant.init_ofBool z + have hwork : ∀ i, Tape.StartInvariant ((M.initCfg z).work i) := fun i => by + exact Tape.StartInvariant.init_nil + have hout : Tape.StartInvariant (M.initCfg z).output := by + exact Tape.StartInvariant.init_nil + obtain ⟨finalReal, hreachSim⟩ := + retargetInput_reachesIn_of_reachesIn M hreach hinp hwork hout realInput + refine ⟨retargetWrap M finalReal c_M, t, ht, ?_, ?_, ?_, ?_⟩ + · rw [retargetInitCfg_eq_retargetWrap]; exact hreachSim + · show (retargetWrap M finalReal c_M).state = (retargetInput M).qhalt + show c_M.state = M.qhalt + exact hhalt + · intro hz + show (retargetWrap M finalReal c_M).output.cells 1 = Γ.one + exact hyes hz + · intro hz + show (retargetWrap M finalReal c_M).output.cells 1 = Γ.zero + exact hno hz + +/-- A verifier that decides a language cannot have `qstart = qhalt`, because + the initial output cell is blank, not an accepting or rejecting bit. -/ +theorem qstart_ne_qhalt_of_decidesInTime (M : TM k) {L : Language} {T : ℕ → ℕ} + (hM : M.DecidesInTime L T) : M.qstart ≠ M.qhalt := by + intro hstart + obtain ⟨c', t, _ht, hreach, _hhalt, hyes, hno⟩ := hM [] + have hinit_halt : M.halted (M.initCfg []) := by + simpa [TM.halted, Cfg.isHalted, Cfg.init] using hstart + have ht0 : t = 0 := by + have hle := M.reachesIn_le_halt hreach + (TM.reachesIn.zero : M.reachesIn 0 (M.initCfg []) (M.initCfg [])) + hinit_halt + omega + subst ht0 + cases hreach + by_cases hmem : ([] : List Bool) ∈ L + · have hcell := hyes hmem + simp [Tape.init] at hcell + · have hcell := hno hmem + simp [Tape.init] at hcell + +/-- The verifier configuration after its forced first move off the start cells. + For a deciding machine this is well-defined by `qstart_ne_qhalt_of_decidesInTime`. -/ +noncomputable def startedCfg (M : TM k) (z : List Bool) (hne : M.qstart ≠ M.qhalt) : + Cfg k M.Q := + (M.step (M.initCfg z)).get (by + simp [TM.step, hne]) + +/-- `startedCfg` is the result of one deterministic verifier step from + `M.initCfg z`. -/ +theorem step_initCfg_startedCfg (M : TM k) (z : List Bool) + (hne : M.qstart ≠ M.qhalt) : + M.step (M.initCfg z) = some (startedCfg M z hne) := by + simp [startedCfg, TM.step, hne] + +/-- The verifier state immediately after the forced first move off `▷` is + independent of the concrete input string: the first step reads only the + start symbols on every tape. -/ +theorem startedCfg_state_eq (M : TM k) (z₁ z₂ : List Bool) + (hne : M.qstart ≠ M.qhalt) : + (startedCfg M z₁ hne).state = (startedCfg M z₂ hne).state := by + simp [startedCfg, TM.step, hne, Tape.read, Tape.init] + +/-- The verifier work tapes immediately after the forced first move off `▷` + are independent of the concrete input string. -/ +theorem startedCfg_work_eq (M : TM k) (z₁ z₂ : List Bool) + (hne : M.qstart ≠ M.qhalt) : + (startedCfg M z₁ hne).work = (startedCfg M z₂ hne).work := by + funext i + simp [startedCfg, TM.step, hne, Tape.read, Tape.init] + +/-- The verifier output tape immediately after the forced first move off `▷` + is independent of the concrete input string. -/ +theorem startedCfg_output_eq (M : TM k) (z₁ z₂ : List Bool) + (hne : M.qstart ≠ M.qhalt) : + (startedCfg M z₁ hne).output = (startedCfg M z₂ hne).output := by + simp [startedCfg, TM.step, hne, Tape.read, Tape.init] + +/-- The verifier input tape immediately after the forced first move off `▷` + is the ordinary initialized input moved right to cell 1. -/ +theorem startedCfg_input_eq (M : TM k) (z : List Bool) + (hne : M.qstart ≠ M.qhalt) : + (startedCfg M z hne).input = (Tape.init (z.map Γ.ofBool)).move Dir3.right := by + have hinDir : + (M.δ M.qstart Γ.start (fun _ : Fin k => Γ.start) Γ.start).2.2.2.1 = + Dir3.right := + (M.δ_right_of_start M.qstart Γ.start (fun _ : Fin k => Γ.start) Γ.start).1 rfl + change (M.6 M.qstart Γ.start (fun _ : Fin k => Γ.start) Γ.start).2.2.2.1 = + Dir3.right at hinDir + simp [startedCfg, TM.step, hne, Tape.read, Tape.init] + rw [hinDir] + +/-- Each verifier work tape immediately after the forced first move off `▷` + is a blank initialized tape moved right to cell 1. -/ +theorem startedCfg_work_eq_init_move_right (M : TM k) (z : List Bool) + (hne : M.qstart ≠ M.qhalt) (i : Fin k) : + (startedCfg M z hne).work i = (Tape.init []).move Dir3.right := by + have hworkDir : + (M.δ M.qstart Γ.start (fun _ : Fin k => Γ.start) Γ.start).2.2.2.2.1 i = + Dir3.right := + (M.δ_right_of_start M.qstart Γ.start (fun _ : Fin k => Γ.start) Γ.start).2.1 i rfl + change (M.6 M.qstart Γ.start (fun _ : Fin k => Γ.start) Γ.start).2.2.2.2.1 i = + Dir3.right at hworkDir + simp [startedCfg, TM.step, hne, Tape.read, Tape.init, Tape.writeAndMove, Tape.write] + rw [hworkDir] + +/-- The verifier output tape immediately after the forced first move off `▷` + is a blank initialized tape moved right to cell 1. -/ +theorem startedCfg_output_eq_init_move_right (M : TM k) (z : List Bool) + (hne : M.qstart ≠ M.qhalt) : + (startedCfg M z hne).output = (Tape.init []).move Dir3.right := by + have houtDir : + (M.δ M.qstart Γ.start (fun _ : Fin k => Γ.start) Γ.start).2.2.2.2.2 = + Dir3.right := + (M.δ_right_of_start M.qstart Γ.start (fun _ : Fin k => Γ.start) Γ.start).2.2 rfl + change (M.6 M.qstart Γ.start (fun _ : Fin k => Γ.start) Γ.start).2.2.2.2.2 = + Dir3.right at houtDir + simp [startedCfg, TM.step, hne, Tape.read, Tape.init, Tape.writeAndMove, Tape.write] + rw [houtDir] + +/-- User-facing simulation from the post-start verifier configuration. + + If `M` decides `L`, then `retargetInput M` can start from `retargetWrap` + of the verifier state immediately after `M`'s first step on `z`, and it + reaches the same accepting/rejecting output. This is the form needed by + phase-composed machines whose earlier phases have already moved every + tape off `▷`. -/ +theorem retargetInput_decidesVirtual_started (M : TM k) {L : Language} {T : ℕ → ℕ} + (hM : M.DecidesInTime L T) (z : List Bool) (realInput : Tape) : + ∃ c' t, t + 1 ≤ T z.length ∧ + (retargetInput M).reachesIn t + (retargetWrap M realInput (startedCfg M z (qstart_ne_qhalt_of_decidesInTime M hM))) c' ∧ + (retargetInput M).halted c' ∧ + (z ∈ L → c'.output.cells 1 = Γ.one) ∧ + (z ∉ L → c'.output.cells 1 = Γ.zero) := by + let hne := qstart_ne_qhalt_of_decidesInTime M hM + obtain ⟨c_M, t, ht, hreach, hhalt, hyes, hno⟩ := hM z + have ht_ne : t ≠ 0 := by + intro ht0 + subst ht0 + cases hreach + exact hne hhalt + obtain ⟨t', ht'⟩ := Nat.exists_eq_succ_of_ne_zero ht_ne + subst ht' + obtain ⟨c_mid, hstep, hrest⟩ : ∃ c_mid, + M.step (M.initCfg z) = some c_mid ∧ M.reachesIn t' c_mid c_M := by + cases hreach with + | step hstep hrest => exact ⟨_, hstep, hrest⟩ + have hstarted : c_mid = startedCfg M z hne := by + have hs : some c_mid = some (startedCfg M z hne) := by + rw [← hstep, step_initCfg_startedCfg M z hne] + exact Option.some.inj hs + subst hstarted + have hinp : Tape.StartInvariant (startedCfg M z hne).input := by + have hinit : Tape.StartInvariant (M.initCfg z).input := Tape.StartInvariant.init_ofBool z + have hwork : ∀ i, Tape.StartInvariant ((M.initCfg z).work i) := + fun _ => Tape.StartInvariant.init_nil + have hout : Tape.StartInvariant (M.initCfg z).output := Tape.StartInvariant.init_nil + obtain ⟨hinp', _, _⟩ := + Tape.StartInvariant.step M (step_initCfg_startedCfg M z hne) hinit hwork hout + exact hinp' + have hwork : ∀ i, Tape.StartInvariant ((startedCfg M z hne).work i) := by + have hinit : Tape.StartInvariant (M.initCfg z).input := Tape.StartInvariant.init_ofBool z + have hwork : ∀ i, Tape.StartInvariant ((M.initCfg z).work i) := + fun _ => Tape.StartInvariant.init_nil + have hout : Tape.StartInvariant (M.initCfg z).output := Tape.StartInvariant.init_nil + obtain ⟨_, hwork', _⟩ := + Tape.StartInvariant.step M (step_initCfg_startedCfg M z hne) hinit hwork hout + exact hwork' + have hout : Tape.StartInvariant (startedCfg M z hne).output := by + have hinit : Tape.StartInvariant (M.initCfg z).input := Tape.StartInvariant.init_ofBool z + have hwork : ∀ i, Tape.StartInvariant ((M.initCfg z).work i) := + fun _ => Tape.StartInvariant.init_nil + have hout : Tape.StartInvariant (M.initCfg z).output := Tape.StartInvariant.init_nil + obtain ⟨_, _, hout'⟩ := + Tape.StartInvariant.step M (step_initCfg_startedCfg M z hne) hinit hwork hout + exact hout' + obtain ⟨finalReal, hreachSim⟩ := + retargetInput_reachesIn_of_reachesIn M hrest hinp hwork hout realInput + refine ⟨retargetWrap M finalReal c_M, t', by omega, hreachSim, ?_, ?_, ?_⟩ + · show (retargetWrap M finalReal c_M).state = (retargetInput M).qhalt + show c_M.state = M.qhalt + exact hhalt + · intro hz + show (retargetWrap M finalReal c_M).output.cells 1 = Γ.one + exact hyes hz + · intro hz + show (retargetWrap M finalReal c_M).output.cells 1 = Γ.zero + exact hno hz + +/-- Hoare lifting for `retargetInput`: if a deterministic TM satisfies a + Hoare triple on its ordinary input tape, then `retargetInput` satisfies + the corresponding triple when that input is supplied on the last work + tape. The real input tape is ignored. -/ +theorem retargetInput_hoareTime (M : TM k) + {pre post : TapePred k} {b : ℕ} + (hM : M.HoareTime pre post b) + (hpre_inp : ∀ inp work out, pre inp work out → Tape.StartInvariant inp) + (hpre_work : ∀ inp work out, pre inp work out → ∀ i, Tape.StartInvariant (work i)) + (hpre_out : ∀ inp work out, pre inp work out → Tape.StartInvariant out) : + (retargetInput M).HoareTime + (fun _inp work out => + pre (work ⟨k, by omega⟩) (fun i => work ⟨i.val, by omega⟩) out) + (fun _inp work out => + ∃ vin : Tape, ∃ innerWork : Fin k → Tape, + post vin innerWork out ∧ + (∀ i : Fin k, work ⟨i.val, by omega⟩ = innerWork i) ∧ + work ⟨k, by omega⟩ = vin) + b := by + intro realInput work out hpre + let vin : Tape := work ⟨k, by omega⟩ + let innerWork : Fin k → Tape := fun i => work ⟨i.val, by omega⟩ + have hpreM : pre vin innerWork out := hpre + obtain ⟨c', t, ht, hreach, hhalt, hpost⟩ := hM vin innerWork out hpreM + have hinp : Tape.StartInvariant vin := hpre_inp vin innerWork out hpreM + have hwork : ∀ i, Tape.StartInvariant (innerWork i) := hpre_work vin innerWork out hpreM + have hout : Tape.StartInvariant out := hpre_out vin innerWork out hpreM + obtain ⟨finalReal, hreachSim⟩ := + retargetInput_reachesIn_of_reachesIn M hreach hinp hwork hout realInput + let c0 : Cfg k M.Q := + { state := M.qstart, input := vin, work := innerWork, output := out } + have hworkField : (retargetWrap M realInput c0).work = work := by + funext j + by_cases hj : j.val < k + · simp [retargetWrap, c0, vin, innerWork, hj] + · have hjval : j.val = k := by + omega + have hjk : j = ⟨k, by omega⟩ := by + apply Fin.ext + simp [hjval] + simp [retargetWrap, c0, vin, innerWork, hjk] + have hstart : + retargetWrap M realInput c0 = + ({ state := (retargetInput M).qstart, input := realInput, work := work, output := out } : + Cfg (k + 1) (retargetInput M).Q) := by + refine Cfg.mk.injEq _ _ _ _ _ _ _ _ |>.mpr ⟨rfl, rfl, ?_, rfl⟩ + simpa [retargetInput] using hworkField + refine ⟨retargetWrap M finalReal c', t, ht, ?_, ?_, ?_⟩ + · rw [← hstart] + exact hreachSim + · show (retargetWrap M finalReal c').state = (retargetInput M).qhalt + simpa [retargetInput, retargetWrap] using hhalt + · refine ⟨c'.input, c'.work, hpost, ?_, ?_⟩ + · intro i + simp [retargetWrap_work_lt] + · simp [retargetWrap_work_last] + +/-- Virtual-input version of `copyInputToWorkTM_started_hoareTime`: if the +virtual input is a Boolean string at head `1` and work tape `idx` is a blank +started tape, then `retargetInput (copyInputToWorkTM idx)` copies that virtual +input onto work tape `idx` within `|x| + 1` steps. -/ +theorem retargetInput_copyInputToWorkTM_started_hoareTime (idx : Fin k) (x : List Bool) : + (retargetInput (copyInputToWorkTM idx)).HoareTime + (fun _inp work out => + work ⟨k, by omega⟩ = (Tape.init (x.map Γ.ofBool)).move Dir3.right ∧ + work ⟨idx.val, by omega⟩ = (Tape.init []).move Dir3.right ∧ + Tape.StartInvariant out ∧ + (∀ i : Fin k, i ≠ idx → Tape.StartInvariant (work ⟨i.val, by omega⟩))) + (fun _inp work _out => + (work ⟨k, by omega⟩).cells = (Tape.init (x.map Γ.ofBool)).cells ∧ + (work ⟨k, by omega⟩).head = x.length + 1 ∧ + (work ⟨idx.val, by omega⟩).HasBinaryPrefix x) + (x.length + 1) := by + have hmove_right_invariant : ∀ {t : Tape}, + Tape.StartInvariant t → Tape.StartInvariant (t.move Dir3.right) := by + intro t ht + refine ⟨?_, ?_⟩ + · simpa [Tape.move_cells] using ht.1 + · intro j hj + simpa [Tape.move_cells] using ht.2 j hj + have hcopy : + (copyInputToWorkTM idx).HoareTime + (fun inp work out => + inp = (Tape.init (x.map Γ.ofBool)).move Dir3.right ∧ + work idx = (Tape.init []).move Dir3.right ∧ + Tape.StartInvariant out ∧ + (∀ i : Fin k, i ≠ idx → Tape.StartInvariant (work i))) + (fun inp work _out => + inp.cells = (Tape.init (x.map Γ.ofBool)).cells ∧ + inp.head = x.length + 1 ∧ + (work idx).HasBinaryPrefix x) + (x.length + 1) := + (copyInputToWorkTM_started_hoareTime idx x).weaken_pre (by + intro inp work out hpre + refine ⟨hpre.1, ?_⟩ + rw [hpre.2.1] + exact Tape.init_nil_move_right_hasBinaryPrefix_nil) + have hret := retargetInput_hoareTime (M := copyInputToWorkTM idx) hcopy + (hpre_inp := by + intro _inp work out hpre + rcases hpre with ⟨hvin, _hidx, _hout, _hrest⟩ + rw [hvin] + exact hmove_right_invariant (Tape.StartInvariant.init_ofBool x)) + (hpre_work := by + intro _inp work out hpre i + rcases hpre with ⟨_hvin, hidx, _hout, hrest⟩ + by_cases hi : i = idx + · subst hi + rw [hidx] + exact hmove_right_invariant Tape.StartInvariant.init_nil + · exact hrest i hi) + (hpre_out := by + intro _inp work out hpre + exact hpre.2.2.1) + refine hret.strengthen_post ?_ + intro _inp work out hpost + rcases hpost with ⟨vin, innerWork, hinner, hmap, hvin⟩ + exact ⟨by simpa [hvin] using hinner.1, + by simpa [hvin] using hinner.2.1, + by simpa [hmap idx] using hinner.2.2⟩ + +/-- Virtual-input version of `inputLengthPlusOneCounterTM_started_hoareTime`: +if the virtual input is a started Boolean string and work tape `counterIdx` +is a started blank tape, then `retargetInput (inputLengthPlusOneCounterTM +counterIdx)` materializes a unary counter of length `|x| + 1` on that tape. -/ +theorem retargetInput_inputLengthPlusOneCounterTM_started_hoareTime + (counterIdx : Fin k) (x : List Bool) : + (retargetInput (inputLengthPlusOneCounterTM counterIdx)).HoareTime + (fun _inp work out => + work ⟨k, by omega⟩ = (Tape.init (x.map Γ.ofBool)).move Dir3.right ∧ + work ⟨counterIdx.val, by omega⟩ = (Tape.init []).move Dir3.right ∧ + Tape.StartInvariant out ∧ + (∀ i : Fin k, i ≠ counterIdx → Tape.StartInvariant (work ⟨i.val, by omega⟩))) + (fun _inp work _out => + (work ⟨counterIdx.val, by omega⟩).HasUnaryCounter (x.length + 1) ∧ + (work ⟨counterIdx.val, by omega⟩).cells 0 = Γ.start ∧ + (∀ j, j ≥ 1 → (work ⟨counterIdx.val, by omega⟩).cells j ≠ Γ.start)) + (inputLengthPlusOneCounterTime x.length) := by + have hmove_right_invariant : ∀ {t : Tape}, + Tape.StartInvariant t → Tape.StartInvariant (t.move Dir3.right) := by + intro t ht + refine ⟨?_, ?_⟩ + · simpa [Tape.move_cells] using ht.1 + · intro j hj + simpa [Tape.move_cells] using ht.2 j hj + have hcounter : + (inputLengthPlusOneCounterTM counterIdx).HoareTime + (fun inp work _out => + inp = (Tape.init (x.map Γ.ofBool)).move Dir3.right ∧ + work counterIdx = (Tape.init []).move Dir3.right ∧ + Tape.StartInvariant _out ∧ + (∀ i : Fin k, i ≠ counterIdx → Tape.StartInvariant (work i))) + (fun _inp work _out => + (work counterIdx).HasUnaryCounter (x.length + 1) ∧ + (work counterIdx).cells 0 = Γ.start ∧ + (∀ j, j ≥ 1 → (work counterIdx).cells j ≠ Γ.start)) + (inputLengthPlusOneCounterTime x.length) := + (inputLengthPlusOneCounterTM_started_hoareTime counterIdx x).weaken_pre (by + intro inp work out hpre + exact ⟨hpre.1, hpre.2.1⟩) + have hret := retargetInput_hoareTime (M := inputLengthPlusOneCounterTM counterIdx) hcounter + (hpre_inp := by + intro _inp work out hpre + rcases hpre with ⟨hvin, _hidx, _hout, _hrest⟩ + rw [hvin] + exact hmove_right_invariant (Tape.StartInvariant.init_ofBool x)) + (hpre_work := by + intro _inp work out hpre i + rcases hpre with ⟨_hvin, hidx, _hout, hrest⟩ + by_cases hi : i = counterIdx + · subst hi + rw [hidx] + exact hmove_right_invariant Tape.StartInvariant.init_nil + · exact hrest i hi) + (hpre_out := by + intro _inp work out hpre + exact hpre.2.2.1) + refine hret.strengthen_post ?_ + intro _inp work out hpost + rcases hpost with ⟨vin, innerWork, hinner, hmap, hvin⟩ + exact ⟨by simpa [hmap counterIdx] using hinner.1, + by simpa [hmap counterIdx] using hinner.2.1, + by simpa [hmap counterIdx] using hinner.2.2⟩ + +/-- Virtual-input version of +`inputLengthPlusOneCounterTM_started_tracksInput_hoareTime`: besides building +the unary counter on work tape `counterIdx`, the postcondition also records +the final cells and head of the virtual-input tape itself. -/ +theorem retargetInput_inputLengthPlusOneCounterTM_started_tracksInput_hoareTime + (counterIdx : Fin k) (x : List Bool) : + (retargetInput (inputLengthPlusOneCounterTM counterIdx)).HoareTime + (fun _inp work out => + work ⟨k, by omega⟩ = (Tape.init (x.map Γ.ofBool)).move Dir3.right ∧ + work ⟨counterIdx.val, by omega⟩ = (Tape.init []).move Dir3.right ∧ + Tape.StartInvariant out ∧ + (∀ i : Fin k, i ≠ counterIdx → Tape.StartInvariant (work ⟨i.val, by omega⟩))) + (fun _inp work _out => + (work ⟨k, by omega⟩).cells = (Tape.init (x.map Γ.ofBool)).cells ∧ + (work ⟨k, by omega⟩).head = x.length + 1 ∧ + (work ⟨counterIdx.val, by omega⟩).HasUnaryCounter (x.length + 1) ∧ + (work ⟨counterIdx.val, by omega⟩).cells 0 = Γ.start ∧ + (∀ j, j ≥ 1 → (work ⟨counterIdx.val, by omega⟩).cells j ≠ Γ.start)) + (inputLengthPlusOneCounterTime x.length) := by + have hmove_right_invariant : ∀ {t : Tape}, + Tape.StartInvariant t → Tape.StartInvariant (t.move Dir3.right) := by + intro t ht + refine ⟨?_, ?_⟩ + · simpa [Tape.move_cells] using ht.1 + · intro j hj + simpa [Tape.move_cells] using ht.2 j hj + have hcounter : + (inputLengthPlusOneCounterTM counterIdx).HoareTime + (fun inp work _out => + inp = (Tape.init (x.map Γ.ofBool)).move Dir3.right ∧ + work counterIdx = (Tape.init []).move Dir3.right ∧ + Tape.StartInvariant _out ∧ + (∀ i : Fin k, i ≠ counterIdx → Tape.StartInvariant (work i))) + (fun inp work _out => + inp.cells = (Tape.init (x.map Γ.ofBool)).cells ∧ + inp.head = x.length + 1 ∧ + (work counterIdx).HasUnaryCounter (x.length + 1) ∧ + (work counterIdx).cells 0 = Γ.start ∧ + (∀ j, j ≥ 1 → (work counterIdx).cells j ≠ Γ.start)) + (inputLengthPlusOneCounterTime x.length) := + (inputLengthPlusOneCounterTM_started_tracksInput_hoareTime counterIdx x).weaken_pre (by + intro inp work out hpre + exact ⟨hpre.1, hpre.2.1⟩) + have hret := retargetInput_hoareTime (M := inputLengthPlusOneCounterTM counterIdx) hcounter + (hpre_inp := by + intro _inp work out hpre + rcases hpre with ⟨hvin, _hidx, _hout, _hrest⟩ + rw [hvin] + exact hmove_right_invariant (Tape.StartInvariant.init_ofBool x)) + (hpre_work := by + intro _inp work out hpre i + rcases hpre with ⟨_hvin, hidx, _hout, hrest⟩ + by_cases hi : i = counterIdx + · subst hi + rw [hidx] + exact hmove_right_invariant Tape.StartInvariant.init_nil + · exact hrest i hi) + (hpre_out := by + intro _inp work out hpre + exact hpre.2.2.1) + refine hret.strengthen_post ?_ + intro _inp work out hpost + rcases hpost with ⟨vin, innerWork, hinner, hmap, hvin⟩ + exact ⟨by rw [hvin]; exact hinner.1, + by rw [hvin]; exact hinner.2.1, + by simpa [hmap counterIdx] using hinner.2.2.1, + by simpa [hmap counterIdx] using hinner.2.2.2.1, + by simpa [hmap counterIdx] using hinner.2.2.2.2⟩ + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/Internal/Scanner.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/Internal/Scanner.lean new file mode 100644 index 0000000000..1fd474373d --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/Internal/Scanner.lean @@ -0,0 +1,235 @@ +/- +Copyright (c) 2025 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.Internal.Generic +public import Std.Tactic.BVDecide.Normalize.BitVec + +/-! +# Correctness of the generic finite-state scanner + +Proofs that `TM.scannerTM` correctly implements a left-to-right fold with +`|x| + 2`-step running time. + +## Main results + +- `TM.scannerTM_reachesIn` — the scanner halts in `|x| + 2` steps on every + input `x`, writing `finalOutput (x.foldl scanStep s₀)` to output cell 1. +- `TM.scannerTM_decidesInTime` — bridge to `DecidesInTime` for any language + characterized by `x ∈ L ↔ finalOutput (x.foldl scanStep s₀) = Γw.one`. +-/ + + +public section + +namespace Complexity + +namespace TM + +variable {S : Type} [DecidableEq S] [Fintype S] + +-- ════════════════════════════════════════════════════════════════════════ +-- Step lemmas +-- ════════════════════════════════════════════════════════════════════════ + +/-- Step 1: from `.start` with both input and output heads at cell 0 on `▷`, + the machine enters `.scan s₀` with both heads advanced to cell 1. + Tape cell contents are preserved (writes at cell 0 are no-ops). -/ +private theorem scannerTM_step_start + (s₀ : S) (scanStep : S → Bool → S) (finalOutput : S → Γw) + (c : Cfg 0 (scannerTM s₀ scanStep finalOutput).Q) + (hst : c.state = ScannerPhase.start) + (hih : c.input.head = 0) (hoh : c.output.head = 0) : + ∃ c', (scannerTM s₀ scanStep finalOutput).step c = some c' ∧ + c'.state = ScannerPhase.scan s₀ ∧ + c'.input.head = 1 ∧ c'.input.cells = c.input.cells ∧ + c'.output.head = 1 ∧ c'.output.cells = c.output.cells := by + simp only [TM.step, hst, scannerTM, reduceCtorEq, ↓reduceIte] + refine ⟨_, rfl, rfl, ?_, ?_, ?_, ?_⟩ + · simp [Tape.move, hih] + · rfl + · simp [Tape.writeAndMove, Tape.move, Tape.write, hoh] + · simp [Tape.writeAndMove, Tape.move, Tape.write, hoh] + +/-- Scan step: from `.scan s` reading a non-blank input symbol, advance + input one cell, transition scan state via `scanStep s (decide iHead = Γ.one)`. + Output and work tapes are preserved. -/ +private theorem scannerTM_step_scan + (s₀ : S) (scanStep : S → Bool → S) (finalOutput : S → Γw) + (c : Cfg 0 (scannerTM s₀ scanStep finalOutput).Q) (s : S) + (hst : c.state = ScannerPhase.scan s) + (hi_nb : c.input.read ≠ Γ.blank) + (ho_head : c.output.head = 1) + (ho_cell1_nb : c.output.cells 1 ≠ Γ.start) : + ∃ c', (scannerTM s₀ scanStep finalOutput).step c = some c' ∧ + c'.state = ScannerPhase.scan (scanStep s (decide (c.input.read = Γ.one))) ∧ + c'.input.head = c.input.head + 1 ∧ c'.input.cells = c.input.cells ∧ + c'.output.head = 1 ∧ c'.output.cells = c.output.cells := by + simp only [TM.step, hst, scannerTM, reduceCtorEq, ↓reduceIte, if_neg hi_nb] + have hne : c.output.read ≠ Γ.start := by + simp only [Tape.read, ho_head]; exact ho_cell1_nb + have ho_move : idleDir c.output.read = Dir3.stay := by + simp [idleDir, hne] + refine ⟨_, rfl, rfl, ?_, rfl, ?_, ?_⟩ + · simp [Tape.move] + · simp [Tape.writeAndMove, ho_move, Tape.move, Tape.write_head, ho_head] + · exact tape_readBackWrite_preserves c.output _ (Or.inr hne) + +/-- Halt step: from `.scan s` reading blank (end of input), emit + `finalOutput s` at output cell 1 and enter `.done`. -/ +private theorem scannerTM_step_halt + (s₀ : S) (scanStep : S → Bool → S) (finalOutput : S → Γw) + (c : Cfg 0 (scannerTM s₀ scanStep finalOutput).Q) (s : S) + (hst : c.state = ScannerPhase.scan s) + (hi_blank : c.input.read = Γ.blank) + (ho_head : c.output.head = 1) + (ho_cell1_nb : c.output.cells 1 ≠ Γ.start) : + ∃ c', (scannerTM s₀ scanStep finalOutput).step c = some c' ∧ + (scannerTM s₀ scanStep finalOutput).halted c' ∧ + c'.output.cells 1 = (finalOutput s).toΓ := by + simp only [TM.step, hst, scannerTM, reduceCtorEq, ↓reduceIte, if_pos hi_blank] + refine ⟨_, rfl, rfl, ?_⟩ + have hne : c.output.read ≠ Γ.start := by + simp only [Tape.read, ho_head]; exact ho_cell1_nb + have ho_move : idleDir c.output.read = Dir3.stay := by + simp [idleDir, hne] + have h1 : (1 : ℕ) ≠ 0 := by omega + simp [Tape.writeAndMove, ho_move, Tape.move, Tape.write, ho_head, h1] + +-- ════════════════════════════════════════════════════════════════════════ +-- Scan loop +-- ════════════════════════════════════════════════════════════════════════ + +/-- **Scan invariant**: from a scan-state configuration `.scan s` with + input head at cell `k + 1` and `m` input bits remaining (`|x| = k + m`), + the scanner halts in `m + 1` steps with output cell 1 set to the fold + of `scanStep` over the remaining bits `x.drop k`, starting from `s`. -/ +private theorem scannerTM_scan + (s₀ : S) (scanStep : S → Bool → S) (finalOutput : S → Γw) + (x : List Bool) (m k : ℕ) (hlen : x.length = k + m) (s : S) + (c : Cfg 0 (scannerTM s₀ scanStep finalOutput).Q) + (hst : c.state = ScannerPhase.scan s) + (hic : c.input.cells = (Tape.init (x.map Γ.ofBool)).cells) + (hih : c.input.head = k + 1) + (hoh : c.output.head = 1) + (hoc : c.output.cells 1 ≠ Γ.start) : + ∃ c', (scannerTM s₀ scanStep finalOutput).reachesIn (m + 1) c c' ∧ + (scannerTM s₀ scanStep finalOutput).halted c' ∧ + c'.output.cells 1 = (finalOutput ((x.drop k).foldl scanStep s)).toΓ := by + induction m generalizing k s c with + | zero => + -- k = x.length: reading blank, apply halt step. + have hk : k = x.length := by omega + have hi_blank : c.input.read = Γ.blank := by + simp only [Tape.read, hih, hic] + show (Tape.init (x.map Γ.ofBool)).cells (k + 1) = Γ.blank + simp [Tape.init, hk] + obtain ⟨c', hstep, hhalt, hout⟩ := + scannerTM_step_halt s₀ scanStep finalOutput c s hst hi_blank hoh hoc + refine ⟨c', .step hstep .zero, hhalt, ?_⟩ + have : x.drop k = [] := by simp [hk] + rw [hout, this, List.foldl_nil] + | succ m ih => + -- k < x.length: read bit, scan step, IH. + have hk_lt : k < x.length := by omega + have hmap_len : (x.map Γ.ofBool).length = x.length := by simp + have hkmap : k < (x.map Γ.ofBool).length := by rw [hmap_len]; exact hk_lt + -- The symbol under the input head is `Γ.ofBool x[k]`. + have hi_read : c.input.read = Γ.ofBool (x[k]'hk_lt) := by + simp only [Tape.read, hih, hic] + show (Tape.init (x.map Γ.ofBool)).cells (k + 1) = _ + simp only [Tape.init, show k + 1 ≠ 0 from by omega, ↓reduceIte, + Nat.add_sub_cancel, List.getElem?_eq_getElem hkmap, Option.getD_some, + List.getElem_map] + have hi_nb : c.input.read ≠ Γ.blank := by + rw [hi_read]; cases x[k]'hk_lt <;> simp [Γ.ofBool] + -- Apply scan step. + obtain ⟨c₁, hstep, hst₁, hih₁, hic₁, hoh₁, hoc₁⟩ := + scannerTM_step_scan s₀ scanStep finalOutput c s hst hi_nb hoh hoc + -- Bit decoding: `decide (Γ.ofBool b = Γ.one) = b`. + have hbit : decide (c.input.read = Γ.one) = x[k]'hk_lt := by + rw [hi_read]; cases x[k]'hk_lt <;> simp [Γ.ofBool] + rw [hbit] at hst₁ + -- Apply IH at k + 1 with state `scanStep s x[k]`. + have hlen' : x.length = (k + 1) + m := by omega + have hic₁' : c₁.input.cells = (Tape.init (x.map Γ.ofBool)).cells := by + rw [hic₁]; exact hic + have hih₁' : c₁.input.head = (k + 1) + 1 := by + rw [hih₁, hih] + have hoc₁' : c₁.output.cells 1 ≠ Γ.start := by + rw [hoc₁]; exact hoc + obtain ⟨c', hreach, hhalt, hout⟩ := + ih (k + 1) hlen' (scanStep s (x[k]'hk_lt)) c₁ hst₁ hic₁' hih₁' hoh₁ hoc₁' + refine ⟨c', .step hstep hreach, hhalt, ?_⟩ + -- `(x.drop k).foldl scanStep s = (x.drop (k+1)).foldl scanStep (scanStep s x[k])`. + have hdrop : x.drop k = (x[k]'hk_lt) :: x.drop (k + 1) := + List.drop_eq_getElem_cons hk_lt + rw [hout, hdrop, List.foldl_cons] + +-- ════════════════════════════════════════════════════════════════════════ +-- Main correctness theorem +-- ════════════════════════════════════════════════════════════════════════ + +/-- **`scannerTM` halts in `|x| + 2` steps and emits the fold result.** + + Output cell 1 is set to `finalOutput (x.foldl scanStep s₀)`, and the + machine reaches a halted configuration in exactly `|x| + 2` steps on + every input. -/ +theorem scannerTM_reachesIn + (s₀ : S) (scanStep : S → Bool → S) (finalOutput : S → Γw) (x : List Bool) : + ∃ c', (scannerTM s₀ scanStep finalOutput).reachesIn (x.length + 2) + ((scannerTM s₀ scanStep finalOutput).initCfg x) c' ∧ + (scannerTM s₀ scanStep finalOutput).halted c' ∧ + c'.output.cells 1 = (finalOutput (x.foldl scanStep s₀)).toΓ := by + -- Step 1: start → scan s₀. + obtain ⟨c₁, hstep1, hst1, hih1, hic1, hoh1, hoc1⟩ := + scannerTM_step_start s₀ scanStep finalOutput + ((scannerTM s₀ scanStep finalOutput).initCfg x) rfl rfl rfl + -- Apply scan lemma from k = 0 with m = |x|. + have hic1' : c₁.input.cells = (Tape.init (x.map Γ.ofBool)).cells := hic1 + have hih1' : c₁.input.head = 0 + 1 := by simpa using hih1 + have hoc1' : c₁.output.cells 1 ≠ Γ.start := by + rw [hoc1]; simp [Tape.init] + obtain ⟨c', hreach, hhalt, hout⟩ := + scannerTM_scan s₀ scanStep finalOutput x x.length 0 (by omega) s₀ c₁ + hst1 hic1' hih1' hoh1 hoc1' + refine ⟨c', ?_, hhalt, ?_⟩ + · exact .step hstep1 hreach + · simpa using hout + +-- ════════════════════════════════════════════════════════════════════════ +-- DecidesInTime bridge +-- ════════════════════════════════════════════════════════════════════════ + +/-- **Bridge to `DecidesInTime`**. Whenever a language `L` is characterized + by a decision predicate `accept : S → Bool` applied to the fold, the + scanner with finalOutput `fun s => if accept s then .one else .zero` + decides `L` in time `n + 2`. -/ +theorem scannerTM_decidesInTime + (s₀ : S) (scanStep : S → Bool → S) (accept : S → Bool) + {L : Language} + (hL : ∀ x, x ∈ L ↔ accept (x.foldl scanStep s₀) = true) : + TM.DecidesInTime + (scannerTM s₀ scanStep (fun s => if accept s then .one else .zero)) + L (fun n => n + 2) := by + intro x + obtain ⟨c', hreach, hhalt, hout⟩ := + scannerTM_reachesIn s₀ scanStep (fun s => if accept s then .one else .zero) x + refine ⟨c', x.length + 2, le_refl _, hreach, hhalt, ?_, ?_⟩ + · intro hxL + rw [hout, if_pos ((hL x).mp hxL)]; rfl + · intro hxnL + rw [hout] + have hacc : accept (x.foldl scanStep s₀) = false := by + rcases h : accept (x.foldl scanStep s₀) with _ | _ + · rfl + · exact absurd ((hL x).mpr h) hxnL + rw [if_neg (by simp [hacc])]; rfl + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/Internal/Seq.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/Internal/Seq.lean new file mode 100644 index 0000000000..dd63f28216 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/Internal/Seq.lean @@ -0,0 +1,163 @@ +/- +Copyright (c) 2025 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.Internal.Generic + +/-! +# seqTM simulation — proof internals + +This file contains the simulation lemmas for `seqTM tm₁ tm₂`. + +## Key definitions + +- `phase1Wrap` — embed a `tm₁` config into the `seqTM` config space +- `phase2Wrap` — embed a `tm₂` config into the `seqTM` config space +- Tape transformations use the shared `transitionTape` / `transitionInput` +-/ + + +@[expose] public section + +namespace Complexity + +variable {n : ℕ} + +namespace TM + +-- ════════════════════════════════════════════════════════════════════════ +-- Config wrapping +-- ════════════════════════════════════════════════════════════════════════ + +/-- Embed a `tm₁` configuration into the `seqTM` config space (Phase 1). + State is wrapped in `Sum.inl`; tapes are shared. -/ +def phase1Wrap (tm₁ : TM n) (tm₂ : TM n) (c₁ : Cfg n tm₁.Q) : + Cfg n (SeqQ tm₁.Q tm₂.Q) where + state := Sum.inl c₁.state + input := c₁.input + work := c₁.work + output := c₁.output + +/-- Embed a `tm₂` configuration into the `seqTM` config space (Phase 2). + State is wrapped in `Sum.inr`; tapes are shared. -/ +def phase2Wrap (tm₁ : TM n) (tm₂ : TM n) (c₂ : Cfg n tm₂.Q) : + Cfg n (SeqQ tm₁.Q tm₂.Q) where + state := Sum.inr c₂.state + input := c₂.input + work := c₂.work + output := c₂.output + +-- ════════════════════════════════════════════════════════════════════════ +-- Phase 1: seqTM simulates tm₁ (via generic simulation lifting) +-- ════════════════════════════════════════════════════════════════════════ + +/-- One step of `tm₁` corresponds to one step of `seqTM` during Phase 1. -/ +theorem seqTM_phase1_step (tm₁ tm₂ : TM n) {c₁ c₁' : Cfg n tm₁.Q} + (hstep : tm₁.step c₁ = some c₁') : + (seqTM tm₁ tm₂).step (phase1Wrap tm₁ tm₂ c₁) = some (phase1Wrap tm₁ tm₂ c₁') := by + have hne := state_ne_qhalt_of_step hstep + simp only [step, hne, ↓reduceIte, Option.some.injEq] at hstep + subst hstep + show (if (phase1Wrap tm₁ tm₂ c₁).state = (seqTM tm₁ tm₂).qhalt then none + else some _) = some _ + simp only [phase1Wrap, seqTM, if_neg Sum.inl_ne_inr, if_neg hne] + +/-- Multi-step Phase 1 simulation. -/ +theorem seqTM_reachesIn_phase1Wrap (tm₁ tm₂ : TM n) {t : ℕ} + {c₁_start c₁_end : Cfg n tm₁.Q} + (hreach : tm₁.reachesIn t c₁_start c₁_end) : + (seqTM tm₁ tm₂).reachesIn t + (phase1Wrap tm₁ tm₂ c₁_start) (phase1Wrap tm₁ tm₂ c₁_end) := + reachesIn_map (tm' := seqTM tm₁ tm₂) (phase1Wrap tm₁ tm₂) + (fun _ _ => seqTM_phase1_step tm₁ tm₂) hreach + +-- ════════════════════════════════════════════════════════════════════════ +-- Transition step +-- ════════════════════════════════════════════════════════════════════════ + +/-- When `tm₁` halts, one step of `seqTM` transitions to Phase 2. -/ +theorem seqTM_transition_step (tm₁ tm₂ : TM n) {c₁ : Cfg n tm₁.Q} + (hhalt : c₁.state = tm₁.qhalt) : + (seqTM tm₁ tm₂).step (phase1Wrap tm₁ tm₂ c₁) = + some (phase2Wrap tm₁ tm₂ + { state := tm₂.qstart, + input := transitionInput c₁.input, + work := fun i => transitionTape (c₁.work i), + output := transitionTape c₁.output }) := by + show (if (phase1Wrap tm₁ tm₂ c₁).state = (seqTM tm₁ tm₂).qhalt then none + else some _) = some _ + simp only [phase1Wrap, seqTM, if_neg Sum.inl_ne_inr, hhalt, ↓reduceIte] + congr 1 + +-- ════════════════════════════════════════════════════════════════════════ +-- Phase 2: seqTM simulates tm₂ (via generic simulation lifting) +-- ════════════════════════════════════════════════════════════════════════ + +/-- One step of `tm₂` corresponds to one step of `seqTM` during Phase 2. -/ +theorem seqTM_phase2_step (tm₁ tm₂ : TM n) {c₂ c₂' : Cfg n tm₂.Q} + (hstep : tm₂.step c₂ = some c₂') : + (seqTM tm₁ tm₂).step (phase2Wrap tm₁ tm₂ c₂) = some (phase2Wrap tm₁ tm₂ c₂') := by + have hne := state_ne_qhalt_of_step hstep + simp only [step, hne, ↓reduceIte, Option.some.injEq] at hstep + subst hstep + show (if (phase2Wrap tm₁ tm₂ c₂).state = (seqTM tm₁ tm₂).qhalt then none + else some _) = some _ + simp only [phase2Wrap, seqTM, if_neg (Sum.inr_injective.ne hne), if_neg hne] + +/-- Multi-step Phase 2 simulation. -/ +theorem seqTM_reachesIn_phase2Wrap (tm₁ tm₂ : TM n) {t : ℕ} + {c₂_start c₂_end : Cfg n tm₂.Q} + (hreach : tm₂.reachesIn t c₂_start c₂_end) : + (seqTM tm₁ tm₂).reachesIn t + (phase2Wrap tm₁ tm₂ c₂_start) (phase2Wrap tm₁ tm₂ c₂_end) := + reachesIn_map (tm' := seqTM tm₁ tm₂) (phase2Wrap tm₁ tm₂) + (fun _ _ => seqTM_phase2_step tm₁ tm₂) hreach + +-- ════════════════════════════════════════════════════════════════════════ +-- Full simulation +-- ════════════════════════════════════════════════════════════════════════ + +/-- Full `seqTM` simulation combining all three phases. -/ +theorem seqTM_reachesIn_of_reachesIn (tm₁ tm₂ : TM n) + {t₁ : ℕ} {c₁_start c₁_end : Cfg n tm₁.Q} + (hreach₁ : tm₁.reachesIn t₁ c₁_start c₁_end) + (hhalt₁ : c₁_end.state = tm₁.qhalt) + {t₂ : ℕ} {c₂_end : Cfg n tm₂.Q} + (hreach₂ : tm₂.reachesIn t₂ + { state := tm₂.qstart, + input := transitionInput c₁_end.input, + work := fun i => transitionTape (c₁_end.work i), + output := transitionTape c₁_end.output } + c₂_end) : + (seqTM tm₁ tm₂).reachesIn (t₁ + 1 + t₂) + (phase1Wrap tm₁ tm₂ c₁_start) + (phase2Wrap tm₁ tm₂ c₂_end) := by + have hp1 := seqTM_reachesIn_phase1Wrap tm₁ tm₂ hreach₁ + have htrans := seqTM_transition_step tm₁ tm₂ hhalt₁ + have hp2 := seqTM_reachesIn_phase2Wrap tm₁ tm₂ hreach₂ + have h_tr : (seqTM tm₁ tm₂).reachesIn 1 + (phase1Wrap tm₁ tm₂ c₁_end) (phase2Wrap tm₁ tm₂ _) := + .step htrans .zero + exact reachesIn_trans _ (reachesIn_trans _ hp1 h_tr) hp2 + +-- ════════════════════════════════════════════════════════════════════════ +-- Halting and output in Phase 2 +-- ════════════════════════════════════════════════════════════════════════ + +/-- A Phase-2 wrapped configuration is halted in `seqTM` iff the underlying `tm₂` + configuration is halted. -/ +theorem phase2Wrap_halted_iff (tm₁ tm₂ : TM n) (c₂ : Cfg n tm₂.Q) : + (seqTM tm₁ tm₂).halted (phase2Wrap tm₁ tm₂ c₂) ↔ tm₂.halted c₂ := by + simp [phase2Wrap, seqTM, halted, Cfg.isHalted] + +/-- Wrapping a `tm₂` configuration into the `seqTM` config space leaves the output + tape unchanged. -/ +theorem phase2Wrap_output (tm₁ tm₂ : TM n) (c₂ : Cfg n tm₂.Q) : + (phase2Wrap tm₁ tm₂ c₂).output = c₂.output := rfl + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/Internal/Union.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/Internal/Union.lean new file mode 100644 index 0000000000..1f901ae5ed --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/Internal/Union.lean @@ -0,0 +1,1259 @@ +/- +Copyright (c) 2025 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Internal + +/-! +# unionTM simulation — proof internals + +This file contains the simulation lemmas needed to prove that `unionTM tm₁ tm₂` +correctly decides `L₁ ∪ L₂` when `tm₁` decides `L₁` and `tm₂` decides `L₂`. + +## Strategy + +The proof proceeds in three phases: + +1. **Phase 1 simulation**: Show that the union machine faithfully simulates + `tm₁` for `t₁` steps, with tm₁'s output redirected to the fake output + tape (work tape `n₁`). + +2. **Transition phase**: After Phase 1, the machine rewinds the fake output + to check tm₁'s result. If tm₁ accepted (cell 1 = `Γ.one`), write `Γ.one` + to the real output and halt. Otherwise, rewind the input and start Phase 2. + +3. **Phase 2 simulation**: Simulate `tm₂` using the real output tape. + +## Key definitions + +- `unionIdleTape` — the steady-state of an idle tape (head at 1, cells from `Tape.init []`) +- `unionPhase1Cfg` — embedding of a tm₁ config into the union machine's config space +-/ + + +public section + +namespace Complexity + +variable {n₁ n₂ : ℕ} + +namespace TM + +-- ════════════════════════════════════════════════════════════════════════ +-- Idle tape +-- ════════════════════════════════════════════════════════════════════════ + +/-- The steady-state tape for an idle tape during Phase 1. + After the first step (where `δ_right_of_start` forces a right move from + cell 0), idle tapes remain at head position 1 with blank cells. -/ +def unionIdleTape : Tape := + { head := 1, cells := (Tape.init ([] : List Γ)).cells } + +private theorem idleTape_read : unionIdleTape.read = Γ.blank := by + simp [unionIdleTape, Tape.read, Tape.init] + +/-- Writing blank to an idle tape at position 1 is a no-op. -/ +private theorem idleTape_write_blank : unionIdleTape.write Γ.blank = unionIdleTape := by + simp [unionIdleTape, Tape.write, Tape.init, Function.update_eq_self_iff] + +/-- An idle tape stays idle when written with blank and moved by idleDir. -/ +private theorem idleTape_step_idle : + (unionIdleTape.write Γw.blank.toΓ).move (idleDir unionIdleTape.read) = unionIdleTape := by + show (unionIdleTape.write Γ.blank).move (idleDir unionIdleTape.read) = unionIdleTape + rw [idleTape_read, idleDir, if_neg (by decide)] + simp [idleTape_write_blank, Tape.move] + +-- ════════════════════════════════════════════════════════════════════════ +-- Phase 1 config embedding +-- ════════════════════════════════════════════════════════════════════════ + +/-- Embed a tm₁ configuration into the union machine's config space. + Active tapes (input, work 0..n₁-1, fake output at n₁) come from `c`. + Idle tapes (work n₁+1..n₁+n₂ and real output) use `unionIdleTape`. -/ +def unionPhase1Cfg (tm₁ : TM n₁) (tm₂ : TM n₂) (c : Cfg n₁ tm₁.Q) : + Cfg (n₁ + 1 + n₂) (UnionQ tm₁.Q tm₂.Q) where + state := Sum.inl c.state + input := c.input + work := fun i => + if h : i.val < n₁ then c.work ⟨i.val, h⟩ + else if i.val = n₁ then c.output + else unionIdleTape + output := unionIdleTape + +-- ════════════════════════════════════════════════════════════════════════ +-- Phase 1: one-step correspondence +-- ════════════════════════════════════════════════════════════════════════ + +/-- Key computation: unionTM.δ for a Phase 1 non-halted state delegates to tm₁.δ. -/ +private theorem unionTM_delta_inl (tm₁ : TM n₁) (tm₂ : TM n₂) {q : tm₁.Q} + (hne : q ≠ tm₁.qhalt) (iHead : Γ) (wHeads : Fin (n₁ + 1 + n₂) → Γ) (oHead : Γ) : + (unionTM tm₁ tm₂).δ (Sum.inl q) iHead wHeads oHead = + let r := tm₁.δ q iHead (phase1WorkReads wHeads) (wHeads fakeOutIdx) + (Sum.inl r.1, + fun i => if h : i.val < n₁ then r.2.1 ⟨i.val, h⟩ else if i.val = n₁ then r.2.2.1 else .blank, + .blank, r.2.2.2.1, + fun i => if h : i.val < n₁ then r.2.2.2.2.1 ⟨i.val, h⟩ + else if i.val = n₁ then r.2.2.2.2.2 else idleDir (wHeads i), + idleDir oHead) := by + simp only [unionTM, if_neg hne] + +private theorem unionTM_qhalt (tm₁ : TM n₁) (tm₂ : TM n₂) : + (unionTM tm₁ tm₂).qhalt = Sum.inr (Sum.inr tm₂.qhalt) := rfl + +/-- Key computation: unionTM.δ for a Phase 2 non-halted state delegates to tm₂.δ. -/ +private theorem unionTM_delta_inr_inr (tm₁ : TM n₁) (tm₂ : TM n₂) {q : tm₂.Q} + (hne : q ≠ tm₂.qhalt) (iHead : Γ) (wHeads : Fin (n₁ + 1 + n₂) → Γ) (oHead : Γ) : + (unionTM tm₁ tm₂).δ (Sum.inr (Sum.inr q)) iHead wHeads oHead = + let r := tm₂.δ q iHead (phase2WorkReads wHeads) oHead + (Sum.inr (Sum.inr r.1), + fun i => if h : i.val ≤ n₁ then (Γw.blank : Γw) else r.2.1 ⟨i.val - (n₁ + 1), by omega⟩, + r.2.2.1, r.2.2.2.1, + fun i => if h : i.val ≤ n₁ then idleDir (wHeads i) + else r.2.2.2.2.1 ⟨i.val - (n₁ + 1), by omega⟩, + r.2.2.2.2.2) := by + simp only [unionTM, if_neg hne] + +private theorem phase1Cfg_state (tm₁ : TM n₁) (tm₂ : TM n₂) (c : Cfg n₁ tm₁.Q) : + (unionPhase1Cfg tm₁ tm₂ c).state = Sum.inl c.state := rfl + +private theorem phase1_step_corr (tm₁ : TM n₁) (tm₂ : TM n₂) + {c c' : Cfg n₁ tm₁.Q} (hstep : tm₁.step c = some c') : + (unionTM tm₁ tm₂).step (unionPhase1Cfg tm₁ tm₂ c) = some (unionPhase1Cfg tm₁ tm₂ c') := by + have hne := state_ne_qhalt_of_step hstep + -- Extract c' from tm₁.step + simp only [step, hne, ↓reduceIte, Option.some.injEq] at hstep + subst hstep + -- Unfold step for unionTM on unionPhase1Cfg + simp only [step, phase1Cfg_state, unionTM_qhalt] + simp only [reduceCtorEq, ↓reduceIte] + apply congrArg some + -- Rewrite the δ call using our helper + simp only [unionTM_delta_inl tm₁ tm₂ hne] + -- Now unfold unionPhase1Cfg on both sides and simplify + dsimp only [unionPhase1Cfg] + -- Establish that the δ calls produce the same result + have hfake_read : (if h : (n₁ : ℕ) < n₁ then c.work ⟨n₁, h⟩ + else if (n₁ : ℕ) = n₁ then c.output else unionIdleTape).read = c.output.read := by + rw [dif_neg (Nat.lt_irrefl n₁), if_pos rfl] + have hwork_reads : (phase1WorkReads fun i : Fin (n₁ + 1 + n₂) => + (if h : i.val < n₁ then c.work ⟨i.val, h⟩ + else if i.val = n₁ then c.output else unionIdleTape).read) = + fun j => (c.work j).read := by + ext ⟨j, hj⟩; simp only [phase1WorkReads]; rw [dif_pos (show j < n₁ from hj)] + -- Simplify fakeOutIdx to ⟨n₁, _⟩ and reduce the dite conditions + simp only [fakeOutIdx] at hfake_read ⊢ + -- Rewrite the work reads and fake output read + simp_rw [hwork_reads, hfake_read] + -- State and input match by rfl; work and output need case analysis + have hcfg : ∀ (a b : Cfg (n₁ + 1 + n₂) (UnionQ tm₁.Q tm₂.Q)), + a.state = b.state → a.input = b.input → a.work = b.work → a.output = b.output → a = b := by + intros a b hs hi hw ho; cases a; cases b; simp_all + apply hcfg + · rfl -- state + · rfl -- input + · -- work tapes: case split on i + funext i; dsimp only []; split + · rfl -- i < n₁: active work tape + · split + · rfl -- i = n₁: fake output + · -- i > n₁: idle tape stays idle + exact idleTape_step_idle + · -- output: idle tape stays idle + exact idleTape_step_idle + +-- ════════════════════════════════════════════════════════════════════════ +-- Phase 1 simulation +-- ════════════════════════════════════════════════════════════════════════ + +/-- Multi-step Phase 1: if tm₁ takes t steps from c to c', the union machine + takes t steps from unionPhase1Cfg c to unionPhase1Cfg c'. -/ +private theorem phase1_steps (tm₁ : TM n₁) (tm₂ : TM n₂) + {t : ℕ} {c c' : Cfg n₁ tm₁.Q} + (hreach : tm₁.reachesIn t c c') : + (unionTM tm₁ tm₂).reachesIn t (unionPhase1Cfg tm₁ tm₂ c) (unionPhase1Cfg tm₁ tm₂ c') := by + induction hreach with + | zero => exact .zero + | step hstep _ ih => exact .step (phase1_step_corr tm₁ tm₂ hstep) ih + +/-- The first step of unionTM on initCfg produces unionPhase1Cfg of tm₁'s first step result. + At step 0, all tapes are at cell 0 with ▷, so δ_right_of_start forces right moves. + After this step, idle tapes become unionIdleTape (head=1, blank cells). -/ +private theorem phase1_init_step (tm₁ : TM n₁) (tm₂ : TM n₂) (x : List Bool) + {c_mid : Cfg n₁ tm₁.Q} (hstep : tm₁.step (tm₁.initCfg x) = some c_mid) : + (unionTM tm₁ tm₂).step ((unionTM tm₁ tm₂).initCfg x) = some (unionPhase1Cfg tm₁ tm₂ c_mid) := by + have hne := state_ne_qhalt_of_step hstep + simp only [step] at hstep ⊢ + rw [if_neg hne] at hstep + simp only [Option.some.injEq] at hstep + subst hstep + -- Unfold unionTM qstart/qhalt + rw [show (unionTM tm₁ tm₂).qstart = Sum.inl tm₁.qstart from rfl, + show (unionTM tm₁ tm₂).qhalt = Sum.inr (Sum.inr tm₂.qhalt) from rfl] + simp only [reduceCtorEq, ↓reduceIte] + apply congrArg some + -- Rewrite the unionTM δ call + simp only [unionTM_delta_inl tm₁ tm₂ hne] + -- The phase1WorkReads of fixedValue function is a fixedValue function + have hwork_reads : + phase1WorkReads (fun (_ : Fin (n₁ + 1 + n₂)) => (Tape.init ([] : List Γ)).read) = + fun _ => (Tape.init ([] : List Γ)).read := by ext; rfl + simp_rw [hwork_reads] + -- Now the δ calls match; show Cfg equality field by field + have hcfg : ∀ (a b : Cfg (n₁ + 1 + n₂) (UnionQ tm₁.Q tm₂.Q)), + a.state = b.state → a.input = b.input → a.work = b.work → a.output = b.output → a = b := by + intros a b hs hi hw ho; cases a; cases b; simp_all + apply hcfg + · rfl -- state + · rfl -- input + · -- work tapes + funext i; dsimp only [unionPhase1Cfg]; split + · -- i < n₁: all tapes start at Tape.init [], write at head 0 is no-op + simp [Tape.init, Tape.read] + · split + · -- i = n₁ + simp [Tape.init, Tape.read] + · -- i > n₁: becomes unionIdleTape + simp [Tape.init, Tape.write, Tape.read, unionIdleTape, idleDir, Tape.move] + · -- output: becomes unionIdleTape (unionPhase1Cfg always has unionIdleTape as output) + simp only [unionPhase1Cfg] + simp [Tape.init, Tape.write, Tape.read, idleDir, Tape.move, unionIdleTape] + +/-- **Phase 1 simulation**: if `tm₁` reaches `c₁` from `initCfg x` in `t₁ ≥ 1` + steps, the union machine reaches the embedded config `unionPhase1Cfg c₁` + from its own `initCfg x` in the same number of steps. -/ +theorem unionTM_phase1_simulation (tm₁ : TM n₁) (tm₂ : TM n₂) (x : List Bool) + {t₁ : ℕ} {c₁ : Cfg n₁ tm₁.Q} + (hreach : tm₁.reachesIn t₁ (tm₁.initCfg x) c₁) + (ht₁ : t₁ ≥ 1) : + (unionTM tm₁ tm₂).reachesIn t₁ ((unionTM tm₁ tm₂).initCfg x) + (unionPhase1Cfg tm₁ tm₂ c₁) := by + -- Split the first step off + cases hreach with + | zero => omega -- contradicts t₁ ≥ 1 + | step hstep hrest => + exact .step (phase1_init_step tm₁ tm₂ x hstep) (phase1_steps tm₁ tm₂ hrest) + +/-- If a tape has head ≥ 1 and cells[≥1] ≠ start, idleDir gives stay (head unchanged). -/ +private theorem idleDir_stay_of_ge_one (t : Tape) + (hhead : t.head ≥ 1) (hno : ∀ i, i ≥ 1 → t.cells i ≠ Γ.start) : + idleDir t.read = Dir3.stay := by + rw [idleDir, if_neg]; rw [Tape.read]; exact hno _ hhead + +/-- Input head stays fixedValue when moved by idleDir if head ≥ 1 and cells[≥1] ≠ start. -/ +private theorem idle_move_preserves_head (t : Tape) + (hhead : t.head ≥ 1) (hno : ∀ i, i ≥ 1 → t.cells i ≠ Γ.start) : + (t.move (idleDir t.read)).head = t.head := by + rw [idleDir_stay_of_ge_one t hhead hno]; rfl + +-- ════════════════════════════════════════════════════════════════════════ +-- Union TM delta helpers for UnionPhase states +-- ════════════════════════════════════════════════════════════════════════ + +/-- Delta computation for rewindOut when fake output is not at start. -/ +private theorem unionTM_delta_rewindOut_nostart (tm₁ : TM n₁) (tm₂ : TM n₂) + (iHead : Γ) (wHeads : Fin (n₁ + 1 + n₂) → Γ) (oHead : Γ) + (hread : wHeads fakeOutIdx ≠ Γ.start) : + (unionTM tm₁ tm₂).δ (Sum.inr (Sum.inl UnionPhase.rewindOut)) iHead wHeads oHead = + ( Sum.inr (Sum.inl UnionPhase.rewindOut), + fun i => if i.val = n₁ then readBackWrite (wHeads fakeOutIdx) else .blank, + .blank, idleDir iHead, + fun i => if i.val = n₁ then Dir3.left else idleDir (wHeads i), + idleDir oHead ) := by + unfold unionTM; simp only [if_neg hread] + +/-- Delta computation for rewindOut when fake output is at start. -/ +private theorem unionTM_delta_rewindOut_start (tm₁ : TM n₁) (tm₂ : TM n₂) + (iHead : Γ) (wHeads : Fin (n₁ + 1 + n₂) → Γ) (oHead : Γ) + (hread : wHeads fakeOutIdx = Γ.start) : + (unionTM tm₁ tm₂).δ (Sum.inr (Sum.inl UnionPhase.rewindOut)) iHead wHeads oHead = + ( Sum.inr (Sum.inl UnionPhase.checkResult), + fun _ => .blank, .blank, idleDir iHead, + fun i => if i.val = n₁ then Dir3.right else idleDir (wHeads i), + idleDir oHead ) := by + unfold unionTM; simp only [if_pos hread] + +/-- Delta computation for checkResult when fake output reads Γ.one. -/ +private theorem unionTM_delta_checkResult_one (tm₁ : TM n₁) (tm₂ : TM n₂) + (iHead : Γ) (wHeads : Fin (n₁ + 1 + n₂) → Γ) (oHead : Γ) + (hread : wHeads fakeOutIdx = Γ.one) : + (unionTM tm₁ tm₂).δ (Sum.inr (Sum.inl UnionPhase.checkResult)) iHead wHeads oHead = + ( Sum.inr (Sum.inr tm₂.qhalt), + fun _ => .blank, .one, idleDir iHead, + fun i => idleDir (wHeads i), + idleDir oHead ) := by + unfold unionTM; simp only [if_pos hread] + +/-- Delta computation for checkResult when fake output does not read Γ.one. -/ +private theorem unionTM_delta_checkResult_notone (tm₁ : TM n₁) (tm₂ : TM n₂) + (iHead : Γ) (wHeads : Fin (n₁ + 1 + n₂) → Γ) (oHead : Γ) + (hread : wHeads fakeOutIdx ≠ Γ.one) : + (unionTM tm₁ tm₂).δ (Sum.inr (Sum.inl UnionPhase.checkResult)) iHead wHeads oHead = + allIdle (Sum.inr (Sum.inl UnionPhase.rewindIn)) iHead wHeads oHead := by + unfold unionTM; simp only [if_neg hread] + +/-- Delta computation for rewindIn when input is not at start. -/ +private theorem unionTM_delta_rewindIn_nostart (tm₁ : TM n₁) (tm₂ : TM n₂) + (iHead : Γ) (wHeads : Fin (n₁ + 1 + n₂) → Γ) (oHead : Γ) + (hread : iHead ≠ Γ.start) : + (unionTM tm₁ tm₂).δ (Sum.inr (Sum.inl UnionPhase.rewindIn)) iHead wHeads oHead = + ( Sum.inr (Sum.inl UnionPhase.rewindIn), + fun _ => .blank, .blank, Dir3.left, + fun i => idleDir (wHeads i), + idleDir oHead ) := by + simp only [unionTM, if_neg hread] + +/-- Delta computation for rewindIn when input is at start. -/ +private theorem unionTM_delta_rewindIn_start (tm₁ : TM n₁) (tm₂ : TM n₂) + (iHead : Γ) (wHeads : Fin (n₁ + 1 + n₂) → Γ) (oHead : Γ) + (hread : iHead = Γ.start) : + (unionTM tm₁ tm₂).δ (Sum.inr (Sum.inl UnionPhase.rewindIn)) iHead wHeads oHead = + ( Sum.inr (Sum.inl UnionPhase.setup2), + fun _ => .blank, .blank, Dir3.right, + fun i => idleDir (wHeads i), + idleDir oHead ) := by + simp only [unionTM, if_pos hread] + +/-- Delta computation for setup2. -/ +private theorem unionTM_delta_setup2 (tm₁ : TM n₁) (tm₂ : TM n₂) + (iHead : Γ) (wHeads : Fin (n₁ + 1 + n₂) → Γ) (oHead : Γ) : + (unionTM tm₁ tm₂).δ (Sum.inr (Sum.inl UnionPhase.setup2)) iHead wHeads oHead = + ( Sum.inr (Sum.inr tm₂.qstart), + fun _ => .blank, .blank, moveLeftDir iHead, + fun i => if i.val ≤ n₁ then idleDir (wHeads i) else moveLeftDir (wHeads i), + moveLeftDir oHead ) := by + unfold unionTM; rfl + +/-- Delta computation for Phase 1 halted state (transition to rewindOut). -/ +private theorem unionTM_delta_inl_qhalt (tm₁ : TM n₁) (tm₂ : TM n₂) + (iHead : Γ) (wHeads : Fin (n₁ + 1 + n₂) → Γ) (oHead : Γ) : + (unionTM tm₁ tm₂).δ (Sum.inl tm₁.qhalt) iHead wHeads oHead = + ( Sum.inr (Sum.inl UnionPhase.rewindOut), + fun i => if i.val = n₁ then readBackWrite (wHeads fakeOutIdx) else .blank, + .blank, + idleDir iHead, + fun i => idleDir (wHeads i), + idleDir oHead ) := by + simp only [unionTM, ite_true] + +-- ════════════════════════════════════════════════════════════════════════ +-- One-step lemmas for union TM +-- ════════════════════════════════════════════════════════════════════════ + +/-- The union machine is not halted in any UnionPhase state. -/ +private theorem unionTM_mid_not_halted (tm₁ : TM n₁) (tm₂ : TM n₂) (m : UnionPhase) + {c : Cfg (n₁ + 1 + n₂) (UnionQ tm₁.Q tm₂.Q)} + (hstate : c.state = Sum.inr (Sum.inl m)) : + c.state ≠ (unionTM tm₁ tm₂).qhalt := by + rw [hstate]; exact fun h => nomatch h + +/-- The union machine is not halted when in a Phase 1 state. -/ +private theorem unionTM_inl_not_halted (tm₁ : TM n₁) (tm₂ : TM n₂) (q : tm₁.Q) + {c : Cfg (n₁ + 1 + n₂) (UnionQ tm₁.Q tm₂.Q)} + (hstate : c.state = Sum.inl q) : + c.state ≠ (unionTM tm₁ tm₂).qhalt := by + rw [hstate]; exact fun h => nomatch h + +/-- Step the union machine from a rewindOut state with non-start fake output read. -/ +private theorem step_rewindOut_nostart_cfg (tm₁ : TM n₁) (tm₂ : TM n₂) + {c : Cfg (n₁ + 1 + n₂) (UnionQ tm₁.Q tm₂.Q)} + (hstate : c.state = Sum.inr (Sum.inl UnionPhase.rewindOut)) + (hread : (c.work fakeOutIdx).read ≠ Γ.start) : + (unionTM tm₁ tm₂).step c = some + { state := Sum.inr (Sum.inl UnionPhase.rewindOut), + input := c.input.move (idleDir c.input.read), + work := fun i => ((c.work i).write + ((if i.val = n₁ then readBackWrite (c.work fakeOutIdx).read else .blank) : Γw).toΓ).move + (if i.val = n₁ then Dir3.left else idleDir (c.work i).read), + output := (c.output.write Γw.blank.toΓ).move (idleDir c.output.read) } := by + simp only [step]; rw [hstate]; simp only [unionTM, if_neg hread]; rfl + +/-- Step the union machine from a rewindOut state when fake output reads start. -/ +private theorem step_rewindOut_start_cfg (tm₁ : TM n₁) (tm₂ : TM n₂) + {c : Cfg (n₁ + 1 + n₂) (UnionQ tm₁.Q tm₂.Q)} + (hstate : c.state = Sum.inr (Sum.inl UnionPhase.rewindOut)) + (hread : (c.work fakeOutIdx).read = Γ.start) : + (unionTM tm₁ tm₂).step c = some + { state := Sum.inr (Sum.inl UnionPhase.checkResult), + input := c.input.move (idleDir c.input.read), + work := fun i => ((c.work i).write (Γw.blank : Γw).toΓ).move + (if i.val = n₁ then Dir3.right else idleDir (c.work i).read), + output := (c.output.write Γw.blank.toΓ).move (idleDir c.output.read) } := by + simp only [step]; rw [hstate]; simp only [unionTM, if_pos hread]; rfl + +/-- Step the union machine from checkResult with Γ.one → halted. -/ +private theorem step_checkResult_one_cfg (tm₁ : TM n₁) (tm₂ : TM n₂) + {c : Cfg (n₁ + 1 + n₂) (UnionQ tm₁.Q tm₂.Q)} + (hstate : c.state = Sum.inr (Sum.inl UnionPhase.checkResult)) + (hread : (c.work fakeOutIdx).read = Γ.one) : + (unionTM tm₁ tm₂).step c = some + { state := Sum.inr (Sum.inr tm₂.qhalt), + input := c.input.move (idleDir c.input.read), + work := fun i => ((c.work i).write (Γw.blank : Γw).toΓ).move (idleDir (c.work i).read), + output := (c.output.write Γw.one.toΓ).move (idleDir c.output.read) } := by + simp only [step]; rw [hstate]; simp only [unionTM, if_pos hread]; rfl + +/-- Step the union machine from checkResult when not Γ.one → rewindIn (allIdle). -/ +private theorem step_checkResult_notone_cfg (tm₁ : TM n₁) (tm₂ : TM n₂) + {c : Cfg (n₁ + 1 + n₂) (UnionQ tm₁.Q tm₂.Q)} + (hstate : c.state = Sum.inr (Sum.inl UnionPhase.checkResult)) + (hread : (c.work fakeOutIdx).read ≠ Γ.one) : + (unionTM tm₁ tm₂).step c = some + { state := Sum.inr (Sum.inl UnionPhase.rewindIn), + input := c.input.move (idleDir c.input.read), + work := fun i => ((c.work i).write (Γw.blank : Γw).toΓ).move (idleDir (c.work i).read), + output := (c.output.write Γw.blank.toΓ).move (idleDir c.output.read) } := by + simp only [step]; rw [hstate]; simp only [unionTM, if_neg hread, allIdle]; rfl + +/-- Step the union machine from rewindIn with non-start input. -/ +private theorem step_rewindIn_nostart_cfg (tm₁ : TM n₁) (tm₂ : TM n₂) + {c : Cfg (n₁ + 1 + n₂) (UnionQ tm₁.Q tm₂.Q)} + (hstate : c.state = Sum.inr (Sum.inl UnionPhase.rewindIn)) + (hread : c.input.read ≠ Γ.start) : + (unionTM tm₁ tm₂).step c = some + { state := Sum.inr (Sum.inl UnionPhase.rewindIn), + input := c.input.move Dir3.left, + work := fun i => ((c.work i).write (Γw.blank : Γw).toΓ).move (idleDir (c.work i).read), + output := (c.output.write Γw.blank.toΓ).move (idleDir c.output.read) } := by + simp only [step]; rw [hstate]; simp only [unionTM, if_neg hread]; rfl + +/-- Step the union machine from rewindIn when input reads start. -/ +private theorem step_rewindIn_start_cfg (tm₁ : TM n₁) (tm₂ : TM n₂) + {c : Cfg (n₁ + 1 + n₂) (UnionQ tm₁.Q tm₂.Q)} + (hstate : c.state = Sum.inr (Sum.inl UnionPhase.rewindIn)) + (hread : c.input.read = Γ.start) : + (unionTM tm₁ tm₂).step c = some + { state := Sum.inr (Sum.inl UnionPhase.setup2), + input := c.input.move Dir3.right, + work := fun i => ((c.work i).write (Γw.blank : Γw).toΓ).move (idleDir (c.work i).read), + output := (c.output.write Γw.blank.toΓ).move (idleDir c.output.read) } := by + simp only [step]; rw [hstate]; simp only [unionTM, if_pos hread]; rfl + +/-- Step the union machine from setup2. -/ +private theorem step_setup2_cfg (tm₁ : TM n₁) (tm₂ : TM n₂) + {c : Cfg (n₁ + 1 + n₂) (UnionQ tm₁.Q tm₂.Q)} + (hstate : c.state = Sum.inr (Sum.inl UnionPhase.setup2)) : + (unionTM tm₁ tm₂).step c = some + { state := Sum.inr (Sum.inr tm₂.qstart), + input := c.input.move (moveLeftDir c.input.read), + work := fun i => ((c.work i).write (Γw.blank : Γw).toΓ).move + (if i.val ≤ n₁ then idleDir (c.work i).read else moveLeftDir (c.work i).read), + output := (c.output.write Γw.blank.toΓ).move (moveLeftDir c.output.read) } := by + simp only [step]; rw [hstate]; rfl + +/-- Step the union machine from unionPhase1Cfg when tm₁ halted. -/ +private theorem step_inl_qhalt_cfg (tm₁ : TM n₁) (tm₂ : TM n₂) + {c : Cfg (n₁ + 1 + n₂) (UnionQ tm₁.Q tm₂.Q)} + (hstate : c.state = Sum.inl tm₁.qhalt) : + (unionTM tm₁ tm₂).step c = some + { state := Sum.inr (Sum.inl UnionPhase.rewindOut), + input := c.input.move (idleDir c.input.read), + work := fun i => ((c.work i).write + ((if i.val = n₁ then readBackWrite (c.work fakeOutIdx).read else .blank) : Γw).toΓ).move + (idleDir (c.work i).read), + output := (c.output.write Γw.blank.toΓ).move (idleDir c.output.read) } := by + simp only [step]; rw [hstate]; simp only [unionTM, ite_true]; rfl + +-- ════════════════════════════════════════════════════════════════════════ +-- Rewind fake output loop +-- ════════════════════════════════════════════════════════════════════════ + +/-- readBackWrite preserves cells at non-zero head positions. -/ +private theorem write_readBack_cells_eq (t : Tape) (hne : t.read ≠ Γ.start) : + (t.write (readBackWrite t.read).toΓ).cells = t.cells := by + rw [toΓ_readBackWrite_of_ne_start hne] + simp only [Tape.write] + split + · rfl + · ext i; simp only [Function.update]; split + · next heq => subst heq; rfl + · rfl + +-- ════════════════════════════════════════════════════════════════════════ +-- Transition phase: accept path (x ∈ L₁) +-- ════════════════════════════════════════════════════════════════════════ + +/-- unionPhase1Cfg output is unionIdleTape. -/ +private theorem phase1Cfg_output (tm₁ : TM n₁) (tm₂ : TM n₂) (c : Cfg n₁ tm₁.Q) : + (unionPhase1Cfg tm₁ tm₂ c).output = unionIdleTape := rfl + +/-- unionPhase1Cfg fake output tape is c.output. -/ +private theorem phase1Cfg_fakeOut (tm₁ : TM n₁) (tm₂ : TM n₂) (c : Cfg n₁ tm₁.Q) : + (unionPhase1Cfg tm₁ tm₂ c).work fakeOutIdx = c.output := by + simp [unionPhase1Cfg, fakeOutIdx] + +/-- One step from unionPhase1Cfg when tm₁ is halted transitions to rewindOut. -/ +private theorem step_phase1_halted (tm₁ : TM n₁) (tm₂ : TM n₂) + (c₁ : Cfg n₁ tm₁.Q) (hhalt : tm₁.halted c₁) + (hnostart_out : ∀ i, i ≥ 1 → c₁.output.cells i ≠ Γ.start) : + ∃ c', (unionTM tm₁ tm₂).step (unionPhase1Cfg tm₁ tm₂ c₁) = some c' ∧ + c'.state = Sum.inr (Sum.inl UnionPhase.rewindOut) ∧ + (c'.work fakeOutIdx).cells = c₁.output.cells ∧ + c'.output = (unionIdleTape.write Γw.blank.toΓ).move (idleDir unionIdleTape.read) := by + have hstate : (unionPhase1Cfg tm₁ tm₂ c₁).state = Sum.inl tm₁.qhalt := by + show Sum.inl c₁.state = Sum.inl tm₁.qhalt; rw [hhalt] + have hstep := step_inl_qhalt_cfg tm₁ tm₂ hstate + -- The result config + set c' : Cfg (n₁ + 1 + n₂) (UnionQ tm₁.Q tm₂.Q) := + { state := Sum.inr (Sum.inl UnionPhase.rewindOut), + input := (unionPhase1Cfg tm₁ tm₂ c₁).input.move + (idleDir (unionPhase1Cfg tm₁ tm₂ c₁).input.read), + work := fun i => (((unionPhase1Cfg tm₁ tm₂ c₁).work i).write + ((if i.val = n₁ then readBackWrite ((unionPhase1Cfg tm₁ tm₂ c₁).work fakeOutIdx).read + else .blank) : Γw).toΓ).move + (idleDir ((unionPhase1Cfg tm₁ tm₂ c₁).work i).read), + output := ((unionPhase1Cfg tm₁ tm₂ c₁).output.write Γw.blank.toΓ).move + (idleDir (unionPhase1Cfg tm₁ tm₂ c₁).output.read) } with hc'_def + refine ⟨c', hstep, rfl, ?_, ?_⟩ + · -- fake output cells preserved + simp only [hc'_def, show (fakeOutIdx : Fin (n₁ + 1 + n₂)).val = n₁ from rfl, ite_true] + rw [phase1Cfg_fakeOut] + rw [Tape.move_cells] + simp only [Tape.write] + split + · rfl -- head = 0: write is no-op + · next hne => + -- head ≠ 0: readBackWrite writes back the same value + have hread_ne : c₁.output.read ≠ Γ.start := by + rw [Tape.read]; exact hnostart_out _ (by omega) + rw [toΓ_readBackWrite_of_ne_start hread_ne, Tape.read] + exact Function.update_eq_self _ _ + · -- output is unionIdleTape write blank / move idle + simp only [hc'_def, phase1Cfg_output] + +/-- Rewind the fake output tape, tracking all loop invariants: + state, fakeOut head/cells, output = unionIdleTape, and conditionally + input head preservation and work tape idleness for tapes > n₁. -/ +private theorem rewind_fakeOut_loop (tm₁ : TM n₁) (tm₂ : TM n₂) : + ∀ (h : ℕ) (c : Cfg (n₁ + 1 + n₂) (UnionQ tm₁.Q tm₂.Q)), + c.state = Sum.inr (Sum.inl UnionPhase.rewindOut) → + c.output = unionIdleTape → + (c.work fakeOutIdx).head = h → + (c.work fakeOutIdx).cells 0 = Γ.start → + (∀ i, i ≥ 1 → (c.work fakeOutIdx).cells i ≠ Γ.start) → + ∃ c', (unionTM tm₁ tm₂).reachesIn h c c' ∧ + c'.state = Sum.inr (Sum.inl UnionPhase.rewindOut) ∧ + (c'.work fakeOutIdx).head = 0 ∧ + (c'.work fakeOutIdx).cells = (c.work fakeOutIdx).cells ∧ + c'.output = unionIdleTape ∧ + (c.input.head ≥ 1 → (∀ i, i ≥ 1 → c.input.cells i ≠ Γ.start) → + c'.input.head = c.input.head) ∧ + (∀ i : Fin (n₁ + 1 + n₂), i.val > n₁ → c.work i = unionIdleTape → + c'.work i = unionIdleTape) := by + intro h + induction h with + | zero => + intro c hst hout hhead _ _ + exact ⟨c, .zero, hst, hhead, rfl, hout, fun _ _ => rfl, fun _ _ h => h⟩ + | succ n ih => + intro c hst hout hhead hcell0 hnostart + have hread_ne : (c.work fakeOutIdx).read ≠ Γ.start := by + rw [Tape.read]; exact hnostart _ (by omega) + have hstep := step_rewindOut_nostart_cfg tm₁ tm₂ hst hread_ne + set c' : Cfg (n₁ + 1 + n₂) (UnionQ tm₁.Q tm₂.Q) := + { state := Sum.inr (Sum.inl UnionPhase.rewindOut), + input := c.input.move (idleDir c.input.read), + work := fun i => ((c.work i).write + ((if i.val = n₁ then readBackWrite (c.work fakeOutIdx).read else .blank) : Γw).toΓ).move + (if i.val = n₁ then Dir3.left else idleDir (c.work i).read), + output := (c.output.write Γw.blank.toΓ).move (idleDir c.output.read) } + with hc'_def + have hout' : c'.output = unionIdleTape := by + simp only [hc'_def]; rw [hout, idleTape_step_idle] + have hhead' : (c'.work fakeOutIdx).head = n := by + simp only [hc'_def, show (fakeOutIdx : Fin (n₁ + 1 + n₂)).val = n₁ from rfl, ite_true] + rw [toΓ_readBackWrite_of_ne_start hread_ne]; simp only [Tape.write] + split + · omega + · simp [Tape.move, hhead] + have hcells' : (c'.work fakeOutIdx).cells = (c.work fakeOutIdx).cells := by + simp only [hc'_def, show (fakeOutIdx : Fin (n₁ + 1 + n₂)).val = n₁ from rfl, ite_true] + rw [Tape.move_cells, write_readBack_cells_eq _ hread_ne] + obtain ⟨c'', hreach, hst'', hhead'', hcells'', hout'', hinp'', hwork''⟩ := + ih c' rfl hout' hhead' + (by rw [hcells']; exact hcell0) + (by intro i hi; rw [hcells']; exact hnostart i hi) + refine ⟨c'', .step hstep hreach, hst'', hhead'', by rw [hcells'', hcells'], hout'', + fun hih hino => ?_, fun i hi hidle => ?_⟩ + · -- Input head: chain c → c' → c'' + have hih' : c'.input.head = c.input.head := idle_move_preserves_head _ hih hino + have hino' : ∀ i, i ≥ 1 → c'.input.cells i ≠ Γ.start := by + intro i hi; show (c.input.move _).cells i ≠ _; rw [Tape.move_cells]; exact hino i hi + rw [hinp'' (by omega) hino', hih'] + · -- Work tapes: chain c → c' → c'' + have hidle' : c'.work i = unionIdleTape := by + simp only [hc'_def, show (i : ℕ) ≠ n₁ from by omega, ↓reduceIte] + rw [hidle]; exact idleTape_step_idle + exact hwork'' i hi hidle' + +/-- After Phase 1, if tm₁ accepted (output cell 1 = `Γ.one`), the union + machine rewinds the fake output, checks the result, writes `Γ.one` to + the real output, and halts. -/ +theorem unionTM_transition_accept (tm₁ : TM n₁) (tm₂ : TM n₂) + {c₁ : Cfg n₁ tm₁.Q} + (hhalt : tm₁.halted c₁) + (haccept : c₁.output.cells 1 = Γ.one) + (hcell0 : c₁.output.cells 0 = Γ.start) + (hnostart : ∀ i, i ≥ 1 → c₁.output.cells i ≠ Γ.start) : + ∃ (t_tr : ℕ) (c_final : Cfg (n₁ + 1 + n₂) (UnionQ tm₁.Q tm₂.Q)), + (unionTM tm₁ tm₂).reachesIn t_tr (unionPhase1Cfg tm₁ tm₂ c₁) c_final ∧ + (unionTM tm₁ tm₂).halted c_final ∧ + c_final.output.cells 1 = Γ.one ∧ + t_tr ≤ c₁.output.head + 4 := by + -- Step 1: unionPhase1Cfg → rewindOut (1 step) + obtain ⟨c_rw, hstep1, hst_rw, hcells_rw, hout_rw⟩ := + step_phase1_halted tm₁ tm₂ c₁ hhalt hnostart + -- Head bound for the fake output after step 1 + have hfo_head_bound : (c_rw.work fakeOutIdx).head ≤ c₁.output.head + 1 := by + have hstate : (unionPhase1Cfg tm₁ tm₂ c₁).state = Sum.inl tm₁.qhalt := by + show Sum.inl c₁.state = Sum.inl tm₁.qhalt; rw [hhalt] + have hexp := (step_inl_qhalt_cfg tm₁ tm₂ hstate).symm.trans hstep1 + rw [Option.some.injEq] at hexp + rw [← hexp] + simp only [phase1Cfg_fakeOut] + have hmv : ∀ (t : Tape) (d : Dir3), (t.move d).head ≤ t.head + 1 := by + intro t d; cases d <;> simp [Tape.move]; omega + have hwh : ∀ (t : Tape) (s : Γ), (t.write s).head = t.head := by + intro t s; simp [Tape.write]; split <;> rfl + calc ((c₁.output.write _).move _).head ≤ (c₁.output.write _).head + 1 := hmv _ _ + _ = c₁.output.head + 1 := by rw [hwh] + -- Fake output cells preserved + have hcell0_rw : (c_rw.work fakeOutIdx).cells 0 = Γ.start := by + rw [hcells_rw]; exact hcell0 + have hnostart_rw : ∀ i, i ≥ 1 → (c_rw.work fakeOutIdx).cells i ≠ Γ.start := by + intro i hi; rw [hcells_rw]; exact hnostart i hi + -- c_rw.output = unionIdleTape + have hout_rw_eq : c_rw.output = unionIdleTape := by + rw [hout_rw]; exact idleTape_step_idle + -- Step 2: Rewind loop (h_rw steps), also preserving output = unionIdleTape + set h_rw := (c_rw.work fakeOutIdx).head with hh_rw_def + obtain ⟨c_at0, hreach_rw, hst_at0, hhead_at0, hcells_at0, hout_at0, -, -⟩ := + rewind_fakeOut_loop tm₁ tm₂ h_rw c_rw hst_rw hout_rw_eq rfl hcell0_rw hnostart_rw + -- Step 3: rewindOut at head 0 → checkResult (1 step) + have hread_start : (c_at0.work fakeOutIdx).read = Γ.start := by + rw [Tape.read, hhead_at0, hcells_at0, hcells_rw]; exact hcell0 + have hstep3 := step_rewindOut_start_cfg tm₁ tm₂ hst_at0 hread_start + set c_cr : Cfg (n₁ + 1 + n₂) (UnionQ tm₁.Q tm₂.Q) := + { state := Sum.inr (Sum.inl UnionPhase.checkResult), + input := c_at0.input.move (idleDir c_at0.input.read), + work := fun i => ((c_at0.work i).write (Γw.blank : Γw).toΓ).move + (if i.val = n₁ then Dir3.right else idleDir (c_at0.work i).read), + output := (c_at0.output.write Γw.blank.toΓ).move (idleDir c_at0.output.read) } + with hc_cr_def + -- c_cr fake output head = 1 (moved right from head 0) + have hcr_fo_head : (c_cr.work fakeOutIdx).head = 1 := by + simp only [hc_cr_def, show (fakeOutIdx : Fin (n₁ + 1 + n₂)).val = n₁ from rfl, ite_true] + simp only [Tape.write, hhead_at0, ↓reduceIte, Tape.move] + -- c_cr fake output cells preserved (write blank at head 0 is no-op) + have hcr_fo_cells : (c_cr.work fakeOutIdx).cells = (c_at0.work fakeOutIdx).cells := by + simp only [hc_cr_def, show (fakeOutIdx : Fin (n₁ + 1 + n₂)).val = n₁ from rfl, ite_true] + rw [Tape.move_cells]; simp only [Tape.write, if_pos hhead_at0] + -- c_cr fake output reads cell 1 = Γ.one + have hcr_read : (c_cr.work fakeOutIdx).read = Γ.one := by + rw [Tape.read, hcr_fo_head, hcr_fo_cells, hcells_at0, hcells_rw]; exact haccept + -- c_cr output = unionIdleTape + have hout_cr : c_cr.output = unionIdleTape := by + show (c_at0.output.write Γw.blank.toΓ).move (idleDir c_at0.output.read) = unionIdleTape + rw [hout_at0]; exact idleTape_step_idle + -- Step 4: checkResult with Γ.one → halt (1 step) + have hst_cr : c_cr.state = Sum.inr (Sum.inl UnionPhase.checkResult) := rfl + have hstep4 := step_checkResult_one_cfg tm₁ tm₂ hst_cr hcr_read + set c_final : Cfg (n₁ + 1 + n₂) (UnionQ tm₁.Q tm₂.Q) := + { state := Sum.inr (Sum.inr tm₂.qhalt), + input := c_cr.input.move (idleDir c_cr.input.read), + work := fun i => ((c_cr.work i).write (Γw.blank : Γw).toΓ).move (idleDir (c_cr.work i).read), + output := (c_cr.output.write Γw.one.toΓ).move (idleDir c_cr.output.read) } + with hc_final_def + -- c_final is halted + have hhalt_final : (unionTM tm₁ tm₂).halted c_final := rfl + -- c_final output cell 1 = Γ.one + have hcells_final : c_final.output.cells 1 = Γ.one := by + show ((c_cr.output.write Γw.one.toΓ).move (idleDir c_cr.output.read)).cells 1 = Γ.one + rw [Tape.move_cells, hout_cr] + simp [Tape.write, unionIdleTape, Γw.toΓ, Function.update, Tape.init] + -- Compose all steps: 1 + h_rw + 1 + 1 steps total + have htotal : (unionTM tm₁ tm₂).reachesIn (1 + (h_rw + (1 + 1))) + (unionPhase1Cfg tm₁ tm₂ c₁) c_final := + reachesIn_trans _ (.step hstep1 .zero) + (reachesIn_trans _ hreach_rw + (.step hstep3 (.step hstep4 .zero))) + have heq : 1 + (h_rw + (1 + 1)) = 1 + h_rw + 1 + 1 := by omega + exact ⟨1 + h_rw + 1 + 1, c_final, heq ▸ htotal, hhalt_final, hcells_final, by omega⟩ + +-- ════════════════════════════════════════════════════════════════════════ +-- Transition phase: reject path (x ∉ L₁) → Phase 2 ready +-- ════════════════════════════════════════════════════════════════════════ + +/-- Rewind the input tape from head position `h` to head position 0, + preserving output = unionIdleTape. -/ +private theorem rewind_input_loop (tm₁ : TM n₁) (tm₂ : TM n₂) : + ∀ (h : ℕ) (c : Cfg (n₁ + 1 + n₂) (UnionQ tm₁.Q tm₂.Q)), + c.state = Sum.inr (Sum.inl UnionPhase.rewindIn) → + c.input.head = h → + (∀ i, i ≥ 1 → c.input.cells i ≠ Γ.start) → + c.input.cells 0 = Γ.start → + c.output = unionIdleTape → + ∃ c', (unionTM tm₁ tm₂).reachesIn h c c' ∧ + c'.state = Sum.inr (Sum.inl UnionPhase.rewindIn) ∧ + c'.input.head = 0 ∧ + c'.input.cells = c.input.cells ∧ + c'.output = unionIdleTape := by + intro h + induction h with + | zero => + intro c hst hhead _ _ hout + exact ⟨c, .zero, hst, hhead, rfl, hout⟩ + | succ n ih => + intro c hst hhead hnostart hcell0 hout + have hread_ne : c.input.read ≠ Γ.start := by + rw [Tape.read]; exact hnostart _ (by omega) + have hstep := step_rewindIn_nostart_cfg tm₁ tm₂ hst hread_ne + set c' : Cfg (n₁ + 1 + n₂) (UnionQ tm₁.Q tm₂.Q) := + { state := Sum.inr (Sum.inl UnionPhase.rewindIn), + input := c.input.move Dir3.left, + work := fun i => ((c.work i).write (Γw.blank : Γw).toΓ).move (idleDir (c.work i).read), + output := (c.output.write Γw.blank.toΓ).move (idleDir c.output.read) } + with hc'_def + have hst' : c'.state = Sum.inr (Sum.inl UnionPhase.rewindIn) := rfl + have hhead' : c'.input.head = n := by + show (c.input.move Dir3.left).head = n; simp [Tape.move, hhead] + have hcells' : c'.input.cells = c.input.cells := Tape.move_cells _ _ + have hcell0' : c'.input.cells 0 = Γ.start := by rw [hcells']; exact hcell0 + have hnostart' : ∀ i, i ≥ 1 → c'.input.cells i ≠ Γ.start := by + intro i hi; rw [hcells']; exact hnostart i hi + have hout' : c'.output = unionIdleTape := by + show (c.output.write Γw.blank.toΓ).move (idleDir c.output.read) = unionIdleTape + rw [hout]; exact idleTape_step_idle + obtain ⟨c'', hreach, hst'', hhead'', hcells'', hout''⟩ := + ih c' hst' hhead' hnostart' hcell0' hout' + exact ⟨c'', .step hstep hreach, hst'', hhead'', by rw [hcells'', hcells'], hout''⟩ + +/-- Writing blank to unionIdleTape and moving left yields Tape.init []. -/ +private theorem idleTape_moveLeft : + (unionIdleTape.write Γw.blank.toΓ).move (moveLeftDir unionIdleTape.read) = Tape.init [] := by + simp [unionIdleTape, moveLeftDir, Tape.write, Tape.move, Tape.read, Tape.init] + +/-- unionIdleTape stays unionIdleTape when written with blank and moved by idleDir (on any tape). -/ +private theorem tape_idle_step (t : Tape) (ht : t = unionIdleTape) : + (t.write Γw.blank.toΓ).move (idleDir t.read) = unionIdleTape := by + rw [ht]; exact idleTape_step_idle + +/-- Input cells are preserved through any reachesIn (input tape is read-only). -/ +private theorem union_input_cells_of_step (tm₁ : TM n₁) (tm₂ : TM n₂) + {c c' : Cfg (n₁ + 1 + n₂) (unionTM tm₁ tm₂).Q} + (hs : (unionTM tm₁ tm₂).step c = some c') : c'.input.cells = c.input.cells := by + have hne := state_ne_qhalt_of_step hs + simp only [step, hne, ↓reduceIte, Option.some.injEq] at hs; subst hs + exact Tape.move_cells _ _ + +private theorem union_input_cells_of_reachesIn (tm₁ : TM n₁) (tm₂ : TM n₂) + {t : ℕ} {c₀ c : Cfg (n₁ + 1 + n₂) (unionTM tm₁ tm₂).Q} + (h : (unionTM tm₁ tm₂).reachesIn t c₀ c) : c.input.cells = c₀.input.cells := by + induction h with + | zero => rfl + | step hs _ ih => rw [ih, union_input_cells_of_step tm₁ tm₂ hs] + +/-- Work tapes at index `> n₁` get write blank + move idle in any step + from `inl q`, `rewindOut`, `checkResult`, or `rewindIn` states. -/ +private theorem phase2_work_step_idle (tm₁ : TM n₁) (tm₂ : TM n₂) + {c c' : Cfg (n₁ + 1 + n₂) (UnionQ tm₁.Q tm₂.Q)} + (hs : (unionTM tm₁ tm₂).step c = some c') + (hstate : (∃ q, c.state = Sum.inl q) ∨ + c.state = Sum.inr (Sum.inl UnionPhase.rewindOut) ∨ + c.state = Sum.inr (Sum.inl UnionPhase.checkResult) ∨ + c.state = Sum.inr (Sum.inl UnionPhase.rewindIn)) + {i : Fin (n₁ + 1 + n₂)} (hi : i.val > n₁) : + c'.work i = ((c.work i).write Γw.blank.toΓ).move (idleDir (c.work i).read) := by + have hne : c.state ≠ (unionTM tm₁ tm₂).qhalt := by + rcases hstate with ⟨q, hq⟩ | hq | hq | hq <;> rw [hq] <;> exact fun h => nomatch h + simp only [step] at hs + split at hs + · exact absurd ‹_› hne + injection hs with hs; subst hs + have hine : (i : ℕ) ≠ n₁ := by omega + rcases hstate with ⟨q, hq⟩ | hq | hq | hq + · dsimp only []; rw [hq]; dsimp only [unionTM]; split + · -- qhalt: write (if i = n₁ then ... else blank), dir idleDir + congr 1; simp only [hine, ↓reduceIte] + · -- q ≠ qhalt: write/dir have dif/if structure + congr 1 + · congr 1 + show (if h : (i : ℕ) < n₁ then _ else if (i : ℕ) = n₁ then _ else Γw.blank) = Γw.blank + rw [dif_neg (show ¬((i : ℕ) < n₁) from by omega), if_neg hine] + · show (if h : (i : ℕ) < n₁ then _ + else if (i : ℕ) = n₁ then _ else idleDir (c.work i).read) = _ + rw [dif_neg (show ¬((i : ℕ) < n₁) from by omega), if_neg hine] + · rw [hq]; dsimp only [unionTM]; split + · congr 1; simp only [hine, ↓reduceIte] + · congr 1 + · congr 1; simp only [hine, ↓reduceIte] + · simp only [hine, ↓reduceIte] + · rw [hq]; dsimp only [unionTM]; split <;> rfl + · rw [hq]; dsimp only [unionTM]; split <;> rfl + +/-- Rewind input loop also preserves phase 2 work tapes. -/ +private theorem rewind_input_work_idle (tm₁ : TM n₁) (tm₂ : TM n₂) + {i : Fin (n₁ + 1 + n₂)} (_hi : i.val > n₁) : + ∀ (h : ℕ) (c : Cfg (n₁ + 1 + n₂) (UnionQ tm₁.Q tm₂.Q)), + c.state = Sum.inr (Sum.inl UnionPhase.rewindIn) → + c.input.head = h → + (∀ j, j ≥ 1 → c.input.cells j ≠ Γ.start) → + c.input.cells 0 = Γ.start → + c.work i = unionIdleTape → + ∃ c', (unionTM tm₁ tm₂).reachesIn h c c' ∧ + c'.work i = unionIdleTape := by + intro h + induction h with + | zero => + intro c _ _ _ _ hidle; exact ⟨c, .zero, hidle⟩ + | succ n ih => + intro c hst hhead hnostart hcell0 hidle + have hread_ne : c.input.read ≠ Γ.start := by + rw [Tape.read]; exact hnostart _ (by omega) + have hstep := step_rewindIn_nostart_cfg tm₁ tm₂ hst hread_ne + set c' : Cfg (n₁ + 1 + n₂) (UnionQ tm₁.Q tm₂.Q) := + { state := Sum.inr (Sum.inl UnionPhase.rewindIn), + input := c.input.move Dir3.left, + work := fun j => ((c.work j).write (Γw.blank : Γw).toΓ).move (idleDir (c.work j).read), + output := (c.output.write Γw.blank.toΓ).move (idleDir c.output.read) } + with hc'_def + have hidle' : c'.work i = unionIdleTape := by + show ((c.work i).write _).move _ = _; rw [hidle]; exact idleTape_step_idle + obtain ⟨c'', hreach, hidle''⟩ := ih c' rfl + (by show (c.input.move Dir3.left).head = n; simp [Tape.move, hhead]) + (by intro j hj; show (c.input.move Dir3.left).cells j ≠ _ + rw [Tape.move_cells]; exact hnostart j hj) + (by show (c.input.move Dir3.left).cells 0 = _; rw [Tape.move_cells]; exact hcell0) + hidle' + exact ⟨c'', .step hstep hreach, hidle''⟩ + +/-- After Phase 1, if tm₁ rejected, the union machine transitions to a + config ready for Phase 2: state is `Sum.inr (Sum.inr tm₂.qstart)`, + input/output/active work tapes match `tm₂.initCfg x`. -/ +theorem unionTM_transition_reject (tm₁ : TM n₁) (tm₂ : TM n₂) (x : List Bool) + {c₁ : Cfg n₁ tm₁.Q} + (hhalt : tm₁.halted c₁) + (hreject : c₁.output.cells 1 = Γ.zero) + (hcell0_out : c₁.output.cells 0 = Γ.start) + (hnostart_out : ∀ i, i ≥ 1 → c₁.output.cells i ≠ Γ.start) + (hinput_cells : c₁.input.cells = (Tape.init (x.map Γ.ofBool)).cells) : + ∃ (t_tr : ℕ) (c_mid : Cfg (n₁ + 1 + n₂) (UnionQ tm₁.Q tm₂.Q)), + (unionTM tm₁ tm₂).reachesIn t_tr (unionPhase1Cfg tm₁ tm₂ c₁) c_mid ∧ + c_mid.state = Sum.inr (Sum.inr tm₂.qstart) ∧ + c_mid.input = Tape.init (x.map Γ.ofBool) ∧ + (∀ j : Fin n₂, c_mid.work ⟨n₁ + 1 + j.val, by omega⟩ = Tape.init []) ∧ + c_mid.output = Tape.init [] ∧ + t_tr ≤ c₁.output.head + c₁.input.head + 7 := by + -- Step 1: unionPhase1Cfg halted → rewindOut (1 step) + obtain ⟨c_rw, hstep1, hst_rw, hcells_rw, hout_rw⟩ := + step_phase1_halted tm₁ tm₂ c₁ hhalt hnostart_out + -- Head bounds + have hfo_head_bound : (c_rw.work fakeOutIdx).head ≤ c₁.output.head + 1 := by + have hstate : (unionPhase1Cfg tm₁ tm₂ c₁).state = Sum.inl tm₁.qhalt := by + show Sum.inl c₁.state = Sum.inl tm₁.qhalt; rw [hhalt] + have hexp := (step_inl_qhalt_cfg tm₁ tm₂ hstate).symm.trans hstep1 + rw [Option.some.injEq] at hexp + rw [← hexp] + simp only [phase1Cfg_fakeOut] + have hmv : ∀ (t : Tape) (d : Dir3), (t.move d).head ≤ t.head + 1 := by + intro t d; cases d <;> simp [Tape.move]; omega + have hwh : ∀ (t : Tape) (s : Γ), (t.write s).head = t.head := by + intro t s; simp [Tape.write]; split <;> rfl + calc ((c₁.output.write _).move _).head ≤ (c₁.output.write _).head + 1 := hmv _ _ + _ = c₁.output.head + 1 := by rw [hwh] + -- c_rw properties + have hcell0_rw : (c_rw.work fakeOutIdx).cells 0 = Γ.start := by rw [hcells_rw]; exact hcell0_out + have hnostart_rw : ∀ i, i ≥ 1 → (c_rw.work fakeOutIdx).cells i ≠ Γ.start := by + intro i hi; rw [hcells_rw]; exact hnostart_out i hi + have hout_rw_eq : c_rw.output = unionIdleTape := by rw [hout_rw]; exact idleTape_step_idle + -- Step 2: Rewind fake output (h_rw steps) + set h_rw := (c_rw.work fakeOutIdx).head with hh_rw_def + obtain ⟨c_at0, hreach_rw, hst_at0, hhead_at0, hcells_at0, hout_at0, hinp_at0, hwork_at0⟩ := + rewind_fakeOut_loop tm₁ tm₂ h_rw c_rw hst_rw hout_rw_eq rfl hcell0_rw hnostart_rw + -- Step 3: rewindOut at head 0 → checkResult (1 step) + have hread_start : (c_at0.work fakeOutIdx).read = Γ.start := by + rw [Tape.read, hhead_at0, hcells_at0, hcells_rw]; exact hcell0_out + have hstep3 := step_rewindOut_start_cfg tm₁ tm₂ hst_at0 hread_start + set c_cr : Cfg (n₁ + 1 + n₂) (UnionQ tm₁.Q tm₂.Q) := + { state := Sum.inr (Sum.inl UnionPhase.checkResult), + input := c_at0.input.move (idleDir c_at0.input.read), + work := fun i => ((c_at0.work i).write (Γw.blank : Γw).toΓ).move + (if i.val = n₁ then Dir3.right else idleDir (c_at0.work i).read), + output := (c_at0.output.write Γw.blank.toΓ).move (idleDir c_at0.output.read) } + with hc_cr_def + have hout_cr : c_cr.output = unionIdleTape := by + show (c_at0.output.write Γw.blank.toΓ).move (idleDir c_at0.output.read) = unionIdleTape + rw [hout_at0]; exact idleTape_step_idle + -- c_cr fake output reads Γ.zero (not Γ.one) + have hcr_fo_head : (c_cr.work fakeOutIdx).head = 1 := by + simp only [hc_cr_def, show (fakeOutIdx : Fin (n₁ + 1 + n₂)).val = n₁ from rfl, ite_true] + simp only [Tape.write, hhead_at0, ↓reduceIte, Tape.move] + have hcr_fo_cells : (c_cr.work fakeOutIdx).cells = (c_at0.work fakeOutIdx).cells := by + simp only [hc_cr_def, show (fakeOutIdx : Fin (n₁ + 1 + n₂)).val = n₁ from rfl, ite_true] + rw [Tape.move_cells]; simp only [Tape.write, if_pos hhead_at0] + have hcr_read_ne_one : (c_cr.work fakeOutIdx).read ≠ Γ.one := by + rw [Tape.read, hcr_fo_head, hcr_fo_cells, hcells_at0, hcells_rw, hreject]; decide + -- Step 4: checkResult ≠ Γ.one → rewindIn (1 step) + have hstep4 := step_checkResult_notone_cfg tm₁ tm₂ rfl hcr_read_ne_one + set c_ri : Cfg (n₁ + 1 + n₂) (UnionQ tm₁.Q tm₂.Q) := + { state := Sum.inr (Sum.inl UnionPhase.rewindIn), + input := c_cr.input.move (idleDir c_cr.input.read), + work := fun i => ((c_cr.work i).write (Γw.blank : Γw).toΓ).move (idleDir (c_cr.work i).read), + output := (c_cr.output.write Γw.blank.toΓ).move (idleDir c_cr.output.read) } + with hc_ri_def + have hout_ri : c_ri.output = unionIdleTape := by + show (c_cr.output.write Γw.blank.toΓ).move (idleDir c_cr.output.read) = unionIdleTape + rw [hout_cr]; exact idleTape_step_idle + -- Input cells chain: input is read-only, so cells are preserved through all steps. + -- unionPhase1Cfg → c_rw → (rewind) → c_at0 → c_cr → c_ri all preserve input.cells + have hin_cells_chain : c_ri.input.cells = (Tape.init (x.map Γ.ofBool)).cells := by + -- c_ri.input.cells = c_cr.input.cells (move) + show (c_cr.input.move _).cells = _; rw [Tape.move_cells] + -- c_cr.input.cells = c_at0.input.cells (move) + show (c_at0.input.move _).cells = _; rw [Tape.move_cells] + -- c_at0.input.cells = c_rw.input.cells (reachesIn) + rw [union_input_cells_of_reachesIn tm₁ tm₂ hreach_rw] + -- c_rw.input.cells = unionPhase1Cfg.input.cells (step) + have hstate : (unionPhase1Cfg tm₁ tm₂ c₁).state = Sum.inl tm₁.qhalt := by + show Sum.inl c₁.state = Sum.inl tm₁.qhalt; rw [hhalt] + have hexp := (step_inl_qhalt_cfg tm₁ tm₂ hstate).symm.trans hstep1 + rw [Option.some.injEq] at hexp + rw [← hexp, Tape.move_cells]; exact hinput_cells + -- Input cells ≥ 1 ≠ Γ.start + have hin_nostart_ri : ∀ i, i ≥ 1 → c_ri.input.cells i ≠ Γ.start := by + intro i hi; rw [hin_cells_chain] + simp only [Tape.init, show i ≠ 0 from by omega, ↓reduceIte] + intro heq + have : (x.map Γ.ofBool)[i - 1]?.getD Γ.blank = Γ.start := heq + cases hget : (x.map Γ.ofBool)[i - 1]? with + | none => simp [hget, Option.getD] at this + | some v => + simp [hget, Option.getD] at this; subst this + have hmem := List.mem_of_getElem? hget + simp [List.mem_map] at hmem + rcases hmem with ⟨_, hb⟩ | ⟨_, hb⟩ <;> simp [Γ.ofBool] at hb + -- Input cell 0 = Γ.start + have hin_cell0_ri : c_ri.input.cells 0 = Γ.start := by + rw [hin_cells_chain]; simp [Tape.init] + -- Input head bound for c_ri + -- c_ri.input goes through: unionPhase1Cfg.input → move → (h_rw moves) → move → move → move + -- Each move adds at most 1, so total head ≤ initial + (1 + h_rw + 1 + 1 + 1) + -- But we need a tighter bound. Let's compute it through the reachesIn chain. + -- Actually, we just need c_ri.input.head for the rewind loop bound. + -- Let's compose: steps 1..4 give reachesIn (1 + h_rw + 1 + 1) from unionPhase1Cfg to c_ri + have hreach_to_ri : (unionTM tm₁ tm₂).reachesIn (1 + (h_rw + (1 + 1))) + (unionPhase1Cfg tm₁ tm₂ c₁) c_ri := + reachesIn_trans _ (.step hstep1 .zero) + (reachesIn_trans _ hreach_rw (.step hstep3 (.step hstep4 .zero))) + -- Input head bound: through all steps, head changes by at most 1 per step + -- total steps so far = 1 + h_rw + 2, so head ≤ initial + (1 + h_rw + 2) + -- unionPhase1Cfg.input.head = c₁.input.head + -- But we need a precise bound. Let's just track c_ri.input.head. + -- Actually for rewind_input_loop we need h_ri = c_ri.input.head and the + -- total t_tr ≤ c₁.output.head + c₁.input.head + 7 + -- We don't need a tight head bound; we just use the loop count. + -- Step 5: Rewind input (h_ri steps) + set h_ri := c_ri.input.head with hh_ri_def + obtain ⟨c_ri0, hreach_ri, hst_ri0, hhead_ri0, hcells_ri0, hout_ri0⟩ := + rewind_input_loop tm₁ tm₂ h_ri c_ri rfl rfl hin_nostart_ri hin_cell0_ri hout_ri + -- Step 6: rewindIn at head 0 → setup2 (1 step) + have hread_start_ri : c_ri0.input.read = Γ.start := by + rw [Tape.read, hhead_ri0, hcells_ri0, hin_cells_chain]; simp [Tape.init] + have hstep6 := step_rewindIn_start_cfg tm₁ tm₂ hst_ri0 hread_start_ri + set c_s2 : Cfg (n₁ + 1 + n₂) (UnionQ tm₁.Q tm₂.Q) := + { state := Sum.inr (Sum.inl UnionPhase.setup2), + input := c_ri0.input.move Dir3.right, + work := fun i => + ((c_ri0.work i).write (Γw.blank : Γw).toΓ).move (idleDir (c_ri0.work i).read), + output := (c_ri0.output.write Γw.blank.toΓ).move (idleDir c_ri0.output.read) } + with hc_s2_def + -- Step 7: setup2 → Phase 2 start (1 step) + have hstep7 := step_setup2_cfg tm₁ tm₂ + (show c_s2.state = Sum.inr (Sum.inl UnionPhase.setup2) from rfl) + set c_mid : Cfg (n₁ + 1 + n₂) (UnionQ tm₁.Q tm₂.Q) := + { state := Sum.inr (Sum.inr tm₂.qstart), + input := c_s2.input.move (moveLeftDir c_s2.input.read), + work := fun i => ((c_s2.work i).write (Γw.blank : Γw).toΓ).move + (if i.val ≤ n₁ then idleDir (c_s2.work i).read else moveLeftDir (c_s2.work i).read), + output := (c_s2.output.write Γw.blank.toΓ).move (moveLeftDir c_s2.output.read) } + with hc_mid_def + -- Now prove all properties of c_mid. + -- c_mid.state + have hst_mid : c_mid.state = Sum.inr (Sum.inr tm₂.qstart) := rfl + -- c_mid.input = Tape.init (x.map Γ.ofBool) + -- c_mid.input = c_s2.input.move (moveLeftDir c_s2.input.read) + -- c_s2.input = c_ri0.input.move Dir3.right + -- c_ri0.input.head = 0, so moving right gives head = 1 + -- c_s2.input.head = 1, c_s2.input.cells = c_ri0.input.cells (move preserves) + -- c_s2.input.read = cells[1] which is from Tape.init, not start + -- moveLeftDir(non-start) = left, so head goes from 1 to 0 + -- c_mid.input = { head := 0, cells := Tape.init cells } = Tape.init (x.map Γ.ofBool) + have hcells_ri0_eq : c_ri0.input.cells = (Tape.init (x.map Γ.ofBool)).cells := by + rw [hcells_ri0, hin_cells_chain] + have hin_mid : c_mid.input = Tape.init (x.map Γ.ofBool) := by + -- c_mid.input.cells = Tape.init cells + have h2 : c_mid.input.cells = (Tape.init (x.map Γ.ofBool)).cells := by + show (c_s2.input.move _).cells = _ + rw [Tape.move_cells]; show (c_ri0.input.move Dir3.right).cells = _ + rw [Tape.move_cells]; exact hcells_ri0_eq + -- c_s2.input = c_ri0.input.move Dir3.right, head = 1 + have hs2_head : c_s2.input.head = 1 := by + show (c_ri0.input.move Dir3.right).head = 1 + simp [Tape.move, hhead_ri0] + have hs2_cells : c_s2.input.cells = c_ri0.input.cells := Tape.move_cells _ _ + -- c_s2.input.read ≠ Γ.start (cells[1] is from Tape.init, not start) + have hs2_read_ne : c_s2.input.read ≠ Γ.start := by + rw [Tape.read, hs2_head, hs2_cells, hcells_ri0] + exact hin_nostart_ri 1 (by omega) + -- c_mid.input.head = 0 (moveLeftDir of non-start = left, from head 1 → 0) + have h1 : c_mid.input.head = 0 := by + show (c_s2.input.move (moveLeftDir c_s2.input.read)).head = 0 + rw [moveLeftDir, if_neg hs2_read_ne]; simp [Tape.move, hs2_head] + -- Combine + have hcfg : ∀ (a b : Tape), a.head = b.head → a.cells = b.cells → a = b := by + intros a b hh hc; cases a; cases b; simp only [Tape.mk.injEq] at *; exact ⟨hh, hc⟩ + exact hcfg _ _ (by rw [h1]; rfl) h2 + -- c_mid.output = Tape.init [] + -- c_mid.output = (c_s2.output.write blank).move (moveLeftDir c_s2.output.read) + -- c_s2.output = (c_ri0.output.write blank).move (idleDir c_ri0.output.read) + -- c_ri0.output = unionIdleTape + -- c_s2.output = unionIdleTape (write blank + move idle on unionIdleTape) + -- c_mid.output = (unionIdleTape.write blank).move (moveLeftDir unionIdleTape.read) = Tape.init [] + have hout_s2 : c_s2.output = unionIdleTape := by + show (c_ri0.output.write Γw.blank.toΓ).move (idleDir c_ri0.output.read) = unionIdleTape + rw [hout_ri0]; exact idleTape_step_idle + have hout_mid : c_mid.output = Tape.init [] := by + show (c_s2.output.write Γw.blank.toΓ).move (moveLeftDir c_s2.output.read) = Tape.init [] + rw [hout_s2]; exact idleTape_moveLeft + -- Phase 2 work tapes = Tape.init [] + -- Strategy: show work tapes at > n₁ indices stay unionIdleTape through each phase, + -- then setup2 sends unionIdleTape to Tape.init []. + -- Step 1: c_rw.work at > n₁ = unionIdleTape (from phase1_halted step) + have hwork_rw_idle : ∀ (j : Fin n₂), + c_rw.work ⟨n₁ + 1 + j.val, by omega⟩ = unionIdleTape := by + intro j + have hstateq : (unionPhase1Cfg tm₁ tm₂ c₁).state = Sum.inl tm₁.qhalt := by + show Sum.inl c₁.state = Sum.inl tm₁.qhalt; rw [hhalt] + have hstep' := phase2_work_step_idle tm₁ tm₂ hstep1 + (Or.inl ⟨tm₁.qhalt, hstateq⟩) (i := ⟨n₁ + 1 + j.val, by omega⟩) + (by omega : n₁ + 1 + j.val > n₁) + rw [hstep'] + have hp1 : (unionPhase1Cfg tm₁ tm₂ c₁).work ⟨n₁ + 1 + j.val, by omega⟩ = unionIdleTape := by + simp [unionPhase1Cfg, show ¬(n₁ + 1 + j.val < n₁) from by omega, + show ¬(n₁ + 1 + j.val = n₁) from by omega] + rw [hp1]; exact idleTape_step_idle + -- Step 2: Through rewind_fakeOut (hreach_rw), work tapes > n₁ stay unionIdleTape + have hwork_at0_idle : ∀ (j : Fin n₂), + c_at0.work ⟨n₁ + 1 + j.val, by omega⟩ = unionIdleTape := by + intro j; exact hwork_at0 ⟨n₁ + 1 + j.val, by omega⟩ + (show n₁ + 1 + j.val > n₁ by omega) (hwork_rw_idle j) + -- Step 3 (rewindOut→checkResult): c_cr.work at > n₁ = unionIdleTape + have hwork_cr_idle : ∀ (j : Fin n₂), + c_cr.work ⟨n₁ + 1 + j.val, by omega⟩ = unionIdleTape := by + intro j + show ((c_at0.work ⟨n₁ + 1 + j.val, by omega⟩).write _).move + (if (n₁ + 1 + j.val) = n₁ then _ else _) = _ + rw [if_neg (show n₁ + 1 + j.val ≠ n₁ from by omega), hwork_at0_idle j] + exact idleTape_step_idle + -- Step 4 (checkResult→rewindIn): c_ri.work at > n₁ = unionIdleTape + have hwork_ri_idle : ∀ (j : Fin n₂), + c_ri.work ⟨n₁ + 1 + j.val, by omega⟩ = unionIdleTape := by + intro j + show ((c_cr.work ⟨n₁ + 1 + j.val, by omega⟩).write _).move _ = _ + rw [hwork_cr_idle j]; exact idleTape_step_idle + -- Step 5: Through rewind_input (hreach_ri), work tapes > n₁ stay unionIdleTape + have hwork_ri0_idle : ∀ (j : Fin n₂), + c_ri0.work ⟨n₁ + 1 + j.val, by omega⟩ = unionIdleTape := by + intro j + obtain ⟨c_ri0', hreach', hidle'⟩ := rewind_input_work_idle tm₁ tm₂ + (show n₁ + 1 + j.val > n₁ from by omega) + h_ri c_ri rfl rfl hin_nostart_ri hin_cell0_ri (hwork_ri_idle j) + have hdet := TM.reachesIn_right_unique hreach_ri hreach' + rw [hdet]; exact hidle' + -- Step 6 (rewindIn→setup2): c_s2.work at > n₁ = unionIdleTape + have hwork_s2_idle : ∀ (j : Fin n₂), + c_s2.work ⟨n₁ + 1 + j.val, by omega⟩ = unionIdleTape := by + intro j + show ((c_ri0.work ⟨n₁ + 1 + j.val, by omega⟩).write _).move _ = _ + rw [hwork_ri0_idle j]; exact idleTape_step_idle + -- Step 7 (setup2→phase2_start): c_mid.work at > n₁ = Tape.init [] + have hwork_mid : ∀ (j : Fin n₂), + c_mid.work ⟨n₁ + 1 + j.val, by omega⟩ = Tape.init [] := by + intro j + show ((c_s2.work ⟨n₁ + 1 + j.val, by omega⟩).write _).move + (if (n₁ + 1 + j.val) ≤ n₁ then _ else _) = _ + rw [if_neg (show ¬(n₁ + 1 + j.val ≤ n₁) from by omega), hwork_s2_idle j] + exact idleTape_moveLeft + -- Compose all reachesIn steps + have hreach_total : (unionTM tm₁ tm₂).reachesIn + (1 + (h_rw + (1 + 1)) + (h_ri + (1 + 1))) + (unionPhase1Cfg tm₁ tm₂ c₁) c_mid := + reachesIn_trans _ hreach_to_ri + (reachesIn_trans _ hreach_ri (.step hstep6 (.step hstep7 .zero))) + -- Time bound + -- h_rw ≤ c₁.output.head + 1 (hfo_head_bound) + -- h_ri = c_ri.input.head ≤ c₁.input.head + 1 (input moves by idleDir, which is stay for head ≥ 1) + -- Need: 1 + (h_rw + 2) + (h_ri + 2) = h_rw + h_ri + 5 ≤ c₁.output.head + c₁.input.head + 7 + -- Suffices: h_rw + h_ri ≤ c₁.output.head + c₁.input.head + 2, which holds. + -- Prove h_ri ≤ c₁.input.head + 1: + have hri_bound : h_ri ≤ c₁.input.head + 1 := by + -- c_rw.input.cells = c₁.input.cells (input cells preserved through step) + have hcrw_cells : c_rw.input.cells = c₁.input.cells := by + have := union_input_cells_of_step tm₁ tm₂ hstep1 + rw [this]; rfl + -- c_rw.input cells[≥1] ≠ Γ.start + have hcrw_ino : ∀ i, i ≥ 1 → c_rw.input.cells i ≠ Γ.start := by + intro i hi; rw [hcrw_cells, hinput_cells] + simp only [Tape.init, show i ≠ 0 from by omega, ↓reduceIte] + intro heq + cases hget : (x.map Γ.ofBool)[i - 1]? with + | none => simp [hget, Option.getD] at heq + | some v => + simp [hget, Option.getD] at heq; subst heq + have hmem := List.mem_of_getElem? hget + simp [List.mem_map] at hmem; rcases hmem with ⟨_, hb⟩ | ⟨_, hb⟩ <;> simp [Γ.ofBool] at hb + -- c_rw.input.head ≤ c₁.input.head + 1 + -- From step_inl_qhalt_cfg, the input direction is idleDir(input.read) + -- Use step_inl_qhalt_cfg to get the exact form of c_rw.input + have hstateq : (unionPhase1Cfg tm₁ tm₂ c₁).state = Sum.inl tm₁.qhalt := by + show Sum.inl c₁.state = Sum.inl tm₁.qhalt; rw [hhalt] + have hstep_eq := step_inl_qhalt_cfg tm₁ tm₂ hstateq + -- c_rw.input = c₁.input.move (idleDir c₁.input.read) since unionPhase1Cfg.input = c₁.input + have hcrw_input_eq : c_rw.input = c₁.input.move (idleDir c₁.input.read) := by + have heq : some c_rw = some _ := hstep1.symm.trans hstep_eq + simp only [Option.some.injEq] at heq + rw [heq]; rfl + -- c_rw.input.head ≤ c₁.input.head + 1 + have hcrw_head : c_rw.input.head ≤ c₁.input.head + 1 := by + rw [hcrw_input_eq]; cases (idleDir c₁.input.read) <;> simp [Tape.move]; omega + -- c_rw.input.head ≥ 1 + have hcrw_hge : c_rw.input.head ≥ 1 := by + rw [hcrw_input_eq] + by_cases hh : c₁.input.head = 0 + · have hread0 : c₁.input.read = Γ.start := by + rw [Tape.read, hh, hinput_cells]; simp [Tape.init] + rw [hread0, idleDir, if_pos rfl]; simp [Tape.move, hh] + · have hge : c₁.input.head ≥ 1 := by omega + have hc1_ino : ∀ i, i ≥ 1 → c₁.input.cells i ≠ Γ.start := by + intro i hi; rw [← hcrw_cells]; exact hcrw_ino i hi + rw [idleDir_stay_of_ge_one _ hge hc1_ino]; simp [Tape.move]; omega + -- Through rewind_fakeOut loop: input head preserved + have hat0_head : c_at0.input.head = c_rw.input.head := + hinp_at0 hcrw_hge hcrw_ino + -- c_at0.input.cells[≥1] ≠ start (preserved through reachesIn) + have hat0_ino : ∀ i, i ≥ 1 → c_at0.input.cells i ≠ Γ.start := by + intro i hi; rw [union_input_cells_of_reachesIn tm₁ tm₂ hreach_rw]; exact hcrw_ino i hi + -- c_cr.input.head = c_at0.input.head (idleDir step from head ≥ 1) + have hcr_head : c_cr.input.head = c_at0.input.head := by + show (c_at0.input.move (idleDir c_at0.input.read)).head = _ + exact idle_move_preserves_head _ (by omega) hat0_ino + -- c_ri.input.head = c_cr.input.head (idleDir step from head ≥ 1) + have hcr_ino : ∀ i, i ≥ 1 → c_cr.input.cells i ≠ Γ.start := by + intro i hi; show (c_at0.input.move _).cells i ≠ _; rw [Tape.move_cells]; exact hat0_ino i hi + have hri_head : c_ri.input.head = c_cr.input.head := by + show (c_cr.input.move (idleDir c_cr.input.read)).head = _ + exact idle_move_preserves_head _ (by omega) hcr_ino + -- Chain: h_ri = c_ri.input.head = c_rw.input.head ≤ c₁.input.head + 1 + omega + have htime : 1 + (h_rw + (1 + 1)) + (h_ri + (1 + 1)) ≤ c₁.output.head + c₁.input.head + 7 := by + omega + refine ⟨1 + (h_rw + (1 + 1)) + (h_ri + (1 + 1)), c_mid, ?_, hst_mid, hin_mid, hwork_mid, + hout_mid, htime⟩ + exact hreach_total + +-- ════════════════════════════════════════════════════════════════════════ +-- Phase 2: one-step correspondence +-- ════════════════════════════════════════════════════════════════════════ + +/-- Phase 2 compatibility: a union machine config agrees with a tm₂ config + on the active components (state, input, Phase 2 work tapes, output). -/ +structure UnionPhase2Compat (tm₁ : TM n₁) (tm₂ : TM n₂) + (c_u : Cfg (n₁ + 1 + n₂) (UnionQ tm₁.Q tm₂.Q)) + (c₂ : Cfg n₂ tm₂.Q) : Prop where + state_eq : c_u.state = Sum.inr (Sum.inr c₂.state) + input_eq : c_u.input = c₂.input + work_eq : ∀ j : Fin n₂, c_u.work ⟨n₁ + 1 + j.val, by omega⟩ = c₂.work j + output_eq : c_u.output = c₂.output + +/-- One step of the union machine on a Phase 2 compatible config preserves + compatibility. -/ +private theorem phase2_step_corr (tm₁ : TM n₁) (tm₂ : TM n₂) + {c₂ c₂' : Cfg n₂ tm₂.Q} (hstep : tm₂.step c₂ = some c₂') + {c_u : Cfg (n₁ + 1 + n₂) (UnionQ tm₁.Q tm₂.Q)} + (hcompat : UnionPhase2Compat tm₁ tm₂ c_u c₂) : + ∃ c_u', (unionTM tm₁ tm₂).step c_u = some c_u' ∧ + UnionPhase2Compat tm₁ tm₂ c_u' c₂' := by + have hne := state_ne_qhalt_of_step hstep + -- Extract c₂' from tm₂.step + simp only [step, hne, ↓reduceIte, Option.some.injEq] at hstep; subst hstep + -- c_u is not halted in the union machine + have hne_u : c_u.state ≠ (unionTM tm₁ tm₂).qhalt := by + rw [hcompat.state_eq, unionTM_qhalt]; exact fun h => hne (Sum.inr.inj (Sum.inr.inj h)) + -- Unfold the union step; `split` reduces the halting ite (the stored + -- decidability instance blocks `simp`/`rw [if_neg]` here), then pin the + -- explicit step-result config as the existential witness via `rfl`. + simp only [step] + split + · exact absurd ‹_› hne_u + refine ⟨_, rfl, ?_⟩ + -- Rewrite reads using UnionPhase2Compat + have hwork_reads : phase2WorkReads (fun i => (c_u.work i).read) = + fun j => (c₂.work j).read := by + ext ⟨j, hj⟩; simp only [phase2WorkReads]; exact congrArg Tape.read (hcompat.work_eq ⟨j, hj⟩) + -- Construct UnionPhase2Compat (state_eq, input_eq, output_eq all close; + -- work_eq needs dif reduction) + refine ⟨?_, ?_, fun ⟨j, hj⟩ => ?_, ?_⟩ <;> dsimp only [] <;> rw [hcompat.state_eq] <;> + simp only [unionTM_delta_inr_inr tm₁ tm₂ hne, hcompat.input_eq, hcompat.output_eq, hwork_reads] + have hgt : ¬((n₁ + 1 + j) ≤ n₁) := by omega + rw [dif_neg hgt] + have hfin : ∀ (p : n₁ + 1 + j - (n₁ + 1) < n₂), + (⟨n₁ + 1 + j - (n₁ + 1), p⟩ : Fin n₂) = ⟨j, hj⟩ := by + intro p; apply Fin.ext; show n₁ + 1 + j - (n₁ + 1) = j; omega + simp only [hfin, hcompat.work_eq ⟨j, hj⟩, dif_neg hgt] + +-- ════════════════════════════════════════════════════════════════════════ +-- Phase 2 simulation +-- ════════════════════════════════════════════════════════════════════════ + +/-- Multi-step Phase 2 simulation via step correspondence. -/ +private theorem phase2_steps (tm₁ : TM n₁) (tm₂ : TM n₂) + {t : ℕ} {c₂_start c₂_end : Cfg n₂ tm₂.Q} + (hreach : tm₂.reachesIn t c₂_start c₂_end) + {c_start : Cfg (n₁ + 1 + n₂) (UnionQ tm₁.Q tm₂.Q)} + (hcompat : UnionPhase2Compat tm₁ tm₂ c_start c₂_start) : + ∃ c_end, (unionTM tm₁ tm₂).reachesIn t c_start c_end ∧ + UnionPhase2Compat tm₁ tm₂ c_end c₂_end := by + induction hreach generalizing c_start with + | zero => exact ⟨c_start, .zero, hcompat⟩ + | step hstep _ ih => + obtain ⟨c_mid, hstep_u, hcompat_mid⟩ := phase2_step_corr tm₁ tm₂ hstep hcompat + obtain ⟨c_end, hreach_u, hcompat_end⟩ := ih hcompat_mid + exact ⟨c_end, .step hstep_u hreach_u, hcompat_end⟩ + +/-- **Phase 2 simulation**: if `tm₂` reaches `c₂` from `initCfg x` in + `t₂` steps, and the starting union config is compatible with `initCfg x`, + then the union machine reaches a config compatible with `c₂` in `t₂` steps. -/ +theorem unionTM_phase2_simulation (tm₁ : TM n₁) (tm₂ : TM n₂) (x : List Bool) + {t₂ : ℕ} {c₂ : Cfg n₂ tm₂.Q} + (hreach : tm₂.reachesIn t₂ (tm₂.initCfg x) c₂) + {c_start : Cfg (n₁ + 1 + n₂) (UnionQ tm₁.Q tm₂.Q)} + (hss : c_start.state = Sum.inr (Sum.inr tm₂.qstart)) + (hsi : c_start.input = Tape.init (x.map Γ.ofBool)) + (hsw : ∀ j : Fin n₂, c_start.work ⟨n₁ + 1 + j.val, by omega⟩ = Tape.init []) + (hso : c_start.output = Tape.init []) : + ∃ c_end, (unionTM tm₁ tm₂).reachesIn t₂ c_start c_end ∧ + c_end.state = Sum.inr (Sum.inr c₂.state) ∧ + c_end.output = c₂.output := by + have hcompat : UnionPhase2Compat tm₁ tm₂ c_start (tm₂.initCfg x) := + ⟨by rw [hss], hsi, hsw, hso⟩ + obtain ⟨c_end, hreach_u, hcompat_end⟩ := phase2_steps tm₁ tm₂ hreach hcompat + exact ⟨c_end, hreach_u, hcompat_end.state_eq, hcompat_end.output_eq⟩ + +-- ════════════════════════════════════════════════════════════════════════ + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/RetargetCompute.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/RetargetCompute.lean new file mode 100644 index 0000000000..52c6601f04 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/RetargetCompute.lean @@ -0,0 +1,166 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.RetargetCompute.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.RetargetCompute.Internal + +/-! +# Retargeted-input computation seams + +`TM.retargetInputStarted` runs a source machine on a virtual input held by its +last work tape when every participating head is already parked at cell `1`. +It absorbs the source machine's compulsory first transition from `▷`, making +the wrapper suitable as a later phase of `TM.seqTM`. + +The degenerate `qstart = qhalt` case is included: such a source computes only +the empty string, and the wrapper halts immediately without requiring a +positive advertised time bound. + +## Main results + +- `TM.retargetInputStarted_computesVirtual_exact` — exact saved-start time +- `TM.retargetInputStarted_computesVirtual` — same-time virtual computation +- `TM.retargetInputStarted_decidesVirtual` — same-time virtual decision +- `TM.retargetInputStarted_hoareTime` — Hoare form for phase composition +- `TM.placeWorkTM_retargetInputStarted_computesVirtual` — placed stable-frame seam +- `TM.placeWorkTM_retargetInputStarted_decidesVirtual` — placed decision seam +-/ + + +public section + +namespace Complexity + +namespace TM + +variable {k : ℕ} + +/-- The started wrapper and ordinary retargeted-input machine have identical +step functions. -/ +theorem retargetInputStarted_step_eq (M : TM k) (c : Cfg (k + 1) M.Q) : + (retargetInputStarted M).step c = (retargetInput M).step c := + retargetInputStarted_step_eq_internal M c + +/-- A run of `retargetInput M` is also a run of its started wrapper. -/ +theorem retargetInputStarted_reachesIn_of_retargetInput (M : TM k) + {t : ℕ} {c c' : Cfg (k + 1) M.Q} + (hreach : (retargetInput M).reachesIn t c c') : + (retargetInputStarted M).reachesIn t c c' := + retargetInputStarted_reachesIn_of_retargetInput_internal M hreach + +/-- For a non-halted source start state, the wrapper entry configuration is +exactly the retargeted embedding of the source's post-sentinel configuration. -/ +theorem retargetInputStartedCfg_eq_retargetWrap (M : TM k) + (y : List Bool) (realInput : Tape) (hne : M.qstart ≠ M.qhalt) : + retargetInputStartedCfg M y realInput = + retargetWrap M realInput (startedCfg M y hne) := + retargetInputStartedCfg_eq_retargetWrap_internal M y realInput hne + +/-- Exact virtual-input computation seam. A nondegenerate source run saves its +first transition; an initially halted source uses zero transitions. -/ +theorem retargetInputStarted_computesVirtual_exact (M : TM k) + {f : List Bool → List Bool} {T : ℕ → ℕ} + (hcomp : M.ComputesInTime f T) (y : List Bool) (realInput : Tape) : + ∃ (c' : Cfg (k + 1) M.Q) (t : ℕ), + t + (if M.qstart = M.qhalt then 0 else 1) ≤ T y.length ∧ + (retargetInputStarted M).reachesIn t + (retargetInputStartedCfg M y realInput) c' ∧ + (retargetInputStarted M).halted c' ∧ + c'.output.HasOutput (f y) := + retargetInputStarted_computesVirtual_exact_internal M hcomp y realInput + +/-- The started virtual-input wrapper computes within the source's advertised +time bound. -/ +theorem retargetInputStarted_computesVirtual (M : TM k) + {f : List Bool → List Bool} {T : ℕ → ℕ} + (hcomp : M.ComputesInTime f T) (y : List Bool) (realInput : Tape) : + ∃ (c' : Cfg (k + 1) M.Q) (t : ℕ), + t ≤ T y.length ∧ + (retargetInputStarted M).reachesIn t + (retargetInputStartedCfg M y realInput) c' ∧ + (retargetInputStarted M).halted c' ∧ + c'.output.HasOutput (f y) := + retargetInputStarted_computesVirtual_internal M hcomp y realInput + +/-- The started virtual-input wrapper retains a source decider's two verdict +implications within the source's advertised time bound. -/ +theorem retargetInputStarted_decidesVirtual (M : TM k) + {L : Language} {T : ℕ → ℕ} + (hdec : M.DecidesInTime L T) (y : List Bool) (realInput : Tape) : + ∃ (c' : Cfg (k + 1) M.Q) (t : ℕ), + t ≤ T y.length ∧ + (retargetInputStarted M).reachesIn t + (retargetInputStartedCfg M y realInput) c' ∧ + (retargetInputStarted M).halted c' ∧ + (y ∈ L → c'.output.cells 1 = Γ.one) ∧ + (y ∉ L → c'.output.cells 1 = Γ.zero) := + retargetInputStarted_decidesVirtual_internal M hdec y realInput + +/-- Hoare form of the same-time virtual-input seam. The real input is ignored; +the work and output tapes have the canonical already-started shapes. -/ +theorem retargetInputStarted_hoareTime (M : TM k) + {f : List Bool → List Bool} {T : ℕ → ℕ} + (hcomp : M.ComputesInTime f T) (y : List Bool) : + (retargetInputStarted M).HoareTime + (fun inp work out => + work = (retargetInputStartedCfg M y inp).work ∧ + out = (Tape.init []).move Dir3.right) + (fun _inp _work out => out.HasOutput (f y)) + (T y.length) := + retargetInputStarted_hoareTime_internal M hcomp y + +/-- Placed virtual-input computation with an exact preserved prefix/suffix +frame. The middle block contains the source scratch tapes and virtual input. +Every extra tape satisfying the standard start invariant at a positive head +position is unchanged in the final `placeWorkCfg` endpoint. -/ +theorem placeWorkTM_retargetInputStarted_computesVirtual (M : TM k) + (pre post : ℕ) (extras : Fin (pre + (k + 1) + post) → Tape) + {f : List Bool → List Bool} {T : ℕ → ℕ} + (hcomp : M.ComputesInTime f T) (y : List Bool) (realInput : Tape) + (hinv : ∀ i, ¬placeWorkInMiddle pre (k + 1) i → + Tape.StartInvariant (extras i)) + (hhead : ∀ i, ¬placeWorkInMiddle pre (k + 1) i → + 1 ≤ (extras i).head) : + ∃ (c' : Cfg (k + 1) M.Q) + (C' : Cfg (pre + (k + 1) + post) + (placeWorkTM pre post (retargetInputStarted M)).Q) (t : ℕ), + t ≤ T y.length ∧ + (placeWorkTM pre post (retargetInputStarted M)).reachesIn t + (placeWorkCfg (retargetInputStarted M) pre post extras + (retargetInputStartedCfg M y realInput)) C' ∧ + C' = placeWorkCfg (retargetInputStarted M) pre post extras c' ∧ + (placeWorkTM pre post (retargetInputStarted M)).halted C' ∧ + C'.output.HasOutput (f y) := + placeWorkTM_retargetInputStarted_computesVirtual_internal M pre post extras + hcomp y realInput hinv hhead + +/-- Placed virtual-input decision with an exact preserved prefix/suffix frame. -/ +theorem placeWorkTM_retargetInputStarted_decidesVirtual (M : TM k) + (pre post : ℕ) (extras : Fin (pre + (k + 1) + post) → Tape) + {L : Language} {T : ℕ → ℕ} + (hdec : M.DecidesInTime L T) (y : List Bool) (realInput : Tape) + (hinv : ∀ i, ¬placeWorkInMiddle pre (k + 1) i → + Tape.StartInvariant (extras i)) + (hhead : ∀ i, ¬placeWorkInMiddle pre (k + 1) i → + 1 ≤ (extras i).head) : + ∃ (c' : Cfg (k + 1) M.Q) + (C' : Cfg (pre + (k + 1) + post) + (placeWorkTM pre post (retargetInputStarted M)).Q) (t : ℕ), + t ≤ T y.length ∧ + (placeWorkTM pre post (retargetInputStarted M)).reachesIn t + (placeWorkCfg (retargetInputStarted M) pre post extras + (retargetInputStartedCfg M y realInput)) C' ∧ + C' = placeWorkCfg (retargetInputStarted M) pre post extras c' ∧ + (placeWorkTM pre post (retargetInputStarted M)).halted C' ∧ + (y ∈ L → C'.output.cells 1 = Γ.one) ∧ + (y ∉ L → C'.output.cells 1 = Γ.zero) := + placeWorkTM_retargetInputStarted_decidesVirtual_internal M pre post extras + hdec y realInput hinv hhead + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/RetargetCompute/Defs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/RetargetCompute/Defs.lean new file mode 100644 index 0000000000..899917810c --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/RetargetCompute/Defs.lean @@ -0,0 +1,91 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators + +/-! +# Retargeted-input computation seams + +An ordinary machine begins with every head on `▷`; its first transition moves +all heads right and may also change the control state. A phase-composed machine +usually enters its next phase with tapes already parked at cell `1`. This file +defines an executable wrapper that resumes a machine after that compulsory +sentinel transition while reading its input from the last work tape. + +## Main definitions + +- `TM.retargetInputStartState` — control state after the sentinel transition +- `TM.retargetInputStarted` — virtual-input machine entered with heads at cell `1` +- `TM.retargetInputStartedCfg` — canonical entry configuration for a virtual input +-/ + + +@[expose] public section + +namespace Complexity + +namespace TM + +variable {k : ℕ} + +/-- The source control state produced by its first transition from the all-`▷` +initial head positions. -/ +def retargetInputStartState (M : TM k) : M.Q := + (M.δ M.qstart Γ.start (fun _ => Γ.start) Γ.start).1 + +/-- Read the source input from work tape `k`, starting from the already-parked +post-sentinel configuration. If the source starts halted, the wrapper also +starts halted; otherwise its start state is `retargetInputStartState M`. + +The transition function and halt state are exactly those of `retargetInput M`. -/ +def retargetInputStarted (M : TM k) : TM (k + 1) where + Q := M.Q + qstart := if M.qstart = M.qhalt then M.qhalt else retargetInputStartState M + qhalt := M.qhalt + δ := (retargetInput M).δ + δ_right_of_start := (retargetInput M).δ_right_of_start + +/-- Canonical phase-entry configuration for `retargetInputStarted M`: virtual +input `y` is on the last work tape at head `1`; source work tapes and the real +output are parked and blank. The ignored real input tape is arbitrary. -/ +def retargetInputStartedCfg (M : TM k) (y : List Bool) (realInput : Tape) : + Cfg (k + 1) (retargetInputStarted M).Q where + state := (retargetInputStarted M).qstart + input := realInput + work := fun i => + if i.val < k then (Tape.init []).move Dir3.right + else (Tape.init (y.map Γ.ofBool)).move Dir3.right + output := (Tape.init []).move Dir3.right + +@[simp] theorem retargetInputStartedCfg_state (M : TM k) (y : List Bool) + (realInput : Tape) : + (retargetInputStartedCfg M y realInput).state = (retargetInputStarted M).qstart := rfl + +@[simp] theorem retargetInputStartedCfg_input (M : TM k) (y : List Bool) + (realInput : Tape) : + (retargetInputStartedCfg M y realInput).input = realInput := rfl + +@[simp] theorem retargetInputStartedCfg_output (M : TM k) (y : List Bool) + (realInput : Tape) : + (retargetInputStartedCfg M y realInput).output = + (Tape.init []).move Dir3.right := rfl + +theorem retargetInputStartedCfg_work_lt (M : TM k) (y : List Bool) + (realInput : Tape) (i : Fin (k + 1)) (h : i.val < k) : + (retargetInputStartedCfg M y realInput).work i = + (Tape.init []).move Dir3.right := by + simp [retargetInputStartedCfg, h] + +@[simp] theorem retargetInputStartedCfg_work_last (M : TM k) (y : List Bool) + (realInput : Tape) : + (retargetInputStartedCfg M y realInput).work ⟨k, by omega⟩ = + (Tape.init (y.map Γ.ofBool)).move Dir3.right := by + simp [retargetInputStartedCfg] + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/RetargetCompute/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/RetargetCompute/Internal.lean new file mode 100644 index 0000000000..792ecaae01 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/RetargetCompute/Internal.lean @@ -0,0 +1,286 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.RetargetCompute.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.Internal.Retarget +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Placement.Internal + +/-! +# Retargeted-input computation seam internals + +This file proves that `TM.retargetInputStarted` resumes an ordinary source run +after its compulsory sentinel transition. The already-halted case is handled +separately: such a machine can compute only the empty output, and the wrapper +therefore halts immediately on its parked blank output tape. +-/ + + +public section + +namespace Complexity + +namespace TM + +variable {k : ℕ} + +/-- The started wrapper has exactly the same transition behavior as the +ordinary retargeted-input machine. -/ +theorem retargetInputStarted_step_eq_internal (M : TM k) + (c : Cfg (k + 1) M.Q) : + (retargetInputStarted M).step c = (retargetInput M).step c := by + rfl + +/-- Any bounded run of the ordinary retargeted-input machine is also a run of +the started wrapper. -/ +theorem retargetInputStarted_reachesIn_of_retargetInput_internal (M : TM k) + {t : ℕ} {c c' : Cfg (k + 1) M.Q} + (hreach : (retargetInput M).reachesIn t c c') : + (retargetInputStarted M).reachesIn t c c' := by + apply reachesIn_map (tm := retargetInput M) (tm' := retargetInputStarted M) + (fun c => c) _ hreach + intro c₀ c₁ hstep + change (retargetInputStarted M).step c₀ = some c₁ + rw [retargetInputStarted_step_eq_internal] + exact hstep + +/-- In the nondegenerate case, the wrapper start state is exactly the source +state after its first transition from the all-sentinel configuration. -/ +theorem retargetInputStarted_qstart_eq_startedCfg_state_internal (M : TM k) + (y : List Bool) (hne : M.qstart ≠ M.qhalt) : + (retargetInputStarted M).qstart = (startedCfg M y hne).state := by + simp [retargetInputStarted, retargetInputStartState, startedCfg, TM.step, hne, + Tape.read, Tape.init] + +/-- In the nondegenerate case, the canonical wrapper entry is the ordinary +`retargetWrap` of the source's exact post-sentinel configuration. -/ +theorem retargetInputStartedCfg_eq_retargetWrap_internal (M : TM k) + (y : List Bool) (realInput : Tape) (hne : M.qstart ≠ M.qhalt) : + retargetInputStartedCfg M y realInput = + retargetWrap M realInput (startedCfg M y hne) := by + refine Cfg.ext ?_ rfl ?_ ?_ + · exact retargetInputStarted_qstart_eq_startedCfg_state_internal M y hne + · funext i + by_cases hi : i.val < k + · rw [retargetInputStartedCfg_work_lt M y realInput i hi, + retargetWrap_work_lt M realInput _ i hi] + exact (startedCfg_work_eq_init_move_right M y hne ⟨i.val, hi⟩).symm + · have hval : i.val = k := by omega + have hilast : i = ⟨k, by omega⟩ := by + apply Fin.ext + exact hval + rw [hilast] + rw [retargetInputStartedCfg_work_last, retargetWrap_work_last, + startedCfg_input_eq] + · rw [retargetInputStartedCfg_output, retargetWrap_output, + startedCfg_output_eq_init_move_right] + +/-- An initially halted machine that computes a function can only compute the +empty string. -/ +private theorem computes_eq_nil_of_qstart_eq_qhalt (M : TM k) + {f : List Bool → List Bool} {T : ℕ → ℕ} + (hcomp : M.ComputesInTime f T) (heq : M.qstart = M.qhalt) (y : List Bool) : + f y = [] := by + obtain ⟨c', t, _ht, hreach, _hhalt, hout⟩ := hcomp y + have hinit : M.halted (M.initCfg y) := by + simpa [TM.halted, Cfg.isHalted] using heq + have ht0 : t = 0 := by + have hle := M.reachesIn_le_halt hreach + (TM.reachesIn.zero : M.reachesIn 0 (M.initCfg y) (M.initCfg y)) hinit + omega + subst t + cases hreach + cases hy : f y with + | nil => rfl + | cons bit bits => + have hcell := hout.1 0 (by simp [hy]) + simp [hy, Tape.init] at hcell + exact (False.elim ((Γ.ofBool_ne_blank bit) hcell.symm)) + +/-- Exact virtual-input computation seam. The result time omits the source's +first transition when that transition exists; an initially halted source uses +zero steps. -/ +theorem retargetInputStarted_computesVirtual_exact_internal (M : TM k) + {f : List Bool → List Bool} {T : ℕ → ℕ} + (hcomp : M.ComputesInTime f T) (y : List Bool) (realInput : Tape) : + ∃ (c' : Cfg (k + 1) M.Q) (t : ℕ), + t + (if M.qstart = M.qhalt then 0 else 1) ≤ T y.length ∧ + (retargetInputStarted M).reachesIn t + (retargetInputStartedCfg M y realInput) c' ∧ + (retargetInputStarted M).halted c' ∧ + c'.output.HasOutput (f y) := by + by_cases heq : M.qstart = M.qhalt + · have hfy := computes_eq_nil_of_qstart_eq_qhalt M hcomp heq y + refine ⟨retargetInputStartedCfg M y realInput, 0, ?_, .zero, ?_, ?_⟩ + · simp [heq] + · show (retargetInputStarted M).qstart = (retargetInputStarted M).qhalt + simp [retargetInputStarted, heq] + · rw [hfy] + simp [Tape.HasOutput, Tape.init, Tape.move] + · obtain ⟨cM, t, ht, hreach, hhalt, hout⟩ := hcomp y + have ht_ne : t ≠ 0 := by + intro ht0 + subst t + cases hreach + exact heq hhalt + obtain ⟨t', rfl⟩ := Nat.exists_eq_succ_of_ne_zero ht_ne + cases hreach with + | step hstep hrest => + next cMid => + have hmid : cMid = startedCfg M y heq := by + have hs : some cMid = some (startedCfg M y heq) := by + rw [← hstep, step_initCfg_startedCfg M y heq] + exact Option.some.inj hs + subst cMid + have hinitIn : Tape.StartInvariant (M.initCfg y).input := + Tape.StartInvariant.init_ofBool y + have hinitWork : ∀ i, Tape.StartInvariant ((M.initCfg y).work i) := + fun _ => Tape.StartInvariant.init_nil + have hinitOut : Tape.StartInvariant (M.initCfg y).output := + Tape.StartInvariant.init_nil + obtain ⟨hinv, hworkInv, houtInv⟩ := Tape.StartInvariant.step M + (step_initCfg_startedCfg M y heq) hinitIn hinitWork hinitOut + obtain ⟨finalReal, hsim⟩ := retargetInput_reachesIn_of_reachesIn M hrest + hinv hworkInv houtInv realInput + let c' := retargetWrap M finalReal cM + have hsim' : (retargetInputStarted M).reachesIn t' + (retargetInputStartedCfg M y realInput) c' := by + rw [retargetInputStartedCfg_eq_retargetWrap_internal M y realInput heq] + exact retargetInputStarted_reachesIn_of_retargetInput_internal M hsim + refine ⟨c', t', ?_, hsim', ?_, ?_⟩ + · simp [heq] + omega + · show cM.state = M.qhalt + exact hhalt + · show cM.output.HasOutput (f y) + exact hout + +/-- Same-time form of the virtual-input computation seam. -/ +theorem retargetInputStarted_computesVirtual_internal (M : TM k) + {f : List Bool → List Bool} {T : ℕ → ℕ} + (hcomp : M.ComputesInTime f T) (y : List Bool) (realInput : Tape) : + ∃ (c' : Cfg (k + 1) M.Q) (t : ℕ), + t ≤ T y.length ∧ + (retargetInputStarted M).reachesIn t + (retargetInputStartedCfg M y realInput) c' ∧ + (retargetInputStarted M).halted c' ∧ + c'.output.HasOutput (f y) := by + obtain ⟨c', t, ht, hreach, hhalt, hout⟩ := + retargetInputStarted_computesVirtual_exact_internal M hcomp y realInput + exact ⟨c', t, by omega, hreach, hhalt, hout⟩ + +/-- A decider run can be resumed on a virtual input with the same advertised +time bound while retaining both verdict implications. -/ +theorem retargetInputStarted_decidesVirtual_internal (M : TM k) + {L : Language} {T : ℕ → ℕ} + (hdec : M.DecidesInTime L T) (y : List Bool) (realInput : Tape) : + ∃ (c' : Cfg (k + 1) M.Q) (t : ℕ), + t ≤ T y.length ∧ + (retargetInputStarted M).reachesIn t + (retargetInputStartedCfg M y realInput) c' ∧ + (retargetInputStarted M).halted c' ∧ + (y ∈ L → c'.output.cells 1 = Γ.one) ∧ + (y ∉ L → c'.output.cells 1 = Γ.zero) := by + obtain ⟨c', t, ht, hreach, hhalt, hyes, hno⟩ := + retargetInput_decidesVirtual_started M hdec y realInput + refine ⟨c', t, by omega, ?_, hhalt, hyes, hno⟩ + rw [retargetInputStartedCfg_eq_retargetWrap_internal M y realInput + (qstart_ne_qhalt_of_decidesInTime M hdec)] + exact retargetInputStarted_reachesIn_of_retargetInput_internal M hreach + +/-- Hoare form of the same-time virtual-input seam. -/ +theorem retargetInputStarted_hoareTime_internal (M : TM k) + {f : List Bool → List Bool} {T : ℕ → ℕ} + (hcomp : M.ComputesInTime f T) (y : List Bool) : + (retargetInputStarted M).HoareTime + (fun inp work out => + work = (retargetInputStartedCfg M y inp).work ∧ + out = (Tape.init []).move Dir3.right) + (fun _inp _work out => out.HasOutput (f y)) + (T y.length) := by + intro inp work out hpre + obtain ⟨c', t, ht, hreach, hhalt, hout⟩ := + retargetInputStarted_computesVirtual_internal M hcomp y inp + have hstart : + ({ state := (retargetInputStarted M).qstart, input := inp, + work := work, output := out } : Cfg (k + 1) M.Q) = + retargetInputStartedCfg M y inp := by + exact Cfg.ext rfl rfl hpre.1 hpre.2 + refine ⟨c', t, ht, ?_, hhalt, hout⟩ + convert hreach using 1 + +/-- Combined placement seam with an exact preserved physical frame. The source +work tapes and virtual input occupy the placed middle block; all prefix and +suffix tapes are returned unchanged. -/ +theorem placeWorkTM_retargetInputStarted_computesVirtual_internal (M : TM k) + (pre post : ℕ) (extras : Fin (pre + (k + 1) + post) → Tape) + {f : List Bool → List Bool} {T : ℕ → ℕ} + (hcomp : M.ComputesInTime f T) (y : List Bool) (realInput : Tape) + (hinv : ∀ i, ¬placeWorkInMiddle pre (k + 1) i → + Tape.StartInvariant (extras i)) + (hhead : ∀ i, ¬placeWorkInMiddle pre (k + 1) i → + 1 ≤ (extras i).head) : + ∃ (c' : Cfg (k + 1) M.Q) + (C' : Cfg (pre + (k + 1) + post) + (placeWorkTM pre post (retargetInputStarted M)).Q) (t : ℕ), + t ≤ T y.length ∧ + (placeWorkTM pre post (retargetInputStarted M)).reachesIn t + (placeWorkCfg (retargetInputStarted M) pre post extras + (retargetInputStartedCfg M y realInput)) C' ∧ + C' = placeWorkCfg (retargetInputStarted M) pre post extras c' ∧ + (placeWorkTM pre post (retargetInputStarted M)).halted C' ∧ + C'.output.HasOutput (f y) := by + obtain ⟨c', t, ht, hreach, hhalt, hout⟩ := + retargetInputStarted_computesVirtual_internal M hcomp y realInput + let C' := placeWorkCfg (retargetInputStarted M) pre post extras c' + refine ⟨c', C', t, ht, ?_, rfl, ?_, ?_⟩ + · apply placeWorkTM_reachesIn_placeWorkCfg_stable_internal _ pre post extras hreach + intro i hi + show (extras i).cells (extras i).head ≠ Γ.start + exact (hinv i hi).2 (extras i).head (hhead i hi) + · show c'.state = (retargetInputStarted M).qhalt + exact hhalt + · show c'.output.HasOutput (f y) + exact hout + +/-- Placed virtual-input decision with an exact preserved physical frame. -/ +theorem placeWorkTM_retargetInputStarted_decidesVirtual_internal (M : TM k) + (pre post : ℕ) (extras : Fin (pre + (k + 1) + post) → Tape) + {L : Language} {T : ℕ → ℕ} + (hdec : M.DecidesInTime L T) (y : List Bool) (realInput : Tape) + (hinv : ∀ i, ¬placeWorkInMiddle pre (k + 1) i → + Tape.StartInvariant (extras i)) + (hhead : ∀ i, ¬placeWorkInMiddle pre (k + 1) i → + 1 ≤ (extras i).head) : + ∃ (c' : Cfg (k + 1) M.Q) + (C' : Cfg (pre + (k + 1) + post) + (placeWorkTM pre post (retargetInputStarted M)).Q) (t : ℕ), + t ≤ T y.length ∧ + (placeWorkTM pre post (retargetInputStarted M)).reachesIn t + (placeWorkCfg (retargetInputStarted M) pre post extras + (retargetInputStartedCfg M y realInput)) C' ∧ + C' = placeWorkCfg (retargetInputStarted M) pre post extras c' ∧ + (placeWorkTM pre post (retargetInputStarted M)).halted C' ∧ + (y ∈ L → C'.output.cells 1 = Γ.one) ∧ + (y ∉ L → C'.output.cells 1 = Γ.zero) := by + obtain ⟨c', t, ht, hreach, hhalt, hyes, hno⟩ := + retargetInputStarted_decidesVirtual_internal M hdec y realInput + let C' := placeWorkCfg (retargetInputStarted M) pre post extras c' + refine ⟨c', C', t, ht, ?_, rfl, ?_, ?_, ?_⟩ + · apply placeWorkTM_reachesIn_placeWorkCfg_stable_internal _ pre post extras hreach + intro i hi + show (extras i).cells (extras i).head ≠ Γ.start + exact (hinv i hi).2 (extras i).head (hhead i hi) + · show c'.state = (retargetInputStarted M).qhalt + exact hhalt + · show y ∈ L → c'.output.cells 1 = Γ.one + exact hyes + · show y ∉ L → c'.output.cells 1 = Γ.zero + exact hno + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/WorkBranch.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/WorkBranch.lean new file mode 100644 index 0000000000..dec41d2fc2 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/WorkBranch.lean @@ -0,0 +1,206 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.WorkBranch.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.WorkBranch.Internal + +/-! +# Direct work-symbol branch combinator + +`TM.branchWorkBlankTM idx onBlank onNonblank` reads one work-tape symbol and +runs `onBlank` exactly on blank, or `onNonblank` on any other symbol. The +dispatcher performs one framed, tape-preserving step. It never writes a test +result to the output tape, and branch simulation adds no trailing seam step. + +The preservation results require every head to be off the left marker. This +is the necessary boundary condition imposed by the one-sided tape model: +heads reading `▷` must move right. + +## Main results + +- `TM.branchWorkBlankTM_reachesIn_blank_frame` and its nonblank counterpart + give exact selected-branch execution and literal tape frames. +- `TM.branchWorkBlankTM_hoareTime` composes two branch contracts with one + dispatch step. +- `TM.branchWorkBlankTM_hoareTimeSpace` preserves the maximum branch budget. +- `Tape.HasBinaryNat.read_eq_blank_iff` specializes blank dispatch to + canonical binary zero. +- `TM.IsTransducer.branchWorkBlankTM` preserves one-way output behavior. +-/ + + +public section + +namespace Complexity + +namespace Tape + +/-- A canonical little-endian natural reads blank exactly when its value is +zero. Consequently the direct blank/nonblank work branch is a canonical +zero/nonzero branch on `HasBinaryNat` tapes. -/ +theorem HasBinaryNat.read_eq_blank_iff {t : Tape} {value : ℕ} + (h : t.HasBinaryNat value) : + t.read = Γ.blank ↔ value = 0 := + h.read_eq_blank_iff_internal + +end Tape + +namespace TM + +variable {n : ℕ} + +/-- Blank dispatch takes one step, selects the blank branch, and preserves +all tapes exactly. -/ +theorem branchWorkBlankTM_dispatch_blank + (idx : Fin n) (onBlank onNonblank : TM n) + (inp : Tape) (work : Fin n → Tape) (out : Tape) + (hblank : (work idx).read = Γ.blank) + (hinp : inp.read ≠ Γ.start) (hwork : ∀ i, (work i).read ≠ Γ.start) + (hout : out.read ≠ Γ.start) : + (branchWorkBlankTM idx onBlank onNonblank).step + { state := (branchWorkBlankTM idx onBlank onNonblank).qstart + input := inp + work := work + output := out } = + some + { state := workBranchBlankState onBlank onNonblank onBlank.qstart + input := inp + work := work + output := out } := by + simpa [workBranchBlankWrap] using + branchWorkBlankTM_dispatch_blank_internal idx onBlank onNonblank + inp work out hblank hinp hwork hout + +/-- Nonblank dispatch takes one step, selects the nonblank branch, and +preserves all tapes exactly. -/ +theorem branchWorkBlankTM_dispatch_nonblank + (idx : Fin n) (onBlank onNonblank : TM n) + (inp : Tape) (work : Fin n → Tape) (out : Tape) + (hnonblank : (work idx).read ≠ Γ.blank) + (hinp : inp.read ≠ Γ.start) (hwork : ∀ i, (work i).read ≠ Γ.start) + (hout : out.read ≠ Γ.start) : + (branchWorkBlankTM idx onBlank onNonblank).step + { state := (branchWorkBlankTM idx onBlank onNonblank).qstart + input := inp + work := work + output := out } = + some + { state := workBranchNonblankState onBlank onNonblank + onNonblank.qstart + input := inp + work := work + output := out } := by + simpa [workBranchNonblankWrap] using + branchWorkBlankTM_dispatch_nonblank_internal idx onBlank onNonblank + inp work out hnonblank hinp hwork hout + +/-- Exact framed execution through the blank branch. The combined controller +uses one dispatch transition followed by the branch's exact `t` transitions. -/ +theorem branchWorkBlankTM_reachesIn_blank_frame + (idx : Fin n) (onBlank onNonblank : TM n) + (inp : Tape) (work : Fin n → Tape) (out : Tape) + {t : ℕ} {c' : Cfg n onBlank.Q} + (hblank : (work idx).read = Γ.blank) + (hinp : inp.read ≠ Γ.start) (hwork : ∀ i, (work i).read ≠ Γ.start) + (hout : out.read ≠ Γ.start) + (hreach : onBlank.reachesIn t + { state := onBlank.qstart, input := inp, work := work, output := out } c') + (hhalt : onBlank.halted c') : + ∃ C, + (branchWorkBlankTM idx onBlank onNonblank).reachesIn (t + 1) + { state := (branchWorkBlankTM idx onBlank onNonblank).qstart + input := inp + work := work + output := out } C ∧ + (branchWorkBlankTM idx onBlank onNonblank).halted C ∧ + C.input = c'.input ∧ C.work = c'.work ∧ C.output = c'.output := + branchWorkBlankTM_reachesIn_blank_frame_internal idx onBlank onNonblank + inp work out hblank hinp hwork hout hreach hhalt + +/-- Exact framed execution through the nonblank branch. -/ +theorem branchWorkBlankTM_reachesIn_nonblank_frame + (idx : Fin n) (onBlank onNonblank : TM n) + (inp : Tape) (work : Fin n → Tape) (out : Tape) + {t : ℕ} {c' : Cfg n onNonblank.Q} + (hnonblank : (work idx).read ≠ Γ.blank) + (hinp : inp.read ≠ Γ.start) (hwork : ∀ i, (work i).read ≠ Γ.start) + (hout : out.read ≠ Γ.start) + (hreach : onNonblank.reachesIn t + { state := onNonblank.qstart, input := inp, work := work, output := out } c') + (hhalt : onNonblank.halted c') : + ∃ C, + (branchWorkBlankTM idx onBlank onNonblank).reachesIn (t + 1) + { state := (branchWorkBlankTM idx onBlank onNonblank).qstart + input := inp + work := work + output := out } C ∧ + (branchWorkBlankTM idx onBlank onNonblank).halted C ∧ + C.input = c'.input ∧ C.work = c'.work ∧ C.output = c'.output := + branchWorkBlankTM_reachesIn_nonblank_frame_internal idx onBlank onNonblank + inp work out hnonblank hinp hwork hout hreach hhalt + +/-- Compose two time-bounded branch contracts. The precondition supplies the +off-marker frame and translates the initial read into the selected branch's +precondition. The postcondition records which branch contract completed. -/ +theorem branchWorkBlankTM_hoareTime + (idx : Fin n) (onBlank onNonblank : TM n) + {pre blankPre nonblankPre blankPost nonblankPost : TapePred n} + {blankTime nonblankTime : ℕ} + (hframe : ∀ inp work out, pre inp work out → + inp.read ≠ Γ.start ∧ (∀ i, (work i).read ≠ Γ.start) ∧ + out.read ≠ Γ.start) + (hblankPre : ∀ inp work out, pre inp work out → + (work idx).read = Γ.blank → blankPre inp work out) + (hnonblankPre : ∀ inp work out, pre inp work out → + (work idx).read ≠ Γ.blank → nonblankPre inp work out) + (hblank : onBlank.HoareTime blankPre blankPost blankTime) + (hnonblank : onNonblank.HoareTime nonblankPre nonblankPost nonblankTime) : + (branchWorkBlankTM idx onBlank onNonblank).HoareTime pre + (fun inp work out => + blankPost inp work out ∨ nonblankPost inp work out) + (branchWorkBlankTime blankTime nonblankTime) := + branchWorkBlankTM_hoareTime_internal idx onBlank onNonblank hframe + hblankPre hnonblankPre hblank hnonblank + +/-- Compose two time-and-space branch contracts. Dispatch preserves the +starting tapes, so the all-reachable space bound is exactly the maximum of the +two branch budgets rather than an additional seam allowance. -/ +theorem branchWorkBlankTM_hoareTimeSpace + (idx : Fin n) (onBlank onNonblank : TM n) + {pre blankPre nonblankPre blankPost nonblankPost : TapePred n} + {blankTime nonblankTime inputLength blankSpace nonblankSpace : ℕ} + (hframe : ∀ inp work out, pre inp work out → + inp.read ≠ Γ.start ∧ (∀ i, (work i).read ≠ Γ.start) ∧ + out.read ≠ Γ.start) + (hblankPre : ∀ inp work out, pre inp work out → + (work idx).read = Γ.blank → blankPre inp work out) + (hnonblankPre : ∀ inp work out, pre inp work out → + (work idx).read ≠ Γ.blank → nonblankPre inp work out) + (hblank : onBlank.HoareTimeSpace blankPre blankPost blankTime + inputLength blankSpace) + (hnonblank : onNonblank.HoareTimeSpace nonblankPre nonblankPost + nonblankTime inputLength nonblankSpace) : + (branchWorkBlankTM idx onBlank onNonblank).HoareTimeSpace pre + (fun inp work out => + blankPost inp work out ∨ nonblankPost inp work out) + (branchWorkBlankTime blankTime nonblankTime) inputLength + (max blankSpace nonblankSpace) := + branchWorkBlankTM_hoareTimeSpace_internal idx onBlank onNonblank hframe + hblankPre hnonblankPre hblank hnonblank + +/-- Direct work branching preserves one-way output when both selected +branches do. The dispatch step itself never moves the output head left. -/ +theorem IsTransducer.branchWorkBlankTM + {idx : Fin n} {onBlank onNonblank : TM n} + (hblank : onBlank.IsTransducer) + (hnonblank : onNonblank.IsTransducer) : + (branchWorkBlankTM idx onBlank onNonblank).IsTransducer := + hblank.branchWorkBlankTM_internal hnonblank + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/WorkBranch/Defs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/WorkBranch/Defs.lean new file mode 100644 index 0000000000..518c1fd494 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/WorkBranch/Defs.lean @@ -0,0 +1,114 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators + +/-! +# Direct work-symbol branch combinator -- definitions + +`TM.branchWorkBlankTM idx onBlank onNonblank` inspects work tape `idx` once. +A blank selects `onBlank`; every other symbol selects `onNonblank`. The +dispatcher uses the ordinary read-back action on every tape and never uses the +output tape as control storage. +-/ + + +@[expose] public section + +namespace Complexity + +namespace TM + +/-- Finite driver states for direct work-symbol branching. -/ +inductive WorkBranchPhase where + | dispatch + | done + deriving DecidableEq + +/-- `WorkBranchPhase` has exactly two states. -/ +instance instFintypeWorkBranchPhase : Fintype WorkBranchPhase where + elems := {.dispatch, .done} + complete := fun phase => by cases phase <;> simp + +/-- State space of a direct work-symbol branch. -/ +abbrev WorkBranchQ (QBlank QNonblank : Type) := + WorkBranchPhase ⊕ (QBlank ⊕ QNonblank) + +/-- Embed a blank-branch state, collapsing its halt state to the shared halt. -/ +def workBranchBlankState {n : ℕ} (onBlank onNonblank : TM n) + (q : onBlank.Q) : WorkBranchQ onBlank.Q onNonblank.Q := + if q = onBlank.qhalt then .inl .done else .inr (.inl q) + +/-- Embed a nonblank-branch state, collapsing its halt state to the shared halt. -/ +def workBranchNonblankState {n : ℕ} (onBlank onNonblank : TM n) + (q : onNonblank.Q) : WorkBranchQ onBlank.Q onNonblank.Q := + if q = onNonblank.qhalt then .inl .done else .inr (.inr q) + +/-- Uniform time bound for a one-step dispatch followed by either branch. -/ +def branchWorkBlankTime (blankTime nonblankTime : ℕ) : ℕ := + 1 + max blankTime nonblankTime + +/-- Inspect one work symbol and run the selected branch on the same tapes. + +The dispatcher selects `onBlank` exactly when `wHeads idx = Γ.blank` and +otherwise selects `onNonblank`. Branch halt states are collapsed into the +shared halt state on the same simulated transition, so there is no trailing +seam step and no extra tape action after a branch halts. -/ +def branchWorkBlankTM {n : ℕ} (idx : Fin n) + (onBlank onNonblank : TM n) : TM n where + Q := WorkBranchQ onBlank.Q onNonblank.Q + qstart := .inl .dispatch + qhalt := .inl .done + δ := fun state iHead wHeads oHead => + match state with + | .inl .dispatch => + if wHeads idx = Γ.blank then + allReadBack + (workBranchBlankState onBlank onNonblank onBlank.qstart) + iHead wHeads oHead + else + allReadBack + (workBranchNonblankState onBlank onNonblank onNonblank.qstart) + iHead wHeads oHead + | .inl .done => allIdle (.inl .done) iHead wHeads oHead + | .inr (.inl q) => + if q = onBlank.qhalt then + allIdle (.inl .done) iHead wHeads oHead + else + let (q', workWrites, outputWrite, inputDir, workDirs, outputDir) := + onBlank.δ q iHead wHeads oHead + (workBranchBlankState onBlank onNonblank q', workWrites, + outputWrite, inputDir, workDirs, outputDir) + | .inr (.inr q) => + if q = onNonblank.qhalt then + allIdle (.inl .done) iHead wHeads oHead + else + let (q', workWrites, outputWrite, inputDir, workDirs, outputDir) := + onNonblank.δ q iHead wHeads oHead + (workBranchNonblankState onBlank onNonblank q', workWrites, + outputWrite, inputDir, workDirs, outputDir) + δ_right_of_start := by + intro state iHead wHeads oHead + match state with + | .inl .dispatch => + dsimp only + split <;> exact rightOfStart_allReadBack iHead wHeads oHead + | .inl .done => exact rightOfStart_allIdle iHead wHeads oHead + | .inr (.inl q) => + dsimp only + split + · exact rightOfStart_allIdle iHead wHeads oHead + · exact onBlank.δ_right_of_start q iHead wHeads oHead + | .inr (.inr q) => + dsimp only + split + · exact rightOfStart_allIdle iHead wHeads oHead + · exact onNonblank.δ_right_of_start q iHead wHeads oHead + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/WorkBranch/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/WorkBranch/Internal.lean new file mode 100644 index 0000000000..a256d701d1 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/WorkBranch/Internal.lean @@ -0,0 +1,469 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Mathlib.NatBits +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.WorkBranch.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Hoare.Space +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinarySucc.Defs +public import Mathlib.Algebra.Order.Group.Nat + +/-! +# Direct work-symbol branch combinator -- proof internals +-/ + + +@[expose] public section + +namespace Complexity + +namespace TM + +variable {n : ℕ} + +/-- Embed a blank-branch configuration into the combined controller. -/ +def workBranchBlankWrap (idx : Fin n) (onBlank onNonblank : TM n) + (c : Cfg n onBlank.Q) : Cfg n (branchWorkBlankTM idx onBlank onNonblank).Q where + state := workBranchBlankState onBlank onNonblank c.state + input := c.input + work := c.work + output := c.output + +/-- Embed a nonblank-branch configuration into the combined controller. -/ +def workBranchNonblankWrap (idx : Fin n) (onBlank onNonblank : TM n) + (c : Cfg n onNonblank.Q) : + Cfg n (branchWorkBlankTM idx onBlank onNonblank).Q where + state := workBranchNonblankState onBlank onNonblank c.state + input := c.input + work := c.work + output := c.output + +theorem workBranchBlankWrap_halted_iff_internal + (idx : Fin n) (onBlank onNonblank : TM n) (c : Cfg n onBlank.Q) : + (branchWorkBlankTM idx onBlank onNonblank).halted + (workBranchBlankWrap idx onBlank onNonblank c) ↔ + onBlank.halted c := by + change (workBranchBlankWrap idx onBlank onNonblank c).state = + (branchWorkBlankTM idx onBlank onNonblank).qhalt ↔ + c.state = onBlank.qhalt + by_cases hhalt : c.state = onBlank.qhalt + · simp [workBranchBlankWrap, workBranchBlankState, branchWorkBlankTM, + hhalt] + · simp [workBranchBlankWrap, workBranchBlankState, branchWorkBlankTM, + hhalt] + +theorem workBranchNonblankWrap_halted_iff_internal + (idx : Fin n) (onBlank onNonblank : TM n) (c : Cfg n onNonblank.Q) : + (branchWorkBlankTM idx onBlank onNonblank).halted + (workBranchNonblankWrap idx onBlank onNonblank c) ↔ + onNonblank.halted c := by + change (workBranchNonblankWrap idx onBlank onNonblank c).state = + (branchWorkBlankTM idx onBlank onNonblank).qhalt ↔ + c.state = onNonblank.qhalt + by_cases hhalt : c.state = onNonblank.qhalt + · simp [workBranchNonblankWrap, workBranchNonblankState, + branchWorkBlankTM, hhalt] + · simp [workBranchNonblankWrap, workBranchNonblankState, + branchWorkBlankTM, hhalt] + +theorem branchWorkBlankTM_blank_step_internal + (idx : Fin n) (onBlank onNonblank : TM n) + {c c' : Cfg n onBlank.Q} (hstep : onBlank.step c = some c') : + (branchWorkBlankTM idx onBlank onNonblank).step + (workBranchBlankWrap idx onBlank onNonblank c) = + some (workBranchBlankWrap idx onBlank onNonblank c') := by + have hne : c.state ≠ onBlank.qhalt := state_ne_qhalt_of_step hstep + rw [TM.step, if_neg (by + simp [workBranchBlankWrap, workBranchBlankState, branchWorkBlankTM, + hne])] + simp only [workBranchBlankWrap, workBranchBlankState, hne, ↓reduceIte, + branchWorkBlankTM] + rw [TM.step, if_neg hne] at hstep + revert hstep + generalize haction : onBlank.δ c.state c.input.read + (fun i => (c.work i).read) c.output.read = action + obtain ⟨q', workWrites, outputWrite, inputDir, workDirs, outputDir⟩ := action + simp only [haction] + intro hstep + cases Option.some.inj hstep + rfl + +theorem branchWorkBlankTM_nonblank_step_internal + (idx : Fin n) (onBlank onNonblank : TM n) + {c c' : Cfg n onNonblank.Q} (hstep : onNonblank.step c = some c') : + (branchWorkBlankTM idx onBlank onNonblank).step + (workBranchNonblankWrap idx onBlank onNonblank c) = + some (workBranchNonblankWrap idx onBlank onNonblank c') := by + have hne : c.state ≠ onNonblank.qhalt := state_ne_qhalt_of_step hstep + rw [TM.step, if_neg (by + simp [workBranchNonblankWrap, workBranchNonblankState, + branchWorkBlankTM, hne])] + simp only [workBranchNonblankWrap, workBranchNonblankState, hne, + ↓reduceIte, branchWorkBlankTM] + rw [TM.step, if_neg hne] at hstep + revert hstep + generalize haction : onNonblank.δ c.state c.input.read + (fun i => (c.work i).read) c.output.read = action + obtain ⟨q', workWrites, outputWrite, inputDir, workDirs, outputDir⟩ := action + simp only [haction] + intro hstep + cases Option.some.inj hstep + rfl + +theorem branchWorkBlankTM_blank_reachesIn_internal + (idx : Fin n) (onBlank onNonblank : TM n) + {t : ℕ} {c c' : Cfg n onBlank.Q} + (hreach : onBlank.reachesIn t c c') : + (branchWorkBlankTM idx onBlank onNonblank).reachesIn t + (workBranchBlankWrap idx onBlank onNonblank c) + (workBranchBlankWrap idx onBlank onNonblank c') := + reachesIn_map (workBranchBlankWrap idx onBlank onNonblank) + (fun _ _ => branchWorkBlankTM_blank_step_internal idx onBlank onNonblank) + hreach + +theorem branchWorkBlankTM_nonblank_reachesIn_internal + (idx : Fin n) (onBlank onNonblank : TM n) + {t : ℕ} {c c' : Cfg n onNonblank.Q} + (hreach : onNonblank.reachesIn t c c') : + (branchWorkBlankTM idx onBlank onNonblank).reachesIn t + (workBranchNonblankWrap idx onBlank onNonblank c) + (workBranchNonblankWrap idx onBlank onNonblank c') := + reachesIn_map (workBranchNonblankWrap idx onBlank onNonblank) + (fun _ _ => branchWorkBlankTM_nonblank_step_internal idx onBlank onNonblank) + hreach + +theorem branchWorkBlankTM_dispatch_blank_internal + (idx : Fin n) (onBlank onNonblank : TM n) + (inp : Tape) (work : Fin n → Tape) (out : Tape) + (hblank : (work idx).read = Γ.blank) + (hinp : inp.read ≠ Γ.start) (hwork : ∀ i, (work i).read ≠ Γ.start) + (hout : out.read ≠ Γ.start) : + (branchWorkBlankTM idx onBlank onNonblank).step + { state := (branchWorkBlankTM idx onBlank onNonblank).qstart + input := inp + work := work + output := out } = + some (workBranchBlankWrap idx onBlank onNonblank + { state := onBlank.qstart + input := inp + work := work + output := out }) := by + rw [TM.step, if_neg (by simp [branchWorkBlankTM])] + simp only [branchWorkBlankTM, hblank, allReadBack, ↓reduceIte, + workBranchBlankWrap] + refine congrArg some (Cfg.ext rfl ?_ ?_ ?_) + · exact transitionInput_eq_self hinp + · funext i + exact transitionTape_eq_self (hwork i) + · exact transitionTape_eq_self hout + +theorem branchWorkBlankTM_dispatch_nonblank_internal + (idx : Fin n) (onBlank onNonblank : TM n) + (inp : Tape) (work : Fin n → Tape) (out : Tape) + (hnonblank : (work idx).read ≠ Γ.blank) + (hinp : inp.read ≠ Γ.start) (hwork : ∀ i, (work i).read ≠ Γ.start) + (hout : out.read ≠ Γ.start) : + (branchWorkBlankTM idx onBlank onNonblank).step + { state := (branchWorkBlankTM idx onBlank onNonblank).qstart + input := inp + work := work + output := out } = + some (workBranchNonblankWrap idx onBlank onNonblank + { state := onNonblank.qstart + input := inp + work := work + output := out }) := by + rw [TM.step, if_neg (by simp [branchWorkBlankTM])] + simp only [branchWorkBlankTM, hnonblank, allReadBack, ↓reduceIte, + workBranchNonblankWrap] + refine congrArg some (Cfg.ext rfl ?_ ?_ ?_) + · exact transitionInput_eq_self hinp + · funext i + exact transitionTape_eq_self (hwork i) + · exact transitionTape_eq_self hout + +theorem branchWorkBlankTM_reachesIn_blank_frame_internal + (idx : Fin n) (onBlank onNonblank : TM n) + (inp : Tape) (work : Fin n → Tape) (out : Tape) + {t : ℕ} {c' : Cfg n onBlank.Q} + (hblank : (work idx).read = Γ.blank) + (hinp : inp.read ≠ Γ.start) (hwork : ∀ i, (work i).read ≠ Γ.start) + (hout : out.read ≠ Γ.start) + (hreach : onBlank.reachesIn t + { state := onBlank.qstart, input := inp, work := work, output := out } c') + (hhalt : onBlank.halted c') : + ∃ C, + (branchWorkBlankTM idx onBlank onNonblank).reachesIn (t + 1) + { state := (branchWorkBlankTM idx onBlank onNonblank).qstart + input := inp + work := work + output := out } C ∧ + (branchWorkBlankTM idx onBlank onNonblank).halted C ∧ + C.input = c'.input ∧ C.work = c'.work ∧ C.output = c'.output := by + let C := workBranchBlankWrap idx onBlank onNonblank c' + refine ⟨C, .step + (branchWorkBlankTM_dispatch_blank_internal idx onBlank onNonblank + inp work out hblank hinp hwork hout) + (branchWorkBlankTM_blank_reachesIn_internal idx onBlank onNonblank + hreach), ?_, rfl, rfl, rfl⟩ + exact (workBranchBlankWrap_halted_iff_internal idx onBlank onNonblank c').2 + hhalt + +theorem branchWorkBlankTM_reachesIn_nonblank_frame_internal + (idx : Fin n) (onBlank onNonblank : TM n) + (inp : Tape) (work : Fin n → Tape) (out : Tape) + {t : ℕ} {c' : Cfg n onNonblank.Q} + (hnonblank : (work idx).read ≠ Γ.blank) + (hinp : inp.read ≠ Γ.start) (hwork : ∀ i, (work i).read ≠ Γ.start) + (hout : out.read ≠ Γ.start) + (hreach : onNonblank.reachesIn t + { state := onNonblank.qstart, input := inp, work := work, output := out } c') + (hhalt : onNonblank.halted c') : + ∃ C, + (branchWorkBlankTM idx onBlank onNonblank).reachesIn (t + 1) + { state := (branchWorkBlankTM idx onBlank onNonblank).qstart + input := inp + work := work + output := out } C ∧ + (branchWorkBlankTM idx onBlank onNonblank).halted C ∧ + C.input = c'.input ∧ C.work = c'.work ∧ C.output = c'.output := by + let C := workBranchNonblankWrap idx onBlank onNonblank c' + refine ⟨C, .step + (branchWorkBlankTM_dispatch_nonblank_internal idx onBlank onNonblank + inp work out hnonblank hinp hwork hout) + (branchWorkBlankTM_nonblank_reachesIn_internal idx onBlank onNonblank + hreach), ?_, rfl, rfl, rfl⟩ + exact (workBranchNonblankWrap_halted_iff_internal idx onBlank onNonblank c').2 + hhalt + +theorem branchWorkBlankTM_hoareTime_internal + (idx : Fin n) (onBlank onNonblank : TM n) + {pre blankPre nonblankPre blankPost nonblankPost : TapePred n} + {blankTime nonblankTime : ℕ} + (hframe : ∀ inp work out, pre inp work out → + inp.read ≠ Γ.start ∧ (∀ i, (work i).read ≠ Γ.start) ∧ + out.read ≠ Γ.start) + (hblankPre : ∀ inp work out, pre inp work out → + (work idx).read = Γ.blank → blankPre inp work out) + (hnonblankPre : ∀ inp work out, pre inp work out → + (work idx).read ≠ Γ.blank → nonblankPre inp work out) + (hblank : onBlank.HoareTime blankPre blankPost blankTime) + (hnonblank : onNonblank.HoareTime nonblankPre nonblankPost nonblankTime) : + (branchWorkBlankTM idx onBlank onNonblank).HoareTime pre + (fun inp work out => + blankPost inp work out ∨ nonblankPost inp work out) + (branchWorkBlankTime blankTime nonblankTime) := by + intro inp work out hpre + obtain ⟨hinp, hwork, hout⟩ := hframe inp work out hpre + by_cases hread : (work idx).read = Γ.blank + · obtain ⟨c', t, ht, hreach, hhalt, hpost⟩ := + hblank inp work out (hblankPre inp work out hpre hread) + obtain ⟨C, hrun, hhaltC, hinput, hworkC, houtput⟩ := + branchWorkBlankTM_reachesIn_blank_frame_internal idx onBlank + onNonblank inp work out hread hinp hwork hout hreach hhalt + refine ⟨C, t + 1, ?_, hrun, hhaltC, ?_⟩ + · unfold branchWorkBlankTime + omega + · left + simpa [hinput, hworkC, houtput] using hpost + · obtain ⟨c', t, ht, hreach, hhalt, hpost⟩ := + hnonblank inp work out (hnonblankPre inp work out hpre hread) + obtain ⟨C, hrun, hhaltC, hinput, hworkC, houtput⟩ := + branchWorkBlankTM_reachesIn_nonblank_frame_internal idx onBlank + onNonblank inp work out hread hinp hwork hout hreach hhalt + refine ⟨C, t + 1, ?_, hrun, hhaltC, ?_⟩ + · unfold branchWorkBlankTime + omega + · right + simpa [hinput, hworkC, houtput] using hpost + +theorem branchWorkBlankTM_hoareTimeSpace_internal + (idx : Fin n) (onBlank onNonblank : TM n) + {pre blankPre nonblankPre blankPost nonblankPost : TapePred n} + {blankTime nonblankTime inputLength blankSpace nonblankSpace : ℕ} + (hframe : ∀ inp work out, pre inp work out → + inp.read ≠ Γ.start ∧ (∀ i, (work i).read ≠ Γ.start) ∧ + out.read ≠ Γ.start) + (hblankPre : ∀ inp work out, pre inp work out → + (work idx).read = Γ.blank → blankPre inp work out) + (hnonblankPre : ∀ inp work out, pre inp work out → + (work idx).read ≠ Γ.blank → nonblankPre inp work out) + (hblank : onBlank.HoareTimeSpace blankPre blankPost blankTime + inputLength blankSpace) + (hnonblank : onNonblank.HoareTimeSpace nonblankPre nonblankPost + nonblankTime inputLength nonblankSpace) : + (branchWorkBlankTM idx onBlank onNonblank).HoareTimeSpace pre + (fun inp work out => + blankPost inp work out ∨ nonblankPost inp work out) + (branchWorkBlankTime blankTime nonblankTime) inputLength + (max blankSpace nonblankSpace) := by + constructor + · exact branchWorkBlankTM_hoareTime_internal idx onBlank onNonblank + hframe hblankPre hnonblankPre hblank.1 hnonblank.1 + · intro inp work out hpre C hreach + obtain ⟨hinp, hwork, hout⟩ := hframe inp work out hpre + obtain ⟨u, hreachU⟩ := + (branchWorkBlankTM idx onBlank onNonblank).reaches_to_reachesIn hreach + by_cases hread : (work idx).read = Γ.blank + · have hbranchPre := hblankPre inp work out hpre hread + obtain ⟨cHalt, t, _ht, hbranch, hhalt, _hpost⟩ := + hblank.1 inp work out hbranchPre + have hfull : + (branchWorkBlankTM idx onBlank onNonblank).reachesIn (t + 1) + { state := (branchWorkBlankTM idx onBlank onNonblank).qstart + input := inp + work := work + output := out } + (workBranchBlankWrap idx onBlank onNonblank cHalt) := + .step + (branchWorkBlankTM_dispatch_blank_internal idx onBlank onNonblank + inp work out hread hinp hwork hout) + (branchWorkBlankTM_blank_reachesIn_internal idx onBlank onNonblank + hbranch) + have hfullHalt : + (branchWorkBlankTM idx onBlank onNonblank).halted + (workBranchBlankWrap idx onBlank onNonblank cHalt) := + (workBranchBlankWrap_halted_iff_internal idx onBlank onNonblank + cHalt).2 hhalt + have hu : u ≤ t + 1 := + (branchWorkBlankTM idx onBlank onNonblank).reachesIn_le_halt + hreachU hfull hfullHalt + cases u with + | zero => + cases hreachU + have hspace := hblank.2 inp work out hbranchPre _ .refl + exact hspace.mono le_rfl (le_max_left _ _) + | succ v => + have hv : v ≤ t := by omega + obtain ⟨d, hprefix, _hsuffix⟩ := + reachesIn_prefix_internal hbranch hv + have hcanonical : + (branchWorkBlankTM idx onBlank onNonblank).reachesIn (v + 1) + { state := (branchWorkBlankTM idx onBlank onNonblank).qstart + input := inp + work := work + output := out } + (workBranchBlankWrap idx onBlank onNonblank d) := + .step + (branchWorkBlankTM_dispatch_blank_internal idx onBlank + onNonblank inp work out hread hinp hwork hout) + (branchWorkBlankTM_blank_reachesIn_internal idx onBlank + onNonblank hprefix) + have hC : C = workBranchBlankWrap idx onBlank onNonblank d := + (branchWorkBlankTM idx onBlank onNonblank).reachesIn_right_unique + hreachU hcanonical + rw [hC] + have hspace := hblank.2 inp work out hbranchPre d + (reaches_of_reachesIn hprefix) + exact (hspace.mono le_rfl (le_max_left _ _)) + · have hbranchPre := hnonblankPre inp work out hpre hread + obtain ⟨cHalt, t, _ht, hbranch, hhalt, _hpost⟩ := + hnonblank.1 inp work out hbranchPre + have hfull : + (branchWorkBlankTM idx onBlank onNonblank).reachesIn (t + 1) + { state := (branchWorkBlankTM idx onBlank onNonblank).qstart + input := inp + work := work + output := out } + (workBranchNonblankWrap idx onBlank onNonblank cHalt) := + .step + (branchWorkBlankTM_dispatch_nonblank_internal idx onBlank + onNonblank inp work out hread hinp hwork hout) + (branchWorkBlankTM_nonblank_reachesIn_internal idx onBlank + onNonblank hbranch) + have hfullHalt : + (branchWorkBlankTM idx onBlank onNonblank).halted + (workBranchNonblankWrap idx onBlank onNonblank cHalt) := + (workBranchNonblankWrap_halted_iff_internal idx onBlank onNonblank + cHalt).2 hhalt + have hu : u ≤ t + 1 := + (branchWorkBlankTM idx onBlank onNonblank).reachesIn_le_halt + hreachU hfull hfullHalt + cases u with + | zero => + cases hreachU + have hspace := hnonblank.2 inp work out hbranchPre _ .refl + exact hspace.mono le_rfl (le_max_right _ _) + | succ v => + have hv : v ≤ t := by omega + obtain ⟨d, hprefix, _hsuffix⟩ := + reachesIn_prefix_internal hbranch hv + have hcanonical : + (branchWorkBlankTM idx onBlank onNonblank).reachesIn (v + 1) + { state := (branchWorkBlankTM idx onBlank onNonblank).qstart + input := inp + work := work + output := out } + (workBranchNonblankWrap idx onBlank onNonblank d) := + .step + (branchWorkBlankTM_dispatch_nonblank_internal idx onBlank + onNonblank inp work out hread hinp hwork hout) + (branchWorkBlankTM_nonblank_reachesIn_internal idx onBlank + onNonblank hprefix) + have hC : C = workBranchNonblankWrap idx onBlank onNonblank d := + (branchWorkBlankTM idx onBlank onNonblank).reachesIn_right_unique + hreachU hcanonical + rw [hC] + have hspace := hnonblank.2 inp work out hbranchPre d + (reaches_of_reachesIn hprefix) + exact (hspace.mono le_rfl (le_max_right _ _)) + +theorem IsTransducer.branchWorkBlankTM_internal + {idx : Fin n} {onBlank onNonblank : TM n} + (hblank : onBlank.IsTransducer) + (hnonblank : onNonblank.IsTransducer) : + (branchWorkBlankTM idx onBlank onNonblank).IsTransducer := by + intro state iHead wHeads oHead + cases state with + | inl phase => + cases phase with + | dispatch => + simp only [branchWorkBlankTM] + split <;> cases oHead <;> simp [allReadBack, idleDir] + | done => cases oHead <;> simp [branchWorkBlankTM, allIdle, idleDir] + | inr branchState => + cases branchState with + | inl q => + simp only [branchWorkBlankTM] + split + · cases oHead <;> simp [allIdle, idleDir] + · exact hblank q iHead wHeads oHead + | inr q => + simp only [branchWorkBlankTM] + split + · cases oHead <;> simp [allIdle, idleDir] + · exact hnonblank q iHead wHeads oHead + +end TM + +namespace Tape + +/-- A canonical little-endian natural reads blank exactly at zero. -/ +theorem HasBinaryNat.read_eq_blank_iff_internal {t : Tape} {value : ℕ} + (h : t.HasBinaryNat value) : + t.read = Γ.blank ↔ value = 0 := by + constructor + · intro hread + by_contra hvalue + have hbits : value.bits ≠ [] := by + intro hnil + apply hvalue + rw [← Nat.fromBitsLE_bits value, hnil] + rfl + obtain ⟨bit, bits, hcons⟩ := List.exists_cons_of_ne_nil hbits + have hcell : t.cells 1 = Γ.ofBool bit := by + have hfirst := h.2.2.1 0 (by simp [hcons]) + simpa [hcons] using hfirst + rw [Tape.read, h.2.1, hcell] at hread + cases bit <;> simp [Γ.ofBool] at hread + · intro hvalue + subst value + rw [Tape.read, h.2.1] + exact h.2.2.2 0 (by simp) + +end Tape + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/WorkSymbolBranch.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/WorkSymbolBranch.lean new file mode 100644 index 0000000000..84184d0fb1 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/WorkSymbolBranch.lean @@ -0,0 +1,98 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.WorkSymbolBranch.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.WorkSymbolBranch.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Hoare.Space + +/-! +# Direct work-symbol branch combinator + +This module exposes exact framed execution for a one-step branch on an +arbitrary work-tape symbol. It is the direct controller primitive used to +branch on the readable sparse-entry equality flag. +-/ + + +public section + +namespace Complexity + +namespace TM + +variable {n : ℕ} + +/-- Exact framed execution through the symbol-equal branch. -/ +theorem branchWorkSymbolTM_reachesIn_equal_frame + (idx : Fin n) (symbol : Γ) (onEqual onDifferent : TM n) + (inp : Tape) (work : Fin n → Tape) (out : Tape) + {t : ℕ} {c' : Cfg n onEqual.Q} + (hequal : (work idx).read = symbol) + (hinp : inp.read ≠ Γ.start) (hwork : ∀ i, (work i).read ≠ Γ.start) + (hout : out.read ≠ Γ.start) + (hreach : onEqual.reachesIn t + { state := onEqual.qstart, input := inp, work := work, output := out } c') + (hhalt : onEqual.halted c') : + ∃ C, + (branchWorkSymbolTM idx symbol onEqual onDifferent).reachesIn (t + 1) + { state := (branchWorkSymbolTM idx symbol onEqual onDifferent).qstart + input := inp + work := work + output := out } C ∧ + (branchWorkSymbolTM idx symbol onEqual onDifferent).halted C ∧ + C.input = c'.input ∧ C.work = c'.work ∧ C.output = c'.output := + branchWorkSymbolTM_reachesIn_equal_frame_internal idx symbol onEqual + onDifferent inp work out hequal hinp hwork hout hreach hhalt + +/-- Exact framed execution through the symbol-different branch. -/ +theorem branchWorkSymbolTM_reachesIn_different_frame + (idx : Fin n) (symbol : Γ) (onEqual onDifferent : TM n) + (inp : Tape) (work : Fin n → Tape) (out : Tape) + {t : ℕ} {c' : Cfg n onDifferent.Q} + (hdifferent : (work idx).read ≠ symbol) + (hinp : inp.read ≠ Γ.start) (hwork : ∀ i, (work i).read ≠ Γ.start) + (hout : out.read ≠ Γ.start) + (hreach : onDifferent.reachesIn t + { state := onDifferent.qstart, input := inp, work := work, output := out } + c') + (hhalt : onDifferent.halted c') : + ∃ C, + (branchWorkSymbolTM idx symbol onEqual onDifferent).reachesIn (t + 1) + { state := (branchWorkSymbolTM idx symbol onEqual onDifferent).qstart + input := inp + work := work + output := out } C ∧ + (branchWorkSymbolTM idx symbol onEqual onDifferent).halted C ∧ + C.input = c'.input ∧ C.work = c'.work ∧ C.output = c'.output := + branchWorkSymbolTM_reachesIn_different_frame_internal idx symbol onEqual + onDifferent inp work out hdifferent hinp hwork hout hreach hhalt + +/-- A direct work-symbol branch is a transducer when both selected branches +are transducers. -/ +theorem IsTransducer.branchWorkSymbolTM + {idx : Fin n} {symbol : Γ} {onEqual onDifferent : TM n} + (hequal : onEqual.IsTransducer) (hdifferent : onDifferent.IsTransducer) : + (branchWorkSymbolTM idx symbol onEqual onDifferent).IsTransducer := + hequal.branchWorkSymbolTM_internal hdifferent + +/-- Coarse all-prefix auxiliary-space envelope for a direct work-symbol +branch. -/ +theorem branchWorkSymbolTM_prefix_withinAuxSpace + (idx : Fin n) (symbol : Γ) (onEqual onDifferent : TM n) + (branchTime inputLength initialSpace time : ℕ) + (start current : Cfg n + (branchWorkSymbolTM idx symbol onEqual onDifferent).Q) + (hinitial : start.WithinAuxSpace inputLength initialSpace) + (hreach : (branchWorkSymbolTM idx symbol onEqual onDifferent).reachesIn + time start current) + (htime : time ≤ branchTime + 1) : + current.WithinAuxSpace inputLength (initialSpace + branchTime + 1) := + (hinitial.reachesIn hreach).mono le_rfl (by omega) + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/WorkSymbolBranch/Defs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/WorkSymbolBranch/Defs.lean new file mode 100644 index 0000000000..3152906731 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/WorkSymbolBranch/Defs.lean @@ -0,0 +1,83 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.WorkBranch.Defs + +/-! +# Direct work-symbol branch combinator — definitions + +`TM.branchWorkSymbolTM idx symbol onEqual onDifferent` inspects one work tape +and runs `onEqual` exactly when the current symbol equals `symbol`. This is the +generic controller branch used by the sparse RAM lookup scan. +-/ + + +@[expose] public section + +namespace Complexity + +namespace TM + +/-- Inspect one work symbol and run the selected branch on the same tapes. -/ +def branchWorkSymbolTM {n : ℕ} (idx : Fin n) (symbol : Γ) + (onEqual onDifferent : TM n) : TM n where + Q := WorkBranchQ onEqual.Q onDifferent.Q + qstart := .inl .dispatch + qhalt := .inl .done + δ := fun state iHead wHeads oHead => + match state with + | .inl .dispatch => + if wHeads idx = symbol then + allReadBack + (workBranchBlankState onEqual onDifferent onEqual.qstart) + iHead wHeads oHead + else + allReadBack + (workBranchNonblankState onEqual onDifferent onDifferent.qstart) + iHead wHeads oHead + | .inl .done => allIdle (.inl .done) iHead wHeads oHead + | .inr (.inl q) => + if q = onEqual.qhalt then + allReadBack (.inl .done) iHead wHeads oHead + else + let (q', workWrites, outputWrite, inputDir, workDirs, outputDir) := + onEqual.δ q iHead wHeads oHead + (workBranchBlankState onEqual onDifferent q', workWrites, + outputWrite, inputDir, workDirs, outputDir) + | .inr (.inr q) => + if q = onDifferent.qhalt then + allReadBack (.inl .done) iHead wHeads oHead + else + let (q', workWrites, outputWrite, inputDir, workDirs, outputDir) := + onDifferent.δ q iHead wHeads oHead + (workBranchNonblankState onEqual onDifferent q', workWrites, + outputWrite, inputDir, workDirs, outputDir) + δ_right_of_start := by + intro state iHead wHeads oHead + match state with + | .inl .dispatch => + dsimp only + split <;> exact rightOfStart_allReadBack iHead wHeads oHead + | .inl .done => exact rightOfStart_allIdle iHead wHeads oHead + | .inr (.inl q) => + dsimp only + split + · exact rightOfStart_allReadBack iHead wHeads oHead + · exact onEqual.δ_right_of_start q iHead wHeads oHead + | .inr (.inr q) => + dsimp only + split + · exact rightOfStart_allReadBack iHead wHeads oHead + · exact onDifferent.δ_right_of_start q iHead wHeads oHead + +/-- One dispatch step followed by either branch's advertised time. -/ +def branchWorkSymbolTime (equalTime differentTime : ℕ) : ℕ := + 1 + max equalTime differentTime + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/WorkSymbolBranch/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/WorkSymbolBranch/Internal.lean new file mode 100644 index 0000000000..4e785f3510 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/WorkSymbolBranch/Internal.lean @@ -0,0 +1,260 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.Internal.Generic +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.WorkSymbolBranch.Defs + +/-! +# Direct work-symbol branch combinator — proof internals +-/ + + +public section + +namespace Complexity + +namespace TM + +variable {n : ℕ} + +/-- Embed an equal-branch configuration in the direct-symbol controller. -/ +def workSymbolEqualWrap (idx : Fin n) (symbol : Γ) + (onEqual onDifferent : TM n) (c : Cfg n onEqual.Q) : + Cfg n (branchWorkSymbolTM idx symbol onEqual onDifferent).Q where + state := workBranchBlankState onEqual onDifferent c.state + input := c.input + work := c.work + output := c.output + +/-- Embed a different-branch configuration in the direct-symbol controller. -/ +def workSymbolDifferentWrap (idx : Fin n) (symbol : Γ) + (onEqual onDifferent : TM n) (c : Cfg n onDifferent.Q) : + Cfg n (branchWorkSymbolTM idx symbol onEqual onDifferent).Q where + state := workBranchNonblankState onEqual onDifferent c.state + input := c.input + work := c.work + output := c.output + +private theorem workSymbolEqualWrap_halted_iff + (idx : Fin n) (symbol : Γ) (onEqual onDifferent : TM n) + (c : Cfg n onEqual.Q) : + (branchWorkSymbolTM idx symbol onEqual onDifferent).halted + (workSymbolEqualWrap idx symbol onEqual onDifferent c) ↔ + onEqual.halted c := by + change (workSymbolEqualWrap idx symbol onEqual onDifferent c).state = + (branchWorkSymbolTM idx symbol onEqual onDifferent).qhalt ↔ + c.state = onEqual.qhalt + by_cases hhalt : c.state = onEqual.qhalt <;> + simp [workSymbolEqualWrap, workBranchBlankState, branchWorkSymbolTM, + hhalt] + +private theorem workSymbolDifferentWrap_halted_iff + (idx : Fin n) (symbol : Γ) (onEqual onDifferent : TM n) + (c : Cfg n onDifferent.Q) : + (branchWorkSymbolTM idx symbol onEqual onDifferent).halted + (workSymbolDifferentWrap idx symbol onEqual onDifferent c) ↔ + onDifferent.halted c := by + change (workSymbolDifferentWrap idx symbol onEqual onDifferent c).state = + (branchWorkSymbolTM idx symbol onEqual onDifferent).qhalt ↔ + c.state = onDifferent.qhalt + by_cases hhalt : c.state = onDifferent.qhalt <;> + simp [workSymbolDifferentWrap, workBranchNonblankState, + branchWorkSymbolTM, hhalt] + +private theorem branchWorkSymbolTM_equal_step + (idx : Fin n) (symbol : Γ) (onEqual onDifferent : TM n) + {c c' : Cfg n onEqual.Q} (hstep : onEqual.step c = some c') : + (branchWorkSymbolTM idx symbol onEqual onDifferent).step + (workSymbolEqualWrap idx symbol onEqual onDifferent c) = + some (workSymbolEqualWrap idx symbol onEqual onDifferent c') := by + have hne : c.state ≠ onEqual.qhalt := state_ne_qhalt_of_step hstep + rw [TM.step, if_neg (by + simp [workSymbolEqualWrap, workBranchBlankState, branchWorkSymbolTM, + hne])] + simp only [workSymbolEqualWrap, workBranchBlankState, hne, ↓reduceIte, + branchWorkSymbolTM] + rw [TM.step, if_neg hne] at hstep + revert hstep + generalize haction : onEqual.δ c.state c.input.read + (fun i => (c.work i).read) c.output.read = action + obtain ⟨q', workWrites, outputWrite, inputDir, workDirs, outputDir⟩ := action + simp only [haction] + intro hstep + cases Option.some.inj hstep + rfl + +private theorem branchWorkSymbolTM_different_step + (idx : Fin n) (symbol : Γ) (onEqual onDifferent : TM n) + {c c' : Cfg n onDifferent.Q} (hstep : onDifferent.step c = some c') : + (branchWorkSymbolTM idx symbol onEqual onDifferent).step + (workSymbolDifferentWrap idx symbol onEqual onDifferent c) = + some (workSymbolDifferentWrap idx symbol onEqual onDifferent c') := by + have hne : c.state ≠ onDifferent.qhalt := state_ne_qhalt_of_step hstep + rw [TM.step, if_neg (by + simp [workSymbolDifferentWrap, workBranchNonblankState, + branchWorkSymbolTM, hne])] + simp only [workSymbolDifferentWrap, workBranchNonblankState, hne, + ↓reduceIte, branchWorkSymbolTM] + rw [TM.step, if_neg hne] at hstep + revert hstep + generalize haction : onDifferent.δ c.state c.input.read + (fun i => (c.work i).read) c.output.read = action + obtain ⟨q', workWrites, outputWrite, inputDir, workDirs, outputDir⟩ := action + simp only [haction] + intro hstep + cases Option.some.inj hstep + rfl + +private theorem branchWorkSymbolTM_equal_reachesIn + (idx : Fin n) (symbol : Γ) (onEqual onDifferent : TM n) + {t : ℕ} {c c' : Cfg n onEqual.Q} (hreach : onEqual.reachesIn t c c') : + (branchWorkSymbolTM idx symbol onEqual onDifferent).reachesIn t + (workSymbolEqualWrap idx symbol onEqual onDifferent c) + (workSymbolEqualWrap idx symbol onEqual onDifferent c') := + reachesIn_map (workSymbolEqualWrap idx symbol onEqual onDifferent) + (fun _ _ => branchWorkSymbolTM_equal_step idx symbol onEqual onDifferent) + hreach + +private theorem branchWorkSymbolTM_different_reachesIn + (idx : Fin n) (symbol : Γ) (onEqual onDifferent : TM n) + {t : ℕ} {c c' : Cfg n onDifferent.Q} + (hreach : onDifferent.reachesIn t c c') : + (branchWorkSymbolTM idx symbol onEqual onDifferent).reachesIn t + (workSymbolDifferentWrap idx symbol onEqual onDifferent c) + (workSymbolDifferentWrap idx symbol onEqual onDifferent c') := + reachesIn_map (workSymbolDifferentWrap idx symbol onEqual onDifferent) + (fun _ _ => branchWorkSymbolTM_different_step idx symbol onEqual onDifferent) + hreach + +private theorem branchWorkSymbolTM_dispatch_equal + (idx : Fin n) (symbol : Γ) (onEqual onDifferent : TM n) + (inp : Tape) (work : Fin n → Tape) (out : Tape) + (hequal : (work idx).read = symbol) + (hinp : inp.read ≠ Γ.start) (hwork : ∀ i, (work i).read ≠ Γ.start) + (hout : out.read ≠ Γ.start) : + (branchWorkSymbolTM idx symbol onEqual onDifferent).step + { state := (branchWorkSymbolTM idx symbol onEqual onDifferent).qstart + input := inp + work := work + output := out } = + some (workSymbolEqualWrap idx symbol onEqual onDifferent + { state := onEqual.qstart, input := inp, work := work, output := out }) := by + rw [TM.step, if_neg (by simp [branchWorkSymbolTM])] + simp only [branchWorkSymbolTM, hequal, allReadBack, ↓reduceIte, + workSymbolEqualWrap] + refine congrArg some (Cfg.ext rfl ?_ ?_ ?_) + · exact transitionInput_eq_self hinp + · funext i + exact transitionTape_eq_self (hwork i) + · exact transitionTape_eq_self hout + +private theorem branchWorkSymbolTM_dispatch_different + (idx : Fin n) (symbol : Γ) (onEqual onDifferent : TM n) + (inp : Tape) (work : Fin n → Tape) (out : Tape) + (hdifferent : (work idx).read ≠ symbol) + (hinp : inp.read ≠ Γ.start) (hwork : ∀ i, (work i).read ≠ Γ.start) + (hout : out.read ≠ Γ.start) : + (branchWorkSymbolTM idx symbol onEqual onDifferent).step + { state := (branchWorkSymbolTM idx symbol onEqual onDifferent).qstart + input := inp + work := work + output := out } = + some (workSymbolDifferentWrap idx symbol onEqual onDifferent + { state := onDifferent.qstart, input := inp, work := work, + output := out }) := by + rw [TM.step, if_neg (by simp [branchWorkSymbolTM])] + simp only [branchWorkSymbolTM, hdifferent, allReadBack, ↓reduceIte, + workSymbolDifferentWrap] + refine congrArg some (Cfg.ext rfl ?_ ?_ ?_) + · exact transitionInput_eq_self hinp + · funext i + exact transitionTape_eq_self (hwork i) + · exact transitionTape_eq_self hout + +theorem branchWorkSymbolTM_reachesIn_equal_frame_internal + (idx : Fin n) (symbol : Γ) (onEqual onDifferent : TM n) + (inp : Tape) (work : Fin n → Tape) (out : Tape) + {t : ℕ} {c' : Cfg n onEqual.Q} + (hequal : (work idx).read = symbol) + (hinp : inp.read ≠ Γ.start) (hwork : ∀ i, (work i).read ≠ Γ.start) + (hout : out.read ≠ Γ.start) + (hreach : onEqual.reachesIn t + { state := onEqual.qstart, input := inp, work := work, output := out } c') + (hhalt : onEqual.halted c') : + ∃ C, + (branchWorkSymbolTM idx symbol onEqual onDifferent).reachesIn (t + 1) + { state := (branchWorkSymbolTM idx symbol onEqual onDifferent).qstart + input := inp + work := work + output := out } C ∧ + (branchWorkSymbolTM idx symbol onEqual onDifferent).halted C ∧ + C.input = c'.input ∧ C.work = c'.work ∧ C.output = c'.output := by + let C := workSymbolEqualWrap idx symbol onEqual onDifferent c' + refine ⟨C, .step + (branchWorkSymbolTM_dispatch_equal idx symbol onEqual onDifferent + inp work out hequal hinp hwork hout) + (branchWorkSymbolTM_equal_reachesIn idx symbol onEqual onDifferent hreach), + ?_, rfl, rfl, rfl⟩ + exact (workSymbolEqualWrap_halted_iff idx symbol onEqual onDifferent c').2 + hhalt + +theorem branchWorkSymbolTM_reachesIn_different_frame_internal + (idx : Fin n) (symbol : Γ) (onEqual onDifferent : TM n) + (inp : Tape) (work : Fin n → Tape) (out : Tape) + {t : ℕ} {c' : Cfg n onDifferent.Q} + (hdifferent : (work idx).read ≠ symbol) + (hinp : inp.read ≠ Γ.start) (hwork : ∀ i, (work i).read ≠ Γ.start) + (hout : out.read ≠ Γ.start) + (hreach : onDifferent.reachesIn t + { state := onDifferent.qstart, input := inp, work := work, output := out } + c') + (hhalt : onDifferent.halted c') : + ∃ C, + (branchWorkSymbolTM idx symbol onEqual onDifferent).reachesIn (t + 1) + { state := (branchWorkSymbolTM idx symbol onEqual onDifferent).qstart + input := inp + work := work + output := out } C ∧ + (branchWorkSymbolTM idx symbol onEqual onDifferent).halted C ∧ + C.input = c'.input ∧ C.work = c'.work ∧ C.output = c'.output := by + let C := workSymbolDifferentWrap idx symbol onEqual onDifferent c' + refine ⟨C, .step + (branchWorkSymbolTM_dispatch_different idx symbol onEqual onDifferent + inp work out hdifferent hinp hwork hout) + (branchWorkSymbolTM_different_reachesIn idx symbol onEqual onDifferent + hreach), ?_, rfl, rfl, rfl⟩ + exact (workSymbolDifferentWrap_halted_iff idx symbol onEqual onDifferent + c').2 hhalt + +theorem IsTransducer.branchWorkSymbolTM_internal + {idx : Fin n} {symbol : Γ} {onEqual onDifferent : TM n} + (hequal : onEqual.IsTransducer) (hdifferent : onDifferent.IsTransducer) : + (branchWorkSymbolTM idx symbol onEqual onDifferent).IsTransducer := by + intro state iHead wHeads oHead + cases state with + | inl phase => + cases phase with + | dispatch => + simp only [branchWorkSymbolTM] + split <;> cases oHead <;> simp [allReadBack, idleDir] + | done => cases oHead <;> simp [branchWorkSymbolTM, allIdle, idleDir] + | inr branchState => + cases branchState with + | inl q => + simp only [branchWorkSymbolTM] + split + · cases oHead <;> simp [allReadBack, idleDir] + · exact hequal q iHead wHeads oHead + | inr q => + simp only [branchWorkSymbolTM] + split + · cases oHead <;> simp [allReadBack, idleDir] + · exact hdifferent q iHead wHeads oHead + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Composition.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Composition.lean new file mode 100644 index 0000000000..f07599a08e --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Composition.lean @@ -0,0 +1,63 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Composition.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Composition.Internal + +/-! +# Sequential composition after function computation + +`TM.compositionTM tmF tmG` is an executable deterministic machine that runs +`tmF`, copies its delimited output onto a fresh virtual-input tape, and then +runs `tmG` on that output. Work tapes of the two machines occupy disjoint +blocks, and the intermediate raw output may contain arbitrary junk after its +first delimiter. + +## Main result + +- `TM.compositionTM_computesInTime` — correctness with a monotone coarse time bound +- `TM.compositionTM_decidesInTime` — function computation followed by a decider +-/ + + +public section + +namespace Complexity + +namespace TM + +variable {nf ng : ℕ} + +/-- Sequential deterministic function composition. The first computation, +two copy/rewind passes, four phase transitions, and the second computation fit +within `4 * TF(n) + 11 + TG(TF(n))` whenever `TG` is monotone. -/ +theorem compositionTM_computesInTime + {tmF : TM nf} {tmG : TM ng} + {f g : List Bool → List Bool} {TF TG : ℕ → ℕ} + (hF : tmF.ComputesInTime f TF) + (hG : tmG.ComputesInTime g TG) + (hmono : Monotone TG) : + (compositionTM tmF tmG).ComputesInTime (g ∘ f) + (fun n => 4 * TF n + 11 + TG (TF n)) := + compositionTM_computesInTime_internal hF hG hmono + +/-- Sequential deterministic preprocessing followed by a language decider. +The composite decides the preimage language with the same coarse monotone time +bound as function composition. -/ +theorem compositionTM_decidesInTime + {tmF : TM nf} {tmG : TM ng} + {f : List Bool → List Bool} {L : Language} {TF TG : ℕ → ℕ} + (hF : tmF.ComputesInTime f TF) + (hG : tmG.DecidesInTime L TG) + (hmono : Monotone TG) : + (compositionTM tmF tmG).DecidesInTime (f ⁻¹' L) + (fun n => 4 * TF n + 11 + TG (TF n)) := + compositionTM_decidesInTime_preimage_internal hF hG hmono + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Composition/Defs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Composition/Defs.lean new file mode 100644 index 0000000000..178eaefc3b --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Composition/Defs.lean @@ -0,0 +1,127 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.RetargetCompute.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Lift +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Placement.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines + +/-! +# Sequential composition after function computation + +This file fixes the tape layout and executable phase pipeline used to feed one +deterministic function computation into a second machine. Proofs of correctness +and time bounds live in the internal and public theorem layers. + +For a function-computing `tmF : TM nf` and a second machine `tmG : TM ng`, the +composite has +`nf + 1 + (ng + 1)` work tapes: + +- `0 .. nf - 1`: work tapes of `tmF` +- `nf`: raw redirected output of `tmF` +- `nf + 1 .. nf + ng`: work tapes of `tmG` +- `nf + ng + 1`: canonical virtual input of `tmG` + +The raw output is rewound and copied to the fresh virtual-input tape before +`tmG` resumes after its compulsory first transition off the left-end markers. +-/ + + +@[expose] public section + +namespace Complexity + +namespace TM + +variable {nf ng : ℕ} + +/-- Work-tape count of the sequential composition machine. -/ +abbrev compositionTapeCount (nf ng : ℕ) := 0 + (nf + 1) + (ng + 1) + +/-- Physical work tape holding the raw redirected output of the first machine. -/ +def compositionRawOutputIdx (nf ng : ℕ) : Fin (compositionTapeCount nf ng) := + ⟨nf, by simp [compositionTapeCount]; omega⟩ + +@[simp] theorem compositionRawOutputIdx_val (nf ng : ℕ) : + (compositionRawOutputIdx nf ng).val = nf := rfl + +/-- Physical work tape holding the canonical virtual input of the second machine. -/ +def compositionVirtualInputIdx (nf ng : ℕ) : Fin (compositionTapeCount nf ng) := + ⟨nf + 1 + ng, by simp [compositionTapeCount]⟩ + +@[simp] theorem compositionVirtualInputIdx_val (nf ng : ℕ) : + (compositionVirtualInputIdx nf ng).val = nf + 1 + ng := rfl + +/-- The two pipeline tapes occupy distinct physical coordinates. -/ +theorem compositionRawOutputIdx_ne_virtualInputIdx (nf ng : ℕ) : + compositionRawOutputIdx nf ng ≠ compositionVirtualInputIdx nf ng := by + intro h + have := congrArg Fin.val h + simp only [compositionRawOutputIdx_val, compositionVirtualInputIdx_val] at this + omega + +/-- The raw-output coordinate is the placed last work tape of +`tmF.retargetOutput`. -/ +theorem compositionRawOutputIdx_eq_firstPlacedLast (nf ng : ℕ) : + compositionRawOutputIdx nf ng = + placeWorkIdx 0 (ng + 1) (Fin.last nf) := by + apply Fin.ext + simp [compositionRawOutputIdx, placeWorkIdx] + +/-- The virtual-input coordinate is the placed last work tape of +`retargetInputStarted tmG`. -/ +theorem compositionVirtualInputIdx_eq_secondPlacedLast (nf ng : ℕ) : + compositionVirtualInputIdx nf ng = + placeWorkIdx (0 + (nf + 1)) 0 (Fin.last ng) := by + apply Fin.ext + simp [compositionVirtualInputIdx, placeWorkIdx] + +/-- Physical coordinate of work tape `i` of the first computation. -/ +def compositionPrefixIdx (nf ng : ℕ) (i : Fin nf) : + Fin (compositionTapeCount nf ng) := + ⟨i.val, by simp [compositionTapeCount]; omega⟩ + +@[simp] theorem compositionPrefixIdx_val (nf ng : ℕ) (i : Fin nf) : + (compositionPrefixIdx nf ng i).val = i.val := rfl + +/-- Physical coordinate of source work tape `j` of the second computation. -/ +def compositionSecondWorkIdx (nf ng : ℕ) (j : Fin ng) : + Fin (compositionTapeCount nf ng) := + placeWorkIdx (0 + (nf + 1)) 0 (Fin.castSucc j) + +@[simp] theorem compositionSecondWorkIdx_val (nf ng : ℕ) (j : Fin ng) : + (compositionSecondWorkIdx nf ng j).val = nf + 1 + j.val := by + simp [compositionSecondWorkIdx, placeWorkIdx] + +/-- The first phase redirects `tmF`'s output into the raw-output tape and parks +the work-tape suffix reserved for the second computation. -/ +def compositionFirstTM (tmF : TM nf) (ng : ℕ) : TM (compositionTapeCount nf ng) := + placeWorkTM 0 (ng + 1) tmF.retargetOutput + +/-- The last phase places the already-started virtual-input wrapper for `tmG` +after the first computation's work and raw-output tapes. -/ +def compositionSecondTM (nf : ℕ) (tmG : TM ng) : TM (compositionTapeCount nf ng) := + placeWorkTM (0 + (nf + 1)) 0 (retargetInputStarted tmG) + +/-- Pipeline after the first computation: rewind its raw output, copy it onto +a clean virtual-input tape, rewind that tape, and run the second computation. -/ +def compositionTailTM (nf ng : ℕ) (tmG : TM ng) : TM (compositionTapeCount nf ng) := + seqTM (rewindWorkTM (compositionRawOutputIdx nf ng)) + (seqTM + (copyWorkToWorkTM (compositionRawOutputIdx nf ng) + (compositionVirtualInputIdx nf ng)) + (seqTM (rewindWorkTM (compositionVirtualInputIdx nf ng)) + (compositionSecondTM nf tmG))) + +/-- Executable sequential composition of a function computation with a second +deterministic machine. -/ +def compositionTM (tmF : TM nf) (tmG : TM ng) : TM (compositionTapeCount nf ng) := + seqTM (compositionFirstTM tmF ng) (compositionTailTM nf ng tmG) + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Composition/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Composition/Internal.lean new file mode 100644 index 0000000000..da309c6fde --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Composition/Internal.lean @@ -0,0 +1,130 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Composition.Internal.FirstPhase +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Composition.Internal.Tail +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.OutputBounds + +/-! +# Sequential composition correctness — proof internals + +This module connects the first function computation's placed raw-output +boundary to the normalization tail. It derives coarse monotone time bounds for +both function composition and preprocessing followed by a language decider. +-/ + + +public section + +namespace Complexity + +namespace TM + +variable {nf ng : ℕ} + +/-- Internal correctness theorem for the executable sequential function +composition machine. -/ +theorem compositionTM_computesInTime_internal + {tmF : TM nf} {tmG : TM ng} + {f g : List Bool → List Bool} {TF TG : ℕ → ℕ} + (hF : tmF.ComputesInTime f TF) + (hG : tmG.ComputesInTime g TG) + (hmono : Monotone TG) : + (compositionTM tmF tmG).ComputesInTime (g ∘ f) + (fun n => 4 * TF n + 11 + TG (TF n)) := by + intro x + obtain ⟨C, t, ht, hreachF, hhaltF, hrawOutput, hrawHead, + hvirtual, hscratch, hinputInv, hinputHead, hworkBoundary, + houtputParked⟩ := + compositionFirstTM_boundary_internal tmF ng hF x + let boundaryInput := transitionInput C.input + let boundaryWork : Fin (compositionTapeCount nf ng) → Tape := + fun i => transitionTape (C.work i) + let boundaryOutput := transitionTape C.output + have htail := compositionTailTM_hoareTime_internal (nf := nf) + tmG hG (f x) (TF x.length + 1) + obtain ⟨D, u, hu, hreachTail, hhaltTail, houtTail⟩ := + htail boundaryInput boundaryWork boundaryOutput (by + refine ⟨hrawOutput, (hworkBoundary _).1, ?_, hvirtual, hscratch, + houtputParked, hinputInv, hinputHead, ?_⟩ + · dsimp only [boundaryWork] + omega + · intro i + exact hworkBoundary (compositionPrefixIdx nf ng i)) + let first := compositionFirstTM tmF ng + let tail := compositionTailTM nf ng tmG + let final := phase2Wrap first tail D + refine ⟨final, t + 1 + u, ?_, ?_, ?_, ?_⟩ + · have hlength : (f x).length ≤ TF x.length := hF.output_length_le x + have hgBound : TG (f x).length ≤ TG (TF x.length) := hmono hlength + have hu' : u ≤ TF x.length + 1 + 2 * (f x).length + 9 + TG (f x).length := by + omega + change t + 1 + u ≤ 4 * TF x.length + 11 + TG (TF x.length) + omega + · have hreach := seqTM_reachesIn_of_reachesIn first tail + hreachF hhaltF hreachTail + simpa [compositionTM, first, tail, final, boundaryInput, boundaryWork, + boundaryOutput] using hreach + · show (compositionTM tmF tmG).halted final + simpa [compositionTM, first, tail, final] using + (phase2Wrap_halted_iff first tail D).2 hhaltTail + · simpa [final, phase2Wrap, Function.comp_apply] using houtTail + +/-- Internal correctness theorem for deterministic preprocessing followed by a +language decider. -/ +theorem compositionTM_decidesInTime_preimage_internal + {tmF : TM nf} {tmG : TM ng} + {f : List Bool → List Bool} {L : Language} {TF TG : ℕ → ℕ} + (hF : tmF.ComputesInTime f TF) + (hG : tmG.DecidesInTime L TG) + (hmono : Monotone TG) : + (compositionTM tmF tmG).DecidesInTime (f ⁻¹' L) + (fun n => 4 * TF n + 11 + TG (TF n)) := by + intro x + obtain ⟨C, t, ht, hreachF, hhaltF, hrawOutput, hrawHead, + hvirtual, hscratch, hinputInv, hinputHead, hworkBoundary, + houtputParked⟩ := + compositionFirstTM_boundary_internal tmF ng hF x + let boundaryInput := transitionInput C.input + let boundaryWork : Fin (compositionTapeCount nf ng) → Tape := + fun i => transitionTape (C.work i) + let boundaryOutput := transitionTape C.output + have htail := compositionTailTM_decides_hoareTime_internal (nf := nf) + tmG hG (f x) (TF x.length + 1) + obtain ⟨D, u, hu, hreachTail, hhaltTail, hyesTail, hnoTail⟩ := + htail boundaryInput boundaryWork boundaryOutput (by + refine ⟨hrawOutput, (hworkBoundary _).1, ?_, hvirtual, hscratch, + houtputParked, hinputInv, hinputHead, ?_⟩ + · dsimp only [boundaryWork] + omega + · intro i + exact hworkBoundary (compositionPrefixIdx nf ng i)) + let first := compositionFirstTM tmF ng + let tail := compositionTailTM nf ng tmG + let final := phase2Wrap first tail D + refine ⟨final, t + 1 + u, ?_, ?_, ?_, ?_, ?_⟩ + · have hlength : (f x).length ≤ TF x.length := hF.output_length_le x + have hgBound : TG (f x).length ≤ TG (TF x.length) := hmono hlength + have hu' : u ≤ TF x.length + 1 + 2 * (f x).length + 9 + TG (f x).length := by + omega + change t + 1 + u ≤ 4 * TF x.length + 11 + TG (TF x.length) + omega + · have hreach := seqTM_reachesIn_of_reachesIn first tail + hreachF hhaltF hreachTail + simpa [compositionTM, first, tail, final, boundaryInput, boundaryWork, + boundaryOutput] using hreach + · show (compositionTM tmF tmG).halted final + simpa [compositionTM, first, tail, final] using + (phase2Wrap_halted_iff first tail D).2 hhaltTail + · intro hx + simpa [final, phase2Wrap] using hyesTail hx + · intro hx + simpa [final, phase2Wrap] using hnoTail hx + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Composition/Internal/FirstPhase.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Composition/Internal/FirstPhase.lean new file mode 100644 index 0000000000..0fd06d2e9c --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Composition/Internal/FirstPhase.lean @@ -0,0 +1,187 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Composition.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.Internal.Generic +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Placement.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Internal + +/-! +# Function composition: first-phase boundary + +This module runs the first function machine with its output redirected to the +raw-output work tape, places that run in the composite layout, and exposes the +exact tape facts required by the normalization tail. +-/ + + +public section + +namespace Complexity + +namespace TM + +variable {nf ng : ℕ} + +/-- Start-tape well-formedness is preserved over a deterministic run. -/ +private theorem reachesIn_startInvariant {n : ℕ} {tm : TM n} + {t : ℕ} {c c' : Cfg n tm.Q} (hreach : tm.reachesIn t c c') + (hin : c.input.StartInvariant) + (hwork : ∀ i, (c.work i).StartInvariant) + (hout : c.output.StartInvariant) : + c'.input.StartInvariant ∧ (∀ i, (c'.work i).StartInvariant) ∧ + c'.output.StartInvariant := by + induction hreach with + | zero => exact ⟨hin, hwork, hout⟩ + | step hstep _ ih => + obtain ⟨hin1, hwork1, hout1⟩ := Tape.StartInvariant.step tm hstep hin hwork hout + exact ih hin1 hwork1 hout1 + +/-- A phase-boundary work-tape action preserves the start invariant and moves +the head off the left-end marker. -/ +private theorem transitionTape_boundary {t : Tape} (h : t.StartInvariant) : + (transitionTape t).StartInvariant ∧ 1 ≤ (transitionTape t).head := by + refine ⟨⟨?_, ?_⟩, one_le_head_transitionTape t h.1⟩ + · rw [transitionTape_cells t h.2] + exact h.1 + · intro j hj + rw [transitionTape_cells t h.2] + exact h.2 j hj + +/-- The input counterpart of `transitionTape_boundary`. -/ +private theorem transitionInput_boundary {t : Tape} (h : t.StartInvariant) : + (transitionInput t).StartInvariant ∧ 1 ≤ (transitionInput t).head := by + refine ⟨⟨?_, ?_⟩, transitionInput_head_ge t h.1⟩ + · rw [transitionInput_cells] + exact h.1 + · intro j hj + rw [transitionInput_cells] + exact h.2 j hj + +/-- A blank output tape whose head is still at zero or one becomes the +canonical parked blank tape at a phase boundary. -/ +private theorem transitionTape_blank_eq_parked {t : Tape} + (hcells : t.cells = (Tape.init []).cells) (hhead : t.head ≤ 1) : + transitionTape t = (Tape.init []).move Dir3.right := by + rcases Nat.le_one_iff_eq_zero_or_eq_one.mp hhead with hzero | hone + · have ht : t = Tape.init [] := Tape.ext hzero hcells + subst ht + rfl + · have ht : t = (Tape.init []).move Dir3.right := by + apply Tape.ext + · exact hone + · simpa only [Tape.move_cells] using hcells + subst ht + exact transitionTape_eq_self (by decide) + +/-- The first computation reaches a halted composite-layout boundary within +its original time bound. The raw output remains readable, the destination for +the canonical virtual input is still fresh, and every seam tape is parked in +a start-invariant state. -/ +theorem compositionFirstTM_boundary_internal (tmF : TM nf) (ng : ℕ) + {f : List Bool → List Bool} {T : ℕ → ℕ} + (hcomp : tmF.ComputesInTime f T) (x : List Bool) : + ∃ (C : Cfg (compositionTapeCount nf ng) (compositionFirstTM tmF ng).Q) + (t : ℕ), + t ≤ T x.length ∧ + (compositionFirstTM tmF ng).reachesIn t + ((compositionFirstTM tmF ng).initCfg x) C ∧ + (compositionFirstTM tmF ng).halted C ∧ + (transitionTape (C.work (compositionRawOutputIdx nf ng))).HasOutput (f x) ∧ + (transitionTape (C.work (compositionRawOutputIdx nf ng))).head ≤ t + 1 ∧ + transitionTape (C.work (compositionVirtualInputIdx nf ng)) = + (Tape.init []).move Dir3.right ∧ + (∀ j : Fin ng, + transitionTape (C.work (compositionSecondWorkIdx nf ng j)) = + (Tape.init []).move Dir3.right) ∧ + (transitionInput C.input).StartInvariant ∧ + 1 ≤ (transitionInput C.input).head ∧ + (∀ i, (transitionTape (C.work i)).StartInvariant ∧ + 1 ≤ (transitionTape (C.work i)).head) ∧ + transitionTape C.output = (Tape.init []).move Dir3.right := by + obtain ⟨cR, t, ht, hreachR, hhaltR, hrawR, houtCells, houtHead⟩ := + retargetOutput_computesInTime_boundary tmF hcomp x + obtain ⟨C, hreachC, hstateC, _hinputC, houtputC, hshapeC⟩ := + placeWorkTM_reachesIn_init_internal tmF.retargetOutput 0 (ng + 1) x hreachR + have hreachFirst : (compositionFirstTM tmF ng).reachesIn t + ((compositionFirstTM tmF ng).initCfg x) C := by + simpa [compositionFirstTM] using hreachC + have hhaltFirst : (compositionFirstTM tmF ng).halted C := by + show C.state = (compositionFirstTM tmF ng).qhalt + rw [hstateC] + exact hhaltR + have hrawC : (C.work (compositionRawOutputIdx nf ng)).HasOutput (f x) := by + rcases hshapeC with ht0 | hC + · subst t + cases hreachR + cases hreachC + simpa [compositionFirstTM, compositionRawOutputIdx, Cfg.init] using hrawR + · rw [hC, compositionRawOutputIdx_eq_firstPlacedLast, + placeWorkParkedCfg, placeWorkCfg_work_middle] + exact hrawR + have hvirtual : transitionTape (C.work (compositionVirtualInputIdx nf ng)) = + (Tape.init []).move Dir3.right := by + rcases hshapeC with ht0 | hC + · subst t + cases hreachC + rfl + · rw [hC] + have hnot : ¬placeWorkInMiddle 0 (nf + 1) + (compositionVirtualInputIdx nf ng) := by + simp [placeWorkInMiddle, compositionVirtualInputIdx] + change transitionTape + ((placeWorkCfg tmF.retargetOutput 0 (ng + 1) + (fun _ => (Tape.init []).move Dir3.right) cR).work + (compositionVirtualInputIdx nf ng)) = _ + rw [placeWorkCfg_work_extra _ _ _ _ _ _ hnot] + exact transitionTape_eq_self + (t := (Tape.init []).move Dir3.right) (by decide) + have hscratch : ∀ j : Fin ng, + transitionTape (C.work (compositionSecondWorkIdx nf ng j)) = + (Tape.init []).move Dir3.right := by + intro j + let idx := compositionSecondWorkIdx nf ng j + change transitionTape (C.work idx) = _ + rcases hshapeC with ht0 | hC + · subst t + cases hreachC + rfl + · rw [hC] + have hnot : ¬placeWorkInMiddle 0 (nf + 1) idx := by + simp [placeWorkInMiddle, idx] + change transitionTape + ((placeWorkCfg tmF.retargetOutput 0 (ng + 1) + (fun _ => (Tape.init []).move Dir3.right) cR).work idx) = _ + rw [placeWorkCfg_work_extra _ _ _ _ _ _ hnot] + exact transitionTape_eq_self + (t := (Tape.init []).move Dir3.right) (by decide) + have hinvariants := reachesIn_startInvariant hreachFirst + (Tape.StartInvariant.init_ofBool x) + (fun _ => Tape.StartInvariant.init_nil) + Tape.StartInvariant.init_nil + have hinBoundary := transitionInput_boundary hinvariants.1 + have hworkBoundary : ∀ i, (transitionTape (C.work i)).StartInvariant ∧ + 1 ≤ (transitionTape (C.work i)).head := + fun i => transitionTape_boundary (hinvariants.2.1 i) + have hrawOutput : + (transitionTape (C.work (compositionRawOutputIdx nf ng))).HasOutput (f x) := by + exact (Tape.hasOutput_congr + (transitionTape_cells _ (hinvariants.2.1 _).2) (f x)).mpr hrawC + have hheads := head_le_of_reachesIn (compositionFirstTM tmF ng) hreachFirst + have hrawHead : + (transitionTape (C.work (compositionRawOutputIdx nf ng))).head ≤ t + 1 := + head_transitionTape_le (hinvariants.2.1 _).1 (hheads.2.2 _) + have houtputParked : transitionTape C.output = + (Tape.init []).move Dir3.right := by + rw [houtputC] + exact transitionTape_blank_eq_parked houtCells houtHead + exact ⟨C, t, ht, hreachFirst, hhaltFirst, hrawOutput, hrawHead, hvirtual, + hscratch, hinBoundary.1, hinBoundary.2, hworkBoundary, houtputParked⟩ + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Composition/Internal/Tail.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Composition/Internal/Tail.lean new file mode 100644 index 0000000000..72ce2bd7f4 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Composition/Internal/Tail.lean @@ -0,0 +1,560 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Composition.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.CopyWorkOutput +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.RetargetCompute + +/-! +# Sequential-composition tail pipeline + +This module verifies the pipeline after the first function computation has +placed its raw output on the dedicated work tape. The pipeline rewinds that +tape, copies its delimited `HasOutput` value onto a fresh canonical tape, +rewinds the fresh tape, and runs the placed started-input wrapper for the +second machine. Its final output contract may describe either a computed string +or a decision verdict. + +The phase-expanded bound is +`(B + 2) + 1 + (|y| + 1) + 1 + (|y| + 1 + 2) + 1 + G(|y|)`, +which simplifies to `B + 2 * |y| + 9 + G(|y|)`. +-/ + + +@[expose] public section + +namespace Complexity + +namespace TM + +/-- A start-invariant tape at a positive head does not read `▷`. -/ +private theorem read_ne_start_of_startInvariant {t : Tape} + (hinv : Tape.StartInvariant t) (hhead : 1 ≤ t.head) : + t.read ≠ Γ.start := by + show t.cells t.head ≠ Γ.start + exact hinv.2 t.head hhead + +/-- A start-invariant tape at a positive head is unchanged by a `seqTM` +boundary. -/ +private theorem transitionTape_eq_of_startInvariant {t : Tape} + (hinv : Tape.StartInvariant t) (hhead : 1 ≤ t.head) : + transitionTape t = t := + transitionTape_eq_self (read_ne_start_of_startInvariant hinv hhead) + +/-- Boundary contract consumed only by the proof-internal composition tail. -/ +def CompositionTailPre (nf ng : ℕ) (y : List Bool) (B : ℕ) + (inp : Tape) (work : Fin (compositionTapeCount nf ng) → Tape) + (out : Tape) : Prop := + (work (compositionRawOutputIdx nf ng)).HasOutput y ∧ + Tape.StartInvariant (work (compositionRawOutputIdx nf ng)) ∧ + (work (compositionRawOutputIdx nf ng)).head ≤ B ∧ + work (compositionVirtualInputIdx nf ng) = (Tape.init []).move Dir3.right ∧ + (∀ j : Fin ng, work (compositionSecondWorkIdx nf ng j) = + (Tape.init []).move Dir3.right) ∧ + out = (Tape.init []).move Dir3.right ∧ + Tape.StartInvariant inp ∧ 1 ≤ inp.head ∧ + (∀ i : Fin nf, Tape.StartInvariant (work (compositionPrefixIdx nf ng i)) ∧ + 1 ≤ (work (compositionPrefixIdx nf ng i)).head) + +/-- Generic post-first-computation tail driven by a virtual-input run contract. + +The prefix tapes are arbitrary stable frame tapes. The raw tape may initially +have any head up to `B`, and cells after its first output delimiter may contain +arbitrary junk. The virtual-input tape, second-machine scratch block, and real +output begin in their canonical parked blank shapes. -/ +private theorem compositionTailTM_hoareTime_of_virtualRun_internal + {nf ng : ℕ} (tmG : TM ng) {G : ℕ → ℕ} + (y : List Bool) (B : ℕ) (P : Tape → Prop) + (hG : ∀ realInput : Tape, + ∃ (c' : Cfg (ng + 1) tmG.Q) (t : ℕ), + t ≤ G y.length ∧ + (retargetInputStarted tmG).reachesIn t + (retargetInputStartedCfg tmG y realInput) c' ∧ + (retargetInputStarted tmG).halted c' ∧ P c'.output) : + (compositionTailTM nf ng tmG).HoareTime + (CompositionTailPre nf ng y B) + (fun _inp _work out => P out) + ((B + 2) + 1 + ((y.length + 1) + 1 + + ((y.length + 1 + 2) + 1 + G y.length))) := by + intro inp work out hpre + rcases hpre with + ⟨hrawOutput, hrawInv, hrawBound, hvinBlank, hgBlank, houtBlank, + hinv, hinputHead, hprefix⟩ + let raw := compositionRawOutputIdx nf ng + let vin := compositionVirtualInputIdx nf ng + change (work raw).HasOutput y at hrawOutput + change Tape.StartInvariant (work raw) at hrawInv + change (work raw).head ≤ B at hrawBound + change work vin = (Tape.init []).move Dir3.right at hvinBlank + have hrawVin : raw ≠ vin := compositionRawOutputIdx_ne_virtualInputIdx nf ng + have houtInv : Tape.StartInvariant out := by + rw [houtBlank] + exact Tape.StartInvariant.init_nil.move Dir3.right + have houtHead : 1 ≤ out.head := by rw [houtBlank]; simp [Tape.move] + have hvinInv : Tape.StartInvariant (work vin) := by + rw [hvinBlank] + exact Tape.StartInvariant.init_nil.move Dir3.right + have hvinHead : 1 ≤ (work vin).head := by + rw [hvinBlank] + simp [Tape.move] + have hotherStable : ∀ i, i ≠ raw → + Tape.StartInvariant (work i) ∧ 1 ≤ (work i).head := by + intro i hiRaw + by_cases hiPrefix : i.val < nf + · let j : Fin nf := ⟨i.val, hiPrefix⟩ + have hidx : compositionPrefixIdx nf ng j = i := by + apply Fin.ext + rfl + rw [← hidx] + exact hprefix j + by_cases hiVin : i = vin + · subst i + exact ⟨hvinInv, hvinHead⟩ + · have hiLower : nf + 1 ≤ i.val := by + have hneVal : i.val ≠ nf := by + intro heq + apply hiRaw + apply Fin.ext + simpa [raw] using heq + omega + have hiUpper : i.val < nf + 1 + ng := by + have hlt := i.isLt + have hneVinVal : i.val ≠ nf + 1 + ng := by + intro heq + apply hiVin + apply Fin.ext + simpa [vin] using heq + simp only [compositionTapeCount] at hlt + omega + let j : Fin ng := ⟨i.val - (nf + 1), by omega⟩ + have hidx : compositionSecondWorkIdx nf ng j = i := by + apply Fin.ext + simp [compositionSecondWorkIdx, placeWorkIdx, j] + omega + rw [← hidx, hgBlank j] + exact ⟨Tape.StartInvariant.init_nil.move Dir3.right, by simp [Tape.move]⟩ + let FrameRaw : TapePred (compositionTapeCount nf ng) := + fun inp' work' out' => + (work' raw).cells = (work raw).cells ∧ + inp' = inp ∧ out' = out ∧ ∀ i, i ≠ raw → work' i = work i + have hrewRaw := rewindWorkTM_hoareTime_frame raw B + (P := FrameRaw) (by + intro inp₀ work₀ out₀ inp' work' out' hframe hcells _hhead hother hinp' + houtCells houtHead' + rcases hframe with ⟨hrawCells₀, hinp₀, hout₀, hwork₀⟩ + have hout' : out' = out₀ := Tape.ext houtHead' houtCells + exact ⟨hcells.trans hrawCells₀, hinp'.trans hinp₀, + hout'.trans hout₀, fun i hi => (hother i hi).trans (hwork₀ i hi)⟩) + have hrewPre : + (work raw).cells 0 = Γ.start ∧ + (∀ j, j ≥ 1 → (work raw).cells j ≠ Γ.start) ∧ + (work raw).head ≤ B ∧ inp.read ≠ Γ.start ∧ + out.read ≠ Γ.start ∧ out.head ≥ 1 ∧ + (∀ i, i ≠ raw → (work i).read ≠ Γ.start ∧ (work i).head ≥ 1) ∧ + FrameRaw inp work out := by + refine ⟨hrawInv.1, hrawInv.2, hrawBound, + read_ne_start_of_startInvariant hinv hinputHead, + read_ne_start_of_startInvariant houtInv houtHead, houtHead, ?_, ?_⟩ + · intro i hi + exact ⟨read_ne_start_of_startInvariant (hotherStable i hi).1 + (hotherStable i hi).2, (hotherStable i hi).2⟩ + · exact ⟨rfl, rfl, rfl, fun _ _ => rfl⟩ + obtain ⟨c₁, t₁, ht₁, hreach₁, hhalt₁, hc₁Head, hc₁Frame⟩ := + hrewRaw inp work out hrewPre + rcases hc₁Frame with ⟨hc₁RawCells, hc₁Input, hc₁Output, hc₁Other⟩ + let source : Tape := { head := 1, cells := (work raw).cells } + have hc₁Raw : c₁.work raw = source := Tape.ext hc₁Head hc₁RawCells + have hsourceInv : Tape.StartInvariant source := by + exact ⟨by simpa [source] using hrawInv.1, + by intro j hj; simpa [source] using hrawInv.2 j hj⟩ + have hsourceOutput : source.HasOutput y := by + exact (Tape.hasOutput_congr (by rfl) y).mpr hrawOutput + have hc₁WorkStable : ∀ i, Tape.StartInvariant (c₁.work i) ∧ + 1 ≤ (c₁.work i).head := by + intro i + by_cases hi : i = raw + · subst i + rw [hc₁Raw] + exact ⟨hsourceInv, by simp [source]⟩ + · rw [hc₁Other i hi] + exact hotherStable i hi + have hc₁InputTr : transitionInput c₁.input = c₁.input := by + rw [hc₁Input] + exact transitionInput_eq_self (read_ne_start_of_startInvariant hinv hinputHead) + have hc₁OutputTr : transitionTape c₁.output = c₁.output := by + rw [hc₁Output] + exact transitionTape_eq_of_startInvariant houtInv houtHead + have hc₁WorkTr : ∀ i, transitionTape (c₁.work i) = c₁.work i := by + intro i + exact transitionTape_eq_of_startInvariant (hc₁WorkStable i).1 + (hc₁WorkStable i).2 + let FrameCopy : TapePred (compositionTapeCount nf ng) := + fun inp' work' out' => + inp' = inp ∧ out' = out ∧ + ∀ i, i ≠ raw → i ≠ vin → work' i = work i + have hcopy := copyWorkToWorkTM_hoareTime_frame_of_hasOutput raw vin hrawVin y source + (P := FrameCopy) (by + intro inp₀ work₀ out₀ inp' work' out' hframe _hsrcCells _hsrcHead + _hsrcOutput _hdstPrefix _hdst0 hinp' hout' hother + rcases hframe with ⟨hinp₀, hout₀, hwork₀⟩ + exact ⟨hinp'.trans hinp₀, hout'.trans hout₀, + fun i hiRaw hiVin => (hother i hiRaw hiVin).trans (hwork₀ i hiRaw hiVin)⟩) + have hcopyPre : + (fun i => transitionTape (c₁.work i)) raw = source ∧ + source.head = 1 ∧ source.HasOutput y ∧ + (fun i => transitionTape (c₁.work i)) vin = + (Tape.init []).move Dir3.right ∧ + (transitionInput c₁.input).read ≠ Γ.start ∧ + (transitionTape c₁.output).read ≠ Γ.start ∧ + 1 ≤ (transitionTape c₁.output).head ∧ + (∀ i, i ≠ raw → i ≠ vin → + ((fun i => transitionTape (c₁.work i)) i).read ≠ Γ.start ∧ + 1 ≤ ((fun i => transitionTape (c₁.work i)) i).head) ∧ + FrameCopy (transitionInput c₁.input) + (fun i => transitionTape (c₁.work i)) (transitionTape c₁.output) := by + refine ⟨?_, rfl, hsourceOutput, ?_, ?_, ?_, ?_, ?_, ?_⟩ + · change transitionTape (c₁.work raw) = source + rw [hc₁WorkTr raw, hc₁Raw] + · change transitionTape (c₁.work vin) = (Tape.init []).move Dir3.right + rw [hc₁WorkTr vin, hc₁Other vin hrawVin.symm, hvinBlank] + · rw [hc₁InputTr, hc₁Input] + exact read_ne_start_of_startInvariant hinv hinputHead + · rw [hc₁OutputTr, hc₁Output] + exact read_ne_start_of_startInvariant houtInv houtHead + · rw [hc₁OutputTr, hc₁Output] + exact houtHead + · intro i hiRaw hiVin + change (transitionTape (c₁.work i)).read ≠ Γ.start ∧ + 1 ≤ (transitionTape (c₁.work i)).head + rw [hc₁WorkTr i, hc₁Other i hiRaw] + exact ⟨read_ne_start_of_startInvariant (hotherStable i hiRaw).1 + (hotherStable i hiRaw).2, (hotherStable i hiRaw).2⟩ + · refine ⟨?_, ?_, ?_⟩ + · rw [hc₁InputTr, hc₁Input] + · rw [hc₁OutputTr, hc₁Output] + · intro i hiRaw hiVin + change transitionTape (c₁.work i) = work i + rw [hc₁WorkTr i, hc₁Other i hiRaw] + obtain ⟨c₂, t₂, ht₂, hreach₂, hhalt₂, hc₂RawCells, + hc₂RawHead, hc₂RawOutput, hc₂VinPrefix, hc₂Vin0, hc₂Frame⟩ := + hcopy (transitionInput c₁.input) (fun i => transitionTape (c₁.work i)) + (transitionTape c₁.output) hcopyPre + rcases hc₂Frame with ⟨hc₂Input, hc₂Output, hc₂Other⟩ + have hc₂VinCells : (c₂.work vin).cells = + (Tape.init (y.map Γ.ofBool)).cells := + hc₂VinPrefix.cells_eq_init hc₂Vin0 + have hc₂RawInv : Tape.StartInvariant (c₂.work raw) := by + refine ⟨?_, ?_⟩ + · rw [hc₂RawCells] + exact hsourceInv.1 + · intro j hj + rw [hc₂RawCells] + exact hsourceInv.2 j hj + have hc₂VinInv : Tape.StartInvariant (c₂.work vin) := by + refine ⟨?_, ?_⟩ + · rw [hc₂VinCells] + rfl + · intro j hj + rw [hc₂VinCells] + exact Tape.init_ofBool_cells_ne_start y j hj + have hc₂WorkStable : ∀ i, Tape.StartInvariant (c₂.work i) ∧ + 1 ≤ (c₂.work i).head := by + intro i + by_cases hiRaw : i = raw + · subst i + exact ⟨hc₂RawInv, by omega⟩ + by_cases hiVin : i = vin + · subst i + refine ⟨hc₂VinInv, ?_⟩ + rw [hc₂VinPrefix.1] + omega + · rw [hc₂Other i hiRaw hiVin] + exact hotherStable i hiRaw + have hc₂InputTr : transitionInput c₂.input = c₂.input := by + rw [hc₂Input] + exact transitionInput_eq_self (read_ne_start_of_startInvariant hinv hinputHead) + have hc₂OutputTr : transitionTape c₂.output = c₂.output := by + rw [hc₂Output] + exact transitionTape_eq_of_startInvariant houtInv houtHead + have hc₂WorkTr : ∀ i, transitionTape (c₂.work i) = c₂.work i := by + intro i + exact transitionTape_eq_of_startInvariant (hc₂WorkStable i).1 + (hc₂WorkStable i).2 + let FrameVin : TapePred (compositionTapeCount nf ng) := + fun inp' work' out' => + (work' vin).cells = (Tape.init (y.map Γ.ofBool)).cells ∧ + inp' = inp ∧ out' = out ∧ ∀ i, i ≠ vin → work' i = c₂.work i + have hrewVin := rewindWorkTM_hoareTime_frame vin (y.length + 1) + (P := FrameVin) (by + intro inp₀ work₀ out₀ inp' work' out' hframe hcells _hhead hother hinp' + houtCells houtHead' + rcases hframe with ⟨hvinCells₀, hinp₀, hout₀, hwork₀⟩ + have hout' : out' = out₀ := Tape.ext houtHead' houtCells + exact ⟨hcells.trans hvinCells₀, hinp'.trans hinp₀, + hout'.trans hout₀, fun i hi => (hother i hi).trans (hwork₀ i hi)⟩) + have hrewVinPre : + ((fun i => transitionTape (c₂.work i)) vin).cells 0 = Γ.start ∧ + (∀ j, j ≥ 1 → ((fun i => transitionTape (c₂.work i)) vin).cells j ≠ + Γ.start) ∧ + ((fun i => transitionTape (c₂.work i)) vin).head ≤ y.length + 1 ∧ + (transitionInput c₂.input).read ≠ Γ.start ∧ + (transitionTape c₂.output).read ≠ Γ.start ∧ + (transitionTape c₂.output).head ≥ 1 ∧ + (∀ i, i ≠ vin → + ((fun i => transitionTape (c₂.work i)) i).read ≠ Γ.start ∧ + ((fun i => transitionTape (c₂.work i)) i).head ≥ 1) ∧ + FrameVin (transitionInput c₂.input) + (fun i => transitionTape (c₂.work i)) (transitionTape c₂.output) := by + refine ⟨?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_⟩ + · change (transitionTape (c₂.work vin)).cells 0 = Γ.start + rw [hc₂WorkTr vin] + exact hc₂VinInv.1 + · intro j hj + change (transitionTape (c₂.work vin)).cells j ≠ Γ.start + rw [hc₂WorkTr vin] + exact hc₂VinInv.2 j hj + · change (transitionTape (c₂.work vin)).head ≤ y.length + 1 + rw [hc₂WorkTr vin, hc₂VinPrefix.1] + · rw [hc₂InputTr, hc₂Input] + exact read_ne_start_of_startInvariant hinv hinputHead + · rw [hc₂OutputTr, hc₂Output] + exact read_ne_start_of_startInvariant houtInv houtHead + · rw [hc₂OutputTr, hc₂Output] + exact houtHead + · intro i hi + change (transitionTape (c₂.work i)).read ≠ Γ.start ∧ + (transitionTape (c₂.work i)).head ≥ 1 + rw [hc₂WorkTr i] + exact ⟨read_ne_start_of_startInvariant (hc₂WorkStable i).1 + (hc₂WorkStable i).2, (hc₂WorkStable i).2⟩ + · refine ⟨?_, ?_, ?_, ?_⟩ + · change (transitionTape (c₂.work vin)).cells = + (Tape.init (y.map Γ.ofBool)).cells + rw [hc₂WorkTr vin] + exact hc₂VinCells + · rw [hc₂InputTr, hc₂Input] + · rw [hc₂OutputTr, hc₂Output] + · intro i hi + change transitionTape (c₂.work i) = c₂.work i + rw [hc₂WorkTr i] + obtain ⟨c₃, t₃, ht₃, hreach₃, hhalt₃, hc₃VinHead, hc₃Frame⟩ := + hrewVin (transitionInput c₂.input) (fun i => transitionTape (c₂.work i)) + (transitionTape c₂.output) hrewVinPre + rcases hc₃Frame with ⟨hc₃VinCells, hc₃Input, hc₃Output, hc₃Other⟩ + have hc₃Vin : c₃.work vin = + (Tape.init (y.map Γ.ofBool)).move Dir3.right := by + exact Tape.ext hc₃VinHead hc₃VinCells + have hc₃WorkStable : ∀ i, Tape.StartInvariant (c₃.work i) ∧ + 1 ≤ (c₃.work i).head := by + intro i + by_cases hi : i = vin + · subst i + rw [hc₃Vin] + exact ⟨Tape.StartInvariant.init_ofBool y |>.move Dir3.right, by simp [Tape.move]⟩ + · rw [hc₃Other i hi] + exact hc₂WorkStable i + have hc₃InputTr : transitionInput c₃.input = c₃.input := by + rw [hc₃Input] + exact transitionInput_eq_self (read_ne_start_of_startInvariant hinv hinputHead) + have hc₃OutputTr : transitionTape c₃.output = c₃.output := by + rw [hc₃Output] + exact transitionTape_eq_of_startInvariant houtInv houtHead + have hc₃WorkTr : ∀ i, transitionTape (c₃.work i) = c₃.work i := by + intro i + exact transitionTape_eq_of_startInvariant (hc₃WorkStable i).1 + (hc₃WorkStable i).2 + let secondPre := 0 + (nf + 1) + let extras : Fin (secondPre + (ng + 1) + 0) → Tape := + fun i => transitionTape (c₃.work i) + let realInput := transitionInput c₃.input + have hextrasInv : ∀ i, ¬placeWorkInMiddle secondPre (ng + 1) i → + Tape.StartInvariant (extras i) := by + intro i _hi + rw [show extras i = c₃.work i from hc₃WorkTr i] + exact (hc₃WorkStable i).1 + have hextrasHead : ∀ i, ¬placeWorkInMiddle secondPre (ng + 1) i → + 1 ≤ (extras i).head := by + intro i _hi + rw [show extras i = c₃.work i from hc₃WorkTr i] + exact (hc₃WorkStable i).2 + obtain ⟨c₄, t₄, ht₄, hreachSource₄, hhaltSource₄, hout₄⟩ := hG realInput + let C₄ := placeWorkCfg (retargetInputStarted tmG) secondPre 0 extras c₄ + have hreach₄ : + (placeWorkTM secondPre 0 (retargetInputStarted tmG)).reachesIn t₄ + (placeWorkCfg (retargetInputStarted tmG) secondPre 0 extras + (retargetInputStartedCfg tmG y realInput)) C₄ := by + apply placeWorkTM_reachesIn_placeWorkCfg_stable_internal + (retargetInputStarted tmG) secondPre 0 extras hreachSource₄ + intro i hi + show (extras i).cells (extras i).head ≠ Γ.start + exact (hextrasInv i hi).2 (extras i).head (hextrasHead i hi) + have hhalt₄ : + (placeWorkTM secondPre 0 (retargetInputStarted tmG)).halted C₄ := by + show c₄.state = (retargetInputStarted tmG).qhalt + exact hhaltSource₄ + let gEntry : Cfg (compositionTapeCount nf ng) (compositionSecondTM nf tmG).Q := + { state := (compositionSecondTM nf tmG).qstart + input := transitionInput c₃.input + work := fun i => transitionTape (c₃.work i) + output := transitionTape c₃.output } + have hEntry : + placeWorkCfg (retargetInputStarted tmG) secondPre 0 extras + (retargetInputStartedCfg tmG y realInput) = gEntry := by + refine Cfg.ext rfl rfl ?_ ?_ + · funext i + by_cases hmid : placeWorkInMiddle secondPre (ng + 1) i + · let j := placeWorkCoord secondPre (ng + 1) i hmid + have hphys : placeWorkIdx secondPre 0 j = i := + placeWorkIdx_placeWorkCoord i hmid + by_cases hj : j.val < ng + · let jG : Fin ng := ⟨j.val, hj⟩ + have hjcast : Fin.castSucc jG = j := by + apply Fin.ext + rfl + have hiVal : i.val = secondPre + j.val := by + have hv := congrArg Fin.val hphys + simp only [placeWorkIdx_val] at hv + omega + have hiRaw : i ≠ raw := by + change i ≠ compositionRawOutputIdx nf ng + intro heq + have hv := congrArg Fin.val heq + simp only [compositionRawOutputIdx_val] at hv + dsimp only [secondPre] at hiVal + omega + have hiVin : i ≠ vin := by + change i ≠ compositionVirtualInputIdx nf ng + intro heq + have hv := congrArg Fin.val heq + simp only [compositionVirtualInputIdx_val] at hv + dsimp only [secondPre] at hiVal + omega + have hblank : c₃.work i = (Tape.init []).move Dir3.right := by + calc + c₃.work i = c₂.work i := hc₃Other i hiVin + _ = work i := hc₂Other i hiRaw hiVin + _ = (Tape.init []).move Dir3.right := by + rw [← hphys, ← hjcast] + exact hgBlank jG + change + (placeWorkCfg (retargetInputStarted tmG) secondPre 0 extras + (retargetInputStartedCfg tmG y realInput)).work i = + transitionTape (c₃.work i) + calc + _ = (retargetInputStartedCfg tmG y realInput).work j := by + rw [← hphys, placeWorkCfg_work_middle] + _ = (Tape.init []).move Dir3.right := by + exact retargetInputStartedCfg_work_lt tmG y realInput j hj + _ = transitionTape (c₃.work i) := by + rw [hc₃WorkTr i, hblank] + · have hjval : j.val = ng := by + have := j.isLt + omega + have hjlast : j = Fin.last ng := by + apply Fin.ext + simpa using hjval + have hiVin : i = vin := by + rw [← hphys, hjlast] + exact (compositionVirtualInputIdx_eq_secondPlacedLast nf ng).symm + change + (placeWorkCfg (retargetInputStarted tmG) secondPre 0 extras + (retargetInputStartedCfg tmG y realInput)).work i = + transitionTape (c₃.work i) + calc + _ = (retargetInputStartedCfg tmG y realInput).work j := by + rw [← hphys, placeWorkCfg_work_middle] + _ = (Tape.init (y.map Γ.ofBool)).move Dir3.right := by + rw [hjlast] + simp [Fin.last] + _ = transitionTape (c₃.work i) := by + rw [hiVin, hc₃WorkTr vin, hc₃Vin] + · change + (placeWorkCfg (retargetInputStarted tmG) secondPre 0 extras + (retargetInputStartedCfg tmG y realInput)).work i = + transitionTape (c₃.work i) + rw [placeWorkCfg_work_extra _ _ _ _ _ i hmid] + · change (retargetInputStartedCfg tmG y realInput).output = + transitionTape c₃.output + rw [retargetInputStartedCfg_output, hc₃OutputTr, hc₃Output, houtBlank] + have hreach₄' : (compositionSecondTM nf tmG).reachesIn t₄ gEntry C₄ := by + change (placeWorkTM secondPre 0 (retargetInputStarted tmG)).reachesIn t₄ gEntry C₄ + rw [← hEntry] + exact hreach₄ + let tm₃ := rewindWorkTM vin + let tm₂ := copyWorkToWorkTM raw vin + let tm₁ := rewindWorkTM raw + let c₃₄ := phase2Wrap tm₃ (compositionSecondTM nf tmG) C₄ + have hreach₃₄ : (seqTM tm₃ (compositionSecondTM nf tmG)).reachesIn + (t₃ + 1 + t₄) + (phase1Wrap tm₃ (compositionSecondTM nf tmG) + { state := tm₃.qstart, input := transitionInput c₂.input, + work := fun i => transitionTape (c₂.work i), + output := transitionTape c₂.output }) c₃₄ := by + exact seqTM_reachesIn_of_reachesIn tm₃ (compositionSecondTM nf tmG) + hreach₃ hhalt₃ hreach₄' + let tm₃₄ := seqTM tm₃ (compositionSecondTM nf tmG) + let c₂₃₄ := phase2Wrap tm₂ tm₃₄ c₃₄ + have hreach₂₃₄ : (seqTM tm₂ tm₃₄).reachesIn + (t₂ + 1 + (t₃ + 1 + t₄)) + (phase1Wrap tm₂ tm₃₄ + { state := tm₂.qstart, input := transitionInput c₁.input, + work := fun i => transitionTape (c₁.work i), + output := transitionTape c₁.output }) c₂₃₄ := by + exact seqTM_reachesIn_of_reachesIn tm₂ tm₃₄ hreach₂ hhalt₂ hreach₃₄ + let tm₂₃₄ := seqTM tm₂ tm₃₄ + let cFinal := phase2Wrap tm₁ tm₂₃₄ c₂₃₄ + have hreachFinal : (compositionTailTM nf ng tmG).reachesIn + (t₁ + 1 + (t₂ + 1 + (t₃ + 1 + t₄))) + { state := (compositionTailTM nf ng tmG).qstart, + input := inp, work := work, output := out } cFinal := by + change (seqTM tm₁ tm₂₃₄).reachesIn _ _ _ + exact seqTM_reachesIn_of_reachesIn tm₁ tm₂₃₄ + hreach₁ hhalt₁ hreach₂₃₄ + refine ⟨cFinal, t₁ + 1 + (t₂ + 1 + (t₃ + 1 + t₄)), ?_, + hreachFinal, ?_, ?_⟩ + · omega + · change (seqTM tm₁ tm₂₃₄).halted cFinal + rw [phase2Wrap_halted_iff, phase2Wrap_halted_iff, phase2Wrap_halted_iff] + exact hhalt₄ + · show P C₄.output + exact hout₄ + +/-- The post-first-computation tail correctly runs the second function. -/ +theorem compositionTailTM_hoareTime_internal {nf ng : ℕ} (tmG : TM ng) + {g : List Bool → List Bool} {G : ℕ → ℕ} + (hG : tmG.ComputesInTime g G) (y : List Bool) (B : ℕ) : + (compositionTailTM nf ng tmG).HoareTime + (CompositionTailPre nf ng y B) + (fun _inp _work out => out.HasOutput (g y)) + ((B + 2) + 1 + ((y.length + 1) + 1 + + ((y.length + 1 + 2) + 1 + G y.length))) := by + apply compositionTailTM_hoareTime_of_virtualRun_internal tmG y B + (fun out => out.HasOutput (g y)) + intro realInput + exact retargetInputStarted_computesVirtual tmG hG y realInput + +/-- The same tail pipeline retains a second machine's decision verdict. -/ +theorem compositionTailTM_decides_hoareTime_internal {nf ng : ℕ} (tmG : TM ng) + {L : Language} {G : ℕ → ℕ} + (hG : tmG.DecidesInTime L G) (y : List Bool) (B : ℕ) : + (compositionTailTM nf ng tmG).HoareTime + (CompositionTailPre nf ng y B) + (fun _inp _work out => + (y ∈ L → out.cells 1 = Γ.one) ∧ + (y ∉ L → out.cells 1 = Γ.zero)) + ((B + 2) + 1 + ((y.length + 1) + 1 + + ((y.length + 1 + 2) + 1 + G y.length))) := by + apply compositionTailTM_hoareTime_of_virtualRun_internal tmG y B + (fun out => + (y ∈ L → out.cells 1 = Γ.one) ∧ + (y ∉ L → out.cells 1 = Γ.zero)) + intro realInput + exact retargetInputStarted_decidesVirtual tmG hG y realInput + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Composition/PairWithInput.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Composition/PairWithInput.lean new file mode 100644 index 0000000000..9bbd4b304b --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Composition/PairWithInput.lean @@ -0,0 +1,43 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Composition.PairWithInput.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Composition.PairWithInput.Internal + +/-! +# Pair a computed value with the original input + +This module exposes a generic deterministic fanout combinator. If `tmF` +computes `f`, then `pairWithInputTM tmF` computes `x ↦ pair (f x) x` while +retaining a concrete polynomial-preserving time bound. + +## Main result + +- `TM.pairWithInputTM_computesInTime` — computation paired with original input +-/ + + +public section + +namespace Complexity + +namespace TM + +variable {nf : ℕ} + +/-- Pairing a computed string with the unchanged original input costs at most +five source-time budgets, one linear input scan, and fixedValue seam overhead. -/ +theorem pairWithInputTM_computesInTime + {tmF : TM nf} {f : List Bool → List Bool} {T : ℕ → ℕ} + (hcomp : tmF.ComputesInTime f T) : + (pairWithInputTM tmF).ComputesInTime + (fun x => pair (f x) x) (pairWithInputTime T) := + pairWithInputTM_computesInTime_internal hcomp + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Composition/PairWithInput/Defs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Composition/PairWithInput/Defs.lean new file mode 100644 index 0000000000..061383a303 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Composition/PairWithInput/Defs.lean @@ -0,0 +1,59 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Composition.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.PairEmit.Defs + +/-! +# Pair a computed value with the original input + +This file defines a generic deterministic pipeline for the fanout operation +`x ↦ pair (f x) x`. It redirects the computed value to a work tape, rewinds +that tape and the immutable original input, then emits both components +directly to the real output. Only the first raw-output delimiter is semantic; +later cells may contain arbitrary non-`▷` junk. +-/ + + +@[expose] public section + +namespace Complexity + +namespace TM + +/-- Work-tape count of `pairWithInputTM`. One extra tape beyond the redirected +output is kept as a stable phase-composition frame. -/ +abbrev pairWithInputTapeCount (nf : ℕ) := compositionTapeCount nf 0 + +/-- Physical work tape holding the raw output of the function computation. -/ +def pairWithInputRawOutputIdx (nf : ℕ) : Fin (pairWithInputTapeCount nf) := + compositionRawOutputIdx nf 0 + +/-- First phase of `pairWithInputTM`: compute with the output redirected to +the raw-output work tape. -/ +def pairWithInputFirstTM (tmF : TM nf) : TM (pairWithInputTapeCount nf) := + compositionFirstTM tmF 0 + +/-- Normalize the two read heads, then emit the computed value paired with +the unchanged original input. -/ +def pairWithInputTailTM (nf : ℕ) : TM (pairWithInputTapeCount nf) := + seqTM (rewindWorkTM (pairWithInputRawOutputIdx nf)) + (seqTM rewindInputTM (pairInputWorkTM (pairWithInputRawOutputIdx nf))) + +/-- Executable deterministic fanout combinator computing +`x ↦ pair (f x) x` whenever `tmF` computes `f`. -/ +def pairWithInputTM (tmF : TM nf) : TM (pairWithInputTapeCount nf) := + seqTM (pairWithInputFirstTM tmF) (pairWithInputTailTM nf) + +/-- Coarse time budget for `pairWithInputTM`. It covers the source run, both +rewinds, pair emission, and the three phase transitions. -/ +def pairWithInputTime (sourceTime : ℕ → ℕ) (inputLength : ℕ) : ℕ := + 5 * sourceTime inputLength + inputLength + 12 + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Composition/PairWithInput/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Composition/PairWithInput/Internal.lean new file mode 100644 index 0000000000..a829600814 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Composition/PairWithInput/Internal.lean @@ -0,0 +1,292 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Composition.Internal.FirstPhase +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Composition.PairWithInput.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.OutputBounds +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.PairEmit + +/-! +# Pair a computed value with the original input — proof internals + +This module verifies the generic fanout pipeline defined in +`Composition.PairWithInput.Defs`. +-/ + + +public section + +namespace Complexity + +namespace TM + +variable {nf : ℕ} + +/-- Boundary contract after the source computation has redirected its output. +Both source heads remain within `B`, every tape is safely parked away from the +left marker, and the real output is fresh for pair emission. -/ +def PairWithInputTailPre (nf : ℕ) (first second : List Bool) (B : ℕ) + (inp : Tape) (work : Fin (pairWithInputTapeCount nf) → Tape) + (out : Tape) : Prop := + let raw := pairWithInputRawOutputIdx nf + (work raw).HasOutput first ∧ + (work raw).StartInvariant ∧ + (work raw).head ≤ B ∧ + inp.cells = (Tape.init (second.map Γ.ofBool)).cells ∧ + inp.StartInvariant ∧ + 1 ≤ inp.head ∧ + inp.head ≤ B ∧ + (∀ i, (work i).StartInvariant ∧ 1 ≤ (work i).head) ∧ + out = (Tape.init []).move Dir3.right + +/-- Boundary after rewinding the raw computed output. -/ +private def PairWithInputAfterRaw (nf : ℕ) (first second : List Bool) (B : ℕ) + (inp : Tape) (work : Fin (pairWithInputTapeCount nf) → Tape) + (out : Tape) : Prop := + let raw := pairWithInputRawOutputIdx nf + (work raw).head = 1 ∧ + (work raw).HasOutput first ∧ + inp.cells = (Tape.init (second.map Γ.ofBool)).cells ∧ + inp.StartInvariant ∧ + 1 ≤ inp.head ∧ + inp.head ≤ B ∧ + (∀ i, (work i).StartInvariant ∧ 1 ≤ (work i).head) ∧ + out = (Tape.init []).move Dir3.right + +/-- Boundary after also rewinding the immutable original input. -/ +private def PairWithInputEmitterPre (nf : ℕ) (first second : List Bool) + (inp : Tape) (work : Fin (pairWithInputTapeCount nf) → Tape) + (out : Tape) : Prop := + let raw := pairWithInputRawOutputIdx nf + inp = (Tape.init (second.map Γ.ofBool)).move Dir3.right ∧ + (work raw).head = 1 ∧ + (work raw).HasOutput first ∧ + (∀ i, (work i).StartInvariant ∧ 1 ≤ (work i).head) ∧ + out = (Tape.init []).move Dir3.right + +/-- The normalization-and-emission tail turns a raw delimited source output +and the original input into their canonical pair. -/ +theorem pairWithInputTailTM_hoareTime_internal (nf : ℕ) + (first second : List Bool) (B : ℕ) : + (pairWithInputTailTM nf).HoareTime + (PairWithInputTailPre nf first second B) + (fun _inp _work out => out.HasOutput (pair first second)) + (2 * B + pairInputWorkTime first second + 6) := by + let raw := pairWithInputRawOutputIdx nf + let RawFrame : TapePred (pairWithInputTapeCount nf) := + fun inp work out => + (work raw).HasOutput first ∧ + inp.cells = (Tape.init (second.map Γ.ofBool)).cells ∧ + inp.StartInvariant ∧ + 1 ≤ inp.head ∧ + inp.head ≤ B ∧ + (∀ i, (work i).StartInvariant ∧ 1 ≤ (work i).head) ∧ + out = (Tape.init []).move Dir3.right + have hrewRaw := rewindWorkTM_hoareTime_frame raw B + (P := RawFrame) (by + intro inp work out inp' work' out' hframe hrawCells hrawHead + hother hinp houtCells houtHead + rcases hframe with + ⟨hrawOutput, hinputCells, hinputInv, hinputHead, hinputBound, + hworkInv, hout⟩ + have hout' : out' = out := Tape.ext houtHead houtCells + have hrawOutput' : (work' raw).HasOutput first := + (Tape.hasOutput_congr hrawCells first).mpr hrawOutput + have hrawInv' : (work' raw).StartInvariant := by + refine ⟨?_, ?_⟩ + · rw [hrawCells] + exact (hworkInv raw).1.1 + · intro j hj + rw [hrawCells] + exact (hworkInv raw).1.2 j hj + refine ⟨hrawOutput', hinp ▸ hinputCells, hinp ▸ hinputInv, + hinp ▸ hinputHead, hinp ▸ hinputBound, ?_, hout' ▸ hout⟩ + intro i + by_cases hi : i = raw + · subst i + exact ⟨hrawInv', by omega⟩ + · rw [hother i hi] + exact hworkInv i) + have hrewRaw' : + (rewindWorkTM raw).HoareTime + (PairWithInputTailPre nf first second B) + (PairWithInputAfterRaw nf first second B) + (B + 2) := by + apply hrewRaw.consequence (b' := B + 2) + · intro inp work out hpre + rcases hpre with + ⟨hrawOutput, hrawInv, hrawBound, hinputCells, hinputInv, + hinputHead, hinputBound, hworkInv, hout⟩ + refine ⟨hrawInv.1, hrawInv.2, hrawBound, + hinputInv.read_ne_start hinputHead, ?_, ?_, ?_, ?_⟩ + · rw [hout] + decide + · rw [hout] + simp [Tape.move] + · intro i hi + exact ⟨(hworkInv i).1.read_ne_start (hworkInv i).2, (hworkInv i).2⟩ + · exact ⟨hrawOutput, hinputCells, hinputInv, hinputHead, + hinputBound, hworkInv, hout⟩ + · intro inp work out hpost + rcases hpost with ⟨hrawHead, hrawOutput, hinputCells, + hinputInv, hinputHead, hinputBound, hworkInv, hout⟩ + exact ⟨hrawHead, hrawOutput, hinputCells, hinputInv, + hinputHead, hinputBound, hworkInv, hout⟩ + · exact le_rfl + let InputFrame : TapePred (pairWithInputTapeCount nf) := + fun inp work out => + inp.cells = (Tape.init (second.map Γ.ofBool)).cells ∧ + (work raw).head = 1 ∧ + (work raw).HasOutput first ∧ + (∀ i, (work i).StartInvariant ∧ 1 ≤ (work i).head) ∧ + out = (Tape.init []).move Dir3.right + have hrewInput := rewindInputTM_hoareTime_frame B + (P := InputFrame) (by + intro inp work out inp' work' out' hframe hinputCells _hinputHead + hwork hout + rcases hframe with + ⟨hcanonical, hrawHead, hrawOutput, hworkInv, houtEq⟩ + subst work' + subst out' + exact ⟨hinputCells.trans hcanonical, hrawHead, hrawOutput, + hworkInv, houtEq⟩) + have hrewInput' : + rewindInputTM.HoareTime + (PairWithInputAfterRaw nf first second B) + (PairWithInputEmitterPre nf first second) + (B + 2) := by + apply hrewInput.consequence (b' := B + 2) + · intro inp work out hpre + rcases hpre with + ⟨hrawHead, hrawOutput, hinputCells, hinputInv, + hinputHead, hinputBound, hworkInv, hout⟩ + refine ⟨hinputInv.1, hinputInv.2, hinputBound, ?_, ?_, ?_, ?_⟩ + · rw [hout] + decide + · rw [hout] + simp [Tape.move] + · intro i + exact ⟨(hworkInv i).1.read_ne_start (hworkInv i).2, (hworkInv i).2⟩ + · exact ⟨hinputCells, hrawHead, hrawOutput, hworkInv, hout⟩ + · intro inp work out hpost + rcases hpost with + ⟨hinputHead, hinputCells, hrawHead, hrawOutput, hworkInv, hout⟩ + have hinput : inp = + (Tape.init (second.map Γ.ofBool)).move Dir3.right := by + apply Tape.ext + · simpa [Tape.move] using hinputHead + · simpa only [Tape.move_cells] using hinputCells + exact ⟨hinput, hrawHead, hrawOutput, hworkInv, hout⟩ + · exact le_rfl + have hemitter := pairInputWorkTM_hoareTime raw first second + have hinner := seqTM_hoareTime rewindInputTM (pairInputWorkTM raw) + hrewInput' (by + intro inp work out hpre + rcases hpre with ⟨hinput, hrawHead, hrawOutput, hworkInv, hout⟩ + have hinputStable : transitionInput inp = inp := by + apply transitionInput_eq_self + rw [hinput] + exact Tape.init_ofBool_move_right_read_ne_start second + have hworkStable : (fun i => transitionTape (work i)) = work := by + funext i + apply transitionTape_eq_self + exact (hworkInv i).1.read_ne_start (hworkInv i).2 + have hworkStableAt (i) : transitionTape (work i) = work i := + congrFun hworkStable i + have houtStable : transitionTape out = out := by + apply transitionTape_eq_self + rw [hout] + decide + simpa only [hinputStable, hworkStableAt, houtStable] using + (show PairWithInputEmitterPre nf first second inp work out from + ⟨hinput, hrawHead, hrawOutput, hworkInv, hout⟩)) + hemitter + have htail := seqTM_hoareTime (rewindWorkTM raw) + (seqTM rewindInputTM (pairInputWorkTM raw)) hrewRaw' (by + intro inp work out hpre + rcases hpre with + ⟨hrawHead, hrawOutput, hinputCells, hinputInv, + hinputHead, hinputBound, hworkInv, hout⟩ + have hinputStable : transitionInput inp = inp := + transitionInput_eq_self (hinputInv.read_ne_start hinputHead) + have hworkStable : (fun i => transitionTape (work i)) = work := by + funext i + apply transitionTape_eq_self + exact (hworkInv i).1.read_ne_start (hworkInv i).2 + have hworkStableAt (i) : transitionTape (work i) = work i := + congrFun hworkStable i + have houtStable : transitionTape out = out := by + apply transitionTape_eq_self + rw [hout] + decide + simpa only [hinputStable, hworkStableAt, houtStable] using + (show PairWithInputAfterRaw nf first second B inp work out from + ⟨hrawHead, hrawOutput, hinputCells, hinputInv, hinputHead, + hinputBound, hworkInv, hout⟩)) + hinner + simpa only [pairWithInputTailTM] using + htail.mono_bound (by omega) + +/-- Internal correctness of the executable fanout combinator. -/ +theorem pairWithInputTM_computesInTime_internal + {tmF : TM nf} {f : List Bool → List Bool} {T : ℕ → ℕ} + (hcomp : tmF.ComputesInTime f T) : + (pairWithInputTM tmF).ComputesInTime + (fun x => pair (f x) x) (pairWithInputTime T) := by + intro x + obtain ⟨C, t, ht, hreachF, hhaltF, hrawOutput, hrawHead, + _hvirtual, _hscratch, hinputInv, hinputHead, hworkBoundary, + houtputParked⟩ := + compositionFirstTM_boundary_internal tmF 0 hcomp x + let boundaryInput := transitionInput C.input + let boundaryWork : Fin (pairWithInputTapeCount nf) → Tape := + fun i => transitionTape (C.work i) + let boundaryOutput := transitionTape C.output + have hinputCells : boundaryInput.cells = + (Tape.init (x.map Γ.ofBool)).cells := by + dsimp only [boundaryInput] + rw [transitionInput_cells, + input_cells_eq_of_reachesIn hreachF] + have hinputBound : boundaryInput.head ≤ T x.length + 1 := by + have hhead := (head_le_of_reachesIn + (compositionFirstTM tmF 0) hreachF).1 + have hmove := Tape.head_move_le C.input (idleDir C.input.read) + change (C.input.move (idleDir C.input.read)).head ≤ T x.length + 1 + omega + have htail := pairWithInputTailTM_hoareTime_internal nf + (f x) x (T x.length + 1) + obtain ⟨D, u, hu, hreachTail, hhaltTail, houtTail⟩ := + htail boundaryInput boundaryWork boundaryOutput (by + refine ⟨hrawOutput, (hworkBoundary _).1, ?_, hinputCells, + hinputInv, hinputHead, hinputBound, hworkBoundary, houtputParked⟩ + dsimp only [boundaryWork] + change (transitionTape + (C.work (compositionRawOutputIdx nf 0))).head ≤ T x.length + 1 + omega) + let first := pairWithInputFirstTM tmF + let tail := pairWithInputTailTM nf + let final := phase2Wrap first tail D + refine ⟨final, t + 1 + u, ?_, ?_, ?_, ?_⟩ + · have hlength : (f x).length ≤ T x.length := hcomp.output_length_le x + have hu' : u ≤ 2 * (T x.length + 1) + + pairInputWorkTime (f x) x + 6 := hu + change t + 1 + u ≤ 5 * T x.length + x.length + 12 + simp only [pairInputWorkTime] at hu' + omega + · have hreach := seqTM_reachesIn_of_reachesIn first tail + hreachF hhaltF hreachTail + simpa [pairWithInputTM, pairWithInputFirstTM, first, tail, final, + boundaryInput, boundaryWork, boundaryOutput] using hreach + · show (pairWithInputTM tmF).halted final + simpa [pairWithInputTM, first, tail, final] using + (phase2Wrap_halted_iff first tail D).2 hhaltTail + · simpa [final, phase2Wrap] using houtTail + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Frame.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Frame.lean new file mode 100644 index 0000000000..fcb423386c --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Frame.lean @@ -0,0 +1,234 @@ +/- +Copyright (c) 2026 Bolton Bailey. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Bolton Bailey +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.Internal +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Hoare +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Placement +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Registers + +/-! +# Frame rules for composite machines + +Two things a machine built out of sub-machines needs to know: that a +sub-machine's Hoare triple still holds once its tapes are embedded in a larger +tape space (`TM.placeWorkTM_hoareTime_frame`), and that a run of bounded length +cannot have touched cells far from where its heads started +(`TM.reachesIn_work_cells_far`). The second is what lets a *bounded* wipe reset +an opaque machine's scratch completely. + +## Main results + +- `TM.placeWorkTM_hoareTime_frame` — a Hoare triple survives tape embedding +- `TM.reachesIn_work_cells_far` — a `t`-step run leaves cells beyond `head + t` alone +- `TM.reachesIn_startInvariant` — runs preserve `Tape.StartInvariant` +- `TM.seqTM_det` — sequential composition is deterministic on its components +- `TM.IdlesInput` — machines that never move their input head +-/ + + +@[expose] public section + +namespace Complexity + +namespace TM + +/-- The parked blank tape every scratch tape starts and ends at. -/ +def parkedBlank : Tape := (Tape.init []).move Dir3.right + +/-! ## Embedding a Hoare triple in a larger tape space + +A composite machine runs sub-machines that each own a fixed number of work +tapes, while carrying persistent state (running values, fuel registers) on tapes +those sub-machines never touch. `TM.placeWorkTM` already gives the exact +frame-preserving simulation +(`placeWorkTM_reachesIn_placeWorkCfg_of_startInvariant`); the lemma below turns +that into a Hoare-triple-level tool, so each embedding is a single lemma +application instead of a fresh `reachesIn` argument. -/ + +/-- **Placing a Hoare triple.** If `tm : TM n` satisfies a Hoare triple, then +`placeWorkTM pre post tm` satisfies the triple obtained by reindexing `tm`'s +work-tape predicate through the middle block, with an arbitrary `Parked`-style +frame (`extras`) held exactly fixed outside it. -/ +theorem placeWorkTM_hoareTime_frame {n pre post : ℕ} (tm : TM n) + {preSmall postSmall : TapePred n} {b : ℕ} + (h : tm.HoareTime preSmall postSmall b) + (extras : Fin (pre + n + post) → Tape) + (hinv : ∀ i, ¬placeWorkInMiddle pre n i → Tape.StartInvariant (extras i)) + (hhead : ∀ i, ¬placeWorkInMiddle pre n i → 1 ≤ (extras i).head) : + (placeWorkTM pre post tm).HoareTime + (fun inp work out => preSmall inp (fun i => work (placeWorkIdx pre post i)) out ∧ + ∀ i, ¬placeWorkInMiddle pre n i → work i = extras i) + (fun inp work out => postSmall inp (fun i => work (placeWorkIdx pre post i)) out ∧ + ∀ i, ¬placeWorkInMiddle pre n i → work i = extras i) + b := by + rintro inp work out ⟨hpre, hextra⟩ + set wSmall : Fin n → Tape := fun i => work (placeWorkIdx pre post i) with hwSmall + obtain ⟨c', t, ht, hreach, hhalt, hpost⟩ := h inp wSmall out hpre + have hweq : work = (placeWorkCfg tm pre post extras + { state := tm.qstart, input := inp, work := wSmall, output := out }).work := by + funext i + by_cases hmid : placeWorkInMiddle pre n i + · rw [show i = placeWorkIdx pre post (placeWorkCoord pre n i hmid) from + (placeWorkIdx_placeWorkCoord i hmid).symm, placeWorkCfg_work_middle] + · rw [placeWorkCfg_work_extra tm pre post extras _ i hmid] + exact hextra i hmid + refine ⟨placeWorkCfg tm pre post extras c', t, ht, ?_, + (placeWorkCfg_halted_iff tm pre post extras c').mpr hhalt, ?_, ?_⟩ + · rw [hweq] + exact placeWorkTM_reachesIn_placeWorkCfg_of_startInvariant tm pre post extras hreach + hinv hhead + · show postSmall c'.input (fun i => (placeWorkCfg tm pre post extras c').work + (placeWorkIdx pre post i)) c'.output + simp only [placeWorkCfg_work_middle] + exact hpost + · intro i hi + exact placeWorkCfg_work_extra tm pre post extras c' i hi + +/-! ## What a bounded run can have disturbed + +Resetting an opaque machine's scratch tapes between calls needs +to know *how far out* the machine could possibly have written. Since each head +moves by at most one cell per step and a machine only ever writes under its +heads, a `t`-step run leaves every cell beyond `head + t` exactly as it found +it. That is what makes the bounded wipe of `TM.resetTapesTM` complete rather +than merely partial. -/ + +/-- One step leaves every work-tape cell other than that tape's own head +unchanged: a machine writes only under its heads. -/ +theorem work_cells_ne_of_step {n : ℕ} {tm : TM n} {c c' : Cfg n tm.Q} + (hstep : tm.step c = some c') (i : Fin n) {j : ℕ} (hj : j ≠ (c.work i).head) : + (c'.work i).cells j = (c.work i).cells j := by + simp only [TM.step] at hstep + split at hstep + · simp at hstep + · simp only [Option.some.injEq] at hstep + rw [← hstep] + simp only [Tape.move_cells, Tape.write] + split + · rfl + · change Function.update (c.work i).cells (c.work i).head _ j = (c.work i).cells j + rw [Function.update_of_ne hj] + +/-- **Cells beyond a work head's maximum reach are never touched.** -/ +theorem reachesIn_work_cells_far {n : ℕ} {tm : TM n} : + ∀ {t : ℕ} {c c' : Cfg n tm.Q}, tm.reachesIn t c c' → + ∀ (i : Fin n) (j : ℕ), (c.work i).head + t < j → + (c'.work i).cells j = (c.work i).cells j := by + intro t + induction t with + | zero => + intro c c' hreach i j _ + cases hreach + rfl + | succ t ih => + intro c c' hreach i j hj + cases hreach with + | step hstep hrest => + next c'' => + have hhead : (c''.work i).head ≤ (c.work i).head + 1 := + (head_le_start_add_of_reachesIn tm (TM.reachesIn.step hstep TM.reachesIn.zero)).2.2 i + have hcell : (c''.work i).cells j = (c.work i).cells j := + work_cells_ne_of_step hstep i (by omega) + rw [ih hrest i j (by omega), hcell] + +/-- The standing left-marker invariant survives an entire run, on every tape. -/ +theorem reachesIn_startInvariant {n : ℕ} {tm : TM n} : + ∀ {t : ℕ} {c c' : Cfg n tm.Q}, tm.reachesIn t c c' → + c.input.StartInvariant → (∀ i, (c.work i).StartInvariant) → c.output.StartInvariant → + c'.input.StartInvariant ∧ (∀ i, (c'.work i).StartInvariant) ∧ + c'.output.StartInvariant := by + intro t c c' hreach + induction hreach with + | zero => exact fun hi hw ho => ⟨hi, hw, ho⟩ + | step hstep _ ih => + intro hi hw ho + obtain ⟨hi', hw', ho'⟩ := Tape.StartInvariant.step _ hstep hi hw ho + exact ih hi' hw' ho' + +/-- A fully parked tape frame passes through a combinator seam unchanged — +the boundary obligation of `TM.seqTM_hoareTime` in the common case where every +tape is parked on both sides of the seam. -/ +theorem parked_transition {n : ℕ} {inp₀ out₀ : Tape} {W : Fin n → Tape} + (hinp : Parked inp₀) (hW : ∀ i, Parked (W i)) (hout : Parked out₀) : + transitionInput inp₀ = inp₀ ∧ + (fun i => transitionTape (W i)) = W ∧ transitionTape out₀ = out₀ := + ⟨transitionInput_eq_self hinp.read_ne_start, + funext fun i => transitionTape_eq_self (hW i).read_ne_start, + transitionTape_eq_self hout.read_ne_start⟩ + +/-- **Chaining two fully-determined phases.** When each phase pins down the +entire tape family and every intermediate tape is parked, sequential +composition needs no boundary reasoning at all. -/ +theorem seqTM_det {n : ℕ} (m₁ m₂ : TM n) {inp₀ out₀ : Tape} {W₀ W₁ W₂ : Fin n → Tape} + {b₁ b₂ : ℕ} (hinp : Parked inp₀) (hout : Parked out₀) (hW₁ : ∀ i, Parked (W₁ i)) + (h₁ : m₁.HoareTime (fun inp work out => inp = inp₀ ∧ work = W₀ ∧ out = out₀) + (fun inp work out => inp = inp₀ ∧ work = W₁ ∧ out = out₀) b₁) + (h₂ : m₂.HoareTime (fun inp work out => inp = inp₀ ∧ work = W₁ ∧ out = out₀) + (fun inp work out => inp = inp₀ ∧ work = W₂ ∧ out = out₀) b₂) : + (seqTM m₁ m₂).HoareTime + (fun inp work out => inp = inp₀ ∧ work = W₀ ∧ out = out₀) + (fun inp work out => inp = inp₀ ∧ work = W₂ ∧ out = out₀) + (b₁ + 1 + b₂) := by + refine seqTM_hoareTime m₁ m₂ h₁ ?_ h₂ + rintro inp work out ⟨rfl, rfl, rfl⟩ + exact parked_transition hinp hW₁ hout + +/-- A machine that never moves its real input head off a parked position: its +transition function always returns `idleDir` for the input tape. Machines that +read their input from a work tape instead (`TM.retargetInput` and everything +built on it) satisfy this. -/ +def IdlesInput {n : ℕ} (tm : TM n) : Prop := + ∀ q iHead wHeads oHead, (tm.δ q iHead wHeads oHead).2.2.2.1 = idleDir iHead + +/-- An input-idling machine preserves a parked real input tape exactly, for +any number of steps. -/ +theorem reachesIn_input_eq_of_idlesInput {n : ℕ} {tm : TM n} (hidle : IdlesInput tm) : + ∀ {t : ℕ} {c c' : Cfg n tm.Q}, tm.reachesIn t c c' → Parked c.input → + c'.input = c.input := by + intro t + induction t with + | zero => + intro c c' hreach _ + cases hreach + rfl + | succ t ih => + intro c c' hreach hp + cases hreach with + | step hstep hrest => + next c'' => + have hc'' : c''.input = c.input := by + simp only [TM.step] at hstep + split at hstep + · simp at hstep + · simp only [Option.some.injEq] at hstep + rw [← hstep] + show c.input.move _ = c.input + rw [hidle, hp.move_idle] + rw [ih hrest (by rw [hc'']; exact hp), hc''] + +/-- The blank tape satisfies the left-marker invariant. -/ +theorem startInvariant_initNil : Tape.StartInvariant (Tape.init ([] : List Γ)) := by + refine ⟨Tape.init_cells_zero [], fun j hj => ?_⟩ + rw [show j = (j - 1) + 1 from by omega, Tape.init_cells_ge [] (j - 1) (by simp)] + decide + +/-- A tape initialized with a Boolean string satisfies the left-marker +invariant: `Γ.ofBool` never produces `▷`. -/ +theorem startInvariant_initOfBool (y : List Bool) : + Tape.StartInvariant (Tape.init (y.map Γ.ofBool)) := by + refine ⟨Tape.init_cells_zero _, fun j hj => ?_⟩ + have hj1 : j = (j - 1) + 1 := by omega + by_cases hlt : j - 1 < y.length + · rw [hj1, Tape.init_ofBool_cells_lt y (j - 1) hlt] + cases y[j - 1]'hlt <;> decide + · rw [hj1, Tape.init_ofBool_cells_ge y (j - 1) (by omega)] + decide + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Hoare.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Hoare.lean new file mode 100644 index 0000000000..4086d14dc9 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Hoare.lean @@ -0,0 +1,382 @@ +/- +Copyright (c) 2025 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Hoare.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.Internal.Seq +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.Internal.If +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.Internal.Complement + +/-! +# Hoare-style composition rules for TM combinators + +This file provides Hoare-triple composition rules for all four TM combinators. +Each rule specifies how pre/postconditions and time bounds compose. + +## Main results + +- `seqTM_hoareTime` — sequential composition: time `b₁ + 1 + b₂` +- `phaseTransition_eq_self_of_reads_ne_start` — identify a stable phase boundary +- `complementTM_hoareTime` — complement flips output cell 1: time `b + p_bound + 4` +- `ifTM_hoareTime` — if-then-else branching: time `b_test + p_bound + max b_then b_else + 5` +- `loopTM_hoareTime` — loop invariant with variant: time `(k + 1) * b_iter` + +## Tape transition effects + +All combinators apply `transitionTape` / `transitionInput` at phase boundaries. +A current read other than `▷` is exactly what their fixed-point rules require; +parked tapes, or `AllTapesWF` together with positive-head facts, provide common +stronger certificates. +-/ + + +@[expose] public section + +namespace Complexity + +namespace TM + +variable {n : ℕ} + +/-- **Sequential composition of Hoare triples**. -/ +theorem seqTM_hoareTime (tm₁ tm₂ : TM n) + {pre mid mid' post : TapePred n} {b₁ b₂ : ℕ} + (h₁ : tm₁.HoareTime pre mid b₁) + (h_trans : ∀ inp work out, mid inp work out → + mid' (transitionInput inp) + (fun i => transitionTape (work i)) + (transitionTape out)) + (h₂ : tm₂.HoareTime mid' post b₂) : + (seqTM tm₁ tm₂).HoareTime pre post (b₁ + 1 + b₂) := by + intro inp work out hpre + obtain ⟨c₁, t₁, ht₁, hreach₁, hhalt₁, hmid⟩ := h₁ inp work out hpre + have hmid' := h_trans c₁.input c₁.work c₁.output hmid + obtain ⟨c₂, t₂, ht₂, hreach₂, hhalt₂, hpost⟩ := h₂ _ _ _ hmid' + refine ⟨phase2Wrap tm₁ tm₂ c₂, t₁ + 1 + t₂, ?_, ?_, ?_, ?_⟩ + · omega + · convert seqTM_reachesIn_of_reachesIn tm₁ tm₂ hreach₁ hhalt₁ hreach₂ using 1 + · rw [phase2Wrap_halted_iff]; exact hhalt₂ + · exact hpost + +/-- The input, work family, and output transition maps are jointly the +identity when every tape is reading something other than the left-end marker. +This shared read-local boundary certificate matches the transition shape +accepted by both time-only and time-space sequential composition; it +deliberately does not require parked heads or global tape well-formedness. -/ +theorem phaseTransition_eq_self_of_reads_ne_start + {inp out : Tape} {work : Fin n → Tape} + (hinput : inp.read ≠ Γ.start) + (hwork : ∀ i, (work i).read ≠ Γ.start) + (houtput : out.read ≠ Γ.start) : + transitionInput inp = inp ∧ + (fun i => transitionTape (work i)) = work ∧ + transitionTape out = out := by + exact ⟨transitionInput_eq_self hinput, + funext fun i => transitionTape_eq_self (hwork i), + transitionTape_eq_self houtput⟩ + +/-- Well-formedness condition on all tapes: cells 0 = start and cells ≥ 1 ≠ start. -/ +def AllTapesWF (inp : Tape) (work : Fin n → Tape) (out : Tape) : Prop := + inp.cells 0 = Γ.start ∧ (∀ j, j ≥ 1 → inp.cells j ≠ Γ.start) ∧ + (∀ i, (work i).cells 0 = Γ.start) ∧ (∀ i j, j ≥ 1 → (work i).cells j ≠ Γ.start) ∧ + out.cells 0 = Γ.start ∧ (∀ j, j ≥ 1 → out.cells j ≠ Γ.start) + +-- ════════════════════════════════════════════════════════════════════════ +-- AllTapesWF propagation through phase transitions +-- ════════════════════════════════════════════════════════════════════════ + +/-- AllTapesWF is preserved through the standard combinator phase transition + (`transitionTape` / `transitionInput`). -/ +theorem AllTapesWF.transition {inp : Tape} {work : Fin n → Tape} {out : Tape} + (h : AllTapesWF inp work out) : + (transitionInput inp).head ≥ 1 ∧ + (∀ j, j ≥ 1 → (transitionInput inp).cells j ≠ Γ.start) ∧ + (∀ i, (transitionTape (work i)).head ≥ 1) ∧ + (∀ i j, j ≥ 1 → (transitionTape (work i)).cells j ≠ Γ.start) ∧ + (transitionTape out).cells = out.cells ∧ + (transitionTape out).head ≥ 1 := by + obtain ⟨hic0, hins, hwc0, hwns, hoc0, hons⟩ := h + exact ⟨transitionInput_head_ge inp hic0, + by rw [transitionInput_cells]; exact hins, + fun i => one_le_head_transitionTape _ (hwc0 i), + fun i j hj => by rw [transitionTape_cells _ (hwns i)]; exact hwns i j hj, + transitionTape_cells out hons, + one_le_head_transitionTape out hoc0⟩ + +-- ════════════════════════════════════════════════════════════════════════ +-- Complement rule +-- ════════════════════════════════════════════════════════════════════════ + +/-- **Complement Hoare triple**. If `tm` satisfies a Hoare triple whose + postcondition provides output WF (for rewind), a head bound, and a + property of output cell 1, then `complementTM tm` satisfies a triple + where output cell 1 is flipped. Time: `b + p_bound + 4`. -/ +theorem complementTM_hoareTime (tm : TM n) + {pre : TapePred n} {b p_bound : ℕ} + {cell1_pred : Γ → Prop} + (h_tm : tm.HoareTime pre + (fun _ _ out => + out.cells 0 = Γ.start ∧ + (∀ j, j ≥ 1 → out.cells j ≠ Γ.start) ∧ + out.head ≤ p_bound ∧ + cell1_pred (out.cells 1)) + b) : + tm.complementTM.HoareTime pre + (fun _ _ out => ∃ g, cell1_pred g ∧ out.cells 1 = (flipBit g).toΓ) + (b + p_bound + 4) := by + intro inp work out hpre + obtain ⟨c', t, ht, hreach, hhalt, hcell0, hnostart, hhead, hcell1⟩ := + h_tm inp work out hpre + have hsim := complementTM_simulation tm hreach + rw [compCfg_qstart] at hsim + obtain ⟨c_done, t_rw, hreach_rw, hhalt_done, hflip, hle_rw⟩ := + complementTM_rewind_and_flip tm c' hhalt hcell0 hnostart + exact ⟨c_done, t + t_rw, + by have : t_rw ≤ p_bound + 4 := le_trans hle_rw (by omega); omega, + reachesIn_trans _ hsim hreach_rw, hhalt_done, + c'.output.cells 1, hcell1, hflip⟩ + +-- ════════════════════════════════════════════════════════════════════════ +-- If-then-else rule +-- ════════════════════════════════════════════════════════════════════════ + +/-- **If-then-else Hoare triple**. Composes test, then-branch, and else-branch + Hoare triples. The test postcondition must include `AllTapesWF` (for rewind) + and a head bound. Branch routing maps the test postcondition to the branch + precondition on transitioned tapes (output gets head = 1, cells preserved). + + Time: `b_test + p_bound + max b_then b_else + 5` + (test + transition + rewind + check + branch + halt). -/ +theorem ifTM_hoareTime (tmTest tmThen tmElse : TM n) + {pre mid_test mid_then mid_else post_then post_else post : TapePred n} + {b_test b_then b_else p_bound : ℕ} + (h_test : tmTest.HoareTime pre mid_test b_test) + (h_wf : ∀ inp work out, mid_test inp work out → AllTapesWF inp work out) + (h_head : ∀ inp work out, mid_test inp work out → out.head ≤ p_bound) + (h_to_then : ∀ inp work out, mid_test inp work out → out.cells 1 = Γ.one → + mid_then (transitionInput inp) (fun i => transitionTape (work i)) + ⟨1, out.cells⟩) + (h_to_else : ∀ inp work out, mid_test inp work out → out.cells 1 ≠ Γ.one → + mid_else (transitionInput inp) (fun i => transitionTape (work i)) + ⟨1, out.cells⟩) + (h_then : tmThen.HoareTime mid_then post_then b_then) + (h_else : tmElse.HoareTime mid_else post_else b_else) + (h_post_then : ∀ inp work out, post_then inp work out → + post (transitionInput inp) (fun i => transitionTape (work i)) + (transitionTape out)) + (h_post_else : ∀ inp work out, post_else inp work out → + post (transitionInput inp) (fun i => transitionTape (work i)) + (transitionTape out)) : + (ifTM tmTest tmThen tmElse).HoareTime pre post + (b_test + p_bound + max b_then b_else + 5) := by + intro inp work out hpre + obtain ⟨c_test, t₁, ht₁, hreach₁, hhalt₁, hmid⟩ := h_test inp work out hpre + have hwf := h_wf _ _ _ hmid + have hhead_bound := h_head _ _ _ hmid + obtain ⟨hic0, hins, hwc0, hwns, hoc0, hons⟩ := hwf + -- Phase 1: test simulation + have hsim := ifTM_reachesIn_ifTestWrap tmTest tmThen tmElse hreach₁ + -- Phase 2: test → rewind transition (1 step) + have h_tr := ifTM_test_to_rewind tmTest tmThen tmElse hhalt₁ + -- Phase 3: rewind loop (tracks all tapes, using AllTapesWF propagation) + obtain ⟨h_inp_ge, h_inp_ns, h_work_ge, h_work_ns, h_out_cells, _⟩ := + AllTapesWF.transition (h_wf _ _ _ hmid) + have h_out_head_bound := head_transitionTape_le hoc0 hhead_bound + obtain ⟨c_check, hreach_rw, hst_check, hh_check, hcells_check, hinp_check, hwork_check⟩ := + ifTM_rewindOut_reachesIn_check tmTest tmThen tmElse (transitionTape c_test.output).head + { state := Sum.inr (Sum.inl IfPhase.rewindOut), + input := transitionInput c_test.input, + work := fun i => transitionTape (c_test.work i), + output := transitionTape c_test.output } + rfl (by rw [h_out_cells]; exact hoc0) + (by intro j hj; rw [h_out_cells]; exact hons j hj) rfl + h_inp_ge h_inp_ns h_work_ge h_work_ns + -- Phase 4: check + branch (cases on output cell 1) + -- Derive invariants on the check config from rewind results + have hcells_at_check : c_check.output.cells 1 = c_test.output.cells 1 := by + rw [hcells_check, h_out_cells] + have hns_at_check : ∀ j, j ≥ 1 → c_check.output.cells j ≠ Γ.start := by + intro j hj; rw [hcells_check, h_out_cells]; exact hons j hj + have hinp_stable : c_check.input.head ≥ 1 := by rw [hinp_check]; exact h_inp_ge + have hins_stable : ∀ j, j ≥ 1 → c_check.input.cells j ≠ Γ.start := by + intro j hj; rw [hinp_check]; exact h_inp_ns j hj + have hwh_stable : ∀ i, (c_check.work i).head ≥ 1 := by + intro i; rw [hwork_check]; exact h_work_ge i + have hwns_stable : ∀ i j, j ≥ 1 → (c_check.work i).cells j ≠ Γ.start := by + intro i j hj; rw [hwork_check]; exact h_work_ns i j hj + -- Time for transition + rewind + have hreach_tr_rw : (ifTM tmTest tmThen tmElse).reachesIn + (1 + ((transitionTape c_test.output).head + 1)) + (ifTestWrap tmTest tmThen tmElse c_test) c_check := + reachesIn_trans _ (.step h_tr .zero) hreach_rw + -- Branch on output cell 1 + by_cases hcell1 : c_test.output.cells 1 = Γ.one + · -- Then branch + obtain ⟨c_branch, hstep_check, hst_branch, hcells_branch, hhead_branch, + hinp_branch, hwork_branch⟩ := + ifTM_check_step_then_full tmTest tmThen tmElse c_check hst_check hh_check + (by rw [hcells_at_check]; exact hcell1) hinp_stable hins_stable hwh_stable hwns_stable + have hmid_then := h_to_then c_test.input c_test.work c_test.output hmid hcell1 + obtain ⟨c_then, t₃, ht₃, hreach₃, hhalt₃, hpost_then⟩ := + h_then _ _ _ hmid_then + have hsim₃ := ifTM_reachesIn_ifThenWrap tmTest tmThen tmElse hreach₃ + have h_halt_step := ifTM_then_halt_step tmTest tmThen tmElse hhalt₃ + have hpost := h_post_then c_then.input c_then.work c_then.output hpost_then + -- Compose: test sim + transition + rewind + check + branch sim + halt + let c_done : Cfg n (ifTM tmTest tmThen tmElse).Q := + ⟨(ifTM tmTest tmThen tmElse).qhalt, + transitionInput c_then.input, + fun i => transitionTape (c_then.work i), + transitionTape c_then.output⟩ + refine ⟨c_done, t₁ + (1 + ((transitionTape c_test.output).head + 1)) + 1 + t₃ + 1, + ?_, ?_, ?_, ?_⟩ + · have : (transitionTape c_test.output).head + 1 ≤ p_bound + 2 := by omega + calc t₁ + _ + 1 + t₃ + 1 + ≤ b_test + (1 + (p_bound + 2)) + 1 + b_then + 1 := by omega + _ ≤ b_test + p_bound + max b_then b_else + 5 := by omega + · have hstep_branch : (ifTM tmTest tmThen tmElse).step c_check = + some (ifThenWrap tmTest tmThen tmElse + ⟨tmThen.qstart, transitionInput c_test.input, + fun i => transitionTape (c_test.work i), ⟨1, c_test.output.cells⟩⟩) := by + rw [hstep_check]; congr 1; simp only [ifThenWrap] + have hcfg_eta : c_branch = + ⟨c_branch.state, c_branch.input, c_branch.work, c_branch.output⟩ := rfl + have htape_eta : c_branch.output = + ⟨c_branch.output.head, c_branch.output.cells⟩ := rfl + rw [hcfg_eta, hst_branch, hinp_branch, hinp_check, hwork_branch, hwork_check, + htape_eta, hhead_branch] + congr 1; simp only [hcells_branch, hcells_check, h_out_cells] + have r1 := reachesIn_trans _ hsim hreach_tr_rw + have r2 := reachesIn_trans _ r1 (.step hstep_branch .zero) + have r3 := reachesIn_trans _ r2 hsim₃ + exact reachesIn_trans _ r3 (.step h_halt_step .zero) + · exact ifTM_halted_of_state_eq_done tmTest tmThen tmElse _ rfl + · exact hpost + · -- Else branch (symmetric) + obtain ⟨c_branch, hstep_check, hst_branch, hcells_branch, hhead_branch, + hinp_branch, hwork_branch⟩ := + ifTM_check_step_else_full tmTest tmThen tmElse c_check hst_check hh_check + (by rw [hcells_at_check]; exact hcell1) hns_at_check + hinp_stable hins_stable hwh_stable hwns_stable + have hmid_else := h_to_else c_test.input c_test.work c_test.output hmid hcell1 + obtain ⟨c_else, t₃, ht₃, hreach₃, hhalt₃, hpost_else⟩ := + h_else _ _ _ hmid_else + have hsim₃ := ifTM_reachesIn_ifElseWrap tmTest tmThen tmElse hreach₃ + have h_halt_step := ifTM_else_halt_step tmTest tmThen tmElse hhalt₃ + have hpost := h_post_else c_else.input c_else.work c_else.output hpost_else + let c_done_else : Cfg n (ifTM tmTest tmThen tmElse).Q := + ⟨(ifTM tmTest tmThen tmElse).qhalt, + transitionInput c_else.input, + fun i => transitionTape (c_else.work i), + transitionTape c_else.output⟩ + refine ⟨c_done_else, t₁ + (1 + ((transitionTape c_test.output).head + 1)) + 1 + t₃ + 1, + ?_, ?_, ?_, ?_⟩ + · have : (transitionTape c_test.output).head + 1 ≤ p_bound + 2 := by omega + calc t₁ + _ + 1 + t₃ + 1 + ≤ b_test + (1 + (p_bound + 2)) + 1 + b_else + 1 := by omega + _ ≤ b_test + p_bound + max b_then b_else + 5 := by omega + · have hstep_branch : (ifTM tmTest tmThen tmElse).step c_check = + some (ifElseWrap tmTest tmThen tmElse + ⟨tmElse.qstart, transitionInput c_test.input, + fun i => transitionTape (c_test.work i), ⟨1, c_test.output.cells⟩⟩) := by + rw [hstep_check]; congr 1; simp only [ifElseWrap] + have hcfg_eta : c_branch = + ⟨c_branch.state, c_branch.input, c_branch.work, c_branch.output⟩ := rfl + have htape_eta : c_branch.output = + ⟨c_branch.output.head, c_branch.output.cells⟩ := rfl + rw [hcfg_eta, hst_branch, hinp_branch, hinp_check, hwork_branch, hwork_check, + htape_eta, hhead_branch] + congr 1; simp only [hcells_branch, hcells_check, h_out_cells] + have r1 := reachesIn_trans _ hsim hreach_tr_rw + have r2 := reachesIn_trans _ r1 (.step hstep_branch .zero) + have r3 := reachesIn_trans _ r2 hsim₃ + exact reachesIn_trans _ r3 (.step h_halt_step .zero) + · exact ifTM_halted_of_state_eq_done tmTest tmThen tmElse _ rfl + · exact hpost + +-- ════════════════════════════════════════════════════════════════════════ +-- Loop invariant rule +-- ════════════════════════════════════════════════════════════════════════ + +private theorem loopTM_hoareTime_aux (tmBody tmTest : TM n) + {inv post : TapePred n} {b_iter : ℕ} + {variant : Tape → (Fin n → Tape) → Tape → ℕ} + (h_iter : ∀ inp work out, inv inp work out → + (∃ c' t, t ≤ b_iter ∧ + (loopTM tmBody tmTest).reachesIn t + ⟨(loopTM tmBody tmTest).qstart, inp, work, out⟩ c' ∧ + (loopTM tmBody tmTest).halted c' ∧ + post c'.input c'.work c'.output) + ∨ + (∃ inp' work' out' t, t ≤ b_iter ∧ + (loopTM tmBody tmTest).reachesIn t + ⟨(loopTM tmBody tmTest).qstart, inp, work, out⟩ + ⟨(loopTM tmBody tmTest).qstart, inp', work', out'⟩ ∧ + inv inp' work' out' ∧ + variant inp' work' out' < variant inp work out)) + (fuel : ℕ) : + ∀ inp work out, inv inp work out → variant inp work out ≤ fuel → + ∃ c' t, t ≤ (fuel + 1) * b_iter ∧ + (loopTM tmBody tmTest).reachesIn t + ⟨(loopTM tmBody tmTest).qstart, inp, work, out⟩ c' ∧ + (loopTM tmBody tmTest).halted c' ∧ + post c'.input c'.work c'.output := by + induction fuel with + | zero => + intro inp work out hinv hfuel + cases h_iter inp work out hinv with + | inl h => + obtain ⟨c', t, ht, hreach, hhalt, hpost⟩ := h + exact ⟨c', t, le_trans ht (by omega), hreach, hhalt, hpost⟩ + | inr h => + obtain ⟨_, _, _, _, _, _, _, hvar_dec⟩ := h + omega + | succ fuel ih => + intro inp work out hinv hfuel + cases h_iter inp work out hinv with + | inl h => + obtain ⟨c', t, ht, hreach, hhalt, hpost⟩ := h + refine ⟨c', t, le_trans ht ?_, hreach, hhalt, hpost⟩ + calc b_iter = 1 * b_iter := (Nat.one_mul _).symm + _ ≤ (fuel + 1 + 1) * b_iter := Nat.mul_le_mul_right _ (by omega) + | inr h => + obtain ⟨inp', work', out', t₁, ht₁, hreach₁, hinv', hvar_dec⟩ := h + have hfuel' : variant inp' work' out' ≤ fuel := by omega + obtain ⟨c', t₂, ht₂, hreach₂, hhalt, hpost⟩ := ih inp' work' out' hinv' hfuel' + refine ⟨c', t₁ + t₂, ?_, reachesIn_trans _ hreach₁ hreach₂, hhalt, hpost⟩ + calc t₁ + t₂ + ≤ b_iter + (fuel + 1) * b_iter := Nat.add_le_add ht₁ ht₂ + _ = (fuel + 1) * b_iter + b_iter := Nat.add_comm _ _ + _ = (fuel + 1 + 1) * b_iter := (Nat.succ_mul _ _).symm + +/-- **Loop invariant rule**. Each iteration (≤ `b_iter` steps) either halts with + `post` or returns to the loop start with `inv` preserved and `variant` decreased. + The `variant` is bounded by `k` under `inv`, giving total time `(k + 1) * b_iter`. -/ +theorem loopTM_hoareTime (tmBody tmTest : TM n) + {inv post : TapePred n} {b_iter k : ℕ} + {variant : Tape → (Fin n → Tape) → Tape → ℕ} + (h_variant_bound : ∀ inp work out, inv inp work out → variant inp work out ≤ k) + (h_iter : ∀ inp work out, inv inp work out → + (∃ c' t, t ≤ b_iter ∧ + (loopTM tmBody tmTest).reachesIn t + ⟨(loopTM tmBody tmTest).qstart, inp, work, out⟩ c' ∧ + (loopTM tmBody tmTest).halted c' ∧ + post c'.input c'.work c'.output) + ∨ + (∃ inp' work' out' t, t ≤ b_iter ∧ + (loopTM tmBody tmTest).reachesIn t + ⟨(loopTM tmBody tmTest).qstart, inp, work, out⟩ + ⟨(loopTM tmBody tmTest).qstart, inp', work', out'⟩ ∧ + inv inp' work' out' ∧ + variant inp' work' out' < variant inp work out)) : + (loopTM tmBody tmTest).HoareTime inv post ((k + 1) * b_iter) := by + intro inp work out hinv + exact loopTM_hoareTime_aux tmBody tmTest h_iter k inp work out hinv + (h_variant_bound inp work out hinv) + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Hoare/Defs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Hoare/Defs.lean new file mode 100644 index 0000000000..6627ef2be2 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Hoare/Defs.lean @@ -0,0 +1,320 @@ +/- +Copyright (c) 2025 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Internal + +/-! +# Hoare-style specifications for Turing machines + +This file defines Hoare triples for reasoning about TM behavior in terms of +tape preconditions and postconditions. This provides a compositional framework +for building and verifying complex machines from simpler components. + +## Main definitions + +- `TapePred` — a predicate on the tape configuration (input, work, output) +- `TM.HoareTime` — time-bounded Hoare triple: `{pre} tm {post} [≤ bound]` +- `TM.Hoare` — unbounded Hoare triple: `{pre} tm {post}` + +## Design notes + +Hoare triples abstract away the internal state `Q`, reasoning purely about +tape contents and head positions. This makes them ideal for compositional +reasoning: the pre/postconditions of composed machines can be stated without +reference to the internal state types of the components. + +The precondition must imply that the starting configuration has the machine's +`qstart` state. The postcondition holds at halting. +-/ + + +@[expose] public section + +namespace Complexity + +/-- A predicate on the tape configuration: input tape, work tapes, output tape. -/ +abbrev TapePred (n : ℕ) := Tape → (Fin n → Tape) → Tape → Prop + +namespace TM + +variable {n : ℕ} + +@[inherit_doc Complexity.TapePred] +abbrev TapePred (n : ℕ) := Complexity.TapePred n + +/-- **Time-bounded Hoare triple**: for any tapes satisfying `pre`, starting + from `qstart`, the machine halts within `bound` steps with tapes satisfying + `post`. + + This is the core specification type for compositional TM reasoning. + Captures both correctness (pre/post) and efficiency (time bound). -/ +def HoareTime (tm : TM n) (pre post : TapePred n) (bound : ℕ) : Prop := + ∀ inp work out, pre inp work out → + ∃ c' t, t ≤ bound ∧ + tm.reachesIn t { state := tm.qstart, input := inp, work := work, output := out } c' ∧ + tm.halted c' ∧ post c'.input c'.work c'.output + +/-- **Unbounded Hoare triple**: the machine halts with tapes satisfying `post`, + without a time bound. Useful when only correctness matters. -/ +def Hoare (tm : TM n) (pre post : TapePred n) : Prop := + ∀ inp work out, pre inp work out → + ∃ c', tm.reaches { state := tm.qstart, input := inp, work := work, output := out } c' ∧ + tm.halted c' ∧ post c'.input c'.work c'.output + +-- ════════════════════════════════════════════════════════════════════════ +-- Structural rules +-- ════════════════════════════════════════════════════════════════════════ + +/-- **Consequence rule**: weaken the precondition and strengthen the postcondition. -/ +theorem HoareTime.consequence {tm : TM n} + {pre pre' post post' : TapePred n} {b b' : ℕ} + (h : tm.HoareTime pre post b) + (hpre : ∀ inp work out, pre' inp work out → pre inp work out) + (hpost : ∀ inp work out, post inp work out → post' inp work out) + (hbound : b ≤ b') : + tm.HoareTime pre' post' b' := by + intro inp work out hpre' + obtain ⟨c', t, ht, hreach, hhalt, hpost_c⟩ := h inp work out (hpre _ _ _ hpre') + exact ⟨c', t, le_trans ht hbound, hreach, hhalt, hpost _ _ _ hpost_c⟩ + +/-- **Precondition weakening**: if `pre'` implies `pre`, lift the Hoare triple. -/ +theorem HoareTime.weaken_pre {tm : TM n} + {pre pre' post : TapePred n} {b : ℕ} + (h : tm.HoareTime pre post b) + (hpre : ∀ inp work out, pre' inp work out → pre inp work out) : + tm.HoareTime pre' post b := + h.consequence hpre (fun _ _ _ h => h) le_rfl + +/-- **Postcondition strengthening**: if `post` implies `post'`, lift the triple. -/ +theorem HoareTime.strengthen_post {tm : TM n} + {pre post post' : TapePred n} {b : ℕ} + (h : tm.HoareTime pre post b) + (hpost : ∀ inp work out, post inp work out → post' inp work out) : + tm.HoareTime pre post' b := + h.consequence (fun _ _ _ h => h) hpost le_rfl + +/-- **Time monotonicity**: increase the time bound. -/ +theorem HoareTime.mono_bound {tm : TM n} + {pre post : TapePred n} {b b' : ℕ} + (h : tm.HoareTime pre post b) (hle : b ≤ b') : + tm.HoareTime pre post b' := + h.consequence (fun _ _ _ h => h) (fun _ _ _ h => h) hle + +/-- Bounded implies unbounded. -/ +theorem HoareTime.toHoare {tm : TM n} + {pre post : TapePred n} {b : ℕ} + (h : tm.HoareTime pre post b) : + tm.Hoare pre post := by + intro inp work out hpre + obtain ⟨c', t, _, hreach, hhalt, hpost⟩ := h inp work out hpre + exact ⟨c', TM.reaches_of_reachesIn hreach, hhalt, hpost⟩ + +-- ════════════════════════════════════════════════════════════════════════ +-- Connection to DecidesInTime +-- ════════════════════════════════════════════════════════════════════════ + +/-- `DecidesInTime` implies a family of Hoare triples, one per input. -/ +theorem hoareTime_of_decidesInTime {tm : TM n} {L : Language} {T : ℕ → ℕ} + (h : tm.DecidesInTime L T) (x : List Bool) : + tm.HoareTime + (fun inp work out => inp = Tape.init (x.map Γ.ofBool) ∧ + (work = fun _ => Tape.init []) ∧ + out = Tape.init []) + (fun _ _ out => (x ∈ L → out.cells 1 = Γ.one) ∧ + (x ∉ L → out.cells 1 = Γ.zero)) + (T x.length) := by + intro inp work out ⟨hinp, hwork, hout⟩ + subst hinp; subst hout; subst hwork + obtain ⟨c', t, ht, hreach, hhalt, hmem, hnmem⟩ := h x + exact ⟨c', t, ht, hreach, hhalt, hmem, hnmem⟩ + +end TM + +namespace NTM + +variable {n : ℕ} + +@[inherit_doc Complexity.TapePred] +abbrev TapePred (n : ℕ) := Complexity.TapePred n + +/-- Time-bounded Hoare triple for nondeterministic machines: every choice + sequence of the given length reaches a halted configuration satisfying + `post`. `NTM.trace` already keeps halted configurations fixed, so this + also covers machines that halt earlier than the bound. -/ +def HoareTime (tm : NTM n) (pre post : TapePred n) (bound : ℕ) : Prop := + ∀ inp work out, pre inp work out → + ∀ choices : Fin bound → Bool, + let c' := tm.trace bound choices + { state := tm.qstart, input := inp, work := work, output := out } + tm.halted c' ∧ post c'.input c'.work c'.output + +/-- Consequence rule for NTM Hoare triples. -/ +theorem HoareTime.consequence {tm : NTM n} + {pre pre' post post' : TapePred n} {b : ℕ} + (h : tm.HoareTime pre post b) + (hpre : ∀ inp work out, pre' inp work out → pre inp work out) + (hpost : ∀ inp work out, post inp work out → post' inp work out) : + tm.HoareTime pre' post' b := by + intro inp work out hpre' choices + exact (h inp work out (hpre _ _ _ hpre') choices).imp + (fun hhalt => hhalt) (fun hp => hpost _ _ _ hp) + +/-- Precondition weakening for NTM Hoare triples. -/ +theorem HoareTime.weaken_pre {tm : NTM n} + {pre pre' post : TapePred n} {b : ℕ} + (h : tm.HoareTime pre post b) + (hpre : ∀ inp work out, pre' inp work out → pre inp work out) : + tm.HoareTime pre' post b := + h.consequence hpre (fun _ _ _ h => h) + +/-- Postcondition strengthening for NTM Hoare triples. -/ +theorem HoareTime.strengthen_post {tm : NTM n} + {pre post post' : TapePred n} {b : ℕ} + (h : tm.HoareTime pre post b) + (hpost : ∀ inp work out, post inp work out → post' inp work out) : + tm.HoareTime pre post' b := + h.consequence (fun _ _ _ h => h) hpost + +/-- Time monotonicity for NTM Hoare triples. Since `NTM.trace` is fixed after + halting, a proof for `b` steps also gives a proof for any larger bound. -/ +theorem HoareTime.mono_bound {tm : NTM n} + {pre post : TapePred n} {b b' : ℕ} + (h : tm.HoareTime pre post b) (hle : b ≤ b') : + tm.HoareTime pre post b' := by + intro inp work out hpre choices' + let c0 : Cfg n tm.Q := { state := tm.qstart, input := inp, work := work, output := out } + let choices : Fin b → Bool := fun i => choices' ⟨i.val, by omega⟩ + obtain ⟨hhalt, hpost⟩ := h inp work out hpre choices + have heq := tm.trace_mono hle (choices := choices) (choices' := choices') (c := c0) + (by intro i; rfl) hhalt + constructor + · change tm.halted (tm.trace b' choices' c0) + rw [heq] + exact hhalt + · change post (tm.trace b' choices' c0).input (tm.trace b' choices' c0).work + (tm.trace b' choices' c0).output + rw [heq] + exact hpost + +/-- Consequence rule plus time-bound weakening for NTM Hoare triples. -/ +theorem HoareTime.consequence_bound {tm : NTM n} + {pre pre' post post' : TapePred n} {b b' : ℕ} + (h : tm.HoareTime pre post b) + (hpre : ∀ inp work out, pre' inp work out → pre inp work out) + (hpost : ∀ inp work out, post inp work out → post' inp work out) + (hbound : b ≤ b') : + tm.HoareTime pre' post' b' := + (h.consequence hpre hpost).mono_bound hbound + +/-- If a finite NTM trace is halted at time `T`, then it has a least halted + prefix time. This is useful for phase-composed machines: Hoare-time facts + give halting by a fixed bound, while phase exits need the first local halt + time. -/ +theorem exists_first_halt_time_of_trace_halted (tm : NTM n) (T : ℕ) + (choices : Fin T → Bool) (c : Cfg n tm.Q) + (hhalt : tm.halted (tm.trace T choices c)) : + ∃ t, ∃ ht : t ≤ T, + tm.halted (tm.trace t (fun i => choices (Fin.castLE ht i)) c) ∧ + ∀ s, (hs : s < t) → + ¬ tm.halted (tm.trace s + (fun i => choices (Fin.castLE (le_trans (Nat.le_of_lt hs) ht) i)) c) := by + classical + let P : ℕ → Prop := fun t => + ∃ ht : t ≤ T, tm.halted (tm.trace t (fun i => choices (Fin.castLE ht i)) c) + have hP : ∃ t, P t := by + refine ⟨T, le_rfl, ?_⟩ + simpa using hhalt + let t := Nat.find hP + obtain ⟨ht, hhalt_t⟩ : P t := Nat.find_spec hP + refine ⟨t, ht, hhalt_t, ?_⟩ + intro s hs hhalts + have hsP : P s := by + exact ⟨le_trans (Nat.le_of_lt hs) ht, hhalts⟩ + exact (Nat.find_min hP hs) hsP + +/-- Hoare-time corollary of `exists_first_halt_time_of_trace_halted`: every + all-path halting proof yields a least halting prefix for each fixed choice + sequence. -/ +theorem HoareTime.exists_first_halt_time {tm : NTM n} + {pre post : TapePred n} {bound : ℕ} + (h : tm.HoareTime pre post bound) + {inp : Tape} {work : Fin n → Tape} {out : Tape} + (hpre : pre inp work out) (choices : Fin bound → Bool) : + ∃ t, ∃ ht : t ≤ bound, + tm.halted (tm.trace t (fun i => choices (Fin.castLE ht i)) + { state := tm.qstart, input := inp, work := work, output := out }) ∧ + ∀ s, (hs : s < t) → + ¬ tm.halted (tm.trace s + (fun i => choices (Fin.castLE (le_trans (Nat.le_of_lt hs) ht) i)) + { state := tm.qstart, input := inp, work := work, output := out }) := by + have hhalt := (h inp work out hpre choices).1 + exact exists_first_halt_time_of_trace_halted tm bound choices + { state := tm.qstart, input := inp, work := work, output := out } hhalt + +/-- Hoare-time first-halt extraction, preserving the Hoare postcondition at the + first halted prefix. -/ +theorem HoareTime.exists_first_halt_time_with_post {tm : NTM n} + {pre post : TapePred n} {bound : ℕ} + (h : tm.HoareTime pre post bound) + {inp : Tape} {work : Fin n → Tape} {out : Tape} + (hpre : pre inp work out) (choices : Fin bound → Bool) : + ∃ t, ∃ ht : t ≤ bound, + let c0 : Cfg n tm.Q := + { state := tm.qstart, input := inp, work := work, output := out } + tm.halted (tm.trace t (fun i => choices (Fin.castLE ht i)) c0) ∧ + post (tm.trace t (fun i => choices (Fin.castLE ht i)) c0).input + (tm.trace t (fun i => choices (Fin.castLE ht i)) c0).work + (tm.trace t (fun i => choices (Fin.castLE ht i)) c0).output ∧ + ∀ s, (hs : s < t) → + ¬ tm.halted (tm.trace s + (fun i => choices (Fin.castLE (le_trans (Nat.le_of_lt hs) ht) i)) c0) := by + obtain ⟨t, ht, hhalt_t, hfirst⟩ := + h.exists_first_halt_time hpre choices + refine ⟨t, ht, ?_, ?_, ?_⟩ + · simpa using hhalt_t + · let c0 : Cfg n tm.Q := + { state := tm.qstart, input := inp, work := work, output := out } + let choicesT : Fin t → Bool := fun i => choices (Fin.castLE ht i) + have hpost_bound := (h inp work out hpre choices).2 + have heq := tm.trace_mono ht (choices := choicesT) (choices' := choices) + (c := c0) (by intro i; rfl) (by simpa [c0, choicesT] using hhalt_t) + rw [heq] at hpost_bound + simpa [c0, choicesT] using hpost_bound + · intro s hs + simpa using hfirst s hs + +end NTM + +namespace TM + +variable {n : ℕ} + +/-- A deterministic Hoare triple lifts to an NTM Hoare triple for `TM.toNTM`. + The bound is unchanged because `toNTM` ignores the choice bit. -/ +theorem HoareTime.toNTM {tm : TM n} {pre post : TapePred n} {b : ℕ} + (h : tm.HoareTime pre post b) : + tm.toNTM.HoareTime pre post b := by + intro inp work out hpre choices + obtain ⟨c', t, ht, hreach, hhalt, hpost⟩ := h inp work out hpre + have htrace := tm.toNTM_trace_of_reachesIn hreach hhalt ht choices + constructor + · change (tm.toNTM.trace b choices + { state := tm.qstart, input := inp, work := work, output := out }).state = tm.qhalt + exact htrace ▸ hhalt + · change post + (tm.toNTM.trace b choices + { state := tm.qstart, input := inp, work := work, output := out }).input + (tm.toNTM.trace b choices + { state := tm.qstart, input := inp, work := work, output := out }).work + (tm.toNTM.trace b choices + { state := tm.qstart, input := inp, work := work, output := out }).output + exact htrace ▸ hpost + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Hoare/RetargetOutput.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Hoare/RetargetOutput.lean new file mode 100644 index 0000000000..ec47fa8e89 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Hoare/RetargetOutput.lean @@ -0,0 +1,77 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Hoare.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Lift + +/-! +# Hoare contracts for output redirection + +This module lifts a framed contract through `TM.retargetOutput`, exposing the +source output as the fresh last work tape while pinning the real output to the +standard parked blank tape. +-/ + + +public section + +namespace Complexity + +namespace TM + +/-- Lift a framed time contract while redirecting the source machine's output +to the fresh last work tape. -/ +theorem retargetOutput_hoareTime {n : ℕ} {pre post : TapePred n} + {bound : ℕ} (tm : TM n) (h : tm.HoareTime pre post bound) : + tm.retargetOutput.HoareTime + (fun inp work out => + pre inp (fun i => work (Fin.castSucc i)) (work (Fin.last n)) ∧ + out = (Tape.init []).move Dir3.right) + (fun inp work out => + post inp (fun i => work (Fin.castSucc i)) (work (Fin.last n)) ∧ + out = (Tape.init []).move Dir3.right) + bound := by + intro inp work out hpre + rcases hpre with ⟨hpre, hout⟩ + let baseWork : Fin n → Tape := fun i => work (Fin.castSucc i) + let baseCfg : Cfg n tm.Q := + { state := tm.qstart + input := inp + work := baseWork + output := work (Fin.last n) } + have hstart : + ({ state := tm.retargetOutput.qstart + input := inp + work := work + output := out } : Cfg (n + 1) tm.retargetOutput.Q) = + tm.retargetCfg baseCfg := by + apply Cfg.ext + · rfl + · rfl + · funext i + by_cases hi : i.val < n + · rw [retargetCfg_work_lt tm baseCfg i hi] + change work i = work (Fin.castSucc ⟨i.val, hi⟩) + congr + · rw [show i = Fin.last n by + apply Fin.ext + simp only [Fin.val_last] + omega] + exact (retargetCfg_work_last tm baseCfg).symm + · change out = (Tape.init []).move Dir3.right + exact hout + obtain ⟨c', time, htime, hreach, hhalt, hpost⟩ := + h inp baseWork (work (Fin.last n)) hpre + refine ⟨tm.retargetCfg c', time, htime, ?_, hhalt, ?_⟩ + · rw [hstart] + exact retargetOutput_reachesIn_retargetCfg_frame tm hreach + · refine ⟨?_, rfl⟩ + simpa [retargetCfg_work_lt, retargetCfg_work_last] using hpost + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Hoare/Space.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Hoare/Space.lean new file mode 100644 index 0000000000..40ef574598 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Hoare/Space.lean @@ -0,0 +1,178 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Hoare.Space.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Hoare.Space.Internal + +/-! +# Space-aware Hoare specifications + +`TM.HoareSpace` states the all-reachable auxiliary-space invariant required by +`TM.ComputesInSpace`; `TM.HoareTimeSpace` pairs it with a terminating +time-bounded Hoare triple. +The public API includes structural rules, sequential composition, transducer +closure, and a fresh-start computation bridge. + +## Main results + +- `TM.HoareTimeSpace.consequence` — weaken/strengthen every contract component. +- `TM.HoareSpace.weaken_pre`, `TM.HoareSpace.mono` — structural space rules. +- `Cfg.WithinAuxSpace.reachesIn` — bound head growth along a concrete run. +- `TM.HoareTime.and_hoareSpace` — pair existing endpoint and safety proofs. +- `TM.HoareTime.toHoareTimeSpace` — derive all-reachable space from time and + an initial head bound. +- `TM.seqTM_hoareTimeSpace` — compose two phases at one space budget. +- `TM.IsTransducer.seqTM` — sequential composition remains append-only. +- `TM.computesInSpace_of_hoareTimeSpace` — package per-input contracts. +-/ + + +public section + +namespace Complexity + +namespace Cfg + +/-- Enlarging the logical input region and work-space budget preserves an +auxiliary-space bound. -/ +theorem WithinAuxSpace.mono {c : Cfg n Q} + {inputLength inputLength' space space' : ℕ} + (h : c.WithinAuxSpace inputLength space) + (hinput : inputLength ≤ inputLength') (hspace : space ≤ space') : + c.WithinAuxSpace inputLength' space' := + h.mono_internal hinput hspace + +/-- The standard combinator phase transition moves input and work heads by at +most one, so one additional auxiliary-space cell covers the seam. -/ +theorem WithinAuxSpace.transition {c : Cfg n Q} + {inputLength space : ℕ} (h : c.WithinAuxSpace inputLength space) : + ({ state := c.state, + input := TM.transitionInput c.input, + work := fun i => TM.transitionTape (c.work i), + output := TM.transitionTape c.output } : Cfg n Q).WithinAuxSpace + inputLength (space + 1) := + h.transition_internal + +/-- A `time`-step run can increase every charged head position by at most +`time`, so adding that many cells preserves the auxiliary-space bound. -/ +theorem WithinAuxSpace.reachesIn {tm : TM n} + {c c' : Cfg n tm.Q} {time inputLength space : ℕ} + (h : c.WithinAuxSpace inputLength space) + (hreach : tm.reachesIn time c c') : + c'.WithinAuxSpace inputLength (space + time) := + h.reachesIn_internal hreach + +end Cfg + +namespace TM + +variable {n : ℕ} + +/-- Strengthening the precondition preserves an all-reachable space contract. -/ +theorem HoareSpace.weaken_pre {tm : TM n} + {pre pre' : TapePred n} {inputLength space : ℕ} + (h : tm.HoareSpace pre inputLength space) + (hpre : ∀ inp work out, pre' inp work out → pre inp work out) : + tm.HoareSpace pre' inputLength space := + h.weaken_pre_internal hpre + +/-- Enlarging the logical input region and auxiliary-space budget preserves a +space contract. -/ +theorem HoareSpace.mono {tm : TM n} + {pre : TapePred n} {inputLength inputLength' space space' : ℕ} + (h : tm.HoareSpace pre inputLength space) + (hinput : inputLength ≤ inputLength') (hspace : space ≤ space') : + tm.HoareSpace pre inputLength' space' := + h.mono_internal hinput hspace + +/-- Pair an existing terminating Hoare proof with an all-reachable space +proof. This is the main entry point for upgrading established subroutine +contracts without reproving their endpoint behavior. -/ +theorem HoareTime.and_hoareSpace {tm : TM n} + {pre post : TapePred n} {time inputLength space : ℕ} + (htime : tm.HoareTime pre post time) + (hspace : tm.HoareSpace pre inputLength space) : + tm.HoareTimeSpace pre post time inputLength space := + ⟨htime, hspace⟩ + +/-- Upgrade a terminating time-bounded Hoare triple to an all-reachable +time-and-space contract. If every starting configuration fits in +`initialSpace`, then at most one additional cell per machine step gives the +uniform bound `initialSpace + time`. -/ +theorem HoareTime.toHoareTimeSpace {tm : TM n} + {pre post : TapePred n} {time inputLength initialSpace : ℕ} + (htime : tm.HoareTime pre post time) + (hinitial : ∀ inp work out, pre inp work out → + ({ state := tm.qstart, input := inp, work := work, output := out } : + Cfg n tm.Q).WithinAuxSpace inputLength initialSpace) : + tm.HoareTimeSpace pre post time inputLength (initialSpace + time) := + htime.toHoareTimeSpace_internal hinitial + +/-- A time-and-space contract exposes its ordinary time-bounded Hoare triple. -/ +theorem HoareTimeSpace.toHoareTime {tm : TM n} + {pre post : TapePred n} {time inputLength space : ℕ} + (h : tm.HoareTimeSpace pre post time inputLength space) : + tm.HoareTime pre post time := + h.1 + +/-- A time-and-space contract exposes its all-reachable space component. -/ +theorem HoareTimeSpace.toHoareSpace {tm : TM n} + {pre post : TapePred n} {time inputLength space : ℕ} + (h : tm.HoareTimeSpace pre post time inputLength space) : + tm.HoareSpace pre inputLength space := + h.2 + +/-- Consequence rule: strengthen the precondition, weaken the postcondition, +and enlarge any of the three numerical bounds. -/ +theorem HoareTimeSpace.consequence {tm : TM n} + {pre pre' post post' : TapePred n} + {time time' inputLength inputLength' space space' : ℕ} + (h : tm.HoareTimeSpace pre post time inputLength space) + (hpre : ∀ inp work out, pre' inp work out → pre inp work out) + (hpost : ∀ inp work out, post inp work out → post' inp work out) + (htime : time ≤ time') (hinput : inputLength ≤ inputLength') + (hspace : space ≤ space') : + tm.HoareTimeSpace pre' post' time' inputLength' space' := + h.consequence_internal hpre hpost htime hinput hspace + +/-- Sequentially composing one-way-output machines preserves the transducer +discipline. -/ +theorem IsTransducer.seqTM {tm₁ tm₂ : TM n} + (h₁ : tm₁.IsTransducer) (h₂ : tm₂.IsTransducer) : + (seqTM tm₁ tm₂).IsTransducer := + h₁.seqTM_internal h₂ + +/-- Sequential composition of time-and-space Hoare contracts. -/ +theorem seqTM_hoareTimeSpace (tm₁ tm₂ : TM n) + {pre mid mid' post : TapePred n} + {b₁ b₂ inputLength space₁ space₂ : ℕ} + (h₁ : tm₁.HoareTimeSpace pre mid b₁ inputLength space₁) + (htrans : ∀ inp work out, mid inp work out → + mid' (transitionInput inp) (fun i => transitionTape (work i)) + (transitionTape out)) + (h₂ : tm₂.HoareTimeSpace mid' post b₂ inputLength space₂) : + (seqTM tm₁ tm₂).HoareTimeSpace pre post (b₁ + 1 + b₂) + inputLength (max space₁ space₂) := + seqTM_hoareTimeSpace_internal tm₁ tm₂ h₁ htrans h₂ + +/-- Per-input fresh-start time-and-space contracts package a total function +transducer satisfying `TM.ComputesInSpace`. -/ +theorem computesInSpace_of_hoareTimeSpace + {tm : TM n} {f : List Bool → List Bool} {T S : ℕ → ℕ} + (htrans : tm.IsTransducer) + (h : ∀ x, tm.HoareTimeSpace + (fun inp work out => + inp = Tape.init (x.map Γ.ofBool) ∧ + work = (fun _ => Tape.init []) ∧ out = Tape.init []) + (fun _ _ out => out.HasOutput (f x)) + (T x.length) x.length (S x.length)) : + tm.ComputesInSpace f S := + computesInSpace_of_hoareTimeSpace_internal htrans h + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Hoare/Space/Defs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Hoare/Space/Defs.lean new file mode 100644 index 0000000000..aa6ff8ac6e --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Hoare/Space/Defs.lean @@ -0,0 +1,43 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Hoare.Defs + +/-! +# Space-aware Hoare specifications — definitions + +Ordinary `TM.HoareTime` records a bounded terminating run, but logarithmic-space +computation requires a bound on every reachable configuration. This module +pairs those two obligations in one compositional contract. +-/ + + +@[expose] public section + +namespace Complexity + +namespace TM + +variable {n : ℕ} + +/-- An all-reachable auxiliary-space contract from tapes satisfying `pre`. -/ +def HoareSpace (tm : TM n) (pre : TapePred n) + (inputLength spaceBound : ℕ) : Prop := + ∀ inp work out, pre inp work out → + ∀ c', tm.reaches + { state := tm.qstart, input := inp, work := work, output := out } c' → + c'.WithinAuxSpace inputLength spaceBound + +/-- A time-and-space Hoare contract: ordinary terminating behavior paired with +an independent all-reachable auxiliary-space contract. -/ +def HoareTimeSpace (tm : TM n) (pre post : TapePred n) + (timeBound inputLength spaceBound : ℕ) : Prop := + tm.HoareTime pre post timeBound ∧ tm.HoareSpace pre inputLength spaceBound + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Hoare/Space/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Hoare/Space/Internal.lean new file mode 100644 index 0000000000..98da198efd --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Hoare/Space/Internal.lean @@ -0,0 +1,246 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Hoare.Space.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Hoare +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.SpaceTime.Internal.Reachability + +/-! +# Space-aware Hoare specifications — proof internals + +This module supplies structural rules, sequential composition, and the bridge +from fresh-start contracts to `TM.ComputesInSpace`. +-/ + + +public section + +namespace Complexity + +namespace Cfg + +/-- Internal monotonicity of the honest auxiliary-space predicate. -/ +theorem WithinAuxSpace.mono_internal {c : Cfg n Q} + {inputLength inputLength' space space' : ℕ} + (h : c.WithinAuxSpace inputLength space) + (hinput : inputLength ≤ inputLength') (hspace : space ≤ space') : + c.WithinAuxSpace inputLength' space' := by + constructor + · intro i + exact (h.1 i).trans hspace + · calc + c.input.head ≤ inputLength + space + 1 := h.2 + _ ≤ inputLength' + space' + 1 := by omega + +/-- Internal phase-boundary bound: the standard input/work tape transition +moves every head by at most one. -/ +theorem WithinAuxSpace.transition_internal {c : Cfg n Q} + {inputLength space : ℕ} (h : c.WithinAuxSpace inputLength space) : + ({ state := c.state, + input := TM.transitionInput c.input, + work := fun i => TM.transitionTape (c.work i), + output := TM.transitionTape c.output } : Cfg n Q).WithinAuxSpace + inputLength (space + 1) := by + constructor + · intro i + calc + (TM.transitionTape (c.work i)).head ≤ (c.work i).head + 1 := + Tape.head_writeAndMove_le _ _ _ + _ ≤ space + 1 := Nat.add_le_add_right (h.1 i) 1 + · calc + (TM.transitionInput c.input).head ≤ c.input.head + 1 := + Tape.head_move_le _ _ + _ ≤ inputLength + space + 1 + 1 := Nat.add_le_add_right h.2 1 + _ = inputLength + (space + 1) + 1 := by omega + +/-- Internal reachability rule: after `time` concrete transitions, one extra +auxiliary-space cell per transition covers every input and work head. -/ +theorem WithinAuxSpace.reachesIn_internal {tm : TM n} + {c c' : Cfg n tm.Q} {time inputLength space : ℕ} + (h : c.WithinAuxSpace inputLength space) + (hreach : tm.reachesIn time c c') : + c'.WithinAuxSpace inputLength (space + time) := by + constructor + · intro i + calc + (c'.work i).head ≤ (c.work i).head + time := + tm.work_head_reachesIn_bound hreach i + _ ≤ space + time := Nat.add_le_add_right (h.1 i) time + · calc + c'.input.head ≤ c.input.head + time := + tm.input_head_reachesIn_bound hreach + _ ≤ inputLength + (space + time) + 1 := by + have hinput := h.2 + omega + +end Cfg + +namespace TM + +variable {n : ℕ} + +/-- Internal precondition weakening for all-reachable space contracts. -/ +theorem HoareSpace.weaken_pre_internal {tm : TM n} + {pre pre' : TapePred n} {inputLength space : ℕ} + (h : tm.HoareSpace pre inputLength space) + (hpre : ∀ inp work out, pre' inp work out → pre inp work out) : + tm.HoareSpace pre' inputLength space := by + intro inp work out hpre' c' hreach + exact h inp work out (hpre inp work out hpre') c' hreach + +/-- Internal numerical monotonicity for all-reachable space contracts. -/ +theorem HoareSpace.mono_internal {tm : TM n} + {pre : TapePred n} {inputLength inputLength' space space' : ℕ} + (h : tm.HoareSpace pre inputLength space) + (hinput : inputLength ≤ inputLength') (hspace : space ≤ space') : + tm.HoareSpace pre inputLength' space' := by + intro inp work out hpre c' hreach + exact (h inp work out hpre c' hreach).mono_internal hinput hspace + +/-- Internal time-to-space bridge. Determinism bounds every reachable prefix +by the terminating run supplied by the Hoare triple, and tape heads grow by at +most one cell per step. -/ +theorem HoareTime.toHoareTimeSpace_internal {tm : TM n} + {pre post : TapePred n} {time inputLength initialSpace : ℕ} + (htime : tm.HoareTime pre post time) + (hinitial : ∀ inp work out, pre inp work out → + ({ state := tm.qstart, input := inp, work := work, output := out } : + Cfg n tm.Q).WithinAuxSpace inputLength initialSpace) : + tm.HoareTimeSpace pre post time inputLength (initialSpace + time) := by + refine ⟨htime, ?_⟩ + intro inp work out hpre c hreach + obtain ⟨cHalt, haltTime, hhaltTime, hrun, hhalt, _hpost⟩ := + htime inp work out hpre + obtain ⟨t, hreachIn⟩ := tm.reaches_to_reachesIn hreach + have ht : t ≤ haltTime := tm.reachesIn_le_halt hreachIn hrun hhalt + have hstart := hinitial inp work out hpre + exact (hstart.reachesIn_internal hreachIn).mono_internal le_rfl (by omega) + +/-- Internal consequence rule for time-and-space Hoare contracts. -/ +theorem HoareTimeSpace.consequence_internal {tm : TM n} + {pre pre' post post' : TapePred n} + {time time' inputLength inputLength' space space' : ℕ} + (h : tm.HoareTimeSpace pre post time inputLength space) + (hpre : ∀ inp work out, pre' inp work out → pre inp work out) + (hpost : ∀ inp work out, post inp work out → post' inp work out) + (htime : time ≤ time') (hinput : inputLength ≤ inputLength') + (hspace : space ≤ space') : + tm.HoareTimeSpace pre' post' time' inputLength' space' := by + constructor + · exact h.1.consequence hpre hpost htime + · intro inp work out hpre' c' hreach + exact (h.2 inp work out (hpre inp work out hpre') c' hreach).mono_internal + hinput hspace + +/-- Internal transducer closure under sequential composition. -/ +theorem IsTransducer.seqTM_internal {tm₁ tm₂ : TM n} + (h₁ : tm₁.IsTransducer) (h₂ : tm₂.IsTransducer) : + (seqTM tm₁ tm₂).IsTransducer := by + intro state iHead wHeads oHead + cases state with + | inl q => + simp only [seqTM] + split + · simp only [idleDir] + split <;> decide + · exact h₁ q iHead wHeads oHead + | inr q => + simp only [seqTM] + split + · simp only [allIdle, idleDir] + split <;> decide + · exact h₂ q iHead wHeads oHead + +/-- Internal sequential composition rule. Both phases use one shared logical +input length and auxiliary-space budget; the phase boundary is covered by the +second contract at its reflexive initial configuration. -/ +theorem seqTM_hoareTimeSpace_internal (tm₁ tm₂ : TM n) + {pre mid mid' post : TapePred n} {b₁ b₂ inputLength space₁ space₂ : ℕ} + (h₁ : tm₁.HoareTimeSpace pre mid b₁ inputLength space₁) + (htrans : ∀ inp work out, mid inp work out → + mid' (transitionInput inp) (fun i => transitionTape (work i)) + (transitionTape out)) + (h₂ : tm₂.HoareTimeSpace mid' post b₂ inputLength space₂) : + (seqTM tm₁ tm₂).HoareTimeSpace pre post (b₁ + 1 + b₂) + inputLength (max space₁ space₂) := by + constructor + · exact seqTM_hoareTime tm₁ tm₂ h₁.1 htrans h₂.1 + · intro inp work out hpre c hreach + obtain ⟨c₁, t₁, _ht₁, hreach₁, hhalt₁, hmid⟩ := + h₁.1 inp work out hpre + have hmid' := htrans c₁.input c₁.work c₁.output hmid + obtain ⟨c₂, t₂, _ht₂, hreach₂, hhalt₂, _hpost⟩ := + h₂.1 (transitionInput c₁.input) + (fun i => transitionTape (c₁.work i)) (transitionTape c₁.output) hmid' + have hfull := seqTM_reachesIn_of_reachesIn tm₁ tm₂ + hreach₁ hhalt₁ hreach₂ + have hfullHalt : + (seqTM tm₁ tm₂).halted (phase2Wrap tm₁ tm₂ c₂) := + (phase2Wrap_halted_iff tm₁ tm₂ c₂).2 hhalt₂ + obtain ⟨t, hreachT⟩ := (seqTM tm₁ tm₂).reaches_to_reachesIn hreach + have ht : t ≤ t₁ + 1 + t₂ := + (seqTM tm₁ tm₂).reachesIn_le_halt hreachT hfull hfullHalt + by_cases hphase₁ : t ≤ t₁ + · obtain ⟨d, hprefix, _hsuffix⟩ := + reachesIn_prefix_internal hreach₁ hphase₁ + have hwrapped := seqTM_reachesIn_phase1Wrap tm₁ tm₂ hprefix + have hwrapped' : + (seqTM tm₁ tm₂).reachesIn t + { state := (seqTM tm₁ tm₂).qstart, input := inp, + work := work, output := out } + (phase1Wrap tm₁ tm₂ d) := by + simpa [phase1Wrap, seqTM] using hwrapped + have hc : c = phase1Wrap tm₁ tm₂ d := + (seqTM tm₁ tm₂).reachesIn_right_unique hreachT hwrapped' + rw [hc] + have hd := h₁.2 inp work out hpre d + (TM.reaches_of_reachesIn hprefix) + exact hd.mono_internal le_rfl (le_max_left _ _) + · have hphase₂ : t₁ + 1 ≤ t := by omega + let u := t - (t₁ + 1) + have hu : u ≤ t₂ := by + dsimp only [u] + omega + obtain ⟨d, hprefix, _hsuffix⟩ := + reachesIn_prefix_internal hreach₂ hu + have hwrapped := seqTM_reachesIn_of_reachesIn tm₁ tm₂ + hreach₁ hhalt₁ hprefix + have htime : t₁ + 1 + u = t := by + dsimp only [u] + omega + rw [htime] at hwrapped + have hc : c = phase2Wrap tm₁ tm₂ d := + (seqTM tm₁ tm₂).reachesIn_right_unique hreachT hwrapped + rw [hc] + have hd := h₂.2 (transitionInput c₁.input) + (fun i => transitionTape (c₁.work i)) (transitionTape c₁.output) + hmid' d (TM.reaches_of_reachesIn hprefix) + exact hd.mono_internal le_rfl (le_max_right _ _) + +/-- Internal bridge from fresh-start time-and-space contracts to function +computation in space. -/ +theorem computesInSpace_of_hoareTimeSpace_internal + {tm : TM n} {f : List Bool → List Bool} {T S : ℕ → ℕ} + (htrans : tm.IsTransducer) + (h : ∀ x, tm.HoareTimeSpace + (fun inp work out => + inp = Tape.init (x.map Γ.ofBool) ∧ + work = (fun _ => Tape.init []) ∧ out = Tape.init []) + (fun _ _ out => out.HasOutput (f x)) + (T x.length) x.length (S x.length)) : + tm.ComputesInSpace f S := by + refine ⟨htrans, ?_, ?_⟩ + · intro x c' hreach + exact (h x).2 _ _ _ ⟨rfl, rfl, rfl⟩ c' hreach + · intro x + obtain ⟨c', t, _ht, hreach, hhalt, hout⟩ := + (h x).1 _ _ _ ⟨rfl, rfl, rfl⟩ + exact ⟨c', TM.reaches_of_reachesIn hreach, hhalt, hout⟩ + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Internal.lean new file mode 100644 index 0000000000..37454e61db --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Internal.lean @@ -0,0 +1,693 @@ +/- +Copyright (c) 2025 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine +public import Mathlib.Data.Finset.Lattice.Fold + +/-! +# TM–NTM embedding: proof internals + +Helper lemmas for `TM.toNTM_accepts_iff`, showing that the DTM step function +and the NTM trace on `toNTM` compute the same thing. +-/ + + +public section + +namespace Complexity + +variable {n : ℕ} + +private lemma TM.toNTM_trace_step (tm : TM n) {c : Cfg n tm.Q} + (T : ℕ) (choices : Fin (T + 1) → Bool) (hne : c.state ≠ tm.qhalt) : + tm.toNTM.trace (T + 1) choices c = + tm.toNTM.trace T (fun i => choices ⟨i.val + 1, by omega⟩) + ((tm.step c).get (by simp [TM.step, hne])) := by + simp [NTM.trace, hne, TM.toNTM, TM.step] + +private lemma TM.reaches_toNTM_trace (tm : TM n) {a c' : Cfg n tm.Q} + (hreach : tm.reaches a c') : + ∃ T, ∀ (ch : Fin T → Bool), tm.toNTM.trace T ch a = c' := by + induction hreach using Relation.ReflTransGen.head_induction_on with + | refl => exact ⟨0, fun _ => rfl⟩ + | @head a₀ b₀ hstep _ ih => + obtain ⟨T, hT⟩ := ih + have hne : a₀.state ≠ tm.qhalt := by + rw [TM.stepRel] at hstep; exact state_ne_qhalt_of_step hstep + refine ⟨T + 1, fun ch => ?_⟩ + rw [tm.toNTM_trace_step T ch hne] + have : (tm.step a₀).get (by simp [TM.step, hne]) = b₀ := by + simp [TM.stepRel] at hstep; simp [hstep] + rw [this]; exact hT _ + +lemma TM.toNTM_trace_reaches (tm : TM n) (c : Cfg n tm.Q) + (T : ℕ) (choices : Fin T → Bool) : + tm.reaches c (tm.toNTM.trace T choices c) := by + induction T generalizing c with + | zero => exact Relation.ReflTransGen.refl + | succ T ih => + simp only [NTM.trace] + split + · exact Relation.ReflTransGen.refl + · next hne => + have hne : c.state ≠ tm.qhalt := hne + exact Relation.ReflTransGen.head + (show tm.stepRel c _ by simp [TM.stepRel, TM.step, hne, TM.toNTM]) + (ih _ _) + +/-- For `toNTM`, the trace is independent of the choice sequence since both + transition functions are identical. -/ +lemma TM.toNTM_trace_choice_irrel (tm : TM n) (T : ℕ) (c : Cfg n tm.Q) + (ch₁ ch₂ : Fin T → Bool) : + tm.toNTM.trace T ch₁ c = tm.toNTM.trace T ch₂ c := by + induction T generalizing c with + | zero => rfl + | succ T ih => + simp only [NTM.trace] + split + · rfl + · simp only [TM.toNTM]; exact ih _ _ _ + +/-- If a DTM reaches `c'` in exactly `t` steps, then `toNTM.trace t` agrees. -/ +private lemma TM.toNTM_reachesIn_trace (tm : TM n) {c c' : Cfg n tm.Q} {t : ℕ} + (h : tm.reachesIn t c c') (ch : Fin t → Bool) : + tm.toNTM.trace t ch c = c' := by + induction h with + | zero => rfl + | @step c₀ c_mid _ _ hstep _ ih => + have hne := state_ne_qhalt_of_step hstep + rw [tm.toNTM_trace_step _ ch hne] + have : (tm.step c₀).get (by simp [TM.step, hne]) = c_mid := by + simp [TM.step, hne] at hstep ⊢; exact hstep + rw [this]; exact ih _ + +/-- If a DTM halts within `t ≤ T` steps, then `toNTM.trace T` reaches the same + halted configuration regardless of choices. -/ +lemma TM.toNTM_trace_of_reachesIn (tm : TM n) {c c' : Cfg n tm.Q} + {t T : ℕ} (h : tm.reachesIn t c c') (hhalt : tm.halted c') + (hle : t ≤ T) (ch : Fin T → Bool) : + tm.toNTM.trace T ch c = c' := by + induction T generalizing c t with + | zero => + have : t = 0 := by omega + subst this; cases h; rfl + | succ T ih => + by_cases hh : c.state = tm.qhalt + · -- c is halted → t = 0 → c = c' + have : t = 0 := by + by_contra hp; obtain ⟨t', rfl⟩ := Nat.exists_eq_succ_of_ne_zero hp + cases h with | step hs _ => simp [TM.step, hh] at hs + subst this; cases h; simp [NTM.trace, TM.toNTM, hh] + · -- c not halted → t > 0 → peel one step + have ht_pos : t ≠ 0 := by + intro h0; subst h0; cases h; exact hh hhalt + obtain ⟨t', rfl⟩ := Nat.exists_eq_succ_of_ne_zero ht_pos + obtain ⟨c_mid, hstep, hrest⟩ : + ∃ c_mid, tm.step c = some c_mid ∧ tm.reachesIn t' c_mid c' := by + cases h with | step hs hr => exact ⟨_, hs, hr⟩ + rw [tm.toNTM_trace_step T ch hh] + have : (tm.step c).get (by simp [TM.step, hh]) = c_mid := by + simp [hstep] + rw [this] + exact ih hrest (by omega) _ + +/-- The DTM and its NTM embedding agree on acceptance. -/ +theorem TM.toNTM_accepts_iff (tm : TM n) (x : List Bool) : + tm.Accepts x ↔ (tm.toNTM).Accepts x := by + constructor + · rintro ⟨c', hreach, hhalt, hout⟩ + obtain ⟨T, hT⟩ := tm.reaches_toNTM_trace hreach + exact ⟨T, fun _ => false, + by change (tm.toNTM.trace T _ (tm.initCfg x)).state = _; rw [hT]; exact hhalt, + by change (tm.toNTM.trace T _ (tm.initCfg x)).output.cells 1 = _; rw [hT]; exact hout⟩ + · rintro ⟨T, choices, hhalt, hout⟩ + exact ⟨_, tm.toNTM_trace_reaches _ T choices, hhalt, hout⟩ + +/-- If a DTM decides `L` in time `f`, then its NTM embedding also decides `L` + in time `f`. This is the key internal lemma for `DTIME ⊆ NTIME`. -/ +theorem TM.toNTM_decidesInTime (tm : TM n) {L : Language} {f : ℕ → ℕ} + (h : tm.DecidesInTime L f) : tm.toNTM.DecidesInTime L f := by + refine ⟨?_, ?_⟩ + · -- AllPathsHaltIn + intro x choices + obtain ⟨c', t, hle, hreach, hhalt, _, _⟩ := h x + have htrace := tm.toNTM_trace_of_reachesIn hreach hhalt hle choices + change (tm.toNTM.trace _ choices (tm.initCfg x)).state = tm.qhalt + rw [htrace]; exact hhalt + · -- x ∈ L ↔ AcceptsInTime + intro x; constructor + · -- x ∈ L → AcceptsInTime + intro hx + obtain ⟨c', t, hle, hreach, hhalt, hyes, _⟩ := h x + refine ⟨fun _ => false, ?_, ?_⟩ + · change (tm.toNTM.trace _ _ (tm.initCfg x)).state = _ + rw [tm.toNTM_trace_of_reachesIn hreach hhalt hle]; exact hhalt + · change (tm.toNTM.trace _ _ (tm.initCfg x)).output.cells 1 = _ + rw [tm.toNTM_trace_of_reachesIn hreach hhalt hle]; exact hyes hx + · -- AcceptsInTime → x ∈ L + intro ⟨choices, hhalt_ch, hout_ch⟩ + obtain ⟨c', t, hle, hreach, hhalt, _, hno⟩ := h x + by_contra hxL + have htrace := tm.toNTM_trace_of_reachesIn hreach hhalt hle choices + change (tm.toNTM.trace _ choices (tm.initCfg x)).output.cells 1 = _ at hout_ch + rw [htrace] at hout_ch + have := hno hxL + simp_all + +/-- Work tape heads grow by at most 1 per step. -/ +private lemma TM.work_head_step_bound (tm : TM n) {c c' : Cfg n tm.Q} + (h : tm.step c = some c') (i : Fin n) : + (c'.work i).head ≤ (c.work i).head + 1 := by + simp only [TM.step] at h + split at h + · simp at h + · simp only [Option.some.injEq] at h + rw [← h] + exact Tape.head_writeAndMove_le _ _ _ + +/-- The input head grows by at most one in a machine step. -/ +private lemma TM.input_head_step_bound (tm : TM n) {c c' : Cfg n tm.Q} + (h : tm.step c = some c') : c'.input.head ≤ c.input.head + 1 := by + simp only [TM.step] at h + split at h + · simp at h + · simp only [Option.some.injEq] at h + rw [← h] + exact Tape.head_move_le _ _ + +/-- The output head grows by at most one in a machine step. -/ +private lemma TM.output_head_step_bound (tm : TM n) {c c' : Cfg n tm.Q} + (h : tm.step c = some c') : c'.output.head ≤ c.output.head + 1 := by + simp only [TM.step] at h + split at h + · simp at h + · simp only [Option.some.injEq] at h + rw [← h] + exact Tape.head_writeAndMove_le _ _ _ + +/-- After `t` steps, each work tape head is at most `t` plus its initial value. -/ +theorem TM.work_head_reachesIn_bound (tm : TM n) {c c' : Cfg n tm.Q} {t : ℕ} + (h : tm.reachesIn t c c') (i : Fin n) : + (c'.work i).head ≤ (c.work i).head + t := by + induction h with + | zero => omega + | @step c₀ c_mid _ _ hstep _ ih => + have := tm.work_head_step_bound hstep i + omega + +/-- After `t` steps, the input head is at most `t` plus its initial value. -/ +theorem TM.input_head_reachesIn_bound (tm : TM n) {c c' : Cfg n tm.Q} {t : ℕ} + (h : tm.reachesIn t c c') : c'.input.head ≤ c.input.head + t := by + induction h with + | zero => omega + | @step c₀ c_mid _ _ hstep _ ih => + have := tm.input_head_step_bound hstep + omega + +/-- After `t` steps, the output head is at most `t` plus its initial value. -/ +theorem TM.output_head_reachesIn_bound (tm : TM n) {c c' : Cfg n tm.Q} {t : ℕ} + (h : tm.reachesIn t c c') : c'.output.head ≤ c.output.head + t := by + induction h with + | zero => omega + | @step c₀ c_mid _ _ hstep _ ih => + have := tm.output_head_step_bound hstep + omega + +/-- Deterministic runs have unique endpoints: reaching two configurations in + the same number of steps forces them to coincide. -/ +theorem TM.reachesIn_right_unique {tm : TM n} {t : ℕ} {c c' c'' : Cfg n tm.Q} + (h₁ : tm.reachesIn t c c') (h₂ : tm.reachesIn t c c'') : c' = c'' := by + induction h₁ with + | zero => cases h₂; rfl + | step hs₁ _ ih₁ => + cases h₂ with + | step hs₂ h₂' => + have heq : some _ = some _ := hs₁.symm.trans hs₂ + simp only [Option.some.injEq] at heq; subst heq + exact ih₁ h₂' + +/-- Convert `reaches` to `reachesIn`. -/ +theorem TM.reaches_to_reachesIn (tm : TM n) {c c' : Cfg n tm.Q} + (h : tm.reaches c c') : ∃ t, tm.reachesIn t c c' := by + induction h using Relation.ReflTransGen.head_induction_on with + | refl => exact ⟨0, .zero⟩ + | head hstep _ ih => + obtain ⟨t, ht⟩ := ih + exact ⟨t + 1, .step hstep ht⟩ + +/-- A DTM step is deterministic: `step` is a function. -/ +private lemma TM.step_det (tm : TM n) {c c₁ c₂ : Cfg n tm.Q} + (h₁ : tm.step c = some c₁) (h₂ : tm.step c = some c₂) : c₁ = c₂ := by + rw [h₁] at h₂; exact Option.some.inj h₂ + +/-- If a DTM halts at step `t_halt`, then any `reachesIn t` has `t ≤ t_halt`. -/ +theorem TM.reachesIn_le_halt (tm : TM n) {c c' c_halt : Cfg n tm.Q} + {t t_halt : ℕ} (hr : tm.reachesIn t c c') + (hh : tm.reachesIn t_halt c c_halt) (hhalt : tm.halted c_halt) : + t ≤ t_halt := by + induction t generalizing c t_halt with + | zero => omega + | succ t ih => + cases hr with | @step c₀ c_mid _ _ hs hr' => + cases t_halt with + | zero => + cases hh + simp [TM.step, hhalt] at hs + | succ t_halt' => + cases hh with | step hs' hh' => + have := tm.step_det hs hs' + subst this + exact Nat.succ_le_succ (ih hr' hh') + +/-- Initial work tape heads are all at position 0. -/ +lemma TM.initCfg_work_head_zero (tm : TM n) (x : List Bool) (i : Fin n) : + ((tm.initCfg x).work i).head = 0 := by + simp [Tape.init] + +/-- The initial input head is at position zero. -/ +lemma TM.initCfg_input_head_zero (tm : TM n) (x : List Bool) : + (tm.initCfg x).input.head = 0 := rfl + +/-- The initial output head is at position zero. -/ +lemma TM.initCfg_output_head_zero (tm : TM n) (x : List Bool) : + (tm.initCfg x).output.head = 0 := rfl + +/-- If a DTM is a transducer, so is its NTM embedding. -/ +theorem TM.toNTM_isTransducer (tm : TM n) (h : tm.IsTransducer) : tm.toNTM.IsTransducer := by + intro b q iHead wHeads oHead + simp only [TM.toNTM] + exact h q iHead wHeads oHead + +/-- If a DTM decides `L` in space `f`, then its NTM embedding also decides `L` + in space `f`. The uniform time bound is constructed as the maximum halting + time over all inputs of each length. -/ +theorem TM.toNTM_decidesInSpace (tm : TM n) {L : Language} {f : ℕ → ℕ} + (h : tm.DecidesInSpace L f) : tm.toNTM.DecidesInSpace L f := by + -- Extract per-input halting times + have hdata : ∀ x, ∃ t c', tm.reachesIn t (tm.initCfg x) c' ∧ tm.halted c' ∧ + (x ∈ L → c'.output.cells 1 = Γ.one) ∧ (x ∉ L → c'.output.cells 1 = Γ.zero) := by + intro x + obtain ⟨c', hreach, hhalt, hyes, hno⟩ := h.2 x + obtain ⟨t, hreachIn⟩ := tm.reaches_to_reachesIn hreach + exact ⟨t, c', hreachIn, hhalt, hyes, hno⟩ + choose t_fn c_fn hreachIn hhalt hyes hno using hdata + -- Uniform time bound: max halting time over all inputs of each length + let T : ℕ → ℕ := fun m => + Finset.sup (Finset.univ : Finset (Fin m → Bool)) (fun v => t_fn (List.ofFn v)) + have hle_T : ∀ x, t_fn x ≤ T x.length := by + intro x + show t_fn x ≤ Finset.sup Finset.univ (fun v => t_fn (List.ofFn v)) + conv_lhs => rw [show x = List.ofFn (fun i : Fin x.length => x[↑i]) from + (List.ofFn_getElem (xs := x)).symm] + exact Finset.le_sup (f := fun v => t_fn (List.ofFn v)) + (Finset.mem_univ (fun i : Fin x.length => x[↑i])) + refine ⟨T, ⟨?_, ?_⟩, ?_⟩ + · -- AllPathsHaltIn + intro x choices + have htrace := tm.toNTM_trace_of_reachesIn (hreachIn x) (hhalt x) (hle_T x) choices + change (tm.toNTM.trace _ choices (tm.initCfg x)).state = tm.qhalt + rw [htrace]; exact hhalt x + · -- x ∈ L ↔ AcceptsInTime + intro x; constructor + · intro hx + refine ⟨fun _ => false, ?_, ?_⟩ + · change (tm.toNTM.trace _ _ (tm.initCfg x)).state = tm.qhalt + rw [tm.toNTM_trace_of_reachesIn (hreachIn x) (hhalt x) (hle_T x)] + exact hhalt x + · change (tm.toNTM.trace _ _ (tm.initCfg x)).output.cells 1 = Γ.one + rw [tm.toNTM_trace_of_reachesIn (hreachIn x) (hhalt x) (hle_T x)] + exact hyes x hx + · intro ⟨choices, hhalt_ch, hout_ch⟩ + by_contra hxL + have htrace := tm.toNTM_trace_of_reachesIn (hreachIn x) (hhalt x) (hle_T x) choices + change (tm.toNTM.trace _ choices (tm.initCfg x)).output.cells 1 = _ at hout_ch + rw [htrace] at hout_ch + have := hno x hxL + simp_all + · -- Space bound + intro x choices t' ht' + have hreach := tm.toNTM_trace_reaches (tm.initCfg x) t' + (fun j : Fin t' => choices ⟨j.val, by omega⟩) + exact h.1 x _ hreach + + +namespace TM + +-- ════════════════════════════════════════════════════════════════════════ +-- Tape invariant helpers +-- ════════════════════════════════════════════════════════════════════════ + +/-- Cell 0 stays Γ.start after write + move. -/ +private theorem tape_cell0_preserved (t : Tape) (s : Γ) (d : Dir3) + (h0 : t.cells 0 = Γ.start) : + ((t.write s).move d).cells 0 = Γ.start := by + rw [Tape.move_cells]; simp only [Tape.write] + split + · exact h0 + · simp only [Function.update, dif_neg (show (0 : ℕ) ≠ t.head from fun h => by omega)] + exact h0 + +/-- Cells ≥ 1 stay non-Γ.start after writing a non-Γ.start value. -/ +private theorem tape_noStart_preserved (t : Tape) (s : Γ) (d : Dir3) + (hs : s ≠ Γ.start) (hno : ∀ i, i ≥ 1 → t.cells i ≠ Γ.start) : + ∀ i, i ≥ 1 → ((t.write s).move d).cells i ≠ Γ.start := by + intro i hi; rw [Tape.move_cells]; simp only [Tape.write] + split + · exact hno i hi + · simp only [Function.update]; split + · next heq => subst heq; exact hs + · exact hno i hi + +/-- Output cell 0 = Γ.start is preserved by one TM step. -/ +private theorem output_cell0_step {tm : TM n} {c c' : Cfg n tm.Q} + (hs : tm.step c = some c') (h0 : c.output.cells 0 = Γ.start) : + c'.output.cells 0 = Γ.start := by + have hne := state_ne_qhalt_of_step hs + simp only [step, hne, ↓reduceIte, Option.some.injEq] at hs; subst hs + exact tape_cell0_preserved _ _ _ h0 + +/-- Work-tape cell 0 is preserved by one TM step. -/ +private theorem work_cell0_step {tm : TM n} {c c' : Cfg n tm.Q} + (idx : Fin n) (hs : tm.step c = some c') + (h0 : (c.work idx).cells 0 = Γ.start) : + (c'.work idx).cells 0 = Γ.start := by + have hne := state_ne_qhalt_of_step hs + simp only [step, hne, ↓reduceIte, Option.some.injEq] at hs + subst hs + exact tape_cell0_preserved _ _ _ h0 + +/-- Output cells ≥ 1 ≠ Γ.start is preserved by one TM step. -/ +private theorem output_noStart_step {tm : TM n} {c c' : Cfg n tm.Q} + (hs : tm.step c = some c') (hno : ∀ i, i ≥ 1 → c.output.cells i ≠ Γ.start) : + ∀ i, i ≥ 1 → c'.output.cells i ≠ Γ.start := by + have hne := state_ne_qhalt_of_step hs + simp only [step, hne, ↓reduceIte, Option.some.injEq] at hs; subst hs + exact tape_noStart_preserved _ _ _ (Γw.toΓ_ne_start _) hno + +theorem output_cells_zero_eq_start_of_reachesIn {tm : TM n} {t : ℕ} {c₀ c : Cfg n tm.Q} + (h : tm.reachesIn t c₀ c) (h0 : c₀.output.cells 0 = Γ.start) : + c.output.cells 0 = Γ.start := by + induction h with + | zero => exact h0 + | step hs _ ih => exact ih (output_cell0_step hs h0) + +/-- Cell zero of any named work tape remains the left-end marker throughout a +deterministic run. -/ +theorem work_cells_zero_eq_start_of_reachesIn {tm : TM n} {t : ℕ} + {c₀ c : Cfg n tm.Q} (idx : Fin n) (h : tm.reachesIn t c₀ c) + (h0 : (c₀.work idx).cells 0 = Γ.start) : + (c.work idx).cells 0 = Γ.start := by + induction h with + | zero => exact h0 + | step hs _ ih => exact ih (work_cell0_step idx hs h0) + +theorem output_cells_ne_start_of_reachesIn {tm : TM n} {t : ℕ} {c₀ c : Cfg n tm.Q} + (h : tm.reachesIn t c₀ c) + (hno : ∀ i, i ≥ 1 → c₀.output.cells i ≠ Γ.start) : + ∀ i, i ≥ 1 → c.output.cells i ≠ Γ.start := by + induction h with + | zero => exact hno + | step hs _ ih => exact ih (output_noStart_step hs hno) + +theorem input_cells_eq_of_step {tm : TM n} {c c' : Cfg n tm.Q} + (hs : tm.step c = some c') : c'.input.cells = c.input.cells := by + have hne := state_ne_qhalt_of_step hs + simp only [step, hne, ↓reduceIte, Option.some.injEq] at hs; subst hs + exact Tape.move_cells _ _ + +theorem input_cells_eq_of_reachesIn {tm : TM n} {t : ℕ} {c₀ c : Cfg n tm.Q} + (h : tm.reachesIn t c₀ c) : c.input.cells = c₀.input.cells := by + induction h with + | zero => rfl + | step hs _ ih => rw [ih, input_cells_eq_of_step hs] + + + +/-- After one step, each tape head increases by at most 1. -/ +private theorem step_head_bound (tm : TM n) (c c' : Cfg n tm.Q) + (hs : tm.step c = some c') : + c'.input.head ≤ c.input.head + 1 ∧ + c'.output.head ≤ c.output.head + 1 ∧ + ∀ i, (c'.work i).head ≤ (c.work i).head + 1 := by + unfold TM.step at hs + split at hs + · simp at hs + · simp only [Option.some.injEq] at hs + subst hs + dsimp only [] + set δr := tm.δ c.state c.input.read (fun i => (c.work i).read) c.output.read + refine ⟨Tape.head_move_le _ δr.2.2.2.1, ?_, fun i => ?_⟩ + · have hm := Tape.head_move_le (c.output.write δr.2.2.1.toΓ) δr.2.2.2.2.2 + simp only [Tape.write_head] at hm + exact hm + · have hm := Tape.head_move_le ((c.work i).write (δr.2.1 i).toΓ) (δr.2.2.2.2.1 i) + simp only [Tape.write_head] at hm + exact hm + +/-- A tape head moves at most one cell per step, relative to an arbitrary +starting configuration. -/ +theorem head_le_start_add_of_reachesIn (tm : TM n) + {t : ℕ} {c₀ c : Cfg n tm.Q} + (hreach : tm.reachesIn t c₀ c) : + c.input.head ≤ c₀.input.head + t ∧ + c.output.head ≤ c₀.output.head + t ∧ + ∀ i, (c.work i).head ≤ (c₀.work i).head + t := by + induction hreach with + | zero => simp + | step hstep _ ih => + obtain ⟨ih_in, ih_out, ih_work⟩ := ih + obtain ⟨hs_in, hs_out, hs_work⟩ := step_head_bound tm _ _ hstep + exact ⟨by omega, by omega, fun i => by + have := hs_work i + have := ih_work i + omega⟩ + +/-- A tape head moves at most 1 cell per step. After `t` steps starting + from `initCfg`, the head is at position ≤ `t`. -/ +theorem head_le_of_reachesIn (tm : TM n) + {t : ℕ} {c : Cfg n tm.Q} + (hreach : tm.reachesIn t (tm.initCfg x) c) : + c.input.head ≤ t ∧ c.output.head ≤ t ∧ ∀ i, (c.work i).head ≤ t := by + have h := head_le_start_add_of_reachesIn tm hreach + simpa [Tape.init] using h +end TM + +/-- The invariant is preserved across one DTM step, on every tape. -/ +theorem Tape.StartInvariant.step {n : ℕ} (tm : TM n) + {c c' : Cfg n tm.Q} (hstep : tm.step c = some c') + (hinp : c.input.StartInvariant) (hwork : ∀ i, (c.work i).StartInvariant) + (hout : c.output.StartInvariant) : + c'.input.StartInvariant ∧ (∀ i, (c'.work i).StartInvariant) ∧ + c'.output.StartInvariant := by + simp only [TM.step] at hstep + split at hstep + · simp at hstep + · simp only [Option.some.injEq] at hstep + subst hstep + refine ⟨?_, ?_, ?_⟩ + · constructor + · show (c.input.move _).cells 0 = _ + rw [Tape.move_cells]; exact hinp.1 + · intro j hj + show (c.input.move _).cells j ≠ _ + rw [Tape.move_cells]; exact hinp.2 j hj + · intro i + exact Tape.StartInvariant.writeAndMove (hwork i) _ _ + · exact Tape.StartInvariant.writeAndMove hout _ _ + +namespace NTM + +variable {n : ℕ} + +/-- NTM traces never alter input tape cells; the input tape is read-only and + only its head moves. -/ +theorem input_cells_trace (tm : NTM n) (T : ℕ) + (choices : Fin T → Bool) (c : Cfg n tm.Q) : + (tm.trace T choices c).input.cells = c.input.cells := by + induction T generalizing c with + | zero => rfl + | succ T ih => + by_cases hhalt : c.state = tm.qhalt + · simp [NTM.trace, hhalt] + · simp only [NTM.trace, hhalt, if_false] + rw [ih] + cases (tm.δ (choices ⟨0, Nat.zero_lt_succ T⟩) c.state c.input.read + (fun i => (c.work i).read) c.output.read).2.2.2.1 <;> rfl + +/-- During an NTM trace, the input head increases by at most one per step. -/ +theorem input_head_trace_le (tm : NTM n) (T : ℕ) + (choices : Fin T → Bool) (c : Cfg n tm.Q) : + (tm.trace T choices c).input.head ≤ c.input.head + T := by + induction T generalizing c with + | zero => + simp [NTM.trace] + | succ T ih => + by_cases hhalt : c.state = tm.qhalt + · simp [NTM.trace, hhalt] + · simp only [NTM.trace, hhalt, if_false] + let b := choices ⟨0, Nat.zero_lt_succ T⟩ + let tr := tm.δ b c.state c.input.read (fun i => (c.work i).read) c.output.read + let c' : Cfg n tm.Q := + { state := tr.1 + input := c.input.move tr.2.2.2.1 + work := fun i => (c.work i).writeAndMove (tr.2.1 i) (tr.2.2.2.2.1 i) + output := c.output.writeAndMove tr.2.2.1 tr.2.2.2.2.2 } + have hrec := ih (fun i => choices ⟨i.val + 1, by omega⟩) c' + have hstep : c'.input.head ≤ c.input.head + 1 := by + exact Tape.head_move_le c.input tr.2.2.2.1 + change (tm.trace T (fun i => choices ⟨i.val + 1, by omega⟩) c').input.head ≤ + c.input.head + (T + 1) + calc + (tm.trace T (fun i => choices ⟨i.val + 1, by omega⟩) c').input.head + ≤ c'.input.head + T := hrec + _ ≤ (c.input.head + 1) + T := by omega + _ ≤ c.input.head + (T + 1) := by omega + +/-- During an NTM trace, every work-tape head increases by at most one per step. -/ +theorem work_head_trace_le (tm : NTM n) (T : ℕ) + (choices : Fin T → Bool) (c : Cfg n tm.Q) (i : Fin n) : + ((tm.trace T choices c).work i).head ≤ (c.work i).head + T := by + induction T generalizing c with + | zero => simp [NTM.trace] + | succ T ih => + by_cases hhalt : c.state = tm.qhalt + · simp [NTM.trace, hhalt] + · simp only [NTM.trace, hhalt, if_false] + let b := choices ⟨0, Nat.zero_lt_succ T⟩ + let tr := tm.δ b c.state c.input.read (fun j => (c.work j).read) c.output.read + let c' : Cfg n tm.Q := + { state := tr.1 + input := c.input.move tr.2.2.2.1 + work := fun j => (c.work j).writeAndMove (tr.2.1 j) (tr.2.2.2.2.1 j) + output := c.output.writeAndMove tr.2.2.1 tr.2.2.2.2.2 } + have hrec := ih (fun j => choices ⟨j.val + 1, by omega⟩) c' + have hstep : (c'.work i).head ≤ (c.work i).head + 1 := by + exact Tape.head_writeAndMove_le _ _ _ + change ((tm.trace T (fun j => choices ⟨j.val + 1, by omega⟩) c').work i).head ≤ + (c.work i).head + (T + 1) + omega + +/-- During an NTM trace, the output-tape head increases by at most one per step. -/ +theorem output_head_trace_le (tm : NTM n) (T : ℕ) + (choices : Fin T → Bool) (c : Cfg n tm.Q) : + (tm.trace T choices c).output.head ≤ c.output.head + T := by + induction T generalizing c with + | zero => simp [NTM.trace] + | succ T ih => + by_cases hhalt : c.state = tm.qhalt + · simp [NTM.trace, hhalt] + · simp only [NTM.trace, hhalt, if_false] + let b := choices ⟨0, Nat.zero_lt_succ T⟩ + let tr := tm.δ b c.state c.input.read (fun i => (c.work i).read) c.output.read + let c' : Cfg n tm.Q := + { state := tr.1 + input := c.input.move tr.2.2.2.1 + work := fun i => (c.work i).writeAndMove (tr.2.1 i) (tr.2.2.2.2.1 i) + output := c.output.writeAndMove tr.2.2.1 tr.2.2.2.2.2 } + have hrec := ih (fun i => choices ⟨i.val + 1, by omega⟩) c' + have hstep : c'.output.head ≤ c.output.head + 1 := by + exact Tape.head_writeAndMove_le _ _ _ + change (tm.trace T (fun i => choices ⟨i.val + 1, by omega⟩) c').output.head ≤ + c.output.head + (T + 1) + omega + +/-- Split a two-step trace into two one-step traces. -/ +theorem trace_two (tm : NTM n) (choices : Fin 2 → Bool) (c : Cfg n tm.Q) : + tm.trace 2 choices c = + tm.trace 1 (fun _ => choices ⟨1, by omega⟩) + (tm.trace 1 (fun _ => choices ⟨0, by omega⟩) c) := by + by_cases hhalt : c.state = tm.qhalt + · simp [NTM.trace, hhalt] + · simp [NTM.trace, hhalt] + +/-- Split the first step off a nonzero trace. If the machine is already + halted, both sides reduce to the starting configuration. -/ +theorem trace_succ (tm : NTM n) (T : ℕ) + (choices : Fin (T + 1) → Bool) (c : Cfg n tm.Q) : + tm.trace (T + 1) choices c = + tm.trace T (fun i => choices ⟨i.val + 1, by omega⟩) + (tm.trace 1 (fun _ => choices ⟨0, by omega⟩) c) := by + by_cases hhalt : c.state = tm.qhalt + · simp [NTM.trace, hhalt] + exact (tm.trace_halted T (fun i => choices ⟨i.val + 1, by omega⟩) hhalt).symm + · simp [NTM.trace, hhalt] + +/-- Split the first two steps off a trace. -/ +theorem trace_add_two (tm : NTM n) (T : ℕ) + (choices : Fin (T + 2) → Bool) (c : Cfg n tm.Q) : + tm.trace (T + 2) choices c = + tm.trace T (fun i => choices ⟨i.val + 2, by omega⟩) + (tm.trace 2 (fun i => choices ⟨i.val, by omega⟩) c) := by + change tm.trace ((T + 1) + 1) choices c = _ + rw [trace_succ tm (T + 1) choices c] + rw [trace_succ tm T + (fun i : Fin (T + 1) => choices ⟨i.val + 1, by omega⟩) + (tm.trace 1 (fun x => choices ⟨0, by omega⟩) c)] + rw [← trace_two tm (fun i : Fin 2 => choices ⟨i.val, by omega⟩) c] + +/-- Reindex a trace along an equality of time bounds. -/ +theorem trace_cast (tm : NTM n) {T T' : ℕ} (h : T = T') + (choices : Fin T → Bool) (c : Cfg n tm.Q) : + tm.trace T choices c = + tm.trace T' (fun i => choices (Fin.cast h.symm i)) c := by + cases h + rfl + +/-- Split the first `T` steps off a trace. + +This version uses `Fin.castLE`/`Fin.natAdd` for the prefix and suffix choice +sequences, which keeps later proofs away from ad-hoc dependent index casts. -/ +theorem trace_add (tm : NTM n) (T U : ℕ) + (choices : Fin (T + U) → Bool) (c : Cfg n tm.Q) : + tm.trace (T + U) choices c = + tm.trace U (fun i => choices (Fin.natAdd T i)) + (tm.trace T (fun i => choices (Fin.castLE (Nat.le_add_right T U) i)) c) := by + induction T generalizing U c with + | zero => + have h := trace_cast tm (Nat.zero_add U) choices c + rw [h] + congr 1 + funext i + apply congrArg choices + exact Fin.ext (by simp [Fin.natAdd]) + | succ T ih => + let choicesCast : Fin ((T + U) + 1) → Bool := + fun i => choices (Fin.cast (by omega : (T + U) + 1 = (T + 1) + U) i) + have hcast := trace_cast tm (by omega : (T + 1) + U = (T + U) + 1) choices c + rw [hcast] + rw [trace_succ tm (T + U) choicesCast c] + rw [ih U (fun i : Fin (T + U) => choicesCast ⟨i.val + 1, by omega⟩) + (tm.trace 1 (fun _ => choicesCast ⟨0, by omega⟩) c)] + let prefixFinal : Fin (T + 1) → Bool := + fun i => choices (Fin.castLE (Nat.le_add_right (T + 1) U) i) + have hprefix : + tm.trace (T + 1) prefixFinal c = + tm.trace T + (fun i : Fin T => + choicesCast ⟨(Fin.castLE (Nat.le_add_right T U) i).val + 1, by omega⟩) + (tm.trace 1 (fun _ => choicesCast ⟨0, by omega⟩) c) := by + simpa [choicesCast, prefixFinal, Fin.castLE, Fin.cast] using + trace_succ tm T prefixFinal c + rw [← hprefix] + congr 1 + funext i + apply congrArg choices + exact Fin.ext (by simp [Fin.val_natAdd]; omega) + +/-- Split a trace driven by an infinite choice stream at a natural-number +offset. This is the cast-free form used by fixed-schedule simulations. -/ +theorem trace_add_fun (tm : NTM n) (T U : ℕ) + (choices : ℕ → Bool) (c : Cfg n tm.Q) : + tm.trace (T + U) (fun i => choices i.val) c = + tm.trace U (fun i => choices (T + i.val)) + (tm.trace T (fun i => choices i.val) c) := by + simpa [Fin.castLE, Fin.natAdd] using + tm.trace_add T U (fun i => choices i.val) c + +end NTM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Internal/OutputBounds.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Internal/OutputBounds.lean new file mode 100644 index 0000000000..26a0243eba --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Internal/OutputBounds.lean @@ -0,0 +1,102 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Internal + +/-! +# Output-length bounds — proof internals + +This module proves that a deterministic machine cannot produce more output +bits than the number of transitions it has taken. The key support lemma says +that an output cell beyond the initial head position plus the elapsed time is +unchanged. + +Public statements are in `Complexitylib.Models.TuringMachine.OutputBounds`. +-/ + + +public section + +namespace Complexity + +namespace TM + +variable {n : ℕ} + +/-- One output-tape action leaves every cell other than the current head +unchanged. -/ +private theorem output_cells_ne_of_step {tm : TM n} {c c' : Cfg n tm.Q} + (hstep : tm.step c = some c') {j : ℕ} (hj : j ≠ c.output.head) : + c'.output.cells j = c.output.cells j := by + simp only [TM.step] at hstep + split at hstep + · simp at hstep + · simp only [Option.some.injEq] at hstep + rw [← hstep] + simp only [Tape.move_cells, Tape.write] + split + · rfl + · change Function.update c.output.cells c.output.head _ j = c.output.cells j + rw [Function.update_of_ne hj] + +/-- Cells beyond the output head's maximum reach are never changed. -/ +theorem reachesIn_output_cells_far_internal {tm : TM n} : + ∀ {t : ℕ} {c c' : Cfg n tm.Q}, tm.reachesIn t c c' → + ∀ j, c.output.head + t < j → c'.output.cells j = c.output.cells j := by + intro t + induction t with + | zero => + intro c c' hreach j _hj + cases hreach + rfl + | succ t ih => + intro c c' hreach j hj + cases hreach with + | step hstep hrest => + next c'' => + have hhead : c''.output.head ≤ c.output.head + 1 := by + have hbound := tm.output_head_reachesIn_bound + (TM.reachesIn.step hstep TM.reachesIn.zero) + simpa using hbound + have hcell : c''.output.cells j = c.output.cells j := + output_cells_ne_of_step hstep (by omega) + rw [ih hrest j (by omega), hcell] + +/-- A run from an initial configuration needs at least one transition for +each bit present in its final output string. -/ +theorem output_length_le_of_reachesIn_internal {tm : TM n} {x y : List Bool} + {c' : Cfg n tm.Q} {t : ℕ} + (hreach : tm.reachesIn t (tm.initCfg x) c') + (hout : c'.output.HasOutput y) : y.length ≤ t := by + by_contra hnle + have ht : t < y.length := Nat.lt_of_not_ge hnle + have hy : 0 < y.length := lt_of_le_of_lt (Nat.zero_le t) ht + let i := y.length - 1 + have hi : i < y.length := by + dsimp only [i] + omega + have hidx : i + 1 = y.length := by omega + have hbit := hout.1 i hi + have hfar := reachesIn_output_cells_far_internal hreach y.length (by simp; omega) + have hblank : c'.output.cells y.length = Γ.blank := by + rw [hfar] + simp [Tape.init, hy.ne'] + rw [hidx, hblank] at hbit + exact Γ.ofBool_ne_blank _ hbit.symm + +/-- A time-bounded function computation has output length bounded by its +advertised running time. -/ +theorem computesInTime_output_length_le_internal {tm : TM n} + {f : List Bool → List Bool} {T : ℕ → ℕ} + (h : tm.ComputesInTime f T) (x : List Bool) : + (f x).length ≤ T x.length := by + obtain ⟨c', t, ht, hreach, _hhalt, hout⟩ := h x + exact (output_length_le_of_reachesIn_internal hreach hout).trans ht + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Lift.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Lift.lean new file mode 100644 index 0000000000..1fde94780a --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Lift.lean @@ -0,0 +1,594 @@ +/- +Copyright (c) 2025 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators + +/-! +# Tape-layout combinators: extra work tapes and output retargeting + +Two DTM combinators that change a machine's tape layout without changing +its behavior: + +- `TM.liftTM tm m` — pad `tm : TM n` with `m` never-used work tapes, giving + a `TM (n + m)` that decides/computes exactly as `tm` does, in the same + time bound. The extra tapes bounce off `▷` on the first step (respecting + `δ_right_of_start`) and then park at cell 1 forever, writing `□` over the + `□` already there. +- `TM.retargetOutput tm` — redirect the output actions of `tm : TM n` to a + fresh work tape `n` (the `Fin.last n` tape), giving a `TM (n + 1)` whose + real output tape is idled. Used to "compute a value onto a work tape", + e.g. materializing a clock value for downstream composition. + +## Correspondence proofs + +Both combinators are proved correct by a step-commutation lemma through a +configuration embedding (`liftCfg` / `retargetCfg`): one step of the +derived machine on an embedded configuration equals one step of `tm`, +embedded. The embeddings park the dummy tapes at cell 1 with blank cells; +the initial configuration instead has dummy heads at cell 0 (on `▷`), so +the step lemma is stated for any dummy tape with `cells = Tape.init []` and +`head ≤ 1` — covering both the initial bounce and the parked steady state +(mirroring `NTM.pad0`). + +The time bounds are preserved *exactly* (no `+ 1`): the dummy-tape bounce +happens during the simulated machine's own first step. +-/ + + +@[expose] public section + +namespace Complexity + +namespace TM + +variable {n : ℕ} + +-- ════════════════════════════════════════════════════════════════════════ +-- Dummy-tape dynamics +-- ════════════════════════════════════════════════════════════════════════ + +/-- One idle action (`readBackWrite` of the read + `idleDir`) sends any + blank tape with head at cell 0 or 1 to the canonical *parked* tape + `(Tape.init []).move Dir3.right` (head 1, blank cells): at cell 0 the + write is a structural no-op and the head bounces right off `▷`; at + cell 1 it writes `□` over `□` and stays. -/ +private theorem dummy_writeAndMove (w : Tape) + (hc : w.cells = (Tape.init []).cells) (hh : w.head ≤ 1) : + w.writeAndMove (readBackWrite w.read).toΓ (idleDir w.read) + = (Tape.init []).move Dir3.right := by + have hread : w.read = (Tape.init []).cells w.head := by rw [Tape.read, hc] + rcases Nat.le_one_iff_eq_zero_or_eq_one.mp hh with h0 | h1 + · -- head at cell 0: `w` *is* `Tape.init []`, and the action is the bounce + have hw : w = Tape.init [] := by + calc w = ⟨w.head, w.cells⟩ := rfl + _ = Tape.init [] := by rw [h0, hc]; rfl + subst hw + rfl + · -- head at cell 1: write `□` over `□` and stay + have hr : w.read = Γ.blank := by rw [hread, h1]; rfl + rw [hr] + show w.write (readBackWrite Γ.blank).toΓ = (Tape.init []).move Dir3.right + rw [Tape.write, if_neg (show ¬ w.head = 0 by omega), h1, hc] + rw [show (readBackWrite Γ.blank).toΓ = (Tape.init []).cells 1 from rfl, + Function.update_eq_self] + rfl + +-- ════════════════════════════════════════════════════════════════════════ +-- liftTM: extra never-used work tapes +-- ════════════════════════════════════════════════════════════════════════ + +/-- Pad `tm : TM n` with `m` never-used work tapes. Work tapes `0..n-1` + (indexed by `Fin.castAdd m i`) behave exactly as `tm`'s; the extra + tapes `n..n+m-1` write back what they read (`readBackWrite`) and idle + (`idleDir`): they bounce off `▷` at the first step and then park at + cell 1 forever. Input and output behavior is unchanged. -/ +def liftTM (tm : TM n) (m : ℕ) : TM (n + m) where + Q := tm.Q + qstart := tm.qstart + qhalt := tm.qhalt + δ := fun q iHead wHeads oHead => + let r := tm.δ q iHead (fun i => wHeads (Fin.castAdd m i)) oHead + ( r.1, + fun i => if h : i.val < n then r.2.1 ⟨i.val, h⟩ else readBackWrite (wHeads i), + r.2.2.1, + r.2.2.2.1, + fun i => if h : i.val < n then r.2.2.2.2.1 ⟨i.val, h⟩ else idleDir (wHeads i), + r.2.2.2.2.2 ) + δ_right_of_start := by + intro q iHead wHeads oHead + obtain ⟨hin, hwork, hout⟩ := + tm.δ_right_of_start q iHead (fun i => wHeads (Fin.castAdd m i)) oHead + refine ⟨hin, fun i hi => ?_, hout⟩ + dsimp only + split + · next hlt => exact hwork ⟨i.val, hlt⟩ hi + · next hlt => exact idleDir_right_of_start hi + +/-- Embed a configuration of `tm : TM n` into one of `tm.liftTM m`: + work tapes `i < n` are `c`'s, the extras are the canonical parked + blank tape (head 1, blank cells). State, input, and output are + shared. -/ +def liftCfg (tm : TM n) (m : ℕ) (c : Cfg n tm.Q) : Cfg (n + m) tm.Q where + state := c.state + input := c.input + work := fun i => + if h : i.val < n then c.work ⟨i.val, h⟩ else (Tape.init []).move Dir3.right + output := c.output + +/-- `liftCfg` leaves the state unchanged. -/ +@[simp] theorem liftCfg_state (tm : TM n) (m : ℕ) (c : Cfg n tm.Q) : + (tm.liftCfg m c).state = c.state := rfl + +/-- `liftCfg` leaves the input tape unchanged. -/ +@[simp] theorem liftCfg_input (tm : TM n) (m : ℕ) (c : Cfg n tm.Q) : + (tm.liftCfg m c).input = c.input := rfl + +/-- `liftCfg` leaves the output tape unchanged. -/ +@[simp] theorem liftCfg_output (tm : TM n) (m : ℕ) (c : Cfg n tm.Q) : + (tm.liftCfg m c).output = c.output := rfl + +/-- `liftCfg` maps the first `n` work tapes to `c`'s work tapes. -/ +theorem liftCfg_work_lt (tm : TM n) (m : ℕ) (c : Cfg n tm.Q) + (i : Fin (n + m)) (h : i.val < n) : + (tm.liftCfg m c).work i = c.work ⟨i.val, h⟩ := dif_pos h + +/-- `liftCfg` maps the extra work tapes to the parked blank tape. -/ +theorem liftCfg_work_ge (tm : TM n) (m : ℕ) (c : Cfg n tm.Q) + (i : Fin (n + m)) (h : n ≤ i.val) : + (tm.liftCfg m c).work i = (Tape.init []).move Dir3.right := + dif_neg (Nat.not_lt.mpr h) + +/-- **Unified step commutation** for `liftTM`. If the extra work tapes of + `C` are blank with head at cell 0 or 1 and the rest of `C` matches `c`, + then one step of `tm.liftTM m` from `C` is one step of `tm` from `c`, + embedded via `liftCfg` (extras parked). This covers both the initial + bounce (extra heads at 0, on `▷`) and the parked steady state. -/ +private theorem liftTM_step_of_extras (tm : TM n) (m : ℕ) {c : Cfg n tm.Q} + {C : Cfg (n + m) tm.Q} + (hs : C.state = c.state) (hi : C.input = c.input) (ho : C.output = c.output) + (hw : ∀ (i : Fin (n + m)) (h : i.val < n), C.work i = c.work ⟨i.val, h⟩) + (hd : ∀ i : Fin (n + m), n ≤ i.val → + (C.work i).cells = (Tape.init []).cells ∧ (C.work i).head ≤ 1) : + (tm.liftTM m).step C = (tm.step c).map (tm.liftCfg m) := by + by_cases hh : c.state = tm.qhalt + · -- both machines are halted + have h1 : (tm.liftTM m).step C = none := by + simp only [step, hs, hh, show (tm.liftTM m).qhalt = tm.qhalt from rfl, + ↓reduceIte] + have h2 : tm.step c = none := by + simp only [step, hh, ↓reduceIte] + rw [h1, h2]; rfl + · cases hstep : tm.step c with + | none => exact absurd hstep (by simp [step, hh]) + | some c' => + -- extract the explicit stepped configuration + simp only [step, hh, ↓reduceIte, Option.some.injEq] at hstep + subst hstep + have hinner : (fun i : Fin n => (C.work (Fin.castAdd m i)).read) + = fun i => (c.work i).read := + funext fun i => by rw [hw (Fin.castAdd m i) i.isLt]; rfl + simp only [step, Option.map_some] + dsimp only [liftTM, liftCfg] + rw [hs, hi, ho, hinner, if_neg hh] + refine congrArg some (Cfg.mk.injEq _ _ _ _ _ _ _ _ |>.mpr ⟨rfl, rfl, ?_, rfl⟩) + funext i + by_cases hik : i.val < n + · rw [hw i hik, dif_pos hik, dif_pos hik, dif_pos hik] + · have hdi := hd i (Nat.le_of_not_lt hik) + rw [dif_neg hik, dif_neg hik, dif_neg hik] + exact dummy_writeAndMove (C.work i) hdi.1 hdi.2 + +/-- **Step commutation** on embedded configurations: once the extra tapes + are parked, `tm.liftTM m` steps exactly as `tm` does through + `liftCfg`. -/ +theorem liftTM_step_liftCfg (tm : TM n) (m : ℕ) (c : Cfg n tm.Q) : + (tm.liftTM m).step (tm.liftCfg m c) = (tm.step c).map (tm.liftCfg m) := + liftTM_step_of_extras tm m rfl rfl rfl (fun _ h => dif_pos h) + (fun i h => by + rw [liftCfg_work_ge tm m c i h] + exact ⟨rfl, Nat.le_refl 1⟩) + +/-- The first step out of the lifted initial configuration: the extra + tapes bounce off `▷` into the parked position while `tm` performs its + own first step. -/ +private theorem liftTM_step_initCfg (tm : TM n) (m : ℕ) (x : List Bool) : + (tm.liftTM m).step ((tm.liftTM m).initCfg x) + = (tm.step (tm.initCfg x)).map (tm.liftCfg m) := + liftTM_step_of_extras tm m rfl rfl rfl (fun _ _ => rfl) + (fun _ _ => ⟨rfl, Nat.zero_le 1⟩) + +/-- Multi-step commutation through `liftCfg`. -/ +private theorem liftTM_reachesIn_liftCfg (tm : TM n) (m : ℕ) {t : ℕ} + {c c' : Cfg n tm.Q} (h : tm.reachesIn t c c') : + (tm.liftTM m).reachesIn t (tm.liftCfg m c) (tm.liftCfg m c') := by + induction h with + | zero => exact .zero + | step hstep _ ih => + exact .step (by rw [liftTM_step_liftCfg, hstep]; rfl) ih + +/-- Multi-step simulation from the initial configuration: the lifted run + tracks `tm`'s run in the same number of steps, agreeing on state and + output. -/ +private theorem liftTM_reachesIn_init (tm : TM n) (m : ℕ) (x : List Bool) + {t : ℕ} {c' : Cfg n tm.Q} (h : tm.reachesIn t (tm.initCfg x) c') : + ∃ C' : Cfg (n + m) tm.Q, + (tm.liftTM m).reachesIn t ((tm.liftTM m).initCfg x) C' ∧ + C'.state = c'.state ∧ C'.output = c'.output := by + cases h with + | zero => exact ⟨(tm.liftTM m).initCfg x, .zero, rfl, rfl⟩ + | step hstep hrest => + exact ⟨tm.liftCfg m c', + .step (by rw [liftTM_step_initCfg, hstep]; rfl) + (liftTM_reachesIn_liftCfg tm m hrest), + rfl, rfl⟩ + +/-- A positive-length run of a lifted machine from genuine initialization has +the exact `liftCfg` endpoint of the underlying run. The positivity hypothesis +excludes the sole mismatch at time zero, when the extra tapes have not yet +bounced from cell `0` to their canonical parked position at cell `1`. -/ +theorem liftTM_reachesIn_initCfg_of_pos (tm : TM n) (m : ℕ) (x : List Bool) + {t : ℕ} {c' : Cfg n tm.Q} (ht : 0 < t) + (h : tm.reachesIn t (tm.initCfg x) c') : + (tm.liftTM m).reachesIn t ((tm.liftTM m).initCfg x) (tm.liftCfg m c') := by + cases h with + | zero => omega + | step hstep hrest => + exact .step (by rw [liftTM_step_initCfg, hstep]; rfl) + (liftTM_reachesIn_liftCfg tm m hrest) + +/-- Unbounded-reachability commutation through `liftCfg`. -/ +private theorem liftTM_reaches_liftCfg (tm : TM n) (m : ℕ) {c c' : Cfg n tm.Q} + (h : tm.reaches c c') : + (tm.liftTM m).reaches (tm.liftCfg m c) (tm.liftCfg m c') := by + induction h with + | refl => exact Relation.ReflTransGen.refl + | @tail b c₂ _ hbc ih => + refine ih.tail ?_ + show (tm.liftTM m).step (tm.liftCfg m b) = some (tm.liftCfg m c₂) + have hb : tm.step b = some c₂ := hbc + rw [liftTM_step_liftCfg, hb]; rfl + +/-- Unbounded simulation from the initial configuration, agreeing on state + and output. -/ +private theorem liftTM_reaches_init (tm : TM n) (m : ℕ) (x : List Bool) + {c' : Cfg n tm.Q} (h : tm.reaches (tm.initCfg x) c') : + ∃ C' : Cfg (n + m) tm.Q, + (tm.liftTM m).reaches ((tm.liftTM m).initCfg x) C' ∧ + C'.state = c'.state ∧ C'.output = c'.output := by + rcases Relation.ReflTransGen.cases_head h with heq | ⟨c₁, hstep, hrest⟩ + · subst heq + exact ⟨(tm.liftTM m).initCfg x, Relation.ReflTransGen.refl, rfl, rfl⟩ + · refine ⟨tm.liftCfg m c', + Relation.ReflTransGen.head ?_ (liftTM_reaches_liftCfg tm m hrest), rfl, rfl⟩ + show (tm.liftTM m).step ((tm.liftTM m).initCfg x) = some (tm.liftCfg m c₁) + have h1 : tm.step (tm.initCfg x) = some c₁ := hstep + rw [liftTM_step_initCfg, h1]; rfl + +/-- Every configuration the lifted machine reaches from its initial + configuration is either that initial configuration or the `liftCfg` + image of a configuration `tm` reaches. -/ +private theorem liftTM_reaches_init_inv (tm : TM n) (m : ℕ) (x : List Bool) + {C' : Cfg (n + m) tm.Q} + (h : (tm.liftTM m).reaches ((tm.liftTM m).initCfg x) C') : + C' = (tm.liftTM m).initCfg x ∨ + ∃ c' : Cfg n tm.Q, tm.reaches (tm.initCfg x) c' ∧ C' = tm.liftCfg m c' := by + induction h with + | refl => exact Or.inl rfl + | @tail b C₂ _ hbc ih => + have hstep' : (tm.liftTM m).step b = some C₂ := hbc + rcases ih with rfl | ⟨c₀, hc₀, rfl⟩ + · rw [liftTM_step_initCfg] at hstep' + cases hmc : tm.step (tm.initCfg x) with + | none => rw [hmc] at hstep'; simp at hstep' + | some c₁ => + rw [hmc] at hstep' + exact Or.inr ⟨c₁, Relation.ReflTransGen.single hmc, + (Option.some.inj hstep').symm⟩ + · rw [liftTM_step_liftCfg] at hstep' + cases hmc : tm.step c₀ with + | none => rw [hmc] at hstep'; simp at hstep' + | some c₁ => + rw [hmc] at hstep' + exact Or.inr ⟨c₁, hc₀.tail hmc, (Option.some.inj hstep').symm⟩ + +/-- **Lifting preserves deciding, with the same time bound.** The extra + work tapes never interfere: the lifted machine's run tracks `tm`'s run + step for step. -/ +theorem liftTM_decidesInTime (tm : TM n) (m : ℕ) {L : Language} {T : ℕ → ℕ} + (h : tm.DecidesInTime L T) : (tm.liftTM m).DecidesInTime L T := by + intro x + obtain ⟨c', t, ht, hreach, hhalt, hyes, hno⟩ := h x + obtain ⟨C', hR, hstate, hout⟩ := liftTM_reachesIn_init tm m x hreach + refine ⟨C', t, ht, hR, ?_, fun hx => ?_, fun hx => ?_⟩ + · show C'.state = (tm.liftTM m).qhalt + rw [hstate]; exact hhalt + · rw [hout]; exact hyes hx + · rw [hout]; exact hno hx + +/-- **Lifting preserves function computation, with the same time bound.** -/ +theorem liftTM_computesInTime (tm : TM n) (m : ℕ) {f : List Bool → List Bool} + {T : ℕ → ℕ} (h : tm.ComputesInTime f T) : + (tm.liftTM m).ComputesInTime f T := by + intro x + obtain ⟨c', t, ht, hreach, hhalt, hout⟩ := h x + obtain ⟨C', hR, hstate, houtC⟩ := liftTM_reachesIn_init tm m x hreach + refine ⟨C', t, ht, hR, ?_, ?_⟩ + · show C'.state = (tm.liftTM m).qhalt + rw [hstate]; exact hhalt + · rw [houtC]; exact hout + +/-- **Lifting preserves space bounds up to the parked cell.** The extra + work tapes' heads never move past cell 1, so `tm.liftTM m` decides `L` + in space `max (S ·) 1`. -/ +theorem liftTM_decidesInSpace (tm : TM n) (m : ℕ) {L : Language} {S : ℕ → ℕ} + (h : tm.DecidesInSpace L S) : + (tm.liftTM m).DecidesInSpace L (fun k => max (S k) 1) := by + obtain ⟨hspace, hdec⟩ := h + constructor + · intro x C' hreach + rcases liftTM_reaches_init_inv tm m x hreach with rfl | ⟨c', hc', rfl⟩ + · simp [Cfg.WithinDecisionSpace, Cfg.WithinAuxSpace] + · obtain ⟨⟨hwork, hin⟩, hout⟩ := hspace x c' hc' + refine ⟨⟨?_, ?_⟩, ?_⟩ + · intro j + by_cases hj : j.val < n + · rw [liftCfg_work_lt tm m c' j hj] + exact (hwork ⟨j.val, hj⟩).trans (le_max_left _ _) + · rw [liftCfg_work_ge tm m c' j (Nat.le_of_not_lt hj)] + exact le_max_right _ _ + · simp only [liftCfg_input] + have := le_max_left (S x.length) 1 + omega + · simp only [liftCfg_output] + have := le_max_left (S x.length) 1 + omega + · intro x + obtain ⟨c', hreach, hhalt, hyes, hno⟩ := hdec x + obtain ⟨C', hR, hstate, hout⟩ := liftTM_reaches_init tm m x hreach + refine ⟨C', hR, ?_, fun hx => ?_, fun hx => ?_⟩ + · show C'.state = (tm.liftTM m).qhalt + rw [hstate]; exact hhalt + · rw [hout]; exact hyes hx + · rw [hout]; exact hno hx + +-- ════════════════════════════════════════════════════════════════════════ +-- retargetOutput: write the output onto a fresh work tape +-- ════════════════════════════════════════════════════════════════════════ + +/-- Redirect `tm`'s output actions to a fresh work tape. `retargetOutput + tm : TM (n + 1)` behaves like `tm`, except that the output write and + direction are applied to work tape `n` (the `Fin.last n` tape), whose + read is fed to `tm.δ` as the virtual output head; the real output tape + is idled (`readBackWrite`/`idleDir`). Work tapes `0..n-1` (indexed by + `Fin.castSucc i`) and the input tape behave as before. -/ +def retargetOutput (tm : TM n) : TM (n + 1) where + Q := tm.Q + qstart := tm.qstart + qhalt := tm.qhalt + δ := fun q iHead wHeads oHead => + let r := tm.δ q iHead (fun i => wHeads (Fin.castSucc i)) (wHeads (Fin.last n)) + ( r.1, + fun i => if h : i.val < n then r.2.1 ⟨i.val, h⟩ else r.2.2.1, + readBackWrite oHead, + r.2.2.2.1, + fun i => if h : i.val < n then r.2.2.2.2.1 ⟨i.val, h⟩ else r.2.2.2.2.2, + idleDir oHead ) + δ_right_of_start := by + intro q iHead wHeads oHead + obtain ⟨hin, hwork, hout⟩ := + tm.δ_right_of_start q iHead (fun i => wHeads (Fin.castSucc i)) + (wHeads (Fin.last n)) + refine ⟨hin, fun i hi => ?_, fun hoh => idleDir_right_of_start hoh⟩ + dsimp only + split + · next hlt => exact hwork ⟨i.val, hlt⟩ hi + · next hlt => + have hi_last : i = Fin.last n := by + apply Fin.ext + have := i.isLt + simp only [Fin.val_last] + omega + exact hout (hi_last ▸ hi) + +/-- Embed a configuration of `tm : TM n` into one of `tm.retargetOutput`: + work tapes `i < n` are `c`'s, work tape `n` is `c`'s output tape, and + the real output tape is the canonical parked blank tape. -/ +def retargetCfg (tm : TM n) (c : Cfg n tm.Q) : Cfg (n + 1) tm.Q where + state := c.state + input := c.input + work := fun i => if h : i.val < n then c.work ⟨i.val, h⟩ else c.output + output := (Tape.init []).move Dir3.right + +/-- `retargetCfg` leaves the state unchanged. -/ +@[simp] theorem retargetCfg_state (tm : TM n) (c : Cfg n tm.Q) : + (tm.retargetCfg c).state = c.state := rfl + +/-- `retargetCfg` leaves the input tape unchanged. -/ +@[simp] theorem retargetCfg_input (tm : TM n) (c : Cfg n tm.Q) : + (tm.retargetCfg c).input = c.input := rfl + +/-- `retargetCfg` maps the first `n` work tapes to `c`'s work tapes. -/ +theorem retargetCfg_work_lt (tm : TM n) (c : Cfg n tm.Q) + (i : Fin (n + 1)) (h : i.val < n) : + (tm.retargetCfg c).work i = c.work ⟨i.val, h⟩ := dif_pos h + +/-- `retargetCfg` maps the last work tape to `c`'s output tape. -/ +theorem retargetCfg_work_last (tm : TM n) (c : Cfg n tm.Q) : + (tm.retargetCfg c).work (Fin.last n) = c.output := dif_neg (Nat.lt_irrefl n) + +/-- **Unified step commutation** for `retargetOutput`: if `C`'s real + output tape is blank with head at cell 0 or 1, work tape `n` matches + `c`'s output tape, and the rest of `C` matches `c`, then one step of + `tm.retargetOutput` from `C` is one step of `tm` from `c`, embedded + via `retargetCfg`. -/ +private theorem retargetOutput_step_of_extras (tm : TM n) {c : Cfg n tm.Q} + {C : Cfg (n + 1) tm.Q} + (hs : C.state = c.state) (hi : C.input = c.input) + (hw : ∀ (i : Fin (n + 1)) (h : i.val < n), C.work i = c.work ⟨i.val, h⟩) + (hlast : C.work (Fin.last n) = c.output) + (ho : C.output.cells = (Tape.init []).cells ∧ C.output.head ≤ 1) : + (tm.retargetOutput).step C = (tm.step c).map tm.retargetCfg := by + by_cases hh : c.state = tm.qhalt + · -- both machines are halted + have h1 : (tm.retargetOutput).step C = none := by + simp only [step, hs, hh, show (tm.retargetOutput).qhalt = tm.qhalt from rfl, + ↓reduceIte] + have h2 : tm.step c = none := by + simp only [step, hh, ↓reduceIte] + rw [h1, h2]; rfl + · cases hstep : tm.step c with + | none => exact absurd hstep (by simp [step, hh]) + | some c' => + -- extract the explicit stepped configuration + simp only [step, hh, ↓reduceIte, Option.some.injEq] at hstep + subst hstep + have hinner : (fun i : Fin n => (C.work (Fin.castSucc i)).read) + = fun i => (c.work i).read := + funext fun i => by rw [hw (Fin.castSucc i) i.isLt]; rfl + have hvirt : (C.work (Fin.last n)).read = c.output.read := by rw [hlast] + simp only [step, Option.map_some] + dsimp only [retargetOutput, retargetCfg] + rw [hs, hi, hinner, hvirt, if_neg hh] + refine congrArg some (Cfg.mk.injEq _ _ _ _ _ _ _ _ |>.mpr ⟨rfl, rfl, ?_, ?_⟩) + · funext i + by_cases hik : i.val < n + · rw [hw i hik, dif_pos hik, dif_pos hik, dif_pos hik] + · have hi_last : i = Fin.last n := by + apply Fin.ext + have := i.isLt + simp only [Fin.val_last] + omega + rw [dif_neg hik, dif_neg hik, dif_neg hik, hi_last, hlast] + · exact dummy_writeAndMove C.output ho.1 ho.2 + +/-- **Step commutation** on embedded configurations: once the real output + tape is parked, `tm.retargetOutput` steps exactly as `tm` does through + `retargetCfg`. -/ +theorem retargetOutput_step_retargetCfg (tm : TM n) (c : Cfg n tm.Q) : + (tm.retargetOutput).step (tm.retargetCfg c) = (tm.step c).map tm.retargetCfg := + retargetOutput_step_of_extras tm rfl rfl (fun _ h => dif_pos h) + (retargetCfg_work_last tm c) + ⟨rfl, Nat.le_refl 1⟩ + +/-- The first step out of the retargeted initial configuration: the real + output tape bounces off `▷` into the parked position while `tm` + performs its own first step (work tape `n` mirrors `tm`'s output tape, + which also starts at `Tape.init []`). -/ +private theorem retargetOutput_step_initCfg (tm : TM n) (x : List Bool) : + (tm.retargetOutput).step ((tm.retargetOutput).initCfg x) + = (tm.step (tm.initCfg x)).map tm.retargetCfg := + retargetOutput_step_of_extras tm rfl rfl (fun _ _ => rfl) rfl + ⟨rfl, Nat.zero_le 1⟩ + +/-- Multi-step commutation through `retargetCfg`. -/ +private theorem retargetOutput_reachesIn_retargetCfg (tm : TM n) {t : ℕ} + {c c' : Cfg n tm.Q} (h : tm.reachesIn t c c') : + (tm.retargetOutput).reachesIn t (tm.retargetCfg c) (tm.retargetCfg c') := by + induction h with + | zero => exact .zero + | step hstep _ ih => + exact .step (by rw [retargetOutput_step_retargetCfg, hstep]; rfl) ih + +/-- Redirecting output to a fresh work tape preserves every exact run through +the canonical configuration embedding. -/ +theorem retargetOutput_reachesIn_retargetCfg_frame (tm : TM n) {t : ℕ} + {c c' : Cfg n tm.Q} (h : tm.reachesIn t c c') : + (tm.retargetOutput).reachesIn t (tm.retargetCfg c) (tm.retargetCfg c') := + retargetOutput_reachesIn_retargetCfg tm h + +/-- Multi-step simulation from the initial configuration: the retargeted + run tracks `tm`'s run in the same number of steps, with work tape `n` + holding `tm`'s output tape. -/ +private theorem retargetOutput_reachesIn_init (tm : TM n) (x : List Bool) + {t : ℕ} {c' : Cfg n tm.Q} (h : tm.reachesIn t (tm.initCfg x) c') : + ∃ C' : Cfg (n + 1) tm.Q, + (tm.retargetOutput).reachesIn t ((tm.retargetOutput).initCfg x) C' ∧ + C'.state = c'.state ∧ C'.work (Fin.last n) = c'.output := by + cases h with + | zero => exact ⟨(tm.retargetOutput).initCfg x, .zero, rfl, rfl⟩ + | step hstep hrest => + exact ⟨tm.retargetCfg c', + .step (by rw [retargetOutput_step_initCfg, hstep]; rfl) + (retargetOutput_reachesIn_retargetCfg tm hrest), + rfl, retargetCfg_work_last tm c'⟩ + +/-- A run of an output-retargeted machine leaves the virtual output on the +last work tape and keeps the real output blank with its head at cell zero or +one. A subsequent combinator transition therefore parks it at cell one. -/ +theorem retargetOutput_reachesIn_init_boundary (tm : TM n) (x : List Bool) + {t : ℕ} {c' : Cfg n tm.Q} (h : tm.reachesIn t (tm.initCfg x) c') : + ∃ C' : Cfg (n + 1) tm.Q, + (tm.retargetOutput).reachesIn t ((tm.retargetOutput).initCfg x) C' ∧ + C'.state = c'.state ∧ C'.work (Fin.last n) = c'.output ∧ + C'.output.cells = (Tape.init []).cells ∧ C'.output.head ≤ 1 := by + cases h with + | zero => + exact ⟨(tm.retargetOutput).initCfg x, .zero, rfl, rfl, rfl, + Nat.zero_le 1⟩ + | step hstep hrest => + refine ⟨tm.retargetCfg c', + .step (by rw [retargetOutput_step_initCfg, hstep]; rfl) + (retargetOutput_reachesIn_retargetCfg tm hrest), + rfl, retargetCfg_work_last tm c', rfl, le_rfl⟩ + +/-- **Output retargeting preserves computation, with the same time + bound.** If `tm` computes `f` within time `T`, then `retargetOutput + tm` halts within `T(|x|)` steps with `f x` written on work tape `n` + (the `Fin.last n` tape). This is the form needed to compose "compute a + clock value onto a work tape". -/ +theorem retargetOutput_computesInTime (tm : TM n) {f : List Bool → List Bool} + {T : ℕ → ℕ} (h : tm.ComputesInTime f T) (x : List Bool) : + ∃ (c' : Cfg (n + 1) tm.Q) (t : ℕ), t ≤ T x.length ∧ + (tm.retargetOutput).reachesIn t ((tm.retargetOutput).initCfg x) c' ∧ + (tm.retargetOutput).halted c' ∧ + (c'.work (Fin.last n)).HasOutput (f x) := by + obtain ⟨c₀, t, ht, hreach, hhalt, hout⟩ := h x + obtain ⟨C', hR, hstate, hwork⟩ := retargetOutput_reachesIn_init tm x hreach + refine ⟨C', t, ht, hR, ?_, ?_⟩ + · show C'.state = (tm.retargetOutput).qhalt + rw [hstate]; exact hhalt + · rw [hwork]; exact hout + +/-- Output retargeting with the blank real-output frame exposed. This is the +form used by sequential function composition. -/ +theorem retargetOutput_computesInTime_boundary (tm : TM n) + {f : List Bool → List Bool} {T : ℕ → ℕ} + (h : tm.ComputesInTime f T) (x : List Bool) : + ∃ (c' : Cfg (n + 1) tm.Q) (t : ℕ), t ≤ T x.length ∧ + (tm.retargetOutput).reachesIn t ((tm.retargetOutput).initCfg x) c' ∧ + (tm.retargetOutput).halted c' ∧ + (c'.work (Fin.last n)).HasOutput (f x) ∧ + c'.output.cells = (Tape.init []).cells ∧ c'.output.head ≤ 1 := by + obtain ⟨c₀, t, ht, hreach, hhalt, hout⟩ := h x + obtain ⟨C', hR, hstate, hwork, houtCells, houtHead⟩ := + retargetOutput_reachesIn_init_boundary tm x hreach + refine ⟨C', t, ht, hR, ?_, ?_, houtCells, houtHead⟩ + · show C'.state = (tm.retargetOutput).qhalt + rw [hstate] + exact hhalt + · rw [hwork] + exact hout + +/-- Padding by unused work tapes preserves one-way output behavior. -/ +theorem IsTransducer.liftTM {tm : TM n} (h : tm.IsTransducer) (m : ℕ) : + (tm.liftTM m).IsTransducer := by + intro q iHead wHeads oHead + simpa only [liftTM] using h q iHead + (fun i => wHeads (Fin.castAdd m i)) oHead + +/-- Redirecting output to a work tape leaves the real output direction idle, +so the resulting machine is always a one-way-output transducer. -/ +theorem retargetOutput_isTransducer (tm : TM n) : + tm.retargetOutput.IsTransducer := by + intro q iHead wHeads oHead + simp only [retargetOutput] + unfold idleDir + split <;> decide + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/OutputBounds.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/OutputBounds.lean new file mode 100644 index 0000000000..641d57bddd --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/OutputBounds.lean @@ -0,0 +1,58 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Internal.OutputBounds + +/-! +# Output-length bounds + +A deterministic machine can change only the output cell currently under its +head. Consequently, a run of `t` transitions from a blank output tape can +produce at most `t` output bits. + +## Main results + +- `TM.reachesIn_output_cells_far` — sufficiently distant output cells are unchanged +- `TM.output_length_le_of_reachesIn` — a run bounds its output length +- `TM.ComputesInTime.output_length_le` — a time bound also bounds output length +-/ + + +public section + +namespace Complexity + +namespace TM + +variable {n : ℕ} + +/-- Cells beyond the output head's maximum reach are never changed. -/ +theorem reachesIn_output_cells_far {tm : TM n} {t : ℕ} + {c c' : Cfg n tm.Q} (hreach : tm.reachesIn t c c') + (j : ℕ) (hj : c.output.head + t < j) : + c'.output.cells j = c.output.cells j := by + exact reachesIn_output_cells_far_internal hreach j hj + +/-- A run from an initial configuration needs at least one transition for +each bit present in its final output string. -/ +theorem output_length_le_of_reachesIn {tm : TM n} {x y : List Bool} + {c' : Cfg n tm.Q} {t : ℕ} + (hreach : tm.reachesIn t (tm.initCfg x) c') + (hout : c'.output.HasOutput y) : y.length ≤ t := by + exact output_length_le_of_reachesIn_internal hreach hout + +/-- The output of a time-bounded function computation is no longer than the +advertised running-time bound. -/ +theorem ComputesInTime.output_length_le {tm : TM n} + {f : List Bool → List Bool} {T : ℕ → ℕ} + (h : tm.ComputesInTime f T) (x : List Bool) : + (f x).length ≤ T x.length := by + exact computesInTime_output_length_le_internal h x + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Placement.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Placement.lean new file mode 100644 index 0000000000..bd6819bcf3 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Placement.lean @@ -0,0 +1,140 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Placement.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Placement.Internal + +/-! +# Work-tape placement + +This public surface exposes exact simulation theorems for `TM.placeWorkTM`. +The source machine occupies a contiguous middle block of physical work tapes; +prefix and suffix tapes form an arbitrary preserved frame whenever their heads +are parked away from the left-end marker. + +## Main results + +- `TM.placeWorkTM_step_placeWorkCfg` — exact step with an evolving frame +- `TM.placeWorkTM_reachesIn_placeWorkCfg_stable` — exact stable-frame simulation +- `TM.placeWorkTM_reachesIn_placeWorkParkedCfg` — canonical parked simulation +- `TM.placeWorkTM_computesInTime` — same-time preservation of computation +-/ + + +public section + +namespace Complexity + +namespace TM + +variable {n : ℕ} + +/-- A placed step simulates one source step while applying the prescribed idle +action to the arbitrary physical extra-tape frame. -/ +theorem placeWorkTM_step_placeWorkCfg (tm : TM n) (pre post : ℕ) + (extras : Fin (pre + n + post) → Tape) (c : Cfg n tm.Q) : + (placeWorkTM pre post tm).step (placeWorkCfg tm pre post extras c) = + (tm.step c).map + (placeWorkCfg tm pre post (placeWorkFrameStep extras)) := + placeWorkTM_step_placeWorkCfg_internal tm pre post extras c + +/-- If every extra tape reads a non-left-end symbol, its idle action is a +no-op and a placed step commutes through the unchanged frame. -/ +theorem placeWorkTM_step_placeWorkCfg_stable (tm : TM n) (pre post : ℕ) + (extras : Fin (pre + n + post) → Tape) (c : Cfg n tm.Q) + (hextra : ∀ i, ¬placeWorkInMiddle pre n i → (extras i).read ≠ Γ.start) : + (placeWorkTM pre post tm).step (placeWorkCfg tm pre post extras c) = + (tm.step c).map (placeWorkCfg tm pre post extras) := + placeWorkTM_step_placeWorkCfg_stable_internal tm pre post extras c hextra + +/-- Start-invariant extra tapes whose heads are at positive positions form a +stable frame for one placed step. -/ +theorem placeWorkTM_step_placeWorkCfg_of_startInvariant (tm : TM n) + (pre post : ℕ) (extras : Fin (pre + n + post) → Tape) (c : Cfg n tm.Q) + (hinv : ∀ i, ¬placeWorkInMiddle pre n i → Tape.StartInvariant (extras i)) + (hhead : ∀ i, ¬placeWorkInMiddle pre n i → 1 ≤ (extras i).head) : + (placeWorkTM pre post tm).step (placeWorkCfg tm pre post extras c) = + (tm.step c).map (placeWorkCfg tm pre post extras) := by + apply placeWorkTM_step_placeWorkCfg_stable tm pre post extras c + intro i hi + show (extras i).cells (extras i).head ≠ Γ.start + exact (hinv i hi).2 (extras i).head (hhead i hi) + +/-- A stable arbitrary frame is preserved exactly throughout a bounded source +run, with no time overhead. -/ +theorem placeWorkTM_reachesIn_placeWorkCfg_stable (tm : TM n) + (pre post : ℕ) (extras : Fin (pre + n + post) → Tape) + {t : ℕ} {c c' : Cfg n tm.Q} (hreach : tm.reachesIn t c c') + (hextra : ∀ i, ¬placeWorkInMiddle pre n i → (extras i).read ≠ Γ.start) : + (placeWorkTM pre post tm).reachesIn t + (placeWorkCfg tm pre post extras c) + (placeWorkCfg tm pre post extras c') := + placeWorkTM_reachesIn_placeWorkCfg_stable_internal tm pre post extras hreach hextra + +/-- Start-invariant positive-head extras remain an exact frame throughout a +bounded source run. -/ +theorem placeWorkTM_reachesIn_placeWorkCfg_of_startInvariant (tm : TM n) + (pre post : ℕ) (extras : Fin (pre + n + post) → Tape) + {t : ℕ} {c c' : Cfg n tm.Q} (hreach : tm.reachesIn t c c') + (hinv : ∀ i, ¬placeWorkInMiddle pre n i → Tape.StartInvariant (extras i)) + (hhead : ∀ i, ¬placeWorkInMiddle pre n i → 1 ≤ (extras i).head) : + (placeWorkTM pre post tm).reachesIn t + (placeWorkCfg tm pre post extras c) + (placeWorkCfg tm pre post extras c') := by + apply placeWorkTM_reachesIn_placeWorkCfg_stable tm pre post extras hreach + intro i hi + show (extras i).cells (extras i).head ≠ Γ.start + exact (hinv i hi).2 (extras i).head (hhead i hi) + +/-- The canonical parked embedding commutes with one source step. -/ +theorem placeWorkTM_step_placeWorkParkedCfg (tm : TM n) (pre post : ℕ) + (c : Cfg n tm.Q) : + (placeWorkTM pre post tm).step (placeWorkParkedCfg tm pre post c) = + (tm.step c).map (placeWorkParkedCfg tm pre post) := + placeWorkTM_step_placeWorkParkedCfg_internal tm pre post c + +/-- The canonical parked embedding simulates a bounded source run exactly. -/ +theorem placeWorkTM_reachesIn_placeWorkParkedCfg (tm : TM n) + (pre post : ℕ) {t : ℕ} {c c' : Cfg n tm.Q} + (hreach : tm.reachesIn t c c') : + (placeWorkTM pre post tm).reachesIn t + (placeWorkParkedCfg tm pre post c) + (placeWorkParkedCfg tm pre post c') := + placeWorkTM_reachesIn_placeWorkParkedCfg_internal tm pre post hreach + +/-- A placed embedded configuration is halted exactly when its source +configuration is halted. -/ +@[simp] theorem placeWorkCfg_halted_iff (tm : TM n) (pre post : ℕ) + (extras : Fin (pre + n + post) → Tape) (c : Cfg n tm.Q) : + (placeWorkTM pre post tm).halted (placeWorkCfg tm pre post extras c) ↔ + tm.halted c := by + rfl + +/-- A bounded run from the source's ordinary initial configuration lifts with +the same duration. A positive run ends in the canonical parked embedding; at +time zero the placed machine remains at its own ordinary initial configuration. -/ +theorem placeWorkTM_reachesIn_init (tm : TM n) (pre post : ℕ) + (x : List Bool) {t : ℕ} {c' : Cfg n tm.Q} + (hreach : tm.reachesIn t (tm.initCfg x) c') : + ∃ C' : Cfg (pre + n + post) (placeWorkTM pre post tm).Q, + (placeWorkTM pre post tm).reachesIn t ((placeWorkTM pre post tm).initCfg x) C' ∧ + C'.state = c'.state ∧ C'.input = c'.input ∧ C'.output = c'.output ∧ + (t = 0 ∨ C' = placeWorkParkedCfg tm pre post c') := + placeWorkTM_reachesIn_init_internal tm pre post x hreach + +/-- Work-tape placement preserves deterministic function computation with +exactly the same time bound. The surrounding blank tapes bounce off `▷` +during the source machine's own first step and then remain parked. -/ +theorem placeWorkTM_computesInTime (tm : TM n) (pre post : ℕ) + {f : List Bool → List Bool} {T : ℕ → ℕ} + (hcomp : tm.ComputesInTime f T) : + (placeWorkTM pre post tm).ComputesInTime f T := + placeWorkTM_computesInTime_internal tm pre post hcomp + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Placement/Defs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Placement/Defs.lean new file mode 100644 index 0000000000..eee7d9ec82 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Placement/Defs.lean @@ -0,0 +1,184 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators + +/-! +# Work-tape placement + +This file defines a layout combinator that places the work tapes of a machine +inside a larger, contiguous middle block. The surrounding physical tapes are +idled, so later phases can reserve disjoint tape regions without changing the +source machine. + +## Main definitions + +- `TM.placeWorkIdx` — physical index of a source work tape +- `TM.placeWorkCoord` — source coordinate of a physical middle-block tape +- `TM.placeWorkTM` — place a machine between `pre` prefix and `post` suffix tapes +- `TM.placeWorkCfg` — embed a configuration with an arbitrary extra-tape frame +- `TM.placeWorkFrameStep` — one idle action on every physical frame tape +- `TM.placeWorkParkedCfg` — the canonical embedding with parked blank extras +-/ + + +@[expose] public section + +namespace Complexity + +namespace TM + +variable {n pre post : ℕ} + +/-- Physical work-tape index occupied by source work tape `i` after placement. -/ +def placeWorkIdx (pre post : ℕ) (i : Fin n) : Fin (pre + n + post) := + ⟨pre + i.val, by omega⟩ + +/-- A physical work tape lies in the block occupied by the source machine. -/ +def placeWorkInMiddle (pre n : ℕ) {post : ℕ} (i : Fin (pre + n + post)) : Prop := + pre ≤ i.val ∧ i.val < pre + n + +instance instDecidablePlaceWorkInMiddle (pre n : ℕ) {post : ℕ} + (i : Fin (pre + n + post)) : Decidable (placeWorkInMiddle pre n i) := by + unfold placeWorkInMiddle + infer_instance + +/-- Source coordinate corresponding to a physical tape in the middle block. -/ +def placeWorkCoord (pre n : ℕ) {post : ℕ} (i : Fin (pre + n + post)) + (h : placeWorkInMiddle pre n i) : Fin n := + ⟨i.val - pre, by + unfold placeWorkInMiddle at h + omega⟩ + +@[simp] theorem placeWorkIdx_val (pre post : ℕ) (i : Fin n) : + (placeWorkIdx pre post i).val = pre + i.val := rfl + +@[simp] theorem placeWorkInMiddle_placeWorkIdx (pre post : ℕ) (i : Fin n) : + placeWorkInMiddle pre n (placeWorkIdx pre post i) := by + unfold placeWorkInMiddle + simp only [placeWorkIdx_val] + exact ⟨by omega, by omega⟩ + +@[simp] theorem placeWorkCoord_placeWorkIdx (pre post : ℕ) (i : Fin n) : + placeWorkCoord pre n (placeWorkIdx pre post i) + (placeWorkInMiddle_placeWorkIdx pre post i) = i := by + apply Fin.ext + simp [placeWorkCoord] + +theorem placeWorkIdx_placeWorkCoord (i : Fin (pre + n + post)) + (h : placeWorkInMiddle pre n i) : + placeWorkIdx pre post (placeWorkCoord pre n i h) = i := by + apply Fin.ext + unfold placeWorkInMiddle at h + simp [placeWorkIdx, placeWorkCoord] + omega + +theorem placeWorkIdx_injective (pre post : ℕ) : + Function.Injective (placeWorkIdx (n := n) pre post) := by + intro i j h + apply Fin.ext + have := congrArg Fin.val h + simp only [placeWorkIdx_val] at this + omega + +/-- Place `tm` after `pre` reserved work tapes and before `post` reserved work +tapes. Physical tapes in the middle block simulate `tm`; every other work tape +writes back the symbol it reads and idles. Input and output actions are unchanged. -/ +def placeWorkTM (pre post : ℕ) (tm : TM n) : TM (pre + n + post) where + Q := tm.Q + qstart := tm.qstart + qhalt := tm.qhalt + δ := fun q iHead wHeads oHead => + let r := tm.δ q iHead (fun i => wHeads (placeWorkIdx pre post i)) oHead + (r.1, + fun i => + if h : placeWorkInMiddle pre n i then r.2.1 (placeWorkCoord pre n i h) + else readBackWrite (wHeads i), + r.2.2.1, + r.2.2.2.1, + fun i => + if h : placeWorkInMiddle pre n i then r.2.2.2.2.1 (placeWorkCoord pre n i h) + else idleDir (wHeads i), + r.2.2.2.2.2) + δ_right_of_start := by + intro q iHead wHeads oHead + obtain ⟨hin, hwork, hout⟩ := + tm.δ_right_of_start q iHead (fun i => wHeads (placeWorkIdx pre post i)) oHead + refine ⟨hin, fun i hi => ?_, hout⟩ + dsimp only + split + · rename_i hmid + apply hwork (placeWorkCoord pre n i hmid) + rw [placeWorkIdx_placeWorkCoord i hmid] + exact hi + · exact idleDir_right_of_start hi + +/-- Embed `c` into the placed layout. The supplied physical `extras` frame is +used outside the middle block and ignored inside it. -/ +def placeWorkCfg (tm : TM n) (pre post : ℕ) + (extras : Fin (pre + n + post) → Tape) (c : Cfg n tm.Q) : + Cfg (pre + n + post) (placeWorkTM pre post tm).Q where + state := c.state + input := c.input + work := fun i => + if h : placeWorkInMiddle pre n i then c.work (placeWorkCoord pre n i h) + else extras i + output := c.output + +/-- Apply the placement machine's idle work-tape action to an extra-tape frame. +Only values outside the middle block are observable through `placeWorkCfg`. -/ +def placeWorkFrameStep {pre n post : ℕ} + (extras : Fin (pre + n + post) → Tape) : Fin (pre + n + post) → Tape := + fun i => (extras i).writeAndMove (readBackWrite (extras i).read) + (idleDir (extras i).read) + +/-- Canonical embedding whose prefix and suffix tapes are parked and blank. -/ +def placeWorkParkedCfg (tm : TM n) (pre post : ℕ) (c : Cfg n tm.Q) : + Cfg (pre + n + post) (placeWorkTM pre post tm).Q := + placeWorkCfg tm pre post (fun _ => (Tape.init []).move Dir3.right) c + +@[simp] theorem placeWorkCfg_state (tm : TM n) (pre post : ℕ) + (extras : Fin (pre + n + post) → Tape) (c : Cfg n tm.Q) : + (placeWorkCfg tm pre post extras c).state = c.state := rfl + +@[simp] theorem placeWorkCfg_input (tm : TM n) (pre post : ℕ) + (extras : Fin (pre + n + post) → Tape) (c : Cfg n tm.Q) : + (placeWorkCfg tm pre post extras c).input = c.input := rfl + +@[simp] theorem placeWorkCfg_output (tm : TM n) (pre post : ℕ) + (extras : Fin (pre + n + post) → Tape) (c : Cfg n tm.Q) : + (placeWorkCfg tm pre post extras c).output = c.output := rfl + +@[simp] theorem placeWorkCfg_work_middle (tm : TM n) (pre post : ℕ) + (extras : Fin (pre + n + post) → Tape) (c : Cfg n tm.Q) (i : Fin n) : + (placeWorkCfg tm pre post extras c).work (placeWorkIdx pre post i) = c.work i := by + simp only [placeWorkCfg, placeWorkInMiddle_placeWorkIdx, dite_true] + rw [placeWorkCoord_placeWorkIdx] + +theorem placeWorkCfg_work_extra (tm : TM n) (pre post : ℕ) + (extras : Fin (pre + n + post) → Tape) (c : Cfg n tm.Q) + (i : Fin (pre + n + post)) (h : ¬placeWorkInMiddle pre n i) : + (placeWorkCfg tm pre post extras c).work i = extras i := by + simp [placeWorkCfg, h] + +theorem placeWorkCfg_work_prefix (tm : TM n) (pre post : ℕ) + (extras : Fin (pre + n + post) → Tape) (c : Cfg n tm.Q) (i : Fin pre) : + (placeWorkCfg tm pre post extras c).work ⟨i.val, by omega⟩ = + extras ⟨i.val, by omega⟩ := by + apply placeWorkCfg_work_extra + simp [placeWorkInMiddle] + +theorem placeWorkCfg_work_suffix (tm : TM n) (pre post : ℕ) + (extras : Fin (pre + n + post) → Tape) (c : Cfg n tm.Q) (i : Fin post) : + (placeWorkCfg tm pre post extras c).work ⟨pre + n + i.val, by omega⟩ = + extras ⟨pre + n + i.val, by omega⟩ := by + apply placeWorkCfg_work_extra + simp [placeWorkInMiddle] + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Placement/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Placement/Internal.lean new file mode 100644 index 0000000000..d22a843397 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Placement/Internal.lean @@ -0,0 +1,211 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Placement.Defs + +/-! +# Work-tape placement correctness internals + +This file proves exact step and bounded-reachability commutation for +`TM.placeWorkTM`. The strongest one-step theorem evolves an arbitrary physical +extra-tape frame by its prescribed idle action. Stable frames and the canonical +parked frame are fixed points of that action. +-/ + + +public section + +namespace Complexity + +namespace TM + +variable {n pre post : ℕ} + +/-- The idle extra-tape action is the identity away from the left-end marker. -/ +private theorem placeWorkFrameStep_eq_self_of_read_ne_start (t : Tape) + (hread : t.read ≠ Γ.start) : + t.writeAndMove (readBackWrite t.read) (idleDir t.read) = t := by + rw [writeAndMove_readBack t hread] + simp [idleDir, hread, Tape.move] + +/-- A blank tape at head zero or one is sent to the canonical parked blank tape. -/ +private theorem placeWorkFrameStep_blank (t : Tape) + (hcells : t.cells = (Tape.init []).cells) (hhead : t.head ≤ 1) : + t.writeAndMove (readBackWrite t.read) (idleDir t.read) = + (Tape.init []).move Dir3.right := by + have hread : t.read = (Tape.init []).cells t.head := by rw [Tape.read, hcells] + rcases Nat.le_one_iff_eq_zero_or_eq_one.mp hhead with h0 | h1 + · have ht : t = Tape.init [] := Tape.ext h0 hcells + subst ht + rfl + · have hr : t.read = Γ.blank := by rw [hread, h1]; rfl + rw [hr] + show t.write (readBackWrite Γ.blank) = (Tape.init []).move Dir3.right + rw [Tape.write, if_neg (show ¬t.head = 0 by omega), h1, hcells] + rw [show (readBackWrite Γ.blank).toΓ = (Tape.init []).cells 1 from rfl, + Function.update_eq_self] + rfl + +/-- Exact one-step commutation with an arbitrary extra-tape frame. The source +machine takes one step while every physical extra tape takes its idle action. -/ +theorem placeWorkTM_step_placeWorkCfg_internal (tm : TM n) (pre post : ℕ) + (extras : Fin (pre + n + post) → Tape) (c : Cfg n tm.Q) : + (placeWorkTM pre post tm).step (placeWorkCfg tm pre post extras c) = + (tm.step c).map + (placeWorkCfg tm pre post (placeWorkFrameStep extras)) := by + by_cases hhalt : c.state = tm.qhalt + · simp [TM.step, placeWorkCfg, placeWorkTM, hhalt] + · cases hstep : tm.step c with + | none => exact absurd hstep (by simp [TM.step, hhalt]) + | some c' => + simp only [TM.step, hhalt, ↓reduceIte, Option.some.injEq] at hstep + subst hstep + have hreads : + (fun i : Fin n => + ((placeWorkCfg tm pre post extras c).work (placeWorkIdx pre post i)).read) = + (fun i => (c.work i).read) := by + funext i + rw [placeWorkCfg_work_middle] + simp only [TM.step, Option.map_some, + show (placeWorkCfg tm pre post extras c).state = c.state from rfl, + show (placeWorkTM pre post tm).qhalt = tm.qhalt from rfl] + split + · rename_i heq + exact (hhalt heq).elim + · dsimp only [placeWorkTM] + rw [placeWorkCfg_input, placeWorkCfg_output, hreads] + refine congrArg some + (Cfg.mk.injEq _ _ _ _ _ _ _ _ |>.mpr ⟨rfl, rfl, ?_, rfl⟩) + funext i + by_cases hmid : placeWorkInMiddle pre n i + · simp only [hmid, ↓reduceDIte, placeWorkCfg] + · simp only [hmid, ↓reduceDIte, placeWorkCfg, placeWorkFrameStep] + +/-- If every observable extra tape is off the left-end marker, the extra frame +is fixed and one placed step commutes through the same embedding. -/ +theorem placeWorkTM_step_placeWorkCfg_stable_internal (tm : TM n) (pre post : ℕ) + (extras : Fin (pre + n + post) → Tape) (c : Cfg n tm.Q) + (hextra : ∀ i, ¬placeWorkInMiddle pre n i → (extras i).read ≠ Γ.start) : + (placeWorkTM pre post tm).step (placeWorkCfg tm pre post extras c) = + (tm.step c).map (placeWorkCfg tm pre post extras) := by + rw [placeWorkTM_step_placeWorkCfg_internal] + cases hstep : tm.step c with + | none => rfl + | some c' => + simp only [Option.map_some] + refine congrArg some + (Cfg.mk.injEq _ _ _ _ _ _ _ _ |>.mpr ⟨rfl, rfl, ?_, rfl⟩) + funext i + by_cases hmid : placeWorkInMiddle pre n i + · simp only [hmid, ↓reduceDIte] + · simp only [hmid, ↓reduceDIte] + exact placeWorkFrameStep_eq_self_of_read_ne_start _ (hextra i hmid) + +/-- Bounded reachability commutes exactly while a stable arbitrary frame is +preserved around the source work tapes. -/ +theorem placeWorkTM_reachesIn_placeWorkCfg_stable_internal (tm : TM n) + (pre post : ℕ) (extras : Fin (pre + n + post) → Tape) + {t : ℕ} {c c' : Cfg n tm.Q} (hreach : tm.reachesIn t c c') + (hextra : ∀ i, ¬placeWorkInMiddle pre n i → (extras i).read ≠ Γ.start) : + (placeWorkTM pre post tm).reachesIn t + (placeWorkCfg tm pre post extras c) + (placeWorkCfg tm pre post extras c') := by + induction hreach with + | zero => exact .zero + | step hstep _ ih => + exact .step (by + rw [placeWorkTM_step_placeWorkCfg_stable_internal tm pre post extras _ hextra, + hstep] + rfl) ih + +/-- The canonical parked frame is fixed by a placed source step. -/ +theorem placeWorkTM_step_placeWorkParkedCfg_internal (tm : TM n) (pre post : ℕ) + (c : Cfg n tm.Q) : + (placeWorkTM pre post tm).step (placeWorkParkedCfg tm pre post c) = + (tm.step c).map (placeWorkParkedCfg tm pre post) := by + apply placeWorkTM_step_placeWorkCfg_stable_internal + intro i _ + decide + +/-- Bounded reachability commutes through the canonical parked embedding. -/ +theorem placeWorkTM_reachesIn_placeWorkParkedCfg_internal (tm : TM n) + (pre post : ℕ) {t : ℕ} {c c' : Cfg n tm.Q} + (hreach : tm.reachesIn t c c') : + (placeWorkTM pre post tm).reachesIn t + (placeWorkParkedCfg tm pre post c) + (placeWorkParkedCfg tm pre post c') := by + apply placeWorkTM_reachesIn_placeWorkCfg_stable_internal tm pre post _ hreach + intro i _ + decide + +/-- The first placed step from the ordinary initial configuration performs the +source machine's first step and parks every surrounding blank tape. -/ +theorem placeWorkTM_step_initCfg_internal (tm : TM n) (pre post : ℕ) + (x : List Bool) : + (placeWorkTM pre post tm).step ((placeWorkTM pre post tm).initCfg x) = + (tm.step (tm.initCfg x)).map (placeWorkParkedCfg tm pre post) := by + let initialExtras : Fin (pre + n + post) → Tape := fun _ => Tape.init [] + have hcfg : (placeWorkTM pre post tm).initCfg x = + placeWorkCfg tm pre post initialExtras (tm.initCfg x) := by + refine Cfg.mk.injEq _ _ _ _ _ _ _ _ |>.mpr ⟨rfl, rfl, ?_, rfl⟩ + funext i + by_cases hmid : placeWorkInMiddle pre n i + · simp only [hmid, ↓reduceDIte] + · simp only [hmid, ↓reduceDIte, initialExtras] + rw [hcfg, placeWorkTM_step_placeWorkCfg_internal] + cases hstep : tm.step (tm.initCfg x) with + | none => rfl + | some c => + simp only [Option.map_some] + refine congrArg some + (Cfg.mk.injEq _ _ _ _ _ _ _ _ |>.mpr ⟨rfl, rfl, ?_, rfl⟩) + funext i + by_cases hmid : placeWorkInMiddle pre n i + · simp only [hmid, ↓reduceDIte] + · simp only [hmid, ↓reduceDIte] + exact placeWorkFrameStep_blank _ rfl (Nat.zero_le 1) + +/-- Simulation from an ordinary initial configuration. At time zero the placed +configuration is its ordinary initial configuration; every positive run ends +in the canonical parked embedding of the source configuration. -/ +theorem placeWorkTM_reachesIn_init_internal (tm : TM n) (pre post : ℕ) + (x : List Bool) {t : ℕ} {c' : Cfg n tm.Q} + (hreach : tm.reachesIn t (tm.initCfg x) c') : + ∃ C' : Cfg (pre + n + post) (placeWorkTM pre post tm).Q, + (placeWorkTM pre post tm).reachesIn t ((placeWorkTM pre post tm).initCfg x) C' ∧ + C'.state = c'.state ∧ C'.input = c'.input ∧ C'.output = c'.output ∧ + (t = 0 ∨ C' = placeWorkParkedCfg tm pre post c') := by + cases hreach with + | zero => + exact ⟨(placeWorkTM pre post tm).initCfg x, .zero, rfl, rfl, rfl, Or.inl rfl⟩ + | @step _ cMid _ _ hstep hrest => + refine ⟨placeWorkParkedCfg tm pre post c', .step (c'' := + placeWorkParkedCfg tm pre post cMid) ?_ ?_, rfl, rfl, rfl, Or.inr rfl⟩ + · rw [placeWorkTM_step_initCfg_internal, hstep] + rfl + · exact placeWorkTM_reachesIn_placeWorkParkedCfg_internal tm pre post hrest + +/-- Work-tape placement preserves deterministic function computation with the +same time bound. -/ +theorem placeWorkTM_computesInTime_internal (tm : TM n) (pre post : ℕ) + {f : List Bool → List Bool} {T : ℕ → ℕ} + (hcomp : tm.ComputesInTime f T) : + (placeWorkTM pre post tm).ComputesInTime f T := by + intro x + obtain ⟨c', t, ht, hreach, hhalt, hout⟩ := hcomp x + obtain ⟨C', hreach', hstate, _hinput, houtput, _hshape⟩ := + placeWorkTM_reachesIn_init_internal tm pre post x hreach + refine ⟨C', t, ht, hreach', ?_, ?_⟩ + · show C'.state = (placeWorkTM pre post tm).qhalt + rw [hstate] + exact hhalt + · rw [houtput] + exact hout + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Registers.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Registers.lean new file mode 100644 index 0000000000..95e5a25818 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Registers.lean @@ -0,0 +1,235 @@ +/- +Copyright (c) 2025 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.Counter + +/-! +# Unary registers + +A *register* is a work tape holding a natural number in unary: cells `1..v` +hold `1`, everything beyond is blank, and the head is parked at cell 1. All +arithmetic in the Cook–Levin reduction emitter (`docs/A5-ReductionEmitter.md`) +is over registers — the CNF encoding is unary, so no binary arithmetic is +ever needed. + +`IsReg` strengthens `Tape.HasUnaryCounter` with the cell-0 sentinel and +all-blanks-beyond, making registers literally preserved by parked no-op +actions and stable under the combinator phase transitions. + +## Main definitions + +- `TM.Parked` — a tape whose head is off `▷` and which has no spurious `▷`s +- `TM.IsReg` — the register predicate + +## Main results + +- `TM.IsReg.parked`, `TM.IsReg.hasUnaryCounter` — bridges +- `TM.reg_zero_init_bumped` — a freshly bumped blank tape is `IsReg 0` +-/ + + +@[expose] public section + +namespace Complexity + +namespace TM + +-- ════════════════════════════════════════════════════════════════════════ +-- Parked tapes +-- ════════════════════════════════════════════════════════════════════════ + +/-- A tape parked for preservation: head off `▷` (so `idleDir` stays put and + `δ_right_of_start` is moot) and no `▷` outside cell 0 (so `readBackWrite` + writes back the read symbol verbatim). Machines that do not use a tape + keep it parked and literally unchanged. -/ +def Parked (t : Tape) : Prop := + 1 ≤ t.head ∧ ∀ j, 1 ≤ j → t.cells j ≠ Γ.start + +/-- A parked tape never reads the start symbol `▷`. -/ +theorem Parked.read_ne_start {t : Tape} (h : Parked t) : t.read ≠ Γ.start := + h.2 t.head h.1 + +/-- A parked tape is untouched by the no-op action `writeAndMove (readBackWrite + read) (idleDir read)`. -/ +theorem Parked.writeAndMove_readBack_idle {t : Tape} (h : Parked t) : + t.writeAndMove (readBackWrite t.read) (idleDir t.read) = t := + Tape.writeAndMove_readBack_idle_of_ne_start t h.read_ne_start + +/-- A parked tape's head does not move under `idleDir`. -/ +theorem Parked.move_idle {t : Tape} (h : Parked t) : + t.move (idleDir t.read) = t := by + rw [idleDir, if_neg h.read_ne_start] + rfl + +/-- Parked tapes pass through combinator phase boundaries unchanged. -/ +theorem Parked.transitionTape_eq_self {t : Tape} (h : Parked t) : transitionTape t = t := + TM.transitionTape_eq_self h.read_ne_start + +/-- Parked input tapes pass through combinator phase boundaries unchanged. -/ +theorem Parked.transitionInput_eq_self {t : Tape} (h : Parked t) : transitionInput t = t := + TM.transitionInput_eq_self h.read_ne_start + +-- ════════════════════════════════════════════════════════════════════════ +-- Registers +-- ════════════════════════════════════════════════════════════════════════ + +/-- **Register.** The tape holds `v` in unary: `▷` at cell 0, `1` at cells + `1..v`, blank everywhere beyond, head parked at cell 1. -/ +def IsReg (v : ℕ) (t : Tape) : Prop := + t.head = 1 ∧ + t.cells 0 = Γ.start ∧ + (∀ i, i < v → t.cells (i + 1) = Γ.one) ∧ + (∀ j, v + 1 ≤ j → t.cells j = Γ.blank) + +namespace IsReg + +/-- A register tape's head is parked at cell 1. -/ +theorem head_eq {v : ℕ} {t : Tape} (h : IsReg v t) : t.head = 1 := h.1 + +/-- A register tape's cell 0 holds the sentinel `▷`. -/ +theorem cell0 {v : ℕ} {t : Tape} (h : IsReg v t) : t.cells 0 = Γ.start := h.2.1 + +/-- Cells `1..v` of a register holding `v` contain `1`. -/ +theorem cells_one {v : ℕ} {t : Tape} (h : IsReg v t) {i : ℕ} (hi : i < v) : + t.cells (i + 1) = Γ.one := h.2.2.1 i hi + +/-- Cells beyond position `v` of a register holding `v` are blank. -/ +theorem cells_blank {v : ℕ} {t : Tape} (h : IsReg v t) {j : ℕ} (hj : v + 1 ≤ j) : + t.cells j = Γ.blank := h.2.2.2 j hj + +/-- Register cells off the sentinel are `1` or blank — never `▷`. -/ +theorem cells_ne_start {v : ℕ} {t : Tape} (h : IsReg v t) {j : ℕ} (hj : 1 ≤ j) : + t.cells j ≠ Γ.start := by + rcases Nat.lt_or_ge j (v + 1) with hlt | hge + · obtain ⟨i, rfl⟩ : ∃ i, j = i + 1 := ⟨j - 1, by omega⟩ + rw [h.cells_one (by omega)]; decide + · rw [h.cells_blank hge]; decide + +/-- A register tape is parked. -/ +theorem parked {v : ℕ} {t : Tape} (h : IsReg v t) : Parked t := + ⟨by rw [h.head_eq], fun _ hj => h.cells_ne_start hj⟩ + +/-- A register is a unary counter (the weaker shape used by the counter + subroutines). -/ +theorem hasUnaryCounter {v : ℕ} {t : Tape} (h : IsReg v t) : + t.HasUnaryCounter v := + ⟨h.head_eq, fun _ hi => h.cells_one hi, h.cells_blank (le_refl _)⟩ + +/-- The register's read: `1` when nonempty, blank when zero. -/ +theorem read_eq {v : ℕ} {t : Tape} (h : IsReg v t) : + t.read = if v = 0 then Γ.blank else Γ.one := by + rw [Tape.read, h.head_eq] + rcases Nat.eq_zero_or_pos v with rfl | hv + · rw [if_pos rfl]; exact h.cells_blank (le_refl _) + · rw [if_neg (by omega)]; exact h.cells_one hv + +end IsReg + +/-- A blank tape with the head bumped to cell 1 is the zero register. -/ +theorem reg_zero_init_bumped : IsReg 0 { head := 1, cells := (Tape.init []).cells } := by + refine ⟨rfl, by simp [Tape.init], fun _ hi => by omega, fun j hj => ?_⟩ + show (Tape.init []).cells j = Γ.blank + simp only [Tape.init] + rw [if_neg (by omega : ¬ j = 0)] + simp + +-- ════════════════════════════════════════════════════════════════════════ +-- The canonical register tape +-- ════════════════════════════════════════════════════════════════════════ + +/-- Canonical register cells holding `v` in unary. -/ +def regCells (v : ℕ) : ℕ → Γ := fun j => + if j = 0 then Γ.start else if j ≤ v then Γ.one else Γ.blank + +/-- The canonical register tape holding `v`. -/ +def regTape (v : ℕ) : Tape := ⟨1, regCells v⟩ + +/-- The canonical register tape's head sits at cell 1. -/ +@[simp] theorem regT_head (v : ℕ) : (regTape v).head = 1 := rfl + +/-- The canonical register tape's cells are `regCells v`. -/ +@[simp] theorem regT_cells (v : ℕ) : (regTape v).cells = regCells v := rfl + +/-- Cell 0 of the canonical register cells is the sentinel `▷`. -/ +@[simp] theorem regCells_zero (v : ℕ) : regCells v 0 = Γ.start := rfl + +/-- Cells `1..v` of the canonical register cells for `v` hold `1`. -/ +theorem regCells_one {v j : ℕ} (h1 : 1 ≤ j) (h2 : j ≤ v) : regCells v j = Γ.one := by + rw [regCells, if_neg (by omega), if_pos h2] + +/-- Cells beyond position `v` of the canonical register cells for `v` are blank. -/ +theorem regCells_blank {v j : ℕ} (h : v + 1 ≤ j) : regCells v j = Γ.blank := by + rw [regCells, if_neg (by omega), if_neg (by omega)] + +/-- Register cells away from the sentinel are never `▷`. -/ +theorem regCells_ne_start {v j : ℕ} (hj : 1 ≤ j) : + regCells v j ≠ Γ.start := by + rw [regCells, if_neg (by omega)] + split <;> decide + +/-- The canonical register tape `regTape v` satisfies `IsReg v`. -/ +theorem reg_regT (v : ℕ) : IsReg v (regTape v) := + ⟨rfl, rfl, fun _ hi => by rw [regT_cells]; exact regCells_one (by omega) (by omega), + fun _ hj => by rw [regT_cells]; exact regCells_blank hj⟩ + +/-- **A register's tape is canonical**: the `IsReg` predicate pins every cell and + the head, so it is an equation. -/ +theorem IsReg.eq_regT {v : ℕ} {t : Tape} (h : IsReg v t) : t = regTape v := by + refine Tape.ext h.head_eq ?_ + funext j + rcases Nat.eq_zero_or_pos j with rfl | hj + · rw [h.cell0]; rfl + · rcases Nat.lt_or_ge v j with hlt | hge + · rw [h.cells_blank (by omega), regT_cells] + exact (regCells_blank (by omega)).symm + · obtain ⟨i, rfl⟩ : ∃ i, j = i + 1 := ⟨j - 1, by omega⟩ + rw [h.cells_one (by omega), regT_cells] + exact (regCells_one (by omega) (by omega)).symm + +/-- The canonical register tape is parked. -/ +theorem parked_regTape (v : ℕ) : Parked (regTape v) := (reg_regT v).parked + +/-- Register cells with the head anywhere off `▷` form a parked tape. -/ +theorem parked_regCells {h v : ℕ} (hh : 1 ≤ h) : + Parked (⟨h, regCells v⟩ : Tape) := by + exact ⟨hh, fun _ hj => regCells_ne_start hj⟩ + +/-- Writing the next mark turns `regCells d` into `regCells (d + 1)`. -/ +theorem regCells_update_succ (d : ℕ) : + Function.update (regCells d) (d + 1) Γ.one = regCells (d + 1) := by + funext j + rw [Function.update_apply] + split + · next h => + subst h + exact (regCells_one (by omega) (by omega)).symm + · next h => + rcases Nat.eq_zero_or_pos j with rfl | hj + · rfl + · rcases Nat.lt_or_ge d j with hlt | hge + · rw [regCells_blank (by omega), regCells_blank (by omega)] + · rw [regCells_one (by omega) (by omega), regCells_one (by omega) (by omega)] + +/-- Erasing the final mark turns `regCells (d + 1)` into `regCells d`. -/ +theorem regCells_update_blank_succ (d : ℕ) : + Function.update (regCells (d + 1)) (d + 1) Γ.blank = regCells d := by + funext j + rw [Function.update_apply] + split + · next hj => + subst hj + exact (regCells_blank (by omega)).symm + · next hj => + rcases Nat.eq_zero_or_pos j with rfl | hj1 + · rfl + · rcases Nat.lt_or_ge d j with hlt | hge + · rw [regCells_blank (by omega), regCells_blank (by omega)] + · rw [regCells_one (by omega) (by omega), regCells_one (by omega) (by omega)] + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Registers/Arith.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Registers/Arith.lean new file mode 100644 index 0000000000..4e51680472 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Registers/Arith.lean @@ -0,0 +1,290 @@ +/- +Copyright (c) 2025 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Registers.ForReg +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Registers.RegisterOps + +/-! +# Derived register arithmetic + +Addition, copying, and multiply-accumulate over unary registers, composed from +`forRegTM`, `incRegTM`, and `clearRegTM` — no new hand-rolled machines. Each +spec is one application of `forRegTM_hoareTime` with an iteration-indexed +ghost family, plus `Function.update` bookkeeping. + +Time bounds are deliberately loose (rounded up via `HoareTime.mono_bound`); +only their polynomial shape matters downstream. +-/ + + +@[expose] public section + +namespace Complexity + +namespace TM + +variable {n : ℕ} + +/-- `dst += src` (repeat-increment, fueled by `src`). -/ +def addIntoTM (src dst : Fin n) : TM n := forRegTM (incRegTM dst) src + +/-- **`addIntoTM` Hoare specification.** From `regTape a` in `src` and `regTape b` in + `dst`, reach `regTape (b + a)` in `dst`; `src` and everything else untouched. -/ +theorem addIntoTM_hoareTime (src dst : Fin n) (hne : src ≠ dst) (a b : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (ys : List Bool) + (hinp₀ : Parked inp₀) (hwork₀ : ∀ i, i ≠ src → Parked (work₀ i)) + (hsrc : work₀ src = regTape a) (hdst : work₀ dst = regTape b) : + (addIntoTM src dst).HoareTime + (EmitPred inp₀ work₀ ys) + (EmitPred inp₀ (Function.update work₀ dst (regTape (b + a))) ys) + (a * ((2 * (b + a) + 4) + 2) + (a + 2)) := by + have hbody : ∀ i, i < a → (incRegTM dst).HoareTime + (fun inp work out => inp = inp₀ ∧ + work = Function.update (Function.update work₀ dst (regTape (b + i))) src + ⟨i + 2, regCells a⟩ ∧ OutAcc ys out) + (fun inp work out => inp = inp₀ ∧ + work = Function.update (Function.update work₀ dst (regTape (b + (i + 1)))) src + ⟨i + 2, regCells a⟩ ∧ OutAcc ys out) + (2 * (b + a) + 4) := by + intro i hi + have hspec := incRegTM_hoareTime dst (b + i) inp₀ + (Function.update (Function.update work₀ dst (regTape (b + i))) src + ⟨i + 2, regCells a⟩) ys hinp₀ + (fun j hj => by + by_cases hjs : j = src + · subst hjs + rw [Function.update_self] + exact parked_regCells (by omega) + · rw [Function.update_of_ne hjs] + by_cases hjd : j = dst + · subst hjd + rw [Function.update_self] + exact parked_regTape _ + · rw [Function.update_of_ne hjd] + exact hwork₀ j hjs) + (by + rw [Function.update_of_ne (fun h => hne h.symm), Function.update_self]) + have hfun : Function.update + (Function.update (Function.update work₀ dst (regTape (b + i))) src + ⟨i + 2, regCells a⟩) dst (regTape (b + i + 1)) + = Function.update (Function.update work₀ dst (regTape (b + (i + 1)))) src + ⟨i + 2, regCells a⟩ := by + rw [Function.update_comm hne, Function.update_idem] + rfl + refine (hspec.consequence (fun inp work out h => h) ?_ ?_) + · rintro inp work out ⟨h1, h2, h3⟩ + exact ⟨h1, by rw [h2, hfun], h3⟩ + · omega + have hrule := forRegTM_hoareTime (incRegTM dst) src a inp₀ + (fun i => Function.update work₀ dst (regTape (b + i))) (fun _ => ys) + (2 * (b + a) + 4) hinp₀ + (fun i => by + show Function.update work₀ dst (regTape (b + i)) src = regTape a + rw [Function.update_of_ne hne] + exact hsrc) + (fun i j hj => by + show Parked (Function.update work₀ dst (regTape (b + i)) j) + by_cases hjd : j = dst + · subst hjd + rw [Function.update_self] + exact parked_regTape _ + · rw [Function.update_of_ne hjd] + exact hwork₀ j hj) + hbody + have hw0 : Function.update work₀ dst (regTape (b + 0)) = work₀ := by + rw [show regTape (b + 0) = work₀ dst from by rw [Nat.add_zero, hdst], + Function.update_eq_self] + exact hrule.weaken_pre (fun inp work out h => by + show EmitPred inp₀ (Function.update work₀ dst (regTape (b + 0))) ys inp work out + rw [hw0] + exact h) + +/-- `dst := src` (clear then add). -/ +def copyIntoTM (src dst : Fin n) : TM n := seqTM (clearRegTM dst) (addIntoTM src dst) + +/-- **`copyIntoTM` Hoare specification.** -/ +theorem copyIntoTM_hoareTime (src dst : Fin n) (hne : src ≠ dst) (a b : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (ys : List Bool) + (hinp₀ : Parked inp₀) (hwork₀ : ∀ i, i ≠ src → Parked (work₀ i)) + (hsrc : work₀ src = regTape a) (hdst : work₀ dst = regTape b) : + (copyIntoTM src dst).HoareTime + (EmitPred inp₀ work₀ ys) + (EmitPred inp₀ (Function.update work₀ dst (regTape a)) ys) + ((2 * b + 4) + 1 + (a * ((2 * (0 + a) + 4) + 2) + (a + 2))) := by + have hclear := clearRegTM_hoareTime dst b inp₀ work₀ ys hinp₀ + (fun i hi => by + by_cases his : i = src + · subst his; rw [hsrc]; exact parked_regTape _ + · exact hwork₀ i (fun h => his h)) hdst + have hadd := addIntoTM_hoareTime src dst hne a 0 inp₀ + (Function.update work₀ dst (regTape 0)) ys hinp₀ + (fun i hi => by + by_cases hid : i = dst + · subst hid; rw [Function.update_self]; exact parked_regTape _ + · rw [Function.update_of_ne hid]; exact hwork₀ i hi) + (by rw [Function.update_of_ne hne]; exact hsrc) + (by rw [Function.update_self]) + have hmidP : ∀ i, Parked (Function.update work₀ dst (regTape 0) i) := by + intro i + by_cases hid : i = dst + · subst hid; rw [Function.update_self]; exact parked_regTape _ + · rw [Function.update_of_ne hid] + by_cases his : i = src + · subst his; rw [hsrc]; exact parked_regTape _ + · exact hwork₀ i his + have hseq := seqTM_hoareTime (clearRegTM dst) (addIntoTM src dst) hclear + (emitPred_transition hinp₀ hmidP ys) hadd + refine hseq.strengthen_post ?_ + rintro inp work out ⟨h1, h2, h3⟩ + refine ⟨h1, ?_, h3⟩ + rw [h2, Function.update_idem, Nat.zero_add] + +/-- `dst += src₁ * src₂` (repeat-add, fueled by `src₁`). -/ +def mulAddIntoTM (src₁ src₂ dst : Fin n) : TM n := + forRegTM (addIntoTM src₂ dst) src₁ + +/-- The (loose) per-iteration budget of `mulAddIntoTM`. -/ +def mulAddBound (a b d : ℕ) : ℕ := b * ((2 * (d + a * b + b) + 4) + 2) + (b + 2) + +/-- **`mulAddIntoTM` Hoare specification.** From `regTape a`, `regTape b`, `regTape d` + in `src₁`, `src₂`, `dst`, reach `regTape (d + a·b)` in `dst`. -/ +theorem mulAddIntoTM_hoareTime (src₁ src₂ dst : Fin n) + (h12 : src₁ ≠ src₂) (h1d : src₁ ≠ dst) (h2d : src₂ ≠ dst) (a b d : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (ys : List Bool) + (hinp₀ : Parked inp₀) (hwork₀ : ∀ i, i ≠ src₁ → Parked (work₀ i)) + (h1 : work₀ src₁ = regTape a) (h2 : work₀ src₂ = regTape b) + (hd : work₀ dst = regTape d) : + (mulAddIntoTM src₁ src₂ dst).HoareTime + (EmitPred inp₀ work₀ ys) + (EmitPred inp₀ (Function.update work₀ dst (regTape (d + a * b))) ys) + (a * (mulAddBound a b d + 2) + (a + 2)) := by + have hbody : ∀ i, i < a → (addIntoTM src₂ dst).HoareTime + (fun inp work out => inp = inp₀ ∧ + work = Function.update (Function.update work₀ dst (regTape (d + i * b))) src₁ + ⟨i + 2, regCells a⟩ ∧ OutAcc ys out) + (fun inp work out => inp = inp₀ ∧ + work = Function.update (Function.update work₀ dst (regTape (d + (i + 1) * b))) + src₁ ⟨i + 2, regCells a⟩ ∧ OutAcc ys out) + (mulAddBound a b d) := by + intro i hi + have hspec := addIntoTM_hoareTime src₂ dst h2d b (d + i * b) inp₀ + (Function.update (Function.update work₀ dst (regTape (d + i * b))) src₁ + ⟨i + 2, regCells a⟩) ys hinp₀ + (fun j hj => by + by_cases hj1 : j = src₁ + · subst hj1 + rw [Function.update_self] + exact parked_regCells (by omega) + · rw [Function.update_of_ne hj1] + by_cases hjd : j = dst + · subst hjd + rw [Function.update_self] + exact parked_regTape _ + · rw [Function.update_of_ne hjd] + exact hwork₀ j hj1) + (by + rw [Function.update_of_ne (fun h => h12 h.symm), + Function.update_of_ne h2d] + exact h2) + (by + rw [Function.update_of_ne (fun h => h1d h.symm), Function.update_self]) + have hfun : Function.update + (Function.update (Function.update work₀ dst (regTape (d + i * b))) src₁ + ⟨i + 2, regCells a⟩) dst (regTape (d + i * b + b)) + = Function.update (Function.update work₀ dst (regTape (d + (i + 1) * b))) + src₁ ⟨i + 2, regCells a⟩ := by + rw [Function.update_comm h1d, Function.update_idem, + show d + i * b + b = d + (i + 1) * b from by rw [Nat.succ_mul]; omega] + have him : i * b ≤ a * b := Nat.mul_le_mul_right b (le_of_lt hi) + have hinner : (2 * (d + i * b + b) + 4) + 2 ≤ (2 * (d + a * b + b) + 4) + 2 := by + omega + have hbnd := Nat.mul_le_mul_left b hinner + refine hspec.consequence (fun _ _ _ h => h) ?_ ?_ + · rintro inp work out ⟨g1, g2, g3⟩ + exact ⟨g1, by rw [g2, hfun], g3⟩ + · show b * ((2 * (d + i * b + b) + 4) + 2) + (b + 2) ≤ mulAddBound a b d + rw [mulAddBound] + omega + have hrule := forRegTM_hoareTime (addIntoTM src₂ dst) src₁ a inp₀ + (fun i => Function.update work₀ dst (regTape (d + i * b))) (fun _ => ys) + (mulAddBound a b d) hinp₀ + (fun i => by + show Function.update work₀ dst (regTape (d + i * b)) src₁ = regTape a + rw [Function.update_of_ne h1d] + exact h1) + (fun i j hj => by + show Parked (Function.update work₀ dst (regTape (d + i * b)) j) + by_cases hjd : j = dst + · subst hjd + rw [Function.update_self] + exact parked_regTape _ + · rw [Function.update_of_ne hjd] + exact hwork₀ j hj) + hbody + have hw0 : Function.update work₀ dst (regTape (d + 0 * b)) = work₀ := by + rw [show regTape (d + 0 * b) = work₀ dst from by + rw [Nat.zero_mul, Nat.add_zero, hd], + Function.update_eq_self] + exact hrule.weaken_pre (fun inp work out h => by + show EmitPred inp₀ (Function.update work₀ dst (regTape (d + 0 * b))) ys inp work out + rw [hw0] + exact h) + +-- ════════════════════════════════════════════════════════════════════════ +-- Iterated machines (fixedValue-building) +-- ════════════════════════════════════════════════════════════════════════ + +/-- Run `m` in sequence `c` times. -/ +def iterTM (m : TM n) : ℕ → TM n + | 0 => skipTM + | c + 1 => seqTM m (iterTM m c) + +/-- **Iterated increment**: add the fixedValue `c` to register `q`. -/ +theorem iterTM_incRegTM_hoareTime (q : Fin n) (c : ℕ) : + ∀ (d : ℕ) (inp₀ : Tape) (work₀ : Fin n → Tape) (ys : List Bool), + Parked inp₀ → (∀ i, Parked (work₀ i)) → work₀ q = regTape d → + (iterTM (incRegTM q) c).HoareTime + (EmitPred inp₀ work₀ ys) + (EmitPred inp₀ (Function.update work₀ q (regTape (d + c))) ys) + (c * (2 * (d + c) + 5) + 1) := by + induction c with + | zero => + intro d inp₀ work₀ ys hinp₀ hwork₀ hq + have hskip := skipTM_hoareTime inp₀ work₀ ys hinp₀ hwork₀ + refine hskip.consequence (fun _ _ _ h => h) ?_ (by omega) + rintro inp work out ⟨g1, g2, g3⟩ + refine ⟨g1, ?_, g3⟩ + rw [g2, show regTape (d + 0) = work₀ q from by rw [Nat.add_zero, hq], + Function.update_eq_self] + | succ c ih => + intro d inp₀ work₀ ys hinp₀ hwork₀ hq + have hinc := incRegTM_hoareTime q d inp₀ work₀ ys hinp₀ + (fun i _ => hwork₀ i) hq + have hmidP : ∀ i, Parked (Function.update work₀ q (regTape (d + 1)) i) := by + intro i + by_cases hiq : i = q + · subst hiq; rw [Function.update_self]; exact parked_regTape _ + · rw [Function.update_of_ne hiq]; exact hwork₀ i + have hrest := ih (d + 1) inp₀ (Function.update work₀ q (regTape (d + 1))) ys + hinp₀ hmidP (by rw [Function.update_self]) + have hseq := seqTM_hoareTime (incRegTM q) (iterTM (incRegTM q) c) hinc + (emitPred_transition hinp₀ hmidP ys) hrest + refine hseq.consequence (fun _ _ _ h => h) ?_ ?_ + · rintro inp work out ⟨g1, g2, g3⟩ + refine ⟨g1, ?_, g3⟩ + rw [g2, Function.update_idem, + show d + 1 + c = d + (c + 1) from by omega] + · have hmul : (c + 1) * (2 * (d + (c + 1)) + 5) + = c * (2 * (d + (c + 1)) + 5) + (2 * (d + (c + 1)) + 5) := + Nat.succ_mul .. + have hmono : c * (2 * (d + 1 + c) + 5) ≤ c * (2 * (d + (c + 1)) + 5) := + Nat.mul_le_mul_left c (by omega) + omega + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Registers/Emit.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Registers/Emit.lean new file mode 100644 index 0000000000..d3ce04db04 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Registers/Emit.lean @@ -0,0 +1,878 @@ +/- +Copyright (c) 2025 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Registers +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Hoare + +/-! +# Output-emission subroutines + +Building blocks for machines that *compute string functions* (`ComputesInTime`): +the output tape is treated as an append-only accumulator, written left to +right. The central predicate `OutAcc ys out` says the output tape holds +exactly the bits `ys` (after the `▷` at cell 0) with the head parked on the +first blank, ready to append; emitters have Hoare specs of the shape + + {OutAcc ys ∧ …} emit {OutAcc (ys ++ w) ∧ …} + +which compose by `seqTM` along `List.append` associativity. The final bridge +to `ComputesInTime` is `OutAcc.hasOutput`. + +This layer is the foundation for the Cook–Levin reduction emitter +(`docs/A5-ReductionEmitter.md`). + +## Main definitions + +- `TM.OutAcc` — the output-accumulator predicate +- `TM.bumpTM` — entry adapter: bump every head from `▷` to cell 1 +- `TM.emitBitsTM` — append a fixed word to the output +- `TM.emitUnaryTM` — append a register's value as a doubled-unary run +- `TM.emitLitTM` — append one encoded literal (sign bits, unary body, terminator) + +## Main results + +- `TM.OutAcc.hasOutput` — accumulated output is `HasOutput` +- `TM.OutAcc.eq` — the accumulated word uniquely determines its output tape +- `TM.outAcc_append_bit` — one `writeAndMove _ .right` extends the accumulator +- `TM.emitBitsTM_reachesIn_frame` — exact emission with a complete input/work frame +- `TM.emitBitsTM_hoareTime` — `emitBitsTM w` appends `w` in `|w|` steps, + preserving the input and work tapes +- `TM.emitBitsTM_isTransducer` — fixed-word emission never moves output left +-/ + + +@[expose] public section + +namespace Complexity + +namespace TM + +variable {n : ℕ} + +-- ════════════════════════════════════════════════════════════════════════ +-- The output accumulator +-- ════════════════════════════════════════════════════════════════════════ + +/-- **Output accumulator.** The output tape holds exactly the bits `ys` + (cells `1..|ys|`, after the `▷` at cell 0), all cells beyond are blank, + and the head is parked on the first blank — ready to append. -/ +def OutAcc (ys : List Bool) (out : Tape) : Prop := + out.head = ys.length + 1 ∧ + out.cells 0 = Γ.start ∧ + (∀ i, (h : i < ys.length) → out.cells (i + 1) = Γ.ofBool ys[i]) ∧ + (∀ j, ys.length + 1 ≤ j → out.cells j = Γ.blank) + +namespace OutAcc + +/-- The accumulator head sits just past the `|ys|` stored bits, at cell `|ys| + 1`. -/ +theorem head_eq {ys : List Bool} {out : Tape} (h : OutAcc ys out) : + out.head = ys.length + 1 := h.1 + +/-- The accumulator reads the first blank. -/ +theorem read_blank {ys : List Bool} {out : Tape} (h : OutAcc ys out) : + out.read = Γ.blank := by + rw [Tape.read, h.1]; exact h.2.2.2 _ (le_refl _) + +/-- An accumulator tape is parked (bits and blanks are never `▷`). -/ +theorem parked {ys : List Bool} {out : Tape} (h : OutAcc ys out) : Parked out := by + refine ⟨by rw [h.1]; omega, fun j hj => ?_⟩ + rcases Nat.lt_or_ge j (ys.length + 1) with hlt | hge + · obtain ⟨i, rfl⟩ : ∃ i, j = i + 1 := ⟨j - 1, by omega⟩ + rw [h.2.2.1 i (by omega)] + cases ys[i] <;> decide + · rw [h.2.2.2 j hge]; decide + +/-- The bridge to `ComputesInTime`: an accumulated output `HasOutput` its bits. -/ +theorem hasOutput {ys : List Bool} {out : Tape} (h : OutAcc ys out) : + out.HasOutput ys := + ⟨fun i hi => h.2.2.1 i hi, h.2.2.2 _ (le_refl _)⟩ + +/-- An output accumulator is uniquely determined by its accumulated word. -/ +theorem eq {ys : List Bool} {first second : Tape} + (hfirst : OutAcc ys first) (hsecond : OutAcc ys second) : + first = second := by + apply Tape.ext + · rw [hfirst.1, hsecond.1] + · funext j + by_cases hj0 : j = 0 + · subst j + rw [hfirst.2.1, hsecond.2.1] + · by_cases hj : j ≤ ys.length + · obtain ⟨i, hi, rfl⟩ : ∃ i, i < ys.length ∧ j = i + 1 := by + refine ⟨j - 1, by omega, by omega⟩ + rw [hfirst.2.2.1 i hi, hsecond.2.2.1 i hi] + · rw [hfirst.2.2.2 j (by omega), hsecond.2.2.2 j (by omega)] + +end OutAcc + +/-- The empty accumulator: a blank output tape with the head bumped to cell 1. -/ +theorem outAcc_nil_init : OutAcc [] { head := 1, cells := (Tape.init []).cells } := by + refine ⟨rfl, by simp [Tape.init], fun i hi => absurd hi (by simp), fun j hj => ?_⟩ + show (Tape.init []).cells j = Γ.blank + simp only [Tape.init] + rw [if_neg (by omega : ¬ j = 0)] + simp + +/-- **Appending one bit.** Writing `Γ.ofBool b` at the accumulator head and + moving right extends the accumulator by `b`. -/ +theorem outAcc_append_bit {ys : List Bool} {out : Tape} (h : OutAcc ys out) (b : Bool) : + OutAcc (ys ++ [b]) (out.writeAndMove (Γ.ofBool b) .right) := by + obtain ⟨hhead, hc0, hbits, hblank⟩ := h + have hne : ¬ out.head = 0 := by omega + have hcells : (out.writeAndMove (Γ.ofBool b) .right).cells + = Function.update out.cells (ys.length + 1) (Γ.ofBool b) := by + show ((out.write _).move _).cells = _ + rw [Tape.move] + show (out.write _).cells = _ + rw [Tape.write, if_neg hne, hhead] + have hhead' : (out.writeAndMove (Γ.ofBool b) .right).head = out.head + 1 := by + show ((out.write _).move _).head = _ + rw [Tape.move] + show (out.write _).head + 1 = _ + rw [Tape.write, if_neg hne] + refine ⟨?_, ?_, ?_, ?_⟩ + · rw [hhead', hhead]; simp + · rw [hcells, Function.update_of_ne (by omega : ¬ (0 : ℕ) = ys.length + 1)] + exact hc0 + · intro i hi + rw [List.length_append, List.length_cons, List.length_nil] at hi + rcases Nat.lt_or_ge i ys.length with hlt | hge + · rw [hcells, Function.update_of_ne (by omega : ¬ i + 1 = ys.length + 1), + List.getElem_append_left hlt] + exact hbits i hlt + · obtain rfl : i = ys.length := by omega + rw [hcells, Function.update_self, + List.getElem_append_right (le_refl _)] + simp + · intro j hj + rw [List.length_append, List.length_cons, List.length_nil] at hj + rw [hcells, Function.update_of_ne (by omega : ¬ j = ys.length + 1)] + exact hblank j (by omega) + +-- ════════════════════════════════════════════════════════════════════════ +-- bumpTM: the entry adapter +-- ════════════════════════════════════════════════════════════════════════ + +/-- The two states of `bumpTM`: `go` (initial, about to bump every head right) + and `done` (halted). -/ +inductive BumpPhase where + | go | done + deriving DecidableEq + +/-- `BumpPhase` is a finite type, as required for TM state spaces. -/ +instance : Fintype BumpPhase where + elems := {.go, .done} + complete := fun x => by cases x <;> simp + +/-- **Entry adapter**: one step moving every head from `▷` (cell 0, the + initial configuration) to cell 1, establishing the parked discipline: + blank work tapes become zero registers and the blank output becomes the + empty accumulator. -/ +def bumpTM : TM n where + Q := BumpPhase + qstart := .go + qhalt := .done + δ := fun _ _ wHeads _ => + (.done, fun i => readBackWrite (wHeads i), .blank, + Dir3.right, fun _ => Dir3.right, Dir3.right) + δ_right_of_start := fun _ _ _ _ => ⟨fun _ => rfl, fun _ _ => rfl, fun _ => rfl⟩ + +/-- The input tape of the initial configuration, bumped to cell 1, is parked. -/ +theorem parked_init_input (x : List Bool) : + Parked { head := 1, cells := (Tape.init (x.map Γ.ofBool)).cells } := by + refine ⟨le_refl 1, fun j hj => ?_⟩ + show (Tape.init (x.map Γ.ofBool)).cells j ≠ Γ.start + simp only [Tape.init] + rw [if_neg (by omega : ¬ j = 0)] + cases h : (x.map Γ.ofBool)[j - 1]? with + | none => decide + | some g => + obtain ⟨b, _, rfl⟩ := List.mem_map.mp (List.mem_of_getElem? h) + cases b <;> decide + +/-- **`bumpTM` Hoare specification.** From the initial configuration's tapes, + one step establishes: parked input (cells intact), zero registers on all + work tapes, and the empty output accumulator. -/ +theorem bumpTM_hoareTime (x : List Bool) : + (bumpTM (n := n)).HoareTime + (fun inp work out => + inp = Tape.init (x.map Γ.ofBool) ∧ (∀ i, work i = Tape.init []) ∧ + out = Tape.init []) + (fun inp work out => + inp = { head := 1, cells := (Tape.init (x.map Γ.ofBool)).cells } ∧ + (∀ i, IsReg 0 (work i)) ∧ OutAcc [] out) + 1 := by + rintro inp work out ⟨rfl, hwork, rfl⟩ + obtain rfl : work = fun _ => Tape.init [] := funext hwork + refine ⟨⟨BumpPhase.done, ⟨1, (Tape.init (x.map Γ.ofBool)).cells⟩, + fun _ => ⟨1, (Tape.init []).cells⟩, ⟨1, (Tape.init []).cells⟩⟩, 1, le_refl 1, + .step ?_ .zero, rfl, rfl, fun _ => reg_zero_init_bumped, outAcc_nil_init⟩ + rfl + +-- ════════════════════════════════════════════════════════════════════════ +-- emitBitsTM: append a fixed word to the output +-- ════════════════════════════════════════════════════════════════════════ + +/-- **Append the fixed word `w` to the output** and halt. State `k` = number of + bits already emitted; each step writes bit `k` and moves the output head + right; input and work tapes are parked and untouched. -/ +def emitBitsTM (w : List Bool) : TM n where + Q := Fin (w.length + 1) + qstart := ⟨0, by omega⟩ + qhalt := ⟨w.length, by omega⟩ + δ := fun k iHead wHeads oHead => + if h : k.val < w.length then + (⟨k.val + 1, by omega⟩, fun i => readBackWrite (wHeads i), Γw.ofBool w[k.val], + idleDir iHead, fun i => idleDir (wHeads i), Dir3.right) + else + allIdle k iHead wHeads oHead + δ_right_of_start := by + intro k iHead wHeads oHead + by_cases h : k.val < w.length + · simp only [h, ↓reduceDIte] + exact ⟨idleDir_right_of_start, fun _ => idleDir_right_of_start, fun _ => trivial⟩ + · simp only [h, ↓reduceDIte] + exact rightOfStart_allIdle iHead wHeads oHead + +/-- One emit step: from state `k < |w|`, the machine writes bit `k`, advances + the accumulator, and leaves the parked input and work tapes unchanged. -/ +private theorem emitBitsTM_step (w : List Bool) (c : Cfg n (emitBitsTM (n := n) w).Q) + (k : ℕ) (hk : k < w.length) (hst : c.state = ⟨k, by omega⟩) + (hinp : Parked c.input) (hwork : ∀ i, Parked (c.work i)) : + (emitBitsTM (n := n) w).step c = some + { state := ⟨k + 1, by omega⟩, input := c.input, work := c.work, + output := c.output.writeAndMove (Γ.ofBool w[k]) .right } := by + have hne : ¬ c.state = (emitBitsTM (n := n) w).qhalt := by + rw [hst] + simp only [emitBitsTM, Fin.mk.injEq] + omega + rw [TM.step, if_neg hne] + simp only [emitBitsTM, hst, hk, ↓reduceDIte] + refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, ?_, ?_, ?_⟩) + · exact hinp.move_idle + · funext i + exact (hwork i).writeAndMove_readBack_idle + · rw [Γw.ofBool_toΓ] + +/-- The emit loop: from state `k` with `|w| = k + m`, the machine reaches the + halt state in exactly `m` steps, appending `w.drop k` and preserving the + input and work tapes. -/ +private theorem emitBitsTM_run (w : List Bool) (m : ℕ) : + ∀ (k : ℕ) (hk : w.length = k + m), + ∀ (c : Cfg n (emitBitsTM (n := n) w).Q) (ys : List Bool), + c.state = ⟨k, by omega⟩ → Parked c.input → (∀ i, Parked (c.work i)) → + OutAcc ys c.output → + ∃ c', (emitBitsTM (n := n) w).reachesIn m c c' ∧ + c'.state = ⟨w.length, by omega⟩ ∧ c'.input = c.input ∧ c'.work = c.work ∧ + OutAcc (ys ++ w.drop k) c'.output := by + induction m with + | zero => + intro k hk c ys hst hinp hwork hout + refine ⟨c, .zero, ?_, rfl, rfl, ?_⟩ + · rw [hst]; congr 1; omega + · rw [List.drop_of_length_le (by omega), List.append_nil] + exact hout + | succ m ih => + intro k hk c ys hst hinp hwork hout + have hklt : k < w.length := by omega + have hstep := emitBitsTM_step w c k hklt hst hinp hwork + set c₁ : Cfg n (emitBitsTM (n := n) w).Q := + { state := ⟨k + 1, by omega⟩, input := c.input, work := c.work, + output := c.output.writeAndMove (Γ.ofBool w[k]) .right } with hc₁ + obtain ⟨c', hreach, hst', hinp', hwork', hout'⟩ := + ih (k + 1) (by omega) c₁ (ys ++ [w[k]]) rfl hinp hwork + (outAcc_append_bit hout w[k]) + refine ⟨c', .step hstep hreach, hst', hinp', hwork', ?_⟩ + rwa [List.append_assoc, List.singleton_append, + List.getElem_cons_drop] at hout' + +/-- Exact fixed-word emission appends `w`, preserves the complete input/work +frame, and reaches the halt state in exactly `|w|` steps. -/ +theorem emitBitsTM_reachesIn_frame (w : List Bool) (inp₀ : Tape) + (work₀ : Fin n → Tape) (out₀ : Tape) (ys : List Bool) + (hinp₀ : Parked inp₀) (hwork₀ : ∀ i, Parked (work₀ i)) + (hout₀ : OutAcc ys out₀) : + ∃ c', + (emitBitsTM (n := n) w).reachesIn w.length + { state := (emitBitsTM (n := n) w).qstart + input := inp₀ + work := work₀ + output := out₀ } c' ∧ + (emitBitsTM (n := n) w).halted c' ∧ + c'.input = inp₀ ∧ + c'.work = work₀ ∧ + OutAcc (ys ++ w) c'.output := by + obtain ⟨c', hreach, hhalt, hinput, hwork, houtput⟩ := + emitBitsTM_run w w.length 0 (by omega) + { state := ⟨0, by omega⟩, input := inp₀, work := work₀, output := out₀ } + ys rfl hinp₀ hwork₀ hout₀ + refine ⟨c', hreach, hhalt, hinput, hwork, ?_⟩ + rwa [List.drop_zero] at houtput + +/-- Fixed-word emission satisfies the one-way-output transducer discipline. -/ +theorem emitBitsTM_isTransducer (w : List Bool) : + (emitBitsTM (n := n) w).IsTransducer := by + intro k iHead wHeads oHead + by_cases h : k.val < w.length + · simp [emitBitsTM, h] + · simp [emitBitsTM, h, allIdle, idleDir] + split <;> decide + +/-- **`emitBitsTM` Hoare specification.** Appends the word `w` to the output + accumulator in `|w|` steps, leaving the (parked) input and work tapes + literally unchanged. Ghost-parametrized by the initial tapes for + `seqTM` composition. -/ +theorem emitBitsTM_hoareTime (w : List Bool) (inp₀ : Tape) (work₀ : Fin n → Tape) + (ys : List Bool) (hinp₀ : Parked inp₀) (hwork₀ : ∀ i, Parked (work₀ i)) : + (emitBitsTM (n := n) w).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ OutAcc ys out) + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ OutAcc (ys ++ w) out) + w.length := by + rintro inp work out ⟨rfl, rfl, hout⟩ + obtain ⟨c', hreach, hst', hinp', hwork', hout'⟩ := + emitBitsTM_run w w.length 0 (by omega) + { state := ⟨0, by omega⟩, input := inp, work := work, output := out } + ys rfl hinp₀ hwork₀ hout + refine ⟨c', w.length, le_refl _, hreach, ?_, hinp', hwork', ?_⟩ + · exact hst' + · rw [List.drop_zero] at hout' + exact hout' + +-- ════════════════════════════════════════════════════════════════════════ +-- emitUnaryTM: append a register's value as a doubled-unary run +-- ════════════════════════════════════════════════════════════════════════ + +/-- The states of `emitUnaryTM`: `emitA`/`emitB` alternate to emit two trues per + register mark, `back` rewinds the register head to `▷`, `park` steps it to + cell 1, and `done` halts. -/ +inductive EmitUnaryPhase where + | emitA | emitB | back | park | done + deriving DecidableEq + +/-- `EmitUnaryPhase` is a finite type, as required for TM state spaces. -/ +instance : Fintype EmitUnaryPhase where + elems := {.emitA, .emitB, .back, .park, .done} + complete := fun x => by cases x <;> simp + +/-- **Append `2v` trues to the output, where `v` is the value of register `r`** + (the doubled-unary body `doubleBits (Unary.encode v)` of a literal's + variable index), restoring the register exactly. The head sweeps right + over the register's marks emitting two trues per mark (`emitA`/`emitB`), + then rewinds to cell 1 (`back`/`park`). -/ +def emitUnaryTM (r : Fin n) : TM n where + Q := EmitUnaryPhase + qstart := .emitA + qhalt := .done + δ := fun s iHead wHeads oHead => + match s with + | .emitA => + if wHeads r = Γ.one then + (.emitB, fun i => readBackWrite (wHeads i), Γw.one, + idleDir iHead, fun i => if i = r then Dir3.stay else idleDir (wHeads i), + Dir3.right) + else + (.back, fun i => readBackWrite (wHeads i), readBackWrite oHead, + idleDir iHead, + fun i => if i = r then (if wHeads r = Γ.start then Dir3.right else Dir3.left) + else idleDir (wHeads i), + idleDir oHead) + | .emitB => + (.emitA, fun i => readBackWrite (wHeads i), Γw.one, + idleDir iHead, fun i => if i = r then Dir3.right else idleDir (wHeads i), + Dir3.right) + | .back => + if wHeads r = Γ.start then + (.park, fun i => readBackWrite (wHeads i), readBackWrite oHead, + idleDir iHead, fun i => if i = r then Dir3.right else idleDir (wHeads i), + idleDir oHead) + else + (.back, fun i => readBackWrite (wHeads i), readBackWrite oHead, + idleDir iHead, fun i => if i = r then Dir3.left else idleDir (wHeads i), + idleDir oHead) + | .park => + (.done, fun i => readBackWrite (wHeads i), readBackWrite oHead, + idleDir iHead, fun i => idleDir (wHeads i), idleDir oHead) + | .done => allIdle s iHead wHeads oHead + δ_right_of_start := by + intro s iHead wHeads oHead + match s with + | .emitA => + dsimp only [] + split + · next hone => + refine ⟨idleDir_right_of_start, fun i hi => ?_, fun _ => rfl⟩ + dsimp only [] + by_cases hir : i = r + · subst hir; rw [hone] at hi; exact absurd hi (by decide) + · rw [if_neg hir]; exact idleDir_right_of_start hi + · next hnone => + refine ⟨idleDir_right_of_start, fun i hi => ?_, idleDir_right_of_start⟩ + dsimp only [] + by_cases hir : i = r + · subst hir; rw [if_pos rfl, if_pos hi] + · rw [if_neg hir]; exact idleDir_right_of_start hi + | .emitB => + refine ⟨idleDir_right_of_start, fun i hi => ?_, fun _ => rfl⟩ + dsimp only [] + by_cases hir : i = r + · rw [if_pos hir] + · rw [if_neg hir]; exact idleDir_right_of_start hi + | .back => + dsimp only [] + split + · refine ⟨idleDir_right_of_start, fun i hi => ?_, idleDir_right_of_start⟩ + dsimp only [] + by_cases hir : i = r + · rw [if_pos hir] + · rw [if_neg hir]; exact idleDir_right_of_start hi + · next hns => + refine ⟨idleDir_right_of_start, fun i hi => ?_, idleDir_right_of_start⟩ + dsimp only [] + by_cases hir : i = r + · subst hir; exact absurd hi hns + · rw [if_neg hir]; exact idleDir_right_of_start hi + | .park => + exact ⟨idleDir_right_of_start, fun _ => idleDir_right_of_start, + idleDir_right_of_start⟩ + | .done => exact rightOfStart_allIdle iHead wHeads oHead + +section EmitUnary + +variable {r : Fin n} + +/-- Not yet halted, from any of the four working phases. -/ +private theorem emitUnaryTM_ne_halt {s : EmitUnaryPhase} (h : s ≠ .done) + {c : Cfg n (emitUnaryTM (n := n) r).Q} (hst : c.state = s) : + ¬ c.state = (emitUnaryTM (n := n) r).qhalt := by + rw [hst] + show ¬ s = EmitUnaryPhase.done + exact h + +/-- `emitA` over a mark: write one `true`, output right, register stays. -/ +private theorem emitUnaryTM_step_emitA_one (c : Cfg n (emitUnaryTM (n := n) r).Q) + (hst : c.state = .emitA) (hone : (c.work r).read = Γ.one) + (hinp : Parked c.input) (hwork : ∀ i, i ≠ r → Parked (c.work i)) : + (emitUnaryTM (n := n) r).step c = some + { state := .emitB, input := c.input, work := c.work, + output := c.output.writeAndMove (Γ.ofBool true) .right } := by + rw [TM.step, if_neg (emitUnaryTM_ne_halt (by decide) hst)] + simp only [emitUnaryTM, hst, hone, ↓reduceIte] + refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, ?_, ?_, ?_⟩) + · exact hinp.move_idle + · funext i + by_cases hir : i = r + · subst hir + rw [if_pos rfl, writeAndMove_readBack _ (by rw [hone]; decide)] + rfl + · rw [if_neg hir] + exact (hwork i hir).writeAndMove_readBack_idle + · rfl + +/-- `emitB`: write the second `true`, output right, register advances right. -/ +private theorem emitUnaryTM_step_emitB (c : Cfg n (emitUnaryTM (n := n) r).Q) + (hst : c.state = .emitB) (hone : (c.work r).read = Γ.one) + (hinp : Parked c.input) (hwork : ∀ i, i ≠ r → Parked (c.work i)) : + (emitUnaryTM (n := n) r).step c = some + { state := .emitA, input := c.input, + work := Function.update c.work r ((c.work r).move .right), + output := c.output.writeAndMove (Γ.ofBool true) .right } := by + rw [TM.step, if_neg (emitUnaryTM_ne_halt (by decide) hst)] + simp only [emitUnaryTM, hst] + refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, ?_, ?_, ?_⟩) + · exact hinp.move_idle + · funext i + by_cases hir : i = r + · subst hir + rw [if_pos rfl, Function.update_self, + writeAndMove_readBack _ (by rw [hone]; decide)] + · rw [if_neg hir, Function.update_of_ne hir] + exact (hwork i hir).writeAndMove_readBack_idle + · rfl + +/-- `emitA` over the sentinel blank: turn around (register head left), output + untouched. -/ +private theorem emitUnaryTM_step_emitA_blank (c : Cfg n (emitUnaryTM (n := n) r).Q) + (hst : c.state = .emitA) (hblank : (c.work r).read = Γ.blank) + (hinp : Parked c.input) (hwork : ∀ i, i ≠ r → Parked (c.work i)) + (hout : Parked c.output) : + (emitUnaryTM (n := n) r).step c = some + { state := .back, input := c.input, + work := Function.update c.work r ((c.work r).move .left), + output := c.output } := by + rw [TM.step, if_neg (emitUnaryTM_ne_halt (by decide) hst)] + simp only [emitUnaryTM, hst, hblank, reduceCtorEq, ↓reduceIte] + refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, ?_, ?_, ?_⟩) + · exact hinp.move_idle + · funext i + by_cases hir : i = r + · subst hir + rw [if_pos rfl, Function.update_self, + writeAndMove_readBack _ (by rw [hblank]; decide)] + · rw [if_neg hir, Function.update_of_ne hir] + exact (hwork i hir).writeAndMove_readBack_idle + · exact hout.writeAndMove_readBack_idle + +/-- `back` off the sentinel: keep rewinding left, everything else untouched. -/ +private theorem emitUnaryTM_step_back_left (c : Cfg n (emitUnaryTM (n := n) r).Q) + (hst : c.state = .back) (hns : (c.work r).read ≠ Γ.start) + (hinp : Parked c.input) (hwork : ∀ i, i ≠ r → Parked (c.work i)) + (hout : Parked c.output) : + (emitUnaryTM (n := n) r).step c = some + { state := .back, input := c.input, + work := Function.update c.work r ((c.work r).move .left), + output := c.output } := by + rw [TM.step, if_neg (emitUnaryTM_ne_halt (by decide) hst)] + simp only [emitUnaryTM, hst, hns, ↓reduceIte] + refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, ?_, ?_, ?_⟩) + · exact hinp.move_idle + · funext i + by_cases hir : i = r + · subst hir + rw [if_pos rfl, Function.update_self, writeAndMove_readBack _ hns] + · rw [if_neg hir, Function.update_of_ne hir] + exact (hwork i hir).writeAndMove_readBack_idle + · exact hout.writeAndMove_readBack_idle + +/-- `back` on the sentinel `▷` (which, absent spurious `▷`s, means cell 0): + step right to cell 1 and park. The write is structurally void at cell 0. -/ +private theorem emitUnaryTM_step_back_start (c : Cfg n (emitUnaryTM (n := n) r).Q) + (hst : c.state = .back) (hs : (c.work r).read = Γ.start) + (hcr : ∀ j, 1 ≤ j → (c.work r).cells j ≠ Γ.start) + (hinp : Parked c.input) (hwork : ∀ i, i ≠ r → Parked (c.work i)) + (hout : Parked c.output) : + (emitUnaryTM (n := n) r).step c = some + { state := .park, input := c.input, + work := Function.update c.work r ((c.work r).move .right), + output := c.output } := by + have h0 : (c.work r).head = 0 := by + by_contra hc + exact hcr _ (by omega) hs + rw [TM.step, if_neg (emitUnaryTM_ne_halt (by decide) hst)] + simp only [emitUnaryTM, hst, hs, ↓reduceIte] + refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, ?_, ?_, ?_⟩) + · exact hinp.move_idle + · funext i + by_cases hir : i = r + · subst hir + rw [if_pos rfl, Function.update_self] + show ((c.work i).write _).move Dir3.right = (c.work i).move .right + congr 1 + rw [Tape.write, if_pos h0] + · rw [if_neg hir, Function.update_of_ne hir] + exact (hwork i hir).writeAndMove_readBack_idle + · exact hout.writeAndMove_readBack_idle + +/-- `park`: one idle step into `done`; nothing changes. -/ +private theorem emitUnaryTM_step_park (c : Cfg n (emitUnaryTM (n := n) r).Q) + (hst : c.state = .park) (hinp : Parked c.input) (hwork : ∀ i, Parked (c.work i)) + (hout : Parked c.output) : + (emitUnaryTM (n := n) r).step c = some + { state := .done, input := c.input, work := c.work, output := c.output } := by + rw [TM.step, if_neg (emitUnaryTM_ne_halt (by decide) hst)] + simp only [emitUnaryTM, hst] + refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, ?_, ?_, ?_⟩) + · exact hinp.move_idle + · funext i + exact (hwork i).writeAndMove_readBack_idle + · exact hout.writeAndMove_readBack_idle + +/-- The emit loop: from `emitA` mid-scan (register head at `k + 1`, register + value `v = k + m`), the machine emits `2m` trues in `2m` steps and lands + back in `emitA` on the sentinel blank, register cells untouched. -/ +private theorem emitUnaryTM_emit_run (v m : ℕ) : + ∀ (k : ℕ), v = k + m → + ∀ (c : Cfg n (emitUnaryTM (n := n) r).Q) (ys : List Bool), + c.state = .emitA → + Parked c.input → (∀ i, i ≠ r → Parked (c.work i)) → + (∀ i, i < v → (c.work r).cells (i + 1) = Γ.one) → + (∀ j, v + 1 ≤ j → (c.work r).cells j = Γ.blank) → + (c.work r).head = k + 1 → + OutAcc ys c.output → + ∃ c', (emitUnaryTM (n := n) r).reachesIn (2 * m) c c' ∧ + c'.state = .emitA ∧ c'.input = c.input ∧ + (∀ i, i ≠ r → c'.work i = c.work i) ∧ + (c'.work r).cells = (c.work r).cells ∧ + (c'.work r).head = v + 1 ∧ + OutAcc (ys ++ List.replicate (2 * m) true) c'.output := by + induction m with + | zero => + intro k hk c ys hst hinp hwork _ _ hhead hout + refine ⟨c, .zero, hst, rfl, fun _ _ => rfl, rfl, ?_, by simpa using hout⟩ + rw [hhead, hk] + | succ m ih => + intro k hk c ys hst hinp hwork hones hblanks hhead hout + have hone : (c.work r).read = Γ.one := by + rw [Tape.read, hhead]; exact hones k (by omega) + have hstepA := emitUnaryTM_step_emitA_one c hst hone hinp hwork + set c₁ : Cfg n (emitUnaryTM (n := n) r).Q := + { state := .emitB, input := c.input, work := c.work, + output := c.output.writeAndMove (Γ.ofBool true) .right } with hc₁ + have hstepB := emitUnaryTM_step_emitB c₁ rfl hone hinp hwork + set c₂ : Cfg n (emitUnaryTM (n := n) r).Q := + { state := .emitA, input := c.input, + work := Function.update c.work r ((c.work r).move .right), + output := (c.output.writeAndMove (Γ.ofBool true) .right).writeAndMove + (Γ.ofBool true) .right } with hc₂ + have hmove_cells : ((c.work r).move .right).cells = (c.work r).cells := rfl + obtain ⟨c', hreach, hst', hinp', hwork', hcells', hhead', hout'⟩ := + ih (k + 1) (by omega) c₂ (ys ++ [true] ++ [true]) rfl hinp + (fun i hi => by + show Parked (Function.update c.work r ((c.work r).move .right) i) + rw [Function.update_of_ne hi] + exact hwork i hi) + (fun i hi => by + show (Function.update c.work r ((c.work r).move .right) r).cells (i + 1) = Γ.one + rw [Function.update_self, hmove_cells] + exact hones i hi) + (fun j hj => by + show (Function.update c.work r ((c.work r).move .right) r).cells j = Γ.blank + rw [Function.update_self, hmove_cells] + exact hblanks j hj) + (by + show (Function.update c.work r ((c.work r).move .right) r).head = (k + 1) + 1 + rw [Function.update_self] + show (c.work r).head + 1 = (k + 1) + 1 + rw [hhead]) + (outAcc_append_bit (outAcc_append_bit hout true) true) + refine ⟨c', .step hstepA (.step hstepB hreach), hst', hinp', ?_, ?_, hhead', ?_⟩ + · intro i hi + rw [hwork' i hi] + show Function.update c.work r ((c.work r).move .right) i = c.work i + rw [Function.update_of_ne hi] + · rw [hcells'] + show (Function.update c.work r ((c.work r).move .right) r).cells = (c.work r).cells + rw [Function.update_self, hmove_cells] + · have he : ys ++ [true] ++ [true] ++ List.replicate (2 * m) true + = ys ++ List.replicate (2 * (m + 1)) true := by + rw [show 2 * (m + 1) = 2 * m + 1 + 1 from by omega, List.replicate_succ, + List.replicate_succ] + simp [List.append_assoc] + rwa [he] at hout' + +/-- The rewind loop: from `back` with the register head at `h` (cell 0 holds + `▷`, no spurious `▷`s beyond), the machine reaches `done` in `h + 2` steps + with the register parked at cell 1 and everything else untouched. -/ +private theorem emitUnaryTM_back_run (h : ℕ) : + ∀ (c : Cfg n (emitUnaryTM (n := n) r).Q) (ys : List Bool), + c.state = .back → + Parked c.input → (∀ i, i ≠ r → Parked (c.work i)) → + (c.work r).cells 0 = Γ.start → + (∀ j, 1 ≤ j → (c.work r).cells j ≠ Γ.start) → + (c.work r).head = h → + OutAcc ys c.output → + ∃ c', (emitUnaryTM (n := n) r).reachesIn (h + 2) c c' ∧ + c'.state = .done ∧ c'.input = c.input ∧ + (∀ i, i ≠ r → c'.work i = c.work i) ∧ + (c'.work r).cells = (c.work r).cells ∧ + (c'.work r).head = 1 ∧ + c'.output = c.output := by + induction h with + | zero => + intro c ys hst hinp hwork hc0 hcr hhead hout + have hs : (c.work r).read = Γ.start := by rw [Tape.read, hhead]; exact hc0 + have hstep₁ := emitUnaryTM_step_back_start c hst hs hcr hinp hwork hout.parked + set c₁ : Cfg n (emitUnaryTM (n := n) r).Q := + { state := .park, input := c.input, + work := Function.update c.work r ((c.work r).move .right), + output := c.output } with hc₁ + have hworkP : ∀ i, Parked (c₁.work i) := by + intro i + by_cases hir : i = r + · subst hir + show Parked (Function.update c.work i ((c.work i).move .right) i) + rw [Function.update_self] + exact ⟨by show (c.work i).head + 1 ≥ 1; omega, fun j hj => hcr j hj⟩ + · show Parked (Function.update c.work r ((c.work r).move .right) i) + rw [Function.update_of_ne hir] + exact hwork i hir + have hstep₂ := emitUnaryTM_step_park c₁ rfl hinp hworkP hout.parked + refine ⟨_, .step hstep₁ (.step hstep₂ .zero), rfl, rfl, ?_, ?_, ?_, rfl⟩ + · intro i hi + show Function.update c.work r ((c.work r).move .right) i = c.work i + rw [Function.update_of_ne hi] + · show (Function.update c.work r ((c.work r).move .right) r).cells = (c.work r).cells + rw [Function.update_self] + rfl + · show (Function.update c.work r ((c.work r).move .right) r).head = 1 + rw [Function.update_self] + show (c.work r).head + 1 = 1 + rw [hhead] + | succ h ih => + intro c ys hst hinp hwork hc0 hcr hhead hout + have hns : (c.work r).read ≠ Γ.start := by + rw [Tape.read, hhead]; exact hcr (h + 1) (by omega) + have hstep₁ := emitUnaryTM_step_back_left c hst hns hinp hwork hout.parked + set c₁ : Cfg n (emitUnaryTM (n := n) r).Q := + { state := .back, input := c.input, + work := Function.update c.work r ((c.work r).move .left), + output := c.output } with hc₁ + have hupd_cells : (c₁.work r).cells = (c.work r).cells := by + show (Function.update c.work r ((c.work r).move .left) r).cells = _ + rw [Function.update_self] + rfl + obtain ⟨c', hreach, hst', hinp', hwork', hcells', hhead', hout'⟩ := + ih c₁ ys rfl hinp + (fun i hi => by + show Parked (Function.update c.work r ((c.work r).move .left) i) + rw [Function.update_of_ne hi] + exact hwork i hi) + (by rw [hupd_cells]; exact hc0) + (fun j hj => by rw [hupd_cells]; exact hcr j hj) + (by + show (Function.update c.work r ((c.work r).move .left) r).head = h + rw [Function.update_self] + show (c.work r).head - 1 = h + rw [hhead] + omega) + hout + refine ⟨c', .step hstep₁ hreach, hst', hinp', ?_, ?_, hhead', hout'⟩ + · intro i hi + rw [hwork' i hi] + show Function.update c.work r ((c.work r).move .left) i = c.work i + rw [Function.update_of_ne hi] + · rw [hcells', hupd_cells] + +/-- **`emitUnaryTM` Hoare specification.** Appends `2v` trues (the doubled + unary body of a literal with variable index `v`) to the output accumulator + in `3v + 3` steps, restoring all tapes exactly: the scanned register `r` + included. -/ +theorem emitUnaryTM_hoareTime (r : Fin n) (v : ℕ) (inp₀ : Tape) (work₀ : Fin n → Tape) + (ys : List Bool) (hinp₀ : Parked inp₀) (hwork₀ : ∀ i, i ≠ r → Parked (work₀ i)) + (hreg : IsReg v (work₀ r)) : + (emitUnaryTM (n := n) r).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ OutAcc ys out) + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ + OutAcc (ys ++ List.replicate (2 * v) true) out) + (3 * v + 3) := by + rintro inp work out ⟨rfl, rfl, hout⟩ + obtain ⟨c₁, hreach₁, hst₁, hinp₁, hwork₁, hcells₁, hhead₁, hout₁⟩ := + emitUnaryTM_emit_run v v 0 (by omega) + { state := .emitA, input := inp, work := work, output := out } ys rfl + hinp₀ hwork₀ (fun i hi => hreg.cells_one hi) (fun j hj => hreg.cells_blank hj) + (by show (work r).head = 0 + 1; rw [hreg.head_eq]) hout + have hinpP₁ : Parked c₁.input := by rw [hinp₁]; exact hinp₀ + have hworkP₁ : ∀ i, i ≠ r → Parked (c₁.work i) := fun i hi => by + rw [hwork₁ i hi] + exact hwork₀ i hi + have hblank₁ : (c₁.work r).read = Γ.blank := by + rw [Tape.read, hhead₁, hcells₁] + exact hreg.cells_blank (le_refl _) + have hstep₂ := emitUnaryTM_step_emitA_blank c₁ hst₁ hblank₁ hinpP₁ hworkP₁ hout₁.parked + set c₂ : Cfg n (emitUnaryTM (n := n) r).Q := + { state := .back, input := c₁.input, + work := Function.update c₁.work r ((c₁.work r).move .left), + output := c₁.output } with hc₂ + have hupd_cells₂ : (c₂.work r).cells = (work r).cells := by + show (Function.update c₁.work r ((c₁.work r).move .left) r).cells = _ + rw [Function.update_self] + show (c₁.work r).cells = _ + rw [hcells₁] + obtain ⟨c₃, hreach₃, hst₃, hinp₃, hwork₃, hcells₃, hhead₃, hout₃⟩ := + emitUnaryTM_back_run v c₂ (ys ++ List.replicate (2 * v) true) rfl hinpP₁ + (fun i hi => by + show Parked (Function.update c₁.work r ((c₁.work r).move .left) i) + rw [Function.update_of_ne hi] + exact hworkP₁ i hi) + (by rw [hupd_cells₂]; exact hreg.cell0) + (fun j hj => by rw [hupd_cells₂]; exact hreg.cells_ne_start hj) + (by + show (Function.update c₁.work r ((c₁.work r).move .left) r).head = v + rw [Function.update_self] + show (c₁.work r).head - 1 = v + rw [hhead₁] + omega) + hout₁ + refine ⟨c₃, 2 * v + ((v + 2) + 1), by omega, + reachesIn_trans _ hreach₁ (.step hstep₂ hreach₃), hst₃, ?_, ?_, ?_⟩ + · rw [hinp₃]; exact hinp₁ + · funext i + by_cases hir : i = r + · subst hir + refine Tape.ext ?_ ?_ + · rw [hhead₃, hreg.head_eq] + · rw [hcells₃, hupd_cells₂] + · rw [hwork₃ i hir] + show Function.update c₁.work r ((c₁.work r).move .left) i = work i + rw [Function.update_of_ne hir] + exact hwork₁ i hir + · rw [hout₃] + exact hout₁ + +end EmitUnary + +-- ════════════════════════════════════════════════════════════════════════ +-- seqTM composition glue for ghost-parametrized emit specs +-- ════════════════════════════════════════════════════════════════════════ + +/-- The standard emit-spec shape: ghost-fixed input and work tapes, output + accumulator holding `ys`. -/ +def EmitPred (inp₀ : Tape) (work₀ : Fin n → Tape) (ys : List Bool) : TapePred n := + fun inp work out => inp = inp₀ ∧ work = work₀ ∧ OutAcc ys out + +/-- Emit-spec states pass through combinator phase boundaries unchanged: + parked ghosts and the accumulator are fixed points of + `transitionTape` / `transitionInput`. The `h_trans` obligation of + `seqTM_hoareTime` for any two composed emitters. -/ +theorem emitPred_transition {inp₀ : Tape} {work₀ : Fin n → Tape} + (hinp₀ : Parked inp₀) (hworkAll : ∀ i, Parked (work₀ i)) (ys : List Bool) : + ∀ inp work out, EmitPred inp₀ work₀ ys inp work out → + EmitPred inp₀ work₀ ys (transitionInput inp) + (fun i => transitionTape (work i)) (transitionTape out) := by + rintro inp work out ⟨rfl, rfl, hout⟩ + refine ⟨Parked.transitionInput_eq_self hinp₀, ?_, ?_⟩ + · funext i + exact Parked.transitionTape_eq_self (hworkAll i) + · rw [Parked.transitionTape_eq_self hout.parked] + exact hout + +-- ════════════════════════════════════════════════════════════════════════ +-- emitLitTM: append one encoded literal +-- ════════════════════════════════════════════════════════════════════════ + +/-- **Append one encoded literal** with sign `s` and variable index read from + register `r`: the bits `[s, s] ++ (2v trues) ++ [false, true]` + (= `doubleBits (Lit.encodeRaw ⟨s, v⟩) ++ [false, true]`, the form literals + take inside `Clause.encode`). -/ +def emitLitTM (s : Bool) (r : Fin n) : TM n := + seqTM (emitBitsTM [s, s]) (seqTM (emitUnaryTM r) (emitBitsTM [false, true])) + +/-- **`emitLitTM` Hoare specification.** Appends the encoded literal in + `3v + 9` steps, preserving the input and work tapes (the scanned register + included). The first `seqTM`-composed emitter spec; later emitters chain + the same way. -/ +theorem emitLitTM_hoareTime (s : Bool) (r : Fin n) (v : ℕ) (inp₀ : Tape) + (work₀ : Fin n → Tape) (ys : List Bool) (hinp₀ : Parked inp₀) + (hwork₀ : ∀ i, i ≠ r → Parked (work₀ i)) (hreg : IsReg v (work₀ r)) : + (emitLitTM s r).HoareTime + (EmitPred inp₀ work₀ ys) + (EmitPred inp₀ work₀ + (ys ++ ([s, s] ++ List.replicate (2 * v) true ++ [false, true]))) + (3 * v + 9) := by + have hworkAll : ∀ i, Parked (work₀ i) := by + intro i + by_cases hir : i = r + · subst hir; exact hreg.parked + · exact hwork₀ i hir + have h₂₃ := seqTM_hoareTime (emitUnaryTM r) (emitBitsTM [false, true]) + (emitUnaryTM_hoareTime r v inp₀ work₀ (ys ++ [s, s]) hinp₀ hwork₀ hreg) + (emitPred_transition hinp₀ hworkAll _) + (emitBitsTM_hoareTime [false, true] inp₀ work₀ + (ys ++ [s, s] ++ List.replicate (2 * v) true) hinp₀ hworkAll) + have h := seqTM_hoareTime (emitBitsTM [s, s]) + (seqTM (emitUnaryTM r) (emitBitsTM [false, true])) + (emitBitsTM_hoareTime [s, s] inp₀ work₀ ys hinp₀ hworkAll) + (emitPred_transition hinp₀ hworkAll _) + h₂₃ + refine h.consequence (fun _ _ _ hp => hp) ?_ (by simp; omega) + rintro inp work out ⟨rfl, rfl, hout⟩ + refine ⟨rfl, rfl, ?_⟩ + rwa [List.append_assoc (ys ++ [s, s]), List.append_assoc ys, + ← List.append_assoc [s, s]] at hout + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Registers/EmitSeq.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Registers/EmitSeq.lean new file mode 100644 index 0000000000..486aa849e1 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Registers/EmitSeq.lean @@ -0,0 +1,70 @@ +/- +Copyright (c) 2025 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Registers.RegisterOps + +/-! +# Sequencing emitter stages + +`bigSeqTM` folds a list of machines with `seqTM`, and `bigSeqTM_hoareTime` +chains their `EmitPred` specs: stage `k` carries the ghost state `(W k, Y k)` +to `(W (k+1), Y (k+1))`. All the finite-tuple folds of the reduction emitter +(literal chains, clause chains, the per-state/symbol/choice unrollings of the +transition family) are instances of this single rule. +-/ + + +@[expose] public section + +namespace Complexity + +namespace TM + +variable {n : ℕ} + +/-- Sequence a list of machines (right fold, `skipTM` base). -/ +def bigSeqTM : List (TM n) → TM n + | [] => skipTM + | m :: ms => seqTM m (bigSeqTM ms) + +/-- **Indexed chain rule.** Machine `ms[k]` carries the `EmitPred` state from + stage `k` to stage `k + 1`; the fold carries stage `0` to stage + `ms.length`, in `|ms| · (b + 1) + 1` steps. -/ +theorem bigSeqTM_hoareTime (ms : List (TM n)) (inp₀ : Tape) + (W : ℕ → Fin n → Tape) (Y : ℕ → List Bool) (b : ℕ) + (hinp₀ : Parked inp₀) + (hWP : ∀ k j, Parked (W k j)) + (hms : ∀ k, (hk : k < ms.length) → ms[k].HoareTime + (EmitPred inp₀ (W k) (Y k)) (EmitPred inp₀ (W (k + 1)) (Y (k + 1))) b) : + (bigSeqTM ms).HoareTime + (EmitPred inp₀ (W 0) (Y 0)) + (EmitPred inp₀ (W ms.length) (Y ms.length)) + (ms.length * (b + 1) + 1) := by + induction ms generalizing W Y with + | nil => + exact (skipTM_hoareTime inp₀ (W 0) (Y 0) hinp₀ (hWP 0)).mono_bound (by omega) + | cons m ms ih => + have hhead := hms 0 (by simp) + have hrest := ih (fun k => W (k + 1)) (fun k => Y (k + 1)) + (fun k j => hWP (k + 1) j) + (fun k hk => by + have h := hms (k + 1) (by simpa using Nat.succ_lt_succ hk) + simpa using h) + have hseq := seqTM_hoareTime m (bigSeqTM ms) hhead + (emitPred_transition hinp₀ (hWP 1) (Y 1)) hrest + refine hseq.consequence (fun _ _ _ h => h) (fun _ _ _ h => ?_) ?_ + · show EmitPred inp₀ (W (m :: ms).length) (Y (m :: ms).length) _ _ _ + rw [List.length_cons] + exact h + · rw [List.length_cons] + have hmul : (ms.length + 1) * (b + 1) = ms.length * (b + 1) + (b + 1) := + Nat.succ_mul .. + omega + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Registers/ForReg.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Registers/ForReg.lean new file mode 100644 index 0000000000..11cda572c8 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Registers/ForReg.lean @@ -0,0 +1,522 @@ +/- +Copyright (c) 2025 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Registers.Emit + +/-! +# forRegTM: the register-fueled loop combinator + +`forRegTM body r` runs `body` once per mark of register `r`. The fuel is the +*head position* on `r`: the register's cells are never written; the test reads +the cell under the head — a mark means "iterate" (consume = move right, run +the body), the first blank means "exit" (rewind `r` to cell 1 and halt). The +body must leave `r` untouched (our ghost-style specs guarantee this for free, +since bodies preserve every non-target tape literally). + +This is the only loop mechanism of the reduction emitter +(`docs/A5-ReductionEmitter.md`): unlike `loopTM`, its test reads a *work* +tape, so the output tape remains an append-only accumulator throughout. + +The Hoare rule `forRegTM_hoareTime` threads an iteration-indexed family of +ghost work-tape functions and output words through the loop. +-/ + + +@[expose] public section + +namespace Complexity + +namespace TM + +variable {n : ℕ} + +/-- Driver phases of `forRegTM`: `test` reads the fuel register's cell (mark = iterate, + blank = exit), `rewind` returns the register head to cell 1, `done` is the halt state. -/ +inductive ForPhase where + | test | rewind | done + deriving DecidableEq + +/-- `ForPhase` is a finite type (it has exactly three constructors). -/ +instance : Fintype ForPhase where + elems := {.test, .rewind, .done} + complete := fun x => by cases x <;> simp + +/-- **Register-fueled loop**: run `body` once per mark of register `r`. + States: the driver phases on the left, the body's states on the right. -/ +def forRegTM (body : TM n) (r : Fin n) : TM n where + Q := ForPhase ⊕ body.Q + qstart := .inl .test + qhalt := .inl .done + δ := fun s iHead wHeads oHead => + match s with + | .inl .test => + if wHeads r = Γ.one then + (.inr body.qstart, fun i => readBackWrite (wHeads i), readBackWrite oHead, + idleDir iHead, fun i => if i = r then Dir3.right else idleDir (wHeads i), + idleDir oHead) + else + (.inl .rewind, fun i => readBackWrite (wHeads i), readBackWrite oHead, + idleDir iHead, + fun i => if i = r then (if wHeads r = Γ.start then Dir3.right else Dir3.left) + else idleDir (wHeads i), + idleDir oHead) + | .inl .rewind => + if wHeads r = Γ.start then + (.inl .done, fun i => readBackWrite (wHeads i), readBackWrite oHead, + idleDir iHead, fun i => if i = r then Dir3.right else idleDir (wHeads i), + idleDir oHead) + else + (.inl .rewind, fun i => readBackWrite (wHeads i), readBackWrite oHead, + idleDir iHead, fun i => if i = r then Dir3.left else idleDir (wHeads i), + idleDir oHead) + | .inl .done => allIdle s iHead wHeads oHead + | .inr q => + if q = body.qhalt then + (.inl .test, fun i => readBackWrite (wHeads i), readBackWrite oHead, + idleDir iHead, fun i => idleDir (wHeads i), idleDir oHead) + else + ((Sum.inr (body.δ q iHead wHeads oHead).1 : ForPhase ⊕ body.Q), + (body.δ q iHead wHeads oHead).2.1, + (body.δ q iHead wHeads oHead).2.2.1, + (body.δ q iHead wHeads oHead).2.2.2.1, + (body.δ q iHead wHeads oHead).2.2.2.2.1, + (body.δ q iHead wHeads oHead).2.2.2.2.2) + δ_right_of_start := by + intro s iHead wHeads oHead + match s with + | .inl .test => + dsimp only [] + split + · next hone => + refine ⟨idleDir_right_of_start, fun i hi => ?_, idleDir_right_of_start⟩ + dsimp only [] + by_cases hir : i = r + · subst hir; rw [hone] at hi; exact absurd hi (by decide) + · rw [if_neg hir]; exact idleDir_right_of_start hi + · next hnone => + refine ⟨idleDir_right_of_start, fun i hi => ?_, idleDir_right_of_start⟩ + dsimp only [] + by_cases hir : i = r + · subst hir; rw [if_pos rfl, if_pos hi] + · rw [if_neg hir]; exact idleDir_right_of_start hi + | .inl .rewind => + dsimp only [] + split + · refine ⟨idleDir_right_of_start, fun i hi => ?_, idleDir_right_of_start⟩ + dsimp only [] + by_cases hir : i = r + · rw [if_pos hir] + · rw [if_neg hir]; exact idleDir_right_of_start hi + · next hns => + refine ⟨idleDir_right_of_start, fun i hi => ?_, idleDir_right_of_start⟩ + dsimp only [] + by_cases hir : i = r + · subst hir; exact absurd hi hns + · rw [if_neg hir]; exact idleDir_right_of_start hi + | .inl .done => exact rightOfStart_allIdle iHead wHeads oHead + | .inr q => + dsimp only [] + split + · exact ⟨idleDir_right_of_start, fun _ => idleDir_right_of_start, + idleDir_right_of_start⟩ + · exact body.δ_right_of_start q iHead wHeads oHead + +section ForReg + +variable {body : TM n} {r : Fin n} + +/-- Retag a body configuration as a composite configuration. -/ +private def wrapCfg (body : TM n) (r : Fin n) (c : Cfg n body.Q) : + Cfg n (forRegTM body r).Q := + { state := .inr c.state, input := c.input, work := c.work, output := c.output } + +/-- Body steps lift to composite steps. -/ +private theorem forRegTM_lift_step (c c' : Cfg n body.Q) + (hstep : body.step c = some c') : + (forRegTM body r).step (wrapCfg body r c) = some (wrapCfg body r c') := by + have hne : ¬ c.state = body.qhalt := by + intro h + rw [TM.step, if_pos h] at hstep + simp at hstep + rw [TM.step, if_neg hne] at hstep + rw [TM.step, if_neg (show ¬ (wrapCfg body r c).state = (forRegTM body r).qhalt from + by simp [wrapCfg, forRegTM])] + simp only [wrapCfg, forRegTM, hne, ↓reduceIte] + revert hstep + generalize body.δ c.state c.input.read (fun i => (c.work i).read) c.output.read = bd + obtain ⟨q', ww, ow, iD, wD, oD⟩ := bd + intro hstep + cases Option.some.inj hstep + rfl + +private theorem forRegTM_ne_halt {s : ForPhase ⊕ body.Q} (h : s ≠ .inl .done) + {c : Cfg n (forRegTM body r).Q} (hst : c.state = s) : + ¬ c.state = (forRegTM body r).qhalt := by + rw [hst] + show ¬ s = Sum.inl ForPhase.done + exact h + +/-- `test` over a mark: consume it (register head right) and enter the body. -/ +private theorem forRegTM_step_test_one (c : Cfg n (forRegTM body r).Q) + (hst : c.state = .inl .test) (hone : (c.work r).read = Γ.one) + (hinp : Parked c.input) (hwork : ∀ i, i ≠ r → Parked (c.work i)) + (hout : Parked c.output) : + (forRegTM body r).step c = some + { state := .inr body.qstart, input := c.input, + work := Function.update c.work r ((c.work r).move .right), + output := c.output } := by + rw [TM.step, if_neg (forRegTM_ne_halt (by simp) hst)] + simp only [forRegTM, hst, hone, ↓reduceIte] + refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, ?_, ?_, ?_⟩) + · exact hinp.move_idle + · funext i + by_cases hir : i = r + · subst hir + rw [if_pos rfl, Function.update_self, + writeAndMove_readBack _ (by rw [hone]; decide)] + · rw [if_neg hir, Function.update_of_ne hir] + exact (hwork i hir).writeAndMove_readBack_idle + · exact hout.writeAndMove_readBack_idle + +/-- `test` at the first blank: exit toward the rewind. -/ +private theorem forRegTM_step_test_blank (c : Cfg n (forRegTM body r).Q) + (hst : c.state = .inl .test) (hblank : (c.work r).read = Γ.blank) + (hinp : Parked c.input) (hwork : ∀ i, i ≠ r → Parked (c.work i)) + (hout : Parked c.output) : + (forRegTM body r).step c = some + { state := .inl .rewind, input := c.input, + work := Function.update c.work r ((c.work r).move .left), + output := c.output } := by + rw [TM.step, if_neg (forRegTM_ne_halt (by simp) hst)] + simp only [forRegTM, hst, hblank, reduceCtorEq, ↓reduceIte] + refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, ?_, ?_, ?_⟩) + · exact hinp.move_idle + · funext i + by_cases hir : i = r + · subst hir + simp only [↓reduceIte, Function.update_self] + rw [writeAndMove_readBack _ (by rw [hblank]; decide)] + · rw [if_neg hir, Function.update_of_ne hir] + exact (hwork i hir).writeAndMove_readBack_idle + · exact hout.writeAndMove_readBack_idle + +/-- `rewind` off the sentinel: keep rewinding. -/ +private theorem forRegTM_step_rewind_left (c : Cfg n (forRegTM body r).Q) + (hst : c.state = .inl .rewind) (hns : (c.work r).read ≠ Γ.start) + (hinp : Parked c.input) (hwork : ∀ i, i ≠ r → Parked (c.work i)) + (hout : Parked c.output) : + (forRegTM body r).step c = some + { state := .inl .rewind, input := c.input, + work := Function.update c.work r ((c.work r).move .left), + output := c.output } := by + rw [TM.step, if_neg (forRegTM_ne_halt (by simp) hst)] + simp only [forRegTM, hst, hns, ↓reduceIte] + refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, ?_, ?_, ?_⟩) + · exact hinp.move_idle + · funext i + by_cases hir : i = r + · subst hir + rw [if_pos rfl, Function.update_self, writeAndMove_readBack _ hns] + · rw [if_neg hir, Function.update_of_ne hir] + exact (hwork i hir).writeAndMove_readBack_idle + · exact hout.writeAndMove_readBack_idle + +/-- `rewind` on the sentinel: step right to cell 1 and halt. -/ +private theorem forRegTM_step_rewind_start (c : Cfg n (forRegTM body r).Q) + (hst : c.state = .inl .rewind) (hs : (c.work r).read = Γ.start) + (hcr : ∀ j, 1 ≤ j → (c.work r).cells j ≠ Γ.start) + (hinp : Parked c.input) (hwork : ∀ i, i ≠ r → Parked (c.work i)) + (hout : Parked c.output) : + (forRegTM body r).step c = some + { state := .inl .done, input := c.input, + work := Function.update c.work r ((c.work r).move .right), + output := c.output } := by + have h0 : (c.work r).head = 0 := by + by_contra hc + exact hcr _ (by omega) hs + rw [TM.step, if_neg (forRegTM_ne_halt (by simp) hst)] + simp only [forRegTM, hst, hs, ↓reduceIte] + refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, ?_, ?_, ?_⟩) + · exact hinp.move_idle + · funext i + by_cases hir : i = r + · subst hir + rw [if_pos rfl, Function.update_self] + show ((c.work i).write _).move Dir3.right = (c.work i).move .right + congr 1 + rw [Tape.write, if_pos h0] + · rw [if_neg hir, Function.update_of_ne hir] + exact (hwork i hir).writeAndMove_readBack_idle + · exact hout.writeAndMove_readBack_idle + +/-- The body has halted: one idle step loops back to the test. -/ +private theorem forRegTM_step_loopback (c : Cfg n (forRegTM body r).Q) + (hst : c.state = .inr body.qhalt) + (hinp : Parked c.input) (hwork : ∀ i, Parked (c.work i)) + (hout : Parked c.output) : + (forRegTM body r).step c = some + { state := .inl .test, input := c.input, work := c.work, + output := c.output } := by + rw [TM.step, if_neg (forRegTM_ne_halt (by simp) hst)] + simp only [forRegTM, hst, ↓reduceIte] + refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, ?_, ?_, ?_⟩) + · exact hinp.move_idle + · funext i + exact (hwork i).writeAndMove_readBack_idle + · exact hout.writeAndMove_readBack_idle + +/-- The rewind loop: from `rewind` at head `h`, halt parked at cell 1 in + `h + 1` steps. -/ +private theorem forRegTM_rewind_run (h : ℕ) : + ∀ (c : Cfg n (forRegTM body r).Q), + c.state = .inl .rewind → Parked c.input → (∀ i, i ≠ r → Parked (c.work i)) → + Parked c.output → + (c.work r).cells 0 = Γ.start → + (∀ j, 1 ≤ j → (c.work r).cells j ≠ Γ.start) → + (c.work r).head = h → + ∃ c', (forRegTM body r).reachesIn (h + 1) c c' ∧ + c'.state = .inl .done ∧ c'.input = c.input ∧ + (∀ i, i ≠ r → c'.work i = c.work i) ∧ + (c'.work r).cells = (c.work r).cells ∧ (c'.work r).head = 1 ∧ + c'.output = c.output := by + induction h with + | zero => + intro c hst hinp hwork hout hc0 hcr hhead + have hs : (c.work r).read = Γ.start := by rw [Tape.read, hhead]; exact hc0 + have hstep := forRegTM_step_rewind_start c hst hs hcr hinp hwork hout + refine ⟨_, .step hstep .zero, rfl, rfl, ?_, ?_, ?_, rfl⟩ + · intro i hi + show Function.update c.work r ((c.work r).move .right) i = c.work i + rw [Function.update_of_ne hi] + · show (Function.update c.work r ((c.work r).move .right) r).cells = _ + rw [Function.update_self] + rfl + · show (Function.update c.work r ((c.work r).move .right) r).head = 1 + rw [Function.update_self] + show (c.work r).head + 1 = 1 + rw [hhead] + | succ h ih => + intro c hst hinp hwork hout hc0 hcr hhead + have hns : (c.work r).read ≠ Γ.start := by + rw [Tape.read, hhead]; exact hcr (h + 1) (by omega) + have hstep := forRegTM_step_rewind_left c hst hns hinp hwork hout + have hupd : (Function.update c.work r ((c.work r).move .left) r).cells + = (c.work r).cells := by + rw [Function.update_self] + rfl + obtain ⟨c', hreach, hst', hinp', hwork', hcells', hhead', hout'⟩ := + ih { state := .inl .rewind, input := c.input, + work := Function.update c.work r ((c.work r).move .left), + output := c.output } rfl hinp + (fun i hi => by + show Parked (Function.update c.work r ((c.work r).move .left) i) + rw [Function.update_of_ne hi] + exact hwork i hi) + hout + (by rw [hupd]; exact hc0) + (fun j hj => by rw [hupd]; exact hcr j hj) + (by + show (Function.update c.work r ((c.work r).move .left) r).head = h + rw [Function.update_self] + show (c.work r).head - 1 = h + rw [hhead] + omega) + refine ⟨c', .step hstep hreach, hst', hinp', ?_, ?_, hhead', hout'⟩ + · intro i hi + rw [hwork' i hi] + show Function.update c.work r ((c.work r).move .left) i = c.work i + rw [Function.update_of_ne hi] + · rw [hcells', hupd] + +/-- The iteration loop: from the `i`-th test entry, run the remaining `m` + iterations and the exit rewind. -/ +private theorem forRegTM_loop_run (inp₀ : Tape) (w : ℕ → Fin n → Tape) + (ys : ℕ → List Bool) (b_iter v : ℕ) + (hinp₀ : Parked inp₀) + (hwP : ∀ i j, j ≠ r → Parked (w i j)) + (hbody : ∀ i, i < v → body.HoareTime + (fun inp work out => inp = inp₀ ∧ + work = Function.update (w i) r ⟨i + 2, regCells v⟩ ∧ OutAcc (ys i) out) + (fun inp work out => inp = inp₀ ∧ + work = Function.update (w (i + 1)) r ⟨i + 2, regCells v⟩ ∧ + OutAcc (ys (i + 1)) out) + b_iter) : + ∀ (m i : ℕ), v = i + m → + ∀ c : Cfg n (forRegTM body r).Q, + c.state = .inl .test → c.input = inp₀ → + c.work = Function.update (w i) r ⟨i + 1, regCells v⟩ → + OutAcc (ys i) c.output → + ∃ c' t, t ≤ m * (b_iter + 2) + (v + 2) ∧ + (forRegTM body r).reachesIn t c c' ∧ + c'.state = .inl .done ∧ c'.input = inp₀ ∧ + c'.work = Function.update (w v) r (regTape v) ∧ + OutAcc (ys v) c'.output := by + intro m + induction m with + | zero => + intro i hi c hst hcin hcw hout + obtain rfl : v = i := by omega + have hcwr : c.work r = ⟨v + 1, regCells v⟩ := by + rw [hcw, Function.update_self] + have hblank : (c.work r).read = Γ.blank := by + rw [hcwr] + show regCells v (v + 1) = Γ.blank + exact regCells_blank (le_refl _) + have hworkP : ∀ j, j ≠ r → Parked (c.work j) := by + intro j hj + rw [hcw, Function.update_of_ne hj] + exact hwP v j hj + have hinpP : Parked c.input := by rw [hcin]; exact hinp₀ + have hstep₁ := forRegTM_step_test_blank c hst hblank hinpP hworkP hout.parked + have hw₁ : Function.update c.work r ((c.work r).move .left) + = Function.update (w v) r ⟨v, regCells v⟩ := by + rw [hcwr, hcw, Function.update_idem] + rfl + obtain ⟨c', hreach, hst', hinp', hwork', hcells', hhead', hout'⟩ := + forRegTM_rewind_run (body := body) v + { state := .inl .rewind, input := c.input, + work := Function.update (w v) r ⟨v, regCells v⟩, output := c.output } + rfl hinpP + (fun j hj => by + show Parked (Function.update (w v) r (⟨v, regCells v⟩ : Tape) j) + rw [Function.update_of_ne hj] + exact hwP v j hj) + hout.parked + (by + show (Function.update (w v) r (⟨v, regCells v⟩ : Tape) r).cells 0 = Γ.start + rw [Function.update_self] + rfl) + (fun j hj => by + show (Function.update (w v) r (⟨v, regCells v⟩ : Tape) r).cells j ≠ Γ.start + rw [Function.update_self] + show regCells v j ≠ Γ.start + rw [regCells, if_neg (by omega)] + split <;> decide) + (by + show (Function.update (w v) r (⟨v, regCells v⟩ : Tape) r).head = v + rw [Function.update_self]) + have hb0 : (v + 1) + 1 ≤ 0 * (b_iter + 2) + (v + 2) := by omega + refine ⟨c', (v + 1) + 1, hb0, .step hstep₁ ?_, hst', ?_, ?_, ?_⟩ + · rw [hw₁] + exact hreach + · rw [hinp'] + show c.input = inp₀ + exact hcin + · funext j + by_cases hjr : j = r + · subst hjr + rw [Function.update_self] + refine Tape.ext ?_ ?_ + · rw [hhead'] + rfl + · rw [hcells'] + show (Function.update (w v) j (⟨v, regCells v⟩ : Tape) j).cells = _ + rw [Function.update_self, regT_cells] + · rw [hwork' j hjr, Function.update_of_ne hjr] + show Function.update (w v) r (⟨v, regCells v⟩ : Tape) j = w v j + rw [Function.update_of_ne hjr] + · rw [hout'] + exact hout + | succ m ih => + intro i hi c hst hcin hcw hout + have hcwr : c.work r = ⟨i + 1, regCells v⟩ := by + rw [hcw, Function.update_self] + have hone : (c.work r).read = Γ.one := by + rw [hcwr] + show regCells v (i + 1) = Γ.one + exact regCells_one (by omega) (by omega) + have hworkP : ∀ j, j ≠ r → Parked (c.work j) := by + intro j hj + rw [hcw, Function.update_of_ne hj] + exact hwP i j hj + have hinpP : Parked c.input := by rw [hcin]; exact hinp₀ + have hstep₁ := forRegTM_step_test_one c hst hone hinpP hworkP hout.parked + have hw₁ : Function.update c.work r ((c.work r).move .right) + = Function.update (w i) r ⟨i + 2, regCells v⟩ := by + rw [hcwr, hcw, Function.update_idem] + rfl + obtain ⟨cb, tb, htb, hbreach, hbhalt, hbinp, hbwork, hbout⟩ := + hbody i (by omega) inp₀ (Function.update (w i) r ⟨i + 2, regCells v⟩) c.output + ⟨rfl, rfl, hout⟩ + have hlift := reachesIn_map (wrapCfg body r) + (fun a b h => forRegTM_lift_step a b h) hbreach + have hbworkP : ∀ j, Parked (cb.work j) := by + intro j + rw [hbwork] + by_cases hjr : j = r + · subst hjr + rw [Function.update_self] + refine ⟨by show (1 : ℕ) ≤ i + 2; omega, fun p hp => ?_⟩ + show regCells v p ≠ Γ.start + rw [regCells, if_neg (by omega)] + split <;> decide + · rw [Function.update_of_ne hjr] + exact hwP (i + 1) j hjr + have hstep₂ := forRegTM_step_loopback (wrapCfg body r cb) + (by show Sum.inr cb.state = Sum.inr body.qhalt; rw [hbhalt]) + (by show Parked cb.input; rw [hbinp]; exact hinp₀) + (fun j => hbworkP j) + (by show Parked cb.output; exact hbout.parked) + obtain ⟨c', t', ht', hreach', hst', hinp', hwork', hout'⟩ := + ih (i + 1) (by omega) + { state := .inl .test, input := inp₀, + work := Function.update (w (i + 1)) r ⟨i + 2, regCells v⟩, + output := cb.output } + rfl rfl rfl hbout + have hbS : tb + (t' + 1) + 1 ≤ (m + 1) * (b_iter + 2) + (v + 2) := by + have hmul : (m + 1) * (b_iter + 2) = m * (b_iter + 2) + (b_iter + 2) := + Nat.succ_mul .. + omega + refine ⟨c', tb + (t' + 1) + 1, hbS, .step hstep₁ ?_, hst', hinp', hwork', hout'⟩ + rw [hw₁, hcin] + refine reachesIn_trans _ hlift (.step hstep₂ ?_) + rw [show (⟨.inl .test, (wrapCfg body r cb).input, (wrapCfg body r cb).work, + (wrapCfg body r cb).output⟩ : Cfg n (forRegTM body r).Q) + = ⟨.inl .test, inp₀, Function.update (w (i + 1)) r ⟨i + 2, regCells v⟩, + cb.output⟩ from by + simp only [wrapCfg] + rw [hbinp, hbwork]] + exact hreach' + +/-- **`forRegTM` Hoare rule.** Given a fuel register holding `v` (whose tape the + iteration-indexed ghost family `w` never changes) and a body spec carrying + `w i / ys i` to `w (i+1) / ys (i+1)`, the loop carries `w 0 / ys 0` to + `w v / ys v` in at most `v·(b_iter + 2) + v + 3` steps. -/ +theorem forRegTM_hoareTime (body : TM n) (r : Fin n) (v : ℕ) (inp₀ : Tape) + (w : ℕ → Fin n → Tape) (ys : ℕ → List Bool) (b_iter : ℕ) + (hinp₀ : Parked inp₀) + (hwreg : ∀ i, w i r = regTape v) + (hwP : ∀ i j, j ≠ r → Parked (w i j)) + (hbody : ∀ i, i < v → body.HoareTime + (fun inp work out => inp = inp₀ ∧ + work = Function.update (w i) r ⟨i + 2, regCells v⟩ ∧ OutAcc (ys i) out) + (fun inp work out => inp = inp₀ ∧ + work = Function.update (w (i + 1)) r ⟨i + 2, regCells v⟩ ∧ + OutAcc (ys (i + 1)) out) + b_iter) : + (forRegTM body r).HoareTime + (EmitPred inp₀ (w 0) (ys 0)) + (EmitPred inp₀ (w v) (ys v)) + (v * (b_iter + 2) + (v + 2)) := by + rintro inp work out ⟨rfl, rfl, hout⟩ + obtain ⟨c', t, ht, hreach, hst', hinp', hwork', hout'⟩ := + forRegTM_loop_run inp w ys b_iter v hinp₀ hwP hbody v 0 (by omega) + { state := .inl .test, input := inp, work := w 0, output := out } + rfl rfl + (by + show w 0 = Function.update (w 0) r ⟨0 + 1, regCells v⟩ + rw [show (⟨0 + 1, regCells v⟩ : Tape) = w 0 r from by rw [hwreg 0]; rfl, + Function.update_eq_self]) + hout + refine ⟨c', t, ht, hreach, hst', hinp', ?_, hout'⟩ + rw [hwork', show regTape v = w v r from (hwreg v).symm, Function.update_eq_self] + +end ForReg + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Registers/Horner.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Registers/Horner.lean new file mode 100644 index 0000000000..26f60c3dfb --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Registers/Horner.lean @@ -0,0 +1,610 @@ +/- +Copyright (c) 2025 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Registers.EmitSeq +public import Mathlib.Algebra.Polynomial.Eval.Defs +public import Mathlib.Algebra.Polynomial.Eval.Degree +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Registers.Arith + +/-! +# Horner layers: polynomial register evaluation + +The reduction emitter's variable indices are mixed-radix numerals +(`flatVar`), and its time budget is `p.eval n` — both are computed by +iterating the single **Horner layer** `tmp := tmp · X + c` over unary +registers. This file builds that layer from the `Arith` register calculus +and folds it into `polyEvalTM`. + +To keep the time accounting sane across long `seqTM` chains, every stage +bound is rounded up to the single monotone budget `opBudget M`, where `M` +bounds every register value in play. Only the polynomial shape of the final +bound matters (`FP` quantifies the degree existentially), so all budgets +are deliberately loose. + +## Main definitions + +- `TM.opBudget` — the uniform per-operation time budget +- `TM.setConstTM` — `q := c` +- `TM.hornerLayerRegTM` — `tmp := tmp · X + comp` (register addend) +- `TM.hornerLayerConstTM` — `tmp := tmp · X + c` (fixedValue addend) + +## Main results + +- the `_hoareTime` specification of each machine +-/ + + +@[expose] public section + +namespace Complexity + +namespace TM + +variable {n : ℕ} + +-- ════════════════════════════════════════════════════════════════════════ +-- The uniform operation budget +-- ════════════════════════════════════════════════════════════════════════ + +/-- One budget bounds every register operation whose values are at most `M`: + increments, clears, copies, additions, multiply-accumulates, and literal + emissions. Cubic in `M` because `mulAddIntoTM`'s bound is (product value) + × (per-mark sweep length). -/ +def opBudget (M : ℕ) : ℕ := 32 * ((M + 2) * (M + 2) * (M + 2)) + +/-- Anything at most quadratic in `M + 2` (with fixedValue `6`) fits in `opBudget M`. -/ +theorem le_opBudget_of_le {a M : ℕ} (h : a ≤ 6 * (M + 2) * (M + 2)) : + a ≤ opBudget M := by + refine le_trans h ?_ + rw [opBudget] + have h2 : 2 ≤ M + 2 := by omega + calc 6 * (M + 2) * (M + 2) = 6 * ((M + 2) * (M + 2)) := by ring + _ ≤ 32 * ((M + 2) * ((M + 2) * (M + 2))) := by + have : (M + 2) * (M + 2) ≤ (M + 2) * ((M + 2) * (M + 2)) := + Nat.le_mul_of_pos_left _ (by omega) + omega + _ = 32 * ((M + 2) * (M + 2) * (M + 2)) := by ring + +/-- `incRegTM` fits the budget. -/ +theorem incRegTM_le_opBudget {d M : ℕ} (h : d ≤ M) : 2 * d + 4 ≤ opBudget M := + le_opBudget_of_le (by nlinarith) + +/-- `clearRegTM` fits the budget. -/ +theorem clearRegTM_le_opBudget {d M : ℕ} (h : d ≤ M) : 2 * d + 4 ≤ opBudget M := + incRegTM_le_opBudget h + +/-- `skipTM` fits the budget. -/ +theorem one_le_opBudget {M : ℕ} : 1 ≤ opBudget M := + le_opBudget_of_le (by nlinarith) + +/-- `addIntoTM` fits the budget. -/ +theorem addIntoTM_le_opBudget {a b M : ℕ} (ha : a ≤ M) (hab : b + a ≤ M) : + a * ((2 * (b + a) + 4) + 2) + (a + 2) ≤ opBudget M := by + refine le_opBudget_of_le ?_ + have h1 : a * ((2 * (b + a) + 4) + 2) ≤ M * (2 * M + 6) := + Nat.mul_le_mul ha (by omega) + nlinarith + +/-- `iterTM (incRegTM q) c` fits the budget. -/ +theorem iterTM_incRegTM_le_opBudget {c d M : ℕ} (h : d + c ≤ M) : + c * (2 * (d + c) + 5) + 1 ≤ opBudget M := by + refine le_opBudget_of_le ?_ + have h1 : c * (2 * (d + c) + 5) ≤ M * (2 * M + 5) := + Nat.mul_le_mul (by omega) (by omega) + nlinarith + +/-- `copyIntoTM` fits the budget. -/ +theorem copyIntoTM_le_opBudget {a b M : ℕ} (ha : a ≤ M) (hb : b ≤ M) : + (2 * b + 4) + 1 + (a * ((2 * (0 + a) + 4) + 2) + (a + 2)) ≤ opBudget M := by + refine le_opBudget_of_le ?_ + have h1 : a * ((2 * (0 + a) + 4) + 2) ≤ M * (2 * M + 6) := + Nat.mul_le_mul ha (by omega) + nlinarith + +/-- `setConstTM` fits the budget. -/ +theorem setConstTM_le_opBudget {c d M : ℕ} (hc : c ≤ M) (hd : d ≤ M) : + (2 * d + 4) + 1 + (c * (2 * c + 5) + 1) ≤ opBudget M := by + refine le_opBudget_of_le ?_ + have h1 : c * (2 * c + 5) ≤ M * (2 * M + 5) := Nat.mul_le_mul hc (by omega) + nlinarith + +/-- `emitLitTM` fits the budget. -/ +theorem emitLitTM_le_opBudget {v M : ℕ} (h : v ≤ M) : 3 * v + 9 ≤ opBudget M := + le_opBudget_of_le (by nlinarith) + +/-- `mulAddIntoTM` fits the budget, provided the accumulated product stays + below `M`. -/ +theorem mulAddIntoTM_le_opBudget {a b d M : ℕ} (ha : a ≤ M) (hb : b ≤ M) + (hd : d + a * b ≤ M) : + a * (mulAddBound a b d + 2) + (a + 2) ≤ opBudget M := by + have h1 : mulAddBound a b d ≤ M * (4 * M + 10) + (M + 2) := by + rw [mulAddBound] + exact Nat.add_le_add (Nat.mul_le_mul hb (by omega)) (by omega) + have h2 : a * (mulAddBound a b d + 2) + (a + 2) + ≤ M * ((M * (4 * M + 10) + (M + 2)) + 2) + (M + 2) := + Nat.add_le_add (Nat.mul_le_mul ha (by omega)) (by omega) + refine le_trans h2 ?_ + rw [opBudget] + nlinarith + +-- ════════════════════════════════════════════════════════════════════════ +-- setConstTM: load a fixedValue into a register +-- ════════════════════════════════════════════════════════════════════════ + +/-- `q := c` (clear, then increment `c` times). -/ +def setConstTM (q : Fin n) (c : ℕ) : TM n := + seqTM (clearRegTM q) (iterTM (incRegTM q) c) + +/-- **`setConstTM` Hoare specification.** -/ +theorem setConstTM_hoareTime (q : Fin n) (c d : ℕ) (inp₀ : Tape) + (work₀ : Fin n → Tape) (ys : List Bool) + (hinp₀ : Parked inp₀) (hwork₀ : ∀ i, Parked (work₀ i)) + (hq : work₀ q = regTape d) : + (setConstTM q c).HoareTime + (EmitPred inp₀ work₀ ys) + (EmitPred inp₀ (Function.update work₀ q (regTape c)) ys) + ((2 * d + 4) + 1 + (c * (2 * c + 5) + 1)) := by + have hclear := clearRegTM_hoareTime q d inp₀ work₀ ys hinp₀ + (fun i _ => hwork₀ i) hq + have hmidP : ∀ i, Parked (Function.update work₀ q (regTape 0) i) := by + intro i + by_cases hiq : i = q + · subst hiq; rw [Function.update_self]; exact parked_regTape _ + · rw [Function.update_of_ne hiq]; exact hwork₀ i + have hiter := iterTM_incRegTM_hoareTime q c 0 inp₀ (Function.update work₀ q (regTape 0)) + ys hinp₀ hmidP (by rw [Function.update_self]) + have hseq := seqTM_hoareTime (clearRegTM q) (iterTM (incRegTM q) c) hclear + (emitPred_transition hinp₀ hmidP ys) hiter + refine hseq.consequence (fun _ _ _ h => h) ?_ + (by simp only [Nat.zero_add]; exact le_refl _) + rintro inp work out ⟨h1, h2, h3⟩ + refine ⟨h1, ?_, h3⟩ + rw [h2, Function.update_idem, Nat.zero_add] + +-- ════════════════════════════════════════════════════════════════════════ +-- Horner layers: tmp := tmp · X + addend +-- ════════════════════════════════════════════════════════════════════════ + +/-- One Horner layer with a **register** addend: + `tmp := tmp · X + comp` (scratch `tmp2` ends holding the same value). -/ +def hornerLayerRegTM (X comp tmp tmp2 : Fin n) : TM n := + seqTM (clearRegTM tmp2) + (seqTM (mulAddIntoTM tmp X tmp2) + (seqTM (addIntoTM comp tmp2) (copyIntoTM tmp2 tmp))) + +/-- One Horner layer with a **fixedValue** addend: + `tmp := tmp · X + c` (scratch `tmp2` ends holding the same value). -/ +def hornerLayerConstTM (X tmp tmp2 : Fin n) (c : ℕ) : TM n := + seqTM (clearRegTM tmp2) + (seqTM (mulAddIntoTM tmp X tmp2) + (seqTM (iterTM (incRegTM tmp2) c) (copyIntoTM tmp2 tmp))) + +/-- The (uniform) time budget of one Horner layer. -/ +def layerBudget (M : ℕ) : ℕ := 4 * opBudget M + 3 + +section HornerLayer + +variable {X comp tmp tmp2 : Fin n} + +/-- **`hornerLayerRegTM` Hoare specification.** From `tmp = v`, `X = x`, + `comp = w` (and any `tmp2 = u`), reach `tmp = tmp2 = v·x + w` with all + other tapes untouched, within `layerBudget M` steps, provided every value + in play is at most `M`. -/ +theorem hornerLayerRegTM_hoareTime + (hXt : X ≠ tmp) (hXt2 : X ≠ tmp2) (htt2 : tmp ≠ tmp2) + (hct2 : comp ≠ tmp2) + (M x v w u : ℕ) (hx : x ≤ M) (hv : v ≤ M) (hu : u ≤ M) + (hres : v * x + w ≤ M) + (inp₀ : Tape) (work₀ : Fin n → Tape) (ys : List Bool) + (hinp₀ : Parked inp₀) (hwork₀ : ∀ i, Parked (work₀ i)) + (hX : work₀ X = regTape x) (hc : work₀ comp = regTape w) + (ht : work₀ tmp = regTape v) (ht2 : work₀ tmp2 = regTape u) : + (hornerLayerRegTM X comp tmp tmp2).HoareTime + (EmitPred inp₀ work₀ ys) + (EmitPred inp₀ + (Function.update (Function.update work₀ tmp2 (regTape (v * x + w))) tmp + (regTape (v * x + w))) ys) + (layerBudget M) := by + set A : Fin n → Tape := Function.update work₀ tmp2 (regTape 0) with hA + set B : Fin n → Tape := Function.update work₀ tmp2 (regTape (v * x)) with hB + set C : Fin n → Tape := Function.update work₀ tmp2 (regTape (v * x + w)) with hC + have hAP : ∀ i, Parked (A i) := by + intro i + by_cases hi : i = tmp2 + · subst hi; rw [hA, Function.update_self]; exact parked_regTape _ + · rw [hA, Function.update_of_ne hi]; exact hwork₀ i + have hBP : ∀ i, Parked (B i) := by + intro i + by_cases hi : i = tmp2 + · subst hi; rw [hB, Function.update_self]; exact parked_regTape _ + · rw [hB, Function.update_of_ne hi]; exact hwork₀ i + have hCP : ∀ i, Parked (C i) := by + intro i + by_cases hi : i = tmp2 + · subst hi; rw [hC, Function.update_self]; exact parked_regTape _ + · rw [hC, Function.update_of_ne hi]; exact hwork₀ i + -- Stage 1: clear tmp2. + have h₁ : (clearRegTM tmp2).HoareTime (EmitPred inp₀ work₀ ys) + (EmitPred inp₀ A ys) (opBudget M) := + (clearRegTM_hoareTime tmp2 u inp₀ work₀ ys hinp₀ + (fun i _ => hwork₀ i) ht2).mono_bound (clearRegTM_le_opBudget hu) + -- Stage 2: tmp2 += tmp · X. + have h₂ : (mulAddIntoTM tmp X tmp2).HoareTime (EmitPred inp₀ A ys) + (EmitPred inp₀ B ys) (opBudget M) := by + refine (mulAddIntoTM_hoareTime tmp X tmp2 (fun h => hXt h.symm) htt2 hXt2 + v x 0 inp₀ A ys hinp₀ (fun i _ => hAP i) + (by rw [hA, Function.update_of_ne htt2]; exact ht) + (by rw [hA, Function.update_of_ne hXt2]; exact hX) + (by rw [hA, Function.update_self])).consequence + (fun _ _ _ h => h) ?_ (mulAddIntoTM_le_opBudget hv hx (by omega)) + rintro inp work out ⟨g1, g2, g3⟩ + refine ⟨g1, ?_, g3⟩ + rw [g2, hA, Function.update_idem, Nat.zero_add, hB] + -- Stage 3: tmp2 += comp. + have h₃ : (addIntoTM comp tmp2).HoareTime (EmitPred inp₀ B ys) + (EmitPred inp₀ C ys) (opBudget M) := by + refine (addIntoTM_hoareTime comp tmp2 hct2 w (v * x) inp₀ B ys hinp₀ + (fun i _ => hBP i) + (by rw [hB, Function.update_of_ne hct2]; exact hc) + (by rw [hB, Function.update_self])).consequence + (fun _ _ _ h => h) ?_ (addIntoTM_le_opBudget (by omega) hres) + rintro inp work out ⟨g1, g2, g3⟩ + refine ⟨g1, ?_, g3⟩ + rw [g2, hB, Function.update_idem, hC] + -- Stage 4: tmp := tmp2. + have h₄ : (copyIntoTM tmp2 tmp).HoareTime (EmitPred inp₀ C ys) + (EmitPred inp₀ (Function.update C tmp (regTape (v * x + w))) ys) + (opBudget M) := by + refine (copyIntoTM_hoareTime tmp2 tmp (fun h => htt2 h.symm) (v * x + w) v + inp₀ C ys hinp₀ (fun i _ => hCP i) + (by rw [hC, Function.update_self]) + (by rw [hC, Function.update_of_ne htt2]; exact ht)).consequence + (fun _ _ _ h => h) (fun _ _ _ h => h) (copyIntoTM_le_opBudget hres hv) + -- Glue. + have h₃₄ := seqTM_hoareTime (addIntoTM comp tmp2) (copyIntoTM tmp2 tmp) h₃ + (emitPred_transition hinp₀ hCP ys) h₄ + have h₂₃₄ := seqTM_hoareTime (mulAddIntoTM tmp X tmp2) _ h₂ + (emitPred_transition hinp₀ hBP ys) h₃₄ + have h := seqTM_hoareTime (clearRegTM tmp2) _ h₁ + (emitPred_transition hinp₀ hAP ys) h₂₃₄ + refine h.consequence (fun _ _ _ hp => hp) ?_ (by rw [layerBudget]; omega) + rintro inp work out ⟨g1, g2, g3⟩ + exact ⟨g1, by rw [g2, hC], g3⟩ + +/-- **`hornerLayerConstTM` Hoare specification.** From `tmp = v`, `X = x` + (and any `tmp2 = u`), reach `tmp = tmp2 = v·x + c`. -/ +theorem hornerLayerConstTM_hoareTime + (hXt : X ≠ tmp) (hXt2 : X ≠ tmp2) (htt2 : tmp ≠ tmp2) + (M x v c u : ℕ) (hx : x ≤ M) (hv : v ≤ M) (hu : u ≤ M) + (hres : v * x + c ≤ M) + (inp₀ : Tape) (work₀ : Fin n → Tape) (ys : List Bool) + (hinp₀ : Parked inp₀) (hwork₀ : ∀ i, Parked (work₀ i)) + (hX : work₀ X = regTape x) + (ht : work₀ tmp = regTape v) (ht2 : work₀ tmp2 = regTape u) : + (hornerLayerConstTM X tmp tmp2 c).HoareTime + (EmitPred inp₀ work₀ ys) + (EmitPred inp₀ + (Function.update (Function.update work₀ tmp2 (regTape (v * x + c))) tmp + (regTape (v * x + c))) ys) + (layerBudget M) := by + set A : Fin n → Tape := Function.update work₀ tmp2 (regTape 0) with hA + set B : Fin n → Tape := Function.update work₀ tmp2 (regTape (v * x)) with hB + set C : Fin n → Tape := Function.update work₀ tmp2 (regTape (v * x + c)) with hC + have hAP : ∀ i, Parked (A i) := by + intro i + by_cases hi : i = tmp2 + · subst hi; rw [hA, Function.update_self]; exact parked_regTape _ + · rw [hA, Function.update_of_ne hi]; exact hwork₀ i + have hBP : ∀ i, Parked (B i) := by + intro i + by_cases hi : i = tmp2 + · subst hi; rw [hB, Function.update_self]; exact parked_regTape _ + · rw [hB, Function.update_of_ne hi]; exact hwork₀ i + have hCP : ∀ i, Parked (C i) := by + intro i + by_cases hi : i = tmp2 + · subst hi; rw [hC, Function.update_self]; exact parked_regTape _ + · rw [hC, Function.update_of_ne hi]; exact hwork₀ i + -- Stage 1: clear tmp2. + have h₁ : (clearRegTM tmp2).HoareTime (EmitPred inp₀ work₀ ys) + (EmitPred inp₀ A ys) (opBudget M) := + (clearRegTM_hoareTime tmp2 u inp₀ work₀ ys hinp₀ + (fun i _ => hwork₀ i) ht2).mono_bound (clearRegTM_le_opBudget hu) + -- Stage 2: tmp2 += tmp · X. + have h₂ : (mulAddIntoTM tmp X tmp2).HoareTime (EmitPred inp₀ A ys) + (EmitPred inp₀ B ys) (opBudget M) := by + refine (mulAddIntoTM_hoareTime tmp X tmp2 (fun h => hXt h.symm) htt2 hXt2 + v x 0 inp₀ A ys hinp₀ (fun i _ => hAP i) + (by rw [hA, Function.update_of_ne htt2]; exact ht) + (by rw [hA, Function.update_of_ne hXt2]; exact hX) + (by rw [hA, Function.update_self])).consequence + (fun _ _ _ h => h) ?_ (mulAddIntoTM_le_opBudget hv hx (by omega)) + rintro inp work out ⟨g1, g2, g3⟩ + refine ⟨g1, ?_, g3⟩ + rw [g2, hA, Function.update_idem, Nat.zero_add, hB] + -- Stage 3: tmp2 += c. + have h₃ : (iterTM (incRegTM tmp2) c).HoareTime (EmitPred inp₀ B ys) + (EmitPred inp₀ C ys) (opBudget M) := by + refine (iterTM_incRegTM_hoareTime tmp2 c (v * x) inp₀ B ys hinp₀ hBP + (by rw [hB, Function.update_self])).consequence + (fun _ _ _ h => h) ?_ (iterTM_incRegTM_le_opBudget hres) + rintro inp work out ⟨g1, g2, g3⟩ + refine ⟨g1, ?_, g3⟩ + rw [g2, hB, Function.update_idem, hC] + -- Stage 4: tmp := tmp2. + have h₄ : (copyIntoTM tmp2 tmp).HoareTime (EmitPred inp₀ C ys) + (EmitPred inp₀ (Function.update C tmp (regTape (v * x + c))) ys) + (opBudget M) := by + refine (copyIntoTM_hoareTime tmp2 tmp (fun h => htt2 h.symm) (v * x + c) v + inp₀ C ys hinp₀ (fun i _ => hCP i) + (by rw [hC, Function.update_self]) + (by rw [hC, Function.update_of_ne htt2]; exact ht)).consequence + (fun _ _ _ h => h) (fun _ _ _ h => h) (copyIntoTM_le_opBudget hres hv) + -- Glue. + have h₃₄ := seqTM_hoareTime (iterTM (incRegTM tmp2) c) (copyIntoTM tmp2 tmp) h₃ + (emitPred_transition hinp₀ hCP ys) h₄ + have h₂₃₄ := seqTM_hoareTime (mulAddIntoTM tmp X tmp2) _ h₂ + (emitPred_transition hinp₀ hBP ys) h₃₄ + have h := seqTM_hoareTime (clearRegTM tmp2) _ h₁ + (emitPred_transition hinp₀ hAP ys) h₂₃₄ + refine h.consequence (fun _ _ _ hp => hp) ?_ (by rw [layerBudget]; omega) + rintro inp work out ⟨g1, g2, g3⟩ + exact ⟨g1, by rw [g2, hC], g3⟩ + +end HornerLayer + +-- ════════════════════════════════════════════════════════════════════════ +-- Folding layers: polynomial evaluation +-- ════════════════════════════════════════════════════════════════════════ + +/-- Horner accumulator over a coefficient list (highest degree first). -/ +def hornerFold (x : ℕ) : List ℕ → ℕ → ℕ + | [], a => a + | c :: cs, a => hornerFold x cs (a * x + c) + +/-- `hornerFold` over the empty coefficient list returns the accumulator. -/ +@[simp] theorem hornerFold_nil (x a : ℕ) : hornerFold x [] a = a := rfl + +/-- Unfolding lemma: one Horner layer replaces the accumulator `a` by `a * x + c`. -/ +theorem hornerFold_cons (x c a : ℕ) (cs : List ℕ) : + hornerFold x (c :: cs) a = hornerFold x cs (a * x + c) := rfl + +/-- The Horner fold of a reversed coefficient window is the polynomial sum. -/ +theorem hornerFold_reverse_range (f : ℕ → ℕ) (x : ℕ) : + ∀ (k a : ℕ), + hornerFold x ((List.range k).map f).reverse a + = a * x ^ k + ∑ i ∈ Finset.range k, f i * x ^ i := by + intro k + induction k with + | zero => intro a; simp + | succ k ih => + intro a + rw [List.range_succ, List.map_append, List.reverse_append] + simp only [List.map_cons, List.map_nil, List.reverse_cons, List.reverse_nil, + List.nil_append, List.singleton_append] + rw [hornerFold_cons, ih, Finset.sum_range_succ] + ring + +/-- Crude but monotone bound on the Horner accumulator. -/ +theorem hornerFold_le (x : ℕ) : ∀ (cs : List ℕ) (a : ℕ), + hornerFold x cs a ≤ (a + cs.sum) * (x + 1) ^ cs.length := by + intro cs + induction cs with + | nil => intro a; simp + | cons c cs ih => + intro a + rw [hornerFold_cons] + refine le_trans (ih (a * x + c)) ?_ + rw [List.sum_cons, List.length_cons, pow_succ] + have h1 : a * x + c + cs.sum ≤ (a + (c + cs.sum)) * (x + 1) := by + have hexp : (a + (c + cs.sum)) * (x + 1) + = a * x + a + ((c + cs.sum) * x + (c + cs.sum)) := by ring + omega + calc (a * x + c + cs.sum) * (x + 1) ^ cs.length + ≤ ((a + (c + cs.sum)) * (x + 1)) * (x + 1) ^ cs.length := + Nat.mul_le_mul_right _ h1 + _ = (a + (c + cs.sum)) * ((x + 1) ^ cs.length * (x + 1)) := by ring + +/-- Every prefix of the Horner fold is bounded by the full coefficient sum + times the dominating power — the hypothesis-discharger for + `hornerLayersTM_hoareTime`'s value cap. -/ +theorem hornerFold_take_le (x : ℕ) (cs : List ℕ) (k : ℕ) : + hornerFold x (cs.take k) 0 ≤ (cs.sum + 1) * (x + 1) ^ cs.length := by + refine le_trans (hornerFold_le x _ 0) ?_ + have h1 : (cs.take k).sum ≤ cs.sum := by + conv_rhs => rw [← List.take_append_drop k cs] + rw [List.sum_append] + omega + have h2 : (x + 1) ^ (cs.take k).length ≤ (x + 1) ^ cs.length := + Nat.pow_le_pow_right (by omega) + (by rw [List.length_take]; omega) + calc (0 + (cs.take k).sum) * (x + 1) ^ (cs.take k).length + ≤ (cs.sum + 1) * (x + 1) ^ cs.length := + Nat.mul_le_mul (by omega) h2 + +/-- Fold Horner layers (fixedValue addends, highest first) over a register. -/ +def hornerLayersTM (X tmp tmp2 : Fin n) (cs : List ℕ) : TM n := + bigSeqTM (cs.map (hornerLayerConstTM X tmp tmp2)) + +/-- **`hornerLayersTM` Hoare specification** (nonempty coefficient list). + From `tmp = v`, reach `tmp = tmp2 = hornerFold x (c :: cs) v`, provided + every intermediate accumulator value is at most `M`. -/ +theorem hornerLayersTM_hoareTime (X tmp tmp2 : Fin n) + (hXt : X ≠ tmp) (hXt2 : X ≠ tmp2) (htt2 : tmp ≠ tmp2) + (M x : ℕ) (hx : x ≤ M) (inp₀ : Tape) (hinp₀ : Parked inp₀) : + ∀ (c : ℕ) (cs : List ℕ) (v u : ℕ) (work₀ : Fin n → Tape) (ys : List Bool), + (∀ k, k ≤ (c :: cs).length → hornerFold x (List.take k (c :: cs)) v ≤ M) → + u ≤ M → + (∀ i, Parked (work₀ i)) → + work₀ X = regTape x → work₀ tmp = regTape v → work₀ tmp2 = regTape u → + (hornerLayersTM X tmp tmp2 (c :: cs)).HoareTime + (EmitPred inp₀ work₀ ys) + (EmitPred inp₀ + (Function.update (Function.update work₀ tmp2 + (regTape (hornerFold x (c :: cs) v))) tmp + (regTape (hornerFold x (c :: cs) v))) ys) + ((c :: cs).length * (layerBudget M + 1) + 1) := by + intro c cs + induction cs generalizing c with + | nil => + intro v u work₀ ys hpre hu hwork₀ hX ht ht2 + have hv : v ≤ M := by + have := hpre 0 (by omega) + simpa using this + have hres : v * x + c ≤ M := by + have := hpre 1 (by simp) + simpa [hornerFold_cons] using this + have hlayer := hornerLayerConstTM_hoareTime hXt hXt2 htt2 M x v c u + hx hv hu hres inp₀ work₀ ys hinp₀ hwork₀ hX ht ht2 + set P : Fin n → Tape := + Function.update (Function.update work₀ tmp2 (regTape (v * x + c))) tmp + (regTape (v * x + c)) with hP + have hPP : ∀ i, Parked (P i) := by + intro i + by_cases hi : i = tmp + · subst hi; rw [hP, Function.update_self]; exact parked_regTape _ + · rw [hP, Function.update_of_ne hi] + by_cases hi2 : i = tmp2 + · subst hi2; rw [Function.update_self]; exact parked_regTape _ + · rw [Function.update_of_ne hi2]; exact hwork₀ i + have hskip := skipTM_hoareTime inp₀ P ys hinp₀ hPP + have hseq := seqTM_hoareTime (hornerLayerConstTM X tmp tmp2 c) skipTM hlayer + (emitPred_transition hinp₀ hPP ys) hskip + refine hseq.consequence (fun _ _ _ h => h) ?_ + (by simp only [List.length_cons, List.length_nil, Nat.zero_add, + Nat.one_mul]; omega) + rintro inp work out ⟨g1, g2, g3⟩ + exact ⟨g1, by rw [g2, hP, hornerFold_cons, hornerFold_nil], g3⟩ + | cons c' cs' ih => + intro v u work₀ ys hpre hu hwork₀ hX ht ht2 + have hv : v ≤ M := by + have := hpre 0 (by omega) + simpa using this + have hv₁ : v * x + c ≤ M := by + have := hpre 1 (by simp) + simpa [hornerFold_cons] using this + have hlayer := hornerLayerConstTM_hoareTime hXt hXt2 htt2 M x v c u + hx hv hu hv₁ inp₀ work₀ ys hinp₀ hwork₀ hX ht ht2 + set P : Fin n → Tape := + Function.update (Function.update work₀ tmp2 (regTape (v * x + c))) tmp + (regTape (v * x + c)) with hP + have hPP : ∀ i, Parked (P i) := by + intro i + by_cases hi : i = tmp + · subst hi; rw [hP, Function.update_self]; exact parked_regTape _ + · rw [hP, Function.update_of_ne hi] + by_cases hi2 : i = tmp2 + · subst hi2; rw [Function.update_self]; exact parked_regTape _ + · rw [Function.update_of_ne hi2]; exact hwork₀ i + have hpre' : ∀ k, k ≤ (c' :: cs').length → + hornerFold x (List.take k (c' :: cs')) (v * x + c) ≤ M := by + intro k hk + have := hpre (k + 1) (by simpa using Nat.succ_le_succ hk) + rwa [List.take_succ_cons, hornerFold_cons] at this + have hrest := ih c' (v * x + c) (v * x + c) P ys hpre' hv₁ hPP + (by rw [hP, Function.update_of_ne hXt, Function.update_of_ne hXt2]; exact hX) + (by rw [hP, Function.update_self]) + (by rw [hP, Function.update_of_ne (fun h => htt2 h.symm), + Function.update_self]) + have hseq := seqTM_hoareTime (hornerLayerConstTM X tmp tmp2 c) + (hornerLayersTM X tmp tmp2 (c' :: cs')) hlayer + (emitPred_transition hinp₀ hPP ys) hrest + refine hseq.consequence (fun _ _ _ h => h) ?_ ?_ + · rintro inp work out ⟨g1, g2, g3⟩ + refine ⟨g1, ?_, g3⟩ + rw [g2, hP, Function.update_comm htt2, Function.update_idem, + Function.update_idem, + show hornerFold x (c' :: cs') (v * x + c) + = hornerFold x (c :: c' :: cs') v from rfl] + · have hmul : (c :: c' :: cs').length * (layerBudget M + 1) + = (c' :: cs').length * (layerBudget M + 1) + (layerBudget M + 1) := by + rw [List.length_cons] + exact Nat.succ_mul .. + omega + +-- ════════════════════════════════════════════════════════════════════════ +-- polyEvalTM +-- ════════════════════════════════════════════════════════════════════════ + +/-- The coefficient list of `p`, highest degree first. -/ +def polyCoeffs (p : Polynomial ℕ) : List ℕ := + ((List.range (p.natDegree + 1)).map p.coeff).reverse + +/-- The coefficient list of a polynomial is never empty (it has `natDegree + 1` entries). -/ +theorem polyCoeffs_ne_nil (p : Polynomial ℕ) : polyCoeffs p ≠ [] := by + simp [polyCoeffs] + +/-- `polyCoeffs p` has exactly `p.natDegree + 1` entries. -/ +@[simp] theorem polyCoeffs_length (p : Polynomial ℕ) : + (polyCoeffs p).length = p.natDegree + 1 := by + simp [polyCoeffs] + +/-- **The Horner fold computes `p.eval`.** -/ +theorem hornerFold_polyCoeffs (p : Polynomial ℕ) (x : ℕ) : + hornerFold x (polyCoeffs p) 0 = p.eval x := by + rw [polyCoeffs, hornerFold_reverse_range, Polynomial.eval_eq_sum_range] + simp + +/-- `tmp := p.eval x`, reading `x` from register `X` (Horner's rule over the + hardwired coefficient list; `tmp2` is scratch and ends equal to `tmp`). -/ +def polyEvalTM (X tmp tmp2 : Fin n) (p : Polynomial ℕ) : TM n := + seqTM (setConstTM tmp 0) (hornerLayersTM X tmp tmp2 (polyCoeffs p)) + +/-- **`polyEvalTM` Hoare specification.** From `X = x` (and any `tmp = v`, + `tmp2 = u`), reach `tmp = tmp2 = p.eval x`, provided `M` caps `x`, the + starting scratch values, and every Horner prefix value. -/ +theorem polyEvalTM_hoareTime (X tmp tmp2 : Fin n) + (hXt : X ≠ tmp) (hXt2 : X ≠ tmp2) (htt2 : tmp ≠ tmp2) + (p : Polynomial ℕ) (M x v u : ℕ) (hx : x ≤ M) (hv : v ≤ M) (hu : u ≤ M) + (hpre : ∀ k, k ≤ p.natDegree + 1 → + hornerFold x (List.take k (polyCoeffs p)) 0 ≤ M) + (inp₀ : Tape) (work₀ : Fin n → Tape) (ys : List Bool) + (hinp₀ : Parked inp₀) (hwork₀ : ∀ i, Parked (work₀ i)) + (hX : work₀ X = regTape x) (ht : work₀ tmp = regTape v) + (ht2 : work₀ tmp2 = regTape u) : + (polyEvalTM X tmp tmp2 p).HoareTime + (EmitPred inp₀ work₀ ys) + (EmitPred inp₀ + (Function.update (Function.update work₀ tmp2 (regTape (p.eval x))) tmp + (regTape (p.eval x))) ys) + (opBudget M + 1 + ((p.natDegree + 1) * (layerBudget M + 1) + 1)) := by + have hset := (setConstTM_hoareTime tmp 0 v inp₀ work₀ ys hinp₀ hwork₀ + ht).mono_bound (setConstTM_le_opBudget (by omega) hv) + set A : Fin n → Tape := Function.update work₀ tmp (regTape 0) with hA + have hAP : ∀ i, Parked (A i) := by + intro i + by_cases hi : i = tmp + · subst hi; rw [hA, Function.update_self]; exact parked_regTape _ + · rw [hA, Function.update_of_ne hi]; exact hwork₀ i + obtain ⟨c, cs, hcs⟩ := List.exists_cons_of_ne_nil (polyCoeffs_ne_nil p) + have hlen : (c :: cs).length = p.natDegree + 1 := by + rw [← hcs, polyCoeffs_length] + have hrest := hornerLayersTM_hoareTime X tmp tmp2 hXt hXt2 htt2 M x hx inp₀ + hinp₀ c cs 0 u A ys + (by rw [← hcs, polyCoeffs_length]; exact hpre) + hu hAP + (by rw [hA, Function.update_of_ne hXt]; exact hX) + (by rw [hA, Function.update_self]) + (by rw [hA, Function.update_of_ne (fun h => htt2 h.symm)]; exact ht2) + have heval : hornerFold x (c :: cs) 0 = p.eval x := by + rw [← hcs, hornerFold_polyCoeffs] + rw [heval] at hrest + have hseq := seqTM_hoareTime (setConstTM tmp 0) + (hornerLayersTM X tmp tmp2 (c :: cs)) hset + (emitPred_transition hinp₀ hAP ys) hrest + have hmach : polyEvalTM X tmp tmp2 p + = seqTM (setConstTM tmp 0) (hornerLayersTM X tmp tmp2 (c :: cs)) := by + rw [polyEvalTM, hcs] + rw [hmach] + refine hseq.consequence (fun _ _ _ h => h) ?_ (by rw [hlen]) + rintro inp work out ⟨g1, g2, g3⟩ + refine ⟨g1, ?_, g3⟩ + rw [g2, hA, Function.update_comm htt2, Function.update_idem] + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Registers/InputLen.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Registers/InputLen.lean new file mode 100644 index 0000000000..932e0a0b86 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Registers/InputLen.lean @@ -0,0 +1,486 @@ +/- +Copyright (c) 2025 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Registers.RegisterOps + +/-! +# Input length into a register + +`inputLenRegTM q` scans the input tape in lockstep with register `q`, writing +one mark per input bit, then rewinds both heads to cell 1: from the bumped +initial configuration it puts `regTape |x|` in register `q`, restoring the input +tape exactly. This is the reduction emitter's only input-reading machine +besides the start-clause emitter, and the last hand-rolled machine of the +campaign (`docs/A5-ReductionEmitter.md`). +-/ + + +public section + +namespace Complexity + +namespace TM + +variable {n : ℕ} + +/-- **Measure the input length into register `q`**: lockstep scan right over + the input bits writing marks, then lockstep rewind. -/ +def inputLenRegTM (q : Fin n) : TM n where + Q := IncPhase + qstart := .scan + qhalt := .done + δ := fun s iHead wHeads oHead => + match s with + | .scan => + if iHead = Γ.blank then + (.back, fun i => readBackWrite (wHeads i), readBackWrite oHead, + Dir3.left, + fun i => if i = q then (if wHeads q = Γ.start then Dir3.right else Dir3.left) + else idleDir (wHeads i), + idleDir oHead) + else if iHead = Γ.start then + (.scan, fun i => readBackWrite (wHeads i), readBackWrite oHead, + Dir3.right, fun i => idleDir (wHeads i), idleDir oHead) + else + (.scan, fun i => if i = q then Γw.one else readBackWrite (wHeads i), + readBackWrite oHead, Dir3.right, + fun i => if i = q then Dir3.right else idleDir (wHeads i), + idleDir oHead) + | .back => + if wHeads q = Γ.start then + (.park, fun i => readBackWrite (wHeads i), readBackWrite oHead, + Dir3.right, fun i => if i = q then Dir3.right else idleDir (wHeads i), + idleDir oHead) + else + (.back, fun i => readBackWrite (wHeads i), readBackWrite oHead, + (if iHead = Γ.start then Dir3.right else Dir3.left), + fun i => if i = q then Dir3.left else idleDir (wHeads i), + idleDir oHead) + | .park => + (.done, fun i => readBackWrite (wHeads i), readBackWrite oHead, + idleDir iHead, fun i => idleDir (wHeads i), idleDir oHead) + | .done => allIdle s iHead wHeads oHead + δ_right_of_start := by + intro s iHead wHeads oHead + match s with + | .scan => + dsimp only [] + split + · next hbl => + refine ⟨fun hi => absurd hi (by rw [hbl]; decide), fun i hi => ?_, + idleDir_right_of_start⟩ + dsimp only [] + by_cases hir : i = q + · subst hir; rw [if_pos rfl, if_pos hi] + · rw [if_neg hir]; exact idleDir_right_of_start hi + · split + · exact ⟨fun _ => rfl, fun i hi => idleDir_right_of_start hi, + idleDir_right_of_start⟩ + · refine ⟨fun _ => rfl, fun i hi => ?_, idleDir_right_of_start⟩ + dsimp only [] + by_cases hir : i = q + · rw [if_pos hir] + · rw [if_neg hir]; exact idleDir_right_of_start hi + | .back => + dsimp only [] + split + · refine ⟨fun _ => rfl, fun i hi => ?_, idleDir_right_of_start⟩ + dsimp only [] + by_cases hir : i = q + · rw [if_pos hir] + · rw [if_neg hir]; exact idleDir_right_of_start hi + · next hns => + refine ⟨fun hi => by rw [if_pos hi], fun i hi => ?_, idleDir_right_of_start⟩ + dsimp only [] + by_cases hir : i = q + · subst hir; exact absurd hi hns + · rw [if_neg hir]; exact idleDir_right_of_start hi + | .park => + exact ⟨idleDir_right_of_start, fun _ => idleDir_right_of_start, + idleDir_right_of_start⟩ + | .done => exact rightOfStart_allIdle iHead wHeads oHead + +section InputLen + +variable {q : Fin n} + +private theorem inputLenRegTM_ne_halt {s : IncPhase} (h : s ≠ .done) + {c : Cfg n (inputLenRegTM (n := n) q).Q} (hst : c.state = s) : + ¬ c.state = (inputLenRegTM (n := n) q).qhalt := by + rw [hst] + show ¬ s = IncPhase.done + exact h + +/-- `scan` over a bit: mark the register, advance both heads. -/ +private theorem inputLenRegTM_step_scan_bit (c : Cfg n (inputLenRegTM (n := n) q).Q) + (hst : c.state = .scan) (hbl : c.input.read ≠ Γ.blank) + (hns : c.input.read ≠ Γ.start) + (hwork : ∀ i, i ≠ q → Parked (c.work i)) (hout : Parked c.output) : + (inputLenRegTM (n := n) q).step c = some + { state := .scan, input := c.input.move .right, + work := Function.update c.work q + (((c.work q).write Γw.one).move .right), + output := c.output } := by + rw [TM.step, if_neg (inputLenRegTM_ne_halt (by decide) hst)] + simp only [inputLenRegTM, hst, hbl, hns, ↓reduceIte] + refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, rfl, ?_, ?_⟩) + · funext i + by_cases hir : i = q + · subst hir + simp only [↓reduceIte, Function.update_self] + · rw [if_neg hir, if_neg hir, Function.update_of_ne hir] + exact (hwork i hir).writeAndMove_readBack_idle + · exact hout.writeAndMove_readBack_idle + +/-- `scan` at the input's first blank: turn both heads around. -/ +private theorem inputLenRegTM_step_scan_blank (c : Cfg n (inputLenRegTM (n := n) q).Q) + (hst : c.state = .scan) (hbl : c.input.read = Γ.blank) + (hqns : (c.work q).read ≠ Γ.start) + (hwork : ∀ i, i ≠ q → Parked (c.work i)) (hout : Parked c.output) : + (inputLenRegTM (n := n) q).step c = some + { state := .back, input := c.input.move .left, + work := Function.update c.work q ((c.work q).move .left), + output := c.output } := by + rw [TM.step, if_neg (inputLenRegTM_ne_halt (by decide) hst)] + simp only [inputLenRegTM, hst, hbl, ↓reduceIte] + refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, rfl, ?_, ?_⟩) + · funext i + by_cases hir : i = q + · subst hir + rw [if_pos rfl, if_neg hqns, Function.update_self, + writeAndMove_readBack _ hqns] + · rw [if_neg hir, Function.update_of_ne hir] + exact (hwork i hir).writeAndMove_readBack_idle + · exact hout.writeAndMove_readBack_idle + +/-- `back` off the sentinel: both heads keep rewinding. -/ +private theorem inputLenRegTM_step_back_left (c : Cfg n (inputLenRegTM (n := n) q).Q) + (hst : c.state = .back) (hqns : (c.work q).read ≠ Γ.start) + (hins : c.input.read ≠ Γ.start) + (hwork : ∀ i, i ≠ q → Parked (c.work i)) (hout : Parked c.output) : + (inputLenRegTM (n := n) q).step c = some + { state := .back, input := c.input.move .left, + work := Function.update c.work q ((c.work q).move .left), + output := c.output } := by + rw [TM.step, if_neg (inputLenRegTM_ne_halt (by decide) hst)] + simp only [inputLenRegTM, hst, hqns, hins, ↓reduceIte] + refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, rfl, ?_, ?_⟩) + · funext i + by_cases hir : i = q + · subst hir + rw [if_pos rfl, Function.update_self, writeAndMove_readBack _ hqns] + · rw [if_neg hir, Function.update_of_ne hir] + exact (hwork i hir).writeAndMove_readBack_idle + · exact hout.writeAndMove_readBack_idle + +/-- `back` on the sentinel: both heads step right to cell 1 and park. -/ +private theorem inputLenRegTM_step_back_start (c : Cfg n (inputLenRegTM (n := n) q).Q) + (hst : c.state = .back) (hs : (c.work q).read = Γ.start) + (hcr : ∀ j, 1 ≤ j → (c.work q).cells j ≠ Γ.start) + (hwork : ∀ i, i ≠ q → Parked (c.work i)) (hout : Parked c.output) : + (inputLenRegTM (n := n) q).step c = some + { state := .park, input := c.input.move .right, + work := Function.update c.work q ((c.work q).move .right), + output := c.output } := by + have h0 : (c.work q).head = 0 := by + by_contra hc + exact hcr _ (by omega) hs + rw [TM.step, if_neg (inputLenRegTM_ne_halt (by decide) hst)] + simp only [inputLenRegTM, hst, hs, ↓reduceIte] + refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, rfl, ?_, ?_⟩) + · funext i + by_cases hir : i = q + · subst hir + rw [if_pos rfl, Function.update_self] + show ((c.work i).write _).move Dir3.right = (c.work i).move .right + congr 1 + rw [Tape.write, if_pos h0] + · rw [if_neg hir, Function.update_of_ne hir] + exact (hwork i hir).writeAndMove_readBack_idle + · exact hout.writeAndMove_readBack_idle + +/-- `park`: one idle step into `done` (parked tapes everywhere). -/ +private theorem inputLenRegTM_step_park (c : Cfg n (inputLenRegTM (n := n) q).Q) + (hst : c.state = .park) (hinp : Parked c.input) + (hwork : ∀ i, Parked (c.work i)) (hout : Parked c.output) : + (inputLenRegTM (n := n) q).step c = some + { state := .done, input := c.input, work := c.work, output := c.output } := by + rw [TM.step, if_neg (inputLenRegTM_ne_halt (by decide) hst)] + simp only [inputLenRegTM, hst] + refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, ?_, ?_, ?_⟩) + · exact hinp.move_idle + · funext i + exact (hwork i).writeAndMove_readBack_idle + · exact hout.writeAndMove_readBack_idle + +/-- The lockstep scan: one mark per input bit. -/ +private theorem inputLenRegTM_scan_run (x : List Bool) (m : ℕ) : + ∀ (k : ℕ), x.length = k + m → + ∀ (c : Cfg n (inputLenRegTM (n := n) q).Q), + c.state = .scan → + c.input.cells = (Tape.init (x.map Γ.ofBool)).cells → c.input.head = k + 1 → + (∀ i, i ≠ q → Parked (c.work i)) → Parked c.output → + (c.work q).cells = regCells k → (c.work q).head = k + 1 → + ∃ c', (inputLenRegTM (n := n) q).reachesIn m c c' ∧ + c'.state = .scan ∧ + c'.input.cells = (Tape.init (x.map Γ.ofBool)).cells ∧ + c'.input.head = x.length + 1 ∧ + (∀ i, i ≠ q → c'.work i = c.work i) ∧ + (c'.work q).cells = regCells x.length ∧ + (c'.work q).head = x.length + 1 ∧ + c'.output = c.output := by + induction m with + | zero => + intro k hk c hst hic hih hwork hout hqc hqh + obtain rfl : x.length = k := by omega + exact ⟨c, .zero, hst, hic, hih, fun _ _ => rfl, hqc, hqh, rfl⟩ + | succ m ih => + intro k hk c hst hic hih hwork hout hqc hqh + have hread : c.input.read = Γ.ofBool (x[k]'(by omega)) := by + rw [Tape.read, hih, hic] + exact Tape.init_ofBool_cells_lt x k (by omega) + have hbl : c.input.read ≠ Γ.blank := by + rw [hread] + exact Γ.ofBool_ne_blank _ + have hns : c.input.read ≠ Γ.start := by + rw [hread] + exact Γ.ofBool_ne_start _ + have hstep := inputLenRegTM_step_scan_bit c hst hbl hns hwork hout + have hq₁cells : (((c.work q).write Γw.one).move .right).cells + = regCells (k + 1) := by + show ((c.work q).write Γw.one).cells = _ + rw [Tape.write, if_neg (by rw [hqh]; omega)] + show Function.update (c.work q).cells (c.work q).head Γw.one.toΓ = _ + rw [hqh, hqc] + exact regCells_update_succ k + have hq₁head : (((c.work q).write Γw.one).move .right).head = (k + 1) + 1 := by + show ((c.work q).write Γw.one).head + 1 = _ + rw [Tape.write_head, hqh] + obtain ⟨c', hreach, h1, h2, h3, h4, h5, h6, h7⟩ := + ih (k + 1) (by omega) + { state := .scan, input := c.input.move .right, + work := Function.update c.work q (((c.work q).write Γw.one).move .right), + output := c.output } rfl + (by show (c.input.move .right).cells = _ + rw [Tape.move_cells] + exact hic) + (by show c.input.head + 1 = (k + 1) + 1 + rw [hih]) + (fun i hi => by + show Parked (Function.update c.work q _ i) + rw [Function.update_of_ne hi] + exact hwork i hi) + hout + (by show (Function.update c.work q _ q).cells = _ + rw [Function.update_self] + exact hq₁cells) + (by show (Function.update c.work q _ q).head = _ + rw [Function.update_self] + exact hq₁head) + refine ⟨c', .step hstep hreach, h1, h2, h3, ?_, h5, h6, h7⟩ + intro i hi + rw [h4 i hi] + show Function.update c.work q _ i = c.work i + rw [Function.update_of_ne hi] + +/-- The lockstep rewind: both heads return to cell 1. -/ +private theorem inputLenRegTM_back_run (x : List Bool) (h : ℕ) : + ∀ (c : Cfg n (inputLenRegTM (n := n) q).Q), + c.state = .back → + c.input.cells = (Tape.init (x.map Γ.ofBool)).cells → c.input.head = h → + (∀ i, i ≠ q → Parked (c.work i)) → Parked c.output → + (c.work q).cells 0 = Γ.start → + (∀ j, 1 ≤ j → (c.work q).cells j ≠ Γ.start) → + (c.work q).head = h → + ∃ c', (inputLenRegTM (n := n) q).reachesIn (h + 2) c c' ∧ + c'.state = .done ∧ + c'.input.cells = (Tape.init (x.map Γ.ofBool)).cells ∧ c'.input.head = 1 ∧ + (∀ i, i ≠ q → c'.work i = c.work i) ∧ + (c'.work q).cells = (c.work q).cells ∧ (c'.work q).head = 1 ∧ + c'.output = c.output := by + induction h with + | zero => + intro c hst hic hih hwork hout hc0 hcr hqh + have hs : (c.work q).read = Γ.start := by rw [Tape.read, hqh]; exact hc0 + have hstep₁ := inputLenRegTM_step_back_start c hst hs hcr hwork hout + have hparkP : Parked (c.input.move .right) := by + refine ⟨?_, fun j hj => ?_⟩ + · show c.input.head + 1 ≥ 1 + omega + · show (c.input.move .right).cells j ≠ Γ.start + rw [Tape.move_cells, hic] + exact Tape.init_ofBool_cells_ne_start x j hj + have hstep₂ := inputLenRegTM_step_park (q := q) + { state := .park, input := c.input.move .right, + work := Function.update c.work q ((c.work q).move .right), + output := c.output } rfl hparkP + (fun i => by + by_cases hir : i = q + · subst hir + show Parked (Function.update c.work i ((c.work i).move .right) i) + rw [Function.update_self] + exact ⟨by show (c.work i).head + 1 ≥ 1; omega, fun j hj => hcr j hj⟩ + · show Parked (Function.update c.work q ((c.work q).move .right) i) + rw [Function.update_of_ne hir] + exact hwork i hir) + hout + refine ⟨_, .step hstep₁ (.step hstep₂ .zero), rfl, ?_, ?_, ?_, ?_, ?_, rfl⟩ + · show (c.input.move .right).cells = _ + rw [Tape.move_cells] + exact hic + · show c.input.head + 1 = 1 + rw [hih] + · intro i hi + show Function.update c.work q ((c.work q).move .right) i = c.work i + rw [Function.update_of_ne hi] + · show (Function.update c.work q ((c.work q).move .right) q).cells = _ + rw [Function.update_self] + rfl + · show (Function.update c.work q ((c.work q).move .right) q).head = 1 + rw [Function.update_self] + show (c.work q).head + 1 = 1 + rw [hqh] + | succ h ih => + intro c hst hic hih hwork hout hc0 hcr hqh + have hqns : (c.work q).read ≠ Γ.start := by + rw [Tape.read, hqh] + exact hcr (h + 1) (by omega) + have hins : c.input.read ≠ Γ.start := by + rw [Tape.read, hih, hic] + exact Tape.init_ofBool_cells_ne_start x _ (by omega) + have hstep₁ := inputLenRegTM_step_back_left c hst hqns hins hwork hout + obtain ⟨c', hreach, h1, h2, h3, h4, h5, h6, h7⟩ := + ih { state := .back, input := c.input.move .left, + work := Function.update c.work q ((c.work q).move .left), + output := c.output } rfl + (by show (c.input.move .left).cells = _ + rw [Tape.move_cells] + exact hic) + (by show c.input.head - 1 = h + rw [hih] + omega) + (fun i hi => by + show Parked (Function.update c.work q ((c.work q).move .left) i) + rw [Function.update_of_ne hi] + exact hwork i hi) + hout + (by show (Function.update c.work q _ q).cells 0 = _ + rw [Function.update_self] + exact hc0) + (fun j hj => by + show (Function.update c.work q _ q).cells j ≠ _ + rw [Function.update_self] + exact hcr j hj) + (by show (Function.update c.work q _ q).head = h + rw [Function.update_self] + show (c.work q).head - 1 = h + rw [hqh] + omega) + refine ⟨c', .step hstep₁ hreach, h1, h2, h3, ?_, ?_, h6, h7⟩ + · intro i hi + rw [h4 i hi] + show Function.update c.work q ((c.work q).move .left) i = c.work i + rw [Function.update_of_ne hi] + · rw [h5] + show (Function.update c.work q ((c.work q).move .left) q).cells = _ + rw [Function.update_self] + rfl + +/-- **`inputLenRegTM` Hoare specification.** From the bumped initial input and + `regTape 0` in `q`, reach `regTape |x|` in `q`, restoring the input exactly. -/ +theorem inputLenRegTM_hoareTime (q : Fin n) (x : List Bool) + (work₀ : Fin n → Tape) (ys : List Bool) + (hwork₀ : ∀ i, i ≠ q → Parked (work₀ i)) (hq : work₀ q = regTape 0) : + (inputLenRegTM (n := n) q).HoareTime + (EmitPred ⟨1, (Tape.init (x.map Γ.ofBool)).cells⟩ work₀ ys) + (EmitPred ⟨1, (Tape.init (x.map Γ.ofBool)).cells⟩ + (Function.update work₀ q (regTape x.length)) ys) + (2 * x.length + 4) := by + rintro inp work out ⟨rfl, rfl, hout⟩ + obtain ⟨c₁, hreach₁, h1, h2, h3, h4, h5, h6, h7⟩ := + inputLenRegTM_scan_run x x.length 0 (by omega) + { state := .scan, input := ⟨1, (Tape.init (x.map Γ.ofBool)).cells⟩, + work := work, output := out } rfl rfl rfl + hwork₀ hout.parked + (by show (work q).cells = regCells 0; rw [hq, regT_cells]) + (by show (work q).head = 0 + 1; rw [hq, regT_head]) + have hworkP₁ : ∀ i, i ≠ q → Parked (c₁.work i) := fun i hi => by + rw [h4 i hi] + exact hwork₀ i hi + have houtP₁ : Parked c₁.output := by rw [h7]; exact hout.parked + have hibl : c₁.input.read = Γ.blank := by + rw [Tape.read, h3, h2] + exact Tape.init_ofBool_cells_ge x x.length (le_refl _) + have hqns₁ : (c₁.work q).read ≠ Γ.start := by + rw [Tape.read, h6, h5] + show regCells x.length (x.length + 1) ≠ Γ.start + rw [regCells_blank (le_refl _)] + decide + have hstep₂ := inputLenRegTM_step_scan_blank c₁ h1 hibl hqns₁ hworkP₁ houtP₁ + obtain ⟨c₃, hreach₃, g1, g2, g3, g4, g5, g6, g7⟩ := + inputLenRegTM_back_run x x.length + { state := .back, input := c₁.input.move .left, + work := Function.update c₁.work q ((c₁.work q).move .left), + output := c₁.output } rfl + (by show (c₁.input.move .left).cells = _ + rw [Tape.move_cells] + exact h2) + (by show c₁.input.head - 1 = x.length + rw [h3] + omega) + (fun i hi => by + show Parked (Function.update c₁.work q ((c₁.work q).move .left) i) + rw [Function.update_of_ne hi] + exact hworkP₁ i hi) + houtP₁ + (by show (Function.update c₁.work q _ q).cells 0 = _ + rw [Function.update_self] + show (c₁.work q).cells 0 = _ + rw [h5] + rfl) + (fun j hj => by + show (Function.update c₁.work q _ q).cells j ≠ _ + rw [Function.update_self] + show (c₁.work q).cells j ≠ _ + rw [h5] + show regCells x.length j ≠ Γ.start + rw [regCells, if_neg (by omega)] + split <;> decide) + (by show (Function.update c₁.work q _ q).head = x.length + rw [Function.update_self] + show (c₁.work q).head - 1 = x.length + rw [h6] + omega) + refine ⟨c₃, x.length + ((x.length + 2) + 1), by omega, + reachesIn_trans _ hreach₁ (.step hstep₂ hreach₃), g1, ?_, ?_, ?_⟩ + · refine Tape.ext ?_ ?_ + · rw [g3] + · rw [g2] + · funext i + by_cases hir : i = q + · subst hir + rw [Function.update_self] + refine Tape.ext ?_ ?_ + · rw [g6] + rfl + · rw [g5] + show (Function.update c₁.work i ((c₁.work i).move .left) i).cells = _ + rw [Function.update_self] + show (c₁.work i).cells = _ + rw [h5, regT_cells] + · rw [Function.update_of_ne hir, g4 i hir] + show Function.update c₁.work q ((c₁.work q).move .left) i = work i + rw [Function.update_of_ne hir] + exact h4 i hir + · rw [g7, h7] + exact hout + +end InputLen + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Registers/RegisterOps.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Registers/RegisterOps.lean new file mode 100644 index 0000000000..f30f749443 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Registers/RegisterOps.lean @@ -0,0 +1,961 @@ +/- +Copyright (c) 2025 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Registers.Emit + +/-! +# Register operations + +The hand-rolled core machines of the reduction emitter's register calculus +(`docs/A5-ReductionEmitter.md`): `skipTM` (a one-step no-op, the fold +identity), `incRegTM` (append one mark to a register), and `clearRegTM` +(blank a register). All register arithmetic (addition, multiplication, +polynomial evaluation) composes from these via the `forRegTM` loop +combinator. + +Specs are in the ghost-parametrized `EmitPred` style: registers are the +canonical tapes `regTape v`, and posts are `Function.update` equations. +-/ + + +@[expose] public section + +namespace Complexity + +namespace TM + +variable {n : ℕ} + +-- ════════════════════════════════════════════════════════════════════════ +-- skipTM: the one-step no-op +-- ════════════════════════════════════════════════════════════════════════ + +/-- One idle step and halt: the identity for `seqTM` folds. -/ +def skipTM : TM n where + Q := BumpPhase + qstart := .go + qhalt := .done + δ := fun _ iHead wHeads oHead => + (.done, fun i => readBackWrite (wHeads i), readBackWrite oHead, + idleDir iHead, fun i => idleDir (wHeads i), idleDir oHead) + δ_right_of_start := fun _ _ _ _ => + ⟨idleDir_right_of_start, fun _ => idleDir_right_of_start, idleDir_right_of_start⟩ + +/-- `skipTM` changes nothing (parked tapes). -/ +theorem skipTM_hoareTime (inp₀ : Tape) (work₀ : Fin n → Tape) (ys : List Bool) + (hinp₀ : Parked inp₀) (hwork₀ : ∀ i, Parked (work₀ i)) : + (skipTM (n := n)).HoareTime + (EmitPred inp₀ work₀ ys) (EmitPred inp₀ work₀ ys) 1 := by + rintro inp work out ⟨rfl, rfl, hout⟩ + have hstep : (skipTM (n := n)).step + { state := .go, input := inp, work := work, output := out } = some + { state := .done, input := inp, work := work, output := out } := by + simp only [TM.step, skipTM, reduceCtorEq, ↓reduceIte] + refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, ?_, ?_, ?_⟩) + · exact hinp₀.move_idle + · funext i + exact (hwork₀ i).writeAndMove_readBack_idle + · exact hout.parked.writeAndMove_readBack_idle + exact ⟨_, 1, le_refl 1, .step hstep .zero, rfl, rfl, rfl, hout⟩ + +/-- `skipTM` preserves an arbitrary fully parked tape frame exactly. -/ +theorem skipTM_hoareTime_frame (inp₀ : Tape) (work₀ : Fin n → Tape) + (out₀ : Tape) (hinput : Parked inp₀) (hwork : ∀ i, Parked (work₀ i)) + (houtput : Parked out₀) : + (skipTM (n := n)).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + 1 := by + rintro inp work out ⟨hinp, hworkEq, hout⟩ + subst inp + subst work + subst out + let c' : Cfg n (skipTM (n := n)).Q := + { state := (skipTM (n := n)).qhalt + input := inp₀ + work := work₀ + output := out₀ } + have hstep : (skipTM (n := n)).step + { state := (skipTM (n := n)).qstart + input := inp₀ + work := work₀ + output := out₀ } = some c' := by + simp only [TM.step, skipTM, reduceCtorEq, ↓reduceIte, c'] + refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, ?_, ?_, ?_⟩) + · exact hinput.move_idle + · funext i + exact (hwork i).writeAndMove_readBack_idle + · exact houtput.writeAndMove_readBack_idle + exact ⟨c', 1, le_rfl, .step hstep .zero, rfl, rfl, rfl, rfl⟩ + +-- ════════════════════════════════════════════════════════════════════════ +-- incRegTM: append one mark to a register +-- ════════════════════════════════════════════════════════════════════════ + +/-- State set shared by `incRegTM` and `clearRegTM`: `scan` sweeps right over + the marks, `back` rewinds to the sentinel, `park` steps onto cell 1, and + `done` halts. -/ +inductive IncPhase where + | scan | back | park | done + deriving DecidableEq + +/-- `IncPhase` is finite (it has exactly four states). -/ +instance : Fintype IncPhase where + elems := {.scan, .back, .park, .done} + complete := fun x => by cases x <;> simp + +/-- **Increment register `q`**: scan right over the marks, write a mark on the + first blank, rewind to cell 1. From `regTape d` to `regTape (d + 1)` in + `2d + 4` steps; every other tape untouched. -/ +def incRegTM (q : Fin n) : TM n where + Q := IncPhase + qstart := .scan + qhalt := .done + δ := fun s iHead wHeads oHead => + match s with + | .scan => + if wHeads q = Γ.one then + (.scan, fun i => readBackWrite (wHeads i), readBackWrite oHead, + idleDir iHead, fun i => if i = q then Dir3.right else idleDir (wHeads i), + idleDir oHead) + else + (.back, fun i => if i = q then Γw.one else readBackWrite (wHeads i), + readBackWrite oHead, idleDir iHead, + fun i => if i = q then (if wHeads q = Γ.start then Dir3.right else Dir3.left) + else idleDir (wHeads i), + idleDir oHead) + | .back => + if wHeads q = Γ.start then + (.park, fun i => readBackWrite (wHeads i), readBackWrite oHead, + idleDir iHead, fun i => if i = q then Dir3.right else idleDir (wHeads i), + idleDir oHead) + else + (.back, fun i => readBackWrite (wHeads i), readBackWrite oHead, + idleDir iHead, fun i => if i = q then Dir3.left else idleDir (wHeads i), + idleDir oHead) + | .park => + (.done, fun i => readBackWrite (wHeads i), readBackWrite oHead, + idleDir iHead, fun i => idleDir (wHeads i), idleDir oHead) + | .done => allIdle s iHead wHeads oHead + δ_right_of_start := by + intro s iHead wHeads oHead + match s with + | .scan => + dsimp only [] + split + · next hone => + refine ⟨idleDir_right_of_start, fun i hi => ?_, idleDir_right_of_start⟩ + dsimp only [] + by_cases hir : i = q + · subst hir; rw [hone] at hi; exact absurd hi (by decide) + · rw [if_neg hir]; exact idleDir_right_of_start hi + · next hnone => + refine ⟨idleDir_right_of_start, fun i hi => ?_, idleDir_right_of_start⟩ + dsimp only [] + by_cases hir : i = q + · subst hir; rw [if_pos rfl, if_pos hi] + · rw [if_neg hir]; exact idleDir_right_of_start hi + | .back => + dsimp only [] + split + · refine ⟨idleDir_right_of_start, fun i hi => ?_, idleDir_right_of_start⟩ + dsimp only [] + by_cases hir : i = q + · rw [if_pos hir] + · rw [if_neg hir]; exact idleDir_right_of_start hi + · next hns => + refine ⟨idleDir_right_of_start, fun i hi => ?_, idleDir_right_of_start⟩ + dsimp only [] + by_cases hir : i = q + · subst hir; exact absurd hi hns + · rw [if_neg hir]; exact idleDir_right_of_start hi + | .park => + exact ⟨idleDir_right_of_start, fun _ => idleDir_right_of_start, + idleDir_right_of_start⟩ + | .done => exact rightOfStart_allIdle iHead wHeads oHead + +section IncReg + +variable {q : Fin n} + +private theorem incRegTM_ne_halt {s : IncPhase} (h : s ≠ .done) + {c : Cfg n (incRegTM (n := n) q).Q} (hst : c.state = s) : + ¬ c.state = (incRegTM (n := n) q).qhalt := by + rw [hst] + show ¬ s = IncPhase.done + exact h + +/-- `scan` over a mark: the register head advances; nothing else changes. -/ +private theorem incRegTM_step_scan_one (c : Cfg n (incRegTM (n := n) q).Q) + (hst : c.state = .scan) (hone : (c.work q).read = Γ.one) + (hinp : Parked c.input) (hwork : ∀ i, i ≠ q → Parked (c.work i)) + (hout : Parked c.output) : + (incRegTM (n := n) q).step c = some + { state := .scan, input := c.input, + work := Function.update c.work q ((c.work q).move .right), + output := c.output } := by + rw [TM.step, if_neg (incRegTM_ne_halt (by decide) hst)] + simp only [incRegTM, hst, hone, ↓reduceIte] + refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, ?_, ?_, ?_⟩) + · exact hinp.move_idle + · funext i + by_cases hir : i = q + · subst hir + rw [if_pos rfl, Function.update_self, + writeAndMove_readBack _ (by rw [hone]; decide)] + · rw [if_neg hir, Function.update_of_ne hir] + exact (hwork i hir).writeAndMove_readBack_idle + · exact hout.writeAndMove_readBack_idle + +/-- `scan` at the first blank: write the new mark and turn around. -/ +private theorem incRegTM_step_scan_blank (c : Cfg n (incRegTM (n := n) q).Q) + (hst : c.state = .scan) (hblank : (c.work q).read = Γ.blank) + (hinp : Parked c.input) (hwork : ∀ i, i ≠ q → Parked (c.work i)) + (hout : Parked c.output) : + (incRegTM (n := n) q).step c = some + { state := .back, input := c.input, + work := Function.update c.work q + (((c.work q).write Γw.one).move .left), + output := c.output } := by + rw [TM.step, if_neg (incRegTM_ne_halt (by decide) hst)] + simp only [incRegTM, hst, hblank, reduceCtorEq, ↓reduceIte] + refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, ?_, ?_, ?_⟩) + · exact hinp.move_idle + · funext i + by_cases hir : i = q + · subst hir + simp only [↓reduceIte, Function.update_self] + · rw [if_neg hir, if_neg hir, Function.update_of_ne hir] + exact (hwork i hir).writeAndMove_readBack_idle + · exact hout.writeAndMove_readBack_idle + +/-- `back` off the sentinel: keep rewinding. -/ +private theorem incRegTM_step_back_left (c : Cfg n (incRegTM (n := n) q).Q) + (hst : c.state = .back) (hns : (c.work q).read ≠ Γ.start) + (hinp : Parked c.input) (hwork : ∀ i, i ≠ q → Parked (c.work i)) + (hout : Parked c.output) : + (incRegTM (n := n) q).step c = some + { state := .back, input := c.input, + work := Function.update c.work q ((c.work q).move .left), + output := c.output } := by + rw [TM.step, if_neg (incRegTM_ne_halt (by decide) hst)] + simp only [incRegTM, hst, hns, ↓reduceIte] + refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, ?_, ?_, ?_⟩) + · exact hinp.move_idle + · funext i + by_cases hir : i = q + · subst hir + rw [if_pos rfl, Function.update_self, writeAndMove_readBack _ hns] + · rw [if_neg hir, Function.update_of_ne hir] + exact (hwork i hir).writeAndMove_readBack_idle + · exact hout.writeAndMove_readBack_idle + +/-- `back` on the sentinel: step right to cell 1 and park. -/ +private theorem incRegTM_step_back_start (c : Cfg n (incRegTM (n := n) q).Q) + (hst : c.state = .back) (hs : (c.work q).read = Γ.start) + (hcr : ∀ j, 1 ≤ j → (c.work q).cells j ≠ Γ.start) + (hinp : Parked c.input) (hwork : ∀ i, i ≠ q → Parked (c.work i)) + (hout : Parked c.output) : + (incRegTM (n := n) q).step c = some + { state := .park, input := c.input, + work := Function.update c.work q ((c.work q).move .right), + output := c.output } := by + have h0 : (c.work q).head = 0 := by + by_contra hc + exact hcr _ (by omega) hs + rw [TM.step, if_neg (incRegTM_ne_halt (by decide) hst)] + simp only [incRegTM, hst, hs, ↓reduceIte] + refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, ?_, ?_, ?_⟩) + · exact hinp.move_idle + · funext i + by_cases hir : i = q + · subst hir + rw [if_pos rfl, Function.update_self] + show ((c.work i).write _).move Dir3.right = (c.work i).move .right + congr 1 + rw [Tape.write, if_pos h0] + · rw [if_neg hir, Function.update_of_ne hir] + exact (hwork i hir).writeAndMove_readBack_idle + · exact hout.writeAndMove_readBack_idle + +/-- `park`: one idle step into `done`. -/ +private theorem incRegTM_step_park (c : Cfg n (incRegTM (n := n) q).Q) + (hst : c.state = .park) (hinp : Parked c.input) (hwork : ∀ i, Parked (c.work i)) + (hout : Parked c.output) : + (incRegTM (n := n) q).step c = some + { state := .done, input := c.input, work := c.work, output := c.output } := by + rw [TM.step, if_neg (incRegTM_ne_halt (by decide) hst)] + simp only [incRegTM, hst] + refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, ?_, ?_, ?_⟩) + · exact hinp.move_idle + · funext i + exact (hwork i).writeAndMove_readBack_idle + · exact hout.writeAndMove_readBack_idle + +/-- The scan loop: from `scan` with the register head at `k + 1` over + `regCells d` cells (`k ≤ d`), reach the first blank in `d - k` steps. -/ +private theorem incRegTM_scan_run (d m : ℕ) : + ∀ (k : ℕ), d = k + m → + ∀ (c : Cfg n (incRegTM (n := n) q).Q), + c.state = .scan → Parked c.input → (∀ i, i ≠ q → Parked (c.work i)) → + Parked c.output → + (c.work q).cells = regCells d → (c.work q).head = k + 1 → + ∃ c', (incRegTM (n := n) q).reachesIn m c c' ∧ + c'.state = .scan ∧ c'.input = c.input ∧ + (∀ i, i ≠ q → c'.work i = c.work i) ∧ + (c'.work q).cells = regCells d ∧ (c'.work q).head = d + 1 ∧ + c'.output = c.output := by + induction m with + | zero => + intro k hk c hst hinp hwork hout hcells hhead + exact ⟨c, .zero, hst, rfl, fun _ _ => rfl, hcells, by rw [hhead, hk], rfl⟩ + | succ m ih => + intro k hk c hst hinp hwork hout hcells hhead + have hone : (c.work q).read = Γ.one := by + rw [Tape.read, hhead, hcells] + exact regCells_one (by omega) (by omega) + have hstep := incRegTM_step_scan_one c hst hone hinp hwork hout + obtain ⟨c', hreach, hst', hinp', hwork', hcells', hhead', hout'⟩ := + ih (k + 1) (by omega) + { state := .scan, input := c.input, + work := Function.update c.work q ((c.work q).move .right), + output := c.output } rfl hinp + (fun i hi => by + show Parked (Function.update c.work q ((c.work q).move .right) i) + rw [Function.update_of_ne hi] + exact hwork i hi) + hout + (by + show (Function.update c.work q ((c.work q).move .right) q).cells = _ + rw [Function.update_self] + show (c.work q).cells = _ + exact hcells) + (by + show (Function.update c.work q ((c.work q).move .right) q).head = _ + rw [Function.update_self] + show (c.work q).head + 1 = _ + rw [hhead]) + refine ⟨c', .step hstep hreach, hst', hinp', ?_, hcells', hhead', hout'⟩ + intro i hi + rw [hwork' i hi] + show Function.update c.work q ((c.work q).move .right) i = c.work i + rw [Function.update_of_ne hi] + +/-- The rewind loop: from `back` at head `h` over `▷`-clean cells, reach + `done` parked at cell 1 in `h + 2` steps. -/ +private theorem incRegTM_back_run (h : ℕ) : + ∀ (c : Cfg n (incRegTM (n := n) q).Q), + c.state = .back → Parked c.input → (∀ i, i ≠ q → Parked (c.work i)) → + Parked c.output → + (c.work q).cells 0 = Γ.start → + (∀ j, 1 ≤ j → (c.work q).cells j ≠ Γ.start) → + (c.work q).head = h → + ∃ c', (incRegTM (n := n) q).reachesIn (h + 2) c c' ∧ + c'.state = .done ∧ c'.input = c.input ∧ + (∀ i, i ≠ q → c'.work i = c.work i) ∧ + (c'.work q).cells = (c.work q).cells ∧ (c'.work q).head = 1 ∧ + c'.output = c.output := by + induction h with + | zero => + intro c hst hinp hwork hout hc0 hcr hhead + have hs : (c.work q).read = Γ.start := by rw [Tape.read, hhead]; exact hc0 + have hstep₁ := incRegTM_step_back_start c hst hs hcr hinp hwork hout + have hworkP : ∀ i, Parked (Function.update c.work q ((c.work q).move .right) i) := by + intro i + by_cases hir : i = q + · subst hir + rw [Function.update_self] + exact ⟨by show (c.work i).head + 1 ≥ 1; omega, fun j hj => hcr j hj⟩ + · rw [Function.update_of_ne hir] + exact hwork i hir + have hstep₂ := incRegTM_step_park (q := q) + { state := .park, input := c.input, + work := Function.update c.work q ((c.work q).move .right), + output := c.output } rfl hinp hworkP hout + refine ⟨_, .step hstep₁ (.step hstep₂ .zero), rfl, rfl, ?_, ?_, ?_, rfl⟩ + · intro i hi + show Function.update c.work q ((c.work q).move .right) i = c.work i + rw [Function.update_of_ne hi] + · show (Function.update c.work q ((c.work q).move .right) q).cells = _ + rw [Function.update_self] + rfl + · show (Function.update c.work q ((c.work q).move .right) q).head = 1 + rw [Function.update_self] + show (c.work q).head + 1 = 1 + rw [hhead] + | succ h ih => + intro c hst hinp hwork hout hc0 hcr hhead + have hns : (c.work q).read ≠ Γ.start := by + rw [Tape.read, hhead]; exact hcr (h + 1) (by omega) + have hstep₁ := incRegTM_step_back_left c hst hns hinp hwork hout + have hupd : (Function.update c.work q ((c.work q).move .left) q).cells + = (c.work q).cells := by + rw [Function.update_self] + rfl + obtain ⟨c', hreach, hst', hinp', hwork', hcells', hhead', hout'⟩ := + ih { state := .back, input := c.input, + work := Function.update c.work q ((c.work q).move .left), + output := c.output } rfl hinp + (fun i hi => by + show Parked (Function.update c.work q ((c.work q).move .left) i) + rw [Function.update_of_ne hi] + exact hwork i hi) + hout + (by rw [hupd]; exact hc0) + (fun j hj => by rw [hupd]; exact hcr j hj) + (by + show (Function.update c.work q ((c.work q).move .left) q).head = h + rw [Function.update_self] + show (c.work q).head - 1 = h + rw [hhead] + omega) + refine ⟨c', .step hstep₁ hreach, hst', hinp', ?_, ?_, hhead', hout'⟩ + · intro i hi + rw [hwork' i hi] + show Function.update c.work q ((c.work q).move .left) i = c.work i + rw [Function.update_of_ne hi] + · rw [hcells', hupd] + +/-- **`incRegTM` Hoare specification.** From `regTape d` in register `q`, reach + `regTape (d + 1)` in `2d + 4` steps; the input, output, and every other work + tape are untouched. -/ +theorem incRegTM_hoareTime (q : Fin n) (d : ℕ) (inp₀ : Tape) (work₀ : Fin n → Tape) + (ys : List Bool) (hinp₀ : Parked inp₀) (hwork₀ : ∀ i, i ≠ q → Parked (work₀ i)) + (hq : work₀ q = regTape d) : + (incRegTM (n := n) q).HoareTime + (EmitPred inp₀ work₀ ys) + (EmitPred inp₀ (Function.update work₀ q (regTape (d + 1))) ys) + (2 * d + 4) := by + rintro inp work out ⟨rfl, rfl, hout⟩ + obtain ⟨c₁, hreach₁, hst₁, hinp₁, hwork₁, hcells₁, hhead₁, hout₁⟩ := + incRegTM_scan_run d d 0 (by omega) + { state := .scan, input := inp, work := work, output := out } rfl + hinp₀ hwork₀ hout.parked + (by show (work q).cells = regCells d; rw [hq, regT_cells]) + (by show (work q).head = 0 + 1; rw [hq, regT_head]) + have hinpP₁ : Parked c₁.input := by rw [hinp₁]; exact hinp₀ + have hworkP₁ : ∀ i, i ≠ q → Parked (c₁.work i) := fun i hi => by + rw [hwork₁ i hi] + exact hwork₀ i hi + have houtP₁ : Parked c₁.output := by rw [hout₁]; exact hout.parked + have hblank₁ : (c₁.work q).read = Γ.blank := by + rw [Tape.read, hhead₁, hcells₁] + exact regCells_blank (le_refl _) + have hstep₂ := incRegTM_step_scan_blank c₁ hst₁ hblank₁ hinpP₁ hworkP₁ houtP₁ + set wq₂ : Tape := ((c₁.work q).write Γw.one).move .left with hwq₂ + have hwq₂cells : wq₂.cells = regCells (d + 1) := by + rw [hwq₂] + show ((c₁.work q).write Γw.one).cells = _ + rw [Tape.write, if_neg (by rw [hhead₁]; omega)] + show Function.update (c₁.work q).cells (c₁.work q).head Γw.one.toΓ = _ + rw [hhead₁, hcells₁] + exact regCells_update_succ d + have hwq₂head : wq₂.head = d := by + rw [hwq₂] + show ((c₁.work q).write Γw.one).head - 1 = d + rw [Tape.write_head, hhead₁] + omega + obtain ⟨c₃, hreach₃, hst₃, hinp₃, hwork₃, hcells₃, hhead₃, hout₃⟩ := + incRegTM_back_run d + { state := .back, input := c₁.input, + work := Function.update c₁.work q wq₂, + output := c₁.output } rfl hinpP₁ + (fun i hi => by + show Parked (Function.update c₁.work q wq₂ i) + rw [Function.update_of_ne hi] + exact hworkP₁ i hi) + houtP₁ + (by + show (Function.update c₁.work q wq₂ q).cells 0 = Γ.start + rw [Function.update_self, hwq₂cells] + rfl) + (fun j hj => by + show (Function.update c₁.work q wq₂ q).cells j ≠ Γ.start + rw [Function.update_self, hwq₂cells] + exact (reg_regT (d + 1)).cells_ne_start hj) + (by + show (Function.update c₁.work q wq₂ q).head = d + rw [Function.update_self, hwq₂head]) + refine ⟨c₃, d + ((d + 2) + 1), by omega, + reachesIn_trans _ hreach₁ (.step hstep₂ hreach₃), hst₃, ?_, ?_, ?_⟩ + · rw [hinp₃]; exact hinp₁ + · funext i + by_cases hir : i = q + · subst hir + rw [Function.update_self] + refine Tape.ext ?_ ?_ + · rw [hhead₃] + rfl + · rw [hcells₃] + show (Function.update c₁.work i wq₂ i).cells = _ + rw [Function.update_self, hwq₂cells, regT_cells] + · rw [Function.update_of_ne hir, hwork₃ i hir] + show Function.update c₁.work q wq₂ i = work i + rw [Function.update_of_ne hir] + exact hwork₁ i hir + · rw [hout₃, hout₁] + exact hout + +end IncReg + +-- ════════════════════════════════════════════════════════════════════════ +-- clearRegTM: blank a register +-- ════════════════════════════════════════════════════════════════════════ + +/-- Cells of a register holding `d` mid-clear: positions `1..k` blanked, + `k+1..d` still marked. -/ +def clearRegCells (d k : ℕ) : ℕ → Γ := fun j => + if j = 0 then Γ.start + else if j ≤ k then Γ.blank + else if j ≤ d then Γ.one + else Γ.blank + +/-- Before any blanking (`k = 0`), a mid-clear register is exactly `regCells d`. -/ +theorem clearCells_zero (d : ℕ) : clearRegCells d 0 = regCells d := by + funext j + simp only [clearRegCells, regCells] + rcases Nat.eq_zero_or_pos j with rfl | hj + · rfl + · rw [if_neg (show ¬ j = 0 from by omega), if_neg (show ¬ j ≤ 0 from by omega), + if_neg (show ¬ j = 0 from by omega)] + +/-- After blanking all `d` marks (`k = d`), a mid-clear register is `regCells 0`. -/ +theorem clearCells_last (d : ℕ) : clearRegCells d d = regCells 0 := by + funext j + simp only [clearRegCells, regCells] + rcases Nat.eq_zero_or_pos j with rfl | hj + · rfl + · rw [if_neg (show ¬ j = 0 from by omega), if_neg (show ¬ j = 0 from by omega), + if_neg (show ¬ j ≤ 0 from by omega)] + by_cases hd : j ≤ d + · rw [if_pos hd] + · rw [if_neg hd, if_neg hd] + +/-- No mid-clear cell at position `j ≥ 1` is the `▷` sentinel. -/ +theorem clearCells_ne_start {d k j : ℕ} (hj : 1 ≤ j) : + clearRegCells d k j ≠ Γ.start := by + simp only [clearRegCells] + rw [if_neg (show ¬ j = 0 from by omega)] + split + · decide + · split <;> decide + +/-- Blanking cell `k + 1` of `clearRegCells d k` advances the sweep to + `clearRegCells d (k + 1)`. -/ +theorem clearCells_update_succ (d k : ℕ) : + Function.update (clearRegCells d k) (k + 1) Γ.blank = clearRegCells d (k + 1) := by + funext j + rw [Function.update_apply] + by_cases hj : j = k + 1 + · subst hj + rw [if_pos rfl] + show Γ.blank = clearRegCells d (k + 1) (k + 1) + simp only [clearRegCells] + rw [if_neg (show ¬ k + 1 = 0 from by omega), if_pos (le_refl (k + 1))] + · rw [if_neg hj] + simp only [clearRegCells] + rcases Nat.eq_zero_or_pos j with rfl | hj1 + · rfl + · rcases Nat.lt_or_ge j (k + 1) with hlt | hge + · rw [if_neg (show ¬ j = 0 from by omega), if_neg (show ¬ j = 0 from by omega), + if_pos (show j ≤ k from by omega), if_pos (show j ≤ k + 1 from by omega)] + · rw [if_neg (show ¬ j = 0 from by omega), if_neg (show ¬ j = 0 from by omega), + if_neg (show ¬ j ≤ k from by omega), if_neg (show ¬ j ≤ k + 1 from by omega)] + +/-- **Clear register `q`**: sweep right blanking the marks, rewind to cell 1. + From `regTape d` to `regTape 0` in `2d + 4` steps; every other tape untouched. -/ +def clearRegTM (q : Fin n) : TM n where + Q := IncPhase + qstart := .scan + qhalt := .done + δ := fun s iHead wHeads oHead => + match s with + | .scan => + if wHeads q = Γ.one then + (.scan, fun i => if i = q then Γw.blank else readBackWrite (wHeads i), + readBackWrite oHead, idleDir iHead, + fun i => if i = q then Dir3.right else idleDir (wHeads i), + idleDir oHead) + else + (.back, fun i => readBackWrite (wHeads i), readBackWrite oHead, + idleDir iHead, + fun i => if i = q then (if wHeads q = Γ.start then Dir3.right else Dir3.left) + else idleDir (wHeads i), + idleDir oHead) + | .back => + if wHeads q = Γ.start then + (.park, fun i => readBackWrite (wHeads i), readBackWrite oHead, + idleDir iHead, fun i => if i = q then Dir3.right else idleDir (wHeads i), + idleDir oHead) + else + (.back, fun i => readBackWrite (wHeads i), readBackWrite oHead, + idleDir iHead, fun i => if i = q then Dir3.left else idleDir (wHeads i), + idleDir oHead) + | .park => + (.done, fun i => readBackWrite (wHeads i), readBackWrite oHead, + idleDir iHead, fun i => idleDir (wHeads i), idleDir oHead) + | .done => allIdle s iHead wHeads oHead + δ_right_of_start := by + intro s iHead wHeads oHead + match s with + | .scan => + dsimp only [] + split + · next hone => + refine ⟨idleDir_right_of_start, fun i hi => ?_, idleDir_right_of_start⟩ + dsimp only [] + by_cases hir : i = q + · subst hir; rw [hone] at hi; exact absurd hi (by decide) + · rw [if_neg hir]; exact idleDir_right_of_start hi + · next hnone => + refine ⟨idleDir_right_of_start, fun i hi => ?_, idleDir_right_of_start⟩ + dsimp only [] + by_cases hir : i = q + · subst hir; rw [if_pos rfl, if_pos hi] + · rw [if_neg hir]; exact idleDir_right_of_start hi + | .back => + dsimp only [] + split + · refine ⟨idleDir_right_of_start, fun i hi => ?_, idleDir_right_of_start⟩ + dsimp only [] + by_cases hir : i = q + · rw [if_pos hir] + · rw [if_neg hir]; exact idleDir_right_of_start hi + · next hns => + refine ⟨idleDir_right_of_start, fun i hi => ?_, idleDir_right_of_start⟩ + dsimp only [] + by_cases hir : i = q + · subst hir; exact absurd hi hns + · rw [if_neg hir]; exact idleDir_right_of_start hi + | .park => + exact ⟨idleDir_right_of_start, fun _ => idleDir_right_of_start, + idleDir_right_of_start⟩ + | .done => exact rightOfStart_allIdle iHead wHeads oHead + +section ClearReg + +variable {q : Fin n} + +private theorem clearRegTM_ne_halt {s : IncPhase} (h : s ≠ .done) + {c : Cfg n (clearRegTM (n := n) q).Q} (hst : c.state = s) : + ¬ c.state = (clearRegTM (n := n) q).qhalt := by + rw [hst] + show ¬ s = IncPhase.done + exact h + +/-- `scan` over a mark: blank it and advance. -/ +private theorem clearRegTM_step_scan_one (c : Cfg n (clearRegTM (n := n) q).Q) + (hst : c.state = .scan) (hone : (c.work q).read = Γ.one) + (hinp : Parked c.input) (hwork : ∀ i, i ≠ q → Parked (c.work i)) + (hout : Parked c.output) : + (clearRegTM (n := n) q).step c = some + { state := .scan, input := c.input, + work := Function.update c.work q + (((c.work q).write Γw.blank).move .right), + output := c.output } := by + rw [TM.step, if_neg (clearRegTM_ne_halt (by decide) hst)] + simp only [clearRegTM, hst, hone, ↓reduceIte] + refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, ?_, ?_, ?_⟩) + · exact hinp.move_idle + · funext i + by_cases hir : i = q + · subst hir + simp only [↓reduceIte, Function.update_self] + · rw [if_neg hir, if_neg hir, Function.update_of_ne hir] + exact (hwork i hir).writeAndMove_readBack_idle + · exact hout.writeAndMove_readBack_idle + +/-- `scan` at the first blank: turn around (no write). -/ +private theorem clearRegTM_step_scan_blank (c : Cfg n (clearRegTM (n := n) q).Q) + (hst : c.state = .scan) (hblank : (c.work q).read = Γ.blank) + (hinp : Parked c.input) (hwork : ∀ i, i ≠ q → Parked (c.work i)) + (hout : Parked c.output) : + (clearRegTM (n := n) q).step c = some + { state := .back, input := c.input, + work := Function.update c.work q ((c.work q).move .left), + output := c.output } := by + rw [TM.step, if_neg (clearRegTM_ne_halt (by decide) hst)] + simp only [clearRegTM, hst, hblank, reduceCtorEq, ↓reduceIte] + refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, ?_, ?_, ?_⟩) + · exact hinp.move_idle + · funext i + by_cases hir : i = q + · subst hir + simp only [↓reduceIte, Function.update_self] + rw [writeAndMove_readBack _ (by rw [hblank]; decide)] + · rw [if_neg hir, Function.update_of_ne hir] + exact (hwork i hir).writeAndMove_readBack_idle + · exact hout.writeAndMove_readBack_idle + +/-- `back` off the sentinel: keep rewinding. -/ +private theorem clearRegTM_step_back_left (c : Cfg n (clearRegTM (n := n) q).Q) + (hst : c.state = .back) (hns : (c.work q).read ≠ Γ.start) + (hinp : Parked c.input) (hwork : ∀ i, i ≠ q → Parked (c.work i)) + (hout : Parked c.output) : + (clearRegTM (n := n) q).step c = some + { state := .back, input := c.input, + work := Function.update c.work q ((c.work q).move .left), + output := c.output } := by + rw [TM.step, if_neg (clearRegTM_ne_halt (by decide) hst)] + simp only [clearRegTM, hst, hns, ↓reduceIte] + refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, ?_, ?_, ?_⟩) + · exact hinp.move_idle + · funext i + by_cases hir : i = q + · subst hir + rw [if_pos rfl, Function.update_self, writeAndMove_readBack _ hns] + · rw [if_neg hir, Function.update_of_ne hir] + exact (hwork i hir).writeAndMove_readBack_idle + · exact hout.writeAndMove_readBack_idle + +/-- `back` on the sentinel: step right to cell 1 and park. -/ +private theorem clearRegTM_step_back_start (c : Cfg n (clearRegTM (n := n) q).Q) + (hst : c.state = .back) (hs : (c.work q).read = Γ.start) + (hcr : ∀ j, 1 ≤ j → (c.work q).cells j ≠ Γ.start) + (hinp : Parked c.input) (hwork : ∀ i, i ≠ q → Parked (c.work i)) + (hout : Parked c.output) : + (clearRegTM (n := n) q).step c = some + { state := .park, input := c.input, + work := Function.update c.work q ((c.work q).move .right), + output := c.output } := by + have h0 : (c.work q).head = 0 := by + by_contra hc + exact hcr _ (by omega) hs + rw [TM.step, if_neg (clearRegTM_ne_halt (by decide) hst)] + simp only [clearRegTM, hst, hs, ↓reduceIte] + refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, ?_, ?_, ?_⟩) + · exact hinp.move_idle + · funext i + by_cases hir : i = q + · subst hir + rw [if_pos rfl, Function.update_self] + show ((c.work i).write _).move Dir3.right = (c.work i).move .right + congr 1 + rw [Tape.write, if_pos h0] + · rw [if_neg hir, Function.update_of_ne hir] + exact (hwork i hir).writeAndMove_readBack_idle + · exact hout.writeAndMove_readBack_idle + +/-- `park`: one idle step into `done`. -/ +private theorem clearRegTM_step_park (c : Cfg n (clearRegTM (n := n) q).Q) + (hst : c.state = .park) (hinp : Parked c.input) (hwork : ∀ i, Parked (c.work i)) + (hout : Parked c.output) : + (clearRegTM (n := n) q).step c = some + { state := .done, input := c.input, work := c.work, output := c.output } := by + rw [TM.step, if_neg (clearRegTM_ne_halt (by decide) hst)] + simp only [clearRegTM, hst] + refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, ?_, ?_, ?_⟩) + · exact hinp.move_idle + · funext i + exact (hwork i).writeAndMove_readBack_idle + · exact hout.writeAndMove_readBack_idle + +/-- The clearing sweep: from `scan` at head `k + 1` over `clearRegCells d k`, + blank the remaining `d - k` marks. -/ +private theorem clearRegTM_scan_run (d m : ℕ) : + ∀ (k : ℕ), d = k + m → + ∀ (c : Cfg n (clearRegTM (n := n) q).Q), + c.state = .scan → Parked c.input → (∀ i, i ≠ q → Parked (c.work i)) → + Parked c.output → + (c.work q).cells = clearRegCells d k → (c.work q).head = k + 1 → + ∃ c', (clearRegTM (n := n) q).reachesIn m c c' ∧ + c'.state = .scan ∧ c'.input = c.input ∧ + (∀ i, i ≠ q → c'.work i = c.work i) ∧ + (c'.work q).cells = clearRegCells d d ∧ (c'.work q).head = d + 1 ∧ + c'.output = c.output := by + induction m with + | zero => + intro k hk c hst hinp hwork hout hcells hhead + obtain rfl : k = d := by omega + exact ⟨c, .zero, hst, rfl, fun _ _ => rfl, hcells, hhead, rfl⟩ + | succ m ih => + intro k hk c hst hinp hwork hout hcells hhead + have hone : (c.work q).read = Γ.one := by + rw [Tape.read, hhead, hcells, clearRegCells, if_neg (by omega), if_neg (by omega), + if_pos (by omega)] + have hstep := clearRegTM_step_scan_one c hst hone hinp hwork hout + set wq₁ : Tape := ((c.work q).write Γw.blank).move .right with hwq₁ + have hwq₁cells : wq₁.cells = clearRegCells d (k + 1) := by + rw [hwq₁] + show ((c.work q).write Γw.blank).cells = _ + rw [Tape.write, if_neg (by rw [hhead]; omega)] + show Function.update (c.work q).cells (c.work q).head Γw.blank.toΓ = _ + rw [hhead, hcells] + exact clearCells_update_succ d k + have hwq₁head : wq₁.head = (k + 1) + 1 := by + rw [hwq₁] + show ((c.work q).write Γw.blank).head + 1 = _ + rw [Tape.write_head, hhead] + obtain ⟨c', hreach, hst', hinp', hwork', hcells', hhead', hout'⟩ := + ih (k + 1) (by omega) + { state := .scan, input := c.input, + work := Function.update c.work q wq₁, + output := c.output } rfl hinp + (fun i hi => by + show Parked (Function.update c.work q wq₁ i) + rw [Function.update_of_ne hi] + exact hwork i hi) + hout + (by + show (Function.update c.work q wq₁ q).cells = _ + rw [Function.update_self, hwq₁cells]) + (by + show (Function.update c.work q wq₁ q).head = _ + rw [Function.update_self, hwq₁head]) + refine ⟨c', .step hstep hreach, hst', hinp', ?_, hcells', hhead', hout'⟩ + intro i hi + rw [hwork' i hi] + show Function.update c.work q wq₁ i = c.work i + rw [Function.update_of_ne hi] + +/-- The rewind loop (identical shape to `incRegTM`'s). -/ +private theorem clearRegTM_back_run (h : ℕ) : + ∀ (c : Cfg n (clearRegTM (n := n) q).Q), + c.state = .back → Parked c.input → (∀ i, i ≠ q → Parked (c.work i)) → + Parked c.output → + (c.work q).cells 0 = Γ.start → + (∀ j, 1 ≤ j → (c.work q).cells j ≠ Γ.start) → + (c.work q).head = h → + ∃ c', (clearRegTM (n := n) q).reachesIn (h + 2) c c' ∧ + c'.state = .done ∧ c'.input = c.input ∧ + (∀ i, i ≠ q → c'.work i = c.work i) ∧ + (c'.work q).cells = (c.work q).cells ∧ (c'.work q).head = 1 ∧ + c'.output = c.output := by + induction h with + | zero => + intro c hst hinp hwork hout hc0 hcr hhead + have hs : (c.work q).read = Γ.start := by rw [Tape.read, hhead]; exact hc0 + have hstep₁ := clearRegTM_step_back_start c hst hs hcr hinp hwork hout + have hworkP : ∀ i, Parked (Function.update c.work q ((c.work q).move .right) i) := by + intro i + by_cases hir : i = q + · subst hir + rw [Function.update_self] + exact ⟨by show (c.work i).head + 1 ≥ 1; omega, fun j hj => hcr j hj⟩ + · rw [Function.update_of_ne hir] + exact hwork i hir + have hstep₂ := clearRegTM_step_park (q := q) + { state := .park, input := c.input, + work := Function.update c.work q ((c.work q).move .right), + output := c.output } rfl hinp hworkP hout + refine ⟨_, .step hstep₁ (.step hstep₂ .zero), rfl, rfl, ?_, ?_, ?_, rfl⟩ + · intro i hi + show Function.update c.work q ((c.work q).move .right) i = c.work i + rw [Function.update_of_ne hi] + · show (Function.update c.work q ((c.work q).move .right) q).cells = _ + rw [Function.update_self] + rfl + · show (Function.update c.work q ((c.work q).move .right) q).head = 1 + rw [Function.update_self] + show (c.work q).head + 1 = 1 + rw [hhead] + | succ h ih => + intro c hst hinp hwork hout hc0 hcr hhead + have hns : (c.work q).read ≠ Γ.start := by + rw [Tape.read, hhead]; exact hcr (h + 1) (by omega) + have hstep₁ := clearRegTM_step_back_left c hst hns hinp hwork hout + have hupd : (Function.update c.work q ((c.work q).move .left) q).cells + = (c.work q).cells := by + rw [Function.update_self] + rfl + obtain ⟨c', hreach, hst', hinp', hwork', hcells', hhead', hout'⟩ := + ih { state := .back, input := c.input, + work := Function.update c.work q ((c.work q).move .left), + output := c.output } rfl hinp + (fun i hi => by + show Parked (Function.update c.work q ((c.work q).move .left) i) + rw [Function.update_of_ne hi] + exact hwork i hi) + hout + (by rw [hupd]; exact hc0) + (fun j hj => by rw [hupd]; exact hcr j hj) + (by + show (Function.update c.work q ((c.work q).move .left) q).head = h + rw [Function.update_self] + show (c.work q).head - 1 = h + rw [hhead] + omega) + refine ⟨c', .step hstep₁ hreach, hst', hinp', ?_, ?_, hhead', hout'⟩ + · intro i hi + rw [hwork' i hi] + show Function.update c.work q ((c.work q).move .left) i = c.work i + rw [Function.update_of_ne hi] + · rw [hcells', hupd] + +/-- **`clearRegTM` Hoare specification.** From `regTape d` in register `q`, reach + `regTape 0` in `2d + 4` steps; everything else untouched. -/ +theorem clearRegTM_hoareTime (q : Fin n) (d : ℕ) (inp₀ : Tape) (work₀ : Fin n → Tape) + (ys : List Bool) (hinp₀ : Parked inp₀) (hwork₀ : ∀ i, i ≠ q → Parked (work₀ i)) + (hq : work₀ q = regTape d) : + (clearRegTM (n := n) q).HoareTime + (EmitPred inp₀ work₀ ys) + (EmitPred inp₀ (Function.update work₀ q (regTape 0)) ys) + (2 * d + 4) := by + rintro inp work out ⟨rfl, rfl, hout⟩ + obtain ⟨c₁, hreach₁, hst₁, hinp₁, hwork₁, hcells₁, hhead₁, hout₁⟩ := + clearRegTM_scan_run d d 0 (by omega) + { state := .scan, input := inp, work := work, output := out } rfl + hinp₀ hwork₀ hout.parked + (by show (work q).cells = clearRegCells d 0; rw [hq, regT_cells, clearCells_zero]) + (by show (work q).head = 0 + 1; rw [hq, regT_head]) + have hinpP₁ : Parked c₁.input := by rw [hinp₁]; exact hinp₀ + have hworkP₁ : ∀ i, i ≠ q → Parked (c₁.work i) := fun i hi => by + rw [hwork₁ i hi] + exact hwork₀ i hi + have houtP₁ : Parked c₁.output := by rw [hout₁]; exact hout.parked + have hblank₁ : (c₁.work q).read = Γ.blank := by + rw [Tape.read, hhead₁, hcells₁, clearCells_last] + exact regCells_blank (by omega) + have hstep₂ := clearRegTM_step_scan_blank c₁ hst₁ hblank₁ hinpP₁ hworkP₁ houtP₁ + have hupd₂ : (Function.update c₁.work q ((c₁.work q).move .left) q).cells + = regCells 0 := by + rw [Function.update_self] + show (c₁.work q).cells = _ + rw [hcells₁, clearCells_last] + obtain ⟨c₃, hreach₃, hst₃, hinp₃, hwork₃, hcells₃, hhead₃, hout₃⟩ := + clearRegTM_back_run d + { state := .back, input := c₁.input, + work := Function.update c₁.work q ((c₁.work q).move .left), + output := c₁.output } rfl hinpP₁ + (fun i hi => by + show Parked (Function.update c₁.work q ((c₁.work q).move .left) i) + rw [Function.update_of_ne hi] + exact hworkP₁ i hi) + houtP₁ + (by rw [hupd₂]; rfl) + (fun j hj => by rw [hupd₂]; exact (reg_regT 0).cells_ne_start hj) + (by + show (Function.update c₁.work q ((c₁.work q).move .left) q).head = d + rw [Function.update_self] + show (c₁.work q).head - 1 = d + rw [hhead₁] + omega) + refine ⟨c₃, d + ((d + 2) + 1), by omega, + reachesIn_trans _ hreach₁ (.step hstep₂ hreach₃), hst₃, ?_, ?_, ?_⟩ + · rw [hinp₃]; exact hinp₁ + · funext i + by_cases hir : i = q + · subst hir + rw [Function.update_self] + refine Tape.ext ?_ ?_ + · rw [hhead₃] + rfl + · rw [hcells₃] + show (Function.update c₁.work i ((c₁.work i).move .left) i).cells = _ + rw [hupd₂, regT_cells] + · rw [Function.update_of_ne hir, hwork₃ i hir] + show Function.update c₁.work q ((c₁.work q).move .left) i = work i + rw [Function.update_of_ne hir] + exact hwork₁ i hir + · rw [hout₃, hout₁] + exact hout + +end ClearReg + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/SpaceTime.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/SpaceTime.lean new file mode 100644 index 0000000000..79c99171ad --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/SpaceTime.lean @@ -0,0 +1,9 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.SpaceTime.Internal + +/-! Supporting modules for Beyond the Bethe approximation of the permanent. -/ diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/SpaceTime/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/SpaceTime/Internal.lean new file mode 100644 index 0000000000..8e407f3057 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/SpaceTime/Internal.lean @@ -0,0 +1,9 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.SpaceTime.Internal.Reachability + +/-! Supporting modules for Beyond the Bethe approximation of the permanent. -/ diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/SpaceTime/Internal/Reachability.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/SpaceTime/Internal/Reachability.lean new file mode 100644 index 0000000000..b3e9465898 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/SpaceTime/Internal/Reachability.lean @@ -0,0 +1,52 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine + +/-! +# Exact-run decomposition — proof internals + +These small deterministic-run lemmas expose configurations at chosen time +indices. They support the finite reduced-configuration argument without adding +execution choices to the machine model. +-/ + + +public section + +namespace Complexity + +namespace TM + +variable {n : ℕ} + +/-- Split an exact run at a prescribed prefix length. -/ +theorem reachesIn_split_internal {tm : TM n} {a b : ℕ} {c c' : Cfg n tm.Q} + (hreach : tm.reachesIn (a + b) c c') : + ∃ d, tm.reachesIn a c d ∧ tm.reachesIn b d c' := by + induction a generalizing c with + | zero => + exact ⟨c, .zero, by simpa using hreach⟩ + | succ a ih => + have hlength : Nat.succ a + b = (a + b) + 1 := by omega + rw [hlength] at hreach + cases hreach with + | step hstep hrest => + obtain ⟨d, hprefix, hsuffix⟩ := ih hrest + exact ⟨d, .step hstep hprefix, hsuffix⟩ + +/-- Expose the configuration at time `i` of an exact `t`-step run. -/ +theorem reachesIn_prefix_internal {tm : TM n} {t i : ℕ} {c c' : Cfg n tm.Q} + (hreach : tm.reachesIn t c c') (hi : i ≤ t) : + ∃ d, tm.reachesIn i c d ∧ tm.reachesIn (t - i) d c' := by + have hlength : i + (t - i) = t := Nat.add_sub_of_le hi + rw [← hlength] at hreach + exact reachesIn_split_internal hreach + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines.lean new file mode 100644 index 0000000000..7ffa37d18e --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines.lean @@ -0,0 +1,482 @@ +/- +Copyright (c) 2025 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators + +/-! +# TM Subroutines + +Small concrete Turing machines used as composable building blocks for +constructing larger machines via `seqTM`, `ifTM`, and `loopTM`. + +Subroutine correctness theorems live in the proof modules under +`Complexitylib.Models.TuringMachine.Subroutines.Internal`; reusable public +statements are re-exported by focused surface modules when needed. + +## Main definitions + +- `TM.writeTM` — write a symbol to output cell 1 and halt +- `TM.rewindWorkTM` — rewind a work tape head to cell 1 +- `TM.rewindInputTM` — rewind the input tape head to cell 1 +- `TM.scanRightTM` — scan a work tape right until blank +- `TM.blankWorkTM` — blank a started work tape while scanning right +- `TM.clearWorkTM` — blank a started work tape and rewind it to cell 1 +- `TM.copyInputToWorkTM` — copy input tape contents to a work tape +- `TM.copyInputToOutputTM` — copy input tape contents to the output tape +- `TM.copyWorkToWorkTM` — copy one work tape's contents to another +- `TM.compareWorkTapesTM` — compare two work tapes cell by cell +-/ + + +@[expose] public section + +namespace Complexity + +namespace TM + +variable {n : ℕ} + +-- ════════════════════════════════════════════════════════════════════════ +-- writeTM: write a symbol to output cell 1 and halt +-- ════════════════════════════════════════════════════════════════════════ + +/-- State space of `writeTM`: rewind the output head to `▷`, step right to +cell 1, write the symbol, then halt. -/ +inductive WritePhase where + | rewind | goRight | write | done + deriving DecidableEq + +instance : Fintype WritePhase where + elems := {.rewind, .goRight, .write, .done} + complete := fun x => by cases x <;> simp + +/-- Write `sym` to output cell 1 and halt. + Phases: rewind output to ▷ → move right to cell 1 → write → halt. -/ +def writeTM (sym : Γw) : TM n where + Q := WritePhase + qstart := .rewind + qhalt := .done + δ := fun state iHead wHeads oHead => + match state with + | .rewind => + if oHead = Γ.start then + (.goRight, fun _ => .blank, .blank, + idleDir iHead, fun i => idleDir (wHeads i), Dir3.right) + else + (.rewind, fun _ => .blank, readBackWrite oHead, + idleDir iHead, fun i => idleDir (wHeads i), Dir3.left) + | .goRight => + (.write, fun _ => .blank, .blank, + idleDir iHead, fun i => idleDir (wHeads i), idleDir oHead) + | .write => + (.done, fun _ => .blank, sym, + idleDir iHead, fun i => idleDir (wHeads i), idleDir oHead) + | .done => allIdle .done iHead wHeads oHead + δ_right_of_start := by + intro state iHead wHeads oHead + match state with + | .rewind => + dsimp only []; split + · exact ⟨idleDir_right_of_start, fun _ => idleDir_right_of_start, fun _ => rfl⟩ + · refine ⟨idleDir_right_of_start, fun _ => idleDir_right_of_start, ?_⟩ + intro h; next hn => exact absurd h hn + | .goRight => + exact ⟨idleDir_right_of_start, fun _ => idleDir_right_of_start, + idleDir_right_of_start⟩ + | .write => + exact ⟨idleDir_right_of_start, fun _ => idleDir_right_of_start, + idleDir_right_of_start⟩ + | .done => exact rightOfStart_allIdle iHead wHeads oHead + +/-- `writeTM` specialized to write `Γw.one` to output cell 1 (accept). -/ +abbrev writeOneTM : TM n := writeTM .one + +/-- `writeTM` specialized to write `Γw.zero` to output cell 1 (reject). -/ +abbrev writeZeroTM : TM n := writeTM .zero + +-- ════════════════════════════════════════════════════════════════════════ +-- rewindWorkTM: rewind a work tape to cell 1 +-- ════════════════════════════════════════════════════════════════════════ + +/-- State space of `rewindWorkTM`/`rewindInputTM`: move the head left until it +reads `▷`, then move right once to land on cell 1 and halt. -/ +inductive RewindPhase where + | moveLeft | moveRight | done + deriving DecidableEq + +instance : Fintype RewindPhase where + elems := {.moveLeft, .moveRight, .done} + complete := fun x => by cases x <;> simp + +/-- Rewind work tape `idx` to cell 1 (first data cell after ▷). -/ +def rewindWorkTM (idx : Fin n) : TM n where + Q := RewindPhase + qstart := .moveLeft + qhalt := .done + δ := fun state iHead wHeads oHead => + match state with + | .moveLeft => + if wHeads idx = Γ.start then + (.moveRight, fun i => readBackWrite (wHeads i), readBackWrite oHead, + idleDir iHead, + fun i => if i = idx then Dir3.right else idleDir (wHeads i), + idleDir oHead) + else + (.moveLeft, + fun i => readBackWrite (wHeads i), + readBackWrite oHead, idleDir iHead, + fun i => if i = idx then Dir3.left else idleDir (wHeads i), + idleDir oHead) + | .moveRight => + (.done, fun i => readBackWrite (wHeads i), readBackWrite oHead, + idleDir iHead, fun i => idleDir (wHeads i), idleDir oHead) + | .done => allIdle .done iHead wHeads oHead + δ_right_of_start := by + intro state iHead wHeads oHead + match state with + | .moveLeft => + dsimp only []; split + · refine ⟨idleDir_right_of_start, ?_, idleDir_right_of_start⟩ + intro i hwi; simp only []; split + · rfl + · exact idleDir_right_of_start hwi + · refine ⟨idleDir_right_of_start, ?_, idleDir_right_of_start⟩ + intro i hwi; simp only []; split + · rename_i heq; subst heq; contradiction + · exact idleDir_right_of_start hwi + | .moveRight => + exact ⟨idleDir_right_of_start, fun _ => idleDir_right_of_start, + idleDir_right_of_start⟩ + | .done => exact rightOfStart_allIdle iHead wHeads oHead + +-- ════════════════════════════════════════════════════════════════════════ +-- rewindInputTM: rewind the input tape to cell 1 +-- ════════════════════════════════════════════════════════════════════════ + +/-- Rewind the input tape to cell 1 (first data cell after ▷). Work and + output tapes are only written with `readBackWrite`, so their contents are + preserved under the usual no-start-under-head side conditions. -/ +def rewindInputTM : TM n where + Q := RewindPhase + qstart := .moveLeft + qhalt := .done + δ := fun state iHead wHeads oHead => + match state with + | .moveLeft => + if iHead = Γ.start then + (.moveRight, fun i => readBackWrite (wHeads i), readBackWrite oHead, + Dir3.right, fun i => idleDir (wHeads i), idleDir oHead) + else + (.moveLeft, + fun i => readBackWrite (wHeads i), + readBackWrite oHead, moveLeftDir iHead, + fun i => idleDir (wHeads i), + idleDir oHead) + | .moveRight => + (.done, fun i => readBackWrite (wHeads i), readBackWrite oHead, + idleDir iHead, fun i => idleDir (wHeads i), idleDir oHead) + | .done => allIdle .done iHead wHeads oHead + δ_right_of_start := by + intro state iHead wHeads oHead + match state with + | .moveLeft => + dsimp only []; split + · refine ⟨fun _ => rfl, ?_, idleDir_right_of_start⟩ + intro i hwi + exact idleDir_right_of_start hwi + · rename_i hne + refine ⟨?_, ?_, idleDir_right_of_start⟩ + · intro hi; exact (hne hi).elim + · intro i hwi; exact idleDir_right_of_start hwi + | .moveRight => + exact ⟨idleDir_right_of_start, fun _ => idleDir_right_of_start, + idleDir_right_of_start⟩ + | .done => exact rightOfStart_allIdle iHead wHeads oHead + +-- ════════════════════════════════════════════════════════════════════════ +-- scanRightTM: scan a work tape right until blank +-- ════════════════════════════════════════════════════════════════════════ + +/-- State space of `scanRightTM`/`blankWorkTM`: scan right until reading +`Γ.blank`, then halt. -/ +inductive ScanPhase where + | scanning | done + deriving DecidableEq + +instance : Fintype ScanPhase where + elems := {.scanning, .done} + complete := fun x => by cases x <;> simp + +/-- Scan work tape `idx` right until finding `Γ.blank`. On canonical binary +tapes, its exact content- and frame-preserving behavior is specified by +`scanRightTM_reachesIn_frame` and `scanRightTM_hoareTime_frame`. -/ +def scanRightTM (idx : Fin n) : TM n where + Q := ScanPhase + qstart := .scanning + qhalt := .done + δ := fun state iHead wHeads oHead => + match state with + | .scanning => + if wHeads idx = Γ.blank then + (.done, + fun i => readBackWrite (wHeads i), readBackWrite oHead, + idleDir iHead, fun i => idleDir (wHeads i), idleDir oHead) + else + (.scanning, + fun i => readBackWrite (wHeads i), + readBackWrite oHead, idleDir iHead, + fun i => if i = idx then Dir3.right else idleDir (wHeads i), + idleDir oHead) + | .done => + (.done, + fun i => readBackWrite (wHeads i), readBackWrite oHead, + idleDir iHead, fun i => idleDir (wHeads i), idleDir oHead) + δ_right_of_start := by + intro state iHead wHeads oHead + match state with + | .scanning => + dsimp only []; split + · exact ⟨idleDir_right_of_start, fun _ => idleDir_right_of_start, + idleDir_right_of_start⟩ + · refine ⟨idleDir_right_of_start, ?_, idleDir_right_of_start⟩ + intro i hwi; simp only []; split + · rfl + · exact idleDir_right_of_start hwi + | .done => + exact ⟨idleDir_right_of_start, fun _ => idleDir_right_of_start, + idleDir_right_of_start⟩ + +-- ════════════════════════════════════════════════════════════════════════ +-- blankWorkTM: blank a work tape while scanning right +-- ════════════════════════════════════════════════════════════════════════ + +/-- Scan work tape `idx` right until finding `Γ.blank`, overwriting every +visited nonblank cell with `Γ.blank`. This consumes a started Boolean string +and leaves the tape blank to the right of the current head. -/ +def blankWorkTM (idx : Fin n) : TM n where + Q := ScanPhase + qstart := .scanning + qhalt := .done + δ := fun state iHead wHeads oHead => + match state with + | .scanning => + if wHeads idx = Γ.blank then + (.done, + fun i => readBackWrite (wHeads i), + readBackWrite oHead, idleDir iHead, + fun i => idleDir (wHeads i), + idleDir oHead) + else + (.scanning, + fun i => if i = idx then .blank else readBackWrite (wHeads i), + readBackWrite oHead, idleDir iHead, + fun i => if i = idx then Dir3.right else idleDir (wHeads i), + idleDir oHead) + | .done => allIdle .done iHead wHeads oHead + δ_right_of_start := by + intro state iHead wHeads oHead + match state with + | .scanning => + dsimp only []; split + · exact rightOfStart_allIdle iHead wHeads oHead + · refine ⟨idleDir_right_of_start, ?_, idleDir_right_of_start⟩ + intro i hwi; simp only []; split + · rfl + · exact idleDir_right_of_start hwi + | .done => exact rightOfStart_allIdle iHead wHeads oHead + +/-- Blank a started work tape and rewind it to cell `1`, yielding the standard +started blank tape shape. -/ +def clearWorkTM (idx : Fin n) : TM n := + seqTM (blankWorkTM idx) (rewindWorkTM idx) + +-- ════════════════════════════════════════════════════════════════════════ +-- copyInputToWorkTM: copy input tape to a work tape +-- ════════════════════════════════════════════════════════════════════════ + +/-- State space shared by the input/work/output copy machines: copy symbols +rightward until the source reads `Γ.blank`, then halt. -/ +inductive CopyPhase where + | copying | done + deriving DecidableEq + +instance : Fintype CopyPhase where + elems := {.copying, .done} + complete := fun x => by cases x <;> simp + +/-- Copy input tape data to work tape `idx`. Reads input right, writes to work tape. + Stops when input reads `Γ.blank`. Skips ▷ at cell 0. -/ +def copyInputToWorkTM (idx : Fin n) : TM n where + Q := CopyPhase + qstart := .copying + qhalt := .done + δ := fun state iHead wHeads oHead => + match state with + | .copying => + if iHead = Γ.blank then + allIdle .done iHead wHeads oHead + else + let w : Γw := match iHead with + | .zero => .zero | .one => .one | .blank => .blank | .start => .blank + (.copying, + fun i => if i = idx then w else .blank, + .blank, Dir3.right, + fun i => if i = idx then Dir3.right else idleDir (wHeads i), + idleDir oHead) + | .done => allIdle .done iHead wHeads oHead + δ_right_of_start := by + intro state iHead wHeads oHead + match state with + | .copying => + dsimp only []; split + · exact rightOfStart_allIdle iHead wHeads oHead + · refine ⟨fun _ => rfl, ?_, idleDir_right_of_start⟩ + intro i hwi; simp only []; split + · rfl + · exact idleDir_right_of_start hwi + | .done => exact rightOfStart_allIdle iHead wHeads oHead + +/-- Copy the Boolean input to the output tape while scanning both tapes +rightward. The first transition skips the left-end markers, each subsequent +nonblank input symbol is written to the output, and the machine halts at the +first input blank. Work-tape contents are preserved; heads reading the +left-end marker take their required one-cell rightward bounce. -/ +def copyInputToOutputTM : TM n where + Q := CopyPhase + qstart := .copying + qhalt := .done + δ := fun state iHead wHeads oHead => + match state with + | .copying => + if iHead = Γ.blank then + (.done, fun i => readBackWrite (wHeads i), readBackWrite oHead, + idleDir iHead, fun i => idleDir (wHeads i), idleDir oHead) + else + (.copying, fun i => readBackWrite (wHeads i), readBackWrite iHead, + Dir3.right, fun i => idleDir (wHeads i), Dir3.right) + | .done => allIdle .done iHead wHeads oHead + δ_right_of_start := by + intro state iHead wHeads oHead + match state with + | .copying => + dsimp only [] + split + · exact ⟨idleDir_right_of_start, fun _ => idleDir_right_of_start, + idleDir_right_of_start⟩ + · exact ⟨fun _ => rfl, fun _ => idleDir_right_of_start, fun _ => rfl⟩ + | .done => exact rightOfStart_allIdle iHead wHeads oHead + +/-- Copy the contents of work tape `src` to work tape `dst`. Reads `src` +right, writes the same bits to `dst`, and stops when `src` reads `Γ.blank`. +The source tape contents are preserved by writing the currently read symbol +back before moving right. -/ +def copyWorkToWorkTM (src dst : Fin n) : TM n where + Q := CopyPhase + qstart := .copying + qhalt := .done + δ := fun state iHead wHeads oHead => + match state with + | .copying => + if wHeads src = Γ.blank then + (.done, + fun i => readBackWrite (wHeads i), + readBackWrite oHead, idleDir iHead, + fun i => idleDir (wHeads i), + idleDir oHead) + else + let w : Γw := match wHeads src with + | .zero => .zero | .one => .one | .blank => .blank | .start => .blank + (.copying, + fun i => if i = dst then w else readBackWrite (wHeads i), + readBackWrite oHead, idleDir iHead, + fun i => if i = dst then Dir3.right + else if i = src then Dir3.right else idleDir (wHeads i), + idleDir oHead) + | .done => allIdle .done iHead wHeads oHead + δ_right_of_start := by + intro state iHead wHeads oHead + match state with + | .copying => + dsimp only []; split + · exact rightOfStart_allIdle iHead wHeads oHead + · refine ⟨idleDir_right_of_start, ?_, idleDir_right_of_start⟩ + intro i hwi + simp only [] + split + · rfl + · split + · rfl + · exact idleDir_right_of_start hwi + | .done => exact rightOfStart_allIdle iHead wHeads oHead + +-- ════════════════════════════════════════════════════════════════════════ +-- compareWorkTapesTM: compare two work tapes cell by cell +-- ════════════════════════════════════════════════════════════════════════ + +/-- State space of `compareWorkTapesTM`: compare cells while both tapes agree, +ending in `matchDone` (equal) or `mismatch` (unequal) before halting. -/ +inductive ComparePhase where + | comparing | mismatch | matchDone | done + deriving DecidableEq + +instance : Fintype ComparePhase where + elems := {.comparing, .mismatch, .matchDone, .done} + complete := fun x => by cases x <;> simp + +/-- Compare work tapes `idx₁` and `idx₂` cell by cell. + Both advance right together. Stops when both read `Γ.blank`. + Writes `Γ.one` to output if match, `Γ.zero` if mismatch. + Assumes output head is at cell 1. -/ +def compareWorkTapesTM (idx₁ idx₂ : Fin n) : TM n where + Q := ComparePhase + qstart := .comparing + qhalt := .done + δ := fun state iHead wHeads oHead => + match state with + | .comparing => + if wHeads idx₁ = Γ.blank ∧ wHeads idx₂ = Γ.blank then + (.matchDone, fun _ => .blank, .one, + idleDir iHead, fun i => idleDir (wHeads i), idleDir oHead) + else if wHeads idx₁ = wHeads idx₂ then + (.comparing, + fun i => if i = idx₁ then readBackWrite (wHeads idx₁) + else if i = idx₂ then readBackWrite (wHeads idx₂) + else .blank, + .blank, idleDir iHead, + fun i => if i = idx₁ then Dir3.right + else if i = idx₂ then Dir3.right + else idleDir (wHeads i), + idleDir oHead) + else + (.mismatch, fun _ => .blank, .zero, + idleDir iHead, fun i => idleDir (wHeads i), idleDir oHead) + | .mismatch => allIdle .done iHead wHeads oHead + | .matchDone => allIdle .done iHead wHeads oHead + | .done => allIdle .done iHead wHeads oHead + δ_right_of_start := by + intro state iHead wHeads oHead + match state with + | .comparing => + dsimp only []; split + · exact ⟨idleDir_right_of_start, fun _ => idleDir_right_of_start, + idleDir_right_of_start⟩ + · split + · refine ⟨idleDir_right_of_start, ?_, idleDir_right_of_start⟩ + intro i hwi; simp only []; split + · rfl + · split + · rfl + · exact idleDir_right_of_start hwi + · exact ⟨idleDir_right_of_start, fun _ => idleDir_right_of_start, + idleDir_right_of_start⟩ + | .mismatch => exact rightOfStart_allIdle iHead wHeads oHead + | .matchDone => exact rightOfStart_allIdle iHead wHeads oHead + | .done => exact rightOfStart_allIdle iHead wHeads oHead + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryAddConst.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryAddConst.lean new file mode 100644 index 0000000000..ce7669769a --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryAddConst.lean @@ -0,0 +1,110 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryAddConst.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryAddConst.Internal + +/-! +# Addition of a fixed natural to a canonical binary tape + +This module exposes the literal-frame and resource contracts for a finite +sequence of binary successors compiled from a hardwired natural constant. + +## Main results + +- `binaryAddConstTM_reachesIn_frame` gives the exact runtime and endpoint. +- `binaryAddConstTM_hoareTime_frame` packages the exact literal frame. +- `binaryAddConstTM_hoareTimeSpace_frame` gives a width-based prefix bound. +- `binaryAddConstTM_isTransducer` proves append-only-output safety. +-/ + + +public section + +namespace Complexity + +namespace TM + +variable {n : ℕ} + +/-- Fixed-fixedValue addition has the advertised exact runtime and changes only +the destination tape. -/ +theorem binaryAddConstTM_reachesIn_frame + (idx : Fin n) (fixedValue dstValue : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hdst : (work₀ idx).HasBinaryNat dstValue) + (hinp : Parked inp₀) + (hother : ∀ i, i ≠ idx → Parked (work₀ i)) + (hout : Parked out₀) : + (binaryAddConstTM idx fixedValue).reachesIn + (binaryAddConstTime fixedValue dstValue) + { state := (binaryAddConstTM idx fixedValue).qstart + input := inp₀ + work := work₀ + output := out₀ } + { state := (binaryAddConstTM idx fixedValue).qhalt + input := inp₀ + work := Function.update work₀ idx + ((Tape.init ((dstValue + fixedValue).bits.map Γ.ofBool)).move + Dir3.right) + output := out₀ } := + binaryAddConstTM_reachesIn_frame_internal idx fixedValue dstValue inp₀ work₀ + out₀ hdst hinp hother hout + +/-- Time-bounded literal-frame contract for fixed-fixedValue addition. -/ +theorem binaryAddConstTM_hoareTime_frame + (idx : Fin n) (fixedValue dstValue : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hdst : (work₀ idx).HasBinaryNat dstValue) + (hinp : Parked inp₀) + (hother : ∀ i, i ≠ idx → Parked (work₀ i)) + (hout : Parked out₀) : + (binaryAddConstTM idx fixedValue).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + work = Function.update work₀ idx + ((Tape.init ((dstValue + fixedValue).bits.map Γ.ofBool)).move + Dir3.right) ∧ + out = out₀) + (binaryAddConstTime fixedValue dstValue) := + binaryAddConstTM_hoareTime_frame_internal idx fixedValue dstValue inp₀ work₀ + out₀ hdst hinp hother hout + +/-- Every prefix of fixed-fixedValue addition respects a bound controlled by +the final destination width. -/ +theorem binaryAddConstTM_hoareTimeSpace_frame + (idx : Fin n) (fixedValue dstValue inputLength initialSpace : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hdst : (work₀ idx).HasBinaryNat dstValue) + (hinp : Parked inp₀) + (hother : ∀ i, i ≠ idx → Parked (work₀ i)) + (hout : Parked out₀) + (hworkSpace : ∀ i, (work₀ i).head ≤ initialSpace) + (hinputSpace : inp₀.head ≤ inputLength + initialSpace + 1) : + (binaryAddConstTM idx fixedValue).HoareTimeSpace + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + work = Function.update work₀ idx + ((Tape.init ((dstValue + fixedValue).bits.map Γ.ofBool)).move + Dir3.right) ∧ + out = out₀) + (binaryAddConstTime fixedValue dstValue) inputLength + (binaryAddConstSpace initialSpace fixedValue dstValue) := + binaryAddConstTM_hoareTimeSpace_frame_internal idx fixedValue dstValue + inputLength initialSpace inp₀ work₀ out₀ hdst hinp hother hout + hworkSpace hinputSpace + +/-- Fixed-fixedValue addition never moves its output head left. -/ +theorem binaryAddConstTM_isTransducer (idx : Fin n) (fixedValue : ℕ) : + (binaryAddConstTM idx fixedValue).IsTransducer := + binaryAddConstTM_isTransducer_internal idx fixedValue + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryAddConst/Defs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryAddConst/Defs.lean new file mode 100644 index 0000000000..157c0c731a --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryAddConst/Defs.lean @@ -0,0 +1,47 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Registers.RegisterOps +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinarySucc.Defs + +/-! +# Addition of a fixed natural to a canonical binary tape — definitions + +A fixed fixedValue is compiled into finitely many sequential applications of +canonical binary successor. No work tape is needed for the hardwired value, +so the construction preserves every tape except its destination. +-/ + + +@[expose] public section + +namespace Complexity + +namespace TM + +/-- Add a hardwired natural to one canonical binary work tape. -/ +def binaryAddConstTM {n : ℕ} (idx : Fin n) : ℕ → TM n + | 0 => skipTM + | fixedValue + 1 => + seqTM (binaryAddConstTM idx fixedValue) (binarySuccTM idx) + +/-- Exact runtime of fixed-fixedValue binary addition. -/ +def binaryAddConstTime (fixedValue dstValue : ℕ) : ℕ := + match fixedValue with + | 0 => 1 + | fixedValue + 1 => + binaryAddConstTime fixedValue dstValue + 1 + + binarySuccTime (dstValue + fixedValue) + +/-- All-prefix width-based space bound for fixed-fixedValue addition. -/ +def binaryAddConstSpace + (initialSpace fixedValue dstValue : ℕ) : ℕ := + initialSpace + 2 * (dstValue + fixedValue).size + 3 + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryAddConst/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryAddConst/Internal.lean new file mode 100644 index 0000000000..1f3daba55b --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryAddConst/Internal.lean @@ -0,0 +1,402 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryAddConst.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinarySucc + +/-! +# Addition of a fixed natural to a canonical binary tape — proof internals + +The proof follows the definition-level finite successor chain. Exact runs +compose through `seqTM`; the all-prefix space induction uses the largest +destination width rather than the total successor-chain runtime. +-/ + + +@[expose] public section + +namespace Complexity + +namespace TM + +variable {n : ℕ} + +/-- Canonical parked tape encoding of a natural for fixedValue addition. -/ +def binaryAddConstNatTape (value : ℕ) : Tape := + (Tape.init (value.bits.map Γ.ofBool)).move Dir3.right + +private theorem binaryAddConstNatTape_hasBinaryNat (value : ℕ) : + (binaryAddConstNatTape value).HasBinaryNat value := + Tape.init_move_right_hasBinaryNat value + +private theorem binaryAddConstHasBinaryNat_parked {t : Tape} {value : ℕ} + (h : t.HasBinaryNat value) : Parked t := by + refine ⟨by rw [h.2.1], ?_⟩ + exact Tape.HasBinaryContent.cells_ne_start h.2.2 + +private theorem binaryAddConstNatTape_parked (value : ℕ) : + Parked (binaryAddConstNatTape value) := + binaryAddConstHasBinaryNat_parked + (binaryAddConstNatTape_hasBinaryNat value) + +private def binaryAddConstWorkAt (work : Fin n → Tape) (idx : Fin n) + (dstValue current : ℕ) : Fin n → Tape := + Function.update work idx (binaryAddConstNatTape (dstValue + current)) + +private theorem binaryAddConstWorkAt_target + (work : Fin n → Tape) (idx : Fin n) (dstValue current : ℕ) : + binaryAddConstWorkAt work idx dstValue current idx = + binaryAddConstNatTape (dstValue + current) := by + simp [binaryAddConstWorkAt] + +private theorem binaryAddConstWorkAt_other + (work : Fin n → Tape) {idx i : Fin n} (hne : i ≠ idx) + (dstValue current : ℕ) : + binaryAddConstWorkAt work idx dstValue current i = work i := by + simp [binaryAddConstWorkAt, hne] + +private theorem binaryAddConstWorkAt_target_hasBinaryNat + (work : Fin n → Tape) (idx : Fin n) (dstValue current : ℕ) : + (binaryAddConstWorkAt work idx dstValue current idx).HasBinaryNat + (dstValue + current) := by + rw [binaryAddConstWorkAt_target] + exact binaryAddConstNatTape_hasBinaryNat _ + +private theorem binaryAddConstWorkAt_parked + (work : Fin n → Tape) (idx : Fin n) (dstValue current : ℕ) + (hwork : ∀ i, Parked (work i)) : + ∀ i, Parked (binaryAddConstWorkAt work idx dstValue current i) := by + intro i + by_cases hi : i = idx + · subst i + rw [binaryAddConstWorkAt_target] + exact binaryAddConstNatTape_parked _ + · rw [binaryAddConstWorkAt_other work hi] + exact hwork i + +private theorem binaryAddConstWorkAt_zero_eq + (work : Fin n → Tape) (idx : Fin n) (dstValue : ℕ) + (hdst : (work idx).HasBinaryNat dstValue) : + binaryAddConstWorkAt work idx dstValue 0 = work := by + funext i + by_cases hi : i = idx + · subst i + rw [binaryAddConstWorkAt_target] + simpa [binaryAddConstNatTape] using hdst.eq_init_move_right.symm + · exact binaryAddConstWorkAt_other work hi dstValue 0 + +private theorem binaryAddConstWorkAt_succ_eq + (work : Fin n → Tape) (idx : Fin n) (dstValue current : ℕ) : + Function.update (binaryAddConstWorkAt work idx dstValue current) idx + (binaryAddConstNatTape (dstValue + current + 1)) = + binaryAddConstWorkAt work idx dstValue (current + 1) := by + funext i + by_cases hi : i = idx + · subst i + simp [binaryAddConstWorkAt, Nat.add_assoc] + · simp [binaryAddConstWorkAt, hi] + +private theorem binaryAddConstInitialWork_parked + (work : Fin n → Tape) (idx : Fin n) {dstValue : ℕ} + (hdst : (work idx).HasBinaryNat dstValue) + (hother : ∀ i, i ≠ idx → Parked (work i)) : + ∀ i, Parked (work i) := by + intro i + by_cases hi : i = idx + · subst i + exact binaryAddConstHasBinaryNat_parked hdst + · exact hother i hi + +/-- Predicate fixing the tapes framing a fixedValue-addition execution. -/ +abbrev binaryAddConstFramePred + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) : TapePred n := + fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀ + +private theorem skipTM_reachesIn_frame + (inp : Tape) (work : Fin n → Tape) (out : Tape) + (hinp : Parked inp) (hwork : ∀ i, Parked (work i)) + (hout : Parked out) : + (skipTM (n := n)).reachesIn 1 + { state := (skipTM (n := n)).qstart + input := inp + work := work + output := out } + { state := (skipTM (n := n)).qhalt + input := inp + work := work + output := out } := by + have hstep : (skipTM (n := n)).step + { state := .go, input := inp, work := work, output := out } = some + { state := .done, input := inp, work := work, output := out } := by + simp only [TM.step, skipTM, reduceCtorEq, ↓reduceIte] + refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, ?_, ?_, ?_⟩) + · exact hinp.move_idle + · funext i + exact (hwork i).writeAndMove_readBack_idle + · exact hout.writeAndMove_readBack_idle + exact .step hstep .zero + +private theorem binaryAddConstSucc_reachesIn + (idx : Fin n) (dstValue current : ℕ) + (inp : Tape) (work : Fin n → Tape) (out : Tape) + (hinp : Parked inp) (hwork : ∀ i, Parked (work i)) + (hout : Parked out) : + (binarySuccTM idx).reachesIn (binarySuccTime (dstValue + current)) + { state := (binarySuccTM idx).qstart + input := inp + work := binaryAddConstWorkAt work idx dstValue current + output := out } + { state := (binarySuccTM idx).qhalt + input := inp + work := binaryAddConstWorkAt work idx dstValue (current + 1) + output := out } := by + have hworkAt := binaryAddConstWorkAt_parked work idx dstValue current hwork + obtain ⟨c', hreach, hhalt, hinput, hother, htarget, houtput⟩ := + binarySuccTM_reachesIn_frame idx (dstValue + current) inp + (binaryAddConstWorkAt work idx dstValue current) out + (binaryAddConstWorkAt_target_hasBinaryNat work idx dstValue current) + hinp.read_ne_start (fun i _ => (hworkAt i).read_ne_start) + hout.read_ne_start + have hworkEq : c'.work = + binaryAddConstWorkAt work idx dstValue (current + 1) := by + have hupdate : c'.work = Function.update + (binaryAddConstWorkAt work idx dstValue current) idx + (binaryAddConstNatTape (dstValue + current + 1)) := by + funext i + by_cases hi : i = idx + · subst i + rw [Function.update_self] + exact htarget.eq_init_move_right + · rw [Function.update_of_ne hi, hother i hi] + rw [hupdate, binaryAddConstWorkAt_succ_eq] + have hc' : c' = + { state := (binarySuccTM idx).qhalt + input := inp + work := binaryAddConstWorkAt work idx dstValue (current + 1) + output := out } := + Cfg.ext hhalt hinput hworkEq houtput + simpa [hc'] using hreach + +theorem binaryAddConstTM_reachesIn_frame_internal + (idx : Fin n) (fixedValue dstValue : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hdst : (work₀ idx).HasBinaryNat dstValue) + (hinp : Parked inp₀) + (hother : ∀ i, i ≠ idx → Parked (work₀ i)) + (hout : Parked out₀) : + (binaryAddConstTM idx fixedValue).reachesIn + (binaryAddConstTime fixedValue dstValue) + { state := (binaryAddConstTM idx fixedValue).qstart + input := inp₀ + work := work₀ + output := out₀ } + { state := (binaryAddConstTM idx fixedValue).qhalt + input := inp₀ + work := Function.update work₀ idx + (binaryAddConstNatTape (dstValue + fixedValue)) + output := out₀ } := by + have hwork := binaryAddConstInitialWork_parked work₀ idx hdst hother + induction fixedValue with + | zero => + have hrun := skipTM_reachesIn_frame inp₀ work₀ out₀ hinp hwork hout + simp only [binaryAddConstTM, binaryAddConstTime] + have heq : Function.update work₀ idx + (binaryAddConstNatTape (dstValue + 0)) = work₀ := by + simpa [binaryAddConstWorkAt] using + binaryAddConstWorkAt_zero_eq work₀ idx dstValue hdst + rw [heq] + exact hrun + | succ fixedValue ih => + have hprev := ih + have hprevWork := binaryAddConstWorkAt_parked work₀ idx dstValue + fixedValue hwork + have hnext := binaryAddConstSucc_reachesIn idx dstValue fixedValue inp₀ + work₀ out₀ hinp hwork hout + have hnext' : (binarySuccTM idx).reachesIn + (binarySuccTime (dstValue + fixedValue)) + { state := (binarySuccTM idx).qstart + input := transitionInput inp₀ + work := fun i => transitionTape + (binaryAddConstWorkAt work₀ idx dstValue fixedValue i) + output := transitionTape out₀ } + { state := (binarySuccTM idx).qhalt + input := inp₀ + work := binaryAddConstWorkAt work₀ idx dstValue (fixedValue + 1) + output := out₀ } := by + simpa only [hinp.transitionInput_eq_self, + hout.transitionTape_eq_self, + funext fun i => (hprevWork i).transitionTape_eq_self] using hnext + have hseq := seqTM_reachesIn_of_reachesIn + (binaryAddConstTM idx fixedValue) (binarySuccTM idx) hprev rfl hnext' + simpa [binaryAddConstTM, binaryAddConstTime, binaryAddConstNatTape, + binaryAddConstWorkAt] using hseq + +theorem binaryAddConstTM_hoareTime_frame_internal + (idx : Fin n) (fixedValue dstValue : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hdst : (work₀ idx).HasBinaryNat dstValue) + (hinp : Parked inp₀) + (hother : ∀ i, i ≠ idx → Parked (work₀ i)) + (hout : Parked out₀) : + (binaryAddConstTM idx fixedValue).HoareTime + (binaryAddConstFramePred inp₀ work₀ out₀) + (binaryAddConstFramePred inp₀ + (Function.update work₀ idx + (binaryAddConstNatTape (dstValue + fixedValue))) out₀) + (binaryAddConstTime fixedValue dstValue) := by + intro inp work out hpre + obtain ⟨hinput, hworkEq, houtput⟩ := hpre + subst inp + subst work + subst out + let c' : Cfg n (binaryAddConstTM idx fixedValue).Q := + { state := (binaryAddConstTM idx fixedValue).qhalt + input := inp₀ + work := Function.update work₀ idx + (binaryAddConstNatTape (dstValue + fixedValue)) + output := out₀ } + refine ⟨c', binaryAddConstTime fixedValue dstValue, le_rfl, ?_, rfl, ?_⟩ + · exact binaryAddConstTM_reachesIn_frame_internal idx fixedValue dstValue + inp₀ work₀ out₀ hdst hinp hother hout + · exact ⟨rfl, rfl, rfl⟩ + +private theorem binaryAddConstWorkAt_cfg_withinAuxSpace + {Q : Type} (state : Q) (inp : Tape) (work : Fin n → Tape) + (out : Tape) (idx : Fin n) (dstValue current inputLength initialSpace : ℕ) + (hdst : (work idx).HasBinaryNat dstValue) + (hworkSpace : ∀ i, (work i).head ≤ initialSpace) + (hinputSpace : inp.head ≤ inputLength + initialSpace + 1) : + ({ state := state + input := inp + work := binaryAddConstWorkAt work idx dstValue current + output := out } : Cfg n Q).WithinAuxSpace inputLength initialSpace := by + constructor + · intro i + change (binaryAddConstWorkAt work idx dstValue current i).head ≤ + initialSpace + by_cases hi : i = idx + · subst i + rw [binaryAddConstWorkAt_target, + (binaryAddConstNatTape_hasBinaryNat (dstValue + current)).2.1, + ← hdst.2.1] + exact hworkSpace idx + · rw [binaryAddConstWorkAt_other work hi] + exact hworkSpace i + · exact hinputSpace + +private theorem binaryAddConstFrame_transition + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hinp : Parked inp₀) (hwork : ∀ i, Parked (work₀ i)) + (hout : Parked out₀) : + ∀ inp work out, binaryAddConstFramePred inp₀ work₀ out₀ inp work out → + binaryAddConstFramePred inp₀ work₀ out₀ + (transitionInput inp) (fun i => transitionTape (work i)) + (transitionTape out) := by + rintro _ _ _ ⟨rfl, rfl, rfl⟩ + refine ⟨hinp.transitionInput_eq_self, ?_, hout.transitionTape_eq_self⟩ + funext i + exact (hwork i).transitionTape_eq_self + +theorem binaryAddConstTM_hoareTimeSpace_frame_internal + (idx : Fin n) (fixedValue dstValue inputLength initialSpace : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hdst : (work₀ idx).HasBinaryNat dstValue) + (hinp : Parked inp₀) + (hother : ∀ i, i ≠ idx → Parked (work₀ i)) + (hout : Parked out₀) + (hworkSpace : ∀ i, (work₀ i).head ≤ initialSpace) + (hinputSpace : inp₀.head ≤ inputLength + initialSpace + 1) : + (binaryAddConstTM idx fixedValue).HoareTimeSpace + (binaryAddConstFramePred inp₀ work₀ out₀) + (binaryAddConstFramePred inp₀ + (Function.update work₀ idx + (binaryAddConstNatTape (dstValue + fixedValue))) out₀) + (binaryAddConstTime fixedValue dstValue) inputLength + (binaryAddConstSpace initialSpace fixedValue dstValue) := by + have hwork := binaryAddConstInitialWork_parked work₀ idx hdst hother + induction fixedValue with + | zero => + have htime := binaryAddConstTM_hoareTime_frame_internal idx 0 dstValue + inp₀ work₀ out₀ hdst hinp hother hout + have hrun := htime.toHoareTimeSpace (by + rintro _ _ _ ⟨rfl, rfl, rfl⟩ + constructor + · exact hworkSpace + · exact hinputSpace) + exact hrun.consequence (fun _ _ _ h => h) (fun _ _ _ h => h) + le_rfl le_rfl (by + simp [binaryAddConstSpace, binaryAddConstTime] + omega) + | succ fixedValue ih => + let midWork := binaryAddConstWorkAt work₀ idx dstValue fixedValue + have hmidWork := binaryAddConstWorkAt_parked work₀ idx dstValue + fixedValue hwork + have hmidTarget := binaryAddConstWorkAt_target_hasBinaryNat work₀ idx + dstValue fixedValue + have hmidSpace : ∀ i, (midWork i).head ≤ initialSpace := by + have hcfg := binaryAddConstWorkAt_cfg_withinAuxSpace Unit.unit inp₀ + work₀ out₀ idx dstValue fixedValue inputLength initialSpace hdst + hworkSpace hinputSpace + exact hcfg.1 + have hsucc := binarySuccTM_hoareTimeSpace_frame idx + (dstValue + fixedValue) inputLength initialSpace inp₀ midWork out₀ + (by simpa [midWork] using hmidTarget) hinp.read_ne_start + (fun i _ => (hmidWork i).read_ne_start) hout.read_ne_start + (by + constructor + · exact hmidSpace + · exact hinputSpace) + have hsucc' : (binarySuccTM idx).HoareTimeSpace + (binaryAddConstFramePred inp₀ midWork out₀) + (binaryAddConstFramePred inp₀ + (binaryAddConstWorkAt work₀ idx dstValue (fixedValue + 1)) out₀) + (binarySuccTime (dstValue + fixedValue)) inputLength + (initialSpace + binarySuccTime (dstValue + fixedValue)) := by + refine hsucc.consequence (fun _ _ _ h => h) (fun inp work out h => ?_) + le_rfl le_rfl le_rfl + refine ⟨h.1, ?_, h.2.2.2⟩ + have hworkEq : work = Function.update midWork idx + (binaryAddConstNatTape (dstValue + fixedValue + 1)) := by + funext i + by_cases hi : i = idx + · subst i + rw [Function.update_self] + exact h.2.2.1.eq_init_move_right + · rw [Function.update_of_ne hi, h.2.1 i hi] + rw [hworkEq] + simpa [midWork] using + binaryAddConstWorkAt_succ_eq work₀ idx dstValue fixedValue + have hseq := seqTM_hoareTimeSpace (binaryAddConstTM idx fixedValue) + (binarySuccTM idx) ih + (binaryAddConstFrame_transition inp₀ midWork out₀ hinp hmidWork hout) + hsucc' + refine hseq.consequence (fun _ _ _ h => h) (fun _ _ _ h => h) + (by simp [binaryAddConstTime]) le_rfl ?_ + have hprevSize : (dstValue + fixedValue).size ≤ + (dstValue + (fixedValue + 1)).size := + Nat.size_le_size (by omega) + have hsuccTime := binarySuccTime_le (dstValue + fixedValue) + simp [binaryAddConstSpace] at ⊢ + omega + +theorem binaryAddConstTM_isTransducer_internal + (idx : Fin n) (fixedValue : ℕ) : + (binaryAddConstTM idx fixedValue).IsTransducer := by + induction fixedValue with + | zero => + intro state iHead wHeads oHead + cases state + all_goals + simp [binaryAddConstTM, skipTM, idleDir] + split <;> decide + | succ fixedValue ih => + simpa [binaryAddConstTM] using + ih.seqTM (binarySuccTM_isTransducer idx) + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryCopy.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryCopy.lean new file mode 100644 index 0000000000..0ebcb18fdf --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryCopy.lean @@ -0,0 +1,109 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryCopy.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryCopy.Internal + +/-! +# Copying canonical binary naturals + +This module exposes a literal-frame copy operation assembled from work-tape +clearing and width-linear ripple addition. The source is preserved, the +destination becomes an exact copy, and the zero scratch is restored literally. + +## Main results + +- `TM.binaryCopyIntoTM_hoareTime_frame` gives the literal endpoint and time bound. +- `TM.binaryCopyIntoTM_hoareTimeSpace_frame` adds an all-prefix width bound. +- `TM.binaryCopyTime_le` exposes the linear operand-width envelope. +- `TM.binaryCopyIntoTM_isTransducer` proves append-only-output safety. +-/ + + +public section + +namespace Complexity + +namespace TM + +variable {n : ℕ} + +/-- Canonical binary copying is linear in the source and old-destination +widths. -/ +theorem binaryCopyTime_le (srcValue dstValue : ℕ) : + binaryCopyTime srcValue dstValue ≤ + 3 * srcValue.size + 2 * dstValue.size + 20 := + binaryCopyTime_le_internal srcValue dstValue + +/-- Binary copying changes only the destination tape. The source, zero +counter, input, output, and every unrelated work tape are preserved literally. -/ +theorem binaryCopyIntoTM_hoareTime_frame + (srcIdx dstIdx counterIdx : Fin n) + (hsrcDst : srcIdx ≠ dstIdx) (hsrcCounter : srcIdx ≠ counterIdx) + (hdstCounter : dstIdx ≠ counterIdx) + (srcValue dstValue : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hsrc : (work₀ srcIdx).HasBinaryNat srcValue) + (hdst : (work₀ dstIdx).HasBinaryNat dstValue) + (hcounter : (work₀ counterIdx).HasBinaryNat 0) + (hinp : Parked inp₀) + (hother : ∀ i, i ≠ srcIdx → i ≠ dstIdx → i ≠ counterIdx → + Parked (work₀ i)) + (hout : Parked out₀) : + (binaryCopyIntoTM srcIdx dstIdx counterIdx).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + work = Function.update work₀ dstIdx + ((Tape.init (srcValue.bits.map Γ.ofBool)).move Dir3.right) ∧ + out = out₀) + (binaryCopyTime srcValue dstValue) := + binaryCopyIntoTM_hoareTime_frame_internal srcIdx dstIdx counterIdx + hsrcDst hsrcCounter hdstCounter srcValue dstValue inp₀ work₀ out₀ + hsrc hdst hcounter hinp hother hout + +/-- Time-and-space form of canonical binary copying. Every reachable +configuration stays within the maximum of the clearing and ripple-addition +bounds. -/ +theorem binaryCopyIntoTM_hoareTimeSpace_frame + (srcIdx dstIdx counterIdx : Fin n) + (hsrcDst : srcIdx ≠ dstIdx) (hsrcCounter : srcIdx ≠ counterIdx) + (hdstCounter : dstIdx ≠ counterIdx) + (srcValue dstValue inputLength initialSpace : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hsrc : (work₀ srcIdx).HasBinaryNat srcValue) + (hdst : (work₀ dstIdx).HasBinaryNat dstValue) + (hcounter : (work₀ counterIdx).HasBinaryNat 0) + (hinp : Parked inp₀) + (hother : ∀ i, i ≠ srcIdx → i ≠ dstIdx → i ≠ counterIdx → + Parked (work₀ i)) + (hout : Parked out₀) + (hworkSpace : ∀ i, (work₀ i).head ≤ initialSpace) + (hinputSpace : inp₀.head ≤ inputLength + initialSpace + 1) : + (binaryCopyIntoTM srcIdx dstIdx counterIdx).HoareTimeSpace + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + work = Function.update work₀ dstIdx + ((Tape.init (srcValue.bits.map Γ.ofBool)).move Dir3.right) ∧ + out = out₀) + (binaryCopyTime srcValue dstValue) inputLength + (binaryCopySpace initialSpace srcValue dstValue) := + binaryCopyIntoTM_hoareTimeSpace_frame_internal srcIdx dstIdx counterIdx + hsrcDst hsrcCounter hdstCounter srcValue dstValue inputLength + initialSpace inp₀ work₀ out₀ hsrc hdst hcounter hinp hother hout + hworkSpace hinputSpace + +/-- Canonical binary copying never moves the output head left. -/ +theorem binaryCopyIntoTM_isTransducer + (srcIdx dstIdx counterIdx : Fin n) : + (binaryCopyIntoTM srcIdx dstIdx counterIdx).IsTransducer := + binaryCopyIntoTM_isTransducer_internal srcIdx dstIdx counterIdx + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryCopy/Defs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryCopy/Defs.lean new file mode 100644 index 0000000000..81170a9cd5 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryCopy/Defs.lean @@ -0,0 +1,45 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleAdd.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.ClearWork.Defs + +/-! +# Copying canonical binary naturals + +This definitions layer composes work-tape clearing with width-linear canonical +binary addition. The source and zero scratch tapes are preserved, while the +destination is replaced by an exact copy of the source. +-/ + + +@[expose] public section + +namespace Complexity + +namespace TM + +/-- Clear `dstIdx`, then copy the canonical binary natural on `srcIdx` into it. +The distinct `counterIdx` supplies the preserved zero operand to ripple +addition, and `dstIdx` is its fresh result tape. -/ +def binaryCopyIntoTM {n : ℕ} + (srcIdx dstIdx counterIdx : Fin n) : TM n := + seqTM (clearWorkTM dstIdx) + (binaryRippleAddTM srcIdx counterIdx dstIdx) + +/-- Compositional running-time bound for canonical binary copying. -/ +def binaryCopyTime (srcValue dstValue : ℕ) : ℕ := + clearWorkTimeBound dstValue.size + 1 + binaryRippleAddTime srcValue 0 + +/-- All-prefix auxiliary-space bound for canonical binary copying. -/ +def binaryCopySpace (initialSpace srcValue dstValue : ℕ) : ℕ := + max (initialSpace + clearWorkTimeBound dstValue.size) + (initialSpace + binaryRippleAddTime srcValue 0) + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryCopy/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryCopy/Internal.lean new file mode 100644 index 0000000000..0a6a17c322 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryCopy/Internal.lean @@ -0,0 +1,314 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleAdd +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryCopy.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.ClearWork + +/-! +# Copying canonical binary naturals -- proof internals + +The copy machine first clears its destination and then invokes width-linear +ripple addition with the source and zero counter as preserved operands. These +proofs compose the public literal-frame and all-prefix contracts of both +phases, then recover the original literal copy frame from canonicality. +-/ + + +@[expose] public section + +namespace Complexity + +namespace TM + +variable {n : ℕ} + +/-- Canonical parked tape encoding of a natural for binary copying. -/ +def binaryCopyNatTape (value : ℕ) : Tape := + (Tape.init (value.bits.map Γ.ofBool)).move Dir3.right + +private theorem binaryCopyNatTape_hasBinaryNat (value : ℕ) : + (binaryCopyNatTape value).HasBinaryNat value := + Tape.init_move_right_hasBinaryNat value + +private theorem binaryCopyHasBinaryNat_parked {t : Tape} {value : ℕ} + (h : t.HasBinaryNat value) : Parked t := by + refine ⟨by rw [h.2.1], ?_⟩ + exact Tape.HasBinaryContent.cells_ne_start h.2.2 + +private theorem binaryCopyNatTape_parked (value : ℕ) : + Parked (binaryCopyNatTape value) := + binaryCopyHasBinaryNat_parked (binaryCopyNatTape_hasBinaryNat value) + +private theorem binaryCopyInitialWork_parked + (srcIdx dstIdx counterIdx : Fin n) (srcValue dstValue : ℕ) + (work₀ : Fin n → Tape) + (hsrc : (work₀ srcIdx).HasBinaryNat srcValue) + (hdst : (work₀ dstIdx).HasBinaryNat dstValue) + (hcounter : (work₀ counterIdx).HasBinaryNat 0) + (hother : ∀ i, i ≠ srcIdx → i ≠ dstIdx → i ≠ counterIdx → + Parked (work₀ i)) : + ∀ i, Parked (work₀ i) := by + intro i + by_cases hsrcIdx : i = srcIdx + · subst i + exact binaryCopyHasBinaryNat_parked hsrc + by_cases hdstIdx : i = dstIdx + · subst i + exact binaryCopyHasBinaryNat_parked hdst + by_cases hcounterIdx : i = counterIdx + · subst i + exact binaryCopyHasBinaryNat_parked hcounter + exact hother i hsrcIdx hdstIdx hcounterIdx + +private def binaryCopyMidWork (work₀ : Fin n → Tape) (dstIdx : Fin n) : + Fin n → Tape := + Function.update work₀ dstIdx (binaryCopyNatTape 0) + +private theorem binaryCopyMidWork_parked + (work₀ : Fin n → Tape) (dstIdx : Fin n) + (hwork : ∀ i, Parked (work₀ i)) : + ∀ i, Parked (binaryCopyMidWork work₀ dstIdx i) := by + intro i + by_cases hi : i = dstIdx + · subst i + simp only [binaryCopyMidWork, Function.update_self] + exact binaryCopyNatTape_parked 0 + · rw [binaryCopyMidWork, Function.update_of_ne hi] + exact hwork i + +private theorem binaryCopyFrame_transition + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hinp : Parked inp₀) (hwork : ∀ i, Parked (work₀ i)) + (hout : Parked out₀) : + ∀ inp work out, + (inp = inp₀ ∧ work = work₀ ∧ out = out₀) → + transitionInput inp = inp₀ ∧ + (fun i => transitionTape (work i)) = work₀ ∧ + transitionTape out = out₀ := by + rintro _ _ _ ⟨rfl, rfl, rfl⟩ + refine ⟨hinp.transitionInput_eq_self, ?_, hout.transitionTape_eq_self⟩ + funext i + exact (hwork i).transitionTape_eq_self + +private theorem binaryCopyDistinct + (srcIdx dstIdx counterIdx : Fin n) + (hsrcDst : srcIdx ≠ dstIdx) (hsrcCounter : srcIdx ≠ counterIdx) + (hdstCounter : dstIdx ≠ counterIdx) : + BinaryRippleAddDistinct srcIdx counterIdx dstIdx := + ⟨hsrcCounter, hsrcDst, hdstCounter.symm⟩ + +private theorem binaryCopyRipplePost_eq + (srcIdx dstIdx counterIdx : Fin n) + (hsrcDst : srcIdx ≠ dstIdx) (hdstCounter : dstIdx ≠ counterIdx) + (srcValue : ℕ) (work₀ work : Fin n → Tape) + (hsrc₀ : (work₀ srcIdx).HasBinaryNat srcValue) + (hcounter₀ : (work₀ counterIdx).HasBinaryNat 0) + (hsrc : (work srcIdx).HasBinaryNat srcValue) + (hcounter : (work counterIdx).HasBinaryNat 0) + (hdst : (work dstIdx).HasBinaryNat srcValue) + (hother : ∀ i, i ≠ srcIdx → i ≠ counterIdx → i ≠ dstIdx → + work i = binaryCopyMidWork work₀ dstIdx i) : + work = Function.update work₀ dstIdx (binaryCopyNatTape srcValue) := by + funext i + by_cases hdstIdx : i = dstIdx + · subst i + rw [Function.update_self] + simpa [binaryCopyNatTape] using hdst.eq_init_move_right + by_cases hsrcIdx : i = srcIdx + · subst i + rw [Function.update_of_ne hsrcDst] + exact hsrc.eq_init_move_right.trans hsrc₀.eq_init_move_right.symm + by_cases hcounterIdx : i = counterIdx + · subst i + rw [Function.update_of_ne hdstCounter.symm] + exact hcounter.eq_init_move_right.trans hcounter₀.eq_init_move_right.symm + rw [Function.update_of_ne hdstIdx] + simpa [binaryCopyMidWork, hdstIdx] using + hother i hsrcIdx hcounterIdx hdstIdx + +theorem binaryCopyTime_le_internal (srcValue dstValue : ℕ) : + binaryCopyTime srcValue dstValue ≤ + 3 * srcValue.size + 2 * dstValue.size + 20 := by + have hadd := binaryRippleAddTime_le srcValue 0 + have hadd' : binaryRippleAddTime srcValue 0 ≤ + 3 * srcValue.size + 14 := by + simpa using hadd + simp only [binaryCopyTime, clearWorkTimeBound] + omega + +theorem binaryCopyIntoTM_hoareTime_frame_internal + (srcIdx dstIdx counterIdx : Fin n) + (hsrcDst : srcIdx ≠ dstIdx) (hsrcCounter : srcIdx ≠ counterIdx) + (hdstCounter : dstIdx ≠ counterIdx) + (srcValue dstValue : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hsrc : (work₀ srcIdx).HasBinaryNat srcValue) + (hdst : (work₀ dstIdx).HasBinaryNat dstValue) + (hcounter : (work₀ counterIdx).HasBinaryNat 0) + (hinp : Parked inp₀) + (hother : ∀ i, i ≠ srcIdx → i ≠ dstIdx → i ≠ counterIdx → + Parked (work₀ i)) + (hout : Parked out₀) : + (binaryCopyIntoTM srcIdx dstIdx counterIdx).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + work = Function.update work₀ dstIdx (binaryCopyNatTape srcValue) ∧ + out = out₀) + (binaryCopyTime srcValue dstValue) := by + let midWork := binaryCopyMidWork work₀ dstIdx + have hwork := binaryCopyInitialWork_parked srcIdx dstIdx counterIdx + srcValue dstValue work₀ hsrc hdst hcounter hother + have hmidWork : ∀ i, Parked (midWork i) := by + exact binaryCopyMidWork_parked work₀ dstIdx hwork + have hclear := clearWorkTM_hoareTime_frame dstIdx dstValue.bits + inp₀ work₀ out₀ hdst.eq_init_move_right hinp + (fun i _ => hwork i) hout + have hclear' : (clearWorkTM dstIdx).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => inp = inp₀ ∧ work = midWork ∧ out = out₀) + (clearWorkTimeBound dstValue.size) := by + simpa [midWork, binaryCopyMidWork, binaryCopyNatTape, + Nat.size_eq_bits_len] using hclear + have hmidSrc : (midWork srcIdx).HasBinaryNat srcValue := by + simpa [midWork, binaryCopyMidWork, hsrcDst] using hsrc + have hmidDst : (midWork dstIdx).HasBinaryNat 0 := by + simpa [midWork, binaryCopyMidWork] using + binaryCopyNatTape_hasBinaryNat 0 + have hmidCounter : (midWork counterIdx).HasBinaryNat 0 := by + simpa [midWork, binaryCopyMidWork, hdstCounter.symm] using hcounter + have hdistinct := binaryCopyDistinct srcIdx dstIdx counterIdx + hsrcDst hsrcCounter hdstCounter + have hadd := binaryRippleAddTM_hoareTime_frame + srcIdx counterIdx dstIdx hdistinct srcValue 0 inp₀ midWork out₀ + hmidSrc hmidCounter hmidDst hinp + (fun i _ _ _ => hmidWork i) hout + have hseq := seqTM_hoareTime (clearWorkTM dstIdx) + (binaryRippleAddTM srcIdx counterIdx dstIdx) hclear' + (binaryCopyFrame_transition inp₀ midWork out₀ hinp hmidWork hout) + hadd + apply hseq.consequence (b' := binaryCopyTime srcValue dstValue) + · intro _inp _work _out hpre + exact hpre + · rintro inp work out ⟨hinput, hfinalSrc, hfinalCounter, hfinalDst, + hfinalOther, houtput⟩ + exact ⟨hinput, binaryCopyRipplePost_eq srcIdx dstIdx counterIdx + hsrcDst hdstCounter srcValue work₀ work hsrc hcounter + hfinalSrc hfinalCounter (by simpa using hfinalDst) (by + intro i hiSrc hiCounter hiDst + exact hfinalOther i hiSrc hiCounter hiDst), houtput⟩ + · simp [binaryCopyTime] + +theorem binaryCopyIntoTM_hoareTimeSpace_frame_internal + (srcIdx dstIdx counterIdx : Fin n) + (hsrcDst : srcIdx ≠ dstIdx) (hsrcCounter : srcIdx ≠ counterIdx) + (hdstCounter : dstIdx ≠ counterIdx) + (srcValue dstValue inputLength initialSpace : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hsrc : (work₀ srcIdx).HasBinaryNat srcValue) + (hdst : (work₀ dstIdx).HasBinaryNat dstValue) + (hcounter : (work₀ counterIdx).HasBinaryNat 0) + (hinp : Parked inp₀) + (hother : ∀ i, i ≠ srcIdx → i ≠ dstIdx → i ≠ counterIdx → + Parked (work₀ i)) + (hout : Parked out₀) + (hworkSpace : ∀ i, (work₀ i).head ≤ initialSpace) + (hinputSpace : inp₀.head ≤ inputLength + initialSpace + 1) : + (binaryCopyIntoTM srcIdx dstIdx counterIdx).HoareTimeSpace + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + work = Function.update work₀ dstIdx (binaryCopyNatTape srcValue) ∧ + out = out₀) + (binaryCopyTime srcValue dstValue) inputLength + (binaryCopySpace initialSpace srcValue dstValue) := by + let midWork := binaryCopyMidWork work₀ dstIdx + have hwork := binaryCopyInitialWork_parked srcIdx dstIdx counterIdx + srcValue dstValue work₀ hsrc hdst hcounter hother + have hmidWork : ∀ i, Parked (midWork i) := by + exact binaryCopyMidWork_parked work₀ dstIdx hwork + have hinitial : + ({ state := (clearWorkTM dstIdx).qstart + input := inp₀ + work := work₀ + output := out₀ } : + Cfg n (clearWorkTM dstIdx).Q).WithinAuxSpace + inputLength initialSpace := + ⟨hworkSpace, hinputSpace⟩ + have hclear := clearWorkTM_hoareTimeSpace_frame dstIdx dstValue.bits + inputLength initialSpace inp₀ work₀ out₀ + hdst.eq_init_move_right hinp (fun i _ => hwork i) hout hinitial + have hclear' : (clearWorkTM dstIdx).HoareTimeSpace + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => inp = inp₀ ∧ work = midWork ∧ out = out₀) + (clearWorkTimeBound dstValue.size) inputLength + (initialSpace + clearWorkTimeBound dstValue.size) := by + simpa [midWork, binaryCopyMidWork, binaryCopyNatTape, + Nat.size_eq_bits_len] using hclear + have hmidSrc : (midWork srcIdx).HasBinaryNat srcValue := by + simpa [midWork, binaryCopyMidWork, hsrcDst] using hsrc + have hmidDst : (midWork dstIdx).HasBinaryNat 0 := by + simpa [midWork, binaryCopyMidWork] using + binaryCopyNatTape_hasBinaryNat 0 + have hmidCounter : (midWork counterIdx).HasBinaryNat 0 := by + simpa [midWork, binaryCopyMidWork, hdstCounter.symm] using hcounter + have hone : 1 ≤ initialSpace := by + have h := hworkSpace srcIdx + rw [hsrc.2.1] at h + exact h + have hmidWorkSpace : ∀ i, (midWork i).head ≤ initialSpace := by + intro i + by_cases hi : i = dstIdx + · subst i + simpa [midWork, binaryCopyMidWork, binaryCopyNatTape, Tape.move] + using hone + · simpa [midWork, binaryCopyMidWork, hi] using hworkSpace i + have hdistinct := binaryCopyDistinct srcIdx dstIdx counterIdx + hsrcDst hsrcCounter hdstCounter + have haddInitial : + ({ state := (binaryRippleAddTM srcIdx counterIdx dstIdx).qstart + input := inp₀ + work := midWork + output := out₀ } : + Cfg n (binaryRippleAddTM srcIdx counterIdx dstIdx).Q).WithinAuxSpace + inputLength initialSpace := + ⟨hmidWorkSpace, hinputSpace⟩ + have hadd := binaryRippleAddTM_hoareTimeSpace_frame + srcIdx counterIdx dstIdx hdistinct srcValue 0 inputLength initialSpace + inp₀ midWork out₀ hmidSrc hmidCounter hmidDst hinp + (fun i _ _ _ => hmidWork i) hout haddInitial + have hseq := seqTM_hoareTimeSpace (clearWorkTM dstIdx) + (binaryRippleAddTM srcIdx counterIdx dstIdx) hclear' + (binaryCopyFrame_transition inp₀ midWork out₀ hinp hmidWork hout) + hadd + apply hseq.consequence + (time' := binaryCopyTime srcValue dstValue) + (inputLength' := inputLength) + (space' := binaryCopySpace initialSpace srcValue dstValue) + · intro _inp _work _out hpre + exact hpre + · rintro inp work out ⟨hfinalInput, hfinalSrc, hfinalCounter, + hfinalDst, hfinalOther, hfinalOutput⟩ + exact ⟨hfinalInput, binaryCopyRipplePost_eq srcIdx dstIdx counterIdx + hsrcDst hdstCounter srcValue work₀ work hsrc hcounter + hfinalSrc hfinalCounter (by simpa using hfinalDst) (by + intro i hiSrc hiCounter hiDst + exact hfinalOther i hiSrc hiCounter hiDst), hfinalOutput⟩ + · simp [binaryCopyTime] + · exact le_rfl + · simp [binaryCopySpace] + +theorem binaryCopyIntoTM_isTransducer_internal + (srcIdx dstIdx counterIdx : Fin n) : + (binaryCopyIntoTM srcIdx dstIdx counterIdx).IsTransducer := by + exact (clearWorkTM_isTransducer dstIdx).seqTM + (binaryRippleAddTM_isTransducer srcIdx counterIdx dstIdx) + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryEq.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryEq.lean new file mode 100644 index 0000000000..5fb9288c51 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryEq.lean @@ -0,0 +1,68 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryEq.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryEq.Internal + +/-! +# Binary work-tape equality + +This module exposes a framed linear-time correctness theorem for the concrete +binary equality routine used by RAM register-store scans. +-/ + + +public section + +namespace Complexity + +namespace TM + +/-- Two canonical binary strings are compared in linear time. The Boolean +answer is appended to `resultIdx`; input, output, unrelated tapes, and all +binary contents are preserved. -/ +theorem binaryEqTM_reachesIn_frame {n : ℕ} + (lhsIdx rhsIdx resultIdx : Fin n) + (hdistinct : BinaryEqDistinct lhsIdx rhsIdx resultIdx) + (lhs rhs : List Bool) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hlhs : (work₀ lhsIdx).HasBinaryString lhs) + (hrhs : (work₀ rhsIdx).HasBinaryString rhs) + (hresult : (work₀ resultIdx).HasBinaryPrefix []) + (hinput : inp₀.read ≠ Γ.start) + (hother : ∀ i, i ≠ lhsIdx → i ≠ rhsIdx → i ≠ resultIdx → + (work₀ i).read ≠ Γ.start) + (houtput : out₀.read ≠ Γ.start) : + ∃ c' t, + t ≤ binaryEqTime lhs rhs ∧ + (binaryEqTM lhsIdx rhsIdx resultIdx).reachesIn t + { state := (binaryEqTM lhsIdx rhsIdx resultIdx).qstart + input := inp₀ + work := work₀ + output := out₀ } c' ∧ + (binaryEqTM lhsIdx rhsIdx resultIdx).halted c' ∧ + c'.input = inp₀ ∧ + (c'.work resultIdx).HasBinaryPrefix [decide (lhs = rhs)] ∧ + (c'.work lhsIdx).HasBinaryContent lhs ∧ + 1 ≤ (c'.work lhsIdx).head ∧ + (c'.work rhsIdx).HasBinaryContent rhs ∧ + 1 ≤ (c'.work rhsIdx).head ∧ + (∀ i, i ≠ lhsIdx → i ≠ rhsIdx → i ≠ resultIdx → + c'.work i = work₀ i) ∧ + c'.output = out₀ := + binaryEqTM_reachesIn_frame_internal lhsIdx rhsIdx resultIdx hdistinct + lhs rhs inp₀ work₀ out₀ hlhs hrhs hresult hinput hother houtput + +/-- Binary equality preserves one-way output safety. -/ +theorem binaryEqTM_isTransducer {n : ℕ} + (lhsIdx rhsIdx resultIdx : Fin n) : + (binaryEqTM lhsIdx rhsIdx resultIdx).IsTransducer := + binaryEqTM_isTransducer_internal lhsIdx rhsIdx resultIdx + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryEq/Defs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryEq/Defs.lean new file mode 100644 index 0000000000..5adb75867e --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryEq/Defs.lean @@ -0,0 +1,108 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators + +/-! +# Binary work-tape equality — definitions + +`TM.binaryEqTM` compares two canonical binary strings and writes the Boolean +result on a third work tape. Unlike the legacy output-oriented comparator, it +preserves the public output tape and every unrelated work tape. +-/ + + +@[expose] public section + +namespace Complexity + +namespace TM + +/-- The binary comparator scans until the first mismatch or simultaneous +termination, then halts immediately. -/ +inductive BinaryEqPhase where + | scan + | done + deriving DecidableEq + +instance : Fintype BinaryEqPhase where + elems := {.scan, .done} + complete := fun state => by cases state <;> simp + +/-- Pairwise distinct work tapes used by `binaryEqTM`. -/ +structure BinaryEqDistinct {n : ℕ} (lhsIdx rhsIdx resultIdx : Fin n) : Prop where + lhs_rhs : lhsIdx ≠ rhsIdx + lhs_result : lhsIdx ≠ resultIdx + rhs_result : rhsIdx ≠ resultIdx + +/-- Compare canonical binary strings on `lhsIdx` and `rhsIdx`, writing one to +`resultIdx` exactly when they agree. The compared heads advance together over +matching bits; all tape contents are preserved except the single result cell. -/ +def binaryEqTM {n : ℕ} (lhsIdx rhsIdx resultIdx : Fin n) : TM n where + Q := BinaryEqPhase + qstart := .scan + qhalt := .done + δ := fun state iHead wHeads oHead => + match state with + | .scan => + if wHeads lhsIdx = Γ.blank ∧ wHeads rhsIdx = Γ.blank then + (.done, + fun i => if i = resultIdx then Γw.one else readBackWrite (wHeads i), + readBackWrite oHead, + idleDir iHead, + fun i => if i = resultIdx then Dir3.right else idleDir (wHeads i), + idleDir oHead) + else if wHeads lhsIdx = wHeads rhsIdx then + (.scan, fun i => readBackWrite (wHeads i), readBackWrite oHead, + idleDir iHead, + fun i => if i = lhsIdx then Dir3.right + else if i = rhsIdx then Dir3.right else idleDir (wHeads i), + idleDir oHead) + else + (.done, + fun i => if i = resultIdx then Γw.zero else readBackWrite (wHeads i), + readBackWrite oHead, + idleDir iHead, + fun i => if i = resultIdx then Dir3.right else idleDir (wHeads i), + idleDir oHead) + | .done => allIdle .done iHead wHeads oHead + δ_right_of_start := by + intro state iHead wHeads oHead + cases state with + | scan => + dsimp only [] + split + · refine ⟨idleDir_right_of_start, ?_, idleDir_right_of_start⟩ + intro i hstart + simp only + split + · rfl + · exact idleDir_right_of_start hstart + · split + · refine ⟨idleDir_right_of_start, ?_, idleDir_right_of_start⟩ + intro i hstart + simp only + split + · rfl + · split + · rfl + · exact idleDir_right_of_start hstart + · refine ⟨idleDir_right_of_start, ?_, idleDir_right_of_start⟩ + intro i hstart + simp only + split + · rfl + · exact idleDir_right_of_start hstart + | done => exact rightOfStart_allIdle iHead wHeads oHead + +/-- Linear scan bound for binary equality. -/ +def binaryEqTime (lhs rhs : List Bool) : ℕ := + max lhs.length rhs.length + 1 + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryEq/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryEq/Internal.lean new file mode 100644 index 0000000000..9f71dc9c6f --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryEq/Internal.lean @@ -0,0 +1,399 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryEq.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.Internal.Generic +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Tape.Encoding +public import Std.Tactic.BVDecide.Normalize.BitVec + +/-! +# Binary work-tape equality — proof internals +-/ + + +public section + +namespace Complexity + +namespace TM + +private def binaryEqResultWork {n : ℕ} (resultIdx : Fin n) + (work : Fin n → Tape) (result : Bool) : Fin n → Tape := + Function.update work resultIdx + ((work resultIdx).writeAndMove (Γw.ofBool result) Dir3.right) + +private def binaryEqAdvanceWork {n : ℕ} (lhsIdx rhsIdx : Fin n) + (work : Fin n → Tape) : Fin n → Tape := + fun i => if i = lhsIdx then (work i).move Dir3.right + else if i = rhsIdx then (work i).move Dir3.right else work i + +private def binaryEqResultCfg {n : ℕ} (resultIdx : Fin n) + (result : Bool) (inp : Tape) (work : Fin n → Tape) (out : Tape) : + Cfg n BinaryEqPhase where + state := .done + input := inp + work := binaryEqResultWork resultIdx work result + output := out + +private def binaryEqAdvanceCfg {n : ℕ} (lhsIdx rhsIdx : Fin n) + (inp : Tape) (work : Fin n → Tape) (out : Tape) : Cfg n BinaryEqPhase where + state := .scan + input := inp + work := binaryEqAdvanceWork lhsIdx rhsIdx work + output := out + +private theorem writeAndMove_readBack_right {tape : Tape} + (hread : tape.read ≠ Γ.start) : + tape.writeAndMove (readBackWrite tape.read) Dir3.right = + tape.move Dir3.right := by + cases tape with + | mk head cells => + simp only [Tape.writeAndMove, Tape.read] at hread ⊢ + rw [toΓ_readBackWrite_of_ne_start hread] + simp [Tape.write, Tape.move, Function.update_eq_self] + +private theorem binaryEq_terminal_step {n : ℕ} + (lhsIdx rhsIdx resultIdx : Fin n) (result : Bool) + (inp : Tape) (work : Fin n → Tape) (out : Tape) + (hterminal : if result then + (work lhsIdx).read = Γ.blank ∧ (work rhsIdx).read = Γ.blank + else ¬((work lhsIdx).read = (work rhsIdx).read)) + (hinput : inp.read ≠ Γ.start) + (hwork : ∀ i, i ≠ resultIdx → (work i).read ≠ Γ.start) + (houtput : out.read ≠ Γ.start) : + (binaryEqTM lhsIdx rhsIdx resultIdx).step + { state := .scan, input := inp, work := work, output := out } = + some (binaryEqResultCfg resultIdx result inp work out) := by + simp only [TM.step, binaryEqTM] + cases result with + | false => + simp only [Bool.false_eq_true, if_false] at hterminal + have hnotBlank : ¬((work lhsIdx).read = Γ.blank ∧ + (work rhsIdx).read = Γ.blank) := by + intro hblank + exact hterminal (hblank.1.trans hblank.2.symm) + rw [if_neg hnotBlank, if_neg hterminal] + simp only [show BinaryEqPhase.scan ≠ BinaryEqPhase.done by decide, + if_false] + refine congrArg some (Cfg.ext rfl (transitionInput_eq_self hinput) ?_ + (transitionTape_eq_self houtput)) + funext i + by_cases hi : i = resultIdx + · subst i + simp [binaryEqResultCfg, binaryEqResultWork, Γw.ofBool] + · simpa [binaryEqResultCfg, binaryEqResultWork, hi] using + transitionTape_eq_self (hwork i hi) + + | true => + simp only [if_true] at hterminal + rw [if_pos hterminal] + simp only [show BinaryEqPhase.scan ≠ BinaryEqPhase.done by decide, + if_false] + refine congrArg some (Cfg.ext rfl (transitionInput_eq_self hinput) ?_ + (transitionTape_eq_self houtput)) + funext i + by_cases hi : i = resultIdx + · subst i + simp [binaryEqResultCfg, binaryEqResultWork, Γw.ofBool] + · simpa [binaryEqResultCfg, binaryEqResultWork, hi] using + transitionTape_eq_self (hwork i hi) + +private theorem binaryEq_scan_step {n : ℕ} + (lhsIdx rhsIdx resultIdx : Fin n) + (inp : Tape) (work : Fin n → Tape) (out : Tape) + (hreadEq : (work lhsIdx).read = (work rhsIdx).read) + (hnotBlank : ¬((work lhsIdx).read = Γ.blank ∧ + (work rhsIdx).read = Γ.blank)) + (hinput : inp.read ≠ Γ.start) + (hwork : ∀ i, (work i).read ≠ Γ.start) + (houtput : out.read ≠ Γ.start) : + (binaryEqTM lhsIdx rhsIdx resultIdx).step + { state := .scan, input := inp, work := work, output := out } = + some (binaryEqAdvanceCfg lhsIdx rhsIdx inp work out) := by + simp only [TM.step, binaryEqTM] + rw [if_neg hnotBlank, if_pos hreadEq] + simp only [show BinaryEqPhase.scan ≠ BinaryEqPhase.done by decide, if_false] + refine congrArg some (Cfg.ext rfl (transitionInput_eq_self hinput) ?_ + (transitionTape_eq_self houtput)) + funext i + by_cases hil : i = lhsIdx + · subst i + simp only [binaryEqAdvanceCfg, binaryEqAdvanceWork, if_pos] + exact writeAndMove_readBack_right (hwork lhsIdx) + · by_cases hir : i = rhsIdx + · subst i + simp only [binaryEqAdvanceCfg, binaryEqAdvanceWork, if_neg hil, if_pos] + exact writeAndMove_readBack_right (hwork rhsIdx) + · simpa [binaryEqAdvanceCfg, binaryEqAdvanceWork, hil, hir] using + transitionTape_eq_self (hwork i) + +private theorem binaryEq_terminal_reachesIn {n : ℕ} + (lhsIdx rhsIdx resultIdx : Fin n) + (hdistinct : BinaryEqDistinct lhsIdx rhsIdx resultIdx) + (lhs rhs : List Bool) (result : Bool) + (hdecision : decide (lhs = rhs) = result) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hlhs : (work₀ lhsIdx).HasBinarySuffix lhs) + (hrhs : (work₀ rhsIdx).HasBinarySuffix rhs) + (hresult : (work₀ resultIdx).HasBinaryPrefix []) + (hterminal : if result then + (work₀ lhsIdx).read = Γ.blank ∧ (work₀ rhsIdx).read = Γ.blank + else ¬((work₀ lhsIdx).read = (work₀ rhsIdx).read)) + (hinput : inp₀.read ≠ Γ.start) + (hother : ∀ i, i ≠ lhsIdx → i ≠ rhsIdx → i ≠ resultIdx → + (work₀ i).read ≠ Γ.start) + (houtput : out₀.read ≠ Γ.start) : + ∃ c' t, + t ≤ binaryEqTime lhs rhs ∧ + (binaryEqTM lhsIdx rhsIdx resultIdx).reachesIn t + { state := (binaryEqTM lhsIdx rhsIdx resultIdx).qstart + input := inp₀ + work := work₀ + output := out₀ } c' ∧ + (binaryEqTM lhsIdx rhsIdx resultIdx).halted c' ∧ + c'.input = inp₀ ∧ + (c'.work resultIdx).HasBinaryPrefix [decide (lhs = rhs)] ∧ + (c'.work lhsIdx).cells = (work₀ lhsIdx).cells ∧ + (c'.work rhsIdx).cells = (work₀ rhsIdx).cells ∧ + 1 ≤ (c'.work lhsIdx).head ∧ + 1 ≤ (c'.work rhsIdx).head ∧ + (∀ i, i ≠ lhsIdx → i ≠ rhsIdx → i ≠ resultIdx → + c'.work i = work₀ i) ∧ + c'.output = out₀ := by + have hwork : ∀ i, i ≠ resultIdx → (work₀ i).read ≠ Γ.start := by + intro i hir + by_cases hil : i = lhsIdx + · subst i + exact hlhs.read_ne_start + · by_cases hirhs : i = rhsIdx + · subst i + exact hrhs.read_ne_start + · exact hother i hil hirhs hir + have hstep := binaryEq_terminal_step lhsIdx rhsIdx resultIdx result + inp₀ work₀ out₀ hterminal hinput hwork houtput + let c' := binaryEqResultCfg resultIdx result inp₀ work₀ out₀ + refine ⟨c', 1, by simp [binaryEqTime], .step hstep .zero, rfl, rfl, ?_, ?_, + ?_, ?_, ?_, ?_, rfl⟩ + · rw [hdecision] + cases result with + | false => + simpa [c', binaryEqResultCfg, binaryEqResultWork, Γw.ofBool] using + Tape.hasBinaryPrefix_write_bit false hresult + | true => + simpa [c', binaryEqResultCfg, binaryEqResultWork, Γw.ofBool] using + Tape.hasBinaryPrefix_write_bit true hresult + · change (Function.update work₀ resultIdx _ lhsIdx).cells = _ + rw [Function.update_of_ne hdistinct.lhs_result] + · change (Function.update work₀ resultIdx _ rhsIdx).cells = _ + rw [Function.update_of_ne hdistinct.rhs_result] + · change 1 ≤ (Function.update work₀ resultIdx _ lhsIdx).head + rw [Function.update_of_ne hdistinct.lhs_result] + exact hlhs.1 + · change 1 ≤ (Function.update work₀ resultIdx _ rhsIdx).head + rw [Function.update_of_ne hdistinct.rhs_result] + exact hrhs.1 + · intro i hil hirhs hir + simp [c', binaryEqResultCfg, binaryEqResultWork, hir] + +private theorem binaryEq_suffix_reachesIn {n : ℕ} + (lhsIdx rhsIdx resultIdx : Fin n) + (hdistinct : BinaryEqDistinct lhsIdx rhsIdx resultIdx) + (lhs rhs : List Bool) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hlhs : (work₀ lhsIdx).HasBinarySuffix lhs) + (hrhs : (work₀ rhsIdx).HasBinarySuffix rhs) + (hresult : (work₀ resultIdx).HasBinaryPrefix []) + (hinput : inp₀.read ≠ Γ.start) + (hother : ∀ i, i ≠ lhsIdx → i ≠ rhsIdx → i ≠ resultIdx → + (work₀ i).read ≠ Γ.start) + (houtput : out₀.read ≠ Γ.start) : + ∃ c' t, + t ≤ binaryEqTime lhs rhs ∧ + (binaryEqTM lhsIdx rhsIdx resultIdx).reachesIn t + { state := (binaryEqTM lhsIdx rhsIdx resultIdx).qstart + input := inp₀ + work := work₀ + output := out₀ } c' ∧ + (binaryEqTM lhsIdx rhsIdx resultIdx).halted c' ∧ + c'.input = inp₀ ∧ + (c'.work resultIdx).HasBinaryPrefix [decide (lhs = rhs)] ∧ + (c'.work lhsIdx).cells = (work₀ lhsIdx).cells ∧ + (c'.work rhsIdx).cells = (work₀ rhsIdx).cells ∧ + 1 ≤ (c'.work lhsIdx).head ∧ + 1 ≤ (c'.work rhsIdx).head ∧ + (∀ i, i ≠ lhsIdx → i ≠ rhsIdx → i ≠ resultIdx → + c'.work i = work₀ i) ∧ + c'.output = out₀ := by + induction lhs generalizing rhs inp₀ work₀ out₀ with + | nil => + cases rhs with + | nil => + apply binaryEq_terminal_reachesIn lhsIdx rhsIdx resultIdx hdistinct + [] [] true (by simp) inp₀ work₀ out₀ hlhs hrhs hresult + · simp [hlhs.read_nil, hrhs.read_nil] + · exact hinput + · exact hother + · exact houtput + | cons rhsBit rhsTail => + apply binaryEq_terminal_reachesIn lhsIdx rhsIdx resultIdx hdistinct + [] (rhsBit :: rhsTail) false (by simp) inp₀ work₀ out₀ hlhs hrhs + hresult + · rw [hlhs.read_nil, hrhs.read_cons] + cases rhsBit <;> decide + · exact hinput + · exact hother + · exact houtput + | cons lhsBit lhsTail ih => + cases rhs with + | nil => + apply binaryEq_terminal_reachesIn lhsIdx rhsIdx resultIdx hdistinct + (lhsBit :: lhsTail) [] false (by simp) inp₀ work₀ out₀ hlhs hrhs + hresult + · rw [hlhs.read_cons, hrhs.read_nil] + cases lhsBit <;> decide + · exact hinput + · exact hother + · exact houtput + | cons rhsBit rhsTail => + by_cases hbit : lhsBit = rhsBit + · subst rhsBit + have hworkRead : ∀ i, (work₀ i).read ≠ Γ.start := by + intro i + by_cases hil : i = lhsIdx + · subst i + exact hlhs.read_ne_start + · by_cases hir : i = rhsIdx + · subst i + exact hrhs.read_ne_start + · by_cases hires : i = resultIdx + · subst i + rw [hresult.read_blank] + decide + · exact hother i hil hir hires + have hreadEq : (work₀ lhsIdx).read = (work₀ rhsIdx).read := by + rw [hlhs.read_cons, hrhs.read_cons] + have hnotBlank : ¬((work₀ lhsIdx).read = Γ.blank ∧ + (work₀ rhsIdx).read = Γ.blank) := by + intro hblank + rw [hlhs.read_cons] at hblank + cases lhsBit <;> simp [Γ.ofBool] at hblank + have hstep := binaryEq_scan_step lhsIdx rhsIdx resultIdx inp₀ work₀ + out₀ hreadEq hnotBlank hinput hworkRead houtput + let work₁ := binaryEqAdvanceWork lhsIdx rhsIdx work₀ + have hlhs₁ : (work₁ lhsIdx).HasBinarySuffix lhsTail := by + simpa [work₁, binaryEqAdvanceWork] using hlhs.move_right_cons + have hrhs₁ : (work₁ rhsIdx).HasBinarySuffix rhsTail := by + simp only [work₁, binaryEqAdvanceWork, + if_neg (Ne.symm hdistinct.lhs_rhs), if_pos] + exact hrhs.move_right_cons + have hresult₁ : (work₁ resultIdx).HasBinaryPrefix [] := by + simpa [work₁, binaryEqAdvanceWork, + Ne.symm hdistinct.lhs_result, + Ne.symm hdistinct.rhs_result] using hresult + have hother₁ : ∀ i, i ≠ lhsIdx → i ≠ rhsIdx → i ≠ resultIdx → + (work₁ i).read ≠ Γ.start := by + intro i hil hir hires + simpa [work₁, binaryEqAdvanceWork, hil, hir] using + hother i hil hir hires + obtain ⟨c', t, htime, hreach, hhalt, hfinalInput, hfinalResult, + hfinalLhs, hfinalRhs, hfinalLhsHead, hfinalRhsHead, + hfinalOther, hfinalOutput⟩ := + ih rhsTail inp₀ work₁ out₀ hlhs₁ hrhs₁ hresult₁ hinput hother₁ + houtput + have hreach' : (binaryEqTM lhsIdx rhsIdx resultIdx).reachesIn (t + 1) + { state := (binaryEqTM lhsIdx rhsIdx resultIdx).qstart + input := inp₀ + work := work₀ + output := out₀ } c' := by + exact .step hstep (by + simpa [work₁, binaryEqAdvanceCfg] using hreach) + refine ⟨c', t + 1, ?_, hreach', hhalt, hfinalInput, ?_, ?_, ?_, + hfinalLhsHead, hfinalRhsHead, ?_, hfinalOutput⟩ + · simp only [binaryEqTime, List.length_cons] at htime ⊢ + omega + · simpa using hfinalResult + · simpa [work₁, binaryEqAdvanceWork, Tape.move_cells] using hfinalLhs + · simpa [work₁, binaryEqAdvanceWork, Tape.move_cells, + Ne.symm hdistinct.lhs_rhs] using hfinalRhs + · intro i hil hir hires + simpa [work₁, binaryEqAdvanceWork, hil, hir] using + hfinalOther i hil hir hires + · apply binaryEq_terminal_reachesIn lhsIdx rhsIdx resultIdx hdistinct + (lhsBit :: lhsTail) (rhsBit :: rhsTail) false (by simp [hbit]) + inp₀ work₀ out₀ hlhs hrhs hresult + · rw [hlhs.read_cons, hrhs.read_cons] + intro heq + cases lhsBit <;> cases rhsBit <;> simp_all [Γ.ofBool] + · exact hinput + · exact hother + · exact houtput + +theorem binaryEqTM_reachesIn_frame_internal {n : ℕ} + (lhsIdx rhsIdx resultIdx : Fin n) + (hdistinct : BinaryEqDistinct lhsIdx rhsIdx resultIdx) + (lhs rhs : List Bool) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hlhs : (work₀ lhsIdx).HasBinaryString lhs) + (hrhs : (work₀ rhsIdx).HasBinaryString rhs) + (hresult : (work₀ resultIdx).HasBinaryPrefix []) + (hinput : inp₀.read ≠ Γ.start) + (hother : ∀ i, i ≠ lhsIdx → i ≠ rhsIdx → i ≠ resultIdx → + (work₀ i).read ≠ Γ.start) + (houtput : out₀.read ≠ Γ.start) : + ∃ c' t, + t ≤ binaryEqTime lhs rhs ∧ + (binaryEqTM lhsIdx rhsIdx resultIdx).reachesIn t + { state := (binaryEqTM lhsIdx rhsIdx resultIdx).qstart + input := inp₀ + work := work₀ + output := out₀ } c' ∧ + (binaryEqTM lhsIdx rhsIdx resultIdx).halted c' ∧ + c'.input = inp₀ ∧ + (c'.work resultIdx).HasBinaryPrefix [decide (lhs = rhs)] ∧ + (c'.work lhsIdx).HasBinaryContent lhs ∧ + 1 ≤ (c'.work lhsIdx).head ∧ + (c'.work rhsIdx).HasBinaryContent rhs ∧ + 1 ≤ (c'.work rhsIdx).head ∧ + (∀ i, i ≠ lhsIdx → i ≠ rhsIdx → i ≠ resultIdx → + c'.work i = work₀ i) ∧ + c'.output = out₀ := by + obtain ⟨c', t, htime, hreach, hhalt, hfinalInput, hfinalResult, + hfinalLhs, hfinalRhs, hfinalLhsHead, hfinalRhsHead, hfinalOther, + hfinalOutput⟩ := + binaryEq_suffix_reachesIn lhsIdx rhsIdx resultIdx hdistinct lhs rhs + inp₀ work₀ out₀ hlhs.hasBinarySuffix hrhs.hasBinarySuffix hresult + hinput hother houtput + refine ⟨c', t, htime, hreach, hhalt, hfinalInput, hfinalResult, ?_, + hfinalLhsHead, ?_, hfinalRhsHead, hfinalOther, hfinalOutput⟩ + · simpa only [Tape.HasBinaryContent, hfinalLhs] using hlhs.hasBinaryContent + · simpa only [Tape.HasBinaryContent, hfinalRhs] using hrhs.hasBinaryContent + +theorem binaryEqTM_isTransducer_internal {n : ℕ} + (lhsIdx rhsIdx resultIdx : Fin n) : + (binaryEqTM lhsIdx rhsIdx resultIdx).IsTransducer := by + intro phase iHead wHeads oHead + cases phase with + | scan => + simp only [binaryEqTM] + split + · simp only + simp only [idleDir] + split <;> decide + · split + · simp only + simp only [idleDir] + split <;> decide + · simp only + simp only [idleDir] + split <;> decide + | done => + simp only [binaryEqTM, allIdle, idleDir] + split <;> decide + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryFor.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryFor.lean new file mode 100644 index 0000000000..f554f490ee --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryFor.lean @@ -0,0 +1,10 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryFor.Defs +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryFor.Internal + +/-! Supporting modules for Beyond the Bethe approximation of the permanent. -/ diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryFor/Defs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryFor/Defs.lean new file mode 100644 index 0000000000..9bd9f7721d --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryFor/Defs.lean @@ -0,0 +1,285 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinarySucc.Defs + +/-! +# Canonical binary count-up loops — definitions + +This module defines an output-safe loop driver for a body indexed by a +canonical little-endian binary counter. A second, distinct work tape stores a +preserved limit. Before each iteration, the driver compares the two tapes in +lockstep, remembers whether every scanned symbol agreed, and rewinds both +heads to cell one. Equality halts the loop; inequality runs the body and then +increments the counter with `TM.binarySuccTM`. + +The comparison deliberately scans through the full limit width even after a +mismatch. Under the intended invariant `counter ≤ limit`, this gives the +value-independent exact comparison time `2 * limit.size + 2`. The controller +never moves the output head left and does not alter its contents; output +behavior during an iteration is entirely delegated to the body. + +The wrapper-free certificate structures at the end of the file separate the +executable controller from later correctness and all-prefix space proofs. +-/ + + +@[expose] public section + +namespace Complexity + +namespace TM + +/-- Controller phases for a canonical binary count-up loop. + +The Boolean carried by `scan` and `rewind` records whether the counter and +limit symbols seen so far were equal. -/ +inductive BinaryForPhase where + | scan (equalSoFar : Bool) + | rewind (equalSoFar : Bool) + | done + deriving DecidableEq + +/-- `BinaryForPhase` is finite, as required by the concrete machine model. -/ +instance instFintypeBinaryForPhase : Fintype BinaryForPhase where + elems := {.scan false, .scan true, .rewind false, .rewind true, .done} + complete := by + intro phase + cases phase with + | scan equalSoFar => cases equalSoFar <;> simp + | rewind equalSoFar => cases equalSoFar <;> simp + | done => simp + +/-- One count-up iteration: run `body`, take the `seqTM` seam, and increment +the designated canonical binary counter. -/ +def binaryForIterationTM {n : ℕ} (body : TM n) (counterIdx : Fin n) : TM n := + seqTM body (binarySuccTM counterIdx) + +/-- Count upward from a canonical binary counter to a preserved canonical +binary limit. + +The intended correctness interface assumes `counterIdx ≠ limitIdx`. In the +driver phases both work heads move in lockstep. A complete scan records tape +equality without writing a verdict, and a complete rewind either halts or +enters `binaryForIterationTM body counterIdx`. When that composite iteration +halts, one content-preserving seam returns to a fresh equality scan. + +Input, unrelated work tapes, and output use read-back/idle actions throughout +the controller. In particular, the driver itself is compatible with +append-only output; any output writes come only from `body`. -/ +def binaryForTM {n : ℕ} (body : TM n) (counterIdx limitIdx : Fin n) : TM n := + let iteration := binaryForIterationTM body counterIdx + haveI : Fintype iteration.Q := iteration.finQ + haveI : DecidableEq iteration.Q := iteration.decEq + { Q := BinaryForPhase ⊕ iteration.Q + qstart := .inl (.scan true) + qhalt := .inl .done + δ := fun state iHead wHeads oHead => + match state with + | .inl (.scan equalSoFar) => + if wHeads counterIdx = Γ.blank ∧ wHeads limitIdx = Γ.blank then + (.inl (.rewind equalSoFar), + fun i => readBackWrite (wHeads i), readBackWrite oHead, + idleDir iHead, + fun i => + if i = counterIdx then Dir3.left + else if i = limitIdx then Dir3.left + else idleDir (wHeads i), + idleDir oHead) + else + let equal' := + equalSoFar && decide (wHeads counterIdx = wHeads limitIdx) + (.inl (.scan equal'), + fun i => readBackWrite (wHeads i), readBackWrite oHead, + idleDir iHead, + fun i => + if i = counterIdx then Dir3.right + else if i = limitIdx then Dir3.right + else idleDir (wHeads i), + idleDir oHead) + | .inl (.rewind equalSoFar) => + if wHeads counterIdx = Γ.start ∧ wHeads limitIdx = Γ.start then + let nextState : BinaryForPhase ⊕ iteration.Q := + if equalSoFar then .inl .done else .inr iteration.qstart + (nextState, + fun i => readBackWrite (wHeads i), readBackWrite oHead, + idleDir iHead, + fun i => + if i = counterIdx then Dir3.right + else if i = limitIdx then Dir3.right + else idleDir (wHeads i), + idleDir oHead) + else + (.inl (.rewind equalSoFar), + fun i => readBackWrite (wHeads i), readBackWrite oHead, + idleDir iHead, + fun i => + if i = counterIdx then moveLeftDir (wHeads i) + else if i = limitIdx then moveLeftDir (wHeads i) + else idleDir (wHeads i), + idleDir oHead) + | .inl .done => allIdle (.inl .done) iHead wHeads oHead + | .inr q => + if q = iteration.qhalt then + allReadBack (.inl (.scan true)) iHead wHeads oHead + else + let (q', workWrite, outputWrite, inputDir, workDir, outputDir) := + iteration.δ q iHead wHeads oHead + (.inr q', workWrite, outputWrite, inputDir, workDir, outputDir) + δ_right_of_start := by + intro state iHead wHeads oHead + match state with + | .inl (.scan equalSoFar) => + dsimp only + split + · next hblank => + refine ⟨idleDir_right_of_start, fun i hi => ?_, + idleDir_right_of_start⟩ + dsimp only + by_cases hic : i = counterIdx + · subst i + rw [hblank.1] at hi + exact absurd hi (by decide) + · rw [if_neg hic] + by_cases hil : i = limitIdx + · subst i + rw [hblank.2] at hi + exact absurd hi (by decide) + · rw [if_neg hil] + exact idleDir_right_of_start hi + · refine ⟨idleDir_right_of_start, fun i hi => ?_, + idleDir_right_of_start⟩ + dsimp only + by_cases hic : i = counterIdx + · rw [if_pos hic] + · rw [if_neg hic] + by_cases hil : i = limitIdx + · rw [if_pos hil] + · rw [if_neg hil] + exact idleDir_right_of_start hi + | .inl (.rewind equalSoFar) => + dsimp only + split + · refine ⟨idleDir_right_of_start, fun i hi => ?_, + idleDir_right_of_start⟩ + dsimp only + by_cases hic : i = counterIdx + · rw [if_pos hic] + · rw [if_neg hic] + by_cases hil : i = limitIdx + · rw [if_pos hil] + · rw [if_neg hil] + exact idleDir_right_of_start hi + · refine ⟨idleDir_right_of_start, fun i hi => ?_, + idleDir_right_of_start⟩ + dsimp only + by_cases hic : i = counterIdx + · rw [if_pos hic] + exact moveLeftDir_right_of_start hi + · rw [if_neg hic] + by_cases hil : i = limitIdx + · rw [if_pos hil] + exact moveLeftDir_right_of_start hi + · rw [if_neg hil] + exact idleDir_right_of_start hi + | .inl .done => exact rightOfStart_allIdle iHead wHeads oHead + | .inr q => + dsimp only + split + · exact rightOfStart_allReadBack iHead wHeads oHead + · exact iteration.δ_right_of_start q iHead wHeads oHead } + +/-- Exact time for one full-width equality scan and synchronized rewind when +the counter is bounded by `limit`. -/ +def binaryForCompareTime (limit : ℕ) : ℕ := + 2 * limit.size + 2 + +/-- Exact time of the composite iteration before the outer loopback seam: +the body run, one `seqTM` transition, and canonical binary successor. -/ +def binaryForIterationTime (bodyTime : ℕ → ℕ) (value : ℕ) : ℕ := + bodyTime value + 1 + binarySuccTime value + +/-- Exact remaining count-up-loop time. + +`value` is the current counter and `count` is the number of nonterminal +iterations remaining. The zero case performs the final successful comparison. +Each successor case performs one unsuccessful comparison, one composite +iteration, one outer loopback seam, and the remaining loop. Intended uses +supply `value + count = limit`. -/ +def binaryForLoopTime (bodyTime : ℕ → ℕ) (limit value : ℕ) : ℕ → ℕ + | 0 => binaryForCompareTime limit + | count + 1 => + binaryForCompareTime limit + binaryForIterationTime bodyTime value + 1 + + binaryForLoopTime bodyTime limit (value + 1) count + +/-- Wrapper-free certificate for exact control flow of a canonical binary +count-up loop. + +All configurations use the public state type of +`binaryForTM body counterIdx limitIdx`. The client supplies the intended +canonical configuration family and proves that a nonterminal test reaches the +composite iteration, which runs the body and successor before one loopback +step advances to the next scanner configuration. At `limitValue`, the client +supplies the final comparison run. -/ +structure BinaryForLoopSpec {n : ℕ} (body : TM n) + (counterIdx limitIdx : Fin n) (bodyTime : ℕ → ℕ) + (limitValue : ℕ) where + /-- The counter and preserved-limit tapes are distinct. -/ + counter_ne_limit : counterIdx ≠ limitIdx + /-- Client-supplied canonical combined-machine configuration before testing + `value`. -/ + scanCfg : ℕ → Cfg n (binaryForTM body counterIdx limitIdx).Q + /-- Client-supplied canonical configuration at the composite iteration start. -/ + iterationStartCfg : ℕ → Cfg n (binaryForTM body counterIdx limitIdx).Q + /-- Client-supplied canonical configuration after the exact composite iteration. -/ + iterationDoneCfg : ℕ → Cfg n (binaryForTM body counterIdx limitIdx).Q + /-- Client-supplied canonical final driver configuration. -/ + doneCfg : Cfg n (binaryForTM body counterIdx limitIdx).Q + /-- A nonterminal comparison and rewind enter the composite iteration. -/ + testRun : ∀ value, value < limitValue → + (binaryForTM body counterIdx limitIdx).reachesIn + (binaryForCompareTime limitValue) (scanCfg value) + (iterationStartCfg value) + /-- The body, `seqTM` seam, and successor have the advertised exact runtime. -/ + iterationRun : ∀ value, value < limitValue → + (binaryForTM body counterIdx limitIdx).reachesIn + (binaryForIterationTime bodyTime value) (iterationStartCfg value) + (iterationDoneCfg value) + /-- The preserving outer seam returns to the next comparison. -/ + loopbackStep : ∀ value, value < limitValue → + (binaryForTM body counterIdx limitIdx).step (iterationDoneCfg value) = + some (scanCfg (value + 1)) + /-- Equality at the limit completes one final comparison and rewind. -/ + doneRun : + (binaryForTM body counterIdx limitIdx).reachesIn + (binaryForCompareTime limitValue) (scanCfg limitValue) doneCfg + +/-- All-prefix auxiliary-space obligations for a certified binary count-up +loop. The comparison and composite-iteration obligations concern prefixes of +their advertised exact runs; later execution may already have crossed the +corresponding seam. -/ +structure BinaryForLoopSpaceSpec {n : ℕ} {body : TM n} + {counterIdx limitIdx : Fin n} {bodyTime : ℕ → ℕ} + {limitValue : ℕ} + (spec : BinaryForLoopSpec body counterIdx limitIdx bodyTime limitValue) + (inputLength spaceBound : ℕ) where + /-- Every prefix of each full-width comparison and rewind respects the budget. -/ + testPrefixWithin : ∀ value time cfg, value ≤ limitValue → + time ≤ binaryForCompareTime limitValue → + (binaryForTM body counterIdx limitIdx).reachesIn time + (spec.scanCfg value) cfg → + cfg.WithinAuxSpace inputLength spaceBound + /-- Every prefix of each body-plus-successor iteration respects the budget. -/ + iterationPrefixWithin : ∀ value time cfg, value < limitValue → + time ≤ binaryForIterationTime bodyTime value → + (binaryForTM body counterIdx limitIdx).reachesIn time + (spec.iterationStartCfg value) cfg → + cfg.WithinAuxSpace inputLength spaceBound + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryFor/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryFor/Internal.lean new file mode 100644 index 0000000000..e19ba74245 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryFor/Internal.lean @@ -0,0 +1,11 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryFor.Internal.Comparison +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryFor.Internal.Control +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryFor.Internal.Loop + +/-! Supporting modules for Beyond the Bethe approximation of the permanent. -/ diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryFor/Internal/Comparison.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryFor/Internal/Comparison.lean new file mode 100644 index 0000000000..348bb9842e --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryFor/Internal/Comparison.lean @@ -0,0 +1,722 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryFor.Internal.Control +public import LeanPool.BeyondBethe.Complexitylib.Mathlib.NatBits +public import Mathlib.Algebra.Order.Group.Nat +public import Std.Tactic.BVDecide.Normalize.BitVec + +/-! +# Canonical binary count-up loops — comparison internals + +This module proves the exact full-width comparison run used by +`TM.binaryForTM`. The scanner compares two canonical little-endian natural +numbers without changing their contents, then rewinds both cursors. Under +the loop invariant `value ≤ limitValue`, the run takes exactly +`binaryForCompareTime limitValue` steps and branches to the composite +iteration precisely below the limit, or to `done` precisely at equality. +-/ + + +public section + +namespace Complexity + +namespace TM + +variable {n : ℕ} + +/-- The alphabet symbol at one zero-based position of a blank-padded binary +string. -/ +private def paddedBinarySymbol (bits : List Bool) (i : ℕ) : Γ := + if h : i < bits.length then Γ.ofBool bits[i] else Γ.blank + +private theorem paddedBinarySymbol_of_lt {bits : List Bool} {i : ℕ} + (h : i < bits.length) : + paddedBinarySymbol bits i = Γ.ofBool bits[i] := by + simp only [paddedBinarySymbol, dif_pos h] + +private theorem paddedBinarySymbol_of_ge {bits : List Bool} {i : ℕ} + (h : bits.length ≤ i) : + paddedBinarySymbol bits i = Γ.blank := by + simp only [paddedBinarySymbol, dif_neg (Nat.not_lt.mpr h)] + +/-- Boolean equality accumulated through the first `width` padded symbols. -/ +private def paddedBinaryPrefixEq (left right : List Bool) : ℕ → Bool + | 0 => true + | width + 1 => + paddedBinaryPrefixEq left right width && + decide (paddedBinarySymbol left width = paddedBinarySymbol right width) + +private theorem paddedBinaryPrefixEq_symbol_eq {left right : List Bool} + {width i : ℕ} (heq : paddedBinaryPrefixEq left right width = true) + (hi : i < width) : + paddedBinarySymbol left i = paddedBinarySymbol right i := by + induction width with + | zero => omega + | succ width ih => + simp only [paddedBinaryPrefixEq, Bool.and_eq_true, decide_eq_true_eq] at heq + by_cases hlast : i = width + · simpa [hlast] using heq.2 + · exact ih heq.1 (by omega) + +private theorem paddedBinaryPrefixEq_self (bits : List Bool) (width : ℕ) : + paddedBinaryPrefixEq bits bits width = true := by + induction width with + | zero => rfl + | succ width ih => simp [paddedBinaryPrefixEq, ih] + +private theorem ofBool_injective {left right : Bool} + (h : Γ.ofBool left = Γ.ofBool right) : left = right := by + cases left <;> cases right <;> simp [Γ.ofBool] at h ⊢ + +private theorem paddedBinaryPrefixEq_eq_true_iff {left right : List Bool} + {width : ℕ} (hleft : left.length ≤ width) + (hright : right.length ≤ width) : + paddedBinaryPrefixEq left right width = true ↔ left = right := by + constructor + · intro heq + have hlen : left.length = right.length := by + apply Nat.le_antisymm + · by_contra hnot + have hlt : right.length < left.length := Nat.lt_of_not_ge hnot + have hsymbol := paddedBinaryPrefixEq_symbol_eq heq + (lt_of_lt_of_le hlt hleft) + rw [paddedBinarySymbol_of_lt hlt, + paddedBinarySymbol_of_ge le_rfl] at hsymbol + exact Γ.ofBool_ne_blank _ hsymbol + · by_contra hnot + have hlt : left.length < right.length := Nat.lt_of_not_ge hnot + have hsymbol := paddedBinaryPrefixEq_symbol_eq heq + (lt_of_lt_of_le hlt hright) + rw [paddedBinarySymbol_of_ge le_rfl, + paddedBinarySymbol_of_lt hlt] at hsymbol + exact Γ.ofBool_ne_blank _ hsymbol.symm + apply List.ext_get hlen + intro i hli hri + have hsymbol := paddedBinaryPrefixEq_symbol_eq heq + (lt_of_lt_of_le hli hleft) + rw [paddedBinarySymbol_of_lt hli, + paddedBinarySymbol_of_lt hri] at hsymbol + exact ofBool_injective hsymbol + · intro heq + subst right + exact paddedBinaryPrefixEq_self left width + +private theorem HasBinaryContent.cells_paddedBinarySymbol {t : Tape} + {bits : List Bool} (h : t.HasBinaryContent bits) (i : ℕ) : + t.cells (i + 1) = paddedBinarySymbol bits i := by + by_cases hi : i < bits.length + · rw [paddedBinarySymbol_of_lt hi, h.1 i hi] + · rw [paddedBinarySymbol_of_ge (Nat.le_of_not_gt hi), + h.2 i (Nat.le_of_not_gt hi)] + +/-- Reset only the head of a tape, preserving all cells. -/ +private def tapeAtHead (t : Tape) (head : ℕ) : Tape := + { head := head, cells := t.cells } + +@[simp] private theorem tapeAtHead_head (t : Tape) (head : ℕ) : + (tapeAtHead t head).head = head := rfl + +@[simp] private theorem tapeAtHead_cells (t : Tape) (head : ℕ) : + (tapeAtHead t head).cells = t.cells := rfl + +private theorem tapeAtHead_eq_self {t : Tape} {head : ℕ} + (hhead : t.head = head) : tapeAtHead t head = t := by + ext <;> simp [tapeAtHead, hhead] + +/-- Put the two comparison cursors at the same head position and leave every +other work tape untouched. -/ +private def binaryForWorkAt (work : Fin n → Tape) + (counterIdx limitIdx : Fin n) (head : ℕ) : Fin n → Tape := + fun i => + if i = counterIdx then tapeAtHead (work i) head + else if i = limitIdx then tapeAtHead (work i) head + else work i + +private theorem binaryForWorkAt_counter (work : Fin n → Tape) + (counterIdx limitIdx : Fin n) (head : ℕ) : + binaryForWorkAt work counterIdx limitIdx head counterIdx = + tapeAtHead (work counterIdx) head := by + simp [binaryForWorkAt] + +private theorem binaryForWorkAt_limit (work : Fin n → Tape) + {counterIdx limitIdx : Fin n} (hne : counterIdx ≠ limitIdx) (head : ℕ) : + binaryForWorkAt work counterIdx limitIdx head limitIdx = + tapeAtHead (work limitIdx) head := by + simp [binaryForWorkAt, Ne.symm hne] + +private theorem binaryForWorkAt_other (work : Fin n → Tape) + {counterIdx limitIdx i : Fin n} (hic : i ≠ counterIdx) + (hil : i ≠ limitIdx) (head : ℕ) : + binaryForWorkAt work counterIdx limitIdx head i = work i := by + simp [binaryForWorkAt, hic, hil] + +private theorem binaryForWorkAt_one_eq (work : Fin n → Tape) + {counterIdx limitIdx : Fin n} + (hcounter : (work counterIdx).head = 1) + (hlimit : (work limitIdx).head = 1) : + binaryForWorkAt work counterIdx limitIdx 1 = work := by + funext i + by_cases hic : i = counterIdx + · subst i + rw [binaryForWorkAt_counter, tapeAtHead_eq_self hcounter] + · by_cases hil : i = limitIdx + · subst i + simp only [binaryForWorkAt, hic, ↓reduceIte] + exact tapeAtHead_eq_self hlimit + · exact binaryForWorkAt_other work hic hil 1 + +private theorem binaryForWorkAt_selected_cells (work : Fin n → Tape) + {counterIdx limitIdx : Fin n} (head : ℕ) (i : Fin n) + (hi : i = counterIdx ∨ i = limitIdx) : + (binaryForWorkAt work counterIdx limitIdx head i).cells = (work i).cells := by + rcases hi with rfl | rfl + · simp [binaryForWorkAt_counter] + · simp [binaryForWorkAt] + +private theorem binaryForWorkAt_move_right (work : Fin n → Tape) + {counterIdx limitIdx : Fin n} (hne : counterIdx ≠ limitIdx) (head : ℕ) : + Function.update + (Function.update (binaryForWorkAt work counterIdx limitIdx head) + counterIdx + ((binaryForWorkAt work counterIdx limitIdx head counterIdx).move + Dir3.right)) + limitIdx + ((binaryForWorkAt work counterIdx limitIdx head limitIdx).move + Dir3.right) = + binaryForWorkAt work counterIdx limitIdx (head + 1) := by + funext i + by_cases hic : i = counterIdx + · subst i + simp [Function.update, hne, binaryForWorkAt, tapeAtHead, Tape.move] + · by_cases hil : i = limitIdx + · subst i + simp [Function.update, hic, binaryForWorkAt, tapeAtHead, Tape.move] + · simp [Function.update, hic, hil, binaryForWorkAt] + +private theorem binaryForWorkAt_move_left (work : Fin n → Tape) + {counterIdx limitIdx : Fin n} (hne : counterIdx ≠ limitIdx) (head : ℕ) : + Function.update + (Function.update (binaryForWorkAt work counterIdx limitIdx head) + counterIdx + ((binaryForWorkAt work counterIdx limitIdx head counterIdx).move + Dir3.left)) + limitIdx + ((binaryForWorkAt work counterIdx limitIdx head limitIdx).move + Dir3.left) = + binaryForWorkAt work counterIdx limitIdx (head - 1) := by + funext i + by_cases hic : i = counterIdx + · subst i + simp [Function.update, hne, binaryForWorkAt, tapeAtHead, Tape.move] + · by_cases hil : i = limitIdx + · subst i + simp [Function.update, hic, binaryForWorkAt, tapeAtHead, Tape.move] + · simp [Function.update, hic, hil, binaryForWorkAt] + +/-- A comparison-phase configuration with synchronized counter and limit +cursors. -/ +private def binaryForCompareCfg (body : TM n) + (counterIdx limitIdx : Fin n) (phase : BinaryForPhase) + (head : ℕ) (inp : Tape) (work : Fin n → Tape) (out : Tape) : + Cfg n (binaryForTM body counterIdx limitIdx).Q := + { state := .inl phase + input := inp + work := binaryForWorkAt work counterIdx limitIdx head + output := out } + +private theorem binaryForCompareCfg_one_eq + (body : TM n) (counterIdx limitIdx : Fin n) (phase : BinaryForPhase) + (inp : Tape) (work : Fin n → Tape) (out : Tape) + (hcounter : (work counterIdx).head = 1) + (hlimit : (work limitIdx).head = 1) : + binaryForCompareCfg body counterIdx limitIdx phase 1 inp work out = + { state := .inl phase + input := inp + work := work + output := out } := by + simp only [binaryForCompareCfg, binaryForWorkAt_one_eq work hcounter hlimit] + +private theorem binaryForCompareCfg_work_read_ne_start + (body : TM n) (work : Fin n → Tape) + {counterIdx limitIdx : Fin n} (hne : counterIdx ≠ limitIdx) + (phase : BinaryForPhase) {head : ℕ} (hhead : 1 ≤ head) + (inp out : Tape) {counterBits limitBits : List Bool} + (hcounter : (work counterIdx).HasBinaryContent counterBits) + (hlimit : (work limitIdx).HasBinaryContent limitBits) + (hother : ∀ i, i ≠ counterIdx → i ≠ limitIdx → + (work i).read ≠ Γ.start) : + ∀ i, ((binaryForCompareCfg body counterIdx limitIdx phase head + inp work out).work i).read ≠ Γ.start := by + intro i + by_cases hic : i = counterIdx + · subst i + simp only [binaryForCompareCfg, binaryForWorkAt_counter, Tape.read, + tapeAtHead_head, tapeAtHead_cells] + exact hcounter.cells_ne_start head hhead + · by_cases hil : i = limitIdx + · subst i + simp only [binaryForCompareCfg, binaryForWorkAt_limit work hne, + Tape.read, tapeAtHead_head, tapeAtHead_cells] + exact hlimit.cells_ne_start head hhead + · rw [show (binaryForCompareCfg body counterIdx limitIdx phase head + inp work out).work i = work i by + exact binaryForWorkAt_other work hic hil head] + exact hother i hic hil + +private theorem binaryForCompareCfg_counter_read + (body : TM n) (work : Fin n → Tape) + (counterIdx limitIdx : Fin n) (phase : BinaryForPhase) + (inp out : Tape) {bits : List Bool} + (hbits : (work counterIdx).HasBinaryContent bits) (i : ℕ) : + ((binaryForCompareCfg body counterIdx limitIdx phase (i + 1) + inp work out).work counterIdx).read = paddedBinarySymbol bits i := by + simp only [binaryForCompareCfg, binaryForWorkAt_counter, Tape.read, + tapeAtHead_head, tapeAtHead_cells] + exact HasBinaryContent.cells_paddedBinarySymbol hbits i + +private theorem binaryForCompareCfg_limit_read + (body : TM n) (work : Fin n → Tape) + {counterIdx limitIdx : Fin n} (hne : counterIdx ≠ limitIdx) + (phase : BinaryForPhase) (inp out : Tape) {bits : List Bool} + (hbits : (work limitIdx).HasBinaryContent bits) (i : ℕ) : + ((binaryForCompareCfg body counterIdx limitIdx phase (i + 1) + inp work out).work limitIdx).read = paddedBinarySymbol bits i := by + simp only [binaryForCompareCfg, binaryForWorkAt_limit work hne, + Tape.read, tapeAtHead_head, tapeAtHead_cells] + exact HasBinaryContent.cells_paddedBinarySymbol hbits i + +private theorem binaryForCompareCfg_step_scan + (body : TM n) (work : Fin n → Tape) + {counterIdx limitIdx : Fin n} (hne : counterIdx ≠ limitIdx) + (inp out : Tape) {counterBits limitBits : List Bool} + (hcounter : (work counterIdx).HasBinaryContent counterBits) + (hlimit : (work limitIdx).HasBinaryContent limitBits) + (hinp : inp.read ≠ Γ.start) + (hother : ∀ i, i ≠ counterIdx → i ≠ limitIdx → + (work i).read ≠ Γ.start) + (hout : out.read ≠ Γ.start) (i : ℕ) (hi : i < limitBits.length) : + (binaryForTM body counterIdx limitIdx).step + (binaryForCompareCfg body counterIdx limitIdx + (.scan (paddedBinaryPrefixEq counterBits limitBits i)) + (i + 1) inp work out) = + some (binaryForCompareCfg body counterIdx limitIdx + (.scan (paddedBinaryPrefixEq counterBits limitBits (i + 1))) + (i + 1 + 1) inp work out) := by + let c := binaryForCompareCfg body counterIdx limitIdx + (.scan (paddedBinaryPrefixEq counterBits limitBits i)) + (i + 1) inp work out + have hcounterRead : (c.work counterIdx).read = + paddedBinarySymbol counterBits i := + binaryForCompareCfg_counter_read body work counterIdx limitIdx _ inp out + hcounter i + have hlimitRead : (c.work limitIdx).read = + paddedBinarySymbol limitBits i := + binaryForCompareCfg_limit_read body work hne _ inp out hlimit i + have hmore : ¬((c.work counterIdx).read = Γ.blank ∧ + (c.work limitIdx).read = Γ.blank) := by + intro hblank + rw [hlimitRead, paddedBinarySymbol_of_lt hi] at hblank + exact Γ.ofBool_ne_blank _ hblank.2 + have hwork : ∀ j, (c.work j).read ≠ Γ.start := by + dsimp only [c] + exact binaryForCompareCfg_work_read_ne_start body work hne + (.scan (paddedBinaryPrefixEq counterBits limitBits i)) + (head := i + 1) (by omega) inp out hcounter hlimit hother + have hstep := binaryForTM_step_scan_internal body counterIdx limitIdx hne + (paddedBinaryPrefixEq counterBits limitBits i) c rfl hmore hinp hwork hout + rw [hcounterRead, hlimitRead] at hstep + dsimp only [c, binaryForCompareCfg] at hstep + rw [binaryForWorkAt_move_right work hne] at hstep + simpa only [c, binaryForCompareCfg, paddedBinaryPrefixEq] using hstep + +private theorem binaryForCompareCfg_scan_reachesIn + (body : TM n) (work : Fin n → Tape) + {counterIdx limitIdx : Fin n} (hne : counterIdx ≠ limitIdx) + (inp out : Tape) {counterBits limitBits : List Bool} + (hcounter : (work counterIdx).HasBinaryContent counterBits) + (hlimit : (work limitIdx).HasBinaryContent limitBits) + (hinp : inp.read ≠ Γ.start) + (hother : ∀ i, i ≠ counterIdx → i ≠ limitIdx → + (work i).read ≠ Γ.start) + (hout : out.read ≠ Γ.start) : + ∀ width, width ≤ limitBits.length → + (binaryForTM body counterIdx limitIdx).reachesIn width + (binaryForCompareCfg body counterIdx limitIdx (.scan true) + 1 inp work out) + (binaryForCompareCfg body counterIdx limitIdx + (.scan (paddedBinaryPrefixEq counterBits limitBits width)) + (width + 1) inp work out) := by + intro width + induction width with + | zero => + intro _ + simpa only [paddedBinaryPrefixEq] using + (TM.reachesIn.zero : + (binaryForTM body counterIdx limitIdx).reachesIn 0 + (binaryForCompareCfg body counterIdx limitIdx (.scan true) + 1 inp work out) + (binaryForCompareCfg body counterIdx limitIdx (.scan true) + 1 inp work out)) + | succ width ih => + intro hwidth + have hprefix := ih (by omega) + have hstep := binaryForCompareCfg_step_scan body work hne inp out + hcounter hlimit hinp hother hout width (by omega) + exact (binaryForTM body counterIdx limitIdx).reachesIn_snoc hprefix hstep + +private theorem binaryForCompareCfg_step_scan_blank + (body : TM n) (work : Fin n → Tape) + {counterIdx limitIdx : Fin n} (hne : counterIdx ≠ limitIdx) + (inp out : Tape) {counterBits limitBits : List Bool} + (hcounter : (work counterIdx).HasBinaryContent counterBits) + (hlimit : (work limitIdx).HasBinaryContent limitBits) + (hinp : inp.read ≠ Γ.start) + (hother : ∀ i, i ≠ counterIdx → i ≠ limitIdx → + (work i).read ≠ Γ.start) + (hout : out.read ≠ Γ.start) (equalSoFar : Bool) (width : ℕ) + (hcounterWidth : counterBits.length ≤ width) + (hlimitWidth : limitBits.length ≤ width) : + (binaryForTM body counterIdx limitIdx).step + (binaryForCompareCfg body counterIdx limitIdx + (.scan equalSoFar) (width + 1) inp work out) = + some (binaryForCompareCfg body counterIdx limitIdx + (.rewind equalSoFar) width inp work out) := by + let c := binaryForCompareCfg body counterIdx limitIdx + (.scan equalSoFar) (width + 1) inp work out + have hcounterRead : (c.work counterIdx).read = Γ.blank := by + rw [binaryForCompareCfg_counter_read body work counterIdx limitIdx + (.scan equalSoFar) inp out hcounter width] + exact paddedBinarySymbol_of_ge hcounterWidth + have hlimitRead : (c.work limitIdx).read = Γ.blank := by + rw [binaryForCompareCfg_limit_read body work hne + (.scan equalSoFar) inp out hlimit width] + exact paddedBinarySymbol_of_ge hlimitWidth + have hwork : ∀ i, (c.work i).read ≠ Γ.start := by + dsimp only [c] + exact binaryForCompareCfg_work_read_ne_start body work hne + (.scan equalSoFar) (head := width + 1) (by omega) + inp out hcounter hlimit hother + have hstep := binaryForTM_step_scan_blank_internal body counterIdx + limitIdx hne equalSoFar c rfl hcounterRead hlimitRead hinp hwork hout + dsimp only [c, binaryForCompareCfg] at hstep + rw [binaryForWorkAt_move_left work hne] at hstep + simpa using hstep + +private theorem binaryForCompareCfg_step_rewind + (body : TM n) (work : Fin n → Tape) + {counterIdx limitIdx : Fin n} (hne : counterIdx ≠ limitIdx) + (inp out : Tape) {counterBits limitBits : List Bool} + (hcounter : (work counterIdx).HasBinaryContent counterBits) + (hlimit : (work limitIdx).HasBinaryContent limitBits) + (hinp : inp.read ≠ Γ.start) + (hother : ∀ i, i ≠ counterIdx → i ≠ limitIdx → + (work i).read ≠ Γ.start) + (hout : out.read ≠ Γ.start) (equalSoFar : Bool) (head : ℕ) : + (binaryForTM body counterIdx limitIdx).step + (binaryForCompareCfg body counterIdx limitIdx + (.rewind equalSoFar) (head + 1) inp work out) = + some (binaryForCompareCfg body counterIdx limitIdx + (.rewind equalSoFar) head inp work out) := by + let c := binaryForCompareCfg body counterIdx limitIdx + (.rewind equalSoFar) (head + 1) inp work out + have hwork : ∀ i, (c.work i).read ≠ Γ.start := by + dsimp only [c] + exact binaryForCompareCfg_work_read_ne_start body work hne + (.rewind equalSoFar) (head := head + 1) (by omega) + inp out hcounter hlimit hother + have hstep := binaryForTM_step_rewind_internal body counterIdx limitIdx + hne equalSoFar c rfl hinp hwork hout + dsimp only [c, binaryForCompareCfg] at hstep + rw [binaryForWorkAt_move_left work hne] at hstep + simpa using hstep + +private theorem binaryForCompareCfg_rewind_reachesIn + (body : TM n) (work : Fin n → Tape) + {counterIdx limitIdx : Fin n} (hne : counterIdx ≠ limitIdx) + (inp out : Tape) {counterBits limitBits : List Bool} + (hcounter : (work counterIdx).HasBinaryContent counterBits) + (hlimit : (work limitIdx).HasBinaryContent limitBits) + (hinp : inp.read ≠ Γ.start) + (hother : ∀ i, i ≠ counterIdx → i ≠ limitIdx → + (work i).read ≠ Γ.start) + (hout : out.read ≠ Γ.start) (equalSoFar : Bool) : + ∀ head, + (binaryForTM body counterIdx limitIdx).reachesIn head + (binaryForCompareCfg body counterIdx limitIdx + (.rewind equalSoFar) head inp work out) + (binaryForCompareCfg body counterIdx limitIdx + (.rewind equalSoFar) 0 inp work out) := by + intro head + induction head with + | zero => exact .zero + | succ head ih => + exact .step (binaryForCompareCfg_step_rewind body work hne inp out + hcounter hlimit hinp hother hout equalSoFar head) ih + +private theorem binaryForCompareCfg_step_rewind_true + (body : TM n) (work : Fin n → Tape) + {counterIdx limitIdx : Fin n} (hne : counterIdx ≠ limitIdx) + (inp out : Tape) + (hcounterStart : (work counterIdx).cells 0 = Γ.start) + (hlimitStart : (work limitIdx).cells 0 = Γ.start) + (hcounterHead : (work counterIdx).head = 1) + (hlimitHead : (work limitIdx).head = 1) + (hinp : inp.read ≠ Γ.start) + (hother : ∀ i, i ≠ counterIdx → i ≠ limitIdx → + (work i).read ≠ Γ.start) + (hout : out.read ≠ Γ.start) : + (binaryForTM body counterIdx limitIdx).step + (binaryForCompareCfg body counterIdx limitIdx + (.rewind true) 0 inp work out) = + some + { state := .inl .done + input := inp + work := work + output := out } := by + let c := binaryForCompareCfg body counterIdx limitIdx + (.rewind true) 0 inp work out + have hcounterRead : (c.work counterIdx).read = Γ.start := by + simp [c, binaryForCompareCfg, binaryForWorkAt_counter, tapeAtHead, + Tape.read, hcounterStart] + have hlimitRead : (c.work limitIdx).read = Γ.start := by + simp [c, binaryForCompareCfg, binaryForWorkAt_limit work hne, + tapeAtHead, Tape.read, hlimitStart] + have hcounterHead0 : (c.work counterIdx).head = 0 := by + simp [c, binaryForCompareCfg, binaryForWorkAt_counter] + have hlimitHead0 : (c.work limitIdx).head = 0 := by + simp [c, binaryForCompareCfg, binaryForWorkAt_limit work hne] + have hother' : ∀ i, i ≠ counterIdx → i ≠ limitIdx → + (c.work i).read ≠ Γ.start := by + intro i hic hil + rw [show c.work i = work i by + exact binaryForWorkAt_other work hic hil 0] + exact hother i hic hil + have hstep := binaryForTM_step_rewind_equal_internal body counterIdx + limitIdx hne c rfl hcounterRead hlimitRead hcounterHead0 hlimitHead0 + hinp hother' hout + dsimp only [c, binaryForCompareCfg] at hstep + rw [binaryForWorkAt_move_right work hne, + binaryForWorkAt_one_eq work hcounterHead hlimitHead] at hstep + exact hstep + +private theorem binaryForCompareCfg_step_rewind_false + (body : TM n) (work : Fin n → Tape) + {counterIdx limitIdx : Fin n} (hne : counterIdx ≠ limitIdx) + (inp out : Tape) + (hcounterStart : (work counterIdx).cells 0 = Γ.start) + (hlimitStart : (work limitIdx).cells 0 = Γ.start) + (hcounterHead : (work counterIdx).head = 1) + (hlimitHead : (work limitIdx).head = 1) + (hinp : inp.read ≠ Γ.start) + (hother : ∀ i, i ≠ counterIdx → i ≠ limitIdx → + (work i).read ≠ Γ.start) + (hout : out.read ≠ Γ.start) : + (binaryForTM body counterIdx limitIdx).step + (binaryForCompareCfg body counterIdx limitIdx + (.rewind false) 0 inp work out) = + some + { state := .inr (binaryForIterationTM body counterIdx).qstart + input := inp + work := work + output := out } := by + let c := binaryForCompareCfg body counterIdx limitIdx + (.rewind false) 0 inp work out + have hcounterRead : (c.work counterIdx).read = Γ.start := by + simp [c, binaryForCompareCfg, binaryForWorkAt_counter, tapeAtHead, + Tape.read, hcounterStart] + have hlimitRead : (c.work limitIdx).read = Γ.start := by + simp [c, binaryForCompareCfg, binaryForWorkAt_limit work hne, + tapeAtHead, Tape.read, hlimitStart] + have hcounterHead0 : (c.work counterIdx).head = 0 := by + simp [c, binaryForCompareCfg, binaryForWorkAt_counter] + have hlimitHead0 : (c.work limitIdx).head = 0 := by + simp [c, binaryForCompareCfg, binaryForWorkAt_limit work hne] + have hother' : ∀ i, i ≠ counterIdx → i ≠ limitIdx → + (c.work i).read ≠ Γ.start := by + intro i hic hil + rw [show c.work i = work i by + exact binaryForWorkAt_other work hic hil 0] + exact hother i hic hil + have hstep := binaryForTM_step_rewind_unequal_internal body counterIdx + limitIdx hne c rfl hcounterRead hlimitRead hcounterHead0 hlimitHead0 + hinp hother' hout + dsimp only [c, binaryForCompareCfg] at hstep + rw [binaryForWorkAt_move_right work hne, + binaryForWorkAt_one_eq work hcounterHead hlimitHead] at hstep + exact hstep + +private theorem binaryForCompareCfg_reachesIn_rewind_zero + (body : TM n) (work : Fin n → Tape) + {counterIdx limitIdx : Fin n} (hne : counterIdx ≠ limitIdx) + (inp out : Tape) {counterBits limitBits : List Bool} + (hcounter : (work counterIdx).HasBinaryContent counterBits) + (hlimit : (work limitIdx).HasBinaryContent limitBits) + (hinp : inp.read ≠ Γ.start) + (hother : ∀ i, i ≠ counterIdx → i ≠ limitIdx → + (work i).read ≠ Γ.start) + (hout : out.read ≠ Γ.start) (width : ℕ) + (hcounterWidth : counterBits.length ≤ width) + (hlimitWidth : limitBits.length = width) : + (binaryForTM body counterIdx limitIdx).reachesIn (2 * width + 1) + (binaryForCompareCfg body counterIdx limitIdx (.scan true) + 1 inp work out) + (binaryForCompareCfg body counterIdx limitIdx + (.rewind (paddedBinaryPrefixEq counterBits limitBits width)) + 0 inp work out) := by + have hscan := binaryForCompareCfg_scan_reachesIn body work hne inp out + hcounter hlimit hinp hother hout width (by omega) + have hblank := binaryForCompareCfg_step_scan_blank body work hne inp out + hcounter hlimit hinp hother hout + (paddedBinaryPrefixEq counterBits limitBits width) width + hcounterWidth (by omega) + have hscanRewind := + (binaryForTM body counterIdx limitIdx).reachesIn_snoc hscan hblank + have hrewind := binaryForCompareCfg_rewind_reachesIn body work hne inp out + hcounter hlimit hinp hother hout + (paddedBinaryPrefixEq counterBits limitBits width) width + have hrun := reachesIn_trans (binaryForTM body counterIdx limitIdx) + hscanRewind hrewind + convert hrun using 1 + omega + +/-- At equality, the full-width comparison preserves every tape exactly and +reaches the loop's `done` state in the advertised exact time. -/ +theorem binaryForTM_compare_reachesIn_frame_of_eq_internal + (body : TM n) (counterIdx limitIdx : Fin n) + (hne : counterIdx ≠ limitIdx) (value : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hcounter : (work₀ counterIdx).HasBinaryNat value) + (hlimit : (work₀ limitIdx).HasBinaryNat value) + (hinp : inp₀.read ≠ Γ.start) + (hother : ∀ i, i ≠ counterIdx → i ≠ limitIdx → + (work₀ i).read ≠ Γ.start) + (hout : out₀.read ≠ Γ.start) : + (binaryForTM body counterIdx limitIdx).reachesIn + (binaryForCompareTime value) + { state := .inl (.scan true) + input := inp₀ + work := work₀ + output := out₀ } + { state := .inl .done + input := inp₀ + work := work₀ + output := out₀ } := by + have hwidth : value.bits.length = value.size := + Nat.size_eq_bits_len value + have hrewind := binaryForCompareCfg_reachesIn_rewind_zero body work₀ hne + inp₀ out₀ hcounter.2.2 hlimit.2.2 hinp hother hout value.size + (by omega) hwidth + rw [paddedBinaryPrefixEq_self] at hrewind + have hexit := binaryForCompareCfg_step_rewind_true body work₀ hne + inp₀ out₀ hcounter.1 hlimit.1 hcounter.2.1 hlimit.2.1 + hinp hother hout + have hrun := + (binaryForTM body counterIdx limitIdx).reachesIn_snoc hrewind hexit + rw [binaryForCompareCfg_one_eq body counterIdx limitIdx (.scan true) + inp₀ work₀ out₀ hcounter.2.1 hlimit.2.1] at hrun + simpa [binaryForCompareTime] using hrun + +/-- Strictly below the limit, the full-width comparison preserves every tape +exactly and reaches the composite iteration start in the advertised time. -/ +theorem binaryForTM_compare_reachesIn_frame_of_lt_internal + (body : TM n) (counterIdx limitIdx : Fin n) + (hne : counterIdx ≠ limitIdx) (value limitValue : ℕ) + (hlt : value < limitValue) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hcounter : (work₀ counterIdx).HasBinaryNat value) + (hlimit : (work₀ limitIdx).HasBinaryNat limitValue) + (hinp : inp₀.read ≠ Γ.start) + (hother : ∀ i, i ≠ counterIdx → i ≠ limitIdx → + (work₀ i).read ≠ Γ.start) + (hout : out₀.read ≠ Γ.start) : + (binaryForTM body counterIdx limitIdx).reachesIn + (binaryForCompareTime limitValue) + { state := .inl (.scan true) + input := inp₀ + work := work₀ + output := out₀ } + { state := .inr (binaryForIterationTM body counterIdx).qstart + input := inp₀ + work := work₀ + output := out₀ } := by + have hcounterWidth : value.bits.length ≤ limitValue.size := by + rw [Nat.size_eq_bits_len value] + exact Nat.size_le_size (Nat.le_of_lt hlt) + have hlimitWidth : limitValue.bits.length = limitValue.size := + Nat.size_eq_bits_len limitValue + have hflag : paddedBinaryPrefixEq value.bits limitValue.bits + limitValue.size = false := by + cases hprefix : paddedBinaryPrefixEq value.bits limitValue.bits + limitValue.size with + | false => rfl + | true => + have hbits := (paddedBinaryPrefixEq_eq_true_iff hcounterWidth + (by omega)).mp hprefix + have hvalues := congrArg Nat.fromBitsLE hbits + simp only [Nat.fromBitsLE_bits] at hvalues + omega + have hrewind := binaryForCompareCfg_reachesIn_rewind_zero body work₀ hne + inp₀ out₀ hcounter.2.2 hlimit.2.2 hinp hother hout + limitValue.size hcounterWidth hlimitWidth + rw [hflag] at hrewind + have hexit := binaryForCompareCfg_step_rewind_false body work₀ hne + inp₀ out₀ hcounter.1 hlimit.1 hcounter.2.1 hlimit.2.1 + hinp hother hout + have hrun := + (binaryForTM body counterIdx limitIdx).reachesIn_snoc hrewind hexit + rw [binaryForCompareCfg_one_eq body counterIdx limitIdx (.scan true) + inp₀ work₀ out₀ hcounter.2.1 hlimit.2.1] at hrun + simpa [binaryForCompareTime] using hrun + +/-- A complete canonical comparison has one exact, fully framed endpoint. +The endpoint enters the composite iteration exactly below the limit and is +the final `done` configuration exactly at equality. -/ +theorem binaryForTM_compare_reachesIn_frame_internal + (body : TM n) (counterIdx limitIdx : Fin n) + (hne : counterIdx ≠ limitIdx) (value limitValue : ℕ) + (hle : value ≤ limitValue) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hcounter : (work₀ counterIdx).HasBinaryNat value) + (hlimit : (work₀ limitIdx).HasBinaryNat limitValue) + (hinp : inp₀.read ≠ Γ.start) + (hother : ∀ i, i ≠ counterIdx → i ≠ limitIdx → + (work₀ i).read ≠ Γ.start) + (hout : out₀.read ≠ Γ.start) : + ∃ c', + (binaryForTM body counterIdx limitIdx).reachesIn + (binaryForCompareTime limitValue) + { state := .inl (.scan true) + input := inp₀ + work := work₀ + output := out₀ } c' ∧ + c'.input = inp₀ ∧ + c'.work = work₀ ∧ + c'.output = out₀ ∧ + (c'.state = .inr (binaryForIterationTM body counterIdx).qstart ↔ + value < limitValue) ∧ + (c'.state = .inl .done ↔ value = limitValue) := by + by_cases heq : value = limitValue + · subst limitValue + have hrun := binaryForTM_compare_reachesIn_frame_of_eq_internal + body counterIdx limitIdx hne value inp₀ work₀ out₀ + hcounter hlimit hinp hother hout + refine ⟨_, hrun, rfl, rfl, rfl, ?_, ?_⟩ + · simp + · simp + · have hlt : value < limitValue := by omega + have hrun := binaryForTM_compare_reachesIn_frame_of_lt_internal + body counterIdx limitIdx hne value limitValue hlt inp₀ work₀ out₀ + hcounter hlimit hinp hother hout + refine ⟨_, hrun, rfl, rfl, rfl, ?_, ?_⟩ + · simp [hlt] + · simp [heq] + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryFor/Internal/Control.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryFor/Internal/Control.lean new file mode 100644 index 0000000000..6af5584b04 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryFor/Internal/Control.lean @@ -0,0 +1,307 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.Internal.Generic +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryFor.Defs + +/-! +# Canonical binary count-up loops — control proofs + +This module supplies the local proof interface for `TM.binaryForTM`. It lifts +runs of the composite body-plus-successor iteration through the outer control +state and gives exact, full-frame transition lemmas for scanning, rewinding, +entering an iteration, and returning from a completed iteration. + +The canonical multi-step comparison run and loop induction are intentionally +left to later proof layers. +-/ + + +@[expose] public section + +namespace Complexity + +namespace TM + +variable {n : ℕ} + +/-- Embed a composite iteration configuration into the iteration phase of +`binaryForTM`. -/ +def binaryForIterationWrap (body : TM n) (counterIdx limitIdx : Fin n) + (c : Cfg n (binaryForIterationTM body counterIdx).Q) : + Cfg n (binaryForTM body counterIdx limitIdx).Q := + { state := .inr c.state + input := c.input + work := c.work + output := c.output } + +/-- Every nonhalting composite-iteration step is simulated exactly by one +`binaryForTM` step. -/ +theorem binaryForTM_iteration_step_internal (body : TM n) + (counterIdx limitIdx : Fin n) + {c c' : Cfg n (binaryForIterationTM body counterIdx).Q} + (hstep : (binaryForIterationTM body counterIdx).step c = some c') : + (binaryForTM body counterIdx limitIdx).step + (binaryForIterationWrap body counterIdx limitIdx c) = + some (binaryForIterationWrap body counterIdx limitIdx c') := by + have hne : c.state ≠ (binaryForIterationTM body counterIdx).qhalt := + state_ne_qhalt_of_step hstep + rw [TM.step, if_neg (by simp [binaryForIterationWrap, binaryForTM])] + simp only [binaryForIterationWrap, binaryForTM, hne, ↓reduceIte] + rw [TM.step, if_neg hne] at hstep + simpa only [Option.map_some, binaryForIterationWrap] using + congrArg (Option.map (binaryForIterationWrap body counterIdx limitIdx)) hstep + +/-- Exact runs of the composite iteration lift through the iteration phase of +`binaryForTM`. -/ +theorem binaryForTM_iteration_reachesIn_internal (body : TM n) + (counterIdx limitIdx : Fin n) + {t : ℕ} {c c' : Cfg n (binaryForIterationTM body counterIdx).Q} + (hreach : (binaryForIterationTM body counterIdx).reachesIn t c c') : + (binaryForTM body counterIdx limitIdx).reachesIn t + (binaryForIterationWrap body counterIdx limitIdx c) + (binaryForIterationWrap body counterIdx limitIdx c') := + reachesIn_map (binaryForIterationWrap body counterIdx limitIdx) + (fun _ _ => binaryForTM_iteration_step_internal body counterIdx limitIdx) hreach + +/-- Away from the common terminating blank, one scanner step compares the +current symbols and advances both designated tapes, preserving the full +off-start frame. -/ +theorem binaryForTM_step_scan_internal (body : TM n) + (counterIdx limitIdx : Fin n) (hne : counterIdx ≠ limitIdx) + (equalSoFar : Bool) (c : Cfg n (binaryForTM body counterIdx limitIdx).Q) + (hstate : c.state = .inl (.scan equalSoFar)) + (hmore : ¬((c.work counterIdx).read = Γ.blank ∧ + (c.work limitIdx).read = Γ.blank)) + (hinput : c.input.read ≠ Γ.start) + (hwork : ∀ i, (c.work i).read ≠ Γ.start) + (houtput : c.output.read ≠ Γ.start) : + (binaryForTM body counterIdx limitIdx).step c = some + { state := .inl (.scan + (equalSoFar && decide ((c.work counterIdx).read = (c.work limitIdx).read))) + input := c.input + work := Function.update + (Function.update c.work counterIdx ((c.work counterIdx).move Dir3.right)) + limitIdx ((c.work limitIdx).move Dir3.right) + output := c.output } := by + rw [TM.step, if_neg (by rw [hstate]; simp [binaryForTM])] + simp only [binaryForTM, hstate] + rw [if_neg hmore] + dsimp only + refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, ?_, ?_, ?_⟩) + · exact transitionInput_eq_self hinput + · funext i + by_cases hic : i = counterIdx + · subst i + rw [if_pos rfl, Function.update_of_ne hne, Function.update_self, + writeAndMove_readBack _ (hwork counterIdx)] + · rw [if_neg hic] + by_cases hil : i = limitIdx + · subst i + rw [if_pos rfl, Function.update_self, + writeAndMove_readBack _ (hwork limitIdx)] + · rw [if_neg hil, Function.update_of_ne hil, Function.update_of_ne hic] + exact transitionTape_eq_self (hwork i) + · exact transitionTape_eq_self houtput + +/-- At the common terminating blank, one scanner step enters rewind and moves +both designated tapes left, preserving the full off-start frame. -/ +theorem binaryForTM_step_scan_blank_internal (body : TM n) + (counterIdx limitIdx : Fin n) (hne : counterIdx ≠ limitIdx) + (equalSoFar : Bool) (c : Cfg n (binaryForTM body counterIdx limitIdx).Q) + (hstate : c.state = .inl (.scan equalSoFar)) + (hcounter : (c.work counterIdx).read = Γ.blank) + (hlimit : (c.work limitIdx).read = Γ.blank) + (hinput : c.input.read ≠ Γ.start) + (hwork : ∀ i, (c.work i).read ≠ Γ.start) + (houtput : c.output.read ≠ Γ.start) : + (binaryForTM body counterIdx limitIdx).step c = some + { state := .inl (.rewind equalSoFar) + input := c.input + work := Function.update + (Function.update c.work counterIdx ((c.work counterIdx).move Dir3.left)) + limitIdx ((c.work limitIdx).move Dir3.left) + output := c.output } := by + rw [TM.step, if_neg (by rw [hstate]; simp [binaryForTM])] + simp only [binaryForTM, hstate] + rw [if_pos ⟨hcounter, hlimit⟩] + dsimp only + refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, ?_, ?_, ?_⟩) + · exact transitionInput_eq_self hinput + · funext i + by_cases hic : i = counterIdx + · subst i + rw [if_pos rfl, Function.update_of_ne hne, Function.update_self, + writeAndMove_readBack _ (hwork counterIdx)] + · rw [if_neg hic] + by_cases hil : i = limitIdx + · subst i + rw [if_pos rfl, Function.update_self, + writeAndMove_readBack _ (hwork limitIdx)] + · rw [if_neg hil, Function.update_of_ne hil, Function.update_of_ne hic] + exact transitionTape_eq_self (hwork i) + · exact transitionTape_eq_self houtput + +/-- One ordinary rewind step moves both designated tapes left, preserving the +full off-start frame. -/ +theorem binaryForTM_step_rewind_internal (body : TM n) + (counterIdx limitIdx : Fin n) (hne : counterIdx ≠ limitIdx) + (equalSoFar : Bool) (c : Cfg n (binaryForTM body counterIdx limitIdx).Q) + (hstate : c.state = .inl (.rewind equalSoFar)) + (hinput : c.input.read ≠ Γ.start) + (hwork : ∀ i, (c.work i).read ≠ Γ.start) + (houtput : c.output.read ≠ Γ.start) : + (binaryForTM body counterIdx limitIdx).step c = some + { state := .inl (.rewind equalSoFar) + input := c.input + work := Function.update + (Function.update c.work counterIdx ((c.work counterIdx).move Dir3.left)) + limitIdx ((c.work limitIdx).move Dir3.left) + output := c.output } := by + rw [TM.step, if_neg (by rw [hstate]; simp [binaryForTM])] + have hnotboth : ¬((c.work counterIdx).read = Γ.start ∧ + (c.work limitIdx).read = Γ.start) := by + intro h + exact hwork counterIdx h.1 + simp only [binaryForTM, hstate] + rw [if_neg hnotboth] + dsimp only + refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, ?_, ?_, ?_⟩) + · exact transitionInput_eq_self hinput + · funext i + by_cases hic : i = counterIdx + · subst i + rw [if_pos rfl, Function.update_of_ne hne, Function.update_self, + writeAndMove_readBack _ (hwork counterIdx)] + simp [moveLeftDir, hwork counterIdx] + · rw [if_neg hic] + by_cases hil : i = limitIdx + · subst i + rw [if_pos rfl, Function.update_self, + writeAndMove_readBack _ (hwork limitIdx)] + simp [moveLeftDir, hwork limitIdx] + · rw [if_neg hil, Function.update_of_ne hil, Function.update_of_ne hic] + exact transitionTape_eq_self (hwork i) + · exact transitionTape_eq_self houtput + +/-- When an equal comparison rewinds to both left markers, one preserving +step returns both designated heads to cell one and halts the loop. -/ +theorem binaryForTM_step_rewind_equal_internal (body : TM n) + (counterIdx limitIdx : Fin n) (hne : counterIdx ≠ limitIdx) + (c : Cfg n (binaryForTM body counterIdx limitIdx).Q) + (hstate : c.state = .inl (.rewind true)) + (hcounter : (c.work counterIdx).read = Γ.start) + (hlimit : (c.work limitIdx).read = Γ.start) + (hcounterHead : (c.work counterIdx).head = 0) + (hlimitHead : (c.work limitIdx).head = 0) + (hinput : c.input.read ≠ Γ.start) + (hother : ∀ i, i ≠ counterIdx → i ≠ limitIdx → + (c.work i).read ≠ Γ.start) + (houtput : c.output.read ≠ Γ.start) : + (binaryForTM body counterIdx limitIdx).step c = some + { state := .inl .done + input := c.input + work := Function.update + (Function.update c.work counterIdx ((c.work counterIdx).move Dir3.right)) + limitIdx ((c.work limitIdx).move Dir3.right) + output := c.output } := by + rw [TM.step, if_neg (by rw [hstate]; simp [binaryForTM])] + simp only [binaryForTM, hstate] + rw [if_pos ⟨hcounter, hlimit⟩] + dsimp only + refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, ?_, ?_, ?_⟩) + · exact transitionInput_eq_self hinput + · funext i + by_cases hic : i = counterIdx + · subst i + rw [if_pos rfl, Function.update_of_ne hne, Function.update_self] + show (((c.work counterIdx).write _).move Dir3.right) = + (c.work counterIdx).move Dir3.right + rw [Tape.write, if_pos hcounterHead] + · rw [if_neg hic] + by_cases hil : i = limitIdx + · subst i + rw [if_pos rfl, Function.update_self] + show (((c.work limitIdx).write _).move Dir3.right) = + (c.work limitIdx).move Dir3.right + rw [Tape.write, if_pos hlimitHead] + · rw [if_neg hil, Function.update_of_ne hil, Function.update_of_ne hic] + exact transitionTape_eq_self (hother i hic hil) + · exact transitionTape_eq_self houtput + +/-- When an unequal comparison rewinds to both left markers, one preserving +step returns both designated heads to cell one and enters the composite +iteration. -/ +theorem binaryForTM_step_rewind_unequal_internal (body : TM n) + (counterIdx limitIdx : Fin n) (hne : counterIdx ≠ limitIdx) + (c : Cfg n (binaryForTM body counterIdx limitIdx).Q) + (hstate : c.state = .inl (.rewind false)) + (hcounter : (c.work counterIdx).read = Γ.start) + (hlimit : (c.work limitIdx).read = Γ.start) + (hcounterHead : (c.work counterIdx).head = 0) + (hlimitHead : (c.work limitIdx).head = 0) + (hinput : c.input.read ≠ Γ.start) + (hother : ∀ i, i ≠ counterIdx → i ≠ limitIdx → + (c.work i).read ≠ Γ.start) + (houtput : c.output.read ≠ Γ.start) : + (binaryForTM body counterIdx limitIdx).step c = some + { state := .inr (binaryForIterationTM body counterIdx).qstart + input := c.input + work := Function.update + (Function.update c.work counterIdx ((c.work counterIdx).move Dir3.right)) + limitIdx ((c.work limitIdx).move Dir3.right) + output := c.output } := by + rw [TM.step, if_neg (by rw [hstate]; simp [binaryForTM])] + simp only [binaryForTM, hstate] + rw [if_pos ⟨hcounter, hlimit⟩] + dsimp only + refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, ?_, ?_, ?_⟩) + · exact transitionInput_eq_self hinput + · funext i + by_cases hic : i = counterIdx + · subst i + rw [if_pos rfl, Function.update_of_ne hne, Function.update_self] + show (((c.work counterIdx).write _).move Dir3.right) = + (c.work counterIdx).move Dir3.right + rw [Tape.write, if_pos hcounterHead] + · rw [if_neg hic] + by_cases hil : i = limitIdx + · subst i + rw [if_pos rfl, Function.update_self] + show (((c.work limitIdx).write _).move Dir3.right) = + (c.work limitIdx).move Dir3.right + rw [Tape.write, if_pos hlimitHead] + · rw [if_neg hil, Function.update_of_ne hil, Function.update_of_ne hic] + exact transitionTape_eq_self (hother i hic hil) + · exact transitionTape_eq_self houtput + +/-- A halted composite iteration takes one preserving outer seam step back to +a fresh equality scan. -/ +theorem binaryForTM_step_iteration_halt_internal (body : TM n) + (counterIdx limitIdx : Fin n) + (c : Cfg n (binaryForIterationTM body counterIdx).Q) + (hhalt : (binaryForIterationTM body counterIdx).halted c) + (hinput : c.input.read ≠ Γ.start) + (hwork : ∀ i, (c.work i).read ≠ Γ.start) + (houtput : c.output.read ≠ Γ.start) : + (binaryForTM body counterIdx limitIdx).step + (binaryForIterationWrap body counterIdx limitIdx c) = some + { state := .inl (.scan true) + input := c.input + work := c.work + output := c.output } := by + rw [TM.step, if_neg (by simp [binaryForIterationWrap, binaryForTM])] + simp only [binaryForIterationWrap, binaryForTM, hhalt, allReadBack, ↓reduceIte] + refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, ?_, ?_, ?_⟩) + · exact transitionInput_eq_self hinput + · funext i + exact transitionTape_eq_self (hwork i) + · exact transitionTape_eq_self houtput + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryFor/Internal/Loop.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryFor/Internal/Loop.lean new file mode 100644 index 0000000000..b6869cac9c --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryFor/Internal/Loop.lean @@ -0,0 +1,193 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryFor.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinarySucc.Internal + +/-! +# Canonical binary count-up loops — proof internals + +This module turns the wrapper-free loop certificates from `BinaryFor.Defs` +into exact executions and all-prefix auxiliary-space bounds. It also proves +that the binary loop driver preserves the one-way-output discipline of its +body. +-/ + + +public section + +namespace Complexity + +namespace TM + +variable {n : ℕ} + +/-- A certified canonical binary count-up loop has its advertised exact +remaining run. -/ +theorem BinaryForLoopSpec.reachesIn_internal {body : TM n} + {counterIdx limitIdx : Fin n} {bodyTime : ℕ → ℕ} {limitValue : ℕ} + (spec : BinaryForLoopSpec body counterIdx limitIdx bodyTime limitValue) : + ∀ count value, value + count = limitValue → + (binaryForTM body counterIdx limitIdx).reachesIn + (binaryForLoopTime bodyTime limitValue value count) + (spec.scanCfg value) spec.doneCfg := by + intro count + induction count with + | zero => + intro value hlimit + have hvalue : value = limitValue := by omega + subst value + exact spec.doneRun + | succ count ih => + intro value hlimit + have hvalue : value < limitValue := by omega + have htest := spec.testRun value hvalue + have hiteration := spec.iterationRun value hvalue + have hloopback : (binaryForTM body counterIdx limitIdx).reachesIn 1 + (spec.iterationDoneCfg value) (spec.scanCfg (value + 1)) := + .step (spec.loopbackStep value hvalue) .zero + have htail := ih (value + 1) (by omega) + have hreach := reachesIn_trans (binaryForTM body counterIdx limitIdx) htest + (reachesIn_trans (binaryForTM body counterIdx limitIdx) hiteration + (reachesIn_trans (binaryForTM body counterIdx limitIdx) hloopback htail)) + convert hreach using 1 + simp only [binaryForLoopTime] + omega + +/-- Scanner bounds are the reflexive prefixes of the comparison obligation. -/ +theorem BinaryForLoopSpaceSpec.scanWithin_internal + {body : TM n} {counterIdx limitIdx : Fin n} {bodyTime : ℕ → ℕ} + {limitValue inputLength spaceBound value : ℕ} + {spec : BinaryForLoopSpec body counterIdx limitIdx bodyTime limitValue} + (spaceSpec : BinaryForLoopSpaceSpec spec inputLength spaceBound) + (hvalue : value ≤ limitValue) : + (spec.scanCfg value).WithinAuxSpace inputLength spaceBound := + spaceSpec.testPrefixWithin value 0 (spec.scanCfg value) hvalue + (Nat.zero_le _) .zero + +/-- The final-state bound is the complete final comparison prefix. -/ +theorem BinaryForLoopSpaceSpec.doneWithin_internal + {body : TM n} {counterIdx limitIdx : Fin n} {bodyTime : ℕ → ℕ} + {limitValue inputLength spaceBound : ℕ} + {spec : BinaryForLoopSpec body counterIdx limitIdx bodyTime limitValue} + (spaceSpec : BinaryForLoopSpaceSpec spec inputLength spaceBound) : + spec.doneCfg.WithinAuxSpace inputLength spaceBound := + spaceSpec.testPrefixWithin limitValue (binaryForCompareTime limitValue) + spec.doneCfg le_rfl le_rfl spec.doneRun + +/-- Every configuration reached no later than a certified binary loop's exact +remaining runtime satisfies its auxiliary-space budget. -/ +theorem BinaryForLoopSpaceSpec.prefix_withinAuxSpace_internal + {body : TM n} {counterIdx limitIdx : Fin n} {bodyTime : ℕ → ℕ} + {limitValue inputLength spaceBound : ℕ} + {spec : BinaryForLoopSpec body counterIdx limitIdx bodyTime limitValue} + (spaceSpec : BinaryForLoopSpaceSpec spec inputLength spaceBound) : + ∀ count value t (c : Cfg n (binaryForTM body counterIdx limitIdx).Q), + value + count = limitValue → + (binaryForTM body counterIdx limitIdx).reachesIn t (spec.scanCfg value) c → + t ≤ binaryForLoopTime bodyTime limitValue value count → + c.WithinAuxSpace inputLength spaceBound := by + intro count + induction count with + | zero => + intro value t c hlimit hreach htime + have hvalue : value = limitValue := by omega + subst value + simp only [binaryForLoopTime] at htime + exact spaceSpec.testPrefixWithin limitValue t c le_rfl htime hreach + | succ count ih => + intro value t c hlimit hreach htime + have hvalue : value < limitValue := by omega + by_cases htest : t ≤ binaryForCompareTime limitValue + · exact spaceSpec.testPrefixWithin value t c (Nat.le_of_lt hvalue) + htest hreach + · let iterationTime := t - binaryForCompareTime limitValue + have htimeEq : binaryForCompareTime limitValue + iterationTime = t := by + dsimp only [iterationTime] + exact Nat.add_sub_of_le (by omega) + by_cases hiteration : + iterationTime ≤ binaryForIterationTime bodyTime value + · obtain ⟨d, hprefix, _hsuffix⟩ := reachesIn_prefix_internal + (spec.iterationRun value hvalue) hiteration + have hcanonical : (binaryForTM body counterIdx limitIdx).reachesIn t + (spec.scanCfg value) d := by + have htotalRun := reachesIn_trans + (binaryForTM body counterIdx limitIdx) + (spec.testRun value hvalue) hprefix + simpa [htimeEq] using htotalRun + have hc := (binaryForTM body counterIdx limitIdx).reachesIn_right_unique + hreach hcanonical + rw [hc] + exact spaceSpec.iterationPrefixWithin value iterationTime d hvalue + hiteration hprefix + · let prefixTime := binaryForCompareTime limitValue + + binaryForIterationTime bodyTime value + 1 + have hprefixTime : prefixTime ≤ t := by + dsimp only [prefixTime, iterationTime] at ⊢ hiteration + omega + let tailTime := t - prefixTime + have htailEq : prefixTime + tailTime = t := by + dsimp only [tailTime] + exact Nat.add_sub_of_le hprefixTime + have htailBound : + tailTime ≤ + binaryForLoopTime bodyTime limitValue (value + 1) count := by + rw [binaryForLoopTime] at htime + dsimp only [prefixTime, tailTime] at ⊢ + omega + have htailFull := spec.reachesIn_internal count (value + 1) (by omega) + obtain ⟨d, htail, _hsuffix⟩ := reachesIn_prefix_internal + htailFull htailBound + have hloopback : (binaryForTM body counterIdx limitIdx).reachesIn 1 + (spec.iterationDoneCfg value) (spec.scanCfg (value + 1)) := + .step (spec.loopbackStep value hvalue) .zero + have hcanonical := reachesIn_trans + (binaryForTM body counterIdx limitIdx) (spec.testRun value hvalue) + (reachesIn_trans (binaryForTM body counterIdx limitIdx) + (spec.iterationRun value hvalue) + (reachesIn_trans (binaryForTM body counterIdx limitIdx) + hloopback htail)) + have hcanonical' : (binaryForTM body counterIdx limitIdx).reachesIn t + (spec.scanCfg value) d := by + convert hcanonical using 1 + all_goals + dsimp only [prefixTime] at htailEq ⊢ + omega + have hc := (binaryForTM body counterIdx limitIdx).reachesIn_right_unique + hreach hcanonical' + rw [hc] + exact ih (value + 1) tailTime d (by omega) htail htailBound + +/-- A canonical binary count-up loop preserves the body's one-way-output +discipline. -/ +theorem IsTransducer.binaryForTM_internal {body : TM n} + (hbody : body.IsTransducer) (counterIdx limitIdx : Fin n) : + (binaryForTM body counterIdx limitIdx).IsTransducer := by + have hiteration : (binaryForIterationTM body counterIdx).IsTransducer := by + exact hbody.seqTM_internal (binarySuccTM_isTransducer_internal counterIdx) + intro state iHead wHeads oHead + cases state with + | inl phase => + cases phase with + | scan equalSoFar => + simp only [binaryForTM] + split <;> simp [idleDir] <;> split <;> decide + | rewind equalSoFar => + simp only [binaryForTM] + split <;> simp [idleDir] <;> split <;> decide + | done => + simp [binaryForTM, allIdle, idleDir] + split <;> decide + | inr q => + by_cases hq : q = (binaryForIterationTM body counterIdx).qhalt + · simp [binaryForTM, hq, allReadBack, idleDir] + split <;> decide + · simpa [binaryForTM, hq] using hiteration q iHead wHeads oHead + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryPred.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryPred.lean new file mode 100644 index 0000000000..42ae20a3de --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryPred.lean @@ -0,0 +1,142 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryPred.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryPred.Internal + +/-! +# Little-endian binary predecessor + +This module exposes the canonical semantics and compositional contracts for +`TM.binaryPredTM`. Natural numbers use little-endian `Nat.bits`. On positive +input `value + 1`, borrow propagates through initial zero bits, canonicalizes +the high bit when decrementing a power of two, and rewinds the target tape. + +The machine is total on canonical zero and leaves its empty representation +unchanged, but the decrement theorems deliberately require the target to +represent `value + 1`; they make no underflow claim. + +## Main results + +- `BinaryPred.ripple_succ_natBits` — pure borrow computes predecessor. +- `TM.binaryPredTM_reachesIn_frame` — exact execution with a full tape frame. +- `TM.binaryPredTM_hoareTimeSpace_frame` — terminating and all-reachable + width-based space contract. +- `TM.binaryPredTM_isTransducer` — the output head never moves left. +-/ + + +public section + +namespace Complexity + +namespace BinaryPred + +/-- Ripple borrow on the canonical bits of a positive natural computes its +predecessor, including high-bit erasure for powers of two. -/ +theorem ripple_succ_natBits (value : ℕ) : + ripple (value + 1).bits = value.bits := + ripple_succ_natBits_internal value + +/-- The exact transition count is at most twice the represented positive +input width, plus two. -/ +theorem steps_le (bits : List Bool) : + steps bits ≤ 2 * bits.length + 2 := + steps_le_internal bits + +end BinaryPred + +namespace TM + +/-- Exact predecessor time is bounded linearly in the binary width of the +positive input `value + 1`. -/ +theorem binaryPredTime_le (value : ℕ) : + binaryPredTime value ≤ 2 * (value + 1).size + 2 := + binaryPredTime_le_internal value + +/-- Starting on canonical positive `value + 1`, `binaryPredTM` halts after +exactly `binaryPredTime value` transitions with canonical `value`. Input, +output, and every unrelated work tape are preserved exactly. The positive +precondition is the explicit no-underflow boundary of this contract. -/ +theorem binaryPredTM_reachesIn_frame {n : ℕ} + (idx : Fin n) (value : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hvalue : (work₀ idx).HasBinaryNat (value + 1)) + (hinp : inp₀.read ≠ Γ.start) + (hother : ∀ i, i ≠ idx → (work₀ i).read ≠ Γ.start) + (hout : out₀.read ≠ Γ.start) : + ∃ c', + (binaryPredTM idx).reachesIn (binaryPredTime value) + { state := (binaryPredTM idx).qstart + input := inp₀ + work := work₀ + output := out₀ } c' ∧ + (binaryPredTM idx).halted c' ∧ + c'.input = inp₀ ∧ + (∀ i, i ≠ idx → c'.work i = work₀ i) ∧ + (c'.work idx).HasBinaryNat value ∧ + c'.output = out₀ := + binaryPredTM_reachesIn_frame_internal idx value inp₀ work₀ out₀ + hvalue hinp hother hout + +/-- Time-bounded compositional form of `binaryPredTM_reachesIn_frame`. -/ +theorem binaryPredTM_hoareTime_frame {n : ℕ} + (idx : Fin n) (value : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hvalue : (work₀ idx).HasBinaryNat (value + 1)) + (hinp : inp₀.read ≠ Γ.start) + (hother : ∀ i, i ≠ idx → (work₀ i).read ≠ Γ.start) + (hout : out₀.read ≠ Γ.start) : + (binaryPredTM idx).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + (∀ i, i ≠ idx → work i = work₀ i) ∧ + (work idx).HasBinaryNat value ∧ + out = out₀) + (binaryPredTime value) := + binaryPredTM_hoareTime_frame_internal idx value inp₀ work₀ out₀ + hvalue hinp hother hout + +/-- Time-and-space contract for positive canonical predecessor. Every +reachable configuration stays inside the explicit width-based budget +`binaryPredSpace initialSpace value`; this is independent of the represented +numeric magnitude except through its binary width. -/ +theorem binaryPredTM_hoareTimeSpace_frame {n : ℕ} + (idx : Fin n) (value inputLength initialSpace : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hvalue : (work₀ idx).HasBinaryNat (value + 1)) + (hinp : inp₀.read ≠ Γ.start) + (hother : ∀ i, i ≠ idx → (work₀ i).read ≠ Γ.start) + (hout : out₀.read ≠ Γ.start) + (hinitial : + ({ state := (binaryPredTM idx).qstart + input := inp₀ + work := work₀ + output := out₀ } : + Cfg n (binaryPredTM idx).Q).WithinAuxSpace inputLength initialSpace) : + (binaryPredTM idx).HoareTimeSpace + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + (∀ i, i ≠ idx → work i = work₀ i) ∧ + (work idx).HasBinaryNat value ∧ + out = out₀) + (binaryPredTime value) inputLength + (binaryPredSpace initialSpace value) := + binaryPredTM_hoareTimeSpace_frame_internal idx value inputLength initialSpace + inp₀ work₀ out₀ hvalue hinp hother hout hinitial + +/-- `binaryPredTM` never moves the output head left, so it is safe in +one-way-output, space-bounded compositions. -/ +theorem binaryPredTM_isTransducer {n : ℕ} (idx : Fin n) : + (binaryPredTM idx).IsTransducer := + binaryPredTM_isTransducer_internal idx + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryPred/Defs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryPred/Defs.lean new file mode 100644 index 0000000000..63ae953e9e --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryPred/Defs.lean @@ -0,0 +1,233 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators +public import Mathlib.Data.Nat.Bits + +/-! +# Little-endian binary predecessor — definitions + +This module defines the finite controller for in-place predecessor on a +positive canonical binary natural. Borrow turns initial low-order zero bits +into ones. The first one becomes zero; when it was the unique high bit, a +one-cell lookahead detects the terminating blank and erases that now-redundant +zero before rewinding. + +The controller is total on zero, where it simply rewinds the unchanged empty +representation. Public correctness theorems intentionally start from +`value + 1`, so no underflow behavior is claimed. +-/ + + +@[expose] public section + +namespace Complexity + +namespace BinaryPred + +/-- Ripple one borrow through a little-endian bit string, dropping a vacated +unique high bit. The empty case defines underflow as unchanged zero. -/ +def ripple : List Bool → List Bool + | [] => [] + | false :: rest => true :: ripple rest + | [true] => [] + | true :: bit :: rest => false :: bit :: rest + +/-- Exact transition count used by `binaryPredTM` on a canonical bit string. -/ +def steps : List Bool → ℕ + | [] => 2 + | false :: rest => steps rest + 2 + | true :: _ => 4 + +end BinaryPred + +namespace TM + +/-- Finite phases of ripple-borrow predecessor. -/ +inductive BinaryPredPhase where + | borrow + | check + | erase + | rewind + | done + deriving DecidableEq + +/-- `BinaryPredPhase` has exactly five states. -/ +instance instFintypeBinaryPredPhase : Fintype BinaryPredPhase where + elems := {.borrow, .check, .erase, .rewind, .done} + complete := fun state => by cases state <;> simp + +/-- Exact running time for decrementing canonical `value + 1` to `value`. -/ +def binaryPredTime (value : ℕ) : ℕ := + BinaryPred.steps (value + 1).bits + +/-- Explicit width-based all-prefix space budget for predecessor. -/ +def binaryPredSpace (initialSpace value : ℕ) : ℕ := + initialSpace + 2 * (value + 1).size + 2 + +/-- Decrement a positive canonical little-endian natural on work tape `idx`. + +The borrow phase flips initial zeros to ones and replaces the first one by +zero. A lookahead distinguishes an internal bit from the terminating blank; +the latter case erases the vacated high zero. The machine finally rewinds to +cell one. On canonical zero it takes the blank branch and leaves zero intact. +-/ +def binaryPredTM {n : ℕ} (idx : Fin n) : TM n where + Q := BinaryPredPhase + qstart := .borrow + qhalt := .done + δ := fun phase iHead wHeads oHead => + match phase with + | .borrow => + match wHeads idx with + | .zero => + (.borrow, + fun i => if i = idx then Γw.one else readBackWrite (wHeads i), + readBackWrite oHead, idleDir iHead, + fun i => if i = idx then Dir3.right else idleDir (wHeads i), + idleDir oHead) + | .one => + (.check, + fun i => if i = idx then Γw.zero else readBackWrite (wHeads i), + readBackWrite oHead, idleDir iHead, + fun i => if i = idx then Dir3.right else idleDir (wHeads i), + idleDir oHead) + | .blank => + (.rewind, fun i => readBackWrite (wHeads i), readBackWrite oHead, + idleDir iHead, + fun i => if i = idx then Dir3.left else idleDir (wHeads i), + idleDir oHead) + | .start => + (.borrow, fun i => readBackWrite (wHeads i), readBackWrite oHead, + idleDir iHead, + fun i => if i = idx then Dir3.right else idleDir (wHeads i), + idleDir oHead) + | .check => + match wHeads idx with + | .blank => + (.erase, fun i => readBackWrite (wHeads i), readBackWrite oHead, + idleDir iHead, + fun i => if i = idx then Dir3.left else idleDir (wHeads i), + idleDir oHead) + | .start => + (.rewind, fun i => readBackWrite (wHeads i), readBackWrite oHead, + idleDir iHead, + fun i => if i = idx then Dir3.right else idleDir (wHeads i), + idleDir oHead) + | .zero | .one => + (.rewind, fun i => readBackWrite (wHeads i), readBackWrite oHead, + idleDir iHead, + fun i => if i = idx then Dir3.left else idleDir (wHeads i), + idleDir oHead) + | .erase => + if wHeads idx = Γ.start then + (.rewind, fun i => readBackWrite (wHeads i), readBackWrite oHead, + idleDir iHead, + fun i => if i = idx then Dir3.right else idleDir (wHeads i), + idleDir oHead) + else + (.rewind, + fun i => if i = idx then Γw.blank else readBackWrite (wHeads i), + readBackWrite oHead, idleDir iHead, + fun i => if i = idx then Dir3.left else idleDir (wHeads i), + idleDir oHead) + | .rewind => + if wHeads idx = Γ.start then + (.done, fun i => readBackWrite (wHeads i), readBackWrite oHead, + idleDir iHead, + fun i => if i = idx then Dir3.right else idleDir (wHeads i), + idleDir oHead) + else + (.rewind, fun i => readBackWrite (wHeads i), readBackWrite oHead, + idleDir iHead, + fun i => if i = idx then Dir3.left else idleDir (wHeads i), + idleDir oHead) + | .done => allIdle .done iHead wHeads oHead + δ_right_of_start := by + intro phase iHead wHeads oHead + match phase with + | .borrow => + dsimp only + match htarget : wHeads idx with + | .zero | .one | .blank => + simp only + refine ⟨idleDir_right_of_start, fun i hi => ?_, + idleDir_right_of_start⟩ + by_cases hitarget : i = idx + · subst i + rw [htarget] at hi + exact absurd hi (by decide) + · rw [if_neg hitarget] + exact idleDir_right_of_start hi + | .start => + simp only + refine ⟨idleDir_right_of_start, fun i hi => ?_, + idleDir_right_of_start⟩ + by_cases hitarget : i = idx + · rw [if_pos hitarget] + · rw [if_neg hitarget] + exact idleDir_right_of_start hi + | .check => + dsimp only + match htarget : wHeads idx with + | .zero | .one | .blank => + simp only + refine ⟨idleDir_right_of_start, fun i hi => ?_, + idleDir_right_of_start⟩ + by_cases hitarget : i = idx + · subst i + rw [htarget] at hi + exact absurd hi (by decide) + · rw [if_neg hitarget] + exact idleDir_right_of_start hi + | .start => + simp only + refine ⟨idleDir_right_of_start, fun i hi => ?_, + idleDir_right_of_start⟩ + by_cases hitarget : i = idx + · rw [if_pos hitarget] + · rw [if_neg hitarget] + exact idleDir_right_of_start hi + | .erase => + dsimp only + split + · simp only + refine ⟨idleDir_right_of_start, fun i hi => ?_, idleDir_right_of_start⟩ + by_cases hitarget : i = idx + · rw [if_pos hitarget] + · rw [if_neg hitarget] + exact idleDir_right_of_start hi + · next hnotStart => + simp only + refine ⟨idleDir_right_of_start, fun i hi => ?_, idleDir_right_of_start⟩ + by_cases hitarget : i = idx + · subst i + exact absurd hi hnotStart + · rw [if_neg hitarget] + exact idleDir_right_of_start hi + | .rewind => + dsimp only + split + · simp only + refine ⟨idleDir_right_of_start, fun i hi => ?_, idleDir_right_of_start⟩ + by_cases hitarget : i = idx + · rw [if_pos hitarget] + · rw [if_neg hitarget] + exact idleDir_right_of_start hi + · next hnotStart => + simp only + refine ⟨idleDir_right_of_start, fun i hi => ?_, idleDir_right_of_start⟩ + by_cases hitarget : i = idx + · subst i + exact absurd hi hnotStart + · rw [if_neg hitarget] + exact idleDir_right_of_start hi + | .done => exact rightOfStart_allIdle iHead wHeads oHead + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryPred/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryPred/Internal.lean new file mode 100644 index 0000000000..ca12af339d --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryPred/Internal.lean @@ -0,0 +1,891 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Mathlib.NatBits +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Hoare.Space +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryPred.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinarySucc.Defs +public import Mathlib.Algebra.Order.Ring.Nat +public import Mathlib.Algebra.Order.Sub.Basic + +/-! +# Little-endian binary predecessor — proof internals + +This file proves pure ripple-borrow semantics and the exact full-frame +execution of `TM.binaryPredTM`. The machine proof tracks the already-borrowed +low-order prefix independently of the target head, including the canonical +high-bit erasure needed when decrementing a power of two. +-/ + + +public section + +namespace Complexity + +namespace BinaryPred + +/-- Internal proof that ripple borrow on a positive canonical value computes +its predecessor. -/ +theorem ripple_succ_natBits_internal (value : ℕ) : + ripple (value + 1).bits = value.bits := by + induction value using Nat.binaryRec' with + | zero => simp [ripple] + | bit bit value hcanonical ih => + rw [Nat.bits_append_bit value bit hcanonical] + cases bit with + | false => + have hvalue : value ≠ 0 := by + intro hzero + have := hcanonical hzero + contradiction + rw [show Nat.bit false value + 1 = Nat.bit true value by + simp [Nat.bit]] + rw [Nat.bits_append_bit value true (fun _ => rfl)] + cases hbits : value.bits with + | nil => + exfalso + apply hvalue + have hdecoded := Nat.fromBitsLE_bits value + rw [hbits] at hdecoded + simpa [Nat.fromBitsLE, Nat.fromBits] using hdecoded.symm + | cons first rest => simp [ripple] + | true => + rw [show Nat.bit true value + 1 = Nat.bit false (value + 1) by + simp [Nat.bit] + omega] + rw [Nat.bits_append_bit (value + 1) false (by omega)] + simp only [ripple] + rw [ih] + +/-- Internal worst-case bound for predecessor's exact transition count. -/ +theorem steps_le_internal (bits : List Bool) : + steps bits ≤ 2 * bits.length + 2 := by + induction bits with + | nil => simp [steps] + | cons bit bits ih => + cases bit + · simp only [steps, List.length_cons] + omega + · simp [steps] + +end BinaryPred + +namespace Tape + +private theorem HasBinaryContent.binaryPred_read_cons {t : Tape} {done : ℕ} + {bit : Bool} {rest : List Bool} + (h : t.HasBinaryContent (List.replicate done true ++ bit :: rest)) + (hhead : t.head = done + 1) : t.read = Γ.ofBool bit := by + rw [Tape.read, hhead] + have hcell := h.1 done (by simp) + simpa using hcell + +private theorem HasBinaryContent.binaryPred_read_nil {t : Tape} {done : ℕ} + (h : t.HasBinaryContent (List.replicate done true)) + (hhead : t.head = done + 1) : t.read = Γ.blank := by + rw [Tape.read, hhead] + exact h.2 done (by simp) + +/-- Replacing the last represented bit by blank shortens canonical contents. -/ +private theorem HasBinaryContent.binaryPred_erase_last {t : Tape} + {bitsPrefix : List Bool} + (h : t.HasBinaryContent (bitsPrefix ++ [false])) + (hhead : t.head = bitsPrefix.length + 1) : + (t.write Γ.blank).HasBinaryContent bitsPrefix := by + have hhead0 : t.head ≠ 0 := by omega + constructor + · intro i hi + rw [Tape.write, if_neg hhead0] + simp only + rw [hhead, Function.update_of_ne (by omega)] + have hcell := h.1 i (by simp; omega) + simpa [List.getElem_append, hi] using hcell + · intro i hi + rw [Tape.write, if_neg hhead0] + simp only + rw [hhead] + by_cases heq : i = bitsPrefix.length + · subst i + rw [Function.update_self] + · rw [Function.update_of_ne (by omega)] + exact h.2 i (by simp; omega) + +end Tape + +namespace BinaryPred + +private theorem set_false_to_true (done : ℕ) (rest : List Bool) : + (List.replicate done true ++ false :: rest).set done true = + List.replicate (done + 1) true ++ rest := by + induction done with + | zero => rfl + | succ done ih => + change true :: (List.replicate done true ++ false :: rest).set done true = + true :: true :: (List.replicate done true ++ rest) + congr 1 + +private theorem set_true_to_false (done : ℕ) (rest : List Bool) : + (List.replicate done true ++ true :: rest).set done false = + List.replicate done true ++ false :: rest := by + induction done with + | zero => rfl + | succ done ih => + change true :: (List.replicate done true ++ true :: rest).set done false = + true :: (List.replicate done true ++ false :: rest) + congr 1 + +end BinaryPred + +namespace TM + +variable {n : ℕ} {idx : Fin n} + +private theorem binaryPredTM_ne_halt {phase : BinaryPredPhase} + (hne : phase ≠ .done) {c : Cfg n (binaryPredTM idx).Q} + (hstate : c.state = phase) : + c.state ≠ (binaryPredTM idx).qhalt := by + rw [hstate] + exact hne + +/-- Propagate borrow over one low-order zero. -/ +private theorem binaryPredTM_step_zero (c : Cfg n (binaryPredTM idx).Q) + (hstate : c.state = .borrow) (hread : (c.work idx).read = Γ.zero) + (hinput : c.input.read ≠ Γ.start) + (hother : ∀ i, i ≠ idx → (c.work i).read ≠ Γ.start) + (houtput : c.output.read ≠ Γ.start) : + (binaryPredTM idx).step c = some + { state := .borrow + input := c.input + work := Function.update c.work idx + (((c.work idx).write Γ.one).move Dir3.right) + output := c.output } := by + rw [TM.step, if_neg (binaryPredTM_ne_halt (by decide) hstate)] + simp only [binaryPredTM, hstate, hread] + refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, ?_, ?_, ?_⟩) + · exact transitionInput_eq_self hinput + · funext i + by_cases hi : i = idx + · subst i + simp only [↓reduceIte, Function.update_self] + rfl + · rw [Function.update_of_ne hi] + simpa only [if_neg hi] using transitionTape_eq_self (hother i hi) + · exact transitionTape_eq_self houtput + +/-- Resolve borrow at the first one and advance to lookahead. -/ +private theorem binaryPredTM_step_one (c : Cfg n (binaryPredTM idx).Q) + (hstate : c.state = .borrow) (hread : (c.work idx).read = Γ.one) + (hinput : c.input.read ≠ Γ.start) + (hother : ∀ i, i ≠ idx → (c.work i).read ≠ Γ.start) + (houtput : c.output.read ≠ Γ.start) : + (binaryPredTM idx).step c = some + { state := .check + input := c.input + work := Function.update c.work idx + (((c.work idx).write Γ.zero).move Dir3.right) + output := c.output } := by + rw [TM.step, if_neg (binaryPredTM_ne_halt (by decide) hstate)] + simp only [binaryPredTM, hstate, hread] + refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, ?_, ?_, ?_⟩) + · exact transitionInput_eq_self hinput + · funext i + by_cases hi : i = idx + · subst i + simp only [↓reduceIte, Function.update_self] + rfl + · rw [Function.update_of_ne hi] + simpa only [if_neg hi] using transitionTape_eq_self (hother i hi) + · exact transitionTape_eq_self houtput + +/-- Define zero underflow by turning left from the terminating blank. -/ +private theorem binaryPredTM_step_borrow_blank + (c : Cfg n (binaryPredTM idx).Q) + (hstate : c.state = .borrow) (hread : (c.work idx).read = Γ.blank) + (hinput : c.input.read ≠ Γ.start) + (hother : ∀ i, i ≠ idx → (c.work i).read ≠ Γ.start) + (houtput : c.output.read ≠ Γ.start) : + (binaryPredTM idx).step c = some + { state := .rewind + input := c.input + work := Function.update c.work idx ((c.work idx).move Dir3.left) + output := c.output } := by + rw [TM.step, if_neg (binaryPredTM_ne_halt (by decide) hstate)] + simp only [binaryPredTM, hstate, hread] + refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, ?_, ?_, ?_⟩) + · exact transitionInput_eq_self hinput + · funext i + by_cases hi : i = idx + · subst i + rw [if_pos rfl, Function.update_self, + writeAndMove_readBack _ (by rw [hread]; decide)] + · rw [if_neg hi, Function.update_of_ne hi] + exact transitionTape_eq_self (hother i hi) + · exact transitionTape_eq_self houtput + +/-- A nonblank lookahead turns left and begins rewinding. -/ +private theorem binaryPredTM_step_check_bit (bit : Bool) + (c : Cfg n (binaryPredTM idx).Q) + (hstate : c.state = .check) + (hread : (c.work idx).read = Γ.ofBool bit) + (hinput : c.input.read ≠ Γ.start) + (hother : ∀ i, i ≠ idx → (c.work i).read ≠ Γ.start) + (houtput : c.output.read ≠ Γ.start) : + (binaryPredTM idx).step c = some + { state := .rewind + input := c.input + work := Function.update c.work idx ((c.work idx).move Dir3.left) + output := c.output } := by + rw [TM.step, if_neg (binaryPredTM_ne_halt (by decide) hstate)] + cases bit <;> simp only [Γ.ofBool, binaryPredTM, hstate, hread] + all_goals + refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, ?_, ?_, ?_⟩) + · exact transitionInput_eq_self hinput + · funext i + by_cases hi : i = idx + · subst i + rw [if_pos rfl, Function.update_self, + writeAndMove_readBack _ (by rw [hread]; decide)] + · rw [if_neg hi, Function.update_of_ne hi] + exact transitionTape_eq_self (hother i hi) + · exact transitionTape_eq_self houtput + +/-- A blank lookahead identifies a vacated unique high bit. -/ +private theorem binaryPredTM_step_check_blank + (c : Cfg n (binaryPredTM idx).Q) + (hstate : c.state = .check) (hread : (c.work idx).read = Γ.blank) + (hinput : c.input.read ≠ Γ.start) + (hother : ∀ i, i ≠ idx → (c.work i).read ≠ Γ.start) + (houtput : c.output.read ≠ Γ.start) : + (binaryPredTM idx).step c = some + { state := .erase + input := c.input + work := Function.update c.work idx ((c.work idx).move Dir3.left) + output := c.output } := by + rw [TM.step, if_neg (binaryPredTM_ne_halt (by decide) hstate)] + simp only [binaryPredTM, hstate, hread] + refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, ?_, ?_, ?_⟩) + · exact transitionInput_eq_self hinput + · funext i + by_cases hi : i = idx + · subst i + rw [if_pos rfl, Function.update_self, + writeAndMove_readBack _ (by rw [hread]; decide)] + · rw [if_neg hi, Function.update_of_ne hi] + exact transitionTape_eq_self (hother i hi) + · exact transitionTape_eq_self houtput + +/-- Erase the vacated high zero and turn left. -/ +private theorem binaryPredTM_step_erase (c : Cfg n (binaryPredTM idx).Q) + (hstate : c.state = .erase) (hread : (c.work idx).read ≠ Γ.start) + (hinput : c.input.read ≠ Γ.start) + (hother : ∀ i, i ≠ idx → (c.work i).read ≠ Γ.start) + (houtput : c.output.read ≠ Γ.start) : + (binaryPredTM idx).step c = some + { state := .rewind + input := c.input + work := Function.update c.work idx + (((c.work idx).write Γ.blank).move Dir3.left) + output := c.output } := by + rw [TM.step, if_neg (binaryPredTM_ne_halt (by decide) hstate)] + simp only [binaryPredTM, hstate, hread, ↓reduceIte] + refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, ?_, ?_, ?_⟩) + · exact transitionInput_eq_self hinput + · funext i + by_cases hi : i = idx + · subst i + simp only [↓reduceIte, Function.update_self] + rfl + · rw [Function.update_of_ne hi] + simpa only [if_neg hi] using transitionTape_eq_self (hother i hi) + · exact transitionTape_eq_self houtput + +/-- Rewind one ordinary target cell to the left. -/ +private theorem binaryPredTM_step_rewind (c : Cfg n (binaryPredTM idx).Q) + (hstate : c.state = .rewind) (hread : (c.work idx).read ≠ Γ.start) + (hinput : c.input.read ≠ Γ.start) + (hother : ∀ i, i ≠ idx → (c.work i).read ≠ Γ.start) + (houtput : c.output.read ≠ Γ.start) : + (binaryPredTM idx).step c = some + { state := .rewind + input := c.input + work := Function.update c.work idx ((c.work idx).move Dir3.left) + output := c.output } := by + rw [TM.step, if_neg (binaryPredTM_ne_halt (by decide) hstate)] + simp only [binaryPredTM, hstate, hread, ↓reduceIte] + refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, ?_, ?_, ?_⟩) + · exact transitionInput_eq_self hinput + · funext i + by_cases hi : i = idx + · subst i + rw [if_pos rfl, Function.update_self, + writeAndMove_readBack _ hread] + · rw [if_neg hi, Function.update_of_ne hi] + exact transitionTape_eq_self (hother i hi) + · exact transitionTape_eq_self houtput + +/-- Bounce right from the left marker and halt. -/ +private theorem binaryPredTM_step_start (c : Cfg n (binaryPredTM idx).Q) + (hstate : c.state = .rewind) (hread : (c.work idx).read = Γ.start) + (hhead : (c.work idx).head = 0) + (hinput : c.input.read ≠ Γ.start) + (hother : ∀ i, i ≠ idx → (c.work i).read ≠ Γ.start) + (houtput : c.output.read ≠ Γ.start) : + (binaryPredTM idx).step c = some + { state := .done + input := c.input + work := Function.update c.work idx ((c.work idx).move Dir3.right) + output := c.output } := by + rw [TM.step, if_neg (binaryPredTM_ne_halt (by decide) hstate)] + simp only [binaryPredTM, hstate, hread, ↓reduceIte] + refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, ?_, ?_, ?_⟩) + · exact transitionInput_eq_self hinput + · funext i + by_cases hi : i = idx + · subst i + simp only [↓reduceIte, Function.update_self] + show (((c.work idx).write _).move Dir3.right) = + (c.work idx).move Dir3.right + rw [Tape.write, if_pos hhead] + · rw [if_neg hi, Function.update_of_ne hi] + exact transitionTape_eq_self (hother i hi) + · exact transitionTape_eq_self houtput + +/-! ## Exact rewind and borrow runs -/ + +private theorem binaryPredTM_rewind_run (bits : List Bool) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hinp : inp₀.read ≠ Γ.start) + (hother : ∀ i, i ≠ idx → (work₀ i).read ≠ Γ.start) + (hout : out₀.read ≠ Γ.start) : + ∀ head (c : Cfg n (binaryPredTM idx).Q), + c.state = .rewind → + c.input = inp₀ → + (∀ i, i ≠ idx → c.work i = work₀ i) → + (c.work idx).HasBinaryContent bits → + (c.work idx).cells 0 = Γ.start → + (c.work idx).head = head → + c.output = out₀ → + ∃ c', + (binaryPredTM idx).reachesIn (head + 1) c c' ∧ + (binaryPredTM idx).halted c' ∧ + c'.input = inp₀ ∧ + (∀ i, i ≠ idx → c'.work i = work₀ i) ∧ + (c'.work idx).HasBinaryString bits ∧ + (c'.work idx).cells 0 = Γ.start ∧ + c'.output = out₀ := by + intro head + induction head with + | zero => + intro c hstate hinput hwork hcontent hcell0 hhead houtput + have hread : (c.work idx).read = Γ.start := by + rw [Tape.read, hhead] + exact hcell0 + have hstep := binaryPredTM_step_start c hstate hread hhead + (by rw [hinput]; exact hinp) + (fun i hi => by rw [hwork i hi]; exact hother i hi) + (by rw [houtput]; exact hout) + let c₁ : Cfg n (binaryPredTM idx).Q := + { state := .done + input := c.input + work := Function.update c.work idx ((c.work idx).move Dir3.right) + output := c.output } + refine ⟨c₁, .step hstep .zero, rfl, hinput, ?_, ?_, ?_, houtput⟩ + · intro i hi + show Function.update c.work idx ((c.work idx).move Dir3.right) i = work₀ i + rw [Function.update_of_ne hi] + exact hwork i hi + · show (Function.update c.work idx ((c.work idx).move Dir3.right) idx) + |>.HasBinaryString bits + rw [Function.update_self] + apply Tape.HasBinaryContent.hasBinaryString + · simpa only [Tape.HasBinaryContent, Tape.move_cells] using hcontent + · simp [Tape.move, hhead] + · show (Function.update c.work idx ((c.work idx).move Dir3.right) idx).cells 0 = _ + rw [Function.update_self, Tape.move_cells] + exact hcell0 + | succ head ih => + intro c hstate hinput hwork hcontent hcell0 hhead houtput + have hread : (c.work idx).read ≠ Γ.start := by + rw [Tape.read, hhead] + exact hcontent.cells_ne_start (head + 1) (by omega) + have hstep := binaryPredTM_step_rewind c hstate hread + (by rw [hinput]; exact hinp) + (fun i hi => by rw [hwork i hi]; exact hother i hi) + (by rw [houtput]; exact hout) + let c₁ : Cfg n (binaryPredTM idx).Q := + { state := .rewind + input := c.input + work := Function.update c.work idx ((c.work idx).move Dir3.left) + output := c.output } + obtain ⟨c', hreach, hhalt, hinput', hwork', hstring, hcell0', houtput'⟩ := + ih c₁ rfl hinput + (fun i hi => by + show Function.update c.work idx ((c.work idx).move Dir3.left) i = work₀ i + rw [Function.update_of_ne hi] + exact hwork i hi) + (by + show (Function.update c.work idx ((c.work idx).move Dir3.left) idx) + |>.HasBinaryContent bits + rw [Function.update_self] + simpa only [Tape.HasBinaryContent, Tape.move_cells] using hcontent) + (by + show (Function.update c.work idx ((c.work idx).move Dir3.left) idx).cells 0 = _ + rw [Function.update_self, Tape.move_cells] + exact hcell0) + (by + show (Function.update c.work idx ((c.work idx).move Dir3.left) idx).head = + head + rw [Function.update_self] + simp [Tape.move, hhead]) + houtput + refine ⟨c', ?_, hhalt, hinput', hwork', hstring, hcell0', houtput'⟩ + simpa [Nat.succ_eq_add_one, Nat.add_assoc] using + (TM.reachesIn.step hstep hreach) + +private theorem binaryPredTM_borrow_run + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hinp : inp₀.read ≠ Γ.start) + (hother : ∀ i, i ≠ idx → (work₀ i).read ≠ Γ.start) + (hout : out₀.read ≠ Γ.start) : + ∀ done bits (c : Cfg n (binaryPredTM idx).Q), + c.state = .borrow → + c.input = inp₀ → + (∀ i, i ≠ idx → c.work i = work₀ i) → + (c.work idx).HasBinaryContent (List.replicate done true ++ bits) → + (c.work idx).cells 0 = Γ.start → + (c.work idx).head = done + 1 → + c.output = out₀ → + ∃ c', + (binaryPredTM idx).reachesIn (done + BinaryPred.steps bits) c c' ∧ + (binaryPredTM idx).halted c' ∧ + c'.input = inp₀ ∧ + (∀ i, i ≠ idx → c'.work i = work₀ i) ∧ + (c'.work idx).HasBinaryString + (List.replicate done true ++ BinaryPred.ripple bits) ∧ + (c'.work idx).cells 0 = Γ.start ∧ + c'.output = out₀ := by + intro done bits + induction bits generalizing done with + | nil => + intro c hstate hinput hwork hcontent hcell0 hhead houtput + have hcontent' : + (c.work idx).HasBinaryContent (List.replicate done true) := by + simpa using hcontent + have hread : (c.work idx).read = Γ.blank := + hcontent'.binaryPred_read_nil hhead + have hstep := binaryPredTM_step_borrow_blank c hstate hread + (by rw [hinput]; exact hinp) + (fun i hi => by rw [hwork i hi]; exact hother i hi) + (by rw [houtput]; exact hout) + let target : Tape := (c.work idx).move Dir3.left + have htargetContent : + target.HasBinaryContent (List.replicate done true) := by + simpa only [target] using hcontent'.move Dir3.left + have htargetCell0 : target.cells 0 = Γ.start := by + simpa [target, Tape.move_cells] using hcell0 + have htargetHead : target.head = done := by + simp [target, Tape.move, hhead] + let c₁ : Cfg n (binaryPredTM idx).Q := + { state := .rewind + input := c.input + work := Function.update c.work idx target + output := c.output } + obtain ⟨c', hreach, hhalt, hinput', hwork', hstring, hcell0', houtput'⟩ := + binaryPredTM_rewind_run (idx := idx) (List.replicate done true) + inp₀ work₀ out₀ hinp hother hout done c₁ rfl hinput + (fun i hi => by + show Function.update c.work idx target i = work₀ i + rw [Function.update_of_ne hi] + exact hwork i hi) + (by + show (Function.update c.work idx target idx).HasBinaryContent _ + rw [Function.update_self] + exact htargetContent) + (by + show (Function.update c.work idx target idx).cells 0 = _ + rw [Function.update_self] + exact htargetCell0) + (by + show (Function.update c.work idx target idx).head = done + rw [Function.update_self] + exact htargetHead) + houtput + refine ⟨c', ?_, hhalt, hinput', hwork', ?_, hcell0', houtput'⟩ + · simpa [BinaryPred.steps, Nat.add_assoc] using + (TM.reachesIn.step hstep hreach) + · simpa [BinaryPred.ripple] using hstring + | cons bit rest ih => + cases bit with + | false => + intro c hstate hinput hwork hcontent hcell0 hhead houtput + have hread : (c.work idx).read = Γ.zero := + hcontent.binaryPred_read_cons hhead + have hstep := binaryPredTM_step_zero c hstate hread + (by rw [hinput]; exact hinp) + (fun i hi => by rw [hwork i hi]; exact hother i hi) + (by rw [houtput]; exact hout) + let target : Tape := ((c.work idx).write Γ.one).move Dir3.right + have htargetContent : target.HasBinaryContent + (List.replicate (done + 1) true ++ rest) := by + have hwrite := hcontent.write_set true hhead (by simp) + rw [BinaryPred.set_false_to_true] at hwrite + simpa only [target, Tape.HasBinaryContent, Tape.move_cells] using + hwrite + have htargetCell0 : target.cells 0 = Γ.start := by + exact Tape.write_move_cell0 Γ.one Dir3.right hcell0 + have htargetHead : target.head = (done + 1) + 1 := by + simp [target, Tape.move, Tape.write_head, hhead] + let c₁ : Cfg n (binaryPredTM idx).Q := + { state := .borrow + input := c.input + work := Function.update c.work idx target + output := c.output } + obtain ⟨c', hreach, hhalt, hinput', hwork', hstring, hcell0', houtput'⟩ := + ih (done + 1) c₁ rfl hinput + (fun i hi => by + show Function.update c.work idx target i = work₀ i + rw [Function.update_of_ne hi] + exact hwork i hi) + (by + show (Function.update c.work idx target idx).HasBinaryContent _ + rw [Function.update_self] + exact htargetContent) + (by + show (Function.update c.work idx target idx).cells 0 = _ + rw [Function.update_self] + exact htargetCell0) + (by + show (Function.update c.work idx target idx).head = + (done + 1) + 1 + rw [Function.update_self] + exact htargetHead) + houtput + refine ⟨c', ?_, hhalt, hinput', hwork', ?_, hcell0', houtput'⟩ + · convert TM.reachesIn.step hstep hreach using 1 + all_goals simp [BinaryPred.steps, Nat.add_assoc] + all_goals omega + · simpa [BinaryPred.ripple, List.replicate_add, + List.append_assoc] using hstring + | true => + cases rest with + | nil => + intro c hstate hinput hwork hcontent hcell0 hhead houtput + have hread : (c.work idx).read = Γ.one := + hcontent.binaryPred_read_cons hhead + have hstep := binaryPredTM_step_one c hstate hread + (by rw [hinput]; exact hinp) + (fun i hi => by rw [hwork i hi]; exact hother i hi) + (by rw [houtput]; exact hout) + let target₁ : Tape := + ((c.work idx).write Γ.zero).move Dir3.right + have htarget₁Content : target₁.HasBinaryContent + (List.replicate done true ++ [false]) := by + have hwrite := hcontent.write_set false hhead (by simp) + rw [BinaryPred.set_true_to_false] at hwrite + simpa only [target₁, Tape.HasBinaryContent, Tape.move_cells] + using hwrite + have htarget₁Cell0 : target₁.cells 0 = Γ.start := by + exact Tape.write_move_cell0 Γ.zero Dir3.right hcell0 + have htarget₁Head : target₁.head = done + 2 := by + simp [target₁, Tape.move, Tape.write_head, hhead] + have htarget₁Read : target₁.read = Γ.blank := by + rw [Tape.read, htarget₁Head] + exact htarget₁Content.2 (done + 1) (by simp) + let c₁ : Cfg n (binaryPredTM idx).Q := + { state := .check + input := c.input + work := Function.update c.work idx target₁ + output := c.output } + have hcheck := binaryPredTM_step_check_blank c₁ rfl + (by simpa [c₁] using htarget₁Read) + (by rw [hinput]; exact hinp) + (fun i hi => by + simp only [c₁, Function.update_of_ne hi] + rw [hwork i hi] + exact hother i hi) + (by rw [houtput]; exact hout) + let target₂ : Tape := target₁.move Dir3.left + have htarget₂Content : target₂.HasBinaryContent + (List.replicate done true ++ [false]) := by + simpa only [target₂] using htarget₁Content.move Dir3.left + have htarget₂Cell0 : target₂.cells 0 = Γ.start := by + simpa [target₂, Tape.move_cells] using htarget₁Cell0 + have htarget₂Head : target₂.head = done + 1 := by + simp [target₂, Tape.move, htarget₁Head] + have htarget₂Read : target₂.read ≠ Γ.start := + htarget₂Content.cells_ne_start target₂.head (by + rw [htarget₂Head] + omega) + let c₂ : Cfg n (binaryPredTM idx).Q := + { state := .erase + input := c.input + work := Function.update c.work idx target₂ + output := c.output } + have herase := binaryPredTM_step_erase c₂ rfl + (by simpa [c₂] using htarget₂Read) + (by rw [hinput]; exact hinp) + (fun i hi => by + simp only [c₂, Function.update_of_ne hi] + rw [hwork i hi] + exact hother i hi) + (by rw [houtput]; exact hout) + let target₃ : Tape := + (target₂.write Γ.blank).move Dir3.left + have htarget₃Content : + target₃.HasBinaryContent (List.replicate done true) := by + have herased := htarget₂Content.binaryPred_erase_last (by + simpa using htarget₂Head) + simpa only [target₃] using herased.move Dir3.left + have htarget₃Cell0 : target₃.cells 0 = Γ.start := by + exact Tape.write_move_cell0 Γ.blank Dir3.left htarget₂Cell0 + have htarget₃Head : target₃.head = done := by + simp [target₃, Tape.move, Tape.write_head, htarget₂Head] + let c₃ : Cfg n (binaryPredTM idx).Q := + { state := .rewind + input := c.input + work := Function.update c.work idx target₃ + output := c.output } + have hcheck' : (binaryPredTM idx).step c₁ = some c₂ := by + simpa [c₁, c₂, target₂] using hcheck + have herase' : (binaryPredTM idx).step c₂ = some c₃ := by + simpa [c₂, c₃, target₃] using herase + obtain ⟨c', hreach, hhalt, hinput', hwork', hstring, + hcell0', houtput'⟩ := + binaryPredTM_rewind_run (idx := idx) + (List.replicate done true) inp₀ work₀ out₀ hinp hother + hout done c₃ rfl hinput + (fun i hi => by + show Function.update c.work idx target₃ i = work₀ i + rw [Function.update_of_ne hi] + exact hwork i hi) + (by + show (Function.update c.work idx target₃ idx) + |>.HasBinaryContent _ + rw [Function.update_self] + exact htarget₃Content) + (by + show (Function.update c.work idx target₃ idx).cells 0 = _ + rw [Function.update_self] + exact htarget₃Cell0) + (by + show (Function.update c.work idx target₃ idx).head = done + rw [Function.update_self] + exact htarget₃Head) + houtput + have hprefix : (binaryPredTM idx).reachesIn 3 c c₃ := by + exact .step hstep (.step hcheck' (.step herase' .zero)) + refine ⟨c', ?_, hhalt, hinput', hwork', ?_, hcell0', houtput'⟩ + · have hrun := reachesIn_trans (binaryPredTM idx) hprefix hreach + convert hrun using 1 + all_goals simp [BinaryPred.steps] + all_goals omega + · simpa [BinaryPred.ripple] using hstring + | cons next rest => + intro c hstate hinput hwork hcontent hcell0 hhead houtput + have hread : (c.work idx).read = Γ.one := + hcontent.binaryPred_read_cons hhead + have hstep := binaryPredTM_step_one c hstate hread + (by rw [hinput]; exact hinp) + (fun i hi => by rw [hwork i hi]; exact hother i hi) + (by rw [houtput]; exact hout) + let target₁ : Tape := + ((c.work idx).write Γ.zero).move Dir3.right + have htarget₁Content : target₁.HasBinaryContent + (List.replicate done true ++ false :: next :: rest) := by + have hwrite := hcontent.write_set false hhead (by simp) + rw [BinaryPred.set_true_to_false] at hwrite + simpa only [target₁, Tape.HasBinaryContent, Tape.move_cells] + using hwrite + have htarget₁Cell0 : target₁.cells 0 = Γ.start := by + exact Tape.write_move_cell0 Γ.zero Dir3.right hcell0 + have htarget₁Head : target₁.head = done + 2 := by + simp [target₁, Tape.move, Tape.write_head, hhead] + have htarget₁Read : target₁.read = Γ.ofBool next := by + rw [Tape.read, htarget₁Head] + have hcell := htarget₁Content.1 (done + 1) (by simp) + simpa [List.getElem_append] using hcell + let c₁ : Cfg n (binaryPredTM idx).Q := + { state := .check + input := c.input + work := Function.update c.work idx target₁ + output := c.output } + have hcheck := binaryPredTM_step_check_bit next c₁ rfl + (by simpa [c₁] using htarget₁Read) + (by rw [hinput]; exact hinp) + (fun i hi => by + simp only [c₁, Function.update_of_ne hi] + rw [hwork i hi] + exact hother i hi) + (by rw [houtput]; exact hout) + let target₂ : Tape := target₁.move Dir3.left + have htarget₂Content : target₂.HasBinaryContent + (List.replicate done true ++ false :: next :: rest) := by + simpa only [target₂] using htarget₁Content.move Dir3.left + have htarget₂Cell0 : target₂.cells 0 = Γ.start := by + simpa [target₂, Tape.move_cells] using htarget₁Cell0 + have htarget₂Head : target₂.head = done + 1 := by + simp [target₂, Tape.move, htarget₁Head] + let c₂ : Cfg n (binaryPredTM idx).Q := + { state := .rewind + input := c.input + work := Function.update c.work idx target₂ + output := c.output } + have hcheck' : (binaryPredTM idx).step c₁ = some c₂ := by + simpa [c₁, c₂, target₂] using hcheck + obtain ⟨c', hreach, hhalt, hinput', hwork', hstring, + hcell0', houtput'⟩ := + binaryPredTM_rewind_run (idx := idx) + (List.replicate done true ++ false :: next :: rest) + inp₀ work₀ out₀ hinp hother hout (done + 1) c₂ rfl hinput + (fun i hi => by + show Function.update c.work idx target₂ i = work₀ i + rw [Function.update_of_ne hi] + exact hwork i hi) + (by + show (Function.update c.work idx target₂ idx) + |>.HasBinaryContent _ + rw [Function.update_self] + exact htarget₂Content) + (by + show (Function.update c.work idx target₂ idx).cells 0 = _ + rw [Function.update_self] + exact htarget₂Cell0) + (by + show (Function.update c.work idx target₂ idx).head = done + 1 + rw [Function.update_self] + exact htarget₂Head) + houtput + have hprefix : (binaryPredTM idx).reachesIn 2 c c₂ := by + exact .step hstep (.step hcheck' .zero) + refine ⟨c', ?_, hhalt, hinput', hwork', ?_, hcell0', houtput'⟩ + · have hrun := reachesIn_trans (binaryPredTM idx) hprefix hreach + convert hrun using 1 + all_goals simp [BinaryPred.steps] + all_goals omega + · simpa [BinaryPred.ripple] using hstring + +/-! ## Public-theorem internals -/ + +theorem binaryPredTime_le_internal (value : ℕ) : + binaryPredTime value ≤ 2 * (value + 1).size + 2 := by + simpa [binaryPredTime, Nat.size_eq_bits_len] using + BinaryPred.steps_le_internal (value + 1).bits + +theorem binaryPredTM_reachesIn_frame_internal + (idx : Fin n) (value : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hvalue : (work₀ idx).HasBinaryNat (value + 1)) + (hinp : inp₀.read ≠ Γ.start) + (hother : ∀ i, i ≠ idx → (work₀ i).read ≠ Γ.start) + (hout : out₀.read ≠ Γ.start) : + ∃ c', + (binaryPredTM idx).reachesIn (binaryPredTime value) + { state := (binaryPredTM idx).qstart + input := inp₀ + work := work₀ + output := out₀ } c' ∧ + (binaryPredTM idx).halted c' ∧ + c'.input = inp₀ ∧ + (∀ i, i ≠ idx → c'.work i = work₀ i) ∧ + (c'.work idx).HasBinaryNat value ∧ + c'.output = out₀ := by + let c₀ : Cfg n (binaryPredTM idx).Q := + { state := (binaryPredTM idx).qstart + input := inp₀ + work := work₀ + output := out₀ } + obtain ⟨c', hreach, hhalt, hinput, hwork, hstring, hcell0, houtput⟩ := + binaryPredTM_borrow_run (idx := idx) inp₀ work₀ out₀ hinp hother hout + 0 (value + 1).bits c₀ (by rfl) (by rfl) (fun _ _ => rfl) + (by simpa [c₀] using hvalue.2.hasBinaryContent) hvalue.1 + (by simpa [c₀] using hvalue.2.1) (by rfl) + refine ⟨c', ?_, hhalt, hinput, hwork, ?_, houtput⟩ + · simpa [c₀, binaryPredTime] using hreach + · exact ⟨hcell0, by + simpa [BinaryPred.ripple_succ_natBits_internal] using hstring⟩ + +theorem binaryPredTM_hoareTime_frame_internal + (idx : Fin n) (value : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hvalue : (work₀ idx).HasBinaryNat (value + 1)) + (hinp : inp₀.read ≠ Γ.start) + (hother : ∀ i, i ≠ idx → (work₀ i).read ≠ Γ.start) + (hout : out₀.read ≠ Γ.start) : + (binaryPredTM idx).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + (∀ i, i ≠ idx → work i = work₀ i) ∧ + (work idx).HasBinaryNat value ∧ + out = out₀) + (binaryPredTime value) := by + rintro inp work out ⟨hinput₀, hwork₀, houtput₀⟩ + obtain ⟨c', hreach, hhalt, hinput, hwork, hvalue', houtput⟩ := + binaryPredTM_reachesIn_frame_internal idx value inp₀ work₀ out₀ + hvalue hinp hother hout + refine ⟨c', binaryPredTime value, le_rfl, ?_, hhalt, + hinput, hwork, hvalue', houtput⟩ + simpa [hinput₀, hwork₀, houtput₀] using hreach + +theorem binaryPredTM_hoareTimeSpace_frame_internal + (idx : Fin n) (value inputLength initialSpace : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hvalue : (work₀ idx).HasBinaryNat (value + 1)) + (hinp : inp₀.read ≠ Γ.start) + (hother : ∀ i, i ≠ idx → (work₀ i).read ≠ Γ.start) + (hout : out₀.read ≠ Γ.start) + (hinitial : + ({ state := (binaryPredTM idx).qstart + input := inp₀ + work := work₀ + output := out₀ } : + Cfg n (binaryPredTM idx).Q).WithinAuxSpace inputLength initialSpace) : + (binaryPredTM idx).HoareTimeSpace + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + (∀ i, i ≠ idx → work i = work₀ i) ∧ + (work idx).HasBinaryNat value ∧ + out = out₀) + (binaryPredTime value) inputLength + (binaryPredSpace initialSpace value) := by + have htimeSpace := + (binaryPredTM_hoareTime_frame_internal idx value inp₀ work₀ out₀ + hvalue hinp hother hout).toHoareTimeSpace (by + rintro inp work out ⟨hinput₀, hwork₀, houtput₀⟩ + simpa [hinput₀, hwork₀, houtput₀] using hinitial) + refine htimeSpace.consequence (fun _ _ _ h => h) (fun _ _ _ h => h) + le_rfl le_rfl ?_ + have htime := binaryPredTime_le_internal value + simp only [binaryPredSpace] + omega + +theorem binaryPredTM_isTransducer_internal (idx : Fin n) : + (binaryPredTM idx).IsTransducer := by + intro phase iHead wHeads oHead + cases phase with + | borrow => + cases hread : wHeads idx <;> + simp [binaryPredTM, hread, idleDir] <;> + split <;> decide + | check => + cases hread : wHeads idx <;> + simp [binaryPredTM, hread, idleDir] <;> + split <;> decide + | erase => + simp only [binaryPredTM] + split <;> simp [idleDir] <;> split <;> decide + | rewind => + simp only [binaryPredTM] + split <;> simp [idleDir] <;> split <;> decide + | done => + simp [binaryPredTM, allIdle, idleDir] + split <;> decide + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleAdd.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleAdd.lean new file mode 100644 index 0000000000..c458a3525e --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleAdd.lean @@ -0,0 +1,164 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleAdd.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleAdd.Internal + +/-! +# Linear-time canonical binary addition + +This module exposes a concrete three-tape ripple-carry adder. It preserves two +canonical little-endian operands, writes their canonical sum to a fresh zero +result tape, restores every owned head to cell one, and preserves the complete +external tape frame. Its running time is linear in the operand bit widths. + +The older `TM.binaryAddIntoTM` remains useful as a value-iterating count-up +routine; complexity-sensitive RAM simulation should use this width-linear +machine instead. +-/ + + +public section + +namespace Complexity + +namespace BinaryRippleAdd + +/-- Ripple carry over canonical little-endian encodings computes addition. -/ +theorem ripple_natBits (lhs rhs : ℕ) : + ripple false lhs.bits rhs.bits = (lhs + rhs).bits := + ripple_natBits_internal lhs rhs + +end BinaryRippleAdd + +namespace TM + +/-- The scan bound is one more than the larger operand width. -/ +theorem binaryRippleAddScanTime_natBits (lhs rhs : ℕ) : + binaryRippleAddScanTime lhs.bits rhs.bits = + max lhs.size rhs.size + 1 := + binaryRippleAddScanTime_natBits_internal lhs rhs + +/-- Addition increases binary width by at most one over the larger operand. -/ +theorem binaryRippleAdd_sum_size_le (lhs rhs : ℕ) : + (lhs + rhs).size ≤ max lhs.size rhs.size + 1 := + size_add_le_max_add_one_internal lhs rhs + +/-- The complete scan-and-rewind machine has a linear bit-width envelope. -/ +theorem binaryRippleAddTime_le (lhs rhs : ℕ) : + binaryRippleAddTime lhs rhs ≤ + 3 * (lhs.size + rhs.size) + 14 := + binaryRippleAddTime_le_internal lhs rhs + +/-- Framed time contract for canonical addition. Both operands are restored, +the initially-zero result becomes their sum, and every unrelated tape is +preserved exactly. -/ +theorem binaryRippleAddTM_hoareTime_frame {n : ℕ} + (lhsIdx rhsIdx resultIdx : Fin n) + (hdistinct : BinaryRippleAddDistinct lhsIdx rhsIdx resultIdx) + (lhs rhs : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hlhs : (work₀ lhsIdx).HasBinaryNat lhs) + (hrhs : (work₀ rhsIdx).HasBinaryNat rhs) + (hresult : (work₀ resultIdx).HasBinaryNat 0) + (hinput : Parked inp₀) + (hother : ∀ i, i ≠ lhsIdx → i ≠ rhsIdx → i ≠ resultIdx → + Parked (work₀ i)) + (houtput : Parked out₀) : + (binaryRippleAddTM lhsIdx rhsIdx resultIdx).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + (work lhsIdx).HasBinaryNat lhs ∧ + (work rhsIdx).HasBinaryNat rhs ∧ + (work resultIdx).HasBinaryNat (lhs + rhs) ∧ + (∀ i, i ≠ lhsIdx → i ≠ rhsIdx → i ≠ resultIdx → + work i = work₀ i) ∧ + out = out₀) + (binaryRippleAddTime lhs rhs) := + binaryRippleAddTM_hoareTime_frame_internal lhsIdx rhsIdx resultIdx + hdistinct lhs rhs inp₀ work₀ out₀ hlhs hrhs hresult hinput hother + houtput + +/-- Reachability form of the framed addition theorem. -/ +theorem binaryRippleAddTM_reachesIn_frame {n : ℕ} + (lhsIdx rhsIdx resultIdx : Fin n) + (hdistinct : BinaryRippleAddDistinct lhsIdx rhsIdx resultIdx) + (lhs rhs : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hlhs : (work₀ lhsIdx).HasBinaryNat lhs) + (hrhs : (work₀ rhsIdx).HasBinaryNat rhs) + (hresult : (work₀ resultIdx).HasBinaryNat 0) + (hinput : Parked inp₀) + (hother : ∀ i, i ≠ lhsIdx → i ≠ rhsIdx → i ≠ resultIdx → + Parked (work₀ i)) + (houtput : Parked out₀) : + ∃ c' time, + time ≤ binaryRippleAddTime lhs rhs ∧ + (binaryRippleAddTM lhsIdx rhsIdx resultIdx).reachesIn time + { state := (binaryRippleAddTM lhsIdx rhsIdx resultIdx).qstart + input := inp₀ + work := work₀ + output := out₀ } c' ∧ + (binaryRippleAddTM lhsIdx rhsIdx resultIdx).halted c' ∧ + c'.input = inp₀ ∧ + (c'.work lhsIdx).HasBinaryNat lhs ∧ + (c'.work rhsIdx).HasBinaryNat rhs ∧ + (c'.work resultIdx).HasBinaryNat (lhs + rhs) ∧ + (∀ i, i ≠ lhsIdx → i ≠ rhsIdx → i ≠ resultIdx → + c'.work i = work₀ i) ∧ + c'.output = out₀ := by + exact binaryRippleAddTM_hoareTime_frame lhsIdx rhsIdx resultIdx hdistinct + lhs rhs inp₀ work₀ out₀ hlhs hrhs hresult hinput hother houtput + inp₀ work₀ out₀ ⟨rfl, rfl, rfl⟩ + +/-- All-prefix auxiliary-space contract obtained from the concrete linear +time bound. -/ +theorem binaryRippleAddTM_hoareTimeSpace_frame {n : ℕ} + (lhsIdx rhsIdx resultIdx : Fin n) + (hdistinct : BinaryRippleAddDistinct lhsIdx rhsIdx resultIdx) + (lhs rhs inputLength initialSpace : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hlhs : (work₀ lhsIdx).HasBinaryNat lhs) + (hrhs : (work₀ rhsIdx).HasBinaryNat rhs) + (hresult : (work₀ resultIdx).HasBinaryNat 0) + (hinput : Parked inp₀) + (hother : ∀ i, i ≠ lhsIdx → i ≠ rhsIdx → i ≠ resultIdx → + Parked (work₀ i)) + (houtput : Parked out₀) + (hinitial : + ({ state := (binaryRippleAddTM lhsIdx rhsIdx resultIdx).qstart + input := inp₀ + work := work₀ + output := out₀ } : + Cfg n (binaryRippleAddTM lhsIdx rhsIdx resultIdx).Q).WithinAuxSpace + inputLength initialSpace) : + (binaryRippleAddTM lhsIdx rhsIdx resultIdx).HoareTimeSpace + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + (work lhsIdx).HasBinaryNat lhs ∧ + (work rhsIdx).HasBinaryNat rhs ∧ + (work resultIdx).HasBinaryNat (lhs + rhs) ∧ + (∀ i, i ≠ lhsIdx → i ≠ rhsIdx → i ≠ resultIdx → + work i = work₀ i) ∧ + out = out₀) + (binaryRippleAddTime lhs rhs) inputLength + (initialSpace + binaryRippleAddTime lhs rhs) := + binaryRippleAddTM_hoareTimeSpace_frame_internal lhsIdx rhsIdx resultIdx + hdistinct lhs rhs inputLength initialSpace inp₀ work₀ out₀ hlhs hrhs + hresult hinput hother houtput hinitial + +/-- Canonical addition never moves the public output head left. -/ +theorem binaryRippleAddTM_isTransducer {n : ℕ} + (lhsIdx rhsIdx resultIdx : Fin n) : + (binaryRippleAddTM lhsIdx rhsIdx resultIdx).IsTransducer := + binaryRippleAddTM_isTransducer_internal lhsIdx rhsIdx resultIdx + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleAdd/Defs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleAdd/Defs.lean new file mode 100644 index 0000000000..aa0d9d6fb2 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleAdd/Defs.lean @@ -0,0 +1,164 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines +public import Mathlib.Data.Nat.Bits + +/-! +# Linear-time canonical binary addition -- definitions + +This module defines a finite-state ripple-carry scan over two preserved +little-endian binary work tapes. Each scan step appends one sum bit to a fresh +result tape. A composed wrapper then rewinds all three owned tapes. +-/ + + +@[expose] public section + +namespace Complexity + +namespace BinaryRippleAdd + +/-- The output bit of a one-column binary addition with incoming carry. -/ +def sumBit (carry lhs rhs : Bool) : Bool := + (lhs.xor rhs).xor carry + +/-- The outgoing carry of a one-column binary addition. -/ +def carryBit (carry lhs rhs : Bool) : Bool := + (lhs && rhs) || (carry && lhs) || (carry && rhs) + +/-- Ripple-carry addition on little-endian bit strings, padding a missing side +with zero and emitting a final high bit exactly when the carry remains set. -/ +def ripple : Bool → List Bool → List Bool → List Bool + | false, [], [] => [] + | true, [], [] => [true] + | carry, lhs :: lhsTail, [] => + sumBit carry lhs false :: ripple (carryBit carry lhs false) lhsTail [] + | carry, [], rhs :: rhsTail => + sumBit carry false rhs :: ripple (carryBit carry false rhs) [] rhsTail + | carry, lhs :: lhsTail, rhs :: rhsTail => + sumBit carry lhs rhs :: ripple (carryBit carry lhs rhs) lhsTail rhsTail + +end BinaryRippleAdd + +namespace TM + +/-- Carry-bearing scan states followed by the unique halt state. -/ +inductive BinaryRippleAddPhase where + | scan (carry : Bool) + | done + deriving DecidableEq + +/-- `BinaryRippleAddPhase` is finite, as required by the concrete machine model. -/ +instance instFintypeBinaryRippleAddPhase : Fintype BinaryRippleAddPhase where + elems := {.scan false, .scan true, .done} + complete := by + intro phase + cases phase with + | scan carry => cases carry <;> simp + | done => simp + +/-- Pairwise distinct work tapes used by the ripple-carry adder. -/ +structure BinaryRippleAddDistinct {n : ℕ} + (lhsIdx rhsIdx resultIdx : Fin n) : Prop where + lhs_rhs : lhsIdx ≠ rhsIdx + lhs_result : lhsIdx ≠ resultIdx + rhs_result : rhsIdx ≠ resultIdx + +/-- Scan two canonical little-endian operands and append their sum to a fresh +result tape. Operand cells are written back unchanged. An exhausted operand +stays on its first blank while the longer operand continues to advance. -/ +def binaryRippleAddScanTM {n : ℕ} + (lhsIdx rhsIdx resultIdx : Fin n) : TM n where + Q := BinaryRippleAddPhase + qstart := .scan false + qhalt := .done + δ := fun state iHead wHeads oHead => + match state with + | .scan carry => + if wHeads lhsIdx = Γ.blank ∧ wHeads rhsIdx = Γ.blank then + if carry then + (.done, + fun i => if i = resultIdx then Γw.one else readBackWrite (wHeads i), + readBackWrite oHead, + idleDir iHead, + fun i => if i = resultIdx then Dir3.right else idleDir (wHeads i), + idleDir oHead) + else + allReadBack .done iHead wHeads oHead + else + let lhsBit := decide (wHeads lhsIdx = Γ.one) + let rhsBit := decide (wHeads rhsIdx = Γ.one) + let sum := BinaryRippleAdd.sumBit carry lhsBit rhsBit + let nextCarry := BinaryRippleAdd.carryBit carry lhsBit rhsBit + (.scan nextCarry, + fun i => if i = resultIdx then Γw.ofBool sum else readBackWrite (wHeads i), + readBackWrite oHead, + idleDir iHead, + fun i => + if i = resultIdx then Dir3.right + else if i = lhsIdx then + if wHeads lhsIdx = Γ.blank then Dir3.stay else Dir3.right + else if i = rhsIdx then + if wHeads rhsIdx = Γ.blank then Dir3.stay else Dir3.right + else idleDir (wHeads i), + idleDir oHead) + | .done => allIdle .done iHead wHeads oHead + δ_right_of_start := by + intro state iHead wHeads oHead + cases state with + | scan carry => + dsimp only + split + · split + · refine ⟨idleDir_right_of_start, ?_, idleDir_right_of_start⟩ + intro i hi + dsimp only + by_cases hresult : i = resultIdx + · rw [if_pos hresult] + · rw [if_neg hresult] + exact idleDir_right_of_start hi + · exact rightOfStart_allReadBack iHead wHeads oHead + · refine ⟨idleDir_right_of_start, ?_, idleDir_right_of_start⟩ + intro i hi + dsimp only + by_cases hresult : i = resultIdx + · rw [if_pos hresult] + · rw [if_neg hresult] + by_cases hlhs : i = lhsIdx + · rw [if_pos hlhs] + subst i + simp [hi] + · rw [if_neg hlhs] + by_cases hrhs : i = rhsIdx + · rw [if_pos hrhs] + subst i + simp [hi] + · rw [if_neg hrhs] + exact idleDir_right_of_start hi + | done => exact rightOfStart_allIdle iHead wHeads oHead + +/-- Exact number of scan transitions, including the final simultaneous-blank +transition. -/ +def binaryRippleAddScanTime (lhs rhs : List Bool) : ℕ := + max lhs.length rhs.length + 1 + +/-- Scan the operands into a fresh result and then rewind both operands and the +result to cell one. -/ +def binaryRippleAddTM {n : ℕ} + (lhsIdx rhsIdx resultIdx : Fin n) : TM n := + seqTM (binaryRippleAddScanTM lhsIdx rhsIdx resultIdx) + (seqTM (rewindWorkTM lhsIdx) + (seqTM (rewindWorkTM rhsIdx) (rewindWorkTM resultIdx))) + +/-- Linear width bound for the scan, three rewinds, and three composition seams. -/ +def binaryRippleAddTime (lhs rhs : ℕ) : ℕ := + max lhs.size rhs.size + lhs.size + rhs.size + (lhs + rhs).size + 13 + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleAdd/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleAdd/Internal.lean new file mode 100644 index 0000000000..f274b72b60 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleAdd/Internal.lean @@ -0,0 +1,20 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleAdd.Internal.Bounds +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleAdd.Internal.Out +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleAdd.Internal.Pure +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleAdd.Internal.Rewind +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleAdd.Internal.Scan +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleAdd.Internal.Sem + +/-! +# Linear-time canonical binary addition -- proof internals + +This aggregation module collects the pure arithmetic, scan, rewind, resource, +and output-discipline proofs used by the public surface. +-/ diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleAdd/Internal/Bounds.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleAdd/Internal/Bounds.lean new file mode 100644 index 0000000000..15a7850a7f --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleAdd/Internal/Bounds.lean @@ -0,0 +1,49 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleAdd.Defs +public import Mathlib.Data.Nat.Size + +/-! +# Linear binary addition -- resource-bound internals + +This file relates the concrete scan and composed-machine bounds to the +standard binary widths of the two operands. +-/ + + +public section + +namespace Complexity + +namespace TM + +theorem size_add_le_max_add_one_internal (lhs rhs : ℕ) : + (lhs + rhs).size ≤ max lhs.size rhs.size + 1 := by + rw [Nat.size_le] + let width := max lhs.size rhs.size + have hlhs : lhs < 2 ^ width := by + exact lt_of_lt_of_le (Nat.lt_size_self lhs) + (Nat.pow_le_pow_right (by decide) (le_max_left _ _)) + have hrhs : rhs < 2 ^ width := by + exact lt_of_lt_of_le (Nat.lt_size_self rhs) + (Nat.pow_le_pow_right (by decide) (le_max_right _ _)) + have hsum : lhs + rhs < 2 ^ width + 2 ^ width := + Nat.add_lt_add hlhs hrhs + simpa [width, pow_succ, Nat.mul_comm, Nat.two_mul] using hsum + +theorem binaryRippleAddTime_le_internal (lhs rhs : ℕ) : + binaryRippleAddTime lhs rhs ≤ 3 * (lhs.size + rhs.size) + 14 := by + have hsum := size_add_le_max_add_one_internal lhs rhs + have hmax : max lhs.size rhs.size ≤ lhs.size + rhs.size := by + exact max_le (Nat.le_add_right _ _) (Nat.le_add_left _ _) + simp only [binaryRippleAddTime] + omega + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleAdd/Internal/Out.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleAdd/Internal/Out.lean new file mode 100644 index 0000000000..22191c7710 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleAdd/Internal/Out.lean @@ -0,0 +1,59 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleAdd.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.ClearWork.Internal + +/-! +# Linear-time canonical binary addition -- output discipline + +The scan and its rewind wrapper leave the public output tape one-way, so both +machines satisfy the transducer discipline required by space-bounded function +computation. +-/ + + +public section + +namespace Complexity + +namespace TM + +/-- The ripple-add scan never moves the public output head left. -/ +theorem binaryRippleAddScanTM_isTransducer_internal {n : ℕ} + (lhsIdx rhsIdx resultIdx : Fin n) : + (binaryRippleAddScanTM lhsIdx rhsIdx resultIdx).IsTransducer := by + intro phase iHead wHeads oHead + cases phase with + | scan carry => + simp only [binaryRippleAddScanTM] + split + · split + · simp only + simp [idleDir] + split <;> decide + · simp [allReadBack, idleDir] + split <;> decide + · simp only + simp [idleDir] + split <;> decide + | done => + simp [binaryRippleAddScanTM, allIdle, idleDir] + split <;> decide + +/-- The scan followed by all three rewinds remains a transducer. -/ +theorem binaryRippleAddTM_isTransducer_internal {n : ℕ} + (lhsIdx rhsIdx resultIdx : Fin n) : + (binaryRippleAddTM lhsIdx rhsIdx resultIdx).IsTransducer := by + exact (binaryRippleAddScanTM_isTransducer_internal lhsIdx rhsIdx resultIdx).seqTM + ((rewindWorkTM_isTransducer_internal lhsIdx).seqTM + ((rewindWorkTM_isTransducer_internal rhsIdx).seqTM + (rewindWorkTM_isTransducer_internal resultIdx))) + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleAdd/Internal/Pure.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleAdd/Internal/Pure.lean new file mode 100644 index 0000000000..e5a745f241 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleAdd/Internal/Pure.lean @@ -0,0 +1,184 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleAdd.Defs +public import Mathlib.Data.Nat.Size +public import Std.Tactic.BVDecide.Normalize.Bool + +/-! +# Linear-time canonical binary addition -- pure proofs + +This file proves that the finite full-adder recurrence computes addition on +canonical little-endian `Nat.bits`. The generalized theorem includes an +incoming carry so that its induction follows the recurrence exactly. +-/ + + +public section + +namespace Complexity + +namespace BinaryRippleAdd + +private theorem ripple_nil_cons (carry rhsBit : Bool) + (rhs : List Bool) : + ripple carry [] (rhsBit :: rhs) = + sumBit carry false rhsBit :: + ripple (carryBit carry false rhsBit) [] rhs := by + cases carry <;> simp [ripple] + +private theorem ripple_cons_nil (carry lhsBit : Bool) + (lhs : List Bool) : + ripple carry (lhsBit :: lhs) [] = + sumBit carry lhsBit false :: + ripple (carryBit carry lhsBit false) lhs [] := by + cases carry <;> simp [ripple] + +private theorem ripple_cons_cons (carry lhsBit rhsBit : Bool) + (lhs rhs : List Bool) : + ripple carry (lhsBit :: lhs) (rhsBit :: rhs) = + sumBit carry lhsBit rhsBit :: + ripple (carryBit carry lhsBit rhsBit) lhs rhs := by + cases carry <;> simp [ripple] + +private theorem fullAdder_value (carry lhsBit rhsBit : Bool) (lhs rhs : ℕ) : + Nat.bit lhsBit lhs + Nat.bit rhsBit rhs + (if carry then 1 else 0) = + Nat.bit (sumBit carry lhsBit rhsBit) + (lhs + rhs + (if carryBit carry lhsBit rhsBit then 1 else 0)) := by + cases carry <;> cases lhsBit <;> cases rhsBit <;> + simp [sumBit, carryBit, Nat.bit] <;> omega + +private theorem fullAdder_valid (carry lhsBit rhsBit : Bool) (lhs rhs : ℕ) + (hvalue : Nat.bit lhsBit lhs + Nat.bit rhsBit rhs + + (if carry then 1 else 0) ≠ 0) : + lhs + rhs + (if carryBit carry lhsBit rhsBit then 1 else 0) = 0 → + sumBit carry lhsBit rhsBit = true := by + apply Nat.bit_ne_zero_iff.mp + rw [← fullAdder_value] + exact hvalue + +/-- Ripple addition with an incoming carry computes the corresponding natural +sum. This is the induction-strengthened form of `ripple_natBits_internal`. -/ +theorem ripple_natBits_carry_internal (carry : Bool) (lhs rhs : ℕ) : + ripple carry lhs.bits rhs.bits = + (lhs + rhs + (if carry then 1 else 0)).bits := by + induction lhs using Nat.binaryRec' generalizing rhs carry with + | zero => + simp only [Nat.zero_bits, Nat.zero_add] + induction rhs using Nat.binaryRec' generalizing carry with + | zero => + cases carry <;> simp [ripple] + | bit rhsBit rhs hrhs ih => + have hrhsValue : Nat.bit rhsBit rhs ≠ 0 := + Nat.bit_ne_zero_iff.mpr hrhs + have htotal : Nat.bit false 0 + Nat.bit rhsBit rhs + + (if carry then 1 else 0) ≠ 0 := by + omega + have hvalid := fullAdder_valid carry false rhsBit 0 rhs htotal + have hvalid' : + rhs + (if carryBit carry false rhsBit then 1 else 0) = 0 → + sumBit carry false rhsBit = true := by + simpa using hvalid + have hadd : Nat.bit rhsBit rhs + (if carry then 1 else 0) = + Nat.bit (sumBit carry false rhsBit) + (rhs + (if carryBit carry false rhsBit then 1 else 0)) := by + simpa using fullAdder_value carry false rhsBit 0 rhs + calc + ripple carry [] (Nat.bit rhsBit rhs).bits = + sumBit carry false rhsBit :: + ripple (carryBit carry false rhsBit) [] rhs.bits := by + rw [Nat.bits_append_bit rhs rhsBit hrhs] + exact ripple_nil_cons carry rhsBit rhs.bits + _ = sumBit carry false rhsBit :: + (rhs + (if carryBit carry false rhsBit then 1 else 0)).bits := by + rw [ih] + _ = (Nat.bit (sumBit carry false rhsBit) + (rhs + (if carryBit carry false rhsBit then 1 else 0))).bits := by + exact (Nat.bits_append_bit _ _ hvalid').symm + _ = (Nat.bit rhsBit rhs + (if carry then 1 else 0)).bits := by + rw [hadd] + | bit lhsBit lhs hlhs ih => + induction rhs using Nat.binaryRec' generalizing carry with + | zero => + have hlhsValue : Nat.bit lhsBit lhs ≠ 0 := + Nat.bit_ne_zero_iff.mpr hlhs + have htotal : Nat.bit lhsBit lhs + Nat.bit false 0 + + (if carry then 1 else 0) ≠ 0 := by + omega + have hvalid := fullAdder_valid carry lhsBit false lhs 0 htotal + have hvalid' : + lhs + (if carryBit carry lhsBit false then 1 else 0) = 0 → + sumBit carry lhsBit false = true := by + simpa using hvalid + have hadd : Nat.bit lhsBit lhs + (if carry then 1 else 0) = + Nat.bit (sumBit carry lhsBit false) + (lhs + (if carryBit carry lhsBit false then 1 else 0)) := by + simpa using fullAdder_value carry lhsBit false lhs 0 + calc + ripple carry (Nat.bit lhsBit lhs).bits [] = + sumBit carry lhsBit false :: + ripple (carryBit carry lhsBit false) lhs.bits [] := by + rw [Nat.bits_append_bit lhs lhsBit hlhs] + exact ripple_cons_nil carry lhsBit lhs.bits + _ = sumBit carry lhsBit false :: + (lhs + (if carryBit carry lhsBit false then 1 else 0)).bits := by + simpa using congrArg (List.cons (sumBit carry lhsBit false)) + (ih (carryBit carry lhsBit false) 0) + _ = (Nat.bit (sumBit carry lhsBit false) + (lhs + (if carryBit carry lhsBit false then 1 else 0))).bits := by + exact (Nat.bits_append_bit _ _ hvalid').symm + _ = (Nat.bit lhsBit lhs + (if carry then 1 else 0)).bits := by + rw [hadd] + | bit rhsBit rhs hrhs _ => + have hlhsValue : Nat.bit lhsBit lhs ≠ 0 := + Nat.bit_ne_zero_iff.mpr hlhs + have htotal : Nat.bit lhsBit lhs + Nat.bit rhsBit rhs + + (if carry then 1 else 0) ≠ 0 := by + omega + have hvalid := fullAdder_valid carry lhsBit rhsBit lhs rhs htotal + have hadd := fullAdder_value carry lhsBit rhsBit lhs rhs + calc + ripple carry (Nat.bit lhsBit lhs).bits (Nat.bit rhsBit rhs).bits = + sumBit carry lhsBit rhsBit :: + ripple (carryBit carry lhsBit rhsBit) lhs.bits rhs.bits := by + rw [Nat.bits_append_bit lhs lhsBit hlhs, + Nat.bits_append_bit rhs rhsBit hrhs] + exact ripple_cons_cons carry lhsBit rhsBit lhs.bits rhs.bits + _ = sumBit carry lhsBit rhsBit :: + (lhs + rhs + + (if carryBit carry lhsBit rhsBit then 1 else 0)).bits := by + rw [ih] + _ = (Nat.bit (sumBit carry lhsBit rhsBit) + (lhs + rhs + + (if carryBit carry lhsBit rhsBit then 1 else 0))).bits := by + exact (Nat.bits_append_bit _ _ hvalid).symm + _ = (Nat.bit lhsBit lhs + Nat.bit rhsBit rhs + + (if carry then 1 else 0)).bits := by + rw [hadd] + +/-- Ripple addition without an incoming carry computes canonical addition. -/ +theorem ripple_natBits_internal (lhs rhs : ℕ) : + ripple false lhs.bits rhs.bits = (lhs + rhs).bits := by + simpa using ripple_natBits_carry_internal false lhs rhs + +/-- The pure result has exactly the canonical width of the sum. -/ +theorem length_ripple_natBits_internal (lhs rhs : ℕ) : + (ripple false lhs.bits rhs.bits).length = (lhs + rhs).size := by + rw [ripple_natBits_internal, Nat.size_eq_bits_len] + +end BinaryRippleAdd + +namespace TM + +/-- Rewrite the list-level scan bound as a bound in natural-number widths. -/ +theorem binaryRippleAddScanTime_natBits_internal (lhs rhs : ℕ) : + binaryRippleAddScanTime lhs.bits rhs.bits = max lhs.size rhs.size + 1 := by + simp [binaryRippleAddScanTime, Nat.size_eq_bits_len] + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleAdd/Internal/Rewind.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleAdd/Internal/Rewind.lean new file mode 100644 index 0000000000..87e2e614a3 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleAdd/Internal/Rewind.lean @@ -0,0 +1,219 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleAdd.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.ResetBinary.Internal + +/-! +# Linear-time canonical binary addition -- rewind proof internals + +This module packages the three-rewind tail of `binaryRippleAddTM` into one +framed Hoare-time contract. +-/ + + +@[expose] public section + +namespace Complexity + +namespace TM + +/-- Canonical parked tape containing the supplied little-endian binary digits. -/ +def binaryRippleAddCanonicalTape (bits : List Bool) : Tape := + (Tape.init (bits.map Γ.ofBool)).move Dir3.right + +private theorem binaryRippleAddCanonicalTape_parked (bits : List Bool) : + Parked (binaryRippleAddCanonicalTape bits) := by + refine ⟨by simp [binaryRippleAddCanonicalTape, Tape.move], ?_⟩ + simpa [binaryRippleAddCanonicalTape] using + Tape.init_ofBool_move_right_cells_ne_start bits + +private theorem binaryRippleAddRewindExact_hoareTime {n : ℕ} + (idx : Fin n) (bits : List Bool) (headBound : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (htarget : (work₀ idx).HasBinaryContent bits) + (htargetStart : (work₀ idx).cells 0 = Γ.start) + (htargetHead : 1 ≤ (work₀ idx).head ∧ (work₀ idx).head ≤ headBound) + (hinput : Parked inp₀) + (hother : ∀ i, i ≠ idx → Parked (work₀ i)) + (houtput : Parked out₀) : + (rewindWorkTM idx).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + work = Function.update work₀ idx (binaryRippleAddCanonicalTape bits) ∧ + out = out₀) + (headBound + 2) := by + have hrewind := rewindBinaryWorkTM_hoareTime_frame_internal idx bits + headBound inp₀ work₀ out₀ htarget htargetStart htargetHead hinput + hother houtput + apply hrewind.consequence (b' := headBound + 2) + · intro _inp _work _out hpre + exact hpre + · rintro inp work out ⟨hinp, htargetEq, hotherEq, hout⟩ + refine ⟨hinp, ?_, hout⟩ + funext i + by_cases hi : i = idx + · subst i + rw [Function.update_self] + simpa [binaryRippleAddCanonicalTape] using htargetEq + · rw [Function.update_of_ne hi] + exact hotherEq i hi + · exact le_rfl + +private theorem binaryRippleAddExactFrame_transition {n : ℕ} + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hinput : Parked inp₀) (hwork : ∀ i, Parked (work₀ i)) + (houtput : Parked out₀) : + ∀ inp work out, + (inp = inp₀ ∧ work = work₀ ∧ out = out₀) → + transitionInput inp = inp₀ ∧ + (fun i => transitionTape (work i)) = work₀ ∧ + transitionTape out = out₀ := by + rintro _inp _work _out ⟨rfl, rfl, rfl⟩ + exact ⟨hinput.transitionInput_eq_self, + funext fun i => (hwork i).transitionTape_eq_self, + houtput.transitionTape_eq_self⟩ + +theorem binaryRippleAddRewindTM_hoareTime_frame_internal {n : ℕ} + (lhsIdx rhsIdx resultIdx : Fin n) + (hdistinct : BinaryRippleAddDistinct lhsIdx rhsIdx resultIdx) + (lhsBits rhsBits resultBits : List Bool) + (lhsBound rhsBound resultBound : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hlhs : (work₀ lhsIdx).HasBinaryContent lhsBits) + (hlhsStart : (work₀ lhsIdx).cells 0 = Γ.start) + (hlhsHead : 1 ≤ (work₀ lhsIdx).head ∧ + (work₀ lhsIdx).head ≤ lhsBound) + (hrhs : (work₀ rhsIdx).HasBinaryContent rhsBits) + (hrhsStart : (work₀ rhsIdx).cells 0 = Γ.start) + (hrhsHead : 1 ≤ (work₀ rhsIdx).head ∧ + (work₀ rhsIdx).head ≤ rhsBound) + (hresult : (work₀ resultIdx).HasBinaryContent resultBits) + (hresultStart : (work₀ resultIdx).cells 0 = Γ.start) + (hresultHead : 1 ≤ (work₀ resultIdx).head ∧ + (work₀ resultIdx).head ≤ resultBound) + (hinput : Parked inp₀) + (hother : ∀ i, i ≠ lhsIdx → i ≠ rhsIdx → i ≠ resultIdx → + Parked (work₀ i)) + (houtput : Parked out₀) : + (seqTM (rewindWorkTM lhsIdx) + (seqTM (rewindWorkTM rhsIdx) (rewindWorkTM resultIdx))).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + work lhsIdx = binaryRippleAddCanonicalTape lhsBits ∧ + work rhsIdx = binaryRippleAddCanonicalTape rhsBits ∧ + work resultIdx = binaryRippleAddCanonicalTape resultBits ∧ + (∀ i, i ≠ lhsIdx → i ≠ rhsIdx → i ≠ resultIdx → + work i = work₀ i) ∧ + out = out₀) + (lhsBound + rhsBound + resultBound + 8) := by + have hlhsParked : Parked (work₀ lhsIdx) := + ⟨hlhsHead.1, hlhs.cells_ne_start⟩ + have hrhsParked : Parked (work₀ rhsIdx) := + ⟨hrhsHead.1, hrhs.cells_ne_start⟩ + have hresultParked : Parked (work₀ resultIdx) := + ⟨hresultHead.1, hresult.cells_ne_start⟩ + have hwork₀ : ∀ i, Parked (work₀ i) := by + intro i + by_cases hlhsIdx : i = lhsIdx + · subst i + exact hlhsParked + by_cases hrhsIdx : i = rhsIdx + · subst i + exact hrhsParked + by_cases hresultIdx : i = resultIdx + · subst i + exact hresultParked + exact hother i hlhsIdx hrhsIdx hresultIdx + + let lhsTape := binaryRippleAddCanonicalTape lhsBits + let rhsTape := binaryRippleAddCanonicalTape rhsBits + let resultTape := binaryRippleAddCanonicalTape resultBits + let work₁ := Function.update work₀ lhsIdx lhsTape + let work₂ := Function.update work₁ rhsIdx rhsTape + let work₃ := Function.update work₂ resultIdx resultTape + + have hwork₁ : ∀ i, Parked (work₁ i) := by + intro i + by_cases hi : i = lhsIdx + · subst i + simpa [work₁, lhsTape] using + binaryRippleAddCanonicalTape_parked lhsBits + · simpa only [work₁, Function.update_of_ne hi] using hwork₀ i + have hwork₂ : ∀ i, Parked (work₂ i) := by + intro i + by_cases hi : i = rhsIdx + · subst i + simpa [work₂, rhsTape] using + binaryRippleAddCanonicalTape_parked rhsBits + · simpa only [work₂, Function.update_of_ne hi] using hwork₁ i + + have hrhs₁ : (work₁ rhsIdx).HasBinaryContent rhsBits := by + simpa only [work₁, Function.update_of_ne hdistinct.lhs_rhs.symm] using hrhs + have hrhsStart₁ : (work₁ rhsIdx).cells 0 = Γ.start := by + simpa only [work₁, Function.update_of_ne hdistinct.lhs_rhs.symm] using hrhsStart + have hrhsHead₁ : 1 ≤ (work₁ rhsIdx).head ∧ + (work₁ rhsIdx).head ≤ rhsBound := by + simpa only [work₁, Function.update_of_ne hdistinct.lhs_rhs.symm] using hrhsHead + + have hresult₂ : (work₂ resultIdx).HasBinaryContent resultBits := by + simpa only [work₂, Function.update_of_ne hdistinct.rhs_result.symm, + work₁, Function.update_of_ne hdistinct.lhs_result.symm] using hresult + have hresultStart₂ : (work₂ resultIdx).cells 0 = Γ.start := by + simpa only [work₂, Function.update_of_ne hdistinct.rhs_result.symm, + work₁, Function.update_of_ne hdistinct.lhs_result.symm] using hresultStart + have hresultHead₂ : 1 ≤ (work₂ resultIdx).head ∧ + (work₂ resultIdx).head ≤ resultBound := by + simpa only [work₂, Function.update_of_ne hdistinct.rhs_result.symm, + work₁, Function.update_of_ne hdistinct.lhs_result.symm] using hresultHead + + have hrewindLhs := binaryRippleAddRewindExact_hoareTime lhsIdx lhsBits + lhsBound inp₀ work₀ out₀ hlhs hlhsStart hlhsHead hinput + (fun i _ => hwork₀ i) houtput + have hrewindRhs := binaryRippleAddRewindExact_hoareTime rhsIdx rhsBits + rhsBound inp₀ work₁ out₀ hrhs₁ hrhsStart₁ hrhsHead₁ hinput + (fun i _ => hwork₁ i) houtput + have hrewindResult := binaryRippleAddRewindExact_hoareTime resultIdx + resultBits resultBound inp₀ work₂ out₀ hresult₂ hresultStart₂ + hresultHead₂ hinput (fun i _ => hwork₂ i) houtput + + have htail := seqTM_hoareTime (rewindWorkTM rhsIdx) + (rewindWorkTM resultIdx) hrewindRhs + (binaryRippleAddExactFrame_transition inp₀ work₂ out₀ hinput + hwork₂ houtput) + hrewindResult + have hrun := seqTM_hoareTime (rewindWorkTM lhsIdx) + (seqTM (rewindWorkTM rhsIdx) (rewindWorkTM resultIdx)) hrewindLhs + (binaryRippleAddExactFrame_transition inp₀ work₁ out₀ hinput + hwork₁ houtput) + htail + apply hrun.consequence (b' := lhsBound + rhsBound + resultBound + 8) + · intro _inp _work _out hpre + exact hpre + · rintro inp work out ⟨hinp, hworkEq, hout⟩ + refine ⟨hinp, ?_, ?_, ?_, ?_, hout⟩ + · rw [hworkEq] + simp only [Function.update_of_ne hdistinct.lhs_result, + work₂, Function.update_of_ne hdistinct.lhs_rhs, + work₁, Function.update_self, lhsTape] + · rw [hworkEq] + simp only [Function.update_of_ne hdistinct.rhs_result, + work₂, Function.update_self, rhsTape] + · rw [hworkEq] + simp only [Function.update_self] + · intro i hlhsIdx hrhsIdx hresultIdx + rw [hworkEq] + simp only [Function.update_of_ne hresultIdx, + work₂, Function.update_of_ne hrhsIdx, + work₁, Function.update_of_ne hlhsIdx] + · omega + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleAdd/Internal/Scan.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleAdd/Internal/Scan.lean new file mode 100644 index 0000000000..59074a847c --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleAdd/Internal/Scan.lean @@ -0,0 +1,578 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleAdd.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.Internal.Generic +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Tape.Encoding + +/-! +# Linear-time canonical binary addition -- scan proof + +This file proves the exact operational contract for the carry-bearing forward +scan. Rewinding and the complete canonical-natural interface are composed in +later internal layers. +-/ + + +public section + +namespace Complexity + +namespace TM + +private def binaryRippleAddScanAdvanceWork {n : ℕ} + (lhsIdx rhsIdx resultIdx : Fin n) (sum : Bool) + (work : Fin n → Tape) : Fin n → Tape := + fun i => + if i = resultIdx then + (work i).writeAndMove (Γw.ofBool sum) Dir3.right + else if i = lhsIdx then + if (work lhsIdx).read = Γ.blank then work i + else (work i).move Dir3.right + else if i = rhsIdx then + if (work rhsIdx).read = Γ.blank then work i + else (work i).move Dir3.right + else work i + +private theorem writeAndMove_readBack_right {tape : Tape} + (hread : tape.read ≠ Γ.start) : + tape.writeAndMove (readBackWrite tape.read) Dir3.right = + tape.move Dir3.right := by + cases tape with + | mk head cells => + simp only [Tape.writeAndMove, Tape.read] at hread ⊢ + rw [toΓ_readBackWrite_of_ne_start hread] + simp [Tape.write, Tape.move, Function.update_eq_self] + +private theorem writeAndMove_readBack_stay {tape : Tape} + (hread : tape.read ≠ Γ.start) : + tape.writeAndMove (readBackWrite tape.read) Dir3.stay = tape := by + rw [toΓ_readBackWrite_of_ne_start hread] + simp only [Tape.writeAndMove, Tape.move, Tape.write] + split + · rfl + · simp only [Tape.read, Function.update_eq_self] + +private theorem binaryRippleAddScanTM_step_active {n : ℕ} + (lhsIdx rhsIdx resultIdx : Fin n) + (carry : Bool) (inp : Tape) (work : Fin n → Tape) (out : Tape) + (hactive : ¬((work lhsIdx).read = Γ.blank ∧ + (work rhsIdx).read = Γ.blank)) + (hinput : inp.read ≠ Γ.start) + (hlhs : (work lhsIdx).read ≠ Γ.start) + (hrhs : (work rhsIdx).read ≠ Γ.start) + (hother : ∀ i, i ≠ lhsIdx → i ≠ rhsIdx → i ≠ resultIdx → + (work i).read ≠ Γ.start) + (houtput : out.read ≠ Γ.start) : + let lhsBit := decide ((work lhsIdx).read = Γ.one) + let rhsBit := decide ((work rhsIdx).read = Γ.one) + let sum := BinaryRippleAdd.sumBit carry lhsBit rhsBit + let nextCarry := BinaryRippleAdd.carryBit carry lhsBit rhsBit + (binaryRippleAddScanTM lhsIdx rhsIdx resultIdx).step + { state := .scan carry, input := inp, work := work, output := out } = + some + { state := .scan nextCarry + input := inp + work := binaryRippleAddScanAdvanceWork lhsIdx rhsIdx resultIdx sum work + output := out } := by + dsimp only + rw [TM.step, if_neg (by simp [binaryRippleAddScanTM])] + simp only [binaryRippleAddScanTM, hactive, ↓reduceIte] + refine congrArg some (Cfg.ext rfl (transitionInput_eq_self hinput) ?_ + (transitionTape_eq_self houtput)) + funext i + by_cases hresultIdx : i = resultIdx + · subst i + simp [binaryRippleAddScanAdvanceWork] + · by_cases hlhsIdx : i = lhsIdx + · subst i + simp only [binaryRippleAddScanAdvanceWork, hresultIdx, if_false, + if_pos] + by_cases hblank : (work lhsIdx).read = Γ.blank + · rw [if_pos hblank, if_pos hblank] + simpa [hblank] using + writeAndMove_readBack_stay (show (work lhsIdx).read ≠ Γ.start from hlhs) + · rw [if_neg hblank, if_neg hblank] + exact writeAndMove_readBack_right hlhs + · by_cases hrhsIdx : i = rhsIdx + · subst i + simp only [binaryRippleAddScanAdvanceWork, hresultIdx, if_false, + hlhsIdx, if_pos] + by_cases hblank : (work rhsIdx).read = Γ.blank + · rw [if_pos hblank, if_pos hblank] + simpa [hblank] using + writeAndMove_readBack_stay (show (work rhsIdx).read ≠ Γ.start from hrhs) + · rw [if_neg hblank, if_neg hblank] + exact writeAndMove_readBack_right hrhs + · simp only [binaryRippleAddScanAdvanceWork, hresultIdx, if_false, + hlhsIdx, hrhsIdx] + exact transitionTape_eq_self (hother i hlhsIdx hrhsIdx hresultIdx) + +private theorem binaryRippleAddScanTM_step_terminal {n : ℕ} + (lhsIdx rhsIdx resultIdx : Fin n) + (hdistinct : BinaryRippleAddDistinct lhsIdx rhsIdx resultIdx) + (carry : Bool) (emitted : List Bool) + (inp : Tape) (work : Fin n → Tape) (out : Tape) + (hlhs : (work lhsIdx).read = Γ.blank) + (hrhs : (work rhsIdx).read = Γ.blank) + (hinput : inp.read ≠ Γ.start) + (hresult : (work resultIdx).HasBinaryPrefix emitted) + (hresultStart : (work resultIdx).cells 0 = Γ.start) + (hother : ∀ i, i ≠ lhsIdx → i ≠ rhsIdx → i ≠ resultIdx → + (work i).read ≠ Γ.start) + (houtput : out.read ≠ Γ.start) : + ∃ finalWork, + (binaryRippleAddScanTM lhsIdx rhsIdx resultIdx).step + { state := .scan carry, input := inp, work := work, output := out } = + some { state := .done, input := inp, work := finalWork, output := out } ∧ + (finalWork lhsIdx).cells = (work lhsIdx).cells ∧ + (finalWork lhsIdx).head = (work lhsIdx).head ∧ + (finalWork rhsIdx).cells = (work rhsIdx).cells ∧ + (finalWork rhsIdx).head = (work rhsIdx).head ∧ + (finalWork resultIdx).HasBinaryPrefix + (emitted ++ BinaryRippleAdd.ripple carry [] []) ∧ + (finalWork resultIdx).cells 0 = Γ.start ∧ + (∀ i, i ≠ lhsIdx → i ≠ rhsIdx → i ≠ resultIdx → + finalWork i = work i) := by + cases carry with + | false => + refine ⟨work, ?_, rfl, rfl, rfl, rfl, ?_, hresultStart, ?_⟩ + · rw [TM.step, if_neg (by simp [binaryRippleAddScanTM])] + simp only [binaryRippleAddScanTM, hlhs, hrhs, and_self, if_pos, + Bool.false_eq_true, if_false, allReadBack] + refine congrArg some (Cfg.ext rfl (transitionInput_eq_self hinput) ?_ + (transitionTape_eq_self houtput)) + funext i + by_cases hil : i = lhsIdx + · subst i + exact transitionTape_eq_self (by rw [hlhs]; decide) + · by_cases hir : i = rhsIdx + · subst i + exact transitionTape_eq_self (by rw [hrhs]; decide) + · by_cases hires : i = resultIdx + · subst i + exact transitionTape_eq_self (by + rw [hresult.read_blank] + decide) + · exact transitionTape_eq_self (hother i hil hir hires) + · simpa [BinaryRippleAdd.ripple] using hresult + · intro i _ _ _ + rfl + | true => + let finalWork := Function.update work resultIdx + ((work resultIdx).writeAndMove Γ.one Dir3.right) + refine ⟨finalWork, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_⟩ + · rw [TM.step, if_neg (by simp [binaryRippleAddScanTM])] + simp only [binaryRippleAddScanTM, hlhs, hrhs, and_self, if_pos] + refine congrArg some (Cfg.ext rfl (transitionInput_eq_self hinput) ?_ + (transitionTape_eq_self houtput)) + funext i + by_cases hires : i = resultIdx + · subst i + simp [finalWork] + · by_cases hil : i = lhsIdx + · subst i + simpa [finalWork, hdistinct.lhs_result] using + transitionTape_eq_self (by rw [hlhs]; decide) + · by_cases hir : i = rhsIdx + · subst i + simpa [finalWork, hdistinct.rhs_result] using + transitionTape_eq_self (by rw [hrhs]; decide) + · simpa [finalWork, hires] using + transitionTape_eq_self (hother i hil hir hires) + · simp [finalWork, hdistinct.lhs_result] + · simp [finalWork, hdistinct.lhs_result] + · simp [finalWork, hdistinct.rhs_result] + · simp [finalWork, hdistinct.rhs_result] + · simpa [finalWork, BinaryRippleAdd.ripple] using + Tape.hasBinaryPrefix_write_bit true hresult + · simpa [finalWork] using + Tape.hasBinaryPrefix_write_bit_cell0 true hresult hresultStart + · intro i _ _ hires + simp [finalWork, hires] + +private theorem binaryRippleAddScanTM_suffix_reachesIn {n : ℕ} + (lhsIdx rhsIdx resultIdx : Fin n) + (hdistinct : BinaryRippleAddDistinct lhsIdx rhsIdx resultIdx) + (carry : Bool) (lhs rhs emitted : List Bool) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hlhs : (work₀ lhsIdx).HasBinarySuffix lhs) + (hrhs : (work₀ rhsIdx).HasBinarySuffix rhs) + (hresult : (work₀ resultIdx).HasBinaryPrefix emitted) + (hresultStart : (work₀ resultIdx).cells 0 = Γ.start) + (hinput : inp₀.read ≠ Γ.start) + (hother : ∀ i, i ≠ lhsIdx → i ≠ rhsIdx → i ≠ resultIdx → + (work₀ i).read ≠ Γ.start) + (houtput : out₀.read ≠ Γ.start) : + ∃ c', + (binaryRippleAddScanTM lhsIdx rhsIdx resultIdx).reachesIn + (binaryRippleAddScanTime lhs rhs) + { state := .scan carry, input := inp₀, work := work₀, output := out₀ } c' ∧ + (binaryRippleAddScanTM lhsIdx rhsIdx resultIdx).halted c' ∧ + c'.input = inp₀ ∧ + (c'.work lhsIdx).cells = (work₀ lhsIdx).cells ∧ + (c'.work lhsIdx).head = (work₀ lhsIdx).head + lhs.length ∧ + (c'.work rhsIdx).cells = (work₀ rhsIdx).cells ∧ + (c'.work rhsIdx).head = (work₀ rhsIdx).head + rhs.length ∧ + (c'.work resultIdx).HasBinaryPrefix + (emitted ++ BinaryRippleAdd.ripple carry lhs rhs) ∧ + (c'.work resultIdx).cells 0 = Γ.start ∧ + (∀ i, i ≠ lhsIdx → i ≠ rhsIdx → i ≠ resultIdx → + c'.work i = work₀ i) ∧ + c'.output = out₀ := by + induction hlength : lhs.length + rhs.length using Nat.strong_induction_on + generalizing lhs rhs carry emitted inp₀ work₀ out₀ with + | h total ih => + cases lhs with + | nil => + cases rhs with + | nil => + obtain ⟨finalWork, hstep, hfinalLhs, hfinalLhsHead, hfinalRhs, + hfinalRhsHead, hfinalResult, hfinalResultStart, hfinalOther⟩ := + binaryRippleAddScanTM_step_terminal lhsIdx rhsIdx resultIdx + hdistinct carry emitted inp₀ work₀ out₀ hlhs.read_nil + hrhs.read_nil hinput hresult hresultStart hother houtput + let c' : Cfg n BinaryRippleAddPhase := + { state := .done, input := inp₀, work := finalWork, output := out₀ } + refine ⟨c', ?_, rfl, rfl, hfinalLhs, ?_, hfinalRhs, ?_, + hfinalResult, hfinalResultStart, hfinalOther, rfl⟩ + · have hreach : + (binaryRippleAddScanTM lhsIdx rhsIdx resultIdx).reachesIn 1 + { state := .scan carry, input := inp₀, work := work₀, + output := out₀ } c' := + .step hstep .zero + simpa [binaryRippleAddScanTime] using hreach + · simpa using hfinalLhsHead + · simpa using hfinalRhsHead + | cons rhsBit rhsTail => + have hlhsBit : decide ((work₀ lhsIdx).read = Γ.one) = false := by + rw [hlhs.read_nil] + decide + have hrhsBit : decide ((work₀ rhsIdx).read = Γ.one) = rhsBit := by + rw [hrhs.read_cons] + cases rhsBit <;> rfl + let sum := BinaryRippleAdd.sumBit carry false rhsBit + let nextCarry := BinaryRippleAdd.carryBit carry false rhsBit + let work₁ := binaryRippleAddScanAdvanceWork lhsIdx rhsIdx resultIdx + sum work₀ + have hactive : ¬((work₀ lhsIdx).read = Γ.blank ∧ + (work₀ rhsIdx).read = Γ.blank) := by + intro hblank + rw [hrhs.read_cons] at hblank + cases rhsBit <;> simp [Γ.ofBool] at hblank + have hrhsNotBlank : (work₀ rhsIdx).read ≠ Γ.blank := by + rw [hrhs.read_cons] + cases rhsBit <;> decide + have hstep : + (binaryRippleAddScanTM lhsIdx rhsIdx resultIdx).step + { state := .scan carry, input := inp₀, work := work₀, + output := out₀ } = + some + { state := .scan nextCarry + input := inp₀ + work := work₁ + output := out₀ } := by + simpa [hlhsBit, hrhsBit, sum, nextCarry, work₁] using + binaryRippleAddScanTM_step_active lhsIdx rhsIdx resultIdx carry + inp₀ work₀ out₀ hactive hinput hlhs.read_ne_start + hrhs.read_ne_start hother houtput + have hlhs₁ : (work₁ lhsIdx).HasBinarySuffix [] := by + simpa [work₁, binaryRippleAddScanAdvanceWork, + hdistinct.lhs_result, hlhs.read_nil] using hlhs + have hrhs₁ : (work₁ rhsIdx).HasBinarySuffix rhsTail := by + simpa [work₁, binaryRippleAddScanAdvanceWork, + hdistinct.rhs_result, Ne.symm hdistinct.lhs_rhs, + hrhsNotBlank] using hrhs.move_right_cons + have hresult₁ : + (work₁ resultIdx).HasBinaryPrefix (emitted ++ [sum]) := by + rw [show work₁ resultIdx = + (work₀ resultIdx).writeAndMove (Γw.ofBool sum).toΓ + Dir3.right by + simp [work₁, binaryRippleAddScanAdvanceWork]] + rw [Γw.ofBool_toΓ] + exact Tape.hasBinaryPrefix_write_bit sum hresult + have hresultStart₁ : (work₁ resultIdx).cells 0 = Γ.start := by + rw [show work₁ resultIdx = + (work₀ resultIdx).writeAndMove (Γw.ofBool sum).toΓ + Dir3.right by + simp [work₁, binaryRippleAddScanAdvanceWork]] + rw [Γw.ofBool_toΓ] + exact Tape.hasBinaryPrefix_write_bit_cell0 sum hresult hresultStart + have hother₁ : ∀ i, i ≠ lhsIdx → i ≠ rhsIdx → i ≠ resultIdx → + (work₁ i).read ≠ Γ.start := by + intro i hil hir hires + simpa [work₁, binaryRippleAddScanAdvanceWork, hil, hir, hires] using + hother i hil hir hires + have htailLength : rhsTail.length < total := by + simp only [List.length_nil, zero_add, List.length_cons] at hlength + omega + obtain ⟨c', hreach, hhalt, hfinalInput, hfinalLhs, + hfinalLhsHead, hfinalRhs, hfinalRhsHead, hfinalResult, + hfinalResultStart, hfinalOther, hfinalOutput⟩ := + ih rhsTail.length htailLength nextCarry [] rhsTail + (emitted ++ [sum]) inp₀ work₁ out₀ hlhs₁ hrhs₁ hresult₁ + hresultStart₁ hinput hother₁ houtput (by simp) + refine ⟨c', ?_, hhalt, hfinalInput, ?_, ?_, ?_, ?_, ?_, + hfinalResultStart, ?_, hfinalOutput⟩ + · simpa [binaryRippleAddScanTime] using + TM.reachesIn.step hstep hreach + · simpa [work₁, binaryRippleAddScanAdvanceWork, + hdistinct.lhs_result, hlhs.read_nil] using hfinalLhs + · simpa [work₁, binaryRippleAddScanAdvanceWork, + hdistinct.lhs_result, hlhs.read_nil] using hfinalLhsHead + · simpa [work₁, binaryRippleAddScanAdvanceWork, + hdistinct.rhs_result, Ne.symm hdistinct.lhs_rhs, + hrhsNotBlank, Tape.move_cells] using hfinalRhs + · rw [hfinalRhsHead] + simp only [work₁, binaryRippleAddScanAdvanceWork, + if_neg hdistinct.rhs_result, + if_neg (Ne.symm hdistinct.lhs_rhs), if_pos, + if_neg hrhsNotBlank, Tape.move, List.length_cons] + omega + · simpa [BinaryRippleAdd.ripple, sum, nextCarry, + List.append_assoc] using hfinalResult + · intro i hil hir hires + rw [hfinalOther i hil hir hires] + simp [work₁, binaryRippleAddScanAdvanceWork, hil, hir, hires] + | cons lhsBit lhsTail => + cases rhs with + | nil => + have hlhsBit : decide ((work₀ lhsIdx).read = Γ.one) = lhsBit := by + rw [hlhs.read_cons] + cases lhsBit <;> rfl + have hrhsBit : decide ((work₀ rhsIdx).read = Γ.one) = false := by + rw [hrhs.read_nil] + decide + let sum := BinaryRippleAdd.sumBit carry lhsBit false + let nextCarry := BinaryRippleAdd.carryBit carry lhsBit false + let work₁ := binaryRippleAddScanAdvanceWork lhsIdx rhsIdx resultIdx + sum work₀ + have hactive : ¬((work₀ lhsIdx).read = Γ.blank ∧ + (work₀ rhsIdx).read = Γ.blank) := by + intro hblank + rw [hlhs.read_cons] at hblank + cases lhsBit <;> simp [Γ.ofBool] at hblank + have hlhsNotBlank : (work₀ lhsIdx).read ≠ Γ.blank := by + rw [hlhs.read_cons] + cases lhsBit <;> decide + have hstep : + (binaryRippleAddScanTM lhsIdx rhsIdx resultIdx).step + { state := .scan carry, input := inp₀, work := work₀, + output := out₀ } = + some + { state := .scan nextCarry + input := inp₀ + work := work₁ + output := out₀ } := by + simpa [hlhsBit, hrhsBit, sum, nextCarry, work₁] using + binaryRippleAddScanTM_step_active lhsIdx rhsIdx resultIdx carry + inp₀ work₀ out₀ hactive hinput hlhs.read_ne_start + hrhs.read_ne_start hother houtput + have hlhs₁ : (work₁ lhsIdx).HasBinarySuffix lhsTail := by + simpa [work₁, binaryRippleAddScanAdvanceWork, + hdistinct.lhs_result, hlhsNotBlank] using hlhs.move_right_cons + have hrhs₁ : (work₁ rhsIdx).HasBinarySuffix [] := by + simpa [work₁, binaryRippleAddScanAdvanceWork, + hdistinct.rhs_result, Ne.symm hdistinct.lhs_rhs, + hrhs.read_nil] using hrhs + have hresult₁ : + (work₁ resultIdx).HasBinaryPrefix (emitted ++ [sum]) := by + rw [show work₁ resultIdx = + (work₀ resultIdx).writeAndMove (Γw.ofBool sum).toΓ + Dir3.right by + simp [work₁, binaryRippleAddScanAdvanceWork]] + rw [Γw.ofBool_toΓ] + exact Tape.hasBinaryPrefix_write_bit sum hresult + have hresultStart₁ : (work₁ resultIdx).cells 0 = Γ.start := by + rw [show work₁ resultIdx = + (work₀ resultIdx).writeAndMove (Γw.ofBool sum).toΓ + Dir3.right by + simp [work₁, binaryRippleAddScanAdvanceWork]] + rw [Γw.ofBool_toΓ] + exact Tape.hasBinaryPrefix_write_bit_cell0 sum hresult hresultStart + have hother₁ : ∀ i, i ≠ lhsIdx → i ≠ rhsIdx → i ≠ resultIdx → + (work₁ i).read ≠ Γ.start := by + intro i hil hir hires + simpa [work₁, binaryRippleAddScanAdvanceWork, hil, hir, hires] using + hother i hil hir hires + have htailLength : lhsTail.length < total := by + simp only [List.length_nil, Nat.add_zero, List.length_cons] at hlength + omega + obtain ⟨c', hreach, hhalt, hfinalInput, hfinalLhs, + hfinalLhsHead, hfinalRhs, hfinalRhsHead, hfinalResult, + hfinalResultStart, hfinalOther, hfinalOutput⟩ := + ih lhsTail.length htailLength nextCarry lhsTail [] + (emitted ++ [sum]) inp₀ work₁ out₀ hlhs₁ hrhs₁ hresult₁ + hresultStart₁ hinput hother₁ houtput (by simp) + refine ⟨c', ?_, hhalt, hfinalInput, ?_, ?_, ?_, ?_, ?_, + hfinalResultStart, ?_, hfinalOutput⟩ + · simpa [binaryRippleAddScanTime] using + TM.reachesIn.step hstep hreach + · simpa [work₁, binaryRippleAddScanAdvanceWork, + hdistinct.lhs_result, hlhsNotBlank, Tape.move_cells] using + hfinalLhs + · rw [hfinalLhsHead] + simp only [work₁, binaryRippleAddScanAdvanceWork, + if_neg hdistinct.lhs_result, if_pos, if_neg hlhsNotBlank, + Tape.move, List.length_cons] + omega + · simpa [work₁, binaryRippleAddScanAdvanceWork, + hdistinct.rhs_result, Ne.symm hdistinct.lhs_rhs, + hrhs.read_nil] using hfinalRhs + · simpa [work₁, binaryRippleAddScanAdvanceWork, + hdistinct.rhs_result, Ne.symm hdistinct.lhs_rhs, + hrhs.read_nil] using hfinalRhsHead + · simpa [BinaryRippleAdd.ripple, sum, nextCarry, + List.append_assoc] using hfinalResult + · intro i hil hir hires + rw [hfinalOther i hil hir hires] + simp [work₁, binaryRippleAddScanAdvanceWork, hil, hir, hires] + | cons rhsBit rhsTail => + have hlhsBit : decide ((work₀ lhsIdx).read = Γ.one) = lhsBit := by + rw [hlhs.read_cons] + cases lhsBit <;> rfl + have hrhsBit : decide ((work₀ rhsIdx).read = Γ.one) = rhsBit := by + rw [hrhs.read_cons] + cases rhsBit <;> rfl + let sum := BinaryRippleAdd.sumBit carry lhsBit rhsBit + let nextCarry := BinaryRippleAdd.carryBit carry lhsBit rhsBit + let work₁ := binaryRippleAddScanAdvanceWork lhsIdx rhsIdx resultIdx + sum work₀ + have hactive : ¬((work₀ lhsIdx).read = Γ.blank ∧ + (work₀ rhsIdx).read = Γ.blank) := by + intro hblank + rw [hlhs.read_cons] at hblank + cases lhsBit <;> simp [Γ.ofBool] at hblank + have hlhsNotBlank : (work₀ lhsIdx).read ≠ Γ.blank := by + rw [hlhs.read_cons] + cases lhsBit <;> decide + have hrhsNotBlank : (work₀ rhsIdx).read ≠ Γ.blank := by + rw [hrhs.read_cons] + cases rhsBit <;> decide + have hstep : + (binaryRippleAddScanTM lhsIdx rhsIdx resultIdx).step + { state := .scan carry, input := inp₀, work := work₀, + output := out₀ } = + some + { state := .scan nextCarry + input := inp₀ + work := work₁ + output := out₀ } := by + simpa [hlhsBit, hrhsBit, sum, nextCarry, work₁] using + binaryRippleAddScanTM_step_active lhsIdx rhsIdx resultIdx carry + inp₀ work₀ out₀ hactive hinput hlhs.read_ne_start + hrhs.read_ne_start hother houtput + have hlhs₁ : (work₁ lhsIdx).HasBinarySuffix lhsTail := by + simpa [work₁, binaryRippleAddScanAdvanceWork, + hdistinct.lhs_result, hlhsNotBlank] using hlhs.move_right_cons + have hrhs₁ : (work₁ rhsIdx).HasBinarySuffix rhsTail := by + simpa [work₁, binaryRippleAddScanAdvanceWork, + hdistinct.rhs_result, Ne.symm hdistinct.lhs_rhs, + hrhsNotBlank] using hrhs.move_right_cons + have hresult₁ : + (work₁ resultIdx).HasBinaryPrefix (emitted ++ [sum]) := by + rw [show work₁ resultIdx = + (work₀ resultIdx).writeAndMove (Γw.ofBool sum).toΓ + Dir3.right by + simp [work₁, binaryRippleAddScanAdvanceWork]] + rw [Γw.ofBool_toΓ] + exact Tape.hasBinaryPrefix_write_bit sum hresult + have hresultStart₁ : (work₁ resultIdx).cells 0 = Γ.start := by + rw [show work₁ resultIdx = + (work₀ resultIdx).writeAndMove (Γw.ofBool sum).toΓ + Dir3.right by + simp [work₁, binaryRippleAddScanAdvanceWork]] + rw [Γw.ofBool_toΓ] + exact Tape.hasBinaryPrefix_write_bit_cell0 sum hresult hresultStart + have hother₁ : ∀ i, i ≠ lhsIdx → i ≠ rhsIdx → i ≠ resultIdx → + (work₁ i).read ≠ Γ.start := by + intro i hil hir hires + simpa [work₁, binaryRippleAddScanAdvanceWork, hil, hir, hires] using + hother i hil hir hires + have htailLength : lhsTail.length + rhsTail.length < total := by + simp only [List.length_cons] at hlength + omega + obtain ⟨c', hreach, hhalt, hfinalInput, hfinalLhs, + hfinalLhsHead, hfinalRhs, hfinalRhsHead, hfinalResult, + hfinalResultStart, hfinalOther, hfinalOutput⟩ := + ih (lhsTail.length + rhsTail.length) htailLength nextCarry lhsTail + rhsTail (emitted ++ [sum]) inp₀ work₁ out₀ hlhs₁ hrhs₁ + hresult₁ hresultStart₁ hinput hother₁ houtput rfl + refine ⟨c', ?_, hhalt, hfinalInput, ?_, ?_, ?_, ?_, ?_, + hfinalResultStart, ?_, hfinalOutput⟩ + · simpa [binaryRippleAddScanTime, Nat.succ_max_succ] using + TM.reachesIn.step hstep hreach + · simpa [work₁, binaryRippleAddScanAdvanceWork, + hdistinct.lhs_result, hlhsNotBlank, Tape.move_cells] using + hfinalLhs + · rw [hfinalLhsHead] + simp only [work₁, binaryRippleAddScanAdvanceWork, + if_neg hdistinct.lhs_result, if_pos, if_neg hlhsNotBlank, + Tape.move, List.length_cons] + omega + · simpa [work₁, binaryRippleAddScanAdvanceWork, + hdistinct.rhs_result, Ne.symm hdistinct.lhs_rhs, + hrhsNotBlank, Tape.move_cells] using hfinalRhs + · rw [hfinalRhsHead] + simp only [work₁, binaryRippleAddScanAdvanceWork, + if_neg hdistinct.rhs_result, + if_neg (Ne.symm hdistinct.lhs_rhs), if_pos, + if_neg hrhsNotBlank, Tape.move, List.length_cons] + omega + · simpa [BinaryRippleAdd.ripple, sum, nextCarry, + List.append_assoc] using hfinalResult + · intro i hil hir hires + rw [hfinalOther i hil hir hires] + simp [work₁, binaryRippleAddScanAdvanceWork, hil, hir, hires] + +theorem binaryRippleAddScanTM_reachesIn_frame_internal {n : ℕ} + (lhsIdx rhsIdx resultIdx : Fin n) + (hdistinct : BinaryRippleAddDistinct lhsIdx rhsIdx resultIdx) + (lhs rhs : List Bool) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hlhs : (work₀ lhsIdx).HasBinaryString lhs) + (hrhs : (work₀ rhsIdx).HasBinaryString rhs) + (hresult : (work₀ resultIdx).HasBinaryPrefix []) + (hresultStart : (work₀ resultIdx).cells 0 = Γ.start) + (hinput : inp₀.read ≠ Γ.start) + (hother : ∀ i, i ≠ lhsIdx → i ≠ rhsIdx → i ≠ resultIdx → + (work₀ i).read ≠ Γ.start) + (houtput : out₀.read ≠ Γ.start) : + ∃ c', + (binaryRippleAddScanTM lhsIdx rhsIdx resultIdx).reachesIn + (binaryRippleAddScanTime lhs rhs) + { state := (binaryRippleAddScanTM lhsIdx rhsIdx resultIdx).qstart + input := inp₀ + work := work₀ + output := out₀ } c' ∧ + (binaryRippleAddScanTM lhsIdx rhsIdx resultIdx).halted c' ∧ + c'.input = inp₀ ∧ + (c'.work lhsIdx).cells = (work₀ lhsIdx).cells ∧ + (c'.work lhsIdx).head = lhs.length + 1 ∧ + (c'.work rhsIdx).cells = (work₀ rhsIdx).cells ∧ + (c'.work rhsIdx).head = rhs.length + 1 ∧ + (c'.work resultIdx).HasBinaryPrefix + (BinaryRippleAdd.ripple false lhs rhs) ∧ + (c'.work resultIdx).cells 0 = Γ.start ∧ + (∀ i, i ≠ lhsIdx → i ≠ rhsIdx → i ≠ resultIdx → + c'.work i = work₀ i) ∧ + c'.output = out₀ := by + obtain ⟨c', hreach, hhalt, hfinalInput, hfinalLhs, hfinalLhsHead, + hfinalRhs, hfinalRhsHead, hfinalResult, hfinalResultStart, + hfinalOther, hfinalOutput⟩ := + binaryRippleAddScanTM_suffix_reachesIn lhsIdx rhsIdx resultIdx hdistinct + false lhs rhs [] inp₀ work₀ out₀ hlhs.hasBinarySuffix + hrhs.hasBinarySuffix hresult hresultStart hinput hother houtput + refine ⟨c', hreach, hhalt, hfinalInput, hfinalLhs, ?_, hfinalRhs, ?_, ?_, + hfinalResultStart, hfinalOther, hfinalOutput⟩ + · simpa [hlhs.1, Nat.add_comm] using hfinalLhsHead + · simpa [hrhs.1, Nat.add_comm] using hfinalRhsHead + · simpa using hfinalResult + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleAdd/Internal/Sem.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleAdd/Internal/Sem.lean new file mode 100644 index 0000000000..6a5988f3fd --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleAdd/Internal/Sem.lean @@ -0,0 +1,251 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleAdd.Internal.Pure +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleAdd.Internal.Rewind +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleAdd.Internal.Scan +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinarySucc + +/-! +# Linear-time canonical binary addition -- composed semantics + +This file composes the one-pass full-adder scan with the three checked rewind +contracts. The resulting machine restores both operands, returns a canonical +sum, preserves the complete external tape frame, and carries explicit time and +all-prefix auxiliary-space bounds. +-/ + + +@[expose] public section + +namespace Complexity + +namespace TM + +private def binaryRippleAddScanPost {n : ℕ} + (lhsIdx rhsIdx resultIdx : Fin n) (lhs rhs : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) : TapePred n := + fun inp work out => + inp = inp₀ ∧ + (work lhsIdx).HasBinaryContent lhs.bits ∧ + (work lhsIdx).cells 0 = Γ.start ∧ + (work lhsIdx).head = lhs.size + 1 ∧ + (work rhsIdx).HasBinaryContent rhs.bits ∧ + (work rhsIdx).cells 0 = Γ.start ∧ + (work rhsIdx).head = rhs.size + 1 ∧ + (work resultIdx).HasBinaryContent (lhs + rhs).bits ∧ + (work resultIdx).cells 0 = Γ.start ∧ + (work resultIdx).head = (lhs + rhs).size + 1 ∧ + (∀ i, i ≠ lhsIdx → i ≠ rhsIdx → i ≠ resultIdx → + work i = work₀ i) ∧ + out = out₀ + +/-- Postcondition for completed binary ripple addition. -/ +def binaryRippleAddPost {n : ℕ} + (lhsIdx rhsIdx resultIdx : Fin n) (lhs rhs : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) : TapePred n := + fun inp work out => + inp = inp₀ ∧ + (work lhsIdx).HasBinaryNat lhs ∧ + (work rhsIdx).HasBinaryNat rhs ∧ + (work resultIdx).HasBinaryNat (lhs + rhs) ∧ + (∀ i, i ≠ lhsIdx → i ≠ rhsIdx → i ≠ resultIdx → + work i = work₀ i) ∧ + out = out₀ + +private theorem binaryRippleAddScanTM_hoareTime_frame_internal {n : ℕ} + (lhsIdx rhsIdx resultIdx : Fin n) + (hdistinct : BinaryRippleAddDistinct lhsIdx rhsIdx resultIdx) + (lhs rhs : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hlhs : (work₀ lhsIdx).HasBinaryNat lhs) + (hrhs : (work₀ rhsIdx).HasBinaryNat rhs) + (hresult : (work₀ resultIdx).HasBinaryNat 0) + (hinput : inp₀.read ≠ Γ.start) + (hother : ∀ i, i ≠ lhsIdx → i ≠ rhsIdx → i ≠ resultIdx → + (work₀ i).read ≠ Γ.start) + (houtput : out₀.read ≠ Γ.start) : + (binaryRippleAddScanTM lhsIdx rhsIdx resultIdx).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (binaryRippleAddScanPost lhsIdx rhsIdx resultIdx lhs rhs inp₀ work₀ out₀) + (binaryRippleAddScanTime lhs.bits rhs.bits) := by + rintro inp work out ⟨hinputEq, hworkEq, houtputEq⟩ + subst inp + subst work + subst out + have hresultPrefix : (work₀ resultIdx).HasBinaryPrefix [] := by + simpa [Tape.HasBinaryString, Tape.HasBinaryPrefix] using hresult.2 + obtain ⟨c', hreach, hhalt, hfinalInput, hfinalLhs, hfinalLhsHead, + hfinalRhs, hfinalRhsHead, hfinalResult, hfinalResultStart, + hfinalOther, hfinalOutput⟩ := + binaryRippleAddScanTM_reachesIn_frame_internal lhsIdx rhsIdx resultIdx + hdistinct lhs.bits rhs.bits inp₀ work₀ out₀ hlhs.2 hrhs.2 + hresultPrefix hresult.1 hinput hother houtput + refine ⟨c', binaryRippleAddScanTime lhs.bits rhs.bits, le_rfl, + hreach, hhalt, ?_⟩ + refine ⟨hfinalInput, ?_, ?_, ?_, ?_, ?_, ?_, ?_, hfinalResultStart, + ?_, hfinalOther, hfinalOutput⟩ + · simpa only [Tape.HasBinaryContent, hfinalLhs] using + hlhs.2.hasBinaryContent + · rw [hfinalLhs] + exact hlhs.1 + · simpa [Nat.size_eq_bits_len] using hfinalLhsHead + · simpa only [Tape.HasBinaryContent, hfinalRhs] using + hrhs.2.hasBinaryContent + · rw [hfinalRhs] + exact hrhs.1 + · simpa [Nat.size_eq_bits_len] using hfinalRhsHead + · simpa [BinaryRippleAdd.ripple_natBits_internal] using hfinalResult.2 + · simpa [BinaryRippleAdd.ripple_natBits_internal, + Nat.size_eq_bits_len] using hfinalResult.1 + +private theorem binaryRippleAddRewindTail_hoareTime_internal {n : ℕ} + (lhsIdx rhsIdx resultIdx : Fin n) + (hdistinct : BinaryRippleAddDistinct lhsIdx rhsIdx resultIdx) + (lhs rhs : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hinput : Parked inp₀) + (hother : ∀ i, i ≠ lhsIdx → i ≠ rhsIdx → i ≠ resultIdx → + Parked (work₀ i)) + (houtput : Parked out₀) : + (seqTM (rewindWorkTM lhsIdx) + (seqTM (rewindWorkTM rhsIdx) (rewindWorkTM resultIdx))).HoareTime + (binaryRippleAddScanPost lhsIdx rhsIdx resultIdx lhs rhs inp₀ work₀ out₀) + (binaryRippleAddPost lhsIdx rhsIdx resultIdx lhs rhs inp₀ work₀ out₀) + ((lhs.size + 1) + (rhs.size + 1) + ((lhs + rhs).size + 1) + 8) := by + intro inp work out hpre + rcases hpre with ⟨hinp, hlhs, hlhsStart, hlhsHead, hrhs, hrhsStart, + hrhsHead, hresult, hresultStart, hresultHead, hframe, hout⟩ + have hrewind := binaryRippleAddRewindTM_hoareTime_frame_internal + lhsIdx rhsIdx resultIdx hdistinct lhs.bits rhs.bits (lhs + rhs).bits + (lhs.size + 1) (rhs.size + 1) ((lhs + rhs).size + 1) + inp work out hlhs hlhsStart + ⟨by rw [hlhsHead]; omega, by rw [hlhsHead]⟩ + hrhs hrhsStart + ⟨by rw [hrhsHead]; omega, by rw [hrhsHead]⟩ + hresult hresultStart + ⟨by rw [hresultHead]; omega, by rw [hresultHead]⟩ + (hinp.symm ▸ hinput) + (fun i hil hir hires => by + rw [hframe i hil hir hires] + exact hother i hil hir hires) + (hout.symm ▸ houtput) + obtain ⟨c', time, htime, hreach, hhalt, hfinalInput, hfinalLhs, + hfinalRhs, hfinalResult, hfinalOther, hfinalOutput⟩ := + hrewind inp work out ⟨rfl, rfl, rfl⟩ + refine ⟨c', time, htime, hreach, hhalt, ?_⟩ + refine ⟨hfinalInput.trans hinp, ?_, ?_, ?_, ?_, hfinalOutput.trans hout⟩ + · rw [hfinalLhs] + exact Tape.init_move_right_hasBinaryNat lhs + · rw [hfinalRhs] + exact Tape.init_move_right_hasBinaryNat rhs + · rw [hfinalResult] + exact Tape.init_move_right_hasBinaryNat (lhs + rhs) + · intro i hil hir hires + exact (hfinalOther i hil hir hires).trans (hframe i hil hir hires) + +theorem binaryRippleAddTM_hoareTime_frame_internal {n : ℕ} + (lhsIdx rhsIdx resultIdx : Fin n) + (hdistinct : BinaryRippleAddDistinct lhsIdx rhsIdx resultIdx) + (lhs rhs : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hlhs : (work₀ lhsIdx).HasBinaryNat lhs) + (hrhs : (work₀ rhsIdx).HasBinaryNat rhs) + (hresult : (work₀ resultIdx).HasBinaryNat 0) + (hinput : Parked inp₀) + (hother : ∀ i, i ≠ lhsIdx → i ≠ rhsIdx → i ≠ resultIdx → + Parked (work₀ i)) + (houtput : Parked out₀) : + (binaryRippleAddTM lhsIdx rhsIdx resultIdx).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (binaryRippleAddPost lhsIdx rhsIdx resultIdx lhs rhs inp₀ work₀ out₀) + (binaryRippleAddTime lhs rhs) := by + have hscan := binaryRippleAddScanTM_hoareTime_frame_internal + lhsIdx rhsIdx resultIdx hdistinct lhs rhs inp₀ work₀ out₀ hlhs hrhs + hresult hinput.read_ne_start + (fun i hil hir hires => (hother i hil hir hires).read_ne_start) + houtput.read_ne_start + have htail := binaryRippleAddRewindTail_hoareTime_internal + lhsIdx rhsIdx resultIdx hdistinct lhs rhs inp₀ work₀ out₀ + hinput hother houtput + have htransition : ∀ inp work out, + binaryRippleAddScanPost lhsIdx rhsIdx resultIdx lhs rhs inp₀ work₀ out₀ + inp work out → + binaryRippleAddScanPost lhsIdx rhsIdx resultIdx lhs rhs inp₀ work₀ out₀ + (transitionInput inp) (fun i => transitionTape (work i)) + (transitionTape out) := by + intro inp work out hpost + rcases hpost with ⟨hinp, hlhsContent, hlhsStart, hlhsHead, + hrhsContent, hrhsStart, hrhsHead, hresultContent, hresultStart, + hresultHead, hframe, hout⟩ + have hworkRead : ∀ i, (work i).read ≠ Γ.start := by + intro i + by_cases hil : i = lhsIdx + · subst i + exact hlhsContent.cells_ne_start _ (by rw [hlhsHead]; omega) + by_cases hir : i = rhsIdx + · subst i + exact hrhsContent.cells_ne_start _ (by rw [hrhsHead]; omega) + by_cases hires : i = resultIdx + · subst i + exact hresultContent.cells_ne_start _ (by rw [hresultHead]; omega) + · rw [hframe i hil hir hires] + exact (hother i hil hir hires).read_ne_start + obtain ⟨hinputTransition, hworkTransition, houtputTransition⟩ := + phaseTransition_eq_self_of_reads_ne_start + (hinp.symm ▸ hinput.read_ne_start) hworkRead + (hout.symm ▸ houtput.read_ne_start) + rw [hinputTransition, hworkTransition, houtputTransition] + exact ⟨hinp, hlhsContent, hlhsStart, hlhsHead, hrhsContent, hrhsStart, + hrhsHead, hresultContent, hresultStart, hresultHead, hframe, hout⟩ + have hrun := seqTM_hoareTime + (binaryRippleAddScanTM lhsIdx rhsIdx resultIdx) + (seqTM (rewindWorkTM lhsIdx) + (seqTM (rewindWorkTM rhsIdx) (rewindWorkTM resultIdx))) + hscan htransition htail + unfold binaryRippleAddTM + apply hrun.mono_bound + rw [binaryRippleAddScanTime_natBits_internal] + simp only [binaryRippleAddTime] + omega + +theorem binaryRippleAddTM_hoareTimeSpace_frame_internal {n : ℕ} + (lhsIdx rhsIdx resultIdx : Fin n) + (hdistinct : BinaryRippleAddDistinct lhsIdx rhsIdx resultIdx) + (lhs rhs inputLength initialSpace : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hlhs : (work₀ lhsIdx).HasBinaryNat lhs) + (hrhs : (work₀ rhsIdx).HasBinaryNat rhs) + (hresult : (work₀ resultIdx).HasBinaryNat 0) + (hinput : Parked inp₀) + (hother : ∀ i, i ≠ lhsIdx → i ≠ rhsIdx → i ≠ resultIdx → + Parked (work₀ i)) + (houtput : Parked out₀) + (hinitial : + ({ state := (binaryRippleAddTM lhsIdx rhsIdx resultIdx).qstart + input := inp₀ + work := work₀ + output := out₀ } : + Cfg n (binaryRippleAddTM lhsIdx rhsIdx resultIdx).Q).WithinAuxSpace + inputLength initialSpace) : + (binaryRippleAddTM lhsIdx rhsIdx resultIdx).HoareTimeSpace + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (binaryRippleAddPost lhsIdx rhsIdx resultIdx lhs rhs inp₀ work₀ out₀) + (binaryRippleAddTime lhs rhs) inputLength + (initialSpace + binaryRippleAddTime lhs rhs) := by + apply (binaryRippleAddTM_hoareTime_frame_internal lhsIdx rhsIdx resultIdx + hdistinct lhs rhs inp₀ work₀ out₀ hlhs hrhs hresult hinput hother + houtput).toHoareTimeSpace + rintro inp work out ⟨hinputEq, hworkEq, houtputEq⟩ + subst inp + subst work + subst out + exact hinitial + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleSub.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleSub.lean new file mode 100644 index 0000000000..aa604ac911 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleSub.lean @@ -0,0 +1,150 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleSub.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleSub.Internal.Sem +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleSub.Internal.Out + +/-! +# Linear-time canonical binary subtraction + +This module exposes a concrete three-tape ripple-borrow subtractor. It preserves +two canonical little-endian operands, writes their truncated natural-number +difference to a fresh zero result tape, restores every owned head to cell one, +and preserves the complete external tape frame. Its running time is linear in +the operand bit widths. +-/ + + +public section + +namespace Complexity + +namespace BinaryRippleSub + +/-- Canonical ripple-borrow subtraction agrees with natural-number monus. -/ +theorem subtract_natBits (lhs rhs : ℕ) : + subtract lhs.bits rhs.bits = (lhs - rhs).bits := + subtract_natBits_internal lhs rhs + +end BinaryRippleSub + +namespace TM + +/-- The complete subtractor has a linear bit-width envelope. -/ +theorem binaryRippleSubTime_le (lhs rhs : ℕ) : + binaryRippleSubTime lhs rhs ≤ 3 * (lhs.size + rhs.size) + 10 := + binaryRippleSubTime_le_internal lhs rhs + +/-- Framed time contract for truncated subtraction. Both operands are restored, +the initially-zero result becomes their natural-number difference, and every +unrelated tape is preserved exactly. -/ +theorem binaryRippleSubTM_hoareTime_frame {n : ℕ} + (lhsIdx rhsIdx resultIdx : Fin n) + (hdistinct : BinaryRippleSubDistinct lhsIdx rhsIdx resultIdx) + (lhs rhs : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hlhs : (work₀ lhsIdx).HasBinaryNat lhs) + (hrhs : (work₀ rhsIdx).HasBinaryNat rhs) + (hresult : (work₀ resultIdx).HasBinaryNat 0) + (hinput : Parked inp₀) + (hother : ∀ i, i ≠ lhsIdx → i ≠ rhsIdx → i ≠ resultIdx → + Parked (work₀ i)) + (houtput : Parked out₀) : + (binaryRippleSubTM lhsIdx rhsIdx resultIdx).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + (work lhsIdx).HasBinaryNat lhs ∧ + (work rhsIdx).HasBinaryNat rhs ∧ + (work resultIdx).HasBinaryNat (lhs - rhs) ∧ + (∀ i, i ≠ lhsIdx → i ≠ rhsIdx → i ≠ resultIdx → + work i = work₀ i) ∧ + out = out₀) + (binaryRippleSubTime lhs rhs) := + binaryRippleSubTM_hoareTime_frame_internal lhsIdx rhsIdx resultIdx + hdistinct lhs rhs inp₀ work₀ out₀ hlhs hrhs hresult hinput hother + houtput + +/-- Reachability form of the framed subtraction theorem. -/ +theorem binaryRippleSubTM_reachesIn_frame {n : ℕ} + (lhsIdx rhsIdx resultIdx : Fin n) + (hdistinct : BinaryRippleSubDistinct lhsIdx rhsIdx resultIdx) + (lhs rhs : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hlhs : (work₀ lhsIdx).HasBinaryNat lhs) + (hrhs : (work₀ rhsIdx).HasBinaryNat rhs) + (hresult : (work₀ resultIdx).HasBinaryNat 0) + (hinput : Parked inp₀) + (hother : ∀ i, i ≠ lhsIdx → i ≠ rhsIdx → i ≠ resultIdx → + Parked (work₀ i)) + (houtput : Parked out₀) : + ∃ c' time, + time ≤ binaryRippleSubTime lhs rhs ∧ + (binaryRippleSubTM lhsIdx rhsIdx resultIdx).reachesIn time + { state := (binaryRippleSubTM lhsIdx rhsIdx resultIdx).qstart + input := inp₀ + work := work₀ + output := out₀ } c' ∧ + (binaryRippleSubTM lhsIdx rhsIdx resultIdx).halted c' ∧ + c'.input = inp₀ ∧ + (c'.work lhsIdx).HasBinaryNat lhs ∧ + (c'.work rhsIdx).HasBinaryNat rhs ∧ + (c'.work resultIdx).HasBinaryNat (lhs - rhs) ∧ + (∀ i, i ≠ lhsIdx → i ≠ rhsIdx → i ≠ resultIdx → + c'.work i = work₀ i) ∧ + c'.output = out₀ := by + exact binaryRippleSubTM_hoareTime_frame lhsIdx rhsIdx resultIdx hdistinct + lhs rhs inp₀ work₀ out₀ hlhs hrhs hresult hinput hother houtput + inp₀ work₀ out₀ ⟨rfl, rfl, rfl⟩ + +/-- All-prefix auxiliary-space contract obtained from the concrete linear +time bound. -/ +theorem binaryRippleSubTM_hoareTimeSpace_frame {n : ℕ} + (lhsIdx rhsIdx resultIdx : Fin n) + (hdistinct : BinaryRippleSubDistinct lhsIdx rhsIdx resultIdx) + (lhs rhs inputLength initialSpace : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hlhs : (work₀ lhsIdx).HasBinaryNat lhs) + (hrhs : (work₀ rhsIdx).HasBinaryNat rhs) + (hresult : (work₀ resultIdx).HasBinaryNat 0) + (hinput : Parked inp₀) + (hother : ∀ i, i ≠ lhsIdx → i ≠ rhsIdx → i ≠ resultIdx → + Parked (work₀ i)) + (houtput : Parked out₀) + (hinitial : + ({ state := (binaryRippleSubTM lhsIdx rhsIdx resultIdx).qstart + input := inp₀ + work := work₀ + output := out₀ } : + Cfg n (binaryRippleSubTM lhsIdx rhsIdx resultIdx).Q).WithinAuxSpace + inputLength initialSpace) : + (binaryRippleSubTM lhsIdx rhsIdx resultIdx).HoareTimeSpace + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + (work lhsIdx).HasBinaryNat lhs ∧ + (work rhsIdx).HasBinaryNat rhs ∧ + (work resultIdx).HasBinaryNat (lhs - rhs) ∧ + (∀ i, i ≠ lhsIdx → i ≠ rhsIdx → i ≠ resultIdx → + work i = work₀ i) ∧ + out = out₀) + (binaryRippleSubTime lhs rhs) inputLength + (initialSpace + binaryRippleSubTime lhs rhs) := + binaryRippleSubTM_hoareTimeSpace_frame_internal lhsIdx rhsIdx resultIdx + hdistinct lhs rhs inputLength initialSpace inp₀ work₀ out₀ hlhs hrhs + hresult hinput hother houtput hinitial + +/-- Canonical subtraction never moves the public output head left. -/ +theorem binaryRippleSubTM_isTransducer {n : ℕ} + (lhsIdx rhsIdx resultIdx : Fin n) : + (binaryRippleSubTM lhsIdx rhsIdx resultIdx).IsTransducer := + binaryRippleSubTM_isTransducer_internal lhsIdx rhsIdx resultIdx + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleSub/Defs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleSub/Defs.lean new file mode 100644 index 0000000000..ba0c898930 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleSub/Defs.lean @@ -0,0 +1,274 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines +public import Mathlib.Data.Nat.Bits + +/-! +# Linear-time canonical binary subtraction -- definitions + +This module defines a full-borrow scan over two preserved little-endian binary +work tapes. The scan writes a fixed-width difference to a fresh result tape. +A single backward pass then erases the complete result on underflow or removes +only its redundant high zeros, while returning the result head to cell one. +-/ + + +@[expose] public section + +namespace Complexity + +namespace BinaryRippleSub + +/-- The low output bit of one binary-subtraction column. -/ +def diffBit (borrow lhs rhs : Bool) : Bool := + (lhs.xor rhs).xor borrow + +/-- The outgoing borrow of one binary-subtraction column. -/ +def borrowBit (borrow lhs rhs : Bool) : Bool := + (!lhs && rhs) || (!lhs && borrow) || (rhs && borrow) + +/-- Raw fixed-width output of a borrow scan. -/ +structure ScanResult where + /-- Little-endian difference bits produced so far. -/ + bits : List Bool + /-- Borrow propagated beyond the most-significant scanned column. -/ + borrow : Bool + deriving DecidableEq + +/-- Scan two little-endian bit strings with an incoming borrow. A missing side +is padded by zero; the final borrow is retained separately from the raw bits. -/ +def scan : Bool → List Bool → List Bool → ScanResult + | borrow, [], [] => ⟨[], borrow⟩ + | borrow, lhs :: lhsTail, [] => + let tail := scan (borrowBit borrow lhs false) lhsTail [] + ⟨diffBit borrow lhs false :: tail.bits, tail.borrow⟩ + | borrow, [], rhs :: rhsTail => + let tail := scan (borrowBit borrow false rhs) [] rhsTail + ⟨diffBit borrow false rhs :: tail.bits, tail.borrow⟩ + | borrow, lhs :: lhsTail, rhs :: rhsTail => + let tail := scan (borrowBit borrow lhs rhs) lhsTail rhsTail + ⟨diffBit borrow lhs rhs :: tail.bits, tail.borrow⟩ + +/-- Remove redundant most-significant zeros from a little-endian bit string. -/ +def trimHighZeros : List Bool → List Bool + | [] => [] + | bit :: rest => + match trimHighZeros rest with + | [] => if bit then [true] else [] + | high :: tail => bit :: high :: tail + +/-- Canonical truncated subtraction semantics on arbitrary little-endian bit +strings. Underflow is represented by canonical zero. -/ +def subtract (lhs rhs : List Bool) : List Bool := + let raw := scan false lhs rhs + if raw.borrow then [] else trimHighZeros raw.bits + +end BinaryRippleSub + +namespace TM + +/-- Forward-borrow states, backward cleanup states, and the unique halt state. -/ +inductive BinaryRippleSubPhase where + | scan (borrow : Bool) + | erase + | trim (seenOne : Bool) + | done + deriving DecidableEq + +/-- `BinaryRippleSubPhase` is finite, as required by the concrete TM model. -/ +instance instFintypeBinaryRippleSubPhase : Fintype BinaryRippleSubPhase where + elems := {.scan false, .scan true, .erase, .trim false, .trim true, .done} + complete := by + intro phase + cases phase with + | scan borrow => cases borrow <;> simp + | erase => simp + | trim seenOne => cases seenOne <;> simp + | done => simp + +/-- Pairwise distinct work tapes owned by the ripple-borrow subtractor. -/ +structure BinaryRippleSubDistinct {n : ℕ} + (lhsIdx rhsIdx resultIdx : Fin n) : Prop where + lhs_rhs : lhsIdx ≠ rhsIdx + lhs_result : lhsIdx ≠ resultIdx + rhs_result : rhsIdx ≠ resultIdx + +/-- Scan two canonical operands, write their fixed-width raw difference, and +canonicalize the result while moving backward. A final borrow erases the whole +result; otherwise high zeros are erased until the first high one is seen. -/ +def binaryRippleSubCoreTM {n : ℕ} + (lhsIdx rhsIdx resultIdx : Fin n) : TM n where + Q := BinaryRippleSubPhase + qstart := .scan false + qhalt := .done + δ := fun state iHead wHeads oHead => + match state with + | .scan borrow => + if wHeads lhsIdx = Γ.blank ∧ wHeads rhsIdx = Γ.blank then + (if borrow then .erase else .trim false, + fun i => readBackWrite (wHeads i), readBackWrite oHead, + idleDir iHead, + fun i => if i = resultIdx then moveLeftDir (wHeads resultIdx) + else idleDir (wHeads i), + idleDir oHead) + else + let lhsBit := decide (wHeads lhsIdx = Γ.one) + let rhsBit := decide (wHeads rhsIdx = Γ.one) + let diff := BinaryRippleSub.diffBit borrow lhsBit rhsBit + let nextBorrow := BinaryRippleSub.borrowBit borrow lhsBit rhsBit + (.scan nextBorrow, + fun i => if i = resultIdx then Γw.ofBool diff + else readBackWrite (wHeads i), + readBackWrite oHead, + idleDir iHead, + fun i => + if i = resultIdx then Dir3.right + else if i = lhsIdx then + if wHeads lhsIdx = Γ.blank then Dir3.stay else Dir3.right + else if i = rhsIdx then + if wHeads rhsIdx = Γ.blank then Dir3.stay else Dir3.right + else idleDir (wHeads i), + idleDir oHead) + | .erase => + if wHeads resultIdx = Γ.start then + (.done, fun i => readBackWrite (wHeads i), readBackWrite oHead, + idleDir iHead, + fun i => if i = resultIdx then Dir3.right else idleDir (wHeads i), + idleDir oHead) + else + (.erase, + fun i => if i = resultIdx then Γw.blank + else readBackWrite (wHeads i), + readBackWrite oHead, + idleDir iHead, + fun i => if i = resultIdx then moveLeftDir (wHeads resultIdx) + else idleDir (wHeads i), + idleDir oHead) + | .trim seenOne => + if wHeads resultIdx = Γ.start then + (.done, fun i => readBackWrite (wHeads i), readBackWrite oHead, + idleDir iHead, + fun i => if i = resultIdx then Dir3.right else idleDir (wHeads i), + idleDir oHead) + else if seenOne ∨ wHeads resultIdx = Γ.one then + (.trim true, fun i => readBackWrite (wHeads i), readBackWrite oHead, + idleDir iHead, + fun i => if i = resultIdx then moveLeftDir (wHeads resultIdx) + else idleDir (wHeads i), + idleDir oHead) + else + (.trim false, + fun i => if i = resultIdx then Γw.blank + else readBackWrite (wHeads i), + readBackWrite oHead, + idleDir iHead, + fun i => if i = resultIdx then moveLeftDir (wHeads resultIdx) + else idleDir (wHeads i), + idleDir oHead) + | .done => allIdle .done iHead wHeads oHead + δ_right_of_start := by + intro state iHead wHeads oHead + cases state with + | scan borrow => + dsimp only + split + · refine ⟨idleDir_right_of_start, ?_, idleDir_right_of_start⟩ + intro i hi + simp only + by_cases hresult : i = resultIdx + · subst i + rw [if_pos rfl] + exact moveLeftDir_right_of_start hi + · rw [if_neg hresult] + exact idleDir_right_of_start hi + · refine ⟨idleDir_right_of_start, ?_, idleDir_right_of_start⟩ + intro i hi + dsimp only + by_cases hresult : i = resultIdx + · rw [if_pos hresult] + · rw [if_neg hresult] + by_cases hlhs : i = lhsIdx + · rw [if_pos hlhs] + subst i + simp [hi] + · rw [if_neg hlhs] + by_cases hrhs : i = rhsIdx + · rw [if_pos hrhs] + subst i + simp [hi] + · rw [if_neg hrhs] + exact idleDir_right_of_start hi + | erase => + dsimp only + split + · refine ⟨idleDir_right_of_start, ?_, idleDir_right_of_start⟩ + intro i hi + simp only + by_cases hresult : i = resultIdx + · rw [if_pos hresult] + · rw [if_neg hresult] + exact idleDir_right_of_start hi + · rename_i hnotStart + refine ⟨idleDir_right_of_start, ?_, idleDir_right_of_start⟩ + intro i hi + simp only + by_cases hresult : i = resultIdx + · subst i + rw [if_pos rfl] + exact moveLeftDir_right_of_start hi + · rw [if_neg hresult] + exact idleDir_right_of_start hi + | trim seenOne => + dsimp only + split + · refine ⟨idleDir_right_of_start, ?_, idleDir_right_of_start⟩ + intro i hi + simp only + by_cases hresult : i = resultIdx + · rw [if_pos hresult] + · rw [if_neg hresult] + exact idleDir_right_of_start hi + · rename_i hnotStart + split <;> + refine ⟨idleDir_right_of_start, ?_, idleDir_right_of_start⟩ + all_goals + intro i hi + simp only + by_cases hresult : i = resultIdx + · subst i + rw [if_pos rfl] + exact moveLeftDir_right_of_start hi + · rw [if_neg hresult] + exact idleDir_right_of_start hi + | done => exact rightOfStart_allIdle iHead wHeads oHead + +/-- Forward scan time, including the simultaneous-blank turn. -/ +def binaryRippleSubScanTime (lhs rhs : List Bool) : ℕ := + max lhs.length rhs.length + 1 + +/-- Backward cleanup time, including the final marker bounce. -/ +def binaryRippleSubCleanupTime (lhs rhs : List Bool) : ℕ := + max lhs.length rhs.length + 1 + +/-- Exact time of the forward scan followed by backward canonicalization. -/ +def binaryRippleSubCoreTime (lhs rhs : List Bool) : ℕ := + 2 * max lhs.length rhs.length + 2 + +/-- Canonical subtraction followed by rewinds of the two preserved operands. -/ +def binaryRippleSubTM {n : ℕ} + (lhsIdx rhsIdx resultIdx : Fin n) : TM n := + seqTM (binaryRippleSubCoreTM lhsIdx rhsIdx resultIdx) + (seqTM (rewindWorkTM lhsIdx) (rewindWorkTM rhsIdx)) + +/-- Width-linear time bound for the core, two rewinds, and two seams. -/ +def binaryRippleSubTime (lhs rhs : ℕ) : ℕ := + 2 * max lhs.size rhs.size + lhs.size + rhs.size + 10 + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleSub/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleSub/Internal.lean new file mode 100644 index 0000000000..6bed9279d5 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleSub/Internal.lean @@ -0,0 +1,14 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleSub.Internal.Backward +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleSub.Internal.Out +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleSub.Internal.Pure +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleSub.Internal.Rewind +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleSub.Internal.Scan +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleSub.Internal.Sem + +/-! Supporting modules for Beyond the Bethe approximation of the permanent. -/ diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleSub/Internal/Backward.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleSub/Internal/Backward.lean new file mode 100644 index 0000000000..a30e6500c6 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleSub/Internal/Backward.lean @@ -0,0 +1,623 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.Internal.Generic +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleSub.Internal.Pure +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Tape.Encoding +public import Mathlib.Algebra.Order.Sub.Basic + +/-! +# Linear-time canonical binary subtraction -- backward cleanup + +This module proves the exact backward half of `TM.binaryRippleSubCoreTM`. +Underflow erases the entire fixed-width result. Otherwise the machine erases +only redundant high zeros, preserves the significant suffix after its first +high one, and returns the result head to cell one. All other tapes are framed +literally throughout the run. +-/ + + +public section + +namespace Complexity + +namespace Tape + +/-- Blanking the final represented cell shortens canonical binary contents by +one bit. The erased bit may have either value. -/ +theorem HasBinaryContent.write_blank_last_internal {t : Tape} + {bitsPrefix : List Bool} {bit : Bool} + (h : t.HasBinaryContent (bitsPrefix ++ [bit])) + (hhead : t.head = bitsPrefix.length + 1) : + (t.write Γ.blank).HasBinaryContent bitsPrefix := by + have hhead0 : t.head ≠ 0 := by omega + constructor + · intro i hi + rw [Tape.write, if_neg hhead0] + simp only + rw [hhead, Function.update_of_ne (by omega)] + have hcell := h.1 i (by simp; omega) + simpa [List.getElem_append, hi] using hcell + · intro i hi + rw [Tape.write, if_neg hhead0] + simp only + rw [hhead] + by_cases heq : i = bitsPrefix.length + · subst i + rw [Function.update_self] + · rw [Function.update_of_ne (by omega)] + exact h.2 i (by simp; omega) + +end Tape + +namespace TM + +variable {n : ℕ} {lhsIdx rhsIdx resultIdx : Fin n} + +private theorem binaryRippleSubCoreTM_ne_halt + {phase : BinaryRippleSubPhase} + (hne : phase ≠ .done) + {c : Cfg n (binaryRippleSubCoreTM lhsIdx rhsIdx resultIdx).Q} + (hstate : c.state = phase) : + c.state ≠ (binaryRippleSubCoreTM lhsIdx rhsIdx resultIdx).qhalt := by + rw [hstate] + exact hne + +private theorem binaryRippleSubCoreTM_step_erase + (c : Cfg n (binaryRippleSubCoreTM lhsIdx rhsIdx resultIdx).Q) + (hstate : c.state = .erase) + (hread : (c.work resultIdx).read ≠ Γ.start) + (hinput : c.input.read ≠ Γ.start) + (hother : ∀ i, i ≠ resultIdx → (c.work i).read ≠ Γ.start) + (houtput : c.output.read ≠ Γ.start) : + (binaryRippleSubCoreTM lhsIdx rhsIdx resultIdx).step c = some + { state := .erase + input := c.input + work := Function.update c.work resultIdx + (((c.work resultIdx).write Γ.blank).move Dir3.left) + output := c.output } := by + rw [TM.step, if_neg (binaryRippleSubCoreTM_ne_halt (by simp) hstate)] + simp only [binaryRippleSubCoreTM, hstate, hread, ↓reduceIte] + refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, ?_, ?_, ?_⟩) + · exact transitionInput_eq_self hinput + · funext i + by_cases hi : i = resultIdx + · subst i + simp only [↓reduceIte, Function.update_self] + simp [moveLeftDir, hread] + · rw [Function.update_of_ne hi] + simpa only [if_neg hi] using transitionTape_eq_self (hother i hi) + · exact transitionTape_eq_self houtput + +private theorem binaryRippleSubCoreTM_step_trim_false_zero + (c : Cfg n (binaryRippleSubCoreTM lhsIdx rhsIdx resultIdx).Q) + (hstate : c.state = .trim false) + (hread : (c.work resultIdx).read = Γ.zero) + (hinput : c.input.read ≠ Γ.start) + (hother : ∀ i, i ≠ resultIdx → (c.work i).read ≠ Γ.start) + (houtput : c.output.read ≠ Γ.start) : + (binaryRippleSubCoreTM lhsIdx rhsIdx resultIdx).step c = some + { state := .trim false + input := c.input + work := Function.update c.work resultIdx + (((c.work resultIdx).write Γ.blank).move Dir3.left) + output := c.output } := by + rw [TM.step, if_neg (binaryRippleSubCoreTM_ne_halt (by decide) hstate)] + simp only [binaryRippleSubCoreTM, hstate] + simp [hread] + refine ⟨transitionInput_eq_self hinput, ?_, transitionTape_eq_self houtput⟩ + funext i + by_cases hi : i = resultIdx + · subst i + simp only [↓reduceIte, Function.update_self] + simp [moveLeftDir] + · rw [Function.update_of_ne hi] + simpa only [if_neg hi] using transitionTape_eq_self (hother i hi) + +private theorem binaryRippleSubCoreTM_step_trim_false_one + (c : Cfg n (binaryRippleSubCoreTM lhsIdx rhsIdx resultIdx).Q) + (hstate : c.state = .trim false) + (hread : (c.work resultIdx).read = Γ.one) + (hinput : c.input.read ≠ Γ.start) + (hother : ∀ i, i ≠ resultIdx → (c.work i).read ≠ Γ.start) + (houtput : c.output.read ≠ Γ.start) : + (binaryRippleSubCoreTM lhsIdx rhsIdx resultIdx).step c = some + { state := .trim true + input := c.input + work := Function.update c.work resultIdx + ((c.work resultIdx).move Dir3.left) + output := c.output } := by + rw [TM.step, if_neg (binaryRippleSubCoreTM_ne_halt (by decide) hstate)] + simp only [binaryRippleSubCoreTM, hstate] + simp [hread] + refine ⟨transitionInput_eq_self hinput, ?_, transitionTape_eq_self houtput⟩ + funext i + by_cases hi : i = resultIdx + · subst i + rw [if_pos rfl, Function.update_self] + change (c.work resultIdx).writeAndMove + (readBackWrite (c.work resultIdx).read) (moveLeftDir Γ.one) = _ + rw [writeAndMove_readBack _ (by rw [hread]; decide)] + simp [moveLeftDir] + · rw [if_neg hi, Function.update_of_ne hi] + exact transitionTape_eq_self (hother i hi) + +private theorem binaryRippleSubCoreTM_step_trim_true + (c : Cfg n (binaryRippleSubCoreTM lhsIdx rhsIdx resultIdx).Q) + (hstate : c.state = .trim true) + (hread : (c.work resultIdx).read ≠ Γ.start) + (hinput : c.input.read ≠ Γ.start) + (hother : ∀ i, i ≠ resultIdx → (c.work i).read ≠ Γ.start) + (houtput : c.output.read ≠ Γ.start) : + (binaryRippleSubCoreTM lhsIdx rhsIdx resultIdx).step c = some + { state := .trim true + input := c.input + work := Function.update c.work resultIdx + ((c.work resultIdx).move Dir3.left) + output := c.output } := by + rw [TM.step, if_neg (binaryRippleSubCoreTM_ne_halt (by decide) hstate)] + simp only [binaryRippleSubCoreTM, hstate] + simp [hread] + refine ⟨transitionInput_eq_self hinput, ?_, transitionTape_eq_self houtput⟩ + funext i + by_cases hi : i = resultIdx + · subst i + rw [if_pos rfl, Function.update_self] + change (c.work resultIdx).writeAndMove + (readBackWrite (c.work resultIdx).read) + (moveLeftDir (c.work resultIdx).read) = _ + rw [writeAndMove_readBack _ hread] + simp [moveLeftDir, hread] + · rw [if_neg hi, Function.update_of_ne hi] + exact transitionTape_eq_self (hother i hi) + +private theorem binaryRippleSubCoreTM_step_erase_start + (c : Cfg n (binaryRippleSubCoreTM lhsIdx rhsIdx resultIdx).Q) + (hstate : c.state = .erase) + (hread : (c.work resultIdx).read = Γ.start) + (hhead : (c.work resultIdx).head = 0) + (hinput : c.input.read ≠ Γ.start) + (hother : ∀ i, i ≠ resultIdx → (c.work i).read ≠ Γ.start) + (houtput : c.output.read ≠ Γ.start) : + (binaryRippleSubCoreTM lhsIdx rhsIdx resultIdx).step c = some + { state := .done + input := c.input + work := Function.update c.work resultIdx + ((c.work resultIdx).move Dir3.right) + output := c.output } := by + rw [TM.step, if_neg (binaryRippleSubCoreTM_ne_halt (by simp) hstate)] + simp only [binaryRippleSubCoreTM, hstate, hread, ↓reduceIte] + refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, ?_, ?_, ?_⟩) + · exact transitionInput_eq_self hinput + · funext i + by_cases hi : i = resultIdx + · subst i + simp only [↓reduceIte, Function.update_self] + show (((c.work resultIdx).write _).move Dir3.right) = + (c.work resultIdx).move Dir3.right + rw [Tape.write, if_pos hhead] + · rw [if_neg hi, Function.update_of_ne hi] + exact transitionTape_eq_self (hother i hi) + · exact transitionTape_eq_self houtput + +private theorem binaryRippleSubCoreTM_step_trim_start + (seenOne : Bool) + (c : Cfg n (binaryRippleSubCoreTM lhsIdx rhsIdx resultIdx).Q) + (hstate : c.state = .trim seenOne) + (hread : (c.work resultIdx).read = Γ.start) + (hhead : (c.work resultIdx).head = 0) + (hinput : c.input.read ≠ Γ.start) + (hother : ∀ i, i ≠ resultIdx → (c.work i).read ≠ Γ.start) + (houtput : c.output.read ≠ Γ.start) : + (binaryRippleSubCoreTM lhsIdx rhsIdx resultIdx).step c = some + { state := .done + input := c.input + work := Function.update c.work resultIdx + ((c.work resultIdx).move Dir3.right) + output := c.output } := by + rw [TM.step, if_neg (binaryRippleSubCoreTM_ne_halt (by simp) hstate)] + simp only [binaryRippleSubCoreTM, hstate, hread, ↓reduceIte] + refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, ?_, ?_, ?_⟩) + · exact transitionInput_eq_self hinput + · funext i + by_cases hi : i = resultIdx + · subst i + simp only [↓reduceIte, Function.update_self] + show (((c.work resultIdx).write _).move Dir3.right) = + (c.work resultIdx).move Dir3.right + rw [Tape.write, if_pos hhead] + · rw [if_neg hi, Function.update_of_ne hi] + exact transitionTape_eq_self (hother i hi) + · exact transitionTape_eq_self houtput + +/-! ## Exact backward runs -/ + +private theorem binaryRippleSubCoreTM_trim_true_run + (bits : List Bool) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hinp : inp₀.read ≠ Γ.start) + (hother : ∀ i, i ≠ resultIdx → (work₀ i).read ≠ Γ.start) + (hout : out₀.read ≠ Γ.start) : + ∀ head (c : Cfg n (binaryRippleSubCoreTM lhsIdx rhsIdx resultIdx).Q), + c.state = .trim true → + c.input = inp₀ → + (∀ i, i ≠ resultIdx → c.work i = work₀ i) → + (c.work resultIdx).HasBinaryContent bits → + (c.work resultIdx).cells 0 = Γ.start → + (c.work resultIdx).head = head → + c.output = out₀ → + ∃ c', + (binaryRippleSubCoreTM lhsIdx rhsIdx resultIdx).reachesIn + (head + 1) c c' ∧ + (binaryRippleSubCoreTM lhsIdx rhsIdx resultIdx).halted c' ∧ + c'.input = inp₀ ∧ + (∀ i, i ≠ resultIdx → c'.work i = work₀ i) ∧ + (c'.work resultIdx).HasBinaryString bits ∧ + (c'.work resultIdx).cells 0 = Γ.start ∧ + c'.output = out₀ := by + intro head + induction head with + | zero => + intro c hstate hinput hwork hcontent hcell0 hhead houtput + have hread : (c.work resultIdx).read = Γ.start := by + rw [Tape.read, hhead] + exact hcell0 + have hstep := binaryRippleSubCoreTM_step_trim_start true c hstate hread + hhead (by rw [hinput]; exact hinp) + (fun i hi => by rw [hwork i hi]; exact hother i hi) + (by rw [houtput]; exact hout) + let c₁ : Cfg n (binaryRippleSubCoreTM lhsIdx rhsIdx resultIdx).Q := + { state := .done + input := c.input + work := Function.update c.work resultIdx + ((c.work resultIdx).move Dir3.right) + output := c.output } + refine ⟨c₁, .step hstep .zero, rfl, hinput, ?_, ?_, ?_, houtput⟩ + · intro i hi + show Function.update c.work resultIdx + ((c.work resultIdx).move Dir3.right) i = work₀ i + rw [Function.update_of_ne hi] + exact hwork i hi + · show (Function.update c.work resultIdx + ((c.work resultIdx).move Dir3.right) resultIdx).HasBinaryString bits + rw [Function.update_self] + apply Tape.HasBinaryContent.hasBinaryString + · exact hcontent.move Dir3.right + · simp [Tape.move, hhead] + · show (Function.update c.work resultIdx + ((c.work resultIdx).move Dir3.right) resultIdx).cells 0 = _ + rw [Function.update_self, Tape.move_cells] + exact hcell0 + | succ head ih => + intro c hstate hinput hwork hcontent hcell0 hhead houtput + have hread : (c.work resultIdx).read ≠ Γ.start := by + rw [Tape.read, hhead] + exact hcontent.cells_ne_start (head + 1) (by omega) + have hstep := binaryRippleSubCoreTM_step_trim_true c hstate hread + (by rw [hinput]; exact hinp) + (fun i hi => by rw [hwork i hi]; exact hother i hi) + (by rw [houtput]; exact hout) + let c₁ : Cfg n (binaryRippleSubCoreTM lhsIdx rhsIdx resultIdx).Q := + { state := .trim true + input := c.input + work := Function.update c.work resultIdx + ((c.work resultIdx).move Dir3.left) + output := c.output } + obtain ⟨c', hreach, hhalt, hinput', hwork', hstring, hcell0', houtput'⟩ := + ih c₁ rfl hinput + (fun i hi => by + show Function.update c.work resultIdx + ((c.work resultIdx).move Dir3.left) i = work₀ i + rw [Function.update_of_ne hi] + exact hwork i hi) + (by + show (Function.update c.work resultIdx + ((c.work resultIdx).move Dir3.left) resultIdx).HasBinaryContent bits + rw [Function.update_self] + exact hcontent.move Dir3.left) + (by + show (Function.update c.work resultIdx + ((c.work resultIdx).move Dir3.left) resultIdx).cells 0 = _ + rw [Function.update_self, Tape.move_cells] + exact hcell0) + (by + show (Function.update c.work resultIdx + ((c.work resultIdx).move Dir3.left) resultIdx).head = head + rw [Function.update_self] + simp [Tape.move, hhead]) + houtput + refine ⟨c', ?_, hhalt, hinput', hwork', hstring, hcell0', houtput'⟩ + simpa [Nat.succ_eq_add_one, Nat.add_assoc] using + (TM.reachesIn.step hstep hreach) + +private theorem binaryRippleSubCoreTM_erase_run + (raw : List Bool) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hinp : inp₀.read ≠ Γ.start) + (hother : ∀ i, i ≠ resultIdx → (work₀ i).read ≠ Γ.start) + (hout : out₀.read ≠ Γ.start) + (c : Cfg n (binaryRippleSubCoreTM lhsIdx rhsIdx resultIdx).Q) + (hstate : c.state = .erase) + (hinput : c.input = inp₀) + (hwork : ∀ i, i ≠ resultIdx → c.work i = work₀ i) + (hcontent : (c.work resultIdx).HasBinaryContent raw) + (hcell0 : (c.work resultIdx).cells 0 = Γ.start) + (hhead : (c.work resultIdx).head = raw.length) + (houtput : c.output = out₀) : + ∃ c', + (binaryRippleSubCoreTM lhsIdx rhsIdx resultIdx).reachesIn + (raw.length + 1) c c' ∧ + (binaryRippleSubCoreTM lhsIdx rhsIdx resultIdx).halted c' ∧ + c'.input = inp₀ ∧ + (∀ i, i ≠ resultIdx → c'.work i = work₀ i) ∧ + (c'.work resultIdx).HasBinaryString [] ∧ + (c'.work resultIdx).cells 0 = Γ.start ∧ + c'.output = out₀ := by + induction raw using List.reverseRecOn generalizing c with + | nil => + have hread : (c.work resultIdx).read = Γ.start := by + rw [Tape.read, hhead] + exact hcell0 + have hstep := binaryRippleSubCoreTM_step_erase_start c hstate hread + hhead (by rw [hinput]; exact hinp) + (fun i hi => by rw [hwork i hi]; exact hother i hi) + (by rw [houtput]; exact hout) + let c₁ : Cfg n (binaryRippleSubCoreTM lhsIdx rhsIdx resultIdx).Q := + { state := .done + input := c.input + work := Function.update c.work resultIdx + ((c.work resultIdx).move Dir3.right) + output := c.output } + refine ⟨c₁, .step hstep .zero, rfl, hinput, ?_, ?_, ?_, houtput⟩ + · intro i hi + show Function.update c.work resultIdx + ((c.work resultIdx).move Dir3.right) i = work₀ i + rw [Function.update_of_ne hi] + exact hwork i hi + · show (Function.update c.work resultIdx + ((c.work resultIdx).move Dir3.right) resultIdx).HasBinaryString [] + rw [Function.update_self] + exact (hcontent.move Dir3.right).hasBinaryString (by simp [Tape.move, hhead]) + · show (Function.update c.work resultIdx + ((c.work resultIdx).move Dir3.right) resultIdx).cells 0 = _ + rw [Function.update_self, Tape.move_cells] + exact hcell0 + | append_singleton bitsPrefix bit ih => + have hread : (c.work resultIdx).read = Γ.ofBool bit := by + rw [Tape.read, hhead] + have hcell := hcontent.1 bitsPrefix.length (by simp) + simpa using hcell + have hreadNe : (c.work resultIdx).read ≠ Γ.start := by + rw [hread] + exact Γ.ofBool_ne_start bit + have hstep := binaryRippleSubCoreTM_step_erase c hstate hreadNe + (by rw [hinput]; exact hinp) + (fun i hi => by rw [hwork i hi]; exact hother i hi) + (by rw [houtput]; exact hout) + let target₁ : Tape := + ((c.work resultIdx).write Γ.blank).move Dir3.left + let c₁ : Cfg n (binaryRippleSubCoreTM lhsIdx rhsIdx resultIdx).Q := + { state := .erase + input := c.input + work := Function.update c.work resultIdx target₁ + output := c.output } + have hshort : + ((c.work resultIdx).write Γ.blank).HasBinaryContent bitsPrefix := + hcontent.write_blank_last_internal (by simpa using hhead) + obtain ⟨c', hreach, hhalt, hinput', hwork', hstring, hcell0', houtput'⟩ := + ih c₁ rfl hinput + (fun i hi => by + show Function.update c.work resultIdx target₁ i = work₀ i + rw [Function.update_of_ne hi] + exact hwork i hi) + (by + show (Function.update c.work resultIdx target₁ resultIdx) + |>.HasBinaryContent bitsPrefix + rw [Function.update_self] + exact hshort.move Dir3.left) + (by + show (Function.update c.work resultIdx target₁ resultIdx).cells 0 = _ + rw [Function.update_self] + exact Tape.write_move_cell0 Γ.blank Dir3.left hcell0) + (by + show (Function.update c.work resultIdx target₁ resultIdx).head = + bitsPrefix.length + rw [Function.update_self] + simp [target₁, Tape.move, Tape.write_head, hhead]) + houtput + refine ⟨c', ?_, hhalt, hinput', hwork', hstring, hcell0', houtput'⟩ + simpa [List.length_append, Nat.add_assoc] using + (TM.reachesIn.step hstep hreach) + +private theorem binaryRippleSubCoreTM_trim_false_run + (raw : List Bool) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hinp : inp₀.read ≠ Γ.start) + (hother : ∀ i, i ≠ resultIdx → (work₀ i).read ≠ Γ.start) + (hout : out₀.read ≠ Γ.start) + (c : Cfg n (binaryRippleSubCoreTM lhsIdx rhsIdx resultIdx).Q) + (hstate : c.state = .trim false) + (hinput : c.input = inp₀) + (hwork : ∀ i, i ≠ resultIdx → c.work i = work₀ i) + (hcontent : (c.work resultIdx).HasBinaryContent raw) + (hcell0 : (c.work resultIdx).cells 0 = Γ.start) + (hhead : (c.work resultIdx).head = raw.length) + (houtput : c.output = out₀) : + ∃ c', + (binaryRippleSubCoreTM lhsIdx rhsIdx resultIdx).reachesIn + (raw.length + 1) c c' ∧ + (binaryRippleSubCoreTM lhsIdx rhsIdx resultIdx).halted c' ∧ + c'.input = inp₀ ∧ + (∀ i, i ≠ resultIdx → c'.work i = work₀ i) ∧ + (c'.work resultIdx).HasBinaryString + (BinaryRippleSub.trimHighZeros raw) ∧ + (c'.work resultIdx).cells 0 = Γ.start ∧ + c'.output = out₀ := by + induction raw using List.reverseRecOn generalizing c with + | nil => + have hread : (c.work resultIdx).read = Γ.start := by + rw [Tape.read, hhead] + exact hcell0 + have hstep := binaryRippleSubCoreTM_step_trim_start false c hstate hread + hhead (by rw [hinput]; exact hinp) + (fun i hi => by rw [hwork i hi]; exact hother i hi) + (by rw [houtput]; exact hout) + let c₁ : Cfg n (binaryRippleSubCoreTM lhsIdx rhsIdx resultIdx).Q := + { state := .done + input := c.input + work := Function.update c.work resultIdx + ((c.work resultIdx).move Dir3.right) + output := c.output } + refine ⟨c₁, .step hstep .zero, rfl, hinput, ?_, ?_, ?_, houtput⟩ + · intro i hi + show Function.update c.work resultIdx + ((c.work resultIdx).move Dir3.right) i = work₀ i + rw [Function.update_of_ne hi] + exact hwork i hi + · show (Function.update c.work resultIdx + ((c.work resultIdx).move Dir3.right) resultIdx).HasBinaryString + (BinaryRippleSub.trimHighZeros []) + rw [Function.update_self] + simpa [BinaryRippleSub.trimHighZeros] using + (hcontent.move Dir3.right).hasBinaryString (by simp [Tape.move, hhead]) + · show (Function.update c.work resultIdx + ((c.work resultIdx).move Dir3.right) resultIdx).cells 0 = _ + rw [Function.update_self, Tape.move_cells] + exact hcell0 + | append_singleton bitsPrefix bit ih => + have hread : (c.work resultIdx).read = Γ.ofBool bit := by + rw [Tape.read, hhead] + have hcell := hcontent.1 bitsPrefix.length (by simp) + simpa using hcell + cases bit with + | false => + have hreadZero : (c.work resultIdx).read = Γ.zero := by + simpa [Γ.ofBool] using hread + have hstep := binaryRippleSubCoreTM_step_trim_false_zero c hstate + hreadZero (by rw [hinput]; exact hinp) + (fun i hi => by rw [hwork i hi]; exact hother i hi) + (by rw [houtput]; exact hout) + let target₁ : Tape := + ((c.work resultIdx).write Γ.blank).move Dir3.left + let c₁ : Cfg n (binaryRippleSubCoreTM lhsIdx rhsIdx resultIdx).Q := + { state := .trim false + input := c.input + work := Function.update c.work resultIdx target₁ + output := c.output } + have hshort : + ((c.work resultIdx).write Γ.blank).HasBinaryContent bitsPrefix := + hcontent.write_blank_last_internal (by simpa using hhead) + obtain ⟨c', hreach, hhalt, hinput', hwork', hstring, hcell0', houtput'⟩ := + ih c₁ rfl hinput + (fun i hi => by + show Function.update c.work resultIdx target₁ i = work₀ i + rw [Function.update_of_ne hi] + exact hwork i hi) + (by + show (Function.update c.work resultIdx target₁ resultIdx) + |>.HasBinaryContent bitsPrefix + rw [Function.update_self] + exact hshort.move Dir3.left) + (by + show (Function.update c.work resultIdx target₁ resultIdx).cells 0 = _ + rw [Function.update_self] + exact Tape.write_move_cell0 Γ.blank Dir3.left hcell0) + (by + show (Function.update c.work resultIdx target₁ resultIdx).head = + bitsPrefix.length + rw [Function.update_self] + simp [target₁, Tape.move, Tape.write_head, hhead]) + houtput + refine ⟨c', ?_, hhalt, hinput', hwork', ?_, hcell0', houtput'⟩ + · simpa [List.length_append, Nat.add_assoc] using + (TM.reachesIn.step hstep hreach) + · simpa [BinaryRippleSub.trimHighZeros_append_false_internal] using hstring + | true => + have hreadOne : (c.work resultIdx).read = Γ.one := by + simpa [Γ.ofBool] using hread + have hstep := binaryRippleSubCoreTM_step_trim_false_one c hstate + hreadOne (by rw [hinput]; exact hinp) + (fun i hi => by rw [hwork i hi]; exact hother i hi) + (by rw [houtput]; exact hout) + let target₁ : Tape := (c.work resultIdx).move Dir3.left + let c₁ : Cfg n (binaryRippleSubCoreTM lhsIdx rhsIdx resultIdx).Q := + { state := .trim true + input := c.input + work := Function.update c.work resultIdx target₁ + output := c.output } + obtain ⟨c', hreach, hhalt, hinput', hwork', hstring, hcell0', houtput'⟩ := + binaryRippleSubCoreTM_trim_true_run (lhsIdx := lhsIdx) + (rhsIdx := rhsIdx) (resultIdx := resultIdx) (bitsPrefix ++ [true]) + inp₀ work₀ out₀ hinp hother hout bitsPrefix.length c₁ rfl hinput + (fun i hi => by + show Function.update c.work resultIdx target₁ i = work₀ i + rw [Function.update_of_ne hi] + exact hwork i hi) + (by + show (Function.update c.work resultIdx target₁ resultIdx) + |>.HasBinaryContent (bitsPrefix ++ [true]) + rw [Function.update_self] + exact hcontent.move Dir3.left) + (by + show (Function.update c.work resultIdx target₁ resultIdx).cells 0 = _ + rw [Function.update_self, Tape.move_cells] + exact hcell0) + (by + show (Function.update c.work resultIdx target₁ resultIdx).head = + bitsPrefix.length + rw [Function.update_self] + simp [target₁, Tape.move, hhead]) + houtput + refine ⟨c', ?_, hhalt, hinput', hwork', ?_, hcell0', houtput'⟩ + · simpa [List.length_append, Nat.add_assoc] using + (TM.reachesIn.step hstep hreach) + · simpa [BinaryRippleSub.trimHighZeros_append_true_internal] using hstring + +/-- Exact framed backward cleanup after the forward scan has turned the result +head left. A final borrow erases the entire raw result; otherwise all and only +its redundant high zeros are erased. -/ +theorem binaryRippleSubCoreTM_cleanup_run_internal + (lhsIdx rhsIdx resultIdx : Fin n) + (raw : List Bool) (borrow : Bool) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hinp : inp₀.read ≠ Γ.start) + (hother : ∀ i, i ≠ resultIdx → (work₀ i).read ≠ Γ.start) + (hout : out₀.read ≠ Γ.start) + (hcontent : (work₀ resultIdx).HasBinaryContent raw) + (hcell0 : (work₀ resultIdx).cells 0 = Γ.start) + (hhead : (work₀ resultIdx).head = raw.length) : + ∃ c', + (binaryRippleSubCoreTM lhsIdx rhsIdx resultIdx).reachesIn + (raw.length + 1) + { state := if borrow then .erase else .trim false + input := inp₀ + work := work₀ + output := out₀ } c' ∧ + (binaryRippleSubCoreTM lhsIdx rhsIdx resultIdx).halted c' ∧ + c'.input = inp₀ ∧ + (∀ i, i ≠ resultIdx → c'.work i = work₀ i) ∧ + (c'.work resultIdx).HasBinaryString + (if borrow then [] else BinaryRippleSub.trimHighZeros raw) ∧ + (c'.work resultIdx).cells 0 = Γ.start ∧ + c'.output = out₀ := by + cases borrow with + | false => + simpa using binaryRippleSubCoreTM_trim_false_run + (lhsIdx := lhsIdx) (rhsIdx := rhsIdx) (resultIdx := resultIdx) + raw inp₀ work₀ out₀ hinp hother hout + { state := .trim false, input := inp₀, work := work₀, output := out₀ } + rfl rfl (fun _ _ => rfl) hcontent hcell0 hhead rfl + | true => + simpa using binaryRippleSubCoreTM_erase_run + (lhsIdx := lhsIdx) (rhsIdx := rhsIdx) (resultIdx := resultIdx) + raw inp₀ work₀ out₀ hinp hother hout + { state := .erase, input := inp₀, work := work₀, output := out₀ } + rfl rfl (fun _ _ => rfl) hcontent hcell0 hhead rfl + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleSub/Internal/Out.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleSub/Internal/Out.lean new file mode 100644 index 0000000000..93035e97c3 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleSub/Internal/Out.lean @@ -0,0 +1,63 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleSub.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.ClearWork.Internal + +/-! +# Linear-time canonical binary subtraction -- output discipline + +The borrow scan, backward cleanup, and operand rewinds leave the public output +tape one-way, so the core and complete machines are safe transducers. +-/ + + +public section + +namespace Complexity + +namespace TM + +/-- The direct subtraction core never moves the public output head left. -/ +theorem binaryRippleSubCoreTM_isTransducer_internal {n : ℕ} + (lhsIdx rhsIdx resultIdx : Fin n) : + (binaryRippleSubCoreTM lhsIdx rhsIdx resultIdx).IsTransducer := by + intro phase iHead wHeads oHead + cases phase with + | scan borrow => + simp only [binaryRippleSubCoreTM] + split <;> simp [idleDir] <;> split <;> decide + | erase => + simp only [binaryRippleSubCoreTM] + split <;> simp [idleDir] <;> split <;> decide + | trim seenOne => + simp only [binaryRippleSubCoreTM] + split + · simp [idleDir] + split <;> decide + · split + · simp [idleDir] + split <;> decide + · simp [idleDir] + split <;> decide + | done => + simp [binaryRippleSubCoreTM, allIdle, idleDir] + split <;> decide + +/-- Backward canonicalization followed by both operand rewinds remains a +transducer. -/ +theorem binaryRippleSubTM_isTransducer_internal {n : ℕ} + (lhsIdx rhsIdx resultIdx : Fin n) : + (binaryRippleSubTM lhsIdx rhsIdx resultIdx).IsTransducer := by + exact (binaryRippleSubCoreTM_isTransducer_internal + lhsIdx rhsIdx resultIdx).seqTM + ((rewindWorkTM_isTransducer_internal lhsIdx).seqTM + (rewindWorkTM_isTransducer_internal rhsIdx)) + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleSub/Internal/Pure.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleSub/Internal/Pure.lean new file mode 100644 index 0000000000..544a10ccbe --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleSub/Internal/Pure.lean @@ -0,0 +1,229 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Mathlib.NatBits +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleSub.Defs +public import Mathlib.Algebra.Order.Ring.Nat +public import Std.Tactic.BVDecide.Normalize.Bool + +/-! +# Linear-time canonical binary subtraction -- pure proofs + +The raw scan is verified through the standard full-subtractor invariant. Its +final borrow decides underflow, while trimming is proved to recover the +canonical `Nat.bits` representation of the raw fixed-width value. +-/ + + +public section + +namespace Complexity + +namespace BinaryRippleSub + +/-- Interpret a Boolean bit as a natural number. -/ +def boolValue (bit : Bool) : ℕ := + if bit then 1 else 0 + +private theorem fullSub_value (borrow lhs rhs : Bool) : + boolValue lhs + 2 * boolValue (borrowBit borrow lhs rhs) = + boolValue rhs + boolValue borrow + boolValue (diffBit borrow lhs rhs) := by + cases borrow <;> cases lhs <;> cases rhs <;> + simp [boolValue, borrowBit, diffBit] + +private theorem scan_value_step + (borrow lhsBit rhsBit tailBorrow : Bool) + (lhs rhs tailValue width : ℕ) + (htail : lhs + (if tailBorrow then 2 ^ width else 0) = + rhs + boolValue (borrowBit borrow lhsBit rhsBit) + tailValue) : + (boolValue lhsBit + 2 * lhs) + + (if tailBorrow then 2 ^ (width + 1) else 0) = + (boolValue rhsBit + 2 * rhs) + boolValue borrow + + (boolValue (diffBit borrow lhsBit rhsBit) + 2 * tailValue) := by + cases borrow <;> cases lhsBit <;> cases rhsBit <;> cases tailBorrow <;> + simp [boolValue, borrowBit, diffBit, pow_succ] at htail ⊢ <;> omega + +/-- The raw borrow scan writes exactly the larger input width. -/ +theorem scan_bits_length_internal (borrow : Bool) (lhs rhs : List Bool) : + (scan borrow lhs rhs).bits.length = max lhs.length rhs.length := by + induction lhs generalizing rhs borrow with + | nil => + induction rhs generalizing borrow with + | nil => simp [scan] + | cons rhsBit rhsTail ih => simp [scan, ih] + | cons lhsBit lhsTail ih => + cases rhs with + | nil => simp [scan, ih] + | cons rhsBit rhsTail => simp [scan, ih] + +/-- Arithmetic invariant for the fixed-width borrow scan. The final borrow is +the coefficient of the width-sized wraparound term. -/ +theorem scan_value_internal (borrow : Bool) (lhs rhs : List Bool) : + Nat.fromBitsLE lhs + + (if (scan borrow lhs rhs).borrow then + 2 ^ max lhs.length rhs.length else 0) = + Nat.fromBitsLE rhs + boolValue borrow + + Nat.fromBitsLE (scan borrow lhs rhs).bits := by + induction lhs generalizing rhs borrow with + | nil => + induction rhs generalizing borrow with + | nil => + cases borrow <;> simp [scan, boolValue, Nat.fromBitsLE, Nat.fromBits] + | cons rhsBit rhsTail ih => + let nextBorrow := borrowBit borrow false rhsBit + let tail := scan nextBorrow [] rhsTail + have htail : 0 + (if tail.borrow then 2 ^ rhsTail.length else 0) = + Nat.fromBitsLE rhsTail + boolValue nextBorrow + + Nat.fromBitsLE tail.bits := by + simpa [tail, nextBorrow, Nat.fromBitsLE, Nat.fromBits] using + ih nextBorrow + have hstep := scan_value_step borrow false rhsBit tail.borrow 0 + (Nat.fromBitsLE rhsTail) (Nat.fromBitsLE tail.bits) + rhsTail.length htail + simpa [scan, tail, nextBorrow, Nat.fromBitsLE_cons] using hstep + | cons lhsBit lhsTail ih => + cases rhs with + | nil => + let nextBorrow := borrowBit borrow lhsBit false + let tail := scan nextBorrow lhsTail [] + have htail : Nat.fromBitsLE lhsTail + + (if tail.borrow then 2 ^ lhsTail.length else 0) = + 0 + boolValue nextBorrow + Nat.fromBitsLE tail.bits := by + simpa [tail, nextBorrow, Nat.fromBitsLE, Nat.fromBits] using + ih nextBorrow [] + have hstep := scan_value_step borrow lhsBit false tail.borrow + (Nat.fromBitsLE lhsTail) 0 (Nat.fromBitsLE tail.bits) + lhsTail.length htail + simpa [scan, tail, nextBorrow, Nat.fromBitsLE_cons] using hstep + | cons rhsBit rhsTail => + let nextBorrow := borrowBit borrow lhsBit rhsBit + let tail := scan nextBorrow lhsTail rhsTail + have htail : Nat.fromBitsLE lhsTail + + (if tail.borrow then + 2 ^ max lhsTail.length rhsTail.length else 0) = + Nat.fromBitsLE rhsTail + boolValue nextBorrow + + Nat.fromBitsLE tail.bits := by + simpa [tail, nextBorrow] using ih nextBorrow rhsTail + have hstep := scan_value_step borrow lhsBit rhsBit tail.borrow + (Nat.fromBitsLE lhsTail) (Nat.fromBitsLE rhsTail) + (Nat.fromBitsLE tail.bits) (max lhsTail.length rhsTail.length) htail + simpa [scan, tail, nextBorrow, Nat.fromBitsLE_cons] using hstep + +/-- Appending a redundant high zero does not change canonical trimming. -/ +theorem trimHighZeros_append_false_internal (bits : List Bool) : + trimHighZeros (bits ++ [false]) = trimHighZeros bits := by + induction bits with + | nil => simp [trimHighZeros] + | cons bit rest ih => + rw [List.cons_append, trimHighZeros, ih] + cases rest <;> rfl + +/-- A high one makes the entire lower prefix significant. -/ +theorem trimHighZeros_append_true_internal (bits : List Bool) : + trimHighZeros (bits ++ [true]) = bits ++ [true] := by + induction bits with + | nil => simp [trimHighZeros] + | cons bit rest ih => + rw [List.cons_append, trimHighZeros, ih] + cases rest <;> rfl + +/-- Trimming arbitrary little-endian bits produces the canonical bits of their +decoded natural value. -/ +theorem trimHighZeros_eq_natBits_internal (bits : List Bool) : + trimHighZeros bits = (Nat.fromBitsLE bits).bits := by + induction bits with + | nil => simp [trimHighZeros, Nat.fromBitsLE, Nat.fromBits] + | cons bit rest ih => + rw [Nat.fromBitsLE_cons] + simp only [trimHighZeros, ih] + by_cases hrest : Nat.fromBitsLE rest = 0 + · rw [hrest] + cases bit <;> simp + · have hbits : (Nat.fromBitsLE rest).bits ≠ [] := by + intro hnil + have hsize : (Nat.fromBitsLE rest).size = 0 := by + rw [← Nat.size_eq_bits_len, hnil] + rfl + exact hrest (Nat.size_eq_zero.mp hsize) + have hvalue : (if bit then 1 else 0) + 2 * Nat.fromBitsLE rest = + Nat.bit bit (Nat.fromBitsLE rest) := by + cases bit + · simp [Nat.bit] + · simp [Nat.bit, Nat.add_comm] + rw [hvalue, Nat.bits_append_bit _ bit (fun h => (hrest h).elim)] + cases htail : (Nat.fromBitsLE rest).bits with + | nil => exact (hbits htail).elim + | cons high tail => rfl + +/-- The canonical pure subtraction result agrees with natural-number monus. -/ +theorem subtract_natBits_internal (lhs rhs : ℕ) : + subtract lhs.bits rhs.bits = (lhs - rhs).bits := by + let raw := scan false lhs.bits rhs.bits + have hinvariant := scan_value_internal false lhs.bits rhs.bits + have hlength := scan_bits_length_internal false lhs.bits rhs.bits + have hrawBound := Nat.fromBitsLE_lt_pow_length raw.bits + have hlength' : raw.bits.length = max lhs.size rhs.size := by + simpa [raw, Nat.size_eq_bits_len] using hlength + have hinvariant' : lhs + + (if raw.borrow then 2 ^ max lhs.size rhs.size else 0) = + rhs + Nat.fromBitsLE raw.bits := by + simpa [raw, Nat.fromBitsLE_bits, Nat.size_eq_bits_len] using hinvariant + have hrawBound' : Nat.fromBitsLE raw.bits < 2 ^ max lhs.size rhs.size := by + rw [hlength'] at hrawBound + exact hrawBound + change (if raw.borrow then [] else trimHighZeros raw.bits) = (lhs - rhs).bits + cases hborrow : raw.borrow with + | false => + simp only [Bool.false_eq_true, if_false] + rw [trimHighZeros_eq_natBits_internal] + have hvalue : Nat.fromBitsLE raw.bits = lhs - rhs := by + simp [hborrow] at hinvariant' + omega + rw [hvalue] + | true => + simp only [if_true] + have hlt : lhs < rhs := by + simp [hborrow] at hinvariant' + omega + rw [Nat.sub_eq_zero_of_le (Nat.le_of_lt hlt), Nat.zero_bits] + +/-- Canonical subtraction has exactly the width of natural-number monus. -/ +theorem length_subtract_natBits_internal (lhs rhs : ℕ) : + (subtract lhs.bits rhs.bits).length = (lhs - rhs).size := by + rw [subtract_natBits_internal, Nat.size_eq_bits_len] + +end BinaryRippleSub + +namespace TM + +/-- The scan bound on canonical operands is the larger natural-number width. -/ +theorem binaryRippleSubScanTime_natBits_internal (lhs rhs : ℕ) : + binaryRippleSubScanTime lhs.bits rhs.bits = max lhs.size rhs.size + 1 := by + simp [binaryRippleSubScanTime, Nat.size_eq_bits_len] + +/-- The cleanup bound equals the scan bound on canonical operands. -/ +theorem binaryRippleSubCleanupTime_natBits_internal (lhs rhs : ℕ) : + binaryRippleSubCleanupTime lhs.bits rhs.bits = max lhs.size rhs.size + 1 := by + simp [binaryRippleSubCleanupTime, Nat.size_eq_bits_len] + +/-- The core bound is twice the larger width plus its two turning steps. -/ +theorem binaryRippleSubCoreTime_natBits_internal (lhs rhs : ℕ) : + binaryRippleSubCoreTime lhs.bits rhs.bits = + 2 * max lhs.size rhs.size + 2 := by + simp [binaryRippleSubCoreTime, Nat.size_eq_bits_len] + +/-- The complete subtractor is linear in the sum of the operand widths. -/ +theorem binaryRippleSubTime_le_internal (lhs rhs : ℕ) : + binaryRippleSubTime lhs rhs ≤ 3 * (lhs.size + rhs.size) + 10 := by + simp only [binaryRippleSubTime] + have hmax : max lhs.size rhs.size ≤ lhs.size + rhs.size := + max_le (Nat.le_add_right _ _) (Nat.le_add_left _ _) + omega + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleSub/Internal/Rewind.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleSub/Internal/Rewind.lean new file mode 100644 index 0000000000..48ff575bf1 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleSub/Internal/Rewind.lean @@ -0,0 +1,181 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleSub.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.ResetBinary.Internal + +/-! +# Linear-time canonical binary subtraction -- operand rewind internals + +The subtraction core already returns its result to cell one. This module +packages the two remaining operand rewinds into one exact framed contract. +-/ + + +@[expose] public section + +namespace Complexity + +namespace TM + +/-- Canonical parked tape containing the supplied little-endian binary digits. -/ +def binaryRippleSubCanonicalTape (bits : List Bool) : Tape := + (Tape.init (bits.map Γ.ofBool)).move Dir3.right + +private theorem binaryRippleSubCanonicalTape_parked (bits : List Bool) : + Parked (binaryRippleSubCanonicalTape bits) := by + refine ⟨by simp [binaryRippleSubCanonicalTape, Tape.move], ?_⟩ + simpa [binaryRippleSubCanonicalTape] using + Tape.init_ofBool_move_right_cells_ne_start bits + +private theorem binaryRippleSubRewindExact_hoareTime {n : ℕ} + (idx : Fin n) (bits : List Bool) (headBound : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (htarget : (work₀ idx).HasBinaryContent bits) + (htargetStart : (work₀ idx).cells 0 = Γ.start) + (htargetHead : 1 ≤ (work₀ idx).head ∧ + (work₀ idx).head ≤ headBound) + (hinput : Parked inp₀) + (hother : ∀ i, i ≠ idx → Parked (work₀ i)) + (houtput : Parked out₀) : + (rewindWorkTM idx).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + work = Function.update work₀ idx + (binaryRippleSubCanonicalTape bits) ∧ + out = out₀) + (headBound + 2) := by + have hrewind := rewindBinaryWorkTM_hoareTime_frame_internal idx bits + headBound inp₀ work₀ out₀ htarget htargetStart htargetHead hinput + hother houtput + apply hrewind.consequence (b' := headBound + 2) + · intro _inp _work _out hpre + exact hpre + · rintro inp work out ⟨hinp, htargetEq, hotherEq, hout⟩ + refine ⟨hinp, ?_, hout⟩ + funext i + by_cases hi : i = idx + · subst i + rw [Function.update_self] + simpa [binaryRippleSubCanonicalTape] using htargetEq + · rw [Function.update_of_ne hi] + exact hotherEq i hi + · exact le_rfl + +private theorem binaryRippleSubExactFrame_transition {n : ℕ} + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hinput : Parked inp₀) (hwork : ∀ i, Parked (work₀ i)) + (houtput : Parked out₀) : + ∀ inp work out, + (inp = inp₀ ∧ work = work₀ ∧ out = out₀) → + transitionInput inp = inp₀ ∧ + (fun i => transitionTape (work i)) = work₀ ∧ + transitionTape out = out₀ := by + rintro _inp _work _out ⟨rfl, rfl, rfl⟩ + exact ⟨hinput.transitionInput_eq_self, + funext fun i => (hwork i).transitionTape_eq_self, + houtput.transitionTape_eq_self⟩ + +theorem binaryRippleSubRewindTM_hoareTime_frame_internal {n : ℕ} + (lhsIdx rhsIdx resultIdx : Fin n) + (hdistinct : BinaryRippleSubDistinct lhsIdx rhsIdx resultIdx) + (lhsBits rhsBits : List Bool) (lhsBound rhsBound : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hlhs : (work₀ lhsIdx).HasBinaryContent lhsBits) + (hlhsStart : (work₀ lhsIdx).cells 0 = Γ.start) + (hlhsHead : 1 ≤ (work₀ lhsIdx).head ∧ + (work₀ lhsIdx).head ≤ lhsBound) + (hrhs : (work₀ rhsIdx).HasBinaryContent rhsBits) + (hrhsStart : (work₀ rhsIdx).cells 0 = Γ.start) + (hrhsHead : 1 ≤ (work₀ rhsIdx).head ∧ + (work₀ rhsIdx).head ≤ rhsBound) + (hresult : Parked (work₀ resultIdx)) + (hinput : Parked inp₀) + (hother : ∀ i, i ≠ lhsIdx → i ≠ rhsIdx → i ≠ resultIdx → + Parked (work₀ i)) + (houtput : Parked out₀) : + (seqTM (rewindWorkTM lhsIdx) (rewindWorkTM rhsIdx)).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + work lhsIdx = binaryRippleSubCanonicalTape lhsBits ∧ + work rhsIdx = binaryRippleSubCanonicalTape rhsBits ∧ + work resultIdx = work₀ resultIdx ∧ + (∀ i, i ≠ lhsIdx → i ≠ rhsIdx → i ≠ resultIdx → + work i = work₀ i) ∧ + out = out₀) + (lhsBound + rhsBound + 5) := by + have hlhsParked : Parked (work₀ lhsIdx) := + ⟨hlhsHead.1, hlhs.cells_ne_start⟩ + have hrhsParked : Parked (work₀ rhsIdx) := + ⟨hrhsHead.1, hrhs.cells_ne_start⟩ + have hwork₀ : ∀ i, Parked (work₀ i) := by + intro i + by_cases hil : i = lhsIdx + · subst i + exact hlhsParked + by_cases hir : i = rhsIdx + · subst i + exact hrhsParked + by_cases hires : i = resultIdx + · subst i + exact hresult + exact hother i hil hir hires + + let lhsTape := binaryRippleSubCanonicalTape lhsBits + let rhsTape := binaryRippleSubCanonicalTape rhsBits + let work₁ := Function.update work₀ lhsIdx lhsTape + let work₂ := Function.update work₁ rhsIdx rhsTape + + have hwork₁ : ∀ i, Parked (work₁ i) := by + intro i + by_cases hi : i = lhsIdx + · subst i + simpa [work₁, lhsTape] using + binaryRippleSubCanonicalTape_parked lhsBits + · simpa only [work₁, Function.update_of_ne hi] using hwork₀ i + have hrhs₁ : (work₁ rhsIdx).HasBinaryContent rhsBits := by + simpa only [work₁, Function.update_of_ne hdistinct.lhs_rhs.symm] using + hrhs + have hrhsStart₁ : (work₁ rhsIdx).cells 0 = Γ.start := by + simpa only [work₁, Function.update_of_ne hdistinct.lhs_rhs.symm] using + hrhsStart + have hrhsHead₁ : 1 ≤ (work₁ rhsIdx).head ∧ + (work₁ rhsIdx).head ≤ rhsBound := by + simpa only [work₁, Function.update_of_ne hdistinct.lhs_rhs.symm] using + hrhsHead + + have hrewindLhs := binaryRippleSubRewindExact_hoareTime lhsIdx lhsBits + lhsBound inp₀ work₀ out₀ hlhs hlhsStart hlhsHead hinput + (fun i _ => hwork₀ i) houtput + have hrewindRhs := binaryRippleSubRewindExact_hoareTime rhsIdx rhsBits + rhsBound inp₀ work₁ out₀ hrhs₁ hrhsStart₁ hrhsHead₁ hinput + (fun i _ => hwork₁ i) houtput + have hrun := seqTM_hoareTime (rewindWorkTM lhsIdx) + (rewindWorkTM rhsIdx) hrewindLhs + (binaryRippleSubExactFrame_transition inp₀ work₁ out₀ hinput + hwork₁ houtput) + hrewindRhs + apply hrun.consequence (b' := lhsBound + rhsBound + 5) + · intro _inp _work _out hpre + exact hpre + · rintro inp work out ⟨hinp, hwork, hout⟩ + refine ⟨hinp, ?_, ?_, ?_, ?_, hout⟩ + · simpa [work₂, work₁, rhsTape, lhsTape, + hdistinct.lhs_rhs] using congrFun hwork lhsIdx + · simpa [work₂, rhsTape] using congrFun hwork rhsIdx + · simpa [work₂, work₁, hdistinct.rhs_result, + hdistinct.rhs_result.symm, hdistinct.lhs_result, + hdistinct.lhs_result.symm] using congrFun hwork resultIdx + · intro i hil hir hires + simpa [work₂, work₁, hir, hil] using congrFun hwork i + · omega + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleSub/Internal/Scan.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleSub/Internal/Scan.lean new file mode 100644 index 0000000000..cbfef932a7 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleSub/Internal/Scan.lean @@ -0,0 +1,577 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleSub.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.Internal.Generic +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Tape.Encoding +public import Mathlib.Algebra.Order.Ring.Nat +public import Mathlib.Tactic.NormNum.Inv +public import Mathlib.Tactic.NormNum.Pow + +/-! +# Linear-time canonical binary subtraction -- forward scan proof + +This file proves the exact framed contract for the forward borrow scan, +including its final turn into backward cleanup. Cleanup itself is proved in a +separate internal layer. +-/ + + +public section + +namespace Complexity + +namespace TM + +private def binaryRippleSubScanAdvanceWork {n : ℕ} + (lhsIdx rhsIdx resultIdx : Fin n) (diff : Bool) + (work : Fin n → Tape) : Fin n → Tape := + fun i => + if i = resultIdx then + (work i).writeAndMove (Γw.ofBool diff) Dir3.right + else if i = lhsIdx then + if (work lhsIdx).read = Γ.blank then work i + else (work i).move Dir3.right + else if i = rhsIdx then + if (work rhsIdx).read = Γ.blank then work i + else (work i).move Dir3.right + else work i + +private def binaryRippleSubScanTurnWork {n : ℕ} (resultIdx : Fin n) + (work : Fin n → Tape) : Fin n → Tape := + Function.update work resultIdx ((work resultIdx).move Dir3.left) + +private theorem binaryRippleSubCoreTM_step_active {n : ℕ} + (lhsIdx rhsIdx resultIdx : Fin n) + (borrow : Bool) (inp : Tape) (work : Fin n → Tape) (out : Tape) + (hactive : ¬((work lhsIdx).read = Γ.blank ∧ + (work rhsIdx).read = Γ.blank)) + (hinput : inp.read ≠ Γ.start) + (hlhs : (work lhsIdx).read ≠ Γ.start) + (hrhs : (work rhsIdx).read ≠ Γ.start) + (hother : ∀ i, i ≠ lhsIdx → i ≠ rhsIdx → i ≠ resultIdx → + (work i).read ≠ Γ.start) + (houtput : out.read ≠ Γ.start) : + let lhsBit := decide ((work lhsIdx).read = Γ.one) + let rhsBit := decide ((work rhsIdx).read = Γ.one) + let diff := BinaryRippleSub.diffBit borrow lhsBit rhsBit + let nextBorrow := BinaryRippleSub.borrowBit borrow lhsBit rhsBit + (binaryRippleSubCoreTM lhsIdx rhsIdx resultIdx).step + { state := .scan borrow, input := inp, work := work, output := out } = + some + { state := .scan nextBorrow + input := inp + work := binaryRippleSubScanAdvanceWork lhsIdx rhsIdx resultIdx diff work + output := out } := by + dsimp only + rw [TM.step, if_neg (by simp [binaryRippleSubCoreTM])] + simp only [binaryRippleSubCoreTM, hactive, ↓reduceIte] + refine congrArg some (Cfg.ext rfl (transitionInput_eq_self hinput) ?_ + (transitionTape_eq_self houtput)) + funext i + by_cases hresultIdx : i = resultIdx + · subst i + simp [binaryRippleSubScanAdvanceWork] + · by_cases hlhsIdx : i = lhsIdx + · subst i + simp only [binaryRippleSubScanAdvanceWork, hresultIdx, if_false, if_pos] + by_cases hblank : (work lhsIdx).read = Γ.blank + · rw [if_pos hblank, if_pos hblank] + rw [writeAndMove_readBack _ hlhs Dir3.stay] + rfl + · rw [if_neg hblank, if_neg hblank] + exact writeAndMove_readBack (work lhsIdx) hlhs Dir3.right + · by_cases hrhsIdx : i = rhsIdx + · subst i + simp only [binaryRippleSubScanAdvanceWork, hresultIdx, if_false, + hlhsIdx, if_pos] + by_cases hblank : (work rhsIdx).read = Γ.blank + · rw [if_pos hblank, if_pos hblank] + rw [writeAndMove_readBack _ hrhs Dir3.stay] + rfl + · rw [if_neg hblank, if_neg hblank] + exact writeAndMove_readBack (work rhsIdx) hrhs Dir3.right + · simp only [binaryRippleSubScanAdvanceWork, hresultIdx, if_false, + hlhsIdx, hrhsIdx] + exact transitionTape_eq_self (hother i hlhsIdx hrhsIdx hresultIdx) + +private theorem binaryRippleSubCoreTM_step_terminal {n : ℕ} + (lhsIdx rhsIdx resultIdx : Fin n) + (hdistinct : BinaryRippleSubDistinct lhsIdx rhsIdx resultIdx) + (borrow : Bool) (emitted : List Bool) + (inp : Tape) (work : Fin n → Tape) (out : Tape) + (hlhs : (work lhsIdx).read = Γ.blank) + (hrhs : (work rhsIdx).read = Γ.blank) + (hinput : inp.read ≠ Γ.start) + (hresult : (work resultIdx).HasBinaryPrefix emitted) + (hresultStart : (work resultIdx).cells 0 = Γ.start) + (hother : ∀ i, i ≠ lhsIdx → i ≠ rhsIdx → i ≠ resultIdx → + (work i).read ≠ Γ.start) + (houtput : out.read ≠ Γ.start) : + let finalWork := binaryRippleSubScanTurnWork resultIdx work + (binaryRippleSubCoreTM lhsIdx rhsIdx resultIdx).step + { state := .scan borrow, input := inp, work := work, output := out } = + some + { state := if borrow then .erase else .trim false + input := inp + work := finalWork + output := out } ∧ + (finalWork lhsIdx).cells = (work lhsIdx).cells ∧ + (finalWork lhsIdx).head = (work lhsIdx).head ∧ + (finalWork rhsIdx).cells = (work rhsIdx).cells ∧ + (finalWork rhsIdx).head = (work rhsIdx).head ∧ + (finalWork resultIdx).HasBinaryContent emitted ∧ + (finalWork resultIdx).head = emitted.length ∧ + (finalWork resultIdx).cells 0 = Γ.start ∧ + (∀ i, i ≠ lhsIdx → i ≠ rhsIdx → i ≠ resultIdx → + finalWork i = work i) := by + dsimp only + let finalWork := binaryRippleSubScanTurnWork resultIdx work + refine ⟨?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_⟩ + · rw [TM.step, if_neg (by simp [binaryRippleSubCoreTM])] + simp only [binaryRippleSubCoreTM, hlhs, hrhs, and_self, if_pos] + refine congrArg some (Cfg.ext rfl (transitionInput_eq_self hinput) ?_ + (transitionTape_eq_self houtput)) + funext i + by_cases hires : i = resultIdx + · subst i + simp only [binaryRippleSubScanTurnWork, Function.update_self] + rw [show moveLeftDir (work resultIdx).read = Dir3.left by + rw [hresult.read_blank] + rfl] + exact writeAndMove_readBack (work resultIdx) (by + rw [hresult.read_blank] + decide) Dir3.left + · by_cases hil : i = lhsIdx + · subst i + simpa [binaryRippleSubScanTurnWork, + hdistinct.lhs_result] using + transitionTape_eq_self (by rw [hlhs]; decide) + · by_cases hir : i = rhsIdx + · subst i + simpa [binaryRippleSubScanTurnWork, + hdistinct.rhs_result] using + transitionTape_eq_self (by rw [hrhs]; decide) + · simpa [binaryRippleSubScanTurnWork, hires] using + transitionTape_eq_self (hother i hil hir hires) + · simp [binaryRippleSubScanTurnWork, hdistinct.lhs_result] + · simp [binaryRippleSubScanTurnWork, hdistinct.lhs_result] + · simp [binaryRippleSubScanTurnWork, hdistinct.rhs_result] + · simp [binaryRippleSubScanTurnWork, hdistinct.rhs_result] + · simpa [finalWork, binaryRippleSubScanTurnWork, Tape.move_cells] using + hresult.2 + · simp [binaryRippleSubScanTurnWork, Tape.move, hresult.1] + · simpa [finalWork, binaryRippleSubScanTurnWork, Tape.move_cells] using + hresultStart + · intro i _ _ hires + simp [binaryRippleSubScanTurnWork, hires] + +private theorem binaryRippleSubCoreTM_suffix_reachesIn {n : ℕ} + (lhsIdx rhsIdx resultIdx : Fin n) + (hdistinct : BinaryRippleSubDistinct lhsIdx rhsIdx resultIdx) + (borrow : Bool) (lhs rhs emitted : List Bool) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hlhs : (work₀ lhsIdx).HasBinarySuffix lhs) + (hrhs : (work₀ rhsIdx).HasBinarySuffix rhs) + (hresult : (work₀ resultIdx).HasBinaryPrefix emitted) + (hresultStart : (work₀ resultIdx).cells 0 = Γ.start) + (hinput : inp₀.read ≠ Γ.start) + (hother : ∀ i, i ≠ lhsIdx → i ≠ rhsIdx → i ≠ resultIdx → + (work₀ i).read ≠ Γ.start) + (houtput : out₀.read ≠ Γ.start) : + ∃ c', + (binaryRippleSubCoreTM lhsIdx rhsIdx resultIdx).reachesIn + (binaryRippleSubScanTime lhs rhs) + { state := .scan borrow, input := inp₀, work := work₀, output := out₀ } c' ∧ + c'.state = (if (BinaryRippleSub.scan borrow lhs rhs).borrow then + .erase else .trim false) ∧ + c'.input = inp₀ ∧ + (c'.work lhsIdx).cells = (work₀ lhsIdx).cells ∧ + (c'.work lhsIdx).head = (work₀ lhsIdx).head + lhs.length ∧ + (c'.work rhsIdx).cells = (work₀ rhsIdx).cells ∧ + (c'.work rhsIdx).head = (work₀ rhsIdx).head + rhs.length ∧ + (c'.work resultIdx).HasBinaryContent + (emitted ++ (BinaryRippleSub.scan borrow lhs rhs).bits) ∧ + (c'.work resultIdx).head = + (emitted ++ (BinaryRippleSub.scan borrow lhs rhs).bits).length ∧ + (c'.work resultIdx).cells 0 = Γ.start ∧ + (∀ i, i ≠ lhsIdx → i ≠ rhsIdx → i ≠ resultIdx → + c'.work i = work₀ i) ∧ + c'.output = out₀ := by + induction hlength : lhs.length + rhs.length using Nat.strong_induction_on + generalizing lhs rhs borrow emitted inp₀ work₀ out₀ with + | h total ih => + cases lhs with + | nil => + cases rhs with + | nil => + have hterminal := binaryRippleSubCoreTM_step_terminal + lhsIdx rhsIdx resultIdx hdistinct borrow emitted inp₀ work₀ out₀ + hlhs.read_nil hrhs.read_nil hinput hresult hresultStart hother houtput + let finalWork := binaryRippleSubScanTurnWork resultIdx work₀ + let c' : Cfg n BinaryRippleSubPhase := + { state := if borrow then .erase else .trim false + input := inp₀ + work := finalWork + output := out₀ } + rcases hterminal with ⟨hstep, hfinalLhs, hfinalLhsHead, hfinalRhs, + hfinalRhsHead, hfinalResult, hfinalResultHead, hfinalResultStart, + hfinalOther⟩ + refine ⟨c', ?_, by + cases borrow <;> simp [c', BinaryRippleSub.scan], rfl, + hfinalLhs, ?_, hfinalRhs, ?_, ?_, ?_, + hfinalResultStart, hfinalOther, rfl⟩ + · have hreach : + (binaryRippleSubCoreTM lhsIdx rhsIdx resultIdx).reachesIn 1 + { state := .scan borrow, input := inp₀, work := work₀, + output := out₀ } c' := + .step hstep .zero + simpa [binaryRippleSubScanTime] using hreach + · simpa using hfinalLhsHead + · simpa using hfinalRhsHead + · simpa [BinaryRippleSub.scan] using hfinalResult + · simpa [BinaryRippleSub.scan] using hfinalResultHead + | cons rhsBit rhsTail => + have hlhsBit : decide ((work₀ lhsIdx).read = Γ.one) = false := by + rw [hlhs.read_nil] + decide + have hrhsBit : decide ((work₀ rhsIdx).read = Γ.one) = rhsBit := by + rw [hrhs.read_cons] + cases rhsBit <;> rfl + let diff := BinaryRippleSub.diffBit borrow false rhsBit + let nextBorrow := BinaryRippleSub.borrowBit borrow false rhsBit + let work₁ := binaryRippleSubScanAdvanceWork lhsIdx rhsIdx resultIdx + diff work₀ + have hactive : ¬((work₀ lhsIdx).read = Γ.blank ∧ + (work₀ rhsIdx).read = Γ.blank) := by + intro hblank + rw [hrhs.read_cons] at hblank + cases rhsBit <;> simp [Γ.ofBool] at hblank + have hrhsNotBlank : (work₀ rhsIdx).read ≠ Γ.blank := by + rw [hrhs.read_cons] + cases rhsBit <;> decide + have hstep : + (binaryRippleSubCoreTM lhsIdx rhsIdx resultIdx).step + { state := .scan borrow, input := inp₀, work := work₀, + output := out₀ } = + some + { state := .scan nextBorrow + input := inp₀ + work := work₁ + output := out₀ } := by + simpa [hlhsBit, hrhsBit, diff, nextBorrow, work₁] using + binaryRippleSubCoreTM_step_active lhsIdx rhsIdx resultIdx borrow + inp₀ work₀ out₀ hactive hinput hlhs.read_ne_start + hrhs.read_ne_start hother houtput + have hlhs₁ : (work₁ lhsIdx).HasBinarySuffix [] := by + simpa [work₁, binaryRippleSubScanAdvanceWork, + hdistinct.lhs_result, hlhs.read_nil] using hlhs + have hrhs₁ : (work₁ rhsIdx).HasBinarySuffix rhsTail := by + simpa [work₁, binaryRippleSubScanAdvanceWork, + hdistinct.rhs_result, Ne.symm hdistinct.lhs_rhs, + hrhsNotBlank] using hrhs.move_right_cons + have hresult₁ : + (work₁ resultIdx).HasBinaryPrefix (emitted ++ [diff]) := by + rw [show work₁ resultIdx = + (work₀ resultIdx).writeAndMove (Γw.ofBool diff).toΓ + Dir3.right by + simp [work₁, binaryRippleSubScanAdvanceWork]] + rw [Γw.ofBool_toΓ] + exact Tape.hasBinaryPrefix_write_bit diff hresult + have hresultStart₁ : (work₁ resultIdx).cells 0 = Γ.start := by + rw [show work₁ resultIdx = + (work₀ resultIdx).writeAndMove (Γw.ofBool diff).toΓ + Dir3.right by + simp [work₁, binaryRippleSubScanAdvanceWork]] + rw [Γw.ofBool_toΓ] + exact Tape.hasBinaryPrefix_write_bit_cell0 diff hresult hresultStart + have hother₁ : ∀ i, i ≠ lhsIdx → i ≠ rhsIdx → i ≠ resultIdx → + (work₁ i).read ≠ Γ.start := by + intro i hil hir hires + simpa [work₁, binaryRippleSubScanAdvanceWork, hil, hir, hires] using + hother i hil hir hires + have htailLength : rhsTail.length < total := by + simp only [List.length_nil, zero_add, List.length_cons] at hlength + omega + obtain ⟨c', hreach, hstate, hfinalInput, hfinalLhs, + hfinalLhsHead, hfinalRhs, hfinalRhsHead, hfinalResult, + hfinalResultHead, hfinalResultStart, hfinalOther, hfinalOutput⟩ := + ih rhsTail.length htailLength nextBorrow [] rhsTail + (emitted ++ [diff]) inp₀ work₁ out₀ hlhs₁ hrhs₁ hresult₁ + hresultStart₁ hinput hother₁ houtput (by simp) + refine ⟨c', ?_, ?_, hfinalInput, ?_, ?_, ?_, ?_, ?_, ?_, + hfinalResultStart, ?_, hfinalOutput⟩ + · simpa [binaryRippleSubScanTime] using + TM.reachesIn.step hstep hreach + · simpa [BinaryRippleSub.scan, nextBorrow] using hstate + · simpa [work₁, binaryRippleSubScanAdvanceWork, + hdistinct.lhs_result, hlhs.read_nil] using hfinalLhs + · simpa [work₁, binaryRippleSubScanAdvanceWork, + hdistinct.lhs_result, hlhs.read_nil] using hfinalLhsHead + · simpa [work₁, binaryRippleSubScanAdvanceWork, + hdistinct.rhs_result, Ne.symm hdistinct.lhs_rhs, + hrhsNotBlank, Tape.move_cells] using hfinalRhs + · rw [hfinalRhsHead] + simp only [work₁, binaryRippleSubScanAdvanceWork, + if_neg hdistinct.rhs_result, + if_neg (Ne.symm hdistinct.lhs_rhs), if_pos, + if_neg hrhsNotBlank, Tape.move, List.length_cons] + omega + · simpa [BinaryRippleSub.scan, diff, nextBorrow, + List.append_assoc] using hfinalResult + · simpa [BinaryRippleSub.scan, diff, nextBorrow, + List.append_assoc] using hfinalResultHead + · intro i hil hir hires + rw [hfinalOther i hil hir hires] + simp [work₁, binaryRippleSubScanAdvanceWork, hil, hir, hires] + | cons lhsBit lhsTail => + cases rhs with + | nil => + have hlhsBit : decide ((work₀ lhsIdx).read = Γ.one) = lhsBit := by + rw [hlhs.read_cons] + cases lhsBit <;> rfl + have hrhsBit : decide ((work₀ rhsIdx).read = Γ.one) = false := by + rw [hrhs.read_nil] + decide + let diff := BinaryRippleSub.diffBit borrow lhsBit false + let nextBorrow := BinaryRippleSub.borrowBit borrow lhsBit false + let work₁ := binaryRippleSubScanAdvanceWork lhsIdx rhsIdx resultIdx + diff work₀ + have hactive : ¬((work₀ lhsIdx).read = Γ.blank ∧ + (work₀ rhsIdx).read = Γ.blank) := by + intro hblank + rw [hlhs.read_cons] at hblank + cases lhsBit <;> simp [Γ.ofBool] at hblank + have hlhsNotBlank : (work₀ lhsIdx).read ≠ Γ.blank := by + rw [hlhs.read_cons] + cases lhsBit <;> decide + have hstep : + (binaryRippleSubCoreTM lhsIdx rhsIdx resultIdx).step + { state := .scan borrow, input := inp₀, work := work₀, + output := out₀ } = + some + { state := .scan nextBorrow + input := inp₀ + work := work₁ + output := out₀ } := by + simpa [hlhsBit, hrhsBit, diff, nextBorrow, work₁] using + binaryRippleSubCoreTM_step_active lhsIdx rhsIdx resultIdx borrow + inp₀ work₀ out₀ hactive hinput hlhs.read_ne_start + hrhs.read_ne_start hother houtput + have hlhs₁ : (work₁ lhsIdx).HasBinarySuffix lhsTail := by + simpa [work₁, binaryRippleSubScanAdvanceWork, + hdistinct.lhs_result, hlhsNotBlank] using hlhs.move_right_cons + have hrhs₁ : (work₁ rhsIdx).HasBinarySuffix [] := by + simpa [work₁, binaryRippleSubScanAdvanceWork, + hdistinct.rhs_result, Ne.symm hdistinct.lhs_rhs, + hrhs.read_nil] using hrhs + have hresult₁ : + (work₁ resultIdx).HasBinaryPrefix (emitted ++ [diff]) := by + rw [show work₁ resultIdx = + (work₀ resultIdx).writeAndMove (Γw.ofBool diff).toΓ + Dir3.right by + simp [work₁, binaryRippleSubScanAdvanceWork]] + rw [Γw.ofBool_toΓ] + exact Tape.hasBinaryPrefix_write_bit diff hresult + have hresultStart₁ : (work₁ resultIdx).cells 0 = Γ.start := by + rw [show work₁ resultIdx = + (work₀ resultIdx).writeAndMove (Γw.ofBool diff).toΓ + Dir3.right by + simp [work₁, binaryRippleSubScanAdvanceWork]] + rw [Γw.ofBool_toΓ] + exact Tape.hasBinaryPrefix_write_bit_cell0 diff hresult hresultStart + have hother₁ : ∀ i, i ≠ lhsIdx → i ≠ rhsIdx → i ≠ resultIdx → + (work₁ i).read ≠ Γ.start := by + intro i hil hir hires + simpa [work₁, binaryRippleSubScanAdvanceWork, hil, hir, hires] using + hother i hil hir hires + have htailLength : lhsTail.length < total := by + simp only [List.length_nil, Nat.add_zero, List.length_cons] at hlength + omega + obtain ⟨c', hreach, hstate, hfinalInput, hfinalLhs, + hfinalLhsHead, hfinalRhs, hfinalRhsHead, hfinalResult, + hfinalResultHead, hfinalResultStart, hfinalOther, hfinalOutput⟩ := + ih lhsTail.length htailLength nextBorrow lhsTail [] + (emitted ++ [diff]) inp₀ work₁ out₀ hlhs₁ hrhs₁ hresult₁ + hresultStart₁ hinput hother₁ houtput (by simp) + refine ⟨c', ?_, ?_, hfinalInput, ?_, ?_, ?_, ?_, ?_, ?_, + hfinalResultStart, ?_, hfinalOutput⟩ + · simpa [binaryRippleSubScanTime] using + TM.reachesIn.step hstep hreach + · simpa [BinaryRippleSub.scan, nextBorrow] using hstate + · simpa [work₁, binaryRippleSubScanAdvanceWork, + hdistinct.lhs_result, hlhsNotBlank, Tape.move_cells] using + hfinalLhs + · rw [hfinalLhsHead] + simp only [work₁, binaryRippleSubScanAdvanceWork, + if_neg hdistinct.lhs_result, if_pos, if_neg hlhsNotBlank, + Tape.move, List.length_cons] + omega + · simpa [work₁, binaryRippleSubScanAdvanceWork, + hdistinct.rhs_result, Ne.symm hdistinct.lhs_rhs, + hrhs.read_nil] using hfinalRhs + · simpa [work₁, binaryRippleSubScanAdvanceWork, + hdistinct.rhs_result, Ne.symm hdistinct.lhs_rhs, + hrhs.read_nil] using hfinalRhsHead + · simpa [BinaryRippleSub.scan, diff, nextBorrow, + List.append_assoc] using hfinalResult + · simpa [BinaryRippleSub.scan, diff, nextBorrow, + List.append_assoc] using hfinalResultHead + · intro i hil hir hires + rw [hfinalOther i hil hir hires] + simp [work₁, binaryRippleSubScanAdvanceWork, hil, hir, hires] + | cons rhsBit rhsTail => + have hlhsBit : decide ((work₀ lhsIdx).read = Γ.one) = lhsBit := by + rw [hlhs.read_cons] + cases lhsBit <;> rfl + have hrhsBit : decide ((work₀ rhsIdx).read = Γ.one) = rhsBit := by + rw [hrhs.read_cons] + cases rhsBit <;> rfl + let diff := BinaryRippleSub.diffBit borrow lhsBit rhsBit + let nextBorrow := BinaryRippleSub.borrowBit borrow lhsBit rhsBit + let work₁ := binaryRippleSubScanAdvanceWork lhsIdx rhsIdx resultIdx + diff work₀ + have hactive : ¬((work₀ lhsIdx).read = Γ.blank ∧ + (work₀ rhsIdx).read = Γ.blank) := by + intro hblank + rw [hlhs.read_cons] at hblank + cases lhsBit <;> simp [Γ.ofBool] at hblank + have hlhsNotBlank : (work₀ lhsIdx).read ≠ Γ.blank := by + rw [hlhs.read_cons] + cases lhsBit <;> decide + have hrhsNotBlank : (work₀ rhsIdx).read ≠ Γ.blank := by + rw [hrhs.read_cons] + cases rhsBit <;> decide + have hstep : + (binaryRippleSubCoreTM lhsIdx rhsIdx resultIdx).step + { state := .scan borrow, input := inp₀, work := work₀, + output := out₀ } = + some + { state := .scan nextBorrow + input := inp₀ + work := work₁ + output := out₀ } := by + simpa [hlhsBit, hrhsBit, diff, nextBorrow, work₁] using + binaryRippleSubCoreTM_step_active lhsIdx rhsIdx resultIdx borrow + inp₀ work₀ out₀ hactive hinput hlhs.read_ne_start + hrhs.read_ne_start hother houtput + have hlhs₁ : (work₁ lhsIdx).HasBinarySuffix lhsTail := by + simpa [work₁, binaryRippleSubScanAdvanceWork, + hdistinct.lhs_result, hlhsNotBlank] using hlhs.move_right_cons + have hrhs₁ : (work₁ rhsIdx).HasBinarySuffix rhsTail := by + simpa [work₁, binaryRippleSubScanAdvanceWork, + hdistinct.rhs_result, Ne.symm hdistinct.lhs_rhs, + hrhsNotBlank] using hrhs.move_right_cons + have hresult₁ : + (work₁ resultIdx).HasBinaryPrefix (emitted ++ [diff]) := by + rw [show work₁ resultIdx = + (work₀ resultIdx).writeAndMove (Γw.ofBool diff).toΓ + Dir3.right by + simp [work₁, binaryRippleSubScanAdvanceWork]] + rw [Γw.ofBool_toΓ] + exact Tape.hasBinaryPrefix_write_bit diff hresult + have hresultStart₁ : (work₁ resultIdx).cells 0 = Γ.start := by + rw [show work₁ resultIdx = + (work₀ resultIdx).writeAndMove (Γw.ofBool diff).toΓ + Dir3.right by + simp [work₁, binaryRippleSubScanAdvanceWork]] + rw [Γw.ofBool_toΓ] + exact Tape.hasBinaryPrefix_write_bit_cell0 diff hresult hresultStart + have hother₁ : ∀ i, i ≠ lhsIdx → i ≠ rhsIdx → i ≠ resultIdx → + (work₁ i).read ≠ Γ.start := by + intro i hil hir hires + simpa [work₁, binaryRippleSubScanAdvanceWork, hil, hir, hires] using + hother i hil hir hires + have htailLength : lhsTail.length + rhsTail.length < total := by + simp only [List.length_cons] at hlength + omega + obtain ⟨c', hreach, hstate, hfinalInput, hfinalLhs, + hfinalLhsHead, hfinalRhs, hfinalRhsHead, hfinalResult, + hfinalResultHead, hfinalResultStart, hfinalOther, hfinalOutput⟩ := + ih (lhsTail.length + rhsTail.length) htailLength nextBorrow lhsTail + rhsTail (emitted ++ [diff]) inp₀ work₁ out₀ hlhs₁ hrhs₁ + hresult₁ hresultStart₁ hinput hother₁ houtput rfl + refine ⟨c', ?_, ?_, hfinalInput, ?_, ?_, ?_, ?_, ?_, ?_, + hfinalResultStart, ?_, hfinalOutput⟩ + · simpa [binaryRippleSubScanTime, Nat.succ_max_succ] using + TM.reachesIn.step hstep hreach + · simpa [BinaryRippleSub.scan, nextBorrow] using hstate + · simpa [work₁, binaryRippleSubScanAdvanceWork, + hdistinct.lhs_result, hlhsNotBlank, Tape.move_cells] using + hfinalLhs + · rw [hfinalLhsHead] + simp only [work₁, binaryRippleSubScanAdvanceWork, + if_neg hdistinct.lhs_result, if_pos, if_neg hlhsNotBlank, + Tape.move, List.length_cons] + omega + · simpa [work₁, binaryRippleSubScanAdvanceWork, + hdistinct.rhs_result, Ne.symm hdistinct.lhs_rhs, + hrhsNotBlank, Tape.move_cells] using hfinalRhs + · rw [hfinalRhsHead] + simp only [work₁, binaryRippleSubScanAdvanceWork, + if_neg hdistinct.rhs_result, + if_neg (Ne.symm hdistinct.lhs_rhs), if_pos, + if_neg hrhsNotBlank, Tape.move, List.length_cons] + omega + · simpa [BinaryRippleSub.scan, diff, nextBorrow, + List.append_assoc] using hfinalResult + · simpa [BinaryRippleSub.scan, diff, nextBorrow, + List.append_assoc] using hfinalResultHead + · intro i hil hir hires + rw [hfinalOther i hil hir hires] + simp [work₁, binaryRippleSubScanAdvanceWork, hil, hir, hires] + +theorem binaryRippleSubCoreTM_scan_reachesIn_frame_internal {n : ℕ} + (lhsIdx rhsIdx resultIdx : Fin n) + (hdistinct : BinaryRippleSubDistinct lhsIdx rhsIdx resultIdx) + (lhs rhs : List Bool) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hlhs : (work₀ lhsIdx).HasBinaryString lhs) + (hrhs : (work₀ rhsIdx).HasBinaryString rhs) + (hresult : (work₀ resultIdx).HasBinaryPrefix []) + (hresultStart : (work₀ resultIdx).cells 0 = Γ.start) + (hinput : inp₀.read ≠ Γ.start) + (hother : ∀ i, i ≠ lhsIdx → i ≠ rhsIdx → i ≠ resultIdx → + (work₀ i).read ≠ Γ.start) + (houtput : out₀.read ≠ Γ.start) : + let raw := BinaryRippleSub.scan false lhs rhs + ∃ c', + (binaryRippleSubCoreTM lhsIdx rhsIdx resultIdx).reachesIn + (binaryRippleSubScanTime lhs rhs) + { state := (binaryRippleSubCoreTM lhsIdx rhsIdx resultIdx).qstart + input := inp₀ + work := work₀ + output := out₀ } c' ∧ + c'.state = (if raw.borrow then .erase else .trim false) ∧ + c'.input = inp₀ ∧ + (c'.work lhsIdx).cells = (work₀ lhsIdx).cells ∧ + (c'.work lhsIdx).head = lhs.length + 1 ∧ + (c'.work rhsIdx).cells = (work₀ rhsIdx).cells ∧ + (c'.work rhsIdx).head = rhs.length + 1 ∧ + (c'.work resultIdx).HasBinaryContent raw.bits ∧ + (c'.work resultIdx).head = raw.bits.length ∧ + (c'.work resultIdx).cells 0 = Γ.start ∧ + (∀ i, i ≠ lhsIdx → i ≠ rhsIdx → i ≠ resultIdx → + c'.work i = work₀ i) ∧ + c'.output = out₀ := by + dsimp only + obtain ⟨c', hreach, hstate, hfinalInput, hfinalLhs, hfinalLhsHead, + hfinalRhs, hfinalRhsHead, hfinalResult, hfinalResultHead, + hfinalResultStart, hfinalOther, hfinalOutput⟩ := + binaryRippleSubCoreTM_suffix_reachesIn lhsIdx rhsIdx resultIdx hdistinct + false lhs rhs [] inp₀ work₀ out₀ hlhs.hasBinarySuffix + hrhs.hasBinarySuffix hresult hresultStart hinput hother houtput + refine ⟨c', hreach, hstate, hfinalInput, hfinalLhs, ?_, hfinalRhs, ?_, ?_, + ?_, hfinalResultStart, hfinalOther, hfinalOutput⟩ + · simpa [hlhs.1, Nat.add_comm] using hfinalLhsHead + · simpa [hrhs.1, Nat.add_comm] using hfinalRhsHead + · simpa using hfinalResult + · simpa using hfinalResultHead + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleSub/Internal/Sem.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleSub/Internal/Sem.lean new file mode 100644 index 0000000000..6e79a00721 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleSub/Internal/Sem.lean @@ -0,0 +1,334 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleSub.Internal.Backward +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleSub.Internal.Rewind +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleSub.Internal.Scan +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinarySucc + +/-! +# Linear-time canonical binary subtraction -- composed semantics + +This file composes the exact forward borrow scan with its backward +canonicalization pass, then restores both preserved operands through the +checked rewind tail. The complete machine computes natural-number monus, +preserves the external tape frame literally, and carries explicit time and +all-prefix auxiliary-space bounds. +-/ + + +@[expose] public section + +namespace Complexity + +namespace TM + +/-- Postcondition at the end of the core binary ripple-subtraction phase. -/ +def binaryRippleSubCorePost {n : ℕ} + (lhsIdx rhsIdx resultIdx : Fin n) (lhs rhs : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) : TapePred n := + fun inp work out => + inp = inp₀ ∧ + (work lhsIdx).HasBinaryContent lhs.bits ∧ + (work lhsIdx).cells 0 = Γ.start ∧ + (work lhsIdx).head = lhs.size + 1 ∧ + (work rhsIdx).HasBinaryContent rhs.bits ∧ + (work rhsIdx).cells 0 = Γ.start ∧ + (work rhsIdx).head = rhs.size + 1 ∧ + (work resultIdx).HasBinaryNat (lhs - rhs) ∧ + (∀ i, i ≠ lhsIdx → i ≠ rhsIdx → i ≠ resultIdx → + work i = work₀ i) ∧ + out = out₀ + +/-- Postcondition for completed binary ripple subtraction. -/ +def binaryRippleSubPost {n : ℕ} + (lhsIdx rhsIdx resultIdx : Fin n) (lhs rhs : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) : TapePred n := + fun inp work out => + inp = inp₀ ∧ + (work lhsIdx).HasBinaryNat lhs ∧ + (work rhsIdx).HasBinaryNat rhs ∧ + (work resultIdx).HasBinaryNat (lhs - rhs) ∧ + (∀ i, i ≠ lhsIdx → i ≠ rhsIdx → i ≠ resultIdx → + work i = work₀ i) ∧ + out = out₀ + +/-- The direct core executes its forward and backward passes in exactly twice +the larger operand width plus the two turn/bounce transitions. -/ +theorem binaryRippleSubCoreTM_reachesIn_frame_internal {n : ℕ} + (lhsIdx rhsIdx resultIdx : Fin n) + (hdistinct : BinaryRippleSubDistinct lhsIdx rhsIdx resultIdx) + (lhs rhs : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hlhs : (work₀ lhsIdx).HasBinaryNat lhs) + (hrhs : (work₀ rhsIdx).HasBinaryNat rhs) + (hresult : (work₀ resultIdx).HasBinaryNat 0) + (hinput : inp₀.read ≠ Γ.start) + (hother : ∀ i, i ≠ lhsIdx → i ≠ rhsIdx → i ≠ resultIdx → + (work₀ i).read ≠ Γ.start) + (houtput : out₀.read ≠ Γ.start) : + ∃ c', + (binaryRippleSubCoreTM lhsIdx rhsIdx resultIdx).reachesIn + (binaryRippleSubCoreTime lhs.bits rhs.bits) + { state := (binaryRippleSubCoreTM lhsIdx rhsIdx resultIdx).qstart + input := inp₀ + work := work₀ + output := out₀ } c' ∧ + (binaryRippleSubCoreTM lhsIdx rhsIdx resultIdx).halted c' ∧ + binaryRippleSubCorePost lhsIdx rhsIdx resultIdx lhs rhs inp₀ work₀ out₀ + c'.input c'.work c'.output := by + let raw := BinaryRippleSub.scan false lhs.bits rhs.bits + have hresultPrefix : (work₀ resultIdx).HasBinaryPrefix [] := by + simpa [Tape.HasBinaryString, Tape.HasBinaryPrefix] using hresult.2 + obtain ⟨c₁, hscanReach, hscanState, hscanInput, hscanLhsCells, + hscanLhsHead, hscanRhsCells, hscanRhsHead, hscanResult, + hscanResultHead, hscanResultStart, hscanOther, hscanOutput⟩ := + binaryRippleSubCoreTM_scan_reachesIn_frame_internal + lhsIdx rhsIdx resultIdx hdistinct lhs.bits rhs.bits inp₀ work₀ out₀ + hlhs.2 hrhs.2 hresultPrefix hresult.1 hinput hother houtput + have hscanLhsContent : (c₁.work lhsIdx).HasBinaryContent lhs.bits := by + simpa only [Tape.HasBinaryContent, hscanLhsCells] using + hlhs.2.hasBinaryContent + have hscanRhsContent : (c₁.work rhsIdx).HasBinaryContent rhs.bits := by + simpa only [Tape.HasBinaryContent, hscanRhsCells] using + hrhs.2.hasBinaryContent + have hcleanupOther : ∀ i, i ≠ resultIdx → + (c₁.work i).read ≠ Γ.start := by + intro i hires + by_cases hil : i = lhsIdx + · subst i + exact hscanLhsContent.cells_ne_start _ (by rw [hscanLhsHead]; omega) + by_cases hir : i = rhsIdx + · subst i + exact hscanRhsContent.cells_ne_start _ (by rw [hscanRhsHead]; omega) + · rw [hscanOther i hil hir hires] + exact hother i hil hir hires + obtain ⟨c₂, hcleanupReach, hcleanupHalt, hcleanupInput, + hcleanupOtherEq, hcleanupResult, hcleanupResultStart, hcleanupOutput⟩ := + binaryRippleSubCoreTM_cleanup_run_internal lhsIdx rhsIdx resultIdx raw.bits + raw.borrow c₁.input c₁.work c₁.output + (hscanInput.symm ▸ hinput) hcleanupOther + (hscanOutput.symm ▸ houtput) hscanResult hscanResultStart hscanResultHead + have hcleanupStart : + ({ state := if raw.borrow then .erase else .trim false + input := c₁.input + work := c₁.work + output := c₁.output } : + Cfg n (binaryRippleSubCoreTM lhsIdx rhsIdx resultIdx).Q) = c₁ := by + exact Cfg.ext hscanState.symm rfl rfl rfl + rw [hcleanupStart] at hcleanupReach + have hrun := (binaryRippleSubCoreTM lhsIdx rhsIdx resultIdx).reachesIn_trans + hscanReach hcleanupReach + have htime : binaryRippleSubScanTime lhs.bits rhs.bits + + (raw.bits.length + 1) = binaryRippleSubCoreTime lhs.bits rhs.bits := by + have hrawLength : raw.bits.length = max lhs.bits.length rhs.bits.length := by + simpa [raw] using BinaryRippleSub.scan_bits_length_internal + false lhs.bits rhs.bits + rw [hrawLength] + simp only [binaryRippleSubScanTime, binaryRippleSubCoreTime] + omega + have hfinalLhs : c₂.work lhsIdx = c₁.work lhsIdx := + hcleanupOtherEq lhsIdx hdistinct.lhs_result + have hfinalRhs : c₂.work rhsIdx = c₁.work rhsIdx := + hcleanupOtherEq rhsIdx hdistinct.rhs_result + have hfinalResult : (c₂.work resultIdx).HasBinaryNat (lhs - rhs) := by + refine ⟨hcleanupResultStart, ?_⟩ + have hresultBits : + (if raw.borrow then [] else BinaryRippleSub.trimHighZeros raw.bits) = + (lhs - rhs).bits := by + simpa only [BinaryRippleSub.subtract, raw] using + BinaryRippleSub.subtract_natBits_internal lhs rhs + rw [← hresultBits] + exact hcleanupResult + refine ⟨c₂, ?_, hcleanupHalt, ?_⟩ + · simpa [htime] using hrun + · refine ⟨hcleanupInput.trans hscanInput, ?_, ?_, ?_, ?_, ?_, ?_, + hfinalResult, ?_, hcleanupOutput.trans hscanOutput⟩ + · rw [hfinalLhs] + exact hscanLhsContent + · rw [hfinalLhs, hscanLhsCells] + exact hlhs.1 + · rw [hfinalLhs, hscanLhsHead, Nat.size_eq_bits_len] + · rw [hfinalRhs] + exact hscanRhsContent + · rw [hfinalRhs, hscanRhsCells] + exact hrhs.1 + · rw [hfinalRhs, hscanRhsHead, Nat.size_eq_bits_len] + · intro i hil hir hires + exact (hcleanupOtherEq i hires).trans (hscanOther i hil hir hires) + +/-- Hoare-time form of the exact direct-core execution. -/ +theorem binaryRippleSubCoreTM_hoareTime_frame_internal {n : ℕ} + (lhsIdx rhsIdx resultIdx : Fin n) + (hdistinct : BinaryRippleSubDistinct lhsIdx rhsIdx resultIdx) + (lhs rhs : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hlhs : (work₀ lhsIdx).HasBinaryNat lhs) + (hrhs : (work₀ rhsIdx).HasBinaryNat rhs) + (hresult : (work₀ resultIdx).HasBinaryNat 0) + (hinput : inp₀.read ≠ Γ.start) + (hother : ∀ i, i ≠ lhsIdx → i ≠ rhsIdx → i ≠ resultIdx → + (work₀ i).read ≠ Γ.start) + (houtput : out₀.read ≠ Γ.start) : + (binaryRippleSubCoreTM lhsIdx rhsIdx resultIdx).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (binaryRippleSubCorePost lhsIdx rhsIdx resultIdx lhs rhs inp₀ work₀ out₀) + (binaryRippleSubCoreTime lhs.bits rhs.bits) := by + rintro inp work out ⟨hinputEq, hworkEq, houtputEq⟩ + subst inp + subst work + subst out + obtain ⟨c', hreach, hhalt, hpost⟩ := + binaryRippleSubCoreTM_reachesIn_frame_internal lhsIdx rhsIdx resultIdx + hdistinct lhs rhs inp₀ work₀ out₀ hlhs hrhs hresult hinput hother + houtput + exact ⟨c', binaryRippleSubCoreTime lhs.bits rhs.bits, le_rfl, + hreach, hhalt, hpost⟩ + +private theorem binaryRippleSubRewindTail_hoareTime_internal {n : ℕ} + (lhsIdx rhsIdx resultIdx : Fin n) + (hdistinct : BinaryRippleSubDistinct lhsIdx rhsIdx resultIdx) + (lhs rhs : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hinput : Parked inp₀) + (hother : ∀ i, i ≠ lhsIdx → i ≠ rhsIdx → i ≠ resultIdx → + Parked (work₀ i)) + (houtput : Parked out₀) : + (seqTM (rewindWorkTM lhsIdx) (rewindWorkTM rhsIdx)).HoareTime + (binaryRippleSubCorePost lhsIdx rhsIdx resultIdx lhs rhs inp₀ work₀ out₀) + (binaryRippleSubPost lhsIdx rhsIdx resultIdx lhs rhs inp₀ work₀ out₀) + ((lhs.size + 1) + (rhs.size + 1) + 5) := by + intro inp work out hpre + rcases hpre with ⟨hinp, hlhs, hlhsStart, hlhsHead, hrhs, hrhsStart, + hrhsHead, hresult, hframe, hout⟩ + have hresultParked : Parked (work resultIdx) := + ⟨by rw [hresult.2.1], hresult.2.hasBinaryContent.cells_ne_start⟩ + have hrewind := binaryRippleSubRewindTM_hoareTime_frame_internal + lhsIdx rhsIdx resultIdx hdistinct lhs.bits rhs.bits + (lhs.size + 1) (rhs.size + 1) inp work out hlhs hlhsStart + ⟨by rw [hlhsHead]; omega, by rw [hlhsHead]⟩ + hrhs hrhsStart ⟨by rw [hrhsHead]; omega, by rw [hrhsHead]⟩ + hresultParked (hinp.symm ▸ hinput) + (fun i hil hir hires => by + rw [hframe i hil hir hires] + exact hother i hil hir hires) + (hout.symm ▸ houtput) + obtain ⟨c', time, htime, hreach, hhalt, hfinalInput, hfinalLhs, + hfinalRhs, hfinalResult, hfinalOther, hfinalOutput⟩ := + hrewind inp work out ⟨rfl, rfl, rfl⟩ + refine ⟨c', time, htime, hreach, hhalt, ?_⟩ + refine ⟨hfinalInput.trans hinp, ?_, ?_, ?_, ?_, hfinalOutput.trans hout⟩ + · rw [hfinalLhs] + exact Tape.init_move_right_hasBinaryNat lhs + · rw [hfinalRhs] + exact Tape.init_move_right_hasBinaryNat rhs + · rw [hfinalResult] + exact hresult + · intro i hil hir hires + exact (hfinalOther i hil hir hires).trans (hframe i hil hir hires) + +/-- The complete direct subtraction machine restores both operands and returns +canonical natural-number monus within the advertised width-linear bound. -/ +theorem binaryRippleSubTM_hoareTime_frame_internal {n : ℕ} + (lhsIdx rhsIdx resultIdx : Fin n) + (hdistinct : BinaryRippleSubDistinct lhsIdx rhsIdx resultIdx) + (lhs rhs : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hlhs : (work₀ lhsIdx).HasBinaryNat lhs) + (hrhs : (work₀ rhsIdx).HasBinaryNat rhs) + (hresult : (work₀ resultIdx).HasBinaryNat 0) + (hinput : Parked inp₀) + (hother : ∀ i, i ≠ lhsIdx → i ≠ rhsIdx → i ≠ resultIdx → + Parked (work₀ i)) + (houtput : Parked out₀) : + (binaryRippleSubTM lhsIdx rhsIdx resultIdx).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (binaryRippleSubPost lhsIdx rhsIdx resultIdx lhs rhs inp₀ work₀ out₀) + (binaryRippleSubTime lhs rhs) := by + have hcore := binaryRippleSubCoreTM_hoareTime_frame_internal + lhsIdx rhsIdx resultIdx hdistinct lhs rhs inp₀ work₀ out₀ hlhs hrhs + hresult hinput.read_ne_start + (fun i hil hir hires => (hother i hil hir hires).read_ne_start) + houtput.read_ne_start + have htail := binaryRippleSubRewindTail_hoareTime_internal + lhsIdx rhsIdx resultIdx hdistinct lhs rhs inp₀ work₀ out₀ + hinput hother houtput + have htransition : ∀ inp work out, + binaryRippleSubCorePost lhsIdx rhsIdx resultIdx lhs rhs inp₀ work₀ out₀ + inp work out → + binaryRippleSubCorePost lhsIdx rhsIdx resultIdx lhs rhs inp₀ work₀ out₀ + (transitionInput inp) (fun i => transitionTape (work i)) + (transitionTape out) := by + intro inp work out hpost + rcases hpost with ⟨hinp, hlhsContent, hlhsStart, hlhsHead, + hrhsContent, hrhsStart, hrhsHead, hresultNat, hframe, hout⟩ + have hworkRead : ∀ i, (work i).read ≠ Γ.start := by + intro i + by_cases hil : i = lhsIdx + · subst i + exact hlhsContent.cells_ne_start _ (by rw [hlhsHead]; omega) + by_cases hir : i = rhsIdx + · subst i + exact hrhsContent.cells_ne_start _ (by rw [hrhsHead]; omega) + by_cases hires : i = resultIdx + · subst i + exact hresultNat.2.hasBinaryContent.cells_ne_start _ (by + rw [hresultNat.2.1]) + · rw [hframe i hil hir hires] + exact (hother i hil hir hires).read_ne_start + obtain ⟨hinputTransition, hworkTransition, houtputTransition⟩ := + phaseTransition_eq_self_of_reads_ne_start + (hinp.symm ▸ hinput.read_ne_start) hworkRead + (hout.symm ▸ houtput.read_ne_start) + rw [hinputTransition, hworkTransition, houtputTransition] + exact ⟨hinp, hlhsContent, hlhsStart, hlhsHead, hrhsContent, hrhsStart, + hrhsHead, hresultNat, hframe, hout⟩ + have hrun := seqTM_hoareTime + (binaryRippleSubCoreTM lhsIdx rhsIdx resultIdx) + (seqTM (rewindWorkTM lhsIdx) (rewindWorkTM rhsIdx)) + hcore htransition htail + unfold binaryRippleSubTM + apply hrun.mono_bound + rw [binaryRippleSubCoreTime_natBits_internal] + simp only [binaryRippleSubTime] + omega + +/-- Time-and-space contract for complete direct subtraction. The generic +all-prefix envelope charges at most one additional cell per possible step. -/ +theorem binaryRippleSubTM_hoareTimeSpace_frame_internal {n : ℕ} + (lhsIdx rhsIdx resultIdx : Fin n) + (hdistinct : BinaryRippleSubDistinct lhsIdx rhsIdx resultIdx) + (lhs rhs inputLength initialSpace : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hlhs : (work₀ lhsIdx).HasBinaryNat lhs) + (hrhs : (work₀ rhsIdx).HasBinaryNat rhs) + (hresult : (work₀ resultIdx).HasBinaryNat 0) + (hinput : Parked inp₀) + (hother : ∀ i, i ≠ lhsIdx → i ≠ rhsIdx → i ≠ resultIdx → + Parked (work₀ i)) + (houtput : Parked out₀) + (hinitial : + ({ state := (binaryRippleSubTM lhsIdx rhsIdx resultIdx).qstart + input := inp₀ + work := work₀ + output := out₀ } : + Cfg n (binaryRippleSubTM lhsIdx rhsIdx resultIdx).Q).WithinAuxSpace + inputLength initialSpace) : + (binaryRippleSubTM lhsIdx rhsIdx resultIdx).HoareTimeSpace + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (binaryRippleSubPost lhsIdx rhsIdx resultIdx lhs rhs inp₀ work₀ out₀) + (binaryRippleSubTime lhs rhs) inputLength + (initialSpace + binaryRippleSubTime lhs rhs) := by + apply (binaryRippleSubTM_hoareTime_frame_internal lhsIdx rhsIdx resultIdx + hdistinct lhs rhs inp₀ work₀ out₀ hlhs hrhs hresult hinput hother + houtput).toHoareTimeSpace + rintro inp work out ⟨rfl, rfl, rfl⟩ + exact hinitial + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryShiftMul.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryShiftMul.lean new file mode 100644 index 0000000000..ec917c3552 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryShiftMul.lean @@ -0,0 +1,173 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryShiftMul.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryShiftMul.Internal.Out +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryShiftMul.Internal.Pure +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryShiftMul.Internal.Sem + +/-! +# Width-driven binary shift-and-add multiplication + +This module exposes a concrete six-work-tape multiplier. It preserves two +canonical little-endian operands, writes their product to an initially-zero +accumulator, restores every owned head to cell one, clears three scratch tapes, +and preserves the complete external tape frame. Its running time is quadratic +in the combined operand width. +-/ + + +public section + +namespace Complexity + +namespace BinaryShiftMul + +/-- The generalized shift-and-add fold has its closed arithmetic form. -/ +theorem fold_eq (bits : List Bool) (acc shift : ℕ) : + fold bits acc shift = + (acc + shift * Nat.fromBitsLE bits, shift * 2 ^ bits.length) := + fold_eq_internal bits acc shift + +/-- Folding all canonical multiplier bits computes multiplication. -/ +theorem fold_natBits (lhs rhs : ℕ) : + fold rhs.bits 0 lhs = (lhs * rhs, lhs * 2 ^ rhs.size) := + fold_natBits_internal lhs rhs + +/-- Binary multiplication produces at most the sum of the operand widths. -/ +theorem size_mul_le_add (lhs rhs : ℕ) : + (lhs * rhs).size ≤ lhs.size + rhs.size := + size_mul_le_add_internal lhs rhs + +end BinaryShiftMul + +namespace TM + +/-- The audited multiplier budget is quadratic in combined input width. -/ +theorem binaryShiftMulTime_eq (lhs rhs : ℕ) : + binaryShiftMulTime lhs rhs = + 33 * binaryShiftMulWidth lhs rhs ^ 2 + + 170 * binaryShiftMulWidth lhs rhs + 58 := + rfl + +/-- Framed time contract for canonical binary multiplication. Both operands +are restored, the accumulator becomes their product, every scratch tape is +reset to zero, and all unrelated tapes are preserved exactly. -/ +theorem binaryShiftMulTM_hoareTime_frame {n : ℕ} + (abi : BinaryShiftMulABI n) (lhs rhs : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hlhs : (work₀ abi.lhs).HasBinaryNat lhs) + (hrhs : (work₀ abi.rhs).HasBinaryNat rhs) + (hacc : (work₀ abi.acc).HasBinaryNat 0) + (hshift : (work₀ abi.shift).HasBinaryNat 0) + (htmp : (work₀ abi.tmp).HasBinaryNat 0) + (hdbl : (work₀ abi.dbl).HasBinaryNat 0) + (hinput : Parked inp₀) (hwork : ∀ i, Parked (work₀ i)) + (houtput : Parked out₀) : + (binaryShiftMulTM abi).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + (work abi.lhs).HasBinaryNat lhs ∧ + (work abi.rhs).HasBinaryNat rhs ∧ + (work abi.acc).HasBinaryNat (lhs * rhs) ∧ + (work abi.shift).HasBinaryNat 0 ∧ + (work abi.tmp).HasBinaryNat 0 ∧ + (work abi.dbl).HasBinaryNat 0 ∧ + (∀ i, i ≠ abi.lhs → i ≠ abi.rhs → i ≠ abi.acc → + i ≠ abi.shift → i ≠ abi.tmp → i ≠ abi.dbl → + work i = work₀ i) ∧ + out = out₀) + (binaryShiftMulTime lhs rhs) := + binaryShiftMulTM_hoareTime_frame_internal abi lhs rhs inp₀ work₀ out₀ + hlhs hrhs hacc hshift htmp hdbl hinput hwork houtput + +/-- Reachability form of the framed multiplication theorem. -/ +theorem binaryShiftMulTM_reachesIn_frame {n : ℕ} + (abi : BinaryShiftMulABI n) (lhs rhs : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hlhs : (work₀ abi.lhs).HasBinaryNat lhs) + (hrhs : (work₀ abi.rhs).HasBinaryNat rhs) + (hacc : (work₀ abi.acc).HasBinaryNat 0) + (hshift : (work₀ abi.shift).HasBinaryNat 0) + (htmp : (work₀ abi.tmp).HasBinaryNat 0) + (hdbl : (work₀ abi.dbl).HasBinaryNat 0) + (hinput : Parked inp₀) (hwork : ∀ i, Parked (work₀ i)) + (houtput : Parked out₀) : + ∃ c' time, + time ≤ binaryShiftMulTime lhs rhs ∧ + (binaryShiftMulTM abi).reachesIn time + { state := (binaryShiftMulTM abi).qstart + input := inp₀ + work := work₀ + output := out₀ } c' ∧ + (binaryShiftMulTM abi).halted c' ∧ + c'.input = inp₀ ∧ + (c'.work abi.lhs).HasBinaryNat lhs ∧ + (c'.work abi.rhs).HasBinaryNat rhs ∧ + (c'.work abi.acc).HasBinaryNat (lhs * rhs) ∧ + (c'.work abi.shift).HasBinaryNat 0 ∧ + (c'.work abi.tmp).HasBinaryNat 0 ∧ + (c'.work abi.dbl).HasBinaryNat 0 ∧ + (∀ i, i ≠ abi.lhs → i ≠ abi.rhs → i ≠ abi.acc → + i ≠ abi.shift → i ≠ abi.tmp → i ≠ abi.dbl → + c'.work i = work₀ i) ∧ + c'.output = out₀ := by + exact binaryShiftMulTM_hoareTime_frame abi lhs rhs inp₀ work₀ out₀ + hlhs hrhs hacc hshift htmp hdbl hinput hwork houtput + inp₀ work₀ out₀ ⟨rfl, rfl, rfl⟩ + +/-- All-prefix auxiliary-space contract obtained from the concrete quadratic +time envelope. -/ +theorem binaryShiftMulTM_hoareTimeSpace_frame {n : ℕ} + (abi : BinaryShiftMulABI n) (lhs rhs inputLength initialSpace : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hlhs : (work₀ abi.lhs).HasBinaryNat lhs) + (hrhs : (work₀ abi.rhs).HasBinaryNat rhs) + (hacc : (work₀ abi.acc).HasBinaryNat 0) + (hshift : (work₀ abi.shift).HasBinaryNat 0) + (htmp : (work₀ abi.tmp).HasBinaryNat 0) + (hdbl : (work₀ abi.dbl).HasBinaryNat 0) + (hinput : Parked inp₀) (hwork : ∀ i, Parked (work₀ i)) + (houtput : Parked out₀) + (hinitial : + ({ state := (binaryShiftMulTM abi).qstart + input := inp₀ + work := work₀ + output := out₀ } : + Cfg n (binaryShiftMulTM abi).Q).WithinAuxSpace + inputLength initialSpace) : + (binaryShiftMulTM abi).HoareTimeSpace + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + (work abi.lhs).HasBinaryNat lhs ∧ + (work abi.rhs).HasBinaryNat rhs ∧ + (work abi.acc).HasBinaryNat (lhs * rhs) ∧ + (work abi.shift).HasBinaryNat 0 ∧ + (work abi.tmp).HasBinaryNat 0 ∧ + (work abi.dbl).HasBinaryNat 0 ∧ + (∀ i, i ≠ abi.lhs → i ≠ abi.rhs → i ≠ abi.acc → + i ≠ abi.shift → i ≠ abi.tmp → i ≠ abi.dbl → + work i = work₀ i) ∧ + out = out₀) + (binaryShiftMulTime lhs rhs) inputLength + (initialSpace + binaryShiftMulTime lhs rhs) := + binaryShiftMulTM_hoareTimeSpace_frame_internal abi lhs rhs inputLength + initialSpace inp₀ work₀ out₀ hlhs hrhs hacc hshift htmp hdbl hinput + hwork houtput hinitial + +/-- Canonical shift-and-add multiplication never moves the public output head +left. -/ +theorem binaryShiftMulTM_isTransducer {n : ℕ} + (abi : BinaryShiftMulABI n) : + (binaryShiftMulTM abi).IsTransducer := + binaryShiftMulTM_isTransducer_internal abi + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryShiftMul/Defs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryShiftMul/Defs.lean new file mode 100644 index 0000000000..475d7592af --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryShiftMul/Defs.lean @@ -0,0 +1,210 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.ForBinaryWork.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.WorkSymbolBranch.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryCopy.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.ResetBinaryMany.Defs +public import LeanPool.BeyondBethe.Complexitylib.Mathlib.NatBits + +/-! +# Width-driven binary shift-and-add multiplication -- definitions + +This module defines a six-work-tape multiplication ABI and a concrete +least-significant-bit-first shift-and-add machine. The multiplicands are +preserved, the accumulator receives their product, and three scratch tapes are +returned to canonical zero. +-/ + + +@[expose] public section + +namespace Complexity + +namespace BinaryShiftMul + +/-- One pure shift-and-add iteration. The first component is the partial +accumulator and the second is the current shifted multiplicand. -/ +def step (bit : Bool) (acc shift : ℕ) : ℕ × ℕ := + (if bit then acc + shift else acc, 2 * shift) + +/-- Fold little-endian multiplier bits through generalized initial accumulator +and shift values. -/ +def fold : List Bool → ℕ → ℕ → ℕ × ℕ + | [], acc, shift => (acc, shift) + | bit :: bits, acc, shift => + let next := step bit acc shift + fold bits next.1 next.2 + +/-- Accumulator value after the first `i` little-endian multiplier bits. -/ +def partialAcc (lhs rhs i : ℕ) : ℕ := + lhs * Nat.fromBitsLE (rhs.bits.take i) + +/-- Shifted multiplicand after `i` iterations. -/ +def partialShift (lhs i : ℕ) : ℕ := + lhs * 2 ^ i + +end BinaryShiftMul + +namespace TM + +/-- Compact injective assignment of the six multiplication roles to work +tapes. Injectivity makes every pair of roles structurally distinct. -/ +structure BinaryShiftMulABI (n : ℕ) where + /-- Injective map from semantic roles to physical work tapes. -/ + tape : Fin 6 ↪ Fin n + +/-- Preserved multiplicand tape. -/ +def BinaryShiftMulABI.lhs {n : ℕ} (abi : BinaryShiftMulABI n) : Fin n := + abi.tape 0 + +/-- Preserved multiplier and loop-driver tape. -/ +def BinaryShiftMulABI.rhs {n : ℕ} (abi : BinaryShiftMulABI n) : Fin n := + abi.tape 1 + +/-- Initially-zero output accumulator tape. -/ +def BinaryShiftMulABI.acc {n : ℕ} (abi : BinaryShiftMulABI n) : Fin n := + abi.tape 2 + +/-- Current shifted multiplicand tape. -/ +def BinaryShiftMulABI.shift {n : ℕ} (abi : BinaryShiftMulABI n) : Fin n := + abi.tape 3 + +/-- First alternating zero scratch tape. -/ +def BinaryShiftMulABI.tmp {n : ℕ} (abi : BinaryShiftMulABI n) : Fin n := + abi.tape 4 + +/-- Second alternating zero scratch tape. -/ +def BinaryShiftMulABI.dbl {n : ℕ} (abi : BinaryShiftMulABI n) : Fin n := + abi.tape 5 + +/-- Distinct ABI slots map to distinct work tapes. -/ +theorem BinaryShiftMulABI.tape_ne {n : ℕ} (abi : BinaryShiftMulABI n) + {first second : Fin 6} (hne : first ≠ second) : + abi.tape first ≠ abi.tape second := by + exact fun heq => hne (abi.tape.injective heq) + +@[simp] theorem BinaryShiftMulABI.lhs_ne_rhs {n : ℕ} + (abi : BinaryShiftMulABI n) : abi.lhs ≠ abi.rhs := + abi.tape_ne (by decide) + +@[simp] theorem BinaryShiftMulABI.lhs_ne_acc {n : ℕ} + (abi : BinaryShiftMulABI n) : abi.lhs ≠ abi.acc := + abi.tape_ne (by decide) + +@[simp] theorem BinaryShiftMulABI.lhs_ne_shift {n : ℕ} + (abi : BinaryShiftMulABI n) : abi.lhs ≠ abi.shift := + abi.tape_ne (by decide) + +@[simp] theorem BinaryShiftMulABI.lhs_ne_tmp {n : ℕ} + (abi : BinaryShiftMulABI n) : abi.lhs ≠ abi.tmp := + abi.tape_ne (by decide) + +@[simp] theorem BinaryShiftMulABI.lhs_ne_dbl {n : ℕ} + (abi : BinaryShiftMulABI n) : abi.lhs ≠ abi.dbl := + abi.tape_ne (by decide) + +@[simp] theorem BinaryShiftMulABI.rhs_ne_acc {n : ℕ} + (abi : BinaryShiftMulABI n) : abi.rhs ≠ abi.acc := + abi.tape_ne (by decide) + +@[simp] theorem BinaryShiftMulABI.rhs_ne_shift {n : ℕ} + (abi : BinaryShiftMulABI n) : abi.rhs ≠ abi.shift := + abi.tape_ne (by decide) + +@[simp] theorem BinaryShiftMulABI.rhs_ne_tmp {n : ℕ} + (abi : BinaryShiftMulABI n) : abi.rhs ≠ abi.tmp := + abi.tape_ne (by decide) + +@[simp] theorem BinaryShiftMulABI.rhs_ne_dbl {n : ℕ} + (abi : BinaryShiftMulABI n) : abi.rhs ≠ abi.dbl := + abi.tape_ne (by decide) + +@[simp] theorem BinaryShiftMulABI.acc_ne_shift {n : ℕ} + (abi : BinaryShiftMulABI n) : abi.acc ≠ abi.shift := + abi.tape_ne (by decide) + +@[simp] theorem BinaryShiftMulABI.acc_ne_tmp {n : ℕ} + (abi : BinaryShiftMulABI n) : abi.acc ≠ abi.tmp := + abi.tape_ne (by decide) + +@[simp] theorem BinaryShiftMulABI.acc_ne_dbl {n : ℕ} + (abi : BinaryShiftMulABI n) : abi.acc ≠ abi.dbl := + abi.tape_ne (by decide) + +@[simp] theorem BinaryShiftMulABI.shift_ne_tmp {n : ℕ} + (abi : BinaryShiftMulABI n) : abi.shift ≠ abi.tmp := + abi.tape_ne (by decide) + +@[simp] theorem BinaryShiftMulABI.shift_ne_dbl {n : ℕ} + (abi : BinaryShiftMulABI n) : abi.shift ≠ abi.dbl := + abi.tape_ne (by decide) + +@[simp] theorem BinaryShiftMulABI.tmp_ne_dbl {n : ℕ} + (abi : BinaryShiftMulABI n) : abi.tmp ≠ abi.dbl := + abi.tape_ne (by decide) + +/-- Initialize the shifted multiplicand from `lhs`, using the zero accumulator +as the copy routine's preserved zero scratch. -/ +def binaryShiftMulInitTM {n : ℕ} (abi : BinaryShiftMulABI n) : TM n := + binaryCopyIntoTM abi.lhs abi.shift abi.acc + +/-- Add the current shift into the accumulator. The sum is formed on `tmp`, +copied back through zero scratch `dbl`, and `tmp` is reset. -/ +def binaryShiftMulUpdateTM {n : ℕ} (abi : BinaryShiftMulABI n) : TM n := + seqTM (binaryRippleAddTM abi.acc abi.shift abi.tmp) + (seqTM (binaryCopyIntoTM abi.tmp abi.acc abi.dbl) + (resetBinaryWorkTM abi.tmp)) + +/-- Double `shift`. A copy on `tmp` is added back into `dbl`; after alternating +copy-back and resets, `shift` contains twice its old value and both scratch +tapes are zero. -/ +def binaryShiftMulDoubleTM {n : ℕ} (abi : BinaryShiftMulABI n) : TM n := + seqTM (binaryCopyIntoTM abi.shift abi.tmp abi.dbl) + (seqTM (binaryRippleAddTM abi.shift abi.tmp abi.dbl) + (seqTM (resetBinaryWorkTM abi.tmp) + (seqTM (binaryCopyIntoTM abi.dbl abi.shift abi.tmp) + (resetBinaryWorkTM abi.dbl)))) + +/-- Execute the conditional add and then the unconditional doubling step. -/ +def binaryShiftMulOneTM {n : ℕ} (abi : BinaryShiftMulABI n) : TM n := + seqTM (binaryShiftMulUpdateTM abi) (binaryShiftMulDoubleTM abi) + +/-- Branch on the current multiplier bit. A one performs update-and-double; +every other dispatched Boolean symbol performs only the doubling step. -/ +def binaryShiftMulBitBodyTM {n : ℕ} (abi : BinaryShiftMulABI n) : TM n := + branchWorkSymbolTM abi.rhs Γ.one + (binaryShiftMulOneTM abi) (binaryShiftMulDoubleTM abi) + +/-- Iterate once per canonical bit on the preserved multiplier tape. -/ +def binaryShiftMulLoopTM {n : ℕ} (abi : BinaryShiftMulABI n) : TM n := + forBinaryWorkTM abi.rhs (binaryShiftMulBitBodyTM abi) + +/-- Restore the multiplier head and reset every non-output scratch tape. -/ +def binaryShiftMulCleanupTM {n : ℕ} (abi : BinaryShiftMulABI n) : TM n := + seqTM (rewindWorkTM abi.rhs) + (resetBinaryWorkManyTM [abi.shift, abi.tmp, abi.dbl]) + +/-- Initialize, scan the multiplier, and clean up the six-tape shift-and-add +implementation. -/ +def binaryShiftMulTM {n : ℕ} (abi : BinaryShiftMulABI n) : TM n := + seqTM (binaryShiftMulInitTM abi) + (seqTM (binaryShiftMulLoopTM abi) (binaryShiftMulCleanupTM abi)) + +/-- Combined input width used by the conservative multiplication budget. -/ +def binaryShiftMulWidth (lhs rhs : ℕ) : ℕ := + lhs.size + rhs.size + +/-- Audited conservative quadratic budget for initialization, all multiplier +iterations, cleanup, and composition seams. -/ +def binaryShiftMulTime (lhs rhs : ℕ) : ℕ := + let width := binaryShiftMulWidth lhs rhs + 33 * width ^ 2 + 170 * width + 58 + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryShiftMul/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryShiftMul/Internal.lean new file mode 100644 index 0000000000..e23f6d7708 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryShiftMul/Internal.lean @@ -0,0 +1,11 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryShiftMul.Internal.Out +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryShiftMul.Internal.Pure +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryShiftMul.Internal.Sem + +/-! Supporting modules for Beyond the Bethe approximation of the permanent. -/ diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryShiftMul/Internal/Out.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryShiftMul/Internal/Out.lean new file mode 100644 index 0000000000..9b5cc0aff9 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryShiftMul/Internal/Out.lean @@ -0,0 +1,66 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.ForBinaryWork +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.WorkSymbolBranch +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryCopy +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryShiftMul.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.ResetBinaryMany + +/-! +# Width-driven binary shift-and-add multiplication -- output safety + +This file composes the transducer certificates of every multiplication phase. +-/ + + +public section + +namespace Complexity + +namespace TM + +private theorem binaryShiftMulUpdateTM_isTransducer {n : ℕ} + (abi : BinaryShiftMulABI n) : + (binaryShiftMulUpdateTM abi).IsTransducer := by + unfold binaryShiftMulUpdateTM + exact (binaryRippleAddTM_isTransducer abi.acc abi.shift abi.tmp).seqTM + ((binaryCopyIntoTM_isTransducer abi.tmp abi.acc abi.dbl).seqTM + (resetBinaryWorkTM_isTransducer abi.tmp)) + +private theorem binaryShiftMulDoubleTM_isTransducer {n : ℕ} + (abi : BinaryShiftMulABI n) : + (binaryShiftMulDoubleTM abi).IsTransducer := by + unfold binaryShiftMulDoubleTM + exact (binaryCopyIntoTM_isTransducer abi.shift abi.tmp abi.dbl).seqTM + ((binaryRippleAddTM_isTransducer abi.shift abi.tmp abi.dbl).seqTM + ((resetBinaryWorkTM_isTransducer abi.tmp).seqTM + ((binaryCopyIntoTM_isTransducer abi.dbl abi.shift abi.tmp).seqTM + (resetBinaryWorkTM_isTransducer abi.dbl)))) + +private theorem binaryShiftMulBitBodyTM_isTransducer {n : ℕ} + (abi : BinaryShiftMulABI n) : + (binaryShiftMulBitBodyTM abi).IsTransducer := by + unfold binaryShiftMulBitBodyTM binaryShiftMulOneTM + exact (binaryShiftMulUpdateTM_isTransducer abi).seqTM + (binaryShiftMulDoubleTM_isTransducer abi) |>.branchWorkSymbolTM + (binaryShiftMulDoubleTM_isTransducer abi) + +/-- Shift-and-add multiplication never moves the public output head left. -/ +theorem binaryShiftMulTM_isTransducer_internal {n : ℕ} + (abi : BinaryShiftMulABI n) : + (binaryShiftMulTM abi).IsTransducer := by + unfold binaryShiftMulTM binaryShiftMulInitTM binaryShiftMulLoopTM + binaryShiftMulCleanupTM + exact (binaryCopyIntoTM_isTransducer abi.lhs abi.shift abi.acc).seqTM + ((binaryShiftMulBitBodyTM_isTransducer abi).forBinaryWorkTM.seqTM + ((rewindWorkTM_isTransducer abi.rhs).seqTM + (resetBinaryWorkManyTM_isTransducer [abi.shift, abi.tmp, abi.dbl]))) + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryShiftMul/Internal/Pure.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryShiftMul/Internal/Pure.lean new file mode 100644 index 0000000000..6c6195187d --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryShiftMul/Internal/Pure.lean @@ -0,0 +1,154 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryShiftMul.Defs +public import Mathlib.Algebra.Order.Ring.Nat +public import Mathlib.Tactic.Ring.RingNF + +/-! +# Width-driven binary shift-and-add multiplication -- pure proofs + +This file proves the generalized arithmetic invariant of the little-endian +shift-and-add fold, its multiplication specialization, and width bounds for +every partial accumulator and shifted multiplicand. +-/ + + +public section + +namespace Complexity + +namespace BinaryShiftMul + +/-- The generalized shift-and-add fold accumulates `shift` times the decoded +bit string and doubles `shift` once per consumed bit. -/ +theorem fold_eq_internal (bits : List Bool) (acc shift : ℕ) : + fold bits acc shift = + (acc + shift * Nat.fromBitsLE bits, shift * 2 ^ bits.length) := by + induction bits generalizing acc shift with + | nil => simp [fold, Nat.fromBitsLE, Nat.fromBits] + | cons bit bits ih => + cases bit <;> + simp [fold, step, ih, Nat.fromBitsLE_cons, pow_succ, + Prod.ext_iff] <;> + constructor <;> ring + +/-- Taking a low-order prefix cannot increase its little-endian decoded +value. -/ +theorem fromBitsLE_take_le_internal (bits : List Bool) (i : ℕ) : + Nat.fromBitsLE (bits.take i) ≤ Nat.fromBitsLE bits := by + induction bits generalizing i with + | nil => simp [Nat.fromBitsLE] + | cons bit bits ih => + cases i with + | zero => + simp only [List.take_zero] + exact Nat.zero_le _ + | succ i => + rw [List.take_succ_cons, Nat.fromBitsLE_cons, + Nat.fromBitsLE_cons] + exact Nat.add_le_add_left (Nat.mul_le_mul_left 2 (ih i)) _ + +/-- If the iteration index is within the canonical multiplier width, folding +its prefix produces the advertised partial accumulator and shift. -/ +theorem fold_take_eq_internal (lhs rhs i : ℕ) (hi : i ≤ rhs.size) : + fold (rhs.bits.take i) 0 lhs = + (partialAcc lhs rhs i, partialShift lhs i) := by + rw [fold_eq_internal] + simp [partialAcc, partialShift, List.length_take, Nat.size_eq_bits_len, + min_eq_left hi] + +private theorem fold_append (xs ys : List Bool) (acc shift : ℕ) : + fold (xs ++ ys) acc shift = + let middle := fold xs acc shift + fold ys middle.1 middle.2 := by + induction xs generalizing acc shift with + | nil => rfl + | cons bit xs ih => + simp only [List.cons_append, fold] + rw [ih] + +/-- One live multiplier bit advances the partial arithmetic invariant by one +iteration. -/ +theorem step_partial_internal (lhs rhs i : ℕ) (hi : i < rhs.size) : + step (rhs.bits.get ⟨i, by simpa [Nat.size_eq_bits_len] using hi⟩) + (partialAcc lhs rhs i) (partialShift lhs i) = + (partialAcc lhs rhs (i + 1), partialShift lhs (i + 1)) := by + have hcurrent := fold_take_eq_internal lhs rhs i (Nat.le_of_lt hi) + have hnext := fold_take_eq_internal lhs rhs (i + 1) (by omega) + rw [List.take_succ_eq_append_getElem (by + simpa [Nat.size_eq_bits_len] using hi), fold_append, hcurrent] at hnext + simpa [fold] using hnext + +/-- Folding all canonical multiplier bits computes multiplication and leaves +the shift advanced by the multiplier width. -/ +theorem fold_natBits_internal (lhs rhs : ℕ) : + fold rhs.bits 0 lhs = (lhs * rhs, lhs * 2 ^ rhs.size) := by + rw [fold_eq_internal, Nat.fromBitsLE_bits, Nat.size_eq_bits_len] + simp + +/-- The complete partial accumulator is the product. -/ +theorem partialAcc_full_internal (lhs rhs : ℕ) : + partialAcc lhs rhs rhs.size = lhs * rhs := by + unfold partialAcc + rw [← Nat.size_eq_bits_len, List.take_length, Nat.fromBitsLE_bits] + +/-- The complete partial shift has advanced by the multiplier width. -/ +theorem partialShift_full_internal (lhs rhs : ℕ) : + partialShift lhs rhs.size = lhs * 2 ^ rhs.size := by + rfl + +/-- The accumulator component of the complete pure fold is the product. -/ +theorem fold_natBits_fst_internal (lhs rhs : ℕ) : + (fold rhs.bits 0 lhs).1 = lhs * rhs := by + rw [fold_natBits_internal] + +/-- Every partial accumulator is bounded by the complete product. -/ +theorem partialAcc_le_mul_internal (lhs rhs i : ℕ) : + partialAcc lhs rhs i ≤ lhs * rhs := by + unfold partialAcc + simpa only [Nat.fromBitsLE_bits] using + Nat.mul_le_mul_left lhs (fromBitsLE_take_le_internal rhs.bits i) + +/-- Binary width is subadditive under multiplication. -/ +theorem size_mul_le_add_internal (lhs rhs : ℕ) : + (lhs * rhs).size ≤ lhs.size + rhs.size := by + by_cases hrhs : rhs = 0 + · simp [hrhs] + rw [Nat.size_le] + calc + lhs * rhs < 2 ^ lhs.size * rhs := + Nat.mul_lt_mul_of_pos_right (Nat.lt_size_self lhs) (Nat.pos_of_ne_zero hrhs) + _ < 2 ^ lhs.size * 2 ^ rhs.size := + Nat.mul_lt_mul_of_pos_left (Nat.lt_size_self rhs) (Nat.two_pow_pos _) + _ = 2 ^ (lhs.size + rhs.size) := by rw [pow_add] + +/-- Every partial accumulator fits in the combined input width. -/ +theorem partialAcc_size_le_width_internal (lhs rhs i : ℕ) : + (partialAcc lhs rhs i).size ≤ lhs.size + rhs.size := by + exact le_trans (Nat.size_le_size (partialAcc_le_mul_internal lhs rhs i)) + (size_mul_le_add_internal lhs rhs) + +/-- Shifting left by `i` grows binary width by at most `i`. -/ +theorem partialShift_size_le_internal (lhs i : ℕ) : + (partialShift lhs i).size ≤ lhs.size + i := by + by_cases hlhs : lhs = 0 + · simp [partialShift, hlhs] + rw [partialShift, ← Nat.shiftLeft_eq_mul_pow, Nat.size_shiftLeft hlhs] + +/-- At any live multiplier iteration, both arithmetic values fit in the +combined input width. -/ +theorem partial_widths_le_internal (lhs rhs i : ℕ) (hi : i ≤ rhs.size) : + (partialAcc lhs rhs i).size ≤ lhs.size + rhs.size ∧ + (partialShift lhs i).size ≤ lhs.size + rhs.size := by + exact ⟨partialAcc_size_le_width_internal lhs rhs i, + le_trans (partialShift_size_le_internal lhs i) + (Nat.add_le_add_left hi lhs.size)⟩ + +end BinaryShiftMul + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryShiftMul/Internal/Sem.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryShiftMul/Internal/Sem.lean new file mode 100644 index 0000000000..5c028ee273 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryShiftMul/Internal/Sem.lean @@ -0,0 +1,1781 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.ForBinaryWork +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.WorkSymbolBranch +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryCopy +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryShiftMul.Internal.Pure +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.ResetBinaryMany + +/-! +# Width-driven binary shift-and-add multiplication -- composed semantics + +This file composes the width-linear copy and ripple-add primitives through a +bit-driven work-tape loop. The multiplier cursor is preserved by every body +phase and advanced only by the loopback seam. +-/ + + +@[expose] public section + +namespace Complexity + +namespace TM + +private def binaryShiftMulNatTape (value : ℕ) : Tape := + (Tape.init (value.bits.map Γ.ofBool)).move Dir3.right + +private theorem binaryShiftMulNatTape_hasBinaryNat (value : ℕ) : + (binaryShiftMulNatTape value).HasBinaryNat value := by + simpa [binaryShiftMulNatTape] using Tape.init_move_right_hasBinaryNat value + +private theorem hasBinaryNat_parked {t : Tape} {value : ℕ} + (h : t.HasBinaryNat value) : Parked t := + ⟨by rw [h.2.1], h.2.hasBinaryContent.cells_ne_start⟩ + +private theorem binaryShiftMulExactFrame_transition {n : ℕ} + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hinput : Parked inp₀) (hwork : ∀ i, Parked (work₀ i)) + (houtput : Parked out₀) : + ∀ inp work out, + (inp = inp₀ ∧ work = work₀ ∧ out = out₀) → + transitionInput inp = inp₀ ∧ + (fun i => transitionTape (work i)) = work₀ ∧ + transitionTape out = out₀ := by + intro inp work out hpre + rcases hpre with ⟨hinp, hworkEq, hout⟩ + subst inp + subst work + subst out + exact phaseTransition_eq_self_of_reads_ne_start hinput.read_ne_start + (fun i => (hwork i).read_ne_start) houtput.read_ne_start + +private def binaryShiftMulUpdateTime (acc shift : ℕ) : ℕ := + binaryRippleAddTime acc shift + 1 + + binaryCopyTime (acc + shift) acc + 1 + + resetBinaryWorkTime 1 (acc + shift).size + +private def binaryShiftMulUpdatePost {n : ℕ} (abi : BinaryShiftMulABI n) + (acc shift : ℕ) (inp₀ : Tape) (work₀ : Fin n → Tape) + (out₀ : Tape) : TapePred n := + fun inp work out => + inp = inp₀ ∧ + (work abi.acc).HasBinaryNat (acc + shift) ∧ + (work abi.shift).HasBinaryNat shift ∧ + (work abi.tmp).HasBinaryNat 0 ∧ + (work abi.dbl).HasBinaryNat 0 ∧ + (∀ i, i ≠ abi.acc → i ≠ abi.shift → i ≠ abi.tmp → i ≠ abi.dbl → + work i = work₀ i) ∧ + out = out₀ + +private theorem binaryShiftMulUpdateTM_hoareTime_frame {n : ℕ} + (abi : BinaryShiftMulABI n) (acc shift : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hacc : (work₀ abi.acc).HasBinaryNat acc) + (hshift : (work₀ abi.shift).HasBinaryNat shift) + (htmp : (work₀ abi.tmp).HasBinaryNat 0) + (hdbl : (work₀ abi.dbl).HasBinaryNat 0) + (hinput : Parked inp₀) (hwork : ∀ i, Parked (work₀ i)) + (houtput : Parked out₀) : + (binaryShiftMulUpdateTM abi).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (binaryShiftMulUpdatePost abi acc shift inp₀ work₀ out₀) + (binaryShiftMulUpdateTime acc shift) := by + have hdistinctAdd : BinaryRippleAddDistinct abi.acc abi.shift abi.tmp := + ⟨abi.acc_ne_shift, abi.acc_ne_tmp, abi.shift_ne_tmp⟩ + have hadd := binaryRippleAddTM_hoareTime_frame abi.acc abi.shift abi.tmp + hdistinctAdd acc shift inp₀ work₀ out₀ hacc hshift htmp hinput + (fun i _ _ _ => hwork i) houtput + let AddPost : TapePred n := fun inp work out => + inp = inp₀ ∧ + (work abi.acc).HasBinaryNat acc ∧ + (work abi.shift).HasBinaryNat shift ∧ + (work abi.tmp).HasBinaryNat (acc + shift) ∧ + (∀ i, i ≠ abi.acc → i ≠ abi.shift → i ≠ abi.tmp → + work i = work₀ i) ∧ + out = out₀ + have hadd' : (binaryRippleAddTM abi.acc abi.shift abi.tmp).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + AddPost (binaryRippleAddTime acc shift) := by + simpa only [AddPost] using hadd + have htail : + (seqTM (binaryCopyIntoTM abi.tmp abi.acc abi.dbl) + (resetBinaryWorkTM abi.tmp)).HoareTime + AddPost (binaryShiftMulUpdatePost abi acc shift inp₀ work₀ out₀) + (binaryCopyTime (acc + shift) acc + 1 + + resetBinaryWorkTime 1 (acc + shift).size) := by + intro inp work out hpre + rcases hpre with ⟨hinp, haccNow, hshiftNow, htmpNow, hframe, hout⟩ + have hworkNow : ∀ i, Parked (work i) := by + intro i + by_cases haccIdx : i = abi.acc + · subst i + exact hasBinaryNat_parked haccNow + by_cases hshiftIdx : i = abi.shift + · subst i + exact hasBinaryNat_parked hshiftNow + by_cases htmpIdx : i = abi.tmp + · subst i + exact hasBinaryNat_parked htmpNow + rw [hframe i haccIdx hshiftIdx htmpIdx] + exact hwork i + have hdblNow : (work abi.dbl).HasBinaryNat 0 := by + rw [hframe abi.dbl abi.acc_ne_dbl.symm abi.shift_ne_dbl.symm + abi.tmp_ne_dbl.symm] + exact hdbl + have hcopy := binaryCopyIntoTM_hoareTime_frame abi.tmp abi.acc abi.dbl + abi.acc_ne_tmp.symm abi.tmp_ne_dbl abi.acc_ne_dbl + (acc + shift) acc inp work out htmpNow haccNow hdblNow + (hinp.symm ▸ hinput) (fun i _ _ _ => hworkNow i) + (hout.symm ▸ houtput) + let work₂ := Function.update work abi.acc + (binaryShiftMulNatTape (acc + shift)) + have hcopy' : (binaryCopyIntoTM abi.tmp abi.acc abi.dbl).HoareTime + (fun inp' work' out' => inp' = inp ∧ work' = work ∧ out' = out) + (fun inp' work' out' => inp' = inp ∧ work' = work₂ ∧ out' = out) + (binaryCopyTime (acc + shift) acc) := by + simpa only [work₂, binaryShiftMulNatTape] using hcopy + have hwork₂ : ∀ i, Parked (work₂ i) := by + intro i + by_cases hi : i = abi.acc + · subst i + simp only [work₂, Function.update_self] + exact hasBinaryNat_parked + (binaryShiftMulNatTape_hasBinaryNat (acc + shift)) + simp only [work₂, Function.update_of_ne hi] + exact hworkNow i + have htmp₂ : (work₂ abi.tmp).HasBinaryNat (acc + shift) := by + simpa only [work₂, Function.update_of_ne abi.acc_ne_tmp.symm] using + htmpNow + have hreset := resetBinaryWorkTM_hoareTime_frame abi.tmp + (acc + shift).bits 1 inp work₂ out htmp₂.2.hasBinaryContent htmp₂.1 + ⟨by rw [htmp₂.2.1], by rw [htmp₂.2.1]⟩ (hinp.symm ▸ hinput) + (fun i _ => hwork₂ i) (hout.symm ▸ houtput) + have htransition : ∀ inp' work' out', + (inp' = inp ∧ work' = work₂ ∧ out' = out) → + (transitionInput inp' = inp ∧ + (fun i => transitionTape (work' i)) = work₂ ∧ + transitionTape out' = out) := by + rintro _ _ _ ⟨rfl, rfl, rfl⟩ + exact phaseTransition_eq_self_of_reads_ne_start + ((hinp.symm ▸ hinput).read_ne_start) + (fun i => (hwork₂ i).read_ne_start) + ((hout.symm ▸ houtput).read_ne_start) + have hrun := seqTM_hoareTime + (binaryCopyIntoTM abi.tmp abi.acc abi.dbl) + (resetBinaryWorkTM abi.tmp) hcopy' htransition hreset + obtain ⟨c', time, htime, hreach, hhalt, hfinalInput, hfinalWork, + hfinalOutput⟩ := hrun inp work out ⟨rfl, rfl, rfl⟩ + refine ⟨c', time, (by simpa [Nat.size_eq_bits_len] using htime), + hreach, hhalt, ?_⟩ + refine ⟨hfinalInput.trans hinp, ?_, ?_, ?_, ?_, ?_, + hfinalOutput.trans hout⟩ + · rw [hfinalWork] + simp only [Function.update_of_ne abi.acc_ne_tmp, + work₂, Function.update_self] + exact binaryShiftMulNatTape_hasBinaryNat (acc + shift) + · rw [hfinalWork] + simp only [Function.update_of_ne abi.shift_ne_tmp, + work₂, Function.update_of_ne abi.acc_ne_shift.symm] + exact hshiftNow + · rw [hfinalWork, Function.update_self] + exact binaryShiftMulNatTape_hasBinaryNat 0 + · rw [hfinalWork] + simp only [Function.update_of_ne abi.tmp_ne_dbl.symm, + work₂, Function.update_of_ne abi.acc_ne_dbl.symm] + exact hdblNow + · intro i haccIdx hshiftIdx htmpIdx hdblIdx + rw [hfinalWork, Function.update_of_ne htmpIdx] + simp only [work₂, Function.update_of_ne haccIdx] + exact hframe i haccIdx hshiftIdx htmpIdx + have htransition : ∀ inp work out, AddPost inp work out → + AddPost (transitionInput inp) (fun i => transitionTape (work i)) + (transitionTape out) := by + intro inp work out hpost + rcases hpost with ⟨hinp, haccNow, hshiftNow, htmpNow, hframe, hout⟩ + have hreads : ∀ i, (work i).read ≠ Γ.start := by + intro i + by_cases haccIdx : i = abi.acc + · subst i + exact (hasBinaryNat_parked haccNow).read_ne_start + by_cases hshiftIdx : i = abi.shift + · subst i + exact (hasBinaryNat_parked hshiftNow).read_ne_start + by_cases htmpIdx : i = abi.tmp + · subst i + exact (hasBinaryNat_parked htmpNow).read_ne_start + rw [hframe i haccIdx hshiftIdx htmpIdx] + exact (hwork i).read_ne_start + obtain ⟨hinputTransition, hworkTransition, houtputTransition⟩ := + phaseTransition_eq_self_of_reads_ne_start + (hinp.symm ▸ hinput.read_ne_start) hreads + (hout.symm ▸ houtput.read_ne_start) + rw [hinputTransition, hworkTransition, houtputTransition] + exact ⟨hinp, haccNow, hshiftNow, htmpNow, hframe, hout⟩ + have hrun := seqTM_hoareTime + (binaryRippleAddTM abi.acc abi.shift abi.tmp) + (seqTM (binaryCopyIntoTM abi.tmp abi.acc abi.dbl) + (resetBinaryWorkTM abi.tmp)) hadd' htransition htail + simpa [binaryShiftMulUpdateTM, binaryShiftMulUpdateTime, + Nat.add_assoc] using hrun + +private def binaryShiftMulDoubleTime (shift : ℕ) : ℕ := + binaryCopyTime shift 0 + 1 + + binaryRippleAddTime shift shift + 1 + + resetBinaryWorkTime 1 shift.size + 1 + + binaryCopyTime (shift + shift) shift + 1 + + resetBinaryWorkTime 1 (shift + shift).size + +private def binaryShiftMulDoublePost {n : ℕ} (abi : BinaryShiftMulABI n) + (shift : ℕ) (inp₀ : Tape) (work₀ : Fin n → Tape) + (out₀ : Tape) : TapePred n := + fun inp work out => + inp = inp₀ ∧ + (work abi.shift).HasBinaryNat (2 * shift) ∧ + (work abi.tmp).HasBinaryNat 0 ∧ + (work abi.dbl).HasBinaryNat 0 ∧ + (∀ i, i ≠ abi.shift → i ≠ abi.tmp → i ≠ abi.dbl → + work i = work₀ i) ∧ + out = out₀ + +private theorem binaryShiftMulDoubleTM_hoareTime_frame {n : ℕ} + (abi : BinaryShiftMulABI n) (shift : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hshift : (work₀ abi.shift).HasBinaryNat shift) + (htmp : (work₀ abi.tmp).HasBinaryNat 0) + (hdbl : (work₀ abi.dbl).HasBinaryNat 0) + (hinput : Parked inp₀) (hwork : ∀ i, Parked (work₀ i)) + (houtput : Parked out₀) : + (binaryShiftMulDoubleTM abi).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (binaryShiftMulDoublePost abi shift inp₀ work₀ out₀) + (binaryShiftMulDoubleTime shift) := by + have hcopy₁ := binaryCopyIntoTM_hoareTime_frame abi.shift abi.tmp abi.dbl + abi.shift_ne_tmp abi.shift_ne_dbl abi.tmp_ne_dbl shift 0 + inp₀ work₀ out₀ hshift htmp hdbl hinput (fun i _ _ _ => hwork i) + houtput + let work₁ := Function.update work₀ abi.tmp (binaryShiftMulNatTape shift) + have hcopy₁' : (binaryCopyIntoTM abi.shift abi.tmp abi.dbl).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => inp = inp₀ ∧ work = work₁ ∧ out = out₀) + (binaryCopyTime shift 0) := by + simpa only [work₁, binaryShiftMulNatTape] using hcopy₁ + have hwork₁ : ∀ i, Parked (work₁ i) := by + intro i + by_cases hi : i = abi.tmp + · subst i + simp only [work₁, Function.update_self] + exact hasBinaryNat_parked (binaryShiftMulNatTape_hasBinaryNat shift) + simp only [work₁, Function.update_of_ne hi] + exact hwork i + have hshift₁ : (work₁ abi.shift).HasBinaryNat shift := by + simpa only [work₁, Function.update_of_ne abi.shift_ne_tmp] using hshift + have htmp₁ : (work₁ abi.tmp).HasBinaryNat shift := by + simp only [work₁, Function.update_self] + exact binaryShiftMulNatTape_hasBinaryNat shift + have hdbl₁ : (work₁ abi.dbl).HasBinaryNat 0 := by + simpa only [work₁, Function.update_of_ne abi.tmp_ne_dbl.symm] using hdbl + let AddPost : TapePred n := fun inp work out => + inp = inp₀ ∧ + (work abi.shift).HasBinaryNat shift ∧ + (work abi.tmp).HasBinaryNat shift ∧ + (work abi.dbl).HasBinaryNat (shift + shift) ∧ + (∀ i, i ≠ abi.shift → i ≠ abi.tmp → i ≠ abi.dbl → + work i = work₁ i) ∧ + out = out₀ + have hdistinctAdd : BinaryRippleAddDistinct abi.shift abi.tmp abi.dbl := + ⟨abi.shift_ne_tmp, abi.shift_ne_dbl, abi.tmp_ne_dbl⟩ + have hadd := binaryRippleAddTM_hoareTime_frame abi.shift abi.tmp abi.dbl + hdistinctAdd shift shift inp₀ work₁ out₀ hshift₁ htmp₁ hdbl₁ + hinput (fun i _ _ _ => hwork₁ i) houtput + have hadd' : (binaryRippleAddTM abi.shift abi.tmp abi.dbl).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₁ ∧ out = out₀) + AddPost (binaryRippleAddTime shift shift) := by + simpa only [AddPost] using hadd + have hfinish : + (seqTM (resetBinaryWorkTM abi.tmp) + (seqTM (binaryCopyIntoTM abi.dbl abi.shift abi.tmp) + (resetBinaryWorkTM abi.dbl))).HoareTime + AddPost (binaryShiftMulDoublePost abi shift inp₀ work₀ out₀) + (resetBinaryWorkTime 1 shift.size + 1 + + (binaryCopyTime (shift + shift) shift + 1 + + resetBinaryWorkTime 1 (shift + shift).size)) := by + intro inp work out hpre + rcases hpre with ⟨hinp, hshiftNow, htmpNow, hdblNow, hframe, hout⟩ + have hworkNow : ∀ i, Parked (work i) := by + intro i + by_cases hshiftIdx : i = abi.shift + · subst i + exact hasBinaryNat_parked hshiftNow + by_cases htmpIdx : i = abi.tmp + · subst i + exact hasBinaryNat_parked htmpNow + by_cases hdblIdx : i = abi.dbl + · subst i + exact hasBinaryNat_parked hdblNow + rw [hframe i hshiftIdx htmpIdx hdblIdx] + exact hwork₁ i + have hresetTmp := resetBinaryWorkTM_hoareTime_frame abi.tmp shift.bits 1 + inp work out htmpNow.2.hasBinaryContent htmpNow.1 + ⟨by rw [htmpNow.2.1], by rw [htmpNow.2.1]⟩ + (hinp.symm ▸ hinput) (fun i _ => hworkNow i) + (hout.symm ▸ houtput) + let work₂ := Function.update work abi.tmp (binaryShiftMulNatTape 0) + have hresetTmp' : (resetBinaryWorkTM abi.tmp).HoareTime + (fun inp' work' out' => inp' = inp ∧ work' = work ∧ out' = out) + (fun inp' work' out' => inp' = inp ∧ work' = work₂ ∧ out' = out) + (resetBinaryWorkTime 1 shift.size) := by + simpa only [work₂, binaryShiftMulNatTape, + Nat.size_eq_bits_len] using hresetTmp + have hwork₂ : ∀ i, Parked (work₂ i) := by + intro i + by_cases hi : i = abi.tmp + · subst i + simp only [work₂, Function.update_self] + exact hasBinaryNat_parked (binaryShiftMulNatTape_hasBinaryNat 0) + simp only [work₂, Function.update_of_ne hi] + exact hworkNow i + have hdbl₂ : (work₂ abi.dbl).HasBinaryNat (shift + shift) := by + simpa only [work₂, Function.update_of_ne abi.tmp_ne_dbl.symm] using + hdblNow + have hshift₂ : (work₂ abi.shift).HasBinaryNat shift := by + simpa only [work₂, Function.update_of_ne abi.shift_ne_tmp] using + hshiftNow + have htmp₂ : (work₂ abi.tmp).HasBinaryNat 0 := by + simp only [work₂, Function.update_self] + exact binaryShiftMulNatTape_hasBinaryNat 0 + have hcopy₂ := binaryCopyIntoTM_hoareTime_frame abi.dbl abi.shift abi.tmp + abi.shift_ne_dbl.symm abi.tmp_ne_dbl.symm abi.shift_ne_tmp + (shift + shift) shift inp work₂ out hdbl₂ hshift₂ htmp₂ + (hinp.symm ▸ hinput) (fun i _ _ _ => hwork₂ i) + (hout.symm ▸ houtput) + let work₃ := Function.update work₂ abi.shift + (binaryShiftMulNatTape (shift + shift)) + have hcopy₂' : (binaryCopyIntoTM abi.dbl abi.shift abi.tmp).HoareTime + (fun inp' work' out' => inp' = inp ∧ work' = work₂ ∧ out' = out) + (fun inp' work' out' => inp' = inp ∧ work' = work₃ ∧ out' = out) + (binaryCopyTime (shift + shift) shift) := by + simpa only [work₃, binaryShiftMulNatTape] using hcopy₂ + have hwork₃ : ∀ i, Parked (work₃ i) := by + intro i + by_cases hi : i = abi.shift + · subst i + simp only [work₃, Function.update_self] + exact hasBinaryNat_parked + (binaryShiftMulNatTape_hasBinaryNat (shift + shift)) + simp only [work₃, Function.update_of_ne hi] + exact hwork₂ i + have hdbl₃ : (work₃ abi.dbl).HasBinaryNat (shift + shift) := by + simpa only [work₃, Function.update_of_ne abi.shift_ne_dbl.symm] using + hdbl₂ + have hresetDbl := resetBinaryWorkTM_hoareTime_frame abi.dbl + (shift + shift).bits 1 inp work₃ out hdbl₃.2.hasBinaryContent hdbl₃.1 + ⟨by rw [hdbl₃.2.1], by rw [hdbl₃.2.1]⟩ + (hinp.symm ▸ hinput) (fun i _ => hwork₃ i) + (hout.symm ▸ houtput) + have hcopyTail := seqTM_hoareTime + (binaryCopyIntoTM abi.dbl abi.shift abi.tmp) + (resetBinaryWorkTM abi.dbl) hcopy₂' + (binaryShiftMulExactFrame_transition inp work₃ out + (hinp.symm ▸ hinput) hwork₃ (hout.symm ▸ houtput)) hresetDbl + have hresetTail := seqTM_hoareTime (resetBinaryWorkTM abi.tmp) + (seqTM (binaryCopyIntoTM abi.dbl abi.shift abi.tmp) + (resetBinaryWorkTM abi.dbl)) hresetTmp' + (binaryShiftMulExactFrame_transition inp work₂ out + (hinp.symm ▸ hinput) hwork₂ (hout.symm ▸ houtput)) hcopyTail + obtain ⟨c', time, htime, hreach, hhalt, hfinalInput, hfinalWork, + hfinalOutput⟩ := hresetTail inp work out ⟨rfl, rfl, rfl⟩ + refine ⟨c', time, (by + simpa [Nat.size_eq_bits_len, Nat.add_assoc] using htime), + hreach, hhalt, ?_⟩ + refine ⟨hfinalInput.trans hinp, ?_, ?_, ?_, ?_, + hfinalOutput.trans hout⟩ + · rw [hfinalWork] + simp only [Function.update_of_ne abi.shift_ne_dbl, + work₃, Function.update_self] + simpa [two_mul] using + binaryShiftMulNatTape_hasBinaryNat (shift + shift) + · rw [hfinalWork] + simp only [Function.update_of_ne abi.tmp_ne_dbl, + work₃, Function.update_of_ne abi.shift_ne_tmp.symm, + work₂, Function.update_self] + exact binaryShiftMulNatTape_hasBinaryNat 0 + · rw [hfinalWork, Function.update_self] + exact binaryShiftMulNatTape_hasBinaryNat 0 + · intro i hshiftIdx htmpIdx hdblIdx + rw [hfinalWork, Function.update_of_ne hdblIdx] + simp only [work₃, Function.update_of_ne hshiftIdx, + work₂, Function.update_of_ne htmpIdx] + exact (hframe i hshiftIdx htmpIdx hdblIdx).trans (by + simp only [work₁, Function.update_of_ne htmpIdx]) + have haddTail := seqTM_hoareTime + (binaryRippleAddTM abi.shift abi.tmp abi.dbl) + (seqTM (resetBinaryWorkTM abi.tmp) + (seqTM (binaryCopyIntoTM abi.dbl abi.shift abi.tmp) + (resetBinaryWorkTM abi.dbl))) hadd' + (by + intro inp work out hpost + rcases hpost with ⟨hinp, hshiftNow, htmpNow, hdblNow, hframe, hout⟩ + have hreads : ∀ i, (work i).read ≠ Γ.start := by + intro i + by_cases hshiftIdx : i = abi.shift + · subst i + exact (hasBinaryNat_parked hshiftNow).read_ne_start + by_cases htmpIdx : i = abi.tmp + · subst i + exact (hasBinaryNat_parked htmpNow).read_ne_start + by_cases hdblIdx : i = abi.dbl + · subst i + exact (hasBinaryNat_parked hdblNow).read_ne_start + rw [hframe i hshiftIdx htmpIdx hdblIdx] + exact (hwork₁ i).read_ne_start + obtain ⟨hi, hw, ho⟩ := phaseTransition_eq_self_of_reads_ne_start + (hinp.symm ▸ hinput.read_ne_start) hreads + (hout.symm ▸ houtput.read_ne_start) + rw [hi, hw, ho] + exact ⟨hinp, hshiftNow, htmpNow, hdblNow, hframe, hout⟩) + hfinish + have hrun := seqTM_hoareTime + (binaryCopyIntoTM abi.shift abi.tmp abi.dbl) + (seqTM (binaryRippleAddTM abi.shift abi.tmp abi.dbl) + (seqTM (resetBinaryWorkTM abi.tmp) + (seqTM (binaryCopyIntoTM abi.dbl abi.shift abi.tmp) + (resetBinaryWorkTM abi.dbl)))) hcopy₁' + (binaryShiftMulExactFrame_transition inp₀ work₁ out₀ hinput hwork₁ + houtput) haddTail + simpa [binaryShiftMulDoubleTM, binaryShiftMulDoubleTime, + Nat.add_assoc] using hrun + +private def binaryShiftMulOneTime (acc shift : ℕ) : ℕ := + binaryShiftMulUpdateTime acc shift + 1 + binaryShiftMulDoubleTime shift + +private def binaryShiftMulOnePost {n : ℕ} (abi : BinaryShiftMulABI n) + (acc shift : ℕ) (inp₀ : Tape) (work₀ : Fin n → Tape) + (out₀ : Tape) : TapePred n := + fun inp work out => + inp = inp₀ ∧ + (work abi.acc).HasBinaryNat (acc + shift) ∧ + (work abi.shift).HasBinaryNat (2 * shift) ∧ + (work abi.tmp).HasBinaryNat 0 ∧ + (work abi.dbl).HasBinaryNat 0 ∧ + (∀ i, i ≠ abi.acc → i ≠ abi.shift → i ≠ abi.tmp → i ≠ abi.dbl → + work i = work₀ i) ∧ + out = out₀ + +private theorem binaryShiftMulOneTM_hoareTime_frame {n : ℕ} + (abi : BinaryShiftMulABI n) (acc shift : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hacc : (work₀ abi.acc).HasBinaryNat acc) + (hshift : (work₀ abi.shift).HasBinaryNat shift) + (htmp : (work₀ abi.tmp).HasBinaryNat 0) + (hdbl : (work₀ abi.dbl).HasBinaryNat 0) + (hinput : Parked inp₀) (hwork : ∀ i, Parked (work₀ i)) + (houtput : Parked out₀) : + (binaryShiftMulOneTM abi).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (binaryShiftMulOnePost abi acc shift inp₀ work₀ out₀) + (binaryShiftMulOneTime acc shift) := by + have hupdate := binaryShiftMulUpdateTM_hoareTime_frame abi acc shift + inp₀ work₀ out₀ hacc hshift htmp hdbl hinput hwork houtput + have hdouble : (binaryShiftMulDoubleTM abi).HoareTime + (binaryShiftMulUpdatePost abi acc shift inp₀ work₀ out₀) + (binaryShiftMulOnePost abi acc shift inp₀ work₀ out₀) + (binaryShiftMulDoubleTime shift) := by + intro inp work out hpre + rcases hpre with ⟨hinp, haccNow, hshiftNow, htmpNow, hdblNow, + hframe, hout⟩ + have hworkNow : ∀ i, Parked (work i) := by + intro i + by_cases haccIdx : i = abi.acc + · subst i + exact hasBinaryNat_parked haccNow + by_cases hshiftIdx : i = abi.shift + · subst i + exact hasBinaryNat_parked hshiftNow + by_cases htmpIdx : i = abi.tmp + · subst i + exact hasBinaryNat_parked htmpNow + by_cases hdblIdx : i = abi.dbl + · subst i + exact hasBinaryNat_parked hdblNow + rw [hframe i haccIdx hshiftIdx htmpIdx hdblIdx] + exact hwork i + have hrun := binaryShiftMulDoubleTM_hoareTime_frame abi shift + inp work out hshiftNow htmpNow hdblNow (hinp.symm ▸ hinput) + hworkNow (hout.symm ▸ houtput) + obtain ⟨c', time, htime, hreach, hhalt, hfinalInput, hfinalShift, + hfinalTmp, hfinalDbl, hfinalFrame, hfinalOutput⟩ := + hrun inp work out ⟨rfl, rfl, rfl⟩ + refine ⟨c', time, htime, hreach, hhalt, ?_⟩ + refine ⟨hfinalInput.trans hinp, ?_, hfinalShift, hfinalTmp, hfinalDbl, + ?_, hfinalOutput.trans hout⟩ + · rw [hfinalFrame abi.acc abi.acc_ne_shift abi.acc_ne_tmp + abi.acc_ne_dbl] + exact haccNow + · intro i haccIdx hshiftIdx htmpIdx hdblIdx + exact (hfinalFrame i hshiftIdx htmpIdx hdblIdx).trans + (hframe i haccIdx hshiftIdx htmpIdx hdblIdx) + have htransition : ∀ inp work out, + binaryShiftMulUpdatePost abi acc shift inp₀ work₀ out₀ inp work out → + binaryShiftMulUpdatePost abi acc shift inp₀ work₀ out₀ + (transitionInput inp) (fun i => transitionTape (work i)) + (transitionTape out) := by + intro inp work out hpost + rcases hpost with ⟨hinp, haccNow, hshiftNow, htmpNow, hdblNow, + hframe, hout⟩ + have hreads : ∀ i, (work i).read ≠ Γ.start := by + intro i + by_cases haccIdx : i = abi.acc + · subst i + exact (hasBinaryNat_parked haccNow).read_ne_start + by_cases hshiftIdx : i = abi.shift + · subst i + exact (hasBinaryNat_parked hshiftNow).read_ne_start + by_cases htmpIdx : i = abi.tmp + · subst i + exact (hasBinaryNat_parked htmpNow).read_ne_start + by_cases hdblIdx : i = abi.dbl + · subst i + exact (hasBinaryNat_parked hdblNow).read_ne_start + rw [hframe i haccIdx hshiftIdx htmpIdx hdblIdx] + exact (hwork i).read_ne_start + obtain ⟨hi, hw, ho⟩ := phaseTransition_eq_self_of_reads_ne_start + (hinp.symm ▸ hinput.read_ne_start) hreads + (hout.symm ▸ houtput.read_ne_start) + rw [hi, hw, ho] + exact ⟨hinp, haccNow, hshiftNow, htmpNow, hdblNow, hframe, hout⟩ + have hrun := seqTM_hoareTime (binaryShiftMulUpdateTM abi) + (binaryShiftMulDoubleTM abi) hupdate htransition hdouble + simpa [binaryShiftMulOneTM, binaryShiftMulOneTime] using hrun + +private def binaryShiftMulBodyTime (bit : Bool) (acc shift : ℕ) : ℕ := + (if bit then binaryShiftMulOneTime acc shift + else binaryShiftMulDoubleTime shift) + 1 + +private theorem binaryShiftMulUpdateTime_le (acc shift width : ℕ) + (hacc : acc.size ≤ width) (hshift : shift.size ≤ width) : + binaryShiftMulUpdateTime acc shift ≤ 13 * width + 50 := by + have haddSize := binaryRippleAdd_sum_size_le acc shift + have hsum : (acc + shift).size ≤ width + 1 := by + exact haddSize.trans (Nat.add_le_add_right (max_le hacc hshift) 1) + have haddTime := binaryRippleAddTime_le acc shift + have hcopyTime := binaryCopyTime_le (acc + shift) acc + simp only [binaryShiftMulUpdateTime, resetBinaryWorkTime, + clearWorkTimeBound] + omega + +private theorem binaryShiftMulDoubleTime_le (shift width : ℕ) + (hshift : shift.size ≤ width) : + binaryShiftMulDoubleTime shift ≤ 20 * width + 110 := by + have hdoubleSize := binaryRippleAdd_sum_size_le shift shift + have hsum : (shift + shift).size ≤ width + 1 := by + exact hdoubleSize.trans + (Nat.add_le_add_right (max_le hshift hshift) 1) + have hcopy₁ := binaryCopyTime_le shift 0 + simp only [Nat.size_zero, Nat.mul_zero, Nat.add_zero] at hcopy₁ + have hadd := binaryRippleAddTime_le shift shift + have hcopy₂ := binaryCopyTime_le (shift + shift) shift + simp only [binaryShiftMulDoubleTime, resetBinaryWorkTime, + clearWorkTimeBound] + omega + +private theorem binaryShiftMulBodyTime_le (bit : Bool) (acc shift width : ℕ) + (hacc : acc.size ≤ width) (hshift : shift.size ≤ width) : + binaryShiftMulBodyTime bit acc shift ≤ 33 * width + 162 := by + have hupdate := binaryShiftMulUpdateTime_le acc shift width hacc hshift + have hdouble := binaryShiftMulDoubleTime_le shift width hshift + cases bit <;> + simp only [binaryShiftMulBodyTime, binaryShiftMulOneTime, + Bool.false_eq_true, if_false, if_true] <;> + omega + +private theorem forBinaryWorkLoopTime_le + (bodyTime : ℕ → ℕ) (total bound : ℕ) + (hbody : ∀ i, i < total → bodyTime i ≤ bound) : + ∀ count value, value + count = total → + forBinaryWorkLoopTime bodyTime value count ≤ count * (bound + 2) + 1 := by + intro count + induction count with + | zero => + intro value _ + simp [forBinaryWorkLoopTime] + | succ count ih => + intro value htotal + have hvalue : value < total := by omega + have htail := ih (value + 1) (by omega) + have hhead := hbody value hvalue + simp only [forBinaryWorkLoopTime] + rw [Nat.succ_mul] + omega + +private def binaryShiftMulBodyPost {n : ℕ} (abi : BinaryShiftMulABI n) + (bit : Bool) (acc shift : ℕ) (inp₀ : Tape) + (work₀ : Fin n → Tape) (out₀ : Tape) : TapePred n := + fun inp work out => + inp = inp₀ ∧ + (work abi.acc).HasBinaryNat (BinaryShiftMul.step bit acc shift).1 ∧ + (work abi.shift).HasBinaryNat (BinaryShiftMul.step bit acc shift).2 ∧ + (work abi.tmp).HasBinaryNat 0 ∧ + (work abi.dbl).HasBinaryNat 0 ∧ + (∀ i, i ≠ abi.acc → i ≠ abi.shift → i ≠ abi.tmp → i ≠ abi.dbl → + work i = work₀ i) ∧ + out = out₀ + +private theorem binaryShiftMulBitBodyTM_hoareTime_frame {n : ℕ} + (abi : BinaryShiftMulABI n) (bit : Bool) (acc shift : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hbit : (work₀ abi.rhs).read = Γ.ofBool bit) + (hacc : (work₀ abi.acc).HasBinaryNat acc) + (hshift : (work₀ abi.shift).HasBinaryNat shift) + (htmp : (work₀ abi.tmp).HasBinaryNat 0) + (hdbl : (work₀ abi.dbl).HasBinaryNat 0) + (hinput : Parked inp₀) (hwork : ∀ i, Parked (work₀ i)) + (houtput : Parked out₀) : + (binaryShiftMulBitBodyTM abi).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (binaryShiftMulBodyPost abi bit acc shift inp₀ work₀ out₀) + (binaryShiftMulBodyTime bit acc shift) := by + intro inp work out hpre + rcases hpre with ⟨hinp, hworkEq, hout⟩ + subst inp + subst work + subst out + cases bit with + | false => + have hrun := binaryShiftMulDoubleTM_hoareTime_frame abi shift + inp₀ work₀ out₀ hshift htmp hdbl hinput hwork houtput + inp₀ work₀ out₀ ⟨rfl, rfl, rfl⟩ + obtain ⟨c', time, htime, hreach, hhalt, hfinalInput, hfinalShift, + hfinalTmp, hfinalDbl, hfinalFrame, hfinalOutput⟩ := hrun + have hne : (work₀ abi.rhs).read ≠ Γ.one := by + rw [hbit] + decide + obtain ⟨C, hbranch, hbranchHalt, hinputEq, hworkEq, houtputEq⟩ := + branchWorkSymbolTM_reachesIn_different_frame abi.rhs Γ.one + (binaryShiftMulOneTM abi) (binaryShiftMulDoubleTM abi) + inp₀ work₀ out₀ hne hinput.read_ne_start + (fun i => (hwork i).read_ne_start) houtput.read_ne_start + hreach hhalt + refine ⟨C, time + 1, ?_, hbranch, hbranchHalt, ?_⟩ + · simpa [binaryShiftMulBodyTime] using Nat.add_le_add_right htime 1 + · refine ⟨hinputEq.trans hfinalInput, ?_, ?_, ?_, ?_, ?_, + houtputEq.trans hfinalOutput⟩ + · rw [hworkEq, hfinalFrame abi.acc abi.acc_ne_shift abi.acc_ne_tmp + abi.acc_ne_dbl] + simpa [BinaryShiftMul.step] using hacc + · rw [hworkEq] + simpa [BinaryShiftMul.step] using hfinalShift + · rw [hworkEq] + exact hfinalTmp + · rw [hworkEq] + exact hfinalDbl + · intro i haccIdx hshiftIdx htmpIdx hdblIdx + rw [hworkEq, hfinalFrame i hshiftIdx htmpIdx hdblIdx] + | true => + have hrun := binaryShiftMulOneTM_hoareTime_frame abi acc shift + inp₀ work₀ out₀ hacc hshift htmp hdbl hinput hwork houtput + inp₀ work₀ out₀ ⟨rfl, rfl, rfl⟩ + obtain ⟨c', time, htime, hreach, hhalt, hfinalInput, hfinalAcc, + hfinalShift, hfinalTmp, hfinalDbl, hfinalFrame, + hfinalOutput⟩ := hrun + have heq : (work₀ abi.rhs).read = Γ.one := by + simpa using hbit + obtain ⟨C, hbranch, hbranchHalt, hinputEq, hworkEq, houtputEq⟩ := + branchWorkSymbolTM_reachesIn_equal_frame abi.rhs Γ.one + (binaryShiftMulOneTM abi) (binaryShiftMulDoubleTM abi) + inp₀ work₀ out₀ heq hinput.read_ne_start + (fun i => (hwork i).read_ne_start) houtput.read_ne_start + hreach hhalt + refine ⟨C, time + 1, ?_, hbranch, hbranchHalt, ?_⟩ + · simpa [binaryShiftMulBodyTime] using Nat.add_le_add_right htime 1 + · refine ⟨hinputEq.trans hfinalInput, ?_, ?_, ?_, ?_, ?_, + houtputEq.trans hfinalOutput⟩ + · rw [hworkEq] + simpa [BinaryShiftMul.step] using hfinalAcc + · rw [hworkEq] + simpa [BinaryShiftMul.step] using hfinalShift + · rw [hworkEq] + exact hfinalTmp + · rw [hworkEq] + exact hfinalDbl + · intro i haccIdx hshiftIdx htmpIdx hdblIdx + rw [hworkEq, hfinalFrame i haccIdx hshiftIdx htmpIdx hdblIdx] + +private def binaryShiftMulBitAt (rhs i : ℕ) : Bool := + (rhs.bits[i]?).getD false + +private theorem binaryShiftMulBitAt_eq_get (rhs i : ℕ) (hi : i < rhs.size) : + binaryShiftMulBitAt rhs i = + rhs.bits.get ⟨i, by simpa [Nat.size_eq_bits_len] using hi⟩ := by + simp [binaryShiftMulBitAt, + show i < rhs.bits.length by simpa [Nat.size_eq_bits_len] using hi] + +private def binaryShiftMulCursorTape (tape : Tape) (index : ℕ) : Tape := + { head := index + 1, cells := tape.cells } + +private def binaryShiftMulLoopWork {n : ℕ} (abi : BinaryShiftMulABI n) + (work₀ : Fin n → Tape) (index acc shift : ℕ) : Fin n → Tape := + Function.update + (Function.update + (Function.update + (Function.update + (Function.update work₀ abi.rhs + (binaryShiftMulCursorTape (work₀ abi.rhs) index)) + abi.acc (binaryShiftMulNatTape acc)) + abi.shift (binaryShiftMulNatTape shift)) + abi.tmp (binaryShiftMulNatTape 0)) + abi.dbl (binaryShiftMulNatTape 0) + +private theorem binaryShiftMulLoopWork_rhs {n : ℕ} + (abi : BinaryShiftMulABI n) (work₀ : Fin n → Tape) + (index acc shift : ℕ) : + binaryShiftMulLoopWork abi work₀ index acc shift abi.rhs = + binaryShiftMulCursorTape (work₀ abi.rhs) index := by + simp [binaryShiftMulLoopWork] + +private theorem binaryShiftMulLoopWork_acc {n : ℕ} + (abi : BinaryShiftMulABI n) (work₀ : Fin n → Tape) + (index acc shift : ℕ) : + binaryShiftMulLoopWork abi work₀ index acc shift abi.acc = + binaryShiftMulNatTape acc := by + simp [binaryShiftMulLoopWork] + +private theorem binaryShiftMulLoopWork_shift {n : ℕ} + (abi : BinaryShiftMulABI n) (work₀ : Fin n → Tape) + (index acc shift : ℕ) : + binaryShiftMulLoopWork abi work₀ index acc shift abi.shift = + binaryShiftMulNatTape shift := by + simp [binaryShiftMulLoopWork] + +private theorem binaryShiftMulLoopWork_tmp {n : ℕ} + (abi : BinaryShiftMulABI n) (work₀ : Fin n → Tape) + (index acc shift : ℕ) : + binaryShiftMulLoopWork abi work₀ index acc shift abi.tmp = + binaryShiftMulNatTape 0 := by + simp [binaryShiftMulLoopWork] + +private theorem binaryShiftMulLoopWork_dbl {n : ℕ} + (abi : BinaryShiftMulABI n) (work₀ : Fin n → Tape) + (index acc shift : ℕ) : + binaryShiftMulLoopWork abi work₀ index acc shift abi.dbl = + binaryShiftMulNatTape 0 := by + simp [binaryShiftMulLoopWork] + +private theorem binaryShiftMulLoopWork_other {n : ℕ} + (abi : BinaryShiftMulABI n) (work₀ : Fin n → Tape) + (index acc shift : ℕ) (i : Fin n) + (hrhs : i ≠ abi.rhs) (hacc : i ≠ abi.acc) + (hshift : i ≠ abi.shift) (htmp : i ≠ abi.tmp) + (hdbl : i ≠ abi.dbl) : + binaryShiftMulLoopWork abi work₀ index acc shift i = work₀ i := by + simp [binaryShiftMulLoopWork, hrhs, hacc, hshift, htmp, hdbl] + +private theorem binaryShiftMulCursorTape_parked {tape : Tape} + (h : Parked tape) (index : ℕ) : + Parked (binaryShiftMulCursorTape tape index) := by + exact ⟨by simp [binaryShiftMulCursorTape], by + simpa [binaryShiftMulCursorTape] using h.2⟩ + +private theorem binaryShiftMulLoopWork_parked {n : ℕ} + (abi : BinaryShiftMulABI n) (work₀ : Fin n → Tape) + (index acc shift : ℕ) (hwork : ∀ i, Parked (work₀ i)) : + ∀ i, Parked (binaryShiftMulLoopWork abi work₀ index acc shift i) := by + intro i + by_cases hrhs : i = abi.rhs + · subst i + rw [binaryShiftMulLoopWork_rhs] + exact binaryShiftMulCursorTape_parked (hwork abi.rhs) index + by_cases hacc : i = abi.acc + · subst i + rw [binaryShiftMulLoopWork_acc] + exact hasBinaryNat_parked (binaryShiftMulNatTape_hasBinaryNat acc) + by_cases hshift : i = abi.shift + · subst i + rw [binaryShiftMulLoopWork_shift] + exact hasBinaryNat_parked (binaryShiftMulNatTape_hasBinaryNat shift) + by_cases htmp : i = abi.tmp + · subst i + rw [binaryShiftMulLoopWork_tmp] + exact hasBinaryNat_parked (binaryShiftMulNatTape_hasBinaryNat 0) + by_cases hdbl : i = abi.dbl + · subst i + rw [binaryShiftMulLoopWork_dbl] + exact hasBinaryNat_parked (binaryShiftMulNatTape_hasBinaryNat 0) + rw [binaryShiftMulLoopWork_other abi work₀ index acc shift i hrhs hacc + hshift htmp hdbl] + exact hwork i + +private theorem binaryShiftMulLoopWork_read_bit {n : ℕ} + (abi : BinaryShiftMulABI n) (work₀ : Fin n → Tape) + (rhs index acc shift : ℕ) (hrhs : (work₀ abi.rhs).HasBinaryNat rhs) + (hi : index < rhs.size) : + (binaryShiftMulLoopWork abi work₀ index acc shift abi.rhs).read = + Γ.ofBool (binaryShiftMulBitAt rhs index) := by + rw [binaryShiftMulLoopWork_rhs, Tape.read] + simp only [binaryShiftMulCursorTape] + rw [binaryShiftMulBitAt_eq_get rhs index hi] + exact hrhs.2.2.1 index (by simpa [Nat.size_eq_bits_len] using hi) + +private theorem binaryShiftMulLoopWork_read_blank {n : ℕ} + (abi : BinaryShiftMulABI n) (work₀ : Fin n → Tape) + (rhs acc shift : ℕ) (hrhs : (work₀ abi.rhs).HasBinaryNat rhs) : + (binaryShiftMulLoopWork abi work₀ rhs.size acc shift abi.rhs).read = + Γ.blank := by + rw [binaryShiftMulLoopWork_rhs, Tape.read] + simp only [binaryShiftMulCursorTape] + exact hrhs.2.2.2 rhs.size (by simp [Nat.size_eq_bits_len]) + +private theorem binaryShiftMulLoopWork_advance {n : ℕ} + (abi : BinaryShiftMulABI n) (work₀ : Fin n → Tape) + (index acc shift : ℕ) : + (fun i => if i = abi.rhs then + (binaryShiftMulLoopWork abi work₀ index acc shift i).move Dir3.right + else binaryShiftMulLoopWork abi work₀ index acc shift i) = + binaryShiftMulLoopWork abi work₀ (index + 1) acc shift := by + funext i + by_cases hrhs : i = abi.rhs + · subst i + simp only [if_pos, binaryShiftMulLoopWork_rhs] + simp [binaryShiftMulCursorTape, Tape.move] + · rw [if_neg hrhs] + by_cases hacc : i = abi.acc + · subst i + rw [binaryShiftMulLoopWork_acc, binaryShiftMulLoopWork_acc] + by_cases hshift : i = abi.shift + · subst i + rw [binaryShiftMulLoopWork_shift, binaryShiftMulLoopWork_shift] + by_cases htmp : i = abi.tmp + · subst i + rw [binaryShiftMulLoopWork_tmp, binaryShiftMulLoopWork_tmp] + by_cases hdbl : i = abi.dbl + · subst i + rw [binaryShiftMulLoopWork_dbl, binaryShiftMulLoopWork_dbl] + rw [binaryShiftMulLoopWork_other abi work₀ index acc shift i hrhs hacc + hshift htmp hdbl, + binaryShiftMulLoopWork_other abi work₀ (index + 1) acc shift i hrhs + hacc hshift htmp hdbl] + +private def binaryShiftMulPartialWork {n : ℕ} (abi : BinaryShiftMulABI n) + (work₀ : Fin n → Tape) (lhs rhs index : ℕ) : Fin n → Tape := + binaryShiftMulLoopWork abi work₀ index + (BinaryShiftMul.partialAcc lhs rhs index) + (BinaryShiftMul.partialShift lhs index) + +private def binaryShiftMulBodyDoneWork {n : ℕ} + (abi : BinaryShiftMulABI n) (work₀ : Fin n → Tape) + (lhs rhs index : ℕ) : Fin n → Tape := + binaryShiftMulLoopWork abi work₀ index + (BinaryShiftMul.partialAcc lhs rhs (index + 1)) + (BinaryShiftMul.partialShift lhs (index + 1)) + +private def binaryShiftMulScanCfg {n : ℕ} (abi : BinaryShiftMulABI n) + (lhs rhs index : ℕ) (inp₀ : Tape) (work₀ : Fin n → Tape) + (out₀ : Tape) : + Cfg n (forBinaryWorkTM abi.rhs (binaryShiftMulBitBodyTM abi)).Q := + { state := .inl .scan + input := inp₀ + work := binaryShiftMulPartialWork abi work₀ lhs rhs index + output := out₀ } + +private def binaryShiftMulBodyStartCfg {n : ℕ} + (abi : BinaryShiftMulABI n) (lhs rhs index : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) : + Cfg n (forBinaryWorkTM abi.rhs (binaryShiftMulBitBodyTM abi)).Q := + { state := .inr (binaryShiftMulBitBodyTM abi).qstart + input := inp₀ + work := binaryShiftMulPartialWork abi work₀ lhs rhs index + output := out₀ } + +private def binaryShiftMulBodyDoneCfg {n : ℕ} + (abi : BinaryShiftMulABI n) (lhs rhs index : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) : + Cfg n (forBinaryWorkTM abi.rhs (binaryShiftMulBitBodyTM abi)).Q := + { state := .inr (binaryShiftMulBitBodyTM abi).qhalt + input := inp₀ + work := binaryShiftMulBodyDoneWork abi work₀ lhs rhs index + output := out₀ } + +private def binaryShiftMulDoneCfg {n : ℕ} (abi : BinaryShiftMulABI n) + (lhs rhs : ℕ) (inp₀ : Tape) (work₀ : Fin n → Tape) + (out₀ : Tape) : + Cfg n (forBinaryWorkTM abi.rhs (binaryShiftMulBitBodyTM abi)).Q := + { state := .inl .done + input := inp₀ + work := binaryShiftMulPartialWork abi work₀ lhs rhs rhs.size + output := out₀ } + +private theorem binaryShiftMulBody_run {n : ℕ} + (abi : BinaryShiftMulABI n) (lhs rhs index : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hrhs : (work₀ abi.rhs).HasBinaryNat rhs) + (hinput : Parked inp₀) (hwork : ∀ i, Parked (work₀ i)) + (houtput : Parked out₀) (hi : index < rhs.size) : + ∃ time, + time ≤ binaryShiftMulBodyTime (binaryShiftMulBitAt rhs index) + (BinaryShiftMul.partialAcc lhs rhs index) + (BinaryShiftMul.partialShift lhs index) ∧ + (binaryShiftMulBitBodyTM abi).reachesIn time + { state := (binaryShiftMulBitBodyTM abi).qstart + input := inp₀ + work := binaryShiftMulPartialWork abi work₀ lhs rhs index + output := out₀ } + { state := (binaryShiftMulBitBodyTM abi).qhalt + input := inp₀ + work := binaryShiftMulBodyDoneWork abi work₀ lhs rhs index + output := out₀ } := by + let acc := BinaryShiftMul.partialAcc lhs rhs index + let shift := BinaryShiftMul.partialShift lhs index + let work := binaryShiftMulPartialWork abi work₀ lhs rhs index + have hworkParked : ∀ i, Parked (work i) := by + exact binaryShiftMulLoopWork_parked abi work₀ index acc shift hwork + have hacc : (work abi.acc).HasBinaryNat acc := by + rw [show work = binaryShiftMulLoopWork abi work₀ index acc shift by rfl, + binaryShiftMulLoopWork_acc] + exact binaryShiftMulNatTape_hasBinaryNat acc + have hshift : (work abi.shift).HasBinaryNat shift := by + rw [show work = binaryShiftMulLoopWork abi work₀ index acc shift by rfl, + binaryShiftMulLoopWork_shift] + exact binaryShiftMulNatTape_hasBinaryNat shift + have htmp : (work abi.tmp).HasBinaryNat 0 := by + rw [show work = binaryShiftMulLoopWork abi work₀ index acc shift by rfl, + binaryShiftMulLoopWork_tmp] + exact binaryShiftMulNatTape_hasBinaryNat 0 + have hdbl : (work abi.dbl).HasBinaryNat 0 := by + rw [show work = binaryShiftMulLoopWork abi work₀ index acc shift by rfl, + binaryShiftMulLoopWork_dbl] + exact binaryShiftMulNatTape_hasBinaryNat 0 + have hbit : (work abi.rhs).read = + Γ.ofBool (binaryShiftMulBitAt rhs index) := by + exact binaryShiftMulLoopWork_read_bit abi work₀ rhs index acc shift + hrhs hi + have hrun := binaryShiftMulBitBodyTM_hoareTime_frame abi + (binaryShiftMulBitAt rhs index) acc shift inp₀ work out₀ hbit hacc + hshift htmp hdbl hinput hworkParked houtput + inp₀ work out₀ ⟨rfl, rfl, rfl⟩ + obtain ⟨c', time, htime, hreach, hhalt, hfinalInput, hfinalAcc, + hfinalShift, hfinalTmp, hfinalDbl, hfinalFrame, hfinalOutput⟩ := hrun + have hstep := BinaryShiftMul.step_partial_internal lhs rhs index hi + rw [← binaryShiftMulBitAt_eq_get rhs index hi] at hstep + have hfinalAcc' : (c'.work abi.acc).HasBinaryNat + (BinaryShiftMul.partialAcc lhs rhs (index + 1)) := by + simpa [acc, shift, hstep] using hfinalAcc + have hfinalShift' : (c'.work abi.shift).HasBinaryNat + (BinaryShiftMul.partialShift lhs (index + 1)) := by + simpa [acc, shift, hstep] using hfinalShift + have hfinalWork : c'.work = + binaryShiftMulBodyDoneWork abi work₀ lhs rhs index := by + funext i + by_cases haccIdx : i = abi.acc + · subst i + rw [binaryShiftMulBodyDoneWork, binaryShiftMulLoopWork_acc] + exact hfinalAcc'.eq_init_move_right + by_cases hshiftIdx : i = abi.shift + · subst i + rw [binaryShiftMulBodyDoneWork, binaryShiftMulLoopWork_shift] + exact hfinalShift'.eq_init_move_right + by_cases htmpIdx : i = abi.tmp + · subst i + rw [binaryShiftMulBodyDoneWork, binaryShiftMulLoopWork_tmp] + exact hfinalTmp.eq_init_move_right + by_cases hdblIdx : i = abi.dbl + · subst i + rw [binaryShiftMulBodyDoneWork, binaryShiftMulLoopWork_dbl] + exact hfinalDbl.eq_init_move_right + rw [hfinalFrame i haccIdx hshiftIdx htmpIdx hdblIdx] + simp [work, binaryShiftMulPartialWork, binaryShiftMulBodyDoneWork, + binaryShiftMulLoopWork, haccIdx, hshiftIdx, htmpIdx, hdblIdx] + refine ⟨time, htime, ?_⟩ + have hc : c' = + { state := (binaryShiftMulBitBodyTM abi).qhalt + input := inp₀ + work := binaryShiftMulBodyDoneWork abi work₀ lhs rhs index + output := out₀ } := by + exact Cfg.ext hhalt hfinalInput hfinalWork hfinalOutput + simpa [work, hc] using hreach + +private def binaryShiftMulLoopBound (lhs rhs : ℕ) : ℕ := + rhs.size * (33 * binaryShiftMulWidth lhs rhs + 164) + 1 + +private def binaryShiftMulLoopPost {n : ℕ} (abi : BinaryShiftMulABI n) + (lhs rhs : ℕ) (inp₀ : Tape) (work₀ : Fin n → Tape) + (out₀ : Tape) : TapePred n := + fun inp work out => + inp = inp₀ ∧ + (work abi.lhs).HasBinaryNat lhs ∧ + (work abi.rhs).HasBinaryContent rhs.bits ∧ + (work abi.rhs).cells 0 = Γ.start ∧ + (work abi.rhs).head = rhs.size + 1 ∧ + (work abi.acc).HasBinaryNat (lhs * rhs) ∧ + (work abi.shift).HasBinaryNat (lhs * 2 ^ rhs.size) ∧ + (work abi.tmp).HasBinaryNat 0 ∧ + (work abi.dbl).HasBinaryNat 0 ∧ + (∀ i, i ≠ abi.lhs → i ≠ abi.rhs → i ≠ abi.acc → + i ≠ abi.shift → i ≠ abi.tmp → i ≠ abi.dbl → work i = work₀ i) ∧ + out = out₀ + +private theorem binaryShiftMulLoopTM_hoareTime_frame {n : ℕ} + (abi : BinaryShiftMulABI n) (lhs rhs : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hlhs : (work₀ abi.lhs).HasBinaryNat lhs) + (hrhs : (work₀ abi.rhs).HasBinaryNat rhs) + (hacc : (work₀ abi.acc).HasBinaryNat 0) + (hshift : (work₀ abi.shift).HasBinaryNat lhs) + (htmp : (work₀ abi.tmp).HasBinaryNat 0) + (hdbl : (work₀ abi.dbl).HasBinaryNat 0) + (hinput : Parked inp₀) (hwork : ∀ i, Parked (work₀ i)) + (houtput : Parked out₀) : + (binaryShiftMulLoopTM abi).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (binaryShiftMulLoopPost abi lhs rhs inp₀ work₀ out₀) + (binaryShiftMulLoopBound lhs rhs) := by + classical + let body := binaryShiftMulBitBodyTM abi + have hbodyExists : ∀ index, ∃ time, index < rhs.size → + time ≤ binaryShiftMulBodyTime (binaryShiftMulBitAt rhs index) + (BinaryShiftMul.partialAcc lhs rhs index) + (BinaryShiftMul.partialShift lhs index) ∧ + body.reachesIn time + { state := body.qstart + input := inp₀ + work := binaryShiftMulPartialWork abi work₀ lhs rhs index + output := out₀ } + { state := body.qhalt + input := inp₀ + work := binaryShiftMulBodyDoneWork abi work₀ lhs rhs index + output := out₀ } := by + intro index + by_cases hi : index < rhs.size + · obtain ⟨time, htime, hrun⟩ := binaryShiftMulBody_run abi lhs rhs + index inp₀ work₀ out₀ hrhs hinput hwork houtput hi + exact ⟨time, fun _ => ⟨htime, hrun⟩⟩ + · exact ⟨0, fun h => (hi h).elim⟩ + choose bodyTime hbody using hbodyExists + let spec : ForBinaryWorkLoopSpec abi.rhs body bodyTime rhs.size := + { scanCfg := fun index => + binaryShiftMulScanCfg abi lhs rhs index inp₀ work₀ out₀ + bodyStartCfg := fun index => + binaryShiftMulBodyStartCfg abi lhs rhs index inp₀ work₀ out₀ + bodyDoneCfg := fun index => + binaryShiftMulBodyDoneCfg abi lhs rhs index inp₀ work₀ out₀ + doneCfg := binaryShiftMulDoneCfg abi lhs rhs inp₀ work₀ out₀ + scanStep := by + intro index hi + apply forBinaryWorkTM_step_scan_bit_internal abi.rhs body + (binaryShiftMulBitAt rhs index) + · rfl + · exact binaryShiftMulLoopWork_read_bit abi work₀ rhs index + (BinaryShiftMul.partialAcc lhs rhs index) + (BinaryShiftMul.partialShift lhs index) hrhs hi + · exact hinput.read_ne_start + · exact fun i => (binaryShiftMulLoopWork_parked abi work₀ index + (BinaryShiftMul.partialAcc lhs rhs index) + (BinaryShiftMul.partialShift lhs index) hwork i).read_ne_start + · exact houtput.read_ne_start + bodyRun := by + intro index hi + exact forBinaryWorkTM_body_reachesIn_internal abi.rhs body + (hbody index hi).2 + loopbackStep := by + intro index hi + let acc := BinaryShiftMul.partialAcc lhs rhs (index + 1) + let shift := BinaryShiftMul.partialShift lhs (index + 1) + let work := binaryShiftMulBodyDoneWork abi work₀ lhs rhs index + have hworkParked : ∀ i, Parked (work i) := by + exact binaryShiftMulLoopWork_parked abi work₀ index acc shift + hwork + have hstep := forBinaryWorkTM_step_body_halt_internal abi.rhs body + ({ state := body.qhalt + input := inp₀ + work := work + output := out₀ } : Cfg n body.Q) rfl hinput.read_ne_start + (fun i => (hworkParked i).read_ne_start) houtput.read_ne_start + have hadvance := binaryShiftMulLoopWork_advance abi work₀ index + acc shift + simpa [binaryShiftMulBodyDoneCfg, binaryShiftMulScanCfg, + binaryShiftMulPartialWork, work, acc, shift, + binaryShiftMulBodyDoneWork, body, hadvance] using hstep + stopStep := by + apply forBinaryWorkTM_step_scan_blank_internal abi.rhs body + · rfl + · exact binaryShiftMulLoopWork_read_blank abi work₀ rhs + (BinaryShiftMul.partialAcc lhs rhs rhs.size) + (BinaryShiftMul.partialShift lhs rhs.size) hrhs + · exact hinput.read_ne_start + · exact fun i => (binaryShiftMulLoopWork_parked abi work₀ rhs.size + (BinaryShiftMul.partialAcc lhs rhs rhs.size) + (BinaryShiftMul.partialShift lhs rhs.size) hwork i).read_ne_start + · exact houtput.read_ne_start } + have hbodyBound : ∀ index, index < rhs.size → + bodyTime index ≤ 33 * binaryShiftMulWidth lhs rhs + 162 := by + intro index hi + have hwidths := BinaryShiftMul.partial_widths_le_internal lhs rhs index + (Nat.le_of_lt hi) + exact (hbody index hi).1.trans + (binaryShiftMulBodyTime_le (binaryShiftMulBitAt rhs index) + (BinaryShiftMul.partialAcc lhs rhs index) + (BinaryShiftMul.partialShift lhs index) + (binaryShiftMulWidth lhs rhs) hwidths.1 hwidths.2) + have hloop := spec.reachesIn (count := rhs.size) (value := 0) (by simp) + have hloopTime := forBinaryWorkLoopTime_le bodyTime rhs.size + (33 * binaryShiftMulWidth lhs rhs + 162) hbodyBound rhs.size 0 (by simp) + have hinitialWork : binaryShiftMulPartialWork abi work₀ lhs rhs 0 = work₀ := by + funext i + by_cases hrhsIdx : i = abi.rhs + · subst i + rw [binaryShiftMulPartialWork, binaryShiftMulLoopWork_rhs] + apply Tape.ext + · simpa [binaryShiftMulCursorTape] using hrhs.2.1.symm + · rfl + by_cases haccIdx : i = abi.acc + · subst i + rw [binaryShiftMulPartialWork, binaryShiftMulLoopWork_acc] + simpa [BinaryShiftMul.partialAcc] using hacc.eq_init_move_right.symm + by_cases hshiftIdx : i = abi.shift + · subst i + rw [binaryShiftMulPartialWork, binaryShiftMulLoopWork_shift] + simpa [BinaryShiftMul.partialShift] using hshift.eq_init_move_right.symm + by_cases htmpIdx : i = abi.tmp + · subst i + rw [binaryShiftMulPartialWork, binaryShiftMulLoopWork_tmp] + exact htmp.eq_init_move_right.symm + by_cases hdblIdx : i = abi.dbl + · subst i + rw [binaryShiftMulPartialWork, binaryShiftMulLoopWork_dbl] + exact hdbl.eq_init_move_right.symm + exact binaryShiftMulLoopWork_other abi work₀ 0 + (BinaryShiftMul.partialAcc lhs rhs 0) + (BinaryShiftMul.partialShift lhs 0) i hrhsIdx haccIdx hshiftIdx + htmpIdx hdblIdx + intro inp work out hpre + rcases hpre with ⟨hinp, hworkEq, hout⟩ + subst inp + subst work + subst out + let doneWork := binaryShiftMulPartialWork abi work₀ lhs rhs rhs.size + let doneCfg := binaryShiftMulDoneCfg abi lhs rhs inp₀ work₀ out₀ + have hreach : (binaryShiftMulLoopTM abi).reachesIn + (forBinaryWorkLoopTime bodyTime 0 rhs.size) + { state := (binaryShiftMulLoopTM abi).qstart + input := inp₀ + work := work₀ + output := out₀ } doneCfg := by + simpa [binaryShiftMulLoopTM, spec, binaryShiftMulScanCfg, + hinitialWork, doneCfg, body] using hloop + refine ⟨doneCfg, forBinaryWorkLoopTime bodyTime 0 rhs.size, + (by simpa [binaryShiftMulLoopBound] using hloopTime), hreach, rfl, ?_⟩ + refine ⟨rfl, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_, rfl⟩ + · rw [show doneCfg.work = doneWork by rfl] + dsimp only [doneWork] + rw [binaryShiftMulPartialWork, + binaryShiftMulLoopWork_other abi work₀ rhs.size + (BinaryShiftMul.partialAcc lhs rhs rhs.size) + (BinaryShiftMul.partialShift lhs rhs.size) abi.lhs + abi.lhs_ne_rhs abi.lhs_ne_acc abi.lhs_ne_shift abi.lhs_ne_tmp + abi.lhs_ne_dbl] + exact hlhs + · rw [show doneCfg.work = doneWork by rfl] + dsimp only [doneWork] + rw [binaryShiftMulPartialWork, + binaryShiftMulLoopWork_rhs] + simpa [binaryShiftMulCursorTape, Tape.HasBinaryContent] using + hrhs.2.hasBinaryContent + · rw [show doneCfg.work = doneWork by rfl] + dsimp only [doneWork] + rw [binaryShiftMulPartialWork, + binaryShiftMulLoopWork_rhs] + simpa [binaryShiftMulCursorTape] using hrhs.1 + · rw [show doneCfg.work = doneWork by rfl] + dsimp only [doneWork] + rw [binaryShiftMulPartialWork, + binaryShiftMulLoopWork_rhs] + simp [binaryShiftMulCursorTape] + · rw [show doneCfg.work = doneWork by rfl] + dsimp only [doneWork] + rw [binaryShiftMulPartialWork, + binaryShiftMulLoopWork_acc, + BinaryShiftMul.partialAcc_full_internal] + exact binaryShiftMulNatTape_hasBinaryNat (lhs * rhs) + · rw [show doneCfg.work = doneWork by rfl] + dsimp only [doneWork] + rw [binaryShiftMulPartialWork, + binaryShiftMulLoopWork_shift, + BinaryShiftMul.partialShift_full_internal] + exact binaryShiftMulNatTape_hasBinaryNat (lhs * 2 ^ rhs.size) + · rw [show doneCfg.work = doneWork by rfl] + dsimp only [doneWork] + rw [binaryShiftMulPartialWork, + binaryShiftMulLoopWork_tmp] + exact binaryShiftMulNatTape_hasBinaryNat 0 + · rw [show doneCfg.work = doneWork by rfl] + dsimp only [doneWork] + rw [binaryShiftMulPartialWork, + binaryShiftMulLoopWork_dbl] + exact binaryShiftMulNatTape_hasBinaryNat 0 + · intro i hlhsIdx hrhsIdx haccIdx hshiftIdx htmpIdx hdblIdx + rw [show doneCfg.work = doneWork by rfl] + dsimp only [doneWork] + rw [binaryShiftMulPartialWork, + binaryShiftMulLoopWork_other abi work₀ rhs.size + (BinaryShiftMul.partialAcc lhs rhs rhs.size) + (BinaryShiftMul.partialShift lhs rhs.size) i hrhsIdx haccIdx + hshiftIdx htmpIdx hdblIdx] + +private def binaryShiftMulCleanupBits {n : ℕ} + (abi : BinaryShiftMulABI n) (lhs rhs : ℕ) (i : Fin n) : List Bool := + if i = abi.shift then (lhs * 2 ^ rhs.size).bits else [] + +private def binaryShiftMulCleanupHead {n : ℕ} (_abi : BinaryShiftMulABI n) + (_i : Fin n) : ℕ := + 1 + +private def binaryShiftMulCleanupTime {n : ℕ} + (abi : BinaryShiftMulABI n) (lhs rhs : ℕ) : ℕ := + rhs.size + 3 + 1 + + resetBinaryWorkManyTime (binaryShiftMulCleanupBits abi lhs rhs) + (binaryShiftMulCleanupHead abi) [abi.shift, abi.tmp, abi.dbl] + +private def binaryShiftMulCleanupMid {n : ℕ} (abi : BinaryShiftMulABI n) + (lhs rhs : ℕ) (inp₀ : Tape) (work₀ : Fin n → Tape) + (out₀ : Tape) : TapePred n := + fun inp work out => + inp = inp₀ ∧ + (work abi.lhs).HasBinaryNat lhs ∧ + (work abi.rhs).HasBinaryNat rhs ∧ + (work abi.acc).HasBinaryNat (lhs * rhs) ∧ + (work abi.shift).HasBinaryNat (lhs * 2 ^ rhs.size) ∧ + (work abi.tmp).HasBinaryNat 0 ∧ + (work abi.dbl).HasBinaryNat 0 ∧ + (∀ i, i ≠ abi.lhs → i ≠ abi.rhs → i ≠ abi.acc → + i ≠ abi.shift → i ≠ abi.tmp → i ≠ abi.dbl → work i = work₀ i) ∧ + out = out₀ + +/-- Postcondition for completed shift-and-add binary multiplication. -/ +def binaryShiftMulPost {n : ℕ} (abi : BinaryShiftMulABI n) + (lhs rhs : ℕ) (inp₀ : Tape) (work₀ : Fin n → Tape) + (out₀ : Tape) : TapePred n := + fun inp work out => + inp = inp₀ ∧ + (work abi.lhs).HasBinaryNat lhs ∧ + (work abi.rhs).HasBinaryNat rhs ∧ + (work abi.acc).HasBinaryNat (lhs * rhs) ∧ + (work abi.shift).HasBinaryNat 0 ∧ + (work abi.tmp).HasBinaryNat 0 ∧ + (work abi.dbl).HasBinaryNat 0 ∧ + (∀ i, i ≠ abi.lhs → i ≠ abi.rhs → i ≠ abi.acc → + i ≠ abi.shift → i ≠ abi.tmp → i ≠ abi.dbl → work i = work₀ i) ∧ + out = out₀ + +private theorem binaryShiftMulRewindTM_hoareTime_frame {n : ℕ} + (abi : BinaryShiftMulABI n) (lhs rhs : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hinput : Parked inp₀) (hwork : ∀ i, Parked (work₀ i)) + (houtput : Parked out₀) : + (rewindWorkTM abi.rhs).HoareTime + (binaryShiftMulLoopPost abi lhs rhs inp₀ work₀ out₀) + (binaryShiftMulCleanupMid abi lhs rhs inp₀ work₀ out₀) + (rhs.size + 3) := by + intro inp work out hpre + rcases hpre with ⟨hinp, hlhs, hrhsContent, hrhsStart, hrhsHead, + hacc, hshift, htmp, hdbl, hframe, hout⟩ + have hworkParked : ∀ i, Parked (work i) := by + intro i + by_cases hlhsIdx : i = abi.lhs + · subst i + exact hasBinaryNat_parked hlhs + by_cases hrhsIdx : i = abi.rhs + · subst i + exact ⟨by rw [hrhsHead]; omega, hrhsContent.cells_ne_start⟩ + by_cases haccIdx : i = abi.acc + · subst i + exact hasBinaryNat_parked hacc + by_cases hshiftIdx : i = abi.shift + · subst i + exact hasBinaryNat_parked hshift + by_cases htmpIdx : i = abi.tmp + · subst i + exact hasBinaryNat_parked htmp + by_cases hdblIdx : i = abi.dbl + · subst i + exact hasBinaryNat_parked hdbl + rw [hframe i hlhsIdx hrhsIdx haccIdx hshiftIdx htmpIdx hdblIdx] + exact hwork i + have hrewind := rewindBinaryWorkTM_hoareTime_frame abi.rhs rhs.bits + (rhs.size + 1) inp work out hrhsContent hrhsStart + ⟨by rw [hrhsHead]; omega, by rw [hrhsHead]⟩ + (hinp.symm ▸ hinput) (fun i _ => hworkParked i) (hout.symm ▸ houtput) + obtain ⟨c', time, htime, hreach, hhalt, hfinalInput, hfinalRhs, + hfinalOther, hfinalOutput⟩ := + hrewind inp work out ⟨rfl, rfl, rfl⟩ + refine ⟨c', time, (by simpa using htime), hreach, hhalt, ?_⟩ + refine ⟨hfinalInput.trans hinp, ?_, ?_, ?_, ?_, ?_, ?_, ?_, + hfinalOutput.trans hout⟩ + · rw [hfinalOther abi.lhs abi.lhs_ne_rhs] + exact hlhs + · rw [hfinalRhs] + exact Tape.init_move_right_hasBinaryNat rhs + · rw [hfinalOther abi.acc (Ne.symm abi.rhs_ne_acc)] + exact hacc + · rw [hfinalOther abi.shift (Ne.symm abi.rhs_ne_shift)] + exact hshift + · rw [hfinalOther abi.tmp (Ne.symm abi.rhs_ne_tmp)] + exact htmp + · rw [hfinalOther abi.dbl (Ne.symm abi.rhs_ne_dbl)] + exact hdbl + · intro i hlhsIdx hrhsIdx haccIdx hshiftIdx htmpIdx hdblIdx + exact (hfinalOther i hrhsIdx).trans + (hframe i hlhsIdx hrhsIdx haccIdx hshiftIdx htmpIdx hdblIdx) + +private theorem binaryShiftMulResetTM_hoareTime_frame {n : ℕ} + (abi : BinaryShiftMulABI n) (lhs rhs : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hinput : Parked inp₀) (hwork : ∀ i, Parked (work₀ i)) + (houtput : Parked out₀) : + (resetBinaryWorkManyTM [abi.shift, abi.tmp, abi.dbl]).HoareTime + (binaryShiftMulCleanupMid abi lhs rhs inp₀ work₀ out₀) + (binaryShiftMulPost abi lhs rhs inp₀ work₀ out₀) + (resetBinaryWorkManyTime (binaryShiftMulCleanupBits abi lhs rhs) + (binaryShiftMulCleanupHead abi) [abi.shift, abi.tmp, abi.dbl]) := by + intro inp work out hpre + rcases hpre with ⟨hinp, hlhs, hrhs, hacc, hshift, htmp, hdbl, + hframe, hout⟩ + have hworkParked : ∀ i, Parked (work i) := by + intro i + by_cases hlhsIdx : i = abi.lhs + · subst i + exact hasBinaryNat_parked hlhs + by_cases hrhsIdx : i = abi.rhs + · subst i + exact hasBinaryNat_parked hrhs + by_cases haccIdx : i = abi.acc + · subst i + exact hasBinaryNat_parked hacc + by_cases hshiftIdx : i = abi.shift + · subst i + exact hasBinaryNat_parked hshift + by_cases htmpIdx : i = abi.tmp + · subst i + exact hasBinaryNat_parked htmp + by_cases hdblIdx : i = abi.dbl + · subst i + exact hasBinaryNat_parked hdbl + rw [hframe i hlhsIdx hrhsIdx haccIdx hshiftIdx htmpIdx hdblIdx] + exact hwork i + have htargets : [abi.shift, abi.tmp, abi.dbl].Nodup := by + simp + have htarget : ∀ i, i ∈ [abi.shift, abi.tmp, abi.dbl] → + (work i).HasBinaryContent (binaryShiftMulCleanupBits abi lhs rhs i) := by + intro i hi + simp only [List.mem_cons, List.not_mem_nil, or_false] at hi + rcases hi with rfl | rfl | rfl + · simpa [binaryShiftMulCleanupBits] using hshift.2.hasBinaryContent + · simpa [binaryShiftMulCleanupBits, Ne.symm abi.shift_ne_tmp] using + htmp.2.hasBinaryContent + · simpa [binaryShiftMulCleanupBits, Ne.symm abi.shift_ne_dbl] using + hdbl.2.hasBinaryContent + have htargetStart : ∀ i, i ∈ [abi.shift, abi.tmp, abi.dbl] → + (work i).cells 0 = Γ.start := by + intro i hi + simp only [List.mem_cons, List.not_mem_nil, or_false] at hi + rcases hi with rfl | rfl | rfl + · exact hshift.1 + · exact htmp.1 + · exact hdbl.1 + have htargetHead : ∀ i, i ∈ [abi.shift, abi.tmp, abi.dbl] → + (work i).head ≤ binaryShiftMulCleanupHead abi i := by + intro i hi + simp only [List.mem_cons, List.not_mem_nil, or_false] at hi + rcases hi with rfl | rfl | rfl + · simpa [binaryShiftMulCleanupHead] using hshift.2.1.le + · simpa [binaryShiftMulCleanupHead] using htmp.2.1.le + · simpa [binaryShiftMulCleanupHead] using hdbl.2.1.le + have hreset := resetBinaryWorkManyTM_hoareTime_frame + [abi.shift, abi.tmp, abi.dbl] (binaryShiftMulCleanupBits abi lhs rhs) + (binaryShiftMulCleanupHead abi) inp work out htargets htarget + htargetStart htargetHead (hinp.symm ▸ hinput) hworkParked + (hout.symm ▸ houtput) + obtain ⟨c', time, htime, hreach, hhalt, hfinalInput, hfinalWork, + hfinalOutput⟩ := hreset inp work out ⟨rfl, rfl, rfl⟩ + refine ⟨c', time, htime, hreach, hhalt, ?_⟩ + refine ⟨hfinalInput.trans hinp, ?_, ?_, ?_, ?_, ?_, ?_, ?_, + hfinalOutput.trans hout⟩ + · rw [hfinalWork, resetBinaryWorkManyResult_eq_of_not_mem] + · exact hlhs + · simp + · rw [hfinalWork, resetBinaryWorkManyResult_eq_of_not_mem] + · exact hrhs + · simp + · rw [hfinalWork, resetBinaryWorkManyResult_eq_of_not_mem] + · exact hacc + · simp + · rw [hfinalWork, + resetBinaryWorkManyResult_eq_blank_of_mem work _ abi.shift (by simp)] + simpa [resetBinaryBlank] using Tape.init_move_right_hasBinaryNat 0 + · rw [hfinalWork, + resetBinaryWorkManyResult_eq_blank_of_mem work _ abi.tmp (by simp)] + simpa [resetBinaryBlank] using Tape.init_move_right_hasBinaryNat 0 + · rw [hfinalWork, + resetBinaryWorkManyResult_eq_blank_of_mem work _ abi.dbl (by simp)] + simpa [resetBinaryBlank] using Tape.init_move_right_hasBinaryNat 0 + · intro i hlhsIdx hrhsIdx haccIdx hshiftIdx htmpIdx hdblIdx + rw [hfinalWork, resetBinaryWorkManyResult_eq_of_not_mem] + · exact hframe i hlhsIdx hrhsIdx haccIdx hshiftIdx htmpIdx hdblIdx + · simp [hshiftIdx, htmpIdx, hdblIdx] + +private theorem binaryShiftMulCleanupTM_hoareTime_frame {n : ℕ} + (abi : BinaryShiftMulABI n) (lhs rhs : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hinput : Parked inp₀) (hwork : ∀ i, Parked (work₀ i)) + (houtput : Parked out₀) : + (binaryShiftMulCleanupTM abi).HoareTime + (binaryShiftMulLoopPost abi lhs rhs inp₀ work₀ out₀) + (binaryShiftMulPost abi lhs rhs inp₀ work₀ out₀) + (binaryShiftMulCleanupTime abi lhs rhs) := by + have hrewind := binaryShiftMulRewindTM_hoareTime_frame abi lhs rhs + inp₀ work₀ out₀ hinput hwork houtput + have hreset := binaryShiftMulResetTM_hoareTime_frame abi lhs rhs + inp₀ work₀ out₀ hinput hwork houtput + have htransition : ∀ inp work out, + binaryShiftMulCleanupMid abi lhs rhs inp₀ work₀ out₀ inp work out → + binaryShiftMulCleanupMid abi lhs rhs inp₀ work₀ out₀ + (transitionInput inp) (fun i => transitionTape (work i)) + (transitionTape out) := by + intro inp work out hmid + rcases hmid with ⟨hinp, hlhs, hrhs, hacc, hshift, htmp, hdbl, + hframe, hout⟩ + have hreads : ∀ i, (work i).read ≠ Γ.start := by + intro i + by_cases hlhsIdx : i = abi.lhs + · subst i + exact (hasBinaryNat_parked hlhs).read_ne_start + by_cases hrhsIdx : i = abi.rhs + · subst i + exact (hasBinaryNat_parked hrhs).read_ne_start + by_cases haccIdx : i = abi.acc + · subst i + exact (hasBinaryNat_parked hacc).read_ne_start + by_cases hshiftIdx : i = abi.shift + · subst i + exact (hasBinaryNat_parked hshift).read_ne_start + by_cases htmpIdx : i = abi.tmp + · subst i + exact (hasBinaryNat_parked htmp).read_ne_start + by_cases hdblIdx : i = abi.dbl + · subst i + exact (hasBinaryNat_parked hdbl).read_ne_start + rw [hframe i hlhsIdx hrhsIdx haccIdx hshiftIdx htmpIdx hdblIdx] + exact (hwork i).read_ne_start + obtain ⟨hi, hw, ho⟩ := phaseTransition_eq_self_of_reads_ne_start + (hinp.symm ▸ hinput.read_ne_start) hreads + (hout.symm ▸ houtput.read_ne_start) + rw [hi, hw, ho] + exact ⟨hinp, hlhs, hrhs, hacc, hshift, htmp, hdbl, hframe, hout⟩ + have hrun := seqTM_hoareTime (rewindWorkTM abi.rhs) + (resetBinaryWorkManyTM [abi.shift, abi.tmp, abi.dbl]) + hrewind htransition hreset + simpa [binaryShiftMulCleanupTM, binaryShiftMulCleanupTime] using hrun + +private def binaryShiftMulInitPost {n : ℕ} (abi : BinaryShiftMulABI n) + (lhs rhs : ℕ) (inp₀ : Tape) (work₀ : Fin n → Tape) + (out₀ : Tape) : TapePred n := + fun inp work out => + inp = inp₀ ∧ + (work abi.lhs).HasBinaryNat lhs ∧ + (work abi.rhs).HasBinaryNat rhs ∧ + (work abi.acc).HasBinaryNat 0 ∧ + (work abi.shift).HasBinaryNat lhs ∧ + (work abi.tmp).HasBinaryNat 0 ∧ + (work abi.dbl).HasBinaryNat 0 ∧ + (∀ i, i ≠ abi.lhs → i ≠ abi.rhs → i ≠ abi.acc → + i ≠ abi.shift → i ≠ abi.tmp → i ≠ abi.dbl → work i = work₀ i) ∧ + out = out₀ + +private theorem binaryShiftMulInitTM_hoareTime_frame {n : ℕ} + (abi : BinaryShiftMulABI n) (lhs rhs : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hlhs : (work₀ abi.lhs).HasBinaryNat lhs) + (hrhs : (work₀ abi.rhs).HasBinaryNat rhs) + (hacc : (work₀ abi.acc).HasBinaryNat 0) + (hshift : (work₀ abi.shift).HasBinaryNat 0) + (htmp : (work₀ abi.tmp).HasBinaryNat 0) + (hdbl : (work₀ abi.dbl).HasBinaryNat 0) + (hinput : Parked inp₀) (hwork : ∀ i, Parked (work₀ i)) + (houtput : Parked out₀) : + (binaryShiftMulInitTM abi).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (binaryShiftMulInitPost abi lhs rhs inp₀ work₀ out₀) + (binaryCopyTime lhs 0) := by + have hcopy := binaryCopyIntoTM_hoareTime_frame abi.lhs abi.shift abi.acc + abi.lhs_ne_shift abi.lhs_ne_acc (Ne.symm abi.acc_ne_shift) lhs 0 + inp₀ work₀ out₀ hlhs hshift hacc hinput (fun i _ _ _ => hwork i) + houtput + unfold binaryShiftMulInitTM + apply hcopy.strengthen_post + intro inp work out hpost + rcases hpost with ⟨hinp, hworkEq, hout⟩ + refine ⟨hinp, ?_, ?_, ?_, ?_, ?_, ?_, ?_, hout⟩ + · rw [hworkEq, Function.update_of_ne abi.lhs_ne_shift] + exact hlhs + · rw [hworkEq, Function.update_of_ne abi.rhs_ne_shift] + exact hrhs + · rw [hworkEq, Function.update_of_ne abi.acc_ne_shift] + exact hacc + · rw [hworkEq, Function.update_self] + exact binaryShiftMulNatTape_hasBinaryNat lhs + · rw [hworkEq, Function.update_of_ne (Ne.symm abi.shift_ne_tmp)] + exact htmp + · rw [hworkEq, Function.update_of_ne (Ne.symm abi.shift_ne_dbl)] + exact hdbl + · intro i hlhsIdx hrhsIdx haccIdx hshiftIdx htmpIdx hdblIdx + rw [hworkEq, Function.update_of_ne hshiftIdx] + +private theorem binaryShiftMulLoopTM_hoareTime_from_init {n : ℕ} + (abi : BinaryShiftMulABI n) (lhs rhs : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hinput : Parked inp₀) (hwork : ∀ i, Parked (work₀ i)) + (houtput : Parked out₀) : + (binaryShiftMulLoopTM abi).HoareTime + (binaryShiftMulInitPost abi lhs rhs inp₀ work₀ out₀) + (binaryShiftMulLoopPost abi lhs rhs inp₀ work₀ out₀) + (binaryShiftMulLoopBound lhs rhs) := by + intro inp work out hpre + rcases hpre with ⟨hinp, hlhs, hrhs, hacc, hshift, htmp, hdbl, + hframe, hout⟩ + have hworkParked : ∀ i, Parked (work i) := by + intro i + by_cases hlhsIdx : i = abi.lhs + · subst i + exact hasBinaryNat_parked hlhs + by_cases hrhsIdx : i = abi.rhs + · subst i + exact hasBinaryNat_parked hrhs + by_cases haccIdx : i = abi.acc + · subst i + exact hasBinaryNat_parked hacc + by_cases hshiftIdx : i = abi.shift + · subst i + exact hasBinaryNat_parked hshift + by_cases htmpIdx : i = abi.tmp + · subst i + exact hasBinaryNat_parked htmp + by_cases hdblIdx : i = abi.dbl + · subst i + exact hasBinaryNat_parked hdbl + rw [hframe i hlhsIdx hrhsIdx haccIdx hshiftIdx htmpIdx hdblIdx] + exact hwork i + have hloop := binaryShiftMulLoopTM_hoareTime_frame abi lhs rhs + inp work out hlhs hrhs hacc hshift htmp hdbl (hinp.symm ▸ hinput) + hworkParked (hout.symm ▸ houtput) + obtain ⟨c', time, htime, hreach, hhalt, hfinalInput, hfinalLhs, + hfinalRhsContent, hfinalRhsStart, hfinalRhsHead, hfinalAcc, + hfinalShift, hfinalTmp, hfinalDbl, hfinalFrame, hfinalOutput⟩ := + hloop inp work out ⟨rfl, rfl, rfl⟩ + refine ⟨c', time, htime, hreach, hhalt, ?_⟩ + refine ⟨hfinalInput.trans hinp, hfinalLhs, hfinalRhsContent, + hfinalRhsStart, hfinalRhsHead, hfinalAcc, hfinalShift, hfinalTmp, + hfinalDbl, ?_, hfinalOutput.trans hout⟩ + intro i hlhsIdx hrhsIdx haccIdx hshiftIdx htmpIdx hdblIdx + exact (hfinalFrame i hlhsIdx hrhsIdx haccIdx hshiftIdx htmpIdx + hdblIdx).trans + (hframe i hlhsIdx hrhsIdx haccIdx hshiftIdx htmpIdx hdblIdx) + +private theorem binaryShiftMulInitPost_transition {n : ℕ} + (abi : BinaryShiftMulABI n) (lhs rhs : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hinput : Parked inp₀) (hwork : ∀ i, Parked (work₀ i)) + (houtput : Parked out₀) : + ∀ inp work out, + binaryShiftMulInitPost abi lhs rhs inp₀ work₀ out₀ inp work out → + binaryShiftMulInitPost abi lhs rhs inp₀ work₀ out₀ + (transitionInput inp) (fun i => transitionTape (work i)) + (transitionTape out) := by + intro inp work out hpost + rcases hpost with ⟨hinp, hlhs, hrhs, hacc, hshift, htmp, hdbl, + hframe, hout⟩ + have hreads : ∀ i, (work i).read ≠ Γ.start := by + intro i + by_cases hlhsIdx : i = abi.lhs + · subst i + exact (hasBinaryNat_parked hlhs).read_ne_start + by_cases hrhsIdx : i = abi.rhs + · subst i + exact (hasBinaryNat_parked hrhs).read_ne_start + by_cases haccIdx : i = abi.acc + · subst i + exact (hasBinaryNat_parked hacc).read_ne_start + by_cases hshiftIdx : i = abi.shift + · subst i + exact (hasBinaryNat_parked hshift).read_ne_start + by_cases htmpIdx : i = abi.tmp + · subst i + exact (hasBinaryNat_parked htmp).read_ne_start + by_cases hdblIdx : i = abi.dbl + · subst i + exact (hasBinaryNat_parked hdbl).read_ne_start + rw [hframe i hlhsIdx hrhsIdx haccIdx hshiftIdx htmpIdx hdblIdx] + exact (hwork i).read_ne_start + obtain ⟨hi, hw, ho⟩ := phaseTransition_eq_self_of_reads_ne_start + (hinp.symm ▸ hinput.read_ne_start) hreads + (hout.symm ▸ houtput.read_ne_start) + rw [hi, hw, ho] + exact ⟨hinp, hlhs, hrhs, hacc, hshift, htmp, hdbl, hframe, hout⟩ + +private theorem binaryShiftMulLoopPost_transition {n : ℕ} + (abi : BinaryShiftMulABI n) (lhs rhs : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hinput : Parked inp₀) (hwork : ∀ i, Parked (work₀ i)) + (houtput : Parked out₀) : + ∀ inp work out, + binaryShiftMulLoopPost abi lhs rhs inp₀ work₀ out₀ inp work out → + binaryShiftMulLoopPost abi lhs rhs inp₀ work₀ out₀ + (transitionInput inp) (fun i => transitionTape (work i)) + (transitionTape out) := by + intro inp work out hpost + rcases hpost with ⟨hinp, hlhs, hrhsContent, hrhsStart, hrhsHead, + hacc, hshift, htmp, hdbl, hframe, hout⟩ + have hreads : ∀ i, (work i).read ≠ Γ.start := by + intro i + by_cases hlhsIdx : i = abi.lhs + · subst i + exact (hasBinaryNat_parked hlhs).read_ne_start + by_cases hrhsIdx : i = abi.rhs + · subst i + exact hrhsContent.cells_ne_start _ (by rw [hrhsHead]; omega) + by_cases haccIdx : i = abi.acc + · subst i + exact (hasBinaryNat_parked hacc).read_ne_start + by_cases hshiftIdx : i = abi.shift + · subst i + exact (hasBinaryNat_parked hshift).read_ne_start + by_cases htmpIdx : i = abi.tmp + · subst i + exact (hasBinaryNat_parked htmp).read_ne_start + by_cases hdblIdx : i = abi.dbl + · subst i + exact (hasBinaryNat_parked hdbl).read_ne_start + rw [hframe i hlhsIdx hrhsIdx haccIdx hshiftIdx htmpIdx hdblIdx] + exact (hwork i).read_ne_start + obtain ⟨hi, hw, ho⟩ := phaseTransition_eq_self_of_reads_ne_start + (hinp.symm ▸ hinput.read_ne_start) hreads + (hout.symm ▸ houtput.read_ne_start) + rw [hi, hw, ho] + exact ⟨hinp, hlhs, hrhsContent, hrhsStart, hrhsHead, hacc, hshift, + htmp, hdbl, hframe, hout⟩ + +private theorem binaryShiftMulCleanupTime_le {n : ℕ} + (abi : BinaryShiftMulABI n) (lhs rhs : ℕ) : + binaryShiftMulCleanupTime abi lhs rhs ≤ + 3 * binaryShiftMulWidth lhs rhs + 35 := by + have hshift := (BinaryShiftMul.partial_widths_le_internal lhs rhs + rhs.size le_rfl).2 + have hshiftBits : (lhs * 2 ^ rhs.size).bits.length ≤ + binaryShiftMulWidth lhs rhs := by + simpa [BinaryShiftMul.partialShift, Nat.size_eq_bits_len, + binaryShiftMulWidth] using hshift + have hrhs : rhs.size ≤ binaryShiftMulWidth lhs rhs := by + simp [binaryShiftMulWidth] + simp only [binaryShiftMulCleanupTime, resetBinaryWorkManyTime, + binaryShiftMulCleanupBits, binaryShiftMulCleanupHead, + resetBinaryWorkTime, clearWorkTimeBound, if_pos] + simp only [if_neg (Ne.symm abi.shift_ne_tmp), + if_neg (Ne.symm abi.shift_ne_dbl), List.length_nil] + omega + +/-- The concrete shift-and-add multiplier preserves both operands, writes +their product to the accumulator, clears all three scratch tapes, and +preserves the complete external frame. -/ +theorem binaryShiftMulTM_hoareTime_frame_internal {n : ℕ} + (abi : BinaryShiftMulABI n) (lhs rhs : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hlhs : (work₀ abi.lhs).HasBinaryNat lhs) + (hrhs : (work₀ abi.rhs).HasBinaryNat rhs) + (hacc : (work₀ abi.acc).HasBinaryNat 0) + (hshift : (work₀ abi.shift).HasBinaryNat 0) + (htmp : (work₀ abi.tmp).HasBinaryNat 0) + (hdbl : (work₀ abi.dbl).HasBinaryNat 0) + (hinput : Parked inp₀) (hwork : ∀ i, Parked (work₀ i)) + (houtput : Parked out₀) : + (binaryShiftMulTM abi).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (binaryShiftMulPost abi lhs rhs inp₀ work₀ out₀) + (binaryShiftMulTime lhs rhs) := by + have hinit := binaryShiftMulInitTM_hoareTime_frame abi lhs rhs + inp₀ work₀ out₀ hlhs hrhs hacc hshift htmp hdbl hinput hwork houtput + have hloop := binaryShiftMulLoopTM_hoareTime_from_init abi lhs rhs + inp₀ work₀ out₀ hinput hwork houtput + have hcleanup := binaryShiftMulCleanupTM_hoareTime_frame abi lhs rhs + inp₀ work₀ out₀ hinput hwork houtput + have htail := seqTM_hoareTime (binaryShiftMulLoopTM abi) + (binaryShiftMulCleanupTM abi) hloop + (binaryShiftMulLoopPost_transition abi lhs rhs inp₀ work₀ out₀ + hinput hwork houtput) + hcleanup + have hrun := seqTM_hoareTime (binaryShiftMulInitTM abi) + (seqTM (binaryShiftMulLoopTM abi) (binaryShiftMulCleanupTM abi)) + hinit + (binaryShiftMulInitPost_transition abi lhs rhs inp₀ work₀ out₀ + hinput hwork houtput) + htail + unfold binaryShiftMulTM + apply hrun.mono_bound + have hinitBound := binaryCopyTime_le lhs 0 + simp only [Nat.size_zero, Nat.mul_zero, Nat.add_zero] at hinitBound + have hlhsWidth : lhs.size ≤ binaryShiftMulWidth lhs rhs := by + simp [binaryShiftMulWidth] + have hloopBound : binaryShiftMulLoopBound lhs rhs ≤ + 33 * binaryShiftMulWidth lhs rhs ^ 2 + + 164 * binaryShiftMulWidth lhs rhs + 1 := by + have hrhsWidth : rhs.size ≤ binaryShiftMulWidth lhs rhs := by + simp [binaryShiftMulWidth] + unfold binaryShiftMulLoopBound + calc + rhs.size * (33 * binaryShiftMulWidth lhs rhs + 164) + 1 ≤ + binaryShiftMulWidth lhs rhs * + (33 * binaryShiftMulWidth lhs rhs + 164) + 1 := by + exact Nat.add_le_add_right + (Nat.mul_le_mul_right _ hrhsWidth) 1 + _ = 33 * binaryShiftMulWidth lhs rhs ^ 2 + + 164 * binaryShiftMulWidth lhs rhs + 1 := by ring + have hcleanupBound := binaryShiftMulCleanupTime_le abi lhs rhs + simp only [binaryShiftMulTime] + omega + +/-- Coarse all-prefix auxiliary-space contract inherited from the concrete +quadratic time envelope. -/ +theorem binaryShiftMulTM_hoareTimeSpace_frame_internal {n : ℕ} + (abi : BinaryShiftMulABI n) (lhs rhs inputLength initialSpace : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hlhs : (work₀ abi.lhs).HasBinaryNat lhs) + (hrhs : (work₀ abi.rhs).HasBinaryNat rhs) + (hacc : (work₀ abi.acc).HasBinaryNat 0) + (hshift : (work₀ abi.shift).HasBinaryNat 0) + (htmp : (work₀ abi.tmp).HasBinaryNat 0) + (hdbl : (work₀ abi.dbl).HasBinaryNat 0) + (hinput : Parked inp₀) (hwork : ∀ i, Parked (work₀ i)) + (houtput : Parked out₀) + (hinitial : + ({ state := (binaryShiftMulTM abi).qstart + input := inp₀ + work := work₀ + output := out₀ } : + Cfg n (binaryShiftMulTM abi).Q).WithinAuxSpace + inputLength initialSpace) : + (binaryShiftMulTM abi).HoareTimeSpace + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (binaryShiftMulPost abi lhs rhs inp₀ work₀ out₀) + (binaryShiftMulTime lhs rhs) inputLength + (initialSpace + binaryShiftMulTime lhs rhs) := by + apply (binaryShiftMulTM_hoareTime_frame_internal abi lhs rhs inp₀ work₀ + out₀ hlhs hrhs hacc hshift htmp hdbl hinput hwork houtput).toHoareTimeSpace + rintro inp work out ⟨hinp, hworkEq, hout⟩ + subst inp + subst work + subst out + exact hinitial + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinarySucc.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinarySucc.lean new file mode 100644 index 0000000000..e19587e4ca --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinarySucc.lean @@ -0,0 +1,157 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinarySucc.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinarySucc.Internal + +/-! +# Little-endian binary successor + +This module exposes the canonical semantics and compositional contracts for +`TM.binarySuccTM`. Natural numbers use `Nat.bits`, with the least significant +bit first and zero represented by the empty string. Successor propagates carry +through the initial one bits, appends on overflow, and rewinds the target work +tape to cell one. + +## Main results + +- `BinarySucc.ripple_natBits` — the pure ripple function computes successor. +- `TM.binarySuccTM_reachesIn_frame` — exact execution with a full tape frame. +- `TM.binarySuccTM_hoareTimeSpace_frame` — terminating and all-reachable space + contract. +- `TM.binarySuccTM_isTransducer` — the output head never moves left. +-/ + + +public section + +namespace Complexity + +namespace BinarySucc + +/-- Ripple carry on canonical little-endian bits computes natural-number +successor, including the empty representation of zero and overflow. -/ +theorem ripple_natBits (value : ℕ) : + ripple value.bits = (value + 1).bits := + ripple_natBits_internal value + +/-- The exact transition count is at most twice the represented bit length, +plus two. -/ +theorem steps_le (bits : List Bool) : + steps bits ≤ 2 * bits.length + 2 := + steps_le_internal bits + +end BinarySucc + +namespace Tape + +/-- `HasBinaryNat` determines the entire canonical initialized tape, including +its head position, left marker, digits, and blank tail. -/ +theorem HasBinaryNat.eq_init_move_right {t : Tape} {value : ℕ} + (h : t.HasBinaryNat value) : + t = (Tape.init (value.bits.map Γ.ofBool)).move Dir3.right := + eq_init_move_right_of_hasBinaryString h.2 h.1 + +/-- The standard initialized natural-number tape satisfies `HasBinaryNat`. -/ +theorem init_move_right_hasBinaryNat (value : ℕ) : + ((Tape.init (value.bits.map Γ.ofBool)).move Dir3.right).HasBinaryNat value := by + refine ⟨?_, init_move_right_hasBinaryString value.bits⟩ + simp [Tape.init, Tape.move] + +end Tape + +namespace TM + +/-- The exact successor running time is at most twice the standard binary +size of the input value, plus two. -/ +theorem binarySuccTime_le (value : ℕ) : + binarySuccTime value ≤ 2 * value.size + 2 := + binarySuccTime_le_internal value + +/-- Starting on a canonical rewound natural number, `binarySuccTM` halts after +exactly `binarySuccTime value` transitions with the canonical representation +of `value + 1`. Input, output, and every unrelated work tape are preserved +exactly. The off-marker hypotheses are precisely what makes the structurally +mandatory idle moves preserve those tape heads. -/ +theorem binarySuccTM_reachesIn_frame {n : ℕ} + (idx : Fin n) (value : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hvalue : (work₀ idx).HasBinaryNat value) + (hinp : inp₀.read ≠ Γ.start) + (hother : ∀ i, i ≠ idx → (work₀ i).read ≠ Γ.start) + (hout : out₀.read ≠ Γ.start) : + ∃ c', + (binarySuccTM idx).reachesIn (binarySuccTime value) + { state := (binarySuccTM idx).qstart + input := inp₀ + work := work₀ + output := out₀ } c' ∧ + (binarySuccTM idx).halted c' ∧ + c'.input = inp₀ ∧ + (∀ i, i ≠ idx → c'.work i = work₀ i) ∧ + (c'.work idx).HasBinaryNat (value + 1) ∧ + c'.output = out₀ := + binarySuccTM_reachesIn_frame_internal + idx value inp₀ work₀ out₀ hvalue hinp hother hout + +/-- Time-bounded compositional form of `binarySuccTM_reachesIn_frame`. -/ +theorem binarySuccTM_hoareTime_frame {n : ℕ} + (idx : Fin n) (value : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hvalue : (work₀ idx).HasBinaryNat value) + (hinp : inp₀.read ≠ Γ.start) + (hother : ∀ i, i ≠ idx → (work₀ i).read ≠ Γ.start) + (hout : out₀.read ≠ Γ.start) : + (binarySuccTM idx).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + (∀ i, i ≠ idx → work i = work₀ i) ∧ + (work idx).HasBinaryNat (value + 1) ∧ + out = out₀) + (binarySuccTime value) := + binarySuccTM_hoareTime_frame_internal + idx value inp₀ work₀ out₀ hvalue hinp hother hout + +/-- Time-and-space contract for canonical successor. The space component +bounds every reachable configuration, not just the terminal one. Starting +from auxiliary-space budget `initialSpace`, one cell per possible transition +gives the explicit bound `initialSpace + binarySuccTime value`. -/ +theorem binarySuccTM_hoareTimeSpace_frame {n : ℕ} + (idx : Fin n) (value inputLength initialSpace : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hvalue : (work₀ idx).HasBinaryNat value) + (hinp : inp₀.read ≠ Γ.start) + (hother : ∀ i, i ≠ idx → (work₀ i).read ≠ Γ.start) + (hout : out₀.read ≠ Γ.start) + (hinitial : + ({ state := (binarySuccTM idx).qstart + input := inp₀ + work := work₀ + output := out₀ } : + Cfg n (binarySuccTM idx).Q).WithinAuxSpace inputLength initialSpace) : + (binarySuccTM idx).HoareTimeSpace + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + (∀ i, i ≠ idx → work i = work₀ i) ∧ + (work idx).HasBinaryNat (value + 1) ∧ + out = out₀) + (binarySuccTime value) inputLength + (initialSpace + binarySuccTime value) := + binarySuccTM_hoareTimeSpace_frame_internal idx value inputLength initialSpace + inp₀ work₀ out₀ hvalue hinp hother hout hinitial + +/-- `binarySuccTM` never moves the output head left, so it is safe to use in +one-way-output, space-bounded compositions. -/ +theorem binarySuccTM_isTransducer {n : ℕ} (idx : Fin n) : + (binarySuccTM idx).IsTransducer := + binarySuccTM_isTransducer_internal idx + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinarySucc/Defs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinarySucc/Defs.lean new file mode 100644 index 0000000000..bf332d944d --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinarySucc/Defs.lean @@ -0,0 +1,162 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Tape.Encoding +public import Mathlib.Data.Nat.Bits + +/-! +# Little-endian binary successor — definitions + +This module defines the canonical tape representation and finite controller +for ripple-carry successor. Natural numbers use `Nat.bits`, whose least +significant bit comes first and whose representation of zero is empty. +Overflow therefore appends one new high bit at the first blank cell. +-/ + + +@[expose] public section + +namespace Complexity + +namespace BinarySucc + +/-- Ripple one carry through a little-endian bit string. -/ +def ripple : List Bool → List Bool + | [] => [true] + | false :: rest => true :: rest + | true :: rest => false :: ripple rest + +/-- Exact number of transitions used by `binarySuccTM` on a canonical bit +string. It is twice the successor of the number of initial low-order one bits. -/ +def steps : List Bool → ℕ + | [] => 2 + | false :: _ => 2 + | true :: rest => steps rest + 2 + +end BinarySucc + +namespace Tape + +/-- A rewound tape containing the canonical little-endian representation of +one natural number, including its immutable left-end marker. -/ +def HasBinaryNat (t : Tape) (value : ℕ) : Prop := + t.cells 0 = Γ.start ∧ t.HasBinaryString value.bits + +end Tape + +namespace TM + +/-- Finite phases of ripple-carry successor. -/ +inductive BinarySuccPhase where + | carry + | rewind + | done + deriving DecidableEq + +/-- `BinarySuccPhase` has exactly three states. -/ +instance instFintypeBinarySuccPhase : Fintype BinarySuccPhase where + elems := {.carry, .rewind, .done} + complete := fun state => by cases state <;> simp + +/-- Exact running time of canonical successor on `value.bits`. -/ +def binarySuccTime (value : ℕ) : ℕ := + BinarySucc.steps value.bits + +/-- Increment the canonical little-endian natural on work tape `idx`. + +The carry phase turns initial one bits into zero bits. The first zero becomes +one; if the carry reaches the terminating blank, one is appended there. The +machine then rewinds to cell one. Input, output, and unrelated work tapes use +the structurally safe read-back/idle action. -/ +def binarySuccTM {n : ℕ} (idx : Fin n) : TM n where + Q := BinarySuccPhase + qstart := .carry + qhalt := .done + δ := fun phase iHead wHeads oHead => + match phase with + | .carry => + match wHeads idx with + | .zero => + (.rewind, + fun i => if i = idx then Γw.one else readBackWrite (wHeads i), + readBackWrite oHead, idleDir iHead, + fun i => if i = idx then Dir3.left else idleDir (wHeads i), + idleDir oHead) + | .one => + (.carry, + fun i => if i = idx then Γw.zero else readBackWrite (wHeads i), + readBackWrite oHead, idleDir iHead, + fun i => if i = idx then Dir3.right else idleDir (wHeads i), + idleDir oHead) + | .blank => + (.rewind, + fun i => if i = idx then Γw.one else readBackWrite (wHeads i), + readBackWrite oHead, idleDir iHead, + fun i => if i = idx then Dir3.left else idleDir (wHeads i), + idleDir oHead) + | .start => + (.carry, fun i => readBackWrite (wHeads i), readBackWrite oHead, + idleDir iHead, + fun i => if i = idx then Dir3.right else idleDir (wHeads i), + idleDir oHead) + | .rewind => + if wHeads idx = Γ.start then + (.done, fun i => readBackWrite (wHeads i), readBackWrite oHead, + idleDir iHead, + fun i => if i = idx then Dir3.right else idleDir (wHeads i), + idleDir oHead) + else + (.rewind, fun i => readBackWrite (wHeads i), readBackWrite oHead, + idleDir iHead, + fun i => if i = idx then Dir3.left else idleDir (wHeads i), + idleDir oHead) + | .done => allIdle .done iHead wHeads oHead + δ_right_of_start := by + intro phase iHead wHeads oHead + match phase with + | .carry => + dsimp only + match htarget : wHeads idx with + | .zero | .one | .blank => + simp only + refine ⟨idleDir_right_of_start, fun i hi => ?_, idleDir_right_of_start⟩ + by_cases hitarget : i = idx + · subst i + rw [htarget] at hi + exact absurd hi (by decide) + · rw [if_neg hitarget] + exact idleDir_right_of_start hi + | .start => + simp only + refine ⟨idleDir_right_of_start, fun i hi => ?_, idleDir_right_of_start⟩ + by_cases hitarget : i = idx + · rw [if_pos hitarget] + · rw [if_neg hitarget] + exact idleDir_right_of_start hi + | .rewind => + dsimp only + split + · simp only + refine ⟨idleDir_right_of_start, fun i hi => ?_, idleDir_right_of_start⟩ + by_cases hitarget : i = idx + · rw [if_pos hitarget] + · rw [if_neg hitarget] + exact idleDir_right_of_start hi + · next hnotStart => + simp only + refine ⟨idleDir_right_of_start, fun i hi => ?_, idleDir_right_of_start⟩ + by_cases hitarget : i = idx + · subst i + exact absurd hi hnotStart + · rw [if_neg hitarget] + exact idleDir_right_of_start hi + | .done => exact rightOfStart_allIdle iHead wHeads oHead + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinarySucc/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinarySucc/Internal.lean new file mode 100644 index 0000000000..bd3da858fe --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinarySucc/Internal.lean @@ -0,0 +1,605 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Hoare.Space +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinarySucc.Defs +public import Mathlib.Data.Nat.Size + +/-! +# Little-endian binary successor — proof internals + +This file proves the pure ripple semantics and the exact full-frame execution +of `TM.binarySuccTM`. The carry proof uses a private head-independent binary +content predicate, generalized over the already-zeroed low-order prefix. +-/ + + +public section + +namespace Complexity + +namespace BinarySucc + +/-- Internal proof that ripple carry computes successor on canonical +little-endian natural-number bits. -/ +theorem ripple_natBits_internal (value : ℕ) : + ripple value.bits = (value + 1).bits := by + induction value using Nat.binaryRec' with + | zero => simp [ripple] + | bit bit value hvalue ih => + rw [Nat.bits_append_bit value bit hvalue] + cases bit + · simp [ripple, Nat.bit] + · simp only [ripple] + rw [show Nat.bit true value + 1 = 2 * (value + 1) by + simp [Nat.bit, Nat.mul_add]] + rw [Nat.bit0_bits (value + 1) (Nat.succ_ne_zero value)] + rw [ih] + +/-- Internal worst-case bound for the exact successor step count. -/ +theorem steps_le_internal (bits : List Bool) : + steps bits ≤ 2 * bits.length + 2 := by + induction bits with + | nil => simp [steps] + | cons bit bits ih => + cases bit + · simp [steps] + · simp only [steps, List.length_cons] + omega + +end BinarySucc + +namespace Tape + +private theorem HasBinaryContent.read_cons {t : Tape} {done : ℕ} + {bit : Bool} {rest : List Bool} + (h : t.HasBinaryContent (List.replicate done false ++ bit :: rest)) + (hhead : t.head = done + 1) : t.read = Γ.ofBool bit := by + rw [Tape.read, hhead] + have hcell := h.1 done (by simp) + simpa using hcell + +private theorem HasBinaryContent.read_nil {t : Tape} {done : ℕ} + (h : t.HasBinaryContent (List.replicate done false)) + (hhead : t.head = done + 1) : t.read = Γ.blank := by + rw [Tape.read, hhead] + exact h.2 done (by simp) + +end Tape + +namespace BinarySucc + +private theorem set_true_to_false (done : ℕ) (rest : List Bool) : + (List.replicate done false ++ true :: rest).set done false = + List.replicate (done + 1) false ++ rest := by + induction done with + | zero => rfl + | succ done ih => + change false :: (List.replicate done false ++ true :: rest).set done false = + false :: false :: (List.replicate done false ++ rest) + congr 1 + +private theorem set_false_to_true (done : ℕ) (rest : List Bool) : + (List.replicate done false ++ false :: rest).set done true = + List.replicate done false ++ true :: rest := by + induction done with + | zero => rfl + | succ done ih => + change false :: (List.replicate done false ++ false :: rest).set done true = + false :: (List.replicate done false ++ true :: rest) + congr 1 + +end BinarySucc + +namespace TM + +variable {n : ℕ} {idx : Fin n} + +private theorem binarySuccTM_ne_halt {phase : BinarySuccPhase} + (hne : phase ≠ .done) {c : Cfg n (binarySuccTM idx).Q} + (hstate : c.state = phase) : + c.state ≠ (binarySuccTM idx).qhalt := by + rw [hstate] + exact hne + +/-- Carry over one low-order one: write zero and advance right. -/ +private theorem binarySuccTM_step_one (c : Cfg n (binarySuccTM idx).Q) + (hstate : c.state = .carry) (hread : (c.work idx).read = Γ.one) + (hinput : c.input.read ≠ Γ.start) + (hother : ∀ i, i ≠ idx → (c.work i).read ≠ Γ.start) + (houtput : c.output.read ≠ Γ.start) : + (binarySuccTM idx).step c = some + { state := .carry + input := c.input + work := Function.update c.work idx + (((c.work idx).write Γ.zero).move Dir3.right) + output := c.output } := by + rw [TM.step, if_neg (binarySuccTM_ne_halt (by decide) hstate)] + simp only [binarySuccTM, hstate, hread] + refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, ?_, ?_, ?_⟩) + · exact transitionInput_eq_self hinput + · funext i + by_cases hi : i = idx + · subst i + simp only [↓reduceIte, Function.update_self] + rfl + · rw [Function.update_of_ne hi] + simpa only [if_neg hi] using transitionTape_eq_self (hother i hi) + · exact transitionTape_eq_self houtput + +/-- Resolve a carry on zero: write one and turn left. -/ +private theorem binarySuccTM_step_zero (c : Cfg n (binarySuccTM idx).Q) + (hstate : c.state = .carry) (hread : (c.work idx).read = Γ.zero) + (hinput : c.input.read ≠ Γ.start) + (hother : ∀ i, i ≠ idx → (c.work i).read ≠ Γ.start) + (houtput : c.output.read ≠ Γ.start) : + (binarySuccTM idx).step c = some + { state := .rewind + input := c.input + work := Function.update c.work idx + (((c.work idx).write Γ.one).move Dir3.left) + output := c.output } := by + rw [TM.step, if_neg (binarySuccTM_ne_halt (by decide) hstate)] + simp only [binarySuccTM, hstate, hread] + refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, ?_, ?_, ?_⟩) + · exact transitionInput_eq_self hinput + · funext i + by_cases hi : i = idx + · subst i + simp only [↓reduceIte, Function.update_self] + rfl + · rw [Function.update_of_ne hi] + simpa only [if_neg hi] using transitionTape_eq_self (hother i hi) + · exact transitionTape_eq_self houtput + +/-- Resolve overflow on the terminating blank: append one and turn left. -/ +private theorem binarySuccTM_step_blank (c : Cfg n (binarySuccTM idx).Q) + (hstate : c.state = .carry) (hread : (c.work idx).read = Γ.blank) + (hinput : c.input.read ≠ Γ.start) + (hother : ∀ i, i ≠ idx → (c.work i).read ≠ Γ.start) + (houtput : c.output.read ≠ Γ.start) : + (binarySuccTM idx).step c = some + { state := .rewind + input := c.input + work := Function.update c.work idx + (((c.work idx).write Γ.one).move Dir3.left) + output := c.output } := by + rw [TM.step, if_neg (binarySuccTM_ne_halt (by decide) hstate)] + simp only [binarySuccTM, hstate, hread] + refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, ?_, ?_, ?_⟩) + · exact transitionInput_eq_self hinput + · funext i + by_cases hi : i = idx + · subst i + simp only [↓reduceIte, Function.update_self] + rfl + · rw [Function.update_of_ne hi] + simpa only [if_neg hi] using transitionTape_eq_self (hother i hi) + · exact transitionTape_eq_self houtput + +/-- Rewind one ordinary target cell to the left. -/ +private theorem binarySuccTM_step_rewind (c : Cfg n (binarySuccTM idx).Q) + (hstate : c.state = .rewind) (hread : (c.work idx).read ≠ Γ.start) + (hinput : c.input.read ≠ Γ.start) + (hother : ∀ i, i ≠ idx → (c.work i).read ≠ Γ.start) + (houtput : c.output.read ≠ Γ.start) : + (binarySuccTM idx).step c = some + { state := .rewind + input := c.input + work := Function.update c.work idx ((c.work idx).move Dir3.left) + output := c.output } := by + rw [TM.step, if_neg (binarySuccTM_ne_halt (by decide) hstate)] + simp only [binarySuccTM, hstate, hread, ↓reduceIte] + refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, ?_, ?_, ?_⟩) + · exact transitionInput_eq_self hinput + · funext i + by_cases hi : i = idx + · subst i + rw [if_pos rfl, Function.update_self, + writeAndMove_readBack _ hread] + · rw [if_neg hi, Function.update_of_ne hi] + exact transitionTape_eq_self (hother i hi) + · exact transitionTape_eq_self houtput + +/-- Bounce right from the left marker and halt. -/ +private theorem binarySuccTM_step_start (c : Cfg n (binarySuccTM idx).Q) + (hstate : c.state = .rewind) (hread : (c.work idx).read = Γ.start) + (hhead : (c.work idx).head = 0) + (hinput : c.input.read ≠ Γ.start) + (hother : ∀ i, i ≠ idx → (c.work i).read ≠ Γ.start) + (houtput : c.output.read ≠ Γ.start) : + (binarySuccTM idx).step c = some + { state := .done + input := c.input + work := Function.update c.work idx ((c.work idx).move Dir3.right) + output := c.output } := by + rw [TM.step, if_neg (binarySuccTM_ne_halt (by decide) hstate)] + simp only [binarySuccTM, hstate, hread, ↓reduceIte] + refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, ?_, ?_, ?_⟩) + · exact transitionInput_eq_self hinput + · funext i + by_cases hi : i = idx + · subst i + simp only [↓reduceIte, Function.update_self] + show (((c.work idx).write _).move Dir3.right) = + (c.work idx).move Dir3.right + rw [Tape.write, if_pos hhead] + · rw [if_neg hi, Function.update_of_ne hi] + exact transitionTape_eq_self (hother i hi) + · exact transitionTape_eq_self houtput + +/-! ## Exact rewind and carry runs -/ + +private theorem binarySuccTM_rewind_run (bits : List Bool) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hinp : inp₀.read ≠ Γ.start) + (hother : ∀ i, i ≠ idx → (work₀ i).read ≠ Γ.start) + (hout : out₀.read ≠ Γ.start) : + ∀ head (c : Cfg n (binarySuccTM idx).Q), + c.state = .rewind → + c.input = inp₀ → + (∀ i, i ≠ idx → c.work i = work₀ i) → + (c.work idx).HasBinaryContent bits → + (c.work idx).cells 0 = Γ.start → + (c.work idx).head = head → + c.output = out₀ → + ∃ c', + (binarySuccTM idx).reachesIn (head + 1) c c' ∧ + (binarySuccTM idx).halted c' ∧ + c'.input = inp₀ ∧ + (∀ i, i ≠ idx → c'.work i = work₀ i) ∧ + (c'.work idx).HasBinaryString bits ∧ + (c'.work idx).cells 0 = Γ.start ∧ + c'.output = out₀ := by + intro head + induction head with + | zero => + intro c hstate hinput hwork hcontent hcell0 hhead houtput + have hread : (c.work idx).read = Γ.start := by + rw [Tape.read, hhead] + exact hcell0 + have hstep := binarySuccTM_step_start c hstate hread hhead + (by rw [hinput]; exact hinp) + (fun i hi => by rw [hwork i hi]; exact hother i hi) + (by rw [houtput]; exact hout) + let c₁ : Cfg n (binarySuccTM idx).Q := + { state := .done + input := c.input + work := Function.update c.work idx ((c.work idx).move Dir3.right) + output := c.output } + refine ⟨c₁, .step hstep .zero, rfl, hinput, ?_, ?_, ?_, houtput⟩ + · intro i hi + show Function.update c.work idx ((c.work idx).move Dir3.right) i = work₀ i + rw [Function.update_of_ne hi] + exact hwork i hi + · show (Function.update c.work idx ((c.work idx).move Dir3.right) idx) + |>.HasBinaryString bits + rw [Function.update_self] + apply Tape.HasBinaryContent.hasBinaryString + · simpa only [Tape.HasBinaryContent, Tape.move_cells] using hcontent + · simp [Tape.move, hhead] + · show (Function.update c.work idx ((c.work idx).move Dir3.right) idx).cells 0 = _ + rw [Function.update_self, Tape.move_cells] + exact hcell0 + | succ head ih => + intro c hstate hinput hwork hcontent hcell0 hhead houtput + have hread : (c.work idx).read ≠ Γ.start := by + rw [Tape.read, hhead] + exact hcontent.cells_ne_start (head + 1) (by omega) + have hstep := binarySuccTM_step_rewind c hstate hread + (by rw [hinput]; exact hinp) + (fun i hi => by rw [hwork i hi]; exact hother i hi) + (by rw [houtput]; exact hout) + let c₁ : Cfg n (binarySuccTM idx).Q := + { state := .rewind + input := c.input + work := Function.update c.work idx ((c.work idx).move Dir3.left) + output := c.output } + obtain ⟨c', hreach, hhalt, hinput', hwork', hstring, hcell0', houtput'⟩ := + ih c₁ rfl hinput + (fun i hi => by + show Function.update c.work idx ((c.work idx).move Dir3.left) i = work₀ i + rw [Function.update_of_ne hi] + exact hwork i hi) + (by + show (Function.update c.work idx ((c.work idx).move Dir3.left) idx) + |>.HasBinaryContent bits + rw [Function.update_self] + simpa only [Tape.HasBinaryContent, Tape.move_cells] using hcontent) + (by + show (Function.update c.work idx ((c.work idx).move Dir3.left) idx).cells 0 = _ + rw [Function.update_self, Tape.move_cells] + exact hcell0) + (by + show (Function.update c.work idx ((c.work idx).move Dir3.left) idx).head = head + rw [Function.update_self] + simp [Tape.move, hhead]) + houtput + refine ⟨c', ?_, hhalt, hinput', hwork', hstring, hcell0', houtput'⟩ + simpa [Nat.succ_eq_add_one, Nat.add_assoc] using + (TM.reachesIn.step hstep hreach) + +private theorem binarySuccTM_carry_run + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hinp : inp₀.read ≠ Γ.start) + (hother : ∀ i, i ≠ idx → (work₀ i).read ≠ Γ.start) + (hout : out₀.read ≠ Γ.start) : + ∀ done bits (c : Cfg n (binarySuccTM idx).Q), + c.state = .carry → + c.input = inp₀ → + (∀ i, i ≠ idx → c.work i = work₀ i) → + (c.work idx).HasBinaryContent (List.replicate done false ++ bits) → + (c.work idx).cells 0 = Γ.start → + (c.work idx).head = done + 1 → + c.output = out₀ → + ∃ c', + (binarySuccTM idx).reachesIn (done + BinarySucc.steps bits) c c' ∧ + (binarySuccTM idx).halted c' ∧ + c'.input = inp₀ ∧ + (∀ i, i ≠ idx → c'.work i = work₀ i) ∧ + (c'.work idx).HasBinaryString + (List.replicate done false ++ BinarySucc.ripple bits) ∧ + (c'.work idx).cells 0 = Γ.start ∧ + c'.output = out₀ := by + intro done bits + induction bits generalizing done with + | nil => + intro c hstate hinput hwork hcontent hcell0 hhead houtput + have hcontent' : (c.work idx).HasBinaryContent (List.replicate done false) := by + simpa using hcontent + have hread : (c.work idx).read = Γ.blank := + hcontent'.read_nil hhead + have hstep := binarySuccTM_step_blank c hstate hread + (by rw [hinput]; exact hinp) + (fun i hi => by rw [hwork i hi]; exact hother i hi) + (by rw [houtput]; exact hout) + let target : Tape := ((c.work idx).write Γ.one).move Dir3.left + have htargetContent : target.HasBinaryContent + (List.replicate done false ++ [true]) := by + have hwrite := hcontent'.write_append true (by simpa using hhead) + simpa only [target, Tape.HasBinaryContent, Tape.move_cells] using hwrite + have htargetCell0 : target.cells 0 = Γ.start := by + exact Tape.write_move_cell0 Γ.one Dir3.left hcell0 + have htargetHead : target.head = done := by + simp [target, Tape.move, Tape.write_head, hhead] + let c₁ : Cfg n (binarySuccTM idx).Q := + { state := .rewind + input := c.input + work := Function.update c.work idx target + output := c.output } + obtain ⟨c', hreach, hhalt, hinput', hwork', hstring, hcell0', houtput'⟩ := + binarySuccTM_rewind_run (idx := idx) + (List.replicate done false ++ [true]) inp₀ work₀ out₀ hinp hother hout + done c₁ rfl hinput + (fun i hi => by + show Function.update c.work idx target i = work₀ i + rw [Function.update_of_ne hi] + exact hwork i hi) + (by + show (Function.update c.work idx target idx).HasBinaryContent _ + rw [Function.update_self] + exact htargetContent) + (by + show (Function.update c.work idx target idx).cells 0 = _ + rw [Function.update_self] + exact htargetCell0) + (by + show (Function.update c.work idx target idx).head = done + rw [Function.update_self] + exact htargetHead) + houtput + refine ⟨c', ?_, hhalt, hinput', hwork', ?_, hcell0', houtput'⟩ + · simpa [BinarySucc.steps, Nat.add_assoc] using + (TM.reachesIn.step hstep hreach) + · simpa [BinarySucc.ripple] using hstring + | cons bit rest ih => + cases bit with + | false => + intro c hstate hinput hwork hcontent hcell0 hhead houtput + have hread : (c.work idx).read = Γ.zero := + hcontent.read_cons hhead + have hstep := binarySuccTM_step_zero c hstate hread + (by rw [hinput]; exact hinp) + (fun i hi => by rw [hwork i hi]; exact hother i hi) + (by rw [houtput]; exact hout) + let target : Tape := ((c.work idx).write Γ.one).move Dir3.left + have htargetContent : target.HasBinaryContent + (List.replicate done false ++ true :: rest) := by + have hwrite := hcontent.write_set true hhead (by simp) + rw [BinarySucc.set_false_to_true] at hwrite + simpa only [target, Tape.HasBinaryContent, Tape.move_cells] using hwrite + have htargetCell0 : target.cells 0 = Γ.start := by + exact Tape.write_move_cell0 Γ.one Dir3.left hcell0 + have htargetHead : target.head = done := by + simp [target, Tape.move, Tape.write_head, hhead] + let c₁ : Cfg n (binarySuccTM idx).Q := + { state := .rewind + input := c.input + work := Function.update c.work idx target + output := c.output } + obtain ⟨c', hreach, hhalt, hinput', hwork', hstring, hcell0', houtput'⟩ := + binarySuccTM_rewind_run (idx := idx) + (List.replicate done false ++ true :: rest) + inp₀ work₀ out₀ hinp hother hout done c₁ rfl hinput + (fun i hi => by + show Function.update c.work idx target i = work₀ i + rw [Function.update_of_ne hi] + exact hwork i hi) + (by + show (Function.update c.work idx target idx).HasBinaryContent _ + rw [Function.update_self] + exact htargetContent) + (by + show (Function.update c.work idx target idx).cells 0 = _ + rw [Function.update_self] + exact htargetCell0) + (by + show (Function.update c.work idx target idx).head = done + rw [Function.update_self] + exact htargetHead) + houtput + refine ⟨c', ?_, hhalt, hinput', hwork', ?_, hcell0', houtput'⟩ + · simpa [BinarySucc.steps, Nat.add_assoc] using + (TM.reachesIn.step hstep hreach) + · simpa [BinarySucc.ripple] using hstring + | true => + intro c hstate hinput hwork hcontent hcell0 hhead houtput + have hread : (c.work idx).read = Γ.one := + hcontent.read_cons hhead + have hstep := binarySuccTM_step_one c hstate hread + (by rw [hinput]; exact hinp) + (fun i hi => by rw [hwork i hi]; exact hother i hi) + (by rw [houtput]; exact hout) + let target : Tape := ((c.work idx).write Γ.zero).move Dir3.right + have htargetContent : target.HasBinaryContent + (List.replicate (done + 1) false ++ rest) := by + have hwrite := hcontent.write_set false hhead (by simp) + rw [BinarySucc.set_true_to_false] at hwrite + simpa only [target, Tape.HasBinaryContent, Tape.move_cells] using hwrite + have htargetCell0 : target.cells 0 = Γ.start := by + exact Tape.write_move_cell0 Γ.zero Dir3.right hcell0 + have htargetHead : target.head = (done + 1) + 1 := by + simp [target, Tape.move, Tape.write_head, hhead] + let c₁ : Cfg n (binarySuccTM idx).Q := + { state := .carry + input := c.input + work := Function.update c.work idx target + output := c.output } + obtain ⟨c', hreach, hhalt, hinput', hwork', hstring, hcell0', houtput'⟩ := + ih (done + 1) c₁ rfl hinput + (fun i hi => by + show Function.update c.work idx target i = work₀ i + rw [Function.update_of_ne hi] + exact hwork i hi) + (by + show (Function.update c.work idx target idx).HasBinaryContent _ + rw [Function.update_self] + exact htargetContent) + (by + show (Function.update c.work idx target idx).cells 0 = _ + rw [Function.update_self] + exact htargetCell0) + (by + show (Function.update c.work idx target idx).head = (done + 1) + 1 + rw [Function.update_self] + exact htargetHead) + houtput + refine ⟨c', ?_, hhalt, hinput', hwork', ?_, hcell0', houtput'⟩ + · convert TM.reachesIn.step hstep hreach using 1 + all_goals simp [BinarySucc.steps, Nat.add_assoc] + all_goals omega + · simpa [BinarySucc.ripple, List.replicate_add, + List.append_assoc] using hstring + +/-! ## Public-theorem internals -/ + +theorem binarySuccTime_le_internal (value : ℕ) : + binarySuccTime value ≤ 2 * value.size + 2 := by + simpa [binarySuccTime, Nat.size_eq_bits_len] using + BinarySucc.steps_le_internal value.bits + +theorem binarySuccTM_reachesIn_frame_internal + (idx : Fin n) (value : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hvalue : (work₀ idx).HasBinaryNat value) + (hinp : inp₀.read ≠ Γ.start) + (hother : ∀ i, i ≠ idx → (work₀ i).read ≠ Γ.start) + (hout : out₀.read ≠ Γ.start) : + ∃ c', + (binarySuccTM idx).reachesIn (binarySuccTime value) + { state := (binarySuccTM idx).qstart + input := inp₀ + work := work₀ + output := out₀ } c' ∧ + (binarySuccTM idx).halted c' ∧ + c'.input = inp₀ ∧ + (∀ i, i ≠ idx → c'.work i = work₀ i) ∧ + (c'.work idx).HasBinaryNat (value + 1) ∧ + c'.output = out₀ := by + let c₀ : Cfg n (binarySuccTM idx).Q := + { state := (binarySuccTM idx).qstart + input := inp₀ + work := work₀ + output := out₀ } + obtain ⟨c', hreach, hhalt, hinput, hwork, hstring, hcell0, houtput⟩ := + binarySuccTM_carry_run (idx := idx) inp₀ work₀ out₀ hinp hother hout + 0 value.bits c₀ (by rfl) (by rfl) (fun _ _ => rfl) + (by simpa [c₀] using hvalue.2.hasBinaryContent) hvalue.1 + (by simpa [c₀] using hvalue.2.1) (by rfl) + refine ⟨c', ?_, hhalt, hinput, hwork, ?_, houtput⟩ + · simpa [c₀, binarySuccTime] using hreach + · exact ⟨hcell0, by + simpa [BinarySucc.ripple_natBits_internal] using hstring⟩ + +theorem binarySuccTM_hoareTime_frame_internal + (idx : Fin n) (value : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hvalue : (work₀ idx).HasBinaryNat value) + (hinp : inp₀.read ≠ Γ.start) + (hother : ∀ i, i ≠ idx → (work₀ i).read ≠ Γ.start) + (hout : out₀.read ≠ Γ.start) : + (binarySuccTM idx).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + (∀ i, i ≠ idx → work i = work₀ i) ∧ + (work idx).HasBinaryNat (value + 1) ∧ + out = out₀) + (binarySuccTime value) := by + rintro inp work out ⟨hinput₀, hwork₀, houtput₀⟩ + obtain ⟨c', hreach, hhalt, hinput, hwork, hvalue', houtput⟩ := + binarySuccTM_reachesIn_frame_internal idx value inp₀ work₀ out₀ + hvalue hinp hother hout + refine ⟨c', binarySuccTime value, le_rfl, ?_, hhalt, + hinput, hwork, hvalue', houtput⟩ + simpa [hinput₀, hwork₀, houtput₀] using hreach + +theorem binarySuccTM_hoareTimeSpace_frame_internal + (idx : Fin n) (value inputLength initialSpace : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hvalue : (work₀ idx).HasBinaryNat value) + (hinp : inp₀.read ≠ Γ.start) + (hother : ∀ i, i ≠ idx → (work₀ i).read ≠ Γ.start) + (hout : out₀.read ≠ Γ.start) + (hinitial : + ({ state := (binarySuccTM idx).qstart + input := inp₀ + work := work₀ + output := out₀ } : + Cfg n (binarySuccTM idx).Q).WithinAuxSpace inputLength initialSpace) : + (binarySuccTM idx).HoareTimeSpace + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + (∀ i, i ≠ idx → work i = work₀ i) ∧ + (work idx).HasBinaryNat (value + 1) ∧ + out = out₀) + (binarySuccTime value) inputLength + (initialSpace + binarySuccTime value) := by + apply (binarySuccTM_hoareTime_frame_internal idx value inp₀ work₀ out₀ + hvalue hinp hother hout).toHoareTimeSpace + rintro inp work out ⟨hinput₀, hwork₀, houtput₀⟩ + simpa [hinput₀, hwork₀, houtput₀] using hinitial + +theorem binarySuccTM_isTransducer_internal (idx : Fin n) : + (binarySuccTM idx).IsTransducer := by + intro phase iHead wHeads oHead + cases phase with + | carry => + cases hread : wHeads idx <;> + simp [binarySuccTM, hread, idleDir] <;> + split <;> decide + | rewind => + simp only [binarySuccTM] + split <;> simp [idleDir] <;> split <;> decide + | done => + simp [binarySuccTM, allIdle, idleDir] + split <;> decide + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/ClearWork.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/ClearWork.lean new file mode 100644 index 0000000000..83cffb5f2a --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/ClearWork.lean @@ -0,0 +1,102 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.ClearWork.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.ClearWork.Internal + +/-! +# Clearing a binary work tape + +This module exposes a literal-frame contract for erasing a canonical Boolean +work tape and returning its head to cell one. It also records the one-way-output +discipline of the clearing, rewinding, and composite machines. + +## Main results + +- `clearWorkTM_hoareTime_frame` — clear and rewind with a full external frame. +- `clearWorkTM_hoareTimeSpace_frame` — the corresponding all-prefix space contract. +- `clearWorkTM_isTransducer` — clearing never moves the output head left. +-/ + + +public section + +namespace Complexity + +namespace TM + +variable {n : ℕ} + +/-- Clearing a canonical Boolean work tape preserves the input, output, and +every unrelated work tape literally, and resets the target to the standard +parked blank tape within `2 * bits.length + 5` steps. -/ +theorem clearWorkTM_hoareTime_frame + (idx : Fin n) (bits : List Bool) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (htarget : work₀ idx = + (Tape.init (bits.map Γ.ofBool)).move Dir3.right) + (hinp : Parked inp₀) + (hother : ∀ i, i ≠ idx → Parked (work₀ i)) + (hout : Parked out₀) : + (clearWorkTM idx).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + work = Function.update work₀ idx + ((Tape.init []).move Dir3.right) ∧ + out = out₀) + (clearWorkTimeBound bits.length) := + clearWorkTM_hoareTime_frame_internal idx bits inp₀ work₀ out₀ + htarget hinp hother hout + +/-- Time-and-space form of `clearWorkTM_hoareTime_frame`. Starting from an +`initialSpace` budget, one extra cell per possible transition yields an honest +all-reachable bound. -/ +theorem clearWorkTM_hoareTimeSpace_frame + (idx : Fin n) (bits : List Bool) (inputLength initialSpace : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (htarget : work₀ idx = + (Tape.init (bits.map Γ.ofBool)).move Dir3.right) + (hinp : Parked inp₀) + (hother : ∀ i, i ≠ idx → Parked (work₀ i)) + (hout : Parked out₀) + (hinitial : + ({ state := (clearWorkTM idx).qstart + input := inp₀ + work := work₀ + output := out₀ } : + Cfg n (clearWorkTM idx).Q).WithinAuxSpace inputLength initialSpace) : + (clearWorkTM idx).HoareTimeSpace + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + work = Function.update work₀ idx + ((Tape.init []).move Dir3.right) ∧ + out = out₀) + (clearWorkTimeBound bits.length) inputLength + (initialSpace + clearWorkTimeBound bits.length) := + clearWorkTM_hoareTimeSpace_frame_internal idx bits inputLength initialSpace + inp₀ work₀ out₀ htarget hinp hother hout hinitial + +/-- Blanking a work tape never moves the output head left. -/ +theorem blankWorkTM_isTransducer (idx : Fin n) : + (blankWorkTM idx).IsTransducer := + blankWorkTM_isTransducer_internal idx + +/-- Rewinding a work tape never moves the output head left. -/ +theorem rewindWorkTM_isTransducer (idx : Fin n) : + (rewindWorkTM idx).IsTransducer := + rewindWorkTM_isTransducer_internal idx + +/-- Clearing and rewinding a work tape never moves the output head left. -/ +theorem clearWorkTM_isTransducer (idx : Fin n) : + (clearWorkTM idx).IsTransducer := + clearWorkTM_isTransducer_internal idx + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/ClearWork/Defs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/ClearWork/Defs.lean new file mode 100644 index 0000000000..02e66becfb --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/ClearWork/Defs.lean @@ -0,0 +1,35 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import Mathlib.Data.Finset.Attr +public import Mathlib.Data.Nat.Notation +public import Mathlib.Tactic.Finiteness.Attr +public import Mathlib.Tactic.SetLike +public import Mathlib.Tactic.ToAdditive + +/-! +# Clearing a binary work tape — definitions + +This module names the concrete time bound used by the public framed contract +for `TM.clearWorkTM`. +-/ + + +@[expose] public section + +namespace Complexity + +namespace TM + +/-- Concrete running-time bound for clearing and rewinding a Boolean work tape +whose represented string has `length` bits. -/ +def clearWorkTimeBound (length : ℕ) : ℕ := + 2 * length + 5 + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/ClearWork/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/ClearWork/Internal.lean new file mode 100644 index 0000000000..ec0df5f1a7 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/ClearWork/Internal.lean @@ -0,0 +1,131 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Hoare.Space +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Registers +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.ClearWork.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.Internal + +/-! +# Clearing a binary work tape — proof internals + +This module packages the legacy rich clear/rewind proof behind a literal frame +contract and proves that its component machines never move the output head +left. +-/ + + +public section + +namespace Complexity + +namespace TM + +variable {n : ℕ} + +theorem clearWorkTM_hoareTime_frame_internal + (idx : Fin n) (bits : List Bool) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (htarget : work₀ idx = + (Tape.init (bits.map Γ.ofBool)).move Dir3.right) + (hinp : Parked inp₀) + (hother : ∀ i, i ≠ idx → Parked (work₀ i)) + (hout : Parked out₀) : + (clearWorkTM idx).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + work = Function.update work₀ idx + ((Tape.init []).move Dir3.right) ∧ + out = out₀) + (clearWorkTimeBound bits.length) := by + let Frame : TapePred n := fun inp work out => + inp = inp₀ ∧ (∀ i, i ≠ idx → work i = work₀ i) ∧ out = out₀ + have hclear := clearWorkTM_hoareTime_frame_of_binaryString idx bits + (P := Frame) (by + intro inp work out inp' work' out' hframe _htarget hinp' hout' hwork' + rcases hframe with ⟨hinp₀, hwork₀, hout₀⟩ + refine ⟨hinp'.trans hinp₀, ?_, hout'.trans hout₀⟩ + intro i hi + exact (hwork' i hi).trans (hwork₀ i hi)) + refine hclear.consequence ?_ ?_ (by simp [clearWorkTimeBound]; omega) + · rintro inp work out ⟨rfl, rfl, rfl⟩ + refine ⟨htarget, hinp.read_ne_start, hout.read_ne_start, hout.1, ?_, ?_⟩ + · intro i hi + exact ⟨(hother i hi).read_ne_start, (hother i hi).1⟩ + · exact ⟨rfl, fun _ _ => rfl, rfl⟩ + · rintro inp work out ⟨htarget', hinp', hother', hout'⟩ + refine ⟨hinp', ?_, hout'⟩ + funext i + by_cases hi : i = idx + · subst i + rw [Function.update_self] + exact htarget' + · rw [Function.update_of_ne hi] + exact hother' i hi + +theorem clearWorkTM_hoareTimeSpace_frame_internal + (idx : Fin n) (bits : List Bool) (inputLength initialSpace : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (htarget : work₀ idx = + (Tape.init (bits.map Γ.ofBool)).move Dir3.right) + (hinp : Parked inp₀) + (hother : ∀ i, i ≠ idx → Parked (work₀ i)) + (hout : Parked out₀) + (hinitial : + ({ state := (clearWorkTM idx).qstart + input := inp₀ + work := work₀ + output := out₀ } : + Cfg n (clearWorkTM idx).Q).WithinAuxSpace inputLength initialSpace) : + (clearWorkTM idx).HoareTimeSpace + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + work = Function.update work₀ idx + ((Tape.init []).move Dir3.right) ∧ + out = out₀) + (clearWorkTimeBound bits.length) inputLength + (initialSpace + clearWorkTimeBound bits.length) := by + apply (clearWorkTM_hoareTime_frame_internal idx bits inp₀ work₀ out₀ + htarget hinp hother hout).toHoareTimeSpace + rintro inp work out ⟨rfl, rfl, rfl⟩ + exact hinitial + +theorem blankWorkTM_isTransducer_internal (idx : Fin n) : + (blankWorkTM idx).IsTransducer := by + intro phase iHead wHeads oHead + cases phase with + | scanning => + simp only [blankWorkTM] + split <;> simp [idleDir] <;> split <;> decide + | done => + simp [blankWorkTM, allIdle, idleDir] + split <;> decide + +theorem rewindWorkTM_isTransducer_internal (idx : Fin n) : + (rewindWorkTM idx).IsTransducer := by + intro phase iHead wHeads oHead + cases phase with + | moveLeft => + simp only [rewindWorkTM] + split <;> simp [idleDir] <;> split <;> decide + | moveRight => + simp [rewindWorkTM, idleDir] + split <;> decide + | done => + simp [rewindWorkTM, allIdle, idleDir] + split <;> decide + +theorem clearWorkTM_isTransducer_internal (idx : Fin n) : + (clearWorkTM idx).IsTransducer := + (blankWorkTM_isTransducer_internal idx).seqTM + (rewindWorkTM_isTransducer_internal idx) + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/CopyOutput.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/CopyOutput.lean new file mode 100644 index 0000000000..8a4c563eac --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/CopyOutput.lean @@ -0,0 +1,39 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.Internal.CopyOutput + +/-! +# Input-to-output copy subroutine + +Public correctness theorem for `TM.copyInputToOutputTM`. The machine copies +its Boolean input verbatim to its output tape in the exact linear bound +`|x| + 2`, without using the contents of its fixed work-tape bank. + +## Main result + +- `TM.copyInputToOutputTM_computesInTime` — the copy machine computes `id` + within time `m + 2` +-/ + + +public section + +namespace Complexity + +namespace TM + +/-- The input-to-output copy machine computes the identity function within +the exact linear time bound `m + 2`. -/ +theorem copyInputToOutputTM_computesInTime (n : ℕ) : + (copyInputToOutputTM (n := n)).ComputesInTime id (fun m => m + 2) := by + exact copyInputToOutputTM_computesInTime_internal n + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/CopyToVirtualInput.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/CopyToVirtualInput.lean new file mode 100644 index 0000000000..867cb228d3 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/CopyToVirtualInput.lean @@ -0,0 +1,195 @@ +/- +Copyright (c) 2026 Bolton Bailey. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Bolton Bailey +-/ + +module +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.CopyWorkOutput +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.ResetTapes + +/-! +# Copying a value into virtual-input shape + +`TM.retargetInputStartedCfg` expects the virtual-input work tape in the exact +shape `(Tape.init (y.map Γ.ofBool)).move Dir3.right` — head parked at cell `1`. +A value produced elsewhere lands with its head *past* its content, so one more +rewind closes the gap. + +## Main results + +- `TM.copyToVirtualInputTM` — move a value into virtual-input position +- `TM.copyToVirtualInputTM_hoareTime` — its contract +-/ + + +public section + +namespace Complexity + +namespace TM + +/-- Copy the value held at `src` into `dst`, then rewind `dst` to cell `1` — +the exact shape `retargetInputStartedCfg` expects of a virtual input. Every +tape besides `src`/`dst`, the real input, and the real output are held at +fixed `Parked` values throughout. -/ +theorem copyToVirtualInput_hoareTime {n : ℕ} (src dst : Fin n) (hne : src ≠ dst) + (x : List Bool) (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hsrcHead : (work₀ src).head = 1) (hsrcOut : (work₀ src).HasOutput x) + (hsrcParked : Parked (work₀ src)) + (hdst : work₀ dst = (Tape.init []).move Dir3.right) + (hinp : Parked inp₀) (hout : Parked out₀) + (hother : ∀ i, i ≠ src → i ≠ dst → Parked (work₀ i)) : + (seqTM (copyWorkToWorkTM src dst) (rewindWorkTM dst)).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => inp = inp₀ ∧ out = out₀ ∧ + work dst = (Tape.init (x.map Γ.ofBool)).move Dir3.right ∧ + (work src).cells = (work₀ src).cells ∧ + (work src).head = x.length + 1 ∧ + (∀ i, i ≠ src → i ≠ dst → work i = work₀ i)) + (2 * x.length + 5) := by + have hP : ∀ (inp : Tape) (work : Fin n → Tape) (out : Tape) + (inp' : Tape) (work' : Fin n → Tape) (out' : Tape), + (inp = inp₀ ∧ out = out₀ ∧ ∀ i, i ≠ src → i ≠ dst → work i = work₀ i) → + (work' src).cells = (work₀ src).cells → + (work' src).head = x.length + 1 → + (work' src).HasOutput x → + (work' dst).HasBinaryPrefix x → + (work' dst).cells 0 = Γ.start → + inp' = inp → out' = out → + (∀ i, i ≠ src → i ≠ dst → work' i = work i) → + (inp' = inp₀ ∧ out' = out₀ ∧ ∀ i, i ≠ src → i ≠ dst → work' i = work₀ i) := by + rintro inp work out inp' work' out' ⟨rfl, rfl, hrest⟩ _ _ _ _ _ rfl rfl hkeep + exact ⟨rfl, rfl, fun i hisrc hidst => (hkeep i hisrc hidst).trans (hrest i hisrc hidst)⟩ + have hcopy := copyWorkToWorkTM_hoareTime_frame_of_hasOutput src dst hne x (work₀ src) hP + have hpre_imp : ∀ (inp : Tape) (work : Fin n → Tape) (out : Tape), + (inp = inp₀ ∧ work = work₀ ∧ out = out₀) → + (work src = work₀ src ∧ (work₀ src).head = 1 ∧ (work₀ src).HasOutput x ∧ + work dst = (Tape.init []).move Dir3.right ∧ + inp.read ≠ Γ.start ∧ out.read ≠ Γ.start ∧ 1 ≤ out.head ∧ + (∀ i, i ≠ src → i ≠ dst → (work i).read ≠ Γ.start ∧ 1 ≤ (work i).head) ∧ + (inp = inp₀ ∧ out = out₀ ∧ ∀ i, i ≠ src → i ≠ dst → work i = work₀ i)) := by + rintro inp work out ⟨rfl, rfl, rfl⟩ + exact ⟨rfl, hsrcHead, hsrcOut, hdst, hinp.read_ne_start, hout.read_ne_start, hout.1, + fun i hisrc hidst => ⟨(hother i hisrc hidst).read_ne_start, (hother i hisrc hidst).1⟩, + rfl, rfl, fun i _ _ => rfl⟩ + have h₁ := hcopy.weaken_pre hpre_imp + have hP2 : ∀ (inp : Tape) (work : Fin n → Tape) (out : Tape) + (inp' : Tape) (work' : Fin n → Tape) (out' : Tape), + ((work dst).cells = (Tape.init (x.map Γ.ofBool)).cells ∧ + (work src).cells = (work₀ src).cells ∧ + (work src).head = x.length + 1 ∧ + inp = inp₀ ∧ out = out₀ ∧ ∀ i, i ≠ src → i ≠ dst → work i = work₀ i) → + (work' dst).cells = (work dst).cells → + (work' dst).head = 1 → + (∀ i, i ≠ dst → work' i = work i) → + inp' = inp → + out'.cells = out.cells → + out'.head = out.head → + ((work' dst).cells = (Tape.init (x.map Γ.ofBool)).cells ∧ + (work' src).cells = (work₀ src).cells ∧ + (work' src).head = x.length + 1 ∧ + inp' = inp₀ ∧ out' = out₀ ∧ ∀ i, i ≠ src → i ≠ dst → work' i = work₀ i) := by + rintro inp work out inp' work' out' ⟨hcellsP, hsc, hsh, rfl, rfl, hrest⟩ hcells' _ hkeep rfl + hout'c hout'h + refine ⟨hcells'.trans hcellsP, ?_, ?_, rfl, Tape.ext hout'h hout'c, + fun i hisrc hidst => (hkeep i hidst).trans (hrest i hisrc hidst)⟩ + · rw [hkeep src hne]; exact hsc + · rw [hkeep src hne]; exact hsh + have h₂ := rewindWorkTM_hoareTime_frame (n := n) dst (x.length + 1) + (P := fun inp work out => + (work dst).cells = (Tape.init (x.map Γ.ofBool)).cells ∧ + (work src).cells = (work₀ src).cells ∧ + (work src).head = x.length + 1 ∧ + inp = inp₀ ∧ out = out₀ ∧ ∀ i, i ≠ src → i ≠ dst → work i = work₀ i) hP2 + have hcomb : (seqTM (copyWorkToWorkTM src dst) (rewindWorkTM dst)).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => (work dst).head = 1 ∧ + (work dst).cells = (Tape.init (x.map Γ.ofBool)).cells ∧ + (work src).cells = (work₀ src).cells ∧ + (work src).head = x.length + 1 ∧ + inp = inp₀ ∧ out = out₀ ∧ ∀ i, i ≠ src → i ≠ dst → work i = work₀ i) + (2 * x.length + 5) := by + refine (seqTM_hoareTime (copyWorkToWorkTM src dst) (rewindWorkTM dst) h₁ ?_ h₂).mono_bound + (by omega) + rintro inp work out ⟨hcells, hhead, hout_, hprefix, hcell0, hPinp, hPout, hPrest⟩ + have hread_src : (work src).read ≠ Γ.start := by + show (work src).cells (work src).head ≠ Γ.start + rw [hhead, hcells] + exact hsrcParked.2 (x.length + 1) (by omega) + have hread_dst : (work dst).read ≠ Γ.start := by + rw [hprefix.read_blank]; decide + have hread_other : ∀ i, i ≠ dst → (work i).read ≠ Γ.start ∧ (work i).head ≥ 1 := by + intro i hidst + by_cases hisrc : i = src + · subst hisrc; exact ⟨hread_src, by omega⟩ + · rw [hPrest i hisrc hidst] + exact ⟨(hother i hisrc hidst).read_ne_start, (hother i hisrc hidst).1⟩ + have hinp_ns : inp.read ≠ Γ.start := by rw [hPinp]; exact hinp.read_ne_start + have hout_ns : out.read ≠ Γ.start := by rw [hPout]; exact hout.read_ne_start + have ht1 : transitionInput inp = inp := transitionInput_eq_self hinp_ns + have ht2 : (fun i => transitionTape (work i)) = work := + funext fun i => by + by_cases hidst : i = dst + · subst hidst; exact transitionTape_eq_self hread_dst + · exact transitionTape_eq_self (hread_other i hidst).1 + have ht3 : transitionTape out = out := transitionTape_eq_self hout_ns + rw [ht1, ht2, ht3] + have hcellsP : (work dst).cells = (Tape.init (x.map Γ.ofBool)).cells := + hprefix.cells_eq_init hcell0 + refine ⟨hcell0, ?_, le_of_eq hprefix.1, hinp_ns, hout_ns, ?_, + fun i hidst => hread_other i hidst, + hcellsP, hcells, hhead, hPinp, hPout, hPrest⟩ + · intro j hj + have hj1 : j - 1 + 1 = j := by omega + by_cases hle : j ≤ x.length + · rw [← hj1, hprefix.2.1 (j - 1) (by omega)] + cases x[j - 1]'(by omega) <;> decide + · rw [← hj1, hprefix.2.2 (j - 1) (by omega)] + decide + · rw [hPout]; exact hout.1 + exact hcomb.strengthen_post (by + rintro inp work out ⟨hhead1, hcellsP, hsc, hsh, hPinp, hPout, hPrest⟩ + exact ⟨hPinp, hPout, Tape.ext hhead1 hcellsP, hsc, hsh, hPrest⟩) + +/-- Copy a work tape's value into another and park the result at cell `1`. -/ +def copyToVirtualInputTM {n : ℕ} (src dst : Fin n) : TM n := + seqTM (copyWorkToWorkTM src dst) (rewindWorkTM dst) + +/-- **The copy, with the whole tape family pinned down.** The source keeps its +cells but ends with its head past the copied value; the destination holds the +value parked at cell `1`; nothing else moves. This determined form is what +`TM.seqTM_det` chains. -/ +theorem copyToVirtualInputTM_hoareTime {n : ℕ} (src dst : Fin n) (hne : src ≠ dst) + (x : List Bool) (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hsrcHead : (work₀ src).head = 1) (hsrcOut : (work₀ src).HasOutput x) + (hsrcParked : Parked (work₀ src)) + (hdst : work₀ dst = (Tape.init []).move Dir3.right) + (hinp : Parked inp₀) (hout : Parked out₀) + (hother : ∀ i, i ≠ src → i ≠ dst → Parked (work₀ i)) : + (copyToVirtualInputTM src dst).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => inp = inp₀ ∧ + work = Function.update (Function.update work₀ dst + ((Tape.init (x.map Γ.ofBool)).move Dir3.right)) + src (⟨x.length + 1, (work₀ src).cells⟩ : Tape) ∧ + out = out₀) + (2 * x.length + 5) := by + refine (copyToVirtualInput_hoareTime src dst hne x inp₀ work₀ out₀ hsrcHead hsrcOut + hsrcParked hdst hinp hout hother).strengthen_post ?_ + rintro inp work out ⟨hi, ho, hd, hsc, hsh, hrest⟩ + refine ⟨hi, ?_, ho⟩ + funext j + by_cases hjs : j = src + · rw [hjs, Function.update_self] + exact Tape.ext (hjs ▸ hsh) (hjs ▸ hsc) + · rw [Function.update_of_ne hjs] + by_cases hjd : j = dst + · rw [hjd, Function.update_self] + exact hjd ▸ hd + · rw [Function.update_of_ne hjd] + exact hrest j hjs hjd + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/CopyWorkOutput.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/CopyWorkOutput.lean new file mode 100644 index 0000000000..6dd612b538 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/CopyWorkOutput.lean @@ -0,0 +1,105 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.Internal.CopyWorkOutput + +/-! +# Copy a raw work-tape output + +These theorems let `TM.copyWorkToWorkTM` consume a source satisfying +`Tape.HasOutput`, even when cells after the terminating blank contain arbitrary +junk. The fresh destination receives a canonical `Tape.HasBinaryPrefix`. + +## Main results + +- `TM.copyWorkToWorkTM_reachesIn_of_hasOutput` — exact concrete copy run +- `TM.copyWorkToWorkTM_hoareTime_of_hasOutput` — exact raw-output copy +- `TM.copyWorkToWorkTM_hoareTime_frame_of_hasOutput` — copy with frame preservation +-/ + + +public section + +namespace Complexity + +namespace TM + +/-- Starting at cell one, copy exactly the source's advertised output in +`|x| + 1` steps, preserving all source cells and the destination's cell zero. -/ +theorem copyWorkToWorkTM_reachesIn_of_hasOutput {n : ℕ} + (src dst : Fin n) (hne : src ≠ dst) (x : List Bool) + {inp out : Tape} {work : Fin n → Tape} + (hsrcHead : (work src).head = 1) + (hsrcOutput : (work src).HasOutput x) + (hdst : (work dst).HasBinaryPrefix []) : + ∃ c', + (copyWorkToWorkTM src dst).reachesIn (x.length + 1) + { state := (copyWorkToWorkTM src dst).qstart, + input := inp, work := work, output := out } c' ∧ + (copyWorkToWorkTM src dst).halted c' ∧ + (c'.work src).cells = (work src).cells ∧ + (c'.work src).head = x.length + 1 ∧ + (c'.work src).HasOutput x ∧ + (c'.work dst).HasBinaryPrefix x ∧ + (c'.work dst).cells 0 = (work dst).cells 0 := by + exact copyWorkToWorkTM_reachesIn_of_hasOutput_internal + src dst hne x hsrcHead hsrcOutput hdst + +/-- Copy a raw `HasOutput` source to a fresh destination in exactly the usual +linear bound. Source cells are preserved, including arbitrary trailing junk. -/ +theorem copyWorkToWorkTM_hoareTime_of_hasOutput {n : ℕ} + (src dst : Fin n) (hne : src ≠ dst) (x : List Bool) (source : Tape) : + (copyWorkToWorkTM src dst).HoareTime + (fun _inp work _out => + work src = source ∧ source.head = 1 ∧ source.HasOutput x ∧ + (work dst).HasBinaryPrefix []) + (fun _inp work _out => + (work src).cells = source.cells ∧ + (work src).head = x.length + 1 ∧ + (work src).HasOutput x ∧ + (work dst).HasBinaryPrefix x) + (x.length + 1) := by + exact copyWorkToWorkTM_hoareTime_of_hasOutput_internal src dst hne x source + +/-- Frame-rich raw-output copy. The input, output, and unrelated work tapes +are preserved exactly while the source is copied to the fresh destination. -/ +theorem copyWorkToWorkTM_hoareTime_frame_of_hasOutput {n : ℕ} + (src dst : Fin n) (hne : src ≠ dst) (x : List Bool) (source : Tape) + {P : Tape → (Fin n → Tape) → Tape → Prop} + (hP : ∀ (inp : Tape) (work : Fin n → Tape) (out : Tape) + (inp' : Tape) (work' : Fin n → Tape) (out' : Tape), + P inp work out → + (work' src).cells = source.cells → + (work' src).head = x.length + 1 → + (work' src).HasOutput x → + (work' dst).HasBinaryPrefix x → + (work' dst).cells 0 = Γ.start → + inp' = inp → out' = out → + (∀ i, i ≠ src → i ≠ dst → work' i = work i) → + P inp' work' out') : + (copyWorkToWorkTM src dst).HoareTime + (fun inp work out => + work src = source ∧ source.head = 1 ∧ source.HasOutput x ∧ + work dst = (Tape.init []).move Dir3.right ∧ + inp.read ≠ Γ.start ∧ out.read ≠ Γ.start ∧ 1 ≤ out.head ∧ + (∀ i, i ≠ src → i ≠ dst → + (work i).read ≠ Γ.start ∧ 1 ≤ (work i).head) ∧ + P inp work out) + (fun inp work out => + (work src).cells = source.cells ∧ + (work src).head = x.length + 1 ∧ + (work src).HasOutput x ∧ + (work dst).HasBinaryPrefix x ∧ + (work dst).cells 0 = Γ.start ∧ + P inp work out) + (x.length + 1) := by + exact copyWorkToWorkTM_hoareTime_frame_of_hasOutput_internal + src dst hne x source hP + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/Counter.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/Counter.lean new file mode 100644 index 0000000000..34e9227861 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/Counter.lean @@ -0,0 +1,1294 @@ +/- +Copyright (c) 2025 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.Internal.Generic +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Hoare.Defs + +/-! +# Counter-building TM subroutines + +Deterministic helper machines for materializing unary counters on work tapes. + +The SAT-specific NP construction only needs a linear witness bound: +`assignment.length ≤ input.length + 1`. This file defines a small machine +that writes exactly `|input| + 1` unary marks to a designated counter tape. +-/ + + +@[expose] public section + +namespace Complexity + +namespace Tape + +/-- A counter tape while it is being built: cells `1..used` contain unary + marks, the head is at cell `used + 1`, and the tail from that cell onward + is blank. -/ +def HasUnaryPrefix (t : Tape) (used : ℕ) : Prop := + t.head = used + 1 ∧ + (∀ i, i < used → t.cells (i + 1) = Γ.one) ∧ + (∀ i, used ≤ i → t.cells (i + 1) = Γ.blank) + +/-- An empty tape moved one cell right has the empty unary prefix: the head is + at cell 1 and every cell after `▷` is blank. -/ +theorem init_nil_move_right_hasUnaryPrefix_zero : + ((Tape.init []).move Dir3.right).HasUnaryPrefix 0 := by + simp [HasUnaryPrefix, Tape.init, Tape.move] + +/-- Writing one mark at the current head and moving right extends a unary + prefix by one cell. -/ +theorem hasUnaryPrefix_write_one {t : Tape} {used : ℕ} + (h : t.HasUnaryPrefix used) : + (t.writeAndMove Γ.one Dir3.right).HasUnaryPrefix (used + 1) := by + refine ⟨?_, ?_, ?_⟩ + · simp [Tape.writeAndMove, Tape.write, Tape.move, h.1] + · intro i hi + unfold Tape.writeAndMove + simp only [Tape.move] + unfold Tape.write + have hhead_ne : ¬t.head = 0 := by rw [h.1]; omega + simp only [hhead_ne, ↓reduceIte] + by_cases hidx : i = used + · have hcellidx : i + 1 = t.head := by rw [h.1, hidx] + rw [hcellidx, Function.update_self] + · have hi_used : i < used := by omega + have hcell := h.2.1 i hi_used + have hne : t.head ≠ i + 1 := by rw [h.1]; omega + rw [Function.update_of_ne (Ne.symm hne)] + exact hcell + · intro i hi + unfold Tape.writeAndMove + simp only [Tape.move] + unfold Tape.write + have hhead_ne : ¬t.head = 0 := by rw [h.1]; omega + simp only [hhead_ne, ↓reduceIte] + have hne : t.head ≠ i + 1 := by rw [h.1]; omega + rw [Function.update_of_ne (Ne.symm hne)] + exact h.2.2 i (by omega) + +/-- Writing the next unary mark preserves the left-end marker cell. -/ +theorem hasUnaryPrefix_write_one_cell0 {t : Tape} {used : ℕ} + (h : t.HasUnaryPrefix used) (h0 : t.cells 0 = Γ.start) : + (t.writeAndMove Γ.one Dir3.right).cells 0 = Γ.start := by + unfold Tape.writeAndMove + rw [Tape.move_cells] + unfold Tape.write + have hhead_ne : ¬t.head = 0 := by rw [h.1]; omega + simp only [hhead_ne, ↓reduceIte] + have hne : t.head ≠ 0 := by rw [h.1]; omega + rw [Function.update_of_ne (Ne.symm hne)] + exact h0 + +/-- A unary prefix never contains `▷` after the left-end marker. -/ +theorem hasUnaryPrefix_cells_ne_start {t : Tape} {used : ℕ} + (h : t.HasUnaryPrefix used) : + ∀ j, j ≥ 1 → t.cells j ≠ Γ.start := by + intro j hj + let i := j - 1 + have hj_eq : j = i + 1 := by omega + by_cases hi : i < used + · rw [hj_eq, h.2.1 i hi] + decide + · have hge : used ≤ i := by omega + rw [hj_eq, h.2.2 i hge] + decide + +/-- A unary counter tape positioned at its first data cell. + +`HasUnaryCounter t B` means cells `1..B` contain `1`, cell `B+1` is blank, +and the head is at cell `1`. -/ +def HasUnaryCounter (t : Tape) (B : ℕ) : Prop := + t.head = 1 ∧ + (∀ i, i < B → t.cells (i + 1) = Γ.one) ∧ + t.cells (B + 1) = Γ.blank + +/-- Rewinding a built unary prefix to cell 1 yields the public counter shape. -/ +theorem hasUnaryCounter_of_hasUnaryPrefix {t t' : Tape} {B : ℕ} + (hprefix : t.HasUnaryPrefix B) + (hhead : t'.head = 1) + (hcells : t'.cells = t.cells) : + t'.HasUnaryCounter B := by + refine ⟨hhead, ?_, ?_⟩ + · intro i hi + rw [hcells] + exact hprefix.2.1 i hi + · rw [hcells] + exact hprefix.2.2 B le_rfl + +/-- A tape holding a zero-length unary counter reads blank at its head. -/ +theorem hasUnaryCounter_read_zero {t : Tape} + (h : t.HasUnaryCounter 0) : t.read = Γ.blank := by + simp [Tape.read, h.1, h.2.2] + +/-- A tape holding a positive-length unary counter reads `1` at its head. -/ +theorem hasUnaryCounter_read_pos {t : Tape} {B : ℕ} + (h : t.HasUnaryCounter B) (hB : 0 < B) : t.read = Γ.one := by + have hcell := h.2.1 0 hB + simp [Tape.read, h.1, hcell] + +/-- Counter shape after `used` marks have already been consumed. The head is +at the next unconsumed counter cell, previous cells are blanked, remaining +marks are `1`, and the first cell after the total bound is blank. -/ +def HasCounterRemainder (t : Tape) (used total : ℕ) : Prop := + used ≤ total ∧ + t.head = used + 1 ∧ + (∀ i, i < used → t.cells (i + 1) = Γ.blank) ∧ + (∀ i, used ≤ i → i < total → t.cells (i + 1) = Γ.one) ∧ + t.cells (total + 1) = Γ.blank + +/-- A fresh unary counter is exactly a counter remainder with zero marks + consumed. -/ +theorem hasUnaryCounter_iff_remainder_zero {t : Tape} {B : ℕ} : + t.HasUnaryCounter B ↔ t.HasCounterRemainder 0 B := by + constructor + · intro h + refine ⟨Nat.zero_le B, h.1, ?_, ?_, h.2.2⟩ + · intro i hi + omega + · intro i _ hi + exact h.2.1 i hi + · intro h + exact ⟨h.2.1, fun i hi => h.2.2.2.1 i (by omega) hi, h.2.2.2.2⟩ + +/-- Once all counter marks are consumed, the head reads blank. -/ +theorem hasCounterRemainder_read_blank_of_done {t : Tape} {B : ℕ} + (h : t.HasCounterRemainder B B) : t.read = Γ.blank := by + simp [Tape.read, h.2.1, h.2.2.2.2] + +/-- While counter marks remain unconsumed, the head reads `1`. -/ +theorem hasCounterRemainder_read_one_of_remaining {t : Tape} {used total : ℕ} + (h : t.HasCounterRemainder used total) (hlt : used < total) : + t.read = Γ.one := by + have hcell := h.2.2.2.1 used (le_rfl) hlt + simp [Tape.read, h.2.1, hcell] + +/-- A well-shaped counter remainder never reads the left-end marker. -/ +theorem hasCounterRemainder_read_ne_start {t : Tape} {used total : ℕ} + (h : t.HasCounterRemainder used total) : t.read ≠ Γ.start := by + by_cases hremaining : used < total + · rw [hasCounterRemainder_read_one_of_remaining h hremaining] + decide + · have hle : used ≤ total := h.1 + have hdone : used = total := by omega + subst total + rw [hasCounterRemainder_read_blank_of_done h] + decide + +/-- Blanking the current counter mark and moving right advances the unary + counter remainder by one. -/ +theorem hasCounterRemainder_consume {t : Tape} {used total : ℕ} + (h : t.HasCounterRemainder used total) (hlt : used < total) : + (t.writeAndMove Γ.blank Dir3.right).HasCounterRemainder (used + 1) total := by + refine ⟨by omega, ?_, ?_, ?_, ?_⟩ + · simp [Tape.writeAndMove, Tape.write, Tape.move, h.2.1] + · intro i hi + unfold Tape.writeAndMove + simp only [Tape.move] + unfold Tape.write + have hhead_ne : ¬t.head = 0 := by rw [h.2.1]; omega + simp only [hhead_ne, ↓reduceIte] + by_cases hidx : i = used + · have hcellidx : i + 1 = t.head := by rw [h.2.1, hidx] + rw [hcellidx, Function.update_self] + · have hi_used : i < used := by omega + have hcell := h.2.2.1 i hi_used + have hne : t.head ≠ i + 1 := by rw [h.2.1]; omega + rw [Function.update_of_ne (Ne.symm hne)] + exact hcell + · intro i hge hltotal + have hcell := h.2.2.2.1 i (by omega) hltotal + unfold Tape.writeAndMove + simp only [Tape.move] + unfold Tape.write + have hhead_ne : ¬t.head = 0 := by rw [h.2.1]; omega + simp only [hhead_ne, ↓reduceIte] + have hne : t.head ≠ i + 1 := by rw [h.2.1]; omega + rw [Function.update_of_ne (Ne.symm hne)] + exact hcell + · unfold Tape.writeAndMove + simp only [Tape.move] + unfold Tape.write + have hhead_ne : ¬t.head = 0 := by rw [h.2.1]; omega + simp only [hhead_ne, ↓reduceIte] + have hne : t.head ≠ total + 1 := by rw [h.2.1]; omega + rw [Function.update_of_ne (Ne.symm hne)] + exact h.2.2.2.2 + +/-- Writing back the currently read non-start symbol and idling preserves a + tape. This is the basic preservation fact for non-active tapes in the + counter and guessing machines. -/ +theorem writeAndMove_readBack_idle_of_ne_start (t : Tape) + (hread : t.read ≠ Γ.start) : + t.writeAndMove (TM.readBackWrite t.read) (TM.idleDir t.read) = t := by + have hback : (TM.readBackWrite t.read).toΓ = t.read := by + cases h : t.read with + | zero => rfl + | one => rfl + | blank => rfl + | start => exact (hread h).elim + have hdir : TM.idleDir t.read = Dir3.stay := by + simp [TM.idleDir, hread] + rw [hback] + simp only [Tape.writeAndMove, hdir, Tape.move] + by_cases h0 : t.head = 0 + · simp [Tape.write, h0] + · simp [Tape.write, h0, Tape.read, Function.update_eq_self] + +end Tape + +namespace TM + +variable {n : ℕ} + +-- ════════════════════════════════════════════════════════════════════════ +-- Small alphabet / Tape.init helpers +-- ════════════════════════════════════════════════════════════════════════ + +private theorem started_ofBool_tape_read_ne_start (x : List Bool) : + (((Tape.init (x.map Γ.ofBool)).move Dir3.right).read) ≠ Γ.start := by + exact Tape.init_ofBool_move_right_read_ne_start x + +-- ════════════════════════════════════════════════════════════════════════ +-- inputLengthPlusOneCounterTM +-- ════════════════════════════════════════════════════════════════════════ + +/-- Control states for `inputLengthPlusOneCounterTM`. -/ +inductive LinearCounterPhase where + | scan + | rewind + | done + deriving DecidableEq + +/-- `LinearCounterPhase` has exactly the three states `scan`, `rewind`, + `done`. -/ +instance : Fintype LinearCounterPhase where + elems := {.scan, .rewind, .done} + complete := fun x => by cases x <;> simp + +/-- Preserve every writable work-tape symbol. -/ +def counterPreserveWork (wHeads : Fin n → Γ) : Fin n → Γw := + fun i => readBackWrite (wHeads i) + +/-- Keep every work head stationary, except when bouncing off the start marker. -/ +def counterIdleDirs (wHeads : Fin n → Γ) : Fin n → Dir3 := + fun i => idleDir (wHeads i) + +private theorem counterIdleDirs_right_of_start (wHeads : Fin n → Γ) : + ∀ i, wHeads i = Γ.start → counterIdleDirs wHeads i = Dir3.right := by + intro i hi + exact idleDir_right_of_start hi + +/-- Write one unary mark on the counter tape and preserve every other tape. -/ +def counterWriteOneWork (counterIdx : Fin n) (wHeads : Fin n → Γ) : + Fin n → Γw := + fun i => if i = counterIdx then Γw.one else readBackWrite (wHeads i) + +/-- Advance the counter head and idle every other work head. -/ +def counterAdvanceDirs (counterIdx : Fin n) (wHeads : Fin n → Γ) : + Fin n → Dir3 := + fun i => if i = counterIdx then Dir3.right else idleDir (wHeads i) + +private theorem counterAdvanceDirs_right_of_start (counterIdx : Fin n) + (wHeads : Fin n → Γ) : + ∀ i, wHeads i = Γ.start → counterAdvanceDirs counterIdx wHeads i = Dir3.right := by + intro i hi + by_cases hidx : i = counterIdx + · simp [counterAdvanceDirs, hidx] + · simp [counterAdvanceDirs, hidx, idleDir_right_of_start hi] + +/-- Rewind the counter head and idle every other work head. -/ +def counterRewindDirs (counterIdx : Fin n) (wHeads : Fin n → Γ) : + Fin n → Dir3 := + fun i => if i = counterIdx then moveLeftDir (wHeads i) else idleDir (wHeads i) + +private theorem counterRewindDirs_right_of_start (counterIdx : Fin n) + (wHeads : Fin n → Γ) : + ∀ i, wHeads i = Γ.start → counterRewindDirs counterIdx wHeads i = Dir3.right := by + intro i hi + by_cases hidx : i = counterIdx + · subst hidx + simp [counterRewindDirs, moveLeftDir_right_of_start hi] + · simp [counterRewindDirs, hidx, idleDir_right_of_start hi] + +private theorem counterRightOfStart_idle (iHead : Γ) (wHeads : Fin n → Γ) (oHead : Γ) : + (iHead = Γ.start → idleDir iHead = Dir3.right) ∧ + (∀ i, wHeads i = Γ.start → counterIdleDirs wHeads i = Dir3.right) ∧ + (oHead = Γ.start → idleDir oHead = Dir3.right) := + ⟨idleDir_right_of_start, counterIdleDirs_right_of_start wHeads, + idleDir_right_of_start⟩ + +private theorem counterRightOfStart_advance (counterIdx : Fin n) + (iHead : Γ) (wHeads : Fin n → Γ) (oHead : Γ) : + (iHead = Γ.start → Dir3.right = Dir3.right) ∧ + (∀ i, wHeads i = Γ.start → counterAdvanceDirs counterIdx wHeads i = Dir3.right) ∧ + (oHead = Γ.start → idleDir oHead = Dir3.right) := + ⟨fun _ => rfl, counterAdvanceDirs_right_of_start counterIdx wHeads, + idleDir_right_of_start⟩ + +private theorem counterRightOfStart_scanStart + (iHead : Γ) (wHeads : Fin n → Γ) (oHead : Γ) : + (iHead = Γ.start → Dir3.right = Dir3.right) ∧ + (∀ i, wHeads i = Γ.start → counterIdleDirs wHeads i = Dir3.right) ∧ + (oHead = Γ.start → idleDir oHead = Dir3.right) := + ⟨fun _ => rfl, counterIdleDirs_right_of_start wHeads, idleDir_right_of_start⟩ + +private theorem counterRightOfStart_idleInput_advance (counterIdx : Fin n) + (iHead : Γ) (wHeads : Fin n → Γ) (oHead : Γ) : + (iHead = Γ.start → idleDir iHead = Dir3.right) ∧ + (∀ i, wHeads i = Γ.start → counterAdvanceDirs counterIdx wHeads i = Dir3.right) ∧ + (oHead = Γ.start → idleDir oHead = Dir3.right) := + ⟨idleDir_right_of_start, counterAdvanceDirs_right_of_start counterIdx wHeads, + idleDir_right_of_start⟩ + +private theorem counterRightOfStart_rewind (counterIdx : Fin n) + (iHead : Γ) (wHeads : Fin n → Γ) (oHead : Γ) : + (iHead = Γ.start → idleDir iHead = Dir3.right) ∧ + (∀ i, wHeads i = Γ.start → counterRewindDirs counterIdx wHeads i = Dir3.right) ∧ + (oHead = Γ.start → idleDir oHead = Dir3.right) := + ⟨idleDir_right_of_start, counterRewindDirs_right_of_start counterIdx wHeads, + idleDir_right_of_start⟩ + +/-- Write a unary counter of length `|input| + 1` to `counterIdx`. + +Starting with the input head on `▷` and an empty counter tape, the `scan` +phase skips the input start cell, writes one counter mark per input bit, +then writes one extra mark when the input head reaches blank. The `rewind` +phase rewinds the counter tape to cell 1 and halts. + +The machine does not try to restore the input head; later composition layers +can rewind or retarget input as needed. -/ +def inputLengthPlusOneCounterTM (counterIdx : Fin n) : TM n where + Q := LinearCounterPhase + qstart := .scan + qhalt := .done + δ := fun state iHead wHeads oHead => + match state with + | .scan => + if iHead = Γ.start then + (.scan, counterPreserveWork wHeads, readBackWrite oHead, + Dir3.right, counterIdleDirs wHeads, idleDir oHead) + else if iHead = Γ.blank then + (.rewind, counterWriteOneWork counterIdx wHeads, readBackWrite oHead, + idleDir iHead, counterAdvanceDirs counterIdx wHeads, idleDir oHead) + else + (.scan, counterWriteOneWork counterIdx wHeads, readBackWrite oHead, + Dir3.right, counterAdvanceDirs counterIdx wHeads, idleDir oHead) + | .rewind => + if wHeads counterIdx = Γ.start then + (.done, counterPreserveWork wHeads, readBackWrite oHead, + idleDir iHead, counterAdvanceDirs counterIdx wHeads, idleDir oHead) + else + (.rewind, counterPreserveWork wHeads, readBackWrite oHead, + idleDir iHead, counterRewindDirs counterIdx wHeads, idleDir oHead) + | .done => + (.done, counterPreserveWork wHeads, readBackWrite oHead, + idleDir iHead, counterIdleDirs wHeads, idleDir oHead) + δ_right_of_start := by + intro state iHead wHeads oHead + cases state + · by_cases hiStart : iHead = Γ.start + · simpa [hiStart] using counterRightOfStart_scanStart iHead wHeads oHead + · by_cases hiBlank : iHead = Γ.blank + · simpa [hiStart, hiBlank] using + counterRightOfStart_idleInput_advance counterIdx iHead wHeads oHead + · simpa [hiStart, hiBlank] using + counterRightOfStart_advance counterIdx iHead wHeads oHead + · by_cases hcounter : wHeads counterIdx = Γ.start + · simpa [hcounter] using + counterRightOfStart_idleInput_advance counterIdx iHead wHeads oHead + · simpa [hcounter] using + counterRightOfStart_rewind counterIdx iHead wHeads oHead + · exact counterRightOfStart_idle iHead wHeads oHead + +-- ════════════════════════════════════════════════════════════════════════ +-- One-step transition API +-- ════════════════════════════════════════════════════════════════════════ + +/-- In the `scan` phase, reading `▷` on the input keeps the machine in + `scan`. -/ +theorem inputLengthPlusOneCounterTM_scan_start_state + (counterIdx : Fin n) (inp : Tape) (work : Fin n → Tape) (out : Tape) + (hinp : inp.read = Γ.start) : + (((inputLengthPlusOneCounterTM counterIdx).step + { state := LinearCounterPhase.scan, input := inp, work := work, output := out }).get + (by simp [TM.step, inputLengthPlusOneCounterTM])).state = + LinearCounterPhase.scan := by + simp [TM.step, inputLengthPlusOneCounterTM, hinp] + +/-- The start-skip step positions an initially empty counter tape at cell 1, + giving the zero-length unary-prefix invariant. -/ +theorem inputLengthPlusOneCounterTM_scan_start_initializes_counter + (counterIdx : Fin n) (inp : Tape) (work : Fin n → Tape) (out : Tape) + (hinp : inp.read = Γ.start) + (hcounter : work counterIdx = Tape.init []) : + ((((inputLengthPlusOneCounterTM counterIdx).step + { state := LinearCounterPhase.scan, input := inp, work := work, output := out }).get + (by simp [TM.step, inputLengthPlusOneCounterTM])).work counterIdx).HasUnaryPrefix 0 := by + simp [TM.step, inputLengthPlusOneCounterTM, hinp, counterPreserveWork, + counterIdleDirs, hcounter] + simpa [Tape.writeAndMove, Tape.write] using + Tape.init_nil_move_right_hasUnaryPrefix_zero + +/-- In the `scan` phase, reading blank on the input moves the machine to the + `rewind` phase. -/ +theorem inputLengthPlusOneCounterTM_scan_blank_state + (counterIdx : Fin n) (inp : Tape) (work : Fin n → Tape) (out : Tape) + (hinp : inp.read = Γ.blank) : + (((inputLengthPlusOneCounterTM counterIdx).step + { state := LinearCounterPhase.scan, input := inp, work := work, output := out }).get + (by simp [TM.step, inputLengthPlusOneCounterTM])).state = + LinearCounterPhase.rewind := by + simp [TM.step, inputLengthPlusOneCounterTM, hinp] + +/-- In the `scan` phase, reading an input bit (neither `▷` nor blank) keeps + the machine in `scan`. -/ +theorem inputLengthPlusOneCounterTM_scan_bit_state + (counterIdx : Fin n) (inp : Tape) (work : Fin n → Tape) (out : Tape) + (hstart : inp.read ≠ Γ.start) (hblank : inp.read ≠ Γ.blank) : + (((inputLengthPlusOneCounterTM counterIdx).step + { state := LinearCounterPhase.scan, input := inp, work := work, output := out }).get + (by simp [TM.step, inputLengthPlusOneCounterTM])).state = + LinearCounterPhase.scan := by + simp [TM.step, inputLengthPlusOneCounterTM, hstart, hblank] + +/-- Scanning an input bit writes one unary mark and advances the counter + prefix by one. -/ +theorem inputLengthPlusOneCounterTM_scan_bit_extends_counter + (counterIdx : Fin n) (inp : Tape) (work : Fin n → Tape) (out : Tape) + {used : ℕ} + (hprefix : (work counterIdx).HasUnaryPrefix used) + (hstart : inp.read ≠ Γ.start) (hblank : inp.read ≠ Γ.blank) : + ((((inputLengthPlusOneCounterTM counterIdx).step + { state := LinearCounterPhase.scan, input := inp, work := work, output := out }).get + (by simp [TM.step, inputLengthPlusOneCounterTM])).work counterIdx).HasUnaryPrefix + (used + 1) := by + simp [TM.step, inputLengthPlusOneCounterTM, hstart, hblank, + counterWriteOneWork, counterAdvanceDirs, Tape.hasUnaryPrefix_write_one hprefix] + +/-- Scanning the input blank writes the final extra unary mark and enters the + rewind phase. -/ +theorem inputLengthPlusOneCounterTM_scan_blank_extends_counter + (counterIdx : Fin n) (inp : Tape) (work : Fin n → Tape) (out : Tape) + {used : ℕ} + (hprefix : (work counterIdx).HasUnaryPrefix used) + (hinp : inp.read = Γ.blank) : + ((((inputLengthPlusOneCounterTM counterIdx).step + { state := LinearCounterPhase.scan, input := inp, work := work, output := out }).get + (by simp [TM.step, inputLengthPlusOneCounterTM])).work counterIdx).HasUnaryPrefix + (used + 1) := by + have hstart : inp.read ≠ Γ.start := by rw [hinp]; simp + simp [TM.step, inputLengthPlusOneCounterTM, hinp, + counterWriteOneWork, counterAdvanceDirs, Tape.hasUnaryPrefix_write_one hprefix] + +/-- In the `rewind` phase, reading `▷` on the counter tape moves the machine + to `done`. -/ +theorem inputLengthPlusOneCounterTM_rewind_start_state + (counterIdx : Fin n) (inp : Tape) (work : Fin n → Tape) (out : Tape) + (hcounter : (work counterIdx).read = Γ.start) : + (((inputLengthPlusOneCounterTM counterIdx).step + { state := LinearCounterPhase.rewind, input := inp, work := work, output := out }).get + (by simp [TM.step, inputLengthPlusOneCounterTM])).state = + LinearCounterPhase.done := by + simp [TM.step, inputLengthPlusOneCounterTM, hcounter] + +/-- In the `rewind` phase, a counter-tape read other than `▷` keeps the + machine in `rewind`. -/ +theorem inputLengthPlusOneCounterTM_rewind_left_state + (counterIdx : Fin n) (inp : Tape) (work : Fin n → Tape) (out : Tape) + (hcounter : (work counterIdx).read ≠ Γ.start) : + (((inputLengthPlusOneCounterTM counterIdx).step + { state := LinearCounterPhase.rewind, input := inp, work := work, output := out }).get + (by simp [TM.step, inputLengthPlusOneCounterTM])).state = + LinearCounterPhase.rewind := by + simp [TM.step, inputLengthPlusOneCounterTM, hcounter] + +/-- One NTM trace step of the lifted counter machine leaves a non-counter work + tape unchanged when that tape is the started blank tape. -/ +theorem inputLengthPlusOneCounterTM_toNTM_trace_one_preserves_started_blank_other_work + (counterIdx : Fin n) (choice : Bool) + (c : Cfg n (inputLengthPlusOneCounterTM counterIdx).Q) + (i : Fin n) (hi : i ≠ counterIdx) + (hwork : c.work i = (Tape.init []).move Dir3.right) : + (((inputLengthPlusOneCounterTM counterIdx).toNTM).trace 1 + (fun _ => choice) c).work i = (Tape.init []).move Dir3.right := by + cases c with + | mk state input work output => + change work i = (Tape.init []).move Dir3.right at hwork + cases state + · by_cases hstart : input.cells input.head = Γ.start + · simp [NTM.trace, TM.toNTM, inputLengthPlusOneCounterTM, hstart, + counterPreserveWork, counterIdleDirs, hwork, Tape.writeAndMove, + Tape.write, Tape.move, Tape.read, readBackWrite, idleDir, Tape.init] + · by_cases hblank : input.cells input.head = Γ.blank + · simp [NTM.trace, TM.toNTM, inputLengthPlusOneCounterTM, hblank, + counterWriteOneWork, counterAdvanceDirs, hwork, hi, + Tape.writeAndMove, Tape.write, Tape.move, Tape.read, readBackWrite, + idleDir, Tape.init] + · simp [NTM.trace, TM.toNTM, inputLengthPlusOneCounterTM, hstart, hblank, + counterWriteOneWork, counterAdvanceDirs, hwork, hi, + Tape.writeAndMove, Tape.write, Tape.move, Tape.read, readBackWrite, + idleDir, Tape.init] + · by_cases hcounter : (work counterIdx).cells (work counterIdx).head = Γ.start + · simp [NTM.trace, TM.toNTM, inputLengthPlusOneCounterTM, hcounter, + counterPreserveWork, counterAdvanceDirs, hwork, hi, Tape.writeAndMove, + Tape.write, Tape.move, Tape.read, readBackWrite, idleDir, Tape.init] + · simp [NTM.trace, TM.toNTM, inputLengthPlusOneCounterTM, hcounter, + counterPreserveWork, counterRewindDirs, hwork, hi, Tape.writeAndMove, + Tape.write, Tape.move, Tape.read, readBackWrite, idleDir, Tape.init] + · simp [NTM.trace, TM.toNTM, inputLengthPlusOneCounterTM, hwork] + +/-- One NTM trace step of the lifted counter machine (in a non-halted state) + moves a fresh blank non-counter work tape past its `▷` marker, turning it + into the started blank tape. -/ +theorem inputLengthPlusOneCounterTM_toNTM_trace_one_initializes_blank_other_work + (counterIdx : Fin n) (choice : Bool) + (c : Cfg n (inputLengthPlusOneCounterTM counterIdx).Q) + (i : Fin n) (hi : i ≠ counterIdx) + (hstate : c.state ≠ LinearCounterPhase.done) + (hwork : c.work i = Tape.init []) : + (((inputLengthPlusOneCounterTM counterIdx).toNTM).trace 1 + (fun _ => choice) c).work i = (Tape.init []).move Dir3.right := by + cases c with + | mk state input work output => + change work i = Tape.init [] at hwork + cases state + · by_cases hstart : input.cells input.head = Γ.start + · simp [NTM.trace, TM.toNTM, inputLengthPlusOneCounterTM, hstart, + counterPreserveWork, counterIdleDirs, hwork, Tape.writeAndMove, + Tape.write, Tape.move, Tape.read, readBackWrite, idleDir, Tape.init] + · by_cases hblank : input.cells input.head = Γ.blank + · simp [NTM.trace, TM.toNTM, inputLengthPlusOneCounterTM, hblank, + counterWriteOneWork, counterAdvanceDirs, hwork, hi, + Tape.writeAndMove, Tape.write, Tape.move, Tape.read, readBackWrite, + idleDir, Tape.init] + · simp [NTM.trace, TM.toNTM, inputLengthPlusOneCounterTM, hstart, hblank, + counterWriteOneWork, counterAdvanceDirs, hwork, hi, + Tape.writeAndMove, Tape.write, Tape.move, Tape.read, readBackWrite, + idleDir, Tape.init] + · by_cases hcounter : (work counterIdx).cells (work counterIdx).head = Γ.start + · simp [NTM.trace, TM.toNTM, inputLengthPlusOneCounterTM, hcounter, + counterPreserveWork, counterAdvanceDirs, hwork, hi, Tape.writeAndMove, + Tape.write, Tape.move, Tape.read, readBackWrite, idleDir, Tape.init] + · simp [NTM.trace, TM.toNTM, inputLengthPlusOneCounterTM, hcounter, + counterPreserveWork, counterRewindDirs, hwork, hi, Tape.writeAndMove, + Tape.write, Tape.move, Tape.read, readBackWrite, idleDir, Tape.init] + · exact (hstate rfl).elim + +/-- One NTM trace step of the lifted counter machine leaves a started blank + output tape unchanged. -/ +theorem inputLengthPlusOneCounterTM_toNTM_trace_one_preserves_started_blank_output + (counterIdx : Fin n) (choice : Bool) + (c : Cfg n (inputLengthPlusOneCounterTM counterIdx).Q) + (houtput : c.output = (Tape.init []).move Dir3.right) : + (((inputLengthPlusOneCounterTM counterIdx).toNTM).trace 1 + (fun _ => choice) c).output = (Tape.init []).move Dir3.right := by + cases c with + | mk state input work output => + change output = (Tape.init []).move Dir3.right at houtput + cases state + · by_cases hstart : input.cells input.head = Γ.start + · simp [NTM.trace, TM.toNTM, inputLengthPlusOneCounterTM, hstart, + houtput, Tape.writeAndMove, Tape.write, Tape.move, Tape.read, + readBackWrite, idleDir, Tape.init] + · by_cases hblank : input.cells input.head = Γ.blank + · simp [NTM.trace, TM.toNTM, inputLengthPlusOneCounterTM, hblank, + houtput, Tape.writeAndMove, Tape.write, Tape.move, Tape.read, + readBackWrite, idleDir, Tape.init] + · simp [NTM.trace, TM.toNTM, inputLengthPlusOneCounterTM, hstart, hblank, + houtput, Tape.writeAndMove, Tape.write, Tape.move, Tape.read, + readBackWrite, idleDir, Tape.init] + · by_cases hcounter : (work counterIdx).cells (work counterIdx).head = Γ.start + · simp [NTM.trace, TM.toNTM, inputLengthPlusOneCounterTM, hcounter, + houtput, Tape.writeAndMove, Tape.write, Tape.move, Tape.read, + readBackWrite, idleDir, Tape.init] + · simp [NTM.trace, TM.toNTM, inputLengthPlusOneCounterTM, hcounter, + houtput, Tape.writeAndMove, Tape.write, Tape.move, Tape.read, + readBackWrite, idleDir, Tape.init] + · simp [NTM.trace, TM.toNTM, inputLengthPlusOneCounterTM, houtput] + +/-- One NTM trace step of the lifted counter machine (in a non-halted state) + moves a fresh blank output tape past its `▷` marker, turning it into the + started blank tape. -/ +theorem inputLengthPlusOneCounterTM_toNTM_trace_one_initializes_blank_output + (counterIdx : Fin n) (choice : Bool) + (c : Cfg n (inputLengthPlusOneCounterTM counterIdx).Q) + (hstate : c.state ≠ LinearCounterPhase.done) + (houtput : c.output = Tape.init []) : + (((inputLengthPlusOneCounterTM counterIdx).toNTM).trace 1 + (fun _ => choice) c).output = (Tape.init []).move Dir3.right := by + cases c with + | mk state input work output => + change output = Tape.init [] at houtput + cases state + · by_cases hstart : input.cells input.head = Γ.start + · simp [NTM.trace, TM.toNTM, inputLengthPlusOneCounterTM, hstart, + houtput, Tape.writeAndMove, Tape.write, Tape.move, Tape.read, + readBackWrite, idleDir, Tape.init] + · by_cases hblank : input.cells input.head = Γ.blank + · simp [NTM.trace, TM.toNTM, inputLengthPlusOneCounterTM, hblank, + houtput, Tape.writeAndMove, Tape.write, Tape.move, Tape.read, + readBackWrite, idleDir, Tape.init] + · simp [NTM.trace, TM.toNTM, inputLengthPlusOneCounterTM, hstart, hblank, + houtput, Tape.writeAndMove, Tape.write, Tape.move, Tape.read, + readBackWrite, idleDir, Tape.init] + · by_cases hcounter : (work counterIdx).cells (work counterIdx).head = Γ.start + · simp [NTM.trace, TM.toNTM, inputLengthPlusOneCounterTM, hcounter, + houtput, Tape.writeAndMove, Tape.write, Tape.move, Tape.read, + readBackWrite, idleDir, Tape.init] + · simp [NTM.trace, TM.toNTM, inputLengthPlusOneCounterTM, hcounter, + houtput, Tape.writeAndMove, Tape.write, Tape.move, Tape.read, + readBackWrite, idleDir, Tape.init] + · exact (hstate rfl).elim + +-- ════════════════════════════════════════════════════════════════════════ +-- Multi-step correctness for inputLengthPlusOneCounterTM +-- ════════════════════════════════════════════════════════════════════════ + +private theorem inputLengthPlusOneCounterTM_start_step + (counterIdx : Fin n) (x : List Bool) (work : Fin n → Tape) (out : Tape) + (hcounter : work counterIdx = Tape.init []) : + ∃ c₁, + (inputLengthPlusOneCounterTM counterIdx).step + { state := LinearCounterPhase.scan, + input := Tape.init (x.map Γ.ofBool), + work := work, output := out } = some c₁ ∧ + c₁.state = LinearCounterPhase.scan ∧ + c₁.input.cells = (Tape.init (x.map Γ.ofBool)).cells ∧ + c₁.input.head = 1 ∧ + (c₁.work counterIdx).HasUnaryPrefix 0 ∧ + (c₁.work counterIdx).cells 0 = Γ.start := by + have hread : (Tape.init (x.map Γ.ofBool)).read = Γ.start := by + simp [Tape.read, Tape.init] + simp [TM.step, inputLengthPlusOneCounterTM, hread] + refine ⟨?_, ?_, ?_, ?_⟩ + · rw [Tape.move_cells] + · simp [Tape.init, Tape.move] + · have hcounter_read : (work counterIdx).read = Γ.start := by + rw [hcounter] + simp [Tape.read, Tape.init] + simpa [counterPreserveWork, counterIdleDirs, hcounter, hcounter_read, + Tape.writeAndMove, Tape.write] using + Tape.init_nil_move_right_hasUnaryPrefix_zero + · simp [counterIdleDirs, hcounter, Tape.writeAndMove, Tape.move_cells, + Tape.write, Tape.init] + +private theorem inputLengthPlusOneCounterTM_scan_bit_step + (counterIdx : Fin n) (x : List Bool) (k : ℕ) + (c : Cfg n (inputLengthPlusOneCounterTM counterIdx).Q) + (hk : k < x.length) + (hstate : c.state = LinearCounterPhase.scan) + (hinput_cells : c.input.cells = (Tape.init (x.map Γ.ofBool)).cells) + (hinput_head : c.input.head = k + 1) + (hprefix : (c.work counterIdx).HasUnaryPrefix k) + (hcell0 : (c.work counterIdx).cells 0 = Γ.start) : + ∃ c', + (inputLengthPlusOneCounterTM counterIdx).step c = some c' ∧ + c'.state = LinearCounterPhase.scan ∧ + c'.input.cells = (Tape.init (x.map Γ.ofBool)).cells ∧ + c'.input.head = k + 2 ∧ + (c'.work counterIdx).HasUnaryPrefix (k + 1) ∧ + (c'.work counterIdx).cells 0 = Γ.start := by + have hread : c.input.read = Γ.ofBool (x[k]'hk) := by + show c.input.cells c.input.head = _ + rw [hinput_head, hinput_cells] + exact Tape.init_ofBool_cells_lt x k hk + have hstart : c.input.read ≠ Γ.start := by + rw [hread] + exact Γ.ofBool_ne_start _ + have hblank : c.input.read ≠ Γ.blank := by + rw [hread] + exact Γ.ofBool_ne_blank _ + simp only [TM.step, hstate, inputLengthPlusOneCounterTM, hstart, hblank] + refine ⟨_, rfl, rfl, ?_, ?_, ?_, ?_⟩ + · rw [Tape.move_cells] + exact hinput_cells + · simp [Tape.move, hinput_head] + · simpa [counterWriteOneWork, counterAdvanceDirs] using + Tape.hasUnaryPrefix_write_one hprefix + · simpa [counterWriteOneWork, counterAdvanceDirs] using + Tape.hasUnaryPrefix_write_one_cell0 hprefix hcell0 + +private theorem inputLengthPlusOneCounterTM_scan_bits_loop + (counterIdx : Fin n) (x : List Bool) : + ∀ (m k : ℕ) (c : Cfg n (inputLengthPlusOneCounterTM counterIdx).Q), + k + m ≤ x.length → + c.state = LinearCounterPhase.scan → + c.input.cells = (Tape.init (x.map Γ.ofBool)).cells → + c.input.head = k + 1 → + (c.work counterIdx).HasUnaryPrefix k → + (c.work counterIdx).cells 0 = Γ.start → + ∃ c', + (inputLengthPlusOneCounterTM counterIdx).reachesIn m c c' ∧ + c'.state = LinearCounterPhase.scan ∧ + c'.input.cells = (Tape.init (x.map Γ.ofBool)).cells ∧ + c'.input.head = k + m + 1 ∧ + (c'.work counterIdx).HasUnaryPrefix (k + m) ∧ + (c'.work counterIdx).cells 0 = Γ.start := by + intro m + induction m with + | zero => + intro k c _ hstate hcells hhead hprefix hcell0 + refine ⟨c, .zero, hstate, hcells, ?_, ?_, hcell0⟩ + · omega + · simpa using hprefix + | succ m ih => + intro k c hle hstate hcells hhead hprefix hcell0 + have hk : k < x.length := by omega + obtain ⟨c₁, hstep, hstate₁, hcells₁, hhead₁, hprefix₁, hcell0₁⟩ := + inputLengthPlusOneCounterTM_scan_bit_step counterIdx x k c hk hstate + hcells hhead hprefix hcell0 + have hle₁ : (k + 1) + m ≤ x.length := by omega + obtain ⟨c', hreach, hstate', hcells', hhead', hprefix', hcell0'⟩ := + ih (k + 1) c₁ hle₁ hstate₁ hcells₁ (by omega) hprefix₁ hcell0₁ + refine ⟨c', .step hstep hreach, hstate', hcells', ?_, ?_, hcell0'⟩ + · rw [hhead'] + omega + · convert hprefix' using 1 + omega + +private theorem inputLengthPlusOneCounterTM_scan_blank_step + (counterIdx : Fin n) (x : List Bool) + (c : Cfg n (inputLengthPlusOneCounterTM counterIdx).Q) + (hstate : c.state = LinearCounterPhase.scan) + (hinput_cells : c.input.cells = (Tape.init (x.map Γ.ofBool)).cells) + (hinput_head : c.input.head = x.length + 1) + (hprefix : (c.work counterIdx).HasUnaryPrefix x.length) + (hcell0 : (c.work counterIdx).cells 0 = Γ.start) : + ∃ c', + (inputLengthPlusOneCounterTM counterIdx).step c = some c' ∧ + c'.state = LinearCounterPhase.rewind ∧ + c'.input = c.input ∧ + (c'.work counterIdx).HasUnaryPrefix (x.length + 1) ∧ + (c'.work counterIdx).cells 0 = Γ.start := by + have hread : c.input.read = Γ.blank := by + show c.input.cells c.input.head = _ + rw [hinput_head, hinput_cells] + exact Tape.init_ofBool_cells_ge x x.length le_rfl + simp only [TM.step, hstate, inputLengthPlusOneCounterTM, hread] + refine ⟨_, rfl, rfl, ?_, ?_, ?_⟩ + · simp [TM.idleDir, Tape.move] + · simpa [counterWriteOneWork, counterAdvanceDirs] using + Tape.hasUnaryPrefix_write_one hprefix + · simpa [counterWriteOneWork, counterAdvanceDirs] using + Tape.hasUnaryPrefix_write_one_cell0 hprefix hcell0 + +private theorem inputLengthPlusOneCounterTM_rewind_step_left + (counterIdx : Fin n) (c : Cfg n (inputLengthPlusOneCounterTM counterIdx).Q) + (hstate : c.state = LinearCounterPhase.rewind) + (hinp : c.input.read ≠ Γ.start) + (hread : (c.work counterIdx).read ≠ Γ.start) + (_ : (c.work counterIdx).cells 0 = Γ.start) + (_ : ∀ j, j ≥ 1 → (c.work counterIdx).cells j ≠ Γ.start) : + ∃ c', + (inputLengthPlusOneCounterTM counterIdx).step c = some c' ∧ + c'.state = LinearCounterPhase.rewind ∧ + c'.input = c.input ∧ + (c'.work counterIdx).head = (c.work counterIdx).head - 1 ∧ + (c'.work counterIdx).cells = (c.work counterIdx).cells := by + simp only [TM.step, hstate, inputLengthPlusOneCounterTM, hread] + refine ⟨_, rfl, rfl, ?_, ?_, ?_⟩ + · show c.input.move (TM.idleDir c.input.read) = c.input + exact TM.transitionInput_eq_self hinp + · by_cases h0 : (c.work counterIdx).head = 0 + · simp [counterRewindDirs, moveLeftDir, hread, Tape.writeAndMove, Tape.move, + Tape.write, h0] + · simp [counterRewindDirs, moveLeftDir, hread, Tape.writeAndMove, Tape.move, + Tape.write, h0] + · simp [counterRewindDirs, moveLeftDir, hread, + Tape.writeAndMove, Tape.move_cells] + change ((c.work counterIdx).write + ((readBackWrite (c.work counterIdx).read).toΓ)).cells = + (c.work counterIdx).cells + rw [toΓ_readBackWrite_of_ne_start hread] + simp only [Tape.write, Tape.read] + split + · rfl + · exact Function.update_eq_self _ _ + +private theorem inputLengthPlusOneCounterTM_rewind_step_base + (counterIdx : Fin n) (c : Cfg n (inputLengthPlusOneCounterTM counterIdx).Q) + (hstate : c.state = LinearCounterPhase.rewind) + (hinp : c.input.read ≠ Γ.start) + (hread : (c.work counterIdx).read = Γ.start) + (_ : (c.work counterIdx).cells 0 = Γ.start) + (hnostart : ∀ j, j ≥ 1 → (c.work counterIdx).cells j ≠ Γ.start) : + ∃ c', + (inputLengthPlusOneCounterTM counterIdx).step c = some c' ∧ + c'.state = LinearCounterPhase.done ∧ + c'.input = c.input ∧ + (c'.work counterIdx).head = 1 ∧ + (c'.work counterIdx).cells = (c.work counterIdx).cells := by + have hhead : (c.work counterIdx).head = 0 := by + by_contra h + exact hnostart (c.work counterIdx).head (by omega) (by rwa [Tape.read] at hread) + simp only [TM.step, hstate, inputLengthPlusOneCounterTM, hread] + refine ⟨_, rfl, rfl, ?_, ?_, ?_⟩ + · show c.input.move (TM.idleDir c.input.read) = c.input + exact TM.transitionInput_eq_self hinp + · simp [counterAdvanceDirs, Tape.writeAndMove, Tape.move, Tape.write, hhead] + · simp [counterAdvanceDirs, Tape.writeAndMove, Tape.move_cells, Tape.write, hhead] + +private theorem inputLengthPlusOneCounterTM_rewind_loop (counterIdx : Fin n) : + ∀ (h : ℕ) (c : Cfg n (inputLengthPlusOneCounterTM counterIdx).Q), + c.state = LinearCounterPhase.rewind → + c.input.read ≠ Γ.start → + (c.work counterIdx).cells 0 = Γ.start → + (∀ j, j ≥ 1 → (c.work counterIdx).cells j ≠ Γ.start) → + (c.work counterIdx).head = h → + ∃ c', + (inputLengthPlusOneCounterTM counterIdx).reachesIn (h + 1) c c' ∧ + (inputLengthPlusOneCounterTM counterIdx).halted c' ∧ + c'.input = c.input ∧ + (c'.work counterIdx).head = 1 ∧ + (c'.work counterIdx).cells = (c.work counterIdx).cells := by + intro h + induction h with + | zero => + intro c hstate hinp hcell0 hnostart hhead + have hread : (c.work counterIdx).read = Γ.start := by + simp [Tape.read, hhead, hcell0] + obtain ⟨c', hstep, hstate', hinp', hhead', hcells'⟩ := + inputLengthPlusOneCounterTM_rewind_step_base counterIdx c hstate hinp hread hcell0 hnostart + exact ⟨c', .step hstep .zero, hstate', hinp', hhead', hcells'⟩ + | succ h ih => + intro c hstate hinp hcell0 hnostart hhead + have hread : (c.work counterIdx).read ≠ Γ.start := by + simp [Tape.read, hhead] + exact hnostart (h + 1) (by omega) + obtain ⟨c1, hstep, hstate1, hinput1_eq, hhead1, hcells1⟩ := + inputLengthPlusOneCounterTM_rewind_step_left counterIdx c hstate hinp hread hcell0 hnostart + have hinp1_ns : c1.input.read ≠ Γ.start := by + rw [hinput1_eq] + exact hinp + have hhead1' : (c1.work counterIdx).head = h := by + rw [hhead1, hhead] + omega + obtain ⟨c', hreach, hhalt, hinp', hhead', hcells'⟩ := + ih c1 hstate1 hinp1_ns (by rw [hcells1]; exact hcell0) + (by intro j hj; rw [hcells1]; exact hnostart j hj) hhead1' + exact ⟨c', .step hstep hreach, hhalt, by rw [hinp', hinput1_eq], hhead', + by rw [hcells', hcells1]⟩ + +/-- A convenient linear upper bound for `inputLengthPlusOneCounterTM`. -/ +def inputLengthPlusOneCounterTime (xLen : ℕ) : ℕ := + 3 * xLen + 10 + +/-- `inputLengthPlusOneCounterTM` materializes a unary counter of length + `|x| + 1` on the designated work tape and rewinds it to cell 1. -/ +theorem inputLengthPlusOneCounterTM_hoareTime + (counterIdx : Fin n) (x : List Bool) : + (inputLengthPlusOneCounterTM counterIdx).HoareTime + (fun inp work _ => + inp = Tape.init (x.map Γ.ofBool) ∧ + work counterIdx = Tape.init []) + (fun _ work _ => + (work counterIdx).HasUnaryCounter (x.length + 1)) + (inputLengthPlusOneCounterTime x.length) := by + intro inp work out ⟨hinput, hcounter⟩ + subst inp + let c0 : Cfg n (inputLengthPlusOneCounterTM counterIdx).Q := + { state := LinearCounterPhase.scan, + input := Tape.init (x.map Γ.ofBool), + work := work, + output := out } + obtain ⟨c1, hstep_start, hstate1, hcells1, hhead1, hprefix1, hcell01⟩ := + inputLengthPlusOneCounterTM_start_step counterIdx x work out hcounter + obtain ⟨c2, hreach_scan, hstate2, hcells2, hhead2, hprefix2, hcell02⟩ := + inputLengthPlusOneCounterTM_scan_bits_loop counterIdx x x.length 0 c1 + (by omega) hstate1 hcells1 hhead1 hprefix1 hcell01 + have hhead2' : c2.input.head = x.length + 1 := by + rw [hhead2] + omega + have hprefix2' : (c2.work counterIdx).HasUnaryPrefix x.length := by + simpa using hprefix2 + obtain ⟨c3, hstep_blank, hstate3, hinput3, hprefix3, hcell03⟩ := + inputLengthPlusOneCounterTM_scan_blank_step counterIdx x c2 + hstate2 hcells2 hhead2' hprefix2' hcell02 + have hinp3 : c3.input.read ≠ Γ.start := by + rw [hinput3] + show c2.input.read ≠ Γ.start + rw [show c2.input.read = c2.input.cells c2.input.head by rfl, hhead2', hcells2] + rw [Tape.init_ofBool_cells_ge x x.length le_rfl] + decide + have hnostart3 : ∀ j, j ≥ 1 → (c3.work counterIdx).cells j ≠ Γ.start := + Tape.hasUnaryPrefix_cells_ne_start hprefix3 + have hhead3 : (c3.work counterIdx).head = x.length + 2 := by + rw [hprefix3.1] + obtain ⟨c4, hreach_rewind, hhalt4, hinput4, hhead4, hcells4⟩ := + inputLengthPlusOneCounterTM_rewind_loop counterIdx (x.length + 2) c3 + hstate3 hinp3 hcell03 hnostart3 hhead3 + have hpost : (c4.work counterIdx).HasUnaryCounter (x.length + 1) := + Tape.hasUnaryCounter_of_hasUnaryPrefix hprefix3 hhead4 hcells4 + have hreach_start : (inputLengthPlusOneCounterTM counterIdx).reachesIn 1 c0 c1 := by + exact .step hstep_start .zero + have hreach_02 : (inputLengthPlusOneCounterTM counterIdx).reachesIn + (1 + x.length) c0 c2 := + reachesIn_trans _ hreach_start hreach_scan + have hreach_03 : (inputLengthPlusOneCounterTM counterIdx).reachesIn + (1 + x.length + 1) c0 c3 := by + simpa [Nat.add_assoc] using + reachesIn_trans _ hreach_02 (.step hstep_blank .zero) + have hreach_04 : (inputLengthPlusOneCounterTM counterIdx).reachesIn + (1 + x.length + 1 + (x.length + 2 + 1)) c0 c4 := by + simpa [Nat.add_assoc] using + reachesIn_trans _ hreach_03 hreach_rewind + refine ⟨c4, 1 + x.length + 1 + (x.length + 2 + 1), ?_, ?_, hhalt4, hpost⟩ + · simp [inputLengthPlusOneCounterTime] + omega + · simpa [c0] using hreach_04 + +/-- Started-tape variant of `inputLengthPlusOneCounterTM_hoareTime`: if the +input is already positioned at cell `1` and the counter tape is the started +blank tape, the machine still builds a unary counter of length `|x| + 1`. +The postcondition also exposes the structural fact that the resulting counter +tape has no `▷` markers beyond cell `0`. -/ +theorem inputLengthPlusOneCounterTM_started_hoareTime + (counterIdx : Fin n) (x : List Bool) : + (inputLengthPlusOneCounterTM counterIdx).HoareTime + (fun inp work _ => + inp = (Tape.init (x.map Γ.ofBool)).move Dir3.right ∧ + work counterIdx = (Tape.init []).move Dir3.right) + (fun _ work _ => + (work counterIdx).HasUnaryCounter (x.length + 1) ∧ + (work counterIdx).cells 0 = Γ.start ∧ + (∀ j, j ≥ 1 → (work counterIdx).cells j ≠ Γ.start)) + (inputLengthPlusOneCounterTime x.length) := by + intro inp work out hpre + rcases hpre with ⟨hinput, hcounter⟩ + subst inp + let c0 : Cfg n (inputLengthPlusOneCounterTM counterIdx).Q := + { state := LinearCounterPhase.scan, + input := (Tape.init (x.map Γ.ofBool)).move Dir3.right, + work := work, + output := out } + have hcells0 : c0.input.cells = (Tape.init (x.map Γ.ofBool)).cells := by + simp [c0, Tape.move_cells] + have hhead0 : c0.input.head = 1 := by + simp [c0, Tape.move, Tape.init] + have hprefix0 : (c0.work counterIdx).HasUnaryPrefix 0 := by + rw [show c0.work counterIdx = work counterIdx by rfl, hcounter] + exact Tape.init_nil_move_right_hasUnaryPrefix_zero + have hcell00 : (c0.work counterIdx).cells 0 = Γ.start := by + rw [show c0.work counterIdx = work counterIdx by rfl, hcounter] + simp [Tape.move, Tape.init] + obtain ⟨c2, hreach_scan, hstate2, hcells2, hhead2, hprefix2, hcell02⟩ := + inputLengthPlusOneCounterTM_scan_bits_loop counterIdx x x.length 0 c0 + (by omega) rfl hcells0 hhead0 hprefix0 hcell00 + have hhead2' : c2.input.head = x.length + 1 := by + rw [hhead2] + omega + have hprefix2' : (c2.work counterIdx).HasUnaryPrefix x.length := by + simpa using hprefix2 + obtain ⟨c3, hstep_blank, hstate3, hinput3, hprefix3, hcell03⟩ := + inputLengthPlusOneCounterTM_scan_blank_step counterIdx x c2 + hstate2 hcells2 hhead2' hprefix2' hcell02 + have hinp3 : c3.input.read ≠ Γ.start := by + rw [hinput3] + show c2.input.read ≠ Γ.start + rw [show c2.input.read = c2.input.cells c2.input.head by rfl, hhead2', hcells2] + rw [Tape.init_ofBool_cells_ge x x.length le_rfl] + decide + have hnostart3 : ∀ j, j ≥ 1 → (c3.work counterIdx).cells j ≠ Γ.start := + Tape.hasUnaryPrefix_cells_ne_start hprefix3 + have hhead3 : (c3.work counterIdx).head = x.length + 2 := by + rw [hprefix3.1] + obtain ⟨c4, hreach_rewind, hhalt4, hinput4, hhead4, hcells4⟩ := + inputLengthPlusOneCounterTM_rewind_loop counterIdx (x.length + 2) c3 + hstate3 hinp3 hcell03 hnostart3 hhead3 + have hcounter4 : (c4.work counterIdx).HasUnaryCounter (x.length + 1) := + Tape.hasUnaryCounter_of_hasUnaryPrefix hprefix3 hhead4 hcells4 + have hcell04 : (c4.work counterIdx).cells 0 = Γ.start := by + rw [hcells4] + exact hcell03 + have hnostart4 : ∀ j, j ≥ 1 → (c4.work counterIdx).cells j ≠ Γ.start := by + intro j hj + rw [hcells4] + exact hnostart3 j hj + have hreach_03 : (inputLengthPlusOneCounterTM counterIdx).reachesIn + (x.length + 1) c0 c3 := by + simpa [Nat.add_assoc] using + reachesIn_trans _ hreach_scan (.step hstep_blank .zero) + have hreach_04 : (inputLengthPlusOneCounterTM counterIdx).reachesIn + (x.length + 1 + (x.length + 2 + 1)) c0 c4 := by + simpa [Nat.add_assoc] using + reachesIn_trans _ hreach_03 hreach_rewind + refine ⟨c4, x.length + 1 + (x.length + 2 + 1), ?_, ?_, hhalt4, + ⟨hcounter4, hcell04, hnostart4⟩⟩ + · simp [inputLengthPlusOneCounterTime] + omega + · simpa [c0] using hreach_04 + +/-- Started-tape variant of the unary counter builder that also records the +final input position. The input cells are unchanged, and the input head ends at +the first blank after the scanned Boolean string. -/ +theorem inputLengthPlusOneCounterTM_started_tracksInput_hoareTime + (counterIdx : Fin n) (x : List Bool) : + (inputLengthPlusOneCounterTM counterIdx).HoareTime + (fun inp work _ => + inp = (Tape.init (x.map Γ.ofBool)).move Dir3.right ∧ + work counterIdx = (Tape.init []).move Dir3.right) + (fun inp work _ => + inp.cells = (Tape.init (x.map Γ.ofBool)).cells ∧ + inp.head = x.length + 1 ∧ + (work counterIdx).HasUnaryCounter (x.length + 1) ∧ + (work counterIdx).cells 0 = Γ.start ∧ + (∀ j, j ≥ 1 → (work counterIdx).cells j ≠ Γ.start)) + (inputLengthPlusOneCounterTime x.length) := by + intro inp work out hpre + rcases hpre with ⟨hinput, hcounter⟩ + subst inp + let c0 : Cfg n (inputLengthPlusOneCounterTM counterIdx).Q := + { state := LinearCounterPhase.scan, + input := (Tape.init (x.map Γ.ofBool)).move Dir3.right, + work := work, + output := out } + have hcells0 : c0.input.cells = (Tape.init (x.map Γ.ofBool)).cells := by + simp [c0, Tape.move_cells] + have hhead0 : c0.input.head = 1 := by + simp [c0, Tape.move, Tape.init] + have hprefix0 : (c0.work counterIdx).HasUnaryPrefix 0 := by + rw [show c0.work counterIdx = work counterIdx by rfl, hcounter] + exact Tape.init_nil_move_right_hasUnaryPrefix_zero + have hcell00 : (c0.work counterIdx).cells 0 = Γ.start := by + rw [show c0.work counterIdx = work counterIdx by rfl, hcounter] + simp [Tape.move, Tape.init] + obtain ⟨c2, hreach_scan, hstate2, hcells2, hhead2, hprefix2, hcell02⟩ := + inputLengthPlusOneCounterTM_scan_bits_loop counterIdx x x.length 0 c0 + (by omega) rfl hcells0 hhead0 hprefix0 hcell00 + have hhead2' : c2.input.head = x.length + 1 := by + rw [hhead2] + omega + have hprefix2' : (c2.work counterIdx).HasUnaryPrefix x.length := by + simpa using hprefix2 + obtain ⟨c3, hstep_blank, hstate3, hinput3, hprefix3, hcell03⟩ := + inputLengthPlusOneCounterTM_scan_blank_step counterIdx x c2 + hstate2 hcells2 hhead2' hprefix2' hcell02 + have hinp3 : c3.input.read ≠ Γ.start := by + rw [hinput3] + show c2.input.read ≠ Γ.start + rw [show c2.input.read = c2.input.cells c2.input.head by rfl, hhead2', hcells2] + rw [Tape.init_ofBool_cells_ge x x.length le_rfl] + decide + have hnostart3 : ∀ j, j ≥ 1 → (c3.work counterIdx).cells j ≠ Γ.start := + Tape.hasUnaryPrefix_cells_ne_start hprefix3 + have hhead3 : (c3.work counterIdx).head = x.length + 2 := by + rw [hprefix3.1] + obtain ⟨c4, hreach_rewind, hhalt4, hinput4, hhead4, hcells4⟩ := + inputLengthPlusOneCounterTM_rewind_loop counterIdx (x.length + 2) c3 + hstate3 hinp3 hcell03 hnostart3 hhead3 + have hcounter4 : (c4.work counterIdx).HasUnaryCounter (x.length + 1) := + Tape.hasUnaryCounter_of_hasUnaryPrefix hprefix3 hhead4 hcells4 + have hcell04 : (c4.work counterIdx).cells 0 = Γ.start := by + rw [hcells4] + exact hcell03 + have hnostart4 : ∀ j, j ≥ 1 → (c4.work counterIdx).cells j ≠ Γ.start := by + intro j hj + rw [hcells4] + exact hnostart3 j hj + have hinput4_cells : c4.input.cells = (Tape.init (x.map Γ.ofBool)).cells := by + rw [hinput4, hinput3] + exact hcells2 + have hinput4_head : c4.input.head = x.length + 1 := by + rw [hinput4, hinput3] + exact hhead2' + have hreach_03 : (inputLengthPlusOneCounterTM counterIdx).reachesIn + (x.length + 1) c0 c3 := by + simpa [Nat.add_assoc] using + reachesIn_trans _ hreach_scan (.step hstep_blank .zero) + have hreach_04 : (inputLengthPlusOneCounterTM counterIdx).reachesIn + (x.length + 1 + (x.length + 2 + 1)) c0 c4 := by + simpa [Nat.add_assoc] using + reachesIn_trans _ hreach_03 hreach_rewind + refine ⟨c4, x.length + 1 + (x.length + 2 + 1), ?_, ?_, hhalt4, + ⟨hinput4_cells, hinput4_head, hcounter4, hcell04, hnostart4⟩⟩ + · simp [inputLengthPlusOneCounterTime] + omega + · simpa [c0] using hreach_04 + +/-- One-step preservation of a passive started Boolean work tape distinct from +the active counter tape. -/ +private theorem inputLengthPlusOneCounterTM_step_preserves_started_other_work + (counterIdx passiveIdx : Fin n) (hne : passiveIdx ≠ counterIdx) + (y : List Bool) + {c c' : Cfg n (inputLengthPlusOneCounterTM counterIdx).Q} + (hstep : (inputLengthPlusOneCounterTM counterIdx).step c = some c') + (hpassive : c.work passiveIdx = (Tape.init (y.map Γ.ofBool)).move Dir3.right) : + c'.work passiveIdx = c.work passiveIdx := by + have hpassive_read : (c.work passiveIdx).read ≠ Γ.start := by + rw [hpassive] + exact started_ofBool_tape_read_ne_start y + cases c with + | mk state input work output => + change work passiveIdx = (Tape.init (y.map Γ.ofBool)).move Dir3.right at hpassive + cases state with + | scan => + by_cases hstart : input.read = Γ.start + · simp [TM.step, inputLengthPlusOneCounterTM, hstart] at hstep + subst hstep + simpa [counterPreserveWork, counterIdleDirs] using + Tape.writeAndMove_readBack_idle_of_ne_start (work passiveIdx) + (by simpa [hpassive] using hpassive_read) + · by_cases hblank : input.read = Γ.blank + · simp [TM.step, inputLengthPlusOneCounterTM, hblank] at hstep + subst hstep + simpa [counterWriteOneWork, counterAdvanceDirs, hne] using + Tape.writeAndMove_readBack_idle_of_ne_start (work passiveIdx) + (by simpa [hpassive] using hpassive_read) + · simp [TM.step, inputLengthPlusOneCounterTM, hstart, hblank] at hstep + subst hstep + simpa [counterWriteOneWork, counterAdvanceDirs, hne] using + Tape.writeAndMove_readBack_idle_of_ne_start (work passiveIdx) + (by simpa [hpassive] using hpassive_read) + | rewind => + by_cases hcounter : (work counterIdx).read = Γ.start + · simp [TM.step, inputLengthPlusOneCounterTM, hcounter] at hstep + subst hstep + simpa [counterPreserveWork, counterAdvanceDirs, hne] using + Tape.writeAndMove_readBack_idle_of_ne_start (work passiveIdx) + (by simpa [hpassive] using hpassive_read) + · simp [TM.step, inputLengthPlusOneCounterTM, hcounter] at hstep + subst hstep + simpa [counterPreserveWork, counterRewindDirs, hne] using + Tape.writeAndMove_readBack_idle_of_ne_start (work passiveIdx) + (by simpa [hpassive] using hpassive_read) + | done => + simp [TM.step, inputLengthPlusOneCounterTM] at hstep + +/-- Multi-step preservation of a passive started Boolean work tape distinct +from the active counter tape. -/ +private theorem inputLengthPlusOneCounterTM_reachesIn_preserves_started_other_work + (counterIdx passiveIdx : Fin n) (hne : passiveIdx ≠ counterIdx) + (y : List Bool) + {t : ℕ} {c c' : Cfg n (inputLengthPlusOneCounterTM counterIdx).Q} + (hreach : (inputLengthPlusOneCounterTM counterIdx).reachesIn t c c') + (hpassive : c.work passiveIdx = (Tape.init (y.map Γ.ofBool)).move Dir3.right) : + c'.work passiveIdx = (Tape.init (y.map Γ.ofBool)).move Dir3.right := by + induction hreach with + | zero => + exact hpassive + | step hstep _ ih => + have hmid : _ = _ := + inputLengthPlusOneCounterTM_step_preserves_started_other_work + counterIdx passiveIdx hne y hstep hpassive + exact ih (by simpa [hmid] using hpassive) + +/-- One-step preservation of a started blank output tape. -/ +private theorem inputLengthPlusOneCounterTM_step_preserves_started_blank_output + (counterIdx : Fin n) + {c c' : Cfg n (inputLengthPlusOneCounterTM counterIdx).Q} + (hstep : (inputLengthPlusOneCounterTM counterIdx).step c = some c') + (hout : c.output = (Tape.init []).move Dir3.right) : + c'.output = c.output := by + have hout_read : c.output.read ≠ Γ.start := by + rw [hout] + simp [Tape.read, Tape.move, Tape.init] + cases c with + | mk state input work output => + change output = (Tape.init []).move Dir3.right at hout + cases state with + | scan => + by_cases hstart : input.read = Γ.start + · simp [TM.step, inputLengthPlusOneCounterTM, hstart] at hstep + subst hstep + simpa [hout] using + Tape.writeAndMove_readBack_idle_of_ne_start output + hout_read + · by_cases hblank : input.read = Γ.blank + · simp [TM.step, inputLengthPlusOneCounterTM, hblank] at hstep + subst hstep + simpa [hout] using + Tape.writeAndMove_readBack_idle_of_ne_start output + hout_read + · simp [TM.step, inputLengthPlusOneCounterTM, hstart, hblank] at hstep + subst hstep + simpa [hout] using + Tape.writeAndMove_readBack_idle_of_ne_start output + hout_read + | rewind => + by_cases hcounter : (work counterIdx).read = Γ.start + · simp [TM.step, inputLengthPlusOneCounterTM, hcounter] at hstep + subst hstep + simpa [hout] using + Tape.writeAndMove_readBack_idle_of_ne_start output + hout_read + · simp [TM.step, inputLengthPlusOneCounterTM, hcounter] at hstep + subst hstep + simpa [hout] using + Tape.writeAndMove_readBack_idle_of_ne_start output + hout_read + | done => + simp [TM.step, inputLengthPlusOneCounterTM] at hstep + +/-- Multi-step preservation of a started blank output tape. -/ +private theorem inputLengthPlusOneCounterTM_reachesIn_preserves_started_blank_output + (counterIdx : Fin n) + {t : ℕ} {c c' : Cfg n (inputLengthPlusOneCounterTM counterIdx).Q} + (hreach : (inputLengthPlusOneCounterTM counterIdx).reachesIn t c c') + (hout : c.output = (Tape.init []).move Dir3.right) : + c'.output = (Tape.init []).move Dir3.right := by + induction hreach with + | zero => + exact hout + | step hstep _ ih => + have hmid : _ = _ := + inputLengthPlusOneCounterTM_step_preserves_started_blank_output + counterIdx hstep hout + exact ih (by simpa [hmid] using hout) + +/-- Started-tape variant of the unary counter builder that also records the +final input position and preserves one passive started Boolean work tape +exactly. -/ +theorem inputLengthPlusOneCounterTM_started_tracksInput_preserves_work_hoareTime + (counterIdx passiveIdx : Fin n) (hne : passiveIdx ≠ counterIdx) + (x y : List Bool) : + (inputLengthPlusOneCounterTM counterIdx).HoareTime + (fun inp work out => + inp = (Tape.init (x.map Γ.ofBool)).move Dir3.right ∧ + work counterIdx = (Tape.init []).move Dir3.right ∧ + work passiveIdx = (Tape.init (y.map Γ.ofBool)).move Dir3.right ∧ + out = (Tape.init []).move Dir3.right) + (fun inp work out => + inp.cells = (Tape.init (x.map Γ.ofBool)).cells ∧ + inp.head = x.length + 1 ∧ + work passiveIdx = (Tape.init (y.map Γ.ofBool)).move Dir3.right ∧ + (work counterIdx).HasUnaryCounter (x.length + 1) ∧ + (work counterIdx).cells 0 = Γ.start ∧ + (∀ j, j ≥ 1 → (work counterIdx).cells j ≠ Γ.start) ∧ + out = (Tape.init []).move Dir3.right) + (inputLengthPlusOneCounterTime x.length) := by + intro inp work out hpre + rcases hpre with ⟨hinput, hcounter, hpassive, hout⟩ + obtain ⟨c', t, ht, hreach, hhalt, hpost⟩ := + inputLengthPlusOneCounterTM_started_tracksInput_hoareTime counterIdx x inp work out + ⟨hinput, hcounter⟩ + have hpassive' : + c'.work passiveIdx = (Tape.init (y.map Γ.ofBool)).move Dir3.right := + inputLengthPlusOneCounterTM_reachesIn_preserves_started_other_work + counterIdx passiveIdx hne y hreach hpassive + have hout' : + c'.output = (Tape.init []).move Dir3.right := + inputLengthPlusOneCounterTM_reachesIn_preserves_started_blank_output + counterIdx hreach hout + exact ⟨c', t, ht, hreach, hhalt, ⟨hpost.1, hpost.2.1, hpassive', hpost.2.2.1, + hpost.2.2.2.1, hpost.2.2.2.2, hout'⟩⟩ + +/-- Nondeterministic form of `inputLengthPlusOneCounterTM_hoareTime`, for use + inside NTM constructions after lifting the deterministic setup machine. -/ +theorem inputLengthPlusOneCounterTM_toNTM_hoareTime + (counterIdx : Fin n) (x : List Bool) : + ((inputLengthPlusOneCounterTM counterIdx).toNTM).HoareTime + (fun inp work _ => + inp = Tape.init (x.map Γ.ofBool) ∧ + work counterIdx = Tape.init []) + (fun _ work _ => + (work counterIdx).HasUnaryCounter (x.length + 1)) + (inputLengthPlusOneCounterTime x.length) := + (inputLengthPlusOneCounterTM_hoareTime counterIdx x).toNTM + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/Internal.lean new file mode 100644 index 0000000000..01fb4d3828 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/Internal.lean @@ -0,0 +1,1969 @@ +/- +Copyright (c) 2025 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Tape.Encoding +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Hoare +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Hoare.Defs + +/-! +# TM Subroutines: proof internals + +Simulation lemmas and `HoareTime` proofs for the rewind, blank, clear, and +copy subroutine machines defined in +`Complexitylib.Models.TuringMachine.Subroutines`. Each subroutine gets a +basic Hoare-style spec, and where needed a rich "frame" variant that threads +an arbitrary predicate `P` on the untouched tapes through the run. + +## Main results + +- `writeTM_hoareTime` — writes `sym.toΓ` to output cell 1 +- `rewindWorkTM_hoareTime` — rewinds work tape `idx` to cell 1 +- `rewindWorkTM_hoareTime_frame` — work-tape rewind preserving a predicate P +- `rewindInputTM_hoareTime` — rewinds the input tape to cell 1 +- `rewindInputTM_hoareTime_frame` — input rewind preserving a predicate P +- `rewindInputTM_toNTM_hoareTime` — NTM-lifted input rewind spec +- `rewindInputTM_toNTM_hoareTime_frame` — NTM-lifted rich input rewind spec +- `blankWorkTM_started_hoareTime` — blank a started work tape in linear time +- `blankWorkTM_hoareTime_frame_of_binaryString` — frame-preserving blank +- `clearWorkTM_hoareTime_frame_of_binaryString` — blank then rewind to the + started empty tape, preserving the frame +- `copyInputToWorkTM_started_hoareTime` — copy the Boolean input to a work tape +- `copyWorkToWorkTM_started_hoareTime` — copy one started work tape to another +- `copyWorkToWorkTM_hoareTime_frame_of_binaryString` — frame-preserving + work-to-work copy +-/ + + +public section + +namespace Complexity + +namespace TM + +variable {n : ℕ} + +-- ════════════════════════════════════════════════════════════════════════ +-- writeTM: rewind loop +-- ════════════════════════════════════════════════════════════════════════ + +private theorem writeTM_rewind_step_left (sym : Γw) (c : Cfg n (writeTM sym).Q) + (hst : c.state = WritePhase.rewind) (hread : c.output.read ≠ Γ.start) + (_ : c.output.cells 0 = Γ.start) (_ : ∀ j, j ≥ 1 → c.output.cells j ≠ Γ.start) : + ∃ c', (writeTM sym).step c = some c' ∧ + c'.state = WritePhase.rewind ∧ + c'.output.head = c.output.head - 1 ∧ + c'.output.cells = c.output.cells := by + simp only [TM.step, ↓reduceIte, hst, writeTM, hread] + refine ⟨_, rfl, rfl, ?_, ?_⟩ + · simp only [Tape.writeAndMove, Tape.move] + rw [toΓ_readBackWrite_of_ne_start hread] + simp only [Tape.write, Tape.read]; split <;> simp + · simp only [Tape.writeAndMove, Tape.move_cells] + rw [toΓ_readBackWrite_of_ne_start hread] + simp only [Tape.write, Tape.read]; split + · rfl + · exact Function.update_eq_self _ _ + +private theorem writeTM_rewind_step_base (sym : Γw) (c : Cfg n (writeTM sym).Q) + (hst : c.state = WritePhase.rewind) (hread : c.output.read = Γ.start) + (_ : c.output.cells 0 = Γ.start) + (hns : ∀ j, j ≥ 1 → c.output.cells j ≠ Γ.start) : + ∃ c', (writeTM sym).step c = some c' ∧ + c'.state = WritePhase.goRight ∧ + c'.output.head = 1 ∧ + c'.output.cells = c.output.cells := by + have hhead : c.output.head = 0 := by + by_contra h; exact hns c.output.head (by omega) (by rwa [Tape.read] at hread) + simp only [TM.step, ↓reduceIte, hst, writeTM, hread] + refine ⟨_, rfl, rfl, ?_, ?_⟩ + · simp [Tape.writeAndMove, Tape.move, Tape.write, hhead] + · simp [Tape.writeAndMove, Tape.move_cells, Tape.write, hhead] + +private theorem writeTM_rewind_loop (sym : Γw) : + ∀ (h : ℕ) (c : Cfg n (writeTM sym).Q), + c.state = WritePhase.rewind → + c.output.cells 0 = Γ.start → + (∀ j, j ≥ 1 → c.output.cells j ≠ Γ.start) → + c.output.head = h → + ∃ c', + (writeTM sym).reachesIn (h + 1) c c' ∧ + c'.state = WritePhase.goRight ∧ + c'.output.head = 1 ∧ + c'.output.cells = c.output.cells := + exists_reachesIn_of_rewindStep_output (writeTM sym) + (fun c hst hread hc0 hns => writeTM_rewind_step_left sym c hst hread hc0 hns) + (fun c hst hread hc0 hns => writeTM_rewind_step_base sym c hst hread hc0 hns) + +-- ════════════════════════════════════════════════════════════════════════ +-- writeTM: goRight and write steps +-- ════════════════════════════════════════════════════════════════════════ + +private theorem writeTM_goRight_to_done (sym : Γw) (c : Cfg n (writeTM sym).Q) + (hstate : c.state = WritePhase.goRight) + (hhead : c.output.head = 1) + (hnostart1 : c.output.cells 1 ≠ Γ.start) : + ∃ c', + (writeTM sym).reachesIn 2 c c' ∧ + (writeTM sym).halted c' ∧ + c'.output.cells 1 = sym.toΓ := by + have hoDir : idleDir (c.output.read) = Dir3.stay := by + simp [idleDir, Tape.read, hhead, hnostart1] + -- Step 1: goRight → write + have hstep1 : ∃ c₁, (writeTM sym).step c = some c₁ ∧ + c₁.state = WritePhase.write ∧ + c₁.output.head = 1 ∧ + c₁.output.cells 1 = Γ.blank := by + simp only [TM.step, hstate, writeTM] + refine ⟨_, rfl, rfl, ?_, ?_⟩ + · simp [Tape.writeAndMove, Tape.move, Tape.write, hhead, hoDir] + · simp [Tape.writeAndMove, Tape.move, Tape.write, hhead, hoDir, + Function.update_self, Γw.toΓ] + obtain ⟨c₁, hstep1', hst1, hhead1, hcell1_blank⟩ := hstep1 + -- Step 2: write → done + have hoDir2 : idleDir (c₁.output.read) = Dir3.stay := by + simp [idleDir, Tape.read, hhead1, hcell1_blank] + have hstep2 : ∃ c₂, (writeTM sym).step c₁ = some c₂ ∧ + c₂.state = WritePhase.done ∧ + c₂.output.cells 1 = sym.toΓ := by + simp only [TM.step, hst1, writeTM] + refine ⟨_, rfl, rfl, ?_⟩ + simp [Tape.writeAndMove, Tape.move, Tape.write, hhead1, hoDir2, + Function.update_self] + obtain ⟨c₂, hstep2', hst2, hcells2⟩ := hstep2 + exact ⟨c₂, .step hstep1' (.step hstep2' .zero), hst2, hcells2⟩ + +-- ════════════════════════════════════════════════════════════════════════ +-- writeTM: main HoareTime theorem +-- ════════════════════════════════════════════════════════════════════════ + +/-- `writeTM sym` writes `sym.toΓ` to output cell 1 and halts. + **Pre**: output tape well-formed (cell 0 = ▷, cells ≥ 1 ≠ ▷), head ≤ B. + **Post**: output cell 1 = sym.toΓ. + **Time**: B + 3 steps. -/ +theorem writeTM_hoareTime (sym : Γw) (B : ℕ) : + (writeTM (n := n) sym).HoareTime + (fun _ _ out => out.cells 0 = Γ.start ∧ + (∀ j, j ≥ 1 → out.cells j ≠ Γ.start) ∧ + out.head ≤ B) + (fun _ _ out => out.cells 1 = sym.toΓ) + (B + 3) := by + intro inp work out ⟨hcell0, hnostart, hhead_le⟩ + obtain ⟨c_go, hreach_rw, hst_go, hhead_go, hcells_go⟩ := + writeTM_rewind_loop sym out.head + { state := WritePhase.rewind, input := inp, work := work, output := out } + rfl hcell0 hnostart rfl + have hnostart_go : c_go.output.cells 1 ≠ Γ.start := by + rw [hcells_go]; exact hnostart 1 (by omega) + obtain ⟨c_done, hreach_wr, hhalt, hwrite⟩ := + writeTM_goRight_to_done sym c_go hst_go hhead_go hnostart_go + refine ⟨c_done, (out.head + 1) + 2, ?_, + reachesIn_trans (writeTM sym) hreach_rw hreach_wr, hhalt, hwrite⟩ + omega + +-- ════════════════════════════════════════════════════════════════════════ +-- rewindWorkTM: rewind loop +-- ════════════════════════════════════════════════════════════════════════ + +private theorem rewindWorkTM_rewind_step_left (idx : Fin n) (c : Cfg n (rewindWorkTM idx).Q) + (hst : c.state = RewindPhase.moveLeft) (hread : (c.work idx).read ≠ Γ.start) + (_ : (c.work idx).cells 0 = Γ.start) (_ : ∀ j, j ≥ 1 → (c.work idx).cells j ≠ Γ.start) : + ∃ c', (rewindWorkTM idx).step c = some c' ∧ + c'.state = RewindPhase.moveLeft ∧ + (c'.work idx).head = (c.work idx).head - 1 ∧ + (c'.work idx).cells = (c.work idx).cells := by + simp only [TM.step, ↓reduceIte, hst, rewindWorkTM, hread] + refine ⟨_, rfl, rfl, ?_, ?_⟩ + · dsimp only []; simp only [↓reduceIte, Tape.writeAndMove, Tape.move] + rw [toΓ_readBackWrite_of_ne_start hread] + simp only [Tape.write, Tape.read]; split <;> simp + · dsimp only []; simp only [↓reduceIte, Tape.writeAndMove, Tape.move_cells] + rw [toΓ_readBackWrite_of_ne_start hread] + simp only [Tape.write, Tape.read]; split + · rfl + · exact Function.update_eq_self _ _ + +private theorem rewindWorkTM_rewind_step_base (idx : Fin n) (c : Cfg n (rewindWorkTM idx).Q) + (hst : c.state = RewindPhase.moveLeft) (hread : (c.work idx).read = Γ.start) + (_ : (c.work idx).cells 0 = Γ.start) + (hns : ∀ j, j ≥ 1 → (c.work idx).cells j ≠ Γ.start) : + ∃ c', (rewindWorkTM idx).step c = some c' ∧ + c'.state = RewindPhase.moveRight ∧ + (c'.work idx).head = 1 ∧ + (c'.work idx).cells = (c.work idx).cells := by + have hhead : (c.work idx).head = 0 := by + by_contra h; exact hns (c.work idx).head (by omega) (by rwa [Tape.read] at hread) + simp only [TM.step, ↓reduceIte, hst, rewindWorkTM, hread] + refine ⟨_, rfl, rfl, ?_, ?_⟩ + · dsimp only []; simp [Tape.writeAndMove, Tape.move, Tape.write, hhead] + · dsimp only []; simp [Tape.writeAndMove, Tape.move_cells, Tape.write, hhead] + +private theorem rewindWorkTM_rewind_loop (idx : Fin n) : + ∀ (h : ℕ) (c : Cfg n (rewindWorkTM idx).Q), + c.state = RewindPhase.moveLeft → + (c.work idx).cells 0 = Γ.start → + (∀ j, j ≥ 1 → (c.work idx).cells j ≠ Γ.start) → + (c.work idx).head = h → + ∃ c', + (rewindWorkTM idx).reachesIn (h + 1) c c' ∧ + c'.state = RewindPhase.moveRight ∧ + (c'.work idx).head = 1 ∧ + (c'.work idx).cells = (c.work idx).cells := + exists_reachesIn_of_rewindStep_tape (rewindWorkTM idx) (fun c => c.work idx) + (fun c hst hread hc0 hns => rewindWorkTM_rewind_step_left idx c hst hread hc0 hns) + (fun c hst hread hc0 hns => rewindWorkTM_rewind_step_base idx c hst hread hc0 hns) + +-- ════════════════════════════════════════════════════════════════════════ +-- rewindWorkTM: moveRight step +-- ════════════════════════════════════════════════════════════════════════ + +private theorem rewindWorkTM_moveRight_to_done (idx : Fin n) + (c : Cfg n (rewindWorkTM idx).Q) + (hstate : c.state = RewindPhase.moveRight) + (hread_ne : (c.work idx).read ≠ Γ.start) : + ∃ c', + (rewindWorkTM idx).reachesIn 1 c c' ∧ + (rewindWorkTM idx).halted c' ∧ + (c'.work idx).head = (c.work idx).head := by + have hoDir : idleDir ((c.work idx).read) = Dir3.stay := by + simp [idleDir, hread_ne] + have hstep : ∃ c', (rewindWorkTM idx).step c = some c' ∧ + (rewindWorkTM idx).halted c' ∧ + (c'.work idx).head = (c.work idx).head := by + simp only [TM.step, hstate, rewindWorkTM, allIdle] + refine ⟨_, rfl, rfl, ?_⟩ + dsimp only [] + rw [Tape.writeAndMove, hoDir] + simp [Tape.move, Tape.write] + split <;> rfl + obtain ⟨c', hstep', hhalt, hhead⟩ := hstep + exact ⟨c', .step hstep' .zero, hhalt, hhead⟩ + +-- ════════════════════════════════════════════════════════════════════════ +-- rewindWorkTM: main HoareTime theorem +-- ════════════════════════════════════════════════════════════════════════ + +/-- `rewindWorkTM idx` rewinds work tape `idx` to cell 1 and halts. + **Pre**: work tape `idx` well-formed (cell 0 = ▷, cells ≥ 1 ≠ ▷), head ≤ B. + **Post**: work tape `idx` head = 1. + **Time**: B + 2 steps. -/ +theorem rewindWorkTM_hoareTime (idx : Fin n) (B : ℕ) : + (rewindWorkTM idx).HoareTime + (fun _ work _ => (work idx).cells 0 = Γ.start ∧ + (∀ j, j ≥ 1 → (work idx).cells j ≠ Γ.start) ∧ + (work idx).head ≤ B) + (fun _ work _ => (work idx).head = 1) + (B + 2) := by + intro inp work out ⟨hcell0, hnostart, hhead_le⟩ + obtain ⟨c_mr, hreach_rw, hst_mr, hhead_mr, hcells_mr⟩ := + rewindWorkTM_rewind_loop idx (work idx).head + { state := RewindPhase.moveLeft, input := inp, work := work, output := out } + rfl hcell0 hnostart rfl + have hread_mr : (c_mr.work idx).read ≠ Γ.start := by + simp [Tape.read, hhead_mr, hcells_mr]; exact hnostart 1 (by omega) + obtain ⟨c_done, hreach_mr, hhalt, hhead_done⟩ := + rewindWorkTM_moveRight_to_done idx c_mr hst_mr hread_mr + refine ⟨c_done, ((work idx).head + 1) + 1, ?_, + reachesIn_trans (rewindWorkTM idx) hreach_rw hreach_mr, hhalt, + by dsimp only []; rw [hhead_done, hhead_mr]⟩ + omega + +-- ════════════════════════════════════════════════════════════════════════ +-- rewindInputTM: rewind loop +-- ════════════════════════════════════════════════════════════════════════ + +private theorem rewindInputTM_rewind_step_left (c : Cfg n (rewindInputTM (n := n)).Q) + (hst : c.state = RewindPhase.moveLeft) (hread : c.input.read ≠ Γ.start) + (_ : c.input.cells 0 = Γ.start) (_ : ∀ j, j ≥ 1 → c.input.cells j ≠ Γ.start) : + ∃ c', (rewindInputTM (n := n)).step c = some c' ∧ + c'.state = RewindPhase.moveLeft ∧ + c'.input.head = c.input.head - 1 ∧ + c'.input.cells = c.input.cells := by + simp only [TM.step, ↓reduceIte, hst, rewindInputTM, hread] + refine ⟨_, rfl, rfl, ?_, ?_⟩ + · simp [Tape.move, moveLeftDir, hread] + · simp [Tape.move_cells] + +private theorem rewindInputTM_rewind_step_base (c : Cfg n (rewindInputTM (n := n)).Q) + (hst : c.state = RewindPhase.moveLeft) (hread : c.input.read = Γ.start) + (_ : c.input.cells 0 = Γ.start) + (hns : ∀ j, j ≥ 1 → c.input.cells j ≠ Γ.start) : + ∃ c', (rewindInputTM (n := n)).step c = some c' ∧ + c'.state = RewindPhase.moveRight ∧ + c'.input.head = 1 ∧ + c'.input.cells = c.input.cells := by + have hhead : c.input.head = 0 := by + by_contra h; exact hns c.input.head (by omega) (by rwa [Tape.read] at hread) + simp only [TM.step, ↓reduceIte, hst, rewindInputTM, hread] + refine ⟨_, rfl, rfl, ?_, ?_⟩ + · simp [Tape.move, hhead] + · simp [Tape.move_cells] + +private theorem rewindInputTM_rewind_loop : + ∀ (h : ℕ) (c : Cfg n (rewindInputTM (n := n)).Q), + c.state = RewindPhase.moveLeft → + c.input.cells 0 = Γ.start → + (∀ j, j ≥ 1 → c.input.cells j ≠ Γ.start) → + c.input.head = h → + ∃ c', + (rewindInputTM (n := n)).reachesIn (h + 1) c c' ∧ + c'.state = RewindPhase.moveRight ∧ + c'.input.head = 1 ∧ + c'.input.cells = c.input.cells := + exists_reachesIn_of_rewindStep_tape (rewindInputTM (n := n)) (fun c => c.input) + (fun c hst hread hc0 hns => rewindInputTM_rewind_step_left c hst hread hc0 hns) + (fun c hst hread hc0 hns => rewindInputTM_rewind_step_base c hst hread hc0 hns) + +-- ════════════════════════════════════════════════════════════════════════ +-- rewindInputTM: moveRight step +-- ════════════════════════════════════════════════════════════════════════ + +private theorem rewindInputTM_moveRight_to_done + (c : Cfg n (rewindInputTM (n := n)).Q) + (hstate : c.state = RewindPhase.moveRight) + (hread_ne : c.input.read ≠ Γ.start) : + ∃ c', + (rewindInputTM (n := n)).reachesIn 1 c c' ∧ + (rewindInputTM (n := n)).halted c' ∧ + c'.input.head = c.input.head ∧ + c'.input.cells = c.input.cells := by + have hiDir : idleDir c.input.read = Dir3.stay := by + simp [idleDir, hread_ne] + have hstep : ∃ c', (rewindInputTM (n := n)).step c = some c' ∧ + (rewindInputTM (n := n)).halted c' ∧ + c'.input.head = c.input.head ∧ + c'.input.cells = c.input.cells := by + simp only [TM.step, hstate, rewindInputTM] + refine ⟨_, rfl, rfl, ?_, ?_⟩ + · simp [Tape.move, hiDir] + · simp [Tape.move_cells] + obtain ⟨c', hstep', hhalt, hhead, hcells⟩ := hstep + exact ⟨c', .step hstep' .zero, hhalt, hhead, hcells⟩ + +-- ════════════════════════════════════════════════════════════════════════ +-- rewindInputTM: main HoareTime theorem +-- ════════════════════════════════════════════════════════════════════════ + +/-- `rewindInputTM` rewinds the input tape to cell 1 and halts. + **Pre**: input tape well-formed (cell 0 = ▷, cells ≥ 1 ≠ ▷), head ≤ B. + **Post**: input head = 1. + **Time**: B + 2 steps. -/ +theorem rewindInputTM_hoareTime (B : ℕ) : + (rewindInputTM (n := n)).HoareTime + (fun inp _ _ => inp.cells 0 = Γ.start ∧ + (∀ j, j ≥ 1 → inp.cells j ≠ Γ.start) ∧ + inp.head ≤ B) + (fun inp _ _ => inp.head = 1) + (B + 2) := by + intro inp work out ⟨hcell0, hnostart, hhead_le⟩ + obtain ⟨c_mr, hreach_rw, hst_mr, hhead_mr, hcells_mr⟩ := + rewindInputTM_rewind_loop (n := n) inp.head + { state := RewindPhase.moveLeft, input := inp, work := work, output := out } + rfl hcell0 hnostart rfl + have hread_mr : c_mr.input.read ≠ Γ.start := by + simp [Tape.read, hhead_mr, hcells_mr]; exact hnostart 1 (by omega) + obtain ⟨c_done, hreach_mr, hhalt, hhead_done, _hcells_done⟩ := + rewindInputTM_moveRight_to_done (n := n) c_mr hst_mr hread_mr + refine ⟨c_done, (inp.head + 1) + 1, ?_, + reachesIn_trans (rewindInputTM (n := n)) hreach_rw hreach_mr, hhalt, + by dsimp only []; rw [hhead_done, hhead_mr]⟩ + omega + +-- ════════════════════════════════════════════════════════════════════════ +-- rewindInputTM: rich HoareTime preserving arbitrary data +-- ════════════════════════════════════════════════════════════════════════ + +/-- Rich HoareTime for `rewindInputTM` that preserves an arbitrary predicate P + through the rewind, provided P is stable when the input cells are unchanged + and the input head is reset to 1. Work and output tapes are preserved + exactly under the usual non-start-under-head side conditions. -/ +theorem rewindInputTM_hoareTime_frame {n : ℕ} (B_input : ℕ) + {P : Tape → (Fin n → Tape) → Tape → Prop} + (hP_preserved : ∀ (inp : Tape) (work : Fin n → Tape) (out : Tape) + (inp' : Tape) (work' : Fin n → Tape) (out' : Tape), + P inp work out → + inp'.cells = inp.cells → + inp'.head = 1 → + work' = work → + out' = out → + P inp' work' out') : + (rewindInputTM (n := n)).HoareTime + (fun inp work out => + inp.cells 0 = Γ.start ∧ + (∀ j, j ≥ 1 → inp.cells j ≠ Γ.start) ∧ + inp.head ≤ B_input ∧ + out.read ≠ Γ.start ∧ out.head ≥ 1 ∧ + (∀ i, (work i).read ≠ Γ.start ∧ (work i).head ≥ 1) ∧ + P inp work out) + (fun inp work out => + inp.head = 1 ∧ + P inp work out) + (B_input + 2) := by + intro inp work out ⟨hcell0, hnostart, hhead_le, hout_ns, hout_h, hwork_wf, hP⟩ + have tape_idle_preserve : ∀ (t : Tape), t.read ≠ Γ.start → t.head ≥ 1 → + t.writeAndMove (readBackWrite t.read) (idleDir t.read) = t := by + intro t hns hh + simp only [Tape.writeAndMove, idleDir, hns, ↓reduceIte, Tape.move, Tape.write] + split + · omega + · simp only [Tape.read] at hns ⊢ + rw [toΓ_readBackWrite_of_ne_start hns, Function.update_eq_self] + have input_idle_preserve : ∀ (t : Tape), t.read ≠ Γ.start → + t.move (idleDir t.read) = t := by + intro t hns + simp [idleDir, hns, Tape.move] + suffices h_loop : ∀ (h : ℕ) (c : Cfg n (rewindInputTM (n := n)).Q), + c.state = RewindPhase.moveLeft → + c.input.cells 0 = Γ.start → + (∀ j, j ≥ 1 → c.input.cells j ≠ Γ.start) → + c.input.head = h → + c.work = work → c.output = out → + ∃ c', + (rewindInputTM (n := n)).reachesIn (h + 2) c c' ∧ + (rewindInputTM (n := n)).halted c' ∧ + c'.input.head = 1 ∧ c'.input.cells = c.input.cells ∧ + c'.work = work ∧ c'.output = out by + obtain ⟨c', hreach, hhalt, hh1, hcells, hwork', hout'⟩ := + h_loop inp.head + { state := RewindPhase.moveLeft, input := inp, work := work, output := out } + rfl hcell0 hnostart rfl rfl rfl + refine ⟨c', _, by omega, hreach, hhalt, hh1, ?_⟩ + exact hP_preserved inp work out c'.input c'.work c'.output hP + (by rw [hcells]) hh1 hwork' hout' + intro h; induction h with + | zero => + intro c hstate hcell0_c hnostart_c hhead hwork_c hout_c + have hread : c.input.read = Γ.start := by simp [Tape.read, hhead, hcell0_c] + have hstep1 : ∃ c₁, + (rewindInputTM (n := n)).step c = some c₁ ∧ + c₁.state = RewindPhase.moveRight ∧ + c₁.input.head = 1 ∧ c₁.input.cells = c.input.cells ∧ + c₁.work = work ∧ c₁.output = out := by + simp only [TM.step, ↓reduceIte, hstate, rewindInputTM, hread] + refine ⟨_, rfl, rfl, ?_, ?_, ?_, ?_⟩ + · simp [Tape.move, hhead] + · simp [Tape.move_cells] + · funext i; dsimp only [] + rw [hwork_c] + exact tape_idle_preserve (work i) (hwork_wf i).1 (hwork_wf i).2 + · dsimp only []; rw [hout_c] + exact tape_idle_preserve out hout_ns hout_h + obtain ⟨c₁, hstep1', hst1, hh1, hcells1, hwork1, hout1⟩ := hstep1 + have hread1 : c₁.input.read ≠ Γ.start := by + simp [Tape.read, hh1, hcells1]; exact hnostart_c 1 (by omega) + have hstep2 : ∃ c₂, + (rewindInputTM (n := n)).step c₁ = some c₂ ∧ + (rewindInputTM (n := n)).halted c₂ ∧ + c₂.input.head = 1 ∧ c₂.input.cells = c₁.input.cells ∧ + c₂.work = work ∧ c₂.output = out := by + simp only [TM.step, hst1, rewindInputTM] + refine ⟨_, rfl, rfl, ?_, ?_, ?_, ?_⟩ + · have := input_idle_preserve c₁.input hread1 + show (c₁.input.move (idleDir c₁.input.read)).head = 1 + rw [this]; exact hh1 + · have := input_idle_preserve c₁.input hread1 + show (c₁.input.move (idleDir c₁.input.read)).cells = c₁.input.cells + rw [this] + · funext i; dsimp only [] + rw [hwork1] + exact tape_idle_preserve (work i) (hwork_wf i).1 (hwork_wf i).2 + · dsimp only []; rw [hout1] + exact tape_idle_preserve out hout_ns hout_h + obtain ⟨c₂, hstep2', hhalt, hh2, hcells2, hwork2, hout2⟩ := hstep2 + exact ⟨c₂, .step hstep1' (.step hstep2' .zero), hhalt, hh2, + by rw [hcells2, hcells1], hwork2, hout2⟩ + | succ h ih => + intro c hstate hcell0_c hnostart_c hhead hwork_c hout_c + have hread_ne : c.input.read ≠ Γ.start := by + simp [Tape.read, hhead]; exact hnostart_c (h + 1) (by omega) + have hstep : ∃ c₁, + (rewindInputTM (n := n)).step c = some c₁ ∧ + c₁.state = RewindPhase.moveLeft ∧ + c₁.input.head = h ∧ c₁.input.cells = c.input.cells ∧ + c₁.work = work ∧ c₁.output = out := by + simp only [TM.step, ↓reduceIte, hstate, rewindInputTM, hread_ne] + refine ⟨_, rfl, rfl, ?_, ?_, ?_, ?_⟩ + · simp [Tape.move, moveLeftDir, hread_ne, hhead] + · simp [Tape.move_cells] + · funext i; dsimp only [] + rw [hwork_c] + exact tape_idle_preserve (work i) (hwork_wf i).1 (hwork_wf i).2 + · dsimp only []; rw [hout_c] + exact tape_idle_preserve out hout_ns hout_h + obtain ⟨c₁, hstep', hst1, hh1, hcells1, hwork1, hout1⟩ := hstep + obtain ⟨c_f, hreach_f, hhalt_f, hh_f, hcells_f, hwork_f, hout_f⟩ := + ih c₁ hst1 (by rw [hcells1]; exact hcell0_c) + (by intro j hj; rw [hcells1]; exact hnostart_c j hj) hh1 hwork1 hout1 + exact ⟨c_f, .step hstep' hreach_f, hhalt_f, hh_f, + by rw [hcells_f, hcells1], hwork_f, hout_f⟩ + +/-- Nondeterministic form of `rewindInputTM_hoareTime`, for phase compositions + that run deterministic setup subroutines through `TM.toNTM`. -/ +theorem rewindInputTM_toNTM_hoareTime (B : ℕ) : + ((rewindInputTM (n := n)).toNTM).HoareTime + (fun inp _ _ => inp.cells 0 = Γ.start ∧ + (∀ j, j ≥ 1 → inp.cells j ≠ Γ.start) ∧ + inp.head ≤ B) + (fun inp _ _ => inp.head = 1) + (B + 2) := + (rewindInputTM_hoareTime (n := n) B).toNTM + +/-- Nondeterministic form of `rewindInputTM_hoareTime_frame`. -/ +theorem rewindInputTM_toNTM_hoareTime_frame {n : ℕ} (B_input : ℕ) + {P : Tape → (Fin n → Tape) → Tape → Prop} + (hP_preserved : ∀ (inp : Tape) (work : Fin n → Tape) (out : Tape) + (inp' : Tape) (work' : Fin n → Tape) (out' : Tape), + P inp work out → + inp'.cells = inp.cells → + inp'.head = 1 → + work' = work → + out' = out → + P inp' work' out') : + ((rewindInputTM (n := n)).toNTM).HoareTime + (fun inp work out => + inp.cells 0 = Γ.start ∧ + (∀ j, j ≥ 1 → inp.cells j ≠ Γ.start) ∧ + inp.head ≤ B_input ∧ + out.read ≠ Γ.start ∧ out.head ≥ 1 ∧ + (∀ i, (work i).read ≠ Γ.start ∧ (work i).head ≥ 1) ∧ + P inp work out) + (fun inp work out => + inp.head = 1 ∧ + P inp work out) + (B_input + 2) := + (rewindInputTM_hoareTime_frame (n := n) B_input hP_preserved).toNTM + +-- ════════════════════════════════════════════════════════════════════════ +-- rewindWorkTM: rich HoareTime preserving arbitrary data +-- ════════════════════════════════════════════════════════════════════════ + +/-- Rich HoareTime for `rewindWorkTM` that preserves an arbitrary predicate P + through the rewind, provided P depends on cells (not heads) of the target + tape. This is the key tool for threading invariants (e.g., simulation state, + encoded data) through rewind steps in `seqTM` compositions. + + The caller provides `hP_preserved` showing that P is stable under: + - target tape cells unchanged, head set to 1 + - all other work tapes unchanged + - input and output unchanged -/ +theorem rewindWorkTM_hoareTime_frame {n : ℕ} (idx : Fin n) (B_tape : ℕ) + {P : Tape → (Fin n → Tape) → Tape → Prop} + (hP_preserved : ∀ (inp : Tape) (work : Fin n → Tape) (out : Tape) + (inp' : Tape) (work' : Fin n → Tape) (out' : Tape), + P inp work out → + (work' idx).cells = (work idx).cells → + (work' idx).head = 1 → + (∀ i, i ≠ idx → work' i = work i) → + inp' = inp → + out'.cells = out.cells → + out'.head = out.head → + P inp' work' out') : + (rewindWorkTM idx).HoareTime + (fun inp work out => + (work idx).cells 0 = Γ.start ∧ + (∀ j, j ≥ 1 → (work idx).cells j ≠ Γ.start) ∧ + (work idx).head ≤ B_tape ∧ + inp.read ≠ Γ.start ∧ + out.read ≠ Γ.start ∧ out.head ≥ 1 ∧ + (∀ i, i ≠ idx → (work i).read ≠ Γ.start ∧ (work i).head ≥ 1) ∧ + P inp work out) + (fun inp work out => + (work idx).head = 1 ∧ + P inp work out) + (B_tape + 2) := by + intro inp work out ⟨hcell0, hnostart, hhead_le, hinp_ns, hout_ns, hout_h, hother_wf, hP⟩ + -- Helper: idle-step identity for stable tapes + have tape_idle_preserve : ∀ (t : Tape), t.read ≠ Γ.start → t.head ≥ 1 → + t.writeAndMove (readBackWrite t.read) (idleDir t.read) = t := by + intro t hns hh + simp only [Tape.writeAndMove, idleDir, hns, ↓reduceIte, Tape.move, Tape.write] + split + · omega + · simp only [Tape.read] at hns ⊢ + rw [toΓ_readBackWrite_of_ne_start hns, Function.update_eq_self] + -- Rich rewind loop: tracks ALL tapes, not just work tape idx + suffices h_loop : ∀ (h : ℕ) (c : Cfg n (rewindWorkTM idx).Q), + c.state = RewindPhase.moveLeft → + (c.work idx).cells 0 = Γ.start → + (∀ j, j ≥ 1 → (c.work idx).cells j ≠ Γ.start) → + (c.work idx).head = h → + c.input = inp → c.output = out → (∀ i, i ≠ idx → c.work i = work i) → + ∃ c', + (rewindWorkTM idx).reachesIn (h + 2) c c' ∧ + (rewindWorkTM idx).halted c' ∧ + (c'.work idx).head = 1 ∧ (c'.work idx).cells = (c.work idx).cells ∧ + c'.input = inp ∧ c'.output = out ∧ (∀ i, i ≠ idx → c'.work i = work i) by + obtain ⟨c', hreach, hhalt, hh1, hcells, hinp', hout', hw'⟩ := + h_loop (work idx).head + { state := RewindPhase.moveLeft, input := inp, work := work, output := out } + rfl hcell0 hnostart rfl rfl rfl (fun _ _ => rfl) + refine ⟨c', _, by omega, hreach, hhalt, hh1, ?_⟩ + exact hP_preserved inp work out c'.input c'.work c'.output hP + (by rw [hcells]) hh1 hw' hinp' + (by rw [hout']) (by rw [hout']) + intro h; induction h with + | zero => + intro c hstate hcell0_c hnostart_c hhead hinp_c hout_c hw_c + have hread : (c.work idx).read = Γ.start := by simp [Tape.read, hhead, hcell0_c] + -- Step 1: moveLeft, read ▷ → moveRight + have hstep1 : ∃ c₁, + (rewindWorkTM idx).step c = some c₁ ∧ + c₁.state = RewindPhase.moveRight ∧ + (c₁.work idx).head = 1 ∧ (c₁.work idx).cells = (c.work idx).cells ∧ + c₁.input = inp ∧ c₁.output = out ∧ (∀ i, i ≠ idx → c₁.work i = work i) := by + simp only [TM.step, ↓reduceIte, hstate, rewindWorkTM, hread] + refine ⟨_, rfl, rfl, ?_, ?_, ?_, ?_, ?_⟩ + · dsimp only []; simp [Tape.writeAndMove, Tape.move, Tape.write, hhead] + · dsimp only []; simp [Tape.writeAndMove, Tape.move_cells, Tape.write, hhead] + · dsimp only []; rw [hinp_c]; simp only [idleDir, hinp_ns, ↓reduceIte, Tape.move] + · dsimp only []; rw [hout_c]; exact tape_idle_preserve out hout_ns hout_h + · intro i hne; dsimp only [] + simp only [show ¬(i = idx) from hne, ↓reduceIte] + rw [hw_c i hne]; exact tape_idle_preserve (work i) (hother_wf i hne).1 (hother_wf i hne).2 + obtain ⟨c₁, hstep1', hst1, hh1, hcells1, hinp1, hout1, hw1⟩ := hstep1 + -- Step 2: moveRight → done + have hread1 : (c₁.work idx).read ≠ Γ.start := by + simp [Tape.read, hh1, hcells1]; exact hnostart_c 1 (by omega) + have hstep2 : ∃ c₂, + (rewindWorkTM idx).step c₁ = some c₂ ∧ + (rewindWorkTM idx).halted c₂ ∧ + (c₂.work idx).head = 1 ∧ (c₂.work idx).cells = (c₁.work idx).cells ∧ + c₂.input = inp ∧ c₂.output = out ∧ (∀ i, i ≠ idx → c₂.work i = work i) := by + simp only [TM.step, hst1, rewindWorkTM] + refine ⟨_, rfl, rfl, ?_, ?_, ?_, ?_, ?_⟩ + · dsimp only [] + have := tape_idle_preserve (c₁.work idx) hread1 (by omega) + show ((c₁.work idx).writeAndMove (readBackWrite (c₁.work idx).read) + (idleDir (c₁.work idx).read)).head = 1 + rw [this]; exact hh1 + · dsimp only [] + have := tape_idle_preserve (c₁.work idx) hread1 (by omega) + show ((c₁.work idx).writeAndMove (readBackWrite (c₁.work idx).read) + (idleDir (c₁.work idx).read)).cells = (c₁.work idx).cells + rw [this] + · dsimp only []; rw [hinp1]; simp only [idleDir, hinp_ns, ↓reduceIte, Tape.move] + · dsimp only []; rw [hout1]; exact tape_idle_preserve out hout_ns hout_h + · intro i hne; dsimp only [] + rw [hw1 i hne]; exact tape_idle_preserve (work i) (hother_wf i hne).1 (hother_wf i hne).2 + obtain ⟨c₂, hstep2', hhalt, hh2, hcells2, hinp2, hout2, hw2⟩ := hstep2 + exact ⟨c₂, .step hstep1' (.step hstep2' .zero), hhalt, hh2, + by rw [hcells2, hcells1], hinp2, hout2, hw2⟩ + | succ h ih => + intro c hstate hcell0_c hnostart_c hhead hinp_c hout_c hw_c + have hread_ne : (c.work idx).read ≠ Γ.start := by + simp [Tape.read, hhead]; exact hnostart_c (h + 1) (by omega) + -- Step: moveLeft, read non-▷ → stay in moveLeft, move left + have hstep : ∃ c₁, + (rewindWorkTM idx).step c = some c₁ ∧ + c₁.state = RewindPhase.moveLeft ∧ + (c₁.work idx).head = h ∧ (c₁.work idx).cells = (c.work idx).cells ∧ + c₁.input = inp ∧ c₁.output = out ∧ (∀ i, i ≠ idx → c₁.work i = work i) := by + simp only [TM.step, ↓reduceIte, hstate, rewindWorkTM, hread_ne] + refine ⟨_, rfl, rfl, ?_, ?_, ?_, ?_, ?_⟩ + · dsimp only [] + simp only [↓reduceIte, Tape.writeAndMove, Tape.move] + rw [toΓ_readBackWrite_of_ne_start hread_ne] + simp only [Tape.write]; split + · omega + · simp [hhead] + · dsimp only [] + simp only [↓reduceIte, Tape.writeAndMove, Tape.move_cells] + rw [toΓ_readBackWrite_of_ne_start hread_ne] + simp only [Tape.write]; split + · rfl + · exact Function.update_eq_self _ _ + · dsimp only []; rw [hinp_c]; simp only [idleDir, hinp_ns, ↓reduceIte, Tape.move] + · dsimp only []; rw [hout_c]; exact tape_idle_preserve out hout_ns hout_h + · intro i hne; dsimp only [] + simp only [show ¬(i = idx) from hne, ↓reduceIte] + rw [hw_c i hne]; exact tape_idle_preserve (work i) (hother_wf i hne).1 (hother_wf i hne).2 + obtain ⟨c₁, hstep', hst1, hh1, hcells1, hinp1, hout1, hw1⟩ := hstep + obtain ⟨c_f, hreach_f, hhalt_f, hh_f, hcells_f, hinp_f, hout_f, hw_f⟩ := + ih c₁ hst1 (by rw [hcells1]; exact hcell0_c) + (by intro j hj; rw [hcells1]; exact hnostart_c j hj) hh1 hinp1 hout1 hw1 + exact ⟨c_f, .step hstep' hreach_f, hhalt_f, hh_f, + by rw [hcells_f, hcells1], hinp_f, hout_f, hw_f⟩ + +/-- Starting from cell `k + 1` of a started Boolean work tape whose first `k` +cells have already been blanked, `blankWorkTM idx` clears the remaining suffix +and halts with the entire tape blank from cell `1` onward. -/ +private theorem blankWorkTM_loop {n : ℕ} (idx : Fin n) (x : List Bool) : + ∀ rem k (c : Cfg n (blankWorkTM idx).Q), + rem = x.length - k → + k ≤ x.length → + c.state = ScanPhase.scanning → + (c.work idx).head = k + 1 → + (c.work idx).cells 0 = Γ.start → + (∀ i, i < k → (c.work idx).cells (i + 1) = Γ.blank) → + (∀ i, ∀ _ : k ≤ i, ∀ hi : i < x.length, + (c.work idx).cells (i + 1) = Γ.ofBool (x[i]'hi)) → + (∀ i, x.length ≤ i → (c.work idx).cells (i + 1) = Γ.blank) → + ∃ c', + (blankWorkTM idx).reachesIn (rem + 1) c c' ∧ + (blankWorkTM idx).halted c' ∧ + (c'.work idx).head = x.length + 1 ∧ + (c'.work idx).cells 0 = Γ.start ∧ + (∀ i, (c'.work idx).cells (i + 1) = Γ.blank) := by + intro rem + induction rem with + | zero => + intro k c hrem hk_le hstate hhead hcell0 hblank_prefix hdata hblank_tail + have hk_eq : k = x.length := by omega + subst hk_eq + have hread : (c.work idx).read = Γ.blank := by + simp [Tape.read, hhead, hblank_tail x.length le_rfl] + have hstep : + ∃ c1, + (blankWorkTM idx).step c = some c1 ∧ + (blankWorkTM idx).halted c1 ∧ + (c1.work idx).head = x.length + 1 ∧ + (c1.work idx).cells 0 = Γ.start ∧ + (∀ i, (c1.work idx).cells (i + 1) = Γ.blank) := by + let c1 : Cfg n (blankWorkTM idx).Q := + { state := ScanPhase.done + input := c.input.move (TM.idleDir c.input.read) + work := fun i => + (c.work i).writeAndMove (TM.readBackWrite ((c.work i).read)).toΓ + (TM.idleDir ((c.work i).read)) + output := c.output.writeAndMove (TM.readBackWrite c.output.read).toΓ + (TM.idleDir c.output.read) } + have hkeep : c1.work idx = c.work idx := by + have hread_ne : (c.work idx).read ≠ Γ.start := by simp [hread] + simpa [c1, hread, TM.transitionTape] using + (TM.transitionTape_eq_self (t := c.work idx) hread_ne) + refine ⟨c1, ?_, rfl, ?_, ?_, ?_⟩ + · simp [TM.step, hstate, blankWorkTM, hread, c1, allIdle] + · rw [hkeep, hhead] + · rw [hkeep] + exact hcell0 + · intro i + rw [hkeep] + by_cases hi : i < x.length + · exact hblank_prefix i hi + · exact hblank_tail i (by omega) + obtain ⟨c1, hstep1, hhalt1, hhead1, hcell01, hblank1⟩ := hstep + exact ⟨c1, .step hstep1 .zero, hhalt1, hhead1, hcell01, hblank1⟩ + | succ rem ih => + intro k c hrem hk_le hstate hhead hcell0 hblank_prefix hdata hblank_tail + have hk_lt : k < x.length := by omega + have hread : (c.work idx).read = Γ.ofBool (x[k]'hk_lt) := by + simp [Tape.read, hhead, hdata k le_rfl hk_lt] + have hstep : + ∃ c1, + (blankWorkTM idx).step c = some c1 ∧ + c1.state = ScanPhase.scanning ∧ + (c1.work idx).head = k + 2 ∧ + (c1.work idx).cells 0 = Γ.start ∧ + (∀ i, i < k + 1 → (c1.work idx).cells (i + 1) = Γ.blank) ∧ + (∀ i, ∀ _ : k + 1 ≤ i, ∀ hi : i < x.length, + (c1.work idx).cells (i + 1) = Γ.ofBool (x[i]'hi)) ∧ + (∀ i, x.length ≤ i → (c1.work idx).cells (i + 1) = Γ.blank) := by + cases hbit : x[k]'hk_lt with + | false => + have hread0 : (c.work idx).read = Γ.zero := by simpa [hbit] using hread + let c1 : Cfg n (blankWorkTM idx).Q := + { state := ScanPhase.scanning + input := c.input.move (TM.idleDir c.input.read) + work := fun i => + (c.work i).writeAndMove + ((if i = idx then Γw.blank else TM.readBackWrite ((c.work i).read)).toΓ) + (if i = idx then Dir3.right else TM.idleDir ((c.work i).read)) + output := c.output.writeAndMove (TM.readBackWrite c.output.read).toΓ + (TM.idleDir c.output.read) } + refine ⟨c1, ?_, rfl, ?_, ?_, ?_, ?_, ?_⟩ + · simp [TM.step, hstate, blankWorkTM, hread0, c1] + · simp [c1, hhead, Tape.writeAndMove, Tape.move, Tape.write_head] + · simp [c1, Tape.writeAndMove, Tape.move_cells, Tape.write, hhead, hcell0] + · intro i hi + by_cases hik : i < k + · have hblanki := hblank_prefix i hik + have hne : i + 1 ≠ k + 1 := by omega + simp [c1, Tape.writeAndMove, Tape.move_cells, Tape.write, hhead] + rw [Function.update_of_ne hne] + exact hblanki + · have hik_eq : i = k := by omega + subst hik_eq + simp [c1, Tape.writeAndMove, Tape.move_cells, Tape.write, hhead] + · intro i hi hix + have hcell := hdata i (by omega) hix + have hne : i + 1 ≠ k + 1 := by omega + simp [c1, Tape.writeAndMove, Tape.move_cells, Tape.write, hhead] + rw [Function.update_of_ne hne] + exact hcell + · intro i hi + have hcell := hblank_tail i hi + have hne : i + 1 ≠ k + 1 := by omega + simp [c1, Tape.writeAndMove, Tape.move_cells, Tape.write, hhead] + rw [Function.update_of_ne hne] + exact hcell + | true => + have hread1 : (c.work idx).read = Γ.one := by simpa [hbit] using hread + let c1 : Cfg n (blankWorkTM idx).Q := + { state := ScanPhase.scanning + input := c.input.move (TM.idleDir c.input.read) + work := fun i => + (c.work i).writeAndMove + ((if i = idx then Γw.blank else TM.readBackWrite ((c.work i).read)).toΓ) + (if i = idx then Dir3.right else TM.idleDir ((c.work i).read)) + output := c.output.writeAndMove (TM.readBackWrite c.output.read).toΓ + (TM.idleDir c.output.read) } + refine ⟨c1, ?_, rfl, ?_, ?_, ?_, ?_, ?_⟩ + · simp [TM.step, hstate, blankWorkTM, hread1, c1] + · simp [c1, hhead, Tape.writeAndMove, Tape.move, Tape.write_head] + · simp [c1, Tape.writeAndMove, Tape.move_cells, Tape.write, hhead, hcell0] + · intro i hi + by_cases hik : i < k + · have hblanki := hblank_prefix i hik + have hne : i + 1 ≠ k + 1 := by omega + simp [c1, Tape.writeAndMove, Tape.move_cells, Tape.write, hhead] + rw [Function.update_of_ne hne] + exact hblanki + · have hik_eq : i = k := by omega + subst hik_eq + simp [c1, Tape.writeAndMove, Tape.move_cells, Tape.write, hhead] + · intro i hi hix + have hcell := hdata i (by omega) hix + have hne : i + 1 ≠ k + 1 := by omega + simp [c1, Tape.writeAndMove, Tape.move_cells, Tape.write, hhead] + rw [Function.update_of_ne hne] + exact hcell + · intro i hi + have hcell := hblank_tail i hi + have hne : i + 1 ≠ k + 1 := by omega + simp [c1, Tape.writeAndMove, Tape.move_cells, Tape.write, hhead] + rw [Function.update_of_ne hne] + exact hcell + obtain ⟨c1, hstep1, hstate1, hhead1, hcell01, hblank_prefix1, + hdata1, hblank_tail1⟩ := hstep + have hrem1 : rem = x.length - (k + 1) := by omega + obtain ⟨c', hreach, hhalt, hhead', hcell0', hblank'⟩ := + ih (k + 1) c1 hrem1 (by omega) hstate1 hhead1 hcell01 hblank_prefix1 hdata1 hblank_tail1 + exact ⟨c', .step hstep1 hreach, hhalt, hhead', hcell0', hblank'⟩ + +/-- If work tape `idx` holds a started Boolean string `x`, then `blankWorkTM +idx` clears that tape in `|x| + 1` steps and leaves the head at the first +blank cell after the erased string. -/ +theorem blankWorkTM_started_hoareTime {n : ℕ} + (idx : Fin n) (x : List Bool) : + (blankWorkTM idx).HoareTime + (fun _inp work _out => + work idx = (Tape.init (x.map Γ.ofBool)).move Dir3.right) + (fun _inp work _out => + (work idx).head = x.length + 1 ∧ + (work idx).cells 0 = Γ.start ∧ + (∀ i, (work idx).cells (i + 1) = Γ.blank)) + (x.length + 1) := by + intro inp work out hpre + have hwork : work idx = (Tape.init (x.map Γ.ofBool)).move Dir3.right := hpre + have hhead0 : (work idx).head = 1 := by + rw [hwork] + simp [Tape.move, Tape.init] + have hcell00 : (work idx).cells 0 = Γ.start := by + rw [hwork] + simp [Tape.move, Tape.init] + have hblank0 : ∀ i, i < 0 → (work idx).cells (i + 1) = Γ.blank := by + intro i hi + exact (Nat.not_lt_zero i hi).elim + have hdata0 : ∀ i, ∀ _ : 0 ≤ i, ∀ hi : i < x.length, + (work idx).cells (i + 1) = Γ.ofBool (x[i]'hi) := by + intro i _ hi + rw [hwork] + exact Tape.init_ofBool_cells_lt x i hi + have htail0 : ∀ i, x.length ≤ i → (work idx).cells (i + 1) = Γ.blank := by + intro i hi + rw [hwork] + exact Tape.init_ofBool_cells_ge x i hi + obtain ⟨c', hreach, hhalt, hhead, hcell0, hblank⟩ := + blankWorkTM_loop idx x x.length 0 + { state := ScanPhase.scanning, input := inp, work := work, output := out } + (by simp) + (Nat.zero_le _) + rfl + hhead0 hcell00 hblank0 hdata0 htail0 + refine ⟨c', x.length + 1, le_rfl, hreach, hhalt, hhead, hcell0, hblank⟩ + +/-- Rich HoareTime for `blankWorkTM`: erase a started Boolean work tape while +preserving arbitrary frame data on the input tape, output tape, and all other +work tapes. This is the form needed to recycle a staged work tape inside a +larger verifier pipeline. -/ +theorem blankWorkTM_hoareTime_frame_of_binaryString {n : ℕ} + (idx : Fin n) (x : List Bool) + {P : Tape → (Fin n → Tape) → Tape → Prop} + (hP_preserved : ∀ (inp : Tape) (work : Fin n → Tape) (out : Tape) + (inp' : Tape) (work' : Fin n → Tape) (out' : Tape), + P inp work out → + (work' idx).head = x.length + 1 → + (work' idx).cells 0 = Γ.start → + (∀ i, (work' idx).cells (i + 1) = Γ.blank) → + inp' = inp → + out' = out → + (∀ i, i ≠ idx → work' i = work i) → + P inp' work' out') : + (blankWorkTM idx).HoareTime + (fun inp work out => + work idx = (Tape.init (x.map Γ.ofBool)).move Dir3.right ∧ + inp.read ≠ Γ.start ∧ + out.read ≠ Γ.start ∧ out.head ≥ 1 ∧ + (∀ i, i ≠ idx → (work i).read ≠ Γ.start ∧ (work i).head ≥ 1) ∧ + P inp work out) + (fun inp work out => + (work idx).head = x.length + 1 ∧ + (work idx).cells 0 = Γ.start ∧ + (∀ i, (work idx).cells (i + 1) = Γ.blank) ∧ + P inp work out) + (x.length + 1) := by + intro inp work out ⟨hwork, hinp_ns, hout_ns, hout_h, hother_wf, hP⟩ + have tape_idle_preserve : ∀ (t : Tape), t.read ≠ Γ.start → t.head ≥ 1 → + t.writeAndMove (readBackWrite t.read) (idleDir t.read) = t := by + intro t hns hh + simp only [Tape.writeAndMove, idleDir, hns, ↓reduceIte, Tape.move, Tape.write] + split + · omega + · simp only [Tape.read] at hns ⊢ + rw [toΓ_readBackWrite_of_ne_start hns, Function.update_eq_self] + have input_idle_preserve : ∀ (t : Tape), t.read ≠ Γ.start → + t.move (idleDir t.read) = t := by + intro t hns + simp [idleDir, hns, Tape.move] + suffices h_loop : ∀ rem k (c : Cfg n (blankWorkTM idx).Q), + rem = x.length - k → + k ≤ x.length → + c.state = ScanPhase.scanning → + (c.work idx).head = k + 1 → + (c.work idx).cells 0 = Γ.start → + (∀ i, i < k → (c.work idx).cells (i + 1) = Γ.blank) → + (∀ i, ∀ _ : k ≤ i, ∀ hi : i < x.length, + (c.work idx).cells (i + 1) = Γ.ofBool (x[i]'hi)) → + (∀ i, x.length ≤ i → (c.work idx).cells (i + 1) = Γ.blank) → + c.input = inp → + c.output = out → + (∀ i, i ≠ idx → c.work i = work i) → + ∃ c', + (blankWorkTM idx).reachesIn (rem + 1) c c' ∧ + (blankWorkTM idx).halted c' ∧ + (c'.work idx).head = x.length + 1 ∧ + (c'.work idx).cells 0 = Γ.start ∧ + (∀ i, (c'.work idx).cells (i + 1) = Γ.blank) ∧ + c'.input = inp ∧ + c'.output = out ∧ + (∀ i, i ≠ idx → c'.work i = work i) by + have hhead0 : (work idx).head = 1 := by + rw [hwork] + simp [Tape.move, Tape.init] + have hcell00 : (work idx).cells 0 = Γ.start := by + rw [hwork] + simp [Tape.move, Tape.init] + have hblank0 : ∀ i, i < 0 → (work idx).cells (i + 1) = Γ.blank := by + intro i hi + exact (Nat.not_lt_zero i hi).elim + have hdata0 : ∀ i, ∀ _ : 0 ≤ i, ∀ hi : i < x.length, + (work idx).cells (i + 1) = Γ.ofBool (x[i]'hi) := by + intro i _ hi + rw [hwork] + exact Tape.init_ofBool_cells_lt x i hi + have htail0 : ∀ i, x.length ≤ i → (work idx).cells (i + 1) = Γ.blank := by + intro i hi + rw [hwork] + exact Tape.init_ofBool_cells_ge x i hi + obtain ⟨c', hreach, hhalt, hhead, hcell0, hblank, hinp', hout', hwork'⟩ := + h_loop x.length 0 + { state := ScanPhase.scanning, input := inp, work := work, output := out } + (by simp) + (Nat.zero_le _) + rfl + hhead0 hcell00 hblank0 hdata0 htail0 + rfl rfl (fun _ _ => rfl) + refine ⟨c', x.length + 1, le_rfl, hreach, hhalt, hhead, hcell0, hblank, ?_⟩ + exact hP_preserved inp work out c'.input c'.work c'.output hP + hhead hcell0 hblank hinp' hout' hwork' + intro rem + induction rem with + | zero => + intro k c hrem hk_le hstate hhead hcell0 hblank_prefix hdata hblank_tail + hinp_c hout_c hw_c + have hk_eq : k = x.length := by omega + subst hk_eq + have hread : (c.work idx).read = Γ.blank := by + simp [Tape.read, hhead, hblank_tail x.length le_rfl] + let c1 : Cfg n (blankWorkTM idx).Q := + { state := ScanPhase.done + input := c.input.move (TM.idleDir c.input.read) + work := fun i => + (c.work i).writeAndMove (TM.readBackWrite ((c.work i).read)).toΓ + (TM.idleDir ((c.work i).read)) + output := c.output.writeAndMove (TM.readBackWrite c.output.read).toΓ + (TM.idleDir c.output.read) } + have hstep1 : (blankWorkTM idx).step c = some c1 := by + simp [TM.step, hstate, blankWorkTM, hread, c1] + have hinput_keep : c1.input = inp := by + change c.input.move (TM.idleDir c.input.read) = inp + rw [hinp_c] + exact input_idle_preserve _ hinp_ns + have htarget_keep : c1.work idx = c.work idx := by + have hread_ne : (c.work idx).read ≠ Γ.start := by + simp [hread] + have hh : (c.work idx).head ≥ 1 := by + rw [hhead] + omega + change (c.work idx).writeAndMove (TM.readBackWrite ((c.work idx).read)).toΓ + (TM.idleDir ((c.work idx).read)) = c.work idx + exact tape_idle_preserve (c.work idx) hread_ne hh + have hout_keep : c1.output = out := by + change c.output.writeAndMove (TM.readBackWrite c.output.read).toΓ + (TM.idleDir c.output.read) = out + rw [hout_c] + exact tape_idle_preserve out hout_ns hout_h + have hwork_keep : ∀ i, i ≠ idx → c1.work i = work i := by + intro i hi + change (c.work i).writeAndMove (TM.readBackWrite ((c.work i).read)).toΓ + (TM.idleDir ((c.work i).read)) = work i + rw [hw_c i hi] + exact tape_idle_preserve (work i) (hother_wf i hi).1 (hother_wf i hi).2 + have hblank_all : ∀ i, (c1.work idx).cells (i + 1) = Γ.blank := by + intro i + rw [htarget_keep] + by_cases hi : i < x.length + · exact hblank_prefix i hi + · exact hblank_tail i (by omega) + exact ⟨c1, .step hstep1 .zero, rfl, by rw [htarget_keep, hhead], + by rw [htarget_keep]; exact hcell0, + hblank_all, hinput_keep, hout_keep, hwork_keep⟩ + | succ rem ih => + intro k c hrem hk_le hstate hhead hcell0 hblank_prefix hdata hblank_tail + hinp_c hout_c hw_c + have hk_lt : k < x.length := by omega + have hread : (c.work idx).read = Γ.ofBool (x[k]'hk_lt) := by + simp [Tape.read, hhead, hdata k le_rfl hk_lt] + cases hbit : x[k]'hk_lt with + | false => + have hread0 : (c.work idx).read = Γ.zero := by simpa [hbit] using hread + let c1 : Cfg n (blankWorkTM idx).Q := + { state := ScanPhase.scanning + input := c.input.move (TM.idleDir c.input.read) + work := fun i => + (c.work i).writeAndMove + ((if i = idx then Γw.blank else TM.readBackWrite ((c.work i).read)).toΓ) + (if i = idx then Dir3.right else TM.idleDir ((c.work i).read)) + output := c.output.writeAndMove (TM.readBackWrite c.output.read).toΓ + (TM.idleDir c.output.read) } + have hstep1 : (blankWorkTM idx).step c = some c1 := by + simp [TM.step, hstate, blankWorkTM, hread0, c1] + have hinput_keep : c1.input = inp := by + simpa [c1, hinp_c] using input_idle_preserve inp hinp_ns + have houtput_keep : c1.output = out := by + simpa [c1, hout_c] using tape_idle_preserve out hout_ns hout_h + have hwork_keep : ∀ i, i ≠ idx → c1.work i = work i := by + intro i hi + simpa [c1, hi, hw_c i hi] using + tape_idle_preserve (work i) (hother_wf i hi).1 (hother_wf i hi).2 + have hhead1 : (c1.work idx).head = k + 2 := by + simp [c1, hhead, Tape.writeAndMove, Tape.move, Tape.write_head] + have hcell01 : (c1.work idx).cells 0 = Γ.start := by + simp [c1, Tape.writeAndMove, Tape.move_cells, Tape.write, hhead, hcell0] + have hblank_prefix1 : ∀ i, i < k + 1 → (c1.work idx).cells (i + 1) = Γ.blank := by + intro i hi + by_cases hik : i < k + · have hblanki := hblank_prefix i hik + have hne : i + 1 ≠ k + 1 := by omega + simp [c1, Tape.writeAndMove, Tape.move_cells, Tape.write, hhead] + rw [Function.update_of_ne hne] + exact hblanki + · have hik_eq : i = k := by omega + subst hik_eq + simp [c1, Tape.writeAndMove, Tape.move_cells, Tape.write, hhead] + have hdata1 : ∀ i, ∀ _ : k + 1 ≤ i, ∀ hi : i < x.length, + (c1.work idx).cells (i + 1) = Γ.ofBool (x[i]'hi) := by + intro i _ hix + have hcell := hdata i (by omega) hix + have hne : i + 1 ≠ k + 1 := by omega + simp [c1, Tape.writeAndMove, Tape.move_cells, Tape.write, hhead] + rw [Function.update_of_ne hne] + exact hcell + have hblank_tail1 : ∀ i, x.length ≤ i → (c1.work idx).cells (i + 1) = Γ.blank := by + intro i hi + have hcell := hblank_tail i hi + have hne : i + 1 ≠ k + 1 := by omega + simp [c1, Tape.writeAndMove, Tape.move_cells, Tape.write, hhead] + rw [Function.update_of_ne hne] + exact hcell + have hrem1 : rem = x.length - (k + 1) := by omega + obtain ⟨c', hreach, hhalt, hhead', hcell0', hblank', hinp', hout', hwork'⟩ := + ih (k + 1) c1 hrem1 (by omega) rfl hhead1 hcell01 hblank_prefix1 hdata1 + hblank_tail1 hinput_keep houtput_keep hwork_keep + exact ⟨c', .step hstep1 hreach, hhalt, hhead', hcell0', hblank', hinp', hout', hwork'⟩ + | true => + have hread1 : (c.work idx).read = Γ.one := by simpa [hbit] using hread + let c1 : Cfg n (blankWorkTM idx).Q := + { state := ScanPhase.scanning + input := c.input.move (TM.idleDir c.input.read) + work := fun i => + (c.work i).writeAndMove + ((if i = idx then Γw.blank else TM.readBackWrite ((c.work i).read)).toΓ) + (if i = idx then Dir3.right else TM.idleDir ((c.work i).read)) + output := c.output.writeAndMove (TM.readBackWrite c.output.read).toΓ + (TM.idleDir c.output.read) } + have hstep1 : (blankWorkTM idx).step c = some c1 := by + simp [TM.step, hstate, blankWorkTM, hread1, c1] + have hinput_keep : c1.input = inp := by + simpa [c1, hinp_c] using input_idle_preserve inp hinp_ns + have houtput_keep : c1.output = out := by + simpa [c1, hout_c] using tape_idle_preserve out hout_ns hout_h + have hwork_keep : ∀ i, i ≠ idx → c1.work i = work i := by + intro i hi + simpa [c1, hi, hw_c i hi] using + tape_idle_preserve (work i) (hother_wf i hi).1 (hother_wf i hi).2 + have hhead1 : (c1.work idx).head = k + 2 := by + simp [c1, hhead, Tape.writeAndMove, Tape.move, Tape.write_head] + have hcell01 : (c1.work idx).cells 0 = Γ.start := by + simp [c1, Tape.writeAndMove, Tape.move_cells, Tape.write, hhead, hcell0] + have hblank_prefix1 : ∀ i, i < k + 1 → (c1.work idx).cells (i + 1) = Γ.blank := by + intro i hi + by_cases hik : i < k + · have hblanki := hblank_prefix i hik + have hne : i + 1 ≠ k + 1 := by omega + simp [c1, Tape.writeAndMove, Tape.move_cells, Tape.write, hhead] + rw [Function.update_of_ne hne] + exact hblanki + · have hik_eq : i = k := by omega + subst hik_eq + simp [c1, Tape.writeAndMove, Tape.move_cells, Tape.write, hhead] + have hdata1 : ∀ i, ∀ _ : k + 1 ≤ i, ∀ hi : i < x.length, + (c1.work idx).cells (i + 1) = Γ.ofBool (x[i]'hi) := by + intro i _ hix + have hcell := hdata i (by omega) hix + have hne : i + 1 ≠ k + 1 := by omega + simp [c1, Tape.writeAndMove, Tape.move_cells, Tape.write, hhead] + rw [Function.update_of_ne hne] + exact hcell + have hblank_tail1 : ∀ i, x.length ≤ i → (c1.work idx).cells (i + 1) = Γ.blank := by + intro i hi + have hcell := hblank_tail i hi + have hne : i + 1 ≠ k + 1 := by omega + simp [c1, Tape.writeAndMove, Tape.move_cells, Tape.write, hhead] + rw [Function.update_of_ne hne] + exact hcell + have hrem1 : rem = x.length - (k + 1) := by omega + obtain ⟨c', hreach, hhalt, hhead', hcell0', hblank', hinp', hout', hwork'⟩ := + ih (k + 1) c1 hrem1 (by omega) rfl hhead1 hcell01 hblank_prefix1 hdata1 + hblank_tail1 hinput_keep houtput_keep hwork_keep + exact ⟨c', .step hstep1 hreach, hhalt, hhead', hcell0', hblank', hinp', hout', hwork'⟩ + +/-- Rich HoareTime for `clearWorkTM`: erase a started Boolean work tape and +rewind it to the standard started blank tape while preserving the external +frame. The user predicate only needs to be stable once the target tape has +reached the final started blank configuration. -/ +theorem clearWorkTM_hoareTime_frame_of_binaryString {n : ℕ} + (idx : Fin n) (x : List Bool) + {P : Tape → (Fin n → Tape) → Tape → Prop} + (hP_preserved : ∀ (inp : Tape) (work : Fin n → Tape) (out : Tape) + (inp' : Tape) (work' : Fin n → Tape) (out' : Tape), + P inp work out → + work' idx = (Tape.init []).move Dir3.right → + inp' = inp → + out' = out → + (∀ i, i ≠ idx → work' i = work i) → + P inp' work' out') : + (clearWorkTM idx).HoareTime + (fun inp work out => + work idx = (Tape.init (x.map Γ.ofBool)).move Dir3.right ∧ + inp.read ≠ Γ.start ∧ + out.read ≠ Γ.start ∧ out.head ≥ 1 ∧ + (∀ i, i ≠ idx → (work i).read ≠ Γ.start ∧ (work i).head ≥ 1) ∧ + P inp work out) + (fun inp work out => + work idx = (Tape.init []).move Dir3.right ∧ + P inp work out) + ((x.length + 1) + 1 + (x.length + 1 + 2)) := by + intro inp work out hpre + rcases hpre with ⟨hwork, hinp_ns, hout_ns, hout_h, hother_wf, hP⟩ + let FrameEq : TapePred n := fun inp' work' out' => + inp' = inp ∧ + out' = out ∧ + (∀ i, i ≠ idx → work' i = work i) + let BlankFrame : TapePred n := fun inp' work' out' => + FrameEq inp' work' out' ∧ + (work' idx).cells 0 = Γ.start ∧ + (∀ j, (work' idx).cells (j + 1) = Γ.blank) + have hblank : + (blankWorkTM idx).HoareTime + (fun inp work out => + work idx = (Tape.init (x.map Γ.ofBool)).move Dir3.right ∧ + inp.read ≠ Γ.start ∧ + out.read ≠ Γ.start ∧ out.head ≥ 1 ∧ + (∀ i, i ≠ idx → (work i).read ≠ Γ.start ∧ (work i).head ≥ 1) ∧ + FrameEq inp work out) + (fun inp work out => + (work idx).head = x.length + 1 ∧ + (work idx).cells 0 = Γ.start ∧ + (∀ j, (work idx).cells (j + 1) = Γ.blank) ∧ + FrameEq inp work out) + (x.length + 1) := by + refine blankWorkTM_hoareTime_frame_of_binaryString idx x ?_ + intro inp0 work0 out0 inp' work' out' hframe _hhead _hcell0 _hblank hinp' hout' hwork' + rcases hframe with ⟨hinp0, hout0, hwork0⟩ + exact ⟨by rw [hinp', hinp0], by rw [hout', hout0], by + intro i hi + rw [hwork' i hi, hwork0 i hi]⟩ + have hrew : + (rewindWorkTM idx).HoareTime + (fun inp work out => + (work idx).cells 0 = Γ.start ∧ + (∀ j, j ≥ 1 → (work idx).cells j ≠ Γ.start) ∧ + (work idx).head ≤ x.length + 1 ∧ + inp.read ≠ Γ.start ∧ + out.read ≠ Γ.start ∧ out.head ≥ 1 ∧ + (∀ i, i ≠ idx → (work i).read ≠ Γ.start ∧ (work i).head ≥ 1) ∧ + BlankFrame inp work out) + (fun inp work out => + (work idx).head = 1 ∧ + BlankFrame inp work out) + (x.length + 1 + 2) := by + refine rewindWorkTM_hoareTime_frame idx (x.length + 1) ?_ + intro inp0 work0 out0 inp' work' out' hblankframe hcells _hhead hwork_eq hinp' + hout_cells hout_head + rcases hblankframe with ⟨hframe, hcell0, hblank⟩ + rcases hframe with ⟨hinp0, hout0, hwork0⟩ + have hout_eq0 : out' = out0 := by + cases out' + cases out0 + simp at hout_cells hout_head + simp [hout_cells, hout_head] + refine ⟨?_, ?_, ?_⟩ + · exact ⟨by rw [hinp', hinp0], by rw [hout_eq0, hout0], by + intro i hi + rw [hwork_eq i hi, hwork0 i hi]⟩ + · rw [hcells] + exact hcell0 + · intro j + rw [hcells] + exact hblank j + have hseq : + (clearWorkTM idx).HoareTime + (fun inp work out => + work idx = (Tape.init (x.map Γ.ofBool)).move Dir3.right ∧ + inp.read ≠ Γ.start ∧ + out.read ≠ Γ.start ∧ out.head ≥ 1 ∧ + (∀ i, i ≠ idx → (work i).read ≠ Γ.start ∧ (work i).head ≥ 1) ∧ + FrameEq inp work out) + (fun inp work out => + (work idx).head = 1 ∧ + BlankFrame inp work out) + ((x.length + 1) + 1 + (x.length + 1 + 2)) := + seqTM_hoareTime (blankWorkTM idx) (rewindWorkTM idx) + hblank + (by + intro inp1 work1 out1 hmid + rcases hmid with ⟨hhead1, hcell01, hblank1, hframe1⟩ + rcases hframe1 with ⟨hinp1, hout1, hwork1⟩ + have htarget_read_ne : (work1 idx).read ≠ Γ.start := by + rw [Tape.read, hhead1, hblank1 x.length] + decide + have htarget_tr : TM.transitionTape (work1 idx) = work1 idx := + TM.transitionTape_eq_self htarget_read_ne + have hinput_tr : TM.transitionInput inp1 = inp1 := by + rw [hinp1] + exact TM.transitionInput_eq_self hinp_ns + have hout_tr : TM.transitionTape out1 = out1 := by + rw [hout1] + exact TM.transitionTape_eq_self hout_ns + have hwork_tr : ∀ i, i ≠ idx → TM.transitionTape (work1 i) = work1 i := by + intro i hi + rw [hwork1 i hi] + exact TM.transitionTape_eq_self (hother_wf i hi).1 + refine ⟨?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_⟩ + · change (TM.transitionTape (work1 idx)).cells 0 = Γ.start + rw [htarget_tr] + exact hcell01 + · intro j hj + cases j with + | zero => omega + | succ j => + change (TM.transitionTape (work1 idx)).cells j.succ ≠ Γ.start + rw [htarget_tr] + rw [show j.succ = j + 1 by omega, hblank1 j] + decide + · change (TM.transitionTape (work1 idx)).head ≤ x.length + 1 + rw [htarget_tr, hhead1] + · rw [hinput_tr, hinp1] + exact hinp_ns + · change (TM.transitionTape out1).read ≠ Γ.start + rw [hout_tr, hout1] + exact hout_ns + · change (TM.transitionTape out1).head ≥ 1 + rw [hout_tr, hout1] + exact hout_h + · intro i hi + constructor + · change (TM.transitionTape (work1 i)).read ≠ Γ.start + rw [hwork_tr i hi, hwork1 i hi] + exact (hother_wf i hi).1 + · change (TM.transitionTape (work1 i)).head ≥ 1 + rw [hwork_tr i hi, hwork1 i hi] + exact (hother_wf i hi).2 + · refine ⟨?_, ?_, ?_⟩ + · refine ⟨?_, ?_, ?_⟩ + · change TM.transitionInput inp1 = inp + rw [hinput_tr, hinp1] + · change TM.transitionTape out1 = out + rw [hout_tr, hout1] + · intro i hi + change TM.transitionTape (work1 i) = work i + rw [hwork_tr i hi, hwork1 i hi] + · change (TM.transitionTape (work1 idx)).cells 0 = Γ.start + rw [htarget_tr] + exact hcell01 + · intro j + change (TM.transitionTape (work1 idx)).cells (j + 1) = Γ.blank + rw [htarget_tr] + exact hblank1 j) + hrew + have hclear := hseq.strengthen_post (by + intro inp' work' out' hpost + rcases hpost with ⟨hhead, hblankframe⟩ + rcases hblankframe with ⟨hframe, hcell0, hblank⟩ + rcases hframe with ⟨hinp', hout', hwork'⟩ + have hbits : (work' idx).HasBinaryString [] := by + refine ⟨hhead, ?_, ?_⟩ + · intro i hi + exact (Nat.not_lt_zero i hi).elim + · intro i _ + exact hblank i + have hclear : work' idx = (Tape.init []).move Dir3.right := + Tape.eq_init_move_right_of_hasBinaryString hbits hcell0 + exact show work' idx = (Tape.init []).move Dir3.right ∧ P inp' work' out' from + ⟨hclear, hP_preserved inp work out inp' work' out' hP hclear hinp' hout' hwork'⟩) + exact hclear inp work out ⟨hwork, hinp_ns, hout_ns, hout_h, hother_wf, ⟨rfl, rfl, fun _ _ => rfl⟩⟩ + +/-- Starting from cell `k + 1` of a Boolean input tape and an already-copied +prefix `x.take k` on work tape `idx`, `copyInputToWorkTM idx` copies the +remaining suffix and halts with the full prefix `x` on the target tape. -/ +private theorem copyInputToWorkTM_loop {n : ℕ} (idx : Fin n) (x : List Bool) : + ∀ rem k (c : Cfg n (copyInputToWorkTM idx).Q), + rem = x.length - k → + c.state = CopyPhase.copying → + c.input.cells = (Tape.init (x.map Γ.ofBool)).cells → + c.input.head = k + 1 → + (c.work idx).HasBinaryPrefix (x.take k) → + k ≤ x.length → + ∃ c', + (copyInputToWorkTM idx).reachesIn (rem + 1) c c' ∧ + (copyInputToWorkTM idx).halted c' ∧ + c'.input.cells = (Tape.init (x.map Γ.ofBool)).cells ∧ + c'.input.head = x.length + 1 ∧ + (c'.work idx).HasBinaryPrefix x := by + intro rem + induction rem with + | zero => + intro k c hrem hstate hcells hhead hprefix hk_le + have hk_eq : k = x.length := by + omega + subst hk_eq + have hread : c.input.read = Γ.blank := by + simp [Tape.read, hhead, hcells, Tape.init_ofBool_cells_ge x x.length le_rfl] + have hprefix_full : (c.work idx).HasBinaryPrefix x := by + simpa using hprefix + have hwork_blank : (c.work idx).read = Γ.blank := by + have hblank := hprefix_full.2.2 x.length le_rfl + simp [Tape.read, hprefix_full.1, hblank] + have hstep : + ∃ c1, + (copyInputToWorkTM idx).step c = some c1 ∧ + (copyInputToWorkTM idx).halted c1 ∧ + c1.input.cells = (Tape.init (x.map Γ.ofBool)).cells ∧ + c1.input.head = x.length + 1 ∧ + (c1.work idx).HasBinaryPrefix x := by + let c1 : Cfg n (copyInputToWorkTM idx).Q := + { state := CopyPhase.done + input := c.input.move (TM.idleDir c.input.read) + work := fun i => + (c.work i).writeAndMove Γ.blank (TM.idleDir ((c.work i).read)) + output := c.output.writeAndMove Γ.blank (TM.idleDir c.output.read) } + have hinput_keep : + c.input.move (TM.idleDir c.input.read) = c.input := by + simp [TM.idleDir, hread, Tape.move] + have hwork_keep : + (c.work idx).writeAndMove Γ.blank (TM.idleDir ((c.work idx).read)) = c.work idx := by + simpa [transitionTape, hwork_blank] using + (transitionTape_eq_self (t := c.work idx) (by simp [hwork_blank])) + refine ⟨c1, ?_, rfl, ?_, ?_, ?_⟩ + · simp [TM.step, hstate, copyInputToWorkTM, hread, c1, allIdle] + · rw [show c1.input = c.input by simpa [c1] using hinput_keep] + exact hcells + · rw [show c1.input = c.input by simpa [c1] using hinput_keep] + exact hhead + · rw [show c1.work idx = c.work idx by + simpa [c1] using hwork_keep] + exact hprefix_full + obtain ⟨c1, hstep1, hhalt1, hcells1, hhead1, hprefix1⟩ := hstep + exact ⟨c1, .step hstep1 .zero, hhalt1, hcells1, hhead1, hprefix1⟩ + | succ rem ih => + intro k c hrem hstate hcells hhead hprefix hk_le + have hk_lt : k < x.length := by + omega + have hread : c.input.read = Γ.ofBool (x[k]'hk_lt) := by + simp [Tape.read, hhead, hcells, Tape.init_ofBool_cells_lt x k hk_lt] + have hprefix_next : + ((c.work idx).writeAndMove (Γ.ofBool (x[k]'hk_lt)) Dir3.right).HasBinaryPrefix + (x.take (k + 1)) := by + have hwrite := Tape.hasBinaryPrefix_write_bit (x[k]'hk_lt) hprefix + simpa [List.take_concat_get' x k hk_lt] using hwrite + have hstep : + ∃ c1, + (copyInputToWorkTM idx).step c = some c1 ∧ + c1.state = CopyPhase.copying ∧ + c1.input.cells = (Tape.init (x.map Γ.ofBool)).cells ∧ + c1.input.head = k + 2 ∧ + (c1.work idx).HasBinaryPrefix (x.take (k + 1)) := by + cases hbit : x[k]'hk_lt with + | false => + have hread0 : c.input.read = Γ.zero := by + simpa [hbit] using hread + let c1 : Cfg n (copyInputToWorkTM idx).Q := + { state := CopyPhase.copying + input := c.input.move Dir3.right + work := fun i => + (c.work i).writeAndMove + ((if i = idx then Γw.zero else Γw.blank).toΓ) + (if i = idx then Dir3.right else TM.idleDir ((c.work i).read)) + output := c.output.writeAndMove Γ.blank (TM.idleDir c.output.read) } + refine ⟨c1, ?_, rfl, ?_, ?_, ?_⟩ + · simp [TM.step, hstate, copyInputToWorkTM, hread0, c1] + · simpa [c1, Tape.move_cells] using hcells + · simp [c1, Tape.move, hhead] + · have hwidx : + c1.work idx = (c.work idx).writeAndMove Γ.zero Dir3.right := by + simp [c1] + rw [hwidx] + simpa [hbit] using hprefix_next + | true => + have hread1 : c.input.read = Γ.one := by + simpa [hbit] using hread + let c1 : Cfg n (copyInputToWorkTM idx).Q := + { state := CopyPhase.copying + input := c.input.move Dir3.right + work := fun i => + (c.work i).writeAndMove + ((if i = idx then Γw.one else Γw.blank).toΓ) + (if i = idx then Dir3.right else TM.idleDir ((c.work i).read)) + output := c.output.writeAndMove Γ.blank (TM.idleDir c.output.read) } + refine ⟨c1, ?_, rfl, ?_, ?_, ?_⟩ + · simp [TM.step, hstate, copyInputToWorkTM, hread1, c1] + · simpa [c1, Tape.move_cells] using hcells + · simp [c1, Tape.move, hhead] + · have hwidx : + c1.work idx = (c.work idx).writeAndMove Γ.one Dir3.right := by + simp [c1] + rw [hwidx] + simpa [hbit] using hprefix_next + obtain ⟨c1, hstep1, hstate1, hcells1, hhead1, hprefix1⟩ := hstep + have hrem1 : rem = x.length - (k + 1) := by + omega + obtain ⟨c', hreach, hhalt, hcells', hhead', hprefix'⟩ := + ih (k + 1) c1 hrem1 hstate1 hcells1 hhead1 hprefix1 (by omega) + exact ⟨c', .step hstep1 hreach, hhalt, hcells', hhead', hprefix'⟩ + +/-- `copyInputToWorkTM idx` can be started with the input and target work tape +already positioned at cell `1`: it copies the entire Boolean input to a binary +prefix on work tape `idx` and halts within `|x| + 1` steps. -/ +theorem copyInputToWorkTM_started_hoareTime {n : ℕ} (idx : Fin n) (x : List Bool) : + (copyInputToWorkTM idx).HoareTime + (fun inp work _out => + inp = (Tape.init (x.map Γ.ofBool)).move Dir3.right ∧ + (work idx).HasBinaryPrefix []) + (fun inp work _out => + inp.cells = (Tape.init (x.map Γ.ofBool)).cells ∧ + inp.head = x.length + 1 ∧ + (work idx).HasBinaryPrefix x) + (x.length + 1) := by + intro inp work out hpre + rcases hpre with ⟨hinp, hprefix⟩ + subst inp + obtain ⟨c', hreach, hhalt, hcells, hhead, hprefix'⟩ := + copyInputToWorkTM_loop idx x x.length 0 + { state := CopyPhase.copying + input := (Tape.init (x.map Γ.ofBool)).move Dir3.right + work := work + output := out } + (by simp) + rfl + (by simp [Tape.move]) + rfl + (by simpa using hprefix) + (Nat.zero_le _) + refine ⟨c', x.length + 1, le_rfl, hreach, hhalt, hcells, hhead, hprefix'⟩ + +private theorem copyWorkToWorkTM_loop {n : ℕ} + (src dst : Fin n) (hne : src ≠ dst) (x : List Bool) : + ∀ rem k (c : Cfg n (copyWorkToWorkTM src dst).Q), + rem = x.length - k → + c.state = CopyPhase.copying → + (c.work src).cells = (Tape.init (x.map Γ.ofBool)).cells → + (c.work src).head = k + 1 → + (c.work dst).HasBinaryPrefix (x.take k) → + k ≤ x.length → + ∃ c', + (copyWorkToWorkTM src dst).reachesIn (rem + 1) c c' ∧ + (copyWorkToWorkTM src dst).halted c' ∧ + (c'.work src).cells = (Tape.init (x.map Γ.ofBool)).cells ∧ + (c'.work src).head = x.length + 1 ∧ + (c'.work dst).HasBinaryPrefix x := by + intro rem + induction rem with + | zero => + intro k c hrem hstate hsrc_cells hsrc_head hprefix hk_le + have hk_eq : k = x.length := by + omega + subst hk_eq + have hsrc_read : (c.work src).read = Γ.blank := by + simp [Tape.read, hsrc_head, hsrc_cells, Tape.init_ofBool_cells_ge x x.length le_rfl] + have hprefix_full : (c.work dst).HasBinaryPrefix x := by + simpa using hprefix + have hdst_read : (c.work dst).read = Γ.blank := by + have hblank := hprefix_full.2.2 x.length le_rfl + simp [Tape.read, hprefix_full.1, hblank] + have hstep : + ∃ c1, + (copyWorkToWorkTM src dst).step c = some c1 ∧ + (copyWorkToWorkTM src dst).halted c1 ∧ + (c1.work src).cells = (Tape.init (x.map Γ.ofBool)).cells ∧ + (c1.work src).head = x.length + 1 ∧ + (c1.work dst).HasBinaryPrefix x := by + let c1 : Cfg n (copyWorkToWorkTM src dst).Q := + { state := CopyPhase.done + input := c.input.move (TM.idleDir c.input.read) + work := fun i => + (c.work i).writeAndMove (TM.readBackWrite ((c.work i).read)).toΓ + (TM.idleDir ((c.work i).read)) + output := c.output.writeAndMove (TM.readBackWrite c.output.read).toΓ + (TM.idleDir c.output.read) } + have hsrc_keep : c1.work src = c.work src := by + have hsrc_ne : (c.work src).read ≠ Γ.start := by + rw [hsrc_read] + decide + simpa [c1, hsrc_read, TM.transitionTape] using + (TM.transitionTape_eq_self (t := c.work src) hsrc_ne) + have hdst_keep : c1.work dst = c.work dst := by + have hdst_ne : (c.work dst).read ≠ Γ.start := by + rw [hdst_read] + decide + simpa [c1, hdst_read, TM.transitionTape] using + (TM.transitionTape_eq_self (t := c.work dst) hdst_ne) + refine ⟨c1, ?_, rfl, ?_, ?_, ?_⟩ + · simp [TM.step, hstate, copyWorkToWorkTM, hsrc_read, c1, allIdle] + · rw [hsrc_keep] + exact hsrc_cells + · rw [hsrc_keep, hsrc_head] + · rw [hdst_keep] + exact hprefix_full + obtain ⟨c1, hstep1, hhalt1, hsrc_cells1, hsrc_head1, hprefix1⟩ := hstep + exact ⟨c1, .step hstep1 .zero, hhalt1, hsrc_cells1, hsrc_head1, hprefix1⟩ + | succ rem ih => + intro k c hrem hstate hsrc_cells hsrc_head hprefix hk_le + have hk_lt : k < x.length := by + omega + have hsrc_read : (c.work src).read = Γ.ofBool (x[k]'hk_lt) := by + simp [Tape.read, hsrc_head, hsrc_cells, Tape.init_ofBool_cells_lt x k hk_lt] + have hprefix_next : + ((c.work dst).writeAndMove (Γ.ofBool (x[k]'hk_lt)) Dir3.right).HasBinaryPrefix + (x.take (k + 1)) := by + have hwrite := Tape.hasBinaryPrefix_write_bit (x[k]'hk_lt) hprefix + simpa [List.take_concat_get' x k hk_lt] using hwrite + have hstep : + ∃ c1, + (copyWorkToWorkTM src dst).step c = some c1 ∧ + c1.state = CopyPhase.copying ∧ + (c1.work src).cells = (Tape.init (x.map Γ.ofBool)).cells ∧ + (c1.work src).head = k + 2 ∧ + (c1.work dst).HasBinaryPrefix (x.take (k + 1)) := by + cases hbit : x[k]'hk_lt with + | false => + have hread0 : (c.work src).read = Γ.zero := by + simpa [hbit] using hsrc_read + let c1 : Cfg n (copyWorkToWorkTM src dst).Q := + { state := CopyPhase.copying + input := c.input.move (TM.idleDir c.input.read) + work := fun i => + (c.work i).writeAndMove + ((if i = dst then Γw.zero else TM.readBackWrite ((c.work i).read)).toΓ) + (if i = dst then Dir3.right else if i = src then Dir3.right + else TM.idleDir ((c.work i).read)) + output := c.output.writeAndMove (TM.readBackWrite c.output.read).toΓ + (TM.idleDir c.output.read) } + refine ⟨c1, ?_, rfl, ?_, ?_, ?_⟩ + · simp [TM.step, hstate, copyWorkToWorkTM, hread0, c1, TM.readBackWrite] + · have hsrc_ne : (c.work src).read ≠ Γ.start := by + rw [hread0] + decide + have hsrc_pres : + (c1.work src).cells = (c.work src).cells := by + simpa [c1, hread0, hne, TM.readBackWrite] using + (TM.tape_readBackWrite_preserves (c.work src) Dir3.right (Or.inr hsrc_ne)) + rw [hsrc_pres] + exact hsrc_cells + · simp [c1, hsrc_head, hne, Tape.writeAndMove, Tape.move, Tape.write_head] + · have hdst : + c1.work dst = (c.work dst).writeAndMove Γ.zero Dir3.right := by + simp [c1] + rw [hdst] + simpa [hbit] using hprefix_next + | true => + have hread1 : (c.work src).read = Γ.one := by + simpa [hbit] using hsrc_read + let c1 : Cfg n (copyWorkToWorkTM src dst).Q := + { state := CopyPhase.copying + input := c.input.move (TM.idleDir c.input.read) + work := fun i => + (c.work i).writeAndMove + ((if i = dst then Γw.one else TM.readBackWrite ((c.work i).read)).toΓ) + (if i = dst then Dir3.right else if i = src then Dir3.right + else TM.idleDir ((c.work i).read)) + output := c.output.writeAndMove (TM.readBackWrite c.output.read).toΓ + (TM.idleDir c.output.read) } + refine ⟨c1, ?_, rfl, ?_, ?_, ?_⟩ + · simp [TM.step, hstate, copyWorkToWorkTM, hread1, c1, TM.readBackWrite] + · have hsrc_ne : (c.work src).read ≠ Γ.start := by + rw [hread1] + decide + have hsrc_pres : + (c1.work src).cells = (c.work src).cells := by + simpa [c1, hread1, hne, TM.readBackWrite] using + (TM.tape_readBackWrite_preserves (c.work src) Dir3.right (Or.inr hsrc_ne)) + rw [hsrc_pres] + exact hsrc_cells + · simp [c1, hsrc_head, hne, Tape.writeAndMove, Tape.move, Tape.write_head] + · have hdst : + c1.work dst = (c.work dst).writeAndMove Γ.one Dir3.right := by + simp [c1] + rw [hdst] + simpa [hbit] using hprefix_next + obtain ⟨c1, hstep1, hstate1, hsrc_cells1, hsrc_head1, hprefix1⟩ := hstep + have hrem1 : rem = x.length - (k + 1) := by + omega + obtain ⟨c', hreach, hhalt, hsrc_cells', hsrc_head', hprefix'⟩ := + ih (k + 1) c1 hrem1 hstate1 hsrc_cells1 hsrc_head1 hprefix1 (by omega) + exact ⟨c', .step hstep1 hreach, hhalt, hsrc_cells', hsrc_head', hprefix'⟩ + +/-- If `src` holds a started Boolean string `x` and `dst` is a started blank +work tape, then `copyWorkToWorkTM src dst` copies `x` onto `dst` within +`|x| + 1` steps. The source contents are preserved, while its head advances +to the first blank cell after the copied data. -/ +theorem copyWorkToWorkTM_started_hoareTime {n : ℕ} + (src dst : Fin n) (hne : src ≠ dst) (x : List Bool) : + (copyWorkToWorkTM src dst).HoareTime + (fun _inp work _out => + work src = (Tape.init (x.map Γ.ofBool)).move Dir3.right ∧ + (work dst).HasBinaryPrefix []) + (fun _inp work _out => + (work src).cells = (Tape.init (x.map Γ.ofBool)).cells ∧ + (work src).head = x.length + 1 ∧ + (work dst).HasBinaryPrefix x) + (x.length + 1) := by + intro inp work out hpre + rcases hpre with ⟨hsrc, hdst⟩ + have hsrc_cells0 : (work src).cells = (Tape.init (x.map Γ.ofBool)).cells := by + rw [hsrc] + exact Tape.move_cells _ _ + have hsrc_head0 : (work src).head = 1 := by + rw [hsrc] + simp [Tape.move, Tape.init] + obtain ⟨c', hreach, hhalt, hsrc_cells, hsrc_head, hprefix⟩ := + copyWorkToWorkTM_loop src dst hne x x.length 0 + { state := CopyPhase.copying + input := inp + work := work + output := out } + (by simp) + rfl + hsrc_cells0 + hsrc_head0 + (by simpa using hdst) + (Nat.zero_le _) + refine ⟨c', x.length + 1, le_rfl, hreach, hhalt, hsrc_cells, hsrc_head, hprefix⟩ + +/-- Rich HoareTime for `copyWorkToWorkTM`: copy a started Boolean work tape to +another started blank work tape while preserving arbitrary frame data on the +input tape, output tape, and all unrelated work tapes. The source cells are +preserved while its head advances to the first blank after the copied string, +and the destination accumulates the copied prefix without losing its left-end +marker. -/ +theorem copyWorkToWorkTM_hoareTime_frame_of_binaryString {n : ℕ} + (src dst : Fin n) (hne : src ≠ dst) (x : List Bool) + {P : Tape → (Fin n → Tape) → Tape → Prop} + (hP_preserved : ∀ (inp : Tape) (work : Fin n → Tape) (out : Tape) + (inp' : Tape) (work' : Fin n → Tape) (out' : Tape), + P inp work out → + (work' src).cells = (Tape.init (x.map Γ.ofBool)).cells → + (work' src).head = x.length + 1 → + (work' dst).HasBinaryPrefix x → + (work' dst).cells 0 = Γ.start → + inp' = inp → + out' = out → + (∀ i, i ≠ src → i ≠ dst → work' i = work i) → + P inp' work' out') : + (copyWorkToWorkTM src dst).HoareTime + (fun inp work out => + work src = (Tape.init (x.map Γ.ofBool)).move Dir3.right ∧ + work dst = (Tape.init []).move Dir3.right ∧ + inp.read ≠ Γ.start ∧ + out.read ≠ Γ.start ∧ out.head ≥ 1 ∧ + (∀ i, i ≠ src → i ≠ dst → (work i).read ≠ Γ.start ∧ (work i).head ≥ 1) ∧ + P inp work out) + (fun inp work out => + (work src).cells = (Tape.init (x.map Γ.ofBool)).cells ∧ + (work src).head = x.length + 1 ∧ + (work dst).HasBinaryPrefix x ∧ + (work dst).cells 0 = Γ.start ∧ + P inp work out) + (x.length + 1) := by + intro inp work out hpre + rcases hpre with ⟨hsrc, hdst, hinp_ns, hout_ns, hout_h, hother_wf, hP⟩ + have tape_idle_preserve : ∀ (t : Tape), t.read ≠ Γ.start → t.head ≥ 1 → + t.writeAndMove (readBackWrite t.read) (idleDir t.read) = t := by + intro t hns hh + simp only [Tape.writeAndMove, idleDir, hns, ↓reduceIte, Tape.move, Tape.write] + split + · omega + · simp only [Tape.read] at hns ⊢ + rw [toΓ_readBackWrite_of_ne_start hns, Function.update_eq_self] + have input_idle_preserve : ∀ (t : Tape), t.read ≠ Γ.start → + t.move (idleDir t.read) = t := by + intro t hns + simp [idleDir, hns, Tape.move] + suffices h_loop : ∀ rem k (c : Cfg n (copyWorkToWorkTM src dst).Q), + rem = x.length - k → + c.state = CopyPhase.copying → + (c.work src).cells = (Tape.init (x.map Γ.ofBool)).cells → + (c.work src).head = k + 1 → + (c.work dst).HasBinaryPrefix (x.take k) → + (c.work dst).cells 0 = Γ.start → + k ≤ x.length → + c.input = inp → + c.output = out → + (∀ i, i ≠ src → i ≠ dst → c.work i = work i) → + ∃ c', + (copyWorkToWorkTM src dst).reachesIn (rem + 1) c c' ∧ + (copyWorkToWorkTM src dst).halted c' ∧ + (c'.work src).cells = (Tape.init (x.map Γ.ofBool)).cells ∧ + (c'.work src).head = x.length + 1 ∧ + (c'.work dst).HasBinaryPrefix x ∧ + (c'.work dst).cells 0 = Γ.start ∧ + c'.input = inp ∧ + c'.output = out ∧ + (∀ i, i ≠ src → i ≠ dst → c'.work i = work i) by + have hsrc_cells0 : (work src).cells = (Tape.init (x.map Γ.ofBool)).cells := by + rw [hsrc] + exact Tape.move_cells _ _ + have hsrc_head0 : (work src).head = 1 := by + rw [hsrc] + simp [Tape.move, Tape.init] + have hdst_prefix0 : (work dst).HasBinaryPrefix [] := by + rw [hdst] + exact Tape.init_nil_move_right_hasBinaryPrefix_nil + have hdst_cell00 : (work dst).cells 0 = Γ.start := by + rw [hdst] + simp [Tape.move, Tape.init] + obtain ⟨c', hreach, hhalt, hsrc_cells, hsrc_head, hprefix, hcell0, hinp', hout', + hwork'⟩ := + h_loop x.length 0 + { state := CopyPhase.copying, input := inp, work := work, output := out } + (by simp) + rfl + hsrc_cells0 + hsrc_head0 + hdst_prefix0 + hdst_cell00 + (Nat.zero_le _) + rfl + rfl + (fun _ _ _ => rfl) + refine ⟨c', x.length + 1, le_rfl, hreach, hhalt, hsrc_cells, hsrc_head, hprefix, + hcell0, ?_⟩ + exact hP_preserved inp work out c'.input c'.work c'.output hP + hsrc_cells hsrc_head hprefix hcell0 hinp' hout' hwork' + intro rem + induction rem with + | zero => + intro k c hrem hstate hsrc_cells hsrc_head hprefix hdst_cell0 hk_le hinp_c hout_c hw_c + have hk_eq : k = x.length := by + omega + subst hk_eq + have hsrc_read : (c.work src).read = Γ.blank := by + simp [Tape.read, hsrc_head, hsrc_cells, Tape.init_ofBool_cells_ge x x.length le_rfl] + have hprefix_full : (c.work dst).HasBinaryPrefix x := by + simpa using hprefix + have hdst_read : (c.work dst).read = Γ.blank := by + have hblank := hprefix_full.2.2 x.length le_rfl + simp [Tape.read, hprefix_full.1, hblank] + let c1 : Cfg n (copyWorkToWorkTM src dst).Q := + { state := CopyPhase.done + input := c.input.move (TM.idleDir c.input.read) + work := fun i => + (c.work i).writeAndMove (TM.readBackWrite ((c.work i).read)).toΓ + (TM.idleDir ((c.work i).read)) + output := c.output.writeAndMove (TM.readBackWrite c.output.read).toΓ + (TM.idleDir c.output.read) } + have hstep1 : (copyWorkToWorkTM src dst).step c = some c1 := by + simp [TM.step, hstate, copyWorkToWorkTM, hsrc_read, c1, allIdle] + have hinput_keep : c1.input = inp := by + simpa [c1, hinp_c] using input_idle_preserve inp hinp_ns + have houtput_keep : c1.output = out := by + simpa [c1, hout_c] using tape_idle_preserve out hout_ns hout_h + have hother_keep : ∀ i, i ≠ src → i ≠ dst → c1.work i = work i := by + intro i hi_src hi_dst + simpa [c1, hi_src, hi_dst, hw_c i hi_src hi_dst] using + tape_idle_preserve (work i) (hother_wf i hi_src hi_dst).1 (hother_wf i hi_src hi_dst).2 + have hsrc_keep : c1.work src = c.work src := by + have hsrc_ne : (c.work src).read ≠ Γ.start := by + rw [hsrc_read] + decide + simpa [c1, hsrc_read, TM.transitionTape] using + (TM.transitionTape_eq_self (t := c.work src) hsrc_ne) + have hdst_keep : c1.work dst = c.work dst := by + have hdst_ne : (c.work dst).read ≠ Γ.start := by + rw [hdst_read] + decide + simpa [c1, hdst_read, TM.transitionTape] using + (TM.transitionTape_eq_self (t := c.work dst) hdst_ne) + refine ⟨c1, .step hstep1 .zero, rfl, ?_, ?_, ?_, ?_, ?_, ?_, ?_⟩ + · rw [hsrc_keep] + exact hsrc_cells + · rw [hsrc_keep, hsrc_head] + · rw [hdst_keep] + exact hprefix_full + · rw [hdst_keep] + exact hdst_cell0 + · exact hinput_keep + · exact houtput_keep + · exact hother_keep + | succ rem ih => + intro k c hrem hstate hsrc_cells hsrc_head hprefix hdst_cell0 hk_le hinp_c hout_c hw_c + have hk_lt : k < x.length := by + omega + have hsrc_read : (c.work src).read = Γ.ofBool (x[k]'hk_lt) := by + simp [Tape.read, hsrc_head, hsrc_cells, Tape.init_ofBool_cells_lt x k hk_lt] + have hprefix_next : + ((c.work dst).writeAndMove (Γ.ofBool (x[k]'hk_lt)) Dir3.right).HasBinaryPrefix + (x.take (k + 1)) := by + have hwrite := Tape.hasBinaryPrefix_write_bit (x[k]'hk_lt) hprefix + simpa [List.take_concat_get' x k hk_lt] using hwrite + cases hbit : x[k]'hk_lt with + | false => + have hread0 : (c.work src).read = Γ.zero := by + simpa [hbit] using hsrc_read + let c1 : Cfg n (copyWorkToWorkTM src dst).Q := + { state := CopyPhase.copying + input := c.input.move (TM.idleDir c.input.read) + work := fun i => + (c.work i).writeAndMove + ((if i = dst then Γw.zero else TM.readBackWrite ((c.work i).read)).toΓ) + (if i = dst then Dir3.right else if i = src then Dir3.right + else TM.idleDir ((c.work i).read)) + output := c.output.writeAndMove (TM.readBackWrite c.output.read).toΓ + (TM.idleDir c.output.read) } + have hstep1 : (copyWorkToWorkTM src dst).step c = some c1 := by + simp [TM.step, hstate, copyWorkToWorkTM, hread0, c1, TM.readBackWrite] + have hinput_keep : c1.input = inp := by + simpa [c1, hinp_c] using input_idle_preserve inp hinp_ns + have houtput_keep : c1.output = out := by + simpa [c1, hout_c] using tape_idle_preserve out hout_ns hout_h + have hother_keep : ∀ i, i ≠ src → i ≠ dst → c1.work i = work i := by + intro i hi_src hi_dst + simpa [c1, hi_src, hi_dst, hw_c i hi_src hi_dst] using + tape_idle_preserve (work i) (hother_wf i hi_src hi_dst).1 + (hother_wf i hi_src hi_dst).2 + have hsrc_cells1 : (c1.work src).cells = (Tape.init (x.map Γ.ofBool)).cells := by + have hsrc_ne : (c.work src).read ≠ Γ.start := by + rw [hread0] + decide + have hsrc_pres : + (c1.work src).cells = (c.work src).cells := by + simpa [c1, hread0, hne, TM.readBackWrite] using + (TM.tape_readBackWrite_preserves (c.work src) Dir3.right (Or.inr hsrc_ne)) + rw [hsrc_pres] + exact hsrc_cells + have hsrc_head1 : (c1.work src).head = k + 2 := by + simp [c1, hsrc_head, hne, Tape.writeAndMove, Tape.move, Tape.write_head] + have hdst_prefix1 : (c1.work dst).HasBinaryPrefix (x.take (k + 1)) := by + have hdst : + c1.work dst = (c.work dst).writeAndMove Γ.zero Dir3.right := by + simp [c1] + rw [hdst] + simpa [hbit] using hprefix_next + have hdst_cell01 : (c1.work dst).cells 0 = Γ.start := by + have hdst : + c1.work dst = (c.work dst).writeAndMove Γ.zero Dir3.right := by + simp [c1] + rw [hdst] + exact Tape.hasBinaryPrefix_write_bit_cell0 false hprefix hdst_cell0 + have hrem1 : rem = x.length - (k + 1) := by + omega + obtain ⟨c', hreach, hhalt, hsrc_cells', hsrc_head', hprefix', hcell0', hinp', + hout', hwork'⟩ := + ih (k + 1) c1 hrem1 rfl hsrc_cells1 hsrc_head1 hdst_prefix1 hdst_cell01 + (by omega) hinput_keep houtput_keep hother_keep + exact ⟨c', .step hstep1 hreach, hhalt, hsrc_cells', hsrc_head', hprefix', hcell0', + hinp', hout', hwork'⟩ + | true => + have hread1 : (c.work src).read = Γ.one := by + simpa [hbit] using hsrc_read + let c1 : Cfg n (copyWorkToWorkTM src dst).Q := + { state := CopyPhase.copying + input := c.input.move (TM.idleDir c.input.read) + work := fun i => + (c.work i).writeAndMove + ((if i = dst then Γw.one else TM.readBackWrite ((c.work i).read)).toΓ) + (if i = dst then Dir3.right else if i = src then Dir3.right + else TM.idleDir ((c.work i).read)) + output := c.output.writeAndMove (TM.readBackWrite c.output.read).toΓ + (TM.idleDir c.output.read) } + have hstep1 : (copyWorkToWorkTM src dst).step c = some c1 := by + simp [TM.step, hstate, copyWorkToWorkTM, hread1, c1, TM.readBackWrite] + have hinput_keep : c1.input = inp := by + simpa [c1, hinp_c] using input_idle_preserve inp hinp_ns + have houtput_keep : c1.output = out := by + simpa [c1, hout_c] using tape_idle_preserve out hout_ns hout_h + have hother_keep : ∀ i, i ≠ src → i ≠ dst → c1.work i = work i := by + intro i hi_src hi_dst + simpa [c1, hi_src, hi_dst, hw_c i hi_src hi_dst] using + tape_idle_preserve (work i) (hother_wf i hi_src hi_dst).1 + (hother_wf i hi_src hi_dst).2 + have hsrc_cells1 : (c1.work src).cells = (Tape.init (x.map Γ.ofBool)).cells := by + have hsrc_ne : (c.work src).read ≠ Γ.start := by + rw [hread1] + decide + have hsrc_pres : + (c1.work src).cells = (c.work src).cells := by + simpa [c1, hread1, hne, TM.readBackWrite] using + (TM.tape_readBackWrite_preserves (c.work src) Dir3.right (Or.inr hsrc_ne)) + rw [hsrc_pres] + exact hsrc_cells + have hsrc_head1 : (c1.work src).head = k + 2 := by + simp [c1, hsrc_head, hne, Tape.writeAndMove, Tape.move, Tape.write_head] + have hdst_prefix1 : (c1.work dst).HasBinaryPrefix (x.take (k + 1)) := by + have hdst : + c1.work dst = (c.work dst).writeAndMove Γ.one Dir3.right := by + simp [c1] + rw [hdst] + simpa [hbit] using hprefix_next + have hdst_cell01 : (c1.work dst).cells 0 = Γ.start := by + have hdst : + c1.work dst = (c.work dst).writeAndMove Γ.one Dir3.right := by + simp [c1] + rw [hdst] + exact Tape.hasBinaryPrefix_write_bit_cell0 true hprefix hdst_cell0 + have hrem1 : rem = x.length - (k + 1) := by + omega + obtain ⟨c', hreach, hhalt, hsrc_cells', hsrc_head', hprefix', hcell0', hinp', + hout', hwork'⟩ := + ih (k + 1) c1 hrem1 rfl hsrc_cells1 hsrc_head1 hdst_prefix1 hdst_cell01 + (by omega) hinput_keep houtput_keep hother_keep + exact ⟨c', .step hstep1 hreach, hhalt, hsrc_cells', hsrc_head', hprefix', hcell0', + hinp', hout', hwork'⟩ + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/Internal/CopyOutput.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/Internal/CopyOutput.lean new file mode 100644 index 0000000000..533bb62359 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/Internal/CopyOutput.lean @@ -0,0 +1,169 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Tape.Encoding +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.Internal.Generic + +/-! +# Input-to-output copy correctness + +Exact simulation proof for `TM.copyInputToOutputTM`. Starting from the initial +configuration on `x`, the machine skips the two left-end markers, copies one +Boolean symbol per step, and halts at the first input blank after exactly +`|x| + 2` steps with output `x`. + +The public theorem is stated in +`Complexitylib.Models.TuringMachine.Subroutines.CopyOutput`. +-/ + + +public section + +namespace Complexity + +namespace TM + +/-! ## Copy loop -/ + +/-- From the first uncopied input cell and an output holding `x.take k`, the +copy loop consumes the remaining `rem = |x| - k` bits and one terminating +blank step. -/ +private theorem copyInputToOutputTM_loop {n : ℕ} (x : List Bool) : + ∀ rem k (c : Cfg n (copyInputToOutputTM (n := n)).Q), + rem = x.length - k → + c.state = CopyPhase.copying → + c.input.cells = (Tape.init (x.map Γ.ofBool)).cells → + c.input.head = k + 1 → + c.output.HasBinaryPrefix (x.take k) → + k ≤ x.length → + ∃ c', + (copyInputToOutputTM (n := n)).reachesIn (rem + 1) c c' ∧ + (copyInputToOutputTM (n := n)).halted c' ∧ + c'.input.cells = (Tape.init (x.map Γ.ofBool)).cells ∧ + c'.input.head = x.length + 1 ∧ + c'.output.HasBinaryPrefix x := by + intro rem + induction rem with + | zero => + intro k c hrem hstate hcells hhead hprefix hk_le + have hk_eq : k = x.length := by omega + subst hk_eq + have hread : c.input.read = Γ.blank := by + simp [Tape.read, hhead, hcells, Tape.init_ofBool_cells_ge x x.length le_rfl] + have hprefix_full : c.output.HasBinaryPrefix x := by + simpa using hprefix + have houtput_blank : c.output.read = Γ.blank := by + have hblank := hprefix_full.2.2 x.length le_rfl + simp [Tape.read, hprefix_full.1, hblank] + let c1 : Cfg n (copyInputToOutputTM (n := n)).Q := + { state := CopyPhase.done + input := c.input.move (idleDir c.input.read) + work := fun i => + (c.work i).writeAndMove (readBackWrite (c.work i).read) + (idleDir (c.work i).read) + output := c.output.writeAndMove (readBackWrite c.output.read) + (idleDir c.output.read) } + have hinput_keep : c.input.move (idleDir c.input.read) = c.input := by + simp [idleDir, hread, Tape.move] + have houtput_keep : + c.output.writeAndMove (readBackWrite c.output.read) + (idleDir c.output.read) = c.output := by + exact transitionTape_eq_self (t := c.output) (by simp [houtput_blank]) + have hstep : (copyInputToOutputTM (n := n)).step c = some c1 := by + simp [TM.step, hstate, copyInputToOutputTM, hread, c1] + refine ⟨c1, .step hstep .zero, rfl, ?_, ?_, ?_⟩ + · rw [show c1.input = c.input by simpa [c1] using hinput_keep] + exact hcells + · rw [show c1.input = c.input by simpa [c1] using hinput_keep] + exact hhead + · rw [show c1.output = c.output by simpa [c1] using houtput_keep] + exact hprefix_full + | succ rem ih => + intro k c hrem hstate hcells hhead hprefix hk_le + have hk_lt : k < x.length := by omega + have hread : c.input.read = Γ.ofBool (x[k]'hk_lt) := by + simp [Tape.read, hhead, hcells, Tape.init_ofBool_cells_lt x k hk_lt] + have hprefix_next : + (c.output.writeAndMove (Γ.ofBool (x[k]'hk_lt)) Dir3.right).HasBinaryPrefix + (x.take (k + 1)) := by + have hwrite := Tape.hasBinaryPrefix_write_bit (x[k]'hk_lt) hprefix + simpa [List.take_concat_get' x k hk_lt] using hwrite + have hstep : + ∃ c1, + (copyInputToOutputTM (n := n)).step c = some c1 ∧ + c1.state = CopyPhase.copying ∧ + c1.input.cells = (Tape.init (x.map Γ.ofBool)).cells ∧ + c1.input.head = k + 2 ∧ + c1.output.HasBinaryPrefix (x.take (k + 1)) := by + cases hbit : x[k]'hk_lt with + | false => + have hread0 : c.input.read = Γ.zero := by + simpa [hbit] using hread + let c1 : Cfg n (copyInputToOutputTM (n := n)).Q := + { state := CopyPhase.copying + input := c.input.move Dir3.right + work := fun i => + (c.work i).writeAndMove (readBackWrite (c.work i).read) + (idleDir (c.work i).read) + output := c.output.writeAndMove Γ.zero Dir3.right } + refine ⟨c1, ?_, rfl, ?_, ?_, ?_⟩ + · simp [TM.step, hstate, copyInputToOutputTM, hread0, c1, readBackWrite] + · simpa [c1, Tape.move_cells] using hcells + · simp [c1, Tape.move, hhead] + · simpa [c1, hbit] using hprefix_next + | true => + have hread1 : c.input.read = Γ.one := by + simpa [hbit] using hread + let c1 : Cfg n (copyInputToOutputTM (n := n)).Q := + { state := CopyPhase.copying + input := c.input.move Dir3.right + work := fun i => + (c.work i).writeAndMove (readBackWrite (c.work i).read) + (idleDir (c.work i).read) + output := c.output.writeAndMove Γ.one Dir3.right } + refine ⟨c1, ?_, rfl, ?_, ?_, ?_⟩ + · simp [TM.step, hstate, copyInputToOutputTM, hread1, c1, readBackWrite] + · simpa [c1, Tape.move_cells] using hcells + · simp [c1, Tape.move, hhead] + · simpa [c1, hbit] using hprefix_next + obtain ⟨c1, hstep1, hstate1, hcells1, hhead1, hprefix1⟩ := hstep + have hrem1 : rem = x.length - (k + 1) := by omega + obtain ⟨c', hreach, hhalt, hcells', hhead', hprefix'⟩ := + ih (k + 1) c1 hrem1 hstate1 hcells1 hhead1 hprefix1 (by omega) + exact ⟨c', .step hstep1 hreach, hhalt, hcells', hhead', hprefix'⟩ + +/-! ## Initial-configuration correctness -/ + +/-- Internal implementation theorem: the copy machine computes identity in +the exact linear bound `m + 2`. -/ +theorem copyInputToOutputTM_computesInTime_internal (n : ℕ) : + (copyInputToOutputTM (n := n)).ComputesInTime id (fun m => m + 2) := by + intro x + let c1 : Cfg n (copyInputToOutputTM (n := n)).Q := + { state := CopyPhase.copying + input := (Tape.init (x.map Γ.ofBool)).move Dir3.right + work := fun _ => (Tape.init []).move Dir3.right + output := (Tape.init []).move Dir3.right } + have hstep : + (copyInputToOutputTM (n := n)).step + ((copyInputToOutputTM (n := n)).initCfg x) = some c1 := by + simp [TM.step, copyInputToOutputTM, c1, Tape.read, Tape.init, readBackWrite, + idleDir, Tape.writeAndMove, Tape.write, Tape.move] + obtain ⟨c', hreach, hhalt, _hcells, _hhead, hprefix⟩ := + copyInputToOutputTM_loop (n := n) x x.length 0 c1 (by simp) rfl + (by simp [c1, Tape.move]) (by simp [c1, Tape.move]) + (by simpa [c1] using Tape.init_nil_move_right_hasBinaryPrefix_nil) + (Nat.zero_le _) + refine ⟨c', x.length + 2, le_rfl, ?_, hhalt, ?_⟩ + · simpa [Nat.add_assoc] using TM.reachesIn.step hstep hreach + · simpa using (show c'.output.HasOutput x from + ⟨hprefix.2.1, hprefix.2.2 x.length le_rfl⟩) + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/Internal/CopyWorkOutput.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/Internal/CopyWorkOutput.lean new file mode 100644 index 0000000000..1e40c71e17 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/Internal/CopyWorkOutput.lean @@ -0,0 +1,351 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.Internal.Generic +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Hoare.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Tape.Encoding + +/-! +# Copy a raw work-tape output — proof internals + +`Tape.HasOutput` deliberately leaves cells after the terminating blank +unconstrained. This module proves that `TM.copyWorkToWorkTM` nevertheless +copies such an output to a fresh work tape: it reads only the advertised bits +and their first blank delimiter. + +Public statements are in +`Complexitylib.Models.TuringMachine.Subroutines.CopyWorkOutput`. +-/ + + +public section + +namespace Complexity + +namespace TM + +/-! ## Exact copy loop -/ + +/-- Copy the unread suffix of a raw output while preserving the source cells. -/ +private theorem copyWorkOutput_loop {n : ℕ} + (src dst : Fin n) (hne : src ≠ dst) (x : List Bool) (source : Tape) : + ∀ rem k (c : Cfg n (copyWorkToWorkTM src dst).Q) (dstCell0 : Γ), + rem = x.length - k → + c.state = CopyPhase.copying → + (c.work src).cells = source.cells → + (c.work src).head = k + 1 → + source.HasOutput x → + (c.work dst).HasBinaryPrefix (x.take k) → + (c.work dst).cells 0 = dstCell0 → + k ≤ x.length → + ∃ c', + (copyWorkToWorkTM src dst).reachesIn (rem + 1) c c' ∧ + (copyWorkToWorkTM src dst).halted c' ∧ + (c'.work src).cells = source.cells ∧ + (c'.work src).head = x.length + 1 ∧ + (c'.work src).HasOutput x ∧ + (c'.work dst).HasBinaryPrefix x ∧ + (c'.work dst).cells 0 = dstCell0 := by + intro rem + induction rem with + | zero => + intro k c dstCell0 hrem hstate hsrcCells hsrcHead hsource hprefix hdst0 hk + have hkEq : k = x.length := by omega + subst hkEq + have hsrcRead : (c.work src).read = Γ.blank := by + rw [Tape.read, hsrcHead, hsrcCells] + exact hsource.2 + have hprefixFull : (c.work dst).HasBinaryPrefix x := by + simpa using hprefix + have hdstRead : (c.work dst).read = Γ.blank := by + rw [Tape.read, hprefixFull.1] + exact hprefixFull.2.2 x.length le_rfl + let c1 : Cfg n (copyWorkToWorkTM src dst).Q := + { state := CopyPhase.done + input := c.input.move (idleDir c.input.read) + work := fun i => + (c.work i).writeAndMove (readBackWrite (c.work i).read).toΓ + (idleDir (c.work i).read) + output := c.output.writeAndMove (readBackWrite c.output.read).toΓ + (idleDir c.output.read) } + have hstep : (copyWorkToWorkTM src dst).step c = some c1 := by + simp [TM.step, hstate, copyWorkToWorkTM, hsrcRead, c1, allIdle] + have hsrcKeep : c1.work src = c.work src := by + have hneStart : (c.work src).read ≠ Γ.start := by + rw [hsrcRead] + decide + simpa [c1, hsrcRead, transitionTape] using + (transitionTape_eq_self (t := c.work src) hneStart) + have hdstKeep : c1.work dst = c.work dst := by + have hneStart : (c.work dst).read ≠ Γ.start := by + rw [hdstRead] + decide + simpa [c1, hdstRead, transitionTape] using + (transitionTape_eq_self (t := c.work dst) hneStart) + refine ⟨c1, .step hstep .zero, rfl, ?_, ?_, ?_, ?_, ?_⟩ + · rw [hsrcKeep] + exact hsrcCells + · rw [hsrcKeep, hsrcHead] + · rw [hsrcKeep] + exact (Tape.hasOutput_congr hsrcCells x).mpr hsource + · rw [hdstKeep] + exact hprefixFull + · rw [hdstKeep] + exact hdst0 + | succ rem ih => + intro k c dstCell0 hrem hstate hsrcCells hsrcHead hsource hprefix hdst0 hk + have hkLt : k < x.length := by omega + let bit := x[k]'hkLt + have hsrcRead : (c.work src).read = Γ.ofBool bit := by + rw [Tape.read, hsrcHead, hsrcCells] + exact hsource.1 k hkLt + have hprefixNext : + ((c.work dst).writeAndMove (Γ.ofBool bit) Dir3.right).HasBinaryPrefix + (x.take (k + 1)) := by + have hwrite := Tape.hasBinaryPrefix_write_bit bit hprefix + simpa [bit, List.take_concat_get' x k hkLt] using hwrite + let c1 : Cfg n (copyWorkToWorkTM src dst).Q := + { state := CopyPhase.copying + input := c.input.move (idleDir c.input.read) + work := fun i => + (c.work i).writeAndMove + (if i = dst then (Γw.ofBool bit).toΓ + else (readBackWrite (c.work i).read).toΓ) + (if i = dst then Dir3.right + else if i = src then Dir3.right else idleDir (c.work i).read) + output := c.output.writeAndMove (readBackWrite c.output.read).toΓ + (idleDir c.output.read) } + have hstep : (copyWorkToWorkTM src dst).step c = some c1 := by + cases hbit : bit + · simp [TM.step, hstate, copyWorkToWorkTM, hsrcRead, hbit, bit, c1, + Γ.ofBool, Γw.ofBool, Γw.toΓ, readBackWrite] + funext i + by_cases hi : i = dst <;> simp [hi] + · simp [TM.step, hstate, copyWorkToWorkTM, hsrcRead, hbit, bit, c1, + Γ.ofBool, Γw.ofBool, Γw.toΓ, readBackWrite] + funext i + by_cases hi : i = dst <;> simp [hi] + have hsrcCells1 : (c1.work src).cells = source.cells := by + have hneStart : (c.work src).read ≠ Γ.start := by + rw [hsrcRead] + exact Γ.ofBool_ne_start bit + have hpres : (c1.work src).cells = (c.work src).cells := by + simpa [c1, hne, hsrcRead] using + (tape_readBackWrite_preserves (c.work src) Dir3.right (Or.inr hneStart)) + rw [hpres] + exact hsrcCells + have hsrcHead1 : (c1.work src).head = k + 2 := by + simp [c1, hsrcHead, hne, Tape.writeAndMove, Tape.move, Tape.write_head] + have hdstTape : + c1.work dst = (c.work dst).writeAndMove (Γ.ofBool bit) Dir3.right := by + dsimp only [c1] + simp only [if_pos] + rw [Γw.ofBool_toΓ] + have hdstPrefix1 : (c1.work dst).HasBinaryPrefix (x.take (k + 1)) := by + rw [hdstTape] + exact hprefixNext + have hdst01 : (c1.work dst).cells 0 = dstCell0 := by + rw [hdstTape] + simp only [Tape.writeAndMove, Tape.move_cells, Tape.write] + rw [if_neg (by rw [hprefix.1]; omega)] + change Function.update (c.work dst).cells (c.work dst).head + (Γ.ofBool bit) 0 = dstCell0 + rw [Function.update_of_ne (by rw [hprefix.1]; omega)] + exact hdst0 + have hrem1 : rem = x.length - (k + 1) := by omega + obtain ⟨c', hreach, hhalt, hsrcCells', hsrcHead', hsrcOutput', hprefix', + hdst0'⟩ := + ih (k + 1) c1 dstCell0 hrem1 rfl hsrcCells1 hsrcHead1 hsource + hdstPrefix1 hdst01 (by omega) + exact ⟨c', .step hstep hreach, hhalt, hsrcCells', hsrcHead', hsrcOutput', + hprefix', hdst0'⟩ + +/-! ## Hoare specification -/ + +/-- Exact raw-output copy from a concrete tape configuration. -/ +theorem copyWorkToWorkTM_reachesIn_of_hasOutput_internal {n : ℕ} + (src dst : Fin n) (hne : src ≠ dst) (x : List Bool) + {inp out : Tape} {work : Fin n → Tape} + (hsrcHead : (work src).head = 1) + (hsrcOutput : (work src).HasOutput x) + (hdst : (work dst).HasBinaryPrefix []) : + ∃ c', + (copyWorkToWorkTM src dst).reachesIn (x.length + 1) + { state := (copyWorkToWorkTM src dst).qstart, + input := inp, work := work, output := out } c' ∧ + (copyWorkToWorkTM src dst).halted c' ∧ + (c'.work src).cells = (work src).cells ∧ + (c'.work src).head = x.length + 1 ∧ + (c'.work src).HasOutput x ∧ + (c'.work dst).HasBinaryPrefix x ∧ + (c'.work dst).cells 0 = (work dst).cells 0 := by + exact copyWorkOutput_loop src dst hne x (work src) x.length 0 + { state := CopyPhase.copying, input := inp, work := work, output := out } + ((work dst).cells 0) (by simp) rfl rfl hsrcHead hsrcOutput + (by simpa using hdst) rfl (Nat.zero_le _) + +/-- A raw `HasOutput` source is copied exactly through its first blank. +Arbitrary source cells after that delimiter are preserved and ignored. -/ +theorem copyWorkToWorkTM_hoareTime_of_hasOutput_internal {n : ℕ} + (src dst : Fin n) (hne : src ≠ dst) (x : List Bool) (source : Tape) : + (copyWorkToWorkTM src dst).HoareTime + (fun _inp work _out => + work src = source ∧ source.head = 1 ∧ source.HasOutput x ∧ + (work dst).HasBinaryPrefix []) + (fun _inp work _out => + (work src).cells = source.cells ∧ + (work src).head = x.length + 1 ∧ + (work src).HasOutput x ∧ + (work dst).HasBinaryPrefix x) + (x.length + 1) := by + intro inp work out hpre + rcases hpre with ⟨hsrc, hsourceHead, hsourceOutput, hdst⟩ + have hsrcCells : (work src).cells = source.cells := by rw [hsrc] + have hsrcHead : (work src).head = 1 := by rw [hsrc, hsourceHead] + obtain ⟨c', hreach, hhalt, hsrcCells', hsrcHead', hsrcOutput', hprefix', _⟩ := + copyWorkOutput_loop src dst hne x source x.length 0 + { state := CopyPhase.copying, input := inp, work := work, output := out } + ((work dst).cells 0) (by simp) rfl hsrcCells hsrcHead hsourceOutput + (by simpa using hdst) rfl (Nat.zero_le _) + exact ⟨c', x.length + 1, le_rfl, hreach, hhalt, hsrcCells', hsrcHead', + hsrcOutput', hprefix'⟩ + +/-! ## Exact frame preservation -/ + +/-- A stable tape is unchanged by the copy machine's idle action. -/ +private theorem idle_writeBack_eq (t : Tape) + (hread : t.read ≠ Γ.start) (hhead : 1 ≤ t.head) : + t.writeAndMove (readBackWrite t.read).toΓ (idleDir t.read) = t := by + simp only [Tape.writeAndMove, idleDir, hread, ↓reduceIte, Tape.move, Tape.write] + split + · omega + · simp only [Tape.read] at hread ⊢ + rw [toΓ_readBackWrite_of_ne_start hread, Function.update_eq_self] + +/-- A stable read-only tape is unchanged by the input idle action. -/ +private theorem idle_input_eq (t : Tape) (hread : t.read ≠ Γ.start) : + t.move (idleDir t.read) = t := by + simp [idleDir, hread, Tape.move] + +/-- One copy step preserves the input, output, and every unrelated work tape +when those tapes are already off the left-end marker. -/ +private theorem copyWorkOutput_step_frame {n : ℕ} (src dst : Fin n) + {c c' : Cfg n (copyWorkToWorkTM src dst).Q} + (hstep : (copyWorkToWorkTM src dst).step c = some c') + (hin : c.input.read ≠ Γ.start) + (hout : c.output.read ≠ Γ.start) (houtHead : 1 ≤ c.output.head) + (hother : ∀ i, i ≠ src → i ≠ dst → + (c.work i).read ≠ Γ.start ∧ 1 ≤ (c.work i).head) : + c'.input = c.input ∧ c'.output = c.output ∧ + ∀ i, i ≠ src → i ≠ dst → c'.work i = c.work i := by + have hneHalt := state_ne_qhalt_of_step hstep + cases hstate : c.state with + | done => + exfalso + exact hneHalt (by simpa [copyWorkToWorkTM] using hstate) + | copying => + unfold TM.step at hstep + rw [if_neg hneHalt] at hstep + have hc := Option.some.inj hstep + rw [← hc] + rw [hstate] + dsimp only [copyWorkToWorkTM] + split + · refine ⟨idle_input_eq c.input hin, idle_writeBack_eq c.output hout houtHead, ?_⟩ + intro i hiSrc hiDst + exact idle_writeBack_eq (c.work i) (hother i hiSrc hiDst).1 + (hother i hiSrc hiDst).2 + · refine ⟨idle_input_eq c.input hin, idle_writeBack_eq c.output hout houtHead, ?_⟩ + intro i hiSrc hiDst + simp only [hiDst, hiSrc, ↓reduceIte] + exact idle_writeBack_eq (c.work i) (hother i hiSrc hiDst).1 + (hother i hiSrc hiDst).2 + +/-- Exact frame preservation over an arbitrary finite copy run. -/ +private theorem copyWorkOutput_reachesIn_frame {n : ℕ} (src dst : Fin n) + {t : ℕ} {c c' : Cfg n (copyWorkToWorkTM src dst).Q} + (hreach : (copyWorkToWorkTM src dst).reachesIn t c c') + (hin : c.input.read ≠ Γ.start) + (hout : c.output.read ≠ Γ.start) (houtHead : 1 ≤ c.output.head) + (hother : ∀ i, i ≠ src → i ≠ dst → + (c.work i).read ≠ Γ.start ∧ 1 ≤ (c.work i).head) : + c'.input = c.input ∧ c'.output = c.output ∧ + ∀ i, i ≠ src → i ≠ dst → c'.work i = c.work i := by + induction hreach with + | zero => exact ⟨rfl, rfl, fun _ _ _ => rfl⟩ + | @step c0 c1 _ _ hstep _ ih => + obtain ⟨hin1, hout1, hwork1⟩ := + copyWorkOutput_step_frame src dst hstep hin hout houtHead hother + have hother1 : ∀ i, i ≠ src → i ≠ dst → + (c1.work i).read ≠ Γ.start ∧ 1 ≤ (c1.work i).head := by + intro i hiSrc hiDst + rw [hwork1 i hiSrc hiDst] + exact hother i hiSrc hiDst + have ih' := ih (by rw [hin1]; exact hin) (by rw [hout1]; exact hout) + (by rw [hout1]; exact houtHead) hother1 + exact ⟨ih'.1.trans hin1, ih'.2.1.trans hout1, fun i hiSrc hiDst => + (ih'.2.2 i hiSrc hiDst).trans (hwork1 i hiSrc hiDst)⟩ + +/-- Frame-rich raw-output copy. The input tape, output tape, and unrelated work +tapes are preserved exactly, allowing an arbitrary predicate to be threaded +through the copy. -/ +theorem copyWorkToWorkTM_hoareTime_frame_of_hasOutput_internal {n : ℕ} + (src dst : Fin n) (hne : src ≠ dst) (x : List Bool) (source : Tape) + {P : Tape → (Fin n → Tape) → Tape → Prop} + (hP : ∀ (inp : Tape) (work : Fin n → Tape) (out : Tape) + (inp' : Tape) (work' : Fin n → Tape) (out' : Tape), + P inp work out → + (work' src).cells = source.cells → + (work' src).head = x.length + 1 → + (work' src).HasOutput x → + (work' dst).HasBinaryPrefix x → + (work' dst).cells 0 = Γ.start → + inp' = inp → out' = out → + (∀ i, i ≠ src → i ≠ dst → work' i = work i) → + P inp' work' out') : + (copyWorkToWorkTM src dst).HoareTime + (fun inp work out => + work src = source ∧ source.head = 1 ∧ source.HasOutput x ∧ + work dst = (Tape.init []).move Dir3.right ∧ + inp.read ≠ Γ.start ∧ out.read ≠ Γ.start ∧ 1 ≤ out.head ∧ + (∀ i, i ≠ src → i ≠ dst → + (work i).read ≠ Γ.start ∧ 1 ≤ (work i).head) ∧ + P inp work out) + (fun inp work out => + (work src).cells = source.cells ∧ + (work src).head = x.length + 1 ∧ + (work src).HasOutput x ∧ + (work dst).HasBinaryPrefix x ∧ + (work dst).cells 0 = Γ.start ∧ + P inp work out) + (x.length + 1) := by + intro inp work out hpre + rcases hpre with + ⟨hsrc, hsourceHead, hsourceOutput, hdst, hin, hout, houtHead, hother, hPred⟩ + have hsrcCells0 : (work src).cells = source.cells := by rw [hsrc] + have hsrcHead0 : (work src).head = 1 := by rw [hsrc, hsourceHead] + have hdstPrefix0 : (work dst).HasBinaryPrefix [] := by + rw [hdst] + exact Tape.init_nil_move_right_hasBinaryPrefix_nil + have hdst0Start : (work dst).cells 0 = Γ.start := by rw [hdst]; rfl + obtain ⟨c', hreach, hhalt, hsrcCells, hsrcHead, hsrcOutput, hdstPrefix, + hdst0⟩ := + copyWorkOutput_loop src dst hne x source x.length 0 + { state := CopyPhase.copying, input := inp, work := work, output := out } + Γ.start (by simp) rfl hsrcCells0 hsrcHead0 hsourceOutput hdstPrefix0 + hdst0Start (Nat.zero_le _) + obtain ⟨hinFrame, houtFrame, hworkFrame⟩ := + copyWorkOutput_reachesIn_frame src dst hreach hin hout houtHead hother + refine ⟨c', x.length + 1, le_rfl, hreach, hhalt, hsrcCells, hsrcHead, hsrcOutput, + hdstPrefix, hdst0, ?_⟩ + exact hP inp work out c'.input c'.work c'.output hPred hsrcCells hsrcHead + hsrcOutput hdstPrefix hdst0 hinFrame houtFrame hworkFrame + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/MoveLeftStep.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/MoveLeftStep.lean new file mode 100644 index 0000000000..6bdda4f9a5 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/MoveLeftStep.lean @@ -0,0 +1,110 @@ +/- +Copyright (c) 2026 Bolton Bailey. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Bolton Bailey +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.WipeStep + +/-! +# Moving left unconditionally + +Before scratch tapes can be wiped (`TM.wipeStepTM` scans rightward), every head +needs to be at a *known* position. The `▷` marker at cell `0` is immutable, so +moving left far enough always reaches it whatever the content: +`TM.moveLeftStepTM`, run enough times, is a content-agnostic bulk rewind for a +whole list of tapes, exactly as `TM.wipeStepTM` is a content-agnostic bulk wipe. + +## Main results + +- `TM.moveLeftStepTM` — move every targeted tape one cell left +- `TM.moveLeftStepTM_hoareTime` — its one-step contract +-/ + + +public section + +namespace Complexity + +namespace TM + +/-- Unconditional write-then-move collapses to a pure move whenever the +tape's only possible `▷` is at cell `0` — regardless of whether the head is +currently on it. -/ +theorem writeAndMove_readBack_of_startInvariant (t : Tape) (h : Tape.StartInvariant t) + (d : Dir3) : t.writeAndMove (readBackWrite t.read) d = t.move d := by + by_cases hh : t.head = 0 + · show (t.write _).move d = t.move d + congr 1 + rw [Tape.write, if_pos hh] + · exact writeAndMove_readBack t (h.read_ne_start (by omega)) d + +/-- One unconditional step: every work tape named in `targets` moves left +(bouncing off `▷` via `moveLeftDir`); every other work tape, the input, and +the output are held by `readBackWrite`/`idleDir`. Content is always preserved. -/ +def moveLeftStepTM {n : ℕ} (targets : List (Fin n)) : TM n where + Q := WipeStepPhase + qstart := .running + qhalt := .done + δ := fun state iHead wHeads oHead => + match state with + | .running => + (.done, + fun i => readBackWrite (wHeads i), + readBackWrite oHead, idleDir iHead, + fun i => if i ∈ targets then moveLeftDir (wHeads i) else idleDir (wHeads i), + idleDir oHead) + | .done => allIdle .done iHead wHeads oHead + δ_right_of_start := by + intro state iHead wHeads oHead + match state with + | .running => + refine ⟨idleDir_right_of_start, fun i hi => ?_, idleDir_right_of_start⟩ + dsimp only + split + · exact moveLeftDir_right_of_start hi + · exact idleDir_right_of_start hi + | .done => exact rightOfStart_allIdle iHead wHeads oHead + +/-- **`moveLeftStepTM`'s exact one-step Hoare contract.** Targeted tapes need +only `StartInvariant` (their `▷`, if any, is at cell `0` — true regardless of +current head position); every other work tape, the input, and the output +must be `Parked`. -/ +theorem moveLeftStepTM_hoareTime {n : ℕ} (targets : List (Fin n)) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hinp : Parked inp₀) (hout : Parked out₀) + (htarget : ∀ i, i ∈ targets → Tape.StartInvariant (work₀ i)) + (hother : ∀ i, i ∉ targets → Parked (work₀ i)) : + (moveLeftStepTM targets).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => inp = inp₀ ∧ out = out₀ ∧ + ∀ i, work i = if i ∈ targets then (work₀ i).move (moveLeftDir (work₀ i).read) + else work₀ i) + 1 := by + rintro inp work out ⟨rfl, rfl, rfl⟩ + refine ⟨(⟨WipeStepPhase.done, + inp.move (idleDir inp.read), + (fun i => if i ∈ targets then (work i).move (moveLeftDir (work i).read) + else (work i).writeAndMove (readBackWrite (work i).read) (idleDir (work i).read)), + out.writeAndMove (readBackWrite out.read) (idleDir out.read)⟩ : + Cfg n (moveLeftStepTM targets).Q), + 1, le_refl 1, ?_, rfl, hinp.move_idle, hout.writeAndMove_readBack_idle, fun i => ?_⟩ + · refine TM.reachesIn.step ?_ .zero + simp only [TM.step, moveLeftStepTM, + if_neg (show WipeStepPhase.running ≠ WipeStepPhase.done by decide)] + congr 1 + congr 1 + funext i + by_cases hi : i ∈ targets + · simp only [if_pos hi] + exact writeAndMove_readBack_of_startInvariant (work i) (htarget i hi) _ + · simp only [if_neg hi] + · dsimp only + split + · rfl + · next hi => exact (hother i hi).writeAndMove_readBack_idle + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/PairEmit.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/PairEmit.lean new file mode 100644 index 0000000000..83f6c0eeb1 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/PairEmit.lean @@ -0,0 +1,74 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.PairEmit.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.PairEmit.Internal + +/-! +# Pair emission from the input and a work tape + +The emitter reads a delimited first component from a designated work tape, +doubles its bits, writes the pair separator, and copies the real input as the +second component. + +## Main results + +- `TM.pairInputWorkTM_reachesIn` — exact execution from a concrete tape boundary +- `TM.pairInputWorkTM_hoareTime` — compositional time-bounded contract +-/ + + +public section + +namespace Complexity + +namespace TM + +/-- Exact pair emission preserves the source cells and every unrelated work +tape, consumes both sources through their delimiters, and leaves the output as +an appendable prefix containing the canonical pair. -/ +theorem pairInputWorkTM_reachesIn {n : ℕ} + (firstIdx : Fin n) (first second : List Bool) + {inp out : Tape} {work : Fin n → Tape} + (hinput : inp = (Tape.init (second.map Γ.ofBool)).move Dir3.right) + (hsourceHead : (work firstIdx).head = 1) + (hsourceOutput : (work firstIdx).HasOutput first) + (hwork : ∀ i, (work i).StartInvariant ∧ 1 ≤ (work i).head) + (houtput : out = (Tape.init []).move Dir3.right) : + ∃ c', + (pairInputWorkTM firstIdx).reachesIn (pairInputWorkTime first second) + { state := (pairInputWorkTM firstIdx).qstart, + input := inp, work := work, output := out } c' ∧ + (pairInputWorkTM firstIdx).halted c' ∧ + c'.input.HasBinarySuffix [] ∧ + c'.input.cells = inp.cells ∧ + (c'.work firstIdx).HasBinarySuffix [] ∧ + (c'.work firstIdx).cells = (work firstIdx).cells ∧ + (c'.work firstIdx).HasOutput first ∧ + (∀ i, i ≠ firstIdx → c'.work i = work i) ∧ + c'.output.HasBinaryPrefix (pair first second) := + pairInputWorkTM_reachesIn_internal firstIdx first second hinput + hsourceHead hsourceOutput hwork houtput + +/-- Emit `pair first second` within +`2 * first.length + second.length + 3` steps. -/ +theorem pairInputWorkTM_hoareTime {n : ℕ} + (firstIdx : Fin n) (first second : List Bool) : + (pairInputWorkTM firstIdx).HoareTime + (fun inp work out => + inp = (Tape.init (second.map Γ.ofBool)).move Dir3.right ∧ + (work firstIdx).head = 1 ∧ + (work firstIdx).HasOutput first ∧ + (∀ i, (work i).StartInvariant ∧ 1 ≤ (work i).head) ∧ + out = (Tape.init []).move Dir3.right) + (fun _inp _work out => out.HasOutput (pair first second)) + (pairInputWorkTime first second) := + pairInputWorkTM_hoareTime_internal firstIdx first second + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/PairEmit/Defs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/PairEmit/Defs.lean new file mode 100644 index 0000000000..67703c74af --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/PairEmit/Defs.lean @@ -0,0 +1,135 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators + +/-! +# Pair emission from the input and a work tape + +This file defines a small deterministic transducer that emits `pair first second`. +The first component is scanned on a designated work tape and doubled on the +output; the second component is then copied verbatim from the real input tape. +Both sources are consumed only through their first blank delimiter. + +## Main definitions + +- `TM.PairInputWorkPhase` — the five control phases of the emitter +- `TM.pairInputWorkTM` — emit a pair from one work tape and the input +- `TM.pairInputWorkTime` — the exact running time on canonical sources +-/ + + +@[expose] public section + +namespace Complexity + +namespace TM + +/-- Control phases for `pairInputWorkTM`. `firstAgain bit` remembers the first +component bit while emitting its second copy. -/ +inductive PairInputWorkPhase where + | first + | firstAgain (bit : Bool) + | separator + | second + | done + deriving DecidableEq + +/-- `PairInputWorkPhase` is finite, as required for a Turing-machine state +space. -/ +instance : Fintype PairInputWorkPhase where + elems := {.first, .firstAgain false, .firstAgain true, .separator, .second, .done} + complete := by + intro state + cases state with + | first => simp + | firstAgain bit => cases bit <;> simp + | separator => simp + | second => simp + | done => simp + +/-- Emit `pair first second`, reading `first` from work tape `firstIdx` and +`second` from the real input. Sources begin at cell one and advance to their +first blank delimiters. The output is the fresh empty tape parked at cell one +and is left immediately after the emitted pair, without a rewind. -/ +def pairInputWorkTM {n : ℕ} (firstIdx : Fin n) : TM n where + Q := PairInputWorkPhase + qstart := .first + qhalt := .done + δ := fun state iHead wHeads oHead => + match state with + | .first => + match wHeads firstIdx with + | .zero => + (.firstAgain false, fun i => readBackWrite (wHeads i), .zero, + idleDir iHead, fun i => idleDir (wHeads i), .right) + | .one => + (.firstAgain true, fun i => readBackWrite (wHeads i), .one, + idleDir iHead, fun i => idleDir (wHeads i), .right) + | .blank => + (.separator, fun i => readBackWrite (wHeads i), .zero, + idleDir iHead, fun i => idleDir (wHeads i), .right) + | .start => allIdle .first iHead wHeads oHead + | .firstAgain bit => + (.first, fun i => readBackWrite (wHeads i), Γw.ofBool bit, + idleDir iHead, + fun i => if i = firstIdx then .right else idleDir (wHeads i), + .right) + | .separator => + (.second, fun i => readBackWrite (wHeads i), .one, + idleDir iHead, fun i => idleDir (wHeads i), .right) + | .second => + match iHead with + | .zero => + (.second, fun i => readBackWrite (wHeads i), .zero, + .right, fun i => idleDir (wHeads i), .right) + | .one => + (.second, fun i => readBackWrite (wHeads i), .one, + .right, fun i => idleDir (wHeads i), .right) + | .blank => + (.done, fun i => readBackWrite (wHeads i), readBackWrite oHead, + idleDir iHead, fun i => idleDir (wHeads i), idleDir oHead) + | .start => allIdle .second iHead wHeads oHead + | .done => allIdle .done iHead wHeads oHead + δ_right_of_start := by + intro state iHead wHeads oHead + cases state with + | first => + cases hfirst : wHeads firstIdx + · exact ⟨idleDir_right_of_start, fun _ => idleDir_right_of_start, + fun _ => rfl⟩ + · exact ⟨idleDir_right_of_start, fun _ => idleDir_right_of_start, + fun _ => rfl⟩ + · exact ⟨idleDir_right_of_start, fun _ => idleDir_right_of_start, + fun _ => rfl⟩ + · exact rightOfStart_allIdle iHead wHeads oHead + | firstAgain bit => + refine ⟨idleDir_right_of_start, ?_, fun _ => rfl⟩ + intro i hi + by_cases hidx : i = firstIdx + · simp [hidx] + · simp [hidx, idleDir_right_of_start hi] + | separator => + exact ⟨idleDir_right_of_start, fun _ => idleDir_right_of_start, + fun _ => rfl⟩ + | second => + cases iHead + · exact ⟨fun _ => rfl, fun _ => idleDir_right_of_start, fun _ => rfl⟩ + · exact ⟨fun _ => rfl, fun _ => idleDir_right_of_start, fun _ => rfl⟩ + · exact rightOfStart_allIdle Γ.blank wHeads oHead + · exact rightOfStart_allIdle Γ.start wHeads oHead + | done => exact rightOfStart_allIdle iHead wHeads oHead + +/-- Exact running time of `pairInputWorkTM` on components `first` and +`second`: two steps per first-component bit, two separator steps, one step per +second-component bit, and one final blank-detection step. -/ +def pairInputWorkTime (first second : List Bool) : ℕ := + 2 * first.length + second.length + 3 + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/PairEmit/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/PairEmit/Internal.lean new file mode 100644 index 0000000000..8a891e3268 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/PairEmit/Internal.lean @@ -0,0 +1,348 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Encoding.Pairing +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.Internal.Generic +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Hoare.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.PairEmit.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Tape.Encoding + +/-! +# Pair emission from the input and a work tape — proof internals + +This module verifies the exact two-pass controller in `PairEmit.Defs`. +-/ + + +public section + +namespace Complexity + +namespace TM + +/-- Bits emitted for the first component of the pairing codec. -/ +private def doubled (bits : List Bool) : List Bool := + bits.flatMap fun bit => [bit, bit] + +@[simp] private theorem doubled_cons (bit : Bool) (bits : List Bool) : + doubled (bit :: bits) = bit :: bit :: doubled bits := by + simp [doubled] + +/-- Emit the doubled first component and the two-bit separator. -/ +private theorem pairInputWorkTM_first_loop {n : ℕ} (firstIdx : Fin n) : + ∀ (first emitted : List Bool) + (c : Cfg n (pairInputWorkTM firstIdx).Q), + c.state = PairInputWorkPhase.first → + (c.work firstIdx).HasBinarySuffix first → + c.input.read ≠ Γ.start → + (∀ i, i ≠ firstIdx → (c.work i).read ≠ Γ.start) → + c.output.HasBinaryPrefix emitted → + ∃ c', + (pairInputWorkTM firstIdx).reachesIn (2 * first.length + 2) c c' ∧ + c'.state = PairInputWorkPhase.second ∧ + c'.input = c.input ∧ + (c'.work firstIdx).HasBinarySuffix [] ∧ + (c'.work firstIdx).cells = (c.work firstIdx).cells ∧ + (∀ i, i ≠ firstIdx → c'.work i = c.work i) ∧ + c'.output.HasBinaryPrefix (emitted ++ doubled first ++ [false, true]) := by + intro first + induction first with + | nil => + intro emitted c hstate hsource hinput hother houtput + have hsourceRead : (c.work firstIdx).read = Γ.blank := hsource.read_nil + let c₁ : Cfg n (pairInputWorkTM firstIdx).Q := + { state := PairInputWorkPhase.separator + input := transitionInput c.input + work := fun i => transitionTape (c.work i) + output := c.output.writeAndMove Γ.zero Dir3.right } + have hstep₁ : (pairInputWorkTM firstIdx).step c = some c₁ := by + simp [TM.step, hstate, pairInputWorkTM, hsourceRead, c₁, transitionInput, + transitionTape] + have hinputKeep₁ : c₁.input = c.input := by + simpa [c₁] using transitionInput_eq_self hinput + have hsourceKeep₁ : c₁.work firstIdx = c.work firstIdx := by + simpa [c₁] using transitionTape_eq_self (by rw [hsourceRead]; decide) + have hotherKeep₁ (i) (hi : i ≠ firstIdx) : c₁.work i = c.work i := by + simpa [c₁] using transitionTape_eq_self (hother i hi) + have houtput₁ : c₁.output.HasBinaryPrefix (emitted ++ [false]) := by + simpa [c₁] using Tape.hasBinaryPrefix_write_bit false houtput + let c₂ : Cfg n (pairInputWorkTM firstIdx).Q := + { state := PairInputWorkPhase.second + input := transitionInput c₁.input + work := fun i => transitionTape (c₁.work i) + output := c₁.output.writeAndMove Γ.one Dir3.right } + have hstep₂ : (pairInputWorkTM firstIdx).step c₁ = some c₂ := by + simp [TM.step, c₁, pairInputWorkTM, c₂, transitionInput, transitionTape] + have hinputKeep₂ : c₂.input = c.input := by + have hstable : transitionInput c₁.input = c₁.input := + transitionInput_eq_self (by rw [hinputKeep₁]; exact hinput) + rw [show c₂.input = transitionInput c₁.input by rfl, hstable, + hinputKeep₁] + have hsourceKeep₂ : c₂.work firstIdx = c.work firstIdx := by + have hstable : transitionTape (c₁.work firstIdx) = c₁.work firstIdx := + transitionTape_eq_self (by rw [hsourceKeep₁, hsourceRead]; decide) + rw [show c₂.work firstIdx = transitionTape (c₁.work firstIdx) by rfl, + hstable, hsourceKeep₁] + have hotherKeep₂ (i) (hi : i ≠ firstIdx) : c₂.work i = c.work i := by + have hstable : transitionTape (c₁.work i) = c₁.work i := + transitionTape_eq_self (by rw [hotherKeep₁ i hi]; exact hother i hi) + rw [show c₂.work i = transitionTape (c₁.work i) by rfl, + hstable, hotherKeep₁ i hi] + have houtput₂ : c₂.output.HasBinaryPrefix (emitted ++ [false, true]) := by + have hwrite := Tape.hasBinaryPrefix_write_bit true houtput₁ + simpa [c₂, List.append_assoc] using hwrite + refine ⟨c₂, ?_, rfl, hinputKeep₂, ?_, ?_, hotherKeep₂, ?_⟩ + · simpa using TM.reachesIn.step hstep₁ (TM.reachesIn.step hstep₂ .zero) + · rw [hsourceKeep₂] + exact hsource + · rw [hsourceKeep₂] + · simpa [doubled] using houtput₂ + | cons bit bits ih => + intro emitted c hstate hsource hinput hother houtput + have hsourceRead : (c.work firstIdx).read = Γ.ofBool bit := + hsource.read_cons + let c₁ : Cfg n (pairInputWorkTM firstIdx).Q := + { state := PairInputWorkPhase.firstAgain bit + input := transitionInput c.input + work := fun i => transitionTape (c.work i) + output := c.output.writeAndMove (Γ.ofBool bit) Dir3.right } + have hstep₁ : (pairInputWorkTM firstIdx).step c = some c₁ := by + cases bit <;> + simp [TM.step, hstate, pairInputWorkTM, hsourceRead, c₁, transitionInput, + transitionTape, Γ.ofBool, Γw.toΓ, readBackWrite] + have hinputKeep₁ : c₁.input = c.input := by + simpa [c₁] using transitionInput_eq_self hinput + have hsourceKeep₁ : c₁.work firstIdx = c.work firstIdx := by + simpa [c₁] using transitionTape_eq_self hsource.read_ne_start + have hotherKeep₁ (i) (hi : i ≠ firstIdx) : c₁.work i = c.work i := by + simpa [c₁] using transitionTape_eq_self (hother i hi) + have houtput₁ : c₁.output.HasBinaryPrefix (emitted ++ [bit]) := by + simpa [c₁] using Tape.hasBinaryPrefix_write_bit bit houtput + let c₂ : Cfg n (pairInputWorkTM firstIdx).Q := + { state := PairInputWorkPhase.first + input := transitionInput c₁.input + work := fun i => + (c₁.work i).writeAndMove (readBackWrite (c₁.work i).read) + (if i = firstIdx then Dir3.right else idleDir (c₁.work i).read) + output := c₁.output.writeAndMove (Γ.ofBool bit) Dir3.right } + have hstep₂ : (pairInputWorkTM firstIdx).step c₁ = some c₂ := by + cases bit <;> + simp [TM.step, c₁, pairInputWorkTM, c₂, transitionInput, Γ.ofBool, + Γw.ofBool, Γw.toΓ] + have hinputKeep₂ : c₂.input = c.input := by + have hstable : transitionInput c₁.input = c₁.input := + transitionInput_eq_self (by rw [hinputKeep₁]; exact hinput) + rw [show c₂.input = transitionInput c₁.input by rfl, hstable, + hinputKeep₁] + have hsourceMove : c₂.work firstIdx = (c.work firstIdx).move Dir3.right := by + rw [show c₂.work firstIdx = + (c₁.work firstIdx).writeAndMove (readBackWrite (c₁.work firstIdx).read) + Dir3.right by simp [c₂]] + rw [writeAndMove_readBack _ (by rw [hsourceKeep₁]; exact hsource.read_ne_start)] + rw [hsourceKeep₁] + have hotherKeep₂ (i) (hi : i ≠ firstIdx) : c₂.work i = c.work i := by + have hstable : transitionTape (c₁.work i) = c₁.work i := + transitionTape_eq_self (by rw [hotherKeep₁ i hi]; exact hother i hi) + have hc₂ : c₂.work i = transitionTape (c₁.work i) := by + simp [c₂, hi, transitionTape] + rw [hc₂, hstable, hotherKeep₁ i hi] + have hsource₂ : (c₂.work firstIdx).HasBinarySuffix bits := by + rw [hsourceMove] + exact hsource.move_right_cons + have houtput₂ : c₂.output.HasBinaryPrefix (emitted ++ [bit, bit]) := by + have hwrite := Tape.hasBinaryPrefix_write_bit bit houtput₁ + simpa [c₂, List.append_assoc] using hwrite + obtain ⟨c', hreach, hstate', hinput', hsource', hsourceCells', hother', + houtput'⟩ := + ih (emitted ++ [bit, bit]) c₂ rfl hsource₂ + (by rw [hinputKeep₂]; exact hinput) + (by intro i hi + rw [hotherKeep₂ i hi] + exact hother i hi) + houtput₂ + refine ⟨c', ?_, hstate', ?_, hsource', ?_, ?_, ?_⟩ + · simpa using TM.reachesIn.step hstep₁ (TM.reachesIn.step hstep₂ hreach) + · exact hinput'.trans hinputKeep₂ + · rw [hsourceCells', hsourceMove, Tape.move_cells] + · intro i hi + exact (hother' i hi).trans (hotherKeep₂ i hi) + · simpa [List.append_assoc] using houtput' + +/-- Copy the second component verbatim and halt at its delimiter. -/ +private theorem pairInputWorkTM_second_loop {n : ℕ} (firstIdx : Fin n) : + ∀ (second emitted : List Bool) + (c : Cfg n (pairInputWorkTM firstIdx).Q), + c.state = PairInputWorkPhase.second → + c.input.HasBinarySuffix second → + (∀ i, (c.work i).read ≠ Γ.start) → + c.output.HasBinaryPrefix emitted → + ∃ c', + (pairInputWorkTM firstIdx).reachesIn (second.length + 1) c c' ∧ + (pairInputWorkTM firstIdx).halted c' ∧ + c'.input.HasBinarySuffix [] ∧ + c'.input.cells = c.input.cells ∧ + c'.work = c.work ∧ + c'.output.HasBinaryPrefix (emitted ++ second) := by + intro second + induction second with + | nil => + intro emitted c hstate hinput hwork houtput + have hinputRead : c.input.read = Γ.blank := hinput.read_nil + have houtputRead : c.output.read = Γ.blank := houtput.read_blank + let c' : Cfg n (pairInputWorkTM firstIdx).Q := + { state := PairInputWorkPhase.done + input := transitionInput c.input + work := fun i => transitionTape (c.work i) + output := transitionTape c.output } + have hstep : (pairInputWorkTM firstIdx).step c = some c' := by + simp [TM.step, hstate, pairInputWorkTM, hinputRead, c', transitionInput, + transitionTape] + have hinputKeep : c'.input = c.input := by + simpa [c'] using transitionInput_eq_self (by rw [hinputRead]; decide) + have hworkKeep : c'.work = c.work := by + funext i + simpa [c'] using transitionTape_eq_self (hwork i) + have houtputKeep : c'.output = c.output := by + simpa [c'] using transitionTape_eq_self (by rw [houtputRead]; decide) + refine ⟨c', .step hstep .zero, rfl, ?_, ?_, hworkKeep, ?_⟩ + · rw [hinputKeep] + exact hinput + · rw [hinputKeep] + · simpa [houtputKeep] using houtput + | cons bit bits ih => + intro emitted c hstate hinput hwork houtput + have hinputRead : c.input.read = Γ.ofBool bit := hinput.read_cons + let c₁ : Cfg n (pairInputWorkTM firstIdx).Q := + { state := PairInputWorkPhase.second + input := c.input.move Dir3.right + work := fun i => transitionTape (c.work i) + output := c.output.writeAndMove (Γ.ofBool bit) Dir3.right } + have hstep : (pairInputWorkTM firstIdx).step c = some c₁ := by + cases bit <;> + simp [TM.step, hstate, pairInputWorkTM, hinputRead, c₁, transitionTape, + Γ.ofBool, Γw.toΓ, readBackWrite] + have hinput₁ : c₁.input.HasBinarySuffix bits := by + simpa [c₁] using hinput.move_right_cons + have hworkKeep : c₁.work = c.work := by + funext i + simpa [c₁] using transitionTape_eq_self (hwork i) + have hwork₁ (i) : (c₁.work i).read ≠ Γ.start := by + rw [hworkKeep] + exact hwork i + have houtput₁ : c₁.output.HasBinaryPrefix (emitted ++ [bit]) := by + simpa [c₁] using Tape.hasBinaryPrefix_write_bit bit houtput + obtain ⟨c', hreach, hhalt, hinput', hinputCells', hwork', houtput'⟩ := + ih (emitted ++ [bit]) c₁ rfl hinput₁ hwork₁ houtput₁ + refine ⟨c', ?_, hhalt, hinput', ?_, ?_, ?_⟩ + · simpa using TM.reachesIn.step hstep hreach + · rw [hinputCells'] + simpa [c₁] using Tape.move_cells c.input Dir3.right + · exact hwork'.trans hworkKeep + · simpa [List.append_assoc] using houtput' + +/-- Exact execution from the concrete tape boundary used by the generic +fanout combinator. -/ +theorem pairInputWorkTM_reachesIn_internal {n : ℕ} + (firstIdx : Fin n) (first second : List Bool) + {inp out : Tape} {work : Fin n → Tape} + (hinput : inp = (Tape.init (second.map Γ.ofBool)).move Dir3.right) + (hsourceHead : (work firstIdx).head = 1) + (hsourceOutput : (work firstIdx).HasOutput first) + (hwork : ∀ i, (work i).StartInvariant ∧ 1 ≤ (work i).head) + (houtput : out = (Tape.init []).move Dir3.right) : + ∃ c', + (pairInputWorkTM firstIdx).reachesIn (pairInputWorkTime first second) + { state := (pairInputWorkTM firstIdx).qstart, + input := inp, work := work, output := out } c' ∧ + (pairInputWorkTM firstIdx).halted c' ∧ + c'.input.HasBinarySuffix [] ∧ + c'.input.cells = inp.cells ∧ + (c'.work firstIdx).HasBinarySuffix [] ∧ + (c'.work firstIdx).cells = (work firstIdx).cells ∧ + (c'.work firstIdx).HasOutput first ∧ + (∀ i, i ≠ firstIdx → c'.work i = work i) ∧ + c'.output.HasBinaryPrefix (pair first second) := by + have hsourceSuffix : (work firstIdx).HasBinarySuffix first := + hsourceOutput.hasBinarySuffix hsourceHead (hwork firstIdx).1 + let c₀ : Cfg n (pairInputWorkTM firstIdx).Q := + { state := (pairInputWorkTM firstIdx).qstart, + input := inp, work := work, output := out } + obtain ⟨c₁, hreach₁, hstate₁, hinput₁, hsource₁, hsourceCells₁, + hother₁, houtput₁⟩ := + pairInputWorkTM_first_loop firstIdx first [] c₀ rfl + (by simpa [c₀] using hsourceSuffix) + (by rw [show c₀.input = inp by rfl, hinput] + exact Tape.init_ofBool_move_right_read_ne_start second) + (by + intro i hi + show (work i).cells (work i).head ≠ Γ.start + exact (hwork i).1.2 (work i).head (hwork i).2) + (by rw [show c₀.output = out by rfl, houtput] + exact Tape.init_nil_move_right_hasBinaryPrefix_nil) + have hinputSuffix₁ : c₁.input.HasBinarySuffix second := by + rw [hinput₁] + change inp.HasBinarySuffix second + rw [hinput] + exact Tape.init_move_right_hasBinarySuffix second + have hworkRead₁ : ∀ i, (c₁.work i).read ≠ Γ.start := by + intro i + by_cases hi : i = firstIdx + · subst i + exact hsource₁.read_ne_start + · rw [hother₁ i hi] + show (work i).cells (work i).head ≠ Γ.start + exact (hwork i).1.2 (work i).head (hwork i).2 + obtain ⟨c₂, hreach₂, hhalt₂, hinput₂, hinputCells₂, hwork₂, + houtput₂⟩ := + pairInputWorkTM_second_loop firstIdx second + (doubled first ++ [false, true]) c₁ hstate₁ hinputSuffix₁ + hworkRead₁ (by simpa using houtput₁) + refine ⟨c₂, ?_, hhalt₂, hinput₂, ?_, ?_, ?_, ?_, ?_, ?_⟩ + · have htime : 2 * first.length + 2 + (second.length + 1) = + pairInputWorkTime first second := by + simp only [pairInputWorkTime] + omega + rw [← htime] + simpa only [c₀] using + reachesIn_trans (pairInputWorkTM firstIdx) hreach₁ hreach₂ + · rw [hinputCells₂, hinput₁] + · rw [hwork₂] + exact hsource₁ + · rw [hwork₂] + exact hsourceCells₁ + · apply (Tape.hasOutput_congr ?_ first).mpr hsourceOutput + rw [hwork₂] + exact hsourceCells₁ + · intro i hi + rw [hwork₂] + exact hother₁ i hi + · simpa [pair, delimit, doubled, List.append_assoc] using houtput₂ + +/-- Internal compact Hoare contract for pair emission. -/ +theorem pairInputWorkTM_hoareTime_internal {n : ℕ} + (firstIdx : Fin n) (first second : List Bool) : + (pairInputWorkTM firstIdx).HoareTime + (fun inp work out => + inp = (Tape.init (second.map Γ.ofBool)).move Dir3.right ∧ + (work firstIdx).head = 1 ∧ + (work firstIdx).HasOutput first ∧ + (∀ i, (work i).StartInvariant ∧ 1 ≤ (work i).head) ∧ + out = (Tape.init []).move Dir3.right) + (fun _inp _work out => out.HasOutput (pair first second)) + (pairInputWorkTime first second) := by + intro inp work out hpre + rcases hpre with ⟨hinput, hsourceHead, hsourceOutput, hwork, houtput⟩ + obtain ⟨c', hreach, hhalt, _hinput, _hinputCells, _hsource, + _hsourceCells, _hsourceOutput, _hother, hprefix⟩ := + pairInputWorkTM_reachesIn_internal firstIdx first second hinput + hsourceHead hsourceOutput hwork houtput + exact ⟨c', pairInputWorkTime first second, le_rfl, hreach, hhalt, + hprefix.hasOutput⟩ + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/PairValidate.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/PairValidate.lean new file mode 100644 index 0000000000..fcb655cb37 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/PairValidate.lean @@ -0,0 +1,104 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Lift +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Hoare +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.PairValidate.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.PairValidate.Internal + +/-! +# Validate paired machine inputs + +`pairValidateTM` is a total finite-state recognizer for the image of the +library's self-delimiting `pair` codec. It rejects every malformed outer input +and runs in exactly the generic scanner budget `n + 2`. + +This complements `pairSplitCoreTM`: validate first when arbitrary input strings +need rejecting semantics, then rewind and use the canonical splitter to stage +the two decoded components. +-/ + + +public section + +namespace Complexity + +/-- Decoder-facing characterization of membership in `validPairEncoding`. -/ +theorem mem_validPairEncoding_iff (bits : List Bool) : + bits ∈ validPairEncoding ↔ (unpair? bits).isSome = true := + Iff.rfl + +/-- Extensional characterization: valid encodings are exactly canonical +encodings of some pair of Boolean strings. -/ +theorem mem_validPairEncoding_iff_exists_pair (bits : List Bool) : + bits ∈ validPairEncoding ↔ ∃ x y, bits = pair x y := by + constructor + · intro hmem + change (unpair? bits).isSome = true at hmem + cases hdecode : unpair? bits with + | none => simp [hdecode] at hmem + | some decoded => + obtain ⟨x, y⟩ := decoded + exact ⟨x, y, eq_pair_of_unpair?_eq_some hdecode⟩ + · rintro ⟨x, y, rfl⟩ + simp [validPairEncoding] + +/-- Failure of the partial decoder is exactly nonmembership in the valid-pair +language. -/ +theorem not_mem_validPairEncoding_iff (bits : List Bool) : + bits ∉ validPairEncoding ↔ unpair? bits = none := by + cases hdecode : unpair? bits <;> simp [validPairEncoding, hdecode] + +/-- Every canonical `pair` is a valid pair encoding. -/ +@[simp] theorem pair_mem_validPairEncoding (x y : List Bool) : + pair x y ∈ validPairEncoding := by + simp [validPairEncoding] + +namespace TM + +/-- The pair-validator fold accepts exactly when the canonical decoder succeeds. -/ +theorem pairValidateAccept_fold_eq_true_iff (bits : List Bool) : + pairValidateAccept (bits.foldl pairValidateStep .next) = true ↔ + (unpair? bits).isSome = true := + pairValidateAccept_fold_eq_true_iff_internal bits + +/-- The finite-state pair validator decides `validPairEncoding` in linear time. -/ +theorem pairValidateTM_decidesInTime : + pairValidateTM.DecidesInTime validPairEncoding (fun n => n + 2) := + pairValidateTM_decidesInTime_internal + +/-- Adding arbitrary unused work tapes preserves the validator's language and +exact linear time bound. This is the form used by larger machine pipelines. -/ +theorem pairValidateTM_lift_decidesInTime (workTapes : ℕ) : + (pairValidateTM.liftTM workTapes).DecidesInTime + validPairEncoding (fun n => n + 2) := + liftTM_decidesInTime pairValidateTM workTapes pairValidateTM_decidesInTime + +/-- Frame-rich initialized specification for the lifted validator. Besides the +verdict, it exposes the read-only input cells, head bounds, well-formedness of +all tapes, and the fact that every added work tape is parked and blank. These +are the seams needed by `ifTM` and a subsequent input rewind. -/ +theorem pairValidateTM_lift_hoareTime (workTapes : ℕ) (bits : List Bool) : + (pairValidateTM.liftTM workTapes).HoareTime + (fun inp work out => + inp = Tape.init (bits.map Γ.ofBool) ∧ + work = (fun _ => Tape.init []) ∧ + out = Tape.init []) + (fun inp work out => + AllTapesWF inp work out ∧ + inp.cells = (Tape.init (bits.map Γ.ofBool)).cells ∧ + inp.head ≤ bits.length + 2 ∧ + (∀ i, work i = (Tape.init []).move Dir3.right) ∧ + out.head ≤ bits.length + 2 ∧ + (bits ∈ validPairEncoding → out.cells 1 = Γ.one) ∧ + (bits ∉ validPairEncoding → out.cells 1 = Γ.zero)) + (bits.length + 2) := + pairValidateTM_lift_hoareTime_internal workTapes bits + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/PairValidate/Defs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/PairValidate/Defs.lean new file mode 100644 index 0000000000..4c05bd2841 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/PairValidate/Defs.lean @@ -0,0 +1,79 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Encoding.Pairing +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators + +/-! +# Pair-encoding validator — definitions + +This file defines a finite-state scanner for the image of the library's +self-delimiting binary `pair` codec. Unlike `pairSplitCoreTM`, the validator +has total semantics: it writes `1` exactly when `unpair?` succeeds and writes +`0` on every malformed encoding. +-/ + + +@[expose] public section + +namespace Complexity + +/-- The language of strings on which the canonical pair decoder succeeds. -/ +def validPairEncoding : Language := + {z | (unpair? z).isSome = true} + +namespace TM + +/-- Finite control for recognizing the doubled prefix and `01` separator of a +pair encoding. Once the separator has been seen, every remaining bit belongs +to the unrestricted right component. -/ +inductive PairValidateState where + /-- Expect the first copy of the next doubled bit. -/ + | next + /-- The first copy was `0`; `0` continues the prefix and `1` is the separator. -/ + | afterZero + /-- The first copy was `1`; only a second `1` is valid. -/ + | afterOne + /-- The separator has been seen; the remaining suffix is unrestricted. -/ + | suffix + /-- A mismatched doubled bit was seen. -/ + | invalid + deriving DecidableEq + +instance : Fintype PairValidateState where + elems := {.next, .afterZero, .afterOne, .suffix, .invalid} + complete := by + intro state + cases state <;> simp + +/-- One automaton step for the pair-encoding validator. -/ +def pairValidateStep : PairValidateState → Bool → PairValidateState + | .next, false => .afterZero + | .next, true => .afterOne + | .afterZero, false => .next + | .afterZero, true => .suffix + | .afterOne, false => .invalid + | .afterOne, true => .next + | .suffix, _ => .suffix + | .invalid, _ => .invalid + +/-- The scanner accepts exactly after it has seen the pair separator. -/ +def pairValidateAccept : PairValidateState → Bool + | .suffix => true + | _ => false + +/-- A total, zero-work-tape validator for the image of `pair`. + +The generic scanner consumes the whole input, folds `pairValidateStep` in +finite control, and writes the final Boolean verdict to output cell `1`. -/ +def pairValidateTM : TM 0 := + scannerTM .next pairValidateStep + (fun state => if pairValidateAccept state then .one else .zero) + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/PairValidate/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/PairValidate/Internal.lean new file mode 100644 index 0000000000..8eaa5b6a16 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/PairValidate/Internal.lean @@ -0,0 +1,152 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.Internal.Scanner +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Hoare +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Lift +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.PairValidate.Defs + +/-! +# Pair-encoding validator — proof internals + +The finite-state fold is related to `unpair?`, then the generic scanner +correctness theorem supplies the executable machine proof and exact time bound. +-/ + + +public section + +namespace Complexity + +namespace TM + +/-- Semantic meaning of a validator state with a yet-unread suffix. The three +prefix states reconstruct the pending decoder input; the absorbing states have +fixedValue verdicts. -/ +private def pairValidateSuffix : PairValidateState → List Bool → Bool + | .next, bits => (unpair? bits).isSome + | .afterZero, bits => (unpair? (false :: bits)).isSome + | .afterOne, bits => (unpair? (true :: bits)).isSome + | .suffix, _ => true + | .invalid, _ => false + +/-- Folding the validator over a suffix produces exactly the semantic verdict +associated with the incoming control state. -/ +private theorem pairValidate_fold_correct (state : PairValidateState) (bits : List Bool) : + pairValidateAccept (bits.foldl pairValidateStep state) = + pairValidateSuffix state bits := by + induction bits generalizing state with + | nil => + cases state <;> simp [pairValidateAccept, pairValidateSuffix, unpair?] + | cons bit bits ih => + rw [List.foldl_cons, ih] + cases state <;> cases bit <;> + simp [pairValidateStep, pairValidateSuffix, unpair?] + +/-- The pair-validator fold accepts exactly when `unpair?` succeeds. -/ +theorem pairValidateAccept_fold_eq_true_iff_internal (bits : List Bool) : + pairValidateAccept (bits.foldl pairValidateStep .next) = true ↔ + (unpair? bits).isSome = true := by + rw [pairValidate_fold_correct] + rfl + +/-- The finite-state pair validator decides all well-formed pair encodings in +the generic scanner's exact `n + 2` time bound. -/ +theorem pairValidateTM_decidesInTime_internal : + pairValidateTM.DecidesInTime validPairEncoding (fun n => n + 2) := by + apply scannerTM_decidesInTime .next pairValidateStep pairValidateAccept + intro bits + change (unpair? bits).isSome = true ↔ + pairValidateAccept (bits.foldl pairValidateStep .next) = true + exact (pairValidateAccept_fold_eq_true_iff_internal bits).symm + +/-- Frame-rich initialized specification for the lifted validator. -/ +theorem pairValidateTM_lift_hoareTime_internal (workTapes : ℕ) (bits : List Bool) : + (pairValidateTM.liftTM workTapes).HoareTime + (fun inp work out => + inp = Tape.init (bits.map Γ.ofBool) ∧ + work = (fun _ => Tape.init []) ∧ + out = Tape.init []) + (fun inp work out => + AllTapesWF inp work out ∧ + inp.cells = (Tape.init (bits.map Γ.ofBool)).cells ∧ + inp.head ≤ bits.length + 2 ∧ + (∀ i, work i = (Tape.init []).move Dir3.right) ∧ + out.head ≤ bits.length + 2 ∧ + (bits ∈ validPairEncoding → out.cells 1 = Γ.one) ∧ + (bits ∉ validPairEncoding → out.cells 1 = Γ.zero)) + (bits.length + 2) := by + rintro inp work out ⟨rfl, rfl, rfl⟩ + obtain ⟨c', hreach, hhalt, hout⟩ := + scannerTM_reachesIn .next pairValidateStep + (fun state => if pairValidateAccept state then .one else .zero) bits + let C := pairValidateTM.liftCfg workTapes c' + have hreachLift : + (pairValidateTM.liftTM workTapes).reachesIn (bits.length + 2) + ((pairValidateTM.liftTM workTapes).initCfg bits) C := by + exact liftTM_reachesIn_initCfg_of_pos pairValidateTM workTapes bits + (by omega) hreach + have hinputCells : + c'.input.cells = (Tape.init (bits.map Γ.ofBool)).cells := + input_cells_eq_of_reachesIn hreach + have hheads := head_le_of_reachesIn pairValidateTM hreach + have hwork : ∀ i, C.work i = (Tape.init []).move Dir3.right := by + intro i + exact liftCfg_work_ge pairValidateTM workTapes c' i (by omega) + have houtput0 : c'.output.cells 0 = Γ.start := + output_cells_zero_eq_start_of_reachesIn hreach rfl + have houtputNoStart : ∀ j, j ≥ 1 → c'.output.cells j ≠ Γ.start := + output_cells_ne_start_of_reachesIn hreach (by + intro j hj + cases j with + | zero => omega + | succ j => simp [Tape.init]) + have hwf : AllTapesWF C.input C.work C.output := by + refine ⟨?_, ?_, ?_, ?_, ?_, ?_⟩ + · rw [liftCfg_input, hinputCells] + rfl + · intro j hj + rw [liftCfg_input, hinputCells] + exact Tape.init_ofBool_cells_ne_start bits j hj + · intro i + rw [hwork i] + rfl + · intro i j hj + rw [hwork i] + cases j with + | zero => omega + | succ j => simp [Tape.move, Tape.init] + · simpa only [liftCfg_output] using houtput0 + · simpa only [liftCfg_output] using houtputNoStart + have hyes : bits ∈ validPairEncoding → C.output.cells 1 = Γ.one := by + intro hmem + rw [show C.output = c'.output from rfl, hout] + have haccept : + pairValidateAccept (bits.foldl pairValidateStep .next) = true := + (pairValidateAccept_fold_eq_true_iff_internal bits).2 hmem + simp [haccept] + have hno : bits ∉ validPairEncoding → C.output.cells 1 = Γ.zero := by + intro hmem + rw [show C.output = c'.output from rfl, hout] + have haccept : + pairValidateAccept (bits.foldl pairValidateStep .next) = false := by + cases hstate : pairValidateAccept (bits.foldl pairValidateStep .next) with + | false => rfl + | true => + exact absurd + ((pairValidateAccept_fold_eq_true_iff_internal bits).1 hstate) hmem + simp [haccept] + refine ⟨C, bits.length + 2, le_rfl, hreachLift, ?_, hwf, ?_, ?_, hwork, ?_, + hyes, hno⟩ + · exact hhalt + · exact hinputCells + · exact hheads.1 + · exact hheads.2.1 + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/ParkAll.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/ParkAll.lean new file mode 100644 index 0000000000..d308187966 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/ParkAll.lean @@ -0,0 +1,88 @@ +/- +Copyright (c) 2026 Bolton Bailey. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Bolton Bailey +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Registers.RegisterOps +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.MoveLeftStep + +/-! +# Parking every tape at once + +Rewinding tapes one at a time needs every tape *not* being rewound to be +`Parked` already — a tape still reading `▷` would bounce to cell `1` as a side +effect. One `TM.skipTM` step with no target achieves that uniformly: from +`Tape.StartInvariant` alone, cell-`0` tapes bounce to cell `1` and parked tapes +stay put. + +## Main results + +- `TM.parkAll_hoareTime` — one step parks every tape +-/ + + +public section + +namespace Complexity + +namespace TM + +/-- One idle step on a `StartInvariant` tape is exactly a bounce off `▷` if it +was there, and otherwise a no-op: the resulting head is `max t.head 1`. -/ +theorem move_idleDir_eq_of_startInvariant {t : Tape} (h : Tape.StartInvariant t) : + t.move (idleDir t.read) = ⟨max t.head 1, t.cells⟩ := by + by_cases hh : t.read = Γ.start + · have hh0 : t.head = 0 := by + by_contra hc + exact (h.2 t.head (by omega)) hh + rw [idleDir, if_pos hh] + refine Tape.ext ?_ (Tape.move_cells t Dir3.right) + show t.head + 1 = max t.head 1 + omega + · have hh0 : t.head ≠ 0 := fun hc => hh (by rw [Tape.read, hc]; exact h.1) + rw [idleDir, if_neg hh] + show t = ⟨max t.head 1, t.cells⟩ + have : max t.head 1 = t.head := by omega + rw [this] + +/-- One idle step parks a `StartInvariant` tape: bounces it off `▷` if it was +there, and otherwise leaves it exactly as it was. -/ +theorem parked_move_idleDir_of_startInvariant {t : Tape} (h : Tape.StartInvariant t) : + Parked (t.move (idleDir t.read)) ∧ (t.move (idleDir t.read)).cells = t.cells := by + rw [move_idleDir_eq_of_startInvariant h] + exact ⟨⟨le_max_right _ _, fun j hj => h.2 j hj⟩, rfl⟩ + +/-- **Parking every tape at once.** From tapes satisfying only +`StartInvariant`, one `skipTM` step brings every one of them to `Parked`, +preserving all cell contents exactly. -/ +theorem parkAll_hoareTime {n : ℕ} (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hinp : Tape.StartInvariant inp₀) (hwork : ∀ i, Tape.StartInvariant (work₀ i)) + (hout : Tape.StartInvariant out₀) : + (skipTM (n := n)).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => inp = (⟨max inp₀.head 1, inp₀.cells⟩ : Tape) ∧ + (∀ i, work i = (⟨max (work₀ i).head 1, (work₀ i).cells⟩ : Tape)) ∧ + out = (⟨max out₀.head 1, out₀.cells⟩ : Tape)) + 1 := by + rintro inp work out ⟨rfl, rfl, rfl⟩ + refine ⟨⟨(skipTM (n := n)).qhalt, + inp.move (idleDir inp.read), + fun i => (work i).move (idleDir (work i).read), + out.move (idleDir out.read)⟩, + 1, le_refl 1, ?_, rfl, ?_, ?_, ?_⟩ + · refine TM.reachesIn.step ?_ .zero + simp only [TM.step, skipTM, + if_neg (show BumpPhase.go ≠ BumpPhase.done by decide), + writeAndMove_readBack_of_startInvariant out hout] + congr 2 + funext i + exact writeAndMove_readBack_of_startInvariant (work i) (hwork i) _ + · exact move_idleDir_eq_of_startInvariant hinp + · exact fun i => move_idleDir_eq_of_startInvariant (hwork i) + · exact move_idleDir_eq_of_startInvariant hout + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/ResetBinary.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/ResetBinary.lean new file mode 100644 index 0000000000..514c4bec00 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/ResetBinary.lean @@ -0,0 +1,88 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.ClearWork +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.ResetBinary.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.ResetBinary.Internal + +/-! +# Resetting a binary work tape + +This module exposes the framed time and space contracts for rewinding an +arbitrary canonical binary cursor and clearing it to the standard blank tape. +-/ + + +public section + +namespace Complexity + +namespace TM + +/-- Rewind canonical binary contents to cell one while preserving the complete +external tape frame. -/ +theorem rewindBinaryWorkTM_hoareTime_frame {n : ℕ} + (idx : Fin n) (bits : List Bool) (headBound : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (htarget : (work₀ idx).HasBinaryContent bits) + (htargetStart : (work₀ idx).cells 0 = Γ.start) + (htargetHead : 1 ≤ (work₀ idx).head ∧ (work₀ idx).head ≤ headBound) + (hinput : Parked inp₀) + (hother : ∀ i, i ≠ idx → Parked (work₀ i)) + (houtput : Parked out₀) : + (rewindWorkTM idx).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + work idx = (Tape.init (bits.map Γ.ofBool)).move Dir3.right ∧ + (∀ i, i ≠ idx → work i = work₀ i) ∧ + out = out₀) + (headBound + 2) := + rewindBinaryWorkTM_hoareTime_frame_internal idx bits headBound inp₀ work₀ + out₀ htarget htargetStart htargetHead hinput hother houtput + +/-- Rewind and clear canonical binary contents while preserving the complete +external tape frame. -/ +theorem resetBinaryWorkTM_hoareTime_frame {n : ℕ} + (idx : Fin n) (bits : List Bool) (headBound : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (htarget : (work₀ idx).HasBinaryContent bits) + (htargetStart : (work₀ idx).cells 0 = Γ.start) + (htargetHead : 1 ≤ (work₀ idx).head ∧ (work₀ idx).head ≤ headBound) + (hinput : Parked inp₀) + (hother : ∀ i, i ≠ idx → Parked (work₀ i)) + (houtput : Parked out₀) : + (resetBinaryWorkTM idx).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + work = Function.update work₀ idx ((Tape.init []).move Dir3.right) ∧ + out = out₀) + (resetBinaryWorkTime headBound bits.length) := + resetBinaryWorkTM_hoareTime_frame_internal idx bits headBound inp₀ work₀ out₀ + htarget htargetStart htargetHead hinput hother houtput + +/-- Coarse all-prefix auxiliary-space envelope for binary reset. -/ +theorem resetBinaryWorkTM_prefix_withinAuxSpace {n : ℕ} + (idx : Fin n) (headBound bitLength inputLength initialSpace time : ℕ) + (start current : Cfg n (resetBinaryWorkTM idx).Q) + (hinitial : start.WithinAuxSpace inputLength initialSpace) + (hreach : (resetBinaryWorkTM idx).reachesIn time start current) + (htime : time ≤ resetBinaryWorkTime headBound bitLength) : + current.WithinAuxSpace inputLength + (initialSpace + resetBinaryWorkTime headBound bitLength) := + (hinitial.reachesIn hreach).mono le_rfl (by omega) + +/-- Binary reset preserves one-way output safety. -/ +theorem resetBinaryWorkTM_isTransducer {n : ℕ} (idx : Fin n) : + (resetBinaryWorkTM idx).IsTransducer := by + unfold resetBinaryWorkTM + exact (rewindWorkTM_isTransducer idx).seqTM (clearWorkTM_isTransducer idx) + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/ResetBinary/Defs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/ResetBinary/Defs.lean new file mode 100644 index 0000000000..779c3da812 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/ResetBinary/Defs.lean @@ -0,0 +1,36 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.ClearWork.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines + +/-! +# Resetting a binary work tape — definitions + +`resetBinaryWorkTM` first rewinds an arbitrary cursor over canonical binary +contents and then clears the resulting completed string to the standard blank +work tape. +-/ + + +@[expose] public section + +namespace Complexity + +namespace TM + +/-- Rewind and clear one canonical binary work tape. -/ +def resetBinaryWorkTM {n : ℕ} (idx : Fin n) : TM n := + seqTM (rewindWorkTM idx) (clearWorkTM idx) + +/-- Time bound in terms of the initial head bound and represented bit length. -/ +def resetBinaryWorkTime (headBound bitLength : ℕ) : ℕ := + headBound + 2 + 1 + clearWorkTimeBound bitLength + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/ResetBinary/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/ResetBinary/Internal.lean new file mode 100644 index 0000000000..6c520e8659 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/ResetBinary/Internal.lean @@ -0,0 +1,159 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Registers +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.ResetBinary.Defs + +/-! +# Resetting a binary work tape — proof internals +-/ + + +public section + +namespace Complexity + +namespace TM + +theorem rewindBinaryWorkTM_hoareTime_frame_internal {n : ℕ} + (idx : Fin n) (bits : List Bool) (headBound : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (htarget : (work₀ idx).HasBinaryContent bits) + (htargetStart : (work₀ idx).cells 0 = Γ.start) + (htargetHead : 1 ≤ (work₀ idx).head ∧ (work₀ idx).head ≤ headBound) + (hinput : Parked inp₀) + (hother : ∀ i, i ≠ idx → Parked (work₀ i)) + (houtput : Parked out₀) : + (rewindWorkTM idx).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + work idx = (Tape.init (bits.map Γ.ofBool)).move Dir3.right ∧ + (∀ i, i ≠ idx → work i = work₀ i) ∧ + out = out₀) + (headBound + 2) := by + let RewindFrame : TapePred n := fun inp work out => + inp = inp₀ ∧ + (work idx).HasBinaryContent bits ∧ + (work idx).cells 0 = Γ.start ∧ + (∀ i, i ≠ idx → work i = work₀ i) ∧ + out = out₀ + have hrewindBase := rewindWorkTM_hoareTime_frame idx headBound + (P := RewindFrame) (by + intro inp work out inp' work' out' hframe hcells _hhead hwork hinp + houtCells houtHead + rcases hframe with ⟨hframeInput, hframeContent, hframeStart, + hframeOther, hframeOutput⟩ + refine ⟨hinp.trans hframeInput, ?_, ?_, ?_, ?_⟩ + · simpa only [Tape.HasBinaryContent, hcells] using hframeContent + · rw [hcells] + exact hframeStart + · intro i hi + exact (hwork i hi).trans (hframeOther i hi) + · exact (Tape.ext houtHead houtCells).trans hframeOutput) + apply hrewindBase.consequence (b' := headBound + 2) + · rintro inp work out ⟨rfl, rfl, rfl⟩ + refine ⟨htargetStart, htarget.cells_ne_start, htargetHead.2, + hinput.read_ne_start, houtput.read_ne_start, houtput.1, ?_, + rfl, htarget, htargetStart, (fun _ _ => rfl), rfl⟩ + intro i hi + exact ⟨(hother i hi).read_ne_start, (hother i hi).1⟩ + · intro inp work out hpost + rcases hpost with ⟨hhead, hframeInput, hcontent, hstart, + hframeOther, hframeOutput⟩ + refine ⟨hframeInput, ?_, hframeOther, hframeOutput⟩ + exact Tape.eq_init_move_right_of_hasBinaryString + (hcontent.hasBinaryString hhead) hstart + · exact le_rfl + +theorem resetBinaryWorkTM_hoareTime_frame_internal {n : ℕ} + (idx : Fin n) (bits : List Bool) (headBound : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (htarget : (work₀ idx).HasBinaryContent bits) + (htargetStart : (work₀ idx).cells 0 = Γ.start) + (htargetHead : 1 ≤ (work₀ idx).head ∧ (work₀ idx).head ≤ headBound) + (hinput : Parked inp₀) + (hother : ∀ i, i ≠ idx → Parked (work₀ i)) + (houtput : Parked out₀) : + (resetBinaryWorkTM idx).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + work = Function.update work₀ idx ((Tape.init []).move Dir3.right) ∧ + out = out₀) + (resetBinaryWorkTime headBound bits.length) := by + have hrewind := rewindBinaryWorkTM_hoareTime_frame_internal idx bits + headBound inp₀ work₀ out₀ htarget htargetStart htargetHead hinput + hother houtput + let ClearFrame : TapePred n := fun inp work out => + inp = inp₀ ∧ (∀ i, i ≠ idx → work i = work₀ i) ∧ out = out₀ + have hclear := clearWorkTM_hoareTime_frame_of_binaryString idx bits + (P := ClearFrame) (by + intro inp work out inp' work' out' hframe _htarget hinp hout hwork + rcases hframe with ⟨hframeInput, hframeOther, hframeOutput⟩ + exact ⟨hinp.trans hframeInput, fun i hi => + (hwork i hi).trans (hframeOther i hi), hout.trans hframeOutput⟩) + have hclear' : (clearWorkTM idx).HoareTime + (fun inp work out => + inp = inp₀ ∧ + work idx = (Tape.init (bits.map Γ.ofBool)).move Dir3.right ∧ + (∀ i, i ≠ idx → work i = work₀ i) ∧ + out = out₀) + (fun inp work out => + inp = inp₀ ∧ + work = Function.update work₀ idx ((Tape.init []).move Dir3.right) ∧ + out = out₀) + (clearWorkTimeBound bits.length) := by + apply hclear.consequence (b' := clearWorkTimeBound bits.length) + · intro inp work out hpre + rcases hpre with ⟨hinp, htargetEq, hwork, hout⟩ + refine ⟨htargetEq, ?_, ?_, ?_, ?_, hinp, hwork, hout⟩ + · rw [hinp] + exact hinput.read_ne_start + · rw [hout] + exact houtput.read_ne_start + · rw [hout] + exact houtput.1 + · intro i hi + rw [hwork i hi] + exact ⟨(hother i hi).read_ne_start, (hother i hi).1⟩ + · intro inp work out hpost + rcases hpost with ⟨htargetEq, hinp, hwork, hout⟩ + refine ⟨hinp, ?_, hout⟩ + funext i + by_cases hi : i = idx + · subst i + rw [Function.update_self] + exact htargetEq + · rw [Function.update_of_ne hi] + exact hwork i hi + · unfold clearWorkTimeBound + omega + unfold resetBinaryWorkTM resetBinaryWorkTime + exact seqTM_hoareTime (rewindWorkTM idx) (clearWorkTM idx) hrewind + (by + intro inp work out hmid + rcases hmid with ⟨hinp, htargetEq, hwork, hout⟩ + have hreads : ∀ i, (work i).read ≠ Γ.start := by + intro i + by_cases hi : i = idx + · subst i + rw [htargetEq] + exact Tape.init_ofBool_move_right_read_ne_start bits + · rw [hwork i hi] + exact (hother i hi).read_ne_start + obtain ⟨hinputTransition, hworkTransition, houtputTransition⟩ := + phaseTransition_eq_self_of_reads_ne_start + (hinp ▸ hinput.read_ne_start) hreads (hout ▸ houtput.read_ne_start) + rw [hinputTransition, hworkTransition, houtputTransition] + exact ⟨hinp, htargetEq, hwork, hout⟩) + hclear' + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/ResetBinaryMany.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/ResetBinaryMany.lean new file mode 100644 index 0000000000..5431fb144a --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/ResetBinaryMany.lean @@ -0,0 +1,112 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.ResetBinaryMany.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.ResetBinaryMany.Internal + +/-! +# Resetting several binary work tapes + +This module exposes a framed compositional contract for resetting a fixed list +of distinct canonical binary work tapes. +-/ + + +public section + +namespace Complexity + +namespace TM + +variable {n : ℕ} + +/-- A reset list has a uniform linear bound when every target head and +represented bit string is bounded uniformly. -/ +theorem resetBinaryWorkManyTime_le + (targets : List (Fin n)) (bits : Fin n → List Bool) + (headBound : Fin n → ℕ) (maxHead maxWidth : ℕ) + (hhead : ∀ i, i ∈ targets → headBound i ≤ maxHead) + (hwidth : ∀ i, i ∈ targets → (bits i).length ≤ maxWidth) : + resetBinaryWorkManyTime bits headBound targets ≤ + targets.length * (maxHead + 2 * maxWidth + 9) + 1 := + resetBinaryWorkManyTime_le_internal targets bits headBound maxHead maxWidth + hhead hwidth + +/-- Every targeted work tape is the standard parked blank after the reset +sequence. -/ +theorem resetBinaryWorkManyResult_eq_blank_of_mem + (work₀ : Fin n → Tape) (targets : List (Fin n)) (idx : Fin n) + (hidx : idx ∈ targets) : + resetBinaryWorkManyResult work₀ targets idx = resetBinaryBlank := + resetBinaryWorkManyResult_eq_blank_of_mem_internal work₀ targets idx hidx + +/-- Work tapes outside the target list are preserved literally. -/ +theorem resetBinaryWorkManyResult_eq_of_not_mem + (work₀ : Fin n → Tape) (targets : List (Fin n)) (idx : Fin n) + (hidx : idx ∉ targets) : + resetBinaryWorkManyResult work₀ targets idx = work₀ idx := + resetBinaryWorkManyResult_eq_of_not_mem_internal work₀ targets idx hidx + +/-- Resetting a list of work tapes preserves parkedness of the whole work +family. -/ +theorem resetBinaryWorkManyResult_parked + (work₀ : Fin n → Tape) (targets : List (Fin n)) + (hwork : ∀ i, Parked (work₀ i)) : + ∀ i, Parked (resetBinaryWorkManyResult work₀ targets i) := + resetBinaryWorkManyResult_parked_internal work₀ targets hwork + +/-- The reset-sequence time depends on head bounds only at named targets. -/ +theorem resetBinaryWorkManyTime_congr_headBound + (targets : List (Fin n)) (bits : Fin n → List Bool) + (left right : Fin n → ℕ) + (heq : ∀ i, i ∈ targets → left i = right i) : + resetBinaryWorkManyTime bits left targets = + resetBinaryWorkManyTime bits right targets := + resetBinaryWorkManyTime_congr_headBound_internal targets bits left right heq + +/-- Sequentially reset a distinct list of canonical binary work tapes while +preserving the complete external frame. -/ +theorem resetBinaryWorkManyTM_hoareTime_frame + (targets : List (Fin n)) (bits : Fin n → List Bool) + (headBound : Fin n → ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hnodup : targets.Nodup) + (htarget : ∀ i, i ∈ targets → (work₀ i).HasBinaryContent (bits i)) + (htargetStart : ∀ i, i ∈ targets → (work₀ i).cells 0 = Γ.start) + (htargetHead : ∀ i, i ∈ targets → (work₀ i).head ≤ headBound i) + (hinput : Parked inp₀) (hwork : ∀ i, Parked (work₀ i)) + (houtput : Parked out₀) : + (resetBinaryWorkManyTM targets).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + work = resetBinaryWorkManyResult work₀ targets ∧ + out = out₀) + (resetBinaryWorkManyTime bits headBound targets) := + resetBinaryWorkManyTM_hoareTime_frame_internal targets bits headBound inp₀ + work₀ out₀ hnodup htarget htargetStart htargetHead hinput hwork houtput + +/-- Resetting several binary work tapes preserves one-way output safety. -/ +theorem resetBinaryWorkManyTM_isTransducer (targets : List (Fin n)) : + (resetBinaryWorkManyTM targets).IsTransducer := + resetBinaryWorkManyTM_isTransducer_internal targets + +/-- Coarse all-prefix auxiliary-space envelope for a reset sequence. -/ +theorem resetBinaryWorkManyTM_prefix_withinAuxSpace + (targets : List (Fin n)) (bits : Fin n → List Bool) + (headBound : Fin n → ℕ) (inputLength initialSpace time : ℕ) + (start current : Cfg n (resetBinaryWorkManyTM targets).Q) + (hinitial : start.WithinAuxSpace inputLength initialSpace) + (hreach : (resetBinaryWorkManyTM targets).reachesIn time start current) + (htime : time ≤ resetBinaryWorkManyTime bits headBound targets) : + current.WithinAuxSpace inputLength + (initialSpace + resetBinaryWorkManyTime bits headBound targets) := + (hinitial.reachesIn hreach).mono le_rfl (by omega) + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/ResetBinaryMany/Defs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/ResetBinaryMany/Defs.lean new file mode 100644 index 0000000000..deb531568c --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/ResetBinaryMany/Defs.lean @@ -0,0 +1,54 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Registers.RegisterOps +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.ResetBinary.Defs + +/-! +# Resetting several binary work tapes — definitions + +`resetBinaryWorkManyTM targets` sequentially rewinds and clears every work +tape named by `targets`. The executable machine depends only on the tape-index +list; represented contents and resource bounds occur only in its contracts. +-/ + + +@[expose] public section + +namespace Complexity + +namespace TM + +/-- The standard parked blank work tape produced by binary reset. -/ +def resetBinaryBlank : Tape := + (Tape.init []).move Dir3.right + +/-- Sequentially reset every work tape in `targets`, with `skipTM` as the +empty-list identity. -/ +def resetBinaryWorkManyTM {n : ℕ} : List (Fin n) → TM n + | [] => skipTM + | idx :: rest => seqTM (resetBinaryWorkTM idx) (resetBinaryWorkManyTM rest) + +/-- Exact work family obtained by applying the advertised resets in order. -/ +def resetBinaryWorkManyResult {n : ℕ} : + (Fin n → Tape) → List (Fin n) → Fin n → Tape + | work, [] => work + | work, idx :: rest => + resetBinaryWorkManyResult (Function.update work idx resetBinaryBlank) rest + +/-- Compositional time bound: every reset is followed by one sequencing seam, +and the empty-list `skipTM` costs one final step. -/ +def resetBinaryWorkManyTime {n : ℕ} (bits : Fin n → List Bool) + (headBound : Fin n → ℕ) : List (Fin n) → ℕ + | [] => 1 + | idx :: rest => + resetBinaryWorkTime (headBound idx) (bits idx).length + 1 + + resetBinaryWorkManyTime bits headBound rest + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/ResetBinaryMany/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/ResetBinaryMany/Internal.lean new file mode 100644 index 0000000000..0426ba9bf9 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/ResetBinaryMany/Internal.lean @@ -0,0 +1,215 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.ResetBinary +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.ResetBinaryMany.Defs + +/-! +# Resetting several binary work tapes — proof internals +-/ + + +public section + +namespace Complexity + +namespace TM + +variable {n : ℕ} + +theorem resetBinaryWorkManyTime_le_internal + (targets : List (Fin n)) (bits : Fin n → List Bool) + (headBound : Fin n → ℕ) (maxHead maxWidth : ℕ) + (hhead : ∀ i, i ∈ targets → headBound i ≤ maxHead) + (hwidth : ∀ i, i ∈ targets → (bits i).length ≤ maxWidth) : + resetBinaryWorkManyTime bits headBound targets ≤ + targets.length * (maxHead + 2 * maxWidth + 9) + 1 := by + induction targets with + | nil => simp [resetBinaryWorkManyTime] + | cons idx rest ih => + have hheadIdx := hhead idx (by simp) + have hwidthIdx := hwidth idx (by simp) + have ih' := ih + (fun i hi => hhead i (by simp [hi])) + (fun i hi => hwidth i (by simp [hi])) + simp only [resetBinaryWorkManyTime, resetBinaryWorkTime, + clearWorkTimeBound, List.length_cons] + calc + headBound idx + 2 + 1 + (2 * (bits idx).length + 5) + 1 + + resetBinaryWorkManyTime bits headBound rest ≤ + (maxHead + 2 * maxWidth + 9) + + resetBinaryWorkManyTime bits headBound rest := by omega + _ ≤ (maxHead + 2 * maxWidth + 9) + + (rest.length * (maxHead + 2 * maxWidth + 9) + 1) := + Nat.add_le_add_left ih' _ + _ = (rest.length + 1) * (maxHead + 2 * maxWidth + 9) + 1 := by + rw [Nat.add_mul] + omega + +private theorem resetBinaryBlank_parked : Parked resetBinaryBlank := by + constructor + · simp [resetBinaryBlank, Tape.init, Tape.move] + · intro j hj + simpa [resetBinaryBlank, Tape.init, Tape.move] using + (show j ≠ 0 by omega) + +theorem resetBinaryWorkManyResult_parked_internal + (work₀ : Fin n → Tape) (targets : List (Fin n)) + (hwork : ∀ i, Parked (work₀ i)) : + ∀ i, Parked (resetBinaryWorkManyResult work₀ targets i) := by + induction targets generalizing work₀ with + | nil => exact hwork + | cons idx rest ih => + apply ih + intro i + by_cases hi : i = idx + · subst i + rw [Function.update_self] + exact resetBinaryBlank_parked + · simpa [Function.update_of_ne hi] using hwork i + +theorem resetBinaryWorkManyResult_eq_of_not_mem_internal + (work₀ : Fin n → Tape) (targets : List (Fin n)) (idx : Fin n) + (hidx : idx ∉ targets) : + resetBinaryWorkManyResult work₀ targets idx = work₀ idx := by + induction targets generalizing work₀ with + | nil => rfl + | cons target rest ih => + have hne : idx ≠ target := by + intro heq + exact hidx (by simp [heq]) + have hrest : idx ∉ rest := by + intro hmem + exact hidx (by simp [hmem]) + simpa [resetBinaryWorkManyResult, Function.update_of_ne hne] using + ih (Function.update work₀ target resetBinaryBlank) hrest + +theorem resetBinaryWorkManyResult_eq_blank_of_mem_internal + (work₀ : Fin n → Tape) (targets : List (Fin n)) (idx : Fin n) + (hidx : idx ∈ targets) : + resetBinaryWorkManyResult work₀ targets idx = resetBinaryBlank := by + induction targets generalizing work₀ with + | nil => simp at hidx + | cons target rest ih => + by_cases heq : idx = target + · subst idx + by_cases hmem : target ∈ rest + · exact ih (Function.update work₀ target resetBinaryBlank) hmem + · exact resetBinaryWorkManyResult_eq_of_not_mem_internal + (Function.update work₀ target resetBinaryBlank) rest target hmem + |>.trans (Function.update_self ..) + · have hrest : idx ∈ rest := by + simpa [heq] using hidx + exact ih (Function.update work₀ target resetBinaryBlank) hrest + +theorem resetBinaryWorkManyTime_congr_headBound_internal + (targets : List (Fin n)) (bits : Fin n → List Bool) + (left right : Fin n → ℕ) + (heq : ∀ i, i ∈ targets → left i = right i) : + resetBinaryWorkManyTime bits left targets = + resetBinaryWorkManyTime bits right targets := by + induction targets with + | nil => rfl + | cons idx rest ih => + simp only [resetBinaryWorkManyTime] + rw [heq idx (by simp)] + exact congrArg + (fun time => resetBinaryWorkTime (right idx) (bits idx).length + 1 + time) + (ih fun i hi => heq i (by simp [hi])) + +theorem resetBinaryWorkManyTM_hoareTime_frame_internal + (targets : List (Fin n)) (bits : Fin n → List Bool) + (headBound : Fin n → ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hnodup : targets.Nodup) + (htarget : ∀ i, i ∈ targets → (work₀ i).HasBinaryContent (bits i)) + (htargetStart : ∀ i, i ∈ targets → (work₀ i).cells 0 = Γ.start) + (htargetHead : ∀ i, i ∈ targets → (work₀ i).head ≤ headBound i) + (hinput : Parked inp₀) (hwork : ∀ i, Parked (work₀ i)) + (houtput : Parked out₀) : + (resetBinaryWorkManyTM targets).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + work = resetBinaryWorkManyResult work₀ targets ∧ + out = out₀) + (resetBinaryWorkManyTime bits headBound targets) := by + induction targets generalizing work₀ with + | nil => + simpa [resetBinaryWorkManyTM, resetBinaryWorkManyResult, + resetBinaryWorkManyTime] using + skipTM_hoareTime_frame inp₀ work₀ out₀ hinput hwork houtput + | cons idx rest ih => + have hidxNotMem : idx ∉ rest := (List.nodup_cons.mp hnodup).1 + have hrestNodup : rest.Nodup := (List.nodup_cons.mp hnodup).2 + let work₁ := Function.update work₀ idx resetBinaryBlank + have hreset := resetBinaryWorkTM_hoareTime_frame idx (bits idx) + (headBound idx) inp₀ work₀ out₀ + (htarget idx (by simp)) (htargetStart idx (by simp)) + ⟨(hwork idx).1, htargetHead idx (by simp)⟩ hinput + (fun i _ => hwork i) houtput + have hwork₁ : ∀ i, Parked (work₁ i) := by + intro i + by_cases hi : i = idx + · subst i + simpa [work₁, resetBinaryBlank] using resetBinaryBlank_parked + · simpa [work₁, Function.update_of_ne hi] using hwork i + have htarget₁ : ∀ i, i ∈ rest → + (work₁ i).HasBinaryContent (bits i) := by + intro i hi + have hne : i ≠ idx := fun hieq => hidxNotMem (hieq ▸ hi) + simpa [work₁, Function.update_of_ne hne] using + htarget i (by simp [hi]) + have htargetStart₁ : ∀ i, i ∈ rest → + (work₁ i).cells 0 = Γ.start := by + intro i hi + have hne : i ≠ idx := fun hieq => hidxNotMem (hieq ▸ hi) + simpa [work₁, Function.update_of_ne hne] using + htargetStart i (by simp [hi]) + have htargetHead₁ : ∀ i, i ∈ rest → + (work₁ i).head ≤ headBound i := by + intro i hi + have hne : i ≠ idx := fun hieq => hidxNotMem (hieq ▸ hi) + simpa [work₁, Function.update_of_ne hne] using + htargetHead i (by simp [hi]) + have hrest := ih work₁ hrestNodup htarget₁ htargetStart₁ + htargetHead₁ hwork₁ + have hseq := seqTM_hoareTime (resetBinaryWorkTM idx) + (resetBinaryWorkManyTM rest) hreset + (by + intro inp work out hmid + rcases hmid with ⟨hinp, hworkEq, hout⟩ + have hworkParked : ∀ i, Parked (work i) := by + intro i + rw [hworkEq] + exact hwork₁ i + obtain ⟨hinpTransition, hworkTransition, houtTransition⟩ := + phaseTransition_eq_self_of_reads_ne_start + (hinp ▸ hinput.read_ne_start) + (fun i => (hworkParked i).read_ne_start) + (hout ▸ houtput.read_ne_start) + rw [hinpTransition, hworkTransition, houtTransition] + exact ⟨hinp, hworkEq, hout⟩) + hrest + simpa [resetBinaryWorkManyTM, resetBinaryWorkManyResult, + resetBinaryWorkManyTime, work₁] using hseq + +theorem resetBinaryWorkManyTM_isTransducer_internal + (targets : List (Fin n)) : + (resetBinaryWorkManyTM targets).IsTransducer := by + induction targets with + | nil => + intro state iHead wHeads oHead + cases state <;> cases oHead <;> simp [resetBinaryWorkManyTM, skipTM, + idleDir] + | cons idx rest ih => + simpa [resetBinaryWorkManyTM] using + (resetBinaryWorkTM_isTransducer idx).seqTM ih + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/ResetTapes.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/ResetTapes.lean new file mode 100644 index 0000000000..5cb62593b3 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/ResetTapes.lean @@ -0,0 +1,309 @@ +/- +Copyright (c) 2026 Bolton Bailey. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Bolton Bailey +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.RewindList +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.WipeLoop + +/-! +# Resetting a list of tapes to blank, content-agnostically + +The full reset an opaque machine's scratch needs between calls: park everything +(`TM.parkAll_hoareTime`), rewind every targeted tape to cell `1` +(`TM.rewindList_hoareTime`), then wipe `H` cells forward from there +(`TM.wipeLoop_hoareTime`). A fuel register disjoint from the targets drives the +wipe and is left exactly as it started. + +## Main results + +- `TM.resetTapesTM` — the composite reset machine +- `TM.resetTapesTM_hoareTime` / `TM.resetTapesTM_hoareTime_of_bounds` — its contract +-/ + + +public section + +namespace Complexity + +namespace TM + +/-- **Resetting a list of tapes.** Regardless of their current content or head +position (bounded by `H`), every tape in `targets` ends up blanked from cell +`1` through cell `H`, with its tail beyond cell `H` untouched; the fuel +register `r` (disjoint from `targets`) and every other tape are exactly as +they were. -/ +theorem resetTapes_hoareTime {n : ℕ} (targets : List (Fin n)) (hnodup : targets.Nodup) + (r : Fin n) (hr : r ∉ targets) (H : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hinpSI : Tape.StartInvariant inp₀) (hinpP : Parked inp₀) + (hout0 : out₀ = (Tape.init []).move Dir3.right) + (hworkSI : ∀ j, j ≠ r → Tape.StartInvariant (work₀ j)) + (htargetHead : ∀ j, j ∈ targets → (work₀ j).head ≤ H) + (hworkR : work₀ r = regTape H) + (hother : ∀ j, j ≠ r → j ∉ targets → Parked (work₀ j)) : + (seqTM (seqTM skipTM (bigSeqTM (targets.map rewindWorkTM))) + (forRegTM (wipeStepTM targets) r)).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => inp = inp₀ ∧ out = out₀ ∧ + (∀ j, j ∈ targets → work j = wipedTape (⟨1, (work₀ j).cells⟩ : Tape) H) ∧ + work r = regTape H ∧ + (∀ j, j ≠ r → j ∉ targets → work j = work₀ j)) + (targets.length * (H + 4) + H * 4 + 8) := by + have hregParked : Parked (regTape H) := + ⟨le_refl 1, fun i hi => by + show regCells H i ≠ Γ.start + simp only [regCells]; split + · omega + · split <;> decide⟩ + have houtSI : Tape.StartInvariant out₀ := by + rw [hout0] + refine ⟨?_, fun j hj => ?_⟩ + · rw [Tape.move_cells]; exact Tape.init_cells_zero [] + · rw [Tape.move_cells, show j = (j - 1) + 1 from by omega, + Tape.init_cells_ge [] (j - 1) (by simp)] + decide + have houtP : Parked out₀ := by rw [hout0]; exact parked_parkedBlank + have hworkSI' : ∀ j, Tape.StartInvariant (work₀ j) := by + intro j + by_cases hjr : j = r + · subst hjr; rw [hworkR]; exact ⟨rfl, hregParked.2⟩ + · exact hworkSI j hjr + set workA : Fin n → Tape := fun j => (⟨max (work₀ j).head 1, (work₀ j).cells⟩ : Tape) + with hworkA + have hAP : ∀ j, Parked (workA j) := fun j => ⟨le_max_right _ _, fun i hi => (hworkSI' j).2 i hi⟩ + have hAtarget : ∀ j, j ∈ targets → (workA j).cells 0 = Γ.start ∧ (workA j).head ≤ H + 1 := by + intro j hj + refine ⟨(hworkSI' j).1, ?_⟩ + show max (work₀ j).head 1 ≤ H + 1 + have := htargetHead j hj + omega + have hA := parkAll_hoareTime inp₀ work₀ out₀ hinpSI hworkSI' houtSI + have hinpAeq : (⟨max inp₀.head 1, inp₀.cells⟩ : Tape) = inp₀ := + Tape.ext (by show max inp₀.head 1 = inp₀.head; have := hinpP.1; omega) rfl + have houtAeq : (⟨max out₀.head 1, out₀.cells⟩ : Tape) = out₀ := + Tape.ext (by show max out₀.head 1 = out₀.head; have := houtP.1; omega) rfl + have hApost_imp : ∀ inp work out, + (inp = (⟨max inp₀.head 1, inp₀.cells⟩ : Tape) ∧ + (∀ i, work i = workA i) ∧ out = (⟨max out₀.head 1, out₀.cells⟩ : Tape)) → + (inp = inp₀ ∧ work = workA ∧ out = out₀) := by + rintro inp work out ⟨hi, hw, ho⟩ + exact ⟨hi.trans hinpAeq, funext hw, ho.trans houtAeq⟩ + have hA' := hA.strengthen_post hApost_imp + have hB0 := rewindList_hoareTime targets hnodup (H + 1) inp₀ workA out₀ hinpP houtP hAP hAtarget + have hB : (seqTM skipTM (bigSeqTM (targets.map rewindWorkTM))).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => inp = inp₀ ∧ out = out₀ ∧ + (∀ j, j ∈ targets → work j = (⟨1, (work₀ j).cells⟩ : Tape)) ∧ + (∀ j, j ∉ targets → work j = workA j)) + (1 + 1 + targets.length * ((H + 1) + 3) + 1) := by + refine seqTM_hoareTime skipTM (bigSeqTM (targets.map rewindWorkTM)) hA' ?_ hB0 + rintro inp work out ⟨rfl, rfl, rfl⟩ + refine ⟨transitionInput_eq_self hinpP.read_ne_start, ?_, + transitionTape_eq_self houtP.read_ne_start⟩ + funext i + exact transitionTape_eq_self (hAP i).read_ne_start + set workC : Fin n → Tape := fun j => if j ∈ targets then (⟨1, (work₀ j).cells⟩ : Tape) + else work₀ j with hworkC + have hCother : ∀ j, j ≠ r → Parked (workC j) := by + intro j hjr + rw [hworkC] + dsimp only + split + · next hjt => exact ⟨le_refl 1, (hworkSI' j).2⟩ + · next hjt => exact hother j hjr hjt + have hC0 := wipeLoop_hoareTime targets r hr H inp₀ workC hinpP hCother + have hworkeq : ∀ (work : Fin n → Tape), + (∀ j, j ∈ targets → work j = (⟨1, (work₀ j).cells⟩ : Tape)) → + (∀ j, j ∉ targets → work j = workA j) → + work = Function.update workC r (regTape H) := by + intro work hts hnts + funext j + by_cases hjr : j = r + · rw [hjr, Function.update_self] + rw [hnts r hr] + show (⟨max (work₀ r).head 1, (work₀ r).cells⟩ : Tape) = regTape H + rw [hworkR] + exact Tape.ext (by show max 1 1 = 1; omega) (by rw [regT_cells]) + · rw [Function.update_of_ne hjr] + by_cases hjt : j ∈ targets + · rw [hts j hjt, hworkC]; simp [hjt] + · rw [hnts j hjt, hworkC] + simp only [hjt, if_false] + exact Tape.ext (by + show max (work₀ j).head 1 = (work₀ j).head + have := (hother j hjr hjt).1 + omega) rfl + have hread : ∀ (work : Fin n → Tape), + (∀ j, j ∈ targets → work j = (⟨1, (work₀ j).cells⟩ : Tape)) → + (∀ j, j ∉ targets → work j = workA j) → + ∀ j, (work j).read ≠ Γ.start := by + intro work hts hnts j + by_cases hjt : j ∈ targets + · rw [hts j hjt] + exact (hworkSI' j).2 1 le_rfl + · rw [hnts j hjt] + exact (hAP j).read_ne_start + have htrans : ∀ (inp : Tape) (work : Fin n → Tape) (out : Tape), + (inp = inp₀ ∧ out = out₀ ∧ + (∀ j, j ∈ targets → work j = (⟨1, (work₀ j).cells⟩ : Tape)) ∧ + (∀ j, j ∉ targets → work j = workA j)) → + transitionInput inp = inp₀ ∧ + (fun i => transitionTape (work i)) = Function.update workC r (regTape H) ∧ + transitionTape out = (Tape.init []).move Dir3.right := by + rintro inp work out ⟨hi, ho, hts, hnts⟩ + refine ⟨by rw [hi]; exact transitionInput_eq_self hinpP.read_ne_start, + ?_, by rw [ho, transitionTape_eq_self houtP.read_ne_start]; exact hout0⟩ + rw [← hworkeq work hts hnts] + funext j + exact transitionTape_eq_self (hread work hts hnts j) + have hFull := seqTM_hoareTime (seqTM skipTM (bigSeqTM (targets.map rewindWorkTM))) + (forRegTM (wipeStepTM targets) r) hB htrans hC0 + have hpost_imp : ∀ (inp : Tape) (work : Fin n → Tape) (out : Tape), + (inp = inp₀ ∧ + work = Function.update (fun j => if j ∈ targets then wipedTape (workC j) H else workC j) + r (regTape H) ∧ + out = (Tape.init []).move Dir3.right) → + (inp = inp₀ ∧ out = out₀ ∧ + (∀ j, j ∈ targets → work j = wipedTape (⟨1, (work₀ j).cells⟩ : Tape) H) ∧ + work r = regTape H ∧ + (∀ j, j ≠ r → j ∉ targets → work j = work₀ j)) := by + rintro inp work out ⟨hi, hw, ho⟩ + refine ⟨hi, ho.trans hout0.symm, fun j hjt => ?_, ?_, fun j hjr hjt => ?_⟩ + · rw [hw, Function.update_of_ne (fun h => hr (by rw [h] at hjt; exact hjt)), + if_pos hjt, hworkC] + simp [hjt] + · rw [hw, Function.update_self] + · rw [hw, Function.update_of_ne hjr, hworkC] + simp [hjt] + refine (hFull.strengthen_post hpost_imp).mono_bound ?_ + ring_nf + omega + +/-- The composite reset machine: park everything, rewind the targets, wipe +`H` cells forward, then rewind the targets again. -/ +def resetTapesTM {n : ℕ} (targets : List (Fin n)) (r : Fin n) : TM n := + seqTM (seqTM (seqTM skipTM (bigSeqTM (targets.map rewindWorkTM))) + (forRegTM (wipeStepTM targets) r)) + (bigSeqTM (targets.map rewindWorkTM)) + +/-- **The full reset.** Every tape in `targets` whose content is confined to +cells `1 … H` — no matter *where* in that range, and no matter where its head +currently sits — ends up literally blank and parked at cell `1`. The fuel +register `r` and all other tapes are returned exactly as they were. -/ +theorem resetTapesTM_hoareTime {n : ℕ} (targets : List (Fin n)) (hnodup : targets.Nodup) + (r : Fin n) (hr : r ∉ targets) (H : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hinpSI : Tape.StartInvariant inp₀) (hinpP : Parked inp₀) + (hout0 : out₀ = (Tape.init []).move Dir3.right) + (hworkSI : ∀ j, j ≠ r → Tape.StartInvariant (work₀ j)) + (htargetHead : ∀ j, j ∈ targets → (work₀ j).head ≤ H) + (htargetFar : ∀ j, j ∈ targets → ∀ i, H < i → (work₀ j).cells i = Γ.blank) + (hworkR : work₀ r = regTape H) + (hother : ∀ j, j ≠ r → j ∉ targets → Parked (work₀ j)) : + (resetTapesTM targets r).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => inp = inp₀ ∧ out = out₀ ∧ + (∀ j, j ∈ targets → work j = (Tape.init []).move Dir3.right) ∧ + work r = regTape H ∧ + (∀ j, j ≠ r → j ∉ targets → work j = work₀ j)) + (targets.length * (H + 4) + H * 4 + 8 + 1 + (targets.length * (H + 4) + 1)) := by + have houtP : Parked out₀ := by rw [hout0]; exact parked_parkedBlank + have hregParked : Parked (regTape H) := + ⟨le_refl 1, fun i hi => by + show regCells H i ≠ Γ.start + simp only [regCells]; split + · omega + · split <;> decide⟩ + -- the wipe's exact effect on a targeted tape, spelled out + have hwiped : ∀ j, j ∈ targets → + wipedTape (⟨1, (work₀ j).cells⟩ : Tape) H = (⟨H + 1, (Tape.init []).cells⟩ : Tape) := by + intro j hj + refine wipedTape_eq_blank H rfl ?_ (fun i hi => htargetFar j hj i hi) + exact (hworkSI j (fun h => hr (h ▸ hj))).1 + -- the tape family after the wipe phase + set workD : Fin n → Tape := fun j => + if j ∈ targets then (⟨H + 1, (Tape.init []).cells⟩ : Tape) + else if j = r then regTape H else work₀ j with hworkD + have hDP : ∀ j, Parked (workD j) := by + intro j + rw [hworkD] + dsimp only + split + · exact ⟨show 1 ≤ H + 1 by omega, + fun i hi => by rw [initNil_cells, if_neg (by omega)]; decide⟩ + · split + · exact hregParked + · next hjt hjr => exact hother j hjr hjt + have hDtarget : ∀ j, j ∈ targets → + (workD j).cells 0 = Γ.start ∧ (workD j).head ≤ H + 1 := by + intro j hj + rw [hworkD] + simp only [if_pos hj] + exact ⟨by rw [initNil_cells, if_pos rfl], le_refl _⟩ + have hfirst := resetTapes_hoareTime targets hnodup r hr H inp₀ work₀ out₀ hinpSI hinpP + hout0 hworkSI htargetHead hworkR hother + have hsecond := rewindList_hoareTime targets hnodup (H + 1) inp₀ workD out₀ hinpP houtP + hDP hDtarget + refine seqTM_hoareTime _ _ hfirst ?_ hsecond |>.strengthen_post ?_ + · -- the boundary: everything is parked, so the seam is the identity + rintro inp work out ⟨hi, ho, hts, hR, hrest⟩ + have hworkD_eq : work = workD := by + funext j + by_cases hjt : j ∈ targets + · rw [hts j hjt, hwiped j hjt, hworkD]; simp [hjt] + · by_cases hjr : j = r + · rw [hjr, hR, hworkD]; simp [hr] + · rw [hrest j hjr hjt, hworkD]; simp [hjt, hjr] + subst hworkD_eq + refine ⟨by rw [hi]; exact transitionInput_eq_self hinpP.read_ne_start, ?_, + by rw [ho]; exact transitionTape_eq_self houtP.read_ne_start⟩ + funext j + exact transitionTape_eq_self (hDP j).read_ne_start + · rintro inp work out ⟨hi, ho, hts, hnts⟩ + refine ⟨hi, ho, fun j hj => ?_, ?_, fun j hjr hjt => ?_⟩ + · rw [hts j hj, hworkD] + simp only [if_pos hj] + rfl + · rw [hnts r hr, hworkD] + simp [hr] + · rw [hnts j hjt, hworkD] + simp [hjt, hjr] + +/-- **The reset, keyed on bounds rather than on a named tape family.** The +tapes an opaque machine leaves behind are only known through bounds, never as +a closed form, so this is the shape the loop body actually needs: the exact +starting family is instantiated inside the proof. -/ +theorem resetTapesTM_hoareTime_of_bounds {n : ℕ} (targets : List (Fin n)) + (hnodup : targets.Nodup) (r : Fin n) (hr : r ∉ targets) (H : ℕ) + (inp₀ : Tape) (extras : Fin n → Tape) (out₀ : Tape) + (hinpSI : Tape.StartInvariant inp₀) (hinpP : Parked inp₀) + (hout0 : out₀ = (Tape.init []).move Dir3.right) + (hextraP : ∀ j, j ≠ r → j ∉ targets → Parked (extras j)) : + (resetTapesTM targets r).HoareTime + (fun inp work out => inp = inp₀ ∧ out = out₀ ∧ + (∀ j, j ≠ r → Tape.StartInvariant (work j)) ∧ + (∀ j, j ∈ targets → (work j).head ≤ H ∧ ∀ i, H < i → (work j).cells i = Γ.blank) ∧ + work r = regTape H ∧ + (∀ j, j ≠ r → j ∉ targets → work j = extras j)) + (fun inp work out => inp = inp₀ ∧ out = out₀ ∧ + (∀ j, j ∈ targets → work j = (Tape.init []).move Dir3.right) ∧ + work r = regTape H ∧ + (∀ j, j ≠ r → j ∉ targets → work j = extras j)) + (targets.length * (H + 4) + H * 4 + 8 + 1 + (targets.length * (H + 4) + 1)) := by + intro inp work out hpre + obtain ⟨hi, ho, hSI, hbnd, hR, hext⟩ := hpre + rw [hi, ho] + obtain ⟨c', t, ht, hreach, hhalt, hi', ho', hts, hR', hrest⟩ := + resetTapesTM_hoareTime targets hnodup r hr H inp₀ work out₀ hinpSI hinpP hout0 hSI + (fun j hj => (hbnd j hj).1) (fun j hj i hii => (hbnd j hj).2 i hii) hR + (fun j hjr hjt => by rw [hext j hjr hjt]; exact hextraP j hjr hjt) + inp₀ work out₀ ⟨rfl, rfl, rfl⟩ + exact ⟨c', t, ht, hreach, hhalt, hi', ho', hts, hR', + fun j hjr hjt => (hrest j hjr hjt).trans (hext j hjr hjt)⟩ + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/RewindList.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/RewindList.lean new file mode 100644 index 0000000000..5959360bb6 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/RewindList.lean @@ -0,0 +1,141 @@ +/- +Copyright (c) 2026 Bolton Bailey. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Bolton Bailey +-/ + +module +public import Mathlib.Tactic.Ring +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Registers.EmitSeq +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.ParkAll + +/-! +# Rewinding a list of tapes, one at a time + +Rewinding cannot be done in one uniform pass the way wiping can: +`TM.rewindWorkTM` bounces at `▷` rather than saturating there, so moving +everyone left the same number of times oscillates. Doing it one tape at a time +via `TM.bigSeqTM` works once every tape has been parked once +(`TM.parkAll_hoareTime`). + +## Main results + +- `TM.rewindList_hoareTime` — rewind every targeted tape to cell `1` +-/ + + +public section + +namespace Complexity + +namespace TM + +/-- **Rewinding a list of tapes, one at a time.** Given a uniform head bound +`B` and that *every* tape (not just the targets) is already `Parked` — the +state after `parkAll_hoareTime` — sequentially rewinding each named tape +lands it at cell `1` with its cells unchanged, leaving every other tape +(targeted-but-not-yet-reached, or never targeted) exactly as it was. -/ +theorem rewindList_hoareTime {n : ℕ} : + ∀ (targets : List (Fin n)), targets.Nodup → + ∀ (B : ℕ) (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape), + Parked inp₀ → Parked out₀ → (∀ j, Parked (work₀ j)) → + (∀ j, j ∈ targets → (work₀ j).cells 0 = Γ.start ∧ (work₀ j).head ≤ B) → + (bigSeqTM (targets.map rewindWorkTM)).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => inp = inp₀ ∧ out = out₀ ∧ + (∀ j, j ∈ targets → work j = ⟨1, (work₀ j).cells⟩) ∧ + (∀ j, j ∉ targets → work j = work₀ j)) + (targets.length * (B + 3) + 1) := by + intro targets + induction targets with + | nil => + intro _ B inp₀ work₀ out₀ hinp hout hwork _ + simp only [List.map_nil, List.length_nil, Nat.zero_mul, Nat.zero_add] + refine (skipTM_hoareTime_frame inp₀ work₀ out₀ hinp hwork hout).strengthen_post ?_ + rintro inp work out ⟨rfl, rfl, rfl⟩ + exact ⟨rfl, rfl, nofun, fun j _ => rfl⟩ + | cons t ts ih => + intro hnodup B inp₀ work₀ out₀ hinp hout hwork htarget + have htnts : t ∉ ts := (List.nodup_cons.mp hnodup).1 + have htsnodup : ts.Nodup := (List.nodup_cons.mp hnodup).2 + have hP : ∀ (inp : Tape) (work : Fin n → Tape) (out : Tape) + (inp' : Tape) (work' : Fin n → Tape) (out' : Tape), + ((work t).cells = (work₀ t).cells ∧ + inp = inp₀ ∧ out = out₀ ∧ ∀ j, j ≠ t → work j = work₀ j) → + (work' t).cells = (work t).cells → (work' t).head = 1 → + (∀ j, j ≠ t → work' j = work j) → + inp' = inp → out'.cells = out.cells → out'.head = out.head → + ((work' t).cells = (work₀ t).cells ∧ + inp' = inp₀ ∧ out' = out₀ ∧ ∀ j, j ≠ t → work' j = work₀ j) := by + rintro inp work out inp' work' out' ⟨hcellsP, rfl, rfl, hrest⟩ hcells' _ hkeep rfl + hout'c hout'h + exact ⟨hcells'.trans hcellsP, rfl, Tape.ext hout'h hout'c, + fun j hjt => (hkeep j hjt).trans (hrest j hjt)⟩ + have h1 := rewindWorkTM_hoareTime_frame t B hP + have h1' := h1.weaken_pre + (show (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) ≤ _ by + rintro inp work out ⟨rfl, rfl, rfl⟩ + exact ⟨(htarget t (by simp)).1, fun j hj => (hwork t).2 j hj, (htarget t (by simp)).2, + hinp.read_ne_start, hout.read_ne_start, hout.1, + fun i _ => ⟨(hwork i).read_ne_start, (hwork i).1⟩, rfl, rfl, rfl, fun _ _ => rfl⟩) + set work₁ : Fin n → Tape := Function.update work₀ t (⟨1, (work₀ t).cells⟩ : Tape) with hwork₁ + have hwork₁P : ∀ j, Parked (work₁ j) := by + intro j + by_cases hjt : j = t + · rw [hjt, hwork₁, Function.update_self] + exact ⟨le_refl 1, fun i hi => (hwork t).2 i hi⟩ + · rw [hwork₁, Function.update_of_ne hjt]; exact hwork j + have hwork₁target : ∀ j, j ∈ ts → (work₁ j).cells 0 = Γ.start ∧ (work₁ j).head ≤ B := by + intro j hj + have hjt : j ≠ t := by rintro rfl; exact htnts hj + rw [hwork₁, Function.update_of_ne hjt] + exact htarget j (by simp [hj]) + have ih' := ih htsnodup B inp₀ work₁ out₀ hinp hout hwork₁P hwork₁target + have hread_t : ∀ (work : Fin n → Tape), (work t).cells = (work₀ t).cells → + (work t).head = 1 → (work t).read ≠ Γ.start := by + intro work hcells hhead + show (work t).cells (work t).head ≠ Γ.start + rw [hhead, hcells] + exact (hwork t).2 1 le_rfl + have h2 : (bigSeqTM ((t :: ts).map rewindWorkTM)).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => inp = inp₀ ∧ out = out₀ ∧ + (∀ j, j ∈ ts → work j = ⟨1, (work₁ j).cells⟩) ∧ + (∀ j, j ∉ ts → work j = work₁ j)) + ((B + 2) + 1 + (ts.length * (B + 3) + 1)) := by + simp only [List.map_cons, bigSeqTM] + refine seqTM_hoareTime (rewindWorkTM t) (bigSeqTM (ts.map rewindWorkTM)) h1' ?_ ih' + rintro inp work out ⟨hhead1, hcellsP, hpinp, hpout, hprest⟩ + have hreadt : (work t).read ≠ Γ.start := hread_t work hcellsP hhead1 + have ht1 : transitionInput inp = inp₀ := by + rw [hpinp]; exact transitionInput_eq_self hinp.read_ne_start + have ht3 : transitionTape out = out₀ := by + rw [hpout]; exact transitionTape_eq_self hout.read_ne_start + have ht2 : (fun i => transitionTape (work i)) = work₁ := by + funext j + by_cases hjt : j = t + · rw [hjt, transitionTape_eq_self hreadt, hwork₁, Function.update_self] + exact Tape.ext hhead1 hcellsP + · rw [hprest j hjt, transitionTape_eq_self (hwork j).read_ne_start, + hwork₁, Function.update_of_ne hjt] + rw [ht1, ht2, ht3] + exact ⟨rfl, rfl, rfl⟩ + refine h2.consequence (fun _ _ _ h => h) + (fun inp work out ⟨hinpeq, houteq, hts, hnts⟩ => ?_) + (by rw [List.length_cons]; ring_nf; omega) + refine ⟨hinpeq, houteq, fun j hj => ?_, fun j hj => ?_⟩ + · rw [List.mem_cons] at hj + rcases hj with hjeqt | hjts + · rw [hnts j (hjeqt ▸ htnts), hjeqt, hwork₁, Function.update_self] + · rw [hts j hjts] + congr 1 + have hjt : j ≠ t := fun h => htnts (h ▸ hjts) + rw [hwork₁, Function.update_of_ne hjt] + · have hjt : j ≠ t := fun h => hj (List.mem_cons.mpr (Or.inl h)) + have hjts : j ∉ ts := fun h => hj (List.mem_cons.mpr (Or.inr h)) + rw [hnts j hjts, hwork₁, Function.update_of_ne hjt] + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/UnaryLength.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/UnaryLength.lean new file mode 100644 index 0000000000..4fc8b3d069 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/UnaryLength.lean @@ -0,0 +1,39 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.UnaryLength.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.UnaryLength.Internal + +/-! +# Unary input-length transducer + +Public correctness theorem for `TM.unaryLengthTM`. On input `x`, the machine +emits `List.replicate x.length true` within the linear bound `|x| + 2`. + +## Main result + +- `TM.unaryLengthTM_computesInTime` — unary input-length computation in + linear time +-/ + + +public section + +namespace Complexity + +namespace TM + +/-- The unary input-length transducer computes `List.replicate |x| true` +within the linear time bound `m + 2`. -/ +theorem unaryLengthTM_computesInTime (n : ℕ) : + (unaryLengthTM (n := n)).ComputesInTime + (fun x => List.replicate x.length true) (fun m => m + 2) := by + exact unaryLengthTM_computesInTime_internal n + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/UnaryLength/Defs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/UnaryLength/Defs.lean new file mode 100644 index 0000000000..04946a7d80 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/UnaryLength/Defs.lean @@ -0,0 +1,65 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators + +/-! +# Unary input-length transducer — definitions + +This module defines a deterministic transducer that scans its Boolean input +once and writes one `true` bit per input bit. Its output is therefore the +unary representation `List.replicate x.length true` of the input length. +-/ + + +@[expose] public section + +namespace Complexity + +namespace TM + +/-- Control states for `unaryLengthTM`: scan the input, then halt at its first +trailing blank. -/ +inductive UnaryLengthPhase where + | copying + | done + deriving DecidableEq + +instance : Fintype UnaryLengthPhase where + elems := {.copying, .done} + complete := fun state => by cases state <;> simp + +/-- Scan the Boolean input from left to right and emit one `true` bit per +input bit. The first step skips the left-end markers, and the machine halts +when the input head reaches its first trailing blank. -/ +def unaryLengthTM {n : ℕ} : TM n where + Q := UnaryLengthPhase + qstart := .copying + qhalt := .done + δ := fun state iHead wHeads oHead => + match state with + | .copying => + if iHead = Γ.blank then + (.done, fun i => readBackWrite (wHeads i), readBackWrite oHead, + idleDir iHead, fun i => idleDir (wHeads i), idleDir oHead) + else + (.copying, fun i => readBackWrite (wHeads i), .one, + Dir3.right, fun i => idleDir (wHeads i), Dir3.right) + | .done => allIdle .done iHead wHeads oHead + δ_right_of_start := by + intro state iHead wHeads oHead + match state with + | .copying => + dsimp only [] + split + · exact rightOfStart_allIdle iHead wHeads oHead + · exact ⟨fun _ => rfl, fun _ => idleDir_right_of_start, fun _ => rfl⟩ + | .done => exact rightOfStart_allIdle iHead wHeads oHead + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/UnaryLength/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/UnaryLength/Internal.lean new file mode 100644 index 0000000000..6d65025b77 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/UnaryLength/Internal.lean @@ -0,0 +1,138 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.Internal.Generic +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.UnaryLength.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Tape.Encoding + +/-! +# Unary input-length transducer — proof internals + +This module proves the exact execution contract for `TM.unaryLengthTM`. +Starting from an initial configuration on `x`, it skips the left-end marker, +writes one `true` bit per input bit, and halts on the first input blank after +exactly `|x| + 2` transitions. +-/ + + +public section + +namespace Complexity + +namespace TM + +/-- From the first unvisited input cell and an output containing `k` unary +marks, the scan consumes the remaining `|x| - k` bits and the terminating +blank. -/ +private theorem unaryLengthTM_loop {n : ℕ} (x : List Bool) : + ∀ rem k (c : Cfg n (unaryLengthTM (n := n)).Q), + rem = x.length - k → + c.state = UnaryLengthPhase.copying → + c.input.cells = (Tape.init (x.map Γ.ofBool)).cells → + c.input.head = k + 1 → + c.output.HasBinaryPrefix (List.replicate k true) → + k ≤ x.length → + ∃ c', + (unaryLengthTM (n := n)).reachesIn (rem + 1) c c' ∧ + (unaryLengthTM (n := n)).halted c' ∧ + c'.input.cells = (Tape.init (x.map Γ.ofBool)).cells ∧ + c'.input.head = x.length + 1 ∧ + c'.output.HasBinaryPrefix (List.replicate x.length true) := by + intro rem + induction rem with + | zero => + intro k c hrem hstate hcells hhead hprefix hk + have hk_eq : k = x.length := by omega + subst k + have hread : c.input.read = Γ.blank := by + simp [Tape.read, hhead, hcells, Tape.init_ofBool_cells_ge x x.length] + have houtputRead : c.output.read = Γ.blank := hprefix.read_blank + let c' : Cfg n (unaryLengthTM (n := n)).Q := + { state := UnaryLengthPhase.done + input := c.input.move (idleDir c.input.read) + work := fun i => + (c.work i).writeAndMove (readBackWrite (c.work i).read) + (idleDir (c.work i).read) + output := c.output.writeAndMove (readBackWrite c.output.read) + (idleDir c.output.read) } + have hinputKeep : c.input.move (idleDir c.input.read) = c.input := by + simp [idleDir, hread, Tape.move] + have houtputKeep : + c.output.writeAndMove (readBackWrite c.output.read) + (idleDir c.output.read) = c.output := by + exact transitionTape_eq_self (by simp [houtputRead]) + have hstep : (unaryLengthTM (n := n)).step c = some c' := by + simp [TM.step, hstate, unaryLengthTM, hread, c'] + refine ⟨c', .step hstep .zero, rfl, ?_, ?_, ?_⟩ + · rw [show c'.input = c.input by simpa [c'] using hinputKeep] + exact hcells + · rw [show c'.input = c.input by simpa [c'] using hinputKeep] + exact hhead + · rw [show c'.output = c.output by simpa [c'] using houtputKeep] + exact hprefix + | succ rem ih => + intro k c hrem hstate hcells hhead hprefix hk + have hk_lt : k < x.length := by omega + have hread : c.input.read = Γ.ofBool (x[k]'hk_lt) := by + simp [Tape.read, hhead, hcells, Tape.init_ofBool_cells_lt x k hk_lt] + have hnotBlank : c.input.read ≠ Γ.blank := by + rw [hread] + exact Γ.ofBool_ne_blank _ + have hreplicate : + List.replicate k true ++ [true] = List.replicate (k + 1) true := by + change List.replicate k true ++ List.replicate 1 true = _ + rw [← List.replicate_add] + have hprefix' : + (c.output.writeAndMove Γ.one Dir3.right).HasBinaryPrefix + (List.replicate (k + 1) true) := by + rw [← hreplicate] + exact Tape.hasBinaryPrefix_write_bit true hprefix + let c' : Cfg n (unaryLengthTM (n := n)).Q := + { state := UnaryLengthPhase.copying + input := c.input.move Dir3.right + work := fun i => + (c.work i).writeAndMove (readBackWrite (c.work i).read) + (idleDir (c.work i).read) + output := c.output.writeAndMove Γ.one Dir3.right } + have hstep : (unaryLengthTM (n := n)).step c = some c' := by + simp [TM.step, hstate, unaryLengthTM, hnotBlank, c'] + have hcells' : c'.input.cells = (Tape.init (x.map Γ.ofBool)).cells := by + simpa [c', Tape.move_cells] using hcells + have hhead' : c'.input.head = (k + 1) + 1 := by + simp [c', Tape.move, hhead] + have hrem' : rem = x.length - (k + 1) := by omega + obtain ⟨c'', hreach, hhalt, hcells'', hhead'', hprefix''⟩ := + ih (k + 1) c' hrem' rfl hcells' hhead' (by simpa [c'] using hprefix') (by omega) + exact ⟨c'', .step hstep hreach, hhalt, hcells'', hhead'', hprefix''⟩ + +/-- Internal implementation theorem: `unaryLengthTM` emits the unary input +length within the linear bound `m + 2`. -/ +theorem unaryLengthTM_computesInTime_internal (n : ℕ) : + (unaryLengthTM (n := n)).ComputesInTime + (fun x => List.replicate x.length true) (fun m => m + 2) := by + intro x + let c₁ : Cfg n (unaryLengthTM (n := n)).Q := + { state := UnaryLengthPhase.copying + input := (Tape.init (x.map Γ.ofBool)).move Dir3.right + work := fun _ => (Tape.init []).move Dir3.right + output := (Tape.init []).move Dir3.right } + have hstep : + (unaryLengthTM (n := n)).step ((unaryLengthTM (n := n)).initCfg x) = some c₁ := by + simp [TM.step, unaryLengthTM, c₁, Tape.read, Tape.init, readBackWrite, + idleDir, Tape.writeAndMove, Tape.write, Tape.move] + obtain ⟨c', hreach, hhalt, _hcells, _hhead, hprefix⟩ := + unaryLengthTM_loop (n := n) x x.length 0 c₁ (by simp) rfl + (by simp [c₁, Tape.move]) (by simp [c₁, Tape.move]) + (by simpa [c₁] using Tape.init_nil_move_right_hasBinaryPrefix_nil) + (Nat.zero_le _) + refine ⟨c', x.length + 2, le_rfl, ?_, hhalt, ?_⟩ + · simpa [Nat.add_assoc] using TM.reachesIn.step hstep hreach + · exact hprefix.hasOutput + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/WipeLoop.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/WipeLoop.lean new file mode 100644 index 0000000000..f4e2f4ec44 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/WipeLoop.lean @@ -0,0 +1,250 @@ +/- +Copyright (c) 2026 Bolton Bailey. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Bolton Bailey +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Registers.ForReg +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.WipeStep + +/-! +# The wipe loop + +`TM.forRegTM` drives a body an exact number of times off a dedicated unary fuel +register. Running `TM.wipeStepTM` through it, fueled by a register holding `v` +marks unrelated to any targeted tape's content, blanks the leading `v` cells of +every target whatever was there. + +## Main results + +- `TM.wipedTape` — the closed form of `v` wipe steps applied to a tape +- `TM.wipeLoop_hoareTime` — the loop's contract +-/ + + +@[expose] public section + +namespace Complexity + +namespace TM + +/-- Wipe-step applied `i` times to `t`, in closed form. -/ +def wipedTape (t : Tape) (i : ℕ) : Tape := + (fun s : Tape => s.writeAndMove Γw.blank.toΓ Dir3.right)^[i] t + +@[simp] theorem wipedTape_zero (t : Tape) : wipedTape t 0 = t := rfl + +theorem wipedTape_succ (t : Tape) (i : ℕ) : + wipedTape t (i + 1) = (wipedTape t i).writeAndMove Γw.blank.toΓ Dir3.right := + Function.iterate_succ_apply' _ i t + +/-- Wiping advances the head one cell per step. -/ +theorem wipedTape_head (t : Tape) (i : ℕ) : (wipedTape t i).head = t.head + i := by + induction i with + | zero => rfl + | succ i ih => + rw [wipedTape_succ] + show (((wipedTape t i).write Γw.blank.toΓ).move Dir3.right).head = t.head + (i + 1) + rw [show (((wipedTape t i).write Γw.blank.toΓ).move Dir3.right).head + = ((wipedTape t i).write Γw.blank.toΓ).head + 1 from rfl, + Tape.write_head, ih] + omega + +/-- **What wiping does.** From a head parked at cell `1`, wiping `H` times +blanks exactly cells `1 … H` and leaves every other cell alone. -/ +theorem wipedTape_cells_of_head_one {t : Tape} (hh : t.head = 1) (H j : ℕ) : + (wipedTape t H).cells j = if 1 ≤ j ∧ j ≤ H then Γ.blank else t.cells j := by + induction H with + | zero => rw [wipedTape_zero, if_neg (by omega : ¬(1 ≤ j ∧ j ≤ 0))] + | succ H ih => + have hheadH : (wipedTape t H).head = H + 1 := by rw [wipedTape_head, hh]; omega + rw [wipedTape_succ] + show (((wipedTape t H).write Γw.blank.toΓ).move Dir3.right).cells j = _ + rw [Tape.move_cells, Tape.write, if_neg (by rw [hheadH]; omega)] + show Function.update (wipedTape t H).cells (wipedTape t H).head Γw.blank.toΓ j = _ + rw [hheadH] + by_cases hj : j = H + 1 + · rw [hj, Function.update_self, if_pos ⟨by omega, by omega⟩] + rfl + · rw [Function.update_of_ne hj, ih] + by_cases hc : 1 ≤ j ∧ j ≤ H + · rw [if_pos hc, if_pos ⟨hc.1, by omega⟩] + · have hc' : ¬(1 ≤ j ∧ j ≤ H + 1) := by + rintro ⟨h1, h2⟩ + exact hc ⟨h1, by omega⟩ + rw [if_neg hc, if_neg hc'] + +/-- The canonical blank tape's cells, spelled out. -/ +theorem initNil_cells (j : ℕ) : + (Tape.init ([] : List Γ)).cells j = if j = 0 then Γ.start else Γ.blank := by + cases j with + | zero => exact Tape.init_cells_zero [] + | succ i => rw [Tape.init_cells_ge [] i (by simp), if_neg (Nat.succ_ne_zero i)] + +/-- **Wiping really blanks the tape.** A tape parked at cell `1` whose content +is confined to cells `1 … H` becomes literally the blank tape (head at `H + 1`) +after `H` wipe steps — this is where the content-agnostic wipe pays off: no +assumption is made about *where* inside `1 … H` the nonblank cells sit. -/ +theorem wipedTape_eq_blank {t : Tape} (H : ℕ) (hh : t.head = 1) + (h0 : t.cells 0 = Γ.start) (hfar : ∀ j, H < j → t.cells j = Γ.blank) : + wipedTape t H = (⟨H + 1, (Tape.init ([] : List Γ)).cells⟩ : Tape) := by + refine Tape.ext (by rw [wipedTape_head, hh]; show 1 + H = H + 1; omega) (funext fun j => ?_) + rw [wipedTape_cells_of_head_one hh, initNil_cells] + by_cases hj0 : j = 0 + · rw [hj0, if_neg (by omega : ¬(1 ≤ 0 ∧ 0 ≤ H)), if_pos rfl, h0] + · rw [if_neg hj0] + by_cases hc : 1 ≤ j ∧ j ≤ H + · rw [if_pos hc] + · rw [if_neg hc, hfar j (by omega)] + +/-- Wiping preserves `Parked`-ness: the head only advances, and every +written or untouched cell beyond the marker stays off `▷`. -/ +theorem wipedTape_parked {t : Tape} (h : Parked t) (i : ℕ) : Parked (wipedTape t i) := by + induction i with + | zero => exact h + | succ i ih => + rw [wipedTape_succ] + have hheq : (wipedTape t i).writeAndMove Γw.blank.toΓ Dir3.right = + ((wipedTape t i).write Γw.blank.toΓ).move Dir3.right := rfl + have hhead_ne : (wipedTape t i).head ≠ 0 := by + have := ih.1; omega + refine ⟨?_, fun j hj => ?_⟩ + · rw [hheq] + show 1 ≤ ((wipedTape t i).write Γw.blank.toΓ).head + 1 + omega + · rw [hheq, Tape.move_cells] + simp only [Tape.write, if_neg hhead_ne] + show Function.update (wipedTape t i).cells (wipedTape t i).head Γw.blank.toΓ j ≠ Γ.start + by_cases hje : j = (wipedTape t i).head + · rw [hje, Function.update_self]; decide + · rw [Function.update_of_ne hje]; exact ih.2 j hj + +/-- A fresh output tape (`(Tape.init []).move Dir3.right`) is `Parked`. -/ +theorem parked_parkedBlank : Parked ((Tape.init []).move Dir3.right) := by + refine ⟨le_refl 1, fun j hj => ?_⟩ + rw [Tape.move_cells, show j = (j - 1) + 1 from by omega, + Tape.init_cells_ge [] (j - 1) (by simp)] + decide + +/-- A fresh output tape satisfies the empty output accumulator. -/ +theorem outAcc_nil_of_parkedBlank : + OutAcc [] ((Tape.init []).move Dir3.right) := by + refine ⟨rfl, ?_, nofun, fun j hj => ?_⟩ + · rw [Tape.move_cells]; exact Tape.init_cells_zero [] + · rw [Tape.move_cells, show j = (j - 1) + 1 from by omega, + Tape.init_cells_ge [] (j - 1) (by simp)] + +/-- The only tape satisfying the empty output accumulator is the fresh +parked blank tape. -/ +theorem eq_parkedBlank_of_outAcc_nil {t : Tape} (h : OutAcc [] t) : + t = (Tape.init []).move Dir3.right := by + obtain ⟨hhead, hcell0, -, htail⟩ := h + refine Tape.ext ?_ ?_ + · rw [hhead]; rfl + · rw [Tape.move_cells] + funext j + rcases Nat.eq_zero_or_pos j with hj0 | hj1 + · subst hj0; rw [hcell0, Tape.init_cells_zero] + · rw [htail j (by simpa using hj1), show j = (j - 1) + 1 from by omega, + Tape.init_cells_ge [] (j - 1) (by simp)] + +/-- The register-shaped tape at iteration `i` is `Parked`. -/ +theorem regIterCells_parked (v i : ℕ) : Parked (⟨i + 2, regCells v⟩ : Tape) := by + refine ⟨show 1 ≤ i + 2 by omega, fun j _ => ?_⟩ + show regCells v j ≠ Γ.start + simp only [regCells] + split + · omega + · split <;> decide + +/-- **The wipe loop.** Fueled by a register at `r` holding `v` marks (`r` +disjoint from `targets`), `forRegTM (wipeStepTM targets) r` blanks the leading +`v` cells of every tape in `targets`, leaving every other tape — including the +fuel register itself — exactly as it was. -/ +theorem wipeLoop_hoareTime {n : ℕ} (targets : List (Fin n)) (r : Fin n) + (hr : r ∉ targets) (v : ℕ) (inp₀ : Tape) (work₀ : Fin n → Tape) + (hinp₀ : Parked inp₀) + (hother : ∀ j, j ≠ r → Parked (work₀ j)) : + (forRegTM (wipeStepTM targets) r).HoareTime + (fun inp work out => inp = inp₀ ∧ + work = Function.update work₀ r (regTape v) ∧ + out = (Tape.init []).move Dir3.right) + (fun inp work out => inp = inp₀ ∧ + work = Function.update + (fun j => if j ∈ targets then wipedTape (work₀ j) v else work₀ j) r (regTape v) ∧ + out = (Tape.init []).move Dir3.right) + (v * 3 + (v + 2)) := by + set w : ℕ → Fin n → Tape := fun i j => + if j = r then regTape v else if j ∈ targets then wipedTape (work₀ j) i else work₀ j + with hw + have hw0 : w 0 = Function.update work₀ r (regTape v) := by + funext j + by_cases hjr : j = r + · subst hjr; simp [hw, Function.update_self] + · rw [Function.update_of_ne hjr] + simp only [hw, if_neg hjr] + split + · rfl + · rfl + have hwv : w v = Function.update + (fun j => if j ∈ targets then wipedTape (work₀ j) v else work₀ j) r (regTape v) := by + funext j + by_cases hjr : j = r + · subst hjr; simp [hw, Function.update_self] + · rw [Function.update_of_ne hjr]; simp [hw, if_neg hjr] + have hwork_parked : ∀ i j, j ≠ r → Parked (w i j) := by + intro i j hjr + by_cases hjt : j ∈ targets + · simp only [hw, if_neg hjr, if_pos hjt] + exact wipedTape_parked (hother j hjr) i + · simp only [hw, if_neg hjr, if_neg hjt] + exact hother j hjr + have hbody : ∀ i, i < v → (wipeStepTM targets).HoareTime + (fun inp work out => inp = inp₀ ∧ + work = Function.update (w i) r (⟨i + 2, regCells v⟩ : Tape) ∧ OutAcc [] out) + (fun inp work out => inp = inp₀ ∧ + work = Function.update (w (i + 1)) r (⟨i + 2, regCells v⟩ : Tape) ∧ OutAcc [] out) + 1 := by + intro i _ + set W : Fin n → Tape := Function.update (w i) r (⟨i + 2, regCells v⟩ : Tape) with hW + have hcopy := wipeStepTM_hoareTime targets inp₀ W ((Tape.init []).move Dir3.right) + hinp₀ parked_parkedBlank + (fun k _ => by + by_cases hkr : k = r + · subst hkr; rw [hW, Function.update_self]; exact regIterCells_parked v i + · rw [hW, Function.update_of_ne hkr]; exact hwork_parked i k hkr) + refine (hcopy.weaken_pre ?_).strengthen_post ?_ + · rintro inp work out ⟨rfl, rfl, hout⟩ + exact ⟨rfl, rfl, eq_parkedBlank_of_outAcc_nil hout⟩ + · rintro inp work out ⟨rfl, hout, hwork⟩ + refine ⟨rfl, ?_, hout ▸ outAcc_nil_of_parkedBlank⟩ + funext j + rw [hwork j] + by_cases hjr : j = r + · subst hjr + rw [if_neg hr, hW, Function.update_self, Function.update_self] + · by_cases hjt : j ∈ targets + · rw [if_pos hjt] + have hWj : W j = wipedTape (work₀ j) i := by + rw [hW, Function.update_of_ne hjr, hw]; simp [if_neg hjr, if_pos hjt] + have hRj : Function.update (w (i + 1)) r (⟨i + 2, regCells v⟩ : Tape) j = + wipedTape (work₀ j) (i + 1) := by + rw [Function.update_of_ne hjr, hw]; simp [if_neg hjr, if_pos hjt] + rw [hWj, hRj, wipedTape_succ] + · rw [if_neg hjt] + have hWj : W j = work₀ j := by + rw [hW, Function.update_of_ne hjr, hw]; simp [if_neg hjr, if_neg hjt] + have hRj : Function.update (w (i + 1)) r (⟨i + 2, regCells v⟩ : Tape) j = work₀ j := by + rw [Function.update_of_ne hjr, hw]; simp [if_neg hjr, if_neg hjt] + rw [hWj, hRj] + have key := forRegTM_hoareTime (wipeStepTM targets) r v inp₀ w (fun _ => []) 1 hinp₀ + (fun i => by simp [hw]) hwork_parked hbody + refine key.consequence + (fun inp work out ⟨h1, h2, h3⟩ => ⟨h1, by rw [h2, hw0], h3 ▸ outAcc_nil_of_parkedBlank⟩) + (fun inp work out ⟨h1, h2, h3⟩ => ⟨h1, by rw [h2, hwv], (eq_parkedBlank_of_outAcc_nil h3)⟩) + (by omega) + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/WipeStep.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/WipeStep.lean new file mode 100644 index 0000000000..802cbb0156 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/WipeStep.lean @@ -0,0 +1,110 @@ +/- +Copyright (c) 2026 Bolton Bailey. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Bolton Bailey +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Frame + +/-! +# An unconditional, content-agnostic wipe step + +Reusing an opaque machine's scratch tapes across calls needs them genuinely +blank in between, but an arbitrary machine may leave *gaps* — an isolated blank +cell with more content beyond it — and a content-driven scanner +(`TM.blankWorkTM` stops at the first blank) under-wipes there. `TM.wipeStepTM` +writes `Γ.blank` to every targeted tape and advances, unconditionally, never +reading what it overwrites; iterated a known number of times it blanks an exact +number of cells whatever was there. + +## Main results + +- `TM.wipeStepTM` — blank one cell of every targeted tape and advance +- `TM.wipeStepTM_hoareTime` — its one-step contract +-/ + + +public section + +namespace Complexity + +namespace TM + +/-- Control states of the unconditional wipe-step machine. -/ +inductive WipeStepPhase where + /-- Write blank to every targeted tape and advance; then halt. -/ + | running + /-- Halted. -/ + | done + deriving DecidableEq + +instance instFintypeWipeStepPhase : Fintype WipeStepPhase where + elems := {.running, .done} + complete := fun p => by cases p <;> simp + +/-- One unconditional step: every work tape named in `targets` is written +`Γ.blank` and its head advances right; every other work tape, the input, and +the output are held by `readBackWrite`/`idleDir`. Does not inspect the +targeted tapes' contents at all. -/ +def wipeStepTM {n : ℕ} (targets : List (Fin n)) : TM n where + Q := WipeStepPhase + qstart := .running + qhalt := .done + δ := fun state iHead wHeads oHead => + match state with + | .running => + (.done, + fun i => if i ∈ targets then Γw.blank else readBackWrite (wHeads i), + readBackWrite oHead, idleDir iHead, + fun i => if i ∈ targets then Dir3.right else idleDir (wHeads i), + idleDir oHead) + | .done => allIdle .done iHead wHeads oHead + δ_right_of_start := by + intro state iHead wHeads oHead + match state with + | .running => + refine ⟨idleDir_right_of_start, fun i hi => ?_, idleDir_right_of_start⟩ + dsimp only + split + · rfl + · exact idleDir_right_of_start hi + | .done => exact rightOfStart_allIdle iHead wHeads oHead + +/-- **`wipeStepTM`'s exact one-step Hoare contract.** From tapes where every +non-targeted work tape, the input, and the output are `Parked`, one step +unconditionally blanks and advances every targeted work tape and preserves +everything else exactly. -/ +theorem wipeStepTM_hoareTime {n : ℕ} (targets : List (Fin n)) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hinp : Parked inp₀) (hout : Parked out₀) + (hother : ∀ i, i ∉ targets → Parked (work₀ i)) : + (wipeStepTM targets).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => inp = inp₀ ∧ out = out₀ ∧ + ∀ i, work i = if i ∈ targets then (work₀ i).writeAndMove Γw.blank.toΓ Dir3.right + else work₀ i) + 1 := by + rintro inp work out ⟨rfl, rfl, rfl⟩ + refine ⟨(⟨WipeStepPhase.done, + inp.move (idleDir inp.read), + (fun i => if i ∈ targets then (work i).writeAndMove Γw.blank.toΓ Dir3.right + else (work i).writeAndMove (readBackWrite (work i).read) (idleDir (work i).read)), + out.writeAndMove (readBackWrite out.read) (idleDir out.read)⟩ : + Cfg n (wipeStepTM targets).Q), + 1, le_refl 1, ?_, rfl, hinp.move_idle, hout.writeAndMove_readBack_idle, fun i => ?_⟩ + · refine TM.reachesIn.step ?_ .zero + simp only [TM.step, wipeStepTM, + if_neg (show WipeStepPhase.running ≠ WipeStepPhase.done by decide)] + congr 1 + congr 1 + funext i + split <;> rfl + · dsimp only + split + · rfl + · next hi => exact (hother i hi).writeAndMove_readBack_idle + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Tape.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Tape.lean new file mode 100644 index 0000000000..131be9cd6b --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Tape.lean @@ -0,0 +1,9 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Tape.Encoding + +/-! Supporting modules for Beyond the Bethe approximation of the permanent. -/ diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Tape/Encoding.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Tape/Encoding.lean new file mode 100644 index 0000000000..55c5b21dc7 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Tape/Encoding.lean @@ -0,0 +1,402 @@ +/- +Copyright (c) 2025 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine + +/-! +# Binary string encodings on Turing-machine tapes + +Generic predicates and lemmas for tapes containing canonical binary strings. +`Tape.HasBinaryPrefix` describes a string being written from left to right, +`Tape.HasBinaryString` describes the same contents after rewinding the head to +cell one, `Tape.HasBinaryContent` forgets the head while an in-place arithmetic +cursor moves, and `Tape.HasBinarySuffix` describes a read cursor at the +beginning of a remaining suffix. These shapes are shared by deterministic and +nondeterministic machine constructions. +-/ + + +@[expose] public section + +namespace Complexity + +namespace Tape + +/-- A tape while a binary string is being written: cells `1..|bits|` contain + the bits, the head is at the next cell, and the remaining tail is blank. -/ +def HasBinaryPrefix (t : Tape) (bits : List Bool) : Prop := + t.head = bits.length + 1 ∧ + (∀ i, (h : i < bits.length) → t.cells (i + 1) = Γ.ofBool (bits[i]'h)) ∧ + (∀ i, bits.length ≤ i → t.cells (i + 1) = Γ.blank) + +/-- A completed binary string: the bits are present and the head has been + rewound to cell one. -/ +def HasBinaryString (t : Tape) (bits : List Bool) : Prop := + t.head = 1 ∧ + (∀ i, (h : i < bits.length) → t.cells (i + 1) = Γ.ofBool (bits[i]'h)) ∧ + (∀ i, bits.length ≤ i → t.cells (i + 1) = Γ.blank) + +/-- Canonical binary contents independently of the tape head. This is the +stable invariant for in-place arithmetic cursors that scan and rewind. -/ +def HasBinaryContent (t : Tape) (bits : List Bool) : Prop := + (∀ i, (h : i < bits.length) → t.cells (i + 1) = Γ.ofBool (bits[i]'h)) ∧ + ∀ i, bits.length ≤ i → t.cells (i + 1) = Γ.blank + +/-- A read cursor at the beginning of a remaining binary suffix. The suffix +starts under the current off-marker head, is followed immediately by blank, +and the tape has no stray left markers. -/ +def HasBinarySuffix (t : Tape) (bits : List Bool) : Prop := + t.head ≥ 1 ∧ + (∀ i, (h : i < bits.length) → + t.cells (t.head + i) = Γ.ofBool (bits[i]'h)) ∧ + t.cells (t.head + bits.length) = Γ.blank ∧ + (∀ j, j ≥ 1 → t.cells j ≠ Γ.start) + +/-- A completed binary string whose length is at most `B`. -/ +def HasBoundedBinaryString (t : Tape) (B : ℕ) : Prop := + ∃ bits : List Bool, bits.length ≤ B ∧ t.HasBinaryString bits + +/-- A completed binary string has the same canonical contents after forgetting +its parked head. -/ +theorem HasBinaryString.hasBinaryContent {t : Tape} {bits : List Bool} + (h : t.HasBinaryString bits) : t.HasBinaryContent bits := + h.2 + +/-- Canonical contents become a completed binary string when the head is at +cell one. -/ +theorem HasBinaryContent.hasBinaryString {t : Tape} {bits : List Bool} + (h : t.HasBinaryContent bits) (hhead : t.head = 1) : + t.HasBinaryString bits := + ⟨hhead, h⟩ + +/-- Moving a cursor preserves its canonical binary contents. -/ +theorem HasBinaryContent.move {t : Tape} {bits : List Bool} + (h : t.HasBinaryContent bits) (dir : Dir3) : + (t.move dir).HasBinaryContent bits := by + simpa only [HasBinaryContent, Tape.move_cells] using h + +/-- Canonical binary contents contain no stray left marker after cell zero. -/ +theorem HasBinaryContent.cells_ne_start {t : Tape} {bits : List Bool} + (h : t.HasBinaryContent bits) : + ∀ j, 1 ≤ j → t.cells j ≠ Γ.start := by + intro j hj + let i := j - 1 + have hji : j = i + 1 := by omega + by_cases hi : i < bits.length + · rw [hji, h.1 i hi] + exact Γ.ofBool_ne_start _ + · rw [hji, h.2 i (Nat.le_of_not_gt hi)] + decide + +/-- Overwriting one in-range binary cell preserves canonical contents and +updates exactly that bit. -/ +theorem HasBinaryContent.write_set {t : Tape} {bits : List Bool} + {i : ℕ} (bit : Bool) (h : t.HasBinaryContent bits) + (hhead : t.head = i + 1) (hi : i < bits.length) : + (t.write (Γ.ofBool bit)).HasBinaryContent (bits.set i bit) := by + rcases h with ⟨hbits, htail⟩ + have hhead0 : ¬t.head = 0 := by omega + constructor + · intro j hj + rw [Tape.write, if_neg hhead0] + simp only + rw [List.length_set] at hj + rw [hhead] + by_cases hij : i = j + · subst j + rw [Function.update_self, List.getElem_set] + simp + · have hne : i + 1 ≠ j + 1 := by omega + rw [Function.update_of_ne (Ne.symm hne), hbits j hj, + List.getElem_set] + simp [hij] + · intro j hj + rw [Tape.write, if_neg hhead0] + simp only + rw [List.length_set] at hj + rw [hhead] + have hne : i + 1 ≠ j + 1 := by omega + rw [Function.update_of_ne (Ne.symm hne)] + exact htail j hj + +/-- Writing away from cell zero and then moving preserves the left marker. -/ +theorem write_move_cell0 {t : Tape} (symbol : Γ) (dir : Dir3) + (h0 : t.cells 0 = Γ.start) : + ((t.write symbol).move dir).cells 0 = Γ.start := by + rw [Tape.move_cells, Tape.write] + split + · exact h0 + · simp only + rw [Function.update_of_ne (by omega)] + exact h0 + +/-- A completed binary tape encodes exactly `bits` as its output string. -/ +theorem hasOutput_of_hasBinaryString {t : Tape} {bits : List Bool} + (h : t.HasBinaryString bits) : t.HasOutput bits := + ⟨h.2.1, h.2.2 bits.length le_rfl⟩ + +/-- A completed binary tape never contains `▷` after the left-end marker. -/ +theorem cells_ne_start_of_hasBinaryString {t : Tape} {bits : List Bool} + (h : t.HasBinaryString bits) : + ∀ j, j ≥ 1 → t.cells j ≠ Γ.start := by + intro j hj + let i := j - 1 + have hj_eq : j = i + 1 := by omega + by_cases hi : i < bits.length + · rw [hj_eq, h.2.1 i hi] + cases bits[i]'hi <;> simp [Γ.ofBool] + · have hge : bits.length ≤ i := by omega + rw [hj_eq, h.2.2 i hge] + decide + +/-- A completed binary tape with the left marker at cell `0` is exactly the + standard initialized tape for those bits, moved to cell `1`. -/ +theorem eq_init_move_right_of_hasBinaryString {t : Tape} {bits : List Bool} + (h : t.HasBinaryString bits) (h0 : t.cells 0 = Γ.start) : + t = (Tape.init (bits.map Γ.ofBool)).move Dir3.right := by + cases t with + | mk head cells => + simp only [HasBinaryString] at h + rcases h with ⟨hhead, hbits, htail⟩ + simp only at h0 hbits htail + subst head + simp only [Tape.move] + congr + funext j + by_cases hj0 : j = 0 + · subst hj0 + simp [Tape.init, h0] + · let i := j - 1 + have hj : j = i + 1 := by omega + rw [hj] + by_cases hi : i < bits.length + · rw [hbits i hi, Tape.init_ofBool_cells_lt bits i hi] + · have hge : bits.length ≤ i := by omega + rw [htail i hge, Tape.init_ofBool_cells_ge bits i hge] + +/-- A binary prefix with the left marker at cell zero has exactly the +canonical initialized cell contents, independently of its current head. -/ +theorem HasBinaryPrefix.cells_eq_init {t : Tape} {bits : List Bool} + (h : t.HasBinaryPrefix bits) (h0 : t.cells 0 = Γ.start) : + t.cells = (Tape.init (bits.map Γ.ofBool)).cells := by + funext j + cases j with + | zero => simpa using h0 + | succ i => + by_cases hi : i < bits.length + · rw [h.2.1 i hi, Tape.init_ofBool_cells_lt bits i hi] + · have hge : bits.length ≤ i := by omega + rw [h.2.2 i hge, Tape.init_ofBool_cells_ge bits i hge] + +/-- Bounded completed binary tapes expose exact initialized tape shape for + some string whose length satisfies the same bound. -/ +theorem exists_eq_init_move_right_of_hasBoundedBinaryString {t : Tape} {B : ℕ} + (h : t.HasBoundedBinaryString B) (h0 : t.cells 0 = Γ.start) : + ∃ bits : List Bool, bits.length ≤ B ∧ + t = (Tape.init (bits.map Γ.ofBool)).move Dir3.right := by + obtain ⟨bits, hlen, hbits⟩ := h + exact ⟨bits, hlen, eq_init_move_right_of_hasBinaryString hbits h0⟩ + +/-- A freshly initialized empty tape, moved right past `▷`, is an empty + binary prefix. -/ +theorem init_nil_move_right_hasBinaryPrefix_nil : + ((Tape.init []).move Dir3.right).HasBinaryPrefix [] := by + simp [HasBinaryPrefix, Tape.init, Tape.move] + +/-- A standard initialized binary tape moved right to its first data cell is +a completed binary string. -/ +theorem init_move_right_hasBinaryString (bits : List Bool) : + ((Tape.init (bits.map Γ.ofBool)).move Dir3.right).HasBinaryString bits := by + refine ⟨by simp [Tape.move], ?_, ?_⟩ + · intro i hi + exact Tape.init_ofBool_cells_lt bits i hi + · intro i hi + exact Tape.init_ofBool_cells_ge bits i hi + +/-- The head of an appendable binary prefix reads its first trailing blank. -/ +theorem HasBinaryPrefix.read_blank {t : Tape} {bits : List Bool} + (h : t.HasBinaryPrefix bits) : t.read = Γ.blank := by + rw [Tape.read, h.1] + exact h.2.2 bits.length le_rfl + +/-- An appendable binary prefix already contains the advertised delimited +output, independently of its current head. -/ +theorem HasBinaryPrefix.hasOutput {t : Tape} {bits : List Bool} + (h : t.HasBinaryPrefix bits) : t.HasOutput bits := + ⟨h.2.1, h.2.2 bits.length le_rfl⟩ + +/-- A freshly initialized binary tape starts with its whole string as the +remaining suffix. -/ +theorem init_move_right_hasBinarySuffix (bits : List Bool) : + ((Tape.init (bits.map Γ.ofBool)).move Dir3.right).HasBinarySuffix bits := by + refine ⟨by simp [Tape.move, Tape.init], ?_, ?_, ?_⟩ + · intro i hi + simpa [Tape.move, Tape.init, Nat.add_comm] using + Tape.init_ofBool_cells_lt bits i hi + · simp [Tape.move, Tape.init, Nat.add_comm] + · intro j hj + simp [Tape.move] + exact Tape.init_ofBool_cells_ne_start bits j hj + +/-- A completed binary string exposes the same bits as its remaining suffix. -/ +theorem HasBinaryString.hasBinarySuffix {t : Tape} {bits : List Bool} + (h : t.HasBinaryString bits) : t.HasBinarySuffix bits := by + refine ⟨by rw [h.1], ?_, ?_, cells_ne_start_of_hasBinaryString h⟩ + · intro i hi + rw [h.1] + simpa [Nat.add_comm] using h.2.1 i hi + · rw [h.1] + simpa [Nat.add_comm] using h.2.2 bits.length le_rfl + +/-- A delimited output parked at cell one is a binary suffix cursor when the +tape has no stray left-end markers. -/ +theorem HasOutput.hasBinarySuffix {t : Tape} {bits : List Bool} + (h : t.HasOutput bits) (hhead : t.head = 1) (hinv : t.StartInvariant) : + t.HasBinarySuffix bits := by + refine ⟨by rw [hhead], ?_, ?_, hinv.2⟩ + · intro i hi + simpa [hhead, Nat.add_comm] using h.1 i hi + · simpa [hhead, Nat.add_comm] using h.2 + +/-- The first symbol of a nonempty binary suffix is under the tape head. -/ +theorem HasBinarySuffix.read_cons {t : Tape} {bit : Bool} {bits : List Bool} + (h : t.HasBinarySuffix (bit :: bits)) : + t.read = Γ.ofBool bit := by + have hzero := h.2.1 0 (by simp) + simpa [Tape.read] using hzero + +/-- Moving right after reading the first bit exposes the remaining suffix. -/ +theorem HasBinarySuffix.move_right_cons {t : Tape} {bit : Bool} + {bits : List Bool} (h : t.HasBinarySuffix (bit :: bits)) : + (t.move Dir3.right).HasBinarySuffix bits := by + refine ⟨by simp [Tape.move], ?_, ?_, ?_⟩ + · intro i hi + have hcell := h.2.1 (i + 1) (by simpa using hi) + simpa [Tape.move, Nat.add_assoc, Nat.add_comm, Nat.add_left_comm] using hcell + · have hcell := h.2.2.1 + simpa [Tape.move, Nat.add_assoc, Nat.add_comm, Nat.add_left_comm] using hcell + · intro j hj + simpa [Tape.move_cells] using h.2.2.2 j hj + +/-- An empty remaining suffix reads the terminating blank. -/ +theorem HasBinarySuffix.read_nil {t : Tape} (h : t.HasBinarySuffix []) : + t.read = Γ.blank := by + simpa [Tape.read] using h.2.2.1 + +/-- A binary suffix cursor never reads the left-end marker. -/ +theorem HasBinarySuffix.read_ne_start {t : Tape} {bits : List Bool} + (h : t.HasBinarySuffix bits) : t.read ≠ Γ.start := + h.2.2.2 t.head h.1 + +/-- Writing the next bit extends a binary prefix by one cell. -/ +theorem hasBinaryPrefix_write_bit {t : Tape} {bits : List Bool} (bit : Bool) + (h : t.HasBinaryPrefix bits) : + (t.writeAndMove (Γ.ofBool bit) Dir3.right).HasBinaryPrefix (bits ++ [bit]) := by + refine ⟨?_, ?_, ?_⟩ + · simp [Tape.writeAndMove, Tape.write, Tape.move, h.1] + · intro i hi + unfold Tape.writeAndMove + simp only [Tape.move] + unfold Tape.write + have hhead_ne : ¬t.head = 0 := by rw [h.1]; omega + simp only [hhead_ne, ↓reduceIte] + by_cases hidx : i = bits.length + · have hcellidx : i + 1 = t.head := by rw [h.1, hidx] + have hget : (bits ++ [bit])[i]'hi = bit := by + subst hidx + simp + rw [hcellidx, Function.update_self, hget] + · have hi_bits : i < bits.length := by + rw [List.length_append, List.length_singleton] at hi + omega + have hcell := h.2.1 i hi_bits + have hget : (bits ++ [bit])[i]'hi = bits[i]'hi_bits := by + exact List.getElem_append_left (as := bits) (bs := [bit]) hi_bits + have hne : t.head ≠ i + 1 := by rw [h.1]; omega + rw [Function.update_of_ne (Ne.symm hne), hcell, hget] + · intro i hi + unfold Tape.writeAndMove + simp only [Tape.move] + unfold Tape.write + have hhead_ne : ¬t.head = 0 := by rw [h.1]; omega + simp only [hhead_ne, ↓reduceIte] + have hne : t.head ≠ i + 1 := by + rw [List.length_append, List.length_singleton] at hi + rw [h.1] + omega + rw [Function.update_of_ne (Ne.symm hne)] + exact h.2.2 i (by + rw [List.length_append, List.length_singleton] at hi + omega) + +/-- Writing at the first blank appends one canonical binary cell. -/ +theorem HasBinaryContent.write_append {t : Tape} {bits : List Bool} + (bit : Bool) (h : t.HasBinaryContent bits) + (hhead : t.head = bits.length + 1) : + (t.write (Γ.ofBool bit)).HasBinaryContent (bits ++ [bit]) := by + have hprefix : t.HasBinaryPrefix bits := ⟨hhead, h⟩ + exact (hasBinaryPrefix_write_bit bit hprefix).2 + +/-- Writing the next bit preserves the left-end marker cell. -/ +theorem hasBinaryPrefix_write_bit_cell0 {t : Tape} {bits : List Bool} (bit : Bool) + (h : t.HasBinaryPrefix bits) (h0 : t.cells 0 = Γ.start) : + (t.writeAndMove (Γ.ofBool bit) Dir3.right).cells 0 = Γ.start := by + unfold Tape.writeAndMove + rw [Tape.move_cells] + unfold Tape.write + have hhead_ne : ¬t.head = 0 := by rw [h.1]; omega + simp only [hhead_ne, ↓reduceIte] + have hne : t.head ≠ 0 := by rw [h.1]; omega + rw [Function.update_of_ne (Ne.symm hne)] + exact h0 + +/-- A binary prefix never contains `▷` after the left-end marker. -/ +theorem cells_ne_start_of_hasBinaryPrefix {t : Tape} {bits : List Bool} + (h : t.HasBinaryPrefix bits) : + ∀ j, j ≥ 1 → t.cells j ≠ Γ.start := by + intro j hj + let i := j - 1 + have hj_eq : j = i + 1 := by omega + by_cases hi : i < bits.length + · rw [hj_eq, h.2.1 i hi] + cases bits[i]'hi <;> simp [Γ.ofBool] + · have hge : bits.length ≤ i := by omega + rw [hj_eq, h.2.2 i hge] + decide + +/-- Moving a completed binary string's head to the first blank, without + changing its cells, yields the corresponding appendable prefix. -/ +theorem hasBinaryPrefix_of_hasBinaryString {t t' : Tape} {bits : List Bool} + (hstring : t.HasBinaryString bits) + (hhead : t'.head = bits.length + 1) + (hcells : t'.cells = t.cells) : + t'.HasBinaryPrefix bits := by + refine ⟨hhead, ?_, ?_⟩ + · intro i hi + rw [hcells] + exact hstring.2.1 i hi + · intro i hi + rw [hcells] + exact hstring.2.2 i hi + +/-- Rewinding a binary prefix to cell one yields a completed binary string. -/ +theorem hasBinaryString_of_hasBinaryPrefix {t t' : Tape} {bits : List Bool} + (hprefix : t.HasBinaryPrefix bits) + (hhead : t'.head = 1) + (hcells : t'.cells = t.cells) : + t'.HasBinaryString bits := by + refine ⟨hhead, ?_, ?_⟩ + · intro i hi + rw [hcells] + exact hprefix.2.1 i hi + · intro i hi + rw [hcells] + exact hprefix.2.2 i hi + +end Tape + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/WorkReadOnly.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/WorkReadOnly.lean new file mode 100644 index 0000000000..64dbc00a7d --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/WorkReadOnly.lean @@ -0,0 +1,95 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.Internal.Generic + +/-! +# Read-only work-tape certificates + +`TM.WorkReadOnly tm idx` records the local syntactic fact that every transition +of `tm` writes the symbol already read on work tape `idx`. The head may move, +but valid tape contents are preserved through every finite run. +-/ + + +@[expose] public section + +namespace Complexity + +namespace TM + +/-- Every transition writes back the symbol read on the selected work tape. -/ +def WorkReadOnly (tm : TM n) (idx : Fin n) : Prop := + ∀ state inputHead workHeads outputHead, + state ≠ tm.qhalt → + (tm.δ state inputHead workHeads outputHead).2.1 idx = + readBackWrite (workHeads idx) + +/-- A read-only transition preserves all cells of a valid selected tape. -/ +theorem WorkReadOnly.cells_eq_of_step {tm : TM n} {idx : Fin n} + (hreadonly : tm.WorkReadOnly idx) {c c' : Cfg n tm.Q} + (hstep : tm.step c = some c') + (hnostart : ∀ j, 1 ≤ j → (c.work idx).cells j ≠ Γ.start) : + (c'.work idx).cells = (c.work idx).cells := by + have hne := state_ne_qhalt_of_step hstep + simp only [step, hne, ↓reduceIte, Option.some.injEq] at hstep + subst c' + change + ((c.work idx).writeAndMove + ((tm.δ c.state c.input.read (fun i => (c.work i).read) + c.output.read).2.1 idx).toΓ + ((tm.δ c.state c.input.read (fun i => (c.work i).read) + c.output.read).2.2.2.2.1 idx)).cells = (c.work idx).cells + rw [hreadonly _ _ _ _ hne] + apply tape_readBackWrite_preserves + by_cases hhead : (c.work idx).head = 0 + · exact Or.inl hhead + · exact Or.inr (by + apply hnostart + omega) + +/-- A read-only work tape retains its complete cell function through an exact +finite run. -/ +theorem WorkReadOnly.cells_eq_of_reachesIn {tm : TM n} {idx : Fin n} + (hreadonly : tm.WorkReadOnly idx) {time : ℕ} {start final : Cfg n tm.Q} + (hreach : tm.reachesIn time start final) + (hnostart : ∀ j, 1 ≤ j → (start.work idx).cells j ≠ Γ.start) : + (final.work idx).cells = (start.work idx).cells := by + induction hreach with + | zero => rfl + | step hstep _ ih => + have hcells := hreadonly.cells_eq_of_step hstep hnostart + apply Eq.trans (ih ?_) hcells + intro j hj + rw [hcells] + exact hnostart j hj + +/-- Sequential composition preserves a shared read-only work tape. -/ +theorem WorkReadOnly.seqTM {first second : TM n} {idx : Fin n} + (hfirst : first.WorkReadOnly idx) + (hsecond : second.WorkReadOnly idx) : + (seqTM first second).WorkReadOnly idx := by + intro state inputHead workHeads outputHead hstate + cases state with + | inl state => + unfold Complexity.TM.seqTM + dsimp only + split + · rfl + · next hne => exact hfirst state inputHead workHeads outputHead hne + | inr state => + unfold Complexity.TM.seqTM + dsimp only + split + · next heq => + subst state + exact (hstate rfl).elim + · next hne => exact hsecond state inputHead workHeads outputHead hne + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/SAT.lean b/LeanPool/BeyondBethe/Complexitylib/SAT.lean new file mode 100644 index 0000000000..220779705e --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/SAT.lean @@ -0,0 +1,15 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.Complexitylib.SAT.Encoding +import LeanPool.BeyondBethe.Complexitylib.SAT.Language +import LeanPool.BeyondBethe.Complexitylib.SAT.Rename +import LeanPool.BeyondBethe.Complexitylib.SAT.Semantics +import LeanPool.BeyondBethe.Complexitylib.SAT.ThreeCNF +import LeanPool.BeyondBethe.Complexitylib.SAT.ThreeSAT +import LeanPool.BeyondBethe.Complexitylib.SAT.Verifier + +/-! Supporting modules for Beyond the Bethe approximation of the permanent. -/ diff --git a/LeanPool/BeyondBethe/Complexitylib/SAT/Encoding.lean b/LeanPool/BeyondBethe/Complexitylib/SAT/Encoding.lean new file mode 100644 index 0000000000..e342a817f5 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/SAT/Encoding.lean @@ -0,0 +1,299 @@ +/- +Copyright (c) 2025 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.SAT.Semantics +public import Mathlib.Tactic.Ring.RingNF +public import Std.Tactic.BVDecide.Normalize.Prop + +/-! +# SAT: Encoding Layer + +This file pins down how CNFs and literals are written as `List Bool`, which +is the bit-string format that the TM verifier will actually parse. + +## Format summary + +``` + data bit b ↦ [b, b] (doubled) + literal separator "|" ↦ [false, true] (one undoubled pair) + clause separator "#" ↦ [true, false] (one undoubled pair) +``` + +- A variable index `v : ℕ` is encoded **in unary** as `replicate v true` — + that is, `v` consecutive `1`-bits. `Unary.encode 0 = []`. + Unary is chosen (over binary) so that `|encode v| ≥ v`, which makes + `maxVar φ ≤ |φ.encode|` automatic. This is what powers the + `PolyBalanced` step in the NP-membership proof. +- A literal `(sign, var)` is encoded as `[sign] ++ Unary.encode var` — + call this the *raw* literal encoding (a list of single bits). +- A clause is a list of raw-encoded literals, each *doubled* bit-by-bit, + separated (and terminated) by `|`. An empty clause is the empty list. +- A CNF is a list of encoded clauses, each terminated by `#`. An empty + CNF is the empty list. + +Inside a clause, every bit is doubled, so the only pairs that appear are +`00`, `11` (data), `01` (lit sep), `10` (clause sep). The four patterns +cover all four two-bit combinations and are mutually exclusive, giving a +well-defined token stream for any valid encoding. + +## Why this format + +- `|` and `#` can't collide with data because all data bits are doubled. +- No length prefixes — parsing is a single pass over the input. +- Unary variables give `|encodeRaw ℓ| = ℓ.var + 1`, which propagates to + `maxVar φ ≤ |φ.encode|` (key for `PolyBalanced`). +- Distinguishes `[]` (true CNF) from `[[]]` (one unsatisfiable clause): + the former encodes to `[]`, the latter to `[true, false]`. + +The matching executable decoder `CNF.decode?`, its round-trip theorem, and its +soundness theorem live with the token parser in `Complexitylib.SAT.Verifier`. +-/ + + +@[expose] public section + +namespace Complexity + +namespace SAT + +-- ════════════════════════════════════════════════════════════════════════ +-- Unary encoding of natural numbers (used for variable indices) +-- ════════════════════════════════════════════════════════════════════════ + +namespace Unary + +/-- Unary encoding of `n`: `n` consecutive `true` bits. `encode 0 = []`. -/ +def encode (n : Nat) : List Bool := List.replicate n true + +/-- The unary encoding of `n` has length exactly `n`. -/ +@[simp] theorem length_encode (n : Nat) : (encode n).length = n := by + simp [encode] + +/-- Zero encodes to the empty bit list. -/ +@[simp] theorem encode_zero : encode 0 = [] := rfl + +/-- Every bit in a unary encoding is `true`. -/ +theorem encode_all_true (n : Nat) : ∀ b ∈ encode n, b = true := by + intro b hb + simp [encode, List.mem_replicate] at hb + exact hb.2 + +end Unary + +-- ════════════════════════════════════════════════════════════════════════ +-- Literal raw encoding: sign bit + unary var +-- ════════════════════════════════════════════════════════════════════════ + +namespace Lit + +/-- Raw literal encoding: `[sign] ++ unary(var)`. Produces a list of + single (undoubled) bits; the doubling happens at the clause level. -/ +def encodeRaw (ℓ : Lit) : List Bool := ℓ.sign :: Unary.encode ℓ.var + +/-- The raw literal encoding has length `ℓ.var + 1`: one sign bit plus a unary var. -/ +@[simp] theorem encodeRaw_length (ℓ : Lit) : ℓ.encodeRaw.length = ℓ.var + 1 := by + simp [encodeRaw] + +/-- The raw encoding of a literal has `ℓ.var ≤ |encodeRaw| - 1`. Key for + `maxVar ≤ |encode|`. -/ +theorem var_lt_encodeRaw_length (ℓ : Lit) : ℓ.var < ℓ.encodeRaw.length := by + simp + +/-- The raw literal encoding is injective: sign and var are recoverable. -/ +theorem encodeRaw_injective : Function.Injective Lit.encodeRaw := by + rintro ⟨s₁, v₁⟩ ⟨s₂, v₂⟩ h + have hlen : v₁ + 1 = v₂ + 1 := by + have := congrArg List.length h + simpa using this + have hvar : v₁ = v₂ := by omega + subst hvar + have hsign : s₁ = s₂ := by simpa [encodeRaw] using h + subst hsign + rfl + +end Lit + +-- ════════════════════════════════════════════════════════════════════════ +-- Bit doubling +-- ════════════════════════════════════════════════════════════════════════ + +/-- Double each bit: `b ↦ [b, b]`. The image consists only of `00` and `11` + two-bit patterns, so `01` and `10` cannot appear in doubled data. -/ +def doubleBits (bs : List Bool) : List Bool := bs.flatMap (fun b => [b, b]) + +/-- Doubling the empty bit list yields the empty list. -/ +@[simp] theorem doubleBits_nil : doubleBits [] = [] := rfl + +/-- Doubling a cons prepends the head bit twice: `doubleBits (b :: bs) = b :: b :: …`. -/ +@[simp] theorem doubleBits_cons (b : Bool) (bs : List Bool) : + doubleBits (b :: bs) = b :: b :: doubleBits bs := by + simp [doubleBits] + +/-- Doubling exactly doubles the length: `|doubleBits bs| = 2 * |bs|`. -/ +@[simp] theorem doubleBits_length (bs : List Bool) : + (doubleBits bs).length = 2 * bs.length := by + induction bs with + | nil => rfl + | cons b bs ih => simp [ih]; ring + +-- ════════════════════════════════════════════════════════════════════════ +-- Clause and CNF encoding +-- ════════════════════════════════════════════════════════════════════════ + +namespace Clause + +/-- Encoded clause: each literal's raw bits doubled, followed by `[0,1]`. -/ +def encode : Clause → List Bool + | [] => [] + | ℓ :: ℓs => doubleBits ℓ.encodeRaw ++ [false, true] ++ encode ℓs + +/-- The empty clause encodes to the empty bit list. -/ +@[simp] theorem encode_nil : encode ([] : Clause) = [] := rfl + +/-- Unfolding lemma: encoding `ℓ :: ℓs` emits the doubled raw literal, + the `[false, true]` literal separator, then the encoded tail. -/ +theorem encode_cons (ℓ : Lit) (ℓs : Clause) : + encode (ℓ :: ℓs) = doubleBits ℓ.encodeRaw ++ [false, true] ++ encode ℓs := rfl + +/-- Length bound on the encoded clause: each literal contributes at most + `2 * |encodeRaw| + 2` bits (doubling + separator). -/ +theorem length_encode (c : Clause) : + c.encode.length = c.foldr (fun ℓ acc => 2 * ℓ.encodeRaw.length + 2 + acc) 0 := by + induction c with + | nil => rfl + | cons ℓ ℓs ih => + simp only [encode_cons, List.length_append, List.length_cons, List.length_nil, + doubleBits_length, List.foldr_cons, ih] + +end Clause + +namespace CNF + +/-- Encoded CNF: each clause followed by `[1,0]`. -/ +def encode : CNF → List Bool + | [] => [] + | c :: cs => c.encode ++ [true, false] ++ encode cs + +/-- The empty CNF encodes to the empty bit list. -/ +@[simp] theorem encode_nil : encode ([] : CNF) = [] := rfl + +/-- Unfolding lemma: encoding `c :: cs` emits the encoded clause, the + `[true, false]` clause separator, then the encoded tail. -/ +theorem encode_cons (c : Clause) (cs : CNF) : + encode (c :: cs) = c.encode ++ [true, false] ++ encode cs := rfl + +/-- Length bound: each clause contributes `|c.encode| + 2` bits to the CNF. -/ +theorem length_encode (φ : CNF) : + φ.encode.length = φ.foldr (fun c acc => c.encode.length + 2 + acc) 0 := by + induction φ with + | nil => rfl + | cons c cs ih => + simp only [encode_cons, List.length_append, List.length_cons, List.length_nil, ih, + List.foldr_cons] + +/-- `CNF.encode` is a `++`-homomorphism — the per-family reduction emitters + compose by output concatenation. -/ +theorem encode_append (φ ψ : CNF) : encode (φ ++ ψ) = encode φ ++ encode ψ := by + induction φ with + | nil => rfl + | cons c cs ih => + rw [List.cons_append, encode_cons, encode_cons, ih] + simp [List.append_assoc] + +end CNF + +/-- Doubling a run of `true`s doubles its length. -/ +theorem doubleBits_replicate_true (v : ℕ) : + doubleBits (List.replicate v true) = List.replicate (2 * v) true := by + induction v with + | zero => rfl + | succ v ih => + rw [List.replicate_succ, doubleBits_cons, ih, + show 2 * (v + 1) = (2 * v + 1) + 1 from by omega, + List.replicate_succ, List.replicate_succ] + +/-- The encoded form of one literal inside a clause: doubled sign, doubled + unary variable index, separator — exactly the word the reduction's + literal emitter appends. -/ +theorem Clause.encode_cons' (ℓ : Lit) (ℓs : Clause) : + Clause.encode (ℓ :: ℓs) + = ([ℓ.sign, ℓ.sign] ++ List.replicate (2 * ℓ.var) true ++ [false, true]) + ++ Clause.encode ℓs := by + rw [Clause.encode_cons, Lit.encodeRaw, Unary.encode, doubleBits_cons, + doubleBits_replicate_true] + simp [List.append_assoc] + +-- ════════════════════════════════════════════════════════════════════════ +-- maxVar ≤ |encode| (the key bound for PolyBalanced) +-- ════════════════════════════════════════════════════════════════════════ +-- +-- With unary variables, each literal `ℓ` contributes `2 * (ℓ.var + 1)` bits +-- to its doubled block, so `ℓ.var ≤ |c.encode|` and hence `c.maxVar ≤ |c.encode|`, +-- and `φ.maxVar ≤ |φ.encode|`. + +namespace Clause + +/-- Every variable in a clause has index `≤ |c.encode|`. Immediate from unary. -/ +theorem maxVar_le_encode_length (c : Clause) : c.maxVar ≤ c.encode.length := by + induction c with + | nil => simp + | cons ℓ ℓs ih => + simp only [maxVar_cons, encode_cons, List.length_append, List.length_cons, List.length_nil, + doubleBits_length, Lit.encodeRaw_length] + have h_var : ℓ.var ≤ 2 * (ℓ.var + 1) + 2 + (Clause.encode ℓs).length := by omega + have h_tail : Clause.maxVar ℓs ≤ 2 * (ℓ.var + 1) + 2 + (Clause.encode ℓs).length := + le_trans ih (by omega) + exact max_le h_var h_tail + +end Clause + +namespace CNF + +/-- **Key bound for `PolyBalanced`.** Every variable mentioned in `φ` has + index at most `|φ.encode|`. Hence any satisfying assignment `α` (with + unused positions truncated) has length at most `|φ.encode| + 1`. -/ +theorem maxVar_le_encode_length (φ : CNF) : φ.maxVar ≤ φ.encode.length := by + induction φ with + | nil => simp + | cons c cs ih => + simp only [maxVar_cons, encode_cons, List.length_append, List.length_cons, List.length_nil] + have h_c : c.maxVar ≤ c.encode.length + 2 + (CNF.encode cs).length := + le_trans c.maxVar_le_encode_length (by omega) + have h_tail : CNF.maxVar cs ≤ c.encode.length + 2 + (CNF.encode cs).length := + le_trans ih (by omega) + exact max_le h_c h_tail + +end CNF + +-- ════════════════════════════════════════════════════════════════════════ +-- Lemmas about doubled data: only `00` and `11` appear +-- ════════════════════════════════════════════════════════════════════════ + +/-- `doubleBits bs` contains no `[false, true]` or `[true, false]` pair at + an even-index boundary. Concretely: every pair `(b_{2k}, b_{2k+1})` in + `doubleBits bs` has `b_{2k} = b_{2k+1}`. -/ +theorem doubleBits_pair_eq (bs : List Bool) (k : Nat) (h : 2 * k + 1 < (doubleBits bs).length) : + (doubleBits bs)[2 * k]? = (doubleBits bs)[2 * k + 1]? := by + induction bs generalizing k with + | nil => simp at h + | cons b bs ih => + match k with + | 0 => simp [doubleBits_cons] + | k + 1 => + simp only [doubleBits_cons, List.length_cons] at h + have h2 : 2 * k + 1 < (doubleBits bs).length := by omega + have ih' := ih k h2 + show (b :: b :: doubleBits bs)[2 * (k + 1)]? = (b :: b :: doubleBits bs)[2 * (k + 1) + 1]? + have e1 : 2 * (k + 1) = (2 * k) + 2 := by ring + have e2 : 2 * (k + 1) + 1 = (2 * k + 1) + 2 := by ring + rw [e2, e1] + simp only [List.getElem?_cons_succ] + exact ih' + +end SAT + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/SAT/Language.lean b/LeanPool/BeyondBethe/Complexitylib/SAT/Language.lean new file mode 100644 index 0000000000..3c9e9871f6 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/SAT/Language.lean @@ -0,0 +1,154 @@ +/- +Copyright (c) 2025 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.SAT.Encoding +public import LeanPool.BeyondBethe.Complexitylib.Classes.NP.Witness + +/-! +# SAT: Language and Witness Relation + +This file defines the formal SAT language `language` and the NP witness +relation `Witness`, and proves the two core bridge theorems: + +- `mem_language_iff_witness` — `z ∈ language ↔ ∃ α, Witness z α` + (a CNF is satisfiable iff it admits a short satisfying assignment) +- `polyBalanced_witness` — witness length is bounded by `|z| + 1` + (satisfying assignments can always be truncated to length `φ.maxVar + 1`, + and `φ.maxVar ≤ |φ.encode|` from the unary encoding) + +These are the semantic and witness-length ingredients used by both routes to +`SAT ∈ NP`. The executable verifier is specified in `SAT/Verifier.lean`, its +polynomial-time TM implementation is proved in `SAT/VerifierTM.lean`, and the +SAT-specialized guess-and-verify construction is assembled into the +unconditional headline theorem in `SAT/Headline.lean`. +-/ + + +@[expose] public section + +namespace Complexity + +namespace SAT + +/-- **The SAT language.** A bitstring `z` is in `language` iff it encodes + some satisfiable CNF formula. + + Note: `encode` is injective on well-formed CNFs, but we don't need + injectivity for any of the downstream theorems — we only need + "there exists some `φ` …". -/ +def language : Language := {z | ∃ φ : CNF, z = φ.encode ∧ φ.Satisfiable} + +/-- **The SAT witness relation.** `Witness z α` holds when `z` encodes + some CNF `φ`, `α` is a bit-string of length at most `|z| + 1`, and + `α` satisfies `φ`. + + The `|z| + 1` length bound is what gives `PolyBalanced Witness`. It's + always achievable because any satisfying assignment can be truncated + to length `φ.maxVar + 1 ≤ |φ.encode| + 1 = |z| + 1` + (`satisfiable_iff_short_witness` + `CNF.maxVar_le_encode_length`). -/ +def Witness (z α : List Bool) : Prop := + ∃ φ : CNF, z = φ.encode ∧ α.length ≤ z.length + 1 ∧ CNF.eval α φ = true + +-- ════════════════════════════════════════════════════════════════════════ +-- Witness characterization: language iff ∃ witness +-- ════════════════════════════════════════════════════════════════════════ + +/-- **Witness characterization of `language`.** A string `z` is in `language` + iff there exists a witness `α` with `Witness z α`. + + The forward direction uses `CNF.satisfiable_iff_short_witness` to + produce a truncated witness, then applies `CNF.maxVar_le_encode_length` + to bound its length by `|z| + 1`. + + The reverse direction is immediate: any `α` satisfying `φ` proves + `φ.Satisfiable`. -/ +theorem mem_language_iff_witness (z : List Bool) : + z ∈ language ↔ ∃ α, Witness z α := by + constructor + · rintro ⟨φ, hz, hsat⟩ + -- Extract a short witness using truncation lemma. + rw [CNF.satisfiable_iff_short_witness] at hsat + obtain ⟨α, hlen, heval⟩ := hsat + refine ⟨α, φ, hz, ?_, heval⟩ + -- α.length ≤ φ.maxVar + 1 ≤ |φ.encode| + 1 = |z| + 1 + have : α.length ≤ φ.encode.length + 1 := + le_trans hlen (by have := CNF.maxVar_le_encode_length φ; omega) + rw [hz]; exact this + · rintro ⟨α, φ, hz, _, heval⟩ + exact ⟨φ, hz, α, heval⟩ + +-- ════════════════════════════════════════════════════════════════════════ +-- PolyBalanced: witness length is bounded by a polynomial in |z| +-- ════════════════════════════════════════════════════════════════════════ + +/-- **Short-witness property for SAT.** The witness relation `Witness` is + polynomially balanced: every valid witness has length at most + `|z| + 1`, which is bounded by the degree-1 polynomial `X + 1`. + + This is the key structural fact that makes `SAT` a candidate for NP: + we never need to guess more than linearly many bits. -/ +theorem polyBalanced_witness : PolyBalanced Witness := by + refine ⟨Polynomial.X + Polynomial.C 1, ?_⟩ + intro z α hR + obtain ⟨_, _, hlen, _⟩ := hR + simp only [Polynomial.eval_add, Polynomial.eval_X, Polynomial.eval_C] + exact hlen + +-- ════════════════════════════════════════════════════════════════════════ +-- Route to SAT ∈ NP +-- ════════════════════════════════════════════════════════════════════════ +-- +-- With `polyBalanced_witness` in hand, one route to SAT ∈ NP asks whether +-- the verifier's pair language `pairLang Witness` is in P. That is, whether +-- there is a poly-time deterministic TM that, given +-- `pair(z, α)`, decides whether `Witness z α` holds — equivalently, that +-- parses `z` as a CNF and evaluates it at `α`. +-- +-- `SAT/VerifierTM.lean` now discharges that verifier obligation. The generic +-- theorem below remains parameterized by `WitnessNTMConstruction`; the +-- unconditional SAT headline instead uses the specialized construction from +-- `SAT/Internal/GuessVerify.lean`. + +/-- **SAT is in FNP modulo the verifier.** If the verifier's pair language + is in P, then `Witness` is an FNP relation — and hence a candidate NP + witness relation for `language`. The only nontrivial content is + `polyBalanced_witness`. -/ +theorem witness_mem_FNP_of_verifier (h : pairLang Witness ∈ P) : Witness ∈ FNP := + ⟨polyBalanced_witness, h⟩ + +/-- **SAT is in NP modulo the verifier and generic guess-and-verify construction.** + If the verifier's pair language is in P and the generic FNP-witness to NP + construction has been built, then `language ∈ NP`. + + Combines `witness_mem_FNP_of_verifier` (SAT's FNP witness relation) with + the generic NP witness theorem `mem_NP_of_FNP_witness`. This theorem + deliberately retains the generic construction as an explicit hypothesis; + the SAT-specific unconditional route is provided by `SAT/Headline.lean`. -/ +theorem language_mem_NP_of_verifier + (hwitness : NP.WitnessNTMConstruction) (h : pairLang Witness ∈ P) : + language ∈ NP := + NP.mem_NP_of_FNP_witness hwitness (witness_mem_FNP_of_verifier h) mem_language_iff_witness + +-- ════════════════════════════════════════════════════════════════════════ +-- Worked examples: end-to-end sanity check of the semantic layer +-- ════════════════════════════════════════════════════════════════════════ + +/-- `[[x₀]]` is satisfiable. Checked by the `decide` tactic using + `CNF.decidableSatisfiable`. -/ +example : CNF.Satisfiable [[{sign := true, var := 0}]] := by decide + +/-- `[[x₀], [¬x₀]]` is unsatisfiable: no assignment can make both clauses true. -/ +example : ¬ CNF.Satisfiable [[{sign := true, var := 0}], [{sign := false, var := 0}]] := by + decide + +/-- `[[x₀, ¬x₁], [x₁]]` is satisfiable: `α = [true, true]` works. -/ +example : CNF.Satisfiable [[{sign := true, var := 0}, {sign := false, var := 1}], + [{sign := true, var := 1}]] := by decide + +end SAT + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/SAT/Rename.lean b/LeanPool/BeyondBethe/Complexitylib/SAT/Rename.lean new file mode 100644 index 0000000000..96c8fd7805 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/SAT/Rename.lean @@ -0,0 +1,190 @@ +/- +Copyright (c) 2025 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.SAT.Semantics + +/-! +# Variable renaming and satisfiability transport + +Renaming the variables of a CNF along an *injective* map preserves +satisfiability. This justifies re-indexing the Cook–Levin tableau variables +from the `Nat.pair`-based scheme (convenient for injectivity bookkeeping in +the correctness proof) to a flat mixed-radix scheme computable by a Turing +machine with unary multiplication and addition only — the form the reduction +machine actually emits (`docs/A5-ReductionEmitter.md`). + +## Main definitions + +- `SAT.Lit.mapVar`, `SAT.Clause.mapVar`, `SAT.CNF.mapVar` — variable renaming + +## Main results + +- `SAT.CNF.eval_mapVar_eq` — evaluation commutes with renaming, given + pointwise-agreeing assignments on the occurring variables +- `SAT.CNF.satisfiable_mapVar_iff` — renaming along an injective map + preserves satisfiability +-/ + + +@[expose] public section + +namespace Complexity + +namespace SAT + +-- ════════════════════════════════════════════════════════════════════════ +-- Renaming +-- ════════════════════════════════════════════════════════════════════════ + +/-- Rename a literal's variable along `f`. -/ +def Lit.mapVar (f : ℕ → ℕ) (ℓ : Lit) : Lit := ⟨ℓ.sign, f ℓ.var⟩ + +/-- Rename every variable of a clause along `f`. -/ +def Clause.mapVar (f : ℕ → ℕ) (c : Clause) : Clause := c.map (Lit.mapVar f) + +/-- Rename every variable of a CNF along `f`. -/ +def CNF.mapVar (f : ℕ → ℕ) (φ : CNF) : CNF := φ.map (Clause.mapVar f) + +/-- Renaming the empty CNF yields the empty CNF. -/ +@[simp] theorem CNF.mapVar_nil (f : ℕ → ℕ) : CNF.mapVar f [] = [] := rfl + +/-- Renaming distributes over `cons`: rename the head clause and the tail CNF. -/ +theorem CNF.mapVar_cons (f : ℕ → ℕ) (c : Clause) (φ : CNF) : + CNF.mapVar f (c :: φ) = Clause.mapVar f c :: CNF.mapVar f φ := rfl + +/-- Renaming distributes over CNF concatenation. -/ +theorem CNF.mapVar_append (f : ℕ → ℕ) (φ ψ : CNF) : + CNF.mapVar f (φ ++ ψ) = CNF.mapVar f φ ++ CNF.mapVar f ψ := + List.map_append .. + +-- ════════════════════════════════════════════════════════════════════════ +-- Assignment helpers +-- ════════════════════════════════════════════════════════════════════════ + +/-- Out-of-range variables read `false`. -/ +theorem Assignment.get_of_length_le {α : Assignment} {v : ℕ} (h : α.length ≤ v) : + α.get v = false := by + rw [Assignment.get, List.getElem?_eq_none h] + rfl + +/-- Tabulate the first `M` values of a Boolean function as an assignment. -/ +def Assignment.ofFn (M : ℕ) (g : ℕ → Bool) : Assignment := (List.range M).map g + +/-- The tabulated assignment `Assignment.ofFn M g` has length `M`. -/ +@[simp] theorem Assignment.ofFn_length (M : ℕ) (g : ℕ → Bool) : + (Assignment.ofFn M g).length = M := by + simp [Assignment.ofFn] + +/-- Reading `Assignment.ofFn M g` at an in-range variable `v < M` returns `g v`. -/ +theorem Assignment.ofFn_get {M v : ℕ} (g : ℕ → Bool) (h : v < M) : + (Assignment.ofFn M g).get v = g v := by + simp [Assignment.ofFn, Assignment.get, List.getElem?_map, List.getElem?_range h] + +/-- Every member is at most the `foldr max` of its list. -/ +private theorem le_foldr_max' {v : ℕ} {l : List ℕ} (h : v ∈ l) : + v ≤ l.foldr max 0 := by + induction l with + | nil => exact (List.not_mem_nil h).elim + | cons a l ih => + rcases List.mem_cons.mp h with rfl | h + · exact le_max_left _ _ + · exact le_trans (ih h) (le_max_right _ _) + +-- ════════════════════════════════════════════════════════════════════════ +-- Evaluation commutes with renaming +-- ════════════════════════════════════════════════════════════════════════ + +/-- Clause evaluation commutes with renaming, given assignments that agree + pointwise (through `f`) on the clause's variables. -/ +theorem Clause.eval_mapVar_eq (α β : Assignment) (f : ℕ → ℕ) (c : Clause) + (h : ∀ ℓ ∈ c, α.get (f ℓ.var) = β.get ℓ.var) : + Clause.eval α (c.mapVar f) = Clause.eval β c := by + induction c with + | nil => rfl + | cons ℓ ℓs ih => + have h1 : Lit.eval α (Lit.mapVar f ℓ) = Lit.eval β ℓ := by + simp only [Lit.eval, Lit.mapVar] + rw [h ℓ List.mem_cons_self] + have h2 := ih (fun ℓ' hℓ' => h ℓ' (List.mem_cons_of_mem _ hℓ')) + simp only [Clause.mapVar, List.map_cons, Clause.eval, List.any_cons] at h2 ⊢ + rw [h1, h2] + +/-- CNF evaluation commutes with renaming, given assignments that agree + pointwise (through `f`) on the formula's variables. -/ +theorem CNF.eval_mapVar_eq (α β : Assignment) (f : ℕ → ℕ) (φ : CNF) + (h : ∀ c ∈ φ, ∀ ℓ ∈ c, α.get (f ℓ.var) = β.get ℓ.var) : + CNF.eval α (CNF.mapVar f φ) = CNF.eval β φ := by + induction φ with + | nil => rfl + | cons c φ ih => + have h1 := Clause.eval_mapVar_eq α β f c (h c List.mem_cons_self) + have h2 := ih (fun c' hc' => h c' (List.mem_cons_of_mem _ hc')) + simp only [CNF.mapVar, List.map_cons, CNF.eval, List.all_cons] at h2 ⊢ + rw [h1, h2] + +-- ════════════════════════════════════════════════════════════════════════ +-- Satisfiability transport +-- ════════════════════════════════════════════════════════════════════════ + +/-- Renaming preserves satisfiability, forward direction: push the satisfying + assignment along the (injective) renaming. -/ +theorem CNF.Satisfiable.mapVar {f : ℕ → ℕ} (hf : Function.Injective f) {φ : CNF} + (h : CNF.Satisfiable φ) : CNF.Satisfiable (CNF.mapVar f φ) := by + classical + obtain ⟨β, hβ⟩ := h + set M := ((List.range β.length).map f).foldr max 0 + 1 with hM + set α := Assignment.ofFn M + (fun w => decide (∃ v, v < β.length ∧ f v = w ∧ β.get v = true)) with hα + have hpoint : ∀ v, α.get (f v) = β.get v := by + intro v + by_cases hv : v < β.length + · have hfv : f v < M := by + rw [hM] + exact Nat.lt_succ_of_le + (le_foldr_max' (List.mem_map_of_mem (List.mem_range.mpr hv))) + rw [hα, Assignment.ofFn_get _ hfv] + cases hβv : β.get v with + | false => + apply decide_eq_false + rintro ⟨v', _, hfeq, hget⟩ + cases hf hfeq + rw [hβv] at hget + exact Bool.noConfusion hget + | true => exact decide_eq_true ⟨v, hv, rfl, hβv⟩ + · rw [Assignment.get_of_length_le (by omega : β.length ≤ v)] + by_cases hfv : f v < M + · rw [hα, Assignment.ofFn_get _ hfv] + apply decide_eq_false + rintro ⟨v', hv', hfeq, _⟩ + cases hf hfeq + exact hv hv' + · exact Assignment.get_of_length_le (by rw [hα, Assignment.ofFn_length]; omega) + refine ⟨α, ?_⟩ + rw [CNF.eval_mapVar_eq α β f φ (fun c _ ℓ _ => hpoint ℓ.var)] + exact hβ + +/-- Renaming reflects satisfiability, backward direction: pull the satisfying + assignment back through the renaming (no injectivity needed). -/ +theorem CNF.Satisfiable.of_mapVar {f : ℕ → ℕ} {φ : CNF} + (h : CNF.Satisfiable (CNF.mapVar f φ)) : CNF.Satisfiable φ := by + obtain ⟨α, hα⟩ := h + refine ⟨Assignment.ofFn (CNF.maxVar φ + 1) (fun v => α.get (f v)), ?_⟩ + rw [← CNF.eval_mapVar_eq α _ f φ ?_] + · exact hα + · intro c hc ℓ hℓ + have hle : ℓ.var ≤ CNF.maxVar φ := + le_trans (Clause.var_le_maxVar hℓ) (CNF.clause_maxVar_le_maxVar hc) + rw [Assignment.ofFn_get _ (by omega)] + +/-- **Satisfiability is invariant under injective variable renaming.** -/ +theorem CNF.satisfiable_mapVar_iff {f : ℕ → ℕ} (hf : Function.Injective f) (φ : CNF) : + CNF.Satisfiable (CNF.mapVar f φ) ↔ CNF.Satisfiable φ := + ⟨CNF.Satisfiable.of_mapVar, fun h => h.mapVar hf⟩ + +end SAT + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/SAT/Semantics.lean b/LeanPool/BeyondBethe/Complexitylib/SAT/Semantics.lean new file mode 100644 index 0000000000..92417cc2a4 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/SAT/Semantics.lean @@ -0,0 +1,381 @@ +/- +Copyright (c) 2025 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import Mathlib.Data.Fintype.Pi +public import Mathlib.Data.Rat.Cast.Order +public import Mathlib.Tactic.NormNum.Abs +public import Mathlib.Tactic.NormNum.DivMod +public import Mathlib.Tactic.NormNum.OfScientific +public import Mathlib.Tactic.NormNum.Pow + +/-! +# SAT: Semantic Layer + +This file contains the mathematical definition of Boolean satisfiability. +**No Turing machines are used here.** Everything is pure recursion on +inductive types; a reader can audit these definitions in a few minutes +and check that they really capture "α satisfies φ". + +All later claims about the SAT verifier are stated against the predicates +defined here. If this file is wrong, nothing downstream rescues us. + +## Definitions + +- `Lit` — a literal `(sign, var)` where `var : Nat` is a variable index + and `sign : Bool` says whether the literal is positive. +- `Clause` — a list of literals (disjunction). +- `CNF` — a list of clauses (conjunction). +- `Assignment` — a `List Bool` giving the value of each variable. +- `Lit.eval` — `α[ℓ.var] = ℓ.sign` (out-of-range reads as `false`). +- `Clause.eval` — disjunction over literals. +- `CNF.eval` — conjunction over clauses. +- `CNF.Satisfiable` — some assignment makes `CNF.eval` true. + +## Out-of-range convention + +A variable index `i ≥ α.length` is treated as assigned to `false`. This is +standard in SAT textbooks ("unassigned variables default to 0") and makes +the language closed under padding: a short satisfying assignment always +exists, equal to a prefix of any longer one. This is essential for +polynomial balance in the NP reduction. +-/ + + +@[expose] public section + +namespace Complexity + +namespace SAT + +-- ════════════════════════════════════════════════════════════════════════ +-- Literals, clauses, CNF +-- ════════════════════════════════════════════════════════════════════════ + +/-- A literal: `sign = true` means the positive literal `x_var`; + `sign = false` means `¬x_var`. -/ +structure Lit where + /-- Polarity of the literal: `true` for `x_var`, `false` for `¬x_var`. -/ + sign : Bool + /-- Index of the variable this literal mentions. -/ + var : Nat + deriving DecidableEq + +/-- A clause is a disjunction of literals. The empty clause is + unsatisfiable (an empty disjunction is `false`). -/ +abbrev Clause := List Lit + +/-- A CNF formula is a conjunction of clauses. The empty CNF is + satisfiable (an empty conjunction is `true`). -/ +abbrev CNF := List Clause + +/-- An assignment is a bit-string. Position `i` holds the value of + variable `i`. Indices past the end read as `false`. -/ +abbrev Assignment := List Bool + +-- ════════════════════════════════════════════════════════════════════════ +-- Evaluation +-- ════════════════════════════════════════════════════════════════════════ + +namespace Assignment +/-- Value of variable `i` under assignment `α`, with out-of-range = `false`. -/ +@[inline] def get (α : Assignment) (i : Nat) : Bool := + (α[i]?).getD false +end Assignment + +namespace Lit +/-- `ℓ = (s, v)` is satisfied by `α` iff `α.get v = s`. -/ +@[inline] def eval (α : Assignment) (ℓ : Lit) : Bool := + α.get ℓ.var == ℓ.sign +end Lit + +namespace Clause +/-- A clause is satisfied iff at least one literal is. -/ +@[inline] def eval (α : Assignment) (c : Clause) : Bool := + c.any (Lit.eval α) +end Clause + +namespace CNF +/-- A CNF is satisfied iff every clause is. -/ +@[inline] def eval (α : Assignment) (φ : CNF) : Bool := + φ.all (Clause.eval α) + +/-- `φ` is satisfiable if some assignment makes `CNF.eval` true. -/ +def Satisfiable (φ : CNF) : Prop := ∃ α : Assignment, eval α φ = true + +-- ════════════════════════════════════════════════════════════════════════ +-- Basic sanity lemmas (proved here so downstream files can rely on them) +-- ════════════════════════════════════════════════════════════════════════ + +/-- The empty CNF evaluates to `true` (empty conjunction). -/ +@[simp] theorem eval_nil (α : Assignment) : eval α [] = true := rfl + +/-- Evaluating `c :: φ` is the conjunction of evaluating `c` and evaluating `φ`. -/ +@[simp] theorem eval_cons (α : Assignment) (c : Clause) (φ : CNF) : + eval α (c :: φ) = (Clause.eval α c && eval α φ) := by + simp [eval, List.all_cons] + +/-- The empty formula is trivially satisfiable. -/ +theorem satisfiable_nil : Satisfiable [] := ⟨[], rfl⟩ + +/-- The formula `[[]]` (one empty clause) is unsatisfiable. -/ +theorem not_satisfiable_empty_clause : ¬ Satisfiable [([] : Clause)] := by + rintro ⟨α, h⟩ + simp [eval, Clause.eval] at h + +end CNF + +-- ════════════════════════════════════════════════════════════════════════ +-- Max variable index — used to show polynomial-length witnesses exist +-- ════════════════════════════════════════════════════════════════════════ + +/-- Largest variable index appearing in a literal (just `ℓ.var`). -/ +@[inline] def Lit.maxVar (ℓ : Lit) : Nat := ℓ.var + +/-- Largest variable index in a clause (0 if empty). -/ +def Clause.maxVar : Clause → Nat + | [] => 0 + | ℓ :: ℓs => max ℓ.var (maxVar ℓs) + +/-- The empty clause has `maxVar = 0`. -/ +@[simp] theorem Clause.maxVar_nil : Clause.maxVar [] = 0 := rfl + +/-- `maxVar` of `ℓ :: ℓs` is the max of `ℓ.var` and `maxVar ℓs`. -/ +@[simp] theorem Clause.maxVar_cons (ℓ : Lit) (ℓs : Clause) : + Clause.maxVar (ℓ :: ℓs) = max ℓ.var (Clause.maxVar ℓs) := rfl + +/-- Every literal's var in a clause is at most `c.maxVar`. -/ +theorem Clause.var_le_maxVar {ℓ : Lit} {c : Clause} (hℓ : ℓ ∈ c) : + ℓ.var ≤ c.maxVar := by + induction c with + | nil => exact (List.not_mem_nil hℓ).elim + | cons ℓ' ℓs ih => + rcases List.mem_cons.mp hℓ with h | h + · subst h; simp + · calc ℓ.var ≤ Clause.maxVar ℓs := ih h + _ ≤ max ℓ'.var (Clause.maxVar ℓs) := le_max_right _ _ + _ = Clause.maxVar (ℓ' :: ℓs) := by simp + +/-- Largest variable index in a CNF (0 if empty). -/ +def CNF.maxVar : CNF → Nat + | [] => 0 + | c :: cs => max c.maxVar (maxVar cs) + +/-- The empty CNF has `maxVar = 0`. -/ +@[simp] theorem CNF.maxVar_nil : CNF.maxVar [] = 0 := rfl + +/-- `maxVar` of `c :: cs` is the max of `c.maxVar` and `maxVar cs`. -/ +@[simp] theorem CNF.maxVar_cons (c : Clause) (cs : CNF) : + CNF.maxVar (c :: cs) = max c.maxVar (CNF.maxVar cs) := rfl + +/-- Every clause's maxVar is at most `φ.maxVar`. -/ +theorem CNF.clause_maxVar_le_maxVar {c : Clause} {φ : CNF} (hc : c ∈ φ) : + c.maxVar ≤ φ.maxVar := by + induction φ with + | nil => exact (List.not_mem_nil hc).elim + | cons c' cs ih => + rcases List.mem_cons.mp hc with h | h + · subst h; simp + · calc c.maxVar ≤ CNF.maxVar cs := ih h + _ ≤ max c'.maxVar (CNF.maxVar cs) := le_max_right _ _ + _ = CNF.maxVar (c' :: cs) := by simp + +-- ════════════════════════════════════════════════════════════════════════ +-- Padding: truncating α below maxVar doesn't matter for out-of-range vars, +-- and extending α with false never changes eval. +-- ════════════════════════════════════════════════════════════════════════ + +/-- `Assignment.get` on `α ++ β` agrees with `α` at in-range indices. -/ +theorem Assignment.get_append_left (α β : Assignment) (i : Nat) (h : i < α.length) : + Assignment.get (α ++ β) i = Assignment.get α i := by + simp only [Assignment.get, List.getElem?_append_left h] + +/-- Appending to an assignment doesn't change `Lit.eval` for in-range literals. -/ +theorem Lit.eval_append_of_lt (α β : Assignment) (ℓ : Lit) (h : ℓ.var < α.length) : + ℓ.eval (α ++ β) = ℓ.eval α := by + simp [Lit.eval, Assignment.get_append_left α β ℓ.var h] + +-- ════════════════════════════════════════════════════════════════════════ +-- Truncation: assignments agree on eval below `maxVar + 1` +-- ════════════════════════════════════════════════════════════════════════ +-- +-- These lemmas say that if two assignments agree on all variable positions +-- that actually appear in φ, they produce the same evaluation. In particular, +-- truncating α to length `φ.maxVar + 1` preserves `CNF.eval α φ`. +-- +-- This is what powers `PolyBalanced`: given *any* satisfying α, we get a +-- short satisfying witness of length ≤ `φ.maxVar + 1 ≤ |φ.encode| + 1`. + +/-- `α.get i` is preserved by truncating to any length `k > i`. -/ +theorem Assignment.get_take (α : Assignment) (i k : Nat) (hi : i < k) : + Assignment.get (α.take k) i = Assignment.get α i := by + simp only [Assignment.get] + by_cases hl : i < α.length + · have htl : i < (α.take k).length := by + simp only [List.length_take]; omega + rw [List.getElem?_eq_getElem hl, List.getElem?_eq_getElem htl, + List.getElem_take] + · push Not at hl + have h1 : α[i]? = none := List.getElem?_eq_none hl + have h2 : (α.take k)[i]? = none := by + apply List.getElem?_eq_none + simp only [List.length_take]; omega + rw [h1, h2] + +/-- `Lit.eval` is invariant under truncation when the literal's var is in range. -/ +theorem Lit.eval_take (α : Assignment) (ℓ : Lit) (k : Nat) (hk : ℓ.var < k) : + Lit.eval (α.take k) ℓ = Lit.eval α ℓ := by + simp only [Lit.eval] + rw [Assignment.get_take α ℓ.var k hk] + +/-- `Clause.eval` is preserved by truncation of α to length above `c.maxVar`. -/ +theorem Clause.eval_take (α : Assignment) (c : Clause) (k : Nat) (hk : c.maxVar < k) : + Clause.eval (α.take k) c = Clause.eval α c := by + induction c with + | nil => rfl + | cons ℓ ℓs ih => + simp only [maxVar_cons] at hk + have hℓ : ℓ.var < k := by omega + have hℓs : Clause.maxVar ℓs < k := by omega + show ((ℓ :: ℓs).any (Lit.eval (α.take k))) = ((ℓ :: ℓs).any (Lit.eval α)) + simp only [List.any_cons, Lit.eval_take _ _ _ hℓ] + exact congrArg _ (ih hℓs) + +/-- `CNF.eval` is preserved by truncation of α to length above `φ.maxVar`. -/ +theorem CNF.eval_take (α : Assignment) (φ : CNF) (k : Nat) (hk : φ.maxVar < k) : + CNF.eval (α.take k) φ = CNF.eval α φ := by + induction φ with + | nil => rfl + | cons c cs ih => + simp only [maxVar_cons] at hk + have hc : c.maxVar < k := by omega + have hcs : CNF.maxVar cs < k := by omega + show ((c :: cs).all (Clause.eval (α.take k))) = ((c :: cs).all (Clause.eval α)) + simp only [List.all_cons, Clause.eval_take _ _ _ hc] + exact congrArg _ (ih hcs) + +/-- **PolyBalanced witness lemma.** A satisfiable formula has a satisfying + assignment of length at most `φ.maxVar + 1`. -/ +theorem CNF.satisfiable_iff_short_witness (φ : CNF) : + φ.Satisfiable ↔ ∃ α : Assignment, + α.length ≤ φ.maxVar + 1 ∧ CNF.eval α φ = true := by + constructor + · rintro ⟨α, hα⟩ + refine ⟨α.take (φ.maxVar + 1), ?_, ?_⟩ + · exact le_trans (List.length_take_le _ _) (by omega) + · rw [CNF.eval_take α φ (φ.maxVar + 1) (by omega)] + exact hα + · rintro ⟨α, _, hα⟩ + exact ⟨α, hα⟩ + +-- ════════════════════════════════════════════════════════════════════════ +-- Pointwise agreement and decidability of `Satisfiable` +-- ════════════════════════════════════════════════════════════════════════ + +/-- If two assignments give the same value at every index (via `Assignment.get`), + they produce the same literal evaluation. -/ +theorem Lit.eval_eq_of_agree (α β : Assignment) (ℓ : Lit) + (h : Assignment.get α ℓ.var = Assignment.get β ℓ.var) : + Lit.eval α ℓ = Lit.eval β ℓ := by + simp [Lit.eval, h] + +/-- Pointwise agreement of `Assignment.get` implies equal `Clause.eval`. -/ +theorem Clause.eval_eq_of_agree (α β : Assignment) (c : Clause) + (h : ∀ i, Assignment.get α i = Assignment.get β i) : + Clause.eval α c = Clause.eval β c := by + induction c with + | nil => rfl + | cons ℓ ℓs ih => + show ((ℓ :: ℓs).any (Lit.eval α)) = ((ℓ :: ℓs).any (Lit.eval β)) + simp only [List.any_cons, Lit.eval_eq_of_agree α β ℓ (h ℓ.var)] + exact congrArg _ ih + +/-- Pointwise agreement of `Assignment.get` implies equal `CNF.eval`. -/ +theorem CNF.eval_eq_of_agree (α β : Assignment) (φ : CNF) + (h : ∀ i, Assignment.get α i = Assignment.get β i) : + CNF.eval α φ = CNF.eval β φ := by + induction φ with + | nil => rfl + | cons c cs ih => + show ((c :: cs).all (Clause.eval α)) = ((c :: cs).all (Clause.eval β)) + simp only [List.all_cons, Clause.eval_eq_of_agree α β c h] + exact congrArg _ ih + +/-- Appending `false`s doesn't change `Assignment.get`: out-of-range positions + default to `false` anyway. -/ +theorem Assignment.get_append_replicate_false (α : Assignment) (k i : Nat) : + Assignment.get (α ++ List.replicate k false) i = Assignment.get α i := by + simp only [Assignment.get] + by_cases hi : i < α.length + · rw [List.getElem?_append_left hi] + · push Not at hi + rw [List.getElem?_eq_none hi] + by_cases hi' : i < α.length + k + · rw [List.getElem?_append_right hi] + have hrepl : (i - α.length) < (List.replicate k false : List Bool).length := by + simp; omega + rw [List.getElem?_eq_getElem hrepl] + simp [List.getElem_replicate] + · push Not at hi' + rw [List.getElem?_eq_none (by simp; omega)] + +/-- Padding an assignment with `false`s doesn't change `CNF.eval`. -/ +theorem CNF.eval_append_replicate_false (α : Assignment) (k : Nat) (φ : CNF) : + CNF.eval (α ++ List.replicate k false) φ = CNF.eval α φ := + CNF.eval_eq_of_agree _ _ _ (fun _ => Assignment.get_append_replicate_false α k _) + +/-- **Brute-force decidability.** Satisfiability is decidable by enumerating + all `2^(φ.maxVar + 1)` assignments of length `φ.maxVar + 1`. Not + poly-time, but establishes that the semantic layer is concretely + computable and enables `decide` on small instances. -/ +instance CNF.decidableSatisfiable (φ : CNF) : Decidable φ.Satisfiable := by + suffices h : φ.Satisfiable ↔ + ∃ f : Fin (φ.maxVar + 1) → Bool, CNF.eval (List.ofFn f) φ = true from + decidable_of_iff _ h.symm + rw [CNF.satisfiable_iff_short_witness] + constructor + · rintro ⟨α, hlen, heval⟩ + -- Pad α with `false`s up to length `maxVar + 1`, then identify with a Fin-indexed function. + let α' : Assignment := α ++ List.replicate (φ.maxVar + 1 - α.length) false + have hα'_len : α'.length = φ.maxVar + 1 := by + simp only [α', List.length_append, List.length_replicate]; omega + refine ⟨fun i => α'[i.val]'(by rw [hα'_len]; exact i.isLt), ?_⟩ + rw [← CNF.eval_append_replicate_false α (φ.maxVar + 1 - α.length) φ] at heval + change CNF.eval α' φ = true at heval + -- List.ofFn (fun i => α'[i.val]) agrees pointwise with α' via Assignment.get, + -- so CNF.eval is the same. + rw [CNF.eval_eq_of_agree _ α' φ (fun i => ?_)] + · exact heval + · simp only [Assignment.get] + by_cases hi : i < φ.maxVar + 1 + · have h1 : i < (List.ofFn (fun j : Fin (φ.maxVar + 1) => + α'[j.val]'(by rw [hα'_len]; exact j.isLt))).length := by simp [hi] + have hi' : i < α'.length := by rw [hα'_len]; exact hi + rw [List.getElem?_eq_getElem h1, List.getElem_ofFn, + List.getElem?_eq_getElem hi'] + · push Not at hi + rw [List.getElem?_eq_none (by simp; omega), + List.getElem?_eq_none (by rw [hα'_len]; exact hi)] + · rintro ⟨f, hf⟩ + exact ⟨List.ofFn f, by simp, hf⟩ + +/-- Evaluating a concatenation of clauses is the disjunction of the evaluations. -/ +@[simp] theorem Clause.eval_append (α : Assignment) (c d : Clause) : + Clause.eval α (c ++ d) = (Clause.eval α c || Clause.eval α d) := by + induction c with + | nil => simp [Clause.eval] + | cons _ _ _ => simp [Clause.eval, List.any_cons, Bool.or_assoc] + +/-- Evaluating a concatenation of CNFs is the conjunction of the evaluations. -/ +@[simp] theorem CNF.eval_append (α : Assignment) (φ ψ : CNF) : + CNF.eval α (φ ++ ψ) = (CNF.eval α φ && CNF.eval α ψ) := by + induction φ with + | nil => simp [CNF.eval] + | cons _ _ _ => simp [CNF.eval, List.all_cons, Bool.and_assoc] + +end SAT + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/SAT/ThreeCNF.lean b/LeanPool/BeyondBethe/Complexitylib/SAT/ThreeCNF.lean new file mode 100644 index 0000000000..aad6da5dd8 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/SAT/ThreeCNF.lean @@ -0,0 +1,129 @@ +/- +Copyright (c) 2025 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.SAT.Rename +public import Std.Tactic.BVDecide.Normalize.Prop + +/-! +# 3-CNF formulas + +The **3-CNF** refinement of the existing `CNF` type: a CNF is in 3-CNF when every +clause has exactly three literals. Following the roadmap (track N3), 3-CNF is +introduced here as a *predicate* on the existing `CNF = List Clause`, so that all +of the `CNF` semantics (`CNF.eval`, `CNF.Satisfiable`, `CNF.maxVar`, renaming) +apply unchanged and a 3-CNF is literally a CNF. + +## Main definitions and results + +- `CNF.Is3CNF` — every clause has length `3`; decidable +- `CNF.is3CNF_cons` — the cons characterization +- `CNF.Is3CNF.mapVar` — variable renaming preserves the 3-CNF shape + +The substantive N3 milestone — a size-controlled clause-padding transformation +turning an arbitrary CNF into an equisatisfiable 3-CNF — builds on this predicate +and is tracked separately. +-/ + + +@[expose] public section + +namespace Complexity + +namespace SAT + +/-- A CNF is in **3-CNF** when every clause is a disjunction of exactly three + literals. This is a predicate on the existing `CNF` type, so a 3-CNF formula + is literally a `CNF` and inherits all of its semantics. -/ +def CNF.Is3CNF (φ : CNF) : Prop := ∀ c ∈ φ, c.length = 3 + +instance (φ : CNF) : Decidable (CNF.Is3CNF φ) := List.decidableBAll _ _ + +/-- The empty CNF is trivially in 3-CNF. -/ +@[simp] theorem CNF.is3CNF_nil : CNF.Is3CNF [] := by + simp [CNF.Is3CNF] + +/-- `c :: φ` is 3-CNF iff `c` has three literals and `φ` is 3-CNF. -/ +@[simp] theorem CNF.is3CNF_cons {c : Clause} {φ : CNF} : + CNF.Is3CNF (c :: φ) ↔ c.length = 3 ∧ CNF.Is3CNF φ := + List.forall_mem_cons + +/-- Variable renaming preserves the 3-CNF shape: `Clause.mapVar` maps literals + one-for-one, so it does not change clause lengths. -/ +theorem CNF.Is3CNF.mapVar {φ : CNF} (h : CNF.Is3CNF φ) (f : ℕ → ℕ) : + CNF.Is3CNF (CNF.mapVar f φ) := by + intro c hc + rw [CNF.mapVar] at hc + obtain ⟨c', hc', rfl⟩ := List.mem_map.mp hc + rw [Clause.mapVar, List.length_map] + exact h c' hc' + +/-! ### Padding short clauses to width three + +A clause with one or two literals is padded to exactly three literals by +repeating its last literal. This changes neither the clause's models nor its +satisfiability (repeating a literal in a disjunction is idempotent), and turns a +CNF whose clauses all have width `1 … 3` into an equivalent 3-CNF. Splitting +*wide* clauses (width `> 3`) needs fresh Tseitin variables and is tracked +separately. -/ + +/-- Pad a clause of one or two literals to width three by repeating a literal; + clauses of any other width are left unchanged. -/ +def Clause.padTo3 : Clause → Clause + | [a] => [a, a, a] + | [a, b] => [a, b, b] + | c => c + +/-- Padding preserves the clause's value under every assignment (repeating a + literal in a disjunction is idempotent). -/ +theorem Clause.padTo3_eval (α : Assignment) (c : Clause) : + Clause.eval α (Clause.padTo3 c) = Clause.eval α c := by + match c with + | [] => rfl + | [a] => simp [Clause.padTo3, Clause.eval] + | [a, b] => simp [Clause.padTo3, Clause.eval] + | a :: b :: _ :: _ => rfl + +/-- A clause of width `1 … 3` is padded to width exactly three. -/ +theorem Clause.padTo3_length {c : Clause} (h1 : 1 ≤ c.length) (h2 : c.length ≤ 3) : + (Clause.padTo3 c).length = 3 := by + match c with + | [a] => rfl + | [a, b] => rfl + | [a, b, d] => rfl + | [] => simp at h1 + | a :: b :: d :: e :: t => simp only [List.length_cons] at h2; omega + +/-- Pad every clause of a CNF to width three. -/ +def CNF.padTo3 (φ : CNF) : CNF := φ.map Clause.padTo3 + +/-- Padding preserves the CNF's value under every assignment — hence + satisfiability. -/ +theorem CNF.padTo3_eval (α : Assignment) (φ : CNF) : + CNF.eval α (CNF.padTo3 φ) = CNF.eval α φ := by + unfold CNF.padTo3 + induction φ with + | nil => rfl + | cons c φ ih => + simp only [List.map_cons, CNF.eval_cons, Clause.padTo3_eval, ih] + +/-- Padding preserves satisfiability. -/ +theorem CNF.padTo3_satisfiable_iff (φ : CNF) : + CNF.Satisfiable (CNF.padTo3 φ) ↔ CNF.Satisfiable φ := by + simp only [CNF.Satisfiable, CNF.padTo3_eval] + +/-- If every clause of `φ` has width `1 … 3`, then `CNF.padTo3 φ` is a genuine + 3-CNF equivalent to `φ`. -/ +theorem CNF.is3CNF_padTo3 {φ : CNF} + (h : ∀ c ∈ φ, 1 ≤ c.length ∧ c.length ≤ 3) : CNF.Is3CNF (CNF.padTo3 φ) := by + intro c hc + obtain ⟨c', hc', rfl⟩ := List.mem_map.mp hc + obtain ⟨h1, h2⟩ := h c' hc' + exact Clause.padTo3_length h1 h2 + +end SAT + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/SAT/ThreeSAT.lean b/LeanPool/BeyondBethe/Complexitylib/SAT/ThreeSAT.lean new file mode 100644 index 0000000000..bcba218502 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/SAT/ThreeSAT.lean @@ -0,0 +1,187 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.SAT.ThreeCNF +public import LeanPool.BeyondBethe.Complexitylib.SAT.Verifier + +/-! +# Encoded CNF-SAT and 3SAT languages + +This module names the existing encoded SAT problem as `CNFSAT` and defines +`ThreeSAT` by restricting decoded CNFs to clauses of exactly three literals. +It is a semantic and codec interface only; no complexity-class membership or +reduction claim is made here. + +## Main definitions and results + +- `CNF.decode3?` — decode a bit string only when it encodes an exact 3-CNF +- `CNFSAT.language` — compatibility name for the existing `SAT.language` +- `ThreeSAT.language` — satisfiable, exactly-three-literal CNF encodings +- `ThreeSAT.falseFormula` — a fixed unsatisfiable exact 3-CNF +- `ThreeSAT.fallbackEncoding` — valid no-instance output for malformed inputs +-/ + + +@[expose] public section + +namespace Complexity + +namespace SAT + +namespace CNF + +/-- Decode a concrete SAT bit string and accept it only when every decoded +clause contains exactly three literals. -/ +def decode3? (z : List Bool) : Option CNF := do + let φ ← decode? z + if φ.Is3CNF then some φ else none + +/-- An exact 3-CNF survives encoding followed by restricted decoding. -/ +@[simp] theorem decode3?_encode {φ : CNF} (h3 : φ.Is3CNF) : + decode3? φ.encode = some φ := by + simp [decode3?, h3] + +/-- Restricted decoding is sound for both the concrete encoding and the +exact-three-literal shape. -/ +theorem decode3?_sound {z : List Bool} {φ : CNF} + (h : decode3? z = some φ) : z = φ.encode ∧ φ.Is3CNF := by + cases hdecode : decode? z with + | none => + simp [decode3?, hdecode] at h + | some ψ => + by_cases h3 : ψ.Is3CNF + · simp [decode3?, hdecode, h3] at h + subst φ + exact ⟨decode?_sound hdecode, h3⟩ + · simp [decode3?, hdecode, h3] at h + +/-- Characterization of successful exact-3 decoding. -/ +theorem decode3?_eq_some_iff {z : List Bool} {φ : CNF} : + decode3? z = some φ ↔ z = φ.encode ∧ φ.Is3CNF := by + constructor + · exact decode3?_sound + · rintro ⟨rfl, h3⟩ + exact decode3?_encode h3 + +/-- The concrete CNF encoding is injective. -/ +theorem encode_injective : Function.Injective CNF.encode := by + intro φ ψ h + have hdecode := congrArg decode? h + simpa using hdecode + +end CNF + +/-! ## CNF-SAT compatibility surface -/ + +namespace CNFSAT + +/-- Compatibility name for the library's existing SAT language, whose inputs +are concrete encodings of satisfiable CNF formulas. -/ +abbrev language : Language := Complexity.SAT.language + +/-- The compatibility name denotes exactly the existing SAT language. -/ +theorem language_eq_sat : language = Complexity.SAT.language := rfl + +/-- Membership through the compatibility name is definitionally the existing +SAT membership predicate. -/ +@[simp] theorem mem_language_iff_sat (z : List Bool) : + z ∈ language ↔ z ∈ Complexity.SAT.language := Iff.rfl + +/-- A bit string is in CNF-SAT exactly when it decodes to a satisfiable CNF. -/ +theorem mem_language_iff_decode (z : List Bool) : + z ∈ language ↔ ∃ φ : CNF, CNF.decode? z = some φ ∧ φ.Satisfiable := by + constructor + · rintro ⟨φ, rfl, hsat⟩ + exact ⟨φ, CNF.decode?_encode φ, hsat⟩ + · rintro ⟨φ, hdecode, hsat⟩ + exact ⟨φ, CNF.decode?_sound hdecode, hsat⟩ + +/-- Encoding a typed CNF is in CNF-SAT exactly when that formula is +satisfiable. -/ +@[simp] theorem encode_mem_language_iff (φ : CNF) : + φ.encode ∈ language ↔ φ.Satisfiable := by + constructor + · rintro ⟨ψ, hencode, hsat⟩ + have hφψ : φ = ψ := CNF.encode_injective hencode + simpa [hφψ] using hsat + · exact fun hsat => ⟨φ, rfl, hsat⟩ + +end CNFSAT + +/-! ## 3SAT -/ + +namespace ThreeSAT + +/-- **3SAT** consists of concrete encodings of satisfiable CNFs in which every +clause has exactly three literals. -/ +def language : Language := + {z | ∃ φ : CNF, z = φ.encode ∧ φ.Is3CNF ∧ φ.Satisfiable} + +/-- A bit string is in 3SAT exactly when restricted decoding succeeds with a +satisfiable formula. -/ +theorem mem_language_iff_decode3 (z : List Bool) : + z ∈ language ↔ ∃ φ : CNF, CNF.decode3? z = some φ ∧ φ.Satisfiable := by + constructor + · rintro ⟨φ, rfl, h3, hsat⟩ + exact ⟨φ, CNF.decode3?_encode h3, hsat⟩ + · rintro ⟨φ, hdecode, hsat⟩ + obtain ⟨hz, h3⟩ := CNF.decode3?_sound hdecode + exact ⟨φ, hz, h3, hsat⟩ + +/-- Encoding a typed CNF belongs to 3SAT exactly when it is an exact 3-CNF +and is satisfiable. -/ +@[simp] theorem encode_mem_language_iff (φ : CNF) : + φ.encode ∈ language ↔ φ.Is3CNF ∧ φ.Satisfiable := by + constructor + · rintro ⟨ψ, hencode, h3, hsat⟩ + have hφψ : φ = ψ := CNF.encode_injective hencode + simpa [hφψ] using And.intro h3 hsat + · rintro ⟨h3, hsat⟩ + exact ⟨φ, rfl, h3, hsat⟩ + +/-- Every 3SAT instance is, after forgetting the shape restriction, a CNF-SAT +instance. -/ +theorem language_subset_cnfsat : language ⊆ CNFSAT.language := by + rintro z ⟨φ, hz, _h3, hsat⟩ + exact ⟨φ, hz, hsat⟩ + +/-- A fixed unsatisfiable exact 3-CNF: one clause forces `x₀`, while the other +forces `¬x₀`. Repeated literals make both clauses have width exactly three. -/ +def falseFormula : CNF := + [[{ sign := true, var := 0 }, { sign := true, var := 0 }, + { sign := true, var := 0 }], + [{ sign := false, var := 0 }, { sign := false, var := 0 }, + { sign := false, var := 0 }]] + +/-- `falseFormula` has exactly three literals in each clause. -/ +@[simp] theorem falseFormula_is3CNF : falseFormula.Is3CNF := by + decide + +/-- `falseFormula` is unsatisfiable. -/ +theorem falseFormula_not_satisfiable : ¬falseFormula.Satisfiable := by + rintro ⟨α, hα⟩ + simp [falseFormula, CNF.eval, Clause.eval, Lit.eval] at hα + +/-- A valid encoded 3-CNF no-instance suitable as the target of malformed or +otherwise invalid source inputs in later total reductions. -/ +def fallbackEncoding : List Bool := falseFormula.encode + +/-- The fallback encoding decodes successfully as `falseFormula`. -/ +@[simp] theorem decode3?_fallbackEncoding : + CNF.decode3? fallbackEncoding = some falseFormula := by + exact CNF.decode3?_encode falseFormula_is3CNF + +/-- The fallback encoding is not a member of 3SAT. -/ +theorem fallbackEncoding_not_mem_language : fallbackEncoding ∉ language := by + rw [fallbackEncoding, encode_mem_language_iff] + exact fun h => falseFormula_not_satisfiable h.2 + +end ThreeSAT + +end SAT + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/SAT/ThreeSAT/Syntax.lean b/LeanPool/BeyondBethe/Complexitylib/SAT/ThreeSAT/Syntax.lean new file mode 100644 index 0000000000..a33da96087 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/SAT/ThreeSAT/Syntax.lean @@ -0,0 +1,214 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.SAT.ThreeSAT +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.Internal.Scanner + +/-! +# Regular syntax checker for exact 3-CNF encodings + +Exact-3 shape is a regular property of the concrete CNF encoding. This module +gives a finite-state left-to-right scanner for it and proves that the scanner +accepts an encoded CNF exactly when every clause has three literals. The syntax +language deliberately need not reject every malformed word: intersecting it +with `CNFSAT.language` supplies well-formedness, which keeps this checker small +and makes the intended 3SAT decomposition explicit. + +## Main results + +- `ThreeSAT.Syntax.encode_mem_language_iff` -- correctness on encoded CNFs +- `ThreeSAT.Syntax.language_mem_P` -- exact-3 syntax is decidable in linear time +- `ThreeSAT.language_eq_cnfsat_inter_syntax` -- semantic decomposition of 3SAT +-/ + + +@[expose] public section + +namespace Complexity + +namespace SAT + +namespace ThreeSAT + +namespace Syntax + +/-- Parser state after consuming whole two-bit encoding tokens. `between k` +means that `k` complete literals have been seen in the current clause. -/ +inductive TokenState where + | between (count : Fin 4) + | inLit (count : Fin 4) + | invalid + deriving DecidableEq, Fintype + +/-- Initial token parser state: between clauses with no current literals. -/ +def tokenStart : TokenState := .between 0 + +/-- One transition of the exact-3 grammar at token granularity. -/ +def tokenStep : TokenState → EncToken → TokenState + | .invalid, _ => .invalid + | .between count, .bit _ => .inLit count + | .between _, .litSep => .invalid + | .between count, .clauseSep => + if count.val = 3 then tokenStart else .invalid + | .inLit count, .bit true => .inLit count + | .inLit _, .bit false => .invalid + | .inLit count, .litSep => + if h : count.val < 3 then .between ⟨count.val + 1, by omega⟩ else .invalid + | .inLit _, .clauseSep => .invalid + +/-- Bit-level scanner state. `half state b` remembers the first bit of the +next two-bit encoding token. -/ +inductive BitState where + | ready (state : TokenState) + | half (state : TokenState) (first : Bool) + deriving DecidableEq, Fintype + +/-- Initial bit-level scanner state. -/ +def bitStart : BitState := .ready tokenStart + +/-- Decode one of the four two-bit concrete token patterns. -/ +def tokenOfBits : Bool → Bool → EncToken + | false, false => .bit false + | true, true => .bit true + | false, true => .litSep + | true, false => .clauseSep + +/-- One input-bit transition of the exact-3 syntax scanner. -/ +def bitStep : BitState → Bool → BitState + | .ready state, b => .half state b + | .half state first, second => .ready (tokenStep state (tokenOfBits first second)) + +/-- The scanner accepts precisely at a token boundary between clauses. -/ +def accept (state : BitState) : Bool := decide (state = bitStart) + +/-- The regular language recognized by the exact-3 syntax scanner. -/ +def language : Language := + {z | accept (z.foldl bitStep bitStart) = true} + +/-- An invalid token state remains invalid under every suffix. -/ +@[simp] private theorem foldl_invalid (toks : List EncToken) : + toks.foldl tokenStep .invalid = .invalid := by + induction toks with + | nil => rfl + | cons tok toks ih => + rw [List.foldl_cons] + exact ih + +/-- Scanning one concrete token implements its token-level transition. -/ +private theorem foldl_encode_token (state : TokenState) (tok : EncToken) : + tok.encode.foldl bitStep (.ready state) = .ready (tokenStep state tok) := by + cases tok with + | bit b => cases b <;> rfl + | litSep => rfl + | clauseSep => rfl + +/-- Scanning a flattened token stream agrees with folding the token parser. -/ +private theorem foldl_encodeTokens (toks : List EncToken) (state : TokenState) : + (encodeTokens toks).foldl bitStep (.ready state) = + .ready (toks.foldl tokenStep state) := by + induction toks generalizing state with + | nil => rfl + | cons tok toks ih => + rw [encodeTokens_cons, List.foldl_append, foldl_encode_token, ih] + rfl + +/-- Unary variable bodies leave the parser inside the current literal. -/ +@[simp] private theorem foldl_true_tokens (count : Fin 4) (n : ℕ) : + (List.replicate n (EncToken.bit true)).foldl tokenStep (.inLit count) = + .inLit count := by + induction n with + | zero => rfl + | succ n ih => + rw [List.replicate_succ, List.foldl_cons] + exact ih + +/-- A typed literal's raw tokens leave the parser inside that literal with +the clause count unchanged. -/ +@[simp] private theorem foldl_rawTokens (count : Fin 4) (lit : Lit) : + lit.rawTokens.foldl tokenStep (.between count) = .inLit count := by + rcases lit with ⟨sign, var⟩ + simp only [Lit.rawTokens, Lit.encodeRaw, Unary.encode, List.map_cons, + List.map_replicate, List.foldl_cons, tokenStep] + exact foldl_true_tokens count var + +/-- Scanning one well-formed source literal increments the current clause +count, or becomes invalid if three literals were already complete. -/ +private theorem foldl_literal (count : Fin 4) (lit : Lit) : + (lit.rawTokens ++ [EncToken.litSep]).foldl tokenStep (.between count) = + if h : count.val < 3 then .between ⟨count.val + 1, by omega⟩ else .invalid := by + rw [List.foldl_append, foldl_rawTokens] + simp only [List.foldl_cons, List.foldl_nil, tokenStep] + +/-- One encoded clause followed by its separator returns to the initial state +exactly when the clause has width three. -/ +private theorem foldl_clause (clause : Clause) : + (clause.tokens ++ [EncToken.clauseSep]).foldl tokenStep tokenStart = + if clause.length = 3 then tokenStart else .invalid := by + rcases clause with _ | ⟨a, _ | ⟨b, _ | ⟨c, _ | ⟨d, rest⟩⟩⟩⟩ + all_goals + simp [Clause.tokens, List.foldl_append, tokenStart, tokenStep] + +/-- Token-level recognition theorem for typed CNFs. -/ +private theorem foldl_cnf_eq_start_iff (formula : CNF) : + formula.tokens.foldl tokenStep tokenStart = tokenStart ↔ formula.Is3CNF := by + induction formula with + | nil => simp [CNF.tokens, CNF.Is3CNF] + | cons clause rest ih => + rw [CNF.tokens, List.foldl_append] + rw [foldl_clause] + by_cases hclause : clause.length = 3 + · rw [if_pos hclause, ih] + simp [CNF.is3CNF_cons, hclause] + · rw [if_neg hclause, foldl_invalid] + simp [tokenStart, CNF.is3CNF_cons, hclause] + +/-- A typed CNF's bit encoding is accepted exactly when it is exact 3-CNF. -/ +@[simp] theorem encode_mem_language_iff (formula : CNF) : + formula.encode ∈ language ↔ formula.Is3CNF := by + change accept (formula.encode.foldl bitStep bitStart) = true ↔ formula.Is3CNF + rw [← CNF.encodeTokens_tokens formula] + change accept ((encodeTokens formula.tokens).foldl bitStep (.ready tokenStart)) = true ↔ _ + rw [foldl_encodeTokens] + change decide (.ready (formula.tokens.foldl tokenStep tokenStart) = bitStart) = true ↔ _ + rw [decide_eq_true_iff] + unfold bitStart + simp only [BitState.ready.injEq] + exact foldl_cnf_eq_start_iff formula + +/-- Concrete zero-work-tape finite-state checker for exact-3 syntax. -/ +def syntaxTM : TM 0 := + TM.scannerTM bitStart bitStep (fun state => if accept state then .one else .zero) + +/-- The syntax checker decides its regular language in exactly `n + 2` steps. -/ +theorem syntaxTM_decidesInTime : + syntaxTM.DecidesInTime language (fun n => n + 2) := by + exact TM.scannerTM_decidesInTime bitStart bitStep accept (fun _ => Iff.rfl) + +/-- The exact-3 syntax language is decidable in linear time. -/ +theorem language_mem_P : language ∈ P := by + refine Set.mem_iUnion.mpr ⟨1, 0, syntaxTM, fun n => n + 2, + syntaxTM_decidesInTime, ?_⟩ + refine BigO.add ?_ (BigO.const_le_pow 2 1) + simpa using BigO.refl (fun n : ℕ => n) + +end Syntax + +/-- 3SAT is CNF-SAT intersected with the regular exact-3 syntax language. -/ +theorem language_eq_cnfsat_inter_syntax : + language = CNFSAT.language ∩ Syntax.language := by + ext z + constructor + · rintro ⟨formula, rfl, hshape, hsat⟩ + exact ⟨⟨formula, rfl, hsat⟩, (Syntax.encode_mem_language_iff formula).2 hshape⟩ + · rintro ⟨⟨formula, rfl, hsat⟩, hshape⟩ + exact ⟨formula, rfl, (Syntax.encode_mem_language_iff formula).1 hshape, hsat⟩ + +end ThreeSAT + +end SAT + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/SAT/Verifier.lean b/LeanPool/BeyondBethe/Complexitylib/SAT/Verifier.lean new file mode 100644 index 0000000000..d8597ca477 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/SAT/Verifier.lean @@ -0,0 +1,456 @@ +/- +Copyright (c) 2025 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.SAT.Language +public import Std.Tactic.BVDecide.Normalize.BitVec + +/-! +# SAT verifier specification + +This file defines an executable verifier for `pairLang Witness`: + +1. split `pair(z, α)` back into `(z, α)` via `unpair?`, +2. decode `z` as a CNF in SAT's concrete bit encoding, +3. check the witness length bound `|α| ≤ |z| + 1`, +4. evaluate the decoded formula under `α`. + +The deterministic implementation `verifyPairTM` in `SAT/VerifierTM.lean` +computes this specification and proves `pairLang Witness ∈ P`; this file is +the small executable/semantic audit surface for that machine proof. +-/ + + +@[expose] public section + +namespace Complexity + +namespace SAT + +-- ════════════════════════════════════════════════════════════════════════ +-- Tokenization of the SAT bit-level encoding +-- ════════════════════════════════════════════════════════════════════════ + +/-- The four two-bit tokens used by SAT's concrete encoding. -/ +inductive EncToken where + /-- A doubled data bit: `false` is encoded as `00`, `true` as `11`. -/ + | bit (b : Bool) + /-- The literal separator `|`, encoded as `01`. -/ + | litSep + /-- The clause separator `#`, encoded as `10`. -/ + | clauseSep + deriving DecidableEq, Repr + +namespace EncToken + +/-- Concrete two-bit representation of one SAT encoding token. -/ +def encode : EncToken → List Bool + | .bit false => [false, false] + | .bit true => [true, true] + | .litSep => [false, true] + | .clauseSep => [true, false] + +end EncToken + +/-- Flatten a token stream back into concrete bits. -/ +def encodeTokens (toks : List EncToken) : List Bool := + toks.flatMap EncToken.encode + +/-- Split a bitstring into SAT encoding tokens. Odd-length strings are invalid. -/ +def tokenize? : List Bool → Option (List EncToken) + | [] => some [] + | [_] => none + | false :: false :: rest => Option.map (EncToken.bit false :: ·) (tokenize? rest) + | true :: true :: rest => Option.map (EncToken.bit true :: ·) (tokenize? rest) + | false :: true :: rest => Option.map (EncToken.litSep :: ·) (tokenize? rest) + | true :: false :: rest => Option.map (EncToken.clauseSep :: ·) (tokenize? rest) + +/-- The empty token stream encodes to the empty bitstring. -/ +@[simp] theorem encodeTokens_nil : encodeTokens [] = [] := rfl + +/-- `encodeTokens` unfolds on `cons`: the head token's bits precede the tail's encoding. -/ +@[simp] theorem encodeTokens_cons (tok : EncToken) (toks : List EncToken) : + encodeTokens (tok :: toks) = tok.encode ++ encodeTokens toks := by + cases tok <;> rfl + +/-- `encodeTokens` is a monoid homomorphism: it distributes over list append. -/ +@[simp] theorem encodeTokens_append (xs ys : List EncToken) : + encodeTokens (xs ++ ys) = encodeTokens xs ++ encodeTokens ys := by + induction xs with + | nil => rfl + | cons x xs ih => + simp [List.append_assoc, ih] + +/-- Round trip: tokenizing an encoded token stream recovers the original tokens. -/ +@[simp] theorem tokenize?_encodeTokens (toks : List EncToken) : + tokenize? (encodeTokens toks) = some toks := by + induction toks with + | nil => simp [encodeTokens, tokenize?] + | cons tok toks ih => + cases tok with + | bit b => + cases b with + | false => + change tokenize? (false :: false :: encodeTokens toks) + = some (EncToken.bit false :: toks) + simp [tokenize?, ih] + | true => + change tokenize? (true :: true :: encodeTokens toks) + = some (EncToken.bit true :: toks) + simp [tokenize?, ih] + | litSep => + change tokenize? (false :: true :: encodeTokens toks) = some (EncToken.litSep :: toks) + simp [tokenize?, ih] + | clauseSep => + change tokenize? (true :: false :: encodeTokens toks) = some (EncToken.clauseSep :: toks) + simp [tokenize?, ih] + +/-- Soundness of `tokenize?`: any successfully tokenized bitstring is the +encoding of the resulting token stream. -/ +theorem tokenize?_sound {z : List Bool} {toks : List EncToken} + (h : tokenize? z = some toks) : z = encodeTokens toks := by + let rec hsound : ∀ z toks, tokenize? z = some toks → z = encodeTokens toks + | [], toks, htok => by + simp [tokenize?] at htok + cases htok + rfl + | [_], _, htok => by + simp [tokenize?] at htok + | false :: false :: rest, toks, htok => by + simp [tokenize?] at htok + rcases htok with ⟨toks', hrest, rfl⟩ + have henc := hsound rest toks' hrest + simp [encodeTokens, EncToken.encode, henc] + | true :: true :: rest, toks, htok => by + simp [tokenize?] at htok + rcases htok with ⟨toks', hrest, rfl⟩ + have henc := hsound rest toks' hrest + simp [encodeTokens, EncToken.encode, henc] + | false :: true :: rest, toks, htok => by + simp [tokenize?] at htok + rcases htok with ⟨toks', hrest, rfl⟩ + have henc := hsound rest toks' hrest + simp [encodeTokens, EncToken.encode, henc] + | true :: false :: rest, toks, htok => by + simp [tokenize?] at htok + rcases htok with ⟨toks', hrest, rfl⟩ + have henc := hsound rest toks' hrest + simp [encodeTokens, EncToken.encode, henc] + exact hsound z toks h + +/-- Encoding a stream of `bit` tokens doubles each underlying bit. -/ +@[simp] theorem encodeTokens_map_bit (bs : List Bool) : + encodeTokens (bs.map EncToken.bit) = doubleBits bs := by + induction bs with + | nil => rfl + | cons b bs ih => + cases b <;> simp [encodeTokens_cons, doubleBits_cons, EncToken.encode, ih] + +-- ════════════════════════════════════════════════════════════════════════ +-- Literal decoding +-- ════════════════════════════════════════════════════════════════════════ + +namespace Lit + +/-- Decode a raw literal bitstring `[sign] ++ replicate var true`. -/ +def decodeRaw? : List Bool → Option Lit + | [] => none + | sign :: rest => + if _h : ∀ b ∈ rest, b = true then + some { sign := sign, var := rest.length } + else + none + +/-- Round trip: decoding a literal's raw encoding recovers the literal. -/ +@[simp] theorem decodeRaw?_encodeRaw (ℓ : Lit) : + decodeRaw? ℓ.encodeRaw = some ℓ := by + cases ℓ with + | mk sign var => + simp [decodeRaw?, encodeRaw, Unary.encode] + +/-- Soundness of `decodeRaw?`: any successfully decoded bitstring is the raw +encoding of the resulting literal. -/ +theorem decodeRaw?_sound {bs : List Bool} {ℓ : Lit} + (h : decodeRaw? bs = some ℓ) : bs = ℓ.encodeRaw := by + cases bs with + | nil => + simp [decodeRaw?] at h + | cons sign rest => + simp only [decodeRaw?] at h + split at h + · cases h + have hrep : rest = List.replicate rest.length true := by + rw [List.eq_replicate_length] + intro b hb + exact ‹∀ b ∈ rest, b = true› b hb + change sign :: rest = sign :: Unary.encode rest.length + rw [Unary.encode] + exact congrArg (List.cons sign) hrep + · simp at h + +/-- Token-level raw literal encoding. -/ +def rawTokens (ℓ : Lit) : List EncToken := + ℓ.encodeRaw.map EncToken.bit + +/-- A literal's token-level encoding flattens to its raw bits, doubled. -/ +@[simp] theorem encodeTokens_rawTokens (ℓ : Lit) : + encodeTokens ℓ.rawTokens = doubleBits ℓ.encodeRaw := by + simp [rawTokens] + +end Lit + +-- ════════════════════════════════════════════════════════════════════════ +-- Clause/CNF token encodings +-- ════════════════════════════════════════════════════════════════════════ + +namespace Clause + +/-- Token-level clause encoding: doubled raw literal bits, each terminated by `|`. -/ +def tokens : Clause → List EncToken + | [] => [] + | ℓ :: ℓs => ℓ.rawTokens ++ [EncToken.litSep] ++ tokens ℓs + +/-- A clause's token-level encoding flattens to its concrete bit encoding. -/ +@[simp] theorem encodeTokens_tokens (c : Clause) : + encodeTokens (tokens c) = c.encode := by + induction c with + | nil => rfl + | cons ℓ ℓs ih => + simp [tokens, encode_cons, ih, List.append_assoc, EncToken.encode] + +/-- `Clause.tokens` distributes over list append. -/ +@[simp] theorem tokens_append (c₁ c₂ : Clause) : + tokens (c₁ ++ c₂) = tokens c₁ ++ tokens c₂ := by + induction c₁ with + | nil => rfl + | cons ℓ ℓs ih => + simp [tokens, ih, List.append_assoc] + +end Clause + +namespace CNF + +/-- Token-level CNF encoding: each clause is terminated by `#`. -/ +def tokens : CNF → List EncToken + | [] => [] + | c :: cs => c.tokens ++ [EncToken.clauseSep] ++ tokens cs + +/-- A CNF's token-level encoding flattens to its concrete bit encoding. -/ +@[simp] theorem encodeTokens_tokens (φ : CNF) : + encodeTokens (tokens φ) = φ.encode := by + induction φ with + | nil => rfl + | cons c cs ih => + simp [tokens, encode_cons, ih, List.append_assoc, EncToken.encode] + +/-- `CNF.tokens` distributes over list append. -/ +@[simp] theorem tokens_append (φ ψ : CNF) : + tokens (φ ++ ψ) = tokens φ ++ tokens ψ := by + induction φ with + | nil => rfl + | cons c cs ih => + simp [tokens, ih, List.append_assoc] + +end CNF + +-- ════════════════════════════════════════════════════════════════════════ +-- Token parser for CNFs +-- ════════════════════════════════════════════════════════════════════════ + +/-- Core parser state: +`rawRev` is the reversed current raw literal, `clauseRev` the reversed current +clause, and `cnfRev` the reversed list of completed clauses. -/ +def parseTokensAux : + List EncToken → List Bool → Clause → CNF → Option CNF + | [], rawRev, clauseRev, cnfRev => + if _hraw : rawRev = [] then + if _hclause : clauseRev = [] then + some cnfRev.reverse + else + none + else + none + | EncToken.bit b :: toks, rawRev, clauseRev, cnfRev => + parseTokensAux toks (b :: rawRev) clauseRev cnfRev + | EncToken.litSep :: toks, rawRev, clauseRev, cnfRev => + match Lit.decodeRaw? rawRev.reverse with + | some ℓ => parseTokensAux toks [] (ℓ :: clauseRev) cnfRev + | none => none + | EncToken.clauseSep :: toks, rawRev, clauseRev, cnfRev => + if _hraw : rawRev = [] then + parseTokensAux toks [] [] (clauseRev.reverse :: cnfRev) + else + none + +private theorem parseTokensAux_map_bit + (bs : List Bool) (toks : List EncToken) + (rawRev : List Bool) (clauseRev : Clause) (cnfRev : CNF) : + parseTokensAux (bs.map EncToken.bit ++ toks) rawRev clauseRev cnfRev = + parseTokensAux toks (bs.reverse ++ rawRev) clauseRev cnfRev := by + induction bs generalizing rawRev with + | nil => simp + | cons b bs ih => + cases b <;> simp [parseTokensAux, ih, List.reverse_cons, List.append_assoc] + +private theorem parseTokensAux_clause_tokens + (c : Clause) (toks : List EncToken) (clauseRev : Clause) (cnfRev : CNF) : + parseTokensAux (c.tokens ++ EncToken.clauseSep :: toks) [] clauseRev cnfRev = + parseTokensAux toks [] [] ((clauseRev.reverse ++ c) :: cnfRev) := by + induction c generalizing clauseRev with + | nil => + simp [Clause.tokens, parseTokensAux] + | cons ℓ ℓs ih => + simp [Clause.tokens, Lit.rawTokens] + rw [parseTokensAux_map_bit ℓ.encodeRaw] + simp [parseTokensAux, Lit.decodeRaw?_encodeRaw, List.reverse_reverse, ih, + List.reverse_cons, List.append_assoc] + +private theorem parseTokensAux_cnf_tokens + (φ : CNF) (toks : List EncToken) (cnfRev : CNF) : + parseTokensAux (φ.tokens ++ toks) [] [] cnfRev = + parseTokensAux toks [] [] (φ.reverse ++ cnfRev) := by + induction φ generalizing cnfRev with + | nil => simp [CNF.tokens] + | cons c cs ih => + rw [CNF.tokens] + have hclause := parseTokensAux_clause_tokens c (CNF.tokens cs ++ toks) [] cnfRev + rw [show c.tokens ++ [EncToken.clauseSep] ++ CNF.tokens cs ++ toks = + c.tokens ++ EncToken.clauseSep :: (CNF.tokens cs ++ toks) by simp [List.append_assoc]] + rw [hclause] + simp [ih, List.reverse_cons, List.append_assoc] + +private theorem parseTokensAux_sound + {toks : List EncToken} {rawRev : List Bool} {clauseRev : Clause} + {cnfRev φ : CNF} + (h : parseTokensAux toks rawRev clauseRev cnfRev = some φ) : + CNF.tokens cnfRev.reverse ++ Clause.tokens clauseRev.reverse ++ + rawRev.reverse.map EncToken.bit ++ toks = + CNF.tokens φ := by + induction toks generalizing rawRev clauseRev cnfRev φ with + | nil => + cases rawRev <;> cases clauseRev <;> simp [parseTokensAux, Clause.tokens] at h ⊢ + cases h + simp + | cons tok toks ih => + cases tok with + | bit b => + simp [parseTokensAux] at h + have hrec := ih h + simpa [List.reverse_cons, List.append_assoc] using hrec + | litSep => + simp [parseTokensAux] at h + rcases hdecode : Lit.decodeRaw? rawRev.reverse with _ | ℓ + · simp [hdecode] at h + · simp [hdecode] at h + have hrec := ih h + have hraw : rawRev.reverse = ℓ.encodeRaw := Lit.decodeRaw?_sound hdecode + simpa [hraw, Clause.tokens, Clause.tokens_append, Lit.rawTokens, + List.reverse_cons, List.append_assoc] using hrec + | clauseSep => + simp [parseTokensAux] at h + rcases h with ⟨hraw, hrest⟩ + have hrec := ih hrest + simpa [hraw, CNF.tokens, CNF.tokens_append, Clause.tokens, + List.reverse_cons, List.append_assoc] using hrec + +/-- Decode a concrete SAT-encoded bitstring as a CNF. -/ +def CNF.decode? (z : List Bool) : Option CNF := do + let toks <- tokenize? z + parseTokensAux toks [] [] [] + +/-- Round trip: decoding an encoded CNF recovers the formula. -/ +@[simp] theorem CNF.decode?_encode (φ : CNF) : + CNF.decode? φ.encode = some φ := by + rw [CNF.decode?, ← CNF.encodeTokens_tokens φ, tokenize?_encodeTokens] + simp + have hparse := parseTokensAux_cnf_tokens φ [] [] + simpa [parseTokensAux] using hparse + +/-- Soundness of `CNF.decode?`: any successfully decoded bitstring is the +encoding of the resulting CNF. -/ +theorem CNF.decode?_sound {z : List Bool} {φ : CNF} + (h : CNF.decode? z = some φ) : z = φ.encode := by + unfold CNF.decode? at h + cases htok : tokenize? z with + | none => + simp [htok] at h + | some toks => + simp [htok] at h + have hz : z = encodeTokens toks := tokenize?_sound htok + have htoks : toks = CNF.tokens φ := by + simpa using (parseTokensAux_sound h) + calc + z = encodeTokens toks := hz + _ = encodeTokens (CNF.tokens φ) := by rw [htoks] + _ = φ.encode := CNF.encodeTokens_tokens φ + +-- ════════════════════════════════════════════════════════════════════════ +-- Executable verifier specification +-- ════════════════════════════════════════════════════════════════════════ + +/-- Boolean verifier for SAT's witness relation on paired inputs. -/ +def verifyPair (w : List Bool) : Bool := + match unpair? w with + | none => false + | some (z, α) => + match CNF.decode? z with + | none => false + | some φ => decide (α.length ≤ z.length + 1) && CNF.eval α φ + +/-- On a well-formed pair `pair(φ.encode, α)`, `verifyPair` reduces to the +witness length check conjoined with evaluating `φ` under `α`. -/ +@[simp] theorem verifyPair_pair_encode (φ : CNF) (α : Assignment) : + verifyPair (pair φ.encode α) = (decide (α.length ≤ φ.encode.length + 1) && CNF.eval α φ) := by + simp [verifyPair, CNF.decode?_encode] + +/-- Completeness: `verifyPair` accepts the pairing of any witnessed instance. -/ +theorem verifyPair_true_of_witness {z α : List Bool} (hR : Witness z α) : + verifyPair (pair z α) = true := by + obtain ⟨φ, hz, hlen, heval⟩ := hR + subst hz + simp [verifyPair_pair_encode, hlen, heval] + +/-- Correctness of the verifier: `verifyPair` accepts exactly the members of +`pairLang Witness`. -/ +theorem verifyPair_eq_true_iff_mem_pairLang (w : List Bool) : + verifyPair w = true ↔ w ∈ pairLang Witness := by + constructor + · intro h + unfold verifyPair at h + cases hunpair : unpair? w with + | none => + simp [hunpair] at h + | some zw => + rcases zw with ⟨z, α⟩ + simp [hunpair] at h + cases hdecode : CNF.decode? z with + | none => + simp [hdecode] at h + | some φ => + simp [hdecode] at h + have hz : z = φ.encode := CNF.decode?_sound hdecode + have hw : w = pair z α := eq_pair_of_unpair?_eq_some hunpair + have hlen : α.length ≤ z.length + 1 := by + simpa [decide_eq_true_eq] using h.1 + refine ⟨z, α, hw, ?_⟩ + exact ⟨φ, hz, hlen, h.2⟩ + · rintro ⟨z, α, rfl, hR⟩ + exact verifyPair_true_of_witness hR + +/-- `verifyPair_eq_true_iff_mem_pairLang` with the biconditional flipped. -/ +theorem mem_pairLang_iff_verifyPair (w : List Bool) : + w ∈ pairLang Witness ↔ verifyPair w = true := by + rw [verifyPair_eq_true_iff_mem_pairLang] + +/-- `pairLang Witness` equals the language decided by `verifyPair`, as sets. -/ +theorem pairLang_witness_eq_verifyPairLang : + pairLang Witness = {w | verifyPair w = true} := by + ext w + exact mem_pairLang_iff_verifyPair w + +end SAT + +end Complexity diff --git a/LeanPool/BeyondBethe/Solution.lean b/LeanPool/BeyondBethe/Solution.lean new file mode 100644 index 0000000000..6afe187650 --- /dev/null +++ b/LeanPool/BeyondBethe/Solution.lean @@ -0,0 +1,37 @@ +/- +Copyright (c) 2026 Nima Anari. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Nima Anari +-/ + +import LeanPool.BeyondBethe.BeyondBethe.Main +import LeanPool.BeyondBethe.BeyondBethe.PalomarComplexity +import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham + +/-! +# Proved solution for the Palomar statement + +Comparator checks that `Palomar.beyond_bethe_permanent` has exactly the same +type as its counterpart in `Challenge.lean`. The proof below extracts the +concrete algorithm and its finite-word Turing-machine implementation from the +fully internal theorem `BeyondBethe.theoremOne`, then applies Complexitylib's +formal proof of Cobham's characterization of polynomial time. +-/ + +namespace Palomar + +theorem beyond_bethe_permanent : + ∃ (c : ℝ) + (alg : ∀ n, Matrix (Fin n) (Fin n) ℚ → ℚ) + (F : List Bool → List Bool), + BeyondBethe.ApproximationGuarantee alg c ∧ + F ∈ BeyondBethe.PalomarComplexity.CobhamFP ∧ + BeyondBethe.StringRealizes F alg := by + obtain ⟨spec⟩ := BeyondBethe.theoremOne + obtain ⟨F, hF, hrealizes⟩ := spec.polynomialTime + refine ⟨spec.c, spec.alg, F, spec.guarantee, ?_, hrealizes⟩ + apply BeyondBethe.PalomarComplexity.cobhamFP_of_complexity + rw [Complexity.CobhamFP_eq_FP] + exact hF + +end Palomar diff --git a/LeanPool/projects.yml b/LeanPool/projects.yml index 95e0c8ad83..b347e1667a 100644 --- a/LeanPool/projects.yml +++ b/LeanPool/projects.yml @@ -9966,3 +9966,35 @@ projects: msc: - '90C35' - '05C21' + - title: Beyond the Bethe approximation of the permanent + summary: Constructs a deterministic polynomial-time approximation algorithm for the permanent of + every nonnegative rational matrix, with exponential base strictly smaller than the square root + of two. The development includes stable-polynomial inequalities, rational convex optimization, + finite-precision arithmetic, and a Turing-machine complexity proof. + branch: theoretical computer science + provenance: AI + main_declarations: + - BeyondBethe.theoremOne + main_results: + - declaration: BeyondBethe.theoremOne + informal: There is a fixed rational algorithm approximating the permanent of every nonnegative + rational n-by-n matrix within c^n for an absolute c below sqrt(2), with a deterministic polynomial-time + Turing-machine implementation. + tags: + - permanent + - approximation-algorithms + - computational-complexity + - stable-polynomials + msc: + - 68W25 + - 15A15 + slug: formalization-beyond-bethe + entry_module: LeanPool.BeyondBethe + authors: + - Nima Anari + source: + url: https://github.com/nimaanari/formalization-beyond-bethe + github_repo: nimaanari/formalization-beyond-bethe + commit: 325cda6d2118870f7f121a9a986b7ea9ffdd7a26 + license: Apache-2.0 + status: verified From de914811c48321611bfb3937028c1f4b5825286e Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Mon, 21 Sep 2026 18:42:39 +0000 Subject: [PATCH 02/49] Port complete upstream content to current Mathlib and improve lint compliance --- .../BeyondBethe/ApproximateKKT.lean | 4 +- .../BeyondBethe/BetheEpigraphGeometry.lean | 4 +- .../BeyondBethe/BinaryLongDivision.lean | 4 +- .../BeyondBethe/BinaryRationalFloor.lean | 2 +- .../BeyondBethe/CertifiedPairWeights.lean | 6 +- .../BeyondBethe/BeyondBethe/CleanWitness.lean | 6 +- .../BeyondBethe/ClusterProduct.lean | 4 +- LeanPool/BeyondBethe/BeyondBethe/Cycles.lean | 8 +- .../BeyondBethe/DirectedCertificateValue.lean | 2 +- .../BeyondBethe/DyadicMagnitudePrecision.lean | 2 +- LeanPool/BeyondBethe/BeyondBethe/Entropy.lean | 8 +- .../BeyondBethe/ExecutableCertificate.lean | 4 +- .../BeyondBethe/ExplicitBounds.lean | 2 +- .../BeyondBethe/ExplicitScales.lean | 2 +- LeanPool/BeyondBethe/BeyondBethe/Gibbs.lean | 2 +- .../BeyondBethe/BeyondBethe/GoodRowScore.lean | 4 +- .../BeyondBethe/BeyondBethe/KuhnMatching.lean | 6 +- .../MachineBetheAffineLineSum.lean | 8 +- .../MachineBetheFloorCutEntry.lean | 2 +- .../BeyondBethe/MachineBinaryAdd.lean | 2 +- .../BeyondBethe/MachineBinaryDivision.lean | 2 +- .../BeyondBethe/MachineBinaryGCD.lean | 2 +- .../BeyondBethe/MachineBinaryListSnoc.lean | 2 +- .../BeyondBethe/MachineBinaryMul.lean | 2 +- .../BeyondBethe/MachineBinarySub.lean | 2 +- .../BeyondBethe/MachineDirectedLog.lean | 16 +-- .../BeyondBethe/MachineDyadicFloor.lean | 8 +- .../BeyondBethe/MachineGreedyRowMatching.lean | 16 +-- .../BeyondBethe/MachineIntegerArithmetic.lean | 2 +- .../BeyondBethe/MachineKuhnEncoding.lean | 4 +- .../MachineOptimizerDerivedScales.lean | 4 +- .../MachineRationalDirectionUpdateMatrix.lean | 2 +- .../BeyondBethe/MachineRationalExp.lean | 4 +- .../BeyondBethe/MachineRationalMin.lean | 4 +- .../BeyondBethe/MachineRepeatPair.lean | 2 +- .../BeyondBethe/MachineSmoothingDelta.lean | 8 +- .../BeyondBethe/MachineTrimHighZeros.lean | 4 +- .../BeyondBethe/MatrixPerturbation.lean | 2 +- .../BeyondBethe/BeyondBethe/NearCase.lean | 2 +- .../BeyondBethe/NumericalAffine.lean | 2 +- .../BeyondBethe/NumericalScales.lean | 6 +- .../BeyondBethe/BeyondBethe/Optimizer.lean | 2 +- .../BeyondBethe/PairedCertificate.lean | 2 +- .../BeyondBethe/RationalEllipsoid.lean | 2 +- .../BeyondBethe/BeyondBethe/RobustCycle.lean | 8 +- .../RoundedEllipsoidBitBounds.lean | 2 +- .../BeyondBethe/BeyondBethe/RowStability.lean | 10 +- .../BeyondBethe/SourceBetheLower.lean | 2 +- .../BeyondBethe/SourceBetheUpper.lean | 2 +- .../BeyondBethe/SourceStableClosure.lean | 2 +- .../BeyondBethe/SourceStableEncoding.lean | 4 +- .../BeyondBethe/StrongEntropy.lean | 2 +- .../Complexitylib/Asymptotics.lean | 18 +-- .../Circuits/Encoding/Internal/Codec.lean | 2 +- .../Complexitylib/Classes/P/Cobham/Defs.lean | 2 +- .../Classes/P/Cobham/Internal.lean | 24 ++-- .../Classes/P/Cobham/Internal/Algebra.lean | 16 +-- .../Classes/P/Cobham/Internal/Blocks.lean | 16 +-- .../Classes/P/Cobham/Internal/ConsBit.lean | 4 +- .../Classes/P/Cobham/Internal/Encoding.lean | 20 ++-- .../Classes/P/Cobham/Internal/Extract.lean | 14 +-- .../Classes/P/Cobham/Internal/HeadFlag.lean | 4 +- .../Classes/P/Cobham/Internal/Iterate.lean | 54 ++++----- .../P/Cobham/Internal/IterateLayout.lean | 28 ++--- .../Classes/P/Cobham/Internal/MulLen.lean | 62 +++++----- .../Classes/P/Cobham/Internal/Reverse.lean | 26 ++--- .../Classes/P/Cobham/Internal/Simulate.lean | 6 +- .../Classes/P/Cobham/Internal/SndBlock.lean | 12 +- .../P/Cobham/Internal/StepAlgebra.lean | 16 +-- .../Classes/P/Cobham/Internal/TakeLen.lean | 58 ++++----- .../Classes/P/Cobham/Internal/Vec.lean | 4 +- .../Complexitylib/Classes/P/Cobham/Vec.lean | 2 +- .../Complexitylib/Classes/P/FinsetDomain.lean | 4 +- .../Classes/P/FinsetDomain/Internal.lean | 10 +- .../Models/RandomAccessMachine.lean | 10 +- .../Models/RandomAccessMachine/Defs.lean | 4 +- .../Models/RandomAccessMachine/Internal.lean | 32 ++--- .../RegisterStore/DenseOverlay/Internal.lean | 14 +-- .../Simulation/RegisterStore/Internal.lean | 38 +++--- .../Machine/DenseInputLookup/Internal.lean | 30 ++--- .../Machine/EntryCleanup/Internal.lean | 6 +- .../Machine/EntryLookup/Internal.lean | 4 +- .../Machine/EntryMissCopy/Internal.lean | 6 +- .../Machine/EntryReplace/Internal.lean | 6 +- .../Machine/EntryScan/Internal/Ctrl.lean | 18 +-- .../Machine/EntryUpdate/Internal/Ctrl.lean | 64 +++++----- .../Machine/EntryUpdate/Internal/Time.lean | 4 +- .../Machine/Instruction/Control.lean | 4 +- .../Machine/Instruction/DenseControl.lean | 4 +- .../Machine/Program/Bounds/Defs.lean | 4 +- .../Machine/Program/DenseBoundsProof.lean | 12 +- .../Machine/Program/DenseInitProof.lean | 22 ++-- .../Machine/Program/DenseInternal.lean | 2 +- .../Machine/Program/Init/Internal.lean | 60 +++++----- .../Machine/Program/Internal.lean | 6 +- .../Machine/WordDecode/Defs.lean | 2 +- .../Machine/WordDecode/Internal.lean | 4 +- .../Machine/WordDecode/LinearInternal.lean | 30 ++--- .../Simulation/TMConfig/Internal.lean | 2 +- .../TMConfig/Sparse/ABI/Internal/Capture.lean | 2 +- .../TMConfig/Sparse/ABI/Internal/Marshal.lean | 8 +- .../Sparse/ABI/Internal/Resources.lean | 4 +- .../Simulation/TMConfig/Sparse/Internal.lean | 4 +- .../TMConfig/Sparse/Step/Internal/Action.lean | 4 +- .../Sparse/Step/Internal/Iteration.lean | 2 +- .../Sparse/Step/Internal/Resources.lean | 4 +- .../Simulation/TMConfig/Step.lean | 2 +- .../TMConfig/Step/Internal/Action.lean | 6 +- .../Models/RandomAccessMachine/Soundness.lean | 8 +- .../Structured/GateStep/Internal.lean | 4 +- .../Structured/Hamming/Defs.lean | 4 +- .../Structured/Hamming/Internal.lean | 2 +- .../Structured/Internal.lean | 12 +- .../Structured/Internal/Resources.lean | 4 +- .../Structured/UnaryDecode/Defs.lean | 4 +- .../Complexitylib/Models/TuringMachine.lean | 4 +- .../Combinators/ForBinaryWork/Internal.lean | 14 +-- .../Combinators/ForInput/Internal.lean | 22 ++-- .../Combinators/ForWorkOnes/Internal.lean | 26 ++--- .../Combinators/Internal/If.lean | 12 +- .../Combinators/Internal/Loop.lean | 8 +- .../Combinators/Internal/Retarget.lean | 6 +- .../Combinators/Internal/Scanner.lean | 8 +- .../Combinators/Internal/Seq.lean | 6 +- .../Combinators/Internal/Union.lean | 62 +++++----- .../Combinators/WorkBranch/Internal.lean | 12 +- .../WorkSymbolBranch/Internal.lean | 12 +- .../Composition/PairWithInput.lean | 2 +- .../Models/TuringMachine/Internal.lean | 10 +- .../Models/TuringMachine/Lift.lean | 14 +-- .../TuringMachine/Placement/Internal.lean | 2 +- .../Models/TuringMachine/Registers.lean | 14 +-- .../Models/TuringMachine/Registers/Arith.lean | 4 +- .../Models/TuringMachine/Registers/Emit.lean | 60 +++++----- .../TuringMachine/Registers/ForReg.lean | 48 ++++---- .../TuringMachine/Registers/Horner.lean | 10 +- .../TuringMachine/Registers/InputLen.lean | 46 ++++---- .../TuringMachine/Registers/RegisterOps.lean | 110 +++++++++--------- .../Subroutines/BinaryAddConst.lean | 8 +- .../Subroutines/BinaryAddConst/Defs.lean | 6 +- .../Subroutines/BinaryAddConst/Internal.lean | 4 +- .../Subroutines/BinaryEq/Internal.lean | 20 ++-- .../Subroutines/BinaryFor/Defs.lean | 28 ++--- .../BinaryFor/Internal/Comparison.lean | 2 +- .../BinaryFor/Internal/Control.lean | 74 ++++++------ .../Subroutines/BinaryPred/Defs.lean | 24 ++-- .../Subroutines/BinaryPred/Internal.lean | 46 ++++---- .../Subroutines/BinaryRippleAdd/Defs.lean | 16 +-- .../BinaryRippleAdd/Internal/Scan.lean | 46 ++++---- .../Subroutines/BinaryRippleSub/Defs.lean | 32 ++--- .../BinaryRippleSub/Internal/Backward.lean | 36 +++--- .../BinaryRippleSub/Internal/Pure.lean | 2 +- .../BinaryRippleSub/Internal/Scan.lean | 38 +++--- .../BinaryShiftMul/Internal/Sem.lean | 12 +- .../Subroutines/BinarySucc/Defs.lean | 12 +- .../Subroutines/BinarySucc/Internal.lean | 24 ++-- .../Subroutines/Internal/CopyWorkOutput.lean | 6 +- .../Subroutines/MoveLeftStep.lean | 8 +- .../Subroutines/PairValidate/Internal.lean | 2 +- .../TuringMachine/Subroutines/ParkAll.lean | 6 +- .../TuringMachine/Subroutines/ResetTapes.lean | 12 +- .../TuringMachine/Subroutines/WipeLoop.lean | 44 +++---- .../TuringMachine/Subroutines/WipeStep.lean | 2 +- .../Models/TuringMachine/Tape/Encoding.lean | 4 +- .../Complexitylib/SAT/ThreeSAT/Syntax.lean | 4 +- 165 files changed, 1055 insertions(+), 1055 deletions(-) diff --git a/LeanPool/BeyondBethe/BeyondBethe/ApproximateKKT.lean b/LeanPool/BeyondBethe/BeyondBethe/ApproximateKKT.lean index 006ee1ec6c..fcb0d67fd3 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/ApproximateKKT.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/ApproximateKKT.lean @@ -28,7 +28,7 @@ used by the permanent certificate. The executable elementary-function oracle approximates the *negative* gradient. The last theorem below records the corresponding sign and the -additive fixedValue `2 + tau` explicitly. +additive constant `2 + tau` explicitly. -/ /-- On a common floor `delta`, one coordinate of the regularized Bethe @@ -171,7 +171,7 @@ theorem negativeGradient_close_of_objective_gap /-- The complete analytic bridge to the certificate interface. `Gtilde` is an executable approximation to the negative gradient at the returned point `Y`. Anchoring it produces explicit potentials; the signs and the derivative -fixedValue are incorporated in the displayed output potentials. -/ +constant are incorporated in the displayed output potentials. -/ theorem approximateLogKKT_of_objective_gap {ι : Type*} [Fintype ι] [DecidableEq ι] [Nonempty ι] (hcard : 1 < Fintype.card ι) diff --git a/LeanPool/BeyondBethe/BeyondBethe/BetheEpigraphGeometry.lean b/LeanPool/BeyondBethe/BeyondBethe/BetheEpigraphGeometry.lean index e39324fffd..c7bfd972c8 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/BetheEpigraphGeometry.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/BetheEpigraphGeometry.lean @@ -730,7 +730,7 @@ theorem BetheEpigraphTarget_inner_cross_outer_zero calc abs (upper - r) ≤ abs upper + abs r := abs_sub upper r _ = abs upper + r := by rw [abs_of_nonneg hr] - simp only [epigraphPoint, Fin.snoc_last, if_neg hk, add_zero] + simp only [epigraphPoint, Fin.snoc_last, ite_eq_right hk, add_zero] exact htriangle.trans (by dsimp only [C]; linarith) · have hbase := BetheEpigraphTarget_epigraphBase_abs_le_one hδ (hplus k) l @@ -758,7 +758,7 @@ theorem BetheEpigraphTarget_inner_cross_outer_zero calc abs (upper - r) ≤ abs upper + abs r := abs_sub upper r _ = abs upper + r := by rw [abs_of_nonneg hr] - simp only [epigraphPoint, Fin.snoc_last, if_neg hk, sub_zero] + simp only [epigraphPoint, Fin.snoc_last, ite_eq_right hk, sub_zero] exact htriangle.trans (by dsimp only [C]; linarith) · have hbase := BetheEpigraphTarget_epigraphBase_abs_le_one hδ (hminus k) l diff --git a/LeanPool/BeyondBethe/BeyondBethe/BinaryLongDivision.lean b/LeanPool/BeyondBethe/BeyondBethe/BinaryLongDivision.lean index e160aaf8f6..8a52a8ba16 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/BinaryLongDivision.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/BinaryLongDivision.lean @@ -254,13 +254,13 @@ theorem binaryEuclidStep_two_snd_le_half (a b : ℕ) : dsimp only [r] exact Nat.mod_lt _ hbpos have hfirst : binaryEuclidStep (a, b) = (b, r) := by - rw [binaryEuclidStep_eq, if_neg hb] + rw [binaryEuclidStep_eq, ite_eq_right hb] rw [show (binaryEuclidStep^[2]) (a, b) = binaryEuclidStep (binaryEuclidStep (a, b)) by rfl, hfirst] by_cases hr : r = 0 · rw [hr, binaryEuclidStep_zero] simp - · rw [binaryEuclidStep_eq, if_neg hr] + · rw [binaryEuclidStep_eq, ite_eq_right hr] simp only [Prod.snd] exact mod_le_half_of_pos_of_lt (Nat.pos_of_ne_zero hr) hrb diff --git a/LeanPool/BeyondBethe/BeyondBethe/BinaryRationalFloor.lean b/LeanPool/BeyondBethe/BeyondBethe/BinaryRationalFloor.lean index 8f117b10d9..bb5754f8e3 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/BinaryRationalFloor.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/BinaryRationalFloor.lean @@ -56,7 +56,7 @@ theorem binaryRatFloor_eq_floor (q : ℚ) : have hndvdInt : ¬(q.den : ℤ) ∣ ((n + 1 : ℕ) : ℤ) := by exact_mod_cast hndvdNat have hrepr : Int.negSucc n = -((n + 1 : ℕ) : ℤ) := by omega - rw [hrepr, Int.neg_ediv, if_neg hndvdInt, + rw [hrepr, Int.neg_ediv, ite_eq_right hndvdInt, Int.sign_eq_one_of_pos (by exact_mod_cast hden)] norm_num [Nat.add_comm] ring diff --git a/LeanPool/BeyondBethe/BeyondBethe/CertifiedPairWeights.lean b/LeanPool/BeyondBethe/BeyondBethe/CertifiedPairWeights.lean index 54c52df1e2..71a4b7280e 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/CertifiedPairWeights.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/CertifiedPairWeights.lean @@ -13,7 +13,7 @@ import Mathlib.Tactic namespace BeyondBethe /-! -# Executable fixedValue-gain row-pair certificates +# Executable constant-gain row-pair certificates A row pair is retained when some two distinct columns pass the directed four-core-cost test. Every retained pair receives the same rational gain. @@ -57,7 +57,7 @@ theorem certifiedConstantRowWeight_eq_gamma_iff {n : ℕ} HasCertifiedCorePair τ X κ p q := by by_cases h : HasCertifiedCorePair τ X κ p q · simp [certifiedConstantRowWeight, h] - · rw [certifiedConstantRowWeight, if_neg h] + · rw [certifiedConstantRowWeight, ite_eq_right h] exact iff_of_false (fun he ↦ hγ he.symm) h theorem certifiedConstantRowWeight_eq_gamma_of_threshold {n : ℕ} @@ -241,7 +241,7 @@ theorem nearCase_greedyCertifiedMatchingGain_ge_threeSixteenths _ ≤ _ := hgreedy /-- The matching test uses the same fixed precision as the final certificate -evaluation. The generous additive fixedValue keeps the executable matcher and +evaluation. The generous additive constant keeps the executable matcher and its analytic correctness theorem literally aligned. -/ def directedPairCostPrecision (n : ℕ) : ℕ := n + 400 diff --git a/LeanPool/BeyondBethe/BeyondBethe/CleanWitness.lean b/LeanPool/BeyondBethe/BeyondBethe/CleanWitness.lean index e00123fadb..6ec5cda11b 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/CleanWitness.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/CleanWitness.lean @@ -725,7 +725,7 @@ theorem cleanWitness_coreA_moment (cleanWitnessExponent a b) a = αa := by rw [exponentMoment] simp only [Fintype.sum_sum_type, Fintype.sum_unique, - cleanWitnessExponent, if_pos (Or.inl rfl), Nat.cast_one, mul_one] + cleanWitnessExponent, ite_eq_left (Or.inl rfl), Nat.cast_one, mul_one] have hright : ∀ l : OutsideColumn a b, ((if a = b ∨ a = l.1 then 1 else 0 : ℕ) : ℝ) = 0 := by intro l @@ -744,7 +744,7 @@ theorem cleanWitness_coreB_moment (cleanWitnessExponent a b) b = αb := by rw [exponentMoment] simp only [Fintype.sum_sum_type, Fintype.sum_unique, - cleanWitnessExponent, if_pos (Or.inr rfl), Nat.cast_one, mul_one] + cleanWitnessExponent, ite_eq_left (Or.inr rfl), Nat.cast_one, mul_one] have hleft : ∀ l : OutsideColumn a b, ((if b = a ∨ b = l.1 then 1 else 0 : ℕ) : ℝ) = 0 := by intro l @@ -765,7 +765,7 @@ theorem cleanWitness_outside_moment cleanWitnessExponent] have hcore : ¬(l.1 = a ∨ l.1 = b) := by exact fun h ↦ h.elim l.ne_a l.ne_b - rw [if_neg hcore, Nat.cast_zero, mul_zero, zero_add] + rw [ite_eq_right hcore, Nat.cast_zero, mul_zero, zero_add] have hleft : (∑ x : OutsideColumn a b, capacityWitnessMass ρ δa δb α (Sum.inr (Sum.inl x)) * diff --git a/LeanPool/BeyondBethe/BeyondBethe/ClusterProduct.lean b/LeanPool/BeyondBethe/BeyondBethe/ClusterProduct.lean index 91a61489aa..9c8f61fe9e 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/ClusterProduct.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/ClusterProduct.lean @@ -478,9 +478,9 @@ theorem coefficientInnerProduct_rowClusterProduct_eq_permanent apply Finset.sum_congr rfl intro f _ by_cases hg : IsGlobalClusterChoice C f - · rw [if_pos hg, + · rw [ite_eq_left hg, sum_selector_matches_choice_of_global C f _ hg] - · rw [if_neg hg, + · rw [ite_eq_right hg, sum_selector_matches_choice_of_not_global C f _ hg] _ = ∑ f : GlobalClusterChoice C, clusterChoiceWeight A C f.1 := by apply Finset.sum_subtype diff --git a/LeanPool/BeyondBethe/BeyondBethe/Cycles.lean b/LeanPool/BeyondBethe/BeyondBethe/Cycles.lean index 02d0637991..6685ecb6bb 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/Cycles.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/Cycles.lean @@ -665,8 +665,8 @@ theorem component_accounting have hpartR : (g c : ℝ) + b c = k c := by exact_mod_cast hpartition c by_cases hk3 : 3 ≤ k c · have hk2 : 2 ≤ k c := by omega - simp only [longComponentGoodRows, if_pos hk3, - nontrivialComponentCount, if_pos hk2, Nat.cast_one] + simp only [longComponentGoodRows, ite_eq_left hk3, + nontrivialComponentCount, ite_eq_left hk2, Nat.cast_one] have hk3R : (3 : ℝ) ≤ k c := by exact_mod_cast hk3 nlinarith · have hklt : k c < 3 := by omega @@ -677,8 +677,8 @@ theorem component_accounting simp [longComponentGoodRows, nontrivialComponentCount, hk1, hgzero] positivity · have hk2 : 2 ≤ k c := by omega - simp only [longComponentGoodRows, if_neg hk3, - nontrivialComponentCount, if_pos hk2, Nat.cast_zero, zero_div, + simp only [longComponentGoodRows, ite_eq_right hk3, + nontrivialComponentCount, ite_eq_left hk2, Nat.cast_zero, zero_div, Nat.cast_one] have hk2R : (k c : ℝ) = 2 := by exact_mod_cast hk2eq nlinarith diff --git a/LeanPool/BeyondBethe/BeyondBethe/DirectedCertificateValue.lean b/LeanPool/BeyondBethe/BeyondBethe/DirectedCertificateValue.lean index d93f2622dd..55a5839207 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/DirectedCertificateValue.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/DirectedCertificateValue.lean @@ -225,7 +225,7 @@ theorem directedNearbyBetheLower_bounds constructor <;> linarith /-- Fixed precision used for evaluating the final logarithmic certificate. -The additive fixedValue is deliberately generous; it is independent of the +The additive constant is deliberately generous; it is independent of the input and absorbs the tiny hard-coded structural scale. -/ def directedCertificatePrecision (n : ℕ) : ℕ := n + 400 diff --git a/LeanPool/BeyondBethe/BeyondBethe/DyadicMagnitudePrecision.lean b/LeanPool/BeyondBethe/BeyondBethe/DyadicMagnitudePrecision.lean index 95e0e7e91a..6f8a62cca1 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/DyadicMagnitudePrecision.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/DyadicMagnitudePrecision.lean @@ -21,7 +21,7 @@ denominator with `d p` bits even when its numerical magnitude is bounded away from zero. Iterating that rule would multiply the stored precision by the dimension. The definition below instead uses the *difference* between the denominator and numerator bit lengths. It therefore measures -`log₂ (1 / q)`, up to an additive fixedValue, rather than the cost of writing +`log₂ (1 / q)`, up to an additive constant, rather than the cost of writing the exact reduced fraction. -/ diff --git a/LeanPool/BeyondBethe/BeyondBethe/Entropy.lean b/LeanPool/BeyondBethe/BeyondBethe/Entropy.lean index 5e6ca0bdbe..95346520db 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/Entropy.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/Entropy.lean @@ -311,9 +311,9 @@ theorem pushforwardMass_isProbabilityVector · intro y exact Finset.sum_nonneg (fun x _ ↦ by by_cases h : f x = y - · simp only [if_pos h] + · simp only [ite_eq_left h] exact hμ.nonnegative x - · simp only [if_neg h] + · simp only [ite_eq_right h] exact le_rfl) · simp only [pushforwardMass] calc @@ -345,13 +345,13 @@ theorem pushforwardMass_comp apply Finset.sum_congr rfl intro x _ by_cases hx : g (f x) = z - · simp only [Function.comp_apply, if_pos hx] + · simp only [Function.comp_apply, ite_eq_left hx] rw [Finset.sum_eq_single (f x)] · simp [hx] · intro y _ hy simp [Ne.symm hy] · simp - · simp only [Function.comp_apply, if_neg hx] + · simp only [Function.comp_apply, ite_eq_right hx] apply Finset.sum_eq_zero intro y _ by_cases hy : f x = y diff --git a/LeanPool/BeyondBethe/BeyondBethe/ExecutableCertificate.lean b/LeanPool/BeyondBethe/BeyondBethe/ExecutableCertificate.lean index d819487d8e..6bf7be49fd 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/ExecutableCertificate.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/ExecutableCertificate.lean @@ -125,12 +125,12 @@ theorem explicitCertified_certificate_of_logKKT (show 1 < n by omega) (by exact_mod_cast hτ0q) hA hX hmax have hmatch := positiveMatrix_hasPerfectMatching hA have hlogBethe : Real.log (bethePermanent A) = betheLogValue A := by - rw [bethePermanent, if_pos hmatch, Real.log_exp] + rw [bethePermanent, ite_eq_left hmatch, Real.log_exp] rw [hlogBethe] linarith have hmatch := positiveMatrix_hasPerfectMatching hA have hlogBethe : Real.log (bethePermanent A) = betheLogValue A := by - rw [bethePermanent, if_pos hmatch, Real.log_exp] + rw [bethePermanent, ite_eq_left hmatch, Real.log_exp] have hupper : Real.log (Matrix.permanent A) ≤ Real.log (bethePermanent A) + n * (Real.log 2 / 2) := by rw [hlogBethe] diff --git a/LeanPool/BeyondBethe/BeyondBethe/ExplicitBounds.lean b/LeanPool/BeyondBethe/BeyondBethe/ExplicitBounds.lean index a1d7b87f8f..8242a29ab1 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/ExplicitBounds.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/ExplicitBounds.lean @@ -376,7 +376,7 @@ theorem abs_continuousSuffixError_near_half _ = 29 * r := by ring /-- An explicit modulus for the complete three-variable good-row expression. -The fixedValue `70` is deliberately loose; having a transparent computable +The constant `70` is deliberately loose; having a transparent computable bound is more important than optimizing this one-time structural constant. -/ theorem abs_continuousGoodRowPsi_sub_center_le {u v q r : ℝ} (hr0 : 0 ≤ r) (hr1 : r ≤ 1 / 10) diff --git a/LeanPool/BeyondBethe/BeyondBethe/ExplicitScales.lean b/LeanPool/BeyondBethe/BeyondBethe/ExplicitScales.lean index 1b1a60f31d..3d4a6c4fd7 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/ExplicitScales.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/ExplicitScales.lean @@ -385,7 +385,7 @@ def explicitGreedyCompletionScales : _ ≤ 1 / 200000 := hδsmall _ < 3 * ((1 / 4) / 4) / 8 := by norm_num } -/-- Structural data weakened exactly by the fixedValue-factor loss of the +/-- Structural data weakened exactly by the constant-factor loss of the greedy implementation. All analytic inequalities and hard-coded scales are unchanged. -/ def explicitGreedyStructuralScales : RationalStructuralScales where diff --git a/LeanPool/BeyondBethe/BeyondBethe/Gibbs.lean b/LeanPool/BeyondBethe/BeyondBethe/Gibbs.lean index b996d04161..8f0e2f41c6 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/Gibbs.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/Gibbs.lean @@ -152,7 +152,7 @@ theorem assignmentMarginal_pos · exact (permutationWeight_pos A hA σ).le · rfl · refine ⟨Equiv.swap j i, Finset.mem_univ _, ?_⟩ - simp only [Equiv.swap_apply_left, if_pos] + simp only [Equiv.swap_apply_left, ite_eq_left] exact permutationWeight_pos A hA (Equiv.swap j i) theorem assignmentMarginal_strictProbabilityVector diff --git a/LeanPool/BeyondBethe/BeyondBethe/GoodRowScore.lean b/LeanPool/BeyondBethe/BeyondBethe/GoodRowScore.lean index 3632a5b06d..2f39428b96 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/GoodRowScore.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/GoodRowScore.lean @@ -364,10 +364,10 @@ theorem average_suffixError_core_lower intro π have hright0 := strictRightMass_nonneg hp π a by_cases hbefore : CoordinateBefore b a π - · rw [if_pos hbefore] + · rw [ite_eq_left hbefore] exact suffixError_anti (hp.nonnegative a) hright0 (strictRightMass_le_outside_of_before hp hab hbefore) - · rw [if_neg hbefore] + · rw [ite_eq_right hbefore] have hright := strictRightMass_le_one_sub hp π a have hmass : p b + q = 1 - p a := by dsimp [q] diff --git a/LeanPool/BeyondBethe/BeyondBethe/KuhnMatching.lean b/LeanPool/BeyondBethe/BeyondBethe/KuhnMatching.lean index bab005bc73..1886e7675c 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/KuhnMatching.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/KuhnMatching.lean @@ -263,7 +263,7 @@ theorem kuhnSearchWork_le {n : ℕ} | case4 fuel col remaining row seen mate hskip hmate => rw [kuhnSearch.eq_def] dsimp only - rw [dif_neg hskip, hmate] + rw [dite_eq_right hskip, hmate] simp only [List.length_cons] have hnot : col ∉ seen := by aesop rw [Finset.card_insert_of_notMem hnot] @@ -272,7 +272,7 @@ theorem kuhnSearchWork_le {n : ℕ} mateWithoutOld recursive recursiveWork mateRec hrec ih => rw [kuhnSearch.eq_def] dsimp only - rw [dif_neg hskip, hmate] + rw [dite_eq_right hskip, hmate] simp rw [show (kuhnSearch A fuel (List.finRange n) oldRow (insert col seen) (Function.update mate col none)).mate? = some mateRec by @@ -299,7 +299,7 @@ theorem kuhnSearchWork_le {n : ℕ} mateWithoutOld recursive recursiveWork hrec ihRec ihContinue => rw [kuhnSearch.eq_def] dsimp only - rw [dif_neg hskip, hmate] + rw [dite_eq_right hskip, hmate] simp rw [show (kuhnSearch A fuel (List.finRange n) oldRow (insert col seen) (Function.update mate col none)).mate? = none by diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineBetheAffineLineSum.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineBetheAffineLineSum.lean index 2f66d8db1f..51e19ebd38 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineBetheAffineLineSum.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineBetheAffineLineSum.lean @@ -224,7 +224,7 @@ theorem bethe_flat_index_lt_word_length {m : ℕ} (rowMode : Bool) else current.1 * m + fixed.1) < m * m := by cases rowMode with | false => - simp only [Bool.false_eq_true, if_false] + simp only [Bool.false_eq_true, ite_false] calc current.1 * m + fixed.1 < current.1 * m + m := Nat.add_lt_add_left fixed.isLt _ @@ -262,7 +262,7 @@ theorem bethe_flat_index_lt_word_length {m : ℕ} (rowMode : Bool) | false => simp only [machineBetheFlatIndexBits, machineBetheFlatIndexMode, betheFlatIndexCanonicalWord, machinePairFirst_pair, - machineIfHead_false, Bool.false_eq_true, if_false] + machineIfHead_false, Bool.false_eq_true, ite_false] change machineBoundedUnary (pair (betheFlatIndexCanonicalWord false fixed current y) (machineBetheFlatIndexColumnBits @@ -305,7 +305,7 @@ theorem bethe_flat_index_lt_word_length {m : ℕ} (rowMode : Bool) machineBetheFlatIndexVector_encode] cases rowMode with | false => - simp only [Bool.false_eq_true, if_false, rationalFiniteVectorCode] + simp only [Bool.false_eq_true, ite_false, rationalFiniteVectorCode] have hk : current.1 * m + fixed.1 < (List.ofFn y).length := by simp only [List.length_ofFn] calc @@ -742,7 +742,7 @@ theorem betheAffineLineValue_cost_le_word {m : ℕ} (rowMode : Bool) have hzmem : z ∈ List.ofFn y := by cases rowMode with | false => - simp only [z, Bool.false_eq_true, if_false] + simp only [z, Bool.false_eq_true, ite_false] exact (List.mem_ofFn).2 ⟨finProdFinEquiv (current, fixed), rfl⟩ | true => simp only [z, if_true] diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineBetheFloorCutEntry.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineBetheFloorCutEntry.lean index e7cee43cc1..8003074983 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineBetheFloorCutEntry.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineBetheFloorCutEntry.lean @@ -13,7 +13,7 @@ import LeanPool.BeyondBethe.BeyondBethe.MachineBetheHeightCap For a queried recovered entry and a current base coordinate, this machine returns the canonical rational code of the corresponding cut coefficient. The four cases are a negative unit vector, a positive row, a positive column, -and the fixedValue negative-one vector. A supplied height-coordinate bit +and the constant negative-one vector. A supplied height-coordinate bit overrides all four cases with zero. -/ diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryAdd.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryAdd.lean index 580569038c..2bef8ddf49 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryAdd.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryAdd.lean @@ -171,7 +171,7 @@ def machineBinaryAddRuler (word : List Bool) : List Bool := machinePairFirst word ++ machinePairSecond word ++ [false] /-- A quadratic-width zero word. This is intentionally generous and makes -the bounded-iteration proof independent of fine fixedValue accounting. -/ +the bounded-iteration proof independent of fine constant accounting. -/ def machineBinaryAddWidth (word : List Bool) : List Bool := let padded := List.replicate 8 false ++ word List.replicate (padded.length * padded.length) false diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryDivision.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryDivision.lean index da111a540e..4658872eab 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryDivision.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryDivision.lean @@ -612,7 +612,7 @@ theorem natBits_ne_nil_of_ne_zero {n : ℕ} (hn : n ≠ 0) : n.bits ≠ [] := by by_cases hdivisor : divisor = 0 · simp [hdivisor] · by_cases htake : divisor ≤ remainder + remainder + bitValue bit - · simp only [hdivisor, if_false] + · simp only [hdivisor, ite_false] simp only [htake, decide_true, machineIfHead_true, machineBinaryDivDivisor_pack, if_true] rw [machineBinarySubBits_pair_natBits] diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryGCD.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryGCD.lean index 4de71415ae..eb6991ee96 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryGCD.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryGCD.lean @@ -99,7 +99,7 @@ theorem machineBinaryGcdStep_pair_natBits (a b : ℕ) : (natBits_ne_nil_of_ne_zero hb)] simp only [machineBinaryRemainderBits, machineBinaryDivModBits_pair_natBits, machinePairSecond_pair, - hb, if_false, Prod.fst, Prod.snd] + hb, ite_false, Prod.fst, Prod.snd] def MachineBinaryGcdReachable (word state : List Bool) : Prop := ∃ a b : ℕ, diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryListSnoc.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryListSnoc.lean index 878221fe0b..8772c98a41 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryListSnoc.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryListSnoc.lean @@ -10,7 +10,7 @@ import LeanPool.BeyondBethe.BeyondBethe.MachineListReverse # Appending one entry to a finite-word list The canonical list representation is right-nested, so appending an entry is -not a fixedValue-time constructor operation. This machine reverses the encoded +not a constant-time constructor operation. This machine reverses the encoded list, prepends the supplied encoded entry, and reverses once more. The two uses of the verified list-reversal machine make the construction total and polynomial-time on arbitrary finite words. diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryMul.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryMul.lean index 30106dd448..c4f0c7feb7 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryMul.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryMul.lean @@ -292,7 +292,7 @@ theorem binaryMulFold_natBits (bits : List Bool) (shift acc : ℕ) : rw [ih (shift + shift) acc] simp only [Nat.fromBitsLE_cons] congr 1 - simp only [Bool.false_eq_true, if_false] + simp only [Bool.false_eq_true, ite_false] ring | true => simp only [binaryMulFold, machineBinaryAddBits_pair_natBits] diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineBinarySub.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineBinarySub.lean index d9f911c3d4..034910291c 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineBinarySub.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineBinarySub.lean @@ -411,7 +411,7 @@ private theorem machineBinarySubIterate_max simp only [List.cons_ne_nil, List.nil_eq, and_false, ↓reduceIte, List.tail_cons, List.tail_nil, List.head?_cons, Option.getD_some, List.head?_nil, Option.getD_none] - simp only [false_and, if_false] + simp only [false_and, ite_false] rw [hrec'] simp [BinaryRippleSub.scan, List.reverse_cons, List.append_assoc] diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedLog.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedLog.lean index 9fe7033c2d..f3092affcf 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedLog.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedLog.lean @@ -717,13 +717,13 @@ def logUnit (q : ℚ) : RawRat := rw [logUnit, binaryRationalLogUnit] by_cases h : binaryRationalBinaryResidual q < 1 · have hnot : ¬ 1 ≤ (logResidual q).value := by simpa using h - rw [if_pos ((binaryRatLt_eq_true_iff _ _).2 h), if_neg hnot] + rw [ite_eq_left ((binaryRatLt_eq_true_iff _ _).2 h), ite_eq_right hnot] simp [binaryRatInv_eq_inv] · have hle : 1 ≤ (logResidual q).value := by simpa using (le_of_not_gt h) have hflag : ¬ binaryRatLt (binaryRationalBinaryResidual q) 1 = true := fun htrue => h ((binaryRatLt_eq_true_iff _ _).1 htrue) - rw [if_neg hflag, if_pos hle] + rw [ite_eq_right hflag, ite_eq_left hle] exact RawRat.value_logResidual q end RawRat @@ -834,14 +834,14 @@ def logUpper (q : ℚ) (N : ℕ) : RawRat := rw [logResidualLower] by_cases h : binaryRationalBinaryResidual q < 1 · have hnot : ¬ 1 ≤ (logResidual q).value := by simpa using h - rw [if_neg hnot, - if_pos ((binaryRatLt_eq_true_iff _ _).2 h)] + rw [ite_eq_right hnot, + ite_eq_left ((binaryRatLt_eq_true_iff _ _).2 h)] simp [binaryRatNeg_eq_neg] · have hle : 1 ≤ (logResidual q).value := by simpa using (le_of_not_gt h) have hflag : ¬ binaryRatLt (binaryRationalBinaryResidual q) 1 = true := fun htrue => h ((binaryRatLt_eq_true_iff _ _).1 htrue) - rw [if_pos hle, if_neg hflag] + rw [ite_eq_left hle, ite_eq_right hflag] simpa only [value_logUnit] using value_logUnitLower (logUnit q) N @[simp] theorem value_logResidualUpper (q : ℚ) (N : ℕ) : @@ -852,14 +852,14 @@ def logUpper (q : ℚ) (N : ℕ) : RawRat := rw [logResidualUpper] by_cases h : binaryRationalBinaryResidual q < 1 · have hnot : ¬ 1 ≤ (logResidual q).value := by simpa using h - rw [if_neg hnot, - if_pos ((binaryRatLt_eq_true_iff _ _).2 h)] + rw [ite_eq_right hnot, + ite_eq_left ((binaryRatLt_eq_true_iff _ _).2 h)] simp [binaryRatNeg_eq_neg] · have hle : 1 ≤ (logResidual q).value := by simpa using (le_of_not_gt h) have hflag : ¬ binaryRatLt (binaryRationalBinaryResidual q) 1 = true := fun htrue => h ((binaryRatLt_eq_true_iff _ _).1 htrue) - rw [if_pos hle, if_neg hflag] + rw [ite_eq_left hle, ite_eq_right hflag] simpa only [value_logUnit] using value_logUnitUpper (logUnit q) N @[simp] theorem value_logLower (q : ℚ) (N : ℕ) : diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineDyadicFloor.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineDyadicFloor.lean index d6f20d5c8c..de10f51cb7 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineDyadicFloor.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineDyadicFloor.lean @@ -204,7 +204,7 @@ private theorem shiftedNatBits (n p : ℕ) : by_cases hn : n = 0 · subst n simp - · rw [if_neg (natBits_ne_nil_of_ne_zero hn), + · rw [ite_eq_right (natBits_ne_nil_of_ne_zero hn), natBits_mul_pow_two_of_ne_zero n p hn] def binaryRawDyadicFloorInt (p : ℕ) (q : RawRat) : ℤ := @@ -239,7 +239,7 @@ theorem binaryRawDyadicFloorInt_eq_ediv (p : ℕ) (q : RawRat) : · simp only [hnum, Int.natAbs_negSucc] change (if a % q.den = 0 then -((a / q.den : ℕ) : ℤ) else -(((a / q.den : ℕ) + 1 : ℕ) : ℤ)) = _ - rw [if_pos hrem, hrepr] + rw [ite_eq_left hrem, hrepr] have hdvdNat : q.den ∣ a := Nat.dvd_of_mod_eq_zero hrem have hdvdInt : (q.den : ℤ) ∣ (a : ℤ) := by exact_mod_cast hdvdNat @@ -248,12 +248,12 @@ theorem binaryRawDyadicFloorInt_eq_ediv (p : ℕ) (q : RawRat) : · simp only [hnum, Int.natAbs_negSucc] change (if a % q.den = 0 then -((a / q.den : ℕ) : ℤ) else -(((a / q.den : ℕ) + 1 : ℕ) : ℤ)) = _ - rw [if_neg hrem, hrepr] + rw [ite_eq_right hrem, hrepr] have hndvdNat : ¬ q.den ∣ a := by rwa [Nat.dvd_iff_mod_eq_zero] have hndvdInt : ¬ (q.den : ℤ) ∣ (a : ℤ) := by exact_mod_cast hndvdNat - rw [Int.neg_ediv, if_neg hndvdInt, + rw [Int.neg_ediv, ite_eq_right hndvdInt, Int.sign_eq_one_of_pos (by exact_mod_cast hden)] norm_num [Nat.add_comm] ring diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineGreedyRowMatching.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineGreedyRowMatching.lean index 543f2c5a0a..1426c474f9 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineGreedyRowMatching.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineGreedyRowMatching.lean @@ -820,7 +820,7 @@ theorem machineMatchingInnerNextSelected_encode {n : ℕ} rw [hclamp] simp [certifiedGreedyOrderedStep, hij, haccept] · simp [certifiedGreedyOrderedStep, hij, haccept] - · simp only [dif_neg hij, machineIfHead_false, + · simp only [dite_eq_right hij, machineIfHead_false, certifiedGreedyOrderedStep, machineMatchingInnerSelected_pack] theorem certifiedGreedyOrderedScan_take_succ {n : ℕ} @@ -1541,7 +1541,7 @@ theorem certifiedGreedyOrderedStep_map_endpoints {n : ℕ} explicitKappa (directedPairCostPrecision n) (rowPairOfLT i j hij) ∧ ∀ r ∈ selected, Disjoint (rowPairOfLT i j hij).1 r.1 := ⟨h.1, hiff.mp h.2⟩ - rw [if_pos h, if_pos htyped, List.map_cons, + rw [ite_eq_left h, ite_eq_left htyped, List.map_cons, rowPairEndpoints_rowPairOfLT] · have htyped : ¬(HasCertifiedCorePair (explicitRegularizationScale n) X explicitKappa @@ -1549,7 +1549,7 @@ theorem certifiedGreedyOrderedStep_map_endpoints {n : ℕ} ∀ r ∈ selected, Disjoint (rowPairOfLT i j hij).1 r.1) := by intro ht exact h ⟨ht.1, hiff.mpr ht.2⟩ - rw [if_neg h, if_neg htyped] + rw [ite_eq_right h, ite_eq_right htyped] · simp [certifiedGreedyOrderedStep, certifiedGreedyTypedStep, hij] def certifiedGreedyTypedInnerScan {n : ℕ} @@ -1728,13 +1728,13 @@ def greedyRowFinsetStep {n : ℕ} by_cases h : ∀ r ∈ selected, Disjoint q.1 r.1 · have hfin : ∀ r ∈ selected.toFinset, Disjoint q.1 r.1 := by simpa using h - rw [greedyRowListStep, if_pos h, - greedyRowFinsetStep, if_pos hfin] + rw [greedyRowListStep, ite_eq_left h, + greedyRowFinsetStep, ite_eq_left hfin] simp · have hfin : ¬(∀ r ∈ selected.toFinset, Disjoint q.1 r.1) := by simpa using h - rw [greedyRowListStep, if_neg h, - greedyRowFinsetStep, if_neg hfin] + rw [greedyRowListStep, ite_eq_right h, + greedyRowFinsetStep, ite_eq_right hfin] theorem greedyRowListFold_toFinset {n : ℕ} (selected : List (RowPair n)) (edges : List (RowPair n)) : @@ -1790,7 +1790,7 @@ theorem certifiedGreedyTypedStep_nodup {n : ℕ} intro hmem exact rowPair_not_disjoint_self _ (haccept.2 _ hmem) · exact hselected - · rw [certifiedGreedyTypedStep, dif_neg hij] + · rw [certifiedGreedyTypedStep, dite_eq_right hij] exact hselected theorem certifiedGreedyTypedInnerScan_nodup {n : ℕ} diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineIntegerArithmetic.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineIntegerArithmetic.lean index 9fbf017dd6..0558a0d10b 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineIntegerArithmetic.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineIntegerArithmetic.lean @@ -408,7 +408,7 @@ theorem machineIntegerNegCode_encode (z : ℤ) : rw [machineIntegerNegCode, machineIntegerSignedMagnitude_encode] simp only [machinePairFirst_pair, machinePairSecond_pair, machineNotBit_one, Bool.not_true] - simpa only [signedMagnitudeValue, if_false] using + simpa only [signedMagnitudeValue, ite_false] using machineCanonicalIntegerFromSignedAbs_pair false (n + 1) end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineKuhnEncoding.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineKuhnEncoding.lean index 5931202d93..367bafceac 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineKuhnEncoding.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineKuhnEncoding.lean @@ -11,7 +11,7 @@ import LeanPool.BeyondBethe.BeyondBethe.MachineUnaryRange Every natural index is unary. Boolean visited sets and column-mate tables are right-nested lists, and the recursive continuation is an explicit -right-nested stack. The rational matrix and the dimension-derived fixedValue +right-nested stack. The rational matrix and the dimension-derived constant words are carried unchanged beside the control word. -/ @@ -449,7 +449,7 @@ def kuhnMachineStateCode {n : ℕ} (A : Matrix (Fin n) (Fin n) ℚ) kuhnStackCode stack := by exact machineListTail_cons kuhnFrameCode frame stack -/-! The projections below are all fixedValue-depth pairing operations. -/ +/-! The projections below are all constant-depth pairing operations. -/ theorem machineKuhnStateControl_mem_FP : machineKuhnStateControl ∈ Complexity.FP := machinePairFirst_mem_FP diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerDerivedScales.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerDerivedScales.lean index e91c2127ab..c42efa7ff5 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerDerivedScales.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerDerivedScales.lean @@ -405,8 +405,8 @@ theorem machineExplicitOptimizerInnerRadiusRawCode_mem_FP : rw [rawExplicitOptimizerMix] by_cases h : rawOptimizerHalf.value ≤ (rawOptimizerMixCandidate n B).value - · rw [if_pos h, min_eq_left h] - · rw [if_neg h, min_eq_right (le_of_not_ge h)] + · rw [ite_eq_left h, min_eq_left h] + · rw [ite_eq_right h, min_eq_right (le_of_not_ge h)] @[simp] theorem rawExplicitOptimizerInnerRadius_value (n B : ℕ) : (rawExplicitOptimizerInnerRadius n B).value = diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalDirectionUpdateMatrix.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalDirectionUpdateMatrix.lean index afed7388f4..26b71b36d4 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalDirectionUpdateMatrix.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalDirectionUpdateMatrix.lean @@ -272,7 +272,7 @@ theorem rawDirectionMatrixEntry_width_le_word {d : ℕ} 12 + 4 * W := by by_cases hij : i = j · simpa only [rawDirectionDiagonalEntry, hij, if_true] using hperp - · simp only [rawDirectionDiagonalEntry, hij, if_false, rawRatWidth_zero] + · simp only [rawDirectionDiagonalEntry, hij, ite_false, rawRatWidth_zero] omega calc _ = rawRatWidth ((rawDirectionDiagonalEntry i j).sub diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalExp.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalExp.lean index bf9ef0ab7d..41fc4cc0de 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalExp.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalExp.lean @@ -369,7 +369,7 @@ theorem binaryNormalizeRawRat_expBasePow_eq change (0 : ℚ) ≤ (n : ℚ) / (den : ℚ) exact div_nonneg (Nat.cast_nonneg n) (Nat.cast_nonneg den) rw [binaryRationalExpLower, - if_pos ((binaryRatNonnegative_eq_true_iff _).2 hs), + ite_eq_left ((binaryRatNonnegative_eq_true_iff _).2 hs), binaryRationalPositiveExpLower] simp [RawRat.expApproxSteps, RawRat.expMagnitude, binaryRatAdd_eq_add, binaryRatDiv_eq_div, @@ -386,7 +386,7 @@ theorem binaryNormalizeRawRat_expBasePow_eq have hflag : ¬ binaryRatNonnegative ((⟨Int.negSucc n, den, hden⟩ : RawRat).value) = true := fun h => hs ((binaryRatNonnegative_eq_true_iff _).1 h) - rw [binaryRationalExpLower, if_neg hflag, + rw [binaryRationalExpLower, ite_eq_right hflag, binaryRationalNegativeExpLower] simp [RawRat.expApproxSteps, RawRat.expMagnitude, binaryRatNeg_eq_neg, binaryRatSub_eq_sub, diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalMin.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalMin.lean index 3e712e20f7..d6b6c06c4c 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalMin.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalMin.lean @@ -51,10 +51,10 @@ theorem machineRationalMinCode_mem_FP : rationalBinaryCode (min q.value r.value) := by rw [machineRationalMinCode, machineRawRatMinCode_encode] by_cases h : q.value ≤ r.value - · rw [if_pos h, machineNormalizeRawRatBinaryCode_encode, + · rw [ite_eq_left h, machineNormalizeRawRatBinaryCode_encode, binaryNormalizeRawRat_eq_value, min_eq_left h] · have hrq : r.value ≤ q.value := le_of_not_ge h - rw [if_neg h, machineNormalizeRawRatBinaryCode_encode, + rw [ite_eq_right h, machineNormalizeRawRatBinaryCode_encode, binaryNormalizeRawRat_eq_value, min_eq_right hrq] end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRepeatPair.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRepeatPair.lean index 91eacba7e4..1809d8757f 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineRepeatPair.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRepeatPair.lean @@ -18,7 +18,7 @@ open Complexity `repeatPairCode n item tail` is the right-nested word obtained by prepending `item` exactly `n` times to `tail`. This is the machine-level constructor for -fixedValue rational vectors and, later, for the zero blocks of diagonal +constant rational vectors and, later, for the zero blocks of diagonal matrices. Its iteration count is supplied in unary and its accumulator is clamped by an explicit quadratic envelope. -/ diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineSmoothingDelta.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineSmoothingDelta.lean index 3bef2e73ba..3749296a42 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineSmoothingDelta.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineSmoothingDelta.lean @@ -272,13 +272,13 @@ theorem rawRationalSmoothingDelta_value {n : ℕ} 1 / ((2 : ℚ) * n) ≤ χ.value * rationalSupportFloor A ^ n / ((4 : ℚ) * n.factorial) - · rw [if_pos h, min_eq_left h] + · rw [ite_eq_left h, min_eq_left h] simp · have hright : χ.value * rationalSupportFloor A ^ n / ((4 : ℚ) * n.factorial) ≤ 1 / ((2 : ℚ) * n) := le_of_not_ge h - rw [if_neg h, min_eq_right hright] + rw [ite_eq_right h, min_eq_right hright] simp [rawRatRowsSupportProduct_eq_rationalSupportFloor] theorem machineSmoothingDeltaCode_encode {n : ℕ} @@ -309,13 +309,13 @@ theorem machineSmoothingDeltaCode_encode {n : ℕ} 1 / ((2 : ℚ) * n) ≤ χ.value * rationalSupportFloor A ^ n / ((4 : ℚ) * n.factorial) - · rw [if_pos h, min_eq_left h] + · rw [ite_eq_left h, min_eq_left h] simp · have hright : χ.value * rationalSupportFloor A ^ n / ((4 : ℚ) * n.factorial) ≤ 1 / ((2 : ℚ) * n) := le_of_not_ge h - rw [if_neg h, min_eq_right hright] + rw [ite_eq_right h, min_eq_right hright] simp [rawRatRowsSupportProduct_eq_rationalSupportFloor] @[simp] theorem machineSmoothingDeltaCode_rational {n : ℕ} diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineTrimHighZeros.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineTrimHighZeros.lean index 3a9c8ce729..5a1b8b7d63 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineTrimHighZeros.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineTrimHighZeros.lean @@ -92,14 +92,14 @@ theorem machineTrim_recFold_eq : ∀ bits : List Bool, simp only [Cobham.recFold] cases bit with | false => - simp only [Bool.false_eq, cond_false, machineTrimFalseStep, + simp only [Bool.false_eq, Bool.cond_false, machineTrimFalseStep, machineTrimAcc, machinePairFirst_pair, machinePairSecond_pair, ih] cases htrim : BinaryRippleSub.trimHighZeros rest with | nil => simp [BinaryRippleSub.trimHighZeros, htrim] | cons high tail => simp [BinaryRippleSub.trimHighZeros, htrim] | true => - simp only [cond_true, ih] + simp only [Bool.cond_true, ih] cases htrim : BinaryRippleSub.trimHighZeros rest <;> simp [machineTrimTrueStep, machineTrimAcc, BinaryRippleSub.trimHighZeros, htrim] diff --git a/LeanPool/BeyondBethe/BeyondBethe/MatrixPerturbation.lean b/LeanPool/BeyondBethe/BeyondBethe/MatrixPerturbation.lean index cb45d26a60..941157c942 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MatrixPerturbation.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MatrixPerturbation.lean @@ -199,7 +199,7 @@ theorem abs_adjugate_entry_le_of_entrywise {d : ℕ} · subst l simp [hM] · simp [Matrix.updateRow_apply, hil, hM0] - · rw [Matrix.updateRow_apply, if_neg hkj] + · rw [Matrix.updateRow_apply, ite_eq_right hkj] exact hA k l end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/NearCase.lean b/LeanPool/BeyondBethe/BeyondBethe/NearCase.lean index 614e5c7451..704f08ee92 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/NearCase.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/NearCase.lean @@ -1372,7 +1372,7 @@ theorem positiveMatrix_logApproximation hlogn hξ hτscale A hA have hmatch := positiveMatrix_hasPerfectMatching hA have hlogBethe : Real.log (bethePermanent A) = betheLogValue A := by - rw [bethePermanent, if_pos hmatch, Real.log_exp] + rw [bethePermanent, ite_eq_left hmatch, Real.log_exp] have hupper : Real.log (Matrix.permanent A) ≤ Real.log (bethePermanent A) + n * (Real.log 2 / 2) := by rw [hlogBethe] diff --git a/LeanPool/BeyondBethe/BeyondBethe/NumericalAffine.lean b/LeanPool/BeyondBethe/BeyondBethe/NumericalAffine.lean index d27e0d8638..eab4b7c1e1 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/NumericalAffine.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/NumericalAffine.lean @@ -254,7 +254,7 @@ theorem one_sub_entry_ge_of_common_floor rw [← hsum] exact (hfloor i k).trans hrest -/-- The uniform point has fixedValue upper-left coordinates. -/ +/-- The uniform point has constant upper-left coordinates. -/ def uniformAffineCoordinates (n : ℕ) : Matrix (Fin n) (Fin n) ℚ := fun _ _ ↦ 1 / (n + 1) diff --git a/LeanPool/BeyondBethe/BeyondBethe/NumericalScales.lean b/LeanPool/BeyondBethe/BeyondBethe/NumericalScales.lean index a27b4cf02d..11112da999 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/NumericalScales.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/NumericalScales.lean @@ -381,12 +381,12 @@ theorem rationalScales_certificate_of_optimizer hA hX hmax have hmatch := positiveMatrix_hasPerfectMatching hA have hlogBethe : Real.log (bethePermanent A) = betheLogValue A := by - rw [bethePermanent, if_pos hmatch, Real.log_exp] + rw [bethePermanent, ite_eq_left hmatch, Real.log_exp] rw [hlogBethe] linarith have hmatch := positiveMatrix_hasPerfectMatching hA have hlogBethe : Real.log (bethePermanent A) = betheLogValue A := by - rw [bethePermanent, if_pos hmatch, Real.log_exp] + rw [bethePermanent, ite_eq_left hmatch, Real.log_exp] have hupper : Real.log (Matrix.permanent A) ≤ Real.log (bethePermanent A) + n * (Real.log 2 / 2) := by rw [hlogBethe] @@ -422,7 +422,7 @@ theorem rationalScales_certificate_of_optimizer · exact hcertificate · simpa only [η, δ, ξ, hεcast] using hgap -/-- The positive-matrix certificate with a rational improvement fixedValue and +/-- The positive-matrix certificate with a rational improvement constant and an explicitly rational regularization scale. -/ theorem rationalScales_exactPositiveCertificate (stableCoefficient : AnariOveisGharanStableCoefficient.{0}) diff --git a/LeanPool/BeyondBethe/BeyondBethe/Optimizer.lean b/LeanPool/BeyondBethe/BeyondBethe/Optimizer.lean index e2b4fed7a7..e29ca3a526 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/Optimizer.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/Optimizer.lean @@ -716,7 +716,7 @@ theorem exists_regularizedOptimizer_with_logKKT hn hτ.le hA hX hmax have hmatch := positiveMatrix_hasPerfectMatching hA have hlog : Real.log (bethePermanent A) = betheLogValue A := by - rw [bethePermanent, if_pos hmatch, Real.log_exp] + rw [bethePermanent, ite_eq_left hmatch, Real.log_exp] refine ⟨X, hX, hXint, hmax, ⟨r, c, hKKT⟩, ?_⟩ rw [hlog] nlinarith diff --git a/LeanPool/BeyondBethe/BeyondBethe/PairedCertificate.lean b/LeanPool/BeyondBethe/BeyondBethe/PairedCertificate.lean index 0cea285a39..02e3bc6035 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/PairedCertificate.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/PairedCertificate.lean @@ -67,7 +67,7 @@ theorem selectorExponent_injective intro h h' heq funext j have hj := congrArg (fun d : κ × ι →₀ ℕ ↦ d (h j, j)) heq - simp only [selectorExponent_apply, if_pos rfl] at hj + simp only [selectorExponent_apply, ite_eq_left rfl] at hj by_contra hne simp [hne] at hj diff --git a/LeanPool/BeyondBethe/BeyondBethe/RationalEllipsoid.lean b/LeanPool/BeyondBethe/BeyondBethe/RationalEllipsoid.lean index 59c3e1e667..ff38fb02e6 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/RationalEllipsoid.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/RationalEllipsoid.lean @@ -335,7 +335,7 @@ theorem rationalEllipsoid_volumeFactor_lt_one {d : ℕ} (hd : 0 < d) : _ = 1 := Real.exp_zero /-- A rationally stated version of the volume contraction. The weaker -fixedValue is convenient when we later reserve part of the contraction for +constant is convenient when we later reserve part of the contraction for rounding and inflation. -/ theorem rationalEllipsoid_volumeFactor_le_one_sub {d : ℕ} (hd : 0 < d) : (rationalEllipsoidPerpScale d : ℝ) ^ (d - 1) * diff --git a/LeanPool/BeyondBethe/BeyondBethe/RobustCycle.lean b/LeanPool/BeyondBethe/BeyondBethe/RobustCycle.lean index 32263b6890..e5d3fb2248 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/RobustCycle.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/RobustCycle.lean @@ -135,7 +135,7 @@ theorem coreOutcome_some_mass if a ≠ j ∧ b ≠ j then p j else 0 := by unfold pushforwardMass by_cases hj : a ≠ j ∧ b ≠ j - · rw [if_pos hj, Finset.sum_eq_single j] + · rw [ite_eq_left hj, Finset.sum_eq_single j] · simp [coreOutcome, hj.1.symm, hj.2.symm] · intro k _ hkj have hne : coreOutcome a b k ≠ some j := by @@ -144,7 +144,7 @@ theorem coreOutcome_some_mass · simp [coreOutcome, hk, hkj] simp [hne] · simp - · rw [if_neg hj] + · rw [ite_eq_right hj] apply Finset.sum_eq_zero intro k _ by_cases hk : k = a ∨ k = b @@ -718,7 +718,7 @@ theorem alternating_cleanCycle_count (c : Equiv.Perm (Fin n)).support.card = 2 ∧ cycleGoodCount η P h c = 2 := by simpa [k, gc] using And.intro hkEq hg2 - rw [cleanCycleIndicator, if_pos hclean] + rw [cleanCycleIndicator, ite_eq_left hclean] simp [longComponentGoodRows, hkEq] omega · have hgb : gc c ≤ bc c := by omega @@ -726,7 +726,7 @@ theorem alternating_cleanCycle_count cycleGoodCount η P h c = 2) := by intro hclean exact hg2 (by simpa [gc] using hclean.2) - rw [cleanCycleIndicator, if_neg hnotclean] + rw [cleanCycleIndicator, ite_eq_right hnotclean] simp [longComponentGoodRows, hkEq] exact hgb have hsum := Finset.sum_le_sum (s := Finset.univ) diff --git a/LeanPool/BeyondBethe/BeyondBethe/RoundedEllipsoidBitBounds.lean b/LeanPool/BeyondBethe/BeyondBethe/RoundedEllipsoidBitBounds.lean index 9507233c57..d1e1bf7409 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/RoundedEllipsoidBitBounds.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/RoundedEllipsoidBitBounds.lean @@ -163,7 +163,7 @@ theorem rationalEllipsoidPerpScale_le_two {d : ℕ} (hd : 0 < d) : nlinarith [sq_nonneg (rationalEllipsoidAlpha d - 1 / 4)] /-- Every entry of the square-root-free direction update has a universal -fixedValue bound, independent of the scale of the cut normal. -/ +constant bound, independent of the scale of the cut normal. -/ theorem abs_directionUpdateMatrix_le_four {d : ℕ} (hd : 0 < d) {b : Fin d → ℚ} (hb : b ≠ 0) (i j : Fin d) : abs (directionUpdateMatrix diff --git a/LeanPool/BeyondBethe/BeyondBethe/RowStability.lean b/LeanPool/BeyondBethe/BeyondBethe/RowStability.lean index f5624685b7..d31e4256be 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/RowStability.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/RowStability.lean @@ -343,7 +343,7 @@ theorem tripleOrderProbability_eq_zero_of_left_eq_right uniformAverage (fun _ : Equiv.Perm (Fin n) ↦ 0) := by apply congrArg uniformAverage funext π - rw [if_neg] + rw [ite_eq_right] intro h exact lt_asymm h.1 h.2 _ = 0 := uniformAverage_const 0 @@ -963,7 +963,7 @@ theorem rowStabilityH_mono exact (show 0 ≤ z / 12 by linarith [hz'.1, hx0]).trans hprime) exact hmono ⟨le_rfl, hxy⟩ ⟨hxy, le_rfl⟩ hxy -/-- A concrete version of the paper's fixedValue `c₁`. -/ +/-- A concrete version of the paper's constant `c₁`. -/ theorem rowStabilityH_gap_to_half {x : ℝ} (hxQuarter : 1 / 4 ≤ x) (hxHalf : x ≤ 1 / 2) : (1 / 48) * (1 / 2 - x) ≤ rowStabilityC - rowStabilityH x := by @@ -992,7 +992,7 @@ theorem rowStabilityH_gap_to_half rw [rowStabilityH_half] at h linarith -/-- A concrete version of the paper's fixedValue `c₂`. -/ +/-- A concrete version of the paper's constant `c₂`. -/ theorem rowStabilityH_half_argument_gap {x : ℝ} (hxQuarter : 1 / 4 ≤ x) (hxHalf : x ≤ 1 / 2) : (1 / 1536 : ℝ) ≤ rowStabilityH x - rowStabilityH (x / 2) := by @@ -1540,7 +1540,7 @@ theorem separableDefect_ge_tail_below_quarter apply Finset.sum_le_sum intro i _ by_cases hia : i = a - · simp only [hia, ne_eq, not_true_eq_false, if_false] + · simp only [hia, ne_eq, not_true_eq_false, ite_false] exact mul_nonneg (hp.1.nonnegative a) (rowStabilityH_gap_nonnegative (hp.2 a) haHalf) · have hgap := rowStabilityH_gap_of_lt_quarter (hp.2 i) @@ -1809,7 +1809,7 @@ theorem above_half_distance_le_rowDeficit /-- A fully explicit, strict-support version of paper Lemma 8. The sharp one-row inequality is kept as an explicit argument for modularity and is proved in `SourceAnariRezaeiList`; all stability and compactness arguments are -discharged here with the concrete fixedValue `3074`. Strict support is exactly +discharged here with the concrete constant `3074`. Strict support is exactly the case used for rows of the Gibbs marginal matrix associated with a positive input matrix. -/ theorem row_stability_explicit diff --git a/LeanPool/BeyondBethe/BeyondBethe/SourceBetheLower.lean b/LeanPool/BeyondBethe/BeyondBethe/SourceBetheLower.lean index 452ff8a688..c828e772bf 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/SourceBetheLower.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/SourceBetheLower.lean @@ -116,7 +116,7 @@ theorem bethePermanent_le_permanent_of_positive dsimp only [C] at hvalue hbudget linarith have hmatch : Matrix.HasPerfectMatching A := positiveMatrix_hasPerfectMatching hA - rw [bethePermanent, if_pos hmatch] + rw [bethePermanent, ite_eq_left hmatch] have hexp := Real.exp_le_exp.mpr hlog rwa [Real.exp_log hper] at hexp diff --git a/LeanPool/BeyondBethe/BeyondBethe/SourceBetheUpper.lean b/LeanPool/BeyondBethe/BeyondBethe/SourceBetheUpper.lean index 87845152af..433e4bf3d3 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/SourceBetheUpper.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/SourceBetheUpper.lean @@ -77,7 +77,7 @@ theorem permanent_le_sqrtTwo_pow_mul_bethePermanent_of_positive congr 1 rw [← Real.exp_log hsqrt, Real.log_sqrt (by norm_num : (0 : ℝ) ≤ 2)] have hbethe : bethePermanent A = Real.exp (betheLogValue A) := by - rw [bethePermanent, if_pos hmatch] + rw [bethePermanent, ite_eq_left hmatch] rw [hfactor, ← hbethe] at hexp simpa [mul_comm] using hexp diff --git a/LeanPool/BeyondBethe/BeyondBethe/SourceStableClosure.lean b/LeanPool/BeyondBethe/BeyondBethe/SourceStableClosure.lean index e9f0501111..f2b5a6baa4 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/SourceStableClosure.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/SourceStableClosure.lean @@ -270,7 +270,7 @@ theorem upperHalfPlaneStableOrZero_of_positive_ray /-! ## Coefficients, boundary values, and the Lieb--Sokal contraction -/ -/-- Adjoin one multiaffine variable, with fixedValue coefficient `g` and +/-- Adjoin one multiaffine variable, with constant coefficient `g` and linear coefficient `f`. -/ noncomputable def linearExtension {σ : Type*} (g f : MvPolynomial σ ℂ) : MvPolynomial (Option σ) ℂ := diff --git a/LeanPool/BeyondBethe/BeyondBethe/SourceStableEncoding.lean b/LeanPool/BeyondBethe/BeyondBethe/SourceStableEncoding.lean index 413297c16b..66720fe332 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/SourceStableEncoding.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/SourceStableEncoding.lean @@ -76,7 +76,7 @@ theorem multiaffine_eq_boolExpansion · simp [hSd] · intro T hT hTS simp only [MvPolynomial.coeff_monomial] - rw [if_neg] + rw [ite_eq_right] intro h apply hTS exact boolExponent_injective (h.trans hSd.symm) @@ -87,7 +87,7 @@ theorem multiaffine_eq_boolExpansion apply Finset.sum_eq_zero intro S hS simp only [MvPolynomial.coeff_monomial] - rw [if_neg] + rw [ite_eq_right] intro h apply hd intro i diff --git a/LeanPool/BeyondBethe/BeyondBethe/StrongEntropy.lean b/LeanPool/BeyondBethe/BeyondBethe/StrongEntropy.lean index b863f3e25f..d3d9c15639 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/StrongEntropy.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/StrongEntropy.lean @@ -131,7 +131,7 @@ theorem regularizedBetheObjective_segment_quadratic nlinarith /-- Objective suboptimality controls squared distance from any exact -regularized maximizer. The fixedValue `τ/4` comes from the midpoint case. -/ +regularized maximizer. The constant `τ/4` comes from the midpoint case. -/ theorem regularizedBetheMaximizer_distance_sq_le_gap {ι : Type*} [Fintype ι] [DecidableEq ι] (hcard : 1 < Fintype.card ι) diff --git a/LeanPool/BeyondBethe/Complexitylib/Asymptotics.lean b/LeanPool/BeyondBethe/Complexitylib/Asymptotics.lean index 38905aabca..e5abbfd0de 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Asymptotics.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Asymptotics.lean @@ -31,7 +31,7 @@ opened and read like standard complexity-theoretic asymptotic notation. - `BigO.of_le` — pointwise `≤` implies big-O - `BigO.add` — sum of big-O is big-O - `BigO.pow` — fixed powers preserve big-O -- `BigO.const_mul_left` — fixedValue multiple preserves big-O +- `BigO.const_mul_left` — constant multiple preserves big-O - `BigO.natSize_of_pow` — binary widths of power-bounded values are logarithmic - `BigO.le_add_left` / `BigO.le_add_right` — projections from a sum - `BigO.const_mul_add` — `c * f₁ + f₂ = O(T₁ + T₂)` @@ -43,7 +43,7 @@ opened and read like standard complexity-theoretic asymptotic notation. - `LittleO.trans_bigO` — mixed: `o` then `O` gives `o` - `BigO.trans_littleO` — mixed: `O` then `o` gives `o` - `LittleO.add` — sum of little-o is little-o -- `LittleO.const_mul_left` — fixedValue multiple preserves little-o +- `LittleO.const_mul_left` — constant multiple preserves little-o -/ @@ -241,7 +241,7 @@ theorem BigO.max_same {f₁ f₂ g : ℕ → ℕ} (h₁ : f₁ =O g) (h₂ : f (fun n => max (f₁ n) (f₂ n)) =O g := (BigO.max_le_add f₁ f₂).trans (BigO.add h₁ h₂) -/-- Any function is big-O of itself-plus-fixedValue: `f =O (fun n => f n + c)`. -/ +/-- Any function is big-O of itself-plus-constant: `f =O (fun n => f n + c)`. -/ theorem BigO.self_le_add_const (f : ℕ → ℕ) (c : ℕ) : f =O (fun n => f n + c) := BigO.of_le fun _ => Nat.le_add_right _ _ @@ -262,7 +262,7 @@ theorem BigO.pow_le_pow_right {j k : ℕ} (hjk : j ≤ k) : simp only [one_mul, Real.norm_natCast] exact_mod_cast Nat.pow_le_pow_right hn hjk -/-- A fixedValue function is big-O of `n^k` (eventually `n^k ≥ 1`). -/ +/-- A constant function is big-O of `n^k` (eventually `n^k ≥ 1`). -/ theorem BigO.const_le_pow (c k : ℕ) : (fun _ : ℕ => c) =O ((· ^ k) : ℕ → ℕ) := by apply IsBigO.of_bound c @@ -271,7 +271,7 @@ theorem BigO.const_le_pow (c k : ℕ) : have : 1 ≤ n ^ k := Nat.one_le_pow _ _ hn exact_mod_cast le_mul_of_one_le_right (Nat.zero_le _) this -/-- Every fixed natural fixedValue is eventually bounded by a fixedValue multiple +/-- Every fixed natural constant is eventually bounded by a constant multiple of the unshifted base-two logarithm. The threshold `n ≥ 2` is necessary because `Nat.log 2 0 = Nat.log 2 1 = 0`. -/ theorem BigO.const_le_logTwo (c : ℕ) : @@ -313,9 +313,9 @@ theorem polynomial_eval_mono_nat (p : Polynomial ℕ) : Monotone p.eval := by with `f n ≤ p.eval n` *for every* `n` (not just eventually). The standard big-O definition gives only an asymptotic bound; this lemma - turns that into an everywhere-bound by (i) extracting a real fixedValue + turns that into an everywhere-bound by (i) extracting a real constant `C` and threshold `N` such that `f n ≤ C · n^k` for `n ≥ N`, (ii) - rounding `C` up to a natural number, and (iii) adding a fixedValue term + rounding `C` up to a natural number, and (iii) adding a constant term that dominates `f` on the initial segment `[0, N)`. This is the bridge from big-O hypotheses to the explicit @@ -369,7 +369,7 @@ theorem BigO.of_polynomial_bound {f : ℕ → ℕ} (p : Polynomial ℕ) exact Nat.mul_le_mul_left _ this exact_mod_cast le_trans (h n) hp -/-- Extract a natural-number fixedValue and threshold from a big-O bound: +/-- Extract a natural-number constant and threshold from a big-O bound: `f =O g` yields `c` and `N` with `f n ≤ c * g n` for all `n ≥ N`. -/ theorem BigO.exists_nat_bound {f g : ℕ → ℕ} (h : f =O g) : ∃ (c N : ℕ), ∀ n, N ≤ n → f n ≤ c * g n := by @@ -386,7 +386,7 @@ theorem BigO.exists_nat_bound {f g : ℕ → ℕ} (h : f =O g) : /-- Binary widths of power-bounded natural values are logarithmic. The proof raises the eventual power bound by one, which uniformly handles exponent zero -and fixedValue functions. -/ +and constant functions. -/ theorem BigO.natSize_of_pow {f : ℕ → ℕ} {d : ℕ} (hf : f =O ((· ^ d) : ℕ → ℕ)) : (fun n => (f n).size) =O (fun n => Nat.log 2 n) := by diff --git a/LeanPool/BeyondBethe/Complexitylib/Circuits/Encoding/Internal/Codec.lean b/LeanPool/BeyondBethe/Complexitylib/Circuits/Encoding/Internal/Codec.lean index ab8f266f74..f2250deafa 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Circuits/Encoding/Internal/Codec.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Circuits/Encoding/Internal/Codec.lean @@ -366,7 +366,7 @@ theorem eval?_isSome_iff_internal (circuit : RawCircuit) (input : List Bool) : rw [hsize, List.size_toArray] simp rw [eval?] - simp only [List.isEmpty_cons, Bool.false_eq_true, if_false, haux] + simp only [List.isEmpty_cons, Bool.false_eq_true, ite_false, haux] change (result[input.length + (gate :: gates).length - 1]?).isSome rw [Array.getElem?_eq_getElem hlt] simp diff --git a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Defs.lean b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Defs.lean index ed5d0de947..9378acc65a 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Defs.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Defs.lean @@ -101,7 +101,7 @@ polynomial-growth leash that pins the class to exactly `FP` inductive Cobham : ∀ {n : ℕ}, ((Fin n → List Bool) → List Bool) → Prop /-- Every projection is in the class. -/ | proj {n : ℕ} (i : Fin n) : Cobham fun v => v i - /-- The empty-string fixedValue (at every arity) is in the class. -/ + /-- The empty-string constant (at every arity) is in the class. -/ | empty {n : ℕ} : Cobham fun _ : Fin n → List Bool => [] /-- The bit successors `x ↦ b :: x` (the string analogue of `n ↦ 2·n + b`) are in the class. -/ diff --git a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal.lean index ea9d914eb7..535ba3a35a 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal.lean @@ -78,7 +78,7 @@ theorem encodeVec_mem_internal {n : ℕ} : Cobham (@encodeVec n) := by /-! ## Soundness: `Cobham f → FPn f`, constructor by constructor -/ -/-- `empty` case: the fixedValue empty function is `FPn` at every arity, witnessed +/-- `empty` case: the constant empty function is `FPn` at every arity, witnessed by `const_nil_mem_FP`. -/ theorem fpn_empty {n : ℕ} : FPn (fun _ : Fin n → List Bool => ([] : List Bool)) := ⟨fun _ => [], const_nil_mem_FP, fun _ => rfl⟩ @@ -232,7 +232,7 @@ theorem fpn_smash : rfl /-- Assembling an encoded vector out of `FP` component functions of a common input -is `FP`. Proved by induction on the arity: the empty vector is the fixedValue `[]`, +is `FP`. Proved by induction on the arity: the empty vector is the constant `[]`, and the successor step is one `pairFn_mem_FP`. -/ theorem assembleVec_mem_FP {m : ℕ} (w : Fin m → (List Bool → List Bool)) (hw : ∀ i, w i ∈ FP) : @@ -349,7 +349,7 @@ private theorem poly_eval_le_pow (p : Polynomial ℕ) (n : ℕ) : exact Nat.mul_le_mul_left _ (le_trans (Nat.pow_le_pow_left (by omega) i) (Nat.pow_le_pow_right (by omega) hi')) -/-- An `FP` function whose output is at least `c` bits long, for any fixedValue `c`. +/-- An `FP` function whose output is at least `c` bits long, for any constant `c`. Built by iterating `pair · []`, which doubles the length and adds two. -/ theorem exists_const_ruler (c : ℕ) : ∃ K : List Bool → List Bool, K ∈ FP ∧ ∀ z, c ≤ (K z).length := by @@ -362,7 +362,7 @@ theorem exists_const_ruler (c : ℕ) : simp only [pair_length, List.length_nil] omega -/-- **Rulers.** For every fixedValue `c` and exponent `d` there is an `FP` function +/-- **Rulers.** For every constant `c` and exponent `d` there is an `FP` function whose output is at least `c · (|z| + 1) ^ d` bits long. Rulers let the loop of the `boundedRec` case carry its width clamp as *data* — truncating to a string costs linear time, whereas truncating to a computed number would not. -/ @@ -580,15 +580,15 @@ theorem emptyFlag_head_cons (b : Bool) (t : List Bool) : theorem selectHead_emptyFlag_nil (x y : List Bool) : selectHead (emptyFlag []) x y = x := by rw [emptyFlag_nil, selectHead, - if_pos (show ([true] : List Bool).head? = some true from rfl)] + ite_eq_left (show ([true] : List Bool).head? = some true from rfl)] theorem length_take_le_arg (n : ℕ) (l : List Bool) : (l.take n).length ≤ n := by rw [List.length_take]; omega theorem selectHead_emptyFlag_cons (b : Bool) (t x y : List Bool) : selectHead (emptyFlag (b :: t)) x y = y := by - rw [selectHead, if_neg (by rw [emptyFlag_head_cons]; simp), - if_pos (emptyFlag_head_cons b t)] + rw [selectHead, ite_eq_right (by rw [emptyFlag_head_cons]; simp), + ite_eq_left (emptyFlag_head_cons b t)] theorem selectHead_length_le (s x y : List Bool) : (selectHead s x y).length ≤ max x.length y.length := by @@ -805,12 +805,12 @@ theorem iterVal_eq_iterate (F : List Bool → List Bool) (W v₀ : List Bool) (M rw [iterVal, ih] by_cases h : i + 2 ≤ M + 1 · have hhead := counter_head_false (M + 1) (i + 2) (by omega) h - rw [selectHead, if_neg (by rw [hhead]; simp), if_pos hhead, + rw [selectHead, ite_eq_right (by rw [hhead]; simp), ite_eq_left hhead, show min i M = i from by omega, ← Function.iterate_succ_apply' F i v₀, List.take_of_length_le (hclamp (i + 1) (by omega)), show min (i + 1) M = i + 1 from by omega] · have hhead := counter_head_true (M + 1) (i + 2) (by omega) - rw [selectHead, if_pos hhead, show min i M = M from by omega, + rw [selectHead, ite_eq_left hhead, show min i M = M from by omega, show min (i + 1) M = M from by omega] /-- **`FP` is closed under bounded iteration** — the one machine-level fact the @@ -1014,8 +1014,8 @@ theorem recFold_eq_recNotation {n : ℕ} {g : (Fin n → List Bool) → List Boo = _ rw [ih, henc, recNotation_cons] cases b - · simp only [cond_false]; exact hH₀ _ - · simp only [cond_true]; exact hH₁ _ + · simp only [Bool.cond_false]; exact hH₀ _ + · simp only [Bool.cond_true]; exact hH₁ _ /-- Every `FP` function has polynomially bounded output length: a time bound is also an output-length bound (`TM.ComputesInTime.output_length_le`). -/ @@ -1110,7 +1110,7 @@ Cobham's algebra. head position — is one bitstring of equal-width blocks, each tape split at its head so that a head move is a two-bit shift (`Cobham.cfgCode`). 2. The one-step transition is a finite case split on (state, symbols read), which - is `Cobham.tableFn` against the finitely many fixedValue key patterns, with each + is `Cobham.tableFn` against the finitely many constant key patterns, with each branch built from `takeFn`/`dropFn`/`appendFn`/`padFn` (`Cobham.stepFn`). At the halting state the branch is the identity, so the encoding is a fixed point once the machine stops. diff --git a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/Algebra.lean b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/Algebra.lean index 6c29285baa..24ec105ac3 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/Algebra.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/Algebra.lean @@ -43,7 +43,7 @@ theorem of_eq {n : ℕ} {f g : (Fin n → List Bool) → List Bool} (hf : Cobham (h : ∀ v, f v = g v) : Cobham g := (funext h : f = g) ▸ hf -/-- Every fixedValue function is in the class: build the fixedValue string bit by bit from +/-- Every constant function is in the class: build the constant string bit by bit from `empty` and the successors. -/ theorem const {n : ℕ} (s : List Bool) : Cobham fun _ : Fin n → List Bool => s := by induction s with @@ -340,9 +340,9 @@ theorem nonemptyFn {n : ℕ} {g : (Fin n → List Bool) → List Bool} (h : Cobh (comp₃ dispatch h (Cobham.const [true]) (Cobham.const [true])).of_eq fun v => by simp [nonemptyFlag] -/-- **Matching against a fixed fixedValue is in the class.** For each fixedValue the +/-- **Matching against a fixed constant is in the class.** For each constant the test unfolds into finitely many bit comparisons joined by `andFn`, so this is a -finite composition — the meta-level induction is on the fixedValue, not a +finite composition — the meta-level induction is on the constant, not a recursion inside the algebra. -/ theorem matchPrefixFn {n : ℕ} {g : (Fin n → List Bool) → List Bool} (h : Cobham g) (c : List Bool) : @@ -426,7 +426,7 @@ theorem padFn {n : ℕ} {gr gx : (Fin n → List Bool) → List Bool} (takeFn hr (appendFn hx (zeroBlockFn hr))).of_eq fun _ => rfl /-- **Finite table dispatch is in the class.** Matching a member of the class -against each of finitely many fixedValue patterns in turn, taking the first +against each of finitely many constant patterns in turn, taking the first branch that fires and a default otherwise, is a finite chain of `iteFn`s. This is exactly the shape of a Turing machine's transition function: the patterns @@ -445,7 +445,7 @@ theorem tableFn {n : ℕ} {g d : (Fin n → List Bool) → List Bool} exact iteFn (matchPrefixFn hg p.1) (hbranch p (by simp)) (ih fun q hq => hbranch q (by simp [hq])) -/-- **A table of fixedValue patterns is a case analysis.** If some entry's pattern +/-- **A table of constant patterns is a case analysis.** If some entry's pattern prefixes the key, and every entry whose pattern prefixes the key carries the same value, then the fold returns that value — regardless of the order the entries appear in. @@ -466,13 +466,13 @@ theorem foldr_table_eq (g d val : List Bool) : rintro ⟨p, hp, hpre⟩ hall rcases Decidable.em (a.1 <+: g) with hm | hm · rw [List.foldr_cons, (matchPrefix_eq_true_iff a.1 g).mpr hm, caseBit₀_cons, - cond_true] + Bool.cond_true] exact hall a (by simp) hm · have hmf : matchPrefix a.1 g = [false] := by rcases matchPrefix_flag a.1 g with h | h · exact absurd ((matchPrefix_eq_true_iff a.1 g).mp h) hm · exact h - rw [List.foldr_cons, hmf, caseBit₀_cons, cond_false] + rw [List.foldr_cons, hmf, caseBit₀_cons, Bool.cond_false] refine ih ⟨p, ?_, hpre⟩ fun q hq => hall q (by simp [hq]) rcases List.mem_cons.mp hp with rfl | hp' · exact absurd hpre hm @@ -516,7 +516,7 @@ theorem iterFn {n : ℕ} {e : (Fin n → List Bool) → List Bool} exact hbound c v · rw [hrec] -/-- **Clocks.** For every fixedValue `c` and exponent `d` there is a member of the +/-- **Clocks.** For every constant `c` and exponent `d` there is a member of the class whose value on `v` is at least `c · (|v 0| + 1) ^ d` bits long — built from constants and `smash`, which is exactly what `smash` is for. -/ theorem exists_pow_clock (c d : ℕ) : diff --git a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/Blocks.lean b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/Blocks.lean index a98a9a43ac..11f7228d54 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/Blocks.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/Blocks.lean @@ -21,7 +21,7 @@ vocabulary of the proof. * *Flags* — `Complexity.andBit`, `orBit`, `notBit`, `bitAt`, `Complexity.nonemptyFlag` and `Complexity.matchPrefix`, the Boolean layer a machine's finite transition table is written in. `matchPrefix` unfolds into - `|c|` bit tests for each fixed fixedValue `c`, so it is a *finite* composition — + `|c|` bit tests for each fixed constant `c`, so it is a *finite* composition — the induction is at the meta level, not inside the algebra. * *Blocks* — `Complexity.padTo` pads a field to one ruler's width and `Complexity.blockAt` reads field `i` back, so a packed configuration needs no @@ -229,8 +229,8 @@ def nonemptyFlag (x : List Bool) : List Bool := caseBit x [true] [true] @[simp] theorem nonemptyFlag_cons (b : Bool) (x : List Bool) : nonemptyFlag (b :: x) = [true] := by cases b <;> rfl -/-- Flag: does `x` begin with the fixed fixedValue `c`? Unfolds into `|c|` bit -tests joined by `andBit`, so for each fixedValue it is a *finite* composition — +/-- Flag: does `x` begin with the fixed constant `c`? Unfolds into `|c|` bit +tests joined by `andBit`, so for each constant it is a *finite* composition — no recursion on notation is needed. -/ def matchPrefix : List Bool → List Bool → List Bool | [], _ => [true] @@ -247,13 +247,13 @@ def matchPrefix : List Bool → List Bool → List Bool (andBit (bif b then bitAt [] x else notBit (bitAt [] x)) (matchPrefix c x.tail)) := rfl -/-- A fixedValue is matched by anything it prefixes. -/ +/-- A constant is matched by anything it prefixes. -/ theorem matchPrefix_append (c y : List Bool) : matchPrefix c (c ++ y) = [true] := by induction c generalizing y with | nil => rfl | cons b c ih => cases b <;> simp [andBit, notBit, ih] -/-- Nothing but the empty fixedValue matches the empty string. (Not a `simp` +/-- Nothing but the empty constant matches the empty string. (Not a `simp` lemma: `simp` unfolds the left-hand side past this shape.) -/ theorem matchPrefix_nil_right (b : Bool) (c : List Bool) : matchPrefix (b :: c) [] = [false] := by @@ -268,7 +268,7 @@ theorem andBit_flag (x y : List Bool) : | cons a x => cases a · exact Or.inr rfl - · rw [caseBit₀_cons, cond_true] + · rw [caseBit₀_cons, Bool.cond_true] cases y with | nil => exact Or.inr rfl | cons d y => cases d <;> simp @@ -281,7 +281,7 @@ theorem matchPrefix_flag (c x : List Bool) : | cons b c => rw [matchPrefix_cons]; exact andBit_flag _ _ /-- **The match test is exactly the prefix test.** This is what makes a table of -fixedValue patterns behave like a case analysis: the entry whose pattern is a +constant patterns behave like a case analysis: the entry whose pattern is a prefix of the key fires, and no other does. -/ theorem matchPrefix_eq_true_iff (c x : List Bool) : matchPrefix c x = [true] ↔ c <+: x := by @@ -291,7 +291,7 @@ theorem matchPrefix_eq_true_iff (c x : List Bool) : cases x with | nil => simp [andBit] | cons a x => - rw [matchPrefix_cons, nonemptyFlag_cons, andBit, caseBit₀_cons, cond_true, + rw [matchPrefix_cons, nonemptyFlag_cons, andBit, caseBit₀_cons, Bool.cond_true, andBit] have hbit : (bif b then bitAt [] (a :: x) else notBit (bitAt [] (a :: x))) = [decide (a = b)] := by diff --git a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/ConsBit.lean b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/ConsBit.lean index a242ba3a4b..5560ff1f0b 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/ConsBit.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/ConsBit.lean @@ -122,7 +122,7 @@ private theorem consBitTM_copy_loop (b : Bool) (x : List Bool) : c.output.writeAndMove (readBackWrite c.output.read) (idleDir c.output.read) = c.output := by rw [writeAndMove_readBack c.output (by simp [houtput_blank]), - idleDir, if_neg (by simp [houtput_blank]), Tape.move] + idleDir, ite_eq_right (by simp [houtput_blank]), Tape.move] have hstep : (consBitTM b).step c = some c1 := by simp [TM.step, hstate, consBitTM, hread, c1] refine ⟨c1, .step hstep .zero, rfl, ?_⟩ @@ -196,7 +196,7 @@ theorem consBitTM_computesInTime (b : Bool) : simp [c2, c1, Tape.move_cells] have hc2_input_head : c2.input.head = 0 + 1 := by show (c1.input.move (idleDir c1.input.read)).head = 0 + 1 - rw [idleDir, if_neg hne] + rw [idleDir, ite_eq_right hne] simp [Tape.move, c1, Tape.init] have hc2_output : c2.output.HasBinaryPrefix (b :: x.take 0) := by have hbase : ((Tape.init []).move Dir3.right).HasBinaryPrefix [] := diff --git a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/Encoding.lean b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/Encoding.lean index 172a2c796a..1394ec01ff 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/Encoding.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/Encoding.lean @@ -52,7 +52,7 @@ each expressing one head move as two bits crossing the split: - `leftCode_write_right`, `rightCode_write_right` - `leftCode_write_left`, `rightCode_write_left` -Every right-hand side is built from `take 2`, `drop 2`, `++` and the fixedValue +Every right-hand side is built from `take 2`, `drop 2`, `++` and the constant `symCode s` — all of which the algebra has (`Cobham.takeFn`, `Cobham.dropFn`, `Cobham.appendFn`, `Cobham.const`). -/ @@ -126,7 +126,7 @@ private theorem length_flatMap_symCode (l : List ℕ) (f : ℕ → Γ) : /-! ## The control state The state is stored one-hot: `|Q|` bits with a single `1`. Fixed width and -injective, and — the point — every state's code is a *fixedValue* for a fixed +injective, and — the point — every state's code is a *constant* for a fixed machine, so the transition table is finitely many `Cobham.matchPrefixFn` tests against constants (`Cobham.tableFn`). Binary would need arithmetic; one-hot needs none. -/ @@ -205,7 +205,7 @@ theorem leftCodeFrom_congr {t t' : Tape} {n : ℕ} The width is `W + 1 - head`, complementary to `leftCode`'s `head`, so the two parts always account for exactly the cells `0 … W`: their total width is the -fixedValue `2 · (W + 1)` and a head move just shifts two bits across the split. -/ +constant `2 · (W + 1)` and a head move just shifts two bits across the split. -/ def rightCode (t : Tape) (W : ℕ) : List Bool := cellsCode t t.head (W + 1 - t.head) @[simp] theorem leftCode_length (t : Tape) : (leftCode t).length = 2 * t.head := @@ -465,7 +465,7 @@ theorem symDecode_take_padTo_rightCode {W : ℕ} (t : Tape) (hW : t.head ≤ W) /-! ### One tape's step The encoded step on a tape's two half-blocks. Every right-hand side is -`take 2` / `drop 2` / `++` / a fixedValue and a re-pad, so the algebra realizes it +`take 2` / `drop 2` / `++` / a constant and a re-pad, so the algebra realizes it with `Cobham.takeFn`, `Cobham.dropFn`, `Cobham.appendFn`, `Cobham.const` and `Cobham.padFn` — and within one branch of `Cobham.tableFn` the symbol `s` and the direction `d` are *constants*. -/ @@ -545,7 +545,7 @@ def cfgTapes {k : ℕ} {Q : Type} (c : Cfg k Q) : List Tape := The transition function is indexed by the current state together with the symbol under every head. Packing those into one string turns the whole finite case -analysis into `Cobham.tableFn`: each (state, symbols) combination is a *fixedValue* +analysis into `Cobham.tableFn`: each (state, symbols) combination is a *constant* pattern, and there are finitely many of them for a fixed machine. -/ /-- The state and the symbols under every head, in tape order. -/ @@ -592,7 +592,7 @@ private theorem zipWith_ofFn {α β γ : Type} {n : ℕ} (f : α → β → γ) /-- The write a transition *really* performs: at cell `0` the model makes the write a no-op, and this records that. Under `Tape.StartInvariant` the test is on the **read symbol**, which the transition table already branches on — so the -correction costs the algebra nothing, it just picks a different fixedValue in the +correction costs the algebra nothing, it just picks a different constant in the `▷` branch. -/ def correctWriteSym (r s : Γ) : Γ := if r = Γ.start then Γ.start else s @@ -609,7 +609,7 @@ theorem write_correctWrite {t : Tape} (s : Γ) (h : t.StartInvariant) : have hh : t.head = 0 := by by_contra hne exact h.read_ne_start (by omega) hr - rw [Tape.write, if_pos hh, Tape.write, if_pos hh] + rw [Tape.write, ite_eq_left hh, Tape.write, ite_eq_left hh] · rfl /-- Under the invariant, the corrected write agrees with cell `0` when the head @@ -617,7 +617,7 @@ is there — the hypothesis `tapeStepBlocks_eq` needs. -/ theorem correctWrite_at_zero {t : Tape} (s : Γ) (h : t.StartInvariant) (hh : t.head = 0) : correctWrite t s = t.cells t.head := by have hr : t.read = Γ.start := by rw [Tape.read, hh]; exact h.1 - rw [correctWrite, correctWriteSym, if_pos hr] + rw [correctWrite, correctWriteSym, ite_eq_left hr] show Γ.start = t.cells t.head rw [hh] exact h.1.symm @@ -724,7 +724,7 @@ theorem stepActs_eq_stepActsOf {k : ℕ} (tm : TM k) (c : Cfg k tm.Q) : theorem step_state_eq {k : ℕ} (tm : TM k) {c c' : Cfg k tm.Q} (h : tm.step c = some c') : c'.state = stepStateOf tm c.state (cfgReads c) := by have hne : ¬ c.state = tm.qhalt := fun hq => by simp [TM.step, hq] at h - rw [TM.step, if_neg hne] at h + rw [TM.step, ite_eq_right hne] at h injection h with h subst h rfl @@ -736,7 +736,7 @@ theorem cfgTapes_step {k : ℕ} (tm : TM k) {c c' : Cfg k tm.Q} (hwork : ∀ i, (c.work i).StartInvariant) : cfgTapes c' = tapesStep (stepActs tm c) (cfgTapes c) := by have hne : ¬ c.state = tm.qhalt := fun hq => by simp [TM.step, hq] at h - rw [TM.step, if_neg hne] at h + rw [TM.step, ite_eq_right hne] at h injection h with h subst h rw [cfgTapes, cfgTapes, stepActs, tapesStep] diff --git a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/Extract.lean b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/Extract.lean index ef14f0a8e3..8adebd3e76 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/Extract.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/Extract.lean @@ -136,10 +136,10 @@ theorem runTrue_length {z : List Bool} {n : ℕ} (htrue : ∀ i < n, bitOf z i = | succ m ih => rw [runTrue, List.length_append, ih] rcases Nat.lt_or_ge m n with hm | hm - · rw [if_pos ⟨by omega, htrue m hm⟩] + · rw [ite_eq_left ⟨by omega, htrue m hm⟩] simp only [List.length_cons, List.length_nil] omega - · rw [if_neg ?_] + · rw [ite_eq_right ?_] · simp only [List.length_nil] omega · rintro ⟨h1, h2⟩ @@ -190,7 +190,7 @@ theorem cellBitsFn {n : ℕ} (o : ℕ) {gr gz : (Fin n → List Bool) → List B simp; omega cases b <;> · rw [recNotation_cons] - simp only [cond_true, cond_false] + simp only [Bool.cond_true, Bool.cond_false] rw [cellStep_cons, ih, bitAt_eq, hlen, List.length_cons, cellBits] have hh : Cobham (cellStep o) := (appendFn (Cobham.proj 1) @@ -220,18 +220,18 @@ theorem runTrueFn {n : ℕ} {gr gz : (Fin n → List Bool) → List Bool} | cons b x ih => cases b <;> · rw [recNotation_cons] - simp only [cond_true, cond_false] + simp only [Bool.cond_true, Bool.cond_false] rw [runStep_cons, ih, bitAt_eq, List.length_cons, runTrue] congr 1 rcases Nat.lt_or_ge (runTrue (v 0) x.length).length x.length with hlt | hge - · rw [if_neg (by omega)] + · rw [ite_eq_right (by omega)] cases hd : x.drop (runTrue (v 0) x.length).length with | nil => rw [List.drop_eq_nil_iff] at hd; omega | cons c l => cases c <;> rfl · rw [List.drop_eq_nil_of_le hge] cases hb : bitOf (v 0) x.length - · rw [if_neg (by simp)]; rfl - · rw [if_pos ⟨hge, rfl⟩]; rfl + · rw [ite_eq_right (by simp)]; rfl + · rw [ite_eq_left ⟨hge, rfl⟩]; rfl have hh : Cobham runStep := (appendFn (Cobham.proj 1) (iteFn diff --git a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/HeadFlag.lean b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/HeadFlag.lean index ea95361940..ea9773f87a 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/HeadFlag.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/HeadFlag.lean @@ -124,7 +124,7 @@ theorem headFlagTM_computesInTime (target : Bool) : have hstep2 : (headFlagTM target).step c1 = some c2 := by simp [TM.step, headFlagTM, c1, c2, hri] refine ⟨c2, 2, le_rfl, .step hstep1 (.step hstep2 .zero), rfl, ?_⟩ - rw [headFlag, if_pos hb] + rw [headFlag, ite_eq_left hb] refine ⟨fun i hi => ?_, ?_⟩ · have hi0 : i = 0 := by simpa using hi subst hi0 @@ -149,7 +149,7 @@ theorem headFlagTM_computesInTime (target : Bool) : have hstep2 : (headFlagTM target).step c1 = some c2 := by simp [TM.step, headFlagTM, c1, c2, hri] refine ⟨c2, 2, le_rfl, .step hstep1 (.step hstep2 .zero), rfl, ?_⟩ - rw [headFlag, if_neg hb] + rw [headFlag, ite_eq_right hb] refine ⟨fun i hi => by simp at hi, ?_⟩ have hoc : c1.output.read = Γ.blank := by simp [c1, Tape.read, Tape.move, Tape.init] diff --git a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/Iterate.lean b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/Iterate.lean index 5597b54b17..8d2c0c4030 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/Iterate.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/Iterate.lean @@ -217,15 +217,15 @@ def bookTapes (rfT junkT : Tape) (H : ℕ) : Fin (3 + (k + 2) + 0) → Tape := @[simp] theorem bookTapes_rf (rfT junkT : Tape) (H : ℕ) : bookTapes (k := k) rfT junkT H rfIdx = rfT := by - rw [bookTapes, if_pos rfl] + rw [bookTapes, ite_eq_left rfl] @[simp] theorem bookTapes_wf (rfT junkT : Tape) (H : ℕ) : bookTapes (k := k) rfT junkT H wfIdx = regTape H := by - rw [bookTapes, if_neg (fun h => rfIdx_ne_wfIdx h.symm), if_pos rfl] + rw [bookTapes, ite_eq_right (fun h => rfIdx_ne_wfIdx h.symm), ite_eq_left rfl] @[simp] theorem bookTapes_junk (rfT junkT : Tape) (H : ℕ) : bookTapes (k := k) rfT junkT H junkIdx = junkT := by - rw [bookTapes, if_neg junkIdx_ne_rfIdx, if_neg junkIdx_ne_wfIdx] + rw [bookTapes, ite_eq_right junkIdx_ne_rfIdx, ite_eq_right junkIdx_ne_wfIdx] theorem eq_bookTapes_of_not_middle {work : Fin (3 + (k + 2) + 0) → Tape} {rfT junkT : Tape} {H : ℕ} @@ -346,7 +346,7 @@ variable {M : TM k} {Y : ℕ → List Bool} {inp₀ junkT : Tape} {v H : ℕ} theorem iterFamily_book (i : ℕ) (j : Fin (3 + (k + 2) + 0)) (hj : ¬ placeWorkInMiddle 3 (k + 2) j) : iterFamily M Y inp₀ junkT v H i j = bookTapes (regTape v) junkT H j := by - rw [iterFamily, dif_neg hj] + rw [iterFamily, dite_eq_right hj] @[simp] theorem iterFamily_rf (i : ℕ) : iterFamily M Y inp₀ junkT v H i rfIdx = regTape v := by @@ -437,12 +437,12 @@ def emitStart (extras : Fin (3 + (k + 2) + 0) → Tape) : Fin (3 + (k + 2) + 0) theorem emitStart_middle (extras : Fin (3 + (k + 2) + 0) → Tape) (j : Fin (k + 2)) : emitStart extras (appIdx j) = parkedBlank := by - rw [emitStart, if_pos (appIdx_middle j)] + rw [emitStart, ite_eq_left (appIdx_middle j)] theorem emitStart_extra (extras : Fin (3 + (k + 2) + 0) → Tape) (i : Fin (3 + (k + 2) + 0)) (hi : ¬ placeWorkInMiddle 3 (k + 2) i) : emitStart extras i = extras i := by - rw [emitStart, if_neg hi] + rw [emitStart, ite_eq_right hi] /-- **The setup's emission phase.** From the bumped input holding `x` and an all-blank block, `pair [] x` lands on the result tape and the whole block stays @@ -471,13 +471,13 @@ theorem placedEmit_hoareTime (x : List Bool) (H : ℕ) (hH : x.length + 4 ≤ H) (placeWorkInMiddle 3 (k + 2)) (fun i => by by_cases hi : placeWorkInMiddle 3 (k + 2) i - · rw [emitStart, if_pos hi]; exact hblankSI - · rw [emitStart, if_neg hi]; exact hextraSI i hi) - (fun i hi => by rw [emitStart, if_pos hi, parkedBlank_head]) + · rw [emitStart, ite_eq_left hi]; exact hblankSI + · rw [emitStart, ite_eq_right hi]; exact hextraSI i hi) + (fun i hi => by rw [emitStart, ite_eq_left hi, parkedBlank_head]) (fun i hi j hj => by - rw [emitStart, if_pos hi] + rw [emitStart, ite_eq_left hi] show ((Tape.init ([] : List Γ)).move Dir3.right).cells j = Γ.blank - rw [Tape.move_cells, initNil_cells, if_neg (by omega)]) + rw [Tape.move_cells, initNil_cells, ite_eq_right (by omega)]) refine ((hconf.weaken_pre ?_).strengthen_post ?_).mono_bound (by simp only [TM.pairInputWorkTime, List.length_nil]; omega) · rintro inp work out ⟨rfl, rfl, rfl⟩ @@ -508,8 +508,8 @@ theorem parkedBlank_eq_regTape_zero : parkedBlank = regTape 0 := by show _ = regCells 0 j rw [regCells] by_cases hj : j = 0 - · rw [if_pos hj, if_pos hj] - · rw [if_neg hj, if_neg hj, if_neg (by omega)] + · rw [ite_eq_left hj, ite_eq_left hj] + · rw [ite_eq_right hj, ite_eq_right hj, ite_eq_right (by omega)] /-- The register value cap the padding polynomial's evaluation runs under. -/ def polyM (p : Polynomial ℕ) (n : ℕ) : ℕ := @@ -614,8 +614,8 @@ theorem iterSetup_hoareTime (p : Polynomial ℕ) (x : List Bool) (H : ℕ) Parked (emitStart (bookTapes (regTape x.length) (regTape H) H) i) := by intro i by_cases hi : placeWorkInMiddle 3 (k + 2) i - · rw [emitStart, if_pos hi]; exact parked_parkedBlank - · rw [emitStart, if_neg hi] + · rw [emitStart, ite_eq_left hi]; exact parked_parkedBlank + · rw [emitStart, ite_eq_right hi] exact ⟨bookTapes_head (parked_regTape _) (parked_regTape _) i hi, (bookTapes_startInvariant (startInvariant_regTape _) (startInvariant_regTape _) i hi).2⟩ @@ -697,19 +697,19 @@ theorem iterMain_hoareTime (M : TM k) {G : List Bool → List Bool} {T : ℕ → (teardownExtras v H) (fun i hi => by rcases not_middle_succ_cases i hi with h | h | h | h - · rw [h, teardownExtras, if_neg rfIdx_ne_resIdx, bookTapes_rf] + · rw [h, teardownExtras, ite_eq_right rfIdx_ne_resIdx, bookTapes_rf] exact startInvariant_regTape v - · rw [h, teardownExtras, if_neg wfIdx_ne_resIdx, bookTapes_wf]; exact hregSI - · rw [h, teardownExtras, if_neg junkIdx_ne_resIdx, bookTapes_junk]; exact hregSI - · rw [h, teardownExtras, if_pos rfl] + · rw [h, teardownExtras, ite_eq_right wfIdx_ne_resIdx, bookTapes_wf]; exact hregSI + · rw [h, teardownExtras, ite_eq_right junkIdx_ne_resIdx, bookTapes_junk]; exact hregSI + · rw [h, teardownExtras, ite_eq_left rfl] exact startInvariant_initNil.move Dir3.right) (fun i hi => by rcases not_middle_succ_cases i hi with h | h | h | h - · rw [h, teardownExtras, if_neg rfIdx_ne_resIdx, bookTapes_rf] + · rw [h, teardownExtras, ite_eq_right rfIdx_ne_resIdx, bookTapes_rf] exact (parked_regTape v).1 - · rw [h, teardownExtras, if_neg wfIdx_ne_resIdx, bookTapes_wf]; exact hregP.1 - · rw [h, teardownExtras, if_neg junkIdx_ne_resIdx, bookTapes_junk]; exact hregP.1 - · rw [h, teardownExtras, if_pos rfl]; exact parked_parkedBlank.1) + · rw [h, teardownExtras, ite_eq_right wfIdx_ne_resIdx, bookTapes_wf]; exact hregP.1 + · rw [h, teardownExtras, ite_eq_right junkIdx_ne_resIdx, bookTapes_junk]; exact hregP.1 + · rw [h, teardownExtras, ite_eq_left rfl]; exact parked_parkedBlank.1) -- the two seams are the identity: every tape is parked have hseam : ∀ (W : Fin (3 + (k + 2) + 0) → Tape), (∀ i, Parked (W i)) → ∀ (inp' : Tape) (out' : Tape), inp' = inp → out' = parkedBlank → @@ -748,11 +748,11 @@ theorem iterMain_hoareTime (M : TM k) {G : List Bool → List Bool} {T : ℕ → rw [iterFamily_app] exact congrFun (TM.applyPre_spec M (Y v) inp').1 i · rcases not_middle_succ_cases i hi with h | h | h | h - · rw [h, iterFamily_rf, teardownExtras, if_neg rfIdx_ne_resIdx, bookTapes_rf] - · rw [h, iterFamily_wf, teardownExtras, if_neg wfIdx_ne_resIdx, bookTapes_wf] - · rw [h, iterFamily_junk, teardownExtras, if_neg junkIdx_ne_resIdx, bookTapes_junk] + · rw [h, iterFamily_rf, teardownExtras, ite_eq_right rfIdx_ne_resIdx, bookTapes_rf] + · rw [h, iterFamily_wf, teardownExtras, ite_eq_right wfIdx_ne_resIdx, bookTapes_wf] + · rw [h, iterFamily_junk, teardownExtras, ite_eq_right junkIdx_ne_resIdx, bookTapes_junk] · rw [h, show (resIdx (k := k)) = appIdx (Fin.last (k + 1)) from rfl, iterFamily_app, - teardownExtras, if_pos (show appIdx (Fin.last (k + 1)) = resIdx from rfl), + teardownExtras, ite_eq_left (show appIdx (Fin.last (k + 1)) = resIdx from rfl), TM.applyPre, Fin.snoc_last] · rintro inp' work' out' ⟨hout, -⟩ exact hout diff --git a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/IterateLayout.lean b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/IterateLayout.lean index 5d9fa35c72..68e6015ae2 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/IterateLayout.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/IterateLayout.lean @@ -356,7 +356,7 @@ theorem applyPre_eq (M : TM k) (x : List Bool) (inp₀ : Tape) (j : Fin (k + 2)) if j = Fin.castSucc (Fin.last k) then (Tape.init (x.map Γ.ofBool)).move Dir3.right else parkedBlank := by refine Fin.lastCases ?_ ?_ j - · rw [TM.applyPre, Fin.snoc_last, if_neg] + · rw [TM.applyPre, Fin.snoc_last, ite_eq_right] intro hc exact absurd (congrArg Fin.val hc) (by simp) · intro j' @@ -365,14 +365,14 @@ theorem applyPre_eq (M : TM k) (x : List Bool) (inp₀ : Tape) (j : Fin (k + 2)) rw [TM.retargetInputStartedCfg] dsimp only by_cases hj : j' = Fin.last k - · rw [hj, if_neg (by simp), if_pos rfl] + · rw [hj, ite_eq_right (by simp), ite_eq_left rfl] · have hlt : j'.val < k := by have := j'.isLt rcases Nat.lt_or_ge j'.val k with h | h · exact h · exact absurd (Fin.ext (show j'.val = (Fin.last k).val by rw [Fin.val_last]; omega)) hj - rw [if_pos hlt, if_neg (fun hc => hj (Fin.castSucc_injective (k + 1) hc))] + rw [ite_eq_left hlt, ite_eq_right (fun hc => hj (Fin.castSucc_injective (k + 1) hc))] rfl theorem resIdx_ne_vinIdx : resIdx (k := k) ≠ vinIdx := by @@ -435,7 +435,7 @@ theorem iterFinish_hoareTime (M : TM k) (H : ℕ) exact hblankSI have hW₀other : ∀ i, i ≠ resIdx → i ≠ vinIdx → Parked (W₀ i) := by intro i hir _; rw [hW₀]; dsimp only - rw [if_neg hir] + rw [ite_eq_right hir] split; · exact hrfP split; · exact hjunkP split; · exact hregP @@ -444,27 +444,27 @@ theorem iterFinish_hoareTime (M : TM k) (H : ℕ) have hW₀vin : W₀ vinIdx = parkedBlank := by rw [hW₀] dsimp only - rw [if_neg (fun h => resIdx_ne_vinIdx h.symm), if_neg (fun h => rfIdx_ne_appIdx _ h.symm), - if_neg (fun h => junkIdx_ne_appIdx _ h.symm), if_neg (fun h => wfIdx_ne_appIdx _ h.symm)] + rw [ite_eq_right (fun h => resIdx_ne_vinIdx h.symm), ite_eq_right (fun h => rfIdx_ne_appIdx _ h.symm), + ite_eq_right (fun h => junkIdx_ne_appIdx _ h.symm), ite_eq_right (fun h => wfIdx_ne_appIdx _ h.symm)] have hW₀app : ∀ j : Fin (k + 2), appIdx j ≠ resIdx → W₀ (appIdx j) = parkedBlank := by intro j hj rw [hW₀] dsimp only - rw [if_neg hj, if_neg (fun h => rfIdx_ne_appIdx _ h.symm), - if_neg (fun h => junkIdx_ne_appIdx _ h.symm), if_neg (fun h => wfIdx_ne_appIdx _ h.symm)] + rw [ite_eq_right hj, ite_eq_right (fun h => rfIdx_ne_appIdx _ h.symm), + ite_eq_right (fun h => junkIdx_ne_appIdx _ h.symm), ite_eq_right (fun h => wfIdx_ne_appIdx _ h.symm)] have hW₀rf : W₀ rfIdx = rfT := by rw [hW₀] dsimp only - rw [if_neg rfIdx_ne_resIdx, if_pos rfl] + rw [ite_eq_right rfIdx_ne_resIdx, ite_eq_left rfl] have hW₀junk : W₀ junkIdx = junkT := by rw [hW₀] dsimp only - rw [if_neg junkIdx_ne_resIdx, if_neg junkIdx_ne_rfIdx, if_pos rfl] + rw [ite_eq_right junkIdx_ne_resIdx, ite_eq_right junkIdx_ne_rfIdx, ite_eq_left rfl] have hW₀wf : W₀ wfIdx = regTape H := by rw [hW₀] dsimp only - rw [if_neg wfIdx_ne_resIdx, if_neg (fun h => rfIdx_ne_wfIdx h.symm), - if_neg (fun h => junkIdx_ne_wfIdx h.symm), if_pos rfl] + rw [ite_eq_right wfIdx_ne_resIdx, ite_eq_right (fun h => rfIdx_ne_wfIdx h.symm), + ite_eq_right (fun h => junkIdx_ne_wfIdx h.symm), ite_eq_left rfl] -- the value tape produced by the copy, and the family after each phase set vinT : Tape := (Tape.init (x.map Γ.ofBool)).move Dir3.right with hvinT have hvinSI : Tape.StartInvariant vinT := (startInvariant_initOfBool x).move Dir3.right @@ -559,9 +559,9 @@ theorem iterFinish_hoareTime (M : TM k) (H : ℕ) hW₁other wfIdx wfIdx_ne_resIdx wfIdx_ne_vinIdx, hW₀wf] · rw [applyPre_eq] by_cases hj : j = Fin.castSucc (Fin.last k) - · rw [if_pos hj, hj, show appIdx (Fin.castSucc (Fin.last k)) = vinIdx from rfl, + · rw [ite_eq_left hj, hj, show appIdx (Fin.castSucc (Fin.last k)) = vinIdx from rfl, hW₂, Function.update_of_ne resIdx_ne_vinIdx.symm, hW₁vin] - · rw [if_neg hj] + · rw [ite_eq_right hj] by_cases hjl : j = Fin.last (k + 1) · rw [hjl, show appIdx (Fin.last (k + 1)) = resIdx from rfl, hW₂, Function.update_self] · have hjr : appIdx j ≠ resIdx := fun h => diff --git a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/MulLen.lean b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/MulLen.lean index e69a650f12..649958faa6 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/MulLen.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/MulLen.lean @@ -228,7 +228,7 @@ def mulLenTM : TM 1 where /-- A content-preserving idle step on a tape whose head is off the left marker. -/ private theorem idle_eq {t : Tape} (h : t.read ≠ Γ.start) : t.writeAndMove (readBackWrite t.read) (idleDir t.read) = t := by - rw [writeAndMove_readBack t h, idleDir, if_neg h, Tape.move] + rw [writeAndMove_readBack t h, idleDir, ite_eq_right h, Tape.move] /-- The emit pass: from `emit`, with `m` marks on the work tape and the work head at cell `k + 1`, the machine writes one `false` for each of the `r` @@ -255,7 +255,7 @@ private theorem mulLenTM_emit_loop : have hwne : (c.work 0).read ≠ Γ.start := by rw [hwread]; decide have houtne : c.output.read ≠ Γ.start := by rw [hpre.read_blank]; decide have hinp_eq : c.input.move (idleDir c.input.read) = c.input := by - rw [idleDir, if_neg hinp, Tape.move] + rw [idleDir, ite_eq_right hinp, Tape.move] refine ⟨{ state := MulPhase.rew input := c.input work := c.work @@ -267,7 +267,7 @@ private theorem mulLenTM_emit_loop : have : i = 0 := Subsingleton.elim i 0 subst this exact idle_eq hwne - simp only [TM.step, hstate, mulLenTM, hwread, hinp_eq, reduceCtorEq, if_false] + simp only [TM.step, hstate, mulLenTM, hwread, hinp_eq, reduceCtorEq, ite_false] rw [hwork, idle_eq houtne] | succ r ih => intro k m hkm acc c hstate hcells hhead hinp hpre @@ -275,7 +275,7 @@ private theorem mulLenTM_emit_loop : rw [Tape.read, hcells, hhead]; exact regCells_one (by omega) (by omega) have hwne : (c.work 0).read ≠ Γ.start := by rw [hwread]; decide have hinp_eq : c.input.move (idleDir c.input.read) = c.input := by - rw [idleDir, if_neg hinp, Tape.move] + rw [idleDir, ite_eq_right hinp, Tape.move] set c1 : Cfg 1 mulLenTM.Q := { state := MulPhase.emit input := c.input @@ -288,7 +288,7 @@ private theorem mulLenTM_emit_loop : subst hi exact writeAndMove_readBack _ hwne _ have hstep : mulLenTM.step c = some c1 := by - simp only [TM.step, hstate, mulLenTM, hwread, hinp_eq, hc1, reduceCtorEq, if_false, + simp only [TM.step, hstate, mulLenTM, hwread, hinp_eq, hc1, reduceCtorEq, ite_false, reduceIte] rw [hwork] rfl @@ -325,14 +325,14 @@ private theorem mulLenTM_rew_loop : have hwread : (c.work 0).read = Γ.start := by rw [Tape.read, hcells, hhead]; rfl have hinp_eq : c.input.move (idleDir c.input.read) = c.input := by - rw [idleDir, if_neg hinp, Tape.move] + rw [idleDir, ite_eq_right hinp, Tape.move] have hwork : (fun i => (c.work i).writeAndMove (readBackWrite ((c.work i).read)).toΓ Dir3.right) = fun i => (c.work i).move Dir3.right := by funext i have hi : i = 0 := Subsingleton.elim i 0 subst hi show ((c.work 0).write _).move Dir3.right = (c.work 0).move Dir3.right - rw [Tape.write, if_pos hhead] + rw [Tape.write, ite_eq_left hhead] refine ⟨{ state := MulPhase.outer input := c.input work := fun i => (c.work i).move Dir3.right @@ -340,14 +340,14 @@ private theorem mulLenTM_rew_loop : by simp [Tape.move, hhead], rfl, rfl⟩ refine .step ?_ .zero simp only [TM.step, hstate, mulLenTM, hwread, hinp_eq, reduceIte, reduceCtorEq, - if_false] + ite_false] rw [hwork, idle_eq hout] | succ h ih => intro m c hstate hcells hhead hinp hout have hwne : (c.work 0).read ≠ Γ.start := by rw [Tape.read, hcells, hhead]; exact regCells_ne_start (by omega) have hinp_eq : c.input.move (idleDir c.input.read) = c.input := by - rw [idleDir, if_neg hinp, Tape.move] + rw [idleDir, ite_eq_right hinp, Tape.move] set c1 : Cfg 1 mulLenTM.Q := { state := MulPhase.rew input := c.input @@ -358,11 +358,11 @@ private theorem mulLenTM_rew_loop : funext i have hi : i = 0 := Subsingleton.elim i 0 subst hi - rw [moveLeftDir, if_neg hwne] + rw [moveLeftDir, ite_eq_right hwne] exact writeAndMove_readBack _ hwne _ have hstep : mulLenTM.step c = some c1 := by - simp only [TM.step, hstate, mulLenTM, hinp_eq, hc1, if_neg hwne, reduceCtorEq, - if_false] + simp only [TM.step, hstate, mulLenTM, hinp_eq, hc1, ite_eq_right hwne, reduceCtorEq, + ite_false] rw [hwork, idle_eq hout] obtain ⟨c', hreach, hst, hcl, hhd, hin, hou⟩ := ih m c1 rfl (by rw [hc1]; simpa [Tape.move_cells] using hcells) @@ -393,7 +393,7 @@ private theorem mulLenTM_outer_loop : rw [Tape.read, hcells, hhead]; exact regCells_ne_start (by omega) have houtne : c.output.read ≠ Γ.start := by rw [hpre.read_blank]; decide have hinp_eq : c.input.move (idleDir Γ.blank) = c.input := by - rw [idleDir, if_neg (by decide), Tape.move] + rw [idleDir, ite_eq_right (by decide), Tape.move] have hwork : (fun i => (c.work i).writeAndMove (readBackWrite ((c.work i).read)).toΓ (idleDir ((c.work i).read))) = c.work := by funext i @@ -406,7 +406,7 @@ private theorem mulLenTM_outer_loop : output := c.output }, 1, by omega, ?_, rfl, by simpa using hpre⟩ refine .step ?_ .zero simp only [TM.step, hstate, mulLenTM, hread, hinp_eq, reduceIte, reduceCtorEq, - if_false] + ite_false] rw [hwork, idle_eq houtne] | cons b B ih => intro m acc c hstate hcells hhead hsuf hpre @@ -427,7 +427,7 @@ private theorem mulLenTM_outer_loop : work := c.work output := c.output } with hc1 have hstep : mulLenTM.step c = some c1 := by - simp only [TM.step, hstate, mulLenTM, hnb, hc1, reduceCtorEq, if_false] + simp only [TM.step, hstate, mulLenTM, hnb, hc1, reduceCtorEq, ite_false] rw [hwork, idle_eq houtne] have hsuf1 : c1.input.HasBinarySuffix B := hsuf.move_right_cons obtain ⟨c2, hreach2, hst2, hcl2, hhd2, hin2, hout2⟩ := @@ -483,13 +483,13 @@ private theorem mulLenTM_scan_loop : exact idle_eq hwne have hread : c.input.read = Γ.blank := hsuf.read_nil have hinp_eq : c.input.move (idleDir Γ.blank) = c.input := by - rw [idleDir, if_neg (by decide), Tape.move] + rw [idleDir, ite_eq_right (by decide), Tape.move] refine ⟨{ state := MulPhase.done input := c.input work := c.work output := c.output }, 1, by omega, ?_, rfl, by simpa using hpre⟩ refine .step ?_ .zero - simp only [TM.step, hstate, mulLenTM, hread, hinp_eq, reduceCtorEq, if_false] + simp only [TM.step, hstate, mulLenTM, hread, hinp_eq, reduceCtorEq, ite_false] rw [hwork, idle_eq houtne] | succ N ih => intro w k hN c hstate hcells hhead hsuf hpre @@ -503,9 +503,9 @@ private theorem mulLenTM_scan_loop : subst hi exact idle_eq hwne have hidleB : ∀ t : Tape, t.move (idleDir Γ.blank) = t := by - intro t; rw [idleDir, if_neg (by decide)]; rfl + intro t; rw [idleDir, ite_eq_right (by decide)]; rfl have hidleZ : ∀ t : Tape, t.move (idleDir Γ.zero) = t := by - intro t; rw [idleDir, if_neg (by decide)]; rfl + intro t; rw [idleDir, ite_eq_right (by decide)]; rfl -- The one-step transition out of `scanA` on a payload bit. have hstepA : ∀ b : Bool, c.input.read = Γ.ofBool b → @@ -516,8 +516,8 @@ private theorem mulLenTM_scan_loop : output := c.output } := by intro b hread cases b <;> - · simp only [TM.step, hstate, mulLenTM, hread, Γ.ofBool, reduceCtorEq, if_false, - cond_true, cond_false] + · simp only [TM.step, hstate, mulLenTM, hread, Γ.ofBool, reduceCtorEq, ite_false, + Bool.cond_true, Bool.cond_false] rw [hwork, idle_eq houtne] match w with | [] => @@ -527,7 +527,7 @@ private theorem mulLenTM_scan_loop : work := c.work output := c.output }, 1, by omega, ?_, rfl, by simpa using hpre⟩ refine .step ?_ .zero - simp only [TM.step, hstate, mulLenTM, hread, hidleB, reduceCtorEq, if_false] + simp only [TM.step, hstate, mulLenTM, hread, hidleB, reduceCtorEq, ite_false] rw [hwork, idle_eq houtne] | [b] => -- One payload symbol then end of input: the block framing is broken. @@ -540,8 +540,8 @@ private theorem mulLenTM_scan_loop : simpa [mulAux_singleton] using hpre⟩ refine .step (hstepA b hsuf.read_cons) (.step ?_ .zero) cases b <;> - · simp only [TM.step, mulLenTM, hread1, hidleB, reduceCtorEq, if_false, - cond_true, cond_false] + · simp only [TM.step, mulLenTM, hread1, hidleB, reduceCtorEq, ite_false, + Bool.cond_true, Bool.cond_false] rw [hwork, idle_eq houtne] | true :: false :: z => -- A broken doubling: halt with empty output. @@ -554,8 +554,8 @@ private theorem mulLenTM_scan_loop : output := c.output }, 2, by omega, ?_, rfl, by simpa [mulAux_broken] using hpre⟩ refine .step (hstepA true hsuf.read_cons) (.step ?_ .zero) - simp only [TM.step, mulLenTM, hread1, hidleZ, reduceCtorEq, if_false, - cond_true] + simp only [TM.step, mulLenTM, hread1, hidleZ, reduceCtorEq, ite_false, + Bool.cond_true] rw [hwork, idle_eq houtne] | false :: true :: z => -- The separator: rewind the work tape and run the outer loop over `z`. @@ -574,7 +574,7 @@ private theorem mulLenTM_scan_loop : work := c.work output := c.output } with hc2 have hstep2 : mulLenTM.step c1 = some c2 := by - simp only [TM.step, hc1, hc2, mulLenTM, hread1, reduceCtorEq, if_false] + simp only [TM.step, hc1, hc2, mulLenTM, hread1, reduceCtorEq, ite_false] rw [hwork, idle_eq houtne] have hsuf2 : c2.input.HasBinarySuffix z := hsuf1.move_right_cons obtain ⟨c3, hreach3, hst3, hcl3, hhd3, hin3, hou3⟩ := @@ -615,12 +615,12 @@ private theorem mulLenTM_scan_loop : have hwmark : (fun i => (c.work i).writeAndMove (Γw.one).toΓ Dir3.right) = fun i => ((c.work i).write Γ.one).move Dir3.right := rfl have hstep2 : mulLenTM.step c1 = some c2 := by - simp only [TM.step, hc1, hc2, mulLenTM, hread1, reduceCtorEq, if_false] + simp only [TM.step, hc1, hc2, mulLenTM, hread1, reduceCtorEq, ite_false] rw [hwmark, idle_eq houtne] have hcells2 : (c2.work 0).cells = regCells (k + 1) := by rw [hc2] show (((c.work 0).write Γ.one).move Dir3.right).cells = _ - rw [Tape.move_cells, Tape.write, if_neg (by rw [hhead]; omega)] + rw [Tape.move_cells, Tape.write, ite_eq_right (by rw [hhead]; omega)] show Function.update (c.work 0).cells ((c.work 0).head) Γ.one = _ rw [hcells, hhead, regCells_update_succ] have hhead2 : (c2.work 0).head = k + 1 + 1 := by @@ -652,12 +652,12 @@ private theorem mulLenTM_scan_loop : have hwmark : (fun i => (c.work i).writeAndMove (Γw.one).toΓ Dir3.right) = fun i => ((c.work i).write Γ.one).move Dir3.right := rfl have hstep2 : mulLenTM.step c1 = some c2 := by - simp only [TM.step, hc1, hc2, mulLenTM, hread1, reduceCtorEq, if_false] + simp only [TM.step, hc1, hc2, mulLenTM, hread1, reduceCtorEq, ite_false] rw [hwmark, idle_eq houtne] have hcells2 : (c2.work 0).cells = regCells (k + 1) := by rw [hc2] show (((c.work 0).write Γ.one).move Dir3.right).cells = _ - rw [Tape.move_cells, Tape.write, if_neg (by rw [hhead]; omega)] + rw [Tape.move_cells, Tape.write, ite_eq_right (by rw [hhead]; omega)] show Function.update (c.work 0).cells ((c.work 0).head) Γ.one = _ rw [hcells, hhead, regCells_update_succ] have hhead2 : (c2.work 0).head = k + 1 + 1 := by diff --git a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/Reverse.lean b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/Reverse.lean index 7b0dcf185b..448f77bec6 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/Reverse.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/Reverse.lean @@ -107,7 +107,7 @@ def reverseTM : TM 1 where /-- A content-preserving idle step on a tape whose head is off the left marker. -/ private theorem rev_idle_eq {t : Tape} (h : t.read ≠ Γ.start) : t.writeAndMove (readBackWrite t.read) (idleDir t.read) = t := by - rw [writeAndMove_readBack t h, idleDir, if_neg h, Tape.move] + rw [writeAndMove_readBack t h, idleDir, ite_eq_right h, Tape.move] /-- The copy phase: from `copy` with the input cursor on `w` and the work tape holding `acc`, the machine appends `w` to the work tape and enters `emit` with @@ -137,20 +137,20 @@ private theorem reverseTM_copy_loop : exact hwork.2.2 acc.length le_rfl have hwne : (c.work 0).read ≠ Γ.start := by rw [hwread]; decide have hinp_eq : c.input.move (idleDir Γ.blank) = c.input := by - rw [idleDir, if_neg (by decide), Tape.move] + rw [idleDir, ite_eq_right (by decide), Tape.move] have hwmove : (fun i => (c.work i).writeAndMove (readBackWrite ((c.work i).read)).toΓ (moveLeftDir ((c.work i).read))) = fun i => (c.work i).move Dir3.left := by funext i have hi : i = 0 := Subsingleton.elim i 0 subst hi - rw [moveLeftDir, if_neg hwne] + rw [moveLeftDir, ite_eq_right hwne] exact writeAndMove_readBack _ hwne _ refine ⟨{ state := RevPhase.emit input := c.input work := fun i => (c.work i).move Dir3.left output := c.output }, ?_, rfl, ?_, ?_, ?_, by rw [hread]; decide, by simpa⟩ · refine .step ?_ .zero - simp only [TM.step, hstate, reverseTM, hread, hinp_eq, reduceCtorEq, if_false] + simp only [TM.step, hstate, reverseTM, hread, hinp_eq, reduceCtorEq, ite_false] rw [hwmove, rev_idle_eq houtne] · have hc : (c.work 0).HasBinaryContent acc := hwork.2 simpa using hc.move Dir3.left @@ -171,7 +171,7 @@ private theorem reverseTM_copy_loop : have hstep : reverseTM.step c = some c1 := by cases b <;> · simp only [TM.step, hstate, reverseTM, hread, Γ.ofBool, hc1, - reduceCtorEq, if_false] + reduceCtorEq, ite_false] rw [rev_idle_eq houtne] rfl obtain ⟨c', hreach, hst, hcont, hcz, hhd, hinp, hpre⟩ := @@ -206,7 +206,7 @@ private theorem reverseTM_emit_loop : have hwne1 : ¬ (c.work 0).read = Γ.one := by rw [hwread]; decide have houtne : c.output.read ≠ Γ.start := by rw [hout.read_blank]; decide have hinp_eq : c.input.move (idleDir c.input.read) = c.input := by - rw [idleDir, if_neg hinp, Tape.move] + rw [idleDir, ite_eq_right hinp, Tape.move] refine ⟨{ state := RevPhase.done input := c.input work := fun i => (c.work i).move Dir3.right @@ -217,10 +217,10 @@ private theorem reverseTM_emit_loop : funext i have hi : i = 0 := Subsingleton.elim i 0 subst hi - rw [Tape.writeAndMove, Tape.write, if_pos (by omega : (c.work 0).head = 0), - idleDir, if_pos hwread] + rw [Tape.writeAndMove, Tape.write, ite_eq_left (by omega : (c.work 0).head = 0), + idleDir, ite_eq_left hwread] simp only [TM.step, hstate, reverseTM, hinp_eq, hwne0, hwne1, reduceCtorEq, - if_false] + ite_false] rw [hwork, rev_idle_eq houtne] | succ j ih => intro bits acc c hstate hcont hw0 hhead hjb hinp hout @@ -230,13 +230,13 @@ private theorem reverseTM_emit_loop : have hwne : (c.work 0).read ≠ Γ.start := by rw [hwread]; exact Γ.ofBool_ne_start _ have hinp_eq : c.input.move (idleDir c.input.read) = c.input := by - rw [idleDir, if_neg hinp, Tape.move] + rw [idleDir, ite_eq_right hinp, Tape.move] have hwmove : (fun i => (c.work i).writeAndMove (readBackWrite ((c.work i).read)).toΓ (moveLeftDir ((c.work i).read))) = fun i => (c.work i).move Dir3.left := by funext i have hi : i = 0 := Subsingleton.elim i 0 subst hi - rw [moveLeftDir, if_neg hwne] + rw [moveLeftDir, ite_eq_right hwne] exact writeAndMove_readBack _ hwne _ set c1 : Cfg 1 reverseTM.Q := { state := RevPhase.emit @@ -247,12 +247,12 @@ private theorem reverseTM_emit_loop : rcases hb : bits[j]'hjlt with _ | _ · have h0 : (c.work 0).read = Γ.zero := by rw [hwread, hb]; rfl simp only [TM.step, hstate, reverseTM, hinp_eq, h0, hc1, hb, Γ.ofBool, - reduceCtorEq, if_false, reduceIte] + reduceCtorEq, ite_false, reduceIte] rw [hwmove] rfl · have h1 : (c.work 0).read = Γ.one := by rw [hwread, hb]; rfl simp only [TM.step, hstate, reverseTM, hinp_eq, h1, hc1, hb, Γ.ofBool, - reduceCtorEq, if_false, reduceIte] + reduceCtorEq, ite_false, reduceIte] rw [hwmove] rfl obtain ⟨c', hreach, hhalt, hfin⟩ := diff --git a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/Simulate.lean b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/Simulate.lean index 32310b9bc2..63207f2b0c 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/Simulate.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/Simulate.lean @@ -59,7 +59,7 @@ theorem runCfg_of_halted (tm : TM k) {c : Cfg k tm.Q} (h : c.state = tm.qhalt) ( runCfg tm c n = c := by induction n with | zero => rfl - | succ n ih => rw [runCfg_succ, ih, TM.step, if_pos h, Option.getD_none] + | succ n ih => rw [runCfg_succ, ih, TM.step, ite_eq_left h, Option.getD_none] /-- A run of exactly `t` steps is the `t`-th iterate. -/ theorem runCfg_of_reachesIn (tm : TM k) {c c' : Cfg k tm.Q} {t : ℕ} @@ -78,7 +78,7 @@ theorem step_startInvariant (tm : TM k) {c c' : Cfg k tm.Q} (h : tm.step c = som (hout : c.output.StartInvariant) : c'.input.StartInvariant ∧ (∀ i, (c'.work i).StartInvariant) ∧ c'.output.StartInvariant := by - rw [TM.step, if_neg (TM.state_ne_qhalt_of_step h)] at h + rw [TM.step, ite_eq_right (TM.state_ne_qhalt_of_step h)] at h injection h with h subst h exact ⟨hin.move _, fun i => (hwork i).writeAndMove _ _, hout.writeAndMove _ _⟩ @@ -87,7 +87,7 @@ theorem step_startInvariant (tm : TM k) {c c' : Cfg k tm.Q} (h : tm.step c = som theorem step_head_le (tm : TM k) {c c' : Cfg k tm.Q} (h : tm.step c = some c') : c'.input.head ≤ c.input.head + 1 ∧ (∀ i, (c'.work i).head ≤ (c.work i).head + 1) ∧ c'.output.head ≤ c.output.head + 1 := by - rw [TM.step, if_neg (TM.state_ne_qhalt_of_step h)] at h + rw [TM.step, ite_eq_right (TM.state_ne_qhalt_of_step h)] at h injection h with h subst h exact ⟨Tape.head_move_le _ _, fun i => Tape.head_writeAndMove_le _ _ _, diff --git a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/SndBlock.lean b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/SndBlock.lean index 431155d7f9..873051c149 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/SndBlock.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/SndBlock.lean @@ -132,7 +132,7 @@ private theorem sndBlockTM_emit_loop : .step (by simp [TM.step, hstate, sndBlockTM, hread]) .zero, rfl, ?_⟩ rw [show c.output.writeAndMove (readBackWrite c.output.read) (idleDir c.output.read) = c.output from by - rw [writeAndMove_readBack c.output houtne, idleDir, if_neg houtne, Tape.move]] + rw [writeAndMove_readBack c.output houtne, idleDir, ite_eq_right houtne, Tape.move]] simpa using hpre | cons bit y ih => intro acc c hstate hsuf hpre @@ -185,7 +185,7 @@ private theorem sndBlockTM_scan_loop : .step (by simp [TM.step, hstate, sndBlockTM, hread]) .zero, rfl, ?_⟩ rw [show c.output.writeAndMove (readBackWrite c.output.read) (idleDir c.output.read) = c.output from by - rw [writeAndMove_readBack c.output houtne, idleDir, if_neg houtne, Tape.move]] + rw [writeAndMove_readBack c.output houtne, idleDir, ite_eq_right houtne, Tape.move]] simpa [sndBlock] using hpre.hasOutput | succ fuel ih => intro w hw c hstate hsuf hpre @@ -204,7 +204,7 @@ private theorem sndBlockTM_scan_loop : .step (by simp [TM.step, hstate, sndBlockTM, hread]) .zero, rfl, ?_⟩ rw [show c.output.writeAndMove (readBackWrite c.output.read) (idleDir c.output.read) = c.output from by - rw [writeAndMove_readBack c.output houtne, idleDir, if_neg houtne, Tape.move]] + rw [writeAndMove_readBack c.output houtne, idleDir, ite_eq_right houtne, Tape.move]] simpa [sndBlock] using hpre.hasOutput | [false] => -- scanA reads false → scanBfalse; next reads blank → done. @@ -235,7 +235,7 @@ private theorem sndBlockTM_scan_loop : .step hstep (.step (by simp [TM.step, sndBlockTM, hread1, c1]) .zero), rfl, ?_⟩ rw [show c1.output.writeAndMove (readBackWrite c1.output.read) (idleDir c1.output.read) = c1.output from by - rw [writeAndMove_readBack c1.output houtne1, idleDir, if_neg houtne1, Tape.move]] + rw [writeAndMove_readBack c1.output houtne1, idleDir, ite_eq_right houtne1, Tape.move]] simpa [sndBlock] using hpre1.hasOutput | [true] => have hread : c.input.read = Γ.ofBool true := hsuf.read_cons @@ -265,7 +265,7 @@ private theorem sndBlockTM_scan_loop : .step hstep (.step (by simp [TM.step, sndBlockTM, hread1, c1]) .zero), rfl, ?_⟩ rw [show c1.output.writeAndMove (readBackWrite c1.output.read) (idleDir c1.output.read) = c1.output from by - rw [writeAndMove_readBack c1.output houtne1, idleDir, if_neg houtne1, Tape.move]] + rw [writeAndMove_readBack c1.output houtne1, idleDir, ite_eq_right houtne1, Tape.move]] simpa [sndBlock] using hpre1.hasOutput | false :: true :: y => -- separator: scanA false → scanBfalse → (reads true) → emit; copy y. @@ -420,7 +420,7 @@ private theorem sndBlockTM_scan_loop : rfl, ?_⟩ rw [show c1.output.writeAndMove (readBackWrite c1.output.read) (idleDir c1.output.read) = c1.output from by - rw [writeAndMove_readBack c1.output houtne1, idleDir, if_neg houtne1, Tape.move]] + rw [writeAndMove_readBack c1.output houtne1, idleDir, ite_eq_right houtne1, Tape.move]] have : sndBlock (true :: false :: rest) = [] := by simp [sndBlock, unpair?] rw [this]; simpa using hpre1.hasOutput diff --git a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/StepAlgebra.lean b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/StepAlgebra.lean index a2f56575e5..4f5b14b187 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/StepAlgebra.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/StepAlgebra.lean @@ -228,7 +228,7 @@ theorem tapesStepFn_eq {k : ℕ} {Q : Type} [Fintype Q] [DecidableEq Q] ih (j + 1) (by simp only [List.length_cons] at hj; omega)] simp [List.append_assoc] -/-- One whole branch of the transition table: the new state block (a fixedValue) +/-- One whole branch of the transition table: the new state block (a constant) followed by every tape stepped. -/ def branchFn (R q' : List Bool) (acts : List (Γ × Dir3)) (z : List Bool) : List Bool := @@ -266,7 +266,7 @@ theorem branchFn_eq {k : ℕ} (tm : TM k) {c c' : Cfg k tm.Q} {W : ℕ} A machine has finitely many (state, read-symbols) keys, so the transition function is a finite table: one `branchFn` per key, selected by matching the key -read out of the encoding against the key's fixedValue pattern. -/ +read out of the encoding against the key's constant pattern. -/ /-- The transition table's index set: every (state, read-symbols) pair. -/ noncomputable def stepEntries {k : ℕ} (tm : TM k) : @@ -287,13 +287,13 @@ noncomputable def stepBranch {k : ℕ} (tm : TM k) (R : List Bool) theorem stepBranch_halt {k : ℕ} (tm : TM k) (R : List Bool) {p : tm.Q × (Fin (k + 2) → Γ)} (h : p.1 = tm.qhalt) (z : List Bool) : - stepBranch tm R p z = z := if_pos h + stepBranch tm R p z = z := ite_eq_left h theorem stepBranch_step {k : ℕ} (tm : TM k) (R : List Bool) {p : tm.Q × (Fin (k + 2) → Γ)} (h : p.1 ≠ tm.qhalt) (z : List Bool) : stepBranch tm R p z = branchFn R (stateCode (stepStateOf tm p.1 p.2)) (stepActsOf tm p.1 p.2) z := - if_neg h + ite_eq_right h /-- **One machine step, on encodings.** The table dispatches on the key read out of the encoding and applies that key's branch. -/ @@ -537,7 +537,7 @@ theorem rewindFn_eq {W : ℕ} (t : Tape) (hinv : t.StartInvariant) (hW : t.head by_cases h0 : t.head = 0 · have hread : t.read = Γ.start := by rw [Tape.read, h0]; exact hinv.1 have hmove : t.move Dir3.left = t := move_left_of_head_zero h0 - rw [rewindFn, matchPrefix_symCode t hW, if_pos hread.symm, caseBit₀_cons, cond_true, + rw [rewindFn, matchPrefix_symCode t hW, ite_eq_left hread.symm, caseBit₀_cons, Bool.cond_true, hmove] · have hread : t.read ≠ Γ.start := hinv.read_ne_start (by omega) have hstep : ∀ s : Γ, s = t.read → @@ -576,7 +576,7 @@ theorem rewindFn_length_le (R z : List Bool) (hz : z.length ≤ 2 * R.length) : /-! ## The initial encoding At the start every tape but the input is blank and every head is at cell `0`, so -the encoding is a fixedValue apart from the input tape's right half-block — which +the encoding is a constant apart from the input tape's right half-block — which is the input string at two bits per cell. Zero padding *is* blank padding, which is why `symCode Γ.blank = [0,0]`. -/ @@ -615,7 +615,7 @@ theorem encodeBitsFn {n : ℕ} {g : (Fin n → List Bool) → List Bool} (h : Co | cons b x ih => cases b <;> · rw [recNotation_cons] - simp only [cond_true, cond_false] + simp only [Bool.cond_true, Bool.cond_false] rw [encStep_cons, ih, encodeBits_cons] have hs : ∀ b : Bool, Cobham (encStep b) := fun b => (appendFn (Cobham.const (symCode (Γ.ofBool b))) (Cobham.proj 1)).of_eq fun _ => rfl @@ -629,7 +629,7 @@ theorem encodeBitsFn {n : ℕ} {g : (Fin n → List Bool) → List Bool} (h : Co exact (Cobham.comp hbase fun _ : Fin 1 => h).of_eq fun _ => rfl /-- **The initial encoding.** Everything but the input tape's right half-block is -a fixedValue of the machine. -/ +a constant of the machine. -/ noncomputable def initFn {k : ℕ} (tm : TM k) (R x : List Bool) : List Bool := padTo R (stateCode tm.qstart) ++ (padTo R [] ++ (padTo R (symCode Γ.start ++ encodeBits x) ++ diff --git a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/TakeLen.lean b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/TakeLen.lean index a99968b325..5a43c6fb85 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/TakeLen.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/TakeLen.lean @@ -211,7 +211,7 @@ def takeLenTM : TM 1 where /-- A content-preserving idle step on a tape whose head is off the left marker. -/ private theorem take_idle_eq {t : Tape} (h : t.read ≠ Γ.start) : t.writeAndMove (readBackWrite t.read) (idleDir t.read) = t := by - rw [writeAndMove_readBack t h, idleDir, if_neg h, Tape.move] + rw [writeAndMove_readBack t h, idleDir, ite_eq_right h, Tape.move] /-- The copy phase: with `r` marks left under and to the right of the work head, the machine emits the first `r` symbols of the remaining input. -/ @@ -235,7 +235,7 @@ private theorem takeLenTM_copy_loop : have hwne1 : ¬ (c.work 0).read = Γ.one := by rw [hwread]; decide have houtne : c.output.read ≠ Γ.start := by rw [hpre.read_blank]; decide have hinp_eq : c.input.move (idleDir c.input.read) = c.input := by - rw [idleDir, if_neg hsuf.read_ne_start, Tape.move] + rw [idleDir, ite_eq_right hsuf.read_ne_start, Tape.move] have hwork : (fun i => (c.work i).writeAndMove (readBackWrite ((c.work i).read)).toΓ (idleDir ((c.work i).read))) = c.work := by funext i @@ -247,7 +247,7 @@ private theorem takeLenTM_copy_loop : work := c.work output := c.output }, 1, by omega, ?_, rfl, by simpa using hpre⟩ refine .step ?_ .zero - simp only [TM.step, hstate, takeLenTM, hwne1, hinp_eq, reduceCtorEq, if_false] + simp only [TM.step, hstate, takeLenTM, hwne1, hinp_eq, reduceCtorEq, ite_false] rw [hwork, take_idle_eq houtne] | succ r ih => intro h m hsum hh y acc c hstate hcells hhead hsuf hpre @@ -256,7 +256,7 @@ private theorem takeLenTM_copy_loop : have hwne : (c.work 0).read ≠ Γ.start := by rw [hwread]; decide have houtne : c.output.read ≠ Γ.start := by rw [hpre.read_blank]; decide have hinp_eq : c.input.move (idleDir c.input.read) = c.input := by - rw [idleDir, if_neg hsuf.read_ne_start, Tape.move] + rw [idleDir, ite_eq_right hsuf.read_ne_start, Tape.move] have hworkIdle : (fun i => (c.work i).writeAndMove (readBackWrite ((c.work i).read)).toΓ (idleDir ((c.work i).read))) = c.work := by funext i @@ -270,7 +270,7 @@ private theorem takeLenTM_copy_loop : subst hi exact writeAndMove_readBack _ hwne _ have hidleB : ∀ t : Tape, t.move (idleDir Γ.blank) = t := by - intro t; rw [idleDir, if_neg (by decide)]; rfl + intro t; rw [idleDir, ite_eq_right (by decide)]; rfl match y with | [] => have hread : c.input.read = Γ.blank := hsuf.read_nil @@ -280,7 +280,7 @@ private theorem takeLenTM_copy_loop : output := c.output }, 1, by omega, ?_, rfl, by simpa using hpre⟩ refine .step ?_ .zero simp only [TM.step, hstate, takeLenTM, hwread, hread, hidleB, reduceCtorEq, - if_false, reduceIte] + ite_false, reduceIte] rw [hworkIdle, take_idle_eq houtne] | b :: y => have hread : c.input.read = Γ.ofBool b := hsuf.read_cons @@ -292,7 +292,7 @@ private theorem takeLenTM_copy_loop : have hstep : takeLenTM.step c = some c1 := by cases b <;> · simp only [TM.step, hstate, takeLenTM, hwread, hread, hc1, Γ.ofBool, - reduceCtorEq, if_false, reduceIte] + reduceCtorEq, ite_false, reduceIte] rw [hworkR] rfl obtain ⟨c', t, ht, hreach, hhalt, hfin⟩ := @@ -326,14 +326,14 @@ private theorem takeLenTM_rew_loop : have hwread : (c.work 0).read = Γ.start := by rw [Tape.read, hcells, hhead]; rfl have hinp_eq : c.input.move (idleDir c.input.read) = c.input := by - rw [idleDir, if_neg hinp, Tape.move] + rw [idleDir, ite_eq_right hinp, Tape.move] have hwork : (fun i => (c.work i).writeAndMove (readBackWrite ((c.work i).read)).toΓ Dir3.right) = fun i => (c.work i).move Dir3.right := by funext i have hi : i = 0 := Subsingleton.elim i 0 subst hi show ((c.work 0).write _).move Dir3.right = (c.work 0).move Dir3.right - rw [Tape.write, if_pos hhead] + rw [Tape.write, ite_eq_left hhead] refine ⟨{ state := TakePhase.copy input := c.input work := fun i => (c.work i).move Dir3.right @@ -341,14 +341,14 @@ private theorem takeLenTM_rew_loop : by simp [Tape.move, hhead], rfl, rfl⟩ refine .step ?_ .zero simp only [TM.step, hstate, takeLenTM, hwread, hinp_eq, reduceIte, reduceCtorEq, - if_false] + ite_false] rw [hwork, take_idle_eq hout] | succ h ih => intro m c hstate hcells hhead hinp hout have hwne : (c.work 0).read ≠ Γ.start := by rw [Tape.read, hcells, hhead]; exact regCells_ne_start (by omega) have hinp_eq : c.input.move (idleDir c.input.read) = c.input := by - rw [idleDir, if_neg hinp, Tape.move] + rw [idleDir, ite_eq_right hinp, Tape.move] set c1 : Cfg 1 takeLenTM.Q := { state := TakePhase.rew input := c.input @@ -359,11 +359,11 @@ private theorem takeLenTM_rew_loop : funext i have hi : i = 0 := Subsingleton.elim i 0 subst hi - rw [moveLeftDir, if_neg hwne] + rw [moveLeftDir, ite_eq_right hwne] exact writeAndMove_readBack _ hwne _ have hstep : takeLenTM.step c = some c1 := by - simp only [TM.step, hstate, takeLenTM, hinp_eq, hc1, if_neg hwne, reduceCtorEq, - if_false] + simp only [TM.step, hstate, takeLenTM, hinp_eq, hc1, ite_eq_right hwne, reduceCtorEq, + ite_false] rw [hwork, take_idle_eq hout] obtain ⟨c', hreach, hst, hcl, hhd, hin, hou⟩ := ih m c1 rfl (by rw [hc1]; simpa [Tape.move_cells] using hcells) @@ -401,13 +401,13 @@ private theorem takeLenTM_scan_loop : exact take_idle_eq hwne have hread : c.input.read = Γ.blank := hsuf.read_nil have hidleB : ∀ t : Tape, t.move (idleDir Γ.blank) = t := by - intro t; rw [idleDir, if_neg (by decide)]; rfl + intro t; rw [idleDir, ite_eq_right (by decide)]; rfl refine ⟨{ state := TakePhase.done input := c.input work := c.work output := c.output }, 1, by omega, ?_, rfl, by simpa using hpre⟩ refine .step ?_ .zero - simp only [TM.step, hstate, takeLenTM, hread, hidleB, reduceCtorEq, if_false] + simp only [TM.step, hstate, takeLenTM, hread, hidleB, reduceCtorEq, ite_false] rw [hwork, take_idle_eq houtne] | succ N ih => intro w k hN c hstate hcells hhead hsuf hpre @@ -421,9 +421,9 @@ private theorem takeLenTM_scan_loop : subst hi exact take_idle_eq hwne have hidleB : ∀ t : Tape, t.move (idleDir Γ.blank) = t := by - intro t; rw [idleDir, if_neg (by decide)]; rfl + intro t; rw [idleDir, ite_eq_right (by decide)]; rfl have hidleZ : ∀ t : Tape, t.move (idleDir Γ.zero) = t := by - intro t; rw [idleDir, if_neg (by decide)]; rfl + intro t; rw [idleDir, ite_eq_right (by decide)]; rfl have hstepA : ∀ b : Bool, c.input.read = Γ.ofBool b → takeLenTM.step c = some @@ -433,8 +433,8 @@ private theorem takeLenTM_scan_loop : output := c.output } := by intro b hread cases b <;> - · simp only [TM.step, hstate, takeLenTM, hread, Γ.ofBool, reduceCtorEq, if_false, - cond_true, cond_false] + · simp only [TM.step, hstate, takeLenTM, hread, Γ.ofBool, reduceCtorEq, ite_false, + Bool.cond_true, Bool.cond_false] rw [hwork, take_idle_eq houtne] match w with | [] => @@ -444,7 +444,7 @@ private theorem takeLenTM_scan_loop : work := c.work output := c.output }, 1, by omega, ?_, rfl, by simpa using hpre⟩ refine .step ?_ .zero - simp only [TM.step, hstate, takeLenTM, hread, hidleB, reduceCtorEq, if_false] + simp only [TM.step, hstate, takeLenTM, hread, hidleB, reduceCtorEq, ite_false] rw [hwork, take_idle_eq houtne] | [b] => have hsuf1 : (c.input.move Dir3.right).HasBinarySuffix [] := hsuf.move_right_cons @@ -456,8 +456,8 @@ private theorem takeLenTM_scan_loop : simpa [takeLenAux_singleton] using hpre⟩ refine .step (hstepA b hsuf.read_cons) (.step ?_ .zero) cases b <;> - · simp only [TM.step, takeLenTM, hread1, hidleB, reduceCtorEq, if_false, - cond_true, cond_false] + · simp only [TM.step, takeLenTM, hread1, hidleB, reduceCtorEq, ite_false, + Bool.cond_true, Bool.cond_false] rw [hwork, take_idle_eq houtne] | true :: false :: z => have hsuf1 : (c.input.move Dir3.right).HasBinarySuffix (false :: z) := @@ -469,7 +469,7 @@ private theorem takeLenTM_scan_loop : output := c.output }, 2, by omega, ?_, rfl, by simpa [takeLenAux_broken] using hpre⟩ refine .step (hstepA true hsuf.read_cons) (.step ?_ .zero) - simp only [TM.step, takeLenTM, hread1, hidleZ, reduceCtorEq, if_false, cond_true] + simp only [TM.step, takeLenTM, hread1, hidleZ, reduceCtorEq, ite_false, Bool.cond_true] rw [hwork, take_idle_eq houtne] | false :: true :: z => have hsuf1 : (c.input.move Dir3.right).HasBinarySuffix (true :: z) := @@ -487,7 +487,7 @@ private theorem takeLenTM_scan_loop : work := c.work output := c.output } with hc2 have hstep2 : takeLenTM.step c1 = some c2 := by - simp only [TM.step, hc1, hc2, takeLenTM, hread1, reduceCtorEq, if_false] + simp only [TM.step, hc1, hc2, takeLenTM, hread1, reduceCtorEq, ite_false] rw [hwork, take_idle_eq houtne] have hsuf2 : c2.input.HasBinarySuffix z := hsuf1.move_right_cons obtain ⟨c3, hreach3, hst3, hcl3, hhd3, hin3, hou3⟩ := @@ -520,12 +520,12 @@ private theorem takeLenTM_scan_loop : have hwmark : (fun i => (c.work i).writeAndMove (Γw.one).toΓ Dir3.right) = fun i => ((c.work i).write Γ.one).move Dir3.right := rfl have hstep2 : takeLenTM.step c1 = some c2 := by - simp only [TM.step, hc1, hc2, takeLenTM, hread1, reduceCtorEq, if_false] + simp only [TM.step, hc1, hc2, takeLenTM, hread1, reduceCtorEq, ite_false] rw [hwmark, take_idle_eq houtne] have hcells2 : (c2.work 0).cells = regCells (k + 1) := by rw [hc2] show (((c.work 0).write Γ.one).move Dir3.right).cells = _ - rw [Tape.move_cells, Tape.write, if_neg (by rw [hhead]; omega)] + rw [Tape.move_cells, Tape.write, ite_eq_right (by rw [hhead]; omega)] show Function.update (c.work 0).cells ((c.work 0).head) Γ.one = _ rw [hcells, hhead, regCells_update_succ] have hhead2 : (c2.work 0).head = k + 1 + 1 := by @@ -555,12 +555,12 @@ private theorem takeLenTM_scan_loop : have hwmark : (fun i => (c.work i).writeAndMove (Γw.one).toΓ Dir3.right) = fun i => ((c.work i).write Γ.one).move Dir3.right := rfl have hstep2 : takeLenTM.step c1 = some c2 := by - simp only [TM.step, hc1, hc2, takeLenTM, hread1, reduceCtorEq, if_false] + simp only [TM.step, hc1, hc2, takeLenTM, hread1, reduceCtorEq, ite_false] rw [hwmark, take_idle_eq houtne] have hcells2 : (c2.work 0).cells = regCells (k + 1) := by rw [hc2] show (((c.work 0).write Γ.one).move Dir3.right).cells = _ - rw [Tape.move_cells, Tape.write, if_neg (by rw [hhead]; omega)] + rw [Tape.move_cells, Tape.write, ite_eq_right (by rw [hhead]; omega)] show Function.update (c.work 0).cells ((c.work 0).head) Γ.one = _ rw [hcells, hhead, regCells_update_succ] have hhead2 : (c2.work 0).head = k + 1 + 1 := by diff --git a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/Vec.lean b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/Vec.lean index f991e26346..01479acce8 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/Vec.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/Vec.lean @@ -31,7 +31,7 @@ namespace Cobham /-! ## Foundational FP building blocks -/ -/-- The fixedValue empty-output function is in `FP` (the empty-support case of +/-- The constant empty-output function is in `FP` (the empty-support case of `ite_mem_finset_mem_FP`). -/ theorem const_nil_mem_FP : (fun _ : List Bool => ([] : List Bool)) ∈ FP := by have h := ite_mem_finset_mem_FP (fun _ => []) (∅ : Finset (List Bool)) @@ -40,7 +40,7 @@ theorem const_nil_mem_FP : (fun _ : List Bool => ([] : List Bool)) ∈ FP := by /-- The framing map `x ↦ pair [] x` (i.e. `false :: true :: x`) is polynomial-time. This is the foundational map behind the arity-one encoding `encodeVec ![x] = pair [] x`, and it is exactly `mem_FP_pairWithInput` applied to -the fixedValue empty function. -/ +the constant empty function. -/ theorem pairLeftNil_mem_FP : (fun x : List Bool => pair [] x) ∈ FP := by have h := mem_FP_pairWithInput const_nil_mem_FP simpa using h diff --git a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Vec.lean b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Vec.lean index e49a11d4c0..7657eff1af 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Vec.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Vec.lean @@ -18,7 +18,7 @@ multi-arity. This module gives the public, auditable bridge: `encodeVec` packs a fixed-arity argument vector into one string, `vectorLength` measures its unencoded size, and `FPn` asks a unary `FP` function to agree on the encoded vectors. -The nested pairing has an arity-dependent fixedValue overhead. It is injective, and +The nested pairing has an arity-dependent constant overhead. It is injective, and for every fixed arity its encoded length is linear in `vectorLength`. ## Main definitions and results diff --git a/LeanPool/BeyondBethe/Complexitylib/Classes/P/FinsetDomain.lean b/LeanPool/BeyondBethe/Complexitylib/Classes/P/FinsetDomain.lean index b59dfc910a..f9c7ebb4aa 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Classes/P/FinsetDomain.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Classes/P/FinsetDomain.lean @@ -10,7 +10,7 @@ public import LeanPool.BeyondBethe.Complexitylib.Classes.P.FinsetDomain.Internal /-! # Finite-deviation functions are polynomial-time -A function that agrees with the fixedValue empty-output function on all but +A function that agrees with the constant empty-output function on all but finitely many inputs is polynomial-time computable. Concretely, for any target function `g` and finite set `S`, the function `fun s => if s ∈ S then g s else []` belongs to `FP`: the finite lookup table can be hard-wired into the states of a @@ -30,7 +30,7 @@ public section namespace Complexity -/-- A function that agrees with the fixedValue empty-output function except on a +/-- A function that agrees with the constant empty-output function except on a finite set `S` — that is, `fun s => if s ∈ S then g s else []` — is computable in polynomial (indeed linear) time. The finite table of exceptional values is hard-wired into the lookup machine's states. -/ diff --git a/LeanPool/BeyondBethe/Complexitylib/Classes/P/FinsetDomain/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Classes/P/FinsetDomain/Internal.lean index 5812eb727c..de2ae031cd 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Classes/P/FinsetDomain/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Classes/P/FinsetDomain/Internal.lean @@ -19,7 +19,7 @@ public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinator Construction and correctness of a deterministic Turing machine computing a function of the form `fun s => if s ∈ S then g s else []`, where `S` is a finite set of "inputs of interest" and `g` an arbitrary target function. Such a -function differs from the fixedValue empty-output function on only finitely many +function differs from the constant empty-output function on only finitely many inputs, so it can be computed by a table lookup that runs in linear time. The machine has no work tapes. It works in two phases: @@ -251,7 +251,7 @@ private theorem lookup_read_bit_step (p : List Bool) (b : Bool) · have hp' : p ++ [b] ∉ S.prefixes := fun h => hp (Finset.mem_prefixes_of_prefix (List.prefix_append p [b]) h) cases b <;> - simp [TM.step, lookupTM, hstate, hread, readState, haltState, dif_neg hp, dif_neg hp', + simp [TM.step, lookupTM, hstate, hread, readState, haltState, dite_eq_right hp, dite_eq_right hp', Γ.ofBool] /-- Writing back the (blank) symbol under an idle output head keeps the output @@ -333,7 +333,7 @@ private theorem lookup_initial_step (x : List Bool) : by_cases h : ([] : List Bool) ∈ S.prefixes · simp only [TM.step, hc0, lookupTM, readState, dif_pos h] exact congrArg some (Cfg.ext rfl rfl (Subsingleton.elim _ _) rfl) - · simp only [TM.step, hc0, lookupTM, readState, dif_neg h] + · simp only [TM.step, hc0, lookupTM, readState, dite_eq_right h] exact congrArg some (Cfg.ext rfl rfl (Subsingleton.elim _ _) rfl) refine ⟨c0, hstep, rfl, ?_, ?_, ?_⟩ · rw [hc0]; simp [Tape.move_cells] @@ -362,8 +362,8 @@ private theorem lookup_handoff_step (inp : List Bool) (c : Cfg 0 (lookupTM g S). by_cases hp : inp ∈ S.prefixes · simp [TM.step, lookupTM, hstate, hread, readState, writeState, haltState, dif_pos hp, hc1] · have hpS : inp ∉ S := fun h => hp (Finset.mem_prefixes_self h) - simp [TM.step, lookupTM, hstate, hread, readState, writeState, haltState, dif_neg hp, - if_neg hpS, hc1] + simp [TM.step, lookupTM, hstate, hread, readState, writeState, haltState, dite_eq_right hp, + ite_eq_right hpS, hc1] refine ⟨c1, hstep, by rw [hc1], ?_⟩ rw [hc1] exact hasBinaryPrefix_idle houtput diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine.lean index dbee340369..94db373304 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine.lean @@ -313,7 +313,7 @@ namespace RAM The two-instruction program `⟨imm 0 1⟩` overwrites the verdict register with `1` and then halts (its program counter runs off the end). It decides the universal -language in fixedValue logarithmic time, exercising the full `DecidesInTime` API +language in constant logarithmic time, exercising the full `DecidesInTime` API end to end. -/ /-- The always-accept program: set the verdict register to `1`. -/ @@ -324,7 +324,7 @@ theorem acceptProg_run (x : List Bool) : (run acceptProg 1 (initCfg x)).verdict = 1 := by rfl -/-- `acceptProg` decides the universal language in fixedValue logarithmic time. -/ +/-- `acceptProg` decides the universal language in constant logarithmic time. -/ theorem acceptProg_decides : acceptProg.DecidesInTime Set.univ (fun _ => 2) := by intro x refine ⟨1, ?_, ?_, ?_, ?_⟩ @@ -333,7 +333,7 @@ theorem acceptProg_decides : acceptProg.DecidesInTime Set.univ (fun _ => 2) := b · intro _; rfl · intro hx; exact absurd (Set.mem_univ x) hx -/-- The universal language is in `RAM.DTIME` at a fixedValue bound: a witness that +/-- The universal language is in `RAM.DTIME` at a constant bound: a witness that the RAM time classes are inhabited over the shared `Language` interface. -/ theorem univ_mem_DTIME : Set.univ ∈ DTIME (fun _ => 2) := ⟨acceptProg, (fun _ => 2), acceptProg_decides, BigO.refl _⟩ @@ -345,7 +345,7 @@ def rejectProg : Program := [Instr.imm 0 0] theorem rejectProg_run (x : List Bool) : (run rejectProg 1 (initCfg x)).verdict = 0 := by rfl -/-- `rejectProg` decides the empty language in fixedValue logarithmic time, +/-- `rejectProg` decides the empty language in constant logarithmic time, exercising the rejection side of the `DecidesInTime` API. -/ theorem rejectProg_decides : rejectProg.DecidesInTime (∅ : Language) (fun _ => 2) := by intro x @@ -355,7 +355,7 @@ theorem rejectProg_decides : rejectProg.DecidesInTime (∅ : Language) (fun _ => · intro hx; simp at hx · intro _; rfl -/-- The empty language is in `RAM.DTIME` at a fixedValue bound (the rejection +/-- The empty language is in `RAM.DTIME` at a constant bound (the rejection counterpart of `univ_mem_DTIME`). -/ theorem empty_mem_DTIME : (∅ : Language) ∈ DTIME (fun _ => 2) := ⟨rejectProg, (fun _ => 2), rejectProg_decides, BigO.refl _⟩ diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Defs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Defs.lean index 75ab336df2..2f67a89d8c 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Defs.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Defs.lean @@ -70,7 +70,7 @@ two-way simulation bounds are recorded in the surface module instruction (`d`, `s`, `t`, `a`) are program constants, bounded by the program size, so the cost does not separately charge for them; runtime addresses (`R a` in `load`/`store`) *are* charged via `bitlen (c.regs a)`. This keeps the - cost within a fixedValue factor of the Cook–Reckhow measure while remaining + cost within a constant factor of the Cook–Reckhow measure while remaining sound: every value read, computed, or written is charged its bit-length. - **Out-of-range `pc` halts**: `curInstr` reads `Instr.halt` when `pc` is past the program, so a program need not end in `halt` and jumps may target the end. @@ -89,7 +89,7 @@ namespace RAM accessed register index is itself the content of a register — which is what makes the machine "random access". -/ inductive Instr where - /-- `imm d v`: set `R d := v` (load an immediate fixedValue). -/ + /-- `imm d v`: set `R d := v` (load an immediate constant). -/ | imm (d v : ℕ) /-- `add d s t`: set `R d := R s + R t`. -/ | add (d s t : ℕ) diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Internal.lean index 6ffa470874..2353c2b3db 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Internal.lean @@ -71,21 +71,21 @@ theorem step_halted {c : Cfg} (h : Halted P c) : step P c = c := by theorem run_halted {c : Cfg} (h : Halted P c) (fuel : ℕ) : run P fuel c = c := by cases fuel with | zero => rfl - | succ f => rw [run_succ, if_pos h] + | succ f => rw [run_succ, ite_eq_left h] /-- A halted configuration accumulates no logarithmic time. -/ theorem logTimeUpto_halted {c : Cfg} (h : Halted P c) (fuel : ℕ) : logTimeUpto P fuel c = 0 := by cases fuel with | zero => rfl - | succ f => rw [logTimeUpto_succ, if_pos h] + | succ f => rw [logTimeUpto_succ, ite_eq_left h] /-- A halted configuration accumulates no unit time. -/ theorem unitTimeUpto_halted {c : Cfg} (h : Halted P c) (fuel : ℕ) : unitTimeUpto P fuel c = 0 := by cases fuel with | zero => rfl - | succ f => rw [unitTimeUpto_succ, if_pos h] + | succ f => rw [unitTimeUpto_succ, ite_eq_left h] /-! ### Run/cost algebra -/ @@ -93,8 +93,8 @@ theorem unitTimeUpto_halted {c : Cfg} (h : Halted P c) (fuel : ℕ) : theorem run_one (c : Cfg) : run P 1 c = step P c := by rw [show (1 : ℕ) = 0 + 1 from rfl, run_succ] by_cases h : Halted P c - · rw [if_pos h, step_halted P h] - · rw [if_neg h, run_zero] + · rw [ite_eq_left h, step_halted P h] + · rw [ite_eq_right h, run_zero] /-- The run decomposes additively: `a + b` steps is `b` steps after `a` steps. -/ theorem run_add (a b : ℕ) (c : Cfg) : run P (a + b) c = run P b (run P a c) := by @@ -103,9 +103,9 @@ theorem run_add (a b : ℕ) (c : Cfg) : run P (a + b) c = run P b (run P a c) := | succ a ih => rw [Nat.succ_add, run_succ, run_succ] by_cases h : Halted P c - · rw [if_pos h, if_pos h] + · rw [ite_eq_left h, ite_eq_left h] exact (run_halted P h b).symm - · rw [if_neg h, if_neg h] + · rw [ite_eq_right h, ite_eq_right h] exact ih (step P c) /-- Running `n + 1` steps is one step after running `n` steps. -/ @@ -121,8 +121,8 @@ theorem logTimeUpto_add (a b : ℕ) (c : Cfg) : | succ a ih => rw [Nat.succ_add, logTimeUpto_succ, logTimeUpto_succ, run_succ] by_cases h : Halted P c - · rw [if_pos h, if_pos h, if_pos h, logTimeUpto_halted P h b] - · rw [if_neg h, if_neg h, if_neg h, ih (step P c)] + · rw [ite_eq_left h, ite_eq_left h, ite_eq_left h, logTimeUpto_halted P h b] + · rw [ite_eq_right h, ite_eq_right h, ite_eq_right h, ih (step P c)] ring /-- Unit time decomposes additively along the run. -/ @@ -134,8 +134,8 @@ theorem unitTimeUpto_add (a b : ℕ) (c : Cfg) : | succ a ih => rw [Nat.succ_add, unitTimeUpto_succ, unitTimeUpto_succ, run_succ] by_cases h : Halted P c - · rw [if_pos h, if_pos h, if_pos h, unitTimeUpto_halted P h b] - · rw [if_neg h, if_neg h, if_neg h, ih (step P c)] + · rw [ite_eq_left h, ite_eq_left h, ite_eq_left h, unitTimeUpto_halted P h b] + · rw [ite_eq_right h, ite_eq_right h, ite_eq_right h, ih (step P c)] ring /-- Once halted after `f` steps, extra fuel does not change the configuration. -/ @@ -185,8 +185,8 @@ theorem unitTimeUpto_le_logTimeUpto (fuel : ℕ) (c : Cfg) : | succ f ih => rw [unitTimeUpto_succ, logTimeUpto_succ] by_cases h : Halted P c - · rw [if_pos h, if_pos h] - · rw [if_neg h, if_neg h] + · rw [ite_eq_left h, ite_eq_left h] + · rw [ite_eq_right h, ite_eq_right h] have h1 : 1 ≤ stepLogCost P c := one_le_stepLogCost P c have h2 := ih (step P c) omega @@ -199,12 +199,12 @@ theorem unitTimeUpto_eq_of_not_halted (c : Cfg) (fuel : ℕ) | zero => simp | succ f ih => have h0 : ¬ Halted P c := h 0 (Nat.succ_pos f) - rw [unitTimeUpto_succ, if_neg h0] + rw [unitTimeUpto_succ, ite_eq_right h0] have hrec : unitTimeUpto P f (step P c) = f := by apply ih intro j hj have hstep : run P j (step P c) = run P (j + 1) c := by - rw [run_succ, if_neg h0] + rw [run_succ, ite_eq_right h0] rw [hstep] exact h (j + 1) (by omega) rw [hrec] @@ -235,7 +235,7 @@ theorem initRegs_finiteSupport (x : List Bool) : rw [not_lt] at hlt apply hi have hi0 : i ≠ 0 := by omega - simp only [initRegs, hi0, if_false, List.getElem?_eq_none (show x.length ≤ i - 1 by omega)] + simp only [initRegs, hi0, ite_false, List.getElem?_eq_none (show x.length ≤ i - 1 by omega)] /-- One instruction preserves finite support of the register file: each instruction writes at most one register. -/ diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/DenseOverlay/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/DenseOverlay/Internal.lean index aadb063b47..8c05081354 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/DenseOverlay/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/DenseOverlay/Internal.lean @@ -185,8 +185,8 @@ theorem Snapshot.decode_run_internal (program : Program) (input : List Bool) unfold Snapshot.Halted RAM.Halted Snapshot.curInstr RAM.curInstr rfl by_cases hhalt : snapshot.Halted program - · rw [if_pos hhalt, if_pos (hhalted.mp hhalt)] - · rw [if_neg hhalt, if_neg (fun h => hhalt (hhalted.mpr h))] + · rw [ite_eq_left hhalt, ite_eq_left (hhalted.mp hhalt)] + · rw [ite_eq_right hhalt, ite_eq_right (fun h => hhalt (hhalted.mpr h))] rw [ih (snapshot.step program input) (Snapshot.step_canonical_internal program input snapshot hcanonical)] rw [Snapshot.decode_step_internal program input snapshot hcanonical] @@ -237,7 +237,7 @@ theorem write_length_le_internal (overlay : Store) (address value : ℕ) : · have ih' : (RegisterStore.write rest address (value + 1)).length ≤ rest.length + 1 := by simpa only [write] using ih - simp only [write, RegisterStore.write, haddress, if_false, + simp only [write, RegisterStore.write, haddress, ite_false, List.length_cons] omega @@ -277,9 +277,9 @@ theorem Snapshot.length_run_le_internal (program : Program) have hhalted : snapshot.Halted program ↔ RAM.Halted program (snapshot.decode input) := Iff.rfl by_cases hhalt : snapshot.Halted program - · rw [if_pos hhalt, if_pos (hhalted.mp hhalt)] + · rw [ite_eq_left hhalt, ite_eq_left (hhalted.mp hhalt)] omega - · rw [if_neg hhalt, if_neg (fun h => hhalt (hhalted.mpr h))] + · rw [ite_eq_right hhalt, ite_eq_right (fun h => hhalt (hhalted.mpr h))] have hstep := Snapshot.length_stepInstr_le_internal input (snapshot.curInstr program) snapshot have hstep' : (snapshot.step program input).overlay.length ≤ @@ -427,9 +427,9 @@ theorem Snapshot.encodedStoreLength_run_le_internal (program : Program) simp · have hramNotHalted : ¬RAM.Halted program (snapshot.decode input) := fun h => hhalt (hhalted.mpr h) - rw [if_neg hhalt] + rw [ite_eq_right hhalt] simp only [RAM.unitTimeUpto, RAM.logTimeUpto, hramNotHalted, - if_false] + ite_false] have hstep := Snapshot.encodedStoreLength_step_le_internal program input snapshot have hnextCanonical := Snapshot.step_canonical_internal diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Internal.lean index e051606809..a43eaad0f3 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Internal.lean @@ -224,7 +224,7 @@ private theorem initRegs_ne_zero_address_lt (input : List Bool) (address : ℕ) rw [not_lt] at hlt have haddress : address ≠ 0 := by omega apply hvalue - simp only [initRegs, haddress, if_false] + simp only [initRegs, haddress, ite_false] rw [List.getElem?_eq_none (show input.length ≤ address - 1 by omega)] private theorem initRegs_le_length_add_one (input : List Bool) (address : ℕ) : @@ -405,9 +405,9 @@ theorem Snapshot.run_canonical_internal (program : Program) (fuel : ℕ) | succ fuel ih => rw [Snapshot.run] by_cases hhalt : snapshot.Halted program - · rw [if_pos hhalt] + · rw [ite_eq_left hhalt] exact hcanonical - · rw [if_neg hhalt] + · rw [ite_eq_right hhalt] exact ih (snapshot.step program) (Snapshot.step_canonical_internal program snapshot hcanonical) @@ -419,10 +419,10 @@ theorem Snapshot.decode_run_internal (program : Program) (fuel : ℕ) | succ fuel ih => rw [Snapshot.run, RAM.run] by_cases hhalt : snapshot.Halted program - · rw [if_pos hhalt, - if_pos ((Snapshot.halted_decode_iff_internal program snapshot).mpr hhalt)] - · rw [if_neg hhalt, - if_neg (mt (Snapshot.halted_decode_iff_internal program snapshot).mp hhalt)] + · rw [ite_eq_left hhalt, + ite_eq_left ((Snapshot.halted_decode_iff_internal program snapshot).mpr hhalt)] + · rw [ite_eq_right hhalt, + ite_eq_right (mt (Snapshot.halted_decode_iff_internal program snapshot).mp hhalt)] rw [ih (snapshot.step program) (Snapshot.step_canonical_internal program snapshot hcanonical)] rw [Snapshot.decode_step_internal program snapshot hcanonical] @@ -624,11 +624,11 @@ theorem Snapshot.length_run_le_internal (program : Program) (fuel : ℕ) | succ fuel ih => rw [Snapshot.run, RAM.unitTimeUpto] by_cases hhalt : snapshot.Halted program - · rw [if_pos hhalt, - if_pos ((Snapshot.halted_decode_iff_internal program snapshot).mpr hhalt)] + · rw [ite_eq_left hhalt, + ite_eq_left ((Snapshot.halted_decode_iff_internal program snapshot).mpr hhalt)] omega - · rw [if_neg hhalt, - if_neg (mt (Snapshot.halted_decode_iff_internal program snapshot).mp hhalt)] + · rw [ite_eq_right hhalt, + ite_eq_right (mt (Snapshot.halted_decode_iff_internal program snapshot).mp hhalt)] have hstep := Snapshot.length_stepInstr_le_internal (snapshot.curInstr program) snapshot have hstep' : (snapshot.step program).store.length ≤ @@ -651,13 +651,13 @@ theorem Snapshot.width_run_le_internal (program : Program) (fuel : ℕ) | succ fuel ih => rw [Snapshot.run, RAM.unitTimeUpto, RAM.logTimeUpto] by_cases hhalt : snapshot.Halted program - · rw [if_pos hhalt, - if_pos ((Snapshot.halted_decode_iff_internal program snapshot).mpr hhalt), - if_pos ((Snapshot.halted_decode_iff_internal program snapshot).mpr hhalt)] + · rw [ite_eq_left hhalt, + ite_eq_left ((Snapshot.halted_decode_iff_internal program snapshot).mpr hhalt), + ite_eq_left ((Snapshot.halted_decode_iff_internal program snapshot).mpr hhalt)] omega - · rw [if_neg hhalt, - if_neg (mt (Snapshot.halted_decode_iff_internal program snapshot).mp hhalt), - if_neg (mt (Snapshot.halted_decode_iff_internal program snapshot).mp hhalt)] + · rw [ite_eq_right hhalt, + ite_eq_right (mt (Snapshot.halted_decode_iff_internal program snapshot).mp hhalt), + ite_eq_right (mt (Snapshot.halted_decode_iff_internal program snapshot).mp hhalt)] have hstepCanonical := Snapshot.step_canonical_internal program snapshot hcanonical have hrun := ih (snapshot.step program) hstepCanonical @@ -862,9 +862,9 @@ theorem Snapshot.encodedStoreLength_run_le_internal (program : Program) simp · have hramNotHalted : ¬RAM.Halted program snapshot.decode := mt (Snapshot.halted_decode_iff_internal program snapshot).mp hhalt - rw [if_neg hhalt] + rw [ite_eq_right hhalt] simp only [RAM.unitTimeUpto, RAM.logTimeUpto, hramNotHalted, - if_false] + ite_false] have hstep := encodedStoreLength_step_le program snapshot have hnextCanonical := Snapshot.step_canonical_internal program snapshot hcanonical diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/DenseInputLookup/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/DenseInputLookup/Internal.lean index 5f23837249..72979e8ae0 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/DenseInputLookup/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/DenseInputLookup/Internal.lean @@ -114,7 +114,7 @@ theorem capturePreviousInputBitTM_reachesIn_frame_internal {n : ℕ} simp [denseInputBitTape, TM.resetBinaryBlank, Tape.writeAndMove, Tape.write, Tape.move, TM.idleDir, Tape.read, Tape.init, Γ.ofBool] - · simp only [finalWork, Function.update_of_ne hi, hi, if_false] + · simp only [finalWork, Function.update_of_ne hi, hi, ite_false] exact (hwork i).writeAndMove_readBack_idle · exact houtput.writeAndMove_readBack_idle exact ⟨c₂, .step hstep₁ (.step hstep₂ .zero), rfl, rfl, rfl, rfl⟩ @@ -281,16 +281,16 @@ private theorem denseInputStepResult_eq (input : List Bool) (denseInputResultTape input address processed) = denseInputResultTape input address (processed + 1) := by by_cases hbefore : address ≤ processed - · rw [denseInputStepResult, if_neg (by omega)] + · rw [denseInputStepResult, ite_eq_right (by omega)] unfold denseInputResultTape - rw [if_neg haddress, if_pos hbefore, if_neg haddress, - if_pos (le_trans hbefore (by omega))] + rw [ite_eq_right haddress, ite_eq_left hbefore, ite_eq_right haddress, + ite_eq_left (le_trans hbefore (by omega))] · by_cases hcurrent : address = processed + 1 · subst address have hremaining : processed + 1 - processed = 1 := by omega - rw [denseInputStepResult, if_pos hremaining] + rw [denseInputStepResult, ite_eq_left hremaining] unfold denseInputResultTape - rw [if_neg haddress, if_pos (le_refl (processed + 1))] + rw [ite_eq_right haddress, ite_eq_left (le_refl (processed + 1))] congr 1 have hindex : processed + 1 - 1 = processed := by omega rw [hindex] @@ -298,10 +298,10 @@ private theorem denseInputStepResult_eq (input : List Bool) rfl · have hafter : processed + 1 < address := by omega have hremaining : address - processed ≠ 1 := by omega - rw [denseInputStepResult, if_neg hremaining] + rw [denseInputStepResult, ite_eq_right hremaining] unfold denseInputResultTape - rw [if_neg haddress, if_neg (by omega), if_neg haddress, - if_neg (Nat.not_le_of_lt hafter)] + rw [ite_eq_right haddress, ite_eq_right (by omega), ite_eq_right haddress, + ite_eq_right (Nat.not_le_of_lt hafter)] private def denseInputScanCfg {n : ℕ} (counter result : Fin n) (work₀ : Fin n → Tape) (out₀ : Tape) (input : List Bool) @@ -634,7 +634,7 @@ private theorem denseInputScanTM_body_run {n : ℕ} result = TM.resetBinaryBlank rw [denseInputWork_result] unfold denseInputResultTape - rw [if_neg haddress, if_neg (by omega)]) + rw [ite_eq_right haddress, ite_eq_right (by omega)]) (denseInputWork_parked counter result hne work₀ input address processed hwork) houtput have hdone : done = @@ -729,14 +729,14 @@ private theorem denseInputResultTape_final_hasBinaryNat (Complexity.RAM.initRegs input address) := by by_cases hindex : address ≤ input.length · have hlt : address - 1 < input.length := by omega - rw [denseInputResultTape, if_neg haddress, if_pos hindex] - rw [Complexity.RAM.initRegs, if_neg haddress, + rw [denseInputResultTape, ite_eq_right haddress, ite_eq_left hindex] + rw [Complexity.RAM.initRegs, ite_eq_right haddress, List.getElem?_eq_getElem hlt] simpa using denseInputBitTape_hasBinaryNat_internal (input[address - 1]'hlt) · have hnone : input[address - 1]? = none := List.getElem?_eq_none (by omega) - rw [denseInputResultTape, if_neg haddress, if_neg hindex] + rw [denseInputResultTape, ite_eq_right haddress, ite_eq_right hindex] simpa [Complexity.RAM.initRegs, haddress, hnone, TM.resetBinaryBlank] using Tape.init_move_right_hasBinaryNat 0 @@ -796,7 +796,7 @@ theorem denseInputScanTM_reachesIn_frame_internal {n : ℕ} · subst i rw [denseInputWork_result, hresult] unfold denseInputResultTape - rw [if_neg haddress, if_neg (by omega)] + rw [ite_eq_right haddress, ite_eq_right (by omega)] · rw [denseInputWork_other counter result work₀ input address 0 i hic hir] · rfl @@ -837,7 +837,7 @@ private theorem denseInputStepTime_le_width (address processed : ℕ) : TM.binaryPredTime_le_internal (address - processed - 1) have hwidth : (address - processed).size ≤ address.size := Nat.size_le_size (Nat.sub_le address processed) - rw [denseInputStepTime, if_neg hzero, if_neg hone] + rw [denseInputStepTime, ite_eq_right hzero, ite_eq_right hone] have hsucc : address - processed - 1 + 1 = address - processed := by omega rw [hsucc] at hpred diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryCleanup/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryCleanup/Internal.lean index 5ad3ed7c55..b9195b616a 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryCleanup/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryCleanup/Internal.lean @@ -89,7 +89,7 @@ private theorem readable_target_content tapes.ne (show (3 : Fin 9) ≠ 1 by decide) have hvalue : tapes.addressCounter ≠ tapes.value := tapes.ne (show (3 : Fin 9) ≠ 2 by decide) - rw [if_neg haddress, if_neg hvalue, if_pos rfl] + rw [ite_eq_right haddress, ite_eq_right hvalue, ite_eq_left rfl] exact hmatch.addressCounter.2 · simpa [entryMissBits, EntryMatchTapes.address, EntryMatchTapes.value, EntryMatchTapes.addressCounter, EntryMatchTapes.addressWidth, @@ -108,8 +108,8 @@ private theorem readable_target_content tapes.ne (show (5 : Fin 9) ≠ 3 by decide) have haddressWidth : tapes.valueCounter ≠ tapes.addressWidth := tapes.ne (show (5 : Fin 9) ≠ 4 by decide) - rw [if_neg haddress, if_neg hvalue, if_neg haddressCounter, - if_neg haddressWidth, if_pos rfl] + rw [ite_eq_right haddress, ite_eq_right hvalue, ite_eq_right haddressCounter, + ite_eq_right haddressWidth, ite_eq_left rfl] exact hmatch.valueCounter.2 · simpa [entryMissBits, EntryMatchTapes.address, EntryMatchTapes.value, EntryMatchTapes.addressCounter, EntryMatchTapes.addressWidth, diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryLookup/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryLookup/Internal.lean index badc4dbfb9..d28598a443 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryLookup/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryLookup/Internal.lean @@ -45,7 +45,7 @@ private theorem read_eq_matched intro heq exact hmiss prior (by simp) (congrArg Nat.bits heq) simp only [List.cons_append, RegisterStore.read] - rw [if_neg (Ne.symm hprior)] + rw [ite_eq_right (Ne.symm hprior)] apply ih intro candidate hcandidate exact hmiss candidate (by simp [hcandidate]) @@ -61,7 +61,7 @@ private theorem read_eq_zero intro heq exact hmiss entry (by simp) (congrArg Nat.bits heq) simp only [RegisterStore.read] - rw [if_neg (Ne.symm hentry)] + rw [ite_eq_right (Ne.symm hentry)] exact ih (fun candidate hcandidate => hmiss candidate (by simp [hcandidate])) diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryMissCopy/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryMissCopy/Internal.lean index 2f65ea111f..6211d45bfa 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryMissCopy/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryMissCopy/Internal.lean @@ -53,13 +53,13 @@ private theorem entryMissCopiedWork_eq funext i by_cases hia : i = tapes.address · subst i - simp only [entryMissCopiedWork, if_pos] + simp only [entryMissCopiedWork, ite_eq_left] exact Tape.ext haddressHead haddressCells · by_cases hiv : i = tapes.value · subst i - simp only [entryMissCopiedWork, hia, if_false, if_pos] + simp only [entryMissCopiedWork, hia, ite_false, ite_eq_left] exact Tape.ext hvalueHead hvalueCells - · simp only [entryMissCopiedWork, hia, hiv, if_false] + · simp only [entryMissCopiedWork, hia, hiv, ite_false] exact hframe i hia hiv private theorem readableEntryMatch_rebase_after_copy diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryReplace/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryReplace/Internal.lean index 9364d83606..d93c5a9588 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryReplace/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryReplace/Internal.lean @@ -102,9 +102,9 @@ private theorem entryReplaceReadyWork_eq funext i by_cases hia : i = tapes.entry.address · subst i - simp only [entryReplaceReadyWork, if_pos] + simp only [entryReplaceReadyWork, ite_eq_left] exact Tape.ext haddressHead haddressCells - · simp only [entryReplaceReadyWork, hia, if_false] + · simp only [entryReplaceReadyWork, hia, ite_false] exact hframe i hia theorem entryReplaceCleanupTM_hoareTime_frame_internal @@ -338,7 +338,7 @@ theorem entryReplaceCleanupTM_hoareTime_frame_internal { head := entry.1.bits.length + 1, cells := (matchedWork tapes.replacement).cells } else matchedWork tapes.replacement) = matchedWork tapes.replacement - rw [if_neg hne] + rw [ite_eq_right hne] exact (hready.frame tapes.replacement (tapes.replacement_ne 0) (tapes.replacement_ne 1) (tapes.replacement_ne 2) (tapes.replacement_ne 3) diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryScan/Internal/Ctrl.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryScan/Internal/Ctrl.lean index 3dff68295b..8dc634a35a 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryScan/Internal/Ctrl.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryScan/Internal/Ctrl.lean @@ -69,10 +69,10 @@ private theorem entryScanTM_body_step some (entryScanBodyWrap tapes next) := by have hne : cfg.state ≠ (entryScanStepTM tapes.entry).qhalt := TM.state_ne_qhalt_of_step hstep - rw [TM.step, if_neg (by + rw [TM.step, ite_eq_right (by simp [entryScanBodyWrap, entryScanTM])] simp only [entryScanBodyWrap, entryScanTM, hne, ↓reduceIte] - rw [TM.step, if_neg hne] at hstep + rw [TM.step, ite_eq_right hne] at hstep revert hstep generalize haction : (entryScanStepTM tapes.entry).δ cfg.state cfg.input.read (fun i => (cfg.work i).read) cfg.output.read = action @@ -90,10 +90,10 @@ private theorem entryScanTM_pred_step some (entryScanPredWrap tapes next) := by have hne : cfg.state ≠ (TM.binaryPredTM tapes.count).qhalt := TM.state_ne_qhalt_of_step hstep - rw [TM.step, if_neg (by + rw [TM.step, ite_eq_right (by simp [entryScanPredWrap, entryScanTM])] simp only [entryScanPredWrap, entryScanTM, hne, ↓reduceIte] - rw [TM.step, if_neg hne] at hstep + rw [TM.step, ite_eq_right hne] at hstep revert hstep generalize haction : (TM.binaryPredTM tapes.count).δ cfg.state cfg.input.read (fun i => (cfg.work i).read) cfg.output.read = action @@ -129,7 +129,7 @@ theorem entryScanTM_step_test_zero_internal (entryScanTM tapes).step { state := .inl .test, input := inp, work := work, output := out } = some { state := .inl .done, input := inp, work := work, output := out } := by - rw [TM.step, if_neg (by simp [entryScanTM])] + rw [TM.step, ite_eq_right (by simp [entryScanTM])] simp only [entryScanTM, hcount, ↓reduceIte] refine congrArg some (Complexity.Cfg.ext rfl ?_ ?_ ?_) · exact hinput.move_idle @@ -147,7 +147,7 @@ theorem entryScanTM_step_test_positive_internal some (entryScanBodyWrap tapes { state := (entryScanStepTM tapes.entry).qstart input := inp, work := work, output := out }) := by - rw [TM.step, if_neg (by simp [entryScanTM])] + rw [TM.step, ite_eq_right (by simp [entryScanTM])] simp only [entryScanTM, hcount, ↓reduceIte, entryScanBodyWrap] refine congrArg some (Complexity.Cfg.ext rfl ?_ ?_ ?_) · exact hinput.move_idle @@ -164,7 +164,7 @@ theorem entryScanTM_step_body_hit_internal (houtput : TM.Parked cfg.output) : (entryScanTM tapes).step (entryScanBodyWrap tapes cfg) = some (entryScanDoneCfg tapes cfg.input cfg.work cfg.output) := by - rw [TM.step, if_neg (by simp [entryScanBodyWrap, entryScanTM])] + rw [TM.step, ite_eq_right (by simp [entryScanBodyWrap, entryScanTM])] simp only [entryScanBodyWrap, entryScanDoneCfg, entryScanTM, hhalt, hresult, ↓reduceIte] refine congrArg some (Complexity.Cfg.ext rfl ?_ ?_ ?_) @@ -184,7 +184,7 @@ theorem entryScanTM_step_body_miss_internal some (entryScanPredWrap tapes { state := (TM.binaryPredTM tapes.count).qstart input := cfg.input, work := cfg.work, output := cfg.output }) := by - rw [TM.step, if_neg (by simp [entryScanBodyWrap, entryScanTM])] + rw [TM.step, ite_eq_right (by simp [entryScanBodyWrap, entryScanTM])] simp only [entryScanBodyWrap, entryScanTM, hhalt, hresult, ↓reduceIte, entryScanPredWrap] refine congrArg some (Complexity.Cfg.ext rfl ?_ ?_ ?_) @@ -201,7 +201,7 @@ theorem entryScanTM_step_pred_halt_internal (houtput : TM.Parked cfg.output) : (entryScanTM tapes).step (entryScanPredWrap tapes cfg) = some (entryScanTestCfg tapes cfg.input cfg.work cfg.output) := by - rw [TM.step, if_neg (by simp [entryScanPredWrap, entryScanTM])] + rw [TM.step, ite_eq_right (by simp [entryScanPredWrap, entryScanTM])] simp only [entryScanPredWrap, entryScanTestCfg, entryScanTM, hhalt, ↓reduceIte] refine congrArg some (Complexity.Cfg.ext rfl ?_ ?_ ?_) diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Ctrl.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Ctrl.lean index 36598a441e..982a00d50a 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Ctrl.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Ctrl.lean @@ -130,9 +130,9 @@ private theorem entryUpdateTM_match_step some (entryUpdateMatchWrap tapes next) := by have hne : cfg.state ≠ (entryMatchReadTM tapes.entry).qhalt := TM.state_ne_qhalt_of_step hstep - rw [TM.step, if_neg (by simp [entryUpdateMatchWrap, entryUpdateTM])] + rw [TM.step, ite_eq_right (by simp [entryUpdateMatchWrap, entryUpdateTM])] simp only [entryUpdateMatchWrap, entryUpdateTM, hne, ↓reduceIte] - rw [TM.step, if_neg hne] at hstep + rw [TM.step, ite_eq_right hne] at hstep revert hstep generalize haction : (entryMatchReadTM tapes.entry).δ cfg.state cfg.input.read (fun i => (cfg.work i).read) cfg.output.read = action @@ -150,9 +150,9 @@ private theorem entryUpdateTM_miss_step some (entryUpdateMissWrap tapes next) := by have hne : cfg.state ≠ (entryMissCopyTM tapes.entry).qhalt := TM.state_ne_qhalt_of_step hstep - rw [TM.step, if_neg (by simp [entryUpdateMissWrap, entryUpdateTM])] + rw [TM.step, ite_eq_right (by simp [entryUpdateMissWrap, entryUpdateTM])] simp only [entryUpdateMissWrap, entryUpdateTM, hne, ↓reduceIte] - rw [TM.step, if_neg hne] at hstep + rw [TM.step, ite_eq_right hne] at hstep revert hstep generalize haction : (entryMissCopyTM tapes.entry).δ cfg.state cfg.input.read (fun i => (cfg.work i).read) cfg.output.read = action @@ -170,9 +170,9 @@ private theorem entryUpdateTM_delete_step some (entryUpdateDeleteWrap tapes next) := by have hne : cfg.state ≠ (entryMissCleanupTM tapes.entry).qhalt := TM.state_ne_qhalt_of_step hstep - rw [TM.step, if_neg (by simp [entryUpdateDeleteWrap, entryUpdateTM])] + rw [TM.step, ite_eq_right (by simp [entryUpdateDeleteWrap, entryUpdateTM])] simp only [entryUpdateDeleteWrap, entryUpdateTM, hne, ↓reduceIte] - rw [TM.step, if_neg hne] at hstep + rw [TM.step, ite_eq_right hne] at hstep revert hstep generalize haction : (entryMissCleanupTM tapes.entry).δ cfg.state cfg.input.read (fun i => (cfg.work i).read) cfg.output.read = action @@ -190,9 +190,9 @@ private theorem entryUpdateTM_replace_step some (entryUpdateReplaceWrap tapes next) := by have hne : cfg.state ≠ (entryReplaceCleanupTM tapes.replace).qhalt := TM.state_ne_qhalt_of_step hstep - rw [TM.step, if_neg (by simp [entryUpdateReplaceWrap, entryUpdateTM])] + rw [TM.step, ite_eq_right (by simp [entryUpdateReplaceWrap, entryUpdateTM])] simp only [entryUpdateReplaceWrap, entryUpdateTM, hne, ↓reduceIte] - rw [TM.step, if_neg hne] at hstep + rw [TM.step, ite_eq_right hne] at hstep revert hstep generalize haction : (entryReplaceCleanupTM tapes.replace).δ cfg.state cfg.input.read (fun i => (cfg.work i).read) cfg.output.read = action @@ -210,9 +210,9 @@ private theorem entryUpdateTM_append_step some (entryUpdateAppendWrap tapes next) := by have hne : cfg.state ≠ (entryAppendRestoreTM tapes.replace).qhalt := TM.state_ne_qhalt_of_step hstep - rw [TM.step, if_neg (by simp [entryUpdateAppendWrap, entryUpdateTM])] + rw [TM.step, ite_eq_right (by simp [entryUpdateAppendWrap, entryUpdateTM])] simp only [entryUpdateAppendWrap, entryUpdateTM, hne, ↓reduceIte] - rw [TM.step, if_neg hne] at hstep + rw [TM.step, ite_eq_right hne] at hstep revert hstep generalize haction : (entryAppendRestoreTM tapes.replace).δ cfg.state cfg.input.read (fun i => (cfg.work i).read) cfg.output.read = action @@ -230,9 +230,9 @@ private theorem entryUpdateTM_remaining_step some (entryUpdateRemainingWrap tapes next) := by have hne : cfg.state ≠ (TM.binaryPredTM tapes.remaining).qhalt := TM.state_ne_qhalt_of_step hstep - rw [TM.step, if_neg (by simp [entryUpdateRemainingWrap, entryUpdateTM])] + rw [TM.step, ite_eq_right (by simp [entryUpdateRemainingWrap, entryUpdateTM])] simp only [entryUpdateRemainingWrap, entryUpdateTM, hne, ↓reduceIte] - rw [TM.step, if_neg hne] at hstep + rw [TM.step, ite_eq_right hne] at hstep revert hstep generalize haction : (TM.binaryPredTM tapes.remaining).δ cfg.state cfg.input.read (fun i => (cfg.work i).read) cfg.output.read = action @@ -250,9 +250,9 @@ private theorem entryUpdateTM_deleteCount_step some (entryUpdateDeleteCountWrap tapes next) := by have hne : cfg.state ≠ (TM.binaryPredTM tapes.resultCount).qhalt := TM.state_ne_qhalt_of_step hstep - rw [TM.step, if_neg (by simp [entryUpdateDeleteCountWrap, entryUpdateTM])] + rw [TM.step, ite_eq_right (by simp [entryUpdateDeleteCountWrap, entryUpdateTM])] simp only [entryUpdateDeleteCountWrap, entryUpdateTM, hne, ↓reduceIte] - rw [TM.step, if_neg hne] at hstep + rw [TM.step, ite_eq_right hne] at hstep revert hstep generalize haction : (TM.binaryPredTM tapes.resultCount).δ cfg.state cfg.input.read (fun i => (cfg.work i).read) cfg.output.read = action @@ -270,9 +270,9 @@ private theorem entryUpdateTM_appendCount_step some (entryUpdateAppendCountWrap tapes next) := by have hne : cfg.state ≠ (TM.binarySuccTM tapes.resultCount).qhalt := TM.state_ne_qhalt_of_step hstep - rw [TM.step, if_neg (by simp [entryUpdateAppendCountWrap, entryUpdateTM])] + rw [TM.step, ite_eq_right (by simp [entryUpdateAppendCountWrap, entryUpdateTM])] simp only [entryUpdateAppendCountWrap, entryUpdateTM, hne, ↓reduceIte] - rw [TM.step, if_neg hne] at hstep + rw [TM.step, ite_eq_right hne] at hstep revert hstep generalize haction : (TM.binarySuccTM tapes.resultCount).δ cfg.state cfg.input.read (fun i => (cfg.work i).read) cfg.output.read = action @@ -365,7 +365,7 @@ theorem entryUpdateTM_step_test_continue_internal some (entryUpdateMatchWrap tapes { state := (entryMatchReadTM tapes.entry).qstart input := inp, work := work, output := out }) := by - rw [TM.step, if_neg (by simp [entryUpdateTestCfg, entryUpdateTM])] + rw [TM.step, ite_eq_right (by simp [entryUpdateTestCfg, entryUpdateTM])] simp only [entryUpdateTestCfg, entryUpdateTM, hremaining, ↓reduceIte, entryUpdateMatchWrap] refine congrArg some (Complexity.Cfg.ext rfl ?_ ?_ ?_) @@ -382,7 +382,7 @@ theorem entryUpdateTM_step_test_found_internal (houtput : TM.Parked out) : (entryUpdateTM tapes).step (entryUpdateTestCfg tapes inp work out) = some (entryUpdateDoneCfg tapes inp work out) := by - rw [TM.step, if_neg (by simp [entryUpdateTestCfg, entryUpdateTM])] + rw [TM.step, ite_eq_right (by simp [entryUpdateTestCfg, entryUpdateTM])] simp only [entryUpdateTestCfg, entryUpdateDoneCfg, entryUpdateTM, hremaining, hfound, ↓reduceIte] refine congrArg some (Complexity.Cfg.ext rfl ?_ ?_ ?_) @@ -400,7 +400,7 @@ theorem entryUpdateTM_step_test_zero_internal (houtput : TM.Parked out) : (entryUpdateTM tapes).step (entryUpdateTestCfg tapes inp work out) = some (entryUpdateDoneCfg tapes inp work out) := by - rw [TM.step, if_neg (by simp [entryUpdateTestCfg, entryUpdateTM])] + rw [TM.step, ite_eq_right (by simp [entryUpdateTestCfg, entryUpdateTM])] simp only [entryUpdateTestCfg, entryUpdateDoneCfg, entryUpdateTM, hremaining, hfound, hreplacement, ↓reduceIte] refine congrArg some (Complexity.Cfg.ext rfl ?_ ?_ ?_) @@ -420,7 +420,7 @@ theorem entryUpdateTM_step_test_append_internal some (entryUpdateAppendWrap tapes { state := (entryAppendRestoreTM tapes.replace).qstart input := inp, work := work, output := out }) := by - rw [TM.step, if_neg (by simp [entryUpdateTestCfg, entryUpdateTM])] + rw [TM.step, ite_eq_right (by simp [entryUpdateTestCfg, entryUpdateTM])] simp only [entryUpdateTestCfg, entryUpdateTM, hremaining, hfound, hreplacement, ↓reduceIte, entryUpdateAppendWrap] refine congrArg some (Complexity.Cfg.ext rfl ?_ ?_ ?_) @@ -456,7 +456,7 @@ theorem entryUpdateTM_step_match_delete_internal input := cfg.input work := entryUpdateMarkFoundWork tapes cfg.work output := cfg.output }) := by - rw [TM.step, if_neg (by simp [entryUpdateMatchWrap, entryUpdateTM])] + rw [TM.step, ite_eq_right (by simp [entryUpdateMatchWrap, entryUpdateTM])] simp only [entryUpdateMatchWrap, entryUpdateDeleteWrap, entryUpdateTM, hhalt, hresult, hreplacement, ↓reduceIte] refine congrArg some (Complexity.Cfg.ext rfl ?_ ?_ ?_) @@ -470,7 +470,7 @@ theorem entryUpdateTM_step_match_delete_internal by_cases hi : i = tapes.found · subst i simp [entryUpdateMarkFoundWork] - · simp only [hi, if_false, + · simp only [hi, ite_false, entryUpdateMarkFoundWork_apply_ne tapes cfg.work i hi] exact (hwork i).writeAndMove_readBack_idle · exact houtput.writeAndMove_readBack_idle @@ -489,7 +489,7 @@ theorem entryUpdateTM_step_match_replace_internal input := cfg.input work := entryUpdateMarkFoundWork tapes cfg.work output := cfg.output }) := by - rw [TM.step, if_neg (by simp [entryUpdateMatchWrap, entryUpdateTM])] + rw [TM.step, ite_eq_right (by simp [entryUpdateMatchWrap, entryUpdateTM])] simp only [entryUpdateMatchWrap, entryUpdateReplaceWrap, entryUpdateTM, hhalt, hresult, hreplacement, ↓reduceIte] refine congrArg some (Complexity.Cfg.ext rfl ?_ ?_ ?_) @@ -503,7 +503,7 @@ theorem entryUpdateTM_step_match_replace_internal by_cases hi : i = tapes.found · subst i simp [entryUpdateMarkFoundWork] - · simp only [hi, if_false, + · simp only [hi, ite_false, entryUpdateMarkFoundWork_apply_ne tapes cfg.work i hi] exact (hwork i).writeAndMove_readBack_idle · exact houtput.writeAndMove_readBack_idle @@ -519,7 +519,7 @@ theorem entryUpdateTM_step_match_miss_internal some (entryUpdateMissWrap tapes { state := (entryMissCopyTM tapes.entry).qstart input := cfg.input, work := cfg.work, output := cfg.output }) := by - rw [TM.step, if_neg (by simp [entryUpdateMatchWrap, entryUpdateTM])] + rw [TM.step, ite_eq_right (by simp [entryUpdateMatchWrap, entryUpdateTM])] simp only [entryUpdateMatchWrap, entryUpdateMissWrap, entryUpdateTM, hhalt, hresult, ↓reduceIte] refine congrArg some (Complexity.Cfg.ext rfl ?_ ?_ ?_) @@ -538,7 +538,7 @@ theorem entryUpdateTM_step_miss_halt_internal some (entryUpdateRemainingWrap tapes { state := (TM.binaryPredTM tapes.remaining).qstart input := cfg.input, work := cfg.work, output := cfg.output }) := by - rw [TM.step, if_neg (by simp [entryUpdateMissWrap, entryUpdateTM])] + rw [TM.step, ite_eq_right (by simp [entryUpdateMissWrap, entryUpdateTM])] simp only [entryUpdateMissWrap, entryUpdateRemainingWrap, entryUpdateTM, hhalt, ↓reduceIte] refine congrArg some (Complexity.Cfg.ext rfl ?_ ?_ ?_) @@ -557,7 +557,7 @@ theorem entryUpdateTM_step_delete_halt_internal some (entryUpdateDeleteCountWrap tapes { state := (TM.binaryPredTM tapes.resultCount).qstart input := cfg.input, work := cfg.work, output := cfg.output }) := by - rw [TM.step, if_neg (by simp [entryUpdateDeleteWrap, entryUpdateTM])] + rw [TM.step, ite_eq_right (by simp [entryUpdateDeleteWrap, entryUpdateTM])] simp only [entryUpdateDeleteWrap, entryUpdateDeleteCountWrap, entryUpdateTM, hhalt, ↓reduceIte] refine congrArg some (Complexity.Cfg.ext rfl ?_ ?_ ?_) @@ -576,7 +576,7 @@ theorem entryUpdateTM_step_replace_halt_internal some (entryUpdateRemainingWrap tapes { state := (TM.binaryPredTM tapes.remaining).qstart input := cfg.input, work := cfg.work, output := cfg.output }) := by - rw [TM.step, if_neg (by simp [entryUpdateReplaceWrap, entryUpdateTM])] + rw [TM.step, ite_eq_right (by simp [entryUpdateReplaceWrap, entryUpdateTM])] simp only [entryUpdateReplaceWrap, entryUpdateRemainingWrap, entryUpdateTM, hhalt, ↓reduceIte] refine congrArg some (Complexity.Cfg.ext rfl ?_ ?_ ?_) @@ -595,7 +595,7 @@ theorem entryUpdateTM_step_append_halt_internal some (entryUpdateAppendCountWrap tapes { state := (TM.binarySuccTM tapes.resultCount).qstart input := cfg.input, work := cfg.work, output := cfg.output }) := by - rw [TM.step, if_neg (by simp [entryUpdateAppendWrap, entryUpdateTM])] + rw [TM.step, ite_eq_right (by simp [entryUpdateAppendWrap, entryUpdateTM])] simp only [entryUpdateAppendWrap, entryUpdateAppendCountWrap, entryUpdateTM, hhalt, ↓reduceIte] refine congrArg some (Complexity.Cfg.ext rfl ?_ ?_ ?_) @@ -612,7 +612,7 @@ theorem entryUpdateTM_step_remaining_halt_internal (houtput : TM.Parked cfg.output) : (entryUpdateTM tapes).step (entryUpdateRemainingWrap tapes cfg) = some (entryUpdateTestCfg tapes cfg.input cfg.work cfg.output) := by - rw [TM.step, if_neg (by simp [entryUpdateRemainingWrap, entryUpdateTM])] + rw [TM.step, ite_eq_right (by simp [entryUpdateRemainingWrap, entryUpdateTM])] simp only [entryUpdateRemainingWrap, entryUpdateTestCfg, entryUpdateTM, hhalt, ↓reduceIte] refine congrArg some (Complexity.Cfg.ext rfl ?_ ?_ ?_) @@ -631,7 +631,7 @@ theorem entryUpdateTM_step_deleteCount_halt_internal some (entryUpdateRemainingWrap tapes { state := (TM.binaryPredTM tapes.remaining).qstart input := cfg.input, work := cfg.work, output := cfg.output }) := by - rw [TM.step, if_neg (by simp [entryUpdateDeleteCountWrap, entryUpdateTM])] + rw [TM.step, ite_eq_right (by simp [entryUpdateDeleteCountWrap, entryUpdateTM])] simp only [entryUpdateDeleteCountWrap, entryUpdateRemainingWrap, entryUpdateTM, hhalt, ↓reduceIte] refine congrArg some (Complexity.Cfg.ext rfl ?_ ?_ ?_) @@ -648,7 +648,7 @@ theorem entryUpdateTM_step_appendCount_halt_internal (houtput : TM.Parked cfg.output) : (entryUpdateTM tapes).step (entryUpdateAppendCountWrap tapes cfg) = some (entryUpdateDoneCfg tapes cfg.input cfg.work cfg.output) := by - rw [TM.step, if_neg (by simp [entryUpdateAppendCountWrap, entryUpdateTM])] + rw [TM.step, ite_eq_right (by simp [entryUpdateAppendCountWrap, entryUpdateTM])] simp only [entryUpdateAppendCountWrap, entryUpdateDoneCfg, entryUpdateTM, hhalt, ↓reduceIte] refine congrArg some (Complexity.Cfg.ext rfl ?_ ?_ ?_) diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Time.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Time.lean index 48fcdfef90..3d66a80b94 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Time.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Time.lean @@ -149,7 +149,7 @@ private theorem entryMissCopiedWork_target_head · by_cases hvalue : i = tapes.entry.value · subst i simp [entryMissCopiedWork, entryUpdatePostEmitHead, haddress] - · simp only [entryMissCopiedWork, haddress, hvalue, if_false] + · simp only [entryMissCopiedWork, haddress, hvalue, ite_false] exact readable_other_cleanup_target_head tapes entry rest queryBits initialWork matchedWork hmatch i hi haddress hvalue @@ -171,7 +171,7 @@ private theorem entryReplaceReadyWork_target_head hmatch.value.1 · have haddress' : i ≠ tapes.replace.entry.address := by simpa using haddress - rw [entryReplaceReadyWork, if_neg haddress'] + rw [entryReplaceReadyWork, ite_eq_right haddress'] exact readable_other_cleanup_target_head tapes entry rest queryBits initialWork matchedWork hmatch i hi haddress hvalue diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Control.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Control.lean index 035985aad6..fa7b802807 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Control.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Control.lean @@ -478,7 +478,7 @@ theorem zeroJumpInstructionTM_hoareTime_frame_internal change (work tapes.data.lhs).HasBinaryNat value at hoperand simpa only [Function.update_of_ne tapes.lhs_ne_pc] using hoperand · simpa only [targetTape, Function.update_self, newPC, value, - hzero, if_pos] using htarget + hzero, ite_eq_left] using htarget · intro i by_cases hi : i = tapes.pc · subst i @@ -512,7 +512,7 @@ theorem zeroJumpInstructionTM_hoareTime_frame_internal · rw [hframe tapes.data.lhs tapes.lhs_ne_pc] change (work tapes.data.lhs).HasBinaryNat value exact hlookupResult.destination - · simpa only [newPC, value, if_neg hnonzero] using hfinalPC + · simpa only [newPC, value, ite_eq_right hnonzero] using hfinalPC · intro i by_cases hi : i = tapes.pc · subst i diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseControl.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseControl.lean index ee592a585d..07b4d3fc90 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseControl.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseControl.lean @@ -260,7 +260,7 @@ theorem denseZeroJumpInstructionTM_hoareTime_frame refine ⟨work, hlookupResult, ?_, ?_, ?_, ?_⟩ · simpa only [Function.update_of_ne tapes.lhs_ne_pc, value] using hlookupResult.destination - · simpa only [targetTape, Function.update_self, newPC, hzero, if_pos] + · simpa only [targetTape, Function.update_self, newPC, hzero, ite_eq_left] using htarget · intro i by_cases hi : i = tapes.pc @@ -290,7 +290,7 @@ theorem denseZeroJumpInstructionTM_hoareTime_frame refine ⟨work, hlookupResult, ?_, ?_, ?_, hframe⟩ · rw [hframe tapes.data.lhs tapes.lhs_ne_pc] simpa only [value] using hlookupResult.destination - · simpa only [newPC, if_neg hnonzero] using hfinalPC + · simpa only [newPC, ite_eq_right hnonzero] using hfinalPC · intro i by_cases hi : i = tapes.pc · subst i diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Bounds/Defs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Bounds/Defs.lean index 3c99e8dccd..2323709c87 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Bounds/Defs.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Bounds/Defs.lean @@ -15,7 +15,7 @@ import Mathlib.Tactic.NormNum.Pow The concrete simulator has fixed control once its RAM program is fixed. The only program-dependent quantities that matter asymptotically are therefore collected in `programResourceMagnitude`. `programDecisionScale` combines -that fixedValue with the public input length and the charged logarithmic RAM +that constant with the public input length and the charged logarithmic RAM time. The fourth-power envelope is deliberately coarse: it keeps the public class-transfer theorem independent of low-level controller constants while still recording a genuine polynomial simulation. @@ -45,7 +45,7 @@ def instructionResourceMagnitude : Instr → ℕ | .jmp target => target + 1 | .halt => 1 -/-- One positive fixed fixedValue containing the program length and every +/-- One positive fixed constant containing the program length and every hardwired register, immediate, and jump literal. -/ def programResourceMagnitude (program : Program) : ℕ := program.length + (program.map instructionResourceMagnitude).sum + 1 diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseBoundsProof.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseBoundsProof.lean index 374917b7b3..30eeb3f761 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseBoundsProof.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseBoundsProof.lean @@ -1501,15 +1501,15 @@ private theorem denseStepVolume_le_runScale_succ rw [hhalt] rfl unfold denseStepVolume denseStepWidth denseRunScale - rw [RAM.unitTimeUpto_succ, if_pos hramHalt, - RAM.logTimeUpto_succ, if_pos hramHalt] + rw [RAM.unitTimeUpto_succ, ite_eq_left hramHalt, + RAM.logTimeUpto_succ, ite_eq_left hramHalt] rw [hcost] nlinarith · have hramNotHalt : ¬RAM.Halted program (snapshot.decode input) := fun h => hhalt (hhalted.mpr h) unfold denseStepVolume denseStepWidth denseRunScale - rw [RAM.unitTimeUpto_succ, if_neg hramNotHalt, - RAM.logTimeUpto_succ, if_neg hramNotHalt] + rw [RAM.unitTimeUpto_succ, ite_eq_right hramNotHalt, + RAM.logTimeUpto_succ, ite_eq_right hramNotHalt] nlinarith private theorem denseRunScale_step_add_width_le @@ -1545,8 +1545,8 @@ private theorem denseRunScale_step_add_width_le have hdecode := DenseOverlay.Snapshot.decode_step program input snapshot hvalid.1 unfold denseRunScale denseStepWidth - rw [RAM.unitTimeUpto_succ, if_neg hramNotHalt, - RAM.logTimeUpto_succ, if_neg hramNotHalt, hdecode] + rw [RAM.unitTimeUpto_succ, ite_eq_right hramNotHalt, + RAM.logTimeUpto_succ, ite_eq_right hramNotHalt, hdecode] nlinarith private theorem denseDispatchHaltTime_le_width {m : ℕ} diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseInitProof.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseInitProof.lean index af7a54fce9..f487e27d78 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseInitProof.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseInitProof.lean @@ -52,10 +52,10 @@ private theorem denseInitialLengthLoopTM_body_step have hne : c.state ≠ (initialZeroBitTM tapes).qhalt := TM.state_ne_qhalt_of_step hstep rw [TM.step, - if_neg (by simp [denseInitialLengthWrap, denseInitialLengthLoopTM])] + ite_eq_right (by simp [denseInitialLengthWrap, denseInitialLengthLoopTM])] simp only [denseInitialLengthWrap, denseInitialLengthLoopTM, hne, ↓reduceIte] - rw [TM.step, if_neg hne] at hstep + rw [TM.step, ite_eq_right hne] at hstep revert hstep generalize (initialZeroBitTM tapes).δ c.state c.input.read (fun i => (c.work i).read) c.output.read = action @@ -87,7 +87,7 @@ private theorem denseInitialLengthLoopTM_step_scan_data work := c.work output := c.output } := by rw [TM.step, - if_neg (by rw [hstate]; simp [denseInitialLengthLoopTM])] + ite_eq_right (by rw [hstate]; simp [denseInitialLengthLoopTM])] simp only [denseInitialLengthLoopTM, hstate, hblank, TM.allReadBack, ↓reduceIte] refine congrArg some ((Complexity.Cfg.mk.injEq ..).mpr @@ -95,9 +95,9 @@ private theorem denseInitialLengthLoopTM_step_scan_data · simp [TM.idleDir, hstart, Tape.move] · funext i rw [TM.writeAndMove_readBack _ (hwork i), TM.idleDir, - if_neg (hwork i)] + ite_eq_right (hwork i)] rfl - · rw [TM.writeAndMove_readBack _ houtput, TM.idleDir, if_neg houtput] + · rw [TM.writeAndMove_readBack _ houtput, TM.idleDir, ite_eq_right houtput] rfl private theorem denseInitialLengthLoopTM_step_scan_blank @@ -112,7 +112,7 @@ private theorem denseInitialLengthLoopTM_step_scan_blank work := c.work output := c.output } := by rw [TM.step, - if_neg (by rw [hstate]; simp [denseInitialLengthLoopTM])] + ite_eq_right (by rw [hstate]; simp [denseInitialLengthLoopTM])] simp only [denseInitialLengthLoopTM, hstate, hblank, TM.allReadBack, ↓reduceIte] refine congrArg some ((Complexity.Cfg.mk.injEq ..).mpr @@ -120,9 +120,9 @@ private theorem denseInitialLengthLoopTM_step_scan_blank · simp [TM.idleDir, Tape.move] · funext i rw [TM.writeAndMove_readBack _ (hwork i), TM.idleDir, - if_neg (hwork i)] + ite_eq_right (hwork i)] rfl - · rw [TM.writeAndMove_readBack _ houtput, TM.idleDir, if_neg houtput] + · rw [TM.writeAndMove_readBack _ houtput, TM.idleDir, ite_eq_right houtput] rfl private theorem denseInitialLengthLoopTM_step_body_halt @@ -138,16 +138,16 @@ private theorem denseInitialLengthLoopTM_step_body_halt work := c.work output := c.output } := by rw [TM.step, - if_neg (by simp [denseInitialLengthWrap, denseInitialLengthLoopTM])] + ite_eq_right (by simp [denseInitialLengthWrap, denseInitialLengthLoopTM])] simp only [denseInitialLengthWrap, denseInitialLengthLoopTM, hhalt, ↓reduceIte] refine congrArg some ((Complexity.Cfg.mk.injEq ..).mpr ⟨rfl, rfl, ?_, ?_⟩) · funext i rw [TM.writeAndMove_readBack _ (hwork i), TM.idleDir, - if_neg (hwork i)] + ite_eq_right (hwork i)] rfl - · rw [TM.writeAndMove_readBack _ houtput, TM.idleDir, if_neg houtput] + · rw [TM.writeAndMove_readBack _ houtput, TM.idleDir, ite_eq_right houtput] rfl theorem denseInitialLengthLoopTM_hoareTime_internal diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseInternal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseInternal.lean index 26a971adc5..6d66a63d2d 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseInternal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseInternal.lean @@ -366,7 +366,7 @@ theorem denseSnapshot_run_halted_internal ∀ fuel, snapshot.run program input fuel = snapshot | 0 => rfl | fuel + 1 => by - rw [DenseOverlay.Snapshot.run, if_pos hhalted] + rw [DenseOverlay.Snapshot.run, ite_eq_left hhalted] /-- A halted fuel-bounded dense run is realized by the fixed controller loop. The extra iteration handles a snapshot already halted at fuel zero. -/ diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Init/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Init/Internal.lean index bc27c96f95..eebc05b4e6 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Init/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Init/Internal.lean @@ -203,9 +203,9 @@ private theorem initialInputLoopTM_one_step some (initialInputOneWrap tapes c') := by have hne : c.state ≠ (initialOneBitTM tapes).qhalt := TM.state_ne_qhalt_of_step hstep - rw [TM.step, if_neg (by simp [initialInputOneWrap, initialInputLoopTM])] + rw [TM.step, ite_eq_right (by simp [initialInputOneWrap, initialInputLoopTM])] simp only [initialInputOneWrap, initialInputLoopTM, hne, ↓reduceIte] - rw [TM.step, if_neg hne] at hstep + rw [TM.step, ite_eq_right hne] at hstep revert hstep generalize (initialOneBitTM tapes).δ c.state c.input.read (fun i => (c.work i).read) c.output.read = action @@ -223,9 +223,9 @@ private theorem initialInputLoopTM_zero_step some (initialInputZeroWrap tapes c') := by have hne : c.state ≠ (initialZeroBitTM tapes).qhalt := TM.state_ne_qhalt_of_step hstep - rw [TM.step, if_neg (by simp [initialInputZeroWrap, initialInputLoopTM])] + rw [TM.step, ite_eq_right (by simp [initialInputZeroWrap, initialInputLoopTM])] simp only [initialInputZeroWrap, initialInputLoopTM, hne, ↓reduceIte] - rw [TM.step, if_neg hne] at hstep + rw [TM.step, ite_eq_right hne] at hstep revert hstep generalize (initialZeroBitTM tapes).δ c.state c.input.read (fun i => (c.work i).read) c.output.read = action @@ -264,7 +264,7 @@ private theorem initialInputLoopTM_step_scan_one input := c.input work := c.work output := c.output } := by - rw [TM.step, if_neg (by rw [hstate]; simp [initialInputLoopTM])] + rw [TM.step, ite_eq_right (by rw [hstate]; simp [initialInputLoopTM])] simp only [initialInputLoopTM, hstate, hone, TM.allReadBack, reduceCtorEq, ↓reduceIte] refine congrArg some ((Complexity.Cfg.mk.injEq ..).mpr @@ -272,10 +272,10 @@ private theorem initialInputLoopTM_step_scan_one · simp [TM.idleDir, Tape.move] · funext i rw [TM.writeAndMove_readBack _ (hwork i), TM.idleDir, - if_neg (hwork i)] + ite_eq_right (hwork i)] rfl · rw [TM.writeAndMove_readBack _ houtput, TM.idleDir, - if_neg houtput] + ite_eq_right houtput] rfl private theorem initialInputLoopTM_step_scan_zero @@ -292,7 +292,7 @@ private theorem initialInputLoopTM_step_scan_zero have hstart : c.input.read ≠ Γ.start := by rw [hzero]; decide have hblank : c.input.read ≠ Γ.blank := by rw [hzero]; decide have hone : c.input.read ≠ Γ.one := by rw [hzero]; decide - rw [TM.step, if_neg (by rw [hstate]; simp [initialInputLoopTM])] + rw [TM.step, ite_eq_right (by rw [hstate]; simp [initialInputLoopTM])] simp only [initialInputLoopTM, hstate, hblank, hone, TM.allReadBack, ↓reduceIte] refine congrArg some ((Complexity.Cfg.mk.injEq ..).mpr @@ -300,10 +300,10 @@ private theorem initialInputLoopTM_step_scan_zero · simp [TM.idleDir, hstart, Tape.move] · funext i rw [TM.writeAndMove_readBack _ (hwork i), TM.idleDir, - if_neg (hwork i)] + ite_eq_right (hwork i)] rfl · rw [TM.writeAndMove_readBack _ houtput, TM.idleDir, - if_neg houtput] + ite_eq_right houtput] rfl private theorem initialInputLoopTM_step_scan_blank @@ -317,7 +317,7 @@ private theorem initialInputLoopTM_step_scan_blank input := c.input work := c.work output := c.output } := by - rw [TM.step, if_neg (by rw [hstate]; simp [initialInputLoopTM])] + rw [TM.step, ite_eq_right (by rw [hstate]; simp [initialInputLoopTM])] simp only [initialInputLoopTM, hstate, hblank, TM.allReadBack, ↓reduceIte] refine congrArg some ((Complexity.Cfg.mk.injEq ..).mpr @@ -325,10 +325,10 @@ private theorem initialInputLoopTM_step_scan_blank · simp [TM.idleDir, Tape.move] · funext i rw [TM.writeAndMove_readBack _ (hwork i), TM.idleDir, - if_neg (hwork i)] + ite_eq_right (hwork i)] rfl · rw [TM.writeAndMove_readBack _ houtput, TM.idleDir, - if_neg houtput] + ite_eq_right houtput] rfl private theorem initialInputLoopTM_step_one_halt @@ -343,17 +343,17 @@ private theorem initialInputLoopTM_step_one_halt work := c.work output := c.output } := by rw [TM.step, - if_neg (by simp [initialInputOneWrap, initialInputLoopTM])] + ite_eq_right (by simp [initialInputOneWrap, initialInputLoopTM])] simp only [initialInputOneWrap, initialInputLoopTM, hhalt, ↓reduceIte] refine congrArg some ((Complexity.Cfg.mk.injEq ..).mpr ⟨rfl, ?_, ?_, ?_⟩) · rfl · funext i rw [TM.writeAndMove_readBack _ (hwork i), TM.idleDir, - if_neg (hwork i)] + ite_eq_right (hwork i)] rfl · rw [TM.writeAndMove_readBack _ houtput, TM.idleDir, - if_neg houtput] + ite_eq_right houtput] rfl private theorem initialInputLoopTM_step_zero_halt @@ -368,17 +368,17 @@ private theorem initialInputLoopTM_step_zero_halt work := c.work output := c.output } := by rw [TM.step, - if_neg (by simp [initialInputZeroWrap, initialInputLoopTM])] + ite_eq_right (by simp [initialInputZeroWrap, initialInputLoopTM])] simp only [initialInputZeroWrap, initialInputLoopTM, hhalt, ↓reduceIte] refine congrArg some ((Complexity.Cfg.mk.injEq ..).mpr ⟨rfl, ?_, ?_, ?_⟩) · rfl · funext i rw [TM.writeAndMove_readBack _ (hwork i), TM.idleDir, - if_neg (hwork i)] + ite_eq_right (hwork i)] rfl · rw [TM.writeAndMove_readBack _ houtput, TM.idleDir, - if_neg houtput] + ite_eq_right houtput] rfl private theorem copyWorkToWorkTM_exact_hoareTime @@ -1061,7 +1061,7 @@ theorem initialInputLoopTM_hoareTime_internal refine ⟨tailDone, 1 + bodyTime + 1 + tailTime, ?_, ?_, htailHalt, ?_⟩ · simp only [initialInputLoopTime, Bool.false_eq_true, - if_false, Nat.add_zero] + ite_false, Nat.add_zero] omega · simpa [Nat.add_assoc] using hreach · refine ⟨htailInput, ?_, htailOutput.trans hbodyOutput⟩ @@ -1158,7 +1158,7 @@ theorem initialSetupTM_hoareTime_internal input := Tape.init (input.map Γ.ofBool) work := fun _ => Tape.init [] output := Tape.init [] } = some skipped := by - rw [TM.step, if_neg (by simp [TM.skipTM])] + rw [TM.step, ite_eq_right (by simp [TM.skipTM])] simp only [TM.skipTM] refine congrArg some (Complexity.Cfg.ext rfl ?_ ?_ ?_) · simp [skipped, parkedInput, TM.idleDir, Tape.read, Tape.move] @@ -2085,7 +2085,7 @@ private theorem read_inputBitStoreFrom (start target : ℕ) | nil => simp [inputBitStoreFrom, read] | cons bit rest ih => cases bit - · simp only [inputBitStoreFrom, Bool.false_eq_true, if_false, + · simp only [inputBitStoreFrom, Bool.false_eq_true, ite_false, List.nil_append] by_cases htarget : target = start · subst target @@ -2093,26 +2093,26 @@ private theorem read_inputBitStoreFrom (start target : ℕ) simp · by_cases hlt : target < start · rw [ih] - simp only [if_neg (by omega : ¬start + 1 ≤ target), - if_neg (by omega : ¬start ≤ target)] + simp only [ite_eq_right (by omega : ¬start + 1 ≤ target), + ite_eq_right (by omega : ¬start ≤ target)] · have hge : start + 1 ≤ target := by omega have hsub : target - start = (target - (start + 1)) + 1 := by omega - rw [ih, if_pos hge, if_pos (by omega : start ≤ target)] + rw [ih, ite_eq_left hge, ite_eq_left (by omega : start ≤ target)] simp [hsub] · simp only [inputBitStoreFrom, if_true, List.singleton_append] by_cases htarget : target = start · subst target simp [read] · by_cases hlt : target < start - · rw [read, if_neg htarget, ih] - simp only [if_neg (by omega : ¬start + 1 ≤ target), - if_neg (by omega : ¬start ≤ target)] + · rw [read, ite_eq_right htarget, ih] + simp only [ite_eq_right (by omega : ¬start + 1 ≤ target), + ite_eq_right (by omega : ¬start ≤ target)] · have hge : start + 1 ≤ target := by omega have hsub : target - start = (target - (start + 1)) + 1 := by omega - rw [read, if_neg htarget, ih, if_pos hge, - if_pos (by omega : start ≤ target)] + rw [read, ite_eq_right htarget, ih, ite_eq_left hge, + ite_eq_left (by omega : start ≤ target)] simp [hsub] private theorem read_inputBitStoreFrom_zero (input : List Bool) : diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Internal.lean index 2655b8a6cc..d629dd8c80 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Internal.lean @@ -698,7 +698,7 @@ theorem programLoop_rewind_check_internal (tmBody tmTest : TM n) exact TM.transitionTape_eq_self (by rw [hread₃]; simp) refine ⟨c₃, .step hstep₁ (.step hstep₂ (.step hstep₃ .zero)), ?_, ?_, ?_, ?_⟩ - · rw [hstate₃, if_pos hone] + · rw [hstate₃, ite_eq_left hone] · rw [hinput₃, hinput₂, hinput₁] · rw [hwork₃, hwork₂, hwork₁] · rw [houtput₃, houtput₂] @@ -723,7 +723,7 @@ theorem programLoop_rewind_check_internal (tmBody tmTest : TM n) · exact TM.transitionTape_eq_self hread₃Start refine ⟨c₃, .step hstep₁ (.step hstep₂ (.step hstep₃ .zero)), ?_, ?_, ?_, ?_⟩ - · rw [hstate₃, if_neg hone] + · rw [hstate₃, ite_eq_right hone] · rw [hinput₃, hinput₂, hinput₁] · rw [hwork₃, hwork₂, hwork₁] · rw [houtput₃, houtput₂] @@ -1256,7 +1256,7 @@ theorem snapshot_run_halted_internal ∀ fuel, snapshot.run program fuel = snapshot | 0 => rfl | fuel + 1 => by - rw [Snapshot.run, if_pos hhalted] + rw [Snapshot.run, ite_eq_left hhalted] /-- A halted fuel-bounded sparse run is realized by the fixed controller loop. The extra iteration handles a snapshot that is already halted at fuel zero. -/ diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/WordDecode/Defs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/WordDecode/Defs.lean index c0551b3702..744990fabd 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/WordDecode/Defs.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/WordDecode/Defs.lean @@ -326,7 +326,7 @@ def wordDecodeLinearTM {n : ℕ} intro i hi by_cases him : i = markerIdx · subst i - simpa only [if_pos] using TM.moveLeftDir_right_of_start hi + simpa only [ite_eq_left] using TM.moveLeftDir_right_of_start hi · simp [him, TM.idleDir_right_of_start hi] | copy => cases hmarker : wHeads markerIdx with diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/WordDecode/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/WordDecode/Internal.lean index 35da749133..146505f790 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/WordDecode/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/WordDecode/Internal.lean @@ -465,7 +465,7 @@ private theorem payloadBitTM_step (sourceIdx targetIdx : Fin n) work := payloadBitWork sourceIdx targetIdx work₀ bit output := out₀ } := by have hread := hsource.read_cons - rw [TM.step, if_neg (by simp [payloadBitTM])] + rw [TM.step, ite_eq_right (by simp [payloadBitTM])] cases bit <;> simp only [payloadBitTM, hread, Γ.ofBool, reduceCtorEq] all_goals @@ -578,7 +578,7 @@ private theorem wordSeparatorTM_step (sourceIdx : Fin n) have hread := hsource.read_cons have hzero : (work₀ sourceIdx).read = Γ.zero := by simpa [Γ.ofBool] using hread - rw [TM.step, if_neg (by simp [wordSeparatorTM])] + rw [TM.step, ite_eq_right (by simp [wordSeparatorTM])] simp only [wordSeparatorTM, hzero, ↓reduceIte] refine congrArg some (Cfg.ext rfl ?_ ?_ ?_) · dsimp only diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/WordDecode/LinearInternal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/WordDecode/LinearInternal.lean index 2d7d8791df..b3556d84e1 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/WordDecode/LinearInternal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/WordDecode/LinearInternal.lean @@ -64,7 +64,7 @@ private theorem linearMarkStep have hstep : (wordDecodeLinearTM sourceIdx targetIdx markerIdx).step { state := .mark, input := inp, work := work, output := out } = some c' := by - rw [TM.step, if_neg (by simp [wordDecodeLinearTM])] + rw [TM.step, ite_eq_right (by simp [wordDecodeLinearTM])] simp only [wordDecodeLinearTM, hread] apply congrArg some refine Cfg.ext rfl ?_ ?_ ?_ @@ -87,10 +87,10 @@ private theorem linearMarkStep TM.writeAndMove_readBack out houtput Dir3.stay refine ⟨c', hstep, rfl, rfl, ?_, ?_, ?_, rfl, rfl⟩ · dsimp only [c', work', linearMarkWork] - rw [if_pos rfl] + rw [ite_eq_left rfl] exact hsource.move_right_cons · dsimp only [c', work', linearMarkWork] - rw [if_neg (Ne.symm hdistinct.source_marker), if_pos rfl] + rw [ite_eq_right (Ne.symm hdistinct.source_marker), ite_eq_left rfl] simpa [Γw.ofBool, Γ.ofBool, Γw.toΓ] using Tape.hasBinaryPrefix_write_bit true hmarker · intro i his him @@ -197,7 +197,7 @@ private theorem linearSeparatorStep have hstep : (wordDecodeLinearTM sourceIdx targetIdx markerIdx).step { state := .mark, input := inp, work := work, output := out } = some c' := by - rw [TM.step, if_neg (by simp [wordDecodeLinearTM])] + rw [TM.step, ite_eq_right (by simp [wordDecodeLinearTM])] simp only [wordDecodeLinearTM, hread] apply congrArg some refine Cfg.ext rfl ?_ ?_ ?_ @@ -224,15 +224,15 @@ private theorem linearSeparatorStep TM.writeAndMove_readBack out houtput Dir3.stay refine ⟨c', hstep, rfl, rfl, ?_, ?_, ?_, ?_, rfl⟩ · dsimp only [c', work', linearSeparatorWork] - rw [if_pos rfl] + rw [ite_eq_left rfl] exact hsource.move_right_cons · dsimp only [c', work', linearSeparatorWork] - rw [if_neg (Ne.symm hdistinct.source_marker), if_pos rfl] + rw [ite_eq_right (Ne.symm hdistinct.source_marker), ite_eq_left rfl] simp only [Tape.move] rw [hmarker.1] simp · dsimp only [c', work', linearSeparatorWork] - rw [if_neg (Ne.symm hdistinct.source_marker), if_pos rfl, + rw [ite_eq_right (Ne.symm hdistinct.source_marker), ite_eq_left rfl, Tape.move_cells] · intro i his him simp [c', work', linearSeparatorWork, his, him] @@ -267,7 +267,7 @@ private theorem linearRewindLeftStep have hstep : (wordDecodeLinearTM sourceIdx targetIdx markerIdx).step { state := .rewind, input := inp, work := work, output := out } = some c' := by - rw [TM.step, if_neg (by simp [wordDecodeLinearTM])] + rw [TM.step, ite_eq_right (by simp [wordDecodeLinearTM])] simp only [wordDecodeLinearTM, hmarkerRead, ↓reduceIte] apply congrArg some refine Cfg.ext rfl ?_ ?_ ?_ @@ -322,7 +322,7 @@ private theorem linearRewindBaseStep have hstep : (wordDecodeLinearTM sourceIdx targetIdx markerIdx).step { state := .rewind, input := inp, work := work, output := out } = some c' := by - rw [TM.step, if_neg (by simp [wordDecodeLinearTM])] + rw [TM.step, ite_eq_right (by simp [wordDecodeLinearTM])] simp only [wordDecodeLinearTM, hmarkerRead, ↓reduceIte] apply congrArg some refine Cfg.ext rfl ?_ ?_ ?_ @@ -440,7 +440,7 @@ private theorem linearCopyStep have hstep : (wordDecodeLinearTM sourceIdx targetIdx markerIdx).step { state := .copy, input := inp, work := work, output := out } = some c' := by - rw [TM.step, if_neg (by simp [wordDecodeLinearTM])] + rw [TM.step, ite_eq_right (by simp [wordDecodeLinearTM])] cases bit <;> simp only [wordDecodeLinearTM, hmarkerRead, hsourceRead, Γ.ofBool, reduceCtorEq] @@ -473,14 +473,14 @@ private theorem linearCopyStep TM.writeAndMove_readBack out houtput Dir3.stay refine ⟨c', hstep, rfl, rfl, ?_, ?_, ?_, ?_, rfl, rfl⟩ · dsimp only [c', work', linearCopyWork] - rw [if_pos rfl] + rw [ite_eq_left rfl] exact hsource.move_right_cons · dsimp only [c', work', linearCopyWork] - rw [if_neg (Ne.symm hdistinct.source_marker), - if_neg (Ne.symm hdistinct.target_marker), if_pos rfl] + rw [ite_eq_right (Ne.symm hdistinct.source_marker), + ite_eq_right (Ne.symm hdistinct.target_marker), ite_eq_left rfl] exact hmarker.move_right_cons · dsimp only [c', work', linearCopyWork] - rw [if_neg (Ne.symm hdistinct.source_target), if_pos rfl] + rw [ite_eq_right (Ne.symm hdistinct.source_target), ite_eq_left rfl] cases bit with | false => simpa [Γw.ofBool, Γ.ofBool, Γw.toΓ] using @@ -509,7 +509,7 @@ private theorem linearCopyDoneStep have hstep : (wordDecodeLinearTM sourceIdx targetIdx markerIdx).step { state := .copy, input := inp, work := work, output := out } = some c' := by - rw [TM.step, if_neg (by simp [wordDecodeLinearTM])] + rw [TM.step, ite_eq_right (by simp [wordDecodeLinearTM])] simp only [wordDecodeLinearTM, hmarkerRead, TM.allReadBack] apply congrArg some refine Cfg.ext rfl ?_ ?_ ?_ diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Internal.lean index b1e6b83259..79dbb94690 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Internal.lean @@ -52,7 +52,7 @@ theorem tapeAt_input_internal (cfg : Complexity.Cfg n Q) : theorem tapeAt_work_internal (cfg : Complexity.Cfg n Q) (i : Fin n) : tapeAt cfg ⟨i.val + 1, by omega⟩ = cfg.work i := by simp only [tapeAt] - rw [dif_neg (by omega), dif_neg (by omega)] + rw [dite_eq_right (by omega), dite_eq_right (by omega)] congr 1 theorem tapeAt_output_internal (cfg : Complexity.Cfg n Q) : diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/ABI/Internal/Capture.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/ABI/Internal/Capture.lean index 77bc7a44e8..4d7155ab53 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/ABI/Internal/Capture.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/ABI/Internal/Capture.lean @@ -27,7 +27,7 @@ namespace Sparse theorem initRegs_bool_of_pos_internal (x : List Bool) {reg : ℕ} (hpos : 0 < reg) : initRegs x reg = 0 ∨ initRegs x reg = 1 := by - rw [initRegs, if_neg (by omega)] + rw [initRegs, ite_eq_right (by omega)] cases hbit : x[reg - 1]? with | none => simp | some bit => diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/ABI/Internal/Marshal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/ABI/Internal/Marshal.lean index 0487c5e558..6abd6595e3 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/ABI/Internal/Marshal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/ABI/Internal/Marshal.lean @@ -86,7 +86,7 @@ private theorem marshalStart_of_not_captured (n : ℕ) (x : List Bool) private theorem initRegs_eq_zero_of_length_lt (x : List Bool) {reg : ℕ} (hreg : x.length < reg) : initRegs x reg = 0 := by - rw [initRegs, if_neg (by omega)] + rw [initRegs, ite_eq_right (by omega)] rw [List.getElem?_eq_none (by omega)] /-- Installing loop constants establishes the invariant before any input @@ -460,7 +460,7 @@ theorem repairBitStore_data_internal (n : ℕ) (entry : ℕ × ℕ) rw [hloadedValue] by_cases hzero : store (cellReg n (inputTape n) entry.1) = 0 · simp [hzero, hloadedData] - · simp only [hzero, if_false] + · simp only [hzero, ite_false] let valued := (Structured.Basic.imm (valueReg n) (entry.2 + 1)).exec loaded have hvaluedAddress : valued (addressReg n) = @@ -634,7 +634,7 @@ private theorem initRegs_add_one_eq_input_symbol (x : List Bool) ⟨position - 1, by omega⟩ have hindex : index < x.length := by omega rw [Tape.init_ofBool_cells_lt x index hindex] - simp only [initRegs, show index + 1 ≠ 0 by omega, if_false] + simp only [initRegs, show index + 1 ≠ 0 by omega, ite_false] rw [show index + 1 - 1 = index by omega, List.getElem?_eq_getElem hindex] cases x[index] <;> simp [Γ.ofBool, symbolCode] @@ -877,7 +877,7 @@ theorem initializeStore_represents_internal (tm : TM n) (x : List Bool) simpa [inputTape] using hinput · split <;> simp [Tape.init, hposition, symbolCode] -/-- The selected capture-tree leaf executes the fixedValue setup, exact backward +/-- The selected capture-tree leaf executes the constant setup, exact backward copy, conditional repair, and semantic initialization, ending in a complete sparse representation of the TM's initial configuration. -/ theorem marshalLeaf_exec_internal (tm : TM n) (x : List Bool) : diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/ABI/Internal/Resources.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/ABI/Internal/Resources.lean index 0b66d51804..bf45cb1851 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/ABI/Internal/Resources.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/ABI/Internal/Resources.lean @@ -739,7 +739,7 @@ private theorem repairBit_measured_internal {tm : TM n} {bound valueLimit : ℕ} have hrepairStore : repairBitStore n entry store = loaded := by unfold repairBitStore change (if loaded (valueReg n) = 0 then loaded else _) = loaded - rw [if_pos hzero] + rw [ite_eq_left hzero] refine ⟨3, ?_, ?_⟩ · rw [hrepairStore] simpa [repairBit] using hrun' @@ -792,7 +792,7 @@ private theorem repairBit_measured_internal {tm : TM n} {bound valueLimit : ℕ} Structured.Basic.execList [.imm (valueReg n) (entry.2 + 1), .store (addressReg n) (valueReg n)] loaded) = final - rw [if_neg hzero] + rw [ite_eq_right hzero] rfl refine ⟨6, ?_, ?_⟩ · rw [hrepairStore] diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Internal.lean index c532b4bef0..97520485c5 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Internal.lean @@ -201,7 +201,7 @@ theorem encodeRegs_head_internal (tm : TM n) (cfg : Complexity.Cfg n tm.Q) encodeRegs tm cfg (headReg tape) = (tapeAt cfg tape).head := by have hstate : headReg tape ≠ stateReg := by simp [headReg, stateReg] - rw [encodeRegs, dif_neg hstate, + rw [encodeRegs, dite_eq_right hstate, dif_pos (headReg_lt_control_internal tape)] congr 2 apply Fin.ext @@ -217,7 +217,7 @@ theorem encodeRegs_cell_internal (tm : TM n) (cfg : Complexity.Cfg n tm.Q) simp [stateReg] omega have hnotHead : ¬ cellReg n tape position < n + 3 := by omega - rw [encodeRegs, dif_neg hnotState, dif_neg hnotHead, if_pos hbase, + rw [encodeRegs, dite_eq_right hnotState, dite_eq_right hnotHead, ite_eq_left hbase, decodeCellTape_cellReg_internal, decodeCellPosition_cellReg_internal] theorem encodeRegs_represents_internal (tm : TM n) diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Step/Internal/Action.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Step/Internal/Action.lean index ad3ed4c786..62cfa9387c 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Step/Internal/Action.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Step/Internal/Action.lean @@ -181,7 +181,7 @@ private theorem writeOps_tape {tm : TM n} {cfg : Complexity.Cfg n tm.Q} · by_cases hpositionZero : position = 0 · subst position rw [Function.update_self] - rw [Tape.write, if_neg hheadZero] + rw [Tape.write, ite_eq_right hheadZero] change symbolCode Γ.start = symbolCode (Function.update (tapeAt cfg slot).cells (tapeAt cfg slot).head write.toΓ 0) @@ -710,7 +710,7 @@ theorem actionOps_represents_internal {tm : TM n} (fun i => (cfg.work i).read) cfg.output.read with ⟨nextState, workWrites, outputWrite, inputDirection, workDirections, outputDirection⟩ - rw [TM.step, if_neg hnotHalted, hdelta] at hstep + rw [TM.step, ite_eq_right hnotHalted, hdelta] at hstep dsimp only at hstep injection hstep with hnext subst next diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Step/Internal/Iteration.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Step/Internal/Iteration.lean index 1942ca4a3b..7f6f6efbb0 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Step/Internal/Iteration.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Step/Internal/Iteration.lean @@ -116,7 +116,7 @@ theorem starts_of_step_internal {tm : TM n} (fun i => (cfg.work i).read) cfg.output.read with ⟨nextState, workWrites, outputWrite, inputDirection, workDirections, outputDirection⟩ - rw [TM.step, if_neg hnotHalted, hdelta] at hstep + rw [TM.step, ite_eq_right hnotHalted, hdelta] at hstep dsimp only at hstep injection hstep with hnext subst next diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Step/Internal/Resources.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Step/Internal/Resources.lean index a4706348c2..cb5847fb5d 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Step/Internal/Resources.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Step/Internal/Resources.lean @@ -81,7 +81,7 @@ private theorem initRegs_index_le_length {x : List Bool} {reg : ℕ} (hnonzero : initRegs x reg ≠ 0) : reg ≤ x.length := by by_cases hreg : reg = 0 · omega - rw [initRegs, if_neg hreg] at hnonzero + rw [initRegs, ite_eq_right hreg] at hnonzero cases hbit : x[reg - 1]? with | none => simp [hbit] at hnonzero | some bit => @@ -506,7 +506,7 @@ theorem headsBounded_step_internal {tm : TM n} {bound : ℕ} (fun i => (cfg.work i).read) cfg.output.read with ⟨nextState, workWrites, outputWrite, inputDirection, workDirections, outputDirection⟩ - rw [TM.step, if_neg hnotHalted, hdelta] at hstep + rw [TM.step, ite_eq_right hnotHalted, hdelta] at hstep dsimp only at hstep injection hstep with hnext subst next diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Step.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Step.lean index 474a2b5800..e908d2c73e 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Step.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Step.lean @@ -82,7 +82,7 @@ theorem loadOps_correct {tm : TM n} {bound : ℕ} straight-line action maps any represented configuration to the exact TM successor. The assumptions are precisely those needed by the bounded tape layout: all heads are in range, writable tapes retain the left-end marker, and -the loading phase has initialized the fixedValue-one scratch register. -/ +the loading phase has initialized the constant-one scratch register. -/ theorem actionOps_correct {tm : TM n} {bound : ℕ} {cfg next : Complexity.Cfg n tm.Q} {store : Structured.Store} (hstep : tm.step cfg = some next) diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Step/Internal/Action.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Step/Internal/Action.lean index 1a8c6e91b8..0ec04ab858 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Step/Internal/Action.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Step/Internal/Action.lean @@ -177,7 +177,7 @@ private theorem writeOps_cells (n bound : ℕ) (slot : Fin (n + 2)) (configReg_ne_address hreg) (configReg_ne_value hreg)] rw [hstoreHead] by_cases hheadZero : tape.head = 0 - · rw [Tape.write, if_pos hheadZero] + · rw [Tape.write, ite_eq_left hheadZero] by_cases hpositionZero : position.val = 0 · rw [hheadZero, hpositionZero, Nat.add_zero, Function.update_self, hstart] · have htarget : @@ -187,7 +187,7 @@ private theorem writeOps_cells (n bound : ℕ) (slot : Fin (n + 2)) cellBase n bound slot + position.val ≠ cellBase n bound slot := by omega rw [Function.update_of_ne hbase, Function.update_of_ne htarget, hstoreCell] - · rw [Tape.write, if_neg hheadZero] + · rw [Tape.write, ite_eq_right hheadZero] change Function.update (Function.update store (cellBase n bound slot + tape.head) (writeCode write)) (cellBase n bound slot) (symbolCode Γ.start) @@ -749,7 +749,7 @@ theorem actionOps_represents_internal {tm : TM n} {bound : ℕ} (fun i => (cfg.work i).read) cfg.output.read with ⟨nextState, workWrites, outputWrite, inputDirection, workDirections, outputDirection⟩ - rw [TM.step, if_neg hnotHalted, hdelta] at hstep + rw [TM.step, ite_eq_right hnotHalted, hdelta] at hstep dsimp only at hstep injection hstep with hnext subst next diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Soundness.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Soundness.lean index a85c848bc7..532da54ba8 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Soundness.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Soundness.lean @@ -58,7 +58,7 @@ private theorem sqProg_getElem_zero (k : ℕ) : private theorem sqProg_getElem_succ {k j : ℕ} (hj : j < k) : (sqProg k)[j + 1]? = some (Instr.mul 1 1 1) := by - simp only [sqProg, List.getElem?_cons_succ, List.getElem?_replicate, if_pos hj] + simp only [sqProg, List.getElem?_cons_succ, List.getElem?_replicate, ite_eq_left hj] /-- Squaring `2 ^ (2 ^ j)` yields `2 ^ (2 ^ (j + 1))`. -/ private theorem sq_pow (j : ℕ) : 2 ^ 2 ^ j * 2 ^ 2 ^ j = 2 ^ 2 ^ (j + 1) := by @@ -79,7 +79,7 @@ private theorem step_sqStart (k : ℕ) : step (sqProg k) sqStart = sqCfg 0 := by by_cases hi : i = 1 · subst hi; rw [Function.update_self]; rfl · rw [Function.update_of_ne hi] - simp only [sqStart, sqCfg, if_neg hi] + simp only [sqStart, sqCfg, ite_eq_right hi] /-- One squaring step from `sqCfg j` reaches `sqCfg (j + 1)`, provided the `(j + 1)`-th instruction is a `mul` (i.e. `j < k`). -/ @@ -97,7 +97,7 @@ private theorem step_sqCfg {k j : ℕ} (hj : j < k) : by_cases hi : i = 1 · subst hi; rw [Function.update_self]; exact sq_pow j · rw [Function.update_of_ne hi] - simp only [sqCfg, if_neg hi] + simp only [sqCfg, ite_eq_right hi] /-- The run invariant: `j + 1` steps of `sqProg k` from the start reach `sqCfg j`, for every `j ≤ k`. -/ @@ -170,7 +170,7 @@ theorem logGap_squaring {k : ℕ} (hk : 1 ≤ k) : -- Evaluate the one-step logarithmic cost of the final `mul`. have hstep1 : logTimeUpto (sqProg (m + 1)) 1 (sqCfg m) = stepLogCost (sqProg (m + 1)) (sqCfg m) := by - rw [show (1 : ℕ) = 0 + 1 from rfl, logTimeUpto_succ, if_neg hnh, logTimeUpto_zero, + rw [show (1 : ℕ) = 0 + 1 from rfl, logTimeUpto_succ, ite_eq_right hnh, logTimeUpto_zero, Nat.add_zero] have hval : (sqCfg m).regs 1 = 2 ^ 2 ^ m := by simp [sqCfg] have hcost : stepLogCost (sqProg (m + 1)) (sqCfg m) = diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/GateStep/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/GateStep/Internal.lean index 6705ba7c38..81c14de545 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/GateStep/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/GateStep/Internal.lean @@ -366,7 +366,7 @@ private theorem header_cursorReady (gate : CircuitCode.RawGate) (wires : List Bo rw [hpreserved] simp only [inputStore, Input.bitStore, UnaryDecode.remainingReg, UnaryDecode.inputBase] - rw [if_neg (by omega : 10 + delta ≠ 3), if_pos (by omega : 7 ≤ 10 + delta)] + rw [ite_eq_right (by omega : 10 + delta ≠ 3), ite_eq_left (by omega : 7 ≤ 10 + delta)] have hoffset : 10 + delta - 7 = 3 + delta := by omega rw [hoffset] change @@ -656,7 +656,7 @@ private theorem input_wire (gate : CircuitCode.RawGate) (wires : List Bool) simp only [memoBase, UnaryDecode.inputBase, UnaryDecode.remainingReg] omega simp only [inputStore, Input.bitStore] - rw [if_neg hlength, if_pos hbase] + rw [ite_eq_right hlength, ite_eq_left hbase] have hoffset : memoBase gate + index - UnaryDecode.inputBase = gate.encode.length + index := by simp [memoBase] diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Hamming/Defs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Hamming/Defs.lean index f609d31699..292c015bb0 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Hamming/Defs.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Hamming/Defs.lean @@ -53,7 +53,7 @@ def inputStore (bits : List Bool) : Store := Input.bitStore lengthReg inputBase bits /-- Basic instructions that initialize the accumulator, input pointer, and -fixedValue-one register. -/ +constant-one register. -/ def setupOps : List Basic := [.imm countReg 0, .imm pointerReg inputBase, .imm oneReg 1] @@ -86,7 +86,7 @@ def stepCount (bits : List Bool) : ℕ := 6 + 6 * bits.length + 2 * weight bits /-- Explicit logarithmic-cost time budget as a function of input length. The -fixedValue is deliberately simple: the important content is the linear number +constant is deliberately simple: the important content is the linear number of operations, each on values of `O(bitlen n)` bits. -/ def timeBound (inputLength : ℕ) : ℕ := 64 * (inputLength + 1) * (bitlen (inputLength + 5) + 1) diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Hamming/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Hamming/Internal.lean index 60b63074db..1521f9adc4 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Hamming/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Hamming/Internal.lean @@ -92,7 +92,7 @@ private theorem branched_bound {bit : Bool} {rest : List Bool} cases bit with | false => simpa [branched] using loaded_bound hinv.store_bound | true => - rw [branched, if_pos rfl] + rw [branched, ite_eq_left rfl] apply (loaded_bound hinv.store_bound).execBasic (.add countReg countReg oneReg) · simp [countReg] diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Internal.lean index 514638dadb..f59e1aa5db 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Internal.lean @@ -133,7 +133,7 @@ private theorem spaceUpto_add (P : Program) (first second : ℕ) (cfg : Cfg) : simp only [spaceUpto, run_succ] by_cases hhalt : Halted P cfg · simp [hhalt, spaceUpto_halted P hhalt] - · simp only [if_neg hhalt, ih] + · simp only [ite_eq_right hhalt, ih] omega private theorem run_space_le_spaceUpto (P : Program) (fuel : ℕ) (cfg : Cfg) : @@ -274,14 +274,14 @@ theorem compileAt_correct_internal rw [logTimeUpto_add _ branchSteps 1] rw [hbranchRun.2.1, hbranchRun.1] rw [show (1 : ℕ) = 0 + 1 from rfl, logTimeUpto_succ] - rw [if_neg hjmpHalt] + rw [ite_eq_right hjmpHalt] simp [stepLogCost, hjmpInstr', Instr.logCost] rw [spaceUpto] simp [Halted, curInstr] rw [step_jz_nonzero pre _ test _ store htest] rw [spaceUpto_add _ branchSteps 1, hbranchRun.2.2, hbranchRun.1] rw [show (1 : ℕ) = 0 + 1 from rfl, spaceUpto] - rw [if_neg hjmpHalt, hjmp'] + rw [ite_eq_right hjmpHalt, hjmp'] simp only [spaceUpto] have hfinalSpace : final.space ≤ branchSpace := by have hrunSpace := run_space_le_spaceUpto @@ -359,11 +359,11 @@ theorem compileAt_correct_internal rw [show bodySteps + loopSteps + 1 = bodySteps + (loopSteps + 1) by omega] rw [run_add, hbodyRun.1] rw [run_succ] - simp only [if_neg hjmpHalt] + simp only [ite_eq_right hjmpHalt] rw [hjmp', hloopRun.1] rw [logTimeUpto_add _ bodySteps (loopSteps + 1)] rw [hbodyRun.2.1, hbodyRun.1] - rw [logTimeUpto_succ, if_neg hjmpHalt] + rw [logTimeUpto_succ, ite_eq_right hjmpHalt] rw [hjmp', hloopRun.2.1] simp [stepLogCost, hjmpInstr', Instr.logCost] rw [spaceUpto] @@ -372,7 +372,7 @@ theorem compileAt_correct_internal rw [show bodySteps + loopSteps + 1 = bodySteps + (loopSteps + 1) by omega] rw [spaceUpto_add _ bodySteps (loopSteps + 1)] rw [hbodyRun.2.2, hbodyRun.1] - rw [spaceUpto, if_neg hjmpHalt, hjmp', hloopRun.2.2] + rw [spaceUpto, ite_eq_right hjmpHalt, hjmp', hloopRun.2.2] have hinitialSpace : store.space ≤ bodySpace := by have hstart := space_le_spaceUpto (pre ++ Instr.jz test (pre.length + (body.codeSize + 2)) :: diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Internal/Resources.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Internal/Resources.lean index 87f060437e..4c6e2d282b 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Internal/Resources.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Internal/Resources.lean @@ -73,9 +73,9 @@ theorem Input.bitStoreEnvelope {lengthReg inputBase indexBound valueBound : ℕ} · intro index by_cases hlengthRegEq : index = lengthReg · simpa [Input.bitStore, hlengthRegEq] using hlength - · rw [Input.bitStore, if_neg hlengthRegEq] + · rw [Input.bitStore, ite_eq_right hlengthRegEq] by_cases hbase : inputBase ≤ index - · rw [if_pos hbase] + · rw [ite_eq_left hbase] cases hlookup : bits[index - inputBase]? with | none => simp | some bit => diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/UnaryDecode/Defs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/UnaryDecode/Defs.lean index 1c22b33bbc..0af7dab336 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/UnaryDecode/Defs.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/UnaryDecode/Defs.lean @@ -49,7 +49,7 @@ def inputBase : ℕ := 7 def inputStore (bits : List Bool) : Store := Input.bitStore remainingReg inputBase bits -/-- Initialize the parser cursor, accumulator, fixedValue, and activity flag. -/ +/-- Initialize the parser cursor, accumulator, constant, and activity flag. -/ def setupOps : List Basic := [.imm verdictReg 0, .imm valueReg 0, .imm pointerReg inputBase, .imm oneReg 1, .imm activeReg 1] @@ -96,7 +96,7 @@ structure CursorReady (inputLength : ℕ) (remaining : List Bool) pointer_eq : store pointerReg = inputBase + offset /-- The remaining-length register agrees with the semantic suffix. -/ remaining_eq : store remainingReg = remaining.length - /-- The parser's fixedValue-one register is initialized. -/ + /-- The parser's constant-one register is initialized. -/ one_eq : store oneReg = 1 /-- The loop is active. -/ active_eq : store activeReg = 1 diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine.lean index 62ad7457dc..c5ef1befec 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine.lean @@ -714,7 +714,7 @@ theorem trace_startInvariant (tm : NTM n) (T : ℕ) | succ T ih => by_cases hhalt : c.state = tm.qhalt · simpa [trace, hhalt] using And.intro hinp (And.intro hwork hout) - · simp only [trace, hhalt, if_false] + · simp only [trace, hhalt, ite_false] apply ih · exact hinp.move _ · intro i @@ -776,7 +776,7 @@ theorem trace_mono (tm : NTM n) {T T' : ℕ} (hle : T ≤ T') rw [hcT, hcT'] · have hch0 := hagree ⟨0, Nat.zero_lt_succ _⟩ have hle' : T ≤ T' := Nat.le_of_succ_le_succ hle - simp only [NTM.trace, hc, hch0, if_false] at h ⊢ + simp only [NTM.trace, hc, hch0, ite_false] at h ⊢ exact ih hle' (fun i => hagree ⟨i.val + 1, by omega⟩) h /-- NTM acceptance is monotone in the time bound: `AcceptsInTime x T` implies diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/ForBinaryWork/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/ForBinaryWork/Internal.lean index 4659eff31b..3d54c62adb 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/ForBinaryWork/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/ForBinaryWork/Internal.lean @@ -41,9 +41,9 @@ theorem forBinaryWorkTM_body_step_internal (driverIdx : Fin n) (body : TM n) (forBinaryWorkBodyWrap driverIdx body cfg) = some (forBinaryWorkBodyWrap driverIdx body next) := by have hne : cfg.state ≠ body.qhalt := state_ne_qhalt_of_step hstep - rw [TM.step, if_neg (by simp [forBinaryWorkBodyWrap, forBinaryWorkTM])] + rw [TM.step, ite_eq_right (by simp [forBinaryWorkBodyWrap, forBinaryWorkTM])] simp only [forBinaryWorkBodyWrap, forBinaryWorkTM, hne, ↓reduceIte] - rw [TM.step, if_neg hne] at hstep + rw [TM.step, ite_eq_right hne] at hstep revert hstep generalize body.δ cfg.state cfg.input.read (fun i => (cfg.work i).read) cfg.output.read = action @@ -85,7 +85,7 @@ theorem forBinaryWorkTM_step_scan_bit_internal have hblank : (cfg.work driverIdx).read ≠ Γ.blank := by rw [hbit] cases bit <;> decide - rw [TM.step, if_neg (by rw [hstate]; simp [forBinaryWorkTM])] + rw [TM.step, ite_eq_right (by rw [hstate]; simp [forBinaryWorkTM])] simp only [forBinaryWorkTM, hstate, hstart, hblank, allReadBack, ↓reduceIte] refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, ?_, ?_, ?_⟩) @@ -108,7 +108,7 @@ theorem forBinaryWorkTM_step_scan_blank_internal input := cfg.input work := cfg.work output := cfg.output } := by - rw [TM.step, if_neg (by rw [hstate]; simp [forBinaryWorkTM])] + rw [TM.step, ite_eq_right (by rw [hstate]; simp [forBinaryWorkTM])] simp only [forBinaryWorkTM, hstate, hblank, allReadBack, ↓reduceIte] refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, ?_, ?_, ?_⟩) @@ -133,7 +133,7 @@ theorem forBinaryWorkTM_step_body_halt_internal if i = driverIdx then (cfg.work i).move Dir3.right else cfg.work i output := cfg.output } := by - rw [TM.step, if_neg (by simp [forBinaryWorkBodyWrap, forBinaryWorkTM])] + rw [TM.step, ite_eq_right (by simp [forBinaryWorkBodyWrap, forBinaryWorkTM])] simp only [forBinaryWorkBodyWrap, forBinaryWorkTM, hhalt, ↓reduceIte] refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, ?_, ?_, ?_⟩) · exact transitionInput_eq_self hinput @@ -141,9 +141,9 @@ theorem forBinaryWorkTM_step_body_halt_internal rw [writeAndMove_readBack _ (hwork i)] split · rfl - · rw [idleDir, if_neg (hwork i)] + · rw [idleDir, ite_eq_right (hwork i)] rfl - · rw [writeAndMove_readBack _ houtput, idleDir, if_neg houtput] + · rw [writeAndMove_readBack _ houtput, idleDir, ite_eq_right houtput] rfl /-- A certified bit-driven loop has its advertised exact remaining run. -/ diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/ForInput/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/ForInput/Internal.lean index 945cd8c67f..f5d8dcee8c 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/ForInput/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/ForInput/Internal.lean @@ -40,9 +40,9 @@ theorem forInputTM_body_step_internal (body : TM n) (forInputTM body).step (forInputBodyWrap body c) = some (forInputBodyWrap body c') := by have hne : c.state ≠ body.qhalt := state_ne_qhalt_of_step hstep - rw [TM.step, if_neg (by simp [forInputBodyWrap, forInputTM])] + rw [TM.step, ite_eq_right (by simp [forInputBodyWrap, forInputTM])] simp only [forInputBodyWrap, forInputTM, hne, ↓reduceIte] - rw [TM.step, if_neg hne] at hstep + rw [TM.step, ite_eq_right hne] at hstep revert hstep generalize body.δ c.state c.input.read (fun i => (c.work i).read) c.output.read = action obtain ⟨q', workWrites, outputWrite, inputDir, workDirs, outputDir⟩ := action @@ -71,13 +71,13 @@ theorem forInputTM_step_scan_bit_internal (body : TM n) input := c.input.move Dir3.right work := c.work output := c.output } := by - rw [TM.step, if_neg (by rw [hstate]; simp [forInputTM])] + rw [TM.step, ite_eq_right (by rw [hstate]; simp [forInputTM])] simp only [forInputTM, hstate, hstart, hblank, allReadBack, ↓reduceIte] refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, rfl, ?_, ?_⟩) · funext i - rw [writeAndMove_readBack _ (hwork i), idleDir, if_neg (hwork i)] + rw [writeAndMove_readBack _ (hwork i), idleDir, ite_eq_right (hwork i)] rfl - · rw [writeAndMove_readBack _ houtput, idleDir, if_neg houtput] + · rw [writeAndMove_readBack _ houtput, idleDir, ite_eq_right houtput] rfl /-- At the first input blank, the driver halts while preserving all off-start @@ -93,14 +93,14 @@ theorem forInputTM_step_scan_blank_internal (body : TM n) work := c.work output := c.output } := by have hstart : c.input.read ≠ Γ.start := by rw [hblank]; decide - rw [TM.step, if_neg (by rw [hstate]; simp [forInputTM])] + rw [TM.step, ite_eq_right (by rw [hstate]; simp [forInputTM])] simp only [forInputTM, hstate, hblank, allReadBack, reduceCtorEq, ↓reduceIte] refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, ?_, ?_, ?_⟩) · simp [idleDir, Tape.move] · funext i - rw [writeAndMove_readBack _ (hwork i), idleDir, if_neg (hwork i)] + rw [writeAndMove_readBack _ (hwork i), idleDir, ite_eq_right (hwork i)] rfl - · rw [writeAndMove_readBack _ houtput, idleDir, if_neg houtput] + · rw [writeAndMove_readBack _ houtput, idleDir, ite_eq_right houtput] rfl /-- A halted body takes one preserving seam step back to the input scanner. -/ @@ -114,14 +114,14 @@ theorem forInputTM_step_body_halt_internal (body : TM n) input := c.input work := c.work output := c.output } := by - rw [TM.step, if_neg (by simp [forInputBodyWrap, forInputTM])] + rw [TM.step, ite_eq_right (by simp [forInputBodyWrap, forInputTM])] simp only [forInputBodyWrap, forInputTM, hhalt, allReadBack, ↓reduceIte] refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, ?_, ?_, ?_⟩) · exact transitionInput_eq_self hinput · funext i - rw [writeAndMove_readBack _ (hwork i), idleDir, if_neg (hwork i)] + rw [writeAndMove_readBack _ (hwork i), idleDir, ite_eq_right (hwork i)] rfl - · rw [writeAndMove_readBack _ houtput, idleDir, if_neg houtput] + · rw [writeAndMove_readBack _ houtput, idleDir, ite_eq_right houtput] rfl /-- A certified input-driven loop has the advertised exact remaining run. -/ diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/ForWorkOnes/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/ForWorkOnes/Internal.lean index 3d53e1abb4..3a3df259ec 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/ForWorkOnes/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/ForWorkOnes/Internal.lean @@ -39,9 +39,9 @@ theorem forWorkOnesTM_body_step_internal (driverIdx : Fin n) (body : TM n) (forWorkOnesBodyWrap driverIdx body cfg) = some (forWorkOnesBodyWrap driverIdx body next) := by have hne : cfg.state ≠ body.qhalt := state_ne_qhalt_of_step hstep - rw [TM.step, if_neg (by simp [forWorkOnesBodyWrap, forWorkOnesTM])] + rw [TM.step, ite_eq_right (by simp [forWorkOnesBodyWrap, forWorkOnesTM])] simp only [forWorkOnesBodyWrap, forWorkOnesTM, hne, ↓reduceIte] - rw [TM.step, if_neg hne] at hstep + rw [TM.step, ite_eq_right hne] at hstep revert hstep generalize body.δ cfg.state cfg.input.read (fun i => (cfg.work i).read) cfg.output.read = action @@ -74,18 +74,18 @@ theorem forWorkOnesTM_step_scan_one_internal (driverIdx : Fin n) (body : TM n) work := fun i => if i = driverIdx then (cfg.work i).move Dir3.right else cfg.work i output := cfg.output } := by - rw [TM.step, if_neg (by rw [hstate]; simp [forWorkOnesTM])] + rw [TM.step, ite_eq_right (by rw [hstate]; simp [forWorkOnesTM])] simp only [forWorkOnesTM, hstate, hone, reduceCtorEq, ↓reduceIte] refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, ?_, ?_, ?_⟩) - · rw [idleDir, if_neg hinput] + · rw [idleDir, ite_eq_right hinput] rfl · funext i rw [writeAndMove_readBack _ (hwork i)] split · rfl - · rw [idleDir, if_neg (hwork i)] + · rw [idleDir, ite_eq_right (hwork i)] rfl - · rw [writeAndMove_readBack _ houtput, idleDir, if_neg houtput] + · rw [writeAndMove_readBack _ houtput, idleDir, ite_eq_right houtput] rfl /-- On the zero separator, the driver halts without consuming it. -/ @@ -103,15 +103,15 @@ theorem forWorkOnesTM_step_scan_zero_internal (driverIdx : Fin n) (body : TM n) output := cfg.output } := by have hstart : (cfg.work driverIdx).read ≠ Γ.start := by rw [hzero]; decide have hone : (cfg.work driverIdx).read ≠ Γ.one := by rw [hzero]; decide - rw [TM.step, if_neg (by rw [hstate]; simp [forWorkOnesTM])] + rw [TM.step, ite_eq_right (by rw [hstate]; simp [forWorkOnesTM])] simp only [forWorkOnesTM, hstate, hstart, hone, allReadBack, ↓reduceIte] refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, ?_, ?_, ?_⟩) - · rw [idleDir, if_neg hinput] + · rw [idleDir, ite_eq_right hinput] rfl · funext i - rw [writeAndMove_readBack _ (hwork i), idleDir, if_neg (hwork i)] + rw [writeAndMove_readBack _ (hwork i), idleDir, ite_eq_right (hwork i)] rfl - · rw [writeAndMove_readBack _ houtput, idleDir, if_neg houtput] + · rw [writeAndMove_readBack _ houtput, idleDir, ite_eq_right houtput] rfl /-- A halted body takes one preserving seam step back to the scanner. -/ @@ -126,14 +126,14 @@ theorem forWorkOnesTM_step_body_halt_internal (driverIdx : Fin n) (body : TM n) input := cfg.input work := cfg.work output := cfg.output } := by - rw [TM.step, if_neg (by simp [forWorkOnesBodyWrap, forWorkOnesTM])] + rw [TM.step, ite_eq_right (by simp [forWorkOnesBodyWrap, forWorkOnesTM])] simp only [forWorkOnesBodyWrap, forWorkOnesTM, hhalt, allReadBack, ↓reduceIte] refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, ?_, ?_, ?_⟩) · exact transitionInput_eq_self hinput · funext i - rw [writeAndMove_readBack _ (hwork i), idleDir, if_neg (hwork i)] + rw [writeAndMove_readBack _ (hwork i), idleDir, ite_eq_right (hwork i)] rfl - · rw [writeAndMove_readBack _ houtput, idleDir, if_neg houtput] + · rw [writeAndMove_readBack _ houtput, idleDir, ite_eq_right houtput] rfl /-- A certified consecutive-one loop has its advertised exact remaining run. -/ diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/Internal/If.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/Internal/If.lean index 63725be0ec..0e78f63d62 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/Internal/If.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/Internal/If.lean @@ -91,7 +91,7 @@ theorem ifTM_test_step (tmTest tmThen tmElse : TM n) {c c' : Cfg n tmTest.Q} subst hstep show (if (ifTestWrap tmTest tmThen tmElse c).state = (ifTM tmTest tmThen tmElse).qhalt then none else some _) = some _ - simp only [ifTestWrap, ifTM, if_neg ifQ_test_ne_halt, if_neg hne] + simp only [ifTestWrap, ifTM, ite_eq_right ifQ_test_ne_halt, ite_eq_right hne] /-- Multi-step test phase simulation. -/ theorem ifTM_reachesIn_ifTestWrap (tmTest tmThen tmElse : TM n) {t : ℕ} @@ -117,7 +117,7 @@ theorem ifTM_then_step (tmTest tmThen tmElse : TM n) {c c' : Cfg n tmThen.Q} subst hstep show (if (ifThenWrap tmTest tmThen tmElse c).state = (ifTM tmTest tmThen tmElse).qhalt then none else some _) = some _ - simp only [ifThenWrap, ifTM, if_neg ifQ_then_ne_halt, if_neg hne] + simp only [ifThenWrap, ifTM, ite_eq_right ifQ_then_ne_halt, ite_eq_right hne] /-- Multi-step then-branch simulation. -/ theorem ifTM_reachesIn_ifThenWrap (tmTest tmThen tmElse : TM n) {t : ℕ} @@ -143,7 +143,7 @@ theorem ifTM_else_step (tmTest tmThen tmElse : TM n) {c c' : Cfg n tmElse.Q} subst hstep show (if (ifElseWrap tmTest tmThen tmElse c).state = (ifTM tmTest tmThen tmElse).qhalt then none else some _) = some _ - simp only [ifElseWrap, ifTM, if_neg ifQ_else_ne_halt, if_neg hne] + simp only [ifElseWrap, ifTM, ite_eq_right ifQ_else_ne_halt, ite_eq_right hne] /-- Multi-step else-branch simulation. -/ theorem ifTM_reachesIn_ifElseWrap (tmTest tmThen tmElse : TM n) {t : ℕ} @@ -169,7 +169,7 @@ theorem ifTM_then_halt_step (tmTest tmThen tmElse : TM n) {c : Cfg n tmThen.Q} output := transitionTape c.output } := by show (if (ifThenWrap tmTest tmThen tmElse c).state = (ifTM tmTest tmThen tmElse).qhalt then none else some _) = some _ - simp only [ifThenWrap, ifTM, if_neg ifQ_then_ne_halt, hhalt, ↓reduceIte] + simp only [ifThenWrap, ifTM, ite_eq_right ifQ_then_ne_halt, hhalt, ↓reduceIte] congr 1 /-- When `tmElse` halts, one step transitions to `done`. -/ @@ -182,7 +182,7 @@ theorem ifTM_else_halt_step (tmTest tmThen tmElse : TM n) {c : Cfg n tmElse.Q} output := transitionTape c.output } := by show (if (ifElseWrap tmTest tmThen tmElse c).state = (ifTM tmTest tmThen tmElse).qhalt then none else some _) = some _ - simp only [ifElseWrap, ifTM, if_neg ifQ_else_ne_halt, hhalt, ↓reduceIte] + simp only [ifElseWrap, ifTM, ite_eq_right ifQ_else_ne_halt, hhalt, ↓reduceIte] congr 1 -- ════════════════════════════════════════════════════════════════════════ @@ -199,7 +199,7 @@ theorem ifTM_test_to_rewind (tmTest tmThen tmElse : TM n) {c : Cfg n tmTest.Q} output := transitionTape c.output } := by show (if (ifTestWrap tmTest tmThen tmElse c).state = (ifTM tmTest tmThen tmElse).qhalt then none else some _) = some _ - simp only [ifTestWrap, ifTM, if_neg ifQ_test_ne_halt, hhalt, ↓reduceIte] + simp only [ifTestWrap, ifTM, ite_eq_right ifQ_test_ne_halt, hhalt, ↓reduceIte] congr 1 -- ════════════════════════════════════════════════════════════════════════ diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/Internal/Loop.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/Internal/Loop.lean index 384ef17885..b642325297 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/Internal/Loop.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/Internal/Loop.lean @@ -74,7 +74,7 @@ theorem loopTM_body_step (tmBody tmTest : TM n) {c c' : Cfg n tmBody.Q} subst hstep show (if (loopBodyWrap tmBody tmTest c).state = (loopTM tmBody tmTest).qhalt then none else some _) = some _ - simp only [loopBodyWrap, loopTM, if_neg loopQ_body_ne_halt, if_neg hne] + simp only [loopBodyWrap, loopTM, ite_eq_right loopQ_body_ne_halt, ite_eq_right hne] /-- A `t`-step run of `tmBody` lifts to a `t`-step run of `loopTM` between the body-wrapped configurations. -/ @@ -103,7 +103,7 @@ theorem loopTM_body_to_test (tmBody tmTest : TM n) {c : Cfg n tmBody.Q} output := transitionTape c.output }) := by show (if (loopBodyWrap tmBody tmTest c).state = (loopTM tmBody tmTest).qhalt then none else some _) = some _ - simp only [loopBodyWrap, loopTM, if_neg loopQ_body_ne_halt, hhalt, ↓reduceIte] + simp only [loopBodyWrap, loopTM, ite_eq_right loopQ_body_ne_halt, hhalt, ↓reduceIte] congr 1 -- ════════════════════════════════════════════════════════════════════════ @@ -121,7 +121,7 @@ theorem loopTM_test_step (tmBody tmTest : TM n) {c c' : Cfg n tmTest.Q} subst hstep show (if (loopTestWrap tmBody tmTest c).state = (loopTM tmBody tmTest).qhalt then none else some _) = some _ - simp only [loopTestWrap, loopTM, if_neg loopQ_test_ne_halt, if_neg hne] + simp only [loopTestWrap, loopTM, ite_eq_right loopQ_test_ne_halt, ite_eq_right hne] /-- A `t`-step run of `tmTest` lifts to a `t`-step run of `loopTM` between the test-wrapped configurations. -/ @@ -149,7 +149,7 @@ theorem loopTM_test_to_rewind (tmBody tmTest : TM n) {c : Cfg n tmTest.Q} output := transitionTape c.output } := by show (if (loopTestWrap tmBody tmTest c).state = (loopTM tmBody tmTest).qhalt then none else some _) = some _ - simp only [loopTestWrap, loopTM, if_neg loopQ_test_ne_halt, hhalt, ↓reduceIte] + simp only [loopTestWrap, loopTM, ite_eq_right loopQ_test_ne_halt, hhalt, ↓reduceIte] congr 1 -- ════════════════════════════════════════════════════════════════════════ diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/Internal/Retarget.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/Internal/Retarget.lean index 03d60e625a..8fa0d1494c 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/Internal/Retarget.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/Internal/Retarget.lean @@ -164,7 +164,7 @@ theorem retargetInput_step_commute (M : TM k) {c c' : Cfg k M.Q} show (if h : i.val < k then c.work ⟨i.val, h⟩ else c.input).read = (c.work i).read rw [dif_pos i.isLt] -- Unfold step on the LHS. `split` reduces the halting ite (the stored - -- decidability instance blocks `simp`/`if_neg` post-v4.30). + -- decidability instance blocks `simp`/`ite_eq_right` post-v4.30). simp only [step, show (retargetWrap M realInput c).state = c.state from rfl, show (retargetInput M).qhalt = M.qhalt from rfl, retargetWrap_input, retargetWrap_output] @@ -189,7 +189,7 @@ theorem retargetInput_step_commute (M : TM k) {c c' : Cfg k M.Q} have hik_eq : i.val = k := by have := i.isLt; omega have hwork_k : (retargetWrap M realInput c).work i = c.input := by show (if h : i.val < k then c.work ⟨i.val, h⟩ else c.input) = c.input - rw [dif_neg hik] + rw [dite_eq_right hik] have hcond : c.input.head = 0 ∨ c.input.read ≠ Γ.start := by by_cases hh : c.input.head = 0 · left; exact hh @@ -199,7 +199,7 @@ theorem retargetInput_step_commute (M : TM k) {c c' : Cfg k M.Q} -- Rewrite LHS via hwork_k, then use tape_writeBack_eq_move. rw [hwork_k] show _ = (if h : i.val < k then _ else _) - rw [dif_neg hik, dif_neg hik, dif_neg hik] + rw [dite_eq_right hik, dite_eq_right hik, dite_eq_right hik] exact tape_writeBack_eq_move c.input _ hcond -- ════════════════════════════════════════════════════════════════════════ diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/Internal/Scanner.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/Internal/Scanner.lean index 1fd474373d..47cfe501d1 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/Internal/Scanner.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/Internal/Scanner.lean @@ -69,7 +69,7 @@ private theorem scannerTM_step_scan c'.state = ScannerPhase.scan (scanStep s (decide (c.input.read = Γ.one))) ∧ c'.input.head = c.input.head + 1 ∧ c'.input.cells = c.input.cells ∧ c'.output.head = 1 ∧ c'.output.cells = c.output.cells := by - simp only [TM.step, hst, scannerTM, reduceCtorEq, ↓reduceIte, if_neg hi_nb] + simp only [TM.step, hst, scannerTM, reduceCtorEq, ↓reduceIte, ite_eq_right hi_nb] have hne : c.output.read ≠ Γ.start := by simp only [Tape.read, ho_head]; exact ho_cell1_nb have ho_move : idleDir c.output.read = Dir3.stay := by @@ -91,7 +91,7 @@ private theorem scannerTM_step_halt ∃ c', (scannerTM s₀ scanStep finalOutput).step c = some c' ∧ (scannerTM s₀ scanStep finalOutput).halted c' ∧ c'.output.cells 1 = (finalOutput s).toΓ := by - simp only [TM.step, hst, scannerTM, reduceCtorEq, ↓reduceIte, if_pos hi_blank] + simp only [TM.step, hst, scannerTM, reduceCtorEq, ↓reduceIte, ite_eq_left hi_blank] refine ⟨_, rfl, rfl, ?_⟩ have hne : c.output.read ≠ Γ.start := by simp only [Tape.read, ho_head]; exact ho_cell1_nb @@ -221,14 +221,14 @@ theorem scannerTM_decidesInTime scannerTM_reachesIn s₀ scanStep (fun s => if accept s then .one else .zero) x refine ⟨c', x.length + 2, le_refl _, hreach, hhalt, ?_, ?_⟩ · intro hxL - rw [hout, if_pos ((hL x).mp hxL)]; rfl + rw [hout, ite_eq_left ((hL x).mp hxL)]; rfl · intro hxnL rw [hout] have hacc : accept (x.foldl scanStep s₀) = false := by rcases h : accept (x.foldl scanStep s₀) with _ | _ · rfl · exact absurd ((hL x).mpr h) hxnL - rw [if_neg (by simp [hacc])]; rfl + rw [ite_eq_right (by simp [hacc])]; rfl end TM diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/Internal/Seq.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/Internal/Seq.lean index dd63f28216..9f06285e2d 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/Internal/Seq.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/Internal/Seq.lean @@ -63,7 +63,7 @@ theorem seqTM_phase1_step (tm₁ tm₂ : TM n) {c₁ c₁' : Cfg n tm₁.Q} subst hstep show (if (phase1Wrap tm₁ tm₂ c₁).state = (seqTM tm₁ tm₂).qhalt then none else some _) = some _ - simp only [phase1Wrap, seqTM, if_neg Sum.inl_ne_inr, if_neg hne] + simp only [phase1Wrap, seqTM, ite_eq_right Sum.inl_ne_inr, ite_eq_right hne] /-- Multi-step Phase 1 simulation. -/ theorem seqTM_reachesIn_phase1Wrap (tm₁ tm₂ : TM n) {t : ℕ} @@ -89,7 +89,7 @@ theorem seqTM_transition_step (tm₁ tm₂ : TM n) {c₁ : Cfg n tm₁.Q} output := transitionTape c₁.output }) := by show (if (phase1Wrap tm₁ tm₂ c₁).state = (seqTM tm₁ tm₂).qhalt then none else some _) = some _ - simp only [phase1Wrap, seqTM, if_neg Sum.inl_ne_inr, hhalt, ↓reduceIte] + simp only [phase1Wrap, seqTM, ite_eq_right Sum.inl_ne_inr, hhalt, ↓reduceIte] congr 1 -- ════════════════════════════════════════════════════════════════════════ @@ -105,7 +105,7 @@ theorem seqTM_phase2_step (tm₁ tm₂ : TM n) {c₂ c₂' : Cfg n tm₂.Q} subst hstep show (if (phase2Wrap tm₁ tm₂ c₂).state = (seqTM tm₁ tm₂).qhalt then none else some _) = some _ - simp only [phase2Wrap, seqTM, if_neg (Sum.inr_injective.ne hne), if_neg hne] + simp only [phase2Wrap, seqTM, ite_eq_right (Sum.inr_injective.ne hne), ite_eq_right hne] /-- Multi-step Phase 2 simulation. -/ theorem seqTM_reachesIn_phase2Wrap (tm₁ tm₂ : TM n) {t : ℕ} diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/Internal/Union.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/Internal/Union.lean index 1f901ae5ed..f49c6a7159 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/Internal/Union.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/Internal/Union.lean @@ -64,7 +64,7 @@ private theorem idleTape_write_blank : unionIdleTape.write Γ.blank = unionIdleT private theorem idleTape_step_idle : (unionIdleTape.write Γw.blank.toΓ).move (idleDir unionIdleTape.read) = unionIdleTape := by show (unionIdleTape.write Γ.blank).move (idleDir unionIdleTape.read) = unionIdleTape - rw [idleTape_read, idleDir, if_neg (by decide)] + rw [idleTape_read, idleDir, ite_eq_right (by decide)] simp [idleTape_write_blank, Tape.move] -- ════════════════════════════════════════════════════════════════════════ @@ -99,7 +99,7 @@ private theorem unionTM_delta_inl (tm₁ : TM n₁) (tm₂ : TM n₂) {q : tm₁ fun i => if h : i.val < n₁ then r.2.2.2.2.1 ⟨i.val, h⟩ else if i.val = n₁ then r.2.2.2.2.2 else idleDir (wHeads i), idleDir oHead) := by - simp only [unionTM, if_neg hne] + simp only [unionTM, ite_eq_right hne] private theorem unionTM_qhalt (tm₁ : TM n₁) (tm₂ : TM n₂) : (unionTM tm₁ tm₂).qhalt = Sum.inr (Sum.inr tm₂.qhalt) := rfl @@ -115,7 +115,7 @@ private theorem unionTM_delta_inr_inr (tm₁ : TM n₁) (tm₂ : TM n₂) {q : t fun i => if h : i.val ≤ n₁ then idleDir (wHeads i) else r.2.2.2.2.1 ⟨i.val - (n₁ + 1), by omega⟩, r.2.2.2.2.2) := by - simp only [unionTM, if_neg hne] + simp only [unionTM, ite_eq_right hne] private theorem phase1Cfg_state (tm₁ : TM n₁) (tm₂ : TM n₂) (c : Cfg n₁ tm₁.Q) : (unionPhase1Cfg tm₁ tm₂ c).state = Sum.inl c.state := rfl @@ -138,7 +138,7 @@ private theorem phase1_step_corr (tm₁ : TM n₁) (tm₂ : TM n₂) -- Establish that the δ calls produce the same result have hfake_read : (if h : (n₁ : ℕ) < n₁ then c.work ⟨n₁, h⟩ else if (n₁ : ℕ) = n₁ then c.output else unionIdleTape).read = c.output.read := by - rw [dif_neg (Nat.lt_irrefl n₁), if_pos rfl] + rw [dite_eq_right (Nat.lt_irrefl n₁), ite_eq_left rfl] have hwork_reads : (phase1WorkReads fun i : Fin (n₁ + 1 + n₂) => (if h : i.val < n₁ then c.work ⟨i.val, h⟩ else if i.val = n₁ then c.output else unionIdleTape).read) = @@ -187,7 +187,7 @@ private theorem phase1_init_step (tm₁ : TM n₁) (tm₂ : TM n₂) (x : List B (unionTM tm₁ tm₂).step ((unionTM tm₁ tm₂).initCfg x) = some (unionPhase1Cfg tm₁ tm₂ c_mid) := by have hne := state_ne_qhalt_of_step hstep simp only [step] at hstep ⊢ - rw [if_neg hne] at hstep + rw [ite_eq_right hne] at hstep simp only [Option.some.injEq] at hstep subst hstep -- Unfold unionTM qstart/qhalt @@ -197,7 +197,7 @@ private theorem phase1_init_step (tm₁ : TM n₁) (tm₂ : TM n₂) (x : List B apply congrArg some -- Rewrite the unionTM δ call simp only [unionTM_delta_inl tm₁ tm₂ hne] - -- The phase1WorkReads of fixedValue function is a fixedValue function + -- The phase1WorkReads of constant function is a constant function have hwork_reads : phase1WorkReads (fun (_ : Fin (n₁ + 1 + n₂)) => (Tape.init ([] : List Γ)).read) = fun _ => (Tape.init ([] : List Γ)).read := by ext; rfl @@ -241,9 +241,9 @@ theorem unionTM_phase1_simulation (tm₁ : TM n₁) (tm₂ : TM n₂) (x : List private theorem idleDir_stay_of_ge_one (t : Tape) (hhead : t.head ≥ 1) (hno : ∀ i, i ≥ 1 → t.cells i ≠ Γ.start) : idleDir t.read = Dir3.stay := by - rw [idleDir, if_neg]; rw [Tape.read]; exact hno _ hhead + rw [idleDir, ite_eq_right]; rw [Tape.read]; exact hno _ hhead -/-- Input head stays fixedValue when moved by idleDir if head ≥ 1 and cells[≥1] ≠ start. -/ +/-- Input head stays constant when moved by idleDir if head ≥ 1 and cells[≥1] ≠ start. -/ private theorem idle_move_preserves_head (t : Tape) (hhead : t.head ≥ 1) (hno : ∀ i, i ≥ 1 → t.cells i ≠ Γ.start) : (t.move (idleDir t.read)).head = t.head := by @@ -263,7 +263,7 @@ private theorem unionTM_delta_rewindOut_nostart (tm₁ : TM n₁) (tm₂ : TM n .blank, idleDir iHead, fun i => if i.val = n₁ then Dir3.left else idleDir (wHeads i), idleDir oHead ) := by - unfold unionTM; simp only [if_neg hread] + unfold unionTM; simp only [ite_eq_right hread] /-- Delta computation for rewindOut when fake output is at start. -/ private theorem unionTM_delta_rewindOut_start (tm₁ : TM n₁) (tm₂ : TM n₂) @@ -274,7 +274,7 @@ private theorem unionTM_delta_rewindOut_start (tm₁ : TM n₁) (tm₂ : TM n₂ fun _ => .blank, .blank, idleDir iHead, fun i => if i.val = n₁ then Dir3.right else idleDir (wHeads i), idleDir oHead ) := by - unfold unionTM; simp only [if_pos hread] + unfold unionTM; simp only [ite_eq_left hread] /-- Delta computation for checkResult when fake output reads Γ.one. -/ private theorem unionTM_delta_checkResult_one (tm₁ : TM n₁) (tm₂ : TM n₂) @@ -285,7 +285,7 @@ private theorem unionTM_delta_checkResult_one (tm₁ : TM n₁) (tm₂ : TM n₂ fun _ => .blank, .one, idleDir iHead, fun i => idleDir (wHeads i), idleDir oHead ) := by - unfold unionTM; simp only [if_pos hread] + unfold unionTM; simp only [ite_eq_left hread] /-- Delta computation for checkResult when fake output does not read Γ.one. -/ private theorem unionTM_delta_checkResult_notone (tm₁ : TM n₁) (tm₂ : TM n₂) @@ -293,7 +293,7 @@ private theorem unionTM_delta_checkResult_notone (tm₁ : TM n₁) (tm₂ : TM n (hread : wHeads fakeOutIdx ≠ Γ.one) : (unionTM tm₁ tm₂).δ (Sum.inr (Sum.inl UnionPhase.checkResult)) iHead wHeads oHead = allIdle (Sum.inr (Sum.inl UnionPhase.rewindIn)) iHead wHeads oHead := by - unfold unionTM; simp only [if_neg hread] + unfold unionTM; simp only [ite_eq_right hread] /-- Delta computation for rewindIn when input is not at start. -/ private theorem unionTM_delta_rewindIn_nostart (tm₁ : TM n₁) (tm₂ : TM n₂) @@ -304,7 +304,7 @@ private theorem unionTM_delta_rewindIn_nostart (tm₁ : TM n₁) (tm₂ : TM n fun _ => .blank, .blank, Dir3.left, fun i => idleDir (wHeads i), idleDir oHead ) := by - simp only [unionTM, if_neg hread] + simp only [unionTM, ite_eq_right hread] /-- Delta computation for rewindIn when input is at start. -/ private theorem unionTM_delta_rewindIn_start (tm₁ : TM n₁) (tm₂ : TM n₂) @@ -315,7 +315,7 @@ private theorem unionTM_delta_rewindIn_start (tm₁ : TM n₁) (tm₂ : TM n₂) fun _ => .blank, .blank, Dir3.right, fun i => idleDir (wHeads i), idleDir oHead ) := by - simp only [unionTM, if_pos hread] + simp only [unionTM, ite_eq_left hread] /-- Delta computation for setup2. -/ private theorem unionTM_delta_setup2 (tm₁ : TM n₁) (tm₂ : TM n₂) @@ -369,7 +369,7 @@ private theorem step_rewindOut_nostart_cfg (tm₁ : TM n₁) (tm₂ : TM n₂) ((if i.val = n₁ then readBackWrite (c.work fakeOutIdx).read else .blank) : Γw).toΓ).move (if i.val = n₁ then Dir3.left else idleDir (c.work i).read), output := (c.output.write Γw.blank.toΓ).move (idleDir c.output.read) } := by - simp only [step]; rw [hstate]; simp only [unionTM, if_neg hread]; rfl + simp only [step]; rw [hstate]; simp only [unionTM, ite_eq_right hread]; rfl /-- Step the union machine from a rewindOut state when fake output reads start. -/ private theorem step_rewindOut_start_cfg (tm₁ : TM n₁) (tm₂ : TM n₂) @@ -382,7 +382,7 @@ private theorem step_rewindOut_start_cfg (tm₁ : TM n₁) (tm₂ : TM n₂) work := fun i => ((c.work i).write (Γw.blank : Γw).toΓ).move (if i.val = n₁ then Dir3.right else idleDir (c.work i).read), output := (c.output.write Γw.blank.toΓ).move (idleDir c.output.read) } := by - simp only [step]; rw [hstate]; simp only [unionTM, if_pos hread]; rfl + simp only [step]; rw [hstate]; simp only [unionTM, ite_eq_left hread]; rfl /-- Step the union machine from checkResult with Γ.one → halted. -/ private theorem step_checkResult_one_cfg (tm₁ : TM n₁) (tm₂ : TM n₂) @@ -394,7 +394,7 @@ private theorem step_checkResult_one_cfg (tm₁ : TM n₁) (tm₂ : TM n₂) input := c.input.move (idleDir c.input.read), work := fun i => ((c.work i).write (Γw.blank : Γw).toΓ).move (idleDir (c.work i).read), output := (c.output.write Γw.one.toΓ).move (idleDir c.output.read) } := by - simp only [step]; rw [hstate]; simp only [unionTM, if_pos hread]; rfl + simp only [step]; rw [hstate]; simp only [unionTM, ite_eq_left hread]; rfl /-- Step the union machine from checkResult when not Γ.one → rewindIn (allIdle). -/ private theorem step_checkResult_notone_cfg (tm₁ : TM n₁) (tm₂ : TM n₂) @@ -406,7 +406,7 @@ private theorem step_checkResult_notone_cfg (tm₁ : TM n₁) (tm₂ : TM n₂) input := c.input.move (idleDir c.input.read), work := fun i => ((c.work i).write (Γw.blank : Γw).toΓ).move (idleDir (c.work i).read), output := (c.output.write Γw.blank.toΓ).move (idleDir c.output.read) } := by - simp only [step]; rw [hstate]; simp only [unionTM, if_neg hread, allIdle]; rfl + simp only [step]; rw [hstate]; simp only [unionTM, ite_eq_right hread, allIdle]; rfl /-- Step the union machine from rewindIn with non-start input. -/ private theorem step_rewindIn_nostart_cfg (tm₁ : TM n₁) (tm₂ : TM n₂) @@ -418,7 +418,7 @@ private theorem step_rewindIn_nostart_cfg (tm₁ : TM n₁) (tm₂ : TM n₂) input := c.input.move Dir3.left, work := fun i => ((c.work i).write (Γw.blank : Γw).toΓ).move (idleDir (c.work i).read), output := (c.output.write Γw.blank.toΓ).move (idleDir c.output.read) } := by - simp only [step]; rw [hstate]; simp only [unionTM, if_neg hread]; rfl + simp only [step]; rw [hstate]; simp only [unionTM, ite_eq_right hread]; rfl /-- Step the union machine from rewindIn when input reads start. -/ private theorem step_rewindIn_start_cfg (tm₁ : TM n₁) (tm₂ : TM n₂) @@ -430,7 +430,7 @@ private theorem step_rewindIn_start_cfg (tm₁ : TM n₁) (tm₂ : TM n₂) input := c.input.move Dir3.right, work := fun i => ((c.work i).write (Γw.blank : Γw).toΓ).move (idleDir (c.work i).read), output := (c.output.write Γw.blank.toΓ).move (idleDir c.output.read) } := by - simp only [step]; rw [hstate]; simp only [unionTM, if_pos hread]; rfl + simp only [step]; rw [hstate]; simp only [unionTM, ite_eq_left hread]; rfl /-- Step the union machine from setup2. -/ private theorem step_setup2_cfg (tm₁ : TM n₁) (tm₂ : TM n₂) @@ -650,7 +650,7 @@ theorem unionTM_transition_accept (tm₁ : TM n₁) (tm₂ : TM n₂) -- c_cr fake output cells preserved (write blank at head 0 is no-op) have hcr_fo_cells : (c_cr.work fakeOutIdx).cells = (c_at0.work fakeOutIdx).cells := by simp only [hc_cr_def, show (fakeOutIdx : Fin (n₁ + 1 + n₂)).val = n₁ from rfl, ite_true] - rw [Tape.move_cells]; simp only [Tape.write, if_pos hhead_at0] + rw [Tape.move_cells]; simp only [Tape.write, ite_eq_left hhead_at0] -- c_cr fake output reads cell 1 = Γ.one have hcr_read : (c_cr.work fakeOutIdx).read = Γ.one := by rw [Tape.read, hcr_fo_head, hcr_fo_cells, hcells_at0, hcells_rw]; exact haccept @@ -782,10 +782,10 @@ private theorem phase2_work_step_idle (tm₁ : TM n₁) (tm₂ : TM n₂) congr 1 · congr 1 show (if h : (i : ℕ) < n₁ then _ else if (i : ℕ) = n₁ then _ else Γw.blank) = Γw.blank - rw [dif_neg (show ¬((i : ℕ) < n₁) from by omega), if_neg hine] + rw [dite_eq_right (show ¬((i : ℕ) < n₁) from by omega), ite_eq_right hine] · show (if h : (i : ℕ) < n₁ then _ else if (i : ℕ) = n₁ then _ else idleDir (c.work i).read) = _ - rw [dif_neg (show ¬((i : ℕ) < n₁) from by omega), if_neg hine] + rw [dite_eq_right (show ¬((i : ℕ) < n₁) from by omega), ite_eq_right hine] · rw [hq]; dsimp only [unionTM]; split · congr 1; simp only [hine, ↓reduceIte] · congr 1 @@ -893,7 +893,7 @@ theorem unionTM_transition_reject (tm₁ : TM n₁) (tm₂ : TM n₂) (x : List simp only [Tape.write, hhead_at0, ↓reduceIte, Tape.move] have hcr_fo_cells : (c_cr.work fakeOutIdx).cells = (c_at0.work fakeOutIdx).cells := by simp only [hc_cr_def, show (fakeOutIdx : Fin (n₁ + 1 + n₂)).val = n₁ from rfl, ite_true] - rw [Tape.move_cells]; simp only [Tape.write, if_pos hhead_at0] + rw [Tape.move_cells]; simp only [Tape.write, ite_eq_left hhead_at0] have hcr_read_ne_one : (c_cr.work fakeOutIdx).read ≠ Γ.one := by rw [Tape.read, hcr_fo_head, hcr_fo_cells, hcells_at0, hcells_rw, hreject]; decide -- Step 4: checkResult ≠ Γ.one → rewindIn (1 step) @@ -1011,7 +1011,7 @@ theorem unionTM_transition_reject (tm₁ : TM n₁) (tm₂ : TM n₂) (x : List -- c_mid.input.head = 0 (moveLeftDir of non-start = left, from head 1 → 0) have h1 : c_mid.input.head = 0 := by show (c_s2.input.move (moveLeftDir c_s2.input.read)).head = 0 - rw [moveLeftDir, if_neg hs2_read_ne]; simp [Tape.move, hs2_head] + rw [moveLeftDir, ite_eq_right hs2_read_ne]; simp [Tape.move, hs2_head] -- Combine have hcfg : ∀ (a b : Tape), a.head = b.head → a.cells = b.cells → a = b := by intros a b hh hc; cases a; cases b; simp only [Tape.mk.injEq] at *; exact ⟨hh, hc⟩ @@ -1056,7 +1056,7 @@ theorem unionTM_transition_reject (tm₁ : TM n₁) (tm₂ : TM n₂) (x : List intro j show ((c_at0.work ⟨n₁ + 1 + j.val, by omega⟩).write _).move (if (n₁ + 1 + j.val) = n₁ then _ else _) = _ - rw [if_neg (show n₁ + 1 + j.val ≠ n₁ from by omega), hwork_at0_idle j] + rw [ite_eq_right (show n₁ + 1 + j.val ≠ n₁ from by omega), hwork_at0_idle j] exact idleTape_step_idle -- Step 4 (checkResult→rewindIn): c_ri.work at > n₁ = unionIdleTape have hwork_ri_idle : ∀ (j : Fin n₂), @@ -1085,7 +1085,7 @@ theorem unionTM_transition_reject (tm₁ : TM n₁) (tm₂ : TM n₂) (x : List intro j show ((c_s2.work ⟨n₁ + 1 + j.val, by omega⟩).write _).move (if (n₁ + 1 + j.val) ≤ n₁ then _ else _) = _ - rw [if_neg (show ¬(n₁ + 1 + j.val ≤ n₁) from by omega), hwork_s2_idle j] + rw [ite_eq_right (show ¬(n₁ + 1 + j.val ≤ n₁) from by omega), hwork_s2_idle j] exact idleTape_moveLeft -- Compose all reachesIn steps have hreach_total : (unionTM tm₁ tm₂).reachesIn @@ -1135,7 +1135,7 @@ theorem unionTM_transition_reject (tm₁ : TM n₁) (tm₂ : TM n₂) (x : List by_cases hh : c₁.input.head = 0 · have hread0 : c₁.input.read = Γ.start := by rw [Tape.read, hh, hinput_cells]; simp [Tape.init] - rw [hread0, idleDir, if_pos rfl]; simp [Tape.move, hh] + rw [hread0, idleDir, ite_eq_left rfl]; simp [Tape.move, hh] · have hge : c₁.input.head ≥ 1 := by omega have hc1_ino : ∀ i, i ≥ 1 → c₁.input.cells i ≠ Γ.start := by intro i hi; rw [← hcrw_cells]; exact hcrw_ino i hi @@ -1193,7 +1193,7 @@ private theorem phase2_step_corr (tm₁ : TM n₁) (tm₂ : TM n₂) have hne_u : c_u.state ≠ (unionTM tm₁ tm₂).qhalt := by rw [hcompat.state_eq, unionTM_qhalt]; exact fun h => hne (Sum.inr.inj (Sum.inr.inj h)) -- Unfold the union step; `split` reduces the halting ite (the stored - -- decidability instance blocks `simp`/`rw [if_neg]` here), then pin the + -- decidability instance blocks `simp`/`rw [ite_eq_right]` here), then pin the -- explicit step-result config as the existential witness via `rfl`. simp only [step] split @@ -1208,11 +1208,11 @@ private theorem phase2_step_corr (tm₁ : TM n₁) (tm₂ : TM n₂) refine ⟨?_, ?_, fun ⟨j, hj⟩ => ?_, ?_⟩ <;> dsimp only [] <;> rw [hcompat.state_eq] <;> simp only [unionTM_delta_inr_inr tm₁ tm₂ hne, hcompat.input_eq, hcompat.output_eq, hwork_reads] have hgt : ¬((n₁ + 1 + j) ≤ n₁) := by omega - rw [dif_neg hgt] + rw [dite_eq_right hgt] have hfin : ∀ (p : n₁ + 1 + j - (n₁ + 1) < n₂), (⟨n₁ + 1 + j - (n₁ + 1), p⟩ : Fin n₂) = ⟨j, hj⟩ := by intro p; apply Fin.ext; show n₁ + 1 + j - (n₁ + 1) = j; omega - simp only [hfin, hcompat.work_eq ⟨j, hj⟩, dif_neg hgt] + simp only [hfin, hcompat.work_eq ⟨j, hj⟩, dite_eq_right hgt] -- ════════════════════════════════════════════════════════════════════════ -- Phase 2 simulation diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/WorkBranch/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/WorkBranch/Internal.lean index a256d701d1..5f397e2a99 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/WorkBranch/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/WorkBranch/Internal.lean @@ -76,12 +76,12 @@ theorem branchWorkBlankTM_blank_step_internal (workBranchBlankWrap idx onBlank onNonblank c) = some (workBranchBlankWrap idx onBlank onNonblank c') := by have hne : c.state ≠ onBlank.qhalt := state_ne_qhalt_of_step hstep - rw [TM.step, if_neg (by + rw [TM.step, ite_eq_right (by simp [workBranchBlankWrap, workBranchBlankState, branchWorkBlankTM, hne])] simp only [workBranchBlankWrap, workBranchBlankState, hne, ↓reduceIte, branchWorkBlankTM] - rw [TM.step, if_neg hne] at hstep + rw [TM.step, ite_eq_right hne] at hstep revert hstep generalize haction : onBlank.δ c.state c.input.read (fun i => (c.work i).read) c.output.read = action @@ -98,12 +98,12 @@ theorem branchWorkBlankTM_nonblank_step_internal (workBranchNonblankWrap idx onBlank onNonblank c) = some (workBranchNonblankWrap idx onBlank onNonblank c') := by have hne : c.state ≠ onNonblank.qhalt := state_ne_qhalt_of_step hstep - rw [TM.step, if_neg (by + rw [TM.step, ite_eq_right (by simp [workBranchNonblankWrap, workBranchNonblankState, branchWorkBlankTM, hne])] simp only [workBranchNonblankWrap, workBranchNonblankState, hne, ↓reduceIte, branchWorkBlankTM] - rw [TM.step, if_neg hne] at hstep + rw [TM.step, ite_eq_right hne] at hstep revert hstep generalize haction : onNonblank.δ c.state c.input.read (fun i => (c.work i).read) c.output.read = action @@ -151,7 +151,7 @@ theorem branchWorkBlankTM_dispatch_blank_internal input := inp work := work output := out }) := by - rw [TM.step, if_neg (by simp [branchWorkBlankTM])] + rw [TM.step, ite_eq_right (by simp [branchWorkBlankTM])] simp only [branchWorkBlankTM, hblank, allReadBack, ↓reduceIte, workBranchBlankWrap] refine congrArg some (Cfg.ext rfl ?_ ?_ ?_) @@ -176,7 +176,7 @@ theorem branchWorkBlankTM_dispatch_nonblank_internal input := inp work := work output := out }) := by - rw [TM.step, if_neg (by simp [branchWorkBlankTM])] + rw [TM.step, ite_eq_right (by simp [branchWorkBlankTM])] simp only [branchWorkBlankTM, hnonblank, allReadBack, ↓reduceIte, workBranchNonblankWrap] refine congrArg some (Cfg.ext rfl ?_ ?_ ?_) diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/WorkSymbolBranch/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/WorkSymbolBranch/Internal.lean index 4e785f3510..635b8c5fc3 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/WorkSymbolBranch/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/WorkSymbolBranch/Internal.lean @@ -72,12 +72,12 @@ private theorem branchWorkSymbolTM_equal_step (workSymbolEqualWrap idx symbol onEqual onDifferent c) = some (workSymbolEqualWrap idx symbol onEqual onDifferent c') := by have hne : c.state ≠ onEqual.qhalt := state_ne_qhalt_of_step hstep - rw [TM.step, if_neg (by + rw [TM.step, ite_eq_right (by simp [workSymbolEqualWrap, workBranchBlankState, branchWorkSymbolTM, hne])] simp only [workSymbolEqualWrap, workBranchBlankState, hne, ↓reduceIte, branchWorkSymbolTM] - rw [TM.step, if_neg hne] at hstep + rw [TM.step, ite_eq_right hne] at hstep revert hstep generalize haction : onEqual.δ c.state c.input.read (fun i => (c.work i).read) c.output.read = action @@ -94,12 +94,12 @@ private theorem branchWorkSymbolTM_different_step (workSymbolDifferentWrap idx symbol onEqual onDifferent c) = some (workSymbolDifferentWrap idx symbol onEqual onDifferent c') := by have hne : c.state ≠ onDifferent.qhalt := state_ne_qhalt_of_step hstep - rw [TM.step, if_neg (by + rw [TM.step, ite_eq_right (by simp [workSymbolDifferentWrap, workBranchNonblankState, branchWorkSymbolTM, hne])] simp only [workSymbolDifferentWrap, workBranchNonblankState, hne, ↓reduceIte, branchWorkSymbolTM] - rw [TM.step, if_neg hne] at hstep + rw [TM.step, ite_eq_right hne] at hstep revert hstep generalize haction : onDifferent.δ c.state c.input.read (fun i => (c.work i).read) c.output.read = action @@ -143,7 +143,7 @@ private theorem branchWorkSymbolTM_dispatch_equal output := out } = some (workSymbolEqualWrap idx symbol onEqual onDifferent { state := onEqual.qstart, input := inp, work := work, output := out }) := by - rw [TM.step, if_neg (by simp [branchWorkSymbolTM])] + rw [TM.step, ite_eq_right (by simp [branchWorkSymbolTM])] simp only [branchWorkSymbolTM, hequal, allReadBack, ↓reduceIte, workSymbolEqualWrap] refine congrArg some (Cfg.ext rfl ?_ ?_ ?_) @@ -166,7 +166,7 @@ private theorem branchWorkSymbolTM_dispatch_different some (workSymbolDifferentWrap idx symbol onEqual onDifferent { state := onDifferent.qstart, input := inp, work := work, output := out }) := by - rw [TM.step, if_neg (by simp [branchWorkSymbolTM])] + rw [TM.step, ite_eq_right (by simp [branchWorkSymbolTM])] simp only [branchWorkSymbolTM, hdifferent, allReadBack, ↓reduceIte, workSymbolDifferentWrap] refine congrArg some (Cfg.ext rfl ?_ ?_ ?_) diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Composition/PairWithInput.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Composition/PairWithInput.lean index 9bbd4b304b..0f8594a2ad 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Composition/PairWithInput.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Composition/PairWithInput.lean @@ -30,7 +30,7 @@ namespace TM variable {nf : ℕ} /-- Pairing a computed string with the unchanged original input costs at most -five source-time budgets, one linear input scan, and fixedValue seam overhead. -/ +five source-time budgets, one linear input scan, and constant seam overhead. -/ theorem pairWithInputTM_computesInTime {tmF : TM nf} {f : List Bool → List Bool} {T : ℕ → ℕ} (hcomp : tmF.ComputesInTime f T) : diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Internal.lean index 37454e61db..0f66da8b51 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Internal.lean @@ -348,7 +348,7 @@ private theorem tape_cell0_preserved (t : Tape) (s : Γ) (d : Dir3) rw [Tape.move_cells]; simp only [Tape.write] split · exact h0 - · simp only [Function.update, dif_neg (show (0 : ℕ) ≠ t.head from fun h => by omega)] + · simp only [Function.update, dite_eq_right (show (0 : ℕ) ≠ t.head from fun h => by omega)] exact h0 /-- Cells ≥ 1 stay non-Γ.start after writing a non-Γ.start value. -/ @@ -513,7 +513,7 @@ theorem input_cells_trace (tm : NTM n) (T : ℕ) | succ T ih => by_cases hhalt : c.state = tm.qhalt · simp [NTM.trace, hhalt] - · simp only [NTM.trace, hhalt, if_false] + · simp only [NTM.trace, hhalt, ite_false] rw [ih] cases (tm.δ (choices ⟨0, Nat.zero_lt_succ T⟩) c.state c.input.read (fun i => (c.work i).read) c.output.read).2.2.2.1 <;> rfl @@ -528,7 +528,7 @@ theorem input_head_trace_le (tm : NTM n) (T : ℕ) | succ T ih => by_cases hhalt : c.state = tm.qhalt · simp [NTM.trace, hhalt] - · simp only [NTM.trace, hhalt, if_false] + · simp only [NTM.trace, hhalt, ite_false] let b := choices ⟨0, Nat.zero_lt_succ T⟩ let tr := tm.δ b c.state c.input.read (fun i => (c.work i).read) c.output.read let c' : Cfg n tm.Q := @@ -556,7 +556,7 @@ theorem work_head_trace_le (tm : NTM n) (T : ℕ) | succ T ih => by_cases hhalt : c.state = tm.qhalt · simp [NTM.trace, hhalt] - · simp only [NTM.trace, hhalt, if_false] + · simp only [NTM.trace, hhalt, ite_false] let b := choices ⟨0, Nat.zero_lt_succ T⟩ let tr := tm.δ b c.state c.input.read (fun j => (c.work j).read) c.output.read let c' : Cfg n tm.Q := @@ -580,7 +580,7 @@ theorem output_head_trace_le (tm : NTM n) (T : ℕ) | succ T ih => by_cases hhalt : c.state = tm.qhalt · simp [NTM.trace, hhalt] - · simp only [NTM.trace, hhalt, if_false] + · simp only [NTM.trace, hhalt, ite_false] let b := choices ⟨0, Nat.zero_lt_succ T⟩ let tr := tm.δ b c.state c.input.read (fun i => (c.work i).read) c.output.read let c' : Cfg n tm.Q := diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Lift.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Lift.lean index 1fde94780a..c9638b0cc3 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Lift.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Lift.lean @@ -72,7 +72,7 @@ private theorem dummy_writeAndMove (w : Tape) have hr : w.read = Γ.blank := by rw [hread, h1]; rfl rw [hr] show w.write (readBackWrite Γ.blank).toΓ = (Tape.init []).move Dir3.right - rw [Tape.write, if_neg (show ¬ w.head = 0 by omega), h1, hc] + rw [Tape.write, ite_eq_right (show ¬ w.head = 0 by omega), h1, hc] rw [show (readBackWrite Γ.blank).toΓ = (Tape.init []).cells 1 from rfl, Function.update_eq_self] rfl @@ -140,7 +140,7 @@ theorem liftCfg_work_lt (tm : TM n) (m : ℕ) (c : Cfg n tm.Q) theorem liftCfg_work_ge (tm : TM n) (m : ℕ) (c : Cfg n tm.Q) (i : Fin (n + m)) (h : n ≤ i.val) : (tm.liftCfg m c).work i = (Tape.init []).move Dir3.right := - dif_neg (Nat.not_lt.mpr h) + dite_eq_right (Nat.not_lt.mpr h) /-- **Unified step commutation** for `liftTM`. If the extra work tapes of `C` are blank with head at cell 0 or 1 and the rest of `C` matches `c`, @@ -173,13 +173,13 @@ private theorem liftTM_step_of_extras (tm : TM n) (m : ℕ) {c : Cfg n tm.Q} funext fun i => by rw [hw (Fin.castAdd m i) i.isLt]; rfl simp only [step, Option.map_some] dsimp only [liftTM, liftCfg] - rw [hs, hi, ho, hinner, if_neg hh] + rw [hs, hi, ho, hinner, ite_eq_right hh] refine congrArg some (Cfg.mk.injEq _ _ _ _ _ _ _ _ |>.mpr ⟨rfl, rfl, ?_, rfl⟩) funext i by_cases hik : i.val < n · rw [hw i hik, dif_pos hik, dif_pos hik, dif_pos hik] · have hdi := hd i (Nat.le_of_not_lt hik) - rw [dif_neg hik, dif_neg hik, dif_neg hik] + rw [dite_eq_right hik, dite_eq_right hik, dite_eq_right hik] exact dummy_writeAndMove (C.work i) hdi.1 hdi.2 /-- **Step commutation** on embedded configurations: once the extra tapes @@ -418,7 +418,7 @@ theorem retargetCfg_work_lt (tm : TM n) (c : Cfg n tm.Q) /-- `retargetCfg` maps the last work tape to `c`'s output tape. -/ theorem retargetCfg_work_last (tm : TM n) (c : Cfg n tm.Q) : - (tm.retargetCfg c).work (Fin.last n) = c.output := dif_neg (Nat.lt_irrefl n) + (tm.retargetCfg c).work (Fin.last n) = c.output := dite_eq_right (Nat.lt_irrefl n) /-- **Unified step commutation** for `retargetOutput`: if `C`'s real output tape is blank with head at cell 0 or 1, work tape `n` matches @@ -452,7 +452,7 @@ private theorem retargetOutput_step_of_extras (tm : TM n) {c : Cfg n tm.Q} have hvirt : (C.work (Fin.last n)).read = c.output.read := by rw [hlast] simp only [step, Option.map_some] dsimp only [retargetOutput, retargetCfg] - rw [hs, hi, hinner, hvirt, if_neg hh] + rw [hs, hi, hinner, hvirt, ite_eq_right hh] refine congrArg some (Cfg.mk.injEq _ _ _ _ _ _ _ _ |>.mpr ⟨rfl, rfl, ?_, ?_⟩) · funext i by_cases hik : i.val < n @@ -462,7 +462,7 @@ private theorem retargetOutput_step_of_extras (tm : TM n) {c : Cfg n tm.Q} have := i.isLt simp only [Fin.val_last] omega - rw [dif_neg hik, dif_neg hik, dif_neg hik, hi_last, hlast] + rw [dite_eq_right hik, dite_eq_right hik, dite_eq_right hik, hi_last, hlast] · exact dummy_writeAndMove C.output ho.1 ho.2 /-- **Step commutation** on embedded configurations: once the real output diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Placement/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Placement/Internal.lean index d22a843397..8b1a4aa903 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Placement/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Placement/Internal.lean @@ -45,7 +45,7 @@ private theorem placeWorkFrameStep_blank (t : Tape) · have hr : t.read = Γ.blank := by rw [hread, h1]; rfl rw [hr] show t.write (readBackWrite Γ.blank) = (Tape.init []).move Dir3.right - rw [Tape.write, if_neg (show ¬t.head = 0 by omega), h1, hcells] + rw [Tape.write, ite_eq_right (show ¬t.head = 0 by omega), h1, hcells] rw [show (readBackWrite Γ.blank).toΓ = (Tape.init []).cells 1 from rfl, Function.update_eq_self] rfl diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Registers.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Registers.lean index 95e5a25818..5ffcb87605 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Registers.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Registers.lean @@ -62,7 +62,7 @@ theorem Parked.writeAndMove_readBack_idle {t : Tape} (h : Parked t) : /-- A parked tape's head does not move under `idleDir`. -/ theorem Parked.move_idle {t : Tape} (h : Parked t) : t.move (idleDir t.read) = t := by - rw [idleDir, if_neg h.read_ne_start] + rw [idleDir, ite_eq_right h.read_ne_start] rfl /-- Parked tapes pass through combinator phase boundaries unchanged. -/ @@ -124,8 +124,8 @@ theorem read_eq {v : ℕ} {t : Tape} (h : IsReg v t) : t.read = if v = 0 then Γ.blank else Γ.one := by rw [Tape.read, h.head_eq] rcases Nat.eq_zero_or_pos v with rfl | hv - · rw [if_pos rfl]; exact h.cells_blank (le_refl _) - · rw [if_neg (by omega)]; exact h.cells_one hv + · rw [ite_eq_left rfl]; exact h.cells_blank (le_refl _) + · rw [ite_eq_right (by omega)]; exact h.cells_one hv end IsReg @@ -134,7 +134,7 @@ theorem reg_zero_init_bumped : IsReg 0 { head := 1, cells := (Tape.init []).cell refine ⟨rfl, by simp [Tape.init], fun _ hi => by omega, fun j hj => ?_⟩ show (Tape.init []).cells j = Γ.blank simp only [Tape.init] - rw [if_neg (by omega : ¬ j = 0)] + rw [ite_eq_right (by omega : ¬ j = 0)] simp -- ════════════════════════════════════════════════════════════════════════ @@ -159,16 +159,16 @@ def regTape (v : ℕ) : Tape := ⟨1, regCells v⟩ /-- Cells `1..v` of the canonical register cells for `v` hold `1`. -/ theorem regCells_one {v j : ℕ} (h1 : 1 ≤ j) (h2 : j ≤ v) : regCells v j = Γ.one := by - rw [regCells, if_neg (by omega), if_pos h2] + rw [regCells, ite_eq_right (by omega), ite_eq_left h2] /-- Cells beyond position `v` of the canonical register cells for `v` are blank. -/ theorem regCells_blank {v j : ℕ} (h : v + 1 ≤ j) : regCells v j = Γ.blank := by - rw [regCells, if_neg (by omega), if_neg (by omega)] + rw [regCells, ite_eq_right (by omega), ite_eq_right (by omega)] /-- Register cells away from the sentinel are never `▷`. -/ theorem regCells_ne_start {v j : ℕ} (hj : 1 ≤ j) : regCells v j ≠ Γ.start := by - rw [regCells, if_neg (by omega)] + rw [regCells, ite_eq_right (by omega)] split <;> decide /-- The canonical register tape `regTape v` satisfies `IsReg v`. -/ diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Registers/Arith.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Registers/Arith.lean index 4e51680472..d2eb28d363 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Registers/Arith.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Registers/Arith.lean @@ -235,7 +235,7 @@ theorem mulAddIntoTM_hoareTime (src₁ src₂ dst : Fin n) exact h) -- ════════════════════════════════════════════════════════════════════════ --- Iterated machines (fixedValue-building) +-- Iterated machines (constant-building) -- ════════════════════════════════════════════════════════════════════════ /-- Run `m` in sequence `c` times. -/ @@ -243,7 +243,7 @@ def iterTM (m : TM n) : ℕ → TM n | 0 => skipTM | c + 1 => seqTM m (iterTM m c) -/-- **Iterated increment**: add the fixedValue `c` to register `q`. -/ +/-- **Iterated increment**: add the constant `c` to register `q`. -/ theorem iterTM_incRegTM_hoareTime (q : Fin n) (c : ℕ) : ∀ (d : ℕ) (inp₀ : Tape) (work₀ : Fin n → Tape) (ys : List Bool), Parked inp₀ → (∀ i, Parked (work₀ i)) → work₀ q = regTape d → diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Registers/Emit.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Registers/Emit.lean index d3ce04db04..d36fd0e229 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Registers/Emit.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Registers/Emit.lean @@ -114,7 +114,7 @@ theorem outAcc_nil_init : OutAcc [] { head := 1, cells := (Tape.init []).cells } refine ⟨rfl, by simp [Tape.init], fun i hi => absurd hi (by simp), fun j hj => ?_⟩ show (Tape.init []).cells j = Γ.blank simp only [Tape.init] - rw [if_neg (by omega : ¬ j = 0)] + rw [ite_eq_right (by omega : ¬ j = 0)] simp /-- **Appending one bit.** Writing `Γ.ofBool b` at the accumulator head and @@ -128,12 +128,12 @@ theorem outAcc_append_bit {ys : List Bool} {out : Tape} (h : OutAcc ys out) (b : show ((out.write _).move _).cells = _ rw [Tape.move] show (out.write _).cells = _ - rw [Tape.write, if_neg hne, hhead] + rw [Tape.write, ite_eq_right hne, hhead] have hhead' : (out.writeAndMove (Γ.ofBool b) .right).head = out.head + 1 := by show ((out.write _).move _).head = _ rw [Tape.move] show (out.write _).head + 1 = _ - rw [Tape.write, if_neg hne] + rw [Tape.write, ite_eq_right hne] refine ⟨?_, ?_, ?_, ?_⟩ · rw [hhead', hhead]; simp · rw [hcells, Function.update_of_ne (by omega : ¬ (0 : ℕ) = ys.length + 1)] @@ -187,7 +187,7 @@ theorem parked_init_input (x : List Bool) : refine ⟨le_refl 1, fun j hj => ?_⟩ show (Tape.init (x.map Γ.ofBool)).cells j ≠ Γ.start simp only [Tape.init] - rw [if_neg (by omega : ¬ j = 0)] + rw [ite_eq_right (by omega : ¬ j = 0)] cases h : (x.map Γ.ofBool)[j - 1]? with | none => decide | some g => @@ -250,7 +250,7 @@ private theorem emitBitsTM_step (w : List Bool) (c : Cfg n (emitBitsTM (n := n) rw [hst] simp only [emitBitsTM, Fin.mk.injEq] omega - rw [TM.step, if_neg hne] + rw [TM.step, ite_eq_right hne] simp only [emitBitsTM, hst, hk, ↓reduceDIte] refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, ?_, ?_, ?_⟩) · exact hinp.move_idle @@ -408,33 +408,33 @@ def emitUnaryTM (r : Fin n) : TM n where dsimp only [] by_cases hir : i = r · subst hir; rw [hone] at hi; exact absurd hi (by decide) - · rw [if_neg hir]; exact idleDir_right_of_start hi + · rw [ite_eq_right hir]; exact idleDir_right_of_start hi · next hnone => refine ⟨idleDir_right_of_start, fun i hi => ?_, idleDir_right_of_start⟩ dsimp only [] by_cases hir : i = r - · subst hir; rw [if_pos rfl, if_pos hi] - · rw [if_neg hir]; exact idleDir_right_of_start hi + · subst hir; rw [ite_eq_left rfl, ite_eq_left hi] + · rw [ite_eq_right hir]; exact idleDir_right_of_start hi | .emitB => refine ⟨idleDir_right_of_start, fun i hi => ?_, fun _ => rfl⟩ dsimp only [] by_cases hir : i = r - · rw [if_pos hir] - · rw [if_neg hir]; exact idleDir_right_of_start hi + · rw [ite_eq_left hir] + · rw [ite_eq_right hir]; exact idleDir_right_of_start hi | .back => dsimp only [] split · refine ⟨idleDir_right_of_start, fun i hi => ?_, idleDir_right_of_start⟩ dsimp only [] by_cases hir : i = r - · rw [if_pos hir] - · rw [if_neg hir]; exact idleDir_right_of_start hi + · rw [ite_eq_left hir] + · rw [ite_eq_right hir]; exact idleDir_right_of_start hi · next hns => refine ⟨idleDir_right_of_start, fun i hi => ?_, idleDir_right_of_start⟩ dsimp only [] by_cases hir : i = r · subst hir; exact absurd hi hns - · rw [if_neg hir]; exact idleDir_right_of_start hi + · rw [ite_eq_right hir]; exact idleDir_right_of_start hi | .park => exact ⟨idleDir_right_of_start, fun _ => idleDir_right_of_start, idleDir_right_of_start⟩ @@ -459,16 +459,16 @@ private theorem emitUnaryTM_step_emitA_one (c : Cfg n (emitUnaryTM (n := n) r).Q (emitUnaryTM (n := n) r).step c = some { state := .emitB, input := c.input, work := c.work, output := c.output.writeAndMove (Γ.ofBool true) .right } := by - rw [TM.step, if_neg (emitUnaryTM_ne_halt (by decide) hst)] + rw [TM.step, ite_eq_right (emitUnaryTM_ne_halt (by decide) hst)] simp only [emitUnaryTM, hst, hone, ↓reduceIte] refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, ?_, ?_, ?_⟩) · exact hinp.move_idle · funext i by_cases hir : i = r · subst hir - rw [if_pos rfl, writeAndMove_readBack _ (by rw [hone]; decide)] + rw [ite_eq_left rfl, writeAndMove_readBack _ (by rw [hone]; decide)] rfl - · rw [if_neg hir] + · rw [ite_eq_right hir] exact (hwork i hir).writeAndMove_readBack_idle · rfl @@ -480,16 +480,16 @@ private theorem emitUnaryTM_step_emitB (c : Cfg n (emitUnaryTM (n := n) r).Q) { state := .emitA, input := c.input, work := Function.update c.work r ((c.work r).move .right), output := c.output.writeAndMove (Γ.ofBool true) .right } := by - rw [TM.step, if_neg (emitUnaryTM_ne_halt (by decide) hst)] + rw [TM.step, ite_eq_right (emitUnaryTM_ne_halt (by decide) hst)] simp only [emitUnaryTM, hst] refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, ?_, ?_, ?_⟩) · exact hinp.move_idle · funext i by_cases hir : i = r · subst hir - rw [if_pos rfl, Function.update_self, + rw [ite_eq_left rfl, Function.update_self, writeAndMove_readBack _ (by rw [hone]; decide)] - · rw [if_neg hir, Function.update_of_ne hir] + · rw [ite_eq_right hir, Function.update_of_ne hir] exact (hwork i hir).writeAndMove_readBack_idle · rfl @@ -503,16 +503,16 @@ private theorem emitUnaryTM_step_emitA_blank (c : Cfg n (emitUnaryTM (n := n) r) { state := .back, input := c.input, work := Function.update c.work r ((c.work r).move .left), output := c.output } := by - rw [TM.step, if_neg (emitUnaryTM_ne_halt (by decide) hst)] + rw [TM.step, ite_eq_right (emitUnaryTM_ne_halt (by decide) hst)] simp only [emitUnaryTM, hst, hblank, reduceCtorEq, ↓reduceIte] refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, ?_, ?_, ?_⟩) · exact hinp.move_idle · funext i by_cases hir : i = r · subst hir - rw [if_pos rfl, Function.update_self, + rw [ite_eq_left rfl, Function.update_self, writeAndMove_readBack _ (by rw [hblank]; decide)] - · rw [if_neg hir, Function.update_of_ne hir] + · rw [ite_eq_right hir, Function.update_of_ne hir] exact (hwork i hir).writeAndMove_readBack_idle · exact hout.writeAndMove_readBack_idle @@ -525,15 +525,15 @@ private theorem emitUnaryTM_step_back_left (c : Cfg n (emitUnaryTM (n := n) r).Q { state := .back, input := c.input, work := Function.update c.work r ((c.work r).move .left), output := c.output } := by - rw [TM.step, if_neg (emitUnaryTM_ne_halt (by decide) hst)] + rw [TM.step, ite_eq_right (emitUnaryTM_ne_halt (by decide) hst)] simp only [emitUnaryTM, hst, hns, ↓reduceIte] refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, ?_, ?_, ?_⟩) · exact hinp.move_idle · funext i by_cases hir : i = r · subst hir - rw [if_pos rfl, Function.update_self, writeAndMove_readBack _ hns] - · rw [if_neg hir, Function.update_of_ne hir] + rw [ite_eq_left rfl, Function.update_self, writeAndMove_readBack _ hns] + · rw [ite_eq_right hir, Function.update_of_ne hir] exact (hwork i hir).writeAndMove_readBack_idle · exact hout.writeAndMove_readBack_idle @@ -551,18 +551,18 @@ private theorem emitUnaryTM_step_back_start (c : Cfg n (emitUnaryTM (n := n) r). have h0 : (c.work r).head = 0 := by by_contra hc exact hcr _ (by omega) hs - rw [TM.step, if_neg (emitUnaryTM_ne_halt (by decide) hst)] + rw [TM.step, ite_eq_right (emitUnaryTM_ne_halt (by decide) hst)] simp only [emitUnaryTM, hst, hs, ↓reduceIte] refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, ?_, ?_, ?_⟩) · exact hinp.move_idle · funext i by_cases hir : i = r · subst hir - rw [if_pos rfl, Function.update_self] + rw [ite_eq_left rfl, Function.update_self] show ((c.work i).write _).move Dir3.right = (c.work i).move .right congr 1 - rw [Tape.write, if_pos h0] - · rw [if_neg hir, Function.update_of_ne hir] + rw [Tape.write, ite_eq_left h0] + · rw [ite_eq_right hir, Function.update_of_ne hir] exact (hwork i hir).writeAndMove_readBack_idle · exact hout.writeAndMove_readBack_idle @@ -572,7 +572,7 @@ private theorem emitUnaryTM_step_park (c : Cfg n (emitUnaryTM (n := n) r).Q) (hout : Parked c.output) : (emitUnaryTM (n := n) r).step c = some { state := .done, input := c.input, work := c.work, output := c.output } := by - rw [TM.step, if_neg (emitUnaryTM_ne_halt (by decide) hst)] + rw [TM.step, ite_eq_right (emitUnaryTM_ne_halt (by decide) hst)] simp only [emitUnaryTM, hst] refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, ?_, ?_, ?_⟩) · exact hinp.move_idle diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Registers/ForReg.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Registers/ForReg.lean index 11cda572c8..181bf11191 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Registers/ForReg.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Registers/ForReg.lean @@ -96,27 +96,27 @@ def forRegTM (body : TM n) (r : Fin n) : TM n where dsimp only [] by_cases hir : i = r · subst hir; rw [hone] at hi; exact absurd hi (by decide) - · rw [if_neg hir]; exact idleDir_right_of_start hi + · rw [ite_eq_right hir]; exact idleDir_right_of_start hi · next hnone => refine ⟨idleDir_right_of_start, fun i hi => ?_, idleDir_right_of_start⟩ dsimp only [] by_cases hir : i = r - · subst hir; rw [if_pos rfl, if_pos hi] - · rw [if_neg hir]; exact idleDir_right_of_start hi + · subst hir; rw [ite_eq_left rfl, ite_eq_left hi] + · rw [ite_eq_right hir]; exact idleDir_right_of_start hi | .inl .rewind => dsimp only [] split · refine ⟨idleDir_right_of_start, fun i hi => ?_, idleDir_right_of_start⟩ dsimp only [] by_cases hir : i = r - · rw [if_pos hir] - · rw [if_neg hir]; exact idleDir_right_of_start hi + · rw [ite_eq_left hir] + · rw [ite_eq_right hir]; exact idleDir_right_of_start hi · next hns => refine ⟨idleDir_right_of_start, fun i hi => ?_, idleDir_right_of_start⟩ dsimp only [] by_cases hir : i = r · subst hir; exact absurd hi hns - · rw [if_neg hir]; exact idleDir_right_of_start hi + · rw [ite_eq_right hir]; exact idleDir_right_of_start hi | .inl .done => exact rightOfStart_allIdle iHead wHeads oHead | .inr q => dsimp only [] @@ -140,10 +140,10 @@ private theorem forRegTM_lift_step (c c' : Cfg n body.Q) (forRegTM body r).step (wrapCfg body r c) = some (wrapCfg body r c') := by have hne : ¬ c.state = body.qhalt := by intro h - rw [TM.step, if_pos h] at hstep + rw [TM.step, ite_eq_left h] at hstep simp at hstep - rw [TM.step, if_neg hne] at hstep - rw [TM.step, if_neg (show ¬ (wrapCfg body r c).state = (forRegTM body r).qhalt from + rw [TM.step, ite_eq_right hne] at hstep + rw [TM.step, ite_eq_right (show ¬ (wrapCfg body r c).state = (forRegTM body r).qhalt from by simp [wrapCfg, forRegTM])] simp only [wrapCfg, forRegTM, hne, ↓reduceIte] revert hstep @@ -169,16 +169,16 @@ private theorem forRegTM_step_test_one (c : Cfg n (forRegTM body r).Q) { state := .inr body.qstart, input := c.input, work := Function.update c.work r ((c.work r).move .right), output := c.output } := by - rw [TM.step, if_neg (forRegTM_ne_halt (by simp) hst)] + rw [TM.step, ite_eq_right (forRegTM_ne_halt (by simp) hst)] simp only [forRegTM, hst, hone, ↓reduceIte] refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, ?_, ?_, ?_⟩) · exact hinp.move_idle · funext i by_cases hir : i = r · subst hir - rw [if_pos rfl, Function.update_self, + rw [ite_eq_left rfl, Function.update_self, writeAndMove_readBack _ (by rw [hone]; decide)] - · rw [if_neg hir, Function.update_of_ne hir] + · rw [ite_eq_right hir, Function.update_of_ne hir] exact (hwork i hir).writeAndMove_readBack_idle · exact hout.writeAndMove_readBack_idle @@ -191,7 +191,7 @@ private theorem forRegTM_step_test_blank (c : Cfg n (forRegTM body r).Q) { state := .inl .rewind, input := c.input, work := Function.update c.work r ((c.work r).move .left), output := c.output } := by - rw [TM.step, if_neg (forRegTM_ne_halt (by simp) hst)] + rw [TM.step, ite_eq_right (forRegTM_ne_halt (by simp) hst)] simp only [forRegTM, hst, hblank, reduceCtorEq, ↓reduceIte] refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, ?_, ?_, ?_⟩) · exact hinp.move_idle @@ -200,7 +200,7 @@ private theorem forRegTM_step_test_blank (c : Cfg n (forRegTM body r).Q) · subst hir simp only [↓reduceIte, Function.update_self] rw [writeAndMove_readBack _ (by rw [hblank]; decide)] - · rw [if_neg hir, Function.update_of_ne hir] + · rw [ite_eq_right hir, Function.update_of_ne hir] exact (hwork i hir).writeAndMove_readBack_idle · exact hout.writeAndMove_readBack_idle @@ -213,15 +213,15 @@ private theorem forRegTM_step_rewind_left (c : Cfg n (forRegTM body r).Q) { state := .inl .rewind, input := c.input, work := Function.update c.work r ((c.work r).move .left), output := c.output } := by - rw [TM.step, if_neg (forRegTM_ne_halt (by simp) hst)] + rw [TM.step, ite_eq_right (forRegTM_ne_halt (by simp) hst)] simp only [forRegTM, hst, hns, ↓reduceIte] refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, ?_, ?_, ?_⟩) · exact hinp.move_idle · funext i by_cases hir : i = r · subst hir - rw [if_pos rfl, Function.update_self, writeAndMove_readBack _ hns] - · rw [if_neg hir, Function.update_of_ne hir] + rw [ite_eq_left rfl, Function.update_self, writeAndMove_readBack _ hns] + · rw [ite_eq_right hir, Function.update_of_ne hir] exact (hwork i hir).writeAndMove_readBack_idle · exact hout.writeAndMove_readBack_idle @@ -238,18 +238,18 @@ private theorem forRegTM_step_rewind_start (c : Cfg n (forRegTM body r).Q) have h0 : (c.work r).head = 0 := by by_contra hc exact hcr _ (by omega) hs - rw [TM.step, if_neg (forRegTM_ne_halt (by simp) hst)] + rw [TM.step, ite_eq_right (forRegTM_ne_halt (by simp) hst)] simp only [forRegTM, hst, hs, ↓reduceIte] refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, ?_, ?_, ?_⟩) · exact hinp.move_idle · funext i by_cases hir : i = r · subst hir - rw [if_pos rfl, Function.update_self] + rw [ite_eq_left rfl, Function.update_self] show ((c.work i).write _).move Dir3.right = (c.work i).move .right congr 1 - rw [Tape.write, if_pos h0] - · rw [if_neg hir, Function.update_of_ne hir] + rw [Tape.write, ite_eq_left h0] + · rw [ite_eq_right hir, Function.update_of_ne hir] exact (hwork i hir).writeAndMove_readBack_idle · exact hout.writeAndMove_readBack_idle @@ -261,7 +261,7 @@ private theorem forRegTM_step_loopback (c : Cfg n (forRegTM body r).Q) (forRegTM body r).step c = some { state := .inl .test, input := c.input, work := c.work, output := c.output } := by - rw [TM.step, if_neg (forRegTM_ne_halt (by simp) hst)] + rw [TM.step, ite_eq_right (forRegTM_ne_halt (by simp) hst)] simp only [forRegTM, hst, ↓reduceIte] refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, ?_, ?_, ?_⟩) · exact hinp.move_idle @@ -394,7 +394,7 @@ private theorem forRegTM_loop_run (inp₀ : Tape) (w : ℕ → Fin n → Tape) show (Function.update (w v) r (⟨v, regCells v⟩ : Tape) r).cells j ≠ Γ.start rw [Function.update_self] show regCells v j ≠ Γ.start - rw [regCells, if_neg (by omega)] + rw [regCells, ite_eq_right (by omega)] split <;> decide) (by show (Function.update (w v) r (⟨v, regCells v⟩ : Tape) r).head = v @@ -452,7 +452,7 @@ private theorem forRegTM_loop_run (inp₀ : Tape) (w : ℕ → Fin n → Tape) rw [Function.update_self] refine ⟨by show (1 : ℕ) ≤ i + 2; omega, fun p hp => ?_⟩ show regCells v p ≠ Γ.start - rw [regCells, if_neg (by omega)] + rw [regCells, ite_eq_right (by omega)] split <;> decide · rw [Function.update_of_ne hjr] exact hwP (i + 1) j hjr diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Registers/Horner.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Registers/Horner.lean index 26f60c3dfb..9e1587c3d7 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Registers/Horner.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Registers/Horner.lean @@ -30,7 +30,7 @@ are deliberately loose. - `TM.opBudget` — the uniform per-operation time budget - `TM.setConstTM` — `q := c` - `TM.hornerLayerRegTM` — `tmp := tmp · X + comp` (register addend) -- `TM.hornerLayerConstTM` — `tmp := tmp · X + c` (fixedValue addend) +- `TM.hornerLayerConstTM` — `tmp := tmp · X + c` (constant addend) ## Main results @@ -56,7 +56,7 @@ variable {n : ℕ} × (per-mark sweep length). -/ def opBudget (M : ℕ) : ℕ := 32 * ((M + 2) * (M + 2) * (M + 2)) -/-- Anything at most quadratic in `M + 2` (with fixedValue `6`) fits in `opBudget M`. -/ +/-- Anything at most quadratic in `M + 2` (with constant `6`) fits in `opBudget M`. -/ theorem le_opBudget_of_le {a M : ℕ} (h : a ≤ 6 * (M + 2) * (M + 2)) : a ≤ opBudget M := by refine le_trans h ?_ @@ -132,7 +132,7 @@ theorem mulAddIntoTM_le_opBudget {a b d M : ℕ} (ha : a ≤ M) (hb : b ≤ M) nlinarith -- ════════════════════════════════════════════════════════════════════════ --- setConstTM: load a fixedValue into a register +-- setConstTM: load a constant into a register -- ════════════════════════════════════════════════════════════════════════ /-- `q := c` (clear, then increment `c` times). -/ @@ -176,7 +176,7 @@ def hornerLayerRegTM (X comp tmp tmp2 : Fin n) : TM n := (seqTM (mulAddIntoTM tmp X tmp2) (seqTM (addIntoTM comp tmp2) (copyIntoTM tmp2 tmp))) -/-- One Horner layer with a **fixedValue** addend: +/-- One Horner layer with a **constant** addend: `tmp := tmp · X + c` (scratch `tmp2` ends holding the same value). -/ def hornerLayerConstTM (X tmp tmp2 : Fin n) (c : ℕ) : TM n := seqTM (clearRegTM tmp2) @@ -426,7 +426,7 @@ theorem hornerFold_take_le (x : ℕ) (cs : List ℕ) (k : ℕ) : ≤ (cs.sum + 1) * (x + 1) ^ cs.length := Nat.mul_le_mul (by omega) h2 -/-- Fold Horner layers (fixedValue addends, highest first) over a register. -/ +/-- Fold Horner layers (constant addends, highest first) over a register. -/ def hornerLayersTM (X tmp tmp2 : Fin n) (cs : List ℕ) : TM n := bigSeqTM (cs.map (hornerLayerConstTM X tmp tmp2)) diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Registers/InputLen.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Registers/InputLen.lean index 932e0a0b86..f37f7c51e3 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Registers/InputLen.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Registers/InputLen.lean @@ -75,30 +75,30 @@ def inputLenRegTM (q : Fin n) : TM n where idleDir_right_of_start⟩ dsimp only [] by_cases hir : i = q - · subst hir; rw [if_pos rfl, if_pos hi] - · rw [if_neg hir]; exact idleDir_right_of_start hi + · subst hir; rw [ite_eq_left rfl, ite_eq_left hi] + · rw [ite_eq_right hir]; exact idleDir_right_of_start hi · split · exact ⟨fun _ => rfl, fun i hi => idleDir_right_of_start hi, idleDir_right_of_start⟩ · refine ⟨fun _ => rfl, fun i hi => ?_, idleDir_right_of_start⟩ dsimp only [] by_cases hir : i = q - · rw [if_pos hir] - · rw [if_neg hir]; exact idleDir_right_of_start hi + · rw [ite_eq_left hir] + · rw [ite_eq_right hir]; exact idleDir_right_of_start hi | .back => dsimp only [] split · refine ⟨fun _ => rfl, fun i hi => ?_, idleDir_right_of_start⟩ dsimp only [] by_cases hir : i = q - · rw [if_pos hir] - · rw [if_neg hir]; exact idleDir_right_of_start hi + · rw [ite_eq_left hir] + · rw [ite_eq_right hir]; exact idleDir_right_of_start hi · next hns => - refine ⟨fun hi => by rw [if_pos hi], fun i hi => ?_, idleDir_right_of_start⟩ + refine ⟨fun hi => by rw [ite_eq_left hi], fun i hi => ?_, idleDir_right_of_start⟩ dsimp only [] by_cases hir : i = q · subst hir; exact absurd hi hns - · rw [if_neg hir]; exact idleDir_right_of_start hi + · rw [ite_eq_right hir]; exact idleDir_right_of_start hi | .park => exact ⟨idleDir_right_of_start, fun _ => idleDir_right_of_start, idleDir_right_of_start⟩ @@ -125,14 +125,14 @@ private theorem inputLenRegTM_step_scan_bit (c : Cfg n (inputLenRegTM (n := n) q work := Function.update c.work q (((c.work q).write Γw.one).move .right), output := c.output } := by - rw [TM.step, if_neg (inputLenRegTM_ne_halt (by decide) hst)] + rw [TM.step, ite_eq_right (inputLenRegTM_ne_halt (by decide) hst)] simp only [inputLenRegTM, hst, hbl, hns, ↓reduceIte] refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, rfl, ?_, ?_⟩) · funext i by_cases hir : i = q · subst hir simp only [↓reduceIte, Function.update_self] - · rw [if_neg hir, if_neg hir, Function.update_of_ne hir] + · rw [ite_eq_right hir, ite_eq_right hir, Function.update_of_ne hir] exact (hwork i hir).writeAndMove_readBack_idle · exact hout.writeAndMove_readBack_idle @@ -145,15 +145,15 @@ private theorem inputLenRegTM_step_scan_blank (c : Cfg n (inputLenRegTM (n := n) { state := .back, input := c.input.move .left, work := Function.update c.work q ((c.work q).move .left), output := c.output } := by - rw [TM.step, if_neg (inputLenRegTM_ne_halt (by decide) hst)] + rw [TM.step, ite_eq_right (inputLenRegTM_ne_halt (by decide) hst)] simp only [inputLenRegTM, hst, hbl, ↓reduceIte] refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, rfl, ?_, ?_⟩) · funext i by_cases hir : i = q · subst hir - rw [if_pos rfl, if_neg hqns, Function.update_self, + rw [ite_eq_left rfl, ite_eq_right hqns, Function.update_self, writeAndMove_readBack _ hqns] - · rw [if_neg hir, Function.update_of_ne hir] + · rw [ite_eq_right hir, Function.update_of_ne hir] exact (hwork i hir).writeAndMove_readBack_idle · exact hout.writeAndMove_readBack_idle @@ -166,14 +166,14 @@ private theorem inputLenRegTM_step_back_left (c : Cfg n (inputLenRegTM (n := n) { state := .back, input := c.input.move .left, work := Function.update c.work q ((c.work q).move .left), output := c.output } := by - rw [TM.step, if_neg (inputLenRegTM_ne_halt (by decide) hst)] + rw [TM.step, ite_eq_right (inputLenRegTM_ne_halt (by decide) hst)] simp only [inputLenRegTM, hst, hqns, hins, ↓reduceIte] refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, rfl, ?_, ?_⟩) · funext i by_cases hir : i = q · subst hir - rw [if_pos rfl, Function.update_self, writeAndMove_readBack _ hqns] - · rw [if_neg hir, Function.update_of_ne hir] + rw [ite_eq_left rfl, Function.update_self, writeAndMove_readBack _ hqns] + · rw [ite_eq_right hir, Function.update_of_ne hir] exact (hwork i hir).writeAndMove_readBack_idle · exact hout.writeAndMove_readBack_idle @@ -189,17 +189,17 @@ private theorem inputLenRegTM_step_back_start (c : Cfg n (inputLenRegTM (n := n) have h0 : (c.work q).head = 0 := by by_contra hc exact hcr _ (by omega) hs - rw [TM.step, if_neg (inputLenRegTM_ne_halt (by decide) hst)] + rw [TM.step, ite_eq_right (inputLenRegTM_ne_halt (by decide) hst)] simp only [inputLenRegTM, hst, hs, ↓reduceIte] refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, rfl, ?_, ?_⟩) · funext i by_cases hir : i = q · subst hir - rw [if_pos rfl, Function.update_self] + rw [ite_eq_left rfl, Function.update_self] show ((c.work i).write _).move Dir3.right = (c.work i).move .right congr 1 - rw [Tape.write, if_pos h0] - · rw [if_neg hir, Function.update_of_ne hir] + rw [Tape.write, ite_eq_left h0] + · rw [ite_eq_right hir, Function.update_of_ne hir] exact (hwork i hir).writeAndMove_readBack_idle · exact hout.writeAndMove_readBack_idle @@ -209,7 +209,7 @@ private theorem inputLenRegTM_step_park (c : Cfg n (inputLenRegTM (n := n) q).Q) (hwork : ∀ i, Parked (c.work i)) (hout : Parked c.output) : (inputLenRegTM (n := n) q).step c = some { state := .done, input := c.input, work := c.work, output := c.output } := by - rw [TM.step, if_neg (inputLenRegTM_ne_halt (by decide) hst)] + rw [TM.step, ite_eq_right (inputLenRegTM_ne_halt (by decide) hst)] simp only [inputLenRegTM, hst] refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, ?_, ?_, ?_⟩) · exact hinp.move_idle @@ -253,7 +253,7 @@ private theorem inputLenRegTM_scan_run (x : List Bool) (m : ℕ) : have hq₁cells : (((c.work q).write Γw.one).move .right).cells = regCells (k + 1) := by show ((c.work q).write Γw.one).cells = _ - rw [Tape.write, if_neg (by rw [hqh]; omega)] + rw [Tape.write, ite_eq_right (by rw [hqh]; omega)] show Function.update (c.work q).cells (c.work q).head Γw.one.toΓ = _ rw [hqh, hqc] exact regCells_update_succ k @@ -448,7 +448,7 @@ theorem inputLenRegTM_hoareTime (q : Fin n) (x : List Bool) show (c₁.work q).cells j ≠ _ rw [h5] show regCells x.length j ≠ Γ.start - rw [regCells, if_neg (by omega)] + rw [regCells, ite_eq_right (by omega)] split <;> decide) (by show (Function.update c₁.work q _ q).head = x.length rw [Function.update_self] diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Registers/RegisterOps.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Registers/RegisterOps.lean index f30f749443..3098f2f6d8 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Registers/RegisterOps.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Registers/RegisterOps.lean @@ -152,27 +152,27 @@ def incRegTM (q : Fin n) : TM n where dsimp only [] by_cases hir : i = q · subst hir; rw [hone] at hi; exact absurd hi (by decide) - · rw [if_neg hir]; exact idleDir_right_of_start hi + · rw [ite_eq_right hir]; exact idleDir_right_of_start hi · next hnone => refine ⟨idleDir_right_of_start, fun i hi => ?_, idleDir_right_of_start⟩ dsimp only [] by_cases hir : i = q - · subst hir; rw [if_pos rfl, if_pos hi] - · rw [if_neg hir]; exact idleDir_right_of_start hi + · subst hir; rw [ite_eq_left rfl, ite_eq_left hi] + · rw [ite_eq_right hir]; exact idleDir_right_of_start hi | .back => dsimp only [] split · refine ⟨idleDir_right_of_start, fun i hi => ?_, idleDir_right_of_start⟩ dsimp only [] by_cases hir : i = q - · rw [if_pos hir] - · rw [if_neg hir]; exact idleDir_right_of_start hi + · rw [ite_eq_left hir] + · rw [ite_eq_right hir]; exact idleDir_right_of_start hi · next hns => refine ⟨idleDir_right_of_start, fun i hi => ?_, idleDir_right_of_start⟩ dsimp only [] by_cases hir : i = q · subst hir; exact absurd hi hns - · rw [if_neg hir]; exact idleDir_right_of_start hi + · rw [ite_eq_right hir]; exact idleDir_right_of_start hi | .park => exact ⟨idleDir_right_of_start, fun _ => idleDir_right_of_start, idleDir_right_of_start⟩ @@ -198,16 +198,16 @@ private theorem incRegTM_step_scan_one (c : Cfg n (incRegTM (n := n) q).Q) { state := .scan, input := c.input, work := Function.update c.work q ((c.work q).move .right), output := c.output } := by - rw [TM.step, if_neg (incRegTM_ne_halt (by decide) hst)] + rw [TM.step, ite_eq_right (incRegTM_ne_halt (by decide) hst)] simp only [incRegTM, hst, hone, ↓reduceIte] refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, ?_, ?_, ?_⟩) · exact hinp.move_idle · funext i by_cases hir : i = q · subst hir - rw [if_pos rfl, Function.update_self, + rw [ite_eq_left rfl, Function.update_self, writeAndMove_readBack _ (by rw [hone]; decide)] - · rw [if_neg hir, Function.update_of_ne hir] + · rw [ite_eq_right hir, Function.update_of_ne hir] exact (hwork i hir).writeAndMove_readBack_idle · exact hout.writeAndMove_readBack_idle @@ -221,7 +221,7 @@ private theorem incRegTM_step_scan_blank (c : Cfg n (incRegTM (n := n) q).Q) work := Function.update c.work q (((c.work q).write Γw.one).move .left), output := c.output } := by - rw [TM.step, if_neg (incRegTM_ne_halt (by decide) hst)] + rw [TM.step, ite_eq_right (incRegTM_ne_halt (by decide) hst)] simp only [incRegTM, hst, hblank, reduceCtorEq, ↓reduceIte] refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, ?_, ?_, ?_⟩) · exact hinp.move_idle @@ -229,7 +229,7 @@ private theorem incRegTM_step_scan_blank (c : Cfg n (incRegTM (n := n) q).Q) by_cases hir : i = q · subst hir simp only [↓reduceIte, Function.update_self] - · rw [if_neg hir, if_neg hir, Function.update_of_ne hir] + · rw [ite_eq_right hir, ite_eq_right hir, Function.update_of_ne hir] exact (hwork i hir).writeAndMove_readBack_idle · exact hout.writeAndMove_readBack_idle @@ -242,15 +242,15 @@ private theorem incRegTM_step_back_left (c : Cfg n (incRegTM (n := n) q).Q) { state := .back, input := c.input, work := Function.update c.work q ((c.work q).move .left), output := c.output } := by - rw [TM.step, if_neg (incRegTM_ne_halt (by decide) hst)] + rw [TM.step, ite_eq_right (incRegTM_ne_halt (by decide) hst)] simp only [incRegTM, hst, hns, ↓reduceIte] refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, ?_, ?_, ?_⟩) · exact hinp.move_idle · funext i by_cases hir : i = q · subst hir - rw [if_pos rfl, Function.update_self, writeAndMove_readBack _ hns] - · rw [if_neg hir, Function.update_of_ne hir] + rw [ite_eq_left rfl, Function.update_self, writeAndMove_readBack _ hns] + · rw [ite_eq_right hir, Function.update_of_ne hir] exact (hwork i hir).writeAndMove_readBack_idle · exact hout.writeAndMove_readBack_idle @@ -267,18 +267,18 @@ private theorem incRegTM_step_back_start (c : Cfg n (incRegTM (n := n) q).Q) have h0 : (c.work q).head = 0 := by by_contra hc exact hcr _ (by omega) hs - rw [TM.step, if_neg (incRegTM_ne_halt (by decide) hst)] + rw [TM.step, ite_eq_right (incRegTM_ne_halt (by decide) hst)] simp only [incRegTM, hst, hs, ↓reduceIte] refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, ?_, ?_, ?_⟩) · exact hinp.move_idle · funext i by_cases hir : i = q · subst hir - rw [if_pos rfl, Function.update_self] + rw [ite_eq_left rfl, Function.update_self] show ((c.work i).write _).move Dir3.right = (c.work i).move .right congr 1 - rw [Tape.write, if_pos h0] - · rw [if_neg hir, Function.update_of_ne hir] + rw [Tape.write, ite_eq_left h0] + · rw [ite_eq_right hir, Function.update_of_ne hir] exact (hwork i hir).writeAndMove_readBack_idle · exact hout.writeAndMove_readBack_idle @@ -288,7 +288,7 @@ private theorem incRegTM_step_park (c : Cfg n (incRegTM (n := n) q).Q) (hout : Parked c.output) : (incRegTM (n := n) q).step c = some { state := .done, input := c.input, work := c.work, output := c.output } := by - rw [TM.step, if_neg (incRegTM_ne_halt (by decide) hst)] + rw [TM.step, ite_eq_right (incRegTM_ne_halt (by decide) hst)] simp only [incRegTM, hst] refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, ?_, ?_, ?_⟩) · exact hinp.move_idle @@ -450,7 +450,7 @@ theorem incRegTM_hoareTime (q : Fin n) (d : ℕ) (inp₀ : Tape) (work₀ : Fin have hwq₂cells : wq₂.cells = regCells (d + 1) := by rw [hwq₂] show ((c₁.work q).write Γw.one).cells = _ - rw [Tape.write, if_neg (by rw [hhead₁]; omega)] + rw [Tape.write, ite_eq_right (by rw [hhead₁]; omega)] show Function.update (c₁.work q).cells (c₁.work q).head Γw.one.toΓ = _ rw [hhead₁, hcells₁] exact regCells_update_succ d @@ -520,8 +520,8 @@ theorem clearCells_zero (d : ℕ) : clearRegCells d 0 = regCells d := by simp only [clearRegCells, regCells] rcases Nat.eq_zero_or_pos j with rfl | hj · rfl - · rw [if_neg (show ¬ j = 0 from by omega), if_neg (show ¬ j ≤ 0 from by omega), - if_neg (show ¬ j = 0 from by omega)] + · rw [ite_eq_right (show ¬ j = 0 from by omega), ite_eq_right (show ¬ j ≤ 0 from by omega), + ite_eq_right (show ¬ j = 0 from by omega)] /-- After blanking all `d` marks (`k = d`), a mid-clear register is `regCells 0`. -/ theorem clearCells_last (d : ℕ) : clearRegCells d d = regCells 0 := by @@ -529,17 +529,17 @@ theorem clearCells_last (d : ℕ) : clearRegCells d d = regCells 0 := by simp only [clearRegCells, regCells] rcases Nat.eq_zero_or_pos j with rfl | hj · rfl - · rw [if_neg (show ¬ j = 0 from by omega), if_neg (show ¬ j = 0 from by omega), - if_neg (show ¬ j ≤ 0 from by omega)] + · rw [ite_eq_right (show ¬ j = 0 from by omega), ite_eq_right (show ¬ j = 0 from by omega), + ite_eq_right (show ¬ j ≤ 0 from by omega)] by_cases hd : j ≤ d - · rw [if_pos hd] - · rw [if_neg hd, if_neg hd] + · rw [ite_eq_left hd] + · rw [ite_eq_right hd, ite_eq_right hd] /-- No mid-clear cell at position `j ≥ 1` is the `▷` sentinel. -/ theorem clearCells_ne_start {d k j : ℕ} (hj : 1 ≤ j) : clearRegCells d k j ≠ Γ.start := by simp only [clearRegCells] - rw [if_neg (show ¬ j = 0 from by omega)] + rw [ite_eq_right (show ¬ j = 0 from by omega)] split · decide · split <;> decide @@ -552,19 +552,19 @@ theorem clearCells_update_succ (d k : ℕ) : rw [Function.update_apply] by_cases hj : j = k + 1 · subst hj - rw [if_pos rfl] + rw [ite_eq_left rfl] show Γ.blank = clearRegCells d (k + 1) (k + 1) simp only [clearRegCells] - rw [if_neg (show ¬ k + 1 = 0 from by omega), if_pos (le_refl (k + 1))] - · rw [if_neg hj] + rw [ite_eq_right (show ¬ k + 1 = 0 from by omega), ite_eq_left (le_refl (k + 1))] + · rw [ite_eq_right hj] simp only [clearRegCells] rcases Nat.eq_zero_or_pos j with rfl | hj1 · rfl · rcases Nat.lt_or_ge j (k + 1) with hlt | hge - · rw [if_neg (show ¬ j = 0 from by omega), if_neg (show ¬ j = 0 from by omega), - if_pos (show j ≤ k from by omega), if_pos (show j ≤ k + 1 from by omega)] - · rw [if_neg (show ¬ j = 0 from by omega), if_neg (show ¬ j = 0 from by omega), - if_neg (show ¬ j ≤ k from by omega), if_neg (show ¬ j ≤ k + 1 from by omega)] + · rw [ite_eq_right (show ¬ j = 0 from by omega), ite_eq_right (show ¬ j = 0 from by omega), + ite_eq_left (show j ≤ k from by omega), ite_eq_left (show j ≤ k + 1 from by omega)] + · rw [ite_eq_right (show ¬ j = 0 from by omega), ite_eq_right (show ¬ j = 0 from by omega), + ite_eq_right (show ¬ j ≤ k from by omega), ite_eq_right (show ¬ j ≤ k + 1 from by omega)] /-- **Clear register `q`**: sweep right blanking the marks, rewind to cell 1. From `regTape d` to `regTape 0` in `2d + 4` steps; every other tape untouched. -/ @@ -610,27 +610,27 @@ def clearRegTM (q : Fin n) : TM n where dsimp only [] by_cases hir : i = q · subst hir; rw [hone] at hi; exact absurd hi (by decide) - · rw [if_neg hir]; exact idleDir_right_of_start hi + · rw [ite_eq_right hir]; exact idleDir_right_of_start hi · next hnone => refine ⟨idleDir_right_of_start, fun i hi => ?_, idleDir_right_of_start⟩ dsimp only [] by_cases hir : i = q - · subst hir; rw [if_pos rfl, if_pos hi] - · rw [if_neg hir]; exact idleDir_right_of_start hi + · subst hir; rw [ite_eq_left rfl, ite_eq_left hi] + · rw [ite_eq_right hir]; exact idleDir_right_of_start hi | .back => dsimp only [] split · refine ⟨idleDir_right_of_start, fun i hi => ?_, idleDir_right_of_start⟩ dsimp only [] by_cases hir : i = q - · rw [if_pos hir] - · rw [if_neg hir]; exact idleDir_right_of_start hi + · rw [ite_eq_left hir] + · rw [ite_eq_right hir]; exact idleDir_right_of_start hi · next hns => refine ⟨idleDir_right_of_start, fun i hi => ?_, idleDir_right_of_start⟩ dsimp only [] by_cases hir : i = q · subst hir; exact absurd hi hns - · rw [if_neg hir]; exact idleDir_right_of_start hi + · rw [ite_eq_right hir]; exact idleDir_right_of_start hi | .park => exact ⟨idleDir_right_of_start, fun _ => idleDir_right_of_start, idleDir_right_of_start⟩ @@ -657,7 +657,7 @@ private theorem clearRegTM_step_scan_one (c : Cfg n (clearRegTM (n := n) q).Q) work := Function.update c.work q (((c.work q).write Γw.blank).move .right), output := c.output } := by - rw [TM.step, if_neg (clearRegTM_ne_halt (by decide) hst)] + rw [TM.step, ite_eq_right (clearRegTM_ne_halt (by decide) hst)] simp only [clearRegTM, hst, hone, ↓reduceIte] refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, ?_, ?_, ?_⟩) · exact hinp.move_idle @@ -665,7 +665,7 @@ private theorem clearRegTM_step_scan_one (c : Cfg n (clearRegTM (n := n) q).Q) by_cases hir : i = q · subst hir simp only [↓reduceIte, Function.update_self] - · rw [if_neg hir, if_neg hir, Function.update_of_ne hir] + · rw [ite_eq_right hir, ite_eq_right hir, Function.update_of_ne hir] exact (hwork i hir).writeAndMove_readBack_idle · exact hout.writeAndMove_readBack_idle @@ -678,7 +678,7 @@ private theorem clearRegTM_step_scan_blank (c : Cfg n (clearRegTM (n := n) q).Q) { state := .back, input := c.input, work := Function.update c.work q ((c.work q).move .left), output := c.output } := by - rw [TM.step, if_neg (clearRegTM_ne_halt (by decide) hst)] + rw [TM.step, ite_eq_right (clearRegTM_ne_halt (by decide) hst)] simp only [clearRegTM, hst, hblank, reduceCtorEq, ↓reduceIte] refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, ?_, ?_, ?_⟩) · exact hinp.move_idle @@ -687,7 +687,7 @@ private theorem clearRegTM_step_scan_blank (c : Cfg n (clearRegTM (n := n) q).Q) · subst hir simp only [↓reduceIte, Function.update_self] rw [writeAndMove_readBack _ (by rw [hblank]; decide)] - · rw [if_neg hir, Function.update_of_ne hir] + · rw [ite_eq_right hir, Function.update_of_ne hir] exact (hwork i hir).writeAndMove_readBack_idle · exact hout.writeAndMove_readBack_idle @@ -700,15 +700,15 @@ private theorem clearRegTM_step_back_left (c : Cfg n (clearRegTM (n := n) q).Q) { state := .back, input := c.input, work := Function.update c.work q ((c.work q).move .left), output := c.output } := by - rw [TM.step, if_neg (clearRegTM_ne_halt (by decide) hst)] + rw [TM.step, ite_eq_right (clearRegTM_ne_halt (by decide) hst)] simp only [clearRegTM, hst, hns, ↓reduceIte] refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, ?_, ?_, ?_⟩) · exact hinp.move_idle · funext i by_cases hir : i = q · subst hir - rw [if_pos rfl, Function.update_self, writeAndMove_readBack _ hns] - · rw [if_neg hir, Function.update_of_ne hir] + rw [ite_eq_left rfl, Function.update_self, writeAndMove_readBack _ hns] + · rw [ite_eq_right hir, Function.update_of_ne hir] exact (hwork i hir).writeAndMove_readBack_idle · exact hout.writeAndMove_readBack_idle @@ -725,18 +725,18 @@ private theorem clearRegTM_step_back_start (c : Cfg n (clearRegTM (n := n) q).Q) have h0 : (c.work q).head = 0 := by by_contra hc exact hcr _ (by omega) hs - rw [TM.step, if_neg (clearRegTM_ne_halt (by decide) hst)] + rw [TM.step, ite_eq_right (clearRegTM_ne_halt (by decide) hst)] simp only [clearRegTM, hst, hs, ↓reduceIte] refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, ?_, ?_, ?_⟩) · exact hinp.move_idle · funext i by_cases hir : i = q · subst hir - rw [if_pos rfl, Function.update_self] + rw [ite_eq_left rfl, Function.update_self] show ((c.work i).write _).move Dir3.right = (c.work i).move .right congr 1 - rw [Tape.write, if_pos h0] - · rw [if_neg hir, Function.update_of_ne hir] + rw [Tape.write, ite_eq_left h0] + · rw [ite_eq_right hir, Function.update_of_ne hir] exact (hwork i hir).writeAndMove_readBack_idle · exact hout.writeAndMove_readBack_idle @@ -746,7 +746,7 @@ private theorem clearRegTM_step_park (c : Cfg n (clearRegTM (n := n) q).Q) (hout : Parked c.output) : (clearRegTM (n := n) q).step c = some { state := .done, input := c.input, work := c.work, output := c.output } := by - rw [TM.step, if_neg (clearRegTM_ne_halt (by decide) hst)] + rw [TM.step, ite_eq_right (clearRegTM_ne_halt (by decide) hst)] simp only [clearRegTM, hst] refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, ?_, ?_, ?_⟩) · exact hinp.move_idle @@ -775,14 +775,14 @@ private theorem clearRegTM_scan_run (d m : ℕ) : | succ m ih => intro k hk c hst hinp hwork hout hcells hhead have hone : (c.work q).read = Γ.one := by - rw [Tape.read, hhead, hcells, clearRegCells, if_neg (by omega), if_neg (by omega), - if_pos (by omega)] + rw [Tape.read, hhead, hcells, clearRegCells, ite_eq_right (by omega), ite_eq_right (by omega), + ite_eq_left (by omega)] have hstep := clearRegTM_step_scan_one c hst hone hinp hwork hout set wq₁ : Tape := ((c.work q).write Γw.blank).move .right with hwq₁ have hwq₁cells : wq₁.cells = clearRegCells d (k + 1) := by rw [hwq₁] show ((c.work q).write Γw.blank).cells = _ - rw [Tape.write, if_neg (by rw [hhead]; omega)] + rw [Tape.write, ite_eq_right (by rw [hhead]; omega)] show Function.update (c.work q).cells (c.work q).head Γw.blank.toΓ = _ rw [hhead, hcells] exact clearCells_update_succ d k diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryAddConst.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryAddConst.lean index ce7669769a..a9cd6421ba 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryAddConst.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryAddConst.lean @@ -31,7 +31,7 @@ namespace TM variable {n : ℕ} -/-- Fixed-fixedValue addition has the advertised exact runtime and changes only +/-- Fixed-constant addition has the advertised exact runtime and changes only the destination tape. -/ theorem binaryAddConstTM_reachesIn_frame (idx : Fin n) (fixedValue dstValue : ℕ) @@ -55,7 +55,7 @@ theorem binaryAddConstTM_reachesIn_frame binaryAddConstTM_reachesIn_frame_internal idx fixedValue dstValue inp₀ work₀ out₀ hdst hinp hother hout -/-- Time-bounded literal-frame contract for fixed-fixedValue addition. -/ +/-- Time-bounded literal-frame contract for fixed-constant addition. -/ theorem binaryAddConstTM_hoareTime_frame (idx : Fin n) (fixedValue dstValue : ℕ) (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) @@ -75,7 +75,7 @@ theorem binaryAddConstTM_hoareTime_frame binaryAddConstTM_hoareTime_frame_internal idx fixedValue dstValue inp₀ work₀ out₀ hdst hinp hother hout -/-- Every prefix of fixed-fixedValue addition respects a bound controlled by +/-- Every prefix of fixed-constant addition respects a bound controlled by the final destination width. -/ theorem binaryAddConstTM_hoareTimeSpace_frame (idx : Fin n) (fixedValue dstValue inputLength initialSpace : ℕ) @@ -100,7 +100,7 @@ theorem binaryAddConstTM_hoareTimeSpace_frame inputLength initialSpace inp₀ work₀ out₀ hdst hinp hother hout hworkSpace hinputSpace -/-- Fixed-fixedValue addition never moves its output head left. -/ +/-- Fixed-constant addition never moves its output head left. -/ theorem binaryAddConstTM_isTransducer (idx : Fin n) (fixedValue : ℕ) : (binaryAddConstTM idx fixedValue).IsTransducer := binaryAddConstTM_isTransducer_internal idx fixedValue diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryAddConst/Defs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryAddConst/Defs.lean index 157c0c731a..afba95589f 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryAddConst/Defs.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryAddConst/Defs.lean @@ -11,7 +11,7 @@ public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutine /-! # Addition of a fixed natural to a canonical binary tape — definitions -A fixed fixedValue is compiled into finitely many sequential applications of +A fixed constant is compiled into finitely many sequential applications of canonical binary successor. No work tape is needed for the hardwired value, so the construction preserves every tape except its destination. -/ @@ -29,7 +29,7 @@ def binaryAddConstTM {n : ℕ} (idx : Fin n) : ℕ → TM n | fixedValue + 1 => seqTM (binaryAddConstTM idx fixedValue) (binarySuccTM idx) -/-- Exact runtime of fixed-fixedValue binary addition. -/ +/-- Exact runtime of fixed-constant binary addition. -/ def binaryAddConstTime (fixedValue dstValue : ℕ) : ℕ := match fixedValue with | 0 => 1 @@ -37,7 +37,7 @@ def binaryAddConstTime (fixedValue dstValue : ℕ) : ℕ := binaryAddConstTime fixedValue dstValue + 1 + binarySuccTime (dstValue + fixedValue) -/-- All-prefix width-based space bound for fixed-fixedValue addition. -/ +/-- All-prefix width-based space bound for fixed-constant addition. -/ def binaryAddConstSpace (initialSpace fixedValue dstValue : ℕ) : ℕ := initialSpace + 2 * (dstValue + fixedValue).size + 3 diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryAddConst/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryAddConst/Internal.lean index 1f3daba55b..12038ff5e0 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryAddConst/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryAddConst/Internal.lean @@ -25,7 +25,7 @@ namespace TM variable {n : ℕ} -/-- Canonical parked tape encoding of a natural for fixedValue addition. -/ +/-- Canonical parked tape encoding of a natural for constant addition. -/ def binaryAddConstNatTape (value : ℕ) : Tape := (Tape.init (value.bits.map Γ.ofBool)).move Dir3.right @@ -111,7 +111,7 @@ private theorem binaryAddConstInitialWork_parked exact binaryAddConstHasBinaryNat_parked hdst · exact hother i hi -/-- Predicate fixing the tapes framing a fixedValue-addition execution. -/ +/-- Predicate fixing the tapes framing a constant-addition execution. -/ abbrev binaryAddConstFramePred (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) : TapePred n := fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀ diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryEq/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryEq/Internal.lean index 9f71dc9c6f..9529c1f8b4 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryEq/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryEq/Internal.lean @@ -71,14 +71,14 @@ private theorem binaryEq_terminal_step {n : ℕ} simp only [TM.step, binaryEqTM] cases result with | false => - simp only [Bool.false_eq_true, if_false] at hterminal + simp only [Bool.false_eq_true, ite_false] at hterminal have hnotBlank : ¬((work lhsIdx).read = Γ.blank ∧ (work rhsIdx).read = Γ.blank) := by intro hblank exact hterminal (hblank.1.trans hblank.2.symm) - rw [if_neg hnotBlank, if_neg hterminal] + rw [ite_eq_right hnotBlank, ite_eq_right hterminal] simp only [show BinaryEqPhase.scan ≠ BinaryEqPhase.done by decide, - if_false] + ite_false] refine congrArg some (Cfg.ext rfl (transitionInput_eq_self hinput) ?_ (transitionTape_eq_self houtput)) funext i @@ -90,9 +90,9 @@ private theorem binaryEq_terminal_step {n : ℕ} | true => simp only [if_true] at hterminal - rw [if_pos hterminal] + rw [ite_eq_left hterminal] simp only [show BinaryEqPhase.scan ≠ BinaryEqPhase.done by decide, - if_false] + ite_false] refine congrArg some (Cfg.ext rfl (transitionInput_eq_self hinput) ?_ (transitionTape_eq_self houtput)) funext i @@ -115,18 +115,18 @@ private theorem binaryEq_scan_step {n : ℕ} { state := .scan, input := inp, work := work, output := out } = some (binaryEqAdvanceCfg lhsIdx rhsIdx inp work out) := by simp only [TM.step, binaryEqTM] - rw [if_neg hnotBlank, if_pos hreadEq] - simp only [show BinaryEqPhase.scan ≠ BinaryEqPhase.done by decide, if_false] + rw [ite_eq_right hnotBlank, ite_eq_left hreadEq] + simp only [show BinaryEqPhase.scan ≠ BinaryEqPhase.done by decide, ite_false] refine congrArg some (Cfg.ext rfl (transitionInput_eq_self hinput) ?_ (transitionTape_eq_self houtput)) funext i by_cases hil : i = lhsIdx · subst i - simp only [binaryEqAdvanceCfg, binaryEqAdvanceWork, if_pos] + simp only [binaryEqAdvanceCfg, binaryEqAdvanceWork, ite_eq_left] exact writeAndMove_readBack_right (hwork lhsIdx) · by_cases hir : i = rhsIdx · subst i - simp only [binaryEqAdvanceCfg, binaryEqAdvanceWork, if_neg hil, if_pos] + simp only [binaryEqAdvanceCfg, binaryEqAdvanceWork, ite_eq_right hil, ite_eq_left] exact writeAndMove_readBack_right (hwork rhsIdx) · simpa [binaryEqAdvanceCfg, binaryEqAdvanceWork, hil, hir] using transitionTape_eq_self (hwork i) @@ -288,7 +288,7 @@ private theorem binaryEq_suffix_reachesIn {n : ℕ} simpa [work₁, binaryEqAdvanceWork] using hlhs.move_right_cons have hrhs₁ : (work₁ rhsIdx).HasBinarySuffix rhsTail := by simp only [work₁, binaryEqAdvanceWork, - if_neg (Ne.symm hdistinct.lhs_rhs), if_pos] + ite_eq_right (Ne.symm hdistinct.lhs_rhs), ite_eq_left] exact hrhs.move_right_cons have hresult₁ : (work₁ resultIdx).HasBinaryPrefix [] := by simpa [work₁, binaryEqAdvanceWork, diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryFor/Defs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryFor/Defs.lean index 9bd9f7721d..a36a82f3fd 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryFor/Defs.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryFor/Defs.lean @@ -144,22 +144,22 @@ def binaryForTM {n : ℕ} (body : TM n) (counterIdx limitIdx : Fin n) : TM n := · subst i rw [hblank.1] at hi exact absurd hi (by decide) - · rw [if_neg hic] + · rw [ite_eq_right hic] by_cases hil : i = limitIdx · subst i rw [hblank.2] at hi exact absurd hi (by decide) - · rw [if_neg hil] + · rw [ite_eq_right hil] exact idleDir_right_of_start hi · refine ⟨idleDir_right_of_start, fun i hi => ?_, idleDir_right_of_start⟩ dsimp only by_cases hic : i = counterIdx - · rw [if_pos hic] - · rw [if_neg hic] + · rw [ite_eq_left hic] + · rw [ite_eq_right hic] by_cases hil : i = limitIdx - · rw [if_pos hil] - · rw [if_neg hil] + · rw [ite_eq_left hil] + · rw [ite_eq_right hil] exact idleDir_right_of_start hi | .inl (.rewind equalSoFar) => dsimp only @@ -168,23 +168,23 @@ def binaryForTM {n : ℕ} (body : TM n) (counterIdx limitIdx : Fin n) : TM n := idleDir_right_of_start⟩ dsimp only by_cases hic : i = counterIdx - · rw [if_pos hic] - · rw [if_neg hic] + · rw [ite_eq_left hic] + · rw [ite_eq_right hic] by_cases hil : i = limitIdx - · rw [if_pos hil] - · rw [if_neg hil] + · rw [ite_eq_left hil] + · rw [ite_eq_right hil] exact idleDir_right_of_start hi · refine ⟨idleDir_right_of_start, fun i hi => ?_, idleDir_right_of_start⟩ dsimp only by_cases hic : i = counterIdx - · rw [if_pos hic] + · rw [ite_eq_left hic] exact moveLeftDir_right_of_start hi - · rw [if_neg hic] + · rw [ite_eq_right hic] by_cases hil : i = limitIdx - · rw [if_pos hil] + · rw [ite_eq_left hil] exact moveLeftDir_right_of_start hi - · rw [if_neg hil] + · rw [ite_eq_right hil] exact idleDir_right_of_start hi | .inl .done => exact rightOfStart_allIdle iHead wHeads oHead | .inr q => diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryFor/Internal/Comparison.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryFor/Internal/Comparison.lean index 348bb9842e..b04c87e40a 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryFor/Internal/Comparison.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryFor/Internal/Comparison.lean @@ -43,7 +43,7 @@ private theorem paddedBinarySymbol_of_lt {bits : List Bool} {i : ℕ} private theorem paddedBinarySymbol_of_ge {bits : List Bool} {i : ℕ} (h : bits.length ≤ i) : paddedBinarySymbol bits i = Γ.blank := by - simp only [paddedBinarySymbol, dif_neg (Nat.not_lt.mpr h)] + simp only [paddedBinarySymbol, dite_eq_right (Nat.not_lt.mpr h)] /-- Boolean equality accumulated through the first `width` padded symbols. -/ private def paddedBinaryPrefixEq (left right : List Bool) : ℕ → Bool diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryFor/Internal/Control.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryFor/Internal/Control.lean index 6af5584b04..f418d143c4 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryFor/Internal/Control.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryFor/Internal/Control.lean @@ -50,9 +50,9 @@ theorem binaryForTM_iteration_step_internal (body : TM n) some (binaryForIterationWrap body counterIdx limitIdx c') := by have hne : c.state ≠ (binaryForIterationTM body counterIdx).qhalt := state_ne_qhalt_of_step hstep - rw [TM.step, if_neg (by simp [binaryForIterationWrap, binaryForTM])] + rw [TM.step, ite_eq_right (by simp [binaryForIterationWrap, binaryForTM])] simp only [binaryForIterationWrap, binaryForTM, hne, ↓reduceIte] - rw [TM.step, if_neg hne] at hstep + rw [TM.step, ite_eq_right hne] at hstep simpa only [Option.map_some, binaryForIterationWrap] using congrArg (Option.map (binaryForIterationWrap body counterIdx limitIdx)) hstep @@ -88,23 +88,23 @@ theorem binaryForTM_step_scan_internal (body : TM n) (Function.update c.work counterIdx ((c.work counterIdx).move Dir3.right)) limitIdx ((c.work limitIdx).move Dir3.right) output := c.output } := by - rw [TM.step, if_neg (by rw [hstate]; simp [binaryForTM])] + rw [TM.step, ite_eq_right (by rw [hstate]; simp [binaryForTM])] simp only [binaryForTM, hstate] - rw [if_neg hmore] + rw [ite_eq_right hmore] dsimp only refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, ?_, ?_, ?_⟩) · exact transitionInput_eq_self hinput · funext i by_cases hic : i = counterIdx · subst i - rw [if_pos rfl, Function.update_of_ne hne, Function.update_self, + rw [ite_eq_left rfl, Function.update_of_ne hne, Function.update_self, writeAndMove_readBack _ (hwork counterIdx)] - · rw [if_neg hic] + · rw [ite_eq_right hic] by_cases hil : i = limitIdx · subst i - rw [if_pos rfl, Function.update_self, + rw [ite_eq_left rfl, Function.update_self, writeAndMove_readBack _ (hwork limitIdx)] - · rw [if_neg hil, Function.update_of_ne hil, Function.update_of_ne hic] + · rw [ite_eq_right hil, Function.update_of_ne hil, Function.update_of_ne hic] exact transitionTape_eq_self (hwork i) · exact transitionTape_eq_self houtput @@ -126,23 +126,23 @@ theorem binaryForTM_step_scan_blank_internal (body : TM n) (Function.update c.work counterIdx ((c.work counterIdx).move Dir3.left)) limitIdx ((c.work limitIdx).move Dir3.left) output := c.output } := by - rw [TM.step, if_neg (by rw [hstate]; simp [binaryForTM])] + rw [TM.step, ite_eq_right (by rw [hstate]; simp [binaryForTM])] simp only [binaryForTM, hstate] - rw [if_pos ⟨hcounter, hlimit⟩] + rw [ite_eq_left ⟨hcounter, hlimit⟩] dsimp only refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, ?_, ?_, ?_⟩) · exact transitionInput_eq_self hinput · funext i by_cases hic : i = counterIdx · subst i - rw [if_pos rfl, Function.update_of_ne hne, Function.update_self, + rw [ite_eq_left rfl, Function.update_of_ne hne, Function.update_self, writeAndMove_readBack _ (hwork counterIdx)] - · rw [if_neg hic] + · rw [ite_eq_right hic] by_cases hil : i = limitIdx · subst i - rw [if_pos rfl, Function.update_self, + rw [ite_eq_left rfl, Function.update_self, writeAndMove_readBack _ (hwork limitIdx)] - · rw [if_neg hil, Function.update_of_ne hil, Function.update_of_ne hic] + · rw [ite_eq_right hil, Function.update_of_ne hil, Function.update_of_ne hic] exact transitionTape_eq_self (hwork i) · exact transitionTape_eq_self houtput @@ -162,29 +162,29 @@ theorem binaryForTM_step_rewind_internal (body : TM n) (Function.update c.work counterIdx ((c.work counterIdx).move Dir3.left)) limitIdx ((c.work limitIdx).move Dir3.left) output := c.output } := by - rw [TM.step, if_neg (by rw [hstate]; simp [binaryForTM])] + rw [TM.step, ite_eq_right (by rw [hstate]; simp [binaryForTM])] have hnotboth : ¬((c.work counterIdx).read = Γ.start ∧ (c.work limitIdx).read = Γ.start) := by intro h exact hwork counterIdx h.1 simp only [binaryForTM, hstate] - rw [if_neg hnotboth] + rw [ite_eq_right hnotboth] dsimp only refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, ?_, ?_, ?_⟩) · exact transitionInput_eq_self hinput · funext i by_cases hic : i = counterIdx · subst i - rw [if_pos rfl, Function.update_of_ne hne, Function.update_self, + rw [ite_eq_left rfl, Function.update_of_ne hne, Function.update_self, writeAndMove_readBack _ (hwork counterIdx)] simp [moveLeftDir, hwork counterIdx] - · rw [if_neg hic] + · rw [ite_eq_right hic] by_cases hil : i = limitIdx · subst i - rw [if_pos rfl, Function.update_self, + rw [ite_eq_left rfl, Function.update_self, writeAndMove_readBack _ (hwork limitIdx)] simp [moveLeftDir, hwork limitIdx] - · rw [if_neg hil, Function.update_of_ne hil, Function.update_of_ne hic] + · rw [ite_eq_right hil, Function.update_of_ne hil, Function.update_of_ne hic] exact transitionTape_eq_self (hwork i) · exact transitionTape_eq_self houtput @@ -209,27 +209,27 @@ theorem binaryForTM_step_rewind_equal_internal (body : TM n) (Function.update c.work counterIdx ((c.work counterIdx).move Dir3.right)) limitIdx ((c.work limitIdx).move Dir3.right) output := c.output } := by - rw [TM.step, if_neg (by rw [hstate]; simp [binaryForTM])] + rw [TM.step, ite_eq_right (by rw [hstate]; simp [binaryForTM])] simp only [binaryForTM, hstate] - rw [if_pos ⟨hcounter, hlimit⟩] + rw [ite_eq_left ⟨hcounter, hlimit⟩] dsimp only refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, ?_, ?_, ?_⟩) · exact transitionInput_eq_self hinput · funext i by_cases hic : i = counterIdx · subst i - rw [if_pos rfl, Function.update_of_ne hne, Function.update_self] + rw [ite_eq_left rfl, Function.update_of_ne hne, Function.update_self] show (((c.work counterIdx).write _).move Dir3.right) = (c.work counterIdx).move Dir3.right - rw [Tape.write, if_pos hcounterHead] - · rw [if_neg hic] + rw [Tape.write, ite_eq_left hcounterHead] + · rw [ite_eq_right hic] by_cases hil : i = limitIdx · subst i - rw [if_pos rfl, Function.update_self] + rw [ite_eq_left rfl, Function.update_self] show (((c.work limitIdx).write _).move Dir3.right) = (c.work limitIdx).move Dir3.right - rw [Tape.write, if_pos hlimitHead] - · rw [if_neg hil, Function.update_of_ne hil, Function.update_of_ne hic] + rw [Tape.write, ite_eq_left hlimitHead] + · rw [ite_eq_right hil, Function.update_of_ne hil, Function.update_of_ne hic] exact transitionTape_eq_self (hother i hic hil) · exact transitionTape_eq_self houtput @@ -255,27 +255,27 @@ theorem binaryForTM_step_rewind_unequal_internal (body : TM n) (Function.update c.work counterIdx ((c.work counterIdx).move Dir3.right)) limitIdx ((c.work limitIdx).move Dir3.right) output := c.output } := by - rw [TM.step, if_neg (by rw [hstate]; simp [binaryForTM])] + rw [TM.step, ite_eq_right (by rw [hstate]; simp [binaryForTM])] simp only [binaryForTM, hstate] - rw [if_pos ⟨hcounter, hlimit⟩] + rw [ite_eq_left ⟨hcounter, hlimit⟩] dsimp only refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, ?_, ?_, ?_⟩) · exact transitionInput_eq_self hinput · funext i by_cases hic : i = counterIdx · subst i - rw [if_pos rfl, Function.update_of_ne hne, Function.update_self] + rw [ite_eq_left rfl, Function.update_of_ne hne, Function.update_self] show (((c.work counterIdx).write _).move Dir3.right) = (c.work counterIdx).move Dir3.right - rw [Tape.write, if_pos hcounterHead] - · rw [if_neg hic] + rw [Tape.write, ite_eq_left hcounterHead] + · rw [ite_eq_right hic] by_cases hil : i = limitIdx · subst i - rw [if_pos rfl, Function.update_self] + rw [ite_eq_left rfl, Function.update_self] show (((c.work limitIdx).write _).move Dir3.right) = (c.work limitIdx).move Dir3.right - rw [Tape.write, if_pos hlimitHead] - · rw [if_neg hil, Function.update_of_ne hil, Function.update_of_ne hic] + rw [Tape.write, ite_eq_left hlimitHead] + · rw [ite_eq_right hil, Function.update_of_ne hil, Function.update_of_ne hic] exact transitionTape_eq_self (hother i hic hil) · exact transitionTape_eq_self houtput @@ -294,7 +294,7 @@ theorem binaryForTM_step_iteration_halt_internal (body : TM n) input := c.input work := c.work output := c.output } := by - rw [TM.step, if_neg (by simp [binaryForIterationWrap, binaryForTM])] + rw [TM.step, ite_eq_right (by simp [binaryForIterationWrap, binaryForTM])] simp only [binaryForIterationWrap, binaryForTM, hhalt, allReadBack, ↓reduceIte] refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, ?_, ?_, ?_⟩) · exact transitionInput_eq_self hinput diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryPred/Defs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryPred/Defs.lean index 63ae953e9e..b3bc78b87c 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryPred/Defs.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryPred/Defs.lean @@ -161,15 +161,15 @@ def binaryPredTM {n : ℕ} (idx : Fin n) : TM n where · subst i rw [htarget] at hi exact absurd hi (by decide) - · rw [if_neg hitarget] + · rw [ite_eq_right hitarget] exact idleDir_right_of_start hi | .start => simp only refine ⟨idleDir_right_of_start, fun i hi => ?_, idleDir_right_of_start⟩ by_cases hitarget : i = idx - · rw [if_pos hitarget] - · rw [if_neg hitarget] + · rw [ite_eq_left hitarget] + · rw [ite_eq_right hitarget] exact idleDir_right_of_start hi | .check => dsimp only @@ -182,15 +182,15 @@ def binaryPredTM {n : ℕ} (idx : Fin n) : TM n where · subst i rw [htarget] at hi exact absurd hi (by decide) - · rw [if_neg hitarget] + · rw [ite_eq_right hitarget] exact idleDir_right_of_start hi | .start => simp only refine ⟨idleDir_right_of_start, fun i hi => ?_, idleDir_right_of_start⟩ by_cases hitarget : i = idx - · rw [if_pos hitarget] - · rw [if_neg hitarget] + · rw [ite_eq_left hitarget] + · rw [ite_eq_right hitarget] exact idleDir_right_of_start hi | .erase => dsimp only @@ -198,8 +198,8 @@ def binaryPredTM {n : ℕ} (idx : Fin n) : TM n where · simp only refine ⟨idleDir_right_of_start, fun i hi => ?_, idleDir_right_of_start⟩ by_cases hitarget : i = idx - · rw [if_pos hitarget] - · rw [if_neg hitarget] + · rw [ite_eq_left hitarget] + · rw [ite_eq_right hitarget] exact idleDir_right_of_start hi · next hnotStart => simp only @@ -207,7 +207,7 @@ def binaryPredTM {n : ℕ} (idx : Fin n) : TM n where by_cases hitarget : i = idx · subst i exact absurd hi hnotStart - · rw [if_neg hitarget] + · rw [ite_eq_right hitarget] exact idleDir_right_of_start hi | .rewind => dsimp only @@ -215,8 +215,8 @@ def binaryPredTM {n : ℕ} (idx : Fin n) : TM n where · simp only refine ⟨idleDir_right_of_start, fun i hi => ?_, idleDir_right_of_start⟩ by_cases hitarget : i = idx - · rw [if_pos hitarget] - · rw [if_neg hitarget] + · rw [ite_eq_left hitarget] + · rw [ite_eq_right hitarget] exact idleDir_right_of_start hi · next hnotStart => simp only @@ -224,7 +224,7 @@ def binaryPredTM {n : ℕ} (idx : Fin n) : TM n where by_cases hitarget : i = idx · subst i exact absurd hi hnotStart - · rw [if_neg hitarget] + · rw [ite_eq_right hitarget] exact idleDir_right_of_start hi | .done => exact rightOfStart_allIdle iHead wHeads oHead diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryPred/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryPred/Internal.lean index ca12af339d..decd704266 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryPred/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryPred/Internal.lean @@ -99,13 +99,13 @@ private theorem HasBinaryContent.binaryPred_erase_last {t : Tape} have hhead0 : t.head ≠ 0 := by omega constructor · intro i hi - rw [Tape.write, if_neg hhead0] + rw [Tape.write, ite_eq_right hhead0] simp only rw [hhead, Function.update_of_ne (by omega)] have hcell := h.1 i (by simp; omega) simpa [List.getElem_append, hi] using hcell · intro i hi - rw [Tape.write, if_neg hhead0] + rw [Tape.write, ite_eq_right hhead0] simp only rw [hhead] by_cases heq : i = bitsPrefix.length @@ -163,7 +163,7 @@ private theorem binaryPredTM_step_zero (c : Cfg n (binaryPredTM idx).Q) work := Function.update c.work idx (((c.work idx).write Γ.one).move Dir3.right) output := c.output } := by - rw [TM.step, if_neg (binaryPredTM_ne_halt (by decide) hstate)] + rw [TM.step, ite_eq_right (binaryPredTM_ne_halt (by decide) hstate)] simp only [binaryPredTM, hstate, hread] refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, ?_, ?_, ?_⟩) · exact transitionInput_eq_self hinput @@ -173,7 +173,7 @@ private theorem binaryPredTM_step_zero (c : Cfg n (binaryPredTM idx).Q) simp only [↓reduceIte, Function.update_self] rfl · rw [Function.update_of_ne hi] - simpa only [if_neg hi] using transitionTape_eq_self (hother i hi) + simpa only [ite_eq_right hi] using transitionTape_eq_self (hother i hi) · exact transitionTape_eq_self houtput /-- Resolve borrow at the first one and advance to lookahead. -/ @@ -188,7 +188,7 @@ private theorem binaryPredTM_step_one (c : Cfg n (binaryPredTM idx).Q) work := Function.update c.work idx (((c.work idx).write Γ.zero).move Dir3.right) output := c.output } := by - rw [TM.step, if_neg (binaryPredTM_ne_halt (by decide) hstate)] + rw [TM.step, ite_eq_right (binaryPredTM_ne_halt (by decide) hstate)] simp only [binaryPredTM, hstate, hread] refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, ?_, ?_, ?_⟩) · exact transitionInput_eq_self hinput @@ -198,7 +198,7 @@ private theorem binaryPredTM_step_one (c : Cfg n (binaryPredTM idx).Q) simp only [↓reduceIte, Function.update_self] rfl · rw [Function.update_of_ne hi] - simpa only [if_neg hi] using transitionTape_eq_self (hother i hi) + simpa only [ite_eq_right hi] using transitionTape_eq_self (hother i hi) · exact transitionTape_eq_self houtput /-- Define zero underflow by turning left from the terminating blank. -/ @@ -213,16 +213,16 @@ private theorem binaryPredTM_step_borrow_blank input := c.input work := Function.update c.work idx ((c.work idx).move Dir3.left) output := c.output } := by - rw [TM.step, if_neg (binaryPredTM_ne_halt (by decide) hstate)] + rw [TM.step, ite_eq_right (binaryPredTM_ne_halt (by decide) hstate)] simp only [binaryPredTM, hstate, hread] refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, ?_, ?_, ?_⟩) · exact transitionInput_eq_self hinput · funext i by_cases hi : i = idx · subst i - rw [if_pos rfl, Function.update_self, + rw [ite_eq_left rfl, Function.update_self, writeAndMove_readBack _ (by rw [hread]; decide)] - · rw [if_neg hi, Function.update_of_ne hi] + · rw [ite_eq_right hi, Function.update_of_ne hi] exact transitionTape_eq_self (hother i hi) · exact transitionTape_eq_self houtput @@ -239,7 +239,7 @@ private theorem binaryPredTM_step_check_bit (bit : Bool) input := c.input work := Function.update c.work idx ((c.work idx).move Dir3.left) output := c.output } := by - rw [TM.step, if_neg (binaryPredTM_ne_halt (by decide) hstate)] + rw [TM.step, ite_eq_right (binaryPredTM_ne_halt (by decide) hstate)] cases bit <;> simp only [Γ.ofBool, binaryPredTM, hstate, hread] all_goals refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, ?_, ?_, ?_⟩) @@ -247,9 +247,9 @@ private theorem binaryPredTM_step_check_bit (bit : Bool) · funext i by_cases hi : i = idx · subst i - rw [if_pos rfl, Function.update_self, + rw [ite_eq_left rfl, Function.update_self, writeAndMove_readBack _ (by rw [hread]; decide)] - · rw [if_neg hi, Function.update_of_ne hi] + · rw [ite_eq_right hi, Function.update_of_ne hi] exact transitionTape_eq_self (hother i hi) · exact transitionTape_eq_self houtput @@ -265,16 +265,16 @@ private theorem binaryPredTM_step_check_blank input := c.input work := Function.update c.work idx ((c.work idx).move Dir3.left) output := c.output } := by - rw [TM.step, if_neg (binaryPredTM_ne_halt (by decide) hstate)] + rw [TM.step, ite_eq_right (binaryPredTM_ne_halt (by decide) hstate)] simp only [binaryPredTM, hstate, hread] refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, ?_, ?_, ?_⟩) · exact transitionInput_eq_self hinput · funext i by_cases hi : i = idx · subst i - rw [if_pos rfl, Function.update_self, + rw [ite_eq_left rfl, Function.update_self, writeAndMove_readBack _ (by rw [hread]; decide)] - · rw [if_neg hi, Function.update_of_ne hi] + · rw [ite_eq_right hi, Function.update_of_ne hi] exact transitionTape_eq_self (hother i hi) · exact transitionTape_eq_self houtput @@ -290,7 +290,7 @@ private theorem binaryPredTM_step_erase (c : Cfg n (binaryPredTM idx).Q) work := Function.update c.work idx (((c.work idx).write Γ.blank).move Dir3.left) output := c.output } := by - rw [TM.step, if_neg (binaryPredTM_ne_halt (by decide) hstate)] + rw [TM.step, ite_eq_right (binaryPredTM_ne_halt (by decide) hstate)] simp only [binaryPredTM, hstate, hread, ↓reduceIte] refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, ?_, ?_, ?_⟩) · exact transitionInput_eq_self hinput @@ -300,7 +300,7 @@ private theorem binaryPredTM_step_erase (c : Cfg n (binaryPredTM idx).Q) simp only [↓reduceIte, Function.update_self] rfl · rw [Function.update_of_ne hi] - simpa only [if_neg hi] using transitionTape_eq_self (hother i hi) + simpa only [ite_eq_right hi] using transitionTape_eq_self (hother i hi) · exact transitionTape_eq_self houtput /-- Rewind one ordinary target cell to the left. -/ @@ -314,16 +314,16 @@ private theorem binaryPredTM_step_rewind (c : Cfg n (binaryPredTM idx).Q) input := c.input work := Function.update c.work idx ((c.work idx).move Dir3.left) output := c.output } := by - rw [TM.step, if_neg (binaryPredTM_ne_halt (by decide) hstate)] + rw [TM.step, ite_eq_right (binaryPredTM_ne_halt (by decide) hstate)] simp only [binaryPredTM, hstate, hread, ↓reduceIte] refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, ?_, ?_, ?_⟩) · exact transitionInput_eq_self hinput · funext i by_cases hi : i = idx · subst i - rw [if_pos rfl, Function.update_self, + rw [ite_eq_left rfl, Function.update_self, writeAndMove_readBack _ hread] - · rw [if_neg hi, Function.update_of_ne hi] + · rw [ite_eq_right hi, Function.update_of_ne hi] exact transitionTape_eq_self (hother i hi) · exact transitionTape_eq_self houtput @@ -339,7 +339,7 @@ private theorem binaryPredTM_step_start (c : Cfg n (binaryPredTM idx).Q) input := c.input work := Function.update c.work idx ((c.work idx).move Dir3.right) output := c.output } := by - rw [TM.step, if_neg (binaryPredTM_ne_halt (by decide) hstate)] + rw [TM.step, ite_eq_right (binaryPredTM_ne_halt (by decide) hstate)] simp only [binaryPredTM, hstate, hread, ↓reduceIte] refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, ?_, ?_, ?_⟩) · exact transitionInput_eq_self hinput @@ -349,8 +349,8 @@ private theorem binaryPredTM_step_start (c : Cfg n (binaryPredTM idx).Q) simp only [↓reduceIte, Function.update_self] show (((c.work idx).write _).move Dir3.right) = (c.work idx).move Dir3.right - rw [Tape.write, if_pos hhead] - · rw [if_neg hi, Function.update_of_ne hi] + rw [Tape.write, ite_eq_left hhead] + · rw [ite_eq_right hi, Function.update_of_ne hi] exact transitionTape_eq_self (hother i hi) · exact transitionTape_eq_self houtput diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleAdd/Defs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleAdd/Defs.lean index aa0d9d6fb2..d91cf236a0 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleAdd/Defs.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleAdd/Defs.lean @@ -119,26 +119,26 @@ def binaryRippleAddScanTM {n : ℕ} intro i hi dsimp only by_cases hresult : i = resultIdx - · rw [if_pos hresult] - · rw [if_neg hresult] + · rw [ite_eq_left hresult] + · rw [ite_eq_right hresult] exact idleDir_right_of_start hi · exact rightOfStart_allReadBack iHead wHeads oHead · refine ⟨idleDir_right_of_start, ?_, idleDir_right_of_start⟩ intro i hi dsimp only by_cases hresult : i = resultIdx - · rw [if_pos hresult] - · rw [if_neg hresult] + · rw [ite_eq_left hresult] + · rw [ite_eq_right hresult] by_cases hlhs : i = lhsIdx - · rw [if_pos hlhs] + · rw [ite_eq_left hlhs] subst i simp [hi] - · rw [if_neg hlhs] + · rw [ite_eq_right hlhs] by_cases hrhs : i = rhsIdx - · rw [if_pos hrhs] + · rw [ite_eq_left hrhs] subst i simp [hi] - · rw [if_neg hrhs] + · rw [ite_eq_right hrhs] exact idleDir_right_of_start hi | done => exact rightOfStart_allIdle iHead wHeads oHead diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleAdd/Internal/Scan.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleAdd/Internal/Scan.lean index 59074a847c..c23b0b75a9 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleAdd/Internal/Scan.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleAdd/Internal/Scan.lean @@ -80,7 +80,7 @@ private theorem binaryRippleAddScanTM_step_active {n : ℕ} work := binaryRippleAddScanAdvanceWork lhsIdx rhsIdx resultIdx sum work output := out } := by dsimp only - rw [TM.step, if_neg (by simp [binaryRippleAddScanTM])] + rw [TM.step, ite_eq_right (by simp [binaryRippleAddScanTM])] simp only [binaryRippleAddScanTM, hactive, ↓reduceIte] refine congrArg some (Cfg.ext rfl (transitionInput_eq_self hinput) ?_ (transitionTape_eq_self houtput)) @@ -90,25 +90,25 @@ private theorem binaryRippleAddScanTM_step_active {n : ℕ} simp [binaryRippleAddScanAdvanceWork] · by_cases hlhsIdx : i = lhsIdx · subst i - simp only [binaryRippleAddScanAdvanceWork, hresultIdx, if_false, - if_pos] + simp only [binaryRippleAddScanAdvanceWork, hresultIdx, ite_false, + ite_eq_left] by_cases hblank : (work lhsIdx).read = Γ.blank - · rw [if_pos hblank, if_pos hblank] + · rw [ite_eq_left hblank, ite_eq_left hblank] simpa [hblank] using writeAndMove_readBack_stay (show (work lhsIdx).read ≠ Γ.start from hlhs) - · rw [if_neg hblank, if_neg hblank] + · rw [ite_eq_right hblank, ite_eq_right hblank] exact writeAndMove_readBack_right hlhs · by_cases hrhsIdx : i = rhsIdx · subst i - simp only [binaryRippleAddScanAdvanceWork, hresultIdx, if_false, - hlhsIdx, if_pos] + simp only [binaryRippleAddScanAdvanceWork, hresultIdx, ite_false, + hlhsIdx, ite_eq_left] by_cases hblank : (work rhsIdx).read = Γ.blank - · rw [if_pos hblank, if_pos hblank] + · rw [ite_eq_left hblank, ite_eq_left hblank] simpa [hblank] using writeAndMove_readBack_stay (show (work rhsIdx).read ≠ Γ.start from hrhs) - · rw [if_neg hblank, if_neg hblank] + · rw [ite_eq_right hblank, ite_eq_right hblank] exact writeAndMove_readBack_right hrhs - · simp only [binaryRippleAddScanAdvanceWork, hresultIdx, if_false, + · simp only [binaryRippleAddScanAdvanceWork, hresultIdx, ite_false, hlhsIdx, hrhsIdx] exact transitionTape_eq_self (hother i hlhsIdx hrhsIdx hresultIdx) @@ -141,9 +141,9 @@ private theorem binaryRippleAddScanTM_step_terminal {n : ℕ} cases carry with | false => refine ⟨work, ?_, rfl, rfl, rfl, rfl, ?_, hresultStart, ?_⟩ - · rw [TM.step, if_neg (by simp [binaryRippleAddScanTM])] - simp only [binaryRippleAddScanTM, hlhs, hrhs, and_self, if_pos, - Bool.false_eq_true, if_false, allReadBack] + · rw [TM.step, ite_eq_right (by simp [binaryRippleAddScanTM])] + simp only [binaryRippleAddScanTM, hlhs, hrhs, and_self, ite_eq_left, + Bool.false_eq_true, ite_false, allReadBack] refine congrArg some (Cfg.ext rfl (transitionInput_eq_self hinput) ?_ (transitionTape_eq_self houtput)) funext i @@ -166,8 +166,8 @@ private theorem binaryRippleAddScanTM_step_terminal {n : ℕ} let finalWork := Function.update work resultIdx ((work resultIdx).writeAndMove Γ.one Dir3.right) refine ⟨finalWork, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_⟩ - · rw [TM.step, if_neg (by simp [binaryRippleAddScanTM])] - simp only [binaryRippleAddScanTM, hlhs, hrhs, and_self, if_pos] + · rw [TM.step, ite_eq_right (by simp [binaryRippleAddScanTM])] + simp only [binaryRippleAddScanTM, hlhs, hrhs, and_self, ite_eq_left] refine congrArg some (Cfg.ext rfl (transitionInput_eq_self hinput) ?_ (transitionTape_eq_self houtput)) funext i @@ -329,9 +329,9 @@ private theorem binaryRippleAddScanTM_suffix_reachesIn {n : ℕ} hrhsNotBlank, Tape.move_cells] using hfinalRhs · rw [hfinalRhsHead] simp only [work₁, binaryRippleAddScanAdvanceWork, - if_neg hdistinct.rhs_result, - if_neg (Ne.symm hdistinct.lhs_rhs), if_pos, - if_neg hrhsNotBlank, Tape.move, List.length_cons] + ite_eq_right hdistinct.rhs_result, + ite_eq_right (Ne.symm hdistinct.lhs_rhs), ite_eq_left, + ite_eq_right hrhsNotBlank, Tape.move, List.length_cons] omega · simpa [BinaryRippleAdd.ripple, sum, nextCarry, List.append_assoc] using hfinalResult @@ -417,7 +417,7 @@ private theorem binaryRippleAddScanTM_suffix_reachesIn {n : ℕ} hfinalLhs · rw [hfinalLhsHead] simp only [work₁, binaryRippleAddScanAdvanceWork, - if_neg hdistinct.lhs_result, if_pos, if_neg hlhsNotBlank, + ite_eq_right hdistinct.lhs_result, ite_eq_left, ite_eq_right hlhsNotBlank, Tape.move, List.length_cons] omega · simpa [work₁, binaryRippleAddScanAdvanceWork, @@ -511,7 +511,7 @@ private theorem binaryRippleAddScanTM_suffix_reachesIn {n : ℕ} hfinalLhs · rw [hfinalLhsHead] simp only [work₁, binaryRippleAddScanAdvanceWork, - if_neg hdistinct.lhs_result, if_pos, if_neg hlhsNotBlank, + ite_eq_right hdistinct.lhs_result, ite_eq_left, ite_eq_right hlhsNotBlank, Tape.move, List.length_cons] omega · simpa [work₁, binaryRippleAddScanAdvanceWork, @@ -519,9 +519,9 @@ private theorem binaryRippleAddScanTM_suffix_reachesIn {n : ℕ} hrhsNotBlank, Tape.move_cells] using hfinalRhs · rw [hfinalRhsHead] simp only [work₁, binaryRippleAddScanAdvanceWork, - if_neg hdistinct.rhs_result, - if_neg (Ne.symm hdistinct.lhs_rhs), if_pos, - if_neg hrhsNotBlank, Tape.move, List.length_cons] + ite_eq_right hdistinct.rhs_result, + ite_eq_right (Ne.symm hdistinct.lhs_rhs), ite_eq_left, + ite_eq_right hrhsNotBlank, Tape.move, List.length_cons] omega · simpa [BinaryRippleAdd.ripple, sum, nextCarry, List.append_assoc] using hfinalResult diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleSub/Defs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleSub/Defs.lean index ba0c898930..5380f2f32b 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleSub/Defs.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleSub/Defs.lean @@ -182,26 +182,26 @@ def binaryRippleSubCoreTM {n : ℕ} simp only by_cases hresult : i = resultIdx · subst i - rw [if_pos rfl] + rw [ite_eq_left rfl] exact moveLeftDir_right_of_start hi - · rw [if_neg hresult] + · rw [ite_eq_right hresult] exact idleDir_right_of_start hi · refine ⟨idleDir_right_of_start, ?_, idleDir_right_of_start⟩ intro i hi dsimp only by_cases hresult : i = resultIdx - · rw [if_pos hresult] - · rw [if_neg hresult] + · rw [ite_eq_left hresult] + · rw [ite_eq_right hresult] by_cases hlhs : i = lhsIdx - · rw [if_pos hlhs] + · rw [ite_eq_left hlhs] subst i simp [hi] - · rw [if_neg hlhs] + · rw [ite_eq_right hlhs] by_cases hrhs : i = rhsIdx - · rw [if_pos hrhs] + · rw [ite_eq_left hrhs] subst i simp [hi] - · rw [if_neg hrhs] + · rw [ite_eq_right hrhs] exact idleDir_right_of_start hi | erase => dsimp only @@ -210,8 +210,8 @@ def binaryRippleSubCoreTM {n : ℕ} intro i hi simp only by_cases hresult : i = resultIdx - · rw [if_pos hresult] - · rw [if_neg hresult] + · rw [ite_eq_left hresult] + · rw [ite_eq_right hresult] exact idleDir_right_of_start hi · rename_i hnotStart refine ⟨idleDir_right_of_start, ?_, idleDir_right_of_start⟩ @@ -219,9 +219,9 @@ def binaryRippleSubCoreTM {n : ℕ} simp only by_cases hresult : i = resultIdx · subst i - rw [if_pos rfl] + rw [ite_eq_left rfl] exact moveLeftDir_right_of_start hi - · rw [if_neg hresult] + · rw [ite_eq_right hresult] exact idleDir_right_of_start hi | trim seenOne => dsimp only @@ -230,8 +230,8 @@ def binaryRippleSubCoreTM {n : ℕ} intro i hi simp only by_cases hresult : i = resultIdx - · rw [if_pos hresult] - · rw [if_neg hresult] + · rw [ite_eq_left hresult] + · rw [ite_eq_right hresult] exact idleDir_right_of_start hi · rename_i hnotStart split <;> @@ -241,9 +241,9 @@ def binaryRippleSubCoreTM {n : ℕ} simp only by_cases hresult : i = resultIdx · subst i - rw [if_pos rfl] + rw [ite_eq_left rfl] exact moveLeftDir_right_of_start hi - · rw [if_neg hresult] + · rw [ite_eq_right hresult] exact idleDir_right_of_start hi | done => exact rightOfStart_allIdle iHead wHeads oHead diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleSub/Internal/Backward.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleSub/Internal/Backward.lean index a30e6500c6..524221bbe7 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleSub/Internal/Backward.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleSub/Internal/Backward.lean @@ -37,13 +37,13 @@ theorem HasBinaryContent.write_blank_last_internal {t : Tape} have hhead0 : t.head ≠ 0 := by omega constructor · intro i hi - rw [Tape.write, if_neg hhead0] + rw [Tape.write, ite_eq_right hhead0] simp only rw [hhead, Function.update_of_ne (by omega)] have hcell := h.1 i (by simp; omega) simpa [List.getElem_append, hi] using hcell · intro i hi - rw [Tape.write, if_neg hhead0] + rw [Tape.write, ite_eq_right hhead0] simp only rw [hhead] by_cases heq : i = bitsPrefix.length @@ -80,7 +80,7 @@ private theorem binaryRippleSubCoreTM_step_erase work := Function.update c.work resultIdx (((c.work resultIdx).write Γ.blank).move Dir3.left) output := c.output } := by - rw [TM.step, if_neg (binaryRippleSubCoreTM_ne_halt (by simp) hstate)] + rw [TM.step, ite_eq_right (binaryRippleSubCoreTM_ne_halt (by simp) hstate)] simp only [binaryRippleSubCoreTM, hstate, hread, ↓reduceIte] refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, ?_, ?_, ?_⟩) · exact transitionInput_eq_self hinput @@ -90,7 +90,7 @@ private theorem binaryRippleSubCoreTM_step_erase simp only [↓reduceIte, Function.update_self] simp [moveLeftDir, hread] · rw [Function.update_of_ne hi] - simpa only [if_neg hi] using transitionTape_eq_self (hother i hi) + simpa only [ite_eq_right hi] using transitionTape_eq_self (hother i hi) · exact transitionTape_eq_self houtput private theorem binaryRippleSubCoreTM_step_trim_false_zero @@ -106,7 +106,7 @@ private theorem binaryRippleSubCoreTM_step_trim_false_zero work := Function.update c.work resultIdx (((c.work resultIdx).write Γ.blank).move Dir3.left) output := c.output } := by - rw [TM.step, if_neg (binaryRippleSubCoreTM_ne_halt (by decide) hstate)] + rw [TM.step, ite_eq_right (binaryRippleSubCoreTM_ne_halt (by decide) hstate)] simp only [binaryRippleSubCoreTM, hstate] simp [hread] refine ⟨transitionInput_eq_self hinput, ?_, transitionTape_eq_self houtput⟩ @@ -116,7 +116,7 @@ private theorem binaryRippleSubCoreTM_step_trim_false_zero simp only [↓reduceIte, Function.update_self] simp [moveLeftDir] · rw [Function.update_of_ne hi] - simpa only [if_neg hi] using transitionTape_eq_self (hother i hi) + simpa only [ite_eq_right hi] using transitionTape_eq_self (hother i hi) private theorem binaryRippleSubCoreTM_step_trim_false_one (c : Cfg n (binaryRippleSubCoreTM lhsIdx rhsIdx resultIdx).Q) @@ -131,19 +131,19 @@ private theorem binaryRippleSubCoreTM_step_trim_false_one work := Function.update c.work resultIdx ((c.work resultIdx).move Dir3.left) output := c.output } := by - rw [TM.step, if_neg (binaryRippleSubCoreTM_ne_halt (by decide) hstate)] + rw [TM.step, ite_eq_right (binaryRippleSubCoreTM_ne_halt (by decide) hstate)] simp only [binaryRippleSubCoreTM, hstate] simp [hread] refine ⟨transitionInput_eq_self hinput, ?_, transitionTape_eq_self houtput⟩ funext i by_cases hi : i = resultIdx · subst i - rw [if_pos rfl, Function.update_self] + rw [ite_eq_left rfl, Function.update_self] change (c.work resultIdx).writeAndMove (readBackWrite (c.work resultIdx).read) (moveLeftDir Γ.one) = _ rw [writeAndMove_readBack _ (by rw [hread]; decide)] simp [moveLeftDir] - · rw [if_neg hi, Function.update_of_ne hi] + · rw [ite_eq_right hi, Function.update_of_ne hi] exact transitionTape_eq_self (hother i hi) private theorem binaryRippleSubCoreTM_step_trim_true @@ -159,20 +159,20 @@ private theorem binaryRippleSubCoreTM_step_trim_true work := Function.update c.work resultIdx ((c.work resultIdx).move Dir3.left) output := c.output } := by - rw [TM.step, if_neg (binaryRippleSubCoreTM_ne_halt (by decide) hstate)] + rw [TM.step, ite_eq_right (binaryRippleSubCoreTM_ne_halt (by decide) hstate)] simp only [binaryRippleSubCoreTM, hstate] simp [hread] refine ⟨transitionInput_eq_self hinput, ?_, transitionTape_eq_self houtput⟩ funext i by_cases hi : i = resultIdx · subst i - rw [if_pos rfl, Function.update_self] + rw [ite_eq_left rfl, Function.update_self] change (c.work resultIdx).writeAndMove (readBackWrite (c.work resultIdx).read) (moveLeftDir (c.work resultIdx).read) = _ rw [writeAndMove_readBack _ hread] simp [moveLeftDir, hread] - · rw [if_neg hi, Function.update_of_ne hi] + · rw [ite_eq_right hi, Function.update_of_ne hi] exact transitionTape_eq_self (hother i hi) private theorem binaryRippleSubCoreTM_step_erase_start @@ -189,7 +189,7 @@ private theorem binaryRippleSubCoreTM_step_erase_start work := Function.update c.work resultIdx ((c.work resultIdx).move Dir3.right) output := c.output } := by - rw [TM.step, if_neg (binaryRippleSubCoreTM_ne_halt (by simp) hstate)] + rw [TM.step, ite_eq_right (binaryRippleSubCoreTM_ne_halt (by simp) hstate)] simp only [binaryRippleSubCoreTM, hstate, hread, ↓reduceIte] refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, ?_, ?_, ?_⟩) · exact transitionInput_eq_self hinput @@ -199,8 +199,8 @@ private theorem binaryRippleSubCoreTM_step_erase_start simp only [↓reduceIte, Function.update_self] show (((c.work resultIdx).write _).move Dir3.right) = (c.work resultIdx).move Dir3.right - rw [Tape.write, if_pos hhead] - · rw [if_neg hi, Function.update_of_ne hi] + rw [Tape.write, ite_eq_left hhead] + · rw [ite_eq_right hi, Function.update_of_ne hi] exact transitionTape_eq_self (hother i hi) · exact transitionTape_eq_self houtput @@ -219,7 +219,7 @@ private theorem binaryRippleSubCoreTM_step_trim_start work := Function.update c.work resultIdx ((c.work resultIdx).move Dir3.right) output := c.output } := by - rw [TM.step, if_neg (binaryRippleSubCoreTM_ne_halt (by simp) hstate)] + rw [TM.step, ite_eq_right (binaryRippleSubCoreTM_ne_halt (by simp) hstate)] simp only [binaryRippleSubCoreTM, hstate, hread, ↓reduceIte] refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, ?_, ?_, ?_⟩) · exact transitionInput_eq_self hinput @@ -229,8 +229,8 @@ private theorem binaryRippleSubCoreTM_step_trim_start simp only [↓reduceIte, Function.update_self] show (((c.work resultIdx).write _).move Dir3.right) = (c.work resultIdx).move Dir3.right - rw [Tape.write, if_pos hhead] - · rw [if_neg hi, Function.update_of_ne hi] + rw [Tape.write, ite_eq_left hhead] + · rw [ite_eq_right hi, Function.update_of_ne hi] exact transitionTape_eq_self (hother i hi) · exact transitionTape_eq_self houtput diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleSub/Internal/Pure.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleSub/Internal/Pure.lean index 544a10ccbe..97ff0dffc0 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleSub/Internal/Pure.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleSub/Internal/Pure.lean @@ -178,7 +178,7 @@ theorem subtract_natBits_internal (lhs rhs : ℕ) : change (if raw.borrow then [] else trimHighZeros raw.bits) = (lhs - rhs).bits cases hborrow : raw.borrow with | false => - simp only [Bool.false_eq_true, if_false] + simp only [Bool.false_eq_true, ite_false] rw [trimHighZeros_eq_natBits_internal] have hvalue : Nat.fromBitsLE raw.bits = lhs - rhs := by simp [hborrow] at hinvariant' diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleSub/Internal/Scan.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleSub/Internal/Scan.lean index cbfef932a7..dd83406399 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleSub/Internal/Scan.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleSub/Internal/Scan.lean @@ -68,7 +68,7 @@ private theorem binaryRippleSubCoreTM_step_active {n : ℕ} work := binaryRippleSubScanAdvanceWork lhsIdx rhsIdx resultIdx diff work output := out } := by dsimp only - rw [TM.step, if_neg (by simp [binaryRippleSubCoreTM])] + rw [TM.step, ite_eq_right (by simp [binaryRippleSubCoreTM])] simp only [binaryRippleSubCoreTM, hactive, ↓reduceIte] refine congrArg some (Cfg.ext rfl (transitionInput_eq_self hinput) ?_ (transitionTape_eq_self houtput)) @@ -78,24 +78,24 @@ private theorem binaryRippleSubCoreTM_step_active {n : ℕ} simp [binaryRippleSubScanAdvanceWork] · by_cases hlhsIdx : i = lhsIdx · subst i - simp only [binaryRippleSubScanAdvanceWork, hresultIdx, if_false, if_pos] + simp only [binaryRippleSubScanAdvanceWork, hresultIdx, ite_false, ite_eq_left] by_cases hblank : (work lhsIdx).read = Γ.blank - · rw [if_pos hblank, if_pos hblank] + · rw [ite_eq_left hblank, ite_eq_left hblank] rw [writeAndMove_readBack _ hlhs Dir3.stay] rfl - · rw [if_neg hblank, if_neg hblank] + · rw [ite_eq_right hblank, ite_eq_right hblank] exact writeAndMove_readBack (work lhsIdx) hlhs Dir3.right · by_cases hrhsIdx : i = rhsIdx · subst i - simp only [binaryRippleSubScanAdvanceWork, hresultIdx, if_false, - hlhsIdx, if_pos] + simp only [binaryRippleSubScanAdvanceWork, hresultIdx, ite_false, + hlhsIdx, ite_eq_left] by_cases hblank : (work rhsIdx).read = Γ.blank - · rw [if_pos hblank, if_pos hblank] + · rw [ite_eq_left hblank, ite_eq_left hblank] rw [writeAndMove_readBack _ hrhs Dir3.stay] rfl - · rw [if_neg hblank, if_neg hblank] + · rw [ite_eq_right hblank, ite_eq_right hblank] exact writeAndMove_readBack (work rhsIdx) hrhs Dir3.right - · simp only [binaryRippleSubScanAdvanceWork, hresultIdx, if_false, + · simp only [binaryRippleSubScanAdvanceWork, hresultIdx, ite_false, hlhsIdx, hrhsIdx] exact transitionTape_eq_self (hother i hlhsIdx hrhsIdx hresultIdx) @@ -132,8 +132,8 @@ private theorem binaryRippleSubCoreTM_step_terminal {n : ℕ} dsimp only let finalWork := binaryRippleSubScanTurnWork resultIdx work refine ⟨?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_⟩ - · rw [TM.step, if_neg (by simp [binaryRippleSubCoreTM])] - simp only [binaryRippleSubCoreTM, hlhs, hrhs, and_self, if_pos] + · rw [TM.step, ite_eq_right (by simp [binaryRippleSubCoreTM])] + simp only [binaryRippleSubCoreTM, hlhs, hrhs, and_self, ite_eq_left] refine congrArg some (Cfg.ext rfl (transitionInput_eq_self hinput) ?_ (transitionTape_eq_self houtput)) funext i @@ -317,9 +317,9 @@ private theorem binaryRippleSubCoreTM_suffix_reachesIn {n : ℕ} hrhsNotBlank, Tape.move_cells] using hfinalRhs · rw [hfinalRhsHead] simp only [work₁, binaryRippleSubScanAdvanceWork, - if_neg hdistinct.rhs_result, - if_neg (Ne.symm hdistinct.lhs_rhs), if_pos, - if_neg hrhsNotBlank, Tape.move, List.length_cons] + ite_eq_right hdistinct.rhs_result, + ite_eq_right (Ne.symm hdistinct.lhs_rhs), ite_eq_left, + ite_eq_right hrhsNotBlank, Tape.move, List.length_cons] omega · simpa [BinaryRippleSub.scan, diff, nextBorrow, List.append_assoc] using hfinalResult @@ -408,7 +408,7 @@ private theorem binaryRippleSubCoreTM_suffix_reachesIn {n : ℕ} hfinalLhs · rw [hfinalLhsHead] simp only [work₁, binaryRippleSubScanAdvanceWork, - if_neg hdistinct.lhs_result, if_pos, if_neg hlhsNotBlank, + ite_eq_right hdistinct.lhs_result, ite_eq_left, ite_eq_right hlhsNotBlank, Tape.move, List.length_cons] omega · simpa [work₁, binaryRippleSubScanAdvanceWork, @@ -505,7 +505,7 @@ private theorem binaryRippleSubCoreTM_suffix_reachesIn {n : ℕ} hfinalLhs · rw [hfinalLhsHead] simp only [work₁, binaryRippleSubScanAdvanceWork, - if_neg hdistinct.lhs_result, if_pos, if_neg hlhsNotBlank, + ite_eq_right hdistinct.lhs_result, ite_eq_left, ite_eq_right hlhsNotBlank, Tape.move, List.length_cons] omega · simpa [work₁, binaryRippleSubScanAdvanceWork, @@ -513,9 +513,9 @@ private theorem binaryRippleSubCoreTM_suffix_reachesIn {n : ℕ} hrhsNotBlank, Tape.move_cells] using hfinalRhs · rw [hfinalRhsHead] simp only [work₁, binaryRippleSubScanAdvanceWork, - if_neg hdistinct.rhs_result, - if_neg (Ne.symm hdistinct.lhs_rhs), if_pos, - if_neg hrhsNotBlank, Tape.move, List.length_cons] + ite_eq_right hdistinct.rhs_result, + ite_eq_right (Ne.symm hdistinct.lhs_rhs), ite_eq_left, + ite_eq_right hrhsNotBlank, Tape.move, List.length_cons] omega · simpa [BinaryRippleSub.scan, diff, nextBorrow, List.append_assoc] using hfinalResult diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryShiftMul/Internal/Sem.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryShiftMul/Internal/Sem.lean index 5c028ee273..5309744836 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryShiftMul/Internal/Sem.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryShiftMul/Internal/Sem.lean @@ -590,7 +590,7 @@ private theorem binaryShiftMulBodyTime_le (bit : Bool) (acc shift width : ℕ) have hdouble := binaryShiftMulDoubleTime_le shift width hshift cases bit <;> simp only [binaryShiftMulBodyTime, binaryShiftMulOneTime, - Bool.false_eq_true, if_false, if_true] <;> + Bool.false_eq_true, ite_false, if_true] <;> omega private theorem forBinaryWorkLoopTime_le @@ -839,9 +839,9 @@ private theorem binaryShiftMulLoopWork_advance {n : ℕ} funext i by_cases hrhs : i = abi.rhs · subst i - simp only [if_pos, binaryShiftMulLoopWork_rhs] + simp only [ite_eq_left, binaryShiftMulLoopWork_rhs] simp [binaryShiftMulCursorTape, Tape.move] - · rw [if_neg hrhs] + · rw [ite_eq_right hrhs] by_cases hacc : i = abi.acc · subst i rw [binaryShiftMulLoopWork_acc, binaryShiftMulLoopWork_acc] @@ -1679,9 +1679,9 @@ private theorem binaryShiftMulCleanupTime_le {n : ℕ} simp [binaryShiftMulWidth] simp only [binaryShiftMulCleanupTime, resetBinaryWorkManyTime, binaryShiftMulCleanupBits, binaryShiftMulCleanupHead, - resetBinaryWorkTime, clearWorkTimeBound, if_pos] - simp only [if_neg (Ne.symm abi.shift_ne_tmp), - if_neg (Ne.symm abi.shift_ne_dbl), List.length_nil] + resetBinaryWorkTime, clearWorkTimeBound, ite_eq_left] + simp only [ite_eq_right (Ne.symm abi.shift_ne_tmp), + ite_eq_right (Ne.symm abi.shift_ne_dbl), List.length_nil] omega /-- The concrete shift-and-add multiplier preserves both operands, writes diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinarySucc/Defs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinarySucc/Defs.lean index bf332d944d..67dc18df55 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinarySucc/Defs.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinarySucc/Defs.lean @@ -129,14 +129,14 @@ def binarySuccTM {n : ℕ} (idx : Fin n) : TM n where · subst i rw [htarget] at hi exact absurd hi (by decide) - · rw [if_neg hitarget] + · rw [ite_eq_right hitarget] exact idleDir_right_of_start hi | .start => simp only refine ⟨idleDir_right_of_start, fun i hi => ?_, idleDir_right_of_start⟩ by_cases hitarget : i = idx - · rw [if_pos hitarget] - · rw [if_neg hitarget] + · rw [ite_eq_left hitarget] + · rw [ite_eq_right hitarget] exact idleDir_right_of_start hi | .rewind => dsimp only @@ -144,8 +144,8 @@ def binarySuccTM {n : ℕ} (idx : Fin n) : TM n where · simp only refine ⟨idleDir_right_of_start, fun i hi => ?_, idleDir_right_of_start⟩ by_cases hitarget : i = idx - · rw [if_pos hitarget] - · rw [if_neg hitarget] + · rw [ite_eq_left hitarget] + · rw [ite_eq_right hitarget] exact idleDir_right_of_start hi · next hnotStart => simp only @@ -153,7 +153,7 @@ def binarySuccTM {n : ℕ} (idx : Fin n) : TM n where by_cases hitarget : i = idx · subst i exact absurd hi hnotStart - · rw [if_neg hitarget] + · rw [ite_eq_right hitarget] exact idleDir_right_of_start hi | .done => exact rightOfStart_allIdle iHead wHeads oHead diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinarySucc/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinarySucc/Internal.lean index bd3da858fe..260a31ed4d 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinarySucc/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinarySucc/Internal.lean @@ -118,7 +118,7 @@ private theorem binarySuccTM_step_one (c : Cfg n (binarySuccTM idx).Q) work := Function.update c.work idx (((c.work idx).write Γ.zero).move Dir3.right) output := c.output } := by - rw [TM.step, if_neg (binarySuccTM_ne_halt (by decide) hstate)] + rw [TM.step, ite_eq_right (binarySuccTM_ne_halt (by decide) hstate)] simp only [binarySuccTM, hstate, hread] refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, ?_, ?_, ?_⟩) · exact transitionInput_eq_self hinput @@ -128,7 +128,7 @@ private theorem binarySuccTM_step_one (c : Cfg n (binarySuccTM idx).Q) simp only [↓reduceIte, Function.update_self] rfl · rw [Function.update_of_ne hi] - simpa only [if_neg hi] using transitionTape_eq_self (hother i hi) + simpa only [ite_eq_right hi] using transitionTape_eq_self (hother i hi) · exact transitionTape_eq_self houtput /-- Resolve a carry on zero: write one and turn left. -/ @@ -143,7 +143,7 @@ private theorem binarySuccTM_step_zero (c : Cfg n (binarySuccTM idx).Q) work := Function.update c.work idx (((c.work idx).write Γ.one).move Dir3.left) output := c.output } := by - rw [TM.step, if_neg (binarySuccTM_ne_halt (by decide) hstate)] + rw [TM.step, ite_eq_right (binarySuccTM_ne_halt (by decide) hstate)] simp only [binarySuccTM, hstate, hread] refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, ?_, ?_, ?_⟩) · exact transitionInput_eq_self hinput @@ -153,7 +153,7 @@ private theorem binarySuccTM_step_zero (c : Cfg n (binarySuccTM idx).Q) simp only [↓reduceIte, Function.update_self] rfl · rw [Function.update_of_ne hi] - simpa only [if_neg hi] using transitionTape_eq_self (hother i hi) + simpa only [ite_eq_right hi] using transitionTape_eq_self (hother i hi) · exact transitionTape_eq_self houtput /-- Resolve overflow on the terminating blank: append one and turn left. -/ @@ -168,7 +168,7 @@ private theorem binarySuccTM_step_blank (c : Cfg n (binarySuccTM idx).Q) work := Function.update c.work idx (((c.work idx).write Γ.one).move Dir3.left) output := c.output } := by - rw [TM.step, if_neg (binarySuccTM_ne_halt (by decide) hstate)] + rw [TM.step, ite_eq_right (binarySuccTM_ne_halt (by decide) hstate)] simp only [binarySuccTM, hstate, hread] refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, ?_, ?_, ?_⟩) · exact transitionInput_eq_self hinput @@ -178,7 +178,7 @@ private theorem binarySuccTM_step_blank (c : Cfg n (binarySuccTM idx).Q) simp only [↓reduceIte, Function.update_self] rfl · rw [Function.update_of_ne hi] - simpa only [if_neg hi] using transitionTape_eq_self (hother i hi) + simpa only [ite_eq_right hi] using transitionTape_eq_self (hother i hi) · exact transitionTape_eq_self houtput /-- Rewind one ordinary target cell to the left. -/ @@ -192,16 +192,16 @@ private theorem binarySuccTM_step_rewind (c : Cfg n (binarySuccTM idx).Q) input := c.input work := Function.update c.work idx ((c.work idx).move Dir3.left) output := c.output } := by - rw [TM.step, if_neg (binarySuccTM_ne_halt (by decide) hstate)] + rw [TM.step, ite_eq_right (binarySuccTM_ne_halt (by decide) hstate)] simp only [binarySuccTM, hstate, hread, ↓reduceIte] refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, ?_, ?_, ?_⟩) · exact transitionInput_eq_self hinput · funext i by_cases hi : i = idx · subst i - rw [if_pos rfl, Function.update_self, + rw [ite_eq_left rfl, Function.update_self, writeAndMove_readBack _ hread] - · rw [if_neg hi, Function.update_of_ne hi] + · rw [ite_eq_right hi, Function.update_of_ne hi] exact transitionTape_eq_self (hother i hi) · exact transitionTape_eq_self houtput @@ -217,7 +217,7 @@ private theorem binarySuccTM_step_start (c : Cfg n (binarySuccTM idx).Q) input := c.input work := Function.update c.work idx ((c.work idx).move Dir3.right) output := c.output } := by - rw [TM.step, if_neg (binarySuccTM_ne_halt (by decide) hstate)] + rw [TM.step, ite_eq_right (binarySuccTM_ne_halt (by decide) hstate)] simp only [binarySuccTM, hstate, hread, ↓reduceIte] refine congrArg some ((Cfg.mk.injEq ..).mpr ⟨rfl, ?_, ?_, ?_⟩) · exact transitionInput_eq_self hinput @@ -227,8 +227,8 @@ private theorem binarySuccTM_step_start (c : Cfg n (binarySuccTM idx).Q) simp only [↓reduceIte, Function.update_self] show (((c.work idx).write _).move Dir3.right) = (c.work idx).move Dir3.right - rw [Tape.write, if_pos hhead] - · rw [if_neg hi, Function.update_of_ne hi] + rw [Tape.write, ite_eq_left hhead] + · rw [ite_eq_right hi, Function.update_of_ne hi] exact transitionTape_eq_self (hother i hi) · exact transitionTape_eq_self houtput diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/Internal/CopyWorkOutput.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/Internal/CopyWorkOutput.lean index 1e40c71e17..fd63b810cc 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/Internal/CopyWorkOutput.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/Internal/CopyWorkOutput.lean @@ -144,7 +144,7 @@ private theorem copyWorkOutput_loop {n : ℕ} have hdstTape : c1.work dst = (c.work dst).writeAndMove (Γ.ofBool bit) Dir3.right := by dsimp only [c1] - simp only [if_pos] + simp only [ite_eq_left] rw [Γw.ofBool_toΓ] have hdstPrefix1 : (c1.work dst).HasBinaryPrefix (x.take (k + 1)) := by rw [hdstTape] @@ -152,7 +152,7 @@ private theorem copyWorkOutput_loop {n : ℕ} have hdst01 : (c1.work dst).cells 0 = dstCell0 := by rw [hdstTape] simp only [Tape.writeAndMove, Tape.move_cells, Tape.write] - rw [if_neg (by rw [hprefix.1]; omega)] + rw [ite_eq_right (by rw [hprefix.1]; omega)] change Function.update (c.work dst).cells (c.work dst).head (Γ.ofBool bit) 0 = dstCell0 rw [Function.update_of_ne (by rw [hprefix.1]; omega)] @@ -250,7 +250,7 @@ private theorem copyWorkOutput_step_frame {n : ℕ} (src dst : Fin n) exact hneHalt (by simpa [copyWorkToWorkTM] using hstate) | copying => unfold TM.step at hstep - rw [if_neg hneHalt] at hstep + rw [ite_eq_right hneHalt] at hstep have hc := Option.some.inj hstep rw [← hc] rw [hstate] diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/MoveLeftStep.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/MoveLeftStep.lean index 6bdda4f9a5..f07b202734 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/MoveLeftStep.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/MoveLeftStep.lean @@ -37,7 +37,7 @@ theorem writeAndMove_readBack_of_startInvariant (t : Tape) (h : Tape.StartInvari by_cases hh : t.head = 0 · show (t.write _).move d = t.move d congr 1 - rw [Tape.write, if_pos hh] + rw [Tape.write, ite_eq_left hh] · exact writeAndMove_readBack t (h.read_ne_start (by omega)) d /-- One unconditional step: every work tape named in `targets` moves left @@ -92,14 +92,14 @@ theorem moveLeftStepTM_hoareTime {n : ℕ} (targets : List (Fin n)) 1, le_refl 1, ?_, rfl, hinp.move_idle, hout.writeAndMove_readBack_idle, fun i => ?_⟩ · refine TM.reachesIn.step ?_ .zero simp only [TM.step, moveLeftStepTM, - if_neg (show WipeStepPhase.running ≠ WipeStepPhase.done by decide)] + ite_eq_right (show WipeStepPhase.running ≠ WipeStepPhase.done by decide)] congr 1 congr 1 funext i by_cases hi : i ∈ targets - · simp only [if_pos hi] + · simp only [ite_eq_left hi] exact writeAndMove_readBack_of_startInvariant (work i) (htarget i hi) _ - · simp only [if_neg hi] + · simp only [ite_eq_right hi] · dsimp only split · rfl diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/PairValidate/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/PairValidate/Internal.lean index 8eaa5b6a16..192b875ca1 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/PairValidate/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/PairValidate/Internal.lean @@ -26,7 +26,7 @@ namespace TM /-- Semantic meaning of a validator state with a yet-unread suffix. The three prefix states reconstruct the pending decoder input; the absorbing states have -fixedValue verdicts. -/ +constant verdicts. -/ private def pairValidateSuffix : PairValidateState → List Bool → Bool | .next, bits => (unpair? bits).isSome | .afterZero, bits => (unpair? (false :: bits)).isSome diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/ParkAll.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/ParkAll.lean index d308187966..50f94a8965 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/ParkAll.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/ParkAll.lean @@ -37,12 +37,12 @@ theorem move_idleDir_eq_of_startInvariant {t : Tape} (h : Tape.StartInvariant t) · have hh0 : t.head = 0 := by by_contra hc exact (h.2 t.head (by omega)) hh - rw [idleDir, if_pos hh] + rw [idleDir, ite_eq_left hh] refine Tape.ext ?_ (Tape.move_cells t Dir3.right) show t.head + 1 = max t.head 1 omega · have hh0 : t.head ≠ 0 := fun hc => hh (by rw [Tape.read, hc]; exact h.1) - rw [idleDir, if_neg hh] + rw [idleDir, ite_eq_right hh] show t = ⟨max t.head 1, t.cells⟩ have : max t.head 1 = t.head := by omega rw [this] @@ -74,7 +74,7 @@ theorem parkAll_hoareTime {n : ℕ} (inp₀ : Tape) (work₀ : Fin n → Tape) ( 1, le_refl 1, ?_, rfl, ?_, ?_, ?_⟩ · refine TM.reachesIn.step ?_ .zero simp only [TM.step, skipTM, - if_neg (show BumpPhase.go ≠ BumpPhase.done by decide), + ite_eq_right (show BumpPhase.go ≠ BumpPhase.done by decide), writeAndMove_readBack_of_startInvariant out hout] congr 2 funext i diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/ResetTapes.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/ResetTapes.lean index 5cb62593b3..557bb7c591 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/ResetTapes.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/ResetTapes.lean @@ -131,7 +131,7 @@ theorem resetTapes_hoareTime {n : ℕ} (targets : List (Fin n)) (hnodup : target by_cases hjt : j ∈ targets · rw [hts j hjt, hworkC]; simp [hjt] · rw [hnts j hjt, hworkC] - simp only [hjt, if_false] + simp only [hjt, ite_false] exact Tape.ext (by show max (work₀ j).head 1 = (work₀ j).head have := (hother j hjr hjt).1 @@ -173,7 +173,7 @@ theorem resetTapes_hoareTime {n : ℕ} (targets : List (Fin n)) (hnodup : target rintro inp work out ⟨hi, hw, ho⟩ refine ⟨hi, ho.trans hout0.symm, fun j hjt => ?_, ?_, fun j hjr hjt => ?_⟩ · rw [hw, Function.update_of_ne (fun h => hr (by rw [h] at hjt; exact hjt)), - if_pos hjt, hworkC] + ite_eq_left hjt, hworkC] simp [hjt] · rw [hw, Function.update_self] · rw [hw, Function.update_of_ne hjr, hworkC] @@ -233,7 +233,7 @@ theorem resetTapesTM_hoareTime {n : ℕ} (targets : List (Fin n)) (hnodup : targ dsimp only split · exact ⟨show 1 ≤ H + 1 by omega, - fun i hi => by rw [initNil_cells, if_neg (by omega)]; decide⟩ + fun i hi => by rw [initNil_cells, ite_eq_right (by omega)]; decide⟩ · split · exact hregParked · next hjt hjr => exact hother j hjr hjt @@ -241,8 +241,8 @@ theorem resetTapesTM_hoareTime {n : ℕ} (targets : List (Fin n)) (hnodup : targ (workD j).cells 0 = Γ.start ∧ (workD j).head ≤ H + 1 := by intro j hj rw [hworkD] - simp only [if_pos hj] - exact ⟨by rw [initNil_cells, if_pos rfl], le_refl _⟩ + simp only [ite_eq_left hj] + exact ⟨by rw [initNil_cells, ite_eq_left rfl], le_refl _⟩ have hfirst := resetTapes_hoareTime targets hnodup r hr H inp₀ work₀ out₀ hinpSI hinpP hout0 hworkSI htargetHead hworkR hother have hsecond := rewindList_hoareTime targets hnodup (H + 1) inp₀ workD out₀ hinpP houtP @@ -265,7 +265,7 @@ theorem resetTapesTM_hoareTime {n : ℕ} (targets : List (Fin n)) (hnodup : targ · rintro inp work out ⟨hi, ho, hts, hnts⟩ refine ⟨hi, ho, fun j hj => ?_, ?_, fun j hjr hjt => ?_⟩ · rw [hts j hj, hworkD] - simp only [if_pos hj] + simp only [ite_eq_left hj] rfl · rw [hnts r hr, hworkD] simp [hr] diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/WipeLoop.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/WipeLoop.lean index f4e2f4ec44..9d2b5ee244 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/WipeLoop.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/WipeLoop.lean @@ -56,31 +56,31 @@ blanks exactly cells `1 … H` and leaves every other cell alone. -/ theorem wipedTape_cells_of_head_one {t : Tape} (hh : t.head = 1) (H j : ℕ) : (wipedTape t H).cells j = if 1 ≤ j ∧ j ≤ H then Γ.blank else t.cells j := by induction H with - | zero => rw [wipedTape_zero, if_neg (by omega : ¬(1 ≤ j ∧ j ≤ 0))] + | zero => rw [wipedTape_zero, ite_eq_right (by omega : ¬(1 ≤ j ∧ j ≤ 0))] | succ H ih => have hheadH : (wipedTape t H).head = H + 1 := by rw [wipedTape_head, hh]; omega rw [wipedTape_succ] show (((wipedTape t H).write Γw.blank.toΓ).move Dir3.right).cells j = _ - rw [Tape.move_cells, Tape.write, if_neg (by rw [hheadH]; omega)] + rw [Tape.move_cells, Tape.write, ite_eq_right (by rw [hheadH]; omega)] show Function.update (wipedTape t H).cells (wipedTape t H).head Γw.blank.toΓ j = _ rw [hheadH] by_cases hj : j = H + 1 - · rw [hj, Function.update_self, if_pos ⟨by omega, by omega⟩] + · rw [hj, Function.update_self, ite_eq_left ⟨by omega, by omega⟩] rfl · rw [Function.update_of_ne hj, ih] by_cases hc : 1 ≤ j ∧ j ≤ H - · rw [if_pos hc, if_pos ⟨hc.1, by omega⟩] + · rw [ite_eq_left hc, ite_eq_left ⟨hc.1, by omega⟩] · have hc' : ¬(1 ≤ j ∧ j ≤ H + 1) := by rintro ⟨h1, h2⟩ exact hc ⟨h1, by omega⟩ - rw [if_neg hc, if_neg hc'] + rw [ite_eq_right hc, ite_eq_right hc'] /-- The canonical blank tape's cells, spelled out. -/ theorem initNil_cells (j : ℕ) : (Tape.init ([] : List Γ)).cells j = if j = 0 then Γ.start else Γ.blank := by cases j with | zero => exact Tape.init_cells_zero [] - | succ i => rw [Tape.init_cells_ge [] i (by simp), if_neg (Nat.succ_ne_zero i)] + | succ i => rw [Tape.init_cells_ge [] i (by simp), ite_eq_right (Nat.succ_ne_zero i)] /-- **Wiping really blanks the tape.** A tape parked at cell `1` whose content is confined to cells `1 … H` becomes literally the blank tape (head at `H + 1`) @@ -92,11 +92,11 @@ theorem wipedTape_eq_blank {t : Tape} (H : ℕ) (hh : t.head = 1) refine Tape.ext (by rw [wipedTape_head, hh]; show 1 + H = H + 1; omega) (funext fun j => ?_) rw [wipedTape_cells_of_head_one hh, initNil_cells] by_cases hj0 : j = 0 - · rw [hj0, if_neg (by omega : ¬(1 ≤ 0 ∧ 0 ≤ H)), if_pos rfl, h0] - · rw [if_neg hj0] + · rw [hj0, ite_eq_right (by omega : ¬(1 ≤ 0 ∧ 0 ≤ H)), ite_eq_left rfl, h0] + · rw [ite_eq_right hj0] by_cases hc : 1 ≤ j ∧ j ≤ H - · rw [if_pos hc] - · rw [if_neg hc, hfar j (by omega)] + · rw [ite_eq_left hc] + · rw [ite_eq_right hc, hfar j (by omega)] /-- Wiping preserves `Parked`-ness: the head only advances, and every written or untouched cell beyond the marker stays off `▷`. -/ @@ -114,7 +114,7 @@ theorem wipedTape_parked {t : Tape} (h : Parked t) (i : ℕ) : Parked (wipedTape show 1 ≤ ((wipedTape t i).write Γw.blank.toΓ).head + 1 omega · rw [hheq, Tape.move_cells] - simp only [Tape.write, if_neg hhead_ne] + simp only [Tape.write, ite_eq_right hhead_ne] show Function.update (wipedTape t i).cells (wipedTape t i).head Γw.blank.toΓ j ≠ Γ.start by_cases hje : j = (wipedTape t i).head · rw [hje, Function.update_self]; decide @@ -183,7 +183,7 @@ theorem wipeLoop_hoareTime {n : ℕ} (targets : List (Fin n)) (r : Fin n) by_cases hjr : j = r · subst hjr; simp [hw, Function.update_self] · rw [Function.update_of_ne hjr] - simp only [hw, if_neg hjr] + simp only [hw, ite_eq_right hjr] split · rfl · rfl @@ -192,13 +192,13 @@ theorem wipeLoop_hoareTime {n : ℕ} (targets : List (Fin n)) (r : Fin n) funext j by_cases hjr : j = r · subst hjr; simp [hw, Function.update_self] - · rw [Function.update_of_ne hjr]; simp [hw, if_neg hjr] + · rw [Function.update_of_ne hjr]; simp [hw, ite_eq_right hjr] have hwork_parked : ∀ i j, j ≠ r → Parked (w i j) := by intro i j hjr by_cases hjt : j ∈ targets - · simp only [hw, if_neg hjr, if_pos hjt] + · simp only [hw, ite_eq_right hjr, ite_eq_left hjt] exact wipedTape_parked (hother j hjr) i - · simp only [hw, if_neg hjr, if_neg hjt] + · simp only [hw, ite_eq_right hjr, ite_eq_right hjt] exact hother j hjr have hbody : ∀ i, i < v → (wipeStepTM targets).HoareTime (fun inp work out => inp = inp₀ ∧ @@ -223,20 +223,20 @@ theorem wipeLoop_hoareTime {n : ℕ} (targets : List (Fin n)) (r : Fin n) rw [hwork j] by_cases hjr : j = r · subst hjr - rw [if_neg hr, hW, Function.update_self, Function.update_self] + rw [ite_eq_right hr, hW, Function.update_self, Function.update_self] · by_cases hjt : j ∈ targets - · rw [if_pos hjt] + · rw [ite_eq_left hjt] have hWj : W j = wipedTape (work₀ j) i := by - rw [hW, Function.update_of_ne hjr, hw]; simp [if_neg hjr, if_pos hjt] + rw [hW, Function.update_of_ne hjr, hw]; simp [ite_eq_right hjr, ite_eq_left hjt] have hRj : Function.update (w (i + 1)) r (⟨i + 2, regCells v⟩ : Tape) j = wipedTape (work₀ j) (i + 1) := by - rw [Function.update_of_ne hjr, hw]; simp [if_neg hjr, if_pos hjt] + rw [Function.update_of_ne hjr, hw]; simp [ite_eq_right hjr, ite_eq_left hjt] rw [hWj, hRj, wipedTape_succ] - · rw [if_neg hjt] + · rw [ite_eq_right hjt] have hWj : W j = work₀ j := by - rw [hW, Function.update_of_ne hjr, hw]; simp [if_neg hjr, if_neg hjt] + rw [hW, Function.update_of_ne hjr, hw]; simp [ite_eq_right hjr, ite_eq_right hjt] have hRj : Function.update (w (i + 1)) r (⟨i + 2, regCells v⟩ : Tape) j = work₀ j := by - rw [Function.update_of_ne hjr, hw]; simp [if_neg hjr, if_neg hjt] + rw [Function.update_of_ne hjr, hw]; simp [ite_eq_right hjr, ite_eq_right hjt] rw [hWj, hRj] have key := forRegTM_hoareTime (wipeStepTM targets) r v inp₀ w (fun _ => []) 1 hinp₀ (fun i => by simp [hw]) hwork_parked hbody diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/WipeStep.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/WipeStep.lean index 802cbb0156..dc47894022 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/WipeStep.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/WipeStep.lean @@ -95,7 +95,7 @@ theorem wipeStepTM_hoareTime {n : ℕ} (targets : List (Fin n)) 1, le_refl 1, ?_, rfl, hinp.move_idle, hout.writeAndMove_readBack_idle, fun i => ?_⟩ · refine TM.reachesIn.step ?_ .zero simp only [TM.step, wipeStepTM, - if_neg (show WipeStepPhase.running ≠ WipeStepPhase.done by decide)] + ite_eq_right (show WipeStepPhase.running ≠ WipeStepPhase.done by decide)] congr 1 congr 1 funext i diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Tape/Encoding.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Tape/Encoding.lean index 55c5b21dc7..de229811df 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Tape/Encoding.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Tape/Encoding.lean @@ -102,7 +102,7 @@ theorem HasBinaryContent.write_set {t : Tape} {bits : List Bool} have hhead0 : ¬t.head = 0 := by omega constructor · intro j hj - rw [Tape.write, if_neg hhead0] + rw [Tape.write, ite_eq_right hhead0] simp only rw [List.length_set] at hj rw [hhead] @@ -115,7 +115,7 @@ theorem HasBinaryContent.write_set {t : Tape} {bits : List Bool} List.getElem_set] simp [hij] · intro j hj - rw [Tape.write, if_neg hhead0] + rw [Tape.write, ite_eq_right hhead0] simp only rw [List.length_set] at hj rw [hhead] diff --git a/LeanPool/BeyondBethe/Complexitylib/SAT/ThreeSAT/Syntax.lean b/LeanPool/BeyondBethe/Complexitylib/SAT/ThreeSAT/Syntax.lean index a33da96087..88f504e6ea 100644 --- a/LeanPool/BeyondBethe/Complexitylib/SAT/ThreeSAT/Syntax.lean +++ b/LeanPool/BeyondBethe/Complexitylib/SAT/ThreeSAT/Syntax.lean @@ -161,9 +161,9 @@ private theorem foldl_cnf_eq_start_iff (formula : CNF) : rw [CNF.tokens, List.foldl_append] rw [foldl_clause] by_cases hclause : clause.length = 3 - · rw [if_pos hclause, ih] + · rw [ite_eq_left hclause, ih] simp [CNF.is3CNF_cons, hclause] - · rw [if_neg hclause, foldl_invalid] + · rw [ite_eq_right hclause, foldl_invalid] simp [tokenStart, CNF.is3CNF_cons, hclause] /-- A typed CNF's bit encoding is accepted exactly when it is exact 3-CNF. -/ From 30b9984ad7b4be69137eee2a5793980d83fb1aca Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Tue, 22 Sep 2026 00:37:37 +0000 Subject: [PATCH 03/49] Port foundational permanent, computation, and ellipsoid modules --- .../BeyondBethe/BeyondBethe/Permanent.lean | 4 +-- .../BeyondBethe/RationalEllipsoid.lean | 29 ++++++++++--------- .../BeyondBethe/SourceStableSlice.lean | 3 +- .../Complexitylib/Asymptotics.lean | 1 + .../Complexitylib/Circuits/Basic.lean | 2 ++ .../Complexitylib/Mathlib/NatBits.lean | 5 ++-- .../Simulation/TMConfig/Defs.lean | 2 ++ .../Structured/Internal/Resources.lean | 14 ++++----- .../Models/TuringMachine/Combinators.lean | 20 ++++++++----- .../Models/TuringMachine/Internal.lean | 20 ++++++------- 10 files changed, 53 insertions(+), 47 deletions(-) diff --git a/LeanPool/BeyondBethe/BeyondBethe/Permanent.lean b/LeanPool/BeyondBethe/BeyondBethe/Permanent.lean index 90db828f0f..49ef4c105a 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/Permanent.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/Permanent.lean @@ -44,7 +44,7 @@ theorem permanent_mono_real {n : Type*} [Fintype n] [DecidableEq n] rw [permanent, permanent] apply Finset.sum_le_sum intro σ _ - exact Finset.prod_le_prod (fun i _ ↦ hA (σ i) i) fun i _ ↦ hAB (σ i) i + exact Finset.prod_le_prod₀ (fun i _ ↦ hA (σ i) i) fun i _ ↦ hAB (σ i) i /-- Degree-`n` homogeneity under global scaling, as used when the algorithm normalizes the largest matrix entry. -/ @@ -107,7 +107,7 @@ theorem pow_card_le_permanent_of_hasPerfectMatching calc m ^ Fintype.card n = ∏ _i : n, m := by simp _ ≤ ∏ i : n, A (σ i) i := by - exact Finset.prod_le_prod (fun _ _ ↦ hm) fun i _ ↦ hmin (σ i) i (hσ i) + exact Finset.prod_le_prod₀ (fun _ _ ↦ hm) fun i _ ↦ hmin (σ i) i (hσ i) _ ≤ ∑ τ : Equiv.Perm n, ∏ i : n, A (τ i) i := by exact Finset.single_le_sum (fun τ _ ↦ Finset.prod_nonneg fun i _ ↦ hA (τ i) i) diff --git a/LeanPool/BeyondBethe/BeyondBethe/RationalEllipsoid.lean b/LeanPool/BeyondBethe/BeyondBethe/RationalEllipsoid.lean index ff38fb02e6..bf952b85f3 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/RationalEllipsoid.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/RationalEllipsoid.lean @@ -286,7 +286,7 @@ theorem rationalEllipsoid_volumeFactor_le_exp_neg {d : ℕ} (hd : 0 < d) : have hp0 : 0 < 1 - y := by rw [← hp] have hq := rationalEllipsoidParallelScale_pos hd - exact Rat.cast_pos.mpr hq + exact (Rat.cast_pos (K := ℝ)).mpr hq have hbase : 1 + x ≤ Real.exp x := by simpa [add_comm] using Real.add_one_le_exp x have hpow : (1 + x) ^ (d - 1) ≤ (Real.exp x) ^ (d - 1) := @@ -506,13 +506,13 @@ theorem rationalEllipsoid_scalar_containment simpa only [α] using hc have hdR : (1 : ℝ) ≤ d := by exact_mod_cast hd have hp0 : 0 < p := by - simpa [p] using Rat.cast_pos.mpr (rationalEllipsoidParallelScale_pos hd) + simpa [p] using (Rat.cast_pos (K := ℝ)).mpr (rationalEllipsoidParallelScale_pos hd) have hp1 : p ≤ 1 := by simpa [p] using Rat.cast_le.mpr (rationalEllipsoidParallelScale_le_one d) have hA0 : 0 < A := by - simpa [A] using Rat.cast_pos.mpr (rationalEllipsoidPerpScale_pos d) + simpa [A] using (Rat.cast_pos (K := ℝ)).mpr (rationalEllipsoidPerpScale_pos d) have hpA : p < A := by - simpa [p, A] using Rat.cast_lt.mpr (rationalEllipsoidParallel_lt_perp hd) + simpa [p, A] using (Rat.cast_lt (K := ℝ)).mpr (rationalEllipsoidParallel_lt_perp hd) have hh0' : α / d ≤ h := by simpa [α] using hh0 have hh1' : h ≤ α := by simpa [α] using hh1 have hhpos : 0 ≤ h := by @@ -620,11 +620,11 @@ theorem rationalEllipsoid_direction_containment have hrpos : 0 < r := by simpa [r] using Real.sqrt_pos.2 hspos have hrsq : r ^ 2 = s := by simpa [r] using Real.sq_sqrt hs0 have hApos : 0 < A := by - simpa [A] using Rat.cast_pos.mpr (rationalEllipsoidPerpScale_pos d) + simpa [A] using (Rat.cast_pos (K := ℝ)).mpr (rationalEllipsoidPerpScale_pos d) have hppos : 0 < p := by - simpa [p] using Rat.cast_pos.mpr (rationalEllipsoidParallelScale_pos hd) + simpa [p] using (Rat.cast_pos (K := ℝ)).mpr (rationalEllipsoidParallelScale_pos hd) have hαpos : 0 < α := by - simpa [α] using Rat.cast_pos.mpr (rationalEllipsoidAlpha_pos hd) + simpa [α] using (Rat.cast_pos (K := ℝ)).mpr (rationalEllipsoidAlpha_pos hd) have hqcut : q ≤ 0 := by simpa [q] using hcut have ht0 : t ≤ 0 := by dsimp only [t] @@ -750,9 +750,9 @@ theorem rationalEllipsoid_direction_containment_of_rational apply hbq ext i have hi := congrFun h i - exact Rat.cast_eq_zero.mp (by simpa [b] using hi) + exact (Rat.cast_eq_zero (α := ℝ)).mp (by simpa [b] using hi) have huq := cutL1Scale_pos hbq - have hu : 0 < (cutL1Scale bq : ℝ) := Rat.cast_pos.mpr huq + have hu : 0 < (cutL1Scale bq : ℝ) := (Rat.cast_pos (K := ℝ)).mpr huq have hlowerQ := finiteNormSq_le_cutL1Scale_sq bq have hlower : finiteNormSq b ≤ (cutL1Scale bq : ℝ) ^ 2 := by rw [← cast_finiteNormSq bq] @@ -834,14 +834,14 @@ theorem cast_directionUpdateMatrix_preimage {d : ℕ} (hd : 0 < d) intro h apply hbq ext i - exact Rat.cast_eq_zero.mp (by simpa [b] using congrFun h i) + exact (Rat.cast_eq_zero (α := ℝ)).mp (by simpa [b] using congrFun h i) have hnorm : finiteNormSq b ≠ 0 := by intro h exact hb ((finiteNormSq_eq_zero_iff b).1 h) have hA : (0 : ℝ) < (rationalEllipsoidPerpScale d : ℝ) := - Rat.cast_pos.mpr (rationalEllipsoidPerpScale_pos d) + (Rat.cast_pos (K := ℝ)).mpr (rationalEllipsoidPerpScale_pos d) have hp : (0 : ℝ) < (rationalEllipsoidParallelScale d : ℝ) := - Rat.cast_pos.mpr (rationalEllipsoidParallelScale_pos hd) + (Rat.cast_pos (K := ℝ)).mpr (rationalEllipsoidParallelScale_pos hd) have hinv := directionUpdateMatrix_preimage (A := (rationalEllipsoidPerpScale d : ℝ)) (p := (rationalEllipsoidParallelScale d : ℝ)) @@ -1259,8 +1259,9 @@ theorem rationalEllipsoid_storedDet_lower_of_ball_endpoints {d : ℕ} rationalEllipsoidPoint E y = fun i ↦ z i - if i = k then r else 0) : r ^ d ≤ Nat.factorial d * abs ((Matrix.det E.basis : ℚ) : ℝ) := by - simpa only [Rat.cast_det] using - rationalEllipsoid_determinant_lower_of_ball_endpoints E hr hplus hminus + rw [Rat.cast_det] + change r ^ d ≤ Nat.factorial d * abs (Matrix.det (fun i j => (E.basis i j : ℝ))) + exact rationalEllipsoid_determinant_lower_of_ball_endpoints E hr hplus hminus /-- The elementary estimate `exp (-1) ≤ 1/2`, derived from the power-series lower bound `2 ≤ exp 1`. -/ diff --git a/LeanPool/BeyondBethe/BeyondBethe/SourceStableSlice.lean b/LeanPool/BeyondBethe/BeyondBethe/SourceStableSlice.lean index 67c0c74beb..274e72e1b2 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/SourceStableSlice.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/SourceStableSlice.lean @@ -240,7 +240,8 @@ theorem pairTable_slice_rayleigh cases q with | false => simpa using hY | true => simpa using hZ) - simpa [a, b, cc, d, pairTableBivariateSlice_eval] using hne + rw [pairTableBivariateSlice_eval] at hne + simpa only [a, b, cc, d] using hne exact bivariate_rayleigh_of_bistable ha hb hcc hd hbistable end BeyondBethe diff --git a/LeanPool/BeyondBethe/Complexitylib/Asymptotics.lean b/LeanPool/BeyondBethe/Complexitylib/Asymptotics.lean index e5abbfd0de..c605345070 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Asymptotics.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Asymptotics.lean @@ -7,6 +7,7 @@ Authors: Samuel Schlesinger module public import Mathlib.Analysis.Asymptotics.SpecificAsymptotics public import Mathlib.Data.Nat.Size +public import Mathlib.Algebra.Polynomial.Eval.Degree /-! # Asymptotic notation for natural number functions diff --git a/LeanPool/BeyondBethe/Complexitylib/Circuits/Basic.lean b/LeanPool/BeyondBethe/Complexitylib/Circuits/Basic.lean index 30dc754cd0..bdb6a38277 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Circuits/Basic.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Circuits/Basic.lean @@ -6,6 +6,8 @@ Authors: Samuel Schlesinger module public import Mathlib.Data.Nat.Lattice +public import Mathlib.Order.Lattice.Nat +public import Mathlib.Order.CompleteLattice.Basic /-! # Boolean Circuit Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Mathlib/NatBits.lean b/LeanPool/BeyondBethe/Complexitylib/Mathlib/NatBits.lean index 25a9cbf816..3eed214104 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Mathlib/NatBits.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Mathlib/NatBits.lean @@ -93,10 +93,9 @@ theorem Nat.toBits_fromBits : ∀ bits : List Bool, have hlt := Nat.fromBits_lt_pow_length rest have hval : Nat.fromBits (bit :: rest) = Nat.fromBits rest + (if bit then 1 else 0) * 2 ^ rest.length := by - simp only [Nat.fromBits] exact Nat.add_comm _ _ - simp only [Nat.toBits, List.cons.injEq] - constructor + change (_ :: _) = (_ :: _) + congr 1 · rw [hval, Nat.add_mul_div_right _ _ (Nat.two_pow_pos _), Nat.div_eq_of_lt hlt] cases bit <;> simp · rw [hval, Nat.toBits_add_pow_mul, Nat.toBits_fromBits rest] diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Defs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Defs.lean index c3fa5cb179..62d8928874 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Defs.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Defs.lean @@ -29,6 +29,8 @@ namespace RAM namespace TMConfig +variable {n bound : ℕ} + /-- A field in a bounded configuration: state, a named tape head, or a named tape cell. Named tapes use input/work/output indices `0, 1..n, n+1`. -/ abbrev Field (n bound : ℕ) := diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Internal/Resources.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Internal/Resources.lean index 4c6e2d282b..6dbf2d3149 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Internal/Resources.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Internal/Resources.lean @@ -319,15 +319,13 @@ theorem exec_basics_exists (ops : List Basic) (initial : Store) : | nil => exact ⟨op.logCost initial, max initial.space (op.exec initial).space, by - simpa [Cmd.basics, Basic.execList] using Exec.basic op initial⟩ + simpa [Cmd.basics, Cmd.seqList, Basic.execList] using Exec.basic op initial⟩ | cons next tail => obtain ⟨cost, space, hrest⟩ := ih (initial := op.exec initial) refine ⟨op.logCost initial + cost, max (max initial.space (op.exec initial).space) space, ?_⟩ have hrun := Exec.seq (Exec.basic op initial) hrest - convert hrun using 1 - all_goals simp - all_goals omega + convert hrun using 1 <;> simp [Cmd.basics, Cmd.seqList, Basic.execList] <;> omega namespace MeasuredRuns @@ -369,14 +367,14 @@ theorem basicsEnvelope {indexBound valueBound : ℕ} (ops : List Basic) StoreEnvelope indexBound valueBound (Basic.execList ops initial) := by induction ops generalizing initial with | nil => - exact ⟨by simpa [Cmd.basics, Basic.execList] using skipEnvelope hinitial, + exact ⟨by simpa [Cmd.basics, Cmd.seqList, Basic.execList] using skipEnvelope hinitial, hinitial⟩ | cons op rest ih => have hnext := hpreserve op (by simp) initial hinitial have hfirst := basicEnvelope op initial hinitial hnext cases rest with | nil => - exact ⟨by simpa [Cmd.basics, Basic.execList] using hfirst, hnext⟩ + exact ⟨by simpa [Cmd.basics, Cmd.seqList, Basic.execList] using hfirst, hnext⟩ | cons next tail => obtain ⟨hrest, hfinal⟩ := ih (initial := op.exec initial) hnext (by intro candidate hcandidate store hstore @@ -401,7 +399,7 @@ theorem basicsEnvelopeChain {indexBound valueBound : ℕ} (ops : List Basic) StoreEnvelope indexBound valueBound (Basic.execList ops initial) := by induction ops generalizing initial with | nil => - exact ⟨by simpa [Cmd.basics, Basic.execList] using skipEnvelope hchain, + exact ⟨by simpa [Cmd.basics, Cmd.seqList, Basic.execList] using skipEnvelope hchain, hchain⟩ | cons op rest ih => have hinitial := hchain.1 @@ -413,7 +411,7 @@ theorem basicsEnvelopeChain {indexBound valueBound : ℕ} (ops : List Basic) have hfirst := basicEnvelope op initial hinitial hnext cases rest with | nil => - exact ⟨by simpa [Cmd.basics, Basic.execList] using hfirst, hnext⟩ + exact ⟨by simpa [Cmd.basics, Cmd.seqList, Basic.execList] using hfirst, hnext⟩ | cons next tail => obtain ⟨hrest, hfinal⟩ := ih (initial := op.exec initial) htail diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators.lean index db46051ae2..b80b0a6614 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators.lean @@ -85,12 +85,12 @@ private theorem moveLeftDir_start : moveLeftDir Γ.start = Dir3.right := rfl /-- If the head reads `▷`, then `idleDir` moves right — the shape of the `δ_right_of_start` obligation for idle tapes. -/ -theorem idleDir_right_of_start (h : head = Γ.start) : idleDir head = Dir3.right := by +theorem idleDir_right_of_start {head : Γ} (h : head = Γ.start) : idleDir head = Dir3.right := by subst h; rfl /-- If the head reads `▷`, then `moveLeftDir` moves right — the shape of the `δ_right_of_start` obligation for tapes being rewound. -/ -theorem moveLeftDir_right_of_start (h : head = Γ.start) : moveLeftDir head = Dir3.right := +theorem moveLeftDir_right_of_start {head : Γ} (h : head = Γ.start) : moveLeftDir head = Dir3.right := by subst h; rfl /-- Write back the same symbol read from a tape, preserving cell contents. @@ -325,20 +325,24 @@ def unionTM (tm₁ : TM n₁) (tm₂ : TM n₂) : TM (n₁ + 1 + n₂) := match m with | .rewindOut => dsimp only [fakeOutIdx] - split + by_cases hphase : wHeads fakeOutIdx = Γ.start + all_goals simp only [fakeOutIdx] at hphase + all_goals simp only [hphase, ite_true, ite_false] · refine ⟨idleDir_right_of_start, ?_, idleDir_right_of_start⟩ - intro i hwi; simp only []; split + intro i hwi; split · rfl · exact idleDir_right_of_start hwi · refine ⟨idleDir_right_of_start, ?_, idleDir_right_of_start⟩ - intro i hwi; simp only []; split - · next hn heq => - exfalso; apply hn + intro i hwi; split + · next heq => + exfalso; apply hphase rwa [show wHeads ⟨n₁, by omega⟩ = wHeads i from by congr 1; ext; simp [heq]] · exact idleDir_right_of_start hwi | .checkResult => dsimp only [fakeOutIdx] - split + by_cases hphase : wHeads fakeOutIdx = Γ.one + all_goals simp only [fakeOutIdx] at hphase + all_goals simp only [hphase, ite_true, ite_false] · exact ⟨idleDir_right_of_start, fun _ => idleDir_right_of_start, idleDir_right_of_start⟩ · exact rightOfStart_allIdle iHead wHeads oHead | .rewindIn => diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Internal.lean index 0f66da8b51..426fdc8426 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Internal.lean @@ -50,14 +50,12 @@ lemma TM.toNTM_trace_reaches (tm : TM n) (c : Cfg n tm.Q) induction T generalizing c with | zero => exact Relation.ReflTransGen.refl | succ T ih => - simp only [NTM.trace] - split - · exact Relation.ReflTransGen.refl - · next hne => - have hne : c.state ≠ tm.qhalt := hne + by_cases hhalt : c.state = tm.qhalt + · simpa [NTM.trace, TM.toNTM, TM.reaches, hhalt] using + (Relation.ReflTransGen.refl : tm.reaches c c) + · rw [tm.toNTM_trace_step T choices hhalt] exact Relation.ReflTransGen.head - (show tm.stepRel c _ by simp [TM.stepRel, TM.step, hne, TM.toNTM]) - (ih _ _) + (show tm.stepRel c _ by simp [TM.stepRel, TM.step, hhalt]) (ih _ _) /-- For `toNTM`, the trace is independent of the choice sequence since both transition functions are identical. -/ @@ -67,10 +65,10 @@ lemma TM.toNTM_trace_choice_irrel (tm : TM n) (T : ℕ) (c : Cfg n tm.Q) induction T generalizing c with | zero => rfl | succ T ih => - simp only [NTM.trace] - split - · rfl - · simp only [TM.toNTM]; exact ih _ _ _ + by_cases hhalt : c.state = tm.qhalt + · simp [NTM.trace, TM.toNTM, hhalt] + · rw [tm.toNTM_trace_step T ch₁ hhalt, tm.toNTM_trace_step T ch₂ hhalt] + exact ih _ _ _ /-- If a DTM reaches `c'` in exactly `t` steps, then `toNTM.trace t` agrees. -/ private lemma TM.toNTM_reachesIn_trace (tm : TM n) {c c' : Cfg n tm.Q} {t : ℕ} From 5f7bda49def1d0a0db8433031165b1dc0aa69faa Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Tue, 22 Sep 2026 00:52:56 +0000 Subject: [PATCH 04/49] Port cluster product bounds and machine combinator step proofs --- .../BeyondBethe/ClusterProduct.lean | 3 ++- LeanPool/BeyondBethe/BeyondBethe/Gain.lean | 4 ++-- LeanPool/BeyondBethe/BeyondBethe/Slack.lean | 4 ++-- .../BeyondBethe/BeyondBethe/Smoothing.lean | 5 ++-- .../Combinators/Internal/If.lean | 24 +++++++++---------- .../Combinators/Internal/Loop.lean | 16 ++++++------- .../Combinators/Internal/Seq.lean | 12 +++++----- 7 files changed, 35 insertions(+), 33 deletions(-) diff --git a/LeanPool/BeyondBethe/BeyondBethe/ClusterProduct.lean b/LeanPool/BeyondBethe/BeyondBethe/ClusterProduct.lean index 9c8f61fe9e..0cd3ad2e58 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/ClusterProduct.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/ClusterProduct.lean @@ -95,7 +95,8 @@ noncomputable def permutationGlobalClusterChoiceEquiv funext c apply Function.Embedding.ext intro k - simp [clusterChoiceMap, permutationClusterChoice] + simp [clusterChoiceMap, permutationClusterChoice, Equiv.ofBijective_apply] + rfl noncomputable instance globalClusterChoiceFintype {n : ℕ} (C : RowClustering n) : Fintype (GlobalClusterChoice C) := diff --git a/LeanPool/BeyondBethe/BeyondBethe/Gain.lean b/LeanPool/BeyondBethe/BeyondBethe/Gain.lean index d863282550..cf13911f1f 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/Gain.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/Gain.lean @@ -33,7 +33,7 @@ theorem rowZeta_le_one (hp : IsProbabilityVector p) : rowZeta τ p ≤ 1 := by rw [rowZeta] - apply Finset.prod_le_one + apply Finset.prod_le_one₀ · intro j _ exact Real.rpow_nonneg (hp.nonnegative j) _ · intro j _ @@ -273,7 +273,7 @@ theorem productExcept_le_one {p : ι → ℝ} (hp : IsProbabilityVector p) (j : ι) : productExcept p j ≤ 1 := by rw [productExcept] - apply Finset.prod_le_one + apply Finset.prod_le_one₀ · intro k _ exact sub_nonneg.mpr (hp.le_one k) · intro k _ diff --git a/LeanPool/BeyondBethe/BeyondBethe/Slack.lean b/LeanPool/BeyondBethe/BeyondBethe/Slack.lean index f359a27fb9..d7f1ab9f0d 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/Slack.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/Slack.lean @@ -58,7 +58,7 @@ theorem gibbsSequentialDivergence_eq_entropy gibbsSequentialDivergence A = -shannonEntropy (gibbsProbability A) + ∑ i, rowScore (assignmentMarginal A i) := by - rw [gibbsSequentialDivergence, averagedSequentialDivergence] + unfold gibbsSequentialDivergence averagedSequentialDivergence calc uniformAverage (fun π : Equiv.Perm (Fin m) ↦ finiteKL (gibbsProbability A) @@ -73,7 +73,7 @@ theorem gibbsSequentialDivergence_eq_entropy (gibbs_hasAssignmentMarginals A) _ = -shannonEntropy (gibbsProbability A) + ∑ i, rowScore (assignmentMarginal A i) := by - rw [← neg_logMarginals_add_rowT_eq_rowScore] + rw [← neg_logMarginals_add_rowT_eq_rowScore (assignmentMarginal A)] ring theorem gibbsSequentialDivergence_nonneg diff --git a/LeanPool/BeyondBethe/BeyondBethe/Smoothing.lean b/LeanPool/BeyondBethe/BeyondBethe/Smoothing.lean index 08921b4ed6..1903b6f013 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/Smoothing.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/Smoothing.lean @@ -91,7 +91,7 @@ theorem prod_add_const_sub_prod_le have hs1 : ∀ i ∈ s, a i ≤ 1 := fun i hi ↦ ha1 i (Finset.mem_insert_of_mem hi) have hprod : (∏ i ∈ s, (a i + δ)) ≤ (1 + δ) ^ s.card := by rw [← Finset.prod_const] - exact Finset.prod_le_prod + exact Finset.prod_le_prod₀ (fun i hi ↦ add_nonneg (hs0 i hi) hδ) (fun i hi ↦ by simpa [add_comm] using add_le_add_right (hs1 i hi) δ) have hpow : 0 ≤ (1 + δ) ^ s.card - 1 := by @@ -125,7 +125,8 @@ theorem permanent_add_uniform_sub_le Matrix.permanent (fun i j ↦ A i j + δ) - Matrix.permanent A ≤ Nat.factorial (Fintype.card n) * ((1 + δ) ^ Fintype.card n - 1) := by classical - rw [Matrix.permanent, Matrix.permanent, ← Finset.sum_sub_distrib] + unfold Matrix.permanent + rw [← Finset.sum_sub_distrib] calc ∑ σ : Equiv.Perm n, ((∏ i, (A (σ i) i + δ)) - ∏ i, A (σ i) i) diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/Internal/If.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/Internal/If.lean index 0e78f63d62..0caadcddb0 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/Internal/If.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/Internal/If.lean @@ -86,11 +86,11 @@ theorem ifTM_test_step (tmTest tmThen tmElse : TM n) {c c' : Cfg n tmTest.Q} (hstep : tmTest.step c = some c') : (ifTM tmTest tmThen tmElse).step (ifTestWrap tmTest tmThen tmElse c) = some (ifTestWrap tmTest tmThen tmElse c') := by + classical have hne : c.state ≠ tmTest.qhalt := state_ne_qhalt_of_step hstep simp only [step, hne, ↓reduceIte, Option.some.injEq] at hstep subst hstep - show (if (ifTestWrap tmTest tmThen tmElse c).state = - (ifTM tmTest tmThen tmElse).qhalt then none else some _) = some _ + unfold step simp only [ifTestWrap, ifTM, ite_eq_right ifQ_test_ne_halt, ite_eq_right hne] /-- Multi-step test phase simulation. -/ @@ -112,11 +112,11 @@ theorem ifTM_then_step (tmTest tmThen tmElse : TM n) {c c' : Cfg n tmThen.Q} (hstep : tmThen.step c = some c') : (ifTM tmTest tmThen tmElse).step (ifThenWrap tmTest tmThen tmElse c) = some (ifThenWrap tmTest tmThen tmElse c') := by + classical have hne : c.state ≠ tmThen.qhalt := state_ne_qhalt_of_step hstep simp only [step, hne, ↓reduceIte, Option.some.injEq] at hstep subst hstep - show (if (ifThenWrap tmTest tmThen tmElse c).state = - (ifTM tmTest tmThen tmElse).qhalt then none else some _) = some _ + unfold step simp only [ifThenWrap, ifTM, ite_eq_right ifQ_then_ne_halt, ite_eq_right hne] /-- Multi-step then-branch simulation. -/ @@ -138,11 +138,11 @@ theorem ifTM_else_step (tmTest tmThen tmElse : TM n) {c c' : Cfg n tmElse.Q} (hstep : tmElse.step c = some c') : (ifTM tmTest tmThen tmElse).step (ifElseWrap tmTest tmThen tmElse c) = some (ifElseWrap tmTest tmThen tmElse c') := by + classical have hne : c.state ≠ tmElse.qhalt := state_ne_qhalt_of_step hstep simp only [step, hne, ↓reduceIte, Option.some.injEq] at hstep subst hstep - show (if (ifElseWrap tmTest tmThen tmElse c).state = - (ifTM tmTest tmThen tmElse).qhalt then none else some _) = some _ + unfold step simp only [ifElseWrap, ifTM, ite_eq_right ifQ_else_ne_halt, ite_eq_right hne] /-- Multi-step else-branch simulation. -/ @@ -167,8 +167,8 @@ theorem ifTM_then_halt_step (tmTest tmThen tmElse : TM n) {c : Cfg n tmThen.Q} input := transitionInput c.input, work := fun i => transitionTape (c.work i), output := transitionTape c.output } := by - show (if (ifThenWrap tmTest tmThen tmElse c).state = - (ifTM tmTest tmThen tmElse).qhalt then none else some _) = some _ + classical + unfold step simp only [ifThenWrap, ifTM, ite_eq_right ifQ_then_ne_halt, hhalt, ↓reduceIte] congr 1 @@ -180,8 +180,8 @@ theorem ifTM_else_halt_step (tmTest tmThen tmElse : TM n) {c : Cfg n tmElse.Q} input := transitionInput c.input, work := fun i => transitionTape (c.work i), output := transitionTape c.output } := by - show (if (ifElseWrap tmTest tmThen tmElse c).state = - (ifTM tmTest tmThen tmElse).qhalt then none else some _) = some _ + classical + unfold step simp only [ifElseWrap, ifTM, ite_eq_right ifQ_else_ne_halt, hhalt, ↓reduceIte] congr 1 @@ -197,8 +197,8 @@ theorem ifTM_test_to_rewind (tmTest tmThen tmElse : TM n) {c : Cfg n tmTest.Q} input := transitionInput c.input, work := fun i => transitionTape (c.work i), output := transitionTape c.output } := by - show (if (ifTestWrap tmTest tmThen tmElse c).state = - (ifTM tmTest tmThen tmElse).qhalt then none else some _) = some _ + classical + unfold step simp only [ifTestWrap, ifTM, ite_eq_right ifQ_test_ne_halt, hhalt, ↓reduceIte] congr 1 diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/Internal/Loop.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/Internal/Loop.lean index b642325297..a119167400 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/Internal/Loop.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/Internal/Loop.lean @@ -69,11 +69,11 @@ theorem loopTM_body_step (tmBody tmTest : TM n) {c c' : Cfg n tmBody.Q} (hstep : tmBody.step c = some c') : (loopTM tmBody tmTest).step (loopBodyWrap tmBody tmTest c) = some (loopBodyWrap tmBody tmTest c') := by + classical have hne : c.state ≠ tmBody.qhalt := state_ne_qhalt_of_step hstep simp only [step, hne, ↓reduceIte, Option.some.injEq] at hstep subst hstep - show (if (loopBodyWrap tmBody tmTest c).state = - (loopTM tmBody tmTest).qhalt then none else some _) = some _ + unfold step simp only [loopBodyWrap, loopTM, ite_eq_right loopQ_body_ne_halt, ite_eq_right hne] /-- A `t`-step run of `tmBody` lifts to a `t`-step run of `loopTM` between the @@ -101,8 +101,8 @@ theorem loopTM_body_to_test (tmBody tmTest : TM n) {c : Cfg n tmBody.Q} input := transitionInput c.input, work := fun i => transitionTape (c.work i), output := transitionTape c.output }) := by - show (if (loopBodyWrap tmBody tmTest c).state = - (loopTM tmBody tmTest).qhalt then none else some _) = some _ + classical + unfold step simp only [loopBodyWrap, loopTM, ite_eq_right loopQ_body_ne_halt, hhalt, ↓reduceIte] congr 1 @@ -116,11 +116,11 @@ theorem loopTM_test_step (tmBody tmTest : TM n) {c c' : Cfg n tmTest.Q} (hstep : tmTest.step c = some c') : (loopTM tmBody tmTest).step (loopTestWrap tmBody tmTest c) = some (loopTestWrap tmBody tmTest c') := by + classical have hne : c.state ≠ tmTest.qhalt := state_ne_qhalt_of_step hstep simp only [step, hne, ↓reduceIte, Option.some.injEq] at hstep subst hstep - show (if (loopTestWrap tmBody tmTest c).state = - (loopTM tmBody tmTest).qhalt then none else some _) = some _ + unfold step simp only [loopTestWrap, loopTM, ite_eq_right loopQ_test_ne_halt, ite_eq_right hne] /-- A `t`-step run of `tmTest` lifts to a `t`-step run of `loopTM` between the @@ -147,8 +147,8 @@ theorem loopTM_test_to_rewind (tmBody tmTest : TM n) {c : Cfg n tmTest.Q} input := transitionInput c.input, work := fun i => transitionTape (c.work i), output := transitionTape c.output } := by - show (if (loopTestWrap tmBody tmTest c).state = - (loopTM tmBody tmTest).qhalt then none else some _) = some _ + classical + unfold step simp only [loopTestWrap, loopTM, ite_eq_right loopQ_test_ne_halt, hhalt, ↓reduceIte] congr 1 diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/Internal/Seq.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/Internal/Seq.lean index 9f06285e2d..596c192052 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/Internal/Seq.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/Internal/Seq.lean @@ -58,11 +58,11 @@ def phase2Wrap (tm₁ : TM n) (tm₂ : TM n) (c₂ : Cfg n tm₂.Q) : theorem seqTM_phase1_step (tm₁ tm₂ : TM n) {c₁ c₁' : Cfg n tm₁.Q} (hstep : tm₁.step c₁ = some c₁') : (seqTM tm₁ tm₂).step (phase1Wrap tm₁ tm₂ c₁) = some (phase1Wrap tm₁ tm₂ c₁') := by + classical have hne := state_ne_qhalt_of_step hstep simp only [step, hne, ↓reduceIte, Option.some.injEq] at hstep subst hstep - show (if (phase1Wrap tm₁ tm₂ c₁).state = (seqTM tm₁ tm₂).qhalt then none - else some _) = some _ + unfold step simp only [phase1Wrap, seqTM, ite_eq_right Sum.inl_ne_inr, ite_eq_right hne] /-- Multi-step Phase 1 simulation. -/ @@ -87,8 +87,8 @@ theorem seqTM_transition_step (tm₁ tm₂ : TM n) {c₁ : Cfg n tm₁.Q} input := transitionInput c₁.input, work := fun i => transitionTape (c₁.work i), output := transitionTape c₁.output }) := by - show (if (phase1Wrap tm₁ tm₂ c₁).state = (seqTM tm₁ tm₂).qhalt then none - else some _) = some _ + classical + unfold step simp only [phase1Wrap, seqTM, ite_eq_right Sum.inl_ne_inr, hhalt, ↓reduceIte] congr 1 @@ -100,11 +100,11 @@ theorem seqTM_transition_step (tm₁ tm₂ : TM n) {c₁ : Cfg n tm₁.Q} theorem seqTM_phase2_step (tm₁ tm₂ : TM n) {c₂ c₂' : Cfg n tm₂.Q} (hstep : tm₂.step c₂ = some c₂') : (seqTM tm₁ tm₂).step (phase2Wrap tm₁ tm₂ c₂) = some (phase2Wrap tm₁ tm₂ c₂') := by + classical have hne := state_ne_qhalt_of_step hstep simp only [step, hne, ↓reduceIte, Option.some.injEq] at hstep subst hstep - show (if (phase2Wrap tm₁ tm₂ c₂).state = (seqTM tm₁ tm₂).qhalt then none - else some _) = some _ + unfold step simp only [phase2Wrap, seqTM, ite_eq_right (Sum.inr_injective.ne hne), ite_eq_right hne] /-- Multi-step Phase 2 simulation. -/ From d6b5fe764fd378f5d7ee31c79d7e0af30fbe8b53 Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Tue, 22 Sep 2026 01:12:27 +0000 Subject: [PATCH 05/49] Port Turing subroutine proofs and RAM configuration support --- .../Simulation/TMConfig/Internal.lean | 4 +- .../Simulation/TMConfig/Sparse/Step/Defs.lean | 1 + .../TuringMachine/Placement/Internal.lean | 1 + .../Subroutines/BinaryEq/Internal.lean | 12 +++--- .../BinaryFor/Internal/Control.lean | 2 +- .../BinaryRippleAdd/Internal/Scan.lean | 10 ++--- .../BinaryRippleSub/Internal/Pure.lean | 8 ++-- .../BinaryRippleSub/Internal/Scan.lean | 10 ++--- .../TuringMachine/Subroutines/Counter.lean | 40 ++++++++++++------- .../Subroutines/Internal/CopyOutput.lean | 8 ++-- .../Subroutines/PairEmit/Internal.lean | 6 +-- 11 files changed, 58 insertions(+), 44 deletions(-) diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Internal.lean index 79dbb94690..b7b9d72bc6 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Internal.lean @@ -20,6 +20,8 @@ namespace RAM namespace TMConfig +variable {n bound : ℕ} + theorem fieldReg_state_internal : fieldReg (stateField (n := n) (bound := bound)) = 0 := by rfl @@ -123,7 +125,7 @@ theorem decode_of_represents_internal (tm : TM n) (bound : ℕ) · simp only [decode] rw [hrepresents (stateField (n := n) (bound := bound))] exact stateDecode_code_internal tm cfg.state - · simpa [decode, tapeAt_input_internal] using + · simpa [decode, tapeAt_input_internal] using! decodeTape_of_represents tm bound cfg regs hrepresents hbounded ⟨0, by omega⟩ · funext i diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Step/Defs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Step/Defs.lean index f90a06e8c9..ec4356ddbb 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Step/Defs.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Step/Defs.lean @@ -5,6 +5,7 @@ Authors: Samuel Schlesinger -/ module +public import Mathlib.Data.Finset.Lattice.Fold public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.Defs public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.Switch.Defs diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Placement/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Placement/Internal.lean index 8b1a4aa903..71f7be782f 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Placement/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Placement/Internal.lean @@ -59,6 +59,7 @@ theorem placeWorkTM_step_placeWorkCfg_internal (tm : TM n) (pre post : ℕ) (placeWorkCfg tm pre post (placeWorkFrameStep extras)) := by by_cases hhalt : c.state = tm.qhalt · simp [TM.step, placeWorkCfg, placeWorkTM, hhalt] + rfl · cases hstep : tm.step c with | none => exact absurd hstep (by simp [TM.step, hhalt]) | some c' => diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryEq/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryEq/Internal.lean index 9529c1f8b4..50c1a57d1f 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryEq/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryEq/Internal.lean @@ -85,7 +85,7 @@ private theorem binaryEq_terminal_step {n : ℕ} by_cases hi : i = resultIdx · subst i simp [binaryEqResultCfg, binaryEqResultWork, Γw.ofBool] - · simpa [binaryEqResultCfg, binaryEqResultWork, hi] using + · simpa [binaryEqResultCfg, binaryEqResultWork, hi] using! transitionTape_eq_self (hwork i hi) | true => @@ -99,7 +99,7 @@ private theorem binaryEq_terminal_step {n : ℕ} by_cases hi : i = resultIdx · subst i simp [binaryEqResultCfg, binaryEqResultWork, Γw.ofBool] - · simpa [binaryEqResultCfg, binaryEqResultWork, hi] using + · simpa [binaryEqResultCfg, binaryEqResultWork, hi] using! transitionTape_eq_self (hwork i hi) private theorem binaryEq_scan_step {n : ℕ} @@ -128,7 +128,7 @@ private theorem binaryEq_scan_step {n : ℕ} · subst i simp only [binaryEqAdvanceCfg, binaryEqAdvanceWork, ite_eq_right hil, ite_eq_left] exact writeAndMove_readBack_right (hwork rhsIdx) - · simpa [binaryEqAdvanceCfg, binaryEqAdvanceWork, hil, hir] using + · simpa [binaryEqAdvanceCfg, binaryEqAdvanceWork, hil, hir] using! transitionTape_eq_self (hwork i) private theorem binaryEq_terminal_reachesIn {n : ℕ} @@ -181,10 +181,10 @@ private theorem binaryEq_terminal_reachesIn {n : ℕ} · rw [hdecision] cases result with | false => - simpa [c', binaryEqResultCfg, binaryEqResultWork, Γw.ofBool] using + simpa [Γ.ofBool, transitionTape, Γw.toΓ, c', binaryEqResultCfg, binaryEqResultWork, Γw.ofBool] using Tape.hasBinaryPrefix_write_bit false hresult | true => - simpa [c', binaryEqResultCfg, binaryEqResultWork, Γw.ofBool] using + simpa [Γ.ofBool, transitionTape, Γw.toΓ, c', binaryEqResultCfg, binaryEqResultWork, Γw.ofBool] using Tape.hasBinaryPrefix_write_bit true hresult · change (Function.update work₀ resultIdx _ lhsIdx).cells = _ rw [Function.update_of_ne hdistinct.lhs_result] @@ -310,7 +310,7 @@ private theorem binaryEq_suffix_reachesIn {n : ℕ} work := work₀ output := out₀ } c' := by exact .step hstep (by - simpa [work₁, binaryEqAdvanceCfg] using hreach) + simpa [Γ.ofBool, transitionTape, Γw.toΓ, work₁, binaryEqAdvanceCfg] using! hreach) refine ⟨c', t + 1, ?_, hreach', hhalt, hfinalInput, ?_, ?_, ?_, hfinalLhsHead, hfinalRhsHead, ?_, hfinalOutput⟩ · simp only [binaryEqTime, List.length_cons] at htime ⊢ diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryFor/Internal/Control.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryFor/Internal/Control.lean index f418d143c4..f1a81181ba 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryFor/Internal/Control.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryFor/Internal/Control.lean @@ -53,7 +53,7 @@ theorem binaryForTM_iteration_step_internal (body : TM n) rw [TM.step, ite_eq_right (by simp [binaryForIterationWrap, binaryForTM])] simp only [binaryForIterationWrap, binaryForTM, hne, ↓reduceIte] rw [TM.step, ite_eq_right hne] at hstep - simpa only [Option.map_some, binaryForIterationWrap] using + simpa only [Γ.ofBool, transitionTape, Γw.toΓ, Option.map_some, binaryForIterationWrap] using! congrArg (Option.map (binaryForIterationWrap body counterIdx limitIdx)) hstep /-- Exact runs of the composite iteration lift through the iteration phase of diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleAdd/Internal/Scan.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleAdd/Internal/Scan.lean index c23b0b75a9..9842d66945 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleAdd/Internal/Scan.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleAdd/Internal/Scan.lean @@ -176,21 +176,21 @@ private theorem binaryRippleAddScanTM_step_terminal {n : ℕ} simp [finalWork] · by_cases hil : i = lhsIdx · subst i - simpa [finalWork, hdistinct.lhs_result] using + simpa [Γ.ofBool, transitionTape, Γw.toΓ, finalWork, hdistinct.lhs_result] using transitionTape_eq_self (by rw [hlhs]; decide) · by_cases hir : i = rhsIdx · subst i - simpa [finalWork, hdistinct.rhs_result] using + simpa [Γ.ofBool, transitionTape, Γw.toΓ, finalWork, hdistinct.rhs_result] using transitionTape_eq_self (by rw [hrhs]; decide) - · simpa [finalWork, hires] using + · simpa [finalWork, hires] using! transitionTape_eq_self (hother i hil hir hires) · simp [finalWork, hdistinct.lhs_result] · simp [finalWork, hdistinct.lhs_result] · simp [finalWork, hdistinct.rhs_result] · simp [finalWork, hdistinct.rhs_result] - · simpa [finalWork, BinaryRippleAdd.ripple] using + · simpa [finalWork, BinaryRippleAdd.ripple] using! Tape.hasBinaryPrefix_write_bit true hresult - · simpa [finalWork] using + · simpa [finalWork] using! Tape.hasBinaryPrefix_write_bit_cell0 true hresult hresultStart · intro i _ _ hires simp [finalWork, hires] diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleSub/Internal/Pure.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleSub/Internal/Pure.lean index 97ff0dffc0..d69f1a0939 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleSub/Internal/Pure.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleSub/Internal/Pure.lean @@ -84,7 +84,7 @@ theorem scan_value_internal (borrow : Bool) (lhs rhs : List Bool) : have hstep := scan_value_step borrow false rhsBit tail.borrow 0 (Nat.fromBitsLE rhsTail) (Nat.fromBitsLE tail.bits) rhsTail.length htail - simpa [scan, tail, nextBorrow, Nat.fromBitsLE_cons] using hstep + simpa [scan, tail, nextBorrow, Nat.fromBitsLE_cons] using! hstep | cons lhsBit lhsTail ih => cases rhs with | nil => @@ -98,7 +98,7 @@ theorem scan_value_internal (borrow : Bool) (lhs rhs : List Bool) : have hstep := scan_value_step borrow lhsBit false tail.borrow (Nat.fromBitsLE lhsTail) 0 (Nat.fromBitsLE tail.bits) lhsTail.length htail - simpa [scan, tail, nextBorrow, Nat.fromBitsLE_cons] using hstep + simpa [scan, tail, nextBorrow, Nat.fromBitsLE_cons] using! hstep | cons rhsBit rhsTail => let nextBorrow := borrowBit borrow lhsBit rhsBit let tail := scan nextBorrow lhsTail rhsTail @@ -111,7 +111,7 @@ theorem scan_value_internal (borrow : Bool) (lhs rhs : List Bool) : have hstep := scan_value_step borrow lhsBit rhsBit tail.borrow (Nat.fromBitsLE lhsTail) (Nat.fromBitsLE rhsTail) (Nat.fromBitsLE tail.bits) (max lhsTail.length rhsTail.length) htail - simpa [scan, tail, nextBorrow, Nat.fromBitsLE_cons] using hstep + simpa [scan, tail, nextBorrow, Nat.fromBitsLE_cons] using! hstep /-- Appending a redundant high zero does not change canonical trimming. -/ theorem trimHighZeros_append_false_internal (bits : List Bool) : @@ -171,7 +171,7 @@ theorem subtract_natBits_internal (lhs rhs : ℕ) : have hinvariant' : lhs + (if raw.borrow then 2 ^ max lhs.size rhs.size else 0) = rhs + Nat.fromBitsLE raw.bits := by - simpa [raw, Nat.fromBitsLE_bits, Nat.size_eq_bits_len] using hinvariant + simpa [raw, Nat.fromBitsLE_bits, Nat.size_eq_bits_len] using! hinvariant have hrawBound' : Nat.fromBitsLE raw.bits < 2 ^ max lhs.size rhs.size := by rw [hlength'] at hrawBound exact hrawBound diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleSub/Internal/Scan.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleSub/Internal/Scan.lean index dd83406399..edde9dd2ee 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleSub/Internal/Scan.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleSub/Internal/Scan.lean @@ -148,21 +148,21 @@ private theorem binaryRippleSubCoreTM_step_terminal {n : ℕ} decide) Dir3.left · by_cases hil : i = lhsIdx · subst i - simpa [binaryRippleSubScanTurnWork, + simpa [Γ.ofBool, transitionTape, Γw.toΓ, binaryRippleSubScanTurnWork, hdistinct.lhs_result] using transitionTape_eq_self (by rw [hlhs]; decide) · by_cases hir : i = rhsIdx · subst i - simpa [binaryRippleSubScanTurnWork, + simpa [Γ.ofBool, transitionTape, Γw.toΓ, binaryRippleSubScanTurnWork, hdistinct.rhs_result] using transitionTape_eq_self (by rw [hrhs]; decide) - · simpa [binaryRippleSubScanTurnWork, hires] using + · simpa [binaryRippleSubScanTurnWork, hires] using! transitionTape_eq_self (hother i hil hir hires) · simp [binaryRippleSubScanTurnWork, hdistinct.lhs_result] · simp [binaryRippleSubScanTurnWork, hdistinct.lhs_result] · simp [binaryRippleSubScanTurnWork, hdistinct.rhs_result] · simp [binaryRippleSubScanTurnWork, hdistinct.rhs_result] - · simpa [finalWork, binaryRippleSubScanTurnWork, Tape.move_cells] using + · simpa [finalWork, binaryRippleSubScanTurnWork, Tape.move_cells] using! hresult.2 · simp [binaryRippleSubScanTurnWork, Tape.move, hresult.1] · simpa [finalWork, binaryRippleSubScanTurnWork, Tape.move_cells] using @@ -222,7 +222,7 @@ private theorem binaryRippleSubCoreTM_suffix_reachesIn {n : ℕ} hfinalRhsHead, hfinalResult, hfinalResultHead, hfinalResultStart, hfinalOther⟩ refine ⟨c', ?_, by - cases borrow <;> simp [c', BinaryRippleSub.scan], rfl, + cases borrow <;> simp [c', BinaryRippleSub.scan] <;> rfl, rfl, hfinalLhs, ?_, hfinalRhs, ?_, ?_, ?_, hfinalResultStart, hfinalOther, rfl⟩ · have hreach : diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/Counter.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/Counter.lean index 34e9227861..7836e6a480 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/Counter.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/Counter.lean @@ -430,7 +430,7 @@ theorem inputLengthPlusOneCounterTM_scan_start_initializes_counter (by simp [TM.step, inputLengthPlusOneCounterTM])).work counterIdx).HasUnaryPrefix 0 := by simp [TM.step, inputLengthPlusOneCounterTM, hinp, counterPreserveWork, counterIdleDirs, hcounter] - simpa [Tape.writeAndMove, Tape.write] using + simpa [idleDir, Tape.read, Tape.init, Tape.writeAndMove, Tape.write] using Tape.init_nil_move_right_hasUnaryPrefix_zero /-- In the `scan` phase, reading blank on the input moves the machine to the @@ -670,7 +670,7 @@ private theorem inputLengthPlusOneCounterTM_start_step · have hcounter_read : (work counterIdx).read = Γ.start := by rw [hcounter] simp [Tape.read, Tape.init] - simpa [counterPreserveWork, counterIdleDirs, hcounter, hcounter_read, + simpa [idleDir, Tape.read, Tape.init, counterPreserveWork, counterIdleDirs, hcounter, hcounter_read, Tape.writeAndMove, Tape.write] using Tape.init_nil_move_right_hasUnaryPrefix_zero · simp [counterIdleDirs, hcounter, Tape.writeAndMove, Tape.move_cells, @@ -939,7 +939,7 @@ theorem inputLengthPlusOneCounterTM_hoareTime refine ⟨c4, 1 + x.length + 1 + (x.length + 2 + 1), ?_, ?_, hhalt4, hpost⟩ · simp [inputLengthPlusOneCounterTime] omega - · simpa [c0] using hreach_04 + · simpa [c0] using! hreach_04 /-- Started-tape variant of `inputLengthPlusOneCounterTM_hoareTime`: if the input is already positioned at cell `1` and the counter tape is the started @@ -1020,7 +1020,7 @@ theorem inputLengthPlusOneCounterTM_started_hoareTime ⟨hcounter4, hcell04, hnostart4⟩⟩ · simp [inputLengthPlusOneCounterTime] omega - · simpa [c0] using hreach_04 + · simpa [c0] using! hreach_04 /-- Started-tape variant of the unary counter builder that also records the final input position. The input cells are unchanged, and the input head ends at @@ -1107,7 +1107,7 @@ theorem inputLengthPlusOneCounterTM_started_tracksInput_hoareTime ⟨hinput4_cells, hinput4_head, hcounter4, hcell04, hnostart4⟩⟩ · simp [inputLengthPlusOneCounterTime] omega - · simpa [c0] using hreach_04 + · simpa [c0] using! hreach_04 /-- One-step preservation of a passive started Boolean work tape distinct from the active counter tape. -/ @@ -1128,30 +1128,35 @@ private theorem inputLengthPlusOneCounterTM_step_preserves_started_other_work | scan => by_cases hstart : input.read = Γ.start · simp [TM.step, inputLengthPlusOneCounterTM, hstart] at hstep - subst hstep + have hcfg := Option.some.inj hstep + subst c' simpa [counterPreserveWork, counterIdleDirs] using Tape.writeAndMove_readBack_idle_of_ne_start (work passiveIdx) (by simpa [hpassive] using hpassive_read) · by_cases hblank : input.read = Γ.blank · simp [TM.step, inputLengthPlusOneCounterTM, hblank] at hstep - subst hstep + have hcfg := Option.some.inj hstep + subst c' simpa [counterWriteOneWork, counterAdvanceDirs, hne] using Tape.writeAndMove_readBack_idle_of_ne_start (work passiveIdx) (by simpa [hpassive] using hpassive_read) · simp [TM.step, inputLengthPlusOneCounterTM, hstart, hblank] at hstep - subst hstep + have hcfg := Option.some.inj hstep + subst c' simpa [counterWriteOneWork, counterAdvanceDirs, hne] using Tape.writeAndMove_readBack_idle_of_ne_start (work passiveIdx) (by simpa [hpassive] using hpassive_read) | rewind => by_cases hcounter : (work counterIdx).read = Γ.start · simp [TM.step, inputLengthPlusOneCounterTM, hcounter] at hstep - subst hstep + have hcfg := Option.some.inj hstep + subst c' simpa [counterPreserveWork, counterAdvanceDirs, hne] using Tape.writeAndMove_readBack_idle_of_ne_start (work passiveIdx) (by simpa [hpassive] using hpassive_read) · simp [TM.step, inputLengthPlusOneCounterTM, hcounter] at hstep - subst hstep + have hcfg := Option.some.inj hstep + subst c' simpa [counterPreserveWork, counterRewindDirs, hne] using Tape.writeAndMove_readBack_idle_of_ne_start (work passiveIdx) (by simpa [hpassive] using hpassive_read) @@ -1193,30 +1198,35 @@ private theorem inputLengthPlusOneCounterTM_step_preserves_started_blank_output | scan => by_cases hstart : input.read = Γ.start · simp [TM.step, inputLengthPlusOneCounterTM, hstart] at hstep - subst hstep + have hcfg := Option.some.inj hstep + subst c' simpa [hout] using Tape.writeAndMove_readBack_idle_of_ne_start output hout_read · by_cases hblank : input.read = Γ.blank · simp [TM.step, inputLengthPlusOneCounterTM, hblank] at hstep - subst hstep + have hcfg := Option.some.inj hstep + subst c' simpa [hout] using Tape.writeAndMove_readBack_idle_of_ne_start output hout_read · simp [TM.step, inputLengthPlusOneCounterTM, hstart, hblank] at hstep - subst hstep + have hcfg := Option.some.inj hstep + subst c' simpa [hout] using Tape.writeAndMove_readBack_idle_of_ne_start output hout_read | rewind => by_cases hcounter : (work counterIdx).read = Γ.start · simp [TM.step, inputLengthPlusOneCounterTM, hcounter] at hstep - subst hstep + have hcfg := Option.some.inj hstep + subst c' simpa [hout] using Tape.writeAndMove_readBack_idle_of_ne_start output hout_read · simp [TM.step, inputLengthPlusOneCounterTM, hcounter] at hstep - subst hstep + have hcfg := Option.some.inj hstep + subst c' simpa [hout] using Tape.writeAndMove_readBack_idle_of_ne_start output hout_read diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/Internal/CopyOutput.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/Internal/CopyOutput.lean index 533bb62359..92d2b1a885 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/Internal/CopyOutput.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/Internal/CopyOutput.lean @@ -103,7 +103,7 @@ private theorem copyInputToOutputTM_loop {n : ℕ} (x : List Bool) : cases hbit : x[k]'hk_lt with | false => have hread0 : c.input.read = Γ.zero := by - simpa [hbit] using hread + simpa [Γ.ofBool, transitionTape, Γw.toΓ, hbit] using hread let c1 : Cfg n (copyInputToOutputTM (n := n)).Q := { state := CopyPhase.copying input := c.input.move Dir3.right @@ -115,10 +115,10 @@ private theorem copyInputToOutputTM_loop {n : ℕ} (x : List Bool) : · simp [TM.step, hstate, copyInputToOutputTM, hread0, c1, readBackWrite] · simpa [c1, Tape.move_cells] using hcells · simp [c1, Tape.move, hhead] - · simpa [c1, hbit] using hprefix_next + · simpa [c1, hbit] using! hprefix_next | true => have hread1 : c.input.read = Γ.one := by - simpa [hbit] using hread + simpa [Γ.ofBool, transitionTape, Γw.toΓ, hbit] using hread let c1 : Cfg n (copyInputToOutputTM (n := n)).Q := { state := CopyPhase.copying input := c.input.move Dir3.right @@ -130,7 +130,7 @@ private theorem copyInputToOutputTM_loop {n : ℕ} (x : List Bool) : · simp [TM.step, hstate, copyInputToOutputTM, hread1, c1, readBackWrite] · simpa [c1, Tape.move_cells] using hcells · simp [c1, Tape.move, hhead] - · simpa [c1, hbit] using hprefix_next + · simpa [c1, hbit] using! hprefix_next obtain ⟨c1, hstep1, hstate1, hcells1, hhead1, hprefix1⟩ := hstep have hrem1 : rem = x.length - (k + 1) := by omega obtain ⟨c', hreach, hhalt, hcells', hhead', hprefix'⟩ := diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/PairEmit/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/PairEmit/Internal.lean index 8a891e3268..e479eb46f0 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/PairEmit/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/PairEmit/Internal.lean @@ -69,7 +69,7 @@ private theorem pairInputWorkTM_first_loop {n : ℕ} (firstIdx : Fin n) : have hotherKeep₁ (i) (hi : i ≠ firstIdx) : c₁.work i = c.work i := by simpa [c₁] using transitionTape_eq_self (hother i hi) have houtput₁ : c₁.output.HasBinaryPrefix (emitted ++ [false]) := by - simpa [c₁] using Tape.hasBinaryPrefix_write_bit false houtput + simpa [Γ.ofBool, transitionTape, Γw.toΓ, c₁] using Tape.hasBinaryPrefix_write_bit false houtput let c₂ : Cfg n (pairInputWorkTM firstIdx).Q := { state := PairInputWorkPhase.second input := transitionInput c₁.input @@ -94,7 +94,7 @@ private theorem pairInputWorkTM_first_loop {n : ℕ} (firstIdx : Fin n) : hstable, hotherKeep₁ i hi] have houtput₂ : c₂.output.HasBinaryPrefix (emitted ++ [false, true]) := by have hwrite := Tape.hasBinaryPrefix_write_bit true houtput₁ - simpa [c₂, List.append_assoc] using hwrite + simpa [Γ.ofBool, transitionTape, Γw.toΓ, c₂, List.append_assoc] using hwrite refine ⟨c₂, ?_, rfl, hinputKeep₂, ?_, ?_, hotherKeep₂, ?_⟩ · simpa using TM.reachesIn.step hstep₁ (TM.reachesIn.step hstep₂ .zero) · rw [hsourceKeep₂] @@ -165,7 +165,7 @@ private theorem pairInputWorkTM_first_loop {n : ℕ} (firstIdx : Fin n) : exact hother i hi) houtput₂ refine ⟨c', ?_, hstate', ?_, hsource', ?_, ?_, ?_⟩ - · simpa using TM.reachesIn.step hstep₁ (TM.reachesIn.step hstep₂ hreach) + · simpa [Nat.mul_add, Nat.add_assoc] using! TM.reachesIn.step hstep₁ (TM.reachesIn.step hstep₂ hreach) · exact hinput'.trans hinputKeep₂ · rw [hsourceCells', hsourceMove, Tape.move_cells] · intro i hi From 9fe8aa561b89b956612ddc0602f7113f90de7d0a Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Tue, 22 Sep 2026 01:20:34 +0000 Subject: [PATCH 06/49] Complete second compiler frontier across affine and machine proofs --- .../BeyondBethe/NumericalAffine.lean | 20 +++++---- .../P/Cobham/Internal/StepAlgebra.lean | 2 +- .../RegisterStore/DenseOverlay/Internal.lean | 2 +- .../Structured/GateEval/Internal.lean | 42 +++++++++---------- .../Structured/Hamming/Internal.lean | 8 ++-- .../Structured/Scanner/Internal.lean | 8 ++-- .../Structured/Switch/Internal.lean | 4 +- .../Structured/UnaryDecode/Internal.lean | 20 ++++----- .../Models/TuringMachine/Lift.lean | 24 +++++++---- .../Complexitylib/SAT/Verifier.lean | 2 +- 10 files changed, 72 insertions(+), 60 deletions(-) diff --git a/LeanPool/BeyondBethe/BeyondBethe/NumericalAffine.lean b/LeanPool/BeyondBethe/BeyondBethe/NumericalAffine.lean index eab4b7c1e1..2a318d823e 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/NumericalAffine.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/NumericalAffine.lean @@ -145,11 +145,14 @@ theorem birkhoffAffineMap_affineCombination birkhoffAffineMap (fun i j ↦ (1 - t) * Y i j + t * Z i j) = fun i j ↦ (1 - t) * birkhoffAffineMap Y i j + t * birkhoffAffineMap Z i j := by + let W : Matrix (Fin n) (Fin n) ℝ := fun i j => (1 - t) * Y i j + t * Z i j + change birkhoffAffineMap W = _ ext i j refine Fin.lastCases ?_ (fun i ↦ ?_) i <;> refine Fin.lastCases ?_ (fun j ↦ ?_) j - · simp only [birkhoffAffineMap_last_last, - Finset.sum_add_distrib] + · rw [birkhoffAffineMap_last_last W, birkhoffAffineMap_last_last Y, + birkhoffAffineMap_last_last Z] + simp only [W, Finset.sum_add_distrib] have hY : (∑ i, ∑ j, (1 - t) * Y i j) = (1 - t) * (∑ i, ∑ j, Y i j) := by @@ -172,15 +175,18 @@ theorem birkhoffAffineMap_affineCombination rw [Finset.mul_sum] rw [hY, hZ] ring - · simp only [birkhoffAffineMap_last_castSucc, - Finset.sum_add_distrib] + · rw [birkhoffAffineMap_last_castSucc W j, birkhoffAffineMap_last_castSucc Y j, + birkhoffAffineMap_last_castSucc Z j] + simp only [W, Finset.sum_add_distrib] repeat' rw [← Finset.mul_sum] ring - · simp only [birkhoffAffineMap_castSucc_last, - Finset.sum_add_distrib] + · rw [birkhoffAffineMap_castSucc_last W i, birkhoffAffineMap_castSucc_last Y i, + birkhoffAffineMap_castSucc_last Z i] + simp only [W, Finset.sum_add_distrib] repeat' rw [← Finset.mul_sum] ring - · simp + · rw [birkhoffAffineMap_castSucc_castSucc W i j, + birkhoffAffineMap_castSucc_castSucc Y i j, birkhoffAffineMap_castSucc_castSucc Z i j] /-- The affine map lands in the Birkhoff affine hull exactly; only nonnegativity remains to be checked by rational inequalities. -/ diff --git a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/StepAlgebra.lean b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/StepAlgebra.lean index 4f5b14b187..24424d77da 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/StepAlgebra.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/StepAlgebra.lean @@ -677,7 +677,7 @@ private theorem cellsCode_of_bits (x : List Bool) : | cons b x ih => intro t i hcells rw [List.length_cons, cellsCode_succ_left, encodeBits_cons, - show t.cells i = Γ.ofBool b from by simpa using hcells 0 (by simp)] + show t.cells i = Γ.ofBool b from by simpa using! hcells 0 (by simp)] congr 1 exact ih t (i + 1) fun j hj => by have := hcells (j + 1) (by rw [List.length_cons]; omega) diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/DenseOverlay/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/DenseOverlay/Internal.lean index 8c05081354..1161656eb7 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/DenseOverlay/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/DenseOverlay/Internal.lean @@ -54,7 +54,7 @@ theorem write_coversZero_internal (overlay : Store) by_cases haddress : address = 0 · subst address simp - · simpa [Function.update, haddress, Ne.symm haddress] using hcovers + · simpa [Function.update, haddress, Ne.symm haddress] using! hcovers theorem Snapshot.initial_decode_internal (input : List Bool) : (Snapshot.initial input).decode input = RAM.initCfg input := by diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/GateEval/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/GateEval/Internal.lean index 9dccca46e3..b06290db21 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/GateEval/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/GateEval/Internal.lean @@ -272,10 +272,10 @@ private theorem address_measured (gate : CircuitCode.RawGate) (wires : List Bool (.add address0Reg address0Reg baseReg) (inputStore gate wires) hinitial hfirst have hrun1 := MeasuredRuns.basicEnvelope (.add address1Reg address1Reg baseReg) (addressed0 gate wires) hfirst (by - simpa only [addressed, addressOps, Basic.execList] using hfinal) + simpa only [addressed, addressOps, Basic.execList] using! hfinal) refine ⟨?_, hfinal⟩ have hrun := hrun0.seq hrun1 - convert hrun using 1 + convert! hrun using 1 ring private theorem load_measured (gate : CircuitCode.RawGate) (wires : List Bool) @@ -301,10 +301,10 @@ private theorem load_measured (gate : CircuitCode.RawGate) (wires : List Bool) (addressed gate wires) hinitial hfirst have hrun1 := MeasuredRuns.basicEnvelope (.load value1Reg address1Reg) (loaded0 gate wires) hfirst (by - simpa only [loaded, loadOps, Basic.execList] using hfinal) + simpa only [loaded, loadOps, Basic.execList] using! hfinal) refine ⟨?_, hfinal⟩ have hrun := hrun0.seq hrun1 - convert hrun using 1 + convert! hrun using 1 ring private theorem negated0_measured (gate : CircuitCode.RawGate) (wires : List Bool) @@ -368,10 +368,10 @@ private theorem negated0_measured (gate : CircuitCode.RawGate) (wires : List Boo (negated0Product gate wires) hproduct htwice have hrun3 := MeasuredRuns.basicEnvelope (.sub value0Reg outputReg scratchReg) (negated0Twice gate wires) htwice (by - simpa only [negated0, xorOps, Basic.execList] using hfinal) + simpa only [negated0, xorOps, Basic.execList] using! hfinal) refine ⟨?_, hfinal⟩ have hrun := hrun0.seq (hrun1.seq (hrun2.seq hrun3)) - convert hrun using 1 + convert! hrun using 1 ring private theorem loaded_apply_of_ne (gate : CircuitCode.RawGate) (wires : List Bool) @@ -523,10 +523,10 @@ private theorem negated1_measured (gate : CircuitCode.RawGate) (wires : List Boo (negated1Product gate wires) hproduct htwice have hrun3 := MeasuredRuns.basicEnvelope (.sub value1Reg outputReg scratchReg) (negated1Twice gate wires) htwice (by - simpa only [negated1, xorOps, Basic.execList] using hfinal) + simpa only [negated1, xorOps, Basic.execList] using! hfinal) refine ⟨?_, hfinal⟩ have hrun := hrun0.seq (hrun1.seq (hrun2.seq hrun3)) - convert hrun using 1 + convert! hrun using 1 ring private theorem negated1_value0 (gate : CircuitCode.RawGate) (wires : List Bool) @@ -669,10 +669,10 @@ private theorem eval_measured (gate : CircuitCode.RawGate) (wires : List Bool) (evalDelta gate wires) hdelta hselected have hrun5 := MeasuredRuns.basicEnvelope (.sub outputReg outputReg address0Reg) (evalSelected gate wires) hselected (by - simpa only [evaluated, evalOps, Basic.execList] using hfinal) + simpa only [evaluated, evalOps, Basic.execList] using! hfinal) refine ⟨?_, hfinal⟩ have hrun := hrun0.seq (hrun1.seq (hrun2.seq (hrun3.seq (hrun4.seq hrun5)))) - convert hrun using 1 + convert! hrun using 1 ring private theorem evaluated_apply_of_ne (gate : CircuitCode.RawGate) @@ -840,7 +840,7 @@ private theorem append_measured (gate : CircuitCode.RawGate) (wires : List Bool) (appendAddressed gate wires) hfirst hfinal refine ⟨?_, hfinal⟩ have hrun := hrun0.seq hrun1 - convert hrun using 1 + convert! hrun using 1 ring private theorem routineAddressed_address0 {base : ℕ} {gate : CircuitCode.RawGate} @@ -983,7 +983,7 @@ private theorem xor_measured {bound value negated : ℕ} {store : Store} twice htwice hfinal refine ⟨?_, hfinal⟩ have hrun := hrun0.seq (hrun1.seq (hrun2.seq hrun3)) - convert hrun using 1 + convert! hrun using 1 ring private theorem routineNegated0_value {base : ℕ} {gate : CircuitCode.RawGate} @@ -1369,7 +1369,7 @@ theorem routine_measured_internal {bound base : ℕ} (routineAddressed store) 2 (8 * valueWidth bound) (envelopeSpace bound bound) := by have hrun := haddressRun0.seq haddressRun1 - convert hrun using 1 + convert! hrun using 1 ring let loaded0 := (Basic.load value0Reg address0Reg).exec (routineAddressed store) have hloaded0 : StoreEnvelope bound bound loaded0 := by @@ -1392,7 +1392,7 @@ theorem routine_measured_internal {bound base : ℕ} (routineLoaded store) 2 (8 * valueWidth bound) (envelopeSpace bound bound) := by have hrun := hloadRun0.seq hloadRun1 - convert hrun using 1 + convert! hrun using 1 ring have hloadedValue0 := routineLoaded_value0 hready value0 hvalue0 have hloadedNegated0 : routineLoaded store negated0Reg = @@ -1433,7 +1433,7 @@ theorem routine_measured_internal {bound base : ℕ} have hnegated1Run : MeasuredRuns (.basics (xorOps value1Reg negated1Reg)) (routineNegated0 store) (routineNegated1 store) 4 (16 * valueWidth bound) (envelopeSpace bound bound) := by - simpa [routineNegated1] using hxor1.1 + simpa [routineNegated1] using! hxor1.1 have hvalue0Eq := routineNegated1_value0 hready value0 hvalue0 have hvalue1Eq := routineNegated1_value hready value1 hvalue1 have hopEq := routineNegated1_op hready @@ -1528,7 +1528,7 @@ theorem routine_measured_internal {bound base : ℕ} (envelopeSpace bound bound) := by have hrun := hevalRun0.seq (hevalRun1.seq (hevalRun2.seq (hevalRun3.seq (hevalRun4.seq hevalRun5)))) - convert hrun using 1 + convert! hrun using 1 ring let appendAddressed := (Basic.add address1Reg baseReg wireCountReg).exec (routineEvaluated store) @@ -1559,13 +1559,13 @@ theorem routine_measured_internal {bound base : ℕ} (routineFinal store) 2 (8 * valueWidth bound) (envelopeSpace bound bound) := by have hrun := happendRun0.seq happendRun1 - convert hrun using 1 + convert! hrun using 1 ring have hrun := haddressRun.seq (hloadRun.seq (hnegated0Run.seq (hnegated1Run.seq (hevalRun.seq happendRun)))) have hprogram : MeasuredRuns program store (routineFinal store) stepCount (80 * valueWidth bound) (envelopeSpace bound bound) := by - convert hrun using 1 + convert! hrun using 1 all_goals ring exact ⟨routineFinal store, hprogram, hfinal, routineFinal_output hready value0 value1 hvalue0 hvalue1, @@ -1610,7 +1610,7 @@ theorem routine_exec_internal {base : ℕ} {gate : CircuitCode.RawGate} routineFinal_base hready, routineFinal_wireCount hready, ?_, routineFinal_frame hready⟩ · rw [program] - convert hrun using 1 + convert! hrun using 1 · intro index hindex exact routineFinal_wire hready index hindex @@ -1646,7 +1646,7 @@ theorem program_exec_internal (gate : CircuitCode.RawGate) (wires : List Bool) max addressSpace (max loadSpace (max negated0Space (max negated1Space (max evalSpace appendSpace)))), ?_, ?_⟩ · rw [program] - convert hrun using 1 + convert! hrun using 1 · exact finalStore_output gate wires value0 value1 hvalue0 hvalue1 theorem program_measured_internal (gate : CircuitCode.RawGate) (wires : List Bool) @@ -1673,7 +1673,7 @@ theorem program_measured_internal (gate : CircuitCode.RawGate) (wires : List Boo have hprogram : MeasuredRuns program (inputStore gate wires) (finalStore gate wires) stepCount (timeBound wires.length) (resourceSpace wires.length) := by - convert hrun using 1 + convert! hrun using 1 simp [timeBound, width, valueWidth] ring obtain ⟨cost, space, hexec, hcost, hspace⟩ := hprogram diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Hamming/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Hamming/Internal.lean index 1521f9adc4..1f17037557 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Hamming/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Hamming/Internal.lean @@ -213,7 +213,7 @@ private theorem body_measured {bit : Bool} {rest : List Bool} MeasuredRuns.basicEnvelope _ _ hadvancedBound hiteratedBound have hrun := hload.seq (hbranch.seq (hadvance.seq hdecrement)) rw [body, Cmd.seqList] - convert hrun using 1 + convert! hrun using 1 · cases bit <;> simp [bitValue] · ring @@ -278,7 +278,7 @@ private theorem iterated_inv {bit : Bool} {rest : List Bool} · intro offset rw [iterated_high bit store _ (by simp [inputBase]; omega)] have hinput := hinv.input_eq (offset + 1) - convert hinput using 1 + convert! hinput using 1 all_goals simp [Nat.add_assoc, Nat.add_comm, Nat.add_left_comm] private def loopAdvance (state : ℕ × ℕ) (bit : Bool) : ℕ × ℕ := @@ -422,7 +422,7 @@ private theorem finalize_measured {inputLength : ℕ} {store : Store} MeasuredRuns.basicEnvelope _ _ hzeroed hfinal have hrun := hzero.seq hadd rw [finalize, Cmd.seqList] - convert hrun using 1 + convert! hrun using 1 all_goals ring theorem program_measured_internal (bits : List Bool) : @@ -454,7 +454,7 @@ theorem program_measured_internal (bits : List Bool) : have hprogram' : MeasuredRuns (setup.seq (mainLoop.seq finalize)) (inputStore bits) (finalStore loopFinal) (stepCount bits) (timeBound bits.length) (resourceSpace bits.length) := by - convert hprogram using 1 + convert! hprogram using 1 unfold stepCount ring obtain ⟨cost, space, hexec, hcost, hspace⟩ := hprogram' diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Scanner/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Scanner/Internal.lean index f49499925d..cf9bd998fc 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Scanner/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Scanner/Internal.lean @@ -525,7 +525,7 @@ private theorem body_measured {spec : Spec} {bit : Bool} {rest : List Bool} (hindex.seq (haddress.seq (htransition.seq (hadvance.seq hdecrement))))) constructor · simp only [body, Cmd.basics, bodyOps, List.map_cons, List.map_nil, Cmd.seqList] - convert hrun using 1 + convert! hrun using 1 ring · exact hiterated @@ -628,7 +628,7 @@ private theorem iterated_inv {spec : Spec} {bit : Bool} {rest : List Bool} simp [inputBase, transitionBase, twoReg] omega)] have hinput := hinv.input_eq (offset + 1) - convert hinput using 1 + convert! hinput using 1 all_goals simp [Nat.add_assoc, Nat.add_comm, Nat.add_left_comm] private def loopAdvance (spec : Spec) (state : ℕ × ℕ) (bit : Bool) : ℕ × ℕ := @@ -754,7 +754,7 @@ private theorem finalize_measured {spec : Spec} {inputLength state : ℕ} constructor · simp only [finalize, Cmd.basics, finalizeOps, List.map_cons, List.map_nil, Cmd.seqList] - convert hrun using 1 + convert! hrun using 1 ring · change ((Basic.load lengthReg addressReg).exec indexed) lengthReg = _ simp [Basic.exec, haddress, htable] @@ -799,7 +799,7 @@ theorem program_measured_internal (spec : Spec) (bits : List Bool) : (finalStore loopFinal) (stepCount spec bits.length) (timeBound spec bits.length) (resourceSpace spec bits.length) := by rw [program] - convert hwide using 1 + convert! hwide using 1 rw [setupOps_length] simp [stepCount] ring diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Switch/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Switch/Internal.lean index 80eadb1857..08484a76ab 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Switch/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Switch/Internal.lean @@ -100,7 +100,7 @@ theorem select_exec_internal {count test one : ℕ} max initial.space (max (max initial.space ((Basic.sub test test one).exec initial).space) recursiveSpace), ?_⟩ - convert hrun using 1 + convert! hrun using 1 all_goals simp [stepCount] all_goals omega @@ -168,7 +168,7 @@ theorem select_measured_internal {count test one indexBound valueBound : ℕ} have hrun := MeasuredRuns.ifNonzeroEnvelope (onZero := branch ⟨0, by omega⟩) hnonzero hinitial (hdecrement.seq hrecursive) - convert hrun using 1 <;> simp [stepCount, costBound] + convert! hrun using 1 <;> simp [stepCount, costBound] all_goals ring end Switch diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/UnaryDecode/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/UnaryDecode/Internal.lean index daa5fcc294..bfe050fdbe 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/UnaryDecode/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/UnaryDecode/Internal.lean @@ -339,7 +339,7 @@ private theorem false_body_measured {rest : List Bool} hremaining hinv.store_bound (by simpa [consume, Cmd.seqList] using hconsume) refine ⟨?_, hsuccess⟩ - apply MeasuredRuns.weakenCost (by simpa [body] using hrun) + apply MeasuredRuns.weakenCost (by simpa [body] using! hrun) change 3 * width inputLength + (4 * width inputLength + (4 * width inputLength + @@ -382,7 +382,7 @@ private theorem true_body_measured {rest : List Bool} hremaining hinv.store_bound (by simpa [consume, Cmd.seqList] using hconsume) constructor - · apply MeasuredRuns.weakenCost (by simpa [body] using hrun) + · apply MeasuredRuns.weakenCost (by simpa [body] using! hrun) change 3 * width inputLength + (4 * width inputLength + (4 * width inputLength + @@ -433,7 +433,7 @@ private theorem true_body_measured {rest : List Bool} · intro offset rw [continued_high store _ (by simp [inputBase]; omega)] have hinput := hinv.input_eq (offset + 1) - convert hinput using 1 + convert! hinput using 1 all_goals simp [Nat.add_assoc, Nat.add_comm, Nat.add_left_comm] private theorem decodeAux?_eq_map (bits : List Bool) (acc : ℕ) : @@ -508,7 +508,7 @@ private theorem loop_measured {remaining : List Bool} have hrun := MeasuredRuns.whileNonzeroEnvelope hactive hinv.store_bound (by simpa [body] using hbodyRun) hstop refine ⟨truncatedStore store, ?_, ?_, ?_, ?_, ?_, htruncatedBound⟩ - · apply MeasuredRuns.weakenCost (by simpa [mainLoop] using hrun) + · apply MeasuredRuns.weakenCost (by simpa [mainLoop] using! hrun) change 3 * width inputLength + (width inputLength + 8 * width inputLength) + width inputLength ≤ @@ -548,7 +548,7 @@ private theorem loop_measured {remaining : List Bool} have hrun := MeasuredRuns.whileNonzeroEnvelope hactive hinv.store_bound hbody hstop refine ⟨successStore store, ?_, ?_, ?_, ?_, ?_, hsuccessBound⟩ - · apply MeasuredRuns.weakenCost (by simpa [mainLoop] using hrun) + · apply MeasuredRuns.weakenCost (by simpa [mainLoop] using! hrun) change 3 * width inputLength + 32 * width inputLength + width inputLength ≤ 64 * ((false :: rest).length + 1) * width inputLength @@ -601,7 +601,7 @@ private theorem loop_measured {remaining : List Bool} 64 * (rest.length + 1) * width inputLength) (resourceSpace inputLength) := by rw [mainLoop] - convert hrun using 1 + convert! hrun using 1 all_goals omega apply MeasuredRuns.weakenCost hrun' change 3 * width inputLength + 32 * width inputLength + @@ -622,7 +622,7 @@ private theorem loop_measured {remaining : List Bool} 64 * (rest.length + 1) * width inputLength) (resourceSpace inputLength) := by rw [mainLoop] - convert hrun using 1 + convert! hrun using 1 all_goals omega apply MeasuredRuns.weakenCost hrun' change 3 * width inputLength + 32 * width inputLength + @@ -688,7 +688,7 @@ theorem mainLoop_measured_internal {remaining : List Bool} exact hspace refine ⟨final, cost, space, ?_, le_trans hcost hcostBound, hspaceBound, hresult, hactive, hone, hframe, hfinalBound⟩ - simpa [loopStepCount] using hexec + simpa [loopStepCount] using! hexec theorem program_measured_internal (bits : List Bool) : ∃ final cost space, @@ -728,14 +728,14 @@ theorem program_measured_internal (bits : List Bool) : | none => rw [hdecode] at hprogram simp only at hprogram - convert hprogram using 1 + convert! hprogram using 1 all_goals simp [stepCount, hdecode] all_goals omega | some result => rcases result with ⟨value, suffix⟩ rw [hdecode] at hprogram simp only at hprogram - convert hprogram using 1 + convert! hprogram using 1 all_goals simp [stepCount, hdecode] all_goals omega obtain ⟨cost, space, hexec, hcost, hspace⟩ := hprogram' diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Lift.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Lift.lean index c9638b0cc3..0b378579a4 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Lift.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Lift.lean @@ -157,8 +157,7 @@ private theorem liftTM_step_of_extras (tm : TM n) (m : ℕ) {c : Cfg n tm.Q} by_cases hh : c.state = tm.qhalt · -- both machines are halted have h1 : (tm.liftTM m).step C = none := by - simp only [step, hs, hh, show (tm.liftTM m).qhalt = tm.qhalt from rfl, - ↓reduceIte] + exact step_eq_none_iff_halted.2 (hs.trans hh) have h2 : tm.step c = none := by simp only [step, hh, ↓reduceIte] rw [h1, h2]; rfl @@ -171,9 +170,13 @@ private theorem liftTM_step_of_extras (tm : TM n) (m : ℕ) {c : Cfg n tm.Q} have hinner : (fun i : Fin n => (C.work (Fin.castAdd m i)).read) = fun i => (c.work i).read := funext fun i => by rw [hw (Fin.castAdd m i) i.isLt]; rfl - simp only [step, Option.map_some] + have hnot : C.state ≠ (tm.liftTM m).qhalt := by + exact fun h => hh (hs.symm.trans h) + simp only [step, Option.map_some, ite_eq_right hnot] dsimp only [liftTM, liftCfg] - rw [hs, hi, ho, hinner, ite_eq_right hh] + rw [hs, hi, ho, hinner] + change (if c.state = tm.qhalt then (none : Option (Cfg (n + m) tm.Q)) else _) = _ + rw [ite_eq_right hh] refine congrArg some (Cfg.mk.injEq _ _ _ _ _ _ _ _ |>.mpr ⟨rfl, rfl, ?_, rfl⟩) funext i by_cases hik : i.val < n @@ -435,8 +438,7 @@ private theorem retargetOutput_step_of_extras (tm : TM n) {c : Cfg n tm.Q} by_cases hh : c.state = tm.qhalt · -- both machines are halted have h1 : (tm.retargetOutput).step C = none := by - simp only [step, hs, hh, show (tm.retargetOutput).qhalt = tm.qhalt from rfl, - ↓reduceIte] + exact step_eq_none_iff_halted.2 (hs.trans hh) have h2 : tm.step c = none := by simp only [step, hh, ↓reduceIte] rw [h1, h2]; rfl @@ -450,9 +452,13 @@ private theorem retargetOutput_step_of_extras (tm : TM n) {c : Cfg n tm.Q} = fun i => (c.work i).read := funext fun i => by rw [hw (Fin.castSucc i) i.isLt]; rfl have hvirt : (C.work (Fin.last n)).read = c.output.read := by rw [hlast] - simp only [step, Option.map_some] + have hnot : C.state ≠ tm.retargetOutput.qhalt := by + exact fun h => hh (hs.symm.trans h) + simp only [step, Option.map_some, ite_eq_right hnot] dsimp only [retargetOutput, retargetCfg] - rw [hs, hi, hinner, hvirt, ite_eq_right hh] + rw [hs, hi, hinner, hvirt] + change (if c.state = tm.qhalt then (none : Option (Cfg (n + 1) tm.Q)) else _) = _ + rw [ite_eq_right hh] refine congrArg some (Cfg.mk.injEq _ _ _ _ _ _ _ _ |>.mpr ⟨rfl, rfl, ?_, ?_⟩) · funext i by_cases hik : i.val < n @@ -577,7 +583,7 @@ theorem retargetOutput_computesInTime_boundary (tm : TM n) theorem IsTransducer.liftTM {tm : TM n} (h : tm.IsTransducer) (m : ℕ) : (tm.liftTM m).IsTransducer := by intro q iHead wHeads oHead - simpa only [liftTM] using h q iHead + simpa only [liftTM] using! h q iHead (fun i => wHeads (Fin.castAdd m i)) oHead /-- Redirecting output to a work tape leaves the real output direction idle, diff --git a/LeanPool/BeyondBethe/Complexitylib/SAT/Verifier.lean b/LeanPool/BeyondBethe/Complexitylib/SAT/Verifier.lean index d8597ca477..1ada65105c 100644 --- a/LeanPool/BeyondBethe/Complexitylib/SAT/Verifier.lean +++ b/LeanPool/BeyondBethe/Complexitylib/SAT/Verifier.lean @@ -381,7 +381,7 @@ theorem CNF.decode?_sound {z : List Bool} {φ : CNF} simp [htok] at h have hz : z = encodeTokens toks := tokenize?_sound htok have htoks : toks = CNF.tokens φ := by - simpa using (parseTokensAux_sound h) + simpa using! (parseTokensAux_sound h) calc z = encodeTokens toks := hz _ = encodeTokens (CNF.tokens φ) := by rw [htoks] From 2a27421443fd587bb0c93778c8725963acd56a07 Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Tue, 22 Sep 2026 01:33:18 +0000 Subject: [PATCH 07/49] Port Turing composition and structured RAM proof dependencies --- .../BeyondBethe/CertificateCapacity.lean | 4 ++-- .../BeyondBethe/BeyondBethe/Optimizer.lean | 2 +- .../Classes/P/Cobham/Internal/MulLen.lean | 4 ++-- .../Classes/P/Cobham/Internal/TakeLen.lean | 2 +- .../Simulation/TMConfig.lean | 2 ++ .../TMConfig/Sparse/ABI/Internal/Loop.lean | 4 ++-- .../Simulation/TMConfig/Sparse/Internal.lean | 2 +- .../Structured/GateStep/Internal.lean | 20 +++++++++++------ .../Structured/GateStreamStep/Internal.lean | 2 +- .../Composition/Internal/FirstPhase.lean | 22 +++++++++++-------- .../Composition/PairWithInput/Defs.lean | 2 ++ .../Models/TuringMachine/Hoare.lean | 2 +- .../BinaryFor/Internal/Comparison.lean | 8 ++++--- .../BinaryRippleSub/Internal/Backward.lean | 4 ++-- 14 files changed, 48 insertions(+), 32 deletions(-) diff --git a/LeanPool/BeyondBethe/BeyondBethe/CertificateCapacity.lean b/LeanPool/BeyondBethe/BeyondBethe/CertificateCapacity.lean index 0e6a858364..f9cd59b9af 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/CertificateCapacity.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/CertificateCapacity.lean @@ -165,7 +165,7 @@ theorem selectorCapacityValue_le_ratio (columnSelector κ ι).eval z / realMonomial z α := by rw [le_div_iff₀ (realMonomial_pos hz α), columnSelector_eval, selectorCapacityValue_mul_realMonomial hα hz] - apply Finset.prod_le_prod + apply Finset.prod_le_prod₀ · intro j _ exact mul_nonneg (Finset.prod_nonneg fun c _ ↦ Real.rpow_nonneg @@ -239,7 +239,7 @@ theorem clusterProductCapacityValue_le_ratio rw [clusterProductCapacityValue, rowClusterProduct_eval_eq_prod_injection, realMonomial_eq_prod_clusters, ← Finset.prod_div_distrib] - apply Finset.prod_le_prod + apply Finset.prod_le_prod₀ · intro c _ exact polynomialCapacity_nonneg (injectionPolynomial_nonnegativeCoefficients diff --git a/LeanPool/BeyondBethe/BeyondBethe/Optimizer.lean b/LeanPool/BeyondBethe/BeyondBethe/Optimizer.lean index e29ca3a526..e8084256ef 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/Optimizer.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/Optimizer.lean @@ -559,7 +559,7 @@ theorem regularizedGradient_rectangle_identity hX hXint hmax (rectangleDirection_row_sum hjl) (rectangleDirection_col_sum hik) - rw [sum_mul_rectangleDirection _ hik hjl] at htangent + rw [sum_mul_rectangleDirection (regularizedBetheGradient τ A X) hik hjl] at htangent exact htangent /-- Any matrix with zero alternating sum on every rectangle is a sum of a diff --git a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/MulLen.lean b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/MulLen.lean index 649958faa6..2aea67e184 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/MulLen.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/MulLen.lean @@ -294,13 +294,13 @@ private theorem mulLenTM_emit_loop : rfl obtain ⟨c', hreach, hst, hcl, hhd, hin, hout⟩ := ih (k + 1) m (by omega) (acc ++ [false]) c1 rfl - (by rw [hc1]; simpa using hcells) + (by rw [hc1]; simpa using! hcells) (by rw [hc1]; simp [Tape.move, hhead]) (by rw [hc1]; simpa using hinp) (by rw [hc1]; exact Tape.hasBinaryPrefix_write_bit false hpre) refine ⟨c', .step hstep hreach, hst, hcl, hhd, by rw [hin, hc1], ?_⟩ rw [List.append_assoc] at hout - simpa using hout + simpa using! hout /-- The rewind pass: from `rew` with the work head at cell `h`, the machine walks back to the left-end marker and re-enters `outer` with the work head at cell one, diff --git a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/TakeLen.lean b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/TakeLen.lean index 5a43c6fb85..49d94cca7f 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/TakeLen.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/TakeLen.lean @@ -297,7 +297,7 @@ private theorem takeLenTM_copy_loop : rfl obtain ⟨c', t, ht, hreach, hhalt, hfin⟩ := ih (h + 1) m (by omega) (by omega) y (acc ++ [b]) c1 rfl - (by rw [hc1]; simpa using hcells) + (by rw [hc1]; simpa using! hcells) (by rw [hc1]; simp [Tape.move, hhead]) (by rw [hc1]; exact hsuf.move_right_cons) (by rw [hc1]; exact Tape.hasBinaryPrefix_write_bit b hpre) diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig.lean index 472236fdba..0dcb8c5f55 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig.lean @@ -26,6 +26,8 @@ namespace RAM namespace TMConfig +variable {n bound : ℕ} + /-- The state field is register zero. -/ @[simp] theorem fieldReg_state : fieldReg (stateField (n := n) (bound := bound)) = 0 := diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/ABI/Internal/Loop.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/ABI/Internal/Loop.lean index 3e4ad88612..afa8a777a8 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/ABI/Internal/Loop.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/ABI/Internal/Loop.lean @@ -248,7 +248,7 @@ theorem marshalLoopOps_control_internal (n : ℕ) (store : Structured.Store) · simp [stateReg, cellReg, inputTape, cellBase] simpa [marshalLoopOps, sourceAddressed, sourceLoaded, sourceCleared, zeroed, oned, counted, based, encoded, multiplied, destinationAddressed, - destinationStored, final] using + destinationStored, final] using! And.intro hfinalState (And.intro hfinalZero (And.intro hfinalOne (And.intro hfinalCount (And.intro hfinalBase hfinalDestination)))) @@ -678,7 +678,7 @@ theorem marshalLoop_exec_internal (n cursor : ℕ) max bodySpace loopSpace, ?_, hfinalCursor, hfinalZero, hfinalOne, hfinalCount, hfinalBase⟩ have hexec := Structured.Exec.whileNonzero hnonzero hbody hloop - convert hexec using 1 + convert! hexec using 1 simp [marshalLoopSteps, Nat.succ_mul] omega diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Internal.lean index 97520485c5..7c72412080 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Internal.lean @@ -242,7 +242,7 @@ theorem decode_of_represents_internal (tm : TM n) rw [hstate] exact stateDecode_code_internal tm cfg.state · apply Tape.ext - · simpa [decode, decodeTape, tapeAt_input_internal] using + · simpa [decode, decodeTape, tapeAt_input_internal] using! hrepresents (Sum.inr (Sum.inl ⟨0, by omega⟩)) · funext position simp only [decode, decodeTape] diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/GateStep/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/GateStep/Internal.lean index 81c14de545..b250a4609d 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/GateStep/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/GateStep/Internal.lean @@ -84,7 +84,7 @@ private theorem setup_measured (gate : CircuitCode.RawGate) (wires : List Bool) · apply hstore.execBasic (.imm UnaryDecode.activeReg 1) <;> simp [cursorBound, inputBits, UnaryDecode.activeReg, UnaryDecode.inputBase] - simpa [UnaryDecode.setup, setupStore] using + simpa [UnaryDecode.setup, setupStore] using! MeasuredRuns.basicsEnvelope UnaryDecode.setupOps (inputStore gate wires) hinitial hpreserve @@ -297,7 +297,7 @@ private theorem header_measured (gate : CircuitCode.RawGate) (wires : List Bool) refine ⟨?_, h9⟩ have hrun := r1.seq (r2.seq (r3.seq (r4.seq (r5.seq (r6.seq (r7.seq (r8.seq r9))))))) - convert hrun using 1 + convert! hrun using 1 ring private theorem header_cursorReady (gate : CircuitCode.RawGate) (wires : List Bool) : @@ -366,6 +366,12 @@ private theorem header_cursorReady (gate : CircuitCode.RawGate) (wires : List Bo rw [hpreserved] simp only [inputStore, Input.bitStore, UnaryDecode.remainingReg, UnaryDecode.inputBase] + change (if 10 + delta = 3 then (inputBits gate wires).length else + if 7 ≤ 10 + delta then + match (inputBits gate wires)[10 + delta - 7]? with + | some bit => Input.bitValue bit + | none => 0 + else 0) = _ rw [ite_eq_right (by omega : 10 + delta ≠ 3), ite_eq_left (by omega : 7 ≤ 10 + delta)] have hoffset : 10 + delta - 7 = 3 + delta := by omega rw [hoffset] @@ -587,7 +593,7 @@ private theorem saveRestart_measured {bound : ℕ} {store : Store} have r4 := MeasuredRuns.basicEnvelope (.imm UnaryDecode.activeReg 1) s3 h3 h4 refine ⟨?_, h4⟩ have hrun := h1.1.seq (r2.seq (r3.seq r4)) - convert hrun using 1 + convert! hrun using 1 ring private theorem marshal_measured {bound : ℕ} {store : Store} @@ -639,9 +645,9 @@ private theorem marshal_measured {bound : ℕ} {store : Store} refine ⟨?_, ?_⟩ · have hrun := r1.1.seq (r2.1.seq (r3.1.seq (r4.1.seq (r5.1.seq (r6.1.seq r7.1))))) - convert hrun using 1 + convert! hrun using 1 ring - · simpa [marshalStore, marshalOps, s1, s2, s3, s4, s5, s6] using r7.2.1 + · simpa [marshalStore, marshalOps, s1, s2, s3, s4, s5, s6] using! r7.2.1 private theorem input_wire (gate : CircuitCode.RawGate) (wires : List Bool) (index : ℕ) : @@ -710,7 +716,7 @@ theorem program_measured_internal (gate : CircuitCode.RawGate) (wires : List Boo ((Basic.add savedInput0Reg UnaryDecode.valueReg UnaryDecode.activeReg).exec first) := by apply hfirstBound.execBasic - · simpa [savedInput0Reg, UnaryDecode.inputBase] using hlarge + · simpa [savedInput0Reg, UnaryDecode.inputBase] using! hlarge · change first UnaryDecode.valueReg + first UnaryDecode.activeReg ≤ cursorBound gate wires rw [hfirstValue, hfirstActive] @@ -985,7 +991,7 @@ theorem program_measured_internal (gate : CircuitCode.RawGate) (wires : List Boo 80 * valueWidth (storeBound gate wires))))))) (envelopeSpace (storeBound gate wires) (storeBound gate wires)) := by simpa [program, UnaryDecode.setup, setupStore, saved, marshaled, - saveRestartStore, marshalStore] using hrun + saveRestartStore, marshalStore] using! hrun have hcostLe : 20 * valueWidth (storeBound gate wires) + (36 * valueWidth (storeBound gate wires) + diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/GateStreamStep/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/GateStreamStep/Internal.lean index c3dc99d09f..08190b3e6f 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/GateStreamStep/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/GateStreamStep/Internal.lean @@ -1054,7 +1054,7 @@ theorem routine_exec_internal {gateStart base : ℕ} (max marshalSpace (max gateSpace restoreSpace)))))), ?_⟩ rw [← hsteps] simpa [routine, setupStore, headerStore, saveRestartStore, marshaled, - final, restoreStore] using hrun + final, restoreStore] using! hrun obtain ⟨cost, space, hexec⟩ := hexec exact ⟨final, cost, space, hexec, hfinalPointer, hfinalRemaining, hfinalBase, hfinalCount, hfinalAppended, hfinalWires, hfinalCode⟩ diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Composition/Internal/FirstPhase.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Composition/Internal/FirstPhase.lean index 0fd06d2e9c..c4c1f8c963 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Composition/Internal/FirstPhase.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Composition/Internal/FirstPhase.lean @@ -120,9 +120,11 @@ theorem compositionFirstTM_boundary_internal (tmF : TM nf) (ng : ℕ) cases hreachR cases hreachC simpa [compositionFirstTM, compositionRawOutputIdx, Cfg.init] using hrawR - · rw [hC, compositionRawOutputIdx_eq_firstPlacedLast, - placeWorkParkedCfg, placeWorkCfg_work_middle] - exact hrawR + · rw [hC, compositionRawOutputIdx_eq_firstPlacedLast] + have hmiddle := placeWorkCfg_work_middle tmF.retargetOutput 0 (ng + 1) + (fun _ => (Tape.init []).move Dir3.right) cR (Fin.last nf) + have houtput := hmiddle ▸ hrawR + simpa only [placeWorkParkedCfg] using! houtput have hvirtual : transitionTape (C.work (compositionVirtualInputIdx nf ng)) = (Tape.init []).move Dir3.right := by rcases hshapeC with ht0 | hC @@ -137,9 +139,10 @@ theorem compositionFirstTM_boundary_internal (tmF : TM nf) (ng : ℕ) ((placeWorkCfg tmF.retargetOutput 0 (ng + 1) (fun _ => (Tape.init []).move Dir3.right) cR).work (compositionVirtualInputIdx nf ng)) = _ - rw [placeWorkCfg_work_extra _ _ _ _ _ _ hnot] - exact transitionTape_eq_self - (t := (Tape.init []).move Dir3.right) (by decide) + have hextra := placeWorkCfg_work_extra tmF.retargetOutput 0 (ng + 1) + (fun _ => (Tape.init []).move Dir3.right) cR _ hnot + exact (congrArg transitionTape hextra).trans + (transitionTape_eq_self (t := (Tape.init []).move Dir3.right) (by decide)) have hscratch : ∀ j : Fin ng, transitionTape (C.work (compositionSecondWorkIdx nf ng j)) = (Tape.init []).move Dir3.right := by @@ -156,9 +159,10 @@ theorem compositionFirstTM_boundary_internal (tmF : TM nf) (ng : ℕ) change transitionTape ((placeWorkCfg tmF.retargetOutput 0 (ng + 1) (fun _ => (Tape.init []).move Dir3.right) cR).work idx) = _ - rw [placeWorkCfg_work_extra _ _ _ _ _ _ hnot] - exact transitionTape_eq_self - (t := (Tape.init []).move Dir3.right) (by decide) + have hextra := placeWorkCfg_work_extra tmF.retargetOutput 0 (ng + 1) + (fun _ => (Tape.init []).move Dir3.right) cR _ hnot + exact (congrArg transitionTape hextra).trans + (transitionTape_eq_self (t := (Tape.init []).move Dir3.right) (by decide)) have hinvariants := reachesIn_startInvariant hreachFirst (Tape.StartInvariant.init_ofBool x) (fun _ => Tape.StartInvariant.init_nil) diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Composition/PairWithInput/Defs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Composition/PairWithInput/Defs.lean index 061383a303..dd241b258a 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Composition/PairWithInput/Defs.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Composition/PairWithInput/Defs.lean @@ -25,6 +25,8 @@ namespace Complexity namespace TM +variable {nf : ℕ} + /-- Work-tape count of `pairWithInputTM`. One extra tape beyond the redirected output is kept as a stable phase-composition frame. -/ abbrev pairWithInputTapeCount (nf : ℕ) := compositionTapeCount nf 0 diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Hoare.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Hoare.lean index 4086d14dc9..e7988f6e4f 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Hoare.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Hoare.lean @@ -57,7 +57,7 @@ theorem seqTM_hoareTime (tm₁ tm₂ : TM n) obtain ⟨c₂, t₂, ht₂, hreach₂, hhalt₂, hpost⟩ := h₂ _ _ _ hmid' refine ⟨phase2Wrap tm₁ tm₂ c₂, t₁ + 1 + t₂, ?_, ?_, ?_, ?_⟩ · omega - · convert seqTM_reachesIn_of_reachesIn tm₁ tm₂ hreach₁ hhalt₁ hreach₂ using 1 + · convert! seqTM_reachesIn_of_reachesIn tm₁ tm₂ hreach₁ hhalt₁ hreach₂ using 1 · rw [phase2Wrap_halted_iff]; exact hhalt₂ · exact hpost diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryFor/Internal/Comparison.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryFor/Internal/Comparison.lean index b04c87e40a..88de598c43 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryFor/Internal/Comparison.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryFor/Internal/Comparison.lean @@ -406,7 +406,7 @@ private theorem binaryForCompareCfg_step_scan_blank limitIdx hne equalSoFar c rfl hcounterRead hlimitRead hinp hwork hout dsimp only [c, binaryForCompareCfg] at hstep rw [binaryForWorkAt_move_left work hne] at hstep - simpa using hstep + simpa using! hstep private theorem binaryForCompareCfg_step_rewind (body : TM n) (work : Fin n → Tape) @@ -434,7 +434,7 @@ private theorem binaryForCompareCfg_step_rewind hne equalSoFar c rfl hinp hwork hout dsimp only [c, binaryForCompareCfg] at hstep rw [binaryForWorkAt_move_left work hne] at hstep - simpa using hstep + simpa using! hstep private theorem binaryForCompareCfg_rewind_reachesIn (body : TM n) (work : Fin n → Tape) @@ -582,7 +582,7 @@ private theorem binaryForCompareCfg_reachesIn_rewind_zero (paddedBinaryPrefixEq counterBits limitBits width) width have hrun := reachesIn_trans (binaryForTM body counterIdx limitIdx) hscanRewind hrewind - convert hrun using 1 + convert! hrun using 1 omega /-- At equality, the full-width comparison preserves every tape exactly and @@ -709,12 +709,14 @@ theorem binaryForTM_compare_reachesIn_frame_internal refine ⟨_, hrun, rfl, rfl, rfl, ?_, ?_⟩ · simp · simp + rfl · have hlt : value < limitValue := by omega have hrun := binaryForTM_compare_reachesIn_frame_of_lt_internal body counterIdx limitIdx hne value limitValue hlt inp₀ work₀ out₀ hcounter hlimit hinp hother hout refine ⟨_, hrun, rfl, rfl, rfl, ?_, ?_⟩ · simp [hlt] + rfl · simp [heq] end TM diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleSub/Internal/Backward.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleSub/Internal/Backward.lean index 524221bbe7..935f9565f0 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleSub/Internal/Backward.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleSub/Internal/Backward.lean @@ -90,7 +90,7 @@ private theorem binaryRippleSubCoreTM_step_erase simp only [↓reduceIte, Function.update_self] simp [moveLeftDir, hread] · rw [Function.update_of_ne hi] - simpa only [ite_eq_right hi] using transitionTape_eq_self (hother i hi) + simpa only [ite_eq_right hi] using! transitionTape_eq_self (hother i hi) · exact transitionTape_eq_self houtput private theorem binaryRippleSubCoreTM_step_trim_false_zero @@ -116,7 +116,7 @@ private theorem binaryRippleSubCoreTM_step_trim_false_zero simp only [↓reduceIte, Function.update_self] simp [moveLeftDir] · rw [Function.update_of_ne hi] - simpa only [ite_eq_right hi] using transitionTape_eq_self (hother i hi) + simpa only [ite_eq_right hi] using! transitionTape_eq_self (hother i hi) private theorem binaryRippleSubCoreTM_step_trim_false_one (c : Cfg n (binaryRippleSubCoreTM lhsIdx rhsIdx resultIdx).Q) From b65cd7ff7597ad4a2416ec8bdf277ae50bf23202 Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Tue, 22 Sep 2026 01:44:41 +0000 Subject: [PATCH 08/49] Port Bethe certificates and remaining machine transition proofs --- .../BeyondBethe/BeyondBethe/NearCase.lean | 23 ++++++++----- .../BeyondBethe/SourceBetheLower.lean | 5 +-- .../Machine/Instruction/Sim/Defs.lean | 2 +- .../Machine/Lookup/Internal/Reset.lean | 12 +++---- .../TMConfig/Sparse/ABI/Internal/Marshal.lean | 2 +- .../TMConfig/Sparse/Step/Internal/Action.lean | 8 ++--- .../TMConfig/Sparse/Step/Internal/Load.lean | 4 +-- .../TMConfig/Step/Internal/Layout.lean | 2 ++ .../Subroutines/BinaryPred/Internal.lean | 18 +++++----- .../Subroutines/BinarySucc/Internal.lean | 14 ++++---- .../TuringMachine/Subroutines/Internal.lean | 34 +++++++++---------- .../Subroutines/PairValidate/Internal.lean | 8 ++--- 12 files changed, 70 insertions(+), 62 deletions(-) diff --git a/LeanPool/BeyondBethe/BeyondBethe/NearCase.lean b/LeanPool/BeyondBethe/BeyondBethe/NearCase.lean index 704f08ee92..9144b90625 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/NearCase.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/NearCase.lean @@ -216,7 +216,7 @@ theorem cleanCycleWeightedCost_eq_support_sum encodedCoreRowTransferCost f g P U i := by let e := (c.1 : Equiv.Perm (Fin n)).support.orderIsoOfFin (cleanCycleFactor_property c).1 - rw [cleanCycleWeightedCost] + unfold cleanCycleWeightedCost calc (∑ k : Fin 2, encodedCoreRowTransferCost f g P U (cleanCycleRow c k)) = ∑ i : (c.1 : Equiv.Perm (Fin n)).support, @@ -238,7 +238,7 @@ theorem encodedCoreRowTransferCost_nonneg (f g : Equiv.Perm (Fin n)) (i : Fin n) : 0 ≤ encodedCoreRowTransferCost f g P (fun a b ↦ transferU τ (X a) b) i := by - rw [encodedCoreRowTransferCost, transferCostOn] + unfold encodedCoreRowTransferCost transferCostOn apply Finset.sum_nonneg intro j _ exact mul_nonneg (hP.nonnegative i j) @@ -278,8 +278,10 @@ theorem sum_cleanCycleWeightedCost_le_coreTransferCost ∑ c ∈ S, ∑ i ∈ t c, w i := by simpa using Finset.sum_coe_sort S (fun c ↦ ∑ i ∈ t c, w i) _ = ∑ i ∈ S.biUnion t, w i := (Finset.sum_biUnion hpair).symm - rw [coreTransferCost] - simp_rw [cleanCycleWeightedCost_eq_support_sum] + change (∑ c : S, cleanCycleWeightedCost + (fun a b => transferU τ (X a) b) c) ≤ ∑ i, w i + simp_rw [cleanCycleWeightedCost_eq_support_sum + (fun a b => transferU τ (X a) b)] change (∑ c : S, ∑ i ∈ t c.1, w i) ≤ ∑ i, w i rw [hunion] exact Finset.sum_le_sum_of_subset_of_nonneg (Finset.subset_univ _) @@ -328,11 +330,11 @@ theorem cleanCycle_minCost_mul_fourCore (transferU_le_one hτ (hXint i) j) have hsaCore : coreOutside (f s) (g s) = coreOutside a b := by rw [hcols.2.2.2.symm, hcols.2.2.1.symm, coreOutside_comm] - rw [cleanCycleWeightedCost] + unfold cleanCycleWeightedCost simp only [Fin.sum_univ_two] rw [show cleanCycleRow c 0 = r by rfl, show cleanCycleRow c 1 = s by rfl] - rw [encodedCoreRowTransferCost, encodedCoreRowTransferCost, hsaCore, - univ_sdiff_coreOutside_of_ne hcols.2.1] + unfold encodedCoreRowTransferCost + rw [hsaCore, univ_sdiff_coreOutside_of_ne hcols.2.1] simp only [transferCostOn, Finset.sum_insert, Finset.sum_singleton, Finset.mem_singleton, hcols.2.1, not_false_eq_true] rw [fourCoreTransferCost] @@ -368,7 +370,7 @@ theorem cleanCycleWeightedCost_nonneg (c : cleanCycleFactors η P (alternatingRowPerm f g)) : 0 ≤ cleanCycleWeightedCost (fun i j ↦ transferU τ (X i) j) c := by - rw [cleanCycleWeightedCost] + unfold cleanCycleWeightedCost exact Finset.sum_nonneg fun k _ ↦ encodedCoreRowTransferCost_nonneg hτ hP hXint f g (cleanCycleRow c k) @@ -1249,7 +1251,10 @@ theorem paperClusterFactor_rowClusteringOfMatching (rowPairRow q.1 0) (rowPairRow q.1 1) (rowPairRow_ne q.1) (hpositive q.1 q.2)] rw [matchingClusterLogGain] - simp only [rowClusteringOfMatching_rows_pair] + change Real.exp (Real.log (pairGain A X (rowPairRow q.1 0) (rowPairRow q.1 1))) * + (singletonFactor A X (rowPairRow q.1 0) * singletonFactor A X (rowPairRow q.1 1)) = + Real.exp (Real.log (pairGain A X (rowPairRow q.1 0) (rowPairRow q.1 1))) * + ∏ k : Fin 2, singletonFactor A X (rowPairRow q.1 k) have hprod := Fin.prod_univ_two (fun k : Fin 2 ↦ singletonFactor A X (rowPairRow q.1 k)) exact congrArg (Real.exp diff --git a/LeanPool/BeyondBethe/BeyondBethe/SourceBetheLower.lean b/LeanPool/BeyondBethe/BeyondBethe/SourceBetheLower.lean index c828e772bf..cc0d26d5c7 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/SourceBetheLower.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/SourceBetheLower.lean @@ -58,8 +58,9 @@ theorem paperClusterFactor_singletonRowClustering paperClusterFactor A X (singletonRowClustering n) (singletonRowClustering_singletonPairs n) i = singletonFactor A X i := by - rw [paperClusterFactor] - simp + unfold paperClusterFactor + rw [dif_pos (show (singletonRowClustering n).size i = 1 from rfl)] + rfl /-- Gurvits's pointwise Bethe lower certificate, obtained from the stable-coefficient theorem with singleton clusters. -/ diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Sim/Defs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Sim/Defs.lean index 4dea455678..96c46952d8 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Sim/Defs.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Sim/Defs.lean @@ -71,7 +71,7 @@ theorem liftedSource_ne_buffer {n : ℕ} tapes.liftedSource ≠ tapes.buffer := by intro h have hval : tapes.data.update.entry.source.val = n := by - simpa [liftedSource, buffer, lifted] using congrArg Fin.val h + simpa [liftedSource, buffer, lifted] using! congrArg Fin.val h have hlt := tapes.data.update.entry.source.isLt omega diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/Internal/Reset.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/Internal/Reset.lean index 05b68ea182..45b63b558f 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/Internal/Reset.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/Internal/Reset.lean @@ -59,26 +59,26 @@ private theorem found_reset_content · change (finalWork tapes.scan.entry.value).HasBinaryContent (entryLookupFoundBits tapes matched (rest.length + 1) address tapes.scan.entry.value) - simpa only [entryLookupFoundBits_one] using hreadable.value.2 + simpa only [entryLookupFoundBits_one] using! hreadable.value.2 · change (finalWork tapes.scan.entry.addressCounter).HasBinaryContent (entryLookupFoundBits tapes matched (rest.length + 1) address tapes.scan.entry.addressCounter) - simpa only [entryLookupFoundBits_two] using + simpa only [entryLookupFoundBits_two] using! hreadable.addressCounter.2 · change (finalWork tapes.scan.entry.addressWidth).HasBinaryContent (entryLookupFoundBits tapes matched (rest.length + 1) address tapes.scan.entry.addressWidth) - simpa only [entryLookupFoundBits_three] using + simpa only [entryLookupFoundBits_three] using! hreadable.addressWidth.2.hasBinaryContent · change (finalWork tapes.scan.entry.valueCounter).HasBinaryContent (entryLookupFoundBits tapes matched (rest.length + 1) address tapes.scan.entry.valueCounter) - simpa only [entryLookupFoundBits_four] using + simpa only [entryLookupFoundBits_four] using! hreadable.valueCounter.2 · change (finalWork tapes.scan.entry.valueWidth).HasBinaryContent (entryLookupFoundBits tapes matched (rest.length + 1) address tapes.scan.entry.valueWidth) - simpa only [entryLookupFoundBits_five] using + simpa only [entryLookupFoundBits_five] using! hreadable.valueWidth.2.hasBinaryContent · change (finalWork tapes.scan.entry.result).HasBinaryContent (entryLookupFoundBits tapes matched (rest.length + 1) address @@ -224,7 +224,7 @@ private theorem miss_reset_content · change (finalWork tapes.scan.count).HasBinaryContent (entryLookupMissBits tapes address tapes.scan.count) simpa only [EntryLookupRestoreTapes.scan_count, - entryLookupMissBits_eight] using hmiss.count.2.hasBinaryContent + entryLookupMissBits_eight] using! hmiss.count.2.hasBinaryContent private theorem miss_reset_start (tapes : EntryLookupRestoreTapes n) (store : Store) (address : ℕ) diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/ABI/Internal/Marshal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/ABI/Internal/Marshal.lean index 6abd6595e3..2bbc5bed44 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/ABI/Internal/Marshal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/ABI/Internal/Marshal.lean @@ -327,7 +327,7 @@ theorem marshalLoop_invariant_exec_internal (n : ℕ) (x : List Bool) bitlen (store stateReg) + 1 + bodyCost + 1 + loopCost, max bodySpace loopSpace, ?_, hfinalInvariant⟩ have hexec := Structured.Exec.whileNonzero hstoreNonzero hbody hloop - convert hexec using 1 + convert! hexec using 1 simp [marshalLoopSteps, Nat.succ_mul] omega diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Step/Internal/Action.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Step/Internal/Action.lean index 62cfa9387c..9fec16b7e0 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Step/Internal/Action.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Step/Internal/Action.lean @@ -638,7 +638,7 @@ private theorem workPrefix_step {tm : TM n} · have hother := writeMoveOps_otherTape_internal (tm := tm) (cfg := current) (Ne.symm (inputTape_ne_workTape n i)) (workWrites i) (workDirections i) store hcurrent hprefix.tapeCount - simpa [current, inputTape] using hother + simpa [current, inputTape] using! hother · intro j by_cases hji : j = i · subst j @@ -679,7 +679,7 @@ private theorem workPrefix_list {tm : TM n} (items.flatMap (fun i => writeMoveOps n (workTape i) (workWrites i) (workDirections i))) store) := by induction items generalizing processed store with - | nil => simpa using hprefix + | nil => simpa using! hprefix | cons i rest ih => have hinot : i ∉ processed := hfresh i (by simp) have hnext := workPrefix_step hprefix i hinot (hstarts i) @@ -994,7 +994,7 @@ private theorem writeOps_envelopeChain {tm : TM n} {bound : ℕ} (position := 0) (by omega) · simpa [Structured.Internal.Basic.writeValue] using hstartBound simpa [writeOps, addressOps, first, multiplied, addressed, valued, stored, - final] using And.intro henvelope (And.intro hfirst + final] using! And.intro henvelope (And.intro hfirst (And.intro hmultiplied (And.intro haddressed (And.intro hvalued (And.intro hstored hfinal))))) @@ -1047,7 +1047,7 @@ private theorem workPrefix_list_envelope {tm : TM n} {bound : ℕ} (items.reverse ++ processed) (Structured.Basic.execList ops store) ∧ ResourceEnvelopeChain tm bound ops store := by induction items generalizing processed store with - | nil => exact ⟨by simpa using hprefix, henvelope⟩ + | nil => exact ⟨by simpa using! hprefix, henvelope⟩ | cons i rest ih => have hinot : i ∉ processed := hfresh i (by simp) let current : Complexity.Cfg n tm.Q := diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Step/Internal/Load.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Step/Internal/Load.lean index 270746f95d..6b008a4f43 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Step/Internal/Load.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Step/Internal/Load.lean @@ -99,7 +99,7 @@ private theorem setup_loadedPrefix {tm : TM n} {cfg : Complexity.Cfg n tm.Q} simp [third, second, first, Structured.Basic.exec, zeroReg, oneReg, tapeCountReg, Function.update_of_ne] rw [hthirdState, hthirdZero, hstateStore, Nat.add_zero] - simpa [setupOps, first, second, third, final] using + simpa [setupOps, first, second, third, final] using! LoadedPrefix.mk hfinalRep hzero hone hcount hstate (by simp) private theorem loadTape_loadedPrefix {tm : TM n} @@ -161,7 +161,7 @@ private theorem loadTapes_loadedPrefix {tm : TM n} LoadedPrefix tm cfg (tapes.reverse ++ processed) (Structured.Basic.execList (tapes.flatMap (loadTapeOps n)) store) := by induction tapes generalizing processed store with - | nil => simpa using hloaded + | nil => simpa using! hloaded | cons tape rest ih => have hnext := loadTape_loadedPrefix hloaded tape have hfinal := ih (processed := tape :: processed) hnext diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Step/Internal/Layout.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Step/Internal/Layout.lean index bf612b57ac..8616c89b02 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Step/Internal/Layout.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Step/Internal/Layout.lean @@ -21,6 +21,8 @@ namespace RAM namespace TMConfig +variable {n bound : ℕ} {tape : Fin (n + 2)} + namespace Step diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryPred/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryPred/Internal.lean index decd704266..7811da25b3 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryPred/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryPred/Internal.lean @@ -173,7 +173,7 @@ private theorem binaryPredTM_step_zero (c : Cfg n (binaryPredTM idx).Q) simp only [↓reduceIte, Function.update_self] rfl · rw [Function.update_of_ne hi] - simpa only [ite_eq_right hi] using transitionTape_eq_self (hother i hi) + simpa only [ite_eq_right hi] using! transitionTape_eq_self (hother i hi) · exact transitionTape_eq_self houtput /-- Resolve borrow at the first one and advance to lookahead. -/ @@ -198,7 +198,7 @@ private theorem binaryPredTM_step_one (c : Cfg n (binaryPredTM idx).Q) simp only [↓reduceIte, Function.update_self] rfl · rw [Function.update_of_ne hi] - simpa only [ite_eq_right hi] using transitionTape_eq_self (hother i hi) + simpa only [ite_eq_right hi] using! transitionTape_eq_self (hother i hi) · exact transitionTape_eq_self houtput /-- Define zero underflow by turning left from the terminating blank. -/ @@ -300,7 +300,7 @@ private theorem binaryPredTM_step_erase (c : Cfg n (binaryPredTM idx).Q) simp only [↓reduceIte, Function.update_self] rfl · rw [Function.update_of_ne hi] - simpa only [ite_eq_right hi] using transitionTape_eq_self (hother i hi) + simpa only [ite_eq_right hi] using! transitionTape_eq_self (hother i hi) · exact transitionTape_eq_self houtput /-- Rewind one ordinary target cell to the left. -/ @@ -533,7 +533,7 @@ private theorem binaryPredTM_borrow_run (List.replicate (done + 1) true ++ rest) := by have hwrite := hcontent.write_set true hhead (by simp) rw [BinaryPred.set_false_to_true] at hwrite - simpa only [target, Tape.HasBinaryContent, Tape.move_cells] using + simpa only [target, Tape.HasBinaryContent, Tape.move_cells] using! hwrite have htargetCell0 : target.cells 0 = Γ.start := by exact Tape.write_move_cell0 Γ.one Dir3.right hcell0 @@ -565,7 +565,7 @@ private theorem binaryPredTM_borrow_run exact htargetHead) houtput refine ⟨c', ?_, hhalt, hinput', hwork', ?_, hcell0', houtput'⟩ - · convert TM.reachesIn.step hstep hreach using 1 + · convert! TM.reachesIn.step hstep hreach using 1 all_goals simp [BinaryPred.steps, Nat.add_assoc] all_goals omega · simpa [BinaryPred.ripple, List.replicate_add, @@ -587,7 +587,7 @@ private theorem binaryPredTM_borrow_run have hwrite := hcontent.write_set false hhead (by simp) rw [BinaryPred.set_true_to_false] at hwrite simpa only [target₁, Tape.HasBinaryContent, Tape.move_cells] - using hwrite + using! hwrite have htarget₁Cell0 : target₁.cells 0 = Γ.start := by exact Tape.write_move_cell0 Γ.zero Dir3.right hcell0 have htarget₁Head : target₁.head = done + 2 := by @@ -680,7 +680,7 @@ private theorem binaryPredTM_borrow_run exact .step hstep (.step hcheck' (.step herase' .zero)) refine ⟨c', ?_, hhalt, hinput', hwork', ?_, hcell0', houtput'⟩ · have hrun := reachesIn_trans (binaryPredTM idx) hprefix hreach - convert hrun using 1 + convert! hrun using 1 all_goals simp [BinaryPred.steps] all_goals omega · simpa [BinaryPred.ripple] using hstring @@ -699,7 +699,7 @@ private theorem binaryPredTM_borrow_run have hwrite := hcontent.write_set false hhead (by simp) rw [BinaryPred.set_true_to_false] at hwrite simpa only [target₁, Tape.HasBinaryContent, Tape.move_cells] - using hwrite + using! hwrite have htarget₁Cell0 : target₁.cells 0 = Γ.start := by exact Tape.write_move_cell0 Γ.zero Dir3.right hcell0 have htarget₁Head : target₁.head = done + 2 := by @@ -763,7 +763,7 @@ private theorem binaryPredTM_borrow_run exact .step hstep (.step hcheck' .zero) refine ⟨c', ?_, hhalt, hinput', hwork', ?_, hcell0', houtput'⟩ · have hrun := reachesIn_trans (binaryPredTM idx) hprefix hreach - convert hrun using 1 + convert! hrun using 1 all_goals simp [BinaryPred.steps] all_goals omega · simpa [BinaryPred.ripple] using hstring diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinarySucc/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinarySucc/Internal.lean index 260a31ed4d..e26df289ea 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinarySucc/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinarySucc/Internal.lean @@ -128,7 +128,7 @@ private theorem binarySuccTM_step_one (c : Cfg n (binarySuccTM idx).Q) simp only [↓reduceIte, Function.update_self] rfl · rw [Function.update_of_ne hi] - simpa only [ite_eq_right hi] using transitionTape_eq_self (hother i hi) + simpa only [ite_eq_right hi] using! transitionTape_eq_self (hother i hi) · exact transitionTape_eq_self houtput /-- Resolve a carry on zero: write one and turn left. -/ @@ -153,7 +153,7 @@ private theorem binarySuccTM_step_zero (c : Cfg n (binarySuccTM idx).Q) simp only [↓reduceIte, Function.update_self] rfl · rw [Function.update_of_ne hi] - simpa only [ite_eq_right hi] using transitionTape_eq_self (hother i hi) + simpa only [ite_eq_right hi] using! transitionTape_eq_self (hother i hi) · exact transitionTape_eq_self houtput /-- Resolve overflow on the terminating blank: append one and turn left. -/ @@ -178,7 +178,7 @@ private theorem binarySuccTM_step_blank (c : Cfg n (binarySuccTM idx).Q) simp only [↓reduceIte, Function.update_self] rfl · rw [Function.update_of_ne hi] - simpa only [ite_eq_right hi] using transitionTape_eq_self (hother i hi) + simpa only [ite_eq_right hi] using! transitionTape_eq_self (hother i hi) · exact transitionTape_eq_self houtput /-- Rewind one ordinary target cell to the left. -/ @@ -361,7 +361,7 @@ private theorem binarySuccTM_carry_run have htargetContent : target.HasBinaryContent (List.replicate done false ++ [true]) := by have hwrite := hcontent'.write_append true (by simpa using hhead) - simpa only [target, Tape.HasBinaryContent, Tape.move_cells] using hwrite + simpa only [target, Tape.HasBinaryContent, Tape.move_cells] using! hwrite have htargetCell0 : target.cells 0 = Γ.start := by exact Tape.write_move_cell0 Γ.one Dir3.left hcell0 have htargetHead : target.head = done := by @@ -411,7 +411,7 @@ private theorem binarySuccTM_carry_run (List.replicate done false ++ true :: rest) := by have hwrite := hcontent.write_set true hhead (by simp) rw [BinarySucc.set_false_to_true] at hwrite - simpa only [target, Tape.HasBinaryContent, Tape.move_cells] using hwrite + simpa only [target, Tape.HasBinaryContent, Tape.move_cells] using! hwrite have htargetCell0 : target.cells 0 = Γ.start := by exact Tape.write_move_cell0 Γ.one Dir3.left hcell0 have htargetHead : target.head = done := by @@ -459,7 +459,7 @@ private theorem binarySuccTM_carry_run (List.replicate (done + 1) false ++ rest) := by have hwrite := hcontent.write_set false hhead (by simp) rw [BinarySucc.set_true_to_false] at hwrite - simpa only [target, Tape.HasBinaryContent, Tape.move_cells] using hwrite + simpa only [target, Tape.HasBinaryContent, Tape.move_cells] using! hwrite have htargetCell0 : target.cells 0 = Γ.start := by exact Tape.write_move_cell0 Γ.zero Dir3.right hcell0 have htargetHead : target.head = (done + 1) + 1 := by @@ -489,7 +489,7 @@ private theorem binarySuccTM_carry_run exact htargetHead) houtput refine ⟨c', ?_, hhalt, hinput', hwork', ?_, hcell0', houtput'⟩ - · convert TM.reachesIn.step hstep hreach using 1 + · convert! TM.reachesIn.step hstep hreach using 1 all_goals simp [BinarySucc.steps, Nat.add_assoc] all_goals omega · simpa [BinarySucc.ripple, List.replicate_add, diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/Internal.lean index 01fb4d3828..b85e43a3b2 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/Internal.lean @@ -764,7 +764,7 @@ private theorem blankWorkTM_loop {n : ℕ} (idx : Fin n) (x : List Bool) : (∀ i, x.length ≤ i → (c1.work idx).cells (i + 1) = Γ.blank) := by cases hbit : x[k]'hk_lt with | false => - have hread0 : (c.work idx).read = Γ.zero := by simpa [hbit] using hread + have hread0 : (c.work idx).read = Γ.zero := by simpa [hbit] using! hread let c1 : Cfg n (blankWorkTM idx).Q := { state := ScanPhase.scanning input := c.input.move (TM.idleDir c.input.read) @@ -801,7 +801,7 @@ private theorem blankWorkTM_loop {n : ℕ} (idx : Fin n) (x : List Bool) : rw [Function.update_of_ne hne] exact hcell | true => - have hread1 : (c.work idx).read = Γ.one := by simpa [hbit] using hread + have hread1 : (c.work idx).read = Γ.one := by simpa [hbit] using! hread let c1 : Cfg n (blankWorkTM idx).Q := { state := ScanPhase.scanning input := c.input.move (TM.idleDir c.input.read) @@ -1040,7 +1040,7 @@ theorem blankWorkTM_hoareTime_frame_of_binaryString {n : ℕ} simp [Tape.read, hhead, hdata k le_rfl hk_lt] cases hbit : x[k]'hk_lt with | false => - have hread0 : (c.work idx).read = Γ.zero := by simpa [hbit] using hread + have hread0 : (c.work idx).read = Γ.zero := by simpa [hbit] using! hread let c1 : Cfg n (blankWorkTM idx).Q := { state := ScanPhase.scanning input := c.input.move (TM.idleDir c.input.read) @@ -1096,7 +1096,7 @@ theorem blankWorkTM_hoareTime_frame_of_binaryString {n : ℕ} hblank_tail1 hinput_keep houtput_keep hwork_keep exact ⟨c', .step hstep1 hreach, hhalt, hhead', hcell0', hblank', hinp', hout', hwork'⟩ | true => - have hread1 : (c.work idx).read = Γ.one := by simpa [hbit] using hread + have hread1 : (c.work idx).read = Γ.one := by simpa [hbit] using! hread let c1 : Cfg n (blankWorkTM idx).Q := { state := ScanPhase.scanning input := c.input.move (TM.idleDir c.input.read) @@ -1387,7 +1387,7 @@ private theorem copyInputToWorkTM_loop {n : ℕ} (idx : Fin n) (x : List Bool) : simp [TM.idleDir, hread, Tape.move] have hwork_keep : (c.work idx).writeAndMove Γ.blank (TM.idleDir ((c.work idx).read)) = c.work idx := by - simpa [transitionTape, hwork_blank] using + simpa [transitionTape, hwork_blank] using! (transitionTape_eq_self (t := c.work idx) (by simp [hwork_blank])) refine ⟨c1, ?_, rfl, ?_, ?_, ?_⟩ · simp [TM.step, hstate, copyInputToWorkTM, hread, c1, allIdle] @@ -1421,7 +1421,7 @@ private theorem copyInputToWorkTM_loop {n : ℕ} (idx : Fin n) (x : List Bool) : cases hbit : x[k]'hk_lt with | false => have hread0 : c.input.read = Γ.zero := by - simpa [hbit] using hread + simpa [hbit] using! hread let c1 : Cfg n (copyInputToWorkTM idx).Q := { state := CopyPhase.copying input := c.input.move Dir3.right @@ -1438,10 +1438,10 @@ private theorem copyInputToWorkTM_loop {n : ℕ} (idx : Fin n) (x : List Bool) : c1.work idx = (c.work idx).writeAndMove Γ.zero Dir3.right := by simp [c1] rw [hwidx] - simpa [hbit] using hprefix_next + simpa [hbit] using! hprefix_next | true => have hread1 : c.input.read = Γ.one := by - simpa [hbit] using hread + simpa [hbit] using! hread let c1 : Cfg n (copyInputToWorkTM idx).Q := { state := CopyPhase.copying input := c.input.move Dir3.right @@ -1458,7 +1458,7 @@ private theorem copyInputToWorkTM_loop {n : ℕ} (idx : Fin n) (x : List Bool) : c1.work idx = (c.work idx).writeAndMove Γ.one Dir3.right := by simp [c1] rw [hwidx] - simpa [hbit] using hprefix_next + simpa [hbit] using! hprefix_next obtain ⟨c1, hstep1, hstate1, hcells1, hhead1, hprefix1⟩ := hstep have hrem1 : rem = x.length - (k + 1) := by omega @@ -1582,7 +1582,7 @@ private theorem copyWorkToWorkTM_loop {n : ℕ} cases hbit : x[k]'hk_lt with | false => have hread0 : (c.work src).read = Γ.zero := by - simpa [hbit] using hsrc_read + simpa [hbit] using! hsrc_read let c1 : Cfg n (copyWorkToWorkTM src dst).Q := { state := CopyPhase.copying input := c.input.move (TM.idleDir c.input.read) @@ -1609,10 +1609,10 @@ private theorem copyWorkToWorkTM_loop {n : ℕ} c1.work dst = (c.work dst).writeAndMove Γ.zero Dir3.right := by simp [c1] rw [hdst] - simpa [hbit] using hprefix_next + simpa [hbit] using! hprefix_next | true => have hread1 : (c.work src).read = Γ.one := by - simpa [hbit] using hsrc_read + simpa [hbit] using! hsrc_read let c1 : Cfg n (copyWorkToWorkTM src dst).Q := { state := CopyPhase.copying input := c.input.move (TM.idleDir c.input.read) @@ -1639,7 +1639,7 @@ private theorem copyWorkToWorkTM_loop {n : ℕ} c1.work dst = (c.work dst).writeAndMove Γ.one Dir3.right := by simp [c1] rw [hdst] - simpa [hbit] using hprefix_next + simpa [hbit] using! hprefix_next obtain ⟨c1, hstep1, hstate1, hsrc_cells1, hsrc_head1, hprefix1⟩ := hstep have hrem1 : rem = x.length - (k + 1) := by omega @@ -1853,7 +1853,7 @@ theorem copyWorkToWorkTM_hoareTime_frame_of_binaryString {n : ℕ} cases hbit : x[k]'hk_lt with | false => have hread0 : (c.work src).read = Γ.zero := by - simpa [hbit] using hsrc_read + simpa [hbit] using! hsrc_read let c1 : Cfg n (copyWorkToWorkTM src dst).Q := { state := CopyPhase.copying input := c.input.move (TM.idleDir c.input.read) @@ -1892,7 +1892,7 @@ theorem copyWorkToWorkTM_hoareTime_frame_of_binaryString {n : ℕ} c1.work dst = (c.work dst).writeAndMove Γ.zero Dir3.right := by simp [c1] rw [hdst] - simpa [hbit] using hprefix_next + simpa [hbit] using! hprefix_next have hdst_cell01 : (c1.work dst).cells 0 = Γ.start := by have hdst : c1.work dst = (c.work dst).writeAndMove Γ.zero Dir3.right := by @@ -1909,7 +1909,7 @@ theorem copyWorkToWorkTM_hoareTime_frame_of_binaryString {n : ℕ} hinp', hout', hwork'⟩ | true => have hread1 : (c.work src).read = Γ.one := by - simpa [hbit] using hsrc_read + simpa [hbit] using! hsrc_read let c1 : Cfg n (copyWorkToWorkTM src dst).Q := { state := CopyPhase.copying input := c.input.move (TM.idleDir c.input.read) @@ -1948,7 +1948,7 @@ theorem copyWorkToWorkTM_hoareTime_frame_of_binaryString {n : ℕ} c1.work dst = (c.work dst).writeAndMove Γ.one Dir3.right := by simp [c1] rw [hdst] - simpa [hbit] using hprefix_next + simpa [hbit] using! hprefix_next have hdst_cell01 : (c1.work dst).cells 0 = Γ.start := by have hdst : c1.work dst = (c.work dst).writeAndMove Γ.one Dir3.right := by diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/PairValidate/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/PairValidate/Internal.lean index 192b875ca1..e73b2c4d6d 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/PairValidate/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/PairValidate/Internal.lean @@ -107,10 +107,10 @@ theorem pairValidateTM_lift_hoareTime_internal (workTapes : ℕ) (bits : List Bo | succ j => simp [Tape.init]) have hwf : AllTapesWF C.input C.work C.output := by refine ⟨?_, ?_, ?_, ?_, ?_, ?_⟩ - · rw [liftCfg_input, hinputCells] + · rw [show C.input = c'.input from rfl, hinputCells] rfl · intro j hj - rw [liftCfg_input, hinputCells] + rw [show C.input = c'.input from rfl, hinputCells] exact Tape.init_ofBool_cells_ne_start bits j hj · intro i rw [hwork i] @@ -120,8 +120,8 @@ theorem pairValidateTM_lift_hoareTime_internal (workTapes : ℕ) (bits : List Bo cases j with | zero => omega | succ j => simp [Tape.move, Tape.init] - · simpa only [liftCfg_output] using houtput0 - · simpa only [liftCfg_output] using houtputNoStart + · simpa only [liftCfg_output] using! houtput0 + · simpa only [liftCfg_output] using! houtputNoStart have hyes : bits ∈ validPairEncoding → C.output.cells 1 = Γ.one := by intro hmem rw [show C.output = c'.output from rfl, hout] From c13d3016e3e668a09bce0e8313dda51e5b40e31d Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Tue, 22 Sep 2026 01:50:19 +0000 Subject: [PATCH 09/49] Update word encoding and configuration simulation proofs --- .../Machine/EntryCleanup/Internal.lean | 2 +- .../Machine/WordDecode/Internal.lean | 10 ++++---- .../Machine/WordEncode/Internal.lean | 24 ++++++++++--------- .../Sparse/Step/Internal/Iteration.lean | 2 +- .../TMConfig/Step/Internal/Action.lean | 14 ++++++----- .../TMConfig/Step/Internal/Load.lean | 8 +++---- .../Combinators/Internal/Retarget.lean | 2 +- .../Composition/PairWithInput/Internal.lean | 4 ++-- .../Subroutines/BinaryAddConst/Internal.lean | 2 +- .../BinaryRippleAdd/Internal/Sem.lean | 2 +- 10 files changed, 37 insertions(+), 33 deletions(-) diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryCleanup/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryCleanup/Internal.lean index b9195b616a..d619d48e80 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryCleanup/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryCleanup/Internal.lean @@ -80,7 +80,7 @@ private theorem readable_target_content · simpa [entryMissBits, EntryMatchTapes.address, EntryMatchTapes.value, EntryMatchTapes.addressCounter, EntryMatchTapes.addressWidth, EntryMatchTapes.valueCounter, EntryMatchTapes.valueWidth, - EntryMatchTapes.result, tapes.injective.eq_iff] using hmatch.value.2 + EntryMatchTapes.result, tapes.injective.eq_iff] using! hmatch.value.2 · dsimp only [EntryMatchTapes.cleanupIdx] change (matchedWork tapes.addressCounter).HasBinaryContent (entryMissBits tapes entry queryBits tapes.addressCounter) diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/WordDecode/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/WordDecode/Internal.lean index 146505f790..1c775d85e3 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/WordDecode/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/WordDecode/Internal.lean @@ -1063,7 +1063,7 @@ private theorem payloadIterationRun simpa [body, wordPayloadTM, payloadIterationStartCfg, payloadIterationDoneCfg, TM.binaryForIterationTime, TM.binaryForIterationTM, TM.binaryForIterationWrap, TM.phase1Wrap, - TM.phase2Wrap, beforeWork, afterWork] using hlift + TM.phase2Wrap, beforeWork, afterWork] using! hlift private theorem payloadLoopbackStep (sourceIdx targetIdx counterIdx widthIdx : Fin n) @@ -1195,7 +1195,7 @@ theorem wordPayloadTM_reachesIn_frame_internal {n : ℕ} refine ⟨payloadDoneCfg sourceIdx targetIdx counterIdx widthIdx payload width inp₀ work₀ out₀, ?_, rfl, rfl, ?_, ?_, ?_, ?_, ?_, rfl⟩ · simpa [spec, payloadLoopSpec, wordPayloadTime, wordPayloadTM, - payloadScanCfg, hinitial] using hreach + payloadScanCfg, hinitial] using! hreach · change (payloadLoopWork sourceIdx targetIdx counterIdx widthIdx payload width work₀ width width sourceIdx).HasBinarySuffix rest rw [payloadLoopWork_source sourceIdx targetIdx counterIdx widthIdx] @@ -1247,7 +1247,7 @@ theorem wordWidthTM_reachesIn_frame_internal {n : ℕ} have hreach := spec.reachesIn_internal width 0 (by omega) have hinit := initial_work sourceIdx widthIdx hindices work₀ hwidth refine ⟨doneCfg sourceIdx widthIdx width inp₀ work₀ out₀, ?_, rfl, rfl, ?_, ?_, ?_, rfl⟩ - · simpa [spec, loopSpec, wordWidthTime, scanCfg, hinit] using hreach + · simpa [spec, loopSpec, wordWidthTime, scanCfg, hinit] using! hreach · change (wordWidthWork sourceIdx widthIdx work₀ width width sourceIdx).HasBinarySuffix (false :: payload) @@ -1403,7 +1403,7 @@ theorem wordDecodeTM_reachesIn_frame_internal {n : ℕ} output := TM.transitionTape widthDone.output } (TM.phase2Wrap separatorTM payloadTM payloadDone) := by rw [hwidthTransitionInput, hwidthTransitionWork, hwidthTransitionOutput] - simpa [tailTM, separatorTM, payloadTM, TM.phase1Wrap] using htailReach + simpa [tailTM, separatorTM, payloadTM, TM.phase1Wrap] using! htailReach have hfull := TM.seqTM_reachesIn_of_reachesIn widthTM tailTM (by simpa [widthTM] using hwidthReach) hwidthHalt htailReach' let finalCfg := TM.phase2Wrap widthTM tailTM @@ -1412,7 +1412,7 @@ theorem wordDecodeTM_reachesIn_frame_internal {n : ℕ} hpayloadSource, hpayloadTarget, hpayloadCounter, hpayloadWidth, ?_, hpayloadOutput.trans (hseparatorOutput.trans hwidthOutput)⟩ · simpa [finalCfg, wordDecodeTM, wordDecodeTime, widthTM, tailTM, - separatorTM, payloadTM] using hfull + separatorTM, payloadTM] using! hfull · change finalCfg.state = (wordDecodeTM sourceIdx targetIdx counterIdx widthIdx).qhalt change Sum.inr (Sum.inr payloadDone.state) = diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/WordEncode/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/WordEncode/Internal.lean index fc7ea40bc1..b5ddf5524f 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/WordEncode/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/WordEncode/Internal.lean @@ -98,7 +98,7 @@ theorem workEmitTM_reachesIn_frame_internal simpa [c'] using TM.transitionTape_eq_self (hother i hi).read_ne_start have houtput' : c'.output.HasBinaryPrefix (emitted ++ [false]) := by - simpa [c'] using Tape.hasBinaryPrefix_write_bit false houtput + simpa [c'] using! Tape.hasBinaryPrefix_write_bit false houtput refine ⟨c', .step hstep .zero, rfl, hinputKeep, ?_, ?_, ?_, hotherKeep, ?_⟩ · rw [hsourceKeep] @@ -351,7 +351,7 @@ theorem wordEncodeTM_hoareTime_frame_internal (TM.phase2Wrap (TM.rewindWorkTM idx) (workEmitTM idx .payload) payloadDone) := by simpa [hwidthInputTransition, hwidthWorkTransition, - hwidthOutputTransition] using hrestReach + hwidthOutputTransition] using! hrestReach have hfullReach := TM.seqTM_reachesIn_of_reachesIn (workEmitTM idx .width) (TM.seqTM (TM.rewindWorkTM idx) (workEmitTM idx .payload)) @@ -369,10 +369,12 @@ theorem wordEncodeTM_hoareTime_frame_internal (TM.seqTM (workEmitTM idx .width) (TM.seqTM (TM.rewindWorkTM idx) (workEmitTM idx .payload))).halted finalCfg - rw [TM.phase2Wrap_halted_iff, TM.phase2Wrap_halted_iff] - exact hpayloadHalt + exact (TM.phase2Wrap_halted_iff (workEmitTM idx .width) + (TM.seqTM (TM.rewindWorkTM idx) (workEmitTM idx .payload)) _).mpr + ((TM.phase2Wrap_halted_iff (TM.rewindWorkTM idx) + (workEmitTM idx .payload) payloadDone).mpr hpayloadHalt) · refine ⟨?_, hpayloadSuffix, ?_, ?_, ?_, ?_⟩ - · simpa [finalCfg] using + · simpa [finalCfg] using! hpayloadInput.trans (hrewindInput.trans hwidthInput) · have hcanonical := Tape.eq_init_move_right_of_hasBinaryString hvalue.2 hvalue.1 @@ -382,13 +384,13 @@ theorem wordEncodeTM_hoareTime_frame_internal · have hrewindHead : (rewindDone.work idx).head = 1 := by rw [hrewindTarget] simp [Tape.move] - simpa [finalCfg, hrewindHead, Nat.add_comm] using hpayloadHead + simpa [finalCfg, hrewindHead, Nat.add_comm] using! hpayloadHead · intro i hi - simpa [finalCfg] using + simpa [finalCfg] using! (hpayloadFrame i hi).trans ((hrewindFrame i hi).trans (hwidthFrame i hi)) · simpa [finalCfg, WordCode.encode, workEmitBits, bitlen, - Nat.toBitsLE_size, Nat.size_eq_bits_len, List.append_assoc] using + Nat.toBitsLE_size, Nat.size_eq_bits_len, List.append_assoc] using! hpayloadOutput theorem rewindWordEncodeTM_hoareTime_frame_internal @@ -476,15 +478,15 @@ theorem rewindWordEncodeTM_hoareTime_frame_internal rw [TM.phase2Wrap_halted_iff] exact hencodeHalt · refine ⟨?_, hencodeSuffix, ?_, ?_, ?_, ?_⟩ - · simpa [finalCfg] using hencodeInput.trans hrewindInput + · simpa [finalCfg] using! hencodeInput.trans hrewindInput · change (encodeDone.work idx).cells = (work₀ idx).cells rw [hencodeCells, hrewindTarget] exact (cells_eq_init_of_binaryContent hcontent hstart).symm - · simpa [finalCfg] using hencodeHead + · simpa [finalCfg] using! hencodeHead · intro i hi change encodeDone.work i = work₀ i exact (hencodeFrame i hi).trans (hrewindFrame i hi) - · simpa [finalCfg] using hencodeOutput + · simpa [finalCfg] using! hencodeOutput end Machine diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Step/Internal/Iteration.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Step/Internal/Iteration.lean index 7f6f6efbb0..5828834363 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Step/Internal/Iteration.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Step/Internal/Iteration.lean @@ -92,7 +92,7 @@ theorem continueCheck_exec_internal {tm : TM n} ⟨stateCode tm cfg.state, stateCode_lt tm cfg.state⟩) cleared final 1 cost space := by refine ⟨branchCost, branchSpace, ?_⟩ - simpa [hbranchState, final] using hbranchExec + simpa [hbranchState, final] using! hbranchExec obtain ⟨dispatchCost, dispatchSpace, hdispatch⟩ := Structured.Switch.select_exec (fun code : Fin (Fintype.card tm.Q) => .basics diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Step/Internal/Action.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Step/Internal/Action.lean index 0ec04ab858..0968391526 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Step/Internal/Action.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Step/Internal/Action.lean @@ -21,6 +21,8 @@ namespace RAM namespace TMConfig +variable {n bound : ℕ} + namespace Step @@ -500,7 +502,7 @@ private theorem represents_of_named_tapes {tm : TM n} {bound : ℕ} · rcases state with ⟨state, hstateFin⟩ have hzero : state = 0 := by omega subst state - simpa [fieldReg_state_internal, fieldValue] using hstate + simpa [fieldReg_state_internal, fieldValue] using! hstate · rcases headOrCell with head | cell · change store (headReg head) = (tapeAt cfg head).head by_cases hinputSlot : head = inputTape n @@ -622,7 +624,7 @@ private theorem actionPrelude_workPrefix {tm : TM n} {bound : ℕ} Function.update_of_ne honeReg] using hone have hinputStore : RepresentsTape bound (inputTape n) cfg.input store := by have htape := Represents.tape hrepresents (inputTape n) - simpa [inputTape] using htape + simpa [inputTape] using! htape have hinputInitialized : RepresentsTape bound (inputTape n) cfg.input initialized := hinputStore.stateUpdate bound (inputTape n) cfg.input store @@ -718,7 +720,7 @@ private theorem workPrefix_list {tm : TM n} {bound : ℕ} (items.flatMap (fun i => writeMoveOps n bound (workTape i) (workWrites i) (workDirections i))) store) := by induction items generalizing processed store with - | nil => simpa using hprefix + | nil => simpa using! hprefix | cons i rest ih => have hinot : i ∉ processed := hfresh i (by simp) have hnext := workPrefix_step hprefix i hinot (hheads i) (hstarts i) @@ -988,7 +990,7 @@ private theorem writeOps_envelopeChain (tm : TM n) (bound : ℕ) apply hstored.execBasic · exact hbaseLt · simpa [Structured.Internal.Basic.writeValue] using hstartBound - simpa [writeOps, first, addressed, valued, stored, final] using + simpa [writeOps, first, addressed, valued, stored, final] using! And.intro henvelope (And.intro hfirst (And.intro haddressed (And.intro hvalued (And.intro hstored hfinal)))) @@ -1030,7 +1032,7 @@ private theorem workPrefix_list_envelope {tm : TM n} {bound : ℕ} (items.reverse ++ processed) (Structured.Basic.execList ops store) ∧ StepEnvelopeChain tm bound ops store := by induction items generalizing processed store with - | nil => exact ⟨by simpa using hprefix, henvelope⟩ + | nil => exact ⟨by simpa using! hprefix, henvelope⟩ | cons i rest ih => have hinot : i ∉ processed := hfresh i (by simp) have hselected : RepresentsTape bound (workTape i) (cfg.work i) store := by @@ -1091,7 +1093,7 @@ private theorem actionOps_envelopeChain_internal {tm : TM n} {bound : ℕ} [.imm 0 (stateCode tm nextState)] store := ⟨henvelope, hinitialized⟩ have hinputStore : RepresentsTape bound (inputTape n) cfg.input store := by have htape := Represents.tape hrepresents (inputTape n) - simpa [inputTape] using htape + simpa [inputTape] using! htape have hinputHead : initialized (headReg (inputTape n)) ≤ bound := by have hhead := hheads (inputTape n) rw [show tapeAt cfg (inputTape n) = cfg.input by diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Step/Internal/Load.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Step/Internal/Load.lean index 1b44813f33..d052ca0ee1 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Step/Internal/Load.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Step/Internal/Load.lean @@ -158,7 +158,7 @@ private theorem loadTapes_loadedPrefix {tm : TM n} {bound : ℕ} LoadedPrefix tm bound cfg (tapes.reverse ++ processed) (Structured.Basic.execList (tapes.flatMap (loadTapeOps n bound)) store) := by induction tapes generalizing processed store with - | nil => simpa using hloaded + | nil => simpa using! hloaded | cons tape rest ih => have hnext := loadTape_loadedPrefix hloaded tape (hheads tape) have hfinal := ih (processed := tape :: processed) hnext @@ -221,7 +221,7 @@ private theorem setupOps_envelopeChain {tm : TM n} {bound : ℕ} · simpa [Structured.Internal.Basic.writeValue] using honeValue have hstateStore : store 0 = stateCode tm cfg.state := by have hstate := hrepresents (stateField (n := n) (bound := bound)) - simpa [fieldReg_state_internal, fieldValue] using hstate + simpa [fieldReg_state_internal, fieldValue] using! hstate have hsecondSource : second 0 = store 0 := by simp [second, first, Structured.Basic.exec, zeroReg, oneReg, scratchBase, registerCount, Function.update_of_ne] @@ -238,7 +238,7 @@ private theorem setupOps_envelopeChain {tm : TM n} {bound : ℕ} · simp only [Structured.Internal.Basic.writeValue] rw [hsecondSource, hsecondZero, hstateStore, Nat.add_zero] exact hstateBound - simpa [setupOps, first, second, final] using + simpa [setupOps, first, second, final] using! And.intro henvelope (And.intro hfirst (And.intro hsecond hfinal)) private theorem loadTapeOps_envelopeChain {tm : TM n} {bound : ℕ} @@ -307,7 +307,7 @@ private theorem loadTapeOps_envelopeChain {tm : TM n} {bound : ℕ} apply haddressed.execBasic · exact hscratch.2.2.2.2.2 tape · exact haddressed.value_le (addressed (addressReg n bound)) - simpa [loadTapeOps, first, addressed, final] using + simpa [loadTapeOps, first, addressed, final] using! And.intro henvelope (And.intro hfirst (And.intro haddressed hfinal)) private theorem loadTapes_envelopeChain {tm : TM n} {bound : ℕ} diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/Internal/Retarget.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/Internal/Retarget.lean index 8fa0d1494c..502df20992 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/Internal/Retarget.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/Internal/Retarget.lean @@ -502,7 +502,7 @@ theorem retargetInput_hoareTime (M : TM k) ({ state := (retargetInput M).qstart, input := realInput, work := work, output := out } : Cfg (k + 1) (retargetInput M).Q) := by refine Cfg.mk.injEq _ _ _ _ _ _ _ _ |>.mpr ⟨rfl, rfl, ?_, rfl⟩ - simpa [retargetInput] using hworkField + simpa [retargetInput] using! hworkField refine ⟨retargetWrap M finalReal c', t, ht, ?_, ?_, ?_⟩ · rw [← hstart] exact hreachSim diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Composition/PairWithInput/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Composition/PairWithInput/Internal.lean index a829600814..57234b1e41 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Composition/PairWithInput/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Composition/PairWithInput/Internal.lean @@ -202,7 +202,7 @@ theorem pairWithInputTailTM_hoareTime_internal (nf : ℕ) apply transitionTape_eq_self rw [hout] decide - simpa only [hinputStable, hworkStableAt, houtStable] using + simpa only [hinputStable, hworkStableAt, houtStable] using! (show PairWithInputEmitterPre nf first second inp work out from ⟨hinput, hrawHead, hrawOutput, hworkInv, hout⟩)) hemitter @@ -281,7 +281,7 @@ theorem pairWithInputTM_computesInTime_internal · have hreach := seqTM_reachesIn_of_reachesIn first tail hreachF hhaltF hreachTail simpa [pairWithInputTM, pairWithInputFirstTM, first, tail, final, - boundaryInput, boundaryWork, boundaryOutput] using hreach + boundaryInput, boundaryWork, boundaryOutput] using! hreach · show (pairWithInputTM tmF).halted final simpa [pairWithInputTM, first, tail, final] using (phase2Wrap_halted_iff first tail D).2 hhaltTail diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryAddConst/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryAddConst/Internal.lean index 12038ff5e0..828488f430 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryAddConst/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryAddConst/Internal.lean @@ -233,7 +233,7 @@ theorem binaryAddConstTM_reachesIn_frame_internal have hseq := seqTM_reachesIn_of_reachesIn (binaryAddConstTM idx fixedValue) (binarySuccTM idx) hprev rfl hnext' simpa [binaryAddConstTM, binaryAddConstTime, binaryAddConstNatTape, - binaryAddConstWorkAt] using hseq + binaryAddConstWorkAt] using! hseq theorem binaryAddConstTM_hoareTime_frame_internal (idx : Fin n) (fixedValue dstValue : ℕ) diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleAdd/Internal/Sem.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleAdd/Internal/Sem.lean index 6a5988f3fd..f22f394f2e 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleAdd/Internal/Sem.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleAdd/Internal/Sem.lean @@ -99,7 +99,7 @@ private theorem binaryRippleAddScanTM_hoareTime_frame_internal {n : ℕ} · rw [hfinalRhs] exact hrhs.1 · simpa [Nat.size_eq_bits_len] using hfinalRhsHead - · simpa [BinaryRippleAdd.ripple_natBits_internal] using hfinalResult.2 + · simpa [BinaryRippleAdd.ripple_natBits_internal] using! hfinalResult.2 · simpa [BinaryRippleAdd.ripple_natBits_internal, Nat.size_eq_bits_len] using hfinalResult.1 From e8ac1f1a34cac9516c10da927a17cd8bedb45e92 Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Tue, 22 Sep 2026 02:06:16 +0000 Subject: [PATCH 10/49] Port retargeted and register-store machine simulation proofs --- .../Classes/P/PairWithInput/Internal.lean | 2 +- .../Machine/AddressEq/Internal.lean | 2 +- .../Machine/DenseInputLookup/Internal.lean | 4 ++-- .../Machine/EntryDecode/Internal.lean | 2 +- .../Machine/EntryDecode/LinearInternal.lean | 2 +- .../Machine/EntryEncode/Internal.lean | 17 +++++++------- .../Machine/Instruction/Sim/Internal.lean | 22 +++++++++---------- .../Sparse/Step/Internal/Resources.lean | 8 +++---- .../Simulation/TMConfig/Step.lean | 2 ++ .../Combinators/RetargetCompute/Internal.lean | 5 ++--- .../BinaryShiftMul/Internal/Sem.lean | 12 +++++----- .../TuringMachine/Subroutines/WipeLoop.lean | 2 +- 12 files changed, 40 insertions(+), 40 deletions(-) diff --git a/LeanPool/BeyondBethe/Complexitylib/Classes/P/PairWithInput/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Classes/P/PairWithInput/Internal.lean index 47e73dfd24..bb052f8523 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Classes/P/PairWithInput/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Classes/P/PairWithInput/Internal.lean @@ -26,7 +26,7 @@ theorem mem_FP_pairWithInput_internal {f : List Bool → List Bool} Polynomial.C 5 * p + Polynomial.X + Polynomial.C 12 apply mem_FP_iff_computesInTime_polynomial_internal.mpr refine ⟨TM.pairWithInputTapeCount k, TM.pairWithInputTM tm, q, ?_⟩ - simpa [q, TM.pairWithInputTime] using + simpa [q, TM.pairWithInputTime] using! TM.pairWithInputTM_computesInTime hcomp end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/AddressEq/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/AddressEq/Internal.lean index 9707478df6..f2733dcbee 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/AddressEq/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/AddressEq/Internal.lean @@ -125,7 +125,7 @@ theorem decodedAddressEqTM_reachesIn_frame_internal {n : ℕ} input := inp₀ work := work₀ output := out₀ } finalCfg := by - simpa [decodedAddressEqTM, rewindTM, compareTM, finalCfg] using hfullReach + simpa [decodedAddressEqTM, rewindTM, compareTM, finalCfg] using! hfullReach have haddressStartFinal : (finalCfg.work addressIdx).cells 0 = Γ.start := TM.work_cells_zero_eq_start_of_reachesIn (tm := decodedAddressEqTM addressIdx queryIdx resultIdx) addressIdx diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/DenseInputLookup/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/DenseInputLookup/Internal.lean index 72979e8ae0..8028a72d01 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/DenseInputLookup/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/DenseInputLookup/Internal.lean @@ -804,7 +804,7 @@ theorem denseInputScanTM_reachesIn_frame_internal {n : ℕ} rw [← hstart] at hrun let done := denseInputDoneCfg counter result work₀ out₀ input address refine ⟨done, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_⟩ - · simpa [denseInputScanTime, spec, denseInputLoopSpec, done] using hrun + · simpa [denseInputScanTime, spec, denseInputLoopSpec, done] using! hrun · rfl · rfl · rfl @@ -943,7 +943,7 @@ theorem denseInputLookupTM_hoareTime_internal {n : ℕ} · rw [hdoneOther i hic hir] exact hcopiedParked i exact ⟨done, denseInputScanTime input.length address, le_rfl, - hreach, hhalt, hdoneHead, by simpa [inp₀] using hdoneCells, + hreach, hhalt, hdoneHead, by simpa [inp₀] using! hdoneCells, hdoneCounter, hdoneResult, hdoneOther, hdoneParked, hdoneOutput⟩ let stablePost : TM.TapePred n := fun inp work out => inp.cells = inp₀.cells ∧ diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryDecode/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryDecode/Internal.lean index c8ff974df6..27a84bf8b7 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryDecode/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryDecode/Internal.lean @@ -153,7 +153,7 @@ theorem entryDecodeTM_reachesIn_frame_internal {n : ℕ} refine ⟨finalCfg, ?_, ?_, hvalueInput.trans haddressInput, hvalueSource, ?_, ?_, hvalueTarget, hvalueStartFinal, ?_, ?_, hvalueCounterFinal, hvalueWidthFinal, ?_, hvalueOutput.trans haddressOutput⟩ - · simpa [entryDecodeTM, entryDecodeTime, addressTM, valueTM, finalCfg] using + · simpa [entryDecodeTM, entryDecodeTime, addressTM, valueTM, finalCfg] using! hfullReach · exact (TM.phase2Wrap_halted_iff addressTM valueTM valueDone).2 hvalueHalt · change (valueDone.work tapes.address).HasBinaryPrefix entry.1.bits diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryDecode/LinearInternal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryDecode/LinearInternal.lean index b6fbb277e1..7d57d6a8c7 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryDecode/LinearInternal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryDecode/LinearInternal.lean @@ -155,7 +155,7 @@ theorem entryDecodeLinearTM_reachesIn_frame_internal {n : ℕ} ?_, ?_, hvalueTarget, hvalueStartFinal, ?_, hvalueMarkerFinal, ?_, hvalueOutput.trans haddressOutput⟩ · simpa [entryDecodeLinearTM, entryDecodeLinearTime, addressTM, valueTM, - finalCfg] using hfullReach + finalCfg] using! hfullReach · exact (TM.phase2Wrap_halted_iff addressTM valueTM valueDone).2 hvalueHalt · change (valueDone.work tapes.address).HasBinaryPrefix entry.1.bits rw [hvalueFrame tapes.address (tapes.ne (by decide)) diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryEncode/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryEncode/Internal.lean index 893c3c0cee..eb1665ad64 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryEncode/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryEncode/Internal.lean @@ -131,7 +131,7 @@ theorem entryEncodeTM_hoareTime_frame_internal rw [TM.phase2Wrap_halted_iff] exact hvalueHalt · refine ⟨?_, ?_, ?_, ?_, hvalueSuffix, ?_, hvalueHeadFinal, ?_, ?_⟩ - · simpa [finalCfg] using hvalueInput.trans haddressInput + · simpa [finalCfg] using! hvalueInput.trans haddressInput · change (valueDone.work tapes.address).HasBinarySuffix [] rw [hvalueFrame tapes.address tapes.ne] exact haddressSuffix @@ -147,7 +147,7 @@ theorem entryEncodeTM_hoareTime_frame_internal · intro i hia hiv change valueDone.work i = work₀ i exact (hvalueFrame i hiv).trans (haddressFrame i hia) - · simpa [finalCfg, Entry.encode, List.append_assoc] using hvalueOutput + · simpa [finalCfg, Entry.encode, List.append_assoc] using! hvalueOutput theorem rewindEntryEncodeTM_hoareTime_frame_internal (tapes : EntryEncodeTapes n) (entry : Entry) @@ -257,7 +257,7 @@ theorem rewindEntryEncodeTM_hoareTime_frame_internal rw [TM.phase2Wrap_halted_iff] exact hvalueHalt · refine ⟨?_, ?_, ?_, ?_, hvalueSuffix, ?_, hvalueHeadFinal, ?_, ?_⟩ - · simpa [finalCfg] using hvalueInput.trans haddressInput + · simpa [finalCfg] using! hvalueInput.trans haddressInput · change (valueDone.work tapes.address).HasBinarySuffix [] rw [hvalueFrame tapes.address tapes.ne] exact haddressSuffix @@ -273,7 +273,7 @@ theorem rewindEntryEncodeTM_hoareTime_frame_internal · intro i hia hiv change valueDone.work i = work₀ i exact (hvalueFrame i hiv).trans (haddressFrame i hia) - · simpa [finalCfg, Entry.encode, List.append_assoc] using hvalueOutput + · simpa [finalCfg, Entry.encode, List.append_assoc] using! hvalueOutput theorem rewindEntryEncodeRestoreTM_hoareTime_frame_internal (tapes : EntryEncodeTapes n) (entry : Entry) (emitted : List Bool) @@ -458,7 +458,7 @@ theorem rewindEntryEncodeRestoreTM_hoareTime_frame_internal output := TM.transitionTape encoded.output } tailFinal := by simpa only [hencodedInputTransition, hencodedWorkTransition, - hencodedOutputTransition] using htailReach + hencodedOutputTransition] using! htailReach have hreach := TM.seqTM_reachesIn_of_reachesIn (rewindEntryEncodeTM tapes) (TM.seqTM (TM.rewindWorkTM tapes.address) @@ -471,10 +471,9 @@ theorem rewindEntryEncodeRestoreTM_hoareTime_frame_internal ?_, hreach, ?_, ?_⟩ · unfold rewindEntryEncodeRestoreTime omega - · change (rewindEntryEncodeRestoreTM tapes).halted finalCfg - unfold rewindEntryEncodeRestoreTM - rw [TM.phase2Wrap_halted_iff] - exact htailHalt + · exact (TM.phase2Wrap_halted_iff (rewindEntryEncodeTM tapes) + (TM.seqTM (TM.rewindWorkTM tapes.address) (TM.rewindWorkTM tapes.value)) + tailFinal).mpr htailHalt · refine ⟨?_, hrestoredWork, ?_⟩ · change restored.input = inp₀ exact hvalueInput.trans (haddressInput.trans hencodedInput) diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Sim/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Sim/Internal.lean index c4442d0fa3..fe6ac941f1 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Sim/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Sim/Internal.lean @@ -119,7 +119,7 @@ theorem dispatchProgramTM_hoareTime_of_execute_internal have hcleanLhs : cleanWork tapes.liftedLhs = blankTape := by have hzero := hready.1.control.lookup.destination change (cleanWork tapes.liftedLhs).HasBinaryNat 0 at hzero - simpa only [blankTape] using + simpa only [blankTape] using! Tape.HasBinaryNat.eq_init_move_right hzero have hwork₀Parked : ∀ i, TM.Parked (work₀ i) := by intro i @@ -376,12 +376,12 @@ theorem bufferedCleanupTM_hoareTime_frame_internal instructionCleanupResetHeadBound sourceHeadBound slot := by intro slot fin_cases slot - · simpa using (hready.result.cleanup 0).2.1.le - · simpa using (hready.result.cleanup 1).2.1.le - · simpa using (hready.result.cleanup 2).2.1.le - · simpa using (hready.result.cleanup 3).2.1.le - · simpa using (hready.result.cleanup 4).2.1.le - · simpa using hready.result.remaining.2.1.le + · simpa using! (hready.result.cleanup 0).2.1.le + · simpa using! (hready.result.cleanup 1).2.1.le + · simpa using! (hready.result.cleanup 2).2.1.le + · simpa using! (hready.result.cleanup 3).2.1.le + · simpa using! (hready.result.cleanup 4).2.1.le + · simpa using! hready.result.remaining.2.1.le · exact hready.sourceHead have hreset := TM.resetBinaryWorkManyTM_hoareTime_frame targets resetBits resetHeads inp₀ initialWork out₀ @@ -472,7 +472,7 @@ theorem bufferedCleanupTM_hoareTime_frame_internal (List.mem_ofFn.mpr ⟨slot, rfl⟩) have hresetSource : resetWork tapes.liftedSource = TM.resetBinaryBlank := by simpa [instructionCleanupResetTape, instructionCleanupResetParentSlot, - ControlInstructionTapes.liftedSource] using hresetTarget 6 + ControlInstructionTapes.liftedSource] using! hresetTarget 6 have hrewoundSource : rewoundWork tapes.liftedSource = TM.resetBinaryBlank := by simp [rewoundWork, tapes.liftedSource_ne_buffer, hresetSource] @@ -1083,7 +1083,7 @@ theorem instructionCleanupTM_hoareTime_frame_internal simpa only [nextStore, nextPC, cleanupValues, remainingValue, instructionCleanupTime, bufferedCleanupTime, instructionCleanupResetBitsAt, bufferedCleanupResetBitsAt, - instructionCleanupResetBits, bufferedCleanupResetBits] using hgeneric + instructionCleanupResetBits, bufferedCleanupResetBits] using! hgeneric /-- One selected instruction followed by cleanup realizes the next reusable sparse-snapshot boundary. -/ @@ -1135,7 +1135,7 @@ theorem programStepTM_hoareTime_frame_internal hprogram inp work out hpre have hsourceStart₀ : (work tapes.liftedSource).cells 0 = Γ.start := by - simpa [hpre.2.1] using hready.control.lookup.sourceStart + simpa [hpre.2.1] using! hready.control.lookup.sourceStart have hsourceStart := TM.work_cells_zero_eq_start_of_reachesIn tapes.liftedSource hreach hsourceStart₀ have hbufferStart₀ : @@ -1155,7 +1155,7 @@ theorem programStepTM_hoareTime_frame_internal bufferStart := hbufferStart sourceHead := ?_ } have hsourceHead₀ : (work tapes.liftedSource).head = 1 := by - simpa [hpre.2.1] using hready.control.lookup.sourceHead + simpa [hpre.2.1] using! hready.control.lookup.sourceHead rw [hsourceHead₀] at hsourceHead simp only [sourceBound, programStepSourceHeadBound] omega diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Step/Internal/Resources.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Step/Internal/Resources.lean index cb5847fb5d..e937dfc40f 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Step/Internal/Resources.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Step/Internal/Resources.lean @@ -225,7 +225,7 @@ private theorem setupOps_envelopeChain {tm : TM n} {bound : ℕ} · simp only [Structured.Internal.Basic.writeValue] rw [hthirdState, hthirdZero, hstoreState, Nat.add_zero] exact hstateBound - simpa [setupOps, first, second, third, final] using + simpa [setupOps, first, second, third, final] using! And.intro henvelope (And.intro hfirst (And.intro hsecond (And.intro hthird hfinal))) @@ -337,7 +337,7 @@ private theorem loadTapeOps_envelopeChain {tm : TM n} {bound : ℕ} · exact lt_trans (hrange.2.2.2.2.2.2 tape).2 (control_lt_registerBound_internal n bound) · exact haddressed.value_le (addressed (addressReg n)) - simpa [loadTapeOps, addressOps, first, multiplied, addressed, final] using + simpa [loadTapeOps, addressOps, first, multiplied, addressed, final] using! And.intro henvelope (And.intro hfirst (And.intro hmultiplied (And.intro haddressed hfinal))) @@ -470,7 +470,7 @@ theorem continueCheck_measured_internal {tm : TM n} {bound : ℕ} ⟨stateCode tm cfg.state, by simp [stateCode]⟩) cleared final 1 (4 * wordWidth tm bound) (spaceBound tm bound) := by simpa [hbranchState, final, wordWidth, Structured.Internal.valueWidth, - spaceBound, Structured.Internal.envelopeSpace] using hbranch + spaceBound, Structured.Internal.envelopeSpace] using! hbranch have hdispatch := Structured.Switch.select_measured (fun code : Fin (Fintype.card tm.Q) => .basics [.imm (valueReg n) @@ -699,7 +699,7 @@ theorem loop_measured_internal {tm : TM n} {steps base : ℕ} (spaceBound tm bound) := by simpa [loopBody] using hbody have hrun := Structured.Internal.MeasuredRuns.whileNonzeroEnvelope - hnonzero (by simpa [bound, Nat.add_assoc] using henvelope) hbody' hloop' + hnonzero (by simpa [bound, Nat.add_assoc] using! henvelope) hbody' hloop' refine ⟨final, ?_, hfinalRepresents, ?_⟩ · simpa [loopSteps, loopTimeBound, hstep, bound, wordWidth, Structured.Internal.valueWidth, spaceBound, diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Step.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Step.lean index e908d2c73e..120eb115b6 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Step.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Step.lean @@ -27,6 +27,8 @@ namespace RAM namespace TMConfig +variable {n bound : ℕ} + namespace Step diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/RetargetCompute/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/RetargetCompute/Internal.lean index 792ecaae01..22330944ee 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/RetargetCompute/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/RetargetCompute/Internal.lean @@ -44,8 +44,7 @@ theorem retargetInputStarted_reachesIn_of_retargetInput_internal (M : TM k) (fun c => c) _ hreach intro c₀ c₁ hstep change (retargetInputStarted M).step c₀ = some c₁ - rw [retargetInputStarted_step_eq_internal] - exact hstep + exact (retargetInputStarted_step_eq_internal M c₀).trans hstep /-- In the nondegenerate case, the wrapper start state is exactly the source state after its first transition from the all-sentinel configuration. -/ @@ -210,7 +209,7 @@ theorem retargetInputStarted_hoareTime_internal (M : TM k) retargetInputStartedCfg M y inp := by exact Cfg.ext rfl rfl hpre.1 hpre.2 refine ⟨c', t, ht, ?_, hhalt, hout⟩ - convert hreach using 1 + exact hstart.symm ▸ hreach /-- Combined placement seam with an exact preserved physical frame. The source work tapes and virtual input occupy the placed middle block; all prefix and diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryShiftMul/Internal/Sem.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryShiftMul/Internal/Sem.lean index 5309744836..9441af0f98 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryShiftMul/Internal/Sem.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryShiftMul/Internal/Sem.lean @@ -330,7 +330,7 @@ private theorem binaryShiftMulDoubleTM_hoareTime_frame {n : ℕ} (fun inp' work' out' => inp' = inp ∧ work' = work₂ ∧ out' = out) (resetBinaryWorkTime 1 shift.size) := by simpa only [work₂, binaryShiftMulNatTape, - Nat.size_eq_bits_len] using hresetTmp + Nat.size_eq_bits_len] using! hresetTmp have hwork₂ : ∀ i, Parked (work₂ i) := by intro i by_cases hi : i = abi.tmp @@ -683,7 +683,7 @@ private theorem binaryShiftMulBitBodyTM_hoareTime_frame {n : ℕ} hfinalShift, hfinalTmp, hfinalDbl, hfinalFrame, hfinalOutput⟩ := hrun have heq : (work₀ abi.rhs).read = Γ.one := by - simpa using hbit + simpa using! hbit obtain ⟨C, hbranch, hbranchHalt, hinputEq, hworkEq, houtputEq⟩ := branchWorkSymbolTM_reachesIn_equal_frame abi.rhs Γ.one (binaryShiftMulOneTM abi) (binaryShiftMulDoubleTM abi) @@ -1097,7 +1097,7 @@ private theorem binaryShiftMulLoopTM_hoareTime_frame {n : ℕ} acc shift simpa [binaryShiftMulBodyDoneCfg, binaryShiftMulScanCfg, binaryShiftMulPartialWork, work, acc, shift, - binaryShiftMulBodyDoneWork, body, hadvance] using hstep + binaryShiftMulBodyDoneWork, body, hadvance] using! hstep stopStep := by apply forBinaryWorkTM_step_scan_blank_internal abi.rhs body · rfl @@ -1133,11 +1133,11 @@ private theorem binaryShiftMulLoopTM_hoareTime_frame {n : ℕ} by_cases haccIdx : i = abi.acc · subst i rw [binaryShiftMulPartialWork, binaryShiftMulLoopWork_acc] - simpa [BinaryShiftMul.partialAcc] using hacc.eq_init_move_right.symm + simpa [BinaryShiftMul.partialAcc] using! hacc.eq_init_move_right.symm by_cases hshiftIdx : i = abi.shift · subst i rw [binaryShiftMulPartialWork, binaryShiftMulLoopWork_shift] - simpa [BinaryShiftMul.partialShift] using hshift.eq_init_move_right.symm + simpa [BinaryShiftMul.partialShift] using! hshift.eq_init_move_right.symm by_cases htmpIdx : i = abi.tmp · subst i rw [binaryShiftMulPartialWork, binaryShiftMulLoopWork_tmp] @@ -1164,7 +1164,7 @@ private theorem binaryShiftMulLoopTM_hoareTime_frame {n : ℕ} work := work₀ output := out₀ } doneCfg := by simpa [binaryShiftMulLoopTM, spec, binaryShiftMulScanCfg, - hinitialWork, doneCfg, body] using hloop + hinitialWork, doneCfg, body] using! hloop refine ⟨doneCfg, forBinaryWorkLoopTime bodyTime 0 rhs.size, (by simpa [binaryShiftMulLoopBound] using hloopTime), hreach, rfl, ?_⟩ refine ⟨rfl, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_, rfl⟩ diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/WipeLoop.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/WipeLoop.lean index 9d2b5ee244..1da8a957eb 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/WipeLoop.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/WipeLoop.lean @@ -146,7 +146,7 @@ theorem eq_parkedBlank_of_outAcc_nil {t : Tape} (h : OutAcc [] t) : funext j rcases Nat.eq_zero_or_pos j with hj0 | hj1 · subst hj0; rw [hcell0, Tape.init_cells_zero] - · rw [htail j (by simpa using hj1), show j = (j - 1) + 1 from by omega, + · rw [htail j (by simpa using! hj1), show j = (j - 1) + 1 from by omega, Tape.init_cells_ge [] (j - 1) (by simp)] /-- The register-shaped tape at iteration `i` is `Parked`. -/ From 9924cb39f5fa71fa8d07e767468a889b5abb7991 Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Tue, 22 Sep 2026 02:11:40 +0000 Subject: [PATCH 11/49] Adapt composed machine runs and sparse ABI resource proofs --- .../Classes/P/Cobham/Internal/SndBlock.lean | 16 +- .../Machine/EntryAppend/Internal.lean | 25 +- .../Machine/EntryMatch/Internal.lean | 234 +++++++++--------- .../Machine/EntryMissCopy/Internal.lean | 30 +-- .../Machine/EntryReplace/Internal.lean | 31 +-- .../Machine/Program/Init/Internal.lean | 206 +++++++-------- .../Sparse/ABI/Internal/Resources.lean | 96 +++---- .../Composition/Internal/Tail.lean | 15 +- 8 files changed, 330 insertions(+), 323 deletions(-) diff --git a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/SndBlock.lean b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/SndBlock.lean index 873051c149..9bdcf3ec56 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/SndBlock.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/SndBlock.lean @@ -133,7 +133,7 @@ private theorem sndBlockTM_emit_loop : rw [show c.output.writeAndMove (readBackWrite c.output.read) (idleDir c.output.read) = c.output from by rw [writeAndMove_readBack c.output houtne, idleDir, ite_eq_right houtne, Tape.move]] - simpa using hpre + simpa using! hpre | cons bit y ih => intro acc c hstate hsuf hpre have hread : c.input.read = Γ.ofBool bit := hsuf.read_cons @@ -186,7 +186,7 @@ private theorem sndBlockTM_scan_loop : rw [show c.output.writeAndMove (readBackWrite c.output.read) (idleDir c.output.read) = c.output from by rw [writeAndMove_readBack c.output houtne, idleDir, ite_eq_right houtne, Tape.move]] - simpa [sndBlock] using hpre.hasOutput + simpa [sndBlock] using! hpre.hasOutput | succ fuel ih => intro w hw c hstate hsuf hpre -- Halting helper for the malformed / end-of-input branches. @@ -205,7 +205,7 @@ private theorem sndBlockTM_scan_loop : rw [show c.output.writeAndMove (readBackWrite c.output.read) (idleDir c.output.read) = c.output from by rw [writeAndMove_readBack c.output houtne, idleDir, ite_eq_right houtne, Tape.move]] - simpa [sndBlock] using hpre.hasOutput + simpa [sndBlock] using! hpre.hasOutput | [false] => -- scanA reads false → scanBfalse; next reads blank → done. have hread : c.input.read = Γ.ofBool false := hsuf.read_cons @@ -236,7 +236,7 @@ private theorem sndBlockTM_scan_loop : rw [show c1.output.writeAndMove (readBackWrite c1.output.read) (idleDir c1.output.read) = c1.output from by rw [writeAndMove_readBack c1.output houtne1, idleDir, ite_eq_right houtne1, Tape.move]] - simpa [sndBlock] using hpre1.hasOutput + simpa [sndBlock] using! hpre1.hasOutput | [true] => have hread : c.input.read = Γ.ofBool true := hsuf.read_cons let c1 : Cfg 0 sndBlockTM.Q := @@ -266,7 +266,7 @@ private theorem sndBlockTM_scan_loop : rw [show c1.output.writeAndMove (readBackWrite c1.output.read) (idleDir c1.output.read) = c1.output from by rw [writeAndMove_readBack c1.output houtne1, idleDir, ite_eq_right houtne1, Tape.move]] - simpa [sndBlock] using hpre1.hasOutput + simpa [sndBlock] using! hpre1.hasOutput | false :: true :: y => -- separator: scanA false → scanBfalse → (reads true) → emit; copy y. have hreadA : c.input.read = Γ.ofBool false := hsuf.read_cons @@ -307,7 +307,7 @@ private theorem sndBlockTM_scan_loop : .step hstepA (.step hstepB hreach), hhalt, ?_⟩ have : sndBlock (false :: true :: y) = y := by simp [sndBlock, unpair?] rw [this] - simpa using hcout.hasOutput + simpa using! hcout.hasOutput | false :: false :: z => have hreadA : c.input.read = Γ.ofBool false := hsuf.read_cons let c1 : Cfg 0 sndBlockTM.Q := @@ -422,7 +422,7 @@ private theorem sndBlockTM_scan_loop : = c1.output from by rw [writeAndMove_readBack c1.output houtne1, idleDir, ite_eq_right houtne1, Tape.move]] have : sndBlock (true :: false :: rest) = [] := by simp [sndBlock, unpair?] - rw [this]; simpa using hpre1.hasOutput + rw [this]; simpa using! hpre1.hasOutput /-- `sndBlock` is polynomial-time, via the `sndBlockTM` scanner. -/ theorem sndBlock_mem_FP : sndBlock ∈ FP := by @@ -444,7 +444,7 @@ theorem sndBlock_mem_FP : sndBlock ∈ FP := by exact ⟨c', t + 1, by show t + 1 ≤ 2 * z.length + 3; omega, .step hstep1 hreach, hhalt, hcout⟩ · have hn : (fun m : ℕ => 2 * m) =O ((· ^ 1) : ℕ → ℕ) := by - simpa [pow_one] using (BigO.refl (fun m : ℕ => m)).const_mul_left 2 + simpa [pow_one] using! (BigO.refl (fun m : ℕ => m)).const_mul_left 2 exact BigO.add hn (BigO.const_le_pow 3 1) end Cobham diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryAppend/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryAppend/Internal.lean index 6d27de5bc8..ce75245cb1 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryAppend/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryAppend/Internal.lean @@ -78,16 +78,16 @@ theorem entryAppendRestoreTM_hoareTime_frame_internal hencode inp₀ readyWork out₀ ⟨rfl, rfl, rfl⟩ have hqueryCells' : (encoded.work tapes.entry.query).cells = (readyWork tapes.entry.query).cells := by - simpa using hqueryCells + simpa using! hqueryCells have hqueryEncodedHead' : (encoded.work tapes.entry.query).head = address.bits.length + 1 := by - simpa using hqueryEncodedHead + simpa using! hqueryEncodedHead have hreplacementCells' : (encoded.work tapes.replacement).cells = (readyWork tapes.replacement).cells := by - simpa using hreplacementCells + simpa using! hreplacementCells have hreplacementEncodedHead' : (encoded.work tapes.replacement).head = newValue.bits.length + 1 := by - simpa using hreplacementEncodedHead + simpa using! hreplacementEncodedHead have hencodedInputParked : TM.Parked encoded.input := by rw [hencodedInput] exact hinput @@ -97,15 +97,15 @@ theorem entryAppendRestoreTM_hoareTime_frame_internal intro i by_cases hiq : i = tapes.entry.query · subst i - exact parked_of_binarySuffix (by simpa using hquerySuffix) + exact parked_of_binarySuffix (by simpa using! hquerySuffix) · by_cases hir : i = tapes.replacement · subst i - exact parked_of_binarySuffix (by simpa using hreplacementSuffix) + exact parked_of_binarySuffix (by simpa using! hreplacementSuffix) · rw [hencodedFrame i hiq hir] exact hready.parked i have hqueryContent : (encoded.work tapes.entry.query).HasBinaryContent address.bits := by - simpa only [Tape.HasBinaryContent, hqueryCells'] using hready.query.2 + simpa only [Tape.HasBinaryContent, hqueryCells'] using! hready.query.2 have hqueryStart : (encoded.work tapes.entry.query).cells 0 = Γ.start := by rw [hqueryCells'] @@ -130,7 +130,7 @@ theorem entryAppendRestoreTM_hoareTime_frame_internal (queryRewound.work tapes.replacement).HasBinaryContent newValue.bits := by rw [hqueryFrame tapes.replacement (tapes.replacement_ne 7)] - simpa only [Tape.HasBinaryContent, hreplacementCells'] using + simpa only [Tape.HasBinaryContent, hreplacementCells'] using! hreplacement.2.hasBinaryContent have hreplacementStart : (queryRewound.work tapes.replacement).cells 0 = Γ.start := by @@ -199,7 +199,7 @@ theorem entryAppendRestoreTM_hoareTime_frame_internal output := TM.transitionTape queryRewound.output } restored := by simpa only [hqueryInputTransition, hqueryWorkTransition, - hqueryOutputTransition] using hreplacementReach + hqueryOutputTransition] using! hreplacementReach have htailReach := TM.seqTM_reachesIn_of_reachesIn (TM.rewindWorkTM tapes.entry.query) (TM.rewindWorkTM tapes.replacement) hqueryReach hqueryHalt hreplacementReach' @@ -227,7 +227,7 @@ theorem entryAppendRestoreTM_hoareTime_frame_internal output := TM.transitionTape encoded.output } tailFinal := by simpa only [hencodedInputTransition, hencodedWorkTransition, - hencodedOutputTransition] using htailReach + hencodedOutputTransition] using! htailReach have hreach := TM.seqTM_reachesIn_of_reachesIn (rewindEntryEncodeTM tapes.appendEncodeTapes) (TM.seqTM (TM.rewindWorkTM tapes.entry.query) @@ -243,8 +243,9 @@ theorem entryAppendRestoreTM_hoareTime_frame_internal omega · change (entryAppendRestoreTM tapes).halted finalCfg unfold entryAppendRestoreTM - rw [TM.phase2Wrap_halted_iff] - exact htailHalt + exact (TM.phase2Wrap_halted_iff (rewindEntryEncodeTM tapes.appendEncodeTapes) + (TM.seqTM (TM.rewindWorkTM tapes.entry.query) + (TM.rewindWorkTM tapes.replacement)) tailFinal).mpr htailHalt · refine ⟨?_, ?_, ?_⟩ · change restored.input = inp₀ exact hreplacementInput.trans (hqueryInput.trans hencodedInput) diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryMatch/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryMatch/Internal.lean index c560b54771..829f24a1c3 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryMatch/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryMatch/Internal.lean @@ -99,81 +99,81 @@ theorem entryMatchTM_reachesIn_frame_internal {n : ℕ} hdecodeValueStart, hdecodeAddressCounter, hdecodeValueCounter, hdecodeFrame, hdecodeOutput⟩ := entryDecodeLinearTM_reachesIn_frame tapes.decode entry rest inp₀ work₀ out₀ - (by simpa using hsource) (by simpa using haddress) - (by simpa using hvalue) (by simpa using haddressStart) - (by simpa using hvalueStart) + (by simpa using! hsource) (by simpa using! haddress) + (by simpa using! hvalue) (by simpa using! haddressStart) + (by simpa using! hvalueStart) (by - simpa [Tape.HasBinaryPrefix, Tape.HasBinaryString] using + simpa [Tape.HasBinaryPrefix, Tape.HasBinaryString] using! haddressCounter.2) haddressCounter.1 (by - simpa [Tape.HasBinaryPrefix, Tape.HasBinaryString] using + simpa [Tape.HasBinaryPrefix, Tape.HasBinaryString] using! hvalueCounter.2) hvalueCounter.1 hinput.read_ne_start (fun i => (hwork i).read_ne_start) houtput.read_ne_start have hdecodeAddressWidth : (decodeDone.work tapes.addressWidth).HasBinaryNat 0 := by rw [hdecodeFrame tapes.addressWidth - (by simpa using tapes.ne (show (4 : Fin 9) ≠ 0 by decide)) - (by simpa using tapes.ne (show (4 : Fin 9) ≠ 1 by decide)) - (by simpa using tapes.ne (show (4 : Fin 9) ≠ 2 by decide)) - (by simpa using tapes.ne (show (4 : Fin 9) ≠ 3 by decide)) - (by simpa using tapes.ne (show (4 : Fin 9) ≠ 5 by decide))] + (by simpa using! tapes.ne (show (4 : Fin 9) ≠ 0 by decide)) + (by simpa using! tapes.ne (show (4 : Fin 9) ≠ 1 by decide)) + (by simpa using! tapes.ne (show (4 : Fin 9) ≠ 2 by decide)) + (by simpa using! tapes.ne (show (4 : Fin 9) ≠ 3 by decide)) + (by simpa using! tapes.ne (show (4 : Fin 9) ≠ 5 by decide))] exact haddressWidth have hdecodeValueWidth : (decodeDone.work tapes.valueWidth).HasBinaryNat 0 := by rw [hdecodeFrame tapes.valueWidth - (by simpa using tapes.ne (show (6 : Fin 9) ≠ 0 by decide)) - (by simpa using tapes.ne (show (6 : Fin 9) ≠ 1 by decide)) - (by simpa using tapes.ne (show (6 : Fin 9) ≠ 2 by decide)) - (by simpa using tapes.ne (show (6 : Fin 9) ≠ 3 by decide)) - (by simpa using tapes.ne (show (6 : Fin 9) ≠ 5 by decide))] + (by simpa using! tapes.ne (show (6 : Fin 9) ≠ 0 by decide)) + (by simpa using! tapes.ne (show (6 : Fin 9) ≠ 1 by decide)) + (by simpa using! tapes.ne (show (6 : Fin 9) ≠ 2 by decide)) + (by simpa using! tapes.ne (show (6 : Fin 9) ≠ 3 by decide)) + (by simpa using! tapes.ne (show (6 : Fin 9) ≠ 5 by decide))] exact hvalueWidth have hdecodeQuery : (decodeDone.work tapes.query).HasBinaryString queryBits := by rw [hdecodeFrame tapes.query - (by simpa using tapes.ne (show (7 : Fin 9) ≠ 0 by decide)) - (by simpa using tapes.ne (show (7 : Fin 9) ≠ 1 by decide)) - (by simpa using tapes.ne (show (7 : Fin 9) ≠ 2 by decide)) - (by simpa using tapes.ne (show (7 : Fin 9) ≠ 3 by decide)) - (by simpa using tapes.ne (show (7 : Fin 9) ≠ 5 by decide))] + (by simpa using! tapes.ne (show (7 : Fin 9) ≠ 0 by decide)) + (by simpa using! tapes.ne (show (7 : Fin 9) ≠ 1 by decide)) + (by simpa using! tapes.ne (show (7 : Fin 9) ≠ 2 by decide)) + (by simpa using! tapes.ne (show (7 : Fin 9) ≠ 3 by decide)) + (by simpa using! tapes.ne (show (7 : Fin 9) ≠ 5 by decide))] exact hquery have hdecodeResult : (decodeDone.work tapes.result).HasBinaryPrefix [] := by rw [hdecodeFrame tapes.result - (by simpa using tapes.ne (show (8 : Fin 9) ≠ 0 by decide)) - (by simpa using tapes.ne (show (8 : Fin 9) ≠ 1 by decide)) - (by simpa using tapes.ne (show (8 : Fin 9) ≠ 2 by decide)) - (by simpa using tapes.ne (show (8 : Fin 9) ≠ 3 by decide)) - (by simpa using tapes.ne (show (8 : Fin 9) ≠ 5 by decide))] + (by simpa using! tapes.ne (show (8 : Fin 9) ≠ 0 by decide)) + (by simpa using! tapes.ne (show (8 : Fin 9) ≠ 1 by decide)) + (by simpa using! tapes.ne (show (8 : Fin 9) ≠ 2 by decide)) + (by simpa using! tapes.ne (show (8 : Fin 9) ≠ 3 by decide)) + (by simpa using! tapes.ne (show (8 : Fin 9) ≠ 5 by decide))] exact hresult have hdecodeParked : ∀ i, TM.Parked (decodeDone.work i) := by intro i by_cases his : i = tapes.source · subst i - exact parked_of_hasBinarySuffix (by simpa using hdecodeSource) + exact parked_of_hasBinarySuffix (by simpa using! hdecodeSource) · by_cases hia : i = tapes.address · subst i - exact parked_of_hasBinaryPrefix (by simpa using hdecodeAddress) + exact parked_of_hasBinaryPrefix (by simpa using! hdecodeAddress) · by_cases hiv : i = tapes.value · subst i - exact parked_of_hasBinaryPrefix (by simpa using hdecodeValue) + exact parked_of_hasBinaryPrefix (by simpa using! hdecodeValue) · by_cases hiac : i = tapes.addressCounter · subst i exact parked_of_hasBinaryPrefix - (by simpa using hdecodeAddressCounter) + (by simpa using! hdecodeAddressCounter) · by_cases hiaw : i = tapes.addressWidth · subst i exact parked_of_hasBinaryNat - (by simpa using hdecodeAddressWidth) + (by simpa using! hdecodeAddressWidth) · by_cases hivc : i = tapes.valueCounter · subst i exact parked_of_hasBinaryPrefix - (by simpa using hdecodeValueCounter) + (by simpa using! hdecodeValueCounter) · by_cases hivw : i = tapes.valueWidth · subst i exact parked_of_hasBinaryNat - (by simpa using hdecodeValueWidth) + (by simpa using! hdecodeValueWidth) · by_cases hiq : i = tapes.query · subst i exact ⟨by rw [hdecodeQuery.1], @@ -181,9 +181,9 @@ theorem entryMatchTM_reachesIn_frame_internal {n : ℕ} · by_cases hir : i = tapes.result · subst i exact parked_of_hasBinaryPrefix hdecodeResult - · rw [hdecodeFrame i (by simpa using his) - (by simpa using hia) (by simpa using hiv) - (by simpa using hiac) (by simpa using hivc)] + · rw [hdecodeFrame i (by simpa using! his) + (by simpa using! hia) (by simpa using! hiv) + (by simpa using! hiac) (by simpa using! hivc)] exact hwork i have hdecodeQueryStart : (decodeDone.work tapes.query).cells 0 = Γ.start := @@ -195,8 +195,8 @@ theorem entryMatchTM_reachesIn_frame_internal {n : ℕ} hcompareQueryHead, hcompareQueryStart, hcompareFrame, hcompareOutput⟩ := decodedAddressEqTM_reachesIn_frame tapes.address tapes.query tapes.result tapes.binaryEqDistinct entry.1.bits queryBits decodeDone.input - decodeDone.work decodeDone.output (by simpa using hdecodeAddress) - (by simpa using hdecodeAddressStart) hdecodeQuery hdecodeQueryStart + decodeDone.work decodeDone.output (by simpa using! hdecodeAddress) + (by simpa using! hdecodeAddressStart) hdecodeQuery hdecodeQueryStart hdecodeResult (by rw [hdecodeInput]; exact hinput.read_ne_start) (fun i _ _ _ => ⟨(hdecodeParked i).read_ne_start, (hdecodeParked i).1⟩) @@ -219,9 +219,9 @@ theorem entryMatchTM_reachesIn_frame_internal {n : ℕ} work := fun i => TM.transitionTape (decodeDone.work i) output := TM.transitionTape decodeDone.output } compareDone := by rw [htransitionInput, htransitionWork, htransitionOutput] - simpa [compareTM] using hcompareReach + simpa [compareTM] using! hcompareReach have hfullReach := TM.seqTM_reachesIn_of_reachesIn decodeTM compareTM - (by simpa [decodeTM] using hdecodeReach) hdecodeHalt hcompareReach' + (by simpa [decodeTM] using! hdecodeReach) hdecodeHalt hcompareReach' let finalCfg := TM.phase2Wrap decodeTM compareTM compareDone have hresultStartFinal : (finalCfg.work tapes.result).cells 0 = Γ.start := TM.work_cells_zero_eq_start_of_reachesIn @@ -243,10 +243,10 @@ theorem entryMatchTM_reachesIn_frame_internal {n : ℕ} · subst i apply parked_of_hasBinarySuffix rw [hcompareFrame tapes.source - (by simpa using tapes.ne (show (0 : Fin 9) ≠ 1 by decide)) - (by simpa using tapes.ne (show (0 : Fin 9) ≠ 7 by decide)) - (by simpa using tapes.ne (show (0 : Fin 9) ≠ 8 by decide))] - simpa using hdecodeSource + (by simpa using! tapes.ne (show (0 : Fin 9) ≠ 1 by decide)) + (by simpa using! tapes.ne (show (0 : Fin 9) ≠ 7 by decide)) + (by simpa using! tapes.ne (show (0 : Fin 9) ≠ 8 by decide))] + simpa using! hdecodeSource · by_cases hia : i = tapes.address · subst i exact ⟨hcompareAddressHead, @@ -255,42 +255,42 @@ theorem entryMatchTM_reachesIn_frame_internal {n : ℕ} · subst i apply parked_of_hasBinaryPrefix rw [hcompareFrame tapes.value - (by simpa using tapes.ne (show (2 : Fin 9) ≠ 1 by decide)) - (by simpa using tapes.ne (show (2 : Fin 9) ≠ 7 by decide)) - (by simpa using tapes.ne (show (2 : Fin 9) ≠ 8 by decide))] - simpa using hdecodeValue + (by simpa using! tapes.ne (show (2 : Fin 9) ≠ 1 by decide)) + (by simpa using! tapes.ne (show (2 : Fin 9) ≠ 7 by decide)) + (by simpa using! tapes.ne (show (2 : Fin 9) ≠ 8 by decide))] + simpa using! hdecodeValue · by_cases hiac : i = tapes.addressCounter · subst i apply parked_of_hasBinaryPrefix rw [hcompareFrame tapes.addressCounter - (by simpa using tapes.ne (show (3 : Fin 9) ≠ 1 by decide)) - (by simpa using tapes.ne (show (3 : Fin 9) ≠ 7 by decide)) - (by simpa using tapes.ne (show (3 : Fin 9) ≠ 8 by decide))] - simpa using hdecodeAddressCounter + (by simpa using! tapes.ne (show (3 : Fin 9) ≠ 1 by decide)) + (by simpa using! tapes.ne (show (3 : Fin 9) ≠ 7 by decide)) + (by simpa using! tapes.ne (show (3 : Fin 9) ≠ 8 by decide))] + simpa using! hdecodeAddressCounter · by_cases hiaw : i = tapes.addressWidth · subst i apply parked_of_hasBinaryNat rw [hcompareFrame tapes.addressWidth - (by simpa using tapes.ne (show (4 : Fin 9) ≠ 1 by decide)) - (by simpa using tapes.ne (show (4 : Fin 9) ≠ 7 by decide)) - (by simpa using tapes.ne (show (4 : Fin 9) ≠ 8 by decide))] - simpa using hdecodeAddressWidth + (by simpa using! tapes.ne (show (4 : Fin 9) ≠ 1 by decide)) + (by simpa using! tapes.ne (show (4 : Fin 9) ≠ 7 by decide)) + (by simpa using! tapes.ne (show (4 : Fin 9) ≠ 8 by decide))] + simpa using! hdecodeAddressWidth · by_cases hivc : i = tapes.valueCounter · subst i apply parked_of_hasBinaryPrefix rw [hcompareFrame tapes.valueCounter - (by simpa using tapes.ne (show (5 : Fin 9) ≠ 1 by decide)) - (by simpa using tapes.ne (show (5 : Fin 9) ≠ 7 by decide)) - (by simpa using tapes.ne (show (5 : Fin 9) ≠ 8 by decide))] - simpa using hdecodeValueCounter + (by simpa using! tapes.ne (show (5 : Fin 9) ≠ 1 by decide)) + (by simpa using! tapes.ne (show (5 : Fin 9) ≠ 7 by decide)) + (by simpa using! tapes.ne (show (5 : Fin 9) ≠ 8 by decide))] + simpa using! hdecodeValueCounter · by_cases hivw : i = tapes.valueWidth · subst i apply parked_of_hasBinaryNat rw [hcompareFrame tapes.valueWidth - (by simpa using tapes.ne (show (6 : Fin 9) ≠ 1 by decide)) - (by simpa using tapes.ne (show (6 : Fin 9) ≠ 7 by decide)) - (by simpa using tapes.ne (show (6 : Fin 9) ≠ 8 by decide))] - simpa using hdecodeValueWidth + (by simpa using! tapes.ne (show (6 : Fin 9) ≠ 1 by decide)) + (by simpa using! tapes.ne (show (6 : Fin 9) ≠ 7 by decide)) + (by simpa using! tapes.ne (show (6 : Fin 9) ≠ 8 by decide))] + simpa using! hdecodeValueWidth · by_cases hiq : i = tapes.query · subst i exact ⟨hcompareQueryHead, @@ -299,9 +299,9 @@ theorem entryMatchTM_reachesIn_frame_internal {n : ℕ} · subst i exact parked_of_hasBinaryPrefix hcompareResult · rw [hcompareFrame i hia hiq hir, - hdecodeFrame i (by simpa using his) - (by simpa using hia) (by simpa using hiv) - (by simpa using hiac) (by simpa using hivc)] + hdecodeFrame i (by simpa using! his) + (by simpa using! hia) (by simpa using! hiv) + (by simpa using! hiac) (by simpa using! hivc)] exact hwork i refine ⟨finalCfg, entryDecodeLinearTime entry.1 entry.2 + 1 + compareTime, ?_, ?_, ?_, hcompareInput.trans hdecodeInput, ?_, hcompareAddress, @@ -312,58 +312,58 @@ theorem entryMatchTM_reachesIn_frame_internal {n : ℕ} hcompareOutput.trans hdecodeOutput⟩ · simp only [entryMatchTime] omega - · simpa [entryMatchTM, decodeTM, compareTM, finalCfg] using hfullReach + · simpa [entryMatchTM, decodeTM, compareTM, finalCfg] using! hfullReach · exact (TM.phase2Wrap_halted_iff decodeTM compareTM compareDone).2 hcompareHalt · change (compareDone.work tapes.source).HasBinarySuffix rest rw [hcompareFrame tapes.source - (by simpa using tapes.ne (show (0 : Fin 9) ≠ 1 by decide)) - (by simpa using tapes.ne (show (0 : Fin 9) ≠ 7 by decide)) - (by simpa using tapes.ne (show (0 : Fin 9) ≠ 8 by decide))] - simpa using hdecodeSource + (by simpa using! tapes.ne (show (0 : Fin 9) ≠ 1 by decide)) + (by simpa using! tapes.ne (show (0 : Fin 9) ≠ 7 by decide)) + (by simpa using! tapes.ne (show (0 : Fin 9) ≠ 8 by decide))] + simpa using! hdecodeSource · change (compareDone.work tapes.value).HasBinaryPrefix entry.2.bits rw [hcompareFrame tapes.value - (by simpa using tapes.ne (show (2 : Fin 9) ≠ 1 by decide)) - (by simpa using tapes.ne (show (2 : Fin 9) ≠ 7 by decide)) - (by simpa using tapes.ne (show (2 : Fin 9) ≠ 8 by decide))] - simpa using hdecodeValue + (by simpa using! tapes.ne (show (2 : Fin 9) ≠ 1 by decide)) + (by simpa using! tapes.ne (show (2 : Fin 9) ≠ 7 by decide)) + (by simpa using! tapes.ne (show (2 : Fin 9) ≠ 8 by decide))] + simpa using! hdecodeValue · change (compareDone.work tapes.value).cells 0 = Γ.start rw [hcompareFrame tapes.value - (by simpa using tapes.ne (show (2 : Fin 9) ≠ 1 by decide)) - (by simpa using tapes.ne (show (2 : Fin 9) ≠ 7 by decide)) - (by simpa using tapes.ne (show (2 : Fin 9) ≠ 8 by decide))] - simpa using hdecodeValueStart + (by simpa using! tapes.ne (show (2 : Fin 9) ≠ 1 by decide)) + (by simpa using! tapes.ne (show (2 : Fin 9) ≠ 7 by decide)) + (by simpa using! tapes.ne (show (2 : Fin 9) ≠ 8 by decide))] + simpa using! hdecodeValueStart · change (compareDone.work tapes.addressCounter).HasBinaryPrefix (List.replicate (bitlen entry.1) true) rw [hcompareFrame tapes.addressCounter - (by simpa using tapes.ne (show (3 : Fin 9) ≠ 1 by decide)) - (by simpa using tapes.ne (show (3 : Fin 9) ≠ 7 by decide)) - (by simpa using tapes.ne (show (3 : Fin 9) ≠ 8 by decide))] - simpa using hdecodeAddressCounter + (by simpa using! tapes.ne (show (3 : Fin 9) ≠ 1 by decide)) + (by simpa using! tapes.ne (show (3 : Fin 9) ≠ 7 by decide)) + (by simpa using! tapes.ne (show (3 : Fin 9) ≠ 8 by decide))] + simpa using! hdecodeAddressCounter · change (compareDone.work tapes.addressWidth).HasBinaryNat 0 rw [hcompareFrame tapes.addressWidth - (by simpa using tapes.ne (show (4 : Fin 9) ≠ 1 by decide)) - (by simpa using tapes.ne (show (4 : Fin 9) ≠ 7 by decide)) - (by simpa using tapes.ne (show (4 : Fin 9) ≠ 8 by decide))] - simpa using hdecodeAddressWidth + (by simpa using! tapes.ne (show (4 : Fin 9) ≠ 1 by decide)) + (by simpa using! tapes.ne (show (4 : Fin 9) ≠ 7 by decide)) + (by simpa using! tapes.ne (show (4 : Fin 9) ≠ 8 by decide))] + simpa using! hdecodeAddressWidth · change (compareDone.work tapes.valueCounter).HasBinaryPrefix (List.replicate (bitlen entry.2) true) rw [hcompareFrame tapes.valueCounter - (by simpa using tapes.ne (show (5 : Fin 9) ≠ 1 by decide)) - (by simpa using tapes.ne (show (5 : Fin 9) ≠ 7 by decide)) - (by simpa using tapes.ne (show (5 : Fin 9) ≠ 8 by decide))] - simpa using hdecodeValueCounter + (by simpa using! tapes.ne (show (5 : Fin 9) ≠ 1 by decide)) + (by simpa using! tapes.ne (show (5 : Fin 9) ≠ 7 by decide)) + (by simpa using! tapes.ne (show (5 : Fin 9) ≠ 8 by decide))] + simpa using! hdecodeValueCounter · change (compareDone.work tapes.valueWidth).HasBinaryNat 0 rw [hcompareFrame tapes.valueWidth - (by simpa using tapes.ne (show (6 : Fin 9) ≠ 1 by decide)) - (by simpa using tapes.ne (show (6 : Fin 9) ≠ 7 by decide)) - (by simpa using tapes.ne (show (6 : Fin 9) ≠ 8 by decide))] - simpa using hdecodeValueWidth + (by simpa using! tapes.ne (show (6 : Fin 9) ≠ 1 by decide)) + (by simpa using! tapes.ne (show (6 : Fin 9) ≠ 7 by decide)) + (by simpa using! tapes.ne (show (6 : Fin 9) ≠ 8 by decide))] + simpa using! hdecodeValueWidth · intro i his hia hiv hiac hiaw hivc hivw hiq hir change compareDone.work i = work₀ i rw [hcompareFrame i hia hiq hir, - hdecodeFrame i (by simpa using his) (by simpa using hia) - (by simpa using hiv) (by simpa using hiac) (by simpa using hivc)] + hdecodeFrame i (by simpa using! his) (by simpa using! hia) + (by simpa using! hiv) (by simpa using! hiac) (by simpa using! hivc)] theorem entryMatchReadTM_reachesIn_frame_internal {n : ℕ} (tapes : EntryMatchTapes n) (entry : Entry) (rest queryBits : List Bool) @@ -411,7 +411,7 @@ theorem entryMatchReadTM_reachesIn_frame_internal {n : ℕ} obtain ⟨rewindDone, rewindTime, hrewindTime, hrewindReach, hrewindHalt, hrewindInput, hrewindResult, hrewindFrame, hrewindOutput⟩ := wordTargetRewind_reachesIn_frame tapes.result resultBits matchDone.input - matchDone.work matchDone.output (by simpa [resultBits] using hmatchResult) + matchDone.work matchDone.output (by simpa [resultBits] using! hmatchResult) hmatchResultStart (by rw [hmatchInput]; exact hinput.read_ne_start) (fun i _ => ⟨(hmatchParked i).read_ne_start, (hmatchParked i).1⟩) @@ -435,9 +435,9 @@ theorem entryMatchReadTM_reachesIn_frame_internal {n : ℕ} work := fun i => TM.transitionTape (matchDone.work i) output := TM.transitionTape matchDone.output } rewindDone := by rw [htransitionInput, htransitionWork, htransitionOutput] - simpa [rewindTM] using hrewindReach + simpa [rewindTM] using! hrewindReach have hfullReach := TM.seqTM_reachesIn_of_reachesIn matchTM rewindTM - (by simpa [matchTM] using hmatchReach) hmatchHalt hrewindReach' + (by simpa [matchTM] using! hmatchReach) hmatchHalt hrewindReach' let finalCfg := TM.phase2Wrap matchTM rewindTM rewindDone have hresultStartFinal : (finalCfg.work tapes.result).cells 0 = Γ.start := TM.work_cells_zero_eq_start_of_reachesIn @@ -452,7 +452,7 @@ theorem entryMatchReadTM_reachesIn_frame_internal {n : ℕ} · rw [hrewindFrame i hir] exact hmatchParked i have hrewindTimeFour : rewindTime ≤ 4 := by - simpa [resultBits] using hrewindTime + simpa [resultBits] using! hrewindTime have hfullTime : matchTime + 1 + rewindTime ≤ entryMatchReadTime entry queryBits := by simp only [entryMatchReadTime] @@ -465,45 +465,45 @@ theorem entryMatchReadTM_reachesIn_frame_internal {n : ℕ} ReadableEntryMatch tapes entry rest queryBits work₀ finalCfg.work := by constructor · rw [hpreserve tapes.source - (by simpa using tapes.ne (show (0 : Fin 9) ≠ 8 by decide))] + (by simpa using! tapes.ne (show (0 : Fin 9) ≠ 8 by decide))] exact hmatchSource · rw [hpreserve tapes.address - (by simpa using tapes.ne (show (1 : Fin 9) ≠ 8 by decide))] + (by simpa using! tapes.ne (show (1 : Fin 9) ≠ 8 by decide))] exact hmatchAddress · rw [hpreserve tapes.address - (by simpa using tapes.ne (show (1 : Fin 9) ≠ 8 by decide))] + (by simpa using! tapes.ne (show (1 : Fin 9) ≠ 8 by decide))] exact hmatchAddressStart · rw [hpreserve tapes.value - (by simpa using tapes.ne (show (2 : Fin 9) ≠ 8 by decide))] + (by simpa using! tapes.ne (show (2 : Fin 9) ≠ 8 by decide))] exact hmatchValue · rw [hpreserve tapes.value - (by simpa using tapes.ne (show (2 : Fin 9) ≠ 8 by decide))] + (by simpa using! tapes.ne (show (2 : Fin 9) ≠ 8 by decide))] exact hmatchValueStart · rw [hpreserve tapes.addressCounter - (by simpa using tapes.ne (show (3 : Fin 9) ≠ 8 by decide))] + (by simpa using! tapes.ne (show (3 : Fin 9) ≠ 8 by decide))] exact hmatchAddressCounter · rw [hpreserve tapes.addressCounter - (by simpa using tapes.ne (show (3 : Fin 9) ≠ 8 by decide))] + (by simpa using! tapes.ne (show (3 : Fin 9) ≠ 8 by decide))] exact hmatchAddressCounterStart · rw [hpreserve tapes.addressWidth - (by simpa using tapes.ne (show (4 : Fin 9) ≠ 8 by decide))] + (by simpa using! tapes.ne (show (4 : Fin 9) ≠ 8 by decide))] exact hmatchAddressWidth · rw [hpreserve tapes.valueCounter - (by simpa using tapes.ne (show (5 : Fin 9) ≠ 8 by decide))] + (by simpa using! tapes.ne (show (5 : Fin 9) ≠ 8 by decide))] exact hmatchValueCounter · rw [hpreserve tapes.valueCounter - (by simpa using tapes.ne (show (5 : Fin 9) ≠ 8 by decide))] + (by simpa using! tapes.ne (show (5 : Fin 9) ≠ 8 by decide))] exact hmatchValueCounterStart · rw [hpreserve tapes.valueWidth - (by simpa using tapes.ne (show (6 : Fin 9) ≠ 8 by decide))] + (by simpa using! tapes.ne (show (6 : Fin 9) ≠ 8 by decide))] exact hmatchValueWidth · rw [hpreserve tapes.query - (by simpa using tapes.ne (show (7 : Fin 9) ≠ 8 by decide))] + (by simpa using! tapes.ne (show (7 : Fin 9) ≠ 8 by decide))] exact hmatchQuery · rw [hpreserve tapes.query - (by simpa using tapes.ne (show (7 : Fin 9) ≠ 8 by decide))] + (by simpa using! tapes.ne (show (7 : Fin 9) ≠ 8 by decide))] exact hmatchQueryStart - · simpa [resultBits] using hrewindResult + · simpa [resultBits] using! hrewindResult · exact hresultStartFinal · exact hfinalParked · intro i @@ -511,7 +511,7 @@ theorem entryMatchReadTM_reachesIn_frame_internal {n : ℕ} hfullReach i have hhead' := le_trans hhead (Nat.add_le_add_left hfullTime (work₀ i).head) - simpa [finalCfg] using hhead' + simpa [finalCfg] using! hhead' · intro i his hia hiv hiac hiaw hivc hivw hiq hir rw [hpreserve i hir] exact hmatchFrame i his hia hiv hiac hiaw hivc hivw hiq hir @@ -519,7 +519,7 @@ theorem entryMatchReadTM_reachesIn_frame_internal {n : ℕ} hrewindInput.trans hmatchInput, hreadable, hrewindOutput.trans hmatchOutput⟩ · exact hfullTime - · simpa [entryMatchReadTM, matchTM, rewindTM, finalCfg] using hfullReach + · simpa [entryMatchReadTM, matchTM, rewindTM, finalCfg] using! hfullReach · exact (TM.phase2Wrap_halted_iff matchTM rewindTM rewindDone).2 hrewindHalt diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryMissCopy/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryMissCopy/Internal.lean index 6211d45bfa..3b23a1bc12 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryMissCopy/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryMissCopy/Internal.lean @@ -81,10 +81,10 @@ private theorem readableEntryMatch_rebase_after_copy have hsourceNeValue : tapes.source ≠ tapes.value := tapes.ne (by decide) have haddressContent : (copiedWork tapes.address).HasBinaryContent entry.1.bits := by - simpa only [Tape.HasBinaryContent, haddressCells] using hmatch.address + simpa only [Tape.HasBinaryContent, haddressCells] using! hmatch.address have hvalueContent : (copiedWork tapes.value).HasBinaryContent entry.2.bits := by - simpa only [Tape.HasBinaryContent, hvalueCells] using hmatch.value.2 + simpa only [Tape.HasBinaryContent, hvalueCells] using! hmatch.value.2 constructor · rw [hframe tapes.source hsourceNeAddress hsourceNeValue] exact hmatch.source @@ -171,10 +171,10 @@ theorem entryMissCopyTM_hoareTime_frame_internal hencode inp₀ matchedWork out₀ ⟨rfl, rfl, rfl⟩ have hencodedWork : encoded.work = copiedWork := by apply entryMissCopiedWork_eq tapes entry matchedWork encoded.work - · simpa using haddressCells - · simpa using haddressHead - · simpa using hvalueCells - · simpa using hvalueHead + · simpa using! haddressCells + · simpa using! haddressHead + · simpa using! hvalueCells + · simpa using! hvalueHead · intro i hia hiv exact hencodedFrame i hia hiv have hmatchSelf : @@ -183,13 +183,13 @@ theorem entryMissCopyTM_hoareTime_frame_internal ReadableEntryMatch tapes entry rest queryBits encoded.work encoded.work := readableEntryMatch_rebase_after_copy tapes entry rest queryBits initialWork matchedWork encoded.work hmatch - (by simpa using haddressSuffix) (by simpa using haddressCells) - (by simpa using hvalueSuffix) - (by simpa using hvalueCells) (by simpa using hvalueHead) + (by simpa using! haddressSuffix) (by simpa using! haddressCells) + (by simpa using! hvalueSuffix) + (by simpa using! hvalueCells) (by simpa using! hvalueHead) (by intro i hia hiv exact hencodedFrame i hia hiv) - simpa [hencodedWork] using hmatchCopied + simpa [hencodedWork] using! hmatchCopied have hencodedInputParked : TM.Parked encoded.input := by rw [hencodedInput] exact hinput @@ -201,7 +201,7 @@ theorem entryMissCopyTM_hoareTime_frame_internal parked_of_binaryPrefix hencodedOutput have hcleanup := entryMissCleanupTM_hoareTime_frame tapes entry rest queryBits copiedWork copiedWork encoded.input encoded.output hmatchSelf - (by simpa [hencodedInput] using hinput) hencodedOutputParked + (by simpa [hencodedInput] using! hinput) hencodedOutputParked obtain ⟨cleaned, cleanupTime, hcleanupTime, hcleanupReach, hcleanupHalt, hcleanedInput, hready, hcleanedOutput⟩ := hcleanup encoded.input copiedWork encoded.output ⟨rfl, rfl, rfl⟩ @@ -220,7 +220,7 @@ theorem entryMissCopyTM_hoareTime_frame_internal output := TM.transitionTape encoded.output } cleaned := by simpa only [hinputTransition, hworkTransition', houtputTransition] - using hcleanupReach + using! hcleanupReach have hreach := TM.seqTM_reachesIn_of_reachesIn (rewindEntryEncodeTM tapes.encodeTapes) (entryMissCleanupTM tapes) hencodeReach hencodeHalt hcleanupReach' @@ -236,8 +236,8 @@ theorem entryMissCopyTM_hoareTime_frame_internal omega · change (entryMissCopyTM tapes).halted finalCfg unfold entryMissCopyTM - rw [TM.phase2Wrap_halted_iff] - exact hcleanupHalt + exact (TM.phase2Wrap_halted_iff (rewindEntryEncodeTM tapes.encodeTapes) + (entryMissCleanupTM tapes) cleaned).mpr hcleanupHalt · have hreadyGlobal : EntryScanReady tapes rest queryBits initialWork cleaned.work := by refine ⟨hready.source, hready.address, hready.addressStart, @@ -255,7 +255,7 @@ theorem entryMissCopyTM_hoareTime_frame_internal haddressCounter haddressWidth hvalueCounter hvalueWidth hquery hresult)) refine ⟨?_, hreadyGlobal, ?_⟩ - · simpa [finalCfg] using hcleanedInput.trans hencodedInput + · simpa [finalCfg] using! hcleanedInput.trans hencodedInput · change cleaned.output.HasBinaryPrefix (emitted ++ Entry.encode entry) rw [hcleanedOutput] exact hencodedOutput diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryReplace/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryReplace/Internal.lean index d93c5a9588..bad7dc0f04 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryReplace/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryReplace/Internal.lean @@ -48,7 +48,7 @@ private theorem readableEntryMatch_rebase_after_address_emit ReadableEntryMatch tapes.entry entry rest queryBits readyWork readyWork := by have haddressContent : (readyWork tapes.entry.address).HasBinaryContent entry.1.bits := by - simpa only [Tape.HasBinaryContent, haddressCells] using hmatch.address + simpa only [Tape.HasBinaryContent, haddressCells] using! hmatch.address constructor · rw [hframe tapes.entry.source (tapes.entry.ne (by decide))] exact hmatch.source @@ -143,7 +143,7 @@ theorem entryReplaceCleanupTM_hoareTime_frame_internal (matchedWork tapes.replacement).head ≤ 1 := by rw [hreplacement.2.1] exact ⟨le_rfl, le_rfl⟩ - simpa using hhead) + simpa using! hhead) hinput (fun i _ _ => hmatch.parked i) houtput obtain ⟨encoded, encodeTime, hencodeTime, hencodeReach, hencodeHalt, hencodedInput, haddressSuffix, haddressCells, haddressHead, @@ -169,19 +169,19 @@ theorem entryReplaceCleanupTM_hoareTime_frame_internal (encoded.work tapes.replacement).HasBinaryContent newValue.bits := by have hcells : (encoded.work tapes.replacement).cells = (matchedWork tapes.replacement).cells := by - simpa using hreplacementCells - simpa only [Tape.HasBinaryContent, hcells] using + simpa using! hreplacementCells + simpa only [Tape.HasBinaryContent, hcells] using! hreplacement.2.hasBinaryContent have hreplacementStart : (encoded.work tapes.replacement).cells 0 = Γ.start := by have hcells : (encoded.work tapes.replacement).cells = (matchedWork tapes.replacement).cells := by - simpa using hreplacementCells + simpa using! hreplacementCells rw [hcells] exact hreplacement.1 have hreplacementHead' : (encoded.work tapes.replacement).head = newValue.bits.length + 1 := by - simpa using hreplacementHead + simpa using! hreplacementHead have hrewind := TM.rewindBinaryWorkTM_hoareTime_frame tapes.replacement newValue.bits (newValue.bits.length + 1) encoded.input encoded.work encoded.output hreplacementContent hreplacementStart @@ -202,10 +202,10 @@ theorem entryReplaceCleanupTM_hoareTime_frame_internal apply entryReplaceReadyWork_eq tapes entry matchedWork rewound.work · rw [hrewoundFrame tapes.entry.address (Ne.symm (tapes.replacement_ne 1))] - simpa using haddressCells + simpa using! haddressCells · rw [hrewoundFrame tapes.entry.address (Ne.symm (tapes.replacement_ne 1))] - simpa using haddressHead + simpa using! haddressHead · intro i hia by_cases hir : i = tapes.replacement · subst i @@ -218,18 +218,18 @@ theorem entryReplaceCleanupTM_hoareTime_frame_internal (by rw [hrewoundFrame tapes.entry.address (Ne.symm (tapes.replacement_ne 1))] - simpa using haddressSuffix) + simpa using! haddressSuffix) (by rw [hrewoundFrame tapes.entry.address (Ne.symm (tapes.replacement_ne 1))] - simpa using haddressCells) + simpa using! haddressCells) (by intro i hia by_cases hir : i = tapes.replacement · subst i exact hreplacementRestored · exact (hrewoundFrame i hir).trans (hencodedFrame i hia hir)) - simpa [hreadyWorkEq] using hmatchReady + simpa [hreadyWorkEq] using! hmatchReady have hrewoundInputParked : TM.Parked rewound.input := by rw [hrewoundInput, hencodedInput] exact hinput @@ -262,7 +262,7 @@ theorem entryReplaceCleanupTM_hoareTime_frame_internal output := TM.transitionTape rewound.output } cleaned := by simpa only [hrewindInputTransition, hrewindWorkTransition', - hrewindOutputTransition] using hcleanupReach + hrewindOutputTransition] using! hcleanupReach have htailReach := TM.seqTM_reachesIn_of_reachesIn (TM.rewindWorkTM tapes.replacement) (entryMissCleanupTM tapes.entry) hrewindReach hrewindHalt hcleanupReach' @@ -290,7 +290,7 @@ theorem entryReplaceCleanupTM_hoareTime_frame_internal output := TM.transitionTape encoded.output } tailFinal := by simpa only [hencodedInputTransition, hencodedWorkTransition, - hencodedOutputTransition] using htailReach + hencodedOutputTransition] using! htailReach have hreach := TM.seqTM_reachesIn_of_reachesIn (rewindEntryEncodeTM tapes.encodeTapes) (TM.seqTM (TM.rewindWorkTM tapes.replacement) @@ -310,8 +310,9 @@ theorem entryReplaceCleanupTM_hoareTime_frame_internal omega · change (entryReplaceCleanupTM tapes).halted finalCfg unfold entryReplaceCleanupTM - rw [TM.phase2Wrap_halted_iff] - exact htailHalt + exact (TM.phase2Wrap_halted_iff (rewindEntryEncodeTM tapes.encodeTapes) + (TM.seqTM (TM.rewindWorkTM tapes.replacement) + (entryMissCleanupTM tapes.entry)) tailFinal).mpr htailHalt · have hreadyGlobal : EntryScanReady tapes.entry rest queryBits initialWork cleaned.work := by refine ⟨hready.source, hready.address, hready.addressStart, diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Init/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Init/Internal.lean index eebc05b4e6..b0fb514d8a 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Init/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Init/Internal.lean @@ -52,7 +52,7 @@ private theorem programBinaryPrefixTape_parked (bits : List Bool) : private theorem binaryTape_parked (bits : List Bool) : TM.Parked (programBinaryTape bits) := by have hstring : (programBinaryTape bits).HasBinaryString bits := by - simpa only [programBinaryTape] using + simpa only [programBinaryTape] using! Tape.init_move_right_hasBinaryString bits exact ⟨by rw [hstring.1], hstring.hasBinaryContent.cells_ne_start⟩ @@ -127,19 +127,19 @@ theorem initialLoopWork_ready_internal have hvalue := Tape.init_move_right_hasBinaryNat 1 have hcount := Tape.init_move_right_hasBinaryNat count have hblankNat : TM.resetBinaryBlank.HasBinaryNat 0 := by - simpa [TM.resetBinaryBlank] using Tape.init_move_right_hasBinaryNat 0 + simpa [TM.resetBinaryBlank] using! Tape.init_move_right_hasBinaryNat 0 have hblankParked : TM.Parked TM.resetBinaryBlank := ⟨by rw [hblankNat.2.1], hblankNat.2.hasBinaryContent.cells_ne_start⟩ refine { address := by rw [initialLoopWork_lhs] - simpa only [programBinaryTape] using haddress + simpa only [programBinaryTape] using! haddress value := by rw [initialLoopWork_rhs] - simpa only [programBinaryTape] using hvalue + simpa only [programBinaryTape] using! hvalue count := by rw [initialLoopWork_count] - simpa only [programBinaryTape] using hcount + simpa only [programBinaryTape] using! hcount buffer := by rw [initialLoopWork_buffer] exact programBinaryPrefixTape_hasBinaryPrefix _ @@ -415,8 +415,8 @@ private theorem copyWorkToWorkTM_exact_hoareTime subst out refine ⟨?_, ?_, hinput.read_ne_start, houtput.read_ne_start, houtput.1, ?_, rfl, rfl, ?_⟩ - · simpa only [programBinaryTape] using hsrc - · simpa [TM.resetBinaryBlank] using hdst + · simpa only [programBinaryTape] using! hsrc + · simpa [TM.resetBinaryBlank] using! hdst · intro i _ _ exact ⟨(hwork i).read_ne_start, (hwork i).1⟩ · intro i _ _ @@ -426,11 +426,11 @@ private theorem copyWorkToWorkTM_exact_hoareTime hinp, hout, hframe⟩ have hsrcEq : work src = programBinaryPrefixTape bits := by apply Tape.ext - · simpa [programBinaryPrefixTape] using hsrcHead - · simpa [programBinaryPrefixTape] using hsrcCells + · simpa [programBinaryPrefixTape] using! hsrcHead + · simpa [programBinaryPrefixTape] using! hsrcCells have hdstEq : work dst = programBinaryPrefixTape bits := by apply Tape.ext - · simpa [programBinaryPrefixTape] using hdstPrefix.1 + · simpa [programBinaryPrefixTape] using! hdstPrefix.1 · rw [programBinaryPrefixTape] exact hdstPrefix.cells_eq_init hdstStart refine ⟨hinp, ?_, hout⟩ @@ -480,7 +480,7 @@ private theorem eq_programBinaryPrefixTape_of_hasBinaryPrefix (hstart : t.cells 0 = Γ.start) : t = programBinaryPrefixTape bits := by apply Tape.ext - · simpa [programBinaryPrefixTape] using hprefix.1 + · simpa [programBinaryPrefixTape] using! hprefix.1 · rw [programBinaryPrefixTape] exact hprefix.cells_eq_init hstart @@ -607,7 +607,7 @@ private theorem initialAbiFinalWork_eq_programSnapshotWork have hcountEq : work₀ tapes.lifted.data.update.remaining = programBinaryTape store.length.bits := by - simpa only [programBinaryTape] using hready.count.eq_init_move_right + simpa only [programBinaryTape] using! hready.count.eq_init_move_right funext i by_cases hlhs : i = tapes.liftedLhs · subst i @@ -748,10 +748,10 @@ theorem initialOneBitTM_hoareTime_internal obtain ⟨emitted, emitTime, hemitTime, hemitReach, hemitHalt, hemitPost, hemitOutput⟩ := hlift inp₀ work₀ out₀ - ⟨⟨rfl, rfl, rfl⟩, by simpa [TM.resetBinaryBlank] using houtput⟩ + ⟨⟨rfl, rfl, rfl⟩, by simpa [TM.resetBinaryBlank] using! houtput⟩ rcases hemitPost with ⟨hemitInput, hemitBaseWork, hemitBuffer⟩ have hemitOutput' : emitted.output = out₀ := by - exact hemitOutput.trans (by simpa [TM.resetBinaryBlank] using houtput.symm) + exact hemitOutput.trans (by simpa [TM.resetBinaryBlank] using! houtput.symm) have hemitFrame (i : Fin (n + 1)) (hi : i ≠ tapes.buffer) : emitted.work i = work₀ i := by have hil : i.val < n := by @@ -760,7 +760,7 @@ theorem initialOneBitTM_hoareTime_internal intro hval apply hi apply Fin.ext - simpa [ControlInstructionTapes.buffer] using hval + simpa [ControlInstructionTapes.buffer] using! hval omega let j : Fin n := ⟨i.val, hil⟩ have hij : i = Fin.castSucc j := by @@ -775,7 +775,7 @@ theorem initialOneBitTM_hoareTime_internal rw [hemitOutput'] rw [houtput] have hblankNat : TM.resetBinaryBlank.HasBinaryNat 0 := by - simpa [TM.resetBinaryBlank] using Tape.init_move_right_hasBinaryNat 0 + simpa [TM.resetBinaryBlank] using! Tape.init_move_right_hasBinaryNat 0 exact parked_of_binaryNat hblankNat have hemitWorkParked : ∀ i, TM.Parked (emitted.work i) := by intro i @@ -853,7 +853,7 @@ theorem initialOneBitTM_hoareTime_internal output := TM.transitionTape counted.output } advanced := by simpa only [hcountInputTransition, hcountWorkTransition, - hcountOutputTransition] using haddressReach + hcountOutputTransition] using! haddressReach have htailReach := TM.seqTM_reachesIn_of_reachesIn (TM.binarySuccTM tapes.lifted.data.update.remaining) (TM.binarySuccTM tapes.liftedLhs) hcountReach hcountHalt haddressReach' @@ -883,7 +883,7 @@ theorem initialOneBitTM_hoareTime_internal output := TM.transitionTape emitted.output } tailFinal := by simpa only [hemitInputTransition, hemitWorkTransition, - hemitOutputTransition] using htailReach + hemitOutputTransition] using! htailReach have hreach := TM.seqTM_reachesIn_of_reachesIn (rewindEntryEncodeRestoreTM (initialBitEntryTapes tapes)).retargetOutput (TM.seqTM (TM.binarySuccTM tapes.lifted.data.update.remaining) @@ -898,8 +898,9 @@ theorem initialOneBitTM_hoareTime_internal · omega · change (initialOneBitTM tapes).halted finalCfg unfold initialOneBitTM - rw [TM.phase2Wrap_halted_iff] - exact htailHalt + exact (TM.phase2Wrap_halted_iff (rewindEntryEncodeRestoreTM (initialBitEntryTapes tapes)).retargetOutput + (TM.seqTM (TM.binarySuccTM tapes.lifted.data.update.remaining) + (TM.binarySuccTM tapes.liftedLhs)) tailFinal).mpr htailHalt · refine ⟨?_, ?_, ?_⟩ · change advanced.input = inp₀ exact haddressInput.trans (hcountInput.trans hemitInput) @@ -924,7 +925,7 @@ theorem initialOneBitTM_hoareTime_internal ((entries ++ [(address, 1)]).flatMap Entry.encode) rw [haddressFrame _ hlhsBuffer.symm, hcountFrame _ hremainingBuffer.symm] - simpa [List.flatMap_append] using hemitBuffer + simpa [List.flatMap_append] using! hemitBuffer · intro i change TM.Parked (advanced.work i) by_cases hi : i = tapes.liftedLhs @@ -981,11 +982,11 @@ theorem initialInputLoopTM_hoareTime_internal (by rw [houtput] have hblankNat : TM.resetBinaryBlank.HasBinaryNat 0 := by - simpa [TM.resetBinaryBlank] using + simpa [TM.resetBinaryBlank] using! Tape.init_move_right_hasBinaryNat 0 exact (parked_of_binaryNat hblankNat).read_ne_start) refine ⟨done, 1, by simp [initialInputLoopTime], - .step (by simpa [done] using hstep) .zero, ?_, ?_⟩ + .step (by simpa [done] using! hstep) .zero, ?_, ?_⟩ · change done.state = (initialInputLoopTM tapes).qhalt rfl · exact ⟨hinput, by simpa [inputTrueCount, inputBitStoreFrom], rfl⟩ @@ -1004,7 +1005,7 @@ theorem initialInputLoopTM_hoareTime_internal have houtputParked : TM.Parked out₀ := by rw [houtput] have hblankNat : TM.resetBinaryBlank.HasBinaryNat 0 := by - simpa [TM.resetBinaryBlank] using Tape.init_move_right_hasBinaryNat 0 + simpa [TM.resetBinaryBlank] using! Tape.init_move_right_hasBinaryNat 0 exact parked_of_binaryNat hblankNat cases bit with | false => @@ -1015,13 +1016,13 @@ theorem initialInputLoopTM_hoareTime_internal work := work₀ output := out₀ } have hread : inp₀.read = Γ.zero := by - simpa [Γ.ofBool] using hinput.read_cons + simpa [Γ.ofBool] using! hinput.read_cons have hscanStep := initialInputLoopTM_step_scan_zero tapes scan rfl hread (fun i => (hready.parked i).read_ne_start) houtputParked.read_ne_start have hscanReach : (initialInputLoopTM tapes).reachesIn 1 scan (initialInputZeroWrap tapes bodyStart) := - .step (by simpa [scan, bodyStart, initialInputZeroWrap] using + .step (by simpa [scan, bodyStart, initialInputZeroWrap] using! hscanStep) .zero have hbody := initialZeroBitTM_hoareTime_internal tapes address count entries inp₀ work₀ out₀ hready hinputParked @@ -1041,7 +1042,7 @@ theorem initialInputLoopTM_hoareTime_internal (by rw [hbodyOutput]; exact houtputParked.read_ne_start) have hseamReach : (initialInputLoopTM tapes).reachesIn 1 (initialInputZeroWrap tapes bodyDone) nextScan := - .step (by simpa [nextScan] using hseamStep) .zero + .step (by simpa [nextScan] using! hseamStep) .zero have hnextInput : (bodyDone.input.move Dir3.right).HasBinarySuffix rest := by rw [hbodyInput] @@ -1063,10 +1064,10 @@ theorem initialInputLoopTM_hoareTime_internal · simp only [initialInputLoopTime, Bool.false_eq_true, ite_false, Nat.add_zero] omega - · simpa [Nat.add_assoc] using hreach + · simpa [Nat.add_assoc] using! hreach · refine ⟨htailInput, ?_, htailOutput.trans hbodyOutput⟩ simpa [inputTrueCount, inputBitStoreFrom, Nat.add_assoc, - Nat.add_comm, Nat.add_left_comm] using htailReady + Nat.add_comm, Nat.add_left_comm] using! htailReady | true => let bodyStart : Complexity.Cfg (n + 1) (initialOneBitTM tapes).Q := @@ -1075,13 +1076,13 @@ theorem initialInputLoopTM_hoareTime_internal work := work₀ output := out₀ } have hread : inp₀.read = Γ.one := by - simpa [Γ.ofBool] using hinput.read_cons + simpa [Γ.ofBool] using! hinput.read_cons have hscanStep := initialInputLoopTM_step_scan_one tapes scan rfl hread (fun i => (hready.parked i).read_ne_start) houtputParked.read_ne_start have hscanReach : (initialInputLoopTM tapes).reachesIn 1 scan (initialInputOneWrap tapes bodyStart) := - .step (by simpa [scan, bodyStart, initialInputOneWrap] using + .step (by simpa [scan, bodyStart, initialInputOneWrap] using! hscanStep) .zero have hbody := initialOneBitTM_hoareTime_internal tapes address count entries inp₀ work₀ out₀ hready hinputParked houtput @@ -1100,7 +1101,7 @@ theorem initialInputLoopTM_hoareTime_internal (by rw [hbodyOutput]; exact houtputParked.read_ne_start) have hseamReach : (initialInputLoopTM tapes).reachesIn 1 (initialInputOneWrap tapes bodyDone) nextScan := - .step (by simpa [nextScan] using hseamStep) .zero + .step (by simpa [nextScan] using! hseamStep) .zero have hnextInput : (bodyDone.input.move Dir3.right).HasBinarySuffix rest := by rw [hbodyInput] @@ -1122,10 +1123,10 @@ theorem initialInputLoopTM_hoareTime_internal htailHalt, ?_⟩ · simp only [initialInputLoopTime, if_true] omega - · simpa [Nat.add_assoc] using hreach + · simpa [Nat.add_assoc] using! hreach · refine ⟨htailInput, ?_, htailOutput.trans hbodyOutput⟩ simpa [inputTrueCount, inputBitStoreFrom, List.append_assoc, - Nat.add_assoc, Nat.add_comm, Nat.add_left_comm] using htailReady + Nat.add_assoc, Nat.add_comm, Nat.add_left_comm] using! htailReady /-- The setup phase turns the standard all-heads-on-marker configuration into the exact address-one/count-zero streaming boundary. -/ @@ -1174,19 +1175,19 @@ theorem initialSetupTM_hoareTime_internal output := Tape.init [] } skipped := .step hskipStep .zero have hblankNat : TM.resetBinaryBlank.HasBinaryNat 0 := by - simpa [TM.resetBinaryBlank] using Tape.init_move_right_hasBinaryNat 0 + simpa [TM.resetBinaryBlank] using! Tape.init_move_right_hasBinaryNat 0 have hblankParked : TM.Parked TM.resetBinaryBlank := parked_of_binaryNat hblankNat have hparkedInput : TM.Parked parkedInput := parked_of_binarySuffix (by - simpa only [parkedInput] using Tape.init_move_right_hasBinarySuffix input) + simpa only [parkedInput] using! Tape.init_move_right_hasBinarySuffix input) have hlhsRun := TM.binarySuccTM_hoareTime_frame tapes.liftedLhs 0 skipped.input skipped.work skipped.output - (by simpa [skipped, parkedWork] using hblankNat) - (by simpa [skipped] using hparkedInput.read_ne_start) - (fun i _ => by simpa [skipped, parkedWork] using + (by simpa [skipped, parkedWork] using! hblankNat) + (by simpa [skipped] using! hparkedInput.read_ne_start) + (fun i _ => by simpa [skipped, parkedWork] using! hblankParked.read_ne_start) - (by simpa [skipped] using hblankParked.read_ne_start) + (by simpa [skipped] using! hblankParked.read_ne_start) obtain ⟨lhsDone, lhsTime, hlhsTime, hlhsReach, hlhsHalt, hlhsInput, hlhsFrame, hlhsValue, hlhsOutput⟩ := hlhsRun skipped.input skipped.work skipped.output ⟨rfl, rfl, rfl⟩ @@ -1195,20 +1196,20 @@ theorem initialSetupTM_hoareTime_internal have hrhsZero : (lhsDone.work tapes.lifted.data.rhs).HasBinaryNat 0 := by rw [hlhsFrame _ hlhsRhs.symm] - simpa [skipped, parkedWork] using hblankNat + simpa [skipped, parkedWork] using! hblankNat have hlhsInputParked : TM.Parked lhsDone.input := by rw [hlhsInput] - simpa [skipped] using hparkedInput + simpa [skipped] using! hparkedInput have hlhsOutputParked : TM.Parked lhsDone.output := by rw [hlhsOutput] - simpa [skipped] using hblankParked + simpa [skipped] using! hblankParked have hlhsWorkParked : ∀ i, TM.Parked (lhsDone.work i) := by intro i by_cases hi : i = tapes.liftedLhs · subst i exact parked_of_binaryNat hlhsValue · rw [hlhsFrame i hi] - simpa [skipped, parkedWork] using hblankParked + simpa [skipped, parkedWork] using! hblankParked have hrhsRun := TM.binarySuccTM_hoareTime_frame tapes.lifted.data.rhs 0 lhsDone.input lhsDone.work lhsDone.output hrhsZero hlhsInputParked.read_ne_start @@ -1231,7 +1232,7 @@ theorem initialSetupTM_hoareTime_internal output := TM.transitionTape lhsDone.output } rhsDone := by simpa only [hlhsInputTransition, hlhsWorkTransition, - hlhsOutputTransition] using hrhsReach + hlhsOutputTransition] using! hrhsReach have htailReach := TM.seqTM_reachesIn_of_reachesIn (TM.binarySuccTM tapes.liftedLhs) (TM.binarySuccTM tapes.lifted.data.rhs) @@ -1241,8 +1242,8 @@ theorem initialSetupTM_hoareTime_internal have htailHalt : (TM.seqTM (TM.binarySuccTM tapes.liftedLhs) (TM.binarySuccTM tapes.lifted.data.rhs)).halted tailDone := by - rw [TM.phase2Wrap_halted_iff] - exact hrhsHalt + exact (TM.phase2Wrap_halted_iff (TM.binarySuccTM tapes.liftedLhs) + (TM.binarySuccTM tapes.lifted.data.rhs) rhsDone).mpr hrhsHalt obtain ⟨hskipInputTransition, hskipWorkTransition, hskipOutputTransition⟩ := TM.phaseTransition_eq_self_of_reads_ne_start @@ -1250,13 +1251,13 @@ theorem initialSetupTM_hoareTime_internal hblankParked.read_ne_start have hskipInputTransition' : TM.transitionInput skipped.input = skipped.input := by - simpa [skipped] using hskipInputTransition + simpa [skipped] using! hskipInputTransition have hskipWorkTransition' : (fun i => TM.transitionTape (skipped.work i)) = skipped.work := by - simpa [skipped] using hskipWorkTransition + simpa [skipped] using! hskipWorkTransition have hskipOutputTransition' : TM.transitionTape skipped.output = skipped.output := by - simpa [skipped] using hskipOutputTransition + simpa [skipped] using! hskipOutputTransition have htailReach' : (TM.seqTM (TM.binarySuccTM tapes.liftedLhs) (TM.binarySuccTM tapes.lifted.data.rhs)).reachesIn @@ -1268,7 +1269,7 @@ theorem initialSetupTM_hoareTime_internal output := TM.transitionTape skipped.output } tailDone := by simpa only [hskipInputTransition', hskipWorkTransition', - hskipOutputTransition'] using htailReach + hskipOutputTransition'] using! htailReach have hreach := TM.seqTM_reachesIn_of_reachesIn (TM.skipTM (n := n + 1)) (TM.seqTM (TM.binarySuccTM tapes.liftedLhs) @@ -1279,7 +1280,7 @@ theorem initialSetupTM_hoareTime_internal (TM.binarySuccTM tapes.lifted.data.rhs)) tailDone have hrhsInputSuffix : rhsDone.input.HasBinarySuffix input := by rw [hrhsInput, hlhsInput] - simpa [skipped, parkedInput] using Tape.init_move_right_hasBinarySuffix input + simpa [skipped, parkedInput] using! Tape.init_move_right_hasBinarySuffix input have hrhsOutputBlank : rhsDone.output = TM.resetBinaryBlank := by exact hrhsOutput.trans (hlhsOutput.trans (by rfl)) have hrhsWorkParked : ∀ i, TM.Parked (rhsDone.work i) := by @@ -1298,8 +1299,9 @@ theorem initialSetupTM_hoareTime_internal · omega · change (initialSetupTM tapes).halted finalCfg unfold initialSetupTM - rw [TM.phase2Wrap_halted_iff] - exact htailHalt + exact (TM.phase2Wrap_halted_iff (TM.skipTM (n := n + 1)) + (TM.seqTM (TM.binarySuccTM tapes.liftedLhs) + (TM.binarySuccTM tapes.lifted.data.rhs)) tailDone).mpr htailHalt · refine ⟨?_, ?_, ?_, ?_⟩ · change rhsDone.input.HasBinarySuffix input exact hrhsInputSuffix @@ -1315,21 +1317,21 @@ theorem initialSetupTM_hoareTime_internal frame := ?_ } · change (rhsDone.work tapes.liftedLhs).HasBinaryNat 1 rw [hrhsFrame _ hlhsRhs] - simpa using hlhsValue + simpa using! hlhsValue · change (rhsDone.work tapes.lifted.data.rhs).HasBinaryNat 1 - simpa using hrhsValue + simpa using! hrhsValue · change (rhsDone.work tapes.lifted.data.update.remaining).HasBinaryNat 0 rw [hrhsFrame _ hrhsRemaining, hlhsFrame _ hlhsRemaining] - simpa [skipped, parkedWork] using hblankNat + simpa [skipped, parkedWork] using! hblankNat · change (rhsDone.work tapes.buffer).HasBinaryPrefix [] rw [hrhsFrame _ (tapes.liftedData_ne_buffer 14).symm, hlhsFrame _ (tapes.liftedData_ne_buffer 13).symm] have hblankString : TM.resetBinaryBlank.HasBinaryString [] := hblankNat.2 - simpa [skipped, parkedWork] using + simpa [skipped, parkedWork] using! (show TM.resetBinaryBlank.HasBinaryPrefix [] from - ⟨by simpa using hblankString.1, hblankString.2⟩) + ⟨by simpa using! hblankString.1, hblankString.2⟩) · intro i change TM.Parked (rhsDone.work i) exact hrhsWorkParked i @@ -1369,7 +1371,7 @@ theorem initialLengthEmitTM_hoareTime_internal have hqueryBuffer : tapes.lifted.data.update.entry.query ≠ tapes.buffer := tapes.liftedData_ne_buffer 7 have hblankNat : TM.resetBinaryBlank.HasBinaryNat 0 := by - simpa [TM.resetBinaryBlank] using Tape.init_move_right_hasBinaryNat 0 + simpa [TM.resetBinaryBlank] using! Tape.init_move_right_hasBinaryNat 0 have hqueryZero : (work₀ tapes.lifted.data.update.entry.query).HasBinaryNat 0 := by rw [hready.frame _ hqueryLhs hqueryRhs hqueryCount hqueryBuffer] @@ -1389,9 +1391,9 @@ theorem initialLengthEmitTM_hoareTime_internal obtain ⟨emitted, emitTime, hemitTime, hemitReach, hemitHalt, hemitInput, hemitFrame, hemitBuffer, hemitOutput⟩ := hemit inp₀ work₀ out₀ - ⟨rfl, rfl, by simpa [TM.resetBinaryBlank] using houtput⟩ + ⟨rfl, rfl, by simpa [TM.resetBinaryBlank] using! houtput⟩ have hemitOutput' : emitted.output = out₀ := by - exact hemitOutput.trans (by simpa [TM.resetBinaryBlank] using houtput.symm) + exact hemitOutput.trans (by simpa [TM.resetBinaryBlank] using! houtput.symm) have hemitInputParked : TM.Parked emitted.input := by rw [hemitInput] exact hinput @@ -1436,7 +1438,7 @@ theorem initialLengthEmitTM_hoareTime_internal output := TM.transitionTape emitted.output } counted := by simpa only [hemitInputTransition, hemitWorkTransition, - hemitOutputTransition] using hcountReach + hemitOutputTransition] using! hcountReach have hreach := TM.seqTM_reachesIn_of_reachesIn (rewindEntryEncodeRestoreTM (initialLengthEntryTapes tapes)).retargetOutput @@ -1464,8 +1466,9 @@ theorem initialLengthEmitTM_hoareTime_internal refine ⟨finalCfg, emitTime + 1 + countTime, by omega, hreach, ?_, ?_⟩ · change (initialLengthEmitTM tapes).halted finalCfg unfold initialLengthEmitTM - rw [TM.phase2Wrap_halted_iff] - exact hcountHalt + exact (TM.phase2Wrap_halted_iff (rewindEntryEncodeRestoreTM + (initialLengthEntryTapes tapes)).retargetOutput + (TM.binarySuccTM tapes.lifted.data.update.remaining) counted).mpr hcountHalt · refine ⟨?_, ?_, ?_⟩ · change counted.input = inp₀ exact hcountInput.trans hemitInput @@ -1485,7 +1488,7 @@ theorem initialLengthEmitTM_hoareTime_internal · change (counted.work tapes.buffer).HasBinaryPrefix ((entries ++ [(0, length)]).flatMap Entry.encode) rw [hcountFrame _ hcountBuffer.symm] - simpa [List.flatMap_append] using hemitBuffer + simpa [List.flatMap_append] using! hemitBuffer · intro i change TM.Parked (counted.work i) exact hcountWorkParked i @@ -1525,7 +1528,7 @@ theorem initialLengthTM_hoareTime_internal hready.parked (by rw [houtput] have hblankNat : TM.resetBinaryBlank.HasBinaryNat 0 := by - simpa [TM.resetBinaryBlank] using Tape.init_move_right_hasBinaryNat 0 + simpa [TM.resetBinaryBlank] using! Tape.init_move_right_hasBinaryNat 0 exact parked_of_binaryNat hblankNat) obtain ⟨skipDone, skipTime, hskipTime, hskipReach, hskipHalt, hskipInput, hskipWork, hskipOutput⟩ := @@ -1538,7 +1541,7 @@ theorem initialLengthTM_hoareTime_internal (by rw [houtput] have hblankNat : TM.resetBinaryBlank.HasBinaryNat 0 := by - simpa [TM.resetBinaryBlank] using Tape.init_move_right_hasBinaryNat 0 + simpa [TM.resetBinaryBlank] using! Tape.init_move_right_hasBinaryNat 0 exact (parked_of_binaryNat hblankNat).read_ne_start) hskipReach hskipHalt refine ⟨done, skipTime + 1, ?_, hreach, hhalt, ?_⟩ @@ -1546,7 +1549,7 @@ theorem initialLengthTM_hoareTime_internal omega · refine ⟨?_, ?_, ?_⟩ · exact hdoneInput.trans hskipInput - · simpa [hdoneWork, hskipWork] using hready + · simpa [hdoneWork, hskipWork] using! hready · exact hdoneOutput.trans (hskipOutput.trans rfl) · have hnonblank : (work₀ tapes.liftedLhs).read ≠ Γ.blank := by intro hblank @@ -1564,7 +1567,7 @@ theorem initialLengthTM_hoareTime_internal (by rw [houtput] have hblankNat : TM.resetBinaryBlank.HasBinaryNat 0 := by - simpa [TM.resetBinaryBlank] using Tape.init_move_right_hasBinaryNat 0 + simpa [TM.resetBinaryBlank] using! Tape.init_move_right_hasBinaryNat 0 exact (parked_of_binaryNat hblankNat).read_ne_start) hemitReach hemitHalt refine ⟨done, emitTime + 1, ?_, hreach, hhalt, ?_⟩ @@ -1572,7 +1575,7 @@ theorem initialLengthTM_hoareTime_internal omega · refine ⟨?_, ?_, ?_⟩ · exact hdoneInput.trans hemitInput - · simpa [hlength, hdoneWork] using hemitReady + · simpa [hlength, hdoneWork] using! hemitReady · exact hdoneOutput.trans hemitOutput /-- Restore the post-loop address and install the optional length entry. -/ @@ -1602,7 +1605,7 @@ theorem initialLengthInstallTM_hoareTime_internal (by rw [houtput] have hblankNat : TM.resetBinaryBlank.HasBinaryNat 0 := by - simpa [TM.resetBinaryBlank] using Tape.init_move_right_hasBinaryNat 0 + simpa [TM.resetBinaryBlank] using! Tape.init_move_right_hasBinaryNat 0 exact (parked_of_binaryNat hblankNat).read_ne_start) obtain ⟨predDone, predTime, hpredTime, hpredReach, hpredHalt, hpredInput, hpredFrame, hpredValue, hpredOutput⟩ := @@ -1615,7 +1618,7 @@ theorem initialLengthInstallTM_hoareTime_internal have hpredOutputParked : TM.Parked predDone.output := by rw [hpredOutputBlank] have hblankNat : TM.resetBinaryBlank.HasBinaryNat 0 := by - simpa [TM.resetBinaryBlank] using Tape.init_move_right_hasBinaryNat 0 + simpa [TM.resetBinaryBlank] using! Tape.init_move_right_hasBinaryNat 0 exact parked_of_binaryNat hblankNat have hpredWorkParked : ∀ i, TM.Parked (predDone.work i) := by intro i @@ -1665,7 +1668,7 @@ theorem initialLengthInstallTM_hoareTime_internal output := TM.transitionTape predDone.output } lengthDone := by simpa only [hpredInputTransition, hpredWorkTransition, - hpredOutputTransition] using hlengthReach + hpredOutputTransition] using! hlengthReach have hreach := TM.seqTM_reachesIn_of_reachesIn (TM.binaryPredTM tapes.liftedLhs) (initialLengthTM tapes) hpredReach hpredHalt hlengthReach' @@ -1674,8 +1677,8 @@ theorem initialLengthInstallTM_hoareTime_internal refine ⟨finalCfg, predTime + 1 + lengthTime, by omega, hreach, ?_, ?_⟩ · change (initialLengthInstallTM tapes).halted finalCfg unfold initialLengthInstallTM - rw [TM.phase2Wrap_halted_iff] - exact hlengthHalt + exact (TM.phase2Wrap_halted_iff (TM.binaryPredTM tapes.liftedLhs) + (initialLengthTM tapes) lengthDone).mpr hlengthHalt · refine ⟨?_, ?_, ?_⟩ · change lengthDone.input = inp₀ exact hlengthInput.trans hpredInput @@ -1710,7 +1713,7 @@ theorem initialAbiInstallTM_hoareTime_internal let W₅ := initialAbiBufferResetWork tapes W₄ let W₆ := initialAbiFinalWork tapes W₅ have hblankNat : TM.resetBinaryBlank.HasBinaryNat 0 := by - simpa [TM.resetBinaryBlank] using Tape.init_move_right_hasBinaryNat 0 + simpa [TM.resetBinaryBlank] using! Tape.init_move_right_hasBinaryNat 0 have houtputParked : TM.Parked out₀ := by rw [houtput] exact parked_of_binaryNat hblankNat @@ -1765,7 +1768,7 @@ theorem initialAbiInstallTM_hoareTime_internal tapes.buffer := tapes.liftedData_ne_buffer 9 have hcountEq : work₀ tapes.lifted.data.update.remaining = programBinaryTape store.length.bits := by - simpa only [programBinaryTape] using hready.count.eq_init_move_right + simpa only [programBinaryTape] using! hready.count.eq_init_move_right have hbufferEq : work₀ tapes.buffer = programBinaryPrefixTape storeBits := by exact eq_programBinaryPrefixTape_of_hasBinaryPrefix hready.buffer hbufferStart @@ -1793,7 +1796,7 @@ theorem initialAbiInstallTM_hoareTime_internal (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) (fun inp work out => inp = inp₀ ∧ work = W₁ ∧ out = out₀) (TM.binaryCopyTime store.length 0) := by - simpa only [W₁, initialAbiCountWork] using hcopy + simpa only [W₁, initialAbiCountWork] using! hcopy have hW₁Parked : ∀ i, TM.Parked (W₁ i) := by exact parked_update hready.parked (binaryTape_parked store.length.bits) have hW₁Buffer : W₁ tapes.buffer = programBinaryPrefixTape storeBits := by @@ -1804,7 +1807,7 @@ theorem initialAbiInstallTM_hoareTime_internal (fun inp work out => inp = inp₀ ∧ work = W₁ ∧ out = out₀) (fun inp work out => inp = inp₀ ∧ work = W₂ ∧ out = out₀) (storeBits.length + 1 + 2) := by - simpa only [W₂, initialAbiBufferWork] using hrewindBuffer + simpa only [W₂, initialAbiBufferWork] using! hrewindBuffer have hW₂Parked : ∀ i, TM.Parked (W₂ i) := by exact parked_update hW₁Parked (binaryTape_parked storeBits) have hW₂Buffer : W₂ tapes.buffer = programBinaryTape storeBits := by @@ -1822,7 +1825,7 @@ theorem initialAbiInstallTM_hoareTime_internal (fun inp work out => inp = inp₀ ∧ work = W₂ ∧ out = out₀) (fun inp work out => inp = inp₀ ∧ work = W₃ ∧ out = out₀) (storeBits.length + 1) := by - simpa only [W₃, initialAbiCopiedWork] using hcopyStore + simpa only [W₃, initialAbiCopiedWork] using! hcopyStore have hprefixParked : TM.Parked (programBinaryPrefixTape storeBits) := programBinaryPrefixTape_parked storeBits have hW₃Parked : ∀ i, TM.Parked (W₃ i) := by @@ -1838,7 +1841,7 @@ theorem initialAbiInstallTM_hoareTime_internal (fun inp work out => inp = inp₀ ∧ work = W₃ ∧ out = out₀) (fun inp work out => inp = inp₀ ∧ work = W₄ ∧ out = out₀) (storeBits.length + 1 + 2) := by - simpa only [W₄, initialAbiSourceWork] using hrewindSource + simpa only [W₄, initialAbiSourceWork] using! hrewindSource have hW₄Parked : ∀ i, TM.Parked (W₄ i) := by exact parked_update hW₃Parked (binaryTape_parked storeBits) have hW₄Buffer : @@ -1857,7 +1860,7 @@ theorem initialAbiInstallTM_hoareTime_internal (fun inp work out => inp = inp₀ ∧ work = W₅ ∧ out = out₀) (TM.resetBinaryWorkTime (storeBits.length + 1) storeBits.length) := by simpa only [W₅, initialAbiBufferResetWork, TM.resetBinaryBlank] - using hresetBuffer + using! hresetBuffer have hW₅Parked : ∀ i, TM.Parked (W₅ i) := by exact parked_update hW₄Parked (parked_of_binaryNat hblankNat) have hW₅Lhs : W₅ tapes.liftedLhs = work₀ tapes.liftedLhs := by @@ -1877,9 +1880,9 @@ theorem initialAbiInstallTM_hoareTime_internal simp [initialCleanupTargets] at hi rcases hi with rfl | rfl · rw [hW₅Lhs] - simpa [initialCleanupBits] using hready.address.2.hasBinaryContent + simpa [initialCleanupBits] using! hready.address.2.hasBinaryContent · rw [hW₅Rhs] - simpa [initialCleanupBits, hlhsRhs.symm] using + simpa [initialCleanupBits, hlhsRhs.symm] using! hready.value.2.hasBinaryContent have htargetsStart : ∀ i, i ∈ initialCleanupTargets tapes → (W₅ i).cells 0 = Γ.start := by @@ -1907,7 +1910,7 @@ theorem initialAbiInstallTM_hoareTime_internal (fun inp work out => inp = inp₀ ∧ work = W₆ ∧ out = out₀) (TM.resetBinaryWorkManyTime (initialCleanupBits tapes length) (fun _ => 1) (initialCleanupTargets tapes)) := by - simpa only [W₆, initialAbiFinalWork] using hresetMany + simpa only [W₆, initialAbiFinalWork] using! hresetMany have htail₅ := TM.seqTM_hoareTime (TM.resetBinaryWorkTM tapes.buffer) (TM.resetBinaryWorkManyTM (initialCleanupTargets tapes)) @@ -1999,7 +2002,7 @@ private theorem inputBitStoreFrom_addressesNodup have hlower := inputBitStoreFrom_address_lower hentry change entry.1 = start at heq omega - · simpa [inputBitStoreFrom, hbit] using ih (start + 1) + · simpa [inputBitStoreFrom, hbit] using! ih (start + 1) private theorem inputBitStoreFrom_valuesNonzero (start : ℕ) (input : List Bool) : @@ -2014,7 +2017,7 @@ private theorem inputBitStoreFrom_valuesNonzero rcases hentry with rfl | hentry · exact Nat.one_ne_zero · exact ih (start + 1) entry hentry - · simpa [inputBitStoreFrom, hbit] using ih (start + 1) + · simpa [inputBitStoreFrom, hbit] using! ih (start + 1) private theorem zero_not_mem_inputBitStoreFrom_addresses (input : List Bool) : @@ -2169,7 +2172,7 @@ theorem programInitTM_hoareTime_internal have hsetupOutputParked : TM.Parked setupDone.output := by rw [hsetupOutput] have hblankNat : TM.resetBinaryBlank.HasBinaryNat 0 := by - simpa [TM.resetBinaryBlank] using Tape.init_move_right_hasBinaryNat 0 + simpa [TM.resetBinaryBlank] using! Tape.init_move_right_hasBinaryNat 0 exact parked_of_binaryNat hblankNat have hloop := initialInputLoopTM_hoareTime_internal tapes input 1 0 [] setupDone.input setupDone.work setupDone.output hsetupInput hsetupReady @@ -2183,7 +2186,7 @@ theorem programInitTM_hoareTime_internal hsetupBufferStart have hloopReady : InitialLoopReady tapes (input.length + 1) (inputTrueCount input) (inputBitStoreFrom 1 input) loopDone.work := by - simpa [Nat.add_comm] using hloopReadyRaw + simpa [Nat.add_comm] using! hloopReadyRaw have hloopInputParked : TM.Parked loopDone.input := parked_of_binarySuffix hloopInput have hloopOutputBlank : loopDone.output = TM.resetBinaryBlank := @@ -2191,7 +2194,7 @@ theorem programInitTM_hoareTime_internal have hloopOutputParked : TM.Parked loopDone.output := by rw [hloopOutputBlank] have hblankNat : TM.resetBinaryBlank.HasBinaryNat 0 := by - simpa [TM.resetBinaryBlank] using Tape.init_move_right_hasBinaryNat 0 + simpa [TM.resetBinaryBlank] using! Tape.init_move_right_hasBinaryNat 0 exact parked_of_binaryNat hblankNat have hlength := initialLengthInstallTM_hoareTime_internal tapes input.length (inputTrueCount input) (inputBitStoreFrom 1 input) @@ -2218,7 +2221,7 @@ theorem programInitTM_hoareTime_internal have hlengthOutputParked : TM.Parked lengthDone.output := by rw [hlengthOutputBlank] have hblankNat : TM.resetBinaryBlank.HasBinaryNat 0 := by - simpa [TM.resetBinaryBlank] using Tape.init_move_right_hasBinaryNat 0 + simpa [TM.resetBinaryBlank] using! Tape.init_move_right_hasBinaryNat 0 exact parked_of_binaryNat hblankNat have habi := initialAbiInstallTM_hoareTime_internal tapes (programInitialStore input) input.length lengthDone.input @@ -2240,7 +2243,7 @@ theorem programInitTM_hoareTime_internal output := TM.transitionTape lengthDone.output } abiDone := by simpa only [hlengthInputTransition, hlengthWorkTransition, - hlengthOutputTransition] using habiReach + hlengthOutputTransition] using! habiReach have hfinalizeReach := TM.seqTM_reachesIn_of_reachesIn (initialLengthInstallTM tapes) (initialAbiInstallTM tapes) hlengthReach hlengthHalt habiReach' @@ -2248,8 +2251,8 @@ theorem programInitTM_hoareTime_internal (initialAbiInstallTM tapes) abiDone have hfinalizeHalt : (initialFinalizeTM tapes).halted finalizeDone := by unfold initialFinalizeTM - rw [TM.phase2Wrap_halted_iff] - exact habiHalt + exact (TM.phase2Wrap_halted_iff (initialLengthInstallTM tapes) + (initialAbiInstallTM tapes) abiDone).mpr habiHalt have hloopInputTransition : TM.transitionInput loopDone.input = loopDone.input := TM.transitionInput_eq_self hloopInputParked.read_ne_start @@ -2268,7 +2271,7 @@ theorem programInitTM_hoareTime_internal output := TM.transitionTape loopDone.output } finalizeDone := by simpa only [hloopInputTransition, hloopWorkTransition, - hloopOutputTransition] using hfinalizeReach + hloopOutputTransition] using! hfinalizeReach have hloopTailReach := TM.seqTM_reachesIn_of_reachesIn (initialInputLoopTM tapes) (initialFinalizeTM tapes) hloopReach hloopHalt hfinalizeReach' @@ -2277,8 +2280,8 @@ theorem programInitTM_hoareTime_internal have hloopTailHalt : (TM.seqTM (initialInputLoopTM tapes) (initialFinalizeTM tapes)).halted loopTailDone := by - rw [TM.phase2Wrap_halted_iff] - exact hfinalizeHalt + exact (TM.phase2Wrap_halted_iff (initialInputLoopTM tapes) + (initialFinalizeTM tapes) finalizeDone).mpr hfinalizeHalt have hsetupInputTransition : TM.transitionInput setupDone.input = setupDone.input := TM.transitionInput_eq_self hsetupInputParked.read_ne_start @@ -2300,7 +2303,7 @@ theorem programInitTM_hoareTime_internal output := TM.transitionTape setupDone.output } loopTailDone := by simpa only [hsetupInputTransition, hsetupWorkTransition, - hsetupOutputTransition] using hloopTailReach + hsetupOutputTransition] using! hloopTailReach have hreach := TM.seqTM_reachesIn_of_reachesIn (initialSetupTM tapes) (TM.seqTM (initialInputLoopTM tapes) (initialFinalizeTM tapes)) @@ -2315,8 +2318,9 @@ theorem programInitTM_hoareTime_internal omega · change (programInitTM tapes).halted finalCfg unfold programInitTM - rw [TM.phase2Wrap_halted_iff] - exact hloopTailHalt + exact (TM.phase2Wrap_halted_iff (initialSetupTM tapes) + (TM.seqTM (initialInputLoopTM tapes) (initialFinalizeTM tapes)) + loopTailDone).mpr hloopTailHalt · refine ⟨?_, ?_, ?_⟩ · change abiDone.input.HasBinarySuffix [] rw [habiInput, hlengthInput] diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/ABI/Internal/Resources.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/ABI/Internal/Resources.lean index bf45cb1851..2fc0a417c1 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/ABI/Internal/Resources.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/ABI/Internal/Resources.lean @@ -122,7 +122,7 @@ theorem decisionTimeBound_mono_steps_internal (tm : TM n) have hwidth : wordWidth tm (marshalBound n inputLength + steps) ≤ wordWidth tm (marshalBound n inputLength + larger) := by have hsize := Nat.size_le_size hword - simpa [wordWidth, bitlen] using Nat.add_le_add_right hsize 1 + simpa [wordWidth, bitlen] using! Nat.add_le_add_right hsize 1 have hfactor : (steps + 1) * runFactor tm ≤ (larger + 1) * runFactor tm := Nat.mul_le_mul_right _ (Nat.add_le_add_right hle 1) @@ -249,7 +249,7 @@ theorem marshalConstants_measured_internal (tm : TM n) (x : List Bool) : have hfinal := hmeasured.2 exact ⟨hfinal.index_lt, hfinal.value_le, fun index _ => le_trans (hfinal.value_le index) hbaseWord⟩ - simpa [marshalStart] using And.intro hmeasured.1 + simpa [marshalStart] using! And.intro hmeasured.1 (And.intro hmarshal (marshalStart_invariant_internal n x)) private theorem marshalLoopOps_envelopeChain (n : ℕ) (x : List Bool) @@ -521,15 +521,15 @@ private theorem marshalLoop_measured_aux (n : ℕ) (x : List Bool) (registerBound n (marshalBound n x.length + 1)) (marshalBound n x.length) store := by have hp : processed = x.length := by omega - simpa [marshalBound, hp] using henvelope + simpa [marshalBound, hp] using! henvelope have hrun := Structured.Internal.MeasuredRuns.whileZeroEnvelope (body := .basics (marshalLoopOps n)) hzero hglobal refine ⟨store, ?_, hinvariant, ?_⟩ · simpa [marshalLoop, marshalLoopSteps, marshalLoopTimeBound, marshalWidth, marshalSpaceBound, Structured.Internal.valueWidth, - Structured.Internal.envelopeSpace] using hrun - · simpa using henvelope + Structured.Internal.envelopeSpace] using! hrun + · simpa using! henvelope | succ cursor ih => have hpositive : 0 < cursor + 1 := by omega have hnonzero : store stateReg ≠ 0 := by @@ -549,12 +549,12 @@ private theorem marshalLoop_measured_aux (n : ℕ) (x : List Bool) have hmiddleInvariant : MarshalInvariant n x cursor middle := by have hstep := marshalLoopOps_invariant_internal n x (cursor + 1) store hpositive hinvariant - simpa [middle] using hstep + simpa [middle] using! hstep have hmiddleEnvelope : Structured.Internal.StoreEnvelope (registerBound n (marshalBound n x.length + 1)) (marshalBaseBound n x.length + (processed + 1)) middle := by have hfinal := hchain.final - simpa [middle, Nat.add_assoc] using hfinal + simpa [middle, Nat.add_assoc] using! hfinal obtain ⟨final, hloop, hfinalInvariant, hfinalEnvelope⟩ := ih (processed := processed + 1) (store := middle) (by omega) hmiddleInvariant hmiddleEnvelope @@ -565,11 +565,11 @@ private theorem marshalLoop_measured_aux (n : ℕ) (x : List Bool) have hrun := Structured.Internal.MeasuredRuns.whileNonzeroEnvelope hnonzero hinitialGlobal hbody hloop refine ⟨final, ?_, hfinalInvariant, ?_⟩ - · convert hrun using 1 + · convert! hrun using 1 all_goals simp [marshalLoopSteps, marshalWidth, Structured.Internal.valueWidth, Nat.succ_mul] all_goals ring - · convert hfinalEnvelope using 1 + · convert! hfinalEnvelope using 1 omega /-- The backward-copy loop has an exact source-step count, linear logarithmic @@ -587,11 +587,11 @@ theorem marshalLoop_measured_internal {tm : TM n} (x : List Bool) : marshalLoop_measured_aux n x (processed := 0) (store := marshalStart n x) (by simp) hinvariant hmarshal.storeEnvelope refine ⟨final, ?_, hfinalInvariant, ?_⟩ - · simpa using hrun + · simpa using! hrun · apply hfinalEnvelope.mono le_rfl (show marshalBaseBound n x.length + 0 + x.length ≤ wordBound tm (marshalBound n x.length) by - simpa [marshalBound] using + simpa [marshalBound] using! (marshalValue_le_wordBound tm (processed := x.length) le_rfl)) /-- The verdict extractor stays in the core envelope and has the standard @@ -619,7 +619,7 @@ theorem extractVerdict_measured_internal {tm : TM n} {bound : ℕ} apply henvelope.execBasic · exact lt_trans hrange.2.2.2.2.1.2 (control_lt_registerBound n bound) - · simpa [Structured.Internal.Basic.writeValue] using haddressValue + · simpa [Structured.Internal.Basic.writeValue] using! haddressValue have hloaded : StepEnvelope tm bound loaded := by apply haddressed.execBasic · simp [stateReg, registerBound, cellReg, outputTape, cellBase] @@ -629,7 +629,7 @@ theorem extractVerdict_measured_internal {tm : TM n} {bound : ℕ} have honed : StepEnvelope tm bound oned := by apply hloaded.execBasic · exact lt_trans hrange.2.1.2 (control_lt_registerBound n bound) - · simpa [Structured.Internal.Basic.writeValue] using honeBound + · simpa [Structured.Internal.Basic.writeValue] using! honeBound have hfinal : StepEnvelope tm bound final := by apply honed.execBasic · simp [stateReg, registerBound, cellReg, outputTape, cellBase] @@ -637,7 +637,7 @@ theorem extractVerdict_measured_internal {tm : TM n} {bound : ℕ} have hchain : Structured.Internal.Basic.EnvelopeChain (registerBound n (bound + 1)) (wordBound tm bound) (extractVerdictOps n) store := by - simpa [extractVerdictOps, addressed, loaded, oned, final] using + simpa [extractVerdictOps, addressed, loaded, oned, final] using! And.intro henvelope (And.intro haddressed (And.intro hloaded (And.intro honed hfinal))) have hmeasured := Structured.Internal.MeasuredRuns.basicsEnvelopeChain @@ -645,9 +645,9 @@ theorem extractVerdict_measured_internal {tm : TM n} {bound : ℕ} have hverdict := extractVerdict_exec_internal hrepresents refine ⟨?_, hfinal, ?_⟩ · simpa [wordWidth, spaceBound, Structured.Internal.valueWidth, - Structured.Internal.envelopeSpace] using hmeasured.1 + Structured.Internal.envelopeSpace] using! hmeasured.1 · obtain ⟨_cost, _space, _hexec, hvalue⟩ := hverdict - simpa [final] using hvalue + simpa [final] using! hvalue private theorem repairBit_measured_internal {tm : TM n} {bound valueLimit : ℕ} {entry : ℕ × ℕ} {store : Structured.Store} @@ -675,20 +675,20 @@ private theorem repairBit_measured_internal {tm : TM n} {bound valueLimit : ℕ} (control_lt_registerBound n bound) · exact henvelope.index_lt index (by simpa [addressed, Structured.Basic.exec, - Function.update_of_ne heq] using hnonzero) + Function.update_of_ne heq] using! hnonzero) · intro index by_cases heq : index = addressReg n · subst index - simpa [addressed, Structured.Basic.exec] using + simpa [addressed, Structured.Basic.exec] using! le_trans haddressBound hwordLimit · simpa [addressed, Structured.Basic.exec, - Function.update_of_ne heq] using henvelope.value_le index + Function.update_of_ne heq] using! henvelope.value_le index · intro index hne by_cases heq : index = addressReg n · subst index - simpa [addressed, Structured.Basic.exec] using haddressBound + simpa [addressed, Structured.Basic.exec] using! haddressBound · simpa [addressed, Structured.Basic.exec, - Function.update_of_ne heq] using henvelope.value_le_of_ne index hne + Function.update_of_ne heq] using! henvelope.value_le_of_ne index hne have haddressedStore := haddressedMarshal.storeEnvelope have haddress : addressed (addressReg n) = cellReg n (inputTape n) entry.1 := by @@ -706,7 +706,7 @@ private theorem repairBit_measured_internal {tm : TM n} {bound valueLimit : ℕ} (control_lt_registerBound n bound) · exact haddressedMarshal.index_lt index (by simpa [loaded, Structured.Basic.exec, - Function.update_of_ne heq] using hnonzero) + Function.update_of_ne heq] using! hnonzero) · intro index by_cases heq : index = valueReg n · subst index @@ -714,7 +714,7 @@ private theorem repairBit_measured_internal {tm : TM n} {bound valueLimit : ℕ} exact haddressedMarshal.value_le_of_ne (addressed (addressReg n)) haddressNeValue · simpa [loaded, Structured.Basic.exec, - Function.update_of_ne heq] using + Function.update_of_ne heq] using! haddressedMarshal.value_le_of_ne index heq have hloadedLarge := hloadedEnvelope.mono le_rfl hwordLimit have hsetupChain : Structured.Internal.Basic.EnvelopeChain @@ -742,7 +742,7 @@ private theorem repairBit_measured_internal {tm : TM n} {bound valueLimit : ℕ} rw [ite_eq_left hzero] refine ⟨3, ?_, ?_⟩ · rw [hrepairStore] - simpa [repairBit] using hrun' + simpa [repairBit] using! hrun' · rw [hrepairStore] exact hloadedEnvelope · let valued := (Structured.Basic.imm (valueReg n) (entry.2 + 1)).exec loaded @@ -754,7 +754,7 @@ private theorem repairBit_measured_internal {tm : TM n} {bound valueLimit : ℕ} apply hloadedEnvelope.execBasic · exact lt_trans hrange.2.2.2.2.2.1.2 (control_lt_registerBound n bound) - · simpa [Structured.Internal.Basic.writeValue] using hsmall + · simpa [Structured.Internal.Basic.writeValue] using! hsmall have hvaluedAddress : valued (addressReg n) = cellReg n (inputTape n) entry.1 := by simp [valued, loaded, addressed, Structured.Basic.exec, addressReg, @@ -796,7 +796,7 @@ private theorem repairBit_measured_internal {tm : TM n} {bound valueLimit : ℕ} rfl refine ⟨6, ?_, ?_⟩ · rw [hrepairStore] - simpa [repairBit] using hrun' + simpa [repairBit] using! hrun' · rw [hrepairStore] exact hfinal @@ -817,7 +817,7 @@ private theorem repairCaptured_fromStep_measured {tm : TM n} | nil => have hskip := Structured.Internal.MeasuredRuns.skipEnvelope (henvelope.mono le_rfl hwordLimit) - exact ⟨store, 0, by simpa [repairCaptured] using hskip, rfl, henvelope⟩ + exact ⟨store, 0, by simpa [repairCaptured] using! hskip, rfl, henvelope⟩ | cons entry rest ih => have hentry := hentries entry (by simp) obtain ⟨firstSteps, hfirst, hfirstEnvelope⟩ := @@ -829,10 +829,10 @@ private theorem repairCaptured_fromStep_measured {tm : TM n} intro candidate hmem exact hentries candidate (by simp [hmem]) obtain ⟨final, restSteps, hrest, hrestStore, hfinalEnvelope⟩ := - ih hrestEntries (by simpa [first] using hfirstEnvelope) + ih hrestEntries (by simpa [first] using! hfirstEnvelope) have hrun := hfirst.seq hrest refine ⟨final, firstSteps + restSteps, ?_, ?_, hfinalEnvelope⟩ - · convert hrun using 1 + · convert! hrun using 1 simp only [List.length_cons] ring · simp [repairStore] at hrestStore ⊢ @@ -863,7 +863,7 @@ theorem repairCaptured_measured_internal {tm : TM n} {bound valueLimit : ℕ} repairCaptured_fromStep_measured rest hrestEntries hfirstEnvelope hwordLimit have hrun := hfirst.seq hrest refine ⟨final, firstSteps + restSteps, ?_, ?_, hfinalEnvelope⟩ - · convert hrun using 1 + · convert! hrun using 1 simp only [List.length_cons] ring · simp [repairStore] at hrestStore ⊢ @@ -886,7 +886,7 @@ private theorem immWrites_envelopeChain {tm : TM n} {bound : ℕ} ((Structured.Basic.imm write.1 write.2).exec store) := by apply henvelope.execBasic · exact hwrite.1 - · simpa [Structured.Internal.Basic.writeValue] using hwrite.2 + · simpa [Structured.Internal.Basic.writeValue] using! hwrite.2 have hrestFits : ∀ candidate, candidate ∈ rest → candidate.1 < registerBound n (bound + 1) ∧ candidate.2 ≤ wordBound tm bound := by @@ -934,9 +934,9 @@ theorem initializeConfigOps_measured_internal {tm : TM n} {bound : ℕ} initializeConfigWrite_fits tm bound hmem) henvelope have hmeasured := Structured.Internal.MeasuredRuns.basicsEnvelopeChain (initializeConfigOps tm) store (by - simpa [initializeConfigOps] using hchain) + simpa [initializeConfigOps] using! hchain) simpa [wordWidth, spaceBound, Structured.Internal.valueWidth, - Structured.Internal.envelopeSpace] using hmeasured + Structured.Internal.envelopeSpace] using! hmeasured private theorem captureValues_eq_reverse_append (store : Structured.Store) (regs : List ℕ) (captured : List (ℕ × ℕ)) : @@ -999,7 +999,7 @@ private theorem marshalSpace_le_spaceBound (tm : TM n) have hvalue := marshalValue_le_wordBound tm (inputLength := inputLength) (processed := inputLength) le_rfl have hsize := Nat.size_le_size (by - simpa [marshalBound] using hvalue) + simpa [marshalBound] using! hvalue) simp only [marshalSpaceBound, spaceBound, bitlen] exact Nat.mul_le_mul_left _ (Nat.add_le_add_left hsize _) @@ -1036,7 +1036,7 @@ theorem marshalLeaf_measured_internal (tm : TM n) (x : List Bool) : ((capturedInput n x).length * (27 * wordWidth tm (marshalBound n x.length))) (spaceBound tm (marshalBound n x.length)) := by - simpa [wordWidth, spaceBound, Structured.Internal.envelopeSpace] using + simpa [wordWidth, spaceBound, Structured.Internal.envelopeSpace] using! hrepair subst repaired let final := Structured.Basic.execList (initializeConfigOps tm) @@ -1050,13 +1050,13 @@ theorem marshalLeaf_measured_internal (tm : TM n) (x : List Bool) : (marshalConstants n).length + (marshalLoopSteps n x.length + (repairSteps + (initializeConfigOps tm).length)), ?_, ?_, ?_⟩ - · convert hrun using 1 + · convert! hrun using 1 simp [marshalLeafTimeBound, marshalBaseWidth, Structured.Internal.valueWidth, capturedInput, captureValues_eq_reverse_append] ring - · simpa [final, initializeStore] using hrepresents - · simpa [final] using hinitializeEnvelope + · simpa [final, initializeStore] using! hrepresents + · simpa [final] using! hinitializeEnvelope private theorem captureInput_measured_of_leaf {tm : TM n} (x : List Bool) (regs : List ℕ) (captured : List (ℕ × ℕ)) @@ -1074,7 +1074,7 @@ private theorem captureInput_measured_of_leaf {tm : TM n} (x : List Bool) (spaceBound tm (marshalBound n x.length)) := by induction regs generalizing captured with | nil => - exact ⟨leafSteps, by simpa [captureInput, captureValues] using hleaf⟩ + exact ⟨leafSteps, by simpa [captureInput, captureValues] using! hleaf⟩ | cons reg rest ih => have hrestBits : ∀ candidate, candidate ∈ rest → initRegs x candidate = 0 ∨ initRegs x candidate = 1 := by @@ -1109,13 +1109,13 @@ private theorem captureInput_measured_of_leaf {tm : TM n} (x : List Bool) wordWidth tm (marshalBound n x.length) + leafCost := by ring) exact ⟨restSteps + 1, by simpa [captureInput, hzero, spaceBound, - Structured.Internal.envelopeSpace] using hweakened⟩ + Structured.Internal.envelopeSpace] using! hweakened⟩ · have hnonzero : initRegs x reg ≠ 0 := by omega have hbranch := Structured.Internal.MeasuredRuns.ifNonzeroEnvelope (onZero := captureInput tm rest ((reg, 0) :: captured)) hnonzero henvelope hrest refine ⟨restSteps + 2, ?_⟩ - convert hbranch using 1 + convert! hbranch using 1 all_goals simp [captureInput, hone, wordWidth, Structured.Internal.valueWidth] all_goals ring @@ -1136,7 +1136,7 @@ theorem marshalInput_measured_internal (tm : TM n) (x : List Bool) : (captureValues (initRegs x) (captureRegs n) [])) (initRegs x) final leafSteps (marshalLeafTimeBound tm x.length) (spaceBound tm (marshalBound n x.length)) := by - simpa [capturedInput] using hleaf + simpa [capturedInput] using! hleaf have hbits : ∀ reg, reg ∈ captureRegs n → initRegs x reg = 0 ∨ initRegs x reg = 1 := by intro reg hmem @@ -1147,7 +1147,7 @@ theorem marshalInput_measured_internal (tm : TM n) (x : List Bool) : (captureRegs n) [] hbits hselected refine ⟨final, steps, ?_, hrepresents, henvelope⟩ simpa [marshalInput, marshalTimeBound, Nat.add_comm, Nat.add_left_comm, - Nat.add_assoc] using hrun + Nat.add_assoc] using! hrun /-- End-to-end public-ABI execution with concrete time and space bounds. -/ theorem decisionProgram_measured_internal {tm : TM n} {steps : ℕ} @@ -1188,7 +1188,7 @@ theorem decisionProgram_measured_internal {tm : TM n} {steps : ℕ} marshalSteps + (runSteps tm steps (tm.initCfg x) + (extractVerdictOps n).length), ?_, hverdict⟩ - convert hrun using 1 + convert! hrun using 1 simp [decisionTimeBound] ring @@ -1215,11 +1215,11 @@ theorem compiledDecision_resourceBound_internal {tm : TM n} {steps : ℕ} have hcompiled := Structured.Exec.compile_correct hexec refine ⟨final, sourceSteps, cost, space, hexec, hcost, hspace, ?_, ?_, ?_, ?_, hverdict⟩ - · simpa [compiledDecision, initCfg] using hcompiled.1 - · simpa [compiledDecision, initCfg] using + · simpa [compiledDecision, initCfg] using! hcompiled.1 + · simpa [compiledDecision, initCfg] using! Structured.Exec.compile_halted hexec - · simpa [compiledDecision, initCfg] using hcompiled.2.1 - · simpa [compiledDecision, initCfg] using hcompiled.2.2 + · simpa [compiledDecision, initCfg] using! hcompiled.2.1 + · simpa [compiledDecision, initCfg] using! hcompiled.2.2 end Sparse diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Composition/Internal/Tail.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Composition/Internal/Tail.lean index 72ce2bd7f4..20ec2df2f5 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Composition/Internal/Tail.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Composition/Internal/Tail.lean @@ -119,7 +119,7 @@ private theorem compositionTailTM_hoareTime_of_virtualRun_internal intro heq apply hiRaw apply Fin.ext - simpa [raw] using heq + simpa [raw] using! heq omega have hiUpper : i.val < nf + 1 + ng := by have hlt := i.isLt @@ -127,7 +127,7 @@ private theorem compositionTailTM_hoareTime_of_virtualRun_internal intro heq apply hiVin apply Fin.ext - simpa [vin] using heq + simpa [vin] using! heq simp only [compositionTapeCount] at hlt omega let j : Fin ng := ⟨i.val - (nf + 1), by omega⟩ @@ -169,8 +169,8 @@ private theorem compositionTailTM_hoareTime_of_virtualRun_internal let source : Tape := { head := 1, cells := (work raw).cells } have hc₁Raw : c₁.work raw = source := Tape.ext hc₁Head hc₁RawCells have hsourceInv : Tape.StartInvariant source := by - exact ⟨by simpa [source] using hrawInv.1, - by intro j hj; simpa [source] using hrawInv.2 j hj⟩ + exact ⟨by simpa [source] using! hrawInv.1, + by intro j hj; simpa [source] using! hrawInv.2 j hj⟩ have hsourceOutput : source.HasOutput y := by exact (Tape.hasOutput_congr (by rfl) y).mpr hrawOutput have hc₁WorkStable : ∀ i, Tape.StartInvariant (c₁.work i) ∧ @@ -456,7 +456,7 @@ private theorem compositionTailTM_hoareTime_of_virtualRun_internal omega have hjlast : j = Fin.last ng := by apply Fin.ext - simpa using hjval + simpa using! hjval have hiVin : i = vin := by rw [← hphys, hjlast] exact (compositionVirtualInputIdx_eq_secondPlacedLast nf ng).symm @@ -518,8 +518,9 @@ private theorem compositionTailTM_hoareTime_of_virtualRun_internal hreachFinal, ?_, ?_⟩ · omega · change (seqTM tm₁ tm₂₃₄).halted cFinal - rw [phase2Wrap_halted_iff, phase2Wrap_halted_iff, phase2Wrap_halted_iff] - exact hhalt₄ + exact (phase2Wrap_halted_iff tm₁ tm₂₃₄ c₂₃₄).mpr + ((phase2Wrap_halted_iff tm₂ tm₃₄ c₃₄).mpr + ((phase2Wrap_halted_iff tm₃ (compositionSecondTM nf tmG) C₄).mpr hhalt₄)) · show P C₄.output exact hout₄ From 963903d085fc904987ce56ba8a13a10f223a5681 Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Tue, 22 Sep 2026 02:15:15 +0000 Subject: [PATCH 12/49] Resolve machine composition and entry-update type aliases --- .../Machine/EntryScan/Internal/Bounds.lean | 2 +- .../Machine/EntryUpdate/Internal/End.lean | 34 +++++++++---------- .../TuringMachine/Composition/Internal.lean | 14 ++++---- 3 files changed, 25 insertions(+), 25 deletions(-) diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryScan/Internal/Bounds.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryScan/Internal/Bounds.lean index 1eac8f1459..fb3510d8f3 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryScan/Internal/Bounds.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryScan/Internal/Bounds.lean @@ -72,7 +72,7 @@ private theorem entryMissCleanupTime_canonical_le_linear {n : ℕ} 7 * (1 + matchTime + 2 * (bitlen entry.1 + bitlen entry.2 + 1) + 9) + 1 := by simpa [entryMissHeadBound, entryScanCanonicalWork, - TM.resetBinaryBlank, Tape.move, Tape.init] using hreset + TM.resetBinaryBlank, Tape.move, Tape.init] using! hreset unfold entryMissCleanupTime entryMissHeadBound entryScanCanonicalWork simp only [Function.const_apply, TM.resetBinaryBlank, Tape.move, Tape.init, Nat.zero_add] diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/End.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/End.lean index febd8243a0..066dde13f5 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/End.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/End.lean @@ -63,7 +63,7 @@ theorem entryUpdateTerminal_internal cases found with | false => have hfoundZero : (work tapes.found).HasBinaryNat 0 := by - simpa using hinv.foundCount + simpa using! hinv.foundCount have hfoundRead : (work tapes.found).read ≠ Γ.one := by rw [hfoundZero.read_eq_blank_iff.mpr rfl] decide @@ -72,7 +72,7 @@ theorem entryUpdateTerminal_internal exact Bool.false_ne_true (hinv.progress.found_iff.mpr hmem) have hnotmemStore : address ∉ store.map Prod.fst := by rw [hinv.progress.store_eq] - simpa using hnotmemProcessed + simpa using! hnotmemProcessed by_cases hvalue : newValue = 0 · subst newValue have hreplacementRead : (work tapes.replacement).read = Γ.blank := @@ -89,11 +89,11 @@ theorem entryUpdateTerminal_internal { ready := hinv.ready replacement := hinv.replacement_eq remaining := hinv.remainingCount - found := by simpa [hnotmemStore] using hfoundZero + found := by simpa [hnotmemStore] using! hfoundZero resultCount := by - simpa [hcountEq] using hinv.resultCountTape + simpa [hcountEq] using! hinv.resultCountTape frame := hinv.frame } - · simpa [houtputEq] using houtput + · simpa [houtputEq] using! houtput · have hreplacementRead : (work tapes.replacement).read ≠ Γ.blank := by intro hblank @@ -181,14 +181,14 @@ theorem entryUpdateTerminal_internal Entry.encode) := by rw [hsuccOutput] rw [← houtputEq] - simpa [List.flatMap_append, List.append_assoc] using + simpa [List.flatMap_append, List.append_assoc] using! happendOutput have hfinalFrame : EntryUpdateFrame tapes initialWork succDone.work := EntryUpdateFrame.trans_single_internal hinv.frame (12 : Fin 13) (by intro i hi exact hotherWork i (by - simpa [EntryUpdateTapes.resultCount] using hi)) + simpa [EntryUpdateTapes.resultCount] using! hi)) have hsuccTimeBound := binarySuccTime_le_entryUpdateCountTime_internal hinv.resultCount_le refine ⟨entryUpdateDoneCfg tapes succDone.input succDone.work @@ -197,7 +197,7 @@ theorem entryUpdateTerminal_internal ?_, htotalReach, rfl, ?_, ?_, ?_⟩ · simp only [entryUpdateLoopTime] omega - · simpa [entryUpdateDoneCfg] using hsuccInput.trans happendInput + · simpa [entryUpdateDoneCfg] using! hsuccInput.trans happendInput · exact { ready := hreadyFinal replacement := by @@ -213,21 +213,21 @@ theorem entryUpdateTerminal_internal change (succDone.work tapes.found).HasBinaryNat (if address ∈ store.map Prod.fst then 1 else 0) rw [hotherWork tapes.found tapes.found_ne_resultCount] - simpa [hnotmemStore] using hfoundZero - resultCount := by simpa [hcountEq] using hsuccCount + simpa [hnotmemStore] using! hfoundZero + resultCount := by simpa [hcountEq] using! hsuccCount frame := hfinalFrame } - · simpa [entryUpdateDoneCfg] using hfinalOutput + · simpa [entryUpdateDoneCfg] using! hfinalOutput | true => have hfoundOne : (work tapes.found).HasBinaryNat 1 := by - simpa using hinv.foundCount + simpa using! hinv.foundCount have hfoundRead : (work tapes.found).read = Γ.one := by - simpa [Nat.bits, Γ.ofBool] using + simpa [Nat.bits, Γ.ofBool] using! hfoundOne.2.hasBinarySuffix.read_cons have hmemProcessed : address ∈ processed.map Prod.fst := hinv.progress.found_iff.mp rfl have hmemStore : address ∈ store.map Prod.fst := by rw [hinv.progress.store_eq] - simpa using hmemProcessed + simpa using! hmemProcessed have hstep := entryUpdateTM_step_test_found_internal tapes inp work out hremainingRead hfoundRead hinput hinv.ready.parked houtputParked obtain ⟨houtputEq, hcountEq⟩ := @@ -239,10 +239,10 @@ theorem entryUpdateTerminal_internal { ready := hinv.ready replacement := hinv.replacement_eq remaining := hinv.remainingCount - found := by simpa [hmemStore] using hfoundOne - resultCount := by simpa [hcountEq] using hinv.resultCountTape + found := by simpa [hmemStore] using! hfoundOne + resultCount := by simpa [hcountEq] using! hinv.resultCountTape frame := hinv.frame } - · simpa [houtputEq] using houtput + · simpa [houtputEq] using! houtput end Machine diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Composition/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Composition/Internal.lean index da309c6fde..b8a9f3b114 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Composition/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Composition/Internal.lean @@ -68,11 +68,11 @@ theorem compositionTM_computesInTime_internal · have hreach := seqTM_reachesIn_of_reachesIn first tail hreachF hhaltF hreachTail simpa [compositionTM, first, tail, final, boundaryInput, boundaryWork, - boundaryOutput] using hreach + boundaryOutput] using! hreach · show (compositionTM tmF tmG).halted final - simpa [compositionTM, first, tail, final] using + simpa [compositionTM, first, tail, final] using! (phase2Wrap_halted_iff first tail D).2 hhaltTail - · simpa [final, phase2Wrap, Function.comp_apply] using houtTail + · simpa [final, phase2Wrap, Function.comp_apply] using! houtTail /-- Internal correctness theorem for deterministic preprocessing followed by a language decider. -/ @@ -116,14 +116,14 @@ theorem compositionTM_decidesInTime_preimage_internal · have hreach := seqTM_reachesIn_of_reachesIn first tail hreachF hhaltF hreachTail simpa [compositionTM, first, tail, final, boundaryInput, boundaryWork, - boundaryOutput] using hreach + boundaryOutput] using! hreach · show (compositionTM tmF tmG).halted final - simpa [compositionTM, first, tail, final] using + simpa [compositionTM, first, tail, final] using! (phase2Wrap_halted_iff first tail D).2 hhaltTail · intro hx - simpa [final, phase2Wrap] using hyesTail hx + simpa [final, phase2Wrap] using! hyesTail hx · intro hx - simpa [final, phase2Wrap] using hnoTail hx + simpa [final, phase2Wrap] using! hnoTail hx end TM From 503be745c10fa1afa5485d4db1068fcb407a3dde Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Tue, 22 Sep 2026 02:17:42 +0000 Subject: [PATCH 13/49] Port Cobham closure and register instruction simulation proofs --- .../Classes/P/Cobham/Internal.lean | 56 ++++++------- .../Machine/Instruction/DenseControl.lean | 46 +++++------ .../Machine/Instruction/Immediate.lean | 64 +++++++-------- .../Machine/Instruction/Internal.lean | 44 +++++------ .../Machine/Instruction/Load.lean | 78 +++++++++---------- 5 files changed, 144 insertions(+), 144 deletions(-) diff --git a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal.lean index 535ba3a35a..aebf6302d7 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal.lean @@ -189,13 +189,13 @@ theorem selectHeadFn_mem_FP {f a b : List Bool → List Bool} (fun z => selectHead (f z) (a z) (b z)) ∈ FP := by have hflag : ∀ t : Bool, (fun z => headFlag t (f z)) ∈ FP := fun t => by have := mem_FP_comp hf (headFlag_mem_FP t) - simpa [Function.comp] using this + simpa [Function.comp] using! this have hx : (fun z => (a z).take ((headFlag true (f z)).length * (a z).length)) ∈ FP := by have := takeLenFn_mem_FP (mulLenFn_mem_FP (hflag true) ha) ha - simpa using this + simpa using! this have hy : (fun z => (b z).take ((headFlag false (f z)).length * (b z).length)) ∈ FP := by have := takeLenFn_mem_FP (mulLenFn_mem_FP (hflag false) hb) hb - simpa using this + simpa using! this have h := appendFn_mem_FP hx hy have heq : (fun z => (a z).take ((headFlag true (f z)).length * (a z).length) ++ (b z).take ((headFlag false (f z)).length * (b z).length)) @@ -372,7 +372,7 @@ theorem exists_pow_ruler (c d : ℕ) : induction d with | zero => obtain ⟨K, hK, hlen⟩ := exists_const_ruler c - exact ⟨K, hK, fun z => by simpa using hlen z⟩ + exact ⟨K, hK, fun z => by simpa using! hlen z⟩ | succ d ih => obtain ⟨R, hR, hlen⟩ := ih refine ⟨fun z => List.replicate ((R z).length * (pair [] z).length) false, @@ -404,10 +404,10 @@ arithmetic operations now available — `mulLenFn_mem_FP` multiplies lengths and theorem const_replicate_mem_FP (c : ℕ) : (fun _ : List Bool => List.replicate c false) ∈ FP := by induction c with - | zero => simpa using const_nil_mem_FP + | zero => simpa using! const_nil_mem_FP | succ c ih => have := mem_FP_comp ih (cons_mem_FP false) - simpa [Function.comp, List.replicate_succ] using this + simpa [Function.comp, List.replicate_succ] using! this /-- A ruler of length exactly `|z| ^ d`. -/ private theorem exists_pow_exact_ruler (d : ℕ) : @@ -477,10 +477,10 @@ theorem loopStep_mem_FP {A B : List Bool → List Bool} (hA : A ∈ FP) (hB : B have hsnd : sndBlock ∈ FP := sndBlock_mem_FP have hcomp₁ : ∀ {g : List Bool → List Bool}, g ∈ FP → (fun v => fstBlock (g v)) ∈ FP := fun hg => by - simpa [Function.comp] using mem_FP_comp hg hfst + simpa [Function.comp] using! mem_FP_comp hg hfst have hcomp₂ : ∀ {g : List Bool → List Bool}, g ∈ FP → (fun v => sndBlock (g v)) ∈ FP := fun hg => by - simpa [Function.comp] using mem_FP_comp hg hsnd + simpa [Function.comp] using! mem_FP_comp hg hsnd have hP : (fun v : List Bool => fstBlock v) ∈ FP := hfst have hR : (fun v : List Bool => fstBlock (fstBlock v)) ∈ FP := hcomp₁ hP have hW : (fun v : List Bool => fstBlock (sndBlock (fstBlock v))) ∈ FP := @@ -491,21 +491,21 @@ theorem loopStep_mem_FP {A B : List Bool → List Bool} (hA : A ∈ FP) (hB : B have ha : (fun v : List Bool => sndBlock (sndBlock v)) ∈ FP := hcomp₂ hsnd have hrev : ∀ {g : List Bool → List Bool}, g ∈ FP → (fun v => (g v).reverse) ∈ FP := fun hg => by - simpa [Function.comp] using mem_FP_comp hg reverse_mem_FP + simpa [Function.comp] using! mem_FP_comp hg reverse_mem_FP have hcons : (fun v : List Bool => false :: fstBlock (sndBlock v)) ∈ FP := by - simpa [Function.comp] using mem_FP_comp ht (cons_mem_FP false) + simpa [Function.comp] using! mem_FP_comp ht (cons_mem_FP false) have ht' : (fun v : List Bool => (takeLen (pair (false :: fstBlock (sndBlock v)) (sndBlock (sndBlock (fstBlock v))).reverse)).reverse) ∈ FP := by refine hrev ?_ have := takeLenFn_mem_FP hcons (hrev hs) - simpa [takeLen_pair] using this + simpa [takeLen_pair] using! this have hX : (fun v : List Bool => pair (pair (fstBlock (sndBlock (fstBlock v))) (sndBlock (sndBlock v))) (fstBlock (sndBlock v))) ∈ FP := pairFn_mem_FP (pairFn_mem_FP hW ha) ht have hsel := selectHeadFn_mem_FP ht' - (by simpa [Function.comp] using mem_FP_comp hX hB) - (by simpa [Function.comp] using mem_FP_comp hX hA) + (by simpa [Function.comp] using! mem_FP_comp hX hB) + (by simpa [Function.comp] using! mem_FP_comp hX hA) have hacc : (fun v : List Bool => takeLen (pair (fstBlock (fstBlock v)) (selectHead ((takeLen (pair (false :: fstBlock (sndBlock v)) (sndBlock (sndBlock (fstBlock v))).reverse)).reverse) @@ -514,10 +514,10 @@ theorem loopStep_mem_FP {A B : List Bool → List Bool} (hA : A ∈ FP) (hB : B (A (pair (pair (fstBlock (sndBlock (fstBlock v))) (sndBlock (sndBlock v))) (fstBlock (sndBlock v))))))) ∈ FP := by have := takeLenFn_mem_FP hR hsel - simpa [takeLen_pair, Function.comp] using this + simpa [takeLen_pair, Function.comp] using! this have hall := pairFn_mem_FP (pairFn_mem_FP hR (pairFn_mem_FP hW hs)) (pairFn_mem_FP ht' hacc) - simpa [loopStep, loopStepOn] using hall + simpa [loopStep, loopStepOn] using! hall /-- **The loop's invariant.** After `m` iterations the state holds the suffix `s.drop (|s| - m)` and the clamped fold over it. -/ @@ -650,25 +650,25 @@ theorem iterStep_iterate_length_le (F : List Bool → List Bool) (x : List Bool) theorem emptyFlag_mem_FP {f : List Bool → List Bool} (hf : f ∈ FP) : (fun z => emptyFlag (f z)) ∈ FP := by have hcst : (fun _ : List Bool => [true]) ∈ FP := by - simpa [Function.comp] using mem_FP_comp const_nil_mem_FP (cons_mem_FP true) + simpa [Function.comp] using! mem_FP_comp const_nil_mem_FP (cons_mem_FP true) have h1 : (fun z => headFlag true (f z)) ∈ FP := by - simpa [Function.comp] using mem_FP_comp hf (headFlag_mem_FP true) + simpa [Function.comp] using! mem_FP_comp hf (headFlag_mem_FP true) have h2 : (fun z => headFlag false (f z)) ∈ FP := by - simpa [Function.comp] using mem_FP_comp hf (headFlag_mem_FP false) + simpa [Function.comp] using! mem_FP_comp hf (headFlag_mem_FP false) exact appendFn_mem_FP (appendFn_mem_FP h1 h2) hcst theorem nextCounter_mem_FP : nextCounter ∈ FP := by have hf : fstBlock ∈ FP := fstBlock_mem_FP have hs : sndBlock ∈ FP := sndBlock_mem_FP have hc : (fun w => false :: fstBlock (fstBlock w)) ∈ FP := by - simpa [Function.comp] using + simpa [Function.comp] using! mem_FP_comp (mem_FP_comp hf hf) (cons_mem_FP false) have hk : (fun w => fstBlock (fstBlock (sndBlock w))) ∈ FP := by - simpa [Function.comp] using mem_FP_comp hs (mem_FP_comp hf hf) + simpa [Function.comp] using! mem_FP_comp hs (mem_FP_comp hf hf) have := takeLenFn_mem_FP hc hk have hrev : (fun w => ((fstBlock (fstBlock (sndBlock w))).take (false :: fstBlock (fstBlock w)).length).reverse) ∈ FP := by - simpa [Function.comp] using mem_FP_comp this reverse_mem_FP + simpa [Function.comp] using! mem_FP_comp this reverse_mem_FP have heq : (fun w => ((fstBlock (fstBlock (sndBlock w))).take (false :: fstBlock (fstBlock w)).length).reverse) = nextCounter := by funext w @@ -688,7 +688,7 @@ theorem nextValue_mem_FP {F : List Bool → List Bool} (hF : F ∈ FP) : have hclamp : (fun w => takeLen (pair (sndBlock (fstBlock (sndBlock w))) (F (sndBlock (fstBlock w))))) ∈ FP := by have := takeLenFn_mem_FP hW hFv - simpa [takeLen_pair] using this + simpa [takeLen_pair] using! this exact selectHeadFn_mem_FP (emptyFlag_mem_FP hC) hv0 (selectHeadFn_mem_FP nextCounter_mem_FP hv hclamp) @@ -700,7 +700,7 @@ theorem iterStep_mem_FP {F : List Bool → List Bool} (hF : F ∈ FP) : have hclamp : (fun w => takeLen (pair (sndBlock w) (pair (nextCounter w) (nextValue F w)))) ∈ FP := by have := takeLenFn_mem_FP hs hpair - simpa [takeLen_pair] using this + simpa [takeLen_pair] using! this exact pairFn_mem_FP hclamp hs /-- The value the loop carries after `i` iterations, from the second on. -/ @@ -778,7 +778,7 @@ theorem iterStep_iterate (F : List Bool → List Bool) (Krev W v₀ : List Bool) theorem counter_take_le (a j : ℕ) (h : j ≤ a) : (List.replicate a false ++ [true]).take j = List.replicate j false := by - rw [List.take_append_of_le_length (by simpa using h), List.take_replicate, min_eq_left h] + rw [List.take_append_of_le_length (by simpa using! h), List.take_replicate, min_eq_left h] theorem counter_head_false (a j : ℕ) (h1 : 1 ≤ j) (h2 : j ≤ a) : (((List.replicate a false ++ [true]).take j).reverse).head? = some false := by @@ -887,18 +887,18 @@ theorem iterate_mem_FP {F init ruler width : List Bool → List Bool} ≤ (3 * Polynomial.X + Polynomial.C 2 : Polynomial ℕ).eval x.length := by intro x i _ have := iterStep_iterate_length_le F x i - simpa using this + simpa using! this have hΛ := iterate_input_mem_FP hstep (3 * Polynomial.X + Polynomial.C 2) hr -- the wrapper is `FP`, so the composite is have hXFP : X ∈ FP := by have hone : (fun _ : List Bool => [false]) ∈ FP := by - simpa [Function.comp] using mem_FP_comp const_nil_mem_FP (cons_mem_FP false) + simpa [Function.comp] using! mem_FP_comp const_nil_mem_FP (cons_mem_FP false) have htrue : (fun _ : List Bool => [true]) ∈ FP := by - simpa [Function.comp] using mem_FP_comp const_nil_mem_FP (cons_mem_FP true) + simpa [Function.comp] using! mem_FP_comp const_nil_mem_FP (cons_mem_FP true) have hrl : (fun z => ruler z ++ [false]) ∈ FP := appendFn_mem_FP hruler hone have hrep : (fun z => List.replicate ((ruler z).length + 1) false) ∈ FP := by have := mulLenFn_mem_FP hrl hone - simpa using this + simpa using! this exact pairFn_mem_FP (pairFn_mem_FP (appendFn_mem_FP hrep htrue) hwidth) hinit have hXeq : ∀ z, X z = pair (pair (Krev z) (width z)) (init z) := fun z => by rw [hX] have heq : (fun z => F^[(ruler z).length] (init z)) diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseControl.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseControl.lean index 07b4d3fc90..6eb57f3dda 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseControl.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseControl.lean @@ -80,7 +80,7 @@ private theorem denseControlResult_of_zeroJumpReset · subst i simp only [finalWork, Function.update_self] exact hasBinaryNat_parked (Tape.init_move_right_hasBinaryNat 0) - · simpa only [finalWork, Function.update_of_ne hi] using hparked i + · simpa only [finalWork, Function.update_of_ne hi] using! hparked i have hscanner : EntryScanReady tapes.data.lhsLookup.scan.entry (overlay.flatMap Entry.encode) [] finalWork finalWork := by refine @@ -163,7 +163,7 @@ private theorem denseControlResult_of_zeroJumpReset rw [hrole 10 (by decide)] rw [show lookupWork (tapes.data.lhsLookup.idx 10) = initialWork (tapes.data.lhsLookup.idx 10) by - simpa using hlookup.countSource] + simpa using! hlookup.countSource] exact hinitial.lookup.countSource · change (finalWork (tapes.data.lhsLookup.idx 11)).HasBinaryNat 0 rw [hrole 11 (by decide)] @@ -174,7 +174,7 @@ private theorem denseControlResult_of_zeroJumpReset · change (finalWork (tapes.data.lhsLookup.idx 13)).HasBinaryNat 0 rw [hrole 13 (by decide)] exact hlookup.copyScratch - · simpa only [finalWork, Function.update_of_ne tapes.pc_ne_lhs] using hpc + · simpa only [finalWork, Function.update_of_ne tapes.pc_ne_lhs] using! hpc refine { ready := hfinalReady sourceCells := ?_ @@ -223,7 +223,7 @@ theorem denseZeroJumpInstructionTM_hoareTime_frame work ∧ out = out₀ have hinput : TM.Parked inp₀ := by refine ⟨by simp [inp₀, Tape.move], ?_⟩ - simpa [inp₀] using Tape.init_ofBool_move_right_cells_ne_start input + simpa [inp₀] using! Tape.init_ofBool_move_right_cells_ne_start input have hlookup := denseOverlayLookupStaticTM_hoareTime_frame tapes.data.lhsLookup input overlay source initialWork out₀ hvalid hready.lookup houtput @@ -246,8 +246,8 @@ theorem denseZeroJumpInstructionTM_hoareTime_frame exact hready.pc have hset := setProgramCounterTM_hoareTime_frame_internal tapes.pc pcValue target inp work out hpcWork - (by simpa [hinp] using hinput) - hlookupResult.parked (by simpa [hout] using houtput) + (by simpa [hinp] using! hinput) + hlookupResult.parked (by simpa [hout] using! houtput) obtain ⟨final, time, htime, hreach, hhalt, hfinalInput, hfinalWork, hfinalOutput⟩ := hset inp work out ⟨rfl, rfl, rfl⟩ refine ⟨final, time, htime, hreach, hhalt, @@ -258,16 +258,16 @@ theorem denseZeroJumpInstructionTM_hoareTime_frame have htarget : targetTape.HasBinaryNat target := Tape.init_move_right_hasBinaryNat target refine ⟨work, hlookupResult, ?_, ?_, ?_, ?_⟩ - · simpa only [Function.update_of_ne tapes.lhs_ne_pc, value] using + · simpa only [Function.update_of_ne tapes.lhs_ne_pc, value] using! hlookupResult.destination · simpa only [targetTape, Function.update_self, newPC, hzero, ite_eq_left] - using htarget + using! htarget · intro i by_cases hi : i = tapes.pc · subst i - simpa only [targetTape, Function.update_self] using + simpa only [targetTape, Function.update_self] using! hasBinaryNat_parked htarget - · simpa only [targetTape, Function.update_of_ne hi] using + · simpa only [targetTape, Function.update_of_ne hi] using! hlookupResult.parked i · intro i hi exact Function.update_of_ne hi _ work @@ -279,9 +279,9 @@ theorem denseZeroJumpInstructionTM_hoareTime_frame (fun slot => (tapes.lookup_ne_pc slot).symm)] exact hready.pc have hsucc := TM.binarySuccTM_hoareTime_frame tapes.pc pcValue inp - work out hpcWork (by simpa [hinp] using hinput.read_ne_start) + work out hpcWork (by simpa [hinp] using! hinput.read_ne_start) (fun i _ => (hlookupResult.parked i).read_ne_start) - (by simpa [hout] using houtput.read_ne_start) + (by simpa [hout] using! houtput.read_ne_start) obtain ⟨final, time, htime, hreach, hhalt, hfinalInput, hframe, hfinalPC, hfinalOutput⟩ := hsucc inp work out ⟨rfl, rfl, rfl⟩ @@ -289,8 +289,8 @@ theorem denseZeroJumpInstructionTM_hoareTime_frame hfinalInput.trans hinp, ?_, hfinalOutput.trans hout⟩ refine ⟨work, hlookupResult, ?_, ?_, ?_, hframe⟩ · rw [hframe tapes.data.lhs tapes.lhs_ne_pc] - simpa only [value] using hlookupResult.destination - · simpa only [newPC, ite_eq_right hnonzero] using hfinalPC + simpa only [value] using! hlookupResult.destination + · simpa only [newPC, ite_eq_right hnonzero] using! hfinalPC · intro i by_cases hi : i = tapes.pc · subst i @@ -303,9 +303,9 @@ theorem denseZeroJumpInstructionTM_hoareTime_frame (nonblankPre := nonblankPre) (blankPost := branchPost) (nonblankPost := branchPost) (fun inp work out hpre => - ⟨(by simpa [hpre.1] using hinput.read_ne_start), + ⟨(by simpa [hpre.1] using! hinput.read_ne_start), fun i => (hpre.2.1.parked i).read_ne_start, - by simpa [hpre.2.2] using houtput.read_ne_start⟩) + by simpa [hpre.2.2] using! houtput.read_ne_start⟩) (fun _ _ _ hpre hread => ⟨hpre, hpre.2.1.destination.read_eq_blank_iff.mp hread⟩) (fun _ _ _ hpre hread => @@ -326,8 +326,8 @@ theorem denseZeroJumpInstructionTM_hoareTime_frame have hrun := TM.resetBinaryWorkTM_hoareTime_frame tapes.data.lhs value.bits 1 inp work out hoperand.2.hasBinaryContent hoperand.1 ⟨by rw [hoperand.2.1], by rw [hoperand.2.1]⟩ - (by simpa [hinp] using hinput) - (fun i _ => hparked i) (by simpa [hout] using houtput) + (by simpa [hinp] using! hinput) + (fun i _ => hparked i) (by simpa [hout] using! houtput) obtain ⟨final, time, htime, hreach, hhalt, hfinalInput, hfinalWork, hfinalOutput⟩ := hrun inp work out ⟨rfl, rfl, rfl⟩ refine ⟨final, time, htime, hreach, hhalt, @@ -346,8 +346,8 @@ theorem denseZeroJumpInstructionTM_hoareTime_frame hparked, hframe⟩ := hbranchResult obtain ⟨hi, hw, ho⟩ := phaseTransition_of_parked (inp := inp) (work := work) (out := out) - (by simpa [hinp] using hinput) hparked - (by simpa [hout] using houtput) + (by simpa [hinp] using! hinput) hparked + (by simpa [hout] using! houtput) rw [hi, hw, ho] exact ⟨hinp, ⟨lookupWork, hlookupResult, hoperand, hpcResult, hparked, hframe⟩, @@ -363,13 +363,13 @@ theorem denseZeroJumpInstructionTM_hoareTime_frame rintro inp work out ⟨hinp, hlookupResult, hout⟩ obtain ⟨hi, hw, ho⟩ := phaseTransition_of_parked (inp := inp) (work := work) (out := out) - (by simpa [inp₀, hinp] using hinput) hlookupResult.parked - (by simpa [hout] using houtput) + (by simpa [inp₀, hinp] using! hinput) hlookupResult.parked + (by simpa [hout] using! houtput) rw [hi, hw, ho] exact ⟨hinp, hlookupResult, hout⟩) hbranchReset simpa [denseZeroJumpInstructionTM, denseZeroJumpInstructionTime, inp₀, - value, newPC] using hall + value, newPC] using! hall end Machine end RegisterStore diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Immediate.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Immediate.lean index 0674c3c0a2..c98883f07e 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Immediate.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Immediate.lean @@ -162,46 +162,46 @@ theorem immediateUpdate_ready_internal parked := ?_ frame := by intro i _ _ _ _ _ _ _ _ _; rfl } · simpa only [updateWork, valueWork, Function.update_of_ne hsourceQuery, - Function.update_of_ne hsourceReplacement] using hinitial.scanner.source + Function.update_of_ne hsourceReplacement] using! hinitial.scanner.source · simpa only [updateWork, valueWork, Function.update_of_ne haddressQuery, - Function.update_of_ne haddressReplacement] using hinitial.scanner.address + Function.update_of_ne haddressReplacement] using! hinitial.scanner.address · simpa only [updateWork, valueWork, Function.update_of_ne haddressQuery, - Function.update_of_ne haddressReplacement] using + Function.update_of_ne haddressReplacement] using! hinitial.scanner.addressStart · simpa only [updateWork, valueWork, Function.update_of_ne hvalueQuery, - Function.update_of_ne hvalueReplacement] using hinitial.scanner.value + Function.update_of_ne hvalueReplacement] using! hinitial.scanner.value · simpa only [updateWork, valueWork, Function.update_of_ne hvalueQuery, - Function.update_of_ne hvalueReplacement] using + Function.update_of_ne hvalueReplacement] using! hinitial.scanner.valueStart · simpa only [updateWork, valueWork, Function.update_of_ne haddressCounterQuery, - Function.update_of_ne haddressCounterReplacement] using + Function.update_of_ne haddressCounterReplacement] using! hinitial.scanner.addressCounter · simpa only [updateWork, valueWork, Function.update_of_ne haddressWidthQuery, - Function.update_of_ne haddressWidthReplacement] using + Function.update_of_ne haddressWidthReplacement] using! hinitial.scanner.addressWidth · simpa only [updateWork, valueWork, Function.update_of_ne hvalueCounterQuery, - Function.update_of_ne hvalueCounterReplacement] using + Function.update_of_ne hvalueCounterReplacement] using! hinitial.scanner.valueCounter · simpa only [updateWork, valueWork, Function.update_of_ne hvalueWidthQuery, - Function.update_of_ne hvalueWidthReplacement] using + Function.update_of_ne hvalueWidthReplacement] using! hinitial.scanner.valueWidth - · simpa only [updateWork, Function.update_self, queryTape] using + · simpa only [updateWork, Function.update_self, queryTape] using! hqueryNat.2 - · simpa only [updateWork, Function.update_self, queryTape] using + · simpa only [updateWork, Function.update_self, queryTape] using! hqueryNat.1 · simpa only [updateWork, valueWork, Function.update_of_ne hresultQuery, - Function.update_of_ne hresultReplacement] using hinitial.scanner.result + Function.update_of_ne hresultReplacement] using! hinitial.scanner.result · simpa only [updateWork, valueWork, Function.update_of_ne hresultQuery, - Function.update_of_ne hresultReplacement] using + Function.update_of_ne hresultReplacement] using! hinitial.scanner.resultStart · intro i by_cases hiQuery : i = tapes.update.entry.query · subst i - simpa only [updateWork, Function.update_self, queryTape] using + simpa only [updateWork, Function.update_self, queryTape] using! (show TM.Parked queryTape from ⟨by rw [hqueryNat.2.1], hqueryNat.2.hasBinaryContent.cells_ne_start⟩) @@ -210,22 +210,22 @@ theorem immediateUpdate_ready_internal rw [hiEq] by_cases hiReplacement : i = tapes.update.replacement · subst i - simpa only [valueWork, Function.update_self, valueTape] using + simpa only [valueWork, Function.update_self, valueTape] using! (show TM.Parked valueTape from ⟨by rw [hvalueNat.2.1], hvalueNat.2.hasBinaryContent.cells_ne_start⟩) - · simpa only [valueWork, Function.update_of_ne hiReplacement] using + · simpa only [valueWork, Function.update_of_ne hiReplacement] using! hinitial.scanner.parked i refine ⟨hscanner, ?_, ?_, ?_, ?_, hscanner.parked⟩ · simpa only [updateWork, Function.update_of_ne hreplacementQuery, - valueWork, Function.update_self, valueTape] using hvalueNat + valueWork, Function.update_self, valueTape] using! hvalueNat · simpa only [updateWork, Function.update_of_ne hremainingQuery, - valueWork, Function.update_of_ne hremainingReplacement] using + valueWork, Function.update_of_ne hremainingReplacement] using! hinitial.count · simpa only [updateWork, Function.update_of_ne hfoundQuery, valueWork, - Function.update_of_ne hfoundReplacement] using hinitial.copyScratch + Function.update_of_ne hfoundReplacement] using! hinitial.copyScratch · simpa only [updateWork, Function.update_of_ne hresultCountQuery, - valueWork, Function.update_of_ne hresultCountReplacement] using + valueWork, Function.update_of_ne hresultCountReplacement] using! hinitial.countSource /-- Exact semantic and time contract for one immediate sparse assignment. -/ @@ -260,7 +260,7 @@ theorem immediateInstructionTM_hoareTime_frame_internal (fun inp work out => inp = inp₀ ∧ work = initialWork ∧ out = out₀) (fun inp work out => inp = inp₀ ∧ work = valueWork ∧ out = out₀) (TM.binaryAddConstTime value 0) := by - simpa only [valueWork, zero_add] using hvalue + simpa only [valueWork, zero_add] using! hvalue have hquery : (TM.binaryAddConstTM tapes.update.entry.query destination).HoareTime (fun inp work out => inp = inp₀ ∧ work = valueWork ∧ out = out₀) @@ -274,7 +274,7 @@ theorem immediateInstructionTM_hoareTime_frame_internal initialWork tapes.update.entry.query := Function.update_of_ne hqueryReplacement _ initialWork rw [heq] - exact ⟨hinitial.scanner.queryStart, by simpa using hinitial.scanner.query⟩ + exact ⟨hinitial.scanner.queryStart, by simpa using! hinitial.scanner.query⟩ have hrun := TM.binaryAddConstTM_hoareTime_frame tapes.update.entry.query destination 0 inp₀ valueWork out₀ hqueryZero hinput @@ -282,12 +282,12 @@ theorem immediateInstructionTM_hoareTime_frame_internal by_cases hi : i = tapes.update.replacement · subst i exact ⟨by simp [valueWork, Tape.init, Tape.move], by - simpa [valueWork] using + simpa [valueWork] using! (Tape.init_move_right_hasBinaryNat value).2.hasBinaryContent.cells_ne_start⟩ - · simpa only [valueWork, Function.update_of_ne hi] using + · simpa only [valueWork, Function.update_of_ne hi] using! hinitial.scanner.parked i) houtputParked - simpa only [updateWork, zero_add] using hrun + simpa only [updateWork, zero_add] using! hrun have hready := immediateUpdate_ready_internal tapes store destination value initialWork hinitial have hupdate := entryUpdateTM_hoareTime_frame tapes.update store destination @@ -325,8 +325,8 @@ theorem immediateInstructionTM_hoareTime_frame_internal subst work obtain ⟨hi, hw, ho⟩ := phaseTransition_of_parked (inp := inp) (work := updateWork) (out := out) - (by simpa [hinp] using hinput) hready.2.2.2.2.2 - (by simpa [hout] using houtputParked) + (by simpa [hinp] using! hinput) hready.2.2.2.2.2 + (by simpa [hout] using! houtputParked) rw [hi, hw, ho] exact ⟨hinp, rfl, hout⟩) hupdate' @@ -342,20 +342,20 @@ theorem immediateInstructionTM_hoareTime_frame_internal by_cases hi : i = tapes.update.replacement · subst i have hnat := Tape.init_move_right_hasBinaryNat value - simpa only [valueWork, Function.update_self] using + simpa only [valueWork, Function.update_self] using! (show TM.Parked ((Tape.init (value.bits.map Γ.ofBool)).move Dir3.right) from ⟨by rw [hnat.2.1], hnat.2.hasBinaryContent.cells_ne_start⟩) - · simpa only [valueWork, Function.update_of_ne hi] using + · simpa only [valueWork, Function.update_of_ne hi] using! hinitial.scanner.parked i obtain ⟨hi, hw, ho⟩ := phaseTransition_of_parked (inp := inp) (work := valueWork) (out := out) - (by simpa [hinp] using hinput) hparked - (by simpa [hout] using houtputParked) + (by simpa [hinp] using! hinput) hparked + (by simpa [hout] using! houtputParked) rw [hi, hw, ho] exact ⟨hinp, rfl, hout⟩) hqueryUpdate - simpa [immediateInstructionTM, immediateInstructionTime] using hall + simpa [immediateInstructionTM, immediateInstructionTime] using! hall end Machine diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Internal.lean index 70afdd66f6..dead877b63 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Internal.lean @@ -143,48 +143,48 @@ theorem binaryInstructionArithmeticTM_hoareTime_frame_internal hlhs' hrhs' hresult' hframe hwork hshift htmp hdbl, hout⟩) | mul => exact (TM.binaryShiftMulTM_hoareTime_frame tapes.mul lhs rhs inp₀ work₀ - out₀ (by simpa using hlhs) (by simpa using hrhs) - (by simpa using hresult) (by simpa using hshift) - (by simpa using htmp) (by simpa using hdbl) hinput hwork + out₀ (by simpa using! hlhs) (by simpa using! hrhs) + (by simpa using! hresult) (by simpa using! hshift) + (by simpa using! htmp) (by simpa using! hdbl) hinput hwork houtput).strengthen_post (by rintro inp work out ⟨hinp, hlhs', hrhs', hresult', hshift', htmp', hdbl', hframe, hout⟩ refine ⟨hinp, ⟨?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_⟩, hout⟩ - · simpa using hlhs' - · simpa using hrhs' - · simpa using hresult' - · simpa using hshift' - · simpa using htmp' - · simpa using hdbl' + · simpa using! hlhs' + · simpa using! hrhs' + · simpa using! hresult' + · simpa using! hshift' + · simpa using! htmp' + · simpa using! hdbl' · intro i by_cases hilhs : i = tapes.lhs · subst i - exact hasBinaryNat_parked (by simpa using hlhs') + exact hasBinaryNat_parked (by simpa using! hlhs') · by_cases hirhs : i = tapes.rhs · subst i - exact hasBinaryNat_parked (by simpa using hrhs') + exact hasBinaryNat_parked (by simpa using! hrhs') · by_cases hires : i = tapes.update.replacement · subst i - exact hasBinaryNat_parked (by simpa using hresult') + exact hasBinaryNat_parked (by simpa using! hresult') · by_cases hishift : i = tapes.shift · subst i - exact hasBinaryNat_parked (by simpa using hshift') + exact hasBinaryNat_parked (by simpa using! hshift') · by_cases hitmp : i = tapes.tmp · subst i - exact hasBinaryNat_parked (by simpa using htmp') + exact hasBinaryNat_parked (by simpa using! htmp') · by_cases hidbl : i = tapes.dbl · subst i - exact hasBinaryNat_parked (by simpa using hdbl') - · rw [hframe i (by simpa using hilhs) - (by simpa using hirhs) (by simpa using hires) - (by simpa using hishift) (by simpa using hitmp) - (by simpa using hidbl)] + exact hasBinaryNat_parked (by simpa using! hdbl') + · rw [hframe i (by simpa using! hilhs) + (by simpa using! hirhs) (by simpa using! hires) + (by simpa using! hishift) (by simpa using! hitmp) + (by simpa using! hidbl)] exact hwork i · intro i hilhs hirhs hires hishift hitmp hidbl - exact hframe i (by simpa using hilhs) (by simpa using hirhs) - (by simpa using hires) (by simpa using hishift) - (by simpa using hitmp) (by simpa using hidbl)) + exact hframe i (by simpa using! hilhs) (by simpa using! hirhs) + (by simpa using! hires) (by simpa using! hishift) + (by simpa using! hitmp) (by simpa using! hidbl)) /-- Arithmetic feeds its canonical result directly into sparse update. -/ theorem binaryInstructionUpdateTM_hoareTime_frame_internal diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Load.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Load.lean index e05c46070a..be2152fb1f 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Load.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Load.lean @@ -69,21 +69,21 @@ private theorem indirectLoaded_ready (addressWork tapes.update.resultCount).HasBinaryNat store.length := by rw [show addressWork tapes.update.resultCount = initialWork tapes.update.resultCount by - simpa using haddress.countSource] - simpa using hinitial.countSource + simpa using! haddress.countSource] + simpa using! hinitial.countSource refine { scanner := scanner_indirect_of_lhs tapes store addressRegister initialWork addressWork haddress sourceStart := haddress.sourceStart sourceHead := haddress.sourceHead - count := by simpa using haddress.count - countSource := by simpa using hcountSource - querySource := by simpa using haddress.destination + count := by simpa using! haddress.count + countSource := by simpa using! hcountSource + querySource := by simpa using! haddress.destination destination := by change (addressWork tapes.update.replacement).HasBinaryNat 0 rw [hreplacementEq] exact hreplacement - copyScratch := by simpa using haddress.copyScratch } + copyScratch := by simpa using! haddress.copyScratch } theorem scanner_updateQuery_of_indirect_internal (tapes : BinaryInstructionTapes n) (store : Store) (destination : ℕ) @@ -121,52 +121,52 @@ theorem scanner_updateQuery_of_indirect_internal have hnat := Tape.init_move_right_hasBinaryNat destination refine { source := by - simpa only [finalWork, Function.update_of_ne hsource] using + simpa only [finalWork, Function.update_of_ne hsource] using! hscanner.source address := by - simpa only [finalWork, Function.update_of_ne haddress] using + simpa only [finalWork, Function.update_of_ne haddress] using! hscanner.address addressStart := by - simpa only [finalWork, Function.update_of_ne haddress] using + simpa only [finalWork, Function.update_of_ne haddress] using! hscanner.addressStart value := by - simpa only [finalWork, Function.update_of_ne hvalue] using + simpa only [finalWork, Function.update_of_ne hvalue] using! hscanner.value valueStart := by - simpa only [finalWork, Function.update_of_ne hvalue] using + simpa only [finalWork, Function.update_of_ne hvalue] using! hscanner.valueStart addressCounter := by - simpa only [finalWork, Function.update_of_ne haddressCounter] using + simpa only [finalWork, Function.update_of_ne haddressCounter] using! hscanner.addressCounter addressWidth := by - simpa only [finalWork, Function.update_of_ne haddressWidth] using + simpa only [finalWork, Function.update_of_ne haddressWidth] using! hscanner.addressWidth valueCounter := by - simpa only [finalWork, Function.update_of_ne hvalueCounter] using + simpa only [finalWork, Function.update_of_ne hvalueCounter] using! hscanner.valueCounter valueWidth := by - simpa only [finalWork, Function.update_of_ne hvalueWidth] using + simpa only [finalWork, Function.update_of_ne hvalueWidth] using! hscanner.valueWidth query := by - simpa only [finalWork, Function.update_self] using hnat.2 + simpa only [finalWork, Function.update_self] using! hnat.2 queryStart := by - simpa only [finalWork, Function.update_self] using hnat.1 + simpa only [finalWork, Function.update_self] using! hnat.1 result := by - simpa only [finalWork, Function.update_of_ne hresult] using + simpa only [finalWork, Function.update_of_ne hresult] using! hscanner.result resultStart := by - simpa only [finalWork, Function.update_of_ne hresult] using + simpa only [finalWork, Function.update_of_ne hresult] using! hscanner.resultStart parked := ?_ frame := by intro i _ _ _ _ _ _ _ _ _; rfl } intro i by_cases hi : i = tapes.update.entry.query · subst i - simpa only [finalWork, Function.update_self] using + simpa only [finalWork, Function.update_self] using! (show TM.Parked ((Tape.init (destination.bits.map Γ.ofBool)).move Dir3.right) from ⟨by rw [hnat.2.1], hnat.2.hasBinaryContent.cells_ne_start⟩) - · simpa only [finalWork, Function.update_of_ne hi] using hscanner.parked i + · simpa only [finalWork, Function.update_of_ne hi] using! hscanner.parked i private theorem hasBinaryPrefix_parked {t : Tape} {bits : List Bool} (h : t.HasBinaryPrefix bits) : TM.Parked t := by @@ -267,18 +267,18 @@ theorem indirectLoadInstructionTM_hoareTime_frame_internal hloadedResult⟩, hout⟩ have hqueryZero : (work tapes.update.entry.query).HasBinaryNat 0 := ⟨hloadedResult.scanner.queryStart, by - simpa using hloadedResult.scanner.query⟩ + simpa using! hloadedResult.scanner.query⟩ have hrun := TM.binaryAddConstTM_hoareTime_frame tapes.update.entry.query destination 0 inp work out hqueryZero - (by simpa [hinp] using hinput) + (by simpa [hinp] using! hinput) (fun i _ => hloadedResult.parked i) - (by simpa [hout] using houtputParked) + (by simpa [hout] using! houtputParked) obtain ⟨final, time, htime, hreach, hhalt, hfinalInput, hfinalWork, hfinalOutput⟩ := hrun inp work out ⟨rfl, rfl, rfl⟩ exact ⟨final, time, htime, hreach, hhalt, hfinalInput.trans hinp, ⟨addressWork, work, haddressResult, hloadedResult, - by simpa only [zero_add] using hfinalWork⟩, + by simpa only [zero_add] using! hfinalWork⟩, hfinalOutput.trans hout⟩ have hupdate : (entryUpdateTM tapes.update).HoareTime (fun inp work out => @@ -326,21 +326,21 @@ theorem indirectLoadInstructionTM_hoareTime_frame_internal (loadedWork tapes.update.resultCount).HasBinaryNat store.length := by rw [show loadedWork tapes.update.resultCount = addressWork tapes.update.resultCount by - simpa using hloadedResult.countSource] + simpa using! hloadedResult.countSource] rw [show addressWork tapes.update.resultCount = initialWork tapes.update.resultCount by - simpa using haddressResult.countSource] - simpa using hinitial.countSource + simpa using! haddressResult.countSource] + simpa using! hinitial.countSource have hrun := entryUpdateTM_hoareTime_frame tapes.update store destination (RegisterStore.read store (RegisterStore.read store addressRegister)) emittedBits updateWork inp₀ out₀ hcanonical hscanner - (by simpa only [updateWork, Function.update_of_ne hreplacementNe] using + (by simpa only [updateWork, Function.update_of_ne hreplacementNe] using! hloadedResult.value) - (by simpa only [updateWork, Function.update_of_ne hremainingNe] using + (by simpa only [updateWork, Function.update_of_ne hremainingNe] using! hloadedResult.count) - (by simpa only [updateWork, Function.update_of_ne hfoundNe] using + (by simpa only [updateWork, Function.update_of_ne hfoundNe] using! hloadedResult.copyScratch) - (by simpa only [updateWork, Function.update_of_ne hresultCountNe] using + (by simpa only [updateWork, Function.update_of_ne hresultCountNe] using! hresultCount) hinput houtput obtain ⟨final, time, htime, hreach, hhalt, hfinalInput, @@ -374,8 +374,8 @@ theorem indirectLoadInstructionTM_hoareTime_frame_internal (inp := inp) (work := Function.update loadedWork tapes.update.entry.query ((Tape.init (destination.bits.map Γ.ofBool)).move Dir3.right)) - (out := out) (by simpa [hinp] using hinput) hparked - (by simpa [hout] using houtputParked) + (out := out) (by simpa [hinp] using! hinput) hparked + (by simpa [hout] using! houtputParked) rw [hi, hw, ho] exact ⟨hinp, ⟨addressWork, loadedWork, haddressResult, hloadedResult, rfl⟩, hout⟩) @@ -389,8 +389,8 @@ theorem indirectLoadInstructionTM_hoareTime_frame_internal hloadedResult⟩, hout⟩ obtain ⟨hi, hw, ho⟩ := phaseTransition_of_parked (inp := inp) (work := work) (out := out) - (by simpa [hinp] using hinput) hloadedResult.parked - (by simpa [hout] using houtputParked) + (by simpa [hinp] using! hinput) hloadedResult.parked + (by simpa [hout] using! houtputParked) rw [hi, hw, ho] exact ⟨hinp, ⟨addressWork, haddressResult, hloadedResult⟩, hout⟩) hqueryUpdate @@ -403,12 +403,12 @@ theorem indirectLoadInstructionTM_hoareTime_frame_internal rintro inp work out ⟨hinp, haddressResult, hout⟩ obtain ⟨hi, hw, ho⟩ := phaseTransition_of_parked (inp := inp) (work := work) (out := out) - (by simpa [hinp] using hinput) haddressResult.parked - (by simpa [hout] using houtputParked) + (by simpa [hinp] using! hinput) haddressResult.parked + (by simpa [hout] using! houtputParked) rw [hi, hw, ho] exact ⟨hinp, haddressResult, hout⟩) hloadedRest - simpa [indirectLoadInstructionTM, indirectLoadInstructionTime] using hall + simpa [indirectLoadInstructionTM, indirectLoadInstructionTime] using! hall end Machine From 184bb536e3b186f5462dec42190bd32069cbc73d Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Tue, 22 Sep 2026 02:23:14 +0000 Subject: [PATCH 14/49] Port final approximation assembly and numerical cost estimates --- .../BeyondBethe/DirectedPairCost.lean | 4 +- .../BeyondBethe/FinalAssembly.lean | 10 +- .../BeyondBethe/MachineEncoding.lean | 16 ++-- .../BeyondBethe/MatrixPerturbation.lean | 2 +- .../BeyondBethe/PalomarComplexity.lean | 8 +- .../BeyondBethe/RationalFeasibility.lean | 20 ++-- .../Machine/Instruction/DenseImm.lean | 24 ++--- .../Machine/Instruction/DenseLoad.lean | 54 +++++------ .../Machine/Instruction/Direct.lean | 92 +++++++++---------- .../Structured/LastBit.lean | 4 +- 10 files changed, 119 insertions(+), 115 deletions(-) diff --git a/LeanPool/BeyondBethe/BeyondBethe/DirectedPairCost.lean b/LeanPool/BeyondBethe/BeyondBethe/DirectedPairCost.lean index bba32d5c0f..ec6e79344b 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/DirectedPairCost.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/DirectedPairCost.lean @@ -226,7 +226,7 @@ theorem fourCoreTransferCost_le_directedFourCoreCostUpper fourCoreTransferCost (τ : ℝ) (fun i j ↦ ((X i j : ℚ) : ℝ)) r s a b ≤ (directedFourCoreCostUpper τ X r s a b p : ℝ) := by - rw [fourCoreTransferCost, directedFourCoreCostUpper] + unfold fourCoreTransferCost directedFourCoreCostUpper push_cast linarith [transferCost_le_directedTransferCostUpper hτ hXint r a p, transferCost_le_directedTransferCostUpper hτ hXint r b p, @@ -249,7 +249,7 @@ theorem directedFourCoreCostUpper_le_add_error have hsb := directedTransferCostUpper_le_add_error hτ0 hτ1 hXint s b p have hecast : ((((1 / 2 : ℚ) ^ p : ℚ)) : ℝ) = (1 / 2 : ℝ) ^ p := by norm_num - rw [fourCoreTransferCost, directedFourCoreCostUpper] + unfold fourCoreTransferCost directedFourCoreCostUpper push_cast rw [← hecast] linarith diff --git a/LeanPool/BeyondBethe/BeyondBethe/FinalAssembly.lean b/LeanPool/BeyondBethe/BeyondBethe/FinalAssembly.lean index cad8000089..b9e4411f5c 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/FinalAssembly.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/FinalAssembly.lean @@ -78,8 +78,12 @@ structure CertifiedPositiveRoutine (ε : ℝ) where guard to remain a polynomial-time total function on all rational matrices, including inputs outside the approximation theorem's domain. -/ def rationalMatrixNonnegativeDecision {n : ℕ} - (A : Matrix (Fin n) (Fin n) ℚ) : Bool := - decide (∀ i : Fin n, ∀ j : Fin n, 0 ≤ A i j) + (A : Matrix (Fin n) (Fin n) ℚ) : Bool := by + letI : ∀ i j : Fin n, Decidable (0 ≤ A i j) := fun i j => inferInstance + letI : ∀ i : Fin n, Decidable (∀ j : Fin n, 0 ≤ A i j) := + fun i => Fintype.decidableForallFintype + exact @decide (∀ i : Fin n, ∀ j : Fin n, 0 ≤ A i j) + Fintype.decidableForallFintype theorem rationalMatrixNonnegativeDecision_eq_true_iff {n : ℕ} (A : Matrix (Fin n) (Fin n) ℚ) : @@ -181,7 +185,7 @@ theorem finset_prod_le_factor ∏ q ∈ s, f q ≤ f p := by rw [← Finset.prod_erase_mul s f hp] have herase : ∏ q ∈ s.erase p, f q ≤ 1 := - Finset.prod_le_one + Finset.prod_le_one₀ (fun q hq ↦ hpos q (Finset.mem_of_mem_erase hq)) (fun q hq ↦ hone q (Finset.mem_of_mem_erase hq)) exact (mul_le_mul_of_nonneg_right herase (hpos p hp)).trans_eq (one_mul _) diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineEncoding.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineEncoding.lean index 21eb478f25..0d7e51aca8 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineEncoding.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineEncoding.lean @@ -28,10 +28,10 @@ row list. -/ def machinePairSecond (word : List Bool) : List Bool := Cobham.sndBlock word theorem machinePairFirst_mem_FP : machinePairFirst ∈ Complexity.FP := by - simpa only [machinePairFirst] using Cobham.fstBlock_mem_FP + simpa only [machinePairFirst] using! Cobham.fstBlock_mem_FP theorem machinePairSecond_mem_FP : machinePairSecond ∈ Complexity.FP := by - simpa only [machinePairSecond] using Cobham.sndBlock_mem_FP + simpa only [machinePairSecond] using! Cobham.sndBlock_mem_FP @[simp] theorem machinePairFirst_pair (left right : List Bool) : machinePairFirst (pair left right) = left := by @@ -51,11 +51,11 @@ def machineMatrixRowsWord (word : List Bool) : List Bool := theorem machineMatrixDimensionWord_mem_FP : machineMatrixDimensionWord ∈ Complexity.FP := by - simpa only [machineMatrixDimensionWord] using machinePairFirst_mem_FP + simpa only [machineMatrixDimensionWord] using! machinePairFirst_mem_FP theorem machineMatrixRowsWord_mem_FP : machineMatrixRowsWord ∈ Complexity.FP := by - simpa only [machineMatrixRowsWord] using machinePairSecond_mem_FP + simpa only [machineMatrixRowsWord] using! machinePairSecond_mem_FP @[simp] theorem machineMatrixDimensionWord_encode {n : ℕ} (A : Matrix (Fin n) (Fin n) ℚ) : @@ -80,10 +80,10 @@ def machineListHead (word : List Bool) : List Bool := machinePairFirst word def machineListTail (word : List Bool) : List Bool := machinePairSecond word theorem machineListHead_mem_FP : machineListHead ∈ Complexity.FP := by - simpa only [machineListHead] using machinePairFirst_mem_FP + simpa only [machineListHead] using! machinePairFirst_mem_FP theorem machineListTail_mem_FP : machineListTail ∈ Complexity.FP := by - simpa only [machineListTail] using machinePairSecond_mem_FP + simpa only [machineListTail] using! machinePairSecond_mem_FP @[simp] theorem machineListHead_cons {α : Type*} (encode : α → List Bool) (x : α) (xs : List α) : @@ -106,11 +106,11 @@ def machineRationalEntryDenominatorWord (word : List Bool) : List Bool := theorem machineRationalEntryNumeratorWord_mem_FP : machineRationalEntryNumeratorWord ∈ Complexity.FP := by - simpa only [machineRationalEntryNumeratorWord] using machinePairFirst_mem_FP + simpa only [machineRationalEntryNumeratorWord] using! machinePairFirst_mem_FP theorem machineRationalEntryDenominatorWord_mem_FP : machineRationalEntryDenominatorWord ∈ Complexity.FP := by - simpa only [machineRationalEntryDenominatorWord] using machinePairSecond_mem_FP + simpa only [machineRationalEntryDenominatorWord] using! machinePairSecond_mem_FP @[simp] theorem machineRationalEntryNumeratorWord_encode (q : ℚ) : machineRationalEntryNumeratorWord (rationalEntryBinaryCode q) = diff --git a/LeanPool/BeyondBethe/BeyondBethe/MatrixPerturbation.lean b/LeanPool/BeyondBethe/BeyondBethe/MatrixPerturbation.lean index 941157c942..9725df7a7c 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MatrixPerturbation.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MatrixPerturbation.lean @@ -31,7 +31,7 @@ theorem abs_finset_prod_le_pow {ι : Type*} {s : Finset ι} abs (∏ i ∈ s, f i) ≤ M ^ s.card := by classical rw [Finset.abs_prod] - simpa using Finset.prod_le_prod (fun _ _ ↦ abs_nonneg _) + simpa using Finset.prod_le_prod₀ (fun _ _ ↦ abs_nonneg _) (fun i hi ↦ hf i hi) /-- A deliberately coarse but uniform product perturbation estimate. The diff --git a/LeanPool/BeyondBethe/BeyondBethe/PalomarComplexity.lean b/LeanPool/BeyondBethe/BeyondBethe/PalomarComplexity.lean index 58c4f04bef..9a05fdcd45 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/PalomarComplexity.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/PalomarComplexity.lean @@ -108,8 +108,8 @@ theorem of_complexity_cobham {n : ℕ} recNotation g h₀ h₁ (v ⟨0, Nat.zero_lt_succ n⟩) (Fin.tail v) := by refine .boundedRec ihg ihh₀ ihh₁ ihj ?_ intro x v - simpa only [recNotation_eq_complexity] using hbound x v - simpa only [recNotation_eq_complexity] using hstable + simpa only [recNotation_eq_complexity] using! hbound x v + simpa only [recNotation_eq_complexity] using! hstable /-- The source-stable presentation also embeds back into Complexitylib's standard Cobham class. -/ @@ -128,8 +128,8 @@ theorem to_complexity_cobham {n : ℕ} (v ⟨0, Nat.zero_lt_succ n⟩) (Fin.tail v) := by refine .boundedRec ihg ihh₀ ihh₁ ihj ?_ intro x v - simpa only [recNotation_eq_complexity] using hbound x v - simpa only [recNotation_eq_complexity] using hstandard + simpa only [recNotation_eq_complexity] using! hbound x v + simpa only [recNotation_eq_complexity] using! hstandard /-- Every polynomial-time function in Complexitylib's Cobham presentation belongs to the source-stable presentation used in the Palomar statement. -/ diff --git a/LeanPool/BeyondBethe/BeyondBethe/RationalFeasibility.lean b/LeanPool/BeyondBethe/BeyondBethe/RationalFeasibility.lean index 60a99d965f..a660402dd5 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/RationalFeasibility.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/RationalFeasibility.lean @@ -73,7 +73,7 @@ theorem rationalBallEllipsoid_contains {d : ℕ} rw [hyform, finiteNormSq_smul] have hR2 : 0 < (R : ℝ) ^ 2 := sq_pos_of_pos hRreal rw [inv_pow] - simpa [div_eq_mul_inv, mul_comm] using (div_le_one hR2).2 hx + simpa [div_eq_mul_inv, mul_comm] using! (div_le_one hR2).2 hx refine ⟨y, hynorm, ?_⟩ ext i rw [rationalEllipsoidPoint] @@ -115,14 +115,14 @@ theorem rationalBallDyadicExponent_works {d : ℕ} (hd : 0 < d) have hfac : (d.factorial : ℚ) ≤ (2 : ℚ) ^ (d ^ 2) := by exact_mod_cast factorial_le_two_pow_sq d have hRup : R < (2 : ℚ) ^ LR := by - simpa only [LR] using positive_rational_lt_two_pow_encodedBitLength hR + simpa only [LR] using! positive_rational_lt_two_pow_encodedBitLength hR have hRpow : R ^ d < (2 : ℚ) ^ (LR * d) := by calc R ^ d < ((2 : ℚ) ^ LR) ^ d := pow_lt_pow_left₀ hRup hR.le hd.ne' _ = (2 : ℚ) ^ (LR * d) := by rw [← pow_mul] have hrlow : (1 / 2 : ℚ) ^ Lr < r := by - simpa only [Lr] using dyadic_encodedBitLength_lt_positive_rational hr + simpa only [Lr] using! dyadic_encodedBitLength_lt_positive_rational hr have hrpow : ((1 / 2 : ℚ) ^ Lr) ^ d < r ^ d := pow_lt_pow_left₀ hrlow (by positivity) hd.ne' have hM : rationalBallDyadicExponent d R r = A + C + 1 := by @@ -193,7 +193,7 @@ theorem rationalBallEllipsoid_dyadic_budget {d : ℕ} (hd : 0 < d) ((r ^ d : ℚ) : ℝ) := (Rat.cast_lt (K := ℝ)).mpr hq norm_num only [Rat.cast_mul, Rat.cast_pow, Rat.cast_div, Rat.cast_one, Rat.cast_ofNat, Rat.cast_natCast] at hcast - simpa using hcast + simpa using! hcast /-- Pullback identity for the physical displacement from the ellipsoid center. -/ @@ -231,7 +231,7 @@ theorem rationalPulledBackNormal_ne_zero_of_det_ne_zero {d : ℕ} intro hzero apply ha have hdetT : Matrix.det E.basis.transpose ≠ 0 := by - simpa [Matrix.det_transpose] using hdet + simpa [Matrix.det_transpose] using! hdet have hunit : IsUnit (Matrix.det E.basis.transpose) := (isUnit_iff_ne_zero).2 hdetT have hinv := Matrix.nonsing_inv_mul E.basis.transpose hunit @@ -266,7 +266,7 @@ theorem rationalEllipsoidCentralUpdate_contains_point {d : ℕ} (hd : 0 < d) have hpulled : finiteDot (fun j ↦ (rationalPulledBackNormal E a j : ℝ)) y ≤ 0 := by rw [← physicalDot_point_sub_center_eq_pulledDot E a y] - simpa only [hpoint] using hcut + simpa only [hpoint] using! hcut obtain ⟨y', hy', hpoint'⟩ := rationalEllipsoidCentralUpdate_contains hd E a hnonzero hy hpulled exact ⟨y', hy', hpoint'.trans hpoint⟩ @@ -365,7 +365,7 @@ theorem rationalEllipsoidIterate_cuts_eq_of_exhausted {d : ℕ} (hrun : runRationalFeasibility oracle budget E = .exhausted E') : rationalEllipsoidIterate E (rationalFeasibilityCuts oracle budget E) = E' := by induction budget generalizing E E' with - | zero => simpa [runRationalFeasibility, rationalFeasibilityCuts] using hrun + | zero => simpa [runRationalFeasibility, rationalFeasibilityCuts] using! hrun | succ budget ih => rw [runRationalFeasibility] at hrun split at hrun <;> rename_i hresponse @@ -536,13 +536,13 @@ theorem runRationalFeasibility_ball_accepts cases hresult : result with | accepted x => refine ⟨x, ?_, ?_⟩ - · simpa only [result] using hresult + · simpa only [result] using! hresult · exact runRationalFeasibility_acceptsOnly haccept - (by simpa only [result] using hresult) + (by simpa only [result] using! hresult) | exhausted E' => exfalso exact runRationalFeasibility_ball_not_exhausted hd hvalid c hR hr hKplus hKminus houterPlus houterMinus E' - (by simpa only [result] using hresult) + (by simpa only [result] using! hresult) end BeyondBethe diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseImm.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseImm.lean index d0a4ca5ebd..4f44e519da 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseImm.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseImm.lean @@ -79,7 +79,7 @@ theorem denseImmediateInstructionTM_hoareTime_frame (fun inp work out => inp = inp₀ ∧ work = initialWork ∧ out = out₀) (fun inp work out => inp = inp₀ ∧ work = valueWork ∧ out = out₀) (TM.binaryAddConstTime value 0) := by - simpa only [valueWork, zero_add] using hvalue + simpa only [valueWork, zero_add] using! hvalue have hquery : (TM.binaryAddConstTM tapes.update.entry.query destination).HoareTime (fun inp work out => inp = inp₀ ∧ work = valueWork ∧ out = out₀) @@ -92,7 +92,7 @@ theorem denseImmediateInstructionTM_hoareTime_frame rw [show valueWork tapes.update.entry.query = initialWork tapes.update.entry.query by exact Function.update_of_ne hqueryReplacement _ initialWork] - exact ⟨hinitial.scanner.queryStart, by simpa using hinitial.scanner.query⟩ + exact ⟨hinitial.scanner.queryStart, by simpa using! hinitial.scanner.query⟩ have hrun := TM.binaryAddConstTM_hoareTime_frame tapes.update.entry.query destination 0 inp₀ valueWork out₀ hqueryZero hinput @@ -100,15 +100,15 @@ theorem denseImmediateInstructionTM_hoareTime_frame by_cases hi : i = tapes.update.replacement · subst i have hnat := Tape.init_move_right_hasBinaryNat value - simpa only [valueWork, Function.update_self] using + simpa only [valueWork, Function.update_self] using! (show TM.Parked ((Tape.init (value.bits.map Γ.ofBool)).move Dir3.right) from ⟨by rw [hnat.2.1], hnat.2.hasBinaryContent.cells_ne_start⟩) - · simpa only [valueWork, Function.update_of_ne hi] using + · simpa only [valueWork, Function.update_of_ne hi] using! hinitial.scanner.parked i) houtputParked - simpa only [updateWork, zero_add] using hrun + simpa only [updateWork, zero_add] using! hrun have hready := immediateUpdate_ready_internal tapes overlay destination value initialWork hinitial have hupdate := taggedEntryUpdateTM_hoareTime_frame tapes.update overlay @@ -135,8 +135,8 @@ theorem denseImmediateInstructionTM_hoareTime_frame subst work obtain ⟨hi, hw, ho⟩ := phaseTransition_of_parked (inp := inp) (work := updateWork) (out := out) - (by simpa [hinp] using hinput) hready.2.2.2.2.2 - (by simpa [hout] using houtputParked) + (by simpa [hinp] using! hinput) hready.2.2.2.2.2 + (by simpa [hout] using! houtputParked) rw [hi, hw, ho] exact ⟨hinp, rfl, hout⟩) hupdate' @@ -152,20 +152,20 @@ theorem denseImmediateInstructionTM_hoareTime_frame by_cases hi : i = tapes.update.replacement · subst i have hnat := Tape.init_move_right_hasBinaryNat value - simpa only [valueWork, Function.update_self] using + simpa only [valueWork, Function.update_self] using! (show TM.Parked ((Tape.init (value.bits.map Γ.ofBool)).move Dir3.right) from ⟨by rw [hnat.2.1], hnat.2.hasBinaryContent.cells_ne_start⟩) - · simpa only [valueWork, Function.update_of_ne hi] using + · simpa only [valueWork, Function.update_of_ne hi] using! hinitial.scanner.parked i obtain ⟨hi, hw, ho⟩ := phaseTransition_of_parked (inp := inp) (work := valueWork) (out := out) - (by simpa [hinp] using hinput) hparked - (by simpa [hout] using houtputParked) + (by simpa [hinp] using! hinput) hparked + (by simpa [hout] using! houtputParked) rw [hi, hw, ho] exact ⟨hinp, rfl, hout⟩) hqueryUpdate - simpa [denseImmediateInstructionTM, denseImmediateInstructionTime] using hall + simpa [denseImmediateInstructionTM, denseImmediateInstructionTime] using! hall end Machine end RegisterStore diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseLoad.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseLoad.lean index 0d4417ff26..e098f94b93 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseLoad.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseLoad.lean @@ -90,18 +90,18 @@ private theorem denseIndirectLoaded_ready have hcountSource : (addressWork tapes.update.resultCount).HasBinaryNat overlay.length := by rw [show addressWork tapes.update.resultCount = - initialWork tapes.update.resultCount by simpa using haddress.countSource] - simpa using hinitial.countSource + initialWork tapes.update.resultCount by simpa using! haddress.countSource] + simpa using! hinitial.countSource refine { scanner := denseScanner_indirect_of_lhs tapes input overlay addressRegister initialWork addressWork haddress sourceStart := haddress.sourceStart sourceHead := haddress.sourceHead - count := by simpa using haddress.count - countSource := by simpa using hcountSource - querySource := by simpa using haddress.destination + count := by simpa using! haddress.count + countSource := by simpa using! hcountSource + querySource := by simpa using! haddress.destination destination := ?_ - copyScratch := by simpa using haddress.copyScratch } + copyScratch := by simpa using! haddress.copyScratch } change (addressWork tapes.update.replacement).HasBinaryNat 0 rw [hreplacementEq] exact hreplacement @@ -136,7 +136,7 @@ private theorem denseIndirectReads_hoareTime let inp₀ := (Tape.init (input.map Γ.ofBool)).move Dir3.right have hinput : TM.Parked inp₀ := by refine ⟨by simp [inp₀, Tape.move], ?_⟩ - simpa [inp₀] using Tape.init_ofBool_move_right_cells_ne_start input + simpa [inp₀] using! Tape.init_ofBool_move_right_cells_ne_start input have haddress := denseOverlayLookupStaticTM_hoareTime_internal tapes.lhsLookup input overlay addressRegister initialWork out₀ hvalid hinitial houtput @@ -174,12 +174,12 @@ private theorem denseIndirectReads_hoareTime rintro inp work out ⟨hinp, haddressResult, hout⟩ obtain ⟨hi, hw, ho⟩ := phaseTransition_of_parked (inp := inp) (work := work) (out := out) - (by simpa [inp₀, hinp] using hinput) haddressResult.parked - (by simpa [hout] using houtput) + (by simpa [inp₀, hinp] using! hinput) haddressResult.parked + (by simpa [hout] using! houtput) rw [hi, hw, ho] exact ⟨hinp, haddressResult, hout⟩) hloaded - simpa only [inp₀] using hall + simpa only [inp₀] using! hall /-- Exact semantic and time contract for one dense-overlay indirect load. -/ theorem denseIndirectLoadInstructionTM_hoareTime_frame @@ -209,7 +209,7 @@ theorem denseIndirectLoadInstructionTM_hoareTime_frame let inp₀ := (Tape.init (input.map Γ.ofBool)).move Dir3.right have hinput : TM.Parked inp₀ := by refine ⟨by simp [inp₀, Tape.move], ?_⟩ - simpa [inp₀] using Tape.init_ofBool_move_right_cells_ne_start input + simpa [inp₀] using! Tape.init_ofBool_move_right_cells_ne_start input have houtputParked := hasBinaryPrefix_parked houtput have hreads := denseIndirectReads_hoareTime tapes input overlay addressRegister initialWork out₀ hvalid hinitial hreplacement houtputParked @@ -239,17 +239,17 @@ theorem denseIndirectLoadInstructionTM_hoareTime_frame hloadedResult⟩, hout⟩ have hqueryZero : (work tapes.update.entry.query).HasBinaryNat 0 := ⟨hloadedResult.scanner.queryStart, by - simpa using hloadedResult.scanner.query⟩ + simpa using! hloadedResult.scanner.query⟩ have hrun := TM.binaryAddConstTM_hoareTime_frame tapes.update.entry.query destination 0 inp work out hqueryZero - (by simpa [hinp] using hinput) + (by simpa [hinp] using! hinput) (fun i _ => hloadedResult.parked i) - (by simpa [hout] using houtputParked) + (by simpa [hout] using! houtputParked) obtain ⟨final, time, htime, hreach, hhalt, hfinalInput, hfinalWork, hfinalOutput⟩ := hrun inp work out ⟨rfl, rfl, rfl⟩ exact ⟨final, time, htime, hreach, hhalt, hfinalInput.trans hinp, ⟨addressWork, work, haddressResult, hloadedResult, - by simpa only [zero_add] using hfinalWork⟩, + by simpa only [zero_add] using! hfinalWork⟩, hfinalOutput.trans hout⟩ have hupdate : (taggedEntryUpdateTM tapes.update).HoareTime (fun inp work out => @@ -297,23 +297,23 @@ theorem denseIndirectLoadInstructionTM_hoareTime_frame (loadedWork tapes.update.resultCount).HasBinaryNat overlay.length := by rw [show loadedWork tapes.update.resultCount = addressWork tapes.update.resultCount by - simpa using hloadedResult.countSource] + simpa using! hloadedResult.countSource] rw [show addressWork tapes.update.resultCount = initialWork tapes.update.resultCount by - simpa using haddressResult.countSource] - simpa using hinitial.countSource + simpa using! haddressResult.countSource] + simpa using! hinitial.countSource have hrun := taggedEntryUpdateTM_hoareTime_frame tapes.update overlay destination (DenseOverlay.read input overlay (DenseOverlay.read input overlay addressRegister)) emittedBits updateWork inp₀ out₀ hvalid.1 hscanner - (by simpa only [updateWork, Function.update_of_ne hreplacementNe] using + (by simpa only [updateWork, Function.update_of_ne hreplacementNe] using! hloadedResult.value) - (by simpa only [updateWork, Function.update_of_ne hremainingNe] using + (by simpa only [updateWork, Function.update_of_ne hremainingNe] using! hloadedResult.count) - (by simpa only [updateWork, Function.update_of_ne hfoundNe] using + (by simpa only [updateWork, Function.update_of_ne hfoundNe] using! hloadedResult.copyScratch) - (by simpa only [updateWork, Function.update_of_ne hresultCountNe] using + (by simpa only [updateWork, Function.update_of_ne hresultCountNe] using! hresultCount) hinput houtput obtain ⟨final, time, htime, hreach, hhalt, hfinalInput, @@ -335,8 +335,8 @@ theorem denseIndirectLoadInstructionTM_hoareTime_frame (inp := inp) (work := Function.update loadedWork tapes.update.entry.query ((Tape.init (destination.bits.map Γ.ofBool)).move Dir3.right)) - (out := out) (by simpa [hinp] using hinput) hparked - (by simpa [hout] using houtputParked) + (out := out) (by simpa [hinp] using! hinput) hparked + (by simpa [hout] using! houtputParked) rw [hi, hw, ho] exact ⟨hinp, ⟨addressWork, loadedWork, haddressResult, hloadedResult, rfl⟩, hout⟩) @@ -351,13 +351,13 @@ theorem denseIndirectLoadInstructionTM_hoareTime_frame hloadedResult⟩, hout⟩ obtain ⟨hi, hw, ho⟩ := phaseTransition_of_parked (inp := inp) (work := work) (out := out) - (by simpa [hinp] using hinput) hloadedResult.parked - (by simpa [hout] using houtputParked) + (by simpa [hinp] using! hinput) hloadedResult.parked + (by simpa [hout] using! houtputParked) rw [hi, hw, ho] exact ⟨hinp, ⟨addressWork, haddressResult, hloadedResult⟩, hout⟩) hqueryUpdate simpa [denseIndirectLoadInstructionTM, denseIndirectLoadInstructionTime, - inp₀] using hall + inp₀] using! hall end Machine end RegisterStore diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Direct.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Direct.lean index bd0d26ade5..485ee8fd19 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Direct.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Direct.lean @@ -80,20 +80,20 @@ theorem rhsReady_of_lhs_internal hlookup sourceStart := hlookup.sourceStart sourceHead := hlookup.sourceHead - count := by simpa using hlookup.count + count := by simpa using! hlookup.count countSource := ?_ - querySource := by simpa using hlookup.querySource + querySource := by simpa using! hlookup.querySource destination := by change (finalWork tapes.rhs).HasBinaryNat 0 rw [hrhsEq] exact hrhs - copyScratch := by simpa using hlookup.copyScratch } + copyScratch := by simpa using! hlookup.copyScratch } change (finalWork tapes.update.resultCount).HasBinaryNat store.length have hcountSource : finalWork tapes.update.resultCount = initialWork tapes.update.resultCount := by - simpa using hlookup.countSource + simpa using! hlookup.countSource rw [hcountSource] - simpa using hinitial.countSource + simpa using! hinitial.countSource theorem scanner_updateQuery_internal (tapes : BinaryInstructionTapes n) (store : Store) (destination : ℕ) @@ -145,34 +145,34 @@ theorem scanner_updateQuery_internal resultStart := ?_ parked := ?_ frame := by intro i _ _ _ _ _ _ _ _ _; rfl } - · simpa only [finalWork, Function.update_of_ne hsource] using hscanner.source - · simpa only [finalWork, Function.update_of_ne haddress] using hscanner.address - · simpa only [finalWork, Function.update_of_ne haddress] using + · simpa only [finalWork, Function.update_of_ne hsource] using! hscanner.source + · simpa only [finalWork, Function.update_of_ne haddress] using! hscanner.address + · simpa only [finalWork, Function.update_of_ne haddress] using! hscanner.addressStart - · simpa only [finalWork, Function.update_of_ne hvalue] using hscanner.value - · simpa only [finalWork, Function.update_of_ne hvalue] using + · simpa only [finalWork, Function.update_of_ne hvalue] using! hscanner.value + · simpa only [finalWork, Function.update_of_ne hvalue] using! hscanner.valueStart - · simpa only [finalWork, Function.update_of_ne haddressCounter] using + · simpa only [finalWork, Function.update_of_ne haddressCounter] using! hscanner.addressCounter - · simpa only [finalWork, Function.update_of_ne haddressWidth] using + · simpa only [finalWork, Function.update_of_ne haddressWidth] using! hscanner.addressWidth - · simpa only [finalWork, Function.update_of_ne hvalueCounter] using + · simpa only [finalWork, Function.update_of_ne hvalueCounter] using! hscanner.valueCounter - · simpa only [finalWork, Function.update_of_ne hvalueWidth] using + · simpa only [finalWork, Function.update_of_ne hvalueWidth] using! hscanner.valueWidth - · simpa only [finalWork, Function.update_self] using hnat.2 - · simpa only [finalWork, Function.update_self] using hnat.1 - · simpa only [finalWork, Function.update_of_ne hresult] using hscanner.result - · simpa only [finalWork, Function.update_of_ne hresult] using + · simpa only [finalWork, Function.update_self] using! hnat.2 + · simpa only [finalWork, Function.update_self] using! hnat.1 + · simpa only [finalWork, Function.update_of_ne hresult] using! hscanner.result + · simpa only [finalWork, Function.update_of_ne hresult] using! hscanner.resultStart · intro i by_cases hi : i = tapes.update.entry.query · subst i - simpa only [finalWork, Function.update_self] using + simpa only [finalWork, Function.update_self] using! (show TM.Parked ((Tape.init (destination.bits.map Γ.ofBool)).move Dir3.right) from ⟨by rw [hnat.2.1], hnat.2.hasBinaryContent.cells_ne_start⟩) - · simpa only [finalWork, Function.update_of_ne hi] using hscanner.parked i + · simpa only [finalWork, Function.update_of_ne hi] using! hscanner.parked i private theorem directAddress_ready (tapes : BinaryInstructionTapes n) (store : Store) @@ -194,7 +194,7 @@ private theorem directAddress_ready (operandsWork tapes.lhs).HasBinaryNat (RegisterStore.read store source₀) := by rw [hlhsEq] - simpa using hlhs.destination + simpa using! hlhs.destination have hreplacementEq : operandsWork tapes.update.replacement = initialWork tapes.update.replacement := by @@ -215,10 +215,10 @@ private theorem directAddress_ready have hresultCount : (operandsWork tapes.update.resultCount).HasBinaryNat store.length := by rw [show operandsWork tapes.update.resultCount = - lhsWork tapes.update.resultCount by simpa using hrhs.countSource] + lhsWork tapes.update.resultCount by simpa using! hrhs.countSource] rw [show lhsWork tapes.update.resultCount = - initialWork tapes.update.resultCount by simpa using hlhs.countSource] - simpa using hinitial.countSource + initialWork tapes.update.resultCount by simpa using! hlhs.countSource] + simpa using! hinitial.countSource have hqueryNeLhs : tapes.lhs ≠ tapes.update.entry.query := tapes.ne (by decide) have hqueryNeRhs : tapes.rhs ≠ tapes.update.entry.query := @@ -253,16 +253,16 @@ private theorem directAddress_ready found := ?_ resultCount := ?_ parked := ?_ } - · simpa only [Function.update_of_ne hqueryNeLhs] using hlhsValue - · simpa only [Function.update_of_ne hqueryNeRhs] using hrhs.destination + · simpa only [Function.update_of_ne hqueryNeLhs] using! hlhsValue + · simpa only [Function.update_of_ne hqueryNeRhs] using! hrhs.destination · simpa only [Function.update_of_ne hqueryNeReplacement, hreplacementEq] - using hreplacement - · simpa only [Function.update_of_ne hqueryNeShift] using hrhs.querySource - · simpa only [Function.update_of_ne hqueryNeTmp, htmpEq] using htmp - · simpa only [Function.update_of_ne hqueryNeDbl, hdblEq] using hdbl - · simpa only [Function.update_of_ne hqueryNeRemaining] using hrhs.count - · simpa only [Function.update_of_ne hqueryNeFound] using hrhs.copyScratch - · simpa only [Function.update_of_ne hqueryNeResultCount] using hresultCount + using! hreplacement + · simpa only [Function.update_of_ne hqueryNeShift] using! hrhs.querySource + · simpa only [Function.update_of_ne hqueryNeTmp, htmpEq] using! htmp + · simpa only [Function.update_of_ne hqueryNeDbl, hdblEq] using! hdbl + · simpa only [Function.update_of_ne hqueryNeRemaining] using! hrhs.count + · simpa only [Function.update_of_ne hqueryNeFound] using! hrhs.copyScratch + · simpa only [Function.update_of_ne hqueryNeResultCount] using! hresultCount · exact (scanner_updateQuery_internal tapes store destination operandsWork hrhs.scanner).parked @@ -337,8 +337,8 @@ theorem directBinaryOperands_hoareTime_internal rintro inp work out ⟨hinp, hlhsResult, hout⟩ obtain ⟨hi, hw, ho⟩ := phaseTransition_of_parked (inp := inp) (work := work) (out := out) - (by simpa [hinp] using hinput) hlhsResult.parked - (by simpa [hout] using houtput) + (by simpa [hinp] using! hinput) hlhsResult.parked + (by simpa [hout] using! houtput) rw [hi, hw, ho] exact ⟨hinp, hlhsResult, hout⟩) hrhs @@ -414,19 +414,19 @@ theorem directBinaryInstructionTM_hoareTime_frame_internal have hquery : (work tapes.update.entry.query).HasBinaryNat 0 := by refine ⟨?_, ?_⟩ · exact hrhsResult.scanner.queryStart - · simpa using hrhsResult.scanner.query + · simpa using! hrhsResult.scanner.query have hrun := TM.binaryAddConstTM_hoareTime_frame tapes.update.entry.query destination 0 inp work out hquery - (by simpa [hinp] using hinput) + (by simpa [hinp] using! hinput) (fun i _ => hrhsResult.parked i) - (by simpa [hout] using houtputParked) + (by simpa [hout] using! houtputParked) obtain ⟨final, time, htime, hreach, hhalt, hfinalInput, hfinalWork, hfinalOutput⟩ := hrun inp work out ⟨rfl, rfl, rfl⟩ refine ⟨final, time, htime, hreach, hhalt, hfinalInput.trans hinp, ?_, hfinalOutput.trans hout⟩ exact ⟨work, ⟨lhsWork, hlhsResult, hrhsResult⟩, - by simpa only [zero_add] using hfinalWork⟩ + by simpa only [zero_add] using! hfinalWork⟩ have hupdate : (binaryInstructionUpdateTM tapes op).HoareTime (fun inp work out => inp = inp₀ ∧ @@ -469,8 +469,8 @@ theorem directBinaryInstructionTM_hoareTime_frame_internal haddressResult obtain ⟨hi, hw, ho⟩ := phaseTransition_of_parked (inp := inp) (work := work) (out := out) - (by simpa [hinp] using hinput) hready.parked - (by simpa [hout] using houtputParked) + (by simpa [hinp] using! hinput) hready.parked + (by simpa [hout] using! houtputParked) rw [hi, hw, ho] exact ⟨hinp, haddressResult, hout⟩) hupdate @@ -483,8 +483,8 @@ theorem directBinaryInstructionTM_hoareTime_frame_internal rcases operands with ⟨lhsWork, hlhsResult, hrhsResult⟩ obtain ⟨hi, hw, ho⟩ := phaseTransition_of_parked (inp := inp) (work := work) (out := out) - (by simpa [hinp] using hinput) hrhsResult.parked - (by simpa [hout] using houtputParked) + (by simpa [hinp] using! hinput) hrhsResult.parked + (by simpa [hout] using! houtputParked) rw [hi, hw, ho] exact ⟨hinp, ⟨lhsWork, hlhsResult, hrhsResult⟩, hout⟩) haddressUpdate @@ -497,12 +497,12 @@ theorem directBinaryInstructionTM_hoareTime_frame_internal rintro inp work out ⟨hinp, hlhsResult, hout⟩ obtain ⟨hi, hw, ho⟩ := phaseTransition_of_parked (inp := inp) (work := work) (out := out) - (by simpa [hinp] using hinput) hlhsResult.parked - (by simpa [hout] using houtputParked) + (by simpa [hinp] using! hinput) hlhsResult.parked + (by simpa [hout] using! houtputParked) rw [hi, hw, ho] exact ⟨hinp, hlhsResult, hout⟩) hrhsRest - simpa [directBinaryInstructionTM, directBinaryInstructionTime] using hall + simpa [directBinaryInstructionTM, directBinaryInstructionTime] using! hall end Machine diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/LastBit.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/LastBit.lean index f5a68451ae..41e45d6527 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/LastBit.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/LastBit.lean @@ -41,7 +41,7 @@ theorem program_performance (target : Bool) (bits : List Bool) : cost ≤ timeBound target bits.length ∧ space ≤ spaceBound target bits.length ∧ final verdictReg = Input.bitValue (decide (bits.getLast? = some target)) := by - simpa [spec, lastBit_fold_eq_getLast?] using + simpa [spec, lastBit_fold_eq_getLast?] using! Scanner.typed_program_performance (spec target) bits /-- End-to-end compiled performance and language correctness. -/ @@ -68,7 +68,7 @@ theorem compiled_performance (target : Bool) (bits : List Bool) : rw [show (run (compiled target) (stepCount target bits.length) { pc := 0, regs := inputStore target bits }).regs verdictReg = Input.bitValue (decide (bits.getLast? = some target)) by - simpa [spec, lastBit_fold_eq_getLast?] using hresult] + simpa [spec, lastBit_fold_eq_getLast?] using! hresult] simp [Input.bitValue] /-- The explicit time budget is quasilinear. -/ From 1f78390c09df9f5b8d09737e57ec5b7ca86a7e37 Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Tue, 22 Sep 2026 02:29:32 +0000 Subject: [PATCH 15/49] Update certified pair accuracy and directed objective proofs --- .../BeyondBethe/CertifiedPairWeights.lean | 4 +- .../BeyondBethe/DirectedOptimizerOracle.lean | 3 +- .../BeyondBethe/MachineFPBasics.lean | 2 +- .../BeyondBethe/RationalEncodingBounds.lean | 14 +-- .../Machine/Instruction/DenseDirect.lean | 50 +++++----- .../Machine/Instruction/Store.lean | 98 +++++++++---------- 6 files changed, 87 insertions(+), 84 deletions(-) diff --git a/LeanPool/BeyondBethe/BeyondBethe/CertifiedPairWeights.lean b/LeanPool/BeyondBethe/BeyondBethe/CertifiedPairWeights.lean index 71a4b7280e..a45ac3d4e1 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/CertifiedPairWeights.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/CertifiedPairWeights.lean @@ -270,7 +270,9 @@ theorem directedPairCostPrecision_error_le (n : ℕ) : 4 * (n + 3 : ℝ) * ((1 / 2 : ℝ) ^ n * (1 / 1048576 : ℝ)) := by gcongr - norm_num + exact (pow_le_pow_of_le_one (by norm_num : (0 : ℝ) ≤ 1 / 2) + (by norm_num : (1 / 2 : ℝ) ≤ 1) (show 20 ≤ 400 by omega)).trans_eq + (by norm_num) _ ≤ 4 * (4 * (2 : ℝ) ^ n) * ((1 / 2 : ℝ) ^ n * (1 / 1048576 : ℝ)) := by gcongr diff --git a/LeanPool/BeyondBethe/BeyondBethe/DirectedOptimizerOracle.lean b/LeanPool/BeyondBethe/BeyondBethe/DirectedOptimizerOracle.lean index 7397e4e391..61f598813f 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/DirectedOptimizerOracle.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/DirectedOptimizerOracle.lean @@ -262,7 +262,8 @@ theorem directedNegativeObjective_bounds 3 * (n : ℝ) ^ 2 * (((1 / 2 : ℚ) ^ p : ℚ) : ℝ) := by have hcoord := fun i j ↦ directedNegativeObjectiveCoordinate_bounds hτ0 hτ1 (hA i j) (hX0 i j) (hX1 i j) p - rw [regularizedBetheObjective_eq_sum_coordinates] + rw [regularizedBetheObjective_eq_sum_coordinates (τ : ℝ) + (fun i j => (A i j : ℝ)) (fun i j => (X i j : ℝ))] have hexact : -(∑ i, ∑ j, regularizedBetheCoordinate (τ : ℝ) (A i j : ℝ) (X i j : ℝ)) = diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineFPBasics.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineFPBasics.lean index 047e3c1789..3520900921 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineFPBasics.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineFPBasics.lean @@ -46,7 +46,7 @@ theorem machineZeroBlock_mem_FP : theorem machineCompose_mem_FP {f g : List Bool → List Bool} (hf : f ∈ Complexity.FP) (hg : g ∈ Complexity.FP) : (fun word => g (f word)) ∈ Complexity.FP := by - simpa only [Function.comp_apply] using mem_FP_comp hf hg + simpa only [Function.comp_apply] using! mem_FP_comp hf hg theorem machinePair_mem_FP {left right : List Bool → List Bool} (hleft : left ∈ Complexity.FP) (hright : right ∈ Complexity.FP) : diff --git a/LeanPool/BeyondBethe/BeyondBethe/RationalEncodingBounds.lean b/LeanPool/BeyondBethe/BeyondBethe/RationalEncodingBounds.lean index 81dbed9bc8..38367fd29a 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/RationalEncodingBounds.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/RationalEncodingBounds.lean @@ -42,7 +42,7 @@ theorem nat_encodedBitLength_le (n : ℕ) : have hb := bool_dataEncode_size_le_four b omega have hadd := Nat.add_le_add_left hsum 2 - simpa only [Function.comp_apply, Nat.size_eq_bits_len] using hadd + simpa only [Function.comp_apply, Nat.size_eq_bits_len] using! hadd theorem integer_encodedBitLength_le (z : ℤ) : encodedBitLength ℤ z ≤ 8 + 4 * z.natAbs.size := by @@ -59,7 +59,7 @@ theorem integer_encodedBitLength_le (z : ℤ) : rw [encodedBitLength_eq_dataSize] at hn have hn' : (DataEncode.encode (integerPayload z).2).size ≤ 2 + 4 * z.natAbs.size := by - simpa only [integerPayload_snd] using hn + simpa only [integerPayload_snd] using! hn omega theorem rational_encodedBitLength_le (q : ℚ) : @@ -69,7 +69,7 @@ theorem rational_encodedBitLength_le (q : ℚ) : change (DataEncode.encode (rationalPayload q)).size ≤ _ rw [show DataEncode.encode (rationalPayload q) = Data.l [DataEncode.encode q.num, DataEncode.encode q.den] by - simpa only [rationalPayload] using DataEncode_pair q.num q.den] + simpa only [rationalPayload] using! DataEncode_pair q.num q.den] simp only [Data.size, List.map_cons, List.map_nil, List.sum_cons, List.sum_nil, add_zero] have hz := integer_encodedBitLength_le q.num @@ -107,7 +107,7 @@ theorem rat_num_natAbs_le_of_abs_and_den_bounds (2 : ℚ) ^ K * q.den := by rw [rat_abs_eq_numNatAbs_div_den] at habs rw [div_le_iff₀ (by positivity : (0 : ℚ) < q.den)] at habs - simpa only [mul_comm] using habs + simpa only [mul_comm] using! habs have hboundQ : (q.num.natAbs : ℚ) ≤ (2 : ℚ) ^ (K + P) := by calc (q.num.natAbs : ℚ) ≤ (2 : ℚ) ^ K * q.den := hnumQ @@ -177,7 +177,7 @@ theorem roundedEllipsoidInflationFactor_den_dvd (d : ℕ) : exact_mod_cast hdenZ have hadd : (1 + roundedEllipsoidInflation d).den ∣ (roundedEllipsoidInflation d).den := by - simpa using Rat.add_den_dvd (1 : ℚ) (roundedEllipsoidInflation d) + simpa using! Rat.add_den_dvd (1 : ℚ) (roundedEllipsoidInflation d) exact hadd.trans hden theorem roundedEllipsoidInflationFactor_den_le {d : ℕ} (hd : 0 < d) : @@ -408,12 +408,12 @@ theorem adaptiveRoundedEllipsoid_state_encodedBitLength_le ((adaptiveRoundedEllipsoid U).center i)) ≤ d * (20 + 4 * K + 8 * P) := by simpa only [Finset.sum_const, Finset.card_univ, Fintype.card_fin, - nsmul_eq_mul] using hc + nsmul_eq_mul] using! hc have hB' : (∑ i : Fin d, ∑ j : Fin d, encodedBitLength ℚ ((adaptiveRoundedEllipsoid U).basis i j)) ≤ d * (d * (100 + 4 * K + 8 * P + 32 * d)) := by simpa only [Finset.sum_const, Finset.card_univ, Fintype.card_fin, - nsmul_eq_mul] using hB + nsmul_eq_mul] using! hB calc 6 + (∑ i, encodedBitLength ℚ ((adaptiveRoundedEllipsoid U).center i)) + 2 * d + diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseDirect.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseDirect.lean index 618442e810..016a1020cb 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseDirect.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseDirect.lean @@ -94,18 +94,18 @@ private theorem denseRhsReady_of_lhs finalWork hlookup sourceStart := hlookup.sourceStart sourceHead := hlookup.sourceHead - count := by simpa using hlookup.count + count := by simpa using! hlookup.count countSource := ?_ - querySource := by simpa using hlookup.querySource + querySource := by simpa using! hlookup.querySource destination := by change (finalWork tapes.rhs).HasBinaryNat 0 rw [hrhsEq] exact hrhs - copyScratch := by simpa using hlookup.copyScratch } + copyScratch := by simpa using! hlookup.copyScratch } change (finalWork tapes.update.resultCount).HasBinaryNat overlay.length rw [show finalWork tapes.update.resultCount = - initialWork tapes.update.resultCount by simpa using hlookup.countSource] - simpa using hinitial.countSource + initialWork tapes.update.resultCount by simpa using! hlookup.countSource] + simpa using! hinitial.countSource /-- Two fixed dense-overlay reads compose while retaining the shared scanner ABI and the immutable input tape. -/ @@ -133,7 +133,7 @@ theorem denseDirectBinaryOperands_hoareTime let inp₀ := (Tape.init (input.map Γ.ofBool)).move Dir3.right have hinput : TM.Parked inp₀ := by refine ⟨by simp [inp₀, Tape.move], ?_⟩ - simpa [inp₀] using Tape.init_ofBool_move_right_cells_ne_start input + simpa [inp₀] using! Tape.init_ofBool_move_right_cells_ne_start input have hlhs := denseOverlayLookupStaticTM_hoareTime_internal tapes.lhsLookup input overlay source₀ initialWork out₀ hvalid hinitial houtput have hrhs : (denseOverlayLookupStaticTM tapes.rhsLookup source₁).HoareTime @@ -164,12 +164,12 @@ theorem denseDirectBinaryOperands_hoareTime rintro inp work out ⟨hinp, hlhsResult, hout⟩ obtain ⟨hi, hw, ho⟩ := phaseTransition_of_parked (inp := inp) (work := work) (out := out) - (by simpa [inp₀, hinp] using hinput) hlhsResult.parked - (by simpa [hout] using houtput) + (by simpa [inp₀, hinp] using! hinput) hlhsResult.parked + (by simpa [hout] using! houtput) rw [hi, hw, ho] exact ⟨hinp, hlhsResult, hout⟩) hrhs - simpa only [inp₀] using hall + simpa only [inp₀] using! hall private theorem denseDirectAddress_ready (tapes : BinaryInstructionTapes n) (input : List Bool) @@ -213,10 +213,10 @@ private theorem denseDirectAddress_ready have hresultCount : (operandsWork tapes.update.resultCount).HasBinaryNat overlay.length := by rw [show operandsWork tapes.update.resultCount = - lhsWork tapes.update.resultCount by simpa using hrhs.countSource] + lhsWork tapes.update.resultCount by simpa using! hrhs.countSource] rw [show lhsWork tapes.update.resultCount = - initialWork tapes.update.resultCount by simpa using hlhs.countSource] - simpa using hinitial.countSource + initialWork tapes.update.resultCount by simpa using! hlhs.countSource] + simpa using! hinitial.countSource have hqueryNe (i : Fin n) (h : i ≠ tapes.update.entry.query) : Function.update operandsWork tapes.update.entry.query ((Tape.init (destination.bits.map Γ.ofBool)).move Dir3.right) i = @@ -404,13 +404,13 @@ theorem denseBinaryInstructionUpdateTM_hoareTime_frame rintro inp work out ⟨hinp, harith, hout⟩ obtain ⟨hi, hw, ho⟩ := phaseTransition_of_parked (inp := inp) (work := work) (out := out) - (by simpa [hinp] using hinput) harith.parked - (by simpa [hout] using hasBinaryPrefix_parked houtput) + (by simpa [hinp] using! hinput) harith.parked + (by simpa [hout] using! hasBinaryPrefix_parked houtput) rw [hi, hw, ho] exact ⟨hinp, harith, hout⟩) hupdate simpa [denseBinaryInstructionUpdateTM, - denseBinaryInstructionUpdateTime] using hall + denseBinaryInstructionUpdateTime] using! hall /-- Two dense reads, direct destination synthesis, arithmetic, successor tagging, and sparse update implement one RAM arithmetic instruction. -/ @@ -444,7 +444,7 @@ theorem denseDirectBinaryInstructionTM_hoareTime_frame let inp₀ := (Tape.init (input.map Γ.ofBool)).move Dir3.right have hinput : TM.Parked inp₀ := by refine ⟨by simp [inp₀, Tape.move], ?_⟩ - simpa [inp₀] using Tape.init_ofBool_move_right_cells_ne_start input + simpa [inp₀] using! Tape.init_ofBool_move_right_cells_ne_start input have houtputParked := hasBinaryPrefix_parked houtput have hoperands := denseDirectBinaryOperands_hoareTime tapes input overlay source₀ source₁ initialWork out₀ hvalid hinitial hrhs₀ houtputParked @@ -462,17 +462,17 @@ theorem denseDirectBinaryInstructionTM_hoareTime_frame rintro inp work out ⟨hinp, operands, hout⟩ rcases operands with ⟨lhsWork, hlhsResult, hrhsResult⟩ have hquery : (work tapes.update.entry.query).HasBinaryNat 0 := - ⟨hrhsResult.scanner.queryStart, by simpa using hrhsResult.scanner.query⟩ + ⟨hrhsResult.scanner.queryStart, by simpa using! hrhsResult.scanner.query⟩ have hrun := TM.binaryAddConstTM_hoareTime_frame tapes.update.entry.query destination 0 inp work out hquery - (by simpa [hinp] using hinput) + (by simpa [hinp] using! hinput) (fun i _ => hrhsResult.parked i) - (by simpa [hout] using houtputParked) + (by simpa [hout] using! houtputParked) obtain ⟨final, time, htime, hreach, hhalt, hfinalInput, hfinalWork, hfinalOutput⟩ := hrun inp work out ⟨rfl, rfl, rfl⟩ exact ⟨final, time, htime, hreach, hhalt, hfinalInput.trans hinp, ⟨work, ⟨lhsWork, hlhsResult, hrhsResult⟩, - by simpa only [zero_add] using hfinalWork⟩, + by simpa only [zero_add] using! hfinalWork⟩, hfinalOutput.trans hout⟩ have hupdate : (denseBinaryInstructionUpdateTM tapes op).HoareTime (fun inp work out => @@ -517,9 +517,9 @@ theorem denseDirectBinaryInstructionTM_hoareTime_frame rcases hready with ⟨_, _, _, _, _, _, _, _, _, _, hparked⟩ obtain ⟨hi, hw, ho⟩ := phaseTransition_of_parked (inp := inp) (work := work) (out := out) - (by simpa [hinp] using hinput) + (by simpa [hinp] using! hinput) hparked - (by simpa [hout] using houtputParked) + (by simpa [hout] using! houtputParked) rw [hi, hw, ho] exact ⟨hinp, haddressResult, hout⟩) hupdate @@ -533,13 +533,13 @@ theorem denseDirectBinaryInstructionTM_hoareTime_frame rcases operands with ⟨lhsWork, hlhsResult, hrhsResult⟩ obtain ⟨hi, hw, ho⟩ := phaseTransition_of_parked (inp := inp) (work := work) (out := out) - (by simpa [hinp] using hinput) hrhsResult.parked - (by simpa [hout] using houtputParked) + (by simpa [hinp] using! hinput) hrhsResult.parked + (by simpa [hout] using! houtputParked) rw [hi, hw, ho] exact ⟨hinp, ⟨lhsWork, hlhsResult, hrhsResult⟩, hout⟩) haddressUpdate simpa [denseDirectBinaryInstructionTM, denseDirectBinaryInstructionTime, - inp₀] using hall + inp₀] using! hall end Machine end RegisterStore diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Store.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Store.lean index f02bef4fbe..696e954958 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Store.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Store.lean @@ -60,10 +60,10 @@ private theorem storeOperands_values have hlhsEq : operandsWork tapes.lhs = lhsWork tapes.lhs := hrhs.frame tapes.lhs (fun slot => (tapes.rhsLookup_ne_lhs slot).symm) - refine ⟨?_, by simpa using hrhs.destination, by simpa using hrhs.copyScratch, + refine ⟨?_, by simpa using! hrhs.destination, by simpa using! hrhs.copyScratch, hrhs.parked⟩ rw [hlhsEq] - simpa using hlhs.destination + simpa using! hlhs.destination private theorem storeUpdate_ready (tapes : BinaryInstructionTapes n) (store : Store) @@ -156,67 +156,67 @@ private theorem storeUpdate_ready { source := by simpa only [updateWork, queryWork, Function.update_of_ne hsourceReplacement, - Function.update_of_ne hsourceQuery] using hrhs.scanner.source + Function.update_of_ne hsourceQuery] using! hrhs.scanner.source address := by simpa only [updateWork, queryWork, Function.update_of_ne haddressReplacement, - Function.update_of_ne haddressQuery] using hrhs.scanner.address + Function.update_of_ne haddressQuery] using! hrhs.scanner.address addressStart := by simpa only [updateWork, queryWork, Function.update_of_ne haddressReplacement, - Function.update_of_ne haddressQuery] using + Function.update_of_ne haddressQuery] using! hrhs.scanner.addressStart value := by simpa only [updateWork, queryWork, Function.update_of_ne hvalueReplacement, - Function.update_of_ne hvalueQuery] using hrhs.scanner.value + Function.update_of_ne hvalueQuery] using! hrhs.scanner.value valueStart := by simpa only [updateWork, queryWork, Function.update_of_ne hvalueReplacement, - Function.update_of_ne hvalueQuery] using hrhs.scanner.valueStart + Function.update_of_ne hvalueQuery] using! hrhs.scanner.valueStart addressCounter := by simpa only [updateWork, queryWork, Function.update_of_ne haddressCounterReplacement, - Function.update_of_ne haddressCounterQuery] using + Function.update_of_ne haddressCounterQuery] using! hrhs.scanner.addressCounter addressWidth := by simpa only [updateWork, queryWork, Function.update_of_ne haddressWidthReplacement, - Function.update_of_ne haddressWidthQuery] using + Function.update_of_ne haddressWidthQuery] using! hrhs.scanner.addressWidth valueCounter := by simpa only [updateWork, queryWork, Function.update_of_ne hvalueCounterReplacement, - Function.update_of_ne hvalueCounterQuery] using + Function.update_of_ne hvalueCounterQuery] using! hrhs.scanner.valueCounter valueWidth := by simpa only [updateWork, queryWork, Function.update_of_ne hvalueWidthReplacement, - Function.update_of_ne hvalueWidthQuery] using + Function.update_of_ne hvalueWidthQuery] using! hrhs.scanner.valueWidth query := by simpa only [updateWork, Function.update_of_ne hqueryReplacement, queryWork, - Function.update_self, queryTape] using hqueryNat.2 + Function.update_self, queryTape] using! hqueryNat.2 queryStart := by simpa only [updateWork, Function.update_of_ne hqueryReplacement, queryWork, - Function.update_self, queryTape] using hqueryNat.1 + Function.update_self, queryTape] using! hqueryNat.1 result := by simpa only [updateWork, queryWork, Function.update_of_ne hresultReplacement, - Function.update_of_ne hresultQuery] using hrhs.scanner.result + Function.update_of_ne hresultQuery] using! hrhs.scanner.result resultStart := by simpa only [updateWork, queryWork, Function.update_of_ne hresultReplacement, - Function.update_of_ne hresultQuery] using + Function.update_of_ne hresultQuery] using! hrhs.scanner.resultStart parked := ?_ frame := by intro i _ _ _ _ _ _ _ _ _; rfl } intro i by_cases hiReplacement : i = tapes.update.replacement · subst i - simpa only [updateWork, Function.update_self, valueTape] using + simpa only [updateWork, Function.update_self, valueTape] using! (show TM.Parked valueTape from ⟨by rw [hvalueNat.2.1], hvalueNat.2.hasBinaryContent.cells_ne_start⟩) @@ -225,19 +225,19 @@ private theorem storeUpdate_ready rw [hiUpdate] by_cases hiQuery : i = tapes.update.entry.query · subst i - simpa only [queryWork, Function.update_self, queryTape] using + simpa only [queryWork, Function.update_self, queryTape] using! (show TM.Parked queryTape from ⟨by rw [hqueryNat.2.1], hqueryNat.2.hasBinaryContent.cells_ne_start⟩) - · simpa only [queryWork, Function.update_of_ne hiQuery] using + · simpa only [queryWork, Function.update_of_ne hiQuery] using! hrhs.parked i have hresultCount : (operandsWork tapes.update.resultCount).HasBinaryNat store.length := by rw [show operandsWork tapes.update.resultCount = - lhsWork tapes.update.resultCount by simpa using hrhs.countSource] + lhsWork tapes.update.resultCount by simpa using! hrhs.countSource] rw [show lhsWork tapes.update.resultCount = - initialWork tapes.update.resultCount by simpa using hlhs.countSource] - simpa using hinitial.countSource + initialWork tapes.update.resultCount by simpa using! hlhs.countSource] + simpa using! hinitial.countSource have hremainingReplacement : tapes.update.remaining ≠ tapes.update.replacement := tapes.update.ne (by decide) @@ -256,17 +256,17 @@ private theorem storeUpdate_ready tapes.update.resultCount ≠ tapes.update.entry.query := tapes.update.ne (by decide) refine ⟨hscanner, ?_, ?_, ?_, ?_, hscanner.parked⟩ - · simpa only [updateWork, Function.update_self, valueTape] using hvalueNat + · simpa only [updateWork, Function.update_self, valueTape] using! hvalueNat · simpa only [updateWork, Function.update_of_ne hremainingReplacement, queryWork, - Function.update_of_ne hremainingQuery] using hrhs.count + Function.update_of_ne hremainingQuery] using! hrhs.count · simpa only [updateWork, Function.update_of_ne hfoundReplacement, queryWork, - Function.update_of_ne hfoundQuery] using + Function.update_of_ne hfoundQuery] using! hrhs.copyScratch · simpa only [updateWork, Function.update_of_ne hresultCountReplacement, queryWork, - Function.update_of_ne hresultCountQuery] using hresultCount + Function.update_of_ne hresultCountQuery] using! hresultCount /-- Exact semantic and time contract for one indirect sparse store. -/ theorem indirectStoreInstructionTM_hoareTime_frame_internal @@ -320,18 +320,18 @@ theorem indirectStoreInstructionTM_hoareTime_frame_internal have hrun := TM.binaryCopyIntoTM_hoareTime_frame tapes.lhs tapes.update.entry.query tapes.update.found (tapes.ne (by decide)) (tapes.ne (by decide)) (tapes.update.ne (by decide)) address 0 inp work - out (by simpa [address] using hvalues.1) + out (by simpa [address] using! hvalues.1) ⟨(by rcases hops with ⟨_, _, hrhs⟩; exact hrhs.scanner.queryStart), (by rcases hops with ⟨_, _, hrhs⟩; - simpa using hrhs.scanner.query)⟩ - hvalues.2.2.1 (by simpa [hinp] using hinput) + simpa using! hrhs.scanner.query)⟩ + hvalues.2.2.1 (by simpa [hinp] using! hinput) (fun i _ _ _ => hvalues.2.2.2 i) - (by simpa [hout] using houtputParked) + (by simpa [hout] using! houtputParked) obtain ⟨final, time, htime, hreach, hhalt, hfinalInput, hfinalWork, hfinalOutput⟩ := hrun inp work out ⟨rfl, rfl, rfl⟩ exact ⟨final, time, htime, hreach, hhalt, hfinalInput.trans hinp, - ⟨work, hops, by simpa [address] using hfinalWork⟩, + ⟨work, hops, by simpa [address] using! hfinalWork⟩, hfinalOutput.trans hout⟩ have hvalue : (TM.binaryCopyIntoTM tapes.rhs tapes.update.replacement @@ -373,7 +373,7 @@ theorem indirectStoreInstructionTM_hoareTime_frame_internal (tapes.ne (by decide)) (tapes.update.ne (by decide)) value 0 inp queryWork out (by simpa only [queryWork, - Function.update_of_ne hrhsQuery, value] using hvalues.2.1) + Function.update_of_ne hrhsQuery, value] using! hvalues.2.1) (by have hreplEq : operandsWork tapes.update.replacement = initialWork tapes.update.replacement := by @@ -383,28 +383,28 @@ theorem indirectStoreInstructionTM_hoareTime_frame_internal exact hlhs.frame tapes.update.replacement (fun slot => (tapes.lhsLookup_ne_replacement slot).symm) simpa only [queryWork, - Function.update_of_ne hreplacementQuery, hreplEq] using + Function.update_of_ne hreplacementQuery, hreplEq] using! hreplacement) (by simpa only [queryWork, - Function.update_of_ne hfoundQuery] using hvalues.2.2.1) - (by simpa [hinp] using hinput) + Function.update_of_ne hfoundQuery] using! hvalues.2.2.1) + (by simpa [hinp] using! hinput) (fun i _ _ _ => by by_cases hi : i = tapes.update.entry.query · subst i have hnat := Tape.init_move_right_hasBinaryNat address - simpa only [queryWork, Function.update_self] using + simpa only [queryWork, Function.update_self] using! (show TM.Parked ((Tape.init (address.bits.map Γ.ofBool)).move Dir3.right) from ⟨by rw [hnat.2.1], hnat.2.hasBinaryContent.cells_ne_start⟩) - · simpa only [queryWork, Function.update_of_ne hi] using + · simpa only [queryWork, Function.update_of_ne hi] using! hvalues.2.2.2 i) - (by simpa [hout] using houtputParked) + (by simpa [hout] using! houtputParked) obtain ⟨final, time, htime, hreach, hhalt, hfinalInput, hfinalWork, hfinalOutput⟩ := hrun inp queryWork out ⟨rfl, rfl, rfl⟩ exact ⟨final, time, htime, hreach, hhalt, hfinalInput.trans hinp, ⟨operandsWork, queryWork, hops, rfl, - by simpa [value] using hfinalWork⟩, + by simpa [value] using! hfinalWork⟩, hfinalOutput.trans hout⟩ have hupdate : (entryUpdateTM tapes.update).HoareTime (fun inp work out => @@ -446,7 +446,7 @@ theorem indirectStoreInstructionTM_hoareTime_frame_internal ⟨operandsWork, Function.update operandsWork tapes.update.entry.query ((Tape.init (address.bits.map Γ.ofBool)).move Dir3.right), - updateWork, hops, rfl, rfl, by simpa [address, value] using houtcome, + updateWork, hops, rfl, rfl, by simpa [address, value] using! houtcome, by rcases hops with ⟨lhsWork, hlhs, hrhs⟩ calc @@ -467,7 +467,7 @@ theorem indirectStoreInstructionTM_hoareTime_frame_internal _ = (lhsWork tapes.update.entry.source).cells := hrhs.sourceCells _ = (initialWork tapes.update.entry.source).cells := hlhs.sourceCells⟩, - by simpa [address, value] using hfinalOutput⟩ + by simpa [address, value] using! hfinalOutput⟩ have hvalueUpdate := TM.seqTM_hoareTime (TM.binaryCopyIntoTM tapes.rhs tapes.update.replacement tapes.update.found) (entryUpdateTM tapes.update) hvalue @@ -485,8 +485,8 @@ theorem indirectStoreInstructionTM_hoareTime_frame_internal ((Tape.init (address.bits.map Γ.ofBool)).move Dir3.right)) tapes.update.replacement ((Tape.init (value.bits.map Γ.ofBool)).move Dir3.right)) - (out := out) (by simpa [hinp] using hinput) hready.2.2.2.2.2 - (by simpa [hout] using houtputParked) + (out := out) (by simpa [hinp] using! hinput) hready.2.2.2.2.2 + (by simpa [hout] using! houtputParked) rw [hi, hw, ho] exact ⟨hinp, ⟨operandsWork, _, hops, rfl, rfl⟩, hout⟩) hupdate @@ -507,17 +507,17 @@ theorem indirectStoreInstructionTM_hoareTime_frame_internal by_cases hi : i = tapes.update.entry.query · subst i have hnat := Tape.init_move_right_hasBinaryNat address - simpa only [Function.update_self] using + simpa only [Function.update_self] using! (show TM.Parked ((Tape.init (address.bits.map Γ.ofBool)).move Dir3.right) from ⟨by rw [hnat.2.1], hnat.2.hasBinaryContent.cells_ne_start⟩) - · simpa only [Function.update_of_ne hi] using hvalues.2.2.2 i + · simpa only [Function.update_of_ne hi] using! hvalues.2.2.2 i obtain ⟨hi, hw, ho⟩ := phaseTransition_of_parked (inp := inp) (work := Function.update operandsWork tapes.update.entry.query ((Tape.init (address.bits.map Γ.ofBool)).move Dir3.right)) - (out := out) (by simpa [hinp] using hinput) hparked - (by simpa [hout] using houtputParked) + (out := out) (by simpa [hinp] using! hinput) hparked + (by simpa [hout] using! houtputParked) rw [hi, hw, ho] exact ⟨hinp, ⟨operandsWork, hops, rfl⟩, hout⟩) hvalueUpdate @@ -535,13 +535,13 @@ theorem indirectStoreInstructionTM_hoareTime_frame_internal initialWork work hops obtain ⟨hi, hw, ho⟩ := phaseTransition_of_parked (inp := inp) (work := work) (out := out) - (by simpa [hinp] using hinput) hvalues.2.2.2 - (by simpa [hout] using houtputParked) + (by simpa [hinp] using! hinput) hvalues.2.2.2 + (by simpa [hout] using! houtputParked) rw [hi, hw, ho] exact ⟨hinp, hops, hout⟩) hqueryRest simpa [indirectStoreInstructionTM, indirectStoreInstructionTime, address, - value] using hall + value] using! hall end Machine From 356089bb14cefac11e42a92603d7915d1ace8ac8 Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Tue, 22 Sep 2026 02:33:57 +0000 Subject: [PATCH 16/49] Port matrix epigraph identities and instruction execution bounds --- .../BeyondBethe/BetheEpigraph.lean | 50 +++++---- .../BeyondBethe/ExecutableCertificate.lean | 12 +-- .../BeyondBethe/MachineBinaryAdd.lean | 14 +-- .../MachineRationalEllipsoidEncoding.lean | 4 +- .../BeyondBethe/RawRationalBitBounds.lean | 6 +- .../Machine/Instruction/DenseStore.lean | 100 +++++++++--------- .../Machine/Instruction/Sim/Control.lean | 62 +++++------ .../Machine/Instruction/Sim/Data.lean | 86 +++++++-------- 8 files changed, 169 insertions(+), 165 deletions(-) diff --git a/LeanPool/BeyondBethe/BeyondBethe/BetheEpigraph.lean b/LeanPool/BeyondBethe/BeyondBethe/BetheEpigraph.lean index 009031ed65..0473e2e7d2 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/BetheEpigraph.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/BetheEpigraph.lean @@ -74,14 +74,14 @@ theorem finiteDot_squareMatrixToVector {m : ℕ} {R : Type*} [CommSemiring R] matrixPairing G D := by change (∑ k, squareMatrixToVector (fun i j ↦ G i j * D i j) k) = ∑ i, ∑ j, G i j * D i j - rw [sum_squareMatrixToVector] + exact sum_squareMatrixToVector (fun i j => G i j * D i j) theorem vectorL1_squareMatrixToVector {m : ℕ} (D : Matrix (Fin m) (Fin m) ℝ) : vectorL1 (squareMatrixToVector D) = matrixL1 D := by change (∑ k, squareMatrixToVector (fun i j ↦ abs (D i j)) k) = ∑ i, ∑ j, abs (D i j) - rw [sum_squareMatrixToVector] + exact sum_squareMatrixToVector (fun i j => abs (D i j)) /-- Rational affine matrix represented by a flattened epigraph base point. -/ def betheAffineMatrixQ {m : ℕ} (y : Fin (m * m) → ℚ) : @@ -129,7 +129,7 @@ theorem betheDirectedEpigraphData_lower {m : ℕ} (vectorToSquareMatrix (fun k ↦ (y k : ℝ))) := by have h := (directedNegativeObjective_bounds hτ0 hτ1 hA hX0 hX1 p).1 simpa [betheDirectedEpigraphData, affineNegativeObjective, - cast_betheAffineMatrixQ] using h + cast_betheAffineMatrixQ] using! h /-- The flattened stored gradient has the same explicit coordinate error as the affine pullback matrix. -/ @@ -149,7 +149,7 @@ theorem betheDirectedEpigraphData_gradient_error {m : ℕ} 16 * (((1 / 2 : ℚ) ^ p : ℚ) : ℝ) := by let ij := finProdFinEquiv.symm k simpa [betheDirectedEpigraphData, squareMatrixToVector, ij, - affinePullbackGradient, abs_sub_comm] using + affinePullbackGradient, abs_sub_comm] using! directedAffineGradient_error hτ0 hτ1 hA hX0 hX1 p ij.1 ij.2 /-- Exact bounded epigraph body in flattened affine coordinates. -/ @@ -171,7 +171,7 @@ theorem BetheEpigraphTarget_doublyStochastic {m : ℕ} let Y := vectorToSquareMatrix (epigraphBase z) let X := birkhoffAffineMap Y have hfloor : ∀ i j, δ ≤ X i j := by - simpa only [BetheEpigraphTarget, Y, X] using hz.1 + simpa only [BetheEpigraphTarget, Y, X] using! hz.1 refine ⟨fun i j ↦ hδ.trans (hfloor i j), ?_, ?_⟩ · exact birkhoffAffineMap_row_sum Y · exact birkhoffAffineMap_col_sum Y @@ -203,7 +203,7 @@ theorem betheDirectedEpigraphOracle_cut_valid {m : ℕ} (hm : 0 < m) let X : Matrix (Fin (m + 1)) (Fin (m + 1)) ℝ := birkhoffAffineMap Y have hqueryFloor' : ∀ i j, δ ≤ Xq i j := by - simpa only [Xq, Yq, yq, betheAffineMatrixQ] using hqueryFloor + simpa only [Xq, Yq, yq, betheAffineMatrixQ] using! hqueryFloor have hquery := birkhoffAffineMap_interior hm hδ hqueryFloor' have hXqDS := hquery.1 have hXqInt := hquery.2 @@ -217,14 +217,14 @@ theorem betheDirectedEpigraphOracle_cut_valid {m : ℕ} (hm : 0 < m) exact_mod_cast h have hδreal : 0 ≤ (δ : ℝ) := Rat.cast_nonneg.mpr hδ.le have hXDS : IsDoublyStochastic X := by - simpa only [X, Y] using + simpa only [X, Y] using! BetheEpigraphTarget_doublyStochastic hδreal hz have htargetFloor : ∀ i j, (δ : ℝ) ≤ X i j := by - simpa only [BetheEpigraphTarget, X, Y] using hz.1 + simpa only [BetheEpigraphTarget, X, Y] using! hz.1 have htargetEpigraph : affineNegativeObjective (τ : ℝ) (fun i j ↦ (A i j : ℝ)) Y ≤ epigraphHeight z := by - simpa only [BetheEpigraphTarget, X, Y] using hz.2.1 + simpa only [BetheEpigraphTarget, X, Y] using! hz.2.1 let YqR : Matrix (Fin m) (Fin m) ℝ := fun i j ↦ (Yq i j : ℝ) let Gm : Matrix (Fin m) (Fin m) ℝ := @@ -236,7 +236,7 @@ theorem betheDirectedEpigraphOracle_cut_valid {m : ℕ} (hm : 0 < m) (fun i j ↦ (Xq i j : ℝ)) := by ext i j symm - simpa only [Xq, Yq, YqR, yq] using cast_betheAffineMatrixQ yq i j + simpa only [Xq, Yq, YqR, yq] using! cast_betheAffineMatrixQ yq i j have hsupportMatrix := affineNegativeObjective_support hm (Rat.cast_nonneg.mpr hτ0) (A := fun i j ↦ (A i j : ℝ)) @@ -259,16 +259,17 @@ theorem betheDirectedEpigraphOracle_cut_valid {m : ℕ} (hm : 0 < m) epigraphBase z (finProdFinEquiv (finProdFinEquiv.symm k)) - (yq (finProdFinEquiv (finProdFinEquiv.symm k)) : ℝ) rw [hk] - rw [hDvec, finiteDot_squareMatrixToVector] - simpa only [Gm, hcastXq] using hsupportMatrix + rw [hDvec, finiteDot_squareMatrixToVector Gm + (fun i j => Y i j - YqR i j)] + simpa only [Gm, hcastXq] using! hsupportMatrix have hlower := betheDirectedEpigraphData_lower hτ0 hτ1 hA - (by simpa only [Xq, yq, betheAffineMatrixQ] using hXq0) - (by simpa only [Xq, yq, betheAffineMatrixQ] using hXq1) p + (by simpa only [Xq, yq, betheAffineMatrixQ] using! hXq0) + (by simpa only [Xq, yq, betheAffineMatrixQ] using! hXq1) p have hgradient : ∀ k, abs ((((betheDirectedEpigraphData τ A p).gradient yq k : ℚ) : ℝ) - Gv k) ≤ 16 * (((1 / 2 : ℚ) ^ p : ℚ) : ℝ) := by intro k - simpa only [Gv, Gm, Xq, yq, betheAffineMatrixQ] using + simpa only [Gv, Gm, Xq, yq, betheAffineMatrixQ] using! betheDirectedEpigraphData_gradient_error hτ0 hτ1 hA hXq0 hXq1 p k have hD : vectorL1 (fun k ↦ epigraphBase z k - (yq k : ℝ)) ≤ (m * m : ℝ) := by @@ -279,7 +280,7 @@ theorem betheDirectedEpigraphOracle_cut_valid {m : ℕ} (hm : 0 < m) intro k _ let ij := finProdFinEquiv.symm k have hk : finProdFinEquiv ij = k := by - simpa only [ij] using Equiv.apply_symm_apply finProdFinEquiv k + simpa only [ij] using! Equiv.apply_symm_apply finProdFinEquiv k have hz0 : 0 ≤ epigraphBase z k := by have := hXDS.nonnegative ij.1.castSucc ij.2.castSucc simp only [X, Y, birkhoffAffineMap_castSucc_castSucc, @@ -311,12 +312,12 @@ theorem betheDirectedEpigraphOracle_cut_valid {m : ℕ} (hm : 0 < m) (fZ := affineNegativeObjective (τ : ℝ) (fun i j ↦ (A i j : ℝ)) Y) (G := Gv) (z := z) - · simpa only [yq] using hsupport - · simpa only [yq, YqR] using hlower + · simpa only [yq] using! hsupport + · simpa only [yq, YqR] using! hlower · simpa only [yq, Rat.cast_mul, Rat.cast_pow, Rat.cast_div, - Rat.cast_one, Rat.cast_ofNat] using hgradient + Rat.cast_one, Rat.cast_ofNat] using! hgradient · norm_num only [Rat.cast_mul, Rat.cast_natCast] - simpa only [yq] using hD + simpa only [yq] using! hD · exact htargetEpigraph /-- Matrix covector selecting one full Birkhoff coordinate. -/ @@ -452,7 +453,7 @@ theorem firstBetheFloorViolationAll_eq_none_iff {m : ℕ} (δ : ℚ) theorem matrixPairing_entryCovector {n : ℕ} (i j : Fin n) (D : Matrix (Fin n) (Fin n) ℝ) : matrixPairing (fun a b ↦ (matrixEntryCovector i j a b : ℝ)) D = D i j := by - rw [matrixPairing] + unfold matrixPairing have hrow : ∀ a : Fin n, (∑ b, (matrixEntryCovector i j a b : ℝ) * D a b) = if a = i then D i j else 0 := by @@ -494,7 +495,9 @@ theorem betheFloorCut_valid {m : ℕ} {δ : ℚ} birkhoffAffineMap Y i j - birkhoffAffineMap Yq i j = matrixPairing (affinePullbackGradient Gq) (fun a b ↦ Y a b - Yq a b) := by - rw [← hadjoint, matrixPairing_entryCovector] + rw [← hadjoint] + exact (matrixPairing_entryCovector i j + (fun a b => birkhoffAffineMap Y a b - birkhoffAffineMap Yq a b)).symm have hqueryCast : birkhoffAffineMap Yq i j = (betheAffineMatrixQ y i j : ℝ) := by symm @@ -538,7 +541,8 @@ theorem betheFloorCut_valid {m : ℕ} {δ : ℚ} rw [hDvec, hnormalCast] rw [finiteDot] simp_rw [neg_mul, Finset.sum_neg_distrib] - rw [← finiteDot, finiteDot_squareMatrixToVector] + rw [← finiteDot, finiteDot_squareMatrixToVector + (affinePullbackGradient Gq) (fun a b => Y a b - Yq a b)] rw [finiteDot, Fin.sum_univ_castSucc] simp only [betheFloorCutNormal_castSucc, betheFloorCutNormal_last, Rat.cast_neg, Rat.cast_zero, zero_mul, add_zero, Fin.snoc_last, diff --git a/LeanPool/BeyondBethe/BeyondBethe/ExecutableCertificate.lean b/LeanPool/BeyondBethe/BeyondBethe/ExecutableCertificate.lean index 6bf7be49fd..a6dc51a09a 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/ExecutableCertificate.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/ExecutableCertificate.lean @@ -104,7 +104,7 @@ theorem explicitCertified_certificate_of_logKKT have hlogn : Real.log n ≤ (n : ℝ) * Real.log 2 := log_natCast_le_natCast_mul_log_two (show 1 ≤ n by omega) have hξ : 0 < ξ := by - simpa only [ξ] using (show (0 : ℝ) < (explicitXi : ℝ) by + simpa only [ξ] using! (show (0 : ℝ) < (explicitXi : ℝ) by exact_mod_cast explicitXi_pos) have hτscale : (τq : ℝ) = ξ / (4 * (n : ℝ)) := by exact cast_explicitRegularizationScale n @@ -115,7 +115,7 @@ theorem explicitCertified_certificate_of_logKKT regularizedBetheObjective (τq : ℝ) A Y ≤ regularizedBetheObjective (τq : ℝ) A X := by exact regularizedBetheObjective_le_of_logKKT - (by simpa only [Fintype.card_fin] using (show 1 < n by omega)) + (by simpa only [Fintype.card_fin] using! (show 1 < n by omega)) (by exact_mod_cast hτ0q) hX hXint hKKT have hobjective : Real.log (bethePermanent A) - ξ * n ≤ betheObjective A X := by @@ -143,7 +143,7 @@ theorem explicitCertified_certificate_of_logKKT have hmaximal := greedyThresholdRowMatching_isMaximal w explicitGamma have hthreshold : explicitGamma ≤ w q := by have hmem := hmaximal.subset hq - simpa only [List.mem_toFinset, mem_thresholdRowPairsList_iff] using hmem + simpa only [List.mem_toFinset, mem_thresholdRowPairsList_iff] using! hmem have hw : w q = explicitGamma := by exact certifiedConstantRowWeight_eq_gamma_of_threshold τq Xq explicitKappa explicitGamma (directedPairCostPrecision n) q @@ -161,7 +161,7 @@ theorem explicitCertified_certificate_of_logKKT have hr : ((explicitXi : ℚ) : ℝ) ≤ ((explicitXiSource : ℚ) : ℝ) := by exact_mod_cast hq - simpa only [ξ] using hr) + simpa only [ξ] using! hr) hτscale hA hX hXint hKKT (by norm_num) (by norm_num) (directedPairCostPrecision n) q heligible have hcertificate : Real.exp (betheObjective A X + gain) ≤ @@ -201,7 +201,7 @@ theorem explicitCertified_certificate_of_logKKT have hgap := positiveDichotomy_exponent hcases have hεcast := cast_rationalEpsilonPlus explicitCertifiedCompletionScales constructor - · simpa only [X, gain] using hcertificate - · simpa only [X, gain, η, δ, ξ, hεcast] using hgap + · simpa only [X, gain] using! hcertificate + · simpa only [X, gain, η, δ, ξ, hεcast] using! hgap end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryAdd.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryAdd.lean index 2bef8ddf49..8b0903aaf4 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryAdd.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryAdd.lean @@ -46,10 +46,10 @@ theorem machineBinaryAddPack_mem_FP (machinePair_mem_FP hy (machinePair_mem_FP hcarry hacc)) theorem machineBinaryAddX_mem_FP : machineBinaryAddX ∈ Complexity.FP := by - simpa only [machineBinaryAddX] using machinePairFirst_mem_FP + simpa only [machineBinaryAddX] using! machinePairFirst_mem_FP theorem machineBinaryAddY_mem_FP : machineBinaryAddY ∈ Complexity.FP := by - simpa only [machineBinaryAddY] using + simpa only [machineBinaryAddY] using! (machineCompose_mem_FP (f := machinePairSecond) (g := machinePairFirst) machinePairSecond_mem_FP machinePairFirst_mem_FP) @@ -60,7 +60,7 @@ theorem machineBinaryAddCarry_mem_FP : Complexity.FP := machineCompose_mem_FP (f := machinePairSecond) (g := machinePairSecond) machinePairSecond_mem_FP machinePairSecond_mem_FP - simpa only [machineBinaryAddCarry] using + simpa only [machineBinaryAddCarry] using! (machineCompose_mem_FP (f := fun word => machinePairSecond (machinePairSecond word)) (g := machinePairFirst) hsecond machinePairFirst_mem_FP) @@ -72,7 +72,7 @@ theorem machineBinaryAddAccRev_mem_FP : Complexity.FP := machineCompose_mem_FP (f := machinePairSecond) (g := machinePairSecond) machinePairSecond_mem_FP machinePairSecond_mem_FP - simpa only [machineBinaryAddAccRev] using + simpa only [machineBinaryAddAccRev] using! (machineCompose_mem_FP (f := fun word => machinePairSecond (machinePairSecond word)) (g := machinePairSecond) hsecond machinePairSecond_mem_FP) @@ -195,7 +195,7 @@ theorem machineBinaryAddWidth_mem_FP : have hpadded : padded ∈ Complexity.FP := by exact machineAppend_mem_FP (machineConst_mem_FP (List.replicate 8 false)) id_mem_FP - simpa only [machineBinaryAddWidth, padded] using + simpa only [machineBinaryAddWidth, padded] using! Cobham.mulLenFn_mem_FP hpadded hpadded @[simp] theorem machineBinaryAddStep_pack @@ -312,7 +312,7 @@ theorem machineBinaryAddIterate_wellFormed_length_le state.length + iterations := by intro iterations induction iterations with - | zero => simpa using And.intro hstate (Nat.le_refl state.length) + | zero => simpa using! And.intro hstate (Nat.le_refl state.length) | succ iterations ih => rw [Function.iterate_succ_apply'] obtain ⟨hwell, hlength⟩ := ih @@ -379,7 +379,7 @@ theorem machineBinaryAddBits_mem_FP : (machineBinaryAddFinalState word)) ∈ Complexity.FP := machineCompose_mem_FP machineBinaryAddFinalState_mem_FP machineBinaryAddAccRev_mem_FP - simpa only [machineBinaryAddBits] using + simpa only [machineBinaryAddBits] using! (machineCompose_mem_FP hacc machineReverse_mem_FP) end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalEllipsoidEncoding.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalEllipsoidEncoding.lean index 23a3ea18f7..aadab28dea 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalEllipsoidEncoding.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalEllipsoidEncoding.lean @@ -186,13 +186,13 @@ theorem machineRationalEllipsoidPayloadWord_mem_FP : theorem machineRationalEllipsoidCenterWord_mem_FP : machineRationalEllipsoidCenterWord ∈ FP := by - simpa only [machineRationalEllipsoidCenterWord] using + simpa only [machineRationalEllipsoidCenterWord] using! machineCompose_mem_FP machineRationalEllipsoidPayloadWord_mem_FP machinePairFirst_mem_FP theorem machineRationalEllipsoidBasisWord_mem_FP : machineRationalEllipsoidBasisWord ∈ FP := by - simpa only [machineRationalEllipsoidBasisWord] using + simpa only [machineRationalEllipsoidBasisWord] using! machineCompose_mem_FP machineRationalEllipsoidPayloadWord_mem_FP machinePairSecond_mem_FP diff --git a/LeanPool/BeyondBethe/BeyondBethe/RawRationalBitBounds.lean b/LeanPool/BeyondBethe/BeyondBethe/RawRationalBitBounds.lean index e829192bb8..214b3677bd 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/RawRationalBitBounds.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/RawRationalBitBounds.lean @@ -157,7 +157,7 @@ theorem rawRatWidth_add_le (q r : RawRat) : · have h := mul_lt_two_pow_add (rawRat_num_lt_two_pow_width r) (rawRat_den_lt_two_pow_width q) - simpa only [Nat.add_comm] using h + simpa only [Nat.add_comm] using! h · rw [RawRat.add, Nat.size_le] exact (mul_lt_two_pow_add (rawRat_den_lt_two_pow_width q) @@ -166,7 +166,7 @@ theorem rawRatWidth_add_le (q r : RawRat) : theorem rawRatWidth_sub_le (q r : RawRat) : rawRatWidth (q.sub r) ≤ rawRatWidth q + rawRatWidth r + 1 := by - simpa only [RawRat.sub, rawRatWidth_neg] using rawRatWidth_add_le q r.neg + simpa only [RawRat.sub, rawRatWidth_neg] using! rawRatWidth_add_le q r.neg theorem rawRat_value_den_dvd (q : RawRat) : q.value.den ∣ q.den := by have hz : (((q.value.den : ℕ) : ℤ) ∣ (q.den : ℤ)) := by @@ -288,7 +288,7 @@ def rawRatOfRat (q : ℚ) : RawRat := @[simp] theorem rawRatOfRat_value (q : ℚ) : (rawRatOfRat q).value = q := by - simpa only [rawRatOfRat, RawRat.value] using q.num_div_den + simpa only [rawRatOfRat, RawRat.value] using! q.num_div_den /-- The raw width of a canonical input is bounded by its exact project encoding length. -/ diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseStore.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseStore.lean index e2a0f339fa..63b6c1fa5d 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseStore.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseStore.lean @@ -58,8 +58,8 @@ private theorem denseStoreOperands_values rcases hoperands with ⟨lhsWork, hlhs, hrhs⟩ have hlhsEq : operandsWork tapes.lhs = lhsWork tapes.lhs := hrhs.frame tapes.lhs (fun slot => (tapes.rhsLookup_ne_lhs slot).symm) - refine ⟨?_, by simpa using hrhs.destination, - by simpa using hrhs.copyScratch, hrhs.parked⟩ + refine ⟨?_, by simpa using! hrhs.destination, + by simpa using! hrhs.copyScratch, hrhs.parked⟩ rw [hlhsEq] exact hlhs.destination @@ -101,54 +101,54 @@ private theorem scanner_after_replacement have hnat := Tape.init_move_right_hasBinaryNat value refine { source := by - simpa only [finalWork, Function.update_of_ne hsource] using + simpa only [finalWork, Function.update_of_ne hsource] using! hscanner.source address := by - simpa only [finalWork, Function.update_of_ne haddress] using + simpa only [finalWork, Function.update_of_ne haddress] using! hscanner.address addressStart := by - simpa only [finalWork, Function.update_of_ne haddress] using + simpa only [finalWork, Function.update_of_ne haddress] using! hscanner.addressStart value := by - simpa only [finalWork, Function.update_of_ne hvalue] using + simpa only [finalWork, Function.update_of_ne hvalue] using! hscanner.value valueStart := by - simpa only [finalWork, Function.update_of_ne hvalue] using + simpa only [finalWork, Function.update_of_ne hvalue] using! hscanner.valueStart addressCounter := by - simpa only [finalWork, Function.update_of_ne haddressCounter] using + simpa only [finalWork, Function.update_of_ne haddressCounter] using! hscanner.addressCounter addressWidth := by - simpa only [finalWork, Function.update_of_ne haddressWidth] using + simpa only [finalWork, Function.update_of_ne haddressWidth] using! hscanner.addressWidth valueCounter := by - simpa only [finalWork, Function.update_of_ne hvalueCounter] using + simpa only [finalWork, Function.update_of_ne hvalueCounter] using! hscanner.valueCounter valueWidth := by - simpa only [finalWork, Function.update_of_ne hvalueWidth] using + simpa only [finalWork, Function.update_of_ne hvalueWidth] using! hscanner.valueWidth query := by - simpa only [finalWork, Function.update_of_ne hquery] using + simpa only [finalWork, Function.update_of_ne hquery] using! hscanner.query queryStart := by - simpa only [finalWork, Function.update_of_ne hquery] using + simpa only [finalWork, Function.update_of_ne hquery] using! hscanner.queryStart result := by - simpa only [finalWork, Function.update_of_ne hresult] using + simpa only [finalWork, Function.update_of_ne hresult] using! hscanner.result resultStart := by - simpa only [finalWork, Function.update_of_ne hresult] using + simpa only [finalWork, Function.update_of_ne hresult] using! hscanner.resultStart parked := ?_ frame := by intro i _ _ _ _ _ _ _ _ _; rfl } intro i by_cases hi : i = tapes.update.replacement · subst i - simpa only [finalWork, Function.update_self] using + simpa only [finalWork, Function.update_self] using! (show TM.Parked ((Tape.init (value.bits.map Γ.ofBool)).move Dir3.right) from ⟨by rw [hnat.2.1], hnat.2.hasBinaryContent.cells_ne_start⟩) - · simpa only [finalWork, Function.update_of_ne hi] using hscanner.parked i + · simpa only [finalWork, Function.update_of_ne hi] using! hscanner.parked i private theorem denseStoreUpdate_ready (tapes : BinaryInstructionTapes n) (input : List Bool) @@ -182,17 +182,17 @@ private theorem denseStoreUpdate_ready operandsWork hrhs.scanner have hscanner : EntryScanReady tapes.update.entry (overlay.flatMap Entry.encode) address.bits updateWork updateWork := by - simpa only [queryWork, updateWork] using + simpa only [queryWork, updateWork] using! scanner_after_replacement tapes overlay address value queryWork hqueryScanner have hvalueNat := Tape.init_move_right_hasBinaryNat value have hresultCount : (operandsWork tapes.update.resultCount).HasBinaryNat overlay.length := by rw [show operandsWork tapes.update.resultCount = - lhsWork tapes.update.resultCount by simpa using hrhs.countSource] + lhsWork tapes.update.resultCount by simpa using! hrhs.countSource] rw [show lhsWork tapes.update.resultCount = - initialWork tapes.update.resultCount by simpa using hlhs.countSource] - simpa using hinitial.countSource + initialWork tapes.update.resultCount by simpa using! hlhs.countSource] + simpa using! hinitial.countSource have hremainingReplacement : tapes.update.remaining ≠ tapes.update.replacement := tapes.update.ne (by decide) @@ -210,13 +210,13 @@ private theorem denseStoreUpdate_ready tapes.update.resultCount ≠ tapes.update.entry.query := tapes.update.ne (by decide) refine ⟨hscanner, ?_, ?_, ?_, ?_, hscanner.parked⟩ - · simpa only [updateWork, Function.update_self] using hvalueNat + · simpa only [updateWork, Function.update_self] using! hvalueNat · simpa only [updateWork, Function.update_of_ne hremainingReplacement, - queryWork, Function.update_of_ne hremainingQuery] using hrhs.count + queryWork, Function.update_of_ne hremainingQuery] using! hrhs.count · simpa only [updateWork, Function.update_of_ne hfoundReplacement, - queryWork, Function.update_of_ne hfoundQuery] using hrhs.copyScratch + queryWork, Function.update_of_ne hfoundQuery] using! hrhs.copyScratch · simpa only [updateWork, Function.update_of_ne hresultCountReplacement, - queryWork, Function.update_of_ne hresultCountQuery] using hresultCount + queryWork, Function.update_of_ne hresultCountQuery] using! hresultCount /-- Exact semantic and time contract for one dense-overlay indirect store. -/ theorem denseIndirectStoreInstructionTM_hoareTime_frame @@ -248,7 +248,7 @@ theorem denseIndirectStoreInstructionTM_hoareTime_frame let value := DenseOverlay.read input overlay source have hinput : TM.Parked inp₀ := by refine ⟨by simp [inp₀, Tape.move], ?_⟩ - simpa [inp₀] using Tape.init_ofBool_move_right_cells_ne_start input + simpa [inp₀] using! Tape.init_ofBool_move_right_cells_ne_start input have houtputParked := hasBinaryPrefix_parked houtput have hoperands := denseDirectBinaryOperands_hoareTime tapes input overlay addressRegister source initialWork out₀ hvalid hinitial hrhs₀ houtputParked @@ -274,17 +274,17 @@ theorem denseIndirectStoreInstructionTM_hoareTime_frame have hrun := TM.binaryCopyIntoTM_hoareTime_frame tapes.lhs tapes.update.entry.query tapes.update.found (tapes.ne (by decide)) (tapes.ne (by decide)) (tapes.update.ne (by decide)) address 0 inp work - out (by simpa [address] using hvalues.1) + out (by simpa [address] using! hvalues.1) ⟨(by rcases hops with ⟨_, _, hrhs⟩; exact hrhs.scanner.queryStart), (by rcases hops with ⟨_, _, hrhs⟩; - simpa using hrhs.scanner.query)⟩ - hvalues.2.2.1 (by simpa [hinp] using hinput) + simpa using! hrhs.scanner.query)⟩ + hvalues.2.2.1 (by simpa [hinp] using! hinput) (fun i _ _ _ => hvalues.2.2.2 i) - (by simpa [hout] using houtputParked) + (by simpa [hout] using! houtputParked) obtain ⟨final, time, htime, hreach, hhalt, hfinalInput, hfinalWork, hfinalOutput⟩ := hrun inp work out ⟨rfl, rfl, rfl⟩ exact ⟨final, time, htime, hreach, hhalt, hfinalInput.trans hinp, - ⟨work, hops, by simpa [address] using hfinalWork⟩, + ⟨work, hops, by simpa [address] using! hfinalWork⟩, hfinalOutput.trans hout⟩ have hvalue : (TM.binaryCopyIntoTM tapes.rhs tapes.update.replacement @@ -325,7 +325,7 @@ theorem denseIndirectStoreInstructionTM_hoareTime_frame tapes.update.replacement tapes.update.found (tapes.ne (by decide)) (tapes.ne (by decide)) (tapes.update.ne (by decide)) value 0 inp queryWork out - (by simpa only [queryWork, Function.update_of_ne hrhsQuery, value] using + (by simpa only [queryWork, Function.update_of_ne hrhsQuery, value] using! hvalues.2.1) (by have hreplEq : operandsWork tapes.update.replacement = @@ -336,27 +336,27 @@ theorem denseIndirectStoreInstructionTM_hoareTime_frame exact hlhs.frame tapes.update.replacement (fun slot => (tapes.lhsLookup_ne_replacement slot).symm) simpa only [queryWork, Function.update_of_ne hreplacementQuery, - hreplEq] using hreplacement) - (by simpa only [queryWork, Function.update_of_ne hfoundQuery] using + hreplEq] using! hreplacement) + (by simpa only [queryWork, Function.update_of_ne hfoundQuery] using! hvalues.2.2.1) - (by simpa [hinp] using hinput) + (by simpa [hinp] using! hinput) (fun i _ _ _ => by by_cases hi : i = tapes.update.entry.query · subst i have hnat := Tape.init_move_right_hasBinaryNat address - simpa only [queryWork, Function.update_self] using + simpa only [queryWork, Function.update_self] using! (show TM.Parked ((Tape.init (address.bits.map Γ.ofBool)).move Dir3.right) from ⟨by rw [hnat.2.1], hnat.2.hasBinaryContent.cells_ne_start⟩) - · simpa only [queryWork, Function.update_of_ne hi] using + · simpa only [queryWork, Function.update_of_ne hi] using! hvalues.2.2.2 i) - (by simpa [hout] using houtputParked) + (by simpa [hout] using! houtputParked) obtain ⟨final, time, htime, hreach, hhalt, hfinalInput, hfinalWork, hfinalOutput⟩ := hrun inp queryWork out ⟨rfl, rfl, rfl⟩ exact ⟨final, time, htime, hreach, hhalt, hfinalInput.trans hinp, ⟨operandsWork, queryWork, hops, rfl, - by simpa [value] using hfinalWork⟩, + by simpa [value] using! hfinalWork⟩, hfinalOutput.trans hout⟩ have hupdate : (taggedEntryUpdateTM tapes.update).HoareTime (fun inp work out => @@ -399,8 +399,8 @@ theorem denseIndirectStoreInstructionTM_hoareTime_frame ⟨operandsWork, Function.update operandsWork tapes.update.entry.query ((Tape.init (address.bits.map Γ.ofBool)).move Dir3.right), - updateWork, hops, rfl, rfl, by simpa [address, value] using houtcome⟩, - by simpa [address, value] using hfinalOutput⟩ + updateWork, hops, rfl, rfl, by simpa [address, value] using! houtcome⟩, + by simpa [address, value] using! hfinalOutput⟩ have hvalueUpdate := TM.seqTM_hoareTime (TM.binaryCopyIntoTM tapes.rhs tapes.update.replacement tapes.update.found) (taggedEntryUpdateTM tapes.update) hvalue @@ -418,8 +418,8 @@ theorem denseIndirectStoreInstructionTM_hoareTime_frame ((Tape.init (address.bits.map Γ.ofBool)).move Dir3.right)) tapes.update.replacement ((Tape.init (value.bits.map Γ.ofBool)).move Dir3.right)) - (out := out) (by simpa [hinp] using hinput) hready.2.2.2.2.2 - (by simpa [hout] using houtputParked) + (out := out) (by simpa [hinp] using! hinput) hready.2.2.2.2.2 + (by simpa [hout] using! houtputParked) rw [hi, hw, ho] exact ⟨hinp, ⟨operandsWork, _, hops, rfl, rfl⟩, hout⟩) hupdate @@ -440,17 +440,17 @@ theorem denseIndirectStoreInstructionTM_hoareTime_frame by_cases hi : i = tapes.update.entry.query · subst i have hnat := Tape.init_move_right_hasBinaryNat address - simpa only [Function.update_self] using + simpa only [Function.update_self] using! (show TM.Parked ((Tape.init (address.bits.map Γ.ofBool)).move Dir3.right) from ⟨by rw [hnat.2.1], hnat.2.hasBinaryContent.cells_ne_start⟩) - · simpa only [Function.update_of_ne hi] using hvalues.2.2.2 i + · simpa only [Function.update_of_ne hi] using! hvalues.2.2.2 i obtain ⟨hi, hw, ho⟩ := phaseTransition_of_parked (inp := inp) (work := Function.update operandsWork tapes.update.entry.query ((Tape.init (address.bits.map Γ.ofBool)).move Dir3.right)) - (out := out) (by simpa [hinp] using hinput) hparked - (by simpa [hout] using houtputParked) + (out := out) (by simpa [hinp] using! hinput) hparked + (by simpa [hout] using! houtputParked) rw [hi, hw, ho] exact ⟨hinp, ⟨operandsWork, hops, rfl⟩, hout⟩) hvalueUpdate @@ -469,13 +469,13 @@ theorem denseIndirectStoreInstructionTM_hoareTime_frame addressRegister source initialWork work hops obtain ⟨hi, hw, ho⟩ := phaseTransition_of_parked (inp := inp) (work := work) (out := out) - (by simpa [hinp] using hinput) hvalues.2.2.2 - (by simpa [hout] using houtputParked) + (by simpa [hinp] using! hinput) hvalues.2.2.2 + (by simpa [hout] using! houtputParked) rw [hi, hw, ho] exact ⟨hinp, hops, hout⟩) hqueryRest simpa [denseIndirectStoreInstructionTM, denseIndirectStoreInstructionTime, - inp₀, address, value] using hall + inp₀, address, value] using! hall end Machine end RegisterStore diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Sim/Control.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Sim/Control.lean index 9cdd064da9..cfef692d86 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Sim/Control.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Sim/Control.lean @@ -108,8 +108,8 @@ private theorem finishControlInstructionTM_hoareTime_frame_internal have hsourceOutput : (work source).HasOutput bits := by refine ⟨?_, ?_⟩ · intro i hi - simpa [hsourceHead, Nat.add_comm] using hsourceSuffix.2.1 i hi - · simpa [hsourceHead, Nat.add_comm] using hsourceSuffix.2.2.1 + simpa [hsourceHead, Nat.add_comm] using! hsourceSuffix.2.1 i hi + · simpa [hsourceHead, Nat.add_comm] using! hsourceSuffix.2.2.1 have hbufferEq : work buffer = (Tape.init []).move Dir3.right := by rw [hcontrolResult.frame buffer tapes.liftedPC_ne_buffer.symm @@ -121,7 +121,7 @@ private theorem finishControlInstructionTM_hoareTime_frame_internal intro slot fin_cases slot · exact ⟨hcontrolResult.ready.lookup.scanner.queryStart, - by simpa [instructionCleanupTape, instructionCleanupParentSlot] using + by simpa [instructionCleanupTape, instructionCleanupParentSlot] using! hcontrolResult.ready.lookup.scanner.query⟩ · change (work tapes.lifted.data.update.replacement).HasBinaryNat 0 rw [show work tapes.lifted.data.update.replacement = @@ -130,9 +130,9 @@ private theorem finishControlInstructionTM_hoareTime_frame_internal (fun role => (tapes.lifted.data.lhsLookup_ne_replacement role).symm)] exact hready.replacement - · simpa [instructionCleanupTape, instructionCleanupParentSlot] using + · simpa [instructionCleanupTape, instructionCleanupParentSlot] using! hcontrolResult.ready.lookup.copyScratch - · simpa [instructionCleanupTape, instructionCleanupParentSlot] using + · simpa [instructionCleanupTape, instructionCleanupParentSlot] using! hcontrolResult.ready.lookup.destination · change (work tapes.lifted.data.rhs).HasBinaryNat 0 rw [show work tapes.lifted.data.rhs = initialWork tapes.lifted.data.rhs @@ -190,8 +190,8 @@ private theorem finishControlInstructionTM_hoareTime_frame_internal · intro i hiSource hiBuffer rw [hworkFrame i hiSource hiBuffer] exact hPredFrame i hiSource hiBuffer) - have hinpParked : TM.Parked inp := by simpa [hinp] using hinput - have houtParked : TM.Parked out := by simpa [hout] using houtput + have hinpParked : TM.Parked inp := by simpa [hinp] using! hinput + have houtParked : TM.Parked out := by simpa [hout] using! houtput obtain ⟨final, time, htime, hreach, hhalt, hsourceCells, hsourceFinalHead, hsourceFinalOutput, hbufferPrefix, _hbufferStart, hfinalInput, hfinalOutput, hfinalPC, hfinalCount, hfinalCleanup, @@ -287,7 +287,7 @@ private theorem finishControlInstructionTM_hoareTime_frame_internal refine ⟨by omega, ?_, ?_, ?_⟩ · intro i hi simp at hi - · simpa [hsourceFinalHead, Nat.add_comm] using hsourceFinalOutput.2 + · simpa [hsourceFinalHead, Nat.add_comm] using! hsourceFinalOutput.2 · intro j hj rw [hsourceCells] exact hsourceSuffix.2.2.2 j hj @@ -322,8 +322,8 @@ private theorem finishControlInstructionTM_hoareTime_frame_internal (by rintro inp work out ⟨hinp, hcontrolResult, hout⟩ have hworkParked := hcontrolResult.ready.lookup.scanner.parked - have hinpParked : TM.Parked inp := by simpa [hinp] using hinput - have houtParked : TM.Parked out := by simpa [hout] using houtput + have hinpParked : TM.Parked inp := by simpa [hinp] using! hinput + have houtParked : TM.Parked out := by simpa [hout] using! houtput obtain ⟨hi, hw, ho⟩ := TM.phaseTransition_eq_self_of_reads_ne_start hinpParked.read_ne_start @@ -332,7 +332,7 @@ private theorem finishControlInstructionTM_hoareTime_frame_internal rw [hi, hw, ho] exact ⟨hinp, hcontrolResult, hout⟩) hcopy - simpa only [finishControlInstructionTM, bits, source, buffer] using hseq + simpa only [finishControlInstructionTM, bits, source, buffer] using! hseq /-- Representation-independent form of the control-instruction finisher. Control instructions preserve the encoded store, leave zero on every cleanup @@ -411,11 +411,11 @@ theorem executeInstructionTM_jz_hoareTime_frame by_cases hzero : RegisterStore.read store source = 0 · exact ⟨hinp, { buffer := by - simpa [instructionStore, Snapshot.stepInstr, hzero] using hbuffer + simpa [instructionStore, Snapshot.stepInstr, hzero] using! hbuffer pc := by - simpa [instructionPC, Snapshot.stepInstr, hzero] using hpc + simpa [instructionPC, Snapshot.stepInstr, hzero] using! hpc resultCount := by - simpa [instructionStore, Snapshot.stepInstr, hzero] using hcount + simpa [instructionStore, Snapshot.stepInstr, hzero] using! hcount sourceContent := hsourceContent cleanup := by intro slot @@ -425,9 +425,9 @@ theorem executeInstructionTM_jz_hoareTime_frame rw [hvalue] exact hcleanup slot remaining := by - simpa [instructionRemainingValue] using hremaining + simpa [instructionRemainingValue] using! hremaining scanner := by - simpa [instructionCleanupValue] using hscanner + simpa [instructionCleanupValue] using! hscanner shift := hshift tmp := htmp dbl := hdbl @@ -435,11 +435,11 @@ theorem executeInstructionTM_jz_hoareTime_frame hout⟩ · exact ⟨hinp, { buffer := by - simpa [instructionStore, Snapshot.stepInstr, hzero] using hbuffer + simpa [instructionStore, Snapshot.stepInstr, hzero] using! hbuffer pc := by - simpa [instructionPC, Snapshot.stepInstr, hzero] using hpc + simpa [instructionPC, Snapshot.stepInstr, hzero] using! hpc resultCount := by - simpa [instructionStore, Snapshot.stepInstr, hzero] using hcount + simpa [instructionStore, Snapshot.stepInstr, hzero] using! hcount sourceContent := hsourceContent cleanup := by intro slot @@ -449,9 +449,9 @@ theorem executeInstructionTM_jz_hoareTime_frame rw [hvalue] exact hcleanup slot remaining := by - simpa [instructionRemainingValue] using hremaining + simpa [instructionRemainingValue] using! hremaining scanner := by - simpa [instructionCleanupValue] using hscanner + simpa [instructionCleanupValue] using! hscanner shift := hshift tmp := htmp dbl := hdbl @@ -486,10 +486,10 @@ theorem executeInstructionTM_jmp_hoareTime_frame hscanner, hshift, htmp, hdbl, hparked, hout⟩ exact ⟨hinp, { buffer := by - simpa [instructionStore, Snapshot.stepInstr] using hbuffer - pc := by simpa [instructionPC, Snapshot.stepInstr] using hpc + simpa [instructionStore, Snapshot.stepInstr] using! hbuffer + pc := by simpa [instructionPC, Snapshot.stepInstr] using! hpc resultCount := by - simpa [instructionStore, Snapshot.stepInstr] using hcount + simpa [instructionStore, Snapshot.stepInstr] using! hcount sourceContent := hsourceContent cleanup := by intro slot @@ -498,9 +498,9 @@ theorem executeInstructionTM_jmp_hoareTime_frame rw [hvalue] exact hcleanup slot remaining := by - simpa [instructionRemainingValue] using hremaining + simpa [instructionRemainingValue] using! hremaining scanner := by - simpa [instructionCleanupValue] using hscanner + simpa [instructionCleanupValue] using! hscanner shift := hshift tmp := htmp dbl := hdbl @@ -534,10 +534,10 @@ theorem executeInstructionTM_halt_hoareTime_frame hscanner, hshift, htmp, hdbl, hparked, hout⟩ exact ⟨hinp, { buffer := by - simpa [instructionStore, Snapshot.stepInstr] using hbuffer - pc := by simpa [instructionPC, Snapshot.stepInstr] using hpc + simpa [instructionStore, Snapshot.stepInstr] using! hbuffer + pc := by simpa [instructionPC, Snapshot.stepInstr] using! hpc resultCount := by - simpa [instructionStore, Snapshot.stepInstr] using hcount + simpa [instructionStore, Snapshot.stepInstr] using! hcount sourceContent := hsourceContent cleanup := by intro slot @@ -546,9 +546,9 @@ theorem executeInstructionTM_halt_hoareTime_frame rw [hvalue] exact hcleanup slot remaining := by - simpa [instructionRemainingValue] using hremaining + simpa [instructionRemainingValue] using! hremaining scanner := by - simpa [instructionCleanupValue] using hscanner + simpa [instructionCleanupValue] using! hscanner shift := hshift tmp := htmp dbl := hdbl diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Sim/Data.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Sim/Data.lean index 0021d00f96..5e6e440cfa 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Sim/Data.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Sim/Data.lean @@ -248,8 +248,8 @@ theorem finishBufferedDataTM_hoareTime_frame_internal rintro inp work out ⟨hinp, hbuffer, hpc, hcount, hsourceContent, hcleanup, hremaining, hscanner, hshift, htmp, hdbl, hparked, houtEq⟩ - have hinpParked : TM.Parked inp := by simpa [hinp] using hinput - have houtParked : TM.Parked out := by simpa [houtEq] using hout + have hinpParked : TM.Parked inp := by simpa [hinp] using! hinput + have houtParked : TM.Parked out := by simpa [houtEq] using! hout have hrun := TM.binarySuccTM_hoareTime_frame tapes.liftedPC pcValue inp work out hpc hinpParked.read_ne_start (fun i _ => (hparked i).read_ne_start) houtParked.read_ne_start @@ -314,8 +314,8 @@ theorem finishBufferedDataTM_hoareTime_frame_internal rintro inp work out ⟨hinp, hbuffer, hpc, hcount, hsourceContent, hcleanup, hremaining, hscanner, hshift, htmp, hdbl, hparked, houtEq⟩ - have hinpParked : TM.Parked inp := by simpa [hinp] using hinput - have houtParked : TM.Parked out := by simpa [houtEq] using hout + have hinpParked : TM.Parked inp := by simpa [hinp] using! hinput + have houtParked : TM.Parked out := by simpa [houtEq] using! hout obtain ⟨hi, hw, ho⟩ := TM.phaseTransition_eq_self_of_reads_ne_start hinpParked.read_ne_start @@ -325,7 +325,7 @@ theorem finishBufferedDataTM_hoareTime_frame_internal exact ⟨hinp, hbuffer, hpc, hcount, hsourceContent, hcleanup, hremaining, hscanner, hshift, htmp, hdbl, hparked, houtEq⟩) hsucc - simpa only [out₀] using hseq + simpa only [out₀] using! hseq /-- Sparse-instruction specialization of buffered data finalization. -/ private theorem finishDataInstructionTM_hoareTime_frame_internal @@ -473,7 +473,7 @@ theorem retargetBufferedDataKernel_hoareTime_frame_internal (fun j => hparkedBase j) i exact ⟨hinp, hbuffer, hpc, hcount, hsourceContent, hcleanup, hremaining, by - simpa [ControlInstructionTapes.lifted] using + simpa [ControlInstructionTapes.lifted] using! entryScanReady_lifted tapes.data.update.entry _ _ work hscanner hparked, hshift, htmp, hdbl, hparked, hout⟩ @@ -664,7 +664,7 @@ theorem executeInstructionTM_imm_hoareTime_frame fin_cases slot · exact ⟨houtcome.ready.queryStart, by simpa [instructionCleanupValue, instructionCleanupTape, - instructionCleanupParentSlot] using houtcome.ready.query⟩ + instructionCleanupParentSlot] using! houtcome.ready.query⟩ · change ((fun i => work (Fin.castSucc i)) tapes.data.update.replacement).HasBinaryNat value rw [show (fun i => work (Fin.castSucc i)) @@ -682,7 +682,7 @@ theorem executeInstructionTM_imm_hoareTime_frame exact Function.update_self _ _ _] exact Tape.init_move_right_hasBinaryNat value · simpa [instructionCleanupValue, instructionCleanupTape, - instructionCleanupParentSlot] using houtcome.found + instructionCleanupParentSlot] using! houtcome.found · change ((fun i => work (Fin.castSucc i)) tapes.data.lhs).HasBinaryNat 0 rw [show (fun i => work (Fin.castSucc i)) tapes.data.lhs = updateWork tapes.data.lhs from @@ -755,14 +755,14 @@ theorem executeInstructionTM_imm_hoareTime_frame exact hready.dbl refine ⟨hinp, ?_, hpc, ?_, hsourceContent, hcleanup, ?_, ?_, hshift, htmp', hdbl', hparked, hout⟩ - · simpa [instructionStore, Snapshot.stepInstr] using hbuffer' - · simpa [instructionStore, Snapshot.stepInstr] using hcount - · simpa [instructionRemainingValue] using houtcome.remaining - · simpa [ControlInstructionTapes.lifted] using + · simpa [instructionStore, Snapshot.stepInstr] using! hbuffer' + · simpa [instructionStore, Snapshot.stepInstr] using! hcount + · simpa [instructionRemainingValue] using! houtcome.remaining + · simpa [ControlInstructionTapes.lifted] using! entryScanReady_lifted tapes.data.update.entry _ _ work houtcome.ready hparked · exact le_rfl - simpa only [executeInstructionTM, executeInstructionTime] using + simpa only [executeInstructionTM, executeInstructionTime] using! finishDataInstructionTM_hoareTime_frame_internal tapes (.imm destination value) store pcValue initialWork inp₀ (immediateInstructionTM tapes.data destination value) @@ -824,7 +824,7 @@ theorem executeInstructionTM_direct_hoareTime_frame source₁) := by cases op <;> simpa [Result, directInstruction, instructionStore, Snapshot.stepInstr, - BinaryInstrOp.eval] using hbaseRaw + BinaryInstrOp.eval] using! hbaseRaw have hresult : ∀ work, Result work → work tapes.pc = initialWork (Fin.castSucc tapes.pc) ∧ (work tapes.data.update.resultCount).HasBinaryNat @@ -898,29 +898,29 @@ theorem executeInstructionTM_direct_hoareTime_frame · exact ⟨houtcome.ready.queryStart, by cases op <;> simpa [directInstruction, instructionCleanupValue, - instructionCleanupParentSlot] using houtcome.ready.query⟩ + instructionCleanupParentSlot] using! houtcome.ready.query⟩ · change (work tapes.data.update.replacement).HasBinaryNat _ rw [show work tapes.data.update.replacement = arithmeticWork tapes.data.update.replacement from houtcome.replacement] cases op <;> simpa [directInstruction, instructionCleanupValue, - BinaryInstrOp.eval] using harithmetic.result + BinaryInstrOp.eval] using! harithmetic.result · cases op <;> simpa [directInstruction, instructionCleanupValue, - instructionCleanupParentSlot] using houtcome.found + instructionCleanupParentSlot] using! houtcome.found · change (work tapes.data.lhs).HasBinaryNat _ rw [houtcome.frame tapes.data.lhs (fun role => (tapes.data.update_ne_lhs role).symm)] cases op <;> simpa [directInstruction, instructionCleanupValue, - instructionCleanupParentSlot] using harithmetic.lhsValue + instructionCleanupParentSlot] using! harithmetic.lhsValue · change (work tapes.data.rhs).HasBinaryNat _ rw [houtcome.frame tapes.data.rhs (fun role => (tapes.data.update_ne_rhs role).symm)] cases op <;> simpa [directInstruction, instructionCleanupValue, - instructionCleanupParentSlot] using harithmetic.rhsValue + instructionCleanupParentSlot] using! harithmetic.rhsValue have hshift : (work tapes.data.shift).HasBinaryNat 0 := by rw [houtcome.frame tapes.data.shift (fun slot => (tapes.data.update_ne_shift slot).symm)] @@ -938,12 +938,12 @@ theorem executeInstructionTM_direct_hoareTime_frame hcleanup, ?_, ?_, hshift, htmp', hdbl', houtcome.ready.parked⟩ · cases op <;> simpa [directInstruction, instructionStore, Snapshot.stepInstr, - BinaryInstrOp.eval] using houtcome.resultCount + BinaryInstrOp.eval] using! houtcome.resultCount · cases op <;> - simpa [directInstruction, instructionRemainingValue] using + simpa [directInstruction, instructionRemainingValue] using! houtcome.remaining · cases op <;> - simpa [directInstruction, instructionCleanupValue] using + simpa [directInstruction, instructionCleanupValue] using! houtcome.ready have hdata := retargetDataKernel_hoareTime_frame_internal tapes (directInstruction op destination source₀ source₁) store pcValue @@ -959,7 +959,7 @@ theorem executeInstructionTM_direct_hoareTime_frame source₁) (by cases op <;> rfl) hinput hdata cases op <;> simpa [directInstruction, executeInstructionTM, executeInstructionTime] - using hall + using! hall /-- Direct addition has the common one-buffer instruction contract. -/ theorem executeInstructionTM_add_hoareTime_frame @@ -979,7 +979,7 @@ theorem executeInstructionTM_add_hoareTime_frame out = (Tape.init []).move Dir3.right) (executeInstructionTime tapes (.add destination source₀ source₁) pcValue store) := by - simpa [directInstruction] using + simpa [directInstruction] using! executeInstructionTM_direct_hoareTime_frame tapes .add store pcValue destination source₀ source₁ initialWork inp₀ hready hinput @@ -1001,7 +1001,7 @@ theorem executeInstructionTM_sub_hoareTime_frame out = (Tape.init []).move Dir3.right) (executeInstructionTime tapes (.sub destination source₀ source₁) pcValue store) := by - simpa [directInstruction] using + simpa [directInstruction] using! executeInstructionTM_direct_hoareTime_frame tapes .sub store pcValue destination source₀ source₁ initialWork inp₀ hready hinput @@ -1023,7 +1023,7 @@ theorem executeInstructionTM_mul_hoareTime_frame out = (Tape.init []).move Dir3.right) (executeInstructionTime tapes (.mul destination source₀ source₁) pcValue store) := by - simpa [directInstruction] using + simpa [directInstruction] using! executeInstructionTM_direct_hoareTime_frame tapes .mul store pcValue destination source₀ source₁ initialWork inp₀ hready hinput @@ -1073,7 +1073,7 @@ theorem executeInstructionTM_load_hoareTime_frame ((instructionStore instruction pcValue store).flatMap Entry.encode)) (indirectLoadInstructionTime tapes.data store destination addressRegister) := by - simpa [Result, instruction, instructionStore, Snapshot.stepInstr] using + simpa [Result, instruction, instructionStore, Snapshot.stepInstr] using! hbaseRaw have hresult : ∀ work, Result work → work tapes.pc = initialWork (Fin.castSucc tapes.pc) ∧ @@ -1121,7 +1121,7 @@ theorem executeInstructionTM_load_hoareTime_frame fin_cases slot · exact ⟨houtcome.ready.queryStart, by simpa [instruction, instructionCleanupValue, - instructionCleanupParentSlot] using houtcome.ready.query⟩ + instructionCleanupParentSlot] using! houtcome.ready.query⟩ · change (work tapes.data.update.replacement).HasBinaryNat _ rw [show work tapes.data.update.replacement = updateWork tapes.data.update.replacement from houtcome.replacement, @@ -1132,7 +1132,7 @@ theorem executeInstructionTM_load_hoareTime_frame (tapes.data.update.ne (by decide)) _ _] exact hloaded.value · simpa [instruction, instructionCleanupValue, - instructionCleanupParentSlot] using houtcome.found + instructionCleanupParentSlot] using! houtcome.found · change (work tapes.data.lhs).HasBinaryNat _ rw [show work tapes.data.lhs = updateWork tapes.data.lhs from houtcome.frame tapes.data.lhs (fun role => @@ -1143,7 +1143,7 @@ theorem executeInstructionTM_load_hoareTime_frame (tapes.data.update_ne_lhs 7).symm _ _] rw [show loadedWork tapes.data.lhs = addressWork tapes.data.lhs from hloaded.querySource] - simpa [instruction, instructionCleanupValue] using haddress.destination + simpa [instruction, instructionCleanupValue] using! haddress.destination · change (work tapes.data.rhs).HasBinaryNat _ rw [show work tapes.data.rhs = updateWork tapes.data.rhs from houtcome.frame tapes.data.rhs (fun role => @@ -1168,7 +1168,7 @@ theorem executeInstructionTM_load_hoareTime_frame hloaded.frame tapes.data.shift (fun slot => by apply tapes.data.ne fin_cases slot <;> decide)] - simpa using haddress.querySource + simpa using! haddress.querySource have htmp' : (work tapes.data.tmp).HasBinaryNat 0 := by have hqueryNe : tapes.data.tmp ≠ tapes.data.update.entry.query := @@ -1198,17 +1198,17 @@ theorem executeInstructionTM_load_hoareTime_frame refine ⟨hpcOutcome.trans (hpcUpdate.trans (hpcLoaded.trans hpcAddress)), ?_, hsourceContent, hcleanup, ?_, ?_, hshift, htmp', hdbl', houtcome.ready.parked⟩ - · simpa [instruction, instructionStore, Snapshot.stepInstr] using + · simpa [instruction, instructionStore, Snapshot.stepInstr] using! houtcome.resultCount - · simpa [instruction, instructionRemainingValue] using + · simpa [instruction, instructionRemainingValue] using! houtcome.remaining - · simpa [instruction, instructionCleanupValue] using houtcome.ready + · simpa [instruction, instructionCleanupValue] using! houtcome.ready have hdata := retargetDataKernel_hoareTime_frame_internal tapes instruction store pcValue initialWork inp₀ (indirectLoadInstructionTM tapes.data destination addressRegister) (indirectLoadInstructionTime tapes.data store destination addressRegister) Result hready hbase hresult - simpa only [instruction, executeInstructionTM, executeInstructionTime] using + simpa only [instruction, executeInstructionTM, executeInstructionTime] using! finishDataInstructionTM_hoareTime_frame_internal tapes instruction store pcValue initialWork inp₀ (indirectLoadInstructionTM tapes.data destination addressRegister) @@ -1261,7 +1261,7 @@ theorem executeInstructionTM_store_hoareTime_frame out.HasBinaryPrefix ((instructionStore instruction pcValue store).flatMap Entry.encode)) (indirectStoreInstructionTime tapes.data store addressRegister source) := by - simpa [Result, instruction, instructionStore, Snapshot.stepInstr] using + simpa [Result, instruction, instructionStore, Snapshot.stepInstr] using! hbaseRaw have hresult : ∀ work, Result work → work tapes.pc = initialWork (Fin.castSucc tapes.pc) ∧ @@ -1313,7 +1313,7 @@ theorem executeInstructionTM_store_hoareTime_frame fin_cases slot · exact ⟨houtcome.ready.queryStart, by simpa [instruction, instructionCleanupValue, - instructionCleanupParentSlot] using houtcome.ready.query⟩ + instructionCleanupParentSlot] using! houtcome.ready.query⟩ · change (work tapes.data.update.replacement).HasBinaryNat _ rw [show work tapes.data.update.replacement = updateWork tapes.data.update.replacement from houtcome.replacement, @@ -1321,7 +1321,7 @@ theorem executeInstructionTM_store_hoareTime_frame exact Tape.init_move_right_hasBinaryNat (RegisterStore.read store source) · simpa [instruction, instructionCleanupValue, - instructionCleanupParentSlot] using houtcome.found + instructionCleanupParentSlot] using! houtcome.found · change (work tapes.data.lhs).HasBinaryNat _ rw [show work tapes.data.lhs = updateWork tapes.data.lhs from houtcome.frame tapes.data.lhs (fun role => @@ -1361,7 +1361,7 @@ theorem executeInstructionTM_store_hoareTime_frame (tapes.data.update_ne_shift slot).symm), hupdateWork, Function.update_of_ne hreplacementNe, hqueryWork, Function.update_of_ne hqueryNe] - simpa using hrhsResult.querySource + simpa using! hrhsResult.querySource have htmp' : (work tapes.data.tmp).HasBinaryNat 0 := by have hreplacementNe : tapes.data.tmp ≠ tapes.data.update.replacement := @@ -1397,17 +1397,17 @@ theorem executeInstructionTM_store_hoareTime_frame refine ⟨hpcOutcome.trans (hpcUpdate.trans (hpcQueryWork.trans (hpcRhs.trans hpcLhs))), ?_, hsourceContent, hcleanup, ?_, ?_, hshift, htmp', hdbl', houtcome.ready.parked⟩ - · simpa [instruction, instructionStore, Snapshot.stepInstr] using + · simpa [instruction, instructionStore, Snapshot.stepInstr] using! houtcome.resultCount - · simpa [instruction, instructionRemainingValue] using + · simpa [instruction, instructionRemainingValue] using! houtcome.remaining - · simpa [instruction, instructionCleanupValue] using houtcome.ready + · simpa [instruction, instructionCleanupValue] using! houtcome.ready have hdata := retargetDataKernel_hoareTime_frame_internal tapes instruction store pcValue initialWork inp₀ (indirectStoreInstructionTM tapes.data addressRegister source) (indirectStoreInstructionTime tapes.data store addressRegister source) Result hready hbase hresult - simpa only [instruction, executeInstructionTM, executeInstructionTime] using + simpa only [instruction, executeInstructionTM, executeInstructionTime] using! finishDataInstructionTM_hoareTime_frame_internal tapes instruction store pcValue initialWork inp₀ (indirectStoreInstructionTM tapes.data addressRegister source) From 963f50914f78013e1ffd730448a9a4af969ad660 Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Tue, 22 Sep 2026 02:46:36 +0000 Subject: [PATCH 17/49] Port certificate bounds and remaining machine carrier equalities --- .../BeyondBethe/BetheEpigraphFeasibility.lean | 21 ++- .../BeyondBethe/DirectedCertificateValue.lean | 24 +-- .../BeyondBethe/MachineBinaryMul.lean | 18 +- .../BeyondBethe/MachineLengthBits.lean | 4 +- .../Machine/Instruction/DenseSimData.lean | 90 ++++----- .../Machine/Program/Internal.lean | 174 +++++++++--------- 6 files changed, 169 insertions(+), 162 deletions(-) diff --git a/LeanPool/BeyondBethe/BeyondBethe/BetheEpigraphFeasibility.lean b/LeanPool/BeyondBethe/BeyondBethe/BetheEpigraphFeasibility.lean index 1cf8b64319..b5535b56c0 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/BetheEpigraphFeasibility.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/BetheEpigraphFeasibility.lean @@ -132,14 +132,14 @@ theorem betheBoundedEpigraphOracle_valid {m : ℕ} (hm : 0 < m) have hbelow : betheAffineMatrixQ (epigraphBase E.center) ij.1 ij.2 < δ := by apply firstBetheFloorViolation_is_below - simpa only [firstBetheFloorViolationAll] using hfloorScan + simpa only [firstBetheFloorViolationAll] using! hfloorScan have htargetFloor : (δ : ℝ) ≤ birkhoffAffineMap (vectorToSquareMatrix (epigraphBase z)) ij.1 ij.2 := by - simpa only [BetheEpigraphTarget] using hz.1 ij.1 ij.2 + simpa only [BetheEpigraphTarget] using! hz.1 ij.1 ij.2 have hcut := betheFloorCut_valid hbelow htargetFloor rw [finiteDot, Fin.sum_univ_castSucc] at hcut ⊢ - simpa [rationalCenterReal, epigraphBase] using hcut.le + simpa [rationalCenterReal, epigraphBase] using! hcut.le · split at hresponse <;> rename_i hheight · cases hresponse refine ⟨epigraphUpperNormal_ne_zero (m * m), ?_⟩ @@ -149,9 +149,9 @@ theorem betheBoundedEpigraphOracle_valid {m : ℕ} (hm : 0 < m) (fun i ↦ (epigraphUpperNormal (m * m) i : ℝ)) (fun i ↦ z i - rationalCenterReal E i) = epigraphHeight z - (epigraphHeight E.center : ℚ) by - simpa only [rationalCenterReal] using hdot] + simpa only [rationalCenterReal] using! hdot] have hzUpper : epigraphHeight z ≤ (upper : ℝ) := by - simpa only [BetheEpigraphTarget] using hz.2.2 + simpa only [BetheEpigraphTarget] using! hz.2.2 have hheightReal : (upper : ℝ) < ((epigraphHeight E.center : ℚ) : ℝ) := by exact_mod_cast hheight @@ -214,12 +214,12 @@ theorem BetheEpigraphOracleAccepted_exact_objective_upper {m : ℕ} let Xq : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ := betheAffineMatrixQ y have hfloor : ∀ i j, δ ≤ Xq i j := by - simpa only [Xq, y] using haccepted.1 + simpa only [Xq, y] using! haccepted.1 have hX0 : ∀ i j, 0 < Xq i j := fun i j ↦ hδ.trans_le (hfloor i j) have hinterior := birkhoffAffineMap_interior hm hδ (Y := vectorToSquareMatrix y) (by - simpa only [Xq, betheAffineMatrixQ] using hfloor) + simpa only [Xq, betheAffineMatrixQ] using! hfloor) have hX1 : ∀ i j, Xq i j < 1 := by intro i j have h := (hinterior.2 i).2 j |>.2 @@ -230,7 +230,7 @@ theorem BetheEpigraphOracleAccepted_exact_objective_upper {m : ℕ} directedNegativeObjectiveLower τ A Xq p ≤ epigraphHeight q + 16 * (1 / 2 : ℚ) ^ p * (m * m) := by simpa only [BetheEpigraphOracleAccepted, - betheDirectedEpigraphData, Xq, y] using haccepted.2.2 + betheDirectedEpigraphData, Xq, y] using! haccepted.2.2 have hlowerAccepted : (directedNegativeObjectiveLower τ A Xq p : ℝ) ≤ ((epigraphHeight q : ℚ) : ℝ) + @@ -243,8 +243,9 @@ theorem BetheEpigraphOracleAccepted_exact_objective_upper {m : ℕ} fun i j ↦ ((Xq i j : ℚ) : ℝ) := by ext i j symm - simpa only [Xq, y] using cast_betheAffineMatrixQ y i j - rw [affineNegativeObjective, hcast] + simpa only [Xq, y] using! cast_betheAffineMatrixQ y i j + unfold affineNegativeObjective + rw [hcast] linarith [hbounds.2.1, hbounds.2.2] theorem BetheEpigraphOracleAccepted_exact_objective_upper_compact {m : ℕ} diff --git a/LeanPool/BeyondBethe/BeyondBethe/DirectedCertificateValue.lean b/LeanPool/BeyondBethe/BeyondBethe/DirectedCertificateValue.lean index 55a5839207..9568dfa9b0 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/DirectedCertificateValue.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/DirectedCertificateValue.lean @@ -74,7 +74,7 @@ theorem nearbyBetheObjective_eq_logExpression have hpos : ∀ i j, 0 < X i j := fun i j ↦ (hXint i).2 j |>.1 have hlt : ∀ i j, X i j < 1 := fun i j ↦ (hXint i).2 j |>.2 have hpot := weighted_potentials_eq_sum hX Rr Cr - rw [betheObjective] + unfold betheObjective change (∑ i, betheRowObjective (nearbyKKTMatrix (τ : ℝ) X Rr Cr) X i) = _ simp_rw [betheRowObjective, Real.negMulLog_def] @@ -187,7 +187,7 @@ theorem directedNearbyBetheLower_bounds have hx1 : Xq i j < 1 := by have h := (hXint i).2 j |>.2 change ((Xq i j : ℚ) : ℝ) < 1 at h - exact (Rat.cast_lt (K := ℝ)).mp (by simpa using h) + exact (Rat.cast_lt (K := ℝ)).mp (by simpa using! h) exact directedNearbyCoordinateLower_bounds hτ0 hτ1 hx0 hx1 p have hsumLower : (∑ i, ∑ j, lowerCoordinate i j) ≤ ∑ i, ∑ j, exactCoordinate i j := @@ -212,14 +212,14 @@ theorem directedNearbyBetheLower_bounds (∑ i, ∑ j, (directedNearbyCoordinateLower τ (Xq i j) p : ℝ)) ≤ ∑ i, ∑ j, (Real.log ((1 - Xq i j : ℚ) : ℝ) + (τ : ℝ) * (Xq i j : ℝ) * Real.log (Xq i j : ℝ)) := by - simpa only [lowerCoordinate, exactCoordinate] using hsumLower + simpa only [lowerCoordinate, exactCoordinate] using! hsumLower have hsumUpper' : (∑ i, ∑ j, (Real.log ((1 - Xq i j : ℚ) : ℝ) + (τ : ℝ) * (Xq i j : ℝ) * Real.log (Xq i j : ℝ))) ≤ (∑ i, ∑ j, (directedNearbyCoordinateLower τ (Xq i j) p : ℝ)) + 2 * (n : ℝ) ^ 2 * (((1 / 2 : ℚ) ^ p : ℚ) : ℝ) := by - simpa only [lowerCoordinate, exactCoordinate] using hsumUpper + simpa only [lowerCoordinate, exactCoordinate] using! hsumUpper norm_num only [Rat.cast_sub, Rat.cast_one, Rat.cast_pow, Rat.cast_div, Rat.cast_ofNat] at hsumLower' hsumUpper' ⊢ constructor <;> linarith @@ -253,7 +253,9 @@ theorem dyadic_399_le_logEvaluationLoss : have hq : (1 / 2 : ℚ) ^ 399 ≤ explicitLogEvaluationLoss := by rw [explicitLogEvaluationLoss, explicitCertifiedEpsilon, explicitCertifiedEpsilon_eq] - norm_num [explicitXi, explicitDelta, explicitEta, explicitRowRatio] + norm_num [explicitXi, explicitDelta, explicitEta, explicitRowRatio] + exact (pow_le_pow_of_le_one (by norm_num : 0 ≤ (1 / 2 : ℚ)) + (by norm_num : (1 / 2 : ℚ) ≤ 1) (show 240 ≤ 399 by omega)).trans (by norm_num) have hcast : (((1 / 2 : ℚ) ^ 399 : ℚ) : ℝ) ≤ (explicitLogEvaluationLoss : ℝ) := Rat.cast_le.mpr hq norm_num only [Rat.cast_pow, Rat.cast_div, Rat.cast_one, @@ -271,7 +273,7 @@ theorem directedCertificatePrecision_error have hratio : (n : ℝ) * (1 / 2 : ℝ) ^ n ≤ 1 := by simp only [one_div, inv_pow] rw [mul_inv_le_iff₀ hpowpos] - simpa using hnatR + simpa using! hnatR have hconst := dyadic_399_le_logEvaluationLoss rw [directedCertificatePrecision, pow_add] norm_num only [Rat.cast_mul, Rat.cast_pow, Rat.cast_div, @@ -337,7 +339,7 @@ theorem explicitDirectedCertificateLog_bounds have herr := directedCertificatePrecision_error (show 1 ≤ n by omega) rw [explicitDirectedCertificateLog, executableNearbyCertificateLog] norm_num only [Rat.cast_add, Rat.cast_sub, Rat.cast_mul, Rat.cast_natCast] - constructor <;> dsimp only <;> linarith + constructor <;> linarith theorem explicitDirectedCertificateValue_pos {n : ℕ} (hn : 1 ≤ n) @@ -381,7 +383,7 @@ theorem explicitDirectedCertificate_twoSided have hlog := explicitDirectedCertificateLog_bounds hn R C hX hXint have hlog' : qlog ≤ exactLog ∧ exactLog ≤ qlog + (explicitLogEvaluationLoss : ℝ) * n := by - simpa only [qlog, exactLog] using hlog + simpa only [qlog, exactLog] using! hlog have hlossQ : 0 < explicitExpEvaluationLoss * n := mul_pos explicitExpEvaluationLoss_pos (by exact_mod_cast (show 0 < n by omega)) have hexpQ := rationalExpLower_bounds @@ -390,7 +392,7 @@ theorem explicitDirectedCertificate_twoSided (qlog - (explicitExpEvaluationLoss : ℝ) * n) ≤ qvalue ∧ qvalue ≤ Real.exp qlog := by simpa only [qlog, qvalue, explicitDirectedCertificateValue, - Rat.cast_mul, Rat.cast_natCast] using hexpQ + Rat.cast_mul, Rat.cast_natCast] using! hexpQ have htransfer := executableNearbyCertificate_twoSided stableCoefficient hn hA hX hXint happrox have htransfer' : L ≤ Matrix.permanent A ∧ @@ -398,7 +400,7 @@ theorem explicitDirectedCertificate_twoSided (Real.sqrt 2 * Real.exp (-((explicitCertifiedEpsilon : ℝ) - 2 * (explicitKKTError : ℝ)))) ^ n * L := by - simpa only [L, explicitCertifiedEpsilon] using htransfer + simpa only [L, explicitCertifiedEpsilon] using! htransfer have hL : L = Real.exp exactLog := by rfl constructor @@ -517,7 +519,7 @@ theorem explicitDirectedCertificate_twoSided 2 * (explicitKKTError : ℝ)))) * (Real.exp (explicitLogEvaluationLoss : ℝ) * Real.exp (explicitExpEvaluationLoss : ℝ))) ^ n * qvalue := by - simpa [mul_pow, mul_assoc] using hraw + simpa [mul_pow, mul_assoc] using! hraw _ ≤ (preSmoothingBase (explicitCertifiedEpsilon : ℝ)) ^ n * qvalue := mul_le_mul_of_nonneg_right hbasePow (explicitDirectedCertificateValue_pos (show 1 ≤ n by omega) X R C).le diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryMul.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryMul.lean index c4f0c7feb7..7c09d0fa63 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryMul.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryMul.lean @@ -70,16 +70,16 @@ def machineBinaryMulBits (word : List Bool) : List Bool := theorem machineBinaryMulRemaining_mem_FP : machineBinaryMulRemaining ∈ Complexity.FP := by - simpa only [machineBinaryMulRemaining] using machinePairFirst_mem_FP + simpa only [machineBinaryMulRemaining] using! machinePairFirst_mem_FP theorem machineBinaryMulShift_mem_FP : machineBinaryMulShift ∈ Complexity.FP := by - simpa only [machineBinaryMulShift] using + simpa only [machineBinaryMulShift] using! machineCompose_mem_FP machinePairSecond_mem_FP machinePairFirst_mem_FP theorem machineBinaryMulAcc_mem_FP : machineBinaryMulAcc ∈ Complexity.FP := by - simpa only [machineBinaryMulAcc] using + simpa only [machineBinaryMulAcc] using! machineCompose_mem_FP machinePairSecond_mem_FP machinePairSecond_mem_FP theorem machineBinaryMulPack_mem_FP @@ -96,7 +96,7 @@ theorem machineBinaryMulNextShift_mem_FP : (machineBinaryMulShift state)) ∈ Complexity.FP := machinePair_mem_FP machineBinaryMulShift_mem_FP machineBinaryMulShift_mem_FP - simpa only [machineBinaryMulNextShift] using + simpa only [machineBinaryMulNextShift] using! machineCompose_mem_FP hpair machineBinaryAddBits_mem_FP theorem machineBinaryMulNextAcc_mem_FP : @@ -130,7 +130,7 @@ theorem machineBinaryMulInit_mem_FP : theorem machineBinaryMulRuler_mem_FP : machineBinaryMulRuler ∈ Complexity.FP := by - simpa only [machineBinaryMulRuler] using machinePairSecond_mem_FP + simpa only [machineBinaryMulRuler] using! machinePairSecond_mem_FP theorem machineBinaryMulWidth_mem_FP : machineBinaryMulWidth ∈ Complexity.FP := by @@ -139,7 +139,7 @@ theorem machineBinaryMulWidth_mem_FP : have hpadded : padded ∈ Complexity.FP := machineAppend_mem_FP (machineConst_mem_FP (List.replicate 16 false)) id_mem_FP - simpa only [machineBinaryMulWidth, padded] using + simpa only [machineBinaryMulWidth, padded] using! Cobham.mulLenFn_mem_FP hpadded hpadded @[simp] theorem machineBinaryMulRemaining_pack (remaining shift acc) : @@ -246,7 +246,7 @@ theorem machineBinaryMulIterate_reachable (word : List Bool) : | zero => exact machineBinaryMulInit_reachable word | succ iterations ih => rw [Function.iterate_succ_apply'] - simpa [Nat.succ_eq_add_one] using machineBinaryMulStep_reachable ih + simpa [Nat.succ_eq_add_one] using! machineBinaryMulStep_reachable ih theorem machineBinaryMulIterate_length_le_width (word : List Bool) (iterations : ℕ) @@ -273,7 +273,7 @@ theorem machineBinaryMulFinalState_mem_FP : theorem machineBinaryMulBits_mem_FP : machineBinaryMulBits ∈ Complexity.FP := by - simpa only [machineBinaryMulBits] using + simpa only [machineBinaryMulBits] using! machineCompose_mem_FP machineBinaryMulFinalState_mem_FP machineBinaryMulAcc_mem_FP @@ -315,7 +315,7 @@ theorem machineBinaryMulBits_pair_natBits (lhs rhs : ℕ) : have hfold := binaryMulFold_natBits rhs.bits lhs 0 calc (binaryMulFold rhs.bits lhs.bits []).2 = - (lhs * Nat.fromBitsLE rhs.bits).bits := by simpa using hfold + (lhs * Nat.fromBitsLE rhs.bits).bits := by simpa using! hfold _ = (lhs * rhs).bits := by rw [Nat.fromBitsLE_bits] end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineLengthBits.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineLengthBits.lean index c3e16d073f..9841cb2697 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineLengthBits.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineLengthBits.lean @@ -29,7 +29,7 @@ def machineLengthBits (word : List Bool) : List Bool := theorem machineLengthBitsStep_mem_FP : machineLengthBitsStep ∈ Complexity.FP := by have hpair := machinePair_mem_FP id_mem_FP (machineConst_mem_FP [true]) - simpa only [machineLengthBitsStep] using + simpa only [machineLengthBitsStep] using! machineCompose_mem_FP hpair machineBinaryAddBits_mem_FP theorem machineLengthBitsWidth_mem_FP : @@ -58,7 +58,7 @@ theorem machineLengthBitsIterate_length_le_width exact (lengthBits_natBits_length_le_self iterations).trans hiterations theorem machineLengthBits_mem_FP : machineLengthBits ∈ Complexity.FP := by - simpa only [machineLengthBits] using + simpa only [machineLengthBits] using! Cobham.iterate_mem_FP machineLengthBitsStep_mem_FP (machineConst_mem_FP []) id_mem_FP machineLengthBitsWidth_mem_FP machineLengthBitsIterate_length_le_width diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseSimData.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseSimData.lean index 8513e6498a..6f6928ab5e 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseSimData.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseSimData.lean @@ -56,7 +56,7 @@ theorem denseExecuteInstructionTM_imm_hoareTime_frame denseInstructionCleanupValue input (.imm destination value) overlay have hinput : TM.Parked inp₀ := by refine ⟨by simp [inp₀, Tape.move], ?_⟩ - simpa [inp₀] using Tape.init_ofBool_move_right_cells_ne_start input + simpa [inp₀] using! Tape.init_ofBool_move_right_cells_ne_start input have hlookup : EntryLookupStaticReady tapes.data.lhsLookup overlay baseWork := instructionExecutionReady_baseLookup_internal tapes overlay pcValue @@ -80,7 +80,7 @@ theorem denseExecuteInstructionTM_imm_hoareTime_frame inp = inp₀ ∧ Result work ∧ out.HasBinaryPrefix (nextStore.flatMap Entry.encode)) (denseImmediateInstructionTime tapes.data overlay destination value) := by - simpa [Result, nextStore] using hbaseRaw + simpa [Result, nextStore] using! hbaseRaw have hresult : ∀ work, Result work → work tapes.pc = initialWork (Fin.castSucc tapes.pc) ∧ (work tapes.data.update.resultCount).HasBinaryNat nextStore.length ∧ @@ -142,12 +142,12 @@ theorem denseExecuteInstructionTM_imm_hoareTime_frame fin_cases slot · exact ⟨houtcome.ready.queryStart, by simpa [cleanupValues, denseInstructionCleanupValue, - instructionCleanupParentSlot] using houtcome.ready.query⟩ + instructionCleanupParentSlot] using! houtcome.ready.query⟩ · change (work tapes.data.update.replacement).HasBinaryNat (value + 1) rw [houtcome.replacement] exact htagValue · simpa [cleanupValues, denseInstructionCleanupValue, - instructionCleanupParentSlot] using houtcome.found + instructionCleanupParentSlot] using! houtcome.found · change (work tapes.data.lhs).HasBinaryNat 0 rw [houtcome.frame tapes.data.lhs (fun role => (tapes.data.update_ne_lhs role).symm), @@ -217,9 +217,9 @@ theorem denseExecuteInstructionTM_imm_hoareTime_frame exact hready.dbl refine ⟨hpc, ?_, hsourceContent, hcleanup, ?_, ?_, hshift, htmp, hdbl, houtcome.ready.parked⟩ - · simpa [nextStore] using houtcome.resultCount - · simpa using houtcome.remaining - · simpa [cleanupValues, denseInstructionCleanupValue] using + · simpa [nextStore] using! houtcome.resultCount + · simpa using! houtcome.remaining + · simpa [cleanupValues, denseInstructionCleanupValue] using! houtcome.ready have hdata := retargetBufferedDataKernel_hoareTime_frame_internal tapes overlay nextStore cleanupValues 0 pcValue initialWork inp₀ @@ -234,7 +234,7 @@ theorem denseExecuteInstructionTM_imm_hoareTime_frame simpa [denseExecuteInstructionTM, denseExecuteInstructionTime, DenseInstructionExecutionResult, denseInstructionStore, denseInstructionPC, DenseOverlay.Snapshot.stepInstr, nextStore, - cleanupValues] using hall + cleanupValues] using! hall /-- Instruction constructor corresponding to a dense direct arithmetic kernel. -/ @@ -277,7 +277,7 @@ theorem denseExecuteInstructionTM_direct_hoareTime_frame let cleanupValues := denseInstructionCleanupValue input instruction overlay have hinput : TM.Parked inp₀ := by refine ⟨by simp [inp₀, Tape.move], ?_⟩ - simpa [inp₀] using Tape.init_ofBool_move_right_cells_ne_start input + simpa [inp₀] using! Tape.init_ofBool_move_right_cells_ne_start input have hlookup : EntryLookupStaticReady tapes.data.lhsLookup overlay baseWork := instructionExecutionReady_baseLookup_internal tapes overlay pcValue @@ -307,7 +307,7 @@ theorem denseExecuteInstructionTM_direct_hoareTime_frame out.HasBinaryPrefix (nextStore.flatMap Entry.encode)) (denseDirectBinaryInstructionTime tapes.data op input overlay destination source₀ source₁) := by - simpa [Result, lhs, rhs, nextStore] using hbaseRaw + simpa [Result, lhs, rhs, nextStore] using! hbaseRaw have hresult : ∀ work, Result work → work tapes.pc = initialWork (Fin.castSucc tapes.pc) ∧ (work tapes.data.update.resultCount).HasBinaryNat nextStore.length ∧ @@ -391,17 +391,17 @@ theorem denseExecuteInstructionTM_direct_hoareTime_frame cases op <;> simpa [instruction, denseDirectInstruction, cleanupValues, denseInstructionCleanupValue, instructionCleanupParentSlot] - using houtcome.ready.query⟩ + using! houtcome.ready.query⟩ · change (work tapes.data.update.replacement).HasBinaryNat _ rw [houtcome.replacement] cases op <;> simpa [instruction, denseDirectInstruction, cleanupValues, denseInstructionCleanupValue, lhs, rhs, BinaryInstrOp.eval] - using htagValue + using! htagValue · cases op <;> simpa [instruction, denseDirectInstruction, cleanupValues, denseInstructionCleanupValue, instructionCleanupParentSlot] - using houtcome.found + using! houtcome.found · change (work tapes.data.lhs).HasBinaryNat _ rw [houtcome.frame tapes.data.lhs (fun role => (tapes.data.update_ne_lhs role).symm), @@ -409,7 +409,7 @@ theorem denseExecuteInstructionTM_direct_hoareTime_frame (tapes.data.update_ne_lhs 10).symm] cases op <;> simpa [instruction, denseDirectInstruction, cleanupValues, - denseInstructionCleanupValue, lhs] using harithmetic.lhsValue + denseInstructionCleanupValue, lhs] using! harithmetic.lhsValue · change (work tapes.data.rhs).HasBinaryNat _ rw [houtcome.frame tapes.data.rhs (fun role => (tapes.data.update_ne_rhs role).symm), @@ -417,7 +417,7 @@ theorem denseExecuteInstructionTM_direct_hoareTime_frame (tapes.data.update_ne_rhs 10).symm] cases op <;> simpa [instruction, denseDirectInstruction, cleanupValues, - denseInstructionCleanupValue, rhs] using harithmetic.rhsValue + denseInstructionCleanupValue, rhs] using! harithmetic.rhsValue have hshift : (work tapes.data.shift).HasBinaryNat 0 := by rw [houtcome.frame tapes.data.shift (fun slot => (tapes.data.update_ne_shift slot).symm), @@ -436,11 +436,11 @@ theorem denseExecuteInstructionTM_direct_hoareTime_frame refine ⟨hpcUpdate.trans (hpcTag.trans (hpcArithmetic.trans (hpcAddress.trans (hpcRhs.trans hpcLhs)))), ?_, hsourceContent, hcleanup, ?_, ?_, hshift, htmp', hdbl', houtcome.ready.parked⟩ - · simpa [nextStore, DenseOverlay.write] using houtcome.resultCount - · simpa using houtcome.remaining + · simpa [nextStore, DenseOverlay.write] using! houtcome.resultCount + · simpa using! houtcome.remaining · cases op <;> simpa [instruction, denseDirectInstruction, cleanupValues, - denseInstructionCleanupValue] using houtcome.ready + denseInstructionCleanupValue] using! houtcome.ready have hdata := retargetBufferedDataKernel_hoareTime_frame_internal tapes overlay nextStore cleanupValues 0 pcValue initialWork inp₀ (denseDirectBinaryInstructionTM tapes.data op destination source₀ source₁) @@ -456,7 +456,7 @@ theorem denseExecuteInstructionTM_direct_hoareTime_frame denseExecuteInstructionTime, DenseInstructionExecutionResult, denseInstructionStore, denseInstructionPC, DenseOverlay.Snapshot.stepInstr, nextStore, cleanupValues, lhs, rhs, - BinaryInstrOp.eval] using hall + BinaryInstrOp.eval] using! hall /-- Dense direct addition has the common buffered instruction contract. -/ theorem denseExecuteInstructionTM_add_hoareTime_frame @@ -477,7 +477,7 @@ theorem denseExecuteInstructionTM_add_hoareTime_frame out = (Tape.init []).move Dir3.right) (denseExecuteInstructionTime tapes input (.add destination source₀ source₁) pcValue overlay) := by - simpa [denseDirectInstruction] using + simpa [denseDirectInstruction] using! denseExecuteInstructionTM_direct_hoareTime_frame tapes .add input overlay pcValue destination source₀ source₁ initialWork hvalid hready @@ -500,7 +500,7 @@ theorem denseExecuteInstructionTM_sub_hoareTime_frame out = (Tape.init []).move Dir3.right) (denseExecuteInstructionTime tapes input (.sub destination source₀ source₁) pcValue overlay) := by - simpa [denseDirectInstruction] using + simpa [denseDirectInstruction] using! denseExecuteInstructionTM_direct_hoareTime_frame tapes .sub input overlay pcValue destination source₀ source₁ initialWork hvalid hready @@ -523,7 +523,7 @@ theorem denseExecuteInstructionTM_mul_hoareTime_frame out = (Tape.init []).move Dir3.right) (denseExecuteInstructionTime tapes input (.mul destination source₀ source₁) pcValue overlay) := by - simpa [denseDirectInstruction] using + simpa [denseDirectInstruction] using! denseExecuteInstructionTM_direct_hoareTime_frame tapes .mul input overlay pcValue destination source₀ source₁ initialWork hvalid hready @@ -556,7 +556,7 @@ theorem denseExecuteInstructionTM_load_hoareTime_frame let cleanupValues := denseInstructionCleanupValue input instruction overlay have hinput : TM.Parked inp₀ := by refine ⟨by simp [inp₀, Tape.move], ?_⟩ - simpa [inp₀] using Tape.init_ofBool_move_right_cells_ne_start input + simpa [inp₀] using! Tape.init_ofBool_move_right_cells_ne_start input have hlookup : EntryLookupStaticReady tapes.data.lhsLookup overlay baseWork := instructionExecutionReady_baseLookup_internal tapes overlay pcValue @@ -582,7 +582,7 @@ theorem denseExecuteInstructionTM_load_hoareTime_frame out.HasBinaryPrefix (nextStore.flatMap Entry.encode)) (denseIndirectLoadInstructionTime tapes.data input overlay destination addressRegister) := by - simpa [Result, address, value, nextStore] using hbaseRaw + simpa [Result, address, value, nextStore] using! hbaseRaw have hresult : ∀ work, Result work → work tapes.pc = initialWork (Fin.castSucc tapes.pc) ∧ (work tapes.data.update.resultCount).HasBinaryNat nextStore.length ∧ @@ -647,13 +647,13 @@ theorem denseExecuteInstructionTM_load_hoareTime_frame fin_cases slot · exact ⟨houtcome.ready.queryStart, by simpa [instruction, cleanupValues, denseInstructionCleanupValue, - instructionCleanupParentSlot] using houtcome.ready.query⟩ + instructionCleanupParentSlot] using! houtcome.ready.query⟩ · change (work tapes.data.update.replacement).HasBinaryNat _ rw [houtcome.replacement] simpa [instruction, cleanupValues, denseInstructionCleanupValue, - address, value] using htagValue + address, value] using! htagValue · simpa [instruction, cleanupValues, denseInstructionCleanupValue, - instructionCleanupParentSlot] using houtcome.found + instructionCleanupParentSlot] using! houtcome.found · change (work tapes.data.lhs).HasBinaryNat _ rw [houtcome.frame tapes.data.lhs (fun role => (tapes.data.update_ne_lhs role).symm), @@ -666,7 +666,7 @@ theorem denseExecuteInstructionTM_load_hoareTime_frame show loadedWork tapes.data.lhs = addressWork tapes.data.lhs from hloaded.querySource] simpa [instruction, cleanupValues, denseInstructionCleanupValue, - address] using haddress.destination + address] using! haddress.destination · change (work tapes.data.rhs).HasBinaryNat _ rw [houtcome.frame tapes.data.rhs (fun role => (tapes.data.update_ne_rhs role).symm), @@ -693,7 +693,7 @@ theorem denseExecuteInstructionTM_load_hoareTime_frame hloaded.frame tapes.data.shift (fun slot => by apply tapes.data.ne fin_cases slot <;> decide)] - simpa using haddress.querySource + simpa using! haddress.querySource have htmp' : (work tapes.data.tmp).HasBinaryNat 0 := by have hqueryNe : tapes.data.tmp ≠ tapes.data.update.entry.query := @@ -725,10 +725,10 @@ theorem denseExecuteInstructionTM_load_hoareTime_frame refine ⟨hpcOutcome.trans (hpcTag.trans (hpcUpdate.trans (hpcLoaded.trans hpcAddress))), ?_, hsourceContent, hcleanup, ?_, ?_, hshift, htmp', hdbl', houtcome.ready.parked⟩ - · simpa [nextStore, DenseOverlay.write] using houtcome.resultCount - · simpa using houtcome.remaining + · simpa [nextStore, DenseOverlay.write] using! houtcome.resultCount + · simpa using! houtcome.remaining · simpa [instruction, cleanupValues, denseInstructionCleanupValue] - using houtcome.ready + using! houtcome.ready have hdata := retargetBufferedDataKernel_hoareTime_frame_internal tapes overlay nextStore cleanupValues 0 pcValue initialWork inp₀ (denseIndirectLoadInstructionTM tapes.data destination addressRegister) @@ -743,7 +743,7 @@ theorem denseExecuteInstructionTM_load_hoareTime_frame denseExecuteInstructionTime, DenseInstructionExecutionResult, denseInstructionStore, denseInstructionPC, DenseOverlay.Snapshot.stepInstr, nextStore, cleanupValues, address, - value] using hall + value] using! hall /-- A dense indirect store produces the generic buffered endpoint and advances the program counter. -/ @@ -774,7 +774,7 @@ theorem denseExecuteInstructionTM_store_hoareTime_frame let cleanupValues := denseInstructionCleanupValue input instruction overlay have hinput : TM.Parked inp₀ := by refine ⟨by simp [inp₀, Tape.move], ?_⟩ - simpa [inp₀] using Tape.init_ofBool_move_right_cells_ne_start input + simpa [inp₀] using! Tape.init_ofBool_move_right_cells_ne_start input have hlookup : EntryLookupStaticReady tapes.data.lhsLookup overlay baseWork := instructionExecutionReady_baseLookup_internal tapes overlay pcValue @@ -801,7 +801,7 @@ theorem denseExecuteInstructionTM_store_hoareTime_frame out.HasBinaryPrefix (nextStore.flatMap Entry.encode)) (denseIndirectStoreInstructionTime tapes.data input overlay addressRegister source) := by - simpa [Result, address, value, nextStore] using hbaseRaw + simpa [Result, address, value, nextStore] using! hbaseRaw have hresult : ∀ work, Result work → work tapes.pc = initialWork (Fin.castSucc tapes.pc) ∧ (work tapes.data.update.resultCount).HasBinaryNat nextStore.length ∧ @@ -875,14 +875,14 @@ theorem denseExecuteInstructionTM_store_hoareTime_frame fin_cases slot · exact ⟨houtcome.ready.queryStart, by simpa [instruction, cleanupValues, denseInstructionCleanupValue, - instructionCleanupParentSlot, address] using + instructionCleanupParentSlot, address] using! houtcome.ready.query⟩ · change (work tapes.data.update.replacement).HasBinaryNat _ rw [houtcome.replacement] simpa [instruction, cleanupValues, denseInstructionCleanupValue, - value] using htagValue + value] using! htagValue · simpa [instruction, cleanupValues, denseInstructionCleanupValue, - instructionCleanupParentSlot, address] using houtcome.found + instructionCleanupParentSlot, address] using! houtcome.found · change (work tapes.data.lhs).HasBinaryNat _ rw [houtcome.frame tapes.data.lhs (fun role => (tapes.data.update_ne_lhs role).symm), @@ -899,7 +899,7 @@ theorem denseExecuteInstructionTM_store_hoareTime_frame hrhsResult.frame tapes.data.lhs (fun role => (tapes.data.rhsLookup_ne_lhs role).symm)] simpa [instruction, cleanupValues, denseInstructionCleanupValue, - address] using hlhs.destination + address] using! hlhs.destination · change (work tapes.data.rhs).HasBinaryNat _ rw [houtcome.frame tapes.data.rhs (fun role => (tapes.data.update_ne_rhs role).symm), @@ -914,7 +914,7 @@ theorem denseExecuteInstructionTM_store_hoareTime_frame exact Function.update_of_ne (tapes.data.update_ne_rhs 7).symm _ _] simpa [instruction, cleanupValues, denseInstructionCleanupValue, - value] using hrhsResult.destination + value] using! hrhsResult.destination have hshift : (work tapes.data.shift).HasBinaryNat 0 := by have hreplacementNe : tapes.data.shift ≠ tapes.data.update.replacement := @@ -927,7 +927,7 @@ theorem denseExecuteInstructionTM_store_hoareTime_frame htagFrame tapes.data.shift hreplacementNe, hupdateWork, Function.update_of_ne hreplacementNe, hqueryWork, Function.update_of_ne hqueryNe] - simpa using hrhsResult.querySource + simpa using! hrhsResult.querySource have htmp' : (work tapes.data.tmp).HasBinaryNat 0 := by have hreplacementNe : tapes.data.tmp ≠ tapes.data.update.replacement := @@ -965,10 +965,10 @@ theorem denseExecuteInstructionTM_store_hoareTime_frame refine ⟨hpcOutcome.trans (hpcTag.trans (hpcUpdate.trans (hpcQueryWork.trans (hpcRhs.trans hpcLhs)))), ?_, hsourceContent, hcleanup, ?_, ?_, hshift, htmp', hdbl', houtcome.ready.parked⟩ - · simpa [nextStore, DenseOverlay.write] using houtcome.resultCount - · simpa using houtcome.remaining + · simpa [nextStore, DenseOverlay.write] using! houtcome.resultCount + · simpa using! houtcome.remaining · simpa [instruction, cleanupValues, denseInstructionCleanupValue, - address] using houtcome.ready + address] using! houtcome.ready have hdata := retargetBufferedDataKernel_hoareTime_frame_internal tapes overlay nextStore cleanupValues 0 pcValue initialWork inp₀ (denseIndirectStoreInstructionTM tapes.data addressRegister source) @@ -983,7 +983,7 @@ theorem denseExecuteInstructionTM_store_hoareTime_frame denseExecuteInstructionTime, DenseInstructionExecutionResult, denseInstructionStore, denseInstructionPC, DenseOverlay.Snapshot.stepInstr, nextStore, cleanupValues, address, - value] using hall + value] using! hall end Machine end RegisterStore diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Internal.lean index d629dd8c80..4b7f9a1f8c 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Internal.lean @@ -40,12 +40,12 @@ private theorem hasBinaryNat_parked {t : Tape} {value : ℕ} private theorem programBinaryTape_hasBinaryString (bits : List Bool) : (programBinaryTape bits).HasBinaryString bits := by - simpa only [programBinaryTape] using + simpa only [programBinaryTape] using! Tape.init_move_right_hasBinaryString bits private theorem programBinaryTape_hasBinaryNat (value : ℕ) : (programBinaryTape value.bits).HasBinaryNat value := by - simpa only [programBinaryTape] using + simpa only [programBinaryTape] using! Tape.init_move_right_hasBinaryNat value private theorem programBinaryTape_parked (bits : List Bool) : @@ -128,10 +128,10 @@ theorem programSnapshotWork_ready_internal let entry := tapes.lifted.data.lhsLookup.scan.entry change InstructionExecutionReady tapes snapshot.store snapshot.pc work have hblankNat : TM.resetBinaryBlank.HasBinaryNat 0 := by - simpa [TM.resetBinaryBlank] using Tape.init_move_right_hasBinaryNat 0 + simpa [TM.resetBinaryBlank] using! Tape.init_move_right_hasBinaryNat 0 have hblankString : TM.resetBinaryBlank.HasBinaryString [] := hblankNat.2 have hblankPrefix : TM.resetBinaryBlank.HasBinaryPrefix [] := - ⟨by simpa using hblankString.1, hblankString.2⟩ + ⟨by simpa using! hblankString.1, hblankString.2⟩ have hblankStart : TM.resetBinaryBlank.cells 0 = Γ.start := hblankNat.1 have hsource : work tapes.liftedSource = programBinaryTape (snapshot.store.flatMap Entry.encode) := by @@ -186,28 +186,28 @@ theorem programSnapshotWork_ready_internal fin_cases slot · exact (hslot rfl).elim · simpa [entry, BinaryInstructionTapes.lhsLookup, - BinaryInstructionTapes.lhsLookupSlot] using + BinaryInstructionTapes.lhsLookupSlot] using! hdataBlank 1 (by decide) (by decide) (by decide) · simpa [entry, BinaryInstructionTapes.lhsLookup, - BinaryInstructionTapes.lhsLookupSlot] using + BinaryInstructionTapes.lhsLookupSlot] using! hdataBlank 2 (by decide) (by decide) (by decide) · simpa [entry, BinaryInstructionTapes.lhsLookup, - BinaryInstructionTapes.lhsLookupSlot] using + BinaryInstructionTapes.lhsLookupSlot] using! hdataBlank 3 (by decide) (by decide) (by decide) · simpa [entry, BinaryInstructionTapes.lhsLookup, - BinaryInstructionTapes.lhsLookupSlot] using + BinaryInstructionTapes.lhsLookupSlot] using! hdataBlank 4 (by decide) (by decide) (by decide) · simpa [entry, BinaryInstructionTapes.lhsLookup, - BinaryInstructionTapes.lhsLookupSlot] using + BinaryInstructionTapes.lhsLookupSlot] using! hdataBlank 5 (by decide) (by decide) (by decide) · simpa [entry, BinaryInstructionTapes.lhsLookup, - BinaryInstructionTapes.lhsLookupSlot] using + BinaryInstructionTapes.lhsLookupSlot] using! hdataBlank 6 (by decide) (by decide) (by decide) · simpa [entry, BinaryInstructionTapes.lhsLookup, - BinaryInstructionTapes.lhsLookupSlot] using + BinaryInstructionTapes.lhsLookupSlot] using! hdataBlank 7 (by decide) (by decide) (by decide) · simpa [entry, BinaryInstructionTapes.lhsLookup, - BinaryInstructionTapes.lhsLookupSlot] using + BinaryInstructionTapes.lhsLookupSlot] using! hdataBlank 8 (by decide) (by decide) (by decide) refine { source := by @@ -216,62 +216,62 @@ theorem programSnapshotWork_ready_internal exact Tape.init_move_right_hasBinarySuffix _ address := by rw [show work entry.address = TM.resetBinaryBlank by - simpa only [EntryMatchTapes.address] using + simpa only [EntryMatchTapes.address] using! hslotOther 1 (by decide)] exact hblankPrefix addressStart := by rw [show work entry.address = TM.resetBinaryBlank by - simpa only [EntryMatchTapes.address] using + simpa only [EntryMatchTapes.address] using! hslotOther 1 (by decide)] exact hblankStart value := by rw [show work entry.value = TM.resetBinaryBlank by - simpa only [EntryMatchTapes.value] using + simpa only [EntryMatchTapes.value] using! hslotOther 2 (by decide)] exact hblankPrefix valueStart := by rw [show work entry.value = TM.resetBinaryBlank by - simpa only [EntryMatchTapes.value] using + simpa only [EntryMatchTapes.value] using! hslotOther 2 (by decide)] exact hblankStart addressCounter := by rw [show work entry.addressCounter = TM.resetBinaryBlank by - simpa only [EntryMatchTapes.addressCounter] using + simpa only [EntryMatchTapes.addressCounter] using! hslotOther 3 (by decide)] exact hblankNat addressWidth := by rw [show work entry.addressWidth = TM.resetBinaryBlank by - simpa only [EntryMatchTapes.addressWidth] using + simpa only [EntryMatchTapes.addressWidth] using! hslotOther 4 (by decide)] exact hblankNat valueCounter := by rw [show work entry.valueCounter = TM.resetBinaryBlank by - simpa only [EntryMatchTapes.valueCounter] using + simpa only [EntryMatchTapes.valueCounter] using! hslotOther 5 (by decide)] exact hblankNat valueWidth := by rw [show work entry.valueWidth = TM.resetBinaryBlank by - simpa only [EntryMatchTapes.valueWidth] using + simpa only [EntryMatchTapes.valueWidth] using! hslotOther 6 (by decide)] exact hblankNat query := by rw [show work entry.query = TM.resetBinaryBlank by - simpa only [EntryMatchTapes.query] using + simpa only [EntryMatchTapes.query] using! hslotOther 7 (by decide)] exact hblankString queryStart := by rw [show work entry.query = TM.resetBinaryBlank by - simpa only [EntryMatchTapes.query] using + simpa only [EntryMatchTapes.query] using! hslotOther 7 (by decide)] exact hblankStart result := by rw [show work entry.result = TM.resetBinaryBlank by - simpa only [EntryMatchTapes.result] using + simpa only [EntryMatchTapes.result] using! hslotOther 8 (by decide)] exact hblankPrefix resultStart := by rw [show work entry.result = TM.resetBinaryBlank by - simpa only [EntryMatchTapes.result] using + simpa only [EntryMatchTapes.result] using! hslotOther 8 (by decide)] exact hblankStart parked := hparked @@ -434,7 +434,7 @@ theorem programOutputTM_hoareTime_internal hresult.destination hinput hresult.parked obtain ⟨final, time, htime, hreach, hhalt, hfinalInput, _hfinalWork, hfinalOutput⟩ := - hleaf inp work out ⟨hinp, rfl, by simpa only [blank] using hout⟩ + hleaf inp work out ⟨hinp, rfl, by simpa only [blank] using! hout⟩ exact ⟨final, time, htime, hreach, hhalt, hfinalInput, hfinalOutput⟩ have hseq := TM.seqTM_hoareTime (entryLookupStaticTM tapes.lifted.data.lhsLookup 0) @@ -443,7 +443,7 @@ theorem programOutputTM_hoareTime_internal rintro inp work out ⟨hinp, hresult, hout⟩ have hi : TM.transitionInput inp = inp := TM.transitionInput_eq_self - (by simpa [hinp] using hinput.read_ne_start) + (by simpa [hinp] using! hinput.read_ne_start) have hw : (fun i => TM.transitionTape (work i)) = work := by funext i exact TM.transitionTape_eq_self (hresult.parked i).read_ne_start @@ -451,9 +451,9 @@ theorem programOutputTM_hoareTime_internal TM.transitionTape_eq_self (by rw [hout]; exact blank_parked.read_ne_start) rw [hi, hw, ho] - exact ⟨hinp, hresult, by simpa only [blank] using hout⟩) + exact ⟨hinp, hresult, by simpa only [blank] using! hout⟩) hverdict - simpa only [programOutputTM, programOutputTime, mid, blank] using hseq + simpa only [programOutputTM, programOutputTime, mid, blank] using! hseq theorem registerVerdictTM_hoareTime_haltOutput_internal (idx : Fin n) (value : ℕ) (inp₀ : Tape) (work₀ : Fin n → Tape) @@ -554,7 +554,7 @@ theorem programOutputTM_hoareTime_haltOutput_internal hresult.destination hinput hresult.parked obtain ⟨final, time, htime, hreach, hhalt, hfinalInput, _hfinalWork, hfinalOutput⟩ := - hleaf inp work out ⟨hinp, rfl, by simpa only [haltOut] using hout⟩ + hleaf inp work out ⟨hinp, rfl, by simpa only [haltOut] using! hout⟩ exact ⟨final, time, htime, hreach, hhalt, hfinalInput, hfinalOutput⟩ have hseq := TM.seqTM_hoareTime (entryLookupStaticTM tapes.lifted.data.lhsLookup 0) @@ -563,7 +563,7 @@ theorem programOutputTM_hoareTime_haltOutput_internal rintro inp work out ⟨hinp, hresult, hout⟩ have hi : TM.transitionInput inp = inp := TM.transitionInput_eq_self - (by simpa [hinp] using hinput.read_ne_start) + (by simpa [hinp] using! hinput.read_ne_start) have hw : (fun i => TM.transitionTape (work i)) = work := by funext i exact TM.transitionTape_eq_self (hresult.parked i).read_ne_start @@ -571,9 +571,9 @@ theorem programOutputTM_hoareTime_haltOutput_internal TM.transitionTape_eq_self (by rw [hout]; exact hhaltOutParked.read_ne_start) rw [hi, hw, ho] - exact ⟨hinp, hresult, by simpa only [haltOut] using hout⟩) + exact ⟨hinp, hresult, by simpa only [haltOut] using! hout⟩) hverdict - simpa only [programOutputTM, programOutputTime, mid, haltOut] using hseq + simpa only [programOutputTM, programOutputTime, mid, haltOut] using! hseq theorem instructionHaltOutput_head_internal (instruction : Instr) : (instructionHaltOutput instruction).head = 1 := by @@ -798,7 +798,7 @@ theorem dispatchHaltTM_hoareTime_frame_internal have hcleanLhs : cleanWork tapes.liftedLhs = blankTape := by have hzero := hready.1.control.lookup.destination change (cleanWork tapes.liftedLhs).HasBinaryNat 0 at hzero - simpa only [blankTape] using + simpa only [blankTape] using! Tape.HasBinaryNat.eq_init_move_right hzero have hwork₀Parked : ∀ i, TM.Parked (work₀ i) := by intro i @@ -841,15 +841,15 @@ theorem dispatchHaltTM_hoareTime_frame_internal rintro inp work out ⟨hinp, hworkEq, hout⟩ obtain ⟨hi, hw, ho⟩ := phaseTransition_of_parked (inp := inp) (work := work) (out := out) - (by simpa [hinp] using hinput) - (by simpa [hworkEq] using + (by simpa [hinp] using! hinput) + (by simpa [hworkEq] using! hready.1.control.lookup.scanner.parked) - (by simpa [hout] using blank_parked) + (by simpa [hout] using! blank_parked) rw [hi, hw, ho] exact ⟨hinp, hworkEq, hout⟩) hverdict simpa only [dispatchHaltTM, dispatchHaltTime, - selectedInstruction] using hseq + selectedInstruction] using! hseq | cons instruction program ih => let pre : TM.TapePred (n + 1) := fun inp work out => inp = inp₀ ∧ work = work₀ ∧ @@ -899,8 +899,8 @@ theorem dispatchHaltTM_hoareTime_frame_internal hfinalWork, hfinalOutput⟩ := hverdict inp cleanWork out ⟨hinp, rfl, hout⟩ refine ⟨final, time, htime, ?_, hhalt, hfinalInput, hfinalWork, ?_⟩ - · simpa [hworkClean] using hreach - · simpa only [selectedInstruction] using hfinalOutput + · simpa [hworkClean] using! hreach + · simpa only [selectedInstruction] using! hfinalOutput have hnonblank : (TM.seqTM (TM.binaryPredTM tapes.liftedLhs) (dispatchHaltTM tapes program)).HoareTime @@ -914,11 +914,11 @@ theorem dispatchHaltTM_hoareTime_frame_internal rw [hworkEq] rw [hsucc] at hselector exact hselector - have hinpParked : TM.Parked inp := by simpa [hinp] using hinput - have houtParked : TM.Parked out := by simpa [hout] using blank_parked + have hinpParked : TM.Parked inp := by simpa [hinp] using! hinput + have houtParked : TM.Parked out := by simpa [hout] using! blank_parked have hworkParked : ∀ i, TM.Parked (work i) := by intro i - simpa [hworkEq] using hwork₀Parked i + simpa [hworkEq] using! hwork₀Parked i have hpred := TM.binaryPredTM_hoareTime_frame tapes.liftedLhs (selector - 1) inp work out hvalue hinpParked.read_ne_start (fun i _ => (hworkParked i).read_ne_start) @@ -961,7 +961,7 @@ theorem dispatchHaltTM_hoareTime_frame_internal selectedInstruction program (selector - 1) := by rw [hsucc] rfl - exact ⟨hinp', hwork', by simpa only [hselected] using hout'⟩ + exact ⟨hinp', hwork', by simpa only [hselected] using! hout'⟩ · exact le_rfl have hseq := TM.seqTM_hoareTime (TM.binaryPredTM tapes.liftedLhs) (dispatchHaltTM tapes program) hpred' @@ -969,7 +969,7 @@ theorem dispatchHaltTM_hoareTime_frame_internal rintro inp' work' out' ⟨hinp', hwork', hout'⟩ obtain ⟨hi, hw, ho⟩ := phaseTransition_of_parked (inp := inp') (work := work') (out := out') - (by simpa [hinp', hinp] using hinput) + (by simpa [hinp', hinp] using! hinput) (by intro i rw [hwork'] @@ -980,7 +980,7 @@ theorem dispatchHaltTM_hoareTime_frame_internal (Tape.init_move_right_hasBinaryNat (selector - 1)) · simp only [nextWork, Function.update_of_ne hidx] exact hready.1.control.lookup.scanner.parked i) - (by simpa [hout', hout] using blank_parked) + (by simpa [hout', hout] using! blank_parked) rw [hi, hw, ho] exact ⟨hinp', hwork', hout'⟩) hrecursive' @@ -993,24 +993,24 @@ theorem dispatchHaltTM_hoareTime_frame_internal (blankPost := post) (nonblankPost := post) (fun inp work out hpre => by have hinpParked : TM.Parked inp := by - simpa [hpre.1] using hinput + simpa [hpre.1] using! hinput have houtParked : TM.Parked out := by - simpa [hpre.2.2] using blank_parked + simpa [hpre.2.2] using! blank_parked have hworkParked : ∀ i, TM.Parked (work i) := by intro i - simpa [hpre.2.1] using hwork₀Parked i + simpa [hpre.2.1] using! hwork₀Parked i exact ⟨hinpParked.read_ne_start, fun i => (hworkParked i).read_ne_start, houtParked.read_ne_start⟩) (fun _ work _ hpre hread => ⟨hpre, hselector.read_eq_blank_iff.mp - (by simpa [hpre.2.1] using hread)⟩) + (by simpa [hpre.2.1] using! hread)⟩) (fun _ work _ hpre hread => ⟨hpre, fun hzero => hread (by rw [hpre.2.1] exact hselector.read_eq_blank_iff.mpr hzero)⟩) hblank hnonblank - simpa only [dispatchHaltTM, dispatchHaltTime, pre, post] using + simpa only [dispatchHaltTM, dispatchHaltTime, pre, post] using! hdispatch.consequence (fun _ _ _ h => h) (fun _ _ _ h => h.elim id id) le_rfl @@ -1062,14 +1062,14 @@ theorem programHaltTM_hoareTime_frame_internal rintro inp work out ⟨hinp, hworkEq, hout⟩ obtain ⟨hi, hw, ho⟩ := phaseTransition_of_parked (inp := inp) (work := work) (out := out) - (by simpa [hinp] using hinput) - (by simpa [hworkEq, selectorWork, selectorTape] using hselectorParked) - (by simpa [hout] using blank_parked) + (by simpa [hinp] using! hinput) + (by simpa [hworkEq, selectorWork, selectorTape] using! hselectorParked) + (by simpa [hout] using! blank_parked) rw [hi, hw, ho] - exact ⟨hinp, by simpa [selectorWork, selectorTape] using hworkEq, hout⟩) + exact ⟨hinp, by simpa [selectorWork, selectorTape] using! hworkEq, hout⟩) hdispatch simpa only [programHaltTM, programHaltTime, selectorWork, - selectorTape] using hseq + selectorTape] using! hseq /-- One loop iteration realizes one pure sparse step and either halts on the successor's `halt` instruction or returns to the body start with blank output. -/ @@ -1114,11 +1114,11 @@ theorem programLoopTM_iteration_internal hbodyInput, hnextReady, hbodyOutput⟩ := hbody inp₀ initialWork blank ⟨rfl, rfl, rfl⟩ have hbodyInputParked : TM.Parked cbody.input := by - simpa [hbodyInput] using hinput + simpa [hbodyInput] using! hinput have hbodyWorkParked : ∀ i, TM.Parked (cbody.work i) := by exact hnextReady.control.lookup.scanner.parked have hbodyOutputParked : TM.Parked cbody.output := by - simpa [hbodyOutput, blank] using blank_parked + simpa [hbodyOutput, blank] using! blank_parked have hbodyLoop := TM.loopTM_body_simulation body test hbodyReach have hbodyTransition : (⟨test.qstart, TM.transitionInput cbody.input, @@ -1146,11 +1146,11 @@ theorem programLoopTM_iteration_internal selectedInstruction_eq_getElem?_getD program next.pc have htestOutput' : ctest.output = instructionHaltOutput (next.curInstr program) := by - simpa only [hselected] using htestOutput + simpa only [hselected] using! htestOutput have htestInputParked : TM.Parked ctest.input := by - simpa [htestInput] using hinput + simpa [htestInput] using! hinput have htestWorkParked : ∀ i, TM.Parked (ctest.work i) := by - simpa [htestWork] using hbodyWorkParked + simpa [htestWork] using! hbodyWorkParked have htestOutputParked : TM.Parked ctest.output := by refine ⟨?_, ?_⟩ · rw [htestOutput', instructionHaltOutput_head_internal] @@ -1207,40 +1207,44 @@ theorem programLoopTM_iteration_internal rw [htestOutput'] exact instructionHaltOutput_cell_one_eq_one_iff_internal _ |>.2 hhalted have htailDone : ctail.state = Sum.inr (Sum.inl TM.LoopPhase.done) := by - simpa [hone] using htailState + simpa [hone] using! htailState have hcTail : ctail = { state := Sum.inr (Sum.inl TM.LoopPhase.done) input := inp₀ work := cbody.work output := instructionHaltOutput (next.curInstr program) } := by cases ctail - simp only [Complexity.Cfg.mk.injEq] - exact ⟨htailDone, htailInput, htailWork, - htailOutput.trans htestOutput'⟩ - simpa only [programLoopTM, body, test, blank, hcTail] using hreach + apply Complexity.Cfg.ext + · exact htailDone + · exact htailInput + · exact htailWork + · exact htailOutput.trans htestOutput' + simpa only [programLoopTM, body, test, blank, hcTail] using! hreach · right refine ⟨hhalted, ?_⟩ have hcur : next.curInstr program ≠ .halt := hhalted have hblankOutput : ctest.output = blank := by rw [htestOutput'] - simpa only [blank] using + simpa only [blank] using! instructionHaltOutput_eq_blank_of_ne_halt_internal hcur have hone : ctest.output.cells 1 ≠ Γ.one := by rw [htestOutput'] exact fun h => hhalted (instructionHaltOutput_cell_one_eq_one_iff_internal _ |>.1 h) have htailStart : ctail.state = Sum.inl body.qstart := by - simpa [hone] using htailState + simpa [hone] using! htailState have hcTail : ctail = { state := Sum.inl body.qstart input := inp₀ work := cbody.work output := blank } := by cases ctail - simp only [Complexity.Cfg.mk.injEq] - exact ⟨htailStart, htailInput, htailWork, - htailOutput.trans hblankOutput⟩ - simpa only [programLoopTM, body, test, blank, hcTail] using hreach + apply Complexity.Cfg.ext + · exact htailStart + · exact htailInput + · exact htailWork + · exact htailOutput.trans hblankOutput + simpa only [programLoopTM, body, test, blank, hcTail] using! hreach theorem snapshot_step_eq_self_of_halted_internal (program : Program) (snapshot : Snapshot) @@ -1286,7 +1290,7 @@ theorem programLoopTM_hoareTime_run_internal subst work subst out have hsnapshotHalted : snapshot.Halted program := by - simpa [Snapshot.run] using hhalted + simpa [Snapshot.run] using! hhalted have hstepSelf := snapshot_step_eq_self_of_halted_internal program snapshot hsnapshotHalted obtain ⟨nextWork, time, htime, hnextReady, hbranch⟩ := @@ -1296,7 +1300,7 @@ theorem programLoopTM_hoareTime_run_internal ⟨hnextRunning, _⟩ · have hready' : InstructionExecutionReady tapes snapshot.store snapshot.pc nextWork := by - simpa only [hstepSelf] using hnextReady + simpa only [hstepSelf] using! hnextReady have hreach' : (programLoopTM tapes program).reachesIn time { state := (programLoopTM tapes program).qstart input := inp₀ @@ -1307,12 +1311,12 @@ theorem programLoopTM_hoareTime_run_internal work := nextWork output := instructionHaltOutput (snapshot.curInstr program) } := by - simpa only [hstepSelf] using hreach + simpa only [hstepSelf] using! hreach refine ⟨_, time, ?_, hreach', rfl, rfl, ?_, ?_⟩ - · simpa [programLoopTime] using htime - · simpa [Snapshot.run] using hready' + · simpa [programLoopTime] using! htime + · simpa [Snapshot.run] using! hready' · simp [Snapshot.run] - · exact (hnextRunning (by simpa only [hstepSelf] using + · exact (hnextRunning (by simpa only [hstepSelf] using! hsnapshotHalted)).elim | succ fuel ih => intro snapshot initialWork inp₀ hready hinput hhalted @@ -1331,7 +1335,7 @@ theorem programLoopTM_hoareTime_run_internal snapshot_run_halted_internal program snapshot hsnapshotHalted _ have hready' : InstructionExecutionReady tapes snapshot.store snapshot.pc nextWork := by - simpa only [hstepSelf] using hnextReady + simpa only [hstepSelf] using! hnextReady have hreach' : (programLoopTM tapes program).reachesIn time { state := (programLoopTM tapes program).qstart input := inp₀ @@ -1342,17 +1346,17 @@ theorem programLoopTM_hoareTime_run_internal work := nextWork output := instructionHaltOutput (snapshot.curInstr program) } := by - simpa only [hstepSelf] using hreach + simpa only [hstepSelf] using! hreach refine ⟨_, time, ?_, hreach', rfl, rfl, ?_, ?_⟩ · simp only [programLoopTime] omega - · simpa only [hfinal] using hready' + · simpa only [hfinal] using! hready' · simp only [hfinal] - · exact (hnextRunning (by simpa only [hstepSelf] using + · exact (hnextRunning (by simpa only [hstepSelf] using! hsnapshotHalted)).elim · have hrunHalted : ((snapshot.step program).run program fuel).Halted program := by - simpa [Snapshot.run, hsnapshotHalted] using hhalted + simpa [Snapshot.run, hsnapshotHalted] using! hhalted have hiter := programLoopTM_iteration_internal tapes program snapshot initialWork inp₀ hready hinput obtain ⟨nextWork, time₁, htime₁, hnextReady, hbranch⟩ := hiter @@ -1370,7 +1374,7 @@ theorem programLoopTM_hoareTime_run_internal refine ⟨_, time₁, ?_, hreach₁, rfl, rfl, ?_, ?_⟩ · simp only [programLoopTime] omega - · simpa [Snapshot.run, hsnapshotHalted, hfinal] using hnextReady + · simpa [Snapshot.run, hsnapshotHalted, hfinal] using! hnextReady · simp [Snapshot.run, hsnapshotHalted, hfinal] · have hrecursive := ih (snapshot.step program) nextWork inp₀ hnextReady hinput hrunHalted @@ -1390,8 +1394,8 @@ theorem programLoopTM_hoareTime_run_internal programLoopTime tapes program (fuel + 1) (snapshot.step program) exact Nat.add_le_add htime₁ htime₂ - · simpa [Snapshot.run, hsnapshotHalted] using hfinalReady - · simpa [Snapshot.run, hsnapshotHalted] using hfinalOutput + · simpa [Snapshot.run, hsnapshotHalted] using! hfinalReady + · simpa [Snapshot.run, hsnapshotHalted] using! hfinalOutput end Machine From 8cdc01885b4a6fec00ff36791f03f134d1514031 Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Tue, 22 Sep 2026 02:58:22 +0000 Subject: [PATCH 18/49] Port epigraph geometry and dense RAM initialization bounds --- .../BeyondBethe/BetheEpigraphGeometry.lean | 52 +++--- .../MachineNaturalCombinators.lean | 6 +- .../BeyondBethe/MachineRepeatPair.lean | 14 +- .../Machine/Instruction/DenseDispatch.lean | 82 ++++----- .../Machine/Program/Bounds/Internal.lean | 138 +++++++-------- .../Machine/Program/DecisionInternal.lean | 17 +- .../Machine/Program/DenseBoundsProof.lean | 164 +++++++++--------- .../Machine/Program/DenseInitProof.lean | 61 ++++--- .../Machine/Program/DenseInternal.lean | 94 +++++----- 9 files changed, 329 insertions(+), 299 deletions(-) diff --git a/LeanPool/BeyondBethe/BeyondBethe/BetheEpigraphGeometry.lean b/LeanPool/BeyondBethe/BeyondBethe/BetheEpigraphGeometry.lean index c7bfd972c8..d630b10cf9 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/BetheEpigraphGeometry.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/BetheEpigraphGeometry.lean @@ -85,7 +85,7 @@ theorem regularizedBetheObjective_sub_le_rationalRange have hregUpper : regularizedBetheObjective (τ : ℝ) (fun i j ↦ (A i j : ℝ)) X ≤ 2 * (n : ℝ) ^ 2 := by - rw [regularizedBetheObjective] + unfold regularizedBetheObjective have hτEntropy : (τ : ℝ) * totalRowEntropy X ≤ totalRowEntropy X := mul_le_of_le_one_left hentropyX0 hτ1R linarith @@ -93,7 +93,7 @@ theorem regularizedBetheObjective_sub_le_rationalRange (n : ℝ) * Real.log (m : ℝ) - n ≤ regularizedBetheObjective (τ : ℝ) (fun i j ↦ (A i j : ℝ)) Z := by - rw [regularizedBetheObjective] + unfold regularizedBetheObjective have hτEntropy : 0 ≤ (τ : ℝ) * totalRowEntropy Z := mul_nonneg hτ0R hentropyZ0 linarith @@ -164,7 +164,7 @@ theorem negativeRegularizedBetheObjective_rational_bounds have hregUpper : regularizedBetheObjective (τ : ℝ) (fun i j ↦ (A i j : ℝ)) X ≤ 2 * (n : ℝ) ^ 2 := by - rw [regularizedBetheObjective] + unfold regularizedBetheObjective have hτEntropy : (τ : ℝ) * totalRowEntropy X ≤ totalRowEntropy X := mul_le_of_le_one_left hentropy0 hτ1R linarith @@ -172,7 +172,7 @@ theorem negativeRegularizedBetheObjective_rational_bounds (n : ℝ) * Real.log (a : ℝ) - n ≤ regularizedBetheObjective (τ : ℝ) (fun i j ↦ (A i j : ℝ)) X := by - rw [regularizedBetheObjective] + unfold regularizedBetheObjective have hτEntropy : 0 ≤ (τ : ℝ) * totalRowEntropy X := mul_nonneg hτ0R hentropy0 linarith @@ -241,7 +241,10 @@ theorem birkhoffAffineMap_vector_spike_abs_sub_le (fun i j ↦ vectorToSquareMatrix (fun l ↦ y l + coordinateSpike k r l) i j - vectorToSquareMatrix y i j) = abs r - rw [← vectorL1_squareMatrixToVector] + rw [← vectorL1_squareMatrixToVector + (fun i j ↦ + vectorToSquareMatrix (fun l ↦ y l + coordinateSpike k r l) i j - + vectorToSquareMatrix y i j)] have hvec : squareMatrixToVector (fun i j ↦ vectorToSquareMatrix (fun l ↦ y l + coordinateSpike k r l) i j - @@ -331,7 +334,7 @@ theorem smoothedUniformSpike_properties let Ybase := fun i j ↦ (1 - mix) * birkhoffAffineCoordinates X i j + mix * Zbase i j have hZ : IsDoublyStochastic (birkhoffAffineMap Zbase) := by - simpa only [Zbase] using uniformAffineSpike_doublyStochastic hm k hq + simpa only [Zbase] using! uniformAffineSpike_doublyStochastic hm k hq have hrecover : birkhoffAffineMap (birkhoffAffineCoordinates X) = X := birkhoffAffineMap_coordinates_of_unit_sums X hX.row_sum hX.col_sum have hmap : birkhoffAffineMap Ybase = @@ -358,7 +361,8 @@ theorem smoothedUniformSpike_properties have hrange := regularizedBetheObjective_sub_le_rationalRange (show 1 ≤ m + 1 by omega) hτ0 hτ1 hApos hAupper hX hZ refine ⟨by rwa [hmap], hfloor, ?_⟩ - rw [affineNegativeObjective, hmap] + unfold affineNegativeObjective + rw [hmap] nlinarith /-- The unperturbed affine-coordinate center obtained by mixing `X` with the @@ -468,8 +472,16 @@ theorem smoothedUniformSpike_mem_epigraph simp only [BetheEpigraphTarget, epigraphBase_epigraphPoint, epigraphHeight_epigraphPoint, vectorToSquareMatrix_squareMatrixToVector] - exact ⟨fun i j ↦ hδ.trans (hproperties.2.1 i j), - hproperties.2.2.trans hobjective, hsupper⟩ + constructor + · intro i j + convert! hδ.trans (hproperties.2.1 i j) using 1 + exact congrArg (fun B : Matrix (Fin m) (Fin m) ℝ => birkhoffAffineMap B i j) + (vectorToSquareMatrix_squareMatrixToVector _) + · constructor + · convert! hproperties.2.2.trans hobjective using 1 + exact congrArg (affineNegativeObjective (τ : ℝ) (fun i j ↦ (A i j : ℝ))) + (vectorToSquareMatrix_squareMatrixToVector _) + · exact hsupper /-- The truncated epigraph above a threshold with two radii of objective slack contains a full coordinate cross. This is the exact inner-region @@ -526,7 +538,7 @@ theorem BetheEpigraphTarget_smoothed_inner_cross have hmem : BetheEpigraphTarget (τ : ℝ) (fun i j ↦ (A i j : ℝ)) δ upper (epigraphPoint (squareMatrixToVector Ybase) upper) := by - simpa only [Zbase, Ybase] using + simpa only [Zbase, Ybase] using! smoothedUniformSpike_mem_epigraph hm hτ0 hτ1 hApos hAupper hX hXfloor hmix0' hmix1 k0 (q := 0) (by simp; positivity) hδ @@ -540,7 +552,7 @@ theorem BetheEpigraphTarget_smoothed_inner_cross fun l ↦ squareMatrixToVector (smoothedUniformAffineBase X mix) l + coordinateSpike k0 0 l := by - simpa only [Zbase, Ybase] using h + simpa only [Zbase, Ybase] using! h _ = squareMatrixToVector (smoothedUniformAffineBase X mix) := by ext l simp [coordinateSpike] @@ -559,14 +571,14 @@ theorem BetheEpigraphTarget_smoothed_inner_cross have hmem : BetheEpigraphTarget (τ : ℝ) (fun i j ↦ (A i j : ℝ)) δ upper (epigraphPoint (squareMatrixToVector Ybase) (upper - r)) := by - simpa only [Zbase, Ybase, q] using + simpa only [Zbase, Ybase, q] using! smoothedUniformSpike_mem_epigraph hm hτ0 hτ1 hApos hAupper hX hXfloor hmix0' hmix1 k hqplus hδ hobjectiveCenter hcenterUpper have hvec : squareMatrixToVector Ybase = fun l ↦ squareMatrixToVector (smoothedUniformAffineBase X mix) l + coordinateSpike k r l := by - simpa only [Zbase, Ybase, q] using + simpa only [Zbase, Ybase, q] using! squareMatrixToVector_smoothedUniformSpike_of_mul X mix k q r hmul rw [epigraphPoint_add_baseSpike, ← hvec] @@ -581,7 +593,7 @@ theorem BetheEpigraphTarget_smoothed_inner_cross have hmem : BetheEpigraphTarget (τ : ℝ) (fun i j ↦ (A i j : ℝ)) δ upper (epigraphPoint (squareMatrixToVector Ybase) (upper - 2 * r)) := by - simpa only [Zbase, Ybase] using + simpa only [Zbase, Ybase] using! smoothedUniformSpike_mem_epigraph hm hτ0 hτ1 hApos hAupper hX hXfloor hmix0' hmix1 k0 (q := 0) (by simp; positivity) hδ hobjectiveLow hlowUpper @@ -594,7 +606,7 @@ theorem BetheEpigraphTarget_smoothed_inner_cross fun l ↦ squareMatrixToVector (smoothedUniformAffineBase X mix) l + coordinateSpike k0 0 l := by - simpa only [Zbase, Ybase] using h + simpa only [Zbase, Ybase] using! h _ = squareMatrixToVector (smoothedUniformAffineBase X mix) := by ext l simp [coordinateSpike] @@ -613,14 +625,14 @@ theorem BetheEpigraphTarget_smoothed_inner_cross have hmem : BetheEpigraphTarget (τ : ℝ) (fun i j ↦ (A i j : ℝ)) δ upper (epigraphPoint (squareMatrixToVector Ybase) (upper - r)) := by - simpa only [Zbase, Ybase, q] using + simpa only [Zbase, Ybase, q] using! smoothedUniformSpike_mem_epigraph hm hτ0 hτ1 hApos hAupper hX hXfloor hmix0' hmix1 k hqminus hδ hobjectiveCenter hcenterUpper have hvec : squareMatrixToVector Ybase = fun l ↦ squareMatrixToVector (smoothedUniformAffineBase X mix) l + coordinateSpike k (-r) l := by - simpa only [Zbase, Ybase, q] using + simpa only [Zbase, Ybase, q] using! squareMatrixToVector_smoothedUniformSpike_of_mul X mix k q (-r) hmul have hspikeNeg : @@ -652,7 +664,7 @@ theorem finiteNormSq_le_dimension_sq_of_abs_le rw [finiteNormSq, finiteDot] calc (∑ i, x i * x i) ≤ ∑ _i : Fin d, C ^ 2 := - Finset.sum_le_sum fun i _ ↦ by simpa [pow_two] using hterm i + Finset.sum_le_sum fun i _ ↦ by simpa [pow_two] using! hterm i _ = (d : ℝ) * C ^ 2 := by simp _ ≤ ((d : ℝ) * C) ^ 2 := by have hdR : (1 : ℝ) ≤ d := by exact_mod_cast hd @@ -734,7 +746,7 @@ theorem BetheEpigraphTarget_inner_cross_outer_zero exact htriangle.trans (by dsimp only [C]; linarith) · have hbase := BetheEpigraphTarget_epigraphBase_abs_le_one hδ (hplus k) l - simpa only [epigraphBase] using hbase.trans honeC + simpa only [epigraphBase] using! hbase.trans honeC · intro k apply finiteNormSq_le_dimension_sq_of_abs_le (by omega) hC intro i @@ -762,6 +774,6 @@ theorem BetheEpigraphTarget_inner_cross_outer_zero exact htriangle.trans (by dsimp only [C]; linarith) · have hbase := BetheEpigraphTarget_epigraphBase_abs_le_one hδ (hminus k) l - simpa only [epigraphBase] using hbase.trans honeC + simpa only [epigraphBase] using! hbase.trans honeC end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineNaturalCombinators.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineNaturalCombinators.lean index 7ebec78f6d..25e0596776 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineNaturalCombinators.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineNaturalCombinators.lean @@ -32,18 +32,18 @@ def machineBinaryConst (k : ℕ) (_word : List Bool) : List Bool := k.bits theorem machineBinaryAddOf_mem_FP {f g : List Bool → List Bool} (hf : f ∈ FP) (hg : g ∈ FP) : machineBinaryAddOf f g ∈ FP := by - simpa only [machineBinaryAddOf] using + simpa only [machineBinaryAddOf] using! machineCompose_mem_FP (machinePair_mem_FP hf hg) machineBinaryAddBits_mem_FP theorem machineBinaryMulOf_mem_FP {f g : List Bool → List Bool} (hf : f ∈ FP) (hg : g ∈ FP) : machineBinaryMulOf f g ∈ FP := by - simpa only [machineBinaryMulOf] using + simpa only [machineBinaryMulOf] using! machineCompose_mem_FP (machinePair_mem_FP hf hg) machineBinaryMulBits_mem_FP theorem machineBinaryConst_mem_FP (k : ℕ) : machineBinaryConst k ∈ FP := by - simpa only [machineBinaryConst] using machineConst_mem_FP k.bits + simpa only [machineBinaryConst] using! machineConst_mem_FP k.bits @[simp] theorem machineBinaryAddOf_natBits (f g : List Bool → List Bool) (word : List Bool) (a b : ℕ) diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRepeatPair.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRepeatPair.lean index 1809d8757f..aa09ecb6cc 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineRepeatPair.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRepeatPair.lean @@ -112,11 +112,11 @@ theorem machineRepeatPairRuler_mem_FP : machineRepeatPairRuler ∈ FP := machinePairFirst_mem_FP theorem machineRepeatPairItem_mem_FP : machineRepeatPairItem ∈ FP := by - simpa only [machineRepeatPairItem] using + simpa only [machineRepeatPairItem] using! machineCompose_mem_FP machinePairSecond_mem_FP machinePairFirst_mem_FP theorem machineRepeatPairTail_mem_FP : machineRepeatPairTail ∈ FP := by - simpa only [machineRepeatPairTail] using + simpa only [machineRepeatPairTail] using! machineCompose_mem_FP machinePairSecond_mem_FP machinePairSecond_mem_FP theorem machineRepeatPairBound_mem_FP : machineRepeatPairBound ∈ FP := @@ -127,12 +127,12 @@ theorem machineRepeatPairStateItem_mem_FP : theorem machineRepeatPairStateAcc_mem_FP : machineRepeatPairStateAcc ∈ FP := by - simpa only [machineRepeatPairStateAcc] using + simpa only [machineRepeatPairStateAcc] using! machineCompose_mem_FP machinePairSecond_mem_FP machinePairFirst_mem_FP theorem machineRepeatPairStateBound_mem_FP : machineRepeatPairStateBound ∈ FP := by - simpa only [machineRepeatPairStateBound] using + simpa only [machineRepeatPairStateBound] using! machineCompose_mem_FP machinePairSecond_mem_FP machinePairSecond_mem_FP theorem machineRepeatPairCandidate_mem_FP : @@ -142,7 +142,7 @@ theorem machineRepeatPairCandidate_mem_FP : theorem machineRepeatPairNextAcc_mem_FP : machineRepeatPairNextAcc ∈ FP := by - simpa only [machineRepeatPairNextAcc] using + simpa only [machineRepeatPairNextAcc] using! machineTake_mem_FP machineRepeatPairStateBound_mem_FP machineRepeatPairCandidate_mem_FP @@ -241,7 +241,7 @@ theorem machineRepeatPairFinalState_mem_FP : machineRepeatPairWidth_mem_FP machineRepeatPairIterate_length_le_width theorem machineRepeatPairCode_mem_FP : machineRepeatPairCode ∈ FP := by - simpa only [machineRepeatPairCode] using + simpa only [machineRepeatPairCode] using! machineCompose_mem_FP machineRepeatPairFinalState_mem_FP machineRepeatPairStateAcc_mem_FP @@ -339,6 +339,6 @@ theorem machineRepeatPairIterate_semantics (machineRepeatPairIterate_semantics n item tail n le_rfl) simpa [machineRepeatPairCode, machineRepeatPairFinalState, machineRepeatPairRuler, machineRepeatPairCanonicalInput, - machineRepeatPairCanonicalState] using hstate + machineRepeatPairCanonicalState] using! hstate end BeyondBethe diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseDispatch.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseDispatch.lean index d6fb561552..637b6c4dc8 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseDispatch.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseDispatch.lean @@ -32,7 +32,7 @@ private theorem hasBinaryNat_parked {t : Tape} {value : ℕ} private theorem denseInput_parked (input : List Bool) : TM.Parked ((Tape.init (input.map Γ.ofBool)).move Dir3.right) := by refine ⟨by simp [Tape.move], ?_⟩ - simpa using Tape.init_ofBool_move_right_cells_ne_start input + simpa using! Tape.init_ofBool_move_right_cells_ne_start input private theorem blankOutput_parked : TM.Parked ((Tape.init []).move Dir3.right) := by @@ -73,9 +73,9 @@ theorem denseDispatchProgramTM_hoareTime_frame let inp₀ := (Tape.init (input.map Γ.ofBool)).move Dir3.right let out₀ := (Tape.init []).move Dir3.right have hinput : TM.Parked inp₀ := by - simpa only [inp₀] using denseInput_parked input + simpa only [inp₀] using! denseInput_parked input have houtput : TM.Parked out₀ := by - simpa only [out₀] using blankOutput_parked + simpa only [out₀] using! blankOutput_parked induction program generalizing selector work₀ with | nil => let blankTape := (Tape.init []).move Dir3.right @@ -86,7 +86,7 @@ theorem denseDispatchProgramTM_hoareTime_frame have hcleanLhs : cleanWork tapes.liftedLhs = blankTape := by have hzero := hready.1.control.lookup.destination change (cleanWork tapes.liftedLhs).HasBinaryNat 0 at hzero - simpa only [blankTape] using + simpa only [blankTape] using! Tape.HasBinaryNat.eq_init_move_right hzero have hwork₀Parked : ∀ i, TM.Parked (work₀ i) := by intro i @@ -126,16 +126,16 @@ theorem denseDispatchProgramTM_hoareTime_frame rintro inp work out ⟨hinp, hworkEq, hout⟩ obtain ⟨hi, hw, ho⟩ := phaseTransition_of_parked (inp := inp) (work := work) (out := out) - (by simpa [hinp] using hinput) - (by simpa [hworkEq] using + (by simpa [hinp] using! hinput) + (by simpa [hworkEq] using! hready.1.control.lookup.scanner.parked) - (by simpa [hout] using houtput) + (by simpa [hout] using! houtput) rw [hi, hw, ho] exact ⟨hinp, hworkEq, hout⟩) hhalt simpa only [denseDispatchProgramTM, dispatchWithTM, denseDispatchProgramTime, dispatchWithTime, - selectedInstruction, inp₀, out₀] using hseq + selectedInstruction, inp₀, out₀] using! hseq | cons instruction program ih => let pre : TM.TapePred (n + 1) := fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀ @@ -188,8 +188,8 @@ theorem denseDispatchProgramTM_hoareTime_frame ⟨hinp, rfl, hout⟩ refine ⟨final, time, htime, ?_, hhalt, hfinalInput, ?_, hfinalOutput⟩ - · simpa [hworkClean] using hreach - · simpa only [selectedInstruction] using hresult + · simpa [hworkClean] using! hreach + · simpa only [selectedInstruction] using! hresult have hnonblank : (TM.seqTM (TM.binaryPredTM tapes.liftedLhs) (denseDispatchProgramTM tapes program)).HoareTime @@ -204,11 +204,11 @@ theorem denseDispatchProgramTM_hoareTime_frame rw [hworkEq] rw [hsucc] at hselector exact hselector - have hinpParked : TM.Parked inp := by simpa [hinp] using hinput - have houtParked : TM.Parked out := by simpa [hout] using houtput + have hinpParked : TM.Parked inp := by simpa [hinp] using! hinput + have houtParked : TM.Parked out := by simpa [hout] using! houtput have hworkParked : ∀ i, TM.Parked (work i) := by intro i - simpa [hworkEq] using hwork₀Parked i + simpa [hworkEq] using! hwork₀Parked i have hpred := TM.binaryPredTM_hoareTime_frame tapes.liftedLhs (selector - 1) inp work out hvalue hinpParked.read_ne_start (fun i _ => (hworkParked i).read_ne_start) @@ -253,7 +253,7 @@ theorem denseDispatchProgramTM_hoareTime_frame selectedInstruction program (selector - 1) := by rw [hsucc] rfl - exact ⟨hinp', by simpa only [hselected] using hresult, hout'⟩ + exact ⟨hinp', by simpa only [hselected] using! hresult, hout'⟩ · exact le_rfl have hseq := TM.seqTM_hoareTime (TM.binaryPredTM tapes.liftedLhs) @@ -262,7 +262,7 @@ theorem denseDispatchProgramTM_hoareTime_frame rintro inp' work' out' ⟨hinp', hwork', hout'⟩ obtain ⟨hi, hw, ho⟩ := phaseTransition_of_parked (inp := inp') (work := work') (out := out') - (by simpa [hinp', hinp] using hinput) + (by simpa [hinp', hinp] using! hinput) (by intro i rw [hwork'] @@ -273,7 +273,7 @@ theorem denseDispatchProgramTM_hoareTime_frame (Tape.init_move_right_hasBinaryNat (selector - 1)) · simp only [nextWork, Function.update_of_ne hidx] exact hready.1.control.lookup.scanner.parked i) - (by simpa [hout', hout] using houtput) + (by simpa [hout', hout] using! houtput) rw [hi, hw, ho] exact ⟨hinp', hwork', hout'⟩) hrecursive' @@ -287,10 +287,10 @@ theorem denseDispatchProgramTM_hoareTime_frame rw [hpre.2.1] exact hselector.read_eq_blank_iff.mpr rfl have hinpRead : inp.read ≠ Γ.start := by - simpa [hpre.1] using hinput.read_ne_start + simpa [hpre.1] using! hinput.read_ne_start have hworkRead : ∀ i, (work i).read ≠ Γ.start := by intro i - simpa [hpre.2.1] using (hwork₀Parked i).read_ne_start + simpa [hpre.2.1] using! (hwork₀Parked i).read_ne_start have houtRead : out.read ≠ Γ.start := by simp [hpre.2.2] obtain ⟨done, hreach', hhalt', hdoneInput, hdoneWork, @@ -301,9 +301,9 @@ theorem denseDispatchProgramTM_hoareTime_frame (denseDispatchProgramTM tapes program)) inp work out hread hinpRead hworkRead houtRead hreach hhalt refine ⟨done, time + 1, ?_, ?_, hhalt', ?_⟩ - · simpa only [denseDispatchProgramTime, dispatchWithTime] using + · simpa only [denseDispatchProgramTime, dispatchWithTime] using! Nat.add_le_add_right htime 1 - · simpa only [denseDispatchProgramTM, dispatchWithTM] using hreach' + · simpa only [denseDispatchProgramTM, dispatchWithTM] using! hreach' · rw [hdoneInput, hdoneWork, hdoneOutput] exact hpost · intro inp work out hpre @@ -313,12 +313,12 @@ theorem denseDispatchProgramTM_hoareTime_frame intro hblankRead apply hzero exact hselector.read_eq_blank_iff.mp (by - simpa [hpre.2.1] using hblankRead) + simpa [hpre.2.1] using! hblankRead) have hinpRead : inp.read ≠ Γ.start := by - simpa [hpre.1] using hinput.read_ne_start + simpa [hpre.1] using! hinput.read_ne_start have hworkRead : ∀ i, (work i).read ≠ Γ.start := by intro i - simpa [hpre.2.1] using (hwork₀Parked i).read_ne_start + simpa [hpre.2.1] using! (hwork₀Parked i).read_ne_start have houtRead : out.read ≠ Γ.start := by simp [hpre.2.2] obtain ⟨done, hreach', hhalt', hdoneInput, hdoneWork, @@ -330,9 +330,9 @@ theorem denseDispatchProgramTM_hoareTime_frame inp work out hread hinpRead hworkRead houtRead hreach hhalt refine ⟨done, time + 1, ?_, ?_, hhalt', ?_⟩ · rw [show selector = selector - 1 + 1 by omega] - simpa only [denseDispatchProgramTime, dispatchWithTime] using + simpa only [denseDispatchProgramTime, dispatchWithTime] using! Nat.add_le_add_right htime 1 - · simpa only [denseDispatchProgramTM, dispatchWithTM] using hreach' + · simpa only [denseDispatchProgramTM, dispatchWithTM] using! hreach' · rw [hdoneInput, hdoneWork, hdoneOutput] exact hpost @@ -361,9 +361,9 @@ theorem denseProgramInstructionTM_hoareTime_frame let selectorWork := Function.update initialWork tapes.liftedLhs selectorTape have hinput : TM.Parked inp₀ := by - simpa only [inp₀] using denseInput_parked input + simpa only [inp₀] using! denseInput_parked input have houtput : TM.Parked out₀ := by - simpa only [out₀] using blankOutput_parked + simpa only [out₀] using! blankOutput_parked have hcopy := TM.binaryCopyIntoTM_hoareTime_frame tapes.liftedPC tapes.liftedLhs tapes.liftedFound tapes.lifted.pc_ne_lhs (tapes.lifted.pc_ne 11) (tapes.lifted.data.ne (by decide)) pcValue 0 @@ -388,18 +388,18 @@ theorem denseProgramInstructionTM_hoareTime_frame (denseDispatchProgramTM tapes program) hcopy (by rintro inp work out ⟨hinp, hworkEq, hout⟩ - have hinpParked : TM.Parked inp := by simpa [hinp] using hinput - have houtParked : TM.Parked out := by simpa [hout] using houtput + have hinpParked : TM.Parked inp := by simpa [hinp] using! hinput + have houtParked : TM.Parked out := by simpa [hout] using! houtput have hworkParked : ∀ i, TM.Parked (work i) := by - simpa [hworkEq, selectorWork, selectorTape] using hselectorParked + simpa [hworkEq, selectorWork, selectorTape] using! hselectorParked obtain ⟨hi, hw, ho⟩ := phaseTransition_of_parked hinpParked hworkParked houtParked rw [hi, hw, ho] - exact ⟨hinp, by simpa [selectorWork, selectorTape] using hworkEq, + exact ⟨hinp, by simpa [selectorWork, selectorTape] using! hworkEq, hout⟩) hdispatch simpa only [denseProgramInstructionTM, denseProgramInstructionTime, - selectorWork, selectorTape, inp₀, out₀] using hseq + selectorWork, selectorTape, inp₀, out₀] using! hseq /-- One fixed-program dense RAM step returns to the reusable clean ABI for the exact successor overlay snapshot. -/ @@ -434,7 +434,7 @@ theorem denseProgramStepTM_hoareTime_frame let sourceBound := denseProgramStepSourceHeadBound tapes program input pcValue overlay have hinput : TM.Parked inp₀ := by - simpa only [inp₀] using denseInput_parked input + simpa only [inp₀] using! denseInput_parked input have hprogram := denseProgramInstructionTM_hoareTime_frame tapes program input overlay pcValue initialWork hvalid hready have hprogramCleanup : @@ -450,10 +450,10 @@ theorem denseProgramStepTM_hoareTime_frame overlay) := by intro inp work out hpre obtain ⟨c, time, htime, hreach, hhalt, hinp, hresult, hout⟩ := - hprogram inp work out (by simpa [inp₀, blank] using hpre) + hprogram inp work out (by simpa [inp₀, blank] using! hpre) have hsourceStart₀ : (work tapes.liftedSource).cells 0 = Γ.start := by - simpa [hpre.2.1] using hready.control.lookup.sourceStart + simpa [hpre.2.1] using! hready.control.lookup.sourceStart have hsourceStart := TM.work_cells_zero_eq_start_of_reachesIn tapes.liftedSource hreach hsourceStart₀ have hbufferStart₀ : @@ -472,13 +472,13 @@ theorem denseProgramStepTM_hoareTime_frame sourceStart := hsourceStart bufferStart := hbufferStart sourceHead := ?_ } - · simpa [nextStore, denseInstructionStore, instruction] using + · simpa [nextStore, denseInstructionStore, instruction] using! DenseOverlay.Snapshot.stepInstr_canonical input instruction { pc := pcValue, overlay := overlay } hvalid.1 · simpa only [instruction, nextStore, nextPC, cleanupValues, - remainingValue] using hresult + remainingValue] using! hresult · have hsourceHead₀ : (work tapes.liftedSource).head = 1 := by - simpa [hpre.2.1] using hready.control.lookup.sourceHead + simpa [hpre.2.1] using! hready.control.lookup.sourceHead rw [hsourceHead₀] at hsourceHead simp only [sourceBound, denseProgramStepSourceHeadBound] omega @@ -505,9 +505,9 @@ theorem denseProgramStepTM_hoareTime_frame hprogramCleanup (by rintro inp work out ⟨hinp, hcleanupReady, hout⟩ - have hinpParked : TM.Parked inp := by simpa [hinp] using hinput + have hinpParked : TM.Parked inp := by simpa [hinp] using! hinput have houtParked : TM.Parked out := by - simpa [hout, blank] using blankOutput_parked + simpa [hout, blank] using! blankOutput_parked obtain ⟨hi, hw, ho⟩ := phaseTransition_of_parked hinpParked hcleanupReady.result.parked houtParked rw [hi, hw, ho] @@ -515,7 +515,7 @@ theorem denseProgramStepTM_hoareTime_frame hcleanup simpa only [denseProgramStepTM, denseProgramStepTime, instruction, nextStore, nextPC, cleanupValues, remainingValue, sourceBound, inp₀, - blank] using hseq + blank] using! hseq end Machine end RegisterStore diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Bounds/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Bounds/Internal.lean index de0b0fd07b..df1755c23c 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Bounds/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Bounds/Internal.lean @@ -230,9 +230,9 @@ private theorem entryMissBits_length_le {m : ℕ} (hvalue : entry.2.bits.length ≤ bound) (i : Fin m) : (entryMissBits tapes entry queryBits i).length ≤ bound := by have haddressWidth : bitlen entry.1 ≤ bound := by - simpa only [bitlen, Nat.size_eq_bits_len] using haddress + simpa only [bitlen, Nat.size_eq_bits_len] using! haddress have hvalueWidth : bitlen entry.2 ≤ bound := by - simpa only [bitlen, Nat.size_eq_bits_len] using hvalue + simpa only [bitlen, Nat.size_eq_bits_len] using! hvalue unfold entryMissBits split_ifs <;> (try simp only [List.length_nil, List.length_replicate, @@ -272,7 +272,7 @@ private theorem entryMissCleanupTime_canonical_le {m : ℕ} (entryMissTargets tapes) ≤ 7 * (1 + entryMatchReadTime entry queryBits + 2 * bound + 9) + 1 := by simpa [entryMissHeadBound, entryScanCanonicalWork, - TM.resetBinaryBlank, Tape.move, Tape.init] using hreset + TM.resetBinaryBlank, Tape.move, Tape.init] using! hreset unfold entryMissCleanupTime entryMissHeadBound entryScanCanonicalWork simp only [Function.const_apply] simp only [TM.resetBinaryBlank, Tape.move, Tape.init] @@ -378,9 +378,9 @@ private theorem encodedStoreLength_le_uniform (store : Store) (bound : ℕ) have hhead : (Entry.encode entry).length ≤ 4 * bound + 2 := by rw [Entry.encode_length] have haddressWidth : bitlen entry.1 ≤ bound := by - simpa only [bitlen, Nat.size_eq_bits_len] using hentry.1 + simpa only [bitlen, Nat.size_eq_bits_len] using! hentry.1 have hvalueWidth : bitlen entry.2 ≤ bound := by - simpa only [bitlen, Nat.size_eq_bits_len] using hentry.2 + simpa only [bitlen, Nat.size_eq_bits_len] using! hentry.2 omega unfold encodedStoreLength at htail ⊢ simp only [List.flatMap_cons, List.length_append, List.length_cons, @@ -446,9 +446,9 @@ private theorem entryLookupEntryWidth_le (entry : Entry) (hentryValue : entry.2.bits.length ≤ bound) : entryLookupEntryWidth entry address ≤ bound := by have haddressWidth : bitlen entry.1 ≤ bound := by - simpa only [bitlen, Nat.size_eq_bits_len] using hentryAddress + simpa only [bitlen, Nat.size_eq_bits_len] using! hentryAddress have hvalueWidth : bitlen entry.2 ≤ bound := by - simpa only [bitlen, Nat.size_eq_bits_len] using hentryValue + simpa only [bitlen, Nat.size_eq_bits_len] using! hentryValue unfold entryLookupEntryWidth omega @@ -459,7 +459,7 @@ private theorem entryLookupStoreWidth_le (store : Store) entry.1.bits.length ≤ bound ∧ entry.2.bits.length ≤ bound) : entryLookupStoreWidth address store ≤ bound := by induction store with - | nil => simpa [entryLookupStoreWidth] using haddress + | nil => simpa [entryLookupStoreWidth] using! haddress | cons entry rest ih => have hentry := hentries entry (by simp) have hrest : ∀ current ∈ rest, @@ -505,10 +505,10 @@ private theorem entryLookupLoadedTime_le {m : ℕ} have hread := read_bits_length_le store address bound (fun entry hentry => (hentries entry hentry).2) have hcopyAddress := binaryCopyTime_le_width address 0 bound - (by simpa [Nat.size_eq_bits_len] using haddress) (by simp) + (by simpa [Nat.size_eq_bits_len] using! haddress) (by simp) have hcopyRead := binaryCopyTime_le_width (RegisterStore.read store address) 0 bound - (by simpa [Nat.size_eq_bits_len] using hread) (by simp) + (by simpa [Nat.size_eq_bits_len] using! hread) (by simp) have hcopyCount := binaryCopyTime_le_width store.length 0 bound (le_trans (size_le_self store.length) hstoreLength) (by simp) unfold entryLookupLoadedTime entryLookupCopyRestoreTime @@ -570,9 +570,9 @@ private theorem entryUpdatePostEmitHead_le {m : ℕ} (hvalue : entry.2.bits.length ≤ bound) : entryUpdatePostEmitHead tapes entry i ≤ bound + 1 := by have haddressWidth : bitlen entry.1 ≤ bound := by - simpa only [bitlen, Nat.size_eq_bits_len] using haddress + simpa only [bitlen, Nat.size_eq_bits_len] using! haddress have hvalueWidth : bitlen entry.2 ≤ bound := by - simpa only [bitlen, Nat.size_eq_bits_len] using hvalue + simpa only [bitlen, Nat.size_eq_bits_len] using! hvalue unfold entryUpdatePostEmitHead split_ifs <;> omega @@ -756,7 +756,7 @@ private theorem entriesEncode_length_le (store : Store) (bound : ℕ) have htail := ih hrest have hhead : (Entry.encode entry).length ≤ 4 * bound + 2 := by rw [Entry.encode_length] - simpa [bitlen, Nat.size_eq_bits_len] using + simpa [bitlen, Nat.size_eq_bits_len] using! (show 2 * entry.1.bits.length + 2 * entry.2.bits.length + 2 ≤ 4 * bound + 2 by omega) simp only [List.flatMap_cons, List.length_append, List.length_cons] @@ -770,9 +770,9 @@ private theorem binaryInstructionArithmeticTime_le binaryInstructionArithmeticTime op lhs rhs ≤ 1000 * (bound + 1) ^ 2 := by have hlhsSize : lhs.size ≤ bound := by - simpa [Nat.size_eq_bits_len] using hlhs + simpa [Nat.size_eq_bits_len] using! hlhs have hrhsSize : rhs.size ≤ bound := by - simpa [Nat.size_eq_bits_len] using hrhs + simpa [Nat.size_eq_bits_len] using! hrhs cases op with | add => have htime := TM.binaryRippleAddTime_le lhs rhs @@ -797,9 +797,9 @@ private theorem binaryInstrResult_bits_length_le (hrhs : rhs.bits.length ≤ bound) : (op.eval lhs rhs).bits.length ≤ 2 * bound + 1 := by have hlhsSize : lhs.size ≤ bound := by - simpa [Nat.size_eq_bits_len] using hlhs + simpa [Nat.size_eq_bits_len] using! hlhs have hrhsSize : rhs.size ≤ bound := by - simpa [Nat.size_eq_bits_len] using hrhs + simpa [Nat.size_eq_bits_len] using! hrhs rw [Nat.size_eq_bits_len (op.eval lhs rhs)] cases op with | add => @@ -951,9 +951,9 @@ private theorem indirectStoreInstructionTime_le {m : ℕ} have hlookupValue := entryLookupStaticTime_le tapes.rhsLookup store source bound hbound hstoreLength hsource hentries have hcopyAddress := binaryCopyTime_le_width address 0 bound - (by simpa [Nat.size_eq_bits_len] using haddress) (by simp) + (by simpa [Nat.size_eq_bits_len] using! haddress) (by simp) have hcopyValue := binaryCopyTime_le_width value 0 bound - (by simpa [Nat.size_eq_bits_len] using hvalue) (by simp) + (by simpa [Nat.size_eq_bits_len] using! hvalue) (by simp) have hupdate := entryUpdateTime_le tapes.update store address value bound hbound hstoreLength hentries haddress hvalue dsimp only [address, value] at hcopyAddress hcopyValue hupdate ⊢ @@ -977,7 +977,7 @@ private theorem executeInstructionTime_le {m : ℕ} 200000 * (bound + 1) ^ 3 := by have hpcSucc : TM.binarySuccTime pcValue ≤ 2 * bound + 2 := binarySuccTime_le_width pcValue bound (by - simpa [Nat.size_eq_bits_len] using hpc) + simpa [Nat.size_eq_bits_len] using! hpc) have hencoded := entriesEncode_length_le store bound hentries have hencodedCube : (store.flatMap Entry.encode).length ≤ 6 * (bound + 1) ^ 3 := by @@ -1119,15 +1119,15 @@ private theorem dispatchProgramTime_le {m : ℕ} have hselectorBits : selector.bits.length ≤ bound := by rw [Nat.size_eq_bits_len selector] have hsize := Nat.size_le_size hselector - simpa [Nat.size_eq_bits_len] using le_trans hsize (by - simpa [Nat.size_eq_bits_len] using hpc) + simpa [Nat.size_eq_bits_len] using! le_trans hsize (by + simpa [Nat.size_eq_bits_len] using! hpc) have hreset : TM.resetBinaryWorkTime 1 selector.bits.length ≤ 2 * bound + 9 := by unfold TM.resetBinaryWorkTime TM.clearWorkTimeBound omega have hexecute := executeInstructionTime_le tapes .halt pcValue store bound hbound hstoreLength hentries hpc (by - simpa [instructionResourceMagnitude] using hbound) + simpa [instructionResourceMagnitude] using! hbound) simp only [dispatchProgramTime, List.length_nil, Nat.zero_add] have hboundCube : bound ≤ (bound + 1) ^ 3 := by exact le_trans (by omega) @@ -1150,7 +1150,7 @@ private theorem dispatchProgramTime_le {m : ℕ} have hvalue : selector - 1 + 1 ≤ pcValue + 1 := by omega have hsize := Nat.size_le_size hvalue have hpcSize : pcValue.size ≤ bound := by - simpa [Nat.size_eq_bits_len] using hpc + simpa [Nat.size_eq_bits_len] using! hpc have hpcSucc : (pcValue + 1).size ≤ bound + 1 := by rw [Nat.size_le] have hlt := Nat.lt_size_self pcValue @@ -1193,7 +1193,7 @@ private theorem programInstructionTime_le {m : ℕ} (instructionResourceMagnitude_le_program instruction program hinstruction) hprogram) have hcopy := binaryCopyTime_le_width pcValue 0 bound - (by simpa [Nat.size_eq_bits_len] using hpc) (by simp) + (by simpa [Nat.size_eq_bits_len] using! hpc) (by simp) unfold programInstructionTime have hboundCube : bound ≤ (bound + 1) ^ 3 := by exact le_trans (by omega) @@ -1219,7 +1219,7 @@ private theorem maxWidth_le_of_entries (store : Store) (bound : ℕ) current.1.bits.length ≤ bound ∧ current.2.bits.length ≤ bound := by intro current hcurrent exact hentries current (by simp [hcurrent]) - simpa [maxWidth, bitlen, Nat.size_eq_bits_len] using + simpa [maxWidth, bitlen, Nat.size_eq_bits_len] using! (max_le hentry.1 (max_le hentry.2 (ih hrest))) private theorem snapshotWidth_le_of_bounds (pcValue : ℕ) (store : Store) @@ -1231,7 +1231,7 @@ private theorem snapshotWidth_le_of_bounds (pcValue : ℕ) (store : Store) have hcount : store.length.bits.length ≤ bound := bits_length_le_of_value_le store.length bound hstoreLength have hwidth := maxWidth_le_of_entries store bound hentries - simpa [Snapshot.width, bitlen, Nat.size_eq_bits_len] using + simpa [Snapshot.width, bitlen, Nat.size_eq_bits_len] using! (max_le hpc (max_le hcount hwidth)) private theorem entryBitlen_le_maxWidth (store : Store) (entry : Entry) @@ -1258,7 +1258,7 @@ private theorem snapshotEntryBits_le_width (snapshot : Snapshot) maxWidth snapshot.store := entryBitlen_le_maxWidth snapshot.store entry hentry have hboth := le_trans hmember hstore - simpa [bitlen, Nat.size_eq_bits_len] using + simpa [bitlen, Nat.size_eq_bits_len] using! (show bitlen entry.1 ≤ snapshot.width ∧ bitlen entry.2 ≤ snapshot.width from ⟨le_trans (le_max_left _ _) hboth, @@ -1281,7 +1281,7 @@ private theorem instructionLogCost_le (instruction : Instr) simp only [instructionResourceMagnitude] at hinstruction simp only [Instr.logCost] have hvalue := bits_length_le_of_value_le value bound (by omega) - simpa [bitlen, Nat.size_eq_bits_len] using + simpa [bitlen, Nat.size_eq_bits_len] using! (show value.bits.length + 1 ≤ 6 * (bound + 1) by omega) | add destination source₀ source₁ => simp only [instructionResourceMagnitude] at hinstruction @@ -1292,9 +1292,9 @@ private theorem instructionLogCost_le (instruction : Instr) (RegisterStore.read store source₁) bound hlhs hrhs have hresult' : (RegisterStore.read store source₀ + RegisterStore.read store source₁).bits.length ≤ 2 * bound + 1 := by - simpa [BinaryInstrOp.eval] using hresult + simpa [BinaryInstrOp.eval] using! hresult simpa [Instr.logCost, Snapshot.decode, RegisterStore.decode, bitlen, - Nat.size_eq_bits_len, BinaryInstrOp.eval] using + Nat.size_eq_bits_len, BinaryInstrOp.eval] using! (show (RegisterStore.read store source₀).bits.length + (RegisterStore.read store source₁).bits.length + (RegisterStore.read store source₀ + @@ -1304,7 +1304,7 @@ private theorem instructionLogCost_le (instruction : Instr) have hlhs := hread source₀ have hrhs := hread source₁ simpa [Instr.logCost, Snapshot.decode, RegisterStore.decode, bitlen, - Nat.size_eq_bits_len] using + Nat.size_eq_bits_len] using! (show (RegisterStore.read store source₀).bits.length + (RegisterStore.read store source₁).bits.length + 1 ≤ 6 * (bound + 1) by omega) @@ -1316,9 +1316,9 @@ private theorem instructionLogCost_le (instruction : Instr) (RegisterStore.read store source₁) bound hlhs hrhs have hresult' : (RegisterStore.read store source₀ * RegisterStore.read store source₁).bits.length ≤ 2 * bound + 1 := by - simpa [BinaryInstrOp.eval] using hresult + simpa [BinaryInstrOp.eval] using! hresult simpa [Instr.logCost, Snapshot.decode, RegisterStore.decode, bitlen, - Nat.size_eq_bits_len, BinaryInstrOp.eval] using + Nat.size_eq_bits_len, BinaryInstrOp.eval] using! (show (RegisterStore.read store source₀).bits.length + (RegisterStore.read store source₁).bits.length + (RegisterStore.read store source₀ * @@ -1328,7 +1328,7 @@ private theorem instructionLogCost_le (instruction : Instr) have haddress := hread addressRegister have hvalue := hread (RegisterStore.read store addressRegister) simpa [Instr.logCost, Snapshot.decode, RegisterStore.decode, bitlen, - Nat.size_eq_bits_len] using + Nat.size_eq_bits_len] using! (show (RegisterStore.read store addressRegister).bits.length + (RegisterStore.read store (RegisterStore.read store addressRegister)).bits.length + 1 ≤ @@ -1337,14 +1337,14 @@ private theorem instructionLogCost_le (instruction : Instr) have haddress := hread addressRegister have hvalue := hread source simpa [Instr.logCost, Snapshot.decode, RegisterStore.decode, bitlen, - Nat.size_eq_bits_len] using + Nat.size_eq_bits_len] using! (show (RegisterStore.read store addressRegister).bits.length + (RegisterStore.read store source).bits.length + 1 ≤ 6 * (bound + 1) by omega) | jz source target => have hvalue := hread source simpa [Instr.logCost, Snapshot.decode, RegisterStore.decode, bitlen, - Nat.size_eq_bits_len] using + Nat.size_eq_bits_len] using! (show (RegisterStore.read store source).bits.length + 1 ≤ 6 * (bound + 1) by omega) | jmp target => simp only [Instr.logCost]; omega @@ -1411,10 +1411,10 @@ private theorem instructionStoreBounds (instruction : Instr) | jmp target => simp [next, snapshot, Snapshot.stepInstr]; omega | halt => simp [next, snapshot, Snapshot.stepInstr]; omega constructor - · simpa [next, snapshot, instructionStore] using hnextLength + · simpa [next, snapshot, instructionStore] using! hnextLength · intro entry hentry have := snapshotEntryBits_le_width next entry (by - simpa [next, snapshot, instructionStore] using hentry) + simpa [next, snapshot, instructionStore] using! hentry) exact ⟨le_trans this.1 hnextWidth, le_trans this.2 hnextWidth⟩ private theorem instructionCleanupResetBits_le @@ -1438,7 +1438,7 @@ private theorem instructionCleanupResetBits_le exact le_trans hencoded (le_trans hproduct (by nlinarith)) have hencodedWide' : (store.map (fun entry => entry.encode.length)).sum ≤ 6 * (bound + 1) ^ 2 := by - simpa only [List.length_flatMap] using hencodedWide + simpa only [List.length_flatMap] using! hencodedWide have hboundWide : bound ≤ 6 * (bound + 1) ^ 2 := by nlinarith have hstoreLengthBitsWide : store.length.bits.length ≤ 6 * (bound + 1) ^ 2 := by @@ -1473,7 +1473,7 @@ private theorem instructionCleanupResetBits_le (RegisterStore.read store source₀ + RegisterStore.read store source₁).bits.length ≤ 6 * (bound + 1) ^ 2 := by - simpa [BinaryInstrOp.eval] using hsmall _ hresult + simpa [BinaryInstrOp.eval] using! hsmall _ hresult fin_cases slot <;> simp [instructionCleanupResetBits, instructionCleanupValue, instructionRemainingValue] <;> @@ -1493,7 +1493,7 @@ private theorem instructionCleanupResetBits_le (RegisterStore.read store source₀ - RegisterStore.read store source₁).bits.length ≤ 6 * (bound + 1) ^ 2 := by - simpa [BinaryInstrOp.eval] using hsmall _ hresult + simpa [BinaryInstrOp.eval] using! hsmall _ hresult fin_cases slot <;> simp [instructionCleanupResetBits, instructionCleanupValue, instructionRemainingValue] <;> @@ -1513,7 +1513,7 @@ private theorem instructionCleanupResetBits_le (RegisterStore.read store source₀ * RegisterStore.read store source₁).bits.length ≤ 6 * (bound + 1) ^ 2 := by - simpa [BinaryInstrOp.eval] using hsmall _ hresult + simpa [BinaryInstrOp.eval] using! hsmall _ hresult fin_cases slot <;> simp [instructionCleanupResetBits, instructionCleanupValue, instructionRemainingValue] <;> @@ -1569,11 +1569,11 @@ private theorem instructionCleanupTime_le {m : ℕ} have hnext := instructionStoreBounds instruction pcValue store bound hbound hstoreLength hentries hpc hinstruction have hnextLength : nextStore.length ≤ bound + 1 := by - simpa only [nextStore] using hnext.1 + simpa only [nextStore] using! hnext.1 have hnextEntries : ∀ entry ∈ nextStore, entry.1.bits.length ≤ 6 * (bound + 1) ∧ entry.2.bits.length ≤ 6 * (bound + 1) := by - simpa only [nextStore] using hnext.2 + simpa only [nextStore] using! hnext.2 have hnextEncoded := entriesEncode_length_le nextStore (6 * (bound + 1)) hnextEntries have hnextBits : nextBits.length ≤ 26 * (bound + 1) ^ 2 := by @@ -1693,16 +1693,16 @@ private theorem dispatchHaltTime_le {m : ℕ} omega | cons instruction rest ih => have hselectorPred : (selector - 1).bits.length ≤ bound := by - simpa only [Nat.size_eq_bits_len] using + simpa only [Nat.size_eq_bits_len] using! (le_trans (Nat.size_le_size (Nat.sub_le selector 1)) (by - simpa [Nat.size_eq_bits_len] using hselector)) + simpa [Nat.size_eq_bits_len] using! hselector)) have htail := ih (selector - 1) hselectorPred have hpred := TM.binaryPredTime_le (selector - 1) have hpredSize : (selector - 1 + 1).size ≤ bound + 1 := by have hvalue : selector - 1 + 1 ≤ selector + 1 := by omega have hsize := Nat.size_le_size hvalue have hselectorSize : selector.size ≤ bound := by - simpa [Nat.size_eq_bits_len] using hselector + simpa [Nat.size_eq_bits_len] using! hselector have hsucc : (selector + 1).size ≤ bound + 1 := by rw [Nat.size_le] have hlt := Nat.lt_size_self selector @@ -1729,7 +1729,7 @@ private theorem programHaltTime_le {m : ℕ} 40 * (program.length + 1) * (bound + 1) := by have hdispatch := dispatchHaltTime_le tapes program pcValue bound hbound hpc have hcopy := binaryCopyTime_le_width pcValue 0 bound - (by simpa [Nat.size_eq_bits_len] using hpc) (by simp) + (by simpa [Nat.size_eq_bits_len] using! hpc) (by simp) unfold programHaltTime nlinarith @@ -1798,14 +1798,14 @@ private theorem programLoopTime_le {m : ℕ} | zero => simp [programLoopTime] | succ fuel ih => have hcurrent : SnapshotBounded snapshot bound := by - simpa [snapshotSteps] using hall 0 (by omega) + simpa [snapshotSteps] using! hall 0 (by omega) have hnext : SnapshotBounded (snapshot.step program) bound := by - simpa [snapshotSteps] using hall 1 (by omega) + simpa [snapshotSteps] using! hall 1 (by omega) have hiteration := programLoopIterationTime_le tapes program snapshot bound hbound hcurrent hnext hprogram have htail := ih (snapshot.step program) (by intro k hk - simpa [snapshotSteps] using hall (k + 1) (by omega)) + simpa [snapshotSteps] using! hall (k + 1) (by omega)) simp only [programLoopTime] rw [Nat.succ_mul] omega @@ -1862,7 +1862,7 @@ private theorem inputBitStoreFrom_bounds (address : ℕ) (input : List Bool) simp only [List.length_cons] at hsum omega) have hone : (1 : ℕ).bits.length ≤ bound := by - simpa using (show 1 ≤ bound by + simpa using! (show 1 ≤ bound by simp only [List.length_cons] at hsum omega) cases bit with @@ -1897,7 +1897,7 @@ private theorem programInitialSnapshot_bounded (input : List Bool) : · change (RegisterStore.write (inputBitStoreFrom 1 input) 0 input.length).length ≤ input.length + 1 omega - · simpa [programInitialSnapshot, programInitialStore] using hentries + · simpa [programInitialSnapshot, programInitialStore] using! hentries private theorem rewindEntryEncodeRestoreTime_bound (entry : Entry) (bound : ℕ) (hbound : 1 ≤ bound) (haddress : entry.1.bits.length ≤ bound) @@ -1936,7 +1936,7 @@ private theorem initialInputLoopTime_le {m : ℕ} have hrewind := rewindEntryEncodeRestoreTime_bound (address, 1) bound hbound haddressValue hone have hsuccAddress := binarySuccTime_le_width address bound (by - simpa [Nat.size_eq_bits_len] using haddressValue) + simpa [Nat.size_eq_bits_len] using! haddressValue) have hsuccCount := binarySuccTime_le_width count bound (by exact le_trans (size_le_self count) (by omega)) cases bit with @@ -1986,7 +1986,7 @@ private theorem initialCleanupBits_le {m : ℕ} split · exact hlength · split - · simpa using hbound + · simpa using! hbound · simp private theorem initialAbiInstallTime_le {m : ℕ} @@ -2045,7 +2045,7 @@ private theorem programInitTime_le {m : ℕ} omega) have hsuccZero := TM.binarySuccTime_le 0 have hsuccZero' : TM.binarySuccTime 0 ≤ 2 := by - simpa using hsuccZero + simpa using! hsuccZero unfold programInitTime dsimp only [bound] at hloop habi hlengthBits hbound ⊢ have hsqCube : (input.length + 2) ^ 2 ≤ @@ -2061,13 +2061,13 @@ private theorem programInitTime_le {m : ℕ} calc initialInputLoopTime tapes 1 0 input ≤ (input.length + 1) * (100 * (input.length + 2) ^ 2) := by - simpa only [Nat.add_assoc] using hloop + simpa only [Nat.add_assoc] using! hloop _ ≤ (input.length + 2) * (100 * (input.length + 2) ^ 2) := Nat.mul_le_mul_right _ (by omega) _ = 100 * (input.length + 2) ^ 3 := by ring have habi' : initialAbiInstallTime tapes (programInitialStore input) input.length ≤ 100 * (input.length + 2) ^ 2 := by - simpa only [Nat.add_assoc] using habi + simpa only [Nat.add_assoc] using! habi nlinarith theorem programDecisionTime_le_envelope_internal {m : ℕ} @@ -2094,7 +2094,7 @@ theorem programDecisionTime_le_envelope_internal {m : ℕ} exact programDecisionScale_pos_internal program input.length cost have hinitial := programInitialSnapshot_bounded input have hinitialRep : initial.Represents (RAM.initCfg input) := by - simpa only [initial] using programInitialSnapshot_represents_internal input + simpa only [initial] using! programInitialSnapshot_represents_internal input have hinitialWidth : initial.width ≤ input.length + 1 := by exact snapshotWidth_le_of_bounds initial.pc initial.store (input.length + 1) hinitial.1 hinitial.2.1 hinitial.2.2 @@ -2108,7 +2108,7 @@ theorem programDecisionTime_le_envelope_internal {m : ℕ} calc RAM.logTimeUpto program (fuel + 1) initial.decode = RAM.logTimeUpto program fuel initial.decode := by - simpa only [Nat.succ_eq_add_one] using hsame + simpa only [Nat.succ_eq_add_one] using! hsame _ = cost := by rw [hinitialRep.2] have hcanonical : Canonical initial.store := hinitialRep.1 have hall : ∀ k, k ≤ fuel + 1 → @@ -2131,7 +2131,7 @@ theorem programDecisionTime_le_envelope_internal {m : ℕ} Nat.mul_le_mul hunitCost hstaticMagnitude have hlengthScale : current.store.length ≤ scale := by have hinitialLength : initial.store.length ≤ input.length + 1 := by - simpa only [initial] using hinitial.1 + simpa only [initial] using! hinitial.1 have hlengthBase : current.store.length ≤ input.length + 1 + RAM.unitTimeUpto program k initial.decode := by dsimp only [current] @@ -2195,7 +2195,7 @@ theorem programDecisionTime_le_envelope_internal {m : ℕ} le_trans hinit (Nat.mul_le_mul_left 1000 (Nat.pow_le_pow_left hinputScale 3)) have hfuelScale : fuel + 1 ≤ scale + 1 := by - have hfuelCost : fuel ≤ cost := by simpa only [cost] using hfuel + have hfuelCost : fuel ≤ cost := by simpa only [cost] using! hfuel have hcostScale : cost ≤ scale := by change cost ≤ input.length + cost * (magnitude + 2) + magnitude + 3 have hfactor : cost * 1 ≤ cost * (magnitude + 2) := @@ -2240,20 +2240,20 @@ theorem programDecisionTime_le_envelope_internal {m : ℕ} dsimp only [envelopeUnit] exact Nat.mul_pos hmagnitude (pow_pos (by omega) 4) have hinitUnit : programInitTime tapes input ≤ 1000 * envelopeUnit := by - simpa only [envelopeUnit, Nat.mul_assoc] using hinitEnvelope + simpa only [envelopeUnit, Nat.mul_assoc] using! hinitEnvelope have hloopUnit : programLoopTime tapes program (fuel + 1) initial ≤ 602000000 * envelopeUnit := by - simpa only [envelopeUnit, Nat.mul_assoc] using hloop' + simpa only [envelopeUnit, Nat.mul_assoc] using! hloop' have houtputUnit : programOutputTime tapes (initial.run program fuel).store ≤ 22000 * envelopeUnit := by - simpa only [envelopeUnit, Nat.mul_assoc] using houtputEnvelope + simpa only [envelopeUnit, Nat.mul_assoc] using! houtputEnvelope have hloopUnit' : programLoopTime tapes program (fuel + 1) (programInitialSnapshot input) ≤ 602000000 * envelopeUnit := by - simpa only [initial] using hloopUnit + simpa only [initial] using! hloopUnit have houtputUnit' : programOutputTime tapes ((programInitialSnapshot input).run program fuel).store ≤ 22000 * envelopeUnit := by - simpa only [initial] using houtputUnit + simpa only [initial] using! houtputUnit have htotal : programDecisionTime tapes program input fuel ≤ 602023002 * envelopeUnit := by unfold programDecisionTime @@ -2263,7 +2263,7 @@ theorem programDecisionTime_le_envelope_internal {m : ℕ} unfold programDecisionEnvelope change 602023002 * envelopeUnit ≤ 1000000000 * magnitude * (scale + 1) ^ 4 - simpa only [envelopeUnit, Nat.mul_assoc] using + simpa only [envelopeUnit, Nat.mul_assoc] using! (Nat.mul_le_mul_right envelopeUnit (show 602023002 ≤ 1000000000 by decide)) diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DecisionInternal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DecisionInternal.lean index fb24d915f7..a28ad43a54 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DecisionInternal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DecisionInternal.lean @@ -55,7 +55,7 @@ theorem programDecisionTM_hoareTime_run_internal hinitInput, hinitWork, hinitOutput⟩ := hinit _ _ _ ⟨rfl, rfl, rfl⟩ have hinitialCanonical : Canonical initial.store := by - simpa only [initial, programInitialSnapshot] using + simpa only [initial, programInitialSnapshot] using! programInitialStore_canonical_internal input have hready : InstructionExecutionReady tapes initial.store initial.pc initDone.work := by @@ -67,7 +67,7 @@ theorem programDecisionTM_hoareTime_run_internal initDone.work initDone.input hready hinitInputParked hhalted obtain ⟨loopDone, loopTime, hloopTime, hloopReach, hloopHalt, hloopInput, hloopReady, hloopOutput⟩ := - hloop _ _ _ ⟨rfl, rfl, by simpa [TM.resetBinaryBlank] using hinitOutput⟩ + hloop _ _ _ ⟨rfl, rfl, by simpa [TM.resetBinaryBlank] using! hinitOutput⟩ have hloopInputParked : TM.Parked loopDone.input := by rw [hloopInput] exact hinitInputParked @@ -95,7 +95,7 @@ theorem programDecisionTM_hoareTime_run_internal hloopInputParked.read_ne_start (fun i => (hloopReady.control.lookup.scanner.parked i).read_ne_start) hloopOutputParked.read_ne_start - simpa only [hi, hw, ho] using houtputReach + simpa only [hi, hw, ho] using! houtputReach have htailReach := TM.seqTM_reachesIn_of_reachesIn (programLoopTM tapes program) (programOutputTM tapes) hloopReach hloopHalt houtputReach' @@ -113,7 +113,7 @@ theorem programDecisionTM_hoareTime_run_internal have hinitOutputParked : TM.Parked initDone.output := by rw [hinitOutput] have hblankNat : TM.resetBinaryBlank.HasBinaryNat 0 := by - simpa [TM.resetBinaryBlank] using Tape.init_move_right_hasBinaryNat 0 + simpa [TM.resetBinaryBlank] using! Tape.init_move_right_hasBinaryNat 0 exact ⟨by rw [hblankNat.2.1], hblankNat.2.hasBinaryContent.cells_ne_start⟩ have htailReach' : @@ -130,7 +130,7 @@ theorem programDecisionTM_hoareTime_run_internal hinitInputParked.read_ne_start (fun i => (hinitWorkParked i).read_ne_start) hinitOutputParked.read_ne_start - simpa only [hi, hw, ho] using htailReach + simpa only [hi, hw, ho] using! htailReach have hreach := TM.seqTM_reachesIn_of_reachesIn (programInitTM tapes) (TM.seqTM (programLoopTM tapes program) (programOutputTM tapes)) @@ -144,8 +144,9 @@ theorem programDecisionTM_hoareTime_run_internal omega · change (programDecisionTM tapes program).halted done unfold programDecisionTM - rw [TM.phase2Wrap_halted_iff] - exact htailHalt + exact (TM.phase2Wrap_halted_iff (programInitTM tapes) + (TM.seqTM (programLoopTM tapes program) (programOutputTM tapes)) tailDone).mpr + htailHalt · change outputDone.output = registerVerdictOutput (RegisterStore.read final.store 0) exact houtputVerdict @@ -168,7 +169,7 @@ theorem programDecisionTM_hoareTime_ramRun_internal let initial := programInitialSnapshot input let final := initial.run program fuel have hinitialRep : initial.Represents (RAM.initCfg input) := by - simpa only [initial] using programInitialSnapshot_represents_internal input + simpa only [initial] using! programInitialSnapshot_represents_internal input have hdecode : final.decode = RAM.run program fuel (RAM.initCfg input) := by have hrun := Snapshot.decode_run_internal program fuel initial hinitialRep.1 rw [hinitialRep.2] at hrun diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseBoundsProof.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseBoundsProof.lean index 30eeb3f761..dcb3469eee 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseBoundsProof.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseBoundsProof.lean @@ -43,7 +43,7 @@ private theorem encodedStoreLength_eq_sums (store : Store) : 2 * (rest.map fun entry => bitlen entry.1).sum + 2 * (rest.map fun entry => bitlen entry.2).sum + 2 * rest.length := by - simpa only [encodedStoreLength] using ih + simpa only [encodedStoreLength] using! ih rw [ih'] omega @@ -80,7 +80,7 @@ private theorem address_count_width_le_encodedStoreLength norm_num at hlt omega have hbits : bitlen store.length = 1 := by - simpa [bitlen] using hsize + simpa [bitlen] using! hsize rw [hbits] omega | succ width => @@ -93,25 +93,25 @@ private theorem address_count_width_le_encodedStoreLength have hlowSubset : low ⊆ Finset.range threshold := by intro address haddress have := (Finset.mem_filter.mp haddress).2 - simpa [Finset.mem_range] using this + simpa [Finset.mem_range] using! this have hlow : low.card ≤ threshold := by exact le_trans (Finset.card_le_card hlowSubset) (by simp) have hpartition : low.card + high.card = store.length := by have hparts := Finset.card_filter_add_card_filter_not (s := addressSet) (p := fun address => address < threshold) - simpa [low, high, Nat.not_lt, hcard] using hparts + simpa [low, high, Nat.not_lt, hcard] using! hparts have hthresholdTwice : 2 * threshold ≤ store.length := by have hpow : 2 ^ (width + 1) ≤ store.length := by rw [← Nat.lt_size] omega - simpa [threshold, pow_succ, Nat.mul_comm] using hpow + simpa [threshold, pow_succ, Nat.mul_comm] using! hpow have hmanyHigh : store.length ≤ 2 * high.card := by omega have hhighWidth : ∀ address ∈ high, width + 1 ≤ bitlen address := by intro address haddress have hge := (Finset.mem_filter.mp haddress).2 unfold bitlen have hlt : width < address.size := Nat.lt_size.mpr (by - simpa [threshold] using hge) + simpa [threshold] using! hge) omega have hhighSum : high.card * (width + 1) ≤ ∑ address ∈ high, bitlen address := by @@ -125,7 +125,7 @@ private theorem address_count_width_le_encodedStoreLength addressWidths.sum := by rw [← List.sum_toFinset (fun address => bitlen address) hnodup] have hwidth : bitlen store.length = width + 2 := by - simpa [bitlen] using hsize + simpa [bitlen] using! hsize rw [hwidth] have hmain : store.length * (width + 2) ≤ 2 * addressWidths.sum + store.length := by @@ -133,7 +133,7 @@ private theorem address_count_width_le_encodedStoreLength store.length * (width + 1) + store.length by ring] have hproduct : store.length * (width + 1) ≤ 2 * (high.card * (width + 1)) := - by simpa [Nat.mul_assoc] using + by simpa [Nat.mul_assoc] using! Nat.mul_le_mul_right (width + 1) hmanyHigh omega omega @@ -190,7 +190,7 @@ private theorem count_bits_le_encodedStoreLength (store : Store) · simp [hzero, bitlen] · have hpos : 1 ≤ store.length := Nat.one_le_iff_ne_zero.mpr hzero have hle : bitlen store.length ≤ store.length * bitlen store.length := by - simpa only [one_mul] using + simpa only [one_mul] using! Nat.mul_le_mul_right (bitlen store.length) hpos exact le_trans hle hproduct @@ -216,11 +216,11 @@ private theorem entryLookupStoreWidth_le_encoded (store : Store) · apply max_le · exact le_trans hentry.2 (Nat.le_add_right _ _) · apply max_le - · simpa [bitlen, Nat.size_eq_bits_len] using + · simpa [bitlen, Nat.size_eq_bits_len] using! le_trans hentry.1 (Nat.le_add_right (encodedStoreLength (entry :: rest)) address.bits.length) · apply max_le - · simpa [bitlen, Nat.size_eq_bits_len] using + · simpa [bitlen, Nat.size_eq_bits_len] using! le_trans hentry.2 (Nat.le_add_right (encodedStoreLength (entry :: rest)) address.bits.length) · have hpositive : 1 ≤ encodedStoreLength (entry :: rest) := by @@ -353,7 +353,7 @@ private theorem denseOverlayLookupTime_le_volume {m : ℕ} encodedStoreLength overlay + 1 := by have hreadSize : (RegisterStore.read overlay address).size ≤ encodedStoreLength overlay := by - simpa [Nat.size_eq_bits_len] using htag + simpa [Nat.size_eq_bits_len] using! htag have hvalue : RegisterStore.read overlay address - 1 + 1 ≤ RegisterStore.read overlay address + 1 := by omega have hsize := Nat.size_le_size hvalue @@ -362,7 +362,7 @@ private theorem denseOverlayLookupTime_le_volume {m : ℕ} rw [Nat.size_le] have hlt := Nat.lt_size_self (RegisterStore.read overlay address) have hpow := Nat.pow_le_pow_right (by decide : 1 ≤ 2) (by - simpa [Nat.size_eq_bits_len] using htag) + simpa [Nat.size_eq_bits_len] using! htag) rw [pow_succ] omega exact le_trans hsize (le_trans hsucc (by omega)) @@ -374,11 +374,9 @@ private theorem denseOverlayLookupTime_le_volume {m : ℕ} (TM.binaryPredTime (RegisterStore.read overlay address - 1)) ≤ 90000 * denseLookupVolume inputLength overlay address := by apply max_le - · dsimp only at hvolume hfallback ⊢ - unfold denseLookupVolume at hvolume ⊢ + · unfold denseLookupVolume at hvolume ⊢ omega - · dsimp only at hvolume hpred' ⊢ - unfold denseLookupVolume at hvolume ⊢ + · unfold denseLookupVolume at hvolume ⊢ omega unfold denseOverlayLookupTime TM.branchWorkBlankTime omega @@ -421,8 +419,8 @@ private theorem binaryInstructionArithmeticTime_le_width (hlhs : bitlen lhs ≤ width) (hrhs : bitlen rhs ≤ width) : binaryInstructionArithmeticTime op lhs rhs ≤ 1000 * (width + 1) ^ 2 := by - have hlhsSize : lhs.size ≤ width := by simpa [bitlen] using hlhs - have hrhsSize : rhs.size ≤ width := by simpa [bitlen] using hrhs + have hlhsSize : lhs.size ≤ width := by simpa [bitlen] using! hlhs + have hrhsSize : rhs.size ≤ width := by simpa [bitlen] using! hrhs cases op with | add => have htime := TM.binaryRippleAddTime_le lhs rhs @@ -533,12 +531,12 @@ private theorem denseOverlayLookupStaticTime_le_product {m : ℕ} calc denseOverlayLookupTime tapes inputLength overlay address ≤ 800000 * (volume * (width + 1)) := by - simpa only [volume, Nat.mul_assoc] using hlookup + simpa only [volume, Nat.mul_assoc] using! hlookup _ ≤ 800000 * unit := Nat.mul_le_mul_left 800000 hbase have hreset : TM.resetBinaryWorkTime 1 address.bits.length ≤ 2 * width + 9 := by unfold TM.resetBinaryWorkTime TM.clearWorkTimeBound - simpa [bitlen, Nat.size_eq_bits_len] using + simpa [bitlen, Nat.size_eq_bits_len] using! (show 1 + 2 + 1 + (2 * bitlen address + 5) ≤ 2 * width + 9 by omega) have hwidthUnit : width + 1 ≤ unit := by @@ -587,7 +585,7 @@ private theorem taggedEntryUpdateTime_le_product {m : ℕ} have hlength : overlay.length ≤ volume := le_trans hlengthEncoded hencoded have hcountBits := count_bits_le_encodedStoreLength overlay hcanonical have hcount : bitlen overlay.length ≤ encodedStoreLength overlay := by - simpa [bitlen, Nat.size_eq_bits_len] using hcountBits + simpa [bitlen, Nat.size_eq_bits_len] using! hcountBits have hcountProduct := address_count_width_le_encodedStoreLength overlay hcanonical have htag : bitlen (value + 1) ≤ width + 1 := @@ -620,7 +618,7 @@ private theorem taggedEntryUpdateTime_le_product {m : ℕ} have hsucc := TM.binarySuccTime_le value have hsucc' : TM.binarySuccTime value ≤ 3 * volume * (width + 1) := by - have hsize : value.size ≤ width := by simpa [bitlen] using hvalue + have hsize : value.size ≤ width := by simpa [bitlen] using! hvalue exact le_trans hsucc (by nlinarith) unfold taggedEntryUpdateTime dsimp only [volume] at hupdateVolume hsucc' ⊢ @@ -663,7 +661,7 @@ private theorem denseResourceVolume_le_unit (magnitude inputLength : ℕ) have := Nat.mul_le_mul_left (encodedStoreLength overlay + inputLength + width + 1) (show 1 ≤ width + 1 by omega) - simpa only [Nat.mul_one] using this) + simpa only [Nat.mul_one] using! this) (denseResourceBase_le_unit magnitude inputLength overlay width) private theorem denseResourceWidthSq_le_unit (magnitude inputLength : ℕ) @@ -713,7 +711,7 @@ private theorem denseExecuteInstructionTime_le_product {m : ℕ} have hencoded : encodedStoreLength overlay ≤ unit := by exact le_trans (by omega) hvolume have hencodedBits : (overlay.flatMap Entry.encode).length ≤ unit := by - simpa only [encodedStoreLength] using hencoded + simpa only [encodedStoreLength] using! hencoded have hfixedAdd : ∀ fixedValue, fixedValue ≤ magnitude → TM.binaryAddConstTime fixedValue 0 ≤ 4 * unit := by intro fixedValue hconstant @@ -764,7 +762,7 @@ private theorem denseExecuteInstructionTime_le_product {m : ℕ} denseOverlayLookupTime tapes.data.indirectLoadLookup input.length overlay address ≤ 800000 * ((encodedStoreLength overlay + input.length + width + 1) * - (width + 1)) := by simpa only [Nat.mul_assoc] using hlookup + (width + 1)) := by simpa only [Nat.mul_assoc] using! hlookup _ ≤ 800000 * unit := Nat.mul_le_mul_left 800000 hbase have htaggedUpdate : ∀ address value, bitlen address ≤ width → bitlen value ≤ width → @@ -776,7 +774,7 @@ private theorem denseExecuteInstructionTime_le_product {m : ℕ} calc taggedEntryUpdateTime tapes.data.update overlay address value ≤ 20000 * ((encodedStoreLength overlay + input.length + width + 1) * - (width + 1)) := by simpa only [Nat.mul_assoc] using hupdate + (width + 1)) := by simpa only [Nat.mul_assoc] using! hupdate _ ≤ 20000 * unit := Nat.mul_le_mul_left 20000 hbase have harithmetic : ∀ op lhs rhs, bitlen lhs ≤ width → bitlen rhs ≤ width → @@ -788,7 +786,7 @@ private theorem denseExecuteInstructionTime_le_product {m : ℕ} TM.binaryCopyTime value 0 ≤ 23 * unit := by intro value hvalue have htime := TM.binaryCopyTime_le value 0 - have hsize : value.size ≤ width := by simpa [bitlen] using hvalue + have hsize : value.size ≤ width := by simpa [bitlen] using! hvalue rw [Nat.size_zero] at htime exact le_trans htime (by nlinarith) have hreset : ∀ value, bitlen value ≤ width → @@ -796,7 +794,7 @@ private theorem denseExecuteInstructionTime_le_product {m : ℕ} intro value hvalue unfold TM.resetBinaryWorkTime TM.clearWorkTimeBound have hbits : value.bits.length ≤ width := by - simpa [bitlen, Nat.size_eq_bits_len] using hvalue + simpa [bitlen, Nat.size_eq_bits_len] using! hvalue nlinarith have hpcSize : pcValue.size ≤ magnitude := le_trans (size_le_self pcValue) hpc @@ -807,7 +805,7 @@ private theorem denseExecuteInstructionTime_le_product {m : ℕ} 11 * unit := by unfold TM.resetBinaryWorkTime TM.clearWorkTimeBound have hbits : pcValue.bits.length ≤ magnitude := by - simpa [Nat.size_eq_bits_len] using hpcSize + simpa [Nat.size_eq_bits_len] using! hpcSize nlinarith cases instruction with | imm destination value => @@ -1097,14 +1095,14 @@ private theorem denseProgramInstructionTime_le_product {m : ℕ} exact selectedInstructionResourceMagnitude_le program snapshot.pc have hexecute := denseExecuteInstructionTime_le_product tapes input instruction snapshot.pc snapshot.overlay width magnitude hvalid hstatic hcost hfixed (by - simpa only [magnitude] using hpc) + simpa only [magnitude] using! hpc) have hdispatchRaw := dispatchWithTime_le_selected tapes (fun current => denseExecuteInstructionTime tapes input current snapshot.pc snapshot.overlay) program snapshot.pc have hselectorSquare : (snapshot.pc + 1) ^ 2 ≤ (magnitude + 1) ^ 2 := Nat.pow_le_pow_left (Nat.add_le_add_right (by - simpa only [magnitude] using hpc) 1) 2 + simpa only [magnitude] using! hpc) 1) 2 have hdispatch : denseDispatchProgramTime tapes input snapshot.overlay snapshot.pc program snapshot.pc ≤ 6100000 * unit := by unfold denseDispatchProgramTime @@ -1113,7 +1111,7 @@ private theorem denseProgramInstructionTime_le_product {m : ℕ} nlinarith have hcopyRaw := TM.binaryCopyTime_le snapshot.pc 0 have hpcSize : snapshot.pc.size ≤ magnitude := - le_trans (size_le_self snapshot.pc) (by simpa only [magnitude] using hpc) + le_trans (size_le_self snapshot.pc) (by simpa only [magnitude] using! hpc) have hcopy : TM.binaryCopyTime snapshot.pc 0 ≤ 23 * unit := by rw [Nat.size_zero] at hcopyRaw exact le_trans hcopyRaw (by nlinarith) @@ -1151,18 +1149,18 @@ private theorem bufferedCleanupTime_le_linear {m : ℕ} rw [bufferedCleanupResetBitsAt, (instructionCleanupResetTape_injective tapes).extend_apply] fin_cases slot - · simpa [bufferedCleanupResetBits] using hcleanup 0 - · simpa [bufferedCleanupResetBits] using hcleanup 1 - · simpa [bufferedCleanupResetBits] using hcleanup 2 - · simpa [bufferedCleanupResetBits] using hcleanup 3 - · simpa [bufferedCleanupResetBits] using hcleanup 4 - · simpa [bufferedCleanupResetBits] using hremaining - · simpa [bufferedCleanupResetBits, encodedStoreLength] using hold) + · simpa [bufferedCleanupResetBits] using! hcleanup 0 + · simpa [bufferedCleanupResetBits] using! hcleanup 1 + · simpa [bufferedCleanupResetBits] using! hcleanup 2 + · simpa [bufferedCleanupResetBits] using! hcleanup 3 + · simpa [bufferedCleanupResetBits] using! hcleanup 4 + · simpa [bufferedCleanupResetBits] using! hremaining + · simpa [bufferedCleanupResetBits, encodedStoreLength] using! hold) have htargets : (instructionCleanupResetTargets tapes).length = 7 := by simp [instructionCleanupResetTargets] rw [htargets] at hreset have hnextBits : nextBits.length ≤ bound := by - simpa only [nextBits, encodedStoreLength] using hnext + simpa only [nextBits, encodedStoreLength] using! hnext have hnextLength : nextStore.length ≤ bound := le_trans (store_length_le_encodedStoreLength nextStore) hnext have hresetNext : TM.resetBinaryWorkTime (nextBits.length + 1) @@ -1189,7 +1187,7 @@ private theorem denseInstructionCleanupValue_bits_le ≤ width + 1 := by have hbits (value : ℕ) (hvalue : bitlen value ≤ width + 1) : value.bits.length ≤ width + 1 := by - simpa [bitlen, Nat.size_eq_bits_len] using hvalue + simpa [bitlen, Nat.size_eq_bits_len] using! hvalue cases instruction with | imm destination value => simp only [RegisterStore.Instr.staticWidth] at hstatic @@ -1202,7 +1200,8 @@ private theorem denseInstructionCleanupValue_bits_le · exact hbits destination hdestination · exact hbits (value + 1) htag · simp only [denseInstructionCleanupValue] - split <;> simp + split <;> simp_all [Fin.ext_iff] + split <;> simp [Nat.bits] · simp [denseInstructionCleanupValue] · simp [denseInstructionCleanupValue] | add destination source₀ source₁ => @@ -1225,11 +1224,12 @@ private theorem denseInstructionCleanupValue_bits_le intro slot fin_cases slot · exact hbits destination hdestination - · simpa only [lhs, rhs] using hbits (lhs + rhs + 1) htag + · simpa only [lhs, rhs] using! hbits (lhs + rhs + 1) htag · simp only [denseInstructionCleanupValue] - split <;> simp - · simpa only [lhs] using hbits lhs hlhs - · simpa only [rhs] using hbits rhs hrhs + split <;> simp_all [Fin.ext_iff] + split <;> simp [Nat.bits] + · simpa only [lhs] using! hbits lhs hlhs + · simpa only [rhs] using! hbits rhs hrhs | sub destination source₀ source₁ => simp only [RegisterStore.Instr.staticWidth] at hstatic simp only [Instr.logCost, DenseOverlay.Snapshot.decode, @@ -1245,7 +1245,7 @@ private theorem denseInstructionCleanupValue_bits_le omega have hresult := binaryInstrResult_bitlen_le .sub lhs rhs have hresult' : bitlen (lhs - rhs) ≤ bitlen lhs + bitlen rhs + 1 := by - simpa [BinaryInstrOp.eval] using hresult + simpa [BinaryInstrOp.eval] using! hresult have hresultWidth : bitlen (lhs - rhs) ≤ width := by apply le_trans hresult' dsimp only [lhs, rhs] at hcost ⊢ @@ -1256,9 +1256,10 @@ private theorem denseInstructionCleanupValue_bits_le intro slot fin_cases slot · exact hbits destination hdestination - · simpa only [lhs, rhs] using hbits (lhs - rhs + 1) htag + · simpa only [lhs, rhs] using! hbits (lhs - rhs + 1) htag · simp only [denseInstructionCleanupValue] - split <;> simp + split <;> simp_all [Fin.ext_iff] + split <;> simp [Nat.bits] · exact hbits lhs (by omega) · exact hbits rhs (by omega) | mul destination source₀ source₁ => @@ -1281,11 +1282,12 @@ private theorem denseInstructionCleanupValue_bits_le intro slot fin_cases slot · exact hbits destination hdestination - · simpa only [lhs, rhs] using hbits (lhs * rhs + 1) htag + · simpa only [lhs, rhs] using! hbits (lhs * rhs + 1) htag · simp only [denseInstructionCleanupValue] - split <;> simp - · simpa only [lhs] using hbits lhs hlhs - · simpa only [rhs] using hbits rhs hrhs + split <;> simp_all [Fin.ext_iff] + split <;> simp [Nat.bits] + · simpa only [lhs] using! hbits lhs hlhs + · simpa only [rhs] using! hbits rhs hrhs | load destination addressRegister => simp only [RegisterStore.Instr.staticWidth] at hstatic simp only [Instr.logCost, DenseOverlay.Snapshot.decode, @@ -1303,10 +1305,11 @@ private theorem denseInstructionCleanupValue_bits_le intro slot fin_cases slot · exact hbits destination hdestination - · simpa only [address, value] using hbits (value + 1) htag + · simpa only [address, value] using! hbits (value + 1) htag · simp only [denseInstructionCleanupValue] - split <;> simp - · simpa only [address] using hbits address haddress + split <;> simp_all [Fin.ext_iff] + split <;> simp [Nat.bits] + · simpa only [address] using! hbits address haddress · simp [denseInstructionCleanupValue] | store addressRegister source => simp only [RegisterStore.Instr.staticWidth] at hstatic @@ -1324,12 +1327,13 @@ private theorem denseInstructionCleanupValue_bits_le le_trans (bitlen_succ_le value) (by omega) intro slot fin_cases slot - · simpa only [address] using hbits address haddress - · simpa only [value] using hbits (value + 1) htag + · simpa only [address] using! hbits address haddress + · simpa only [value] using! hbits (value + 1) htag · simp only [denseInstructionCleanupValue] - split <;> simp - · simpa only [address] using hbits address haddress - · simpa only [value] using hbits value (by omega) + split <;> simp_all [Fin.ext_iff] + split <;> simp [Nat.bits] + · simpa only [address] using! hbits address haddress + · simpa only [value] using! hbits value (by omega) | jz source target => intro slot fin_cases slot <;> simp [denseInstructionCleanupValue] @@ -1371,7 +1375,7 @@ theorem denseProgramStepTime_le_envelope_internal {m : ℕ} have hinstruction : instructionTime ≤ 7000000 * unit := by have htime := denseProgramInstructionTime_le_product tapes program input snapshot hvalid hpc - simpa only [instructionTime, unit, width, magnitude] using htime + simpa only [instructionTime, unit, width, magnitude] using! htime have hstatic : RegisterStore.Instr.staticWidth instruction ≤ width := by exact le_trans (selectedInstructionStaticWidth_le program snapshot.pc) (by unfold width denseStepWidth @@ -1484,7 +1488,7 @@ private theorem denseSnapshot_step_pc_le_resourceMagnitude List.getElem?_eq_none (by omega) unfold DenseOverlay.Snapshot.step DenseOverlay.Snapshot.curInstr rw [houtOfRange] - simpa [DenseOverlay.Snapshot.stepInstr] using hpc + simpa [DenseOverlay.Snapshot.stepInstr] using! hpc private theorem denseStepVolume_le_runScale_succ (program : Program) (input : List Bool) (fuel : ℕ) @@ -1566,16 +1570,16 @@ private theorem denseDispatchHaltTime_le_width {m : ℕ} omega | cons instruction rest ih => have hselectorPred : (selector - 1).bits.length ≤ bound := by - simpa only [Nat.size_eq_bits_len] using + simpa only [Nat.size_eq_bits_len] using! (le_trans (Nat.size_le_size (Nat.sub_le selector 1)) (by - simpa [Nat.size_eq_bits_len] using hselector)) + simpa [Nat.size_eq_bits_len] using! hselector)) have htail := ih (selector - 1) hselectorPred have hpred := TM.binaryPredTime_le (selector - 1) have hpredSize : (selector - 1 + 1).size ≤ bound + 1 := by have hvalue : selector - 1 + 1 ≤ selector + 1 := by omega have hsize := Nat.size_le_size hvalue have hselectorSize : selector.size ≤ bound := by - simpa [Nat.size_eq_bits_len] using hselector + simpa [Nat.size_eq_bits_len] using! hselector have hsucc : (selector + 1).size ≤ bound + 1 := by rw [Nat.size_le] have hlt := Nat.lt_size_self selector @@ -1604,7 +1608,7 @@ private theorem denseProgramHaltTime_le_magnitude {m : ℕ} have hpcSize : pcValue.size ≤ magnitude := le_trans (size_le_self pcValue) hpc have hpcBits : pcValue.bits.length ≤ magnitude := by - simpa only [Nat.size_eq_bits_len] using hpcSize + simpa only [Nat.size_eq_bits_len] using! hpcSize have hdispatch := denseDispatchHaltTime_le_width tapes program pcValue magnitude hmagnitude hpcBits have hcopyRaw := TM.binaryCopyTime_le pcValue 0 @@ -1699,10 +1703,10 @@ theorem denseProgramLoopTime_le_envelope_internal {m : ℕ} have hiteration' : denseProgramLoopIterationTime tapes program input snapshot ≤ fixed * volume * (width + 1) := by - simpa only [fixed, volume, width] using hiteration + simpa only [fixed, volume, width] using! hiteration have htail' : denseProgramLoopTime tapes program input fuel next ≤ fixed * nextScale ^ 2 := by - simpa only [denseProgramLoopEnvelope, fixed, nextScale] using htail + simpa only [denseProgramLoopEnvelope, fixed, nextScale] using! htail rw [denseProgramLoopTime] unfold denseProgramLoopEnvelope dsimp only [next, fixed, currentScale] at hiteration' htail' ⊢ @@ -1761,7 +1765,7 @@ private theorem denseEntriesEncode_length_le (store : Store) (bound : ℕ) have htail := ih hrest have hhead : (Entry.encode entry).length ≤ 4 * bound + 2 := by rw [Entry.encode_length] - simpa [bitlen, Nat.size_eq_bits_len] using + simpa [bitlen, Nat.size_eq_bits_len] using! (show 2 * entry.1.bits.length + 2 * entry.2.bits.length + 2 ≤ 4 * bound + 2 by omega) simp only [List.flatMap_cons, List.length_append, List.length_cons] @@ -1777,7 +1781,7 @@ private theorem denseInitialCleanupBits_le {m : ℕ} split · exact hlength · split - · simpa using hbound + · simpa using! hbound · simp private theorem denseInitialAbiInstallTime_le {m : ℕ} @@ -1839,7 +1843,7 @@ private theorem denseProgramInitTime_le_quadratic {m : ℕ} have hloop := denseInitialLengthLoopTime_le 1 input (input.length + 1) (by omega) have htagBits : (input.length + 1).bits.length ≤ bound := by - simpa only [Nat.size_eq_bits_len] using + simpa only [Nat.size_eq_bits_len] using! (le_trans (size_le_self (input.length + 1)) (by dsimp only [bound] omega)) @@ -1860,7 +1864,7 @@ private theorem denseProgramInitTime_le_quadratic {m : ℕ} hstoreLength hentries htagBits have hsuccZero := TM.binarySuccTime_le 0 have hsuccZero' : TM.binarySuccTime 0 ≤ 2 := by - simpa using hsuccZero + simpa using! hsuccZero unfold denseProgramInitTime dsimp only [bound] at hrewind habi htagBits hbound ⊢ nlinarith @@ -1891,7 +1895,7 @@ private theorem denseRunScale_initial_succ_le let cost := RAM.logTimeUpto program fuel (RAM.initCfg input) let magnitude := programResourceMagnitude program have hdecode : initial.decode input = RAM.initCfg input := by - simpa only [initial] using DenseOverlay.Snapshot.initial_decode input + simpa only [initial] using! DenseOverlay.Snapshot.initial_decode input have hhaltedInitial : RAM.Halted program (RAM.run program fuel (initial.decode input)) := by rw [hdecode] @@ -1903,21 +1907,21 @@ private theorem denseRunScale_initial_succ_le calc RAM.logTimeUpto program (fuel + 1) (initial.decode input) = RAM.logTimeUpto program fuel (initial.decode input) := by - simpa only [Nat.succ_eq_add_one] using hsame + simpa only [Nat.succ_eq_add_one] using! hsame _ = cost := by rw [hdecode] have hunit := RAM.unitTimeUpto_le_logTimeUpto program (fuel + 1) (initial.decode input) rw [hcostSucc] at hunit have hstatic := programStaticWidth_le_resourceMagnitude program have hmagnitude : 1 ≤ magnitude := by - simpa only [magnitude] using programResourceMagnitude_pos program + simpa only [magnitude] using! programResourceMagnitude_pos program have hencodedRaw := DenseOverlay.Snapshot.initial_encodedStoreLength_run_le program input 0 have hencoded : encodedStoreLength initial.overlay ≤ 2 * bitlen (input.length + 1) + 2 := by simpa only [initial, DenseOverlay.Snapshot.run, RAM.unitTimeUpto_zero, RAM.logTimeUpto_zero, Nat.zero_mul, - Nat.zero_add, Nat.mul_zero, Nat.add_zero] using hencodedRaw + Nat.zero_add, Nat.mul_zero, Nat.add_zero] using! hencodedRaw have hbitlen : bitlen (input.length + 1) ≤ input.length + 1 := size_le_self (input.length + 1) have htime : fuel + 1 + @@ -1976,12 +1980,12 @@ theorem denseProgramDecisionTime_le_envelope_internal {m : ℕ} let scale := input.length + cost + 1 let fixed := (magnitude + 1) ^ 4 * scale ^ 2 have hmagnitude : 1 ≤ magnitude := by - simpa only [magnitude] using programResourceMagnitude_pos program + simpa only [magnitude] using! programResourceMagnitude_pos program have hscale : 1 ≤ scale := by dsimp only [scale] omega have hinitialValid : DenseOverlay.Valid initial.overlay := by - simpa only [initial] using DenseOverlay.Snapshot.initial_valid input + simpa only [initial] using! DenseOverlay.Snapshot.initial_valid input have hinitialPc : initial.pc ≤ magnitude := by dsimp only [initial, DenseOverlay.Snapshot.initial, magnitude] omega diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseInitProof.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseInitProof.lean index f487e27d78..15f4d52618 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseInitProof.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseInitProof.lean @@ -188,10 +188,10 @@ theorem denseInitialLengthLoopTM_hoareTime_internal (by rw [houtput] have hblankNat : TM.resetBinaryBlank.HasBinaryNat 0 := by - simpa [TM.resetBinaryBlank] using Tape.init_move_right_hasBinaryNat 0 + simpa [TM.resetBinaryBlank] using! Tape.init_move_right_hasBinaryNat 0 exact (parked_of_binaryNat hblankNat).read_ne_start) refine ⟨done, 1, by simp [denseInitialLengthLoopTime], - .step (by simpa [done] using hstep) .zero, ?_, ?_⟩ + .step (by simpa [done] using! hstep) .zero, ?_, ?_⟩ · rfl · exact ⟨hinput, rfl, by simpa, rfl⟩ | cons bit rest ih => @@ -214,7 +214,7 @@ theorem denseInitialLengthLoopTM_hoareTime_internal have houtputParked : TM.Parked out₀ := by rw [houtput] have hblankNat : TM.resetBinaryBlank.HasBinaryNat 0 := by - simpa [TM.resetBinaryBlank] using Tape.init_move_right_hasBinaryNat 0 + simpa [TM.resetBinaryBlank] using! Tape.init_move_right_hasBinaryNat 0 exact parked_of_binaryNat hblankNat have hreadNonblank : inp₀.read ≠ Γ.blank := by rw [hinput.read_cons] @@ -228,7 +228,7 @@ theorem denseInitialLengthLoopTM_hoareTime_internal houtputParked.read_ne_start have hscanReach : (denseInitialLengthLoopTM tapes).reachesIn 1 scan (denseInitialLengthWrap tapes bodyStart) := - .step (by simpa [scan, bodyStart, denseInitialLengthWrap] using + .step (by simpa [scan, bodyStart, denseInitialLengthWrap] using! hscanStep) .zero have hbody := initialZeroBitTM_hoareTime_internal tapes address count entries inp₀ work₀ out₀ hready hinputParked houtputParked @@ -248,7 +248,7 @@ theorem denseInitialLengthLoopTM_hoareTime_internal (by rw [hbodyOutput]; exact houtputParked.read_ne_start) have hseamReach : (denseInitialLengthLoopTM tapes).reachesIn 1 (denseInitialLengthWrap tapes bodyDone) nextScan := - .step (by simpa [nextScan] using hseamStep) .zero + .step (by simpa [nextScan] using! hseamStep) .zero have hnextInput : (bodyDone.input.move Dir3.right).HasBinarySuffix rest := by rw [hbodyInput] @@ -268,12 +268,12 @@ theorem denseInitialLengthLoopTM_hoareTime_internal htailHalt, ?_⟩ · simp only [denseInitialLengthLoopTime] omega - · simpa [Nat.add_assoc] using hreach + · simpa [Nat.add_assoc] using! hreach · refine ⟨htailInput, ?_, ?_, htailOutput.trans hbodyOutput⟩ · rw [htailHead, hbodyInput] simp only [Tape.move, List.length_cons] omega - · simpa [Nat.add_assoc, Nat.add_comm, Nat.add_left_comm] using htailReady + · simpa [Nat.add_assoc, Nat.add_comm, Nat.add_left_comm] using! htailReady private theorem denseProgramInitialStore_eq (input : List Bool) : denseProgramInitialStore input = [(0, input.length + 1)] := by @@ -312,7 +312,7 @@ theorem denseProgramInitTM_hoareTime_internal have hsetupOutputParked : TM.Parked setupDone.output := by rw [hsetupOutput] have hblankNat : TM.resetBinaryBlank.HasBinaryNat 0 := by - simpa [TM.resetBinaryBlank] using Tape.init_move_right_hasBinaryNat 0 + simpa [TM.resetBinaryBlank] using! Tape.init_move_right_hasBinaryNat 0 exact parked_of_binaryNat hblankNat have hloop := denseInitialLengthLoopTM_hoareTime_internal tapes input 1 0 [] setupDone.input setupDone.work setupDone.output hsetupInput @@ -322,7 +322,7 @@ theorem denseProgramInitTM_hoareTime_internal hloop _ _ _ ⟨rfl, rfl, rfl⟩ have hloopReady : InitialLoopReady tapes (input.length + 1) 0 [] loopDone.work := by - simpa [Nat.add_comm] using hloopReadyRaw + simpa [Nat.add_comm] using! hloopReadyRaw have hloopBufferStart : (loopDone.work tapes.buffer).cells 0 = Γ.start := TM.work_cells_zero_eq_start_of_reachesIn tapes.buffer hloopReach @@ -334,7 +334,7 @@ theorem denseProgramInitTM_hoareTime_internal have hloopOutputParked : TM.Parked loopDone.output := by rw [hloopOutputBlank] have hblankNat : TM.resetBinaryBlank.HasBinaryNat 0 := by - simpa [TM.resetBinaryBlank] using Tape.init_move_right_hasBinaryNat 0 + simpa [TM.resetBinaryBlank] using! Tape.init_move_right_hasBinaryNat 0 exact parked_of_binaryNat hblankNat have hemit := initialLengthEmitTM_hoareTime_internal tapes (input.length + 1) 0 [] loopDone.input loopDone.work loopDone.output @@ -350,7 +350,7 @@ theorem denseProgramInitTM_hoareTime_internal (denseProgramInitialStore input).length (denseProgramInitialStore input) emitDone.work := by rw [denseProgramInitialStore_eq] - simpa using hemitReadyRaw + simpa using! hemitReadyRaw have hemitInputParked : TM.Parked emitDone.input := by rw [hemitInput] exact hloopInputParked @@ -359,7 +359,7 @@ theorem denseProgramInitTM_hoareTime_internal have hemitOutputParked : TM.Parked emitDone.output := by rw [hemitOutputBlank] have hblankNat : TM.resetBinaryBlank.HasBinaryNat 0 := by - simpa [TM.resetBinaryBlank] using Tape.init_move_right_hasBinaryNat 0 + simpa [TM.resetBinaryBlank] using! Tape.init_move_right_hasBinaryNat 0 exact parked_of_binaryNat hblankNat have habi := initialAbiInstallTM_hoareTime_internal tapes (denseProgramInitialStore input) (input.length + 1) emitDone.input @@ -380,7 +380,7 @@ theorem denseProgramInitTM_hoareTime_internal let sparseInitial : Snapshot := { pc := 0, store := denseProgramInitialStore input } have hsparseCanonical : Canonical sparseInitial.store := by - simpa [sparseInitial, denseProgramInitialStore] using + simpa [sparseInitial, denseProgramInitialStore] using! DenseOverlay.Snapshot.initial_canonical input have habiReady : InstructionExecutionReady tapes sparseInitial.store 0 (programSnapshotWork tapes sparseInitial) := @@ -423,7 +423,7 @@ theorem denseProgramInitTM_hoareTime_internal habiWork rw [hworkEq] exact ⟨hiParked.read_ne_start, hiParked.1⟩ - · simpa [denseProgramSnapshotWork, sparseInitial] using habiWork + · simpa [denseProgramSnapshotWork, sparseInitial] using! habiWork · exact habiOutput.trans hemitOutputBlank obtain ⟨rewindDone, rewindTime, hrewindTime, hrewindReach, hrewindHalt, hrewindHead, hrewindCells, hrewindWork, @@ -450,7 +450,7 @@ theorem denseProgramInitTM_hoareTime_internal output := TM.transitionTape abiDone.output } rewindDone := by simpa only [habiInputTransition, habiWorkTransition, - habiOutputTransition] using hrewindReach + habiOutputTransition] using! hrewindReach have habiRewindReach := TM.seqTM_reachesIn_of_reachesIn (initialAbiInstallTM tapes) TM.rewindInputTM habiReach habiHalt hrewindReach' @@ -477,7 +477,7 @@ theorem denseProgramInitTM_hoareTime_internal output := TM.transitionTape emitDone.output } abiRewindDone := by simpa only [hemitInputTransition, hemitWorkTransition, - hemitOutputTransition] using habiRewindReach + hemitOutputTransition] using! habiRewindReach have emitTailReach := TM.seqTM_reachesIn_of_reachesIn (initialLengthEmitTM tapes) (TM.seqTM (initialAbiInstallTM tapes) TM.rewindInputTM) @@ -489,8 +489,10 @@ theorem denseProgramInitTM_hoareTime_internal (TM.seqTM (initialLengthEmitTM tapes) (TM.seqTM (initialAbiInstallTM tapes) TM.rewindInputTM)).halted emitTailDone := by - rw [TM.phase2Wrap_halted_iff] - exact habiRewindHalt + exact (TM.phase2Wrap_halted_iff + (initialLengthEmitTM tapes) + (TM.seqTM (initialAbiInstallTM tapes) TM.rewindInputTM) abiRewindDone).mpr + habiRewindHalt obtain ⟨hloopInputTransition, hloopWorkTransition, hloopOutputTransition⟩ := TM.phaseTransition_eq_self_of_reads_ne_start @@ -510,7 +512,7 @@ theorem denseProgramInitTM_hoareTime_internal output := TM.transitionTape loopDone.output } emitTailDone := by simpa only [hloopInputTransition, hloopWorkTransition, - hloopOutputTransition] using emitTailReach + hloopOutputTransition] using! emitTailReach have loopTailReach := TM.seqTM_reachesIn_of_reachesIn (denseInitialLengthLoopTM tapes) (TM.seqTM (initialLengthEmitTM tapes) @@ -525,8 +527,11 @@ theorem denseProgramInitTM_hoareTime_internal (TM.seqTM (initialLengthEmitTM tapes) (TM.seqTM (initialAbiInstallTM tapes) TM.rewindInputTM))).halted loopTailDone := by - rw [TM.phase2Wrap_halted_iff] - exact emitTailHalt + exact (TM.phase2Wrap_halted_iff + (denseInitialLengthLoopTM tapes) + (TM.seqTM (initialLengthEmitTM tapes) + (TM.seqTM (initialAbiInstallTM tapes) TM.rewindInputTM)) emitTailDone).mpr + emitTailHalt obtain ⟨hsetupInputTransition, hsetupWorkTransition, hsetupOutputTransition⟩ := TM.phaseTransition_eq_self_of_reads_ne_start @@ -549,7 +554,7 @@ theorem denseProgramInitTM_hoareTime_internal output := TM.transitionTape setupDone.output } loopTailDone := by simpa only [hsetupInputTransition, hsetupWorkTransition, - hsetupOutputTransition] using loopTailReach + hsetupOutputTransition] using! loopTailReach have hreach := TM.seqTM_reachesIn_of_reachesIn (initialSetupTM tapes) (TM.seqTM (denseInitialLengthLoopTM tapes) @@ -569,13 +574,17 @@ theorem denseProgramInitTM_hoareTime_internal omega · change (denseProgramInitTM tapes).halted finalCfg unfold denseProgramInitTM - rw [TM.phase2Wrap_halted_iff] - exact loopTailHalt + exact (TM.phase2Wrap_halted_iff + (initialSetupTM tapes) + (TM.seqTM (denseInitialLengthLoopTM tapes) + (TM.seqTM (initialLengthEmitTM tapes) + (TM.seqTM (initialAbiInstallTM tapes) TM.rewindInputTM))) loopTailDone).mpr + loopTailHalt · refine ⟨?_, hrewindWork, hrewindOutput⟩ change rewindDone.input = (Tape.init (input.map Γ.ofBool)).move Dir3.right - exact Tape.ext (by simpa [Tape.move] using hrewindHead) - (by simpa [Tape.move] using hrewindCells) + exact Tape.ext (by simpa [Tape.move] using! hrewindHead) + (by simpa [Tape.move] using! hrewindCells) end Machine end RegisterStore diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseInternal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseInternal.lean index 6d66a63d2d..e42fcabf3e 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseInternal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseInternal.lean @@ -28,7 +28,7 @@ variable {n : ℕ} private theorem denseInput_parked (input : List Bool) : TM.Parked ((Tape.init (input.map Γ.ofBool)).move Dir3.right) := by refine ⟨by simp [Tape.move], ?_⟩ - simpa using Tape.init_ofBool_move_right_cells_ne_start input + simpa using! Tape.init_ofBool_move_right_cells_ne_start input private theorem blankOutput_parked : TM.Parked ((Tape.init []).move Dir3.right) := by @@ -66,7 +66,7 @@ theorem denseProgramOutputTM_hoareTime_internal let inp₀ := (Tape.init (input.map Γ.ofBool)).move Dir3.right let blank := (Tape.init []).move Dir3.right have hinput : TM.Parked inp₀ := by - simpa only [inp₀] using denseInput_parked input + simpa only [inp₀] using! denseInput_parked input have hlookup := denseOverlayLookupStaticTM_hoareTime_frame tapes.lifted.data.lhsLookup input overlay 0 initialWork blank hvalid hready.control.lookup blankOutput_parked @@ -86,7 +86,7 @@ theorem denseProgramOutputTM_hoareTime_internal hresult.destination hinput hresult.parked obtain ⟨final, time, htime, hreach, hhalt, hfinalInput, _hfinalWork, hfinalOutput⟩ := - hleaf inp work out ⟨hinp, rfl, by simpa only [blank] using hout⟩ + hleaf inp work out ⟨hinp, rfl, by simpa only [blank] using! hout⟩ exact ⟨final, time, htime, hreach, hhalt, hfinalInput, hfinalOutput⟩ have hseq := TM.seqTM_hoareTime (denseOverlayLookupStaticTM tapes.lifted.data.lhsLookup 0) @@ -95,13 +95,13 @@ theorem denseProgramOutputTM_hoareTime_internal rintro inp work out ⟨hinp, hresult, hout⟩ obtain ⟨hi, hw, ho⟩ := phaseTransition_of_parked (inp := inp) (work := work) (out := out) - (by simpa [hinp] using hinput) hresult.parked - (by simpa [hout, blank] using blankOutput_parked) + (by simpa [hinp] using! hinput) hresult.parked + (by simpa [hout, blank] using! blankOutput_parked) rw [hi, hw, ho] - exact ⟨hinp, hresult, by simpa only [blank] using hout⟩) + exact ⟨hinp, hresult, by simpa only [blank] using! hout⟩) hverdict simpa only [denseProgramOutputTM, denseProgramOutputTime, mid, inp₀, - blank] using hseq + blank] using! hseq /-- Final dense lookup overwrites the loop's halt-test bit with the decoded RAM verdict. -/ @@ -122,7 +122,7 @@ theorem denseProgramOutputTM_hoareTime_haltOutput_internal let inp₀ := (Tape.init (input.map Γ.ofBool)).move Dir3.right let haltOut := instructionHaltOutput .halt have hinput : TM.Parked inp₀ := by - simpa only [inp₀] using denseInput_parked input + simpa only [inp₀] using! denseInput_parked input have hhaltOutParked : TM.Parked haltOut := by refine ⟨?_, ?_⟩ · simp [haltOut, instructionHaltOutput, instructionHaltVerdict, @@ -149,7 +149,7 @@ theorem denseProgramOutputTM_hoareTime_haltOutput_internal hresult.destination hinput hresult.parked obtain ⟨final, time, htime, hreach, hhalt, hfinalInput, _hfinalWork, hfinalOutput⟩ := - hleaf inp work out ⟨hinp, rfl, by simpa only [haltOut] using hout⟩ + hleaf inp work out ⟨hinp, rfl, by simpa only [haltOut] using! hout⟩ exact ⟨final, time, htime, hreach, hhalt, hfinalInput, hfinalOutput⟩ have hseq := TM.seqTM_hoareTime (denseOverlayLookupStaticTM tapes.lifted.data.lhsLookup 0) @@ -158,13 +158,13 @@ theorem denseProgramOutputTM_hoareTime_haltOutput_internal rintro inp work out ⟨hinp, hresult, hout⟩ obtain ⟨hi, hw, ho⟩ := phaseTransition_of_parked (inp := inp) (work := work) (out := out) - (by simpa [hinp] using hinput) hresult.parked - (by simpa [hout, haltOut] using hhaltOutParked) + (by simpa [hinp] using! hinput) hresult.parked + (by simpa [hout, haltOut] using! hhaltOutParked) rw [hi, hw, ho] - exact ⟨hinp, hresult, by simpa only [haltOut] using hout⟩) + exact ⟨hinp, hresult, by simpa only [haltOut] using! hout⟩) hverdict simpa only [denseProgramOutputTM, denseProgramOutputTime, mid, inp₀, - haltOut] using hseq + haltOut] using! hseq /-- One dense loop iteration realizes one overlay step and either halts on the successor's selected instruction or returns to the body start. -/ @@ -205,7 +205,7 @@ theorem denseProgramLoopTM_iteration_internal let inp₀ := (Tape.init (input.map Γ.ofBool)).move Dir3.right let blank := (Tape.init []).move Dir3.right have hinput : TM.Parked inp₀ := by - simpa only [inp₀] using denseInput_parked input + simpa only [inp₀] using! denseInput_parked input have hbody := denseProgramStepTM_hoareTime_frame tapes program input snapshot.overlay snapshot.pc initialWork hvalid hready obtain ⟨cbody, bodyTime, hbodyTime, hbodyReach, hbodyHalt, @@ -215,14 +215,14 @@ theorem denseProgramLoopTM_iteration_internal cbody.work := by simpa [next, DenseOverlay.Snapshot.step, DenseOverlay.Snapshot.curInstr, denseInstructionStore, - denseInstructionPC, selectedInstruction_eq_getElem?_getD] using + denseInstructionPC, selectedInstruction_eq_getElem?_getD] using! hnextReadyRaw have hbodyInputParked : TM.Parked cbody.input := by - simpa [hbodyInput] using hinput + simpa [hbodyInput] using! hinput have hbodyWorkParked : ∀ i, TM.Parked (cbody.work i) := hnextReady.control.lookup.scanner.parked have hbodyOutputParked : TM.Parked cbody.output := by - simpa [hbodyOutput, blank] using blankOutput_parked + simpa [hbodyOutput, blank] using! blankOutput_parked have hbodyLoop := TM.loopTM_body_simulation body test hbodyReach have hbodyTransition : (⟨test.qstart, TM.transitionInput cbody.input, @@ -250,11 +250,11 @@ theorem denseProgramLoopTM_iteration_internal selectedInstruction_eq_getElem?_getD program next.pc have htestOutput' : ctest.output = instructionHaltOutput (next.curInstr program) := by - simpa only [hselected] using htestOutput + simpa only [hselected] using! htestOutput have htestInputParked : TM.Parked ctest.input := by - simpa [htestInput] using hinput + simpa [htestInput] using! hinput have htestWorkParked : ∀ i, TM.Parked (ctest.work i) := by - simpa [htestWork] using hbodyWorkParked + simpa [htestWork] using! hbodyWorkParked have htestOutputParked : TM.Parked ctest.output := by refine ⟨?_, ?_⟩ · rw [htestOutput', instructionHaltOutput_head] @@ -311,41 +311,45 @@ theorem denseProgramLoopTM_iteration_internal exact instructionHaltOutput_cell_one_eq_one_iff _ |>.2 hhalted have htailDone : ctail.state = Sum.inr (Sum.inl TM.LoopPhase.done) := by - simpa [hone] using htailState + simpa [hone] using! htailState have hcTail : ctail = { state := Sum.inr (Sum.inl TM.LoopPhase.done) input := inp₀ work := cbody.work output := instructionHaltOutput (next.curInstr program) } := by cases ctail - simp only [Complexity.Cfg.mk.injEq] - exact ⟨htailDone, htailInput, htailWork, - htailOutput.trans htestOutput'⟩ - simpa only [denseProgramLoopTM, body, test, inp₀, blank, hcTail] using + apply Complexity.Cfg.ext + · exact htailDone + · exact htailInput + · exact htailWork + · exact htailOutput.trans htestOutput' + simpa only [denseProgramLoopTM, body, test, inp₀, blank, hcTail] using! hreach · right refine ⟨hhalted, ?_⟩ have hcur : next.curInstr program ≠ .halt := hhalted have hblankOutput : ctest.output = blank := by rw [htestOutput'] - simpa only [blank] using + simpa only [blank] using! instructionHaltOutput_eq_blank_of_ne_halt hcur have hone : ctest.output.cells 1 ≠ Γ.one := by rw [htestOutput'] exact fun h => hhalted (instructionHaltOutput_cell_one_eq_one_iff _ |>.1 h) have htailStart : ctail.state = Sum.inl body.qstart := by - simpa [hone] using htailState + simpa [hone] using! htailState have hcTail : ctail = { state := Sum.inl body.qstart input := inp₀ work := cbody.work output := blank } := by cases ctail - simp only [Complexity.Cfg.mk.injEq] - exact ⟨htailStart, htailInput, htailWork, - htailOutput.trans hblankOutput⟩ - simpa only [denseProgramLoopTM, body, test, inp₀, blank, hcTail] using + apply Complexity.Cfg.ext + · exact htailStart + · exact htailInput + · exact htailWork + · exact htailOutput.trans hblankOutput + simpa only [denseProgramLoopTM, body, test, inp₀, blank, hcTail] using! hreach /-- A halted dense snapshot is stationary under one selected step. -/ @@ -399,7 +403,7 @@ theorem denseProgramLoopTM_hoareTime_run_internal subst work subst out have hsnapshotHalted : snapshot.Halted program := by - simpa [DenseOverlay.Snapshot.run] using hhalted + simpa [DenseOverlay.Snapshot.run] using! hhalted have hstepSelf := denseSnapshot_step_eq_self_of_halted_internal program input snapshot hsnapshotHalted obtain ⟨nextWork, time, htime, hnextReady, hbranch⟩ := @@ -409,7 +413,7 @@ theorem denseProgramLoopTM_hoareTime_run_internal ⟨hnextRunning, _⟩ · have hready' : InstructionExecutionReady tapes snapshot.overlay snapshot.pc nextWork := by - simpa only [hstepSelf] using hnextReady + simpa only [hstepSelf] using! hnextReady have hreach' : (denseProgramLoopTM tapes program).reachesIn time { state := (denseProgramLoopTM tapes program).qstart input := (Tape.init (input.map Γ.ofBool)).move Dir3.right @@ -420,12 +424,12 @@ theorem denseProgramLoopTM_hoareTime_run_internal work := nextWork output := instructionHaltOutput (snapshot.curInstr program) } := by - simpa only [hstepSelf] using hreach + simpa only [hstepSelf] using! hreach refine ⟨_, time, ?_, hreach', rfl, rfl, ?_, ?_⟩ - · simpa [denseProgramLoopTime] using htime - · simpa [DenseOverlay.Snapshot.run] using hready' + · simpa [denseProgramLoopTime] using! htime + · simpa [DenseOverlay.Snapshot.run] using! hready' · simp [DenseOverlay.Snapshot.run] - · exact (hnextRunning (by simpa only [hstepSelf] using + · exact (hnextRunning (by simpa only [hstepSelf] using! hsnapshotHalted)).elim | succ fuel ih => intro snapshot initialWork hvalid hready hhalted @@ -445,7 +449,7 @@ theorem denseProgramLoopTM_hoareTime_run_internal hsnapshotHalted _ have hready' : InstructionExecutionReady tapes snapshot.overlay snapshot.pc nextWork := by - simpa only [hstepSelf] using hnextReady + simpa only [hstepSelf] using! hnextReady have hreach' : (denseProgramLoopTM tapes program).reachesIn time { state := (denseProgramLoopTM tapes program).qstart input := (Tape.init (input.map Γ.ofBool)).move Dir3.right @@ -456,18 +460,18 @@ theorem denseProgramLoopTM_hoareTime_run_internal work := nextWork output := instructionHaltOutput (snapshot.curInstr program) } := by - simpa only [hstepSelf] using hreach + simpa only [hstepSelf] using! hreach refine ⟨_, time, ?_, hreach', rfl, rfl, ?_, ?_⟩ · simp only [denseProgramLoopTime] omega - · simpa only [hfinal] using hready' + · simpa only [hfinal] using! hready' · simp only [hfinal] - · exact (hnextRunning (by simpa only [hstepSelf] using + · exact (hnextRunning (by simpa only [hstepSelf] using! hsnapshotHalted)).elim · have hrunHalted : ((snapshot.step program input).run program input fuel).Halted program := by - simpa [DenseOverlay.Snapshot.run, hsnapshotHalted] using hhalted + simpa [DenseOverlay.Snapshot.run, hsnapshotHalted] using! hhalted have hiter := denseProgramLoopTM_iteration_internal tapes program input snapshot initialWork hvalid hready obtain ⟨nextWork, time₁, htime₁, hnextReady, hbranch⟩ := hiter @@ -486,7 +490,7 @@ theorem denseProgramLoopTM_hoareTime_run_internal · simp only [denseProgramLoopTime] omega · simpa [DenseOverlay.Snapshot.run, hsnapshotHalted, hfinal] - using hnextReady + using! hnextReady · simp [DenseOverlay.Snapshot.run, hsnapshotHalted, hfinal] · have hnextValid := DenseOverlay.Snapshot.step_valid program input snapshot hvalid @@ -509,9 +513,9 @@ theorem denseProgramLoopTM_hoareTime_run_internal denseProgramLoopTime tapes program input (fuel + 1) (snapshot.step program input) exact Nat.add_le_add htime₁ htime₂ - · simpa [DenseOverlay.Snapshot.run, hsnapshotHalted] using + · simpa [DenseOverlay.Snapshot.run, hsnapshotHalted] using! hfinalReady - · simpa [DenseOverlay.Snapshot.run, hsnapshotHalted] using + · simpa [DenseOverlay.Snapshot.run, hsnapshotHalted] using! hfinalOutput end Machine From 33f57fab1d3bd464e1ac4a74b8cc8e478cb1d932 Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Tue, 22 Sep 2026 03:20:38 +0000 Subject: [PATCH 19/49] Port machine computations and certificate bounds to current Lean --- .../BeyondBethe/CertificateMagnitude.lean | 2 +- .../BeyondBethe/MachineBetheAffineEntry.lean | 32 ++--- .../MachineBetheAffineLineSum.lean | 66 +++++------ .../MachineBetheEpigraphOracle.lean | 76 ++++++------ .../MachineBetheFeasibilityFit.lean | 8 +- .../MachineBetheFeasibilityLoop.lean | 56 ++++----- .../MachineBetheFeasibilitySemantics.lean | 2 +- .../MachineBetheFloorCutEntry.lean | 26 ++--- .../MachineBetheFloorCutVector.lean | 16 +-- .../BeyondBethe/MachineBetheFloorScan.lean | 52 ++++----- .../BeyondBethe/MachineBetheFloorTest.lean | 6 +- .../BeyondBethe/MachineBetheHeightCap.lean | 10 +- .../BeyondBethe/MachineBetheHeightNormal.lean | 6 +- .../MachineBinaryAddSemantics.lean | 4 +- .../BeyondBethe/MachineBinaryCompare.lean | 10 +- .../BeyondBethe/MachineBinaryDivision.lean | 44 +++---- .../BeyondBethe/MachineBinaryGCD.lean | 16 +-- .../BeyondBethe/MachineBinaryListInit.lean | 6 +- .../BeyondBethe/MachineBinaryListSnoc.lean | 4 +- .../BeyondBethe/MachineBinarySub.lean | 14 +-- .../BeyondBethe/MachineBitAssembly.lean | 10 +- .../BeyondBethe/MachineBooleanInit.lean | 14 +-- .../BeyondBethe/MachineBooleanMemory.lean | 8 +- .../BeyondBethe/MachineBoundedUnary.lean | 8 +- .../MachineCertificateAssembly.lean | 14 +-- .../MachineCertificateExpGuard.lean | 22 ++-- .../MachineCertificatePotentials.lean | 10 +- .../BeyondBethe/MachineCertificateScales.lean | 12 +- .../MachineCertifiedPairEligibility.lean | 70 +++++------ .../MachineCompletedAlgorithm.lean | 20 ++-- .../MachineDirectedAffineGradientEntry.lean | 22 ++-- .../MachineDirectedAffineGradientVector.lean | 20 ++-- .../MachineDirectedEpigraphNormal.lean | 4 +- .../BeyondBethe/MachineDirectedLog.lean | 80 ++++++------- ...ineDirectedNegativeGradientCoordinate.lean | 14 +-- .../MachineDirectedNegativeGradientEntry.lean | 10 +- ...neDirectedNegativeObjectiveCoordinate.lean | 34 +++--- .../MachineDirectedNegativeObjectiveSum.lean | 110 +++++++++--------- .../MachineDirectedTransferCost.lean | 24 ++-- .../BeyondBethe/MachineDyadicFloor.lean | 34 +++--- .../BeyondBethe/MachineDyadicFloorMatrix.lean | 26 ++--- .../BeyondBethe/MachineDyadicFloorVector.lean | 24 ++-- .../MachineExecutableCertificate.lean | 6 +- .../MachineExecutablePositiveAlgorithm.lean | 6 +- ...chineExecutableScannedOptimizerOutput.lean | 102 ++++++++-------- .../MachineExplicitCertificate.lean | 4 +- .../BeyondBethe/MachineFactorial.lean | 16 +-- .../BeyondBethe/MachineFinalScalars.lean | 4 +- .../BeyondBethe/MachineFourCoreCost.lean | 26 ++--- .../BeyondBethe/MachineGreedyRowMatching.lean | 88 +++++++------- .../BeyondBethe/MachineIntegerArithmetic.lean | 34 +++--- .../BeyondBethe/MachineIntegerCompare.lean | 12 +- .../MachineIntegerSignedMagnitude.lean | 10 +- .../BeyondBethe/MachineKuhnEncoding.lean | 54 ++++----- .../BeyondBethe/MachineKuhnInvariant.lean | 16 +-- .../BeyondBethe/MachineKuhnRunner.lean | 22 ++-- .../BeyondBethe/MachineKuhnSemantics.lean | 2 +- .../BeyondBethe/MachineKuhnStep.lean | 52 ++++----- .../BeyondBethe/MachineListIndex.lean | 8 +- .../BeyondBethe/MachineListReverse.lean | 10 +- .../BeyondBethe/MachineListUpdate.lean | 42 +++---- .../BeyondBethe/MachineMatchingGain.lean | 22 ++-- .../BeyondBethe/MachineMateAllSome.lean | 22 ++-- .../BeyondBethe/MachineMateMemory.lean | 2 +- .../BeyondBethe/MachineMatrixAddDelta.lean | 42 +++---- .../BeyondBethe/MachineMatrixDimension.lean | 6 +- .../BeyondBethe/MachineMatrixNonnegative.lean | 23 ++-- .../MachineMatrixNormalization.lean | 4 +- .../MachineMatrixNormalizeEntries.lean | 44 +++---- .../BeyondBethe/MachineMatrixSum.lean | 36 +++--- .../MachineMatrixSupportProduct.lean | 28 ++--- .../BeyondBethe/MachineNearbyCoordinate.lean | 20 ++-- .../BeyondBethe/MachineNearbyMatrixSum.lean | 52 ++++----- .../MachineNestedMatrixMemory.lean | 4 +- .../MachineOptimizerBisectionLoop.lean | 46 ++++---- .../MachineOptimizerBisectionSchedule.lean | 20 ++-- .../MachineOptimizerBisectionSemantics.lean | 8 +- .../MachineOptimizerDerivedScales.lean | 30 ++--- .../MachineOptimizerEntryLength.lean | 16 +-- .../MachineOptimizerFeasibilityCall.lean | 14 +-- .../MachineOptimizerFeasibilitySchedule.lean | 72 ++++++------ .../MachineOptimizerInteriorScale.lean | 44 ++++--- .../MachineOptimizerMatrixBitBound.lean | 32 ++--- .../MachineOptimizerRoundingSchedule.lean | 34 +++--- .../MachineOptimizerStateBound.lean | 26 ++--- .../BeyondBethe/MachineOutputEncoding.lean | 22 ++-- .../BeyondBethe/MachinePerfectMatching.lean | 12 +- .../BeyondBethe/MachinePositiveAlgorithm.lean | 6 +- .../BeyondBethe/MachineRAMBridge.lean | 8 +- .../BeyondBethe/MachineRAMSmoke.lean | 2 +- .../MachineRationalArithmetic.lean | 22 ++-- .../BeyondBethe/MachineRationalBallInit.lean | 38 +++--- .../BeyondBethe/MachineRationalCompare.lean | 6 +- .../MachineRationalDirectionUpdateMatrix.lean | 74 ++++++------ .../MachineRationalDirectionUpdateRow.lean | 30 ++--- .../MachineRationalEllipsoidCenterUpdate.lean | 24 ++-- .../MachineRationalEllipsoidScalars.lean | 22 ++-- .../MachineRationalEllipsoidUpdate.lean | 4 +- .../BeyondBethe/MachineRationalExp.lean | 32 ++--- .../BeyondBethe/MachineRationalFloor.lean | 10 +- .../BeyondBethe/MachineRationalLogSeries.lean | 38 +++--- .../MachineRationalMatrixColumn.lean | 32 ++--- .../BeyondBethe/MachineRationalMatrixMul.lean | 40 +++---- .../MachineRationalMatrixMulVector.lean | 22 ++-- .../MachineRationalMatrixUpdate.lean | 16 +-- .../BeyondBethe/MachineRationalMin.lean | 2 +- .../MachineRationalNormalization.lean | 18 +-- .../MachineRationalNormalizedDirection.lean | 2 +- .../BeyondBethe/MachineRationalPower.lean | 18 +-- .../BeyondBethe/MachineRationalRowAdd.lean | 36 +++--- .../BeyondBethe/MachineRationalRowDivide.lean | 36 +++--- .../MachineRationalTransposeMulVector.lean | 32 ++--- .../BeyondBethe/MachineRationalUnary.lean | 10 +- .../BeyondBethe/MachineRationalVectorDot.lean | 28 ++--- .../BeyondBethe/MachineRationalVectorL1.lean | 22 ++-- .../MachineRationalVectorScale.lean | 4 +- .../BeyondBethe/MachineRationalVectorSub.lean | 32 ++--- .../BeyondBethe/MachineRationalVectorSum.lean | 4 +- .../MachineRowComplementUpperSum.lean | 54 ++++----- .../BeyondBethe/MachineRowPairDisjoint.lean | 24 ++-- .../BeyondBethe/MachineScheduledLog.lean | 18 +-- .../MachineScheduledRoundedEllipsoid.lean | 30 ++--- .../MachineScheduledStateEncodingBound.lean | 10 +- .../BeyondBethe/MachineSmallDimension.lean | 10 +- .../BeyondBethe/MachineSmoothedMatrix.lean | 6 +- .../BeyondBethe/MachineSmoothingDelta.lean | 23 ++-- .../BeyondBethe/MachineTrimHighZeros.lean | 12 +- .../MachineUnaryGridGenerator.lean | 50 ++++---- .../MachineUnaryMatrixGenerator.lean | 56 ++++----- .../BeyondBethe/MachineUnaryRange.lean | 16 +-- .../Machine/Program/DenseDecisionProof.lean | 7 +- 131 files changed, 1614 insertions(+), 1613 deletions(-) diff --git a/LeanPool/BeyondBethe/BeyondBethe/CertificateMagnitude.lean b/LeanPool/BeyondBethe/BeyondBethe/CertificateMagnitude.lean index 9c7ada2ddb..332e195a0a 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/CertificateMagnitude.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/CertificateMagnitude.lean @@ -235,7 +235,7 @@ theorem explicitExpEvaluationLoss_le_one : have hq : explicitExpEvaluationLoss ≤ (1 : ℚ) := by rw [explicitExpEvaluationLoss, explicitCertifiedEpsilon, explicitCertifiedEpsilon_eq] - norm_num [explicitXi, explicitDelta, explicitEta, explicitRowRatio] + norm_num [explicitXi, explicitDelta, explicitEta, explicitRowRatio] exact_mod_cast hq /-- The magnitude argument depends only on the certified matrix and KKT diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineBetheAffineEntry.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineBetheAffineEntry.lean index 99fada37cb..995b048112 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineBetheAffineEntry.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineBetheAffineEntry.lean @@ -127,7 +127,7 @@ theorem machineBetheAffineEntryRest_mem_FP : theorem machineBetheAffineEntryRow_mem_FP : machineBetheAffineEntryRow ∈ FP := by - simpa only [machineBetheAffineEntryRow] using + simpa only [machineBetheAffineEntryRow] using! machineCompose_mem_FP machineBetheAffineEntryRest_mem_FP machinePairFirst_mem_FP @@ -135,14 +135,14 @@ theorem machineBetheAffineEntryColumn_mem_FP : machineBetheAffineEntryColumn ∈ FP := by have htail := machineCompose_mem_FP machineBetheAffineEntryRest_mem_FP machinePairSecond_mem_FP - simpa only [machineBetheAffineEntryColumn] using + simpa only [machineBetheAffineEntryColumn] using! machineCompose_mem_FP htail machinePairFirst_mem_FP theorem machineBetheAffineEntryVector_mem_FP : machineBetheAffineEntryVector ∈ FP := by have htail := machineCompose_mem_FP machineBetheAffineEntryRest_mem_FP machinePairSecond_mem_FP - simpa only [machineBetheAffineEntryVector] using + simpa only [machineBetheAffineEntryVector] using! machineCompose_mem_FP htail machinePairSecond_mem_FP theorem machineBetheAffineEntryLastRowBit_mem_FP : @@ -166,7 +166,7 @@ theorem machineBetheAffineEntryFlatInput_mem_FP : theorem machineBetheAffineEntryUpperLeft_mem_FP : machineBetheAffineEntryUpperLeft ∈ FP := by - simpa only [machineBetheAffineEntryUpperLeft] using + simpa only [machineBetheAffineEntryUpperLeft] using! machineCompose_mem_FP machineBetheAffineEntryFlatInput_mem_FP machineBetheFlatEntryRawCode_mem_FP @@ -186,13 +186,13 @@ theorem machineBetheAffineEntryColumnSumInput_mem_FP : theorem machineBetheAffineEntryRowSum_mem_FP : machineBetheAffineEntryRowSum ∈ FP := by - simpa only [machineBetheAffineEntryRowSum] using + simpa only [machineBetheAffineEntryRowSum] using! machineCompose_mem_FP machineBetheAffineEntryRowSumInput_mem_FP machineBetheLineSumRawCode_mem_FP theorem machineBetheAffineEntryColumnSum_mem_FP : machineBetheAffineEntryColumnSum ∈ FP := by - simpa only [machineBetheAffineEntryColumnSum] using + simpa only [machineBetheAffineEntryColumnSum] using! machineCompose_mem_FP machineBetheAffineEntryColumnSumInput_mem_FP machineBetheLineSumRawCode_mem_FP @@ -200,7 +200,7 @@ theorem machineRawRatSubCode_mem_FP : machineRawRatSubCode ∈ FP := by have hneg := machineCompose_mem_FP machinePairSecond_mem_FP machineRawRatNegCode_mem_FP have hinput := machinePair_mem_FP machinePairFirst_mem_FP hneg - simpa only [machineRawRatSubCode] using + simpa only [machineRawRatSubCode] using! machineCompose_mem_FP hinput machineRawRatAddCode_mem_FP theorem machineBetheAffineEntryLastColumn_mem_FP : @@ -208,7 +208,7 @@ theorem machineBetheAffineEntryLastColumn_mem_FP : have hinput := machinePair_mem_FP (machineConst_mem_FP (rawRatBinaryCode RawRat.one)) machineBetheAffineEntryRowSum_mem_FP - simpa only [machineBetheAffineEntryLastColumn] using + simpa only [machineBetheAffineEntryLastColumn] using! machineCompose_mem_FP hinput machineRawRatSubCode_mem_FP theorem machineBetheAffineEntryLastRow_mem_FP : @@ -216,18 +216,18 @@ theorem machineBetheAffineEntryLastRow_mem_FP : have hinput := machinePair_mem_FP (machineConst_mem_FP (rawRatBinaryCode RawRat.one)) machineBetheAffineEntryColumnSum_mem_FP - simpa only [machineBetheAffineEntryLastRow] using + simpa only [machineBetheAffineEntryLastRow] using! machineCompose_mem_FP hinput machineRawRatSubCode_mem_FP theorem machineBetheAffineEntryTotal_mem_FP : machineBetheAffineEntryTotal ∈ FP := by - simpa only [machineBetheAffineEntryTotal] using + simpa only [machineBetheAffineEntryTotal] using! machineCompose_mem_FP machineBetheAffineEntryVector_mem_FP machineRationalVectorRawSumCode_mem_FP theorem machineBetheAffineEntryDimensionBits_mem_FP : machineBetheAffineEntryDimensionBits ∈ FP := by - simpa only [machineBetheAffineEntryDimensionBits] using + simpa only [machineBetheAffineEntryDimensionBits] using! machineCompose_mem_FP machineBetheAffineEntryDimension_mem_FP machineLengthBits_mem_FP @@ -238,7 +238,7 @@ theorem machineBetheAffineEntryDimensionMinusOneInteger_mem_FP : machineNaturalIntegerCode_mem_FP have hinput := machinePair_mem_FP hnat (machineConst_mem_FP (integerBinaryCode (-1))) - simpa only [machineBetheAffineEntryDimensionMinusOneInteger] using + simpa only [machineBetheAffineEntryDimensionMinusOneInteger] using! machineCompose_mem_FP hinput machineIntegerAddCode_mem_FP theorem machineBetheAffineEntryDimensionMinusOneRaw_mem_FP : @@ -251,7 +251,7 @@ theorem machineBetheAffineEntryCorner_mem_FP : machineBetheAffineEntryCorner ∈ FP := by have hinput := machinePair_mem_FP machineBetheAffineEntryTotal_mem_FP machineBetheAffineEntryDimensionMinusOneRaw_mem_FP - simpa only [machineBetheAffineEntryCorner] using + simpa only [machineBetheAffineEntryCorner] using! machineCompose_mem_FP hinput machineRawRatSubCode_mem_FP theorem machineBetheAffineEntryRawCode_mem_FP : @@ -317,7 +317,7 @@ def rawBetheAffineEntry {m : ℕ} (y : Fin (m * m) → ℚ) intro h apply hi apply Fin.ext - simpa using h + simpa using! h simp [hi, hval] @[simp] theorem machineBetheAffineEntryLastColumnBit_encode {m : ℕ} @@ -338,7 +338,7 @@ def rawBetheAffineEntry {m : ℕ} (y : Fin (m * m) → ℚ) intro h apply hj apply Fin.ext - simpa using h + simpa using! h simp [hj, hval] @[simp] theorem machineRawRatSubCode_encode (q r : RawRat) : @@ -427,7 +427,7 @@ def rawBetheAffineEntry {m : ℕ} (y : Fin (m * m) → ℚ) rawRatBinaryCode (rawRatListSum RawRat.zero (List.ofFn y)) := by rw [machineBetheAffineEntryTotal, machineBetheAffineEntryVector_encode] - simpa only [rationalFiniteVectorCode, rationalVectorBinaryCode] using + simpa only [rationalFiniteVectorCode, rationalVectorBinaryCode] using! machineRationalVectorRawSumCode_encode y @[simp] theorem machineBetheAffineEntryCorner_encode {m : ℕ} diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineBetheAffineLineSum.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineBetheAffineLineSum.lean index 51e19ebd38..de544de834 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineBetheAffineLineSum.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineBetheAffineLineSum.lean @@ -94,7 +94,7 @@ theorem machineBetheFlatIndexRest_mem_FP : theorem machineBetheFlatIndexDimension_mem_FP : machineBetheFlatIndexDimension ∈ FP := by - simpa only [machineBetheFlatIndexDimension] using + simpa only [machineBetheFlatIndexDimension] using! machineCompose_mem_FP machineBetheFlatIndexRest_mem_FP machinePairFirst_mem_FP @@ -102,7 +102,7 @@ theorem machineBetheFlatIndexFixed_mem_FP : machineBetheFlatIndexFixed ∈ FP := by have htail := machineCompose_mem_FP machineBetheFlatIndexRest_mem_FP machinePairSecond_mem_FP - simpa only [machineBetheFlatIndexFixed] using + simpa only [machineBetheFlatIndexFixed] using! machineCompose_mem_FP htail machinePairFirst_mem_FP theorem machineBetheFlatIndexCurrent_mem_FP : @@ -110,7 +110,7 @@ theorem machineBetheFlatIndexCurrent_mem_FP : have htail₁ := machineCompose_mem_FP machineBetheFlatIndexRest_mem_FP machinePairSecond_mem_FP have htail₂ := machineCompose_mem_FP htail₁ machinePairSecond_mem_FP - simpa only [machineBetheFlatIndexCurrent] using + simpa only [machineBetheFlatIndexCurrent] using! machineCompose_mem_FP htail₂ machinePairFirst_mem_FP theorem machineBetheFlatIndexVector_mem_FP : @@ -118,24 +118,24 @@ theorem machineBetheFlatIndexVector_mem_FP : have htail₁ := machineCompose_mem_FP machineBetheFlatIndexRest_mem_FP machinePairSecond_mem_FP have htail₂ := machineCompose_mem_FP htail₁ machinePairSecond_mem_FP - simpa only [machineBetheFlatIndexVector] using + simpa only [machineBetheFlatIndexVector] using! machineCompose_mem_FP htail₂ machinePairSecond_mem_FP theorem machineBetheFlatIndexDimensionBits_mem_FP : machineBetheFlatIndexDimensionBits ∈ FP := by - simpa only [machineBetheFlatIndexDimensionBits] using + simpa only [machineBetheFlatIndexDimensionBits] using! machineCompose_mem_FP machineBetheFlatIndexDimension_mem_FP machineLengthBits_mem_FP theorem machineBetheFlatIndexFixedBits_mem_FP : machineBetheFlatIndexFixedBits ∈ FP := by - simpa only [machineBetheFlatIndexFixedBits] using + simpa only [machineBetheFlatIndexFixedBits] using! machineCompose_mem_FP machineBetheFlatIndexFixed_mem_FP machineLengthBits_mem_FP theorem machineBetheFlatIndexCurrentBits_mem_FP : machineBetheFlatIndexCurrentBits ∈ FP := by - simpa only [machineBetheFlatIndexCurrentBits] using + simpa only [machineBetheFlatIndexCurrentBits] using! machineCompose_mem_FP machineBetheFlatIndexCurrent_mem_FP machineLengthBits_mem_FP @@ -148,7 +148,7 @@ theorem machineBetheFlatIndexRowBits_mem_FP : machineBinaryMulBits_mem_FP have haddInput := machinePair_mem_FP hmul machineBetheFlatIndexCurrentBits_mem_FP - simpa only [machineBetheFlatIndexRowBits] using + simpa only [machineBetheFlatIndexRowBits] using! machineCompose_mem_FP haddInput machineBinaryAddBits_mem_FP theorem machineBetheFlatIndexColumnBits_mem_FP : @@ -160,7 +160,7 @@ theorem machineBetheFlatIndexColumnBits_mem_FP : machineBinaryMulBits_mem_FP have haddInput := machinePair_mem_FP hmul machineBetheFlatIndexFixedBits_mem_FP - simpa only [machineBetheFlatIndexColumnBits] using + simpa only [machineBetheFlatIndexColumnBits] using! machineCompose_mem_FP haddInput machineBinaryAddBits_mem_FP theorem machineBetheFlatIndexBits_mem_FP : @@ -173,14 +173,14 @@ theorem machineBetheFlatIndexRuler_mem_FP : machineBetheFlatIndexRuler ∈ FP := by have hinput := machinePair_mem_FP id_mem_FP machineBetheFlatIndexBits_mem_FP - simpa only [machineBetheFlatIndexRuler] using + simpa only [machineBetheFlatIndexRuler] using! machineCompose_mem_FP hinput machineBoundedUnary_mem_FP theorem machineBetheFlatEntryRawCode_mem_FP : machineBetheFlatEntryRawCode ∈ FP := by have hinput := machinePair_mem_FP machineBetheFlatIndexRuler_mem_FP machineBetheFlatIndexVector_mem_FP - simpa only [machineBetheFlatEntryRawCode] using + simpa only [machineBetheFlatEntryRawCode] using! machineCompose_mem_FP hinput machineListIndex_mem_FP def betheFlatIndexCanonicalWord {m : ℕ} (rowMode : Bool) @@ -240,7 +240,7 @@ theorem bethe_flat_index_lt_word_length {m : ℕ} (rowMode : Bool) _ ≤ m * m := Nat.mul_le_mul_right m (Nat.succ_le_iff.mpr fixed.isLt) have hvector : m * m ≤ (rationalFiniteVectorCode y).length := by - simpa only [rationalFiniteVectorCode, List.length_ofFn] using + simpa only [rationalFiniteVectorCode, List.length_ofFn] using! list_length_le_binaryListCode_length rationalEntryBinaryCode (List.ofFn y) have hcode : (rationalFiniteVectorCode y).length ≤ @@ -442,7 +442,7 @@ theorem machineBetheLineSumRest_mem_FP : machineBetheLineSumRest ∈ FP := theorem machineBetheLineSumDimension_mem_FP : machineBetheLineSumDimension ∈ FP := by - simpa only [machineBetheLineSumDimension] using + simpa only [machineBetheLineSumDimension] using! machineCompose_mem_FP machineBetheLineSumRest_mem_FP machinePairFirst_mem_FP @@ -450,14 +450,14 @@ theorem machineBetheLineSumFixed_mem_FP : machineBetheLineSumFixed ∈ FP := by have htail := machineCompose_mem_FP machineBetheLineSumRest_mem_FP machinePairSecond_mem_FP - simpa only [machineBetheLineSumFixed] using + simpa only [machineBetheLineSumFixed] using! machineCompose_mem_FP htail machinePairFirst_mem_FP theorem machineBetheLineSumVector_mem_FP : machineBetheLineSumVector ∈ FP := by have htail := machineCompose_mem_FP machineBetheLineSumRest_mem_FP machinePairSecond_mem_FP - simpa only [machineBetheLineSumVector] using + simpa only [machineBetheLineSumVector] using! machineCompose_mem_FP htail machinePairSecond_mem_FP theorem machineBetheLineSumRemaining_mem_FP : @@ -465,14 +465,14 @@ theorem machineBetheLineSumRemaining_mem_FP : theorem machineBetheLineSumCurrent_mem_FP : machineBetheLineSumCurrent ∈ FP := by - simpa only [machineBetheLineSumCurrent] using + simpa only [machineBetheLineSumCurrent] using! machineCompose_mem_FP machinePairSecond_mem_FP machinePairFirst_mem_FP theorem machineBetheLineSumAccumulator_mem_FP : machineBetheLineSumAccumulator ∈ FP := by have htail := machineCompose_mem_FP machinePairSecond_mem_FP machinePairSecond_mem_FP - simpa only [machineBetheLineSumAccumulator] using + simpa only [machineBetheLineSumAccumulator] using! machineCompose_mem_FP htail machinePairFirst_mem_FP theorem machineBetheLineSumPayload_mem_FP : @@ -480,7 +480,7 @@ theorem machineBetheLineSumPayload_mem_FP : have htail₁ := machineCompose_mem_FP machinePairSecond_mem_FP machinePairSecond_mem_FP have htail₂ := machineCompose_mem_FP htail₁ machinePairSecond_mem_FP - simpa only [machineBetheLineSumPayload] using + simpa only [machineBetheLineSumPayload] using! machineCompose_mem_FP htail₂ machinePairFirst_mem_FP theorem machineBetheLineSumBound_mem_FP : @@ -488,7 +488,7 @@ theorem machineBetheLineSumBound_mem_FP : have htail₁ := machineCompose_mem_FP machinePairSecond_mem_FP machinePairSecond_mem_FP have htail₂ := machineCompose_mem_FP htail₁ machinePairSecond_mem_FP - simpa only [machineBetheLineSumBound] using + simpa only [machineBetheLineSumBound] using! machineCompose_mem_FP htail₂ machinePairSecond_mem_FP theorem machineBetheLineSumEntryInput_mem_FP : @@ -507,7 +507,7 @@ theorem machineBetheLineSumEntryInput_mem_FP : (machinePair_mem_FP machineBetheLineSumCurrent_mem_FP hvector))) theorem machineBetheLineSumEntry_mem_FP : machineBetheLineSumEntry ∈ FP := by - simpa only [machineBetheLineSumEntry] using + simpa only [machineBetheLineSumEntry] using! machineCompose_mem_FP machineBetheLineSumEntryInput_mem_FP machineBetheFlatEntryRawCode_mem_FP @@ -515,12 +515,12 @@ theorem machineBetheLineSumCandidate_mem_FP : machineBetheLineSumCandidate ∈ FP := by have hinput := machinePair_mem_FP machineBetheLineSumAccumulator_mem_FP machineBetheLineSumEntry_mem_FP - simpa only [machineBetheLineSumCandidate] using + simpa only [machineBetheLineSumCandidate] using! machineCompose_mem_FP hinput machineRawRatAddCode_mem_FP theorem machineBetheLineSumNextAccumulator_mem_FP : machineBetheLineSumNextAccumulator ∈ FP := by - simpa only [machineBetheLineSumNextAccumulator] using + simpa only [machineBetheLineSumNextAccumulator] using! machineTake_mem_FP machineBetheLineSumBound_mem_FP machineBetheLineSumCandidate_mem_FP @@ -542,7 +542,7 @@ theorem machineBetheLineSumStep_mem_FP : machineBetheLineSumStep ∈ FP := by theorem machineBetheLineSumInputBound_mem_FP : machineBetheLineSumInputBound ∈ FP := by - simpa only [machineBetheLineSumInputBound] using + simpa only [machineBetheLineSumInputBound] using! machineCompose_mem_FP machineBinaryMulWidth_mem_FP machineBinaryMulWidth_mem_FP @@ -624,7 +624,7 @@ theorem machineBetheLineSumInit_bound (word : List Bool) : List.length_append] nlinarith [sq_nonneg (word.length + 16)]) · simpa only [machineBetheLineSumInit, - machineBetheLineSumPayload_pack] using + machineBetheLineSumPayload_pack] using! machineBetheLineSum_word_le_bound word · simp only [machineBetheLineSumInit, machineBetheLineSumBound_pack] @@ -690,7 +690,7 @@ theorem machineBetheLineSumFinalState_mem_FP : theorem machineBetheLineSumRawCode_mem_FP : machineBetheLineSumRawCode ∈ FP := by - simpa only [machineBetheLineSumRawCode] using + simpa only [machineBetheLineSumRawCode] using! machineCompose_mem_FP machineBetheLineSumFinalState_mem_FP machineBetheLineSumAccumulator_mem_FP @@ -751,7 +751,7 @@ theorem betheAffineLineValue_cost_le_word {m : ℕ} (rowMode : Bool) rationalEntryBinaryCode hzmem have hentry' : (rationalEntryBinaryCode z).length ≤ (rationalFiniteVectorCode y).length := by - simpa only [rationalFiniteVectorCode] using hentry + simpa only [rationalFiniteVectorCode] using! hentry have hraw := rawRatWidth_le_binaryCode_length (rawRatOfRat z) rw [rawRatBinaryCode_rawRatOfRat] at hraw have hword := betheLineSum_vector_code_le_word rowMode fixed y @@ -782,12 +782,12 @@ theorem rawRatListCost_betheLine_take_le {m : ℕ} (rowMode : Bool) rw [List.length_take] exact Nat.min_le_right _ _ exact htake.trans - (by simpa only [values, betheAffineLineValues_length, W] using + (by simpa only [values, betheAffineLineValues_length, W] using! betheLineSum_dimension_le_word rowMode fixed y) have hlengthMap : ((values.take k).map fun q ↦ rawRatWidth (rawRatOfRat q) + 1).length ≤ W := by - simpa only [List.length_map] using hlength + simpa only [List.length_map] using! hlength simp only [rawRatListCost] exact hsum.trans (Nat.mul_le_mul_right (W + 1) hlengthMap) @@ -808,7 +808,7 @@ theorem rawBetheAffineLinePrefix_code_le_bound {m : ℕ} have hwidth' : rawRatWidth (rawRatListSum RawRat.zero segment) ≤ 1 + W * (W + 1) := by simp only [rawRatWidth_zero] at hwidth - simpa only [word, W, segment] using hwidth.trans + simpa only [word, W, segment] using! hwidth.trans (Nat.add_le_add_left hcost 1) apply hraw.trans apply (Nat.add_le_add_left (Nat.mul_le_mul_left 3 hwidth') 4).trans @@ -843,10 +843,10 @@ theorem rawBetheAffineLinePrefix_succ {m : ℕ} (rowMode : Bool) else y (finProdFinEquiv (⟨k, hk⟩, fixed)))) := by let values := betheAffineLineValues rowMode fixed y have hk' : k < values.length := by simpa only [values, - betheAffineLineValues_length] using hk + betheAffineLineValues_length] using! hk have htake : values.take (k + 1) = values.take k ++ [values[k]] := by - simpa only [List.concat_eq_append] using (List.take_concat_get hk').symm + simpa only [List.concat_eq_append] using! (List.take_concat_get hk').symm rw [show (betheAffineLineValues rowMode fixed y).take (k + 1) = values.take (k + 1) by rfl, htake, rawRatListSum_append] simp only [rawRatListSum, List.getElem_ofFn, values, @@ -939,7 +939,7 @@ theorem machineBetheLineSumStep_semantics {m : ℕ} (rowMode : Bool) (machineBetheLineSumInputBound word)) = rawRatBinaryCode term := by rw [← hremaining] - simpa only [machineBetheLineSumSemanticState, word, segment] using hentry + simpa only [machineBetheLineSumSemanticState, word, segment] using! hentry have hprefix := rawBetheAffineLinePrefix_succ rowMode fixed y k hk have hcode : (rawRatBinaryCode (segment.add term)).length ≤ (machineBetheLineSumInputBound word).length := by @@ -1003,7 +1003,7 @@ theorem machineBetheLineSumIterate_semantics {m : ℕ} (rowMode : Bool) simp simpa [machineBetheLineSumRawCode, machineBetheLineSumFinalState, machineBetheLineSumDimension_canonical, - machineBetheLineSumSemanticState, rawBetheAffineLineSum, htake] using hstate + machineBetheLineSumSemanticState, rawBetheAffineLineSum, htake] using! hstate theorem rawBetheAffineLineSum_value {m : ℕ} (rowMode : Bool) (fixed : Fin m) (y : Fin (m * m) → ℚ) : diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineBetheEpigraphOracle.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineBetheEpigraphOracle.lean index cae42e5039..41e9a3d608 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineBetheEpigraphOracle.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineBetheEpigraphOracle.lean @@ -83,67 +83,67 @@ theorem machineBetheOracleRest_mem_FP : theorem machineBetheOraclePrecision_mem_FP : machineBetheOraclePrecision ∈ FP := by - simpa only [machineBetheOraclePrecision] using + simpa only [machineBetheOraclePrecision] using! machineCompose_mem_FP machineBetheOracleRest_mem_FP machinePairFirst_mem_FP theorem machineBetheOracleAfterPrecision_mem_FP : machineBetheOracleAfterPrecision ∈ FP := by - simpa only [machineBetheOracleAfterPrecision] using + simpa only [machineBetheOracleAfterPrecision] using! machineCompose_mem_FP machineBetheOracleRest_mem_FP machinePairSecond_mem_FP theorem machineBetheOracleTau_mem_FP : machineBetheOracleTau ∈ FP := by - simpa only [machineBetheOracleTau] using + simpa only [machineBetheOracleTau] using! machineCompose_mem_FP machineBetheOracleAfterPrecision_mem_FP machinePairFirst_mem_FP theorem machineBetheOracleAfterTau_mem_FP : machineBetheOracleAfterTau ∈ FP := by - simpa only [machineBetheOracleAfterTau] using + simpa only [machineBetheOracleAfterTau] using! machineCompose_mem_FP machineBetheOracleAfterPrecision_mem_FP machinePairSecond_mem_FP theorem machineBetheOracleDelta_mem_FP : machineBetheOracleDelta ∈ FP := by - simpa only [machineBetheOracleDelta] using + simpa only [machineBetheOracleDelta] using! machineCompose_mem_FP machineBetheOracleAfterTau_mem_FP machinePairFirst_mem_FP theorem machineBetheOracleAfterDelta_mem_FP : machineBetheOracleAfterDelta ∈ FP := by - simpa only [machineBetheOracleAfterDelta] using + simpa only [machineBetheOracleAfterDelta] using! machineCompose_mem_FP machineBetheOracleAfterTau_mem_FP machinePairSecond_mem_FP theorem machineBetheOracleUpper_mem_FP : machineBetheOracleUpper ∈ FP := by - simpa only [machineBetheOracleUpper] using + simpa only [machineBetheOracleUpper] using! machineCompose_mem_FP machineBetheOracleAfterDelta_mem_FP machinePairFirst_mem_FP theorem machineBetheOracleAfterUpper_mem_FP : machineBetheOracleAfterUpper ∈ FP := by - simpa only [machineBetheOracleAfterUpper] using + simpa only [machineBetheOracleAfterUpper] using! machineCompose_mem_FP machineBetheOracleAfterDelta_mem_FP machinePairSecond_mem_FP theorem machineBetheOracleMatrix_mem_FP : machineBetheOracleMatrix ∈ FP := by - simpa only [machineBetheOracleMatrix] using + simpa only [machineBetheOracleMatrix] using! machineCompose_mem_FP machineBetheOracleAfterUpper_mem_FP machinePairFirst_mem_FP theorem machineBetheOracleEllipsoid_mem_FP : machineBetheOracleEllipsoid ∈ FP := by - simpa only [machineBetheOracleEllipsoid] using + simpa only [machineBetheOracleEllipsoid] using! machineCompose_mem_FP machineBetheOracleAfterUpper_mem_FP machinePairSecond_mem_FP theorem machineBetheOracleCenter_mem_FP : machineBetheOracleCenter ∈ FP := by - simpa only [machineBetheOracleCenter] using + simpa only [machineBetheOracleCenter] using! machineCompose_mem_FP machineBetheOracleEllipsoid_mem_FP machineRationalEllipsoidCenterWord_mem_FP theorem machineBetheOracleBase_mem_FP : machineBetheOracleBase ∈ FP := by - simpa only [machineBetheOracleBase] using + simpa only [machineBetheOracleBase] using! machineCompose_mem_FP machineBetheOracleCenter_mem_FP machineBinaryListInit_mem_FP @@ -234,7 +234,7 @@ def machineBetheOracleNonlinearViolationBit theorem machineBetheOracleDimensionBits_mem_FP : machineBetheOracleDimensionBits ∈ FP := by - simpa only [machineBetheOracleDimensionBits] using + simpa only [machineBetheOracleDimensionBits] using! machineCompose_mem_FP machineBetheOracleDimension_mem_FP machineLengthBits_mem_FP @@ -242,14 +242,14 @@ theorem machineBetheOracleBaseDimensionBits_mem_FP : machineBetheOracleBaseDimensionBits ∈ FP := by have hpair := machinePair_mem_FP machineBetheOracleDimensionBits_mem_FP machineBetheOracleDimensionBits_mem_FP - simpa only [machineBetheOracleBaseDimensionBits] using + simpa only [machineBetheOracleBaseDimensionBits] using! machineCompose_mem_FP hpair machineBinaryMulBits_mem_FP theorem machineBetheOracleBaseDimensionUnary_mem_FP : machineBetheOracleBaseDimensionUnary ∈ FP := by have hpair := machinePair_mem_FP machineBetheOracleBase_mem_FP machineBetheOracleBaseDimensionBits_mem_FP - simpa only [machineBetheOracleBaseDimensionUnary] using + simpa only [machineBetheOracleBaseDimensionUnary] using! machineCompose_mem_FP hpair machineBoundedUnary_mem_FP theorem machineBetheOracleBaseDimensionRawCode_mem_FP : @@ -267,7 +267,7 @@ theorem machineBetheOracleFloorScanInput_mem_FP : theorem machineBetheOracleFloorScanResult_mem_FP : machineBetheOracleFloorScanResult ∈ FP := by - simpa only [machineBetheOracleFloorScanResult] using + simpa only [machineBetheOracleFloorScanResult] using! machineCompose_mem_FP machineBetheOracleFloorScanInput_mem_FP machineBetheFloorScanResultCode_mem_FP @@ -275,21 +275,21 @@ theorem machineBetheOracleFloorFoundBit_mem_FP : machineBetheOracleFloorFoundBit ∈ FP := by have htag := machineCompose_mem_FP machineBetheOracleFloorScanResult_mem_FP machinePairFirst_mem_FP - simpa only [machineBetheOracleFloorFoundBit] using + simpa only [machineBetheOracleFloorFoundBit] using! machineCompose_mem_FP htag machineHeadBit_mem_FP theorem machineBetheOracleFloorRow_mem_FP : machineBetheOracleFloorRow ∈ FP := by have hpayload := machineCompose_mem_FP machineBetheOracleFloorScanResult_mem_FP machinePairSecond_mem_FP - simpa only [machineBetheOracleFloorRow] using + simpa only [machineBetheOracleFloorRow] using! machineCompose_mem_FP hpayload machinePairFirst_mem_FP theorem machineBetheOracleFloorColumn_mem_FP : machineBetheOracleFloorColumn ∈ FP := by have hpayload := machineCompose_mem_FP machineBetheOracleFloorScanResult_mem_FP machinePairSecond_mem_FP - simpa only [machineBetheOracleFloorColumn] using + simpa only [machineBetheOracleFloorColumn] using! machineCompose_mem_FP hpayload machinePairSecond_mem_FP theorem machineBetheOracleHeightInput_mem_FP : @@ -300,13 +300,13 @@ theorem machineBetheOracleHeightInput_mem_FP : theorem machineBetheOracleHeightViolationBit_mem_FP : machineBetheOracleHeightViolationBit ∈ FP := by - simpa only [machineBetheOracleHeightViolationBit] using + simpa only [machineBetheOracleHeightViolationBit] using! machineCompose_mem_FP machineBetheOracleHeightInput_mem_FP machineBetheHeightCapViolationBit_mem_FP theorem machineBetheOracleHeightRawCode_mem_FP : machineBetheOracleHeightRawCode ∈ FP := by - simpa only [machineBetheOracleHeightRawCode] using + simpa only [machineBetheOracleHeightRawCode] using! machineCompose_mem_FP machineBetheOracleHeightInput_mem_FP machineBetheHeightCapEntryCode_mem_FP @@ -314,7 +314,7 @@ theorem machineBetheOracleHalfPowerRawCode_mem_FP : machineBetheOracleHalfPowerRawCode ∈ FP := by have hpair := machinePair_mem_FP machineBetheOraclePrecision_mem_FP (machineConst_mem_FP (rawRatBinaryCode rawOptimizerHalf)) - simpa only [machineBetheOracleHalfPowerRawCode] using + simpa only [machineBetheOracleHalfPowerRawCode] using! machineCompose_mem_FP hpair machineRawRatPowerCode_mem_FP theorem machineBetheOracleScaledErrorRawCode_mem_FP : @@ -322,7 +322,7 @@ theorem machineBetheOracleScaledErrorRawCode_mem_FP : have hpair := machinePair_mem_FP (machineConst_mem_FP (rawRatBinaryCode rawBetheOracleSixteen)) machineBetheOracleHalfPowerRawCode_mem_FP - simpa only [machineBetheOracleScaledErrorRawCode] using + simpa only [machineBetheOracleScaledErrorRawCode] using! machineCompose_mem_FP hpair machineRawRatMulCode_mem_FP theorem machineBetheOracleMarginRawCode_mem_FP : @@ -330,7 +330,7 @@ theorem machineBetheOracleMarginRawCode_mem_FP : have hpair := machinePair_mem_FP machineBetheOracleScaledErrorRawCode_mem_FP machineBetheOracleBaseDimensionRawCode_mem_FP - simpa only [machineBetheOracleMarginRawCode] using + simpa only [machineBetheOracleMarginRawCode] using! machineCompose_mem_FP hpair machineRawRatMulCode_mem_FP theorem machineBetheOracleObjectiveInput_mem_FP : @@ -343,7 +343,7 @@ theorem machineBetheOracleObjectiveInput_mem_FP : theorem machineBetheOracleLowerRawCode_mem_FP : machineBetheOracleLowerRawCode ∈ FP := by - simpa only [machineBetheOracleLowerRawCode] using + simpa only [machineBetheOracleLowerRawCode] using! machineCompose_mem_FP machineBetheOracleObjectiveInput_mem_FP machineDirectedNegativeObjectiveSumRawCode_mem_FP @@ -351,7 +351,7 @@ theorem machineBetheOracleHeightPlusMarginRawCode_mem_FP : machineBetheOracleHeightPlusMarginRawCode ∈ FP := by have hpair := machinePair_mem_FP machineBetheOracleHeightRawCode_mem_FP machineBetheOracleMarginRawCode_mem_FP - simpa only [machineBetheOracleHeightPlusMarginRawCode] using + simpa only [machineBetheOracleHeightPlusMarginRawCode] using! machineCompose_mem_FP hpair machineRawRatAddCode_mem_FP theorem machineBetheOracleNonlinearViolationBit_mem_FP : @@ -359,7 +359,7 @@ theorem machineBetheOracleNonlinearViolationBit_mem_FP : have hpair := machinePair_mem_FP machineBetheOracleLowerRawCode_mem_FP machineBetheOracleHeightPlusMarginRawCode_mem_FP have hle := machineCompose_mem_FP hpair machineRawRatLeBit_mem_FP - simpa only [machineBetheOracleNonlinearViolationBit] using + simpa only [machineBetheOracleNonlinearViolationBit] using! machineNotBit_mem_FP hle /-! ## Cut construction and final response -/ @@ -432,7 +432,7 @@ theorem machineBetheEpigraphOracleResponseCode_mem_FP : have hheight := machineIfHead_mem_FP machineBetheOracleHeightViolationBit_mem_FP machineBetheOracleHeightResponse_mem_FP hnonlinear - simpa only [machineBetheEpigraphOracleResponseCode] using + simpa only [machineBetheEpigraphOracleResponseCode] using! machineIfHead_mem_FP machineBetheOracleFloorFoundBit_mem_FP machineBetheOracleFloorResponse_mem_FP hheight @@ -568,7 +568,7 @@ theorem ofFn_epigraph_center_split {d : ℕ} theorem betheOracle_baseDimension_le_baseCodeLength {m : ℕ} (q : Fin (m * m) → ℚ) : m * m ≤ (rationalFiniteVectorCode q).length := by - simpa only [rationalFiniteVectorCode, List.length_ofFn] using + simpa only [rationalFiniteVectorCode, List.length_ofFn] using! binaryListCode_listLength_le rationalEntryBinaryCode (List.ofFn q) @[simp] theorem machineBetheOracleBaseDimensionUnary_encode {m : ℕ} @@ -918,7 +918,7 @@ def scannedBetheBoundedEpigraphOracle {m : ℕ} 16 * (2 ^ p : ℚ)⁻¹ * (m * m) < directedNegativeObjectiveLower tau A (betheAffineMatrixQ (epigraphBase E.center)) p := by - simpa [one_div, div_pow] using hnonlinear + simpa [one_div, div_pow] using! hnonlinear simp [scannedBetheBoundedEpigraphOracle, state, hfound, hheight, directedEpigraphOracle, betheDirectedEpigraphData, hnonlinear'] · rw [machineBetheOracleNonlinearViolationBit_encode] @@ -928,7 +928,7 @@ def scannedBetheBoundedEpigraphOracle {m : ℕ} 16 * (2 ^ p : ℚ)⁻¹ * (m * m) < directedNegativeObjectiveLower tau A (betheAffineMatrixQ (epigraphBase E.center)) p) := by - simpa [one_div, div_pow] using hnonlinear + simpa [one_div, div_pow] using! hnonlinear simp [scannedBetheBoundedEpigraphOracle, state, hfound, hheight, directedEpigraphOracle, betheDirectedEpigraphData, hnonlinear'] · rw [machineIfHead_true, @@ -951,7 +951,7 @@ theorem scannedBetheBoundedEpigraphOracle_valid {m : ℕ} (hm : 0 < m) split at hresponse <;> rename_i hfloor · let state := finalBetheFloorScanSemanticState delta (epigraphBase E.center) - have hfloor' : state.found = true := by simpa only [state] using hfloor + have hfloor' : state.found = true := by simpa only [state] using! hfloor cases hresponse refine ⟨betheFloorCutNormal_ne_zero hm state.row state.column, ?_⟩ intro z hz @@ -962,10 +962,10 @@ theorem scannedBetheBoundedEpigraphOracle_valid {m : ℕ} (hm : 0 < m) have htargetFloor : (delta.value : ℝ) ≤ birkhoffAffineMap (vectorToSquareMatrix (epigraphBase z)) state.row state.column := by - simpa only [BetheEpigraphTarget] using hz.1 state.row state.column + simpa only [BetheEpigraphTarget] using! hz.1 state.row state.column have hcut := betheFloorCut_valid hbelow htargetFloor rw [finiteDot, Fin.sum_univ_castSucc] at hcut ⊢ - simpa [rationalCenterReal, epigraphBase] using hcut.le + simpa [rationalCenterReal, epigraphBase] using! hcut.le · split at hresponse <;> rename_i hheight · cases hresponse refine ⟨epigraphUpperNormal_ne_zero (m * m), ?_⟩ @@ -975,9 +975,9 @@ theorem scannedBetheBoundedEpigraphOracle_valid {m : ℕ} (hm : 0 < m) (fun i ↦ (epigraphUpperNormal (m * m) i : ℝ)) (fun i ↦ z i - rationalCenterReal E i) = epigraphHeight z - (epigraphHeight E.center : ℚ) by - simpa only [rationalCenterReal] using hdot] + simpa only [rationalCenterReal] using! hdot] have hzUpper : epigraphHeight z ≤ (upper.value : ℝ) := by - simpa only [BetheEpigraphTarget] using hz.2.2 + simpa only [BetheEpigraphTarget] using! hz.2.2 have hheightReal : (upper.value : ℝ) < ((epigraphHeight E.center : ℚ) : ℝ) := by exact_mod_cast hheight @@ -985,7 +985,7 @@ theorem scannedBetheBoundedEpigraphOracle_valid {m : ℕ} (hm : 0 < m) · have hqueryFloor : ∀ i j, delta.value ≤ betheAffineMatrixQ (epigraphBase E.center) i j := by apply finalBetheFloorScanSemanticState_notFound_all_above - simpa using hfloor + simpa using! hfloor refine ⟨directedEpigraphOracle_cut_ne_zero (betheDirectedEpigraphData tau A p) (16 * (1 / 2 : ℚ) ^ p) (m * m) E hresponse, ?_⟩ @@ -1012,7 +1012,7 @@ theorem scannedBetheBoundedEpigraphOracle_acceptsOnly {m : ℕ} · cases hresponse refine ⟨?_, not_lt.mp hheight, ?_⟩ · apply finalBetheFloorScanSemanticState_notFound_all_above - simpa using hfloor + simpa using! hfloor · exact not_lt.mp hnonlinear end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineBetheFeasibilityFit.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineBetheFeasibilityFit.lean index bb24551240..0488995752 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineBetheFeasibilityFit.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineBetheFeasibilityFit.lean @@ -64,7 +64,7 @@ theorem MachineBetheFeasibilityFits.of_invariant let E₁ := scheduledRoundedEllipsoidCentralUpdate p E a have hadvance := hE.advance hd a hpulled htT have hE₁ : ScheduledEllipsoidInvariant d L K (t + 1) E₁ := by - simpa only [d, p, E₁] using hadvance.2 + simpa only [d, p, E₁] using! hadvance.2 constructor · have hexponent : K + (t + 1) * (6 + 3 * d) ≤ K + T * (6 + 3 * d) := by @@ -80,7 +80,7 @@ theorem MachineBetheFeasibilityFits.of_invariant scheduledRoundedEllipsoidCentralUpdate_stateCode_length_le hd E a hM simpa only [d, p, E₁, - scheduledFeasibilityStateCodeBound] using hcode + scheduledFeasibilityStateCodeBound] using! hcode · have hbudget' : (t + 1) + iterations ≤ T := by omega exact ih (t := t + 1) (E := E₁) hE₁ hbudget' @@ -101,7 +101,7 @@ theorem explicitBallMachineBetheFeasibilityFits let K := explicitBallInitialMagnitudeExponent d R have hInv : ScheduledEllipsoidInvariant d L K 0 (rationalBallEllipsoid d 0 R) := by - simpa only [d, L, K] using explicitBallInitialInvariant hR + simpa only [d, L, K] using! explicitBallInitialInvariant hR have hvalid := scannedBetheBoundedEpigraphOracle_valid hm htau0 htau1 hA hdelta oraclePrecision upper have hfit := MachineBetheFeasibilityFits.of_invariant @@ -109,7 +109,7 @@ theorem explicitBallMachineBetheFeasibilityFits tau A oraclePrecision delta upper hvalid (rationalBallEllipsoid d 0 R) hInv (by omega) simpa only [d, L, K, explicitBallFeasibilityPrecision, - explicitBallFeasibilityStateCodeBound] using hfit + explicitBallFeasibilityStateCodeBound] using! hfit theorem machineExplicitBallBetheFeasibilityResultCode_encode {m : ℕ} (hm : 0 < m) diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineBetheFeasibilityLoop.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineBetheFeasibilityLoop.lean index da2b679693..d102f0a905 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineBetheFeasibilityLoop.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineBetheFeasibilityLoop.lean @@ -224,37 +224,37 @@ theorem machineBetheFeasibilityAfterBudget_mem_FP : theorem machineBetheFeasibilityBound_mem_FP : machineBetheFeasibilityBound ∈ FP := by - simpa only [machineBetheFeasibilityBound] using + simpa only [machineBetheFeasibilityBound] using! machineCompose_mem_FP machineBetheFeasibilityAfterBudget_mem_FP machinePairFirst_mem_FP theorem machineBetheFeasibilityAfterBound_mem_FP : machineBetheFeasibilityAfterBound ∈ FP := by - simpa only [machineBetheFeasibilityAfterBound] using + simpa only [machineBetheFeasibilityAfterBound] using! machineCompose_mem_FP machineBetheFeasibilityAfterBudget_mem_FP machinePairSecond_mem_FP theorem machineBetheFeasibilityRoundingPrecision_mem_FP : machineBetheFeasibilityRoundingPrecision ∈ FP := by - simpa only [machineBetheFeasibilityRoundingPrecision] using + simpa only [machineBetheFeasibilityRoundingPrecision] using! machineCompose_mem_FP machineBetheFeasibilityAfterBound_mem_FP machinePairFirst_mem_FP theorem machineBetheFeasibilityStaticAndInitial_mem_FP : machineBetheFeasibilityStaticAndInitial ∈ FP := by - simpa only [machineBetheFeasibilityStaticAndInitial] using + simpa only [machineBetheFeasibilityStaticAndInitial] using! machineCompose_mem_FP machineBetheFeasibilityAfterBound_mem_FP machinePairSecond_mem_FP theorem machineBetheFeasibilityOracleStatic_mem_FP : machineBetheFeasibilityOracleStatic ∈ FP := by - simpa only [machineBetheFeasibilityOracleStatic] using + simpa only [machineBetheFeasibilityOracleStatic] using! machineCompose_mem_FP machineBetheFeasibilityStaticAndInitial_mem_FP machinePairFirst_mem_FP theorem machineBetheFeasibilityInitialEllipsoid_mem_FP : machineBetheFeasibilityInitialEllipsoid ∈ FP := by - simpa only [machineBetheFeasibilityInitialEllipsoid] using + simpa only [machineBetheFeasibilityInitialEllipsoid] using! machineCompose_mem_FP machineBetheFeasibilityStaticAndInitial_mem_FP machinePairSecond_mem_FP @@ -263,21 +263,21 @@ theorem machineBetheFeasibilityStateAccepted_mem_FP : theorem machineBetheFeasibilityStateSource_mem_FP : machineBetheFeasibilityStateSource ∈ FP := by - simpa only [machineBetheFeasibilityStateSource] using + simpa only [machineBetheFeasibilityStateSource] using! machineCompose_mem_FP machinePairSecond_mem_FP machinePairFirst_mem_FP theorem machineBetheFeasibilityStateEllipsoid_mem_FP : machineBetheFeasibilityStateEllipsoid ∈ FP := by have htail := machineCompose_mem_FP machinePairSecond_mem_FP machinePairSecond_mem_FP - simpa only [machineBetheFeasibilityStateEllipsoid] using + simpa only [machineBetheFeasibilityStateEllipsoid] using! machineCompose_mem_FP htail machinePairFirst_mem_FP theorem machineBetheFeasibilityStateBound_mem_FP : machineBetheFeasibilityStateBound ∈ FP := by have htail := machineCompose_mem_FP machinePairSecond_mem_FP machinePairSecond_mem_FP - simpa only [machineBetheFeasibilityStateBound] using + simpa only [machineBetheFeasibilityStateBound] using! machineCompose_mem_FP htail machinePairSecond_mem_FP theorem machineBetheFeasibilityInit_mem_FP : @@ -292,7 +292,7 @@ theorem machineBetheFeasibilityStaticDimension_mem_FP : have hstatic := machineCompose_mem_FP machineBetheFeasibilityStateSource_mem_FP machineBetheFeasibilityOracleStatic_mem_FP - simpa only [machineBetheFeasibilityStaticDimension] using + simpa only [machineBetheFeasibilityStaticDimension] using! machineCompose_mem_FP hstatic machinePairFirst_mem_FP theorem machineBetheFeasibilityStaticRest_mem_FP : @@ -300,54 +300,54 @@ theorem machineBetheFeasibilityStaticRest_mem_FP : have hstatic := machineCompose_mem_FP machineBetheFeasibilityStateSource_mem_FP machineBetheFeasibilityOracleStatic_mem_FP - simpa only [machineBetheFeasibilityStaticRest] using + simpa only [machineBetheFeasibilityStaticRest] using! machineCompose_mem_FP hstatic machinePairSecond_mem_FP theorem machineBetheFeasibilityStaticOraclePrecision_mem_FP : machineBetheFeasibilityStaticOraclePrecision ∈ FP := by - simpa only [machineBetheFeasibilityStaticOraclePrecision] using + simpa only [machineBetheFeasibilityStaticOraclePrecision] using! machineCompose_mem_FP machineBetheFeasibilityStaticRest_mem_FP machinePairFirst_mem_FP theorem machineBetheFeasibilityStaticAfterPrecision_mem_FP : machineBetheFeasibilityStaticAfterPrecision ∈ FP := by - simpa only [machineBetheFeasibilityStaticAfterPrecision] using + simpa only [machineBetheFeasibilityStaticAfterPrecision] using! machineCompose_mem_FP machineBetheFeasibilityStaticRest_mem_FP machinePairSecond_mem_FP theorem machineBetheFeasibilityStaticTau_mem_FP : machineBetheFeasibilityStaticTau ∈ FP := by - simpa only [machineBetheFeasibilityStaticTau] using + simpa only [machineBetheFeasibilityStaticTau] using! machineCompose_mem_FP machineBetheFeasibilityStaticAfterPrecision_mem_FP machinePairFirst_mem_FP theorem machineBetheFeasibilityStaticAfterTau_mem_FP : machineBetheFeasibilityStaticAfterTau ∈ FP := by - simpa only [machineBetheFeasibilityStaticAfterTau] using + simpa only [machineBetheFeasibilityStaticAfterTau] using! machineCompose_mem_FP machineBetheFeasibilityStaticAfterPrecision_mem_FP machinePairSecond_mem_FP theorem machineBetheFeasibilityStaticDelta_mem_FP : machineBetheFeasibilityStaticDelta ∈ FP := by - simpa only [machineBetheFeasibilityStaticDelta] using + simpa only [machineBetheFeasibilityStaticDelta] using! machineCompose_mem_FP machineBetheFeasibilityStaticAfterTau_mem_FP machinePairFirst_mem_FP theorem machineBetheFeasibilityStaticAfterDelta_mem_FP : machineBetheFeasibilityStaticAfterDelta ∈ FP := by - simpa only [machineBetheFeasibilityStaticAfterDelta] using + simpa only [machineBetheFeasibilityStaticAfterDelta] using! machineCompose_mem_FP machineBetheFeasibilityStaticAfterTau_mem_FP machinePairSecond_mem_FP theorem machineBetheFeasibilityStaticUpper_mem_FP : machineBetheFeasibilityStaticUpper ∈ FP := by - simpa only [machineBetheFeasibilityStaticUpper] using + simpa only [machineBetheFeasibilityStaticUpper] using! machineCompose_mem_FP machineBetheFeasibilityStaticAfterDelta_mem_FP machinePairFirst_mem_FP theorem machineBetheFeasibilityStaticMatrix_mem_FP : machineBetheFeasibilityStaticMatrix ∈ FP := by - simpa only [machineBetheFeasibilityStaticMatrix] using + simpa only [machineBetheFeasibilityStaticMatrix] using! machineCompose_mem_FP machineBetheFeasibilityStaticAfterDelta_mem_FP machinePairSecond_mem_FP @@ -364,7 +364,7 @@ theorem machineBetheFeasibilityOracleInput_mem_FP : theorem machineBetheFeasibilityOracleResponse_mem_FP : machineBetheFeasibilityOracleResponse ∈ FP := by - simpa only [machineBetheFeasibilityOracleResponse] using + simpa only [machineBetheFeasibilityOracleResponse] using! machineCompose_mem_FP machineBetheFeasibilityOracleInput_mem_FP machineBetheEpigraphOracleResponseCode_mem_FP @@ -373,12 +373,12 @@ theorem machineBetheFeasibilityResponseTag_mem_FP : have htag := machineCompose_mem_FP machineBetheFeasibilityOracleResponse_mem_FP machineRationalTaggedResultTag_mem_FP - simpa only [machineBetheFeasibilityResponseTag] using + simpa only [machineBetheFeasibilityResponseTag] using! machineCompose_mem_FP htag machineHeadBit_mem_FP theorem machineBetheFeasibilityResponsePayload_mem_FP : machineBetheFeasibilityResponsePayload ∈ FP := by - simpa only [machineBetheFeasibilityResponsePayload] using + simpa only [machineBetheFeasibilityResponsePayload] using! machineCompose_mem_FP machineBetheFeasibilityOracleResponse_mem_FP machineRationalTaggedResultPayload_mem_FP @@ -393,14 +393,14 @@ theorem machineBetheFeasibilityScheduledUpdateInput_mem_FP : theorem machineBetheFeasibilityUpdatedEllipsoidCandidate_mem_FP : machineBetheFeasibilityUpdatedEllipsoidCandidate ∈ FP := by - simpa only [machineBetheFeasibilityUpdatedEllipsoidCandidate] using + simpa only [machineBetheFeasibilityUpdatedEllipsoidCandidate] using! machineCompose_mem_FP machineBetheFeasibilityScheduledUpdateInput_mem_FP machineScheduledRoundedEllipsoidCentralUpdateCode_mem_FP theorem machineBetheFeasibilityUpdatedEllipsoid_mem_FP : machineBetheFeasibilityUpdatedEllipsoid ∈ FP := by - simpa only [machineBetheFeasibilityUpdatedEllipsoid] using + simpa only [machineBetheFeasibilityUpdatedEllipsoid] using! machineTake_mem_FP machineBetheFeasibilityStateBound_mem_FP machineBetheFeasibilityUpdatedEllipsoidCandidate_mem_FP @@ -426,7 +426,7 @@ theorem machineBetheFeasibilityStep_mem_FP : machineBetheFeasibilityResponseTag_mem_FP machineBetheFeasibilityCutState_mem_FP machineBetheFeasibilityAcceptState_mem_FP - simpa only [machineBetheFeasibilityStep] using + simpa only [machineBetheFeasibilityStep] using! machineIfHead_mem_FP haccepted id_mem_FP hbranch theorem machineBetheFeasibilityStateResultCode_mem_FP : @@ -603,9 +603,9 @@ def machineBetheFeasibilityWidth (word : List Bool) : List Bool := theorem machineBetheFeasibilityWidth_mem_FP : machineBetheFeasibilityWidth ∈ FP := by have henvelope : (fun word : List Bool ↦ false :: word) ∈ FP := - by simpa only [List.singleton_append] using + by simpa only [List.singleton_append] using! machineAppend_mem_FP (machineConst_mem_FP [false]) id_mem_FP - simpa only [machineBetheFeasibilityWidth] using + simpa only [machineBetheFeasibilityWidth] using! machinePair_mem_FP henvelope (machinePair_mem_FP henvelope (machinePair_mem_FP henvelope henvelope)) @@ -634,7 +634,7 @@ theorem machineBetheFeasibilityFinalState_mem_FP : theorem machineBetheFeasibilityResultCode_mem_FP : machineBetheFeasibilityResultCode ∈ FP := by - simpa only [machineBetheFeasibilityResultCode] using + simpa only [machineBetheFeasibilityResultCode] using! machineCompose_mem_FP machineBetheFeasibilityFinalState_mem_FP machineBetheFeasibilityStateResultCode_mem_FP diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineBetheFeasibilitySemantics.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineBetheFeasibilitySemantics.lean index dd9b55ebbd..5735f0085f 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineBetheFeasibilitySemantics.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineBetheFeasibilitySemantics.lean @@ -478,7 +478,7 @@ theorem machineBetheFeasibilityIterateResult_encode {m : ℕ} tau A oraclePrecision delta upper) iterations current) := by induction iterations generalizing current with | zero => - simpa [runFixedPrecisionRationalFeasibility] using + simpa [runFixedPrecisionRationalFeasibility] using! machineBetheFeasibilityStateResult_exhausted_encode tau A oraclePrecision delta upper roundingPrecision budget stateBound initial current diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineBetheFloorCutEntry.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineBetheFloorCutEntry.lean index 8003074983..daefa2f634 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineBetheFloorCutEntry.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineBetheFloorCutEntry.lean @@ -111,7 +111,7 @@ theorem machineBetheFloorCutEntryRest_mem_FP : theorem machineBetheFloorCutEntryQueryRow_mem_FP : machineBetheFloorCutEntryQueryRow ∈ FP := by - simpa only [machineBetheFloorCutEntryQueryRow] using + simpa only [machineBetheFloorCutEntryQueryRow] using! machineCompose_mem_FP machineBetheFloorCutEntryRest_mem_FP machinePairFirst_mem_FP @@ -119,7 +119,7 @@ theorem machineBetheFloorCutEntryQueryColumn_mem_FP : machineBetheFloorCutEntryQueryColumn ∈ FP := by have htail := machineCompose_mem_FP machineBetheFloorCutEntryRest_mem_FP machinePairSecond_mem_FP - simpa only [machineBetheFloorCutEntryQueryColumn] using + simpa only [machineBetheFloorCutEntryQueryColumn] using! machineCompose_mem_FP htail machinePairFirst_mem_FP theorem machineBetheFloorCutEntryBaseRow_mem_FP : @@ -127,7 +127,7 @@ theorem machineBetheFloorCutEntryBaseRow_mem_FP : have htailOne := machineCompose_mem_FP machineBetheFloorCutEntryRest_mem_FP machinePairSecond_mem_FP have htailTwo := machineCompose_mem_FP htailOne machinePairSecond_mem_FP - simpa only [machineBetheFloorCutEntryBaseRow] using + simpa only [machineBetheFloorCutEntryBaseRow] using! machineCompose_mem_FP htailTwo machinePairFirst_mem_FP theorem machineBetheFloorCutEntryBaseColumn_mem_FP : @@ -136,7 +136,7 @@ theorem machineBetheFloorCutEntryBaseColumn_mem_FP : machineBetheFloorCutEntryRest_mem_FP machinePairSecond_mem_FP have htailTwo := machineCompose_mem_FP htailOne machinePairSecond_mem_FP have htailThree := machineCompose_mem_FP htailTwo machinePairSecond_mem_FP - simpa only [machineBetheFloorCutEntryBaseColumn] using + simpa only [machineBetheFloorCutEntryBaseColumn] using! machineCompose_mem_FP htailThree machinePairFirst_mem_FP theorem machineBetheFloorCutEntryHeightBit_mem_FP : @@ -145,7 +145,7 @@ theorem machineBetheFloorCutEntryHeightBit_mem_FP : machineBetheFloorCutEntryRest_mem_FP machinePairSecond_mem_FP have htailTwo := machineCompose_mem_FP htailOne machinePairSecond_mem_FP have htailThree := machineCompose_mem_FP htailTwo machinePairSecond_mem_FP - simpa only [machineBetheFloorCutEntryHeightBit] using + simpa only [machineBetheFloorCutEntryHeightBit] using! machineCompose_mem_FP htailThree machinePairSecond_mem_FP theorem machineBetheFloorCutEntryQueryLastRowBit_mem_FP : @@ -153,7 +153,7 @@ theorem machineBetheFloorCutEntryQueryLastRowBit_mem_FP : have heq := machineUnaryRulersEqualBit_mem_FP machineBetheFloorCutEntryQueryRow_mem_FP machineBetheFloorCutEntryDimension_mem_FP - simpa only [machineBetheFloorCutEntryQueryLastRowBit] using + simpa only [machineBetheFloorCutEntryQueryLastRowBit] using! machineCompose_mem_FP heq machineHeadBit_mem_FP theorem machineBetheFloorCutEntryQueryLastColumnBit_mem_FP : @@ -161,7 +161,7 @@ theorem machineBetheFloorCutEntryQueryLastColumnBit_mem_FP : have heq := machineUnaryRulersEqualBit_mem_FP machineBetheFloorCutEntryQueryColumn_mem_FP machineBetheFloorCutEntryDimension_mem_FP - simpa only [machineBetheFloorCutEntryQueryLastColumnBit] using + simpa only [machineBetheFloorCutEntryQueryLastColumnBit] using! machineCompose_mem_FP heq machineHeadBit_mem_FP theorem machineBetheFloorCutEntryBaseRowEqBit_mem_FP : @@ -169,7 +169,7 @@ theorem machineBetheFloorCutEntryBaseRowEqBit_mem_FP : have heq := machineUnaryRulersEqualBit_mem_FP machineBetheFloorCutEntryBaseRow_mem_FP machineBetheFloorCutEntryQueryRow_mem_FP - simpa only [machineBetheFloorCutEntryBaseRowEqBit] using + simpa only [machineBetheFloorCutEntryBaseRowEqBit] using! machineCompose_mem_FP heq machineHeadBit_mem_FP theorem machineBetheFloorCutEntryBaseColumnEqBit_mem_FP : @@ -177,7 +177,7 @@ theorem machineBetheFloorCutEntryBaseColumnEqBit_mem_FP : have heq := machineUnaryRulersEqualBit_mem_FP machineBetheFloorCutEntryBaseColumn_mem_FP machineBetheFloorCutEntryQueryColumn_mem_FP - simpa only [machineBetheFloorCutEntryBaseColumnEqBit] using + simpa only [machineBetheFloorCutEntryBaseColumnEqBit] using! machineCompose_mem_FP heq machineHeadBit_mem_FP theorem machineBetheFloorCutEntryBothBaseEqBit_mem_FP : @@ -239,7 +239,7 @@ def machineBetheFloorCutEntryCanonicalWord {m : ℕ} intro h apply hi apply Fin.ext - simpa using h + simpa using! h simp [hi, hval] @[simp] theorem machineBetheFloorCutEntryQueryLastColumnBit_encode {m : ℕ} @@ -259,7 +259,7 @@ def machineBetheFloorCutEntryCanonicalWord {m : ℕ} intro h apply hj apply Fin.ext - simpa using h + simpa using! h simp [hj, hval] @[simp] theorem machineBetheFloorCutEntryBaseRowEqBit_encode {m : ℕ} @@ -280,7 +280,7 @@ def machineBetheFloorCutEntryCanonicalWord {m : ℕ} intro h apply hai apply Fin.ext - simpa using h + simpa using! h simp [hai, hval] @[simp] theorem machineBetheFloorCutEntryBaseColumnEqBit_encode {m : ℕ} @@ -301,7 +301,7 @@ def machineBetheFloorCutEntryCanonicalWord {m : ℕ} intro h apply hbj apply Fin.ext - simpa using h + simpa using! h simp [hbj, hval] @[simp] theorem machineBetheFloorCutEntryHeightBit_encode {m : ℕ} diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineBetheFloorCutVector.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineBetheFloorCutVector.lean index 78f421774c..7981b1b97f 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineBetheFloorCutVector.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineBetheFloorCutVector.lean @@ -65,13 +65,13 @@ theorem machineBetheFloorCutGridRest_mem_FP : theorem machineBetheFloorCutGridBaseColumn_mem_FP : machineBetheFloorCutGridBaseColumn ∈ FP := by - simpa only [machineBetheFloorCutGridBaseColumn] using + simpa only [machineBetheFloorCutGridBaseColumn] using! machineCompose_mem_FP machineBetheFloorCutGridRest_mem_FP machinePairFirst_mem_FP theorem machineBetheFloorCutGridPayload_mem_FP : machineBetheFloorCutGridPayload ∈ FP := by - simpa only [machineBetheFloorCutGridPayload] using + simpa only [machineBetheFloorCutGridPayload] using! machineCompose_mem_FP machineBetheFloorCutGridRest_mem_FP machinePairSecond_mem_FP @@ -83,13 +83,13 @@ theorem machineBetheFloorCutVectorRest_mem_FP : theorem machineBetheFloorCutVectorQueryRow_mem_FP : machineBetheFloorCutVectorQueryRow ∈ FP := by - simpa only [machineBetheFloorCutVectorQueryRow] using + simpa only [machineBetheFloorCutVectorQueryRow] using! machineCompose_mem_FP machineBetheFloorCutVectorRest_mem_FP machinePairFirst_mem_FP theorem machineBetheFloorCutVectorQueryColumn_mem_FP : machineBetheFloorCutVectorQueryColumn ∈ FP := by - simpa only [machineBetheFloorCutVectorQueryColumn] using + simpa only [machineBetheFloorCutVectorQueryColumn] using! machineCompose_mem_FP machineBetheFloorCutVectorRest_mem_FP machinePairSecond_mem_FP @@ -113,7 +113,7 @@ theorem machineBetheFloorCutGridEntryInput_mem_FP : theorem machineBetheFloorCutGridEntryCode_mem_FP : machineBetheFloorCutGridEntryCode ∈ FP := by - simpa only [machineBetheFloorCutGridEntryCode] using + simpa only [machineBetheFloorCutGridEntryCode] using! machineCompose_mem_FP machineBetheFloorCutGridEntryInput_mem_FP machineBetheFloorCutEntryCode_mem_FP @@ -151,7 +151,7 @@ theorem machineBetheFloorCutVectorBaseCode_mem_FP : machineBetheFloorCutVectorBaseCode ∈ FP := by have hgenerator := machineUnaryGridGeneratorCode_mem_FP machineBetheFloorCutGridEntryCode_mem_FP - simpa only [machineBetheFloorCutVectorBaseCode] using + simpa only [machineBetheFloorCutVectorBaseCode] using! machineCompose_mem_FP machineBetheFloorCutVectorGeneratorInput_mem_FP hgenerator @@ -162,7 +162,7 @@ theorem machineBetheFloorCutVectorSnocInput_mem_FP : theorem machineBetheFloorCutVectorCode_mem_FP : machineBetheFloorCutVectorCode ∈ FP := by - simpa only [machineBetheFloorCutVectorCode] using + simpa only [machineBetheFloorCutVectorCode] using! machineCompose_mem_FP machineBetheFloorCutVectorSnocInput_mem_FP machineBinaryListSnoc_mem_FP @@ -265,7 +265,7 @@ theorem betheFloorCut_base_code_length_le_bound {m : ℕ} rw [machineBetheFloorCutVectorBound, machineIteratedBinaryWidth_length] exact hcode.trans (by - simpa only [T, L, word] using + simpa only [T, L, word] using! certificateExpGuardWidth_pow_lower 1 (machineBetheFloorCutVectorCanonicalWord i j).length) diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineBetheFloorScan.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineBetheFloorScan.lean index 1fa11809b8..0d427ae729 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineBetheFloorScan.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineBetheFloorScan.lean @@ -186,13 +186,13 @@ theorem machineBetheFloorScanRest_mem_FP : theorem machineBetheFloorScanThreshold_mem_FP : machineBetheFloorScanThreshold ∈ FP := by - simpa only [machineBetheFloorScanThreshold] using + simpa only [machineBetheFloorScanThreshold] using! machineCompose_mem_FP machineBetheFloorScanRest_mem_FP machinePairFirst_mem_FP theorem machineBetheFloorScanVector_mem_FP : machineBetheFloorScanVector ∈ FP := by - simpa only [machineBetheFloorScanVector] using + simpa only [machineBetheFloorScanVector] using! machineCompose_mem_FP machineBetheFloorScanRest_mem_FP machinePairSecond_mem_FP @@ -201,14 +201,14 @@ theorem machineBetheFloorScanRow_mem_FP : theorem machineBetheFloorScanColumn_mem_FP : machineBetheFloorScanColumn ∈ FP := by - simpa only [machineBetheFloorScanColumn] using + simpa only [machineBetheFloorScanColumn] using! machineCompose_mem_FP machinePairSecond_mem_FP machinePairFirst_mem_FP theorem machineBetheFloorScanFound_mem_FP : machineBetheFloorScanFound ∈ FP := by have htail := machineCompose_mem_FP machinePairSecond_mem_FP machinePairSecond_mem_FP - simpa only [machineBetheFloorScanFound] using + simpa only [machineBetheFloorScanFound] using! machineCompose_mem_FP htail machinePairFirst_mem_FP theorem machineBetheFloorScanDone_mem_FP : @@ -216,7 +216,7 @@ theorem machineBetheFloorScanDone_mem_FP : have htailTwo := machineCompose_mem_FP machinePairSecond_mem_FP machinePairSecond_mem_FP have htailThree := machineCompose_mem_FP htailTwo machinePairSecond_mem_FP - simpa only [machineBetheFloorScanDone] using + simpa only [machineBetheFloorScanDone] using! machineCompose_mem_FP htailThree machinePairFirst_mem_FP theorem machineBetheFloorScanPayload_mem_FP : @@ -224,24 +224,24 @@ theorem machineBetheFloorScanPayload_mem_FP : have htailTwo := machineCompose_mem_FP machinePairSecond_mem_FP machinePairSecond_mem_FP have htailThree := machineCompose_mem_FP htailTwo machinePairSecond_mem_FP - simpa only [machineBetheFloorScanPayload] using + simpa only [machineBetheFloorScanPayload] using! machineCompose_mem_FP htailThree machinePairSecond_mem_FP theorem machineBetheFloorScanStateDimension_mem_FP : machineBetheFloorScanStateDimension ∈ FP := by - simpa only [machineBetheFloorScanStateDimension] using + simpa only [machineBetheFloorScanStateDimension] using! machineCompose_mem_FP machineBetheFloorScanPayload_mem_FP machineBetheFloorScanDimension_mem_FP theorem machineBetheFloorScanStateThreshold_mem_FP : machineBetheFloorScanStateThreshold ∈ FP := by - simpa only [machineBetheFloorScanStateThreshold] using + simpa only [machineBetheFloorScanStateThreshold] using! machineCompose_mem_FP machineBetheFloorScanPayload_mem_FP machineBetheFloorScanThreshold_mem_FP theorem machineBetheFloorScanStateVector_mem_FP : machineBetheFloorScanStateVector ∈ FP := by - simpa only [machineBetheFloorScanStateVector] using + simpa only [machineBetheFloorScanStateVector] using! machineCompose_mem_FP machineBetheFloorScanPayload_mem_FP machineBetheFloorScanVector_mem_FP @@ -269,7 +269,7 @@ theorem machineBetheFloorScanTestWord_mem_FP : theorem machineBetheFloorScanViolationBit_mem_FP : machineBetheFloorScanViolationBit ∈ FP := by - simpa only [machineBetheFloorScanViolationBit] using + simpa only [machineBetheFloorScanViolationBit] using! machineCompose_mem_FP machineBetheFloorScanTestWord_mem_FP machineBetheFloorViolationBit_mem_FP @@ -356,7 +356,7 @@ theorem machineBetheFloorScanInit_mem_FP : theorem machineBetheFloorScanDimensionBits_mem_FP : machineBetheFloorScanDimensionBits ∈ FP := by - simpa only [machineBetheFloorScanDimensionBits] using + simpa only [machineBetheFloorScanDimensionBits] using! machineCompose_mem_FP machineBetheFloorScanDimension_mem_FP machineLengthBits_mem_FP @@ -365,14 +365,14 @@ theorem machineBetheFloorScanOrderBits_mem_FP : have hinput := machinePair_mem_FP machineBetheFloorScanDimensionBits_mem_FP (machineConst_mem_FP [true]) - simpa only [machineBetheFloorScanOrderBits] using + simpa only [machineBetheFloorScanOrderBits] using! machineCompose_mem_FP hinput machineBinaryAddBits_mem_FP theorem machineBetheFloorScanWorkBits_mem_FP : machineBetheFloorScanWorkBits ∈ FP := by have hinput := machinePair_mem_FP machineBetheFloorScanOrderBits_mem_FP machineBetheFloorScanOrderBits_mem_FP - simpa only [machineBetheFloorScanWorkBits] using + simpa only [machineBetheFloorScanWorkBits] using! machineCompose_mem_FP hinput machineBinaryMulBits_mem_FP theorem machineBetheFloorScanGuard_mem_FP : @@ -382,12 +382,12 @@ theorem machineBetheFloorScanRuler_mem_FP : machineBetheFloorScanRuler ∈ FP := by have hinput := machinePair_mem_FP machineBetheFloorScanGuard_mem_FP machineBetheFloorScanWorkBits_mem_FP - simpa only [machineBetheFloorScanRuler] using + simpa only [machineBetheFloorScanRuler] using! machineCompose_mem_FP hinput machineBoundedUnary_mem_FP theorem machineBetheFloorScanStateEnvelope_mem_FP : machineBetheFloorScanStateEnvelope ∈ FP := by - simpa only [machineBetheFloorScanStateEnvelope] using + simpa only [machineBetheFloorScanStateEnvelope] using! machineCompose_mem_FP machineBinaryMulWidth_mem_FP machineBinaryMulWidth_mem_FP @@ -622,7 +622,7 @@ theorem machineBetheFloorScanRuler_length_le_envelope (word : List Bool) : have hacc := hbound.2.2 simpa only [machineBetheFloorScanRuler, machineBoundedUnary, machineBoundedUnaryFinalState, machineBoundedUnaryRuler, - input, machinePairFirst_pair, machineBetheFloorScanGuard] using hacc + input, machinePairFirst_pair, machineBetheFloorScanGuard] using! hacc theorem machineBetheFloorScanIterate_length_le_width (word : List Bool) (iterations : ℕ) @@ -742,7 +742,7 @@ def betheFloorScanNextFin {m : ℕ} (i : Fin (m + 1)) : Fin (m + 1) := intro h apply hi apply Fin.ext - simpa using h + simpa using! h omega simp [betheFloorScanNextFin, hlt] @@ -872,7 +872,7 @@ def machineBetheFloorScanCanonicalState {m : ℕ} intro h apply hi apply Fin.ext - simpa using h + simpa using! h simp [hi, hval] @[simp] theorem machineBetheFloorScanLastColumnBit_canonicalState {m : ℕ} @@ -891,7 +891,7 @@ def machineBetheFloorScanCanonicalState {m : ℕ} intro h apply hj apply Fin.ext - simpa using h + simpa using! h simp [hj, hval] @[simp] theorem machineBetheFloorScanEntryWord_canonicalState {m : ℕ} @@ -1043,7 +1043,7 @@ def machineBetheFloorScanCanonicalState {m : ℕ} (state.row = Fin.last m) = true := by simp [hrow] have hbelowLast : ¬betheAffineMatrixQ y (Fin.last m) (Fin.last m) < delta.value := by - simpa [hrow, hcolumn] using hbelow + simpa [hrow, hcolumn] using! hbelow rw [hdecBelow, machineIfHead_false, machineBetheFloorScanAdvance, machineBetheFloorScanLastColumnBit_canonicalState, @@ -1070,7 +1070,7 @@ def machineBetheFloorScanCanonicalState {m : ℕ} (state.row = Fin.last m) = false := by simp [hrow] have hbelowLastColumn : ¬betheAffineMatrixQ y state.row (Fin.last m) < delta.value := by - simpa [hcolumn] using hbelow + simpa [hcolumn] using! hbelow rw [hdecBelow, machineIfHead_false, machineBetheFloorScanAdvance, machineBetheFloorScanLastColumnBit_canonicalState, @@ -1246,7 +1246,7 @@ theorem betheFloorScanOrdinal_lt_last_of_ne {m : ℕ} intro h apply hj apply Fin.ext - simpa using h + simpa using! h omega subst i simp only [betheFloorScanOrdinal, Fin.val_last] @@ -1257,7 +1257,7 @@ theorem betheFloorScanOrdinal_lt_last_of_ne {m : ℕ} intro h apply hi apply Fin.ext - simpa using h + simpa using! h omega calc betheFloorScanOrdinal i j < @@ -1360,7 +1360,7 @@ theorem betheFloorScanSemanticStep_invariant {m k : ℕ} · by_cases hrow : state.row = Fin.last m · have hbelowLast : ¬betheAffineMatrixQ y (Fin.last m) (Fin.last m) < delta.value := by - simpa [hrow, hcolumn] using hbelow + simpa [hrow, hcolumn] using! hbelow have hcurrentLast : delta.value ≤ betheAffineMatrixQ y (Fin.last m) (Fin.last m) := not_lt.mp hbelowLast have hstep : betheFloorScanSemanticStep delta y state = @@ -1388,7 +1388,7 @@ theorem betheFloorScanSemanticStep_invariant {m k : ℕ} exact betheFloorScanOrdinal_lt_last_of_ne i j hij · have hbelowLastColumn : ¬betheAffineMatrixQ y state.row (Fin.last m) < delta.value := by - simpa [hcolumn] using hbelow + simpa [hcolumn] using! hbelow have hstep : betheFloorScanSemanticStep delta y state = { state with row := betheFloorScanNextFin state.row @@ -1429,7 +1429,7 @@ theorem finalBetheFloorScanSemanticState_invariant {m : ℕ} (delta : RawRat) (y : Fin (m * m) → ℚ) : BetheFloorScanInvariant delta y ((m + 1) * (m + 1)) (finalBetheFloorScanSemanticState delta y) := by - simpa only [finalBetheFloorScanSemanticState] using + simpa only [finalBetheFloorScanSemanticState] using! betheFloorScanSemanticIterate_invariant delta y ((m + 1) * (m + 1)) diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineBetheFloorTest.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineBetheFloorTest.lean index 45a19302c1..8b9cb288d4 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineBetheFloorTest.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineBetheFloorTest.lean @@ -50,7 +50,7 @@ theorem machineBetheFloorTestEntryWord_mem_FP : theorem machineBetheFloorTestEntryRawCode_mem_FP : machineBetheFloorTestEntryRawCode ∈ FP := by - simpa only [machineBetheFloorTestEntryRawCode] using + simpa only [machineBetheFloorTestEntryRawCode] using! machineCompose_mem_FP machineBetheFloorTestEntryWord_mem_FP machineBetheAffineEntryRawCode_mem_FP @@ -59,12 +59,12 @@ theorem machineBetheFloorTestThresholdLeEntryBit_mem_FP : have hinput := machinePair_mem_FP machineBetheFloorTestThreshold_mem_FP machineBetheFloorTestEntryRawCode_mem_FP - simpa only [machineBetheFloorTestThresholdLeEntryBit] using + simpa only [machineBetheFloorTestThresholdLeEntryBit] using! machineCompose_mem_FP hinput machineRawRatLeBit_mem_FP theorem machineBetheFloorViolationBit_mem_FP : machineBetheFloorViolationBit ∈ FP := by - simpa only [machineBetheFloorViolationBit] using + simpa only [machineBetheFloorViolationBit] using! machineNotBit_mem_FP machineBetheFloorTestThresholdLeEntryBit_mem_FP diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineBetheHeightCap.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineBetheHeightCap.lean index ef66d9036c..c2846f23af 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineBetheHeightCap.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineBetheHeightCap.lean @@ -57,13 +57,13 @@ theorem machineBetheHeightCapRest_mem_FP : theorem machineBetheHeightCapUpper_mem_FP : machineBetheHeightCapUpper ∈ FP := by - simpa only [machineBetheHeightCapUpper] using + simpa only [machineBetheHeightCapUpper] using! machineCompose_mem_FP machineBetheHeightCapRest_mem_FP machinePairFirst_mem_FP theorem machineBetheHeightCapVector_mem_FP : machineBetheHeightCapVector ∈ FP := by - simpa only [machineBetheHeightCapVector] using + simpa only [machineBetheHeightCapVector] using! machineCompose_mem_FP machineBetheHeightCapRest_mem_FP machinePairSecond_mem_FP @@ -74,7 +74,7 @@ theorem machineBetheHeightCapIndexInput_mem_FP : theorem machineBetheHeightCapEntryCode_mem_FP : machineBetheHeightCapEntryCode ∈ FP := by - simpa only [machineBetheHeightCapEntryCode] using + simpa only [machineBetheHeightCapEntryCode] using! machineCompose_mem_FP machineBetheHeightCapIndexInput_mem_FP machineListIndex_mem_FP @@ -82,12 +82,12 @@ theorem machineBetheHeightLeUpperBit_mem_FP : machineBetheHeightLeUpperBit ∈ FP := by have hinput := machinePair_mem_FP machineBetheHeightCapEntryCode_mem_FP machineBetheHeightCapUpper_mem_FP - simpa only [machineBetheHeightLeUpperBit] using + simpa only [machineBetheHeightLeUpperBit] using! machineCompose_mem_FP hinput machineRawRatLeBit_mem_FP theorem machineBetheHeightCapViolationBit_mem_FP : machineBetheHeightCapViolationBit ∈ FP := by - simpa only [machineBetheHeightCapViolationBit] using + simpa only [machineBetheHeightCapViolationBit] using! machineNotBit_mem_FP machineBetheHeightLeUpperBit_mem_FP def machineBetheHeightCapCanonicalWord {d : ℕ} diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineBetheHeightNormal.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineBetheHeightNormal.lean index 7a4390bc95..33ad11fe5a 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineBetheHeightNormal.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineBetheHeightNormal.lean @@ -56,7 +56,7 @@ theorem machineBetheHeightNormalBaseCode_mem_FP : machineBetheHeightNormalBaseCode ∈ FP := by have hgenerator := machineUnaryGridGeneratorCode_mem_FP machineBetheHeightNormalEntryCode_mem_FP - simpa only [machineBetheHeightNormalBaseCode] using + simpa only [machineBetheHeightNormalBaseCode] using! machineCompose_mem_FP machineBetheHeightNormalGeneratorInput_mem_FP hgenerator @@ -67,7 +67,7 @@ theorem machineBetheHeightNormalSnocInput_mem_FP : theorem machineBetheHeightNormalVectorCode_mem_FP : machineBetheHeightNormalVectorCode ∈ FP := by - simpa only [machineBetheHeightNormalVectorCode] using + simpa only [machineBetheHeightNormalVectorCode] using! machineCompose_mem_FP machineBetheHeightNormalSnocInput_mem_FP machineBinaryListSnoc_mem_FP @@ -116,7 +116,7 @@ theorem betheHeightNormal_base_code_length_le_bound (m : ℕ) : rw [machineBetheHeightNormalBound, machineIteratedBinaryWidth_length] exact hcode.trans (by - simpa only [T, L, word] using + simpa only [T, L, word] using! certificateExpGuardWidth_pow_lower 1 (List.replicate m true).length) diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryAddSemantics.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryAddSemantics.lean index 6d0e75fa7e..fa2e1d307c 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryAddSemantics.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryAddSemantics.lean @@ -164,7 +164,7 @@ theorem binaryRippleAdd_length_le : ∀ (carry : Bool) (x y : List Bool), (BinaryRippleAdd.ripple (BinaryRippleAdd.carryBit carry false bit) [] rest).length ≤ rest.length + 1 := by - simpa using hrec + simpa using! hrec omega | cons bit rest ih => cases y with @@ -176,7 +176,7 @@ theorem binaryRippleAdd_length_le : ∀ (carry : Bool) (x y : List Bool), (BinaryRippleAdd.ripple (BinaryRippleAdd.carryBit carry bit false) rest []).length ≤ rest.length + 1 := by - simpa using hrec + simpa using! hrec omega | cons other tail => simp only [BinaryRippleAdd.ripple, List.length_cons] diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryCompare.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryCompare.lean index 1c0b89c275..c883729204 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryCompare.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryCompare.lean @@ -32,7 +32,7 @@ def machineBinaryNatEqBit (word : List Bool) : List Bool := theorem machineBinaryNatLeBit_mem_FP : machineBinaryNatLeBit ∈ Complexity.FP := by - simpa only [machineBinaryNatLeBit] using + simpa only [machineBinaryNatLeBit] using! machineIfEmpty_mem_FP machineBinarySubBits_mem_FP (machineConst_mem_FP [true]) (machineConst_mem_FP [false]) @@ -42,7 +42,7 @@ theorem machineBinaryNatLtBit_mem_FP : (machinePairFirst word)) ∈ Complexity.FP := machinePair_mem_FP machinePairSecond_mem_FP machinePairFirst_mem_FP have hsub := machineCompose_mem_FP hswap machineBinarySubBits_mem_FP - simpa only [machineBinaryNatLtBit] using + simpa only [machineBinaryNatLtBit] using! machineIfEmpty_mem_FP hsub (machineConst_mem_FP [false]) (machineConst_mem_FP [true]) @@ -52,7 +52,7 @@ theorem machineBinaryNatEqBit_mem_FP : (machinePairFirst word)) ∈ Complexity.FP := machinePair_mem_FP machinePairSecond_mem_FP machinePairFirst_mem_FP have hswappedLe := machineCompose_mem_FP hswap machineBinaryNatLeBit_mem_FP - simpa only [machineBinaryNatEqBit] using + simpa only [machineBinaryNatEqBit] using! machineAndBit_mem_FP machineBinaryNatLeBit_mem_FP hswappedLe theorem machineBinaryNatLeBit_pair_natBits (lhs rhs : ℕ) : @@ -67,7 +67,7 @@ theorem machineBinaryNatLeBit_pair_natBits (lhs rhs : ℕ) : | nil => have hlen : (lhs - rhs).bits.length = 0 := by rw [hbits]; rfl have hsize : (lhs - rhs).size = 0 := by - simpa only [Nat.size_eq_bits_len] using hlen + simpa only [Nat.size_eq_bits_len] using! hlen have := Nat.size_eq_zero.mp hsize omega | cons bit rest => simp [hbits, h] @@ -82,7 +82,7 @@ theorem machineBinaryNatLtBit_pair_natBits (lhs rhs : ℕ) : | nil => have hlen : (rhs - lhs).bits.length = 0 := by rw [hbits]; rfl have hsize : (rhs - lhs).size = 0 := by - simpa only [Nat.size_eq_bits_len] using hlen + simpa only [Nat.size_eq_bits_len] using! hlen have := Nat.size_eq_zero.mp hsize omega | cons bit rest => simp [hbits, h] diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryDivision.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryDivision.lean index 4658872eab..98f0077e9c 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryDivision.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryDivision.lean @@ -101,11 +101,11 @@ def machineBinaryDivModBits (word : List Bool) : List Bool := theorem machineBinaryDivRemaining_mem_FP : machineBinaryDivRemaining ∈ Complexity.FP := by - simpa only [machineBinaryDivRemaining] using machinePairFirst_mem_FP + simpa only [machineBinaryDivRemaining] using! machinePairFirst_mem_FP theorem machineBinaryDivDivisor_mem_FP : machineBinaryDivDivisor ∈ Complexity.FP := by - simpa only [machineBinaryDivDivisor] using + simpa only [machineBinaryDivDivisor] using! machineCompose_mem_FP machinePairSecond_mem_FP machinePairFirst_mem_FP theorem machineBinaryDivQuotient_mem_FP : @@ -113,7 +113,7 @@ theorem machineBinaryDivQuotient_mem_FP : have hsecond2 : (fun word => machinePairSecond (machinePairSecond word)) ∈ Complexity.FP := machineCompose_mem_FP machinePairSecond_mem_FP machinePairSecond_mem_FP - simpa only [machineBinaryDivQuotient] using + simpa only [machineBinaryDivQuotient] using! machineCompose_mem_FP hsecond2 machinePairFirst_mem_FP theorem machineBinaryDivRemainder_mem_FP : @@ -121,7 +121,7 @@ theorem machineBinaryDivRemainder_mem_FP : have hsecond2 : (fun word => machinePairSecond (machinePairSecond word)) ∈ Complexity.FP := machineCompose_mem_FP machinePairSecond_mem_FP machinePairSecond_mem_FP - simpa only [machineBinaryDivRemainder] using + simpa only [machineBinaryDivRemainder] using! machineCompose_mem_FP hsecond2 machinePairSecond_mem_FP theorem machineBinaryDivPack_mem_FP @@ -142,7 +142,7 @@ theorem machineBinaryDivDoubleQuotient_mem_FP : (machineBinaryDivQuotient state)) ∈ Complexity.FP := machinePair_mem_FP machineBinaryDivQuotient_mem_FP machineBinaryDivQuotient_mem_FP - simpa only [machineBinaryDivDoubleQuotient] using + simpa only [machineBinaryDivDoubleQuotient] using! machineCompose_mem_FP hpair machineBinaryAddBits_mem_FP theorem machineBinaryDivDoubleRemainder_mem_FP : @@ -151,7 +151,7 @@ theorem machineBinaryDivDoubleRemainder_mem_FP : (machineBinaryDivRemainder state)) ∈ Complexity.FP := machinePair_mem_FP machineBinaryDivRemainder_mem_FP machineBinaryDivRemainder_mem_FP - simpa only [machineBinaryDivDoubleRemainder] using + simpa only [machineBinaryDivDoubleRemainder] using! machineCompose_mem_FP hpair machineBinaryAddBits_mem_FP theorem machineBinaryDivTrial_mem_FP : @@ -165,7 +165,7 @@ theorem machineBinaryDivTrial_mem_FP : machinePair_mem_FP machineBinaryDivDoubleRemainder_mem_FP (machineConst_mem_FP [true]) have hone := machineCompose_mem_FP hpair machineBinaryAddBits_mem_FP - simpa only [machineBinaryDivTrial] using + simpa only [machineBinaryDivTrial] using! machineIfHead_mem_FP hflag hone machineBinaryDivDoubleRemainder_mem_FP theorem machineBinaryDivTake_mem_FP : @@ -175,7 +175,7 @@ theorem machineBinaryDivTake_mem_FP : machinePair_mem_FP machineBinaryDivDivisor_mem_FP machineBinaryDivTrial_mem_FP have hle := machineCompose_mem_FP hpair machineBinaryNatLeBit_mem_FP - simpa only [machineBinaryDivTake] using + simpa only [machineBinaryDivTake] using! machineIfEmpty_mem_FP machineBinaryDivDivisor_mem_FP (machineConst_mem_FP [false]) hle @@ -185,7 +185,7 @@ theorem machineBinaryDivIncrementedQuotient_mem_FP : (machineBinaryDivDoubleQuotient state) [true]) ∈ Complexity.FP := machinePair_mem_FP machineBinaryDivDoubleQuotient_mem_FP (machineConst_mem_FP [true]) - simpa only [machineBinaryDivIncrementedQuotient] using + simpa only [machineBinaryDivIncrementedQuotient] using! machineCompose_mem_FP hpair machineBinaryAddBits_mem_FP theorem machineBinaryDivNextQuotient_mem_FP : @@ -193,7 +193,7 @@ theorem machineBinaryDivNextQuotient_mem_FP : have hnonzero := machineIfHead_mem_FP machineBinaryDivTake_mem_FP machineBinaryDivIncrementedQuotient_mem_FP machineBinaryDivDoubleQuotient_mem_FP - simpa only [machineBinaryDivNextQuotient] using + simpa only [machineBinaryDivNextQuotient] using! machineIfEmpty_mem_FP machineBinaryDivDivisor_mem_FP (machineConst_mem_FP []) hnonzero @@ -204,7 +204,7 @@ theorem machineBinaryDivNextRemainder_mem_FP : machinePair_mem_FP machineBinaryDivTrial_mem_FP machineBinaryDivDivisor_mem_FP have hsub := machineCompose_mem_FP hpair machineBinarySubBits_mem_FP - simpa only [machineBinaryDivNextRemainder] using + simpa only [machineBinaryDivNextRemainder] using! machineIfHead_mem_FP machineBinaryDivTake_mem_FP hsub machineBinaryDivTrial_mem_FP @@ -224,7 +224,7 @@ theorem machineBinaryDivInit_mem_FP : theorem machineBinaryDivRuler_mem_FP : machineBinaryDivRuler ∈ Complexity.FP := by - simpa only [machineBinaryDivRuler] using machinePairFirst_mem_FP + simpa only [machineBinaryDivRuler] using! machinePairFirst_mem_FP theorem machineBinaryDivWidth_mem_FP : machineBinaryDivWidth ∈ Complexity.FP := by @@ -233,7 +233,7 @@ theorem machineBinaryDivWidth_mem_FP : have hpadded : padded ∈ Complexity.FP := machineAppend_mem_FP (machineConst_mem_FP (List.replicate 16 false)) id_mem_FP - simpa only [machineBinaryDivWidth, padded] using + simpa only [machineBinaryDivWidth, padded] using! Cobham.mulLenFn_mem_FP hpadded hpadded @[simp] theorem machineBinaryDivRemaining_pack (remaining divisor quotient remainder) : @@ -298,7 +298,7 @@ theorem machineBinaryDivDoubleQuotient_length_le (machineBinaryDivPack remaining divisor quotient remainder)).length ≤ quotient.length + 1 := by simp only [machineBinaryDivDoubleQuotient, machineBinaryDivQuotient_pack] - simpa using machineBinaryAddBits_pair_length_le quotient quotient + simpa using! machineBinaryAddBits_pair_length_le quotient quotient theorem machineBinaryDivDoubleRemainder_length_le (remaining divisor quotient remainder : List Bool) : @@ -306,7 +306,7 @@ theorem machineBinaryDivDoubleRemainder_length_le (machineBinaryDivPack remaining divisor quotient remainder)).length ≤ remainder.length + 1 := by simp only [machineBinaryDivDoubleRemainder, machineBinaryDivRemainder_pack] - simpa using machineBinaryAddBits_pair_length_le remainder remainder + simpa using! machineBinaryAddBits_pair_length_le remainder remainder theorem machineBinaryDivTrial_length_le (remaining divisor quotient remainder : List Bool) : @@ -379,7 +379,7 @@ theorem machineBinaryDivStep_reachable (machineBinaryDivIncrementedQuotient (machineBinaryDivPack remaining divisor quotient remainder)).length ≤ quotient.length + 2 := by - simpa only [machineBinaryDivIncrementedQuotient] using + simpa only [machineBinaryDivIncrementedQuotient] using! hinc.trans (Nat.add_le_add_right hmaxDouble 1) have hnonzero := machineIfHead_length_le_max (machineBinaryDivTake @@ -437,7 +437,7 @@ theorem machineBinaryDivIterate_reachable (word : List Bool) : | zero => exact machineBinaryDivInit_reachable word | succ iterations ih => rw [Function.iterate_succ_apply'] - simpa [Nat.succ_eq_add_one] using machineBinaryDivStep_reachable ih + simpa [Nat.succ_eq_add_one] using! machineBinaryDivStep_reachable ih theorem machineBinaryDivIterate_length_le_width (word : List Bool) (iterations : ℕ) @@ -467,7 +467,7 @@ theorem machineBinaryDivModBits_mem_FP : machineBinaryDivQuotient_mem_FP have hremainder := machineCompose_mem_FP machineBinaryDivFinalState_mem_FP machineBinaryDivRemainder_mem_FP - simpa only [machineBinaryDivModBits] using + simpa only [machineBinaryDivModBits] using! machinePair_mem_FP hquotient hremainder /-- Forward form of the semantic recurrence, on most-significant-first bits. -/ @@ -504,7 +504,7 @@ theorem natBits_ne_nil_of_ne_zero {n : ℕ} (hn : n ≠ 0) : n.bits ≠ [] := by intro hbits have hlen : n.bits.length = 0 := by simp [hbits] have hsize : n.size = 0 := by - simpa only [Nat.size_eq_bits_len] using hlen + simpa only [Nat.size_eq_bits_len] using! hlen exact hn (Nat.size_eq_zero.mp hsize) @[simp] theorem machineBinaryDivDoubleQuotient_pack_natBits @@ -535,7 +535,7 @@ theorem natBits_ne_nil_of_ne_zero {n : ℕ} (hn : n ≠ 0) : n.bits ≠ [] := by simp only [machineBinaryDivTrial, machineBinaryDivRemaining_pack, machineHeadBit_cons, machineIfHead_true, machineBinaryDivDoubleRemainder_pack_natBits, bitValue] - simpa using machineBinaryAddBits_pair_natBits (remainder + remainder) 1 + simpa using! machineBinaryAddBits_pair_natBits (remainder + remainder) 1 @[simp] theorem machineBinaryDivTake_pack_natBits (bit : Bool) (remaining : List Bool) (divisor quotient remainder : ℕ) : @@ -565,7 +565,7 @@ theorem natBits_ne_nil_of_ne_zero {n : ℕ} (hn : n ≠ 0) : n.bits ≠ [] := by (quotient + quotient + 1).bits := by simp only [machineBinaryDivIncrementedQuotient, machineBinaryDivDoubleQuotient_pack_natBits] - simpa using machineBinaryAddBits_pair_natBits (quotient + quotient) 1 + simpa using! machineBinaryAddBits_pair_natBits (quotient + quotient) 1 @[simp] theorem machineBinaryDivNextQuotient_pack_natBits (bit : Bool) (remaining : List Bool) (divisor quotient remainder : ℕ) : @@ -647,7 +647,7 @@ theorem machineBinaryDivIterate_natBits rw [List.length_cons, Function.iterate_succ_apply, machineBinaryDivStep_pack_natBits] let next := binaryLongDivStep divisor bit (quotient, remainder) - simpa only [binaryLongDivForward] using ih next.1 next.2 + simpa only [binaryLongDivForward] using! ih next.1 next.2 /-- Exact quotient/remainder correctness, including the zero-divisor convention inherited from `Nat.div` and `Nat.mod`. -/ diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryGCD.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryGCD.lean index eb6991ee96..0203f7a3d5 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryGCD.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryGCD.lean @@ -48,7 +48,7 @@ def machineBinaryGcdBits (word : List Bool) : List Bool := theorem machineBinaryRemainderBits_mem_FP : machineBinaryRemainderBits ∈ Complexity.FP := by - simpa only [machineBinaryRemainderBits] using + simpa only [machineBinaryRemainderBits] using! machineCompose_mem_FP machineBinaryDivModBits_mem_FP machinePairSecond_mem_FP @@ -58,7 +58,7 @@ theorem machineBinaryGcdStep_mem_FP : (machineBinaryRemainderBits state)) ∈ Complexity.FP := machinePair_mem_FP machinePairSecond_mem_FP machineBinaryRemainderBits_mem_FP - simpa only [machineBinaryGcdStep] using + simpa only [machineBinaryGcdStep] using! machineIfEmpty_mem_FP machinePairSecond_mem_FP id_mem_FP hpair theorem machineBinaryGcdInit_mem_FP : @@ -67,13 +67,13 @@ theorem machineBinaryGcdInit_mem_FP : machineTrimHighZeros_mem_FP have hsecond := machineCompose_mem_FP machinePairSecond_mem_FP machineTrimHighZeros_mem_FP - simpa only [machineBinaryGcdInit] using machinePair_mem_FP hfirst hsecond + simpa only [machineBinaryGcdInit] using! machinePair_mem_FP hfirst hsecond theorem machineBinaryGcdRuler_mem_FP : machineBinaryGcdRuler ∈ Complexity.FP := by have hsecond := machineCompose_mem_FP machinePairSecond_mem_FP machineTrimHighZeros_mem_FP - simpa only [machineBinaryGcdRuler] using machineAppend_mem_FP hsecond hsecond + simpa only [machineBinaryGcdRuler] using! machineAppend_mem_FP hsecond hsecond theorem machineBinaryGcdWidth_mem_FP : machineBinaryGcdWidth ∈ Complexity.FP := by @@ -82,7 +82,7 @@ theorem machineBinaryGcdWidth_mem_FP : have hpadded : padded ∈ Complexity.FP := machineAppend_mem_FP (machineConst_mem_FP (List.replicate 16 false)) id_mem_FP - simpa only [machineBinaryGcdWidth, padded] using + simpa only [machineBinaryGcdWidth, padded] using! Cobham.mulLenFn_mem_FP hpadded hpadded theorem machineBinaryGcdStep_pair_natBits (a b : ℕ) : @@ -133,7 +133,7 @@ theorem machineBinaryGcdStep_reachable {word state : List Bool} · simp [binaryEuclidStep, hbzero, binaryLongDiv_eq_div_mod] · have hsize := Nat.size_le_size (Nat.mod_le a b) have hbits : (a % b).bits.length ≤ a.bits.length := by - simpa only [Nat.size_eq_bits_len] using hsize + simpa only [Nat.size_eq_bits_len] using! hsize exact hbits.trans ha theorem machineBinaryGcdIterate_reachable (word : List Bool) : @@ -167,7 +167,7 @@ theorem machineBinaryGcdFinalState_mem_FP : theorem machineBinaryGcdBits_mem_FP : machineBinaryGcdBits ∈ Complexity.FP := by - simpa only [machineBinaryGcdBits] using + simpa only [machineBinaryGcdBits] using! machineCompose_mem_FP machineBinaryGcdFinalState_mem_FP machinePairFirst_mem_FP @@ -179,7 +179,7 @@ theorem machineBinaryGcdIterate_pair_natBits (steps a b : ℕ) : | zero => rfl | succ steps ih => rw [Function.iterate_succ_apply, machineBinaryGcdStep_pair_natBits] - simpa only [binaryEuclidIterate] using + simpa only [binaryEuclidIterate] using! ih (binaryEuclidStep (a, b)).1 (binaryEuclidStep (a, b)).2 theorem machineBinaryGcdBits_eq (word : List Bool) : diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryListInit.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryListInit.lean index e2bf755e49..455bdf6606 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryListInit.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryListInit.lean @@ -30,17 +30,17 @@ def machineBinaryListInit (word : List Bool) : List Bool := theorem machineBinaryListInitReversed_mem_FP : machineBinaryListInitReversed ∈ FP := by - simpa only [machineBinaryListInitReversed] using + simpa only [machineBinaryListInitReversed] using! machineListReverse_mem_FP theorem machineBinaryListInitReversedTail_mem_FP : machineBinaryListInitReversedTail ∈ FP := by - simpa only [machineBinaryListInitReversedTail] using + simpa only [machineBinaryListInitReversedTail] using! machineCompose_mem_FP machineBinaryListInitReversed_mem_FP machineListTail_mem_FP theorem machineBinaryListInit_mem_FP : machineBinaryListInit ∈ FP := by - simpa only [machineBinaryListInit] using + simpa only [machineBinaryListInit] using! machineCompose_mem_FP machineBinaryListInitReversedTail_mem_FP machineListReverse_mem_FP diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryListSnoc.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryListSnoc.lean index 8772c98a41..62f9441d6b 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryListSnoc.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryListSnoc.lean @@ -45,7 +45,7 @@ theorem machineBinaryListSnocList_mem_FP : theorem machineBinaryListSnocReversedList_mem_FP : machineBinaryListSnocReversedList ∈ FP := by - simpa only [machineBinaryListSnocReversedList] using + simpa only [machineBinaryListSnocReversedList] using! machineCompose_mem_FP machineBinaryListSnocList_mem_FP machineListReverse_mem_FP @@ -55,7 +55,7 @@ theorem machineBinaryListSnocPrependInput_mem_FP : machineBinaryListSnocReversedList_mem_FP theorem machineBinaryListSnoc_mem_FP : machineBinaryListSnoc ∈ FP := by - simpa only [machineBinaryListSnoc] using + simpa only [machineBinaryListSnoc] using! machineCompose_mem_FP machineBinaryListSnocPrependInput_mem_FP machineListReverse_mem_FP diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineBinarySub.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineBinarySub.lean index 034910291c..2c51e7aad1 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineBinarySub.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineBinarySub.lean @@ -86,10 +86,10 @@ def machineBinarySubBits (word : List Bool) : List Bool := (machineTrimHighZeros (machineBinarySubAccRev state).reverse) theorem machineBinarySubX_mem_FP : machineBinarySubX ∈ Complexity.FP := by - simpa only [machineBinarySubX] using machinePairFirst_mem_FP + simpa only [machineBinarySubX] using! machinePairFirst_mem_FP theorem machineBinarySubY_mem_FP : machineBinarySubY ∈ Complexity.FP := by - simpa only [machineBinarySubY] using + simpa only [machineBinarySubY] using! machineCompose_mem_FP machinePairSecond_mem_FP machinePairFirst_mem_FP theorem machineBinarySubBorrow_mem_FP : @@ -97,7 +97,7 @@ theorem machineBinarySubBorrow_mem_FP : have hsecond2 : (fun word => machinePairSecond (machinePairSecond word)) ∈ Complexity.FP := machineCompose_mem_FP machinePairSecond_mem_FP machinePairSecond_mem_FP - simpa only [machineBinarySubBorrow] using + simpa only [machineBinarySubBorrow] using! machineCompose_mem_FP hsecond2 machinePairFirst_mem_FP theorem machineBinarySubAccRev_mem_FP : @@ -105,7 +105,7 @@ theorem machineBinarySubAccRev_mem_FP : have hsecond2 : (fun word => machinePairSecond (machinePairSecond word)) ∈ Complexity.FP := machineCompose_mem_FP machinePairSecond_mem_FP machinePairSecond_mem_FP - simpa only [machineBinarySubAccRev] using + simpa only [machineBinarySubAccRev] using! machineCompose_mem_FP hsecond2 machinePairSecond_mem_FP theorem machineBinarySubPack_mem_FP @@ -179,7 +179,7 @@ theorem machineBinarySubWidth_mem_FP : have hpadded : padded ∈ Complexity.FP := machineAppend_mem_FP (machineConst_mem_FP (List.replicate 8 false)) id_mem_FP - simpa only [machineBinarySubWidth, padded] using + simpa only [machineBinarySubWidth, padded] using! Cobham.mulLenFn_mem_FP hpadded hpadded @[simp] theorem machineBinarySubX_pack (x y borrow accRev) : @@ -280,7 +280,7 @@ theorem machineBinarySubIterate_wellFormed_length_le state.length + iterations := by intro iterations induction iterations with - | zero => simpa using And.intro hstate (Nat.le_refl state.length) + | zero => simpa using! And.intro hstate (Nat.le_refl state.length) | succ iterations ih => rw [Function.iterate_succ_apply'] obtain ⟨hwell, hlength⟩ := ih @@ -340,7 +340,7 @@ theorem machineBinarySubBits_mem_FP : machineBinarySubAccRev_mem_FP have hrev := machineCompose_mem_FP hacc machineReverse_mem_FP have htrim := machineCompose_mem_FP hrev machineTrimHighZeros_mem_FP - simpa only [machineBinarySubBits] using machineIfHead_mem_FP hborrow + simpa only [machineBinarySubBits] using! machineIfHead_mem_FP hborrow (machineConst_mem_FP []) htrim private theorem machineBinarySubStep_done (borrow : Bool) diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineBitAssembly.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineBitAssembly.lean index 41552afa9a..074440b34d 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineBitAssembly.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineBitAssembly.lean @@ -72,16 +72,16 @@ def machineAssembleBits theorem machineBitAssemblyCounter_mem_FP : machineBitAssemblyCounter ∈ Complexity.FP := by - simpa only [machineBitAssemblyCounter] using machinePairFirst_mem_FP + simpa only [machineBitAssemblyCounter] using! machinePairFirst_mem_FP theorem machineBitAssemblyAcc_mem_FP : machineBitAssemblyAcc ∈ Complexity.FP := by - simpa only [machineBitAssemblyAcc] using + simpa only [machineBitAssemblyAcc] using! machineCompose_mem_FP machinePairSecond_mem_FP machinePairFirst_mem_FP theorem machineBitAssemblyInput_mem_FP : machineBitAssemblyInput ∈ Complexity.FP := by - simpa only [machineBitAssemblyInput] using + simpa only [machineBitAssemblyInput] using! machineCompose_mem_FP machinePairSecond_mem_FP machinePairSecond_mem_FP theorem machineQueriedBit_mem_FP @@ -104,7 +104,7 @@ theorem machineBitAssemblyNextCounter_mem_FP : Complexity.FP := machinePair_mem_FP machineBitAssemblyCounter_mem_FP (machineConst_mem_FP [true]) - simpa only [machineBitAssemblyNextCounter] using + simpa only [machineBitAssemblyNextCounter] using! machineCompose_mem_FP hpayload machineBinaryAddBits_mem_FP theorem machineBitAssemblyStep_mem_FP @@ -219,7 +219,7 @@ theorem machineAssembleBits_mem_FP {query ruler : List Bool → List Bool} (hquery : query ∈ Complexity.FP) (hruler : ruler ∈ Complexity.FP) : machineAssembleBits query ruler ∈ Complexity.FP := by - simpa only [machineAssembleBits] using + simpa only [machineAssembleBits] using! machineCompose_mem_FP (machineBitAssemblyFinalState_mem_FP hquery hruler) machineBitAssemblyAcc_mem_FP diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineBooleanInit.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineBooleanInit.lean index 1ab5738df3..57214120c9 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineBooleanInit.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineBooleanInit.lean @@ -64,7 +64,7 @@ theorem machineFalseVectorIterate_length_le_width theorem machineFalseVectorCode_mem_FP : machineFalseVectorCode ∈ Complexity.FP := by - simpa only [machineFalseVectorCode] using + simpa only [machineFalseVectorCode] using! Cobham.iterate_mem_FP machineFalseVectorStep_mem_FP (machineConst_mem_FP []) id_mem_FP machineFalseVectorWidth_mem_FP machineFalseVectorIterate_length_le_width @@ -147,12 +147,12 @@ theorem machineRepeatedRowMatrixStateRow_mem_FP : theorem machineRepeatedRowMatrixStateAcc_mem_FP : machineRepeatedRowMatrixStateAcc ∈ Complexity.FP := by - simpa only [machineRepeatedRowMatrixStateAcc] using + simpa only [machineRepeatedRowMatrixStateAcc] using! machineCompose_mem_FP machinePairSecond_mem_FP machinePairFirst_mem_FP theorem machineRepeatedRowMatrixStateBound_mem_FP : machineRepeatedRowMatrixStateBound ∈ Complexity.FP := by - simpa only [machineRepeatedRowMatrixStateBound] using + simpa only [machineRepeatedRowMatrixStateBound] using! machineCompose_mem_FP machinePairSecond_mem_FP machinePairSecond_mem_FP theorem machineRepeatedRowMatrixCandidate_mem_FP : @@ -162,7 +162,7 @@ theorem machineRepeatedRowMatrixCandidate_mem_FP : theorem machineRepeatedRowMatrixNextAcc_mem_FP : machineRepeatedRowMatrixNextAcc ∈ Complexity.FP := by - simpa only [machineRepeatedRowMatrixNextAcc] using + simpa only [machineRepeatedRowMatrixNextAcc] using! machineTake_mem_FP machineRepeatedRowMatrixStateBound_mem_FP machineRepeatedRowMatrixCandidate_mem_FP @@ -276,7 +276,7 @@ theorem machineRepeatedRowMatrixFinalState_mem_FP : theorem machineRepeatedRowMatrixCode_mem_FP : machineRepeatedRowMatrixCode ∈ Complexity.FP := by - simpa only [machineRepeatedRowMatrixCode] using + simpa only [machineRepeatedRowMatrixCode] using! machineCompose_mem_FP machineRepeatedRowMatrixFinalState_mem_FP machineRepeatedRowMatrixStateAcc_mem_FP @@ -324,7 +324,7 @@ theorem machineFalseSquareBuilderStep_semantics List.length_replicate, List.length_append] have hrowCode : (boolVectorCode (List.replicate n false)).length = 4 * n := by - simpa only [row] using hrowLength + simpa only [row] using! hrowLength rw [hrowCode] nlinarith have htake : @@ -383,7 +383,7 @@ theorem machineFalseSquareMatrixCode_mem_FP : have hruler := machineMatrixDimensionUnary_mem_FP have hrow := machineCompose_mem_FP hruler machineFalseVectorCode_mem_FP have hpayload := machinePair_mem_FP hruler hrow - simpa only [machineFalseSquareMatrixCode] using + simpa only [machineFalseSquareMatrixCode] using! machineCompose_mem_FP hpayload machineRepeatedRowMatrixCode_mem_FP @[simp] theorem machineFalseSquareMatrixCode_encode {n : ℕ} diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineBooleanMemory.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineBooleanMemory.lean index 467fa8431f..112534fbf5 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineBooleanMemory.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineBooleanMemory.lean @@ -85,7 +85,7 @@ theorem machineBoolMatrixEntryAtUnary_mem_FP : have hrowPayload := machinePair_mem_FP hrow hmatrix have hrowCode := machineCompose_mem_FP hrowPayload machineListIndex_mem_FP have hentryPayload := machinePair_mem_FP hcolumn hrowCode - simpa only [machineBoolMatrixEntryAtUnary] using + simpa only [machineBoolMatrixEntryAtUnary] using! machineCompose_mem_FP hentryPayload machineListIndex_mem_FP @[simp] theorem machineBoolMatrixEntryAtUnary_encode @@ -147,7 +147,7 @@ theorem machineBoolMatrixUpdateAtUnary_mem_FP : machineListUpdate_mem_FP have hupdateMatrixPayload := machinePair_mem_FP hrow (machinePair_mem_FP hupdatedRow hmatrix) - simpa only [machineBoolMatrixUpdateAtUnary] using + simpa only [machineBoolMatrixUpdateAtUnary] using! machineCompose_mem_FP hupdateMatrixPayload machineListUpdate_mem_FP @[simp] theorem machineBoolMatrixUpdateAtUnary_encode @@ -195,7 +195,7 @@ theorem machineRawRatEqBit_mem_FP : theorem machineRawRatNeBit_mem_FP : machineRawRatNeBit ∈ Complexity.FP := by - simpa only [machineRawRatNeBit] using + simpa only [machineRawRatNeBit] using! machineNotBit_mem_FP machineRawRatEqBit_mem_FP @[simp] theorem machineRawRatEqBit_encode (q r : RawRat) : @@ -226,7 +226,7 @@ theorem machineRationalSupportBitAtUnary_mem_FP : machineRationalSupportBitAtUnary ∈ Complexity.FP := by have hpair := machinePair_mem_FP machineMatrixEntryAtUnary_mem_FP (machineConst_mem_FP (rawRatBinaryCode RawRat.zero)) - simpa only [machineRationalSupportBitAtUnary] using + simpa only [machineRationalSupportBitAtUnary] using! machineCompose_mem_FP hpair machineRawRatNeBit_mem_FP @[simp] theorem machineRationalSupportBitAtUnary_encode {n : ℕ} diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineBoundedUnary.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineBoundedUnary.lean index b7a1d3b1e3..33e365078a 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineBoundedUnary.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineBoundedUnary.lean @@ -79,7 +79,7 @@ theorem machineBoundedUnaryDecrement_mem_FP : machineBoundedUnaryDecrement ∈ Complexity.FP := by have hpair := machinePair_mem_FP machineBoundedUnaryRemaining_mem_FP (machineConst_mem_FP [true]) - simpa only [machineBoundedUnaryDecrement] using + simpa only [machineBoundedUnaryDecrement] using! machineCompose_mem_FP hpair machineBinarySubBits_mem_FP theorem machineBoundedUnaryContinue_mem_FP : @@ -90,7 +90,7 @@ theorem machineBoundedUnaryContinue_mem_FP : theorem machineBoundedUnaryStep_mem_FP : machineBoundedUnaryStep ∈ Complexity.FP := by - simpa only [machineBoundedUnaryStep] using + simpa only [machineBoundedUnaryStep] using! machineIfEmpty_mem_FP machineBoundedUnaryRemaining_mem_FP id_mem_FP machineBoundedUnaryContinue_mem_FP @@ -198,7 +198,7 @@ theorem machineBoundedUnaryFinalState_mem_FP : theorem machineBoundedUnary_mem_FP : machineBoundedUnary ∈ Complexity.FP := by - simpa only [machineBoundedUnary] using + simpa only [machineBoundedUnary] using! machineCompose_mem_FP machineBoundedUnaryFinalState_mem_FP machineBoundedUnaryAcc_mem_FP @@ -217,7 +217,7 @@ theorem machineBoundedUnaryStep_encode (n k : ℕ) : intro hnil have hzero : n - k = 0 := by have h := congrArg Nat.fromBitsLE hnil - simpa only [Nat.fromBitsLE_bits] using h + simpa only [Nat.fromBitsLE_bits] using! h omega rw [machineBoundedUnaryStep] simp only [boundedUnaryState, machineBoundedUnaryRemaining_pack] diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineCertificateAssembly.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineCertificateAssembly.lean index 10f61660fb..4f9fb80fa1 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineCertificateAssembly.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineCertificateAssembly.lean @@ -108,7 +108,7 @@ theorem machineCertificateNearbyRawCode_mem_FP : machineNearbyMatrixRawSumCode_mem_FP have hpair := machinePair_mem_FP hpotential hnearby - simpa only [machineCertificateNearbyRawCode] using + simpa only [machineCertificateNearbyRawCode] using! machineCompose_mem_FP hpair machineRawRatAddCode_mem_FP theorem machineCertificateLogBeforePenaltyRawCode_mem_FP @@ -116,7 +116,7 @@ theorem machineCertificateLogBeforePenaltyRawCode_mem_FP (hgain : gainMachine ∈ Complexity.FP) : machineCertificateLogBeforePenaltyRawCode gainMachine ∈ Complexity.FP := by have hpair := machinePair_mem_FP machineCertificateNearbyRawCode_mem_FP hgain - simpa only [machineCertificateLogBeforePenaltyRawCode] using + simpa only [machineCertificateLogBeforePenaltyRawCode] using! machineCompose_mem_FP hpair machineRawRatAddCode_mem_FP theorem machineCertificateLogUnnormalizedRawCode_mem_FP @@ -129,14 +129,14 @@ theorem machineCertificateLogUnnormalizedRawCode_mem_FP have hneg := machineCompose_mem_FP hpenalty machineRawRatNegCode_mem_FP have hpair := machinePair_mem_FP (machineCertificateLogBeforePenaltyRawCode_mem_FP hgain) hneg - simpa only [machineCertificateLogUnnormalizedRawCode] using + simpa only [machineCertificateLogUnnormalizedRawCode] using! machineCompose_mem_FP hpair machineRawRatAddCode_mem_FP theorem machineCertificateLogRawCode_mem_FP {gainMachine : List Bool → List Bool} (hgain : gainMachine ∈ Complexity.FP) : machineCertificateLogRawCode gainMachine ∈ Complexity.FP := by - simpa only [machineCertificateLogRawCode] using + simpa only [machineCertificateLogRawCode] using! machineCompose_mem_FP (machineCertificateLogUnnormalizedRawCode_mem_FP hgain) machineNormalizeRawRatEntryCode_mem_FP @@ -214,7 +214,7 @@ theorem machineCertificateValueRawCode_mem_FP (hgain : gainMachine ∈ Complexity.FP) (hguard : guardMachine ∈ Complexity.FP) : machineCertificateValueRawCode gainMachine guardMachine ∈ Complexity.FP := by - simpa only [machineCertificateValueRawCode] using + simpa only [machineCertificateValueRawCode] using! machineCompose_mem_FP (machineCertificateExpInput_mem_FP hgain hguard) machineBoundedRationalExpLowerRawEntryCode_mem_FP @@ -298,7 +298,7 @@ theorem machineCertificateValueRawCode_realizes CertificateEvaluatorStringRealizes (machineCertificateValueRawCode gainMachine guardMachine) := by intro m B - simpa only [explicitLargeOptimizerOutput] using + simpa only [explicitLargeOptimizerOutput] using! machineCertificateValueRawCode_encode (gainMachine := gainMachine) (guardMachine := guardMachine) (rationalMatrixBinaryEncoding.encode ⟨m + 2, B⟩) @@ -315,7 +315,7 @@ theorem machineCertificateValueRawCode_realizes_onPositive CertificateEvaluatorStringRealizesOnPositiveNormalized (machineCertificateValueRawCode gainMachine guardMachine) := by intro m B hBpos hBupper - simpa only [explicitLargeOptimizerOutput] using + simpa only [explicitLargeOptimizerOutput] using! machineCertificateValueRawCode_encode (gainMachine := gainMachine) (guardMachine := guardMachine) (rationalMatrixBinaryEncoding.encode ⟨m + 2, B⟩) diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineCertificateExpGuard.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineCertificateExpGuard.lean index 706a9f3efc..754c4b1516 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineCertificateExpGuard.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineCertificateExpGuard.lean @@ -64,7 +64,7 @@ theorem inverse_certificate_loss_le_reciprocalCeil have hnQ : (1 : ℚ) ≤ n := by exact_mod_cast hn have hden : explicitExpEvaluationLoss ≤ explicitExpEvaluationLoss * n := by - simpa only [mul_one] using mul_le_mul_of_nonneg_left hnQ hc.le + simpa only [mul_one] using! mul_le_mul_of_nonneg_left hnQ hc.le have hinv : 1 / (explicitExpEvaluationLoss * n) ≤ 1 / explicitExpEvaluationLoss := one_div_le_one_div_of_le hc hden @@ -91,9 +91,9 @@ theorem certificate_expApproxSteps_le_sourceBound_of_abs_le exact_mod_cast habsR have ht0 : 0 ≤ t := abs_nonneg q have hnSource : m + 2 ≤ S := by - simpa only [S, source] using matrix_dimension_le_code_length B + simpa only [S, source] using! matrix_dimension_le_code_length B have hBSource : rationalMatrixEntryBitBound B ≤ 32 * S := by - simpa only [S, source] using + simpa only [S, source] using! rationalMatrixEntryBitBound_le_machineCode (by omega) B have hS : 1 ≤ S := by omega have hK : K ≤ K₀ := by @@ -138,7 +138,7 @@ theorem certificate_expApproxSteps_le_sourceBound_of_abs_le rw [RawRat.expApproxSteps, binaryRationalExpApproxSteps_eq, rationalExpApproxSteps, RawRat.expMagnitude_value, rawRatOfRat_value, hlossValue] - simpa only [t, K₀, S, source, explicitCertificateExpStepBound] using + simpa only [t, K₀, S, source, explicitCertificateExpStepBound] using! Nat.add_le_add_right (Nat.mul_le_mul_left 2 hceil) 1 theorem optimizerCertificate_expApproxSteps_le_sourceBound @@ -160,7 +160,7 @@ theorem optimizerCertificate_expApproxSteps_le_sourceBound (explicitBetheOptimizerColumnPotential (m := m + 1) B) have habsR := explicitOptimizerCertificateLog_abs_le m B hBpos hBupper exact certificate_expApproxSteps_le_sourceBound_of_abs_le m B q - (by simpa only [q] using habsR) + (by simpa only [q] using! habsR) def machineIteratedBinaryWidth : ℕ → List Bool → List Bool | 0, word => word @@ -173,9 +173,9 @@ def certificateExpGuardWidth : ℕ → ℕ → ℕ theorem machineIteratedBinaryWidth_mem_FP (k : ℕ) : machineIteratedBinaryWidth k ∈ Complexity.FP := by induction k with - | zero => simpa only [machineIteratedBinaryWidth] using id_mem_FP + | zero => simpa only [machineIteratedBinaryWidth] using! id_mem_FP | succ k ih => - simpa only [machineIteratedBinaryWidth] using + simpa only [machineIteratedBinaryWidth] using! machineCompose_mem_FP ih machineBinaryMulWidth_mem_FP @[simp] theorem machineIteratedBinaryWidth_length (k : ℕ) @@ -220,7 +220,7 @@ theorem explicitCertificateExpCoefficient_le : apply rationalCeilNat_le_of_le_nat rw [explicitExpEvaluationLoss, explicitCertifiedEpsilon, explicitCertifiedEpsilon_eq] - norm_num [explicitXi, explicitDelta, explicitEta, explicitRowRatio] + norm_num [explicitXi, explicitDelta, explicitEta, explicitRowRatio] rw [explicitCertificateExpCoefficient] calc 2312 * explicitExpReciprocalCeil + 69 ≤ @@ -254,14 +254,14 @@ theorem explicitCertificateExpStepBound_le_guardWidth Nat.mul_le_mul hpow60 hpow4 _ = (S + 16) ^ 64 := by rw [← pow_add] exact hstepCoeff.trans <| hguardPolynomial.trans <| - (by simpa using certificateExpGuardWidth_pow_lower 5 S) + (by simpa using! certificateExpGuardWidth_pow_lower 5 S) def machineOptimizerCertificateExpGuard (word : List Bool) : List Bool := machineIteratedBinaryWidth 6 (machineCertificateSourceWord word) theorem machineOptimizerCertificateExpGuard_mem_FP : machineOptimizerCertificateExpGuard ∈ Complexity.FP := by - simpa only [machineOptimizerCertificateExpGuard] using + simpa only [machineOptimizerCertificateExpGuard] using! machineCompose_mem_FP machineCertificateSourceWord_mem_FP (machineIteratedBinaryWidth_mem_FP 6) @@ -286,7 +286,7 @@ theorem machineOptimizerCertificateExpGuard_fits exact (optimizerCertificate_expApproxSteps_le_sourceBound m B hBpos hBupper).trans (by simpa only [machineOptimizerCertificateExpGuard, machineCertificateSourceWord_pair, - machineIteratedBinaryWidth_length, source] using + machineIteratedBinaryWidth_length, source] using! explicitCertificateExpStepBound_le_guardWidth hsource) theorem machineOptimizerCertificateExpGuard_fits_onPositiveNormalized : diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineCertificatePotentials.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineCertificatePotentials.lean index 5880da4ff0..a15a829d86 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineCertificatePotentials.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineCertificatePotentials.lean @@ -40,13 +40,13 @@ theorem machineOptimizerPotentialsWord_mem_FP : theorem machineOptimizerRowPotentialWord_mem_FP : machineOptimizerRowPotentialWord ∈ Complexity.FP := by - simpa only [machineOptimizerRowPotentialWord] using + simpa only [machineOptimizerRowPotentialWord] using! machineCompose_mem_FP machineOptimizerPotentialsWord_mem_FP machinePairFirst_mem_FP theorem machineOptimizerColumnPotentialWord_mem_FP : machineOptimizerColumnPotentialWord ∈ Complexity.FP := by - simpa only [machineOptimizerColumnPotentialWord] using + simpa only [machineOptimizerColumnPotentialWord] using! machineCompose_mem_FP machineOptimizerPotentialsWord_mem_FP machinePairSecond_mem_FP @@ -91,13 +91,13 @@ def machineCertificatePotentialRawSumCode theorem machineCertificateRowPotentialRawSumCode_mem_FP : machineCertificateRowPotentialRawSumCode ∈ Complexity.FP := by - simpa only [machineCertificateRowPotentialRawSumCode] using + simpa only [machineCertificateRowPotentialRawSumCode] using! machineCompose_mem_FP machineOptimizerRowPotentialWord_mem_FP machineRationalVectorRawSumCode_mem_FP theorem machineCertificateColumnPotentialRawSumCode_mem_FP : machineCertificateColumnPotentialRawSumCode ∈ Complexity.FP := by - simpa only [machineCertificateColumnPotentialRawSumCode] using + simpa only [machineCertificateColumnPotentialRawSumCode] using! machineCompose_mem_FP machineOptimizerColumnPotentialWord_mem_FP machineRationalVectorRawSumCode_mem_FP @@ -106,7 +106,7 @@ theorem machineCertificatePotentialRawSumCode_mem_FP : have hpair := machinePair_mem_FP machineCertificateRowPotentialRawSumCode_mem_FP machineCertificateColumnPotentialRawSumCode_mem_FP - simpa only [machineCertificatePotentialRawSumCode] using + simpa only [machineCertificatePotentialRawSumCode] using! machineCompose_mem_FP hpair machineRawRatAddCode_mem_FP def rawCertificatePotentialSum {n : ℕ} diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineCertificateScales.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineCertificateScales.lean index 9bdb94d3e1..2d84c37249 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineCertificateScales.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineCertificateScales.lean @@ -70,13 +70,13 @@ def machineCertificateExpLossRawCode theorem machineCertificateDimensionBits_mem_FP : machineCertificateDimensionBits ∈ Complexity.FP := by - simpa only [machineCertificateDimensionBits] using + simpa only [machineCertificateDimensionBits] using! machineCompose_mem_FP machineOptimizerMatrixWord_mem_FP machineMatrixDimensionWord_mem_FP theorem machineCertificateDimensionUnary_mem_FP : machineCertificateDimensionUnary ∈ Complexity.FP := by - simpa only [machineCertificateDimensionUnary] using + simpa only [machineCertificateDimensionUnary] using! machineCompose_mem_FP machineOptimizerMatrixWord_mem_FP machineMatrixDimensionUnary_mem_FP @@ -96,7 +96,7 @@ theorem machineCertificateFourDimensionRawCode_mem_FP : have hpair := machinePair_mem_FP (machineConst_mem_FP (rawRatBinaryCode rawCertificateFour)) machineCertificateDimensionRawCode_mem_FP - simpa only [machineCertificateFourDimensionRawCode] using + simpa only [machineCertificateFourDimensionRawCode] using! machineCompose_mem_FP hpair machineRawRatMulCode_mem_FP theorem machineCertificateRegularizationScaleRawCode_mem_FP : @@ -104,7 +104,7 @@ theorem machineCertificateRegularizationScaleRawCode_mem_FP : have hpair := machinePair_mem_FP (machineConst_mem_FP (rawRatBinaryCode rawExplicitXi)) machineCertificateFourDimensionRawCode_mem_FP - simpa only [machineCertificateRegularizationScaleRawCode] using + simpa only [machineCertificateRegularizationScaleRawCode] using! machineCompose_mem_FP hpair machineRawRatDivCode_mem_FP theorem machineCertificateKKTPenaltyRawCode_mem_FP : @@ -112,7 +112,7 @@ theorem machineCertificateKKTPenaltyRawCode_mem_FP : have hpair := machinePair_mem_FP (machineConst_mem_FP (rawRatBinaryCode rawExplicitKKTError)) machineCertificateDimensionRawCode_mem_FP - simpa only [machineCertificateKKTPenaltyRawCode] using + simpa only [machineCertificateKKTPenaltyRawCode] using! machineCompose_mem_FP hpair machineRawRatMulCode_mem_FP theorem machineCertificateExpLossRawCode_mem_FP : @@ -121,7 +121,7 @@ theorem machineCertificateExpLossRawCode_mem_FP : (machineConst_mem_FP (rawRatBinaryCode rawExplicitExpEvaluationLoss)) machineCertificateDimensionRawCode_mem_FP - simpa only [machineCertificateExpLossRawCode] using + simpa only [machineCertificateExpLossRawCode] using! machineCompose_mem_FP hpair machineRawRatMulCode_mem_FP @[simp] theorem machineCertificateDimensionBits_encode {n : ℕ} diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineCertifiedPairEligibility.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineCertifiedPairEligibility.lean index ca595d0b1f..cb040dca5f 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineCertifiedPairEligibility.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineCertifiedPairEligibility.lean @@ -142,46 +142,46 @@ theorem machineFixedARest₁_mem_FP : machineFixedARest₁ ∈ FP := theorem machineFixedASecondRowRuler_mem_FP : machineFixedASecondRowRuler ∈ FP := by - simpa only [machineFixedASecondRowRuler] using machineCompose_mem_FP + simpa only [machineFixedASecondRowRuler] using! machineCompose_mem_FP machineFixedARest₁_mem_FP machinePairFirst_mem_FP theorem machineFixedARest₂_mem_FP : machineFixedARest₂ ∈ FP := by - simpa only [machineFixedARest₂] using machineCompose_mem_FP + simpa only [machineFixedARest₂] using! machineCompose_mem_FP machineFixedARest₁_mem_FP machinePairSecond_mem_FP theorem machineFixedAFirstColumnRuler_mem_FP : machineFixedAFirstColumnRuler ∈ FP := by - simpa only [machineFixedAFirstColumnRuler] using machineCompose_mem_FP + simpa only [machineFixedAFirstColumnRuler] using! machineCompose_mem_FP machineFixedARest₂_mem_FP machinePairFirst_mem_FP theorem machineFixedAOptimizerWord_mem_FP : machineFixedAOptimizerWord ∈ FP := by - simpa only [machineFixedAOptimizerWord] using machineCompose_mem_FP + simpa only [machineFixedAOptimizerWord] using! machineCompose_mem_FP machineFixedARest₂_mem_FP machinePairSecond_mem_FP theorem machineFixedADimensionRuler_mem_FP : machineFixedADimensionRuler ∈ FP := by - simpa only [machineFixedADimensionRuler] using machineCompose_mem_FP + simpa only [machineFixedADimensionRuler] using! machineCompose_mem_FP machineFixedAOptimizerWord_mem_FP machineCertificateDimensionUnary_mem_FP theorem machineFixedAColumnRange_mem_FP : machineFixedAColumnRange ∈ FP := by - simpa only [machineFixedAColumnRange] using machineCompose_mem_FP + simpa only [machineFixedAColumnRange] using! machineCompose_mem_FP machineFixedADimensionRuler_mem_FP machineUnaryRangeCode_mem_FP theorem machineFixedARemaining_mem_FP : machineFixedARemaining ∈ FP := machinePairFirst_mem_FP theorem machineFixedAFound_mem_FP : machineFixedAFound ∈ FP := by - simpa only [machineFixedAFound] using machineCompose_mem_FP + simpa only [machineFixedAFound] using! machineCompose_mem_FP machinePairSecond_mem_FP machinePairFirst_mem_FP theorem machineFixedASource_mem_FP : machineFixedASource ∈ FP := by - simpa only [machineFixedASource] using machineCompose_mem_FP + simpa only [machineFixedASource] using! machineCompose_mem_FP machinePairSecond_mem_FP machinePairSecond_mem_FP theorem machineFixedACurrentSecondColumn_mem_FP : machineFixedACurrentSecondColumn ∈ FP := by - simpa only [machineFixedACurrentSecondColumn] using machineCompose_mem_FP + simpa only [machineFixedACurrentSecondColumn] using! machineCompose_mem_FP machineFixedARemaining_mem_FP machineListHead_mem_FP theorem machineFixedAColumnsEqualBit_mem_FP : @@ -192,7 +192,7 @@ theorem machineFixedAColumnsEqualBit_mem_FP : have hsecond := machineCompose_mem_FP machineFixedACurrentSecondColumn_mem_FP machineLengthBits_mem_FP have hinput := machinePair_mem_FP hfirst hsecond - simpa only [machineFixedAColumnsEqualBit] using machineCompose_mem_FP hinput + simpa only [machineFixedAColumnsEqualBit] using! machineCompose_mem_FP hinput machineBinaryNatEqBit_mem_FP theorem machineFixedAColumnsDistinctBit_mem_FP : @@ -217,7 +217,7 @@ theorem machineFixedAFourCoreInput_mem_FP : theorem machineFixedAFourCoreRawCode_mem_FP : machineFixedAFourCoreRawCode ∈ FP := by - simpa only [machineFixedAFourCoreRawCode] using machineCompose_mem_FP + simpa only [machineFixedAFourCoreRawCode] using! machineCompose_mem_FP machineFixedAFourCoreInput_mem_FP machineDirectedFourCoreCostUpperRawCode_mem_FP @@ -225,7 +225,7 @@ theorem machineFixedACostPassesBit_mem_FP : machineFixedACostPassesBit ∈ FP := by have hinput := machinePair_mem_FP machineFixedAFourCoreRawCode_mem_FP (machineConst_mem_FP (rawRatBinaryCode rawExplicitKappa)) - simpa only [machineFixedACostPassesBit] using machineCompose_mem_FP hinput + simpa only [machineFixedACostPassesBit] using! machineCompose_mem_FP hinput machineRawRatLeBit_mem_FP theorem machineFixedACandidateBit_mem_FP : @@ -241,7 +241,7 @@ theorem machineFixedANextFound_mem_FP : machineFixedANextFound ∈ FP := by machineFixedACandidateBit_mem_FP have hbound := machineCompose_mem_FP machineFixedASource_mem_FP machineFixedAInputBound_mem_FP - simpa only [machineFixedANextFound] using machineTake_mem_FP hbound hdata + simpa only [machineFixedANextFound] using! machineTake_mem_FP hbound hdata theorem machineFixedAProcess_mem_FP : machineFixedAProcess ∈ FP := by have htail := machineCompose_mem_FP machineFixedARemaining_mem_FP @@ -251,7 +251,7 @@ theorem machineFixedAProcess_mem_FP : machineFixedAProcess ∈ FP := by machineFixedASource_mem_FP) theorem machineFixedAStep_mem_FP : machineFixedAStep ∈ FP := by - simpa only [machineFixedAStep] using machineIfEmpty_mem_FP + simpa only [machineFixedAStep] using! machineIfEmpty_mem_FP machineFixedARemaining_mem_FP id_mem_FP machineFixedAProcess_mem_FP theorem machineFixedAInit_mem_FP : machineFixedAInit ∈ FP := @@ -285,13 +285,13 @@ def MachineFixedAStateBound (word state : List Bool) : Prop := theorem machineFixedAInput_le_bound (word : List Bool) : word.length ≤ (machineFixedAInputBound word).length := by - simpa only [machineFixedAInputBound, machinePairFirst_pair] using + simpa only [machineFixedAInputBound, machinePairFirst_pair] using! machinePairFirst_length_le (pair word (machineFixedAColumnRange word)) theorem machineFixedARange_le_bound (word : List Bool) : (machineFixedAColumnRange word).length ≤ (machineFixedAInputBound word).length := by - simpa only [machineFixedAInputBound, machinePairSecond_pair] using + simpa only [machineFixedAInputBound, machinePairSecond_pair] using! machinePairSecond_length_le (pair word (machineFixedAColumnRange word)) theorem machineFixedA_one_le_bound (word : List Bool) : @@ -361,7 +361,7 @@ theorem machineFixedAFinalState_mem_FP : machineFixedAFinalState ∈ FP := by theorem machineFixedAEligibilityBit_mem_FP : machineFixedAEligibilityBit ∈ FP := by - simpa only [machineFixedAEligibilityBit] using machineCompose_mem_FP + simpa only [machineFixedAEligibilityBit] using! machineCompose_mem_FP machineFixedAFinalState_mem_FP machineFixedAFound_mem_FP /-! ## Exact inner-scan semantics -/ @@ -488,7 +488,7 @@ theorem machineFixedASemanticState_step {n : ℕ} (r s a : Fin n) (k : ℕ) (hk : k < n) : machineFixedAStep (machineFixedASemanticState X R C r s a k) = machineFixedASemanticState X R C r s a (k + 1) := by - have hklen : k < (List.finRange n).length := by simpa using hk + have hklen : k < (List.finRange n).length := by simpa using! hk rw [machineFixedASemanticState, List.drop_eq_getElem_cons hklen] rw [machineFixedAStep] @@ -504,7 +504,7 @@ theorem machineFixedASemanticState_step {n : ℕ} have hbound : 1 ≤ (machineFixedAInputBound (fixedAMachineInput X R C r s a)).length := machineFixedA_one_le_bound _ - rw [(List.take_eq_self_iff _).2 (by simpa using hbound)] + rw [(List.take_eq_self_iff _).2 (by simpa using! hbound)] rw [machineFixedASemanticState] apply congrArg (fun z : Bool ↦ machineFixedAPack @@ -622,37 +622,37 @@ theorem machineRowPairRest_mem_FP : machineRowPairRest ∈ FP := theorem machineRowPairSecondRowRuler_mem_FP : machineRowPairSecondRowRuler ∈ FP := by - simpa only [machineRowPairSecondRowRuler] using machineCompose_mem_FP + simpa only [machineRowPairSecondRowRuler] using! machineCompose_mem_FP machineRowPairRest_mem_FP machinePairFirst_mem_FP theorem machineRowPairOptimizerWord_mem_FP : machineRowPairOptimizerWord ∈ FP := by - simpa only [machineRowPairOptimizerWord] using machineCompose_mem_FP + simpa only [machineRowPairOptimizerWord] using! machineCompose_mem_FP machineRowPairRest_mem_FP machinePairSecond_mem_FP theorem machineRowPairDimensionRuler_mem_FP : machineRowPairDimensionRuler ∈ FP := by - simpa only [machineRowPairDimensionRuler] using machineCompose_mem_FP + simpa only [machineRowPairDimensionRuler] using! machineCompose_mem_FP machineRowPairOptimizerWord_mem_FP machineCertificateDimensionUnary_mem_FP theorem machineRowPairColumnRange_mem_FP : machineRowPairColumnRange ∈ FP := by - simpa only [machineRowPairColumnRange] using machineCompose_mem_FP + simpa only [machineRowPairColumnRange] using! machineCompose_mem_FP machineRowPairDimensionRuler_mem_FP machineUnaryRangeCode_mem_FP theorem machineRowPairScanRemaining_mem_FP : machineRowPairScanRemaining ∈ FP := machinePairFirst_mem_FP theorem machineRowPairScanFound_mem_FP : machineRowPairScanFound ∈ FP := by - simpa only [machineRowPairScanFound] using machineCompose_mem_FP + simpa only [machineRowPairScanFound] using! machineCompose_mem_FP machinePairSecond_mem_FP machinePairFirst_mem_FP theorem machineRowPairScanSource_mem_FP : machineRowPairScanSource ∈ FP := by - simpa only [machineRowPairScanSource] using machineCompose_mem_FP + simpa only [machineRowPairScanSource] using! machineCompose_mem_FP machinePairSecond_mem_FP machinePairSecond_mem_FP theorem machineRowPairCurrentFirstColumn_mem_FP : machineRowPairCurrentFirstColumn ∈ FP := by - simpa only [machineRowPairCurrentFirstColumn] using machineCompose_mem_FP + simpa only [machineRowPairCurrentFirstColumn] using! machineCompose_mem_FP machineRowPairScanRemaining_mem_FP machineListHead_mem_FP theorem machineRowPairFixedAInput_mem_FP : @@ -669,7 +669,7 @@ theorem machineRowPairFixedAInput_mem_FP : theorem machineRowPairCandidateBit_mem_FP : machineRowPairCandidateBit ∈ FP := by - simpa only [machineRowPairCandidateBit] using machineCompose_mem_FP + simpa only [machineRowPairCandidateBit] using! machineCompose_mem_FP machineRowPairFixedAInput_mem_FP machineFixedAEligibilityBit_mem_FP theorem machineRowPairInputBound_mem_FP : machineRowPairInputBound ∈ FP := @@ -680,7 +680,7 @@ theorem machineRowPairNextFound_mem_FP : machineRowPairNextFound ∈ FP := by machineRowPairCandidateBit_mem_FP have hbound := machineCompose_mem_FP machineRowPairScanSource_mem_FP machineRowPairInputBound_mem_FP - simpa only [machineRowPairNextFound] using machineTake_mem_FP hbound hdata + simpa only [machineRowPairNextFound] using! machineTake_mem_FP hbound hdata theorem machineRowPairProcess_mem_FP : machineRowPairProcess ∈ FP := by have htail := machineCompose_mem_FP machineRowPairScanRemaining_mem_FP @@ -690,7 +690,7 @@ theorem machineRowPairProcess_mem_FP : machineRowPairProcess ∈ FP := by machineRowPairScanSource_mem_FP) theorem machineRowPairScanStep_mem_FP : machineRowPairScanStep ∈ FP := by - simpa only [machineRowPairScanStep] using machineIfEmpty_mem_FP + simpa only [machineRowPairScanStep] using! machineIfEmpty_mem_FP machineRowPairScanRemaining_mem_FP id_mem_FP machineRowPairProcess_mem_FP theorem machineRowPairScanInit_mem_FP : machineRowPairScanInit ∈ FP := @@ -727,13 +727,13 @@ def MachineRowPairScanStateBound (word state : List Bool) : Prop := theorem machineRowPairInput_le_bound (word : List Bool) : word.length ≤ (machineRowPairInputBound word).length := by - simpa only [machineRowPairInputBound, machinePairFirst_pair] using + simpa only [machineRowPairInputBound, machinePairFirst_pair] using! machinePairFirst_length_le (pair word (machineRowPairColumnRange word)) theorem machineRowPairRange_le_bound (word : List Bool) : (machineRowPairColumnRange word).length ≤ (machineRowPairInputBound word).length := by - simpa only [machineRowPairInputBound, machinePairSecond_pair] using + simpa only [machineRowPairInputBound, machinePairSecond_pair] using! machinePairSecond_length_le (pair word (machineRowPairColumnRange word)) theorem machineRowPair_one_le_bound (word : List Bool) : @@ -808,7 +808,7 @@ theorem machineRowPairScanFinalState_mem_FP : theorem machineCertifiedRowPairEligibilityBit_mem_FP : machineCertifiedRowPairEligibilityBit ∈ FP := by - simpa only [machineCertifiedRowPairEligibilityBit] using + simpa only [machineCertifiedRowPairEligibilityBit] using! machineCompose_mem_FP machineRowPairScanFinalState_mem_FP machineRowPairScanFound_mem_FP @@ -886,7 +886,7 @@ theorem machineRowPairSemanticState_step {n : ℕ} (r s : Fin n) (k : ℕ) (hk : k < n) : machineRowPairScanStep (machineRowPairSemanticState X R C r s k) = machineRowPairSemanticState X R C r s (k + 1) := by - have hklen : k < (List.finRange n).length := by simpa using hk + have hklen : k < (List.finRange n).length := by simpa using! hk rw [machineRowPairSemanticState, List.drop_eq_getElem_cons hklen, machineRowPairScanStep] simp only [machineRowPairScanRemaining_pack] @@ -901,7 +901,7 @@ theorem machineRowPairSemanticState_step {n : ℕ} have hbound : 1 ≤ (machineRowPairInputBound (certifiedRowPairMachineInput X R C r s)).length := machineRowPair_one_le_bound _ - rw [(List.take_eq_self_iff _).2 (by simpa using hbound), + rw [(List.take_eq_self_iff _).2 (by simpa using! hbound), machineRowPairSemanticState] apply congrArg (fun z : Bool ↦ machineRowPairScanPack @@ -948,7 +948,7 @@ theorem certifiedRowPairEligibilityTest_eq_true_iff {n : ℕ} rw [certifiedFirstColumnTest, List.any_eq_true] at hinner obtain ⟨b, hb, htest⟩ := hinner refine ⟨a, b, ?_⟩ - simpa only [certifiedColumnPairTest, decide_eq_true_eq] using htest + simpa only [certifiedColumnPairTest, decide_eq_true_eq] using! htest · rintro ⟨a, b, hab, hcost⟩ refine ⟨a, by simp, ?_⟩ rw [certifiedFirstColumnTest, List.any_eq_true] diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineCompletedAlgorithm.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineCompletedAlgorithm.lean index 7b6113b600..ad1974e039 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineCompletedAlgorithm.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineCompletedAlgorithm.lean @@ -127,21 +127,21 @@ theorem machineCompletedDimensionLtTwoBit_mem_FP : machineCompletedDimensionLtTwoBit ∈ Complexity.FP := by have hpair := machinePair_mem_FP machineMatrixDimensionWord_mem_FP (machineConst_mem_FP (2 : ℕ).bits) - simpa only [machineCompletedDimensionLtTwoBit] using + simpa only [machineCompletedDimensionLtTwoBit] using! machineCompose_mem_FP hpair machineBinaryNatLtBit_mem_FP theorem machineCompletedSmoothedMatrixCode_mem_FP (χ : ℚ) : machineCompletedSmoothedMatrixCode χ ∈ Complexity.FP := by have hpair := machinePair_mem_FP (machineConst_mem_FP (rawRatBinaryCode (rawRatOfRat χ))) id_mem_FP - simpa only [machineCompletedSmoothedMatrixCode] using + simpa only [machineCompletedSmoothedMatrixCode] using! machineCompose_mem_FP hpair machineSmoothedMatrixCode_mem_FP theorem machineCompletedPositiveRawCode_mem_FP {positiveMachine : List Bool → List Bool} (hpositive : positiveMachine ∈ Complexity.FP) (χ : ℚ) : machineCompletedPositiveRawCode positiveMachine χ ∈ Complexity.FP := by - simpa only [machineCompletedPositiveRawCode] using + simpa only [machineCompletedPositiveRawCode] using! machineCompose_mem_FP (machineCompletedSmoothedMatrixCode_mem_FP χ) hpositive @@ -149,7 +149,7 @@ theorem machineCompletedDimensionRawCode_mem_FP (χ : ℚ) : machineCompletedDimensionRawCode χ ∈ Complexity.FP := by have hpair := machinePair_mem_FP (machineConst_mem_FP (rawRatBinaryCode (rawRatOfRat χ))) id_mem_FP - simpa only [machineCompletedDimensionRawCode] using + simpa only [machineCompletedDimensionRawCode] using! machineCompose_mem_FP hpair machineSmoothingDimensionRawCode_mem_FP theorem machineCompletedChiTimesDimensionRawCode_mem_FP (χ : ℚ) : @@ -157,7 +157,7 @@ theorem machineCompletedChiTimesDimensionRawCode_mem_FP (χ : ℚ) : have hpair := machinePair_mem_FP (machineConst_mem_FP (rawRatBinaryCode (rawRatOfRat χ))) (machineCompletedDimensionRawCode_mem_FP χ) - simpa only [machineCompletedChiTimesDimensionRawCode] using + simpa only [machineCompletedChiTimesDimensionRawCode] using! machineCompose_mem_FP hpair machineRawRatMulCode_mem_FP theorem machineCompletedHalfChiDimensionRawCode_mem_FP (χ : ℚ) : @@ -165,7 +165,7 @@ theorem machineCompletedHalfChiDimensionRawCode_mem_FP (χ : ℚ) : have hpair := machinePair_mem_FP (machineCompletedChiTimesDimensionRawCode_mem_FP χ) (machineConst_mem_FP (rawRatBinaryCode (RawRat.ofNat 2))) - simpa only [machineCompletedHalfChiDimensionRawCode] using + simpa only [machineCompletedHalfChiDimensionRawCode] using! machineCompose_mem_FP hpair machineRawRatDivCode_mem_FP theorem machineCompletedCorrectionRawCode_mem_FP (χ : ℚ) : @@ -173,7 +173,7 @@ theorem machineCompletedCorrectionRawCode_mem_FP (χ : ℚ) : have hpair := machinePair_mem_FP (machineConst_mem_FP (rawRatBinaryCode RawRat.one)) (machineCompletedHalfChiDimensionRawCode_mem_FP χ) - simpa only [machineCompletedCorrectionRawCode] using + simpa only [machineCompletedCorrectionRawCode] using! machineCompose_mem_FP hpair machineRawRatAddCode_mem_FP theorem machineCompletedLargeNumeratorRawCode_mem_FP @@ -184,7 +184,7 @@ theorem machineCompletedLargeNumeratorRawCode_mem_FP have hpair := machinePair_mem_FP machineMatrixNormalizationScalePowerRawCode_mem_FP (machineCompletedPositiveRawCode_mem_FP hpositive χ) - simpa only [machineCompletedLargeNumeratorRawCode] using + simpa only [machineCompletedLargeNumeratorRawCode] using! machineCompose_mem_FP hpair machineRawRatMulCode_mem_FP theorem machineCompletedLargeRawCode_mem_FP @@ -194,14 +194,14 @@ theorem machineCompletedLargeRawCode_mem_FP have hpair := machinePair_mem_FP (machineCompletedLargeNumeratorRawCode_mem_FP hpositive χ) (machineCompletedCorrectionRawCode_mem_FP χ) - simpa only [machineCompletedLargeRawCode] using + simpa only [machineCompletedLargeRawCode] using! machineCompose_mem_FP hpair machineRawRatDivCode_mem_FP theorem machineCompletedLargeCode_mem_FP {positiveMachine : List Bool → List Bool} (hpositive : positiveMachine ∈ Complexity.FP) (χ : ℚ) : machineCompletedLargeCode positiveMachine χ ∈ Complexity.FP := by - simpa only [machineCompletedLargeCode] using + simpa only [machineCompletedLargeCode] using! machineCompose_mem_FP (machineCompletedLargeRawCode_mem_FP hpositive χ) machineNormalizeRawRatBinaryCode_mem_FP diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedAffineGradientEntry.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedAffineGradientEntry.lean index e72c718282..2b4ffee3c0 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedAffineGradientEntry.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedAffineGradientEntry.lean @@ -108,25 +108,25 @@ theorem machineDirectedAffineGradientEntryRest_mem_FP : theorem machineDirectedAffineGradientEntryColumn_mem_FP : machineDirectedAffineGradientEntryColumn ∈ FP := by - simpa only [machineDirectedAffineGradientEntryColumn] using + simpa only [machineDirectedAffineGradientEntryColumn] using! machineCompose_mem_FP machineDirectedAffineGradientEntryRest_mem_FP machinePairFirst_mem_FP theorem machineDirectedAffineGradientEntryPayload_mem_FP : machineDirectedAffineGradientEntryPayload ∈ FP := by - simpa only [machineDirectedAffineGradientEntryPayload] using + simpa only [machineDirectedAffineGradientEntryPayload] using! machineCompose_mem_FP machineDirectedAffineGradientEntryRest_mem_FP machinePairSecond_mem_FP theorem machineDirectedAffineGradientEntryDimension_mem_FP : machineDirectedAffineGradientEntryDimension ∈ FP := by - simpa only [machineDirectedAffineGradientEntryDimension] using + simpa only [machineDirectedAffineGradientEntryDimension] using! machineCompose_mem_FP machineDirectedAffineGradientEntryPayload_mem_FP machineDirectedObjectiveSumDimension_mem_FP theorem machineDirectedAffineGradientUpperLeftInput_mem_FP : machineDirectedAffineGradientUpperLeftInput ∈ FP := by - simpa only [machineDirectedAffineGradientUpperLeftInput] using + simpa only [machineDirectedAffineGradientUpperLeftInput] using! (Complexity.id_mem_FP : (fun x : List Bool => x) ∈ FP) theorem machineDirectedAffineGradientUpperRightInput_mem_FP : @@ -149,25 +149,25 @@ theorem machineDirectedAffineGradientLowerRightInput_mem_FP : theorem machineDirectedAffineGradientUpperLeftRaw_mem_FP : machineDirectedAffineGradientUpperLeftRaw ∈ FP := by - simpa only [machineDirectedAffineGradientUpperLeftRaw] using + simpa only [machineDirectedAffineGradientUpperLeftRaw] using! machineCompose_mem_FP machineDirectedAffineGradientUpperLeftInput_mem_FP machineDirectedNegativeGradientEntryRawCode_mem_FP theorem machineDirectedAffineGradientUpperRightRaw_mem_FP : machineDirectedAffineGradientUpperRightRaw ∈ FP := by - simpa only [machineDirectedAffineGradientUpperRightRaw] using + simpa only [machineDirectedAffineGradientUpperRightRaw] using! machineCompose_mem_FP machineDirectedAffineGradientUpperRightInput_mem_FP machineDirectedNegativeGradientEntryRawCode_mem_FP theorem machineDirectedAffineGradientLowerLeftRaw_mem_FP : machineDirectedAffineGradientLowerLeftRaw ∈ FP := by - simpa only [machineDirectedAffineGradientLowerLeftRaw] using + simpa only [machineDirectedAffineGradientLowerLeftRaw] using! machineCompose_mem_FP machineDirectedAffineGradientLowerLeftInput_mem_FP machineDirectedNegativeGradientEntryRawCode_mem_FP theorem machineDirectedAffineGradientLowerRightRaw_mem_FP : machineDirectedAffineGradientLowerRightRaw ∈ FP := by - simpa only [machineDirectedAffineGradientLowerRightRaw] using + simpa only [machineDirectedAffineGradientLowerRightRaw] using! machineCompose_mem_FP machineDirectedAffineGradientLowerRightInput_mem_FP machineDirectedNegativeGradientEntryRawCode_mem_FP @@ -176,7 +176,7 @@ theorem machineDirectedAffineGradientFirstDifference_mem_FP : have hinput := machinePair_mem_FP machineDirectedAffineGradientUpperLeftRaw_mem_FP machineDirectedAffineGradientUpperRightRaw_mem_FP - simpa only [machineDirectedAffineGradientFirstDifference] using + simpa only [machineDirectedAffineGradientFirstDifference] using! machineCompose_mem_FP hinput machineRawRatSubCode_mem_FP theorem machineDirectedAffineGradientSecondDifference_mem_FP : @@ -184,7 +184,7 @@ theorem machineDirectedAffineGradientSecondDifference_mem_FP : have hinput := machinePair_mem_FP machineDirectedAffineGradientFirstDifference_mem_FP machineDirectedAffineGradientLowerLeftRaw_mem_FP - simpa only [machineDirectedAffineGradientSecondDifference] using + simpa only [machineDirectedAffineGradientSecondDifference] using! machineCompose_mem_FP hinput machineRawRatSubCode_mem_FP theorem machineDirectedAffineGradientEntryRawCode_mem_FP : @@ -192,7 +192,7 @@ theorem machineDirectedAffineGradientEntryRawCode_mem_FP : have hinput := machinePair_mem_FP machineDirectedAffineGradientSecondDifference_mem_FP machineDirectedAffineGradientLowerRightRaw_mem_FP - simpa only [machineDirectedAffineGradientEntryRawCode] using + simpa only [machineDirectedAffineGradientEntryRawCode] using! machineCompose_mem_FP hinput machineRawRatAddCode_mem_FP def machineDirectedAffineGradientEntryCanonicalWord {m : ℕ} diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedAffineGradientVector.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedAffineGradientVector.lean index 74eaa381c1..458b8af7e4 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedAffineGradientVector.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedAffineGradientVector.lean @@ -26,7 +26,7 @@ def machineDirectedAffineGradientEntryCode (word : List Bool) : List Bool := theorem machineDirectedAffineGradientEntryCode_mem_FP : machineDirectedAffineGradientEntryCode ∈ FP := by - simpa only [machineDirectedAffineGradientEntryCode] using + simpa only [machineDirectedAffineGradientEntryCode] using! machineCompose_mem_FP machineDirectedAffineGradientEntryRawCode_mem_FP machineNormalizeRawRatEntryCode_mem_FP @@ -71,7 +71,7 @@ theorem machineDirectedAffineGradientVectorCode_mem_FP : machineDirectedAffineGradientVectorCode ∈ FP := by have hgenerator := machineUnaryGridGeneratorCode_mem_FP machineDirectedAffineGradientEntryCode_mem_FP - simpa only [machineDirectedAffineGradientVectorCode] using + simpa only [machineDirectedAffineGradientVectorCode] using! machineCompose_mem_FP machineDirectedAffineGradientVectorGeneratorInput_mem_FP hgenerator @@ -147,7 +147,7 @@ theorem rawDirectedNegativeGradientLower_width_le omega simp only [rawDirectedGradientCoordinateWidthBudget] simpa only [rawDirectedNegativeGradientLower, rawTau, logA, logX, - logComplement] using htotal' + logComplement] using! htotal' theorem rawDirectedNegativeGradientEntry_width_le_word_budget {m : ℕ} (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) @@ -169,7 +169,7 @@ theorem rawDirectedNegativeGradientEntry_width_le_word_budget {m : ℕ} rawDirectedObjectiveSum_A_width_le_word tau A y p i j have hx : rawRatWidth (rawRatOfRat x) ≤ WX := by simpa only [x, WX, L, - rawDirectedObjectiveCoordinateWordXBudget] using + rawDirectedObjectiveCoordinateWordXBudget] using! rawBetheAffineMatrixQ_width_le_word tau A y p i j have hc0 := rawRatWidth_complement_le x have hc : rawRatWidth (rawRatOfRat (1 - x)) ≤ WC := by @@ -224,7 +224,7 @@ theorem rawDirectedAffineGradientEntry_width_le_word_budget {m : ℕ} (((G a.castSucc b.castSucc).sub (G a.castSucc (Fin.last m))).sub (G (Fin.last m) b.castSucc)) (G (Fin.last m) (Fin.last m)) - simpa only [rawDirectedAffineGradientEntry, G, B] using hadd.trans (by omega) + simpa only [rawDirectedAffineGradientEntry, G, B] using! hadd.trans (by omega) theorem directedAffineGradient_entry_code_length_le {m : ℕ} (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) @@ -267,7 +267,7 @@ theorem directedAffineGradient_vector_code_length_le_bound {m : ℕ} pair_length, List.length_replicate] omega have hB : B ≤ T ^ 20 := by - simpa only [B, T] using + simpa only [B, T] using! rawDirectedObjectiveCoordinateWordBudget_le_pow hmL have hE : E ≤ 316 * T ^ 20 := by have hpow : 1 ≤ T ^ 20 := one_le_pow₀ (by simp [T]) @@ -279,7 +279,7 @@ theorem directedAffineGradient_vector_code_length_le_bound {m : ℕ} obtain ⟨k, rfl⟩ := List.mem_ofFn.mp hq let ij := finProdFinEquiv.symm k simpa only [directedAffineGradientVector, squareMatrixToVector, ij, E, - B, L, word] using + B, L, word] using! directedAffineGradient_entry_code_length_le tau A y p ij.1 ij.2 have hsum := List.sum_le_card_nsmul ((List.ofFn (directedAffineGradientVector tau A y p)).map @@ -321,7 +321,7 @@ theorem directedAffineGradient_vector_code_length_le_bound {m : ℕ} rw [machineDirectedAffineGradientVectorBound, machineIteratedBinaryWidth_length] exact hpower.trans (by - simpa only [T, L, word] using + simpa only [T, L, word] using! certificateExpGuardWidth_pow_lower 5 (machineDirectedObjectiveSumCanonicalWord tau A y p).length) @@ -358,13 +358,13 @@ theorem unaryGridValues_directedAffineGradient {m : ℕ} rationalEntryBinaryCode (f a b) := by intro a b simpa only [payload, f, - machineDirectedAffineGradientEntryCanonicalWord] using + machineDirectedAffineGradientEntryCanonicalWord] using! machineDirectedAffineGradientEntryCode_encode tau A y p a b have hbound : (binaryListCode rationalEntryBinaryCode (unaryGridValues f)).length ≤ bound.length := by rw [unaryGridValues_directedAffineGradient] - simpa only [rationalFiniteVectorCode, f, bound, payload] using + simpa only [rationalFiniteVectorCode, f, bound, payload] using! directedAffineGradient_vector_code_length_le_bound tau A y p rw [machineUnaryGridGeneratorCode_encode_of_bound machineDirectedAffineGradientEntryCode f bound payload hentry hbound, diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedEpigraphNormal.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedEpigraphNormal.lean index dc86a665b8..51af551577 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedEpigraphNormal.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedEpigraphNormal.lean @@ -35,7 +35,7 @@ theorem machineDirectedEpigraphNormalSnocInput_mem_FP : theorem machineDirectedEpigraphNormalVectorCode_mem_FP : machineDirectedEpigraphNormalVectorCode ∈ FP := by - simpa only [machineDirectedEpigraphNormalVectorCode] using + simpa only [machineDirectedEpigraphNormalVectorCode] using! machineCompose_mem_FP machineDirectedEpigraphNormalSnocInput_mem_FP machineBinaryListSnoc_mem_FP @@ -75,7 +75,7 @@ theorem ofFn_directedEpigraphNormal {m : ℕ} (machineDirectedObjectiveSumCanonicalWord tau A y p) = rationalFiniteVectorCode (epigraphNormal ((betheDirectedEpigraphData tau A p).gradient y)) := by - simpa only [betheDirectedEpigraphData, directedAffineGradientVector] using + simpa only [betheDirectedEpigraphData, directedAffineGradientVector] using! machineDirectedEpigraphNormalVectorCode_encode tau A y p end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedLog.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedLog.lean index f3092affcf..a58b6a02da 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedLog.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedLog.lean @@ -94,14 +94,14 @@ theorem machineDirectedLogParameterNumeratorCode_mem_FP : have hnegOne : (fun _ : List Bool => machineRawRatNegCode rawRatOneCode) ∈ Complexity.FP := machineConst_mem_FP _ have hpair := machinePair_mem_FP machineDirectedLogArgumentCode_mem_FP hnegOne - simpa only [machineDirectedLogParameterNumeratorCode] using + simpa only [machineDirectedLogParameterNumeratorCode] using! machineCompose_mem_FP hpair machineRawRatAddCode_mem_FP theorem machineDirectedLogParameterDenominatorCode_mem_FP : machineDirectedLogParameterDenominatorCode ∈ Complexity.FP := by have hpair := machinePair_mem_FP machineDirectedLogArgumentCode_mem_FP (machineConst_mem_FP rawRatOneCode) - simpa only [machineDirectedLogParameterDenominatorCode] using + simpa only [machineDirectedLogParameterDenominatorCode] using! machineCompose_mem_FP hpair machineRawRatAddCode_mem_FP theorem machineDirectedLogParameterCode_mem_FP : @@ -109,42 +109,42 @@ theorem machineDirectedLogParameterCode_mem_FP : have hpair := machinePair_mem_FP machineDirectedLogParameterNumeratorCode_mem_FP machineDirectedLogParameterDenominatorCode_mem_FP - simpa only [machineDirectedLogParameterCode] using + simpa only [machineDirectedLogParameterCode] using! machineCompose_mem_FP hpair machineRawRatDivCode_mem_FP theorem machineDirectedLogSeriesSumCode_mem_FP : machineDirectedLogSeriesSumCode ∈ Complexity.FP := by have hpair := machinePair_mem_FP machineDirectedLogRuler_mem_FP machineDirectedLogParameterCode_mem_FP - simpa only [machineDirectedLogSeriesSumCode] using + simpa only [machineDirectedLogSeriesSumCode] using! machineCompose_mem_FP hpair machineRawRationalLogSeriesSumCode_mem_FP theorem machineDirectedLogUnitLowerRawCode_mem_FP : machineDirectedLogUnitLowerRawCode ∈ Complexity.FP := by have hpair := machinePair_mem_FP (machineConst_mem_FP rawRatTwoCode) machineDirectedLogSeriesSumCode_mem_FP - simpa only [machineDirectedLogUnitLowerRawCode] using + simpa only [machineDirectedLogUnitLowerRawCode] using! machineCompose_mem_FP hpair machineRawRatMulCode_mem_FP theorem machineDirectedLogOddPowerRuler_mem_FP : machineDirectedLogOddPowerRuler ∈ Complexity.FP := by have hdouble := machineAppend_mem_FP machineDirectedLogRuler_mem_FP machineDirectedLogRuler_mem_FP - simpa only [machineDirectedLogOddPowerRuler] using + simpa only [machineDirectedLogOddPowerRuler] using! machineCompose_mem_FP hdouble (machinePrepend_mem_FP true) theorem machineDirectedLogOddPowerCode_mem_FP : machineDirectedLogOddPowerCode ∈ Complexity.FP := by have hpair := machinePair_mem_FP machineDirectedLogOddPowerRuler_mem_FP machineDirectedLogParameterCode_mem_FP - simpa only [machineDirectedLogOddPowerCode] using + simpa only [machineDirectedLogOddPowerCode] using! machineCompose_mem_FP hpair machineRawRatPowerCode_mem_FP theorem machineDirectedLogParameterSquareCode_mem_FP : machineDirectedLogParameterSquareCode ∈ Complexity.FP := by have hpair := machinePair_mem_FP machineDirectedLogParameterCode_mem_FP machineDirectedLogParameterCode_mem_FP - simpa only [machineDirectedLogParameterSquareCode] using + simpa only [machineDirectedLogParameterSquareCode] using! machineCompose_mem_FP hpair machineRawRatMulCode_mem_FP theorem machineDirectedLogErrorDenominatorCode_mem_FP : @@ -152,7 +152,7 @@ theorem machineDirectedLogErrorDenominatorCode_mem_FP : have hneg := machineCompose_mem_FP machineDirectedLogParameterSquareCode_mem_FP machineRawRatNegCode_mem_FP have hpair := machinePair_mem_FP (machineConst_mem_FP rawRatOneCode) hneg - simpa only [machineDirectedLogErrorDenominatorCode] using + simpa only [machineDirectedLogErrorDenominatorCode] using! machineCompose_mem_FP hpair machineRawRatAddCode_mem_FP theorem machineDirectedLogSeriesErrorCode_mem_FP : @@ -161,14 +161,14 @@ theorem machineDirectedLogSeriesErrorCode_mem_FP : machineDirectedLogErrorDenominatorCode_mem_FP have hratio := machineCompose_mem_FP hratioPair machineRawRatDivCode_mem_FP have hpair := machinePair_mem_FP (machineConst_mem_FP rawRatTwoCode) hratio - simpa only [machineDirectedLogSeriesErrorCode] using + simpa only [machineDirectedLogSeriesErrorCode] using! machineCompose_mem_FP hpair machineRawRatMulCode_mem_FP theorem machineDirectedLogUnitUpperRawCode_mem_FP : machineDirectedLogUnitUpperRawCode ∈ Complexity.FP := by have hpair := machinePair_mem_FP machineDirectedLogUnitLowerRawCode_mem_FP machineDirectedLogSeriesErrorCode_mem_FP - simpa only [machineDirectedLogUnitUpperRawCode] using + simpa only [machineDirectedLogUnitUpperRawCode] using! machineCompose_mem_FP hpair machineRawRatAddCode_mem_FP /-! ## Dyadic range reduction -/ @@ -278,36 +278,36 @@ theorem machineDirectedLogNumeratorAbsBits_mem_FP : machineDirectedLogNumeratorAbsBits ∈ Complexity.FP := by have hnum := machineCompose_mem_FP machineDirectedLogArgumentCode_mem_FP machinePairFirst_mem_FP - simpa only [machineDirectedLogNumeratorAbsBits] using + simpa only [machineDirectedLogNumeratorAbsBits] using! machineCompose_mem_FP hnum machineIntegerNatAbsBits_mem_FP theorem machineDirectedLogDenominatorBits_mem_FP : machineDirectedLogDenominatorBits ∈ Complexity.FP := by - simpa only [machineDirectedLogDenominatorBits] using + simpa only [machineDirectedLogDenominatorBits] using! machineCompose_mem_FP machineDirectedLogArgumentCode_mem_FP machinePairSecond_mem_FP theorem machineDirectedLogNumeratorLogRuler_mem_FP : machineDirectedLogNumeratorLogRuler ∈ Complexity.FP := by - simpa only [machineDirectedLogNumeratorLogRuler] using + simpa only [machineDirectedLogNumeratorLogRuler] using! machineCompose_mem_FP machineDirectedLogNumeratorAbsBits_mem_FP machineTail_mem_FP theorem machineDirectedLogDenominatorLogRuler_mem_FP : machineDirectedLogDenominatorLogRuler ∈ Complexity.FP := by - simpa only [machineDirectedLogDenominatorLogRuler] using + simpa only [machineDirectedLogDenominatorLogRuler] using! machineCompose_mem_FP machineDirectedLogDenominatorBits_mem_FP machineTail_mem_FP theorem machineDirectedLogNumeratorLogBits_mem_FP : machineDirectedLogNumeratorLogBits ∈ Complexity.FP := by - simpa only [machineDirectedLogNumeratorLogBits] using + simpa only [machineDirectedLogNumeratorLogBits] using! machineCompose_mem_FP machineDirectedLogNumeratorLogRuler_mem_FP machineLengthBits_mem_FP theorem machineDirectedLogDenominatorLogBits_mem_FP : machineDirectedLogDenominatorLogBits ∈ Complexity.FP := by - simpa only [machineDirectedLogDenominatorLogBits] using + simpa only [machineDirectedLogDenominatorLogBits] using! machineCompose_mem_FP machineDirectedLogDenominatorLogRuler_mem_FP machineLengthBits_mem_FP @@ -319,7 +319,7 @@ theorem machineDirectedLogExponentIntegerCode_mem_FP : machineDirectedLogDenominatorLogBits_mem_FP (machinePrepend_mem_FP false) have hden := machineCompose_mem_FP hdenNat machineIntegerNegCode_mem_FP have hpair := machinePair_mem_FP hnum hden - simpa only [machineDirectedLogExponentIntegerCode] using + simpa only [machineDirectedLogExponentIntegerCode] using! machineCompose_mem_FP hpair machineIntegerAddCode_mem_FP theorem machineDirectedLogPowerTwoBits_mem_FP : @@ -327,7 +327,7 @@ theorem machineDirectedLogPowerTwoBits_mem_FP : have hzero := machineZeroBlock_mem_FP have hone : (fun _ : List Bool => [true]) ∈ Complexity.FP := machineConst_mem_FP [true] - simpa only [machineDirectedLogPowerTwoBits] using + simpa only [machineDirectedLogPowerTwoBits] using! machineAppend_mem_FP hzero hone theorem machineDirectedLogScaleCode_mem_FP : @@ -345,21 +345,21 @@ theorem machineDirectedLogResidualCode_mem_FP : machineDirectedLogResidualCode ∈ Complexity.FP := by have hpair := machinePair_mem_FP machineDirectedLogArgumentCode_mem_FP machineDirectedLogScaleCode_mem_FP - simpa only [machineDirectedLogResidualCode] using + simpa only [machineDirectedLogResidualCode] using! machineCompose_mem_FP hpair machineRawRatDivCode_mem_FP theorem machineDirectedLogResidualAtLeastOne_mem_FP : machineDirectedLogResidualAtLeastOne ∈ Complexity.FP := by have hpair := machinePair_mem_FP (machineConst_mem_FP rawRatOneCode) machineDirectedLogResidualCode_mem_FP - simpa only [machineDirectedLogResidualAtLeastOne] using + simpa only [machineDirectedLogResidualAtLeastOne] using! machineCompose_mem_FP hpair machineRawRatLeBit_mem_FP theorem machineDirectedLogUnitCode_mem_FP : machineDirectedLogUnitCode ∈ Complexity.FP := by have hinv := machineCompose_mem_FP machineDirectedLogResidualCode_mem_FP machineRawRatInvCode_mem_FP - simpa only [machineDirectedLogUnitCode] using + simpa only [machineDirectedLogUnitCode] using! machineIfHead_mem_FP machineDirectedLogResidualAtLeastOne_mem_FP machineDirectedLogResidualCode_mem_FP hinv @@ -389,7 +389,7 @@ theorem machineDirectedLogIntegerLowerCode_mem_FP : have hfactor := machineIfHead_mem_FP hsign hhi hlo have hpair := machinePair_mem_FP machineDirectedLogExponentRawRatCode_mem_FP hfactor - simpa only [machineDirectedLogIntegerLowerCode] using + simpa only [machineDirectedLogIntegerLowerCode] using! machineCompose_mem_FP hpair machineRawRatMulCode_mem_FP theorem machineDirectedLogIntegerUpperCode_mem_FP : @@ -403,7 +403,7 @@ theorem machineDirectedLogIntegerUpperCode_mem_FP : have hfactor := machineIfHead_mem_FP hsign hlo hhi have hpair := machinePair_mem_FP machineDirectedLogExponentRawRatCode_mem_FP hfactor - simpa only [machineDirectedLogIntegerUpperCode] using + simpa only [machineDirectedLogIntegerUpperCode] using! machineCompose_mem_FP hpair machineRawRatMulCode_mem_FP theorem machineDirectedLogResidualLowerCode_mem_FP : @@ -413,7 +413,7 @@ theorem machineDirectedLogResidualLowerCode_mem_FP : have hhi := machineCompose_mem_FP machineDirectedLogUnitInput_mem_FP machineDirectedLogUnitUpperRawCode_mem_FP have hnegHi := machineCompose_mem_FP hhi machineRawRatNegCode_mem_FP - simpa only [machineDirectedLogResidualLowerCode] using + simpa only [machineDirectedLogResidualLowerCode] using! machineIfHead_mem_FP machineDirectedLogResidualAtLeastOne_mem_FP hlo hnegHi @@ -424,7 +424,7 @@ theorem machineDirectedLogResidualUpperCode_mem_FP : have hhi := machineCompose_mem_FP machineDirectedLogUnitInput_mem_FP machineDirectedLogUnitUpperRawCode_mem_FP have hnegLo := machineCompose_mem_FP hlo machineRawRatNegCode_mem_FP - simpa only [machineDirectedLogResidualUpperCode] using + simpa only [machineDirectedLogResidualUpperCode] using! machineIfHead_mem_FP machineDirectedLogResidualAtLeastOne_mem_FP hhi hnegLo @@ -432,25 +432,25 @@ theorem machineDirectedLogLowerRawCode_mem_FP : machineDirectedLogLowerRawCode ∈ Complexity.FP := by have hpair := machinePair_mem_FP machineDirectedLogIntegerLowerCode_mem_FP machineDirectedLogResidualLowerCode_mem_FP - simpa only [machineDirectedLogLowerRawCode] using + simpa only [machineDirectedLogLowerRawCode] using! machineCompose_mem_FP hpair machineRawRatAddCode_mem_FP theorem machineDirectedLogUpperRawCode_mem_FP : machineDirectedLogUpperRawCode ∈ Complexity.FP := by have hpair := machinePair_mem_FP machineDirectedLogIntegerUpperCode_mem_FP machineDirectedLogResidualUpperCode_mem_FP - simpa only [machineDirectedLogUpperRawCode] using + simpa only [machineDirectedLogUpperRawCode] using! machineCompose_mem_FP hpair machineRawRatAddCode_mem_FP theorem machineDirectedLogLowerCode_mem_FP : machineDirectedLogLowerCode ∈ Complexity.FP := by - simpa only [machineDirectedLogLowerCode] using + simpa only [machineDirectedLogLowerCode] using! machineCompose_mem_FP machineDirectedLogLowerRawCode_mem_FP machineNormalizeRawRatBinaryCode_mem_FP theorem machineDirectedLogUpperCode_mem_FP : machineDirectedLogUpperCode ∈ Complexity.FP := by - simpa only [machineDirectedLogUpperCode] using + simpa only [machineDirectedLogUpperCode] using! machineCompose_mem_FP machineDirectedLogUpperRawCode_mem_FP machineNormalizeRawRatBinaryCode_mem_FP @@ -598,14 +598,14 @@ theorem machineDirectedLogOddPowerRuler_encode machineDirectedLogUnitLowerRawCode (pair (List.replicate N true) rawRatTwoCode) = rawRatBinaryCode (RawRat.logUnitLower (RawRat.ofNat 2) N) := by - simpa only [rawRatTwoCode] using + simpa only [rawRatTwoCode] using! machineDirectedLogUnitLowerRawCode_encode (RawRat.ofNat 2) N @[simp] theorem machineDirectedLogTwoUpperRawCode_encode (N : ℕ) : machineDirectedLogUnitUpperRawCode (pair (List.replicate N true) rawRatTwoCode) = rawRatBinaryCode (RawRat.logUnitUpper (RawRat.ofNat 2) N) := by - simpa only [rawRatTwoCode] using + simpa only [rawRatTwoCode] using! machineDirectedLogUnitUpperRawCode_encode (RawRat.ofNat 2) N private theorem directedLogPowerTwoBits_value : ∀ k : ℕ, @@ -716,11 +716,11 @@ def logUnit (q : ℚ) : RawRat := (logUnit q).value = binaryRationalLogUnit q := by rw [logUnit, binaryRationalLogUnit] by_cases h : binaryRationalBinaryResidual q < 1 - · have hnot : ¬ 1 ≤ (logResidual q).value := by simpa using h + · have hnot : ¬ 1 ≤ (logResidual q).value := by simpa using! h rw [ite_eq_left ((binaryRatLt_eq_true_iff _ _).2 h), ite_eq_right hnot] simp [binaryRatInv_eq_inv] · have hle : 1 ≤ (logResidual q).value := by - simpa using (le_of_not_gt h) + simpa using! (le_of_not_gt h) have hflag : ¬ binaryRatLt (binaryRationalBinaryResidual q) 1 = true := fun htrue => h ((binaryRatLt_eq_true_iff _ _).1 htrue) rw [ite_eq_right hflag, ite_eq_left hle] @@ -833,16 +833,16 @@ def logUpper (q : ℚ) (N : ℕ) : RawRat := else binaryDirectedLogUnitLower (binaryRationalLogUnit q) N := by rw [logResidualLower] by_cases h : binaryRationalBinaryResidual q < 1 - · have hnot : ¬ 1 ≤ (logResidual q).value := by simpa using h + · have hnot : ¬ 1 ≤ (logResidual q).value := by simpa using! h rw [ite_eq_right hnot, ite_eq_left ((binaryRatLt_eq_true_iff _ _).2 h)] simp [binaryRatNeg_eq_neg] · have hle : 1 ≤ (logResidual q).value := by - simpa using (le_of_not_gt h) + simpa using! (le_of_not_gt h) have hflag : ¬ binaryRatLt (binaryRationalBinaryResidual q) 1 = true := fun htrue => h ((binaryRatLt_eq_true_iff _ _).1 htrue) rw [ite_eq_left hle, ite_eq_right hflag] - simpa only [value_logUnit] using value_logUnitLower (logUnit q) N + simpa only [value_logUnit] using! value_logUnitLower (logUnit q) N @[simp] theorem value_logResidualUpper (q : ℚ) (N : ℕ) : (logResidualUpper q N).value = @@ -851,16 +851,16 @@ def logUpper (q : ℚ) (N : ℕ) : RawRat := else binaryDirectedLogUnitUpper (binaryRationalLogUnit q) N := by rw [logResidualUpper] by_cases h : binaryRationalBinaryResidual q < 1 - · have hnot : ¬ 1 ≤ (logResidual q).value := by simpa using h + · have hnot : ¬ 1 ≤ (logResidual q).value := by simpa using! h rw [ite_eq_right hnot, ite_eq_left ((binaryRatLt_eq_true_iff _ _).2 h)] simp [binaryRatNeg_eq_neg] · have hle : 1 ≤ (logResidual q).value := by - simpa using (le_of_not_gt h) + simpa using! (le_of_not_gt h) have hflag : ¬ binaryRatLt (binaryRationalBinaryResidual q) 1 = true := fun htrue => h ((binaryRatLt_eq_true_iff _ _).1 htrue) rw [ite_eq_left hle, ite_eq_right hflag] - simpa only [value_logUnit] using value_logUnitUpper (logUnit q) N + simpa only [value_logUnit] using! value_logUnitUpper (logUnit q) N @[simp] theorem value_logLower (q : ℚ) (N : ℕ) : (logLower q N).value = binaryDirectedLogLower q N := by diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedNegativeGradientCoordinate.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedNegativeGradientCoordinate.lean index 17087ec235..d232a52d68 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedNegativeGradientCoordinate.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedNegativeGradientCoordinate.lean @@ -65,7 +65,7 @@ def machineDirectedNegativeGradientLowerRawCode theorem machineDirectedGradientCoordinateNegLogA_mem_FP : machineDirectedGradientCoordinateNegLogA ∈ FP := by - simpa only [machineDirectedGradientCoordinateNegLogA] using + simpa only [machineDirectedGradientCoordinateNegLogA] using! machineCompose_mem_FP machineDirectedObjectiveCoordinateLogAUpper_mem_FP machineRawRatNegCode_mem_FP @@ -74,12 +74,12 @@ theorem machineDirectedGradientCoordinateScaledLogX_mem_FP : have hinput := machinePair_mem_FP machineDirectedObjectiveCoordinateOnePlusTau_mem_FP machineDirectedObjectiveCoordinateLogXLower_mem_FP - simpa only [machineDirectedGradientCoordinateScaledLogX] using + simpa only [machineDirectedGradientCoordinateScaledLogX] using! machineCompose_mem_FP hinput machineRawRatMulCode_mem_FP theorem machineDirectedGradientCoordinateLogComplementLower_mem_FP : machineDirectedGradientCoordinateLogComplementLower ∈ FP := by - simpa only [machineDirectedGradientCoordinateLogComplementLower] using + simpa only [machineDirectedGradientCoordinateLogComplementLower] using! machineCompose_mem_FP machineDirectedObjectiveCoordinateLogComplementInput_mem_FP machineScheduledLogLowerRawCode_mem_FP @@ -89,7 +89,7 @@ theorem machineDirectedGradientCoordinateFirstTwo_mem_FP : have hinput := machinePair_mem_FP machineDirectedGradientCoordinateNegLogA_mem_FP machineDirectedGradientCoordinateScaledLogX_mem_FP - simpa only [machineDirectedGradientCoordinateFirstTwo] using + simpa only [machineDirectedGradientCoordinateFirstTwo] using! machineCompose_mem_FP hinput machineRawRatAddCode_mem_FP theorem machineDirectedGradientCoordinateFirstThree_mem_FP : @@ -97,7 +97,7 @@ theorem machineDirectedGradientCoordinateFirstThree_mem_FP : have hinput := machinePair_mem_FP machineDirectedGradientCoordinateFirstTwo_mem_FP machineDirectedGradientCoordinateLogComplementLower_mem_FP - simpa only [machineDirectedGradientCoordinateFirstThree] using + simpa only [machineDirectedGradientCoordinateFirstThree] using! machineCompose_mem_FP hinput machineRawRatAddCode_mem_FP theorem machineDirectedGradientCoordinateTwoPlusTau_mem_FP : @@ -105,7 +105,7 @@ theorem machineDirectedGradientCoordinateTwoPlusTau_mem_FP : have hinput := machinePair_mem_FP (machineConst_mem_FP (rawRatBinaryCode RawRat.one)) machineDirectedObjectiveCoordinateOnePlusTau_mem_FP - simpa only [machineDirectedGradientCoordinateTwoPlusTau] using + simpa only [machineDirectedGradientCoordinateTwoPlusTau] using! machineCompose_mem_FP hinput machineRawRatAddCode_mem_FP theorem machineDirectedNegativeGradientLowerRawCode_mem_FP : @@ -113,7 +113,7 @@ theorem machineDirectedNegativeGradientLowerRawCode_mem_FP : have hinput := machinePair_mem_FP machineDirectedGradientCoordinateFirstThree_mem_FP machineDirectedGradientCoordinateTwoPlusTau_mem_FP - simpa only [machineDirectedNegativeGradientLowerRawCode] using + simpa only [machineDirectedNegativeGradientLowerRawCode] using! machineCompose_mem_FP hinput machineRawRatAddCode_mem_FP def rawDirectedNegativeGradientLower diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedNegativeGradientEntry.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedNegativeGradientEntry.lean index b3da4857b5..bf742e3daf 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedNegativeGradientEntry.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedNegativeGradientEntry.lean @@ -60,13 +60,13 @@ theorem machineDirectedGradientEntryRest_mem_FP : theorem machineDirectedGradientEntryColumn_mem_FP : machineDirectedGradientEntryColumn ∈ FP := by - simpa only [machineDirectedGradientEntryColumn] using + simpa only [machineDirectedGradientEntryColumn] using! machineCompose_mem_FP machineDirectedGradientEntryRest_mem_FP machinePairFirst_mem_FP theorem machineDirectedGradientEntryPayload_mem_FP : machineDirectedGradientEntryPayload ∈ FP := by - simpa only [machineDirectedGradientEntryPayload] using + simpa only [machineDirectedGradientEntryPayload] using! machineCompose_mem_FP machineDirectedGradientEntryRest_mem_FP machinePairSecond_mem_FP @@ -85,19 +85,19 @@ theorem machineDirectedGradientEntryAsObjectiveState_mem_FP : have hwithColumn := machinePair_mem_FP machineDirectedGradientEntryColumn_mem_FP hwithAcc simpa only [machineDirectedGradientEntryAsObjectiveState, - machineDirectedObjectiveSumPack] using + machineDirectedObjectiveSumPack] using! machinePair_mem_FP machineDirectedGradientEntryRow_mem_FP hwithColumn theorem machineDirectedGradientEntryScalarInput_mem_FP : machineDirectedGradientEntryScalarInput ∈ FP := by - simpa only [machineDirectedGradientEntryScalarInput] using + simpa only [machineDirectedGradientEntryScalarInput] using! machineCompose_mem_FP machineDirectedGradientEntryAsObjectiveState_mem_FP machineDirectedObjectiveSumCoordinateInput_mem_FP theorem machineDirectedNegativeGradientEntryRawCode_mem_FP : machineDirectedNegativeGradientEntryRawCode ∈ FP := by - simpa only [machineDirectedNegativeGradientEntryRawCode] using + simpa only [machineDirectedNegativeGradientEntryRawCode] using! machineCompose_mem_FP machineDirectedGradientEntryScalarInput_mem_FP machineDirectedNegativeGradientLowerRawCode_mem_FP diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedNegativeObjectiveCoordinate.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedNegativeObjectiveCoordinate.lean index d078502a8c..a0fd5c077c 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedNegativeObjectiveCoordinate.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedNegativeObjectiveCoordinate.lean @@ -142,7 +142,7 @@ theorem machineDirectedObjectiveCoordinateRest_mem_FP : theorem machineDirectedObjectiveCoordinateTau_mem_FP : machineDirectedObjectiveCoordinateTau ∈ FP := by - simpa only [machineDirectedObjectiveCoordinateTau] using + simpa only [machineDirectedObjectiveCoordinateTau] using! machineCompose_mem_FP machineDirectedObjectiveCoordinateRest_mem_FP machinePairFirst_mem_FP @@ -150,14 +150,14 @@ theorem machineDirectedObjectiveCoordinateA_mem_FP : machineDirectedObjectiveCoordinateA ∈ FP := by have htail := machineCompose_mem_FP machineDirectedObjectiveCoordinateRest_mem_FP machinePairSecond_mem_FP - simpa only [machineDirectedObjectiveCoordinateA] using + simpa only [machineDirectedObjectiveCoordinateA] using! machineCompose_mem_FP htail machinePairFirst_mem_FP theorem machineDirectedObjectiveCoordinateX_mem_FP : machineDirectedObjectiveCoordinateX ∈ FP := by have htail := machineCompose_mem_FP machineDirectedObjectiveCoordinateRest_mem_FP machinePairSecond_mem_FP - simpa only [machineDirectedObjectiveCoordinateX] using + simpa only [machineDirectedObjectiveCoordinateX] using! machineCompose_mem_FP htail machinePairSecond_mem_FP theorem machineDirectedObjectiveCoordinateComplementRaw_mem_FP : @@ -165,12 +165,12 @@ theorem machineDirectedObjectiveCoordinateComplementRaw_mem_FP : have hinput := machinePair_mem_FP (machineConst_mem_FP (rawRatBinaryCode RawRat.one)) machineDirectedObjectiveCoordinateX_mem_FP - simpa only [machineDirectedObjectiveCoordinateComplementRaw] using + simpa only [machineDirectedObjectiveCoordinateComplementRaw] using! machineCompose_mem_FP hinput machineRawRatSubCode_mem_FP theorem machineDirectedObjectiveCoordinateComplement_mem_FP : machineDirectedObjectiveCoordinateComplement ∈ FP := by - simpa only [machineDirectedObjectiveCoordinateComplement] using + simpa only [machineDirectedObjectiveCoordinateComplement] using! machineCompose_mem_FP machineDirectedObjectiveCoordinateComplementRaw_mem_FP machineNormalizeRawRatEntryCode_mem_FP @@ -192,26 +192,26 @@ theorem machineDirectedObjectiveCoordinateLogComplementInput_mem_FP : theorem machineDirectedObjectiveCoordinateLogAUpper_mem_FP : machineDirectedObjectiveCoordinateLogAUpper ∈ FP := by - simpa only [machineDirectedObjectiveCoordinateLogAUpper] using + simpa only [machineDirectedObjectiveCoordinateLogAUpper] using! machineCompose_mem_FP machineDirectedObjectiveCoordinateLogAInput_mem_FP machineScheduledLogUpperRawCode_mem_FP theorem machineDirectedObjectiveCoordinateLogXLower_mem_FP : machineDirectedObjectiveCoordinateLogXLower ∈ FP := by - simpa only [machineDirectedObjectiveCoordinateLogXLower] using + simpa only [machineDirectedObjectiveCoordinateLogXLower] using! machineCompose_mem_FP machineDirectedObjectiveCoordinateLogXInput_mem_FP machineScheduledLogLowerRawCode_mem_FP theorem machineDirectedObjectiveCoordinateLogComplementUpper_mem_FP : machineDirectedObjectiveCoordinateLogComplementUpper ∈ FP := by - simpa only [machineDirectedObjectiveCoordinateLogComplementUpper] using + simpa only [machineDirectedObjectiveCoordinateLogComplementUpper] using! machineCompose_mem_FP machineDirectedObjectiveCoordinateLogComplementInput_mem_FP machineScheduledLogUpperRawCode_mem_FP theorem machineDirectedObjectiveCoordinateNegX_mem_FP : machineDirectedObjectiveCoordinateNegX ∈ FP := by - simpa only [machineDirectedObjectiveCoordinateNegX] using + simpa only [machineDirectedObjectiveCoordinateNegX] using! machineCompose_mem_FP machineDirectedObjectiveCoordinateX_mem_FP machineRawRatNegCode_mem_FP @@ -220,7 +220,7 @@ theorem machineDirectedObjectiveCoordinateFirstTerm_mem_FP : have hinput := machinePair_mem_FP machineDirectedObjectiveCoordinateNegX_mem_FP machineDirectedObjectiveCoordinateLogAUpper_mem_FP - simpa only [machineDirectedObjectiveCoordinateFirstTerm] using + simpa only [machineDirectedObjectiveCoordinateFirstTerm] using! machineCompose_mem_FP hinput machineRawRatMulCode_mem_FP theorem machineDirectedObjectiveCoordinateOnePlusTau_mem_FP : @@ -228,7 +228,7 @@ theorem machineDirectedObjectiveCoordinateOnePlusTau_mem_FP : have hinput := machinePair_mem_FP (machineConst_mem_FP (rawRatBinaryCode RawRat.one)) machineDirectedObjectiveCoordinateTau_mem_FP - simpa only [machineDirectedObjectiveCoordinateOnePlusTau] using + simpa only [machineDirectedObjectiveCoordinateOnePlusTau] using! machineCompose_mem_FP hinput machineRawRatAddCode_mem_FP theorem machineDirectedObjectiveCoordinateMiddleScale_mem_FP : @@ -236,7 +236,7 @@ theorem machineDirectedObjectiveCoordinateMiddleScale_mem_FP : have hinput := machinePair_mem_FP machineDirectedObjectiveCoordinateOnePlusTau_mem_FP machineDirectedObjectiveCoordinateX_mem_FP - simpa only [machineDirectedObjectiveCoordinateMiddleScale] using + simpa only [machineDirectedObjectiveCoordinateMiddleScale] using! machineCompose_mem_FP hinput machineRawRatMulCode_mem_FP theorem machineDirectedObjectiveCoordinateMiddleTerm_mem_FP : @@ -244,7 +244,7 @@ theorem machineDirectedObjectiveCoordinateMiddleTerm_mem_FP : have hinput := machinePair_mem_FP machineDirectedObjectiveCoordinateMiddleScale_mem_FP machineDirectedObjectiveCoordinateLogXLower_mem_FP - simpa only [machineDirectedObjectiveCoordinateMiddleTerm] using + simpa only [machineDirectedObjectiveCoordinateMiddleTerm] using! machineCompose_mem_FP hinput machineRawRatMulCode_mem_FP theorem machineDirectedObjectiveCoordinateComplementProduct_mem_FP : @@ -252,12 +252,12 @@ theorem machineDirectedObjectiveCoordinateComplementProduct_mem_FP : have hinput := machinePair_mem_FP machineDirectedObjectiveCoordinateComplement_mem_FP machineDirectedObjectiveCoordinateLogComplementUpper_mem_FP - simpa only [machineDirectedObjectiveCoordinateComplementProduct] using + simpa only [machineDirectedObjectiveCoordinateComplementProduct] using! machineCompose_mem_FP hinput machineRawRatMulCode_mem_FP theorem machineDirectedObjectiveCoordinateLastTerm_mem_FP : machineDirectedObjectiveCoordinateLastTerm ∈ FP := by - simpa only [machineDirectedObjectiveCoordinateLastTerm] using + simpa only [machineDirectedObjectiveCoordinateLastTerm] using! machineCompose_mem_FP machineDirectedObjectiveCoordinateComplementProduct_mem_FP machineRawRatNegCode_mem_FP @@ -267,7 +267,7 @@ theorem machineDirectedObjectiveCoordinateFirstTwo_mem_FP : have hinput := machinePair_mem_FP machineDirectedObjectiveCoordinateFirstTerm_mem_FP machineDirectedObjectiveCoordinateMiddleTerm_mem_FP - simpa only [machineDirectedObjectiveCoordinateFirstTwo] using + simpa only [machineDirectedObjectiveCoordinateFirstTwo] using! machineCompose_mem_FP hinput machineRawRatAddCode_mem_FP theorem machineDirectedNegativeObjectiveCoordinateLowerRawCode_mem_FP : @@ -275,7 +275,7 @@ theorem machineDirectedNegativeObjectiveCoordinateLowerRawCode_mem_FP : have hinput := machinePair_mem_FP machineDirectedObjectiveCoordinateFirstTwo_mem_FP machineDirectedObjectiveCoordinateLastTerm_mem_FP - simpa only [machineDirectedNegativeObjectiveCoordinateLowerRawCode] using + simpa only [machineDirectedNegativeObjectiveCoordinateLowerRawCode] using! machineCompose_mem_FP hinput machineRawRatAddCode_mem_FP def machineDirectedObjectiveCoordinateCanonicalWord diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedNegativeObjectiveSum.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedNegativeObjectiveSum.lean index c5508d1adc..aa01a78f02 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedNegativeObjectiveSum.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedNegativeObjectiveSum.lean @@ -257,37 +257,37 @@ theorem machineDirectedObjectiveSumRest_mem_FP : theorem machineDirectedObjectiveSumPrecision_mem_FP : machineDirectedObjectiveSumPrecision ∈ FP := by - simpa only [machineDirectedObjectiveSumPrecision] using + simpa only [machineDirectedObjectiveSumPrecision] using! machineCompose_mem_FP machineDirectedObjectiveSumRest_mem_FP machinePairFirst_mem_FP theorem machineDirectedObjectiveSumAfterPrecision_mem_FP : machineDirectedObjectiveSumAfterPrecision ∈ FP := by - simpa only [machineDirectedObjectiveSumAfterPrecision] using + simpa only [machineDirectedObjectiveSumAfterPrecision] using! machineCompose_mem_FP machineDirectedObjectiveSumRest_mem_FP machinePairSecond_mem_FP theorem machineDirectedObjectiveSumTau_mem_FP : machineDirectedObjectiveSumTau ∈ FP := by - simpa only [machineDirectedObjectiveSumTau] using + simpa only [machineDirectedObjectiveSumTau] using! machineCompose_mem_FP machineDirectedObjectiveSumAfterPrecision_mem_FP machinePairFirst_mem_FP theorem machineDirectedObjectiveSumAfterTau_mem_FP : machineDirectedObjectiveSumAfterTau ∈ FP := by - simpa only [machineDirectedObjectiveSumAfterTau] using + simpa only [machineDirectedObjectiveSumAfterTau] using! machineCompose_mem_FP machineDirectedObjectiveSumAfterPrecision_mem_FP machinePairSecond_mem_FP theorem machineDirectedObjectiveSumMatrix_mem_FP : machineDirectedObjectiveSumMatrix ∈ FP := by - simpa only [machineDirectedObjectiveSumMatrix] using + simpa only [machineDirectedObjectiveSumMatrix] using! machineCompose_mem_FP machineDirectedObjectiveSumAfterTau_mem_FP machinePairFirst_mem_FP theorem machineDirectedObjectiveSumVector_mem_FP : machineDirectedObjectiveSumVector ∈ FP := by - simpa only [machineDirectedObjectiveSumVector] using + simpa only [machineDirectedObjectiveSumVector] using! machineCompose_mem_FP machineDirectedObjectiveSumAfterTau_mem_FP machinePairSecond_mem_FP @@ -296,14 +296,14 @@ theorem machineDirectedObjectiveSumRow_mem_FP : theorem machineDirectedObjectiveSumColumn_mem_FP : machineDirectedObjectiveSumColumn ∈ FP := by - simpa only [machineDirectedObjectiveSumColumn] using + simpa only [machineDirectedObjectiveSumColumn] using! machineCompose_mem_FP machinePairSecond_mem_FP machinePairFirst_mem_FP theorem machineDirectedObjectiveSumAcc_mem_FP : machineDirectedObjectiveSumAcc ∈ FP := by have htail := machineCompose_mem_FP machinePairSecond_mem_FP machinePairSecond_mem_FP - simpa only [machineDirectedObjectiveSumAcc] using + simpa only [machineDirectedObjectiveSumAcc] using! machineCompose_mem_FP htail machinePairFirst_mem_FP theorem machineDirectedObjectiveSumBound_mem_FP : @@ -311,7 +311,7 @@ theorem machineDirectedObjectiveSumBound_mem_FP : have htailTwo := machineCompose_mem_FP machinePairSecond_mem_FP machinePairSecond_mem_FP have htailThree := machineCompose_mem_FP htailTwo machinePairSecond_mem_FP - simpa only [machineDirectedObjectiveSumBound] using + simpa only [machineDirectedObjectiveSumBound] using! machineCompose_mem_FP htailThree machinePairFirst_mem_FP theorem machineDirectedObjectiveSumDone_mem_FP : @@ -320,7 +320,7 @@ theorem machineDirectedObjectiveSumDone_mem_FP : machinePairSecond_mem_FP have htailThree := machineCompose_mem_FP htailTwo machinePairSecond_mem_FP have htailFour := machineCompose_mem_FP htailThree machinePairSecond_mem_FP - simpa only [machineDirectedObjectiveSumDone] using + simpa only [machineDirectedObjectiveSumDone] using! machineCompose_mem_FP htailFour machinePairFirst_mem_FP theorem machineDirectedObjectiveSumPayload_mem_FP : @@ -329,36 +329,36 @@ theorem machineDirectedObjectiveSumPayload_mem_FP : machinePairSecond_mem_FP have htailThree := machineCompose_mem_FP htailTwo machinePairSecond_mem_FP have htailFour := machineCompose_mem_FP htailThree machinePairSecond_mem_FP - simpa only [machineDirectedObjectiveSumPayload] using + simpa only [machineDirectedObjectiveSumPayload] using! machineCompose_mem_FP htailFour machinePairSecond_mem_FP theorem machineDirectedObjectiveSumStateDimension_mem_FP : machineDirectedObjectiveSumStateDimension ∈ FP := by - simpa only [machineDirectedObjectiveSumStateDimension] using + simpa only [machineDirectedObjectiveSumStateDimension] using! machineCompose_mem_FP machineDirectedObjectiveSumPayload_mem_FP machineDirectedObjectiveSumDimension_mem_FP theorem machineDirectedObjectiveSumStatePrecision_mem_FP : machineDirectedObjectiveSumStatePrecision ∈ FP := by - simpa only [machineDirectedObjectiveSumStatePrecision] using + simpa only [machineDirectedObjectiveSumStatePrecision] using! machineCompose_mem_FP machineDirectedObjectiveSumPayload_mem_FP machineDirectedObjectiveSumPrecision_mem_FP theorem machineDirectedObjectiveSumStateTau_mem_FP : machineDirectedObjectiveSumStateTau ∈ FP := by - simpa only [machineDirectedObjectiveSumStateTau] using + simpa only [machineDirectedObjectiveSumStateTau] using! machineCompose_mem_FP machineDirectedObjectiveSumPayload_mem_FP machineDirectedObjectiveSumTau_mem_FP theorem machineDirectedObjectiveSumStateMatrix_mem_FP : machineDirectedObjectiveSumStateMatrix ∈ FP := by - simpa only [machineDirectedObjectiveSumStateMatrix] using + simpa only [machineDirectedObjectiveSumStateMatrix] using! machineCompose_mem_FP machineDirectedObjectiveSumPayload_mem_FP machineDirectedObjectiveSumMatrix_mem_FP theorem machineDirectedObjectiveSumStateVector_mem_FP : machineDirectedObjectiveSumStateVector ∈ FP := by - simpa only [machineDirectedObjectiveSumStateVector] using + simpa only [machineDirectedObjectiveSumStateVector] using! machineCompose_mem_FP machineDirectedObjectiveSumPayload_mem_FP machineDirectedObjectiveSumVector_mem_FP @@ -383,7 +383,7 @@ theorem machineDirectedObjectiveSumMatrixEntryRaw_mem_FP : have hentry := machineCompose_mem_FP machineDirectedObjectiveSumMatrixEntryInput_mem_FP machineMatrixEntryAtUnary_mem_FP - simpa only [machineDirectedObjectiveSumMatrixEntryRaw] using + simpa only [machineDirectedObjectiveSumMatrixEntryRaw] using! machineCompose_mem_FP hentry machineNormalizeRawRatEntryCode_mem_FP theorem machineDirectedObjectiveSumAffineEntryInput_mem_FP : @@ -398,7 +398,7 @@ theorem machineDirectedObjectiveSumAffineEntryRaw_mem_FP : have hentry := machineCompose_mem_FP machineDirectedObjectiveSumAffineEntryInput_mem_FP machineBetheAffineEntryRawCode_mem_FP - simpa only [machineDirectedObjectiveSumAffineEntryRaw] using + simpa only [machineDirectedObjectiveSumAffineEntryRaw] using! machineCompose_mem_FP hentry machineNormalizeRawRatEntryCode_mem_FP theorem machineDirectedObjectiveSumCoordinateInput_mem_FP : @@ -410,7 +410,7 @@ theorem machineDirectedObjectiveSumCoordinateInput_mem_FP : theorem machineDirectedObjectiveSumCoordinateRawCode_mem_FP : machineDirectedObjectiveSumCoordinateRawCode ∈ FP := by - simpa only [machineDirectedObjectiveSumCoordinateRawCode] using + simpa only [machineDirectedObjectiveSumCoordinateRawCode] using! machineCompose_mem_FP machineDirectedObjectiveSumCoordinateInput_mem_FP machineDirectedNegativeObjectiveCoordinateLowerRawCode_mem_FP @@ -418,12 +418,12 @@ theorem machineDirectedObjectiveSumCandidate_mem_FP : machineDirectedObjectiveSumCandidate ∈ FP := by have hinput := machinePair_mem_FP machineDirectedObjectiveSumAcc_mem_FP machineDirectedObjectiveSumCoordinateRawCode_mem_FP - simpa only [machineDirectedObjectiveSumCandidate] using + simpa only [machineDirectedObjectiveSumCandidate] using! machineCompose_mem_FP hinput machineRawRatAddCode_mem_FP theorem machineDirectedObjectiveSumNextAcc_mem_FP : machineDirectedObjectiveSumNextAcc ∈ FP := by - simpa only [machineDirectedObjectiveSumNextAcc] using + simpa only [machineDirectedObjectiveSumNextAcc] using! machineTake_mem_FP machineDirectedObjectiveSumBound_mem_FP machineDirectedObjectiveSumCandidate_mem_FP @@ -431,7 +431,7 @@ theorem machineDirectedObjectiveSumNextRow_mem_FP : machineDirectedObjectiveSumNextRow ∈ FP := by have happend := machineAppend_mem_FP machineDirectedObjectiveSumRow_mem_FP (machineConst_mem_FP [true]) - simpa only [machineDirectedObjectiveSumNextRow] using + simpa only [machineDirectedObjectiveSumNextRow] using! machineTake_mem_FP machineDirectedObjectiveSumBound_mem_FP happend theorem machineDirectedObjectiveSumNextColumn_mem_FP : @@ -439,7 +439,7 @@ theorem machineDirectedObjectiveSumNextColumn_mem_FP : have happend := machineAppend_mem_FP machineDirectedObjectiveSumColumn_mem_FP (machineConst_mem_FP [true]) - simpa only [machineDirectedObjectiveSumNextColumn] using + simpa only [machineDirectedObjectiveSumNextColumn] using! machineTake_mem_FP machineDirectedObjectiveSumBound_mem_FP happend theorem machineDirectedObjectiveSumFinish_mem_FP : @@ -490,12 +490,12 @@ theorem machineDirectedObjectiveSumStep_mem_FP : theorem machineDirectedObjectiveSumAccumulatorBound_mem_FP : machineDirectedObjectiveSumAccumulatorBound ∈ FP := by - simpa only [machineDirectedObjectiveSumAccumulatorBound] using + simpa only [machineDirectedObjectiveSumAccumulatorBound] using! machineIteratedBinaryWidth_mem_FP 6 theorem machineDirectedObjectiveSumStateEnvelope_mem_FP : machineDirectedObjectiveSumStateEnvelope ∈ FP := by - simpa only [machineDirectedObjectiveSumStateEnvelope] using + simpa only [machineDirectedObjectiveSumStateEnvelope] using! machineIteratedBinaryWidth_mem_FP 7 theorem machineDirectedObjectiveSumInit_mem_FP : @@ -510,7 +510,7 @@ theorem machineDirectedObjectiveSumInit_mem_FP : theorem machineDirectedObjectiveSumRuler_mem_FP : machineDirectedObjectiveSumRuler ∈ FP := by - simpa only [machineDirectedObjectiveSumRuler] using + simpa only [machineDirectedObjectiveSumRuler] using! machineBetheFloorScanRuler_mem_FP theorem machineDirectedObjectiveSumWidth_mem_FP : @@ -781,7 +781,7 @@ theorem machineDirectedObjectiveSumFinalState_mem_FP : theorem machineDirectedNegativeObjectiveSumRawCode_mem_FP : machineDirectedNegativeObjectiveSumRawCode ∈ FP := by - simpa only [machineDirectedNegativeObjectiveSumRawCode] using + simpa only [machineDirectedNegativeObjectiveSumRawCode] using! machineCompose_mem_FP machineDirectedObjectiveSumFinalState_mem_FP machineDirectedObjectiveSumAcc_mem_FP @@ -1205,7 +1205,7 @@ theorem rawDirectedNegativeObjectiveCoordinateLower_width_le rawRatWidth logX + rawRatWidth logComplement + 4 := by omega simpa [rawDirectedNegativeObjectiveCoordinateLower, rawDirectedNegativeObjectiveCoordinateWidthBudget, - rawTau, rawX, rawComplement, logA, logX, logComplement] using + rawTau, rawX, rawComplement, logA, logX, logComplement] using! htotalBound theorem rawRatListCost_le_uniform_width {W : ℕ} : ∀ xs : List ℚ, @@ -1272,10 +1272,10 @@ theorem rawDirectedObjectiveSum_A_width_le_word {m : ℕ} matrixWord.length := by calc _ = (machineMatrixRowsWord matrixWord).length := by - simpa only [rows, matrixWord] using congrArg List.length + simpa only [rows, matrixWord] using! congrArg List.length (machineMatrixRowsWord_encode A).symm _ ≤ matrixWord.length := by - simpa only [machineMatrixRowsWord] using + simpa only [machineMatrixRowsWord] using! machinePairSecond_length_le matrixWord have hmatrixWord : matrixWord.length ≤ word.length := by simp only [matrixWord, word, machineDirectedObjectiveSumCanonicalWord, @@ -1339,7 +1339,7 @@ theorem rawBetheAffineLineSum_width_le_word {m : ℕ} rw [hlen] at hcost have hfinal : rawRatWidth (rawRatListSum RawRat.zero values) ≤ 1 + m * (L + 1) := hsum.trans (by omega) - simpa only [rawBetheAffineLineSum, values, L] using hfinal + simpa only [rawBetheAffineLineSum, values, L] using! hfinal theorem rawBetheAffineTotal_width_le_word {m : ℕ} (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) @@ -1363,7 +1363,7 @@ theorem rawBetheAffineTotal_width_le_word {m : ℕ} rw [hlen] at hcost have hfinal : rawRatWidth (rawRatListSum RawRat.zero values) ≤ 1 + m * m * (L + 1) := hsum.trans (by omega) - simpa only [values, L] using hfinal + simpa only [values, L] using! hfinal def rawBetheAffineEntryWidthBudget (m L : ℕ) : ℕ := m * m * (L + 1) + m + L + 8 @@ -1442,7 +1442,7 @@ theorem rawBetheAffineMatrixQ_width_le_word {m : ℕ} have hraw := rawBetheAffineEntry_width_le_word tau A y p i j have hraw' : rawRatWidth raw ≤ rawBetheAffineEntryWidthBudget m (machineDirectedObjectiveSumCanonicalWord tau A y p).length := by - simpa only [raw] using hraw + simpa only [raw] using! hraw have hscaled := Nat.mul_le_mul_left 12 hraw' calc rawRatWidth (rawRatOfRat (betheAffineMatrixQ y i j)) = @@ -1497,7 +1497,7 @@ theorem rawDirectedBetheObjectiveCoordinate_width_le_word_budget {m : ℕ} rawDirectedObjectiveSum_A_width_le_word tau A y p i j have hx : rawRatWidth (rawRatOfRat x) ≤ WX := by simpa only [x, WX, L, - rawDirectedObjectiveCoordinateWordXBudget] using + rawDirectedObjectiveCoordinateWordXBudget] using! rawBetheAffineMatrixQ_width_le_word tau A y p i j have hc0 := rawRatWidth_complement_le x have hc : rawRatWidth (rawRatOfRat (1 - x)) ≤ WC := by @@ -1520,7 +1520,7 @@ theorem rawDirectedBetheObjectiveCoordinate_width_le_word_budget {m : ℕ} omega simpa only [rawDirectedBetheObjectiveCoordinate, rawDirectedObjectiveCoordinateWordBudget, rawScheduledLogWordBudget, - WX, WC, L, x] using hfinal + WX, WC, L, x] using! hfinal structure DirectedObjectiveSumSemanticState (m : ℕ) where row : Fin (m + 1) @@ -1577,13 +1577,13 @@ theorem directedObjectiveSumSemanticStep_acc_width {m B C : ℕ} (rawDirectedBetheObjectiveCoordinate tau A y p i j) by_cases hcolumn : j = Fin.last m · by_cases hrow : i = Fin.last m - · simpa [directedObjectiveSumSemanticStep, hcolumn, hrow] using + · simpa [directedObjectiveSumSemanticStep, hcolumn, hrow] using! hadd.trans (by omega) - · simpa [directedObjectiveSumSemanticStep, hcolumn, hrow] using + · simpa [directedObjectiveSumSemanticStep, hcolumn, hrow] using! hadd.trans (by omega) - · simpa [directedObjectiveSumSemanticStep, hcolumn] using + · simpa [directedObjectiveSumSemanticStep, hcolumn] using! hadd.trans (by omega) - · simpa [directedObjectiveSumSemanticStep] using + · simpa [directedObjectiveSumSemanticStep] using! hacc.trans (by omega) def machineDirectedObjectiveSumSemanticCode {m : ℕ} @@ -1613,7 +1613,7 @@ def machineDirectedObjectiveSumSemanticCode {m : ℕ} intro h apply hi apply Fin.ext - simpa using h + simpa using! h simp [hi, hval] @[simp] theorem machineDirectedObjectiveSumLastColumnBit_canonicalState @@ -1636,7 +1636,7 @@ def machineDirectedObjectiveSumSemanticCode {m : ℕ} intro h apply hj apply Fin.ext - simpa using h + simpa using! h simp [hj, hval] @[simp] theorem machineDirectedObjectiveSumCandidate_canonicalState @@ -1699,7 +1699,7 @@ theorem machineDirectedObjectiveSumNextRow_canonicalState intro h apply hi apply Fin.ext - simpa using h + simpa using! h have : i.1 + 1 ≤ m := by omega omega @@ -1726,7 +1726,7 @@ theorem machineDirectedObjectiveSumNextColumn_canonicalState intro h apply hj apply Fin.ext - simpa using h + simpa using! h have : j.1 + 1 ≤ m := by omega omega @@ -1949,11 +1949,11 @@ theorem directedObjectiveSumSemanticStateAt_acc_width {m : ℕ} | succ k ih => let state := directedObjectiveSumSemanticStateAt tau A y p k have ih' : rawRatWidth state.acc ≤ 1 + k * (B + 1) := by - simpa only [state, B] using ih + simpa only [state, B] using! ih have hcoordinate : rawRatWidth (rawDirectedBetheObjectiveCoordinate tau A y p state.row state.column) ≤ B := by - simpa only [B] using + simpa only [B] using! rawDirectedBetheObjectiveCoordinate_width_le_word_budget tau A y p state.row state.column have hstep := directedObjectiveSumSemanticStep_acc_width @@ -1962,7 +1962,7 @@ theorem directedObjectiveSumSemanticStateAt_acc_width {m : ℕ} change rawRatWidth (directedObjectiveSumSemanticStep tau A y p state).acc ≤ 1 + (k + 1) * (B + 1) - simpa only [Nat.succ_eq_add_one] using hstep.trans (by + simpa only [Nat.succ_eq_add_one] using! hstep.trans (by ring_nf omega) @@ -1978,7 +1978,7 @@ theorem rawDirectedObjectiveCoordinateWordBudget_le_pow have hmm := Nat.mul_le_mul hmT hmT have hcube0 := Nat.mul_le_mul hmm hL1T have hcube : m * m * (L + 1) ≤ T ^ 3 := by - simpa [pow_succ, mul_assoc] using hcube0 + simpa [pow_succ, mul_assoc] using! hcube0 have haff : rawBetheAffineEntryWidthBudget m L ≤ 2 * T ^ 3 := by simp only [rawBetheAffineEntryWidthBudget] nlinarith [sq_nonneg T] @@ -2097,17 +2097,17 @@ theorem machineDirectedObjectiveSumAccumulatorBound_dominates_next {m : ℕ} have hworkSquare := Nat.mul_le_mul hm1T hm1T have hkT : k + 1 ≤ T ^ 2 := by have hk' : k + 1 ≤ (m + 1) * (m + 1) := by omega - exact hk'.trans (by simpa only [pow_two] using hworkSquare) + exact hk'.trans (by simpa only [pow_two] using! hworkSquare) have hB : B ≤ T ^ 20 := by - simpa only [B, T] using + simpa only [B, T] using! rawDirectedObjectiveCoordinateWordBudget_le_pow hmL have hacc : rawRatWidth state.acc ≤ 1 + k * (B + 1) := by - simpa only [state, B, L, word] using + simpa only [state, B, L, word] using! directedObjectiveSumSemanticStateAt_acc_width tau A y p k have hcoordinate : rawRatWidth (rawDirectedBetheObjectiveCoordinate tau A y p state.row state.column) ≤ B := by - simpa only [state, B, L, word] using + simpa only [state, B, L, word] using! rawDirectedBetheObjectiveCoordinate_width_le_word_budget tau A y p state.row state.column have hadd := rawRatWidth_add_le state.acc @@ -2166,7 +2166,7 @@ theorem machineDirectedObjectiveSumAccumulatorBound_dominates_next {m : ℕ} rw [machineDirectedObjectiveSumAccumulatorBound, machineIteratedBinaryWidth_length] exact hcodePower.trans (by - simpa only [T, L, word] using + simpa only [T, L, word] using! certificateExpGuardWidth_pow_lower 5 (machineDirectedObjectiveSumCanonicalWord tau A y p).length) @@ -2195,7 +2195,7 @@ theorem machineDirectedObjectiveSumIterate_semanticCode_of_large {m : ℕ} (directedObjectiveSumSemanticStateAt tau A y p k) hbound (hlarge k hklt) simpa only [directedObjectiveSumSemanticStateAt, - Function.iterate_succ_apply'] using hstep + Function.iterate_succ_apply'] using! hstep theorem machineDirectedObjectiveSumFinalState_encode_of_large {m : ℕ} (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) @@ -2223,7 +2223,7 @@ theorem machineDirectedObjectiveSumFinalState_encode_of_large {m : ℕ} (machineDirectedObjectiveSumDimension_le_accumulatorBound tau A y p) hlarge ((m + 1) * (m + 1)) (by omega) simpa only [directedObjectiveSumSemanticStateAt, - finalDirectedObjectiveSumSemanticState] using hiterate + finalDirectedObjectiveSumSemanticState] using! hiterate def rawDirectedNegativeObjectiveSum {m : ℕ} (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) @@ -2313,7 +2313,7 @@ theorem directedNegativeObjectivePrefix_succ_of_ordinal {m k : ℕ} · intro hmem rcases hmem with hij | hprior · subst ij - simpa only [Prod.fst, Prod.snd, hordinal] using Nat.lt_succ_self k + simpa only [Prod.fst, Prod.snd, hordinal] using! Nat.lt_succ_self k · omega rw [directedNegativeObjectivePrefix, hfilter, Finset.sum_insert hcurrentNotMem] diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedTransferCost.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedTransferCost.lean index 45a16de1f0..ff017350c2 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedTransferCost.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedTransferCost.lean @@ -96,23 +96,23 @@ theorem machineTransferRest_mem_FP : machineTransferRest ∈ FP := theorem machineTransferColumnRuler_mem_FP : machineTransferColumnRuler ∈ FP := by - simpa only [machineTransferColumnRuler] using machineCompose_mem_FP + simpa only [machineTransferColumnRuler] using! machineCompose_mem_FP machineTransferRest_mem_FP machinePairFirst_mem_FP theorem machineTransferOptimizerWord_mem_FP : machineTransferOptimizerWord ∈ FP := by - simpa only [machineTransferOptimizerWord] using machineCompose_mem_FP + simpa only [machineTransferOptimizerWord] using! machineCompose_mem_FP machineTransferRest_mem_FP machinePairSecond_mem_FP theorem machineTransferMatrixWord_mem_FP : machineTransferMatrixWord ∈ FP := by - simpa only [machineTransferMatrixWord] using machineCompose_mem_FP + simpa only [machineTransferMatrixWord] using! machineCompose_mem_FP machineTransferOptimizerWord_mem_FP machineOptimizerMatrixWord_mem_FP theorem machineTransferEntryCode_mem_FP : machineTransferEntryCode ∈ FP := by have hinput := machinePair_mem_FP machineTransferRowRuler_mem_FP (machinePair_mem_FP machineTransferColumnRuler_mem_FP machineTransferMatrixWord_mem_FP) - simpa only [machineTransferEntryCode] using machineCompose_mem_FP hinput + simpa only [machineTransferEntryCode] using! machineCompose_mem_FP hinput machineMatrixEntryAtUnary_mem_FP theorem machineTransferComplementInput_mem_FP : @@ -125,7 +125,7 @@ theorem machineTransferComplementInput_mem_FP : theorem machineTransferComplementCode_mem_FP : machineTransferComplementCode ∈ FP := by - simpa only [machineTransferComplementCode] using machineCompose_mem_FP + simpa only [machineTransferComplementCode] using! machineCompose_mem_FP machineTransferComplementInput_mem_FP machineNearbyCoordinateComplementCode_mem_FP @@ -134,7 +134,7 @@ theorem machineTransferLogXRawCode_mem_FP : have hp := machineCompose_mem_FP machineTransferOptimizerWord_mem_FP machineCertificateLogPrecisionRuler_mem_FP have hinput := machinePair_mem_FP hp machineTransferEntryCode_mem_FP - simpa only [machineTransferLogXRawCode] using machineCompose_mem_FP hinput + simpa only [machineTransferLogXRawCode] using! machineCompose_mem_FP hinput machineScheduledLogLowerRawCode_mem_FP theorem machineTransferLogComplementRawCode_mem_FP : @@ -142,7 +142,7 @@ theorem machineTransferLogComplementRawCode_mem_FP : have hp := machineCompose_mem_FP machineTransferOptimizerWord_mem_FP machineCertificateLogPrecisionRuler_mem_FP have hinput := machinePair_mem_FP hp machineTransferComplementCode_mem_FP - simpa only [machineTransferLogComplementRawCode] using + simpa only [machineTransferLogComplementRawCode] using! machineCompose_mem_FP hinput machineScheduledLogLowerRawCode_mem_FP theorem machineTransferOnePlusTauRawCode_mem_FP : @@ -150,7 +150,7 @@ theorem machineTransferOnePlusTauRawCode_mem_FP : have htau := machineCompose_mem_FP machineTransferOptimizerWord_mem_FP machineCertificateRegularizationScaleRawCode_mem_FP have hinput := machinePair_mem_FP (machineConst_mem_FP rawRatOneCode) htau - simpa only [machineTransferOnePlusTauRawCode] using + simpa only [machineTransferOnePlusTauRawCode] using! machineCompose_mem_FP hinput machineRawRatAddCode_mem_FP theorem machineTransferWeightedLogXRawCode_mem_FP : @@ -158,7 +158,7 @@ theorem machineTransferWeightedLogXRawCode_mem_FP : have hinput := machinePair_mem_FP machineTransferOnePlusTauRawCode_mem_FP machineTransferLogXRawCode_mem_FP - simpa only [machineTransferWeightedLogXRawCode] using + simpa only [machineTransferWeightedLogXRawCode] using! machineCompose_mem_FP hinput machineRawRatMulCode_mem_FP theorem machineTransferNegativeDistinguishedRawCode_mem_FP : @@ -168,14 +168,14 @@ theorem machineTransferNegativeDistinguishedRawCode_mem_FP : have hsecond := machineCompose_mem_FP machineTransferLogComplementRawCode_mem_FP machineRawRatNegCode_mem_FP have hinput := machinePair_mem_FP hfirst hsecond - simpa only [machineTransferNegativeDistinguishedRawCode] using + simpa only [machineTransferNegativeDistinguishedRawCode] using! machineCompose_mem_FP hinput machineRawRatAddCode_mem_FP theorem machineTransferRowUpperRawCode_mem_FP : machineTransferRowUpperRawCode ∈ FP := by have hinput := machinePair_mem_FP machineTransferRowRuler_mem_FP machineTransferOptimizerWord_mem_FP - simpa only [machineTransferRowUpperRawCode] using machineCompose_mem_FP hinput + simpa only [machineTransferRowUpperRawCode] using! machineCompose_mem_FP hinput machineRowComplementUpperSumRawCode_mem_FP theorem machineDirectedTransferCostUpperRawCode_mem_FP : @@ -183,7 +183,7 @@ theorem machineDirectedTransferCostUpperRawCode_mem_FP : have hinput := machinePair_mem_FP machineTransferNegativeDistinguishedRawCode_mem_FP machineTransferRowUpperRawCode_mem_FP - simpa only [machineDirectedTransferCostUpperRawCode] using + simpa only [machineDirectedTransferCostUpperRawCode] using! machineCompose_mem_FP hinput machineRawRatAddCode_mem_FP def rawDirectedTransferCostUpper {n : ℕ} diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineDyadicFloor.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineDyadicFloor.lean index de10f51cb7..73876943ad 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineDyadicFloor.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineDyadicFloor.lean @@ -96,30 +96,30 @@ theorem machineDyadicRawCode_mem_FP : theorem machineDyadicNumeratorCode_mem_FP : machineDyadicNumeratorCode ∈ Complexity.FP := by - simpa only [machineDyadicNumeratorCode] using + simpa only [machineDyadicNumeratorCode] using! machineCompose_mem_FP machineDyadicRawCode_mem_FP machinePairFirst_mem_FP theorem machineDyadicDenominatorBits_mem_FP : machineDyadicDenominatorBits ∈ Complexity.FP := by - simpa only [machineDyadicDenominatorBits] using + simpa only [machineDyadicDenominatorBits] using! machineCompose_mem_FP machineDyadicRawCode_mem_FP machinePairSecond_mem_FP theorem machineDyadicNumeratorSign_mem_FP : machineDyadicNumeratorSign ∈ Complexity.FP := by - simpa only [machineDyadicNumeratorSign] using + simpa only [machineDyadicNumeratorSign] using! machineCompose_mem_FP machineDyadicNumeratorCode_mem_FP machineHeadBit_mem_FP theorem machineDyadicNumeratorAbsBits_mem_FP : machineDyadicNumeratorAbsBits ∈ Complexity.FP := by - simpa only [machineDyadicNumeratorAbsBits] using + simpa only [machineDyadicNumeratorAbsBits] using! machineCompose_mem_FP machineDyadicNumeratorCode_mem_FP machineIntegerNatAbsBits_mem_FP theorem machineDyadicPrecisionZeroBits_mem_FP : machineDyadicPrecisionZeroBits ∈ Complexity.FP := by simpa only [machineDyadicPrecisionZeroBits, - machineDyadicPrecisionRuler] using + machineDyadicPrecisionRuler] using! machineCompose_mem_FP machinePairFirst_mem_FP machineZeroBlock_mem_FP theorem machineDyadicScaledAbsBits_mem_FP : @@ -133,18 +133,18 @@ theorem machineDyadicDivModBits_mem_FP : machineDyadicDivModBits ∈ Complexity.FP := by have hpair := machinePair_mem_FP machineDyadicScaledAbsBits_mem_FP machineDyadicDenominatorBits_mem_FP - simpa only [machineDyadicDivModBits] using + simpa only [machineDyadicDivModBits] using! machineCompose_mem_FP hpair machineBinaryDivModBits_mem_FP theorem machineDyadicQuotientBits_mem_FP : machineDyadicQuotientBits ∈ Complexity.FP := by - simpa only [machineDyadicQuotientBits] using + simpa only [machineDyadicQuotientBits] using! machineCompose_mem_FP machineDyadicDivModBits_mem_FP machinePairFirst_mem_FP theorem machineDyadicRemainderBits_mem_FP : machineDyadicRemainderBits ∈ Complexity.FP := by - simpa only [machineDyadicRemainderBits] using + simpa only [machineDyadicRemainderBits] using! machineCompose_mem_FP machineDyadicDivModBits_mem_FP machinePairSecond_mem_FP @@ -152,7 +152,7 @@ theorem machineDyadicQuotientSuccBits_mem_FP : machineDyadicQuotientSuccBits ∈ Complexity.FP := by have hpair := machinePair_mem_FP machineDyadicQuotientBits_mem_FP (machineConst_mem_FP [true]) - simpa only [machineDyadicQuotientSuccBits] using + simpa only [machineDyadicQuotientSuccBits] using! machineCompose_mem_FP hpair machineBinaryAddBits_mem_FP theorem machineDyadicNegativeFloorAbsBits_mem_FP : @@ -170,7 +170,7 @@ theorem machineDyadicFloorIntegerCode_mem_FP : machineDyadicFloorIntegerCode ∈ Complexity.FP := by have hpair := machinePair_mem_FP machineDyadicNumeratorSign_mem_FP machineDyadicFloorAbsBits_mem_FP - simpa only [machineDyadicFloorIntegerCode] using + simpa only [machineDyadicFloorIntegerCode] using! machineCompose_mem_FP hpair machineCanonicalIntegerFromSignedAbs_mem_FP theorem machineDyadicPowerDenominatorBits_mem_FP : @@ -184,7 +184,7 @@ theorem machineRawDyadicFloorCode_mem_FP : machineDyadicPowerDenominatorBits_mem_FP theorem machineDyadicFloorCode_mem_FP : machineDyadicFloorCode ∈ Complexity.FP := by - simpa only [machineDyadicFloorCode] using + simpa only [machineDyadicFloorCode] using! machineCompose_mem_FP machineRawDyadicFloorCode_mem_FP machineNormalizeRawRatBinaryCode_mem_FP @@ -287,8 +287,8 @@ theorem machineDyadicScaledAbsBits_encode (p : ℕ) (q : RawRat) : machinePairFirst_pair, machinePairSecond_pair, rawRatBinaryCode, machineIntegerNatAbsBits_encode, List.length_replicate] cases hbits : q.num.natAbs.bits with - | nil => simpa [hbits] using shiftedNatBits q.num.natAbs p - | cons bit rest => simpa [hbits] using shiftedNatBits q.num.natAbs p + | nil => simpa [hbits] using! shiftedNatBits q.num.natAbs p + | cons bit rest => simpa [hbits] using! shiftedNatBits q.num.natAbs p theorem machineDyadicDivModBits_encode (p : ℕ) (q : RawRat) : machineDyadicDivModBits @@ -328,14 +328,14 @@ theorem machineDyadicFloorIntegerCode_encode (p : ℕ) (q : RawRat) : (pair (List.replicate p true) (rawRatBinaryCode q)) = (((q.num.natAbs * 2 ^ p) / q.den) + 1).bits := by rw [machineDyadicQuotientSuccBits, hquot] - simpa using machineBinaryAddBits_pair_natBits + simpa using! machineBinaryAddBits_pair_natBits ((q.num.natAbs * 2 ^ p) / q.den) 1 rw [machineDyadicFloorIntegerCode] cases hnum : q.num with | ofNat n => have hsignFalse : machineDyadicNumeratorSign (pair (List.replicate p true) (rawRatBinaryCode q)) = [false] := by - simpa [hnum] using hsign + simpa [hnum] using! hsign simp only [machineDyadicFloorAbsBits, hsignFalse, machineIfHead_false, hquot] rw [machineCanonicalIntegerFromSignedAbs_pair] @@ -344,7 +344,7 @@ theorem machineDyadicFloorIntegerCode_encode (p : ℕ) (q : RawRat) : | negSucc n => have hsignTrue : machineDyadicNumeratorSign (pair (List.replicate p true) (rawRatBinaryCode q)) = [true] := by - simpa [hnum] using hsign + simpa [hnum] using! hsign simp only [machineDyadicFloorAbsBits, hsignTrue, machineIfHead_true, machineDyadicNegativeFloorAbsBits, hrembits, hquot, hsucc, hnum, Int.natAbs_negSucc] @@ -370,7 +370,7 @@ theorem machineDyadicPowerDenominatorBits_encode (p : ℕ) (q : RawRat) : simp [machineDyadicPowerDenominatorBits, machineDyadicPrecisionZeroBits, machineDyadicPrecisionRuler, show List.replicate p false ++ [true] = (2 ^ p).bits by - simpa using (natBits_mul_pow_two_of_ne_zero 1 p (by decide)).symm] + simpa using! (natBits_mul_pow_two_of_ne_zero 1 p (by decide)).symm] theorem machineRawDyadicFloorCode_encode (p : ℕ) (q : RawRat) : machineRawDyadicFloorCode diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineDyadicFloorMatrix.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineDyadicFloorMatrix.lean index e16192ac73..efdf797d60 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineDyadicFloorMatrix.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineDyadicFloorMatrix.lean @@ -116,13 +116,13 @@ theorem dyadicFloorMatrix_code_length_le_bound {d : ℕ} List.length_replicate] omega simpa only [rationalSquareMatrixRowsCode, rationalMatrixRows, - List.length_ofFn] using hrows.trans hmatrix + List.length_ofFn] using! hrows.trans hmatrix have hn2 : 2 ≤ n := by simp only [n, word, dyadicFloorMatrixCanonicalWord, pair_length, List.length_replicate] omega have hcubic := dyadicFloorMatrix_code_length_le_cubic p A - have hd' : d ≤ n := by simpa only [n] using hd + have hd' : d ≤ n := by simpa only [n] using! hd have hdd : d * d ≤ n * n := Nat.mul_le_mul hd' hd' have hddn : (d * d) * n ≤ (n * n) * n := Nat.mul_le_mul hdd le_rfl @@ -134,7 +134,7 @@ theorem dyadicFloorMatrix_code_length_le_bound {d : ℕ} (rationalSquareMatrixRowsCode (dyadicFloorMatrix p A)).length ≤ 1000 * n ^ 3 := by apply hcubic.trans - simpa only [n, word] using hpoly + simpa only [n, word] using! hpoly have hnx : n ≤ x := by simp [x] have hxpos : 0 < x := by omega have h1000 : 1000 ≤ x ^ 3 := by @@ -143,18 +143,18 @@ theorem dyadicFloorMatrix_code_length_le_bound {d : ℕ} have hnx3 : n ^ 3 ≤ x ^ 3 := Nat.pow_le_pow_left hnx 3 have hto6 : 1000 * n ^ 3 ≤ x ^ 6 := by have h := Nat.mul_le_mul h1000 hnx3 - simpa only [← pow_add] using h + simpa only [← pow_add] using! h have hto8 : x ^ 6 ≤ x ^ 8 := Nat.pow_le_pow_right hxpos (by omega) have hxy : x ^ 2 ≤ y := by simp [y] have hx4y2 : x ^ 4 ≤ y ^ 2 := by have h := Nat.pow_le_pow_left hxy 2 - simpa only [← pow_mul] using h + simpa only [← pow_mul] using! h have hyz : y ^ 2 ≤ z := by simp [z] have hx4z : x ^ 4 ≤ z := hx4y2.trans hyz have hx8z2 : x ^ 8 ≤ z ^ 2 := by have h := Nat.pow_le_pow_left hx4z 2 - simpa only [← pow_mul] using h + simpa only [← pow_mul] using! h apply hout.trans apply hto6.trans apply hto8.trans @@ -231,7 +231,7 @@ theorem machineDyadicFloorMatrixCurrentRow_mem_FP : machineRationalTransposeMulVectorRemaining_mem_FP machineListHead_mem_FP have hinput := machinePair_mem_FP machineRationalTransposeMulVectorStatePayload_mem_FP hhead - simpa only [machineDyadicFloorMatrixCurrentRow] using + simpa only [machineDyadicFloorMatrixCurrentRow] using! machineCompose_mem_FP hinput machineDyadicFloorVectorCode_mem_FP theorem machineDyadicFloorMatrixCandidate_mem_FP : @@ -241,7 +241,7 @@ theorem machineDyadicFloorMatrixCandidate_mem_FP : theorem machineDyadicFloorMatrixNextAccumulator_mem_FP : machineDyadicFloorMatrixNextAccumulator ∈ FP := by - simpa only [machineDyadicFloorMatrixNextAccumulator] using + simpa only [machineDyadicFloorMatrixNextAccumulator] using! machineTake_mem_FP machineRationalTransposeMulVectorBound_mem_FP machineDyadicFloorMatrixCandidate_mem_FP @@ -348,13 +348,13 @@ theorem machineDyadicFloorMatrixFinalState_mem_FP : theorem machineDyadicFloorMatrixReversedCode_mem_FP : machineDyadicFloorMatrixReversedCode ∈ FP := by - simpa only [machineDyadicFloorMatrixReversedCode] using + simpa only [machineDyadicFloorMatrixReversedCode] using! machineCompose_mem_FP machineDyadicFloorMatrixFinalState_mem_FP machineRationalTransposeMulVectorAccumulator_mem_FP theorem machineDyadicFloorMatrixCode_mem_FP : machineDyadicFloorMatrixCode ∈ FP := by - simpa only [machineDyadicFloorMatrixCode] using + simpa only [machineDyadicFloorMatrixCode] using! machineCompose_mem_FP machineDyadicFloorMatrixReversedCode_mem_FP machineListReverse_mem_FP @@ -394,7 +394,7 @@ theorem dyadicFloorMatrixRowsPrefix_succ {d : ℕ} simp only [dyadicFloorMatrixRowsPrefix, List.map_take] have hkm : k < (rationalMatrixRows A).length := by simp [rationalMatrixRows, hk] - simpa [rationalMatrixRows, List.map_ofFn] using + simpa [rationalMatrixRows, List.map_ofFn] using! congrArg (List.map (List.map (dyadicFloor p))) (List.take_concat_get hkm).symm @@ -441,7 +441,7 @@ theorem machineDyadicFloorMatrixStep_semantics {d : ℕ} (binaryListCode (binaryListCode rationalEntryBinaryCode) (dyadicFloorMatrixRowsPrefix p A k).reverse)).length ≤ (machineDyadicFloorMatrixInputBound word).length := by - simpa only [hreverse, binaryListCode] using hcand + simpa only [hreverse, binaryListCode] using! hcand have hnonempty : binaryListCode (binaryListCode rationalEntryBinaryCode) ((rationalMatrixRows A).drop k) ≠ [] := by @@ -535,7 +535,7 @@ theorem machineDyadicFloorMatrixReversedCode_encode {d : ℕ} List.length_replicate] omega simpa only [rationalSquareMatrixRowsCode, rationalMatrixRows, - List.length_ofFn] using hrows.trans hmatrix + List.length_ofFn] using! hrows.trans hmatrix have hsplit : word.length = (word.length - d) + d := by omega change machineDyadicFloorMatrixReversedCode word = _ rw [machineDyadicFloorMatrixReversedCode, diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineDyadicFloorVector.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineDyadicFloorVector.lean index ec93ed05c7..c16b31c1a1 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineDyadicFloorVector.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineDyadicFloorVector.lean @@ -25,7 +25,7 @@ def machineDyadicFloorEntryCode (word : List Bool) : List Bool := theorem machineDyadicFloorEntryCode_mem_FP : machineDyadicFloorEntryCode ∈ FP := by - simpa only [machineDyadicFloorEntryCode] using + simpa only [machineDyadicFloorEntryCode] using! machineCompose_mem_FP machineRawDyadicFloorCode_mem_FP machineNormalizeRawRatEntryCode_mem_FP @@ -56,7 +56,7 @@ theorem binaryRawDyadicFloorInt_natAbs_le exact (Nat.div_le_self _ _).trans (by omega) · simp only [Int.natAbs_neg] have hdiv := Nat.div_le_self ((n + 1) * 2 ^ p) q.den - simpa only [Nat.succ_eq_add_one] using Nat.add_le_add_right hdiv 1 + simpa only [Nat.succ_eq_add_one] using! Nat.add_le_add_right hdiv 1 theorem binaryRawDyadicFloor_width_le (p : ℕ) (q : RawRat) : @@ -74,7 +74,7 @@ theorem binaryRawDyadicFloor_width_le have hdenSize : (2 ^ p).size = p + 1 := Nat.size_pow simp only [binaryRawDyadicFloor, rawRatWidth] rw [hdenSize] - refine max_le (by simpa only [w] using hfloorSize) ?_ + refine max_le (by simpa only [w] using! hfloorSize) ?_ omega def dyadicFloorVectorCanonicalWord {d : ℕ} @@ -94,7 +94,7 @@ theorem dyadicFloorVector_entry_code_length_le {d : ℕ} have hq : rawRatWidth q ≤ word.length := by have helem' : (rationalEntryBinaryCode (v i)).length ≤ (rationalFiniteVectorCode v).length := by - simpa only [rationalFiniteVectorCode] using helem + simpa only [rationalFiniteVectorCode] using! helem apply hq0.trans apply helem'.trans simp only [word, dyadicFloorVectorCanonicalWord, pair_length, @@ -133,7 +133,7 @@ theorem dyadicFloorVector_code_length_le_bound {d : ℕ} simp only [word, dyadicFloorVectorCanonicalWord, pair_length, List.length_replicate] omega - simpa only [rationalFiniteVectorCode, List.length_ofFn] using + simpa only [rationalFiniteVectorCode, List.length_ofFn] using! hlist.trans hvector have heach : ∀ q ∈ List.ofFn (dyadicFloorVector p v), (rationalEntryBinaryCode q).length ≤ L := by @@ -226,7 +226,7 @@ theorem machineDyadicFloorVectorCurrentEntry_mem_FP : machineRationalTransposeMulVectorRemaining_mem_FP machineListHead_mem_FP have hinput := machinePair_mem_FP machineRationalTransposeMulVectorStatePayload_mem_FP hhead - simpa only [machineDyadicFloorVectorCurrentEntry] using + simpa only [machineDyadicFloorVectorCurrentEntry] using! machineCompose_mem_FP hinput machineDyadicFloorEntryCode_mem_FP theorem machineDyadicFloorVectorCandidate_mem_FP : @@ -236,7 +236,7 @@ theorem machineDyadicFloorVectorCandidate_mem_FP : theorem machineDyadicFloorVectorNextAccumulator_mem_FP : machineDyadicFloorVectorNextAccumulator ∈ FP := by - simpa only [machineDyadicFloorVectorNextAccumulator] using + simpa only [machineDyadicFloorVectorNextAccumulator] using! machineTake_mem_FP machineRationalTransposeMulVectorBound_mem_FP machineDyadicFloorVectorCandidate_mem_FP @@ -343,13 +343,13 @@ theorem machineDyadicFloorVectorFinalState_mem_FP : theorem machineDyadicFloorVectorReversedCode_mem_FP : machineDyadicFloorVectorReversedCode ∈ FP := by - simpa only [machineDyadicFloorVectorReversedCode] using + simpa only [machineDyadicFloorVectorReversedCode] using! machineCompose_mem_FP machineDyadicFloorVectorFinalState_mem_FP machineRationalTransposeMulVectorAccumulator_mem_FP theorem machineDyadicFloorVectorCode_mem_FP : machineDyadicFloorVectorCode ∈ FP := by - simpa only [machineDyadicFloorVectorCode] using + simpa only [machineDyadicFloorVectorCode] using! machineCompose_mem_FP machineDyadicFloorVectorReversedCode_mem_FP machineListReverse_mem_FP @@ -386,7 +386,7 @@ theorem dyadicFloorVectorPrefix_succ {d : ℕ} [dyadicFloor p (v ⟨k, hk⟩)] := by simp only [dyadicFloorVectorPrefix, List.map_take] have hkm : k < (List.ofFn v).length := by simpa - simpa using congrArg (List.map (dyadicFloor p)) + simpa using! congrArg (List.map (dyadicFloor p)) (List.take_concat_get hkm).symm theorem machineDyadicFloorVectorStep_semantics {d : ℕ} @@ -423,7 +423,7 @@ theorem machineDyadicFloorVectorStep_semantics {d : ℕ} (binaryListCode rationalEntryBinaryCode (dyadicFloorVectorPrefix p v k).reverse)).length ≤ (machineDyadicFloorVectorInputBound word).length := by - simpa only [hreverse, binaryListCode] using hcand + simpa only [hreverse, binaryListCode] using! hcand have hnonempty : binaryListCode rationalEntryBinaryCode ((List.ofFn v).drop k) ≠ [] := by rw [hdrop] @@ -505,7 +505,7 @@ theorem machineDyadicFloorVectorReversedCode_encode {d : ℕ} simp only [word, dyadicFloorVectorCanonicalWord, pair_length, List.length_replicate] omega - simpa only [rationalFiniteVectorCode, List.length_ofFn] using + simpa only [rationalFiniteVectorCode, List.length_ofFn] using! hlist.trans hvector have hsplit : word.length = (word.length - d) + d := by omega change machineDyadicFloorVectorReversedCode word = _ diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineExecutableCertificate.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineExecutableCertificate.lean index 62cdde6eeb..4990b5679e 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineExecutableCertificate.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineExecutableCertificate.lean @@ -61,7 +61,7 @@ theorem machineExecutableOptimizerCertificateExpGuard_fits m B hBpos hBupper).trans (by simpa only [machineOptimizerCertificateExpGuard, machineCertificateSourceWord_pair, - machineIteratedBinaryWidth_length, source] using + machineIteratedBinaryWidth_length, source] using! explicitCertificateExpStepBound_le_guardWidth hsource) /-- Correctness of a raw certificate transducer on the concrete outputs of @@ -85,7 +85,7 @@ def machineExecutableCertificateValueRawCode : List Bool → List Bool := theorem machineExecutableCertificateValueRawCode_mem_FP : machineExecutableCertificateValueRawCode ∈ FP := by - simpa only [machineExecutableCertificateValueRawCode] using + simpa only [machineExecutableCertificateValueRawCode] using! machineCertificateValueRawCode_mem_FP machineExplicitMatchingGainRawCode_mem_FP machineOptimizerCertificateExpGuard_mem_FP @@ -96,7 +96,7 @@ theorem machineExecutableCertificateValueRawCode_realizes_onPositive : intro m B hBpos hBupper simpa only [machineExecutableCertificateValueRawCode, executableLargeOptimizerOutput, executableScannedOptimizerOutput, - Nat.add_assoc, Nat.add_comm, Nat.add_left_comm] using + Nat.add_assoc, Nat.add_comm, Nat.add_left_comm] using! machineCertificateValueRawCode_encode (gainMachine := machineExplicitMatchingGainRawCode) (guardMachine := machineOptimizerCertificateExpGuard) diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineExecutablePositiveAlgorithm.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineExecutablePositiveAlgorithm.lean index 3efe652583..f1f06fed92 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineExecutablePositiveAlgorithm.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineExecutablePositiveAlgorithm.lean @@ -45,7 +45,7 @@ def machineExecutableNormalizedCertificateRawCode : List Bool → List Bool := theorem machineExecutableNormalizedCertificateRawCode_mem_FP : machineExecutableNormalizedCertificateRawCode ∈ FP := by - simpa only [machineExecutableNormalizedCertificateRawCode] using + simpa only [machineExecutableNormalizedCertificateRawCode] using! machineNormalizedCertificateFromParts_mem_FP machineExecutableScannedOptimizerOutputCode_mem_FP machineExecutableCertificateValueRawCode_mem_FP @@ -145,7 +145,7 @@ def machineExecutablePositiveAlgorithmRawCode : List Bool → List Bool := theorem machineExecutablePositiveAlgorithmRawCode_mem_FP : machineExecutablePositiveAlgorithmRawCode ∈ FP := by - simpa only [machineExecutablePositiveAlgorithmRawCode] using + simpa only [machineExecutablePositiveAlgorithmRawCode] using! machinePositiveAlgorithmRawCode_mem_FP machineExecutableNormalizedCertificateRawCode_mem_FP @@ -153,7 +153,7 @@ theorem machineExecutablePositiveAlgorithmRawCode_realizes_onPositive : PositiveRawStringRealizes machineExecutablePositiveAlgorithmRawCode executablePositiveAlgorithm := by - simpa only [machineExecutablePositiveAlgorithmRawCode] using + simpa only [machineExecutablePositiveAlgorithmRawCode] using! machinePositiveAlgorithmRawCode_realizes_executable_onPositive machineExecutableNormalizedCertificateRawCode_realizes_onPositive diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineExecutableScannedOptimizerOutput.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineExecutableScannedOptimizerOutput.lean index e540314ac4..6e9eb405e0 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineExecutableScannedOptimizerOutput.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineExecutableScannedOptimizerOutput.lean @@ -63,25 +63,25 @@ theorem machineExecutableMatrixEntryRest_mem_FP : theorem machineExecutableMatrixEntryColumn_mem_FP : machineExecutableMatrixEntryColumn ∈ FP := by - simpa only [machineExecutableMatrixEntryColumn] using + simpa only [machineExecutableMatrixEntryColumn] using! machineCompose_mem_FP machineExecutableMatrixEntryRest_mem_FP machinePairFirst_mem_FP theorem machineExecutableMatrixEntryPayload_mem_FP : machineExecutableMatrixEntryPayload ∈ FP := by - simpa only [machineExecutableMatrixEntryPayload] using + simpa only [machineExecutableMatrixEntryPayload] using! machineCompose_mem_FP machineExecutableMatrixEntryRest_mem_FP machinePairSecond_mem_FP theorem machineExecutableMatrixEntryBaseDimension_mem_FP : machineExecutableMatrixEntryBaseDimension ∈ FP := by - simpa only [machineExecutableMatrixEntryBaseDimension] using + simpa only [machineExecutableMatrixEntryBaseDimension] using! machineCompose_mem_FP machineExecutableMatrixEntryPayload_mem_FP machinePairFirst_mem_FP theorem machineExecutableMatrixEntryPoint_mem_FP : machineExecutableMatrixEntryPoint ∈ FP := by - simpa only [machineExecutableMatrixEntryPoint] using + simpa only [machineExecutableMatrixEntryPoint] using! machineCompose_mem_FP machineExecutableMatrixEntryPayload_mem_FP machinePairSecond_mem_FP @@ -97,7 +97,7 @@ theorem machineExecutableMatrixEntryCode_mem_FP : have hraw := machineCompose_mem_FP machineExecutableMatrixEntryRawInput_mem_FP machineBetheAffineEntryRawCode_mem_FP - simpa only [machineExecutableMatrixEntryCode] using + simpa only [machineExecutableMatrixEntryCode] using! machineCompose_mem_FP hraw machineNormalizeRawRatEntryCode_mem_FP @[simp] theorem machineExecutableMatrixEntryCode_encode {m : ℕ} @@ -177,18 +177,18 @@ def machineExecutableOptimizerMatrixCode theorem machineExecutableOptimizerBaseDimensionUnary_mem_FP : machineExecutableOptimizerBaseDimensionUnary ∈ FP := by - simpa only [machineExecutableOptimizerBaseDimensionUnary] using + simpa only [machineExecutableOptimizerBaseDimensionUnary] using! machineCompose_mem_FP machineMatrixDimensionUnary_mem_FP machineTail_mem_FP theorem machineExecutableOptimizerPointCode_mem_FP : machineExecutableOptimizerPointCode ∈ FP := by - simpa only [machineExecutableOptimizerPointCode] using + simpa only [machineExecutableOptimizerPointCode] using! machineExplicitBetheOptimizerPointCode_mem_FP theorem machineExecutableOptimizerBasePointCode_mem_FP : machineExecutableOptimizerBasePointCode ∈ FP := by - simpa only [machineExecutableOptimizerBasePointCode] using + simpa only [machineExecutableOptimizerBasePointCode] using! machineCompose_mem_FP machineExecutableOptimizerPointCode_mem_FP machineBinaryListInit_mem_FP @@ -211,7 +211,7 @@ theorem machineExecutableOptimizerMatrixBound_mem_FP : have hpadded := machineAppend_mem_FP machineExecutableOptimizerMatrixSeed_mem_FP (machineConst_mem_FP (List.replicate 1024 false)) - simpa only [machineExecutableOptimizerMatrixBound] using + simpa only [machineExecutableOptimizerMatrixBound] using! machineCompose_mem_FP hpadded (machineIteratedBinaryWidth_mem_FP 2) theorem machineExecutableOptimizerMatrixGeneratorInput_mem_FP : @@ -224,7 +224,7 @@ theorem machineExecutableOptimizerMatrixRowsCode_mem_FP : machineExecutableOptimizerMatrixRowsCode ∈ FP := by have hgenerator := machineUnaryMatrixGeneratorRowsCode_mem_FP machineExecutableMatrixEntryCode_mem_FP - simpa only [machineExecutableOptimizerMatrixRowsCode] using + simpa only [machineExecutableOptimizerMatrixRowsCode] using! machineCompose_mem_FP machineExecutableOptimizerMatrixGeneratorInput_mem_FP hgenerator @@ -285,7 +285,7 @@ theorem unaryMatrixCode_length_le_of_entry_bound {n E : ℕ} have hrow' : ∑ j : Fin n, (2 * (rationalEntryBinaryCode (X i j)).length + 2) ≤ - n * (2 * E + 2) := by simpa using hrow + n * (2 * E + 2) := by simpa using! hrow omega _ = n * (2 * (n * (2 * E + 2)) + 2) := by simp @@ -319,7 +319,7 @@ theorem executableOptimizerMatrix_rowsCode_fits_bound {m : ℕ} have hentry : ∀ i j, (rationalEntryBinaryCode (betheAffineMatrixQ y i j)).length ≤ E := by intro i j - simpa only [E, L, seed] using + simpa only [E, L, seed] using! executableOptimizerMatrix_entryCode_length_le A y i j have hmatrix := unaryMatrixCode_length_le_of_entry_bound (betheAffineMatrixQ y) hentry @@ -344,7 +344,7 @@ theorem executableOptimizerMatrix_rowsCode_fits_bound {m : ℕ} change _ ≤ (pair (m + 1).bits (binaryListCode (binaryListCode rationalEntryBinaryCode) (rationalMatrixRows A))).length - simpa only [machinePairSecond_pair] using + simpa only [machinePairSecond_pair] using! machinePairSecond_length_le (pair (m + 1).bits (binaryListCode (binaryListCode rationalEntryBinaryCode) @@ -361,7 +361,7 @@ theorem executableOptimizerMatrix_rowsCode_fits_bound {m : ℕ} 4096 * (L + 16) ^ 3 := by apply hmatrix.trans have hn2 : (m + 1) * (m + 1) ≤ L := by - simpa [pow_two] using hsquare + simpa [pow_two] using! hsquare have hbase : 1 ≤ L + 16 := by omega nlinarith [Nat.mul_le_mul_left (4 * L) hE, sq_nonneg (L + 16)] @@ -372,7 +372,7 @@ theorem executableOptimizerMatrix_rowsCode_fits_bound {m : ℕ} _ ≤ 4096 * (L + 16) ^ 3 := hmatrix' _ ≤ (L + 1024 + 16) ^ 4 := hpow _ ≤ certificateExpGuardWidth 2 (L + 1024) := by - simpa only [show 2 ^ (1 + 1) = 4 by norm_num] using + simpa only [show 2 ^ (1 + 1) = 4 by norm_num] using! certificateExpGuardWidth_pow_lower 1 (L + 1024) _ = _ := by rw [machineIteratedBinaryWidth_length] @@ -392,7 +392,7 @@ theorem executableOptimizerMatrix_rowsCode_fits_bound {m : ℕ} let y := epigraphBase q have hpointFull : machineExecutableOptimizerPointCode word = rationalFiniteVectorCode q := by - simpa only [machineExecutableOptimizerPointCode, word, q] using + simpa only [machineExecutableOptimizerPointCode, word, q] using! machineExplicitBetheOptimizerPointCode_encode hm A hApos hAupper have hpoint : machineExecutableOptimizerBasePointCode word = rationalFiniteVectorCode y := by @@ -415,7 +415,7 @@ theorem executableOptimizerMatrix_rowsCode_fits_bound {m : ℕ} rw [machineExecutableOptimizerMatrixBound] rw [show machineExecutableOptimizerMatrixSeed word = machineDirectedObjectiveSumCanonicalWord 0 A y 0 by - simpa only [word] using hseed] + simpa only [word] using! hseed] rw [hdimension, hpayload, hbound] change machineUnaryMatrixGeneratorRowsCode machineExecutableMatrixEntryCode (machineUnaryMatrixGeneratorCanonicalWord (m + 1) @@ -432,7 +432,7 @@ theorem executableOptimizerMatrix_rowsCode_fits_bound {m : ℕ} · rfl · intro i j exact machineExecutableMatrixEntryCode_encode y i j - · simpa only [unaryMatrixRows, rationalMatrixRows] using + · simpa only [unaryMatrixRows, rationalMatrixRows] using! executableOptimizerMatrix_rowsCode_fits_bound A y @[simp] theorem machineExecutableOptimizerMatrixCode_encode @@ -509,12 +509,12 @@ def machineExecutableColumnPotentialEntryCode (word : List Bool) : List Bool := theorem machineExecutablePotentialIndex_mem_FP : machineExecutablePotentialIndex ∈ FP := by - simpa only [machineExecutablePotentialIndex] using + simpa only [machineExecutablePotentialIndex] using! machineCompose_mem_FP machinePairSecond_mem_FP machinePairFirst_mem_FP theorem machineExecutablePotentialPayload_mem_FP : machineExecutablePotentialPayload ∈ FP := by - simpa only [machineExecutablePotentialPayload] using + simpa only [machineExecutablePotentialPayload] using! machineCompose_mem_FP machinePairSecond_mem_FP machinePairSecond_mem_FP theorem machineExecutablePotentialGradientInput_mem_FP @@ -526,19 +526,19 @@ theorem machineExecutablePotentialGradientInput_mem_FP theorem machineExecutableRowPotentialGradientInput_mem_FP : machineExecutableRowPotentialGradientInput ∈ FP := by - simpa only [machineExecutableRowPotentialGradientInput] using + simpa only [machineExecutableRowPotentialGradientInput] using! machineExecutablePotentialGradientInput_mem_FP machineExecutablePotentialIndex_mem_FP (machineConst_mem_FP []) theorem machineExecutableColumnPotentialGradientInput_mem_FP : machineExecutableColumnPotentialGradientInput ∈ FP := by - simpa only [machineExecutableColumnPotentialGradientInput] using + simpa only [machineExecutableColumnPotentialGradientInput] using! machineExecutablePotentialGradientInput_mem_FP (machineConst_mem_FP []) machineExecutablePotentialIndex_mem_FP theorem machineExecutableOriginGradientInput_mem_FP : machineExecutableOriginGradientInput ∈ FP := by - simpa only [machineExecutableOriginGradientInput] using + simpa only [machineExecutableOriginGradientInput] using! machineExecutablePotentialGradientInput_mem_FP (machineConst_mem_FP []) (machineConst_mem_FP []) @@ -549,7 +549,7 @@ theorem machineExecutableTwoPlusTauRawCode_mem_FP : machineDirectedObjectiveSumTau_mem_FP have hpair := machinePair_mem_FP (machineConst_mem_FP (rawRatBinaryCode rawOptimizerTwo)) htau - simpa only [machineExecutableTwoPlusTauRawCode] using + simpa only [machineExecutableTwoPlusTauRawCode] using! machineCompose_mem_FP hpair machineRawRatAddCode_mem_FP theorem machineExecutableRowPotentialRawCode_mem_FP : @@ -560,7 +560,7 @@ theorem machineExecutableRowPotentialRawCode_mem_FP : have hneg := machineCompose_mem_FP hgradient machineRawRatNegCode_mem_FP have hpair := machinePair_mem_FP hneg machineExecutableTwoPlusTauRawCode_mem_FP - simpa only [machineExecutableRowPotentialRawCode] using + simpa only [machineExecutableRowPotentialRawCode] using! machineCompose_mem_FP hpair machineRawRatAddCode_mem_FP theorem machineExecutableColumnPotentialRawCode_mem_FP : @@ -572,18 +572,18 @@ theorem machineExecutableColumnPotentialRawCode_mem_FP : machineExecutableColumnPotentialGradientInput_mem_FP machineDirectedNegativeGradientEntryRawCode_mem_FP have hpair := machinePair_mem_FP horigin hcolumn - simpa only [machineExecutableColumnPotentialRawCode] using + simpa only [machineExecutableColumnPotentialRawCode] using! machineCompose_mem_FP hpair machineRawRatSubCode_mem_FP theorem machineExecutableRowPotentialEntryCode_mem_FP : machineExecutableRowPotentialEntryCode ∈ FP := by - simpa only [machineExecutableRowPotentialEntryCode] using + simpa only [machineExecutableRowPotentialEntryCode] using! machineCompose_mem_FP machineExecutableRowPotentialRawCode_mem_FP machineNormalizeRawRatEntryCode_mem_FP theorem machineExecutableColumnPotentialEntryCode_mem_FP : machineExecutableColumnPotentialEntryCode ∈ FP := by - simpa only [machineExecutableColumnPotentialEntryCode] using + simpa only [machineExecutableColumnPotentialEntryCode] using! machineCompose_mem_FP machineExecutableColumnPotentialRawCode_mem_FP machineNormalizeRawRatEntryCode_mem_FP @@ -708,7 +708,7 @@ def machineExecutableOptimizerGradientSeed theorem machineExecutableOptimizerTauCanonicalCode_mem_FP : machineExecutableOptimizerTauCanonicalCode ∈ FP := by - simpa only [machineExecutableOptimizerTauCanonicalCode] using + simpa only [machineExecutableOptimizerTauCanonicalCode] using! machineCompose_mem_FP machineOptimizerTauRawCode_mem_FP machineNormalizeRawRatEntryCode_mem_FP @@ -745,7 +745,7 @@ theorem machineExecutableOptimizerGradientSeed_mem_FP : have hpointFull : machineExecutableOptimizerPointCode (rationalMatrixBinaryEncoding.encode ⟨m + 1, A⟩) = rationalFiniteVectorCode q := by - simpa only [machineExecutableOptimizerPointCode, q] using + simpa only [machineExecutableOptimizerPointCode, q] using! machineExplicitBetheOptimizerPointCode_encode hm A hApos hAupper rw [machineExecutableOptimizerBasePointCode, hpointFull, rationalFiniteVectorCode, ofFn_epigraph_center_split, @@ -805,7 +805,7 @@ theorem machineExecutableOptimizerPotentialBound_mem_FP : have hpadded := machineAppend_mem_FP machineExecutableOptimizerGradientSeed_mem_FP (machineConst_mem_FP (List.replicate 4096 false)) - simpa only [machineExecutableOptimizerPotentialBound] using + simpa only [machineExecutableOptimizerPotentialBound] using! machineCompose_mem_FP hpadded (machineIteratedBinaryWidth_mem_FP 6) theorem machineExecutableOptimizerPotentialGeneratorInput_mem_FP : @@ -818,7 +818,7 @@ theorem machineExecutableOptimizerRowPotentialRowsCode_mem_FP : machineExecutableOptimizerRowPotentialRowsCode ∈ FP := by have hgenerator := machineUnaryMatrixGeneratorRowsCode_mem_FP machineExecutableRowPotentialEntryCode_mem_FP - simpa only [machineExecutableOptimizerRowPotentialRowsCode] using + simpa only [machineExecutableOptimizerRowPotentialRowsCode] using! machineCompose_mem_FP machineExecutableOptimizerPotentialGeneratorInput_mem_FP hgenerator @@ -826,20 +826,20 @@ theorem machineExecutableOptimizerColumnPotentialRowsCode_mem_FP : machineExecutableOptimizerColumnPotentialRowsCode ∈ FP := by have hgenerator := machineUnaryMatrixGeneratorRowsCode_mem_FP machineExecutableColumnPotentialEntryCode_mem_FP - simpa only [machineExecutableOptimizerColumnPotentialRowsCode] using + simpa only [machineExecutableOptimizerColumnPotentialRowsCode] using! machineCompose_mem_FP machineExecutableOptimizerPotentialGeneratorInput_mem_FP hgenerator theorem machineExecutableOptimizerRowPotentialCode_mem_FP : machineExecutableOptimizerRowPotentialCode ∈ FP := by - simpa only [machineExecutableOptimizerRowPotentialCode] using + simpa only [machineExecutableOptimizerRowPotentialCode] using! machineCompose_mem_FP machineExecutableOptimizerRowPotentialRowsCode_mem_FP machineListHead_mem_FP theorem machineExecutableOptimizerColumnPotentialCode_mem_FP : machineExecutableOptimizerColumnPotentialCode ∈ FP := by - simpa only [machineExecutableOptimizerColumnPotentialCode] using + simpa only [machineExecutableOptimizerColumnPotentialCode] using! machineCompose_mem_FP machineExecutableOptimizerColumnPotentialRowsCode_mem_FP machineListHead_mem_FP @@ -905,7 +905,7 @@ theorem rawExecutableRowPotential_width_le_word_budget {m : ℕ} (betheAffineMatrixQ y i 0) p).neg (rawOptimizerTwo.add (rawRatOfRat tau)) rw [rawRatWidth_neg] at hsum - simpa only [rawExecutableRowPotential, L, B] using hsum.trans (by omega) + simpa only [rawExecutableRowPotential, L, B] using! hsum.trans (by omega) theorem rawExecutableColumnPotential_width_le_word_budget {m : ℕ} (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) @@ -924,7 +924,7 @@ theorem rawExecutableColumnPotential_width_le_word_budget {m : ℕ} (betheAffineMatrixQ y 0 0) p) (rawDirectedNegativeGradientLower tau (A 0 j) (betheAffineMatrixQ y 0 j) p) - simpa only [rawExecutableColumnPotential, L, B] using hsub.trans (by omega) + simpa only [rawExecutableColumnPotential, L, B] using! hsub.trans (by omega) theorem executableRowPotential_entryCode_length_le {m : ℕ} (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) @@ -998,7 +998,7 @@ theorem executableRepeatedPotential_rowsCode_fits_bound {m : ℕ} pair_length, List.length_replicate] omega have hB : B ≤ T ^ 20 := by - simpa only [B, T] using + simpa only [B, T] using! rawDirectedObjectiveCoordinateWordBudget_le_pow hmL have hTpos : 0 < T := by simp [T] have hpow19 : 1 ≤ T ^ 19 := one_le_pow₀ (by omega) @@ -1014,7 +1014,7 @@ theorem executableRepeatedPotential_rowsCode_fits_bound {m : ℕ} have hmatrix := unaryMatrixCode_length_le_of_entry_bound (X := fun _ j ↦ v j) (E := E) (by intro i j - simpa only [E, B, L, seed] using hentry j) + simpa only [E, B, L, seed] using! hentry j) have hnT : m + 1 ≤ T := hnL.trans (by simp [T]) have hfactor : 2 * E + 2 ≤ 258 * T ^ 20 := by omega have hn2 := Nat.mul_le_mul hnT hnT @@ -1061,7 +1061,7 @@ theorem executableRepeatedPotential_rowsCode_fits_bound {m : ℕ} have hpowBase := Nat.pow_le_pow_left hbase 64 exact hpowBase.trans (by simpa only [show 2 ^ (5 + 1) = 64 by norm_num, - List.length_append, List.length_replicate, T, L, seed] using + List.length_append, List.length_replicate, T, L, seed] using! certificateExpGuardWidth_pow_lower 5 (L + 4096)) theorem executableRowPotential_rowsCode_fits_bound {m : ℕ} @@ -1077,7 +1077,7 @@ theorem executableRowPotential_rowsCode_fits_bound {m : ℕ} apply executableRepeatedPotential_rowsCode_fits_bound intro i L B have h := executableRowPotential_entryCode_length_le tau A y p i - simpa only [L, B] using h.trans (by omega) + simpa only [L, B] using! h.trans (by omega) theorem executableColumnPotential_rowsCode_fits_bound {m : ℕ} (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) @@ -1094,7 +1094,7 @@ theorem executableColumnPotential_rowsCode_fits_bound {m : ℕ} apply executableRepeatedPotential_rowsCode_fits_bound intro j L B have h := executableColumnPotential_entryCode_length_le tau A y p j - simpa only [L, B] using h.trans (by omega) + simpa only [L, B] using! h.trans (by omega) @[simp] theorem machineListHead_unaryMatrixRows_repeated {n : ℕ} (hn : 0 < n) (v : Fin n → ℚ) : @@ -1127,14 +1127,14 @@ theorem executableColumnPotential_rowsCode_fits_bound {m : ℕ} fun _ i ↦ -directedNegativeGradientLowerMatrix tau A (betheAffineMatrixQ y) p i 0 + (2 + tau) have hseed : machineExecutableOptimizerGradientSeed word = seed := by - simpa only [word, seed, tau, y, p] using + simpa only [word, seed, tau, y, p] using! machineExecutableOptimizerGradientSeed_encode hm A hApos hAupper have hinput : machineExecutableOptimizerPotentialGeneratorInput word = machineUnaryMatrixGeneratorCanonicalWord (m + 1) bound seed := by rw [machineExecutableOptimizerPotentialGeneratorInput] rw [show machineMatrixDimensionUnary word = List.replicate (m + 1) true by - simpa only [word] using machineMatrixDimensionUnary_encode A] + simpa only [word] using! machineMatrixDimensionUnary_encode A] rw [machineExecutableOptimizerPotentialBound, hseed] rfl have hentry : ∀ i j, @@ -1143,12 +1143,12 @@ theorem executableColumnPotential_rowsCode_fits_bound {m : ℕ} (pair (List.replicate j.1 true) seed)) = rationalEntryBinaryCode (f i j) := by intro i j - simpa only [seed, tau, y, p, f] using + simpa only [seed, tau, y, p, f] using! machineExecutableRowPotentialEntryCode_encode tau A y p i j have hbound : (binaryListCode (binaryListCode rationalEntryBinaryCode) (unaryMatrixRows f)).length ≤ bound.length := by - simpa only [f, bound, seed] using + simpa only [f, bound, seed] using! executableRowPotential_rowsCode_fits_bound tau A y p rw [machineExecutableOptimizerRowPotentialCode, machineExecutableOptimizerRowPotentialRowsCode, hinput, @@ -1178,14 +1178,14 @@ theorem executableColumnPotential_rowsCode_fits_bound {m : ℕ} directedNegativeGradientLowerMatrix tau A (betheAffineMatrixQ y) p 0 0) have hseed : machineExecutableOptimizerGradientSeed word = seed := by - simpa only [word, seed, tau, y, p] using + simpa only [word, seed, tau, y, p] using! machineExecutableOptimizerGradientSeed_encode hm A hApos hAupper have hinput : machineExecutableOptimizerPotentialGeneratorInput word = machineUnaryMatrixGeneratorCanonicalWord (m + 1) bound seed := by rw [machineExecutableOptimizerPotentialGeneratorInput] rw [show machineMatrixDimensionUnary word = List.replicate (m + 1) true by - simpa only [word] using machineMatrixDimensionUnary_encode A] + simpa only [word] using! machineMatrixDimensionUnary_encode A] rw [machineExecutableOptimizerPotentialBound, hseed] rfl have hentry : ∀ i j, @@ -1194,12 +1194,12 @@ theorem executableColumnPotential_rowsCode_fits_bound {m : ℕ} (pair (List.replicate j.1 true) seed)) = rationalEntryBinaryCode (f i j) := by intro i j - simpa only [seed, tau, y, p, f] using + simpa only [seed, tau, y, p, f] using! machineExecutableColumnPotentialEntryCode_encode tau A y p i j have hbound : (binaryListCode (binaryListCode rationalEntryBinaryCode) (unaryMatrixRows f)).length ≤ bound.length := by - simpa only [f, bound, seed] using + simpa only [f, bound, seed] using! executableColumnPotential_rowsCode_fits_bound tau A y p rw [machineExecutableOptimizerColumnPotentialCode, machineExecutableOptimizerColumnPotentialRowsCode, hinput, @@ -1260,7 +1260,7 @@ theorem machineExecutableScannedOptimizerOutputCode_realizes : machineExecutableScannedOptimizerOutputCode := by intro m B hBpos hBupper simpa only [executableLargeOptimizerOutput, Nat.add_assoc, - Nat.add_comm, Nat.add_left_comm] using + Nat.add_comm, Nat.add_left_comm] using! machineExecutableScannedOptimizerOutputCode_encode (m := m + 1) (by omega) B hBpos hBupper diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineExplicitCertificate.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineExplicitCertificate.lean index 498e768685..63c504156e 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineExplicitCertificate.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineExplicitCertificate.lean @@ -23,7 +23,7 @@ def machineExplicitCertificateValueRawCode : List Bool → List Bool := theorem machineExplicitCertificateValueRawCode_mem_FP : machineExplicitCertificateValueRawCode ∈ Complexity.FP := by - simpa only [machineExplicitCertificateValueRawCode] using + simpa only [machineExplicitCertificateValueRawCode] using! machineCertificateValueRawCode_mem_FP machineExplicitMatchingGainRawCode_mem_FP machineOptimizerCertificateExpGuard_mem_FP @@ -31,7 +31,7 @@ theorem machineExplicitCertificateValueRawCode_mem_FP : theorem machineExplicitCertificateValueRawCode_realizes_onPositive : CertificateEvaluatorStringRealizesOnPositiveNormalized machineExplicitCertificateValueRawCode := by - simpa only [machineExplicitCertificateValueRawCode] using + simpa only [machineExplicitCertificateValueRawCode] using! machineCertificateValueRawCode_realizes_onPositive machineExplicitMatchingGainRawCode_realizes machineOptimizerCertificateExpGuard_fits_onPositiveNormalized diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineFactorial.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineFactorial.lean index 4e0d814fbc..809cbdb7dd 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineFactorial.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineFactorial.lean @@ -74,37 +74,37 @@ theorem machineFactorialAcc_mem_FP : theorem machineFactorialNext_mem_FP : machineFactorialNext ∈ Complexity.FP := by - simpa only [machineFactorialNext] using + simpa only [machineFactorialNext] using! machineCompose_mem_FP machinePairSecond_mem_FP machinePairFirst_mem_FP theorem machineFactorialBound_mem_FP : machineFactorialBound ∈ Complexity.FP := by - simpa only [machineFactorialBound] using + simpa only [machineFactorialBound] using! machineCompose_mem_FP machinePairSecond_mem_FP machinePairSecond_mem_FP theorem machineFactorialSuccessor_mem_FP : machineFactorialSuccessor ∈ Complexity.FP := by have hpair := machinePair_mem_FP machineFactorialNext_mem_FP (machineConst_mem_FP (1 : ℕ).bits) - simpa only [machineFactorialSuccessor] using + simpa only [machineFactorialSuccessor] using! machineCompose_mem_FP hpair machineBinaryAddBits_mem_FP theorem machineFactorialCandidate_mem_FP : machineFactorialCandidate ∈ Complexity.FP := by have hpair := machinePair_mem_FP machineFactorialAcc_mem_FP machineFactorialNext_mem_FP - simpa only [machineFactorialCandidate] using + simpa only [machineFactorialCandidate] using! machineCompose_mem_FP hpair machineBinaryMulBits_mem_FP theorem machineFactorialNextAcc_mem_FP : machineFactorialNextAcc ∈ Complexity.FP := by - simpa only [machineFactorialNextAcc] using + simpa only [machineFactorialNextAcc] using! machineTake_mem_FP machineFactorialBound_mem_FP machineFactorialCandidate_mem_FP theorem machineFactorialNextCounter_mem_FP : machineFactorialNextCounter ∈ Complexity.FP := by - simpa only [machineFactorialNextCounter] using + simpa only [machineFactorialNextCounter] using! machineTake_mem_FP machineFactorialBound_mem_FP machineFactorialSuccessor_mem_FP @@ -203,7 +203,7 @@ theorem machineFactorialFinalState_mem_FP : theorem machineFactorialBits_mem_FP : machineFactorialBits ∈ Complexity.FP := by - simpa only [machineFactorialBits] using + simpa only [machineFactorialBits] using! machineCompose_mem_FP machineFactorialFinalState_mem_FP machineFactorialAcc_mem_FP @@ -276,7 +276,7 @@ theorem machineFactorialSemanticState_step (n k : ℕ) (hk : k < n) : machineFactorialNextCounter, machineFactorialSuccessor, machineBinaryAddBits_pair_natBits] rw [(List.take_eq_self_iff _).2 (by - simpa [Nat.factorial_succ, Nat.mul_comm] using hfac), + simpa [Nat.factorial_succ, Nat.mul_comm] using! hfac), (List.take_eq_self_iff _).2 hcounter] simp [Nat.factorial_succ, Nat.mul_comm, Nat.add_assoc] diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineFinalScalars.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineFinalScalars.lean index 81b1f809ce..2d0a788e00 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineFinalScalars.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineFinalScalars.lean @@ -29,7 +29,7 @@ namespace BeyondBethe machineMatrixNormalizationScaleOutputCode (rationalMatrixBinaryEncoding.encode ⟨n, A⟩) = rationalBinaryCode (rationalNormalizationScale A) := by - simpa only [rationalNormalizationScale] using + simpa only [rationalNormalizationScale] using! machineMatrixNormalizationScaleOutputCode_encode A @[simp] theorem machineMatrixNormalizationScalePowerOutputCode_final {n : ℕ} @@ -37,7 +37,7 @@ namespace BeyondBethe machineMatrixNormalizationScalePowerOutputCode (rationalMatrixBinaryEncoding.encode ⟨n, A⟩) = rationalBinaryCode (rationalNormalizationScale A ^ n) := by - simpa only [rationalNormalizationScale] using + simpa only [rationalNormalizationScale] using! machineMatrixNormalizationScalePowerOutputCode_encode A end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineFourCoreCost.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineFourCoreCost.lean index e8a2dfdfe7..07c9cd4bac 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineFourCoreCost.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineFourCoreCost.lean @@ -99,30 +99,30 @@ theorem machineFourCoreRest₁_mem_FP : machineFourCoreRest₁ ∈ FP := theorem machineFourCoreSecondRowRuler_mem_FP : machineFourCoreSecondRowRuler ∈ FP := by - simpa only [machineFourCoreSecondRowRuler] using machineCompose_mem_FP + simpa only [machineFourCoreSecondRowRuler] using! machineCompose_mem_FP machineFourCoreRest₁_mem_FP machinePairFirst_mem_FP theorem machineFourCoreRest₂_mem_FP : machineFourCoreRest₂ ∈ FP := by - simpa only [machineFourCoreRest₂] using machineCompose_mem_FP + simpa only [machineFourCoreRest₂] using! machineCompose_mem_FP machineFourCoreRest₁_mem_FP machinePairSecond_mem_FP theorem machineFourCoreFirstColumnRuler_mem_FP : machineFourCoreFirstColumnRuler ∈ FP := by - simpa only [machineFourCoreFirstColumnRuler] using machineCompose_mem_FP + simpa only [machineFourCoreFirstColumnRuler] using! machineCompose_mem_FP machineFourCoreRest₂_mem_FP machinePairFirst_mem_FP theorem machineFourCoreRest₃_mem_FP : machineFourCoreRest₃ ∈ FP := by - simpa only [machineFourCoreRest₃] using machineCompose_mem_FP + simpa only [machineFourCoreRest₃] using! machineCompose_mem_FP machineFourCoreRest₂_mem_FP machinePairSecond_mem_FP theorem machineFourCoreSecondColumnRuler_mem_FP : machineFourCoreSecondColumnRuler ∈ FP := by - simpa only [machineFourCoreSecondColumnRuler] using machineCompose_mem_FP + simpa only [machineFourCoreSecondColumnRuler] using! machineCompose_mem_FP machineFourCoreRest₃_mem_FP machinePairFirst_mem_FP theorem machineFourCoreOptimizerWord_mem_FP : machineFourCoreOptimizerWord ∈ FP := by - simpa only [machineFourCoreOptimizerWord] using machineCompose_mem_FP + simpa only [machineFourCoreOptimizerWord] using! machineCompose_mem_FP machineFourCoreRest₃_mem_FP machinePairSecond_mem_FP theorem machineFourCoreTransferInput_mem_FP @@ -137,7 +137,7 @@ theorem machineFourCoreRACostRawCode_mem_FP : have hinput := machineFourCoreTransferInput_mem_FP machineFourCoreFirstRowRuler_mem_FP machineFourCoreFirstColumnRuler_mem_FP machineFourCoreOptimizerWord_mem_FP - simpa only [machineFourCoreRACostRawCode] using machineCompose_mem_FP hinput + simpa only [machineFourCoreRACostRawCode] using! machineCompose_mem_FP hinput machineDirectedTransferCostUpperRawCode_mem_FP theorem machineFourCoreRBCostRawCode_mem_FP : @@ -145,7 +145,7 @@ theorem machineFourCoreRBCostRawCode_mem_FP : have hinput := machineFourCoreTransferInput_mem_FP machineFourCoreFirstRowRuler_mem_FP machineFourCoreSecondColumnRuler_mem_FP machineFourCoreOptimizerWord_mem_FP - simpa only [machineFourCoreRBCostRawCode] using machineCompose_mem_FP hinput + simpa only [machineFourCoreRBCostRawCode] using! machineCompose_mem_FP hinput machineDirectedTransferCostUpperRawCode_mem_FP theorem machineFourCoreSACostRawCode_mem_FP : @@ -153,7 +153,7 @@ theorem machineFourCoreSACostRawCode_mem_FP : have hinput := machineFourCoreTransferInput_mem_FP machineFourCoreSecondRowRuler_mem_FP machineFourCoreFirstColumnRuler_mem_FP machineFourCoreOptimizerWord_mem_FP - simpa only [machineFourCoreSACostRawCode] using machineCompose_mem_FP hinput + simpa only [machineFourCoreSACostRawCode] using! machineCompose_mem_FP hinput machineDirectedTransferCostUpperRawCode_mem_FP theorem machineFourCoreSBCostRawCode_mem_FP : @@ -161,21 +161,21 @@ theorem machineFourCoreSBCostRawCode_mem_FP : have hinput := machineFourCoreTransferInput_mem_FP machineFourCoreSecondRowRuler_mem_FP machineFourCoreSecondColumnRuler_mem_FP machineFourCoreOptimizerWord_mem_FP - simpa only [machineFourCoreSBCostRawCode] using machineCompose_mem_FP hinput + simpa only [machineFourCoreSBCostRawCode] using! machineCompose_mem_FP hinput machineDirectedTransferCostUpperRawCode_mem_FP theorem machineFourCoreFirstRowSumRawCode_mem_FP : machineFourCoreFirstRowSumRawCode ∈ FP := by have hinput := machinePair_mem_FP machineFourCoreRACostRawCode_mem_FP machineFourCoreRBCostRawCode_mem_FP - simpa only [machineFourCoreFirstRowSumRawCode] using machineCompose_mem_FP + simpa only [machineFourCoreFirstRowSumRawCode] using! machineCompose_mem_FP hinput machineRawRatAddCode_mem_FP theorem machineFourCoreSecondRowSumRawCode_mem_FP : machineFourCoreSecondRowSumRawCode ∈ FP := by have hinput := machinePair_mem_FP machineFourCoreSACostRawCode_mem_FP machineFourCoreSBCostRawCode_mem_FP - simpa only [machineFourCoreSecondRowSumRawCode] using machineCompose_mem_FP + simpa only [machineFourCoreSecondRowSumRawCode] using! machineCompose_mem_FP hinput machineRawRatAddCode_mem_FP theorem machineDirectedFourCoreCostUpperRawCode_mem_FP : @@ -183,7 +183,7 @@ theorem machineDirectedFourCoreCostUpperRawCode_mem_FP : have hinput := machinePair_mem_FP machineFourCoreFirstRowSumRawCode_mem_FP machineFourCoreSecondRowSumRawCode_mem_FP - simpa only [machineDirectedFourCoreCostUpperRawCode] using + simpa only [machineDirectedFourCoreCostUpperRawCode] using! machineCompose_mem_FP hinput machineRawRatAddCode_mem_FP def rawDirectedFourCoreCostUpper {n : ℕ} diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineGreedyRowMatching.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineGreedyRowMatching.lean index 1426c474f9..9a7ee4eb6f 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineGreedyRowMatching.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineGreedyRowMatching.lean @@ -34,12 +34,12 @@ theorem machineMatchingDimensionRuler_mem_FP : theorem machineMatchingForwardRange_mem_FP : machineMatchingForwardRange ∈ FP := by - simpa only [machineMatchingForwardRange] using machineCompose_mem_FP + simpa only [machineMatchingForwardRange] using! machineCompose_mem_FP machineMatchingDimensionRuler_mem_FP machineUnaryRangeCode_mem_FP theorem machineMatchingReverseRange_mem_FP : machineMatchingReverseRange ∈ FP := by - simpa only [machineMatchingReverseRange] using machineCompose_mem_FP + simpa only [machineMatchingReverseRange] using! machineCompose_mem_FP machineMatchingForwardRange_mem_FP machineListReverse_mem_FP @[simp] theorem machineMatchingDimensionRuler_encode {n : ℕ} @@ -179,12 +179,12 @@ theorem machineMatchingInnerRest_mem_FP : machineMatchingInnerRest ∈ FP := theorem machineMatchingInnerSelectedInput_mem_FP : machineMatchingInnerSelectedInput ∈ FP := by - simpa only [machineMatchingInnerSelectedInput] using machineCompose_mem_FP + simpa only [machineMatchingInnerSelectedInput] using! machineCompose_mem_FP machineMatchingInnerRest_mem_FP machinePairFirst_mem_FP theorem machineMatchingInnerOptimizer_mem_FP : machineMatchingInnerOptimizer ∈ FP := by - simpa only [machineMatchingInnerOptimizer] using machineCompose_mem_FP + simpa only [machineMatchingInnerOptimizer] using! machineCompose_mem_FP machineMatchingInnerRest_mem_FP machinePairSecond_mem_FP theorem machineMatchingInnerRemaining_mem_FP : @@ -192,16 +192,16 @@ theorem machineMatchingInnerRemaining_mem_FP : theorem machineMatchingInnerSelected_mem_FP : machineMatchingInnerSelected ∈ FP := by - simpa only [machineMatchingInnerSelected] using machineCompose_mem_FP + simpa only [machineMatchingInnerSelected] using! machineCompose_mem_FP machinePairSecond_mem_FP machinePairFirst_mem_FP theorem machineMatchingInnerSource_mem_FP : machineMatchingInnerSource ∈ FP := by - simpa only [machineMatchingInnerSource] using machineCompose_mem_FP + simpa only [machineMatchingInnerSource] using! machineCompose_mem_FP machinePairSecond_mem_FP machinePairSecond_mem_FP theorem machineMatchingInnerCurrentSecondRow_mem_FP : machineMatchingInnerCurrentSecondRow ∈ FP := by - simpa only [machineMatchingInnerCurrentSecondRow] using machineCompose_mem_FP + simpa only [machineMatchingInnerCurrentSecondRow] using! machineCompose_mem_FP machineMatchingInnerRemaining_mem_FP machineListHead_mem_FP theorem machineMatchingInnerFirstLessSecondBit_mem_FP : @@ -212,7 +212,7 @@ theorem machineMatchingInnerFirstLessSecondBit_mem_FP : have hsecond := machineCompose_mem_FP machineMatchingInnerCurrentSecondRow_mem_FP machineLengthBits_mem_FP have hinput := machinePair_mem_FP hfirst hsecond - simpa only [machineMatchingInnerFirstLessSecondBit] using + simpa only [machineMatchingInnerFirstLessSecondBit] using! machineCompose_mem_FP hinput machineBinaryNatLtBit_mem_FP theorem machineMatchingInnerEligibilityInput_mem_FP : @@ -226,7 +226,7 @@ theorem machineMatchingInnerEligibilityInput_mem_FP : theorem machineMatchingInnerEligibleBit_mem_FP : machineMatchingInnerEligibleBit ∈ FP := by - simpa only [machineMatchingInnerEligibleBit] using machineCompose_mem_FP + simpa only [machineMatchingInnerEligibleBit] using! machineCompose_mem_FP machineMatchingInnerEligibilityInput_mem_FP machineCertifiedRowPairEligibilityBit_mem_FP @@ -240,7 +240,7 @@ theorem machineMatchingInnerDisjointInput_mem_FP : theorem machineMatchingInnerDisjointBit_mem_FP : machineMatchingInnerDisjointBit ∈ FP := by - simpa only [machineMatchingInnerDisjointBit] using machineCompose_mem_FP + simpa only [machineMatchingInnerDisjointBit] using! machineCompose_mem_FP machineMatchingInnerDisjointInput_mem_FP machineRowPairDisjointBit_mem_FP theorem machineMatchingInnerSelectBit_mem_FP : @@ -267,16 +267,16 @@ theorem machineMatchingInnerInputBound_mem_FP : (pair word (machineMatchingReverseRange (machineMatchingInnerOptimizer word)))) ∈ FP := machineCompose_mem_FP hbase machineBinaryMulWidth_mem_FP - simpa only [machineMatchingInnerInputBound] using + simpa only [machineMatchingInnerInputBound] using! machineCompose_mem_FP hfirstWidth machineBinaryMulWidth_mem_FP theorem machineMatchingInnerBound_mem_FP : machineMatchingInnerBound ∈ FP := by - simpa only [machineMatchingInnerBound] using machineCompose_mem_FP + simpa only [machineMatchingInnerBound] using! machineCompose_mem_FP machineMatchingInnerSource_mem_FP machineMatchingInnerInputBound_mem_FP theorem machineMatchingInnerSelectedCandidateClamped_mem_FP : machineMatchingInnerSelectedCandidateClamped ∈ FP := by - simpa only [machineMatchingInnerSelectedCandidateClamped] using + simpa only [machineMatchingInnerSelectedCandidateClamped] using! machineTake_mem_FP machineMatchingInnerBound_mem_FP machineMatchingInnerSelectedCandidate_mem_FP @@ -295,7 +295,7 @@ theorem machineMatchingInnerProcess_mem_FP : machineMatchingInnerSource_mem_FP) theorem machineMatchingInnerStep_mem_FP : machineMatchingInnerStep ∈ FP := by - simpa only [machineMatchingInnerStep] using machineIfEmpty_mem_FP + simpa only [machineMatchingInnerStep] using! machineIfEmpty_mem_FP machineMatchingInnerRemaining_mem_FP id_mem_FP machineMatchingInnerProcess_mem_FP @@ -343,7 +343,7 @@ theorem machineMatchingInner_base_le_bound (word : List Bool) : theorem machineMatchingInner_word_le_bound (word : List Bool) : word.length ≤ (machineMatchingInnerInputBound word).length := by - simpa only [machinePairFirst_pair] using (machinePairFirst_length_le + simpa only [machinePairFirst_pair] using! (machinePairFirst_length_le (pair word (machineMatchingReverseRange (machineMatchingInnerOptimizer word)))).trans (machineMatchingInner_base_le_bound word) @@ -352,7 +352,7 @@ theorem machineMatchingInner_range_le_bound (word : List Bool) : (machineMatchingReverseRange (machineMatchingInnerOptimizer word)).length ≤ (machineMatchingInnerInputBound word).length := by - simpa only [machinePairSecond_pair] using (machinePairSecond_length_le + simpa only [machinePairSecond_pair] using! (machinePairSecond_length_le (pair word (machineMatchingReverseRange (machineMatchingInnerOptimizer word)))).trans (machineMatchingInner_base_le_bound word) @@ -393,11 +393,11 @@ theorem machineMatchingInnerStep_bound {word state : List Bool} · rw [machineMatchingInnerNextSelected] cases hs : machineMatchingInnerSelectBit state with | nil => - simpa [machineIfHead, Cobham.selectHead] using hselected + simpa [machineIfHead, Cobham.selectHead] using! hselected | cons select rest => cases select with | false => - simpa using hselected + simpa using! hselected | true => simp only [machineIfHead_true, machineMatchingInnerSelectedCandidateClamped, @@ -444,7 +444,7 @@ theorem machineMatchingInnerFinalState_mem_FP : theorem machineMatchingInnerOutputSelected_mem_FP : machineMatchingInnerOutputSelected ∈ FP := by - simpa only [machineMatchingInnerOutputSelected] using machineCompose_mem_FP + simpa only [machineMatchingInnerOutputSelected] using! machineCompose_mem_FP machineMatchingInnerFinalState_mem_FP machineMatchingInnerSelected_mem_FP /-! ## Canonical one-step facts -/ @@ -732,10 +732,10 @@ theorem canonical_inner_candidate_length_le_bound {n : ℕ} simp only [pair_length] omega have hsourceP : source.length ≤ P := by - simpa only [P, base, machinePairFirst_pair] using + simpa only [P, base, machinePairFirst_pair] using! machinePairFirst_length_le base have hrangeP : range.length ≤ P := by - simpa only [P, base, machinePairSecond_pair] using + simpa only [P, base, machinePairSecond_pair] using! machinePairSecond_length_le base have hnrange : n ≤ range.length := by have hop : machineMatchingInnerOptimizer source = @@ -744,7 +744,7 @@ theorem canonical_inner_candidate_length_le_bound {n : ℕ} machineMatchingInnerOptimizer, machineMatchingInnerRest] dsimp only [range] rw [hop, machineMatchingReverseRange_encode] - simpa using binaryListCode_listLength_le finUnaryCode + simpa using! binaryListCode_listLength_le finUnaryCode (List.finRange n).reverse have hnP : n ≤ P := hnrange.trans hrangeP have hinitialP : @@ -831,7 +831,7 @@ theorem certifiedGreedyOrderedScan_take_succ {n : ℕ} certifiedGreedyOrderedStep X i (certifiedGreedyOrderedScan X i selected (js.take k)) js[k] := by have htake : js.take (k + 1) = js.take k ++ [js[k]] := by - simpa only [List.concat_eq_append] using (List.take_concat_get hk).symm + simpa only [List.concat_eq_append] using! (List.take_concat_get hk).symm unfold certifiedGreedyOrderedScan calc List.foldl (certifiedGreedyOrderedStep X i) selected (js.take (k + 1)) = @@ -1002,17 +1002,17 @@ theorem machineMatchingOuterRemaining_mem_FP : theorem machineMatchingOuterSelected_mem_FP : machineMatchingOuterSelected ∈ FP := by - simpa only [machineMatchingOuterSelected] using machineCompose_mem_FP + simpa only [machineMatchingOuterSelected] using! machineCompose_mem_FP machinePairSecond_mem_FP machinePairFirst_mem_FP theorem machineMatchingOuterSource_mem_FP : machineMatchingOuterSource ∈ FP := by - simpa only [machineMatchingOuterSource] using machineCompose_mem_FP + simpa only [machineMatchingOuterSource] using! machineCompose_mem_FP machinePairSecond_mem_FP machinePairSecond_mem_FP theorem machineMatchingOuterCurrentFirstRow_mem_FP : machineMatchingOuterCurrentFirstRow ∈ FP := by - simpa only [machineMatchingOuterCurrentFirstRow] using machineCompose_mem_FP + simpa only [machineMatchingOuterCurrentFirstRow] using! machineCompose_mem_FP machineMatchingOuterRemaining_mem_FP machineListHead_mem_FP theorem machineMatchingOuterInnerInput_mem_FP : @@ -1023,7 +1023,7 @@ theorem machineMatchingOuterInnerInput_mem_FP : theorem machineMatchingOuterNextSelectedRaw_mem_FP : machineMatchingOuterNextSelectedRaw ∈ FP := by - simpa only [machineMatchingOuterNextSelectedRaw] using machineCompose_mem_FP + simpa only [machineMatchingOuterNextSelectedRaw] using! machineCompose_mem_FP machineMatchingOuterInnerInput_mem_FP machineMatchingInnerOutputSelected_mem_FP @@ -1034,17 +1034,17 @@ theorem machineMatchingOuterInputBound_mem_FP : have hbase := machinePair_mem_FP id_mem_FP hrange have h1 := machineCompose_mem_FP hbase machineBinaryMulWidth_mem_FP have h2 := machineCompose_mem_FP h1 machineBinaryMulWidth_mem_FP - simpa only [machineMatchingOuterInputBound] using + simpa only [machineMatchingOuterInputBound] using! machineCompose_mem_FP h2 machineBinaryMulWidth_mem_FP theorem machineMatchingOuterBound_mem_FP : machineMatchingOuterBound ∈ FP := by - simpa only [machineMatchingOuterBound] using machineCompose_mem_FP + simpa only [machineMatchingOuterBound] using! machineCompose_mem_FP machineMatchingOuterSource_mem_FP machineMatchingOuterInputBound_mem_FP theorem machineMatchingOuterNextSelected_mem_FP : machineMatchingOuterNextSelected ∈ FP := by - simpa only [machineMatchingOuterNextSelected] using + simpa only [machineMatchingOuterNextSelected] using! machineTake_mem_FP machineMatchingOuterBound_mem_FP machineMatchingOuterNextSelectedRaw_mem_FP @@ -1058,7 +1058,7 @@ theorem machineMatchingOuterProcess_mem_FP : theorem machineMatchingOuterStep_mem_FP : machineMatchingOuterStep ∈ FP := by - simpa only [machineMatchingOuterStep] using machineIfEmpty_mem_FP + simpa only [machineMatchingOuterStep] using! machineIfEmpty_mem_FP machineMatchingOuterRemaining_mem_FP id_mem_FP machineMatchingOuterProcess_mem_FP @@ -1105,7 +1105,7 @@ theorem machineMatchingOuter_base_le_bound (optimizer : List Bool) : theorem machineMatchingOuter_optimizer_le_bound (optimizer : List Bool) : optimizer.length ≤ (machineMatchingOuterInputBound optimizer).length := by - simpa only [machinePairFirst_pair] using + simpa only [machinePairFirst_pair] using! (machinePairFirst_length_le (pair optimizer (machineMatchingReverseRange optimizer))).trans (machineMatchingOuter_base_le_bound optimizer) @@ -1113,7 +1113,7 @@ theorem machineMatchingOuter_optimizer_le_bound (optimizer : List Bool) : theorem machineMatchingOuter_range_le_bound (optimizer : List Bool) : (machineMatchingReverseRange optimizer).length ≤ (machineMatchingOuterInputBound optimizer).length := by - simpa only [machinePairSecond_pair] using + simpa only [machinePairSecond_pair] using! (machinePairSecond_length_le (pair optimizer (machineMatchingReverseRange optimizer))).trans (machineMatchingOuter_base_le_bound optimizer) @@ -1189,7 +1189,7 @@ theorem machineMatchingOuterFinalState_mem_FP : theorem machineGreedyMatchingSelected_mem_FP : machineGreedyMatchingSelected ∈ FP := by - simpa only [machineGreedyMatchingSelected] using machineCompose_mem_FP + simpa only [machineGreedyMatchingSelected] using! machineCompose_mem_FP machineMatchingOuterFinalState_mem_FP machineMatchingOuterSelected_mem_FP @@ -1213,7 +1213,7 @@ theorem certifiedGreedyOuterStep_code_length_le {n : ℕ} (binaryListCode orderedRowPairCode (certifiedGreedyOuterStep X selected i)).length ≤ (binaryListCode orderedRowPairCode selected).length + n * (6 * n) := by - simpa [certifiedGreedyOuterStep] using + simpa [certifiedGreedyOuterStep] using! certifiedGreedyOrderedScan_code_length_le X i selected (List.finRange n).reverse @@ -1287,12 +1287,12 @@ theorem canonical_outer_selected_length_le_bound {n : ℕ} let base := pair optimizer range let P := base.length have hrangeP : range.length ≤ P := by - simpa only [P, base, machinePairSecond_pair] using + simpa only [P, base, machinePairSecond_pair] using! machinePairSecond_length_le base have hnrange : n ≤ range.length := by dsimp only [range, optimizer] rw [machineMatchingReverseRange_encode] - simpa using binaryListCode_listLength_le finUnaryCode + simpa using! binaryListCode_listLength_le finUnaryCode (List.finRange n).reverse have hnP : n ≤ P := hnrange.trans hrangeP have hcoarse : (binaryListCode orderedRowPairCode selected).length ≤ @@ -1358,7 +1358,7 @@ theorem certifiedGreedyOuterScan_take_succ {n : ℕ} certifiedGreedyOuterStep X (certifiedGreedyOuterScan X selected (is.take k)) is[k] := by have htake : is.take (k + 1) = is.take k ++ [is[k]] := by - simpa only [List.concat_eq_append] using (List.take_concat_get hk).symm + simpa only [List.concat_eq_append] using! (List.take_concat_get hk).symm unfold certifiedGreedyOuterScan calc List.foldl (certifiedGreedyOuterStep X) selected (is.take (k + 1)) = @@ -1397,7 +1397,7 @@ theorem machineMatchingOuterSemanticState_step {n : ℕ} (binaryListCode orderedRowPairCode selected).length ≤ k * (n * (6 * n)) := by dsimp only [selected] - simpa [binaryListCode] using hscan.trans (Nat.add_le_add_left + simpa [binaryListCode] using! hscan.trans (Nat.add_le_add_left (Nat.mul_le_mul_right (n * (6 * n)) htake) _) have hstep := certifiedGreedyOuterStep_code_length_le X selected is[k] have hcandidate : @@ -1497,7 +1497,8 @@ theorem orderedPairsConflict_map_endpoints_eq_false_iff {n : ℕ} rowPair_eq_pair_rows r, rowPairRow_rowPairOfLT_zero, rowPairRow_rowPairOfLT_one] - simpa [rowPairEndpoints, Finset.disjoint_left, and_assoc] using hhead + simpa [rowPairEndpoints, Finset.disjoint_left, and_assoc] using! + (of_decide_eq_false hhead) · exact htail r hr · intro hall refine ⟨?_, fun r hr ↦ hall r (List.mem_cons_of_mem _ hr)⟩ @@ -1506,8 +1507,9 @@ theorem orderedPairsConflict_map_endpoints_eq_false_iff {n : ℕ} rowPair_eq_pair_rows q, rowPairRow_rowPairOfLT_zero, rowPairRow_rowPairOfLT_one] at hdisj + apply decide_eq_false simpa [rowPairEndpoints, rowPairOfLT, - Finset.disjoint_left, and_assoc] using hdisj + Finset.disjoint_left, and_assoc] using! hdisj /-- The same greedy update, now retaining the proof-carrying unordered row pair. This is the bridge from the machine's endpoint representation to the @@ -1727,12 +1729,12 @@ def greedyRowFinsetStep {n : ℕ} greedyRowFinsetStep selected.toFinset q := by by_cases h : ∀ r ∈ selected, Disjoint q.1 r.1 · have hfin : ∀ r ∈ selected.toFinset, Disjoint q.1 r.1 := by - simpa using h + simpa using! h rw [greedyRowListStep, ite_eq_left h, greedyRowFinsetStep, ite_eq_left hfin] simp · have hfin : ¬(∀ r ∈ selected.toFinset, Disjoint q.1 r.1) := by - simpa using h + simpa using! h rw [greedyRowListStep, ite_eq_right h, greedyRowFinsetStep, ite_eq_right hfin] diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineIntegerArithmetic.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineIntegerArithmetic.lean index 0558a0d10b..47eba1f0c6 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineIntegerArithmetic.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineIntegerArithmetic.lean @@ -108,29 +108,29 @@ def machineIntegerNegCode (word : List Bool) : List Bool := theorem machineCanonicalIntegerFromSignedAbs_mem_FP : machineCanonicalIntegerFromSignedAbs ∈ Complexity.FP := by - simpa only [machineCanonicalIntegerFromSignedAbs] using + simpa only [machineCanonicalIntegerFromSignedAbs] using! machineIfEmpty_mem_FP machinePairSecond_mem_FP (machineConst_mem_FP [false]) machineIntegerCodeFromSignedAbs_mem_FP theorem machineIntegerSignedMagnitude_mem_FP : machineIntegerSignedMagnitude ∈ Complexity.FP := by - simpa only [machineIntegerSignedMagnitude] using + simpa only [machineIntegerSignedMagnitude] using! machinePair_mem_FP machineHeadBit_mem_FP machineIntegerNatAbsBits_mem_FP theorem machineSignedLeftSign_mem_FP : machineSignedLeftSign ∈ Complexity.FP := by - simpa only [machineSignedLeftSign] using + simpa only [machineSignedLeftSign] using! machineCompose_mem_FP machinePairFirst_mem_FP machinePairFirst_mem_FP theorem machineSignedLeftAbs_mem_FP : machineSignedLeftAbs ∈ Complexity.FP := by - simpa only [machineSignedLeftAbs] using + simpa only [machineSignedLeftAbs] using! machineCompose_mem_FP machinePairFirst_mem_FP machinePairSecond_mem_FP theorem machineSignedRightSign_mem_FP : machineSignedRightSign ∈ Complexity.FP := by - simpa only [machineSignedRightSign] using + simpa only [machineSignedRightSign] using! machineCompose_mem_FP machinePairSecond_mem_FP machinePairFirst_mem_FP theorem machineSignedRightAbs_mem_FP : machineSignedRightAbs ∈ Complexity.FP := by - simpa only [machineSignedRightAbs] using + simpa only [machineSignedRightAbs] using! machineCompose_mem_FP machinePairSecond_mem_FP machinePairSecond_mem_FP theorem machineSignedSameSign_mem_FP : machineSignedSameSign ∈ Complexity.FP := by @@ -141,27 +141,27 @@ theorem machineSignedSameSign_mem_FP : machineSignedSameSign ∈ Complexity.FP : theorem machineSignedAbsSum_mem_FP : machineSignedAbsSum ∈ Complexity.FP := by have hpair := machinePair_mem_FP machineSignedLeftAbs_mem_FP machineSignedRightAbs_mem_FP - simpa only [machineSignedAbsSum] using + simpa only [machineSignedAbsSum] using! machineCompose_mem_FP hpair machineBinaryAddBits_mem_FP theorem machineSignedLeftAbsGe_mem_FP : machineSignedLeftAbsGe ∈ Complexity.FP := by have hpair := machinePair_mem_FP machineSignedRightAbs_mem_FP machineSignedLeftAbs_mem_FP - simpa only [machineSignedLeftAbsGe] using + simpa only [machineSignedLeftAbsGe] using! machineCompose_mem_FP hpair machineBinaryNatLeBit_mem_FP theorem machineSignedAbsLeftDiff_mem_FP : machineSignedAbsLeftDiff ∈ Complexity.FP := by have hpair := machinePair_mem_FP machineSignedLeftAbs_mem_FP machineSignedRightAbs_mem_FP - simpa only [machineSignedAbsLeftDiff] using + simpa only [machineSignedAbsLeftDiff] using! machineCompose_mem_FP hpair machineBinarySubBits_mem_FP theorem machineSignedAbsRightDiff_mem_FP : machineSignedAbsRightDiff ∈ Complexity.FP := by have hpair := machinePair_mem_FP machineSignedRightAbs_mem_FP machineSignedLeftAbs_mem_FP - simpa only [machineSignedAbsRightDiff] using + simpa only [machineSignedAbsRightDiff] using! machineCompose_mem_FP hpair machineBinarySubBits_mem_FP theorem machineSignedDifferentAbs_mem_FP : @@ -181,7 +181,7 @@ theorem machineSignedMagnitudeAdd_mem_FP : have hmagnitude := machineIfHead_mem_FP machineSignedSameSign_mem_FP machineSignedAbsSum_mem_FP machineSignedDifferentAbs_mem_FP have hpair := machinePair_mem_FP hsign hmagnitude - simpa only [machineSignedMagnitudeAdd] using + simpa only [machineSignedMagnitudeAdd] using! machineCompose_mem_FP hpair machineCanonicalIntegerFromSignedAbs_mem_FP theorem machineIntegerAddCode_mem_FP : machineIntegerAddCode ∈ Complexity.FP := by @@ -190,14 +190,14 @@ theorem machineIntegerAddCode_mem_FP : machineIntegerAddCode ∈ Complexity.FP : have hright := machineCompose_mem_FP machinePairSecond_mem_FP machineIntegerSignedMagnitude_mem_FP have hpair := machinePair_mem_FP hleft hright - simpa only [machineIntegerAddCode] using + simpa only [machineIntegerAddCode] using! machineCompose_mem_FP hpair machineSignedMagnitudeAdd_mem_FP theorem machineSignedAbsProduct_mem_FP : machineSignedAbsProduct ∈ Complexity.FP := by have hpair := machinePair_mem_FP machineSignedLeftAbs_mem_FP machineSignedRightAbs_mem_FP - simpa only [machineSignedAbsProduct] using + simpa only [machineSignedAbsProduct] using! machineCompose_mem_FP hpair machineBinaryMulBits_mem_FP theorem machineSignedProductSign_mem_FP : @@ -209,7 +209,7 @@ theorem machineSignedMagnitudeMul_mem_FP : machineSignedMagnitudeMul ∈ Complexity.FP := by have hpair := machinePair_mem_FP machineSignedProductSign_mem_FP machineSignedAbsProduct_mem_FP - simpa only [machineSignedMagnitudeMul] using + simpa only [machineSignedMagnitudeMul] using! machineCompose_mem_FP hpair machineCanonicalIntegerFromSignedAbs_mem_FP theorem machineIntegerMulCode_mem_FP : machineIntegerMulCode ∈ Complexity.FP := by @@ -218,7 +218,7 @@ theorem machineIntegerMulCode_mem_FP : machineIntegerMulCode ∈ Complexity.FP : have hright := machineCompose_mem_FP machinePairSecond_mem_FP machineIntegerSignedMagnitude_mem_FP have hpair := machinePair_mem_FP hleft hright - simpa only [machineIntegerMulCode] using + simpa only [machineIntegerMulCode] using! machineCompose_mem_FP hpair machineSignedMagnitudeMul_mem_FP theorem machineIntegerNegCode_mem_FP : machineIntegerNegCode ∈ Complexity.FP := by @@ -227,7 +227,7 @@ theorem machineIntegerNegCode_mem_FP : machineIntegerNegCode ∈ Complexity.FP : have hsign := machineNotBit_mem_FP hsignProjection have habs := machineCompose_mem_FP hsigned machinePairSecond_mem_FP have hpair := machinePair_mem_FP hsign habs - simpa only [machineIntegerNegCode] using + simpa only [machineIntegerNegCode] using! machineCompose_mem_FP hpair machineCanonicalIntegerFromSignedAbs_mem_FP @[simp] theorem machineCanonicalIntegerFromSignedAbs_pair @@ -408,7 +408,7 @@ theorem machineIntegerNegCode_encode (z : ℤ) : rw [machineIntegerNegCode, machineIntegerSignedMagnitude_encode] simp only [machinePairFirst_pair, machinePairSecond_pair, machineNotBit_one, Bool.not_true] - simpa only [signedMagnitudeValue, ite_false] using + simpa only [signedMagnitudeValue, ite_false] using! machineCanonicalIntegerFromSignedAbs_pair false (n + 1) end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineIntegerCompare.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineIntegerCompare.lean index dca65002f9..49b8ebd69f 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineIntegerCompare.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineIntegerCompare.lean @@ -49,23 +49,23 @@ def machineIntegerLeCode (word : List Bool) : List Bool := theorem machineIntegerLeftSign_mem_FP : machineIntegerLeftSign ∈ Complexity.FP := by - simpa only [machineIntegerLeftSign] using + simpa only [machineIntegerLeftSign] using! machineCompose_mem_FP machinePairFirst_mem_FP machineHeadBit_mem_FP theorem machineIntegerRightSign_mem_FP : machineIntegerRightSign ∈ Complexity.FP := by - simpa only [machineIntegerRightSign] using + simpa only [machineIntegerRightSign] using! machineCompose_mem_FP machinePairSecond_mem_FP machineHeadBit_mem_FP theorem machineIntegerLeftAbsBits_mem_FP : machineIntegerLeftAbsBits ∈ Complexity.FP := by - simpa only [machineIntegerLeftAbsBits] using + simpa only [machineIntegerLeftAbsBits] using! machineCompose_mem_FP machinePairFirst_mem_FP machineIntegerNatAbsBits_mem_FP theorem machineIntegerRightAbsBits_mem_FP : machineIntegerRightAbsBits ∈ Complexity.FP := by - simpa only [machineIntegerRightAbsBits] using + simpa only [machineIntegerRightAbsBits] using! machineCompose_mem_FP machinePairSecond_mem_FP machineIntegerNatAbsBits_mem_FP @@ -73,14 +73,14 @@ theorem machineIntegerPositiveLeBit_mem_FP : machineIntegerPositiveLeBit ∈ Complexity.FP := by have hpair := machinePair_mem_FP machineIntegerLeftAbsBits_mem_FP machineIntegerRightAbsBits_mem_FP - simpa only [machineIntegerPositiveLeBit] using + simpa only [machineIntegerPositiveLeBit] using! machineCompose_mem_FP hpair machineBinaryNatLeBit_mem_FP theorem machineIntegerNegativeLeBit_mem_FP : machineIntegerNegativeLeBit ∈ Complexity.FP := by have hpair := machinePair_mem_FP machineIntegerRightAbsBits_mem_FP machineIntegerLeftAbsBits_mem_FP - simpa only [machineIntegerNegativeLeBit] using + simpa only [machineIntegerNegativeLeBit] using! machineCompose_mem_FP hpair machineBinaryNatLeBit_mem_FP theorem machineIntegerLeCode_mem_FP : machineIntegerLeCode ∈ Complexity.FP := by diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineIntegerSignedMagnitude.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineIntegerSignedMagnitude.lean index 6f5ed206c0..178bfaa866 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineIntegerSignedMagnitude.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineIntegerSignedMagnitude.lean @@ -45,12 +45,12 @@ theorem machineIntegerNegativeAbsBits_mem_FP : have hpair : (fun word : List Bool => pair word.tail [true]) ∈ Complexity.FP := machinePair_mem_FP machineTail_mem_FP (machineConst_mem_FP [true]) - simpa only [machineIntegerNegativeAbsBits] using + simpa only [machineIntegerNegativeAbsBits] using! machineCompose_mem_FP hpair machineBinaryAddBits_mem_FP theorem machineIntegerNatAbsBits_mem_FP : machineIntegerNatAbsBits ∈ Complexity.FP := by - simpa only [machineIntegerNatAbsBits] using + simpa only [machineIntegerNatAbsBits] using! machineIfHead_mem_FP id_mem_FP machineIntegerNegativeAbsBits_mem_FP machineTail_mem_FP @@ -59,7 +59,7 @@ theorem machineIntegerNegativePayloadBits_mem_FP : have hpair : (fun absBits : List Bool => pair absBits [true]) ∈ Complexity.FP := machinePair_mem_FP id_mem_FP (machineConst_mem_FP [true]) - simpa only [machineIntegerNegativePayloadBits] using + simpa only [machineIntegerNegativePayloadBits] using! machineCompose_mem_FP hpair machineBinarySubBits_mem_FP theorem machineIntegerCodeFromSignedAbs_mem_FP : @@ -70,7 +70,7 @@ theorem machineIntegerCodeFromSignedAbs_mem_FP : (machinePrepend_mem_FP true) have hpositive := machineCompose_mem_FP machinePairSecond_mem_FP (machinePrepend_mem_FP false) - simpa only [machineIntegerCodeFromSignedAbs] using + simpa only [machineIntegerCodeFromSignedAbs] using! machineIfHead_mem_FP machinePairFirst_mem_FP hnegative hpositive theorem machineIntegerNatAbsBits_encode (z : ℤ) : @@ -80,7 +80,7 @@ theorem machineIntegerNatAbsBits_encode (z : ℤ) : | negSucc n => simp only [machineIntegerNatAbsBits, integerBinaryCode, machineIfHead_true, machineIntegerNegativeAbsBits, List.tail_cons] - simpa using machineBinaryAddBits_pair_natBits n 1 + simpa using! machineBinaryAddBits_pair_natBits n 1 theorem machineIntegerCodeFromSignedAbs_ofNat (n magnitude : ℕ) : machineIntegerCodeFromSignedAbs diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineKuhnEncoding.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineKuhnEncoding.lean index 367bafceac..91601da9bd 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineKuhnEncoding.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineKuhnEncoding.lean @@ -40,13 +40,13 @@ def finListUnaryCode {n : ℕ} (xs : List (Fin n)) : List Bool := @[simp] theorem seenBoolList_getElem {n : ℕ} (seen : Finset (Fin n)) (i : ℕ) (hi : i < (seenBoolList seen).length) : - (seenBoolList seen)[i] = decide (⟨i, by simpa using hi⟩ ∈ seen) := by + (seenBoolList seen)[i] = decide (⟨i, by simpa using! hi⟩ ∈ seen) := by simp [seenBoolList] @[simp] theorem columnMateList_getElem {n : ℕ} (mate : ColumnMate n) (i : ℕ) (hi : i < (columnMateList mate).length) : (columnMateList mate)[i] = - (mate ⟨i, by simpa using hi⟩).map Fin.val := by + (mate ⟨i, by simpa using! hi⟩).map Fin.val := by simp [columnMateList] theorem seenBoolList_insert {n : ℕ} (seen : Finset (Fin n)) (col : Fin n) : @@ -455,20 +455,20 @@ theorem machineKuhnStateControl_mem_FP : machineKuhnStateControl ∈ Complexity.FP := machinePairFirst_mem_FP theorem machineKuhnStateMatrix_mem_FP : machineKuhnStateMatrix ∈ Complexity.FP := by - simpa only [machineKuhnStateMatrix] using + simpa only [machineKuhnStateMatrix] using! machineCompose_mem_FP machinePairSecond_mem_FP machinePairFirst_mem_FP theorem machineKuhnStateDimension_mem_FP : machineKuhnStateDimension ∈ Complexity.FP := by have h := machineCompose_mem_FP machinePairSecond_mem_FP machinePairSecond_mem_FP - simpa only [machineKuhnStateDimension] using + simpa only [machineKuhnStateDimension] using! machineCompose_mem_FP h machinePairFirst_mem_FP theorem machineKuhnStateColumns_mem_FP : machineKuhnStateColumns ∈ Complexity.FP := by have h2 := machineCompose_mem_FP machinePairSecond_mem_FP machinePairSecond_mem_FP have h3 := machineCompose_mem_FP h2 machinePairSecond_mem_FP - simpa only [machineKuhnStateColumns] using + simpa only [machineKuhnStateColumns] using! machineCompose_mem_FP h3 machinePairFirst_mem_FP theorem machineKuhnStateFalseSeen_mem_FP : machineKuhnStateFalseSeen ∈ Complexity.FP := by @@ -476,7 +476,7 @@ theorem machineKuhnStateFalseSeen_mem_FP : machinePairSecond_mem_FP have h3 := machineCompose_mem_FP h2 machinePairSecond_mem_FP have h4 := machineCompose_mem_FP h3 machinePairSecond_mem_FP - simpa only [machineKuhnStateFalseSeen] using + simpa only [machineKuhnStateFalseSeen] using! machineCompose_mem_FP h4 machinePairFirst_mem_FP theorem machineKuhnStateBound_mem_FP : machineKuhnStateBound ∈ Complexity.FP := by @@ -484,7 +484,7 @@ theorem machineKuhnStateBound_mem_FP : machinePairSecond_mem_FP have h3 := machineCompose_mem_FP h2 machinePairSecond_mem_FP have h4 := machineCompose_mem_FP h3 machinePairSecond_mem_FP - simpa only [machineKuhnStateBound] using + simpa only [machineKuhnStateBound] using! machineCompose_mem_FP h4 machinePairSecond_mem_FP theorem machineKuhnFrameTag_mem_FP : machineKuhnFrameTag ∈ Complexity.FP := machinePairFirst_mem_FP @@ -505,9 +505,9 @@ def machinePairSecondN (depth : ℕ) (word : List Bool) : List Bool := theorem machinePairSecondN_mem_FP (depth : ℕ) : machinePairSecondN depth ∈ Complexity.FP := by induction depth with - | zero => simpa [machinePairSecondN] using id_mem_FP + | zero => simpa [machinePairSecondN] using! id_mem_FP | succ depth ih => - simpa [machinePairSecondN, Function.iterate_succ_apply] using + simpa [machinePairSecondN, Function.iterate_succ_apply] using! machineCompose_mem_FP machinePairSecond_mem_FP ih theorem machineKuhnControlIsDoneBit_mem_FP : @@ -515,47 +515,47 @@ theorem machineKuhnControlIsDoneBit_mem_FP : have htagTail := machineCompose_mem_FP (machineCompose_mem_FP machineKuhnControlTag_mem_FP machineTail_mem_FP) machineHeadBit_mem_FP - simpa only [machineKuhnControlIsDoneBit] using htagTail + simpa only [machineKuhnControlIsDoneBit] using! htagTail theorem machineKuhnCallFuel_mem_FP : machineKuhnCallFuel ∈ Complexity.FP := by have h := machineCompose_mem_FP (machinePairSecondN_mem_FP 1) machinePairFirst_mem_FP simpa [machineKuhnCallFuel, machineKuhnControlPayload, - machinePairSecondN, Function.iterate_succ_apply'] using h + machinePairSecondN, Function.iterate_succ_apply'] using! h theorem machineKuhnCallRemaining_mem_FP : machineKuhnCallRemaining ∈ Complexity.FP := by have h := machineCompose_mem_FP (machinePairSecondN_mem_FP 2) machinePairFirst_mem_FP simpa [machineKuhnCallRemaining, machineKuhnControlPayload, - machinePairSecondN, Function.iterate_succ_apply'] using h + machinePairSecondN, Function.iterate_succ_apply'] using! h theorem machineKuhnCallRow_mem_FP : machineKuhnCallRow ∈ Complexity.FP := by have h := machineCompose_mem_FP (machinePairSecondN_mem_FP 3) machinePairFirst_mem_FP simpa [machineKuhnCallRow, machineKuhnControlPayload, - machinePairSecondN, Function.iterate_succ_apply'] using h + machinePairSecondN, Function.iterate_succ_apply'] using! h theorem machineKuhnCallSeen_mem_FP : machineKuhnCallSeen ∈ Complexity.FP := by have h := machineCompose_mem_FP (machinePairSecondN_mem_FP 4) machinePairFirst_mem_FP simpa [machineKuhnCallSeen, machineKuhnControlPayload, - machinePairSecondN, Function.iterate_succ_apply'] using h + machinePairSecondN, Function.iterate_succ_apply'] using! h theorem machineKuhnCallMate_mem_FP : machineKuhnCallMate ∈ Complexity.FP := by have h := machineCompose_mem_FP (machinePairSecondN_mem_FP 5) machinePairFirst_mem_FP simpa [machineKuhnCallMate, machineKuhnControlPayload, - machinePairSecondN, Function.iterate_succ_apply'] using h + machinePairSecondN, Function.iterate_succ_apply'] using! h theorem machineKuhnCallStack_mem_FP : machineKuhnCallStack ∈ Complexity.FP := by simpa [machineKuhnCallStack, machineKuhnControlPayload, - machinePairSecondN, Function.iterate_succ_apply'] using + machinePairSecondN, Function.iterate_succ_apply'] using! machinePairSecondN_mem_FP 6 theorem machineKuhnReturnSuccess_mem_FP : @@ -563,26 +563,26 @@ theorem machineKuhnReturnSuccess_mem_FP : have h := machineCompose_mem_FP (machinePairSecondN_mem_FP 1) machinePairFirst_mem_FP simpa [machineKuhnReturnSuccess, machineKuhnControlPayload, - machinePairSecondN, Function.iterate_succ_apply'] using h + machinePairSecondN, Function.iterate_succ_apply'] using! h theorem machineKuhnReturnSeen_mem_FP : machineKuhnReturnSeen ∈ Complexity.FP := by have h := machineCompose_mem_FP (machinePairSecondN_mem_FP 2) machinePairFirst_mem_FP simpa [machineKuhnReturnSeen, machineKuhnControlPayload, - machinePairSecondN, Function.iterate_succ_apply'] using h + machinePairSecondN, Function.iterate_succ_apply'] using! h theorem machineKuhnReturnMate_mem_FP : machineKuhnReturnMate ∈ Complexity.FP := by have h := machineCompose_mem_FP (machinePairSecondN_mem_FP 3) machinePairFirst_mem_FP simpa [machineKuhnReturnMate, machineKuhnControlPayload, - machinePairSecondN, Function.iterate_succ_apply'] using h + machinePairSecondN, Function.iterate_succ_apply'] using! h theorem machineKuhnReturnStack_mem_FP : machineKuhnReturnStack ∈ Complexity.FP := by simpa [machineKuhnReturnStack, machineKuhnControlPayload, - machinePairSecondN, Function.iterate_succ_apply'] using + machinePairSecondN, Function.iterate_succ_apply'] using! machinePairSecondN_mem_FP 4 theorem machineKuhnDoneMate_mem_FP : @@ -593,44 +593,44 @@ theorem machineKuhnSearchFrameFuel_mem_FP : have h := machineCompose_mem_FP (machinePairSecondN_mem_FP 1) machinePairFirst_mem_FP simpa [machineKuhnSearchFrameFuel, machineKuhnFramePayload, - machinePairSecondN, Function.iterate_succ_apply'] using h + machinePairSecondN, Function.iterate_succ_apply'] using! h theorem machineKuhnSearchFrameRemaining_mem_FP : machineKuhnSearchFrameRemaining ∈ Complexity.FP := by have h := machineCompose_mem_FP (machinePairSecondN_mem_FP 2) machinePairFirst_mem_FP simpa [machineKuhnSearchFrameRemaining, machineKuhnFramePayload, - machinePairSecondN, Function.iterate_succ_apply'] using h + machinePairSecondN, Function.iterate_succ_apply'] using! h theorem machineKuhnSearchFrameRow_mem_FP : machineKuhnSearchFrameRow ∈ Complexity.FP := by have h := machineCompose_mem_FP (machinePairSecondN_mem_FP 3) machinePairFirst_mem_FP simpa [machineKuhnSearchFrameRow, machineKuhnFramePayload, - machinePairSecondN, Function.iterate_succ_apply'] using h + machinePairSecondN, Function.iterate_succ_apply'] using! h theorem machineKuhnSearchFrameMate_mem_FP : machineKuhnSearchFrameMate ∈ Complexity.FP := by have h := machineCompose_mem_FP (machinePairSecondN_mem_FP 4) machinePairFirst_mem_FP simpa [machineKuhnSearchFrameMate, machineKuhnFramePayload, - machinePairSecondN, Function.iterate_succ_apply'] using h + machinePairSecondN, Function.iterate_succ_apply'] using! h theorem machineKuhnSearchFrameColumn_mem_FP : machineKuhnSearchFrameColumn ∈ Complexity.FP := by simpa [machineKuhnSearchFrameColumn, machineKuhnFramePayload, - machinePairSecondN, Function.iterate_succ_apply'] using + machinePairSecondN, Function.iterate_succ_apply'] using! machinePairSecondN_mem_FP 5 theorem machineKuhnBuildFrameRows_mem_FP : machineKuhnBuildFrameRows ∈ Complexity.FP := by have h := machineCompose_mem_FP machinePairSecond_mem_FP machinePairFirst_mem_FP - simpa [machineKuhnBuildFrameRows, machineKuhnFramePayload] using h + simpa [machineKuhnBuildFrameRows, machineKuhnFramePayload] using! h theorem machineKuhnBuildFrameFallback_mem_FP : machineKuhnBuildFrameFallback ∈ Complexity.FP := by - simpa [machineKuhnBuildFrameFallback, machineKuhnFramePayload] using + simpa [machineKuhnBuildFrameFallback, machineKuhnFramePayload] using! machineCompose_mem_FP machinePairSecond_mem_FP machinePairSecond_mem_FP end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineKuhnInvariant.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineKuhnInvariant.lean index 33e11c9f81..1aa1bbc9f3 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineKuhnInvariant.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineKuhnInvariant.lean @@ -152,10 +152,10 @@ theorem kuhnEvalIterate_reachableBound {n steps : ℕ} (hstate : KuhnEvalReachableBound 0 state) : KuhnEvalReachableBound steps ((kuhnEvalStep A)^[steps] state) := by induction steps with - | zero => simpa using hstate + | zero => simpa using! hstate | succ steps ih => rw [Function.iterate_succ_apply'] - simpa [Nat.succ_eq_add_one] using + simpa [Nat.succ_eq_add_one] using! kuhnEvalStep_reachableBound A _ ih /-! ## Length of canonical control words -/ @@ -206,7 +206,7 @@ theorem mateVectorCode_columnMate_length_le {n : ℕ} ((columnMateList mate).map (fun value ↦ 2 * (mateValueCode value).length + 2)).sum ≤ (columnMateList mate).length * (2 * n + 4) := by - simpa [Nat.nsmul_eq_mul] using + simpa [Nat.nsmul_eq_mul] using! List.sum_le_card_nsmul ((columnMateList mate).map (fun value ↦ 2 * (mateValueCode value).length + 2)) @@ -306,7 +306,7 @@ theorem kuhnControlCode_length_le {n steps : ℕ} n * (2 * n + 4) := by cases hmateEq : result.mate? with | none => simp [kuhnSearchResultMateCode, hmateEq] - | some mate => simpa [kuhnSearchResultMateCode, hmateEq] using + | some mate => simpa [kuhnSearchResultMateCode, hmateEq] using! mateVectorCode_columnMate_length_le mate have hstackCode := kuhnStackCode_length_le stack hstack have hstackCode' : (kuhnStackCode stack).length ≤ @@ -399,7 +399,7 @@ theorem kuhnDimensionCode_length_le_inputBound {n : ℕ} (machineKuhnInputBound (rationalMatrixBinaryEncoding.encode ⟨n, A⟩)).length := by have hn := matrix_dimension_le_code_length A - simpa using hn.trans (kuhnMatrixCode_length_le_inputBound A) + simpa using! hn.trans (kuhnMatrixCode_length_le_inputBound A) theorem kuhnColumnsCode_length_le_inputBound {n : ℕ} (A : Matrix (Fin n) (Fin n) ℚ) : @@ -408,7 +408,7 @@ theorem kuhnColumnsCode_length_le_inputBound {n : ℕ} (rationalMatrixBinaryEncoding.encode ⟨n, A⟩)).length := by let matrix := rationalMatrixBinaryEncoding.encode ⟨n, A⟩ have hcolumns : (finRangeUnaryCode n).length ≤ n * (2 * n + 2) := by - simpa [finRangeUnaryCode, finListUnaryCode] using + simpa [finRangeUnaryCode, finListUnaryCode] using! finListUnaryCode_length_le (List.finRange n) have hn : n + 16 ≤ matrix.length + 16 := by exact Nat.add_le_add_right (matrix_dimension_le_code_length A) 16 @@ -482,7 +482,7 @@ theorem machineKuhnIterate_encode {n iterations : ℕ} ih hprefix] apply machineKuhnStep_encode A · exact kuhnEvalIterate_reachableBound A initial hinitial - · simpa [Nat.succ_eq_add_one] using hiterations + · simpa [Nat.succ_eq_add_one] using! hiterations @[simp] theorem kuhnEvalIterate_done {n iterations : ℕ} (A : Matrix (Fin n) (Fin n) ℚ) (mate : ColumnMate n) : @@ -508,7 +508,7 @@ theorem kuhnFullEval_budget {n : ℕ} rw [show (kuhnEvalStep A)^[exactSteps] (kuhnBuildEvalState A (List.finRange n) (emptyColumnMate n)) = .done (kuhnColumnMate A) by - simpa [exactSteps] using kuhnFullBuildEvalState_iterate A] + simpa [exactSteps] using! kuhnFullBuildEvalState_iterate A] simp theorem machineKuhnFullIterate_encode {n : ℕ} diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineKuhnRunner.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineKuhnRunner.lean index b12a2f70bb..c704c737a2 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineKuhnRunner.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineKuhnRunner.lean @@ -72,19 +72,19 @@ theorem machineKuhnInitDimension_mem_FP : theorem machineKuhnInitColumns_mem_FP : machineKuhnInitColumns ∈ Complexity.FP := by - simpa only [machineKuhnInitColumns] using + simpa only [machineKuhnInitColumns] using! machineCompose_mem_FP machineKuhnInitDimension_mem_FP machineUnaryRangeCode_mem_FP theorem machineKuhnInitFalseSeen_mem_FP : machineKuhnInitFalseSeen ∈ Complexity.FP := by - simpa only [machineKuhnInitFalseSeen] using + simpa only [machineKuhnInitFalseSeen] using! machineCompose_mem_FP machineKuhnInitDimension_mem_FP machineFalseVectorCode_mem_FP theorem machineKuhnInitEmptyMate_mem_FP : machineKuhnInitEmptyMate ∈ Complexity.FP := by - simpa only [machineKuhnInitEmptyMate] using + simpa only [machineKuhnInitEmptyMate] using! machineCompose_mem_FP machineKuhnInitDimension_mem_FP machineEmptyMateVectorCode_mem_FP @@ -123,7 +123,7 @@ theorem machineKuhnInitControl_mem_FP : theorem machineKuhnInputBound_mem_FP : machineKuhnInputBound ∈ Complexity.FP := by - simpa only [machineKuhnInputBound] using + simpa only [machineKuhnInputBound] using! machineCompose_mem_FP machineListUpdateInputBound_mem_FP machineBinaryMulWidth_mem_FP @@ -131,7 +131,7 @@ theorem machineKuhnInputClamp_mem_FP {candidate : List Bool → List Bool} (hcandidate : candidate ∈ Complexity.FP) : (fun matrix ↦ machineKuhnInputClamp matrix (candidate matrix)) ∈ Complexity.FP := by - simpa only [machineKuhnInputClamp] using + simpa only [machineKuhnInputClamp] using! machineTake_mem_FP machineKuhnInputBound_mem_FP hcandidate theorem machineKuhnInit_mem_FP : machineKuhnInit ∈ Complexity.FP := by @@ -158,7 +158,7 @@ theorem machineKuhnInitDimension_length_le (matrix : List Bool) : (machineBoundedUnaryInit word))).length ≤ matrix.length at hacc simpa [machineKuhnInitDimension, machineMatrixDimensionUnary, machineBoundedUnary, machineBoundedUnaryFinalState, - machineBoundedUnaryRuler, word] using hacc + machineBoundedUnaryRuler, word] using! hacc theorem machineUnaryRangeCode_length_le_inputBound (ruler : List Bool) : (machineUnaryRangeCode ruler).length ≤ @@ -166,7 +166,7 @@ theorem machineUnaryRangeCode_length_le_inputBound (ruler : List Bool) : have hbound := machineUnaryRangeIterate_bound ruler ruler.length dsimp only [MachineUnaryRangeStateBound] at hbound rcases hbound with ⟨_hpack, _hremaining, hacc, _hbound⟩ - simpa [machineUnaryRangeCode, machineUnaryRangeFinalState] using hacc + simpa [machineUnaryRangeCode, machineUnaryRangeFinalState] using! hacc @[simp] theorem machineFalseVectorCode_length (ruler : List Bool) : (machineFalseVectorCode ruler).length = 4 * ruler.length := by @@ -225,7 +225,7 @@ theorem machineKuhnInitEmptyMate_length_le_bound (matrix : List Bool) : (machineKuhnInitEmptyMate matrix).length ≤ (machineKuhnInputBound matrix).length := by simpa [machineKuhnInitEmptyMate, machineKuhnInitFalseSeen, - machineEmptyMateVectorCode] using + machineEmptyMateVectorCode] using! machineKuhnInitFalseSeen_length_le_bound matrix /-! ## A generic invariant for the outer bounded iteration -/ @@ -285,7 +285,7 @@ theorem machineKuhnIterate_bound (matrix : List Bool) : ∀ iterations, ((machineKuhnStep^[iterations]) (machineKuhnInit matrix)) := by intro iterations induction iterations with - | zero => simpa using machineKuhnInit_bound matrix + | zero => simpa using! machineKuhnInit_bound matrix | succ iterations ih => rw [Function.iterate_succ_apply'] exact machineKuhnStep_bound ih @@ -295,7 +295,7 @@ def machineKuhnRunWidth (matrix : List Bool) : List Bool := theorem machineKuhnRunWidth_mem_FP : machineKuhnRunWidth ∈ Complexity.FP := by - simpa only [machineKuhnRunWidth] using + simpa only [machineKuhnRunWidth] using! machineCompose_mem_FP machineKuhnInputBound_mem_FP machineBinaryMulWidth_mem_FP @@ -339,7 +339,7 @@ def machineKuhnFinalState (matrix : List Bool) : List Bool := theorem machineKuhnFinalState_mem_FP : machineKuhnFinalState ∈ Complexity.FP := by - simpa only [machineKuhnFinalState] using + simpa only [machineKuhnFinalState] using! Cobham.iterate_mem_FP machineKuhnStep_mem_FP machineKuhnInit_mem_FP machineKuhnInputBound_mem_FP machineKuhnRunWidth_mem_FP machineKuhnIterate_length_le_width diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineKuhnSemantics.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineKuhnSemantics.lean index d5b4cb8df8..f71484789b 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineKuhnSemantics.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineKuhnSemantics.lean @@ -50,7 +50,7 @@ open Complexity (pair (List.replicate column true) (pair (true :: List.replicate row true) (mateVectorCode mate))) = mateVectorCode (mate.set column (some row)) := by - simpa [mateValueCode] using + simpa [mateValueCode] using! machineMateVectorUpdateAtUnary_encode mate column (some row) hcolumn @[simp] theorem seenBoolList_empty {n : ℕ} : diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineKuhnStep.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineKuhnStep.lean index 2a7ec777ac..00971f5b59 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineKuhnStep.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineKuhnStep.lean @@ -63,44 +63,44 @@ theorem machineKuhnControl_mem_FP : machineKuhnControl ∈ Complexity.FP := machineKuhnStateControl_mem_FP theorem machineKuhnFuel_mem_FP : machineKuhnFuel ∈ Complexity.FP := by - simpa only [machineKuhnFuel] using + simpa only [machineKuhnFuel] using! machineCompose_mem_FP machineKuhnControl_mem_FP machineKuhnCallFuel_mem_FP theorem machineKuhnRemaining_mem_FP : machineKuhnRemaining ∈ Complexity.FP := by - simpa only [machineKuhnRemaining] using + simpa only [machineKuhnRemaining] using! machineCompose_mem_FP machineKuhnControl_mem_FP machineKuhnCallRemaining_mem_FP theorem machineKuhnRow_mem_FP : machineKuhnRow ∈ Complexity.FP := by - simpa only [machineKuhnRow] using + simpa only [machineKuhnRow] using! machineCompose_mem_FP machineKuhnControl_mem_FP machineKuhnCallRow_mem_FP theorem machineKuhnSeen_mem_FP : machineKuhnSeen ∈ Complexity.FP := by - simpa only [machineKuhnSeen] using + simpa only [machineKuhnSeen] using! machineCompose_mem_FP machineKuhnControl_mem_FP machineKuhnCallSeen_mem_FP theorem machineKuhnMate_mem_FP : machineKuhnMate ∈ Complexity.FP := by - simpa only [machineKuhnMate] using + simpa only [machineKuhnMate] using! machineCompose_mem_FP machineKuhnControl_mem_FP machineKuhnCallMate_mem_FP theorem machineKuhnStack_mem_FP : machineKuhnStack ∈ Complexity.FP := by - simpa only [machineKuhnStack] using + simpa only [machineKuhnStack] using! machineCompose_mem_FP machineKuhnControl_mem_FP machineKuhnCallStack_mem_FP theorem machineKuhnRetSuccess_mem_FP : machineKuhnRetSuccess ∈ Complexity.FP := by - simpa only [machineKuhnRetSuccess] using + simpa only [machineKuhnRetSuccess] using! machineCompose_mem_FP machineKuhnControl_mem_FP machineKuhnReturnSuccess_mem_FP theorem machineKuhnRetSeen_mem_FP : machineKuhnRetSeen ∈ Complexity.FP := by - simpa only [machineKuhnRetSeen] using + simpa only [machineKuhnRetSeen] using! machineCompose_mem_FP machineKuhnControl_mem_FP machineKuhnReturnSeen_mem_FP theorem machineKuhnRetMate_mem_FP : machineKuhnRetMate ∈ Complexity.FP := by - simpa only [machineKuhnRetMate] using + simpa only [machineKuhnRetMate] using! machineCompose_mem_FP machineKuhnControl_mem_FP machineKuhnReturnMate_mem_FP theorem machineKuhnRetStack_mem_FP : machineKuhnRetStack ∈ Complexity.FP := by - simpa only [machineKuhnRetStack] using + simpa only [machineKuhnRetStack] using! machineCompose_mem_FP machineKuhnControl_mem_FP machineKuhnReturnStack_mem_FP theorem machineKuhnTopFrame_mem_FP : machineKuhnTopFrame ∈ Complexity.FP := by - simpa only [machineKuhnTopFrame] using + simpa only [machineKuhnTopFrame] using! machineCompose_mem_FP machineKuhnRetStack_mem_FP machineKuhnStackHead_mem_FP theorem machineKuhnRestStack_mem_FP : machineKuhnRestStack ∈ Complexity.FP := by - simpa only [machineKuhnRestStack] using + simpa only [machineKuhnRestStack] using! machineCompose_mem_FP machineKuhnRetStack_mem_FP machineKuhnStackTail_mem_FP @@ -120,7 +120,7 @@ def machineKuhnWithControl (state control : List Bool) : List Bool := theorem machineKuhnClamp_mem_FP {candidate : List Bool → List Bool} (hcandidate : candidate ∈ Complexity.FP) : (fun state ↦ machineKuhnClamp state (candidate state)) ∈ Complexity.FP := by - simpa only [machineKuhnClamp] using + simpa only [machineKuhnClamp] using! machineTake_mem_FP machineKuhnStateBound_mem_FP hcandidate theorem machineKuhnWithControl_mem_FP @@ -310,18 +310,18 @@ def machineKuhnStep (state : List Bool) : List Bool := theorem machineKuhnCurrentColumn_mem_FP : machineKuhnCurrentColumn ∈ Complexity.FP := by - simpa only [machineKuhnCurrentColumn] using + simpa only [machineKuhnCurrentColumn] using! machineCompose_mem_FP machineKuhnRemaining_mem_FP machineListHead_mem_FP theorem machineKuhnRemainingTail_mem_FP : machineKuhnRemainingTail ∈ Complexity.FP := by - simpa only [machineKuhnRemainingTail] using + simpa only [machineKuhnRemainingTail] using! machineCompose_mem_FP machineKuhnRemaining_mem_FP machineListTail_mem_FP theorem machineKuhnSeenBit_mem_FP : machineKuhnSeenBit ∈ Complexity.FP := by have hp := machinePair_mem_FP machineKuhnCurrentColumn_mem_FP machineKuhnSeen_mem_FP - simpa only [machineKuhnSeenBit] using + simpa only [machineKuhnSeenBit] using! machineCompose_mem_FP hp machineBoolVectorEntryAtUnary_mem_FP theorem machineKuhnSupportBit_mem_FP : @@ -329,7 +329,7 @@ theorem machineKuhnSupportBit_mem_FP : have hp := machinePair_mem_FP machineKuhnRow_mem_FP (machinePair_mem_FP machineKuhnCurrentColumn_mem_FP machineKuhnStateMatrix_mem_FP) - simpa only [machineKuhnSupportBit] using + simpa only [machineKuhnSupportBit] using! machineCompose_mem_FP hp machineRationalSupportBitAtUnary_mem_FP theorem machineKuhnSkipBit_mem_FP : machineKuhnSkipBit ∈ Complexity.FP := by @@ -340,38 +340,38 @@ theorem machineKuhnSeenUpdated_mem_FP : machineKuhnSeenUpdated ∈ Complexity.FP := by have hp := machinePair_mem_FP machineKuhnCurrentColumn_mem_FP (machinePair_mem_FP (machineConst_mem_FP [true]) machineKuhnSeen_mem_FP) - simpa only [machineKuhnSeenUpdated] using + simpa only [machineKuhnSeenUpdated] using! machineCompose_mem_FP hp machineBoolVectorUpdateAtUnary_mem_FP theorem machineKuhnMateValue_mem_FP : machineKuhnMateValue ∈ Complexity.FP := by have hp := machinePair_mem_FP machineKuhnCurrentColumn_mem_FP machineKuhnMate_mem_FP - simpa only [machineKuhnMateValue] using + simpa only [machineKuhnMateValue] using! machineCompose_mem_FP hp machineMateVectorGetAtUnary_mem_FP theorem machineKuhnMateIsNoneBit_mem_FP : machineKuhnMateIsNoneBit ∈ Complexity.FP := by - simpa only [machineKuhnMateIsNoneBit] using + simpa only [machineKuhnMateIsNoneBit] using! machineCompose_mem_FP machineKuhnMateValue_mem_FP machineMateValueIsNoneBit_mem_FP theorem machineKuhnSomeCurrentRow_mem_FP : machineKuhnSomeCurrentRow ∈ Complexity.FP := by - simpa only [machineKuhnSomeCurrentRow] using + simpa only [machineKuhnSomeCurrentRow] using! machineCompose_mem_FP machineKuhnRow_mem_FP (machinePrepend_mem_FP true) theorem machineKuhnMateSetCurrent_mem_FP : machineKuhnMateSetCurrent ∈ Complexity.FP := by have hp := machinePair_mem_FP machineKuhnCurrentColumn_mem_FP (machinePair_mem_FP machineKuhnSomeCurrentRow_mem_FP machineKuhnMate_mem_FP) - simpa only [machineKuhnMateSetCurrent] using + simpa only [machineKuhnMateSetCurrent] using! machineCompose_mem_FP hp machineMateVectorUpdateAtUnary_mem_FP theorem machineKuhnMateClearCurrent_mem_FP : machineKuhnMateClearCurrent ∈ Complexity.FP := by have hp := machinePair_mem_FP machineKuhnCurrentColumn_mem_FP (machinePair_mem_FP (machineConst_mem_FP [false]) machineKuhnMate_mem_FP) - simpa only [machineKuhnMateClearCurrent] using + simpa only [machineKuhnMateClearCurrent] using! machineCompose_mem_FP hp machineMateVectorUpdateAtUnary_mem_FP theorem machineKuhnFailureControl_mem_FP : @@ -461,7 +461,7 @@ theorem machineKuhnSearchReturnFailureControl_mem_FP : machineKuhnSearchReturnFailureControl ∈ Complexity.FP := by have hfield (f : List Bool → List Bool) (hf : f ∈ Complexity.FP) : (fun state ↦ f (machineKuhnTopFrame state)) ∈ Complexity.FP := - by simpa only using + by simpa only using! machineCompose_mem_FP machineKuhnTopFrame_mem_FP hf exact machinePair_mem_FP (machineConst_mem_FP [false]) (machinePair_mem_FP @@ -491,7 +491,7 @@ theorem machineKuhnBuildChosenMate_mem_FP : machineKuhnRetMate_mem_FP hfallback theorem machineKuhnBuildRows_mem_FP : machineKuhnBuildRows ∈ Complexity.FP := by - simpa only [machineKuhnBuildRows] using + simpa only [machineKuhnBuildRows] using! machineCompose_mem_FP machineKuhnTopFrame_mem_FP machineKuhnBuildFrameRows_mem_FP @@ -554,7 +554,7 @@ theorem machineKuhnNextControl_mem_FP : exact machineIfHead_mem_FP htag hretOrDone machineKuhnCallControl_mem_FP theorem machineKuhnStep_mem_FP : machineKuhnStep ∈ Complexity.FP := by - simpa only [machineKuhnStep] using + simpa only [machineKuhnStep] using! machineKuhnWithControl_mem_FP machineKuhnNextControl_mem_FP end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineListIndex.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineListIndex.lean index 3b7b25ecfd..49c0bd7de4 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineListIndex.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineListIndex.lean @@ -45,7 +45,7 @@ theorem machineListIndexData_mem_FP : theorem machineListTail_length_le (word : List Bool) : (machineListTail word).length ≤ word.length := by - simpa only [machineListTail] using machinePairSecond_length_le word + simpa only [machineListTail] using! machinePairSecond_length_le word theorem machineListTail_iterate_length_le (word : List Bool) : ∀ k, ((machineListTail)^[k] word).length ≤ word.length := by @@ -73,7 +73,7 @@ theorem machineListIndexFinalState_mem_FP : theorem machineListIndex_mem_FP : machineListIndex ∈ Complexity.FP := by - simpa only [machineListIndex] using + simpa only [machineListIndex] using! machineCompose_mem_FP machineListIndexFinalState_mem_FP machineListHead_mem_FP @@ -99,7 +99,7 @@ theorem machineListTail_iterate_binaryListCode | nil => have htail : machineListTail [] = [] := by rfl - simpa [binaryListCode] using ih ([] : List α) + simpa [binaryListCode] using! ih ([] : List α) | cons x xs => rw [machineListTail_cons, ih] rfl @@ -150,7 +150,7 @@ theorem machineMatrixEntryAtUnary_mem_FP : have hrowPayload := machinePair_mem_FP hrowUnary hrows have hrowCode := machineCompose_mem_FP hrowPayload machineListIndex_mem_FP have hentryPayload := machinePair_mem_FP hcolumnUnary hrowCode - simpa only [machineMatrixEntryAtUnary] using + simpa only [machineMatrixEntryAtUnary] using! machineCompose_mem_FP hentryPayload machineListIndex_mem_FP @[simp] theorem machineMatrixEntryAtUnary_encode {n : ℕ} diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineListReverse.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineListReverse.lean index c6b8c853f4..ceea64fbaa 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineListReverse.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineListReverse.lean @@ -70,12 +70,12 @@ theorem machineListReverseRemaining_mem_FP : theorem machineListReverseAccumulator_mem_FP : machineListReverseAccumulator ∈ Complexity.FP := by - simpa only [machineListReverseAccumulator] using + simpa only [machineListReverseAccumulator] using! machineCompose_mem_FP machinePairSecond_mem_FP machinePairFirst_mem_FP theorem machineListReverseBound_mem_FP : machineListReverseBound ∈ Complexity.FP := by - simpa only [machineListReverseBound] using + simpa only [machineListReverseBound] using! machineCompose_mem_FP machinePairSecond_mem_FP machinePairSecond_mem_FP theorem machineListReverseCandidate_mem_FP : @@ -86,7 +86,7 @@ theorem machineListReverseCandidate_mem_FP : theorem machineListReverseNextAccumulator_mem_FP : machineListReverseNextAccumulator ∈ Complexity.FP := by - simpa only [machineListReverseNextAccumulator] using + simpa only [machineListReverseNextAccumulator] using! machineTake_mem_FP machineListReverseBound_mem_FP machineListReverseCandidate_mem_FP @@ -188,7 +188,7 @@ theorem machineListReverseFinalState_mem_FP : machineListReverseIterate_length_le_width theorem machineListReverse_mem_FP : machineListReverse ∈ Complexity.FP := by - simpa only [machineListReverse] using + simpa only [machineListReverse] using! machineCompose_mem_FP machineListReverseFinalState_mem_FP machineListReverseAccumulator_mem_FP @@ -220,7 +220,7 @@ theorem machineListReverseStep_semantics have hprefix : (xs.take (k + 1)).reverse = xs[k] :: (xs.take k).reverse := by rw [← htake] - simpa only [List.concat_eq_append] using + simpa only [List.concat_eq_append] using! (List.reverse_concat (l := xs.take k) (a := xs[k])) have hprefixLength : (binaryListCode encode (xs.take (k + 1)).reverse).length ≤ diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineListUpdate.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineListUpdate.lean index d30c0f24fb..86b0f42efb 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineListUpdate.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineListUpdate.lean @@ -102,19 +102,19 @@ theorem machineListUpdatePayload_mem_FP : theorem machineListUpdateReplacement_mem_FP : machineListUpdateReplacement ∈ Complexity.FP := by - simpa only [machineListUpdateReplacement] using + simpa only [machineListUpdateReplacement] using! machineCompose_mem_FP machineListUpdatePayload_mem_FP machinePairFirst_mem_FP theorem machineListUpdateData_mem_FP : machineListUpdateData ∈ Complexity.FP := by - simpa only [machineListUpdateData] using + simpa only [machineListUpdateData] using! machineCompose_mem_FP machineListUpdatePayload_mem_FP machinePairSecond_mem_FP theorem machineListUpdateInputBound_mem_FP : machineListUpdateInputBound ∈ Complexity.FP := by - simpa only [machineListUpdateInputBound] using + simpa only [machineListUpdateInputBound] using! machineCompose_mem_FP machineBinaryMulWidth_mem_FP machineBinaryMulWidth_mem_FP @@ -124,7 +124,7 @@ theorem machineBinaryMulWidth_length_mono {left right : List Bool} (machineBinaryMulWidth right).length := by simp only [machineBinaryMulWidth, List.length_replicate, List.length_append] - simpa [pow_two] using + simpa [pow_two] using! Nat.pow_le_pow_left (Nat.add_le_add_left h 16) 2 theorem machineListUpdateInputBound_length_mono {left right : List Bool} @@ -140,14 +140,14 @@ theorem machineListUpdateScanRemaining_mem_FP : theorem machineListUpdateScanPrefix_mem_FP : machineListUpdateScanPrefix ∈ Complexity.FP := by - simpa only [machineListUpdateScanPrefix] using + simpa only [machineListUpdateScanPrefix] using! machineCompose_mem_FP machinePairSecond_mem_FP machinePairFirst_mem_FP theorem machineListUpdateScanCurrent_mem_FP : machineListUpdateScanCurrent ∈ Complexity.FP := by have htail := machineCompose_mem_FP machinePairSecond_mem_FP machinePairSecond_mem_FP - simpa only [machineListUpdateScanCurrent] using + simpa only [machineListUpdateScanCurrent] using! machineCompose_mem_FP htail machinePairFirst_mem_FP theorem machineListUpdateScanReplacement_mem_FP : @@ -155,7 +155,7 @@ theorem machineListUpdateScanReplacement_mem_FP : have htailTwo := machineCompose_mem_FP machinePairSecond_mem_FP machinePairSecond_mem_FP have htailThree := machineCompose_mem_FP htailTwo machinePairSecond_mem_FP - simpa only [machineListUpdateScanReplacement] using + simpa only [machineListUpdateScanReplacement] using! machineCompose_mem_FP htailThree machinePairFirst_mem_FP theorem machineListUpdateScanBound_mem_FP : @@ -163,7 +163,7 @@ theorem machineListUpdateScanBound_mem_FP : have htailTwo := machineCompose_mem_FP machinePairSecond_mem_FP machinePairSecond_mem_FP have htailThree := machineCompose_mem_FP htailTwo machinePairSecond_mem_FP - simpa only [machineListUpdateScanBound] using + simpa only [machineListUpdateScanBound] using! machineCompose_mem_FP htailThree machinePairSecond_mem_FP theorem machineListUpdateScanPrefixCandidate_mem_FP : @@ -174,7 +174,7 @@ theorem machineListUpdateScanPrefixCandidate_mem_FP : theorem machineListUpdateScanNextPrefix_mem_FP : machineListUpdateScanNextPrefix ∈ Complexity.FP := by - simpa only [machineListUpdateScanNextPrefix] using + simpa only [machineListUpdateScanNextPrefix] using! machineTake_mem_FP machineListUpdateScanBound_mem_FP machineListUpdateScanPrefixCandidate_mem_FP @@ -195,7 +195,7 @@ theorem machineListUpdateScanStep_mem_FP : have hinner := machineIfEmpty_mem_FP machineListUpdateScanCurrent_mem_FP id_mem_FP machineListUpdateScanAdvance_mem_FP - simpa only [machineListUpdateScanStep] using + simpa only [machineListUpdateScanStep] using! machineIfEmpty_mem_FP machineListUpdateScanRemaining_mem_FP id_mem_FP hinner @@ -415,7 +415,7 @@ theorem machineListUpdateSeed_mem_FP : have hbound := machineCompose_mem_FP hscan machineListUpdateScanBound_mem_FP have htaken := machineTake_mem_FP hbound hcandidate - simpa only [machineListUpdateSeed, scan] using + simpa only [machineListUpdateSeed, scan] using! machineIfEmpty_mem_FP hcurrent (machineConst_mem_FP []) htaken theorem machineListUpdateRebuildPrefix_mem_FP : @@ -424,12 +424,12 @@ theorem machineListUpdateRebuildPrefix_mem_FP : theorem machineListUpdateRebuildOutput_mem_FP : machineListUpdateRebuildOutput ∈ Complexity.FP := by - simpa only [machineListUpdateRebuildOutput] using + simpa only [machineListUpdateRebuildOutput] using! machineCompose_mem_FP machinePairSecond_mem_FP machinePairFirst_mem_FP theorem machineListUpdateRebuildBound_mem_FP : machineListUpdateRebuildBound ∈ Complexity.FP := by - simpa only [machineListUpdateRebuildBound] using + simpa only [machineListUpdateRebuildBound] using! machineCompose_mem_FP machinePairSecond_mem_FP machinePairSecond_mem_FP theorem machineListUpdateRebuildCandidate_mem_FP : @@ -440,7 +440,7 @@ theorem machineListUpdateRebuildCandidate_mem_FP : theorem machineListUpdateRebuildNextOutput_mem_FP : machineListUpdateRebuildNextOutput ∈ Complexity.FP := by - simpa only [machineListUpdateRebuildNextOutput] using + simpa only [machineListUpdateRebuildNextOutput] using! machineTake_mem_FP machineListUpdateRebuildBound_mem_FP machineListUpdateRebuildCandidate_mem_FP @@ -454,7 +454,7 @@ theorem machineListUpdateRebuildAdvance_mem_FP : theorem machineListUpdateRebuildStep_mem_FP : machineListUpdateRebuildStep ∈ Complexity.FP := by - simpa only [machineListUpdateRebuildStep] using + simpa only [machineListUpdateRebuildStep] using! machineIfEmpty_mem_FP machineListUpdateRebuildPrefix_mem_FP id_mem_FP machineListUpdateRebuildAdvance_mem_FP @@ -576,7 +576,7 @@ theorem machineListUpdateRebuildFinalState_mem_FP : theorem machineListUpdate_mem_FP : machineListUpdate ∈ Complexity.FP := by - simpa only [machineListUpdate] using + simpa only [machineListUpdate] using! machineCompose_mem_FP machineListUpdateRebuildFinalState_mem_FP machineListUpdateRebuildOutput_mem_FP @@ -682,7 +682,7 @@ theorem machineListUpdateScanStep_semantics have hprefix : (xs.take (k + 1)).reverse = xs[k] :: (xs.take k).reverse := by rw [← htake] - simpa only [List.concat_eq_append] using + simpa only [List.concat_eq_append] using! (List.reverse_concat (l := xs.take k) (a := xs[k])) have hprefixLength : (binaryListCode encode (xs.take (k + 1)).reverse).length ≤ @@ -872,12 +872,12 @@ theorem machineListUpdateRebuildStep_semantics have hpart : (pref.take (k + 1)).reverse = pref[k] :: (pref.take k).reverse := by rw [← htake] - simpa only [List.concat_eq_append] using + simpa only [List.concat_eq_append] using! (List.reverse_concat (l := pref.take k) (a := pref[k])) have hprefCodeLength : (binaryListCode encode pref).length ≤ (binaryListCode encode xs).length := by - simpa only [pref] using + simpa only [pref] using! binaryListCode_take_reverse_length_le encode xs index have hpartCodeLength : (binaryListCode encode (pref.take (k + 1)).reverse).length ≤ @@ -899,7 +899,7 @@ theorem machineListUpdateRebuildStep_semantics (machineListUpdateInputBound word).length := by rw [binaryListCode_append_length] exact (Nat.add_le_add hpartCodeLength hsuffixCodeLength).trans - (by simpa [two_mul] using + (by simpa [two_mul] using! machineListUpdate_double_word_length_le_bound word) have htakeBound : (binaryListCode encode @@ -959,7 +959,7 @@ theorem machineListUpdateRebuildIterate_semantics intro k hk induction k with | zero => - simpa using (machineListUpdateRebuildInit_semantics + simpa using! (machineListUpdateRebuildInit_semantics encode xs replacement index hindex) | succ k ih => rw [Function.iterate_succ_apply', ih (by omega)] diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineMatchingGain.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineMatchingGain.lean index 2c11115f83..f107efbf33 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineMatchingGain.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineMatchingGain.lean @@ -71,12 +71,12 @@ theorem machineListCountRemaining_mem_FP : theorem machineListCountCounter_mem_FP : machineListCountCounter ∈ FP := by - simpa only [machineListCountCounter] using machineCompose_mem_FP + simpa only [machineListCountCounter] using! machineCompose_mem_FP machinePairSecond_mem_FP machinePairFirst_mem_FP theorem machineListCountSource_mem_FP : machineListCountSource ∈ FP := by - simpa only [machineListCountSource] using machineCompose_mem_FP + simpa only [machineListCountSource] using! machineCompose_mem_FP machinePairSecond_mem_FP machinePairSecond_mem_FP theorem machineListCountInputBound_mem_FP : @@ -85,7 +85,7 @@ theorem machineListCountInputBound_mem_FP : theorem machineListCountBound_mem_FP : machineListCountBound ∈ FP := by - simpa only [machineListCountBound] using machineCompose_mem_FP + simpa only [machineListCountBound] using! machineCompose_mem_FP machineListCountSource_mem_FP machineListCountInputBound_mem_FP theorem machineListCountNextCounter_mem_FP : @@ -93,7 +93,7 @@ theorem machineListCountNextCounter_mem_FP : have hinput := machinePair_mem_FP machineListCountCounter_mem_FP (machineConst_mem_FP [true]) have hadd := machineCompose_mem_FP hinput machineBinaryAddBits_mem_FP - simpa only [machineListCountNextCounter] using + simpa only [machineListCountNextCounter] using! machineTake_mem_FP machineListCountBound_mem_FP hadd theorem machineListCountProcess_mem_FP : @@ -106,7 +106,7 @@ theorem machineListCountProcess_mem_FP : theorem machineListCountStep_mem_FP : machineListCountStep ∈ FP := by - simpa only [machineListCountStep] using machineIfEmpty_mem_FP + simpa only [machineListCountStep] using! machineIfEmpty_mem_FP machineListCountRemaining_mem_FP id_mem_FP machineListCountProcess_mem_FP theorem machineListCountInit_mem_FP : @@ -212,7 +212,7 @@ theorem machineEncodedListLengthBits_mem_FP : Cobham.iterate_mem_FP machineListCountStep_mem_FP machineListCountInit_mem_FP id_mem_FP machineListCountWidth_mem_FP machineListCountIterate_length_le_width - simpa only [machineEncodedListLengthBits] using machineCompose_mem_FP + simpa only [machineEncodedListLengthBits] using! machineCompose_mem_FP hfinal machineListCountCounter_mem_FP /-! ## Exact counting semantics -/ @@ -249,7 +249,7 @@ theorem machineListCountSemanticState_step {alpha : Type*} machineListCountSource_pack, machineListCountNextCounter, machineListCountCounter_pack] have hadd : machineBinaryAddBits (pair k.bits [true]) = (k + 1).bits := by - simpa using machineBinaryAddBits_pair_natBits k 1 + simpa using! machineBinaryAddBits_pair_natBits k 1 rw [hadd] have hbits : (k + 1).bits.length ≤ (machineListCountInputBound (binaryListCode encode xs)).length := by @@ -334,14 +334,14 @@ theorem machineMatchingGainFromSelected_mem_FP : (machineConst_mem_FP (rawRatBinaryCode rawExplicitGamma)) machineListCountRawNatCode_mem_FP have hmul := machineCompose_mem_FP hinput machineRawRatMulCode_mem_FP - simpa only [machineMatchingGainFromSelected] using + simpa only [machineMatchingGainFromSelected] using! machineCompose_mem_FP hmul machineNormalizeRawRatEntryCode_mem_FP theorem machineExplicitMatchingGainRawCode_mem_FP : machineExplicitMatchingGainRawCode ∈ FP := by have hselected := machineCompose_mem_FP machinePairSecond_mem_FP machineGreedyMatchingSelected_mem_FP - simpa only [machineExplicitMatchingGainRawCode] using machineCompose_mem_FP + simpa only [machineExplicitMatchingGainRawCode] using! machineCompose_mem_FP hselected machineMatchingGainFromSelected_mem_FP @[simp] theorem machineListCountRawNatCode_encode {alpha : Type*} @@ -390,7 +390,7 @@ theorem explicitCertifiedMatchingGain_eq_typed_length {n : ℕ} (explicitCertifiedRowWeight X) explicitGamma have hthreshold : explicitGamma ≤ explicitCertifiedRowWeight X q := by have hmem := hmax.subset hqmatching - simpa only [List.mem_toFinset, mem_thresholdRowPairsList_iff] using hmem + simpa only [List.mem_toFinset, mem_thresholdRowPairsList_iff] using! hmem exact certifiedConstantRowWeight_eq_gamma_of_threshold (explicitRegularizationScale n) X explicitKappa explicitGamma (directedPairCostPrecision n) q explicitGamma_pos hthreshold @@ -418,7 +418,7 @@ theorem explicitCertifiedMatchingGain_eq_typed_length {n : ℕ} theorem machineExplicitMatchingGainRawCode_realizes : OptimizerMatchingGainStringRealizes machineExplicitMatchingGainRawCode := by intro m B - simpa only [explicitLargeOptimizerOutput] using + simpa only [explicitLargeOptimizerOutput] using! machineExplicitMatchingGainRawCode_encode (rationalMatrixBinaryEncoding.encode ⟨m + 2, B⟩) (explicitBetheOptimizerMatrix (m := m + 1) B) diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineMateAllSome.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineMateAllSome.lean index 239642fb7e..6165822bac 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineMateAllSome.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineMateAllSome.lean @@ -70,19 +70,19 @@ theorem machineMateAllSomeRemaining_mem_FP : theorem machineMateAllSomeRulerState_mem_FP : machineMateAllSomeRulerState ∈ Complexity.FP := by - simpa only [machineMateAllSomeRulerState] using + simpa only [machineMateAllSomeRulerState] using! machineCompose_mem_FP machinePairSecond_mem_FP machinePairFirst_mem_FP theorem machineMateAllSomeOk_mem_FP : machineMateAllSomeOk ∈ Complexity.FP := by - simpa only [machineMateAllSomeOk] using + simpa only [machineMateAllSomeOk] using! machineCompose_mem_FP machinePairSecond_mem_FP machinePairSecond_mem_FP theorem machineMateAllSomeCurrentBit_mem_FP : machineMateAllSomeCurrentBit ∈ Complexity.FP := by have hhead := machineCompose_mem_FP machineMateAllSomeRemaining_mem_FP machineListHead_mem_FP - simpa only [machineMateAllSomeCurrentBit] using + simpa only [machineMateAllSomeCurrentBit] using! machineCompose_mem_FP hhead machineHeadBit_mem_FP theorem machineMateAllSomeAdvance_mem_FP : @@ -150,8 +150,8 @@ theorem machineMateAllSomeInit_bound (word : List Bool) : dsimp only [MachineMateAllSomeStateBound] refine ⟨?_, ?_, ?_, ?_⟩ · simp [machineMateAllSomeInit] - · simpa [machineMateAllSomeInit] using machinePairSecond_length_le word - · simpa [machineMateAllSomeInit] using machinePairFirst_length_le word + · simpa [machineMateAllSomeInit] using! machinePairSecond_length_le word + · simpa [machineMateAllSomeInit] using! machinePairFirst_length_le word · simp [machineMateAllSomeInit] theorem machineMateAllSomeStep_bound {word state : List Bool} @@ -168,7 +168,7 @@ theorem machineMateAllSomeStep_bound {word state : List Bool} dsimp only [MachineMateAllSomeStateBound] refine ⟨?_, ?_, ?_, ?_⟩ · simp - · simpa only [machineMateAllSomeRemaining_pack] using + · simpa only [machineMateAllSomeRemaining_pack] using! (machinePairSecond_length_le (machineMateAllSomeRemaining state)).trans hremaining · rw [hrulerEq] at hruler @@ -181,10 +181,10 @@ theorem machineMateAllSomeStep_bound {word state : List Bool} (machineAndBit (machineMateAllSomeOk state) (machineMateAllSomeCurrentBit state)).length ≤ 1 := by simpa only [machineAndBit, machineMateAllSomeCurrentBit_length, - List.length_cons, List.length_nil, Nat.zero_add, max_self] using + List.length_cons, List.length_nil, Nat.zero_add, max_self] using! machineIfHead_length_le_max (machineMateAllSomeOk state) (machineMateAllSomeCurrentBit state) [false] - simpa only [machineMateAllSomeOk_pack] using + simpa only [machineMateAllSomeOk_pack] using! hbit.trans (by omega : 1 ≤ word.length + 1) theorem machineMateAllSomeIterate_bound (word : List Bool) : ∀ iterations, @@ -193,7 +193,7 @@ theorem machineMateAllSomeIterate_bound (word : List Bool) : ∀ iterations, (machineMateAllSomeInit word)) := by intro iterations induction iterations with - | zero => simpa using machineMateAllSomeInit_bound word + | zero => simpa using! machineMateAllSomeInit_bound word | succ iterations ih => rw [Function.iterate_succ_apply'] exact machineMateAllSomeStep_bound ih @@ -214,7 +214,7 @@ theorem machineMateAllSomeIterate_length_le_width theorem machineMateAllSomeFinalState_mem_FP : machineMateAllSomeFinalState ∈ Complexity.FP := by - simpa only [machineMateAllSomeFinalState] using + simpa only [machineMateAllSomeFinalState] using! Cobham.iterate_mem_FP machineMateAllSomeStep_mem_FP machineMateAllSomeInit_mem_FP machineMateAllSomeInputRuler_mem_FP machineMateAllSomeWidth_mem_FP @@ -222,7 +222,7 @@ theorem machineMateAllSomeFinalState_mem_FP : theorem machineMateAllSomeBit_mem_FP : machineMateAllSomeBit ∈ Complexity.FP := by - simpa only [machineMateAllSomeBit] using + simpa only [machineMateAllSomeBit] using! machineCompose_mem_FP machineMateAllSomeFinalState_mem_FP machineMateAllSomeOk_mem_FP diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineMateMemory.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineMateMemory.lean index 1e58f8f7fa..9ddeecc80f 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineMateMemory.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineMateMemory.lean @@ -42,7 +42,7 @@ def machineMateVectorUpdateAtUnary (word : List Bool) : List Bool := theorem machineMateValueIsNoneBit_mem_FP : machineMateValueIsNoneBit ∈ Complexity.FP := by - simpa only [machineMateValueIsNoneBit] using + simpa only [machineMateValueIsNoneBit] using! machineNotBit_mem_FP machineHeadBit_mem_FP theorem machineMateValueRowUnary_mem_FP : diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineMatrixAddDelta.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineMatrixAddDelta.lean index 906c93e448..c2daec20a2 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineMatrixAddDelta.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineMatrixAddDelta.lean @@ -123,7 +123,7 @@ theorem machineMatrixAddDeltaPadTwenty_length (word : List Bool) : theorem machineMatrixAddDeltaInputBound_mem_FP : machineMatrixAddDeltaInputBound ∈ Complexity.FP := by - simpa only [machineMatrixAddDeltaInputBound] using + simpa only [machineMatrixAddDeltaInputBound] using! machineCompose_mem_FP machineMatrixAddDeltaPadTwenty_mem_FP machineBinaryMulWidth_mem_FP @@ -151,14 +151,14 @@ theorem machineMatrixAddDeltaRemaining_mem_FP : theorem machineMatrixAddDeltaAccumulator_mem_FP : machineMatrixAddDeltaAccumulator ∈ Complexity.FP := by - simpa only [machineMatrixAddDeltaAccumulator] using + simpa only [machineMatrixAddDeltaAccumulator] using! machineCompose_mem_FP machinePairSecond_mem_FP machinePairFirst_mem_FP theorem machineMatrixAddDeltaDelta_mem_FP : machineMatrixAddDeltaDelta ∈ Complexity.FP := by have htail := machineCompose_mem_FP machinePairSecond_mem_FP machinePairSecond_mem_FP - simpa only [machineMatrixAddDeltaDelta] using + simpa only [machineMatrixAddDeltaDelta] using! machineCompose_mem_FP htail machinePairFirst_mem_FP theorem machineMatrixAddDeltaDimension_mem_FP : @@ -166,7 +166,7 @@ theorem machineMatrixAddDeltaDimension_mem_FP : have htailTwo := machineCompose_mem_FP machinePairSecond_mem_FP machinePairSecond_mem_FP have htailThree := machineCompose_mem_FP htailTwo machinePairSecond_mem_FP - simpa only [machineMatrixAddDeltaDimension] using + simpa only [machineMatrixAddDeltaDimension] using! machineCompose_mem_FP htailThree machinePairFirst_mem_FP theorem machineMatrixAddDeltaBound_mem_FP : @@ -174,12 +174,12 @@ theorem machineMatrixAddDeltaBound_mem_FP : have htailTwo := machineCompose_mem_FP machinePairSecond_mem_FP machinePairSecond_mem_FP have htailThree := machineCompose_mem_FP htailTwo machinePairSecond_mem_FP - simpa only [machineMatrixAddDeltaBound] using + simpa only [machineMatrixAddDeltaBound] using! machineCompose_mem_FP htailThree machinePairSecond_mem_FP theorem machineMatrixAddDeltaCurrentRow_mem_FP : machineMatrixAddDeltaCurrentRow ∈ Complexity.FP := by - simpa only [machineMatrixAddDeltaCurrentRow] using + simpa only [machineMatrixAddDeltaCurrentRow] using! machineCompose_mem_FP machineMatrixAddDeltaRemaining_mem_FP machineListHead_mem_FP @@ -187,7 +187,7 @@ theorem machineMatrixAddDeltaOutputRow_mem_FP : machineMatrixAddDeltaOutputRow ∈ Complexity.FP := by have hinput := machinePair_mem_FP machineMatrixAddDeltaDelta_mem_FP machineMatrixAddDeltaCurrentRow_mem_FP - simpa only [machineMatrixAddDeltaOutputRow] using + simpa only [machineMatrixAddDeltaOutputRow] using! machineCompose_mem_FP hinput machineRationalRowAdd_mem_FP theorem machineMatrixAddDeltaCandidate_mem_FP : @@ -197,7 +197,7 @@ theorem machineMatrixAddDeltaCandidate_mem_FP : theorem machineMatrixAddDeltaNextAccumulator_mem_FP : machineMatrixAddDeltaNextAccumulator ∈ Complexity.FP := by - simpa only [machineMatrixAddDeltaNextAccumulator] using + simpa only [machineMatrixAddDeltaNextAccumulator] using! machineTake_mem_FP machineMatrixAddDeltaBound_mem_FP machineMatrixAddDeltaCandidate_mem_FP @@ -353,7 +353,7 @@ theorem machineMatrixAddDeltaEntries_mem_FP : machineMatrixAddDeltaFinalState_mem_FP machineMatrixAddDeltaAccumulator_mem_FP have hrows := machineCompose_mem_FP hacc machineListReverse_mem_FP - simpa only [machineMatrixAddDeltaEntries] using + simpa only [machineMatrixAddDeltaEntries] using! machinePair_mem_FP hdimension hrows /-! ## Output-size bound on canonical matrices -/ @@ -430,7 +430,7 @@ private theorem matrixAddDelta_outputCode_length_le simp only [Function.comp_apply] omega have hsum := matrixAddDelta_natList_sum_le_length_mul hterm - simpa only [rationalRowAddValues, List.length_map] using hsum + simpa only [rationalRowAddValues, List.length_map] using! hsum have htail := ih htailEntry simp only [List.map_cons, binaryListCode, pair_length, List.map_map, List.sum_cons, List.length_cons] at htail ⊢ @@ -453,20 +453,20 @@ theorem machineMatrixAddDelta_outputRows_length_le_bound {n : ℕ} matrixWord.length := by calc _ = (machineMatrixRowsWord matrixWord).length := by - simpa only [matrixWord, rows] using congrArg List.length + simpa only [matrixWord, rows] using! congrArg List.length (machineMatrixRowsWord_encode A).symm _ ≤ matrixWord.length := by - simpa only [machineMatrixRowsWord] using + simpa only [machineMatrixRowsWord] using! machinePairSecond_length_le matrixWord have hmatrixWord : matrixWord.length ≤ word.length := by - simpa only [word, machinePairSecond_pair] using + simpa only [word, machinePairSecond_pair] using! machinePairSecond_length_le word have hrowsCode : (binaryListCode (binaryListCode rationalEntryBinaryCode) rows).length ≤ word.length := hrowsMatrixCode.trans hmatrixWord have hdeltaWidth : rawRatWidth delta ≤ word.length := by have hdeltaCode : (rawRatBinaryCode delta).length ≤ word.length := by - simpa only [word, machinePairFirst_pair] using + simpa only [word, machinePairFirst_pair] using! machinePairFirst_length_le word exact (rawRatWidth_le_binaryCode_length delta).trans hdeltaCode have hentry : ∀ row ∈ rows, ∀ q ∈ row, @@ -518,7 +518,7 @@ theorem machineMatrixAddDelta_outputRows_length_le_bound {n : ℕ} 2 * rows.length ≤ (rows.map List.length).sum * (694 + 288 * word.length) + rows.length * (694 + 288 * word.length) := by - exact Nat.add_le_add hentries (by simpa [Nat.mul_comm] using hrows) + exact Nat.add_le_add hentries (by simpa [Nat.mul_comm] using! hrows) _ = (rows.length + (rows.map List.length).sum) * (694 + 288 * word.length) := by ring have hlinear := Nat.mul_le_mul_right (694 + 288 * word.length) hwork @@ -612,7 +612,7 @@ theorem machineMatrixAddDeltaStep_semantics have hprefix : (output.take (k + 1)).reverse = output[k] :: (output.take k).reverse := by rw [← htake] - simpa only [List.concat_eq_append] using + simpa only [List.concat_eq_append] using! (List.reverse_concat (l := output.take k) (a := output[k])) have hprefixLength : (binaryListCode (binaryListCode rationalEntryBinaryCode) @@ -620,7 +620,7 @@ theorem machineMatrixAddDeltaStep_semantics (machineMatrixAddDeltaInputBound word).length := (binaryListCode_take_reverse_length_le (binaryListCode rationalEntryBinaryCode) output (k + 1)).trans - (by simpa only [output] using hfullBound) + (by simpa only [output] using! hfullBound) have htakeBound : (binaryListCode (binaryListCode rationalEntryBinaryCode) (output.take (k + 1)).reverse).take @@ -656,7 +656,7 @@ theorem machineMatrixAddDeltaStep_semantics (machineMatrixAddDeltaInputBound word)) = binaryListCode rationalEntryBinaryCode output[k] := by rw [houtputGet] - simpa only [machineMatrixAddDeltaSemanticState, output] using + simpa only [machineMatrixAddDeltaSemanticState, output] using! machineMatrixAddDeltaOutputRow_semantics word dimension delta rows k hk rw [hrow, hdrop, machineListTail_cons] @@ -715,18 +715,18 @@ theorem machineMatrixAddDeltaFinalState_encode {n : ℕ} let rows := rationalMatrixRows A have hrowsLength : rows.length ≤ word.length := by have hn : rows.length ≤ matrixWord.length := by - simpa only [rows, matrixWord, rationalMatrixRows, List.length_ofFn] using + simpa only [rows, matrixWord, rationalMatrixRows, List.length_ofFn] using! matrix_dimension_le_code_length A have hm : matrixWord.length ≤ word.length := by simpa only [word, machineMatrixAddDeltaCanonicalInput, - machinePairSecond_pair] using machinePairSecond_length_le word + machinePairSecond_pair] using! machinePairSecond_length_le word exact hn.trans hm have hfullBound : (binaryListCode (binaryListCode rationalEntryBinaryCode) (rationalMatrixAddRows delta rows)).length ≤ (machineMatrixAddDeltaInputBound word).length := by simpa only [word, rows, machineMatrixAddDeltaCanonicalInput, - rationalMatrixAddRows] using + rationalMatrixAddRows] using! machineMatrixAddDelta_outputRows_length_le_bound delta A have hsplit : word.length = (word.length - rows.length) + rows.length := by omega diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineMatrixDimension.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineMatrixDimension.lean index b38f8ca6fa..ee814b2508 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineMatrixDimension.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineMatrixDimension.lean @@ -27,7 +27,7 @@ theorem machineMatrixDimensionUnary_mem_FP : machineMatrixDimensionUnary ∈ Complexity.FP := by have hpair := machinePair_mem_FP id_mem_FP machineMatrixDimensionWord_mem_FP - simpa only [machineMatrixDimensionUnary] using + simpa only [machineMatrixDimensionUnary] using! machineCompose_mem_FP hpair machineBoundedUnary_mem_FP theorem list_length_le_binaryListCode_length {α : Type*} @@ -54,10 +54,10 @@ theorem matrix_dimension_le_code_length {n : ℕ} calc _ = (machineMatrixRowsWord (rationalMatrixBinaryEncoding.encode ⟨n, A⟩)).length := by - simpa using congrArg List.length + simpa using! congrArg List.length (machineMatrixRowsWord_encode A).symm _ ≤ _ := by - simpa only [machineMatrixRowsWord] using machinePairSecond_length_le + simpa only [machineMatrixRowsWord] using! machinePairSecond_length_le (rationalMatrixBinaryEncoding.encode ⟨n, A⟩) exact hlist.trans (hrows.trans hcode) diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineMatrixNonnegative.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineMatrixNonnegative.lean index 3020a81a5e..83ba88d073 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineMatrixNonnegative.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineMatrixNonnegative.lean @@ -84,17 +84,17 @@ theorem machineMatrixNonnegativeRows_mem_FP : theorem machineMatrixNonnegativeCurrent_mem_FP : machineMatrixNonnegativeCurrent ∈ Complexity.FP := by - simpa only [machineMatrixNonnegativeCurrent] using + simpa only [machineMatrixNonnegativeCurrent] using! machineCompose_mem_FP machinePairSecond_mem_FP machinePairFirst_mem_FP theorem machineMatrixNonnegativeOk_mem_FP : machineMatrixNonnegativeOk ∈ Complexity.FP := by - simpa only [machineMatrixNonnegativeOk] using + simpa only [machineMatrixNonnegativeOk] using! machineCompose_mem_FP machinePairSecond_mem_FP machinePairSecond_mem_FP theorem machineMatrixNonnegativeEntry_mem_FP : machineMatrixNonnegativeEntry ∈ Complexity.FP := by - simpa only [machineMatrixNonnegativeEntry, machineListHead] using + simpa only [machineMatrixNonnegativeEntry, machineListHead] using! machineCompose_mem_FP machineMatrixNonnegativeCurrent_mem_FP machinePairFirst_mem_FP @@ -103,7 +103,7 @@ theorem machineMatrixNonnegativeEntryBit_mem_FP : have hpair := machinePair_mem_FP (machineConst_mem_FP (rawRatBinaryCode RawRat.zero)) machineMatrixNonnegativeEntry_mem_FP - simpa only [machineMatrixNonnegativeEntryBit] using + simpa only [machineMatrixNonnegativeEntryBit] using! machineCompose_mem_FP (machineCompose_mem_FP hpair machineRawRatLeBit_mem_FP) machineHeadBit_mem_FP @@ -128,13 +128,13 @@ theorem machineMatrixNonnegativeLoadRow_mem_FP : theorem machineMatrixNonnegativeAfterRow_mem_FP : machineMatrixNonnegativeAfterRow ∈ Complexity.FP := by - simpa only [machineMatrixNonnegativeAfterRow] using + simpa only [machineMatrixNonnegativeAfterRow] using! machineIfEmpty_mem_FP machineMatrixNonnegativeRows_mem_FP id_mem_FP machineMatrixNonnegativeLoadRow_mem_FP theorem machineMatrixNonnegativeStep_mem_FP : machineMatrixNonnegativeStep ∈ Complexity.FP := by - simpa only [machineMatrixNonnegativeStep] using + simpa only [machineMatrixNonnegativeStep] using! machineIfEmpty_mem_FP machineMatrixNonnegativeCurrent_mem_FP machineMatrixNonnegativeAfterRow_mem_FP machineMatrixNonnegativeProcessEntry_mem_FP @@ -182,7 +182,7 @@ theorem machineMatrixNonnegativeInit_bound (word : List Bool) : machineMatrixNonnegativeInit, machineMatrixNonnegativeRows_pack, machineMatrixNonnegativeCurrent_pack, machineMatrixNonnegativeOk_pack] refine ⟨trivial, ?_, by simp, by simp⟩ - simpa only [machineMatrixRowsWord] using machinePairSecond_length_le word + simpa only [machineMatrixRowsWord] using! machinePairSecond_length_le word theorem machineMatrixNonnegativeStep_bound {word state : List Bool} @@ -264,7 +264,7 @@ theorem machineMatrixNonnegativeFinalState_mem_FP : theorem machineMatrixNonnegativeBit_mem_FP : machineMatrixNonnegativeBit ∈ Complexity.FP := by - simpa only [machineMatrixNonnegativeBit] using + simpa only [machineMatrixNonnegativeBit] using! machineCompose_mem_FP machineMatrixNonnegativeFinalState_mem_FP machineMatrixNonnegativeOk_mem_FP @@ -433,10 +433,10 @@ theorem machineMatrixNonnegativeFinalState_encode {n : ℕ} calc (binaryListCode (binaryListCode rationalEntryBinaryCode) rows).length = (machineMatrixRowsWord word).length := by - simpa only [word, rows] using congrArg List.length + simpa only [word, rows] using! congrArg List.length (machineMatrixRowsWord_encode A).symm _ ≤ word.length := by - simpa only [machineMatrixRowsWord] using + simpa only [machineMatrixRowsWord] using! machinePairSecond_length_le word exact hcode.trans hrows have hsplit : word.length = @@ -461,6 +461,7 @@ theorem matrixNonnegativeRowsBit_iff {n : ℕ} simp [matrixNonnegativeRowsBit, matrixNonnegativeRowBit, rationalNonnegativeBit, rationalMatrixRows, Matrix.Nonnegative] +open scoped Classical in @[simp] theorem machineMatrixNonnegativeBit_encode {n : ℕ} (A : Matrix (Fin n) (Fin n) ℚ) : machineMatrixNonnegativeBit @@ -471,6 +472,6 @@ theorem matrixNonnegativeRowsBit_iff {n : ℕ} simp only [machineMatrixNonnegativeOk_pack] apply congrArg singleton apply Bool.eq_iff_iff.mpr - simpa [Matrix.Nonnegative] using matrixNonnegativeRowsBit_iff A + simpa [Matrix.Nonnegative] using! matrixNonnegativeRowsBit_iff A end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineMatrixNormalization.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineMatrixNormalization.lean index 58c166fd5d..eddf65bc3a 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineMatrixNormalization.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineMatrixNormalization.lean @@ -30,12 +30,12 @@ theorem machineMatrixNormalizationScalePowerRawCode_mem_FP : machineMatrixNormalizationScalePowerRawCode ∈ Complexity.FP := by have hpair := machinePair_mem_FP machineMatrixDimensionUnary_mem_FP machineMatrixNormalizationScaleRawCode_mem_FP - simpa only [machineMatrixNormalizationScalePowerRawCode] using + simpa only [machineMatrixNormalizationScalePowerRawCode] using! machineCompose_mem_FP hpair machineRawRatPowerCode_mem_FP theorem machineMatrixNormalizationScalePowerOutputCode_mem_FP : machineMatrixNormalizationScalePowerOutputCode ∈ Complexity.FP := by - simpa only [machineMatrixNormalizationScalePowerOutputCode] using + simpa only [machineMatrixNormalizationScalePowerOutputCode] using! machineCompose_mem_FP machineMatrixNormalizationScalePowerRawCode_mem_FP machineNormalizeRawRatBinaryCode_mem_FP diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineMatrixNormalizeEntries.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineMatrixNormalizeEntries.lean index 5e013968b1..bc1c83cd27 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineMatrixNormalizeEntries.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineMatrixNormalizeEntries.lean @@ -115,7 +115,7 @@ theorem machineMatrixNormalizePadTwenty_length (word : List Bool) : theorem machineMatrixNormalizeInputBound_mem_FP : machineMatrixNormalizeInputBound ∈ Complexity.FP := by - simpa only [machineMatrixNormalizeInputBound] using + simpa only [machineMatrixNormalizeInputBound] using! machineCompose_mem_FP machineMatrixNormalizePadTwenty_mem_FP machineBinaryMulWidth_mem_FP @@ -125,14 +125,14 @@ theorem machineMatrixNormalizeRemaining_mem_FP : theorem machineMatrixNormalizeAccumulator_mem_FP : machineMatrixNormalizeAccumulator ∈ Complexity.FP := by - simpa only [machineMatrixNormalizeAccumulator] using + simpa only [machineMatrixNormalizeAccumulator] using! machineCompose_mem_FP machinePairSecond_mem_FP machinePairFirst_mem_FP theorem machineMatrixNormalizeScale_mem_FP : machineMatrixNormalizeScale ∈ Complexity.FP := by have htail := machineCompose_mem_FP machinePairSecond_mem_FP machinePairSecond_mem_FP - simpa only [machineMatrixNormalizeScale] using + simpa only [machineMatrixNormalizeScale] using! machineCompose_mem_FP htail machinePairFirst_mem_FP theorem machineMatrixNormalizeDimension_mem_FP : @@ -140,7 +140,7 @@ theorem machineMatrixNormalizeDimension_mem_FP : have htailTwo := machineCompose_mem_FP machinePairSecond_mem_FP machinePairSecond_mem_FP have htailThree := machineCompose_mem_FP htailTwo machinePairSecond_mem_FP - simpa only [machineMatrixNormalizeDimension] using + simpa only [machineMatrixNormalizeDimension] using! machineCompose_mem_FP htailThree machinePairFirst_mem_FP theorem machineMatrixNormalizeBound_mem_FP : @@ -148,12 +148,12 @@ theorem machineMatrixNormalizeBound_mem_FP : have htailTwo := machineCompose_mem_FP machinePairSecond_mem_FP machinePairSecond_mem_FP have htailThree := machineCompose_mem_FP htailTwo machinePairSecond_mem_FP - simpa only [machineMatrixNormalizeBound] using + simpa only [machineMatrixNormalizeBound] using! machineCompose_mem_FP htailThree machinePairSecond_mem_FP theorem machineMatrixNormalizeCurrentRow_mem_FP : machineMatrixNormalizeCurrentRow ∈ Complexity.FP := by - simpa only [machineMatrixNormalizeCurrentRow] using + simpa only [machineMatrixNormalizeCurrentRow] using! machineCompose_mem_FP machineMatrixNormalizeRemaining_mem_FP machineListHead_mem_FP @@ -161,7 +161,7 @@ theorem machineMatrixNormalizeOutputRow_mem_FP : machineMatrixNormalizeOutputRow ∈ Complexity.FP := by have hinput := machinePair_mem_FP machineMatrixNormalizeScale_mem_FP machineMatrixNormalizeCurrentRow_mem_FP - simpa only [machineMatrixNormalizeOutputRow] using + simpa only [machineMatrixNormalizeOutputRow] using! machineCompose_mem_FP hinput machineRationalRowDivide_mem_FP theorem machineMatrixNormalizeCandidate_mem_FP : @@ -171,7 +171,7 @@ theorem machineMatrixNormalizeCandidate_mem_FP : theorem machineMatrixNormalizeNextAccumulator_mem_FP : machineMatrixNormalizeNextAccumulator ∈ Complexity.FP := by - simpa only [machineMatrixNormalizeNextAccumulator] using + simpa only [machineMatrixNormalizeNextAccumulator] using! machineTake_mem_FP machineMatrixNormalizeBound_mem_FP machineMatrixNormalizeCandidate_mem_FP @@ -255,8 +255,8 @@ theorem machineMatrixNormalizeInit_bound (word : List Bool) : machineMatrixNormalizeDimension_pack, machineMatrixNormalizeBound_pack] refine ⟨trivial, ?_, by simp, trivial, ?_, trivial⟩ - · simpa only [machineMatrixRowsWord] using machinePairSecond_length_le word - · simpa only [machineMatrixDimensionWord] using + · simpa only [machineMatrixRowsWord] using! machinePairSecond_length_le word + · simpa only [machineMatrixDimensionWord] using! machinePairFirst_length_le word theorem machineMatrixNormalizeStep_bound {word state : List Bool} @@ -324,7 +324,7 @@ theorem machineMatrixNormalizeEntries_mem_FP : machineMatrixNormalizeFinalState_mem_FP machineMatrixNormalizeAccumulator_mem_FP have hrows := machineCompose_mem_FP hacc machineListReverse_mem_FP - simpa only [machineMatrixNormalizeEntries] using + simpa only [machineMatrixNormalizeEntries] using! machinePair_mem_FP hdimension hrows /-! ## Output-size bound on canonical matrices -/ @@ -401,7 +401,7 @@ private theorem matrixNormalize_outputCode_length_le simp only [Function.comp_apply] omega have hsum := matrixNormalize_natList_sum_le_length_mul hterm - simpa only [rationalRowDivideValues, List.length_map] using hsum + simpa only [rationalRowDivideValues, List.length_map] using! hsum have htail := ih htailEntry simp only [List.map_cons, binaryListCode, pair_length, List.map_map, List.sum_cons, List.length_cons] at htail ⊢ @@ -425,17 +425,17 @@ theorem machineMatrixNormalize_outputRows_length_le_bound {n : ℕ} word.length := by calc _ = (machineMatrixRowsWord word).length := by - simpa only [word, rows] using congrArg List.length + simpa only [word, rows] using! congrArg List.length (machineMatrixRowsWord_encode A).symm _ ≤ word.length := by - simpa only [machineMatrixRowsWord] using + simpa only [machineMatrixRowsWord] using! machinePairSecond_length_le word have hcost : rawRatRowsCost rows ≤ word.length := (rawRatRowsCost_le_codeLength rows).trans hrowsCode have hsumWidth : rawRatWidth (rawRatRowsSum RawRat.zero rows) ≤ 1 + word.length := by have h := rawRatWidth_rowsSum_le RawRat.zero rows - simpa only [rawRatWidth_zero] using h.trans + simpa only [rawRatWidth_zero] using! h.trans (Nat.add_le_add_left hcost 1) have hscaleWidth : rawRatWidth scale ≤ word.length + 3 := by have h := rawRatWidth_add_le RawRat.one @@ -446,7 +446,7 @@ theorem machineMatrixNormalize_outputRows_length_le_bound {n : ℕ} (RawRat.one.add (rawRatRowsSum RawRat.zero rows)) ≤ word.length + 3 := by omega - simpa only [scale] using hraw + simpa only [scale] using! hraw have hentry : ∀ row ∈ rows, ∀ q ∈ row, (rationalEntryBinaryCode (binaryNormalizeRawRat ((rawRatOfRat q).div scale))).length ≤ @@ -496,7 +496,7 @@ theorem machineMatrixNormalize_outputRows_length_le_bound {n : ℕ} 2 * rows.length ≤ (rows.map List.length).sum * (694 + 288 * word.length) + rows.length * (694 + 288 * word.length) := by - exact Nat.add_le_add hentries (by simpa [Nat.mul_comm] using hrows) + exact Nat.add_le_add hentries (by simpa [Nat.mul_comm] using! hrows) _ = (rows.length + (rows.map List.length).sum) * (694 + 288 * word.length) := by ring have hlinear := Nat.mul_le_mul_right (694 + 288 * word.length) hwork @@ -585,7 +585,7 @@ theorem machineMatrixNormalizeStep_semantics have hprefix : (output.take (k + 1)).reverse = output[k] :: (output.take k).reverse := by rw [← htake] - simpa only [List.concat_eq_append] using + simpa only [List.concat_eq_append] using! (List.reverse_concat (l := output.take k) (a := output[k])) have hprefixLength : (binaryListCode (binaryListCode rationalEntryBinaryCode) @@ -593,7 +593,7 @@ theorem machineMatrixNormalizeStep_semantics (machineMatrixNormalizeInputBound word).length := (binaryListCode_take_reverse_length_le (binaryListCode rationalEntryBinaryCode) output (k + 1)).trans - (by simpa only [output] using hfullBound) + (by simpa only [output] using! hfullBound) have htakeBound : (binaryListCode (binaryListCode rationalEntryBinaryCode) (output.take (k + 1)).reverse).take @@ -629,7 +629,7 @@ theorem machineMatrixNormalizeStep_semantics (machineMatrixNormalizeInputBound word)) = binaryListCode rationalEntryBinaryCode output[k] := by rw [houtputGet] - simpa only [machineMatrixNormalizeSemanticState, output] using + simpa only [machineMatrixNormalizeSemanticState, output] using! machineMatrixNormalizeOutputRow_semantics word dimension scale rows k hk rw [hrow, hdrop, machineListTail_cons] @@ -688,13 +688,13 @@ theorem machineMatrixNormalizeFinalState_encode {n : ℕ} let rows := rationalMatrixRows A let scale := RawRat.one.add (rawRatRowsSum RawRat.zero rows) have hrowsLength : rows.length ≤ word.length := by - simpa only [rows, word, rationalMatrixRows, List.length_ofFn] using + simpa only [rows, word, rationalMatrixRows, List.length_ofFn] using! matrix_dimension_le_code_length A have hfullBound : (binaryListCode (binaryListCode rationalEntryBinaryCode) (rationalMatrixDivideRows scale rows)).length ≤ (machineMatrixNormalizeInputBound word).length := by - simpa only [word, rows, scale, rationalMatrixDivideRows] using + simpa only [word, rows, scale, rationalMatrixDivideRows] using! machineMatrixNormalize_outputRows_length_le_bound A have hsplit : word.length = (word.length - rows.length) + rows.length := by omega diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineMatrixSum.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineMatrixSum.lean index fa3fcd345b..920b1027f7 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineMatrixSum.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineMatrixSum.lean @@ -107,26 +107,26 @@ theorem machineMatrixRawSumRows_mem_FP : theorem machineMatrixRawSumCurrent_mem_FP : machineMatrixRawSumCurrent ∈ Complexity.FP := by - simpa only [machineMatrixRawSumCurrent] using + simpa only [machineMatrixRawSumCurrent] using! machineCompose_mem_FP machinePairSecond_mem_FP machinePairFirst_mem_FP theorem machineMatrixRawSumAcc_mem_FP : machineMatrixRawSumAcc ∈ Complexity.FP := by - simpa only [machineMatrixRawSumAcc] using + simpa only [machineMatrixRawSumAcc] using! machineCompose_mem_FP (machineCompose_mem_FP machinePairSecond_mem_FP machinePairSecond_mem_FP) machinePairFirst_mem_FP theorem machineMatrixRawSumBound_mem_FP : machineMatrixRawSumBound ∈ Complexity.FP := by - simpa only [machineMatrixRawSumBound] using + simpa only [machineMatrixRawSumBound] using! machineCompose_mem_FP (machineCompose_mem_FP machinePairSecond_mem_FP machinePairSecond_mem_FP) machinePairSecond_mem_FP theorem machineMatrixRawSumEntry_mem_FP : machineMatrixRawSumEntry ∈ Complexity.FP := by - simpa only [machineMatrixRawSumEntry] using + simpa only [machineMatrixRawSumEntry] using! machineCompose_mem_FP machineMatrixRawSumCurrent_mem_FP machineListHead_mem_FP @@ -134,12 +134,12 @@ theorem machineMatrixRawSumCandidate_mem_FP : machineMatrixRawSumCandidate ∈ Complexity.FP := by have hpair := machinePair_mem_FP machineMatrixRawSumAcc_mem_FP machineMatrixRawSumEntry_mem_FP - simpa only [machineMatrixRawSumCandidate] using + simpa only [machineMatrixRawSumCandidate] using! machineCompose_mem_FP hpair machineRawRatAddCode_mem_FP theorem machineMatrixRawSumNextAcc_mem_FP : machineMatrixRawSumNextAcc ∈ Complexity.FP := by - simpa only [machineMatrixRawSumNextAcc] using + simpa only [machineMatrixRawSumNextAcc] using! machineTake_mem_FP machineMatrixRawSumBound_mem_FP machineMatrixRawSumCandidate_mem_FP @@ -227,7 +227,7 @@ theorem machineMatrixRawSumInit_bound (word : List Bool) : machineMatrixRawSumRows_pack, machineMatrixRawSumCurrent_pack, machineMatrixRawSumAcc_pack, machineMatrixRawSumBound_pack] refine ⟨trivial, ?_, by simp, ?_, trivial⟩ - · simpa only [machineMatrixRowsWord] using machinePairSecond_length_le word + · simpa only [machineMatrixRowsWord] using! machinePairSecond_length_le word · simp [machineMatrixRawSumInputBound, machineBinaryMulWidth, rawRatBinaryCode, RawRat.zero, integerBinaryCode] nlinarith [sq_nonneg (word.length + 16)] @@ -297,13 +297,13 @@ theorem machineMatrixRawSumFinalState_mem_FP : theorem machineMatrixRawSumCode_mem_FP : machineMatrixRawSumCode ∈ Complexity.FP := by - simpa only [machineMatrixRawSumCode] using + simpa only [machineMatrixRawSumCode] using! machineCompose_mem_FP machineMatrixRawSumFinalState_mem_FP machineMatrixRawSumAcc_mem_FP theorem machineMatrixSumOutputCode_mem_FP : machineMatrixSumOutputCode ∈ Complexity.FP := by - simpa only [machineMatrixSumOutputCode] using + simpa only [machineMatrixSumOutputCode] using! machineCompose_mem_FP machineMatrixRawSumCode_mem_FP machineNormalizeRawRatBinaryCode_mem_FP @@ -312,12 +312,12 @@ theorem machineMatrixNormalizationScaleRawCode_mem_FP : have hpair := machinePair_mem_FP (machineConst_mem_FP (rawRatBinaryCode RawRat.one)) machineMatrixRawSumCode_mem_FP - simpa only [machineMatrixNormalizationScaleRawCode] using + simpa only [machineMatrixNormalizationScaleRawCode] using! machineCompose_mem_FP hpair machineRawRatAddCode_mem_FP theorem machineMatrixNormalizationScaleOutputCode_mem_FP : machineMatrixNormalizationScaleOutputCode ∈ Complexity.FP := by - simpa only [machineMatrixNormalizationScaleOutputCode] using + simpa only [machineMatrixNormalizationScaleOutputCode] using! machineCompose_mem_FP machineMatrixNormalizationScaleRawCode_mem_FP machineNormalizeRawRatBinaryCode_mem_FP @@ -378,7 +378,7 @@ theorem integerNatAbs_size_le_binaryCode_length (z : ℤ) : omega exact hle.trans_lt hlt simpa [integerBinaryCode, Nat.size_eq_bits_len, - Nat.add_comm] using hs + Nat.add_comm] using! hs theorem rawRatWidth_le_binaryCode_length (q : RawRat) : rawRatWidth q ≤ (rawRatBinaryCode q).length := by @@ -406,7 +406,7 @@ theorem rawRatBinaryCode_length_le_width (q : RawRat) : have hsize : n.size ≤ (n + 1).size := Nat.size_le_size (Nat.le_succ n) have habs : (n + 1).size ≤ rawRatWidth q := by - simpa only [hqnum, Int.natAbs_negSucc] using + simpa only [hqnum, Int.natAbs_negSucc] using! rawRat_num_size_le_width q omega have hden := rawRat_den_size_le_width q @@ -440,7 +440,7 @@ theorem rawRatListCost_le_codeLength (xs : List ℚ) : binaryListCode, pair_length] have ih' : (qs.map fun q => rawRatWidth (rawRatOfRat q) + 1).sum ≤ (binaryListCode rationalEntryBinaryCode qs).length := by - simpa only [rawRatListCost] using ih + simpa only [rawRatListCost] using! ih have hq : rawRatWidth (rawRatOfRat q) ≤ (rationalEntryBinaryCode q).length := by rw [← rawRatBinaryCode_rawRatOfRat] @@ -457,7 +457,7 @@ theorem rawRatRowsCost_le_codeLength (rows : List (List ℚ)) : binaryListCode, pair_length] have ih' : (rows.map rawRatListCost).sum ≤ (binaryListCode (binaryListCode rationalEntryBinaryCode) rows).length := by - simpa only [rawRatRowsCost] using ih + simpa only [rawRatRowsCost] using! ih have hrow := rawRatListCost_le_codeLength row omega @@ -544,7 +544,7 @@ theorem machineMatrixRawSumStep_semantics have hinv := matrixRawSumSemStep_invariant hs have hinv' : rawRatWidth (acc.add (rawRatOfRat q)) + rawRatListCost qs + rawRatRowsCost rows ≤ 1 + word.length := by - simpa only [MatrixRawSumSemInvariant, matrixRawSumSemStep] using hinv + simpa only [MatrixRawSumSemInvariant, matrixRawSumSemStep] using! hinv omega have hcode : (rawRatBinaryCode (acc.add (rawRatOfRat q))).length ≤ @@ -652,10 +652,10 @@ theorem machineMatrixRawSumFinalState_encode {n : ℕ} word.length := by calc _ = (machineMatrixRowsWord word).length := by - simpa only [word, rows] using congrArg List.length + simpa only [word, rows] using! congrArg List.length (machineMatrixRowsWord_encode A).symm _ ≤ word.length := by - simpa only [machineMatrixRowsWord] using + simpa only [machineMatrixRowsWord] using! machinePairSecond_length_le word have hinv : MatrixRawSumSemInvariant (1 + word.length) s := by simp only [MatrixRawSumSemInvariant, s, rawRatListCost, diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineMatrixSupportProduct.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineMatrixSupportProduct.lean index cce5cb5cee..b68de9e8e5 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineMatrixSupportProduct.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineMatrixSupportProduct.lean @@ -83,7 +83,7 @@ theorem machineMatrixSupportNonzeroFlag_mem_FP : machineMatrixSupportNonzeroFlag ∈ Complexity.FP := by have hpair := machinePair_mem_FP machineMatrixRawSumEntry_mem_FP (machineConst_mem_FP (rawRatBinaryCode RawRat.zero)) - simpa only [machineMatrixSupportNonzeroFlag] using + simpa only [machineMatrixSupportNonzeroFlag] using! machineCompose_mem_FP hpair machineRawRatNeBit_mem_FP theorem machineMatrixSupportFactorCode_mem_FP : @@ -96,12 +96,12 @@ theorem machineMatrixSupportCandidate_mem_FP : machineMatrixSupportCandidate ∈ Complexity.FP := by have hpair := machinePair_mem_FP machineMatrixRawSumAcc_mem_FP machineMatrixSupportFactorCode_mem_FP - simpa only [machineMatrixSupportCandidate] using + simpa only [machineMatrixSupportCandidate] using! machineCompose_mem_FP hpair machineRawRatMulCode_mem_FP theorem machineMatrixSupportNextAcc_mem_FP : machineMatrixSupportNextAcc ∈ Complexity.FP := by - simpa only [machineMatrixSupportNextAcc] using + simpa only [machineMatrixSupportNextAcc] using! machineTake_mem_FP machineMatrixRawSumBound_mem_FP machineMatrixSupportCandidate_mem_FP @@ -116,7 +116,7 @@ theorem machineMatrixSupportProcessEntry_mem_FP : theorem machineMatrixSupportLoadRow_mem_FP : machineMatrixSupportLoadRow ∈ Complexity.FP := by - simpa only [machineMatrixSupportLoadRow] using + simpa only [machineMatrixSupportLoadRow] using! machineMatrixRawSumLoadRow_mem_FP theorem machineMatrixSupportAfterRow_mem_FP : @@ -155,7 +155,7 @@ theorem machineMatrixSupportInit_bound (word : List Bool) : machineMatrixRawSumRows_pack, machineMatrixRawSumCurrent_pack, machineMatrixRawSumAcc_pack, machineMatrixRawSumBound_pack] refine ⟨trivial, ?_, by simp, ?_, rfl⟩ - · simpa only [machineMatrixRowsWord] using machinePairSecond_length_le word + · simpa only [machineMatrixRowsWord] using! machinePairSecond_length_le word · simp [machineMatrixRawSumInputBound, machineBinaryMulWidth, rawRatBinaryCode, RawRat.one, integerBinaryCode] nlinarith [sq_nonneg (word.length + 16)] @@ -220,14 +220,14 @@ theorem machineMatrixSupportIterate_length_le_width (machineMatrixSupportInit word)) = machineMatrixSupportInputBound word := by simpa only [machineMatrixSupportInputBound, - machineMatrixRawSumInputBound] using hbound + machineMatrixRawSumInputBound] using! hbound have hacc' : (machineMatrixRawSumAcc ((machineMatrixSupportStep)^[iterations] (machineMatrixSupportInit word))).length ≤ (machineMatrixSupportInputBound word).length := by simpa only [machineMatrixSupportInputBound, - machineMatrixRawSumInputBound] using hacc + machineMatrixRawSumInputBound] using! hacc rw [hdecomp, hbound'] simp only [machineMatrixRawSumPack, machineMatrixSupportWidth, pair_length] omega @@ -241,13 +241,13 @@ theorem machineMatrixSupportFinalState_mem_FP : theorem machineMatrixSupportRawCode_mem_FP : machineMatrixSupportRawCode ∈ Complexity.FP := by - simpa only [machineMatrixSupportRawCode] using + simpa only [machineMatrixSupportRawCode] using! machineCompose_mem_FP machineMatrixSupportFinalState_mem_FP machineMatrixRawSumAcc_mem_FP theorem machineMatrixSupportProductCode_mem_FP : machineMatrixSupportProductCode ∈ Complexity.FP := by - simpa only [machineMatrixSupportProductCode] using + simpa only [machineMatrixSupportProductCode] using! machineCompose_mem_FP machineMatrixSupportRawCode_mem_FP machineNormalizeRawRatBinaryCode_mem_FP @@ -363,7 +363,7 @@ theorem machineMatrixSupportStep_semantics have hinv' : rawRatWidth (acc.mul (rawRatSupportFactor q)) + rawRatListCost qs + rawRatRowsCost rows ≤ 1 + word.length := by simpa only [MatrixSupportSemInvariant, - matrixSupportSemStep] using hinv + matrixSupportSemStep] using! hinv omega have hcode : (rawRatBinaryCode (acc.mul (rawRatSupportFactor q))).length ≤ @@ -379,7 +379,7 @@ theorem machineMatrixSupportStep_semantics (rawRatBinaryCode acc) (machineMatrixSupportInputBound word)) = rawRatBinaryCode (rawRatSupportFactor q) := by - simpa only [matrixRawSumSemCode] using + simpa only [matrixRawSumSemCode] using! machineMatrixSupportFactorCode_semantics rows q qs acc (machineMatrixSupportInputBound word) rw [matrixRawSumSemCode, matrixSupportSemStep, @@ -473,10 +473,10 @@ theorem machineMatrixSupportFinalState_encode {n : ℕ} word.length := by calc _ = (machineMatrixRowsWord word).length := by - simpa only [word, rows] using congrArg List.length + simpa only [word, rows] using! congrArg List.length (machineMatrixRowsWord_encode A).symm _ ≤ word.length := by - simpa only [machineMatrixRowsWord] using + simpa only [machineMatrixRowsWord] using! machinePairSecond_length_le word have hinv : MatrixSupportSemInvariant (1 + word.length) s := by simp only [MatrixSupportSemInvariant, s, rawRatListCost, @@ -564,7 +564,7 @@ theorem rawRatRowsSupportProduct_eq_rationalSupportFloor {n : ℕ} if A i j = 0 then 1 else A i j) = ∏ p ∈ (Finset.univ.product Finset.univ), if A p.1 p.2 = 0 then 1 else A p.1 p.2 := by - simpa using + simpa using! (Finset.prod_product' (Finset.univ : Finset (Fin n)) (Finset.univ : Finset (Fin n)) (fun i j ↦ if A i j = 0 then 1 else A i j)).symm diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineNearbyCoordinate.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineNearbyCoordinate.lean index 9a4f97015d..ac1583989a 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineNearbyCoordinate.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineNearbyCoordinate.lean @@ -85,19 +85,19 @@ theorem machineNearbyCoordinatePayload_mem_FP : theorem machineNearbyCoordinateTauRawCode_mem_FP : machineNearbyCoordinateTauRawCode ∈ Complexity.FP := by - simpa only [machineNearbyCoordinateTauRawCode] using + simpa only [machineNearbyCoordinateTauRawCode] using! machineCompose_mem_FP machineNearbyCoordinatePayload_mem_FP machinePairFirst_mem_FP theorem machineNearbyCoordinateXCode_mem_FP : machineNearbyCoordinateXCode ∈ Complexity.FP := by - simpa only [machineNearbyCoordinateXCode] using + simpa only [machineNearbyCoordinateXCode] using! machineCompose_mem_FP machineNearbyCoordinatePayload_mem_FP machinePairSecond_mem_FP theorem machineNearbyCoordinateNegXRawCode_mem_FP : machineNearbyCoordinateNegXRawCode ∈ Complexity.FP := by - simpa only [machineNearbyCoordinateNegXRawCode] using + simpa only [machineNearbyCoordinateNegXRawCode] using! machineCompose_mem_FP machineNearbyCoordinateXCode_mem_FP machineRawRatNegCode_mem_FP @@ -105,12 +105,12 @@ theorem machineNearbyCoordinateComplementUnnormalizedRawCode_mem_FP : machineNearbyCoordinateComplementUnnormalizedRawCode ∈ Complexity.FP := by have hpair := machinePair_mem_FP (machineConst_mem_FP rawRatOneCode) machineNearbyCoordinateNegXRawCode_mem_FP - simpa only [machineNearbyCoordinateComplementUnnormalizedRawCode] using + simpa only [machineNearbyCoordinateComplementUnnormalizedRawCode] using! machineCompose_mem_FP hpair machineRawRatAddCode_mem_FP theorem machineNearbyCoordinateComplementCode_mem_FP : machineNearbyCoordinateComplementCode ∈ Complexity.FP := by - simpa only [machineNearbyCoordinateComplementCode] using + simpa only [machineNearbyCoordinateComplementCode] using! machineCompose_mem_FP machineNearbyCoordinateComplementUnnormalizedRawCode_mem_FP machineNormalizeRawRatEntryCode_mem_FP @@ -120,7 +120,7 @@ theorem machineNearbyCoordinateLogComplementRawCode_mem_FP : have hpair := machinePair_mem_FP machineNearbyCoordinatePrecisionRuler_mem_FP machineNearbyCoordinateComplementCode_mem_FP - simpa only [machineNearbyCoordinateLogComplementRawCode] using + simpa only [machineNearbyCoordinateLogComplementRawCode] using! machineCompose_mem_FP hpair machineScheduledLogLowerRawCode_mem_FP theorem machineNearbyCoordinateLogXRawCode_mem_FP : @@ -128,14 +128,14 @@ theorem machineNearbyCoordinateLogXRawCode_mem_FP : have hpair := machinePair_mem_FP machineNearbyCoordinatePrecisionRuler_mem_FP machineNearbyCoordinateXCode_mem_FP - simpa only [machineNearbyCoordinateLogXRawCode] using + simpa only [machineNearbyCoordinateLogXRawCode] using! machineCompose_mem_FP hpair machineScheduledLogLowerRawCode_mem_FP theorem machineNearbyCoordinateTauTimesXRawCode_mem_FP : machineNearbyCoordinateTauTimesXRawCode ∈ Complexity.FP := by have hpair := machinePair_mem_FP machineNearbyCoordinateTauRawCode_mem_FP machineNearbyCoordinateXCode_mem_FP - simpa only [machineNearbyCoordinateTauTimesXRawCode] using + simpa only [machineNearbyCoordinateTauTimesXRawCode] using! machineCompose_mem_FP hpair machineRawRatMulCode_mem_FP theorem machineNearbyCoordinateWeightedLogXRawCode_mem_FP : @@ -143,7 +143,7 @@ theorem machineNearbyCoordinateWeightedLogXRawCode_mem_FP : have hpair := machinePair_mem_FP machineNearbyCoordinateTauTimesXRawCode_mem_FP machineNearbyCoordinateLogXRawCode_mem_FP - simpa only [machineNearbyCoordinateWeightedLogXRawCode] using + simpa only [machineNearbyCoordinateWeightedLogXRawCode] using! machineCompose_mem_FP hpair machineRawRatMulCode_mem_FP theorem machineNearbyCoordinateLowerRawCode_mem_FP : @@ -151,7 +151,7 @@ theorem machineNearbyCoordinateLowerRawCode_mem_FP : have hpair := machinePair_mem_FP machineNearbyCoordinateLogComplementRawCode_mem_FP machineNearbyCoordinateWeightedLogXRawCode_mem_FP - simpa only [machineNearbyCoordinateLowerRawCode] using + simpa only [machineNearbyCoordinateLowerRawCode] using! machineCompose_mem_FP hpair machineRawRatAddCode_mem_FP def rawNearbyCoordinateComplement (x : ℚ) : RawRat := diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineNearbyMatrixSum.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineNearbyMatrixSum.lean index a879c7a23e..be860e13b4 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineNearbyMatrixSum.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineNearbyMatrixSum.lean @@ -123,19 +123,19 @@ theorem machineNearbyMatrixSource_mem_FP : theorem machineNearbyMatrixRows_mem_FP : machineNearbyMatrixRows ∈ Complexity.FP := by - simpa only [machineNearbyMatrixRows] using + simpa only [machineNearbyMatrixRows] using! machineCompose_mem_FP machinePairSecond_mem_FP machinePairFirst_mem_FP theorem machineNearbyMatrixCurrent_mem_FP : machineNearbyMatrixCurrent ∈ Complexity.FP := by - simpa only [machineNearbyMatrixCurrent] using + simpa only [machineNearbyMatrixCurrent] using! machineCompose_mem_FP (machineCompose_mem_FP machinePairSecond_mem_FP machinePairSecond_mem_FP) machinePairFirst_mem_FP theorem machineNearbyMatrixAcc_mem_FP : machineNearbyMatrixAcc ∈ Complexity.FP := by - simpa only [machineNearbyMatrixAcc] using + simpa only [machineNearbyMatrixAcc] using! machineCompose_mem_FP (machineCompose_mem_FP (machineCompose_mem_FP machinePairSecond_mem_FP @@ -145,7 +145,7 @@ theorem machineNearbyMatrixAcc_mem_FP : theorem machineNearbyMatrixBound_mem_FP : machineNearbyMatrixBound ∈ Complexity.FP := by - simpa only [machineNearbyMatrixBound] using + simpa only [machineNearbyMatrixBound] using! machineCompose_mem_FP (machineCompose_mem_FP (machineCompose_mem_FP machinePairSecond_mem_FP @@ -155,7 +155,7 @@ theorem machineNearbyMatrixBound_mem_FP : theorem machineNearbyMatrixEntry_mem_FP : machineNearbyMatrixEntry ∈ Complexity.FP := by - simpa only [machineNearbyMatrixEntry] using + simpa only [machineNearbyMatrixEntry] using! machineCompose_mem_FP machineNearbyMatrixCurrent_mem_FP machineListHead_mem_FP @@ -170,7 +170,7 @@ theorem machineNearbyMatrixCoordinateInput_mem_FP : theorem machineNearbyMatrixCoordinateRawCode_mem_FP : machineNearbyMatrixCoordinateRawCode ∈ Complexity.FP := by - simpa only [machineNearbyMatrixCoordinateRawCode] using + simpa only [machineNearbyMatrixCoordinateRawCode] using! machineCompose_mem_FP machineNearbyMatrixCoordinateInput_mem_FP machineNearbyCoordinateLowerRawCode_mem_FP @@ -178,12 +178,12 @@ theorem machineNearbyMatrixCandidate_mem_FP : machineNearbyMatrixCandidate ∈ Complexity.FP := by have hpair := machinePair_mem_FP machineNearbyMatrixAcc_mem_FP machineNearbyMatrixCoordinateRawCode_mem_FP - simpa only [machineNearbyMatrixCandidate] using + simpa only [machineNearbyMatrixCandidate] using! machineCompose_mem_FP hpair machineRawRatAddCode_mem_FP theorem machineNearbyMatrixNextAcc_mem_FP : machineNearbyMatrixNextAcc ∈ Complexity.FP := by - simpa only [machineNearbyMatrixNextAcc] using + simpa only [machineNearbyMatrixNextAcc] using! machineTake_mem_FP machineNearbyMatrixBound_mem_FP machineNearbyMatrixCandidate_mem_FP @@ -223,12 +223,12 @@ theorem machineNearbyMatrixInputBound_mem_FP : machineNearbyMatrixInputBound ∈ Complexity.FP := by have h1 := machineBinaryMulWidth_mem_FP have h2 := machineCompose_mem_FP h1 machineBinaryMulWidth_mem_FP - simpa only [machineNearbyMatrixInputBound] using + simpa only [machineNearbyMatrixInputBound] using! machineCompose_mem_FP h2 machineBinaryMulWidth_mem_FP theorem machineNearbyMatrixRowsWord_mem_FP : machineNearbyMatrixRowsWord ∈ Complexity.FP := by - simpa only [machineNearbyMatrixRowsWord] using + simpa only [machineNearbyMatrixRowsWord] using! machineCompose_mem_FP machineOptimizerMatrixWord_mem_FP machineMatrixRowsWord_mem_FP @@ -369,7 +369,7 @@ theorem machineNearbyMatrixFinalState_mem_FP : theorem machineNearbyMatrixRawSumCode_mem_FP : machineNearbyMatrixRawSumCode ∈ Complexity.FP := by - simpa only [machineNearbyMatrixRawSumCode] using + simpa only [machineNearbyMatrixRawSumCode] using! machineCompose_mem_FP machineNearbyMatrixFinalState_mem_FP machineNearbyMatrixAcc_mem_FP @@ -400,7 +400,7 @@ theorem rawCertificateRegularizationScale_width_le_optimizer_word have hxi : rawRatWidth rawExplicitXi = 231 := by rw [rawExplicitXi, explicitXi, explicitDelta, explicitEta, explicitRowRatio] - norm_num [rawRatOfRat, rawRatWidth] + norm_num [rawRatOfRat, rawRatWidth] apply Nat.le_antisymm · apply max_le · norm_num @@ -422,7 +422,7 @@ theorem rawCertificateRegularizationScale_width_le_optimizer_word have hmatrixWord : (rationalMatrixBinaryEncoding.encode ⟨n, X⟩).length ≤ word.length := by simpa only [word, rationalOptimizerOutputCode, - machinePairFirst_pair] using machinePairFirst_length_le word + machinePairFirst_pair] using! machinePairFirst_length_le word have hnWord : n ≤ word.length := hnMatrix.trans hmatrixWord simp only [rawCertificateRegularizationScale, rawCertificateFourDimension] at htau @@ -450,14 +450,14 @@ theorem rawNearbyCoordinateLower_width_le_optimizer_word calc _ = (machineMatrixRowsWord (rationalMatrixBinaryEncoding.encode ⟨n, X⟩)).length := by - simpa using congrArg List.length + simpa using! congrArg List.length (machineMatrixRowsWord_encode X).symm _ ≤ (rationalMatrixBinaryEncoding.encode ⟨n, X⟩).length := by - simpa only [machineMatrixRowsWord] using machinePairSecond_length_le + simpa only [machineMatrixRowsWord] using! machinePairSecond_length_le (rationalMatrixBinaryEncoding.encode ⟨n, X⟩) _ ≤ word.length := by simpa only [word, rationalOptimizerOutputCode, - machinePairFirst_pair] using machinePairFirst_length_le word + machinePairFirst_pair] using! machinePairFirst_length_le word _ = L := rfl have hqCode := binaryListCode_element_length_le rationalEntryBinaryCode hq @@ -473,7 +473,7 @@ theorem rawNearbyCoordinateLower_width_le_optimizer_word have hmatrixWord : (rationalMatrixBinaryEncoding.encode ⟨n, X⟩).length ≤ L := by simpa only [L, word, rationalOptimizerOutputCode, - machinePairFirst_pair] using machinePairFirst_length_le word + machinePairFirst_pair] using! machinePairFirst_length_le word have hnWord : n ≤ L := hnMatrix.trans hmatrixWord have hp : directedCertificatePrecision n ≤ L + 400 := by simp only [directedCertificatePrecision] @@ -560,7 +560,7 @@ theorem rawNearbyRowsCost_le_optimizer_word (rawNearbyCoordinateLower (rawCertificateRegularizationScale n) q (directedCertificatePrecision n)) ≤ budget := by intro row hrow q hq - simpa only [rows, word, budget] using + simpa only [rows, word, budget] using! rawNearbyCoordinateLower_width_le_optimizer_word X R C hrow hq have hcost := rawNearbyRowsCost_le_uniform rows hcoordinate have hrowsCode : @@ -569,14 +569,14 @@ theorem rawNearbyRowsCost_le_optimizer_word calc _ = (machineMatrixRowsWord (rationalMatrixBinaryEncoding.encode ⟨n, X⟩)).length := by - simpa only [rows] using congrArg List.length + simpa only [rows] using! congrArg List.length (machineMatrixRowsWord_encode X).symm _ ≤ (rationalMatrixBinaryEncoding.encode ⟨n, X⟩).length := by - simpa only [machineMatrixRowsWord] using machinePairSecond_length_le + simpa only [machineMatrixRowsWord] using! machinePairSecond_length_le (rationalMatrixBinaryEncoding.encode ⟨n, X⟩) _ ≤ word.length := by simpa only [word, rationalOptimizerOutputCode, - machinePairFirst_pair] using machinePairFirst_length_le word + machinePairFirst_pair] using! machinePairFirst_length_le word have hwork : matrixNonnegativeRowsWork rows ≤ word.length := (binaryListCode_length_ge_work rows).trans hrowsCode have hentries : (rows.map List.length).sum ≤ word.length := by @@ -591,7 +591,7 @@ theorem rawNearbyRowsCost_le_optimizer_word omega exact (hentriesWork rows).trans hwork have hmul := Nat.mul_le_mul_right (budget + 1) hentries - exact hcost.trans (by simpa only [rows, word, budget] using hmul) + exact hcost.trans (by simpa only [rows, word, budget] using! hmul) theorem machineNearbyMatrixInputBound_length_dominates (word : List Bool) : 4 + 3 * (1 + word.length * @@ -720,7 +720,7 @@ theorem nearbyMatrixSemStep_invariant {tau : RawRat} {p budget : ℕ} (rawNearbyCoordinateLower (rawCertificateRegularizationScale n) q (directedCertificatePrecision n)) := by - simpa only [nearbyMatrixSemCode] using + simpa only [nearbyMatrixSemCode] using! machineNearbyMatrixCoordinateRawCode_semCode X R C rows q qs acc bound theorem machineNearbyMatrixStep_semantics @@ -776,7 +776,7 @@ theorem machineNearbyMatrixStep_semantics (directedCertificatePrecision n) qs + rawNearbyRowsCost (rawCertificateRegularizationScale n) (directedCertificatePrecision n) rows ≤ budget := by - simpa only [NearbyMatrixSemInvariant, nearbyMatrixSemStep] using hinv + simpa only [NearbyMatrixSemInvariant, nearbyMatrixSemStep] using! hinv omega have hcode : (rawRatBinaryCode @@ -898,7 +898,7 @@ theorem machineNearbyMatrixRawSumCode_encode_of_large word.length := by calc _ = (machineNearbyMatrixRowsWord word).length := by - simpa only [word, rows] using congrArg List.length + simpa only [word, rows] using! congrArg List.length (machineNearbyMatrixRowsWord_encode X R C).symm _ ≤ word.length := by exact (machinePairSecond_length_le @@ -918,7 +918,7 @@ theorem machineNearbyMatrixRawSumCode_encode_of_large binaryListCode, machineNearbyMatrixRowsWord] have hlarge' : 4 + 3 * budget ≤ (machineNearbyMatrixInputBound word).length := by - simpa only [budget, tau, p, rows, word] using hlarge + simpa only [budget, tau, p, rows, word] using! hlarge rw [machineNearbyMatrixRawSumCode, machineNearbyMatrixFinalState, hsplit, Function.iterate_add_apply, hinit, machineNearbyMatrixIterate_semantics X R C diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineNestedMatrixMemory.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineNestedMatrixMemory.lean index 9c1fff4cd2..834b26c7e8 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineNestedMatrixMemory.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineNestedMatrixMemory.lean @@ -53,7 +53,7 @@ theorem machineNestedMatrixEntryAtUnary_mem_FP : have hrowPayload := machinePair_mem_FP hrow hmatrix have hrowCode := machineCompose_mem_FP hrowPayload machineListIndex_mem_FP have hentryPayload := machinePair_mem_FP hcolumn hrowCode - simpa only [machineNestedMatrixEntryAtUnary] using + simpa only [machineNestedMatrixEntryAtUnary] using! machineCompose_mem_FP hentryPayload machineListIndex_mem_FP theorem machineNestedMatrixUpdateAtUnary_mem_FP : @@ -72,7 +72,7 @@ theorem machineNestedMatrixUpdateAtUnary_mem_FP : machineListUpdate_mem_FP have hupdateMatrixPayload := machinePair_mem_FP hrow (machinePair_mem_FP hupdatedRow hmatrix) - simpa only [machineNestedMatrixUpdateAtUnary] using + simpa only [machineNestedMatrixUpdateAtUnary] using! machineCompose_mem_FP hupdateMatrixPayload machineListUpdate_mem_FP @[simp] theorem machineNestedMatrixEntryAtUnary_encode diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerBisectionLoop.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerBisectionLoop.lean index c07731293d..2ce45288c5 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerBisectionLoop.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerBisectionLoop.lean @@ -213,12 +213,12 @@ theorem machineOptimizerInitialLowEntryCode_mem_FP : have hneg := machineCompose_mem_FP machineOptimizerTwiceNSquareForWidthRawCode_mem_FP machineRawRatNegCode_mem_FP - simpa only [machineOptimizerInitialLowEntryCode] using + simpa only [machineOptimizerInitialLowEntryCode] using! machineCompose_mem_FP hneg machineNormalizeRawRatEntryCode_mem_FP theorem machineOptimizerInitialWidthEntryCodeForBisection_mem_FP : machineOptimizerInitialWidthEntryCodeForBisection ∈ FP := by - simpa only [machineOptimizerInitialWidthEntryCodeForBisection] using + simpa only [machineOptimizerInitialWidthEntryCodeForBisection] using! machineCompose_mem_FP machineExplicitOptimizerInitialWidthRawCode_mem_FP machineNormalizeRawRatEntryCode_mem_FP @@ -227,26 +227,26 @@ theorem machineOptimizerBisectionStateSource_mem_FP : theorem machineOptimizerBisectionStateRuler_mem_FP : machineOptimizerBisectionStateRuler ∈ FP := by - simpa only [machineOptimizerBisectionStateRuler] using + simpa only [machineOptimizerBisectionStateRuler] using! machineCompose_mem_FP machinePairSecond_mem_FP machinePairFirst_mem_FP theorem machineOptimizerBisectionStateIndex_mem_FP : machineOptimizerBisectionStateIndex ∈ FP := by have htail := machineCompose_mem_FP machinePairSecond_mem_FP machinePairSecond_mem_FP - simpa only [machineOptimizerBisectionStateIndex] using + simpa only [machineOptimizerBisectionStateIndex] using! machineCompose_mem_FP htail machinePairFirst_mem_FP theorem machineOptimizerBisectionStateDepth_mem_FP : machineOptimizerBisectionStateDepth ∈ FP := by have htail := machineCompose_mem_FP machinePairSecond_mem_FP machinePairSecond_mem_FP - simpa only [machineOptimizerBisectionStateDepth] using + simpa only [machineOptimizerBisectionStateDepth] using! machineCompose_mem_FP htail machinePairSecond_mem_FP theorem machineOptimizerBisectionInit_mem_FP : machineOptimizerBisectionInit ∈ FP := by - simpa only [machineOptimizerBisectionInit] using + simpa only [machineOptimizerBisectionInit] using! machinePair_mem_FP id_mem_FP (machinePair_mem_FP machineExplicitOptimizerBisectionStepsRuler_mem_FP (machinePair_mem_FP (machineConst_mem_FP []) @@ -254,7 +254,7 @@ theorem machineOptimizerBisectionInit_mem_FP : theorem machineOptimizerBisectionEvenIndexBits_mem_FP : machineOptimizerBisectionEvenIndexBits ∈ FP := by - simpa only [machineOptimizerBisectionEvenIndexBits] using + simpa only [machineOptimizerBisectionEvenIndexBits] using! machineCompose_mem_FP (machinePair_mem_FP machineOptimizerBisectionStateIndex_mem_FP (machineConst_mem_FP [false, true])) @@ -262,7 +262,7 @@ theorem machineOptimizerBisectionEvenIndexBits_mem_FP : theorem machineOptimizerBisectionOddIndexBits_mem_FP : machineOptimizerBisectionOddIndexBits ∈ FP := by - simpa only [machineOptimizerBisectionOddIndexBits] using + simpa only [machineOptimizerBisectionOddIndexBits] using! machineCompose_mem_FP (machinePair_mem_FP machineOptimizerBisectionEvenIndexBits_mem_FP (machineConst_mem_FP [true])) @@ -270,13 +270,13 @@ theorem machineOptimizerBisectionOddIndexBits_mem_FP : theorem machineOptimizerBisectionNextDepth_mem_FP : machineOptimizerBisectionNextDepth ∈ FP := by - simpa only [machineOptimizerBisectionNextDepth] using + simpa only [machineOptimizerBisectionNextDepth] using! machineCompose_mem_FP machineOptimizerBisectionStateDepth_mem_FP (machinePrepend_mem_FP true) theorem machineOptimizerBisectionDenominatorBits_mem_FP : machineOptimizerBisectionDenominatorBits ∈ FP := by - simpa only [machineOptimizerBisectionDenominatorBits] using + simpa only [machineOptimizerBisectionDenominatorBits] using! machineCompose_mem_FP machineOptimizerBisectionNextDepth_mem_FP machineDirectedLogPowerTwoBits_mem_FP @@ -293,7 +293,7 @@ theorem machineOptimizerBisectionScaledFractionRawCode_mem_FP : have hwidth := machineCompose_mem_FP machineOptimizerBisectionStateSource_mem_FP machineOptimizerInitialWidthEntryCodeForBisection_mem_FP - simpa only [machineOptimizerBisectionScaledFractionRawCode] using + simpa only [machineOptimizerBisectionScaledFractionRawCode] using! machineCompose_mem_FP (machinePair_mem_FP machineOptimizerBisectionFractionRawCode_mem_FP hwidth) @@ -304,7 +304,7 @@ theorem machineOptimizerBisectionMidpointUnnormalizedRawCode_mem_FP : have hlow := machineCompose_mem_FP machineOptimizerBisectionStateSource_mem_FP machineOptimizerInitialLowEntryCode_mem_FP - simpa only [machineOptimizerBisectionMidpointUnnormalizedRawCode] using + simpa only [machineOptimizerBisectionMidpointUnnormalizedRawCode] using! machineCompose_mem_FP (machinePair_mem_FP hlow machineOptimizerBisectionScaledFractionRawCode_mem_FP) @@ -312,7 +312,7 @@ theorem machineOptimizerBisectionMidpointUnnormalizedRawCode_mem_FP : theorem machineOptimizerBisectionMidpointRawCode_mem_FP : machineOptimizerBisectionMidpointRawCode ∈ FP := by - simpa only [machineOptimizerBisectionMidpointRawCode] using + simpa only [machineOptimizerBisectionMidpointRawCode] using! machineCompose_mem_FP machineOptimizerBisectionMidpointUnnormalizedRawCode_mem_FP machineNormalizeRawRatEntryCode_mem_FP @@ -324,7 +324,7 @@ theorem machineOptimizerBisectionFeasibilityCall_mem_FP : theorem machineOptimizerBisectionFeasibilityResult_mem_FP : machineOptimizerBisectionFeasibilityResult ∈ FP := by - simpa only [machineOptimizerBisectionFeasibilityResult] using + simpa only [machineOptimizerBisectionFeasibilityResult] using! machineCompose_mem_FP machineOptimizerBisectionFeasibilityCall_mem_FP machineExplicitBetheThresholdFeasibilityCode_mem_FP @@ -333,7 +333,7 @@ theorem machineOptimizerBisectionExhaustedBit_mem_FP : have htag := machineCompose_mem_FP machineOptimizerBisectionFeasibilityResult_mem_FP machinePairFirst_mem_FP - simpa only [machineOptimizerBisectionExhaustedBit] using + simpa only [machineOptimizerBisectionExhaustedBit] using! machineCompose_mem_FP htag machineHeadBit_mem_FP theorem machineOptimizerBisectionNextIndexBits_mem_FP : @@ -467,7 +467,7 @@ theorem machineOptimizerBisectionIterate_bound (word : List Bool) : ∀ k, | zero => exact machineOptimizerBisectionInit_bound word | succ k ih => rw [Function.iterate_succ_apply'] - simpa only [Nat.succ_eq_add_one] using + simpa only [Nat.succ_eq_add_one] using! machineOptimizerBisectionStep_bound ih def machineOptimizerBisectionWidth (word : List Bool) : List Bool := @@ -482,7 +482,7 @@ theorem machineOptimizerBisectionWidth_mem_FP : have henvelope : (fun word : List Bool ↦ false :: (word ++ machineExplicitOptimizerBisectionStepsRuler word)) ∈ FP := machineCompose_mem_FP happend (machinePrepend_mem_FP false) - simpa only [machineOptimizerBisectionWidth] using + simpa only [machineOptimizerBisectionWidth] using! machinePair_mem_FP henvelope (machinePair_mem_FP henvelope (machinePair_mem_FP henvelope henvelope)) @@ -518,7 +518,7 @@ theorem machineOptimizerBisectionFinalState_mem_FP : theorem machineOptimizerBisectionHighIndexBits_mem_FP : machineOptimizerBisectionHighIndexBits ∈ FP := by - simpa only [machineOptimizerBisectionHighIndexBits] using + simpa only [machineOptimizerBisectionHighIndexBits] using! machineCompose_mem_FP (machinePair_mem_FP machineOptimizerBisectionStateIndex_mem_FP (machineConst_mem_FP [true])) @@ -539,7 +539,7 @@ theorem machineOptimizerBisectionHighScaledRawCode_mem_FP : have hwidth := machineCompose_mem_FP machineOptimizerBisectionStateSource_mem_FP machineOptimizerInitialWidthEntryCodeForBisection_mem_FP - simpa only [machineOptimizerBisectionHighScaledRawCode] using + simpa only [machineOptimizerBisectionHighScaledRawCode] using! machineCompose_mem_FP (machinePair_mem_FP machineOptimizerBisectionHighFractionRawCode_mem_FP hwidth) @@ -550,7 +550,7 @@ theorem machineOptimizerBisectionHighUnnormalizedRawCode_mem_FP : have hlow := machineCompose_mem_FP machineOptimizerBisectionStateSource_mem_FP machineOptimizerInitialLowEntryCode_mem_FP - simpa only [machineOptimizerBisectionHighUnnormalizedRawCode] using + simpa only [machineOptimizerBisectionHighUnnormalizedRawCode] using! machineCompose_mem_FP (machinePair_mem_FP hlow machineOptimizerBisectionHighScaledRawCode_mem_FP) @@ -558,7 +558,7 @@ theorem machineOptimizerBisectionHighUnnormalizedRawCode_mem_FP : theorem machineOptimizerBisectionHighRawCode_mem_FP : machineOptimizerBisectionHighRawCode ∈ FP := by - simpa only [machineOptimizerBisectionHighRawCode] using + simpa only [machineOptimizerBisectionHighRawCode] using! machineCompose_mem_FP machineOptimizerBisectionHighUnnormalizedRawCode_mem_FP machineNormalizeRawRatEntryCode_mem_FP @@ -569,13 +569,13 @@ theorem machineExplicitBetheOptimizerFeasibilityResultCode_mem_FP : machineOptimizerBisectionFinalState_mem_FP machineOptimizerBisectionHighRawCode_mem_FP have hcall := machinePair_mem_FP id_mem_FP hhigh - simpa only [machineExplicitBetheOptimizerFeasibilityResultCode] using + simpa only [machineExplicitBetheOptimizerFeasibilityResultCode] using! machineCompose_mem_FP hcall machineExplicitBetheThresholdFeasibilityCode_mem_FP theorem machineExplicitBetheOptimizerPointCode_mem_FP : machineExplicitBetheOptimizerPointCode ∈ FP := by - simpa only [machineExplicitBetheOptimizerPointCode] using + simpa only [machineExplicitBetheOptimizerPointCode] using! machineCompose_mem_FP machineExplicitBetheOptimizerFeasibilityResultCode_mem_FP machinePairSecond_mem_FP diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerBisectionSchedule.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerBisectionSchedule.lean index eb629e8e36..733b4c2163 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerBisectionSchedule.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerBisectionSchedule.lean @@ -82,7 +82,7 @@ def machineExplicitOptimizerInitialWidthRawCode theorem machineOptimizerObjectiveUpperRawCode_mem_FP : machineOptimizerObjectiveUpperRawCode ∈ FP := by - simpa only [machineOptimizerObjectiveUpperRawCode] using + simpa only [machineOptimizerObjectiveUpperRawCode] using! machineCompose_mem_FP (machinePair_mem_FP machineOptimizerNBProductRawCode_mem_FP machineOptimizerDimensionRawCode_mem_FP) @@ -90,7 +90,7 @@ theorem machineOptimizerObjectiveUpperRawCode_mem_FP : theorem machineOptimizerTwiceInnerRadiusRawCode_mem_FP : machineOptimizerTwiceInnerRadiusRawCode ∈ FP := by - simpa only [machineOptimizerTwiceInnerRadiusRawCode] using + simpa only [machineOptimizerTwiceInnerRadiusRawCode] using! machineCompose_mem_FP (machinePair_mem_FP (machineConst_mem_FP (rawRatBinaryCode rawOptimizerTwo)) @@ -99,14 +99,14 @@ theorem machineOptimizerTwiceInnerRadiusRawCode_mem_FP : theorem machineOptimizerMixRangeRawCode_mem_FP : machineOptimizerMixRangeRawCode ∈ FP := by - simpa only [machineOptimizerMixRangeRawCode] using machineCompose_mem_FP + simpa only [machineOptimizerMixRangeRawCode] using! machineCompose_mem_FP (machinePair_mem_FP machineExplicitOptimizerMixRawCode_mem_FP machineOptimizerObjectiveRangeRawCode_mem_FP) machineRawRatMulCode_mem_FP theorem machineOptimizerSmoothingSlackRawCode_mem_FP : machineOptimizerSmoothingSlackRawCode ∈ FP := by - simpa only [machineOptimizerSmoothingSlackRawCode] using + simpa only [machineOptimizerSmoothingSlackRawCode] using! machineCompose_mem_FP (machinePair_mem_FP machineOptimizerMixRangeRawCode_mem_FP machineOptimizerTwiceInnerRadiusRawCode_mem_FP) @@ -114,14 +114,14 @@ theorem machineOptimizerSmoothingSlackRawCode_mem_FP : theorem machineOptimizerInitialHighRawCode_mem_FP : machineOptimizerInitialHighRawCode ∈ FP := by - simpa only [machineOptimizerInitialHighRawCode] using machineCompose_mem_FP + simpa only [machineOptimizerInitialHighRawCode] using! machineCompose_mem_FP (machinePair_mem_FP machineOptimizerObjectiveUpperRawCode_mem_FP machineOptimizerSmoothingSlackRawCode_mem_FP) machineRawRatAddCode_mem_FP theorem machineOptimizerTwiceNSquareForWidthRawCode_mem_FP : machineOptimizerTwiceNSquareForWidthRawCode ∈ FP := by - simpa only [machineOptimizerTwiceNSquareForWidthRawCode] using + simpa only [machineOptimizerTwiceNSquareForWidthRawCode] using! machineCompose_mem_FP (machinePair_mem_FP (machineConst_mem_FP (rawRatBinaryCode rawOptimizerTwo)) @@ -130,7 +130,7 @@ theorem machineOptimizerTwiceNSquareForWidthRawCode_mem_FP : theorem machineExplicitOptimizerInitialWidthRawCode_mem_FP : machineExplicitOptimizerInitialWidthRawCode ∈ FP := by - simpa only [machineExplicitOptimizerInitialWidthRawCode] using + simpa only [machineExplicitOptimizerInitialWidthRawCode] using! machineCompose_mem_FP (machinePair_mem_FP machineOptimizerInitialHighRawCode_mem_FP machineOptimizerTwiceNSquareForWidthRawCode_mem_FP) @@ -278,20 +278,20 @@ def machineExplicitOptimizerBisectionStepsRuler theorem machineExplicitOptimizerInitialWidthEntryCode_mem_FP : machineExplicitOptimizerInitialWidthEntryCode ∈ FP := by - simpa only [machineExplicitOptimizerInitialWidthEntryCode] using + simpa only [machineExplicitOptimizerInitialWidthEntryCode] using! machineCompose_mem_FP machineExplicitOptimizerInitialWidthRawCode_mem_FP machineNormalizeRawRatEntryCode_mem_FP theorem machineExplicitOptimizerInitialWidthLengthRuler_mem_FP : machineExplicitOptimizerInitialWidthLengthRuler ∈ FP := by - simpa only [machineExplicitOptimizerInitialWidthLengthRuler] using + simpa only [machineExplicitOptimizerInitialWidthLengthRuler] using! machineCompose_mem_FP machineExplicitOptimizerInitialWidthEntryCode_mem_FP machineOptimizerEntryLengthRuler_mem_FP theorem machineExplicitOptimizerBisectionStepsRuler_mem_FP : machineExplicitOptimizerBisectionStepsRuler ∈ FP := by - simpa only [machineExplicitOptimizerBisectionStepsRuler] using + simpa only [machineExplicitOptimizerBisectionStepsRuler] using! machineAppend_mem_FP machineExplicitOptimizerInitialWidthLengthRuler_mem_FP (machineAppend_mem_FP machineExplicitOptimizerGapLengthRuler_mem_FP diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerBisectionSemantics.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerBisectionSemantics.lean index e7422dd12a..459df30ff2 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerBisectionSemantics.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerBisectionSemantics.lean @@ -443,13 +443,13 @@ theorem scannedOptimizerIndexStep_agrees {m : ℕ} | accepted q => simp only [scannedOptimizerIndexStep, hrun] constructor - · simpa only [optimizerDyadicThreshold_even] using hlow + · simpa only [optimizerDyadicThreshold_even] using! hlow · rfl | exhausted E => simp only [scannedOptimizerIndexStep, hrun] constructor · rfl - · simpa only [optimizerDyadicThreshold_odd_high] using hhigh + · simpa only [optimizerDyadicThreshold_odd_high] using! hhigh theorem runScannedOptimizerIndex_agrees {m : ℕ} (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) @@ -466,10 +466,10 @@ theorem runScannedOptimizerIndex_agrees {m : ℕ} intro N induction N generalizing s k t with | zero => simpa [runScannedBetheBisection, - runScannedOptimizerIndex] using hs + runScannedOptimizerIndex] using! hs | succ N ih => rw [runScannedBetheBisection, runScannedOptimizerIndex] have hstep := scannedOptimizerIndexStep_agrees A hs - simpa only [Nat.add_assoc, Nat.add_comm 1 N] using ih hstep + simpa only [Nat.add_assoc, Nat.add_comm 1 N] using! ih hstep end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerDerivedScales.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerDerivedScales.lean index c42efa7ff5..3bac453f1a 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerDerivedScales.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerDerivedScales.lean @@ -141,14 +141,14 @@ theorem machineExplicitOptimizerRhoRawCode_mem_FP : (machinePair_mem_FP machineExplicitOptimizerFloorRawCode_mem_FP (machineConst_mem_FP (rawRatBinaryCode rawOptimizerKKTError))) machineRawRatMulCode_mem_FP - simpa only [machineExplicitOptimizerRhoRawCode] using machineCompose_mem_FP + simpa only [machineExplicitOptimizerRhoRawCode] using! machineCompose_mem_FP (machinePair_mem_FP hproduct (machineConst_mem_FP (rawRatBinaryCode rawOptimizerFortyEight))) machineRawRatDivCode_mem_FP theorem machineExplicitOptimizerRhoSquareRawCode_mem_FP : machineExplicitOptimizerRhoSquareRawCode ∈ FP := by - simpa only [machineExplicitOptimizerRhoSquareRawCode] using + simpa only [machineExplicitOptimizerRhoSquareRawCode] using! machineCompose_mem_FP (machinePair_mem_FP machineExplicitOptimizerRhoRawCode_mem_FP machineExplicitOptimizerRhoRawCode_mem_FP) @@ -156,7 +156,7 @@ theorem machineExplicitOptimizerRhoSquareRawCode_mem_FP : theorem machineExplicitOptimizerGapNumeratorRawCode_mem_FP : machineExplicitOptimizerGapNumeratorRawCode ∈ FP := by - simpa only [machineExplicitOptimizerGapNumeratorRawCode] using + simpa only [machineExplicitOptimizerGapNumeratorRawCode] using! machineCompose_mem_FP (machinePair_mem_FP machineOptimizerTauRawCode_mem_FP machineExplicitOptimizerRhoSquareRawCode_mem_FP) @@ -164,14 +164,14 @@ theorem machineExplicitOptimizerGapNumeratorRawCode_mem_FP : theorem machineExplicitOptimizerGapRawCode_mem_FP : machineExplicitOptimizerGapRawCode ∈ FP := by - simpa only [machineExplicitOptimizerGapRawCode] using machineCompose_mem_FP + simpa only [machineExplicitOptimizerGapRawCode] using! machineCompose_mem_FP (machinePair_mem_FP machineExplicitOptimizerGapNumeratorRawCode_mem_FP (machineConst_mem_FP (rawRatBinaryCode rawOptimizerFour))) machineRawRatDivCode_mem_FP theorem machineOptimizerThreeNSquareRawCode_mem_FP : machineOptimizerThreeNSquareRawCode ∈ FP := by - simpa only [machineOptimizerThreeNSquareRawCode] using machineCompose_mem_FP + simpa only [machineOptimizerThreeNSquareRawCode] using! machineCompose_mem_FP (machinePair_mem_FP (machineConst_mem_FP (rawRatBinaryCode rawOptimizerThree)) machineOptimizerNSquareRawCode_mem_FP) @@ -179,21 +179,21 @@ theorem machineOptimizerThreeNSquareRawCode_mem_FP : theorem machineOptimizerObjectiveRangeRawCode_mem_FP : machineOptimizerObjectiveRangeRawCode ∈ FP := by - simpa only [machineOptimizerObjectiveRangeRawCode] using machineCompose_mem_FP + simpa only [machineOptimizerObjectiveRangeRawCode] using! machineCompose_mem_FP (machinePair_mem_FP machineOptimizerNBProductRawCode_mem_FP machineOptimizerThreeNSquareRawCode_mem_FP) machineRawRatAddCode_mem_FP theorem machineOptimizerRangePlusOneRawCode_mem_FP : machineOptimizerRangePlusOneRawCode ∈ FP := by - simpa only [machineOptimizerRangePlusOneRawCode] using machineCompose_mem_FP + simpa only [machineOptimizerRangePlusOneRawCode] using! machineCompose_mem_FP (machinePair_mem_FP machineOptimizerObjectiveRangeRawCode_mem_FP (machineConst_mem_FP (rawRatBinaryCode rawOptimizerOne))) machineRawRatAddCode_mem_FP theorem machineOptimizerMixDenominatorRawCode_mem_FP : machineOptimizerMixDenominatorRawCode ∈ FP := by - simpa only [machineOptimizerMixDenominatorRawCode] using machineCompose_mem_FP + simpa only [machineOptimizerMixDenominatorRawCode] using! machineCompose_mem_FP (machinePair_mem_FP (machineConst_mem_FP (rawRatBinaryCode rawOptimizerFour)) machineOptimizerRangePlusOneRawCode_mem_FP) @@ -201,14 +201,14 @@ theorem machineOptimizerMixDenominatorRawCode_mem_FP : theorem machineOptimizerMixCandidateRawCode_mem_FP : machineOptimizerMixCandidateRawCode ∈ FP := by - simpa only [machineOptimizerMixCandidateRawCode] using machineCompose_mem_FP + simpa only [machineOptimizerMixCandidateRawCode] using! machineCompose_mem_FP (machinePair_mem_FP machineExplicitOptimizerGapRawCode_mem_FP machineOptimizerMixDenominatorRawCode_mem_FP) machineRawRatDivCode_mem_FP theorem machineExplicitOptimizerMixRawCode_mem_FP : machineExplicitOptimizerMixRawCode ∈ FP := by - simpa only [machineExplicitOptimizerMixRawCode] using machineCompose_mem_FP + simpa only [machineExplicitOptimizerMixRawCode] using! machineCompose_mem_FP (machinePair_mem_FP (machineConst_mem_FP (rawRatBinaryCode rawOptimizerHalf)) machineOptimizerMixCandidateRawCode_mem_FP) @@ -216,7 +216,7 @@ theorem machineExplicitOptimizerMixRawCode_mem_FP : theorem machineOptimizerTwiceDimensionRawCode_mem_FP : machineOptimizerTwiceDimensionRawCode ∈ FP := by - simpa only [machineOptimizerTwiceDimensionRawCode] using machineCompose_mem_FP + simpa only [machineOptimizerTwiceDimensionRawCode] using! machineCompose_mem_FP (machinePair_mem_FP (machineConst_mem_FP (rawRatBinaryCode rawOptimizerTwo)) machineOptimizerDimensionRawCode_mem_FP) @@ -224,7 +224,7 @@ theorem machineOptimizerTwiceDimensionRawCode_mem_FP : theorem machineExplicitOptimizerInnerRadiusRawCode_mem_FP : machineExplicitOptimizerInnerRadiusRawCode ∈ FP := by - simpa only [machineExplicitOptimizerInnerRadiusRawCode] using + simpa only [machineExplicitOptimizerInnerRadiusRawCode] using! machineCompose_mem_FP (machinePair_mem_FP machineExplicitOptimizerMixRawCode_mem_FP machineOptimizerTwiceDimensionRawCode_mem_FP) @@ -450,13 +450,13 @@ def machineExplicitOptimizerPrecisionRuler theorem machineExplicitOptimizerGapEntryCode_mem_FP : machineExplicitOptimizerGapEntryCode ∈ FP := by - simpa only [machineExplicitOptimizerGapEntryCode] using + simpa only [machineExplicitOptimizerGapEntryCode] using! machineCompose_mem_FP machineExplicitOptimizerGapRawCode_mem_FP machineNormalizeRawRatEntryCode_mem_FP theorem machineExplicitOptimizerGapLengthRuler_mem_FP : machineExplicitOptimizerGapLengthRuler ∈ FP := by - simpa only [machineExplicitOptimizerGapLengthRuler] using + simpa only [machineExplicitOptimizerGapLengthRuler] using! machineCompose_mem_FP machineExplicitOptimizerGapEntryCode_mem_FP machineOptimizerEntryLengthRuler_mem_FP @@ -468,7 +468,7 @@ theorem machineExplicitOptimizerPrecisionRuler_mem_FP : have htail := machineAppend_mem_FP (machineConst_mem_FP (List.replicate (encodedBitLength ℚ explicitKKTError) true)) hdim2 - simpa only [machineExplicitOptimizerPrecisionRuler] using + simpa only [machineExplicitOptimizerPrecisionRuler] using! machineAppend_mem_FP machineExplicitOptimizerGapLengthRuler_mem_FP htail @[simp] theorem machineExplicitOptimizerGapEntryCode_encode diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerEntryLength.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerEntryLength.lean index c502f65fc2..6f946d1273 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerEntryLength.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerEntryLength.lean @@ -94,7 +94,7 @@ theorem rational_encodedBitLength_eq_boolDataLength (q : ℚ) : change (DataEncode.encode (rationalPayload q)).size = _ rw [show DataEncode.encode (rationalPayload q) = Data.l [DataEncode.encode q.num, DataEncode.encode q.den] by - simpa only [rationalPayload] using DataEncode_pair q.num q.den] + simpa only [rationalPayload] using! DataEncode_pair q.num q.den] simp only [Data.size, List.map_cons, List.map_nil, List.sum_cons, List.sum_nil, add_zero] rw [← encodedBitLength_eq_dataSize, @@ -165,7 +165,7 @@ theorem machineBoolDataContinue_mem_FP : theorem machineBoolDataStep_mem_FP : machineBoolDataStep ∈ Complexity.FP := by - simpa only [machineBoolDataStep] using + simpa only [machineBoolDataStep] using! machineIfEmpty_mem_FP machineBoolDataRemaining_mem_FP id_mem_FP machineBoolDataContinue_mem_FP @@ -178,7 +178,7 @@ theorem machineBoolDataBound_mem_FP : have hdouble := machineAppend_mem_FP id_mem_FP id_mem_FP have htriple := machineAppend_mem_FP id_mem_FP hdouble have hquadruple := machineAppend_mem_FP id_mem_FP htriple - simpa only [machineBoolDataBound] using + simpa only [machineBoolDataBound] using! machineAppend_mem_FP (machineConst_mem_FP (List.replicate 4 true)) hquadruple @@ -261,7 +261,7 @@ theorem machineBoolDataFinalState_mem_FP : theorem machineBoolDataLengthRuler_mem_FP : machineBoolDataLengthRuler ∈ Complexity.FP := by - simpa only [machineBoolDataLengthRuler] using + simpa only [machineBoolDataLengthRuler] using! machineCompose_mem_FP machineBoolDataFinalState_mem_FP machineBoolDataAcc_mem_FP @@ -322,7 +322,7 @@ theorem machineOptimizerEntryNumeratorCode_mem_FP : theorem machineOptimizerEntryNatAbsBits_mem_FP : machineOptimizerEntryNatAbsBits ∈ Complexity.FP := by - simpa only [machineOptimizerEntryNatAbsBits] using + simpa only [machineOptimizerEntryNatAbsBits] using! machineCompose_mem_FP machineOptimizerEntryNumeratorCode_mem_FP machineIntegerNatAbsBits_mem_FP @@ -334,13 +334,13 @@ theorem machineOptimizerEntrySignRuler_mem_FP : theorem machineOptimizerEntryNumeratorRuler_mem_FP : machineOptimizerEntryNumeratorRuler ∈ Complexity.FP := by - simpa only [machineOptimizerEntryNumeratorRuler] using + simpa only [machineOptimizerEntryNumeratorRuler] using! machineCompose_mem_FP machineOptimizerEntryNatAbsBits_mem_FP machineBoolDataLengthRuler_mem_FP theorem machineOptimizerEntryDenominatorRuler_mem_FP : machineOptimizerEntryDenominatorRuler ∈ Complexity.FP := by - simpa only [machineOptimizerEntryDenominatorRuler] using + simpa only [machineOptimizerEntryDenominatorRuler] using! machineCompose_mem_FP machineRationalEntryDenominatorWord_mem_FP machineBoolDataLengthRuler_mem_FP @@ -351,7 +351,7 @@ theorem machineOptimizerEntryLengthRuler_mem_FP : machineOptimizerEntryDenominatorRuler_mem_FP have hpayload := machineAppend_mem_FP machineOptimizerEntrySignRuler_mem_FP htail - simpa only [machineOptimizerEntryLengthRuler] using + simpa only [machineOptimizerEntryLengthRuler] using! machineAppend_mem_FP (machineConst_mem_FP (List.replicate 8 true)) hpayload diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerFeasibilityCall.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerFeasibilityCall.lean index 82a7903aed..d9f8e6fcef 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerFeasibilityCall.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerFeasibilityCall.lean @@ -70,7 +70,7 @@ def machineExplicitBetheThresholdFeasibilityCode theorem machineOptimizerFeasibilityReducedDimensionUnary_mem_FP : machineOptimizerFeasibilityReducedDimensionUnary ∈ FP := by - simpa only [machineOptimizerFeasibilityReducedDimensionUnary] using + simpa only [machineOptimizerFeasibilityReducedDimensionUnary] using! machineCompose_mem_FP (machinePair_mem_FP machineOptimizerFeasibilitySource_mem_FP machineOptimizerFeasibilityReducedDimensionBits_mem_FP) @@ -81,12 +81,12 @@ theorem machineOptimizerFeasibilityTauCode_mem_FP : have htau := machineCompose_mem_FP machineOptimizerFeasibilitySource_mem_FP machineOptimizerTauRawCode_mem_FP - simpa only [machineOptimizerFeasibilityTauCode] using + simpa only [machineOptimizerFeasibilityTauCode] using! machineCompose_mem_FP htau machineNormalizeRawRatEntryCode_mem_FP theorem machineOptimizerFeasibilityDeltaRawCode_mem_FP : machineOptimizerFeasibilityDeltaRawCode ∈ FP := by - simpa only [machineOptimizerFeasibilityDeltaRawCode] using + simpa only [machineOptimizerFeasibilityDeltaRawCode] using! machineCompose_mem_FP machineOptimizerFeasibilitySource_mem_FP machineExplicitOptimizerFloorRawCode_mem_FP @@ -106,7 +106,7 @@ theorem machineOptimizerFeasibilityOracleStaticCode_mem_FP : theorem machineOptimizerFeasibilityInitialBallCode_mem_FP : machineOptimizerFeasibilityInitialBallCode ∈ FP := by - simpa only [machineOptimizerFeasibilityInitialBallCode] using + simpa only [machineOptimizerFeasibilityInitialBallCode] using! machineCompose_mem_FP (machinePair_mem_FP machineOptimizerFeasibilityEllipsoidDimensionUnary_mem_FP @@ -125,7 +125,7 @@ theorem machineOptimizerFeasibilityLoopWord_mem_FP : theorem machineExplicitBetheThresholdFeasibilityCode_mem_FP : machineExplicitBetheThresholdFeasibilityCode ∈ FP := by - simpa only [machineExplicitBetheThresholdFeasibilityCode] using + simpa only [machineExplicitBetheThresholdFeasibilityCode] using! machineCompose_mem_FP machineOptimizerFeasibilityLoopWord_mem_FP machineBetheFeasibilityResultCode_mem_FP @@ -271,7 +271,7 @@ theorem machineExplicitBetheThresholdFeasibilityCode_encode have htau0 : 0 ≤ tau := (explicitRegularizationScale_pos (by omega)).le have htau1 : tau ≤ 1 := explicitRegularizationScale_le_one (by omega) have hdelta : 0 < delta.value := by - simpa only [delta, (rawExplicitOptimizerScales_value A).1] using + simpa only [delta, (rawExplicitOptimizerScales_value A).1] using! explicitOptimizerFloor_pos A have hr : 0 < r := explicitOptimizerInnerRadius_pos A have hR : 0 < R := betheEpigraphOuterRadius_pos m hr.le @@ -280,6 +280,6 @@ theorem machineExplicitBetheThresholdFeasibilityCode_encode have hmachine := machineExplicitBallBetheFeasibilityResultCode_encode hm htau0 htau1 hA (explicitOptimizerPrecision A) hdelta upper T hR simpa only [tau, delta, r, R, T, - runExplicitScannedBetheThresholdFeasibility] using hmachine + runExplicitScannedBetheThresholdFeasibility] using! hmachine end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerFeasibilitySchedule.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerFeasibilitySchedule.lean index 2b7fa307ff..d0796e8f8b 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerFeasibilitySchedule.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerFeasibilitySchedule.lean @@ -113,18 +113,18 @@ theorem machineRawRatAbsCode_mem_FP : machineRawRatAbsCode ∈ FP := by have habs := machineCompose_mem_FP machinePairFirst_mem_FP machineIntegerNatAbsBits_mem_FP have hnum := machineCompose_mem_FP habs machineNaturalIntegerCode_mem_FP - simpa only [machineRawRatAbsCode] using + simpa only [machineRawRatAbsCode] using! machinePair_mem_FP hnum machinePairSecond_mem_FP theorem machineOptimizerFeasibilityDimensionBits_mem_FP : machineOptimizerFeasibilityDimensionBits ∈ FP := by - simpa only [machineOptimizerFeasibilityDimensionBits] using + simpa only [machineOptimizerFeasibilityDimensionBits] using! machineCompose_mem_FP machineOptimizerFeasibilitySource_mem_FP machineOptimizerDimensionBits_mem_FP theorem machineOptimizerFeasibilityReducedDimensionBits_mem_FP : machineOptimizerFeasibilityReducedDimensionBits ∈ FP := by - simpa only [machineOptimizerFeasibilityReducedDimensionBits] using + simpa only [machineOptimizerFeasibilityReducedDimensionBits] using! machineCompose_mem_FP (machinePair_mem_FP machineOptimizerFeasibilityDimensionBits_mem_FP (machineConst_mem_FP [true])) @@ -132,7 +132,7 @@ theorem machineOptimizerFeasibilityReducedDimensionBits_mem_FP : theorem machineOptimizerFeasibilityReducedDimensionSquareBits_mem_FP : machineOptimizerFeasibilityReducedDimensionSquareBits ∈ FP := by - simpa only [machineOptimizerFeasibilityReducedDimensionSquareBits] using + simpa only [machineOptimizerFeasibilityReducedDimensionSquareBits] using! machineCompose_mem_FP (machinePair_mem_FP machineOptimizerFeasibilityReducedDimensionBits_mem_FP @@ -141,7 +141,7 @@ theorem machineOptimizerFeasibilityReducedDimensionSquareBits_mem_FP : theorem machineOptimizerFeasibilityEllipsoidDimensionBits_mem_FP : machineOptimizerFeasibilityEllipsoidDimensionBits ∈ FP := by - simpa only [machineOptimizerFeasibilityEllipsoidDimensionBits] using + simpa only [machineOptimizerFeasibilityEllipsoidDimensionBits] using! machineCompose_mem_FP (machinePair_mem_FP machineOptimizerFeasibilityReducedDimensionSquareBits_mem_FP @@ -150,7 +150,7 @@ theorem machineOptimizerFeasibilityEllipsoidDimensionBits_mem_FP : theorem machineOptimizerFeasibilityEllipsoidDimensionUnary_mem_FP : machineOptimizerFeasibilityEllipsoidDimensionUnary ∈ FP := by - simpa only [machineOptimizerFeasibilityEllipsoidDimensionUnary] using + simpa only [machineOptimizerFeasibilityEllipsoidDimensionUnary] using! machineCompose_mem_FP (machinePair_mem_FP machineOptimizerFeasibilitySource_mem_FP machineOptimizerFeasibilityEllipsoidDimensionBits_mem_FP) @@ -158,7 +158,7 @@ theorem machineOptimizerFeasibilityEllipsoidDimensionUnary_mem_FP : theorem machineOptimizerFeasibilityEllipsoidDimensionRawCode_mem_FP : machineOptimizerFeasibilityEllipsoidDimensionRawCode ∈ FP := by - simpa only [machineOptimizerFeasibilityEllipsoidDimensionRawCode] using + simpa only [machineOptimizerFeasibilityEllipsoidDimensionRawCode] using! machinePair_mem_FP (machineCompose_mem_FP machineOptimizerFeasibilityEllipsoidDimensionBits_mem_FP @@ -167,13 +167,13 @@ theorem machineOptimizerFeasibilityEllipsoidDimensionRawCode_mem_FP : theorem machineOptimizerFeasibilityInnerRadiusRawCode_mem_FP : machineOptimizerFeasibilityInnerRadiusRawCode ∈ FP := by - simpa only [machineOptimizerFeasibilityInnerRadiusRawCode] using + simpa only [machineOptimizerFeasibilityInnerRadiusRawCode] using! machineCompose_mem_FP machineOptimizerFeasibilitySource_mem_FP machineExplicitOptimizerInnerRadiusRawCode_mem_FP theorem machineOptimizerFeasibilityTwiceInnerRadiusRawCode_mem_FP : machineOptimizerFeasibilityTwiceInnerRadiusRawCode ∈ FP := by - simpa only [machineOptimizerFeasibilityTwiceInnerRadiusRawCode] using + simpa only [machineOptimizerFeasibilityTwiceInnerRadiusRawCode] using! machineCompose_mem_FP (machinePair_mem_FP (machineConst_mem_FP (rawRatBinaryCode rawOptimizerTwo)) @@ -184,7 +184,7 @@ theorem machineOptimizerFeasibilityOnePlusAbsUpperRawCode_mem_FP : machineOptimizerFeasibilityOnePlusAbsUpperRawCode ∈ FP := by have habs := machineCompose_mem_FP machineOptimizerFeasibilityUpperRawCode_mem_FP machineRawRatAbsCode_mem_FP - simpa only [machineOptimizerFeasibilityOnePlusAbsUpperRawCode] using + simpa only [machineOptimizerFeasibilityOnePlusAbsUpperRawCode] using! machineCompose_mem_FP (machinePair_mem_FP (machineConst_mem_FP (rawRatBinaryCode rawOptimizerOne)) habs) @@ -192,7 +192,7 @@ theorem machineOptimizerFeasibilityOnePlusAbsUpperRawCode_mem_FP : theorem machineOptimizerFeasibilityRadiusFactorRawCode_mem_FP : machineOptimizerFeasibilityRadiusFactorRawCode ∈ FP := by - simpa only [machineOptimizerFeasibilityRadiusFactorRawCode] using + simpa only [machineOptimizerFeasibilityRadiusFactorRawCode] using! machineCompose_mem_FP (machinePair_mem_FP machineOptimizerFeasibilityOnePlusAbsUpperRawCode_mem_FP @@ -201,7 +201,7 @@ theorem machineOptimizerFeasibilityRadiusFactorRawCode_mem_FP : theorem machineOptimizerFeasibilityOuterRadiusRawCode_mem_FP : machineOptimizerFeasibilityOuterRadiusRawCode ∈ FP := by - simpa only [machineOptimizerFeasibilityOuterRadiusRawCode] using + simpa only [machineOptimizerFeasibilityOuterRadiusRawCode] using! machineCompose_mem_FP (machinePair_mem_FP machineOptimizerFeasibilityEllipsoidDimensionRawCode_mem_FP @@ -289,7 +289,7 @@ theorem optimizerEllipsoidDimension_le_sourceLength {n : ℕ} (binaryListCode (binaryListCode rationalEntryBinaryCode) rows).length ≤ word.length := by change rowsCode.length ≤ (pair n.bits rowsCode).length - simpa using machinePairSecond_length_le (pair n.bits rowsCode) + simpa using! machinePairSecond_length_le (pair n.bits rowsCode) have hcount : n ^ 2 = (rows.map List.length).sum := by simp only [rows, rationalMatrixRows, List.map_ofFn, List.sum_ofFn, Function.comp_apply, List.length_ofFn] @@ -499,33 +499,33 @@ def machineOptimizerFeasibilityBudgetUnary theorem machineOptimizerFeasibilityOuterRadiusEntryCode_mem_FP : machineOptimizerFeasibilityOuterRadiusEntryCode ∈ FP := by - simpa only [machineOptimizerFeasibilityOuterRadiusEntryCode] using + simpa only [machineOptimizerFeasibilityOuterRadiusEntryCode] using! machineCompose_mem_FP machineOptimizerFeasibilityOuterRadiusRawCode_mem_FP machineNormalizeRawRatEntryCode_mem_FP theorem machineOptimizerFeasibilityOuterRadiusLengthRuler_mem_FP : machineOptimizerFeasibilityOuterRadiusLengthRuler ∈ FP := by - simpa only [machineOptimizerFeasibilityOuterRadiusLengthRuler] using + simpa only [machineOptimizerFeasibilityOuterRadiusLengthRuler] using! machineCompose_mem_FP machineOptimizerFeasibilityOuterRadiusEntryCode_mem_FP machineOptimizerEntryLengthRuler_mem_FP theorem machineOptimizerFeasibilityInnerRadiusEntryCode_mem_FP : machineOptimizerFeasibilityInnerRadiusEntryCode ∈ FP := by - simpa only [machineOptimizerFeasibilityInnerRadiusEntryCode] using + simpa only [machineOptimizerFeasibilityInnerRadiusEntryCode] using! machineCompose_mem_FP machineOptimizerFeasibilityInnerRadiusRawCode_mem_FP machineNormalizeRawRatEntryCode_mem_FP theorem machineOptimizerFeasibilityInnerRadiusLengthRuler_mem_FP : machineOptimizerFeasibilityInnerRadiusLengthRuler ∈ FP := by - simpa only [machineOptimizerFeasibilityInnerRadiusLengthRuler] using + simpa only [machineOptimizerFeasibilityInnerRadiusLengthRuler] using! machineCompose_mem_FP machineOptimizerFeasibilityInnerRadiusEntryCode_mem_FP machineOptimizerEntryLengthRuler_mem_FP theorem machineOptimizerFeasibilityBudgetGuardSource_mem_FP : machineOptimizerFeasibilityBudgetGuardSource ∈ FP := by - simpa only [machineOptimizerFeasibilityBudgetGuardSource] using + simpa only [machineOptimizerFeasibilityBudgetGuardSource] using! machineAppend_mem_FP machineOptimizerFeasibilityEllipsoidDimensionUnary_mem_FP (machineAppend_mem_FP @@ -538,7 +538,7 @@ theorem machineOptimizerFeasibilityDBits_mem_FP : theorem machineOptimizerFeasibilityDSquareBits_mem_FP : machineOptimizerFeasibilityDSquareBits ∈ FP := by - simpa only [machineOptimizerFeasibilityDSquareBits] using + simpa only [machineOptimizerFeasibilityDSquareBits] using! machineCompose_mem_FP (machinePair_mem_FP machineOptimizerFeasibilityDBits_mem_FP machineOptimizerFeasibilityDBits_mem_FP) @@ -546,7 +546,7 @@ theorem machineOptimizerFeasibilityDSquareBits_mem_FP : theorem machineOptimizerFeasibilityDCubeBits_mem_FP : machineOptimizerFeasibilityDCubeBits ∈ FP := by - simpa only [machineOptimizerFeasibilityDCubeBits] using + simpa only [machineOptimizerFeasibilityDCubeBits] using! machineCompose_mem_FP (machinePair_mem_FP machineOptimizerFeasibilityDSquareBits_mem_FP machineOptimizerFeasibilityDBits_mem_FP) @@ -554,21 +554,21 @@ theorem machineOptimizerFeasibilityDCubeBits_mem_FP : theorem machineOptimizerFeasibilityOuterLengthBits_mem_FP : machineOptimizerFeasibilityOuterLengthBits ∈ FP := by - simpa only [machineOptimizerFeasibilityOuterLengthBits] using + simpa only [machineOptimizerFeasibilityOuterLengthBits] using! machineCompose_mem_FP machineOptimizerFeasibilityOuterRadiusLengthRuler_mem_FP machineLengthBits_mem_FP theorem machineOptimizerFeasibilityInnerLengthBits_mem_FP : machineOptimizerFeasibilityInnerLengthBits ∈ FP := by - simpa only [machineOptimizerFeasibilityInnerLengthBits] using + simpa only [machineOptimizerFeasibilityInnerLengthBits] using! machineCompose_mem_FP machineOptimizerFeasibilityInnerRadiusLengthRuler_mem_FP machineLengthBits_mem_FP theorem machineOptimizerFeasibilityOuterLengthTimesDBits_mem_FP : machineOptimizerFeasibilityOuterLengthTimesDBits ∈ FP := by - simpa only [machineOptimizerFeasibilityOuterLengthTimesDBits] using + simpa only [machineOptimizerFeasibilityOuterLengthTimesDBits] using! machineCompose_mem_FP (machinePair_mem_FP machineOptimizerFeasibilityOuterLengthBits_mem_FP machineOptimizerFeasibilityDBits_mem_FP) @@ -576,7 +576,7 @@ theorem machineOptimizerFeasibilityOuterLengthTimesDBits_mem_FP : theorem machineOptimizerFeasibilityInnerLengthTimesDBits_mem_FP : machineOptimizerFeasibilityInnerLengthTimesDBits ∈ FP := by - simpa only [machineOptimizerFeasibilityInnerLengthTimesDBits] using + simpa only [machineOptimizerFeasibilityInnerLengthTimesDBits] using! machineCompose_mem_FP (machinePair_mem_FP machineOptimizerFeasibilityInnerLengthBits_mem_FP machineOptimizerFeasibilityDBits_mem_FP) @@ -584,7 +584,7 @@ theorem machineOptimizerFeasibilityInnerLengthTimesDBits_mem_FP : theorem machineOptimizerFeasibilityMFirstBits_mem_FP : machineOptimizerFeasibilityMFirstBits ∈ FP := by - simpa only [machineOptimizerFeasibilityMFirstBits] using + simpa only [machineOptimizerFeasibilityMFirstBits] using! machineCompose_mem_FP (machinePair_mem_FP machineOptimizerFeasibilityDSquareBits_mem_FP machineOptimizerFeasibilityOuterLengthTimesDBits_mem_FP) @@ -592,7 +592,7 @@ theorem machineOptimizerFeasibilityMFirstBits_mem_FP : theorem machineOptimizerFeasibilityMSecondBits_mem_FP : machineOptimizerFeasibilityMSecondBits ∈ FP := by - simpa only [machineOptimizerFeasibilityMSecondBits] using + simpa only [machineOptimizerFeasibilityMSecondBits] using! machineCompose_mem_FP (machinePair_mem_FP machineOptimizerFeasibilityMFirstBits_mem_FP machineOptimizerFeasibilityInnerLengthTimesDBits_mem_FP) @@ -600,14 +600,14 @@ theorem machineOptimizerFeasibilityMSecondBits_mem_FP : theorem machineOptimizerFeasibilityMBits_mem_FP : machineOptimizerFeasibilityMBits ∈ FP := by - simpa only [machineOptimizerFeasibilityMBits] using machineCompose_mem_FP + simpa only [machineOptimizerFeasibilityMBits] using! machineCompose_mem_FP (machinePair_mem_FP machineOptimizerFeasibilityMSecondBits_mem_FP (machineConst_mem_FP [true])) machineBinaryAddBits_mem_FP theorem machineOptimizerFeasibilityThirtyTwoDCubeBits_mem_FP : machineOptimizerFeasibilityThirtyTwoDCubeBits ∈ FP := by - simpa only [machineOptimizerFeasibilityThirtyTwoDCubeBits] using + simpa only [machineOptimizerFeasibilityThirtyTwoDCubeBits] using! machineCompose_mem_FP (machinePair_mem_FP (machineConst_mem_FP (32 : ℕ).bits) machineOptimizerFeasibilityDCubeBits_mem_FP) @@ -615,7 +615,7 @@ theorem machineOptimizerFeasibilityThirtyTwoDCubeBits_mem_FP : theorem machineOptimizerFeasibilityBudgetBits_mem_FP : machineOptimizerFeasibilityBudgetBits ∈ FP := by - simpa only [machineOptimizerFeasibilityBudgetBits] using + simpa only [machineOptimizerFeasibilityBudgetBits] using! machineCompose_mem_FP (machinePair_mem_FP machineOptimizerFeasibilityThirtyTwoDCubeBits_mem_FP @@ -624,13 +624,13 @@ theorem machineOptimizerFeasibilityBudgetBits_mem_FP : theorem machineOptimizerFeasibilityBudgetGuard_mem_FP : machineOptimizerFeasibilityBudgetGuard ∈ FP := by - simpa only [machineOptimizerFeasibilityBudgetGuard] using + simpa only [machineOptimizerFeasibilityBudgetGuard] using! machineCompose_mem_FP machineOptimizerFeasibilityBudgetGuardSource_mem_FP (machineIteratedBinaryWidth_mem_FP 3) theorem machineOptimizerFeasibilityBudgetUnary_mem_FP : machineOptimizerFeasibilityBudgetUnary ∈ FP := by - simpa only [machineOptimizerFeasibilityBudgetUnary] using + simpa only [machineOptimizerFeasibilityBudgetUnary] using! machineCompose_mem_FP (machinePair_mem_FP machineOptimizerFeasibilityBudgetGuard_mem_FP machineOptimizerFeasibilityBudgetBits_mem_FP) @@ -731,7 +731,7 @@ theorem machineOptimizerFeasibilityBudgetUnary_mem_FP : ((rawExplicitOptimizerInnerRadius n (rationalMatrixEntryBitBound A)).value) have hd : machineOptimizerFeasibilityDBits word = d.bits := by - simpa only [machineOptimizerFeasibilityDBits, word, d] using + simpa only [machineOptimizerFeasibilityDBits, word, d] using! machineOptimizerFeasibilityEllipsoidDimensionBits_encode A upper have hd2 : machineOptimizerFeasibilityDSquareBits word = (d ^ 2).bits := by rw [machineOptimizerFeasibilityDSquareBits, hd, @@ -744,14 +744,14 @@ theorem machineOptimizerFeasibilityBudgetUnary_mem_FP : have hLR : machineOptimizerFeasibilityOuterLengthBits word = LR.bits := by have hRuler : machineOptimizerFeasibilityOuterRadiusLengthRuler word = List.replicate LR true := by - simpa only [word, LR] using + simpa only [word, LR] using! machineOptimizerFeasibilityOuterRadiusLengthRuler_encode hn A upper rw [machineOptimizerFeasibilityOuterLengthBits, hRuler, machineLengthBits_encode, List.length_replicate] have hLr : machineOptimizerFeasibilityInnerLengthBits word = Lr.bits := by have hRuler : machineOptimizerFeasibilityInnerRadiusLengthRuler word = List.replicate Lr true := by - simpa only [word, Lr] using + simpa only [word, Lr] using! machineOptimizerFeasibilityInnerRadiusLengthRuler_encode hn A upper rw [machineOptimizerFeasibilityInnerLengthBits, hRuler, machineLengthBits_encode, List.length_replicate] @@ -813,7 +813,7 @@ theorem optimizerFeasibilityBudget_le_guardPolynomial Nat.mul_le_mul hconst hq5 _ = (Q + 16) ^ 8 := by rw [← pow_add] exact hbudget.trans <| hpow.trans <| by - simpa only [Q] using certificateExpGuardWidth_pow_lower 2 Q + simpa only [Q] using! certificateExpGuardWidth_pow_lower 2 Q @[simp] theorem machineOptimizerFeasibilityBudgetUnary_encode {n : ℕ} (hn : 2 ≤ n) (A : Matrix (Fin n) (Fin n) ℚ) @@ -840,7 +840,7 @@ theorem optimizerFeasibilityBudget_le_guardPolynomial rw [machineOptimizerFeasibilityBudgetGuard, machineIteratedBinaryWidth_length, machineOptimizerFeasibilityBudgetGuardSource_length_encode hn] - simpa only [d, LR, Lr, rationalBallDyadicExponent] using + simpa only [d, LR, Lr, rationalBallDyadicExponent] using! optimizerFeasibilityBudget_le_guardPolynomial d LR Lr theorem machineOptimizerFeasibilityBudgetUnary_eq_thresholdBudget diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerInteriorScale.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerInteriorScale.lean index 96ea17cf8d..078f35fa97 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerInteriorScale.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerInteriorScale.lean @@ -156,7 +156,7 @@ theorem machineOptimizerDimensionRawCode_mem_FP : theorem machineOptimizerBitBoundBits_mem_FP : machineOptimizerBitBoundBits ∈ FP := by - simpa only [machineOptimizerBitBoundBits] using + simpa only [machineOptimizerBitBoundBits] using! machineCompose_mem_FP machineMatrixEntryBitBoundRuler_mem_FP machineLengthBits_mem_FP @@ -169,7 +169,7 @@ theorem machineOptimizerBitBoundRawCode_mem_FP : theorem machineOptimizerFourDimensionRawCode_mem_FP : machineOptimizerFourDimensionRawCode ∈ FP := by - simpa only [machineOptimizerFourDimensionRawCode] using machineCompose_mem_FP + simpa only [machineOptimizerFourDimensionRawCode] using! machineCompose_mem_FP (machinePair_mem_FP (machineConst_mem_FP (rawRatBinaryCode rawOptimizerFour)) machineOptimizerDimensionRawCode_mem_FP) @@ -177,7 +177,7 @@ theorem machineOptimizerFourDimensionRawCode_mem_FP : theorem machineOptimizerTauRawCode_mem_FP : machineOptimizerTauRawCode ∈ FP := by - simpa only [machineOptimizerTauRawCode] using machineCompose_mem_FP + simpa only [machineOptimizerTauRawCode] using! machineCompose_mem_FP (machinePair_mem_FP (machineConst_mem_FP (rawRatBinaryCode rawOptimizerXi)) machineOptimizerFourDimensionRawCode_mem_FP) @@ -185,28 +185,28 @@ theorem machineOptimizerTauRawCode_mem_FP : theorem machineOptimizerNSquareRawCode_mem_FP : machineOptimizerNSquareRawCode ∈ FP := by - simpa only [machineOptimizerNSquareRawCode] using machineCompose_mem_FP + simpa only [machineOptimizerNSquareRawCode] using! machineCompose_mem_FP (machinePair_mem_FP machineOptimizerDimensionRawCode_mem_FP machineOptimizerDimensionRawCode_mem_FP) machineRawRatMulCode_mem_FP theorem machineOptimizerNCubeRawCode_mem_FP : machineOptimizerNCubeRawCode ∈ FP := by - simpa only [machineOptimizerNCubeRawCode] using machineCompose_mem_FP + simpa only [machineOptimizerNCubeRawCode] using! machineCompose_mem_FP (machinePair_mem_FP machineOptimizerNSquareRawCode_mem_FP machineOptimizerDimensionRawCode_mem_FP) machineRawRatMulCode_mem_FP theorem machineOptimizerNBProductRawCode_mem_FP : machineOptimizerNBProductRawCode ∈ FP := by - simpa only [machineOptimizerNBProductRawCode] using machineCompose_mem_FP + simpa only [machineOptimizerNBProductRawCode] using! machineCompose_mem_FP (machinePair_mem_FP machineOptimizerDimensionRawCode_mem_FP machineOptimizerBitBoundRawCode_mem_FP) machineRawRatMulCode_mem_FP theorem machineOptimizerTwiceNSquareRawCode_mem_FP : machineOptimizerTwiceNSquareRawCode ∈ FP := by - simpa only [machineOptimizerTwiceNSquareRawCode] using machineCompose_mem_FP + simpa only [machineOptimizerTwiceNSquareRawCode] using! machineCompose_mem_FP (machinePair_mem_FP (machineConst_mem_FP (rawRatBinaryCode rawOptimizerTwo)) machineOptimizerNSquareRawCode_mem_FP) @@ -214,35 +214,35 @@ theorem machineOptimizerTwiceNSquareRawCode_mem_FP : theorem machineOptimizerInteriorSumRawCode_mem_FP : machineOptimizerInteriorSumRawCode ∈ FP := by - simpa only [machineOptimizerInteriorSumRawCode] using machineCompose_mem_FP + simpa only [machineOptimizerInteriorSumRawCode] using! machineCompose_mem_FP (machinePair_mem_FP machineOptimizerNBProductRawCode_mem_FP machineOptimizerTwiceNSquareRawCode_mem_FP) machineRawRatAddCode_mem_FP theorem machineOptimizerNTimesInteriorSumRawCode_mem_FP : machineOptimizerNTimesInteriorSumRawCode ∈ FP := by - simpa only [machineOptimizerNTimesInteriorSumRawCode] using machineCompose_mem_FP + simpa only [machineOptimizerNTimesInteriorSumRawCode] using! machineCompose_mem_FP (machinePair_mem_FP machineOptimizerDimensionRawCode_mem_FP machineOptimizerInteriorSumRawCode_mem_FP) machineRawRatMulCode_mem_FP theorem machineOptimizerInteriorQuotientRawCode_mem_FP : machineOptimizerInteriorQuotientRawCode ∈ FP := by - simpa only [machineOptimizerInteriorQuotientRawCode] using machineCompose_mem_FP + simpa only [machineOptimizerInteriorQuotientRawCode] using! machineCompose_mem_FP (machinePair_mem_FP machineOptimizerNTimesInteriorSumRawCode_mem_FP machineOptimizerTauRawCode_mem_FP) machineRawRatDivCode_mem_FP theorem machineOptimizerInteriorK0RawCode_mem_FP : machineOptimizerInteriorK0RawCode ∈ FP := by - simpa only [machineOptimizerInteriorK0RawCode] using machineCompose_mem_FP + simpa only [machineOptimizerInteriorK0RawCode] using! machineCompose_mem_FP (machinePair_mem_FP machineOptimizerInteriorQuotientRawCode_mem_FP machineOptimizerNCubeRawCode_mem_FP) machineRawRatAddCode_mem_FP theorem machineOptimizerTwiceInteriorK0RawCode_mem_FP : machineOptimizerTwiceInteriorK0RawCode ∈ FP := by - simpa only [machineOptimizerTwiceInteriorK0RawCode] using machineCompose_mem_FP + simpa only [machineOptimizerTwiceInteriorK0RawCode] using! machineCompose_mem_FP (machinePair_mem_FP (machineConst_mem_FP (rawRatBinaryCode rawOptimizerTwo)) machineOptimizerInteriorK0RawCode_mem_FP) @@ -250,7 +250,7 @@ theorem machineOptimizerTwiceInteriorK0RawCode_mem_FP : theorem machineOptimizerInteriorExponentBits_mem_FP : machineOptimizerInteriorExponentBits ∈ FP := by - simpa only [machineOptimizerInteriorExponentBits] using + simpa only [machineOptimizerInteriorExponentBits] using! machineCompose_mem_FP machineOptimizerTwiceInteriorK0RawCode_mem_FP machineRationalCeilNatBits_mem_FP @@ -466,10 +466,6 @@ theorem explicitOptimizerInteriorExponentCoefficient_le : norm_num [explicitOptimizerInteriorExponentCoefficient, rationalCeilNat, explicitXi, explicitDelta, explicitEta, explicitRowRatio] - change 34 * - (14286815467932160000000000000000000000000000000000000000000000000000000 : ℕ) + - 2 ≤ 17 ^ 60 - norm_num theorem numericalInteriorExponent_le_sourcePolynomial {n B S : ℕ} (hn : 1 ≤ n) (hnS : n ≤ S) (hBS : B ≤ 32 * S) : @@ -530,26 +526,26 @@ def machineExplicitOptimizerFloorRawCode (word : List Bool) : List Bool := theorem machineOptimizerInteriorExponentGuard_mem_FP : machineOptimizerInteriorExponentGuard ∈ FP := by - simpa only [machineOptimizerInteriorExponentGuard] using + simpa only [machineOptimizerInteriorExponentGuard] using! machineIteratedBinaryWidth_mem_FP 6 theorem machineOptimizerInteriorExponentUnary_mem_FP : machineOptimizerInteriorExponentUnary ∈ FP := by - simpa only [machineOptimizerInteriorExponentUnary] using machineCompose_mem_FP + simpa only [machineOptimizerInteriorExponentUnary] using! machineCompose_mem_FP (machinePair_mem_FP machineOptimizerInteriorExponentGuard_mem_FP machineOptimizerInteriorExponentBits_mem_FP) machineBoundedUnary_mem_FP theorem machineOptimizerInteriorFloorRawCode_mem_FP : machineOptimizerInteriorFloorRawCode ∈ FP := by - simpa only [machineOptimizerInteriorFloorRawCode] using machineCompose_mem_FP + simpa only [machineOptimizerInteriorFloorRawCode] using! machineCompose_mem_FP (machinePair_mem_FP machineOptimizerInteriorExponentUnary_mem_FP (machineConst_mem_FP (rawRatBinaryCode rawOptimizerHalf))) machineRawRatPowerCode_mem_FP theorem machineExplicitOptimizerFloorRawCode_mem_FP : machineExplicitOptimizerFloorRawCode ∈ FP := by - simpa only [machineExplicitOptimizerFloorRawCode] using machineCompose_mem_FP + simpa only [machineExplicitOptimizerFloorRawCode] using! machineCompose_mem_FP (machinePair_mem_FP machineOptimizerInteriorFloorRawCode_mem_FP (machineConst_mem_FP (rawRatBinaryCode rawOptimizerTwo))) machineRawRatDivCode_mem_FP @@ -563,9 +559,9 @@ theorem optimizerInteriorExponent_le_guard {n : ℕ} (hn : 1 ≤ n) let word := rationalMatrixBinaryEncoding.encode ⟨n, A⟩ let S := word.length have hnS : n ≤ S := by - simpa only [S, word] using matrix_dimension_le_code_length A + simpa only [S, word] using! matrix_dimension_le_code_length A have hBS : rationalMatrixEntryBitBound A ≤ 32 * S := by - simpa only [S, word] using rationalMatrixEntryBitBound_le_machineCode hn A + simpa only [S, word] using! rationalMatrixEntryBitBound_le_machineCode hn A have hpoly := numericalInteriorExponent_le_sourcePolynomial hn hnS hBS have hcoeff : explicitOptimizerInteriorExponentCoefficient * S ^ 4 ≤ @@ -586,7 +582,7 @@ theorem optimizerInteriorExponent_le_guard {n : ℕ} (hn : 1 ≤ n) explicitOptimizerInteriorExponentCoefficient * S ^ 4 := hpoly _ ≤ (S + 16) ^ 64 := hcoeff _ ≤ certificateExpGuardWidth 6 S := by - simpa using certificateExpGuardWidth_pow_lower 5 S + simpa using! certificateExpGuardWidth_pow_lower 5 S _ = (machineOptimizerInteriorExponentGuard word).length := by simp [machineOptimizerInteriorExponentGuard, S] diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerMatrixBitBound.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerMatrixBitBound.lean index 9c0b3254de..6ec75fa9cf 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerMatrixBitBound.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerMatrixBitBound.lean @@ -103,26 +103,26 @@ theorem machineMatrixEntryLengthRows_mem_FP : theorem machineMatrixEntryLengthCurrent_mem_FP : machineMatrixEntryLengthCurrent ∈ Complexity.FP := by - simpa only [machineMatrixEntryLengthCurrent] using + simpa only [machineMatrixEntryLengthCurrent] using! machineCompose_mem_FP machinePairSecond_mem_FP machinePairFirst_mem_FP theorem machineMatrixEntryLengthAcc_mem_FP : machineMatrixEntryLengthAcc ∈ Complexity.FP := by - simpa only [machineMatrixEntryLengthAcc] using + simpa only [machineMatrixEntryLengthAcc] using! machineCompose_mem_FP (machineCompose_mem_FP machinePairSecond_mem_FP machinePairSecond_mem_FP) machinePairFirst_mem_FP theorem machineMatrixEntryLengthBound_mem_FP : machineMatrixEntryLengthBound ∈ Complexity.FP := by - simpa only [machineMatrixEntryLengthBound] using + simpa only [machineMatrixEntryLengthBound] using! machineCompose_mem_FP (machineCompose_mem_FP machinePairSecond_mem_FP machinePairSecond_mem_FP) machinePairSecond_mem_FP theorem machineMatrixEntryLengthEntry_mem_FP : machineMatrixEntryLengthEntry ∈ Complexity.FP := by - simpa only [machineMatrixEntryLengthEntry] using + simpa only [machineMatrixEntryLengthEntry] using! machineCompose_mem_FP machineMatrixEntryLengthCurrent_mem_FP machineListHead_mem_FP @@ -134,7 +134,7 @@ theorem machineMatrixEntryLengthCandidate_mem_FP : theorem machineMatrixEntryLengthNextAcc_mem_FP : machineMatrixEntryLengthNextAcc ∈ Complexity.FP := by - simpa only [machineMatrixEntryLengthNextAcc] using + simpa only [machineMatrixEntryLengthNextAcc] using! machineTake_mem_FP machineMatrixEntryLengthBound_mem_FP machineMatrixEntryLengthCandidate_mem_FP @@ -177,7 +177,7 @@ theorem machineMatrixEntryLengthInputBound_mem_FP : have h16 := machineAppend_mem_FP h8 h8 have h32 := machineAppend_mem_FP h16 h16 have h64 := machineAppend_mem_FP h32 h32 - simpa only [machineMatrixEntryLengthInputBound] using + simpa only [machineMatrixEntryLengthInputBound] using! machineAppend_mem_FP (machineConst_mem_FP (List.replicate 8 false)) h64 @@ -242,7 +242,7 @@ theorem machineMatrixEntryLengthInit_bound (word : List Bool) : machineMatrixEntryLengthCurrent_pack, machineMatrixEntryLengthAcc_pack, machineMatrixEntryLengthBound_pack] refine ⟨trivial, ?_, by simp, ?_, trivial⟩ - · simpa only [machineMatrixRowsWord] using machinePairSecond_length_le word + · simpa only [machineMatrixRowsWord] using! machinePairSecond_length_le word · simp only [machineMatrixEntryLengthInputBound_length, List.length_singleton] omega @@ -324,7 +324,7 @@ theorem machineMatrixEntryLengthFinalState_mem_FP : theorem machineMatrixEntryBitBoundRuler_mem_FP : machineMatrixEntryBitBoundRuler ∈ Complexity.FP := by - simpa only [machineMatrixEntryBitBoundRuler] using + simpa only [machineMatrixEntryBitBoundRuler] using! machineCompose_mem_FP machineMatrixEntryLengthFinalState_mem_FP machineMatrixEntryLengthAcc_mem_FP @@ -368,15 +368,15 @@ theorem matrixEntryLengthSemStep_invariant {L : ℕ} cases current with | cons q qs => simpa [MatrixEntryLengthSemInvariant, matrixEntryLengthSemStep, - matrixEntryLengthListCost, Nat.add_assoc] using hs + matrixEntryLengthListCost, Nat.add_assoc] using! hs | nil => cases rows with | nil => simpa [MatrixEntryLengthSemInvariant, - matrixEntryLengthSemStep] using hs + matrixEntryLengthSemStep] using! hs | cons row rows => simpa [MatrixEntryLengthSemInvariant, matrixEntryLengthSemStep, matrixEntryLengthListCost, matrixEntryLengthRowsCost, - Nat.add_assoc] using hs + Nat.add_assoc] using! hs theorem machineMatrixEntryLengthStep_semantics (bound : List Bool) (s : MatrixEntryLengthSemState) @@ -429,7 +429,7 @@ theorem machineMatrixEntryLengthStep_semantics List.replicate (encodedBitLength ℚ q) true = List.replicate (acc + encodedBitLength ℚ q) true by exact (List.replicate_add _ _ _).symm, - (List.take_eq_self_iff _).mpr (by simpa using hfit)] + (List.take_eq_self_iff _).mpr (by simpa using! hfit)] rfl theorem machineMatrixEntryLengthIterate_semantics @@ -520,10 +520,10 @@ theorem machineMatrixEntryLengthFinalState_encode {n : ℕ} word.length := by calc _ = (machineMatrixRowsWord word).length := by - simpa only [word, rows] using congrArg List.length + simpa only [word, rows] using! congrArg List.length (machineMatrixRowsWord_encode A).symm _ ≤ word.length := by - simpa only [machineMatrixRowsWord] using + simpa only [machineMatrixRowsWord] using! machinePairSecond_length_le word have hcost : rationalMatrixEntryBitBound A ≤ bound.length := by by_cases hn : n = 0 @@ -535,13 +535,13 @@ theorem machineMatrixEntryLengthFinalState_encode {n : ℕ} · have hmachine := rationalMatrixEntryBitBound_le_machineCode (Nat.pos_of_ne_zero hn) A have hmachine' : rationalMatrixEntryBitBound A ≤ 32 * word.length := by - simpa only [word] using hmachine + simpa only [word] using! hmachine simp only [bound, machineMatrixEntryLengthInputBound_length] omega have hinv : MatrixEntryLengthSemInvariant bound.length s := by simpa only [MatrixEntryLengthSemInvariant, s, matrixEntryLengthListCost, List.map_nil, List.sum_nil, Nat.add_zero, - rows, matrixEntryLengthRowsCost_eq_matrixBound] using hcost + rows, matrixEntryLengthRowsCost_eq_matrixBound] using! hcost have hwork : matrixNonnegativeRowsWork rows ≤ word.length := (binaryListCode_length_ge_work rows).trans hrowsLength have hsplit : word.length = diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerRoundingSchedule.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerRoundingSchedule.lean index 97fc10a27c..dd10a7844f 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerRoundingSchedule.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerRoundingSchedule.lean @@ -155,7 +155,7 @@ theorem machineOptimizerFeasibilityInitialMagnitudeRawCode_mem_FP : machineOptimizerFeasibilityEllipsoidDimensionRawCode_mem_FP machineOptimizerFeasibilityOuterRadiusRawCode_mem_FP) machineRawRatMulCode_mem_FP - simpa only [machineOptimizerFeasibilityInitialMagnitudeRawCode] using + simpa only [machineOptimizerFeasibilityInitialMagnitudeRawCode] using! machineCompose_mem_FP (machinePair_mem_FP (machineConst_mem_FP (rawRatBinaryCode rawOptimizerTwo)) hproduct) @@ -163,21 +163,21 @@ theorem machineOptimizerFeasibilityInitialMagnitudeRawCode_mem_FP : theorem machineOptimizerFeasibilityInitialMagnitudeEntryCode_mem_FP : machineOptimizerFeasibilityInitialMagnitudeEntryCode ∈ FP := by - simpa only [machineOptimizerFeasibilityInitialMagnitudeEntryCode] using + simpa only [machineOptimizerFeasibilityInitialMagnitudeEntryCode] using! machineCompose_mem_FP machineOptimizerFeasibilityInitialMagnitudeRawCode_mem_FP machineNormalizeRawRatEntryCode_mem_FP theorem machineOptimizerFeasibilityInitialMagnitudeLengthRuler_mem_FP : machineOptimizerFeasibilityInitialMagnitudeLengthRuler ∈ FP := by - simpa only [machineOptimizerFeasibilityInitialMagnitudeLengthRuler] using + simpa only [machineOptimizerFeasibilityInitialMagnitudeLengthRuler] using! machineCompose_mem_FP machineOptimizerFeasibilityInitialMagnitudeEntryCode_mem_FP machineOptimizerEntryLengthRuler_mem_FP theorem machineOptimizerFeasibilityKBits_mem_FP : machineOptimizerFeasibilityKBits ∈ FP := by - simpa only [machineOptimizerFeasibilityKBits] using + simpa only [machineOptimizerFeasibilityKBits] using! machineCompose_mem_FP machineOptimizerFeasibilityInitialMagnitudeLengthRuler_mem_FP machineLengthBits_mem_FP @@ -271,7 +271,7 @@ theorem machineOptimizerFeasibilityRoundingPrecisionBits_mem_FP : theorem machineOptimizerFeasibilityRoundingGuardSource_mem_FP : machineOptimizerFeasibilityRoundingGuardSource ∈ FP := by - simpa only [machineOptimizerFeasibilityRoundingGuardSource] using + simpa only [machineOptimizerFeasibilityRoundingGuardSource] using! machineAppend_mem_FP machineOptimizerFeasibilityBudgetUnary_mem_FP (machineAppend_mem_FP machineOptimizerFeasibilityEllipsoidDimensionUnary_mem_FP @@ -281,14 +281,14 @@ theorem machineOptimizerFeasibilityRoundingGuardSource_mem_FP : theorem machineOptimizerFeasibilityRoundingGuard_mem_FP : machineOptimizerFeasibilityRoundingGuard ∈ FP := by - simpa only [machineOptimizerFeasibilityRoundingGuard] using + simpa only [machineOptimizerFeasibilityRoundingGuard] using! machineCompose_mem_FP machineOptimizerFeasibilityRoundingGuardSource_mem_FP (machineIteratedBinaryWidth_mem_FP 2) theorem machineOptimizerFeasibilityRoundingPrecisionUnary_mem_FP : machineOptimizerFeasibilityRoundingPrecisionUnary ∈ FP := by - simpa only [machineOptimizerFeasibilityRoundingPrecisionUnary] using + simpa only [machineOptimizerFeasibilityRoundingPrecisionUnary] using! machineCompose_mem_FP (machinePair_mem_FP machineOptimizerFeasibilityRoundingGuard_mem_FP machineOptimizerFeasibilityRoundingPrecisionBits_mem_FP) @@ -374,12 +374,12 @@ theorem optimizerFeasibilityRoundingPrecision_eq_explicit (rawExplicitOptimizerInnerRadius n (rationalMatrixEntryBitBound A)).value have hd : machineOptimizerFeasibilityDBits word = d.bits := by - simpa only [machineOptimizerFeasibilityDBits, word, d] using + simpa only [machineOptimizerFeasibilityDBits, word, d] using! machineOptimizerFeasibilityEllipsoidDimensionBits_encode A upper have hLR : machineOptimizerFeasibilityOuterLengthBits word = LR.bits := by have hRuler : machineOptimizerFeasibilityOuterRadiusLengthRuler word = List.replicate LR true := by - simpa only [word, LR, R] using + simpa only [word, LR, R] using! machineOptimizerFeasibilityOuterRadiusLengthRuler_encode hn A upper rw [machineOptimizerFeasibilityOuterLengthBits, hRuler, machineLengthBits_encode, List.length_replicate] @@ -387,12 +387,12 @@ theorem optimizerFeasibilityRoundingPrecision_eq_explicit have hRuler : machineOptimizerFeasibilityInitialMagnitudeLengthRuler word = List.replicate K true := by - simpa only [word, K, d, R] using + simpa only [word, K, d, R] using! machineOptimizerFeasibilityInitialMagnitudeLengthRuler_encode hn A upper rw [machineOptimizerFeasibilityKBits, hRuler, machineLengthBits_encode, List.length_replicate] have hT : machineOptimizerFeasibilityBudgetBits word = T.bits := by - simpa only [word, T, d, R] using + simpa only [word, T, d, R] using! machineOptimizerFeasibilityBudgetBits_encode hn A upper have hL : machineOptimizerFeasibilityLBits word = (LR * d).bits := machineBinaryMulOf_natBits _ _ _ _ _ hLR hd @@ -477,14 +477,14 @@ theorem optimizerFeasibilityRoundingPrecision_le_guardPolynomial have hK : K ≤ Q := by omega have hT : T ≤ Q := by omega have hLRd : LR * d ≤ Q ^ 2 := by - simpa only [pow_two] using Nat.mul_le_mul hLR hd + simpa only [pow_two] using! Nat.mul_le_mul hLR hd have hd2 : d ^ 2 ≤ Q ^ 2 := Nat.pow_le_pow_left hd 2 have hdK : d * K ≤ Q ^ 2 := by - simpa only [pow_two] using Nat.mul_le_mul hd hK + simpa only [pow_two] using! Nat.mul_le_mul hd hK have hdT : d * T ≤ Q ^ 2 := by - simpa only [pow_two] using Nat.mul_le_mul hd hT + simpa only [pow_two] using! Nat.mul_le_mul hd hT have hd2T : d ^ 2 * T ≤ Q ^ 3 := by - simpa only [pow_two, pow_succ, pow_zero, one_mul] using + simpa only [pow_two, pow_succ, pow_zero, one_mul] using! Nat.mul_le_mul (Nat.mul_le_mul hd hd) hT have hcoarse : optimizerFeasibilityRoundingPrecision d LR K T ≤ 3 * Q ^ 3 + 10 * Q ^ 2 + 13 * Q + 15 := by @@ -503,7 +503,7 @@ theorem optimizerFeasibilityRoundingPrecision_le_guardPolynomial _ ≤ (Q + 16) * (Q + 16) ^ 3 := Nat.mul_le_mul h8 hshift _ = (Q + 16) ^ 4 := by ring _ ≤ certificateExpGuardWidth 2 Q := by - simpa using certificateExpGuardWidth_pow_lower 1 Q + simpa using! certificateExpGuardWidth_pow_lower 1 Q @[simp] theorem machineOptimizerFeasibilityRoundingGuardSource_length_encode {n : ℕ} (hn : 2 ≤ n) (A : Matrix (Fin n) (Fin n) ℚ) @@ -567,7 +567,7 @@ theorem optimizerFeasibilityRoundingPrecision_le_guardPolynomial machineIteratedBinaryWidth_length, machineOptimizerFeasibilityRoundingGuardSource_length_encode hn] rw [← optimizerFeasibilityRoundingPrecision_eq_explicit d T R] - simpa only [d, R, LR, K, T] using + simpa only [d, R, LR, K, T] using! optimizerFeasibilityRoundingPrecision_le_guardPolynomial d LR K T end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerStateBound.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerStateBound.lean index 4873f91da1..936bbfcd78 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerStateBound.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerStateBound.lean @@ -226,14 +226,14 @@ theorem machineOptimizerFeasibilityStateGuardSource_mem_FP : theorem machineOptimizerFeasibilityStateGuard_mem_FP : machineOptimizerFeasibilityStateGuard ∈ FP := by - simpa only [machineOptimizerFeasibilityStateGuard] using + simpa only [machineOptimizerFeasibilityStateGuard] using! machineCompose_mem_FP machineOptimizerFeasibilityStateGuardSource_mem_FP (machineIteratedBinaryWidth_mem_FP 3) theorem machineOptimizerFeasibilityStateBoundUnary_mem_FP : machineOptimizerFeasibilityStateBoundUnary ∈ FP := by - simpa only [machineOptimizerFeasibilityStateBoundUnary] using + simpa only [machineOptimizerFeasibilityStateBoundUnary] using! machineCompose_mem_FP (machinePair_mem_FP machineOptimizerFeasibilityStateGuard_mem_FP machineOptimizerFeasibilityStateBoundBits_mem_FP) @@ -278,22 +278,22 @@ theorem machineOptimizerFeasibilityStateBoundBits_encode push_cast rw [pow_two] have hd : machineOptimizerFeasibilityDBits word = d.bits := by - simpa only [machineOptimizerFeasibilityDBits, word, d] using + simpa only [machineOptimizerFeasibilityDBits, word, d] using! machineOptimizerFeasibilityEllipsoidDimensionBits_encode A upper have hT : machineOptimizerFeasibilityBudgetBits word = T.bits := by have h := machineOptimizerFeasibilityBudgetBits_encode hn A upper rw [hRthreshold] at h - simpa only [word, T, betheThresholdFeasibilityBudget, pow_two] using h + simpa only [word, T, betheThresholdFeasibilityBudget, pow_two] using! h have hK : machineOptimizerFeasibilityKBits word = K.bits := by have hruler : machineOptimizerFeasibilityInitialMagnitudeLengthRuler word = List.replicate K true := by - simpa only [word, K, d, R] using + simpa only [word, K, d, R] using! machineOptimizerFeasibilityInitialMagnitudeLengthRuler_encode hn A upper rw [machineOptimizerFeasibilityKBits, hruler, machineLengthBits_encode, List.length_replicate] have hp : machineOptimizerFeasibilityRoundingPrecisionBits word = p.bits := by - simpa only [word, p, d, T, R] using + simpa only [word, p, d, T, R] using! machineOptimizerFeasibilityRoundingPrecisionBits_encode hn A upper have h3d : machineOptimizerFeasibilityThreeDBits word = (3 * d).bits := machineBinaryMulOf_natBits _ _ _ _ _ rfl hd @@ -304,7 +304,7 @@ theorem machineOptimizerFeasibilityStateBoundBits_encode (T * (6 + 3 * d)).bits := machineBinaryMulOf_natBits _ _ _ _ _ hT hgrowth have hKS : machineOptimizerFeasibilityKPlusGrowthBits word = KS.bits := by - simpa only [KS] using + simpa only [KS] using! machineBinaryAddOf_natBits _ _ _ _ _ hK hTgrowth have h4d : machineBinaryMulOf (machineBinaryConst 4) machineOptimizerFeasibilityDBits word = (4 * d).bits := @@ -315,7 +315,7 @@ theorem machineOptimizerFeasibilityStateBoundBits_encode machineBinaryAddOf_natBits _ _ _ _ _ rfl h4d have hP : machineOptimizerFeasibilityStateDenominatorBits word = P.bits := by simpa only [machineOptimizerFeasibilityStateDenominatorBits, P, - Nat.add_assoc] using + Nat.add_assoc] using! machineBinaryAddOf_natBits _ _ _ _ _ hp h10plus4d have h2KS : machineOptimizerFeasibilityStateTwiceMagnitudeBits word = (2 * KS).bits := @@ -327,7 +327,7 @@ theorem machineOptimizerFeasibilityStateBoundBits_encode (8 + 2 * KS).bits := machineBinaryAddOf_natBits _ _ _ _ _ rfl h2KS have he : machineOptimizerFeasibilityStateEntryBits word = e.bits := by - simpa only [e, rationalEntryMachineCodeBound] using + simpa only [e, rationalEntryMachineCodeBound] using! machineBinaryAddOf_natBits _ _ _ _ _ h8plus2KS h4P have h2e : machineBinaryMulOf (machineBinaryConst 2) machineOptimizerFeasibilityStateEntryBits word = (2 * e).bits := @@ -336,7 +336,7 @@ theorem machineOptimizerFeasibilityStateBoundBits_encode (2 * e + 2).bits := machineBinaryAddOf_natBits _ _ _ _ _ h2e rfl have hv : machineOptimizerFeasibilityStateVectorBits word = v.bits := by - simpa only [v, rationalVectorMachineCodeBound] using + simpa only [v, rationalVectorMachineCodeBound] using! machineBinaryMulOf_natBits _ _ _ _ _ hd h2e2 have h2v : machineBinaryMulOf (machineBinaryConst 2) machineOptimizerFeasibilityStateVectorBits word = (2 * v).bits := @@ -345,7 +345,7 @@ theorem machineOptimizerFeasibilityStateBoundBits_encode (2 * v + 2).bits := machineBinaryAddOf_natBits _ _ _ _ _ h2v rfl have hM : machineOptimizerFeasibilityStateMatrixBits word = M.bits := by - simpa only [M, rationalMatrixMachineCodeBound] using + simpa only [M, rationalMatrixMachineCodeBound] using! machineBinaryMulOf_natBits _ _ _ _ _ hd h2v2 have hd1 : machineBinaryAddOf machineOptimizerFeasibilityDBits (machineBinaryConst 1) word = (d + 1).bits := @@ -404,7 +404,7 @@ theorem optimizerFeasibilityStateBound_le_guardPolynomial nlinarith [Nat.pow_le_pow_left (by omega : 4 ≤ Q + 16) 4, Nat.pow_le_pow_left (by omega : Q + 1 ≤ Q + 16) 4] exact hcoarse.trans <| hmain.trans <| by - simpa only [Q] using certificateExpGuardWidth_pow_lower 2 Q + simpa only [Q] using! certificateExpGuardWidth_pow_lower 2 Q @[simp] theorem machineOptimizerFeasibilityStateGuardSource_length_encode {n : ℕ} (hn : 2 ≤ n) (A : Matrix (Fin n) (Fin n) ℚ) @@ -484,7 +484,7 @@ theorem optimizerFeasibilityStateBound_le_guardPolynomial machineIteratedBinaryWidth_length, machineOptimizerFeasibilityStateGuardSource_length_encode hn] simpa only [d, K, T, p, explicitBallFeasibilityStateCodeBound, - scheduledFeasibilityStateCodeBound, explicitBallInitialDetExponent] using + scheduledFeasibilityStateCodeBound, explicitBallInitialDetExponent] using! optimizerFeasibilityStateBound_le_guardPolynomial d K T p end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineOutputEncoding.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineOutputEncoding.lean index dc4d19483a..8444b9abfe 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineOutputEncoding.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineOutputEncoding.lean @@ -50,7 +50,7 @@ theorem machineNatPairLeftSquare_mem_FP : have hpair : (fun word => pair (machinePairFirst word) (machinePairFirst word)) ∈ Complexity.FP := machinePair_mem_FP machinePairFirst_mem_FP machinePairFirst_mem_FP - simpa only [machineNatPairLeftSquare] using + simpa only [machineNatPairLeftSquare] using! machineCompose_mem_FP hpair machineBinaryMulBits_mem_FP theorem machineNatPairRightSquare_mem_FP : @@ -58,7 +58,7 @@ theorem machineNatPairRightSquare_mem_FP : have hpair : (fun word => pair (machinePairSecond word) (machinePairSecond word)) ∈ Complexity.FP := machinePair_mem_FP machinePairSecond_mem_FP machinePairSecond_mem_FP - simpa only [machineNatPairRightSquare] using + simpa only [machineNatPairRightSquare] using! machineCompose_mem_FP hpair machineBinaryMulBits_mem_FP theorem machineNatPairLeftBranch_mem_FP : @@ -67,7 +67,7 @@ theorem machineNatPairLeftBranch_mem_FP : (machinePairFirst word)) ∈ Complexity.FP := machinePair_mem_FP machineNatPairRightSquare_mem_FP machinePairFirst_mem_FP - simpa only [machineNatPairLeftBranch] using + simpa only [machineNatPairLeftBranch] using! machineCompose_mem_FP hpair machineBinaryAddBits_mem_FP theorem machineNatPairRightBranchFirst_mem_FP : @@ -76,7 +76,7 @@ theorem machineNatPairRightBranchFirst_mem_FP : (machinePairFirst word)) ∈ Complexity.FP := machinePair_mem_FP machineNatPairLeftSquare_mem_FP machinePairFirst_mem_FP - simpa only [machineNatPairRightBranchFirst] using + simpa only [machineNatPairRightBranchFirst] using! machineCompose_mem_FP hpair machineBinaryAddBits_mem_FP theorem machineNatPairRightBranch_mem_FP : @@ -85,12 +85,12 @@ theorem machineNatPairRightBranch_mem_FP : (machinePairSecond word)) ∈ Complexity.FP := machinePair_mem_FP machineNatPairRightBranchFirst_mem_FP machinePairSecond_mem_FP - simpa only [machineNatPairRightBranch] using + simpa only [machineNatPairRightBranch] using! machineCompose_mem_FP hpair machineBinaryAddBits_mem_FP theorem machineNatPairBits_mem_FP : machineNatPairBits ∈ Complexity.FP := by - simpa only [machineNatPairBits] using + simpa only [machineNatPairBits] using! machineIfHead_mem_FP machineBinaryNatLtBit_mem_FP machineNatPairLeftBranch_mem_FP machineNatPairRightBranch_mem_FP @@ -129,7 +129,7 @@ def machineIntegerNatCodeBits (word : List Bool) : List Bool := theorem machineIntegerMagnitudeWord_mem_FP : machineIntegerMagnitudeWord ∈ Complexity.FP := by - simpa only [machineIntegerMagnitudeWord] using machineTail_mem_FP + simpa only [machineIntegerMagnitudeWord] using! machineTail_mem_FP theorem machineIntegerEvenCodeBits_mem_FP : machineIntegerEvenCodeBits ∈ Complexity.FP := by @@ -137,7 +137,7 @@ theorem machineIntegerEvenCodeBits_mem_FP : (machineIntegerMagnitudeWord word)) ∈ Complexity.FP := machinePair_mem_FP machineIntegerMagnitudeWord_mem_FP machineIntegerMagnitudeWord_mem_FP - simpa only [machineIntegerEvenCodeBits] using + simpa only [machineIntegerEvenCodeBits] using! machineCompose_mem_FP hpair machineBinaryAddBits_mem_FP theorem machineIntegerOddCodeBits_mem_FP : @@ -146,12 +146,12 @@ theorem machineIntegerOddCodeBits_mem_FP : Complexity.FP := machinePair_mem_FP machineIntegerEvenCodeBits_mem_FP (machineConst_mem_FP [true]) - simpa only [machineIntegerOddCodeBits] using + simpa only [machineIntegerOddCodeBits] using! machineCompose_mem_FP hpair machineBinaryAddBits_mem_FP theorem machineIntegerNatCodeBits_mem_FP : machineIntegerNatCodeBits ∈ Complexity.FP := by - simpa only [machineIntegerNatCodeBits] using + simpa only [machineIntegerNatCodeBits] using! machineIfHead_mem_FP id_mem_FP machineIntegerOddCodeBits_mem_FP machineIntegerEvenCodeBits_mem_FP @@ -192,7 +192,7 @@ theorem machineRationalBinaryCode_mem_FP : (machineRationalEntryNumeratorWord word)) (machineRationalEntryDenominatorWord word)) ∈ Complexity.FP := machinePair_mem_FP hnum machineRationalEntryDenominatorWord_mem_FP - simpa only [machineRationalBinaryCode] using + simpa only [machineRationalBinaryCode] using! machineCompose_mem_FP hpair machineNatPairBits_mem_FP theorem machineRationalBinaryCode_encode (q : ℚ) : diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachinePerfectMatching.lean b/LeanPool/BeyondBethe/BeyondBethe/MachinePerfectMatching.lean index f62d4a5459..ff2f9f4e61 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachinePerfectMatching.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachinePerfectMatching.lean @@ -35,7 +35,7 @@ theorem machineKuhnFinalMate_mem_FP : machineKuhnFinalMate ∈ Complexity.FP := by have hcontrol := machineCompose_mem_FP machineKuhnFinalState_mem_FP machineKuhnControl_mem_FP - simpa only [machineKuhnFinalMate] using + simpa only [machineKuhnFinalMate] using! machineCompose_mem_FP hcontrol machineKuhnDoneMate_mem_FP theorem machineKuhnPerfectMatchingInput_mem_FP : @@ -45,7 +45,7 @@ theorem machineKuhnPerfectMatchingInput_mem_FP : theorem machineKuhnPerfectMatchingBit_mem_FP : machineKuhnPerfectMatchingBit ∈ Complexity.FP := by - simpa only [machineKuhnPerfectMatchingBit] using + simpa only [machineKuhnPerfectMatchingBit] using! machineCompose_mem_FP machineKuhnPerfectMatchingInput_mem_FP machineMateAllSomeBit_mem_FP @@ -68,7 +68,7 @@ theorem hasPerfectMatching_of_all_columns_matched {n : ℕ} have rowOfColumn_injective : Function.Injective rowOfColumn := by intro col col' hrows apply hsupport.injective (rowOfColumn_spec col) - simpa only [hrows] using rowOfColumn_spec col' + simpa only [hrows] using! rowOfColumn_spec col' have rowOfColumn_bijective : Function.Bijective rowOfColumn := (Fintype.bijective_iff_injective_and_card rowOfColumn).2 ⟨rowOfColumn_injective, rfl⟩ @@ -99,7 +99,7 @@ theorem all_columns_matched_of_all_rows_matched {n : ℕ} intro col obtain ⟨row, hrow⟩ := colOfRow_surjective col refine ⟨row, ?_⟩ - simpa only [hrow] using colOfRow_spec row + simpa only [hrow] using! colOfRow_spec row theorem columnMateList_all_isSome_eq_true_iff {n : ℕ} (mate : ColumnMate n) : @@ -118,7 +118,7 @@ theorem columnMateList_all_isSome_eq_true_iff {n : ℕ} apply List.all_eq_true.mpr intro value hvalue obtain ⟨i, hi, rfl⟩ := List.mem_iff_getElem.mp hvalue - have hin : i < n := by simpa using hi + have hin : i < n := by simpa using! hi obtain ⟨row, hrow⟩ := hall ⟨i, hin⟩ rw [columnMateList_getElem, hrow] rfl @@ -158,7 +158,7 @@ theorem kuhnColumnMate_all_isSome_eq_true_iff {n : ℕ} [(columnMateList (kuhnColumnMate A)).all Option.isSome] := by rw [machineKuhnPerfectMatchingBit, machineKuhnPerfectMatchingInput_encode] - simpa only [columnMateList_length] using + simpa only [columnMateList_length] using! machineMateAllSomeBit_encode (columnMateList (kuhnColumnMate A)) theorem machineKuhnPerfectMatchingBit_eq_true_iff {n : ℕ} diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachinePositiveAlgorithm.lean b/LeanPool/BeyondBethe/BeyondBethe/MachinePositiveAlgorithm.lean index caf375e219..6ebf1e72a6 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachinePositiveAlgorithm.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachinePositiveAlgorithm.lean @@ -86,7 +86,7 @@ theorem machinePositiveCertificateRawCode_mem_FP {certificateMachine : List Bool → List Bool} (hcertificate : certificateMachine ∈ Complexity.FP) : machinePositiveCertificateRawCode certificateMachine ∈ Complexity.FP := by - simpa only [machinePositiveCertificateRawCode] using + simpa only [machinePositiveCertificateRawCode] using! machineCompose_mem_FP machinePositiveNormalizedMatrixCode_mem_FP hcertificate @@ -97,14 +97,14 @@ theorem machinePositiveLargeProductRawCode_mem_FP have hpair := machinePair_mem_FP machineMatrixNormalizationScalePowerRawCode_mem_FP (machinePositiveCertificateRawCode_mem_FP hcertificate) - simpa only [machinePositiveLargeProductRawCode] using + simpa only [machinePositiveLargeProductRawCode] using! machineCompose_mem_FP hpair machineRawRatMulCode_mem_FP theorem machinePositiveLargeRawCode_mem_FP {certificateMachine : List Bool → List Bool} (hcertificate : certificateMachine ∈ Complexity.FP) : machinePositiveLargeRawCode certificateMachine ∈ Complexity.FP := by - simpa only [machinePositiveLargeRawCode] using + simpa only [machinePositiveLargeRawCode] using! machineCompose_mem_FP (machinePositiveLargeProductRawCode_mem_FP hcertificate) machineNormalizeRawRatEntryCode_mem_FP diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRAMBridge.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRAMBridge.lean index 799ca447ac..71b69fb0d9 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineRAMBridge.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRAMBridge.lean @@ -102,13 +102,13 @@ theorem programDecision_computesLanguageFlagInTime rw [← hrunEq] exact hyes hmember rw [houtput, hverdict] - simpa [languageFlag, hmember] using registerVerdictOutput_hasOutput 1 + simpa [languageFlag, hmember] using! registerVerdictOutput_hasOutput 1 · have hverdict : (RAM.run program firstFuel (RAM.initCfg input)).verdict = 0 := by rw [← hrunEq] exact hno hmember rw [houtput, hverdict] - simpa [languageFlag, hmember] using registerVerdictOutput_hasOutput 0 + simpa [languageFlag, hmember] using! registerVerdictOutput_hasOutput 0 /-- If the RAM time bound is a polynomial evaluation, its one-bit answer is a genuine deterministic Turing-machine `FP` function. -/ @@ -120,7 +120,7 @@ theorem languageFlag_mem_FP_of_ramProgram apply mem_FP_iff_computesInTime_polynomial.mpr refine ⟨20, programDecisionTM standardControlInstructionTapes program, programDecisionPolynomial program p, ?_⟩ - simpa only [programDecisionPolynomial_eval] using + simpa only [programDecisionPolynomial_eval] using! programDecision_computesLanguageFlagInTime program hdecides /-- Reserve a fixed prefix of zero input registers for a RAM program's direct @@ -130,7 +130,7 @@ def prefixZeroRegisters (count : ℕ) (word : List Bool) : List Bool := theorem prefixZeroRegisters_mem_FP (count : ℕ) : prefixZeroRegisters count ∈ Complexity.FP := by - simpa only [prefixZeroRegisters] using + simpa only [prefixZeroRegisters] using! machineAppend_mem_FP (machineConst_mem_FP (List.replicate count false)) id_mem_FP diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRAMSmoke.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRAMSmoke.lean index 38445aabf3..cb735c9710 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineRAMSmoke.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRAMSmoke.lean @@ -45,7 +45,7 @@ theorem emptyMachineTarget_mem_FP_from_paddedRAM (count : ℕ) : (outputBitLanguage emptyMachineTarget)) (2 : Polynomial ℕ).eval := by rw [paddedOutputBitLanguage_emptyMachineTarget] - simpa using RAM.rejectProg_decides + simpa using! RAM.rejectProg_decides apply canonicalTarget_mem_FP_of_paddedRamBitProgram count emptyMachineTarget ruler RAM.rejectProg (2 : Polynomial ℕ) hdecides · exact machineConst_mem_FP [] diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalArithmetic.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalArithmetic.lean index 2cb67d035b..923c282cb4 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalArithmetic.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalArithmetic.lean @@ -80,22 +80,22 @@ def machineRationalMulCode (word : List Bool) : List Bool := theorem machineRawLeftNumeratorCode_mem_FP : machineRawLeftNumeratorCode ∈ Complexity.FP := by - simpa only [machineRawLeftNumeratorCode] using + simpa only [machineRawLeftNumeratorCode] using! machineCompose_mem_FP machinePairFirst_mem_FP machinePairFirst_mem_FP theorem machineRawLeftDenominatorBits_mem_FP : machineRawLeftDenominatorBits ∈ Complexity.FP := by - simpa only [machineRawLeftDenominatorBits] using + simpa only [machineRawLeftDenominatorBits] using! machineCompose_mem_FP machinePairFirst_mem_FP machinePairSecond_mem_FP theorem machineRawRightNumeratorCode_mem_FP : machineRawRightNumeratorCode ∈ Complexity.FP := by - simpa only [machineRawRightNumeratorCode] using + simpa only [machineRawRightNumeratorCode] using! machineCompose_mem_FP machinePairSecond_mem_FP machinePairFirst_mem_FP theorem machineRawRightDenominatorBits_mem_FP : machineRawRightDenominatorBits ∈ Complexity.FP := by - simpa only [machineRawRightDenominatorBits] using + simpa only [machineRawRightDenominatorBits] using! machineCompose_mem_FP machinePairSecond_mem_FP machinePairSecond_mem_FP theorem machineNaturalIntegerCode_mem_FP : @@ -107,7 +107,7 @@ theorem machineRawAddLeftScaledNumerator_mem_FP : have hden := machineCompose_mem_FP machineRawRightDenominatorBits_mem_FP machineNaturalIntegerCode_mem_FP have hpair := machinePair_mem_FP machineRawLeftNumeratorCode_mem_FP hden - simpa only [machineRawAddLeftScaledNumerator] using + simpa only [machineRawAddLeftScaledNumerator] using! machineCompose_mem_FP hpair machineIntegerMulCode_mem_FP theorem machineRawAddRightScaledNumerator_mem_FP : @@ -115,7 +115,7 @@ theorem machineRawAddRightScaledNumerator_mem_FP : have hden := machineCompose_mem_FP machineRawLeftDenominatorBits_mem_FP machineNaturalIntegerCode_mem_FP have hpair := machinePair_mem_FP machineRawRightNumeratorCode_mem_FP hden - simpa only [machineRawAddRightScaledNumerator] using + simpa only [machineRawAddRightScaledNumerator] using! machineCompose_mem_FP hpair machineIntegerMulCode_mem_FP theorem machineRawAddNumeratorCode_mem_FP : @@ -123,21 +123,21 @@ theorem machineRawAddNumeratorCode_mem_FP : have hpair := machinePair_mem_FP machineRawAddLeftScaledNumerator_mem_FP machineRawAddRightScaledNumerator_mem_FP - simpa only [machineRawAddNumeratorCode] using + simpa only [machineRawAddNumeratorCode] using! machineCompose_mem_FP hpair machineIntegerAddCode_mem_FP theorem machineRawProductNumeratorCode_mem_FP : machineRawProductNumeratorCode ∈ Complexity.FP := by have hpair := machinePair_mem_FP machineRawLeftNumeratorCode_mem_FP machineRawRightNumeratorCode_mem_FP - simpa only [machineRawProductNumeratorCode] using + simpa only [machineRawProductNumeratorCode] using! machineCompose_mem_FP hpair machineIntegerMulCode_mem_FP theorem machineRawProductDenominatorBits_mem_FP : machineRawProductDenominatorBits ∈ Complexity.FP := by have hpair := machinePair_mem_FP machineRawLeftDenominatorBits_mem_FP machineRawRightDenominatorBits_mem_FP - simpa only [machineRawProductDenominatorBits] using + simpa only [machineRawProductDenominatorBits] using! machineCompose_mem_FP hpair machineBinaryMulBits_mem_FP theorem machineRawRatAddCode_mem_FP : machineRawRatAddCode ∈ Complexity.FP := by @@ -149,12 +149,12 @@ theorem machineRawRatMulCode_mem_FP : machineRawRatMulCode ∈ Complexity.FP := machineRawProductDenominatorBits_mem_FP theorem machineRationalAddCode_mem_FP : machineRationalAddCode ∈ Complexity.FP := by - simpa only [machineRationalAddCode] using + simpa only [machineRationalAddCode] using! machineCompose_mem_FP machineRawRatAddCode_mem_FP machineNormalizeRawRatBinaryCode_mem_FP theorem machineRationalMulCode_mem_FP : machineRationalMulCode ∈ Complexity.FP := by - simpa only [machineRationalMulCode] using + simpa only [machineRationalMulCode] using! machineCompose_mem_FP machineRawRatMulCode_mem_FP machineNormalizeRawRatBinaryCode_mem_FP diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalBallInit.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalBallInit.lean index fec46d29ce..9e45ba8ded 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalBallInit.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalBallInit.lean @@ -42,7 +42,7 @@ theorem machineRationalZeroVectorCode_mem_FP : have hpayload := machinePair_mem_FP id_mem_FP (machinePair_mem_FP (machineConst_mem_FP machineRationalZeroEntry) (machineConst_mem_FP [])) - simpa only [machineRationalZeroVectorCode] using + simpa only [machineRationalZeroVectorCode] using! machineCompose_mem_FP hpayload machineRepeatPairCode_mem_FP theorem machineRationalZeroMatrixRowsCode_mem_FP : @@ -50,7 +50,7 @@ theorem machineRationalZeroMatrixRowsCode_mem_FP : have hpayload := machinePair_mem_FP id_mem_FP (machinePair_mem_FP machineRationalZeroVectorCode_mem_FP (machineConst_mem_FP [])) - simpa only [machineRationalZeroMatrixRowsCode] using + simpa only [machineRationalZeroMatrixRowsCode] using! machineCompose_mem_FP hpayload machineRepeatPairCode_mem_FP @[simp] theorem machineRationalZeroVectorCode_encode (d : ℕ) : @@ -113,14 +113,14 @@ theorem rationalMatrixRows_diagonalPrefix_set {d k : ℕ} (R : ℚ) (hk : k < d) : let rows := rationalMatrixRows (rationalDiagonalPrefixMatrix d k R) rows.set k - ((rows[k]'(by simpa [rows, rationalMatrixRows] using hk)).set k R) = + ((rows[k]'(by simpa [rows, rationalMatrixRows] using! hk)).set k R) = rationalMatrixRows (rationalDiagonalPrefixMatrix d (k + 1) R) := by dsimp only apply List.ext_getElem · simp [rationalMatrixRows] · intro i hiLeft hiRight have hi : i < d := by - simpa [rationalMatrixRows] using hiRight + simpa [rationalMatrixRows] using! hiRight by_cases hik : i = k · subst i simp only [List.getElem_set, ↓reduceIte] @@ -128,7 +128,7 @@ theorem rationalMatrixRows_diagonalPrefix_set · simp [rationalMatrixRows] · intro j hjLeft hjRight have hj : j < d := by - simpa [rationalMatrixRows] using hjRight + simpa [rationalMatrixRows] using! hjRight by_cases hjk : j = k · subst j simp [rationalMatrixRows, rationalDiagonalPrefixMatrix] @@ -140,7 +140,7 @@ theorem rationalMatrixRows_diagonalPrefix_set apply List.ext_getElem · simp · intro j hjLeft hjRight - have hj : j < d := by simpa using hjRight + have hj : j < d := by simpa using! hjRight simp only [List.getElem_ofFn] by_cases hij : i = j · subst j @@ -236,7 +236,7 @@ theorem machineDiagonalBasisRadiusEntry_mem_FP : theorem machineDiagonalBasisBound_mem_FP : machineDiagonalBasisBound ∈ FP := by - simpa only [machineDiagonalBasisBound] using + simpa only [machineDiagonalBasisBound] using! machineCompose_mem_FP machineBinaryMulWidth_mem_FP machineBinaryMulWidth_mem_FP @@ -245,32 +245,32 @@ theorem machineDiagonalBasisIndex_mem_FP : theorem machineDiagonalBasisMatrix_mem_FP : machineDiagonalBasisMatrix ∈ FP := by - simpa only [machineDiagonalBasisMatrix] using + simpa only [machineDiagonalBasisMatrix] using! machineCompose_mem_FP machinePairSecond_mem_FP machinePairFirst_mem_FP theorem machineDiagonalBasisRadius_mem_FP : machineDiagonalBasisRadius ∈ FP := by have hsecondTwo := machineCompose_mem_FP machinePairSecond_mem_FP machinePairSecond_mem_FP - simpa only [machineDiagonalBasisRadius] using + simpa only [machineDiagonalBasisRadius] using! machineCompose_mem_FP hsecondTwo machinePairFirst_mem_FP theorem machineDiagonalBasisStateBound_mem_FP : machineDiagonalBasisStateBound ∈ FP := by have hsecondTwo := machineCompose_mem_FP machinePairSecond_mem_FP machinePairSecond_mem_FP - simpa only [machineDiagonalBasisStateBound] using + simpa only [machineDiagonalBasisStateBound] using! machineCompose_mem_FP hsecondTwo machinePairSecond_mem_FP theorem machineDiagonalBasisNextIndexCandidate_mem_FP : machineDiagonalBasisNextIndexCandidate ∈ FP := by - simpa only [machineDiagonalBasisNextIndexCandidate] using + simpa only [machineDiagonalBasisNextIndexCandidate] using! machineAppend_mem_FP (machineConst_mem_FP [true]) machineDiagonalBasisIndex_mem_FP theorem machineDiagonalBasisNextIndex_mem_FP : machineDiagonalBasisNextIndex ∈ FP := by - simpa only [machineDiagonalBasisNextIndex] using + simpa only [machineDiagonalBasisNextIndex] using! machineTake_mem_FP machineDiagonalBasisStateBound_mem_FP machineDiagonalBasisNextIndexCandidate_mem_FP @@ -280,12 +280,12 @@ theorem machineDiagonalBasisMatrixCandidate_mem_FP : (machinePair_mem_FP machineDiagonalBasisIndex_mem_FP (machinePair_mem_FP machineDiagonalBasisRadius_mem_FP machineDiagonalBasisMatrix_mem_FP)) - simpa only [machineDiagonalBasisMatrixCandidate] using + simpa only [machineDiagonalBasisMatrixCandidate] using! machineCompose_mem_FP hpayload machineNestedMatrixUpdateAtUnary_mem_FP theorem machineDiagonalBasisNextMatrix_mem_FP : machineDiagonalBasisNextMatrix ∈ FP := by - simpa only [machineDiagonalBasisNextMatrix] using + simpa only [machineDiagonalBasisNextMatrix] using! machineTake_mem_FP machineDiagonalBasisStateBound_mem_FP machineDiagonalBasisMatrixCandidate_mem_FP @@ -299,7 +299,7 @@ theorem machineDiagonalBasisInitialMatrix_mem_FP : machineDiagonalBasisInitialMatrix ∈ FP := by have hzero := machineCompose_mem_FP machineDiagonalBasisRuler_mem_FP machineRationalZeroMatrixRowsCode_mem_FP - simpa only [machineDiagonalBasisInitialMatrix] using + simpa only [machineDiagonalBasisInitialMatrix] using! machineTake_mem_FP machineDiagonalBasisBound_mem_FP hzero theorem machineDiagonalBasisInit_mem_FP : machineDiagonalBasisInit ∈ FP := @@ -401,7 +401,7 @@ theorem machineDiagonalBasisFinalState_mem_FP : theorem machineDiagonalBasisRowsCode_mem_FP : machineDiagonalBasisRowsCode ∈ FP := by - simpa only [machineDiagonalBasisRowsCode] using + simpa only [machineDiagonalBasisRowsCode] using! machineCompose_mem_FP machineDiagonalBasisFinalState_mem_FP machineDiagonalBasisMatrix_mem_FP @@ -576,7 +576,7 @@ theorem machineDiagonalBasisStep_semantics machineDiagonalBasisCanonicalState, machineDiagonalBasisIndex_pack, machineDiagonalBasisMatrix_pack, machineDiagonalBasisRadius_pack] - simpa only [rationalSquareMatrixRowsCode] using + simpa only [rationalSquareMatrixRowsCode] using! congrArg (fun word ↦ word.take (machineDiagonalBasisBound (machineDiagonalBasisCanonicalInput d R)).length) hupdate |>.trans @@ -600,7 +600,7 @@ theorem machineDiagonalBasisStep_semantics true :: List.replicate k true := by rw [List.replicate_succ] rw [← hrep] - exact List.take_of_length_le (by simpa using hindexFit) + exact List.take_of_length_le (by simpa using! hindexFit) simp only [machineDiagonalBasisStep, machineDiagonalBasisCanonicalState, machineDiagonalBasisNextIndex, machineDiagonalBasisNextIndexCandidate, machineDiagonalBasisIndex_pack, machineDiagonalBasisNextMatrix, @@ -655,7 +655,7 @@ theorem machineRationalBallStateCode_mem_FP : machineLengthBits_mem_FP have hcenter := machineCompose_mem_FP machineDiagonalBasisRuler_mem_FP machineRationalZeroVectorCode_mem_FP - simpa only [machineRationalBallStateCode] using + simpa only [machineRationalBallStateCode] using! machinePair_mem_FP hdim (machinePair_mem_FP hcenter machineDiagonalBasisRowsCode_mem_FP) diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalCompare.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalCompare.lean index 5fc99faa7a..280b377918 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalCompare.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalCompare.lean @@ -28,7 +28,7 @@ theorem machineRawRatLeBit_mem_FP : machineRawRatLeBit ∈ Complexity.FP := by have hpair := machinePair_mem_FP machineRawAddLeftScaledNumerator_mem_FP machineRawAddRightScaledNumerator_mem_FP - simpa only [machineRawRatLeBit] using + simpa only [machineRawRatLeBit] using! machineCompose_mem_FP hpair machineIntegerLeCode_mem_FP theorem machineRawRatLeBit_cross_encode (q r : RawRat) : @@ -47,7 +47,7 @@ theorem rawRat_value_le_iff_cross (q r : RawRat) : · intro h have hdiv : (q.num : ℚ) / (q.den : ℚ) ≤ (r.num : ℚ) / (r.den : ℚ) := by - simpa only [RawRat.value] using h + simpa only [RawRat.value] using! h have hcross := (div_le_div_iff₀ (by exact_mod_cast q.den_pos : (0 : ℚ) < q.den) (by exact_mod_cast r.den_pos : (0 : ℚ) < r.den)).1 hdiv @@ -60,7 +60,7 @@ theorem rawRat_value_le_iff_cross (q r : RawRat) : (r.num : ℚ) / (r.den : ℚ) := (div_le_div_iff₀ (by exact_mod_cast q.den_pos : (0 : ℚ) < q.den) (by exact_mod_cast r.den_pos : (0 : ℚ) < r.den)).2 hcross - simpa only [RawRat.value] using hdiv + simpa only [RawRat.value] using! hdiv theorem machineRawRatLeBit_encode (q r : RawRat) : machineRawRatLeBit diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalDirectionUpdateMatrix.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalDirectionUpdateMatrix.lean index 26b71b36d4..32751ce67d 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalDirectionUpdateMatrix.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalDirectionUpdateMatrix.lean @@ -74,7 +74,7 @@ theorem rawDirection_b_width_le_word {d : ℕ} have hvector : (rationalEntryBinaryCode (b i)).length ≤ (rationalFiniteVectorCode b).length := by - simpa only [rationalFiniteVectorCode] using helem + simpa only [rationalFiniteVectorCode] using! helem rw [rawRatBinaryCode_rawRatOfRat] at hcanonical exact hcanonical.trans (hvector.trans (by change (rationalFiniteVectorCode b).length ≤ @@ -123,11 +123,11 @@ theorem rawEllipsoidPerpScale_width_le_direction_word {d : ℕ} have htwo : rawRatWidth rawEllipsoidTwo = 2 := by rfl have hfourWidth : rawRatWidth rawEllipsoidFour = 3 := by rfl have hd' : rawRatWidth (rawEllipsoidDimension d) ≤ W := by - simpa only [W] using hd + simpa only [W] using! hd have hdsq0 : rawRatWidth (rawEllipsoidDimensionSquare d) ≤ rawRatWidth (rawEllipsoidDimension d) + rawRatWidth (rawEllipsoidDimension d) := by - simpa only [rawEllipsoidDimensionSquare] using hdsq + simpa only [rawEllipsoidDimensionSquare] using! hdsq have hdsq' : rawRatWidth (rawEllipsoidDimensionSquare d) ≤ 2 * W := by omega have hfour' : rawRatWidth (rawEllipsoidFourDimensionSquare d) ≤ @@ -135,35 +135,35 @@ theorem rawEllipsoidPerpScale_width_le_direction_word {d : ℕ} have hfour0 : rawRatWidth (rawEllipsoidFourDimensionSquare d) ≤ rawRatWidth rawEllipsoidFour + rawRatWidth (rawEllipsoidDimensionSquare d) := by - simpa only [rawEllipsoidFourDimensionSquare] using hfour + simpa only [rawEllipsoidFourDimensionSquare] using! hfour omega have halpha' : rawRatWidth (rawEllipsoidAlpha d) ≤ 4 + 2 * W := by have halpha0 : rawRatWidth (rawEllipsoidAlpha d) ≤ rawRatWidth rawEllipsoidOne + rawRatWidth (rawEllipsoidFourDimensionSquare d) := by - simpa only [rawEllipsoidAlpha] using halpha + simpa only [rawEllipsoidAlpha] using! halpha omega have halphaSq' : rawRatWidth (rawEllipsoidAlphaSquare d) ≤ 8 + 4 * W := by have halphaSq0 : rawRatWidth (rawEllipsoidAlphaSquare d) ≤ rawRatWidth (rawEllipsoidAlpha d) + rawRatWidth (rawEllipsoidAlpha d) := by - simpa only [rawEllipsoidAlphaSquare] using halphaSq + simpa only [rawEllipsoidAlphaSquare] using! halphaSq omega have htwice' : rawRatWidth (rawEllipsoidTwiceAlphaSquare d) ≤ 10 + 4 * W := by have htwice0 : rawRatWidth (rawEllipsoidTwiceAlphaSquare d) ≤ rawRatWidth rawEllipsoidTwo + rawRatWidth (rawEllipsoidAlphaSquare d) := by - simpa only [rawEllipsoidTwiceAlphaSquare] using htwice + simpa only [rawEllipsoidTwiceAlphaSquare] using! htwice omega have hperp' : rawRatWidth (rawEllipsoidPerpScale d) ≤ 12 + 4 * W := by have hperp0 : rawRatWidth (rawEllipsoidPerpScale d) ≤ rawRatWidth rawEllipsoidOne + rawRatWidth (rawEllipsoidTwiceAlphaSquare d) + 1 := by - simpa only [rawEllipsoidPerpScale] using hperp + simpa only [rawEllipsoidPerpScale] using! hperp omega - simpa only [W] using hperp' + simpa only [W] using! hperp' theorem rawEllipsoidParallelScale_width_le_direction_word {d : ℕ} (b : Fin d → ℚ) : @@ -184,11 +184,11 @@ theorem rawEllipsoidParallelScale_width_le_direction_word {d : ℕ} have hone : rawRatWidth rawEllipsoidOne = 1 := by rfl have hfourWidth : rawRatWidth rawEllipsoidFour = 3 := by rfl have hd' : rawRatWidth (rawEllipsoidDimension d) ≤ W := by - simpa only [W] using hd + simpa only [W] using! hd have hdsq0 : rawRatWidth (rawEllipsoidDimensionSquare d) ≤ rawRatWidth (rawEllipsoidDimension d) + rawRatWidth (rawEllipsoidDimension d) := by - simpa only [rawEllipsoidDimensionSquare] using hdsq + simpa only [rawEllipsoidDimensionSquare] using! hdsq have hdsq' : rawRatWidth (rawEllipsoidDimensionSquare d) ≤ 2 * W := by omega have hfour' : rawRatWidth (rawEllipsoidFourDimensionSquare d) ≤ @@ -196,29 +196,29 @@ theorem rawEllipsoidParallelScale_width_le_direction_word {d : ℕ} have hfour0 : rawRatWidth (rawEllipsoidFourDimensionSquare d) ≤ rawRatWidth rawEllipsoidFour + rawRatWidth (rawEllipsoidDimensionSquare d) := by - simpa only [rawEllipsoidFourDimensionSquare] using hfour + simpa only [rawEllipsoidFourDimensionSquare] using! hfour omega have halpha' : rawRatWidth (rawEllipsoidAlpha d) ≤ 4 + 2 * W := by have halpha0 : rawRatWidth (rawEllipsoidAlpha d) ≤ rawRatWidth rawEllipsoidOne + rawRatWidth (rawEllipsoidFourDimensionSquare d) := by - simpa only [rawEllipsoidAlpha] using halpha + simpa only [rawEllipsoidAlpha] using! halpha omega have hover' : rawRatWidth (rawEllipsoidAlphaOverDimension d) ≤ 4 + 3 * W := by have hover0 : rawRatWidth (rawEllipsoidAlphaOverDimension d) ≤ rawRatWidth (rawEllipsoidAlpha d) + rawRatWidth (rawEllipsoidDimension d) := by - simpa only [rawEllipsoidAlphaOverDimension] using hover + simpa only [rawEllipsoidAlphaOverDimension] using! hover omega have hparallel' : rawRatWidth (rawEllipsoidParallelScale d) ≤ 6 + 3 * W := by have hparallel0 : rawRatWidth (rawEllipsoidParallelScale d) ≤ rawRatWidth rawEllipsoidOne + rawRatWidth (rawEllipsoidAlphaOverDimension d) + 1 := by - simpa only [rawEllipsoidParallelScale] using hparallel + simpa only [rawEllipsoidParallelScale] using! hparallel omega - simpa only [W] using hparallel' + simpa only [W] using! hparallel' theorem rawDirectionMatrixEntry_width_le_word {d : ℕ} (b : Fin d → ℚ) (i j : Fin d) : @@ -231,15 +231,15 @@ theorem rawDirectionMatrixEntry_width_le_word {d : ℕ} have hbi := rawDirection_b_width_le_word b i have hbj := rawDirection_b_width_le_word b j have hperp' : rawRatWidth (rawEllipsoidPerpScale d) ≤ 12 + 4 * W := by - simpa only [W] using hperp + simpa only [W] using! hperp have hparallel' : rawRatWidth (rawEllipsoidParallelScale d) ≤ - 6 + 3 * W := by simpa only [W] using hparallel + 6 + 3 * W := by simpa only [W] using! hparallel have hnorm' : rawRatWidth (rawDirectionNormSq b) ≤ 1 + 2 * W := by - simpa only [W] using hnorm + simpa only [W] using! hnorm have hbi' : rawRatWidth (rawRatOfRat (b i)) ≤ W := by - simpa only [W] using hbi + simpa only [W] using! hbi have hbj' : rawRatWidth (rawRatOfRat (b j)) ≤ W := by - simpa only [W] using hbj + simpa only [W] using! hbj have hgap' : rawRatWidth (rawDirectionGap d) ≤ 19 + 7 * W := by calc _ = rawRatWidth ((rawEllipsoidPerpScale d).sub @@ -271,7 +271,7 @@ theorem rawDirectionMatrixEntry_width_le_word {d : ℕ} have hdiag : rawRatWidth (rawDirectionDiagonalEntry i j) ≤ 12 + 4 * W := by by_cases hij : i = j - · simpa only [rawDirectionDiagonalEntry, hij, if_true] using hperp + · simpa only [rawDirectionDiagonalEntry, hij, if_true] using! hperp · simp only [rawDirectionDiagonalEntry, hij, ite_false, rawRatWidth_zero] omega calc @@ -355,13 +355,13 @@ theorem rationalDirectionUpdateMatrix_code_length_le_bound {d : ℕ} have hd : d ≤ word.length := by have h := machinePairFirst_length_le word simpa only [word, rationalDirectionUpdateCanonicalWord, - machinePairFirst_pair, List.length_replicate] using h + machinePairFirst_pair, List.length_replicate] using! h have hn4 : 4 ≤ n := by simp only [n, word, rationalDirectionUpdateCanonicalWord, pair_length, List.length_replicate] omega have hcubic := rationalDirectionUpdateMatrix_code_length_le_cubic b - have hd' : d ≤ n := by simpa only [n] using hd + have hd' : d ≤ n := by simpa only [n] using! hd have hdn : d * n ≤ n * n := Nat.mul_le_mul hd' le_rfl have hdd : d * d ≤ n * n := Nat.mul_le_mul hd' hd' have hddn : (d * d) * n ≤ (n * n) * n := @@ -374,7 +374,7 @@ theorem rationalDirectionUpdateMatrix_code_length_le_bound {d : ℕ} (rationalSquareMatrixRowsCode (rationalDirectionUpdateMatrix b)).length ≤ 4000 * n ^ 3 := by apply hcubic.trans - simpa only [n, word] using hpoly + simpa only [n, word] using! hpoly have hnx : n ≤ x := by simp [x] have hxpos : 0 < x := by omega have h4000 : 4000 ≤ x ^ 3 := by @@ -383,18 +383,18 @@ theorem rationalDirectionUpdateMatrix_code_length_le_bound {d : ℕ} have hnx3 : n ^ 3 ≤ x ^ 3 := Nat.pow_le_pow_left hnx 3 have hto6 : 4000 * n ^ 3 ≤ x ^ 6 := by have h := Nat.mul_le_mul h4000 hnx3 - simpa only [← pow_add] using h + simpa only [← pow_add] using! h have hto8 : x ^ 6 ≤ x ^ 8 := Nat.pow_le_pow_right hxpos (by omega) have hxy : x ^ 2 ≤ y := by simp [y] have hx4y2 : x ^ 4 ≤ y ^ 2 := by have h := Nat.pow_le_pow_left hxy 2 - simpa only [← pow_mul] using h + simpa only [← pow_mul] using! h have hyz : y ^ 2 ≤ z := by simp [z] have hx4z : x ^ 4 ≤ z := hx4y2.trans hyz have hx8z2 : x ^ 8 ≤ z ^ 2 := by have h := Nat.pow_le_pow_left hx4z 2 - simpa only [← pow_mul] using h + simpa only [← pow_mul] using! h apply hout.trans apply hto6.trans apply hto8.trans @@ -468,7 +468,7 @@ def machineRationalDirectionUpdateMatrixCode theorem machineRationalDirectionUpdateMatrixIndices_mem_FP : machineRationalDirectionUpdateMatrixIndices ∈ FP := by - simpa only [machineRationalDirectionUpdateMatrixIndices] using + simpa only [machineRationalDirectionUpdateMatrixIndices] using! machineCompose_mem_FP machinePairFirst_mem_FP machineUnaryRangeCode_mem_FP @@ -477,7 +477,7 @@ theorem machineRationalDirectionUpdateMatrixCurrentRow_mem_FP : have hinput := machinePair_mem_FP machineRationalTransposeMulVectorCurrentIndex_mem_FP machineRationalTransposeMulVectorStatePayload_mem_FP - simpa only [machineRationalDirectionUpdateMatrixCurrentRow] using + simpa only [machineRationalDirectionUpdateMatrixCurrentRow] using! machineCompose_mem_FP hinput machineRationalDirectionUpdateRowCode_mem_FP @@ -488,7 +488,7 @@ theorem machineRationalDirectionUpdateMatrixCandidate_mem_FP : theorem machineRationalDirectionUpdateMatrixNextAccumulator_mem_FP : machineRationalDirectionUpdateMatrixNextAccumulator ∈ FP := by - simpa only [machineRationalDirectionUpdateMatrixNextAccumulator] using + simpa only [machineRationalDirectionUpdateMatrixNextAccumulator] using! machineTake_mem_FP machineRationalTransposeMulVectorBound_mem_FP machineRationalDirectionUpdateMatrixCandidate_mem_FP @@ -536,7 +536,7 @@ theorem machineRationalDirectionUpdateMatrixInit_bound refine ⟨trivial, ?_, by simp, ?_, trivial⟩ · simpa only [machineRationalDirectionUpdateMatrixIndices, machineRationalTransposeMulVectorIndices, - machineRationalTransposeMulVectorDimension] using + machineRationalTransposeMulVectorDimension] using! machineRationalTransposeMulVector_indices_le_bound word · exact machineRationalTransposeMulVector_word_le_bound word @@ -604,14 +604,14 @@ theorem machineRationalDirectionUpdateMatrixFinalState_mem_FP : theorem machineRationalDirectionUpdateMatrixReversedCode_mem_FP : machineRationalDirectionUpdateMatrixReversedCode ∈ FP := by - simpa only [machineRationalDirectionUpdateMatrixReversedCode] using + simpa only [machineRationalDirectionUpdateMatrixReversedCode] using! machineCompose_mem_FP machineRationalDirectionUpdateMatrixFinalState_mem_FP machineRationalTransposeMulVectorAccumulator_mem_FP theorem machineRationalDirectionUpdateMatrixCode_mem_FP : machineRationalDirectionUpdateMatrixCode ∈ FP := by - simpa only [machineRationalDirectionUpdateMatrixCode] using + simpa only [machineRationalDirectionUpdateMatrixCode] using! machineCompose_mem_FP machineRationalDirectionUpdateMatrixReversedCode_mem_FP machineListReverse_mem_FP @@ -651,7 +651,7 @@ theorem rationalDirectionUpdateRowsPrefix_succ {d : ℕ} [List.ofFn fun j ↦ rationalDirectionUpdateMatrix b ⟨k, hk⟩ j] := by simp only [rationalDirectionUpdateRowsPrefix, List.map_take] have hkm : k < (List.finRange d).length := by simpa - simpa [List.getElem_finRange] using + simpa [List.getElem_finRange] using! congrArg (List.map fun i ↦ List.ofFn fun j ↦ rationalDirectionUpdateMatrix b i j) (List.take_concat_get hkm).symm @@ -701,7 +701,7 @@ theorem machineRationalDirectionUpdateMatrixStep_semantics {d : ℕ} (binaryListCode (binaryListCode rationalEntryBinaryCode) (rationalDirectionUpdateRowsPrefix b k).reverse)).length ≤ (machineRationalDirectionUpdateMatrixInputBound word).length := by - simpa only [hreverse, binaryListCode] using hcand + simpa only [hreverse, binaryListCode] using! hcand have hnonempty : binaryListCode finUnaryCode ((List.finRange d).drop k) ≠ [] := by rw [hdrop] @@ -783,7 +783,7 @@ theorem machineRationalDirectionUpdateMatrixReversedCode_encode {d : ℕ} have hd : d ≤ word.length := by have h := machinePairFirst_length_le word simpa only [word, rationalDirectionUpdateCanonicalWord, - machinePairFirst_pair, List.length_replicate] using h + machinePairFirst_pair, List.length_replicate] using! h have hsplit : word.length = (word.length - d) + d := by omega change machineRationalDirectionUpdateMatrixReversedCode word = _ rw [machineRationalDirectionUpdateMatrixReversedCode, diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalDirectionUpdateRow.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalDirectionUpdateRow.lean index 985af2aeae..370ffdd177 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalDirectionUpdateRow.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalDirectionUpdateRow.lean @@ -133,25 +133,25 @@ theorem machineDirectionRowPayload_mem_FP : theorem machineDirectionRowDimensionUnary_mem_FP : machineDirectionRowDimensionUnary ∈ FP := by - simpa only [machineDirectionRowDimensionUnary] using + simpa only [machineDirectionRowDimensionUnary] using! machineCompose_mem_FP machineDirectionRowPayload_mem_FP machinePairFirst_mem_FP theorem machineDirectionRowDimensionAndVector_mem_FP : machineDirectionRowDimensionAndVector ∈ FP := by - simpa only [machineDirectionRowDimensionAndVector] using + simpa only [machineDirectionRowDimensionAndVector] using! machineCompose_mem_FP machineDirectionRowPayload_mem_FP machinePairSecond_mem_FP theorem machineDirectionRowDimensionBits_mem_FP : machineDirectionRowDimensionBits ∈ FP := by - simpa only [machineDirectionRowDimensionBits] using + simpa only [machineDirectionRowDimensionBits] using! machineCompose_mem_FP machineDirectionRowDimensionAndVector_mem_FP machinePairFirst_mem_FP theorem machineDirectionRowVectorCode_mem_FP : machineDirectionRowVectorCode ∈ FP := by - simpa only [machineDirectionRowVectorCode] using + simpa only [machineDirectionRowVectorCode] using! machineCompose_mem_FP machineDirectionRowDimensionAndVector_mem_FP machinePairSecond_mem_FP @@ -159,7 +159,7 @@ theorem machineDirectionRowNormSqRawCode_mem_FP : machineDirectionRowNormSqRawCode ∈ FP := by have hinput := machinePair_mem_FP machineDirectionRowVectorCode_mem_FP machineDirectionRowVectorCode_mem_FP - simpa only [machineDirectionRowNormSqRawCode] using + simpa only [machineDirectionRowNormSqRawCode] using! machineCompose_mem_FP hinput machineRationalVectorDotRawCode_mem_FP theorem machineDirectionRowGapRawCode_mem_FP : @@ -170,7 +170,7 @@ theorem machineDirectionRowGapRawCode_mem_FP : machineDirectionRowDimensionBits_mem_FP machineEllipsoidParallelScaleRawCode_mem_FP have hneg := machineCompose_mem_FP hparallel machineRawRatNegCode_mem_FP - simpa only [machineDirectionRowGapRawCode] using + simpa only [machineDirectionRowGapRawCode] using! machineCompose_mem_FP (machinePair_mem_FP hperp hneg) machineRawRatAddCode_mem_FP @@ -178,14 +178,14 @@ theorem machineDirectionRowCoefficientRawCode_mem_FP : machineDirectionRowCoefficientRawCode ∈ FP := by have hinput := machinePair_mem_FP machineDirectionRowGapRawCode_mem_FP machineDirectionRowNormSqRawCode_mem_FP - simpa only [machineDirectionRowCoefficientRawCode] using + simpa only [machineDirectionRowCoefficientRawCode] using! machineCompose_mem_FP hinput machineRawRatDivCode_mem_FP theorem machineDirectionRowBEntry_mem_FP : machineDirectionRowBEntry ∈ FP := by have hinput := machinePair_mem_FP machineDirectionRowIndex_mem_FP machineDirectionRowVectorCode_mem_FP - simpa only [machineDirectionRowBEntry] using + simpa only [machineDirectionRowBEntry] using! machineCompose_mem_FP hinput machineListIndex_mem_FP theorem machineDirectionRowScaleRawCode_mem_FP : @@ -193,19 +193,19 @@ theorem machineDirectionRowScaleRawCode_mem_FP : have hinput := machinePair_mem_FP machineDirectionRowCoefficientRawCode_mem_FP machineDirectionRowBEntry_mem_FP - simpa only [machineDirectionRowScaleRawCode] using + simpa only [machineDirectionRowScaleRawCode] using! machineCompose_mem_FP hinput machineRawRatMulCode_mem_FP theorem machineDirectionRowScaledVectorCode_mem_FP : machineDirectionRowScaledVectorCode ∈ FP := by have hinput := machinePair_mem_FP machineDirectionRowScaleRawCode_mem_FP machineDirectionRowVectorCode_mem_FP - simpa only [machineDirectionRowScaledVectorCode] using + simpa only [machineDirectionRowScaledVectorCode] using! machineCompose_mem_FP hinput machineRationalVectorScaleCode_mem_FP theorem machineDirectionRowZeroVectorCode_mem_FP : machineDirectionRowZeroVectorCode ∈ FP := by - simpa only [machineDirectionRowZeroVectorCode] using + simpa only [machineDirectionRowZeroVectorCode] using! machineCompose_mem_FP machineDirectionRowDimensionUnary_mem_FP machineRationalZeroVectorCode_mem_FP @@ -216,7 +216,7 @@ theorem machineDirectionRowDiagonalCode_mem_FP : have hpayload := machinePair_mem_FP hperp machineDirectionRowZeroVectorCode_mem_FP have hinput := machinePair_mem_FP machineDirectionRowIndex_mem_FP hpayload - simpa only [machineDirectionRowDiagonalCode] using + simpa only [machineDirectionRowDiagonalCode] using! machineCompose_mem_FP hinput machineListUpdate_mem_FP theorem machineRationalDirectionUpdateRowCode_mem_FP : @@ -225,7 +225,7 @@ theorem machineRationalDirectionUpdateRowCode_mem_FP : machineDirectionRowScaledVectorCode_mem_FP have hinput := machinePair_mem_FP machineDirectionRowDimensionUnary_mem_FP hpayload - simpa only [machineRationalDirectionUpdateRowCode] using + simpa only [machineRationalDirectionUpdateRowCode] using! machineCompose_mem_FP hinput machineRationalVectorSubCode_mem_FP /-! ## Exact semantics -/ @@ -369,13 +369,13 @@ theorem machineRationalDirectionUpdateRowCode_mem_FP : by_cases hji : j = i.1 · subst j simp [rationalDirectionDiagonalRow] - · have hfin : i ≠ ⟨j, by simpa using hjRight⟩ := by + · have hfin : i ≠ ⟨j, by simpa using! hjRight⟩ := by intro h apply hji exact (congrArg Fin.val h).symm have hij : i.1 ≠ j := Ne.symm hji simp [List.getElem_set, hij, rationalDirectionDiagonalRow, hfin] - · simpa using i.isLt + · simpa using! i.isLt theorem rationalDirectionUpdateRow_eq {d : ℕ} (b : Fin d → ℚ) (i : Fin d) : diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalEllipsoidCenterUpdate.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalEllipsoidCenterUpdate.lean index 0fa33c0334..1e244d40d9 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalEllipsoidCenterUpdate.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalEllipsoidCenterUpdate.lean @@ -90,7 +90,7 @@ theorem machineRationalCenterUpdateCutWord_mem_FP : theorem machineRationalCenterUpdateDimensionBits_mem_FP : machineRationalCenterUpdateDimensionBits ∈ FP := by - simpa only [machineRationalCenterUpdateDimensionBits] using + simpa only [machineRationalCenterUpdateDimensionBits] using! machineCompose_mem_FP machineRationalCenterUpdateStateWord_mem_FP machineRationalEllipsoidDimensionWord_mem_FP @@ -99,18 +99,18 @@ theorem machineRationalCenterUpdateDimensionUnary_mem_FP : have hinput := machinePair_mem_FP machineRationalCenterUpdateStateWord_mem_FP machineRationalCenterUpdateDimensionBits_mem_FP - simpa only [machineRationalCenterUpdateDimensionUnary] using + simpa only [machineRationalCenterUpdateDimensionUnary] using! machineCompose_mem_FP hinput machineBoundedUnary_mem_FP theorem machineRationalCenterUpdateCenterWord_mem_FP : machineRationalCenterUpdateCenterWord ∈ FP := by - simpa only [machineRationalCenterUpdateCenterWord] using + simpa only [machineRationalCenterUpdateCenterWord] using! machineCompose_mem_FP machineRationalCenterUpdateStateWord_mem_FP machineRationalEllipsoidCenterWord_mem_FP theorem machineRationalCenterUpdateBasisWord_mem_FP : machineRationalCenterUpdateBasisWord ∈ FP := by - simpa only [machineRationalCenterUpdateBasisWord] using + simpa only [machineRationalCenterUpdateBasisWord] using! machineCompose_mem_FP machineRationalCenterUpdateStateWord_mem_FP machineRationalEllipsoidBasisWord_mem_FP @@ -121,12 +121,12 @@ theorem machineRationalCenterUpdatePulledBackCode_mem_FP : machineRationalCenterUpdateCutWord_mem_FP have hinput := machinePair_mem_FP machineRationalCenterUpdateDimensionUnary_mem_FP hpayload - simpa only [machineRationalCenterUpdatePulledBackCode] using + simpa only [machineRationalCenterUpdatePulledBackCode] using! machineCompose_mem_FP hinput machineRationalTransposeMulVectorCode_mem_FP theorem machineRationalCenterUpdateNormalizedCode_mem_FP : machineRationalCenterUpdateNormalizedCode ∈ FP := by - simpa only [machineRationalCenterUpdateNormalizedCode] using + simpa only [machineRationalCenterUpdateNormalizedCode] using! machineCompose_mem_FP machineRationalCenterUpdatePulledBackCode_mem_FP machineRationalNormalizedDirectionCode_mem_FP @@ -137,7 +137,7 @@ theorem machineRationalCenterUpdateDisplacementCode_mem_FP : machineRationalCenterUpdateNormalizedCode_mem_FP have hinput := machinePair_mem_FP machineRationalCenterUpdateDimensionUnary_mem_FP hpayload - simpa only [machineRationalCenterUpdateDisplacementCode] using + simpa only [machineRationalCenterUpdateDisplacementCode] using! machineCompose_mem_FP hinput machineRationalMatrixMulVectorCode_mem_FP theorem machineRationalCenterUpdateScaledDisplacementCode_mem_FP : @@ -147,7 +147,7 @@ theorem machineRationalCenterUpdateScaledDisplacementCode_mem_FP : machineEllipsoidAlphaRawCode_mem_FP have hinput := machinePair_mem_FP halpha machineRationalCenterUpdateDisplacementCode_mem_FP - simpa only [machineRationalCenterUpdateScaledDisplacementCode] using + simpa only [machineRationalCenterUpdateScaledDisplacementCode] using! machineCompose_mem_FP hinput machineRationalVectorScaleCode_mem_FP theorem machineRationalEllipsoidCenterUpdateCode_mem_FP : @@ -157,7 +157,7 @@ theorem machineRationalEllipsoidCenterUpdateCode_mem_FP : machineRationalCenterUpdateScaledDisplacementCode_mem_FP have hinput := machinePair_mem_FP machineRationalCenterUpdateDimensionUnary_mem_FP hpayload - simpa only [machineRationalEllipsoidCenterUpdateCode] using + simpa only [machineRationalEllipsoidCenterUpdateCode] using! machineCompose_mem_FP hinput machineRationalVectorSubCode_mem_FP /-! ## Exact semantics -/ @@ -176,10 +176,10 @@ theorem rationalEllipsoid_dimension_le_state_code_length {d : ℕ} have hsecond : payload.length ≤ (rationalEllipsoidStateBinaryCode E).length := by simpa only [payload, rationalEllipsoidStateBinaryCode, - machinePairSecond_pair] using machinePairSecond_length_le + machinePairSecond_pair] using! machinePairSecond_length_le (rationalEllipsoidStateBinaryCode E) - simpa only [payload, machinePairFirst_pair] using hfirst.trans hsecond - simpa only [rationalFiniteVectorCode, List.length_ofFn] using + simpa only [payload, machinePairFirst_pair] using! hfirst.trans hsecond + simpa only [rationalFiniteVectorCode, List.length_ofFn] using! hlist.trans hcenter @[simp] theorem machineRationalCenterUpdateDimensionUnary_encode {d : ℕ} diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalEllipsoidScalars.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalEllipsoidScalars.lean index ccee2a6cd9..96ba8e76d4 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalEllipsoidScalars.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalEllipsoidScalars.lean @@ -125,7 +125,7 @@ theorem machineEllipsoidDimensionRawCode_mem_FP : theorem machineEllipsoidDimensionSquareRawCode_mem_FP : machineEllipsoidDimensionSquareRawCode ∈ FP := by - simpa only [machineEllipsoidDimensionSquareRawCode] using + simpa only [machineEllipsoidDimensionSquareRawCode] using! machineCompose_mem_FP (machinePair_mem_FP machineEllipsoidDimensionRawCode_mem_FP machineEllipsoidDimensionRawCode_mem_FP) @@ -133,7 +133,7 @@ theorem machineEllipsoidDimensionSquareRawCode_mem_FP : theorem machineEllipsoidFourDimensionSquareRawCode_mem_FP : machineEllipsoidFourDimensionSquareRawCode ∈ FP := by - simpa only [machineEllipsoidFourDimensionSquareRawCode] using + simpa only [machineEllipsoidFourDimensionSquareRawCode] using! machineCompose_mem_FP (machinePair_mem_FP (machineConst_mem_FP (rawRatBinaryCode rawEllipsoidFour)) @@ -142,7 +142,7 @@ theorem machineEllipsoidFourDimensionSquareRawCode_mem_FP : theorem machineEllipsoidAlphaRawCode_mem_FP : machineEllipsoidAlphaRawCode ∈ FP := by - simpa only [machineEllipsoidAlphaRawCode] using + simpa only [machineEllipsoidAlphaRawCode] using! machineCompose_mem_FP (machinePair_mem_FP (machineConst_mem_FP (rawRatBinaryCode rawEllipsoidOne)) @@ -151,7 +151,7 @@ theorem machineEllipsoidAlphaRawCode_mem_FP : theorem machineEllipsoidAlphaSquareRawCode_mem_FP : machineEllipsoidAlphaSquareRawCode ∈ FP := by - simpa only [machineEllipsoidAlphaSquareRawCode] using + simpa only [machineEllipsoidAlphaSquareRawCode] using! machineCompose_mem_FP (machinePair_mem_FP machineEllipsoidAlphaRawCode_mem_FP machineEllipsoidAlphaRawCode_mem_FP) @@ -159,7 +159,7 @@ theorem machineEllipsoidAlphaSquareRawCode_mem_FP : theorem machineEllipsoidTwiceAlphaSquareRawCode_mem_FP : machineEllipsoidTwiceAlphaSquareRawCode ∈ FP := by - simpa only [machineEllipsoidTwiceAlphaSquareRawCode] using + simpa only [machineEllipsoidTwiceAlphaSquareRawCode] using! machineCompose_mem_FP (machinePair_mem_FP (machineConst_mem_FP (rawRatBinaryCode rawEllipsoidTwo)) @@ -168,7 +168,7 @@ theorem machineEllipsoidTwiceAlphaSquareRawCode_mem_FP : theorem machineEllipsoidPerpScaleRawCode_mem_FP : machineEllipsoidPerpScaleRawCode ∈ FP := by - simpa only [machineEllipsoidPerpScaleRawCode] using + simpa only [machineEllipsoidPerpScaleRawCode] using! machineCompose_mem_FP (machinePair_mem_FP (machineConst_mem_FP (rawRatBinaryCode rawEllipsoidOne)) @@ -177,7 +177,7 @@ theorem machineEllipsoidPerpScaleRawCode_mem_FP : theorem machineEllipsoidAlphaOverDimensionRawCode_mem_FP : machineEllipsoidAlphaOverDimensionRawCode ∈ FP := by - simpa only [machineEllipsoidAlphaOverDimensionRawCode] using + simpa only [machineEllipsoidAlphaOverDimensionRawCode] using! machineCompose_mem_FP (machinePair_mem_FP machineEllipsoidAlphaRawCode_mem_FP machineEllipsoidDimensionRawCode_mem_FP) @@ -188,7 +188,7 @@ theorem machineEllipsoidParallelScaleRawCode_mem_FP : have hneg := machineCompose_mem_FP machineEllipsoidAlphaOverDimensionRawCode_mem_FP machineRawRatNegCode_mem_FP - simpa only [machineEllipsoidParallelScaleRawCode] using + simpa only [machineEllipsoidParallelScaleRawCode] using! machineCompose_mem_FP (machinePair_mem_FP (machineConst_mem_FP (rawRatBinaryCode rawEllipsoidOne)) @@ -197,19 +197,19 @@ theorem machineEllipsoidParallelScaleRawCode_mem_FP : theorem machineEllipsoidAlphaEntryCode_mem_FP : machineEllipsoidAlphaEntryCode ∈ FP := by - simpa only [machineEllipsoidAlphaEntryCode] using + simpa only [machineEllipsoidAlphaEntryCode] using! machineCompose_mem_FP machineEllipsoidAlphaRawCode_mem_FP machineNormalizeRawRatEntryCode_mem_FP theorem machineEllipsoidPerpScaleEntryCode_mem_FP : machineEllipsoidPerpScaleEntryCode ∈ FP := by - simpa only [machineEllipsoidPerpScaleEntryCode] using + simpa only [machineEllipsoidPerpScaleEntryCode] using! machineCompose_mem_FP machineEllipsoidPerpScaleRawCode_mem_FP machineNormalizeRawRatEntryCode_mem_FP theorem machineEllipsoidParallelScaleEntryCode_mem_FP : machineEllipsoidParallelScaleEntryCode ∈ FP := by - simpa only [machineEllipsoidParallelScaleEntryCode] using + simpa only [machineEllipsoidParallelScaleEntryCode] using! machineCompose_mem_FP machineEllipsoidParallelScaleRawCode_mem_FP machineNormalizeRawRatEntryCode_mem_FP diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalEllipsoidUpdate.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalEllipsoidUpdate.lean index 01a2057462..29ea76a96b 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalEllipsoidUpdate.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalEllipsoidUpdate.lean @@ -45,7 +45,7 @@ theorem machineRationalEllipsoidUpdateDirectionMatrixCode_mem_FP : machineRationalCenterUpdateDimensionUnary_mem_FP (machinePair_mem_FP machineRationalCenterUpdateDimensionBits_mem_FP machineRationalCenterUpdatePulledBackCode_mem_FP) - simpa only [machineRationalEllipsoidUpdateDirectionMatrixCode] using + simpa only [machineRationalEllipsoidUpdateDirectionMatrixCode] using! machineCompose_mem_FP hinput machineRationalDirectionUpdateMatrixCode_mem_FP @@ -55,7 +55,7 @@ theorem machineRationalEllipsoidUpdateBasisCode_mem_FP : machineRationalCenterUpdateDimensionUnary_mem_FP (machinePair_mem_FP machineRationalCenterUpdateBasisWord_mem_FP machineRationalEllipsoidUpdateDirectionMatrixCode_mem_FP) - simpa only [machineRationalEllipsoidUpdateBasisCode] using + simpa only [machineRationalEllipsoidUpdateBasisCode] using! machineCompose_mem_FP hinput machineRationalMatrixMulCode_mem_FP theorem machineRationalEllipsoidCentralUpdateCode_mem_FP : diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalExp.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalExp.lean index 41fc4cc0de..64c0f4aea9 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalExp.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalExp.lean @@ -105,55 +105,55 @@ theorem machineExpPayload_mem_FP : machineExpPayload ∈ Complexity.FP := theorem machineExpArgumentCode_mem_FP : machineExpArgumentCode ∈ Complexity.FP := by - simpa only [machineExpArgumentCode] using + simpa only [machineExpArgumentCode] using! machineCompose_mem_FP machineExpPayload_mem_FP machinePairFirst_mem_FP theorem machineExpLossCode_mem_FP : machineExpLossCode ∈ Complexity.FP := by - simpa only [machineExpLossCode] using + simpa only [machineExpLossCode] using! machineCompose_mem_FP machineExpPayload_mem_FP machinePairSecond_mem_FP theorem machineExpArgumentSign_mem_FP : machineExpArgumentSign ∈ Complexity.FP := by have hnum := machineCompose_mem_FP machineExpArgumentCode_mem_FP machinePairFirst_mem_FP - simpa only [machineExpArgumentSign] using + simpa only [machineExpArgumentSign] using! machineCompose_mem_FP hnum machineHeadBit_mem_FP theorem machineExpMagnitudeCode_mem_FP : machineExpMagnitudeCode ∈ Complexity.FP := by have hneg := machineCompose_mem_FP machineExpArgumentCode_mem_FP machineRawRatNegCode_mem_FP - simpa only [machineExpMagnitudeCode] using + simpa only [machineExpMagnitudeCode] using! machineIfHead_mem_FP machineExpArgumentSign_mem_FP hneg machineExpArgumentCode_mem_FP theorem machineExpSquareCode_mem_FP : machineExpSquareCode ∈ Complexity.FP := by have hpair := machinePair_mem_FP machineExpMagnitudeCode_mem_FP machineExpMagnitudeCode_mem_FP - simpa only [machineExpSquareCode] using + simpa only [machineExpSquareCode] using! machineCompose_mem_FP hpair machineRawRatMulCode_mem_FP theorem machineExpSquareOverLossCode_mem_FP : machineExpSquareOverLossCode ∈ Complexity.FP := by have hpair := machinePair_mem_FP machineExpSquareCode_mem_FP machineExpLossCode_mem_FP - simpa only [machineExpSquareOverLossCode] using + simpa only [machineExpSquareOverLossCode] using! machineCompose_mem_FP hpair machineRawRatDivCode_mem_FP theorem machineExpScheduleArgumentCode_mem_FP : machineExpScheduleArgumentCode ∈ Complexity.FP := by have hpair := machinePair_mem_FP machineExpMagnitudeCode_mem_FP machineExpSquareOverLossCode_mem_FP - simpa only [machineExpScheduleArgumentCode] using + simpa only [machineExpScheduleArgumentCode] using! machineCompose_mem_FP hpair machineRawRatAddCode_mem_FP theorem machineExpCeilBits_mem_FP : machineExpCeilBits ∈ Complexity.FP := by - simpa only [machineExpCeilBits] using + simpa only [machineExpCeilBits] using! machineCompose_mem_FP machineExpScheduleArgumentCode_mem_FP machineRationalCeilNatBits_mem_FP theorem machineExpStepsBits_mem_FP : machineExpStepsBits ∈ Complexity.FP := by - simpa only [machineExpStepsBits] using + simpa only [machineExpStepsBits] using! machineCompose_mem_FP machineExpCeilBits_mem_FP (machinePrepend_mem_FP true) @@ -161,7 +161,7 @@ theorem machineExpStepsRuler_mem_FP : machineExpStepsRuler ∈ Complexity.FP := by have hpair := machinePair_mem_FP machineExpGuard_mem_FP machineExpStepsBits_mem_FP - simpa only [machineExpStepsRuler] using + simpa only [machineExpStepsRuler] using! machineCompose_mem_FP hpair machineBoundedUnary_mem_FP theorem machineExpStepsRawRatCode_mem_FP : @@ -174,32 +174,32 @@ theorem machineExpScaledArgumentCode_mem_FP : machineExpScaledArgumentCode ∈ Complexity.FP := by have hpair := machinePair_mem_FP machineExpArgumentCode_mem_FP machineExpStepsRawRatCode_mem_FP - simpa only [machineExpScaledArgumentCode] using + simpa only [machineExpScaledArgumentCode] using! machineCompose_mem_FP hpair machineRawRatDivCode_mem_FP theorem machineExpBaseCode_mem_FP : machineExpBaseCode ∈ Complexity.FP := by have hpair := machinePair_mem_FP (machineConst_mem_FP rawRatOneCode) machineExpScaledArgumentCode_mem_FP - simpa only [machineExpBaseCode] using + simpa only [machineExpBaseCode] using! machineCompose_mem_FP hpair machineRawRatAddCode_mem_FP theorem machineBoundedRationalExpLowerCode_mem_FP : machineBoundedRationalExpLowerCode ∈ Complexity.FP := by have hpair := machinePair_mem_FP machineExpStepsRuler_mem_FP machineExpBaseCode_mem_FP - simpa only [machineBoundedRationalExpLowerCode] using + simpa only [machineBoundedRationalExpLowerCode] using! machineCompose_mem_FP hpair machineRationalPowerCode_mem_FP theorem machineBoundedRationalExpLowerRawPowerCode_mem_FP : machineBoundedRationalExpLowerRawPowerCode ∈ Complexity.FP := by have hpair := machinePair_mem_FP machineExpStepsRuler_mem_FP machineExpBaseCode_mem_FP - simpa only [machineBoundedRationalExpLowerRawPowerCode] using + simpa only [machineBoundedRationalExpLowerRawPowerCode] using! machineCompose_mem_FP hpair machineRawRatPowerCode_mem_FP theorem machineBoundedRationalExpLowerRawEntryCode_mem_FP : machineBoundedRationalExpLowerRawEntryCode ∈ Complexity.FP := by - simpa only [machineBoundedRationalExpLowerRawEntryCode] using + simpa only [machineBoundedRationalExpLowerRawEntryCode] using! machineCompose_mem_FP machineBoundedRationalExpLowerRawPowerCode_mem_FP machineNormalizeRawRatEntryCode_mem_FP @@ -256,7 +256,7 @@ end RawRat machineExpArgumentCode, machineExpPayload, rawRatBinaryCode, integerBinaryCode, machinePairSecond_pair, machinePairFirst_pair, machineHeadBit_cons, machineIfHead_true, RawRat.expMagnitude] - simpa only [rawRatBinaryCode] using + simpa only [rawRatBinaryCode] using! (machineRawRatNegCode_encode (⟨Int.negSucc n, den, hden⟩ : RawRat)) diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalFloor.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalFloor.lean index a30095be0b..3176f0d80d 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalFloor.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalFloor.lean @@ -42,25 +42,25 @@ def machineRationalCeilNatBits (word : List Bool) : List Bool := theorem machineRationalFloorIntegerCode_mem_FP : machineRationalFloorIntegerCode ∈ Complexity.FP := by have hpair := machinePair_mem_FP (machineConst_mem_FP []) id_mem_FP - simpa only [machineRationalFloorIntegerCode] using + simpa only [machineRationalFloorIntegerCode] using! machineCompose_mem_FP hpair machineDyadicFloorIntegerCode_mem_FP theorem machineRationalCeilIntegerCode_mem_FP : machineRationalCeilIntegerCode ∈ Complexity.FP := by have hneg := machineCompose_mem_FP machineRawRatNegCode_mem_FP machineRationalFloorIntegerCode_mem_FP - simpa only [machineRationalCeilIntegerCode] using + simpa only [machineRationalCeilIntegerCode] using! machineCompose_mem_FP hneg machineIntegerNegCode_mem_FP theorem machineIntegerToNatBits_mem_FP : machineIntegerToNatBits ∈ Complexity.FP := by - simpa only [machineIntegerToNatBits] using + simpa only [machineIntegerToNatBits] using! machineIfHead_mem_FP id_mem_FP (machineConst_mem_FP []) machineTail_mem_FP theorem machineRationalCeilNatBits_mem_FP : machineRationalCeilNatBits ∈ Complexity.FP := by - simpa only [machineRationalCeilNatBits] using + simpa only [machineRationalCeilNatBits] using! machineCompose_mem_FP machineRationalCeilIntegerCode_mem_FP machineIntegerToNatBits_mem_FP @@ -73,7 +73,7 @@ theorem machineRationalFloorIntegerCode_encode (q : RawRat) : machineRationalFloorIntegerCode (rawRatBinaryCode q) = integerBinaryCode (binaryRatFloor q.value) := by rw [machineRationalFloorIntegerCode] - simpa only [List.replicate_zero] using + simpa only [List.replicate_zero] using! (machineDyadicFloorIntegerCode_encode 0 q).trans (congrArg integerBinaryCode (binaryRawFloorInt_eq_binaryRatFloor q)) diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalLogSeries.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalLogSeries.lean index 6fe087f38a..d6993d758f 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalLogSeries.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalLogSeries.lean @@ -121,14 +121,14 @@ theorem machineLogSeriesSumField_mem_FP : theorem machineLogSeriesPowerField_mem_FP : machineLogSeriesPowerField ∈ Complexity.FP := by - simpa only [machineLogSeriesPowerField] using + simpa only [machineLogSeriesPowerField] using! machineCompose_mem_FP machinePairSecond_mem_FP machinePairFirst_mem_FP theorem machineLogSeriesSquareField_mem_FP : machineLogSeriesSquareField ∈ Complexity.FP := by have hrest := machineCompose_mem_FP machinePairSecond_mem_FP machinePairSecond_mem_FP - simpa only [machineLogSeriesSquareField] using + simpa only [machineLogSeriesSquareField] using! machineCompose_mem_FP hrest machinePairFirst_mem_FP theorem machineLogSeriesOddField_mem_FP : @@ -136,7 +136,7 @@ theorem machineLogSeriesOddField_mem_FP : have hrest2 := machineCompose_mem_FP machinePairSecond_mem_FP machinePairSecond_mem_FP have hrest3 := machineCompose_mem_FP hrest2 machinePairSecond_mem_FP - simpa only [machineLogSeriesOddField] using + simpa only [machineLogSeriesOddField] using! machineCompose_mem_FP hrest3 machinePairFirst_mem_FP theorem machineLogSeriesBoundField_mem_FP : @@ -144,7 +144,7 @@ theorem machineLogSeriesBoundField_mem_FP : have hrest2 := machineCompose_mem_FP machinePairSecond_mem_FP machinePairSecond_mem_FP have hrest3 := machineCompose_mem_FP hrest2 machinePairSecond_mem_FP - simpa only [machineLogSeriesBoundField] using + simpa only [machineLogSeriesBoundField] using! machineCompose_mem_FP hrest3 machinePairSecond_mem_FP theorem machineLogSeriesOddRawRatCode_mem_FP : @@ -157,34 +157,34 @@ theorem machineLogSeriesTermCandidate_mem_FP : machineLogSeriesTermCandidate ∈ Complexity.FP := by have hpair := machinePair_mem_FP machineLogSeriesPowerField_mem_FP machineLogSeriesOddRawRatCode_mem_FP - simpa only [machineLogSeriesTermCandidate] using + simpa only [machineLogSeriesTermCandidate] using! machineCompose_mem_FP hpair machineRawRatDivCode_mem_FP theorem machineLogSeriesSumCandidate_mem_FP : machineLogSeriesSumCandidate ∈ Complexity.FP := by have hpair := machinePair_mem_FP machineLogSeriesSumField_mem_FP machineLogSeriesTermCandidate_mem_FP - simpa only [machineLogSeriesSumCandidate] using + simpa only [machineLogSeriesSumCandidate] using! machineCompose_mem_FP hpair machineRawRatAddCode_mem_FP theorem machineLogSeriesPowerCandidate_mem_FP : machineLogSeriesPowerCandidate ∈ Complexity.FP := by have hpair := machinePair_mem_FP machineLogSeriesPowerField_mem_FP machineLogSeriesSquareField_mem_FP - simpa only [machineLogSeriesPowerCandidate] using + simpa only [machineLogSeriesPowerCandidate] using! machineCompose_mem_FP hpair machineRawRatMulCode_mem_FP theorem machineLogSeriesOddCandidate_mem_FP : machineLogSeriesOddCandidate ∈ Complexity.FP := by have hpair := machinePair_mem_FP machineLogSeriesOddField_mem_FP (machineConst_mem_FP [false, true]) - simpa only [machineLogSeriesOddCandidate] using + simpa only [machineLogSeriesOddCandidate] using! machineCompose_mem_FP hpair machineBinaryAddBits_mem_FP theorem machineLogSeriesClamp_mem_FP {candidate : List Bool → List Bool} (hcandidate : candidate ∈ Complexity.FP) : (fun state => machineLogSeriesClamp candidate state) ∈ Complexity.FP := by - simpa only [machineLogSeriesClamp] using + simpa only [machineLogSeriesClamp] using! machineTake_mem_FP machineLogSeriesBoundField_mem_FP hcandidate theorem machineLogSeriesStep_mem_FP : @@ -206,7 +206,7 @@ theorem machineLogSeriesInputBase_mem_FP : theorem machineLogSeriesInputBound_mem_FP : machineLogSeriesInputBound ∈ Complexity.FP := by - simpa only [machineLogSeriesInputBound] using + simpa only [machineLogSeriesInputBound] using! machineCompose_mem_FP machineBinaryMulWidth_mem_FP machineBinaryMulWidth_mem_FP @@ -214,7 +214,7 @@ theorem machineLogSeriesInitialSquareCandidate_mem_FP : machineLogSeriesInitialSquareCandidate ∈ Complexity.FP := by have hpair := machinePair_mem_FP machineLogSeriesInputBase_mem_FP machineLogSeriesInputBase_mem_FP - simpa only [machineLogSeriesInitialSquareCandidate] using + simpa only [machineLogSeriesInitialSquareCandidate] using! machineCompose_mem_FP hpair machineRawRatMulCode_mem_FP theorem machineLogSeriesInit_mem_FP : machineLogSeriesInit ∈ Complexity.FP := by @@ -222,7 +222,7 @@ theorem machineLogSeriesInit_mem_FP : machineLogSeriesInit ∈ Complexity.FP := machineLogSeriesInputBase_mem_FP have hsquare := machineTake_mem_FP machineLogSeriesInputBound_mem_FP machineLogSeriesInitialSquareCandidate_mem_FP - simpa only [machineLogSeriesInit, machineLogSeriesPack] using + simpa only [machineLogSeriesInit, machineLogSeriesPack] using! machinePair_mem_FP (machineConst_mem_FP rawRatZeroCode) (machinePair_mem_FP hbase (machinePair_mem_FP hsquare @@ -349,13 +349,13 @@ theorem machineLogSeriesFinalState_mem_FP : theorem machineRawRationalLogSeriesSumCode_mem_FP : machineRawRationalLogSeriesSumCode ∈ Complexity.FP := by - simpa only [machineRawRationalLogSeriesSumCode] using + simpa only [machineRawRationalLogSeriesSumCode] using! machineCompose_mem_FP machineLogSeriesFinalState_mem_FP machineLogSeriesSumField_mem_FP theorem machineRationalLogSeriesSumCode_mem_FP : machineRationalLogSeriesSumCode ∈ Complexity.FP := by - simpa only [machineRationalLogSeriesSumCode] using + simpa only [machineRationalLogSeriesSumCode] using! machineCompose_mem_FP machineRawRationalLogSeriesSumCode_mem_FP machineNormalizeRawRatBinaryCode_mem_FP @@ -461,7 +461,7 @@ private theorem logSeriesIntegerNatAbs_size_le_code_length (z : ℤ) : omega exact hle.trans_lt hlt simpa [integerBinaryCode, Nat.size_eq_bits_len, - Nat.add_comm] using hs + Nat.add_comm] using! hs private theorem logSeriesRawRatWidth_le_code_length (q : RawRat) : rawRatWidth q ≤ (rawRatBinaryCode q).length := by @@ -489,12 +489,12 @@ private theorem logSeriesRawRatCode_length_le_width (q : RawRat) : have hsize : n.size ≤ (n + 1).size := Nat.size_le_size (Nat.le_succ n) have habs : (n + 1).size ≤ rawRatWidth q := by - simpa only [hqnum, Int.natAbs_negSucc] using + simpa only [hqnum, Int.natAbs_negSucc] using! rawRat_num_size_le_width q omega have hden := rawRat_den_size_le_width q have hdenbits : q.den.bits.length ≤ rawRatWidth q := by - simpa only [Nat.size_eq_bits_len] using hden + simpa only [Nat.size_eq_bits_len] using! hden omega private theorem logSeriesCode_length_le_inputBound @@ -576,7 +576,7 @@ private theorem logSeriesOddBits_length_le_inputBound rw [rawRatWidth, RawRat.ofNat] at hw simp only [Int.natAbs_ofNat', Nat.size_one] at hw have hs := (le_max_left (2 * k + 1).size 1).trans hw - simpa only [Nat.size_eq_bits_len] using hs + simpa only [Nat.size_eq_bits_len] using! hs let word := pair (List.replicate total true) (rawRatBinaryCode q) have htotal : total ≤ word.length := by simp only [word, pair_length, List.length_replicate] @@ -604,7 +604,7 @@ theorem machineLogSeriesInit_encode (q : RawRat) (total : ℕ) : let word := pair (List.replicate total true) (rawRatBinaryCode q) have hbase : (rawRatBinaryCode q).length ≤ (machineLogSeriesInputBound word).length := by - simpa only [RawRat.logOddPower] using + simpa only [RawRat.logOddPower] using! logSeriesPowerCode_length_le_inputBound q total 0 (by omega) have hsquare := logSeriesSquareCode_length_le_inputBound q total rw [machineLogSeriesInit] diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalMatrixColumn.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalMatrixColumn.lean index 283bdef1fc..cdd6059902 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalMatrixColumn.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalMatrixColumn.lean @@ -113,12 +113,12 @@ theorem machineRationalMatrixColumnRemaining_mem_FP : theorem machineRationalMatrixColumnAccumulator_mem_FP : machineRationalMatrixColumnAccumulator ∈ FP := by - simpa only [machineRationalMatrixColumnAccumulator] using + simpa only [machineRationalMatrixColumnAccumulator] using! machineCompose_mem_FP machinePairSecond_mem_FP machinePairFirst_mem_FP theorem machineRationalMatrixColumnColumn_mem_FP : machineRationalMatrixColumnColumn ∈ FP := by - simpa only [machineRationalMatrixColumnColumn] using + simpa only [machineRationalMatrixColumnColumn] using! machineCompose_mem_FP (machineCompose_mem_FP machinePairSecond_mem_FP machinePairSecond_mem_FP) @@ -126,7 +126,7 @@ theorem machineRationalMatrixColumnColumn_mem_FP : theorem machineRationalMatrixColumnBound_mem_FP : machineRationalMatrixColumnBound ∈ FP := by - simpa only [machineRationalMatrixColumnBound] using + simpa only [machineRationalMatrixColumnBound] using! machineCompose_mem_FP (machineCompose_mem_FP machinePairSecond_mem_FP machinePairSecond_mem_FP) @@ -134,7 +134,7 @@ theorem machineRationalMatrixColumnBound_mem_FP : theorem machineRationalMatrixColumnCurrentRow_mem_FP : machineRationalMatrixColumnCurrentRow ∈ FP := by - simpa only [machineRationalMatrixColumnCurrentRow] using + simpa only [machineRationalMatrixColumnCurrentRow] using! machineCompose_mem_FP machineRationalMatrixColumnRemaining_mem_FP machineListHead_mem_FP @@ -142,7 +142,7 @@ theorem machineRationalMatrixColumnCurrentEntry_mem_FP : machineRationalMatrixColumnCurrentEntry ∈ FP := by have hp := machinePair_mem_FP machineRationalMatrixColumnColumn_mem_FP machineRationalMatrixColumnCurrentRow_mem_FP - simpa only [machineRationalMatrixColumnCurrentEntry] using + simpa only [machineRationalMatrixColumnCurrentEntry] using! machineCompose_mem_FP hp machineListIndex_mem_FP theorem machineRationalMatrixColumnCandidate_mem_FP : @@ -152,7 +152,7 @@ theorem machineRationalMatrixColumnCandidate_mem_FP : theorem machineRationalMatrixColumnNextAccumulator_mem_FP : machineRationalMatrixColumnNextAccumulator ∈ FP := by - simpa only [machineRationalMatrixColumnNextAccumulator] using + simpa only [machineRationalMatrixColumnNextAccumulator] using! machineTake_mem_FP machineRationalMatrixColumnBound_mem_FP machineRationalMatrixColumnCandidate_mem_FP @@ -288,13 +288,13 @@ theorem machineRationalMatrixColumnFinalState_mem_FP : theorem machineRationalMatrixColumnReversedCode_mem_FP : machineRationalMatrixColumnReversedCode ∈ FP := by - simpa only [machineRationalMatrixColumnReversedCode] using + simpa only [machineRationalMatrixColumnReversedCode] using! machineCompose_mem_FP machineRationalMatrixColumnFinalState_mem_FP machineRationalMatrixColumnAccumulator_mem_FP theorem machineRationalMatrixColumnCode_mem_FP : machineRationalMatrixColumnCode ∈ FP := by - simpa only [machineRationalMatrixColumnCode] using + simpa only [machineRationalMatrixColumnCode] using! machineCompose_mem_FP machineRationalMatrixColumnReversedCode_mem_FP machineListReverse_mem_FP @@ -316,7 +316,7 @@ theorem rationalEntryCode_getD_length_le have hencode := machineListIndex_binaryListCode rationalEntryBinaryCode row j hj rw [hencode, machineListIndexData, machinePairSecond_pair] at hlength - simpa only [List.getD_eq_getElem row 0 hj] using hlength + simpa only [List.getD_eq_getElem row 0 hj] using! hlength theorem rationalColumnOfRows_code_length_le (j : ℕ) : ∀ rows : List (List ℚ), @@ -340,7 +340,7 @@ theorem rationalColumnOfRows_code_length_le ((rows.map fun r => r.getD j 0))).length ≤ (binaryListCode (binaryListCode rationalEntryBinaryCode) rows).length := by - simpa only [rationalColumnOfRows] using hrec + simpa only [rationalColumnOfRows] using! hrec change (pair (rationalEntryBinaryCode (row.getD j 0)) (binaryListCode rationalEntryBinaryCode @@ -405,8 +405,8 @@ theorem machineRationalMatrixColumnStep_semantics simp only [rationalColumnOfRows, List.map_take] have hkm : k < (rows.map fun row => row.getD j 0).length := by - simpa using hk - simpa using + simpa using! hk + simpa using! (List.take_concat_get (l := rows.map fun row => row.getD j 0) hkm).symm have hreverse : @@ -433,7 +433,7 @@ theorem machineRationalMatrixColumnStep_semantics (binaryListCode rationalEntryBinaryCode (rationalColumnOfRows (rows.take k) j).reverse)).length ≤ bound.length := by - simpa only [hreverse, binaryListCode] using hcand + simpa only [hreverse, binaryListCode] using! hcand rw [machineRationalMatrixColumnStep] simp only [machineRationalMatrixColumnSemanticState, machineRationalMatrixColumnRemaining_pack] @@ -476,7 +476,7 @@ theorem machineRationalMatrixColumnIterate_semantics _ ≤ word.length := machinePairSecond_length_le word induction k with | zero => - simpa only [word] using + simpa only [word] using! (machineRationalMatrixColumnInit_semantics rows j) | succ k ih => rw [Function.iterate_succ_apply', ih (by omega)] @@ -558,7 +558,7 @@ theorem rationalColumnOfRows_matrix {d : ℕ} simp only [rationalColumnOfRows, rationalMatrixRows, List.getElem_map, List.getElem_ofFn] have hj : j.1 < - (List.ofFn fun j' : Fin d => A ⟨i, by simpa using hiRight⟩ j').length := by + (List.ofFn fun j' : Fin d => A ⟨i, by simpa using! hiRight⟩ j').length := by simp rw [List.getD_eq_getElem _ _ hj] simp @@ -600,7 +600,7 @@ theorem machineRationalMatrixTransposeMulVectorEntryCode_mem_FP : have hcolumnCode := machineCompose_mem_FP hcolumnInput machineRationalMatrixColumnCode_mem_FP have hdotInput := machinePair_mem_FP hcolumnCode hvector - simpa only [machineRationalMatrixTransposeMulVectorEntryCode] using + simpa only [machineRationalMatrixTransposeMulVectorEntryCode] using! machineCompose_mem_FP hdotInput machineRationalVectorDotEntryCode_mem_FP diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalMatrixMul.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalMatrixMul.lean index b9976f0955..a360026cc6 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalMatrixMul.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalMatrixMul.lean @@ -68,13 +68,13 @@ theorem machineRationalMatrixMulMatrices_mem_FP : theorem machineRationalMatrixMulLeftRows_mem_FP : machineRationalMatrixMulLeftRows ∈ FP := by - simpa only [machineRationalMatrixMulLeftRows] using + simpa only [machineRationalMatrixMulLeftRows] using! machineCompose_mem_FP machineRationalMatrixMulMatrices_mem_FP machinePairFirst_mem_FP theorem machineRationalMatrixMulRightRows_mem_FP : machineRationalMatrixMulRightRows ∈ FP := by - simpa only [machineRationalMatrixMulRightRows] using + simpa only [machineRationalMatrixMulRightRows] using! machineCompose_mem_FP machineRationalMatrixMulMatrices_mem_FP machinePairSecond_mem_FP @@ -92,7 +92,7 @@ theorem machineRationalMatrixMulRowCode_mem_FP : machineRationalMatrixMulRightRows_mem_FP have hinput := machinePair_mem_FP hdim (machinePair_mem_FP hrightRows hleftRow) - simpa only [machineRationalMatrixMulRowCode] using + simpa only [machineRationalMatrixMulRowCode] using! machineCompose_mem_FP hinput machineRationalTransposeMulVectorCode_mem_FP theorem rationalTransposeMulVector_row_eq_matrixMul {d : ℕ} @@ -158,11 +158,11 @@ theorem rawRationalMatrixMulCoordinate_width_le_word {d : ℕ} (binaryListCode rationalEntryBinaryCode) (show row ∈ rationalMatrixRows A by simp [rationalMatrixRows, row]) - simpa only [rationalSquareMatrixRowsCode] using helem + simpa only [rationalSquareMatrixRowsCode] using! helem have hcolumn : (binaryListCode rationalEntryBinaryCode column).length ≤ (rationalSquareMatrixRowsCode B).length := by - simpa only [column, rationalSquareMatrixRowsCode] using + simpa only [column, rationalSquareMatrixRowsCode] using! rationalColumnOfRows_code_length_le j.1 (rationalMatrixRows B) (rationalMatrixRows_haveColumn B j) have hcombined : @@ -244,13 +244,13 @@ theorem rationalMatrixMul_code_length_le_bound {d : ℕ} have hd : d ≤ word.length := by have h := machinePairFirst_length_le word simpa only [word, rationalMatrixMulCanonicalWord, - machinePairFirst_pair, List.length_replicate] using h + machinePairFirst_pair, List.length_replicate] using! h have hn4 : 4 ≤ n := by simp only [n, word, rationalMatrixMulCanonicalWord, pair_length, List.length_replicate] omega have hcubic := rationalMatrixMul_code_length_le_cubic A B - have hd' : d ≤ n := by simpa only [n] using hd + have hd' : d ≤ n := by simpa only [n] using! hd have hdn : d * n ≤ n * n := Nat.mul_le_mul hd' le_rfl have hdd : d * d ≤ n * n := Nat.mul_le_mul hd' hd' have hddn : (d * d) * n ≤ (n * n) * n := @@ -263,7 +263,7 @@ theorem rationalMatrixMul_code_length_le_bound {d : ℕ} (rationalSquareMatrixRowsCode (rationalMatrixMul A B)).length ≤ 211 * n ^ 3 := by apply hcubic.trans - simpa only [n, word] using hpoly + simpa only [n, word] using! hpoly have hnx : n ≤ x := by simp [x] have hxpos : 0 < x := by omega have h211 : 211 ≤ x ^ 2 := by @@ -273,18 +273,18 @@ theorem rationalMatrixMul_code_length_le_bound {d : ℕ} have hto5 : 211 * n ^ 3 ≤ x ^ 5 := by have h := Nat.mul_le_mul h211 hnx3 simpa only [pow_succ, pow_two, mul_assoc, mul_left_comm, - mul_comm] using h + mul_comm] using! h have hto8 : x ^ 5 ≤ x ^ 8 := Nat.pow_le_pow_right hxpos (by omega) have hxy : x ^ 2 ≤ y := by simp [y] have hx4y2 : x ^ 4 ≤ y ^ 2 := by have h := Nat.pow_le_pow_left hxy 2 - simpa only [← pow_mul] using h + simpa only [← pow_mul] using! h have hyz : y ^ 2 ≤ z := by simp [z] have hx4z : x ^ 4 ≤ z := hx4y2.trans hyz have hx8z2 : x ^ 8 ≤ z ^ 2 := by have h := Nat.pow_le_pow_left hx4z 2 - simpa only [← pow_mul] using h + simpa only [← pow_mul] using! h apply hout.trans apply hto5.trans apply hto8.trans @@ -347,7 +347,7 @@ def machineRationalMatrixMulCode (word : List Bool) : List Bool := theorem machineRationalMatrixMulIndices_mem_FP : machineRationalMatrixMulIndices ∈ FP := by - simpa only [machineRationalMatrixMulIndices] using + simpa only [machineRationalMatrixMulIndices] using! machineCompose_mem_FP machineRationalMatrixMulDimensionUnary_mem_FP machineUnaryRangeCode_mem_FP @@ -356,7 +356,7 @@ theorem machineRationalMatrixMulCurrentRow_mem_FP : have hinput := machinePair_mem_FP machineRationalTransposeMulVectorCurrentIndex_mem_FP machineRationalTransposeMulVectorStatePayload_mem_FP - simpa only [machineRationalMatrixMulCurrentRow] using + simpa only [machineRationalMatrixMulCurrentRow] using! machineCompose_mem_FP hinput machineRationalMatrixMulRowCode_mem_FP theorem machineRationalMatrixMulCandidate_mem_FP : @@ -366,7 +366,7 @@ theorem machineRationalMatrixMulCandidate_mem_FP : theorem machineRationalMatrixMulNextAccumulator_mem_FP : machineRationalMatrixMulNextAccumulator ∈ FP := by - simpa only [machineRationalMatrixMulNextAccumulator] using + simpa only [machineRationalMatrixMulNextAccumulator] using! machineTake_mem_FP machineRationalTransposeMulVectorBound_mem_FP machineRationalMatrixMulCandidate_mem_FP @@ -412,7 +412,7 @@ theorem machineRationalMatrixMulInit_bound (word : List Bool) : · simpa only [machineRationalMatrixMulIndices, machineRationalMatrixMulDimensionUnary, machineRationalTransposeMulVectorIndices, - machineRationalTransposeMulVectorDimension] using + machineRationalTransposeMulVectorDimension] using! machineRationalTransposeMulVector_indices_le_bound word · exact machineRationalTransposeMulVector_word_le_bound word @@ -477,13 +477,13 @@ theorem machineRationalMatrixMulFinalState_mem_FP : theorem machineRationalMatrixMulReversedCode_mem_FP : machineRationalMatrixMulReversedCode ∈ FP := by - simpa only [machineRationalMatrixMulReversedCode] using + simpa only [machineRationalMatrixMulReversedCode] using! machineCompose_mem_FP machineRationalMatrixMulFinalState_mem_FP machineRationalTransposeMulVectorAccumulator_mem_FP theorem machineRationalMatrixMulCode_mem_FP : machineRationalMatrixMulCode ∈ FP := by - simpa only [machineRationalMatrixMulCode] using + simpa only [machineRationalMatrixMulCode] using! machineCompose_mem_FP machineRationalMatrixMulReversedCode_mem_FP machineListReverse_mem_FP @@ -521,7 +521,7 @@ theorem rationalMatrixMulRowsPrefix_succ {d : ℕ} [List.ofFn fun j ↦ rationalMatrixMul A B ⟨k, hk⟩ j] := by simp only [rationalMatrixMulRowsPrefix, List.map_take] have hkm : k < (List.finRange d).length := by simpa - simpa [List.getElem_finRange] using + simpa [List.getElem_finRange] using! congrArg (List.map fun i ↦ List.ofFn fun j ↦ rationalMatrixMul A B i j) (List.take_concat_get hkm).symm @@ -569,7 +569,7 @@ theorem machineRationalMatrixMulStep_semantics {d : ℕ} (binaryListCode (binaryListCode rationalEntryBinaryCode) (rationalMatrixMulRowsPrefix A B k).reverse)).length ≤ (machineRationalMatrixMulInputBound word).length := by - simpa only [hreverse, binaryListCode] using hcand + simpa only [hreverse, binaryListCode] using! hcand have hnonempty : binaryListCode finUnaryCode ((List.finRange d).drop k) ≠ [] := by rw [hdrop] @@ -649,7 +649,7 @@ theorem machineRationalMatrixMulReversedCode_encode {d : ℕ} have hd : d ≤ word.length := by have h := machinePairFirst_length_le word simpa only [word, rationalMatrixMulCanonicalWord, - machinePairFirst_pair, List.length_replicate] using h + machinePairFirst_pair, List.length_replicate] using! h have hsplit : word.length = (word.length - d) + d := by omega change machineRationalMatrixMulReversedCode word = _ rw [machineRationalMatrixMulReversedCode, diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalMatrixMulVector.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalMatrixMulVector.lean index aa66a527a0..02b249ac64 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalMatrixMulVector.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalMatrixMulVector.lean @@ -44,7 +44,7 @@ theorem machineRationalMatrixMulVectorEntryCode_mem_FP : have hrowInput := machinePair_mem_FP hrow hmatrix have hrowCode := machineCompose_mem_FP hrowInput machineListIndex_mem_FP have hdotInput := machinePair_mem_FP hrowCode hvector - simpa only [machineRationalMatrixMulVectorEntryCode] using + simpa only [machineRationalMatrixMulVectorEntryCode] using! machineCompose_mem_FP hdotInput machineRationalVectorDotEntryCode_mem_FP @@ -107,7 +107,7 @@ theorem rawRationalMatrixCoordinate_width_le_word {d : ℕ} (binaryListCode rationalEntryBinaryCode) (show row ∈ rationalMatrixRows A by simp [rationalMatrixRows, row]) - simpa only [rationalMatrixRows, List.getElem_ofFn, row] using helem + simpa only [rationalMatrixRows, List.getElem_ofFn, row] using! helem have hcombined : 1 + (binaryListCode (binaryListCode rationalEntryBinaryCode) (rationalMatrixRows A)).length + @@ -153,7 +153,7 @@ theorem rationalMatrixMulVector_code_length_le_bound {d : ℕ} have hdim : d ≤ word.length := by have hfirst := machinePairFirst_length_le word simpa only [word, rationalMatrixMulVectorCanonicalWord, - machinePairFirst_pair, List.length_replicate] using hfirst + machinePairFirst_pair, List.length_replicate] using! hfirst have heach : ∀ q ∈ List.ofFn (rationalMatrixMulVector A v), (rationalEntryBinaryCode q).length ≤ B := by intro q hq @@ -235,7 +235,7 @@ theorem machineRationalMatrixMulVectorCurrentEntry_mem_FP : have hp := machinePair_mem_FP machineRationalTransposeMulVectorCurrentIndex_mem_FP machineRationalTransposeMulVectorStatePayload_mem_FP - simpa only [machineRationalMatrixMulVectorCurrentEntry] using + simpa only [machineRationalMatrixMulVectorCurrentEntry] using! machineCompose_mem_FP hp machineRationalMatrixMulVectorEntryCode_mem_FP @@ -246,7 +246,7 @@ theorem machineRationalMatrixMulVectorCandidate_mem_FP : theorem machineRationalMatrixMulVectorNextAccumulator_mem_FP : machineRationalMatrixMulVectorNextAccumulator ∈ FP := by - simpa only [machineRationalMatrixMulVectorNextAccumulator] using + simpa only [machineRationalMatrixMulVectorNextAccumulator] using! machineTake_mem_FP machineRationalTransposeMulVectorBound_mem_FP machineRationalMatrixMulVectorCandidate_mem_FP @@ -306,7 +306,7 @@ theorem machineRationalMatrixMulVectorIterate_bound intro k induction k with | zero => - simpa only [machineRationalMatrixMulVectorInit] using + simpa only [machineRationalMatrixMulVectorInit] using! machineRationalTransposeMulVectorInit_bound word | succ k ih => rw [Function.iterate_succ_apply'] @@ -335,13 +335,13 @@ theorem machineRationalMatrixMulVectorFinalState_mem_FP : theorem machineRationalMatrixMulVectorReversedCode_mem_FP : machineRationalMatrixMulVectorReversedCode ∈ FP := by - simpa only [machineRationalMatrixMulVectorReversedCode] using + simpa only [machineRationalMatrixMulVectorReversedCode] using! machineCompose_mem_FP machineRationalMatrixMulVectorFinalState_mem_FP machineRationalTransposeMulVectorAccumulator_mem_FP theorem machineRationalMatrixMulVectorCode_mem_FP : machineRationalMatrixMulVectorCode ∈ FP := by - simpa only [machineRationalMatrixMulVectorCode] using + simpa only [machineRationalMatrixMulVectorCode] using! machineCompose_mem_FP machineRationalMatrixMulVectorReversedCode_mem_FP machineListReverse_mem_FP @@ -390,7 +390,7 @@ theorem rationalMatrixMulVectorPrefix_succ {d : ℕ} [rationalMatrixMulVector A v ⟨k, hk⟩] := by simp only [rationalMatrixMulVectorPrefix, List.map_take] have hkm : k < (List.finRange d).length := by simpa - simpa [List.getElem_finRange] using + simpa [List.getElem_finRange] using! congrArg (List.map fun i ↦ rationalMatrixMulVector A v i) (List.take_concat_get hkm).symm @@ -437,7 +437,7 @@ theorem machineRationalMatrixMulVectorStep_semantics {d : ℕ} (binaryListCode rationalEntryBinaryCode (rationalMatrixMulVectorPrefix A v k).reverse)).length ≤ (machineRationalMatrixMulVectorInputBound word).length := by - simpa only [hreverse, binaryListCode] using hcand + simpa only [hreverse, binaryListCode] using! hcand have hnonempty : binaryListCode finUnaryCode ((List.finRange d).drop k) ≠ [] := by rw [hdrop] @@ -519,7 +519,7 @@ theorem machineRationalMatrixMulVectorReversedCode_encode {d : ℕ} have hd : d ≤ word.length := by have h := machinePairFirst_length_le word simpa only [word, rationalMatrixMulVectorCanonicalWord, - machinePairFirst_pair, List.length_replicate] using h + machinePairFirst_pair, List.length_replicate] using! h have hsplit : word.length = (word.length - d) + d := by omega change machineRationalMatrixMulVectorReversedCode word = _ rw [machineRationalMatrixMulVectorReversedCode, diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalMatrixUpdate.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalMatrixUpdate.lean index 6f4c6acd0d..37c07f7ca2 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalMatrixUpdate.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalMatrixUpdate.lean @@ -72,31 +72,31 @@ theorem machineRationalMatrixUpdateRest_mem_FP : theorem machineRationalMatrixUpdateColumn_mem_FP : machineRationalMatrixUpdateColumn ∈ Complexity.FP := by - simpa only [machineRationalMatrixUpdateColumn] using + simpa only [machineRationalMatrixUpdateColumn] using! machineCompose_mem_FP machineRationalMatrixUpdateRest_mem_FP machinePairFirst_mem_FP theorem machineRationalMatrixUpdatePayload_mem_FP : machineRationalMatrixUpdatePayload ∈ Complexity.FP := by - simpa only [machineRationalMatrixUpdatePayload] using + simpa only [machineRationalMatrixUpdatePayload] using! machineCompose_mem_FP machineRationalMatrixUpdateRest_mem_FP machinePairSecond_mem_FP theorem machineRationalMatrixUpdateReplacement_mem_FP : machineRationalMatrixUpdateReplacement ∈ Complexity.FP := by - simpa only [machineRationalMatrixUpdateReplacement] using + simpa only [machineRationalMatrixUpdateReplacement] using! machineCompose_mem_FP machineRationalMatrixUpdatePayload_mem_FP machinePairFirst_mem_FP theorem machineRationalMatrixUpdateMatrix_mem_FP : machineRationalMatrixUpdateMatrix ∈ Complexity.FP := by - simpa only [machineRationalMatrixUpdateMatrix] using + simpa only [machineRationalMatrixUpdateMatrix] using! machineCompose_mem_FP machineRationalMatrixUpdatePayload_mem_FP machinePairSecond_mem_FP theorem machineRationalMatrixUpdateRows_mem_FP : machineRationalMatrixUpdateRows ∈ Complexity.FP := by - simpa only [machineRationalMatrixUpdateRows] using + simpa only [machineRationalMatrixUpdateRows] using! machineCompose_mem_FP machineRationalMatrixUpdateMatrix_mem_FP machineMatrixRowsWord_mem_FP @@ -104,7 +104,7 @@ theorem machineRationalMatrixUpdateCurrentRow_mem_FP : machineRationalMatrixUpdateCurrentRow ∈ Complexity.FP := by have hinput := machinePair_mem_FP machineRationalMatrixUpdateRow_mem_FP machineRationalMatrixUpdateRows_mem_FP - simpa only [machineRationalMatrixUpdateCurrentRow] using + simpa only [machineRationalMatrixUpdateCurrentRow] using! machineCompose_mem_FP hinput machineListIndex_mem_FP theorem machineRationalMatrixUpdateNewRow_mem_FP : @@ -114,7 +114,7 @@ theorem machineRationalMatrixUpdateNewRow_mem_FP : machineRationalMatrixUpdateCurrentRow_mem_FP have hinput := machinePair_mem_FP machineRationalMatrixUpdateColumn_mem_FP hpayload - simpa only [machineRationalMatrixUpdateNewRow] using + simpa only [machineRationalMatrixUpdateNewRow] using! machineCompose_mem_FP hinput machineListUpdate_mem_FP theorem machineRationalMatrixUpdateNewRows_mem_FP : @@ -123,7 +123,7 @@ theorem machineRationalMatrixUpdateNewRows_mem_FP : machineRationalMatrixUpdateRows_mem_FP have hinput := machinePair_mem_FP machineRationalMatrixUpdateRow_mem_FP hpayload - simpa only [machineRationalMatrixUpdateNewRows] using + simpa only [machineRationalMatrixUpdateNewRows] using! machineCompose_mem_FP hinput machineListUpdate_mem_FP theorem machineRationalMatrixUpdateAtUnary_mem_FP : diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalMin.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalMin.lean index d6b6c06c4c..03461d022b 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalMin.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalMin.lean @@ -34,7 +34,7 @@ theorem machineRawRatMinCode_mem_FP : theorem machineRationalMinCode_mem_FP : machineRationalMinCode ∈ Complexity.FP := by - simpa only [machineRationalMinCode] using + simpa only [machineRationalMinCode] using! machineCompose_mem_FP machineRawRatMinCode_mem_FP machineNormalizeRawRatBinaryCode_mem_FP diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalNormalization.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalNormalization.lean index 52832fd7fc..ebd58e9eba 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalNormalization.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalNormalization.lean @@ -51,7 +51,7 @@ def machineNormalizeRawRatBinaryCode (word : List Bool) : List Bool := theorem machineRawRatNatAbsBits_mem_FP : machineRawRatNatAbsBits ∈ Complexity.FP := by - simpa only [machineRawRatNatAbsBits] using + simpa only [machineRawRatNatAbsBits] using! machineCompose_mem_FP machinePairFirst_mem_FP machineIntegerNatAbsBits_mem_FP @@ -61,7 +61,7 @@ theorem machineRawRatGcdBits_mem_FP : (machinePairSecond word)) ∈ Complexity.FP := machinePair_mem_FP machineRawRatNatAbsBits_mem_FP machinePairSecond_mem_FP - simpa only [machineRawRatGcdBits] using + simpa only [machineRawRatGcdBits] using! machineCompose_mem_FP hpair machineBinaryGcdBits_mem_FP theorem machineRawRatAbsQuotientBits_mem_FP : @@ -71,7 +71,7 @@ theorem machineRawRatAbsQuotientBits_mem_FP : machinePair_mem_FP machineRawRatNatAbsBits_mem_FP machineRawRatGcdBits_mem_FP have hdiv := machineCompose_mem_FP hpair machineBinaryDivModBits_mem_FP - simpa only [machineRawRatAbsQuotientBits] using + simpa only [machineRawRatAbsQuotientBits] using! machineCompose_mem_FP hdiv machinePairFirst_mem_FP theorem machineRawRatDenQuotientBits_mem_FP : @@ -80,7 +80,7 @@ theorem machineRawRatDenQuotientBits_mem_FP : (machineRawRatGcdBits word)) ∈ Complexity.FP := machinePair_mem_FP machinePairSecond_mem_FP machineRawRatGcdBits_mem_FP have hdiv := machineCompose_mem_FP hpair machineBinaryDivModBits_mem_FP - simpa only [machineRawRatDenQuotientBits] using + simpa only [machineRawRatDenQuotientBits] using! machineCompose_mem_FP hdiv machinePairFirst_mem_FP theorem machineNormalizeRawRatEntryCode_mem_FP : @@ -91,12 +91,12 @@ theorem machineNormalizeRawRatEntryCode_mem_FP : machineRawRatAbsQuotientBits_mem_FP have hsigned := machineCompose_mem_FP hsignedPair machineIntegerCodeFromSignedAbs_mem_FP - simpa only [machineNormalizeRawRatEntryCode] using + simpa only [machineNormalizeRawRatEntryCode] using! machinePair_mem_FP hsigned machineRawRatDenQuotientBits_mem_FP theorem machineNormalizeRawRatBinaryCode_mem_FP : machineNormalizeRawRatBinaryCode ∈ Complexity.FP := by - simpa only [machineNormalizeRawRatBinaryCode] using + simpa only [machineNormalizeRawRatBinaryCode] using! machineCompose_mem_FP machineNormalizeRawRatEntryCode_mem_FP machineRationalBinaryCode_mem_FP @@ -128,7 +128,7 @@ theorem machineRawRatDenQuotientBits_encode (q : RawRat) : have hg : machineRawRatGcdBits (pair (integerBinaryCode q.num) q.den.bits) = (Nat.gcd q.num.natAbs q.den).bits := by - simpa only [rawRatBinaryCode] using machineRawRatGcdBits_encode q + simpa only [rawRatBinaryCode] using! machineRawRatGcdBits_encode q rw [hg, machineBinaryDivModBits_pair_natBits] simp only [machinePairFirst_pair] @@ -146,12 +146,12 @@ theorem machineNormalizeRawRatEntryCode_encode (q : RawRat) : have habs : machineRawRatAbsQuotientBits (pair (integerBinaryCode q.num) q.den.bits) = (q.num.natAbs / Nat.gcd q.num.natAbs q.den).bits := by - simpa only [rawRatBinaryCode] using + simpa only [rawRatBinaryCode] using! machineRawRatAbsQuotientBits_encode q have hdenq : machineRawRatDenQuotientBits (pair (integerBinaryCode q.num) q.den.bits) = (q.den / Nat.gcd q.num.natAbs q.den).bits := by - simpa only [rawRatBinaryCode] using + simpa only [rawRatBinaryCode] using! machineRawRatDenQuotientBits_encode q rw [habs, hdenq] change pair diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalNormalizedDirection.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalNormalizedDirection.lean index 993731a221..21c591c294 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalNormalizedDirection.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalNormalizedDirection.lean @@ -33,7 +33,7 @@ theorem machineRationalNormalizedDirectionCode_mem_FP : machineRationalNormalizedDirectionCode ∈ FP := by have hinput := machinePair_mem_FP machineRationalVectorL1RawCode_mem_FP id_mem_FP - simpa only [machineRationalNormalizedDirectionCode] using + simpa only [machineRationalNormalizedDirectionCode] using! machineCompose_mem_FP hinput machineRationalRowDivide_mem_FP theorem rationalRowDivideValues_l1_ofFn {d : ℕ} diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalPower.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalPower.lean index 0cbd2e1992..07573424a3 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalPower.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalPower.lean @@ -81,24 +81,24 @@ theorem machineRawRatPowerAccField_mem_FP : theorem machineRawRatPowerBaseField_mem_FP : machineRawRatPowerBaseField ∈ Complexity.FP := by - simpa only [machineRawRatPowerBaseField] using + simpa only [machineRawRatPowerBaseField] using! machineCompose_mem_FP machinePairSecond_mem_FP machinePairFirst_mem_FP theorem machineRawRatPowerBoundField_mem_FP : machineRawRatPowerBoundField ∈ Complexity.FP := by - simpa only [machineRawRatPowerBoundField] using + simpa only [machineRawRatPowerBoundField] using! machineCompose_mem_FP machinePairSecond_mem_FP machinePairSecond_mem_FP theorem machineRawRatPowerCandidate_mem_FP : machineRawRatPowerCandidate ∈ Complexity.FP := by have hpair := machinePair_mem_FP machineRawRatPowerAccField_mem_FP machineRawRatPowerBaseField_mem_FP - simpa only [machineRawRatPowerCandidate] using + simpa only [machineRawRatPowerCandidate] using! machineCompose_mem_FP hpair machineRawRatMulCode_mem_FP theorem machineRawRatPowerNextAcc_mem_FP : machineRawRatPowerNextAcc ∈ Complexity.FP := by - simpa only [machineRawRatPowerNextAcc] using + simpa only [machineRawRatPowerNextAcc] using! machineTake_mem_FP machineRawRatPowerBoundField_mem_FP machineRawRatPowerCandidate_mem_FP @@ -121,7 +121,7 @@ theorem machineRawRatPowerInputBound_mem_FP : machineBinaryMulWidth_mem_FP have htriple := machineAppend_mem_FP machineBinaryMulWidth_mem_FP hdouble have hquadruple := machineAppend_mem_FP machineBinaryMulWidth_mem_FP htriple - simpa only [machineRawRatPowerInputBound] using + simpa only [machineRawRatPowerInputBound] using! hquadruple theorem machineRawRatPowerInit_mem_FP : @@ -224,13 +224,13 @@ theorem machineRawRatPowerFinalState_mem_FP : theorem machineRawRatPowerCode_mem_FP : machineRawRatPowerCode ∈ Complexity.FP := by - simpa only [machineRawRatPowerCode] using + simpa only [machineRawRatPowerCode] using! machineCompose_mem_FP machineRawRatPowerFinalState_mem_FP machineRawRatPowerAccField_mem_FP theorem machineRationalPowerCode_mem_FP : machineRationalPowerCode ∈ Complexity.FP := by - simpa only [machineRationalPowerCode] using + simpa only [machineRationalPowerCode] using! machineCompose_mem_FP machineRawRatPowerCode_mem_FP machineNormalizeRawRatBinaryCode_mem_FP @@ -250,7 +250,7 @@ private theorem integerNatAbs_size_le_code_length (z : ℤ) : omega exact hle.trans_lt hlt simpa [integerBinaryCode, Nat.size_eq_bits_len, - Nat.add_comm] using hs + Nat.add_comm] using! hs private theorem rawRatWidth_le_code_length (q : RawRat) : rawRatWidth q ≤ (rawRatBinaryCode q).length := by @@ -279,7 +279,7 @@ private theorem rawRatBinaryCode_length_le_width (q : RawRat) : have hsize : n.size ≤ (n + 1).size := Nat.size_le_size (Nat.le_succ n) have habs : (n + 1).size ≤ rawRatWidth q := by - simpa only [hqnum, Int.natAbs_negSucc] using + simpa only [hqnum, Int.natAbs_negSucc] using! rawRat_num_size_le_width q have hnwidth : n.size ≤ rawRatWidth q := hsize.trans habs omega diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalRowAdd.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalRowAdd.lean index fc76bb9d08..e8147e9ac0 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalRowAdd.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalRowAdd.lean @@ -137,7 +137,7 @@ theorem machineRationalRowAddPadSixteen_mem_FP : theorem machineRationalRowAddInputBound_mem_FP : machineRationalRowAddInputBound ∈ Complexity.FP := by - simpa only [machineRationalRowAddInputBound] using + simpa only [machineRationalRowAddInputBound] using! machineCompose_mem_FP machineRationalRowAddPadSixteen_mem_FP machineBinaryMulWidth_mem_FP @@ -164,21 +164,21 @@ theorem machineRationalRowAddRemaining_mem_FP : theorem machineRationalRowAddAccumulator_mem_FP : machineRationalRowAddAccumulator ∈ Complexity.FP := by - simpa only [machineRationalRowAddAccumulator] using + simpa only [machineRationalRowAddAccumulator] using! machineCompose_mem_FP machinePairSecond_mem_FP machinePairFirst_mem_FP theorem machineRationalRowAddDeltaField_mem_FP : machineRationalRowAddDeltaField ∈ Complexity.FP := by have htail := machineCompose_mem_FP machinePairSecond_mem_FP machinePairSecond_mem_FP - simpa only [machineRationalRowAddDeltaField] using + simpa only [machineRationalRowAddDeltaField] using! machineCompose_mem_FP htail machinePairFirst_mem_FP theorem machineRationalRowAddBound_mem_FP : machineRationalRowAddBound ∈ Complexity.FP := by have htail := machineCompose_mem_FP machinePairSecond_mem_FP machinePairSecond_mem_FP - simpa only [machineRationalRowAddBound] using + simpa only [machineRationalRowAddBound] using! machineCompose_mem_FP htail machinePairSecond_mem_FP theorem machineRationalRowAddRawEntry_mem_FP : @@ -187,12 +187,12 @@ theorem machineRationalRowAddRawEntry_mem_FP : machineListHead_mem_FP have hinput := machinePair_mem_FP hhead machineRationalRowAddDeltaField_mem_FP - simpa only [machineRationalRowAddRawEntry] using + simpa only [machineRationalRowAddRawEntry] using! machineCompose_mem_FP hinput machineRawRatAddCode_mem_FP theorem machineRationalRowAddEntry_mem_FP : machineRationalRowAddEntry ∈ Complexity.FP := by - simpa only [machineRationalRowAddEntry] using + simpa only [machineRationalRowAddEntry] using! machineCompose_mem_FP machineRationalRowAddRawEntry_mem_FP machineNormalizeRawRatEntryCode_mem_FP @@ -203,7 +203,7 @@ theorem machineRationalRowAddCandidate_mem_FP : theorem machineRationalRowAddNextAccumulator_mem_FP : machineRationalRowAddNextAccumulator ∈ Complexity.FP := by - simpa only [machineRationalRowAddNextAccumulator] using + simpa only [machineRationalRowAddNextAccumulator] using! machineTake_mem_FP machineRationalRowAddBound_mem_FP machineRationalRowAddCandidate_mem_FP @@ -278,9 +278,9 @@ theorem machineRationalRowAddInit_bound (word : List Bool) : machineRationalRowAddDeltaField_pack, machineRationalRowAddBound_pack] refine ⟨trivial, ?_, by simp, ?_, trivial⟩ - · simpa only [machineRationalRowAddRow] using + · simpa only [machineRationalRowAddRow] using! machinePairSecond_length_le word - · simpa only [machineRationalRowAddDelta] using + · simpa only [machineRationalRowAddDelta] using! machinePairFirst_length_le word theorem machineRationalRowAddStep_bound {word state : List Bool} @@ -343,7 +343,7 @@ theorem machineRationalRowAdd_mem_FP : have hacc := machineCompose_mem_FP machineRationalRowAddFinalState_mem_FP machineRationalRowAddAccumulator_mem_FP - simpa only [machineRationalRowAdd] using + simpa only [machineRationalRowAdd] using! machineCompose_mem_FP hacc machineListReverse_mem_FP /-! ## Ordinary output-size estimate -/ @@ -378,7 +378,7 @@ theorem machineRationalRowAdd_output_length_le_bound (binaryListCode rationalEntryBinaryCode row) have hdelta : rawRatWidth delta ≤ word.length := by have hcomponent : (rawRatBinaryCode delta).length ≤ word.length := by - simpa only [word, machinePairFirst_pair] using + simpa only [word, machinePairFirst_pair] using! machinePairFirst_length_le word exact (rawRatWidth_le_binaryCode_length delta).trans hcomponent @@ -386,7 +386,7 @@ theorem machineRationalRowAdd_output_length_le_bound have hcomponent : (binaryListCode rationalEntryBinaryCode row).length ≤ word.length := by - simpa only [word, machinePairSecond_pair] using + simpa only [word, machinePairSecond_pair] using! machinePairSecond_length_le word exact (binaryListCode_listLength_le rationalEntryBinaryCode row).trans hcomponent @@ -401,11 +401,11 @@ theorem machineRationalRowAdd_output_length_le_bound have hentryCode : (rawRatBinaryCode (rawRatOfRat q)).length ≤ (binaryListCode rationalEntryBinaryCode row).length := by - simpa only [rawRatBinaryCode_rawRatOfRat] using hqCode + simpa only [rawRatBinaryCode_rawRatOfRat] using! hqCode have hrowCode : (binaryListCode rationalEntryBinaryCode row).length ≤ word.length := by - simpa only [word, machinePairSecond_pair] using + simpa only [word, machinePairSecond_pair] using! machinePairSecond_length_le word exact (rawRatWidth_le_binaryCode_length (rawRatOfRat q)).trans (hentryCode.trans hrowCode) @@ -504,13 +504,13 @@ theorem machineRationalRowAddStep_semantics have hprefix : (output.take (k + 1)).reverse = output[k] :: (output.take k).reverse := by rw [← htake] - simpa only [List.concat_eq_append] using + simpa only [List.concat_eq_append] using! (List.reverse_concat (l := output.take k) (a := output[k])) have hfullBound : (binaryListCode rationalEntryBinaryCode output).length ≤ (machineRationalRowAddInputBound word).length := by simpa only [word, output, machineRationalRowAddCanonicalInput, - rationalRowAddValues] using + rationalRowAddValues] using! machineRationalRowAdd_output_length_le_bound delta row have hprefixLength : (binaryListCode rationalEntryBinaryCode @@ -550,7 +550,7 @@ theorem machineRationalRowAddStep_semantics (machineRationalRowAddInputBound word)) = rationalEntryBinaryCode output[k] := by rw [houtputGet] - simpa only [machineRationalRowAddSemanticState, output, word] using + simpa only [machineRationalRowAddSemanticState, output, word] using! machineRationalRowAddEntry_semantics delta row k hk rw [hentry] rw [hdrop, machineListTail_cons] @@ -603,7 +603,7 @@ theorem machineRationalRowAddFinalState_encode (binaryListCode rationalEntryBinaryCode row).length ≤ word.length := by simpa only [word, machineRationalRowAddCanonicalInput, - machinePairSecond_pair] using + machinePairSecond_pair] using! (show (machinePairSecond word).length ≤ word.length from machinePairSecond_length_le word) exact (binaryListCode_listLength_le rationalEntryBinaryCode row).trans diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalRowDivide.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalRowDivide.lean index 0c093c9cc8..f05b9d03eb 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalRowDivide.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalRowDivide.lean @@ -137,7 +137,7 @@ theorem machineRationalRowDividePadSixteen_mem_FP : theorem machineRationalRowDivideInputBound_mem_FP : machineRationalRowDivideInputBound ∈ Complexity.FP := by - simpa only [machineRationalRowDivideInputBound] using + simpa only [machineRationalRowDivideInputBound] using! machineCompose_mem_FP machineRationalRowDividePadSixteen_mem_FP machineBinaryMulWidth_mem_FP @@ -164,21 +164,21 @@ theorem machineRationalRowDivideRemaining_mem_FP : theorem machineRationalRowDivideAccumulator_mem_FP : machineRationalRowDivideAccumulator ∈ Complexity.FP := by - simpa only [machineRationalRowDivideAccumulator] using + simpa only [machineRationalRowDivideAccumulator] using! machineCompose_mem_FP machinePairSecond_mem_FP machinePairFirst_mem_FP theorem machineRationalRowDivideScaleField_mem_FP : machineRationalRowDivideScaleField ∈ Complexity.FP := by have htail := machineCompose_mem_FP machinePairSecond_mem_FP machinePairSecond_mem_FP - simpa only [machineRationalRowDivideScaleField] using + simpa only [machineRationalRowDivideScaleField] using! machineCompose_mem_FP htail machinePairFirst_mem_FP theorem machineRationalRowDivideBound_mem_FP : machineRationalRowDivideBound ∈ Complexity.FP := by have htail := machineCompose_mem_FP machinePairSecond_mem_FP machinePairSecond_mem_FP - simpa only [machineRationalRowDivideBound] using + simpa only [machineRationalRowDivideBound] using! machineCompose_mem_FP htail machinePairSecond_mem_FP theorem machineRationalRowDivideRawEntry_mem_FP : @@ -187,12 +187,12 @@ theorem machineRationalRowDivideRawEntry_mem_FP : machineListHead_mem_FP have hinput := machinePair_mem_FP hhead machineRationalRowDivideScaleField_mem_FP - simpa only [machineRationalRowDivideRawEntry] using + simpa only [machineRationalRowDivideRawEntry] using! machineCompose_mem_FP hinput machineRawRatDivCode_mem_FP theorem machineRationalRowDivideEntry_mem_FP : machineRationalRowDivideEntry ∈ Complexity.FP := by - simpa only [machineRationalRowDivideEntry] using + simpa only [machineRationalRowDivideEntry] using! machineCompose_mem_FP machineRationalRowDivideRawEntry_mem_FP machineNormalizeRawRatEntryCode_mem_FP @@ -203,7 +203,7 @@ theorem machineRationalRowDivideCandidate_mem_FP : theorem machineRationalRowDivideNextAccumulator_mem_FP : machineRationalRowDivideNextAccumulator ∈ Complexity.FP := by - simpa only [machineRationalRowDivideNextAccumulator] using + simpa only [machineRationalRowDivideNextAccumulator] using! machineTake_mem_FP machineRationalRowDivideBound_mem_FP machineRationalRowDivideCandidate_mem_FP @@ -278,9 +278,9 @@ theorem machineRationalRowDivideInit_bound (word : List Bool) : machineRationalRowDivideScaleField_pack, machineRationalRowDivideBound_pack] refine ⟨trivial, ?_, by simp, ?_, trivial⟩ - · simpa only [machineRationalRowDivideRow] using + · simpa only [machineRationalRowDivideRow] using! machinePairSecond_length_le word - · simpa only [machineRationalRowDivideScale] using + · simpa only [machineRationalRowDivideScale] using! machinePairFirst_length_le word theorem machineRationalRowDivideStep_bound {word state : List Bool} @@ -343,7 +343,7 @@ theorem machineRationalRowDivide_mem_FP : have hacc := machineCompose_mem_FP machineRationalRowDivideFinalState_mem_FP machineRationalRowDivideAccumulator_mem_FP - simpa only [machineRationalRowDivide] using + simpa only [machineRationalRowDivide] using! machineCompose_mem_FP hacc machineListReverse_mem_FP /-! ## Ordinary output-size estimate -/ @@ -378,7 +378,7 @@ theorem machineRationalRowDivide_output_length_le_bound (binaryListCode rationalEntryBinaryCode row) have hscale : rawRatWidth scale ≤ word.length := by have hcomponent : (rawRatBinaryCode scale).length ≤ word.length := by - simpa only [word, machinePairFirst_pair] using + simpa only [word, machinePairFirst_pair] using! machinePairFirst_length_le word exact (rawRatWidth_le_binaryCode_length scale).trans hcomponent @@ -386,7 +386,7 @@ theorem machineRationalRowDivide_output_length_le_bound have hcomponent : (binaryListCode rationalEntryBinaryCode row).length ≤ word.length := by - simpa only [word, machinePairSecond_pair] using + simpa only [word, machinePairSecond_pair] using! machinePairSecond_length_le word exact (binaryListCode_listLength_le rationalEntryBinaryCode row).trans hcomponent @@ -401,11 +401,11 @@ theorem machineRationalRowDivide_output_length_le_bound have hentryCode : (rawRatBinaryCode (rawRatOfRat q)).length ≤ (binaryListCode rationalEntryBinaryCode row).length := by - simpa only [rawRatBinaryCode_rawRatOfRat] using hqCode + simpa only [rawRatBinaryCode_rawRatOfRat] using! hqCode have hrowCode : (binaryListCode rationalEntryBinaryCode row).length ≤ word.length := by - simpa only [word, machinePairSecond_pair] using + simpa only [word, machinePairSecond_pair] using! machinePairSecond_length_le word exact (rawRatWidth_le_binaryCode_length (rawRatOfRat q)).trans (hentryCode.trans hrowCode) @@ -504,13 +504,13 @@ theorem machineRationalRowDivideStep_semantics have hprefix : (output.take (k + 1)).reverse = output[k] :: (output.take k).reverse := by rw [← htake] - simpa only [List.concat_eq_append] using + simpa only [List.concat_eq_append] using! (List.reverse_concat (l := output.take k) (a := output[k])) have hfullBound : (binaryListCode rationalEntryBinaryCode output).length ≤ (machineRationalRowDivideInputBound word).length := by simpa only [word, output, machineRationalRowDivideCanonicalInput, - rationalRowDivideValues] using + rationalRowDivideValues] using! machineRationalRowDivide_output_length_le_bound scale row have hprefixLength : (binaryListCode rationalEntryBinaryCode @@ -550,7 +550,7 @@ theorem machineRationalRowDivideStep_semantics (machineRationalRowDivideInputBound word)) = rationalEntryBinaryCode output[k] := by rw [houtputGet] - simpa only [machineRationalRowDivideSemanticState, output, word] using + simpa only [machineRationalRowDivideSemanticState, output, word] using! machineRationalRowDivideEntry_semantics scale row k hk rw [hentry] rw [hdrop, machineListTail_cons] @@ -603,7 +603,7 @@ theorem machineRationalRowDivideFinalState_encode (binaryListCode rationalEntryBinaryCode row).length ≤ word.length := by simpa only [word, machineRationalRowDivideCanonicalInput, - machinePairSecond_pair] using + machinePairSecond_pair] using! (show (machinePairSecond word).length ≤ word.length from machinePairSecond_length_le word) exact (binaryListCode_listLength_le rationalEntryBinaryCode row).trans diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalTransposeMulVector.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalTransposeMulVector.lean index 8d36e9f863..7bb5e3fb3d 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalTransposeMulVector.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalTransposeMulVector.lean @@ -64,7 +64,7 @@ theorem rawRationalTransposeCoordinate_width_le_word {d : ℕ} (binaryListCode rationalEntryBinaryCode column).length ≤ (binaryListCode (binaryListCode rationalEntryBinaryCode) (rationalMatrixRows A)).length := by - simpa only [column] using hcolumn + simpa only [column] using! hcolumn have hcombined : 1 + (binaryListCode (binaryListCode rationalEntryBinaryCode) (rationalMatrixRows A)).length + @@ -103,7 +103,7 @@ theorem machineRationalTransposeMulVectorInputBound_mem_FP : have h1 := machineBinaryMulWidth_mem_FP have h2 := machineCompose_mem_FP h1 machineBinaryMulWidth_mem_FP have h3 := machineCompose_mem_FP h2 machineBinaryMulWidth_mem_FP - simpa only [machineRationalTransposeMulVectorInputBound] using h3 + simpa only [machineRationalTransposeMulVectorInputBound] using! h3 theorem rationalTransposeMulVector_code_length_le_bound {d : ℕ} (A : Matrix (Fin d) (Fin d) ℚ) (v : Fin d → ℚ) : @@ -116,7 +116,7 @@ theorem rationalTransposeMulVector_code_length_le_bound {d : ℕ} have hdim : d ≤ word.length := by have hfirst := machinePairFirst_length_le word simpa only [word, rationalTransposeMulVectorCanonicalWord, - machinePairFirst_pair, List.length_replicate] using hfirst + machinePairFirst_pair, List.length_replicate] using! hfirst have heach : ∀ q ∈ List.ofFn (rationalTransposeMulVector A v), (rationalEntryBinaryCode q).length ≤ B := by intro q hq @@ -239,7 +239,7 @@ theorem machineRationalTransposeMulVectorPayload_mem_FP : theorem machineRationalTransposeMulVectorIndices_mem_FP : machineRationalTransposeMulVectorIndices ∈ FP := by - simpa only [machineRationalTransposeMulVectorIndices] using + simpa only [machineRationalTransposeMulVectorIndices] using! machineCompose_mem_FP machineRationalTransposeMulVectorDimension_mem_FP machineUnaryRangeCode_mem_FP @@ -248,26 +248,26 @@ theorem machineRationalTransposeMulVectorRemaining_mem_FP : theorem machineRationalTransposeMulVectorAccumulator_mem_FP : machineRationalTransposeMulVectorAccumulator ∈ FP := by - simpa only [machineRationalTransposeMulVectorAccumulator] using + simpa only [machineRationalTransposeMulVectorAccumulator] using! machineCompose_mem_FP machinePairSecond_mem_FP machinePairFirst_mem_FP theorem machineRationalTransposeMulVectorStatePayload_mem_FP : machineRationalTransposeMulVectorStatePayload ∈ FP := by - simpa only [machineRationalTransposeMulVectorStatePayload] using + simpa only [machineRationalTransposeMulVectorStatePayload] using! machineCompose_mem_FP (machineCompose_mem_FP machinePairSecond_mem_FP machinePairSecond_mem_FP) machinePairFirst_mem_FP theorem machineRationalTransposeMulVectorBound_mem_FP : machineRationalTransposeMulVectorBound ∈ FP := by - simpa only [machineRationalTransposeMulVectorBound] using + simpa only [machineRationalTransposeMulVectorBound] using! machineCompose_mem_FP (machineCompose_mem_FP machinePairSecond_mem_FP machinePairSecond_mem_FP) machinePairSecond_mem_FP theorem machineRationalTransposeMulVectorCurrentIndex_mem_FP : machineRationalTransposeMulVectorCurrentIndex ∈ FP := by - simpa only [machineRationalTransposeMulVectorCurrentIndex] using + simpa only [machineRationalTransposeMulVectorCurrentIndex] using! machineCompose_mem_FP machineRationalTransposeMulVectorRemaining_mem_FP machineListHead_mem_FP @@ -276,7 +276,7 @@ theorem machineRationalTransposeMulVectorCurrentEntry_mem_FP : have hp := machinePair_mem_FP machineRationalTransposeMulVectorCurrentIndex_mem_FP machineRationalTransposeMulVectorStatePayload_mem_FP - simpa only [machineRationalTransposeMulVectorCurrentEntry] using + simpa only [machineRationalTransposeMulVectorCurrentEntry] using! machineCompose_mem_FP hp machineRationalMatrixTransposeMulVectorEntryCode_mem_FP @@ -287,7 +287,7 @@ theorem machineRationalTransposeMulVectorCandidate_mem_FP : theorem machineRationalTransposeMulVectorNextAccumulator_mem_FP : machineRationalTransposeMulVectorNextAccumulator ∈ FP := by - simpa only [machineRationalTransposeMulVectorNextAccumulator] using + simpa only [machineRationalTransposeMulVectorNextAccumulator] using! machineTake_mem_FP machineRationalTransposeMulVectorBound_mem_FP machineRationalTransposeMulVectorCandidate_mem_FP @@ -374,7 +374,7 @@ theorem machineRationalTransposeMulVector_indices_le_bound have hdimension' : (machineRationalTransposeMulVectorDimension word).length ≤ word.length := by - simpa only [machineRationalTransposeMulVectorDimension] using hdimension + simpa only [machineRationalTransposeMulVectorDimension] using! hdimension have hmono := machineListUpdateInputBound_length_mono hdimension' apply hrange.trans (hmono.trans ?_) simp only [machineListUpdateInputBound, @@ -456,13 +456,13 @@ theorem machineRationalTransposeMulVectorFinalState_mem_FP : theorem machineRationalTransposeMulVectorReversedCode_mem_FP : machineRationalTransposeMulVectorReversedCode ∈ FP := by - simpa only [machineRationalTransposeMulVectorReversedCode] using + simpa only [machineRationalTransposeMulVectorReversedCode] using! machineCompose_mem_FP machineRationalTransposeMulVectorFinalState_mem_FP machineRationalTransposeMulVectorAccumulator_mem_FP theorem machineRationalTransposeMulVectorCode_mem_FP : machineRationalTransposeMulVectorCode ∈ FP := by - simpa only [machineRationalTransposeMulVectorCode] using + simpa only [machineRationalTransposeMulVectorCode] using! machineCompose_mem_FP machineRationalTransposeMulVectorReversedCode_mem_FP machineListReverse_mem_FP @@ -509,7 +509,7 @@ theorem rationalTransposePrefix_succ {d : ℕ} [rationalTransposeMulVector A v ⟨k, hk⟩] := by simp only [rationalTransposePrefix, List.map_take] have hkm : k < (List.finRange d).length := by simpa - simpa [List.getElem_finRange] using + simpa [List.getElem_finRange] using! congrArg (List.map fun j ↦ rationalTransposeMulVector A v j) (List.take_concat_get hkm).symm @@ -556,7 +556,7 @@ theorem machineRationalTransposeMulVectorStep_semantics {d : ℕ} (binaryListCode rationalEntryBinaryCode (rationalTransposePrefix A v k).reverse)).length ≤ (machineRationalTransposeMulVectorInputBound word).length := by - simpa only [hreverse, binaryListCode] using hcand + simpa only [hreverse, binaryListCode] using! hcand have hnonempty : binaryListCode finUnaryCode ((List.finRange d).drop k) ≠ [] := by rw [hdrop] @@ -638,7 +638,7 @@ theorem machineRationalTransposeMulVectorReversedCode_encode {d : ℕ} have hd : d ≤ word.length := by have h := machinePairFirst_length_le word simpa only [word, rationalTransposeMulVectorCanonicalWord, - machinePairFirst_pair, List.length_replicate] using h + machinePairFirst_pair, List.length_replicate] using! h have hsplit : word.length = (word.length - d) + d := by omega change machineRationalTransposeMulVectorReversedCode word = _ rw [machineRationalTransposeMulVectorReversedCode, diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalUnary.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalUnary.lean index 6815d9463d..c8a5ad5604 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalUnary.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalUnary.lean @@ -75,21 +75,21 @@ theorem machineRawRatDivCode_mem_FP : machineRawRatDivCode ∈ Complexity.FP := have hinv := machineCompose_mem_FP machinePairSecond_mem_FP machineRawRatInvCode_mem_FP have hpair := machinePair_mem_FP machinePairFirst_mem_FP hinv - simpa only [machineRawRatDivCode] using + simpa only [machineRawRatDivCode] using! machineCompose_mem_FP hpair machineRawRatMulCode_mem_FP theorem machineRationalNegCode_mem_FP : machineRationalNegCode ∈ Complexity.FP := by - simpa only [machineRationalNegCode] using + simpa only [machineRationalNegCode] using! machineCompose_mem_FP machineRawRatNegCode_mem_FP machineNormalizeRawRatBinaryCode_mem_FP theorem machineRationalInvCode_mem_FP : machineRationalInvCode ∈ Complexity.FP := by - simpa only [machineRationalInvCode] using + simpa only [machineRationalInvCode] using! machineCompose_mem_FP machineRawRatInvCode_mem_FP machineNormalizeRawRatBinaryCode_mem_FP theorem machineRationalDivCode_mem_FP : machineRationalDivCode ∈ Complexity.FP := by - simpa only [machineRationalDivCode] using + simpa only [machineRationalDivCode] using! machineCompose_mem_FP machineRawRatDivCode_mem_FP machineNormalizeRawRatBinaryCode_mem_FP @@ -145,7 +145,7 @@ theorem machineRawRatInvCode_encode (q : RawRat) : (pair [false] [true]) (machineRawRatInvNonzeroCode (pair (integerBinaryCode q.num) q.den.bits)) habs] - simpa only [rawRatBinaryCode] using + simpa only [rawRatBinaryCode] using! machineRawRatInvNonzeroCode_encode q hq theorem machineRawRatDivCode_encode (q r : RawRat) : diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalVectorDot.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalVectorDot.lean index 64fe5d241e..c6b3c7e20e 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalVectorDot.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalVectorDot.lean @@ -102,12 +102,12 @@ theorem machineRationalVectorDotLeft_mem_FP : theorem machineRationalVectorDotRight_mem_FP : machineRationalVectorDotRight ∈ FP := by - simpa only [machineRationalVectorDotRight] using + simpa only [machineRationalVectorDotRight] using! machineCompose_mem_FP machinePairSecond_mem_FP machinePairFirst_mem_FP theorem machineRationalVectorDotAcc_mem_FP : machineRationalVectorDotAcc ∈ FP := by - simpa only [machineRationalVectorDotAcc] using + simpa only [machineRationalVectorDotAcc] using! machineCompose_mem_FP (machineCompose_mem_FP machinePairSecond_mem_FP machinePairSecond_mem_FP) @@ -115,7 +115,7 @@ theorem machineRationalVectorDotAcc_mem_FP : theorem machineRationalVectorDotBound_mem_FP : machineRationalVectorDotBound ∈ FP := by - simpa only [machineRationalVectorDotBound] using + simpa only [machineRationalVectorDotBound] using! machineCompose_mem_FP (machineCompose_mem_FP machinePairSecond_mem_FP machinePairSecond_mem_FP) @@ -123,13 +123,13 @@ theorem machineRationalVectorDotBound_mem_FP : theorem machineRationalVectorDotLeftEntry_mem_FP : machineRationalVectorDotLeftEntry ∈ FP := by - simpa only [machineRationalVectorDotLeftEntry] using + simpa only [machineRationalVectorDotLeftEntry] using! machineCompose_mem_FP machineRationalVectorDotLeft_mem_FP machineListHead_mem_FP theorem machineRationalVectorDotRightEntry_mem_FP : machineRationalVectorDotRightEntry ∈ FP := by - simpa only [machineRationalVectorDotRightEntry] using + simpa only [machineRationalVectorDotRightEntry] using! machineCompose_mem_FP machineRationalVectorDotRight_mem_FP machineListHead_mem_FP @@ -137,19 +137,19 @@ theorem machineRationalVectorDotProduct_mem_FP : machineRationalVectorDotProduct ∈ FP := by have hp := machinePair_mem_FP machineRationalVectorDotLeftEntry_mem_FP machineRationalVectorDotRightEntry_mem_FP - simpa only [machineRationalVectorDotProduct] using + simpa only [machineRationalVectorDotProduct] using! machineCompose_mem_FP hp machineRawRatMulCode_mem_FP theorem machineRationalVectorDotCandidate_mem_FP : machineRationalVectorDotCandidate ∈ FP := by have hp := machinePair_mem_FP machineRationalVectorDotAcc_mem_FP machineRationalVectorDotProduct_mem_FP - simpa only [machineRationalVectorDotCandidate] using + simpa only [machineRationalVectorDotCandidate] using! machineCompose_mem_FP hp machineRawRatAddCode_mem_FP theorem machineRationalVectorDotNextAcc_mem_FP : machineRationalVectorDotNextAcc ∈ FP := by - simpa only [machineRationalVectorDotNextAcc] using + simpa only [machineRationalVectorDotNextAcc] using! machineTake_mem_FP machineRationalVectorDotBound_mem_FP machineRationalVectorDotCandidate_mem_FP @@ -306,13 +306,13 @@ theorem machineRationalVectorDotFinalState_mem_FP : theorem machineRationalVectorDotRawCode_mem_FP : machineRationalVectorDotRawCode ∈ FP := by - simpa only [machineRationalVectorDotRawCode] using + simpa only [machineRationalVectorDotRawCode] using! machineCompose_mem_FP machineRationalVectorDotFinalState_mem_FP machineRationalVectorDotAcc_mem_FP theorem machineRationalVectorDotEntryCode_mem_FP : machineRationalVectorDotEntryCode ∈ FP := by - simpa only [machineRationalVectorDotEntryCode] using + simpa only [machineRationalVectorDotEntryCode] using! machineCompose_mem_FP machineRationalVectorDotRawCode_mem_FP machineNormalizeRawRatEntryCode_mem_FP @@ -459,7 +459,7 @@ theorem machineRationalVectorDotStep_semantics rawRatListDotCost qs rs ≤ 1 + word.length := by simpa only [RationalVectorDotSemInvariant, rationalVectorDotSemStep, rawRatListDotCost, - Nat.add_zero] using hinv + Nat.add_zero] using! hinv omega have hcode : (rawRatBinaryCode @@ -538,7 +538,7 @@ theorem rationalVectorDotSem_process : ∀ (xs ys : List ℚ) rw [List.length_cons, Function.iterate_succ_apply, rationalVectorDotSemStep, ih] · rfl - · simpa using Nat.succ.inj hlen + · simpa using! Nat.succ.inj hlen theorem rationalVectorDotSem_done_iterate (extra : ℕ) (acc : RawRat) : @@ -605,7 +605,7 @@ theorem machineRationalVectorDotFinalState_encode {n : ℕ} have hn : n ≤ word.length := by have hlist := list_length_le_binaryListCode_length rationalEntryBinaryCode left - simpa only [left, List.length_ofFn] using hlist.trans hleftCode + simpa only [left, List.length_ofFn] using! hlist.trans hleftCode have hsplit : word.length = (word.length - n) + n := by omega have hinit : machineRationalVectorDotInit word = rationalVectorDotSemCode @@ -615,7 +615,7 @@ theorem machineRationalVectorDotFinalState_encode {n : ℕ} have hprocess : (rationalVectorDotSemStep)^[n] s = ⟨[], [], rawRatListDot RawRat.zero left right⟩ := by - simpa [s, left, right] using + simpa [s, left, right] using! (rationalVectorDotSem_process left right RawRat.zero (by simp [left, right])) change machineRationalVectorDotFinalState word = _ diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalVectorL1.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalVectorL1.lean index 47cf31ddfa..e9a510bda0 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalVectorL1.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalVectorL1.lean @@ -147,23 +147,23 @@ theorem machineRationalVectorL1Current_mem_FP : theorem machineRationalVectorL1Acc_mem_FP : machineRationalVectorL1Acc ∈ FP := by - simpa only [machineRationalVectorL1Acc] using + simpa only [machineRationalVectorL1Acc] using! machineCompose_mem_FP machinePairSecond_mem_FP machinePairFirst_mem_FP theorem machineRationalVectorL1Bound_mem_FP : machineRationalVectorL1Bound ∈ FP := by - simpa only [machineRationalVectorL1Bound] using + simpa only [machineRationalVectorL1Bound] using! machineCompose_mem_FP machinePairSecond_mem_FP machinePairSecond_mem_FP theorem machineRationalVectorL1Entry_mem_FP : machineRationalVectorL1Entry ∈ FP := by - simpa only [machineRationalVectorL1Entry] using + simpa only [machineRationalVectorL1Entry] using! machineCompose_mem_FP machineRationalVectorL1Current_mem_FP machineListHead_mem_FP theorem machineRationalVectorL1Magnitude_mem_FP : machineRationalVectorL1Magnitude ∈ FP := by - simpa only [machineRationalVectorL1Magnitude] using + simpa only [machineRationalVectorL1Magnitude] using! machineCompose_mem_FP machineRationalVectorL1Entry_mem_FP machineRawRatMagnitudeCode_mem_FP @@ -171,12 +171,12 @@ theorem machineRationalVectorL1Candidate_mem_FP : machineRationalVectorL1Candidate ∈ FP := by have hp := machinePair_mem_FP machineRationalVectorL1Acc_mem_FP machineRationalVectorL1Magnitude_mem_FP - simpa only [machineRationalVectorL1Candidate] using + simpa only [machineRationalVectorL1Candidate] using! machineCompose_mem_FP hp machineRawRatAddCode_mem_FP theorem machineRationalVectorL1NextAcc_mem_FP : machineRationalVectorL1NextAcc ∈ FP := by - simpa only [machineRationalVectorL1NextAcc] using + simpa only [machineRationalVectorL1NextAcc] using! machineTake_mem_FP machineRationalVectorL1Bound_mem_FP machineRationalVectorL1Candidate_mem_FP @@ -305,13 +305,13 @@ theorem machineRationalVectorL1FinalState_mem_FP : theorem machineRationalVectorL1RawCode_mem_FP : machineRationalVectorL1RawCode ∈ FP := by - simpa only [machineRationalVectorL1RawCode] using + simpa only [machineRationalVectorL1RawCode] using! machineCompose_mem_FP machineRationalVectorL1FinalState_mem_FP machineRationalVectorL1Acc_mem_FP theorem machineRationalVectorL1EntryCode_mem_FP : machineRationalVectorL1EntryCode ∈ FP := by - simpa only [machineRationalVectorL1EntryCode] using + simpa only [machineRationalVectorL1EntryCode] using! machineCompose_mem_FP machineRationalVectorL1RawCode_mem_FP machineNormalizeRawRatEntryCode_mem_FP @@ -400,7 +400,7 @@ theorem machineRationalVectorL1Step_semantics rawRatWidth (acc.add (rawRatOfRat q).magnitude) + rawRatListCost qs ≤ 1 + word.length := by simpa only [RationalVectorL1SemInvariant, - rationalVectorL1SemStep] using hinv + rationalVectorL1SemStep] using! hinv omega have hcode : (rawRatBinaryCode @@ -497,7 +497,7 @@ theorem machineRationalVectorL1FinalState_encode {n : ℕ} have hn : n ≤ word.length := by have hlist := list_length_le_binaryListCode_length rationalEntryBinaryCode xs - simpa only [xs, List.length_ofFn, hcode] using hlist + simpa only [xs, List.length_ofFn, hcode] using! hlist have hsplit : word.length = (word.length - n) + n := by omega have hinit : machineRationalVectorL1Init word = rationalVectorL1SemCode @@ -507,7 +507,7 @@ theorem machineRationalVectorL1FinalState_encode {n : ℕ} have hprocess : (rationalVectorL1SemStep)^[n] s = ⟨[], rawRatListL1Sum RawRat.zero xs⟩ := by - simpa [s, xs] using rationalVectorL1Sem_process xs RawRat.zero + simpa [s, xs] using! rationalVectorL1Sem_process xs RawRat.zero change machineRationalVectorL1FinalState word = _ rw [machineRationalVectorL1FinalState, hsplit, Function.iterate_add_apply, hinit, diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalVectorScale.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalVectorScale.lean index a23032b7fb..8f646ae8ee 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalVectorScale.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalVectorScale.lean @@ -40,14 +40,14 @@ theorem machineRationalVectorScaleReciprocalCode_mem_FP : have hinput := machinePair_mem_FP (machineConst_mem_FP (rawRatBinaryCode RawRat.one)) machinePairFirst_mem_FP - simpa only [machineRationalVectorScaleReciprocalCode] using + simpa only [machineRationalVectorScaleReciprocalCode] using! machineCompose_mem_FP hinput machineRawRatDivCode_mem_FP theorem machineRationalVectorScaleCode_mem_FP : machineRationalVectorScaleCode ∈ FP := by have hinput := machinePair_mem_FP machineRationalVectorScaleReciprocalCode_mem_FP machinePairSecond_mem_FP - simpa only [machineRationalVectorScaleCode] using + simpa only [machineRationalVectorScaleCode] using! machineCompose_mem_FP hinput machineRationalRowDivide_mem_FP theorem rationalRowDivideValues_reciprocal_ofFn {d : ℕ} diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalVectorSub.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalVectorSub.lean index e711c9a3b4..37941320af 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalVectorSub.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalVectorSub.lean @@ -49,7 +49,7 @@ theorem machineRationalVectorSubEntryCode_mem_FP : have hnegY := machineCompose_mem_FP hyEntry machineRawRatNegCode_mem_FP have haddInput := machinePair_mem_FP hxEntry hnegY have hadd := machineCompose_mem_FP haddInput machineRawRatAddCode_mem_FP - simpa only [machineRationalVectorSubEntryCode] using + simpa only [machineRationalVectorSubEntryCode] using! machineCompose_mem_FP hadd machineNormalizeRawRatEntryCode_mem_FP @[simp] theorem machineRationalVectorSubEntryCode_encode {d : ℕ} @@ -109,8 +109,8 @@ theorem rawRationalVectorSubCoordinate_width_le {d : ℕ} (pair (rationalFiniteVectorCode x) (rationalFiniteVectorCode y)).length ≤ word.length := by simpa only [word, rationalVectorSubCanonicalWord, - machinePairSecond_pair] using machinePairSecond_length_le word - simpa only [machinePairFirst_pair] using hinner.trans hpayload + machinePairSecond_pair] using! machinePairSecond_length_le word + simpa only [machinePairFirst_pair] using! hinner.trans hpayload have hyVector : (rationalFiniteVectorCode y).length ≤ word.length := by have hinner := machinePairSecond_length_le (pair (rationalFiniteVectorCode x) (rationalFiniteVectorCode y)) @@ -118,14 +118,14 @@ theorem rawRationalVectorSubCoordinate_width_le {d : ℕ} (pair (rationalFiniteVectorCode x) (rationalFiniteVectorCode y)).length ≤ word.length := by simpa only [word, rationalVectorSubCanonicalWord, - machinePairSecond_pair] using machinePairSecond_length_le word - simpa only [machinePairSecond_pair] using hinner.trans hpayload + machinePairSecond_pair] using! machinePairSecond_length_le word + simpa only [machinePairSecond_pair] using! hinner.trans hpayload have hxWidth : rawRatWidth (rawRatOfRat (x i)) ≤ word.length := by have hxCode : (rawRatBinaryCode (rawRatOfRat (x i))).length ≤ (rationalFiniteVectorCode x).length := by simpa only [rationalFiniteVectorCode, - rawRatBinaryCode_rawRatOfRat] using hxElem + rawRatBinaryCode_rawRatOfRat] using! hxElem exact (rawRatWidth_le_binaryCode_length _).trans (hxCode.trans hxVector) have hyWidth : rawRatWidth (rawRatOfRat (y i)) ≤ word.length := by @@ -133,7 +133,7 @@ theorem rawRationalVectorSubCoordinate_width_le {d : ℕ} (rawRatBinaryCode (rawRatOfRat (y i))).length ≤ (rationalFiniteVectorCode y).length := by simpa only [rationalFiniteVectorCode, - rawRatBinaryCode_rawRatOfRat] using hyElem + rawRatBinaryCode_rawRatOfRat] using! hyElem exact (rawRatWidth_le_binaryCode_length _).trans (hyCode.trans hyVector) change rawRatWidth ((rawRatOfRat (x i)).sub (rawRatOfRat (y i))) ≤ @@ -170,7 +170,7 @@ theorem rationalVectorSub_code_length_le_bound {d : ℕ} have hdim : d ≤ word.length := by have hfirst := machinePairFirst_length_le word simpa only [word, rationalVectorSubCanonicalWord, - machinePairFirst_pair, List.length_replicate] using hfirst + machinePairFirst_pair, List.length_replicate] using! hfirst have heach : ∀ q ∈ List.ofFn (rationalVectorSub x y), (rationalEntryBinaryCode q).length ≤ B := by intro q hq @@ -254,7 +254,7 @@ theorem machineRationalVectorSubCurrentEntry_mem_FP : have hp := machinePair_mem_FP machineRationalTransposeMulVectorCurrentIndex_mem_FP machineRationalTransposeMulVectorStatePayload_mem_FP - simpa only [machineRationalVectorSubCurrentEntry] using + simpa only [machineRationalVectorSubCurrentEntry] using! machineCompose_mem_FP hp machineRationalVectorSubEntryCode_mem_FP theorem machineRationalVectorSubCandidate_mem_FP : @@ -264,7 +264,7 @@ theorem machineRationalVectorSubCandidate_mem_FP : theorem machineRationalVectorSubNextAccumulator_mem_FP : machineRationalVectorSubNextAccumulator ∈ FP := by - simpa only [machineRationalVectorSubNextAccumulator] using + simpa only [machineRationalVectorSubNextAccumulator] using! machineTake_mem_FP machineRationalTransposeMulVectorBound_mem_FP machineRationalVectorSubCandidate_mem_FP @@ -332,7 +332,7 @@ theorem machineRationalVectorSubIterate_bound | zero => simpa only [machineRationalVectorSubInit, machineRationalVectorSubInputBound, - machineRationalTransposeMulVectorInit] using + machineRationalTransposeMulVectorInit] using! machineRationalTransposeMulVectorInit_bound word | succ k ih => rw [Function.iterate_succ_apply'] @@ -361,13 +361,13 @@ theorem machineRationalVectorSubFinalState_mem_FP : theorem machineRationalVectorSubReversedCode_mem_FP : machineRationalVectorSubReversedCode ∈ FP := by - simpa only [machineRationalVectorSubReversedCode] using + simpa only [machineRationalVectorSubReversedCode] using! machineCompose_mem_FP machineRationalVectorSubFinalState_mem_FP machineRationalTransposeMulVectorAccumulator_mem_FP theorem machineRationalVectorSubCode_mem_FP : machineRationalVectorSubCode ∈ FP := by - simpa only [machineRationalVectorSubCode] using + simpa only [machineRationalVectorSubCode] using! machineCompose_mem_FP machineRationalVectorSubReversedCode_mem_FP machineListReverse_mem_FP @@ -406,7 +406,7 @@ theorem rationalVectorSubPrefix_succ {d : ℕ} [rationalVectorSub x y ⟨k, hk⟩] := by simp only [rationalVectorSubPrefix, List.map_take] have hkm : k < (List.finRange d).length := by simpa - simpa [List.getElem_finRange] using + simpa [List.getElem_finRange] using! congrArg (List.map fun i ↦ rationalVectorSub x y i) (List.take_concat_get hkm).symm @@ -449,7 +449,7 @@ theorem machineRationalVectorSubStep_semantics {d : ℕ} (binaryListCode rationalEntryBinaryCode (rationalVectorSubPrefix x y k).reverse)).length ≤ (machineRationalVectorSubInputBound word).length := by - simpa only [hreverse, binaryListCode] using hcand + simpa only [hreverse, binaryListCode] using! hcand have hnonempty : binaryListCode finUnaryCode ((List.finRange d).drop k) ≠ [] := by rw [hdrop] @@ -523,7 +523,7 @@ theorem machineRationalVectorSubReversedCode_encode {d : ℕ} have hd : d ≤ word.length := by have h := machinePairFirst_length_le word simpa only [word, rationalVectorSubCanonicalWord, - machinePairFirst_pair, List.length_replicate] using h + machinePairFirst_pair, List.length_replicate] using! h have hsplit : word.length = (word.length - d) + d := by omega change machineRationalVectorSubReversedCode word = _ rw [machineRationalVectorSubReversedCode, diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalVectorSum.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalVectorSum.lean index 4cc1c818d0..8be4fbaa16 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalVectorSum.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalVectorSum.lean @@ -35,7 +35,7 @@ theorem machineMatrixRawSumFinalState_rows_encode have hrowsLength : (binaryListCode (binaryListCode rationalEntryBinaryCode) rows).length ≤ word.length := by - simpa only [word] using machinePairSecond_length_le word + simpa only [word] using! machinePairSecond_length_le word have hinv : MatrixRawSumSemInvariant (1 + word.length) s := by simp only [MatrixRawSumSemInvariant, s, rawRatListCost, List.map_nil, List.sum_nil, rawRatWidth_zero, Nat.add_zero] @@ -82,7 +82,7 @@ theorem machineRationalVectorAsRowsWord_mem_FP : theorem machineRationalVectorRawSumCode_mem_FP : machineRationalVectorRawSumCode ∈ Complexity.FP := by - simpa only [machineRationalVectorRawSumCode] using + simpa only [machineRationalVectorRawSumCode] using! machineCompose_mem_FP machineRationalVectorAsRowsWord_mem_FP machineMatrixRawSumCode_mem_FP diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRowComplementUpperSum.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRowComplementUpperSum.lean index 6dfef54989..ae3ba67b38 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineRowComplementUpperSum.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRowComplementUpperSum.lean @@ -113,16 +113,16 @@ theorem machineRowUpperSource_mem_FP : machineRowUpperSource ∈ FP := machinePairFirst_mem_FP theorem machineRowUpperCurrent_mem_FP : machineRowUpperCurrent ∈ FP := by - simpa only [machineRowUpperCurrent] using + simpa only [machineRowUpperCurrent] using! machineCompose_mem_FP machinePairSecond_mem_FP machinePairFirst_mem_FP theorem machineRowUpperAcc_mem_FP : machineRowUpperAcc ∈ FP := by - simpa only [machineRowUpperAcc] using machineCompose_mem_FP + simpa only [machineRowUpperAcc] using! machineCompose_mem_FP (machineCompose_mem_FP machinePairSecond_mem_FP machinePairSecond_mem_FP) machinePairFirst_mem_FP theorem machineRowUpperBound_mem_FP : machineRowUpperBound ∈ FP := by - simpa only [machineRowUpperBound] using machineCompose_mem_FP + simpa only [machineRowUpperBound] using! machineCompose_mem_FP (machineCompose_mem_FP machinePairSecond_mem_FP machinePairSecond_mem_FP) machinePairSecond_mem_FP @@ -133,18 +133,18 @@ theorem machineRowUpperOptimizerWord_mem_FP : machineRowUpperOptimizerWord ∈ FP := machinePairSecond_mem_FP theorem machineRowUpperMatrixWord_mem_FP : machineRowUpperMatrixWord ∈ FP := by - simpa only [machineRowUpperMatrixWord] using machineCompose_mem_FP + simpa only [machineRowUpperMatrixWord] using! machineCompose_mem_FP machineRowUpperOptimizerWord_mem_FP machineOptimizerMatrixWord_mem_FP theorem machineRowUpperInitialRow_mem_FP : machineRowUpperInitialRow ∈ FP := by have hrows := machineCompose_mem_FP machineRowUpperMatrixWord_mem_FP machineMatrixRowsWord_mem_FP have hpair := machinePair_mem_FP machineRowUpperRowRuler_mem_FP hrows - simpa only [machineRowUpperInitialRow] using + simpa only [machineRowUpperInitialRow] using! machineCompose_mem_FP hpair machineListIndex_mem_FP theorem machineRowUpperEntry_mem_FP : machineRowUpperEntry ∈ FP := by - simpa only [machineRowUpperEntry] using machineCompose_mem_FP + simpa only [machineRowUpperEntry] using! machineCompose_mem_FP machineRowUpperCurrent_mem_FP machineListHead_mem_FP theorem machineRowUpperComplementInput_mem_FP : @@ -159,7 +159,7 @@ theorem machineRowUpperComplementInput_mem_FP : theorem machineRowUpperComplementCode_mem_FP : machineRowUpperComplementCode ∈ FP := by - simpa only [machineRowUpperComplementCode] using machineCompose_mem_FP + simpa only [machineRowUpperComplementCode] using! machineCompose_mem_FP machineRowUpperComplementInput_mem_FP machineNearbyCoordinateComplementCode_mem_FP @@ -169,17 +169,17 @@ theorem machineRowUpperLogRawCode_mem_FP : machineRowUpperLogRawCode ∈ FP := b have hp := machineCompose_mem_FP hsourceOptimizer machineCertificateLogPrecisionRuler_mem_FP have hpair := machinePair_mem_FP hp machineRowUpperComplementCode_mem_FP - simpa only [machineRowUpperLogRawCode] using machineCompose_mem_FP hpair + simpa only [machineRowUpperLogRawCode] using! machineCompose_mem_FP hpair machineScheduledLogUpperRawCode_mem_FP theorem machineRowUpperCandidate_mem_FP : machineRowUpperCandidate ∈ FP := by have hpair := machinePair_mem_FP machineRowUpperAcc_mem_FP machineRowUpperLogRawCode_mem_FP - simpa only [machineRowUpperCandidate] using machineCompose_mem_FP hpair + simpa only [machineRowUpperCandidate] using! machineCompose_mem_FP hpair machineRawRatAddCode_mem_FP theorem machineRowUpperNextAcc_mem_FP : machineRowUpperNextAcc ∈ FP := by - simpa only [machineRowUpperNextAcc] using machineTake_mem_FP + simpa only [machineRowUpperNextAcc] using! machineTake_mem_FP machineRowUpperBound_mem_FP machineRowUpperCandidate_mem_FP theorem machineRowUpperStep_mem_FP : machineRowUpperStep ∈ FP := by @@ -194,7 +194,7 @@ theorem machineRowUpperStep_mem_FP : machineRowUpperStep ∈ FP := by theorem machineRowUpperInputBound_mem_FP : machineRowUpperInputBound ∈ FP := by have h1 := machineBinaryMulWidth_mem_FP have h2 := machineCompose_mem_FP h1 machineBinaryMulWidth_mem_FP - simpa only [machineRowUpperInputBound] using + simpa only [machineRowUpperInputBound] using! machineCompose_mem_FP h2 machineBinaryMulWidth_mem_FP theorem machineRowUpperInit_mem_FP : machineRowUpperInit ∈ FP := by @@ -307,7 +307,7 @@ theorem machineRowUpperFinalState_mem_FP : machineRowUpperFinalState ∈ FP := b theorem machineRowComplementUpperSumRawCode_mem_FP : machineRowComplementUpperSumRawCode ∈ FP := by - simpa only [machineRowComplementUpperSumRawCode] using machineCompose_mem_FP + simpa only [machineRowComplementUpperSumRawCode] using! machineCompose_mem_FP machineRowUpperFinalState_mem_FP machineRowUpperAcc_mem_FP /-! ## Exact semantics -/ @@ -431,7 +431,7 @@ theorem machineRowUpperStep_semantics {n : ℕ} (directedCertificatePrecision n))) + rawRowComplementUpperCost (directedCertificatePrecision n) qs ≤ budget := by - simpa only [RowUpperSemInvariant, rowUpperSemStep] using hinv + simpa only [RowUpperSemInvariant, rowUpperSemStep] using! hinv omega have hcode : (rawRatBinaryCode @@ -529,20 +529,20 @@ theorem rawScheduledLogUpper_complement_width_le_query calc _ = (machineMatrixRowsWord (rationalMatrixBinaryEncoding.encode ⟨n, X⟩)).length := by - simpa using congrArg List.length (machineMatrixRowsWord_encode X).symm + simpa using! congrArg List.length (machineMatrixRowsWord_encode X).symm _ ≤ (rationalMatrixBinaryEncoding.encode ⟨n, X⟩).length := by - simpa only [machineMatrixRowsWord] using machinePairSecond_length_le + simpa only [machineMatrixRowsWord] using! machinePairSecond_length_le (rationalMatrixBinaryEncoding.encode ⟨n, X⟩) _ ≤ optimizer.length := by simpa only [optimizer, rationalOptimizerOutputCode, - machinePairFirst_pair] using machinePairFirst_length_le optimizer + machinePairFirst_pair] using! machinePairFirst_length_le optimizer exact hqCode.trans (hrowCode.trans hrowsCode) have hxWidth : rawRatWidth (rawRatOfRat (X i j)) ≤ L := by have hentryRaw : (rawRatBinaryCode (rawRatOfRat (X i j))).length ≤ optimizer.length := by - simpa only [rawRatBinaryCode_rawRatOfRat] using hentryCode + simpa only [rawRatBinaryCode_rawRatOfRat] using! hentryCode have hoptimizerWord : optimizer.length ≤ word.length := by - simpa only [word, machinePairSecond_pair] using + simpa only [word, machinePairSecond_pair] using! machinePairSecond_length_le word exact (rawRatWidth_le_binaryCode_length _).trans (hentryRaw.trans hoptimizerWord) @@ -554,15 +554,15 @@ theorem rawScheduledLogUpper_complement_width_le_query have hmatrix : (rationalMatrixBinaryEncoding.encode ⟨n, X⟩).length ≤ optimizer.length := by simpa only [optimizer, rationalOptimizerOutputCode, - machinePairFirst_pair] using machinePairFirst_length_le optimizer + machinePairFirst_pair] using! machinePairFirst_length_le optimizer have hoptimizerWord : optimizer.length ≤ word.length := by - simpa only [word, machinePairSecond_pair] using + simpa only [word, machinePairSecond_pair] using! machinePairSecond_length_le word exact hn.trans (hmatrix.trans hoptimizerWord) have hp : directedCertificatePrecision n ≤ L + 400 := by rw [directedCertificatePrecision] omega - simpa only [rawRowComplementUpperInputWidthBudget, L] using + simpa only [rawRowComplementUpperInputWidthBudget, L] using! rawRatWidth_scheduledLogUpper_of_bounds_le (1 - X i j) hp hcompL theorem rawRowComplementUpperCost_le_query @@ -583,7 +583,7 @@ theorem rawRowComplementUpperCost_le_query (directedCertificatePrecision n)) ≤ budget := by intro q hq obtain ⟨j, rfl⟩ := List.mem_ofFn.mp hq - simpa only [word, budget] using + simpa only [word, budget] using! rawScheduledLogUpper_complement_width_le_query X R C i j have rawCost_le_uniform : ∀ xs : List ℚ, (∀ q ∈ xs, rawRatWidth (rawScheduledLogUpper (1 - q) @@ -606,7 +606,7 @@ theorem rawRowComplementUpperCost_le_query (rawScheduledLogUpper (1 - r) (directedCertificatePrecision n)) + 1).sum ≤ qs.length * (budget + 1) := by - simpa only [rawRowComplementUpperCost] using ih' + simpa only [rawRowComplementUpperCost] using! ih' simp only [rawRowComplementUpperCost, List.map_cons, List.sum_cons, List.length_cons, Nat.add_mul] omega @@ -617,12 +617,12 @@ theorem rawRowComplementUpperCost_le_query have hmatrix : (rationalMatrixBinaryEncoding.encode ⟨n, X⟩).length ≤ (rationalOptimizerOutputCode ⟨X, R, C⟩).length := by - simpa only [rationalOptimizerOutputCode, machinePairFirst_pair] using + simpa only [rationalOptimizerOutputCode, machinePairFirst_pair] using! machinePairFirst_length_le (rationalOptimizerOutputCode ⟨X, R, C⟩) have hoptimizerWord : (rationalOptimizerOutputCode ⟨X, R, C⟩).length ≤ word.length := by - simpa only [word, machinePairSecond_pair] using + simpa only [word, machinePairSecond_pair] using! machinePairSecond_length_le word exact hnopt.trans (hmatrix.trans hoptimizerWord) rw [hn] at hcost @@ -645,7 +645,7 @@ theorem machineRowUpperInputBound_length_dominates (word : List Bool) : (rawRowComplementUpperInputWidthBudget word.length + 1)) ≤ 4 + 3 * (1 + word.length * (rawNearbyCoordinateInputWidthBudget word.length + 1)) := by omega - simpa only [machineRowUpperInputBound, machineNearbyMatrixInputBound] using + simpa only [machineRowUpperInputBound, machineNearbyMatrixInputBound] using! htarget.trans hnear @[simp] theorem machineRowComplementUpperSumRawCode_encode @@ -669,7 +669,7 @@ theorem machineRowUpperInputBound_length_dominates (word : List Bool) : word.length := by calc _ = (machineRowUpperInitialRow word).length := by - simpa only [word, xs] using congrArg List.length + simpa only [word, xs] using! congrArg List.length (machineRowUpperInitialRow_encode X R C i).symm _ ≤ word.length := by have hindex := machineListIndex_length_le_data diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRowPairDisjoint.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRowPairDisjoint.lean index db115ff296..b56ca9e9c4 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineRowPairDisjoint.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRowPairDisjoint.lean @@ -130,38 +130,38 @@ theorem machineDisjointRest_mem_FP : machineDisjointRest ∈ FP := theorem machineDisjointCandidateSecond_mem_FP : machineDisjointCandidateSecond ∈ FP := by - simpa only [machineDisjointCandidateSecond] using machineCompose_mem_FP + simpa only [machineDisjointCandidateSecond] using! machineCompose_mem_FP machineDisjointRest_mem_FP machinePairFirst_mem_FP theorem machineDisjointSelectedList_mem_FP : machineDisjointSelectedList ∈ FP := by - simpa only [machineDisjointSelectedList] using machineCompose_mem_FP + simpa only [machineDisjointSelectedList] using! machineCompose_mem_FP machineDisjointRest_mem_FP machinePairSecond_mem_FP theorem machineDisjointRemaining_mem_FP : machineDisjointRemaining ∈ FP := machinePairFirst_mem_FP theorem machineDisjointConflict_mem_FP : machineDisjointConflict ∈ FP := by - simpa only [machineDisjointConflict] using machineCompose_mem_FP + simpa only [machineDisjointConflict] using! machineCompose_mem_FP machinePairSecond_mem_FP machinePairFirst_mem_FP theorem machineDisjointSource_mem_FP : machineDisjointSource ∈ FP := by - simpa only [machineDisjointSource] using machineCompose_mem_FP + simpa only [machineDisjointSource] using! machineCompose_mem_FP machinePairSecond_mem_FP machinePairSecond_mem_FP theorem machineDisjointCurrentPair_mem_FP : machineDisjointCurrentPair ∈ FP := by - simpa only [machineDisjointCurrentPair] using machineCompose_mem_FP + simpa only [machineDisjointCurrentPair] using! machineCompose_mem_FP machineDisjointRemaining_mem_FP machineListHead_mem_FP theorem machineDisjointCurrentFirst_mem_FP : machineDisjointCurrentFirst ∈ FP := by - simpa only [machineDisjointCurrentFirst] using machineCompose_mem_FP + simpa only [machineDisjointCurrentFirst] using! machineCompose_mem_FP machineDisjointCurrentPair_mem_FP machinePairFirst_mem_FP theorem machineDisjointCurrentSecond_mem_FP : machineDisjointCurrentSecond ∈ FP := by - simpa only [machineDisjointCurrentSecond] using machineCompose_mem_FP + simpa only [machineDisjointCurrentSecond] using! machineCompose_mem_FP machineDisjointCurrentPair_mem_FP machinePairSecond_mem_FP theorem machineUnaryRulersEqualBit_mem_FP @@ -170,7 +170,7 @@ theorem machineUnaryRulersEqualBit_mem_FP have hl := machineCompose_mem_FP hlhs machineLengthBits_mem_FP have hr := machineCompose_mem_FP hrhs machineLengthBits_mem_FP have hinput := machinePair_mem_FP hl hr - simpa only [machineUnaryRulersEqualBit] using machineCompose_mem_FP hinput + simpa only [machineUnaryRulersEqualBit] using! machineCompose_mem_FP hinput machineBinaryNatEqBit_mem_FP theorem machineDisjointIFirstBit_mem_FP : machineDisjointIFirstBit ∈ FP := by @@ -213,7 +213,7 @@ theorem machineDisjointNextConflict_mem_FP : machineDisjointCurrentConflictBit_mem_FP have hbound := machineCompose_mem_FP machineDisjointSource_mem_FP machineDisjointInputBound_mem_FP - simpa only [machineDisjointNextConflict] using machineTake_mem_FP hbound hdata + simpa only [machineDisjointNextConflict] using! machineTake_mem_FP hbound hdata theorem machineDisjointProcess_mem_FP : machineDisjointProcess ∈ FP := by have htail := machineCompose_mem_FP machineDisjointRemaining_mem_FP @@ -223,7 +223,7 @@ theorem machineDisjointProcess_mem_FP : machineDisjointProcess ∈ FP := by machineDisjointSource_mem_FP) theorem machineDisjointStep_mem_FP : machineDisjointStep ∈ FP := by - simpa only [machineDisjointStep] using machineIfEmpty_mem_FP + simpa only [machineDisjointStep] using! machineIfEmpty_mem_FP machineDisjointRemaining_mem_FP id_mem_FP machineDisjointProcess_mem_FP theorem machineDisjointInit_mem_FP : machineDisjointInit ∈ FP := @@ -335,7 +335,7 @@ theorem machineDisjointFinalState_mem_FP : machineDisjointFinalState ∈ FP := b machineDisjointWidth_mem_FP machineDisjointIterate_length_le_width theorem machineRowPairConflictBit_mem_FP : machineRowPairConflictBit ∈ FP := by - simpa only [machineRowPairConflictBit] using machineCompose_mem_FP + simpa only [machineRowPairConflictBit] using! machineCompose_mem_FP machineDisjointFinalState_mem_FP machineDisjointConflict_mem_FP theorem machineRowPairDisjointBit_mem_FP : machineRowPairDisjointBit ∈ FP := @@ -423,7 +423,7 @@ theorem machineDisjointSemanticState_step {n : ℕ} have hbound : 1 ≤ (machineDisjointInputBound (machineDisjointInput i j selected)).length := machineDisjoint_one_le_bound _ - rw [(List.take_eq_self_iff _).2 (by simpa using hbound)] + rw [(List.take_eq_self_iff _).2 (by simpa using! hbound)] rw [machineDisjointSemanticState] apply congrArg (fun z : Bool ↦ machineDisjointPack (binaryListCode orderedRowPairCode (selected.drop (k + 1))) [z] diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineScheduledLog.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineScheduledLog.lean index e7a2d11833..61b65d8d72 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineScheduledLog.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineScheduledLog.lean @@ -77,18 +77,18 @@ theorem machineScheduledLogArgumentRawCode_mem_FP : theorem machineScheduledLogPrecisionBits_mem_FP : machineScheduledLogPrecisionBits ∈ Complexity.FP := by - simpa only [machineScheduledLogPrecisionBits] using + simpa only [machineScheduledLogPrecisionBits] using! machineCompose_mem_FP machineScheduledLogPrecisionRuler_mem_FP machineLengthBits_mem_FP theorem machineScheduledLogExponentIntegerCode_mem_FP : machineScheduledLogExponentIntegerCode ∈ Complexity.FP := by - simpa only [machineScheduledLogExponentIntegerCode] using + simpa only [machineScheduledLogExponentIntegerCode] using! machineDirectedLogExponentIntegerCode_mem_FP theorem machineScheduledLogExponentAbsBits_mem_FP : machineScheduledLogExponentAbsBits ∈ Complexity.FP := by - simpa only [machineScheduledLogExponentAbsBits] using + simpa only [machineScheduledLogExponentAbsBits] using! machineCompose_mem_FP machineScheduledLogExponentIntegerCode_mem_FP machineIntegerNatAbsBits_mem_FP @@ -96,7 +96,7 @@ theorem machineScheduledLogPrecisionPlusExponentBits_mem_FP : machineScheduledLogPrecisionPlusExponentBits ∈ Complexity.FP := by have hpair := machinePair_mem_FP machineScheduledLogPrecisionBits_mem_FP machineScheduledLogExponentAbsBits_mem_FP - simpa only [machineScheduledLogPrecisionPlusExponentBits] using + simpa only [machineScheduledLogPrecisionPlusExponentBits] using! machineCompose_mem_FP hpair machineBinaryAddBits_mem_FP theorem machineScheduledLogTermsBits_mem_FP : @@ -104,7 +104,7 @@ theorem machineScheduledLogTermsBits_mem_FP : have hpair := machinePair_mem_FP machineScheduledLogPrecisionPlusExponentBits_mem_FP (machineConst_mem_FP (2 : ℕ).bits) - simpa only [machineScheduledLogTermsBits] using + simpa only [machineScheduledLogTermsBits] using! machineCompose_mem_FP hpair machineBinaryAddBits_mem_FP theorem machineScheduledLogTermsGuard_mem_FP : @@ -115,21 +115,21 @@ theorem machineScheduledLogTermsRuler_mem_FP : machineScheduledLogTermsRuler ∈ Complexity.FP := by have hpair := machinePair_mem_FP machineScheduledLogTermsGuard_mem_FP machineScheduledLogTermsBits_mem_FP - simpa only [machineScheduledLogTermsRuler] using + simpa only [machineScheduledLogTermsRuler] using! machineCompose_mem_FP hpair machineBoundedUnary_mem_FP theorem machineScheduledLogLowerRawCode_mem_FP : machineScheduledLogLowerRawCode ∈ Complexity.FP := by have hpair := machinePair_mem_FP machineScheduledLogTermsRuler_mem_FP machineScheduledLogArgumentRawCode_mem_FP - simpa only [machineScheduledLogLowerRawCode] using + simpa only [machineScheduledLogLowerRawCode] using! machineCompose_mem_FP hpair machineDirectedLogLowerRawCode_mem_FP theorem machineScheduledLogUpperRawCode_mem_FP : machineScheduledLogUpperRawCode ∈ Complexity.FP := by have hpair := machinePair_mem_FP machineScheduledLogTermsRuler_mem_FP machineScheduledLogArgumentRawCode_mem_FP - simpa only [machineScheduledLogUpperRawCode] using + simpa only [machineScheduledLogUpperRawCode] using! machineCompose_mem_FP hpair machineDirectedLogUpperRawCode_mem_FP @[simp] theorem machineScheduledLogPrecisionBits_encode @@ -212,7 +212,7 @@ theorem directedLogTerms_le_scheduledLogGuard (q : ℚ) (p : ℕ) : nlinarith [sq_nonneg (word.length + 14)] simpa only [machineScheduledLogTermsGuard, machineBinaryMulWidth, List.length_replicate, List.length_append, pow_two, - List.length_cons, List.length_nil, Nat.zero_add, word, Nat.add_comm] using + List.length_cons, List.length_nil, Nat.zero_add, word, Nat.add_comm] using! hterms.trans hquad @[simp] theorem machineScheduledLogTermsRuler_encode diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineScheduledRoundedEllipsoid.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineScheduledRoundedEllipsoid.lean index 512ca99207..b268e64fec 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineScheduledRoundedEllipsoid.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineScheduledRoundedEllipsoid.lean @@ -141,7 +141,7 @@ theorem machineScheduledRoundState_mem_FP : theorem machineScheduledRoundDimensionBits_mem_FP : machineScheduledRoundDimensionBits ∈ FP := by - simpa only [machineScheduledRoundDimensionBits] using + simpa only [machineScheduledRoundDimensionBits] using! machineCompose_mem_FP machineScheduledRoundState_mem_FP machineRationalEllipsoidDimensionWord_mem_FP @@ -149,18 +149,18 @@ theorem machineScheduledRoundDimensionUnary_mem_FP : machineScheduledRoundDimensionUnary ∈ FP := by have hinput := machinePair_mem_FP machineScheduledRoundState_mem_FP machineScheduledRoundDimensionBits_mem_FP - simpa only [machineScheduledRoundDimensionUnary] using + simpa only [machineScheduledRoundDimensionUnary] using! machineCompose_mem_FP hinput machineBoundedUnary_mem_FP theorem machineScheduledRoundCenter_mem_FP : machineScheduledRoundCenter ∈ FP := by - simpa only [machineScheduledRoundCenter] using + simpa only [machineScheduledRoundCenter] using! machineCompose_mem_FP machineScheduledRoundState_mem_FP machineRationalEllipsoidCenterWord_mem_FP theorem machineScheduledRoundBasis_mem_FP : machineScheduledRoundBasis ∈ FP := by - simpa only [machineScheduledRoundBasis] using + simpa only [machineScheduledRoundBasis] using! machineCompose_mem_FP machineScheduledRoundState_mem_FP machineRationalEllipsoidBasisWord_mem_FP @@ -173,7 +173,7 @@ theorem machineRoundedInflationDimensionSquareRawCode_mem_FP : have hinput := machinePair_mem_FP machineRoundedInflationDimensionRawCode_mem_FP machineRoundedInflationDimensionRawCode_mem_FP - simpa only [machineRoundedInflationDimensionSquareRawCode] using + simpa only [machineRoundedInflationDimensionSquareRawCode] using! machineCompose_mem_FP hinput machineRawRatMulCode_mem_FP theorem machineRoundedInflationDimensionFourthRawCode_mem_FP : @@ -181,7 +181,7 @@ theorem machineRoundedInflationDimensionFourthRawCode_mem_FP : have hinput := machinePair_mem_FP machineRoundedInflationDimensionSquareRawCode_mem_FP machineRoundedInflationDimensionSquareRawCode_mem_FP - simpa only [machineRoundedInflationDimensionFourthRawCode] using + simpa only [machineRoundedInflationDimensionFourthRawCode] using! machineCompose_mem_FP hinput machineRawRatMulCode_mem_FP theorem machineRoundedInflationDenominatorRawCode_mem_FP : @@ -189,7 +189,7 @@ theorem machineRoundedInflationDenominatorRawCode_mem_FP : have hinput := machinePair_mem_FP (machineConst_mem_FP (rawRatBinaryCode (RawRat.ofNat 1024))) machineRoundedInflationDimensionFourthRawCode_mem_FP - simpa only [machineRoundedInflationDenominatorRawCode] using + simpa only [machineRoundedInflationDenominatorRawCode] using! machineCompose_mem_FP hinput machineRawRatMulCode_mem_FP theorem machineRoundedInflationRawCode_mem_FP : @@ -197,7 +197,7 @@ theorem machineRoundedInflationRawCode_mem_FP : have hinput := machinePair_mem_FP (machineConst_mem_FP (rawRatBinaryCode rawEllipsoidOne)) machineRoundedInflationDenominatorRawCode_mem_FP - simpa only [machineRoundedInflationRawCode] using + simpa only [machineRoundedInflationRawCode] using! machineCompose_mem_FP hinput machineRawRatDivCode_mem_FP theorem machineRoundedInflationFactorRawCode_mem_FP : @@ -205,12 +205,12 @@ theorem machineRoundedInflationFactorRawCode_mem_FP : have hinput := machinePair_mem_FP (machineConst_mem_FP (rawRatBinaryCode rawEllipsoidOne)) machineRoundedInflationRawCode_mem_FP - simpa only [machineRoundedInflationFactorRawCode] using + simpa only [machineRoundedInflationFactorRawCode] using! machineCompose_mem_FP hinput machineRawRatAddCode_mem_FP theorem machineRoundedInflationFactorEntryCode_mem_FP : machineRoundedInflationFactorEntryCode ∈ FP := by - simpa only [machineRoundedInflationFactorEntryCode] using + simpa only [machineRoundedInflationFactorEntryCode] using! machineCompose_mem_FP machineRoundedInflationFactorRawCode_mem_FP machineNormalizeRawRatEntryCode_mem_FP @@ -218,14 +218,14 @@ theorem machineScheduledRoundCenterCode_mem_FP : machineScheduledRoundCenterCode ∈ FP := by have hinput := machinePair_mem_FP machineScheduledRoundPrecision_mem_FP machineScheduledRoundCenter_mem_FP - simpa only [machineScheduledRoundCenterCode] using + simpa only [machineScheduledRoundCenterCode] using! machineCompose_mem_FP hinput machineDyadicFloorVectorCode_mem_FP theorem machineScheduledRoundFlooredBasisCode_mem_FP : machineScheduledRoundFlooredBasisCode ∈ FP := by have hinput := machinePair_mem_FP machineScheduledRoundPrecision_mem_FP machineScheduledRoundBasis_mem_FP - simpa only [machineScheduledRoundFlooredBasisCode] using + simpa only [machineScheduledRoundFlooredBasisCode] using! machineCompose_mem_FP hinput machineDyadicFloorMatrixCode_mem_FP theorem machineScheduledRoundInflationDiagonalCode_mem_FP : @@ -235,7 +235,7 @@ theorem machineScheduledRoundInflationDiagonalCode_mem_FP : machineRoundedInflationFactorEntryCode_mem_FP have hinput := machinePair_mem_FP machineScheduledRoundDimensionUnary_mem_FP hfactor - simpa only [machineScheduledRoundInflationDiagonalCode] using + simpa only [machineScheduledRoundInflationDiagonalCode] using! machineCompose_mem_FP hinput machineDiagonalBasisRowsCode_mem_FP theorem machineScheduledRoundBasisCode_mem_FP : @@ -245,7 +245,7 @@ theorem machineScheduledRoundBasisCode_mem_FP : (machinePair_mem_FP machineScheduledRoundInflationDiagonalCode_mem_FP machineScheduledRoundFlooredBasisCode_mem_FP) - simpa only [machineScheduledRoundBasisCode] using + simpa only [machineScheduledRoundBasisCode] using! machineCompose_mem_FP hinput machineRationalMatrixMulCode_mem_FP theorem machineScheduledRoundedEllipsoidCode_mem_FP : @@ -438,7 +438,7 @@ theorem machineScheduledRoundedEllipsoidCentralUpdateCode_mem_FP : machineRationalEllipsoidCentralUpdateCode_mem_FP have hinput := machinePair_mem_FP machineScheduledCentralPrecision_mem_FP hupdate - simpa only [machineScheduledRoundedEllipsoidCentralUpdateCode] using + simpa only [machineScheduledRoundedEllipsoidCentralUpdateCode] using! machineCompose_mem_FP hinput machineScheduledRoundedEllipsoidCode_mem_FP @[simp] theorem machineScheduledRoundedEllipsoidCentralUpdateCode_encode diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineScheduledStateEncodingBound.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineScheduledStateEncodingBound.lean index 1876cef44a..94e3596b2c 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineScheduledStateEncodingBound.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineScheduledStateEncodingBound.lean @@ -40,10 +40,10 @@ theorem integerBinaryCode_length_le_of_natAbs_le_two_pow (integerBinaryCode z).length ≤ K + 2 := by cases z with | ofNat n => - have hn : n ≤ 2 ^ K := by simpa using h + have hn : n ≤ 2 ^ K := by simpa using! h have hs := nat_size_le_succ_of_le_two_pow hn have hs' : n.bits.length ≤ K + 1 := by - simpa only [Nat.size_eq_bits_len] using hs + simpa only [Nat.size_eq_bits_len] using! hs simp only [integerBinaryCode, List.length_cons] omega | negSucc n => @@ -52,7 +52,7 @@ theorem integerBinaryCode_length_le_of_natAbs_le_two_pow omega have hs := nat_size_le_succ_of_le_two_pow hn have hs' : n.bits.length ≤ K + 1 := by - simpa only [Nat.size_eq_bits_len] using hs + simpa only [Nat.size_eq_bits_len] using! hs simp only [integerBinaryCode, List.length_cons] omega @@ -88,7 +88,7 @@ theorem rationalFiniteVectorCode_length_le_of_bounds {d K P : ℕ} omega simpa only [rationalVectorMachineCodeBound, Finset.sum_const, Finset.card_univ, Fintype.card_fin, nsmul_eq_mul, - Nat.mul_comm] using hsum + Nat.mul_comm] using! hsum theorem rationalSquareMatrixRowsCode_length_le_of_bounds {d K P : ℕ} (A : Matrix (Fin d) (Fin d) ℚ) @@ -110,7 +110,7 @@ theorem rationalSquareMatrixRowsCode_length_le_of_bounds {d K P : ℕ} omega simpa only [rationalMatrixMachineCodeBound, Finset.sum_const, Finset.card_univ, Fintype.card_fin, nsmul_eq_mul, - Nat.mul_comm] using hsum + Nat.mul_comm] using! hsum theorem nat_bits_length_le_add_one (d : ℕ) : d.bits.length ≤ d + 1 := by diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineSmallDimension.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineSmallDimension.lean index 60097f28d5..681ba33e38 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineSmallDimension.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineSmallDimension.lean @@ -44,30 +44,30 @@ theorem machineMatrixDimensionZeroBit_mem_FP : machineMatrixDimensionZeroBit ∈ Complexity.FP := by have hpair := machinePair_mem_FP machineMatrixDimensionWord_mem_FP (machineConst_mem_FP []) - simpa only [machineMatrixDimensionZeroBit] using + simpa only [machineMatrixDimensionZeroBit] using! machineCompose_mem_FP hpair machineBinaryNatEqBit_mem_FP theorem machineMatrixDimensionOneBit_mem_FP : machineMatrixDimensionOneBit ∈ Complexity.FP := by have hpair := machinePair_mem_FP machineMatrixDimensionWord_mem_FP (machineConst_mem_FP [true]) - simpa only [machineMatrixDimensionOneBit] using + simpa only [machineMatrixDimensionOneBit] using! machineCompose_mem_FP hpair machineBinaryNatEqBit_mem_FP theorem machineMatrixFirstRowCode_mem_FP : machineMatrixFirstRowCode ∈ Complexity.FP := by - simpa only [machineMatrixFirstRowCode, machineListHead] using + simpa only [machineMatrixFirstRowCode, machineListHead] using! machineCompose_mem_FP machineMatrixRowsWord_mem_FP machinePairFirst_mem_FP theorem machineMatrixFirstEntryCode_mem_FP : machineMatrixFirstEntryCode ∈ Complexity.FP := by - simpa only [machineMatrixFirstEntryCode, machineListHead] using + simpa only [machineMatrixFirstEntryCode, machineListHead] using! machineCompose_mem_FP machineMatrixFirstRowCode_mem_FP machinePairFirst_mem_FP theorem machineMatrixFirstEntryOutput_mem_FP : machineMatrixFirstEntryOutput ∈ Complexity.FP := by - simpa only [machineMatrixFirstEntryOutput] using + simpa only [machineMatrixFirstEntryOutput] using! machineCompose_mem_FP machineMatrixFirstEntryCode_mem_FP machineRationalBinaryCode_mem_FP diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineSmoothedMatrix.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineSmoothedMatrix.lean index 54bc68e10b..10eb1c2b07 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineSmoothedMatrix.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineSmoothedMatrix.lean @@ -49,7 +49,7 @@ theorem machineSmoothedMatrixInputCode_mem_FP : theorem machineSmoothedMatrixNormalizedCode_mem_FP : machineSmoothedMatrixNormalizedCode ∈ Complexity.FP := by - simpa only [machineSmoothedMatrixNormalizedCode] using + simpa only [machineSmoothedMatrixNormalizedCode] using! machineCompose_mem_FP machineSmoothedMatrixInputCode_mem_FP machineMatrixNormalizeEntries_mem_FP @@ -57,14 +57,14 @@ theorem machineSmoothedMatrixDeltaRawCode_mem_FP : machineSmoothedMatrixDeltaRawCode ∈ Complexity.FP := by have hpair := machinePair_mem_FP machineSmoothedMatrixChiRawCode_mem_FP machineSmoothedMatrixNormalizedCode_mem_FP - simpa only [machineSmoothedMatrixDeltaRawCode] using + simpa only [machineSmoothedMatrixDeltaRawCode] using! machineCompose_mem_FP hpair machineSmoothingDeltaRawCode_mem_FP theorem machineSmoothedMatrixCode_mem_FP : machineSmoothedMatrixCode ∈ Complexity.FP := by have hpair := machinePair_mem_FP machineSmoothedMatrixDeltaRawCode_mem_FP machineSmoothedMatrixNormalizedCode_mem_FP - simpa only [machineSmoothedMatrixCode] using + simpa only [machineSmoothedMatrixCode] using! machineCompose_mem_FP hpair machineMatrixAddDeltaEntries_mem_FP @[simp] theorem machineSmoothedMatrixNormalizedCode_encode {n : ℕ} diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineSmoothingDelta.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineSmoothingDelta.lean index 3749296a42..81bf1f7be3 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineSmoothingDelta.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineSmoothingDelta.lean @@ -95,7 +95,7 @@ theorem machineSmoothingMatrixCode_mem_FP : theorem machineSmoothingDimensionRuler_mem_FP : machineSmoothingDimensionRuler ∈ Complexity.FP := by - simpa only [machineSmoothingDimensionRuler] using + simpa only [machineSmoothingDimensionRuler] using! machineCompose_mem_FP machineSmoothingMatrixCode_mem_FP machineMatrixDimensionUnary_mem_FP @@ -108,7 +108,7 @@ theorem machineSmoothingDimensionRawCode_mem_FP : theorem machineSmoothingSupportRawCode_mem_FP : machineSmoothingSupportRawCode ∈ Complexity.FP := by - simpa only [machineSmoothingSupportRawCode] using + simpa only [machineSmoothingSupportRawCode] using! machineCompose_mem_FP machineSmoothingMatrixCode_mem_FP machineMatrixSupportRawCode_mem_FP @@ -116,12 +116,12 @@ theorem machineSmoothingSupportPowerRawCode_mem_FP : machineSmoothingSupportPowerRawCode ∈ Complexity.FP := by have hpair := machinePair_mem_FP machineSmoothingDimensionRuler_mem_FP machineSmoothingSupportRawCode_mem_FP - simpa only [machineSmoothingSupportPowerRawCode] using + simpa only [machineSmoothingSupportPowerRawCode] using! machineCompose_mem_FP hpair machineRawRatPowerCode_mem_FP theorem machineSmoothingFactorialRawCode_mem_FP : machineSmoothingFactorialRawCode ∈ Complexity.FP := by - simpa only [machineSmoothingFactorialRawCode] using + simpa only [machineSmoothingFactorialRawCode] using! machineCompose_mem_FP machineSmoothingDimensionRuler_mem_FP machineFactorialRawRatCode_mem_FP @@ -130,7 +130,7 @@ theorem machineSmoothingFirstDenominatorRawCode_mem_FP : have hpair := machinePair_mem_FP (machineConst_mem_FP (rawRatBinaryCode (RawRat.ofNat 2))) machineSmoothingDimensionRawCode_mem_FP - simpa only [machineSmoothingFirstDenominatorRawCode] using + simpa only [machineSmoothingFirstDenominatorRawCode] using! machineCompose_mem_FP hpair machineRawRatMulCode_mem_FP theorem machineSmoothingFirstRawCode_mem_FP : @@ -138,14 +138,14 @@ theorem machineSmoothingFirstRawCode_mem_FP : have hpair := machinePair_mem_FP (machineConst_mem_FP (rawRatBinaryCode RawRat.one)) machineSmoothingFirstDenominatorRawCode_mem_FP - simpa only [machineSmoothingFirstRawCode] using + simpa only [machineSmoothingFirstRawCode] using! machineCompose_mem_FP hpair machineRawRatDivCode_mem_FP theorem machineSmoothingWeightedSupportRawCode_mem_FP : machineSmoothingWeightedSupportRawCode ∈ Complexity.FP := by have hpair := machinePair_mem_FP machineSmoothingChiRawCode_mem_FP machineSmoothingSupportPowerRawCode_mem_FP - simpa only [machineSmoothingWeightedSupportRawCode] using + simpa only [machineSmoothingWeightedSupportRawCode] using! machineCompose_mem_FP hpair machineRawRatMulCode_mem_FP theorem machineSmoothingSecondDenominatorRawCode_mem_FP : @@ -153,7 +153,7 @@ theorem machineSmoothingSecondDenominatorRawCode_mem_FP : have hpair := machinePair_mem_FP (machineConst_mem_FP (rawRatBinaryCode (RawRat.ofNat 4))) machineSmoothingFactorialRawCode_mem_FP - simpa only [machineSmoothingSecondDenominatorRawCode] using + simpa only [machineSmoothingSecondDenominatorRawCode] using! machineCompose_mem_FP hpair machineRawRatMulCode_mem_FP theorem machineSmoothingSecondRawCode_mem_FP : @@ -161,19 +161,19 @@ theorem machineSmoothingSecondRawCode_mem_FP : have hpair := machinePair_mem_FP machineSmoothingWeightedSupportRawCode_mem_FP machineSmoothingSecondDenominatorRawCode_mem_FP - simpa only [machineSmoothingSecondRawCode] using + simpa only [machineSmoothingSecondRawCode] using! machineCompose_mem_FP hpair machineRawRatDivCode_mem_FP theorem machineSmoothingDeltaRawCode_mem_FP : machineSmoothingDeltaRawCode ∈ Complexity.FP := by have hpair := machinePair_mem_FP machineSmoothingFirstRawCode_mem_FP machineSmoothingSecondRawCode_mem_FP - simpa only [machineSmoothingDeltaRawCode] using + simpa only [machineSmoothingDeltaRawCode] using! machineCompose_mem_FP hpair machineRawRatMinCode_mem_FP theorem machineSmoothingDeltaCode_mem_FP : machineSmoothingDeltaCode ∈ Complexity.FP := by - simpa only [machineSmoothingDeltaCode] using + simpa only [machineSmoothingDeltaCode] using! machineCompose_mem_FP machineSmoothingDeltaRawCode_mem_FP machineNormalizeRawRatBinaryCode_mem_FP @@ -257,6 +257,7 @@ def rawRationalSmoothingDelta {n : ℕ} machineRawRatMulCode_encode, machineRawRatDivCode_encode, machineRawRatMinCode_encode, rawRationalSmoothingDelta, rawRationalSmoothingFirst, rawRationalSmoothingSecond] + rfl theorem rawRationalSmoothingDelta_value {n : ℕ} (A : Matrix (Fin n) (Fin n) ℚ) (χ : RawRat) : diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineTrimHighZeros.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineTrimHighZeros.lean index 5a1b8b7d63..a24a054339 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineTrimHighZeros.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineTrimHighZeros.lean @@ -39,7 +39,7 @@ def machineTrimHighZeros (word : List Bool) : List Bool := machineTrimPacked (pair [] word) theorem machineTrimAcc_mem_FP : machineTrimAcc ∈ Complexity.FP := by - simpa only [machineTrimAcc] using + simpa only [machineTrimAcc] using! machineCompose_mem_FP machinePairFirst_mem_FP machinePairSecond_mem_FP theorem machineTrimFalseStep_mem_FP : @@ -53,12 +53,12 @@ theorem machineTrimFalseStep_mem_FP : theorem machineTrimTrueStep_mem_FP : machineTrimTrueStep ∈ Complexity.FP := by - simpa only [machineTrimTrueStep] using + simpa only [machineTrimTrueStep] using! machineCompose_mem_FP machineTrimAcc_mem_FP (machinePrepend_mem_FP true) theorem machineTrimPacked_mem_FP : machineTrimPacked ∈ Complexity.FP := by - simpa only [machineTrimPacked, Polynomial.eval_X] using + simpa only [machineTrimPacked, Polynomial.eval_X] using! Cobham.recFoldClamp_mem_FP machineTrimFalseStep_mem_FP machineTrimTrueStep_mem_FP (machineConst_mem_FP []) Polynomial.X @@ -66,7 +66,7 @@ theorem machineTrimHighZeros_mem_FP : machineTrimHighZeros ∈ Complexity.FP := by have hpack : (fun word : List Bool => pair [] word) ∈ Complexity.FP := machinePair_mem_FP (machineConst_mem_FP []) id_mem_FP - simpa only [machineTrimHighZeros] using + simpa only [machineTrimHighZeros] using! machineCompose_mem_FP hpack machineTrimPacked_mem_FP theorem binaryTrimHighZeros_length_le : ∀ bits : List Bool, @@ -128,7 +128,7 @@ theorem machineAssembleCanonicalBits_mem_FP {query ruler : List Bool → List Bool} (hquery : query ∈ Complexity.FP) (hruler : ruler ∈ Complexity.FP) : machineAssembleCanonicalBits query ruler ∈ Complexity.FP := by - simpa only [machineAssembleCanonicalBits] using + simpa only [machineAssembleCanonicalBits] using! machineCompose_mem_FP (machineAssembleBits_mem_FP hquery hruler) machineTrimHighZeros_mem_FP @@ -175,7 +175,7 @@ theorem assembledOutputBitLanguage_padded intro extra induction extra with | zero => - simpa using assembledQueryBits_eq_take + simpa using! assembledQueryBits_eq_take (MachineRAMBridge.languageFlag (outputBitLanguage target)) target (outputBitLanguage_flag_pair target) word (target word).length le_rfl diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineUnaryGridGenerator.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineUnaryGridGenerator.lean index ddea664aa3..298c50b754 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineUnaryGridGenerator.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineUnaryGridGenerator.lean @@ -237,13 +237,13 @@ theorem machineUnaryGridGeneratorRest_mem_FP : theorem machineUnaryGridGeneratorInputBound_mem_FP : machineUnaryGridGeneratorInputBound ∈ FP := by - simpa only [machineUnaryGridGeneratorInputBound] using + simpa only [machineUnaryGridGeneratorInputBound] using! machineCompose_mem_FP machineUnaryGridGeneratorRest_mem_FP machinePairFirst_mem_FP theorem machineUnaryGridGeneratorInputPayload_mem_FP : machineUnaryGridGeneratorInputPayload ∈ FP := by - simpa only [machineUnaryGridGeneratorInputPayload] using + simpa only [machineUnaryGridGeneratorInputPayload] using! machineCompose_mem_FP machineUnaryGridGeneratorRest_mem_FP machinePairSecond_mem_FP @@ -252,14 +252,14 @@ theorem machineUnaryGridGeneratorRow_mem_FP : theorem machineUnaryGridGeneratorColumn_mem_FP : machineUnaryGridGeneratorColumn ∈ FP := by - simpa only [machineUnaryGridGeneratorColumn] using + simpa only [machineUnaryGridGeneratorColumn] using! machineCompose_mem_FP machinePairSecond_mem_FP machinePairFirst_mem_FP theorem machineUnaryGridGeneratorAccumulator_mem_FP : machineUnaryGridGeneratorAccumulator ∈ FP := by have htail := machineCompose_mem_FP machinePairSecond_mem_FP machinePairSecond_mem_FP - simpa only [machineUnaryGridGeneratorAccumulator] using + simpa only [machineUnaryGridGeneratorAccumulator] using! machineCompose_mem_FP htail machinePairFirst_mem_FP theorem machineUnaryGridGeneratorBound_mem_FP : @@ -267,7 +267,7 @@ theorem machineUnaryGridGeneratorBound_mem_FP : have htailTwo := machineCompose_mem_FP machinePairSecond_mem_FP machinePairSecond_mem_FP have htailThree := machineCompose_mem_FP htailTwo machinePairSecond_mem_FP - simpa only [machineUnaryGridGeneratorBound] using + simpa only [machineUnaryGridGeneratorBound] using! machineCompose_mem_FP htailThree machinePairFirst_mem_FP theorem machineUnaryGridGeneratorDone_mem_FP : @@ -276,7 +276,7 @@ theorem machineUnaryGridGeneratorDone_mem_FP : machinePairSecond_mem_FP have htailThree := machineCompose_mem_FP htailTwo machinePairSecond_mem_FP have htailFour := machineCompose_mem_FP htailThree machinePairSecond_mem_FP - simpa only [machineUnaryGridGeneratorDone] using + simpa only [machineUnaryGridGeneratorDone] using! machineCompose_mem_FP htailFour machinePairFirst_mem_FP theorem machineUnaryGridGeneratorPayload_mem_FP : @@ -285,12 +285,12 @@ theorem machineUnaryGridGeneratorPayload_mem_FP : machinePairSecond_mem_FP have htailThree := machineCompose_mem_FP htailTwo machinePairSecond_mem_FP have htailFour := machineCompose_mem_FP htailThree machinePairSecond_mem_FP - simpa only [machineUnaryGridGeneratorPayload] using + simpa only [machineUnaryGridGeneratorPayload] using! machineCompose_mem_FP htailFour machinePairSecond_mem_FP theorem machineUnaryGridGeneratorStateDimension_mem_FP : machineUnaryGridGeneratorStateDimension ∈ FP := by - simpa only [machineUnaryGridGeneratorStateDimension] using + simpa only [machineUnaryGridGeneratorStateDimension] using! machineCompose_mem_FP machineUnaryGridGeneratorPayload_mem_FP machineUnaryGridGeneratorDimension_mem_FP @@ -306,14 +306,14 @@ theorem machineUnaryGridGeneratorNextRow_mem_FP : machineUnaryGridGeneratorNextRow ∈ FP := by have happend := machineAppend_mem_FP machineUnaryGridGeneratorRow_mem_FP (machineConst_mem_FP [true]) - simpa only [machineUnaryGridGeneratorNextRow] using + simpa only [machineUnaryGridGeneratorNextRow] using! machineTake_mem_FP machineUnaryGridGeneratorPayload_mem_FP happend theorem machineUnaryGridGeneratorNextColumn_mem_FP : machineUnaryGridGeneratorNextColumn ∈ FP := by have happend := machineAppend_mem_FP machineUnaryGridGeneratorColumn_mem_FP (machineConst_mem_FP [true]) - simpa only [machineUnaryGridGeneratorNextColumn] using + simpa only [machineUnaryGridGeneratorNextColumn] using! machineTake_mem_FP machineUnaryGridGeneratorPayload_mem_FP happend theorem machineUnaryGridGeneratorColumnCompletesBit_mem_FP : @@ -321,7 +321,7 @@ theorem machineUnaryGridGeneratorColumnCompletesBit_mem_FP : have heq := machineUnaryRulersEqualBit_mem_FP machineUnaryGridGeneratorNextColumn_mem_FP machineUnaryGridGeneratorStateDimension_mem_FP - simpa only [machineUnaryGridGeneratorColumnCompletesBit] using + simpa only [machineUnaryGridGeneratorColumnCompletesBit] using! machineCompose_mem_FP heq machineHeadBit_mem_FP theorem machineUnaryGridGeneratorRowCompletesBit_mem_FP : @@ -329,7 +329,7 @@ theorem machineUnaryGridGeneratorRowCompletesBit_mem_FP : have heq := machineUnaryRulersEqualBit_mem_FP machineUnaryGridGeneratorNextRow_mem_FP machineUnaryGridGeneratorStateDimension_mem_FP - simpa only [machineUnaryGridGeneratorRowCompletesBit] using + simpa only [machineUnaryGridGeneratorRowCompletesBit] using! machineCompose_mem_FP heq machineHeadBit_mem_FP theorem machineUnaryGridGeneratorCandidate_mem_FP @@ -343,7 +343,7 @@ theorem machineUnaryGridGeneratorCandidate_mem_FP theorem machineUnaryGridGeneratorNextAccumulator_mem_FP {entry : List Bool → List Bool} (hentry : entry ∈ FP) : machineUnaryGridGeneratorNextAccumulator entry ∈ FP := by - simpa only [machineUnaryGridGeneratorNextAccumulator] using + simpa only [machineUnaryGridGeneratorNextAccumulator] using! machineTake_mem_FP machineUnaryGridGeneratorBound_mem_FP (machineUnaryGridGeneratorCandidate_mem_FP hentry) @@ -409,7 +409,7 @@ theorem machineUnaryGridGeneratorInit_mem_FP : theorem machineUnaryGridGeneratorDimensionBits_mem_FP : machineUnaryGridGeneratorDimensionBits ∈ FP := by - simpa only [machineUnaryGridGeneratorDimensionBits] using + simpa only [machineUnaryGridGeneratorDimensionBits] using! machineCompose_mem_FP machineUnaryGridGeneratorDimension_mem_FP machineLengthBits_mem_FP @@ -418,7 +418,7 @@ theorem machineUnaryGridGeneratorWorkBits_mem_FP : have hinput := machinePair_mem_FP machineUnaryGridGeneratorDimensionBits_mem_FP machineUnaryGridGeneratorDimensionBits_mem_FP - simpa only [machineUnaryGridGeneratorWorkBits] using + simpa only [machineUnaryGridGeneratorWorkBits] using! machineCompose_mem_FP hinput machineBinaryMulBits_mem_FP theorem machineUnaryGridGeneratorGuard_mem_FP : @@ -428,14 +428,14 @@ theorem machineUnaryGridGeneratorRuler_mem_FP : machineUnaryGridGeneratorRuler ∈ FP := by have hinput := machinePair_mem_FP machineUnaryGridGeneratorGuard_mem_FP machineUnaryGridGeneratorWorkBits_mem_FP - simpa only [machineUnaryGridGeneratorRuler] using + simpa only [machineUnaryGridGeneratorRuler] using! machineCompose_mem_FP hinput machineBoundedUnary_mem_FP theorem machineUnaryGridGeneratorEnvelope_mem_FP : machineUnaryGridGeneratorEnvelope ∈ FP := by have hpadded := machineAppend_mem_FP id_mem_FP (machineConst_mem_FP (List.replicate 16 false)) - simpa only [machineUnaryGridGeneratorEnvelope] using + simpa only [machineUnaryGridGeneratorEnvelope] using! machineCompose_mem_FP hpadded (machineIteratedBinaryWidth_mem_FP 2) theorem machineUnaryGridGeneratorWidth_mem_FP : @@ -661,7 +661,7 @@ theorem machineUnaryGridGeneratorFinalState_mem_FP theorem machineUnaryGridGeneratorReversedCode_mem_FP {entry : List Bool → List Bool} (hentry : entry ∈ FP) : machineUnaryGridGeneratorReversedCode entry ∈ FP := by - simpa only [machineUnaryGridGeneratorReversedCode] using + simpa only [machineUnaryGridGeneratorReversedCode] using! machineCompose_mem_FP (machineUnaryGridGeneratorFinalState_mem_FP hentry) machineUnaryGridGeneratorAccumulator_mem_FP @@ -669,7 +669,7 @@ theorem machineUnaryGridGeneratorReversedCode_mem_FP theorem machineUnaryGridGeneratorCode_mem_FP {entry : List Bool → List Bool} (hentry : entry ∈ FP) : machineUnaryGridGeneratorCode entry ∈ FP := by - simpa only [machineUnaryGridGeneratorCode] using + simpa only [machineUnaryGridGeneratorCode] using! machineCompose_mem_FP (machineUnaryGridGeneratorReversedCode_mem_FP hentry) machineListReverse_mem_FP @@ -814,7 +814,7 @@ def machineUnaryGridGeneratorSemanticCode {m : ℕ} List.replicate (state.row.1 + 1) true := by rw [show ([true] : List Bool) = List.replicate 1 true by rfl, List.replicate_append_replicate] - rw [happend, List.take_of_length_le (by simpa using hlength)] + rw [happend, List.take_of_length_le (by simpa using! hlength)] @[simp] theorem machineUnaryGridGeneratorNextColumn_semanticCode {m : ℕ} (bound payload : List Bool) (state : UnaryGridSemanticState m) : @@ -838,7 +838,7 @@ def machineUnaryGridGeneratorSemanticCode {m : ℕ} List.replicate (state.column.1 + 1) true := by rw [show ([true] : List Bool) = List.replicate 1 true by rfl, List.replicate_append_replicate] - rw [happend, List.take_of_length_le (by simpa using hlength)] + rw [happend, List.take_of_length_le (by simpa using! hlength)] @[simp] theorem machineUnaryGridGeneratorColumnCompletesBit_semanticCode {m : ℕ} (bound payload : List Bool) @@ -1031,7 +1031,7 @@ theorem unaryGridPrefix_succ_of_ordinal {m k : ℕ} rw [← hordinal] exact unaryGridOrdinal_lt_square row column have hget : (unaryGridValues f)[k] = f row column := by - have hk' : k < m * m := by simpa using hk + have hk' : k < m * m := by simpa using! hk let ij : Fin m × Fin m := (row, column) have hfin : (⟨k, hk'⟩ : Fin (m * m)) = finProdFinEquiv ij := by apply Fin.ext @@ -1042,7 +1042,7 @@ theorem unaryGridPrefix_succ_of_ordinal {m k : ℕ} simp only [unaryGridValues, List.getElem_ofFn] rw [hfin, Equiv.symm_apply_apply] rw [unaryGridPrefix, unaryGridPrefix] - simpa only [List.concat_eq_append, hget] using + simpa only [List.concat_eq_append, hget] using! (List.take_concat_get hk).symm def UnaryGridValueInvariant {m : ℕ} @@ -1217,11 +1217,11 @@ theorem machineUnaryGridGeneratorIterate_semanticCode {m : ℕ} rw [unaryGridSemanticStateAt_candidate_eq_prefix hm f hklt] have hprefixBound := binaryListCode_take_reverse_length_le rationalEntryBinaryCode (unaryGridValues f) (k + 1) - simpa only [unaryGridPrefix] using hprefixBound.trans hbound + simpa only [unaryGridPrefix] using! hprefixBound.trans hbound have hstep := machineUnaryGridGeneratorStep_semanticCode entry f bound payload (unaryGridSemanticStateAt hm f k) hentry hlarge simpa only [unaryGridSemanticStateAt, - Function.iterate_succ_apply'] using hstep + Function.iterate_succ_apply'] using! hstep theorem machineUnaryGridGeneratorReversedCode_encode_of_bound {m : ℕ} (entry : List Bool → List Bool) (f : Fin m → Fin m → ℚ) diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineUnaryMatrixGenerator.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineUnaryMatrixGenerator.lean index 5a5fc337f4..f7fae2661a 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineUnaryMatrixGenerator.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineUnaryMatrixGenerator.lean @@ -261,13 +261,13 @@ theorem machineUnaryMatrixGeneratorRest_mem_FP : theorem machineUnaryMatrixGeneratorInputBound_mem_FP : machineUnaryMatrixGeneratorInputBound ∈ FP := by - simpa only [machineUnaryMatrixGeneratorInputBound] using + simpa only [machineUnaryMatrixGeneratorInputBound] using! machineCompose_mem_FP machineUnaryMatrixGeneratorRest_mem_FP machinePairFirst_mem_FP theorem machineUnaryMatrixGeneratorInputPayload_mem_FP : machineUnaryMatrixGeneratorInputPayload ∈ FP := by - simpa only [machineUnaryMatrixGeneratorInputPayload] using + simpa only [machineUnaryMatrixGeneratorInputPayload] using! machineCompose_mem_FP machineUnaryMatrixGeneratorRest_mem_FP machinePairSecond_mem_FP @@ -276,20 +276,20 @@ theorem machineUnaryMatrixGeneratorRow_mem_FP : theorem machineUnaryMatrixGeneratorColumn_mem_FP : machineUnaryMatrixGeneratorColumn ∈ FP := by - simpa only [machineUnaryMatrixGeneratorColumn] using + simpa only [machineUnaryMatrixGeneratorColumn] using! machineCompose_mem_FP machinePairSecond_mem_FP machinePairFirst_mem_FP theorem machineUnaryMatrixGeneratorCurrent_mem_FP : machineUnaryMatrixGeneratorCurrent ∈ FP := by have h := machineCompose_mem_FP machinePairSecond_mem_FP machinePairSecond_mem_FP - simpa only [machineUnaryMatrixGeneratorCurrent] using + simpa only [machineUnaryMatrixGeneratorCurrent] using! machineCompose_mem_FP h machinePairFirst_mem_FP theorem machineUnaryMatrixGeneratorRows_mem_FP : machineUnaryMatrixGeneratorRows ∈ FP := by have h₂ := machineCompose_mem_FP machinePairSecond_mem_FP machinePairSecond_mem_FP have h₃ := machineCompose_mem_FP h₂ machinePairSecond_mem_FP - simpa only [machineUnaryMatrixGeneratorRows] using + simpa only [machineUnaryMatrixGeneratorRows] using! machineCompose_mem_FP h₃ machinePairFirst_mem_FP theorem machineUnaryMatrixGeneratorBound_mem_FP : @@ -297,7 +297,7 @@ theorem machineUnaryMatrixGeneratorBound_mem_FP : have h₂ := machineCompose_mem_FP machinePairSecond_mem_FP machinePairSecond_mem_FP have h₃ := machineCompose_mem_FP h₂ machinePairSecond_mem_FP have h₄ := machineCompose_mem_FP h₃ machinePairSecond_mem_FP - simpa only [machineUnaryMatrixGeneratorBound] using + simpa only [machineUnaryMatrixGeneratorBound] using! machineCompose_mem_FP h₄ machinePairFirst_mem_FP theorem machineUnaryMatrixGeneratorDone_mem_FP : @@ -306,7 +306,7 @@ theorem machineUnaryMatrixGeneratorDone_mem_FP : have h₃ := machineCompose_mem_FP h₂ machinePairSecond_mem_FP have h₄ := machineCompose_mem_FP h₃ machinePairSecond_mem_FP have h₅ := machineCompose_mem_FP h₄ machinePairSecond_mem_FP - simpa only [machineUnaryMatrixGeneratorDone] using + simpa only [machineUnaryMatrixGeneratorDone] using! machineCompose_mem_FP h₅ machinePairFirst_mem_FP theorem machineUnaryMatrixGeneratorPayload_mem_FP : @@ -315,12 +315,12 @@ theorem machineUnaryMatrixGeneratorPayload_mem_FP : have h₃ := machineCompose_mem_FP h₂ machinePairSecond_mem_FP have h₄ := machineCompose_mem_FP h₃ machinePairSecond_mem_FP have h₅ := machineCompose_mem_FP h₄ machinePairSecond_mem_FP - simpa only [machineUnaryMatrixGeneratorPayload] using + simpa only [machineUnaryMatrixGeneratorPayload] using! machineCompose_mem_FP h₅ machinePairSecond_mem_FP theorem machineUnaryMatrixGeneratorStateDimension_mem_FP : machineUnaryMatrixGeneratorStateDimension ∈ FP := by - simpa only [machineUnaryMatrixGeneratorStateDimension] using + simpa only [machineUnaryMatrixGeneratorStateDimension] using! machineCompose_mem_FP machineUnaryMatrixGeneratorPayload_mem_FP machineUnaryMatrixGeneratorDimension_mem_FP @@ -336,14 +336,14 @@ theorem machineUnaryMatrixGeneratorNextRow_mem_FP : machineUnaryMatrixGeneratorNextRow ∈ FP := by have happend := machineAppend_mem_FP machineUnaryMatrixGeneratorRow_mem_FP (machineConst_mem_FP [true]) - simpa only [machineUnaryMatrixGeneratorNextRow] using + simpa only [machineUnaryMatrixGeneratorNextRow] using! machineTake_mem_FP machineUnaryMatrixGeneratorPayload_mem_FP happend theorem machineUnaryMatrixGeneratorNextColumn_mem_FP : machineUnaryMatrixGeneratorNextColumn ∈ FP := by have happend := machineAppend_mem_FP machineUnaryMatrixGeneratorColumn_mem_FP (machineConst_mem_FP [true]) - simpa only [machineUnaryMatrixGeneratorNextColumn] using + simpa only [machineUnaryMatrixGeneratorNextColumn] using! machineTake_mem_FP machineUnaryMatrixGeneratorPayload_mem_FP happend theorem machineUnaryMatrixGeneratorColumnCompletesBit_mem_FP : @@ -351,7 +351,7 @@ theorem machineUnaryMatrixGeneratorColumnCompletesBit_mem_FP : have heq := machineUnaryRulersEqualBit_mem_FP machineUnaryMatrixGeneratorNextColumn_mem_FP machineUnaryMatrixGeneratorStateDimension_mem_FP - simpa only [machineUnaryMatrixGeneratorColumnCompletesBit] using + simpa only [machineUnaryMatrixGeneratorColumnCompletesBit] using! machineCompose_mem_FP heq machineHeadBit_mem_FP theorem machineUnaryMatrixGeneratorRowCompletesBit_mem_FP : @@ -359,7 +359,7 @@ theorem machineUnaryMatrixGeneratorRowCompletesBit_mem_FP : have heq := machineUnaryRulersEqualBit_mem_FP machineUnaryMatrixGeneratorNextRow_mem_FP machineUnaryMatrixGeneratorStateDimension_mem_FP - simpa only [machineUnaryMatrixGeneratorRowCompletesBit] using + simpa only [machineUnaryMatrixGeneratorRowCompletesBit] using! machineCompose_mem_FP heq machineHeadBit_mem_FP theorem machineUnaryMatrixGeneratorCurrentCandidate_mem_FP @@ -373,14 +373,14 @@ theorem machineUnaryMatrixGeneratorCurrentCandidate_mem_FP theorem machineUnaryMatrixGeneratorNextCurrent_mem_FP {entry : List Bool → List Bool} (hentry : entry ∈ FP) : machineUnaryMatrixGeneratorNextCurrent entry ∈ FP := by - simpa only [machineUnaryMatrixGeneratorNextCurrent] using + simpa only [machineUnaryMatrixGeneratorNextCurrent] using! machineTake_mem_FP machineUnaryMatrixGeneratorBound_mem_FP (machineUnaryMatrixGeneratorCurrentCandidate_mem_FP hentry) theorem machineUnaryMatrixGeneratorCompletedRow_mem_FP {entry : List Bool → List Bool} (hentry : entry ∈ FP) : machineUnaryMatrixGeneratorCompletedRow entry ∈ FP := by - simpa only [machineUnaryMatrixGeneratorCompletedRow] using + simpa only [machineUnaryMatrixGeneratorCompletedRow] using! machineCompose_mem_FP (machineUnaryMatrixGeneratorNextCurrent_mem_FP hentry) machineListReverse_mem_FP @@ -394,7 +394,7 @@ theorem machineUnaryMatrixGeneratorRowsCandidate_mem_FP theorem machineUnaryMatrixGeneratorNextRows_mem_FP {entry : List Bool → List Bool} (hentry : entry ∈ FP) : machineUnaryMatrixGeneratorNextRows entry ∈ FP := by - simpa only [machineUnaryMatrixGeneratorNextRows] using + simpa only [machineUnaryMatrixGeneratorNextRows] using! machineTake_mem_FP machineUnaryMatrixGeneratorBound_mem_FP (machineUnaryMatrixGeneratorRowsCandidate_mem_FP hentry) @@ -461,7 +461,7 @@ theorem machineUnaryMatrixGeneratorInit_mem_FP : theorem machineUnaryMatrixGeneratorDimensionBits_mem_FP : machineUnaryMatrixGeneratorDimensionBits ∈ FP := by - simpa only [machineUnaryMatrixGeneratorDimensionBits] using + simpa only [machineUnaryMatrixGeneratorDimensionBits] using! machineCompose_mem_FP machineUnaryMatrixGeneratorDimension_mem_FP machineLengthBits_mem_FP @@ -470,7 +470,7 @@ theorem machineUnaryMatrixGeneratorWorkBits_mem_FP : have hinput := machinePair_mem_FP machineUnaryMatrixGeneratorDimensionBits_mem_FP machineUnaryMatrixGeneratorDimensionBits_mem_FP - simpa only [machineUnaryMatrixGeneratorWorkBits] using + simpa only [machineUnaryMatrixGeneratorWorkBits] using! machineCompose_mem_FP hinput machineBinaryMulBits_mem_FP theorem machineUnaryMatrixGeneratorGuard_mem_FP : @@ -480,14 +480,14 @@ theorem machineUnaryMatrixGeneratorRuler_mem_FP : machineUnaryMatrixGeneratorRuler ∈ FP := by have hinput := machinePair_mem_FP machineUnaryMatrixGeneratorGuard_mem_FP machineUnaryMatrixGeneratorWorkBits_mem_FP - simpa only [machineUnaryMatrixGeneratorRuler] using + simpa only [machineUnaryMatrixGeneratorRuler] using! machineCompose_mem_FP hinput machineBoundedUnary_mem_FP theorem machineUnaryMatrixGeneratorEnvelope_mem_FP : machineUnaryMatrixGeneratorEnvelope ∈ FP := by have hpadded := machineAppend_mem_FP id_mem_FP (machineConst_mem_FP (List.replicate 16 false)) - simpa only [machineUnaryMatrixGeneratorEnvelope] using + simpa only [machineUnaryMatrixGeneratorEnvelope] using! machineCompose_mem_FP hpadded (machineIteratedBinaryWidth_mem_FP 2) theorem machineUnaryMatrixGeneratorWidth_mem_FP : @@ -718,7 +718,7 @@ theorem machineUnaryMatrixGeneratorFinalState_mem_FP theorem machineUnaryMatrixGeneratorReversedRowsCode_mem_FP {entry : List Bool → List Bool} (hentry : entry ∈ FP) : machineUnaryMatrixGeneratorReversedRowsCode entry ∈ FP := by - simpa only [machineUnaryMatrixGeneratorReversedRowsCode] using + simpa only [machineUnaryMatrixGeneratorReversedRowsCode] using! machineCompose_mem_FP (machineUnaryMatrixGeneratorFinalState_mem_FP hentry) machineUnaryMatrixGeneratorRows_mem_FP @@ -726,7 +726,7 @@ theorem machineUnaryMatrixGeneratorReversedRowsCode_mem_FP theorem machineUnaryMatrixGeneratorRowsCode_mem_FP {entry : List Bool → List Bool} (hentry : entry ∈ FP) : machineUnaryMatrixGeneratorRowsCode entry ∈ FP := by - simpa only [machineUnaryMatrixGeneratorRowsCode] using + simpa only [machineUnaryMatrixGeneratorRowsCode] using! machineCompose_mem_FP (machineUnaryMatrixGeneratorReversedRowsCode_mem_FP hentry) machineListReverse_mem_FP @@ -809,7 +809,7 @@ def unaryMatrixRows {m : ℕ} @[simp] theorem unaryMatrixRows_getElem {m : ℕ} (f : Fin m → Fin m → ℚ) (i : ℕ) (hi : i < (unaryMatrixRows f).length) : (unaryMatrixRows f)[i] = - List.ofFn (f ⟨i, by simpa using hi⟩) := by + List.ofFn (f ⟨i, by simpa using! hi⟩) := by simp [unaryMatrixRows] def unaryMatrixCurrent {m : ℕ} @@ -868,7 +868,7 @@ def machineUnaryMatrixGeneratorSemanticCode {m : ℕ} List.replicate (state.row.1 + 1) true := by rw [show ([true] : List Bool) = List.replicate 1 true by rfl, List.replicate_append_replicate] - rw [happend, List.take_of_length_le (by simpa using hlength)] + rw [happend, List.take_of_length_le (by simpa using! hlength)] @[simp] theorem machineUnaryMatrixGeneratorNextColumn_semanticCode {m : ℕ} (f : Fin m → Fin m → ℚ) (bound payload : List Bool) @@ -893,7 +893,7 @@ def machineUnaryMatrixGeneratorSemanticCode {m : ℕ} List.replicate (state.column.1 + 1) true := by rw [show ([true] : List Bool) = List.replicate 1 true by rfl, List.replicate_append_replicate] - rw [happend, List.take_of_length_le (by simpa using hlength)] + rw [happend, List.take_of_length_le (by simpa using! hlength)] @[simp] theorem machineUnaryMatrixGeneratorColumnCompletesBit_semanticCode {m : ℕ} (f : Fin m → Fin m → ℚ) (bound payload : List Bool) @@ -950,7 +950,7 @@ theorem unaryMatrixCurrentCandidate_eq {m : ℕ} f state.row state.column := by simp rw [hget] at htake rw [← htake] - simpa only [List.concat_eq_append] using + simpa only [List.concat_eq_append] using! (List.reverse_concat (l := (List.ofFn (f state.row)).take state.column.1) (a := f state.row state.column)).symm @@ -977,7 +977,7 @@ theorem unaryMatrixRowsCandidate_eq {m : ℕ} List.ofFn (f state.row) := by simp [unaryMatrixRows] rw [← hget, ← htake] - simpa only [List.concat_eq_append] using + simpa only [List.concat_eq_append] using! (List.reverse_concat (l := (unaryMatrixRows f).take state.row.1) (a := (unaryMatrixRows f)[state.row.1])).symm @@ -1195,7 +1195,7 @@ theorem machineUnaryMatrixGeneratorIterate_semanticCode {m : ℕ} | succ k ih => rw [Function.iterate_succ_apply', ih] simpa only [unaryGridSemanticStateAt, - Function.iterate_succ_apply'] using + Function.iterate_succ_apply'] using! machineUnaryMatrixGeneratorStep_semanticCode entry f bound payload (unaryGridSemanticStateAt hm f k) hentry hbound diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineUnaryRange.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineUnaryRange.lean index cdff453abc..07d0a33053 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineUnaryRange.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineUnaryRange.lean @@ -73,12 +73,12 @@ theorem machineUnaryRangeRemaining_mem_FP : theorem machineUnaryRangeAcc_mem_FP : machineUnaryRangeAcc ∈ Complexity.FP := by - simpa only [machineUnaryRangeAcc] using + simpa only [machineUnaryRangeAcc] using! machineCompose_mem_FP machinePairSecond_mem_FP machinePairFirst_mem_FP theorem machineUnaryRangeBound_mem_FP : machineUnaryRangeBound ∈ Complexity.FP := by - simpa only [machineUnaryRangeBound] using + simpa only [machineUnaryRangeBound] using! machineCompose_mem_FP machinePairSecond_mem_FP machinePairSecond_mem_FP theorem machineUnaryRangeCandidate_mem_FP : @@ -89,7 +89,7 @@ theorem machineUnaryRangeCandidate_mem_FP : theorem machineUnaryRangeNextAcc_mem_FP : machineUnaryRangeNextAcc ∈ Complexity.FP := by - simpa only [machineUnaryRangeNextAcc] using + simpa only [machineUnaryRangeNextAcc] using! machineTake_mem_FP machineUnaryRangeBound_mem_FP machineUnaryRangeCandidate_mem_FP @@ -184,7 +184,7 @@ theorem machineUnaryRangeIterate_bound (ruler : List Bool) : ∀ k, ((machineUnaryRangeStep)^[k] (machineUnaryRangeInit ruler)) := by intro k induction k with - | zero => simpa using machineUnaryRangeInit_bound ruler + | zero => simpa using! machineUnaryRangeInit_bound ruler | succ k ih => rw [Function.iterate_succ_apply'] exact machineUnaryRangeStep_bound ih @@ -210,7 +210,7 @@ theorem machineUnaryRangeFinalState_mem_FP : theorem machineUnaryRangeCode_mem_FP : machineUnaryRangeCode ∈ Complexity.FP := by - simpa only [machineUnaryRangeCode] using + simpa only [machineUnaryRangeCode] using! machineCompose_mem_FP machineUnaryRangeFinalState_mem_FP machineUnaryRangeAcc_mem_FP @@ -228,7 +228,7 @@ theorem finRangeUnaryCode_length_le_bound (n : ℕ) : have heach : ∀ i ∈ List.finRange n, (finUnaryCode i).length ≤ n := by intro i _ - simpa [finUnaryCode] using i.isLt.le + simpa [finUnaryCode] using! i.isLt.le have hsum : ((List.finRange n).map fun i ↦ 2 * (finUnaryCode i).length + 2).sum ≤ n * (2 * n + 2) := by @@ -240,7 +240,7 @@ theorem finRangeUnaryCode_length_le_bound (n : ℕ) : obtain ⟨i, hi, rfl⟩ := hvalue have := heach i hi omega) - simpa [List.length_finRange, Nat.nsmul_eq_mul] using h + simpa [List.length_finRange, Nat.nsmul_eq_mul] using! h simp only [machineUnaryRangeInputBound, machineListUpdateInputBound, machineBinaryMulWidth, List.length_replicate, List.length_append] exact hsum.trans (by nlinarith) @@ -293,7 +293,7 @@ theorem machineUnaryRangeSemanticState_step (n k : ℕ) (hk : k < n) : pair (List.replicate (n - k - 1) true) (binaryListCode finUnaryCode ((List.finRange n).drop (n - k - 1 + 1))) := by - simpa only [← hsub] using htake + simpa only [← hsub] using! htake have hnext : n - (k + 1) = n - k - 1 := by omega rw [machineUnaryRangeSemanticState, hsub, List.replicate_succ, machineUnaryRangeStep] diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseDecisionProof.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseDecisionProof.lean index 1259ffbab7..f13334be7e 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseDecisionProof.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseDecisionProof.lean @@ -137,7 +137,7 @@ theorem denseProgramDecisionTM_hoareTime_run_internal (fun i => (hinitWorkParked i).read_ne_start) hinitOutputParked.read_ne_start rw [hi, hw, ho] - simpa only [hinitInput] using htailReach + simpa only [hinitInput] using! htailReach have hreach := TM.seqTM_reachesIn_of_reachesIn (denseProgramInitTM tapes) (TM.seqTM (denseProgramLoopTM tapes program) @@ -153,8 +153,9 @@ theorem denseProgramDecisionTM_hoareTime_run_internal omega · change (denseProgramDecisionTM tapes program).halted done unfold denseProgramDecisionTM - rw [TM.phase2Wrap_halted_iff] - exact htailHalt + exact (TM.phase2Wrap_halted_iff (denseProgramInitTM tapes) + (TM.seqTM (denseProgramLoopTM tapes program) + (denseProgramOutputTM tapes)) tailDone).mpr htailHalt · change outputDone.output = registerVerdictOutput (DenseOverlay.read input final.overlay 0) exact houtputVerdict From 44947667e9d1a5b5715432605e4d2813ba896910 Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Fri, 25 Sep 2026 19:51:55 +0000 Subject: [PATCH 20/49] Checkpoint Beyond Bethe module migration and 385 reviewed docstrings --- LeanPool/BeyondBethe.lean | 1354 +++++++++-------- LeanPool/BeyondBethe/BeyondBethe.lean | 508 ++++--- .../BeyondBethe/AdaptiveRoundedEllipsoid.lean | 8 +- .../BeyondBethe/AlgorithmicSpec.lean | 18 +- .../BeyondBethe/ApproximateKKT.lean | 12 +- .../BeyondBethe/BeyondBethe/AxiomAudit.lean | 8 +- LeanPool/BeyondBethe/BeyondBethe/Bethe.lean | 15 +- .../BeyondBethe/BetheBisection.lean | 17 +- .../BeyondBethe/BetheEpigraph.lean | 15 +- .../BeyondBethe/BetheEpigraphFeasibility.lean | 8 +- .../BeyondBethe/BetheEpigraphGeometry.lean | 12 +- .../BeyondBethe/BetheFloorCutFormula.lean | 6 +- .../BetheThresholdFeasibility.lean | 10 +- .../BeyondBethe/BinaryDirectedElementary.lean | 32 +- .../BeyondBethe/BinaryLongDivision.lean | 8 +- .../BeyondBethe/BinaryRationalComparison.lean | 8 +- .../BeyondBethe/BinaryRationalFloor.lean | 10 +- .../BeyondBethe/BeyondBethe/Birkhoff.lean | 8 +- .../BeyondBethe/BeyondBethe/Capacity.lean | 12 +- .../BeyondBethe/CapacityOrder.lean | 8 +- .../BeyondBethe/CapacityScaling.lean | 8 +- .../BeyondBethe/CertificateCapacity.lean | 15 +- .../BeyondBethe/CertificateMagnitude.lean | 17 +- .../BeyondBethe/CertifiedPairWeights.lean | 10 +- .../BeyondBethe/CleanConstants.lean | 8 +- .../BeyondBethe/BeyondBethe/CleanGain.lean | 10 +- .../BeyondBethe/BeyondBethe/CleanWitness.lean | 15 +- .../BeyondBethe/BeyondBethe/ClusterAlpha.lean | 10 +- .../BeyondBethe/ClusterCertificate.lean | 15 +- .../BeyondBethe/ClusterFactors.lean | 11 +- .../BeyondBethe/ClusterProduct.lean | 7 +- .../BeyondBethe/BeyondBethe/Completion.lean | 12 +- .../BeyondBethe/BeyondBethe/CoreEncoding.lean | 15 +- .../BeyondBethe/CycleTransfer.lean | 12 +- LeanPool/BeyondBethe/BeyondBethe/Cycles.lean | 14 +- .../BeyondBethe/DirectedCertificateValue.lean | 19 +- .../BeyondBethe/DirectedElementary.lean | 12 +- .../BeyondBethe/DirectedOptimizerOracle.lean | 12 +- .../BeyondBethe/DirectedPairCost.lean | 12 +- .../BeyondBethe/DyadicMagnitudePrecision.lean | 10 +- .../BeyondBethe/DyadicRounding.lean | 12 +- LeanPool/BeyondBethe/BeyondBethe/Entropy.lean | 18 +- .../BeyondBethe/ExcursionTransfer.lean | 13 +- .../BeyondBethe/ExecutableCertificate.lean | 10 +- .../ExecutableCertificateMagnitude.lean | 8 +- .../BeyondBethe/ExecutableInterior.lean | 15 +- .../ExecutablePositiveRoutine.lean | 16 +- .../ExecutableScannedBetheOptimizer.lean | 21 +- .../BeyondBethe/ExecutableTransfer.lean | 10 +- .../BeyondBethe/ExplicitBetheOptimizer.lean | 13 +- .../ExplicitBetheThresholdFeasibility.lean | 12 +- .../BeyondBethe/ExplicitBounds.lean | 17 +- .../BeyondBethe/ExplicitOptimizerScales.lean | 25 +- .../BeyondBethe/ExplicitPositiveRoutine.lean | 14 +- .../BeyondBethe/ExplicitScales.lean | 23 +- .../ExplicitScheduledFeasibility.lean | 14 +- .../BeyondBethe/FinalAssembly.lean | 14 +- LeanPool/BeyondBethe/BeyondBethe/Gain.lean | 16 +- LeanPool/BeyondBethe/BeyondBethe/Gibbs.lean | 8 +- .../BeyondBethe/BeyondBethe/GoodRowScore.lean | 14 +- .../BeyondBethe/GreedyRowMatching.lean | 10 +- .../BeyondBethe/BeyondBethe/KuhnMatching.lean | 22 +- .../BeyondBethe/KuhnSmallStep.lean | 15 +- .../BeyondBethe/MachineArithmeticTests.lean | 53 +- .../BeyondBethe/MachineBetheAffineEntry.lean | 37 +- .../MachineBetheAffineLineSum.lean | 56 +- .../MachineBetheEpigraphOracle.lean | 67 +- .../MachineBetheFeasibilityFit.lean | 12 +- .../MachineBetheFeasibilityLoop.lean | 63 +- .../MachineBetheFeasibilitySemantics.lean | 16 +- .../MachineBetheFloorCutEntry.lean | 32 +- .../MachineBetheFloorCutVector.lean | 29 +- .../BeyondBethe/MachineBetheFloorScan.lean | 8 +- .../BeyondBethe/MachineBetheFloorTest.lean | 10 +- .../BeyondBethe/MachineBetheHeightCap.lean | 8 +- .../BeyondBethe/MachineBetheHeightNormal.lean | 6 +- .../BeyondBethe/MachineBinaryAdd.lean | 6 +- .../MachineBinaryAddSemantics.lean | 8 +- .../BeyondBethe/MachineBinaryCompare.lean | 6 +- .../BeyondBethe/MachineBinaryDivision.lean | 8 +- .../BeyondBethe/MachineBinaryGCD.lean | 8 +- .../BeyondBethe/MachineBinaryListInit.lean | 6 +- .../BeyondBethe/MachineBinaryListSnoc.lean | 6 +- .../BeyondBethe/MachineBinaryMul.lean | 8 +- .../BeyondBethe/MachineBinarySub.lean | 24 +- .../BeyondBethe/MachineBitAssembly.lean | 18 +- .../BeyondBethe/BeyondBethe/MachineBool.lean | 14 +- .../BeyondBethe/MachineBooleanInit.lean | 30 +- .../BeyondBethe/MachineBooleanMemory.lean | 13 +- .../BeyondBethe/MachineBoundedUnary.lean | 22 +- .../MachineCertificateAssembly.lean | 18 +- .../MachineCertificateExpGuard.lean | 8 +- .../MachineCertificatePotentials.lean | 6 +- .../BeyondBethe/MachineCertificateScales.lean | 10 +- .../MachineCertifiedPairEligibility.lean | 10 +- .../MachineCompletedAlgorithm.lean | 12 +- .../MachineDirectedAffineGradientEntry.lean | 6 +- .../MachineDirectedAffineGradientVector.lean | 8 +- .../MachineDirectedEpigraphNormal.lean | 8 +- .../BeyondBethe/MachineDirectedLog.lean | 10 +- ...ineDirectedNegativeGradientCoordinate.lean | 6 +- .../MachineDirectedNegativeGradientEntry.lean | 8 +- ...neDirectedNegativeObjectiveCoordinate.lean | 10 +- .../MachineDirectedNegativeObjectiveSum.lean | 14 +- .../MachineDirectedTransferCost.lean | 6 +- .../BeyondBethe/MachineDyadicFloor.lean | 8 +- .../BeyondBethe/MachineDyadicFloorMatrix.lean | 6 +- .../BeyondBethe/MachineDyadicFloorVector.lean | 8 +- .../BeyondBethe/MachineEncoding.lean | 8 +- .../MachineExecutableCertificate.lean | 12 +- .../MachineExecutablePositiveAlgorithm.lean | 10 +- ...chineExecutableScannedOptimizerOutput.lean | 12 +- .../MachineExplicitCertificate.lean | 8 +- .../BeyondBethe/MachineFPBasics.lean | 10 +- .../BeyondBethe/MachineFactorial.lean | 6 +- .../BeyondBethe/MachineFinalScalars.lean | 10 +- .../BeyondBethe/MachineFourCoreCost.lean | 6 +- .../BeyondBethe/MachineGreedyRowMatching.lean | 6 +- .../BeyondBethe/MachineIntegerArithmetic.lean | 6 +- .../BeyondBethe/MachineIntegerCompare.lean | 6 +- .../MachineIntegerSignedMagnitude.lean | 10 +- .../BeyondBethe/MachineKuhnEncoding.lean | 6 +- .../BeyondBethe/MachineKuhnInvariant.lean | 10 +- .../BeyondBethe/MachineKuhnRunner.lean | 8 +- .../BeyondBethe/MachineKuhnSemantics.lean | 8 +- .../BeyondBethe/MachineKuhnStep.lean | 6 +- .../BeyondBethe/MachineLengthBits.lean | 6 +- .../BeyondBethe/MachineListIndex.lean | 6 +- .../BeyondBethe/MachineListReverse.lean | 8 +- .../BeyondBethe/MachineListUpdate.lean | 6 +- .../BeyondBethe/MachineMatchingGain.lean | 8 +- .../BeyondBethe/MachineMateAllSome.lean | 8 +- .../BeyondBethe/MachineMateMemory.lean | 6 +- .../BeyondBethe/MachineMatrixAddDelta.lean | 10 +- .../BeyondBethe/MachineMatrixDimension.lean | 8 +- .../BeyondBethe/MachineMatrixNonnegative.lean | 8 +- .../MachineMatrixNormalization.lean | 8 +- .../MachineMatrixNormalizeEntries.lean | 10 +- .../BeyondBethe/MachineMatrixSum.lean | 6 +- .../MachineMatrixSupportProduct.lean | 10 +- .../MachineNaturalCombinators.lean | 6 +- .../BeyondBethe/MachineNearbyCoordinate.lean | 8 +- .../BeyondBethe/MachineNearbyMatrixSum.lean | 6 +- .../MachineNestedMatrixMemory.lean | 8 +- .../MachineOptimizerBisectionLoop.lean | 10 +- .../MachineOptimizerBisectionSchedule.lean | 6 +- .../MachineOptimizerBisectionSemantics.lean | 8 +- .../MachineOptimizerCertificateBoundary.lean | 8 +- .../MachineOptimizerDerivedScales.lean | 8 +- .../MachineOptimizerEntryLength.lean | 10 +- .../MachineOptimizerFeasibilityCall.lean | 8 +- .../MachineOptimizerFeasibilitySchedule.lean | 6 +- .../MachineOptimizerInteriorScale.lean | 14 +- .../MachineOptimizerMatrixBitBound.lean | 10 +- .../MachineOptimizerRoundingSchedule.lean | 10 +- .../MachineOptimizerStateBound.lean | 8 +- .../BeyondBethe/MachineOptimizerTests.lean | 10 +- .../BeyondBethe/MachineOutputEncoding.lean | 8 +- .../BeyondBethe/MachinePerfectMatching.lean | 8 +- .../BeyondBethe/MachinePositiveAlgorithm.lean | 8 +- .../BeyondBethe/MachineRAMBridge.lean | 8 +- .../BeyondBethe/MachineRAMSmoke.lean | 8 +- .../MachineRationalArithmetic.lean | 6 +- .../BeyondBethe/MachineRationalBallInit.lean | 12 +- .../BeyondBethe/MachineRationalCompare.lean | 8 +- .../MachineRationalDirectionUpdateMatrix.lean | 8 +- .../MachineRationalDirectionUpdateRow.lean | 8 +- .../MachineRationalEllipsoidCenterUpdate.lean | 8 +- .../MachineRationalEllipsoidEncoding.lean | 10 +- .../MachineRationalEllipsoidScalars.lean | 6 +- .../MachineRationalEllipsoidUpdate.lean | 6 +- .../BeyondBethe/MachineRationalExp.lean | 8 +- .../BeyondBethe/MachineRationalFloor.lean | 8 +- .../BeyondBethe/MachineRationalLogSeries.lean | 10 +- .../MachineRationalMatrixColumn.lean | 8 +- .../BeyondBethe/MachineRationalMatrixMul.lean | 6 +- .../MachineRationalMatrixMulVector.lean | 8 +- .../MachineRationalMatrixUpdate.lean | 8 +- .../BeyondBethe/MachineRationalMin.lean | 8 +- .../MachineRationalNormalization.lean | 6 +- .../MachineRationalNormalizedDirection.lean | 8 +- .../BeyondBethe/MachineRationalPower.lean | 6 +- .../BeyondBethe/MachineRationalRowAdd.lean | 12 +- .../BeyondBethe/MachineRationalRowDivide.lean | 12 +- .../MachineRationalTransposeMulVector.lean | 8 +- .../BeyondBethe/MachineRationalUnary.lean | 8 +- .../BeyondBethe/MachineRationalVectorDot.lean | 8 +- .../BeyondBethe/MachineRationalVectorL1.lean | 8 +- .../MachineRationalVectorScale.lean | 6 +- .../BeyondBethe/MachineRationalVectorSub.lean | 8 +- .../BeyondBethe/MachineRationalVectorSum.lean | 8 +- .../BeyondBethe/MachineRepeatPair.lean | 8 +- .../MachineRowComplementUpperSum.lean | 6 +- .../BeyondBethe/MachineRowPairDisjoint.lean | 8 +- .../BeyondBethe/MachineScheduledLog.lean | 8 +- .../BeyondBethe/MachineScheduledLogWidth.lean | 6 +- .../MachineScheduledRoundedEllipsoid.lean | 6 +- .../MachineScheduledStateEncodingBound.lean | 10 +- .../BeyondBethe/MachineSmallDimension.lean | 6 +- .../BeyondBethe/MachineSmoothedMatrix.lean | 10 +- .../BeyondBethe/MachineSmoothingDelta.lean | 16 +- .../BeyondBethe/MachineTrimHighZeros.lean | 8 +- .../MachineUnaryGridGenerator.lean | 8 +- .../MachineUnaryMatrixGenerator.lean | 6 +- .../BeyondBethe/MachineUnaryRange.lean | 8 +- LeanPool/BeyondBethe/BeyondBethe/Main.lean | 26 +- .../BeyondBethe/MatchingAlgorithm.lean | 8 +- .../BeyondBethe/MatrixPerturbation.lean | 14 +- .../BeyondBethe/BeyondBethe/NearCase.lean | 18 +- .../BeyondBethe/NumericalAffine.lean | 8 +- .../BeyondBethe/NumericalCapacity.lean | 8 +- .../BeyondBethe/NumericalInterior.lean | 8 +- .../BeyondBethe/NumericalNearby.lean | 8 +- .../BeyondBethe/NumericalPotentials.lean | 8 +- .../BeyondBethe/NumericalScales.lean | 8 +- .../BeyondBethe/NumericalTransfer.lean | 6 +- .../BeyondBethe/NumericalWitness.lean | 10 +- .../BeyondBethe/BeyondBethe/Optimizer.lean | 14 +- .../BeyondBethe/OptimizerOutputEncoding.lean | 6 +- .../BeyondBethe/PairFactorization.lean | 14 +- .../BeyondBethe/PairStability.lean | 6 +- .../BeyondBethe/PairedCertificate.lean | 10 +- .../BeyondBethe/PalomarComplexity.lean | 6 +- .../BeyondBethe/BeyondBethe/Permanent.lean | 11 +- .../BeyondBethe/RationalEllipsoid.lean | 16 +- .../BeyondBethe/RationalEncodingBounds.lean | 10 +- .../BeyondBethe/RationalEpigraphOracle.lean | 8 +- .../BeyondBethe/RationalFeasibility.lean | 10 +- .../BeyondBethe/RationalLinearOracle.lean | 8 +- .../BeyondBethe/BeyondBethe/RawRational.lean | 10 +- .../BeyondBethe/RawRationalBitBounds.lean | 10 +- .../BeyondBethe/BeyondBethe/RobustCycle.lean | 10 +- .../BeyondBethe/RoundedEllipsoid.lean | 8 +- .../RoundedEllipsoidBitBounds.lean | 8 +- .../RoundedEllipsoidIterationBounds.lean | 8 +- .../BeyondBethe/RoundedEllipsoidScales.lean | 12 +- .../BeyondBethe/RoundedFeasibility.lean | 10 +- .../RoundedFeasibilityBitBounds.lean | 10 +- .../BeyondBethe/BeyondBethe/RowStability.lean | 16 +- .../BeyondBethe/ScannedBetheBisection.lean | 10 +- .../ScannedBetheThresholdFeasibility.lean | 10 +- .../BeyondBethe/ScheduledFeasibility.lean | 12 +- .../ScheduledRoundedEllipsoid.lean | 8 +- .../ScheduledRoundedEllipsoidIteration.lean | 8 +- .../BeyondBethe/BeyondBethe/Sequential.lean | 12 +- .../BeyondBethe/SequentialNormalization.lean | 10 +- LeanPool/BeyondBethe/BeyondBethe/Slack.lean | 10 +- .../BeyondBethe/BeyondBethe/Smoothing.lean | 14 +- .../BeyondBethe/SourceAnariRezaei.lean | 8 +- .../BeyondBethe/SourceAnariRezaeiList.lean | 6 +- .../BeyondBethe/SourceAnariRezaeiMerge.lean | 6 +- .../BeyondBethe/SourceBetheLower.lean | 8 +- .../BeyondBethe/SourceBetheUpper.lean | 8 +- .../BeyondBethe/SourceStableBivariate.lean | 12 +- .../BeyondBethe/SourceStableClosure.lean | 18 +- .../BeyondBethe/SourceStableEncoding.lean | 10 +- .../BeyondBethe/SourceStableInduction.lean | 8 +- .../BeyondBethe/SourceStableReindex.lean | 8 +- .../BeyondBethe/SourceStableSlice.lean | 8 +- .../SourceStableSpecialization.lean | 10 +- .../BeyondBethe/SourceStableTable.lean | 10 +- .../BeyondBethe/SourceVontobel.lean | 10 +- LeanPool/BeyondBethe/BeyondBethe/Stable.lean | 16 +- .../BeyondBethe/StrongEntropy.lean | 12 +- .../BeyondBethe/BeyondBethe/Transfer.lean | 12 +- .../BeyondBethe/TransferIdentity.lean | 10 +- .../BeyondBethe/WeakSeparation.lean | 12 +- LeanPool/BeyondBethe/Complexitylib.lean | 20 +- .../Asymptotics/PolynomialComposition.lean | 2 +- .../BeyondBethe/Complexitylib/Circuits.lean | 10 +- .../Complexitylib/Circuits/AndOrNot.lean | 6 +- .../Complexitylib/Circuits/Encoding.lean | 8 +- .../Circuits/Encoding/Internal.lean | 6 +- .../Circuits/Encoding/Internal/Codec.lean | 2 +- .../BeyondBethe/Complexitylib/Classes.lean | 24 +- .../Complexitylib/Classes/Containments.lean | 2 +- .../Complexitylib/Classes/FNP.lean | 6 +- .../Complexitylib/Classes/NP/Witness.lean | 2 +- .../BeyondBethe/Complexitylib/Classes/P.lean | 4 +- .../Complexitylib/Classes/P/Cobham.lean | 4 +- .../Classes/P/Cobham/Internal.lean | 8 +- .../Classes/P/Cobham/Internal/Algebra.lean | 6 +- .../Classes/P/Cobham/Internal/Blocks.lean | 2 +- .../Classes/P/Cobham/Internal/Cat.lean | 6 +- .../Classes/P/Cobham/Internal/ConsBit.lean | 4 +- .../Classes/P/Cobham/Internal/Encoding.lean | 2 +- .../Classes/P/Cobham/Internal/FstBlock.lean | 6 +- .../Classes/P/Cobham/Internal/Iterate.lean | 6 +- .../Classes/P/Cobham/Internal/MulLen.lean | 2 +- .../Classes/P/Cobham/Internal/Reorder.lean | 6 +- .../Classes/P/Cobham/Internal/Reverse.lean | 4 +- .../Classes/P/Cobham/Internal/Simulate.lean | 2 +- .../Classes/P/Cobham/Internal/SndBlock.lean | 6 +- .../Classes/P/Cobham/Internal/TakeLen.lean | 2 +- .../Classes/P/Cobham/Internal/Vec.lean | 2 +- .../Complexitylib/Classes/P/Cobham/Vec.lean | 2 +- .../Complexitylib/Classes/P/Composition.lean | 2 +- .../Complexitylib/Classes/P/FinsetDomain.lean | 2 +- .../Classes/P/FinsetDomain/Internal.lean | 2 +- .../Complexitylib/Classes/P/Internal.lean | 2 +- .../Classes/P/Internal/Composition.lean | 2 +- .../Classes/P/Internal/NormalForm.lean | 2 +- .../Classes/P/Internal/Preimage.lean | 2 +- .../Complexitylib/Classes/P/NormalForm.lean | 2 +- .../Classes/P/PairWithInput.lean | 2 +- .../Classes/P/PairWithInput/Internal.lean | 2 +- .../Complexitylib/Classes/P/Preimage.lean | 2 +- .../Complexitylib/Classes/P/UnaryLength.lean | 2 +- .../Classes/P/UnaryLength/Internal.lean | 2 +- .../BeyondBethe/Complexitylib/Encoding.lean | 12 +- .../Complexitylib/Encoding/Data.lean | 2 +- .../Complexitylib/Encoding/DataEncode.lean | 4 +- .../BeyondBethe/Complexitylib/Languages.lean | 6 +- .../Complexitylib/Languages/LastBit.lean | 2 +- .../BeyondBethe/Complexitylib/Mathlib.lean | 8 +- .../Complexitylib/Mathlib/FinsetPrefixes.lean | 2 +- .../BeyondBethe/Complexitylib/Models.lean | 8 +- .../Models/RandomAccessMachine.lean | 2 +- .../Models/RandomAccessMachine/Classes.lean | 2 +- .../Models/RandomAccessMachine/Internal.lean | 2 +- .../RandomAccessMachine/Simulation.lean | 8 +- .../Simulation/RegisterStore.lean | 2 +- .../Simulation/RegisterStore/Containment.lean | 2 +- .../RegisterStore/Containment/Internal.lean | 2 +- .../RegisterStore/DenseOverlay.lean | 2 +- .../RegisterStore/DenseOverlay/Internal.lean | 2 +- .../Simulation/RegisterStore/Internal.lean | 2 +- .../Simulation/RegisterStore/Machine.lean | 42 +- .../RegisterStore/Machine/AddressEq.lean | 2 +- .../Machine/AddressEq/Internal.lean | 2 +- .../Machine/DenseInputLookup.lean | 2 +- .../Machine/DenseInputLookup/Internal.lean | 2 +- .../RegisterStore/Machine/EntryAppend.lean | 2 +- .../Machine/EntryAppend/Internal.lean | 2 +- .../RegisterStore/Machine/EntryCleanup.lean | 2 +- .../Machine/EntryCleanup/Internal.lean | 2 +- .../RegisterStore/Machine/EntryDecode.lean | 2 +- .../Machine/EntryDecode/Internal.lean | 2 +- .../Machine/EntryDecode/LinearInternal.lean | 2 +- .../RegisterStore/Machine/EntryEncode.lean | 2 +- .../Machine/EntryEncode/Internal.lean | 2 +- .../RegisterStore/Machine/EntryLookup.lean | 2 +- .../Machine/EntryLookup/Defs.lean | 2 +- .../Machine/EntryLookup/Internal.lean | 2 +- .../Machine/EntryLookupRestore.lean | 2 +- .../RegisterStore/Machine/EntryMatch.lean | 2 +- .../Machine/EntryMatch/Internal.lean | 2 +- .../RegisterStore/Machine/EntryMissCopy.lean | 2 +- .../Machine/EntryMissCopy/Internal.lean | 2 +- .../RegisterStore/Machine/EntryReplace.lean | 2 +- .../Machine/EntryReplace/Internal.lean | 2 +- .../RegisterStore/Machine/EntryScan.lean | 2 +- .../Machine/EntryScan/Internal.lean | 12 +- .../Machine/EntryScan/Internal/Bounds.lean | 10 +- .../Machine/EntryScan/Internal/Inv.lean | 14 +- .../Machine/EntryScan/Internal/Sem.lean | 6 +- .../RegisterStore/Machine/EntryScanStep.lean | 2 +- .../Machine/EntryScanStep/Internal.lean | 2 +- .../RegisterStore/Machine/EntryUpdate.lean | 2 +- .../Machine/EntryUpdate/BoundsInternal.lean | 2 +- .../Machine/EntryUpdate/Internal.lean | 24 +- .../Machine/EntryUpdate/Internal/End.lean | 8 +- .../Machine/EntryUpdate/Internal/Hit.lean | 8 +- .../Machine/EntryUpdate/Internal/Inv.lean | 2 +- .../Machine/EntryUpdate/Internal/Loop.lean | 2 +- .../Machine/EntryUpdate/Internal/Miss.lean | 10 +- .../Machine/EntryUpdate/Internal/Out.lean | 4 +- .../Machine/EntryUpdate/Internal/Sem.lean | 4 +- .../Machine/EntryUpdate/Internal/Step.lean | 4 +- .../Machine/EntryUpdate/Internal/Time.lean | 16 +- .../Machine/EntryUpdate/Progress.lean | 2 +- .../Machine/EntryUpdate/Source.lean | 2 +- .../Machine/EntryUpdate/Tagged.lean | 2 +- .../Machine/EntryUpdate/TaggedProof.lean | 2 +- .../RegisterStore/Machine/Instruction.lean | 2 +- .../Machine/Instruction/Control.lean | 2 +- .../Machine/Instruction/DenseControl.lean | 2 +- .../Machine/Instruction/DenseCtrlSim.lean | 2 +- .../Machine/Instruction/DenseDirect.lean | 2 +- .../Machine/Instruction/DenseDispatch.lean | 2 +- .../Machine/Instruction/DenseImm.lean | 2 +- .../Machine/Instruction/DenseLoad.lean | 2 +- .../Machine/Instruction/DenseSim.lean | 2 +- .../Machine/Instruction/DenseSimData.lean | 2 +- .../Machine/Instruction/DenseStore.lean | 2 +- .../Machine/Instruction/Direct.lean | 2 +- .../Machine/Instruction/Dispatch.lean | 2 +- .../Machine/Instruction/Immediate.lean | 2 +- .../Machine/Instruction/Internal.lean | 2 +- .../Machine/Instruction/Load.lean | 2 +- .../Machine/Instruction/Sim.lean | 12 +- .../Machine/Instruction/Sim/Control.lean | 6 +- .../Machine/Instruction/Sim/Data.lean | 2 +- .../Machine/Instruction/Sim/Internal.lean | 12 +- .../Machine/Instruction/Store.lean | 2 +- .../RegisterStore/Machine/Lookup.lean | 10 +- .../Machine/Lookup/DenseInternal.lean | 2 +- .../Machine/Lookup/Internal.lean | 20 +- .../Machine/Lookup/Internal/Assemble.lean | 8 +- .../Machine/Lookup/Internal/Bounds.lean | 2 +- .../Machine/Lookup/Internal/Prepare.lean | 4 +- .../Machine/Lookup/Internal/Reset.lean | 10 +- .../Machine/Lookup/Internal/Restore.lean | 14 +- .../Machine/Lookup/Internal/Scan.lean | 2 +- .../Machine/Lookup/Internal/Static.lean | 2 +- .../Machine/Lookup/Internal/Value.lean | 12 +- .../RegisterStore/Machine/Program.lean | 2 +- .../RegisterStore/Machine/Program/Bounds.lean | 2 +- .../Machine/Program/Bounds/Defs.lean | 4 +- .../Machine/Program/Bounds/Internal.lean | 4 +- .../Machine/Program/Decision.lean | 2 +- .../Machine/Program/DecisionInternal.lean | 2 +- .../Machine/Program/DenseBounds.lean | 2 +- .../Machine/Program/DenseBoundsProof.lean | 2 +- .../Machine/Program/DenseDecision.lean | 2 +- .../Machine/Program/DenseDecisionProof.lean | 2 +- .../Machine/Program/DenseInit.lean | 2 +- .../Machine/Program/DenseInitProof.lean | 2 +- .../Machine/Program/DenseInternal.lean | 2 +- .../RegisterStore/Machine/Program/Init.lean | 8 +- .../Machine/Program/Init/Internal.lean | 22 +- .../Machine/Program/Initialization.lean | 2 +- .../Machine/Program/Internal.lean | 2 +- .../RegisterStore/Machine/WordDecode.lean | 2 +- .../Machine/WordDecode/Internal.lean | 2 +- .../Machine/WordDecode/LinearInternal.lean | 2 +- .../RegisterStore/Machine/WordEncode.lean | 2 +- .../Machine/WordEncode/Internal.lean | 2 +- .../Simulation/TMConfig.lean | 2 +- .../Simulation/TMConfig/Internal.lean | 2 +- .../Simulation/TMConfig/Sparse.lean | 2 +- .../Simulation/TMConfig/Sparse/ABI.lean | 2 +- .../TMConfig/Sparse/ABI/Internal.lean | 14 +- .../TMConfig/Sparse/ABI/Internal/Capture.lean | 6 +- .../Sparse/ABI/Internal/Decision.lean | 4 +- .../TMConfig/Sparse/ABI/Internal/Loop.lean | 2 +- .../TMConfig/Sparse/ABI/Internal/Marshal.lean | 6 +- .../Sparse/ABI/Internal/Resources.lean | 2 +- .../TMConfig/Sparse/Containment.lean | 2 +- .../TMConfig/Sparse/Containment/Internal.lean | 2 +- .../Simulation/TMConfig/Sparse/Internal.lean | 2 +- .../Simulation/TMConfig/Sparse/Step.lean | 2 +- .../TMConfig/Sparse/Step/Internal/Action.lean | 2 +- .../Sparse/Step/Internal/Dispatch.lean | 4 +- .../Sparse/Step/Internal/Iteration.lean | 2 +- .../TMConfig/Sparse/Step/Internal/Layout.lean | 2 +- .../TMConfig/Sparse/Step/Internal/Load.lean | 2 +- .../Sparse/Step/Internal/Resources.lean | 2 +- .../Simulation/TMConfig/Step.lean | 2 +- .../TMConfig/Step/Internal/Action.lean | 2 +- .../TMConfig/Step/Internal/Dispatch.lean | 2 +- .../TMConfig/Step/Internal/Layout.lean | 2 +- .../TMConfig/Step/Internal/Load.lean | 2 +- .../TMConfig/Step/Internal/Resources.lean | 2 +- .../Models/RandomAccessMachine/Soundness.lean | 2 +- .../RandomAccessMachine/Structured.lean | 2 +- .../Structured/GateEval.lean | 2 +- .../Structured/GateEval/Internal.lean | 2 +- .../Structured/GateStep.lean | 2 +- .../Structured/GateStep/Internal.lean | 2 +- .../Structured/GateStreamStep.lean | 2 +- .../Structured/GateStreamStep/Internal.lean | 2 +- .../Structured/Hamming.lean | 2 +- .../Structured/Hamming/Internal.lean | 2 +- .../Structured/Internal.lean | 2 +- .../Structured/LastBit.lean | 2 +- .../Structured/PairValidate.lean | 2 +- .../Structured/PairValidate/Internal.lean | 2 +- .../Structured/Scanner.lean | 2 +- .../Structured/Scanner/Internal.lean | 2 +- .../Structured/Switch.lean | 2 +- .../Structured/Switch/Compiled.lean | 2 +- .../Structured/Switch/Internal.lean | 2 +- .../Structured/ThreeSATSyntax.lean | 2 +- .../Structured/UnaryDecode.lean | 2 +- .../Structured/UnaryDecode/Internal.lean | 2 +- .../Combinators/ForBinaryWork.lean | 2 +- .../TuringMachine/Combinators/ForInput.lean | 8 +- .../Combinators/ForWorkOnes.lean | 8 +- .../Combinators/Internal/Scanner.lean | 2 +- .../Combinators/Internal/Union.lean | 2 +- .../Combinators/RetargetCompute.lean | 2 +- .../Combinators/RetargetCompute/Internal.lean | 2 +- .../TuringMachine/Combinators/WorkBranch.lean | 2 +- .../Combinators/WorkSymbolBranch.lean | 2 +- .../WorkSymbolBranch/Internal.lean | 2 +- .../Models/TuringMachine/Composition.lean | 2 +- .../TuringMachine/Composition/Internal.lean | 2 +- .../Composition/Internal/FirstPhase.lean | 2 +- .../Composition/PairWithInput.lean | 2 +- .../Composition/PairWithInput/Internal.lean | 2 +- .../Models/TuringMachine/Frame.lean | 4 +- .../TuringMachine/Hoare/RetargetOutput.lean | 2 +- .../Models/TuringMachine/Hoare/Space.lean | 2 +- .../TuringMachine/Hoare/Space/Internal.lean | 2 +- .../Models/TuringMachine/Internal.lean | 2 +- .../TuringMachine/Internal/OutputBounds.lean | 2 +- .../Models/TuringMachine/OutputBounds.lean | 2 +- .../Models/TuringMachine/Placement.lean | 2 +- .../TuringMachine/Placement/Internal.lean | 2 +- .../TuringMachine/Registers/InputLen.lean | 2 +- .../Models/TuringMachine/SpaceTime.lean | 6 +- .../TuringMachine/SpaceTime/Internal.lean | 6 +- .../SpaceTime/Internal/Reachability.lean | 2 +- .../Subroutines/BinaryAddConst.lean | 2 +- .../TuringMachine/Subroutines/BinaryCopy.lean | 2 +- .../TuringMachine/Subroutines/BinaryEq.lean | 2 +- .../Subroutines/BinaryEq/Internal.lean | 2 +- .../TuringMachine/Subroutines/BinaryFor.lean | 8 +- .../Subroutines/BinaryFor/Internal.lean | 10 +- .../BinaryFor/Internal/Comparison.lean | 2 +- .../Subroutines/BinaryFor/Internal/Loop.lean | 2 +- .../TuringMachine/Subroutines/BinaryPred.lean | 2 +- .../Subroutines/BinaryPred/Internal.lean | 2 +- .../Subroutines/BinaryRippleAdd.lean | 2 +- .../BinaryRippleAdd/Internal/Bounds.lean | 2 +- .../BinaryRippleAdd/Internal/Out.lean | 2 +- .../BinaryRippleAdd/Internal/Pure.lean | 2 +- .../BinaryRippleAdd/Internal/Scan.lean | 2 +- .../Subroutines/BinaryRippleSub.lean | 2 +- .../Subroutines/BinaryRippleSub/Internal.lean | 16 +- .../BinaryRippleSub/Internal/Backward.lean | 2 +- .../BinaryRippleSub/Internal/Out.lean | 2 +- .../BinaryRippleSub/Internal/Pure.lean | 2 +- .../BinaryRippleSub/Internal/Scan.lean | 2 +- .../Subroutines/BinaryShiftMul.lean | 2 +- .../Subroutines/BinaryShiftMul/Internal.lean | 10 +- .../BinaryShiftMul/Internal/Out.lean | 2 +- .../BinaryShiftMul/Internal/Pure.lean | 2 +- .../TuringMachine/Subroutines/BinarySucc.lean | 2 +- .../Subroutines/BinarySucc/Internal.lean | 2 +- .../TuringMachine/Subroutines/ClearWork.lean | 2 +- .../Subroutines/ClearWork/Internal.lean | 2 +- .../TuringMachine/Subroutines/CopyOutput.lean | 2 +- .../Subroutines/CopyToVirtualInput.lean | 4 +- .../Subroutines/CopyWorkOutput.lean | 2 +- .../TuringMachine/Subroutines/Internal.lean | 2 +- .../Subroutines/Internal/CopyOutput.lean | 2 +- .../Subroutines/Internal/CopyWorkOutput.lean | 2 +- .../Subroutines/MoveLeftStep.lean | 2 +- .../TuringMachine/Subroutines/PairEmit.lean | 2 +- .../Subroutines/PairEmit/Internal.lean | 2 +- .../Subroutines/PairValidate.lean | 2 +- .../Subroutines/PairValidate/Internal.lean | 2 +- .../TuringMachine/Subroutines/ParkAll.lean | 2 +- .../Subroutines/ResetBinary.lean | 2 +- .../Subroutines/ResetBinary/Internal.lean | 2 +- .../Subroutines/ResetBinaryMany.lean | 2 +- .../Subroutines/ResetBinaryMany/Internal.lean | 2 +- .../TuringMachine/Subroutines/ResetTapes.lean | 2 +- .../TuringMachine/Subroutines/RewindList.lean | 2 +- .../Subroutines/UnaryLength.lean | 2 +- .../Subroutines/UnaryLength/Internal.lean | 2 +- .../TuringMachine/Subroutines/WipeStep.lean | 2 +- .../Models/TuringMachine/Tape.lean | 6 +- LeanPool/BeyondBethe/Complexitylib/SAT.lean | 18 +- LeanPool/BeyondBethe/Solution.lean | 10 +- 557 files changed, 3791 insertions(+), 2115 deletions(-) diff --git a/LeanPool/BeyondBethe.lean b/LeanPool/BeyondBethe.lean index 68895f6550..2e5e3fcf2c 100644 --- a/LeanPool/BeyondBethe.lean +++ b/LeanPool/BeyondBethe.lean @@ -3,682 +3,684 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe -import LeanPool.BeyondBethe.BeyondBethe.AdaptiveRoundedEllipsoid -import LeanPool.BeyondBethe.BeyondBethe.AlgorithmicSpec -import LeanPool.BeyondBethe.BeyondBethe.ApproximateKKT -import LeanPool.BeyondBethe.BeyondBethe.AxiomAudit -import LeanPool.BeyondBethe.BeyondBethe.Bethe -import LeanPool.BeyondBethe.BeyondBethe.BetheBisection -import LeanPool.BeyondBethe.BeyondBethe.BetheEpigraph -import LeanPool.BeyondBethe.BeyondBethe.BetheEpigraphFeasibility -import LeanPool.BeyondBethe.BeyondBethe.BetheEpigraphGeometry -import LeanPool.BeyondBethe.BeyondBethe.BetheFloorCutFormula -import LeanPool.BeyondBethe.BeyondBethe.BetheThresholdFeasibility -import LeanPool.BeyondBethe.BeyondBethe.BinaryDirectedElementary -import LeanPool.BeyondBethe.BeyondBethe.BinaryLongDivision -import LeanPool.BeyondBethe.BeyondBethe.BinaryRationalComparison -import LeanPool.BeyondBethe.BeyondBethe.BinaryRationalFloor -import LeanPool.BeyondBethe.BeyondBethe.Birkhoff -import LeanPool.BeyondBethe.BeyondBethe.Capacity -import LeanPool.BeyondBethe.BeyondBethe.CapacityOrder -import LeanPool.BeyondBethe.BeyondBethe.CapacityScaling -import LeanPool.BeyondBethe.BeyondBethe.CertificateCapacity -import LeanPool.BeyondBethe.BeyondBethe.CertificateMagnitude -import LeanPool.BeyondBethe.BeyondBethe.CertifiedPairWeights -import LeanPool.BeyondBethe.BeyondBethe.CleanConstants -import LeanPool.BeyondBethe.BeyondBethe.CleanGain -import LeanPool.BeyondBethe.BeyondBethe.CleanWitness -import LeanPool.BeyondBethe.BeyondBethe.ClusterAlpha -import LeanPool.BeyondBethe.BeyondBethe.ClusterCertificate -import LeanPool.BeyondBethe.BeyondBethe.ClusterFactors -import LeanPool.BeyondBethe.BeyondBethe.ClusterProduct -import LeanPool.BeyondBethe.BeyondBethe.Completion -import LeanPool.BeyondBethe.BeyondBethe.CoreEncoding -import LeanPool.BeyondBethe.BeyondBethe.CycleTransfer -import LeanPool.BeyondBethe.BeyondBethe.Cycles -import LeanPool.BeyondBethe.BeyondBethe.DirectedCertificateValue -import LeanPool.BeyondBethe.BeyondBethe.DirectedElementary -import LeanPool.BeyondBethe.BeyondBethe.DirectedOptimizerOracle -import LeanPool.BeyondBethe.BeyondBethe.DirectedPairCost -import LeanPool.BeyondBethe.BeyondBethe.DyadicMagnitudePrecision -import LeanPool.BeyondBethe.BeyondBethe.DyadicRounding -import LeanPool.BeyondBethe.BeyondBethe.Entropy -import LeanPool.BeyondBethe.BeyondBethe.ExcursionTransfer -import LeanPool.BeyondBethe.BeyondBethe.ExecutableCertificate -import LeanPool.BeyondBethe.BeyondBethe.ExecutableCertificateMagnitude -import LeanPool.BeyondBethe.BeyondBethe.ExecutableInterior -import LeanPool.BeyondBethe.BeyondBethe.ExecutablePositiveRoutine -import LeanPool.BeyondBethe.BeyondBethe.ExecutableScannedBetheOptimizer -import LeanPool.BeyondBethe.BeyondBethe.ExecutableTransfer -import LeanPool.BeyondBethe.BeyondBethe.ExplicitBetheOptimizer -import LeanPool.BeyondBethe.BeyondBethe.ExplicitBetheThresholdFeasibility -import LeanPool.BeyondBethe.BeyondBethe.ExplicitBounds -import LeanPool.BeyondBethe.BeyondBethe.ExplicitOptimizerScales -import LeanPool.BeyondBethe.BeyondBethe.ExplicitPositiveRoutine -import LeanPool.BeyondBethe.BeyondBethe.ExplicitScales -import LeanPool.BeyondBethe.BeyondBethe.ExplicitScheduledFeasibility -import LeanPool.BeyondBethe.BeyondBethe.FinalAssembly -import LeanPool.BeyondBethe.BeyondBethe.Gain -import LeanPool.BeyondBethe.BeyondBethe.Gibbs -import LeanPool.BeyondBethe.BeyondBethe.GoodRowScore -import LeanPool.BeyondBethe.BeyondBethe.GreedyRowMatching -import LeanPool.BeyondBethe.BeyondBethe.KuhnMatching -import LeanPool.BeyondBethe.BeyondBethe.KuhnSmallStep -import LeanPool.BeyondBethe.BeyondBethe.MachineArithmeticTests -import LeanPool.BeyondBethe.BeyondBethe.MachineBetheAffineEntry -import LeanPool.BeyondBethe.BeyondBethe.MachineBetheAffineLineSum -import LeanPool.BeyondBethe.BeyondBethe.MachineBetheEpigraphOracle -import LeanPool.BeyondBethe.BeyondBethe.MachineBetheFeasibilityFit -import LeanPool.BeyondBethe.BeyondBethe.MachineBetheFeasibilityLoop -import LeanPool.BeyondBethe.BeyondBethe.MachineBetheFeasibilitySemantics -import LeanPool.BeyondBethe.BeyondBethe.MachineBetheFloorCutEntry -import LeanPool.BeyondBethe.BeyondBethe.MachineBetheFloorCutVector -import LeanPool.BeyondBethe.BeyondBethe.MachineBetheFloorScan -import LeanPool.BeyondBethe.BeyondBethe.MachineBetheFloorTest -import LeanPool.BeyondBethe.BeyondBethe.MachineBetheHeightCap -import LeanPool.BeyondBethe.BeyondBethe.MachineBetheHeightNormal -import LeanPool.BeyondBethe.BeyondBethe.MachineBinaryAdd -import LeanPool.BeyondBethe.BeyondBethe.MachineBinaryAddSemantics -import LeanPool.BeyondBethe.BeyondBethe.MachineBinaryCompare -import LeanPool.BeyondBethe.BeyondBethe.MachineBinaryDivision -import LeanPool.BeyondBethe.BeyondBethe.MachineBinaryGCD -import LeanPool.BeyondBethe.BeyondBethe.MachineBinaryListInit -import LeanPool.BeyondBethe.BeyondBethe.MachineBinaryListSnoc -import LeanPool.BeyondBethe.BeyondBethe.MachineBinaryMul -import LeanPool.BeyondBethe.BeyondBethe.MachineBinarySub -import LeanPool.BeyondBethe.BeyondBethe.MachineBitAssembly -import LeanPool.BeyondBethe.BeyondBethe.MachineBool -import LeanPool.BeyondBethe.BeyondBethe.MachineBooleanInit -import LeanPool.BeyondBethe.BeyondBethe.MachineBooleanMemory -import LeanPool.BeyondBethe.BeyondBethe.MachineBoundedUnary -import LeanPool.BeyondBethe.BeyondBethe.MachineCertificateAssembly -import LeanPool.BeyondBethe.BeyondBethe.MachineCertificateExpGuard -import LeanPool.BeyondBethe.BeyondBethe.MachineCertificatePotentials -import LeanPool.BeyondBethe.BeyondBethe.MachineCertificateScales -import LeanPool.BeyondBethe.BeyondBethe.MachineCertifiedPairEligibility -import LeanPool.BeyondBethe.BeyondBethe.MachineCompletedAlgorithm -import LeanPool.BeyondBethe.BeyondBethe.MachineDirectedAffineGradientEntry -import LeanPool.BeyondBethe.BeyondBethe.MachineDirectedAffineGradientVector -import LeanPool.BeyondBethe.BeyondBethe.MachineDirectedEpigraphNormal -import LeanPool.BeyondBethe.BeyondBethe.MachineDirectedLog -import LeanPool.BeyondBethe.BeyondBethe.MachineDirectedNegativeGradientCoordinate -import LeanPool.BeyondBethe.BeyondBethe.MachineDirectedNegativeGradientEntry -import LeanPool.BeyondBethe.BeyondBethe.MachineDirectedNegativeObjectiveCoordinate -import LeanPool.BeyondBethe.BeyondBethe.MachineDirectedNegativeObjectiveSum -import LeanPool.BeyondBethe.BeyondBethe.MachineDirectedTransferCost -import LeanPool.BeyondBethe.BeyondBethe.MachineDyadicFloor -import LeanPool.BeyondBethe.BeyondBethe.MachineDyadicFloorMatrix -import LeanPool.BeyondBethe.BeyondBethe.MachineDyadicFloorVector -import LeanPool.BeyondBethe.BeyondBethe.MachineEncoding -import LeanPool.BeyondBethe.BeyondBethe.MachineExecutableCertificate -import LeanPool.BeyondBethe.BeyondBethe.MachineExecutablePositiveAlgorithm -import LeanPool.BeyondBethe.BeyondBethe.MachineExecutableScannedOptimizerOutput -import LeanPool.BeyondBethe.BeyondBethe.MachineExplicitCertificate -import LeanPool.BeyondBethe.BeyondBethe.MachineFPBasics -import LeanPool.BeyondBethe.BeyondBethe.MachineFactorial -import LeanPool.BeyondBethe.BeyondBethe.MachineFinalScalars -import LeanPool.BeyondBethe.BeyondBethe.MachineFourCoreCost -import LeanPool.BeyondBethe.BeyondBethe.MachineGreedyRowMatching -import LeanPool.BeyondBethe.BeyondBethe.MachineIntegerArithmetic -import LeanPool.BeyondBethe.BeyondBethe.MachineIntegerCompare -import LeanPool.BeyondBethe.BeyondBethe.MachineIntegerSignedMagnitude -import LeanPool.BeyondBethe.BeyondBethe.MachineKuhnEncoding -import LeanPool.BeyondBethe.BeyondBethe.MachineKuhnInvariant -import LeanPool.BeyondBethe.BeyondBethe.MachineKuhnRunner -import LeanPool.BeyondBethe.BeyondBethe.MachineKuhnSemantics -import LeanPool.BeyondBethe.BeyondBethe.MachineKuhnStep -import LeanPool.BeyondBethe.BeyondBethe.MachineLengthBits -import LeanPool.BeyondBethe.BeyondBethe.MachineListIndex -import LeanPool.BeyondBethe.BeyondBethe.MachineListReverse -import LeanPool.BeyondBethe.BeyondBethe.MachineListUpdate -import LeanPool.BeyondBethe.BeyondBethe.MachineMatchingGain -import LeanPool.BeyondBethe.BeyondBethe.MachineMateAllSome -import LeanPool.BeyondBethe.BeyondBethe.MachineMateMemory -import LeanPool.BeyondBethe.BeyondBethe.MachineMatrixAddDelta -import LeanPool.BeyondBethe.BeyondBethe.MachineMatrixDimension -import LeanPool.BeyondBethe.BeyondBethe.MachineMatrixNonnegative -import LeanPool.BeyondBethe.BeyondBethe.MachineMatrixNormalization -import LeanPool.BeyondBethe.BeyondBethe.MachineMatrixNormalizeEntries -import LeanPool.BeyondBethe.BeyondBethe.MachineMatrixSum -import LeanPool.BeyondBethe.BeyondBethe.MachineMatrixSupportProduct -import LeanPool.BeyondBethe.BeyondBethe.MachineNaturalCombinators -import LeanPool.BeyondBethe.BeyondBethe.MachineNearbyCoordinate -import LeanPool.BeyondBethe.BeyondBethe.MachineNearbyMatrixSum -import LeanPool.BeyondBethe.BeyondBethe.MachineNestedMatrixMemory -import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerBisectionLoop -import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerBisectionSchedule -import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerBisectionSemantics -import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerCertificateBoundary -import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerDerivedScales -import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerEntryLength -import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerFeasibilityCall -import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerFeasibilitySchedule -import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerInteriorScale -import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerMatrixBitBound -import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerRoundingSchedule -import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerStateBound -import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerTests -import LeanPool.BeyondBethe.BeyondBethe.MachineOutputEncoding -import LeanPool.BeyondBethe.BeyondBethe.MachinePerfectMatching -import LeanPool.BeyondBethe.BeyondBethe.MachinePositiveAlgorithm -import LeanPool.BeyondBethe.BeyondBethe.MachineRAMBridge -import LeanPool.BeyondBethe.BeyondBethe.MachineRAMSmoke -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalArithmetic -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalBallInit -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalCompare -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalDirectionUpdateMatrix -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalDirectionUpdateRow -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalEllipsoidCenterUpdate -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalEllipsoidEncoding -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalEllipsoidScalars -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalEllipsoidUpdate -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalExp -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalFloor -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalLogSeries -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalMatrixColumn -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalMatrixMul -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalMatrixMulVector -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalMatrixUpdate -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalMin -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalNormalization -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalNormalizedDirection -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalPower -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalRowAdd -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalRowDivide -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalTransposeMulVector -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalUnary -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalVectorDot -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalVectorL1 -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalVectorScale -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalVectorSub -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalVectorSum -import LeanPool.BeyondBethe.BeyondBethe.MachineRepeatPair -import LeanPool.BeyondBethe.BeyondBethe.MachineRowComplementUpperSum -import LeanPool.BeyondBethe.BeyondBethe.MachineRowPairDisjoint -import LeanPool.BeyondBethe.BeyondBethe.MachineScheduledLog -import LeanPool.BeyondBethe.BeyondBethe.MachineScheduledLogWidth -import LeanPool.BeyondBethe.BeyondBethe.MachineScheduledRoundedEllipsoid -import LeanPool.BeyondBethe.BeyondBethe.MachineScheduledStateEncodingBound -import LeanPool.BeyondBethe.BeyondBethe.MachineSmallDimension -import LeanPool.BeyondBethe.BeyondBethe.MachineSmoothedMatrix -import LeanPool.BeyondBethe.BeyondBethe.MachineSmoothingDelta -import LeanPool.BeyondBethe.BeyondBethe.MachineTrimHighZeros -import LeanPool.BeyondBethe.BeyondBethe.MachineUnaryGridGenerator -import LeanPool.BeyondBethe.BeyondBethe.MachineUnaryMatrixGenerator -import LeanPool.BeyondBethe.BeyondBethe.MachineUnaryRange -import LeanPool.BeyondBethe.BeyondBethe.Main -import LeanPool.BeyondBethe.BeyondBethe.MatchingAlgorithm -import LeanPool.BeyondBethe.BeyondBethe.MatrixPerturbation -import LeanPool.BeyondBethe.BeyondBethe.NearCase -import LeanPool.BeyondBethe.BeyondBethe.NumericalAffine -import LeanPool.BeyondBethe.BeyondBethe.NumericalCapacity -import LeanPool.BeyondBethe.BeyondBethe.NumericalInterior -import LeanPool.BeyondBethe.BeyondBethe.NumericalNearby -import LeanPool.BeyondBethe.BeyondBethe.NumericalPotentials -import LeanPool.BeyondBethe.BeyondBethe.NumericalScales -import LeanPool.BeyondBethe.BeyondBethe.NumericalTransfer -import LeanPool.BeyondBethe.BeyondBethe.NumericalWitness -import LeanPool.BeyondBethe.BeyondBethe.Optimizer -import LeanPool.BeyondBethe.BeyondBethe.OptimizerOutputEncoding -import LeanPool.BeyondBethe.BeyondBethe.PairFactorization -import LeanPool.BeyondBethe.BeyondBethe.PairStability -import LeanPool.BeyondBethe.BeyondBethe.PairedCertificate -import LeanPool.BeyondBethe.BeyondBethe.PalomarComplexity -import LeanPool.BeyondBethe.BeyondBethe.Permanent -import LeanPool.BeyondBethe.BeyondBethe.RationalEllipsoid -import LeanPool.BeyondBethe.BeyondBethe.RationalEncodingBounds -import LeanPool.BeyondBethe.BeyondBethe.RationalEpigraphOracle -import LeanPool.BeyondBethe.BeyondBethe.RationalFeasibility -import LeanPool.BeyondBethe.BeyondBethe.RationalLinearOracle -import LeanPool.BeyondBethe.BeyondBethe.RawRational -import LeanPool.BeyondBethe.BeyondBethe.RawRationalBitBounds -import LeanPool.BeyondBethe.BeyondBethe.RobustCycle -import LeanPool.BeyondBethe.BeyondBethe.RoundedEllipsoid -import LeanPool.BeyondBethe.BeyondBethe.RoundedEllipsoidBitBounds -import LeanPool.BeyondBethe.BeyondBethe.RoundedEllipsoidIterationBounds -import LeanPool.BeyondBethe.BeyondBethe.RoundedEllipsoidScales -import LeanPool.BeyondBethe.BeyondBethe.RoundedFeasibility -import LeanPool.BeyondBethe.BeyondBethe.RoundedFeasibilityBitBounds -import LeanPool.BeyondBethe.BeyondBethe.RowStability -import LeanPool.BeyondBethe.BeyondBethe.ScannedBetheBisection -import LeanPool.BeyondBethe.BeyondBethe.ScannedBetheThresholdFeasibility -import LeanPool.BeyondBethe.BeyondBethe.ScheduledFeasibility -import LeanPool.BeyondBethe.BeyondBethe.ScheduledRoundedEllipsoid -import LeanPool.BeyondBethe.BeyondBethe.ScheduledRoundedEllipsoidIteration -import LeanPool.BeyondBethe.BeyondBethe.Sequential -import LeanPool.BeyondBethe.BeyondBethe.SequentialNormalization -import LeanPool.BeyondBethe.BeyondBethe.Slack -import LeanPool.BeyondBethe.BeyondBethe.Smoothing -import LeanPool.BeyondBethe.BeyondBethe.SourceAnariRezaei -import LeanPool.BeyondBethe.BeyondBethe.SourceAnariRezaeiList -import LeanPool.BeyondBethe.BeyondBethe.SourceAnariRezaeiMerge -import LeanPool.BeyondBethe.BeyondBethe.SourceBetheLower -import LeanPool.BeyondBethe.BeyondBethe.SourceBetheUpper -import LeanPool.BeyondBethe.BeyondBethe.SourceStableBivariate -import LeanPool.BeyondBethe.BeyondBethe.SourceStableClosure -import LeanPool.BeyondBethe.BeyondBethe.SourceStableEncoding -import LeanPool.BeyondBethe.BeyondBethe.SourceStableInduction -import LeanPool.BeyondBethe.BeyondBethe.SourceStableReindex -import LeanPool.BeyondBethe.BeyondBethe.SourceStableSlice -import LeanPool.BeyondBethe.BeyondBethe.SourceStableSpecialization -import LeanPool.BeyondBethe.BeyondBethe.SourceStableTable -import LeanPool.BeyondBethe.BeyondBethe.SourceVontobel -import LeanPool.BeyondBethe.BeyondBethe.Stable -import LeanPool.BeyondBethe.BeyondBethe.StrongEntropy -import LeanPool.BeyondBethe.BeyondBethe.Transfer -import LeanPool.BeyondBethe.BeyondBethe.TransferIdentity -import LeanPool.BeyondBethe.BeyondBethe.WeakSeparation -import LeanPool.BeyondBethe.Complexitylib.Asymptotics -import LeanPool.BeyondBethe.Complexitylib.Asymptotics.PolyBound -import LeanPool.BeyondBethe.Complexitylib.Asymptotics.PolynomialComposition -import LeanPool.BeyondBethe.Complexitylib.Circuits.AndOrNot.Defs -import LeanPool.BeyondBethe.Complexitylib.Circuits.Basic -import LeanPool.BeyondBethe.Complexitylib.Circuits.Encoding.Defs -import LeanPool.BeyondBethe.Complexitylib.Circuits.Encoding.Internal.Codec -import LeanPool.BeyondBethe.Complexitylib.Classes.Containments -import LeanPool.BeyondBethe.Complexitylib.Classes.Exponential -import LeanPool.BeyondBethe.Complexitylib.Classes.FNP.Defs -import LeanPool.BeyondBethe.Complexitylib.Classes.L -import LeanPool.BeyondBethe.Complexitylib.Classes.NP -import LeanPool.BeyondBethe.Complexitylib.Classes.NP.Witness -import LeanPool.BeyondBethe.Complexitylib.Classes.P -import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham -import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Defs -import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal -import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.Algebra -import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.BlockScan -import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.Blocks -import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.Cat -import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.ConsBit -import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.Encoding -import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.Extract -import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.FstBlock -import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.HeadFlag -import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.Iterate -import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.IterateLayout -import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.MulLen -import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.Reorder -import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.Reverse -import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.Simulate -import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.SndBlock -import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.StepAlgebra -import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.TakeLen -import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.Vec -import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Vec -import LeanPool.BeyondBethe.Complexitylib.Classes.P.Composition -import LeanPool.BeyondBethe.Complexitylib.Classes.P.Defs -import LeanPool.BeyondBethe.Complexitylib.Classes.P.FinsetDomain -import LeanPool.BeyondBethe.Complexitylib.Classes.P.FinsetDomain.Internal -import LeanPool.BeyondBethe.Complexitylib.Classes.P.Internal -import LeanPool.BeyondBethe.Complexitylib.Classes.P.Internal.Composition -import LeanPool.BeyondBethe.Complexitylib.Classes.P.Internal.NormalForm -import LeanPool.BeyondBethe.Complexitylib.Classes.P.Internal.Preimage -import LeanPool.BeyondBethe.Complexitylib.Classes.P.NormalForm -import LeanPool.BeyondBethe.Complexitylib.Classes.P.PairWithInput -import LeanPool.BeyondBethe.Complexitylib.Classes.P.PairWithInput.Internal -import LeanPool.BeyondBethe.Complexitylib.Classes.P.Preimage -import LeanPool.BeyondBethe.Complexitylib.Classes.P.UnaryLength -import LeanPool.BeyondBethe.Complexitylib.Classes.P.UnaryLength.Internal -import LeanPool.BeyondBethe.Complexitylib.Classes.Pairing -import LeanPool.BeyondBethe.Complexitylib.Classes.Randomized -import LeanPool.BeyondBethe.Complexitylib.Classes.Space -import LeanPool.BeyondBethe.Complexitylib.Classes.Time -import LeanPool.BeyondBethe.Complexitylib.Encoding.Data -import LeanPool.BeyondBethe.Complexitylib.Encoding.DataEncode -import LeanPool.BeyondBethe.Complexitylib.Encoding.Delimit -import LeanPool.BeyondBethe.Complexitylib.Encoding.Pairing -import LeanPool.BeyondBethe.Complexitylib.Languages.LastBit -import LeanPool.BeyondBethe.Complexitylib.Mathlib.FinsetPrefixes -import LeanPool.BeyondBethe.Complexitylib.Mathlib.NatBits -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Classes -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Classes.Defs -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Defs -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Internal -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Containment -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Containment.Defs -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Containment.Internal -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Defs -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.DenseOverlay -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.DenseOverlay.Defs -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.DenseOverlay.Internal -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Internal -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.AddressEq -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.AddressEq.Defs -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.AddressEq.Internal -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.DenseInputLookup -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.DenseInputLookup.Defs -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.DenseInputLookup.Internal -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryAppend -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryAppend.Defs -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryAppend.Internal -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryCleanup -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryCleanup.Defs -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryCleanup.Internal -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryDecode -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryDecode.Defs -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryDecode.Internal -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryDecode.LinearInternal -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryEncode -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryEncode.Defs -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryEncode.Internal -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryLookup -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryLookup.Defs -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryLookup.Internal -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryLookupRestore -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryMatch -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryMatch.Defs -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryMatch.Internal -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryMissCopy -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryMissCopy.Defs -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryMissCopy.Internal -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryReplace -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryReplace.Defs -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryReplace.Internal -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryScan -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryScan.Defs -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryScan.Internal.Bounds -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryScan.Internal.Ctrl -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryScan.Internal.Inv -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryScan.Internal.Sem -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryScanStep -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryScanStep.Defs -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryScanStep.Internal -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.BoundsInternal -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Defs -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Ctrl -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.End -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Hit -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Inv -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Loop -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Miss -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Out -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Sem -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Step -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Time -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Progress -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Source -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Tagged -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.TaggedDefs -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.TaggedProof -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Control -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Defs -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Dense -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.DenseControl -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.DenseCtrlSim -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.DenseDefs -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.DenseDirect -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.DenseDispatch -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.DenseImm -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.DenseLoad -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.DenseSim -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.DenseSimData -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.DenseSimDefs -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.DenseStore -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Direct -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Dispatch -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Immediate -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Internal -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Load -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Sim.Control -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Sim.Data -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Sim.Defs -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Sim.Internal -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Store -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Defs -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.DenseInternal -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Internal.Assemble -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Internal.Bounds -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Internal.Prepare -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Internal.Reset -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Internal.Restore -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Internal.Scan -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Internal.Static -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Internal.Value -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Bounds -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Bounds.Defs -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Bounds.Internal -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Decision -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Decision.Defs -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.DecisionInternal -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Defs -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.DenseBounds -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.DenseBoundsDefs -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.DenseBoundsProof -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.DenseDecision -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.DenseDecisionDefs -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.DenseDecisionProof -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.DenseDefs -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.DenseInit -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.DenseInitDefs -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.DenseInitProof -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.DenseInternal -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Init.Defs -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Init.Internal -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Initialization -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Internal -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.WordDecode -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.WordDecode.Defs -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.WordDecode.Internal -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.WordDecode.LinearInternal -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.WordEncode -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.WordEncode.Defs -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.WordEncode.Internal -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Defs -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Internal -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.ABI -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.ABI.Defs -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.ABI.Internal.Capture -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.ABI.Internal.Decision -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.ABI.Internal.Loop -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.ABI.Internal.Marshal -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.ABI.Internal.Resources -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.Containment -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.Containment.Internal -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.Defs -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.Internal -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.Step -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.Step.Defs -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.Step.Internal -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.Step.Internal.Action -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.Step.Internal.Dispatch -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.Step.Internal.Iteration -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.Step.Internal.Layout -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.Step.Internal.Load -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.Step.Internal.Resources -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Step -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Step.Defs -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Step.Internal -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Step.Internal.Action -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Step.Internal.Dispatch -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Step.Internal.Layout -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Step.Internal.Load -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Step.Internal.Resources -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Soundness -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.Defs -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.GateEval -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.GateEval.Defs -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.GateEval.Internal -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.GateStep -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.GateStep.Defs -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.GateStep.Internal -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.GateStreamStep -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.GateStreamStep.Defs -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.GateStreamStep.Internal -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.Hamming -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.Hamming.Defs -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.Hamming.Internal -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.Internal -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.Internal.Resources -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.LastBit -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.LastBit.Defs -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.PairValidate -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.PairValidate.Defs -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.PairValidate.Internal -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.Scanner -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.Scanner.Defs -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.Scanner.Internal -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.Switch -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.Switch.Compiled -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.Switch.Defs -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.Switch.Internal -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.ThreeSATSyntax -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.ThreeSATSyntax.Defs -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.UnaryDecode -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.UnaryDecode.Defs -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.UnaryDecode.Internal -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.Apply -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.ForBinaryWork -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.ForBinaryWork.Defs -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.ForBinaryWork.Internal -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.ForInput.Defs -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.ForInput.Internal -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.ForWorkOnes.Defs -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.ForWorkOnes.Internal -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.Internal -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.Internal.Complement -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.Internal.Generic -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.Internal.If -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.Internal.Loop -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.Internal.Retarget -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.Internal.Scanner -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.Internal.Seq -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.Internal.Union -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.RetargetCompute -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.RetargetCompute.Defs -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.RetargetCompute.Internal -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.WorkBranch -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.WorkBranch.Defs -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.WorkBranch.Internal -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.WorkSymbolBranch -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.WorkSymbolBranch.Defs -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.WorkSymbolBranch.Internal -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Composition -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Composition.Defs -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Composition.Internal -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Composition.Internal.FirstPhase -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Composition.Internal.Tail -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Composition.PairWithInput -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Composition.PairWithInput.Defs -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Composition.PairWithInput.Internal -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Frame -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Hoare -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Hoare.Defs -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Hoare.RetargetOutput -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Hoare.Space -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Hoare.Space.Defs -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Hoare.Space.Internal -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Internal -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Internal.OutputBounds -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Lift -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.OutputBounds -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Placement -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Placement.Defs -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Placement.Internal -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Registers -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Registers.Arith -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Registers.Emit -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Registers.EmitSeq -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Registers.ForReg -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Registers.Horner -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Registers.InputLen -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Registers.RegisterOps -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.SpaceTime.Internal.Reachability -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryAddConst -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryAddConst.Defs -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryAddConst.Internal -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryCopy -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryCopy.Defs -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryCopy.Internal -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryEq -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryEq.Defs -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryEq.Internal -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryFor.Defs -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryFor.Internal.Comparison -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryFor.Internal.Control -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryFor.Internal.Loop -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryPred -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryPred.Defs -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryPred.Internal -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleAdd -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleAdd.Defs -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleAdd.Internal -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleAdd.Internal.Bounds -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleAdd.Internal.Out -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleAdd.Internal.Pure -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleAdd.Internal.Rewind -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleAdd.Internal.Scan -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleAdd.Internal.Sem -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleSub -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleSub.Defs -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleSub.Internal.Backward -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleSub.Internal.Out -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleSub.Internal.Pure -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleSub.Internal.Rewind -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleSub.Internal.Scan -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleSub.Internal.Sem -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryShiftMul -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryShiftMul.Defs -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryShiftMul.Internal.Out -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryShiftMul.Internal.Pure -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryShiftMul.Internal.Sem -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinarySucc -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinarySucc.Defs -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinarySucc.Internal -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.ClearWork -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.ClearWork.Defs -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.ClearWork.Internal -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.CopyOutput -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.CopyToVirtualInput -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.CopyWorkOutput -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.Counter -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.Internal -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.Internal.CopyOutput -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.Internal.CopyWorkOutput -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.MoveLeftStep -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.PairEmit -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.PairEmit.Defs -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.PairEmit.Internal -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.PairValidate -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.PairValidate.Defs -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.PairValidate.Internal -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.ParkAll -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.ResetBinary -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.ResetBinary.Defs -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.ResetBinary.Internal -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.ResetBinaryMany -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.ResetBinaryMany.Defs -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.ResetBinaryMany.Internal -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.ResetTapes -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.RewindList -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.UnaryLength -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.UnaryLength.Defs -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.UnaryLength.Internal -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.WipeLoop -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.WipeStep -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Tape.Encoding -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.WorkReadOnly -import LeanPool.BeyondBethe.Complexitylib.SAT.Encoding -import LeanPool.BeyondBethe.Complexitylib.SAT.Language -import LeanPool.BeyondBethe.Complexitylib.SAT.Rename -import LeanPool.BeyondBethe.Complexitylib.SAT.Semantics -import LeanPool.BeyondBethe.Complexitylib.SAT.ThreeCNF -import LeanPool.BeyondBethe.Complexitylib.SAT.ThreeSAT -import LeanPool.BeyondBethe.Complexitylib.SAT.ThreeSAT.Syntax -import LeanPool.BeyondBethe.Complexitylib.SAT.Verifier -import LeanPool.BeyondBethe.Solution + +public import LeanPool.BeyondBethe.BeyondBethe +public import LeanPool.BeyondBethe.BeyondBethe.AdaptiveRoundedEllipsoid +public import LeanPool.BeyondBethe.BeyondBethe.AlgorithmicSpec +public import LeanPool.BeyondBethe.BeyondBethe.ApproximateKKT +public import LeanPool.BeyondBethe.BeyondBethe.AxiomAudit +public import LeanPool.BeyondBethe.BeyondBethe.Bethe +public import LeanPool.BeyondBethe.BeyondBethe.BetheBisection +public import LeanPool.BeyondBethe.BeyondBethe.BetheEpigraph +public import LeanPool.BeyondBethe.BeyondBethe.BetheEpigraphFeasibility +public import LeanPool.BeyondBethe.BeyondBethe.BetheEpigraphGeometry +public import LeanPool.BeyondBethe.BeyondBethe.BetheFloorCutFormula +public import LeanPool.BeyondBethe.BeyondBethe.BetheThresholdFeasibility +public import LeanPool.BeyondBethe.BeyondBethe.BinaryDirectedElementary +public import LeanPool.BeyondBethe.BeyondBethe.BinaryLongDivision +public import LeanPool.BeyondBethe.BeyondBethe.BinaryRationalComparison +public import LeanPool.BeyondBethe.BeyondBethe.BinaryRationalFloor +public import LeanPool.BeyondBethe.BeyondBethe.Birkhoff +public import LeanPool.BeyondBethe.BeyondBethe.Capacity +public import LeanPool.BeyondBethe.BeyondBethe.CapacityOrder +public import LeanPool.BeyondBethe.BeyondBethe.CapacityScaling +public import LeanPool.BeyondBethe.BeyondBethe.CertificateCapacity +public import LeanPool.BeyondBethe.BeyondBethe.CertificateMagnitude +public import LeanPool.BeyondBethe.BeyondBethe.CertifiedPairWeights +public import LeanPool.BeyondBethe.BeyondBethe.CleanConstants +public import LeanPool.BeyondBethe.BeyondBethe.CleanGain +public import LeanPool.BeyondBethe.BeyondBethe.CleanWitness +public import LeanPool.BeyondBethe.BeyondBethe.ClusterAlpha +public import LeanPool.BeyondBethe.BeyondBethe.ClusterCertificate +public import LeanPool.BeyondBethe.BeyondBethe.ClusterFactors +public import LeanPool.BeyondBethe.BeyondBethe.ClusterProduct +public import LeanPool.BeyondBethe.BeyondBethe.Completion +public import LeanPool.BeyondBethe.BeyondBethe.CoreEncoding +public import LeanPool.BeyondBethe.BeyondBethe.CycleTransfer +public import LeanPool.BeyondBethe.BeyondBethe.Cycles +public import LeanPool.BeyondBethe.BeyondBethe.DirectedCertificateValue +public import LeanPool.BeyondBethe.BeyondBethe.DirectedElementary +public import LeanPool.BeyondBethe.BeyondBethe.DirectedOptimizerOracle +public import LeanPool.BeyondBethe.BeyondBethe.DirectedPairCost +public import LeanPool.BeyondBethe.BeyondBethe.DyadicMagnitudePrecision +public import LeanPool.BeyondBethe.BeyondBethe.DyadicRounding +public import LeanPool.BeyondBethe.BeyondBethe.Entropy +public import LeanPool.BeyondBethe.BeyondBethe.ExcursionTransfer +public import LeanPool.BeyondBethe.BeyondBethe.ExecutableCertificate +public import LeanPool.BeyondBethe.BeyondBethe.ExecutableCertificateMagnitude +public import LeanPool.BeyondBethe.BeyondBethe.ExecutableInterior +public import LeanPool.BeyondBethe.BeyondBethe.ExecutablePositiveRoutine +public import LeanPool.BeyondBethe.BeyondBethe.ExecutableScannedBetheOptimizer +public import LeanPool.BeyondBethe.BeyondBethe.ExecutableTransfer +public import LeanPool.BeyondBethe.BeyondBethe.ExplicitBetheOptimizer +public import LeanPool.BeyondBethe.BeyondBethe.ExplicitBetheThresholdFeasibility +public import LeanPool.BeyondBethe.BeyondBethe.ExplicitBounds +public import LeanPool.BeyondBethe.BeyondBethe.ExplicitOptimizerScales +public import LeanPool.BeyondBethe.BeyondBethe.ExplicitPositiveRoutine +public import LeanPool.BeyondBethe.BeyondBethe.ExplicitScales +public import LeanPool.BeyondBethe.BeyondBethe.ExplicitScheduledFeasibility +public import LeanPool.BeyondBethe.BeyondBethe.FinalAssembly +public import LeanPool.BeyondBethe.BeyondBethe.Gain +public import LeanPool.BeyondBethe.BeyondBethe.Gibbs +public import LeanPool.BeyondBethe.BeyondBethe.GoodRowScore +public import LeanPool.BeyondBethe.BeyondBethe.GreedyRowMatching +public import LeanPool.BeyondBethe.BeyondBethe.KuhnMatching +public import LeanPool.BeyondBethe.BeyondBethe.KuhnSmallStep +public import LeanPool.BeyondBethe.BeyondBethe.MachineArithmeticTests +public import LeanPool.BeyondBethe.BeyondBethe.MachineBetheAffineEntry +public import LeanPool.BeyondBethe.BeyondBethe.MachineBetheAffineLineSum +public import LeanPool.BeyondBethe.BeyondBethe.MachineBetheEpigraphOracle +public import LeanPool.BeyondBethe.BeyondBethe.MachineBetheFeasibilityFit +public import LeanPool.BeyondBethe.BeyondBethe.MachineBetheFeasibilityLoop +public import LeanPool.BeyondBethe.BeyondBethe.MachineBetheFeasibilitySemantics +public import LeanPool.BeyondBethe.BeyondBethe.MachineBetheFloorCutEntry +public import LeanPool.BeyondBethe.BeyondBethe.MachineBetheFloorCutVector +public import LeanPool.BeyondBethe.BeyondBethe.MachineBetheFloorScan +public import LeanPool.BeyondBethe.BeyondBethe.MachineBetheFloorTest +public import LeanPool.BeyondBethe.BeyondBethe.MachineBetheHeightCap +public import LeanPool.BeyondBethe.BeyondBethe.MachineBetheHeightNormal +public import LeanPool.BeyondBethe.BeyondBethe.MachineBinaryAdd +public import LeanPool.BeyondBethe.BeyondBethe.MachineBinaryAddSemantics +public import LeanPool.BeyondBethe.BeyondBethe.MachineBinaryCompare +public import LeanPool.BeyondBethe.BeyondBethe.MachineBinaryDivision +public import LeanPool.BeyondBethe.BeyondBethe.MachineBinaryGCD +public import LeanPool.BeyondBethe.BeyondBethe.MachineBinaryListInit +public import LeanPool.BeyondBethe.BeyondBethe.MachineBinaryListSnoc +public import LeanPool.BeyondBethe.BeyondBethe.MachineBinaryMul +public import LeanPool.BeyondBethe.BeyondBethe.MachineBinarySub +public import LeanPool.BeyondBethe.BeyondBethe.MachineBitAssembly +public import LeanPool.BeyondBethe.BeyondBethe.MachineBool +public import LeanPool.BeyondBethe.BeyondBethe.MachineBooleanInit +public import LeanPool.BeyondBethe.BeyondBethe.MachineBooleanMemory +public import LeanPool.BeyondBethe.BeyondBethe.MachineBoundedUnary +public import LeanPool.BeyondBethe.BeyondBethe.MachineCertificateAssembly +public import LeanPool.BeyondBethe.BeyondBethe.MachineCertificateExpGuard +public import LeanPool.BeyondBethe.BeyondBethe.MachineCertificatePotentials +public import LeanPool.BeyondBethe.BeyondBethe.MachineCertificateScales +public import LeanPool.BeyondBethe.BeyondBethe.MachineCertifiedPairEligibility +public import LeanPool.BeyondBethe.BeyondBethe.MachineCompletedAlgorithm +public import LeanPool.BeyondBethe.BeyondBethe.MachineDirectedAffineGradientEntry +public import LeanPool.BeyondBethe.BeyondBethe.MachineDirectedAffineGradientVector +public import LeanPool.BeyondBethe.BeyondBethe.MachineDirectedEpigraphNormal +public import LeanPool.BeyondBethe.BeyondBethe.MachineDirectedLog +public import LeanPool.BeyondBethe.BeyondBethe.MachineDirectedNegativeGradientCoordinate +public import LeanPool.BeyondBethe.BeyondBethe.MachineDirectedNegativeGradientEntry +public import LeanPool.BeyondBethe.BeyondBethe.MachineDirectedNegativeObjectiveCoordinate +public import LeanPool.BeyondBethe.BeyondBethe.MachineDirectedNegativeObjectiveSum +public import LeanPool.BeyondBethe.BeyondBethe.MachineDirectedTransferCost +public import LeanPool.BeyondBethe.BeyondBethe.MachineDyadicFloor +public import LeanPool.BeyondBethe.BeyondBethe.MachineDyadicFloorMatrix +public import LeanPool.BeyondBethe.BeyondBethe.MachineDyadicFloorVector +public import LeanPool.BeyondBethe.BeyondBethe.MachineEncoding +public import LeanPool.BeyondBethe.BeyondBethe.MachineExecutableCertificate +public import LeanPool.BeyondBethe.BeyondBethe.MachineExecutablePositiveAlgorithm +public import LeanPool.BeyondBethe.BeyondBethe.MachineExecutableScannedOptimizerOutput +public import LeanPool.BeyondBethe.BeyondBethe.MachineExplicitCertificate +public import LeanPool.BeyondBethe.BeyondBethe.MachineFPBasics +public import LeanPool.BeyondBethe.BeyondBethe.MachineFactorial +public import LeanPool.BeyondBethe.BeyondBethe.MachineFinalScalars +public import LeanPool.BeyondBethe.BeyondBethe.MachineFourCoreCost +public import LeanPool.BeyondBethe.BeyondBethe.MachineGreedyRowMatching +public import LeanPool.BeyondBethe.BeyondBethe.MachineIntegerArithmetic +public import LeanPool.BeyondBethe.BeyondBethe.MachineIntegerCompare +public import LeanPool.BeyondBethe.BeyondBethe.MachineIntegerSignedMagnitude +public import LeanPool.BeyondBethe.BeyondBethe.MachineKuhnEncoding +public import LeanPool.BeyondBethe.BeyondBethe.MachineKuhnInvariant +public import LeanPool.BeyondBethe.BeyondBethe.MachineKuhnRunner +public import LeanPool.BeyondBethe.BeyondBethe.MachineKuhnSemantics +public import LeanPool.BeyondBethe.BeyondBethe.MachineKuhnStep +public import LeanPool.BeyondBethe.BeyondBethe.MachineLengthBits +public import LeanPool.BeyondBethe.BeyondBethe.MachineListIndex +public import LeanPool.BeyondBethe.BeyondBethe.MachineListReverse +public import LeanPool.BeyondBethe.BeyondBethe.MachineListUpdate +public import LeanPool.BeyondBethe.BeyondBethe.MachineMatchingGain +public import LeanPool.BeyondBethe.BeyondBethe.MachineMateAllSome +public import LeanPool.BeyondBethe.BeyondBethe.MachineMateMemory +public import LeanPool.BeyondBethe.BeyondBethe.MachineMatrixAddDelta +public import LeanPool.BeyondBethe.BeyondBethe.MachineMatrixDimension +public import LeanPool.BeyondBethe.BeyondBethe.MachineMatrixNonnegative +public import LeanPool.BeyondBethe.BeyondBethe.MachineMatrixNormalization +public import LeanPool.BeyondBethe.BeyondBethe.MachineMatrixNormalizeEntries +public import LeanPool.BeyondBethe.BeyondBethe.MachineMatrixSum +public import LeanPool.BeyondBethe.BeyondBethe.MachineMatrixSupportProduct +public import LeanPool.BeyondBethe.BeyondBethe.MachineNaturalCombinators +public import LeanPool.BeyondBethe.BeyondBethe.MachineNearbyCoordinate +public import LeanPool.BeyondBethe.BeyondBethe.MachineNearbyMatrixSum +public import LeanPool.BeyondBethe.BeyondBethe.MachineNestedMatrixMemory +public import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerBisectionLoop +public import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerBisectionSchedule +public import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerBisectionSemantics +public import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerCertificateBoundary +public import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerDerivedScales +public import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerEntryLength +public import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerFeasibilityCall +public import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerFeasibilitySchedule +public import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerInteriorScale +public import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerMatrixBitBound +public import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerRoundingSchedule +public import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerStateBound +public import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerTests +public import LeanPool.BeyondBethe.BeyondBethe.MachineOutputEncoding +public import LeanPool.BeyondBethe.BeyondBethe.MachinePerfectMatching +public import LeanPool.BeyondBethe.BeyondBethe.MachinePositiveAlgorithm +public import LeanPool.BeyondBethe.BeyondBethe.MachineRAMBridge +public import LeanPool.BeyondBethe.BeyondBethe.MachineRAMSmoke +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalArithmetic +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalBallInit +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalCompare +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalDirectionUpdateMatrix +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalDirectionUpdateRow +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalEllipsoidCenterUpdate +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalEllipsoidEncoding +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalEllipsoidScalars +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalEllipsoidUpdate +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalExp +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalFloor +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalLogSeries +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalMatrixColumn +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalMatrixMul +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalMatrixMulVector +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalMatrixUpdate +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalMin +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalNormalization +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalNormalizedDirection +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalPower +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalRowAdd +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalRowDivide +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalTransposeMulVector +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalUnary +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalVectorDot +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalVectorL1 +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalVectorScale +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalVectorSub +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalVectorSum +public import LeanPool.BeyondBethe.BeyondBethe.MachineRepeatPair +public import LeanPool.BeyondBethe.BeyondBethe.MachineRowComplementUpperSum +public import LeanPool.BeyondBethe.BeyondBethe.MachineRowPairDisjoint +public import LeanPool.BeyondBethe.BeyondBethe.MachineScheduledLog +public import LeanPool.BeyondBethe.BeyondBethe.MachineScheduledLogWidth +public import LeanPool.BeyondBethe.BeyondBethe.MachineScheduledRoundedEllipsoid +public import LeanPool.BeyondBethe.BeyondBethe.MachineScheduledStateEncodingBound +public import LeanPool.BeyondBethe.BeyondBethe.MachineSmallDimension +public import LeanPool.BeyondBethe.BeyondBethe.MachineSmoothedMatrix +public import LeanPool.BeyondBethe.BeyondBethe.MachineSmoothingDelta +public import LeanPool.BeyondBethe.BeyondBethe.MachineTrimHighZeros +public import LeanPool.BeyondBethe.BeyondBethe.MachineUnaryGridGenerator +public import LeanPool.BeyondBethe.BeyondBethe.MachineUnaryMatrixGenerator +public import LeanPool.BeyondBethe.BeyondBethe.MachineUnaryRange +public import LeanPool.BeyondBethe.BeyondBethe.Main +public import LeanPool.BeyondBethe.BeyondBethe.MatchingAlgorithm +public import LeanPool.BeyondBethe.BeyondBethe.MatrixPerturbation +public import LeanPool.BeyondBethe.BeyondBethe.NearCase +public import LeanPool.BeyondBethe.BeyondBethe.NumericalAffine +public import LeanPool.BeyondBethe.BeyondBethe.NumericalCapacity +public import LeanPool.BeyondBethe.BeyondBethe.NumericalInterior +public import LeanPool.BeyondBethe.BeyondBethe.NumericalNearby +public import LeanPool.BeyondBethe.BeyondBethe.NumericalPotentials +public import LeanPool.BeyondBethe.BeyondBethe.NumericalScales +public import LeanPool.BeyondBethe.BeyondBethe.NumericalTransfer +public import LeanPool.BeyondBethe.BeyondBethe.NumericalWitness +public import LeanPool.BeyondBethe.BeyondBethe.Optimizer +public import LeanPool.BeyondBethe.BeyondBethe.OptimizerOutputEncoding +public import LeanPool.BeyondBethe.BeyondBethe.PairFactorization +public import LeanPool.BeyondBethe.BeyondBethe.PairStability +public import LeanPool.BeyondBethe.BeyondBethe.PairedCertificate +public import LeanPool.BeyondBethe.BeyondBethe.PalomarComplexity +public import LeanPool.BeyondBethe.BeyondBethe.Permanent +public import LeanPool.BeyondBethe.BeyondBethe.RationalEllipsoid +public import LeanPool.BeyondBethe.BeyondBethe.RationalEncodingBounds +public import LeanPool.BeyondBethe.BeyondBethe.RationalEpigraphOracle +public import LeanPool.BeyondBethe.BeyondBethe.RationalFeasibility +public import LeanPool.BeyondBethe.BeyondBethe.RationalLinearOracle +public import LeanPool.BeyondBethe.BeyondBethe.RawRational +public import LeanPool.BeyondBethe.BeyondBethe.RawRationalBitBounds +public import LeanPool.BeyondBethe.BeyondBethe.RobustCycle +public import LeanPool.BeyondBethe.BeyondBethe.RoundedEllipsoid +public import LeanPool.BeyondBethe.BeyondBethe.RoundedEllipsoidBitBounds +public import LeanPool.BeyondBethe.BeyondBethe.RoundedEllipsoidIterationBounds +public import LeanPool.BeyondBethe.BeyondBethe.RoundedEllipsoidScales +public import LeanPool.BeyondBethe.BeyondBethe.RoundedFeasibility +public import LeanPool.BeyondBethe.BeyondBethe.RoundedFeasibilityBitBounds +public import LeanPool.BeyondBethe.BeyondBethe.RowStability +public import LeanPool.BeyondBethe.BeyondBethe.ScannedBetheBisection +public import LeanPool.BeyondBethe.BeyondBethe.ScannedBetheThresholdFeasibility +public import LeanPool.BeyondBethe.BeyondBethe.ScheduledFeasibility +public import LeanPool.BeyondBethe.BeyondBethe.ScheduledRoundedEllipsoid +public import LeanPool.BeyondBethe.BeyondBethe.ScheduledRoundedEllipsoidIteration +public import LeanPool.BeyondBethe.BeyondBethe.Sequential +public import LeanPool.BeyondBethe.BeyondBethe.SequentialNormalization +public import LeanPool.BeyondBethe.BeyondBethe.Slack +public import LeanPool.BeyondBethe.BeyondBethe.Smoothing +public import LeanPool.BeyondBethe.BeyondBethe.SourceAnariRezaei +public import LeanPool.BeyondBethe.BeyondBethe.SourceAnariRezaeiList +public import LeanPool.BeyondBethe.BeyondBethe.SourceAnariRezaeiMerge +public import LeanPool.BeyondBethe.BeyondBethe.SourceBetheLower +public import LeanPool.BeyondBethe.BeyondBethe.SourceBetheUpper +public import LeanPool.BeyondBethe.BeyondBethe.SourceStableBivariate +public import LeanPool.BeyondBethe.BeyondBethe.SourceStableClosure +public import LeanPool.BeyondBethe.BeyondBethe.SourceStableEncoding +public import LeanPool.BeyondBethe.BeyondBethe.SourceStableInduction +public import LeanPool.BeyondBethe.BeyondBethe.SourceStableReindex +public import LeanPool.BeyondBethe.BeyondBethe.SourceStableSlice +public import LeanPool.BeyondBethe.BeyondBethe.SourceStableSpecialization +public import LeanPool.BeyondBethe.BeyondBethe.SourceStableTable +public import LeanPool.BeyondBethe.BeyondBethe.SourceVontobel +public import LeanPool.BeyondBethe.BeyondBethe.Stable +public import LeanPool.BeyondBethe.BeyondBethe.StrongEntropy +public import LeanPool.BeyondBethe.BeyondBethe.Transfer +public import LeanPool.BeyondBethe.BeyondBethe.TransferIdentity +public import LeanPool.BeyondBethe.BeyondBethe.WeakSeparation +public import LeanPool.BeyondBethe.Complexitylib.Asymptotics +public import LeanPool.BeyondBethe.Complexitylib.Asymptotics.PolyBound +public import LeanPool.BeyondBethe.Complexitylib.Asymptotics.PolynomialComposition +public import LeanPool.BeyondBethe.Complexitylib.Circuits.AndOrNot.Defs +public import LeanPool.BeyondBethe.Complexitylib.Circuits.Basic +public import LeanPool.BeyondBethe.Complexitylib.Circuits.Encoding.Defs +public import LeanPool.BeyondBethe.Complexitylib.Circuits.Encoding.Internal.Codec +public import LeanPool.BeyondBethe.Complexitylib.Classes.Containments +public import LeanPool.BeyondBethe.Complexitylib.Classes.Exponential +public import LeanPool.BeyondBethe.Complexitylib.Classes.FNP.Defs +public import LeanPool.BeyondBethe.Complexitylib.Classes.L +public import LeanPool.BeyondBethe.Complexitylib.Classes.NP +public import LeanPool.BeyondBethe.Complexitylib.Classes.NP.Witness +public import LeanPool.BeyondBethe.Complexitylib.Classes.P +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Defs +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.Algebra +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.BlockScan +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.Blocks +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.Cat +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.ConsBit +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.Encoding +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.Extract +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.FstBlock +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.HeadFlag +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.Iterate +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.IterateLayout +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.MulLen +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.Reorder +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.Reverse +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.Simulate +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.SndBlock +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.StepAlgebra +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.TakeLen +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.Vec +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Vec +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Composition +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Defs +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.FinsetDomain +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.FinsetDomain.Internal +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Internal +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Internal.Composition +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Internal.NormalForm +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Internal.Preimage +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.NormalForm +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.PairWithInput +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.PairWithInput.Internal +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Preimage +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.UnaryLength +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.UnaryLength.Internal +public import LeanPool.BeyondBethe.Complexitylib.Classes.Pairing +public import LeanPool.BeyondBethe.Complexitylib.Classes.Randomized +public import LeanPool.BeyondBethe.Complexitylib.Classes.Space +public import LeanPool.BeyondBethe.Complexitylib.Classes.Time +public import LeanPool.BeyondBethe.Complexitylib.Encoding.Data +public import LeanPool.BeyondBethe.Complexitylib.Encoding.DataEncode +public import LeanPool.BeyondBethe.Complexitylib.Encoding.Delimit +public import LeanPool.BeyondBethe.Complexitylib.Encoding.Pairing +public import LeanPool.BeyondBethe.Complexitylib.Languages.LastBit +public import LeanPool.BeyondBethe.Complexitylib.Mathlib.FinsetPrefixes +public import LeanPool.BeyondBethe.Complexitylib.Mathlib.NatBits +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Classes +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Classes.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Containment +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Containment.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Containment.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.DenseOverlay +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.DenseOverlay.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.DenseOverlay.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.AddressEq +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.AddressEq.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.AddressEq.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.DenseInputLookup +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.DenseInputLookup.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.DenseInputLookup.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryAppend +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryAppend.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryAppend.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryCleanup +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryCleanup.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryCleanup.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryDecode +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryDecode.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryDecode.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryDecode.LinearInternal +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryEncode +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryEncode.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryEncode.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryLookup +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryLookup.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryLookup.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryLookupRestore +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryMatch +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryMatch.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryMatch.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryMissCopy +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryMissCopy.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryMissCopy.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryReplace +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryReplace.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryReplace.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryScan +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryScan.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryScan.Internal.Bounds +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryScan.Internal.Ctrl +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryScan.Internal.Inv +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryScan.Internal.Sem +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryScanStep +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryScanStep.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryScanStep.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.BoundsInternal +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Ctrl +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.End +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Hit +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Inv +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Loop +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Miss +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Out +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Sem +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Step +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Time +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Progress +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Source +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Tagged +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.TaggedDefs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.TaggedProof +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Control +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Dense +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.DenseControl +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.DenseCtrlSim +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.DenseDefs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.DenseDirect +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.DenseDispatch +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.DenseImm +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.DenseLoad +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.DenseSim +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.DenseSimData +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.DenseSimDefs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.DenseStore +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Direct +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Dispatch +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Immediate +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Load +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Sim.Control +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Sim.Data +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Sim.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Sim.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Store +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.DenseInternal +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Internal.Assemble +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Internal.Bounds +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Internal.Prepare +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Internal.Reset +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Internal.Restore +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Internal.Scan +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Internal.Static +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Internal.Value +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Bounds +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Bounds.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Bounds.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Decision +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Decision.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.DecisionInternal +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.DenseBounds +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.DenseBoundsDefs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.DenseBoundsProof +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.DenseDecision +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.DenseDecisionDefs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.DenseDecisionProof +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.DenseDefs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.DenseInit +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.DenseInitDefs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.DenseInitProof +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.DenseInternal +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Init.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Init.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Initialization +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.WordDecode +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.WordDecode.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.WordDecode.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.WordDecode.LinearInternal +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.WordEncode +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.WordEncode.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.WordEncode.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.ABI +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.ABI.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.ABI.Internal.Capture +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.ABI.Internal.Decision +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.ABI.Internal.Loop +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.ABI.Internal.Marshal +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.ABI.Internal.Resources +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.Containment +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.Containment.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.Step +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.Step.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.Step.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.Step.Internal.Action +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.Step.Internal.Dispatch +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.Step.Internal.Iteration +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.Step.Internal.Layout +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.Step.Internal.Load +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.Step.Internal.Resources +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Step +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Step.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Step.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Step.Internal.Action +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Step.Internal.Dispatch +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Step.Internal.Layout +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Step.Internal.Load +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Step.Internal.Resources +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Soundness +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.GateEval +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.GateEval.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.GateEval.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.GateStep +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.GateStep.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.GateStep.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.GateStreamStep +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.GateStreamStep.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.GateStreamStep.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.Hamming +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.Hamming.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.Hamming.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.Internal.Resources +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.LastBit +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.LastBit.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.PairValidate +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.PairValidate.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.PairValidate.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.Scanner +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.Scanner.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.Scanner.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.Switch +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.Switch.Compiled +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.Switch.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.Switch.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.ThreeSATSyntax +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.ThreeSATSyntax.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.UnaryDecode +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.UnaryDecode.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.UnaryDecode.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.Apply +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.ForBinaryWork +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.ForBinaryWork.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.ForBinaryWork.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.ForInput.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.ForInput.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.ForWorkOnes.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.ForWorkOnes.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.Internal.Complement +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.Internal.Generic +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.Internal.If +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.Internal.Loop +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.Internal.Retarget +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.Internal.Scanner +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.Internal.Seq +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.Internal.Union +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.RetargetCompute +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.RetargetCompute.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.RetargetCompute.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.WorkBranch +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.WorkBranch.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.WorkBranch.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.WorkSymbolBranch +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.WorkSymbolBranch.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.WorkSymbolBranch.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Composition +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Composition.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Composition.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Composition.Internal.FirstPhase +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Composition.Internal.Tail +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Composition.PairWithInput +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Composition.PairWithInput.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Composition.PairWithInput.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Frame +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Hoare +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Hoare.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Hoare.RetargetOutput +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Hoare.Space +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Hoare.Space.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Hoare.Space.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Internal.OutputBounds +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Lift +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.OutputBounds +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Placement +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Placement.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Placement.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Registers +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Registers.Arith +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Registers.Emit +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Registers.EmitSeq +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Registers.ForReg +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Registers.Horner +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Registers.InputLen +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Registers.RegisterOps +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.SpaceTime.Internal.Reachability +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryAddConst +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryAddConst.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryAddConst.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryCopy +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryCopy.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryCopy.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryEq +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryEq.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryEq.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryFor.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryFor.Internal.Comparison +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryFor.Internal.Control +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryFor.Internal.Loop +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryPred +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryPred.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryPred.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleAdd +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleAdd.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleAdd.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleAdd.Internal.Bounds +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleAdd.Internal.Out +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleAdd.Internal.Pure +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleAdd.Internal.Rewind +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleAdd.Internal.Scan +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleAdd.Internal.Sem +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleSub +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleSub.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleSub.Internal.Backward +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleSub.Internal.Out +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleSub.Internal.Pure +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleSub.Internal.Rewind +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleSub.Internal.Scan +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleSub.Internal.Sem +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryShiftMul +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryShiftMul.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryShiftMul.Internal.Out +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryShiftMul.Internal.Pure +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryShiftMul.Internal.Sem +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinarySucc +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinarySucc.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinarySucc.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.ClearWork +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.ClearWork.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.ClearWork.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.CopyOutput +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.CopyToVirtualInput +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.CopyWorkOutput +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.Counter +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.Internal.CopyOutput +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.Internal.CopyWorkOutput +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.MoveLeftStep +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.PairEmit +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.PairEmit.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.PairEmit.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.PairValidate +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.PairValidate.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.PairValidate.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.ParkAll +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.ResetBinary +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.ResetBinary.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.ResetBinary.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.ResetBinaryMany +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.ResetBinaryMany.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.ResetBinaryMany.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.ResetTapes +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.RewindList +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.UnaryLength +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.UnaryLength.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.UnaryLength.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.WipeLoop +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.WipeStep +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Tape.Encoding +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.WorkReadOnly +public import LeanPool.BeyondBethe.Complexitylib.SAT.Encoding +public import LeanPool.BeyondBethe.Complexitylib.SAT.Language +public import LeanPool.BeyondBethe.Complexitylib.SAT.Rename +public import LeanPool.BeyondBethe.Complexitylib.SAT.Semantics +public import LeanPool.BeyondBethe.Complexitylib.SAT.ThreeCNF +public import LeanPool.BeyondBethe.Complexitylib.SAT.ThreeSAT +public import LeanPool.BeyondBethe.Complexitylib.SAT.ThreeSAT.Syntax +public import LeanPool.BeyondBethe.Complexitylib.SAT.Verifier +public import LeanPool.BeyondBethe.Solution /-! # Beyond the Bethe approximation of the permanent @@ -691,6 +693,8 @@ Tags: permanent, approximation-algorithms, computational-complexity, stable-poly MSC: 68W25, 15A15 -/ +@[expose] public section + /- Upstream attribution notices: diff --git a/LeanPool/BeyondBethe/BeyondBethe.lean b/LeanPool/BeyondBethe/BeyondBethe.lean index 01035ab857..a51b33e120 100644 --- a/LeanPool/BeyondBethe/BeyondBethe.lean +++ b/LeanPool/BeyondBethe/BeyondBethe.lean @@ -3,258 +3,262 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.Permanent -import LeanPool.BeyondBethe.BeyondBethe.Birkhoff -import LeanPool.BeyondBethe.BeyondBethe.Entropy -import LeanPool.BeyondBethe.BeyondBethe.Bethe -import LeanPool.BeyondBethe.BeyondBethe.Stable -import LeanPool.BeyondBethe.BeyondBethe.Capacity -import LeanPool.BeyondBethe.BeyondBethe.CapacityOrder -import LeanPool.BeyondBethe.BeyondBethe.CapacityScaling -import LeanPool.BeyondBethe.BeyondBethe.PairedCertificate -import LeanPool.BeyondBethe.BeyondBethe.PairStability -import LeanPool.BeyondBethe.BeyondBethe.PairFactorization -import LeanPool.BeyondBethe.BeyondBethe.ClusterProduct -import LeanPool.BeyondBethe.BeyondBethe.ClusterFactors -import LeanPool.BeyondBethe.BeyondBethe.ClusterAlpha -import LeanPool.BeyondBethe.BeyondBethe.CertificateCapacity -import LeanPool.BeyondBethe.BeyondBethe.ClusterCertificate -import LeanPool.BeyondBethe.BeyondBethe.Gibbs -import LeanPool.BeyondBethe.BeyondBethe.SequentialNormalization -import LeanPool.BeyondBethe.BeyondBethe.Sequential -import LeanPool.BeyondBethe.BeyondBethe.Slack -import LeanPool.BeyondBethe.BeyondBethe.CoreEncoding -import LeanPool.BeyondBethe.BeyondBethe.Cycles -import LeanPool.BeyondBethe.BeyondBethe.GoodRowScore -import LeanPool.BeyondBethe.BeyondBethe.RobustCycle -import LeanPool.BeyondBethe.BeyondBethe.RowStability -import LeanPool.BeyondBethe.BeyondBethe.SourceAnariRezaei -import LeanPool.BeyondBethe.BeyondBethe.SourceAnariRezaeiMerge -import LeanPool.BeyondBethe.BeyondBethe.SourceAnariRezaeiList -import LeanPool.BeyondBethe.BeyondBethe.SourceBetheUpper -import LeanPool.BeyondBethe.BeyondBethe.SourceBetheLower -import LeanPool.BeyondBethe.BeyondBethe.SourceStableClosure -import LeanPool.BeyondBethe.BeyondBethe.SourceStableBivariate -import LeanPool.BeyondBethe.BeyondBethe.SourceStableTable -import LeanPool.BeyondBethe.BeyondBethe.SourceStableSpecialization -import LeanPool.BeyondBethe.BeyondBethe.SourceStableSlice -import LeanPool.BeyondBethe.BeyondBethe.SourceStableInduction -import LeanPool.BeyondBethe.BeyondBethe.SourceStableEncoding -import LeanPool.BeyondBethe.BeyondBethe.SourceStableReindex -import LeanPool.BeyondBethe.BeyondBethe.Transfer -import LeanPool.BeyondBethe.BeyondBethe.TransferIdentity -import LeanPool.BeyondBethe.BeyondBethe.Optimizer -import LeanPool.BeyondBethe.BeyondBethe.CycleTransfer -import LeanPool.BeyondBethe.BeyondBethe.ExcursionTransfer -import LeanPool.BeyondBethe.BeyondBethe.Gain -import LeanPool.BeyondBethe.BeyondBethe.CleanWitness -import LeanPool.BeyondBethe.BeyondBethe.CleanGain -import LeanPool.BeyondBethe.BeyondBethe.CleanConstants -import LeanPool.BeyondBethe.BeyondBethe.Smoothing -import LeanPool.BeyondBethe.BeyondBethe.Completion -import LeanPool.BeyondBethe.BeyondBethe.AlgorithmicSpec -import LeanPool.BeyondBethe.BeyondBethe.PalomarComplexity -import LeanPool.BeyondBethe.BeyondBethe.DirectedElementary -import LeanPool.BeyondBethe.BeyondBethe.ExplicitBounds -import LeanPool.BeyondBethe.BeyondBethe.KuhnMatching -import LeanPool.BeyondBethe.BeyondBethe.GreedyRowMatching -import LeanPool.BeyondBethe.BeyondBethe.NearCase -import LeanPool.BeyondBethe.BeyondBethe.NumericalScales -import LeanPool.BeyondBethe.BeyondBethe.ExplicitScales -import LeanPool.BeyondBethe.BeyondBethe.ExecutableCertificate -import LeanPool.BeyondBethe.BeyondBethe.ExecutableTransfer -import LeanPool.BeyondBethe.BeyondBethe.DirectedCertificateValue -import LeanPool.BeyondBethe.BeyondBethe.NumericalNearby -import LeanPool.BeyondBethe.BeyondBethe.NumericalInterior -import LeanPool.BeyondBethe.BeyondBethe.NumericalCapacity -import LeanPool.BeyondBethe.BeyondBethe.NumericalTransfer -import LeanPool.BeyondBethe.BeyondBethe.NumericalPotentials -import LeanPool.BeyondBethe.BeyondBethe.NumericalAffine -import LeanPool.BeyondBethe.BeyondBethe.DirectedOptimizerOracle -import LeanPool.BeyondBethe.BeyondBethe.WeakSeparation -import LeanPool.BeyondBethe.BeyondBethe.ExecutableInterior -import LeanPool.BeyondBethe.BeyondBethe.RationalEllipsoid -import LeanPool.BeyondBethe.BeyondBethe.DyadicRounding -import LeanPool.BeyondBethe.BeyondBethe.DyadicMagnitudePrecision -import LeanPool.BeyondBethe.BeyondBethe.MatrixPerturbation -import LeanPool.BeyondBethe.BeyondBethe.RoundedEllipsoid -import LeanPool.BeyondBethe.BeyondBethe.RoundedEllipsoidScales -import LeanPool.BeyondBethe.BeyondBethe.AdaptiveRoundedEllipsoid -import LeanPool.BeyondBethe.BeyondBethe.RoundedEllipsoidBitBounds -import LeanPool.BeyondBethe.BeyondBethe.RoundedEllipsoidIterationBounds -import LeanPool.BeyondBethe.BeyondBethe.ScheduledRoundedEllipsoid -import LeanPool.BeyondBethe.BeyondBethe.ScheduledRoundedEllipsoidIteration -import LeanPool.BeyondBethe.BeyondBethe.ScheduledFeasibility -import LeanPool.BeyondBethe.BeyondBethe.RationalEncodingBounds -import LeanPool.BeyondBethe.BeyondBethe.BinaryLongDivision -import LeanPool.BeyondBethe.BeyondBethe.RawRational -import LeanPool.BeyondBethe.BeyondBethe.RawRationalBitBounds -import LeanPool.BeyondBethe.BeyondBethe.BinaryRationalComparison -import LeanPool.BeyondBethe.BeyondBethe.BinaryRationalFloor -import LeanPool.BeyondBethe.BeyondBethe.MachineEncoding -import LeanPool.BeyondBethe.BeyondBethe.MachineFPBasics -import LeanPool.BeyondBethe.BeyondBethe.MachineBool -import LeanPool.BeyondBethe.BeyondBethe.MachineBinaryAdd -import LeanPool.BeyondBethe.BeyondBethe.MachineBinaryAddSemantics -import LeanPool.BeyondBethe.BeyondBethe.MachineBinaryMul -import LeanPool.BeyondBethe.BeyondBethe.MachineBinarySub -import LeanPool.BeyondBethe.BeyondBethe.MachineBinaryCompare -import LeanPool.BeyondBethe.BeyondBethe.MachineOutputEncoding -import LeanPool.BeyondBethe.BeyondBethe.MachineBinaryDivision -import LeanPool.BeyondBethe.BeyondBethe.MachineBinaryGCD -import LeanPool.BeyondBethe.BeyondBethe.MachineIntegerSignedMagnitude -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalNormalization -import LeanPool.BeyondBethe.BeyondBethe.MachineIntegerArithmetic -import LeanPool.BeyondBethe.BeyondBethe.MachineIntegerCompare -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalArithmetic -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalUnary -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalPower -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalCompare -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalMin -import LeanPool.BeyondBethe.BeyondBethe.MachineFactorial -import LeanPool.BeyondBethe.BeyondBethe.MachineSmoothingDelta -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalRowAdd -import LeanPool.BeyondBethe.BeyondBethe.MachineMatrixAddDelta -import LeanPool.BeyondBethe.BeyondBethe.MachineSmoothedMatrix -import LeanPool.BeyondBethe.BeyondBethe.MachineCompletedAlgorithm -import LeanPool.BeyondBethe.BeyondBethe.MachinePositiveAlgorithm -import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerCertificateBoundary -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalVectorSum -import LeanPool.BeyondBethe.BeyondBethe.MachineCertificatePotentials -import LeanPool.BeyondBethe.BeyondBethe.MachineCertificateScales -import LeanPool.BeyondBethe.BeyondBethe.MachineScheduledLog -import LeanPool.BeyondBethe.BeyondBethe.MachineNearbyCoordinate -import LeanPool.BeyondBethe.BeyondBethe.MachineScheduledLogWidth -import LeanPool.BeyondBethe.BeyondBethe.MachineNearbyMatrixSum -import LeanPool.BeyondBethe.BeyondBethe.MachineRowComplementUpperSum -import LeanPool.BeyondBethe.BeyondBethe.MachineDirectedTransferCost -import LeanPool.BeyondBethe.BeyondBethe.MachineFourCoreCost -import LeanPool.BeyondBethe.BeyondBethe.MachineCertifiedPairEligibility -import LeanPool.BeyondBethe.BeyondBethe.MachineRowPairDisjoint -import LeanPool.BeyondBethe.BeyondBethe.MachineGreedyRowMatching -import LeanPool.BeyondBethe.BeyondBethe.MachineMatchingGain -import LeanPool.BeyondBethe.BeyondBethe.MachineCertificateAssembly -import LeanPool.BeyondBethe.BeyondBethe.CertificateMagnitude -import LeanPool.BeyondBethe.BeyondBethe.MachineCertificateExpGuard -import LeanPool.BeyondBethe.BeyondBethe.MachineExplicitCertificate -import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerEntryLength -import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerMatrixBitBound -import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerInteriorScale -import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerDerivedScales -import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerBisectionSchedule -import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerFeasibilitySchedule -import LeanPool.BeyondBethe.BeyondBethe.ExplicitScheduledFeasibility -import LeanPool.BeyondBethe.BeyondBethe.ExplicitBetheThresholdFeasibility -import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerRoundingSchedule -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalBallInit -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalVectorDot -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalVectorL1 -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalEllipsoidScalars -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalNormalizedDirection -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalVectorScale -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalVectorSub -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalEllipsoidCenterUpdate -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalDirectionUpdateRow -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalDirectionUpdateMatrix -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalEllipsoidUpdate -import LeanPool.BeyondBethe.BeyondBethe.MachineDyadicFloorVector -import LeanPool.BeyondBethe.BeyondBethe.MachineDyadicFloorMatrix -import LeanPool.BeyondBethe.BeyondBethe.MachineScheduledRoundedEllipsoid -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalMatrixMulVector -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalMatrixMul -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalMatrixColumn -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalTransposeMulVector -import LeanPool.BeyondBethe.BeyondBethe.MachineBetheAffineLineSum -import LeanPool.BeyondBethe.BeyondBethe.MachineBetheAffineEntry -import LeanPool.BeyondBethe.BeyondBethe.MachineBetheFloorTest -import LeanPool.BeyondBethe.BeyondBethe.MachineBetheFloorScan -import LeanPool.BeyondBethe.BeyondBethe.MachineBetheHeightCap -import LeanPool.BeyondBethe.BeyondBethe.BetheFloorCutFormula -import LeanPool.BeyondBethe.BeyondBethe.MachineBetheFloorCutEntry -import LeanPool.BeyondBethe.BeyondBethe.MachineDirectedNegativeObjectiveCoordinate -import LeanPool.BeyondBethe.BeyondBethe.MachineDirectedNegativeObjectiveSum -import LeanPool.BeyondBethe.BeyondBethe.MachineDirectedNegativeGradientCoordinate -import LeanPool.BeyondBethe.BeyondBethe.MachineDirectedNegativeGradientEntry -import LeanPool.BeyondBethe.BeyondBethe.MachineDirectedAffineGradientEntry -import LeanPool.BeyondBethe.BeyondBethe.MachineUnaryGridGenerator -import LeanPool.BeyondBethe.BeyondBethe.MachineDirectedAffineGradientVector -import LeanPool.BeyondBethe.BeyondBethe.MachineBinaryListSnoc -import LeanPool.BeyondBethe.BeyondBethe.MachineBinaryListInit -import LeanPool.BeyondBethe.BeyondBethe.MachineBetheFloorCutVector -import LeanPool.BeyondBethe.BeyondBethe.MachineBetheHeightNormal -import LeanPool.BeyondBethe.BeyondBethe.MachineDirectedEpigraphNormal -import LeanPool.BeyondBethe.BeyondBethe.MachineBetheEpigraphOracle -import LeanPool.BeyondBethe.BeyondBethe.ScannedBetheThresholdFeasibility -import LeanPool.BeyondBethe.BeyondBethe.MachineBetheFeasibilityLoop -import LeanPool.BeyondBethe.BeyondBethe.MachineBetheFeasibilitySemantics -import LeanPool.BeyondBethe.BeyondBethe.MachineScheduledStateEncodingBound -import LeanPool.BeyondBethe.BeyondBethe.MachineBetheFeasibilityFit -import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerStateBound -import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerFeasibilityCall -import LeanPool.BeyondBethe.BeyondBethe.ScannedBetheBisection -import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerBisectionLoop -import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerBisectionSemantics -import LeanPool.BeyondBethe.BeyondBethe.ExecutableScannedBetheOptimizer -import LeanPool.BeyondBethe.BeyondBethe.OptimizerOutputEncoding -import LeanPool.BeyondBethe.BeyondBethe.MachineUnaryMatrixGenerator -import LeanPool.BeyondBethe.BeyondBethe.MachineExecutableScannedOptimizerOutput -import LeanPool.BeyondBethe.BeyondBethe.ExecutablePositiveRoutine -import LeanPool.BeyondBethe.BeyondBethe.ExecutableCertificateMagnitude -import LeanPool.BeyondBethe.BeyondBethe.MachineExecutableCertificate -import LeanPool.BeyondBethe.BeyondBethe.MachineExecutablePositiveAlgorithm -import LeanPool.BeyondBethe.BeyondBethe.MachineDyadicFloor -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalFloor -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalLogSeries -import LeanPool.BeyondBethe.BeyondBethe.MachineBoundedUnary -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalExp -import LeanPool.BeyondBethe.BeyondBethe.MachineLengthBits -import LeanPool.BeyondBethe.BeyondBethe.MachineDirectedLog -import LeanPool.BeyondBethe.BeyondBethe.MachineMatrixNonnegative -import LeanPool.BeyondBethe.BeyondBethe.MachineSmallDimension -import LeanPool.BeyondBethe.BeyondBethe.MachineMatrixSum -import LeanPool.BeyondBethe.BeyondBethe.MachineMatrixDimension -import LeanPool.BeyondBethe.BeyondBethe.MachineListIndex -import LeanPool.BeyondBethe.BeyondBethe.MachineListUpdate -import LeanPool.BeyondBethe.BeyondBethe.MachineListReverse -import LeanPool.BeyondBethe.BeyondBethe.MachineBooleanMemory -import LeanPool.BeyondBethe.BeyondBethe.MachineBooleanInit -import LeanPool.BeyondBethe.BeyondBethe.MachineMateMemory -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalMatrixUpdate -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalRowDivide -import LeanPool.BeyondBethe.BeyondBethe.MachineMatrixNormalizeEntries -import LeanPool.BeyondBethe.BeyondBethe.MachineMatrixSupportProduct -import LeanPool.BeyondBethe.BeyondBethe.MachineKuhnEncoding -import LeanPool.BeyondBethe.BeyondBethe.MachineKuhnStep -import LeanPool.BeyondBethe.BeyondBethe.MachineKuhnSemantics -import LeanPool.BeyondBethe.BeyondBethe.MachineKuhnInvariant -import LeanPool.BeyondBethe.BeyondBethe.MachineKuhnRunner -import LeanPool.BeyondBethe.BeyondBethe.MachineMateAllSome -import LeanPool.BeyondBethe.BeyondBethe.MachinePerfectMatching -import LeanPool.BeyondBethe.BeyondBethe.MachineMatrixNormalization -import LeanPool.BeyondBethe.BeyondBethe.MachineFinalScalars -import LeanPool.BeyondBethe.BeyondBethe.MachineRAMBridge -import LeanPool.BeyondBethe.BeyondBethe.MachineBitAssembly -import LeanPool.BeyondBethe.BeyondBethe.MachineTrimHighZeros -import LeanPool.BeyondBethe.BeyondBethe.MachineRAMSmoke -import LeanPool.BeyondBethe.BeyondBethe.BinaryDirectedElementary -import LeanPool.BeyondBethe.BeyondBethe.RationalFeasibility -import LeanPool.BeyondBethe.BeyondBethe.RoundedFeasibility -import LeanPool.BeyondBethe.BeyondBethe.RoundedFeasibilityBitBounds -import LeanPool.BeyondBethe.BeyondBethe.RationalLinearOracle -import LeanPool.BeyondBethe.BeyondBethe.RationalEpigraphOracle -import LeanPool.BeyondBethe.BeyondBethe.BetheEpigraph -import LeanPool.BeyondBethe.BeyondBethe.BetheEpigraphFeasibility -import LeanPool.BeyondBethe.BeyondBethe.StrongEntropy -import LeanPool.BeyondBethe.BeyondBethe.ApproximateKKT -import LeanPool.BeyondBethe.BeyondBethe.BetheEpigraphGeometry -import LeanPool.BeyondBethe.BeyondBethe.BetheThresholdFeasibility -import LeanPool.BeyondBethe.BeyondBethe.BetheBisection -import LeanPool.BeyondBethe.BeyondBethe.ExplicitOptimizerScales -import LeanPool.BeyondBethe.BeyondBethe.ExplicitBetheOptimizer -import LeanPool.BeyondBethe.BeyondBethe.ExplicitPositiveRoutine -import LeanPool.BeyondBethe.BeyondBethe.NumericalWitness -import LeanPool.BeyondBethe.BeyondBethe.FinalAssembly -import LeanPool.BeyondBethe.BeyondBethe.Main + +public import LeanPool.BeyondBethe.BeyondBethe.Permanent +public import LeanPool.BeyondBethe.BeyondBethe.Birkhoff +public import LeanPool.BeyondBethe.BeyondBethe.Entropy +public import LeanPool.BeyondBethe.BeyondBethe.Bethe +public import LeanPool.BeyondBethe.BeyondBethe.Stable +public import LeanPool.BeyondBethe.BeyondBethe.Capacity +public import LeanPool.BeyondBethe.BeyondBethe.CapacityOrder +public import LeanPool.BeyondBethe.BeyondBethe.CapacityScaling +public import LeanPool.BeyondBethe.BeyondBethe.PairedCertificate +public import LeanPool.BeyondBethe.BeyondBethe.PairStability +public import LeanPool.BeyondBethe.BeyondBethe.PairFactorization +public import LeanPool.BeyondBethe.BeyondBethe.ClusterProduct +public import LeanPool.BeyondBethe.BeyondBethe.ClusterFactors +public import LeanPool.BeyondBethe.BeyondBethe.ClusterAlpha +public import LeanPool.BeyondBethe.BeyondBethe.CertificateCapacity +public import LeanPool.BeyondBethe.BeyondBethe.ClusterCertificate +public import LeanPool.BeyondBethe.BeyondBethe.Gibbs +public import LeanPool.BeyondBethe.BeyondBethe.SequentialNormalization +public import LeanPool.BeyondBethe.BeyondBethe.Sequential +public import LeanPool.BeyondBethe.BeyondBethe.Slack +public import LeanPool.BeyondBethe.BeyondBethe.CoreEncoding +public import LeanPool.BeyondBethe.BeyondBethe.Cycles +public import LeanPool.BeyondBethe.BeyondBethe.GoodRowScore +public import LeanPool.BeyondBethe.BeyondBethe.RobustCycle +public import LeanPool.BeyondBethe.BeyondBethe.RowStability +public import LeanPool.BeyondBethe.BeyondBethe.SourceAnariRezaei +public import LeanPool.BeyondBethe.BeyondBethe.SourceAnariRezaeiMerge +public import LeanPool.BeyondBethe.BeyondBethe.SourceAnariRezaeiList +public import LeanPool.BeyondBethe.BeyondBethe.SourceBetheUpper +public import LeanPool.BeyondBethe.BeyondBethe.SourceBetheLower +public import LeanPool.BeyondBethe.BeyondBethe.SourceStableClosure +public import LeanPool.BeyondBethe.BeyondBethe.SourceStableBivariate +public import LeanPool.BeyondBethe.BeyondBethe.SourceStableTable +public import LeanPool.BeyondBethe.BeyondBethe.SourceStableSpecialization +public import LeanPool.BeyondBethe.BeyondBethe.SourceStableSlice +public import LeanPool.BeyondBethe.BeyondBethe.SourceStableInduction +public import LeanPool.BeyondBethe.BeyondBethe.SourceStableEncoding +public import LeanPool.BeyondBethe.BeyondBethe.SourceStableReindex +public import LeanPool.BeyondBethe.BeyondBethe.Transfer +public import LeanPool.BeyondBethe.BeyondBethe.TransferIdentity +public import LeanPool.BeyondBethe.BeyondBethe.Optimizer +public import LeanPool.BeyondBethe.BeyondBethe.CycleTransfer +public import LeanPool.BeyondBethe.BeyondBethe.ExcursionTransfer +public import LeanPool.BeyondBethe.BeyondBethe.Gain +public import LeanPool.BeyondBethe.BeyondBethe.CleanWitness +public import LeanPool.BeyondBethe.BeyondBethe.CleanGain +public import LeanPool.BeyondBethe.BeyondBethe.CleanConstants +public import LeanPool.BeyondBethe.BeyondBethe.Smoothing +public import LeanPool.BeyondBethe.BeyondBethe.Completion +public import LeanPool.BeyondBethe.BeyondBethe.AlgorithmicSpec +public import LeanPool.BeyondBethe.BeyondBethe.PalomarComplexity +public import LeanPool.BeyondBethe.BeyondBethe.DirectedElementary +public import LeanPool.BeyondBethe.BeyondBethe.ExplicitBounds +public import LeanPool.BeyondBethe.BeyondBethe.KuhnMatching +public import LeanPool.BeyondBethe.BeyondBethe.GreedyRowMatching +public import LeanPool.BeyondBethe.BeyondBethe.NearCase +public import LeanPool.BeyondBethe.BeyondBethe.NumericalScales +public import LeanPool.BeyondBethe.BeyondBethe.ExplicitScales +public import LeanPool.BeyondBethe.BeyondBethe.ExecutableCertificate +public import LeanPool.BeyondBethe.BeyondBethe.ExecutableTransfer +public import LeanPool.BeyondBethe.BeyondBethe.DirectedCertificateValue +public import LeanPool.BeyondBethe.BeyondBethe.NumericalNearby +public import LeanPool.BeyondBethe.BeyondBethe.NumericalInterior +public import LeanPool.BeyondBethe.BeyondBethe.NumericalCapacity +public import LeanPool.BeyondBethe.BeyondBethe.NumericalTransfer +public import LeanPool.BeyondBethe.BeyondBethe.NumericalPotentials +public import LeanPool.BeyondBethe.BeyondBethe.NumericalAffine +public import LeanPool.BeyondBethe.BeyondBethe.DirectedOptimizerOracle +public import LeanPool.BeyondBethe.BeyondBethe.WeakSeparation +public import LeanPool.BeyondBethe.BeyondBethe.ExecutableInterior +public import LeanPool.BeyondBethe.BeyondBethe.RationalEllipsoid +public import LeanPool.BeyondBethe.BeyondBethe.DyadicRounding +public import LeanPool.BeyondBethe.BeyondBethe.DyadicMagnitudePrecision +public import LeanPool.BeyondBethe.BeyondBethe.MatrixPerturbation +public import LeanPool.BeyondBethe.BeyondBethe.RoundedEllipsoid +public import LeanPool.BeyondBethe.BeyondBethe.RoundedEllipsoidScales +public import LeanPool.BeyondBethe.BeyondBethe.AdaptiveRoundedEllipsoid +public import LeanPool.BeyondBethe.BeyondBethe.RoundedEllipsoidBitBounds +public import LeanPool.BeyondBethe.BeyondBethe.RoundedEllipsoidIterationBounds +public import LeanPool.BeyondBethe.BeyondBethe.ScheduledRoundedEllipsoid +public import LeanPool.BeyondBethe.BeyondBethe.ScheduledRoundedEllipsoidIteration +public import LeanPool.BeyondBethe.BeyondBethe.ScheduledFeasibility +public import LeanPool.BeyondBethe.BeyondBethe.RationalEncodingBounds +public import LeanPool.BeyondBethe.BeyondBethe.BinaryLongDivision +public import LeanPool.BeyondBethe.BeyondBethe.RawRational +public import LeanPool.BeyondBethe.BeyondBethe.RawRationalBitBounds +public import LeanPool.BeyondBethe.BeyondBethe.BinaryRationalComparison +public import LeanPool.BeyondBethe.BeyondBethe.BinaryRationalFloor +public import LeanPool.BeyondBethe.BeyondBethe.MachineEncoding +public import LeanPool.BeyondBethe.BeyondBethe.MachineFPBasics +public import LeanPool.BeyondBethe.BeyondBethe.MachineBool +public import LeanPool.BeyondBethe.BeyondBethe.MachineBinaryAdd +public import LeanPool.BeyondBethe.BeyondBethe.MachineBinaryAddSemantics +public import LeanPool.BeyondBethe.BeyondBethe.MachineBinaryMul +public import LeanPool.BeyondBethe.BeyondBethe.MachineBinarySub +public import LeanPool.BeyondBethe.BeyondBethe.MachineBinaryCompare +public import LeanPool.BeyondBethe.BeyondBethe.MachineOutputEncoding +public import LeanPool.BeyondBethe.BeyondBethe.MachineBinaryDivision +public import LeanPool.BeyondBethe.BeyondBethe.MachineBinaryGCD +public import LeanPool.BeyondBethe.BeyondBethe.MachineIntegerSignedMagnitude +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalNormalization +public import LeanPool.BeyondBethe.BeyondBethe.MachineIntegerArithmetic +public import LeanPool.BeyondBethe.BeyondBethe.MachineIntegerCompare +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalArithmetic +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalUnary +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalPower +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalCompare +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalMin +public import LeanPool.BeyondBethe.BeyondBethe.MachineFactorial +public import LeanPool.BeyondBethe.BeyondBethe.MachineSmoothingDelta +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalRowAdd +public import LeanPool.BeyondBethe.BeyondBethe.MachineMatrixAddDelta +public import LeanPool.BeyondBethe.BeyondBethe.MachineSmoothedMatrix +public import LeanPool.BeyondBethe.BeyondBethe.MachineCompletedAlgorithm +public import LeanPool.BeyondBethe.BeyondBethe.MachinePositiveAlgorithm +public import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerCertificateBoundary +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalVectorSum +public import LeanPool.BeyondBethe.BeyondBethe.MachineCertificatePotentials +public import LeanPool.BeyondBethe.BeyondBethe.MachineCertificateScales +public import LeanPool.BeyondBethe.BeyondBethe.MachineScheduledLog +public import LeanPool.BeyondBethe.BeyondBethe.MachineNearbyCoordinate +public import LeanPool.BeyondBethe.BeyondBethe.MachineScheduledLogWidth +public import LeanPool.BeyondBethe.BeyondBethe.MachineNearbyMatrixSum +public import LeanPool.BeyondBethe.BeyondBethe.MachineRowComplementUpperSum +public import LeanPool.BeyondBethe.BeyondBethe.MachineDirectedTransferCost +public import LeanPool.BeyondBethe.BeyondBethe.MachineFourCoreCost +public import LeanPool.BeyondBethe.BeyondBethe.MachineCertifiedPairEligibility +public import LeanPool.BeyondBethe.BeyondBethe.MachineRowPairDisjoint +public import LeanPool.BeyondBethe.BeyondBethe.MachineGreedyRowMatching +public import LeanPool.BeyondBethe.BeyondBethe.MachineMatchingGain +public import LeanPool.BeyondBethe.BeyondBethe.MachineCertificateAssembly +public import LeanPool.BeyondBethe.BeyondBethe.CertificateMagnitude +public import LeanPool.BeyondBethe.BeyondBethe.MachineCertificateExpGuard +public import LeanPool.BeyondBethe.BeyondBethe.MachineExplicitCertificate +public import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerEntryLength +public import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerMatrixBitBound +public import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerInteriorScale +public import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerDerivedScales +public import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerBisectionSchedule +public import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerFeasibilitySchedule +public import LeanPool.BeyondBethe.BeyondBethe.ExplicitScheduledFeasibility +public import LeanPool.BeyondBethe.BeyondBethe.ExplicitBetheThresholdFeasibility +public import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerRoundingSchedule +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalBallInit +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalVectorDot +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalVectorL1 +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalEllipsoidScalars +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalNormalizedDirection +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalVectorScale +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalVectorSub +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalEllipsoidCenterUpdate +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalDirectionUpdateRow +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalDirectionUpdateMatrix +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalEllipsoidUpdate +public import LeanPool.BeyondBethe.BeyondBethe.MachineDyadicFloorVector +public import LeanPool.BeyondBethe.BeyondBethe.MachineDyadicFloorMatrix +public import LeanPool.BeyondBethe.BeyondBethe.MachineScheduledRoundedEllipsoid +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalMatrixMulVector +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalMatrixMul +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalMatrixColumn +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalTransposeMulVector +public import LeanPool.BeyondBethe.BeyondBethe.MachineBetheAffineLineSum +public import LeanPool.BeyondBethe.BeyondBethe.MachineBetheAffineEntry +public import LeanPool.BeyondBethe.BeyondBethe.MachineBetheFloorTest +public import LeanPool.BeyondBethe.BeyondBethe.MachineBetheFloorScan +public import LeanPool.BeyondBethe.BeyondBethe.MachineBetheHeightCap +public import LeanPool.BeyondBethe.BeyondBethe.BetheFloorCutFormula +public import LeanPool.BeyondBethe.BeyondBethe.MachineBetheFloorCutEntry +public import LeanPool.BeyondBethe.BeyondBethe.MachineDirectedNegativeObjectiveCoordinate +public import LeanPool.BeyondBethe.BeyondBethe.MachineDirectedNegativeObjectiveSum +public import LeanPool.BeyondBethe.BeyondBethe.MachineDirectedNegativeGradientCoordinate +public import LeanPool.BeyondBethe.BeyondBethe.MachineDirectedNegativeGradientEntry +public import LeanPool.BeyondBethe.BeyondBethe.MachineDirectedAffineGradientEntry +public import LeanPool.BeyondBethe.BeyondBethe.MachineUnaryGridGenerator +public import LeanPool.BeyondBethe.BeyondBethe.MachineDirectedAffineGradientVector +public import LeanPool.BeyondBethe.BeyondBethe.MachineBinaryListSnoc +public import LeanPool.BeyondBethe.BeyondBethe.MachineBinaryListInit +public import LeanPool.BeyondBethe.BeyondBethe.MachineBetheFloorCutVector +public import LeanPool.BeyondBethe.BeyondBethe.MachineBetheHeightNormal +public import LeanPool.BeyondBethe.BeyondBethe.MachineDirectedEpigraphNormal +public import LeanPool.BeyondBethe.BeyondBethe.MachineBetheEpigraphOracle +public import LeanPool.BeyondBethe.BeyondBethe.ScannedBetheThresholdFeasibility +public import LeanPool.BeyondBethe.BeyondBethe.MachineBetheFeasibilityLoop +public import LeanPool.BeyondBethe.BeyondBethe.MachineBetheFeasibilitySemantics +public import LeanPool.BeyondBethe.BeyondBethe.MachineScheduledStateEncodingBound +public import LeanPool.BeyondBethe.BeyondBethe.MachineBetheFeasibilityFit +public import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerStateBound +public import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerFeasibilityCall +public import LeanPool.BeyondBethe.BeyondBethe.ScannedBetheBisection +public import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerBisectionLoop +public import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerBisectionSemantics +public import LeanPool.BeyondBethe.BeyondBethe.ExecutableScannedBetheOptimizer +public import LeanPool.BeyondBethe.BeyondBethe.OptimizerOutputEncoding +public import LeanPool.BeyondBethe.BeyondBethe.MachineUnaryMatrixGenerator +public import LeanPool.BeyondBethe.BeyondBethe.MachineExecutableScannedOptimizerOutput +public import LeanPool.BeyondBethe.BeyondBethe.ExecutablePositiveRoutine +public import LeanPool.BeyondBethe.BeyondBethe.ExecutableCertificateMagnitude +public import LeanPool.BeyondBethe.BeyondBethe.MachineExecutableCertificate +public import LeanPool.BeyondBethe.BeyondBethe.MachineExecutablePositiveAlgorithm +public import LeanPool.BeyondBethe.BeyondBethe.MachineDyadicFloor +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalFloor +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalLogSeries +public import LeanPool.BeyondBethe.BeyondBethe.MachineBoundedUnary +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalExp +public import LeanPool.BeyondBethe.BeyondBethe.MachineLengthBits +public import LeanPool.BeyondBethe.BeyondBethe.MachineDirectedLog +public import LeanPool.BeyondBethe.BeyondBethe.MachineMatrixNonnegative +public import LeanPool.BeyondBethe.BeyondBethe.MachineSmallDimension +public import LeanPool.BeyondBethe.BeyondBethe.MachineMatrixSum +public import LeanPool.BeyondBethe.BeyondBethe.MachineMatrixDimension +public import LeanPool.BeyondBethe.BeyondBethe.MachineListIndex +public import LeanPool.BeyondBethe.BeyondBethe.MachineListUpdate +public import LeanPool.BeyondBethe.BeyondBethe.MachineListReverse +public import LeanPool.BeyondBethe.BeyondBethe.MachineBooleanMemory +public import LeanPool.BeyondBethe.BeyondBethe.MachineBooleanInit +public import LeanPool.BeyondBethe.BeyondBethe.MachineMateMemory +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalMatrixUpdate +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalRowDivide +public import LeanPool.BeyondBethe.BeyondBethe.MachineMatrixNormalizeEntries +public import LeanPool.BeyondBethe.BeyondBethe.MachineMatrixSupportProduct +public import LeanPool.BeyondBethe.BeyondBethe.MachineKuhnEncoding +public import LeanPool.BeyondBethe.BeyondBethe.MachineKuhnStep +public import LeanPool.BeyondBethe.BeyondBethe.MachineKuhnSemantics +public import LeanPool.BeyondBethe.BeyondBethe.MachineKuhnInvariant +public import LeanPool.BeyondBethe.BeyondBethe.MachineKuhnRunner +public import LeanPool.BeyondBethe.BeyondBethe.MachineMateAllSome +public import LeanPool.BeyondBethe.BeyondBethe.MachinePerfectMatching +public import LeanPool.BeyondBethe.BeyondBethe.MachineMatrixNormalization +public import LeanPool.BeyondBethe.BeyondBethe.MachineFinalScalars +public import LeanPool.BeyondBethe.BeyondBethe.MachineRAMBridge +public import LeanPool.BeyondBethe.BeyondBethe.MachineBitAssembly +public import LeanPool.BeyondBethe.BeyondBethe.MachineTrimHighZeros +public import LeanPool.BeyondBethe.BeyondBethe.MachineRAMSmoke +public import LeanPool.BeyondBethe.BeyondBethe.BinaryDirectedElementary +public import LeanPool.BeyondBethe.BeyondBethe.RationalFeasibility +public import LeanPool.BeyondBethe.BeyondBethe.RoundedFeasibility +public import LeanPool.BeyondBethe.BeyondBethe.RoundedFeasibilityBitBounds +public import LeanPool.BeyondBethe.BeyondBethe.RationalLinearOracle +public import LeanPool.BeyondBethe.BeyondBethe.RationalEpigraphOracle +public import LeanPool.BeyondBethe.BeyondBethe.BetheEpigraph +public import LeanPool.BeyondBethe.BeyondBethe.BetheEpigraphFeasibility +public import LeanPool.BeyondBethe.BeyondBethe.StrongEntropy +public import LeanPool.BeyondBethe.BeyondBethe.ApproximateKKT +public import LeanPool.BeyondBethe.BeyondBethe.BetheEpigraphGeometry +public import LeanPool.BeyondBethe.BeyondBethe.BetheThresholdFeasibility +public import LeanPool.BeyondBethe.BeyondBethe.BetheBisection +public import LeanPool.BeyondBethe.BeyondBethe.ExplicitOptimizerScales +public import LeanPool.BeyondBethe.BeyondBethe.ExplicitBetheOptimizer +public import LeanPool.BeyondBethe.BeyondBethe.ExplicitPositiveRoutine +public import LeanPool.BeyondBethe.BeyondBethe.NumericalWitness +public import LeanPool.BeyondBethe.BeyondBethe.FinalAssembly +public import LeanPool.BeyondBethe.BeyondBethe.Main /-! # Beyond Bethe -/ + +@[expose] public section diff --git a/LeanPool/BeyondBethe/BeyondBethe/AdaptiveRoundedEllipsoid.lean b/LeanPool/BeyondBethe/BeyondBethe/AdaptiveRoundedEllipsoid.lean index 12f43ccecd..0ffb17d7b2 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/AdaptiveRoundedEllipsoid.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/AdaptiveRoundedEllipsoid.lean @@ -3,12 +3,16 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.RoundedEllipsoidScales -import Mathlib.Tactic + +public import LeanPool.BeyondBethe.BeyondBethe.RoundedEllipsoidScales +public import Mathlib.Tactic /-! # Adaptive Rounded Ellipsoid -/ +@[expose] public section + open scoped BigOperators namespace BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/AlgorithmicSpec.lean b/LeanPool/BeyondBethe/BeyondBethe/AlgorithmicSpec.lean index fadbd1681d..9c4d936634 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/AlgorithmicSpec.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/AlgorithmicSpec.lean @@ -3,16 +3,20 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.Completion -import LeanPool.BeyondBethe.Complexitylib.Classes.P -import LeanPool.BeyondBethe.Complexitylib.Encoding.DataEncode -import LeanPool.BeyondBethe.Complexitylib.Encoding.Pairing -import Mathlib.Data.List.OfFn -import Mathlib.Data.Nat.Pairing + +public import LeanPool.BeyondBethe.BeyondBethe.Completion +public import LeanPool.BeyondBethe.Complexitylib.Classes.P +public import LeanPool.BeyondBethe.Complexitylib.Encoding.DataEncode +public import LeanPool.BeyondBethe.Complexitylib.Encoding.Pairing +public import Mathlib.Data.List.OfFn +public import Mathlib.Data.Nat.Pairing /-! # Algorithmic Spec -/ +@[expose] public section + namespace BeyondBethe open Complexity @@ -90,6 +94,8 @@ instance rationalMatrixInputDataEncode : DataEncode RationalMatrixInput where /-- An explicit injective binary code. We retain injectivity in the structure so no later complexity statement can silently identify distinct typed inputs. -/ structure OrdinaryBinaryEncoding (α : Type*) where + /-- The finite binary word representing a value; injectivity is required by the encoding + structure. -/ encode : α → List Bool injective : Function.Injective encode diff --git a/LeanPool/BeyondBethe/BeyondBethe/ApproximateKKT.lean b/LeanPool/BeyondBethe/BeyondBethe/ApproximateKKT.lean index fcb0d67fd3..e80f246990 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/ApproximateKKT.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/ApproximateKKT.lean @@ -3,14 +3,18 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.StrongEntropy -import LeanPool.BeyondBethe.BeyondBethe.ExplicitBounds -import LeanPool.BeyondBethe.BeyondBethe.NumericalPotentials -import Mathlib.Tactic + +public import LeanPool.BeyondBethe.BeyondBethe.StrongEntropy +public import LeanPool.BeyondBethe.BeyondBethe.ExplicitBounds +public import LeanPool.BeyondBethe.BeyondBethe.NumericalPotentials +public import Mathlib.Tactic /-! # Approximate KKT -/ +@[expose] public section + open scoped BigOperators namespace BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/AxiomAudit.lean b/LeanPool/BeyondBethe/BeyondBethe/AxiomAudit.lean index 7daf097a0b..0f764e9890 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/AxiomAudit.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/AxiomAudit.lean @@ -3,8 +3,12 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe -import LeanPool.BeyondBethe.Solution + +public import LeanPool.BeyondBethe.BeyondBethe +public import LeanPool.BeyondBethe.Solution /-! # Axiom Audit -/ + +@[expose] public section diff --git a/LeanPool/BeyondBethe/BeyondBethe/Bethe.lean b/LeanPool/BeyondBethe/BeyondBethe/Bethe.lean index 347a926851..c2e6556884 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/Bethe.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/Bethe.lean @@ -3,18 +3,23 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.Birkhoff -import LeanPool.BeyondBethe.BeyondBethe.Entropy -import Mathlib.Analysis.Convex.Function -import Mathlib.Tactic + +public import LeanPool.BeyondBethe.BeyondBethe.Birkhoff +public import LeanPool.BeyondBethe.BeyondBethe.Entropy +public import Mathlib.Analysis.Convex.Function +public import Mathlib.Tactic /-! # Bethe -/ +@[expose] public section + open scoped BigOperators namespace BeyondBethe +/-- Every entry of the matrix is strictly positive. -/ def Matrix.Positive {m n : Type*} (A : Matrix m n ℝ) : Prop := ∀ i j, 0 < A i j @@ -35,6 +40,8 @@ noncomputable def betheRowObjective (X i j * Real.log (A i j) + Real.negMulLog (X i j) + (1 - X i j) * Real.log (1 - X i j)) +/-- The Bethe objective, summed over all rows and columns with the matrix weights and entropy +terms. -/ noncomputable def betheObjective {n : Type*} [Fintype n] (A X : Matrix n n ℝ) : ℝ := by classical diff --git a/LeanPool/BeyondBethe/BeyondBethe/BetheBisection.lean b/LeanPool/BeyondBethe/BeyondBethe/BetheBisection.lean index ae20f30b7c..dbadf6a352 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/BetheBisection.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/BetheBisection.lean @@ -3,12 +3,16 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.BetheThresholdFeasibility -import Mathlib.Tactic + +public import LeanPool.BeyondBethe.BeyondBethe.BetheThresholdFeasibility +public import Mathlib.Tactic /-! # Bethe Bisection -/ +@[expose] public section + namespace BeyondBethe /-! @@ -21,18 +25,24 @@ uses the proved implication that exhaustion can occur only below the exact optimum plus the explicit smoothing slack. -/ +/-- The initial lower threshold `-2 * (m + 1)^2` for the negative Bethe objective. -/ def betheNegativeObjectiveLower (m : ℕ) : ℚ := -(2 * (m + 1) ^ 2) +/-- The negative-objective upper threshold obtained from the dimension and matrix entry bit +bound. -/ def betheNegativeObjectiveUpper {m : ℕ} (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) : ℚ := (m + 1) * rationalMatrixEntryBitBound A + (m + 1) +/-- The smoothing allowance: the mixing weight times the objective range, plus twice the inner +radius. -/ def betheSmoothingSlack {m : ℕ} (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) (mix r : ℚ) : ℚ := mix * rationalRegularizedObjectiveRange A + 2 * r +/-- The initial upper bisection threshold, including the smoothing allowance. -/ def betheBisectionInitialHigh {m : ℕ} (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) (mix r : ℚ) : ℚ := @@ -57,8 +67,11 @@ theorem negativeObjective_mem_initial_interval /-- Executable state of the rational bisection. -/ structure BetheBisectionState (d : ℕ) where + /-- The current lower objective threshold of the bisection interval. -/ low : ℚ + /-- The current upper objective threshold of the bisection interval. -/ high : ℚ + /-- The stored accepted feasibility point, if one has been found. -/ witness : Option (Fin d → ℚ) /-- One bisection step. -/ diff --git a/LeanPool/BeyondBethe/BeyondBethe/BetheEpigraph.lean b/LeanPool/BeyondBethe/BeyondBethe/BetheEpigraph.lean index 0473e2e7d2..6fabf0ec6d 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/BetheEpigraph.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/BetheEpigraph.lean @@ -3,13 +3,17 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.RationalEpigraphOracle -import LeanPool.BeyondBethe.BeyondBethe.WeakSeparation -import Mathlib.Tactic + +public import LeanPool.BeyondBethe.BeyondBethe.RationalEpigraphOracle +public import LeanPool.BeyondBethe.BeyondBethe.WeakSeparation +public import Mathlib.Tactic /-! # Bethe Epigraph -/ +@[expose] public section + open scoped BigOperators namespace BeyondBethe @@ -22,12 +26,14 @@ rational coordinates. This file connects the already certified directed objective and gradient evaluations to the generic rational epigraph oracle. -/ +/-- Flatten a square matrix using the finite product equivalence on its row and column indices. -/ def squareMatrixToVector {m : ℕ} {R : Type*} (Y : Matrix (Fin m) (Fin m) R) : Fin (m * m) → R := fun k ↦ let ij := finProdFinEquiv.symm k Y ij.1 ij.2 +/-- Recover a square matrix from its vector of entries using the finite product equivalence. -/ def vectorToSquareMatrix {m : ℕ} {R : Type*} (y : Fin (m * m) → R) : Matrix (Fin m) (Fin m) R := fun i j ↦ y (finProdFinEquiv (i, j)) @@ -392,6 +398,8 @@ theorem mem_fullMatrixEntryList (m : ℕ) (i j : Fin (m + 1)) : rw [List.mem_map] exact ⟨j, (List.mem_ofFn).2 ⟨j, rfl⟩, rfl⟩ +/-- Scan the supplied entry list for the first affine matrix coordinate strictly below the +floor. -/ def firstBetheFloorViolation {m : ℕ} (δ : ℚ) (y : Fin (m * m) → ℚ) : List (Fin (m + 1) × Fin (m + 1)) → @@ -401,6 +409,7 @@ def firstBetheFloorViolation {m : ℕ} (δ : ℚ) if betheAffineMatrixQ y ij.1 ij.2 < δ then some ij else firstBetheFloorViolation δ y entries +/-- Search every matrix entry for a violation of the prescribed affine-coordinate floor. -/ def firstBetheFloorViolationAll {m : ℕ} (δ : ℚ) (y : Fin (m * m) → ℚ) : Option (Fin (m + 1) × Fin (m + 1)) := firstBetheFloorViolation δ y (fullMatrixEntryList m) diff --git a/LeanPool/BeyondBethe/BeyondBethe/BetheEpigraphFeasibility.lean b/LeanPool/BeyondBethe/BeyondBethe/BetheEpigraphFeasibility.lean index b5535b56c0..5463427925 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/BetheEpigraphFeasibility.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/BetheEpigraphFeasibility.lean @@ -3,12 +3,16 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.BetheEpigraph -import Mathlib.Tactic + +public import LeanPool.BeyondBethe.BeyondBethe.BetheEpigraph +public import Mathlib.Tactic /-! # Bethe Epigraph Feasibility -/ +@[expose] public section + open scoped BigOperators namespace BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/BetheEpigraphGeometry.lean b/LeanPool/BeyondBethe/BeyondBethe/BetheEpigraphGeometry.lean index d630b10cf9..19bab98e27 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/BetheEpigraphGeometry.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/BetheEpigraphGeometry.lean @@ -3,14 +3,18 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.BetheEpigraphFeasibility -import LeanPool.BeyondBethe.BeyondBethe.ExecutableInterior -import LeanPool.BeyondBethe.BeyondBethe.ApproximateKKT -import Mathlib.Tactic + +public import LeanPool.BeyondBethe.BeyondBethe.BetheEpigraphFeasibility +public import LeanPool.BeyondBethe.BeyondBethe.ExecutableInterior +public import LeanPool.BeyondBethe.BeyondBethe.ApproximateKKT +public import Mathlib.Tactic /-! # Bethe Epigraph Geometry -/ +@[expose] public section + open scoped BigOperators namespace BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/BetheFloorCutFormula.lean b/LeanPool/BeyondBethe/BeyondBethe/BetheFloorCutFormula.lean index 58cdbbb982..423b21a725 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/BetheFloorCutFormula.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/BetheFloorCutFormula.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.BetheEpigraph + +public import LeanPool.BeyondBethe.BeyondBethe.BetheEpigraph /-! # Coordinate formula for Bethe floor-cut normals @@ -15,6 +17,8 @@ block. This file proves that direct formula equal to `betheFloorCutNormal`, separately from any encoding or iteration argument. -/ +@[expose] public section + namespace BeyondBethe /-- Base-coordinate coefficient of the lower-floor cut at recovered entry diff --git a/LeanPool/BeyondBethe/BeyondBethe/BetheThresholdFeasibility.lean b/LeanPool/BeyondBethe/BeyondBethe/BetheThresholdFeasibility.lean index ae40ba33ce..d08393b356 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/BetheThresholdFeasibility.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/BetheThresholdFeasibility.lean @@ -3,13 +3,17 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.BetheEpigraphGeometry -import LeanPool.BeyondBethe.BeyondBethe.ScheduledFeasibility -import Mathlib.Tactic + +public import LeanPool.BeyondBethe.BeyondBethe.BetheEpigraphGeometry +public import LeanPool.BeyondBethe.BeyondBethe.ScheduledFeasibility +public import Mathlib.Tactic /-! # Bethe Threshold Feasibility -/ +@[expose] public section + namespace BeyondBethe /-! diff --git a/LeanPool/BeyondBethe/BeyondBethe/BinaryDirectedElementary.lean b/LeanPool/BeyondBethe/BeyondBethe/BinaryDirectedElementary.lean index cfb92008a7..b1141ca77b 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/BinaryDirectedElementary.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/BinaryDirectedElementary.lean @@ -3,14 +3,18 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.BinaryRationalFloor -import LeanPool.BeyondBethe.BeyondBethe.BinaryRationalComparison -import LeanPool.BeyondBethe.BeyondBethe.DirectedElementary -import Mathlib.Tactic + +public import LeanPool.BeyondBethe.BeyondBethe.BinaryRationalFloor +public import LeanPool.BeyondBethe.BeyondBethe.BinaryRationalComparison +public import LeanPool.BeyondBethe.BeyondBethe.DirectedElementary +public import Mathlib.Tactic /-! # Binary Directed Elementary -/ +@[expose] public section + namespace BeyondBethe /-! @@ -41,6 +45,8 @@ theorem binaryRationalLogSeriesSum_eq (x : ℚ) : ∀ N : ℕ, binaryRatDiv_eq_div, binaryRatPow_eq_pow, ih, Finset.sum_range_succ] +/-- Twice the first `N` odd terms of the rational logarithm series, evaluated with binary +arithmetic. -/ def binaryRationalLogSeries (x : ℚ) (N : ℕ) : ℚ := binaryRatMul 2 (binaryRationalLogSeriesSum x N) @@ -49,6 +55,7 @@ theorem binaryRationalLogSeries_eq (x : ℚ) (N : ℕ) : rw [binaryRationalLogSeries, rationalLogSeries, binaryRatMul_eq_mul, binaryRationalLogSeriesSum_eq] +/-- The rational remainder expression `2 * x^(2*N+1) / (1-x^2)` for the logarithm series. -/ def binaryRationalLogSeriesError (x : ℚ) (N : ℕ) : ℚ := binaryRatMul 2 (binaryRatDiv (binaryRatPow x (2 * N + 1)) @@ -60,6 +67,7 @@ theorem binaryRationalLogSeriesError_eq (x : ℚ) (N : ℕ) : binaryRatMul_eq_mul, binaryRatDiv_eq_div, binaryRatSub_eq_sub, binaryRatPow_eq_pow] +/-- The logarithm-series substitution `(y-1)/(y+1)`, computed with binary rational arithmetic. -/ def binaryRationalLogUnitParameter (y : ℚ) : ℚ := binaryRatDiv (binaryRatSub y 1) (binaryRatAdd y 1) @@ -68,6 +76,8 @@ theorem binaryRationalLogUnitParameter_eq (y : ℚ) : simp [binaryRationalLogUnitParameter, rationalLogUnitParameter, binaryRatDiv_eq_div, binaryRatSub_eq_sub, binaryRatAdd_eq_add] +/-- The lower unit-logarithm approximation obtained by evaluating the truncated odd-power +series. -/ def binaryDirectedLogUnitLower (y : ℚ) (N : ℕ) : ℚ := binaryRationalLogSeries (binaryRationalLogUnitParameter y) N @@ -76,6 +86,7 @@ theorem binaryDirectedLogUnitLower_eq (y : ℚ) (N : ℕ) : simp [binaryDirectedLogUnitLower, directedLogUnitLower, binaryRationalLogSeries_eq, binaryRationalLogUnitParameter_eq] +/-- The upper unit-logarithm approximation obtained by adding the series remainder expression. -/ def binaryDirectedLogUnitUpper (y : ℚ) (N : ℕ) : ℚ := binaryRatAdd (binaryRationalLogSeries (binaryRationalLogUnitParameter y) N) @@ -99,6 +110,8 @@ theorem binaryNatLog2_eq_log_two (n : ℕ) : rw [binaryNatLog2, hsize] omega +/-- The power-of-two scale determined by the binary logarithms of the absolute numerator and +denominator. -/ def binaryRationalBinaryScale (q : ℚ) : ℚ := binaryRatDiv (binaryRatPow 2 (binaryNatLog2 q.num.natAbs)) @@ -119,6 +132,7 @@ theorem binaryRationalBinaryExponent_eq (q : ℚ) : simp [binaryRationalBinaryExponent, rationalBinaryExponent, binaryNatLog2_eq_log_two] +/-- The rational input divided by its power-of-two scale. -/ def binaryRationalBinaryResidual (q : ℚ) : ℚ := binaryRatDiv q (binaryRationalBinaryScale q) @@ -127,6 +141,7 @@ theorem binaryRationalBinaryResidual_eq (q : ℚ) : simp [binaryRationalBinaryResidual, rationalBinaryResidual, binaryRatDiv_eq_div, binaryRationalBinaryScale_eq] +/-- The binary residual used for logarithm approximation, inverted when it is below one. -/ def binaryRationalLogUnit (q : ℚ) : ℚ := if binaryRatLt (binaryRationalBinaryResidual q) 1 then binaryRatInv (binaryRationalBinaryResidual q) @@ -139,6 +154,7 @@ theorem binaryRationalLogUnit_eq (q : ℚ) : binaryRationalBinaryResidual_eq, binaryRatInv_eq_inv, binaryRatLt_eq_true_iff] +/-- The lower endpoint for multiplication of an interval by an integer, accounting for its sign. -/ def binaryDirectedIntMulLower (k : ℤ) (lo hi : ℚ) : ℚ := if 0 ≤ k then binaryRatMul k lo else binaryRatMul k hi @@ -147,6 +163,7 @@ theorem binaryDirectedIntMulLower_eq (k : ℤ) (lo hi : ℚ) : simp [binaryDirectedIntMulLower, directedIntMulLower, binaryRatMul_eq_mul] +/-- The upper endpoint for multiplication of an interval by an integer, accounting for its sign. -/ def binaryDirectedIntMulUpper (k : ℤ) (lo hi : ℚ) : ℚ := if 0 ≤ k then binaryRatMul k hi else binaryRatMul k lo @@ -176,6 +193,8 @@ theorem binaryDirectedLogLower_eq (q : ℚ) (N : ℕ) : binaryRatAdd_eq_add, binaryRationalBinaryExponent_eq, binaryRatLt_eq_true_iff] +/-- The upper logarithm approximation combining the binary exponent contribution with the +residual contribution. -/ def binaryDirectedLogUpper (q : ℚ) (N : ℕ) : ℚ := let kPart := binaryDirectedIntMulUpper (binaryRationalBinaryExponent q) (binaryDirectedLogUnitLower 2 N) (binaryDirectedLogUnitUpper 2 N) @@ -204,6 +223,7 @@ theorem binaryRationalCeilNat_eq (t : ℚ) : binaryRationalCeilNat t = rationalCeilNat t := by rw [binaryRationalCeilNat, rationalCeilNat, binaryRatCeil_eq_ceil] +/-- The odd step count `2 * ceil(t + t^2/loss) + 1` used in the exponential approximation. -/ def binaryRationalExpApproxSteps (t loss : ℚ) : ℕ := 2 * binaryRationalCeilNat (binaryRatAdd t (binaryRatDiv (binaryRatPow t 2) loss)) + 1 @@ -215,6 +235,7 @@ theorem binaryRationalExpApproxSteps_eq (t loss : ℚ) : binaryRationalCeilNat_eq, binaryRatAdd_eq_add, binaryRatDiv_eq_div, binaryRatPow_eq_pow] +/-- The binomial expression `(1-t/M)^M` used to approximate `exp(-t)` from below. -/ def binaryRationalNegativeExpLower (t loss : ℚ) : ℚ := let M := binaryRationalExpApproxSteps t loss binaryRatPow @@ -227,6 +248,7 @@ theorem binaryRationalNegativeExpLower_eq (t loss : ℚ) : binaryRationalExpApproxSteps_eq, binaryRatPow_eq_pow, binaryRatSub_eq_sub, binaryRatDiv_eq_div] +/-- The binomial expression `(1+t/M)^M` used to approximate `exp(t)` from below. -/ def binaryRationalPositiveExpLower (t loss : ℚ) : ℚ := let M := binaryRationalExpApproxSteps t loss binaryRatPow @@ -239,6 +261,8 @@ theorem binaryRationalPositiveExpLower_eq (t loss : ℚ) : binaryRationalExpApproxSteps_eq, binaryRatPow_eq_pow, binaryRatAdd_eq_add, binaryRatDiv_eq_div] +/-- Select the positive- or negative-exponent binomial approximation according to the sign of +the input. -/ def binaryRationalExpLower (s loss : ℚ) : ℚ := if binaryRatNonnegative s then binaryRationalPositiveExpLower s loss else binaryRationalNegativeExpLower (binaryRatNeg s) loss diff --git a/LeanPool/BeyondBethe/BeyondBethe/BinaryLongDivision.lean b/LeanPool/BeyondBethe/BeyondBethe/BinaryLongDivision.lean index 8a52a8ba16..4f87ff449f 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/BinaryLongDivision.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/BinaryLongDivision.lean @@ -3,12 +3,16 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.Complexitylib.Mathlib.NatBits -import Mathlib.Tactic + +public import LeanPool.BeyondBethe.Complexitylib.Mathlib.NatBits +public import Mathlib.Tactic /-! # Binary Long Division -/ +@[expose] public section + namespace BeyondBethe /-! diff --git a/LeanPool/BeyondBethe/BeyondBethe/BinaryRationalComparison.lean b/LeanPool/BeyondBethe/BeyondBethe/BinaryRationalComparison.lean index 864157b053..2d97ab4bde 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/BinaryRationalComparison.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/BinaryRationalComparison.lean @@ -3,12 +3,16 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.RawRationalBitBounds -import Mathlib.Tactic + +public import LeanPool.BeyondBethe.BeyondBethe.RawRationalBitBounds +public import Mathlib.Tactic /-! # Binary Rational Comparison -/ +@[expose] public section + namespace BeyondBethe /-! diff --git a/LeanPool/BeyondBethe/BeyondBethe/BinaryRationalFloor.lean b/LeanPool/BeyondBethe/BeyondBethe/BinaryRationalFloor.lean index bb5754f8e3..1169bcbfbf 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/BinaryRationalFloor.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/BinaryRationalFloor.lean @@ -3,13 +3,17 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.RawRationalBitBounds -import LeanPool.BeyondBethe.BeyondBethe.DyadicRounding -import Mathlib.Tactic + +public import LeanPool.BeyondBethe.BeyondBethe.RawRationalBitBounds +public import LeanPool.BeyondBethe.BeyondBethe.DyadicRounding +public import Mathlib.Tactic /-! # Binary Rational Floor -/ +@[expose] public section + namespace BeyondBethe /-! diff --git a/LeanPool/BeyondBethe/BeyondBethe/Birkhoff.lean b/LeanPool/BeyondBethe/BeyondBethe/Birkhoff.lean index 1f8726295c..9d2b7f4578 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/Birkhoff.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/Birkhoff.lean @@ -3,12 +3,16 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.Permanent -import Mathlib.Tactic + +public import LeanPool.BeyondBethe.BeyondBethe.Permanent +public import Mathlib.Tactic /-! # Birkhoff -/ +@[expose] public section + open scoped BigOperators namespace BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/Capacity.lean b/LeanPool/BeyondBethe/BeyondBethe/Capacity.lean index 7219da3bce..98f352e551 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/Capacity.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/Capacity.lean @@ -3,13 +3,17 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.CapacityOrder -import LeanPool.BeyondBethe.BeyondBethe.Entropy -import Mathlib.Tactic + +public import LeanPool.BeyondBethe.BeyondBethe.CapacityOrder +public import LeanPool.BeyondBethe.BeyondBethe.Entropy +public import Mathlib.Tactic /-! # Capacity -/ +@[expose] public section + open scoped BigOperators namespace BeyondBethe @@ -250,10 +254,12 @@ theorem entropyCapacityCertificate_le_log_finitePolynomialCapacity rw [Real.log_exp] at hlog exact hlog +/-- The coefficient of a monomial indexed by an element of the polynomial support. -/ noncomputable def supportCoefficient {σ : Type*} (p : MvPolynomial σ ℝ) (d : p.support) : ℝ := p.coeff d +/-- The exponent of coordinate `j` in a supported monomial. -/ def supportExponent {σ : Type*} (p : MvPolynomial σ ℝ) (d : p.support) (j : σ) : ℕ := d.1 j diff --git a/LeanPool/BeyondBethe/BeyondBethe/CapacityOrder.lean b/LeanPool/BeyondBethe/BeyondBethe/CapacityOrder.lean index 9499a6f6c0..25784c27b6 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/CapacityOrder.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/CapacityOrder.lean @@ -3,12 +3,16 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.Stable -import Mathlib.Tactic + +public import LeanPool.BeyondBethe.BeyondBethe.Stable +public import Mathlib.Tactic /-! # Capacity Order -/ +@[expose] public section + open scoped BigOperators namespace BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/CapacityScaling.lean b/LeanPool/BeyondBethe/BeyondBethe/CapacityScaling.lean index 5aaa0a199b..31df624cab 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/CapacityScaling.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/CapacityScaling.lean @@ -3,12 +3,16 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.CapacityOrder -import Mathlib.Tactic + +public import LeanPool.BeyondBethe.BeyondBethe.CapacityOrder +public import Mathlib.Tactic /-! # Capacity Scaling -/ +@[expose] public section + open scoped BigOperators namespace BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/CertificateCapacity.lean b/LeanPool/BeyondBethe/BeyondBethe/CertificateCapacity.lean index f9cd59b9af..f4b24af4f9 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/CertificateCapacity.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/CertificateCapacity.lean @@ -3,19 +3,24 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.ClusterFactors -import LeanPool.BeyondBethe.BeyondBethe.CapacityOrder -import Mathlib.Analysis.MeanInequalities + +public import LeanPool.BeyondBethe.BeyondBethe.ClusterFactors +public import LeanPool.BeyondBethe.BeyondBethe.CapacityOrder +public import Mathlib.Analysis.MeanInequalities /-! # Certificate Capacity -/ +@[expose] public section + open scoped BigOperators namespace BeyondBethe open MvPolynomial +/-- The product formula `∏ i, (u i / α i)^(α i)` for linear capacity. -/ noncomputable def linearCapacityValue {ι : Type*} [Fintype ι] (u α : ι → ℝ) : ℝ := @@ -118,6 +123,8 @@ theorem linearCapacityValue_eq_capacity rw [heval, hmono, one_div, inv_inv] at hupper exact hupper +/-- The product of the unit-coefficient linear capacity expressions, one for each selector +coordinate. -/ noncomputable def selectorCapacityValue {κ ι : Type*} [Fintype κ] [Fintype ι] (α : κ × ι → ℝ) : ℝ := @@ -194,6 +201,8 @@ theorem selectorCapacityValue_le_capacity intro z hz exact selectorCapacityValue_le_ratio hα hαcol hz +/-- The product of the capacities of the cluster injection polynomials at the prescribed +exponents. -/ noncomputable def clusterProductCapacityValue {n : ℕ} (A : Matrix (Fin n) (Fin n) ℝ) (C : RowClustering n) (α : C.Cluster × Fin n → ℝ) : ℝ := diff --git a/LeanPool/BeyondBethe/BeyondBethe/CertificateMagnitude.lean b/LeanPool/BeyondBethe/BeyondBethe/CertificateMagnitude.lean index 332e195a0a..31ce27c716 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/CertificateMagnitude.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/CertificateMagnitude.lean @@ -3,15 +3,19 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.ExplicitBetheOptimizer -import LeanPool.BeyondBethe.BeyondBethe.MachineMatrixDimension -import LeanPool.BeyondBethe.BeyondBethe.RationalEncodingBounds -import LeanPool.BeyondBethe.BeyondBethe.SourceStableReindex -import Mathlib.Tactic + +public import LeanPool.BeyondBethe.BeyondBethe.ExplicitBetheOptimizer +public import LeanPool.BeyondBethe.BeyondBethe.MachineMatrixDimension +public import LeanPool.BeyondBethe.BeyondBethe.RationalEncodingBounds +public import LeanPool.BeyondBethe.BeyondBethe.SourceStableReindex +public import Mathlib.Tactic /-! # Certificate Magnitude -/ +@[expose] public section + open scoped BigOperators namespace BeyondBethe @@ -29,13 +33,16 @@ the optimizer's rational arithmetic: the certified permanent sandwich and the elementary input-size bounds on the permanent already give both sides. -/ +/-- The certificate magnitude budget `n * (entryBitBound + n + 1)` for a rational matrix. -/ def explicitCertificateMagnitudeBudget {n : ℕ} (B : Matrix (Fin n) (Fin n) ℚ) : ℕ := n * (rationalMatrixEntryBitBound B + n + 1) +/-- The sum of the encoded bit lengths of the rational entries in a list. -/ def rationalListDataCost (xs : List ℚ) : ℕ := (xs.map fun q ↦ encodedBitLength ℚ q).sum +/-- The total encoded bit length of all rational entries in a list of rows. -/ def rationalRowsDataCost (rows : List (List ℚ)) : ℕ := (rows.map rationalListDataCost).sum diff --git a/LeanPool/BeyondBethe/BeyondBethe/CertifiedPairWeights.lean b/LeanPool/BeyondBethe/BeyondBethe/CertifiedPairWeights.lean index a45ac3d4e1..b0cb27797d 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/CertifiedPairWeights.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/CertifiedPairWeights.lean @@ -3,13 +3,17 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.DirectedPairCost -import LeanPool.BeyondBethe.BeyondBethe.GreedyRowMatching -import Mathlib.Tactic + +public import LeanPool.BeyondBethe.BeyondBethe.DirectedPairCost +public import LeanPool.BeyondBethe.BeyondBethe.GreedyRowMatching +public import Mathlib.Tactic /-! # Certified Pair Weights -/ +@[expose] public section + namespace BeyondBethe /-! diff --git a/LeanPool/BeyondBethe/BeyondBethe/CleanConstants.lean b/LeanPool/BeyondBethe/BeyondBethe/CleanConstants.lean index 431afaff94..c39512dc09 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/CleanConstants.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/CleanConstants.lean @@ -3,12 +3,16 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.CleanGain -import Mathlib.Tactic + +public import LeanPool.BeyondBethe.BeyondBethe.CleanGain +public import Mathlib.Tactic /-! # Clean Constants -/ +@[expose] public section + open scoped BigOperators Topology namespace BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/CleanGain.lean b/LeanPool/BeyondBethe/BeyondBethe/CleanGain.lean index f28df14867..a15ab9a084 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/CleanGain.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/CleanGain.lean @@ -3,13 +3,17 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.CleanWitness -import LeanPool.BeyondBethe.BeyondBethe.PairFactorization -import Mathlib.Tactic + +public import LeanPool.BeyondBethe.BeyondBethe.CleanWitness +public import LeanPool.BeyondBethe.BeyondBethe.PairFactorization +public import Mathlib.Tactic /-! # Clean Gain -/ +@[expose] public section + open scoped BigOperators namespace BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/CleanWitness.lean b/LeanPool/BeyondBethe/BeyondBethe/CleanWitness.lean index 6ec5cda11b..6df2d927a4 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/CleanWitness.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/CleanWitness.lean @@ -3,21 +3,27 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.Gain -import LeanPool.BeyondBethe.BeyondBethe.PairedCertificate -import Mathlib.Tactic + +public import LeanPool.BeyondBethe.BeyondBethe.Gain +public import LeanPool.BeyondBethe.BeyondBethe.PairedCertificate +public import Mathlib.Tactic /-! # Clean Witness -/ +@[expose] public section + open scoped BigOperators namespace BeyondBethe +/-- All column indices except the two distinguished columns. -/ def outsideColumnFinset {ι : Type*} [Fintype ι] [DecidableEq ι] (a b : ι) : Finset ι := (Finset.univ.erase a).erase b +/-- The subtype of columns outside the two distinguished columns. -/ abbrev OutsideColumn {ι : Type*} [Fintype ι] [DecidableEq ι] (a b : ι) := {j // j ∈ outsideColumnFinset a b} @@ -61,6 +67,8 @@ theorem pairAlpha_coreDeficit_pos exact ⟨sub_pos.mpr (pairAlpha_lt_one_of_positive hX hXpos hcard hrs a), sub_pos.mpr (pairAlpha_lt_one_of_positive hX hXpos hcard hrs b)⟩ +/-- The coordinate indicator of the endpoint pair associated to each clean capacity-witness +edge. -/ noncomputable def cleanWitnessExponent {ι : Type*} [Fintype ι] [DecidableEq ι] (a b : ι) : CapacityWitnessEdge (OutsideColumn a b) → ι → ℕ @@ -117,6 +125,7 @@ noncomputable def cleanWitnessCoefficient let p := cleanWitnessEndpoints a b e u p.1 * v p.2 + u p.2 * v p.1 +/-- The weighted sum of the logarithms of the coefficients. -/ noncomputable def expectedLogCoefficient {κ : Type*} [Fintype κ] (θ c : κ → ℝ) : ℝ := ∑ e, θ e * Real.log (c e) diff --git a/LeanPool/BeyondBethe/BeyondBethe/ClusterAlpha.lean b/LeanPool/BeyondBethe/BeyondBethe/ClusterAlpha.lean index 31bc2fced8..ee07ee0ad8 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/ClusterAlpha.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/ClusterAlpha.lean @@ -3,13 +3,17 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.ClusterFactors -import LeanPool.BeyondBethe.BeyondBethe.Birkhoff -import Mathlib.Tactic + +public import LeanPool.BeyondBethe.BeyondBethe.ClusterFactors +public import LeanPool.BeyondBethe.BeyondBethe.Birkhoff +public import Mathlib.Tactic /-! # Cluster Alpha -/ +@[expose] public section + open scoped BigOperators namespace BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/ClusterCertificate.lean b/LeanPool/BeyondBethe/BeyondBethe/ClusterCertificate.lean index 6b7abd01a1..075f3b3e8d 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/ClusterCertificate.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/ClusterCertificate.lean @@ -3,14 +3,18 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.CertificateCapacity -import LeanPool.BeyondBethe.BeyondBethe.ClusterAlpha -import LeanPool.BeyondBethe.BeyondBethe.Bethe -import Mathlib.Tactic + +public import LeanPool.BeyondBethe.BeyondBethe.CertificateCapacity +public import LeanPool.BeyondBethe.BeyondBethe.ClusterAlpha +public import LeanPool.BeyondBethe.BeyondBethe.Bethe +public import Mathlib.Tactic /-! # Cluster Certificate -/ +@[expose] public section + open scoped BigOperators namespace BeyondBethe @@ -183,11 +187,14 @@ theorem clusterInjectionPolynomial_eq_pair rw [injectionPolynomial_fin_two] rfl +/-- The product over columns of the singleton row Bethe factors. -/ noncomputable def singletonProductValue {n : ℕ} (A X : Matrix (Fin n) (Fin n) ℝ) (i : Fin n) : ℝ := ∏ j, (A i j / X i j) ^ (X i j) * (1 - X i j) ^ (1 - X i j) +/-- The pair-polynomial capacity multiplied by the complementary-mass product for the two-row +exponents. -/ noncomputable def pairCertificateValue {n : ℕ} (A X : Matrix (Fin n) (Fin n) ℝ) (r s : Fin n) : ℝ := (∏ j, (1 - pairAlpha X r s j) ^ (1 - pairAlpha X r s j)) * diff --git a/LeanPool/BeyondBethe/BeyondBethe/ClusterFactors.lean b/LeanPool/BeyondBethe/BeyondBethe/ClusterFactors.lean index 8fed4f7217..fdc716f9e5 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/ClusterFactors.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/ClusterFactors.lean @@ -3,13 +3,17 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.ClusterProduct -import LeanPool.BeyondBethe.BeyondBethe.PairStability -import Mathlib.Data.Fin.Tuple.Embedding + +public import LeanPool.BeyondBethe.BeyondBethe.ClusterProduct +public import LeanPool.BeyondBethe.BeyondBethe.PairStability +public import Mathlib.Data.Fin.Tuple.Embedding /-! # Cluster Factors -/ +@[expose] public section + open scoped BigOperators namespace BeyondBethe @@ -140,6 +144,7 @@ theorem rowClusterPolynomial_isRealStable_of_size_two exact injectionPolynomial_fin_two_isRealStable hcard (fun k j ↦ hA (C.rows ⟨c, e.symm k⟩) j) +/-- Every cluster contains either one row or two rows. -/ def IsSingletonPairClustering {n : ℕ} (C : RowClustering n) : Prop := ∀ c, C.size c = 1 ∨ C.size c = 2 diff --git a/LeanPool/BeyondBethe/BeyondBethe/ClusterProduct.lean b/LeanPool/BeyondBethe/BeyondBethe/ClusterProduct.lean index 0cd3ad2e58..44c5b34456 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/ClusterProduct.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/ClusterProduct.lean @@ -3,11 +3,15 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.PairedCertificate + +public import LeanPool.BeyondBethe.BeyondBethe.PairedCertificate /-! # Cluster Product -/ +@[expose] public section + open scoped BigOperators namespace BeyondBethe @@ -42,6 +46,7 @@ def IsGlobalClusterChoice {n : ℕ} (C : RowClustering n) (f : ClusterChoice C) : Prop := Function.Bijective (clusterChoiceMap C f) +/-- Cluster column choices whose combined assignment is a bijection. -/ abbrev GlobalClusterChoice {n : ℕ} (C : RowClustering n) := {f : ClusterChoice C // IsGlobalClusterChoice C f} diff --git a/LeanPool/BeyondBethe/BeyondBethe/Completion.lean b/LeanPool/BeyondBethe/BeyondBethe/Completion.lean index 6a1f858a94..340093f848 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/Completion.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/Completion.lean @@ -3,14 +3,18 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.Permanent -import LeanPool.BeyondBethe.BeyondBethe.Slack -import Mathlib.Analysis.SpecialFunctions.ExpDeriv -import Mathlib.Analysis.SpecialFunctions.Pow.Real + +public import LeanPool.BeyondBethe.BeyondBethe.Permanent +public import LeanPool.BeyondBethe.BeyondBethe.Slack +public import Mathlib.Analysis.SpecialFunctions.ExpDeriv +public import Mathlib.Analysis.SpecialFunctions.Pow.Real /-! # Completion -/ +@[expose] public section + namespace BeyondBethe /-- The improvement in the positive-matrix dichotomy (paper (46)). -/ diff --git a/LeanPool/BeyondBethe/BeyondBethe/CoreEncoding.lean b/LeanPool/BeyondBethe/BeyondBethe/CoreEncoding.lean index 07d1f48410..afbfb04ac3 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/CoreEncoding.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/CoreEncoding.lean @@ -3,15 +3,19 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.Entropy -import Mathlib.Combinatorics.Hall.Basic -import Mathlib.Data.Fin.Rev -import Mathlib.GroupTheory.Perm.Cycle.Factors -import Mathlib.Tactic + +public import LeanPool.BeyondBethe.BeyondBethe.Entropy +public import Mathlib.Combinatorics.Hall.Basic +public import Mathlib.Data.Fin.Rev +public import Mathlib.GroupTheory.Perm.Cycle.Factors +public import Mathlib.Tactic /-! # Core Encoding -/ +@[expose] public section + namespace BeyondBethe open Equiv @@ -290,6 +294,7 @@ incident to exactly two edge slots. Parallel edges are represented by equal values in the two row slots. -/ structure TwoRegularBipartiteMultigraph (α : Type*) [Fintype α] [DecidableEq α] where + /-- The target column of each of the two edge slots at a row vertex. -/ edge : α → Fin 2 → α columnDegree : ∀ j, (∑ i, ∑ k : Fin 2, if edge i k = j then 1 else 0) = 2 diff --git a/LeanPool/BeyondBethe/BeyondBethe/CycleTransfer.lean b/LeanPool/BeyondBethe/BeyondBethe/CycleTransfer.lean index 594cc9af14..328c1f907a 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/CycleTransfer.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/CycleTransfer.lean @@ -3,14 +3,18 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.RobustCycle -import LeanPool.BeyondBethe.BeyondBethe.Optimizer -import LeanPool.BeyondBethe.BeyondBethe.ExcursionTransfer -import Mathlib.Tactic + +public import LeanPool.BeyondBethe.BeyondBethe.RobustCycle +public import LeanPool.BeyondBethe.BeyondBethe.Optimizer +public import LeanPool.BeyondBethe.BeyondBethe.ExcursionTransfer +public import Mathlib.Tactic /-! # Cycle Transfer -/ +@[expose] public section + open scoped BigOperators namespace BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/Cycles.lean b/LeanPool/BeyondBethe/BeyondBethe/Cycles.lean index 6685ecb6bb..1ee8a6bfe4 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/Cycles.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/Cycles.lean @@ -3,14 +3,18 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.RowStability -import LeanPool.BeyondBethe.BeyondBethe.CoreEncoding -import Mathlib.Analysis.Convex.SpecificFunctions.Basic -import Mathlib.Tactic + +public import LeanPool.BeyondBethe.BeyondBethe.RowStability +public import LeanPool.BeyondBethe.BeyondBethe.CoreEncoding +public import Mathlib.Analysis.Convex.SpecificFunctions.Basic +public import Mathlib.Tactic /-! # Cycles -/ +@[expose] public section + namespace BeyondBethe /-- The Riemann-sum error `e(a,x)` from paper (27). Lean's conventions @@ -28,6 +32,7 @@ noncomputable def listSuffixScore : List ℝ → ℝ | [] => 0 | a :: l => a * Real.log (a + l.sum) + listSuffixScore l +/-- The sum of the suffix-error term at each position of a list. -/ noncomputable def listSuffixErrorSum : List ℝ → ℝ | [] => 0 | a :: l => suffixError a l.sum + listSuffixErrorSum l @@ -331,6 +336,7 @@ theorem goodRow_has_exactly_two_heavyCoordinates rw [habCard] at htwo exact le_antisymm (heavyCoordinates_card_le_two hp heta) htwo +/-- The rows whose entry in the given column is at least `1/2 - eta`. -/ noncomputable def heavyRows {n : ℕ} (eta : ℝ) (P : Matrix (Fin n) (Fin n) ℝ) (j : Fin n) : Finset (Fin n) := diff --git a/LeanPool/BeyondBethe/BeyondBethe/DirectedCertificateValue.lean b/LeanPool/BeyondBethe/BeyondBethe/DirectedCertificateValue.lean index 9568dfa9b0..24c933f48a 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/DirectedCertificateValue.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/DirectedCertificateValue.lean @@ -3,13 +3,17 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.ExecutableTransfer -import LeanPool.BeyondBethe.BeyondBethe.DirectedPairCost -import Mathlib.Tactic + +public import LeanPool.BeyondBethe.BeyondBethe.ExecutableTransfer +public import LeanPool.BeyondBethe.BeyondBethe.DirectedPairCost +public import Mathlib.Tactic /-! # Directed Certificate Value -/ +@[expose] public section + open scoped BigOperators namespace BeyondBethe @@ -23,11 +27,15 @@ potentials, and logarithms of `X_ij` and `1-X_ij`; the irrational nearby matrix never has to be materialized. -/ +/-- A directed rational approximation to `log(1-x) + τ*x*log x` using scheduled lower +logarithms. -/ def directedNearbyCoordinateLower (τ x : ℚ) (p : ℕ) : ℚ := scheduledLogLower (1 - x) p + τ * x * scheduledLogLower x p +/-- The row and column potential sums plus the directed coordinate contributions of the nearby +Bethe expression. -/ def directedNearbyBetheLower {n : ℕ} (τ : ℚ) (X : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℚ) (p : ℕ) : ℚ := @@ -233,10 +241,15 @@ def directedCertificatePrecision (n : ℕ) : ℕ := n + 400 directedCertificatePrecision n = directedPairCostPrecision n := by rfl +/-- The KKT error allowance, equal to one thirty-second of the certified improvement. -/ def explicitKKTError : ℚ := explicitCertifiedEpsilon / 32 +/-- The logarithm evaluation loss allowance, equal to one thirty-second of the certified +improvement. -/ def explicitLogEvaluationLoss : ℚ := explicitCertifiedEpsilon / 32 +/-- The exponential evaluation loss allowance, equal to one thirty-second of the certified +improvement. -/ def explicitExpEvaluationLoss : ℚ := explicitCertifiedEpsilon / 32 theorem explicitKKTError_pos : 0 < explicitKKTError := by diff --git a/LeanPool/BeyondBethe/BeyondBethe/DirectedElementary.lean b/LeanPool/BeyondBethe/BeyondBethe/DirectedElementary.lean index 5a1babb5e1..7381b5fe88 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/DirectedElementary.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/DirectedElementary.lean @@ -3,14 +3,18 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.AlgorithmicSpec -import Mathlib.Analysis.SpecialFunctions.Log.Deriv -import Mathlib.Data.Nat.Log -import Mathlib.Data.Rat.Floor + +public import LeanPool.BeyondBethe.BeyondBethe.AlgorithmicSpec +public import Mathlib.Analysis.SpecialFunctions.Log.Deriv +public import Mathlib.Data.Nat.Log +public import Mathlib.Data.Rat.Floor /-! # Directed Elementary -/ +@[expose] public section + open scoped BigOperators namespace BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/DirectedOptimizerOracle.lean b/LeanPool/BeyondBethe/BeyondBethe/DirectedOptimizerOracle.lean index 61f598813f..1b535b8b7e 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/DirectedOptimizerOracle.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/DirectedOptimizerOracle.lean @@ -3,14 +3,18 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.DirectedPairCost -import LeanPool.BeyondBethe.BeyondBethe.Optimizer -import LeanPool.BeyondBethe.BeyondBethe.NumericalAffine -import Mathlib.Tactic + +public import LeanPool.BeyondBethe.BeyondBethe.DirectedPairCost +public import LeanPool.BeyondBethe.BeyondBethe.Optimizer +public import LeanPool.BeyondBethe.BeyondBethe.NumericalAffine +public import Mathlib.Tactic /-! # Directed Optimizer Oracle -/ +@[expose] public section + open scoped BigOperators namespace BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/DirectedPairCost.lean b/LeanPool/BeyondBethe/BeyondBethe/DirectedPairCost.lean index ec6e79344b..8f87c9aa13 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/DirectedPairCost.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/DirectedPairCost.lean @@ -3,14 +3,18 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.DirectedElementary -import LeanPool.BeyondBethe.BeyondBethe.TransferIdentity -import LeanPool.BeyondBethe.BeyondBethe.Gain -import Mathlib.Tactic + +public import LeanPool.BeyondBethe.BeyondBethe.DirectedElementary +public import LeanPool.BeyondBethe.BeyondBethe.TransferIdentity +public import LeanPool.BeyondBethe.BeyondBethe.Gain +public import Mathlib.Tactic /-! # Directed Pair Cost -/ +@[expose] public section + open scoped BigOperators namespace BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/DyadicMagnitudePrecision.lean b/LeanPool/BeyondBethe/BeyondBethe/DyadicMagnitudePrecision.lean index 6f8a62cca1..a93ccac226 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/DyadicMagnitudePrecision.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/DyadicMagnitudePrecision.lean @@ -3,13 +3,17 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.DyadicRounding -import Mathlib.Data.Nat.Size -import Mathlib.Tactic + +public import LeanPool.BeyondBethe.BeyondBethe.DyadicRounding +public import Mathlib.Data.Nat.Size +public import Mathlib.Tactic /-! # Dyadic Magnitude Precision -/ +@[expose] public section + namespace BeyondBethe /-! diff --git a/LeanPool/BeyondBethe/BeyondBethe/DyadicRounding.lean b/LeanPool/BeyondBethe/BeyondBethe/DyadicRounding.lean index 29e6e61f64..204abe6ebb 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/DyadicRounding.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/DyadicRounding.lean @@ -3,14 +3,18 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.AlgorithmicSpec -import LeanPool.BeyondBethe.BeyondBethe.RationalEllipsoid -import Mathlib.Data.Rat.Floor -import Mathlib.Tactic + +public import LeanPool.BeyondBethe.BeyondBethe.AlgorithmicSpec +public import LeanPool.BeyondBethe.BeyondBethe.RationalEllipsoid +public import Mathlib.Data.Rat.Floor +public import Mathlib.Tactic /-! # Dyadic Rounding -/ +@[expose] public section + open scoped BigOperators namespace BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/Entropy.lean b/LeanPool/BeyondBethe/BeyondBethe/Entropy.lean index 95346520db..27c5ed310a 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/Entropy.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/Entropy.lean @@ -3,17 +3,21 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.Birkhoff -import Mathlib.Analysis.Convex.Jensen -import Mathlib.Analysis.MeanInequalities -import Mathlib.Analysis.SpecialFunctions.Log.NegMulLog -import Mathlib.Analysis.SpecialFunctions.Pow.Real -import Mathlib.Data.Fintype.Perm -import Mathlib.Tactic + +public import LeanPool.BeyondBethe.BeyondBethe.Birkhoff +public import Mathlib.Analysis.Convex.Jensen +public import Mathlib.Analysis.MeanInequalities +public import Mathlib.Analysis.SpecialFunctions.Log.NegMulLog +public import Mathlib.Analysis.SpecialFunctions.Pow.Real +public import Mathlib.Data.Fintype.Perm +public import Mathlib.Tactic /-! # Entropy -/ +@[expose] public section + open scoped BigOperators namespace BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/ExcursionTransfer.lean b/LeanPool/BeyondBethe/BeyondBethe/ExcursionTransfer.lean index 79921ff9f9..01ed39a8fb 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/ExcursionTransfer.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/ExcursionTransfer.lean @@ -3,13 +3,17 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.TransferIdentity -import Mathlib.Analysis.SpecialFunctions.BinaryEntropy -import Mathlib.Tactic + +public import LeanPool.BeyondBethe.BeyondBethe.TransferIdentity +public import Mathlib.Analysis.SpecialFunctions.BinaryEntropy +public import Mathlib.Tactic /-! # Excursion Transfer -/ +@[expose] public section + open scoped BigOperators namespace BeyondBethe @@ -157,16 +161,19 @@ theorem binaryEntropy_eq_binEntropy (ρ : ℝ) : binaryEntropy ρ = Real.binEntropy ρ := by rw [binaryEntropy, Real.binEntropy_eq_negMulLog_add_negMulLog_one_sub] +/-- The total rowwise transfer cost over all matrix coordinates. -/ noncomputable def matrixTransferCost {ι : Type*} [Fintype ι] (P U : Matrix ι ι ℝ) : ℝ := ∑ i, transferCostOn Finset.univ (P i) (U i) +/-- The total transfer cost over the designated outside coordinates in each row. -/ noncomputable def outsideTransferCost {ι : Type*} [Fintype ι] (outside : ι → Finset ι) (P U : Matrix ι ι ℝ) : ℝ := ∑ i, transferCostOn (outside i) (P i) (U i) +/-- The total transfer cost over the complements of the designated outside coordinates. -/ noncomputable def coreTransferCost {ι : Type*} [Fintype ι] [DecidableEq ι] (outside : ι → Finset ι) (P U : Matrix ι ι ℝ) : ℝ := diff --git a/LeanPool/BeyondBethe/BeyondBethe/ExecutableCertificate.lean b/LeanPool/BeyondBethe/BeyondBethe/ExecutableCertificate.lean index a6dc51a09a..44ef9d11b2 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/ExecutableCertificate.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/ExecutableCertificate.lean @@ -3,13 +3,17 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.ExplicitScales -import LeanPool.BeyondBethe.BeyondBethe.NumericalNearby -import Mathlib.Tactic + +public import LeanPool.BeyondBethe.BeyondBethe.ExplicitScales +public import LeanPool.BeyondBethe.BeyondBethe.NumericalNearby +public import Mathlib.Tactic /-! # Executable Certificate -/ +@[expose] public section + open scoped BigOperators namespace BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/ExecutableCertificateMagnitude.lean b/LeanPool/BeyondBethe/BeyondBethe/ExecutableCertificateMagnitude.lean index ff73f75953..158f9cccb4 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/ExecutableCertificateMagnitude.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/ExecutableCertificateMagnitude.lean @@ -3,14 +3,18 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.CertificateMagnitude -import LeanPool.BeyondBethe.BeyondBethe.ExecutableScannedBetheOptimizer + +public import LeanPool.BeyondBethe.BeyondBethe.CertificateMagnitude +public import LeanPool.BeyondBethe.BeyondBethe.ExecutableScannedBetheOptimizer /-! # Certificate magnitude for the row-major executable optimizer -/ +@[expose] public section + namespace BeyondBethe theorem executableOptimizerCertificateLog_abs_le diff --git a/LeanPool/BeyondBethe/BeyondBethe/ExecutableInterior.lean b/LeanPool/BeyondBethe/BeyondBethe/ExecutableInterior.lean index 87cd524194..98b6d4ff91 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/ExecutableInterior.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/ExecutableInterior.lean @@ -3,14 +3,18 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.NumericalInterior -import LeanPool.BeyondBethe.BeyondBethe.NumericalScales -import LeanPool.BeyondBethe.BeyondBethe.DirectedElementary -import Mathlib.Tactic + +public import LeanPool.BeyondBethe.BeyondBethe.NumericalInterior +public import LeanPool.BeyondBethe.BeyondBethe.NumericalScales +public import LeanPool.BeyondBethe.BeyondBethe.DirectedElementary +public import Mathlib.Tactic /-! # Executable Interior -/ +@[expose] public section + namespace BeyondBethe /-! @@ -21,12 +25,15 @@ whose exponent is computed directly from the matrix encoding, the dimension, and the rational regularization parameter. -/ +/-- The interior-bound quantity `n*(n*B+2*n^2)/τ + n^3`. -/ def numericalInteriorK0 (n B : ℕ) (τ : ℚ) : ℚ := n * (n * B + 2 * n ^ 2) / τ + n ^ 3 +/-- The ceiling of twice the numerical interior-bound quantity. -/ def numericalInteriorExponent (n B : ℕ) (τ : ℚ) : ℕ := rationalCeilNat (2 * numericalInteriorK0 n B τ) +/-- The dyadic interior floor with exponent given by the numerical interior bound. -/ def numericalInteriorFloor (n B : ℕ) (τ : ℚ) : ℚ := (1 / 2 : ℚ) ^ numericalInteriorExponent n B τ diff --git a/LeanPool/BeyondBethe/BeyondBethe/ExecutablePositiveRoutine.lean b/LeanPool/BeyondBethe/BeyondBethe/ExecutablePositiveRoutine.lean index b833fdd0bd..729f17b649 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/ExecutablePositiveRoutine.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/ExecutablePositiveRoutine.lean @@ -3,11 +3,13 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.ExecutableScannedBetheOptimizer -import LeanPool.BeyondBethe.BeyondBethe.FinalAssembly -import LeanPool.BeyondBethe.BeyondBethe.SourceStableReindex -import Mathlib.Tactic + +public import LeanPool.BeyondBethe.BeyondBethe.ExecutableScannedBetheOptimizer +public import LeanPool.BeyondBethe.BeyondBethe.FinalAssembly +public import LeanPool.BeyondBethe.BeyondBethe.SourceStableReindex +public import Mathlib.Tactic /-! # The executable positive-matrix routine @@ -18,8 +20,12 @@ gap, and therefore does not identify its tie-breaking choices with those of the earlier semantic bisection runner. -/ +@[expose] public section + namespace BeyondBethe +/-- The executable positive-input approximation: exact in dimensions zero and one, otherwise a +scaled certificate from the scanned Bethe optimizer. -/ def executablePositiveAlgorithm : ∀ n, Matrix (Fin n) (Fin n) ℚ → ℚ | 0, A => Matrix.permanent A @@ -121,6 +127,8 @@ theorem executablePositiveAlgorithm_succ_succ_spec (pow_nonneg hscale.le (m + 2)) nlinarith +/-- The executable positive-input algorithm bundled with positivity and the two permanent +approximation bounds. -/ def executableCertifiedPositiveRoutine : CertifiedPositiveRoutine (explicitCertifiedEpsilon : ℝ) where alg := executablePositiveAlgorithm diff --git a/LeanPool/BeyondBethe/BeyondBethe/ExecutableScannedBetheOptimizer.lean b/LeanPool/BeyondBethe/BeyondBethe/ExecutableScannedBetheOptimizer.lean index 22cc79b103..e82e095edf 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/ExecutableScannedBetheOptimizer.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/ExecutableScannedBetheOptimizer.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerBisectionSemantics -import LeanPool.BeyondBethe.BeyondBethe.ExplicitBetheOptimizer -import Mathlib.Tactic + +public import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerBisectionSemantics +public import LeanPool.BeyondBethe.BeyondBethe.ExplicitBetheOptimizer +public import Mathlib.Tactic /-! # Correctness of the executable row-major Bethe optimizer @@ -18,14 +20,20 @@ paper-level optimizer, and derives the approximate logarithmic KKT equations without identifying its tie-breaking choices with those of any other runner. -/ +@[expose] public section + namespace BeyondBethe open Complexity +/-- The raw-rational coordinate floor for the scanned optimizer, determined by the dimension and +entry bit bound. -/ def executableScannedBetheOptimizerFloor {m : ℕ} (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) : RawRat := rawExplicitOptimizerFloor (m + 1) (rationalMatrixEntryBitBound A) +/-- Initialize scanned Bethe bisection with the explicit regularization, precision, floor, +mixing weight, and inner radius. -/ def executableScannedBetheOptimizerInitialState {m : ℕ} (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) : BetheBisectionState (m * m + 1) := @@ -35,6 +43,7 @@ def executableScannedBetheOptimizerInitialState {m : ℕ} (executableScannedBetheOptimizerFloor A) (explicitOptimizerMix A) (explicitOptimizerInnerRadius A) +/-- Run scanned Bethe bisection for the prescribed explicit number of iterations. -/ def executableScannedBetheOptimizerState {m : ℕ} (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) : BetheBisectionState (m * m + 1) := @@ -53,11 +62,13 @@ def executableScannedBetheOptimizerPoint {m : ℕ} Fin (m * m + 1) → ℚ := (executableScannedBetheOptimizerState A).witness.getD 0 +/-- Recover the affine matrix from the epigraph base coordinates of the scanned optimizer point. -/ def executableScannedBetheOptimizerMatrix {m : ℕ} (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ := betheAffineMatrixQ (epigraphBase (executableScannedBetheOptimizerPoint A)) +/-- The directed lower negative-gradient matrix evaluated at the scanned optimizer matrix. -/ def executableScannedBetheOptimizerGradient {m : ℕ} (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ := @@ -66,11 +77,15 @@ def executableScannedBetheOptimizerGradient {m : ℕ} (executableScannedBetheOptimizerMatrix A) (explicitOptimizerPrecision A) +/-- The row potential obtained from the negative first-column gradient entry and the +regularization offset. -/ def executableScannedBetheOptimizerRowPotential {m : ℕ} (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) : Fin (m + 1) → ℚ := fun i ↦ -executableScannedBetheOptimizerGradient A i 0 + (2 + explicitRegularizationScale (m + 1)) +/-- The column potential obtained from the negative first-row gradient difference relative to +column zero. -/ def executableScannedBetheOptimizerColumnPotential {m : ℕ} (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) : Fin (m + 1) → ℚ := fun j ↦ -(executableScannedBetheOptimizerGradient A 0 j - diff --git a/LeanPool/BeyondBethe/BeyondBethe/ExecutableTransfer.lean b/LeanPool/BeyondBethe/BeyondBethe/ExecutableTransfer.lean index 23cad3fdaf..79be2bf801 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/ExecutableTransfer.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/ExecutableTransfer.lean @@ -3,12 +3,16 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.ExecutableCertificate -import LeanPool.BeyondBethe.BeyondBethe.NumericalNearby + +public import LeanPool.BeyondBethe.BeyondBethe.ExecutableCertificate +public import LeanPool.BeyondBethe.BeyondBethe.NumericalNearby /-! # Executable Transfer -/ +@[expose] public section + namespace BeyondBethe /-! @@ -30,6 +34,8 @@ noncomputable def executableNearbyCertificateLog let A' := nearbyKKTMatrix (explicitRegularizationScale n : ℝ) X R C betheObjective A' X + (explicitCertifiedMatchingGain Xq : ℝ) - error * n +/-- Exponentiate the logarithmic nearby-certificate value for the rational matrix and supplied +potentials. -/ noncomputable def executableNearbyCertificateValue {n : ℕ} (error : ℝ) (Xq : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℝ) : ℝ := diff --git a/LeanPool/BeyondBethe/BeyondBethe/ExplicitBetheOptimizer.lean b/LeanPool/BeyondBethe/BeyondBethe/ExplicitBetheOptimizer.lean index e7c8a2c064..f2822cae79 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/ExplicitBetheOptimizer.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/ExplicitBetheOptimizer.lean @@ -3,12 +3,16 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.ExplicitOptimizerScales -import Mathlib.Tactic + +public import LeanPool.BeyondBethe.BeyondBethe.ExplicitOptimizerScales +public import Mathlib.Tactic /-! # Explicit Bethe Optimizer -/ +@[expose] public section + namespace BeyondBethe /-! @@ -19,6 +23,7 @@ bisection. The exact real maximizer below appears only in correctness proofs; the state and returned point are executable rational data. -/ +/-- Initialize Bethe bisection with the explicit regularization and optimizer scale parameters. -/ def explicitBetheOptimizerInitialState {m : ℕ} (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) : BetheBisectionState (m * m + 1) := @@ -26,6 +31,7 @@ def explicitBetheOptimizerInitialState {m : ℕ} (explicitOptimizerPrecision A) (explicitOptimizerFloor A) (explicitOptimizerMix A) (explicitOptimizerInnerRadius A) +/-- Run Bethe bisection for the explicit iteration budget from its prescribed initial state. -/ def explicitBetheOptimizerState {m : ℕ} (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) : BetheBisectionState (m * m + 1) := @@ -41,11 +47,14 @@ def explicitBetheOptimizerPoint {m : ℕ} Fin (m * m + 1) → ℚ := (explicitBetheOptimizerState A).witness.getD 0 +/-- Recover the affine matrix from the epigraph base coordinates of the explicit optimizer +point. -/ def explicitBetheOptimizerMatrix {m : ℕ} (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ := betheAffineMatrixQ (epigraphBase (explicitBetheOptimizerPoint A)) +/-- The directed lower negative-gradient matrix evaluated at the explicit optimizer matrix. -/ def explicitBetheOptimizerGradient {m : ℕ} (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ := diff --git a/LeanPool/BeyondBethe/BeyondBethe/ExplicitBetheThresholdFeasibility.lean b/LeanPool/BeyondBethe/BeyondBethe/ExplicitBetheThresholdFeasibility.lean index f9ad625b3f..7798908b96 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/ExplicitBetheThresholdFeasibility.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/ExplicitBetheThresholdFeasibility.lean @@ -3,13 +3,17 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.BetheThresholdFeasibility -import LeanPool.BeyondBethe.BeyondBethe.ExplicitScheduledFeasibility -import Mathlib.Tactic + +public import LeanPool.BeyondBethe.BeyondBethe.BetheThresholdFeasibility +public import LeanPool.BeyondBethe.BeyondBethe.ExplicitScheduledFeasibility +public import Mathlib.Tactic /-! # Explicit Bethe Threshold Feasibility -/ +@[expose] public section + namespace BeyondBethe /-! @@ -21,6 +25,8 @@ uses the same rational oracle and iteration budget as the two explicit zero-ball exponents rather than a matrix LCM. -/ +/-- Run the explicit ball-based feasibility routine on the bounded Bethe epigraph oracle at the +given threshold. -/ def runExplicitBetheThresholdFeasibility {m : ℕ} (τ : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) (p : ℕ) (δ upper r : ℚ) : diff --git a/LeanPool/BeyondBethe/BeyondBethe/ExplicitBounds.lean b/LeanPool/BeyondBethe/BeyondBethe/ExplicitBounds.lean index 8242a29ab1..dcf752ae0d 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/ExplicitBounds.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/ExplicitBounds.lean @@ -3,16 +3,20 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.CleanConstants -import LeanPool.BeyondBethe.BeyondBethe.NumericalWitness -import LeanPool.BeyondBethe.BeyondBethe.GoodRowScore -import LeanPool.BeyondBethe.BeyondBethe.DirectedElementary -import Mathlib.Analysis.Complex.ExponentialBounds -import Mathlib.Tactic + +public import LeanPool.BeyondBethe.BeyondBethe.CleanConstants +public import LeanPool.BeyondBethe.BeyondBethe.NumericalWitness +public import LeanPool.BeyondBethe.BeyondBethe.GoodRowScore +public import LeanPool.BeyondBethe.BeyondBethe.DirectedElementary +public import Mathlib.Analysis.Complex.ExponentialBounds +public import Mathlib.Tactic /-! # Explicit Bounds -/ +@[expose] public section + open scoped Topology namespace BeyondBethe @@ -623,6 +627,7 @@ theorem explicitKappa_cleanCore an unspecified continuity neighborhood. -/ def explicitXiSource : ℚ := 1 / 100 +/-- The fixed rational structural gain parameter `1/4`. -/ def explicitGamma : ℚ := 1 / 4 theorem explicit_cleanPairGain_constants : diff --git a/LeanPool/BeyondBethe/BeyondBethe/ExplicitOptimizerScales.lean b/LeanPool/BeyondBethe/BeyondBethe/ExplicitOptimizerScales.lean index 12d6baf21f..e6b32fd685 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/ExplicitOptimizerScales.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/ExplicitOptimizerScales.lean @@ -3,13 +3,17 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.BetheBisection -import LeanPool.BeyondBethe.BeyondBethe.DirectedCertificateValue -import Mathlib.Tactic + +public import LeanPool.BeyondBethe.BeyondBethe.BetheBisection +public import LeanPool.BeyondBethe.BeyondBethe.DirectedCertificateValue +public import Mathlib.Tactic /-! # Explicit Optimizer Scales -/ +@[expose] public section + namespace BeyondBethe /-! @@ -20,40 +24,55 @@ the fixed structural error budget. Their deliberately generous slack keeps the later objective-to-KKT calculation transparent. -/ +/-- Half the numerical interior floor at the matrix dimension, entry bit bound, and +regularization scale. -/ def explicitOptimizerFloor {m : ℕ} (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) : ℚ := numericalInteriorFloor (m + 1) (rationalMatrixEntryBitBound A) (explicitRegularizationScale (m + 1)) / 2 +/-- The optimizer distance scale: the coordinate floor times the KKT error allowance, divided by +48. -/ def explicitOptimizerRho {m : ℕ} (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) : ℚ := explicitOptimizerFloor A * explicitKKTError / 48 +/-- The optimizer objective gap: one quarter of the regularization scale times the squared +distance scale. -/ def explicitOptimizerGap {m : ℕ} (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) : ℚ := explicitRegularizationScale (m + 1) * explicitOptimizerRho A ^ 2 / 4 +/-- The mixing weight capped at one half and scaled by the objective gap and regularized +objective range. -/ def explicitOptimizerMix {m : ℕ} (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) : ℚ := min (1 / 2) (explicitOptimizerGap A / (4 * (rationalRegularizedObjectiveRange A + 1))) +/-- The optimizer inner radius, equal to the mixing weight divided by twice the matrix +dimension. -/ def explicitOptimizerInnerRadius {m : ℕ} (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) : ℚ := explicitOptimizerMix A / (2 * (m + 1)) +/-- The evaluation precision budget from the encoded gap and KKT allowance, with +dimension-dependent slack. -/ def explicitOptimizerPrecision {m : ℕ} (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) : ℕ := encodedBitLength ℚ (explicitOptimizerGap A) + encodedBitLength ℚ explicitKKTError + 2 * (m + 1) + 10 +/-- The width of the explicit initial Bethe bisection interval. -/ def explicitOptimizerInitialWidth {m : ℕ} (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) : ℚ := betheBisectionInitialHigh A (explicitOptimizerMix A) (explicitOptimizerInnerRadius A) - betheNegativeObjectiveLower m +/-- The bisection iteration count from the encoded initial width and target gap, with three +extra steps. -/ def explicitOptimizerBisectionSteps {m : ℕ} (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) : ℕ := encodedBitLength ℚ (explicitOptimizerInitialWidth A) + diff --git a/LeanPool/BeyondBethe/BeyondBethe/ExplicitPositiveRoutine.lean b/LeanPool/BeyondBethe/BeyondBethe/ExplicitPositiveRoutine.lean index 39dc1c4154..f6ae6d0348 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/ExplicitPositiveRoutine.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/ExplicitPositiveRoutine.lean @@ -3,14 +3,18 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.FinalAssembly -import LeanPool.BeyondBethe.BeyondBethe.ExplicitBetheOptimizer -import LeanPool.BeyondBethe.BeyondBethe.SourceStableReindex -import Mathlib.Tactic + +public import LeanPool.BeyondBethe.BeyondBethe.FinalAssembly +public import LeanPool.BeyondBethe.BeyondBethe.ExplicitBetheOptimizer +public import LeanPool.BeyondBethe.BeyondBethe.SourceStableReindex +public import Mathlib.Tactic /-! # Explicit Positive Routine -/ +@[expose] public section + namespace BeyondBethe /-! @@ -21,6 +25,8 @@ regularized-Bethe optimizer, evaluates the directed rational certificate, and restores the degree-`n` normalization factor. -/ +/-- The explicit positive-input approximation: exact in dimensions zero and one, otherwise a +normalization-scaled Bethe certificate. -/ def explicitPositiveAlgorithm : ∀ n, Matrix (Fin n) (Fin n) ℚ → ℚ | 0, A => Matrix.permanent A diff --git a/LeanPool/BeyondBethe/BeyondBethe/ExplicitScales.lean b/LeanPool/BeyondBethe/BeyondBethe/ExplicitScales.lean index 3d4a6c4fd7..aaf3f5df2e 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/ExplicitScales.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/ExplicitScales.lean @@ -3,14 +3,18 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.ExplicitBounds -import LeanPool.BeyondBethe.BeyondBethe.CertifiedPairWeights -import LeanPool.BeyondBethe.BeyondBethe.NumericalScales -import Mathlib.Tactic + +public import LeanPool.BeyondBethe.BeyondBethe.ExplicitBounds +public import LeanPool.BeyondBethe.BeyondBethe.CertifiedPairWeights +public import LeanPool.BeyondBethe.BeyondBethe.NumericalScales +public import Mathlib.Tactic /-! # Explicit Scales -/ +@[expose] public section + namespace BeyondBethe /-! @@ -20,13 +24,17 @@ This file replaces the remaining density and continuity choices in the structural proof by one fixed tuple of rationals. -/ +/-- The fixed rational heavy-coordinate tolerance `10^(-12)`. -/ def explicitEta : ℚ := 1 / 10 ^ 12 +/-- The fixed row-error ratio `1/200000`. -/ def explicitRowRatio : ℚ := 1 / 200000 +/-- The completion scale `(explicitEta/3074)^4 * explicitRowRatio`. -/ def explicitDelta : ℚ := (explicitEta / 3074) ^ 4 * explicitRowRatio +/-- The transfer tolerance, equal to one hundredth of the completion scale. -/ def explicitXi : ℚ := explicitDelta / 100 /-- The greedy threshold matching retains one quarter of the structural @@ -122,6 +130,8 @@ theorem explicitDelta_le_rowRatio : norm_num only [Rat.cast_mul, Rat.cast_pow, Rat.cast_div, Rat.cast_ofNat] exact mul_le_of_le_one_left (by exact_mod_cast explicitRowRatio_pos.le) heta +/-- The explicit rational completion parameters bundled with their row, cycle, transfer, and +gain bounds. -/ def explicit_completionScales : RationalCompletionScales explicitKappa explicitXiSource explicitGamma := by have hlog0 : 0 < Real.log 2 := Real.log_pos (by norm_num) @@ -337,12 +347,15 @@ theorem explicitCertifiedEpsilon_eq : norm_num [explicitCertifiedGamma, explicitGamma]) linarith +/-- The rational certified improvement extracted from the explicit certified completion scales. -/ def explicitCertifiedEpsilon : ℚ := rationalEpsilonPlus explicitCertifiedCompletionScales theorem explicitCertifiedEpsilon_pos : 0 < explicitCertifiedEpsilon := by exact rationalEpsilonPlus_pos explicitCertifiedCompletionScales +/-- The explicit structural parameters together with the clean-pair gain and completion-scale +proofs. -/ def explicitStructuralScales : RationalStructuralScales where κ₀ := explicitKappa ξ₀ := explicitXiSource @@ -364,6 +377,8 @@ theorem cleanPairGainGuarantee_mono_gamma theorem explicitGreedyGamma_pos : 0 < explicitGreedyGamma := by norm_num [explicitGreedyGamma, explicitGamma] +/-- The explicit completion parameters equipped with the stronger gain comparison needed for +greedy completion. -/ def explicitGreedyCompletionScales : RationalCompletionScales explicitKappa explicitXiSource explicitGreedyGamma := diff --git a/LeanPool/BeyondBethe/BeyondBethe/ExplicitScheduledFeasibility.lean b/LeanPool/BeyondBethe/BeyondBethe/ExplicitScheduledFeasibility.lean index cafa17d902..b2d8a69ccd 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/ExplicitScheduledFeasibility.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/ExplicitScheduledFeasibility.lean @@ -3,12 +3,16 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.ScheduledFeasibility -import Mathlib.Tactic + +public import LeanPool.BeyondBethe.BeyondBethe.ScheduledFeasibility +public import Mathlib.Tactic /-! # Explicit Scheduled Feasibility -/ +@[expose] public section + open scoped BigOperators namespace BeyondBethe @@ -24,20 +28,26 @@ initial state magnitude. This file packages those two exponents into the fixed-precision feasibility runner used by the finite-word implementation. -/ +/-- The initial determinant exponent budget: dimension times the encoded radius length. -/ def explicitBallInitialDetExponent (d : ℕ) (R : ℚ) : ℕ := encodedBitLength ℚ R * d +/-- The initial ball magnitude bound `2 + d*R`. -/ def explicitBallInitialMagnitudeBound (d : ℕ) (R : ℚ) : ℚ := 2 + d * R +/-- The encoded bit length of the initial ball magnitude bound. -/ def explicitBallInitialMagnitudeExponent (d : ℕ) (R : ℚ) : ℕ := encodedBitLength ℚ (explicitBallInitialMagnitudeBound d R) +/-- The rounded-ellipsoid precision schedule determined by the initial ball and iteration +budget. -/ def explicitBallFeasibilityPrecision (d budget : ℕ) (R : ℚ) : ℕ := roundedEllipsoidPrecisionSchedule d (explicitBallInitialDetExponent d R) (explicitBallInitialMagnitudeExponent d R) budget +/-- Run fixed-precision rational feasibility from the radius-`R` ball centered at zero. -/ def runExplicitBallRationalFeasibility {d : ℕ} (oracle : RationalCentralOracle d) (budget : ℕ) (R : ℚ) : RationalFeasibilityResult d := diff --git a/LeanPool/BeyondBethe/BeyondBethe/FinalAssembly.lean b/LeanPool/BeyondBethe/BeyondBethe/FinalAssembly.lean index b9e4411f5c..47f6ab8bb0 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/FinalAssembly.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/FinalAssembly.lean @@ -3,14 +3,18 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.NumericalScales -import LeanPool.BeyondBethe.BeyondBethe.AlgorithmicSpec -import LeanPool.BeyondBethe.BeyondBethe.Smoothing -import LeanPool.BeyondBethe.BeyondBethe.KuhnMatching + +public import LeanPool.BeyondBethe.BeyondBethe.NumericalScales +public import LeanPool.BeyondBethe.BeyondBethe.AlgorithmicSpec +public import LeanPool.BeyondBethe.BeyondBethe.Smoothing +public import LeanPool.BeyondBethe.BeyondBethe.KuhnMatching /-! # Final Assembly -/ +@[expose] public section + open scoped BigOperators namespace BeyondBethe @@ -59,6 +63,8 @@ def smoothedRationalMatrix {n : ℕ} rational matrices. Its numerical loss is exactly the allowance in Lemma 24 of the paper. -/ structure CertifiedPositiveRoutine (ε : ℝ) where + /-- The rational matrix algorithm whose positive-input permanent bounds are certified by the + remaining fields. -/ alg : ∀ n, Matrix (Fin n) (Fin n) ℚ → ℚ positiveOutput : ∀ {n : ℕ}, 2 ≤ n → ∀ A : Matrix (Fin n) (Fin n) ℚ, diff --git a/LeanPool/BeyondBethe/BeyondBethe/Gain.lean b/LeanPool/BeyondBethe/BeyondBethe/Gain.lean index cf13911f1f..26490db56a 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/Gain.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/Gain.lean @@ -3,14 +3,18 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.Capacity -import LeanPool.BeyondBethe.BeyondBethe.Transfer -import Mathlib.Analysis.Convex.SpecificFunctions.Basic -import Mathlib.Tactic + +public import LeanPool.BeyondBethe.BeyondBethe.Capacity +public import LeanPool.BeyondBethe.BeyondBethe.Transfer +public import Mathlib.Analysis.Convex.SpecificFunctions.Basic +public import Mathlib.Tactic /-! # Gain -/ +@[expose] public section + open scoped BigOperators namespace BeyondBethe @@ -40,6 +44,7 @@ theorem rowZeta_le_one exact Real.rpow_le_one (hp.nonnegative j) (hp.le_one j) (mul_nonneg hτ (hp.nonnegative j)) +/-- The total coordinate mass outside the two distinguished columns. -/ noncomputable def outsideMassTwo {ι : Type*} [Fintype ι] [DecidableEq ι] (p : ι → ℝ) (a b : ι) : ℝ := @@ -198,6 +203,7 @@ theorem exp_neg_le_of_log_one_div_le rw [Real.exp_log hu] at hexp exact hexp +/-- The sum of the four logarithmic transfer costs at the two distinguished rows and columns. -/ noncomputable def fourCoreTransferCost {ι : Type*} [Fintype ι] [DecidableEq ι] (τ : ℝ) (X : Matrix ι ι ℝ) (r s a b : ι) : ℝ := @@ -295,6 +301,8 @@ theorem coordinate_rpow_le_transferU and an outside column. -/ abbrev CapacityWitnessEdge (ι : Type*) := Unit ⊕ (ι ⊕ ι) +/-- The capacity-witness edge masses: `1-ρ` on the central edge, and the scaled outside masses +on the two side families. -/ noncomputable def capacityWitnessMass {ι : Type*} (ρ δa δb : ℝ) (α : ι → ℝ) : CapacityWitnessEdge ι → ℝ diff --git a/LeanPool/BeyondBethe/BeyondBethe/Gibbs.lean b/LeanPool/BeyondBethe/BeyondBethe/Gibbs.lean index 8f0e2f41c6..3cbeb21493 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/Gibbs.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/Gibbs.lean @@ -3,12 +3,16 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.Entropy -import Mathlib.Tactic + +public import LeanPool.BeyondBethe.BeyondBethe.Entropy +public import Mathlib.Tactic /-! # Gibbs -/ +@[expose] public section + open scoped BigOperators namespace BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/GoodRowScore.lean b/LeanPool/BeyondBethe/BeyondBethe/GoodRowScore.lean index 2f39428b96..f4027f7ffd 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/GoodRowScore.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/GoodRowScore.lean @@ -3,13 +3,17 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.Cycles -import Mathlib.Analysis.SpecialFunctions.BinaryEntropy -import Mathlib.Tactic + +public import LeanPool.BeyondBethe.BeyondBethe.Cycles +public import Mathlib.Analysis.SpecialFunctions.BinaryEntropy +public import Mathlib.Tactic /-! # Good Row Score -/ +@[expose] public section + open scoped BigOperators Topology open Filter @@ -125,6 +129,7 @@ instance instDecidableCoordinateBefore unfold CoordinateBefore infer_instance +/-- The probability that coordinate `a` precedes `b` in a uniformly chosen permutation. -/ noncomputable def coordinateBeforeProbability {n : ℕ} (a b : Fin n) : ℝ := uniformAverage fun π : Equiv.Perm (Fin n) ↦ @@ -477,8 +482,10 @@ theorem rowScore_sub_twoCoreCoarsenedEntropy_ge_Psi rw [rowScore, goodRowPsi] linarith [hentropy] +/-- The three real coordinates on which the continuous good-row score is evaluated. -/ abbrev GoodRowTriple := ℝ × (ℝ × ℝ) +/-- The reference good-row triple `(1/2, 1/2, 0)`. -/ noncomputable def goodRowCenter : GoodRowTriple := (1 / 2, (1 / 2, 0)) /-- Clamp the radius to the interval on which the paper uses the good-row @@ -601,6 +608,7 @@ theorem continuousOn_continuousGoodRowPsi_closedBall : hentropy.add (hhalf.mul (((hsUQ.add hsUVQ).add hsVQ).add hsVUQ)) simpa only [continuousGoodRowPsi] using htotal.continuousWithinAt +/-- The absolute deviation of the continuous good-row score from `log(2)/2`. -/ noncomputable def goodRowDeviation (z : GoodRowTriple) : ℝ := |Real.log 2 / 2 - continuousGoodRowPsi z.1 z.2.1 z.2.2| diff --git a/LeanPool/BeyondBethe/BeyondBethe/GreedyRowMatching.lean b/LeanPool/BeyondBethe/BeyondBethe/GreedyRowMatching.lean index 5f26ac82ac..7b814c4ca1 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/GreedyRowMatching.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/GreedyRowMatching.lean @@ -3,13 +3,17 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.NearCase -import LeanPool.BeyondBethe.BeyondBethe.NumericalWitness -import Mathlib.Algebra.Order.BigOperators.Group.Finset + +public import LeanPool.BeyondBethe.BeyondBethe.NearCase +public import LeanPool.BeyondBethe.BeyondBethe.NumericalWitness +public import Mathlib.Algebra.Order.BigOperators.Group.Finset /-! # Greedy Row Matching -/ +@[expose] public section + namespace BeyondBethe /-! diff --git a/LeanPool/BeyondBethe/BeyondBethe/KuhnMatching.lean b/LeanPool/BeyondBethe/BeyondBethe/KuhnMatching.lean index 1886e7675c..87f8fd639c 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/KuhnMatching.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/KuhnMatching.lean @@ -3,13 +3,17 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.Permanent -import Mathlib.Data.List.FinRange -import Mathlib.Tactic + +public import LeanPool.BeyondBethe.BeyondBethe.Permanent +public import Mathlib.Data.List.FinRange +public import Mathlib.Tactic /-! # Kuhn Matching -/ +@[expose] public section + namespace BeyondBethe /-! @@ -22,8 +26,10 @@ set of visited columns, so a single root search examines each column at most once; this detail is essential for the polynomial bound. -/ +/-- A table assigning each column either a matched row or no match. -/ abbrev ColumnMate (n : ℕ) := Fin n → Option (Fin n) +/-- The column-mate table with every column unmatched. -/ def emptyColumnMate (n : ℕ) : ColumnMate n := fun _ ↦ none /-- A column-to-row table represents a partial matching in the positive @@ -34,9 +40,11 @@ structure IsSupportColumnMate {n : ℕ} injective : ∀ {col col' row}, mate col = some row → mate col' = some row → col = col' +/-- No column in the mate table is assigned to the given row. -/ def RowUnmatched {n : ℕ} (mate : ColumnMate n) (row : Fin n) : Prop := ∀ col, mate col ≠ some row +/-- Some column in the mate table is assigned to the given row. -/ def MatchesRow {n : ℕ} (mate : ColumnMate n) (row : Fin n) : Prop := ∃ col, mate col = some row @@ -169,7 +177,9 @@ theorem matchesRow_update_some_iff {n : ℕ} /-- Result of one augmenting-path search. `mate? = some m` records success; either way, `seen` contains every column examined by the search. -/ structure KuhnSearchResult (n : ℕ) where + /-- The updated mate table on successful augmentation, or `none` when the search fails. -/ mate? : Option (ColumnMate n) + /-- The set of columns visited by the search, retained even when augmentation fails. -/ seen : Finset (Fin n) /-- Depth-first augmenting-path search with a shared visited-column set. @@ -348,6 +358,7 @@ theorem kuhnSearchWork_le {n : ℕ} rw [hsplitAll, hsplitOne, Nat.mul_add, Nat.mul_add] omega +/-- The work count for an augmenting-path search over the full ordered column list. -/ def kuhnAugmentWork {n : ℕ} (A : Matrix (Fin n) (Fin n) ℚ) (fuel : ℕ) (row : Fin n) (seen : Finset (Fin n)) (mate : ColumnMate n) : ℕ := @@ -494,6 +505,7 @@ theorem kuhnSearch_success {n : ℕ} mateWithoutOld recursive hrec ihRec ihRec' ihContinue => exact ihContinue mate' hsupport hunmatched hresult +/-- Every nonzero support neighbor of the row lies in the specified column set. -/ def AllSupportNeighborsIn {n : ℕ} (A : Matrix (Fin n) (Fin n) ℚ) (row : Fin n) (cols : Finset (Fin n)) : Prop := @@ -700,6 +712,8 @@ def kuhnBuild {n : ℕ} (A : Matrix (Fin n) (Fin n) ℚ) : let result := kuhnAugment A (n + 1) row ∅ mate kuhnBuild A rows (result.mate?.getD mate) +/-- The cumulative augmenting-search work for the row list, retaining the previous mate table +when a search fails. -/ def kuhnBuildWork {n : ℕ} (A : Matrix (Fin n) (Fin n) ℚ) : List (Fin n) → ColumnMate n → ℕ | [], _mate => 0 @@ -816,10 +830,12 @@ theorem kuhnBuild_support {n : ℕ} simpa [kuhnBuild, hresult] using ih mateOne hnodup.tail hsupportOne htailUnmatched +/-- The mate table produced by inserting all rows in order, starting from the empty matching. -/ def kuhnColumnMate {n : ℕ} (A : Matrix (Fin n) (Fin n) ℚ) : ColumnMate n := kuhnBuild A (List.finRange n) (emptyColumnMate n) +/-- Decide whether any column is matched to the given row. -/ def matchedRowDecision {n : ℕ} (mate : ColumnMate n) (row : Fin n) : Bool := (List.finRange n).any fun col ↦ mate col == some row diff --git a/LeanPool/BeyondBethe/BeyondBethe/KuhnSmallStep.lean b/LeanPool/BeyondBethe/BeyondBethe/KuhnSmallStep.lean index 2673231b79..6c2e427c80 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/KuhnSmallStep.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/KuhnSmallStep.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.KuhnMatching -import Mathlib.Tactic + +public import LeanPool.BeyondBethe.BeyondBethe.KuhnMatching +public import Mathlib.Tactic /-! # A small-step evaluator for the Kuhn matching algorithm @@ -21,22 +23,31 @@ to isolate the semantic compiler-correctness argument from the subsequent finite-word implementation. -/ +@[expose] public section + namespace BeyondBethe /-- The information needed after a recursive alternating-path search returns. On success the saved edge is installed. On failure the parent row resumes at its saved column suffix with its original mate table. -/ structure KuhnSearchFrame (n : ℕ) where + /-- The parent search fuel restored if the recursive search fails. -/ fuel : ℕ + /-- The remaining parent columns to scan after a failed recursive search. -/ remaining : List (Fin n) + /-- The parent row whose saved edge is installed after a successful recursive search. -/ row : Fin n + /-- The original parent mate table restored after a failed recursive search. -/ mate : ColumnMate n + /-- The saved column matched to the parent row after a successful recursive search. -/ column : Fin n /-- The outer frame remembers the rows not yet inserted and the mate table to retain if the current root search fails. -/ structure KuhnBuildFrame (n : ℕ) where + /-- The rows still to insert after the current root search returns. -/ rows : List (Fin n) + /-- The mate table retained if the current root search fails. -/ fallback : ColumnMate n inductive KuhnFrame (n : ℕ) diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineArithmeticTests.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineArithmeticTests.lean index d2885abb52..1672ff02f2 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineArithmeticTests.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineArithmeticTests.lean @@ -3,31 +3,35 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ - -import LeanPool.BeyondBethe.BeyondBethe.RawRational -import LeanPool.BeyondBethe.BeyondBethe.MachineBinaryMul -import LeanPool.BeyondBethe.BeyondBethe.MachineBinaryCompare -import LeanPool.BeyondBethe.BeyondBethe.MachineBinaryDivision -import LeanPool.BeyondBethe.BeyondBethe.MachineBinaryGCD -import LeanPool.BeyondBethe.BeyondBethe.MachineIntegerArithmetic -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalNormalization -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalArithmetic -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalUnary -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalCompare -import LeanPool.BeyondBethe.BeyondBethe.MachineDyadicFloor -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalFloor -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalLogSeries -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalExp -import LeanPool.BeyondBethe.BeyondBethe.MachineDirectedLog -import LeanPool.BeyondBethe.BeyondBethe.MachineMatrixNonnegative -import LeanPool.BeyondBethe.BeyondBethe.MachineMatrixSum -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalMin -import LeanPool.BeyondBethe.BeyondBethe.MachineFactorial -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalRowAdd -import LeanPool.BeyondBethe.BeyondBethe.MachineNearbyCoordinate +module + + +public import LeanPool.BeyondBethe.BeyondBethe.RawRational +public import LeanPool.BeyondBethe.BeyondBethe.MachineBinaryMul +public import LeanPool.BeyondBethe.BeyondBethe.MachineBinaryCompare +public import LeanPool.BeyondBethe.BeyondBethe.MachineBinaryDivision +public import LeanPool.BeyondBethe.BeyondBethe.MachineBinaryGCD +public import LeanPool.BeyondBethe.BeyondBethe.MachineIntegerArithmetic +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalNormalization +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalArithmetic +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalUnary +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalCompare +public import LeanPool.BeyondBethe.BeyondBethe.MachineDyadicFloor +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalFloor +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalLogSeries +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalExp +public import LeanPool.BeyondBethe.BeyondBethe.MachineDirectedLog +public import LeanPool.BeyondBethe.BeyondBethe.MachineMatrixNonnegative +public import LeanPool.BeyondBethe.BeyondBethe.MachineMatrixSum +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalMin +public import LeanPool.BeyondBethe.BeyondBethe.MachineFactorial +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalRowAdd +public import LeanPool.BeyondBethe.BeyondBethe.MachineNearbyCoordinate /-! # Machine Arithmetic Tests -/ +@[expose] public section + namespace BeyondBethe /-! Exhaustive executable smoke tests for the machine-arithmetic core. -/ @@ -76,6 +80,7 @@ theorem machineBinaryGcd_exhaustive_32_by_32 : (Nat.gcd a.val b.val).bits := by native_decide +/-- Generate the integer `n` or `-(n+1)` according to the negative flag. -/ def signedIntegerTest (negative : Bool) (n : ℕ) : ℤ := if negative then Int.negSucc n else Int.ofNat n @@ -100,12 +105,15 @@ theorem machineIntegerArithmetic_exhaustive_signed_16 : integerBinaryCode (-signedIntegerTest leftNegative a.val) := by native_decide +/-- The raw-rational test value `n/(d+1)`, including zero when `n = 0`. -/ def positiveRawRatTest (n d : ℕ) : RawRat := ⟨Int.ofNat n, d + 1, by omega⟩ +/-- The strictly negative raw-rational test value `-(n+1)/(d+1)`. -/ def negativeRawRatTest (n d : ℕ) : RawRat := ⟨Int.negSucc n, d + 1, by omega⟩ +/-- Choose between the negative and nonnegative raw-rational test families using the sign flag. -/ def signedRawRatTest (negative : Bool) (n d : ℕ) : RawRat := if negative then negativeRawRatTest n d else positiveRawRatTest n d @@ -211,6 +219,7 @@ theorem machineLengthBits_exhaustive_16 : machineLengthBits (List.replicate n.val true) = n.val.bits := by native_decide +/-- The strictly positive raw-rational test value `(n+1)/(d+1)`. -/ def positiveNonzeroRawRatTest (n d : ℕ) : RawRat := ⟨Int.ofNat (n + 1), d + 1, by omega⟩ diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineBetheAffineEntry.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineBetheAffineEntry.lean index 995b048112..412ad2be1e 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineBetheAffineEntry.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineBetheAffineEntry.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineBetheAffineLineSum -import LeanPool.BeyondBethe.BeyondBethe.MachineRowPairDisjoint -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalUnary + +public import LeanPool.BeyondBethe.BeyondBethe.MachineBetheAffineLineSum +public import LeanPool.BeyondBethe.BeyondBethe.MachineRowPairDisjoint +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalUnary /-! # Exact finite-word entries of the Birkhoff affine recovery @@ -17,33 +19,43 @@ row sum, one minus a column sum, and the total sum minus `m-1`. This file assembles those four cases as one uniform polynomial-time word machine. -/ +@[expose] public section + namespace BeyondBethe open Complexity +/-- Extract the unary dimension ruler from an affine-entry input word. -/ def machineBetheAffineEntryDimension (word : List Bool) : List Bool := machinePairFirst word +/-- Extract the row, column, and vector payload following the affine-entry dimension. -/ def machineBetheAffineEntryRest (word : List Bool) : List Bool := machinePairSecond word +/-- Extract the unary row index from an affine-entry input word. -/ def machineBetheAffineEntryRow (word : List Bool) : List Bool := machinePairFirst (machineBetheAffineEntryRest word) +/-- Extract the unary column index from an affine-entry input word. -/ def machineBetheAffineEntryColumn (word : List Bool) : List Bool := machinePairFirst (machinePairSecond (machineBetheAffineEntryRest word)) +/-- Extract the encoded affine-coordinate vector from an affine-entry input word. -/ def machineBetheAffineEntryVector (word : List Bool) : List Bool := machinePairSecond (machinePairSecond (machineBetheAffineEntryRest word)) +/-- Compare the row ruler with the dimension ruler to detect the last matrix row. -/ def machineBetheAffineEntryLastRowBit (word : List Bool) : List Bool := machineUnaryRulersEqualBit (machineBetheAffineEntryRow word) (machineBetheAffineEntryDimension word) +/-- Compare the column ruler with the dimension ruler to detect the last matrix column. -/ def machineBetheAffineEntryLastColumnBit (word : List Bool) : List Bool := machineUnaryRulersEqualBit (machineBetheAffineEntryColumn word) (machineBetheAffineEntryDimension word) +/-- Package the affine-entry data as a row-mode flattened-entry request. -/ def machineBetheAffineEntryFlatInput (word : List Bool) : List Bool := pair [true] (pair (machineBetheAffineEntryDimension word) @@ -51,48 +63,59 @@ def machineBetheAffineEntryFlatInput (word : List Bool) : List Bool := (pair (machineBetheAffineEntryColumn word) (machineBetheAffineEntryVector word)))) +/-- Evaluate an entry in the upper-left free block of the affine matrix. -/ def machineBetheAffineEntryUpperLeft (word : List Bool) : List Bool := machineBetheFlatEntryRawCode (machineBetheAffineEntryFlatInput word) +/-- Package a row-sum request for the free affine-coordinate block. -/ def machineBetheAffineEntryRowSumInput (word : List Bool) : List Bool := pair [true] (pair (machineBetheAffineEntryDimension word) (pair (machineBetheAffineEntryRow word) (machineBetheAffineEntryVector word))) +/-- Package a column-sum request for the free affine-coordinate block. -/ def machineBetheAffineEntryColumnSumInput (word : List Bool) : List Bool := pair [false] (pair (machineBetheAffineEntryDimension word) (pair (machineBetheAffineEntryColumn word) (machineBetheAffineEntryVector word))) +/-- Compute the encoded raw-rational sum of the selected free-block row. -/ def machineBetheAffineEntryRowSum (word : List Bool) : List Bool := machineBetheLineSumRawCode (machineBetheAffineEntryRowSumInput word) +/-- Compute the encoded raw-rational sum of the selected free-block column. -/ def machineBetheAffineEntryColumnSum (word : List Bool) : List Bool := machineBetheLineSumRawCode (machineBetheAffineEntryColumnSumInput word) +/-- Subtract the second encoded raw rational from the first by negation and addition. -/ def machineRawRatSubCode (word : List Bool) : List Bool := machineRawRatAddCode (pair (machinePairFirst word) (machineRawRatNegCode (machinePairSecond word))) +/-- Compute a last-column entry as one minus the corresponding free-block row sum. -/ def machineBetheAffineEntryLastColumn (word : List Bool) : List Bool := machineRawRatSubCode (pair (rawRatBinaryCode RawRat.one) (machineBetheAffineEntryRowSum word)) +/-- Compute a last-row entry as one minus the corresponding free-block column sum. -/ def machineBetheAffineEntryLastRow (word : List Bool) : List Bool := machineRawRatSubCode (pair (rawRatBinaryCode RawRat.one) (machineBetheAffineEntryColumnSum word)) +/-- Compute the encoded raw-rational sum of all free affine coordinates. -/ def machineBetheAffineEntryTotal (word : List Bool) : List Bool := machineRationalVectorRawSumCode (machineBetheAffineEntryVector word) +/-- Convert the unary affine dimension ruler to its binary length. -/ def machineBetheAffineEntryDimensionBits (word : List Bool) : List Bool := machineLengthBits (machineBetheAffineEntryDimension word) +/-- Encode the affine dimension minus one as a signed integer. -/ def machineBetheAffineEntryDimensionMinusOneInteger (word : List Bool) : List Bool := machineIntegerAddCode @@ -100,16 +123,19 @@ def machineBetheAffineEntryDimensionMinusOneInteger (machineBetheAffineEntryDimensionBits word)) (integerBinaryCode (-1))) +/-- Encode the affine dimension minus one as a raw rational with denominator one. -/ def machineBetheAffineEntryDimensionMinusOneRaw (word : List Bool) : List Bool := pair (machineBetheAffineEntryDimensionMinusOneInteger word) (1 : ℕ).bits +/-- Compute the corner entry as the total free-coordinate sum minus `(m-1)`. -/ def machineBetheAffineEntryCorner (word : List Bool) : List Bool := machineRawRatSubCode (pair (machineBetheAffineEntryTotal word) (machineBetheAffineEntryDimensionMinusOneRaw word)) +/-- Select the free-block, last-row, last-column, or corner formula for an affine matrix entry. -/ def machineBetheAffineEntryRawCode (word : List Bool) : List Bool := machineIfHead (machineBetheAffineEntryLastRowBit word) (machineIfHead (machineBetheAffineEntryLastColumnBit word) @@ -269,15 +295,20 @@ theorem machineBetheAffineEntryRawCode_mem_FP : /-! ## Exact semantics -/ +/-- The canonical affine-entry input word containing unary dimension and indices and the encoded +rational vector. -/ def machineBetheAffineEntryCanonicalWord {m : ℕ} (i j : Fin (m + 1)) (y : Fin (m * m) → ℚ) : List Bool := pair (List.replicate m true) (pair (List.replicate i.1 true) (pair (List.replicate j.1 true) (rationalFiniteVectorCode y))) +/-- The raw rational representing the integer `m-1`. -/ def rawBetheDimensionMinusOne (m : ℕ) : RawRat := ⟨(m : ℤ) - 1, 1, by norm_num⟩ +/-- The raw-rational affine matrix entry, completing the border from row sums, column sums, and +the total free-coordinate sum. -/ def rawBetheAffineEntry {m : ℕ} (y : Fin (m * m) → ℚ) (i j : Fin (m + 1)) : RawRat := Fin.lastCases diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineBetheAffineLineSum.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineBetheAffineLineSum.lean index de544de834..9d59fb1d77 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineBetheAffineLineSum.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineBetheAffineLineSum.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.BetheEpigraph -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalVectorSum -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalTransposeMulVector + +public import LeanPool.BeyondBethe.BeyondBethe.BetheEpigraph +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalVectorSum +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalTransposeMulVector /-! # Finite-word row and column sums for Birkhoff affine coordinates @@ -19,41 +21,53 @@ the machine is unary and is obtained from verified binary multiplication and addition under the complete input word as a guard. -/ +@[expose] public section + namespace BeyondBethe open Complexity /-! ## A verified flattened-coordinate lookup -/ +/-- Extract the row-versus-column mode word from a flattened-index request. -/ def machineBetheFlatIndexMode (word : List Bool) : List Bool := machinePairFirst word +/-- Extract the payload following the flattened-index mode word. -/ def machineBetheFlatIndexRest (word : List Bool) : List Bool := machinePairSecond word +/-- Extract the unary dimension ruler from a flattened-index request. -/ def machineBetheFlatIndexDimension (word : List Bool) : List Bool := machinePairFirst (machineBetheFlatIndexRest word) +/-- Extract the unary fixed row or column index from a flattened-index request. -/ def machineBetheFlatIndexFixed (word : List Bool) : List Bool := machinePairFirst (machinePairSecond (machineBetheFlatIndexRest word)) +/-- Extract the unary varying index from a flattened-index request. -/ def machineBetheFlatIndexCurrent (word : List Bool) : List Bool := machinePairFirst (machinePairSecond (machinePairSecond (machineBetheFlatIndexRest word))) +/-- Extract the encoded rational vector carried by a flattened-index request. -/ def machineBetheFlatIndexVector (word : List Bool) : List Bool := machinePairSecond (machinePairSecond (machinePairSecond (machineBetheFlatIndexRest word))) +/-- Convert the flattened-index dimension ruler to binary. -/ def machineBetheFlatIndexDimensionBits (word : List Bool) : List Bool := machineLengthBits (machineBetheFlatIndexDimension word) +/-- Convert the fixed-index ruler to binary. -/ def machineBetheFlatIndexFixedBits (word : List Bool) : List Bool := machineLengthBits (machineBetheFlatIndexFixed word) +/-- Convert the varying-index ruler to binary. -/ def machineBetheFlatIndexCurrentBits (word : List Bool) : List Bool := machineLengthBits (machineBetheFlatIndexCurrent word) +/-- Compute the binary row-mode offset `fixed * dimension + current`. -/ def machineBetheFlatIndexRowBits (word : List Bool) : List Bool := machineBinaryAddBits (pair @@ -62,6 +76,7 @@ def machineBetheFlatIndexRowBits (word : List Bool) : List Bool := (machineBetheFlatIndexDimensionBits word))) (machineBetheFlatIndexCurrentBits word)) +/-- Compute the binary column-mode offset `current * dimension + fixed`. -/ def machineBetheFlatIndexColumnBits (word : List Bool) : List Bool := machineBinaryAddBits (pair @@ -70,11 +85,13 @@ def machineBetheFlatIndexColumnBits (word : List Bool) : List Bool := (machineBetheFlatIndexDimensionBits word))) (machineBetheFlatIndexFixedBits word)) +/-- Select the binary flattened offset according to the row-versus-column mode. -/ def machineBetheFlatIndexBits (word : List Bool) : List Bool := machineIfHead (machineBetheFlatIndexMode word) (machineBetheFlatIndexRowBits word) (machineBetheFlatIndexColumnBits word) +/-- Convert the flattened binary index to a unary ruler bounded by the input word. -/ def machineBetheFlatIndexRuler (word : List Bool) : List Bool := machineBoundedUnary (pair word (machineBetheFlatIndexBits word)) @@ -183,6 +200,7 @@ theorem machineBetheFlatEntryRawCode_mem_FP : simpa only [machineBetheFlatEntryRawCode] using! machineCompose_mem_FP hinput machineListIndex_mem_FP +/-- The canonical flattened-index request with mode, unary indices, and rational-vector payload. -/ def betheFlatIndexCanonicalWord {m : ℕ} (rowMode : Bool) (fixed current : Fin m) (y : Fin (m * m) → ℚ) : List Bool := pair [rowMode] @@ -347,42 +365,55 @@ theorem bethe_flat_index_lt_word_length {m : ℕ} (rowMode : Bool) /-! ## A bounded exact line-sum iteration -/ +/-- Extract the row-versus-column mode from a line-sum request. -/ def machineBetheLineSumMode (word : List Bool) : List Bool := machinePairFirst word +/-- Extract the payload following the line-sum mode word. -/ def machineBetheLineSumRest (word : List Bool) : List Bool := machinePairSecond word +/-- Extract the unary dimension ruler from a line-sum request. -/ def machineBetheLineSumDimension (word : List Bool) : List Bool := machinePairFirst (machineBetheLineSumRest word) +/-- Extract the unary fixed row or column index from a line-sum request. -/ def machineBetheLineSumFixed (word : List Bool) : List Bool := machinePairFirst (machinePairSecond (machineBetheLineSumRest word)) +/-- Extract the encoded rational vector from a line-sum request. -/ def machineBetheLineSumVector (word : List Bool) : List Bool := machinePairSecond (machinePairSecond (machineBetheLineSumRest word)) +/-- Encode the remaining count, current index, accumulator, payload, and bound of a line-sum +state. -/ def machineBetheLineSumPack (remaining current acc payload bound : List Bool) : List Bool := pair remaining (pair current (pair acc (pair payload bound))) +/-- Extract the remaining-iteration ruler from a line-sum state. -/ def machineBetheLineSumRemaining (state : List Bool) : List Bool := machinePairFirst state +/-- Extract the current-index ruler from a line-sum state. -/ def machineBetheLineSumCurrent (state : List Bool) : List Bool := machinePairFirst (machinePairSecond state) +/-- Extract the encoded raw-rational accumulator from a line-sum state. -/ def machineBetheLineSumAccumulator (state : List Bool) : List Bool := machinePairFirst (machinePairSecond (machinePairSecond state)) +/-- Extract the original line-sum request retained in the state. -/ def machineBetheLineSumPayload (state : List Bool) : List Bool := machinePairFirst (machinePairSecond (machinePairSecond (machinePairSecond state))) +/-- Extract the word whose length bounds the line-sum accumulator. -/ def machineBetheLineSumBound (state : List Bool) : List Bool := machinePairSecond (machinePairSecond (machinePairSecond (machinePairSecond state))) +/-- Build the flattened-entry request for the current position in the line-sum scan. -/ def machineBetheLineSumEntryInput (state : List Bool) : List Bool := let payload := machineBetheLineSumPayload state pair (machineBetheLineSumMode payload) @@ -391,18 +422,22 @@ def machineBetheLineSumEntryInput (state : List Bool) : List Bool := (pair (machineBetheLineSumCurrent state) (machineBetheLineSumVector payload)))) +/-- Evaluate the encoded raw-rational entry at the current scan position. -/ def machineBetheLineSumEntry (state : List Bool) : List Bool := machineBetheFlatEntryRawCode (machineBetheLineSumEntryInput state) +/-- Add the current entry to the encoded line-sum accumulator. -/ def machineBetheLineSumCandidate (state : List Bool) : List Bool := machineRawRatAddCode (pair (machineBetheLineSumAccumulator state) (machineBetheLineSumEntry state)) +/-- Truncate the candidate accumulator code to the stored bound length. -/ def machineBetheLineSumNextAccumulator (state : List Bool) : List Bool := (machineBetheLineSumCandidate state).take (machineBetheLineSumBound state).length +/-- Consume one remaining position, advance the unary index, and store the bounded updated sum. -/ def machineBetheLineSumAdvance (state : List Bool) : List Bool := machineBetheLineSumPack (machineBetheLineSumRemaining state).tail @@ -411,26 +446,33 @@ def machineBetheLineSumAdvance (state : List Bool) : List Bool := (machineBetheLineSumPayload state) (machineBetheLineSumBound state) +/-- Leave a completed line-sum state unchanged, otherwise advance one position. -/ def machineBetheLineSumStep (state : List Bool) : List Bool := machineIfEmpty (machineBetheLineSumRemaining state) state (machineBetheLineSumAdvance state) +/-- Construct the line-sum bound word by applying the multiplication-width construction twice. -/ def machineBetheLineSumInputBound (word : List Bool) : List Bool := machineBinaryMulWidth (machineBinaryMulWidth word) +/-- Initialize the line-sum scan at index zero with a zero accumulator and the full dimension +ruler. -/ def machineBetheLineSumInit (word : List Bool) : List Bool := machineBetheLineSumPack (machineBetheLineSumDimension word) [] (rawRatBinaryCode RawRat.zero) word (machineBetheLineSumInputBound word) +/-- The packed width witness formed from five copies of the line-sum input bound word. -/ def machineBetheLineSumWidth (word : List Bool) : List Bool := let bound := machineBetheLineSumInputBound word machineBetheLineSumPack bound bound bound bound bound +/-- Iterate the line-sum transition as many times as the dimension ruler length. -/ def machineBetheLineSumFinalState (word : List Bool) : List Bool := (machineBetheLineSumStep)^[(machineBetheLineSumDimension word).length] (machineBetheLineSumInit word) +/-- Extract the raw-rational sum code from the final line-sum state. -/ def machineBetheLineSumRawCode (word : List Bool) : List Bool := machineBetheLineSumAccumulator (machineBetheLineSumFinalState word) @@ -579,6 +621,8 @@ theorem machineBetheLineSumWidth_mem_FP : machineBetheLineSumWidth ∈ FP := by machineBetheLineSumBound (machineBetheLineSumPack a b c d e) = e := by simp [machineBetheLineSumBound, machineBetheLineSumPack] +/-- The line-sum state invariant: canonical packing, bounded counters and payloads, and the +fixed input bound. -/ def MachineBetheLineSumStateBound (word state : List Bool) : Prop := let B := (machineBetheLineSumInputBound word).length state = machineBetheLineSumPack @@ -696,6 +740,8 @@ theorem machineBetheLineSumRawCode_mem_FP : /-! ## Exactness and absence of truncation on canonical inputs -/ +/-- The canonical line-sum request encoding the mode, dimension, fixed index, and rational +vector. -/ def machineBetheLineSumCanonicalWord {m : ℕ} (rowMode : Bool) (fixed : Fin m) (y : Fin (m * m) → ℚ) : List Bool := pair [rowMode] @@ -703,12 +749,14 @@ def machineBetheLineSumCanonicalWord {m : ℕ} (rowMode : Bool) (pair (List.replicate fixed.1 true) (rationalFiniteVectorCode y))) +/-- List the free affine-coordinate values along the selected row or column. -/ def betheAffineLineValues {m : ℕ} (rowMode : Bool) (fixed : Fin m) (y : Fin (m * m) → ℚ) : List ℚ := List.ofFn fun current : Fin m ↦ if rowMode then y (finProdFinEquiv (fixed, current)) else y (finProdFinEquiv (current, fixed)) +/-- Sum the selected affine-coordinate row or column with raw-rational arithmetic. -/ def rawBetheAffineLineSum {m : ℕ} (rowMode : Bool) (fixed : Fin m) (y : Fin (m * m) → ℚ) : RawRat := rawRatListSum RawRat.zero (betheAffineLineValues rowMode fixed y) @@ -852,6 +900,8 @@ theorem rawBetheAffineLinePrefix_succ {m : ℕ} (rowMode : Bool) simp only [rawRatListSum, List.getElem_ofFn, values, betheAffineLineValues] +/-- The semantic scan state after `k` positions, with the prefix sum and corresponding unary +counters. -/ def machineBetheLineSumSemanticState {m : ℕ} (rowMode : Bool) (fixed : Fin m) (y : Fin (m * m) → ℚ) (k : ℕ) : List Bool := let word := machineBetheLineSumCanonicalWord rowMode fixed y diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineBetheEpigraphOracle.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineBetheEpigraphOracle.lean index 41e9a3d608..0c680880f3 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineBetheEpigraphOracle.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineBetheEpigraphOracle.lean @@ -3,16 +3,18 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineBinaryListInit -import LeanPool.BeyondBethe.BeyondBethe.MachineBetheFloorCutVector -import LeanPool.BeyondBethe.BeyondBethe.MachineBetheHeightNormal -import LeanPool.BeyondBethe.BeyondBethe.MachineDirectedEpigraphNormal -import LeanPool.BeyondBethe.BeyondBethe.MachineBetheHeightCap -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalEllipsoidEncoding -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalPower -import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerInteriorScale -import LeanPool.BeyondBethe.BeyondBethe.BetheEpigraphFeasibility + +public import LeanPool.BeyondBethe.BeyondBethe.MachineBinaryListInit +public import LeanPool.BeyondBethe.BeyondBethe.MachineBetheFloorCutVector +public import LeanPool.BeyondBethe.BeyondBethe.MachineBetheHeightNormal +public import LeanPool.BeyondBethe.BeyondBethe.MachineDirectedEpigraphNormal +public import LeanPool.BeyondBethe.BeyondBethe.MachineBetheHeightCap +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalEllipsoidEncoding +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalPower +public import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerInteriorScale +public import LeanPool.BeyondBethe.BeyondBethe.BetheEpigraphFeasibility /-! # A finite-word oracle for the bounded Bethe epigraph @@ -24,6 +26,8 @@ their mathematical order: an exact floor scan, the exact height-cap test, and the directed nonlinear objective test. -/ +@[expose] public section + namespace BeyondBethe open Complexity @@ -36,42 +40,55 @@ open Complexity def machineBetheOracleDimension (word : List Bool) : List Bool := machinePairFirst word +/-- Extract the oracle input payload following the dimension word. -/ def machineBetheOracleRest (word : List Bool) : List Bool := machinePairSecond word +/-- Extract the precision ruler from a Bethe oracle input word. -/ def machineBetheOraclePrecision (word : List Bool) : List Bool := machinePairFirst (machineBetheOracleRest word) +/-- Extract the oracle payload following the precision ruler. -/ def machineBetheOracleAfterPrecision (word : List Bool) : List Bool := machinePairSecond (machineBetheOracleRest word) +/-- Extract the encoded regularization parameter from a Bethe oracle input word. -/ def machineBetheOracleTau (word : List Bool) : List Bool := machinePairFirst (machineBetheOracleAfterPrecision word) +/-- Extract the oracle payload following the regularization parameter. -/ def machineBetheOracleAfterTau (word : List Bool) : List Bool := machinePairSecond (machineBetheOracleAfterPrecision word) +/-- Extract the encoded affine-coordinate floor from a Bethe oracle input word. -/ def machineBetheOracleDelta (word : List Bool) : List Bool := machinePairFirst (machineBetheOracleAfterTau word) +/-- Extract the oracle payload following the coordinate floor. -/ def machineBetheOracleAfterDelta (word : List Bool) : List Bool := machinePairSecond (machineBetheOracleAfterTau word) +/-- Extract the encoded epigraph height cap from a Bethe oracle input word. -/ def machineBetheOracleUpper (word : List Bool) : List Bool := machinePairFirst (machineBetheOracleAfterDelta word) +/-- Extract the matrix and ellipsoid payload following the height cap. -/ def machineBetheOracleAfterUpper (word : List Bool) : List Bool := machinePairSecond (machineBetheOracleAfterDelta word) +/-- Extract the encoded rational matrix from a Bethe oracle input word. -/ def machineBetheOracleMatrix (word : List Bool) : List Bool := machinePairFirst (machineBetheOracleAfterUpper word) +/-- Extract the encoded rational ellipsoid state from a Bethe oracle input word. -/ def machineBetheOracleEllipsoid (word : List Bool) : List Bool := machinePairSecond (machineBetheOracleAfterUpper word) +/-- Extract the encoded center vector of the oracle ellipsoid. -/ def machineBetheOracleCenter (word : List Bool) : List Bool := machineRationalEllipsoidCenterWord (machineBetheOracleEllipsoid word) +/-- Remove the final epigraph-height coordinate from the encoded center vector. -/ def machineBetheOracleBase (word : List Bool) : List Bool := machineBinaryListInit (machineBetheOracleCenter word) @@ -149,82 +166,104 @@ theorem machineBetheOracleBase_mem_FP : machineBetheOracleBase ∈ FP := by /-! ## Derived dimension and the three branch tests -/ +/-- Convert the oracle dimension ruler to binary. -/ def machineBetheOracleDimensionBits (word : List Bool) : List Bool := machineLengthBits (machineBetheOracleDimension word) +/-- Compute the squared dimension, the number of free affine coordinates, in binary. -/ def machineBetheOracleBaseDimensionBits (word : List Bool) : List Bool := machineBinaryMulBits (pair (machineBetheOracleDimensionBits word) (machineBetheOracleDimensionBits word)) +/-- Convert the free-coordinate count to a unary ruler bounded by the base-coordinate word. -/ def machineBetheOracleBaseDimensionUnary (word : List Bool) : List Bool := machineBoundedUnary (pair (machineBetheOracleBase word) (machineBetheOracleBaseDimensionBits word)) +/-- Encode the number of free affine coordinates as a raw rational with denominator one. -/ def machineBetheOracleBaseDimensionRawCode (word : List Bool) : List Bool := pair (machineNaturalIntegerCode (machineBetheOracleBaseDimensionBits word)) [true] +/-- Package the dimension, floor, and center base coordinates for the floor-violation scan. -/ def machineBetheOracleFloorScanInput (word : List Bool) : List Bool := pair (machineBetheOracleDimension word) (pair (machineBetheOracleDelta word) (machineBetheOracleBase word)) +/-- Run the affine-coordinate floor scan on the oracle center. -/ def machineBetheOracleFloorScanResult (word : List Bool) : List Bool := machineBetheFloorScanResultCode (machineBetheOracleFloorScanInput word) +/-- Extract the bit reporting whether the floor scan found a violation. -/ def machineBetheOracleFloorFoundBit (word : List Bool) : List Bool := machineHeadBit (machinePairFirst (machineBetheOracleFloorScanResult word)) +/-- Extract the reported row ruler from the floor-scan result. -/ def machineBetheOracleFloorRow (word : List Bool) : List Bool := machinePairFirst (machinePairSecond (machineBetheOracleFloorScanResult word)) +/-- Extract the reported column ruler from the floor-scan result. -/ def machineBetheOracleFloorColumn (word : List Bool) : List Bool := machinePairSecond (machinePairSecond (machineBetheOracleFloorScanResult word)) +/-- Package the base dimension, height cap, and center for the height-cap test. -/ def machineBetheOracleHeightInput (word : List Bool) : List Bool := pair (machineBetheOracleBaseDimensionUnary word) (pair (machineBetheOracleUpper word) (machineBetheOracleCenter word)) +/-- Test whether the center epigraph height violates the prescribed cap. -/ def machineBetheOracleHeightViolationBit (word : List Bool) : List Bool := machineBetheHeightCapViolationBit (machineBetheOracleHeightInput word) +/-- Extract the center epigraph height as a raw-rational code. -/ def machineBetheOracleHeightRawCode (word : List Bool) : List Bool := machineBetheHeightCapEntryCode (machineBetheOracleHeightInput word) +/-- The raw-rational constant sixteen used in the oracle error margin. -/ def rawBetheOracleSixteen : RawRat := RawRat.ofNat 16 +/-- Compute the raw-rational code of one half raised to the oracle precision. -/ def machineBetheOracleHalfPowerRawCode (word : List Bool) : List Bool := machineRawRatPowerCode (pair (machineBetheOraclePrecision word) (rawRatBinaryCode rawOptimizerHalf)) +/-- Compute the raw-rational error scale `16 * (1/2)^p`. -/ def machineBetheOracleScaledErrorRawCode (word : List Bool) : List Bool := machineRawRatMulCode (pair (rawRatBinaryCode rawBetheOracleSixteen) (machineBetheOracleHalfPowerRawCode word)) +/-- Multiply the directed error scale by the number of free affine coordinates. -/ def machineBetheOracleMarginRawCode (word : List Bool) : List Bool := machineRawRatMulCode (pair (machineBetheOracleScaledErrorRawCode word) (machineBetheOracleBaseDimensionRawCode word)) +/-- Package dimension, precision, regularization, matrix, and base coordinates for objective +evaluation. -/ def machineBetheOracleObjectiveInput (word : List Bool) : List Bool := pair (machineBetheOracleDimension word) (pair (machineBetheOraclePrecision word) (pair (machineBetheOracleTau word) (pair (machineBetheOracleMatrix word) (machineBetheOracleBase word)))) +/-- Evaluate the directed lower negative-objective sum at the oracle center base coordinates. -/ def machineBetheOracleLowerRawCode (word : List Bool) : List Bool := machineDirectedNegativeObjectiveSumRawCode (machineBetheOracleObjectiveInput word) +/-- Add the evaluation margin to the center epigraph height. -/ def machineBetheOracleHeightPlusMarginRawCode (word : List Bool) : List Bool := machineRawRatAddCode (pair (machineBetheOracleHeightRawCode word) (machineBetheOracleMarginRawCode word)) +/-- Detect when the directed lower objective exceeds the center height plus the evaluation +margin. -/ def machineBetheOracleNonlinearViolationBit (word : List Bool) : List Bool := machineNotBit @@ -364,27 +403,34 @@ theorem machineBetheOracleNonlinearViolationBit_mem_FP : /-! ## Cut construction and final response -/ +/-- Package the dimension and violating entry indices for a floor-cut normal. -/ def machineBetheOracleFloorNormalInput (word : List Bool) : List Bool := pair (machineBetheOracleDimension word) (pair (machineBetheOracleFloorRow word) (machineBetheOracleFloorColumn word)) +/-- Encode a cutting response with the normal for the detected floor violation. -/ def machineBetheOracleFloorResponse (word : List Bool) : List Bool := pair [true] (machineBetheFloorCutVectorCode (machineBetheOracleFloorNormalInput word)) +/-- Encode a cutting response with the epigraph height-cap normal. -/ def machineBetheOracleHeightResponse (word : List Bool) : List Bool := pair [true] (machineBetheHeightNormalVectorCode (machineBetheOracleDimension word)) +/-- Encode a cutting response with the directed nonlinear epigraph normal. -/ def machineBetheOracleNonlinearResponse (word : List Bool) : List Bool := pair [true] (machineDirectedEpigraphNormalVectorCode (machineBetheOracleObjectiveInput word)) +/-- The encoded acceptance response, carrying no cut vector. -/ def machineBetheOracleAcceptResponse (_word : List Bool) : List Bool := pair [false] [] +/-- Choose the floor, height-cap, or nonlinear cut in that order, accepting when none is +required. -/ def machineBetheEpigraphOracleResponseCode (word : List Bool) : List Bool := machineIfHead (machineBetheOracleFloorFoundBit word) (machineBetheOracleFloorResponse word) @@ -438,6 +484,8 @@ theorem machineBetheEpigraphOracleResponseCode_mem_FP : /-! ## Canonical semantics -/ +/-- The canonical Bethe oracle input word containing its scalar parameters, matrix, and +ellipsoid state. -/ def machineBetheOracleCanonicalWord {m : ℕ} (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) (p : ℕ) (delta upper : RawRat) @@ -690,6 +738,7 @@ theorem betheOracle_baseDimension_le_baseCodeLength {m : ℕ} machineBetheHeightCapEntryCode_encode] rfl +/-- The raw-rational oracle margin `16 * (1/2)^p * m^2`. -/ def rawBetheOracleMargin (m p : ℕ) : RawRat := (rawBetheOracleSixteen.mul (rawOptimizerHalf.pow p)).mul (RawRat.ofNat (m * m)) diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineBetheFeasibilityFit.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineBetheFeasibilityFit.lean index 0488995752..5ef6a219f7 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineBetheFeasibilityFit.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineBetheFeasibilityFit.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineScheduledStateEncodingBound -import Mathlib.Tactic + +public import LeanPool.BeyondBethe.BeyondBethe.MachineScheduledStateEncodingBound +public import Mathlib.Tactic /-! # The canonical Bethe feasibility run always fits its finite-word ruler @@ -16,13 +18,19 @@ discharges the last side condition in the program-correctness theorem for the feasibility machine. -/ +@[expose] public section + namespace BeyondBethe +/-- The ellipsoid state-code bound obtained from the scheduled magnitude and rounding-precision +budgets. -/ def scheduledFeasibilityStateCodeBound (d L K T : ℕ) : ℕ := rationalEllipsoidMachineCodeBound d (K + T * (6 + 3 * d)) (roundedEllipsoidPrecisionSchedule d L K T + 10 + 4 * d) +/-- Specialize the scheduled state-code bound to the initial ball determinant and magnitude +budgets. -/ def explicitBallFeasibilityStateCodeBound (d T : ℕ) (R : ℚ) : ℕ := scheduledFeasibilityStateCodeBound d (explicitBallInitialDetExponent d R) diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineBetheFeasibilityLoop.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineBetheFeasibilityLoop.lean index d102f0a905..a1dbf7e2d3 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineBetheFeasibilityLoop.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineBetheFeasibilityLoop.lean @@ -3,11 +3,13 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineBetheEpigraphOracle -import LeanPool.BeyondBethe.BeyondBethe.MachineScheduledRoundedEllipsoid -import LeanPool.BeyondBethe.BeyondBethe.ScannedBetheThresholdFeasibility -import Mathlib.Tactic + +public import LeanPool.BeyondBethe.BeyondBethe.MachineBetheEpigraphOracle +public import LeanPool.BeyondBethe.BeyondBethe.MachineScheduledRoundedEllipsoid +public import LeanPool.BeyondBethe.BeyondBethe.ScannedBetheThresholdFeasibility +public import Mathlib.Tactic /-! # A finite-word fixed-precision Bethe feasibility loop @@ -18,6 +20,8 @@ makes the iteration polynomial-time on every malformed input. A separate semantic predicate records that the clamp is inactive on the canonical run. -/ +@[expose] public section + namespace BeyondBethe open Complexity @@ -34,53 +38,68 @@ The oracle-static word has layout def machineBetheFeasibilityBudget (word : List Bool) : List Bool := machinePairFirst word +/-- Extract the feasibility input payload following its iteration budget. -/ def machineBetheFeasibilityAfterBudget (word : List Bool) : List Bool := machinePairSecond word +/-- Extract the state-code bound word from a feasibility input. -/ def machineBetheFeasibilityBound (word : List Bool) : List Bool := machinePairFirst (machineBetheFeasibilityAfterBudget word) +/-- Extract the feasibility payload following the state-code bound word. -/ def machineBetheFeasibilityAfterBound (word : List Bool) : List Bool := machinePairSecond (machineBetheFeasibilityAfterBudget word) +/-- Extract the rounding-precision ruler from a feasibility input. -/ def machineBetheFeasibilityRoundingPrecision (word : List Bool) : List Bool := machinePairFirst (machineBetheFeasibilityAfterBound word) +/-- Extract the static oracle data and initial ellipsoid payload. -/ def machineBetheFeasibilityStaticAndInitial (word : List Bool) : List Bool := machinePairSecond (machineBetheFeasibilityAfterBound word) +/-- Extract the static oracle data retained throughout the feasibility iteration. -/ def machineBetheFeasibilityOracleStatic (word : List Bool) : List Bool := machinePairFirst (machineBetheFeasibilityStaticAndInitial word) +/-- Extract the initial ellipsoid code from the feasibility input. -/ def machineBetheFeasibilityInitialEllipsoid (word : List Bool) : List Bool := machinePairSecond (machineBetheFeasibilityStaticAndInitial word) /-! ## Iteration state -/ +/-- Encode the acceptance flag, original input, current ellipsoid, and bound as a feasibility +state. -/ def machineBetheFeasibilityStatePack (accepted source ellipsoid bound : List Bool) : List Bool := pair accepted (pair source (pair ellipsoid bound)) +/-- Extract the acceptance-flag word from a feasibility state. -/ def machineBetheFeasibilityStateAccepted (state : List Bool) : List Bool := machinePairFirst state +/-- Extract the original feasibility input retained in the state. -/ def machineBetheFeasibilityStateSource (state : List Bool) : List Bool := machinePairFirst (machinePairSecond state) +/-- Extract the current ellipsoid code from a feasibility state. -/ def machineBetheFeasibilityStateEllipsoid (state : List Bool) : List Bool := machinePairFirst (machinePairSecond (machinePairSecond state)) +/-- Extract the stored bound word from a feasibility state. -/ def machineBetheFeasibilityStateBound (state : List Bool) : List Bool := machinePairSecond (machinePairSecond (machinePairSecond state)) +/-- Initialize feasibility with a false acceptance flag and the supplied initial ellipsoid and +code bound. -/ def machineBetheFeasibilityInit (word : List Bool) : List Bool := machineBetheFeasibilityStatePack [false] word (machineBetheFeasibilityInitialEllipsoid word) @@ -88,50 +107,63 @@ def machineBetheFeasibilityInit (word : List Bool) : List Bool := /-! ## One oracle/update step -/ +/-- Extract the static oracle dimension ruler from a feasibility state. -/ def machineBetheFeasibilityStaticDimension (state : List Bool) : List Bool := machinePairFirst (machineBetheFeasibilityOracleStatic (machineBetheFeasibilityStateSource state)) +/-- Extract the static oracle payload following the dimension ruler. -/ def machineBetheFeasibilityStaticRest (state : List Bool) : List Bool := machinePairSecond (machineBetheFeasibilityOracleStatic (machineBetheFeasibilityStateSource state)) +/-- Extract the static oracle precision ruler from a feasibility state. -/ def machineBetheFeasibilityStaticOraclePrecision (state : List Bool) : List Bool := machinePairFirst (machineBetheFeasibilityStaticRest state) +/-- Extract the static oracle payload following its precision ruler. -/ def machineBetheFeasibilityStaticAfterPrecision (state : List Bool) : List Bool := machinePairSecond (machineBetheFeasibilityStaticRest state) +/-- Extract the static regularization parameter from a feasibility state. -/ def machineBetheFeasibilityStaticTau (state : List Bool) : List Bool := machinePairFirst (machineBetheFeasibilityStaticAfterPrecision state) +/-- Extract the static oracle payload following the regularization parameter. -/ def machineBetheFeasibilityStaticAfterTau (state : List Bool) : List Bool := machinePairSecond (machineBetheFeasibilityStaticAfterPrecision state) +/-- Extract the raw-rational floor parameter from the immutable feasibility oracle data. -/ def machineBetheFeasibilityStaticDelta (state : List Bool) : List Bool := machinePairFirst (machineBetheFeasibilityStaticAfterTau state) +/-- The immutable oracle payload following the floor parameter, containing the upper threshold +and matrix. -/ def machineBetheFeasibilityStaticAfterDelta (state : List Bool) : List Bool := machinePairSecond (machineBetheFeasibilityStaticAfterTau state) +/-- Extract the raw-rational objective upper threshold from the immutable oracle data. -/ def machineBetheFeasibilityStaticUpper (state : List Bool) : List Bool := machinePairFirst (machineBetheFeasibilityStaticAfterDelta state) +/-- Extract the encoded rational matrix from the immutable oracle data. -/ def machineBetheFeasibilityStaticMatrix (state : List Bool) : List Bool := machinePairSecond (machineBetheFeasibilityStaticAfterDelta state) +/-- Package the static dimension, precision, regularization, floor, upper threshold, and matrix +with the current ellipsoid for an oracle call. -/ def machineBetheFeasibilityOracleInput (state : List Bool) : List Bool := pair (machineBetheFeasibilityStaticDimension state) @@ -142,21 +174,27 @@ def machineBetheFeasibilityOracleInput (pair (machineBetheFeasibilityStaticMatrix state) (machineBetheFeasibilityStateEllipsoid state)))))) +/-- Run the encoded bounded Bethe epigraph oracle on the current feasibility state. -/ def machineBetheFeasibilityOracleResponse (state : List Bool) : List Bool := machineBetheEpigraphOracleResponseCode (machineBetheFeasibilityOracleInput state) +/-- The oracle response bit, which selects a cut when true and acceptance when false. -/ def machineBetheFeasibilityResponseTag (state : List Bool) : List Bool := machineHeadBit (machineRationalTaggedResultTag (machineBetheFeasibilityOracleResponse state)) +/-- Extract the payload of the tagged oracle response, used as the cut normal when a cut is +returned. -/ def machineBetheFeasibilityResponsePayload (state : List Bool) : List Bool := machineRationalTaggedResultPayload (machineBetheFeasibilityOracleResponse state) +/-- Package the stored rounding precision, current ellipsoid, and oracle cut payload for the +scheduled update. -/ def machineBetheFeasibilityScheduledUpdateInput (state : List Bool) : List Bool := pair (machineBetheFeasibilityRoundingPrecision @@ -164,16 +202,21 @@ def machineBetheFeasibilityScheduledUpdateInput (pair (machineBetheFeasibilityStateEllipsoid state) (machineBetheFeasibilityResponsePayload state)) +/-- Compute the scheduled rounded central-cut ellipsoid before imposing the stored code-length +bound. -/ def machineBetheFeasibilityUpdatedEllipsoidCandidate (state : List Bool) : List Bool := machineScheduledRoundedEllipsoidCentralUpdateCode (machineBetheFeasibilityScheduledUpdateInput state) +/-- Truncate the candidate ellipsoid code to the length of the state-bound word. -/ def machineBetheFeasibilityUpdatedEllipsoid (state : List Bool) : List Bool := (machineBetheFeasibilityUpdatedEllipsoidCandidate state).take (machineBetheFeasibilityStateBound state).length +/-- Store an unaccepted state with the truncated updated ellipsoid, retaining the source call +and bound. -/ def machineBetheFeasibilityCutState (state : List Bool) : List Bool := machineBetheFeasibilityStatePack [false] @@ -181,6 +224,7 @@ def machineBetheFeasibilityCutState (machineBetheFeasibilityUpdatedEllipsoid state) (machineBetheFeasibilityStateBound state) +/-- Mark the current state accepted while retaining its source call, ellipsoid, and bound. -/ def machineBetheFeasibilityAcceptState (state : List Bool) : List Bool := machineBetheFeasibilityStatePack [true] @@ -188,6 +232,8 @@ def machineBetheFeasibilityAcceptState (machineBetheFeasibilityStateEllipsoid state) (machineBetheFeasibilityStateBound state) +/-- Leave an accepted state fixed; otherwise perform the oracle's cut update or mark the current +ellipsoid accepted. -/ def machineBetheFeasibilityStep (state : List Bool) : List Bool := machineIfHead (machineHeadBit (machineBetheFeasibilityStateAccepted state)) state @@ -197,10 +243,14 @@ def machineBetheFeasibilityStep (state : List Bool) : List Bool := /-! ## Final result -/ +/-- Iterate the feasibility transition from its initial state for the length of the supplied +budget word. -/ def machineBetheFeasibilityFinalState (word : List Bool) : List Bool := (machineBetheFeasibilityStep)^[(machineBetheFeasibilityBudget word).length] (machineBetheFeasibilityInit word) +/-- Encode an accepted center with the false tag, or the final unaccepted ellipsoid with the +true tag. -/ def machineBetheFeasibilityStateResultCode (state : List Bool) : List Bool := machineIfHead (machineHeadBit @@ -210,6 +260,7 @@ def machineBetheFeasibilityStateResultCode (machineBetheFeasibilityStateEllipsoid state))) (pair [true] (machineBetheFeasibilityStateEllipsoid state)) +/-- Extract the tagged feasibility result after the prescribed number of encoded transitions. -/ def machineBetheFeasibilityResultCode (word : List Bool) : List Bool := machineBetheFeasibilityStateResultCode (machineBetheFeasibilityFinalState word) @@ -475,6 +526,8 @@ theorem machineBetheFeasibilityStateResultCode_mem_FP : simp [machineBetheFeasibilityStateBound, machineBetheFeasibilityStatePack] +/-- The state has the canonical four-field layout, an acceptance word of length at most one, and +source, ellipsoid, and bound words no longer than the original input. -/ def MachineBetheFeasibilityStateBound (word state : List Bool) : Prop := state = machineBetheFeasibilityStatePack @@ -596,6 +649,8 @@ theorem machineBetheFeasibilityIterate_bound (word : List Bool) : ∀ k, rw [Function.iterate_succ_apply'] exact machineBetheFeasibilityStep_bound ih +/-- A uniform state-width envelope obtained by packing four copies of the input prefixed by one +false bit. -/ def machineBetheFeasibilityWidth (word : List Bool) : List Bool := let envelope := [false] ++ word machineBetheFeasibilityStatePack envelope envelope envelope envelope diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineBetheFeasibilitySemantics.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineBetheFeasibilitySemantics.lean index 5735f0085f..14770cd660 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineBetheFeasibilitySemantics.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineBetheFeasibilitySemantics.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineBetheFeasibilityLoop -import Mathlib.Tactic + +public import LeanPool.BeyondBethe.BeyondBethe.MachineBetheFeasibilityLoop +public import Mathlib.Tactic /-! # Semantics of the finite-word Bethe feasibility loop @@ -17,12 +19,16 @@ call word. A later encoding-bound theorem discharges that condition for the public schedule. -/ +@[expose] public section + namespace BeyondBethe open Complexity /-! ## Canonical calls and states -/ +/-- Encode the fixed oracle data with unary dimension and precision, raw-rational parameters, +and the rational matrix code. -/ def machineBetheFeasibilityCanonicalStaticWord {m : ℕ} (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) (oraclePrecision : ℕ) (delta upper : RawRat) : List Bool := @@ -33,6 +39,8 @@ def machineBetheFeasibilityCanonicalStaticWord {m : ℕ} (pair (rawRatBinaryCode upper) (rationalMatrixBinaryEncoding.encode ⟨m + 1, A⟩))))) +/-- Encode a feasibility call with unary iteration, state-length, and rounding bounds, followed +by its static oracle data and initial ellipsoid. -/ def machineBetheFeasibilityCanonicalWord {m : ℕ} (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) (oraclePrecision : ℕ) (delta upper : RawRat) @@ -46,6 +54,8 @@ def machineBetheFeasibilityCanonicalWord {m : ℕ} tau A oraclePrecision delta upper) (rationalEllipsoidStateBinaryCode initial)))) +/-- Encode a semantic feasibility state with its acceptance bit, original canonical call, +current ellipsoid, and unary length bound. -/ def machineBetheFeasibilityCanonicalState {m : ℕ} (accepted : Bool) (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) @@ -399,6 +409,8 @@ theorem machineBetheFeasibilityStep_cut_encode {m : ℕ} /-! ## The ruler condition and complete recursive semantics -/ +/-- Every scheduled cut update reached during the remaining iterations fits the supplied +code-length bound; an accepted oracle response ends the requirement. -/ def MachineBetheFeasibilityFits {m : ℕ} (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) (oraclePrecision : ℕ) (delta upper : RawRat) diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineBetheFloorCutEntry.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineBetheFloorCutEntry.lean index daefa2f634..a8b79b3acc 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineBetheFloorCutEntry.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineBetheFloorCutEntry.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.BetheFloorCutFormula -import LeanPool.BeyondBethe.BeyondBethe.MachineBetheHeightCap + +public import LeanPool.BeyondBethe.BeyondBethe.BetheFloorCutFormula +public import LeanPool.BeyondBethe.BeyondBethe.MachineBetheHeightCap /-! # Finite-word coefficients of Bethe floor cuts @@ -17,75 +19,97 @@ and the constant negative-one vector. A supplied height-coordinate bit overrides all four cases with zero. -/ +@[expose] public section + namespace BeyondBethe open Complexity +/-- Extract the unary base dimension from a floor-cut coefficient query. -/ def machineBetheFloorCutEntryDimension (word : List Bool) : List Bool := machinePairFirst word +/-- The floor-cut query payload following the dimension word. -/ def machineBetheFloorCutEntryRest (word : List Bool) : List Bool := machinePairSecond word +/-- Extract the unary row index of the recovered matrix entry whose floor is being tested. -/ def machineBetheFloorCutEntryQueryRow (word : List Bool) : List Bool := machinePairFirst (machineBetheFloorCutEntryRest word) +/-- Extract the unary column index of the recovered matrix entry whose floor is being tested. -/ def machineBetheFloorCutEntryQueryColumn (word : List Bool) : List Bool := machinePairFirst (machinePairSecond (machineBetheFloorCutEntryRest word)) +/-- Extract the unary row index of the base coordinate at which to evaluate the cut normal. -/ def machineBetheFloorCutEntryBaseRow (word : List Bool) : List Bool := machinePairFirst (machinePairSecond (machinePairSecond (machineBetheFloorCutEntryRest word))) +/-- Extract the unary column index of the base coordinate at which to evaluate the cut normal. -/ def machineBetheFloorCutEntryBaseColumn (word : List Bool) : List Bool := machinePairFirst (machinePairSecond (machinePairSecond (machinePairSecond (machineBetheFloorCutEntryRest word)))) +/-- Extract the bit identifying the extra epigraph height coordinate. -/ def machineBetheFloorCutEntryHeightBit (word : List Bool) : List Bool := machinePairSecond (machinePairSecond (machinePairSecond (machinePairSecond (machineBetheFloorCutEntryRest word)))) +/-- Test whether the queried recovered entry lies in the final row by comparing its unary row +index with the base dimension. -/ def machineBetheFloorCutEntryQueryLastRowBit (word : List Bool) : List Bool := machineHeadBit (machineUnaryRulersEqualBit (machineBetheFloorCutEntryQueryRow word) (machineBetheFloorCutEntryDimension word)) +/-- Test whether the queried recovered entry lies in the final column by comparing its unary +column index with the base dimension. -/ def machineBetheFloorCutEntryQueryLastColumnBit (word : List Bool) : List Bool := machineHeadBit (machineUnaryRulersEqualBit (machineBetheFloorCutEntryQueryColumn word) (machineBetheFloorCutEntryDimension word)) +/-- Test equality of the base-coordinate row and queried recovered-entry row. -/ def machineBetheFloorCutEntryBaseRowEqBit (word : List Bool) : List Bool := machineHeadBit (machineUnaryRulersEqualBit (machineBetheFloorCutEntryBaseRow word) (machineBetheFloorCutEntryQueryRow word)) +/-- Test equality of the base-coordinate column and queried recovered-entry column. -/ def machineBetheFloorCutEntryBaseColumnEqBit (word : List Bool) : List Bool := machineHeadBit (machineUnaryRulersEqualBit (machineBetheFloorCutEntryBaseColumn word) (machineBetheFloorCutEntryQueryColumn word)) +/-- The conjunction of the row and column equality tests for the base coordinate and recovered +entry. -/ def machineBetheFloorCutEntryBothBaseEqBit (word : List Bool) : List Bool := machineAndBit (machineBetheFloorCutEntryBaseRowEqBit word) (machineBetheFloorCutEntryBaseColumnEqBit word) +/-- The canonical rational-entry encoding of zero. -/ def machineBetheFloorCutEntryZeroCode : List Bool := rationalEntryBinaryCode 0 +/-- The canonical rational-entry encoding of one. -/ def machineBetheFloorCutEntryOneCode : List Bool := rationalEntryBinaryCode 1 +/-- The canonical rational-entry encoding of negative one. -/ def machineBetheFloorCutEntryNegOneCode : List Bool := rationalEntryBinaryCode (-1) +/-- Evaluate the floor-cut coefficient: negative one at an internal matching coordinate or the +final corner, positive one on the relevant final-row or final-column slice, and zero elsewhere. -/ def machineBetheFloorCutEntryBaseCode (word : List Bool) : List Bool := machineIfHead (machineBetheFloorCutEntryQueryLastRowBit word) (machineIfHead (machineBetheFloorCutEntryQueryLastColumnBit word) @@ -98,6 +122,8 @@ def machineBetheFloorCutEntryBaseCode (word : List Bool) : List Bool := (machineIfHead (machineBetheFloorCutEntryBothBaseEqBit word) machineBetheFloorCutEntryNegOneCode machineBetheFloorCutEntryZeroCode)) +/-- Return zero at the epigraph height coordinate and the floor-cut base coefficient at every +other coordinate. -/ def machineBetheFloorCutEntryCode (word : List Bool) : List Bool := machineIfHead (machineHeadBit (machineBetheFloorCutEntryHeightBit word)) machineBetheFloorCutEntryZeroCode @@ -214,6 +240,8 @@ theorem machineBetheFloorCutEntryCode_mem_FP : (machineConst_mem_FP machineBetheFloorCutEntryZeroCode) machineBetheFloorCutEntryBaseCode_mem_FP +/-- Encode a recovered-entry index, a base-coordinate index, and the height flag using unary +dimensions and indices. -/ def machineBetheFloorCutEntryCanonicalWord {m : ℕ} (i j : Fin (m + 1)) (a b : Fin m) (isHeight : Bool) : List Bool := pair (List.replicate m true) diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineBetheFloorCutVector.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineBetheFloorCutVector.lean index 7981b1b97f..204345d063 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineBetheFloorCutVector.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineBetheFloorCutVector.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineBetheFloorCutEntry -import LeanPool.BeyondBethe.BeyondBethe.MachineUnaryGridGenerator -import LeanPool.BeyondBethe.BeyondBethe.MachineBinaryListSnoc + +public import LeanPool.BeyondBethe.BeyondBethe.MachineBetheFloorCutEntry +public import LeanPool.BeyondBethe.BeyondBethe.MachineUnaryGridGenerator +public import LeanPool.BeyondBethe.BeyondBethe.MachineBinaryListSnoc /-! # Finite-word Bethe floor-cut vectors @@ -16,36 +18,48 @@ uses the common row-major grid generator to construct all `m^2` coefficients of its affine pullback, then appends the zero epigraph-height coefficient. -/ +@[expose] public section + namespace BeyondBethe open Complexity /-! ## Adapter from grid-entry inputs to floor-cut-entry inputs -/ +/-- Extract the unary base-row index from a floor-cut grid-generator request. -/ def machineBetheFloorCutGridBaseRow (word : List Bool) : List Bool := machinePairFirst word +/-- The grid-generator payload following the base-row word. -/ def machineBetheFloorCutGridRest (word : List Bool) : List Bool := machinePairSecond word +/-- Extract the unary base-column index from a floor-cut grid-generator request. -/ def machineBetheFloorCutGridBaseColumn (word : List Bool) : List Bool := machinePairFirst (machineBetheFloorCutGridRest word) +/-- Extract the original floor-cut vector request carried by the grid generator. -/ def machineBetheFloorCutGridPayload (word : List Bool) : List Bool := machinePairSecond (machineBetheFloorCutGridRest word) +/-- Extract the unary base dimension from a request for the complete floor-cut vector. -/ def machineBetheFloorCutVectorDimension (word : List Bool) : List Bool := machinePairFirst word +/-- The floor-cut vector request after removing its dimension word. -/ def machineBetheFloorCutVectorRest (word : List Bool) : List Bool := machinePairSecond word +/-- Extract the queried recovered-entry row from the floor-cut vector request. -/ def machineBetheFloorCutVectorQueryRow (word : List Bool) : List Bool := machinePairFirst (machineBetheFloorCutVectorRest word) +/-- Extract the queried recovered-entry column from the floor-cut vector request. -/ def machineBetheFloorCutVectorQueryColumn (word : List Bool) : List Bool := machinePairSecond (machineBetheFloorCutVectorRest word) +/-- Combine the stored recovered-entry query with the generator's base-row and base-column +indices, setting the height flag to false. -/ def machineBetheFloorCutGridEntryInput (word : List Bool) : List Bool := let payload := machineBetheFloorCutGridPayload word pair (machineBetheFloorCutVectorDimension payload) @@ -54,6 +68,7 @@ def machineBetheFloorCutGridEntryInput (word : List Bool) : List Bool := (pair (machineBetheFloorCutGridBaseRow word) (pair (machineBetheFloorCutGridBaseColumn word) [false])))) +/-- Evaluate the encoded floor-cut coefficient at the current grid coordinate. -/ def machineBetheFloorCutGridEntryCode (word : List Bool) : List Bool := machineBetheFloorCutEntryCode (machineBetheFloorCutGridEntryInput word) @@ -119,22 +134,28 @@ theorem machineBetheFloorCutGridEntryCode_mem_FP : /-! ## Complete vector machine -/ +/-- The twice-iterated binary-width ruler used to bound generated floor-cut entries. -/ def machineBetheFloorCutVectorBound (word : List Bool) : List Bool := machineIteratedBinaryWidth 2 word +/-- Package the unary grid dimension, entry-width ruler, and original floor-cut vector request +for grid generation. -/ def machineBetheFloorCutVectorGeneratorInput (word : List Bool) : List Bool := pair (machineBetheFloorCutVectorDimension word) (pair (machineBetheFloorCutVectorBound word) word) +/-- Generate the encoded floor-cut coefficients over the square grid of base coordinates. -/ def machineBetheFloorCutVectorBaseCode (word : List Bool) : List Bool := machineUnaryGridGeneratorCode machineBetheFloorCutGridEntryCode (machineBetheFloorCutVectorGeneratorInput word) +/-- Package a zero rational entry for appending to the generated base-coordinate vector. -/ def machineBetheFloorCutVectorSnocInput (word : List Bool) : List Bool := pair (rationalEntryBinaryCode 0) (machineBetheFloorCutVectorBaseCode word) +/-- Append the zero height coefficient to the generated base-coordinate floor-cut vector. -/ def machineBetheFloorCutVectorCode (word : List Bool) : List Bool := machineBinaryListSnoc (machineBetheFloorCutVectorSnocInput word) @@ -166,6 +187,8 @@ theorem machineBetheFloorCutVectorCode_mem_FP : machineCompose_mem_FP machineBetheFloorCutVectorSnocInput_mem_FP machineBinaryListSnoc_mem_FP +/-- Encode a floor-cut vector request with unary base dimension and recovered-entry row and +column indices. -/ def machineBetheFloorCutVectorCanonicalWord {m : ℕ} (i j : Fin (m + 1)) : List Bool := pair (List.replicate m true) diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineBetheFloorScan.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineBetheFloorScan.lean index 0d427ae729..6a14504ae9 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineBetheFloorScan.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineBetheFloorScan.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineBetheFloorTest -import LeanPool.BeyondBethe.BeyondBethe.MachineBoundedUnary + +public import LeanPool.BeyondBethe.BeyondBethe.MachineBetheFloorTest +public import LeanPool.BeyondBethe.BeyondBethe.MachineBoundedUnary /-! # Finite-word row-major scan of all Bethe floor constraints @@ -17,6 +19,8 @@ floor violation. Its iteration ruler is constructed, in polynomial time, as exactly `(m+1)^2` unary bits on canonical inputs. -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineBetheFloorTest.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineBetheFloorTest.lean index 8b9cb288d4..3fc38bcf64 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineBetheFloorTest.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineBetheFloorTest.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineBetheAffineEntry -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalCompare -import LeanPool.BeyondBethe.BeyondBethe.MachineBool + +public import LeanPool.BeyondBethe.BeyondBethe.MachineBetheAffineEntry +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalCompare +public import LeanPool.BeyondBethe.BeyondBethe.MachineBool /-! # Exact finite-word test for a violated Bethe floor constraint @@ -18,6 +20,8 @@ entry as an unreduced rational and negate the exact comparison `delta <= entry`. -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineBetheHeightCap.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineBetheHeightCap.lean index c2846f23af..2a7b70420b 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineBetheHeightCap.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineBetheHeightCap.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineBetheFloorScan -import LeanPool.BeyondBethe.BeyondBethe.MachineListIndex + +public import LeanPool.BeyondBethe.BeyondBethe.MachineBetheFloorScan +public import LeanPool.BeyondBethe.BeyondBethe.MachineListIndex /-! # Exact finite-word test for the Bethe epigraph height cap @@ -16,6 +18,8 @@ last entry and tests the strict violation `upper < height` by exact rational cross multiplication. -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineBetheHeightNormal.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineBetheHeightNormal.lean index 33ad11fe5a..e561ec1938 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineBetheHeightNormal.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineBetheHeightNormal.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineBetheFloorCutVector + +public import LeanPool.BeyondBethe.BeyondBethe.MachineBetheFloorCutVector /-! # Finite-word height-cap normals @@ -14,6 +16,8 @@ The upper-height constraint has normal `(0,...,0,1)`. We construct its single positive height coordinate with the verified list-snoc machine. -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryAdd.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryAdd.lean index 8b0903aaf4..f8198321aa 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryAdd.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryAdd.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineBool + +public import LeanPool.BeyondBethe.BeyondBethe.MachineBool /-! # A composed polynomial-time binary adder @@ -16,6 +18,8 @@ Complexitylib's proved bounded-iteration machine runs this step for the length of a linear ruler; the final reversal restores little-endian order. -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryAddSemantics.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryAddSemantics.lean index fa2e1d307c..45f17428cc 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryAddSemantics.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryAddSemantics.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineBinaryAdd -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleAdd + +public import LeanPool.BeyondBethe.BeyondBethe.MachineBinaryAdd +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleAdd /-! # Correctness of the composed polynomial-time binary adder @@ -15,6 +17,8 @@ same ripple-carry recurrence as Complexitylib's canonical binary adder. This connects the concrete `FP` construction to arithmetic addition. -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryCompare.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryCompare.lean index c883729204..50bb380dcb 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryCompare.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryCompare.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineBinarySub + +public import LeanPool.BeyondBethe.BeyondBethe.MachineBinarySub /-! # Polynomial-time comparison of canonical binary naturals @@ -14,6 +16,8 @@ right. This gives compact comparison machines while reusing the fully verified borrow scan. -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryDivision.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryDivision.lean index 98f0077e9c..884d2d4985 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryDivision.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryDivision.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineBinaryCompare -import LeanPool.BeyondBethe.BeyondBethe.BinaryLongDivision + +public import LeanPool.BeyondBethe.BeyondBethe.MachineBinaryCompare +public import LeanPool.BeyondBethe.BeyondBethe.BinaryLongDivision /-! # Polynomial-time binary long division @@ -16,6 +18,8 @@ unread bits, the fixed divisor, quotient, and remainder. All arithmetic and tests are the previously verified `FP` bitstring routines. -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryGCD.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryGCD.lean index 0203f7a3d5..dea5a9c097 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryGCD.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryGCD.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineBinaryDivision -import LeanPool.BeyondBethe.BeyondBethe.MachineTrimHighZeros + +public import LeanPool.BeyondBethe.BeyondBethe.MachineBinaryDivision +public import LeanPool.BeyondBethe.BeyondBethe.MachineTrimHighZeros /-! # Polynomial-time binary gcd @@ -16,6 +18,8 @@ from the verified long-division machine, and two iterations per bit of the initial second component suffice by the previously proved Euclid bound. -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryListInit.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryListInit.lean index 455bdf6606..80260b48f7 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryListInit.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryListInit.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineListReverse + +public import LeanPool.BeyondBethe.BeyondBethe.MachineListReverse /-! # Removing the last entry of a finite-word list @@ -15,6 +17,8 @@ This machine reverses the list, removes its first encoded entry, and reverses again. It is total and polynomial-time on arbitrary finite words. -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryListSnoc.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryListSnoc.lean index 62f9441d6b..9c30f3ea15 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryListSnoc.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryListSnoc.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineListReverse + +public import LeanPool.BeyondBethe.BeyondBethe.MachineListReverse /-! # Appending one entry to a finite-word list @@ -16,6 +18,8 @@ uses of the verified list-reversal machine make the construction total and polynomial-time on arbitrary finite words. -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryMul.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryMul.lean index 7c09d0fa63..8f3316224c 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryMul.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryMul.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineBinaryAddSemantics -import LeanPool.BeyondBethe.Complexitylib.Mathlib.NatBits + +public import LeanPool.BeyondBethe.BeyondBethe.MachineBinaryAddSemantics +public import LeanPool.BeyondBethe.Complexitylib.Mathlib.NatBits /-! # A composed polynomial-time binary multiplier @@ -17,6 +19,8 @@ quadratic Cobham width bound is proved for every input string, while exact arithmetic correctness is proved on canonical `Nat.bits` operands. -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineBinarySub.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineBinarySub.lean index 2c51e7aad1..2eaeb25c53 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineBinarySub.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineBinarySub.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineTrimHighZeros -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleSub + +public import LeanPool.BeyondBethe.BeyondBethe.MachineTrimHighZeros +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleSub /-! # A composed polynomial-time binary subtractor @@ -16,6 +18,8 @@ underflow to zero and otherwise removes redundant high zeroes. Thus the machine implements truncated subtraction on canonical natural words. -/ +@[expose] public section + namespace BeyondBethe open Complexity @@ -33,19 +37,23 @@ def machineBinarySubY (state : List Bool) : List Bool := def machineBinarySubBorrow (state : List Bool) : List Bool := machinePairFirst (machinePairSecond (machinePairSecond state)) +/-- Extract the reversed output-bit accumulator from the subtraction state. -/ def machineBinarySubAccRev (state : List Bool) : List Bool := machinePairSecond (machinePairSecond (machinePairSecond state)) +/-- Return a true bit exactly when at least one operand still has an unprocessed bit. -/ def machineBinarySubActive (state : List Bool) : List Bool := machineIfEmpty (machineBinarySubX state) (machineIfEmpty (machineBinarySubY state) [false] [true]) [true] +/-- The current difference bit, computed as the parity of the operand heads and incoming borrow. -/ def machineBinarySubDiffBit (state : List Bool) : List Bool := machineFullAdderSum (machineHeadBit (machineBinarySubX state)) (machineHeadBit (machineBinarySubY state)) (machineBinarySubBorrow state) +/-- Compute the outgoing borrow from the two operand heads and incoming borrow. -/ def machineBinarySubNextBorrow (state : List Bool) : List Bool := let lhs := machineHeadBit (machineBinarySubX state) let rhs := machineHeadBit (machineBinarySubY state) @@ -54,6 +62,8 @@ def machineBinarySubNextBorrow (state : List Bool) : List Bool := (machineOrBit (machineAndBit (machineNotBit lhs) borrow) (machineAndBit rhs borrow)) +/-- Consume both operand heads, update the borrow, and prepend the new difference bit to the +reversed accumulator. -/ def machineBinarySubAdvanced (state : List Bool) : List Bool := machineBinarySubPack (machineBinarySubX state).tail @@ -61,25 +71,33 @@ def machineBinarySubAdvanced (state : List Bool) : List Bool := (machineBinarySubNextBorrow state) (machineBinarySubDiffBit state ++ machineBinarySubAccRev state) +/-- Advance subtraction while either operand remains; otherwise leave the state fixed. -/ def machineBinarySubStep (state : List Bool) : List Bool := machineIfHead (machineBinarySubActive state) (machineBinarySubAdvanced state) state +/-- Initialize subtraction from the two decoded operands with no borrow and an empty +accumulator. -/ def machineBinarySubInit (word : List Bool) : List Bool := machineBinarySubPack (machinePairFirst word) (machinePairSecond word) [false] [] +/-- Concatenate the operand words to obtain a sufficient subtraction iteration ruler. -/ def machineBinarySubRuler (word : List Bool) : List Bool := machinePairFirst word ++ machinePairSecond word +/-- A false-bit width ruler of length `(word.length + 8)^2` for subtraction states. -/ def machineBinarySubWidth (word : List Bool) : List Bool := let padded := List.replicate 8 false ++ word List.replicate (padded.length * padded.length) false +/-- Run subtraction for the sum of the two decoded operand lengths. -/ def machineBinarySubFinalState (word : List Bool) : List Bool := machineBinarySubStep^[(machineBinarySubRuler word).length] (machineBinarySubInit word) +/-- Return zero on a final borrow; otherwise reverse the accumulated difference bits and remove +high zeros. -/ def machineBinarySubBits (word : List Bool) : List Bool := let state := machineBinarySubFinalState word machineIfHead (machineBinarySubBorrow state) [] @@ -251,6 +269,8 @@ theorem machineBinarySubStep_pack_length_le List.length_tail] omega +/-- The subtraction state is a packed pair of operand words, a singleton borrow bit, and a +reversed accumulator. -/ def MachineBinarySubWellFormed (state : List Bool) : Prop := ∃ x y accRev : List Bool, ∃ borrow : Bool, state = machineBinarySubPack x y [borrow] accRev diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineBitAssembly.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineBitAssembly.lean index 074440b34d..e4f1e79048 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineBitAssembly.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineBitAssembly.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineBinaryAddSemantics -import LeanPool.BeyondBethe.BeyondBethe.MachineRAMBridge + +public import LeanPool.BeyondBethe.BeyondBethe.MachineBinaryAddSemantics +public import LeanPool.BeyondBethe.BeyondBethe.MachineRAMBridge /-! # Assembling a polynomial number of queried output bits @@ -15,6 +17,8 @@ iteration `k`, the state stores `k.bits`, the first `k` queried bits, and the unchanged original input. A verified binary addition increments the counter. -/ +@[expose] public section + namespace BeyondBethe open Complexity @@ -26,23 +30,30 @@ def machineQueriedBit (query : List Bool → List Bool) (counter word : List Bool) : List Bool := machineHeadBit (query (pair counter word)) +/-- Package the binary query counter, accumulated output bits, and immutable input word. -/ def machineBitAssemblyPack (counter acc word : List Bool) : List Bool := pair counter (pair acc word) +/-- Extract the binary query-position counter from the assembly state. -/ def machineBitAssemblyCounter (state : List Bool) : List Bool := machinePairFirst state +/-- Extract the output bits already assembled. -/ def machineBitAssemblyAcc (state : List Bool) : List Bool := machinePairFirst (machinePairSecond state) +/-- Extract the immutable input supplied to each output-bit query. -/ def machineBitAssemblyInput (state : List Bool) : List Bool := machinePairSecond (machinePairSecond state) +/-- Increment the assembly state's binary query counter by one. -/ def machineBitAssemblyNextCounter (state : List Bool) : List Bool := machineBinaryAddBits (pair (machineBitAssemblyCounter state) [true]) +/-- Append the queried output bit at the current counter, increment the counter, and retain the +original input. -/ def machineBitAssemblyStep (query : List Bool → List Bool) (state : List Bool) : List Bool := machineBitAssemblyPack @@ -52,6 +63,7 @@ def machineBitAssemblyStep (query : List Bool → List Bool) (machineBitAssemblyInput state)) (machineBitAssemblyInput state) +/-- Initialize bit assembly at counter zero with an empty output accumulator. -/ def machineBitAssemblyInit (word : List Bool) : List Bool := machineBitAssemblyPack [] [] word @@ -61,11 +73,13 @@ def machineBitAssemblyWidth (ruler : List Bool → List Bool) (word : List Bool) : List Bool := machineBitAssemblyPack (ruler word) (ruler word) word +/-- Run bit assembly for the number of positions specified by the ruler's length. -/ def machineBitAssemblyFinalState (query ruler : List Bool → List Bool) (word : List Bool) : List Bool := (machineBitAssemblyStep query)^[(ruler word).length] (machineBitAssemblyInit word) +/-- Return the accumulated output bits after all ruler-bounded queries. -/ def machineAssembleBits (query ruler : List Bool → List Bool) (word : List Bool) : List Bool := machineBitAssemblyAcc (machineBitAssemblyFinalState query ruler word) diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineBool.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineBool.lean index 3cbd1d5a6b..2d7f058a17 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineBool.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineBool.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineFPBasics + +public import LeanPool.BeyondBethe.BeyondBethe.MachineFPBasics /-! # Verified one-bit machine logic @@ -14,29 +16,39 @@ The definitions remain total on arbitrary bitstrings by inspecting only the leading bit through the verified selector machine. -/ +@[expose] public section + namespace BeyondBethe open Complexity +/-- Negate the input word's head bit and return its singleton encoding. -/ def machineNotBit (a : List Bool) : List Bool := machineIfHead a [false] [true] +/-- Negate the second bit word when the first head is true; otherwise return the second word +unchanged. -/ def machineXorBit (a b : List Bool) : List Bool := machineIfHead a (machineNotBit b) b +/-- Return the second bit word when the first head is true, and a false singleton otherwise. -/ def machineAndBit (a b : List Bool) : List Bool := machineIfHead a b [false] +/-- Return a true singleton when the first head is true, and the second bit word otherwise. -/ def machineOrBit (a b : List Bool) : List Bool := machineIfHead a [true] b +/-- The majority operation on three encoded bits, expressed through pairwise conjunctions. -/ def machineMajorityBit (a b c : List Bool) : List Bool := machineOrBit (machineAndBit a b) (machineOrBit (machineAndBit a c) (machineAndBit b c)) +/-- The full-adder sum bit, given by XOR of both input bits and the incoming carry. -/ def machineFullAdderSum (a b carry : List Bool) : List Bool := machineXorBit (machineXorBit a b) carry +/-- The full-adder carry bit, given by the majority of both input bits and the incoming carry. -/ def machineFullAdderCarry (a b carry : List Bool) : List Bool := machineMajorityBit a b carry diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineBooleanInit.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineBooleanInit.lean index 57214120c9..cc183e516a 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineBooleanInit.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineBooleanInit.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineBooleanMemory + +public import LeanPool.BeyondBethe.BeyondBethe.MachineBooleanMemory /-! # Polynomially bounded Boolean storage initialization @@ -15,18 +17,23 @@ quadratic word computed from the original input; the exact semantic bounds show that this clamp is inactive on canonical dimension rulers. -/ +@[expose] public section + namespace BeyondBethe open Complexity /-! ## False vectors -/ +/-- Prepend one encoded false entry to a Boolean-vector code. -/ def machineFalseVectorStep (acc : List Bool) : List Bool := pair [false] acc +/-- Use the binary-multiplication width ruler to bound the false-vector construction. -/ def machineFalseVectorWidth (ruler : List Bool) : List Bool := machineBinaryMulWidth ruler +/-- Build a Boolean-vector code containing as many false entries as the ruler has bits. -/ def machineFalseVectorCode (ruler : List Bool) : List Bool := (machineFalseVectorStep)^[ruler.length] [] @@ -77,54 +84,69 @@ theorem machineFalseVectorCode_mem_FP : /-! ## Repeated-row matrices -/ +/-- Extract the row-count ruler from a repeated-row matrix request. -/ def machineRepeatedRowMatrixRuler (word : List Bool) : List Bool := machinePairFirst word +/-- Extract the encoded row to repeat. -/ def machineRepeatedRowMatrixRow (word : List Bool) : List Bool := machinePairSecond word +/-- The binary-multiplication width ruler used to cap the repeated-row matrix accumulator. -/ def machineRepeatedRowMatrixBound (word : List Bool) : List Bool := machineBinaryMulWidth word +/-- Package the repeated row, encoded matrix accumulator, and accumulator-length ruler. -/ def machineRepeatedRowMatrixPack (row acc bound : List Bool) : List Bool := pair row (pair acc bound) +/-- Extract the immutable row code from a matrix-construction state. -/ def machineRepeatedRowMatrixStateRow (state : List Bool) : List Bool := machinePairFirst state +/-- Extract the encoded matrix rows accumulated so far. -/ def machineRepeatedRowMatrixStateAcc (state : List Bool) : List Bool := machinePairFirst (machinePairSecond state) +/-- Extract the word whose length bounds the matrix accumulator. -/ def machineRepeatedRowMatrixStateBound (state : List Bool) : List Bool := machinePairSecond (machinePairSecond state) +/-- Prepend one copy of the stored row to the matrix accumulator before truncation. -/ def machineRepeatedRowMatrixCandidate (state : List Bool) : List Bool := pair (machineRepeatedRowMatrixStateRow state) (machineRepeatedRowMatrixStateAcc state) +/-- Truncate the candidate matrix code to the stored bound word's length. -/ def machineRepeatedRowMatrixNextAcc (state : List Bool) : List Bool := (machineRepeatedRowMatrixCandidate state).take (machineRepeatedRowMatrixStateBound state).length +/-- Replace the matrix accumulator by its bounded row-prepending update, preserving the row and +bound. -/ def machineRepeatedRowMatrixStep (state : List Bool) : List Bool := machineRepeatedRowMatrixPack (machineRepeatedRowMatrixStateRow state) (machineRepeatedRowMatrixNextAcc state) (machineRepeatedRowMatrixStateBound state) +/-- Initialize repeated-row construction with an empty matrix and its computed width bound. -/ def machineRepeatedRowMatrixInit (word : List Bool) : List Bool := machineRepeatedRowMatrixPack (machineRepeatedRowMatrixRow word) [] (machineRepeatedRowMatrixBound word) +/-- A state-width envelope formed by packing three copies of the matrix accumulator bound. -/ def machineRepeatedRowMatrixWidth (word : List Bool) : List Bool := machineRepeatedRowMatrixPack (machineRepeatedRowMatrixBound word) (machineRepeatedRowMatrixBound word) (machineRepeatedRowMatrixBound word) +/-- Repeat the bounded row-prepending step for the length of the row-count ruler. -/ def machineRepeatedRowMatrixFinalState (word : List Bool) : List Bool := (machineRepeatedRowMatrixStep)^[(machineRepeatedRowMatrixRuler word).length] (machineRepeatedRowMatrixInit word) +/-- Return the encoded matrix accumulator after the requested bounded row repetitions. -/ def machineRepeatedRowMatrixCode (word : List Bool) : List Bool := machineRepeatedRowMatrixStateAcc (machineRepeatedRowMatrixFinalState word) @@ -199,6 +221,8 @@ theorem machineRepeatedRowMatrixWidth_mem_FP : (machineRepeatedRowMatrixPack a b c) = c := by simp [machineRepeatedRowMatrixStateBound, machineRepeatedRowMatrixPack] +/-- The state has the expected row, accumulator, and bound layout, with every field bounded by +the computed ruler length. -/ def MachineRepeatedRowMatrixStateBound (word state : List Bool) : Prop := let B := (machineRepeatedRowMatrixBound word).length @@ -282,10 +306,14 @@ theorem machineRepeatedRowMatrixCode_mem_FP : /-! ## Exact all-false square matrices -/ +/-- Request an all-false square matrix using a unary row count and an encoded false row of the +same length. -/ def machineFalseSquareBuilderInput (n : ℕ) : List Bool := pair (List.replicate n true) (boolVectorCode (List.replicate n false)) +/-- The canonical builder state containing `k` all-false rows of length `n`, with the original +square request's bound. -/ def machineFalseSquareBuilderState (n k : ℕ) : List Bool := let word := machineFalseSquareBuilderInput n let row := List.replicate n false diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineBooleanMemory.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineBooleanMemory.lean index 112534fbf5..9fccf1331b 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineBooleanMemory.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineBooleanMemory.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineListUpdate -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalCompare + +public import LeanPool.BeyondBethe.BeyondBethe.MachineListUpdate +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalCompare /-! # Boolean vector and matrix memory @@ -16,15 +18,20 @@ list primitives. The final routine queries the support graph of a rational matrix without decoding the matrix into a Lean object. -/ +@[expose] public section + namespace BeyondBethe open Complexity +/-- Encode one Boolean as a singleton word. -/ def boolElementCode (b : Bool) : List Bool := [b] +/-- Encode a Boolean vector as a binary list of singleton Boolean codes. -/ def boolVectorCode (v : List Bool) : List Bool := binaryListCode boolElementCode v +/-- Encode a Boolean matrix as a binary list of encoded Boolean rows. -/ def boolMatrixCode (M : List (List Bool)) : List Bool := binaryListCode boolVectorCode M @@ -178,11 +185,13 @@ theorem machineBoolMatrixUpdateAtUnary_mem_FP : /-! ## Rational support queries -/ +/-- Test equality of two encoded raw rationals by checking both order comparisons. -/ def machineRawRatEqBit (word : List Bool) : List Bool := machineAndBit (machineRawRatLeBit word) (machineRawRatLeBit (pair (machinePairSecond word) (machinePairFirst word))) +/-- Negate the raw-rational equality test. -/ def machineRawRatNeBit (word : List Bool) : List Bool := machineNotBit (machineRawRatEqBit word) diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineBoundedUnary.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineBoundedUnary.lean index 33e365078a..fe45b1e6b1 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineBoundedUnary.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineBoundedUnary.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineBinarySub + +public import LeanPool.BeyondBethe.BeyondBethe.MachineBinarySub /-! # Bounded conversion from binary to unary @@ -17,43 +19,58 @@ only the guarded prefix. The guard is what later permits paper-specific polynomial schedules without making a false global complexity claim. -/ +@[expose] public section + namespace BeyondBethe open Complexity +/-- Package the remaining binary integer and accumulated unary word. -/ def machineBoundedUnaryPack (remaining acc : List Bool) : List Bool := pair remaining acc +/-- Extract the remaining binary integer from a bounded unary-conversion state. -/ def machineBoundedUnaryRemaining (state : List Bool) : List Bool := machinePairFirst state +/-- Extract the unary true-bit accumulator. -/ def machineBoundedUnaryAcc (state : List Bool) : List Bool := machinePairSecond state +/-- Subtract one from the remaining binary integer using truncated natural subtraction. -/ def machineBoundedUnaryDecrement (state : List Bool) : List Bool := machineBinarySubBits (pair (machineBoundedUnaryRemaining state) [true]) +/-- Decrement the remaining binary integer and prepend one true bit to the unary accumulator. -/ def machineBoundedUnaryContinue (state : List Bool) : List Bool := machineBoundedUnaryPack (machineBoundedUnaryDecrement state) (true :: machineBoundedUnaryAcc state) +/-- Leave an empty remaining word fixed; otherwise perform one decrement-and-append conversion +step. -/ def machineBoundedUnaryStep (state : List Bool) : List Bool := machineIfEmpty (machineBoundedUnaryRemaining state) state (machineBoundedUnaryContinue state) +/-- Extract the iteration ruler that limits binary-to-unary conversion. -/ def machineBoundedUnaryRuler (word : List Bool) : List Bool := machinePairFirst word +/-- Extract the binary integer to convert. -/ def machineBoundedUnaryBits (word : List Bool) : List Bool := machinePairSecond word +/-- Initialize bounded unary conversion with the input integer and an empty accumulator. -/ def machineBoundedUnaryInit (word : List Bool) : List Bool := machineBoundedUnaryPack (machineBoundedUnaryBits word) [] +/-- A conversion-state width envelope obtained by pairing the input word with itself. -/ def machineBoundedUnaryWidth (word : List Bool) : List Bool := pair word word +/-- Run binary-to-unary conversion for the ruler's length, stopping early once the remaining +word is empty. -/ def machineBoundedUnaryFinalState (word : List Bool) : List Bool := (machineBoundedUnaryStep)^[(machineBoundedUnaryRuler word).length] (machineBoundedUnaryInit word) @@ -118,6 +135,8 @@ theorem machineBoundedUnaryWidth_mem_FP : machineBoundedUnaryAcc (machineBoundedUnaryPack remaining acc) = acc := by simp [machineBoundedUnaryAcc, machineBoundedUnaryPack] +/-- The packed conversion state has a remaining binary word bounded by the input length and an +accumulator bounded by the elapsed iteration count. -/ def MachineBoundedUnaryStateBound (word : List Bool) (iterations : ℕ) (state : List Bool) : Prop := state = machineBoundedUnaryPack @@ -204,6 +223,7 @@ theorem machineBoundedUnary_mem_FP : /-! ## Exact semantics -/ +/-- The canonical state after `k` steps on `n`: binary remainder `n-k` and `min k n` true bits. -/ def boundedUnaryState (n k : ℕ) : List Bool := machineBoundedUnaryPack (n - k).bits (List.replicate (min k n) true) diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineCertificateAssembly.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineCertificateAssembly.lean index 4f9fb80fa1..f4d9f0c4d6 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineCertificateAssembly.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineCertificateAssembly.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineNearbyMatrixSum -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalExp + +public import LeanPool.BeyondBethe.BeyondBethe.MachineNearbyMatrixSum +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalExp /-! # Assembly of the directed certificate from its matching gain @@ -17,6 +19,8 @@ unary exponential guard, it returns the final canonical raw rational entry. All composition and rational-format conversions are explicit. -/ +@[expose] public section + namespace BeyondBethe open Complexity @@ -47,6 +51,8 @@ theorem machineCertificateOptimizerWord_mem_FP : machineCertificateOptimizerWord (pair source optimizer) = optimizer := machinePairSecond_pair source optimizer +/-- Assemble the raw-rational logarithmic certificate from the row and column potentials, +directed nearby-coordinate sum, structural gain, and subtracted KKT penalty. -/ def rawCertificateLogAssembly {n : ℕ} (X : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℚ) (gain : ℚ) : RawRat := @@ -71,6 +77,8 @@ theorem rawCertificateLogAssembly_value {n : ℕ} rw [directedNearbyBetheLower] ring +/-- Add the encoded potential sum and nearby-matrix contribution extracted from the optimizer +payload. -/ def machineCertificateNearbyRawCode (word : List Bool) : List Bool := machineRawRatAddCode (pair @@ -79,11 +87,14 @@ def machineCertificateNearbyRawCode (word : List Bool) : List Bool := (machineNearbyMatrixRawSumCode (machineCertificateOptimizerWord word))) +/-- Add the supplied gain machine's raw-rational output to the nearby-certificate sum. -/ def machineCertificateLogBeforePenaltyRawCode (gainMachine : List Bool → List Bool) (word : List Bool) : List Bool := machineRawRatAddCode (pair (machineCertificateNearbyRawCode word) (gainMachine word)) +/-- Subtract the optimizer's encoded KKT penalty from the logarithmic certificate before +normalization. -/ def machineCertificateLogUnnormalizedRawCode (gainMachine : List Bool → List Bool) (word : List Bool) : List Bool := machineRawRatAddCode @@ -185,6 +196,8 @@ theorem machineCertificateLogRawCode_encode rawCertificateLogAssembly_value, explicitDirectedCertificateLog] +/-- Package the exponentiation guard, normalized logarithmic certificate, and optimizer-derived +exponential loss. -/ def machineCertificateExpInput (gainMachine guardMachine : List Bool → List Bool) (word : List Bool) : List Bool := @@ -193,6 +206,7 @@ def machineCertificateExpInput (machineCertificateExpLossRawCode (machineCertificateOptimizerWord word))) +/-- Evaluate the bounded rational lower exponential routine on the assembled certificate input. -/ def machineCertificateValueRawCode (gainMachine guardMachine : List Bool → List Bool) (word : List Bool) : List Bool := diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineCertificateExpGuard.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineCertificateExpGuard.lean index 754c4b1516..0aa2615a9e 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineCertificateExpGuard.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineCertificateExpGuard.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.CertificateMagnitude -import LeanPool.BeyondBethe.BeyondBethe.MachineCertificateAssembly + +public import LeanPool.BeyondBethe.BeyondBethe.CertificateMagnitude +public import LeanPool.BeyondBethe.BeyondBethe.MachineCertificateAssembly /-! # The polynomial exponential guard for the optimizer certificate @@ -16,6 +18,8 @@ guard. On positive normalized source matrices this dominates the exact magnitude-sensitive exponential schedule. -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineCertificatePotentials.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineCertificatePotentials.lean index a15a829d86..f91ac2e21c 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineCertificatePotentials.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineCertificatePotentials.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalVectorSum + +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalVectorSum /-! # Finite-word access and summation for certificate potentials @@ -14,6 +16,8 @@ the canonical optimizer-output word and forms the unreduced rational sum of all row and column potentials. -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineCertificateScales.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineCertificateScales.lean index 2d84c37249..ef675fe2b5 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineCertificateScales.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineCertificateScales.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineCertificatePotentials -import LeanPool.BeyondBethe.BeyondBethe.MachineMatrixDimension -import LeanPool.BeyondBethe.BeyondBethe.MachineDirectedLog + +public import LeanPool.BeyondBethe.BeyondBethe.MachineCertificatePotentials +public import LeanPool.BeyondBethe.BeyondBethe.MachineMatrixDimension +public import LeanPool.BeyondBethe.BeyondBethe.MachineDirectedLog /-! # Dimension-dependent certificate scales as finite-word functions @@ -17,6 +19,8 @@ exponential losses. This file constructs all of them directly from the dimension prefix of the optimizer's matrix word. -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineCertifiedPairEligibility.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineCertifiedPairEligibility.lean index cb040dca5f..4f86e8c628 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineCertifiedPairEligibility.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineCertifiedPairEligibility.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineFourCoreCost -import LeanPool.BeyondBethe.BeyondBethe.MachineUnaryRange -import LeanPool.BeyondBethe.BeyondBethe.MachineLengthBits + +public import LeanPool.BeyondBethe.BeyondBethe.MachineFourCoreCost +public import LeanPool.BeyondBethe.BeyondBethe.MachineUnaryRange +public import LeanPool.BeyondBethe.BeyondBethe.MachineLengthBits /-! # Executable column-pair eligibility @@ -18,6 +20,8 @@ column. Both loops are driven by the unary matrix dimension, and all state is clamped on arbitrary bitstrings. -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineCompletedAlgorithm.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineCompletedAlgorithm.lean index ad1974e039..d0e59e85c6 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineCompletedAlgorithm.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineCompletedAlgorithm.lean @@ -3,11 +3,13 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineFinalScalars -import LeanPool.BeyondBethe.BeyondBethe.MachinePerfectMatching -import LeanPool.BeyondBethe.BeyondBethe.MachineSmoothedMatrix -import LeanPool.BeyondBethe.BeyondBethe.ExplicitScales + +public import LeanPool.BeyondBethe.BeyondBethe.MachineFinalScalars +public import LeanPool.BeyondBethe.BeyondBethe.MachinePerfectMatching +public import LeanPool.BeyondBethe.BeyondBethe.MachineSmoothedMatrix +public import LeanPool.BeyondBethe.BeyondBethe.ExplicitScales /-! # Finite-word outer wrapper for the completed permanent algorithm @@ -20,6 +22,8 @@ The executable development later supplies this parameter with the concrete regularized-Bethe optimizer and certificate machine. -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedAffineGradientEntry.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedAffineGradientEntry.lean index 2b4ffee3c0..f75266a52b 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedAffineGradientEntry.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedAffineGradientEntry.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineDirectedNegativeGradientEntry + +public import LeanPool.BeyondBethe.BeyondBethe.MachineDirectedNegativeGradientEntry /-! # Finite-word entries of the directed affine gradient @@ -18,6 +20,8 @@ This file evaluates those four full-gradient entries with the common verified entry machine and performs the three exact rational operations explicitly. -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedAffineGradientVector.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedAffineGradientVector.lean index 458b8af7e4..42bbe3c0a4 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedAffineGradientVector.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedAffineGradientVector.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineDirectedAffineGradientEntry -import LeanPool.BeyondBethe.BeyondBethe.MachineUnaryGridGenerator + +public import LeanPool.BeyondBethe.BeyondBethe.MachineDirectedAffineGradientEntry +public import LeanPool.BeyondBethe.BeyondBethe.MachineUnaryGridGenerator /-! # Finite-word directed affine-gradient vectors @@ -16,6 +18,8 @@ bound for the complete `m^2`-coordinate vector, so the generator's totalizing accumulator clamp is inactive on every canonical input. -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedEpigraphNormal.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedEpigraphNormal.lean index 51af551577..45873b1a75 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedEpigraphNormal.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedEpigraphNormal.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineDirectedAffineGradientVector -import LeanPool.BeyondBethe.BeyondBethe.MachineBinaryListSnoc + +public import LeanPool.BeyondBethe.BeyondBethe.MachineDirectedAffineGradientVector +public import LeanPool.BeyondBethe.BeyondBethe.MachineBinaryListSnoc /-! # Finite-word directed epigraph normals @@ -15,6 +17,8 @@ height coefficient `-1`. This file performs that final append explicitly and identifies the result with the canonical code of `epigraphNormal`. -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedLog.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedLog.lean index a58b6a02da..6af65b2072 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedLog.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedLog.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineLengthBits -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalLogSeries -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalCompare + +public import LeanPool.BeyondBethe.BeyondBethe.MachineLengthBits +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalLogSeries +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalCompare /-! # Polynomial-time directed rational logarithm @@ -18,6 +20,8 @@ two are constructed directly as bitstrings, and all rational arithmetic is performed by the verified unreduced-rational machines. -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedNegativeGradientCoordinate.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedNegativeGradientCoordinate.lean index d232a52d68..cb40260a82 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedNegativeGradientCoordinate.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedNegativeGradientCoordinate.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineDirectedNegativeObjectiveCoordinate + +public import LeanPool.BeyondBethe.BeyondBethe.MachineDirectedNegativeObjectiveCoordinate /-! # Finite-word lower endpoint for one directed Bethe gradient coordinate @@ -19,6 +21,8 @@ so the two implementations cannot silently disagree about input layout or about the representation of `1-x`. -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedNegativeGradientEntry.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedNegativeGradientEntry.lean index bf742e3daf..9d22d03e94 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedNegativeGradientEntry.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedNegativeGradientEntry.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineDirectedNegativeGradientCoordinate -import LeanPool.BeyondBethe.BeyondBethe.MachineDirectedNegativeObjectiveSum + +public import LeanPool.BeyondBethe.BeyondBethe.MachineDirectedNegativeGradientCoordinate +public import LeanPool.BeyondBethe.BeyondBethe.MachineDirectedNegativeObjectiveSum /-! # Finite-word entries of the directed full gradient @@ -18,6 +20,8 @@ objective and gradient implementations on one common interpretation of `A` and of the recovered Birkhoff matrix. -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedNegativeObjectiveCoordinate.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedNegativeObjectiveCoordinate.lean index a0fd5c077c..5ff96e7318 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedNegativeObjectiveCoordinate.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedNegativeObjectiveCoordinate.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineBetheFloorCutEntry -import LeanPool.BeyondBethe.BeyondBethe.MachineScheduledLog -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalNormalization + +public import LeanPool.BeyondBethe.BeyondBethe.MachineBetheFloorCutEntry +public import LeanPool.BeyondBethe.BeyondBethe.MachineScheduledLog +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalNormalization /-! # Finite-word lower endpoint for one directed Bethe objective coordinate @@ -18,6 +20,8 @@ to the logarithm routine, so the scheduled-log correctness theorem applies to the canonical reduced rational rather than an unreduced subtraction. -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedNegativeObjectiveSum.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedNegativeObjectiveSum.lean index aa01a78f02..38fdd3b7b0 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedNegativeObjectiveSum.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedNegativeObjectiveSum.lean @@ -3,12 +3,14 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineDirectedNegativeObjectiveCoordinate -import LeanPool.BeyondBethe.BeyondBethe.MachineBetheFloorScan -import LeanPool.BeyondBethe.BeyondBethe.MachineListIndex -import LeanPool.BeyondBethe.BeyondBethe.MachineScheduledLogWidth -import LeanPool.BeyondBethe.BeyondBethe.MachineCertificateExpGuard + +public import LeanPool.BeyondBethe.BeyondBethe.MachineDirectedNegativeObjectiveCoordinate +public import LeanPool.BeyondBethe.BeyondBethe.MachineBetheFloorScan +public import LeanPool.BeyondBethe.BeyondBethe.MachineListIndex +public import LeanPool.BeyondBethe.BeyondBethe.MachineScheduledLogWidth +public import LeanPool.BeyondBethe.BeyondBethe.MachineCertificateExpGuard /-! # Finite-word evaluation of the complete directed Bethe objective @@ -25,6 +27,8 @@ proof below is kept separate from this global finite-word bound; on canonical inputs the clamp is proved inactive. -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedTransferCost.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedTransferCost.lean index ff017350c2..77d88c3108 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedTransferCost.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedTransferCost.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineRowComplementUpperSum + +public import LeanPool.BeyondBethe.BeyondBethe.MachineRowComplementUpperSum /-! # One directed transfer-cost endpoint as a finite-word function @@ -15,6 +17,8 @@ certificate precision and regularization scale. The only row traversal is the separately verified complement-log upper sum. -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineDyadicFloor.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineDyadicFloor.lean index 73876943ad..a661f0381b 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineDyadicFloor.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineDyadicFloor.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.BinaryRationalFloor -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalArithmetic + +public import LeanPool.BeyondBethe.BeyondBethe.BinaryRationalFloor +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalArithmetic /-! # Polynomial-time dyadic floor @@ -17,6 +19,8 @@ absolute numerator by the ruler length, performs verified long division, and implements Euclidean flooring explicitly for negative inputs. -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineDyadicFloorMatrix.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineDyadicFloorMatrix.lean index efdf797d60..5e3dd4413b 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineDyadicFloorMatrix.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineDyadicFloorMatrix.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineDyadicFloorVector + +public import LeanPool.BeyondBethe.BeyondBethe.MachineDyadicFloorVector /-! # Polynomial-time coordinatewise matrix dyadic floor @@ -13,6 +15,8 @@ The outer scan maps the verified vector-floor machine over the encoded rows of a square rational matrix. -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineDyadicFloorVector.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineDyadicFloorVector.lean index c16b31c1a1..75b84e3a6a 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineDyadicFloorVector.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineDyadicFloorVector.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineDyadicFloor -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalEllipsoidUpdate + +public import LeanPool.BeyondBethe.BeyondBethe.MachineDyadicFloor +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalEllipsoidUpdate /-! # Polynomial-time coordinatewise dyadic floor @@ -16,6 +18,8 @@ code. We therefore normalize the same raw result into entry format and map that exact operation over a bounded encoded vector. -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineEncoding.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineEncoding.lean index 0d7e51aca8..d9065810f5 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineEncoding.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineEncoding.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.AlgorithmicSpec -import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal + +public import LeanPool.BeyondBethe.BeyondBethe.AlgorithmicSpec +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal /-! # Machine access to the canonical binary encodings @@ -16,6 +18,8 @@ verified Complexitylib machines that split them in polynomial time. No semantic decoder or choice function occurs in these accessors. -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineExecutableCertificate.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineExecutableCertificate.lean index 4990b5679e..812659a02d 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineExecutableCertificate.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineExecutableCertificate.lean @@ -3,11 +3,13 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.ExecutableCertificateMagnitude -import LeanPool.BeyondBethe.BeyondBethe.MachineCertificateExpGuard -import LeanPool.BeyondBethe.BeyondBethe.MachineExecutableScannedOptimizerOutput -import LeanPool.BeyondBethe.BeyondBethe.MachineMatchingGain + +public import LeanPool.BeyondBethe.BeyondBethe.ExecutableCertificateMagnitude +public import LeanPool.BeyondBethe.BeyondBethe.MachineCertificateExpGuard +public import LeanPool.BeyondBethe.BeyondBethe.MachineExecutableScannedOptimizerOutput +public import LeanPool.BeyondBethe.BeyondBethe.MachineMatchingGain /-! # The certificate evaluator for the executable row-major optimizer @@ -18,6 +20,8 @@ optimizer output, using only the executable optimizer's proved certificate-log magnitude bound. -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineExecutablePositiveAlgorithm.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineExecutablePositiveAlgorithm.lean index f1f06fed92..5c267ee2c8 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineExecutablePositiveAlgorithm.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineExecutablePositiveAlgorithm.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.ExecutablePositiveRoutine -import LeanPool.BeyondBethe.BeyondBethe.MachineExecutableCertificate -import LeanPool.BeyondBethe.BeyondBethe.MachinePositiveAlgorithm + +public import LeanPool.BeyondBethe.BeyondBethe.ExecutablePositiveRoutine +public import LeanPool.BeyondBethe.BeyondBethe.MachineExecutableCertificate +public import LeanPool.BeyondBethe.BeyondBethe.MachinePositiveAlgorithm /-! # Finite-word realization of the executable positive-matrix routine @@ -16,6 +18,8 @@ evaluator, normalization, and scale restoration. Correctness is required only on positive inputs, exactly the domain used by the smoothing reduction. -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineExecutableScannedOptimizerOutput.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineExecutableScannedOptimizerOutput.lean index 6e9eb405e0..a2a61dda12 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineExecutableScannedOptimizerOutput.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineExecutableScannedOptimizerOutput.lean @@ -3,11 +3,13 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.ExecutableScannedBetheOptimizer -import LeanPool.BeyondBethe.BeyondBethe.MachineUnaryMatrixGenerator -import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerMatrixBitBound -import LeanPool.BeyondBethe.BeyondBethe.OptimizerOutputEncoding + +public import LeanPool.BeyondBethe.BeyondBethe.ExecutableScannedBetheOptimizer +public import LeanPool.BeyondBethe.BeyondBethe.MachineUnaryMatrixGenerator +public import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerMatrixBitBound +public import LeanPool.BeyondBethe.BeyondBethe.OptimizerOutputEncoding /-! # Finite-word output of the executable scanned optimizer @@ -19,6 +21,8 @@ in row-major order and normalized before being inserted into the nested row encoding. -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineExplicitCertificate.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineExplicitCertificate.lean index 63c504156e..999455e1bf 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineExplicitCertificate.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineExplicitCertificate.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineCertificateExpGuard -import LeanPool.BeyondBethe.BeyondBethe.MachineMatchingGain + +public import LeanPool.BeyondBethe.BeyondBethe.MachineCertificateExpGuard +public import LeanPool.BeyondBethe.BeyondBethe.MachineMatchingGain /-! # The complete finite-word certificate evaluator @@ -15,6 +17,8 @@ directed logarithmic certificate arithmetic, and the polynomial exponential guard. -/ +@[expose] public section + namespace BeyondBethe def machineExplicitCertificateValueRawCode : List Bool → List Bool := diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineFPBasics.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineFPBasics.lean index 3520900921..a2f7a024d4 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineFPBasics.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineFPBasics.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineEncoding -import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.Algebra -import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.Reverse + +public import LeanPool.BeyondBethe.BeyondBethe.MachineEncoding +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.Algebra +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.Reverse /-! # Small verified polynomial-time bitstring combinators @@ -17,6 +19,8 @@ arithmetic and dynamic-state machines below without appealing to a semantic "all Lean programs are efficient" principle. -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineFactorial.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineFactorial.lean index 809cbdb7dd..e64afaf3fc 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineFactorial.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineFactorial.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalLogSeries + +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalLogSeries /-! # Unary-input factorial in the finite-word machine model @@ -15,6 +17,8 @@ clamp. Both evolving fields are clamped on malformed inputs; the ordinary binary-size proof shows that neither clamp fires on a unary ruler. -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineFinalScalars.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineFinalScalars.lean index 2d0a788e00..fed8e454d5 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineFinalScalars.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineFinalScalars.lean @@ -3,15 +3,19 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineMatrixNormalization -import LeanPool.BeyondBethe.BeyondBethe.MachineSmallDimension -import LeanPool.BeyondBethe.BeyondBethe.FinalAssembly + +public import LeanPool.BeyondBethe.BeyondBethe.MachineMatrixNormalization +public import LeanPool.BeyondBethe.BeyondBethe.MachineSmallDimension +public import LeanPool.BeyondBethe.BeyondBethe.FinalAssembly /-! # Connections between scalar machines and the completed algorithm -/ +@[expose] public section + namespace BeyondBethe @[simp] theorem machineMatrixNonnegativeBit_finalDecision {n : ℕ} diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineFourCoreCost.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineFourCoreCost.lean index 07c9cd4bac..deb2afb15c 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineFourCoreCost.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineFourCoreCost.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineDirectedTransferCost + +public import LeanPool.BeyondBethe.BeyondBethe.MachineDirectedTransferCost /-! # The four-core directed cost as a finite-word function @@ -15,6 +17,8 @@ The output is the unreduced rational sum of the four directed transfer-cost endpoints used by the executable row-pair certificate. -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineGreedyRowMatching.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineGreedyRowMatching.lean index 9a7ee4eb6f..7d3cc7bf3e 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineGreedyRowMatching.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineGreedyRowMatching.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineRowPairDisjoint + +public import LeanPool.BeyondBethe.BeyondBethe.MachineRowPairDisjoint /-! # The deterministic greedy row matcher as a finite-word function @@ -15,6 +17,8 @@ ordered row pairs as a self-delimiting list. Disjointness is delegated to the verified list scanner, avoiding a separate mutable-memory invariant. -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineIntegerArithmetic.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineIntegerArithmetic.lean index 47eba1f0c6..e517a2298a 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineIntegerArithmetic.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineIntegerArithmetic.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalNormalization + +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalNormalization /-! # Polynomial-time signed integer arithmetic @@ -14,6 +16,8 @@ Conversion back to `integerBinaryCode` forces the sign to be nonnegative when the magnitude is zero, avoiding the `Int.negSucc` negative-zero pitfall. -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineIntegerCompare.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineIntegerCompare.lean index 49b8ebd69f..97ded98f25 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineIntegerCompare.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineIntegerCompare.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineIntegerArithmetic + +public import LeanPool.BeyondBethe.BeyondBethe.MachineIntegerArithmetic /-! # Polynomial-time signed-integer comparison @@ -15,6 +17,8 @@ comparisons then reduce to natural comparison; for two negative operands the order of the magnitudes is reversed. -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineIntegerSignedMagnitude.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineIntegerSignedMagnitude.lean index 178bfaa866..33b6a338f4 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineIntegerSignedMagnitude.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineIntegerSignedMagnitude.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineBinaryGCD -import LeanPool.BeyondBethe.BeyondBethe.MachineOutputEncoding -import LeanPool.BeyondBethe.BeyondBethe.RawRational + +public import LeanPool.BeyondBethe.BeyondBethe.MachineBinaryGCD +public import LeanPool.BeyondBethe.BeyondBethe.MachineOutputEncoding +public import LeanPool.BeyondBethe.BeyondBethe.RawRational /-! # Signed integers at the rational-arithmetic boundary @@ -17,6 +19,8 @@ payload of a negative integer is one less than its absolute value. The machines below perform the required conversion explicitly. -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineKuhnEncoding.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineKuhnEncoding.lean index 91601da9bd..9f1f221161 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineKuhnEncoding.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineKuhnEncoding.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineUnaryRange + +public import LeanPool.BeyondBethe.BeyondBethe.MachineUnaryRange /-! # Finite-word encoding of the explicit Kuhn evaluator @@ -15,6 +17,8 @@ right-nested stack. The rational matrix and the dimension-derived constant words are carried unchanged beside the control word. -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineKuhnInvariant.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineKuhnInvariant.lean index 1aa1bbc9f3..2cef862bed 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineKuhnInvariant.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineKuhnInvariant.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineKuhnSemantics -import LeanPool.BeyondBethe.BeyondBethe.MachineMatrixDimension -import Mathlib.Tactic + +public import LeanPool.BeyondBethe.BeyondBethe.MachineKuhnSemantics +public import LeanPool.BeyondBethe.BeyondBethe.MachineMatrixDimension +public import Mathlib.Tactic /-! # Reachable-state bounds for the encoded Kuhn evaluator @@ -17,6 +19,8 @@ a deliberately generous octic envelope; its only purpose is to make the polynomial-space estimate transparent. -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineKuhnRunner.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineKuhnRunner.lean index c704c737a2..c78f0e6e39 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineKuhnRunner.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineKuhnRunner.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineKuhnInvariant -import Mathlib.Tactic + +public import LeanPool.BeyondBethe.BeyondBethe.MachineKuhnInvariant +public import Mathlib.Tactic /-! # A complete finite-word perfect-matching runner @@ -16,6 +18,8 @@ envelope. All definitions are total on malformed words; the correctness theorems concern canonical matrix encodings. -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineKuhnSemantics.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineKuhnSemantics.lean index f71484789b..bbafb95291 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineKuhnSemantics.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineKuhnSemantics.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineKuhnStep -import Mathlib.Tactic + +public import LeanPool.BeyondBethe.BeyondBethe.MachineKuhnStep +public import Mathlib.Tactic /-! # Correctness of one encoded Kuhn transition @@ -15,6 +17,8 @@ exactly `kuhnEvalStep`. Clamp inactivity and the bounded full run are proved after the semantic size invariant. -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineKuhnStep.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineKuhnStep.lean index 00971f5b59..81fa034d1e 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineKuhnStep.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineKuhnStep.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineKuhnEncoding + +public import LeanPool.BeyondBethe.BeyondBethe.MachineKuhnEncoding /-! # One finite-word transition of the Kuhn evaluator @@ -14,6 +16,8 @@ only pairing, list access/update, Boolean gates, and the rational support query already shown to lie in `FP`. -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineLengthBits.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineLengthBits.lean index 9841cb2697..919e13a219 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineLengthBits.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineLengthBits.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineBinaryAddSemantics + +public import LeanPool.BeyondBethe.BeyondBethe.MachineBinaryAddSemantics /-! # Binary encoding of an input length @@ -14,6 +16,8 @@ little-endian binary. It is useful whenever a later machine needs the value of a unary ruler without expanding an unrestricted binary integer. -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineListIndex.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineListIndex.lean index 49c0bd7de4..bafe54973d 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineListIndex.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineListIndex.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineMatrixDimension + +public import LeanPool.BeyondBethe.BeyondBethe.MachineMatrixDimension /-! # Indexed access to right-nested machine lists @@ -16,6 +18,8 @@ only shrinks, so its global polynomial-time bound does not depend on the input being a well-formed list code. -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineListReverse.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineListReverse.lean index ceea64fbaa..fba0c90058 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineListReverse.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineListReverse.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineListUpdate -import Mathlib.Tactic + +public import LeanPool.BeyondBethe.BeyondBethe.MachineListUpdate +public import Mathlib.Tactic /-! # Reversal of a self-delimiting machine list @@ -17,6 +19,8 @@ exceeds the input length, so the semantic proof below shows that the clamp is inactive. -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineListUpdate.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineListUpdate.lean index 86b0f42efb..6616e6e02c 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineListUpdate.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineListUpdate.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineListIndex + +public import LeanPool.BeyondBethe.BeyondBethe.MachineListIndex /-! # Indexed update of right-nested machine lists @@ -18,6 +20,8 @@ field to an explicit quadratic word. The semantic invariant proves that the clamps are inactive on every canonical in-range list update. -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineMatchingGain.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineMatchingGain.lean index f107efbf33..dd419e2add 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineMatchingGain.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineMatchingGain.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineGreedyRowMatching -import LeanPool.BeyondBethe.BeyondBethe.MachineCertificateAssembly + +public import LeanPool.BeyondBethe.BeyondBethe.MachineGreedyRowMatching +public import LeanPool.BeyondBethe.BeyondBethe.MachineCertificateAssembly /-! # Counting the selected pairs and assembling the fixed matching gain @@ -17,6 +19,8 @@ the input word and stutters after the encoded list is exhausted, so it is a total polynomial-time string function even on malformed inputs. -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineMateAllSome.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineMateAllSome.lean index 6165822bac..41bdeb0847 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineMateAllSome.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineMateAllSome.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineKuhnRunner -import Mathlib.Tactic + +public import LeanPool.BeyondBethe.BeyondBethe.MachineKuhnRunner +public import Mathlib.Tactic /-! # Testing whether the final mate table is total @@ -15,6 +17,8 @@ self-delimiting encoding and returns one bit indicating whether every column contains a row. -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineMateMemory.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineMateMemory.lean index 9ddeecc80f..a7c3baaba3 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineMateMemory.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineMateMemory.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineBooleanInit + +public import LeanPool.BeyondBethe.BeyondBethe.MachineBooleanInit /-! # Column-mate memory for augmenting-path matching @@ -16,6 +18,8 @@ recursive augmenting-path search while retaining exact polynomial-time list lookup and update. -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineMatrixAddDelta.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineMatrixAddDelta.lean index c2daec20a2..f8c48fb6f2 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineMatrixAddDelta.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineMatrixAddDelta.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalRowAdd -import LeanPool.BeyondBethe.BeyondBethe.FinalAssembly -import Mathlib.Tactic + +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalRowAdd +public import LeanPool.BeyondBethe.BeyondBethe.FinalAssembly +public import Mathlib.Tactic /-! # Entrywise addition of a rational matrix @@ -18,6 +20,8 @@ polynomial clamp is present on malformed inputs and is proved inactive on every canonical pair of a raw rational and a rational matrix. -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineMatrixDimension.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineMatrixDimension.lean index ee814b2508..9b004f052f 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineMatrixDimension.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineMatrixDimension.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineMatrixSum -import LeanPool.BeyondBethe.BeyondBethe.MachineBoundedUnary + +public import LeanPool.BeyondBethe.BeyondBethe.MachineMatrixSum +public import LeanPool.BeyondBethe.BeyondBethe.MachineBoundedUnary /-! # A guarded unary dimension ruler @@ -16,6 +18,8 @@ used as an explicit guard. Canonical square-matrix encodings are long enough to make this guard inactive. -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineMatrixNonnegative.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineMatrixNonnegative.lean index 83ba88d073..2bada85818 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineMatrixNonnegative.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineMatrixNonnegative.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalCompare -import LeanPool.BeyondBethe.BeyondBethe.RawRationalBitBounds + +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalCompare +public import LeanPool.BeyondBethe.BeyondBethe.RawRationalBitBounds /-! # Polynomial-time matrix nonnegativity guard @@ -16,6 +18,8 @@ encoding directly. The scan never decodes a binary dimension into unary and never invokes Lean's decision procedure on the typed matrix. -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineMatrixNormalization.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineMatrixNormalization.lean index eddf65bc3a..527c808ff8 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineMatrixNormalization.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineMatrixNormalization.lean @@ -3,14 +3,18 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineMatrixDimension -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalPower + +public import LeanPool.BeyondBethe.BeyondBethe.MachineMatrixDimension +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalPower /-! # Machine normalization scale and its dimension power -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineMatrixNormalizeEntries.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineMatrixNormalizeEntries.lean index bc1c83cd27..443b03a1ea 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineMatrixNormalizeEntries.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineMatrixNormalizeEntries.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalRowDivide -import LeanPool.BeyondBethe.BeyondBethe.FinalAssembly -import Mathlib.Tactic + +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalRowDivide +public import LeanPool.BeyondBethe.BeyondBethe.FinalAssembly +public import Mathlib.Tactic /-! # Entrywise normalization of a rational matrix @@ -17,6 +19,8 @@ verified row-division machine. A polynomial clamp is present on malformed inputs and is proved inactive on every canonical rational matrix. -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineMatrixSum.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineMatrixSum.lean index 920b1027f7..ed396a647b 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineMatrixSum.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineMatrixSum.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineMatrixNonnegative + +public import LeanPool.BeyondBethe.BeyondBethe.MachineMatrixNonnegative /-! # Polynomial-time row-major rational matrix sum @@ -16,6 +18,8 @@ semantic width invariant below proves that the clamp is inactive on every canonical matrix input. -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineMatrixSupportProduct.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineMatrixSupportProduct.lean index b68de9e8e5..164bfa723a 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineMatrixSupportProduct.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineMatrixSupportProduct.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineMatrixSum -import LeanPool.BeyondBethe.BeyondBethe.MachineBooleanMemory -import LeanPool.BeyondBethe.BeyondBethe.FinalAssembly + +public import LeanPool.BeyondBethe.BeyondBethe.MachineMatrixSum +public import LeanPool.BeyondBethe.BeyondBethe.MachineBooleanMemory +public import LeanPool.BeyondBethe.BeyondBethe.FinalAssembly /-! # Row-major support product of a rational matrix @@ -18,6 +20,8 @@ rational; a quadratic clamp is total on malformed inputs and is proved inactive on canonical matrices. -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineNaturalCombinators.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineNaturalCombinators.lean index 25e0596776..4db9b354a5 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineNaturalCombinators.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineNaturalCombinators.lean @@ -3,11 +3,15 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineBinaryMul + +public import LeanPool.BeyondBethe.BeyondBethe.MachineBinaryMul /-! # Machine Natural Combinators -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineNearbyCoordinate.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineNearbyCoordinate.lean index ac1583989a..f73064767b 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineNearbyCoordinate.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineNearbyCoordinate.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineScheduledLog -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalNormalization + +public import LeanPool.BeyondBethe.BeyondBethe.MachineScheduledLog +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalNormalization /-! # One directed nearby-Bethe coordinate as a finite-word function @@ -17,6 +19,8 @@ output is the unreduced rational `scheduledLogLower (1-x) p + tau*x*scheduledLogLower x p`. -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineNearbyMatrixSum.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineNearbyMatrixSum.lean index be860e13b4..0e91b53409 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineNearbyMatrixSum.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineNearbyMatrixSum.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineScheduledLogWidth + +public import LeanPool.BeyondBethe.BeyondBethe.MachineScheduledLogWidth /-! # Row-major evaluation of the nearby-Bethe coordinate sum @@ -19,6 +21,8 @@ accumulator is clamped by an explicit iterated-quadratic word; the semantic section proves separately that this clamp is inactive on canonical inputs. -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineNestedMatrixMemory.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineNestedMatrixMemory.lean index 834b26c7e8..a81cf89bea 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineNestedMatrixMemory.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineNestedMatrixMemory.lean @@ -3,12 +3,16 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineListIndex -import LeanPool.BeyondBethe.BeyondBethe.MachineListUpdate + +public import LeanPool.BeyondBethe.BeyondBethe.MachineListIndex +public import LeanPool.BeyondBethe.BeyondBethe.MachineListUpdate /-! # Machine Nested Matrix Memory -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerBisectionLoop.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerBisectionLoop.lean index 2ce45288c5..de3afb30b2 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerBisectionLoop.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerBisectionLoop.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerFeasibilityCall -import LeanPool.BeyondBethe.BeyondBethe.ScannedBetheBisection -import Mathlib.Tactic + +public import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerFeasibilityCall +public import LeanPool.BeyondBethe.BeyondBethe.ScannedBetheBisection +public import Mathlib.Tactic /-! # A finite-word dyadic bisection loop for the Bethe optimizer @@ -23,6 +25,8 @@ most one bit in each of its two mutable fields. This gives a direct global polynomial state envelope for the bounded iteration. -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerBisectionSchedule.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerBisectionSchedule.lean index 733b4c2163..b8e2f509ff 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerBisectionSchedule.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerBisectionSchedule.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerDerivedScales + +public import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerDerivedScales /-! # Initial interval and bisection schedule as finite-word functions @@ -15,6 +17,8 @@ of that width and of the optimizer gap, plus three. Both schedules are returned in unary, so later bounded iterations can consume them directly. -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerBisectionSemantics.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerBisectionSemantics.lean index 459df30ff2..da0117940f 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerBisectionSemantics.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerBisectionSemantics.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerBisectionLoop -import Mathlib.Tactic + +public import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerBisectionLoop +public import Mathlib.Tactic /-! # Exact semantics of the dyadic optimizer bisection machine @@ -16,6 +18,8 @@ is inferred from a decoder: every intermediate word is reduced to the canonical project encoding of its stated rational value. -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerCertificateBoundary.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerCertificateBoundary.lean index cace734b3b..b517b8e6db 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerCertificateBoundary.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerCertificateBoundary.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachinePositiveAlgorithm -import LeanPool.BeyondBethe.BeyondBethe.OptimizerOutputEncoding + +public import LeanPool.BeyondBethe.BeyondBethe.MachinePositiveAlgorithm +public import LeanPool.BeyondBethe.BeyondBethe.OptimizerOutputEncoding /-! # The finite-word interface between optimization and certification @@ -22,6 +24,8 @@ Every well-formed optimizer output is a right-nested word built from the already fixed matrix and rational-entry encodings. -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerDerivedScales.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerDerivedScales.lean index 3bac453f1a..8e32822c19 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerDerivedScales.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerDerivedScales.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerInteriorScale -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalMin + +public import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerInteriorScale +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalMin /-! # Remaining rational scales and precision ruler for the optimizer @@ -16,6 +18,8 @@ directly as a unary ruler assembled from the exact canonical encoding length of the objective gap and fixed dimension-dependent summands. -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerEntryLength.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerEntryLength.lean index 6f946d1273..6091a81663 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerEntryLength.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerEntryLength.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineIntegerSignedMagnitude -import LeanPool.BeyondBethe.BeyondBethe.MachineLengthBits -import LeanPool.BeyondBethe.BeyondBethe.RationalEncodingBounds + +public import LeanPool.BeyondBethe.BeyondBethe.MachineIntegerSignedMagnitude +public import LeanPool.BeyondBethe.BeyondBethe.MachineLengthBits +public import LeanPool.BeyondBethe.BeyondBethe.RationalEncodingBounds /-! # Exact unary lengths for optimizer matrix entries @@ -17,6 +19,8 @@ exactly from the numerator and denominator subwords. Producing a unary ruler is the useful form: every later precision loop consumes its schedule in unary. -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerFeasibilityCall.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerFeasibilityCall.lean index d9f8e6fcef..13f4e165b8 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerFeasibilityCall.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerFeasibilityCall.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerStateBound -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalBallInit + +public import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerStateBound +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalBallInit /-! # A complete finite-word Bethe threshold call @@ -16,6 +18,8 @@ the initial ball, and the state-size ruler are produced by verified finite-word machines. -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerFeasibilitySchedule.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerFeasibilitySchedule.lean index d0796e8f8b..b6039adbc0 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerFeasibilitySchedule.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerFeasibilitySchedule.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerBisectionSchedule + +public import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerBisectionSchedule /-! # Finite-word budget for one Bethe feasibility call @@ -16,6 +18,8 @@ to unary only behind a degree-eight guard built from the exact unary dimension and the exact canonical bit lengths of both radii. -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerInteriorScale.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerInteriorScale.lean index 078f35fa97..de62193c25 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerInteriorScale.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerInteriorScale.lean @@ -3,12 +3,14 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerMatrixBitBound -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalPower -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalFloor -import LeanPool.BeyondBethe.BeyondBethe.MachineCertificateExpGuard -import LeanPool.BeyondBethe.BeyondBethe.ExplicitOptimizerScales + +public import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerMatrixBitBound +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalPower +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalFloor +public import LeanPool.BeyondBethe.BeyondBethe.MachineCertificateExpGuard +public import LeanPool.BeyondBethe.BeyondBethe.ExplicitOptimizerScales /-! # Finite-word interior scale for the Bethe optimizer @@ -19,6 +21,8 @@ degree-64 guard in the source matrix length. Thus this file does not hide an unrestricted binary-to-unary conversion. -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerMatrixBitBound.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerMatrixBitBound.lean index 6ec75fa9cf..5ba31aeec3 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerMatrixBitBound.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerMatrixBitBound.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerEntryLength -import LeanPool.BeyondBethe.BeyondBethe.MachineMatrixSum -import LeanPool.BeyondBethe.BeyondBethe.CertificateMagnitude + +public import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerEntryLength +public import LeanPool.BeyondBethe.BeyondBethe.MachineMatrixSum +public import LeanPool.BeyondBethe.BeyondBethe.CertificateMagnitude /-! # Exact matrix entry-bit bound for the optimizer @@ -17,6 +19,8 @@ on arbitrary bitstrings; the clamp is proved inactive on every canonical matrix input. -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerRoundingSchedule.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerRoundingSchedule.lean index dd10a7844f..3677235cc2 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerRoundingSchedule.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerRoundingSchedule.lean @@ -3,13 +3,17 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerFeasibilitySchedule -import LeanPool.BeyondBethe.BeyondBethe.MachineNaturalCombinators -import LeanPool.BeyondBethe.BeyondBethe.ExplicitBetheThresholdFeasibility + +public import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerFeasibilitySchedule +public import LeanPool.BeyondBethe.BeyondBethe.MachineNaturalCombinators +public import LeanPool.BeyondBethe.BeyondBethe.ExplicitBetheThresholdFeasibility /-! # Machine Optimizer Rounding Schedule -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerStateBound.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerStateBound.lean index 936bbfcd78..27c7ddb655 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerStateBound.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerStateBound.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineBetheFeasibilityFit -import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerRoundingSchedule + +public import LeanPool.BeyondBethe.BeyondBethe.MachineBetheFeasibilityFit +public import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerRoundingSchedule /-! # Finite-word state ruler for one optimizer feasibility call @@ -16,6 +18,8 @@ computes the proved ordinary-binary state bound from the same finite-word dimension, budget, magnitude, and precision schedules used by the call. -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerTests.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerTests.lean index a403e8677e..ab54a0b5c2 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerTests.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerTests.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineBetheFloorScan -import LeanPool.BeyondBethe.BeyondBethe.MachineExecutableScannedOptimizerOutput -import LeanPool.BeyondBethe.BeyondBethe.MachineMatchingGain + +public import LeanPool.BeyondBethe.BeyondBethe.MachineBetheFloorScan +public import LeanPool.BeyondBethe.BeyondBethe.MachineExecutableScannedOptimizerOutput +public import LeanPool.BeyondBethe.BeyondBethe.MachineMatchingGain /-! # Exhaustive small tests for the optimizer and certificate boundary @@ -16,6 +18,8 @@ They execute the finite-word programs on small finite families; correctness of the public theorem itself continues to use the symbolic proofs. -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineOutputEncoding.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineOutputEncoding.lean index 8444b9abfe..7ede101dc7 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineOutputEncoding.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineOutputEncoding.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineBinaryCompare -import LeanPool.BeyondBethe.BeyondBethe.MachineBinaryMul + +public import LeanPool.BeyondBethe.BeyondBethe.MachineBinaryCompare +public import LeanPool.BeyondBethe.BeyondBethe.MachineBinaryMul /-! # Polynomial-time canonical output encodings @@ -16,6 +18,8 @@ that pairing formula from the verified arithmetic primitives, and then proves the complete rational encoder correct. -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachinePerfectMatching.lean b/LeanPool/BeyondBethe/BeyondBethe/MachinePerfectMatching.lean index ff2f9f4e61..f4a5fed10b 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachinePerfectMatching.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachinePerfectMatching.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineMateAllSome -import Mathlib.Tactic + +public import LeanPool.BeyondBethe.BeyondBethe.MachineMateAllSome +public import Mathlib.Tactic /-! # A finite-word perfect-matching decision procedure @@ -16,6 +18,8 @@ canonical encoding of a square rational matrix it returns `[true]` exactly when the positive support contains a perfect matching. -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachinePositiveAlgorithm.lean b/LeanPool/BeyondBethe/BeyondBethe/MachinePositiveAlgorithm.lean index 6ebf1e72a6..5ce0c24be7 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachinePositiveAlgorithm.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachinePositiveAlgorithm.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineCompletedAlgorithm -import LeanPool.BeyondBethe.BeyondBethe.ExplicitPositiveRoutine + +public import LeanPool.BeyondBethe.BeyondBethe.MachineCompletedAlgorithm +public import LeanPool.BeyondBethe.BeyondBethe.ExplicitPositiveRoutine /-! # Finite-word wrapper for the positive-matrix routine @@ -15,6 +17,8 @@ dimensions from the remaining positive-routine boundary. The only parameter is a raw-output machine for the normalized optimizer-plus-certificate value. -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRAMBridge.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRAMBridge.lean index 71b69fb0d9..6b24b0b353 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineRAMBridge.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRAMBridge.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineFPBasics -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Containment + +public import LeanPool.BeyondBethe.BeyondBethe.MachineFPBasics +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Containment /-! # From logarithmic-cost RAM deciders to one-bit `FP` functions @@ -17,6 +19,8 @@ This file proves the first, generic bridge without introducing a machine-time assumption. -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRAMSmoke.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRAMSmoke.lean index cb735c9710..bf9c64a357 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineRAMSmoke.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRAMSmoke.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineTrimHighZeros -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine + +public import LeanPool.BeyondBethe.BeyondBethe.MachineTrimHighZeros +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine /-! # End-to-end smoke test for the RAM bit-graph bridge @@ -17,6 +19,8 @@ simulation by a deterministic Turing machine, bounded bit assembly, and canonical high-zero trimming. -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalArithmetic.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalArithmetic.lean index 923c282cb4..7f34b982a0 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalArithmetic.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalArithmetic.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineIntegerArithmetic + +public import LeanPool.BeyondBethe.BeyondBethe.MachineIntegerArithmetic /-! # Polynomial-time rational addition and multiplication @@ -15,6 +17,8 @@ operations then invoke the separately verified gcd normalizer, so no use of Lean's built-in rational arithmetic is hidden in the machine implementation. -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalBallInit.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalBallInit.lean index 9e45ba8ded..89b9d10ef9 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalBallInit.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalBallInit.lean @@ -3,14 +3,18 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalEllipsoidEncoding -import LeanPool.BeyondBethe.BeyondBethe.MachineRepeatPair -import LeanPool.BeyondBethe.BeyondBethe.MachineNestedMatrixMemory -import LeanPool.BeyondBethe.BeyondBethe.MachineLengthBits + +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalEllipsoidEncoding +public import LeanPool.BeyondBethe.BeyondBethe.MachineRepeatPair +public import LeanPool.BeyondBethe.BeyondBethe.MachineNestedMatrixMemory +public import LeanPool.BeyondBethe.BeyondBethe.MachineLengthBits /-! # Machine Rational Ball Init -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalCompare.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalCompare.lean index 280b377918..dc39130bb7 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalCompare.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalCompare.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineIntegerCompare -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalArithmetic + +public import LeanPool.BeyondBethe.BeyondBethe.MachineIntegerCompare +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalArithmetic /-! # Polynomial-time comparison of unreduced rationals @@ -15,6 +17,8 @@ two cross-products are exactly the products already used by rational addition; the final comparison is the verified signed-integer machine. -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalDirectionUpdateMatrix.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalDirectionUpdateMatrix.lean index 32751ce67d..624eb1e605 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalDirectionUpdateMatrix.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalDirectionUpdateMatrix.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalDirectionUpdateRow -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalMatrixMul + +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalDirectionUpdateRow +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalMatrixMul /-! # Polynomial-time direction-update matrices @@ -14,6 +16,8 @@ This module maps the verified row constructor over all row indices. The result is the full rational matrix used to update an ellipsoid basis. -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalDirectionUpdateRow.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalDirectionUpdateRow.lean index 370ffdd177..c96c1d2f91 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalDirectionUpdateRow.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalDirectionUpdateRow.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalBallInit -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalEllipsoidCenterUpdate + +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalBallInit +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalEllipsoidCenterUpdate /-! # Polynomial-time rows of the ellipsoid direction update @@ -19,6 +21,8 @@ The diagonal row is built by updating an encoded zero vector, while the rank-one row is produced by one scalar-vector multiplication. -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalEllipsoidCenterUpdate.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalEllipsoidCenterUpdate.lean index 1e244d40d9..0c2b3dd260 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalEllipsoidCenterUpdate.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalEllipsoidCenterUpdate.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineBoundedUnary -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalVectorSub + +public import LeanPool.BeyondBethe.BeyondBethe.MachineBoundedUnary +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalVectorSub /-! # Polynomial-time center part of the rational ellipsoid update @@ -16,6 +18,8 @@ back through the transposed basis, normalizes by its `ℓ1` norm, multiplies by the basis, scales by `alpha`, and subtracts from the stored center. -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalEllipsoidEncoding.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalEllipsoidEncoding.lean index aadab28dea..bd38da2407 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalEllipsoidEncoding.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalEllipsoidEncoding.lean @@ -3,13 +3,17 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineEncoding -import LeanPool.BeyondBethe.BeyondBethe.MachineFPBasics -import LeanPool.BeyondBethe.BeyondBethe.RationalFeasibility + +public import LeanPool.BeyondBethe.BeyondBethe.MachineEncoding +public import LeanPool.BeyondBethe.BeyondBethe.MachineFPBasics +public import LeanPool.BeyondBethe.BeyondBethe.RationalFeasibility /-! # Machine Rational Ellipsoid Encoding -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalEllipsoidScalars.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalEllipsoidScalars.lean index 96ba8e76d4..2e281ba77d 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalEllipsoidScalars.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalEllipsoidScalars.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalVectorL1 + +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalVectorL1 /-! # Polynomial-time coefficients for the rational ellipsoid update @@ -16,6 +18,8 @@ arithmetic machines. The raw formulas are kept explicit so that no field operation is hidden in the executable layer. -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalEllipsoidUpdate.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalEllipsoidUpdate.lean index 29ea76a96b..1657daca43 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalEllipsoidUpdate.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalEllipsoidUpdate.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalDirectionUpdateMatrix + +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalDirectionUpdateMatrix /-! # Polynomial-time rational central ellipsoid update @@ -14,6 +16,8 @@ direction matrix, and exact matrix multiplication into the canonical code of one complete rational ellipsoid state. -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalExp.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalExp.lean index 64c0f4aea9..594f770ef0 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalExp.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalExp.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineBoundedUnary -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalLogSeries + +public import LeanPool.BeyondBethe.BeyondBethe.MachineBoundedUnary +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalLogSeries /-! # Guarded polynomial-time directed rational exponential @@ -22,6 +24,8 @@ string and agrees exactly with the directed rational exponential whenever the guard has length at least `M`. -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalFloor.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalFloor.lean index 3176f0d80d..2ff09cc2ca 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalFloor.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalFloor.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineDyadicFloor -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalUnary + +public import LeanPool.BeyondBethe.BeyondBethe.MachineDyadicFloor +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalUnary /-! # Polynomial-time rational floor and ceiling @@ -17,6 +19,8 @@ unary: converting an unrestricted binary integer to a word of that length would not be a polynomial-time operation. -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalLogSeries.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalLogSeries.lean index d6993d758f..cbdb7e1142 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalLogSeries.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalLogSeries.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalFloor -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalPower -import LeanPool.BeyondBethe.BeyondBethe.BinaryDirectedElementary + +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalFloor +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalPower +public import LeanPool.BeyondBethe.BeyondBethe.BinaryDirectedElementary /-! # Polynomial-time rational logarithm-series loop @@ -18,6 +20,8 @@ arbitrary strings. The semantic part below proves that none of the three guarded updates is truncated on a well-formed input. -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalMatrixColumn.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalMatrixColumn.lean index cdd6059902..bd49bbf415 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalMatrixColumn.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalMatrixColumn.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalVectorDot -import Mathlib.Data.List.GetD + +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalVectorDot +public import Mathlib.Data.List.GetD /-! # Polynomial-time extraction of rational matrix columns @@ -17,6 +19,8 @@ the exactness theorem only assumes that the selected column exists in every row. -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalMatrixMul.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalMatrixMul.lean index a360026cc6..97b6a03568 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalMatrixMul.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalMatrixMul.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalMatrixMulVector + +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalMatrixMulVector /-! # Polynomial-time rational matrix multiplication @@ -16,6 +18,8 @@ therefore supplies the arithmetic kernel. A bounded outer scan assembles the rows. -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalMatrixMulVector.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalMatrixMulVector.lean index 02b249ac64..77de5eeee4 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalMatrixMulVector.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalMatrixMulVector.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalNormalizedDirection -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalTransposeMulVector + +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalNormalizedDirection +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalTransposeMulVector /-! # Polynomial-time rational matrix--vector multiplication @@ -17,6 +19,8 @@ vector code; it extracts that row and invokes the already verified exact dot product machine. -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalMatrixUpdate.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalMatrixUpdate.lean index 37c07f7ca2..19d91783aa 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalMatrixUpdate.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalMatrixUpdate.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineListUpdate -import Mathlib.Tactic + +public import LeanPool.BeyondBethe.BeyondBethe.MachineListUpdate +public import Mathlib.Tactic /-! # Mutable rational-matrix memory @@ -16,6 +18,8 @@ updates the selected entry of the right-nested row-major matrix encoding and preserves the original binary dimension word. -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalMin.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalMin.lean index 03461d022b..b600c3f5e7 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalMin.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalMin.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalCompare -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalNormalization + +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalCompare +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalNormalization /-! # Exact finite-word minimum of two rationals @@ -16,6 +18,8 @@ selected fraction. This is the minimum operation used in the rational smoothing level. -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalNormalization.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalNormalization.lean index ebd58e9eba..66b7ad89ab 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalNormalization.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalNormalization.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineIntegerSignedMagnitude + +public import LeanPool.BeyondBethe.BeyondBethe.MachineIntegerSignedMagnitude /-! # Polynomial-time normalization of unreduced rationals @@ -15,6 +17,8 @@ computes the absolute numerator, their gcd, both exact quotients, restores the integer sign, and finally applies the public rational encoder. -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalNormalizedDirection.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalNormalizedDirection.lean index 21c591c294..991a7008ef 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalNormalizedDirection.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalNormalizedDirection.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalEllipsoidScalars -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalRowDivide + +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalEllipsoidScalars +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalRowDivide /-! # Polynomial-time rational normalization of a cut direction @@ -16,6 +18,8 @@ to the verified row-division fold. Thus the composition performs no decoding and no hidden field arithmetic. -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalPower.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalPower.lean index 07573424a3..b2a1bbe974 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalPower.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalPower.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalUnary + +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalUnary /-! # A bounded polynomial-time rational power loop @@ -15,6 +17,8 @@ polynomial-time even on malformed strings; a separate bit-growth proof shows that it never truncates a well-formed unreduced power. -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalRowAdd.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalRowAdd.lean index e8147e9ac0..b1406acf77 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalRowAdd.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalRowAdd.lean @@ -3,11 +3,13 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineListReverse -import LeanPool.BeyondBethe.BeyondBethe.MachineMatrixSum -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalArithmetic -import Mathlib.Tactic + +public import LeanPool.BeyondBethe.BeyondBethe.MachineListReverse +public import LeanPool.BeyondBethe.BeyondBethe.MachineMatrixSum +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalArithmetic +public import Mathlib.Tactic /-! # Adding every entry of a rational row by one raw rational @@ -18,6 +20,8 @@ This is deliberately not `machineRationalDivCode`, whose public output uses a different one-natural encoding. -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalRowDivide.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalRowDivide.lean index f05b9d03eb..2010b45974 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalRowDivide.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalRowDivide.lean @@ -3,11 +3,13 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineListReverse -import LeanPool.BeyondBethe.BeyondBethe.MachineMatrixSum -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalUnary -import Mathlib.Tactic + +public import LeanPool.BeyondBethe.BeyondBethe.MachineListReverse +public import LeanPool.BeyondBethe.BeyondBethe.MachineMatrixSum +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalUnary +public import Mathlib.Tactic /-! # Dividing every entry of a rational row by one raw rational @@ -18,6 +20,8 @@ This is deliberately not `machineRationalDivCode`, whose public output uses a different one-natural encoding. -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalTransposeMulVector.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalTransposeMulVector.lean index 7bb5e3fb3d..49878a32d4 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalTransposeMulVector.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalTransposeMulVector.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalMatrixColumn -import LeanPool.BeyondBethe.BeyondBethe.MachineUnaryRange + +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalMatrixColumn +public import LeanPool.BeyondBethe.BeyondBethe.MachineUnaryRange /-! # Polynomial-time rational transpose--vector multiplication @@ -17,6 +19,8 @@ inputs; on canonical inputs a separate encoding estimate proves that the clamp never truncates. -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalUnary.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalUnary.lean index c8a5ad5604..acc4862441 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalUnary.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalUnary.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalArithmetic -import LeanPool.BeyondBethe.BeyondBethe.RawRationalBitBounds + +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalArithmetic +public import LeanPool.BeyondBethe.BeyondBethe.RawRationalBitBounds /-! # Polynomial-time rational negation, inversion, and division @@ -15,6 +17,8 @@ positive denominator with the absolute numerator while preserving the numerator sign. Division is multiplication by this verified reciprocal. -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalVectorDot.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalVectorDot.lean index c6b3c7e20e..b57eb722d5 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalVectorDot.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalVectorDot.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalVectorSum -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalEllipsoidEncoding + +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalVectorSum +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalEllipsoidEncoding /-! # Polynomial-time dot products of rational vectors @@ -18,6 +20,8 @@ the semantic invariant proves that the clamp is inactive on canonical vector inputs. -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalVectorL1.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalVectorL1.lean index e9a510bda0..673e7c13ec 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalVectorL1.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalVectorL1.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalVectorSum -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalEllipsoidEncoding + +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalVectorSum +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalEllipsoidEncoding /-! # Polynomial-time rational `ℓ1` norms @@ -18,6 +20,8 @@ makes the transducer polynomially bounded on malformed words, while the semantic invariant proves that the clamp is inactive on canonical inputs. -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalVectorScale.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalVectorScale.lean index 8f646ae8ee..1875851b03 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalVectorScale.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalVectorScale.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalNormalizedDirection + +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalNormalizedDirection /-! # Polynomial-time rational vector scaling @@ -16,6 +18,8 @@ inverse convention. The reciprocal remains an unreduced `RawRat` word, so the composition performs no decoding or hidden rational arithmetic. -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalVectorSub.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalVectorSub.lean index 37941320af..e5a566a5b1 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalVectorSub.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalVectorSub.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalMatrixMulVector -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalVectorScale + +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalMatrixMulVector +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalVectorScale /-! # Polynomial-time componentwise subtraction of rational vectors @@ -16,6 +18,8 @@ raw rational, adds, and normalizes. A bounded finite-word scan maps this routine over all coordinates and reverses its accumulator once at the end. -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalVectorSum.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalVectorSum.lean index 8be4fbaa16..e65eda4b1d 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalVectorSum.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalVectorSum.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerCertificateBoundary -import LeanPool.BeyondBethe.BeyondBethe.MachineMatrixSum + +public import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerCertificateBoundary +public import LeanPool.BeyondBethe.BeyondBethe.MachineMatrixSum /-! # Polynomial-time rational-vector summation @@ -17,6 +19,8 @@ arbitrary rectangular list of rows; square matrices are not needed by the fold itself. -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRepeatPair.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRepeatPair.lean index aa09ecb6cc..68534a2cd1 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineRepeatPair.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRepeatPair.lean @@ -3,12 +3,16 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineBinaryMul -import LeanPool.BeyondBethe.BeyondBethe.MachineFPBasics + +public import LeanPool.BeyondBethe.BeyondBethe.MachineBinaryMul +public import LeanPool.BeyondBethe.BeyondBethe.MachineFPBasics /-! # Machine Repeat Pair -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRowComplementUpperSum.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRowComplementUpperSum.lean index ae3ba67b38..199d124ce5 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineRowComplementUpperSum.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRowComplementUpperSum.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineNearbyMatrixSum + +public import LeanPool.BeyondBethe.BeyondBethe.MachineNearbyMatrixSum /-! # A directed upper logarithm sum for one matrix row @@ -20,6 +22,8 @@ rational accumulator by an explicit degree-eight word. The semantic proof shows that the clamp is inactive on every canonical in-range row query. -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRowPairDisjoint.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRowPairDisjoint.lean index b56ca9e9c4..bbe65050eb 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineRowPairDisjoint.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRowPairDisjoint.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineCertifiedPairEligibility -import LeanPool.BeyondBethe.BeyondBethe.MachineListReverse + +public import LeanPool.BeyondBethe.BeyondBethe.MachineCertifiedPairEligibility +public import LeanPool.BeyondBethe.BeyondBethe.MachineListReverse /-! # Disjointness from an encoded row-pair list @@ -17,6 +19,8 @@ inputs remain polynomially bounded; after the encoded list is exhausted the step stutters. -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineScheduledLog.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineScheduledLog.lean index 61b65d8d72..b35e4ae868 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineScheduledLog.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineScheduledLog.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineCertificateScales -import LeanPool.BeyondBethe.BeyondBethe.MachineIntegerSignedMagnitude + +public import LeanPool.BeyondBethe.BeyondBethe.MachineCertificateScales +public import LeanPool.BeyondBethe.BeyondBethe.MachineIntegerSignedMagnitude /-! # The input-dependent directed-logarithm schedule @@ -16,6 +18,8 @@ ruler and the signed dyadic exponent of `q`, expands it under a quadratic guard, and invokes the verified directed-logarithm machine. -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineScheduledLogWidth.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineScheduledLogWidth.lean index 3059861e0b..9225f68ec6 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineScheduledLogWidth.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineScheduledLogWidth.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineNearbyCoordinate + +public import LeanPool.BeyondBethe.BeyondBethe.MachineNearbyCoordinate /-! # Explicit raw-width bounds for scheduled logarithms @@ -15,6 +17,8 @@ the exact arithmetic definitions, so the matrix-fold clamp can later be proved inactive without an abstract bit-complexity assumption. -/ +@[expose] public section + namespace BeyondBethe def rawLogSeriesWidthBudget (w N : ℕ) : ℕ := diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineScheduledRoundedEllipsoid.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineScheduledRoundedEllipsoid.lean index b268e64fec..dcd1c2214e 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineScheduledRoundedEllipsoid.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineScheduledRoundedEllipsoid.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineDyadicFloorMatrix + +public import LeanPool.BeyondBethe.BeyondBethe.MachineDyadicFloorMatrix /-! # Polynomial-time scheduled rounded ellipsoid update @@ -15,6 +17,8 @@ then left-multiplied by an explicitly constructed scalar diagonal matrix, which realizes the prescribed inflation without another matrix mapper. -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineScheduledStateEncodingBound.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineScheduledStateEncodingBound.lean index 94e3596b2c..4ecf6de1da 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineScheduledStateEncodingBound.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineScheduledStateEncodingBound.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineBetheFeasibilitySemantics -import LeanPool.BeyondBethe.BeyondBethe.RationalEncodingBounds -import Mathlib.Tactic + +public import LeanPool.BeyondBethe.BeyondBethe.MachineBetheFeasibilitySemantics +public import LeanPool.BeyondBethe.BeyondBethe.RationalEncodingBounds +public import Mathlib.Tactic /-! # Ordinary binary bounds for scheduled ellipsoid states @@ -16,6 +18,8 @@ finite-word loop needs the corresponding bound on its concrete, nested binary code. This file supplies that elementary bridge without changing encodings. -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineSmallDimension.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineSmallDimension.lean index 681ba33e38..70c86f1772 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineSmallDimension.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineSmallDimension.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineOutputEncoding + +public import LeanPool.BeyondBethe.BeyondBethe.MachineOutputEncoding /-! # Exact order-zero and order-one matrix branches @@ -13,6 +15,8 @@ The completed permanent algorithm handles dimensions zero and one exactly. This file realizes those branches directly from the canonical matrix code. -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineSmoothedMatrix.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineSmoothedMatrix.lean index 10eb1c2b07..07ab261a93 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineSmoothedMatrix.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineSmoothedMatrix.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineMatrixAddDelta -import LeanPool.BeyondBethe.BeyondBethe.MachineMatrixNormalizeEntries -import LeanPool.BeyondBethe.BeyondBethe.MachineSmoothingDelta + +public import LeanPool.BeyondBethe.BeyondBethe.MachineMatrixAddDelta +public import LeanPool.BeyondBethe.BeyondBethe.MachineMatrixNormalizeEntries +public import LeanPool.BeyondBethe.BeyondBethe.MachineSmoothingDelta /-! # The complete normalization-and-smoothing matrix transform @@ -18,6 +20,8 @@ is essential: the canonical public rational output uses a different encoding and cannot be fed directly to the matrix-entry arithmetic machines. -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineSmoothingDelta.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineSmoothingDelta.lean index 81bf1f7be3..99f84ce0e9 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineSmoothingDelta.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineSmoothingDelta.lean @@ -3,13 +3,15 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineFactorial -import LeanPool.BeyondBethe.BeyondBethe.MachineLengthBits -import LeanPool.BeyondBethe.BeyondBethe.MachineMatrixDimension -import LeanPool.BeyondBethe.BeyondBethe.MachineMatrixSupportProduct -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalMin -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalPower + +public import LeanPool.BeyondBethe.BeyondBethe.MachineFactorial +public import LeanPool.BeyondBethe.BeyondBethe.MachineLengthBits +public import LeanPool.BeyondBethe.BeyondBethe.MachineMatrixDimension +public import LeanPool.BeyondBethe.BeyondBethe.MachineMatrixSupportProduct +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalMin +public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalPower /-! # The rational smoothing level as a finite-word function @@ -26,6 +28,8 @@ final minimum has selected a branch, at which point the selected fraction is canonically normalized. -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineTrimHighZeros.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineTrimHighZeros.lean index a24a054339..1b304a9654 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineTrimHighZeros.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineTrimHighZeros.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineBitAssembly -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleSub.Defs + +public import LeanPool.BeyondBethe.BeyondBethe.MachineBitAssembly +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleSub.Defs /-! # Polynomial-time canonicalization of little-endian natural words @@ -16,6 +18,8 @@ must be removed. The implementation below is a length-bounded Cobham fold, not a semantic list primitive assumed to be efficient. -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineUnaryGridGenerator.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineUnaryGridGenerator.lean index 298c50b754..550cfafa43 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineUnaryGridGenerator.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineUnaryGridGenerator.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineDirectedNegativeObjectiveSum -import LeanPool.BeyondBethe.BeyondBethe.MachineListReverse + +public import LeanPool.BeyondBethe.BeyondBethe.MachineDirectedNegativeObjectiveSum +public import LeanPool.BeyondBethe.BeyondBethe.MachineListReverse /-! # A reusable finite-word generator for square rational grids @@ -22,6 +24,8 @@ used both for the nonlinear affine-gradient vector and for complete floor-cut vectors, avoiding two unrelated implementations of the same grid traversal. -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineUnaryMatrixGenerator.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineUnaryMatrixGenerator.lean index f7fae2661a..01d82dc660 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineUnaryMatrixGenerator.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineUnaryMatrixGenerator.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineUnaryGridGenerator + +public import LeanPool.BeyondBethe.BeyondBethe.MachineUnaryGridGenerator /-! # A reusable finite-word generator for square rational matrices @@ -21,6 +23,8 @@ proof below shows that neither clamp is active on canonical inputs satisfying the stated output-size bound. -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineUnaryRange.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineUnaryRange.lean index 07d0a33053..77bc3e990e 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineUnaryRange.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineUnaryRange.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineMateMemory -import LeanPool.BeyondBethe.BeyondBethe.KuhnSmallStep + +public import LeanPool.BeyondBethe.BeyondBethe.MachineMateMemory +public import LeanPool.BeyondBethe.BeyondBethe.KuhnSmallStep /-! # Constructing the unary column range @@ -16,6 +18,8 @@ constructor counts down and prepends, so after `n` steps the values occur in the required increasing order `0,1,...,n-1`. -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/Main.lean b/LeanPool/BeyondBethe/BeyondBethe/Main.lean index f3c1f4edc5..70edb4447f 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/Main.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/Main.lean @@ -3,21 +3,25 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.FinalAssembly -import LeanPool.BeyondBethe.BeyondBethe.ExplicitPositiveRoutine -import LeanPool.BeyondBethe.BeyondBethe.ExplicitScales -import LeanPool.BeyondBethe.BeyondBethe.SourceAnariRezaeiList -import LeanPool.BeyondBethe.BeyondBethe.SourceStableReindex -import LeanPool.BeyondBethe.BeyondBethe.MachineCompletedAlgorithm -import LeanPool.BeyondBethe.BeyondBethe.MachinePositiveAlgorithm -import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerCertificateBoundary -import LeanPool.BeyondBethe.BeyondBethe.MachineExplicitCertificate -import LeanPool.BeyondBethe.BeyondBethe.ExecutablePositiveRoutine -import LeanPool.BeyondBethe.BeyondBethe.MachineExecutablePositiveAlgorithm + +public import LeanPool.BeyondBethe.BeyondBethe.FinalAssembly +public import LeanPool.BeyondBethe.BeyondBethe.ExplicitPositiveRoutine +public import LeanPool.BeyondBethe.BeyondBethe.ExplicitScales +public import LeanPool.BeyondBethe.BeyondBethe.SourceAnariRezaeiList +public import LeanPool.BeyondBethe.BeyondBethe.SourceStableReindex +public import LeanPool.BeyondBethe.BeyondBethe.MachineCompletedAlgorithm +public import LeanPool.BeyondBethe.BeyondBethe.MachinePositiveAlgorithm +public import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerCertificateBoundary +public import LeanPool.BeyondBethe.BeyondBethe.MachineExplicitCertificate +public import LeanPool.BeyondBethe.BeyondBethe.ExecutablePositiveRoutine +public import LeanPool.BeyondBethe.BeyondBethe.MachineExecutablePositiveAlgorithm /-! # Main -/ +@[expose] public section + namespace BeyondBethe /-- A faithful algorithmic statement of Theorem 1 contains both the diff --git a/LeanPool/BeyondBethe/BeyondBethe/MatchingAlgorithm.lean b/LeanPool/BeyondBethe/BeyondBethe/MatchingAlgorithm.lean index f7bcd119b7..7c56b27004 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MatchingAlgorithm.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MatchingAlgorithm.lean @@ -3,12 +3,16 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.Permanent -import Mathlib.Tactic + +public import LeanPool.BeyondBethe.BeyondBethe.Permanent +public import Mathlib.Tactic /-! # Matching Algorithm -/ +@[expose] public section + namespace BeyondBethe /-! diff --git a/LeanPool/BeyondBethe/BeyondBethe/MatrixPerturbation.lean b/LeanPool/BeyondBethe/BeyondBethe/MatrixPerturbation.lean index 9725df7a7c..b46fb941b3 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MatrixPerturbation.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MatrixPerturbation.lean @@ -3,15 +3,19 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.DyadicRounding -import Mathlib.Algebra.Order.BigOperators.Group.Finset -import Mathlib.Algebra.Order.BigOperators.Ring.Finset -import Mathlib.LinearAlgebra.Matrix.Adjugate -import Mathlib.Tactic + +public import LeanPool.BeyondBethe.BeyondBethe.DyadicRounding +public import Mathlib.Algebra.Order.BigOperators.Group.Finset +public import Mathlib.Algebra.Order.BigOperators.Ring.Finset +public import Mathlib.LinearAlgebra.Matrix.Adjugate +public import Mathlib.Tactic /-! # Matrix Perturbation -/ +@[expose] public section + open scoped BigOperators namespace BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/NearCase.lean b/LeanPool/BeyondBethe/BeyondBethe/NearCase.lean index 9144b90625..f497727585 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/NearCase.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/NearCase.lean @@ -3,17 +3,21 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.CycleTransfer -import LeanPool.BeyondBethe.BeyondBethe.CleanConstants -import LeanPool.BeyondBethe.BeyondBethe.Completion -import LeanPool.BeyondBethe.BeyondBethe.ClusterCertificate -import LeanPool.BeyondBethe.BeyondBethe.SourceBetheUpper -import Mathlib.Data.Finset.Sort -import Mathlib.Tactic + +public import LeanPool.BeyondBethe.BeyondBethe.CycleTransfer +public import LeanPool.BeyondBethe.BeyondBethe.CleanConstants +public import LeanPool.BeyondBethe.BeyondBethe.Completion +public import LeanPool.BeyondBethe.BeyondBethe.ClusterCertificate +public import LeanPool.BeyondBethe.BeyondBethe.SourceBetheUpper +public import Mathlib.Data.Finset.Sort +public import Mathlib.Tactic /-! # Near Case -/ +@[expose] public section + open scoped BigOperators namespace BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/NumericalAffine.lean b/LeanPool/BeyondBethe/BeyondBethe/NumericalAffine.lean index 2a318d823e..f64f278b8c 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/NumericalAffine.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/NumericalAffine.lean @@ -3,12 +3,16 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.Transfer -import Mathlib.Tactic + +public import LeanPool.BeyondBethe.BeyondBethe.Transfer +public import Mathlib.Tactic /-! # Numerical Affine -/ +@[expose] public section + open scoped BigOperators namespace BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/NumericalCapacity.lean b/LeanPool/BeyondBethe/BeyondBethe/NumericalCapacity.lean index 439ab37b68..a3d1829d28 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/NumericalCapacity.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/NumericalCapacity.lean @@ -3,12 +3,16 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.NumericalInterior -import Mathlib.Tactic + +public import LeanPool.BeyondBethe.BeyondBethe.NumericalInterior +public import Mathlib.Tactic /-! # Numerical Capacity -/ +@[expose] public section + namespace BeyondBethe /-! diff --git a/LeanPool/BeyondBethe/BeyondBethe/NumericalInterior.lean b/LeanPool/BeyondBethe/BeyondBethe/NumericalInterior.lean index b4ace3c532..0298447dcf 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/NumericalInterior.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/NumericalInterior.lean @@ -3,12 +3,16 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.NumericalNearby -import Mathlib.Tactic + +public import LeanPool.BeyondBethe.BeyondBethe.NumericalNearby +public import Mathlib.Tactic /-! # Numerical Interior -/ +@[expose] public section + namespace BeyondBethe /-! diff --git a/LeanPool/BeyondBethe/BeyondBethe/NumericalNearby.lean b/LeanPool/BeyondBethe/BeyondBethe/NumericalNearby.lean index 6904f4693b..37f8ba2e71 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/NumericalNearby.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/NumericalNearby.lean @@ -3,12 +3,16 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.NumericalScales -import Mathlib.Tactic + +public import LeanPool.BeyondBethe.BeyondBethe.NumericalScales +public import Mathlib.Tactic /-! # Numerical Nearby -/ +@[expose] public section + namespace BeyondBethe /-! diff --git a/LeanPool/BeyondBethe/BeyondBethe/NumericalPotentials.lean b/LeanPool/BeyondBethe/BeyondBethe/NumericalPotentials.lean index db83dcd35b..f536ace4b9 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/NumericalPotentials.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/NumericalPotentials.lean @@ -3,12 +3,16 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.NumericalTransfer -import Mathlib.Tactic + +public import LeanPool.BeyondBethe.BeyondBethe.NumericalTransfer +public import Mathlib.Tactic /-! # Numerical Potentials -/ +@[expose] public section + namespace BeyondBethe /-! diff --git a/LeanPool/BeyondBethe/BeyondBethe/NumericalScales.lean b/LeanPool/BeyondBethe/BeyondBethe/NumericalScales.lean index 11112da999..add8519912 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/NumericalScales.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/NumericalScales.lean @@ -3,12 +3,16 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.NearCase -import Mathlib.Algebra.Order.Archimedean.Basic + +public import LeanPool.BeyondBethe.BeyondBethe.NearCase +public import Mathlib.Algebra.Order.Archimedean.Basic /-! # Numerical Scales -/ +@[expose] public section + namespace BeyondBethe /-! diff --git a/LeanPool/BeyondBethe/BeyondBethe/NumericalTransfer.lean b/LeanPool/BeyondBethe/BeyondBethe/NumericalTransfer.lean index 6033dc0fa6..6eb4e93562 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/NumericalTransfer.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/NumericalTransfer.lean @@ -3,11 +3,15 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.NumericalNearby + +public import LeanPool.BeyondBethe.BeyondBethe.NumericalNearby /-! # Numerical Transfer -/ +@[expose] public section + namespace BeyondBethe /-! diff --git a/LeanPool/BeyondBethe/BeyondBethe/NumericalWitness.lean b/LeanPool/BeyondBethe/BeyondBethe/NumericalWitness.lean index 0ef841b424..efb718e2ef 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/NumericalWitness.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/NumericalWitness.lean @@ -3,13 +3,17 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.CleanGain -import LeanPool.BeyondBethe.BeyondBethe.NumericalCapacity -import Mathlib.Tactic + +public import LeanPool.BeyondBethe.BeyondBethe.CleanGain +public import LeanPool.BeyondBethe.BeyondBethe.NumericalCapacity +public import Mathlib.Tactic /-! # Numerical Witness -/ +@[expose] public section + open scoped BigOperators namespace BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/Optimizer.lean b/LeanPool/BeyondBethe/BeyondBethe/Optimizer.lean index e8084256ef..001e683617 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/Optimizer.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/Optimizer.lean @@ -3,15 +3,19 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.TransferIdentity -import LeanPool.BeyondBethe.BeyondBethe.SourceVontobel -import Mathlib.Analysis.Calculus.LocalExtr.Basic -import Mathlib.Topology.Instances.Matrix -import Mathlib.Tactic + +public import LeanPool.BeyondBethe.BeyondBethe.TransferIdentity +public import LeanPool.BeyondBethe.BeyondBethe.SourceVontobel +public import Mathlib.Analysis.Calculus.LocalExtr.Basic +public import Mathlib.Topology.Instances.Matrix +public import Mathlib.Tactic /-! # Optimizer -/ +@[expose] public section + open scoped BigOperators Topology namespace BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/OptimizerOutputEncoding.lean b/LeanPool/BeyondBethe/BeyondBethe/OptimizerOutputEncoding.lean index 31f0480282..c697491168 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/OptimizerOutputEncoding.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/OptimizerOutputEncoding.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.AlgorithmicSpec + +public import LeanPool.BeyondBethe.BeyondBethe.AlgorithmicSpec /-! # Canonical finite-word encoding of optimizer output @@ -15,6 +17,8 @@ and the certificate consumer, so neither side depends on the other's correctness theorem. -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/PairFactorization.lean b/LeanPool/BeyondBethe/BeyondBethe/PairFactorization.lean index 4a3e29b52e..e9b2657569 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/PairFactorization.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/PairFactorization.lean @@ -3,15 +3,19 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.CapacityScaling -import LeanPool.BeyondBethe.BeyondBethe.ClusterCertificate -import LeanPool.BeyondBethe.BeyondBethe.Gain -import LeanPool.BeyondBethe.BeyondBethe.TransferIdentity -import Mathlib.Tactic + +public import LeanPool.BeyondBethe.BeyondBethe.CapacityScaling +public import LeanPool.BeyondBethe.BeyondBethe.ClusterCertificate +public import LeanPool.BeyondBethe.BeyondBethe.Gain +public import LeanPool.BeyondBethe.BeyondBethe.TransferIdentity +public import Mathlib.Tactic /-! # Pair Factorization -/ +@[expose] public section + open scoped BigOperators namespace BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/PairStability.lean b/LeanPool/BeyondBethe/BeyondBethe/PairStability.lean index f211f3c98f..155b944cc2 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/PairStability.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/PairStability.lean @@ -3,11 +3,15 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.PairedCertificate + +public import LeanPool.BeyondBethe.BeyondBethe.PairedCertificate /-! # Pair Stability -/ +@[expose] public section + open scoped BigOperators ComplexConjugate namespace BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/PairedCertificate.lean b/LeanPool/BeyondBethe/BeyondBethe/PairedCertificate.lean index 02e3bc6035..39be20a6c2 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/PairedCertificate.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/PairedCertificate.lean @@ -3,13 +3,17 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.Permanent -import LeanPool.BeyondBethe.BeyondBethe.Stable -import Mathlib.Tactic + +public import LeanPool.BeyondBethe.BeyondBethe.Permanent +public import LeanPool.BeyondBethe.BeyondBethe.Stable +public import Mathlib.Tactic /-! # Paired Certificate -/ +@[expose] public section + open scoped BigOperators namespace BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/PalomarComplexity.lean b/LeanPool/BeyondBethe/BeyondBethe/PalomarComplexity.lean index 9a05fdcd45..5db20ac082 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/PalomarComplexity.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/PalomarComplexity.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham + +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham /-! # A source-stable statement of polynomial time for Palomar @@ -23,6 +25,8 @@ shows that membership still has its usual meaning: deterministic polynomial time on finite bitstrings. -/ +@[expose] public section + namespace BeyondBethe.PalomarComplexity /-- Recursion on the bit notation of the first input, written directly with diff --git a/LeanPool/BeyondBethe/BeyondBethe/Permanent.lean b/LeanPool/BeyondBethe/BeyondBethe/Permanent.lean index 49ef4c105a..049a63ee39 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/Permanent.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/Permanent.lean @@ -3,13 +3,18 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import Mathlib.LinearAlgebra.Matrix.Permanent -import Mathlib.Data.Real.Basic -import Mathlib.Data.Rat.BigOperators + +public import Mathlib.Algebra.Order.BigOperators.GroupWithZero.Finset +public import Mathlib.LinearAlgebra.Matrix.Permanent +public import Mathlib.Data.Real.Basic +public import Mathlib.Data.Rat.BigOperators /-! # Permanent -/ +@[expose] public section + namespace Matrix /-- Entrywise nonnegativity. -/ diff --git a/LeanPool/BeyondBethe/BeyondBethe/RationalEllipsoid.lean b/LeanPool/BeyondBethe/BeyondBethe/RationalEllipsoid.lean index bf952b85f3..158f729b27 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/RationalEllipsoid.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/RationalEllipsoid.lean @@ -3,16 +3,20 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import Mathlib.Algebra.Order.Chebyshev -import Mathlib.Analysis.SpecialFunctions.Log.Basic -import Mathlib.LinearAlgebra.Matrix.Determinant.Basic -import Mathlib.LinearAlgebra.Matrix.AbsoluteValue -import Mathlib.LinearAlgebra.Matrix.SchurComplement -import Mathlib.Tactic + +public import Mathlib.Algebra.Order.Chebyshev +public import Mathlib.Analysis.SpecialFunctions.Log.Basic +public import Mathlib.LinearAlgebra.Matrix.Determinant.Basic +public import Mathlib.LinearAlgebra.Matrix.AbsoluteValue +public import Mathlib.LinearAlgebra.Matrix.SchurComplement +public import Mathlib.Tactic /-! # Rational Ellipsoid -/ +@[expose] public section + open scoped BigOperators namespace BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/RationalEncodingBounds.lean b/LeanPool/BeyondBethe/BeyondBethe/RationalEncodingBounds.lean index 38367fd29a..0619034cea 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/RationalEncodingBounds.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/RationalEncodingBounds.lean @@ -3,13 +3,17 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.RoundedEllipsoidIterationBounds -import Mathlib.Data.Rat.Lemmas -import Mathlib.Tactic + +public import LeanPool.BeyondBethe.BeyondBethe.RoundedEllipsoidIterationBounds +public import Mathlib.Data.Rat.Lemmas +public import Mathlib.Tactic /-! # Rational Encoding Bounds -/ +@[expose] public section + namespace BeyondBethe open Complexity diff --git a/LeanPool/BeyondBethe/BeyondBethe/RationalEpigraphOracle.lean b/LeanPool/BeyondBethe/BeyondBethe/RationalEpigraphOracle.lean index 9067b5eac9..91c16ee4f3 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/RationalEpigraphOracle.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/RationalEpigraphOracle.lean @@ -3,12 +3,16 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.RationalLinearOracle -import Mathlib.Tactic + +public import LeanPool.BeyondBethe.BeyondBethe.RationalLinearOracle +public import Mathlib.Tactic /-! # Rational Epigraph Oracle -/ +@[expose] public section + open scoped BigOperators namespace BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/RationalFeasibility.lean b/LeanPool/BeyondBethe/BeyondBethe/RationalFeasibility.lean index a660402dd5..ac2c9f02cf 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/RationalFeasibility.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/RationalFeasibility.lean @@ -3,13 +3,17 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.RationalEllipsoid -import LeanPool.BeyondBethe.BeyondBethe.AlgorithmicSpec -import Mathlib.Tactic + +public import LeanPool.BeyondBethe.BeyondBethe.RationalEllipsoid +public import LeanPool.BeyondBethe.BeyondBethe.AlgorithmicSpec +public import Mathlib.Tactic /-! # Rational Feasibility -/ +@[expose] public section + open scoped BigOperators namespace BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/RationalLinearOracle.lean b/LeanPool/BeyondBethe/BeyondBethe/RationalLinearOracle.lean index 5698dd8ddc..5c074cdbed 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/RationalLinearOracle.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/RationalLinearOracle.lean @@ -3,12 +3,16 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.RationalFeasibility -import Mathlib.Tactic + +public import LeanPool.BeyondBethe.BeyondBethe.RationalFeasibility +public import Mathlib.Tactic /-! # Rational Linear Oracle -/ +@[expose] public section + open scoped BigOperators namespace BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/RawRational.lean b/LeanPool/BeyondBethe/BeyondBethe/RawRational.lean index a118a38fa9..edf6ea2551 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/RawRational.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/RawRational.lean @@ -3,13 +3,17 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.BinaryLongDivision -import Mathlib.Data.Rat.Lemmas -import Mathlib.Tactic + +public import LeanPool.BeyondBethe.BeyondBethe.BinaryLongDivision +public import Mathlib.Data.Rat.Lemmas +public import Mathlib.Tactic /-! # Raw Rational -/ +@[expose] public section + namespace BeyondBethe /-! diff --git a/LeanPool/BeyondBethe/BeyondBethe/RawRationalBitBounds.lean b/LeanPool/BeyondBethe/BeyondBethe/RawRationalBitBounds.lean index 214b3677bd..255a2f7c4a 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/RawRationalBitBounds.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/RawRationalBitBounds.lean @@ -3,13 +3,17 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.RawRational -import LeanPool.BeyondBethe.BeyondBethe.RationalEncodingBounds -import Mathlib.Tactic + +public import LeanPool.BeyondBethe.BeyondBethe.RawRational +public import LeanPool.BeyondBethe.BeyondBethe.RationalEncodingBounds +public import Mathlib.Tactic /-! # Raw Rational Bit Bounds -/ +@[expose] public section + namespace BeyondBethe /-! diff --git a/LeanPool/BeyondBethe/BeyondBethe/RobustCycle.lean b/LeanPool/BeyondBethe/BeyondBethe/RobustCycle.lean index e5d3fb2248..1964921eb7 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/RobustCycle.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/RobustCycle.lean @@ -3,13 +3,17 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.GoodRowScore -import LeanPool.BeyondBethe.BeyondBethe.Sequential -import LeanPool.BeyondBethe.BeyondBethe.Slack + +public import LeanPool.BeyondBethe.BeyondBethe.GoodRowScore +public import LeanPool.BeyondBethe.BeyondBethe.Sequential +public import LeanPool.BeyondBethe.BeyondBethe.Slack /-! # Robust Cycle -/ +@[expose] public section + namespace BeyondBethe /-- Inversion as an equivalence on permutations. The Gibbs layer represents diff --git a/LeanPool/BeyondBethe/BeyondBethe/RoundedEllipsoid.lean b/LeanPool/BeyondBethe/BeyondBethe/RoundedEllipsoid.lean index 3d153960e6..b6f781fb36 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/RoundedEllipsoid.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/RoundedEllipsoid.lean @@ -3,12 +3,16 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MatrixPerturbation -import Mathlib.Tactic + +public import LeanPool.BeyondBethe.BeyondBethe.MatrixPerturbation +public import Mathlib.Tactic /-! # Rounded Ellipsoid -/ +@[expose] public section + open scoped BigOperators namespace BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/RoundedEllipsoidBitBounds.lean b/LeanPool/BeyondBethe/BeyondBethe/RoundedEllipsoidBitBounds.lean index d1e1bf7409..0d90b851d3 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/RoundedEllipsoidBitBounds.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/RoundedEllipsoidBitBounds.lean @@ -3,12 +3,16 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.AdaptiveRoundedEllipsoid -import Mathlib.Tactic + +public import LeanPool.BeyondBethe.BeyondBethe.AdaptiveRoundedEllipsoid +public import Mathlib.Tactic /-! # Rounded Ellipsoid Bit Bounds -/ +@[expose] public section + open scoped BigOperators namespace BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/RoundedEllipsoidIterationBounds.lean b/LeanPool/BeyondBethe/BeyondBethe/RoundedEllipsoidIterationBounds.lean index 7cf82e19dd..451c4e800f 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/RoundedEllipsoidIterationBounds.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/RoundedEllipsoidIterationBounds.lean @@ -3,12 +3,16 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.RoundedEllipsoidBitBounds -import Mathlib.Tactic + +public import LeanPool.BeyondBethe.BeyondBethe.RoundedEllipsoidBitBounds +public import Mathlib.Tactic /-! # Rounded Ellipsoid Iteration Bounds -/ +@[expose] public section + namespace BeyondBethe /-! diff --git a/LeanPool/BeyondBethe/BeyondBethe/RoundedEllipsoidScales.lean b/LeanPool/BeyondBethe/BeyondBethe/RoundedEllipsoidScales.lean index 9f1e4ecd52..224f4ad7ff 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/RoundedEllipsoidScales.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/RoundedEllipsoidScales.lean @@ -3,14 +3,18 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.RoundedEllipsoid -import LeanPool.BeyondBethe.BeyondBethe.DyadicMagnitudePrecision -import Mathlib.LinearAlgebra.Matrix.Integer -import Mathlib.Tactic + +public import LeanPool.BeyondBethe.BeyondBethe.RoundedEllipsoid +public import LeanPool.BeyondBethe.BeyondBethe.DyadicMagnitudePrecision +public import Mathlib.LinearAlgebra.Matrix.Integer +public import Mathlib.Tactic /-! # Rounded Ellipsoid Scales -/ +@[expose] public section + open scoped BigOperators namespace BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/RoundedFeasibility.lean b/LeanPool/BeyondBethe/BeyondBethe/RoundedFeasibility.lean index 5c11d1f311..f9120bb9eb 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/RoundedFeasibility.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/RoundedFeasibility.lean @@ -3,13 +3,17 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.AdaptiveRoundedEllipsoid -import LeanPool.BeyondBethe.BeyondBethe.RationalFeasibility -import Mathlib.Tactic + +public import LeanPool.BeyondBethe.BeyondBethe.AdaptiveRoundedEllipsoid +public import LeanPool.BeyondBethe.BeyondBethe.RationalFeasibility +public import Mathlib.Tactic /-! # Rounded Feasibility -/ +@[expose] public section + open scoped BigOperators namespace BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/RoundedFeasibilityBitBounds.lean b/LeanPool/BeyondBethe/BeyondBethe/RoundedFeasibilityBitBounds.lean index 490bbbe6fc..391972197c 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/RoundedFeasibilityBitBounds.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/RoundedFeasibilityBitBounds.lean @@ -3,13 +3,17 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.RoundedFeasibility -import LeanPool.BeyondBethe.BeyondBethe.RationalEncodingBounds -import Mathlib.Tactic + +public import LeanPool.BeyondBethe.BeyondBethe.RoundedFeasibility +public import LeanPool.BeyondBethe.BeyondBethe.RationalEncodingBounds +public import Mathlib.Tactic /-! # Rounded Feasibility Bit Bounds -/ +@[expose] public section + namespace BeyondBethe /-! diff --git a/LeanPool/BeyondBethe/BeyondBethe/RowStability.lean b/LeanPool/BeyondBethe/BeyondBethe/RowStability.lean index d31e4256be..211733bc07 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/RowStability.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/RowStability.lean @@ -3,16 +3,20 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.Slack -import Mathlib.Analysis.Convex.Jensen -import Mathlib.Analysis.SpecialFunctions.Artanh -import Mathlib.Analysis.SpecialFunctions.Log.Deriv -import Mathlib.Data.Fin.Rev -import Mathlib.Tactic + +public import LeanPool.BeyondBethe.BeyondBethe.Slack +public import Mathlib.Analysis.Convex.Jensen +public import Mathlib.Analysis.SpecialFunctions.Artanh +public import Mathlib.Analysis.SpecialFunctions.Log.Deriv +public import Mathlib.Data.Fin.Rev +public import Mathlib.Tactic /-! # Row Stability -/ +@[expose] public section + namespace BeyondBethe /-- `b` occurs strictly between `a` and `c` in the ordering `π`. -/ diff --git a/LeanPool/BeyondBethe/BeyondBethe/ScannedBetheBisection.lean b/LeanPool/BeyondBethe/BeyondBethe/ScannedBetheBisection.lean index f83cdba1de..9190d3da94 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/ScannedBetheBisection.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/ScannedBetheBisection.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.ScannedBetheThresholdFeasibility -import LeanPool.BeyondBethe.BeyondBethe.BetheBisection -import Mathlib.Tactic + +public import LeanPool.BeyondBethe.BeyondBethe.ScannedBetheThresholdFeasibility +public import LeanPool.BeyondBethe.BeyondBethe.BetheBisection +public import Mathlib.Tactic /-! # Rational bisection for the row-major Bethe oracle @@ -18,6 +20,8 @@ optimization guarantee is unchanged even though the returned rational point need not be byte-for-byte equal to the earlier runner's point. -/ +@[expose] public section + namespace BeyondBethe def scannedBetheBisectionStep {m : ℕ} diff --git a/LeanPool/BeyondBethe/BeyondBethe/ScannedBetheThresholdFeasibility.lean b/LeanPool/BeyondBethe/BeyondBethe/ScannedBetheThresholdFeasibility.lean index 1917afb45b..96d9deeba1 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/ScannedBetheThresholdFeasibility.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/ScannedBetheThresholdFeasibility.lean @@ -3,13 +3,17 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.MachineBetheEpigraphOracle -import LeanPool.BeyondBethe.BeyondBethe.ExplicitScheduledFeasibility -import Mathlib.Tactic + +public import LeanPool.BeyondBethe.BeyondBethe.MachineBetheEpigraphOracle +public import LeanPool.BeyondBethe.BeyondBethe.ExplicitScheduledFeasibility +public import Mathlib.Tactic /-! # Scanned Bethe Threshold Feasibility -/ +@[expose] public section + namespace BeyondBethe /-! diff --git a/LeanPool/BeyondBethe/BeyondBethe/ScheduledFeasibility.lean b/LeanPool/BeyondBethe/BeyondBethe/ScheduledFeasibility.lean index edd398b032..ca7932527f 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/ScheduledFeasibility.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/ScheduledFeasibility.lean @@ -3,14 +3,18 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.ScheduledRoundedEllipsoidIteration -import LeanPool.BeyondBethe.BeyondBethe.RationalFeasibility -import LeanPool.BeyondBethe.BeyondBethe.RoundedFeasibility -import Mathlib.Tactic + +public import LeanPool.BeyondBethe.BeyondBethe.ScheduledRoundedEllipsoidIteration +public import LeanPool.BeyondBethe.BeyondBethe.RationalFeasibility +public import LeanPool.BeyondBethe.BeyondBethe.RoundedFeasibility +public import Mathlib.Tactic /-! # Scheduled Feasibility -/ +@[expose] public section + open scoped BigOperators namespace BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/ScheduledRoundedEllipsoid.lean b/LeanPool/BeyondBethe/BeyondBethe/ScheduledRoundedEllipsoid.lean index 0c45e29c49..46c15d0691 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/ScheduledRoundedEllipsoid.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/ScheduledRoundedEllipsoid.lean @@ -3,12 +3,16 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.RoundedEllipsoidIterationBounds -import Mathlib.Tactic + +public import LeanPool.BeyondBethe.BeyondBethe.RoundedEllipsoidIterationBounds +public import Mathlib.Tactic /-! # Scheduled Rounded Ellipsoid -/ +@[expose] public section + open scoped BigOperators namespace BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/ScheduledRoundedEllipsoidIteration.lean b/LeanPool/BeyondBethe/BeyondBethe/ScheduledRoundedEllipsoidIteration.lean index 9c3c01fdca..b0eab4ce8a 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/ScheduledRoundedEllipsoidIteration.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/ScheduledRoundedEllipsoidIteration.lean @@ -3,12 +3,16 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.ScheduledRoundedEllipsoid -import Mathlib.Tactic + +public import LeanPool.BeyondBethe.BeyondBethe.ScheduledRoundedEllipsoid +public import Mathlib.Tactic /-! # Scheduled Rounded Ellipsoid Iteration -/ +@[expose] public section + namespace BeyondBethe /-! diff --git a/LeanPool/BeyondBethe/BeyondBethe/Sequential.lean b/LeanPool/BeyondBethe/BeyondBethe/Sequential.lean index 4098174ffd..98e1e26bf9 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/Sequential.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/Sequential.lean @@ -3,14 +3,18 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.Gibbs -import LeanPool.BeyondBethe.BeyondBethe.Transfer -import LeanPool.BeyondBethe.BeyondBethe.SequentialNormalization -import Mathlib.Tactic + +public import LeanPool.BeyondBethe.BeyondBethe.Gibbs +public import LeanPool.BeyondBethe.BeyondBethe.Transfer +public import LeanPool.BeyondBethe.BeyondBethe.SequentialNormalization +public import Mathlib.Tactic /-! # Sequential -/ +@[expose] public section + open scoped BigOperators namespace BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/SequentialNormalization.lean b/LeanPool/BeyondBethe/BeyondBethe/SequentialNormalization.lean index 9ad8edb030..3d0a24f6cb 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/SequentialNormalization.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/SequentialNormalization.lean @@ -3,13 +3,17 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.Entropy -import Mathlib.GroupTheory.Perm.Fin -import Mathlib.Tactic + +public import LeanPool.BeyondBethe.BeyondBethe.Entropy +public import Mathlib.GroupTheory.Perm.Fin +public import Mathlib.Tactic /-! # Sequential Normalization -/ +@[expose] public section + open scoped BigOperators namespace BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/Slack.lean b/LeanPool/BeyondBethe/BeyondBethe/Slack.lean index d7f1ab9f0d..af9f0c3915 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/Slack.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/Slack.lean @@ -3,13 +3,17 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.Bethe -import LeanPool.BeyondBethe.BeyondBethe.Sequential -import Mathlib.Tactic + +public import LeanPool.BeyondBethe.BeyondBethe.Bethe +public import LeanPool.BeyondBethe.BeyondBethe.Sequential +public import Mathlib.Tactic /-! # Slack -/ +@[expose] public section + open scoped BigOperators namespace BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/Smoothing.lean b/LeanPool/BeyondBethe/BeyondBethe/Smoothing.lean index 1903b6f013..ba02472512 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/Smoothing.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/Smoothing.lean @@ -3,15 +3,19 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.Permanent -import Mathlib.Algebra.Order.Ring.Pow -import Mathlib.Analysis.Complex.Exponential -import Mathlib.Data.Fintype.Perm -import Mathlib.Tactic + +public import LeanPool.BeyondBethe.BeyondBethe.Permanent +public import Mathlib.Algebra.Order.Ring.Pow +public import Mathlib.Analysis.Complex.Exponential +public import Mathlib.Data.Fintype.Perm +public import Mathlib.Tactic /-! # Smoothing -/ +@[expose] public section + open scoped BigOperators namespace BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/SourceAnariRezaei.lean b/LeanPool/BeyondBethe/BeyondBethe/SourceAnariRezaei.lean index c71d2636d6..62ce26dc3e 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/SourceAnariRezaei.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/SourceAnariRezaei.lean @@ -3,12 +3,16 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.RowStability -import Mathlib.Analysis.Calculus.Deriv.MeanValue + +public import LeanPool.BeyondBethe.BeyondBethe.RowStability +public import Mathlib.Analysis.Calculus.Deriv.MeanValue /-! # Source Anari Rezaei -/ +@[expose] public section + open scoped BigOperators namespace BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/SourceAnariRezaeiList.lean b/LeanPool/BeyondBethe/BeyondBethe/SourceAnariRezaeiList.lean index 7fc0626063..6709c942ec 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/SourceAnariRezaeiList.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/SourceAnariRezaeiList.lean @@ -3,11 +3,15 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.SourceAnariRezaeiMerge + +public import LeanPool.BeyondBethe.BeyondBethe.SourceAnariRezaeiMerge /-! # Source Anari Rezaei List -/ +@[expose] public section + namespace BeyondBethe /-! diff --git a/LeanPool/BeyondBethe/BeyondBethe/SourceAnariRezaeiMerge.lean b/LeanPool/BeyondBethe/BeyondBethe/SourceAnariRezaeiMerge.lean index 4d6c37a654..e34e22eb29 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/SourceAnariRezaeiMerge.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/SourceAnariRezaeiMerge.lean @@ -3,11 +3,15 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.SourceAnariRezaei + +public import LeanPool.BeyondBethe.BeyondBethe.SourceAnariRezaei /-! # Source Anari Rezaei Merge -/ +@[expose] public section + open scoped BigOperators namespace BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/SourceBetheLower.lean b/LeanPool/BeyondBethe/BeyondBethe/SourceBetheLower.lean index cc0d26d5c7..f5073141c1 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/SourceBetheLower.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/SourceBetheLower.lean @@ -3,12 +3,16 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.ClusterCertificate -import LeanPool.BeyondBethe.BeyondBethe.Optimizer + +public import LeanPool.BeyondBethe.BeyondBethe.ClusterCertificate +public import LeanPool.BeyondBethe.BeyondBethe.Optimizer /-! # Source Bethe Lower -/ +@[expose] public section + open scoped BigOperators namespace BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/SourceBetheUpper.lean b/LeanPool/BeyondBethe/BeyondBethe/SourceBetheUpper.lean index 433e4bf3d3..79e39251b8 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/SourceBetheUpper.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/SourceBetheUpper.lean @@ -3,12 +3,16 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.Optimizer -import LeanPool.BeyondBethe.BeyondBethe.SourceAnariRezaeiList + +public import LeanPool.BeyondBethe.BeyondBethe.Optimizer +public import LeanPool.BeyondBethe.BeyondBethe.SourceAnariRezaeiList /-! # Source Bethe Upper -/ +@[expose] public section + open scoped BigOperators namespace BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/SourceStableBivariate.lean b/LeanPool/BeyondBethe/BeyondBethe/SourceStableBivariate.lean index d34f9ae02c..0b2f5a40b2 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/SourceStableBivariate.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/SourceStableBivariate.lean @@ -3,14 +3,18 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import Mathlib.Analysis.Complex.Basic -import Mathlib.Analysis.MeanInequalities -import Mathlib.Analysis.SpecialFunctions.Pow.Real -import Mathlib.Tactic + +public import Mathlib.Analysis.Complex.Basic +public import Mathlib.Analysis.MeanInequalities +public import Mathlib.Analysis.SpecialFunctions.Pow.Real +public import Mathlib.Tactic /-! # Source Stable Bivariate -/ +@[expose] public section + namespace BeyondBethe /-! diff --git a/LeanPool/BeyondBethe/BeyondBethe/SourceStableClosure.lean b/LeanPool/BeyondBethe/BeyondBethe/SourceStableClosure.lean index f2b5a6baa4..6d91e09b29 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/SourceStableClosure.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/SourceStableClosure.lean @@ -3,17 +3,21 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.Stable -import Mathlib.Analysis.Complex.JensenFormula -import Mathlib.Analysis.Analytic.Polynomial -import Mathlib.Algebra.Polynomial.Roots -import Mathlib.Algebra.MvPolynomial.Funext -import Mathlib.Algebra.Polynomial.Degree.SmallDegree -import Mathlib.Tactic + +public import LeanPool.BeyondBethe.BeyondBethe.Stable +public import Mathlib.Analysis.Complex.JensenFormula +public import Mathlib.Analysis.Analytic.Polynomial +public import Mathlib.Algebra.Polynomial.Roots +public import Mathlib.Algebra.MvPolynomial.Funext +public import Mathlib.Algebra.Polynomial.Degree.SmallDegree +public import Mathlib.Tactic /-! # Source Stable Closure -/ +@[expose] public section + open Filter MeasureTheory Metric Real Set namespace BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/SourceStableEncoding.lean b/LeanPool/BeyondBethe/BeyondBethe/SourceStableEncoding.lean index 66720fe332..a883354588 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/SourceStableEncoding.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/SourceStableEncoding.lean @@ -3,13 +3,17 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.SourceStableInduction -import LeanPool.BeyondBethe.BeyondBethe.CapacityOrder -import Mathlib.Tactic + +public import LeanPool.BeyondBethe.BeyondBethe.SourceStableInduction +public import LeanPool.BeyondBethe.BeyondBethe.CapacityOrder +public import Mathlib.Tactic /-! # Source Stable Encoding -/ +@[expose] public section + open scoped BigOperators open scoped ComplexConjugate diff --git a/LeanPool/BeyondBethe/BeyondBethe/SourceStableInduction.lean b/LeanPool/BeyondBethe/BeyondBethe/SourceStableInduction.lean index 6edc426702..db4c8637c3 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/SourceStableInduction.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/SourceStableInduction.lean @@ -3,12 +3,16 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.SourceStableSlice -import Mathlib.Tactic + +public import LeanPool.BeyondBethe.BeyondBethe.SourceStableSlice +public import Mathlib.Tactic /-! # Source Stable Induction -/ +@[expose] public section + namespace BeyondBethe /-! diff --git a/LeanPool/BeyondBethe/BeyondBethe/SourceStableReindex.lean b/LeanPool/BeyondBethe/BeyondBethe/SourceStableReindex.lean index 1848952da0..b37837fbfd 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/SourceStableReindex.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/SourceStableReindex.lean @@ -3,12 +3,16 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.SourceStableEncoding -import Mathlib.Tactic + +public import LeanPool.BeyondBethe.BeyondBethe.SourceStableEncoding +public import Mathlib.Tactic /-! # Source Stable Reindex -/ +@[expose] public section + open scoped BigOperators namespace BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/SourceStableSlice.lean b/LeanPool/BeyondBethe/BeyondBethe/SourceStableSlice.lean index 274e72e1b2..a3b2fffccf 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/SourceStableSlice.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/SourceStableSlice.lean @@ -3,12 +3,16 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.SourceStableSpecialization -import Mathlib.Tactic + +public import LeanPool.BeyondBethe.BeyondBethe.SourceStableSpecialization +public import Mathlib.Tactic /-! # Source Stable Slice -/ +@[expose] public section + namespace BeyondBethe /-! diff --git a/LeanPool/BeyondBethe/BeyondBethe/SourceStableSpecialization.lean b/LeanPool/BeyondBethe/BeyondBethe/SourceStableSpecialization.lean index dd90ddc75e..d3519d012b 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/SourceStableSpecialization.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/SourceStableSpecialization.lean @@ -3,13 +3,17 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.SourceStableClosure -import LeanPool.BeyondBethe.BeyondBethe.SourceStableTable -import Mathlib.Tactic + +public import LeanPool.BeyondBethe.BeyondBethe.SourceStableClosure +public import LeanPool.BeyondBethe.BeyondBethe.SourceStableTable +public import Mathlib.Tactic /-! # Source Stable Specialization -/ +@[expose] public section + namespace BeyondBethe /-! diff --git a/LeanPool/BeyondBethe/BeyondBethe/SourceStableTable.lean b/LeanPool/BeyondBethe/BeyondBethe/SourceStableTable.lean index 1c926da85e..1f7410ced1 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/SourceStableTable.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/SourceStableTable.lean @@ -3,13 +3,17 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.SourceStableClosure -import LeanPool.BeyondBethe.BeyondBethe.SourceStableBivariate -import Mathlib.Tactic + +public import LeanPool.BeyondBethe.BeyondBethe.SourceStableClosure +public import LeanPool.BeyondBethe.BeyondBethe.SourceStableBivariate +public import Mathlib.Tactic /-! # Source Stable Table -/ +@[expose] public section + namespace BeyondBethe /-! diff --git a/LeanPool/BeyondBethe/BeyondBethe/SourceVontobel.lean b/LeanPool/BeyondBethe/BeyondBethe/SourceVontobel.lean index b1d2aee7d2..605fcc107a 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/SourceVontobel.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/SourceVontobel.lean @@ -3,13 +3,17 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.Bethe -import Mathlib.Algebra.Order.BigOperators.Ring.Finset -import Mathlib.Analysis.Convex.Deriv + +public import LeanPool.BeyondBethe.BeyondBethe.Bethe +public import Mathlib.Algebra.Order.BigOperators.Ring.Finset +public import Mathlib.Analysis.Convex.Deriv /-! # Source Vontobel -/ +@[expose] public section + open scoped BigOperators Topology namespace BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/Stable.lean b/LeanPool/BeyondBethe/BeyondBethe/Stable.lean index 99e7531a01..432afc99d9 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/Stable.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/Stable.lean @@ -3,16 +3,20 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import Mathlib.Algebra.MvPolynomial.Eval -import Mathlib.Algebra.MvPolynomial.Degrees -import Mathlib.RingTheory.MvPolynomial.Homogeneous -import Mathlib.Analysis.Complex.Basic -import Mathlib.Analysis.SpecialFunctions.Pow.Real -import Mathlib.Tactic + +public import Mathlib.Algebra.MvPolynomial.Eval +public import Mathlib.Algebra.MvPolynomial.Degrees +public import Mathlib.RingTheory.MvPolynomial.Homogeneous +public import Mathlib.Analysis.Complex.Basic +public import Mathlib.Analysis.SpecialFunctions.Pow.Real +public import Mathlib.Tactic /-! # Stable -/ +@[expose] public section + open scoped BigOperators namespace BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/StrongEntropy.lean b/LeanPool/BeyondBethe/BeyondBethe/StrongEntropy.lean index d3d9c15639..8c139f0f27 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/StrongEntropy.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/StrongEntropy.lean @@ -3,14 +3,18 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.NumericalNearby -import Mathlib.Analysis.Convex.Strong -import Mathlib.Analysis.Convex.Deriv -import Mathlib.Tactic + +public import LeanPool.BeyondBethe.BeyondBethe.NumericalNearby +public import Mathlib.Analysis.Convex.Strong +public import Mathlib.Analysis.Convex.Deriv +public import Mathlib.Tactic /-! # Strong Entropy -/ +@[expose] public section + open scoped BigOperators namespace BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/Transfer.lean b/LeanPool/BeyondBethe/BeyondBethe/Transfer.lean index adc2b1fe28..557a0cdb52 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/Transfer.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/Transfer.lean @@ -3,14 +3,18 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.Entropy -import Mathlib.Analysis.SpecialFunctions.Log.Deriv -import Mathlib.Analysis.SpecialFunctions.Pow.Real -import Mathlib.Tactic + +public import LeanPool.BeyondBethe.BeyondBethe.Entropy +public import Mathlib.Analysis.SpecialFunctions.Log.Deriv +public import Mathlib.Analysis.SpecialFunctions.Pow.Real +public import Mathlib.Tactic /-! # Transfer -/ +@[expose] public section + open scoped BigOperators namespace BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/TransferIdentity.lean b/LeanPool/BeyondBethe/BeyondBethe/TransferIdentity.lean index 978006096b..dcf1cf1812 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/TransferIdentity.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/TransferIdentity.lean @@ -3,13 +3,17 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.Transfer -import LeanPool.BeyondBethe.BeyondBethe.Slack -import Mathlib.Tactic + +public import LeanPool.BeyondBethe.BeyondBethe.Transfer +public import LeanPool.BeyondBethe.BeyondBethe.Slack +public import Mathlib.Tactic /-! # Transfer Identity -/ +@[expose] public section + open scoped BigOperators namespace BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/WeakSeparation.lean b/LeanPool/BeyondBethe/BeyondBethe/WeakSeparation.lean index 9e45bad774..220db26410 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/WeakSeparation.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/WeakSeparation.lean @@ -3,14 +3,18 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.DirectedOptimizerOracle -import LeanPool.BeyondBethe.BeyondBethe.NumericalNearby -import LeanPool.BeyondBethe.BeyondBethe.NumericalPotentials -import Mathlib.Tactic + +public import LeanPool.BeyondBethe.BeyondBethe.DirectedOptimizerOracle +public import LeanPool.BeyondBethe.BeyondBethe.NumericalNearby +public import LeanPool.BeyondBethe.BeyondBethe.NumericalPotentials +public import Mathlib.Tactic /-! # Weak Separation -/ +@[expose] public section + open scoped BigOperators namespace BeyondBethe diff --git a/LeanPool/BeyondBethe/Complexitylib.lean b/LeanPool/BeyondBethe/Complexitylib.lean index 337fb26542..1b3f9a6487 100644 --- a/LeanPool/BeyondBethe/Complexitylib.lean +++ b/LeanPool/BeyondBethe/Complexitylib.lean @@ -3,14 +3,18 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.Complexitylib.Asymptotics -import LeanPool.BeyondBethe.Complexitylib.Circuits -import LeanPool.BeyondBethe.Complexitylib.Classes -import LeanPool.BeyondBethe.Complexitylib.Encoding -import LeanPool.BeyondBethe.Complexitylib.Languages -import LeanPool.BeyondBethe.Complexitylib.Mathlib -import LeanPool.BeyondBethe.Complexitylib.Models -import LeanPool.BeyondBethe.Complexitylib.SAT + +public import LeanPool.BeyondBethe.Complexitylib.Asymptotics +public import LeanPool.BeyondBethe.Complexitylib.Circuits +public import LeanPool.BeyondBethe.Complexitylib.Classes +public import LeanPool.BeyondBethe.Complexitylib.Encoding +public import LeanPool.BeyondBethe.Complexitylib.Languages +public import LeanPool.BeyondBethe.Complexitylib.Mathlib +public import LeanPool.BeyondBethe.Complexitylib.Models +public import LeanPool.BeyondBethe.Complexitylib.SAT /-! Supporting modules for Beyond the Bethe approximation of the permanent. -/ + +@[expose] public section diff --git a/LeanPool/BeyondBethe/Complexitylib/Asymptotics/PolynomialComposition.lean b/LeanPool/BeyondBethe/Complexitylib/Asymptotics/PolynomialComposition.lean index 990148dae8..6c59cada6b 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Asymptotics/PolynomialComposition.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Asymptotics/PolynomialComposition.lean @@ -21,7 +21,7 @@ deterministic function computations are connected sequentially. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Circuits.lean b/LeanPool/BeyondBethe/Complexitylib/Circuits.lean index 128db4cf2e..3727a665ab 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Circuits.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Circuits.lean @@ -3,9 +3,13 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.Complexitylib.Circuits.AndOrNot -import LeanPool.BeyondBethe.Complexitylib.Circuits.Basic -import LeanPool.BeyondBethe.Complexitylib.Circuits.Encoding + +public import LeanPool.BeyondBethe.Complexitylib.Circuits.AndOrNot +public import LeanPool.BeyondBethe.Complexitylib.Circuits.Basic +public import LeanPool.BeyondBethe.Complexitylib.Circuits.Encoding /-! Supporting modules for Beyond the Bethe approximation of the permanent. -/ + +@[expose] public section diff --git a/LeanPool/BeyondBethe/Complexitylib/Circuits/AndOrNot.lean b/LeanPool/BeyondBethe/Complexitylib/Circuits/AndOrNot.lean index 0d58e0367a..f1baf51d8e 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Circuits/AndOrNot.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Circuits/AndOrNot.lean @@ -3,7 +3,11 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.Complexitylib.Circuits.AndOrNot.Defs + +public import LeanPool.BeyondBethe.Complexitylib.Circuits.AndOrNot.Defs /-! Supporting modules for Beyond the Bethe approximation of the permanent. -/ + +@[expose] public section diff --git a/LeanPool/BeyondBethe/Complexitylib/Circuits/Encoding.lean b/LeanPool/BeyondBethe/Complexitylib/Circuits/Encoding.lean index 9811043957..9d06fdb304 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Circuits/Encoding.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Circuits/Encoding.lean @@ -3,8 +3,12 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.Complexitylib.Circuits.Encoding.Defs -import LeanPool.BeyondBethe.Complexitylib.Circuits.Encoding.Internal + +public import LeanPool.BeyondBethe.Complexitylib.Circuits.Encoding.Defs +public import LeanPool.BeyondBethe.Complexitylib.Circuits.Encoding.Internal /-! Supporting modules for Beyond the Bethe approximation of the permanent. -/ + +@[expose] public section diff --git a/LeanPool/BeyondBethe/Complexitylib/Circuits/Encoding/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Circuits/Encoding/Internal.lean index f618af8072..d6dace739b 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Circuits/Encoding/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Circuits/Encoding/Internal.lean @@ -3,7 +3,11 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.Complexitylib.Circuits.Encoding.Internal.Codec + +public import LeanPool.BeyondBethe.Complexitylib.Circuits.Encoding.Internal.Codec /-! Supporting modules for Beyond the Bethe approximation of the permanent. -/ + +@[expose] public section diff --git a/LeanPool/BeyondBethe/Complexitylib/Circuits/Encoding/Internal/Codec.lean b/LeanPool/BeyondBethe/Complexitylib/Circuits/Encoding/Internal/Codec.lean index f2250deafa..0c38988a4b 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Circuits/Encoding/Internal/Codec.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Circuits/Encoding/Internal/Codec.lean @@ -18,7 +18,7 @@ kept in a separate proof layer. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Classes.lean b/LeanPool/BeyondBethe/Complexitylib/Classes.lean index 1bc004d062..cfd87eb402 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Classes.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Classes.lean @@ -3,16 +3,20 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.Complexitylib.Classes.Containments -import LeanPool.BeyondBethe.Complexitylib.Classes.Exponential -import LeanPool.BeyondBethe.Complexitylib.Classes.FNP -import LeanPool.BeyondBethe.Complexitylib.Classes.L -import LeanPool.BeyondBethe.Complexitylib.Classes.NP -import LeanPool.BeyondBethe.Complexitylib.Classes.P -import LeanPool.BeyondBethe.Complexitylib.Classes.Pairing -import LeanPool.BeyondBethe.Complexitylib.Classes.Randomized -import LeanPool.BeyondBethe.Complexitylib.Classes.Space -import LeanPool.BeyondBethe.Complexitylib.Classes.Time + +public import LeanPool.BeyondBethe.Complexitylib.Classes.Containments +public import LeanPool.BeyondBethe.Complexitylib.Classes.Exponential +public import LeanPool.BeyondBethe.Complexitylib.Classes.FNP +public import LeanPool.BeyondBethe.Complexitylib.Classes.L +public import LeanPool.BeyondBethe.Complexitylib.Classes.NP +public import LeanPool.BeyondBethe.Complexitylib.Classes.P +public import LeanPool.BeyondBethe.Complexitylib.Classes.Pairing +public import LeanPool.BeyondBethe.Complexitylib.Classes.Randomized +public import LeanPool.BeyondBethe.Complexitylib.Classes.Space +public import LeanPool.BeyondBethe.Complexitylib.Classes.Time /-! Supporting modules for Beyond the Bethe approximation of the permanent. -/ + +@[expose] public section diff --git a/LeanPool/BeyondBethe/Complexitylib/Classes/Containments.lean b/LeanPool/BeyondBethe/Complexitylib/Classes/Containments.lean index 53fa4c7c88..be95c0f943 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Classes/Containments.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Classes/Containments.lean @@ -49,7 +49,7 @@ This file collects the standard containment results between complexity classes. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Classes/FNP.lean b/LeanPool/BeyondBethe/Complexitylib/Classes/FNP.lean index 8290e48860..17dce70bca 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Classes/FNP.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Classes/FNP.lean @@ -3,7 +3,11 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.Complexitylib.Classes.FNP.Defs + +public import LeanPool.BeyondBethe.Complexitylib.Classes.FNP.Defs /-! Supporting modules for Beyond the Bethe approximation of the permanent. -/ + +@[expose] public section diff --git a/LeanPool/BeyondBethe/Complexitylib/Classes/NP/Witness.lean b/LeanPool/BeyondBethe/Complexitylib/Classes/NP/Witness.lean index c5d41fcc44..f3ccb845cb 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Classes/NP/Witness.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Classes/NP/Witness.lean @@ -53,7 +53,7 @@ verifier being in P) rest only on that single lemma. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Classes/P.lean b/LeanPool/BeyondBethe/Complexitylib/Classes/P.lean index aa674224f4..021455d465 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Classes/P.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Classes/P.lean @@ -13,7 +13,7 @@ public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Preimage public import LeanPool.BeyondBethe.Complexitylib.Classes.P.UnaryLength public import LeanPool.BeyondBethe.Complexitylib.Classes.P.FinsetDomain public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.CopyOutput +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.CopyOutput /-! # P — surface layer @@ -41,7 +41,7 @@ This file aggregates the definitions and theorems for P, FP, and PSPACE. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham.lean b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham.lean index 7a3371db6d..d968b1b079 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham.lean @@ -8,7 +8,7 @@ module public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Defs public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Vec public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Defs -import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal /-! # Cobham's characterization of FP — surface layer @@ -46,7 +46,7 @@ after a rewind (`Cobham.rewindFn`). The assembly is `Cobham.simFn_eq`. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal.lean index aebf6302d7..03cb4562da 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal.lean @@ -20,12 +20,12 @@ public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.Itera public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.Iterate public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.TakeLen public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.Reverse -import LeanPool.BeyondBethe.Complexitylib.Classes.P.UnaryLength +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.UnaryLength public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.MulLen -import LeanPool.BeyondBethe.Complexitylib.Classes.P.NormalForm -import LeanPool.BeyondBethe.Complexitylib.Classes.P.Composition +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.NormalForm +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Composition public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.HeadFlag -import LeanPool.BeyondBethe.Complexitylib.Classes.P.PairWithInput +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.PairWithInput /-! # Cobham's characterization of FP — proof internals diff --git a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/Algebra.lean b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/Algebra.lean index 24ec105ac3..605a2ec9b5 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/Algebra.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/Algebra.lean @@ -9,8 +9,8 @@ public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.Block public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Defs public import LeanPool.BeyondBethe.Complexitylib.Encoding.Pairing public import Mathlib.Data.Fin.VecNotation -import Mathlib.Data.Fintype.Basic -import Mathlib.Tactic.FinCases +public import Mathlib.Data.Fintype.Basic +public import Mathlib.Tactic.FinCases public import Mathlib.Tactic.Ring /-! @@ -31,7 +31,7 @@ projections follows. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/Blocks.lean b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/Blocks.lean index 11f7228d54..9910c1262a 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/Blocks.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/Blocks.lean @@ -5,7 +5,7 @@ Authors: Bolton Bailey -/ module -import Mathlib.Data.List.Basic +public import Mathlib.Data.List.Basic /-! # Blocks, flags, and bit dispatch — proof internals diff --git a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/Cat.lean b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/Cat.lean index 5e31911810..b76b94eb3d 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/Cat.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/Cat.lean @@ -6,8 +6,8 @@ Authors: Bolton Bailey module public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Defs -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.Counter -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Tape.Encoding +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.Counter +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Tape.Encoding public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.SndBlock /-! @@ -23,7 +23,7 @@ scanner that computes it. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/ConsBit.lean b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/ConsBit.lean index 5560ff1f0b..4893dc5920 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/ConsBit.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/ConsBit.lean @@ -7,7 +7,7 @@ Authors: Bolton Bailey module public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Defs public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.Counter -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Tape.Encoding +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Tape.Encoding /-! # The bit successor — proof internals @@ -21,7 +21,7 @@ the `bit` constructor of Cobham's algebra. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/Encoding.lean b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/Encoding.lean index 1394ec01ff..c0526edf9a 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/Encoding.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/Encoding.lean @@ -7,7 +7,7 @@ Authors: Bolton Bailey module public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.Blocks public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Internal /-! # Encoding machine configurations as bitstrings — proof internals diff --git a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/FstBlock.lean b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/FstBlock.lean index 0153aa290d..0f295ca5a9 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/FstBlock.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/FstBlock.lean @@ -6,8 +6,8 @@ Authors: Bolton Bailey module public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.BlockScan -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.Counter -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Tape.Encoding +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.Counter +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Tape.Encoding /-! # The block-payload decoder — proof internals @@ -22,7 +22,7 @@ halts with empty output. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/Iterate.lean b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/Iterate.lean index 8d2c0c4030..2ca0122f51 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/Iterate.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/Iterate.lean @@ -5,10 +5,10 @@ Authors: Bolton Bailey -/ module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Registers.Horner +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Registers.InputLen public import LeanPool.BeyondBethe.Complexitylib.Asymptotics.PolyBound public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.IterateLayout -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Registers.Horner -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Registers.InputLen public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.PairEmit public import LeanPool.BeyondBethe.Complexitylib.Classes.P.NormalForm @@ -42,7 +42,7 @@ running value and whose last tape `resIdx` receives each result. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/MulLen.lean b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/MulLen.lean index 2aea67e184..28f18e264d 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/MulLen.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/MulLen.lean @@ -8,7 +8,7 @@ module public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Defs public import LeanPool.BeyondBethe.Complexitylib.Encoding.Pairing public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Registers -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Tape.Encoding +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Tape.Encoding /-! # Multiplying the block lengths of a pair — proof internals diff --git a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/Reorder.lean b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/Reorder.lean index 9ce7a254d1..29ee759dd3 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/Reorder.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/Reorder.lean @@ -6,8 +6,8 @@ Authors: Bolton Bailey module public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Defs -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.Counter -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Tape.Encoding +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.Counter +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Tape.Encoding public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.SndBlock /-! @@ -23,7 +23,7 @@ block verbatim, then decode the next block's payload. It is the one machine the -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/Reverse.lean b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/Reverse.lean index 448f77bec6..adf0c7205b 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/Reverse.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/Reverse.lean @@ -7,7 +7,7 @@ Authors: Bolton Bailey module public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Defs public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Tape.Encoding +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Tape.Encoding /-! # Polynomial-time string reversal — proof internals @@ -27,7 +27,7 @@ consumes the *last* bit first. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/Simulate.lean b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/Simulate.lean index 63207f2b0c..7a1005d98c 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/Simulate.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/Simulate.lean @@ -7,7 +7,7 @@ Authors: Bolton Bailey module public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.Extract public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.StepAlgebra -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.OutputBounds +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.OutputBounds /-! # Running a machine inside the algebra — proof internals diff --git a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/SndBlock.lean b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/SndBlock.lean index 9bdcf3ec56..5f53da9de7 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/SndBlock.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/SndBlock.lean @@ -6,8 +6,8 @@ Authors: Bolton Bailey module public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Internal.BlockScan -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.Counter -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Tape.Encoding +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.Counter +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Tape.Encoding /-! # The block-suffix decoder — proof internals @@ -22,7 +22,7 @@ Malformed input halts with empty output, matching `unpair? = none`. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/TakeLen.lean b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/TakeLen.lean index 49d94cca7f..e9af2cc5a2 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/TakeLen.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/TakeLen.lean @@ -8,7 +8,7 @@ module public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Defs public import LeanPool.BeyondBethe.Complexitylib.Encoding.Pairing public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Registers -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Tape.Encoding +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Tape.Encoding /-! # Truncating to the length of a leading block — proof internals diff --git a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/Vec.lean b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/Vec.lean index 01479acce8..050b4f615b 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/Vec.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/Vec.lean @@ -6,7 +6,7 @@ Authors: Bolton Bailey module public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Vec -import LeanPool.BeyondBethe.Complexitylib.Classes.P.FinsetDomain +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.FinsetDomain public import LeanPool.BeyondBethe.Complexitylib.Classes.P.PairWithInput /-! diff --git a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Vec.lean b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Vec.lean index 7657eff1af..32b1db3437 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Vec.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Vec.lean @@ -8,7 +8,7 @@ module public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham.Defs public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Defs public import LeanPool.BeyondBethe.Complexitylib.Encoding.Pairing -import Mathlib.Algebra.BigOperators.Group.Finset.Basic +public import Mathlib.Algebra.BigOperators.Group.Finset.Basic /-! # Fixed-arity inputs for Cobham's characterization diff --git a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Composition.lean b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Composition.lean index 597d21f41d..f1fb725d3b 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Composition.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Composition.lean @@ -16,7 +16,7 @@ public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Internal.Composition -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Classes/P/FinsetDomain.lean b/LeanPool/BeyondBethe/Complexitylib/Classes/P/FinsetDomain.lean index f9c7ebb4aa..92fe217222 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Classes/P/FinsetDomain.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Classes/P/FinsetDomain.lean @@ -26,7 +26,7 @@ regardless of how the values `g s` are chosen. - `ite_mem_finset_mem_FP` — `fun s => if s ∈ S then g s else []` belongs to `FP` -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Classes/P/FinsetDomain/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Classes/P/FinsetDomain/Internal.lean index de2ae031cd..8a38ae5376 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Classes/P/FinsetDomain/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Classes/P/FinsetDomain/Internal.lean @@ -40,7 +40,7 @@ The public statement (`ite_mem_finset_mem_FP`) lives in `Complexitylib.Classes.P.FinsetDomain`. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Internal.lean index ab7438f998..0432b4540b 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Internal.lean @@ -19,7 +19,7 @@ composite machine from `TM.unionTM` correctly decides `L₁ ∪ L₂`. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Internal/Composition.lean b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Internal/Composition.lean index 2f7998fb21..e4deef5d61 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Internal/Composition.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Internal/Composition.lean @@ -18,7 +18,7 @@ normal forms for its two component computations. The public theorem is in -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Internal/NormalForm.lean b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Internal/NormalForm.lean index e90cdd1155..b08dc8c3f0 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Internal/NormalForm.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Internal/NormalForm.lean @@ -18,7 +18,7 @@ The public theorem is in `Complexitylib.Classes.P.NormalForm`. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Internal/Preimage.lean b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Internal/Preimage.lean index 3f1a6df4a1..f2a16277d4 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Internal/Preimage.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Internal/Preimage.lean @@ -18,7 +18,7 @@ those bounds. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Classes/P/NormalForm.lean b/LeanPool/BeyondBethe/Complexitylib/Classes/P/NormalForm.lean index 6495056485..c8ee907613 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Classes/P/NormalForm.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Classes/P/NormalForm.lean @@ -22,7 +22,7 @@ normalized bounds are valid on every input length and are monotone. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Classes/P/PairWithInput.lean b/LeanPool/BeyondBethe/Complexitylib/Classes/P/PairWithInput.lean index c65525ae06..760311da28 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Classes/P/PairWithInput.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Classes/P/PairWithInput.lean @@ -16,7 +16,7 @@ public import LeanPool.BeyondBethe.Complexitylib.Classes.P.PairWithInput.Interna -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Classes/P/PairWithInput/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Classes/P/PairWithInput/Internal.lean index bb052f8523..a7d2b18307 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Classes/P/PairWithInput/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Classes/P/PairWithInput/Internal.lean @@ -13,7 +13,7 @@ public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Compositio -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Preimage.lean b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Preimage.lean index a7ebf87996..6c6e9b9d38 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Preimage.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Preimage.lean @@ -16,7 +16,7 @@ public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Internal.Preimage -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Classes/P/UnaryLength.lean b/LeanPool/BeyondBethe/Complexitylib/Classes/P/UnaryLength.lean index 1b843c26d1..ee5372039c 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Classes/P/UnaryLength.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Classes/P/UnaryLength.lean @@ -16,7 +16,7 @@ public import LeanPool.BeyondBethe.Complexitylib.Classes.P.UnaryLength.Internal -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Classes/P/UnaryLength/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Classes/P/UnaryLength/Internal.lean index c47d6ff796..ab9e459d51 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Classes/P/UnaryLength/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Classes/P/UnaryLength/Internal.lean @@ -13,7 +13,7 @@ public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutine -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Encoding.lean b/LeanPool/BeyondBethe/Complexitylib/Encoding.lean index fcc183b3a0..b6c04fc0d8 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Encoding.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Encoding.lean @@ -3,10 +3,14 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.Complexitylib.Encoding.Data -import LeanPool.BeyondBethe.Complexitylib.Encoding.DataEncode -import LeanPool.BeyondBethe.Complexitylib.Encoding.Delimit -import LeanPool.BeyondBethe.Complexitylib.Encoding.Pairing + +public import LeanPool.BeyondBethe.Complexitylib.Encoding.Data +public import LeanPool.BeyondBethe.Complexitylib.Encoding.DataEncode +public import LeanPool.BeyondBethe.Complexitylib.Encoding.Delimit +public import LeanPool.BeyondBethe.Complexitylib.Encoding.Pairing /-! Supporting modules for Beyond the Bethe approximation of the permanent. -/ + +@[expose] public section diff --git a/LeanPool/BeyondBethe/Complexitylib/Encoding/Data.lean b/LeanPool/BeyondBethe/Complexitylib/Encoding/Data.lean index 38e12112c8..17903fff90 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Encoding/Data.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Encoding/Data.lean @@ -31,7 +31,7 @@ This file contains the main internal data structure for the RTM, `Data`, a rose -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Encoding/DataEncode.lean b/LeanPool/BeyondBethe/Complexitylib/Encoding/DataEncode.lean index 912af2fb3a..22474af982 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Encoding/DataEncode.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Encoding/DataEncode.lean @@ -25,7 +25,7 @@ serializing the target `Data` value with `Data.toBits`. Since both the `DataEnco -/ -public section +@[expose] public section namespace Complexity @@ -107,7 +107,7 @@ instance : DataEncode ℕ where /-- Encode a value into a bitstring (`List Bool`) by first encoding it into `Data` and then serializing that with the parenthesized `Data.toBits`. This is the class-inferrable bitstring encoding available for any type with a `DataEncode` instance. -/ -@[expose] def DataEncode.bitstringEncode {α : Type} [DataEncode α] (a : α) : List Bool := +def DataEncode.bitstringEncode {α : Type} [DataEncode α] (a : α) : List Bool := (DataEncode.encode a).toBits lemma DataEncode.bitstringEncode_def {α : Type} [DataEncode α] (a : α) : diff --git a/LeanPool/BeyondBethe/Complexitylib/Languages.lean b/LeanPool/BeyondBethe/Complexitylib/Languages.lean index 02379bfa90..b09e3c6421 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Languages.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Languages.lean @@ -3,7 +3,11 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.Complexitylib.Languages.LastBit + +public import LeanPool.BeyondBethe.Complexitylib.Languages.LastBit /-! Supporting modules for Beyond the Bethe approximation of the permanent. -/ + +@[expose] public section diff --git a/LeanPool/BeyondBethe/Complexitylib/Languages/LastBit.lean b/LeanPool/BeyondBethe/Complexitylib/Languages/LastBit.lean index 65c0e0928e..a49f8da383 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Languages/LastBit.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Languages/LastBit.lean @@ -28,7 +28,7 @@ is the last bit seen so far, or `none` if no bit has been read. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Mathlib.lean b/LeanPool/BeyondBethe/Complexitylib/Mathlib.lean index 92eec1d30a..692c245b83 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Mathlib.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Mathlib.lean @@ -3,8 +3,12 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.Complexitylib.Mathlib.FinsetPrefixes -import LeanPool.BeyondBethe.Complexitylib.Mathlib.NatBits + +public import LeanPool.BeyondBethe.Complexitylib.Mathlib.FinsetPrefixes +public import LeanPool.BeyondBethe.Complexitylib.Mathlib.NatBits /-! Supporting modules for Beyond the Bethe approximation of the permanent. -/ + +@[expose] public section diff --git a/LeanPool/BeyondBethe/Complexitylib/Mathlib/FinsetPrefixes.lean b/LeanPool/BeyondBethe/Complexitylib/Mathlib/FinsetPrefixes.lean index 96ca3e9bd6..fc5a301309 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Mathlib/FinsetPrefixes.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Mathlib/FinsetPrefixes.lean @@ -22,7 +22,7 @@ type in its home namespace — the sanctioned exception to the `Complexity` root-namespace rule. Its contents are candidates for upstreaming to Mathlib. -/ -public section +@[expose] public section namespace Finset diff --git a/LeanPool/BeyondBethe/Complexitylib/Models.lean b/LeanPool/BeyondBethe/Complexitylib/Models.lean index 72afcbed23..b3ff2b6ee8 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models.lean @@ -3,8 +3,12 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine + +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine /-! Supporting modules for Beyond the Bethe approximation of the permanent. -/ + +@[expose] public section diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine.lean index 94db373304..943486966e 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine.lean @@ -303,7 +303,7 @@ simulator this proves `RAM.RegisterStore.Machine.RAM_P_eq_P`. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Classes.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Classes.lean index 4d8d53bb96..dbecd7bbd7 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Classes.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Classes.lean @@ -15,7 +15,7 @@ elementary monotonicity properties. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Internal.lean index 2353c2b3db..8e3bf264a0 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Internal.lean @@ -32,7 +32,7 @@ statements in the surface module carry the mathematical content. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation.lean index 8f2f13b473..6074efa7ab 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation.lean @@ -3,8 +3,12 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig + +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig /-! Supporting modules for Beyond the Bethe approximation of the permanent. -/ + +@[expose] public section diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore.lean index 60cee37c94..7cac9d628b 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore.lean @@ -24,7 +24,7 @@ bit-width at most `w`, a snapshot with `m` entries occupies at most -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Containment.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Containment.lean index 04e0bbf57f..8986e9758d 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Containment.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Containment.lean @@ -19,7 +19,7 @@ establish machine-model robustness of polynomial time. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Containment/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Containment/Internal.lean index e798c0154b..fdf4b9d43e 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Containment/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Containment/Internal.lean @@ -28,7 +28,7 @@ envelope and lifts the simulation to deterministic polynomial time. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/DenseOverlay.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/DenseOverlay.lean index bb54546670..83eadb0654 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/DenseOverlay.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/DenseOverlay.lean @@ -18,7 +18,7 @@ from an absent overlay entry. -/ -public section +@[expose] public section namespace Complexity namespace RAM diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/DenseOverlay/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/DenseOverlay/Internal.lean index 1161656eb7..f6a5782df2 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/DenseOverlay/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/DenseOverlay/Internal.lean @@ -13,7 +13,7 @@ public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simu -/ -public section +@[expose] public section namespace Complexity namespace RAM diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Internal.lean index a43eaad0f3..fbc2c89734 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Internal.lean @@ -17,7 +17,7 @@ the surface module. It is not part of the human-audited definitions layer. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine.lean index 9153920c54..470722e9d7 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine.lean @@ -3,25 +3,29 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.AddressEq -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.DenseInputLookup -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryAppend -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryCleanup -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryDecode -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryEncode -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryLookup -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryLookupRestore -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryMatch -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryMissCopy -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryReplace -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryScan -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryScanStep -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.WordDecode -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.WordEncode + +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.AddressEq +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.DenseInputLookup +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryAppend +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryCleanup +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryDecode +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryEncode +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryLookup +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryLookupRestore +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryMatch +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryMissCopy +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryReplace +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryScan +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryScanStep +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.WordDecode +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.WordEncode /-! Supporting modules for Beyond the Bethe approximation of the permanent. -/ + +@[expose] public section diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/AddressEq.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/AddressEq.lean index 21cb6a4258..c2feb76c96 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/AddressEq.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/AddressEq.lean @@ -17,7 +17,7 @@ comparison used by the concrete sparse register-store scan. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/AddressEq/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/AddressEq/Internal.lean index f2733dcbee..c243630d08 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/AddressEq/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/AddressEq/Internal.lean @@ -15,7 +15,7 @@ public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutine -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/DenseInputLookup.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/DenseInputLookup.lean index 2b6dbe405d..3d1d34901f 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/DenseInputLookup.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/DenseInputLookup.lean @@ -16,7 +16,7 @@ overlay into the immutable public-input bank. -/ -public section +@[expose] public section namespace Complexity namespace RAM diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/DenseInputLookup/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/DenseInputLookup/Internal.lean index 8028a72d01..4222b8cf85 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/DenseInputLookup/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/DenseInputLookup/Internal.lean @@ -18,7 +18,7 @@ public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutine -/ -public section +@[expose] public section namespace Complexity namespace RAM diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryAppend.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryAppend.lean index b06359a3ba..d050620d68 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryAppend.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryAppend.lean @@ -15,7 +15,7 @@ public import -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryAppend/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryAppend/Internal.lean index ce75245cb1..b9349f0895 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryAppend/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryAppend/Internal.lean @@ -18,7 +18,7 @@ public import Mathlib.Tactic.NormNum.OfScientific -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryCleanup.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryCleanup.lean index 793f88c65e..ca0ce1909e 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryCleanup.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryCleanup.lean @@ -18,7 +18,7 @@ bounded sparse register-store scan. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryCleanup/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryCleanup/Internal.lean index d619d48e80..f5d4daf952 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryCleanup/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryCleanup/Internal.lean @@ -20,7 +20,7 @@ public import Mathlib.Tactic.NormNum.OfScientific -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryDecode.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryDecode.lean index b5ad13f156..3c0c5f76d4 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryDecode.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryDecode.lean @@ -20,7 +20,7 @@ address/value decoder. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryDecode/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryDecode/Internal.lean index 27a84bf8b7..4b19dd80c6 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryDecode/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryDecode/Internal.lean @@ -14,7 +14,7 @@ public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simu -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryDecode/LinearInternal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryDecode/LinearInternal.lean index 7d57d6a8c7..045ce4dfbd 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryDecode/LinearInternal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryDecode/LinearInternal.lean @@ -18,7 +18,7 @@ framed for compatibility with the existing sparse-store work-tape layout. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryEncode.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryEncode.lean index c93593a45b..f63dd7f472 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryEncode.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryEncode.lean @@ -16,7 +16,7 @@ public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Hoare.Reta -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryEncode/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryEncode/Internal.lean index eb1665ad64..5e7db45975 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryEncode/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryEncode/Internal.lean @@ -14,7 +14,7 @@ public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simu -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryLookup.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryLookup.lean index 6cc222e36c..f2171fb673 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryLookup.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryLookup.lean @@ -17,7 +17,7 @@ public import -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryLookup/Defs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryLookup/Defs.lean index b64f140d95..d8e5b2ca9f 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryLookup/Defs.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryLookup/Defs.lean @@ -16,7 +16,7 @@ its semantic endpoint in terms of the pure sparse-store `read` operation. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryLookup/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryLookup/Internal.lean index d28598a443..0dda676a9c 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryLookup/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryLookup/Internal.lean @@ -15,7 +15,7 @@ public import Mathlib.Data.Nat.Bitwise -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryLookupRestore.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryLookupRestore.lean index 54f64f960b..a49e7c6b49 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryLookupRestore.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryLookupRestore.lean @@ -18,7 +18,7 @@ source, restores the runtime entry count, and returns to the same scanner ABI. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryMatch.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryMatch.lean index b94ad6a98b..c227e53dbb 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryMatch.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryMatch.lean @@ -18,7 +18,7 @@ unit used by a bounded sparse register-store scan. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryMatch/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryMatch/Internal.lean index 829f24a1c3..b3a95fe74e 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryMatch/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryMatch/Internal.lean @@ -15,7 +15,7 @@ public import -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryMissCopy.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryMissCopy.lean index 8314cf8195..1c093df071 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryMissCopy.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryMissCopy.lean @@ -18,7 +18,7 @@ the new store and restores the exact invariant needed to inspect the next one. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryMissCopy/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryMissCopy/Internal.lean index 3b23a1bc12..ca6bd430d6 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryMissCopy/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryMissCopy/Internal.lean @@ -15,7 +15,7 @@ public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simu -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryReplace.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryReplace.lean index 4a64b67bfb..92ab772c24 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryReplace.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryReplace.lean @@ -15,7 +15,7 @@ public import -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryReplace/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryReplace/Internal.lean index bad7dc0f04..f76a941287 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryReplace/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryReplace/Internal.lean @@ -15,7 +15,7 @@ public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simu -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryScan.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryScan.lean index 70cce4fee1..09b38c071b 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryScan.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryScan.lean @@ -21,7 +21,7 @@ it is not hardwired into the finite controller. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryScan/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryScan/Internal.lean index 8c00907302..bc452810ed 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryScan/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryScan/Internal.lean @@ -3,10 +3,14 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryScan.Internal.Bounds -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryScan.Internal.Ctrl -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryScan.Internal.Inv -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryScan.Internal.Sem + +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryScan.Internal.Bounds +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryScan.Internal.Ctrl +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryScan.Internal.Inv +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryScan.Internal.Sem /-! Supporting modules for Beyond the Bethe approximation of the permanent. -/ + +@[expose] public section diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryScan/Internal/Bounds.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryScan/Internal/Bounds.lean index fb3510d8f3..45fae7a9bb 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryScan/Internal/Bounds.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryScan/Internal/Bounds.lean @@ -5,12 +5,12 @@ Authors: Samuel Schlesinger -/ module -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryMatch.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryMatch.Internal public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryScan.Defs -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryPred -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.ResetBinaryMany +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryPred +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.ResetBinaryMany /-! # Encoded-length bounds for sparse-entry scans -- proof internals @@ -21,7 +21,7 @@ scan theorem retains only the separate binary remaining-count charge. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryScan/Internal/Inv.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryScan/Internal/Inv.lean index 082439b030..01843d297b 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryScan/Internal/Inv.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryScan/Internal/Inv.lean @@ -7,19 +7,19 @@ Authors: Samuel Schlesinger module public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryScan.Defs -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.ResetBinaryMany -import Mathlib.Tactic.FinCases -import Mathlib.Data.Rat.Cast.Order -import Mathlib.Tactic.NormNum.Abs -import Mathlib.Tactic.NormNum.DivMod -import Mathlib.Tactic.NormNum.OfScientific +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.ResetBinaryMany +public import Mathlib.Tactic.FinCases +public import Mathlib.Data.Rat.Cast.Order +public import Mathlib.Tactic.NormNum.Abs +public import Mathlib.Tactic.NormNum.DivMod +public import Mathlib.Tactic.NormNum.OfScientific /-! # Bounded sparse-entry scan — invariant internals -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryScan/Internal/Sem.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryScan/Internal/Sem.lean index 893094e907..cd4abc51f6 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryScan/Internal/Sem.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryScan/Internal/Sem.lean @@ -5,11 +5,11 @@ Authors: Samuel Schlesinger -/ module -import +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryScan.Internal.Ctrl public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryScan.Internal.Inv -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.WorkBranch +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.WorkBranch public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryPred public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryScanStep @@ -19,7 +19,7 @@ public import -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryScanStep.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryScanStep.lean index 8970e91ea1..b27549d668 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryScanStep.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryScanStep.lean @@ -18,7 +18,7 @@ encoded sparse register-store entry. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryScanStep/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryScanStep/Internal.lean index 8e5a036177..4424c2bca7 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryScanStep/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryScanStep/Internal.lean @@ -16,7 +16,7 @@ public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simu -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate.lean index 6a567a0872..1ca0dbfb30 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate.lean @@ -26,7 +26,7 @@ entry exactly when the address was absent. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/BoundsInternal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/BoundsInternal.lean index 02905c0211..fbc9887a77 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/BoundsInternal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/BoundsInternal.lean @@ -22,7 +22,7 @@ linear in the current entry and the instruction's query/replacement widths. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal.lean index 29820fba6b..1a4620fc52 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal.lean @@ -3,16 +3,20 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Ctrl -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.End -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Hit -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Inv -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Loop -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Miss -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Out -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Sem -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Step -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Time + +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Ctrl +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.End +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Hit +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Inv +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Loop +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Miss +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Out +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Sem +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Step +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Time /-! Supporting modules for Beyond the Bethe approximation of the permanent. -/ + +@[expose] public section diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/End.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/End.lean index 066dde13f5..be792665f3 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/End.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/End.lean @@ -7,11 +7,11 @@ Authors: Samuel Schlesinger module public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Loop -import +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Out -import +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Time -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.WorkBranch +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.WorkBranch /-! # Bounded encoded sparse-store update -- terminal loop case @@ -22,7 +22,7 @@ runs the checked append and result-count successor subroutines. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Hit.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Hit.lean index 5cc510c686..a5fb281a04 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Hit.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Hit.lean @@ -7,11 +7,11 @@ Authors: Samuel Schlesinger module public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Loop -import +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Out -import +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Time -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.WorkBranch +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.WorkBranch /-! # Bounded encoded sparse-store update -- matching iterations @@ -22,7 +22,7 @@ requested address. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Inv.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Inv.lean index 2b8b5bbd2e..12d2c0d03a 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Inv.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Inv.lean @@ -9,7 +9,7 @@ public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Ctrl public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryScan.Internal.Inv -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinarySucc +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinarySucc /-! # Bounded encoded sparse-store update — invariant internals diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Loop.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Loop.lean index 026665a107..0eaea0c34d 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Loop.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Loop.lean @@ -15,7 +15,7 @@ public import -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Miss.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Miss.lean index 057c102a88..9707b19b20 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Miss.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Miss.lean @@ -7,19 +7,19 @@ Authors: Samuel Schlesinger module public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Loop -import +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Out -import +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Time -import Mathlib.Data.Nat.Bitwise -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.WorkBranch +public import Mathlib.Data.Nat.Bitwise +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.WorkBranch /-! # Bounded encoded sparse-store update -- unmatched entry iteration -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Out.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Out.lean index 8ed24d7bc5..3450fa60eb 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Out.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Out.lean @@ -11,7 +11,7 @@ public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simu public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryMissCopy public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryReplace -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryPred +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryPred public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryMatch /-! @@ -23,7 +23,7 @@ the output head idle, so the complete controller remains a transducer. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Sem.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Sem.lean index c8b8af64ee..be485c3797 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Sem.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Sem.lean @@ -7,7 +7,7 @@ Authors: Samuel Schlesinger module public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Step -import +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.End /-! @@ -20,7 +20,7 @@ output needed to connect the concrete controller to `RegisterStore.write`. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Step.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Step.lean index 62ed78105d..3847feaa11 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Step.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Step.lean @@ -5,7 +5,7 @@ Authors: Samuel Schlesinger -/ module -import +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Hit public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Miss @@ -15,7 +15,7 @@ LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.Registe -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Time.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Time.lean index 3d66a80b94..3e2b198571 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Time.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Time.lean @@ -8,13 +8,13 @@ module public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Defs public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryPred -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinarySucc -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.ResetBinaryMany -import Mathlib.Data.Rat.Cast.Order -import Mathlib.Tactic.FinCases -import Mathlib.Tactic.NormNum.Abs -import Mathlib.Tactic.NormNum.DivMod -import Mathlib.Tactic.NormNum.OfScientific +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinarySucc +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.ResetBinaryMany +public import Mathlib.Data.Rat.Cast.Order +public import Mathlib.Tactic.FinCases +public import Mathlib.Tactic.NormNum.Abs +public import Mathlib.Tactic.NormNum.DivMod +public import Mathlib.Tactic.NormNum.OfScientific /-! # Bounded encoded sparse-store update — static runtime bounds @@ -26,7 +26,7 @@ readable match bounds the one cursor whose endpoint is intentionally in-place. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Progress.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Progress.lean index 3e4b649db4..7acd1fb61e 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Progress.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Progress.lean @@ -17,7 +17,7 @@ simulation proof. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Source.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Source.lean index d52829416f..7a537dec9d 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Source.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Source.lean @@ -21,7 +21,7 @@ read-only certificate. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Tagged.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Tagged.lean index 9426d6d5a2..37b749b96c 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Tagged.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Tagged.lean @@ -13,7 +13,7 @@ public import -/ -public section +@[expose] public section namespace Complexity namespace RAM diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/TaggedProof.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/TaggedProof.lean index a50aae594c..2bd64e2b7f 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/TaggedProof.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/TaggedProof.lean @@ -15,7 +15,7 @@ public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simu -/ -public section +@[expose] public section namespace Complexity namespace RAM diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction.lean index b523fad979..03fdffdeaa 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction.lean @@ -30,7 +30,7 @@ controller. A redirected form writes the new store to a fresh work buffer. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Control.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Control.lean index fa7b802807..ca098ccd17 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Control.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Control.lean @@ -19,7 +19,7 @@ counter tape. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseControl.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseControl.lean index 6eb57f3dda..832613d184 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseControl.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseControl.lean @@ -15,7 +15,7 @@ public import -/ -public section +@[expose] public section namespace Complexity namespace RAM diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseCtrlSim.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseCtrlSim.lean index 2772ef5911..50208db266 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseCtrlSim.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseCtrlSim.lean @@ -17,7 +17,7 @@ public import -/ -public section +@[expose] public section namespace Complexity namespace RAM diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseDirect.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseDirect.lean index 016a1020cb..d8149e3db5 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseDirect.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseDirect.lean @@ -19,7 +19,7 @@ public import -/ -public section +@[expose] public section namespace Complexity namespace RAM diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseDispatch.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseDispatch.lean index 637b6c4dc8..ba3efe0d7c 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseDispatch.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseDispatch.lean @@ -16,7 +16,7 @@ public import -/ -public section +@[expose] public section namespace Complexity namespace RAM diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseImm.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseImm.lean index 4f44e519da..b39c70c917 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseImm.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseImm.lean @@ -17,7 +17,7 @@ public import -/ -public section +@[expose] public section namespace Complexity namespace RAM diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseLoad.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseLoad.lean index e098f94b93..af166596b9 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseLoad.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseLoad.lean @@ -19,7 +19,7 @@ public import -/ -public section +@[expose] public section namespace Complexity namespace RAM diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseSim.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseSim.lean index 196ae385ee..560788d744 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseSim.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseSim.lean @@ -15,7 +15,7 @@ public import -/ -public section +@[expose] public section namespace Complexity namespace RAM diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseSimData.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseSimData.lean index 6f6928ab5e..87bbaf5faf 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseSimData.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseSimData.lean @@ -21,7 +21,7 @@ public import -/ -public section +@[expose] public section namespace Complexity namespace RAM diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseStore.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseStore.lean index 63b6c1fa5d..d3987fb3f8 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseStore.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseStore.lean @@ -13,7 +13,7 @@ public import -/ -public section +@[expose] public section namespace Complexity namespace RAM diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Direct.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Direct.lean index 485ee8fd19..674a29c533 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Direct.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Direct.lean @@ -15,7 +15,7 @@ public import -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Dispatch.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Dispatch.lean index cca78d58ec..efe3838a6e 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Dispatch.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Dispatch.lean @@ -25,7 +25,7 @@ execution layer. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Immediate.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Immediate.lean index c98883f07e..158147f517 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Immediate.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Immediate.lean @@ -15,7 +15,7 @@ public import -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Internal.lean index dead877b63..a2c1bc2347 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Internal.lean @@ -16,7 +16,7 @@ public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutine -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Load.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Load.lean index be2152fb1f..b2f4df6ef8 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Load.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Load.lean @@ -16,7 +16,7 @@ public import -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Sim.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Sim.lean index 26ce89a0f6..2b6a9ed6a0 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Sim.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Sim.lean @@ -3,10 +3,14 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Sim.Control -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Sim.Data -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Sim.Defs -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Sim.Internal + +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Sim.Control +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Sim.Data +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Sim.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Sim.Internal /-! Supporting modules for Beyond the Bethe approximation of the permanent. -/ + +@[expose] public section diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Sim/Control.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Sim/Control.lean index cfef692d86..bb8728658e 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Sim/Control.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Sim/Control.lean @@ -7,15 +7,15 @@ Authors: Samuel Schlesinger module public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Sim.Defs -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.CopyWorkOutput +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.CopyWorkOutput /-! # Uniform next-store buffering for control instructions -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Sim/Data.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Sim/Data.lean index 5e6e440cfa..f390101a7c 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Sim/Data.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Sim/Data.lean @@ -14,7 +14,7 @@ public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simu -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Sim/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Sim/Internal.lean index fe6ac941f1..58c6c42ef5 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Sim/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Sim/Internal.lean @@ -7,18 +7,18 @@ Authors: Samuel Schlesinger module public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Sim.Defs -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.WorkBranch -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryCopy -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryPred -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.ResetBinaryMany +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.WorkBranch +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryCopy +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryPred +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.ResetBinaryMany /-! # Fixed-program dispatch -- proof internals -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Store.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Store.lean index 696e954958..230de8f826 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Store.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Store.lean @@ -13,7 +13,7 @@ public import -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup.lean index 4ba1b3893d..bc7de32abb 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup.lean @@ -3,9 +3,13 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Defs -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.DenseInternal -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Internal + +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.DenseInternal +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Internal /-! Supporting modules for Beyond the Bethe approximation of the permanent. -/ + +@[expose] public section diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/DenseInternal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/DenseInternal.lean index 0443ceabaf..16bc413d8a 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/DenseInternal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/DenseInternal.lean @@ -15,7 +15,7 @@ LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.Registe -/ -public section +@[expose] public section namespace Complexity namespace RAM diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/Internal.lean index 2eabefe7f6..65f4328c1b 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/Internal.lean @@ -3,14 +3,18 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Internal.Assemble -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Internal.Bounds -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Internal.Prepare -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Internal.Reset -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Internal.Restore -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Internal.Scan -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Internal.Static -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Internal.Value + +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Internal.Assemble +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Internal.Bounds +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Internal.Prepare +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Internal.Reset +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Internal.Restore +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Internal.Scan +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Internal.Static +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Internal.Value /-! Supporting modules for Beyond the Bethe approximation of the permanent. -/ + +@[expose] public section diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/Internal/Assemble.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/Internal/Assemble.lean index caaf2ede60..679eac6e05 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/Internal/Assemble.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/Internal/Assemble.lean @@ -5,13 +5,13 @@ Authors: Samuel Schlesinger -/ module -import +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Internal.Prepare -import +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Internal.Restore public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Internal.Scan -import +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Internal.Value /-! @@ -19,7 +19,7 @@ import -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/Internal/Bounds.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/Internal/Bounds.lean index 4d4458a00e..b347117963 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/Internal/Bounds.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/Internal/Bounds.lean @@ -12,7 +12,7 @@ public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simu -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/Internal/Prepare.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/Internal/Prepare.lean index 1d066dc752..aded57c958 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/Internal/Prepare.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/Internal/Prepare.lean @@ -6,14 +6,14 @@ Authors: Samuel Schlesinger module public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Defs -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryCopy +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryCopy /-! # Reusable sparse-register lookup -- query preparation -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/Internal/Reset.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/Internal/Reset.lean index 45b63b558f..ca7d8ebf22 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/Internal/Reset.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/Internal/Reset.lean @@ -7,17 +7,17 @@ Authors: Samuel Schlesinger module public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Internal.Bounds -import Mathlib.Data.Rat.Cast.Order -import Mathlib.Tactic.NormNum.Abs -import Mathlib.Tactic.NormNum.DivMod -import Mathlib.Tactic.NormNum.OfScientific +public import Mathlib.Data.Rat.Cast.Order +public import Mathlib.Tactic.NormNum.Abs +public import Mathlib.Tactic.NormNum.DivMod +public import Mathlib.Tactic.NormNum.OfScientific /-! # Reusable sparse-register lookup -- reset certificates -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/Internal/Restore.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/Internal/Restore.lean index cc7d04e317..6ddda29f29 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/Internal/Restore.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/Internal/Restore.lean @@ -5,20 +5,20 @@ Authors: Samuel Schlesinger -/ module -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.ResetBinaryMany +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.ResetBinaryMany public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Defs -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryCopy -import Mathlib.Data.Rat.Cast.Order -import Mathlib.Tactic.NormNum.Abs -import Mathlib.Tactic.NormNum.DivMod -import Mathlib.Tactic.NormNum.OfScientific +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryCopy +public import Mathlib.Data.Rat.Cast.Order +public import Mathlib.Tactic.NormNum.Abs +public import Mathlib.Tactic.NormNum.DivMod +public import Mathlib.Tactic.NormNum.OfScientific /-! # Reusable sparse-register lookup -- scanner restoration -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/Internal/Scan.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/Internal/Scan.lean index 9554371b07..9421390b43 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/Internal/Scan.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/Internal/Scan.lean @@ -14,7 +14,7 @@ public import -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/Internal/Static.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/Internal/Static.lean index 19d506e9ed..4f89294d8b 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/Internal/Static.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/Internal/Static.lean @@ -14,7 +14,7 @@ public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutine -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/Internal/Value.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/Internal/Value.lean index bbfa317046..fb43a419a3 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/Internal/Value.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/Internal/Value.lean @@ -5,19 +5,19 @@ Authors: Samuel Schlesinger -/ module -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryCopy +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryCopy public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Defs -import Mathlib.Data.Rat.Cast.Order -import Mathlib.Tactic.NormNum.Abs -import Mathlib.Tactic.NormNum.DivMod -import Mathlib.Tactic.NormNum.OfScientific +public import Mathlib.Data.Rat.Cast.Order +public import Mathlib.Tactic.NormNum.Abs +public import Mathlib.Tactic.NormNum.DivMod +public import Mathlib.Tactic.NormNum.OfScientific /-! # Reusable sparse-register lookup -- value rewind and copy -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program.lean index dc17253ad1..4f1c063858 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program.lean @@ -18,7 +18,7 @@ the selected instruction is `halt`. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Bounds.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Bounds.lean index 886c5a4156..779a5c7195 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Bounds.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Bounds.lean @@ -15,7 +15,7 @@ public import -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Bounds/Defs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Bounds/Defs.lean index 2323709c87..2e348fbaec 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Bounds/Defs.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Bounds/Defs.lean @@ -6,8 +6,8 @@ Authors: Samuel Schlesinger module public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Defs -import Mathlib.Tactic.NormNum.Inv -import Mathlib.Tactic.NormNum.Pow +public import Mathlib.Tactic.NormNum.Inv +public import Mathlib.Tactic.NormNum.Pow /-! # Sparse RAM decision-machine resource-bound definitions diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Bounds/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Bounds/Internal.lean index df1755c23c..a10012adb7 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Bounds/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Bounds/Internal.lean @@ -9,7 +9,7 @@ public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Bounds.Defs public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Decision.Defs -import +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Init.Internal public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Internal @@ -19,7 +19,7 @@ public import -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Decision.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Decision.lean index dcc10264c7..f2c90f3f63 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Decision.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Decision.lean @@ -15,7 +15,7 @@ public import -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DecisionInternal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DecisionInternal.lean index a28ad43a54..8ea9ed0b02 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DecisionInternal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DecisionInternal.lean @@ -17,7 +17,7 @@ public import -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseBounds.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseBounds.lean index ce64ed7fb9..bdce6c4897 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseBounds.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseBounds.lean @@ -19,7 +19,7 @@ optimized dense-input RAM simulator. -/ -public section +@[expose] public section namespace Complexity namespace RAM diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseBoundsProof.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseBoundsProof.lean index dcb3469eee..0c0a368167 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseBoundsProof.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseBoundsProof.lean @@ -21,7 +21,7 @@ LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.Registe -/ -public section +@[expose] public section namespace Complexity namespace RAM diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseDecision.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseDecision.lean index 10d6c44488..1e55066dfd 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseDecision.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseDecision.lean @@ -15,7 +15,7 @@ LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.Registe -/ -public section +@[expose] public section namespace Complexity namespace RAM diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseDecisionProof.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseDecisionProof.lean index f13334be7e..64d9da978d 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseDecisionProof.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseDecisionProof.lean @@ -17,7 +17,7 @@ public import -/ -public section +@[expose] public section namespace Complexity namespace RAM diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseInit.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseInit.lean index d023128c83..49064c3014 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseInit.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseInit.lean @@ -19,7 +19,7 @@ program ABI, and rewinds the input for dense fallback reads. -/ -public section +@[expose] public section namespace Complexity namespace RAM diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseInitProof.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseInitProof.lean index 15f4d52618..ed077a4dc9 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseInitProof.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseInitProof.lean @@ -18,7 +18,7 @@ public import -/ -public section +@[expose] public section namespace Complexity namespace RAM diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseInternal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseInternal.lean index e42fcabf3e..b39c27be4d 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseInternal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseInternal.lean @@ -16,7 +16,7 @@ LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.Registe -/ -public section +@[expose] public section namespace Complexity namespace RAM diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Init.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Init.lean index 914e2e63e4..bd11eb1dea 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Init.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Init.lean @@ -3,8 +3,12 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Init.Defs -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Init.Internal + +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Init.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Init.Internal /-! Supporting modules for Beyond the Bethe approximation of the permanent. -/ + +@[expose] public section diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Init/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Init/Internal.lean index b0fb514d8a..09cda7267e 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Init/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Init/Internal.lean @@ -7,23 +7,23 @@ Authors: Samuel Schlesinger module public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Init.Defs -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryEncode -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.WorkBranch -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryCopy -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryPred -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.ResetBinaryMany -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore -import Mathlib.Data.Rat.Cast.Order -import Mathlib.Tactic.NormNum.Abs -import Mathlib.Tactic.NormNum.DivMod -import Mathlib.Tactic.NormNum.OfScientific +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryEncode +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.WorkBranch +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryCopy +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryPred +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.ResetBinaryMany +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore +public import Mathlib.Data.Rat.Cast.Order +public import Mathlib.Tactic.NormNum.Abs +public import Mathlib.Tactic.NormNum.DivMod +public import Mathlib.Tactic.NormNum.OfScientific /-! # Sparse RAM public-input initialization -- proof internals -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Initialization.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Initialization.lean index c2737b4569..f7232f2fa3 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Initialization.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Initialization.lean @@ -19,7 +19,7 @@ clean work-tape image consumed by the reusable RAM program controller. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Internal.lean index 4b7f9a1f8c..b0a3d61d81 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Internal.lean @@ -15,7 +15,7 @@ public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinator -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/WordDecode.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/WordDecode.lean index d1ca36fc4a..ea9038e85a 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/WordDecode.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/WordDecode.lean @@ -23,7 +23,7 @@ natural on a separate work tape. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/WordDecode/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/WordDecode/Internal.lean index 1c775d85e3..de68685a22 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/WordDecode/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/WordDecode/Internal.lean @@ -27,7 +27,7 @@ cursor and the canonical binary width counter. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/WordDecode/LinearInternal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/WordDecode/LinearInternal.lean index b3556d84e1..6b9e18b56f 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/WordDecode/LinearInternal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/WordDecode/LinearInternal.lean @@ -19,7 +19,7 @@ while copying one payload bit. Each pass is linear in the encoded word width. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/WordEncode.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/WordEncode.lean index 5406ae4932..4b935bce24 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/WordEncode.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/WordEncode.lean @@ -15,7 +15,7 @@ public import -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/WordEncode/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/WordEncode/Internal.lean index b5ddf5524f..17345b8760 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/WordEncode/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/WordEncode/Internal.lean @@ -16,7 +16,7 @@ public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutine -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig.lean index 0dcb8c5f55..dacae9dd64 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig.lean @@ -18,7 +18,7 @@ information. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Internal.lean index b7b9d72bc6..cc8ca1dc22 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Internal.lean @@ -12,7 +12,7 @@ public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simu -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse.lean index 6d9da0e681..59c7a2d53f 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse.lean @@ -17,7 +17,7 @@ input length or running-time bound. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/ABI.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/ABI.lean index a27cbd2075..b2fdf254e6 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/ABI.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/ABI.lean @@ -21,7 +21,7 @@ Boolean verdict in `R₀`. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/ABI/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/ABI/Internal.lean index 6c7291a403..43a7810c39 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/ABI/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/ABI/Internal.lean @@ -3,11 +3,15 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.ABI.Internal.Capture -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.ABI.Internal.Decision -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.ABI.Internal.Loop -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.ABI.Internal.Marshal -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.ABI.Internal.Resources + +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.ABI.Internal.Capture +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.ABI.Internal.Decision +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.ABI.Internal.Loop +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.ABI.Internal.Marshal +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.ABI.Internal.Resources /-! Supporting modules for Beyond the Bethe approximation of the permanent. -/ + +@[expose] public section diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/ABI/Internal/Capture.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/ABI/Internal/Capture.lean index 4d7155ab53..3420c82ad5 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/ABI/Internal/Capture.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/ABI/Internal/Capture.lean @@ -6,15 +6,15 @@ Authors: Samuel Schlesinger module public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.ABI.Defs -import Mathlib.Tactic.NormNum.Inv -import Mathlib.Tactic.NormNum.Pow +public import Mathlib.Tactic.NormNum.Inv +public import Mathlib.Tactic.NormNum.Pow /-! # Capturing raw-input scratch bits in finite control -- proof internals -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/ABI/Internal/Decision.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/ABI/Internal/Decision.lean index 543205737e..f45d4ad4cd 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/ABI/Internal/Decision.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/ABI/Internal/Decision.lean @@ -7,7 +7,7 @@ Authors: Samuel Schlesinger module public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.ABI.Internal.Marshal -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.Step.Internal.Iteration +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.Step.Internal.Iteration public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured /-! @@ -15,7 +15,7 @@ public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Stru -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/ABI/Internal/Loop.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/ABI/Internal/Loop.lean index afa8a777a8..441e5ba987 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/ABI/Internal/Loop.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/ABI/Internal/Loop.lean @@ -13,7 +13,7 @@ public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simu -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/ABI/Internal/Marshal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/ABI/Internal/Marshal.lean index 2bbc5bed44..d539ae0a61 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/ABI/Internal/Marshal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/ABI/Internal/Marshal.lean @@ -5,11 +5,11 @@ Authors: Samuel Schlesinger -/ module -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.ABI.Internal.Loop -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.ABI.Internal.Loop +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.Internal public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.ABI.Internal.Capture -import Mathlib.Algebra.Order.Sub.Basic +public import Mathlib.Algebra.Order.Sub.Basic /-! # Public-input marshalling correctness -- proof internals diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/ABI/Internal/Resources.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/ABI/Internal/Resources.lean index 2fc0a417c1..7f85a51585 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/ABI/Internal/Resources.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/ABI/Internal/Resources.lean @@ -21,7 +21,7 @@ the sparse data region, returning to the core envelope before simulation. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Containment.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Containment.lean index 41f4007a06..3744e1c0d3 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Containment.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Containment.lean @@ -17,7 +17,7 @@ Turing time is therefore contained in polynomial RAM time. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Containment/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Containment/Internal.lean index c893a7f7ff..a8f4de8143 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Containment/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Containment/Internal.lean @@ -19,7 +19,7 @@ forward machine-model robustness theorem. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Internal.lean index 7c72412080..5543a2d566 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Internal.lean @@ -13,7 +13,7 @@ public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simu -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Step.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Step.lean index 05c18eb005..3edfcd1765 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Step.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Step.lean @@ -23,7 +23,7 @@ public input/output marshalling layer. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Step/Internal/Action.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Step/Internal/Action.lean index 9fec16b7e0..e75d47b937 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Step/Internal/Action.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Step/Internal/Action.lean @@ -14,7 +14,7 @@ public import -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Step/Internal/Dispatch.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Step/Internal/Dispatch.lean index 07ed783843..20e50b19a7 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Step/Internal/Dispatch.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Step/Internal/Dispatch.lean @@ -5,7 +5,7 @@ Authors: Samuel Schlesinger -/ module -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.Step.Internal.Action +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.Step.Internal.Action public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.Switch public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.Step.Internal.Load @@ -14,7 +14,7 @@ public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simu -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Step/Internal/Iteration.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Step/Internal/Iteration.lean index 5828834363..2fd6e61ee2 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Step/Internal/Iteration.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Step/Internal/Iteration.lean @@ -13,7 +13,7 @@ public import -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Step/Internal/Layout.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Step/Internal/Layout.lean index 7269afa211..6d4aeda8e7 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Step/Internal/Layout.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Step/Internal/Layout.lean @@ -13,7 +13,7 @@ public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simu -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Step/Internal/Load.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Step/Internal/Load.lean index 6b008a4f43..b46313836d 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Step/Internal/Load.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Step/Internal/Load.lean @@ -13,7 +13,7 @@ public import -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Step/Internal/Resources.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Step/Internal/Resources.lean index e937dfc40f..cbb0bb6e68 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Step/Internal/Resources.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Step/Internal/Resources.lean @@ -18,7 +18,7 @@ measurements into explicit bounds depending only on input length and TM steps. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Step.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Step.lean index 120eb115b6..af4961b86f 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Step.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Step.lean @@ -19,7 +19,7 @@ envelope and compiled-RAM transfer are the next M6 layer. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Step/Internal/Action.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Step/Internal/Action.lean index 0968391526..7fe088c4ba 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Step/Internal/Action.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Step/Internal/Action.lean @@ -13,7 +13,7 @@ public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Stru -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Step/Internal/Dispatch.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Step/Internal/Dispatch.lean index 55d8729259..d5efe9952a 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Step/Internal/Dispatch.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Step/Internal/Dispatch.lean @@ -14,7 +14,7 @@ public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simu -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Step/Internal/Layout.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Step/Internal/Layout.lean index 8616c89b02..cf1cccfcb4 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Step/Internal/Layout.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Step/Internal/Layout.lean @@ -13,7 +13,7 @@ public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simu -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Step/Internal/Load.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Step/Internal/Load.lean index d052ca0ee1..589faf65bf 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Step/Internal/Load.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Step/Internal/Load.lean @@ -13,7 +13,7 @@ public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Stru -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Step/Internal/Resources.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Step/Internal/Resources.lean index b066cacfb7..d267389bb0 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Step/Internal/Resources.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Step/Internal/Resources.lean @@ -14,7 +14,7 @@ public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Stru -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Soundness.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Soundness.lean index 532da54ba8..82718f49db 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Soundness.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Soundness.lean @@ -30,7 +30,7 @@ convention but the boundary between a sound Turing-equivalent model and a -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured.lean index fcc6701dd9..1ee185330c 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured.lean @@ -27,7 +27,7 @@ accounting and preserves explicit logarithmic-cost and space envelopes. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/GateEval.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/GateEval.lean index 70cef9df35..37a48532e9 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/GateEval.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/GateEval.lean @@ -20,7 +20,7 @@ and indirectly appends the result in exactly twenty RAM transitions. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/GateEval/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/GateEval/Internal.lean index b06290db21..1e5de6d30a 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/GateEval/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/GateEval/Internal.lean @@ -15,7 +15,7 @@ public import Std.Tactic.BVDecide.Normalize.Bool -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/GateStep.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/GateStep.lean index fcdce90311..9cf9861546 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/GateStep.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/GateStep.lean @@ -19,7 +19,7 @@ memo base at runtime, evaluates the decoded gate, and appends its result. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/GateStep/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/GateStep/Internal.lean index b250a4609d..82b779ec6d 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/GateStep/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/GateStep/Internal.lean @@ -16,7 +16,7 @@ public import Mathlib.Tactic.IntervalCases -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/GateStreamStep.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/GateStreamStep.lean index 8f040761b6..d5ebfac8bc 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/GateStreamStep.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/GateStreamStep.lean @@ -18,7 +18,7 @@ routine can be invoked again at the returned cursor. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/GateStreamStep/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/GateStreamStep/Internal.lean index 08190b3e6f..37612f940f 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/GateStreamStep/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/GateStreamStep/Internal.lean @@ -16,7 +16,7 @@ public import Mathlib.Tactic.IntervalCases -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Hamming.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Hamming.lean index 8675096739..9520e16097 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Hamming.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Hamming.lean @@ -22,7 +22,7 @@ quasilinear asymptotic corollaries. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Hamming/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Hamming/Internal.lean index 1f17037557..009699ccee 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Hamming/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Hamming/Internal.lean @@ -13,7 +13,7 @@ public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Stru -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Internal.lean index f59e1aa5db..47792a12db 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Internal.lean @@ -18,7 +18,7 @@ semantics exactly: final registers, logarithmic cost, and peak register space. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/LastBit.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/LastBit.lean index 41e45d6527..5170004dfb 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/LastBit.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/LastBit.lean @@ -18,7 +18,7 @@ and resource bounds. This module adds only agreement with the existing -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/PairValidate.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/PairValidate.lean index de8a819c29..ecf9839cab 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/PairValidate.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/PairValidate.lean @@ -20,7 +20,7 @@ correctness theorem for the canonical pair-encoding language. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/PairValidate/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/PairValidate/Internal.lean index 983a91a797..b391ff7ebf 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/PairValidate/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/PairValidate/Internal.lean @@ -16,7 +16,7 @@ execution, correctness, and resource proofs are all in the generic scanner layer -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Scanner.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Scanner.lean index 5accfb0d93..dc6d669c0f 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Scanner.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Scanner.lean @@ -20,7 +20,7 @@ the concrete compiled RAM. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Scanner/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Scanner/Internal.lean index cf9bd998fc..16f4e52c51 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Scanner/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Scanner/Internal.lean @@ -14,7 +14,7 @@ public import Std.Tactic.BVDecide.Normalize.BitVec -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Switch.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Switch.lean index 6aa484ba1c..813e03a081 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Switch.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Switch.lean @@ -16,7 +16,7 @@ logarithmic-cost and peak-space bounds for a finite numeric switch. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Switch/Compiled.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Switch/Compiled.lean index e0eb832b17..e3e97b35ca 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Switch/Compiled.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Switch/Compiled.lean @@ -12,7 +12,7 @@ public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Stru -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Switch/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Switch/Internal.lean index 08484a76ab..1247745035 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Switch/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Switch/Internal.lean @@ -13,7 +13,7 @@ public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Stru -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/ThreeSATSyntax.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/ThreeSATSyntax.lean index 2a661b884e..e77d558fdb 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/ThreeSATSyntax.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/ThreeSATSyntax.lean @@ -16,7 +16,7 @@ resource analysis for the existing 27-state `SAT.ThreeSAT.Syntax` automaton. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/UnaryDecode.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/UnaryDecode.lean index bdb429d2d2..0d4c8814cb 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/UnaryDecode.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/UnaryDecode.lean @@ -20,7 +20,7 @@ logarithmic cost, peak space, decoded value, and suffix cursor. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/UnaryDecode/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/UnaryDecode/Internal.lean index bfe050fdbe..00d1aafe76 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/UnaryDecode/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/UnaryDecode/Internal.lean @@ -13,7 +13,7 @@ public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Stru -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/ForBinaryWork.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/ForBinaryWork.lean index 6a3bd4e73f..ddc7c52845 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/ForBinaryWork.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/ForBinaryWork.lean @@ -26,7 +26,7 @@ for bitwise algorithms without iterating over the represented numeric value. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/ForInput.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/ForInput.lean index e3e328ec0a..0ecf0293ed 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/ForInput.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/ForInput.lean @@ -3,8 +3,12 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.ForInput.Defs -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.ForInput.Internal + +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.ForInput.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.ForInput.Internal /-! Supporting modules for Beyond the Bethe approximation of the permanent. -/ + +@[expose] public section diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/ForWorkOnes.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/ForWorkOnes.lean index 745aa25413..e448998507 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/ForWorkOnes.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/ForWorkOnes.lean @@ -3,8 +3,12 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.ForWorkOnes.Defs -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.ForWorkOnes.Internal + +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.ForWorkOnes.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.ForWorkOnes.Internal /-! Supporting modules for Beyond the Bethe approximation of the permanent. -/ + +@[expose] public section diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/Internal/Scanner.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/Internal/Scanner.lean index 47cfe501d1..f25551caf8 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/Internal/Scanner.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/Internal/Scanner.lean @@ -24,7 +24,7 @@ Proofs that `TM.scannerTM` correctly implements a left-to-right fold with -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/Internal/Union.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/Internal/Union.lean index f49c6a7159..415438dba2 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/Internal/Union.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/Internal/Union.lean @@ -35,7 +35,7 @@ The proof proceeds in three phases: -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/RetargetCompute.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/RetargetCompute.lean index 52c6601f04..8ffee5c8e3 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/RetargetCompute.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/RetargetCompute.lean @@ -31,7 +31,7 @@ positive advertised time bound. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/RetargetCompute/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/RetargetCompute/Internal.lean index 22330944ee..19d1caeb07 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/RetargetCompute/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/RetargetCompute/Internal.lean @@ -19,7 +19,7 @@ therefore halts immediately on its parked blank output tape. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/WorkBranch.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/WorkBranch.lean index dec41d2fc2..356b21cdcd 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/WorkBranch.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/WorkBranch.lean @@ -33,7 +33,7 @@ heads reading `▷` must move right. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/WorkSymbolBranch.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/WorkSymbolBranch.lean index 84184d0fb1..c196b7e2dd 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/WorkSymbolBranch.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/WorkSymbolBranch.lean @@ -18,7 +18,7 @@ branch on the readable sparse-entry equality flag. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/WorkSymbolBranch/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/WorkSymbolBranch/Internal.lean index 635b8c5fc3..de113dafd7 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/WorkSymbolBranch/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/WorkSymbolBranch/Internal.lean @@ -13,7 +13,7 @@ public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinator -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Composition.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Composition.lean index f07599a08e..583b72e417 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Composition.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Composition.lean @@ -24,7 +24,7 @@ first delimiter. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Composition/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Composition/Internal.lean index b8a9f3b114..2ce3f3d7ea 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Composition/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Composition/Internal.lean @@ -18,7 +18,7 @@ both function composition and preprocessing followed by a language decider. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Composition/Internal/FirstPhase.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Composition/Internal/FirstPhase.lean index c4c1f8c963..619c410541 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Composition/Internal/FirstPhase.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Composition/Internal/FirstPhase.lean @@ -19,7 +19,7 @@ exact tape facts required by the normalization tail. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Composition/PairWithInput.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Composition/PairWithInput.lean index 0f8594a2ad..486b7f1e69 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Composition/PairWithInput.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Composition/PairWithInput.lean @@ -21,7 +21,7 @@ retaining a concrete polynomial-preserving time bound. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Composition/PairWithInput/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Composition/PairWithInput/Internal.lean index 57234b1e41..2323ed9074 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Composition/PairWithInput/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Composition/PairWithInput/Internal.lean @@ -19,7 +19,7 @@ This module verifies the generic fanout pipeline defined in -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Frame.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Frame.lean index fcb423386c..0b88e8b401 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Frame.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Frame.lean @@ -6,8 +6,8 @@ Authors: Bolton Bailey module public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.Internal -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Hoare -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Hoare +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Internal public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Placement public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Registers diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Hoare/RetargetOutput.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Hoare/RetargetOutput.lean index ec47fa8e89..856d80dbfa 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Hoare/RetargetOutput.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Hoare/RetargetOutput.lean @@ -17,7 +17,7 @@ standard parked blank tape. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Hoare/Space.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Hoare/Space.lean index 40ef574598..a373cacf09 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Hoare/Space.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Hoare/Space.lean @@ -31,7 +31,7 @@ closure, and a fresh-start computation bridge. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Hoare/Space/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Hoare/Space/Internal.lean index 98da198efd..63001c213e 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Hoare/Space/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Hoare/Space/Internal.lean @@ -17,7 +17,7 @@ from fresh-start contracts to `TM.ComputesInSpace`. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Internal.lean index 426fdc8426..4054052a72 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Internal.lean @@ -16,7 +16,7 @@ and the NTM trace on `toNTM` compute the same thing. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Internal/OutputBounds.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Internal/OutputBounds.lean index 26a0243eba..46e2819599 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Internal/OutputBounds.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Internal/OutputBounds.lean @@ -19,7 +19,7 @@ Public statements are in `Complexitylib.Models.TuringMachine.OutputBounds`. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/OutputBounds.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/OutputBounds.lean index 641d57bddd..c641c4e99a 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/OutputBounds.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/OutputBounds.lean @@ -22,7 +22,7 @@ produce at most `t` output bits. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Placement.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Placement.lean index bd6819bcf3..eba13476db 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Placement.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Placement.lean @@ -25,7 +25,7 @@ are parked away from the left-end marker. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Placement/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Placement/Internal.lean index 71f7be782f..566acdf0f9 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Placement/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Placement/Internal.lean @@ -17,7 +17,7 @@ parked frame are fixed points of that action. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Registers/InputLen.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Registers/InputLen.lean index f37f7c51e3..ec1c25a3ac 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Registers/InputLen.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Registers/InputLen.lean @@ -19,7 +19,7 @@ campaign (`docs/A5-ReductionEmitter.md`). -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/SpaceTime.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/SpaceTime.lean index 79c99171ad..4245eed95d 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/SpaceTime.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/SpaceTime.lean @@ -3,7 +3,11 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.SpaceTime.Internal + +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.SpaceTime.Internal /-! Supporting modules for Beyond the Bethe approximation of the permanent. -/ + +@[expose] public section diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/SpaceTime/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/SpaceTime/Internal.lean index 8e407f3057..b447c0be66 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/SpaceTime/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/SpaceTime/Internal.lean @@ -3,7 +3,11 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.SpaceTime.Internal.Reachability + +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.SpaceTime.Internal.Reachability /-! Supporting modules for Beyond the Bethe approximation of the permanent. -/ + +@[expose] public section diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/SpaceTime/Internal/Reachability.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/SpaceTime/Internal/Reachability.lean index b3e9465898..25f3247684 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/SpaceTime/Internal/Reachability.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/SpaceTime/Internal/Reachability.lean @@ -16,7 +16,7 @@ execution choices to the machine model. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryAddConst.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryAddConst.lean index a9cd6421ba..cc5dbb7740 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryAddConst.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryAddConst.lean @@ -23,7 +23,7 @@ sequence of binary successors compiled from a hardwired natural constant. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryCopy.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryCopy.lean index 0ebcb18fdf..a85d971d93 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryCopy.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryCopy.lean @@ -24,7 +24,7 @@ destination becomes an exact copy, and the zero scratch is restored literally. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryEq.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryEq.lean index 5fb9288c51..da05687dd9 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryEq.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryEq.lean @@ -16,7 +16,7 @@ binary equality routine used by RAM register-store scans. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryEq/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryEq/Internal.lean index 50c1a57d1f..2bf8298e34 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryEq/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryEq/Internal.lean @@ -15,7 +15,7 @@ public import Std.Tactic.BVDecide.Normalize.BitVec -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryFor.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryFor.lean index f554f490ee..f83e8907ab 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryFor.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryFor.lean @@ -3,8 +3,12 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryFor.Defs -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryFor.Internal + +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryFor.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryFor.Internal /-! Supporting modules for Beyond the Bethe approximation of the permanent. -/ + +@[expose] public section diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryFor/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryFor/Internal.lean index e19ba74245..24aeb0d2b0 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryFor/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryFor/Internal.lean @@ -3,9 +3,13 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryFor.Internal.Comparison -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryFor.Internal.Control -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryFor.Internal.Loop + +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryFor.Internal.Comparison +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryFor.Internal.Control +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryFor.Internal.Loop /-! Supporting modules for Beyond the Bethe approximation of the permanent. -/ + +@[expose] public section diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryFor/Internal/Comparison.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryFor/Internal/Comparison.lean index 88de598c43..d3c01a5b00 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryFor/Internal/Comparison.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryFor/Internal/Comparison.lean @@ -22,7 +22,7 @@ iteration precisely below the limit, or to `done` precisely at equality. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryFor/Internal/Loop.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryFor/Internal/Loop.lean index b6869cac9c..6622992fd5 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryFor/Internal/Loop.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryFor/Internal/Loop.lean @@ -18,7 +18,7 @@ body. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryPred.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryPred.lean index 42ae20a3de..7b08cb9bb0 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryPred.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryPred.lean @@ -30,7 +30,7 @@ represent `value + 1`; they make no underflow claim. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryPred/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryPred/Internal.lean index 7811da25b3..2e473f8893 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryPred/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryPred/Internal.lean @@ -22,7 +22,7 @@ high-bit erasure needed when decrementing a power of two. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleAdd.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleAdd.lean index c458a3525e..f965a90414 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleAdd.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleAdd.lean @@ -22,7 +22,7 @@ machine instead. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleAdd/Internal/Bounds.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleAdd/Internal/Bounds.lean index 15a7850a7f..9e9a6b9d36 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleAdd/Internal/Bounds.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleAdd/Internal/Bounds.lean @@ -16,7 +16,7 @@ standard binary widths of the two operands. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleAdd/Internal/Out.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleAdd/Internal/Out.lean index 22191c7710..f5131e45c5 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleAdd/Internal/Out.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleAdd/Internal/Out.lean @@ -17,7 +17,7 @@ computation. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleAdd/Internal/Pure.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleAdd/Internal/Pure.lean index e5a745f241..a62059c340 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleAdd/Internal/Pure.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleAdd/Internal/Pure.lean @@ -18,7 +18,7 @@ incoming carry so that its induction follows the recurrence exactly. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleAdd/Internal/Scan.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleAdd/Internal/Scan.lean index 9842d66945..58652de409 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleAdd/Internal/Scan.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleAdd/Internal/Scan.lean @@ -18,7 +18,7 @@ later internal layers. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleSub.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleSub.lean index aa604ac911..c59bb7ecb2 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleSub.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleSub.lean @@ -20,7 +20,7 @@ the operand bit widths. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleSub/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleSub/Internal.lean index 6bed9279d5..d5d1b7eaca 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleSub/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleSub/Internal.lean @@ -3,12 +3,16 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleSub.Internal.Backward -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleSub.Internal.Out -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleSub.Internal.Pure -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleSub.Internal.Rewind -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleSub.Internal.Scan -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleSub.Internal.Sem + +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleSub.Internal.Backward +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleSub.Internal.Out +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleSub.Internal.Pure +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleSub.Internal.Rewind +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleSub.Internal.Scan +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleSub.Internal.Sem /-! Supporting modules for Beyond the Bethe approximation of the permanent. -/ + +@[expose] public section diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleSub/Internal/Backward.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleSub/Internal/Backward.lean index 935f9565f0..39e62c7f26 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleSub/Internal/Backward.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleSub/Internal/Backward.lean @@ -21,7 +21,7 @@ literally throughout the run. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleSub/Internal/Out.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleSub/Internal/Out.lean index 93035e97c3..dbc8506403 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleSub/Internal/Out.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleSub/Internal/Out.lean @@ -16,7 +16,7 @@ tape one-way, so the core and complete machines are safe transducers. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleSub/Internal/Pure.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleSub/Internal/Pure.lean index d69f1a0939..173b814c0c 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleSub/Internal/Pure.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleSub/Internal/Pure.lean @@ -19,7 +19,7 @@ canonical `Nat.bits` representation of the raw fixed-width value. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleSub/Internal/Scan.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleSub/Internal/Scan.lean index edde9dd2ee..bf06366c6a 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleSub/Internal/Scan.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleSub/Internal/Scan.lean @@ -21,7 +21,7 @@ separate internal layer. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryShiftMul.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryShiftMul.lean index ec917c3552..da3cd1be56 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryShiftMul.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryShiftMul.lean @@ -21,7 +21,7 @@ in the combined operand width. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryShiftMul/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryShiftMul/Internal.lean index e23f6d7708..b9885a675e 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryShiftMul/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryShiftMul/Internal.lean @@ -3,9 +3,13 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryShiftMul.Internal.Out -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryShiftMul.Internal.Pure -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryShiftMul.Internal.Sem + +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryShiftMul.Internal.Out +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryShiftMul.Internal.Pure +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryShiftMul.Internal.Sem /-! Supporting modules for Beyond the Bethe approximation of the permanent. -/ + +@[expose] public section diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryShiftMul/Internal/Out.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryShiftMul/Internal/Out.lean index 9b5cc0aff9..7432a8b30f 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryShiftMul/Internal/Out.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryShiftMul/Internal/Out.lean @@ -18,7 +18,7 @@ This file composes the transducer certificates of every multiplication phase. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryShiftMul/Internal/Pure.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryShiftMul/Internal/Pure.lean index 6c6195187d..d95ae9de2a 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryShiftMul/Internal/Pure.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryShiftMul/Internal/Pure.lean @@ -18,7 +18,7 @@ every partial accumulator and shifted multiplicand. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinarySucc.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinarySucc.lean index e19587e4ca..bf8f2297c0 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinarySucc.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinarySucc.lean @@ -27,7 +27,7 @@ tape to cell one. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinarySucc/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinarySucc/Internal.lean index e26df289ea..dc4845c8d4 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinarySucc/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinarySucc/Internal.lean @@ -18,7 +18,7 @@ content predicate, generalized over the already-zeroed low-order prefix. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/ClearWork.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/ClearWork.lean index 83cffb5f2a..317828107a 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/ClearWork.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/ClearWork.lean @@ -23,7 +23,7 @@ discipline of the clearing, rewinding, and composite machines. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/ClearWork/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/ClearWork/Internal.lean index ec0df5f1a7..a8f80eae69 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/ClearWork/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/ClearWork/Internal.lean @@ -19,7 +19,7 @@ left. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/CopyOutput.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/CopyOutput.lean index 8a4c563eac..32077bea0f 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/CopyOutput.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/CopyOutput.lean @@ -22,7 +22,7 @@ its Boolean input verbatim to its output tape in the exact linear bound -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/CopyToVirtualInput.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/CopyToVirtualInput.lean index 867cb228d3..24842c43c0 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/CopyToVirtualInput.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/CopyToVirtualInput.lean @@ -5,7 +5,7 @@ Authors: Bolton Bailey -/ module -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.CopyWorkOutput +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.CopyWorkOutput public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.ResetTapes /-! @@ -23,7 +23,7 @@ rewind closes the gap. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/CopyWorkOutput.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/CopyWorkOutput.lean index 6dd612b538..006b09158d 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/CopyWorkOutput.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/CopyWorkOutput.lean @@ -22,7 +22,7 @@ junk. The fresh destination receives a canonical `Tape.HasBinaryPrefix`. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/Internal.lean index b85e43a3b2..9049d58a7f 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/Internal.lean @@ -39,7 +39,7 @@ an arbitrary predicate `P` on the untouched tapes through the run. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/Internal/CopyOutput.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/Internal/CopyOutput.lean index 92d2b1a885..20ae56cb92 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/Internal/CopyOutput.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/Internal/CopyOutput.lean @@ -22,7 +22,7 @@ The public theorem is stated in -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/Internal/CopyWorkOutput.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/Internal/CopyWorkOutput.lean index fd63b810cc..eac5dc9898 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/Internal/CopyWorkOutput.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/Internal/CopyWorkOutput.lean @@ -23,7 +23,7 @@ Public statements are in -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/MoveLeftStep.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/MoveLeftStep.lean index f07b202734..ad344e8de5 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/MoveLeftStep.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/MoveLeftStep.lean @@ -23,7 +23,7 @@ whole list of tapes, exactly as `TM.wipeStepTM` is a content-agnostic bulk wipe. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/PairEmit.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/PairEmit.lean index 83f6c0eeb1..1ca53b49b9 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/PairEmit.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/PairEmit.lean @@ -22,7 +22,7 @@ second component. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/PairEmit/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/PairEmit/Internal.lean index e479eb46f0..ad25ab8feb 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/PairEmit/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/PairEmit/Internal.lean @@ -18,7 +18,7 @@ This module verifies the exact two-pass controller in `PairEmit.Defs`. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/PairValidate.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/PairValidate.lean index fcb655cb37..a0cd9f7b03 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/PairValidate.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/PairValidate.lean @@ -23,7 +23,7 @@ the two decoded components. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/PairValidate/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/PairValidate/Internal.lean index e73b2c4d6d..e15d7d99dd 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/PairValidate/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/PairValidate/Internal.lean @@ -18,7 +18,7 @@ correctness theorem supplies the executable machine proof and exact time bound. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/ParkAll.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/ParkAll.lean index 50f94a8965..f3ee71b91a 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/ParkAll.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/ParkAll.lean @@ -23,7 +23,7 @@ stay put. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/ResetBinary.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/ResetBinary.lean index 514c4bec00..7bf1c5f848 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/ResetBinary.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/ResetBinary.lean @@ -17,7 +17,7 @@ arbitrary canonical binary cursor and clearing it to the standard blank tape. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/ResetBinary/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/ResetBinary/Internal.lean index 6c520e8659..9b9a06d479 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/ResetBinary/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/ResetBinary/Internal.lean @@ -14,7 +14,7 @@ public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutine -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/ResetBinaryMany.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/ResetBinaryMany.lean index 5431fb144a..dc7f423752 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/ResetBinaryMany.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/ResetBinaryMany.lean @@ -16,7 +16,7 @@ of distinct canonical binary work tapes. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/ResetBinaryMany/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/ResetBinaryMany/Internal.lean index 0426ba9bf9..330a94968d 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/ResetBinaryMany/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/ResetBinaryMany/Internal.lean @@ -13,7 +13,7 @@ public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutine -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/ResetTapes.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/ResetTapes.lean index 557bb7c591..906bcee6c1 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/ResetTapes.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/ResetTapes.lean @@ -24,7 +24,7 @@ wipe and is left exactly as it started. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/RewindList.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/RewindList.lean index 5959360bb6..98828d9c6d 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/RewindList.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/RewindList.lean @@ -25,7 +25,7 @@ via `TM.bigSeqTM` works once every tape has been parked once -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/UnaryLength.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/UnaryLength.lean index 4fc8b3d069..fd467a3f94 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/UnaryLength.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/UnaryLength.lean @@ -21,7 +21,7 @@ emits `List.replicate x.length true` within the linear bound `|x| + 2`. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/UnaryLength/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/UnaryLength/Internal.lean index 6d65025b77..9875c13eba 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/UnaryLength/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/UnaryLength/Internal.lean @@ -19,7 +19,7 @@ exactly `|x| + 2` transitions. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/WipeStep.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/WipeStep.lean index dc47894022..77621e97f0 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/WipeStep.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/WipeStep.lean @@ -25,7 +25,7 @@ number of cells whatever was there. -/ -public section +@[expose] public section namespace Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Tape.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Tape.lean index 131be9cd6b..b1f521ed3f 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Tape.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Tape.lean @@ -3,7 +3,11 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Tape.Encoding + +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Tape.Encoding /-! Supporting modules for Beyond the Bethe approximation of the permanent. -/ + +@[expose] public section diff --git a/LeanPool/BeyondBethe/Complexitylib/SAT.lean b/LeanPool/BeyondBethe/Complexitylib/SAT.lean index 220779705e..35f8646d48 100644 --- a/LeanPool/BeyondBethe/Complexitylib/SAT.lean +++ b/LeanPool/BeyondBethe/Complexitylib/SAT.lean @@ -3,13 +3,17 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.Complexitylib.SAT.Encoding -import LeanPool.BeyondBethe.Complexitylib.SAT.Language -import LeanPool.BeyondBethe.Complexitylib.SAT.Rename -import LeanPool.BeyondBethe.Complexitylib.SAT.Semantics -import LeanPool.BeyondBethe.Complexitylib.SAT.ThreeCNF -import LeanPool.BeyondBethe.Complexitylib.SAT.ThreeSAT -import LeanPool.BeyondBethe.Complexitylib.SAT.Verifier + +public import LeanPool.BeyondBethe.Complexitylib.SAT.Encoding +public import LeanPool.BeyondBethe.Complexitylib.SAT.Language +public import LeanPool.BeyondBethe.Complexitylib.SAT.Rename +public import LeanPool.BeyondBethe.Complexitylib.SAT.Semantics +public import LeanPool.BeyondBethe.Complexitylib.SAT.ThreeCNF +public import LeanPool.BeyondBethe.Complexitylib.SAT.ThreeSAT +public import LeanPool.BeyondBethe.Complexitylib.SAT.Verifier /-! Supporting modules for Beyond the Bethe approximation of the permanent. -/ + +@[expose] public section diff --git a/LeanPool/BeyondBethe/Solution.lean b/LeanPool/BeyondBethe/Solution.lean index 6afe187650..f73bea471a 100644 --- a/LeanPool/BeyondBethe/Solution.lean +++ b/LeanPool/BeyondBethe/Solution.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Nima Anari. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Nima Anari -/ +module -import LeanPool.BeyondBethe.BeyondBethe.Main -import LeanPool.BeyondBethe.BeyondBethe.PalomarComplexity -import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham + +public import LeanPool.BeyondBethe.BeyondBethe.Main +public import LeanPool.BeyondBethe.BeyondBethe.PalomarComplexity +public import LeanPool.BeyondBethe.Complexitylib.Classes.P.Cobham /-! # Proved solution for the Palomar statement @@ -18,6 +20,8 @@ fully internal theorem `BeyondBethe.theoremOne`, then applies Complexitylib's formal proof of Cobham's characterization of polynomial time. -/ +@[expose] public section + namespace Palomar theorem beyond_bethe_permanent : From 7658458bd99cdee9979a053de7cf1655a1de22e1 Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Fri, 25 Sep 2026 19:59:30 +0000 Subject: [PATCH 21/49] Exclude unused native-code smoke tests from Beyond Bethe import --- LeanPool.lean | 2 - LeanPool/BeyondBethe.lean | 2 - .../BeyondBethe/MachineArithmeticTests.lean | 291 ------------------ .../BeyondBethe/MachineOptimizerTests.lean | 109 ------- 4 files changed, 404 deletions(-) delete mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineArithmeticTests.lean delete mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerTests.lean diff --git a/LeanPool.lean b/LeanPool.lean index 6a562df50c..b748951961 100644 --- a/LeanPool.lean +++ b/LeanPool.lean @@ -288,7 +288,6 @@ public import LeanPool.BeyondBethe.BeyondBethe.GoodRowScore public import LeanPool.BeyondBethe.BeyondBethe.GreedyRowMatching public import LeanPool.BeyondBethe.BeyondBethe.KuhnMatching public import LeanPool.BeyondBethe.BeyondBethe.KuhnSmallStep -public import LeanPool.BeyondBethe.BeyondBethe.MachineArithmeticTests public import LeanPool.BeyondBethe.BeyondBethe.MachineBetheAffineEntry public import LeanPool.BeyondBethe.BeyondBethe.MachineBetheAffineLineSum public import LeanPool.BeyondBethe.BeyondBethe.MachineBetheEpigraphOracle @@ -381,7 +380,6 @@ public import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerInteriorScale public import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerMatrixBitBound public import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerRoundingSchedule public import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerStateBound -public import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerTests public import LeanPool.BeyondBethe.BeyondBethe.MachineOutputEncoding public import LeanPool.BeyondBethe.BeyondBethe.MachinePerfectMatching public import LeanPool.BeyondBethe.BeyondBethe.MachinePositiveAlgorithm diff --git a/LeanPool/BeyondBethe.lean b/LeanPool/BeyondBethe.lean index 68895f6550..f76388f69a 100644 --- a/LeanPool/BeyondBethe.lean +++ b/LeanPool/BeyondBethe.lean @@ -66,7 +66,6 @@ import LeanPool.BeyondBethe.BeyondBethe.GoodRowScore import LeanPool.BeyondBethe.BeyondBethe.GreedyRowMatching import LeanPool.BeyondBethe.BeyondBethe.KuhnMatching import LeanPool.BeyondBethe.BeyondBethe.KuhnSmallStep -import LeanPool.BeyondBethe.BeyondBethe.MachineArithmeticTests import LeanPool.BeyondBethe.BeyondBethe.MachineBetheAffineEntry import LeanPool.BeyondBethe.BeyondBethe.MachineBetheAffineLineSum import LeanPool.BeyondBethe.BeyondBethe.MachineBetheEpigraphOracle @@ -159,7 +158,6 @@ import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerInteriorScale import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerMatrixBitBound import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerRoundingSchedule import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerStateBound -import LeanPool.BeyondBethe.BeyondBethe.MachineOptimizerTests import LeanPool.BeyondBethe.BeyondBethe.MachineOutputEncoding import LeanPool.BeyondBethe.BeyondBethe.MachinePerfectMatching import LeanPool.BeyondBethe.BeyondBethe.MachinePositiveAlgorithm diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineArithmeticTests.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineArithmeticTests.lean deleted file mode 100644 index d2885abb52..0000000000 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineArithmeticTests.lean +++ /dev/null @@ -1,291 +0,0 @@ -/- -Copyright (c) 2026 Nima Anari. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Nima Anari --/ - -import LeanPool.BeyondBethe.BeyondBethe.RawRational -import LeanPool.BeyondBethe.BeyondBethe.MachineBinaryMul -import LeanPool.BeyondBethe.BeyondBethe.MachineBinaryCompare -import LeanPool.BeyondBethe.BeyondBethe.MachineBinaryDivision -import LeanPool.BeyondBethe.BeyondBethe.MachineBinaryGCD -import LeanPool.BeyondBethe.BeyondBethe.MachineIntegerArithmetic -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalNormalization -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalArithmetic -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalUnary -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalCompare -import LeanPool.BeyondBethe.BeyondBethe.MachineDyadicFloor -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalFloor -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalLogSeries -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalExp -import LeanPool.BeyondBethe.BeyondBethe.MachineDirectedLog -import LeanPool.BeyondBethe.BeyondBethe.MachineMatrixNonnegative -import LeanPool.BeyondBethe.BeyondBethe.MachineMatrixSum -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalMin -import LeanPool.BeyondBethe.BeyondBethe.MachineFactorial -import LeanPool.BeyondBethe.BeyondBethe.MachineRationalRowAdd -import LeanPool.BeyondBethe.BeyondBethe.MachineNearbyCoordinate - -/-! # Machine Arithmetic Tests -/ - -namespace BeyondBethe - -/-! Exhaustive executable smoke tests for the machine-arithmetic core. -/ - -theorem binaryLongDiv_exhaustive_256_by_64 : - ∀ a : Fin 256, ∀ b : Fin 64, - binaryLongDiv a.val b.val = (a.val / b.val, a.val % b.val) := by - native_decide - -theorem binaryEuclidBounded_exhaustive_128_by_128 : - ∀ a : Fin 128, ∀ b : Fin 128, - binaryEuclidBounded a.val b.val = Nat.gcd a.val b.val := by - native_decide - -theorem machineBinaryMul_exhaustive_64_by_64 : - ∀ a : Fin 64, ∀ b : Fin 64, - machineBinaryMulBits (Complexity.pair a.val.bits b.val.bits) = - (a.val * b.val).bits := by - native_decide - -theorem machineBinarySub_exhaustive_64_by_64 : - ∀ a : Fin 64, ∀ b : Fin 64, - machineBinarySubBits (Complexity.pair a.val.bits b.val.bits) = - (a.val - b.val).bits := by - native_decide - -theorem machineBinaryCompare_exhaustive_64_by_64 : - ∀ a : Fin 64, ∀ b : Fin 64, - machineBinaryNatLeBit (Complexity.pair a.val.bits b.val.bits) = - [decide (a.val ≤ b.val)] ∧ - machineBinaryNatLtBit (Complexity.pair a.val.bits b.val.bits) = - [decide (a.val < b.val)] ∧ - machineBinaryNatEqBit (Complexity.pair a.val.bits b.val.bits) = - [decide (a.val = b.val)] := by - native_decide - -theorem machineBinaryDivision_exhaustive_64_by_32 : - ∀ a : Fin 64, ∀ b : Fin 32, - machineBinaryDivModBits (Complexity.pair a.val.bits b.val.bits) = - Complexity.pair (a.val / b.val).bits (a.val % b.val).bits := by - native_decide - -theorem machineBinaryGcd_exhaustive_32_by_32 : - ∀ a : Fin 32, ∀ b : Fin 32, - machineBinaryGcdBits (Complexity.pair a.val.bits b.val.bits) = - (Nat.gcd a.val b.val).bits := by - native_decide - -def signedIntegerTest (negative : Bool) (n : ℕ) : ℤ := - if negative then Int.negSucc n else Int.ofNat n - -theorem machineIntegerArithmetic_exhaustive_signed_16 : - ∀ leftNegative rightNegative : Bool, ∀ a b : Fin 16, - machineIntegerAddCode - (Complexity.pair - (integerBinaryCode (signedIntegerTest leftNegative a.val)) - (integerBinaryCode (signedIntegerTest rightNegative b.val))) = - integerBinaryCode - (signedIntegerTest leftNegative a.val + - signedIntegerTest rightNegative b.val) ∧ - machineIntegerMulCode - (Complexity.pair - (integerBinaryCode (signedIntegerTest leftNegative a.val)) - (integerBinaryCode (signedIntegerTest rightNegative b.val))) = - integerBinaryCode - (signedIntegerTest leftNegative a.val * - signedIntegerTest rightNegative b.val) ∧ - machineIntegerNegCode - (integerBinaryCode (signedIntegerTest leftNegative a.val)) = - integerBinaryCode (-signedIntegerTest leftNegative a.val) := by - native_decide - -def positiveRawRatTest (n d : ℕ) : RawRat := - ⟨Int.ofNat n, d + 1, by omega⟩ - -def negativeRawRatTest (n d : ℕ) : RawRat := - ⟨Int.negSucc n, d + 1, by omega⟩ - -def signedRawRatTest (negative : Bool) (n d : ℕ) : RawRat := - if negative then negativeRawRatTest n d else positiveRawRatTest n d - -theorem machineRationalNormalization_exhaustive_signed_8_by_8 : - ∀ n : Fin 8, ∀ d : Fin 8, - machineNormalizeRawRatBinaryCode - (rawRatBinaryCode (positiveRawRatTest n.val d.val)) = - rationalBinaryCode - (binaryNormalizeRawRat (positiveRawRatTest n.val d.val)) ∧ - machineNormalizeRawRatBinaryCode - (rawRatBinaryCode (negativeRawRatTest n.val d.val)) = - rationalBinaryCode - (binaryNormalizeRawRat (negativeRawRatTest n.val d.val)) := by - native_decide - -theorem machineRationalArithmetic_exhaustive_signed_3 : - ∀ leftNegative rightNegative : Bool, - ∀ leftNum leftDen rightNum rightDen : Fin 3, - let q := signedRawRatTest leftNegative leftNum.val leftDen.val - let r := signedRawRatTest rightNegative rightNum.val rightDen.val - machineRationalAddCode - (Complexity.pair (rawRatBinaryCode q) (rawRatBinaryCode r)) = - rationalBinaryCode (binaryNormalizeRawRat (q.add r)) ∧ - machineRationalMulCode - (Complexity.pair (rawRatBinaryCode q) (rawRatBinaryCode r)) = - rationalBinaryCode (binaryNormalizeRawRat (q.mul r)) := by - native_decide - -theorem machineRationalComparison_exhaustive_signed_4 : - ∀ leftNegative rightNegative : Bool, - ∀ leftNum leftDen rightNum rightDen : Fin 4, - let q := signedRawRatTest leftNegative leftNum.val leftDen.val - let r := signedRawRatTest rightNegative rightNum.val rightDen.val - machineRawRatLeBit - (Complexity.pair (rawRatBinaryCode q) (rawRatBinaryCode r)) = - [decide (q.value ≤ r.value)] := by - native_decide - -theorem machineRationalUnary_exhaustive_signed_3 : - ∀ leftNegative rightNegative : Bool, - ∀ leftNum leftDen rightNum rightDen : Fin 3, - let q := signedRawRatTest leftNegative leftNum.val leftDen.val - let r := signedRawRatTest rightNegative rightNum.val rightDen.val - machineRationalNegCode (rawRatBinaryCode q) = - rationalBinaryCode (binaryNormalizeRawRat q.neg) ∧ - machineRationalInvCode (rawRatBinaryCode q) = - rationalBinaryCode (binaryNormalizeRawRat q.inv) ∧ - machineRationalDivCode - (Complexity.pair (rawRatBinaryCode q) (rawRatBinaryCode r)) = - rationalBinaryCode (binaryNormalizeRawRat (q.div r)) := by - native_decide - -theorem machineDyadicFloor_exhaustive_signed_4 : - ∀ negative : Bool, ∀ p n d : Fin 4, - let q := signedRawRatTest negative n.val d.val - machineDyadicFloorCode - (Complexity.pair (List.replicate p.val true) - (rawRatBinaryCode q)) = - rationalBinaryCode (binaryDyadicFloor p.val q.value) := by - native_decide - -theorem machineRationalFloorCeil_exhaustive_signed_8 : - ∀ negative : Bool, ∀ n : Fin 8, ∀ d : Fin 8, - let q := signedRawRatTest negative n.val d.val - machineRationalFloorIntegerCode (rawRatBinaryCode q) = - integerBinaryCode (binaryRatFloor q.value) ∧ - machineRationalCeilIntegerCode (rawRatBinaryCode q) = - integerBinaryCode (binaryRatCeil q.value) ∧ - machineRationalCeilNatBits (rawRatBinaryCode q) = - (Int.toNat (binaryRatCeil q.value)).bits := by - native_decide - -theorem machineRationalLogSeriesSum_exhaustive_signed_3 : - ∀ negative : Bool, ∀ n : Fin 3, ∀ d : Fin 3, ∀ N : Fin 3, - let q := signedRawRatTest negative n.val d.val - machineRationalLogSeriesSumCode - (Complexity.pair (List.replicate N.val true) - (rawRatBinaryCode q)) = - rationalBinaryCode (binaryRationalLogSeriesSum q.value N.val) := by - native_decide - -theorem machineBoundedUnary_exhaustive_8 : - ∀ guard n : Fin 8, - machineBoundedUnary - (Complexity.pair (List.replicate guard.val true) n.val.bits) = - List.replicate (min guard.val n.val) true := by - native_decide - -theorem machineBoundedRationalExpLower_small_signed : - ∀ negative : Bool, ∀ n d : Fin 2, - let s := signedRawRatTest negative n.val d.val - let M := RawRat.expApproxSteps s RawRat.one - machineBoundedRationalExpLowerCode - (Complexity.pair (List.replicate M true) - (Complexity.pair (rawRatBinaryCode s) - (rawRatBinaryCode RawRat.one))) = - rationalBinaryCode - (binaryRationalExpLower s.value RawRat.one.value) := by - native_decide - -theorem machineLengthBits_exhaustive_16 : - ∀ n : Fin 16, - machineLengthBits (List.replicate n.val true) = n.val.bits := by - native_decide - -def positiveNonzeroRawRatTest (n d : ℕ) : RawRat := - ⟨Int.ofNat (n + 1), d + 1, by omega⟩ - -theorem machineDirectedLog_small_positive : - ∀ n d N : Fin 2, - let q := (positiveNonzeroRawRatTest n.val d.val).value - machineDirectedLogLowerCode - (Complexity.pair (List.replicate N.val true) - (rawRatBinaryCode (rawRatOfRat q))) = - rationalBinaryCode (binaryDirectedLogLower q N.val) ∧ - machineDirectedLogUpperCode - (Complexity.pair (List.replicate N.val true) - (rawRatBinaryCode (rawRatOfRat q))) = - rationalBinaryCode (binaryDirectedLogUpper q N.val) := by - intro n d N - dsimp only - exact ⟨machineDirectedLogLowerCode_encode _ _, - machineDirectedLogUpperCode_encode _ _⟩ - -theorem machineMatrixNonnegative_two_by_two : - ∀ negative : Bool, - let A : Matrix (Fin 2) (Fin 2) ℚ := fun i j ↦ - if negative && decide (i = 0) && decide (j = 0) then -1 else 1 - machineMatrixNonnegativeBit - (rationalMatrixBinaryEncoding.encode ⟨2, A⟩) = - [!negative] := by - native_decide - -theorem machineMatrixSum_two_by_two_constant : - ∀ q : Fin 3, - let A : Matrix (Fin 2) (Fin 2) ℚ := fun _ _ ↦ q.val - machineMatrixSumOutputCode - (rationalMatrixBinaryEncoding.encode ⟨2, A⟩) = - rationalBinaryCode (4 * q.val) := by - native_decide - -theorem machineRationalMin_exhaustive_positive_3 : - ∀ leftNum leftDen rightNum rightDen : Fin 3, - let q := positiveRawRatTest leftNum.val leftDen.val - let r := positiveRawRatTest rightNum.val rightDen.val - machineRationalMinCode - (Complexity.pair (rawRatBinaryCode q) (rawRatBinaryCode r)) = - rationalBinaryCode (min q.value r.value) := by - native_decide - -theorem machineFactorial_exhaustive_8 : - ∀ n : Fin 8, - machineFactorialRawRatCode (List.replicate n.val true) = - rawRatBinaryCode (RawRat.ofNat n.val.factorial) := by - native_decide - -theorem machineRationalRowAdd_exhaustive_2 : - ∀ deltaNum deltaDen left right : Fin 2, - let delta := positiveRawRatTest deltaNum.val deltaDen.val - let row : List ℚ := [left.val, right.val] - machineRationalRowAdd - (machineRationalRowAddCanonicalInput delta row) = - binaryListCode rationalEntryBinaryCode - (rationalRowAddValues delta row) := by - native_decide - -theorem machineScheduledLogTermsRuler_three_halves : - machineScheduledLogTermsRuler - (Complexity.pair (List.replicate 3 true) - (rawRatBinaryCode (rawRatOfRat (3 / 2 : ℚ)))) = - List.replicate (directedLogTerms (3 / 2 : ℚ) 3) true := by - native_decide - -theorem machineNearbyCoordinate_one_third : - let tau := rawRatOfRat (1 / 4 : ℚ) - machineNearbyCoordinateLowerRawCode - (Complexity.pair (List.replicate 3 true) - (Complexity.pair (rawRatBinaryCode tau) - (rationalEntryBinaryCode (1 / 3 : ℚ)))) = - rawRatBinaryCode (rawNearbyCoordinateLower tau (1 / 3 : ℚ) 3) := by - exact machineNearbyCoordinateLowerRawCode_encode _ _ _ - -end BeyondBethe diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerTests.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerTests.lean deleted file mode 100644 index a403e8677e..0000000000 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerTests.lean +++ /dev/null @@ -1,109 +0,0 @@ -/- -Copyright (c) 2026 Nima Anari. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Nima Anari --/ - -import LeanPool.BeyondBethe.BeyondBethe.MachineBetheFloorScan -import LeanPool.BeyondBethe.BeyondBethe.MachineExecutableScannedOptimizerOutput -import LeanPool.BeyondBethe.BeyondBethe.MachineMatchingGain - -/-! -# Exhaustive small tests for the optimizer and certificate boundary - -These tests are deliberately separate from the production dependency graph. -They execute the finite-word programs on small finite families; correctness of -the public theorem itself continues to use the symbolic proofs. --/ - -namespace BeyondBethe - -open Complexity - -def optimizerTestAffinePoint {N : ℕ} (a : Fin N) : Fin 1 → ℚ := - fun _ ↦ a.val / 4 - -def optimizerTestFloor {N : ℕ} (d : Fin N) : RawRat := - rawRatOfRat (d.val / 4 : ℚ) - -theorem machineBetheFloorViolation_exhaustive_two_by_two_quarters : - ∀ a d : Fin 2, ∀ i j : Fin 2, - machineBetheFloorViolationBit - (machineBetheFloorTestCanonicalWord - (optimizerTestFloor d) i j (optimizerTestAffinePoint a)) = - [decide (betheAffineMatrixQ (optimizerTestAffinePoint a) i j < - (optimizerTestFloor d).value)] := by - native_decide - -theorem machineBetheFloorScan_exhaustive_two_by_two_quarters : - ∀ a d : Fin 3, - machineBetheFloorScanResultCode - (machineBetheFloorScanCanonicalWord (m := 1) - (optimizerTestFloor d) (optimizerTestAffinePoint a)) = - betheFloorScanSemanticResultCode - (finalBetheFloorScanSemanticState (m := 1) - (optimizerTestFloor d) (optimizerTestAffinePoint a)) := by - native_decide - -theorem machineExecutableMatrixEntry_exhaustive_two_by_two_quarters : - ∀ a : Fin 3, ∀ i j : Fin 2, - let y : Fin 1 → ℚ := fun _ ↦ a.val / 4 - machineExecutableMatrixEntryCode - (pair (List.replicate i.1 true) - (pair (List.replicate j.1 true) - (pair [true] (rationalFiniteVectorCode y)))) = - rationalEntryBinaryCode (betheAffineMatrixQ y i j) := by - native_decide - -theorem machineExecutablePotentialEntries_two_by_two_half : - let A : Matrix (Fin 2) (Fin 2) ℚ := fun _ _ ↦ 1 - let y : Fin 1 → ℚ := fun _ ↦ 1 / 2 - ∀ dummy i : Fin 2, - machineExecutableRowPotentialEntryCode - (pair (List.replicate dummy.1 true) - (pair (List.replicate i.1 true) - (machineDirectedObjectiveSumCanonicalWord (1 / 8) A y 1))) = - rationalEntryBinaryCode - (-directedNegativeGradientLowerMatrix (1 / 8) A - (betheAffineMatrixQ y) 1 i 0 + (2 + 1 / 8)) ∧ - machineExecutableColumnPotentialEntryCode - (pair (List.replicate dummy.1 true) - (pair (List.replicate i.1 true) - (machineDirectedObjectiveSumCanonicalWord (1 / 8) A y 1))) = - rationalEntryBinaryCode - (-(directedNegativeGradientLowerMatrix (1 / 8) A - (betheAffineMatrixQ y) 1 0 i - - directedNegativeGradientLowerMatrix (1 / 8) A - (betheAffineMatrixQ y) 1 0 0)) := by - dsimp only - intro dummy i - exact ⟨ - machineExecutableRowPotentialEntryCode_encode - (1 / 8) (fun _ _ ↦ 1) (fun _ ↦ 1 / 2) 1 dummy i, - machineExecutableColumnPotentialEntryCode_encode - (1 / 8) (fun _ _ ↦ 1) (fun _ ↦ 1 / 2) 1 dummy i⟩ - -def optimizerTestEntry (bit : Bool) : ℚ := - if bit then 3 / 4 else 1 / 4 - -theorem machineMatchingGain_exhaustive_two_by_two_binary_entries : - ∀ a b c d : Bool, - let X : Matrix (Fin 2) (Fin 2) ℚ := fun i j ↦ - if i = 0 then - if j = 0 then optimizerTestEntry a else optimizerTestEntry b - else if j = 0 then optimizerTestEntry c else optimizerTestEntry d - let R : Fin 2 → ℚ := fun _ ↦ 0 - let C : Fin 2 → ℚ := fun _ ↦ 0 - machineExplicitMatchingGainRawCode - (pair [] (rationalOptimizerOutputCode ⟨X, R, C⟩)) = - rawRatBinaryCode (rawRatOfRat (explicitCertifiedMatchingGain X)) := by - intro a b c d - dsimp only - exact machineExplicitMatchingGainRawCode_encode [] - (fun i j ↦ - if i = 0 then - if j = 0 then optimizerTestEntry a else optimizerTestEntry b - else if j = 0 then optimizerTestEntry c else optimizerTestEntry d) - (fun _ ↦ 0) (fun _ ↦ 0) - -end BeyondBethe From 812cb82396f3eb8d1568aa61a3f6ba7f6d71128d Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Fri, 25 Sep 2026 20:01:54 +0000 Subject: [PATCH 22/49] Record Complexitylib provenance and omit unused RAM smoke harness --- LeanPool.lean | 1 - LeanPool/BeyondBethe.lean | 3 +- LeanPool/BeyondBethe/BeyondBethe.lean | 1 - .../BeyondBethe/MachineRAMSmoke.lean | 57 ------------------- LeanPool/BeyondBethe/Complexitylib.lean | 12 +++- LeanPool/projects.yml | 3 + 6 files changed, 15 insertions(+), 62 deletions(-) delete mode 100644 LeanPool/BeyondBethe/BeyondBethe/MachineRAMSmoke.lean diff --git a/LeanPool.lean b/LeanPool.lean index b748951961..cb7cc52e5d 100644 --- a/LeanPool.lean +++ b/LeanPool.lean @@ -384,7 +384,6 @@ public import LeanPool.BeyondBethe.BeyondBethe.MachineOutputEncoding public import LeanPool.BeyondBethe.BeyondBethe.MachinePerfectMatching public import LeanPool.BeyondBethe.BeyondBethe.MachinePositiveAlgorithm public import LeanPool.BeyondBethe.BeyondBethe.MachineRAMBridge -public import LeanPool.BeyondBethe.BeyondBethe.MachineRAMSmoke public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalArithmetic public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalBallInit public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalCompare diff --git a/LeanPool/BeyondBethe.lean b/LeanPool/BeyondBethe.lean index f76388f69a..6a54172fc7 100644 --- a/LeanPool/BeyondBethe.lean +++ b/LeanPool/BeyondBethe.lean @@ -162,7 +162,6 @@ import LeanPool.BeyondBethe.BeyondBethe.MachineOutputEncoding import LeanPool.BeyondBethe.BeyondBethe.MachinePerfectMatching import LeanPool.BeyondBethe.BeyondBethe.MachinePositiveAlgorithm import LeanPool.BeyondBethe.BeyondBethe.MachineRAMBridge -import LeanPool.BeyondBethe.BeyondBethe.MachineRAMSmoke import LeanPool.BeyondBethe.BeyondBethe.MachineRationalArithmetic import LeanPool.BeyondBethe.BeyondBethe.MachineRationalBallInit import LeanPool.BeyondBethe.BeyondBethe.MachineRationalCompare @@ -682,7 +681,7 @@ import LeanPool.BeyondBethe.Solution # Beyond the Bethe approximation of the permanent Source: url:https://github.com/nimaanari/formalization-beyond-bethe -Authors: Nima Anari +Authors: Nima Anari, Samuel Schlesinger, Bolton Bailey, Christian Reitwiessner Status: verified Main declarations: `BeyondBethe.theoremOne` Tags: permanent, approximation-algorithms, computational-complexity, stable-polynomials diff --git a/LeanPool/BeyondBethe/BeyondBethe.lean b/LeanPool/BeyondBethe/BeyondBethe.lean index 01035ab857..20ee694896 100644 --- a/LeanPool/BeyondBethe/BeyondBethe.lean +++ b/LeanPool/BeyondBethe/BeyondBethe.lean @@ -236,7 +236,6 @@ import LeanPool.BeyondBethe.BeyondBethe.MachineFinalScalars import LeanPool.BeyondBethe.BeyondBethe.MachineRAMBridge import LeanPool.BeyondBethe.BeyondBethe.MachineBitAssembly import LeanPool.BeyondBethe.BeyondBethe.MachineTrimHighZeros -import LeanPool.BeyondBethe.BeyondBethe.MachineRAMSmoke import LeanPool.BeyondBethe.BeyondBethe.BinaryDirectedElementary import LeanPool.BeyondBethe.BeyondBethe.RationalFeasibility import LeanPool.BeyondBethe.BeyondBethe.RoundedFeasibility diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRAMSmoke.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRAMSmoke.lean deleted file mode 100644 index cb735c9710..0000000000 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineRAMSmoke.lean +++ /dev/null @@ -1,57 +0,0 @@ -/- -Copyright (c) 2026 Nima Anari. All rights reserved. -Released under Apache 2.0 license as described in the file LICENSE. -Authors: Nima Anari --/ - -import LeanPool.BeyondBethe.BeyondBethe.MachineTrimHighZeros -import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine - -/-! -# End-to-end smoke test for the RAM bit-graph bridge - -This file instantiates every layer of the bridge on the canonical empty -output. Although the computed function is deliberately trivial, the theorem -checks the complete interface: padded RAM input, logarithmic-cost decision, -simulation by a deterministic Turing machine, bounded bit assembly, and -canonical high-zero trimming. --/ - -namespace BeyondBethe - -open Complexity - -def emptyMachineTarget (_ : List Bool) : List Bool := [] - -theorem outputBitLanguage_emptyMachineTarget : - outputBitLanguage emptyMachineTarget = (∅ : Language) := by - ext payload - simp [outputBitLanguage, emptyMachineTarget] - -theorem paddedOutputBitLanguage_emptyMachineTarget (count : ℕ) : - MachineRAMBridge.paddedLanguage count - (outputBitLanguage emptyMachineTarget) = (∅ : Language) := by - rw [outputBitLanguage_emptyMachineTarget] - ext payload - simp [MachineRAMBridge.paddedLanguage] - -/-- A concrete theorem exercising the complete padded-RAM-to-`FP` reduction. -No machine-time premise is accepted from the caller. -/ -theorem emptyMachineTarget_mem_FP_from_paddedRAM (count : ℕ) : - emptyMachineTarget ∈ Complexity.FP := by - let ruler : List Bool → List Bool := fun _ => [] - have hdecides : RAM.rejectProg.DecidesInTime - (MachineRAMBridge.paddedLanguage count - (outputBitLanguage emptyMachineTarget)) - (2 : Polynomial ℕ).eval := by - rw [paddedOutputBitLanguage_emptyMachineTarget] - simpa using! RAM.rejectProg_decides - apply canonicalTarget_mem_FP_of_paddedRamBitProgram count - emptyMachineTarget ruler RAM.rejectProg (2 : Polynomial ℕ) hdecides - · exact machineConst_mem_FP [] - · intro word - simp [emptyMachineTarget, ruler] - · intro word - rfl - -end BeyondBethe diff --git a/LeanPool/BeyondBethe/Complexitylib.lean b/LeanPool/BeyondBethe/Complexitylib.lean index 337fb26542..f6e096902d 100644 --- a/LeanPool/BeyondBethe/Complexitylib.lean +++ b/LeanPool/BeyondBethe/Complexitylib.lean @@ -13,4 +13,14 @@ import LeanPool.BeyondBethe.Complexitylib.Mathlib import LeanPool.BeyondBethe.Complexitylib.Models import LeanPool.BeyondBethe.Complexitylib.SAT -/-! Supporting modules for Beyond the Bethe approximation of the permanent. -/ +/-! +# Complexitylib dependency provenance + +The imported dependency comes from +[SamuelSchlesinger/complexitylib at `b6738219a3a3c50967d6bd16cba9487887ca6b66`](https://github.com/SamuelSchlesinger/complexitylib/tree/b6738219a3a3c50967d6bd16cba9487887ca6b66). +This is the revision pinned by the upstream Beyond Bethe +[`lake-manifest.json`](https://github.com/nimaanari/formalization-beyond-bethe/blob/325cda6d2118870f7f121a9a986b7ea9ffdd7a26/lake-manifest.json). +The dependency is licensed under Apache-2.0. Its imported file headers credit +Samuel Schlesinger, Bolton Bailey, Christian Reitwiessner, and Nima Anari; +individual copyright and author notices are retained in those files. +-/ diff --git a/LeanPool/projects.yml b/LeanPool/projects.yml index 83739f2afc..c51be4bb32 100644 --- a/LeanPool/projects.yml +++ b/LeanPool/projects.yml @@ -10135,6 +10135,9 @@ projects: entry_module: LeanPool.BeyondBethe authors: - Nima Anari + - Samuel Schlesinger + - Bolton Bailey + - Christian Reitwiessner source: url: https://github.com/nimaanari/formalization-beyond-bethe github_repo: nimaanari/formalization-beyond-bethe From ff3ef47852198f80d5e5ae96629f3a12ce2d11f1 Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Fri, 25 Sep 2026 20:02:02 +0000 Subject: [PATCH 23/49] Document objective and certificate machine interfaces --- .../BeyondBethe/MachineBetheFloorScan.lean | 53 +++++++++++ .../BeyondBethe/MachineBetheFloorTest.lean | 5 + .../BeyondBethe/MachineBetheHeightCap.lean | 8 ++ .../BeyondBethe/MachineBetheHeightNormal.lean | 6 ++ .../BeyondBethe/MachineBinaryAdd.lean | 9 ++ .../BeyondBethe/MachineBinaryCompare.lean | 4 + .../BeyondBethe/MachineBinaryDivision.lean | 18 ++++ .../BeyondBethe/MachineBinaryGCD.lean | 9 ++ .../BeyondBethe/MachineBinaryListInit.lean | 4 + .../BeyondBethe/MachineBinaryListSnoc.lean | 4 + .../BeyondBethe/MachineBinaryMul.lean | 14 +++ .../BeyondBethe/MachineBinarySub.lean | 4 + .../MachineCertificateExpGuard.lean | 10 ++ .../MachineCertificatePotentials.lean | 8 ++ .../BeyondBethe/MachineCertificateScales.lean | 16 ++++ .../MachineCertifiedPairEligibility.lean | 80 ++++++++++++++++ .../MachineCompletedAlgorithm.lean | 17 ++++ .../MachineDirectedAffineGradientEntry.lean | 20 ++++ .../MachineDirectedAffineGradientVector.lean | 9 ++ .../MachineDirectedEpigraphNormal.lean | 2 + .../BeyondBethe/MachineDirectedLog.lean | 64 +++++++++++++ ...ineDirectedNegativeGradientCoordinate.lean | 11 +++ .../MachineDirectedNegativeGradientEntry.lean | 13 +++ ...neDirectedNegativeObjectiveCoordinate.lean | 36 ++++++++ .../MachineDirectedNegativeObjectiveSum.lean | 91 +++++++++++++++++++ .../MachineDirectedTransferCost.lean | 22 +++++ .../BeyondBethe/MachineDyadicFloor.lean | 4 + 27 files changed, 541 insertions(+) diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineBetheFloorScan.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineBetheFloorScan.lean index 6a14504ae9..d3b11efaa0 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineBetheFloorScan.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineBetheFloorScan.lean @@ -27,98 +27,123 @@ open Complexity /-! ## Input and state layout -/ +/-- Extracts the unary dimension parameter from the floor-scan input. -/ def machineBetheFloorScanDimension (word : List Bool) : List Bool := machinePairFirst word +/-- Extracts the paired threshold and coordinate vector from the floor-scan input. -/ def machineBetheFloorScanRest (word : List Bool) : List Bool := machinePairSecond word +/-- Extracts the encoded rational floor threshold from the scan input. -/ def machineBetheFloorScanThreshold (word : List Bool) : List Bool := machinePairFirst (machineBetheFloorScanRest word) +/-- Extracts the encoded rational coordinate vector from the scan input. -/ def machineBetheFloorScanVector (word : List Bool) : List Bool := machinePairSecond (machineBetheFloorScanRest word) +/-- Encodes a floor-scan state as row, column, found flag, done flag, and input payload. -/ def machineBetheFloorScanPack (row column found done payload : List Bool) : List Bool := pair row (pair column (pair found (pair done payload))) +/-- Extracts the current unary row index from the floor-scan state. -/ def machineBetheFloorScanRow (state : List Bool) : List Bool := machinePairFirst state +/-- Extracts the current unary column index from the floor-scan state. -/ def machineBetheFloorScanColumn (state : List Bool) : List Bool := machinePairFirst (machinePairSecond state) +/-- Extracts the flag recording discovery of an entry below the floor threshold. -/ def machineBetheFloorScanFound (state : List Bool) : List Bool := machinePairFirst (machinePairSecond (machinePairSecond state)) +/-- Extracts the flag recording completion of the floor scan. -/ def machineBetheFloorScanDone (state : List Bool) : List Bool := machinePairFirst (machinePairSecond (machinePairSecond (machinePairSecond state))) +/-- Extracts the original scan input stored in the state. -/ def machineBetheFloorScanPayload (state : List Bool) : List Bool := machinePairSecond (machinePairSecond (machinePairSecond (machinePairSecond state))) +/-- Reads the unary dimension parameter from the state's stored input. -/ def machineBetheFloorScanStateDimension (state : List Bool) : List Bool := machineBetheFloorScanDimension (machineBetheFloorScanPayload state) +/-- Reads the rational floor threshold from the state's stored input. -/ def machineBetheFloorScanStateThreshold (state : List Bool) : List Bool := machineBetheFloorScanThreshold (machineBetheFloorScanPayload state) +/-- Reads the rational coordinate vector from the state's stored input. -/ def machineBetheFloorScanStateVector (state : List Bool) : List Bool := machineBetheFloorScanVector (machineBetheFloorScanPayload state) +/-- Tests whether the current row ruler equals the dimension ruler, marking the last row. -/ def machineBetheFloorScanLastRowBit (state : List Bool) : List Bool := machineUnaryRulersEqualBit (machineBetheFloorScanRow state) (machineBetheFloorScanStateDimension state) +/-- Tests whether the current column ruler equals the dimension ruler, marking the last column. -/ def machineBetheFloorScanLastColumnBit (state : List Bool) : List Bool := machineUnaryRulersEqualBit (machineBetheFloorScanColumn state) (machineBetheFloorScanStateDimension state) +/-- Assembles the dimension, current indices, and coordinate vector for an affine-entry query. -/ def machineBetheFloorScanEntryWord (state : List Bool) : List Bool := pair (machineBetheFloorScanStateDimension state) (pair (machineBetheFloorScanRow state) (pair (machineBetheFloorScanColumn state) (machineBetheFloorScanStateVector state))) +/-- Pairs the floor threshold with the current affine-entry query. -/ def machineBetheFloorScanTestWord (state : List Bool) : List Bool := pair (machineBetheFloorScanStateThreshold state) (machineBetheFloorScanEntryWord state) +/-- Tests whether the current affine matrix entry violates the floor constraint. -/ def machineBetheFloorScanViolationBit (state : List Bool) : List Bool := machineBetheFloorViolationBit (machineBetheFloorScanTestWord state) +/-- Increments the current unary row index by appending one bit. -/ def machineBetheFloorScanNextRow (state : List Bool) : List Bool := machineBetheFloorScanRow state ++ [true] +/-- Increments the current unary column index by appending one bit. -/ def machineBetheFloorScanNextColumn (state : List Bool) : List Bool := machineBetheFloorScanColumn state ++ [true] +/-- Sets the found flag while retaining the current indices and input payload. -/ def machineBetheFloorScanMarkFound (state : List Bool) : List Bool := machineBetheFloorScanPack (machineBetheFloorScanRow state) (machineBetheFloorScanColumn state) [true] (machineBetheFloorScanDone state) (machineBetheFloorScanPayload state) +/-- Sets the done flag while retaining the current indices and input payload. -/ def machineBetheFloorScanFinish (state : List Bool) : List Bool := machineBetheFloorScanPack (machineBetheFloorScanRow state) (machineBetheFloorScanColumn state) (machineBetheFloorScanFound state) [true] (machineBetheFloorScanPayload state) +/-- Advances to the next row and resets the column index to zero. -/ def machineBetheFloorScanAdvanceRow (state : List Bool) : List Bool := machineBetheFloorScanPack (machineBetheFloorScanNextRow state) [] (machineBetheFloorScanFound state) (machineBetheFloorScanDone state) (machineBetheFloorScanPayload state) +/-- Advances the column index while retaining the current row and flags. -/ def machineBetheFloorScanAdvanceColumn (state : List Bool) : List Bool := machineBetheFloorScanPack (machineBetheFloorScanRow state) (machineBetheFloorScanNextColumn state) (machineBetheFloorScanFound state) (machineBetheFloorScanDone state) (machineBetheFloorScanPayload state) +/-- Advances in row-major order, marking completion after the final matrix entry. -/ def machineBetheFloorScanAdvance (state : List Bool) : List Bool := machineIfHead (machineHeadBit (machineBetheFloorScanLastColumnBit state)) (machineIfHead (machineHeadBit (machineBetheFloorScanLastRowBit state)) @@ -126,48 +151,59 @@ def machineBetheFloorScanAdvance (state : List Bool) : List Bool := (machineBetheFloorScanAdvanceRow state)) (machineBetheFloorScanAdvanceColumn state) +/-- Marks a floor violation at the current entry or advances to the next entry. -/ def machineBetheFloorScanProcess (state : List Bool) : List Bool := machineIfHead (machineHeadBit (machineBetheFloorScanViolationBit state)) (machineBetheFloorScanMarkFound state) (machineBetheFloorScanAdvance state) +/-- Performs one floor-scan step, leaving found or completed states fixed. -/ def machineBetheFloorScanStep (state : List Bool) : List Bool := machineIfHead (machineHeadBit (machineBetheFloorScanFound state)) state (machineIfHead (machineHeadBit (machineBetheFloorScanDone state)) state (machineBetheFloorScanProcess state)) +/-- Initializes the floor scan at row and column zero with both flags false. -/ def machineBetheFloorScanInit (word : List Bool) : List Bool := machineBetheFloorScanPack [] [] [false] [false] word /-! ## Exact polynomial iteration ruler -/ +/-- Computes binary bits for the length of the input's dimension ruler. -/ def machineBetheFloorScanDimensionBits (word : List Bool) : List Bool := machineLengthBits (machineBetheFloorScanDimension word) +/-- Computes binary bits for one plus the dimension-ruler length. -/ def machineBetheFloorScanOrderBits (word : List Bool) : List Bool := machineBinaryAddBits (pair (machineBetheFloorScanDimensionBits word) [true]) +/-- Computes the square of one plus the dimension-ruler length as binary bits. -/ def machineBetheFloorScanWorkBits (word : List Bool) : List Bool := machineBinaryMulBits (pair (machineBetheFloorScanOrderBits word) (machineBetheFloorScanOrderBits word)) +/-- Supplies the binary-multiplication width bound used to construct the scan ruler. -/ def machineBetheFloorScanGuard (word : List Bool) : List Bool := machineBinaryMulWidth word +/-- Converts the square of the matrix order to a unary iteration ruler within the guard bound. -/ def machineBetheFloorScanRuler (word : List Bool) : List Bool := machineBoundedUnary (pair (machineBetheFloorScanGuard word) (machineBetheFloorScanWorkBits word)) +/-- Applies the binary-multiplication width bound twice to bound encoded scan components. -/ def machineBetheFloorScanStateEnvelope (word : List Bool) : List Bool := machineBinaryMulWidth (machineBinaryMulWidth word) +/-- Packs five copies of the state envelope to provide an encoded-state width bound. -/ def machineBetheFloorScanWidth (word : List Bool) : List Bool := let bound := machineBetheFloorScanStateEnvelope word machineBetheFloorScanPack bound bound bound bound bound +/-- Runs the floor-scan step for the number of iterations specified by its unary ruler. -/ def machineBetheFloorScanFinalState (word : List Bool) : List Bool := (machineBetheFloorScanStep)^[(machineBetheFloorScanRuler word).length] (machineBetheFloorScanInit word) @@ -434,6 +470,8 @@ theorem machineBetheFloorScanWidth_mem_FP : (machineBetheFloorScanPack row column found done payload) = payload := by simp [machineBetheFloorScanPayload, machineBetheFloorScanPack] +/-- Bounds a canonically packed scan state's index lengths, single-bit flags, and payload +length. -/ def MachineBetheFloorScanStateBound (word : List Bool) (iterations : ℕ) (state : List Bool) : Prop := state = machineBetheFloorScanPack @@ -665,6 +703,8 @@ theorem machineBetheFloorScanResultCode_mem_FP : /-! ## Canonical ruler semantics -/ +/-- Encodes a dimension, rational threshold, and coordinate vector as a canonical floor-scan +input. -/ def machineBetheFloorScanCanonicalWord {m : ℕ} (delta : RawRat) (y : Fin (m * m) → ℚ) : List Bool := pair (List.replicate m true) @@ -752,11 +792,16 @@ def betheFloorScanNextFin {m : ℕ} (i : Fin (m + 1)) : Fin (m + 1) := /-- Typed semantic state mirrored by the finite-word scan. -/ structure BetheFloorScanSemanticState (m : ℕ) where + /-- Current row of the affine matrix, whose indices range from zero through `m`. -/ row : Fin (m + 1) + /-- Current column of the affine matrix, whose indices range from zero through `m`. -/ column : Fin (m + 1) + /-- Records whether the scan has found an entry below the floor threshold. -/ found : Bool + /-- Records whether the scan has examined all matrix entries without stopping at a violation. -/ done : Bool +/-- Initializes the semantic floor scan at the first matrix entry with both flags false. -/ def betheFloorScanSemanticInit (m : ℕ) : BetheFloorScanSemanticState m where row := ⟨0, by omega⟩ @@ -764,6 +809,8 @@ def betheFloorScanSemanticInit (m : ℕ) : found := false done := false +/-- Scans one affine matrix entry in row-major order, stopping at a floor violation or +completion. -/ def betheFloorScanSemanticStep {m : ℕ} (delta : RawRat) (y : Fin (m * m) → ℚ) (state : BetheFloorScanSemanticState m) : BetheFloorScanSemanticState m := @@ -781,6 +828,7 @@ def betheFloorScanSemanticStep {m : ℕ} (delta : RawRat) else { state with column := betheFloorScanNextFin state.column } +/-- Encodes a semantic scan state with unary indices, Boolean flags, and its canonical input. -/ def machineBetheFloorScanCanonicalState {m : ℕ} (delta : RawRat) (y : Fin (m * m) → ℚ) (state : BetheFloorScanSemanticState m) : List Bool := @@ -1139,6 +1187,7 @@ theorem machineBetheFloorScanIterate_canonicalState {m : ℕ} simp [machineBetheFloorScanInit, machineBetheFloorScanCanonicalState, betheFloorScanSemanticInit] +/-- Runs the semantic scan for `(m + 1)^2` steps, enough to examine every matrix entry. -/ def finalBetheFloorScanSemanticState {m : ℕ} (delta : RawRat) (y : Fin (m * m) → ℚ) : BetheFloorScanSemanticState m := (betheFloorScanSemanticStep delta y)^[(m + 1) * (m + 1)] @@ -1155,6 +1204,7 @@ def finalBetheFloorScanSemanticState {m : ℕ} (delta : RawRat) machineBetheFloorScanIterate_canonicalState] rfl +/-- Encodes the found flag and the row and column at which the semantic scan stopped. -/ def betheFloorScanSemanticResultCode {m : ℕ} (state : BetheFloorScanSemanticState m) : List Bool := pair [state.found] @@ -1173,6 +1223,7 @@ def betheFloorScanSemanticResultCode {m : ℕ} /-! ## Mathematical correctness of the row-major semantic scan -/ +/-- Numbers matrix entries in row-major order by `i * (m + 1) + j`. -/ def betheFloorScanOrdinal {m : ℕ} (i j : Fin (m + 1)) : ℕ := i.1 * (m + 1) + j.1 @@ -1277,6 +1328,8 @@ theorem betheFloorScanOrdinal_lt_last_of_ne {m : ℕ} _ ≤ betheFloorScanOrdinal (Fin.last m) (Fin.last m) := by simp [betheFloorScanOrdinal] +/-- Records either the first violating entry, successful completion, or the next unchecked +ordinal. -/ def BetheFloorScanInvariant {m : ℕ} (delta : RawRat) (y : Fin (m * m) → ℚ) (k : ℕ) (state : BetheFloorScanSemanticState m) : Prop := diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineBetheFloorTest.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineBetheFloorTest.lean index 3fc38bcf64..18537d3aaf 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineBetheFloorTest.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineBetheFloorTest.lean @@ -26,15 +26,19 @@ namespace BeyondBethe open Complexity +/-- Extracts the encoded rational threshold from a floor-test input. -/ def machineBetheFloorTestThreshold (word : List Bool) : List Bool := machinePairFirst word +/-- Extracts the affine-entry query from a floor-test input. -/ def machineBetheFloorTestEntryWord (word : List Bool) : List Bool := machinePairSecond word +/-- Computes the encoded raw rational value of the queried affine matrix entry. -/ def machineBetheFloorTestEntryRawCode (word : List Bool) : List Bool := machineBetheAffineEntryRawCode (machineBetheFloorTestEntryWord word) +/-- Compares the encoded floor threshold with the queried affine matrix entry. -/ def machineBetheFloorTestThresholdLeEntryBit (word : List Bool) : List Bool := machineRawRatLeBit @@ -72,6 +76,7 @@ theorem machineBetheFloorViolationBit_mem_FP : machineNotBit_mem_FP machineBetheFloorTestThresholdLeEntryBit_mem_FP +/-- Encodes a threshold, matrix indices, and coordinate vector for a canonical floor test. -/ def machineBetheFloorTestCanonicalWord {m : ℕ} (delta : RawRat) (i j : Fin (m + 1)) (y : Fin (m * m) → ℚ) : List Bool := diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineBetheHeightCap.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineBetheHeightCap.lean index 2a7b70420b..9ef2287a0a 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineBetheHeightCap.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineBetheHeightCap.lean @@ -24,25 +24,32 @@ namespace BeyondBethe open Complexity +/-- Extracts the unary height-coordinate index from the height-cap input. -/ def machineBetheHeightCapDimension (word : List Bool) : List Bool := machinePairFirst word +/-- Extracts the paired upper bound and rational vector from the height-cap input. -/ def machineBetheHeightCapRest (word : List Bool) : List Bool := machinePairSecond word +/-- Extracts the encoded rational upper bound from the height-cap input. -/ def machineBetheHeightCapUpper (word : List Bool) : List Bool := machinePairFirst (machineBetheHeightCapRest word) +/-- Extracts the encoded rational vector from the height-cap input. -/ def machineBetheHeightCapVector (word : List Bool) : List Bool := machinePairSecond (machineBetheHeightCapRest word) +/-- Pairs the unary height-coordinate index with the encoded vector for list lookup. -/ def machineBetheHeightCapIndexInput (word : List Bool) : List Bool := pair (machineBetheHeightCapDimension word) (machineBetheHeightCapVector word) +/-- Looks up the encoded height coordinate in the rational vector. -/ def machineBetheHeightCapEntryCode (word : List Bool) : List Bool := machineListIndex (machineBetheHeightCapIndexInput word) +/-- Tests whether the encoded height coordinate is at most the encoded upper bound. -/ def machineBetheHeightLeUpperBit (word : List Bool) : List Bool := machineRawRatLeBit (pair (machineBetheHeightCapEntryCode word) @@ -94,6 +101,7 @@ theorem machineBetheHeightCapViolationBit_mem_FP : simpa only [machineBetheHeightCapViolationBit] using! machineNotBit_mem_FP machineBetheHeightLeUpperBit_mem_FP +/-- Encodes a rational upper bound and a vector whose final coordinate is its height. -/ def machineBetheHeightCapCanonicalWord {d : ℕ} (upper : RawRat) (q : Fin (d + 1) → ℚ) : List Bool := pair (List.replicate d true) diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineBetheHeightNormal.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineBetheHeightNormal.lean index e561ec1938..0aecccef10 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineBetheHeightNormal.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineBetheHeightNormal.lean @@ -22,24 +22,30 @@ namespace BeyondBethe open Complexity +/-- Produces the encoded zero entry used in the non-height coordinates of the cut normal. -/ def machineBetheHeightNormalEntryCode (_word : List Bool) : List Bool := rationalEntryBinaryCode 0 +/-- Supplies a twice-iterated binary width bound for generating the height-cut normal. -/ def machineBetheHeightNormalBound (word : List Bool) : List Bool := machineIteratedBinaryWidth 2 word +/-- Packages the coordinate ruler, entry bound, and payload for generating zero normal entries. -/ def machineBetheHeightNormalGeneratorInput (word : List Bool) : List Bool := pair word (pair (machineBetheHeightNormalBound word) word) +/-- Generates the encoded list of zero entries preceding the height coordinate of the normal. -/ def machineBetheHeightNormalBaseCode (word : List Bool) : List Bool := machineUnaryGridGeneratorCode machineBetheHeightNormalEntryCode (machineBetheHeightNormalGeneratorInput word) +/-- Pairs the encoded unit entry with the zero prefix for appending the height coordinate. -/ def machineBetheHeightNormalSnocInput (word : List Bool) : List Bool := pair (rationalEntryBinaryCode 1) (machineBetheHeightNormalBaseCode word) +/-- Encodes the height-cap cut normal by appending one to a vector of zero entries. -/ def machineBetheHeightNormalVectorCode (word : List Bool) : List Bool := machineBinaryListSnoc (machineBetheHeightNormalSnocInput word) diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryAdd.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryAdd.lean index f8198321aa..b12819cd77 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryAdd.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryAdd.lean @@ -24,19 +24,25 @@ namespace BeyondBethe open Complexity +/-- Encodes binary-addition state as two remaining operands, carry, and reversed accumulated +bits. -/ def machineBinaryAddPack (x y carry accRev : List Bool) : List Bool := pair x (pair y (pair carry accRev)) +/-- Extracts the unprocessed bits of the first addition operand. -/ def machineBinaryAddX (state : List Bool) : List Bool := machinePairFirst state +/-- Extracts the unprocessed bits of the second addition operand. -/ def machineBinaryAddY (state : List Bool) : List Bool := machinePairFirst (machinePairSecond state) +/-- Extracts the carry word from the binary-addition state. -/ def machineBinaryAddCarry (state : List Bool) : List Bool := machinePairFirst (machinePairSecond (machinePairSecond state)) +/-- Extracts the accumulated sum bits in reverse order. -/ def machineBinaryAddAccRev (state : List Bool) : List Bool := machinePairSecond (machinePairSecond (machinePairSecond state)) @@ -105,18 +111,21 @@ def machineBinaryAddActive (state : List Bool) : List Bool := (machineBinaryAddCarry state) [true]) [true] +/-- Computes the next sum bit from the two operand heads and the carry. -/ def machineBinaryAddSumBit (state : List Bool) : List Bool := machineFullAdderSum (machineHeadBit (machineBinaryAddX state)) (machineHeadBit (machineBinaryAddY state)) (machineBinaryAddCarry state) +/-- Computes the next carry from the two operand heads and the current carry. -/ def machineBinaryAddNextCarry (state : List Bool) : List Bool := machineFullAdderCarry (machineHeadBit (machineBinaryAddX state)) (machineHeadBit (machineBinaryAddY state)) (machineBinaryAddCarry state) +/-- Consumes one bit from each operand, updates the carry, and prepends the new sum bit. -/ def machineBinaryAddAdvanced (state : List Bool) : List Bool := machineBinaryAddPack (machineBinaryAddX state).tail diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryCompare.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryCompare.lean index 50bb380dcb..33043fc31f 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryCompare.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryCompare.lean @@ -22,13 +22,17 @@ namespace BeyondBethe open Complexity +/-- Tests whether the first encoded natural number is at most the second using truncated +subtraction. -/ def machineBinaryNatLeBit (word : List Bool) : List Bool := machineIfEmpty (machineBinarySubBits word) [true] [false] +/-- Tests strict inequality of the encoded natural numbers using reversed truncated subtraction. -/ def machineBinaryNatLtBit (word : List Bool) : List Bool := let swapped := pair (machinePairSecond word) (machinePairFirst word) machineIfEmpty (machineBinarySubBits swapped) [false] [true] +/-- Tests equality of the encoded natural numbers by comparing them in both directions. -/ def machineBinaryNatEqBit (word : List Bool) : List Bool := machineAndBit (machineBinaryNatLeBit word) (machineBinaryNatLeBit diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryDivision.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryDivision.lean index 884d2d4985..485ece8b87 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryDivision.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryDivision.lean @@ -24,76 +24,93 @@ namespace BeyondBethe open Complexity +/-- Encodes division state as remaining dividend bits, divisor, quotient, and remainder. -/ def machineBinaryDivPack (remaining divisor quotient remainder : List Bool) : List Bool := pair remaining (pair divisor (pair quotient remainder)) +/-- Extracts the dividend bits still to be processed by long division. -/ def machineBinaryDivRemaining (state : List Bool) : List Bool := machinePairFirst state +/-- Extracts the fixed divisor from the binary-division state. -/ def machineBinaryDivDivisor (state : List Bool) : List Bool := machinePairFirst (machinePairSecond state) +/-- Extracts the current quotient from the binary-division state. -/ def machineBinaryDivQuotient (state : List Bool) : List Bool := machinePairFirst (machinePairSecond (machinePairSecond state)) +/-- Extracts the current remainder from the binary-division state. -/ def machineBinaryDivRemainder (state : List Bool) : List Bool := machinePairSecond (machinePairSecond (machinePairSecond state)) +/-- Doubles the current quotient before processing the next dividend bit. -/ def machineBinaryDivDoubleQuotient (state : List Bool) : List Bool := machineBinaryAddBits (pair (machineBinaryDivQuotient state) (machineBinaryDivQuotient state)) +/-- Doubles the current remainder before processing the next dividend bit. -/ def machineBinaryDivDoubleRemainder (state : List Bool) : List Bool := machineBinaryAddBits (pair (machineBinaryDivRemainder state) (machineBinaryDivRemainder state)) +/-- Forms the trial remainder by doubling the remainder and adding the next dividend bit. -/ def machineBinaryDivTrial (state : List Bool) : List Bool := machineIfHead (machineHeadBit (machineBinaryDivRemaining state)) (machineBinaryAddBits (pair (machineBinaryDivDoubleRemainder state) [true])) (machineBinaryDivDoubleRemainder state) +/-- Tests whether the nonempty divisor is at most the trial remainder. -/ def machineBinaryDivTake (state : List Bool) : List Bool := machineIfEmpty (machineBinaryDivDivisor state) [false] (machineBinaryNatLeBit (pair (machineBinaryDivDivisor state) (machineBinaryDivTrial state))) +/-- Forms twice the current quotient plus one for a successful subtraction step. -/ def machineBinaryDivIncrementedQuotient (state : List Bool) : List Bool := machineBinaryAddBits (pair (machineBinaryDivDoubleQuotient state) [true]) +/-- Updates the quotient according to the trial comparison, returning zero for an empty divisor. -/ def machineBinaryDivNextQuotient (state : List Bool) : List Bool := machineIfEmpty (machineBinaryDivDivisor state) [] (machineIfHead (machineBinaryDivTake state) (machineBinaryDivIncrementedQuotient state) (machineBinaryDivDoubleQuotient state)) +/-- Subtracts the divisor from the trial remainder when the comparison permits it. -/ def machineBinaryDivNextRemainder (state : List Bool) : List Bool := machineIfHead (machineBinaryDivTake state) (machineBinarySubBits (pair (machineBinaryDivTrial state) (machineBinaryDivDivisor state))) (machineBinaryDivTrial state) +/-- Consumes one dividend bit and updates the quotient and remainder. -/ def machineBinaryDivStep (state : List Bool) : List Bool := machineBinaryDivPack (machineBinaryDivRemaining state).tail (machineBinaryDivDivisor state) (machineBinaryDivNextQuotient state) (machineBinaryDivNextRemainder state) +/-- Initializes long division with reversed dividend bits and zero quotient and remainder. -/ def machineBinaryDivInit (word : List Bool) : List Bool := machineBinaryDivPack (machinePairFirst word).reverse (machinePairSecond word) [] [] +/-- Uses the dividend bits as the iteration ruler for long division. -/ def machineBinaryDivRuler (word : List Bool) : List Bool := machinePairFirst word +/-- Provides a quadratic state-width ruler of length `(word.length + 16)^2`. -/ def machineBinaryDivWidth (word : List Bool) : List Bool := let padded := List.replicate 16 false ++ word List.replicate (padded.length * padded.length) false +/-- Runs one long-division step per dividend bit. -/ def machineBinaryDivFinalState (word : List Bool) : List Bool := machineBinaryDivStep^[(machineBinaryDivRuler word).length] (machineBinaryDivInit word) @@ -260,6 +277,7 @@ theorem machineBinaryDivWidth_mem_FP : (machineBinaryDivPack remaining divisor quotient remainder) = remainder := by simp [machineBinaryDivRemainder, machineBinaryDivPack] +/-- Bounds the remaining dividend length and the growth of quotient and remainder encodings. -/ def MachineBinaryDivReachable (dividend divisor : List Bool) (iterations : ℕ) (state : List Bool) : Prop := diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryGCD.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryGCD.lean index dea5a9c097..1db8d5c051 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryGCD.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryGCD.lean @@ -24,29 +24,36 @@ namespace BeyondBethe open Complexity +/-- Extracts the remainder component of the encoded division-with-remainder result. -/ def machineBinaryRemainderBits (word : List Bool) : List Bool := machinePairSecond (machineBinaryDivModBits word) +/-- Performs a Euclidean step, leaving states with zero second operand fixed. -/ def machineBinaryGcdStep (state : List Bool) : List Bool := machineIfEmpty (machinePairSecond state) state (pair (machinePairSecond state) (machineBinaryRemainderBits state)) +/-- Initializes the Euclidean algorithm after trimming high zeros from both operands. -/ def machineBinaryGcdInit (word : List Bool) : List Bool := pair (machineTrimHighZeros (machinePairFirst word)) (machineTrimHighZeros (machinePairSecond word)) +/-- Uses twice the normalized second-operand bit length as the Euclidean iteration budget. -/ def machineBinaryGcdRuler (word : List Bool) : List Bool := let second := machineTrimHighZeros (machinePairSecond word) second ++ second +/-- Provides a quadratic encoded-state width ruler for the Euclidean algorithm. -/ def machineBinaryGcdWidth (word : List Bool) : List Bool := let padded := List.replicate 16 false ++ word List.replicate (padded.length * padded.length) false +/-- Runs the Euclidean step for twice the normalized second-operand bit length. -/ def machineBinaryGcdFinalState (word : List Bool) : List Bool := machineBinaryGcdStep^[(machineBinaryGcdRuler word).length] (machineBinaryGcdInit word) +/-- Extracts the greatest common divisor from the final Euclidean state. -/ def machineBinaryGcdBits (word : List Bool) : List Bool := machinePairFirst (machineBinaryGcdFinalState word) @@ -105,6 +112,8 @@ theorem machineBinaryGcdStep_pair_natBits (a b : ℕ) : machineBinaryDivModBits_pair_natBits, machinePairSecond_pair, hb, ite_false, Prod.fst, Prod.snd] +/-- Expresses a state as a pair of canonical natural-number bit strings bounded by the input +length. -/ def MachineBinaryGcdReachable (word state : List Bool) : Prop := ∃ a b : ℕ, state = pair a.bits b.bits ∧ diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryListInit.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryListInit.lean index 80260b48f7..df014077ed 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryListInit.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryListInit.lean @@ -23,12 +23,16 @@ namespace BeyondBethe open Complexity +/-- Reverses an encoded list before removing its final entry. -/ def machineBinaryListInitReversed (word : List Bool) : List Bool := machineListReverse word +/-- Removes the head of the reversed encoded list. -/ def machineBinaryListInitReversedTail (word : List Bool) : List Bool := machineListTail (machineBinaryListInitReversed word) +/-- Returns the encoded list without its last entry by reversing, taking the tail, and reversing +again. -/ def machineBinaryListInit (word : List Bool) : List Bool := machineListReverse (machineBinaryListInitReversedTail word) diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryListSnoc.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryListSnoc.lean index 9c30f3ea15..0726966593 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryListSnoc.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryListSnoc.lean @@ -28,16 +28,20 @@ open Complexity def machineBinaryListSnocEntry (word : List Bool) : List Bool := machinePairFirst word +/-- Extracts the encoded list to which an entry will be appended. -/ def machineBinaryListSnocList (word : List Bool) : List Bool := machinePairSecond word +/-- Reverses the encoded list before appending its new final entry. -/ def machineBinaryListSnocReversedList (word : List Bool) : List Bool := machineListReverse (machineBinaryListSnocList word) +/-- Prepends the new entry to the reversed encoded list. -/ def machineBinaryListSnocPrependInput (word : List Bool) : List Bool := pair (machineBinaryListSnocEntry word) (machineBinaryListSnocReversedList word) +/-- Appends an encoded entry to a list by reversing the prepended reversed list. -/ def machineBinaryListSnoc (word : List Bool) : List Bool := machineListReverse (machineBinaryListSnocPrependInput word) diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryMul.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryMul.lean index 8f3316224c..0235615cd7 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryMul.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineBinaryMul.lean @@ -25,38 +25,48 @@ namespace BeyondBethe open Complexity +/-- Encodes multiplication state as remaining multiplier bits, shifted multiplicand, and +accumulator. -/ def machineBinaryMulPack (remaining shift acc : List Bool) : List Bool := pair remaining (pair shift acc) +/-- Extracts the unprocessed multiplier bits from the multiplication state. -/ def machineBinaryMulRemaining (state : List Bool) : List Bool := machinePairFirst state +/-- Extracts the shifted multiplicand from the multiplication state. -/ def machineBinaryMulShift (state : List Bool) : List Bool := machinePairFirst (machinePairSecond state) +/-- Extracts the accumulated product from the multiplication state. -/ def machineBinaryMulAcc (state : List Bool) : List Bool := machinePairSecond (machinePairSecond state) +/-- Doubles the shifted multiplicand for the next multiplier bit. -/ def machineBinaryMulNextShift (state : List Bool) : List Bool := machineBinaryAddBits (pair (machineBinaryMulShift state) (machineBinaryMulShift state)) +/-- Adds the shifted multiplicand to the accumulator when the current multiplier bit is set. -/ def machineBinaryMulNextAcc (state : List Bool) : List Bool := machineIfHead (machineHeadBit (machineBinaryMulRemaining state)) (machineBinaryAddBits (pair (machineBinaryMulAcc state) (machineBinaryMulShift state))) (machineBinaryMulAcc state) +/-- Consumes one multiplier bit, doubles the shift, and conditionally updates the accumulator. -/ def machineBinaryMulStep (state : List Bool) : List Bool := machineBinaryMulPack (machineBinaryMulRemaining state).tail (machineBinaryMulNextShift state) (machineBinaryMulNextAcc state) +/-- Initializes multiplication with the second operand as multiplier and a zero accumulator. -/ def machineBinaryMulInit (word : List Bool) : List Bool := machineBinaryMulPack (machinePairSecond word) (machinePairFirst word) [] +/-- Uses the second operand's bits as the multiplication iteration ruler. -/ def machineBinaryMulRuler (word : List Bool) : List Bool := machinePairSecond word @@ -65,10 +75,12 @@ def machineBinaryMulWidth (word : List Bool) : List Bool := let padded := List.replicate 16 false ++ word List.replicate (padded.length * padded.length) false +/-- Runs one multiplication step for each bit of the second operand. -/ def machineBinaryMulFinalState (word : List Bool) : List Bool := machineBinaryMulStep^[(machineBinaryMulRuler word).length] (machineBinaryMulInit word) +/-- Extracts the accumulated product from the final multiplication state. -/ def machineBinaryMulBits (word : List Bool) : List Bool := machineBinaryMulAcc (machineBinaryMulFinalState word) @@ -194,6 +206,8 @@ theorem machineBinaryMulIterate_length machineBinaryMulStep_pack, ih] rfl +/-- Bounds the remaining multiplier length and the growth of the shifted operand and +accumulator. -/ def MachineBinaryMulReachable (lhs rhs : List Bool) (iterations : ℕ) (state : List Bool) : Prop := ∃ remaining shift acc, diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineBinarySub.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineBinarySub.lean index 2eaeb25c53..b30496a83a 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineBinarySub.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineBinarySub.lean @@ -24,16 +24,20 @@ namespace BeyondBethe open Complexity +/-- Encodes subtraction state as remaining operands, borrow, and reversed accumulated bits. -/ def machineBinarySubPack (x y borrow accRev : List Bool) : List Bool := pair x (pair y (pair borrow accRev)) +/-- Extracts the unprocessed minuend bits from the subtraction state. -/ def machineBinarySubX (state : List Bool) : List Bool := machinePairFirst state +/-- Extracts the unprocessed subtrahend bits from the subtraction state. -/ def machineBinarySubY (state : List Bool) : List Bool := machinePairFirst (machinePairSecond state) +/-- Extracts the borrow word from the binary-subtraction state. -/ def machineBinarySubBorrow (state : List Bool) : List Bool := machinePairFirst (machinePairSecond (machinePairSecond state)) diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineCertificateExpGuard.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineCertificateExpGuard.lean index 0aa2615a9e..963b013476 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineCertificateExpGuard.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineCertificateExpGuard.lean @@ -24,9 +24,12 @@ namespace BeyondBethe open Complexity +/-- The natural ceiling of the reciprocal of the fixed exponential evaluation loss. -/ def explicitExpReciprocalCeil : ℕ := rationalCeilNat (1 / explicitExpEvaluationLoss) +/-- The odd exponential step bound `2*(K + K^2*C)+1`, where `K = 34*sourceLength^2` and `C` is +the reciprocal-loss ceiling. -/ def explicitCertificateExpStepBound (sourceLength : ℕ) : ℕ := let K := 34 * sourceLength ^ 2 2 * (K + K ^ 2 * explicitExpReciprocalCeil) + 1 @@ -166,10 +169,13 @@ theorem optimizerCertificate_expApproxSteps_le_sourceBound exact certificate_expApproxSteps_le_sourceBound_of_abs_le m B q (by simpa only [q] using! habsR) +/-- Iterate the binary-multiplication width constructor the specified number of times. -/ def machineIteratedBinaryWidth : ℕ → List Bool → List Bool | 0, word => word | k + 1, word => machineBinaryMulWidth (machineIteratedBinaryWidth k word) +/-- The numerical width recurrence starting at `L` and replacing each width by its padded square +`(width+16)^2`. -/ def certificateExpGuardWidth : ℕ → ℕ → ℕ | 0, L => L | k + 1, L => (certificateExpGuardWidth k L + 16) ^ 2 @@ -214,6 +220,8 @@ theorem certificateExpGuardWidth_pow_lower (k S : ℕ) : Nat.pow_le_pow_left ih 2 _ ≤ (certificateExpGuardWidth (k + 1) S + 16) ^ 2 := hmono +/-- The coefficient `2312*C+69` in the explicit exponential step estimate, with `C` the +reciprocal-loss ceiling. -/ def explicitCertificateExpCoefficient : ℕ := 2312 * explicitExpReciprocalCeil + 69 @@ -260,6 +268,8 @@ theorem explicitCertificateExpStepBound_le_guardWidth exact hstepCoeff.trans <| hguardPolynomial.trans <| (by simpa using! certificateExpGuardWidth_pow_lower 5 S) +/-- Construct the certificate exponentiation guard by applying six binary-width expansions to +the stored source word. -/ def machineOptimizerCertificateExpGuard (word : List Bool) : List Bool := machineIteratedBinaryWidth 6 (machineCertificateSourceWord word) diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineCertificatePotentials.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineCertificatePotentials.lean index f91ac2e21c..c60b8589e5 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineCertificatePotentials.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineCertificatePotentials.lean @@ -22,15 +22,19 @@ namespace BeyondBethe open Complexity +/-- Extract the encoded matrix from an optimizer result word. -/ def machineOptimizerMatrixWord (word : List Bool) : List Bool := machinePairFirst word +/-- Extract the row-and-column potential payload from an optimizer result word. -/ def machineOptimizerPotentialsWord (word : List Bool) : List Bool := machinePairSecond word +/-- Extract the encoded row-potential vector. -/ def machineOptimizerRowPotentialWord (word : List Bool) : List Bool := machinePairFirst (machineOptimizerPotentialsWord word) +/-- Extract the encoded column-potential vector. -/ def machineOptimizerColumnPotentialWord (word : List Bool) : List Bool := machinePairSecond (machineOptimizerPotentialsWord word) @@ -77,16 +81,19 @@ theorem machineOptimizerColumnPotentialWord_mem_FP : simp [machineOptimizerColumnPotentialWord, machineOptimizerPotentialsWord, rationalOptimizerOutputCode] +/-- Compute the raw-rational sum of the encoded row potentials. -/ def machineCertificateRowPotentialRawSumCode (word : List Bool) : List Bool := machineRationalVectorRawSumCode (machineOptimizerRowPotentialWord word) +/-- Compute the raw-rational sum of the encoded column potentials. -/ def machineCertificateColumnPotentialRawSumCode (word : List Bool) : List Bool := machineRationalVectorRawSumCode (machineOptimizerColumnPotentialWord word) +/-- Add the encoded row- and column-potential sums. -/ def machineCertificatePotentialRawSumCode (word : List Bool) : List Bool := machineRawRatAddCode @@ -113,6 +120,7 @@ theorem machineCertificatePotentialRawSumCode_mem_FP : simpa only [machineCertificatePotentialRawSumCode] using! machineCompose_mem_FP hpair machineRawRatAddCode_mem_FP +/-- The raw-rational sum of every row and column potential, using zero-initialized list sums. -/ def rawCertificatePotentialSum {n : ℕ} (R C : Fin n → ℚ) : RawRat := (rawRatListSum RawRat.zero (List.ofFn R)).add diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineCertificateScales.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineCertificateScales.lean index ef675fe2b5..d703719df1 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineCertificateScales.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineCertificateScales.lean @@ -25,9 +25,11 @@ namespace BeyondBethe open Complexity +/-- Extract the optimizer matrix dimension in binary. -/ def machineCertificateDimensionBits (word : List Bool) : List Bool := machineMatrixDimensionWord (machineOptimizerMatrixWord word) +/-- Extract a unary ruler for the optimizer matrix dimension. -/ def machineCertificateDimensionUnary (word : List Bool) : List Bool := machineMatrixDimensionUnary (machineOptimizerMatrixWord word) @@ -35,37 +37,47 @@ def machineCertificateDimensionUnary (word : List Bool) : List Bool := def machineCertificateLogPrecisionRuler (word : List Bool) : List Bool := machineCertificateDimensionUnary word ++ List.replicate 400 true +/-- Encode the matrix dimension as a nonnegative integer numerator with denominator one. -/ def machineCertificateDimensionRawCode (word : List Bool) : List Bool := pair (machineNaturalIntegerCode (machineCertificateDimensionBits word)) [true] +/-- The raw-rational natural number four. -/ def rawCertificateFour : RawRat := RawRat.ofNat 4 +/-- Compute the encoded raw-rational value four times the matrix dimension. -/ def machineCertificateFourDimensionRawCode (word : List Bool) : List Bool := machineRawRatMulCode (pair (rawRatBinaryCode rawCertificateFour) (machineCertificateDimensionRawCode word)) +/-- The raw-rational representation of the fixed structural gain parameter `explicitXi`. -/ def rawExplicitXi : RawRat := rawRatOfRat explicitXi +/-- Divide the fixed gain parameter by four times the encoded matrix dimension to obtain the +regularization scale. -/ def machineCertificateRegularizationScaleRawCode (word : List Bool) : List Bool := machineRawRatDivCode (pair (rawRatBinaryCode rawExplicitXi) (machineCertificateFourDimensionRawCode word)) +/-- The raw-rational representation of the fixed KKT error allowance. -/ def rawExplicitKKTError : RawRat := rawRatOfRat explicitKKTError +/-- Multiply the KKT error allowance by the encoded matrix dimension. -/ def machineCertificateKKTPenaltyRawCode (word : List Bool) : List Bool := machineRawRatMulCode (pair (rawRatBinaryCode rawExplicitKKTError) (machineCertificateDimensionRawCode word)) +/-- The raw-rational representation of the fixed exponential evaluation loss. -/ def rawExplicitExpEvaluationLoss : RawRat := rawRatOfRat explicitExpEvaluationLoss +/-- Multiply the exponential evaluation loss by the encoded matrix dimension. -/ def machineCertificateExpLossRawCode (word : List Bool) : List Bool := machineRawRatMulCode @@ -162,15 +174,19 @@ theorem machineCertificateExpLossRawCode_mem_FP : machineNaturalIntegerCode_natBits] simp [RawRat.ofNat, rawRatBinaryCode] +/-- The raw-rational product of four and the natural dimension. -/ def rawCertificateFourDimension (n : ℕ) : RawRat := rawCertificateFour.mul (RawRat.ofNat n) +/-- The raw-rational regularization scale obtained by dividing the fixed gain by `4*n`. -/ def rawCertificateRegularizationScale (n : ℕ) : RawRat := rawExplicitXi.div (rawCertificateFourDimension n) +/-- The raw-rational KKT penalty, equal to the dimension times the fixed error allowance. -/ def rawCertificateKKTPenalty (n : ℕ) : RawRat := rawExplicitKKTError.mul (RawRat.ofNat n) +/-- The raw-rational exponential loss scaled by the dimension. -/ def rawCertificateExpLoss (n : ℕ) : RawRat := rawExplicitExpEvaluationLoss.mul (RawRat.ofNat n) diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineCertifiedPairEligibility.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineCertifiedPairEligibility.lean index 4f86e8c628..4504ef0da4 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineCertifiedPairEligibility.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineCertifiedPairEligibility.lean @@ -26,8 +26,11 @@ namespace BeyondBethe open Complexity +/-- The raw-rational representation of the fixed pair-eligibility threshold. -/ def rawExplicitKappa : RawRat := rawRatOfRat explicitKappa +/-- The constant machine returning the encoded pair-eligibility threshold, independently of its +input. -/ def machineExplicitKappaRawCode (_word : List Bool) : List Bool := rawRatBinaryCode rawExplicitKappa @@ -37,55 +40,73 @@ theorem machineExplicitKappaRawCode_mem_FP : /-! ## The inner scan: second columns for a fixed first column -/ +/-- Extract the unary first-row index from a fixed-first-column eligibility query. -/ def machineFixedAFirstRowRuler (word : List Bool) : List Bool := machinePairFirst word +/-- The eligibility-query payload following the first-row index. -/ def machineFixedARest₁ (word : List Bool) : List Bool := machinePairSecond word +/-- Extract the unary second-row index from the eligibility query. -/ def machineFixedASecondRowRuler (word : List Bool) : List Bool := machinePairFirst (machineFixedARest₁ word) +/-- The eligibility-query payload following both row indices. -/ def machineFixedARest₂ (word : List Bool) : List Bool := machinePairSecond (machineFixedARest₁ word) +/-- Extract the unary first-column index held fixed during the scan. -/ def machineFixedAFirstColumnRuler (word : List Bool) : List Bool := machinePairFirst (machineFixedARest₂ word) +/-- Extract the optimizer result carried by the eligibility query. -/ def machineFixedAOptimizerWord (word : List Bool) : List Bool := machinePairSecond (machineFixedARest₂ word) +/-- Recover the matrix-dimension ruler from the query's optimizer result. -/ def machineFixedADimensionRuler (word : List Bool) : List Bool := machineCertificateDimensionUnary (machineFixedAOptimizerWord word) +/-- Encode the range of possible second-column indices using the dimension ruler. -/ def machineFixedAColumnRange (word : List Bool) : List Bool := machineUnaryRangeCode (machineFixedADimensionRuler word) +/-- Package the unprocessed column-list code, found flag, and original eligibility query. -/ def machineFixedAPack (remaining found source : List Bool) : List Bool := pair remaining (pair found source) +/-- Extract the encoded list of unprocessed second-column candidates. -/ def machineFixedARemaining (state : List Bool) : List Bool := machinePairFirst state +/-- Extract the accumulated flag recording whether an eligible column pair has been found. -/ def machineFixedAFound (state : List Bool) : List Bool := machinePairFirst (machinePairSecond state) +/-- Extract the immutable source query from the scan state. -/ def machineFixedASource (state : List Bool) : List Bool := machinePairSecond (machinePairSecond state) +/-- Read the first unprocessed second-column index from the encoded candidate list. -/ def machineFixedACurrentSecondColumn (state : List Bool) : List Bool := machineListHead (machineFixedARemaining state) +/-- Compare the fixed and current column indices by converting their unary lengths to binary +naturals. -/ def machineFixedAColumnsEqualBit (state : List Bool) : List Bool := machineBinaryNatEqBit (pair (machineLengthBits (machineFixedAFirstColumnRuler (machineFixedASource state))) (machineLengthBits (machineFixedACurrentSecondColumn state))) +/-- Negate the equality test for the fixed and current column indices. -/ def machineFixedAColumnsDistinctBit (state : List Bool) : List Bool := machineNotBit (machineFixedAColumnsEqualBit state) +/-- Package both fixed row indices, the fixed and current column indices, and the optimizer +result for four-core cost evaluation. -/ def machineFixedAFourCoreInput (state : List Bool) : List Bool := pair (machineFixedAFirstRowRuler (machineFixedASource state)) (pair (machineFixedASecondRowRuler (machineFixedASource state)) @@ -93,42 +114,57 @@ def machineFixedAFourCoreInput (state : List Bool) : List Bool := (pair (machineFixedACurrentSecondColumn state) (machineFixedAOptimizerWord (machineFixedASource state))))) +/-- Compute the directed raw-rational upper bound on the current four-core transfer cost. -/ def machineFixedAFourCoreRawCode (state : List Bool) : List Bool := machineDirectedFourCoreCostUpperRawCode (machineFixedAFourCoreInput state) +/-- Test whether the computed four-core cost upper bound is at most the fixed eligibility +threshold. -/ def machineFixedACostPassesBit (state : List Bool) : List Bool := machineRawRatLeBit (pair (machineFixedAFourCoreRawCode state) (rawRatBinaryCode rawExplicitKappa)) +/-- Accept the current candidate exactly when its column differs from the fixed column and its +cost passes the threshold test. -/ def machineFixedACandidateBit (state : List Bool) : List Bool := machineAndBit (machineFixedAColumnsDistinctBit state) (machineFixedACostPassesBit state) +/-- A scan-length bound word obtained by pairing the source query with its encoded column range. -/ def machineFixedAInputBound (word : List Bool) : List Bool := pair word (machineFixedAColumnRange word) +/-- Accumulate the current eligibility result by Boolean OR, truncating the result to the +source-derived bound length. -/ def machineFixedANextFound (state : List Bool) : List Bool := (machineOrBit (machineFixedAFound state) (machineFixedACandidateBit state)).take (machineFixedAInputBound (machineFixedASource state)).length +/-- Consume one second-column candidate and update the found flag while preserving the source +query. -/ def machineFixedAProcess (state : List Bool) : List Bool := machineFixedAPack (machineListTail (machineFixedARemaining state)) (machineFixedANextFound state) (machineFixedASource state) +/-- Leave a state with no remaining candidates fixed; otherwise process its next column. -/ def machineFixedAStep (state : List Bool) : List Bool := machineIfEmpty (machineFixedARemaining state) state (machineFixedAProcess state) +/-- Initialize the eligibility scan with the full column range and a false found flag. -/ def machineFixedAInit (word : List Bool) : List Bool := machineFixedAPack (machineFixedAColumnRange word) [false] word +/-- A uniform scan-state width envelope formed from three copies of the source-derived bound +word. -/ def machineFixedAWidth (word : List Bool) : List Bool := let bound := machineFixedAInputBound word machineFixedAPack bound bound bound +/-- Run the eligibility scan for the number of columns indicated by the dimension ruler. -/ def machineFixedAFinalState (word : List Bool) : List Bool := (machineFixedAStep)^[(machineFixedADimensionRuler word).length] (machineFixedAInit word) @@ -279,6 +315,8 @@ theorem machineFixedAWidth_mem_FP : machineFixedAWidth ∈ FP := by machineFixedASource (machineFixedAPack remaining found source) = source := by simp [machineFixedASource, machineFixedAPack] +/-- The scan has its canonical three-field layout, bounded remaining and found words, and the +original source query unchanged. -/ def MachineFixedAStateBound (word state : List Bool) : Prop := let B := (machineFixedAInputBound word).length state = machineFixedAPack (machineFixedARemaining state) @@ -370,6 +408,8 @@ theorem machineFixedAEligibilityBit_mem_FP : /-! ## Exact inner-scan semantics -/ +/-- Encode a fixed-column eligibility query from the rational optimizer data and three unary +row/column indices. -/ def fixedAMachineInput {n : ℕ} (X : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℚ) (r s a : Fin n) : List Bool := @@ -377,6 +417,8 @@ def fixedAMachineInput {n : ℕ} (pair (finUnaryCode s) (pair (finUnaryCode a) (rationalOptimizerOutputCode ⟨X, R, C⟩))) +/-- The semantic Boolean test for distinct columns whose directed four-core cost upper bound is +at most `explicitKappa`. -/ def certifiedColumnPairTest {n : ℕ} (X : Matrix (Fin n) (Fin n) ℚ) (r s a b : Fin n) : Bool := decide (a ≠ b ∧ @@ -468,10 +510,14 @@ def certifiedColumnPairTest {n : ℕ} X r s a b (directedPairCostPrecision n) ≤ explicitKappa <;> simp [hdistinct, hcost] +/-- Test whether any of the first `k` columns in the canonical finite enumeration passes the +fixed-column eligibility test. -/ def fixedAScanFound {n : ℕ} (X : Matrix (Fin n) (Fin n) ℚ) (r s a : Fin n) (k : ℕ) : Bool := ((List.finRange n).take k).any (certifiedColumnPairTest X r s a) +/-- The canonical scan state after `k` candidates: the remaining column suffix, the accumulated +semantic test result, and the original query. -/ def machineFixedASemanticState {n : ℕ} (X : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℚ) (r s a : Fin n) (k : ℕ) : List Bool := @@ -543,73 +589,96 @@ theorem machineFixedAIterate_semantics {n : ℕ} /-! ## The outer scan: first columns for a fixed row pair -/ +/-- Extracts the unary first-row index from a row-pair eligibility query. -/ def machineRowPairFirstRowRuler (word : List Bool) : List Bool := machinePairFirst word +/-- Extracts the second-row index and optimizer payload from the row-pair query. -/ def machineRowPairRest (word : List Bool) : List Bool := machinePairSecond word +/-- Extracts the unary second-row index from the eligibility query. -/ def machineRowPairSecondRowRuler (word : List Bool) : List Bool := machinePairFirst (machineRowPairRest word) +/-- Extracts the optimizer matrix and potentials carried by the row-pair query. -/ def machineRowPairOptimizerWord (word : List Bool) : List Bool := machinePairSecond (machineRowPairRest word) +/-- Recovers the matrix-dimension ruler from the query's optimizer result. -/ def machineRowPairDimensionRuler (word : List Bool) : List Bool := machineCertificateDimensionUnary (machineRowPairOptimizerWord word) +/-- Encodes the range of possible first-column indices for the outer eligibility scan. -/ def machineRowPairColumnRange (word : List Bool) : List Bool := machineUnaryRangeCode (machineRowPairDimensionRuler word) +/-- Encodes an outer scan state as remaining first-column candidates, found flag, and source +query. -/ def machineRowPairScanPack (remaining found source : List Bool) : List Bool := pair remaining (pair found source) +/-- Extracts the encoded list of unprocessed first-column candidates. -/ def machineRowPairScanRemaining (state : List Bool) : List Bool := machinePairFirst state +/-- Extracts the flag recording whether an eligible column pair has been found. -/ def machineRowPairScanFound (state : List Bool) : List Bool := machinePairFirst (machinePairSecond state) +/-- Extracts the immutable row-pair query from the scan state. -/ def machineRowPairScanSource (state : List Bool) : List Bool := machinePairSecond (machinePairSecond state) +/-- Reads the first unprocessed first-column index from the encoded candidate list. -/ def machineRowPairCurrentFirstColumn (state : List Bool) : List Bool := machineListHead (machineRowPairScanRemaining state) +/-- Builds the inner eligibility query with the current first column fixed. -/ def machineRowPairFixedAInput (state : List Bool) : List Bool := pair (machineRowPairFirstRowRuler (machineRowPairScanSource state)) (pair (machineRowPairSecondRowRuler (machineRowPairScanSource state)) (pair (machineRowPairCurrentFirstColumn state) (machineRowPairOptimizerWord (machineRowPairScanSource state)))) +/-- Runs the fixed-first-column eligibility test for the current outer-scan candidate. -/ def machineRowPairCandidateBit (state : List Bool) : List Bool := machineFixedAEligibilityBit (machineRowPairFixedAInput state) +/-- Pairs the row-pair query with its encoded column range to bound the scan state. -/ def machineRowPairInputBound (word : List Bool) : List Bool := pair word (machineRowPairColumnRange word) +/-- Combines the previous found flag with the current result and truncates to the source-derived +bound. -/ def machineRowPairNextFound (state : List Bool) : List Bool := (machineOrBit (machineRowPairScanFound state) (machineRowPairCandidateBit state)).take (machineRowPairInputBound (machineRowPairScanSource state)).length +/-- Consumes the current first-column candidate and updates the found flag. -/ def machineRowPairProcess (state : List Bool) : List Bool := machineRowPairScanPack (machineListTail (machineRowPairScanRemaining state)) (machineRowPairNextFound state) (machineRowPairScanSource state) +/-- Processes the next first-column candidate, leaving an exhausted scan state fixed. -/ def machineRowPairScanStep (state : List Bool) : List Bool := machineIfEmpty (machineRowPairScanRemaining state) state (machineRowPairProcess state) +/-- Initializes the outer eligibility scan with all first-column candidates and a false found +flag. -/ def machineRowPairScanInit (word : List Bool) : List Bool := machineRowPairScanPack (machineRowPairColumnRange word) [false] word +/-- Packs three copies of the source-derived bound to bound the encoded outer scan state. -/ def machineRowPairScanWidth (word : List Bool) : List Bool := let bound := machineRowPairInputBound word machineRowPairScanPack bound bound bound +/-- Runs the outer scan for the number of columns specified by the dimension ruler. -/ def machineRowPairScanFinalState (word : List Bool) : List Bool := (machineRowPairScanStep)^[(machineRowPairDimensionRuler word).length] (machineRowPairScanInit word) @@ -721,6 +790,8 @@ theorem machineRowPairScanWidth_mem_FP : machineRowPairScanWidth ∈ FP := (machineRowPairScanPack remaining found source) = source := by simp [machineRowPairScanSource, machineRowPairScanPack] +/-- Bounds the packed state's remaining-candidate and flag lengths while preserving the source +query. -/ def MachineRowPairScanStateBound (word state : List Bool) : Prop := let B := (machineRowPairInputBound word).length state = machineRowPairScanPack (machineRowPairScanRemaining state) @@ -818,16 +889,21 @@ theorem machineCertifiedRowPairEligibilityBit_mem_FP : /-! ## Exact outer-scan semantics -/ +/-- Encodes a matrix, its row and column potentials, and the two row indices for eligibility +testing. -/ def certifiedRowPairMachineInput {n : ℕ} (X : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℚ) (r s : Fin n) : List Bool := pair (finUnaryCode r) (pair (finUnaryCode s) (rationalOptimizerOutputCode ⟨X, R, C⟩)) +/-- Tests whether some distinct second column meets the certified cost threshold for a fixed +first column. -/ def certifiedFirstColumnTest {n : ℕ} (X : Matrix (Fin n) (Fin n) ℚ) (r s a : Fin n) : Bool := (List.finRange n).any (certifiedColumnPairTest X r s a) +/-- Tests whether some column pair meets the certified cost threshold for the two given rows. -/ def certifiedRowPairEligibilityTest {n : ℕ} (X : Matrix (Fin n) (Fin n) ℚ) (r s : Fin n) : Bool := (List.finRange n).any (certifiedFirstColumnTest X r s) @@ -866,10 +942,13 @@ def certifiedRowPairEligibilityTest {n : ℕ} change machineFixedAEligibilityBit (fixedAMachineInput X R C r s a) = _ exact machineFixedAEligibilityBit_encode X R C r s a +/-- Tests whether any of the first `k` first-column candidates yields an eligible column pair. -/ def outerScanFound {n : ℕ} (X : Matrix (Fin n) (Fin n) ℚ) (r s : Fin n) (k : ℕ) : Bool := ((List.finRange n).take k).any (certifiedFirstColumnTest X r s) +/-- Encodes the outer scan after `k` candidates with the remaining columns and accumulated test +result. -/ def machineRowPairSemanticState {n : ℕ} (X : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℚ) (r s : Fin n) (k : ℕ) : List Bool := @@ -959,6 +1038,7 @@ theorem certifiedRowPairEligibilityTest_eq_true_iff {n : ℕ} refine ⟨b, by simp, ?_⟩ simp [certifiedColumnPairTest, hab, hcost] +/-- Builds an eligibility query from the two rows of a `RowPair` and the optimizer result. -/ def certifiedRowPairEligibilityMachineInput {n : ℕ} (X : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℚ) (q : RowPair n) : List Bool := diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineCompletedAlgorithm.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineCompletedAlgorithm.lean index d0e59e85c6..6cf7f259e8 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineCompletedAlgorithm.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineCompletedAlgorithm.lean @@ -49,43 +49,52 @@ def PositiveRawStringRealizes F (rationalMatrixBinaryEncoding.encode ⟨n, A⟩) = rawRatBinaryCode (rawRatOfRat (alg n A)) +/-- Tests whether the encoded matrix dimension is less than two. -/ def machineCompletedDimensionLtTwoBit (word : List Bool) : List Bool := machineBinaryNatLtBit (pair (machineMatrixDimensionWord word) (2 : ℕ).bits) +/-- Encodes the matrix obtained by smoothing the input with rational parameter `χ`. -/ def machineCompletedSmoothedMatrixCode (χ : ℚ) (word : List Bool) : List Bool := machineSmoothedMatrixCode (pair (rawRatBinaryCode (rawRatOfRat χ)) word) +/-- Runs the supplied positive-input machine on the encoded smoothed matrix. -/ def machineCompletedPositiveRawCode (positiveMachine : List Bool → List Bool) (χ : ℚ) (word : List Bool) : List Bool := positiveMachine (machineCompletedSmoothedMatrixCode χ word) +/-- Obtains the raw-rational dimension code through the smoothing input format. -/ def machineCompletedDimensionRawCode (χ : ℚ) (word : List Bool) : List Bool := machineSmoothingDimensionRawCode (pair (rawRatBinaryCode (rawRatOfRat χ)) word) +/-- Computes the encoded product of `χ` and the matrix dimension. -/ def machineCompletedChiTimesDimensionRawCode (χ : ℚ) (word : List Bool) : List Bool := machineRawRatMulCode (pair (rawRatBinaryCode (rawRatOfRat χ)) (machineCompletedDimensionRawCode χ word)) +/-- Computes the encoded smoothing correction term `χ * n / 2`. -/ def machineCompletedHalfChiDimensionRawCode (χ : ℚ) (word : List Bool) : List Bool := machineRawRatDivCode (pair (machineCompletedChiTimesDimensionRawCode χ word) (rawRatBinaryCode (RawRat.ofNat 2))) +/-- Computes the encoded denominator correction `1 + χ * n / 2`. -/ def machineCompletedCorrectionRawCode (χ : ℚ) (word : List Bool) : List Bool := machineRawRatAddCode (pair (rawRatBinaryCode RawRat.one) (machineCompletedHalfChiDimensionRawCode χ word)) +/-- Multiplies the positive-machine output by the matrix normalization scale raised to its +dimension. -/ def machineCompletedLargeNumeratorRawCode (positiveMachine : List Bool → List Bool) (χ : ℚ) (word : List Bool) : List Bool := @@ -93,6 +102,7 @@ def machineCompletedLargeNumeratorRawCode (pair (machineMatrixNormalizationScalePowerRawCode word) (machineCompletedPositiveRawCode positiveMachine χ word)) +/-- Divides the scaled positive-machine output by the smoothing correction `1 + χ * n / 2`. -/ def machineCompletedLargeRawCode (positiveMachine : List Bool → List Bool) (χ : ℚ) (word : List Bool) : List Bool := @@ -100,12 +110,15 @@ def machineCompletedLargeRawCode (pair (machineCompletedLargeNumeratorRawCode positiveMachine χ word) (machineCompletedCorrectionRawCode χ word)) +/-- Normalizes the raw-rational result of the large-dimension branch. -/ def machineCompletedLargeCode (positiveMachine : List Bool → List Bool) (χ : ℚ) (word : List Bool) : List Bool := machineNormalizeRawRatBinaryCode (machineCompletedLargeRawCode positiveMachine χ word) +/-- Runs the corrected positive branch when the support has a perfect matching, returning zero +otherwise. -/ def machineCompletedMatchingBranchCode (positiveMachine : List Bool → List Bool) (χ : ℚ) (word : List Bool) : List Bool := @@ -113,6 +126,8 @@ def machineCompletedMatchingBranchCode (machineCompletedLargeCode positiveMachine χ word) (rationalBinaryCode 0) +/-- Handles dimensions below two directly and otherwise dispatches to the perfect-matching +branch. -/ def machineCompletedNonnegativeBranchCode (positiveMachine : List Bool → List Bool) (χ : ℚ) (word : List Bool) : List Bool := @@ -120,6 +135,8 @@ def machineCompletedNonnegativeBranchCode (machineSmallDimensionPermanentCode word) (machineCompletedMatchingBranchCode positiveMachine χ word) +/-- Dispatches nonnegative matrices to the completed algorithm and returns zero for a failed +sign test. -/ def machineCompletedAlgorithmCode (positiveMachine : List Bool → List Bool) (χ : ℚ) (word : List Bool) : List Bool := diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedAffineGradientEntry.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedAffineGradientEntry.lean index f75266a52b..dfc4445076 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedAffineGradientEntry.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedAffineGradientEntry.lean @@ -26,78 +26,95 @@ namespace BeyondBethe open Complexity +/-- Extracts the unary row index of an affine-gradient coordinate query. -/ def machineDirectedAffineGradientEntryRow (word : List Bool) : List Bool := machinePairFirst word +/-- Extracts the column index and objective-evaluation payload of the gradient query. -/ def machineDirectedAffineGradientEntryRest (word : List Bool) : List Bool := machinePairSecond word +/-- Extracts the unary column index of an affine-gradient coordinate query. -/ def machineDirectedAffineGradientEntryColumn (word : List Bool) : List Bool := machinePairFirst (machineDirectedAffineGradientEntryRest word) +/-- Extracts the shared objective-evaluation payload from the gradient query. -/ def machineDirectedAffineGradientEntryPayload (word : List Bool) : List Bool := machinePairSecond (machineDirectedAffineGradientEntryRest word) +/-- Recovers the affine dimension parameter from the gradient query's objective payload. -/ def machineDirectedAffineGradientEntryDimension (word : List Bool) : List Bool := machineDirectedObjectiveSumDimension (machineDirectedAffineGradientEntryPayload word) +/-- Uses the original query for the interior matrix entry in the affine-gradient formula. -/ def machineDirectedAffineGradientUpperLeftInput (word : List Bool) : List Bool := word +/-- Builds the gradient query at the given row and the last matrix column. -/ def machineDirectedAffineGradientUpperRightInput (word : List Bool) : List Bool := pair (machineDirectedAffineGradientEntryRow word) (pair (machineDirectedAffineGradientEntryDimension word) (machineDirectedAffineGradientEntryPayload word)) +/-- Builds the gradient query at the last matrix row and the given column. -/ def machineDirectedAffineGradientLowerLeftInput (word : List Bool) : List Bool := pair (machineDirectedAffineGradientEntryDimension word) (pair (machineDirectedAffineGradientEntryColumn word) (machineDirectedAffineGradientEntryPayload word)) +/-- Builds the gradient query at the last row and last column. -/ def machineDirectedAffineGradientLowerRightInput (word : List Bool) : List Bool := pair (machineDirectedAffineGradientEntryDimension word) (pair (machineDirectedAffineGradientEntryDimension word) (machineDirectedAffineGradientEntryPayload word)) +/-- Computes the directed negative-gradient value at the interior matrix entry. -/ def machineDirectedAffineGradientUpperLeftRaw (word : List Bool) : List Bool := machineDirectedNegativeGradientEntryRawCode (machineDirectedAffineGradientUpperLeftInput word) +/-- Computes the directed negative-gradient value at the given row and last column. -/ def machineDirectedAffineGradientUpperRightRaw (word : List Bool) : List Bool := machineDirectedNegativeGradientEntryRawCode (machineDirectedAffineGradientUpperRightInput word) +/-- Computes the directed negative-gradient value at the last row and given column. -/ def machineDirectedAffineGradientLowerLeftRaw (word : List Bool) : List Bool := machineDirectedNegativeGradientEntryRawCode (machineDirectedAffineGradientLowerLeftInput word) +/-- Computes the directed negative-gradient value at the last row and last column. -/ def machineDirectedAffineGradientLowerRightRaw (word : List Bool) : List Bool := machineDirectedNegativeGradientEntryRawCode (machineDirectedAffineGradientLowerRightInput word) +/-- Subtracts the last-column gradient value from the interior gradient value. -/ def machineDirectedAffineGradientFirstDifference (word : List Bool) : List Bool := machineRawRatSubCode (pair (machineDirectedAffineGradientUpperLeftRaw word) (machineDirectedAffineGradientUpperRightRaw word)) +/-- Subtracts the last-row gradient value from the interior-minus-last-column difference. -/ def machineDirectedAffineGradientSecondDifference (word : List Bool) : List Bool := machineRawRatSubCode (pair (machineDirectedAffineGradientFirstDifference word) (machineDirectedAffineGradientLowerLeftRaw word)) +/-- Forms the affine-gradient entry by adding the corner value to the two successive +differences. -/ def machineDirectedAffineGradientEntryRawCode (word : List Bool) : List Bool := machineRawRatAddCode @@ -199,6 +216,8 @@ theorem machineDirectedAffineGradientEntryRawCode_mem_FP : simpa only [machineDirectedAffineGradientEntryRawCode] using! machineCompose_mem_FP hinput machineRawRatAddCode_mem_FP +/-- Encodes affine coordinate indices together with regularization, matrix, point, and precision +data. -/ def machineDirectedAffineGradientEntryCanonicalWord {m : ℕ} (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) (y : Fin (m * m) → ℚ) (p : ℕ) (a b : Fin m) : List Bool := @@ -206,6 +225,7 @@ def machineDirectedAffineGradientEntryCanonicalWord {m : ℕ} (pair (List.replicate b.1 true) (machineDirectedObjectiveSumCanonicalWord tau A y p)) +/-- Forms the raw affine-gradient entry `G(a,b) - G(a,m) - G(m,b) + G(m,m)`. -/ def rawDirectedAffineGradientEntry {m : ℕ} (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) (y : Fin (m * m) → ℚ) (p : ℕ) (a b : Fin m) : RawRat := diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedAffineGradientVector.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedAffineGradientVector.lean index 42bbe3c0a4..040bd84765 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedAffineGradientVector.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedAffineGradientVector.lean @@ -24,6 +24,7 @@ namespace BeyondBethe open Complexity +/-- Normalizes the raw affine-gradient entry into an encoded rational vector entry. -/ def machineDirectedAffineGradientEntryCode (word : List Bool) : List Bool := machineNormalizeRawRatEntryCode (machineDirectedAffineGradientEntryRawCode word) @@ -49,14 +50,18 @@ theorem machineDirectedAffineGradientEntryCode_mem_FP : binaryNormalizeRawRat_eq_value, rawDirectedAffineGradientEntry_value] +/-- Uses six binary-width iterations to bound generated affine-gradient entries. -/ def machineDirectedAffineGradientVectorBound (word : List Bool) : List Bool := machineIteratedBinaryWidth 6 word +/-- Packages the dimension ruler, entry-width bound, and objective payload for gradient +generation. -/ def machineDirectedAffineGradientVectorGeneratorInput (word : List Bool) : List Bool := pair (machineDirectedObjectiveSumDimension word) (pair (machineDirectedAffineGradientVectorBound word) word) +/-- Generates the encoded vector of directed affine-gradient entries over the coordinate grid. -/ def machineDirectedAffineGradientVectorCode (word : List Bool) : List Bool := machineUnaryGridGeneratorCode machineDirectedAffineGradientEntryCode (machineDirectedAffineGradientVectorGeneratorInput word) @@ -79,6 +84,8 @@ theorem machineDirectedAffineGradientVectorCode_mem_FP : machineCompose_mem_FP machineDirectedAffineGradientVectorGeneratorInput_mem_FP hgenerator +/-- Flattens the affine pullback of the directed negative-gradient matrix into a coordinate +vector. -/ def directedAffineGradientVector {m : ℕ} (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) (y : Fin (m * m) → ℚ) (p : ℕ) : Fin (m * m) → ℚ := @@ -87,6 +94,8 @@ def directedAffineGradientVector {m : ℕ} (directedNegativeGradientLowerMatrix tau A (betheAffineMatrixQ y) p)) +/-- Budgets raw-rational coordinate width using the regularization and three directed logarithm +widths. -/ def rawDirectedGradientCoordinateWidthBudget (tau a x : ℚ) (p : ℕ) : ℕ := 2 * rawRatWidth (rawRatOfRat tau) + diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedEpigraphNormal.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedEpigraphNormal.lean index 45873b1a75..4b1c525255 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedEpigraphNormal.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedEpigraphNormal.lean @@ -23,11 +23,13 @@ namespace BeyondBethe open Complexity +/-- Pairs the encoded height coefficient `-1` with the directed affine-gradient vector. -/ def machineDirectedEpigraphNormalSnocInput (word : List Bool) : List Bool := pair (rationalEntryBinaryCode (-1)) (machineDirectedAffineGradientVectorCode word) +/-- Appends `-1` to the directed affine-gradient vector to encode an epigraph-cut normal. -/ def machineDirectedEpigraphNormalVectorCode (word : List Bool) : List Bool := machineBinaryListSnoc (machineDirectedEpigraphNormalSnocInput word) diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedLog.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedLog.lean index 6af65b2072..d781b3e7e3 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedLog.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedLog.lean @@ -26,55 +26,69 @@ namespace BeyondBethe open Complexity +/-- The binary encoding of the raw-rational constant two. -/ def rawRatTwoCode : List Bool := rawRatBinaryCode (RawRat.ofNat 2) +/-- Extracts the unary series-length ruler from a directed-logarithm input. -/ def machineDirectedLogRuler (word : List Bool) : List Bool := machinePairFirst word +/-- Extracts the encoded raw-rational argument of the directed logarithm. -/ def machineDirectedLogArgumentCode (word : List Bool) : List Bool := machinePairSecond word +/-- Computes the numerator `y - 1` of the logarithmic series parameter. -/ def machineDirectedLogParameterNumeratorCode (word : List Bool) : List Bool := machineRawRatAddCode (pair (machineDirectedLogArgumentCode word) (machineRawRatNegCode rawRatOneCode)) +/-- Computes the denominator `y + 1` of the logarithmic series parameter. -/ def machineDirectedLogParameterDenominatorCode (word : List Bool) : List Bool := machineRawRatAddCode (pair (machineDirectedLogArgumentCode word) rawRatOneCode) +/-- Computes the raw-rational logarithmic series parameter `(y - 1) / (y + 1)`. -/ def machineDirectedLogParameterCode (word : List Bool) : List Bool := machineRawRatDivCode (pair (machineDirectedLogParameterNumeratorCode word) (machineDirectedLogParameterDenominatorCode word)) +/-- Evaluates the rational logarithmic series at the transformed argument for the supplied ruler +length. -/ def machineDirectedLogSeriesSumCode (word : List Bool) : List Bool := machineRawRationalLogSeriesSumCode (pair (machineDirectedLogRuler word) (machineDirectedLogParameterCode word)) +/-- Doubles the truncated series sum to produce the unit-logarithm lower approximation. -/ def machineDirectedLogUnitLowerRawCode (word : List Bool) : List Bool := machineRawRatMulCode (pair rawRatTwoCode (machineDirectedLogSeriesSumCode word)) +/-- Builds a unary ruler of length `2 * N + 1` from the series-length ruler. -/ def machineDirectedLogOddPowerRuler (word : List Bool) : List Bool := true :: (machineDirectedLogRuler word ++ machineDirectedLogRuler word) +/-- Raises the logarithmic series parameter to the odd power `2 * N + 1`. -/ def machineDirectedLogOddPowerCode (word : List Bool) : List Bool := machineRawRatPowerCode (pair (machineDirectedLogOddPowerRuler word) (machineDirectedLogParameterCode word)) +/-- Computes the square of the logarithmic series parameter. -/ def machineDirectedLogParameterSquareCode (word : List Bool) : List Bool := machineRawRatMulCode (pair (machineDirectedLogParameterCode word) (machineDirectedLogParameterCode word)) +/-- Computes the tail-estimate denominator `1 - x^2` for the series parameter `x`. -/ def machineDirectedLogErrorDenominatorCode (word : List Bool) : List Bool := machineRawRatAddCode (pair rawRatOneCode (machineRawRatNegCode (machineDirectedLogParameterSquareCode word))) +/-- Computes the geometric tail expression `2 * x^(2*N+1) / (1 - x^2)`. -/ def machineDirectedLogSeriesErrorCode (word : List Bool) : List Bool := machineRawRatMulCode (pair rawRatTwoCode @@ -82,6 +96,7 @@ def machineDirectedLogSeriesErrorCode (word : List Bool) : List Bool := (pair (machineDirectedLogOddPowerCode word) (machineDirectedLogErrorDenominatorCode word)))) +/-- Adds the geometric tail expression to the unit-logarithm lower approximation. -/ def machineDirectedLogUnitUpperRawCode (word : List Bool) : List Bool := machineRawRatAddCode (pair (machineDirectedLogUnitLowerRawCode word) @@ -177,33 +192,43 @@ theorem machineDirectedLogUnitUpperRawCode_mem_FP : /-! ## Dyadic range reduction -/ +/-- Extracts the absolute numerator bits of the encoded logarithm argument. -/ def machineDirectedLogNumeratorAbsBits (word : List Bool) : List Bool := machineIntegerNatAbsBits (machinePairFirst (machineDirectedLogArgumentCode word)) +/-- Extracts the denominator bits of the encoded logarithm argument. -/ def machineDirectedLogDenominatorBits (word : List Bool) : List Bool := machinePairSecond (machineDirectedLogArgumentCode word) +/-- Drops one numerator bit to form the ruler for its binary logarithmic scale. -/ def machineDirectedLogNumeratorLogRuler (word : List Bool) : List Bool := (machineDirectedLogNumeratorAbsBits word).tail +/-- Drops one denominator bit to form the ruler for its binary logarithmic scale. -/ def machineDirectedLogDenominatorLogRuler (word : List Bool) : List Bool := (machineDirectedLogDenominatorBits word).tail +/-- Encodes the length of the numerator's logarithmic ruler in binary. -/ def machineDirectedLogNumeratorLogBits (word : List Bool) : List Bool := machineLengthBits (machineDirectedLogNumeratorLogRuler word) +/-- Encodes the length of the denominator's logarithmic ruler in binary. -/ def machineDirectedLogDenominatorLogBits (word : List Bool) : List Bool := machineLengthBits (machineDirectedLogDenominatorLogRuler word) +/-- Encodes the signed difference between numerator and denominator binary logarithmic scales. -/ def machineDirectedLogExponentIntegerCode (word : List Bool) : List Bool := machineIntegerAddCode (pair (machineNaturalIntegerCode (machineDirectedLogNumeratorLogBits word)) (machineIntegerNegCode (machineNaturalIntegerCode (machineDirectedLogDenominatorLogBits word)))) +/-- Encodes `2^ruler.length` as a binary natural number. -/ def machineDirectedLogPowerTwoBits (ruler : List Bool) : List Bool := List.replicate ruler.length false ++ [true] +/-- Encodes the ratio of the numerator and denominator powers of two used for logarithmic +scaling. -/ def machineDirectedLogScaleCode (word : List Bool) : List Bool := pair (machineNaturalIntegerCode @@ -212,28 +237,36 @@ def machineDirectedLogScaleCode (word : List Bool) : List Bool := (machineDirectedLogPowerTwoBits (machineDirectedLogDenominatorLogRuler word)) +/-- Divides the logarithm argument by its encoded power-of-two scale. -/ def machineDirectedLogResidualCode (word : List Bool) : List Bool := machineRawRatDivCode (pair (machineDirectedLogArgumentCode word) (machineDirectedLogScaleCode word)) +/-- Tests whether the scaled residual is at least one. -/ def machineDirectedLogResidualAtLeastOne (word : List Bool) : List Bool := machineRawRatLeBit (pair rawRatOneCode (machineDirectedLogResidualCode word)) +/-- Chooses the residual or its reciprocal according to whether the residual is at least one. -/ def machineDirectedLogUnitCode (word : List Bool) : List Bool := machineIfHead (machineDirectedLogResidualAtLeastOne word) (machineDirectedLogResidualCode word) (machineRawRatInvCode (machineDirectedLogResidualCode word)) +/-- Builds a logarithm-series query for two with the original series-length ruler. -/ def machineDirectedLogTwoInput (word : List Bool) : List Bool := pair (machineDirectedLogRuler word) rawRatTwoCode +/-- Builds a logarithm-series query for the chosen unit residual with the original ruler. -/ def machineDirectedLogUnitInput (word : List Bool) : List Bool := pair (machineDirectedLogRuler word) (machineDirectedLogUnitCode word) +/-- Encodes the signed binary scaling exponent as a raw rational with denominator one. -/ def machineDirectedLogExponentRawRatCode (word : List Bool) : List Bool := pair (machineDirectedLogExponentIntegerCode word) [true] +/-- Computes the lower approximation to the exponent times `log 2`, reversing bounds for +negative exponents. -/ def machineDirectedLogIntegerLowerCode (word : List Bool) : List Bool := let lo := machineDirectedLogUnitLowerRawCode (machineDirectedLogTwoInput word) let hi := machineDirectedLogUnitUpperRawCode (machineDirectedLogTwoInput word) @@ -242,6 +275,8 @@ def machineDirectedLogIntegerLowerCode (word : List Bool) : List Bool := machineRawRatMulCode (pair (machineDirectedLogExponentRawRatCode word) factor) +/-- Computes the upper approximation to the exponent times `log 2`, reversing bounds for +negative exponents. -/ def machineDirectedLogIntegerUpperCode (word : List Bool) : List Bool := let lo := machineDirectedLogUnitLowerRawCode (machineDirectedLogTwoInput word) let hi := machineDirectedLogUnitUpperRawCode (machineDirectedLogTwoInput word) @@ -250,31 +285,39 @@ def machineDirectedLogIntegerUpperCode (word : List Bool) : List Bool := machineRawRatMulCode (pair (machineDirectedLogExponentRawRatCode word) factor) +/-- Chooses the unit-log lower approximation or negated upper approximation for the residual +term. -/ def machineDirectedLogResidualLowerCode (word : List Bool) : List Bool := let lo := machineDirectedLogUnitLowerRawCode (machineDirectedLogUnitInput word) let hi := machineDirectedLogUnitUpperRawCode (machineDirectedLogUnitInput word) machineIfHead (machineDirectedLogResidualAtLeastOne word) lo (machineRawRatNegCode hi) +/-- Chooses the unit-log upper approximation or negated lower approximation for the residual +term. -/ def machineDirectedLogResidualUpperCode (word : List Bool) : List Bool := let lo := machineDirectedLogUnitLowerRawCode (machineDirectedLogUnitInput word) let hi := machineDirectedLogUnitUpperRawCode (machineDirectedLogUnitInput word) machineIfHead (machineDirectedLogResidualAtLeastOne word) hi (machineRawRatNegCode lo) +/-- Adds the scaling and residual lower approximations to encode a directed logarithm result. -/ def machineDirectedLogLowerRawCode (word : List Bool) : List Bool := machineRawRatAddCode (pair (machineDirectedLogIntegerLowerCode word) (machineDirectedLogResidualLowerCode word)) +/-- Adds the scaling and residual upper approximations to encode a directed logarithm result. -/ def machineDirectedLogUpperRawCode (word : List Bool) : List Bool := machineRawRatAddCode (pair (machineDirectedLogIntegerUpperCode word) (machineDirectedLogResidualUpperCode word)) +/-- Normalizes the raw lower logarithm approximation into canonical rational encoding. -/ def machineDirectedLogLowerCode (word : List Bool) : List Bool := machineNormalizeRawRatBinaryCode (machineDirectedLogLowerRawCode word) +/-- Normalizes the raw upper logarithm approximation into canonical rational encoding. -/ def machineDirectedLogUpperCode (word : List Bool) : List Bool := machineNormalizeRawRatBinaryCode (machineDirectedLogUpperRawCode word) @@ -462,16 +505,21 @@ theorem machineDirectedLogUpperCode_mem_FP : namespace RawRat +/-- The raw-rational series parameter `(y - 1) / (y + 1)` for logarithm evaluation. -/ def logUnitParameter (y : RawRat) : RawRat := (y.add one.neg).div (y.add one) +/-- Twice the truncated logarithmic series at the transformed argument. -/ def logUnitLower (y : RawRat) (N : ℕ) : RawRat := (ofNat 2).mul (logSeriesSum (logUnitParameter y) N) +/-- The raw-rational geometric tail expression `2 * x^(2*N+1) / (1 - x^2)` for the transformed +argument. -/ def logSeriesError (y : RawRat) (N : ℕ) : RawRat := let x := logUnitParameter y (ofNat 2).mul ((x.pow (2 * N + 1)).div (one.add (x.mul x).neg)) +/-- The unit-logarithm lower approximation plus its geometric tail expression. -/ def logUnitUpper (y : RawRat) (N : ℕ) : RawRat := (logUnitLower y N).add (logSeriesError y N) @@ -696,13 +744,18 @@ theorem machineDirectedLogDenominatorLogRuler_length namespace RawRat +/-- The ratio of powers of two determined by the binary logarithms of the numerator and +denominator. -/ def logScale (q : ℚ) : RawRat := ⟨(2 ^ binaryNatLog2 q.num.natAbs : ℕ), 2 ^ binaryNatLog2 q.den, by positivity⟩ +/-- The raw-rational residual obtained by dividing `q` by its power-of-two scale. -/ def logResidual (q : ℚ) : RawRat := (rawRatOfRat q).div (logScale q) +/-- Selects the scaled residual or its reciprocal according to whether the residual is at least +one. -/ def logUnit (q : ℚ) : RawRat := if 1 ≤ (logResidual q).value then logResidual q else (logResidual q).inv @@ -781,34 +834,45 @@ end RawRat namespace RawRat +/-- Embeds an integer as a raw rational with denominator one. -/ def ofInt (z : ℤ) : RawRat := ⟨z, 1, by omega⟩ @[simp] theorem value_ofInt (z : ℤ) : (ofInt z).value = z := by simp [ofInt, value] +/-- Approximates the binary exponent times `log 2` from below, with bound choice determined by +its sign. -/ def logIntegerLower (q : ℚ) (N : ℕ) : RawRat := let k := binaryRationalBinaryExponent q (ofInt k).mul (if 0 ≤ k then logUnitLower (ofNat 2) N else logUnitUpper (ofNat 2) N) +/-- Approximates the binary exponent times `log 2` from above, with bound choice determined by +its sign. -/ def logIntegerUpper (q : ℚ) (N : ℕ) : RawRat := let k := binaryRationalBinaryExponent q (ofInt k).mul (if 0 ≤ k then logUnitUpper (ofNat 2) N else logUnitLower (ofNat 2) N) +/-- Selects the unit-log lower approximation or negated upper approximation for the scaled +residual. -/ def logResidualLower (q : ℚ) (N : ℕ) : RawRat := if 1 ≤ (logResidual q).value then logUnitLower (logUnit q) N else (logUnitUpper (logUnit q) N).neg +/-- Selects the unit-log upper approximation or negated lower approximation for the scaled +residual. -/ def logResidualUpper (q : ℚ) (N : ℕ) : RawRat := if 1 ≤ (logResidual q).value then logUnitUpper (logUnit q) N else (logUnitLower (logUnit q) N).neg +/-- Adds the lower approximations for the binary scaling and residual logarithms. -/ def logLower (q : ℚ) (N : ℕ) : RawRat := (logIntegerLower q N).add (logResidualLower q N) +/-- Adds the upper approximations for the binary scaling and residual logarithms. -/ def logUpper (q : ℚ) (N : ℕ) : RawRat := (logIntegerUpper q N).add (logResidualUpper q N) diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedNegativeGradientCoordinate.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedNegativeGradientCoordinate.lean index cb40260a82..c88a1106f1 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedNegativeGradientCoordinate.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedNegativeGradientCoordinate.lean @@ -27,40 +27,49 @@ namespace BeyondBethe open Complexity +/-- Negates the directed upper approximation to the logarithm of the matrix coefficient. -/ def machineDirectedGradientCoordinateNegLogA (word : List Bool) : List Bool := machineRawRatNegCode (machineDirectedObjectiveCoordinateLogAUpper word) +/-- Multiplies the directed lower approximation to `log x` by `1 + tau`. -/ def machineDirectedGradientCoordinateScaledLogX (word : List Bool) : List Bool := machineRawRatMulCode (pair (machineDirectedObjectiveCoordinateOnePlusTau word) (machineDirectedObjectiveCoordinateLogXLower word)) +/-- Computes the directed lower logarithm approximation for the complementary coordinate `1 - +x`. -/ def machineDirectedGradientCoordinateLogComplementLower (word : List Bool) : List Bool := machineScheduledLogLowerRawCode (machineDirectedObjectiveCoordinateLogComplementInput word) +/-- Adds the negated coefficient logarithm and the scaled coordinate logarithm. -/ def machineDirectedGradientCoordinateFirstTwo (word : List Bool) : List Bool := machineRawRatAddCode (pair (machineDirectedGradientCoordinateNegLogA word) (machineDirectedGradientCoordinateScaledLogX word)) +/-- Adds the complementary-coordinate logarithm to the first two gradient terms. -/ def machineDirectedGradientCoordinateFirstThree (word : List Bool) : List Bool := machineRawRatAddCode (pair (machineDirectedGradientCoordinateFirstTwo word) (machineDirectedGradientCoordinateLogComplementLower word)) +/-- Computes the raw-rational constant term `2 + tau` in the negative-gradient formula. -/ def machineDirectedGradientCoordinateTwoPlusTau (word : List Bool) : List Bool := machineRawRatAddCode (pair (rawRatBinaryCode RawRat.one) (machineDirectedObjectiveCoordinateOnePlusTau word)) +/-- Combines the three directed logarithm terms with `2 + tau` into a negative-gradient +approximation. -/ def machineDirectedNegativeGradientLowerRawCode (word : List Bool) : List Bool := machineRawRatAddCode @@ -120,6 +129,8 @@ theorem machineDirectedNegativeGradientLowerRawCode_mem_FP : simpa only [machineDirectedNegativeGradientLowerRawCode] using! machineCompose_mem_FP hinput machineRawRatAddCode_mem_FP +/-- The raw formula `-logUpper(a) + (1+tau)*logLower(x) + logLower(1-x) + 2+tau` at precision +`p`. -/ def rawDirectedNegativeGradientLower (tau a x : ℚ) (p : ℕ) : RawRat := let rawTau := rawRatOfRat tau diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedNegativeGradientEntry.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedNegativeGradientEntry.lean index 9d22d03e94..537996579a 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedNegativeGradientEntry.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedNegativeGradientEntry.lean @@ -26,18 +26,25 @@ namespace BeyondBethe open Complexity +/-- Extracts the unary row index from a negative-gradient entry query. -/ def machineDirectedGradientEntryRow (word : List Bool) : List Bool := machinePairFirst word +/-- Extracts the column index and payload from a negative-gradient entry query. -/ def machineDirectedGradientEntryRest (word : List Bool) : List Bool := machinePairSecond word +/-- Extracts the unary column index from a negative-gradient entry query. -/ def machineDirectedGradientEntryColumn (word : List Bool) : List Bool := machinePairFirst (machineDirectedGradientEntryRest word) +/-- Extracts the encoded objective payload following the row and column of a gradient-entry +request. -/ def machineDirectedGradientEntryPayload (word : List Bool) : List Bool := machinePairSecond (machineDirectedGradientEntryRest word) +/-- Builds an objective-sum state for the requested gradient entry, with zero accumulator, empty +bound word, and an unset completion bit. -/ def machineDirectedGradientEntryAsObjectiveState (word : List Bool) : List Bool := machineDirectedObjectiveSumPack @@ -46,11 +53,15 @@ def machineDirectedGradientEntryAsObjectiveState (rawRatBinaryCode RawRat.zero) [] [false] (machineDirectedGradientEntryPayload word) +/-- Assembles precision, regularization parameter, matrix entry, and affine entry for the +requested gradient coordinate. -/ def machineDirectedGradientEntryScalarInput (word : List Bool) : List Bool := machineDirectedObjectiveSumCoordinateInput (machineDirectedGradientEntryAsObjectiveState word) +/-- Computes the encoded directed lower approximation to the negative gradient at the requested +matrix entry. -/ def machineDirectedNegativeGradientEntryRawCode (word : List Bool) : List Bool := machineDirectedNegativeGradientLowerRawCode @@ -105,6 +116,8 @@ theorem machineDirectedNegativeGradientEntryRawCode_mem_FP : machineCompose_mem_FP machineDirectedGradientEntryScalarInput_mem_FP machineDirectedNegativeGradientLowerRawCode_mem_FP +/-- Encodes row and column as unary rulers preceding the canonical objective payload for `tau`, +`A`, `y`, and precision `p`. -/ def machineDirectedGradientEntryCanonicalWord {m : ℕ} (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) (y : Fin (m * m) → ℚ) (p : ℕ) diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedNegativeObjectiveCoordinate.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedNegativeObjectiveCoordinate.lean index 5ff96e7318..df73485c8e 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedNegativeObjectiveCoordinate.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedNegativeObjectiveCoordinate.lean @@ -26,112 +26,144 @@ namespace BeyondBethe open Complexity +/-- Extracts the unary precision field from an objective-coordinate request. -/ def machineDirectedObjectiveCoordinatePrecision (word : List Bool) : List Bool := machinePairFirst word +/-- Extracts the objective-coordinate payload after its precision field. -/ def machineDirectedObjectiveCoordinateRest (word : List Bool) : List Bool := machinePairSecond word +/-- Extracts the encoded regularization parameter from an objective-coordinate request. -/ def machineDirectedObjectiveCoordinateTau (word : List Bool) : List Bool := machinePairFirst (machineDirectedObjectiveCoordinateRest word) +/-- Extracts the encoded matrix coefficient from an objective-coordinate request. -/ def machineDirectedObjectiveCoordinateA (word : List Bool) : List Bool := machinePairFirst (machinePairSecond (machineDirectedObjectiveCoordinateRest word)) +/-- Extracts the encoded affine coordinate from an objective-coordinate request. -/ def machineDirectedObjectiveCoordinateX (word : List Bool) : List Bool := machinePairSecond (machinePairSecond (machineDirectedObjectiveCoordinateRest word)) +/-- Computes the raw rational code for one minus the requested affine coordinate. -/ def machineDirectedObjectiveCoordinateComplementRaw (word : List Bool) : List Bool := machineRawRatSubCode (pair (rawRatBinaryCode RawRat.one) (machineDirectedObjectiveCoordinateX word)) +/-- Normalizes the raw code for the complement of the requested affine coordinate. -/ def machineDirectedObjectiveCoordinateComplement (word : List Bool) : List Bool := machineNormalizeRawRatEntryCode (machineDirectedObjectiveCoordinateComplementRaw word) +/-- Pairs the requested unary precision with the matrix coefficient for directed logarithm +evaluation. -/ def machineDirectedObjectiveCoordinateLogAInput (word : List Bool) : List Bool := pair (machineDirectedObjectiveCoordinatePrecision word) (machineDirectedObjectiveCoordinateA word) +/-- Pairs the requested unary precision with the affine coordinate for directed logarithm +evaluation. -/ def machineDirectedObjectiveCoordinateLogXInput (word : List Bool) : List Bool := pair (machineDirectedObjectiveCoordinatePrecision word) (machineDirectedObjectiveCoordinateX word) +/-- Pairs the requested unary precision with the normalized coordinate complement for directed +logarithm evaluation. -/ def machineDirectedObjectiveCoordinateLogComplementInput (word : List Bool) : List Bool := pair (machineDirectedObjectiveCoordinatePrecision word) (machineDirectedObjectiveCoordinateComplement word) +/-- Computes the encoded scheduled upper approximation to the logarithm of the matrix +coefficient. -/ def machineDirectedObjectiveCoordinateLogAUpper (word : List Bool) : List Bool := machineScheduledLogUpperRawCode (machineDirectedObjectiveCoordinateLogAInput word) +/-- Computes the encoded scheduled lower approximation to the logarithm of the affine +coordinate. -/ def machineDirectedObjectiveCoordinateLogXLower (word : List Bool) : List Bool := machineScheduledLogLowerRawCode (machineDirectedObjectiveCoordinateLogXInput word) +/-- Computes the encoded scheduled upper approximation to the logarithm of the coordinate +complement. -/ def machineDirectedObjectiveCoordinateLogComplementUpper (word : List Bool) : List Bool := machineScheduledLogUpperRawCode (machineDirectedObjectiveCoordinateLogComplementInput word) +/-- Negates the encoded affine coordinate for the first objective summand. -/ def machineDirectedObjectiveCoordinateNegX (word : List Bool) : List Bool := machineRawRatNegCode (machineDirectedObjectiveCoordinateX word) +/-- Computes the raw code for minus the affine coordinate times the upper logarithm +approximation of the matrix coefficient. -/ def machineDirectedObjectiveCoordinateFirstTerm (word : List Bool) : List Bool := machineRawRatMulCode (pair (machineDirectedObjectiveCoordinateNegX word) (machineDirectedObjectiveCoordinateLogAUpper word)) +/-- Computes the raw rational code for one plus the regularization parameter. -/ def machineDirectedObjectiveCoordinateOnePlusTau (word : List Bool) : List Bool := machineRawRatAddCode (pair (rawRatBinaryCode RawRat.one) (machineDirectedObjectiveCoordinateTau word)) +/-- Computes the raw code for the affine coordinate multiplied by one plus the regularization +parameter. -/ def machineDirectedObjectiveCoordinateMiddleScale (word : List Bool) : List Bool := machineRawRatMulCode (pair (machineDirectedObjectiveCoordinateOnePlusTau word) (machineDirectedObjectiveCoordinateX word)) +/-- Computes the middle objective summand by multiplying the scaled affine coordinate by its +lower logarithm approximation. -/ def machineDirectedObjectiveCoordinateMiddleTerm (word : List Bool) : List Bool := machineRawRatMulCode (pair (machineDirectedObjectiveCoordinateMiddleScale word) (machineDirectedObjectiveCoordinateLogXLower word)) +/-- Computes the raw code for the coordinate complement times its upper logarithm approximation. -/ def machineDirectedObjectiveCoordinateComplementProduct (word : List Bool) : List Bool := machineRawRatMulCode (pair (machineDirectedObjectiveCoordinateComplement word) (machineDirectedObjectiveCoordinateLogComplementUpper word)) +/-- Negates the complement-logarithm product to obtain the last objective summand. -/ def machineDirectedObjectiveCoordinateLastTerm (word : List Bool) : List Bool := machineRawRatNegCode (machineDirectedObjectiveCoordinateComplementProduct word) +/-- Adds the first and middle directed objective summands in raw rational code. -/ def machineDirectedObjectiveCoordinateFirstTwo (word : List Bool) : List Bool := machineRawRatAddCode (pair (machineDirectedObjectiveCoordinateFirstTerm word) (machineDirectedObjectiveCoordinateMiddleTerm word)) +/-- Adds all three directed summands to encode the lower approximation of one negative-objective +coordinate. -/ def machineDirectedNegativeObjectiveCoordinateLowerRawCode (word : List Bool) : List Bool := machineRawRatAddCode @@ -282,6 +314,8 @@ theorem machineDirectedNegativeObjectiveCoordinateLowerRawCode_mem_FP : simpa only [machineDirectedNegativeObjectiveCoordinateLowerRawCode] using! machineCompose_mem_FP hinput machineRawRatAddCode_mem_FP +/-- Encodes precision `p` as a unary ruler followed by the raw rational codes for `tau`, `a`, +and `x`. -/ def machineDirectedObjectiveCoordinateCanonicalWord (tau a x : ℚ) (p : ℕ) : List Bool := pair (List.replicate p true) @@ -289,6 +323,8 @@ def machineDirectedObjectiveCoordinateCanonicalWord (pair (rawRatBinaryCode (rawRatOfRat a)) (rawRatBinaryCode (rawRatOfRat x)))) +/-- Forms the raw rational expression `-x * logUpper(a) + (1 + tau) * x * logLower(x) - (1 - x) +* logUpper(1 - x)` at precision `p`. -/ def rawDirectedNegativeObjectiveCoordinateLower (tau a x : ℚ) (p : ℕ) : RawRat := let rawTau := rawRatOfRat tau diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedNegativeObjectiveSum.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedNegativeObjectiveSum.lean index 38fdd3b7b0..94692562df 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedNegativeObjectiveSum.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedNegativeObjectiveSum.lean @@ -40,102 +40,132 @@ open Complexity def machineDirectedObjectiveSumDimension (word : List Bool) : List Bool := machinePairFirst word +/-- Extracts the objective-sum input payload after its dimension field. -/ def machineDirectedObjectiveSumRest (word : List Bool) : List Bool := machinePairSecond word +/-- Extracts the unary precision field from an objective-sum input. -/ def machineDirectedObjectiveSumPrecision (word : List Bool) : List Bool := machinePairFirst (machineDirectedObjectiveSumRest word) +/-- Extracts the objective-sum payload after its dimension and precision fields. -/ def machineDirectedObjectiveSumAfterPrecision (word : List Bool) : List Bool := machinePairSecond (machineDirectedObjectiveSumRest word) +/-- Extracts the encoded regularization parameter from an objective-sum input. -/ def machineDirectedObjectiveSumTau (word : List Bool) : List Bool := machinePairFirst (machineDirectedObjectiveSumAfterPrecision word) +/-- Extracts the matrix-and-vector payload following the regularization parameter. -/ def machineDirectedObjectiveSumAfterTau (word : List Bool) : List Bool := machinePairSecond (machineDirectedObjectiveSumAfterPrecision word) +/-- Extracts the encoded matrix from an objective-sum input. -/ def machineDirectedObjectiveSumMatrix (word : List Bool) : List Bool := machinePairFirst (machineDirectedObjectiveSumAfterTau word) +/-- Extracts the encoded free-coordinate vector from an objective-sum input. -/ def machineDirectedObjectiveSumVector (word : List Bool) : List Bool := machinePairSecond (machineDirectedObjectiveSumAfterTau word) /-! ## Row-major state and one coordinate evaluation -/ +/-- Packs the row, column, accumulator, length bound, completion bit, and fixed payload into an +objective-sum state. -/ def machineDirectedObjectiveSumPack (row column acc bound done payload : List Bool) : List Bool := pair row (pair column (pair acc (pair bound (pair done payload)))) +/-- Extracts the unary row index from an objective-sum state. -/ def machineDirectedObjectiveSumRow (state : List Bool) : List Bool := machinePairFirst state +/-- Extracts the unary column index from an objective-sum state. -/ def machineDirectedObjectiveSumColumn (state : List Bool) : List Bool := machinePairFirst (machinePairSecond state) +/-- Extracts the accumulated raw rational code from an objective-sum state. -/ def machineDirectedObjectiveSumAcc (state : List Bool) : List Bool := machinePairFirst (machinePairSecond (machinePairSecond state)) +/-- Extracts the word whose length bounds objective-sum accumulator and index updates. -/ def machineDirectedObjectiveSumBound (state : List Bool) : List Bool := machinePairFirst (machinePairSecond (machinePairSecond (machinePairSecond state))) +/-- Extracts the completion-bit word from an objective-sum state. -/ def machineDirectedObjectiveSumDone (state : List Bool) : List Bool := machinePairFirst (machinePairSecond (machinePairSecond (machinePairSecond (machinePairSecond state)))) +/-- Extracts the fixed dimension, precision, parameter, matrix, and vector payload from an +objective-sum state. -/ def machineDirectedObjectiveSumPayload (state : List Bool) : List Bool := machinePairSecond (machinePairSecond (machinePairSecond (machinePairSecond (machinePairSecond state)))) +/-- Reads the unary dimension field from the fixed payload of an objective-sum state. -/ def machineDirectedObjectiveSumStateDimension (state : List Bool) : List Bool := machineDirectedObjectiveSumDimension (machineDirectedObjectiveSumPayload state) +/-- Reads the unary precision field from the fixed payload of an objective-sum state. -/ def machineDirectedObjectiveSumStatePrecision (state : List Bool) : List Bool := machineDirectedObjectiveSumPrecision (machineDirectedObjectiveSumPayload state) +/-- Reads the encoded regularization parameter from the fixed payload of an objective-sum state. -/ def machineDirectedObjectiveSumStateTau (state : List Bool) : List Bool := machineDirectedObjectiveSumTau (machineDirectedObjectiveSumPayload state) +/-- Reads the encoded matrix from the fixed payload of an objective-sum state. -/ def machineDirectedObjectiveSumStateMatrix (state : List Bool) : List Bool := machineDirectedObjectiveSumMatrix (machineDirectedObjectiveSumPayload state) +/-- Reads the encoded free-coordinate vector from the fixed payload of an objective-sum state. -/ def machineDirectedObjectiveSumStateVector (state : List Bool) : List Bool := machineDirectedObjectiveSumVector (machineDirectedObjectiveSumPayload state) +/-- Tests whether the current unary row ruler equals the dimension ruler, identifying the final +matrix row on canonical states. -/ def machineDirectedObjectiveSumLastRowBit (state : List Bool) : List Bool := machineUnaryRulersEqualBit (machineDirectedObjectiveSumRow state) (machineDirectedObjectiveSumStateDimension state) +/-- Tests whether the current unary column ruler equals the dimension ruler, identifying the +final matrix column on canonical states. -/ def machineDirectedObjectiveSumLastColumnBit (state : List Bool) : List Bool := machineUnaryRulersEqualBit (machineDirectedObjectiveSumColumn state) (machineDirectedObjectiveSumStateDimension state) +/-- Pairs the current row and column rulers with the encoded matrix to request one matrix +coefficient. -/ def machineDirectedObjectiveSumMatrixEntryInput (state : List Bool) : List Bool := pair (machineDirectedObjectiveSumRow state) (pair (machineDirectedObjectiveSumColumn state) (machineDirectedObjectiveSumStateMatrix state)) +/-- Looks up the current matrix coefficient and normalizes its raw rational code. -/ def machineDirectedObjectiveSumMatrixEntryRaw (state : List Bool) : List Bool := machineNormalizeRawRatEntryCode (machineMatrixEntryAtUnary (machineDirectedObjectiveSumMatrixEntryInput state)) +/-- Packages the dimension, current row and column, and free-coordinate vector for affine-entry +evaluation. -/ def machineDirectedObjectiveSumAffineEntryInput (state : List Bool) : List Bool := pair (machineDirectedObjectiveSumStateDimension state) @@ -143,12 +173,15 @@ def machineDirectedObjectiveSumAffineEntryInput (pair (machineDirectedObjectiveSumColumn state) (machineDirectedObjectiveSumStateVector state))) +/-- Evaluates the current affine matrix entry and normalizes its raw rational code. -/ def machineDirectedObjectiveSumAffineEntryRaw (state : List Bool) : List Bool := machineNormalizeRawRatEntryCode (machineBetheAffineEntryRawCode (machineDirectedObjectiveSumAffineEntryInput state)) +/-- Packages the precision, regularization parameter, normalized matrix coefficient, and +normalized affine entry for one objective summand. -/ def machineDirectedObjectiveSumCoordinateInput (state : List Bool) : List Bool := pair (machineDirectedObjectiveSumStatePrecision state) @@ -156,28 +189,36 @@ def machineDirectedObjectiveSumCoordinateInput (pair (machineDirectedObjectiveSumMatrixEntryRaw state) (machineDirectedObjectiveSumAffineEntryRaw state))) +/-- Computes the directed lower approximation of the negative-objective summand at the current +row and column. -/ def machineDirectedObjectiveSumCoordinateRawCode (state : List Bool) : List Bool := machineDirectedNegativeObjectiveCoordinateLowerRawCode (machineDirectedObjectiveSumCoordinateInput state) +/-- Adds the current directed objective summand to the accumulated raw rational code. -/ def machineDirectedObjectiveSumCandidate (state : List Bool) : List Bool := machineRawRatAddCode (pair (machineDirectedObjectiveSumAcc state) (machineDirectedObjectiveSumCoordinateRawCode state)) +/-- Truncates the updated accumulator to the length of the state bound word. -/ def machineDirectedObjectiveSumNextAcc (state : List Bool) : List Bool := (machineDirectedObjectiveSumCandidate state).take (machineDirectedObjectiveSumBound state).length +/-- Increments the unary row ruler and truncates it to the length of the state bound word. -/ def machineDirectedObjectiveSumNextRow (state : List Bool) : List Bool := (machineDirectedObjectiveSumRow state ++ [true]).take (machineDirectedObjectiveSumBound state).length +/-- Increments the unary column ruler and truncates it to the length of the state bound word. -/ def machineDirectedObjectiveSumNextColumn (state : List Bool) : List Bool := (machineDirectedObjectiveSumColumn state ++ [true]).take (machineDirectedObjectiveSumBound state).length +/-- Includes the current summand in the bounded accumulator and marks the objective scan +complete, retaining its final indices. -/ def machineDirectedObjectiveSumFinish (state : List Bool) : List Bool := machineDirectedObjectiveSumPack (machineDirectedObjectiveSumRow state) @@ -186,6 +227,8 @@ def machineDirectedObjectiveSumFinish (state : List Bool) : List Bool := (machineDirectedObjectiveSumBound state) [true] (machineDirectedObjectiveSumPayload state) +/-- Includes the current summand, advances the row, and resets the column ruler for the next +row. -/ def machineDirectedObjectiveSumAdvanceRow (state : List Bool) : List Bool := machineDirectedObjectiveSumPack (machineDirectedObjectiveSumNextRow state) [] @@ -194,6 +237,8 @@ def machineDirectedObjectiveSumAdvanceRow (state : List Bool) : List Bool := (machineDirectedObjectiveSumDone state) (machineDirectedObjectiveSumPayload state) +/-- Includes the current summand and advances the column while retaining the current row and +fixed payload. -/ def machineDirectedObjectiveSumAdvanceColumn (state : List Bool) : List Bool := machineDirectedObjectiveSumPack @@ -204,6 +249,8 @@ def machineDirectedObjectiveSumAdvanceColumn (machineDirectedObjectiveSumDone state) (machineDirectedObjectiveSumPayload state) +/-- Processes one matrix entry, finishing at the last row and column, advancing rows at other +row ends, and otherwise advancing the column. -/ def machineDirectedObjectiveSumProcess (state : List Bool) : List Bool := machineIfHead (machineHeadBit (machineDirectedObjectiveSumLastColumnBit state)) @@ -213,20 +260,27 @@ def machineDirectedObjectiveSumProcess (state : List Bool) : List Bool := (machineDirectedObjectiveSumAdvanceRow state)) (machineDirectedObjectiveSumAdvanceColumn state) +/-- Leaves completed objective-sum states unchanged and otherwise processes one matrix entry. -/ def machineDirectedObjectiveSumStep (state : List Bool) : List Bool := machineIfHead (machineHeadBit (machineDirectedObjectiveSumDone state)) state (machineDirectedObjectiveSumProcess state) /-! ## Explicit iteration and state bounds -/ +/-- Builds the accumulator length-bound word by applying the binary-width construction six times +to the input. -/ def machineDirectedObjectiveSumAccumulatorBound (word : List Bool) : List Bool := machineIteratedBinaryWidth 6 word +/-- Builds a common field envelope by applying the binary-width construction seven times to the +input. -/ def machineDirectedObjectiveSumStateEnvelope (word : List Bool) : List Bool := machineIteratedBinaryWidth 7 word +/-- Initializes the objective scan at row and column zero with a zero raw accumulator, its +computed bound, and an unset completion bit. -/ def machineDirectedObjectiveSumInit (word : List Bool) : List Bool := machineDirectedObjectiveSumPack [] [] (rawRatBinaryCode RawRat.zero) @@ -237,15 +291,18 @@ for `(m+1)^2`; it depends only on the first component of the word. -/ def machineDirectedObjectiveSumRuler (word : List Bool) : List Bool := machineBetheFloorScanRuler word +/-- Packs six copies of the common field envelope to bound the encoded objective-sum state. -/ def machineDirectedObjectiveSumWidth (word : List Bool) : List Bool := let envelope := machineDirectedObjectiveSumStateEnvelope word machineDirectedObjectiveSumPack envelope envelope envelope envelope envelope envelope +/-- Iterates the bounded objective scan for the number of steps specified by its scan ruler. -/ def machineDirectedObjectiveSumFinalState (word : List Bool) : List Bool := (machineDirectedObjectiveSumStep)^[(machineDirectedObjectiveSumRuler word).length] (machineDirectedObjectiveSumInit word) +/-- Extracts the encoded raw accumulator after the scheduled objective-sum iteration. -/ def machineDirectedNegativeObjectiveSumRawCode (word : List Bool) : List Bool := machineDirectedObjectiveSumAcc @@ -569,6 +626,8 @@ theorem machineDirectedObjectiveSumWidth_mem_FP : payload := by simp [machineDirectedObjectiveSumPayload, machineDirectedObjectiveSumPack] +/-- Requires a correctly packed scan state with bounded row, column, and accumulator lengths, +the prescribed bound and payload, and at most one completion bit. -/ def MachineDirectedObjectiveSumStateBound (word state : List Bool) : Prop := state = machineDirectedObjectiveSumPack @@ -791,6 +850,8 @@ theorem machineDirectedNegativeObjectiveSumRawCode_mem_FP : /-! ## Canonical inputs and exact coordinate semantics -/ +/-- Encodes dimension `m`, precision `p`, regularization parameter, the `(m + 1)` square matrix, +and the free-coordinate vector for the objective scan. -/ def machineDirectedObjectiveSumCanonicalWord {m : ℕ} (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) (y : Fin (m * m) → ℚ) (p : ℕ) : List Bool := @@ -854,6 +915,8 @@ def machineDirectedObjectiveSumCanonicalWord {m : ℕ} machineDirectedObjectiveSumRest, machineDirectedObjectiveSumCanonicalWord] +/-- Encodes a semantic scan position, raw accumulator, completion flag, and bound together with +the fixed objective payload. -/ def machineDirectedObjectiveSumCanonicalState {m : ℕ} (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) (y : Fin (m * m) → ℚ) (p : ℕ) @@ -1138,6 +1201,8 @@ theorem machineDirectedObjectiveSumWork_le_guard {m : ℕ} /-! ## Typed row-major semantics -/ +/-- Evaluates the raw directed negative-objective summand using matrix coefficient `A i j` and +the corresponding affine entry of `y`. -/ def rawDirectedBetheObjectiveCoordinate {m : ℕ} (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) (y : Fin (m * m) → ℚ) (p : ℕ) @@ -1145,6 +1210,8 @@ def rawDirectedBetheObjectiveCoordinate {m : ℕ} rawDirectedNegativeObjectiveCoordinateLower tau (A i j) (betheAffineMatrixQ y i j) p +/-- Bounds a raw directed coordinate expression by adding the widths of its inputs and three +logarithm approximations, counting the coordinate width twice. -/ def rawDirectedNegativeObjectiveCoordinateWidthBudget (tau a x : ℚ) (p : ℕ) : ℕ := 2 * rawRatWidth (rawRatOfRat x) + @@ -1369,6 +1436,7 @@ theorem rawBetheAffineTotal_width_le_word {m : ℕ} 1 + m * m * (L + 1) := hsum.trans (by omega) simpa only [values, L] using! hfinal +/-- Provides the polynomial affine-entry width budget `m * m * (L + 1) + m + L + 8`. -/ def rawBetheAffineEntryWidthBudget (m L : ℕ) : ℕ := m * m * (L + 1) + m + L + 8 @@ -1457,16 +1525,22 @@ theorem rawBetheAffineMatrixQ_width_le_word {m : ℕ} (machineDirectedObjectiveSumCanonicalWord tau A y p).length := by omega +/-- Provides the encoded coordinate budget `20 + 12 * rawBetheAffineEntryWidthBudget m L`. -/ def rawDirectedObjectiveCoordinateWordXBudget (m L : ℕ) : ℕ := 20 + 12 * rawBetheAffineEntryWidthBudget m L +/-- Provides the encoded complement budget by scaling the coordinate budget by twelve and adding +forty-four. -/ def rawDirectedObjectiveCoordinateWordComplementBudget (m L : ℕ) : ℕ := 44 + 12 * rawDirectedObjectiveCoordinateWordXBudget m L +/-- Provides the polynomial scheduled-logarithm word budget `64 * (L + 2 * W + 4)^2 * (W + 2)`. -/ def rawScheduledLogWordBudget (L W : ℕ) : ℕ := 64 * (L + 2 * W + 4) ^ 2 * (W + 2) +/-- Combines coordinate, complement, parameter, and three scheduled-logarithm budgets into a +bound for one encoded objective summand. -/ def rawDirectedObjectiveCoordinateWordBudget (m L : ℕ) : ℕ := let WX := rawDirectedObjectiveCoordinateWordXBudget m L let WC := rawDirectedObjectiveCoordinateWordComplementBudget m L @@ -1527,11 +1601,17 @@ theorem rawDirectedBetheObjectiveCoordinate_width_le_word_budget {m : ℕ} WX, WC, L, x] using! hfinal structure DirectedObjectiveSumSemanticState (m : ℕ) where + /-- The current matrix row of the semantic objective scan. -/ row : Fin (m + 1) + /-- The current matrix column of the semantic objective scan. -/ column : Fin (m + 1) + /-- The raw rational accumulator of the semantic objective scan. -/ acc : RawRat + /-- Whether the semantic objective scan has included its last matrix entry. -/ done : Bool +/-- Initializes the semantic scan at the first matrix entry with zero accumulator and an unset +completion flag. -/ def directedObjectiveSumSemanticInit (m : ℕ) : DirectedObjectiveSumSemanticState m where row := ⟨0, by omega⟩ @@ -1539,6 +1619,8 @@ def directedObjectiveSumSemanticInit (m : ℕ) : acc := RawRat.zero done := false +/-- Adds one directed objective summand and advances in row-major order, setting the completion +flag after the final entry and fixing completed states. -/ def directedObjectiveSumSemanticStep {m : ℕ} (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) (y : Fin (m * m) → ℚ) (p : ℕ) @@ -1590,6 +1672,7 @@ theorem directedObjectiveSumSemanticStep_acc_width {m B C : ℕ} · simpa [directedObjectiveSumSemanticStep] using! hacc.trans (by omega) +/-- Encodes a semantic objective-sum state with the supplied bound and fixed problem parameters. -/ def machineDirectedObjectiveSumSemanticCode {m : ℕ} (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) (y : Fin (m * m) → ℚ) (p : ℕ) (bound : List Bool) @@ -1907,6 +1990,7 @@ theorem machineDirectedObjectiveSumStep_semanticCode {m : ℕ} machineDirectedObjectiveSumCanonicalState, directedObjectiveSumSemanticInit] +/-- Runs the semantic objective scan for `(m + 1)^2` steps, one per matrix entry. -/ def finalDirectedObjectiveSumSemanticState {m : ℕ} (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) (y : Fin (m * m) → ℚ) (p : ℕ) : @@ -1914,6 +1998,7 @@ def finalDirectedObjectiveSumSemanticState {m : ℕ} (directedObjectiveSumSemanticStep tau A y p)^[(m + 1) * (m + 1)] (directedObjectiveSumSemanticInit m) +/-- Runs the semantic objective scan for exactly `k` steps from its initial state. -/ def directedObjectiveSumSemanticStateAt {m : ℕ} (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) (y : Fin (m * m) → ℚ) (p k : ℕ) : @@ -2229,6 +2314,7 @@ theorem machineDirectedObjectiveSumFinalState_encode_of_large {m : ℕ} simpa only [directedObjectiveSumSemanticStateAt, finalDirectedObjectiveSumSemanticState] using! hiterate +/-- Returns the raw rational accumulator after scanning all matrix entries. -/ def rawDirectedNegativeObjectiveSum {m : ℕ} (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) (y : Fin (m * m) → ℚ) (p : ℕ) : RawRat := @@ -2265,6 +2351,7 @@ theorem machineDirectedNegativeObjectiveSumRawCode_encode_of_large {m : ℕ} /-! ## Mathematical value of the row-major sum -/ +/-- Evaluates the rational directed negative-objective summand at a pair of matrix indices. -/ def directedNegativeObjectivePairValue {m : ℕ} (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) (y : Fin (m * m) → ℚ) (p : ℕ) @@ -2272,6 +2359,8 @@ def directedNegativeObjectivePairValue {m : ℕ} directedNegativeObjectiveCoordinateLower tau (A ij.1 ij.2) (betheAffineMatrixQ y ij.1 ij.2) p +/-- Sums the directed negative-objective summands whose row-major scan ordinals are less than +`k`. -/ def directedNegativeObjectivePrefix {m : ℕ} (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) (y : Fin (m * m) → ℚ) (p k : ℕ) : ℚ := @@ -2349,6 +2438,8 @@ theorem directedNegativeObjectivePrefix_full {m : ℕ} Fintype.sum_prod_type] rfl +/-- Relates a completed scan to the full directed objective sum, or an unfinished scan at +ordinal `k` to the corresponding prefix sum. -/ def DirectedObjectiveSumValueInvariant {m : ℕ} (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) (y : Fin (m * m) → ℚ) (p k : ℕ) diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedTransferCost.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedTransferCost.lean index 77d88c3108..ff059a6bc5 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedTransferCost.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineDirectedTransferCost.lean @@ -23,64 +23,84 @@ namespace BeyondBethe open Complexity +/-- Extracts the unary row ruler from a directed transfer-cost request. -/ def machineTransferRowRuler (word : List Bool) : List Bool := machinePairFirst word +/-- Extracts the transfer-cost payload following its row ruler. -/ def machineTransferRest (word : List Bool) : List Bool := machinePairSecond word +/-- Extracts the unary column ruler from a directed transfer-cost request. -/ def machineTransferColumnRuler (word : List Bool) : List Bool := machinePairFirst (machineTransferRest word) +/-- Extracts the optimizer input following the requested transfer row and column. -/ def machineTransferOptimizerWord (word : List Bool) : List Bool := machinePairSecond (machineTransferRest word) +/-- Reads the encoded matrix from the optimizer input of a transfer-cost request. -/ def machineTransferMatrixWord (word : List Bool) : List Bool := machineOptimizerMatrixWord (machineTransferOptimizerWord word) +/-- Looks up the encoded matrix coefficient at the transfer request's row and column. -/ def machineTransferEntryCode (word : List Bool) : List Bool := machineMatrixEntryAtUnary (pair (machineTransferRowRuler word) (pair (machineTransferColumnRuler word) (machineTransferMatrixWord word))) +/-- Packages the certificate precision, zero reference value, and selected coefficient for +complement evaluation. -/ def machineTransferComplementInput (word : List Bool) : List Bool := pair (machineCertificateLogPrecisionRuler (machineTransferOptimizerWord word)) (pair (rawRatBinaryCode RawRat.zero) (machineTransferEntryCode word)) +/-- Computes the encoded complement of the selected transfer coefficient through the +nearby-coordinate complement machine. -/ def machineTransferComplementCode (word : List Bool) : List Bool := machineNearbyCoordinateComplementCode (machineTransferComplementInput word) +/-- Computes the raw scheduled lower logarithm approximation of the selected transfer +coefficient at certificate precision. -/ def machineTransferLogXRawCode (word : List Bool) : List Bool := machineScheduledLogLowerRawCode (pair (machineCertificateLogPrecisionRuler (machineTransferOptimizerWord word)) (machineTransferEntryCode word)) +/-- Computes the raw scheduled lower logarithm approximation of the selected coefficient's +complement at certificate precision. -/ def machineTransferLogComplementRawCode (word : List Bool) : List Bool := machineScheduledLogLowerRawCode (pair (machineCertificateLogPrecisionRuler (machineTransferOptimizerWord word)) (machineTransferComplementCode word)) +/-- Computes the raw code for one plus the certificate regularization scale. -/ def machineTransferOnePlusTauRawCode (word : List Bool) : List Bool := machineRawRatAddCode (pair rawRatOneCode (machineCertificateRegularizationScaleRawCode (machineTransferOptimizerWord word))) +/-- Multiplies the lower logarithm approximation of the selected coefficient by one plus the +regularization scale. -/ def machineTransferWeightedLogXRawCode (word : List Bool) : List Bool := machineRawRatMulCode (pair (machineTransferOnePlusTauRawCode word) (machineTransferLogXRawCode word)) +/-- Adds the negated weighted coefficient logarithm and negated complement logarithm for the +distinguished transfer entry. -/ def machineTransferNegativeDistinguishedRawCode (word : List Bool) : List Bool := machineRawRatAddCode (pair (machineRawRatNegCode (machineTransferWeightedLogXRawCode word)) (machineRawRatNegCode (machineTransferLogComplementRawCode word))) +/-- Computes the directed upper sum of complement terms along the selected matrix row. -/ def machineTransferRowUpperRawCode (word : List Bool) : List Bool := machineRowComplementUpperSumRawCode (pair (machineTransferRowRuler word) @@ -190,6 +210,8 @@ theorem machineDirectedTransferCostUpperRawCode_mem_FP : simpa only [machineDirectedTransferCostUpperRawCode] using! machineCompose_mem_FP hinput machineRawRatAddCode_mem_FP +/-- Forms the raw upper transfer-cost expression from the negated distinguished logarithm terms +and the directed upper complement sum over row `i`. -/ def rawDirectedTransferCostUpper {n : ℕ} (X : Matrix (Fin n) (Fin n) ℚ) (i j : Fin n) : RawRat := let p := directedCertificatePrecision n diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineDyadicFloor.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineDyadicFloor.lean index a661f0381b..693c7becf6 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineDyadicFloor.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineDyadicFloor.lean @@ -25,12 +25,16 @@ namespace BeyondBethe open Complexity +/-- Extracts the unary precision ruler from a dyadic-rounding request. -/ def machineDyadicPrecisionRuler (word : List Bool) : List Bool := machinePairFirst word +/-- Extracts the raw rational code from a dyadic-rounding request. -/ def machineDyadicRawCode (word : List Bool) : List Bool := machinePairSecond word +/-- Extracts the signed numerator code from the raw rational payload of a dyadic-rounding +request. -/ def machineDyadicNumeratorCode (word : List Bool) : List Bool := machinePairFirst (machineDyadicRawCode word) From 2c3297525f1245fd3482059c6dd9e71fc8139558 Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Fri, 25 Sep 2026 20:07:39 +0000 Subject: [PATCH 24/49] Document rounding, matching, and matrix machine contracts --- .../BeyondBethe/MachineDyadicFloor.lean | 21 ++++++ .../BeyondBethe/MachineDyadicFloorMatrix.lean | 21 ++++++ .../BeyondBethe/MachineDyadicFloorVector.lean | 20 ++++++ .../MachineExecutableCertificate.lean | 2 + .../MachineExecutablePositiveAlgorithm.lean | 8 +++ ...chineExecutableScannedOptimizerOutput.lean | 53 +++++++++++++++ .../MachineExplicitCertificate.lean | 1 + .../BeyondBethe/MachineFactorial.lean | 20 ++++++ .../BeyondBethe/MachineFourCoreCost.lean | 18 +++++ .../BeyondBethe/MachineGreedyRowMatching.lean | 66 +++++++++++++++++++ .../BeyondBethe/MachineIntegerArithmetic.lean | 19 ++++++ .../BeyondBethe/MachineIntegerCompare.lean | 8 +++ .../MachineIntegerSignedMagnitude.lean | 3 + .../BeyondBethe/MachineKuhnEncoding.lean | 62 +++++++++++++++++ .../BeyondBethe/MachineKuhnInvariant.lean | 6 ++ .../BeyondBethe/MachineKuhnRunner.lean | 20 ++++++ .../BeyondBethe/MachineKuhnStep.lean | 61 +++++++++++++++++ .../BeyondBethe/MachineLengthBits.lean | 3 + .../BeyondBethe/MachineListIndex.lean | 3 + .../BeyondBethe/MachineListReverse.lean | 19 ++++++ .../BeyondBethe/MachineListUpdate.lean | 45 +++++++++++++ .../BeyondBethe/MachineMatchingGain.lean | 21 ++++++ .../BeyondBethe/MachineMateAllSome.lean | 18 +++++ .../BeyondBethe/MachineMateMemory.lean | 5 ++ .../BeyondBethe/MachineMatrixAddDelta.lean | 29 ++++++++ .../BeyondBethe/MachineMatrixDimension.lean | 1 + .../BeyondBethe/MachineMatrixNonnegative.lean | 18 +++++ .../MachineMatrixNormalization.lean | 2 + .../MachineMatrixNormalizeEntries.lean | 23 +++++++ .../BeyondBethe/MachineMatrixSum.lean | 13 ++++ 30 files changed, 609 insertions(+) diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineDyadicFloor.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineDyadicFloor.lean index 693c7becf6..eee2f534f3 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineDyadicFloor.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineDyadicFloor.lean @@ -38,52 +38,70 @@ request. -/ def machineDyadicNumeratorCode (word : List Bool) : List Bool := machinePairFirst (machineDyadicRawCode word) +/-- Extracts the denominator bits from the raw rational payload of a dyadic-rounding request. -/ def machineDyadicDenominatorBits (word : List Bool) : List Bool := machinePairSecond (machineDyadicRawCode word) +/-- Reads the sign bit of the encoded numerator in a dyadic-rounding request. -/ def machineDyadicNumeratorSign (word : List Bool) : List Bool := machineHeadBit (machineDyadicNumeratorCode word) +/-- Computes the binary absolute value of the numerator in a dyadic-rounding request. -/ def machineDyadicNumeratorAbsBits (word : List Bool) : List Bool := machineIntegerNatAbsBits (machineDyadicNumeratorCode word) +/-- Builds a zero-bit word whose length equals the requested unary precision. -/ def machineDyadicPrecisionZeroBits (word : List Bool) : List Bool := List.replicate (machineDyadicPrecisionRuler word).length false +/-- Scales the numerator magnitude by the requested power of two using leading low-order zero +bits, preserving the empty zero encoding. -/ def machineDyadicScaledAbsBits (word : List Bool) : List Bool := machineIfEmpty (machineDyadicNumeratorAbsBits word) [] (machineDyadicPrecisionZeroBits word ++ machineDyadicNumeratorAbsBits word) +/-- Divides the scaled numerator magnitude by the denominator and returns the encoded +quotient-remainder pair. -/ def machineDyadicDivModBits (word : List Bool) : List Bool := machineBinaryDivModBits (pair (machineDyadicScaledAbsBits word) (machineDyadicDenominatorBits word)) +/-- Extracts the binary quotient from scaled numerator division. -/ def machineDyadicQuotientBits (word : List Bool) : List Bool := machinePairFirst (machineDyadicDivModBits word) +/-- Extracts the binary remainder from scaled numerator division. -/ def machineDyadicRemainderBits (word : List Bool) : List Bool := machinePairSecond (machineDyadicDivModBits word) +/-- Adds one to the binary quotient from scaled numerator division. -/ def machineDyadicQuotientSuccBits (word : List Bool) : List Bool := machineBinaryAddBits (pair (machineDyadicQuotientBits word) [true]) +/-- Uses the quotient magnitude for exact negative division and its successor when a nonzero +remainder requires rounding downward. -/ def machineDyadicNegativeFloorAbsBits (word : List Bool) : List Bool := machineIfEmpty (machineDyadicRemainderBits word) (machineDyadicQuotientBits word) (machineDyadicQuotientSuccBits word) +/-- Selects the adjusted negative magnitude or ordinary quotient according to the numerator +sign. -/ def machineDyadicFloorAbsBits (word : List Bool) : List Bool := machineIfHead (machineDyadicNumeratorSign word) (machineDyadicNegativeFloorAbsBits word) (machineDyadicQuotientBits word) +/-- Combines the original numerator sign and the selected floor magnitude into a canonical +integer code. -/ def machineDyadicFloorIntegerCode (word : List Bool) : List Bool := machineCanonicalIntegerFromSignedAbs (pair (machineDyadicNumeratorSign word) (machineDyadicFloorAbsBits word)) +/-- Encodes the denominator `2^p` as `p` low-order zero bits followed by one. -/ def machineDyadicPowerDenominatorBits (word : List Bool) : List Bool := machineDyadicPrecisionZeroBits word ++ [true] @@ -215,6 +233,8 @@ private theorem shiftedNatBits (n p : ℕ) : · rw [ite_eq_right (natBits_ne_nil_of_ne_zero hn), natBits_mul_pow_two_of_ne_zero n p hn] +/-- Computes the integer floor of the scaled raw rational using binary long division, increasing +the negative magnitude when the remainder is nonzero. -/ def binaryRawDyadicFloorInt (p : ℕ) (q : RawRat) : ℤ := let qr := binaryLongDiv (q.num.natAbs * 2 ^ p) q.den match q.num with @@ -223,6 +243,7 @@ def binaryRawDyadicFloorInt (p : ℕ) (q : RawRat) : ℤ := if qr.2 = 0 then -(qr.1 : ℤ) else -((qr.1 + 1 : ℕ) : ℤ) +/-- Pairs the binary-computed floor of `2^p * q` with the positive denominator `2^p`. -/ def binaryRawDyadicFloor (p : ℕ) (q : RawRat) : RawRat := ⟨binaryRawDyadicFloorInt p q, 2 ^ p, by positivity⟩ diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineDyadicFloorMatrix.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineDyadicFloorMatrix.lean index 5e3dd4413b..61687e7e98 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineDyadicFloorMatrix.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineDyadicFloorMatrix.lean @@ -21,6 +21,7 @@ namespace BeyondBethe open Complexity +/-- Encodes unary precision `p` followed by the rows of the rational square matrix to round. -/ def dyadicFloorMatrixCanonicalWord {d : ℕ} (p : ℕ) (A : Matrix (Fin d) (Fin d) ℚ) : List Bool := pair (List.replicate p true) (rationalSquareMatrixRowsCode A) @@ -59,6 +60,7 @@ theorem dyadicFloorMatrix_entry_code_length_le {d : ℕ} binaryDyadicFloor_eq_dyadicFloor, rawRatOfRat_value] at hcanonical exact hcanonical.trans (by nlinarith) +/-- Reuses the rational transpose-vector input bound to bound the dyadic matrix scan. -/ def machineDyadicFloorMatrixInputBound (word : List Bool) : List Bool := machineRationalTransposeMulVectorInputBound word @@ -170,27 +172,35 @@ theorem dyadicFloorMatrix_code_length_le_bound {d : ℕ} /-! ## Bounded outer row scan -/ +/-- Extracts the unary rounding precision from a dyadic matrix request. -/ def machineDyadicFloorMatrixPrecision (word : List Bool) : List Bool := machinePairFirst word +/-- Extracts the encoded matrix rows from a dyadic matrix request. -/ def machineDyadicFloorMatrixRows (word : List Bool) : List Bool := machinePairSecond word +/-- Rounds every entry of the next unprocessed matrix row using the precision stored in the scan +payload. -/ def machineDyadicFloorMatrixCurrentRow (state : List Bool) : List Bool := machineDyadicFloorVectorCode (pair (machineRationalTransposeMulVectorStatePayload state) (machineListHead (machineRationalTransposeMulVectorRemaining state))) +/-- Prepends the newly rounded row to the encoded reverse-order accumulator. -/ def machineDyadicFloorMatrixCandidate (state : List Bool) : List Bool := pair (machineDyadicFloorMatrixCurrentRow state) (machineRationalTransposeMulVectorAccumulator state) +/-- Truncates the candidate row accumulator to the length of the scan bound word. -/ def machineDyadicFloorMatrixNextAccumulator (state : List Bool) : List Bool := (machineDyadicFloorMatrixCandidate state).take (machineRationalTransposeMulVectorBound state).length +/-- Drops the processed matrix row and stores the bounded updated accumulator while preserving +precision and bound. -/ def machineDyadicFloorMatrixAdvance (state : List Bool) : List Bool := machineRationalTransposeMulVectorPack (machineListTail (machineRationalTransposeMulVectorRemaining state)) @@ -198,28 +208,35 @@ def machineDyadicFloorMatrixAdvance (state : List Bool) : List Bool := (machineRationalTransposeMulVectorStatePayload state) (machineRationalTransposeMulVectorBound state) +/-- Fixes a matrix scan with no remaining rows and otherwise processes its next row. -/ def machineDyadicFloorMatrixStep (state : List Bool) : List Bool := machineIfEmpty (machineRationalTransposeMulVectorRemaining state) state (machineDyadicFloorMatrixAdvance state) +/-- Initializes the matrix scan with all input rows, an empty accumulator, the requested +precision, and its input bound. -/ def machineDyadicFloorMatrixInit (word : List Bool) : List Bool := machineRationalTransposeMulVectorPack (machineDyadicFloorMatrixRows word) [] (machineDyadicFloorMatrixPrecision word) (machineDyadicFloorMatrixInputBound word) +/-- Packs four copies of the input bound to bound the encoded matrix scan state. -/ def machineDyadicFloorMatrixWidth (word : List Bool) : List Bool := let bound := machineDyadicFloorMatrixInputBound word machineRationalTransposeMulVectorPack bound bound bound bound +/-- Runs the dyadic matrix scan for as many steps as there are bits in the input word. -/ def machineDyadicFloorMatrixFinalState (word : List Bool) : List Bool := (machineDyadicFloorMatrixStep)^[word.length] (machineDyadicFloorMatrixInit word) +/-- Extracts the reversed encoded rounded rows from the final matrix scan state. -/ def machineDyadicFloorMatrixReversedCode (word : List Bool) : List Bool := machineRationalTransposeMulVectorAccumulator (machineDyadicFloorMatrixFinalState word) +/-- Reverses the accumulated rounded rows to recover the original matrix row order. -/ def machineDyadicFloorMatrixCode (word : List Bool) : List Bool := machineListReverse (machineDyadicFloorMatrixReversedCode word) @@ -364,11 +381,15 @@ theorem machineDyadicFloorMatrixCode_mem_FP : /-! ## Exact scan semantics -/ +/-- Takes the first `k` rational matrix rows and applies dyadic floor at precision `p` to every +entry. -/ def dyadicFloorMatrixRowsPrefix {d : ℕ} (p : ℕ) (A : Matrix (Fin d) (Fin d) ℚ) (k : ℕ) : List (List ℚ) := (rationalMatrixRows A).take k |>.map (List.map (dyadicFloor p)) +/-- Encodes the remaining matrix rows and reversed rounded prefix after `k` rows, retaining the +canonical precision and input bound. -/ def machineDyadicFloorMatrixSemanticState {d : ℕ} (p : ℕ) (A : Matrix (Fin d) (Fin d) ℚ) (k : ℕ) : List Bool := let word := dyadicFloorMatrixCanonicalWord p A diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineDyadicFloorVector.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineDyadicFloorVector.lean index 75b84e3a6a..ba13817b68 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineDyadicFloorVector.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineDyadicFloorVector.lean @@ -24,6 +24,7 @@ namespace BeyondBethe open Complexity +/-- Normalizes the raw dyadic-floor result to obtain the rational entry encoding. -/ def machineDyadicFloorEntryCode (word : List Bool) : List Bool := machineNormalizeRawRatEntryCode (machineRawDyadicFloorCode word) @@ -81,6 +82,7 @@ theorem binaryRawDyadicFloor_width_le refine max_le (by simpa only [w] using! hfloorSize) ?_ omega +/-- Encodes unary precision `p` followed by the rational vector to round. -/ def dyadicFloorVectorCanonicalWord {d : ℕ} (p : ℕ) (v : Fin d → ℚ) : List Bool := pair (List.replicate p true) (rationalFiniteVectorCode v) @@ -116,6 +118,7 @@ theorem dyadicFloorVector_entry_code_length_le {d : ℕ} binaryDyadicFloor_eq_dyadicFloor, rawRatOfRat_value] at hcanonical exact hcanonical.trans (by nlinarith) +/-- Reuses the rational transpose-vector input bound to bound the dyadic vector scan. -/ def machineDyadicFloorVectorInputBound (word : List Bool) : List Bool := machineRationalTransposeMulVectorInputBound word @@ -164,12 +167,15 @@ theorem dyadicFloorVector_code_length_le_bound {d : ℕ} /-! ## Bounded encoded-list scan -/ +/-- Extracts the unary rounding precision from a dyadic vector request. -/ def machineDyadicFloorVectorPrecision (word : List Bool) : List Bool := machinePairFirst word +/-- Extracts the encoded entries from a dyadic vector request. -/ def machineDyadicFloorVectorEntries (word : List Bool) : List Bool := machinePairSecond word +/-- Rounds the next unprocessed vector entry using the precision stored in the scan payload. -/ def machineDyadicFloorVectorCurrentEntry (state : List Bool) : List Bool := machineDyadicFloorEntryCode @@ -177,15 +183,19 @@ def machineDyadicFloorVectorCurrentEntry (machineListHead (machineRationalTransposeMulVectorRemaining state))) +/-- Prepends the newly rounded entry to the encoded reverse-order accumulator. -/ def machineDyadicFloorVectorCandidate (state : List Bool) : List Bool := pair (machineDyadicFloorVectorCurrentEntry state) (machineRationalTransposeMulVectorAccumulator state) +/-- Truncates the candidate entry accumulator to the length of the scan bound word. -/ def machineDyadicFloorVectorNextAccumulator (state : List Bool) : List Bool := (machineDyadicFloorVectorCandidate state).take (machineRationalTransposeMulVectorBound state).length +/-- Drops the processed vector entry and stores the bounded updated accumulator while preserving +precision and bound. -/ def machineDyadicFloorVectorAdvance (state : List Bool) : List Bool := machineRationalTransposeMulVectorPack (machineListTail (machineRationalTransposeMulVectorRemaining state)) @@ -193,28 +203,35 @@ def machineDyadicFloorVectorAdvance (state : List Bool) : List Bool := (machineRationalTransposeMulVectorStatePayload state) (machineRationalTransposeMulVectorBound state) +/-- Fixes a vector scan with no remaining entries and otherwise processes its next entry. -/ def machineDyadicFloorVectorStep (state : List Bool) : List Bool := machineIfEmpty (machineRationalTransposeMulVectorRemaining state) state (machineDyadicFloorVectorAdvance state) +/-- Initializes the vector scan with all input entries, an empty accumulator, the requested +precision, and its input bound. -/ def machineDyadicFloorVectorInit (word : List Bool) : List Bool := machineRationalTransposeMulVectorPack (machineDyadicFloorVectorEntries word) [] (machineDyadicFloorVectorPrecision word) (machineDyadicFloorVectorInputBound word) +/-- Packs four copies of the input bound to bound the encoded vector scan state. -/ def machineDyadicFloorVectorWidth (word : List Bool) : List Bool := let bound := machineDyadicFloorVectorInputBound word machineRationalTransposeMulVectorPack bound bound bound bound +/-- Runs the dyadic vector scan for as many steps as there are bits in the input word. -/ def machineDyadicFloorVectorFinalState (word : List Bool) : List Bool := (machineDyadicFloorVectorStep)^[word.length] (machineDyadicFloorVectorInit word) +/-- Extracts the reversed encoded rounded entries from the final vector scan state. -/ def machineDyadicFloorVectorReversedCode (word : List Bool) : List Bool := machineRationalTransposeMulVectorAccumulator (machineDyadicFloorVectorFinalState word) +/-- Reverses the accumulated rounded entries to recover the original vector order. -/ def machineDyadicFloorVectorCode (word : List Bool) : List Bool := machineListReverse (machineDyadicFloorVectorReversedCode word) @@ -359,10 +376,13 @@ theorem machineDyadicFloorVectorCode_mem_FP : /-! ## Exact scan semantics -/ +/-- Takes the first `k` vector entries and applies dyadic floor at precision `p` to each. -/ def dyadicFloorVectorPrefix {d : ℕ} (p : ℕ) (v : Fin d → ℚ) (k : ℕ) : List ℚ := (List.ofFn v).take k |>.map (dyadicFloor p) +/-- Encodes the remaining vector entries and reversed rounded prefix after `k` entries, +retaining the canonical precision and input bound. -/ def machineDyadicFloorVectorSemanticState {d : ℕ} (p : ℕ) (v : Fin d → ℚ) (k : ℕ) : List Bool := let word := dyadicFloorVectorCanonicalWord p v diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineExecutableCertificate.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineExecutableCertificate.lean index 812659a02d..56b27d64d7 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineExecutableCertificate.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineExecutableCertificate.lean @@ -83,6 +83,8 @@ def ExecutableCertificateEvaluatorStringRealizesOnPositiveNormalized (executableScannedBetheOptimizerRowPotential (m := m + 1) B) (executableScannedBetheOptimizerColumnPotential (m := m + 1) B))) +/-- Instantiates the certificate-value machine with the explicit matching-gain code and +executable exponential guard. -/ def machineExecutableCertificateValueRawCode : List Bool → List Bool := machineCertificateValueRawCode machineExplicitMatchingGainRawCode machineOptimizerCertificateExpGuard diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineExecutablePositiveAlgorithm.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineExecutablePositiveAlgorithm.lean index 5c267ee2c8..e351f34eed 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineExecutablePositiveAlgorithm.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineExecutablePositiveAlgorithm.lean @@ -24,6 +24,8 @@ namespace BeyondBethe open Complexity +/-- Returns zero in dimensions zero and one; in larger dimensions evaluates the directed +certificate using the executable scanned optimizer matrix and its row and column potentials. -/ def executableNormalizedCertificateAlgorithm : ∀ n, Matrix (Fin n) (Fin n) ℚ → ℚ | 0, _ => 0 @@ -34,6 +36,8 @@ def executableNormalizedCertificateAlgorithm : (executableScannedBetheOptimizerRowPotential (m := m + 1) B) (executableScannedBetheOptimizerColumnPotential (m := m + 1) B) +/-- Requires a string function to return the exact raw code of the normalized certificate +algorithm on every positive matrix of dimension at least two with entries at most one. -/ def ExecutableNormalizedCertificateStringRealizesOnPositive (F : List Bool → List Bool) : Prop := ∀ (m : ℕ) (B : Matrix (Fin (m + 2)) (Fin (m + 2)) ℚ), @@ -42,6 +46,8 @@ def ExecutableNormalizedCertificateStringRealizesOnPositive rawRatBinaryCode (rawRatOfRat (executableNormalizedCertificateAlgorithm (m + 2) B)) +/-- Combines the executable scanned optimizer output with the executable certificate-value +machine to produce a normalized certificate code. -/ def machineExecutableNormalizedCertificateRawCode : List Bool → List Bool := machineNormalizedCertificateFromParts machineExecutableScannedOptimizerOutputCode @@ -143,6 +149,8 @@ theorem machinePositiveAlgorithmRawCode_realizes_executable_onPositive exact machineExecutablePositiveLargeRawCode_encode_onPositive hrealizes m A hA +/-- Instantiates the positive-matrix algorithm machine with the executable normalized +certificate code. -/ def machineExecutablePositiveAlgorithmRawCode : List Bool → List Bool := machinePositiveAlgorithmRawCode machineExecutableNormalizedCertificateRawCode diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineExecutableScannedOptimizerOutput.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineExecutableScannedOptimizerOutput.lean index a2a61dda12..aaca43eb16 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineExecutableScannedOptimizerOutput.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineExecutableScannedOptimizerOutput.lean @@ -29,31 +29,40 @@ open Complexity /-! ## A normalized recovered-matrix entry -/ +/-- Extracts the unary row ruler from an executable affine matrix-entry request. -/ def machineExecutableMatrixEntryRow (word : List Bool) : List Bool := machinePairFirst word +/-- Extracts the payload following the row ruler of an executable matrix-entry request. -/ def machineExecutableMatrixEntryRest (word : List Bool) : List Bool := machinePairSecond word +/-- Extracts the unary column ruler from an executable matrix-entry request. -/ def machineExecutableMatrixEntryColumn (word : List Bool) : List Bool := machinePairFirst (machineExecutableMatrixEntryRest word) +/-- Extracts the base dimension and point payload following the requested matrix indices. -/ def machineExecutableMatrixEntryPayload (word : List Bool) : List Bool := machinePairSecond (machineExecutableMatrixEntryRest word) +/-- Extracts the base-dimension ruler from an executable matrix-entry payload. -/ def machineExecutableMatrixEntryBaseDimension (word : List Bool) : List Bool := machinePairFirst (machineExecutableMatrixEntryPayload word) +/-- Extracts the encoded free-coordinate point from an executable matrix-entry payload. -/ def machineExecutableMatrixEntryPoint (word : List Bool) : List Bool := machinePairSecond (machineExecutableMatrixEntryPayload word) +/-- Reorders the base dimension, row, column, and point into the input layout expected by the +affine-entry machine. -/ def machineExecutableMatrixEntryRawInput (word : List Bool) : List Bool := pair (machineExecutableMatrixEntryBaseDimension word) (pair (machineExecutableMatrixEntryRow word) (pair (machineExecutableMatrixEntryColumn word) (machineExecutableMatrixEntryPoint word))) +/-- Evaluates the requested affine matrix entry and normalizes its raw rational code. -/ def machineExecutableMatrixEntryCode (word : List Bool) : List Bool := machineNormalizeRawRatEntryCode (machineBetheAffineEntryRawCode @@ -131,18 +140,24 @@ theorem machineExecutableMatrixEntryCode_mem_FP : /-! ## Uniform matrix-output program -/ +/-- Removes one element from the matrix dimension ruler to obtain the optimizer base dimension. -/ def machineExecutableOptimizerBaseDimensionUnary (word : List Bool) : List Bool := (machineMatrixDimensionUnary word).tail +/-- Runs the explicit Bethe optimizer point machine on the input matrix word. -/ def machineExecutableOptimizerPointCode (word : List Bool) : List Bool := machineExplicitBetheOptimizerPointCode word +/-- Drops the final encoded coordinate from the optimizer point to obtain the base point used +for affine matrix reconstruction. -/ def machineExecutableOptimizerBasePointCode (word : List Bool) : List Bool := machineBinaryListInit (machineExecutableOptimizerPointCode word) +/-- Packages the affine dimension ruler and optimizer base-point vector for matrix +reconstruction. -/ def machineExecutableOptimizerMatrixPayload (word : List Bool) : List Bool := pair (machineExecutableOptimizerBaseDimensionUnary word) @@ -157,23 +172,28 @@ def machineExecutableOptimizerMatrixSeed (pair [] (pair (rawRatBinaryCode (rawRatOfRat 0)) (pair word (machineExecutableOptimizerBasePointCode word)))) +/-- Bounds reconstructed matrix entries by twice expanding a seed padded with 1024 bits. -/ def machineExecutableOptimizerMatrixBound (word : List Bool) : List Bool := machineIteratedBinaryWidth 2 (machineExecutableOptimizerMatrixSeed word ++ List.replicate 1024 false) +/-- Packages the matrix-order ruler, entry bound, and reconstruction payload for matrix +generation. -/ def machineExecutableOptimizerMatrixGeneratorInput (word : List Bool) : List Bool := pair (machineMatrixDimensionUnary word) (pair (machineExecutableOptimizerMatrixBound word) (machineExecutableOptimizerMatrixPayload word)) +/-- Generates the encoded rows of the optimizer's reconstructed matrix. -/ def machineExecutableOptimizerMatrixRowsCode (word : List Bool) : List Bool := machineUnaryMatrixGeneratorRowsCode machineExecutableMatrixEntryCode (machineExecutableOptimizerMatrixGeneratorInput word) +/-- Pairs the binary matrix dimension with the generated matrix rows. -/ def machineExecutableOptimizerMatrixCode (word : List Bool) : List Bool := pair (machineMatrixDimensionWord word) @@ -459,34 +479,45 @@ column, and then the immutable directed-objective seed. -/ def machineExecutablePotentialIndex (word : List Bool) : List Bool := machinePairFirst (machinePairSecond word) +/-- Extracts the objective-evaluation payload from a potential-entry query. -/ def machineExecutablePotentialPayload (word : List Bool) : List Bool := machinePairSecond (machinePairSecond word) +/-- Builds a gradient-entry query from supplied row and column extractors and the common +payload. -/ def machineExecutablePotentialGradientInput (row column : List Bool → List Bool) (word : List Bool) : List Bool := pair (row word) (pair (column word) (machineExecutablePotentialPayload word)) +/-- Queries the negative gradient at the requested row and column zero for row-potential +recovery. -/ def machineExecutableRowPotentialGradientInput (word : List Bool) : List Bool := machineExecutablePotentialGradientInput machineExecutablePotentialIndex (fun _ => []) word +/-- Queries the negative gradient at row zero and the requested column for column-potential +recovery. -/ def machineExecutableColumnPotentialGradientInput (word : List Bool) : List Bool := machineExecutablePotentialGradientInput (fun _ => []) machineExecutablePotentialIndex word +/-- Queries the negative gradient at matrix entry `(0, 0)`. -/ def machineExecutableOriginGradientInput (word : List Bool) : List Bool := machineExecutablePotentialGradientInput (fun _ => []) (fun _ => []) word +/-- Computes the encoded constant `2 + tau` from the potential-evaluation payload. -/ def machineExecutableTwoPlusTauRawCode (word : List Bool) : List Bool := machineRawRatAddCode (pair (rawRatBinaryCode rawOptimizerTwo) (machineDirectedObjectiveSumTau (machineExecutablePotentialPayload word))) +/-- Computes the raw row potential as `2 + tau` minus the directed gradient value in column +zero. -/ def machineExecutableRowPotentialRawCode (word : List Bool) : List Bool := machineRawRatAddCode (pair @@ -495,6 +526,7 @@ def machineExecutableRowPotentialRawCode (word : List Bool) : List Bool := (machineExecutableRowPotentialGradientInput word))) (machineExecutableTwoPlusTauRawCode word)) +/-- Computes the raw column potential as the origin gradient minus the gradient in row zero. -/ def machineExecutableColumnPotentialRawCode (word : List Bool) : List Bool := machineRawRatSubCode (pair @@ -503,10 +535,12 @@ def machineExecutableColumnPotentialRawCode (word : List Bool) : List Bool := (machineDirectedNegativeGradientEntryRawCode (machineExecutableColumnPotentialGradientInput word))) +/-- Normalizes a raw row potential into a rational vector-entry code. -/ def machineExecutableRowPotentialEntryCode (word : List Bool) : List Bool := machineNormalizeRawRatEntryCode (machineExecutableRowPotentialRawCode word) +/-- Normalizes a raw column potential into a rational vector-entry code. -/ def machineExecutableColumnPotentialEntryCode (word : List Bool) : List Bool := machineNormalizeRawRatEntryCode (machineExecutableColumnPotentialRawCode word) @@ -699,10 +733,13 @@ theorem machineExecutableColumnPotentialEntryCode_mem_FP : /-! ## Canonical directed-gradient seed -/ +/-- Normalizes the optimizer's regularization parameter into a rational entry code. -/ def machineExecutableOptimizerTauCanonicalCode (word : List Bool) : List Bool := machineNormalizeRawRatEntryCode (machineOptimizerTauRawCode word) +/-- Packages dimension, precision, regularization, source matrix, and base point for gradient +evaluation. -/ def machineExecutableOptimizerGradientSeed (word : List Bool) : List Bool := pair (machineExecutableOptimizerBaseDimensionUnary word) @@ -772,34 +809,41 @@ theorem machineExecutableOptimizerGradientSeed_mem_FP : /-! ## Bounded repeated-row generators for the potential vectors -/ +/-- Bounds potential entries by six width expansions of a gradient seed padded with 4096 bits. -/ def machineExecutableOptimizerPotentialBound (word : List Bool) : List Bool := machineIteratedBinaryWidth 6 (machineExecutableOptimizerGradientSeed word ++ List.replicate 4096 false) +/-- Packages the matrix-order ruler, potential-width bound, and gradient seed for potential +generation. -/ def machineExecutableOptimizerPotentialGeneratorInput (word : List Bool) : List Bool := pair (machineMatrixDimensionUnary word) (pair (machineExecutableOptimizerPotentialBound word) (machineExecutableOptimizerGradientSeed word)) +/-- Generates encoded rows using the row-potential entry evaluator. -/ def machineExecutableOptimizerRowPotentialRowsCode (word : List Bool) : List Bool := machineUnaryMatrixGeneratorRowsCode machineExecutableRowPotentialEntryCode (machineExecutableOptimizerPotentialGeneratorInput word) +/-- Generates encoded rows using the column-potential entry evaluator. -/ def machineExecutableOptimizerColumnPotentialRowsCode (word : List Bool) : List Bool := machineUnaryMatrixGeneratorRowsCode machineExecutableColumnPotentialEntryCode (machineExecutableOptimizerPotentialGeneratorInput word) +/-- Extracts the first generated row as the encoded vector of row potentials. -/ def machineExecutableOptimizerRowPotentialCode (word : List Bool) : List Bool := machineListHead (machineExecutableOptimizerRowPotentialRowsCode word) +/-- Extracts the first generated row as the encoded vector of column potentials. -/ def machineExecutableOptimizerColumnPotentialCode (word : List Bool) : List Bool := machineListHead (machineExecutableOptimizerColumnPotentialRowsCode word) @@ -850,6 +894,8 @@ theorem machineExecutableOptimizerColumnPotentialCode_mem_FP : /-! ## Ordinary bit bounds for the potential output -/ +/-- The raw row potential `2 + tau - G(i,0)` obtained from the directed negative-gradient +approximation. -/ def rawExecutableRowPotential {m : ℕ} (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) (y : Fin (m * m) → ℚ) (p : ℕ) (i : Fin (m + 1)) : RawRat := @@ -857,6 +903,8 @@ def rawExecutableRowPotential {m : ℕ} (betheAffineMatrixQ y i 0) p).neg.add (rawOptimizerTwo.add (rawRatOfRat tau)) +/-- The raw column potential `G(0,0) - G(0,j)` obtained from the directed negative-gradient +approximation. -/ def rawExecutableColumnPotential {m : ℕ} (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) (y : Fin (m * m) → ℚ) (p : ℕ) (j : Fin (m + 1)) : RawRat := @@ -1214,6 +1262,8 @@ theorem executableColumnPotential_rowsCode_fits_bound {m : ℕ} /-! ## Complete optimizer output word -/ +/-- Collects the scanned optimizer's matrix, row potentials, and column potentials into one +output. -/ def executableScannedOptimizerOutput {m : ℕ} (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) : RationalOptimizerOutput (m + 1) where @@ -1221,6 +1271,7 @@ def executableScannedOptimizerOutput {m : ℕ} rowPotential := executableScannedBetheOptimizerRowPotential A columnPotential := executableScannedBetheOptimizerColumnPotential A +/-- Encodes the executable scanned optimizer's matrix and both potential vectors. -/ def machineExecutableScannedOptimizerOutputCode (word : List Bool) : List Bool := pair (machineExecutableOptimizerMatrixCode word) @@ -1252,6 +1303,8 @@ def executableLargeOptimizerOutput (m : ℕ) RationalOptimizerOutput (m + 2) := executableScannedOptimizerOutput (m := m + 1) B +/-- Requires a string function to encode the specified optimizer output on positive matrices of +order at least two. -/ def ExecutableLargeOptimizerStringRealizes (F : List Bool → List Bool) : Prop := ∀ (m : ℕ) (B : Matrix (Fin (m + 2)) (Fin (m + 2)) ℚ), diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineExplicitCertificate.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineExplicitCertificate.lean index 999455e1bf..9eef639dc8 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineExplicitCertificate.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineExplicitCertificate.lean @@ -21,6 +21,7 @@ guard. namespace BeyondBethe +/-- The explicit certificate evaluator using the matching gain and bounded exponential guard. -/ def machineExplicitCertificateValueRawCode : List Bool → List Bool := machineCertificateValueRawCode machineExplicitMatchingGainRawCode machineOptimizerCertificateExpGuard diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineFactorial.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineFactorial.lean index e64afaf3fc..b7efc812a0 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineFactorial.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineFactorial.lean @@ -23,53 +23,69 @@ namespace BeyondBethe open Complexity +/-- Encodes factorial state as accumulated product, next factor, and width bound. -/ def machineFactorialPack (acc next bound : List Bool) : List Bool := pair acc (pair next bound) +/-- Extracts the accumulated product from a factorial state. -/ def machineFactorialAcc (state : List Bool) : List Bool := machinePairFirst state +/-- Extracts the next factor from a factorial state. -/ def machineFactorialNext (state : List Bool) : List Bool := machinePairFirst (machinePairSecond state) +/-- Extracts the width-bound ruler stored in a factorial state. -/ def machineFactorialBound (state : List Bool) : List Bool := machinePairSecond (machinePairSecond state) +/-- Increments the next factorial factor in binary. -/ def machineFactorialSuccessor (state : List Bool) : List Bool := machineBinaryAddBits (pair (machineFactorialNext state) (1 : ℕ).bits) +/-- Multiplies the accumulated product by the next factorial factor. -/ def machineFactorialCandidate (state : List Bool) : List Bool := machineBinaryMulBits (pair (machineFactorialAcc state) (machineFactorialNext state)) +/-- Truncates the candidate factorial product to the stored width bound. -/ def machineFactorialNextAcc (state : List Bool) : List Bool := (machineFactorialCandidate state).take (machineFactorialBound state).length +/-- Truncates the incremented factorial counter to the stored width bound. -/ def machineFactorialNextCounter (state : List Bool) : List Bool := (machineFactorialSuccessor state).take (machineFactorialBound state).length +/-- Updates the bounded factorial product and counter while retaining the width ruler. -/ def machineFactorialStep (state : List Bool) : List Bool := machineFactorialPack (machineFactorialNextAcc state) (machineFactorialNextCounter state) (machineFactorialBound state) +/-- Uses the binary-multiplication width constructor to bound factorial state components. -/ def machineFactorialInputBound (ruler : List Bool) : List Bool := machineBinaryMulWidth ruler +/-- Initializes the factorial accumulator and next factor to one with the input-derived width +bound. -/ def machineFactorialInit (ruler : List Bool) : List Bool := machineFactorialPack (1 : ℕ).bits (1 : ℕ).bits (machineFactorialInputBound ruler) +/-- Packs three copies of the input bound to bound the encoded factorial state. -/ def machineFactorialWidth (ruler : List Bool) : List Bool := let bound := machineFactorialInputBound ruler machineFactorialPack bound bound bound +/-- Runs one factorial step per bit of the unary input ruler. -/ def machineFactorialFinalState (ruler : List Bool) : List Bool := (machineFactorialStep)^[ruler.length] (machineFactorialInit ruler) +/-- Extracts the factorial accumulator after all ruler-specified iterations. -/ def machineFactorialBits (ruler : List Bool) : List Bool := machineFactorialAcc (machineFactorialFinalState ruler) +/-- Encodes the final factorial accumulator as a nonnegative raw rational with denominator one. -/ def machineFactorialRawRatCode (ruler : List Bool) : List Bool := pair (false :: machineFactorialBits ruler) (1 : ℕ).bits @@ -146,6 +162,8 @@ theorem machineFactorialWidth_mem_FP : machineFactorialBound (machineFactorialPack acc next bound) = bound := by simp [machineFactorialBound, machineFactorialPack] +/-- Bounds all three components of a canonically packed factorial state by the input-derived +width. -/ def MachineFactorialStateBound (ruler state : List Bool) : Prop := let B := (machineFactorialInputBound ruler).length state = machineFactorialPack (machineFactorialAcc state) @@ -258,6 +276,8 @@ theorem factorial_counter_bits_length_le_bound {n k : ℕ} rw [hlength] exact hbits.trans <| by nlinarith +/-- Encodes the semantic state after `k` factorial steps, with product `k!` and next factor `k + +1`. -/ def machineFactorialSemanticState (n k : ℕ) : List Bool := machineFactorialPack k.factorial.bits (k + 1).bits (machineFactorialInputBound (List.replicate n true)) diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineFourCoreCost.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineFourCoreCost.lean index deb2afb15c..e9f6601479 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineFourCoreCost.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineFourCoreCost.lean @@ -23,34 +23,44 @@ namespace BeyondBethe open Complexity +/-- Extracts the unary first-row index from a four-core cost query. -/ def machineFourCoreFirstRowRuler (word : List Bool) : List Bool := machinePairFirst word +/-- Extracts the four-core query payload following the first-row index. -/ def machineFourCoreRest₁ (word : List Bool) : List Bool := machinePairSecond word +/-- Extracts the unary second-row index from a four-core cost query. -/ def machineFourCoreSecondRowRuler (word : List Bool) : List Bool := machinePairFirst (machineFourCoreRest₁ word) +/-- Extracts the four-core query payload following both row indices. -/ def machineFourCoreRest₂ (word : List Bool) : List Bool := machinePairSecond (machineFourCoreRest₁ word) +/-- Extracts the unary first-column index from a four-core cost query. -/ def machineFourCoreFirstColumnRuler (word : List Bool) : List Bool := machinePairFirst (machineFourCoreRest₂ word) +/-- Extracts the four-core query payload following the first-column index. -/ def machineFourCoreRest₃ (word : List Bool) : List Bool := machinePairSecond (machineFourCoreRest₂ word) +/-- Extracts the unary second-column index from a four-core cost query. -/ def machineFourCoreSecondColumnRuler (word : List Bool) : List Bool := machinePairFirst (machineFourCoreRest₃ word) +/-- Extracts the optimizer matrix and potentials from the four-core query. -/ def machineFourCoreOptimizerWord (word : List Bool) : List Bool := machinePairSecond (machineFourCoreRest₃ word) +/-- Packages a row index, column index, and optimizer result for transfer-cost evaluation. -/ def machineFourCoreTransferInput (row column optimizer : List Bool) : List Bool := pair row (pair column optimizer) +/-- Computes the directed transfer-cost upper approximation at the first row and first column. -/ def machineFourCoreRACostRawCode (word : List Bool) : List Bool := machineDirectedTransferCostUpperRawCode (machineFourCoreTransferInput @@ -58,6 +68,7 @@ def machineFourCoreRACostRawCode (word : List Bool) : List Bool := (machineFourCoreFirstColumnRuler word) (machineFourCoreOptimizerWord word)) +/-- Computes the directed transfer-cost upper approximation at the first row and second column. -/ def machineFourCoreRBCostRawCode (word : List Bool) : List Bool := machineDirectedTransferCostUpperRawCode (machineFourCoreTransferInput @@ -65,6 +76,7 @@ def machineFourCoreRBCostRawCode (word : List Bool) : List Bool := (machineFourCoreSecondColumnRuler word) (machineFourCoreOptimizerWord word)) +/-- Computes the directed transfer-cost upper approximation at the second row and first column. -/ def machineFourCoreSACostRawCode (word : List Bool) : List Bool := machineDirectedTransferCostUpperRawCode (machineFourCoreTransferInput @@ -72,6 +84,7 @@ def machineFourCoreSACostRawCode (word : List Bool) : List Bool := (machineFourCoreFirstColumnRuler word) (machineFourCoreOptimizerWord word)) +/-- Computes the directed transfer-cost upper approximation at the second row and second column. -/ def machineFourCoreSBCostRawCode (word : List Bool) : List Bool := machineDirectedTransferCostUpperRawCode (machineFourCoreTransferInput @@ -79,11 +92,13 @@ def machineFourCoreSBCostRawCode (word : List Bool) : List Bool := (machineFourCoreSecondColumnRuler word) (machineFourCoreOptimizerWord word)) +/-- Adds the two directed transfer-cost approximations in the first selected row. -/ def machineFourCoreFirstRowSumRawCode (word : List Bool) : List Bool := machineRawRatAddCode (pair (machineFourCoreRACostRawCode word) (machineFourCoreRBCostRawCode word)) +/-- Adds the two directed transfer-cost approximations in the second selected row. -/ def machineFourCoreSecondRowSumRawCode (word : List Bool) : List Bool := machineRawRatAddCode (pair (machineFourCoreSACostRawCode word) @@ -190,6 +205,7 @@ theorem machineDirectedFourCoreCostUpperRawCode_mem_FP : simpa only [machineDirectedFourCoreCostUpperRawCode] using! machineCompose_mem_FP hinput machineRawRatAddCode_mem_FP +/-- Adds the four raw directed transfer-cost approximations at the selected row-column corners. -/ def rawDirectedFourCoreCostUpper {n : ℕ} (X : Matrix (Fin n) (Fin n) ℚ) (r s a b : Fin n) : RawRat := ((rawDirectedTransferCostUpper X r a).add @@ -197,6 +213,8 @@ def rawDirectedFourCoreCostUpper {n : ℕ} ((rawDirectedTransferCostUpper X s a).add (rawDirectedTransferCostUpper X s b)) +/-- Encodes four unary indices together with a matrix and its potentials for four-core +evaluation. -/ def fourCoreMachineInput {n : ℕ} (X : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℚ) (r s a b : Fin n) : List Bool := diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineGreedyRowMatching.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineGreedyRowMatching.lean index 7d3cc7bf3e..58bc902e36 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineGreedyRowMatching.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineGreedyRowMatching.lean @@ -23,12 +23,15 @@ namespace BeyondBethe open Complexity +/-- Extracts the matrix-dimension ruler from the optimizer result for greedy row matching. -/ def machineMatchingDimensionRuler (optimizer : List Bool) : List Bool := machineCertificateDimensionUnary optimizer +/-- Encodes all candidate row indices in increasing order. -/ def machineMatchingForwardRange (optimizer : List Bool) : List Bool := machineUnaryRangeCode (machineMatchingDimensionRuler optimizer) +/-- Reverses the candidate-row list for the greedy scan order. -/ def machineMatchingReverseRange (optimizer : List Bool) : List Bool := machineListReverse (machineMatchingForwardRange optimizer) @@ -72,106 +75,133 @@ theorem machineMatchingReverseRange_mem_FP : def machineMatchingInnerFirstRow (word : List Bool) : List Bool := machinePairFirst word +/-- Extracts the initial selected pairs and optimizer payload from an inner matching query. -/ def machineMatchingInnerRest (word : List Bool) : List Bool := machinePairSecond word +/-- Extracts the initially selected row pairs from an inner matching query. -/ def machineMatchingInnerSelectedInput (word : List Bool) : List Bool := machinePairFirst (machineMatchingInnerRest word) +/-- Extracts the optimizer result from an inner matching query. -/ def machineMatchingInnerOptimizer (word : List Bool) : List Bool := machinePairSecond (machineMatchingInnerRest word) +/-- Encodes an inner matching state as remaining candidates, selected pairs, and source query. -/ def machineMatchingInnerPack (remaining selected source : List Bool) : List Bool := pair remaining (pair selected source) +/-- Extracts the unprocessed second-row candidates from the inner matching state. -/ def machineMatchingInnerRemaining (state : List Bool) : List Bool := machinePairFirst state +/-- Extracts the currently selected row pairs from the inner matching state. -/ def machineMatchingInnerSelected (state : List Bool) : List Bool := machinePairFirst (machinePairSecond state) +/-- Extracts the original inner matching query from the state. -/ def machineMatchingInnerSource (state : List Bool) : List Bool := machinePairSecond (machinePairSecond state) +/-- Reads the first unprocessed second-row candidate. -/ def machineMatchingInnerCurrentSecondRow (state : List Bool) : List Bool := machineListHead (machineMatchingInnerRemaining state) +/-- Tests whether the fixed first-row index is smaller than the current second-row index. -/ def machineMatchingInnerFirstLessSecondBit (state : List Bool) : List Bool := machineBinaryNatLtBit (pair (machineLengthBits (machineMatchingInnerFirstRow (machineMatchingInnerSource state))) (machineLengthBits (machineMatchingInnerCurrentSecondRow state))) +/-- Packages the current row pair and optimizer result for certified eligibility testing. -/ def machineMatchingInnerEligibilityInput (state : List Bool) : List Bool := pair (machineMatchingInnerFirstRow (machineMatchingInnerSource state)) (pair (machineMatchingInnerCurrentSecondRow state) (machineMatchingInnerOptimizer (machineMatchingInnerSource state))) +/-- Tests certified eligibility of the current row pair. -/ def machineMatchingInnerEligibleBit (state : List Bool) : List Bool := machineCertifiedRowPairEligibilityBit (machineMatchingInnerEligibilityInput state) +/-- Packages the current row pair and selected pairs for a disjointness test. -/ def machineMatchingInnerDisjointInput (state : List Bool) : List Bool := pair (machineMatchingInnerFirstRow (machineMatchingInnerSource state)) (pair (machineMatchingInnerCurrentSecondRow state) (machineMatchingInnerSelected state)) +/-- Tests whether the current row pair is disjoint from all selected pairs. -/ def machineMatchingInnerDisjointBit (state : List Bool) : List Bool := machineRowPairDisjointBit (machineMatchingInnerDisjointInput state) +/-- Selects a candidate only when its rows are ordered, it is certified eligible, and it is +disjoint. -/ def machineMatchingInnerSelectBit (state : List Bool) : List Bool := machineAndBit (machineMatchingInnerFirstLessSecondBit state) (machineAndBit (machineMatchingInnerEligibleBit state) (machineMatchingInnerDisjointBit state)) +/-- Prepends the current row pair to the encoded selected-pair list. -/ def machineMatchingInnerSelectedCandidate (state : List Bool) : List Bool := pair (pair (machineMatchingInnerFirstRow (machineMatchingInnerSource state)) (machineMatchingInnerCurrentSecondRow state)) (machineMatchingInnerSelected state) +/-- Bounds inner matching state by twice expanding the query paired with its reverse row range. -/ def machineMatchingInnerInputBound (word : List Bool) : List Bool := machineBinaryMulWidth (machineBinaryMulWidth (pair word (machineMatchingReverseRange (machineMatchingInnerOptimizer word)))) +/-- Reads the inner state bound derived from the stored source query. -/ def machineMatchingInnerBound (state : List Bool) : List Bool := machineMatchingInnerInputBound (machineMatchingInnerSource state) +/-- Truncates the candidate selected-pair list to the inner state bound. -/ def machineMatchingInnerSelectedCandidateClamped (state : List Bool) : List Bool := (machineMatchingInnerSelectedCandidate state).take (machineMatchingInnerBound state).length +/-- Uses the bounded candidate list when the selection test succeeds, retaining the old list +otherwise. -/ def machineMatchingInnerNextSelected (state : List Bool) : List Bool := machineIfHead (machineMatchingInnerSelectBit state) (machineMatchingInnerSelectedCandidateClamped state) (machineMatchingInnerSelected state) +/-- Consumes one second-row candidate and conditionally updates the selected pairs. -/ def machineMatchingInnerProcess (state : List Bool) : List Bool := machineMatchingInnerPack (machineListTail (machineMatchingInnerRemaining state)) (machineMatchingInnerNextSelected state) (machineMatchingInnerSource state) +/-- Processes the next second-row candidate, leaving an exhausted inner scan fixed. -/ def machineMatchingInnerStep (state : List Bool) : List Bool := machineIfEmpty (machineMatchingInnerRemaining state) state (machineMatchingInnerProcess state) +/-- Initializes the inner scan with reverse-ordered candidates and the supplied selected pairs. -/ def machineMatchingInnerInit (word : List Bool) : List Bool := machineMatchingInnerPack (machineMatchingReverseRange (machineMatchingInnerOptimizer word)) (machineMatchingInnerSelectedInput word) word +/-- Packs three copies of the inner bound to bound the complete encoded state. -/ def machineMatchingInnerWidth (word : List Bool) : List Bool := let bound := machineMatchingInnerInputBound word machineMatchingInnerPack bound bound bound +/-- Runs the inner matching scan once per row of the optimizer matrix. -/ def machineMatchingInnerFinalState (word : List Bool) : List Bool := (machineMatchingInnerStep)^[(machineMatchingDimensionRuler (machineMatchingInnerOptimizer word)).length] (machineMatchingInnerInit word) +/-- Extracts the selected-pair list after the complete inner scan. -/ def machineMatchingInnerOutputSelected (word : List Bool) : List Bool := machineMatchingInnerSelected (machineMatchingInnerFinalState word) @@ -329,6 +359,7 @@ theorem machineMatchingInnerWidth_mem_FP : machineMatchingInnerWidth ∈ FP := (machineMatchingInnerPack remaining selected source) = source := by simp [machineMatchingInnerSource, machineMatchingInnerPack] +/-- Bounds the inner scan's remaining and selected lists while preserving its source query. -/ def MachineMatchingInnerStateBound (word state : List Bool) : Prop := let B := (machineMatchingInnerInputBound word).length state = machineMatchingInnerPack (machineMatchingInnerRemaining state) @@ -453,6 +484,8 @@ theorem machineMatchingInnerOutputSelected_mem_FP : /-! ## Canonical one-step facts -/ +/-- Encodes the fixed first row, initial selected pairs, matrix, and potentials for an inner +scan. -/ def matchingInnerMachineInput {n : ℕ} (X : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℚ) (i : Fin n) (selected : List (Fin n × Fin n)) : List Bool := @@ -941,58 +974,75 @@ theorem machineMatchingInnerIterate_semantics {n : ℕ} /-! ## The outer scan over first rows -/ +/-- Encodes an outer matching state as remaining first rows, selected pairs, and optimizer +source. -/ def machineMatchingOuterPack (remaining selected source : List Bool) : List Bool := pair remaining (pair selected source) +/-- Extracts the unprocessed first-row candidates from the outer matching state. -/ def machineMatchingOuterRemaining (state : List Bool) : List Bool := machinePairFirst state +/-- Extracts the selected row pairs from the outer matching state. -/ def machineMatchingOuterSelected (state : List Bool) : List Bool := machinePairFirst (machinePairSecond state) +/-- Extracts the optimizer result stored in the outer matching state. -/ def machineMatchingOuterSource (state : List Bool) : List Bool := machinePairSecond (machinePairSecond state) +/-- Reads the first unprocessed first-row candidate. -/ def machineMatchingOuterCurrentFirstRow (state : List Bool) : List Bool := machineListHead (machineMatchingOuterRemaining state) +/-- Builds an inner scan query from the current first row, selected pairs, and optimizer result. -/ def machineMatchingOuterInnerInput (state : List Bool) : List Bool := pair (machineMatchingOuterCurrentFirstRow state) (pair (machineMatchingOuterSelected state) (machineMatchingOuterSource state)) +/-- Runs the inner scan to obtain the next untruncated selected-pair list. -/ def machineMatchingOuterNextSelectedRaw (state : List Bool) : List Bool := machineMatchingInnerOutputSelected (machineMatchingOuterInnerInput state) +/-- Bounds the outer scan by three width expansions of the optimizer paired with its reverse row +range. -/ def machineMatchingOuterInputBound (optimizer : List Bool) : List Bool := machineBinaryMulWidth (machineBinaryMulWidth (machineBinaryMulWidth (pair optimizer (machineMatchingReverseRange optimizer)))) +/-- Reads the outer state bound derived from the stored optimizer result. -/ def machineMatchingOuterBound (state : List Bool) : List Bool := machineMatchingOuterInputBound (machineMatchingOuterSource state) +/-- Truncates the inner scan's selected-pair result to the outer state bound. -/ def machineMatchingOuterNextSelected (state : List Bool) : List Bool := (machineMatchingOuterNextSelectedRaw state).take (machineMatchingOuterBound state).length +/-- Consumes one first-row candidate and stores the bounded result of its inner scan. -/ def machineMatchingOuterProcess (state : List Bool) : List Bool := machineMatchingOuterPack (machineListTail (machineMatchingOuterRemaining state)) (machineMatchingOuterNextSelected state) (machineMatchingOuterSource state) +/-- Processes the next first row, leaving an exhausted outer scan fixed. -/ def machineMatchingOuterStep (state : List Bool) : List Bool := machineIfEmpty (machineMatchingOuterRemaining state) state (machineMatchingOuterProcess state) +/-- Initializes the outer scan with reverse-ordered row candidates and no selected pairs. -/ def machineMatchingOuterInit (optimizer : List Bool) : List Bool := machineMatchingOuterPack (machineMatchingReverseRange optimizer) [] optimizer +/-- Packs three copies of the outer bound to bound the complete encoded state. -/ def machineMatchingOuterWidth (optimizer : List Bool) : List Bool := let bound := machineMatchingOuterInputBound optimizer machineMatchingOuterPack bound bound bound +/-- Runs the outer matching scan once per row of the optimizer matrix. -/ def machineMatchingOuterFinalState (optimizer : List Bool) : List Bool := (machineMatchingOuterStep)^[(machineMatchingDimensionRuler optimizer).length] (machineMatchingOuterInit optimizer) @@ -1092,6 +1142,7 @@ theorem machineMatchingOuterWidth_mem_FP : (machineMatchingOuterPack remaining selected source) = source := by simp [machineMatchingOuterSource, machineMatchingOuterPack] +/-- Bounds the outer scan's remaining and selected lists while preserving the optimizer source. -/ def MachineMatchingOuterStateBound (optimizer state : List Bool) : Prop := let B := (machineMatchingOuterInputBound optimizer).length state = machineMatchingOuterPack (machineMatchingOuterRemaining state) @@ -1199,12 +1250,15 @@ theorem machineGreedyMatchingSelected_mem_FP : /-! ## Exact outer-scan semantics -/ +/-- Scans second-row candidates in reverse order for a fixed first row and current selected +pairs. -/ def certifiedGreedyOuterStep {n : ℕ} (X : Matrix (Fin n) (Fin n) ℚ) (selected : List (Fin n × Fin n)) (i : Fin n) : List (Fin n × Fin n) := certifiedGreedyOrderedScan X i selected (List.finRange n).reverse +/-- Folds the certified outer matching step over the supplied list of first-row candidates. -/ def certifiedGreedyOuterScan {n : ℕ} (X : Matrix (Fin n) (Fin n) ℚ) (selected : List (Fin n × Fin n)) (is : List (Fin n)) : @@ -1370,6 +1424,8 @@ theorem certifiedGreedyOuterScan_take_succ {n : ℕ} (is.take k ++ [is[k]]) := congrArg _ htake _ = _ := by rw [List.foldl_append]; rfl +/-- Encodes the outer scan after `k` first rows with its remaining rows and greedily selected +pairs. -/ def machineMatchingOuterSemanticState {n : ℕ} (X : Matrix (Fin n) (Fin n) ℚ) (R C : Fin n → ℚ) (is : List (Fin n)) (k : ℕ) : List Bool := @@ -1462,6 +1518,7 @@ theorem machineMatchingOuterIterate_semantics {n : ℕ} /-! ## Identification with the mathematical greedy matching -/ +/-- Extracts the two ordered endpoints of a typed row pair. -/ def rowPairEndpoints {n : ℕ} (q : RowPair n) : Fin n × Fin n := (rowPairRow q 0, rowPairRow q 1) @@ -1558,6 +1615,7 @@ theorem certifiedGreedyOrderedStep_map_endpoints {n : ℕ} rw [ite_eq_right h, ite_eq_right htyped] · simp [certifiedGreedyOrderedStep, certifiedGreedyTypedStep, hij] +/-- Folds the typed greedy selection step over a list of second-row candidates. -/ def certifiedGreedyTypedInnerScan {n : ℕ} (X : Matrix (Fin n) (Fin n) ℚ) (i : Fin n) (selected : List (RowPair n)) (js : List (Fin n)) : List (RowPair n) := @@ -1577,11 +1635,13 @@ theorem certifiedGreedyOrderedScan_map_endpoints {n : ℕ} certifiedGreedyOrderedStep_map_endpoints] exact ih (certifiedGreedyTypedStep X i selected j) +/-- Runs the typed inner scan over all second rows in reverse order. -/ def certifiedGreedyTypedOuterStep {n : ℕ} (X : Matrix (Fin n) (Fin n) ℚ) (selected : List (RowPair n)) (i : Fin n) : List (RowPair n) := certifiedGreedyTypedInnerScan X i selected (List.finRange n).reverse +/-- Folds the typed outer scan over the supplied first-row candidates. -/ def certifiedGreedyTypedOuterScan {n : ℕ} (X : Matrix (Fin n) (Fin n) ℚ) (selected : List (RowPair n)) (is : List (Fin n)) : List (RowPair n) := @@ -1604,18 +1664,23 @@ theorem certifiedGreedyOuterScan_map_endpoints {n : ℕ} rw [certifiedGreedyOrderedScan_map_endpoints] exact ih (certifiedGreedyTypedOuterStep X selected i) +/-- Constructs a typed row pair when the first index is smaller, returning none otherwise. -/ def canonicalRowPairCandidate {n : ℕ} (i j : Fin n) : Option (RowPair n) := if hij : i < j then some (rowPairOfLT i j hij) else none +/-- Tests whether a typed row pair has a certified core pair at the explicit scale, threshold, +and precision. -/ def certifiedRowPairEligibleBit {n : ℕ} (X : Matrix (Fin n) (Fin n) ℚ) (q : RowPair n) : Bool := decide (HasCertifiedCorePair (explicitRegularizationScale n) X explicitKappa (directedPairCostPrecision n) q) +/-- Prepends a row pair when it is disjoint from every pair already selected. -/ def greedyRowListStep {n : ℕ} (selected : List (RowPair n)) (q : RowPair n) : List (RowPair n) := if ∀ r ∈ selected, Disjoint q.1 r.1 then q :: selected else selected +/-- Adds a certified eligible row pair to the greedy list when disjointness permits. -/ def certifiedGreedyEdgeStep {n : ℕ} (X : Matrix (Fin n) (Fin n) ℚ) (selected : List (RowPair n)) (q : RowPair n) : List (RowPair n) := @@ -1723,6 +1788,7 @@ theorem explicitThresholdRowPairsList_eq_certifiedFilter {n : ℕ} · simp [explicitCertifiedRowWeight, certifiedConstantRowWeight, certifiedRowPairEligibleBit, explicitGamma, h] +/-- Inserts a row pair into a finite matching when it is disjoint from every selected pair. -/ def greedyRowFinsetStep {n : ℕ} (selected : Finset (RowPair n)) (q : RowPair n) : Finset (RowPair n) := if ∀ r ∈ selected, Disjoint q.1 r.1 then insert q selected else selected diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineIntegerArithmetic.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineIntegerArithmetic.lean index e517a2298a..b37bfbb3fd 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineIntegerArithmetic.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineIntegerArithmetic.lean @@ -22,52 +22,68 @@ namespace BeyondBethe open Complexity +/-- Interprets a Boolean sign and natural magnitude as an integer. -/ def signedMagnitudeValue (negative : Bool) (magnitude : ℕ) : ℤ := if negative then -(magnitude : ℤ) else magnitude +/-- Converts signed magnitude to canonical integer code, forcing the zero code for an empty +magnitude. -/ def machineCanonicalIntegerFromSignedAbs (word : List Bool) : List Bool := machineIfEmpty (machinePairSecond word) [false] (machineIntegerCodeFromSignedAbs word) +/-- Extracts the sign bit and absolute-value bits of an encoded integer as a pair. -/ def machineIntegerSignedMagnitude (word : List Bool) : List Bool := pair (machineHeadBit word) (machineIntegerNatAbsBits word) +/-- Extracts the left operand's sign from a pair of signed-magnitude operands. -/ def machineSignedLeftSign (word : List Bool) : List Bool := machinePairFirst (machinePairFirst word) +/-- Extracts the left operand's magnitude from a pair of signed-magnitude operands. -/ def machineSignedLeftAbs (word : List Bool) : List Bool := machinePairSecond (machinePairFirst word) +/-- Extracts the right operand's sign from a pair of signed-magnitude operands. -/ def machineSignedRightSign (word : List Bool) : List Bool := machinePairFirst (machinePairSecond word) +/-- Extracts the right operand's magnitude from a pair of signed-magnitude operands. -/ def machineSignedRightAbs (word : List Bool) : List Bool := machinePairSecond (machinePairSecond word) +/-- Tests whether the two signed-magnitude inputs have equal sign bits. -/ def machineSignedSameSign (word : List Bool) : List Bool := machineNotBit (machineXorBit (machineSignedLeftSign word) (machineSignedRightSign word)) +/-- Adds the two input magnitudes using binary natural-number addition. -/ def machineSignedAbsSum (word : List Bool) : List Bool := machineBinaryAddBits (pair (machineSignedLeftAbs word) (machineSignedRightAbs word)) +/-- Tests whether the left input magnitude is at least the right input magnitude. -/ def machineSignedLeftAbsGe (word : List Bool) : List Bool := machineBinaryNatLeBit (pair (machineSignedRightAbs word) (machineSignedLeftAbs word)) +/-- Subtracts the right magnitude from the left using truncated binary subtraction. -/ def machineSignedAbsLeftDiff (word : List Bool) : List Bool := machineBinarySubBits (pair (machineSignedLeftAbs word) (machineSignedRightAbs word)) +/-- Subtracts the left magnitude from the right using truncated binary subtraction. -/ def machineSignedAbsRightDiff (word : List Bool) : List Bool := machineBinarySubBits (pair (machineSignedRightAbs word) (machineSignedLeftAbs word)) +/-- Selects the larger magnitude minus the smaller for addition of inputs with different signs. -/ def machineSignedDifferentAbs (word : List Bool) : List Bool := machineIfHead (machineSignedLeftAbsGe word) (machineSignedAbsLeftDiff word) (machineSignedAbsRightDiff word) +/-- Selects the sign of the larger magnitude for different-sign addition, choosing the left sign +on a tie. -/ def machineSignedDifferentSign (word : List Bool) : List Bool := machineIfHead (machineSignedLeftAbsGe word) (machineSignedLeftSign word) (machineSignedRightSign word) @@ -86,13 +102,16 @@ def machineIntegerAddCode (word : List Bool) : List Bool := (pair (machineIntegerSignedMagnitude (machinePairFirst word)) (machineIntegerSignedMagnitude (machinePairSecond word))) +/-- Multiplies the two input magnitudes using binary multiplication. -/ def machineSignedAbsProduct (word : List Bool) : List Bool := machineBinaryMulBits (pair (machineSignedLeftAbs word) (machineSignedRightAbs word)) +/-- Computes the product sign by exclusive-or of the input signs. -/ def machineSignedProductSign (word : List Bool) : List Bool := machineXorBit (machineSignedLeftSign word) (machineSignedRightSign word) +/-- Combines the product sign and magnitude into a canonical integer code. -/ def machineSignedMagnitudeMul (word : List Bool) : List Bool := machineCanonicalIntegerFromSignedAbs (pair (machineSignedProductSign word) (machineSignedAbsProduct word)) diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineIntegerCompare.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineIntegerCompare.lean index 97ded98f25..69f5c0fa6f 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineIntegerCompare.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineIntegerCompare.lean @@ -23,22 +23,30 @@ namespace BeyondBethe open Complexity +/-- Reads the sign bit of the left encoded integer in a pair. -/ def machineIntegerLeftSign (word : List Bool) : List Bool := machineHeadBit (machinePairFirst word) +/-- Reads the sign bit of the right encoded integer in a pair. -/ def machineIntegerRightSign (word : List Bool) : List Bool := machineHeadBit (machinePairSecond word) +/-- Computes the binary absolute value of the left encoded integer. -/ def machineIntegerLeftAbsBits (word : List Bool) : List Bool := machineIntegerNatAbsBits (machinePairFirst word) +/-- Computes the binary absolute value of the right encoded integer. -/ def machineIntegerRightAbsBits (word : List Bool) : List Bool := machineIntegerNatAbsBits (machinePairSecond word) +/-- Compares the left absolute value with the right in the order used for nonnegative integer +comparison. -/ def machineIntegerPositiveLeBit (word : List Bool) : List Bool := machineBinaryNatLeBit (pair (machineIntegerLeftAbsBits word) (machineIntegerRightAbsBits word)) +/-- Compares the right absolute value with the left in the reversed order used for negative +integer comparison. -/ def machineIntegerNegativeLeBit (word : List Bool) : List Bool := machineBinaryNatLeBit (pair (machineIntegerRightAbsBits word) (machineIntegerLeftAbsBits word)) diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineIntegerSignedMagnitude.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineIntegerSignedMagnitude.lean index 33b6a338f4..6e7584fd58 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineIntegerSignedMagnitude.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineIntegerSignedMagnitude.lean @@ -25,6 +25,8 @@ namespace BeyondBethe open Complexity +/-- Adds one to a negative integer payload to recover the magnitude represented by +`Int.negSucc`. -/ def machineIntegerNegativeAbsBits (word : List Bool) : List Bool := machineBinaryAddBits (pair word.tail [true]) @@ -32,6 +34,7 @@ def machineIntegerNegativeAbsBits (word : List Bool) : List Bool := def machineIntegerNatAbsBits (word : List Bool) : List Bool := machineIfHead word (machineIntegerNegativeAbsBits word) word.tail +/-- Subtracts one from a magnitude to obtain the payload for `Int.negSucc`. -/ def machineIntegerNegativePayloadBits (absBits : List Bool) : List Bool := machineBinarySubBits (pair absBits [true]) diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineKuhnEncoding.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineKuhnEncoding.lean index 9f1f221161..cd943c434a 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineKuhnEncoding.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineKuhnEncoding.lean @@ -25,12 +25,15 @@ open Complexity /-! ## Semantic tables -/ +/-- Lists the membership bits of the seen-column set in finite-index order. -/ def seenBoolList {n : ℕ} (seen : Finset (Fin n)) : List Bool := List.ofFn fun i ↦ decide (i ∈ seen) +/-- Lists each column's optional matched row, replacing finite row indices by natural numbers. -/ def columnMateList {n : ℕ} (mate : ColumnMate n) : List (Option ℕ) := List.ofFn fun j ↦ (mate j).map Fin.val +/-- Encodes a list of finite indices using unary codes for its entries. -/ def finListUnaryCode {n : ℕ} (xs : List (Fin n)) : List Bool := binaryListCode finUnaryCode xs @@ -88,112 +91,148 @@ theorem columnMateList_update {n : ℕ} (mate : ColumnMate n) /-! ## Frame codes -/ +/-- Packs the search continuation's fuel, remaining columns, row, saved matching, and selected +column. -/ def machineKuhnSearchFramePack (fuel remaining row mate column : List Bool) : List Bool := pair fuel (pair remaining (pair row (pair mate column))) +/-- Packs the build continuation's remaining rows and fallback matching. -/ def machineKuhnBuildFramePack (rows fallback : List Bool) : List Bool := pair rows fallback +/-- Encodes a semantic search frame with unary fuel and indices and the encoded column-mate +vector. -/ def kuhnSearchFrameCode {n : ℕ} (frame : KuhnSearchFrame n) : List Bool := machineKuhnSearchFramePack (List.replicate frame.fuel true) (finListUnaryCode frame.remaining) (finUnaryCode frame.row) (mateVectorCode (columnMateList frame.mate)) (finUnaryCode frame.column) +/-- Encodes a semantic build frame using its remaining row list and fallback column-mate vector. -/ def kuhnBuildFrameCode {n : ℕ} (frame : KuhnBuildFrame n) : List Bool := machineKuhnBuildFramePack (finListUnaryCode frame.rows) (mateVectorCode (columnMateList frame.fallback)) +/-- Encodes a Kuhn continuation frame with a false tag for search frames and a true tag for +build frames. -/ def kuhnFrameCode {n : ℕ} : KuhnFrame n → List Bool | .search frame => pair [false] (kuhnSearchFrameCode frame) | .build frame => pair [true] (kuhnBuildFrameCode frame) +/-- Encodes a stack of tagged Kuhn continuation frames as a binary list. -/ def kuhnStackCode {n : ℕ} (stack : List (KuhnFrame n)) : List Bool := binaryListCode kuhnFrameCode stack +/-- Extracts the search-or-build tag from an encoded Kuhn continuation frame. -/ def machineKuhnFrameTag (frame : List Bool) : List Bool := machinePairFirst frame +/-- Extracts the fields following an encoded Kuhn frame's tag. -/ def machineKuhnFramePayload (frame : List Bool) : List Bool := machinePairSecond frame +/-- Extracts the unary fuel field from a tagged search continuation. -/ def machineKuhnSearchFrameFuel (frame : List Bool) : List Bool := machinePairFirst (machineKuhnFramePayload frame) +/-- Extracts the encoded remaining-column list from a tagged search continuation. -/ def machineKuhnSearchFrameRemaining (frame : List Bool) : List Bool := machinePairFirst (machinePairSecond (machineKuhnFramePayload frame)) +/-- Extracts the unary row field from a tagged search continuation. -/ def machineKuhnSearchFrameRow (frame : List Bool) : List Bool := machinePairFirst (machinePairSecond (machinePairSecond (machineKuhnFramePayload frame))) +/-- Extracts the saved column-mate vector from a tagged search continuation. -/ def machineKuhnSearchFrameMate (frame : List Bool) : List Bool := machinePairFirst (machinePairSecond (machinePairSecond (machinePairSecond (machineKuhnFramePayload frame)))) +/-- Extracts the selected column ruler from a tagged search continuation. -/ def machineKuhnSearchFrameColumn (frame : List Bool) : List Bool := machinePairSecond (machinePairSecond (machinePairSecond (machinePairSecond (machineKuhnFramePayload frame)))) +/-- Extracts the remaining-row list from a tagged build continuation. -/ def machineKuhnBuildFrameRows (frame : List Bool) : List Bool := machinePairFirst (machineKuhnFramePayload frame) +/-- Extracts the fallback matching from a tagged build continuation. -/ def machineKuhnBuildFrameFallback (frame : List Bool) : List Bool := machinePairSecond (machineKuhnFramePayload frame) +/-- Reads the first encoded continuation frame from a Kuhn stack. -/ def machineKuhnStackHead (stack : List Bool) : List Bool := machineListHead stack +/-- Removes the first encoded continuation frame from a Kuhn stack. -/ def machineKuhnStackTail (stack : List Bool) : List Bool := machineListTail stack +/-- Prepends an encoded continuation frame to a Kuhn stack. -/ def machineKuhnStackPush (frame stack : List Bool) : List Bool := pair frame stack /-! ## Control codes -/ +/-- Packs the fuel, remaining columns, row, seen bits, matching, and continuation stack of a +Kuhn search call. -/ def machineKuhnCallPack (fuel remaining row seen mate stack : List Bool) : List Bool := pair fuel (pair remaining (pair row (pair seen (pair mate stack)))) +/-- Packs the success flag, seen bits, matching, and continuation stack of a Kuhn return state. -/ def machineKuhnReturnPack (success seen mate stack : List Bool) : List Bool := pair success (pair seen (pair mate stack)) +/-- Builds a Kuhn call control word with the false tag and the complete search-call payload. -/ def machineKuhnControlCall (fuel remaining row seen mate stack : List Bool) : List Bool := pair [false] (machineKuhnCallPack fuel remaining row seen mate stack) +/-- Builds a Kuhn return control word with tag `[true, false]` and its result payload. -/ def machineKuhnControlReturn (success seen mate stack : List Bool) : List Bool := pair [true, false] (machineKuhnReturnPack success seen mate stack) +/-- Builds a completed Kuhn control word with tag `[true, true]` and the resulting matching. -/ def machineKuhnControlDone (mate : List Bool) : List Bool := pair [true, true] mate +/-- Extracts the call, return, or completion tag from a Kuhn control word. -/ def machineKuhnControlTag (control : List Bool) : List Bool := machinePairFirst control +/-- Extracts the payload following a Kuhn control word's tag. -/ def machineKuhnControlPayload (control : List Bool) : List Bool := machinePairSecond control +/-- Reads the second control-tag bit, which distinguishes completed states among the +return-or-done tags. -/ def machineKuhnControlIsDoneBit (control : List Bool) : List Bool := machineHeadBit (machineKuhnControlTag control).tail +/-- Extracts the unary fuel field from a Kuhn call control word. -/ def machineKuhnCallFuel (control : List Bool) : List Bool := machinePairFirst (machineKuhnControlPayload control) +/-- Extracts the remaining-column list from a Kuhn call control word. -/ def machineKuhnCallRemaining (control : List Bool) : List Bool := machinePairFirst (machinePairSecond (machineKuhnControlPayload control)) +/-- Extracts the current row ruler from a Kuhn call control word. -/ def machineKuhnCallRow (control : List Bool) : List Bool := machinePairFirst (machinePairSecond (machinePairSecond (machineKuhnControlPayload control))) +/-- Extracts the seen-column bits from a Kuhn call control word. -/ def machineKuhnCallSeen (control : List Bool) : List Bool := machinePairFirst (machinePairSecond (machinePairSecond (machinePairSecond (machineKuhnControlPayload control)))) +/-- Extracts the column-mate vector from a Kuhn call control word. -/ def machineKuhnCallMate (control : List Bool) : List Bool := machinePairFirst (machinePairSecond @@ -201,6 +240,7 @@ def machineKuhnCallMate (control : List Bool) : List Bool := (machinePairSecond (machinePairSecond (machineKuhnControlPayload control))))) +/-- Extracts the continuation stack from a Kuhn call control word. -/ def machineKuhnCallStack (control : List Bool) : List Bool := machinePairSecond (machinePairSecond @@ -208,28 +248,37 @@ def machineKuhnCallStack (control : List Bool) : List Bool := (machinePairSecond (machinePairSecond (machineKuhnControlPayload control))))) +/-- Extracts the success flag from a Kuhn return control word. -/ def machineKuhnReturnSuccess (control : List Bool) : List Bool := machinePairFirst (machineKuhnControlPayload control) +/-- Extracts the updated seen-column bits from a Kuhn return control word. -/ def machineKuhnReturnSeen (control : List Bool) : List Bool := machinePairFirst (machinePairSecond (machineKuhnControlPayload control)) +/-- Extracts the returned matching from a Kuhn return control word. -/ def machineKuhnReturnMate (control : List Bool) : List Bool := machinePairFirst (machinePairSecond (machinePairSecond (machineKuhnControlPayload control))) +/-- Extracts the continuation stack from a Kuhn return control word. -/ def machineKuhnReturnStack (control : List Bool) : List Bool := machinePairSecond (machinePairSecond (machinePairSecond (machineKuhnControlPayload control))) +/-- Extracts the final matching from a completed Kuhn control word. -/ def machineKuhnDoneMate (control : List Bool) : List Bool := machineKuhnControlPayload control +/-- Encodes a search result's matching when present, using the empty word when the search +failed. -/ def kuhnSearchResultMateCode {n : ℕ} (result : KuhnSearchResult n) : List Bool := match result.mate? with | none => [] | some mate => mateVectorCode (columnMateList mate) +/-- Encodes semantic Kuhn call, return, and completed states, including unary indices, seen +bits, matching vectors, and continuation stacks. -/ def kuhnControlCode {n : ℕ} : KuhnEvalState n → List Bool | .call fuel remaining row seen mate stack => machineKuhnControlCall (List.replicate fuel true) @@ -245,35 +294,47 @@ def kuhnControlCode {n : ℕ} : KuhnEvalState n → List Bool /-! ## Whole-state code and projections -/ +/-- Packs a Kuhn control word with its fixed matrix, dimension, column list, all-false seen +vector, and length bound. -/ def machineKuhnStatePack (control matrix dimension columns falseSeen bound : List Bool) : List Bool := pair control (pair matrix (pair dimension (pair columns (pair falseSeen bound)))) +/-- Extracts the control word from an encoded Kuhn machine state. -/ def machineKuhnStateControl (state : List Bool) : List Bool := machinePairFirst state +/-- Extracts the fixed matrix word from an encoded Kuhn machine state. -/ def machineKuhnStateMatrix (state : List Bool) : List Bool := machinePairFirst (machinePairSecond state) +/-- Extracts the unary dimension from an encoded Kuhn machine state. -/ def machineKuhnStateDimension (state : List Bool) : List Bool := machinePairFirst (machinePairSecond (machinePairSecond state)) +/-- Extracts the fixed complete column list from an encoded Kuhn machine state. -/ def machineKuhnStateColumns (state : List Bool) : List Bool := machinePairFirst (machinePairSecond (machinePairSecond (machinePairSecond state))) +/-- Extracts the fixed all-false seen vector from an encoded Kuhn machine state. -/ def machineKuhnStateFalseSeen (state : List Bool) : List Bool := machinePairFirst (machinePairSecond (machinePairSecond (machinePairSecond (machinePairSecond state)))) +/-- Extracts the word that bounds the field lengths of a Kuhn machine state. -/ def machineKuhnStateBound (state : List Bool) : List Bool := machinePairSecond (machinePairSecond (machinePairSecond (machinePairSecond (machinePairSecond state)))) +/-- Applies the binary-multiplication width construction to the list-update input bound to +obtain the Kuhn field bound. -/ def machineKuhnInputBound (matrix : List Bool) : List Bool := machineBinaryMulWidth (machineListUpdateInputBound matrix) +/-- Encodes a semantic Kuhn state with its rational matrix, unary dimension, complete index +list, all-false seen vector, and computed bound. -/ def kuhnMachineStateCode {n : ℕ} (A : Matrix (Fin n) (Fin n) ℚ) (state : KuhnEvalState n) : List Bool := let matrix := rationalMatrixBinaryEncoding.encode ⟨n, A⟩ @@ -503,6 +564,7 @@ theorem machineKuhnControlTag_mem_FP : theorem machineKuhnControlPayload_mem_FP : machineKuhnControlPayload ∈ Complexity.FP := machinePairSecond_mem_FP +/-- Follows the second projection of a nested pair exactly `depth` times. -/ def machinePairSecondN (depth : ℕ) (word : List Bool) : List Bool := (machinePairSecond)^[depth] word diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineKuhnInvariant.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineKuhnInvariant.lean index 2cef862bed..9165e8dd7b 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineKuhnInvariant.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineKuhnInvariant.lean @@ -27,13 +27,18 @@ open Complexity /-! ## A semantic invariant -/ +/-- Bounds search-frame fuel by `n + 1` and remaining columns by `n`, or build-frame remaining +rows by `n`. -/ def KuhnFrameDataBound (n : ℕ) : KuhnFrame n → Prop | .search frame => frame.fuel ≤ n + 1 ∧ frame.remaining.length ≤ n | .build frame => frame.rows.length ≤ n +/-- Requires every frame in a continuation stack to satisfy its frame-data bounds. -/ def KuhnStackDataBound {n : ℕ} (stack : List (KuhnFrame n)) : Prop := ∀ frame ∈ stack, KuhnFrameDataBound n frame +/-- Bounds active call data and every continuation frame, with stack length at most `steps + 1`; +completed states impose no further bound. -/ def KuhnEvalReachableBound {n : ℕ} (steps : ℕ) : KuhnEvalState n → Prop | .call fuel remaining _row _seen _mate stack => @@ -329,6 +334,7 @@ theorem kuhnControlCode_length_le {n steps : ℕ} /-! ## The fixed octic envelope -/ +/-- Provides the semantic Kuhn step budget `3 * (n * (n + (n + 1) * n)) + 2 * n`. -/ def kuhnMachineStepBudget (n : ℕ) : ℕ := 3 * (n * (n + (n + 1) * n)) + 2 * n diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineKuhnRunner.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineKuhnRunner.lean index c78f0e6e39..e233246ab1 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineKuhnRunner.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineKuhnRunner.lean @@ -26,26 +26,35 @@ open Complexity /-! ## Initializer -/ +/-- Extracts the unary matrix dimension for Kuhn initialization. -/ def machineKuhnInitDimension (matrix : List Bool) : List Bool := machineMatrixDimensionUnary matrix +/-- Builds the encoded complete index range from the unary input dimension. -/ def machineKuhnInitColumns (matrix : List Bool) : List Bool := machineUnaryRangeCode (machineKuhnInitDimension matrix) +/-- Builds an all-false seen-column vector of the input dimension. -/ def machineKuhnInitFalseSeen (matrix : List Bool) : List Bool := machineFalseVectorCode (machineKuhnInitDimension matrix) +/-- Builds the empty column-mate vector of the input dimension. -/ def machineKuhnInitEmptyMate (matrix : List Bool) : List Bool := machineEmptyMateVectorCode (machineKuhnInitDimension matrix) +/-- Builds the initial tagged build continuation with all rows after the first and an empty +fallback matching. -/ def machineKuhnInitBuildFrame (matrix : List Bool) : List Bool := pair [true] (machineKuhnBuildFramePack (machineListTail (machineKuhnInitColumns matrix)) (machineKuhnInitEmptyMate matrix)) +/-- Creates the initial one-frame continuation stack for the Kuhn matching builder. -/ def machineKuhnInitStack (matrix : List Bool) : List Bool := machineKuhnStackPush (machineKuhnInitBuildFrame matrix) [] +/-- Initializes a nonempty-dimensional search at the first row with fuel `n + 1`, all columns, +empty seen and mate vectors, and the build continuation. -/ def machineKuhnInitNonemptyControl (matrix : List Bool) : List Bool := machineKuhnControlCall (true :: machineKuhnInitDimension matrix) (machineKuhnInitColumns matrix) @@ -53,14 +62,19 @@ def machineKuhnInitNonemptyControl (matrix : List Bool) : List Bool := (machineKuhnInitFalseSeen matrix) (machineKuhnInitEmptyMate matrix) (machineKuhnInitStack matrix) +/-- Returns a completed empty matching for dimension zero and initializes the first search +otherwise. -/ def machineKuhnInitControl (matrix : List Bool) : List Bool := machineIfEmpty (machineKuhnInitDimension matrix) (machineKuhnControlDone (machineKuhnInitEmptyMate matrix)) (machineKuhnInitNonemptyControl matrix) +/-- Truncates a candidate word to the length of the Kuhn input bound. -/ def machineKuhnInputClamp (matrix candidate : List Bool) : List Bool := candidate.take (machineKuhnInputBound matrix).length +/-- Initializes every Kuhn state field through the common input clamp and stores the computed +bound unchanged. -/ def machineKuhnInit (matrix : List Bool) : List Bool := machineKuhnStatePack (machineKuhnInputClamp matrix (machineKuhnInitControl matrix)) @@ -234,6 +248,8 @@ theorem machineKuhnInitEmptyMate_length_le_bound (matrix : List Bool) : /-! ## A generic invariant for the outer bounded iteration -/ +/-- Requires exact state packing, all five data fields bounded by the input-bound length, and +the prescribed bound word. -/ def MachineKuhnRunStateBound (matrix state : List Bool) : Prop := let B := (machineKuhnInputBound matrix).length state = machineKuhnStatePack (machineKuhnStateControl state) @@ -294,6 +310,8 @@ theorem machineKuhnIterate_bound (matrix : List Bool) : ∀ iterations, rw [Function.iterate_succ_apply'] exact machineKuhnStep_bound ih +/-- Applies the binary-multiplication width construction once more to the Kuhn input bound to +bound the full run state. -/ def machineKuhnRunWidth (matrix : List Bool) : List Bool := machineBinaryMulWidth (machineKuhnInputBound matrix) @@ -337,6 +355,8 @@ theorem machineKuhnIterate_length_le_width nlinarith omega +/-- Runs the Kuhn step machine for the length of its input-bound word from the bounded initial +state. -/ def machineKuhnFinalState (matrix : List Bool) : List Bool := (machineKuhnStep^[(machineKuhnInputBound matrix).length]) (machineKuhnInit matrix) diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineKuhnStep.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineKuhnStep.lean index 81fa034d1e..d9db2c3d37 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineKuhnStep.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineKuhnStep.lean @@ -24,42 +24,55 @@ open Complexity /-! ## State-level field access -/ +/-- Reads the control word used by the Kuhn transition functions. -/ def machineKuhnControl (state : List Bool) : List Bool := machineKuhnStateControl state +/-- Reads the active call's unary fuel from a Kuhn machine state. -/ def machineKuhnFuel (state : List Bool) : List Bool := machineKuhnCallFuel (machineKuhnControl state) +/-- Reads the active call's remaining-column list from a Kuhn machine state. -/ def machineKuhnRemaining (state : List Bool) : List Bool := machineKuhnCallRemaining (machineKuhnControl state) +/-- Reads the active call's current row from a Kuhn machine state. -/ def machineKuhnRow (state : List Bool) : List Bool := machineKuhnCallRow (machineKuhnControl state) +/-- Reads the active call's seen-column vector from a Kuhn machine state. -/ def machineKuhnSeen (state : List Bool) : List Bool := machineKuhnCallSeen (machineKuhnControl state) +/-- Reads the active call's current matching from a Kuhn machine state. -/ def machineKuhnMate (state : List Bool) : List Bool := machineKuhnCallMate (machineKuhnControl state) +/-- Reads the active call's continuation stack from a Kuhn machine state. -/ def machineKuhnStack (state : List Bool) : List Bool := machineKuhnCallStack (machineKuhnControl state) +/-- Reads the return success flag from a Kuhn machine state. -/ def machineKuhnRetSuccess (state : List Bool) : List Bool := machineKuhnReturnSuccess (machineKuhnControl state) +/-- Reads the returned seen-column vector from a Kuhn machine state. -/ def machineKuhnRetSeen (state : List Bool) : List Bool := machineKuhnReturnSeen (machineKuhnControl state) +/-- Reads the returned matching from a Kuhn machine state. -/ def machineKuhnRetMate (state : List Bool) : List Bool := machineKuhnReturnMate (machineKuhnControl state) +/-- Reads the return continuation stack from a Kuhn machine state. -/ def machineKuhnRetStack (state : List Bool) : List Bool := machineKuhnReturnStack (machineKuhnControl state) +/-- Reads the top continuation frame of the return stack. -/ def machineKuhnTopFrame (state : List Bool) : List Bool := machineKuhnStackHead (machineKuhnRetStack state) +/-- Removes the top continuation frame from the return stack. -/ def machineKuhnRestStack (state : List Bool) : List Bool := machineKuhnStackTail (machineKuhnRetStack state) @@ -110,9 +123,12 @@ theorem machineKuhnRestStack_mem_FP : machineKuhnRestStack ∈ Complexity.FP := /-! ## Repacking with a fixed global clamp -/ +/-- Truncates a candidate word to the length of the bound stored in the current Kuhn state. -/ def machineKuhnClamp (state candidate : List Bool) : List Bool := candidate.take (machineKuhnStateBound state).length +/-- Replaces a Kuhn state's control while clamping all data fields to its stored bound and +preserving that bound. -/ def machineKuhnWithControl (state control : List Bool) : List Bool := machineKuhnStatePack (machineKuhnClamp state control) (machineKuhnClamp state (machineKuhnStateMatrix state)) @@ -144,74 +160,95 @@ theorem machineKuhnWithControl_mem_FP /-! ## Call transition -/ +/-- Reads the first remaining column of the active Kuhn call. -/ def machineKuhnCurrentColumn (state : List Bool) : List Bool := machineListHead (machineKuhnRemaining state) +/-- Removes the current column from the active call's remaining-column list. -/ def machineKuhnRemainingTail (state : List Bool) : List Bool := machineListTail (machineKuhnRemaining state) +/-- Looks up whether the current search column has already been seen. -/ def machineKuhnSeenBit (state : List Bool) : List Bool := machineBoolVectorEntryAtUnary (pair (machineKuhnCurrentColumn state) (machineKuhnSeen state)) +/-- Tests whether the input matrix supports the edge from the current row to the current column. -/ def machineKuhnSupportBit (state : List Bool) : List Bool := machineRationalSupportBitAtUnary (pair (machineKuhnRow state) (pair (machineKuhnCurrentColumn state) (machineKuhnStateMatrix state))) +/-- Marks the current column for skipping when it was already seen or the current matrix edge is +unsupported. -/ def machineKuhnSkipBit (state : List Bool) : List Bool := machineOrBit (machineKuhnSeenBit state) (machineNotBit (machineKuhnSupportBit state)) +/-- Sets the current column's seen bit to true. -/ def machineKuhnSeenUpdated (state : List Bool) : List Bool := machineBoolVectorUpdateAtUnary (pair (machineKuhnCurrentColumn state) (pair [true] (machineKuhnSeen state))) +/-- Looks up the current column's optional matched row. -/ def machineKuhnMateValue (state : List Bool) : List Bool := machineMateVectorGetAtUnary (pair (machineKuhnCurrentColumn state) (machineKuhnMate state)) +/-- Tests whether the current column is unmatched. -/ def machineKuhnMateIsNoneBit (state : List Bool) : List Bool := machineMateValueIsNoneBit (machineKuhnMateValue state) +/-- Encodes the current row as a present optional mate value. -/ def machineKuhnSomeCurrentRow (state : List Bool) : List Bool := true :: machineKuhnRow state +/-- Updates the current column's mate to the current search row. -/ def machineKuhnMateSetCurrent (state : List Bool) : List Bool := machineMateVectorUpdateAtUnary (pair (machineKuhnCurrentColumn state) (pair (machineKuhnSomeCurrentRow state) (machineKuhnMate state))) +/-- Clears the current column's mate before recursively relocating its matched row. -/ def machineKuhnMateClearCurrent (state : List Bool) : List Bool := machineMateVectorUpdateAtUnary (pair (machineKuhnCurrentColumn state) (pair [false] (machineKuhnMate state))) +/-- Returns a failed search with the current seen bits and continuation stack. -/ def machineKuhnFailureControl (state : List Bool) : List Bool := machineKuhnControlReturn [false] (machineKuhnSeen state) [] (machineKuhnStack state) +/-- Continues the active search after dropping the skipped column, retaining fuel, seen bits, +matching, and stack. -/ def machineKuhnSkipControl (state : List Bool) : List Bool := machineKuhnControlCall (machineKuhnFuel state) (machineKuhnRemainingTail state) (machineKuhnRow state) (machineKuhnSeen state) (machineKuhnMate state) (machineKuhnStack state) +/-- Returns success after marking a free column seen and matching it to the current row. -/ def machineKuhnFreeColumnControl (state : List Bool) : List Bool := machineKuhnControlReturn [true] (machineKuhnSeenUpdated state) (machineKuhnMateSetCurrent state) (machineKuhnStack state) +/-- Saves a search continuation containing the current fuel, remaining columns, row, matching, +and selected column. -/ def machineKuhnSearchFrameCurrent (state : List Bool) : List Bool := pair [false] (machineKuhnSearchFramePack (machineKuhnFuel state) (machineKuhnRemainingTail state) (machineKuhnRow state) (machineKuhnMate state) (machineKuhnCurrentColumn state)) +/-- Pushes the current search continuation onto the active stack. -/ def machineKuhnPushedSearchStack (state : List Bool) : List Bool := machineKuhnStackPush (machineKuhnSearchFrameCurrent state) (machineKuhnStack state) +/-- Recursively searches for the occupied column's former row with decremented fuel, all +columns, updated seen bits, that column cleared, and a saved continuation. -/ def machineKuhnOccupiedColumnControl (state : List Bool) : List Bool := machineKuhnControlCall (machineKuhnFuel state).tail (machineKuhnStateColumns state) @@ -219,15 +256,20 @@ def machineKuhnOccupiedColumnControl (state : List Bool) : List Bool := (machineKuhnSeenUpdated state) (machineKuhnMateClearCurrent state) (machineKuhnPushedSearchStack state) +/-- Returns an immediate match for a free column or recursively relocates an occupied column's +mate. -/ def machineKuhnProceedControl (state : List Bool) : List Bool := machineIfHead (machineKuhnMateIsNoneBit state) (machineKuhnFreeColumnControl state) (machineKuhnOccupiedColumnControl state) +/-- Skips a seen or unsupported column and otherwise processes it as free or occupied. -/ def machineKuhnNonterminalCallControl (state : List Bool) : List Bool := machineIfHead (machineKuhnSkipBit state) (machineKuhnSkipControl state) (machineKuhnProceedControl state) +/-- Returns failure when fuel or columns are exhausted and otherwise executes the next search +transition. -/ def machineKuhnCallControl (state : List Bool) : List Bool := machineIfEmpty (machineKuhnFuel state) (machineKuhnFailureControl state) (machineIfEmpty (machineKuhnRemaining state) @@ -236,6 +278,8 @@ def machineKuhnCallControl (state : List Bool) : List Bool := /-! ## Return transition -/ +/-- After a successful recursive search, matches the saved column to the saved row and returns +success through the remaining stack. -/ def machineKuhnSearchReturnSuccessControl (state : List Bool) : List Bool := let frame := machineKuhnTopFrame state let mate := machineMateVectorUpdateAtUnary @@ -245,6 +289,8 @@ def machineKuhnSearchReturnSuccessControl (state : List Bool) : List Bool := machineKuhnControlReturn [true] (machineKuhnRetSeen state) mate (machineKuhnRestStack state) +/-- After a failed recursive search, resumes the saved row and remaining columns with the saved +matching and returned seen bits. -/ def machineKuhnSearchReturnFailureControl (state : List Bool) : List Bool := let frame := machineKuhnTopFrame state machineKuhnControlCall (machineKuhnSearchFrameFuel frame) @@ -252,28 +298,37 @@ def machineKuhnSearchReturnFailureControl (state : List Bool) : List Bool := (machineKuhnSearchFrameRow frame) (machineKuhnRetSeen state) (machineKuhnSearchFrameMate frame) (machineKuhnRestStack state) +/-- Chooses the search-continuation success or failure transition using the return success bit. -/ def machineKuhnSearchReturnControl (state : List Bool) : List Bool := machineIfHead (machineKuhnRetSuccess state) (machineKuhnSearchReturnSuccessControl state) (machineKuhnSearchReturnFailureControl state) +/-- Uses the returned matching after success and the build continuation's fallback matching +after failure. -/ def machineKuhnBuildChosenMate (state : List Bool) : List Bool := let frame := machineKuhnTopFrame state machineIfHead (machineKuhnRetSuccess state) (machineKuhnRetMate state) (machineKuhnBuildFrameFallback frame) +/-- Reads the remaining rows from the top build continuation. -/ def machineKuhnBuildRows (state : List Bool) : List Bool := machineKuhnBuildFrameRows (machineKuhnTopFrame state) +/-- Builds the next continuation with the remaining-row tail and the selected matching as +fallback. -/ def machineKuhnBuildNextFrame (state : List Bool) : List Bool := pair [true] (machineKuhnBuildFramePack (machineListTail (machineKuhnBuildRows state)) (machineKuhnBuildChosenMate state)) +/-- Replaces the completed build continuation with its successor on the remaining stack. -/ def machineKuhnBuildNextStack (state : List Bool) : List Bool := machineKuhnStackPush (machineKuhnBuildNextFrame state) (machineKuhnRestStack state) +/-- Starts searching the next build row with fuel `n + 1`, all columns, fresh seen bits, the +selected matching, and the next build continuation. -/ def machineKuhnBuildContinueControl (state : List Bool) : List Bool := machineKuhnControlCall (true :: machineKuhnStateDimension state) (machineKuhnStateColumns state) @@ -281,20 +336,26 @@ def machineKuhnBuildContinueControl (state : List Bool) : List Bool := (machineKuhnStateFalseSeen state) (machineKuhnBuildChosenMate state) (machineKuhnBuildNextStack state) +/-- Completes matching construction when no build rows remain and otherwise starts the next row +search. -/ def machineKuhnBuildReturnControl (state : List Bool) : List Bool := machineIfEmpty (machineKuhnBuildRows state) (machineKuhnControlDone (machineKuhnBuildChosenMate state)) (machineKuhnBuildContinueControl state) +/-- Dispatches a nonempty return stack to its build or search continuation using the top frame +tag. -/ def machineKuhnNonemptyReturnControl (state : List Bool) : List Bool := machineIfHead (machineKuhnFrameTag (machineKuhnTopFrame state)) (machineKuhnBuildReturnControl state) (machineKuhnSearchReturnControl state) +/-- Preserves a return with empty stack and otherwise processes its top continuation frame. -/ def machineKuhnReturnControl (state : List Bool) : List Bool := machineIfEmpty (machineKuhnRetStack state) (machineKuhnControl state) (machineKuhnNonemptyReturnControl state) +/-- Preserves the control word of a completed Kuhn machine state. -/ def machineKuhnDoneControl (state : List Bool) : List Bool := machineKuhnControl state diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineLengthBits.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineLengthBits.lean index 919e13a219..4ecef17096 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineLengthBits.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineLengthBits.lean @@ -22,11 +22,14 @@ namespace BeyondBethe open Complexity +/-- Increments a binary accumulator by one for the word-length counter. -/ def machineLengthBitsStep (acc : List Bool) : List Bool := machineBinaryAddBits (pair acc [true]) +/-- Uses the original input word as the width bound for its binary length counter. -/ def machineLengthBitsWidth (word : List Bool) : List Bool := word +/-- Computes the binary word length by iterating increment from zero once per input bit. -/ def machineLengthBits (word : List Bool) : List Bool := (machineLengthBitsStep)^[word.length] [] diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineListIndex.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineListIndex.lean index bafe54973d..e54427b1e5 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineListIndex.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineListIndex.lean @@ -24,12 +24,15 @@ namespace BeyondBethe open Complexity +/-- Extracts the unary index ruler from a list-index request. -/ def machineListIndexRuler (word : List Bool) : List Bool := machinePairFirst word +/-- Extracts the encoded list from a list-index request. -/ def machineListIndexData (word : List Bool) : List Bool := machinePairSecond word +/-- Drops as many encoded list entries as the length of the unary index ruler. -/ def machineListIndexFinalState (word : List Bool) : List Bool := (machineListTail)^[(machineListIndexRuler word).length] (machineListIndexData word) diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineListReverse.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineListReverse.lean index fba0c90058..270ac8c170 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineListReverse.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineListReverse.lean @@ -25,46 +25,61 @@ namespace BeyondBethe open Complexity +/-- Packs the unprocessed list, reversed accumulator, and length-bound word for list reversal. -/ def machineListReversePack (remaining accumulator bound : List Bool) : List Bool := pair remaining (pair accumulator bound) +/-- Extracts the unprocessed encoded list from a reversal state. -/ def machineListReverseRemaining (state : List Bool) : List Bool := machinePairFirst state +/-- Extracts the reversed-prefix accumulator from a reversal state. -/ def machineListReverseAccumulator (state : List Bool) : List Bool := machinePairFirst (machinePairSecond state) +/-- Extracts the word bounding accumulator length in a reversal state. -/ def machineListReverseBound (state : List Bool) : List Bool := machinePairSecond (machinePairSecond state) +/-- Prepends the next unprocessed list entry to the reversed accumulator. -/ def machineListReverseCandidate (state : List Bool) : List Bool := pair (machineListHead (machineListReverseRemaining state)) (machineListReverseAccumulator state) +/-- Truncates the candidate reversed accumulator to the length of the stored bound. -/ def machineListReverseNextAccumulator (state : List Bool) : List Bool := (machineListReverseCandidate state).take (machineListReverseBound state).length +/-- Drops the next input entry and records the bounded reversed accumulator while preserving the +bound. -/ def machineListReverseAdvance (state : List Bool) : List Bool := machineListReversePack (machineListTail (machineListReverseRemaining state)) (machineListReverseNextAccumulator state) (machineListReverseBound state) +/-- Fixes an exhausted reversal state and otherwise transfers one entry to the reversed +accumulator. -/ def machineListReverseStep (state : List Bool) : List Bool := machineIfEmpty (machineListReverseRemaining state) state (machineListReverseAdvance state) +/-- Initializes reversal with the input list, empty accumulator, and the input word itself as +bound. -/ def machineListReverseInit (word : List Bool) : List Bool := machineListReversePack word [] word +/-- Packs three copies of the input word to bound the encoded reversal state. -/ def machineListReverseWidth (word : List Bool) : List Bool := machineListReversePack word word word +/-- Iterates the reversal step once per input bit from the initial state. -/ def machineListReverseFinalState (word : List Bool) : List Bool := (machineListReverseStep)^[word.length] (machineListReverseInit word) +/-- Extracts the reversed encoded list from the final reversal state. -/ def machineListReverse (word : List Bool) : List Bool := machineListReverseAccumulator (machineListReverseFinalState word) @@ -129,6 +144,8 @@ theorem machineListReverseWidth_mem_FP : machineListReverseBound (machineListReversePack a b c) = c := by simp [machineListReverseBound, machineListReversePack] +/-- Requires exact reversal-state packing, remaining and accumulator lengths bounded by the +original word, and that original word as the bound. -/ def MachineListReverseStateBound (word state : List Bool) : Prop := state = machineListReversePack (machineListReverseRemaining state) @@ -198,6 +215,8 @@ theorem machineListReverse_mem_FP : machineListReverse ∈ Complexity.FP := by /-! ## Exact semantics on canonical list codes -/ +/-- Encodes the unprocessed suffix, reversed processed prefix, and original-list bound after `k` +reversal steps. -/ def machineListReverseSemanticState {alpha : Type*} (encode : alpha → List Bool) (xs : List alpha) (k : ℕ) : List Bool := diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineListUpdate.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineListUpdate.lean index 6616e6e02c..2bb21c9919 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineListUpdate.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineListUpdate.lean @@ -28,50 +28,67 @@ open Complexity /-! ## Forward scan -/ +/-- Extracts the unary target-index ruler from a list-update request. -/ def machineListUpdateRuler (word : List Bool) : List Bool := machinePairFirst word +/-- Extracts the replacement-and-list payload from a list-update request. -/ def machineListUpdatePayload (word : List Bool) : List Bool := machinePairSecond word +/-- Extracts the encoded replacement entry from a list-update request. -/ def machineListUpdateReplacement (word : List Bool) : List Bool := machinePairFirst (machineListUpdatePayload word) +/-- Extracts the encoded list to update. -/ def machineListUpdateData (word : List Bool) : List Bool := machinePairSecond (machineListUpdatePayload word) +/-- Applies the binary-multiplication width construction twice to bound the list-update +computation. -/ def machineListUpdateInputBound (word : List Bool) : List Bool := machineBinaryMulWidth (machineBinaryMulWidth word) +/-- Packs the remaining index ruler, reversed prefix, current suffix, replacement, and bound for +the update scan. -/ def machineListUpdateScanPack (remaining pref current replacement bound : List Bool) : List Bool := pair remaining (pair pref (pair current (pair replacement bound))) +/-- Extracts the unconsumed unary index ruler from an update scan state. -/ def machineListUpdateScanRemaining (state : List Bool) : List Bool := machinePairFirst state +/-- Extracts the reversed processed prefix from an update scan state. -/ def machineListUpdateScanPrefix (state : List Bool) : List Bool := machinePairFirst (machinePairSecond state) +/-- Extracts the current unprocessed list suffix from an update scan state. -/ def machineListUpdateScanCurrent (state : List Bool) : List Bool := machinePairFirst (machinePairSecond (machinePairSecond state)) +/-- Extracts the replacement entry stored in an update scan state. -/ def machineListUpdateScanReplacement (state : List Bool) : List Bool := machinePairFirst (machinePairSecond (machinePairSecond (machinePairSecond state))) +/-- Extracts the bound word stored in an update scan state. -/ def machineListUpdateScanBound (state : List Bool) : List Bool := machinePairSecond (machinePairSecond (machinePairSecond (machinePairSecond state))) +/-- Prepends the current suffix head to the reversed processed prefix. -/ def machineListUpdateScanPrefixCandidate (state : List Bool) : List Bool := pair (machineListHead (machineListUpdateScanCurrent state)) (machineListUpdateScanPrefix state) +/-- Truncates the updated reversed prefix to the length of the scan bound. -/ def machineListUpdateScanNextPrefix (state : List Bool) : List Bool := (machineListUpdateScanPrefixCandidate state).take (machineListUpdateScanBound state).length +/-- Consumes one index-ruler bit and one list entry, extending the bounded reversed prefix while +retaining replacement and bound. -/ def machineListUpdateScanAdvance (state : List Bool) : List Bool := machineListUpdateScanPack (machineListUpdateScanRemaining state).tail @@ -80,20 +97,26 @@ def machineListUpdateScanAdvance (state : List Bool) : List Bool := (machineListUpdateScanReplacement state) (machineListUpdateScanBound state) +/-- Fixes an update scan when either the index ruler or current suffix is exhausted and +otherwise advances once. -/ def machineListUpdateScanStep (state : List Bool) : List Bool := machineIfEmpty (machineListUpdateScanRemaining state) state (machineIfEmpty (machineListUpdateScanCurrent state) state (machineListUpdateScanAdvance state)) +/-- Initializes the update scan with the requested index, empty prefix, input list, replacement, +and computed bound. -/ def machineListUpdateScanInit (word : List Bool) : List Bool := machineListUpdateScanPack (machineListUpdateRuler word) [] (machineListUpdateData word) (machineListUpdateReplacement word) (machineListUpdateInputBound word) +/-- Packs five copies of the input bound to bound the encoded update-scan state. -/ def machineListUpdateScanWidth (word : List Bool) : List Bool := let bound := machineListUpdateInputBound word machineListUpdateScanPack bound bound bound bound bound +/-- Runs the update scan for the length of the requested unary index ruler. -/ def machineListUpdateScanFinalState (word : List Bool) : List Bool := (machineListUpdateScanStep)^[(machineListUpdateRuler word).length] (machineListUpdateScanInit word) @@ -250,6 +273,8 @@ theorem machineListUpdate_word_length_le_bound (word : List Bool) : List.length_replicate, List.length_append] nlinarith +/-- Requires exact update-scan packing and bounds all five field lengths by the computed +input-bound length. -/ def MachineListUpdateScanStateBound (word state : List Bool) : Prop := let B := (machineListUpdateInputBound word).length @@ -348,6 +373,8 @@ theorem machineListUpdateScanFinalState_mem_FP : /-! ## Reverse-prefix rebuild -/ +/-- Builds the updated suffix by replacing its head and truncating to the stored bound; an +exhausted suffix gives the empty word. -/ def machineListUpdateSeed (word : List Bool) : List Bool := let scan := machineListUpdateScanFinalState word machineIfEmpty (machineListUpdateScanCurrent scan) [] @@ -355,46 +382,58 @@ def machineListUpdateSeed (word : List Bool) : List Bool := (machineListTail (machineListUpdateScanCurrent scan))).take (machineListUpdateScanBound scan).length) +/-- Packs the reversed prefix, current output, and bound for rebuilding the updated list. -/ def machineListUpdateRebuildPack (pref output bound : List Bool) : List Bool := pair pref (pair output bound) +/-- Extracts the remaining reversed prefix from a list-update rebuild state. -/ def machineListUpdateRebuildPrefix (state : List Bool) : List Bool := machinePairFirst state +/-- Extracts the reconstructed output list from a list-update rebuild state. -/ def machineListUpdateRebuildOutput (state : List Bool) : List Bool := machinePairFirst (machinePairSecond state) +/-- Extracts the stored width bound from a list-update rebuild state. -/ def machineListUpdateRebuildBound (state : List Bool) : List Bool := machinePairSecond (machinePairSecond state) +/-- Prepends the next saved prefix entry to the reconstructed output list. -/ def machineListUpdateRebuildCandidate (state : List Bool) : List Bool := pair (machineListHead (machineListUpdateRebuildPrefix state)) (machineListUpdateRebuildOutput state) +/-- Truncates the rebuilt candidate list to the stored width bound. -/ def machineListUpdateRebuildNextOutput (state : List Bool) : List Bool := (machineListUpdateRebuildCandidate state).take (machineListUpdateRebuildBound state).length +/-- Consumes one saved prefix entry and updates the bounded reconstructed list. -/ def machineListUpdateRebuildAdvance (state : List Bool) : List Bool := machineListUpdateRebuildPack (machineListTail (machineListUpdateRebuildPrefix state)) (machineListUpdateRebuildNextOutput state) (machineListUpdateRebuildBound state) +/-- Rebuilds one prefix entry, leaving states with no saved prefix fixed. -/ def machineListUpdateRebuildStep (state : List Bool) : List Bool := machineIfEmpty (machineListUpdateRebuildPrefix state) state (machineListUpdateRebuildAdvance state) +/-- Starts reconstruction from the scanned reversed prefix, updated suffix seed, and stored +bound. -/ def machineListUpdateRebuildInit (word : List Bool) : List Bool := let scan := machineListUpdateScanFinalState word machineListUpdateRebuildPack (machineListUpdateScanPrefix scan) (machineListUpdateSeed word) (machineListUpdateScanBound scan) +/-- Packs three copies of the input-derived bound to bound a rebuild state. -/ def machineListUpdateRebuildWidth (word : List Bool) : List Bool := let bound := machineListUpdateInputBound word machineListUpdateRebuildPack bound bound bound +/-- Runs the rebuild step for the number of iterations specified by the update ruler. -/ def machineListUpdateRebuildFinalState (word : List Bool) : List Bool := (machineListUpdateRebuildStep)^[(machineListUpdateRuler word).length] (machineListUpdateRebuildInit word) @@ -492,6 +531,7 @@ theorem machineListUpdateRebuildWidth_mem_FP : (machineListUpdateRebuildPack a b c) = c := by simp [machineListUpdateRebuildBound, machineListUpdateRebuildPack] +/-- Bounds all components of a canonically packed list-update rebuild state. -/ def MachineListUpdateRebuildStateBound (word state : List Bool) : Prop := let B := (machineListUpdateInputBound word).length @@ -643,12 +683,15 @@ theorem binaryListCode_element_length_le omega · exact (ih hx).trans (by simp [binaryListCode]) +/-- Encodes a unary update index, replacement entry, and original list. -/ def machineListUpdateCanonicalInput {α : Type*} (encode : α → List Bool) (xs : List α) (replacement : α) (index : ℕ) : List Bool := pair (List.replicate index true) (pair (encode replacement) (binaryListCode encode xs)) +/-- Encodes the scan after `k` entries, with the reversed prefix, remaining suffix, and residual +index. -/ def machineListUpdateScanSemanticState {α : Type*} (encode : α → List Bool) (xs : List α) (replacement : α) (index k : ℕ) : List Bool := @@ -830,6 +873,8 @@ theorem machineListUpdateSeed_semantics have hlen := congrArg List.length hnil simp [binaryListCode] at hlen +/-- Encodes reconstruction after `k` saved-prefix entries have been restored before the updated +suffix. -/ def machineListUpdateRebuildSemanticState {α : Type*} (encode : α → List Bool) (xs : List α) (replacement : α) (index k : ℕ) : List Bool := diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineMatchingGain.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineMatchingGain.lean index dd419e2add..05b23b2eda 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineMatchingGain.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineMatchingGain.lean @@ -25,47 +25,60 @@ namespace BeyondBethe open Complexity +/-- Encodes a list-count state as remaining list, binary counter, and source word. -/ def machineListCountPack (remaining counter source : List Bool) : List Bool := pair remaining (pair counter source) +/-- Extracts the unprocessed list suffix from the counting state. -/ def machineListCountRemaining (state : List Bool) : List Bool := machinePairFirst state +/-- Extracts the binary count from the list-count state. -/ def machineListCountCounter (state : List Bool) : List Bool := machinePairFirst (machinePairSecond state) +/-- Extracts the original encoded list from the counting state. -/ def machineListCountSource (state : List Bool) : List Bool := machinePairSecond (machinePairSecond state) +/-- Pairs a false bit with the source list to provide a count-state width bound. -/ def machineListCountInputBound (word : List Bool) : List Bool := pair [false] word +/-- Reads the count-state bound derived from the original list. -/ def machineListCountBound (state : List Bool) : List Bool := machineListCountInputBound (machineListCountSource state) +/-- Increments the binary count and truncates it to the source-derived width bound. -/ def machineListCountNextCounter (state : List Bool) : List Bool := (machineBinaryAddBits (pair (machineListCountCounter state) [true])).take (machineListCountBound state).length +/-- Consumes one encoded list entry and updates the bounded count. -/ def machineListCountProcess (state : List Bool) : List Bool := machineListCountPack (machineListTail (machineListCountRemaining state)) (machineListCountNextCounter state) (machineListCountSource state) +/-- Counts the next entry, leaving an exhausted list-count state fixed. -/ def machineListCountStep (state : List Bool) : List Bool := machineIfEmpty (machineListCountRemaining state) state (machineListCountProcess state) +/-- Initializes list counting with the entire input list and a zero counter. -/ def machineListCountInit (word : List Bool) : List Bool := machineListCountPack word [] word +/-- Packs three copies of the source-derived bound to bound the full counting state. -/ def machineListCountWidth (word : List Bool) : List Bool := let bound := machineListCountInputBound word machineListCountPack bound bound bound +/-- Counts encoded list entries using at most one step per input bit and returns the binary +count. -/ def machineEncodedListLengthBits (word : List Bool) : List Bool := machineListCountCounter ((machineListCountStep)^[word.length] (machineListCountInit word)) @@ -139,6 +152,7 @@ theorem machineListCountWidth_mem_FP : (machineListCountPack remaining counter source) = source := by simp [machineListCountSource, machineListCountPack] +/-- Bounds the remaining-list and counter lengths while preserving the original encoded list. -/ def MachineListCountStateBound (word state : List Bool) : Prop := let B := (machineListCountInputBound word).length state = machineListCountPack (machineListCountRemaining state) @@ -221,6 +235,7 @@ theorem machineEncodedListLengthBits_mem_FP : /-! ## Exact counting semantics -/ +/-- Encodes a counting state with suffix `xs.drop k`, counter `k`, and the original list. -/ def machineListCountSemanticState {alpha : Type*} (encode : alpha → List Bool) (xs : List alpha) (k : ℕ) : List Bool := machineListCountPack (binaryListCode encode (xs.drop k)) k.bits @@ -311,17 +326,23 @@ theorem machineListCount_done_iterate /-! ## Fixed-gain assembly -/ +/-- Encodes the computed list length as a nonnegative raw rational with denominator one. -/ def machineListCountRawNatCode (word : List Bool) : List Bool := pair (machineNaturalIntegerCode (machineEncodedListLengthBits word)) [true] +/-- The raw-rational representation of the fixed matching-gain coefficient `explicitGamma`. -/ def rawExplicitGamma : RawRat := rawRatOfRat explicitGamma +/-- Multiplies the selected-pair count by `explicitGamma` and normalizes the resulting rational +entry. -/ def machineMatchingGainFromSelected (selectedWord : List Bool) : List Bool := machineNormalizeRawRatEntryCode (machineRawRatMulCode (pair (rawRatBinaryCode rawExplicitGamma) (machineListCountRawNatCode selectedWord))) +/-- Computes the explicit matching gain from the greedy selection in the input's second +component. -/ def machineExplicitMatchingGainRawCode (word : List Bool) : List Bool := machineMatchingGainFromSelected (machineGreedyMatchingSelected (machinePairSecond word)) diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineMateAllSome.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineMateAllSome.lean index 41bdeb0847..16718d807a 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineMateAllSome.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineMateAllSome.lean @@ -23,49 +23,64 @@ namespace BeyondBethe open Complexity +/-- Encodes a mate-completeness scan as remaining entries, remaining ruler, and accumulated +success bit. -/ def machineMateAllSomePack (remaining ruler ok : List Bool) : List Bool := pair remaining (pair ruler ok) +/-- Extracts the unprocessed mate-vector entries. -/ def machineMateAllSomeRemaining (state : List Bool) : List Bool := machinePairFirst state +/-- Extracts the remaining iteration ruler from the mate-completeness state. -/ def machineMateAllSomeRulerState (state : List Bool) : List Bool := machinePairFirst (machinePairSecond state) +/-- Extracts the accumulated flag that all examined mate entries are present. -/ def machineMateAllSomeOk (state : List Bool) : List Bool := machinePairSecond (machinePairSecond state) +/-- Reads the presence bit of the current encoded mate entry. -/ def machineMateAllSomeCurrentBit (state : List Bool) : List Bool := machineHeadBit (machineListHead (machineMateAllSomeRemaining state)) +/-- Consumes one mate entry and ruler bit, conjoining its presence with the accumulated flag. -/ def machineMateAllSomeAdvance (state : List Bool) : List Bool := machineMateAllSomePack (machineListTail (machineMateAllSomeRemaining state)) (machineMateAllSomeRulerState state).tail (machineAndBit (machineMateAllSomeOk state) (machineMateAllSomeCurrentBit state)) +/-- Checks the next mate entry, leaving states with an exhausted ruler fixed. -/ def machineMateAllSomeStep (state : List Bool) : List Bool := machineIfEmpty (machineMateAllSomeRulerState state) state (machineMateAllSomeAdvance state) +/-- Extracts the input ruler specifying how many mate entries to check. -/ def machineMateAllSomeInputRuler (word : List Bool) : List Bool := machinePairFirst word +/-- Extracts the encoded mate vector from the completeness-test input. -/ def machineMateAllSomeInputMate (word : List Bool) : List Bool := machinePairSecond word +/-- Initializes mate completeness checking with the supplied vector, ruler, and a true success +flag. -/ def machineMateAllSomeInit (word : List Bool) : List Bool := machineMateAllSomePack (machineMateAllSomeInputMate word) (machineMateAllSomeInputRuler word) [true] +/-- Uses the binary-multiplication width constructor to bound mate-completeness states. -/ def machineMateAllSomeWidth (word : List Bool) : List Bool := machineBinaryMulWidth word +/-- Runs one mate-completeness step per bit of the input ruler. -/ def machineMateAllSomeFinalState (word : List Bool) : List Bool := (machineMateAllSomeStep^[(machineMateAllSomeInputRuler word).length]) (machineMateAllSomeInit word) +/-- Extracts the final flag that every ruler-selected mate entry is present. -/ def machineMateAllSomeBit (word : List Bool) : List Bool := machineMateAllSomeOk (machineMateAllSomeFinalState word) @@ -142,6 +157,7 @@ theorem machineMateAllSomeWidth_mem_FP : (machineMateAllSomeCurrentBit state).length = 1 := by exact machineHeadBit_length _ +/-- Bounds remaining mate entries, ruler length, and accumulated flag in a packed state. -/ def MachineMateAllSomeStateBound (word state : List Bool) : Prop := state = machineMateAllSomePack (machineMateAllSomeRemaining state) (machineMateAllSomeRulerState state) (machineMateAllSomeOk state) ∧ @@ -236,6 +252,8 @@ theorem machineMateAllSomeBit_mem_FP : machineHeadBit (mateValueCode value) = [value.isSome] := by cases value <;> simp [machineHeadBit, mateValueCode] +/-- Encodes the semantic state after checking `k` mates, recording whether all checked entries +are present. -/ def mateAllSomeSemanticState (mate : List (Option ℕ)) (k : ℕ) : List Bool := machineMateAllSomePack (mateVectorCode (mate.drop k)) (List.replicate (mate.length - k) true) diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineMateMemory.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineMateMemory.lean index a7c3baaba3..1df1111fea 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineMateMemory.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineMateMemory.lean @@ -24,19 +24,24 @@ namespace BeyondBethe open Complexity +/-- Encodes absence by a false bit and a present row by a true bit followed by its unary index. -/ def mateValueCode : Option ℕ → List Bool | none => [false] | some row => true :: List.replicate row true +/-- Encodes a list of optional row mates using the tagged mate-value encoding. -/ def mateVectorCode (mate : List (Option ℕ)) : List Bool := binaryListCode mateValueCode mate +/-- Tests for an absent mate by negating its presence bit. -/ def machineMateValueIsNoneBit (value : List Bool) : List Bool := machineNotBit (machineHeadBit value) +/-- Drops the presence tag to extract the unary row index of an encoded mate. -/ def machineMateValueRowUnary (value : List Bool) : List Bool := value.tail +/-- Looks up a mate-vector entry at an encoded unary index. -/ def machineMateVectorGetAtUnary (word : List Bool) : List Bool := machineListIndex word diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineMatrixAddDelta.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineMatrixAddDelta.lean index f8c48fb6f2..52b27f9f28 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineMatrixAddDelta.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineMatrixAddDelta.lean @@ -26,12 +26,15 @@ namespace BeyondBethe open Complexity +/-- Extracts the encoded rational increment from the matrix-addition input. -/ def machineMatrixAddDeltaInputDelta (word : List Bool) : List Bool := machinePairFirst word +/-- Extracts the encoded matrix from the matrix-addition input. -/ def machineMatrixAddDeltaInputMatrix (word : List Bool) : List Bool := machinePairSecond word +/-- Concatenates twenty copies of the input for the matrix-addition width estimate. -/ def machineMatrixAddDeltaPadTwenty (word : List Bool) : List Bool := machineRationalRowAddPadSixteen word ++ machineRationalRowAddPadFour word @@ -42,43 +45,56 @@ row-machine envelope used in the first implementation. -/ def machineMatrixAddDeltaInputBound (word : List Bool) : List Bool := machineBinaryMulWidth (machineMatrixAddDeltaPadTwenty word) +/-- Encodes matrix-addition state as remaining rows, reversed output, increment, dimension, and +bound. -/ def machineMatrixAddDeltaPack (remaining accumulator delta dimension bound : List Bool) : List Bool := pair remaining (pair accumulator (pair delta (pair dimension bound))) +/-- Extracts the unprocessed rows from a matrix-addition state. -/ def machineMatrixAddDeltaRemaining (state : List Bool) : List Bool := machinePairFirst state +/-- Extracts the reversed accumulated output rows from a matrix-addition state. -/ def machineMatrixAddDeltaAccumulator (state : List Bool) : List Bool := machinePairFirst (machinePairSecond state) +/-- Extracts the fixed rational increment from the matrix-addition state. -/ def machineMatrixAddDeltaDelta (state : List Bool) : List Bool := machinePairFirst (machinePairSecond (machinePairSecond state)) +/-- Extracts the binary matrix dimension from the matrix-addition state. -/ def machineMatrixAddDeltaDimension (state : List Bool) : List Bool := machinePairFirst (machinePairSecond (machinePairSecond (machinePairSecond state))) +/-- Extracts the stored width bound from the matrix-addition state. -/ def machineMatrixAddDeltaBound (state : List Bool) : List Bool := machinePairSecond (machinePairSecond (machinePairSecond (machinePairSecond state))) +/-- Reads the first unprocessed row of the matrix. -/ def machineMatrixAddDeltaCurrentRow (state : List Bool) : List Bool := machineListHead (machineMatrixAddDeltaRemaining state) +/-- Adds the fixed rational increment to each entry of the current row. -/ def machineMatrixAddDeltaOutputRow (state : List Bool) : List Bool := machineRationalRowAdd (pair (machineMatrixAddDeltaDelta state) (machineMatrixAddDeltaCurrentRow state)) +/-- Prepends the incremented row to the reversed output accumulator. -/ def machineMatrixAddDeltaCandidate (state : List Bool) : List Bool := pair (machineMatrixAddDeltaOutputRow state) (machineMatrixAddDeltaAccumulator state) +/-- Truncates the candidate row accumulator to the stored width bound. -/ def machineMatrixAddDeltaNextAccumulator (state : List Bool) : List Bool := (machineMatrixAddDeltaCandidate state).take (machineMatrixAddDeltaBound state).length +/-- Consumes one row and stores its incremented output, preserving the increment, dimension, and +bound. -/ def machineMatrixAddDeltaAdvance (state : List Bool) : List Bool := machineMatrixAddDeltaPack (machineListTail (machineMatrixAddDeltaRemaining state)) @@ -87,10 +103,13 @@ def machineMatrixAddDeltaAdvance (state : List Bool) : List Bool := (machineMatrixAddDeltaDimension state) (machineMatrixAddDeltaBound state) +/-- Processes the next matrix row, leaving exhausted matrix-addition states fixed. -/ def machineMatrixAddDeltaStep (state : List Bool) : List Bool := machineIfEmpty (machineMatrixAddDeltaRemaining state) state (machineMatrixAddDeltaAdvance state) +/-- Initializes matrix addition with the source rows, empty output, increment, dimension, and +input bound. -/ def machineMatrixAddDeltaInit (word : List Bool) : List Bool := machineMatrixAddDeltaPack (machineMatrixRowsWord (machineMatrixAddDeltaInputMatrix word)) [] @@ -98,15 +117,19 @@ def machineMatrixAddDeltaInit (word : List Bool) : List Bool := (machineMatrixDimensionWord (machineMatrixAddDeltaInputMatrix word)) (machineMatrixAddDeltaInputBound word) +/-- Builds an encoded width envelope for the five components of a matrix-addition state. -/ def machineMatrixAddDeltaWidth (word : List Bool) : List Bool := machineMatrixAddDeltaPack word (machineMatrixAddDeltaInputBound word) (machineMatrixAddDeltaInputDelta word) word (machineMatrixAddDeltaInputBound word) +/-- Runs matrix addition for one step per input bit. -/ def machineMatrixAddDeltaFinalState (word : List Bool) : List Bool := (machineMatrixAddDeltaStep)^[word.length] (machineMatrixAddDeltaInit word) +/-- Pairs the matrix dimension with the accumulated output rows restored to their original +order. -/ def machineMatrixAddDeltaEntries (word : List Bool) : List Bool := let state := machineMatrixAddDeltaFinalState word pair (machineMatrixAddDeltaDimension state) @@ -261,6 +284,7 @@ theorem machineMatrixAddDeltaWidth_mem_FP : (machineMatrixAddDeltaPack a b c d e) = e := by simp [machineMatrixAddDeltaBound, machineMatrixAddDeltaPack] +/-- Bounds matrix-addition state lengths and preserves the input increment and width bound. -/ def MachineMatrixAddDeltaStateBound (word state : List Bool) : Prop := state = machineMatrixAddDeltaPack (machineMatrixAddDeltaRemaining state) @@ -540,15 +564,19 @@ theorem machineMatrixAddDelta_outputRows_length_le_bound {n : ℕ} /-! ## Exact semantics -/ +/-- Adds the raw-rational increment to every entry of every supplied row. -/ def rationalMatrixAddRows (delta : RawRat) (rows : List (List ℚ)) : List (List ℚ) := rows.map (rationalRowAddValues delta) +/-- Encodes a square rational matrix together with the raw-rational increment to add. -/ def machineMatrixAddDeltaCanonicalInput {n : ℕ} (delta : RawRat) (A : Matrix (Fin n) (Fin n) ℚ) : List Bool := pair (rawRatBinaryCode delta) (rationalMatrixBinaryEncoding.encode ⟨n, A⟩) +/-- Encodes matrix addition after `k` rows, with untouched remaining rows and reversed processed +output. -/ def machineMatrixAddDeltaSemanticState (word dimension : List Bool) (delta : RawRat) (rows : List (List ℚ)) (k : ℕ) : List Bool := @@ -750,6 +778,7 @@ theorem machineMatrixAddDeltaFinalState_encode {n : ℕ} binaryListCode] rw [htakeAll, machineMatrixAddDelta_done_iterate] +/-- Adds `delta.value` to every entry of a square rational matrix. -/ def rationalMatrixAddDeltaSemantic {n : ℕ} (A : Matrix (Fin n) (Fin n) ℚ) (delta : RawRat) : Matrix (Fin n) (Fin n) ℚ := diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineMatrixDimension.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineMatrixDimension.lean index 9b004f052f..b87993ebc7 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineMatrixDimension.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineMatrixDimension.lean @@ -24,6 +24,7 @@ namespace BeyondBethe open Complexity +/-- Converts the encoded binary matrix dimension to a unary ruler bounded by the input length. -/ def machineMatrixDimensionUnary (word : List Bool) : List Bool := machineBoundedUnary (pair word (machineMatrixDimensionWord word)) diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineMatrixNonnegative.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineMatrixNonnegative.lean index 2bada85818..9963c4d610 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineMatrixNonnegative.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineMatrixNonnegative.lean @@ -24,28 +24,35 @@ namespace BeyondBethe open Complexity +/-- Encodes a nonnegativity scan as remaining rows, current row, and accumulated success flag. -/ def machineMatrixNonnegativePack (rows current ok : List Bool) : List Bool := pair rows (pair current ok) +/-- Extracts the rows still to be loaded by the nonnegativity scan. -/ def machineMatrixNonnegativeRows (state : List Bool) : List Bool := machinePairFirst state +/-- Extracts the unprocessed suffix of the current row. -/ def machineMatrixNonnegativeCurrent (state : List Bool) : List Bool := machinePairFirst (machinePairSecond state) +/-- Extracts the accumulated nonnegativity flag. -/ def machineMatrixNonnegativeOk (state : List Bool) : List Bool := machinePairSecond (machinePairSecond state) +/-- Reads the next rational entry of the current row. -/ def machineMatrixNonnegativeEntry (state : List Bool) : List Bool := machineListHead (machineMatrixNonnegativeCurrent state) +/-- Tests whether the current encoded rational matrix entry is at least zero. -/ def machineMatrixNonnegativeEntryBit (state : List Bool) : List Bool := machineHeadBit (machineRawRatLeBit (pair (rawRatBinaryCode RawRat.zero) (machineMatrixNonnegativeEntry state))) +/-- Consumes one entry and conjoins its nonnegativity test with the accumulated flag. -/ def machineMatrixNonnegativeProcessEntry (state : List Bool) : List Bool := machineMatrixNonnegativePack (machineMatrixNonnegativeRows state) @@ -53,27 +60,33 @@ def machineMatrixNonnegativeProcessEntry (state : List Bool) : List Bool := (machineAndBit (machineMatrixNonnegativeOk state) (machineMatrixNonnegativeEntryBit state)) +/-- Loads the next row while preserving the accumulated nonnegativity flag. -/ def machineMatrixNonnegativeLoadRow (state : List Bool) : List Bool := machineMatrixNonnegativePack (machineListTail (machineMatrixNonnegativeRows state)) (machineListHead (machineMatrixNonnegativeRows state)) (machineMatrixNonnegativeOk state) +/-- Loads another row when available, otherwise retaining the completed scan state. -/ def machineMatrixNonnegativeAfterRow (state : List Bool) : List Bool := machineIfEmpty (machineMatrixNonnegativeRows state) state (machineMatrixNonnegativeLoadRow state) +/-- Checks the next entry or loads a new row when the current row is exhausted. -/ def machineMatrixNonnegativeStep (state : List Bool) : List Bool := machineIfEmpty (machineMatrixNonnegativeCurrent state) (machineMatrixNonnegativeAfterRow state) (machineMatrixNonnegativeProcessEntry state) +/-- Initializes the nonnegativity scan with all matrix rows and a true success flag. -/ def machineMatrixNonnegativeInit (word : List Bool) : List Bool := machineMatrixNonnegativePack (machineMatrixRowsWord word) [] [true] +/-- Builds a width envelope for remaining rows, current row, and the one-bit success flag. -/ def machineMatrixNonnegativeWidth (word : List Bool) : List Bool := machineMatrixNonnegativePack word word [true] +/-- Runs the matrix nonnegativity scan for one step per input bit. -/ def machineMatrixNonnegativeFinalState (word : List Bool) : List Bool := (machineMatrixNonnegativeStep)^[word.length] (machineMatrixNonnegativeInit word) @@ -169,6 +182,7 @@ theorem machineMatrixNonnegativeWidth_mem_FP : (machineMatrixNonnegativePack rows current ok) = ok := by simp [machineMatrixNonnegativeOk, machineMatrixNonnegativePack] +/-- Bounds the remaining-row and current-row lengths and the one-bit success flag. -/ def MachineMatrixNonnegativeStateBound (word state : List Bool) : Prop := state = machineMatrixNonnegativePack @@ -274,6 +288,7 @@ theorem machineMatrixNonnegativeBit_mem_FP : /-! ## Exact semantics on canonical nested-list encodings -/ +/-- The Boolean test that a rational number is nonnegative. -/ def rationalNonnegativeBit (q : ℚ) : Bool := decide (0 ≤ q) theorem machineIfEmpty_of_ne_nil_matrix @@ -348,9 +363,11 @@ theorem binaryListCode_cons_ne_nil {α : Type*} machineMatrixNonnegativePack [] [] [ok] := by simp [machineMatrixNonnegativeStep, machineMatrixNonnegativeAfterRow] +/-- Tests whether every entry of a rational row is nonnegative. -/ def matrixNonnegativeRowBit (row : List ℚ) : Bool := row.all rationalNonnegativeBit +/-- Tests whether every entry of every supplied rational row is nonnegative. -/ def matrixNonnegativeRowsBit (rows : List (List ℚ)) : Bool := rows.all matrixNonnegativeRowBit @@ -370,6 +387,7 @@ theorem machineMatrixNonnegativeProcessRow_encode machineMatrixNonnegativeStep_entry_encode, ih] simp [matrixNonnegativeRowBit, Bool.and_assoc] +/-- Counts one row-loading step plus one test per entry across all rows. -/ def matrixNonnegativeRowsWork : List (List ℚ) → ℕ | [] => 0 | row :: rows => 1 + row.length + matrixNonnegativeRowsWork rows diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineMatrixNormalization.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineMatrixNormalization.lean index 527c808ff8..072ff31634 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineMatrixNormalization.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineMatrixNormalization.lean @@ -19,12 +19,14 @@ namespace BeyondBethe open Complexity +/-- Raises the raw-rational matrix normalization scale to the matrix dimension. -/ def machineMatrixNormalizationScalePowerRawCode (word : List Bool) : List Bool := machineRawRatPowerCode (pair (machineMatrixDimensionUnary word) (machineMatrixNormalizationScaleRawCode word)) +/-- Normalizes the encoded dimension-th power of the matrix normalization scale. -/ def machineMatrixNormalizationScalePowerOutputCode (word : List Bool) : List Bool := machineNormalizeRawRatBinaryCode diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineMatrixNormalizeEntries.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineMatrixNormalizeEntries.lean index 443b03a1ea..59ecfa357f 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineMatrixNormalizeEntries.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineMatrixNormalizeEntries.lean @@ -25,6 +25,7 @@ namespace BeyondBethe open Complexity +/-- Concatenates twenty copies of the input for the matrix-normalization width estimate. -/ def machineMatrixNormalizePadTwenty (word : List Bool) : List Bool := machineRationalRowDividePadSixteen word ++ machineRationalRowDividePadFour word @@ -35,43 +36,55 @@ row-machine envelope used in the first implementation. -/ def machineMatrixNormalizeInputBound (word : List Bool) : List Bool := machineBinaryMulWidth (machineMatrixNormalizePadTwenty word) +/-- Encodes normalization state as remaining rows, reversed output, scale, dimension, and bound. -/ def machineMatrixNormalizePack (remaining accumulator scale dimension bound : List Bool) : List Bool := pair remaining (pair accumulator (pair scale (pair dimension bound))) +/-- Extracts the unprocessed rows from a matrix-normalization state. -/ def machineMatrixNormalizeRemaining (state : List Bool) : List Bool := machinePairFirst state +/-- Extracts the reversed accumulated normalized rows. -/ def machineMatrixNormalizeAccumulator (state : List Bool) : List Bool := machinePairFirst (machinePairSecond state) +/-- Extracts the fixed raw-rational normalization scale. -/ def machineMatrixNormalizeScale (state : List Bool) : List Bool := machinePairFirst (machinePairSecond (machinePairSecond state)) +/-- Extracts the binary dimension retained in the normalization state. -/ def machineMatrixNormalizeDimension (state : List Bool) : List Bool := machinePairFirst (machinePairSecond (machinePairSecond (machinePairSecond state))) +/-- Extracts the stored width bound from the normalization state. -/ def machineMatrixNormalizeBound (state : List Bool) : List Bool := machinePairSecond (machinePairSecond (machinePairSecond (machinePairSecond state))) +/-- Reads the first unprocessed row to normalize. -/ def machineMatrixNormalizeCurrentRow (state : List Bool) : List Bool := machineListHead (machineMatrixNormalizeRemaining state) +/-- Divides every entry of the current row by the stored normalization scale. -/ def machineMatrixNormalizeOutputRow (state : List Bool) : List Bool := machineRationalRowDivide (pair (machineMatrixNormalizeScale state) (machineMatrixNormalizeCurrentRow state)) +/-- Prepends the normalized current row to the reversed output accumulator. -/ def machineMatrixNormalizeCandidate (state : List Bool) : List Bool := pair (machineMatrixNormalizeOutputRow state) (machineMatrixNormalizeAccumulator state) +/-- Truncates the candidate normalized-row accumulator to the stored width bound. -/ def machineMatrixNormalizeNextAccumulator (state : List Bool) : List Bool := (machineMatrixNormalizeCandidate state).take (machineMatrixNormalizeBound state).length +/-- Consumes one row and stores its normalized output while preserving scale, dimension, and +bound. -/ def machineMatrixNormalizeAdvance (state : List Bool) : List Bool := machineMatrixNormalizePack (machineListTail (machineMatrixNormalizeRemaining state)) @@ -80,25 +93,31 @@ def machineMatrixNormalizeAdvance (state : List Bool) : List Bool := (machineMatrixNormalizeDimension state) (machineMatrixNormalizeBound state) +/-- Normalizes the next row, leaving exhausted normalization states fixed. -/ def machineMatrixNormalizeStep (state : List Bool) : List Bool := machineIfEmpty (machineMatrixNormalizeRemaining state) state (machineMatrixNormalizeAdvance state) +/-- Initializes normalization with the source rows, empty output, computed scale, dimension, and +bound. -/ def machineMatrixNormalizeInit (word : List Bool) : List Bool := machineMatrixNormalizePack (machineMatrixRowsWord word) [] (machineMatrixNormalizationScaleRawCode word) (machineMatrixDimensionWord word) (machineMatrixNormalizeInputBound word) +/-- Builds an encoded width envelope for the five normalization-state components. -/ def machineMatrixNormalizeWidth (word : List Bool) : List Bool := machineMatrixNormalizePack word (machineMatrixNormalizeInputBound word) (machineMatrixNormalizationScaleRawCode word) word (machineMatrixNormalizeInputBound word) +/-- Runs matrix normalization for one step per input bit. -/ def machineMatrixNormalizeFinalState (word : List Bool) : List Bool := (machineMatrixNormalizeStep)^[word.length] (machineMatrixNormalizeInit word) +/-- Pairs the matrix dimension with normalized rows restored to their original order. -/ def machineMatrixNormalizeEntries (word : List Bool) : List Bool := let state := machineMatrixNormalizeFinalState word pair (machineMatrixNormalizeDimension state) @@ -235,6 +254,7 @@ theorem machineMatrixNormalizeWidth_mem_FP : (machineMatrixNormalizePack a b c d e) = e := by simp [machineMatrixNormalizeBound, machineMatrixNormalizePack] +/-- Bounds normalization state lengths and preserves the computed scale and input-derived bound. -/ def MachineMatrixNormalizeStateBound (word state : List Bool) : Prop := state = machineMatrixNormalizePack (machineMatrixNormalizeRemaining state) @@ -518,10 +538,13 @@ theorem machineMatrixNormalize_outputRows_length_le_bound {n : ℕ} /-! ## Exact semantics -/ +/-- Divides every entry of every supplied row by the raw-rational scale. -/ def rationalMatrixDivideRows (scale : RawRat) (rows : List (List ℚ)) : List (List ℚ) := rows.map (rationalRowDivideValues scale) +/-- Encodes normalization after `k` rows, with the remaining input rows and reversed normalized +output. -/ def machineMatrixNormalizeSemanticState (word dimension : List Bool) (scale : RawRat) (rows : List (List ℚ)) (k : ℕ) : List Bool := diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineMatrixSum.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineMatrixSum.lean index ed396a647b..ef57608122 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineMatrixSum.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineMatrixSum.lean @@ -24,34 +24,44 @@ namespace BeyondBethe open Complexity +/-- Encodes a matrix-sum state as remaining rows, current row, raw-rational accumulator, and +bound. -/ def machineMatrixRawSumPack (rows current acc bound : List Bool) : List Bool := pair rows (pair current (pair acc bound)) +/-- Extracts the rows still to be loaded for matrix summation. -/ def machineMatrixRawSumRows (state : List Bool) : List Bool := machinePairFirst state +/-- Extracts the unprocessed suffix of the current summation row. -/ def machineMatrixRawSumCurrent (state : List Bool) : List Bool := machinePairFirst (machinePairSecond state) +/-- Extracts the accumulated raw-rational matrix sum. -/ def machineMatrixRawSumAcc (state : List Bool) : List Bool := machinePairFirst (machinePairSecond (machinePairSecond state)) +/-- Extracts the width bound stored in the matrix-sum state. -/ def machineMatrixRawSumBound (state : List Bool) : List Bool := machinePairSecond (machinePairSecond (machinePairSecond state)) +/-- Reads the next rational entry to add to the matrix sum. -/ def machineMatrixRawSumEntry (state : List Bool) : List Bool := machineListHead (machineMatrixRawSumCurrent state) +/-- Adds the current entry to the raw-rational sum accumulator. -/ def machineMatrixRawSumCandidate (state : List Bool) : List Bool := machineRawRatAddCode (pair (machineMatrixRawSumAcc state) (machineMatrixRawSumEntry state)) +/-- Truncates the candidate sum encoding to the stored width bound. -/ def machineMatrixRawSumNextAcc (state : List Bool) : List Bool := (machineMatrixRawSumCandidate state).take (machineMatrixRawSumBound state).length +/-- Consumes one entry and updates the bounded matrix-sum accumulator. -/ def machineMatrixRawSumProcessEntry (state : List Bool) : List Bool := machineMatrixRawSumPack (machineMatrixRawSumRows state) @@ -59,6 +69,7 @@ def machineMatrixRawSumProcessEntry (state : List Bool) : List Bool := (machineMatrixRawSumNextAcc state) (machineMatrixRawSumBound state) +/-- Loads the next matrix row while retaining the current sum and width bound. -/ def machineMatrixRawSumLoadRow (state : List Bool) : List Bool := machineMatrixRawSumPack (machineListTail (machineMatrixRawSumRows state)) @@ -66,10 +77,12 @@ def machineMatrixRawSumLoadRow (state : List Bool) : List Bool := (machineMatrixRawSumAcc state) (machineMatrixRawSumBound state) +/-- Loads a further row when available, otherwise retaining the completed summation state. -/ def machineMatrixRawSumAfterRow (state : List Bool) : List Bool := machineIfEmpty (machineMatrixRawSumRows state) state (machineMatrixRawSumLoadRow state) +/-- Adds the next matrix entry or loads another row when the current row is exhausted. -/ def machineMatrixRawSumStep (state : List Bool) : List Bool := machineIfEmpty (machineMatrixRawSumCurrent state) (machineMatrixRawSumAfterRow state) From cf0003d00aba54a6dbc5d70729153b00e2f08db8 Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Fri, 25 Sep 2026 20:15:48 +0000 Subject: [PATCH 25/49] Document optimizer geometry and rational machine contracts --- .../BeyondBethe/MachineMatrixSum.lean | 24 ++++++++++++ .../MachineMatrixSupportProduct.lean | 29 ++++++++++++++ .../MachineNaturalCombinators.lean | 4 ++ .../BeyondBethe/MachineNearbyCoordinate.lean | 15 +++++++ .../BeyondBethe/MachineNearbyMatrixSum.lean | 38 ++++++++++++++++++ .../MachineOptimizerBisectionLoop.lean | 34 ++++++++++++++++ .../MachineOptimizerBisectionSchedule.lean | 16 ++++++++ .../MachineOptimizerBisectionSemantics.lean | 8 ++++ .../MachineOptimizerDerivedScales.lean | 33 ++++++++++++++++ .../MachineOptimizerEntryLength.lean | 21 ++++++++++ .../MachineOptimizerFeasibilityCall.lean | 10 +++++ .../MachineOptimizerFeasibilitySchedule.lean | 39 +++++++++++++++++++ .../MachineOptimizerInteriorScale.lean | 36 +++++++++++++++++ .../MachineOptimizerMatrixBitBound.lean | 32 +++++++++++++++ .../MachineOptimizerRoundingSchedule.lean | 28 +++++++++++++ .../MachineOptimizerStateBound.lean | 19 +++++++++ .../BeyondBethe/MachineOptimizerTests.lean | 3 ++ .../BeyondBethe/MachineOutputEncoding.lean | 8 ++++ .../BeyondBethe/MachinePerfectMatching.lean | 4 ++ .../BeyondBethe/MachinePositiveAlgorithm.lean | 10 +++++ .../BeyondBethe/MachineRAMSmoke.lean | 1 + .../MachineRationalArithmetic.lean | 9 +++++ .../BeyondBethe/MachineRationalBallInit.lean | 25 ++++++++++++ .../BeyondBethe/MachineRationalCompare.lean | 1 + .../MachineRationalDirectionUpdateMatrix.lean | 23 +++++++++++ .../MachineRationalDirectionUpdateRow.lean | 24 ++++++++++++ .../MachineRationalEllipsoidCenterUpdate.lean | 14 +++++++ .../MachineRationalEllipsoidEncoding.lean | 7 ++++ .../MachineRationalEllipsoidScalars.lean | 24 ++++++++++++ .../MachineRationalEllipsoidUpdate.lean | 2 + .../BeyondBethe/MachineRationalExp.lean | 17 ++++++++ .../BeyondBethe/MachineRationalLogSeries.lean | 27 +++++++++++++ .../MachineRationalMatrixColumn.lean | 24 ++++++++++++ .../BeyondBethe/MachineRationalMatrixMul.lean | 24 ++++++++++++ .../MachineRationalMatrixMulVector.lean | 18 +++++++++ .../MachineRationalMatrixUpdate.lean | 12 ++++++ .../BeyondBethe/MachineRationalMin.lean | 3 ++ .../MachineRationalNormalization.lean | 7 ++++ .../MachineRationalNormalizedDirection.lean | 2 + .../BeyondBethe/MachineRationalPower.lean | 18 +++++++++ .../BeyondBethe/MachineRationalRowAdd.lean | 28 +++++++++++++ 41 files changed, 721 insertions(+) diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineMatrixSum.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineMatrixSum.lean index ef57608122..49360ed6a9 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineMatrixSum.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineMatrixSum.lean @@ -92,20 +92,26 @@ def machineMatrixRawSumStep (state : List Bool) : List Bool := def machineMatrixRawSumInputBound (word : List Bool) : List Bool := machineBinaryMulWidth word +/-- Initializes the matrix sum with all encoded rows, an empty current row, zero raw +accumulator, and the computed bound. -/ def machineMatrixRawSumInit (word : List Bool) : List Bool := machineMatrixRawSumPack (machineMatrixRowsWord word) [] (rawRatBinaryCode RawRat.zero) (machineMatrixRawSumInputBound word) +/-- Packs the original word twice and the accumulator bound twice to bound the matrix-sum state. -/ def machineMatrixRawSumWidth (word : List Bool) : List Bool := let bound := machineMatrixRawSumInputBound word machineMatrixRawSumPack word word bound bound +/-- Runs the matrix-sum step once per input bit from the initial state. -/ def machineMatrixRawSumFinalState (word : List Bool) : List Bool := (machineMatrixRawSumStep)^[word.length] (machineMatrixRawSumInit word) +/-- Extracts the raw rational accumulator from the final matrix-sum state. -/ def machineMatrixRawSumCode (word : List Bool) : List Bool := machineMatrixRawSumAcc (machineMatrixRawSumFinalState word) +/-- Normalizes the final raw matrix sum into the rational binary output encoding. -/ def machineMatrixSumOutputCode (word : List Bool) : List Bool := machineNormalizeRawRatBinaryCode (machineMatrixRawSumCode word) @@ -114,6 +120,7 @@ def machineMatrixNormalizationScaleRawCode (word : List Bool) : List Bool := machineRawRatAddCode (pair (rawRatBinaryCode RawRat.one) (machineMatrixRawSumCode word)) +/-- Normalizes the raw matrix-normalization scale into the rational binary output encoding. -/ def machineMatrixNormalizationScaleOutputCode (word : List Bool) : List Bool := machineNormalizeRawRatBinaryCode @@ -228,6 +235,8 @@ theorem machineMatrixRawSumWidth_mem_FP : (machineMatrixRawSumPack rows current acc bound) = bound := by simp [machineMatrixRawSumBound, machineMatrixRawSumPack] +/-- Requires exact sum-state packing, row and current-suffix lengths bounded by the input +length, bounded accumulator length, and the prescribed bound word. -/ def MachineMatrixRawSumStateBound (word state : List Bool) : Prop := state = machineMatrixRawSumPack (machineMatrixRawSumRows state) (machineMatrixRawSumCurrent state) @@ -340,16 +349,22 @@ theorem machineMatrixNormalizationScaleOutputCode_mem_FP : /-! ## Semantic invariant and exactness -/ +/-- Sums the raw rational widths of a list's entries, adding one per entry for accumulator +growth. -/ def rawRatListCost (xs : List ℚ) : ℕ := (xs.map fun q => rawRatWidth (rawRatOfRat q) + 1).sum +/-- Sums the raw rational list costs of all matrix rows. -/ def rawRatRowsCost (rows : List (List ℚ)) : ℕ := (rows.map rawRatListCost).sum +/-- Adds a list of rational entries to a raw rational accumulator from left to right. -/ def rawRatListSum : RawRat → List ℚ → RawRat | acc, [] => acc | acc, q :: qs => rawRatListSum (acc.add (rawRatOfRat q)) qs +/-- Adds successive rational rows to a raw rational accumulator, processing each row from left +to right. -/ def rawRatRowsSum : RawRat → List (List ℚ) → RawRat | acc, [] => acc | acc, row :: rows => rawRatRowsSum (rawRatListSum acc row) rows @@ -479,10 +494,15 @@ theorem rawRatRowsCost_le_codeLength (rows : List (List ℚ)) : omega structure MatrixRawSumSemState where + /-- The unprocessed rows of the semantic raw matrix-sum scan. -/ rows : List (List ℚ) + /-- The unprocessed suffix of the row currently being summed. -/ current : List ℚ + /-- The raw rational sum accumulated from processed matrix entries. -/ acc : RawRat +/-- Adds the next current-row entry, loads the next row when needed, and fixes a state with no +entries or rows remaining. -/ def matrixRawSumSemStep (s : MatrixRawSumSemState) : MatrixRawSumSemState := match s.current with | q :: qs => ⟨s.rows, qs, s.acc.add (rawRatOfRat q)⟩ @@ -491,6 +511,8 @@ def matrixRawSumSemStep (s : MatrixRawSumSemState) : MatrixRawSumSemState := | row :: rows => ⟨rows, row, s.acc⟩ | [] => s +/-- Encodes the semantic scan's remaining rows, current suffix, and raw accumulator using the +supplied bound word. -/ def matrixRawSumSemCode (bound : List Bool) (s : MatrixRawSumSemState) : List Bool := machineMatrixRawSumPack @@ -498,6 +520,8 @@ def matrixRawSumSemCode (bound : List Bool) (binaryListCode rationalEntryBinaryCode s.current) (rawRatBinaryCode s.acc) bound +/-- Bounds the accumulator width plus the costs of all unprocessed current-row entries and +remaining rows by the supplied budget. -/ def MatrixRawSumSemInvariant (budget : ℕ) (s : MatrixRawSumSemState) : Prop := rawRatWidth s.acc + rawRatListCost s.current + rawRatRowsCost s.rows ≤ budget diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineMatrixSupportProduct.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineMatrixSupportProduct.lean index 164bfa723a..bc0b4d289c 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineMatrixSupportProduct.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineMatrixSupportProduct.lean @@ -26,24 +26,30 @@ namespace BeyondBethe open Complexity +/-- Tests whether the current matrix entry differs from zero in raw rational arithmetic. -/ def machineMatrixSupportNonzeroFlag (state : List Bool) : List Bool := machineRawRatNeBit (pair (machineMatrixRawSumEntry state) (rawRatBinaryCode RawRat.zero)) +/-- Uses the current nonzero matrix entry as a support-product factor and substitutes one for +zero entries. -/ def machineMatrixSupportFactorCode (state : List Bool) : List Bool := machineIfHead (machineMatrixSupportNonzeroFlag state) (machineMatrixRawSumEntry state) (rawRatBinaryCode RawRat.one) +/-- Multiplies the support-product accumulator by the current entry's nonzero-or-one factor. -/ def machineMatrixSupportCandidate (state : List Bool) : List Bool := machineRawRatMulCode (pair (machineMatrixRawSumAcc state) (machineMatrixSupportFactorCode state)) +/-- Truncates the updated support-product accumulator to the length of the stored bound. -/ def machineMatrixSupportNextAcc (state : List Bool) : List Bool := (machineMatrixSupportCandidate state).take (machineMatrixRawSumBound state).length +/-- Consumes one current-row entry and stores the bounded updated support-product accumulator. -/ def machineMatrixSupportProcessEntry (state : List Bool) : List Bool := machineMatrixRawSumPack (machineMatrixRawSumRows state) @@ -51,35 +57,49 @@ def machineMatrixSupportProcessEntry (state : List Bool) : List Bool := (machineMatrixSupportNextAcc state) (machineMatrixRawSumBound state) +/-- Reuses the raw matrix scan's row-loading operation for the support-product scan. -/ def machineMatrixSupportLoadRow (state : List Bool) : List Bool := machineMatrixRawSumLoadRow state +/-- Fixes an exhausted support-product scan or loads the next row if one remains. -/ def machineMatrixSupportAfterRow (state : List Bool) : List Bool := machineIfEmpty (machineMatrixRawSumRows state) state (machineMatrixSupportLoadRow state) +/-- Processes the next current-row support factor, or loads another row when the current one is +empty. -/ def machineMatrixSupportStep (state : List Bool) : List Bool := machineIfEmpty (machineMatrixRawSumCurrent state) (machineMatrixSupportAfterRow state) (machineMatrixSupportProcessEntry state) +/-- Applies the binary-multiplication width construction to bound the support-product +accumulator. -/ def machineMatrixSupportInputBound (word : List Bool) : List Bool := machineBinaryMulWidth word +/-- Initializes the support-product scan with all matrix rows, empty current row, multiplicative +identity, and its input bound. -/ def machineMatrixSupportInit (word : List Bool) : List Bool := machineMatrixRawSumPack (machineMatrixRowsWord word) [] (rawRatBinaryCode RawRat.one) (machineMatrixSupportInputBound word) +/-- Packs the original word twice and the support-product bound twice to bound the complete scan +state. -/ def machineMatrixSupportWidth (word : List Bool) : List Bool := let bound := machineMatrixSupportInputBound word machineMatrixRawSumPack word word bound bound +/-- Runs the support-product scan once per input bit from its initial state. -/ def machineMatrixSupportFinalState (word : List Bool) : List Bool := (machineMatrixSupportStep)^[word.length] (machineMatrixSupportInit word) +/-- Extracts the raw support-product accumulator from the final scan state. -/ def machineMatrixSupportRawCode (word : List Bool) : List Bool := machineMatrixRawSumAcc (machineMatrixSupportFinalState word) +/-- Normalizes the raw product of nonzero matrix entries into the rational binary output +encoding. -/ def machineMatrixSupportProductCode (word : List Bool) : List Bool := machineNormalizeRawRatBinaryCode (machineMatrixSupportRawCode word) @@ -257,19 +277,26 @@ theorem machineMatrixSupportProductCode_mem_FP : /-! ## Exact semantics -/ +/-- Replaces zero by the raw multiplicative identity and converts each nonzero rational to its +raw representation. -/ def rawRatSupportFactor (q : ℚ) : RawRat := if q = 0 then RawRat.one else rawRatOfRat q +/-- Multiplies the nonzero entries of a rational list into a raw accumulator, treating zero +entries as factors of one. -/ def rawRatListSupportProduct : RawRat → List ℚ → RawRat | acc, [] => acc | acc, q :: qs => rawRatListSupportProduct (acc.mul (rawRatSupportFactor q)) qs +/-- Multiplies the nonzero entries of successive rational rows into a raw accumulator. -/ def rawRatRowsSupportProduct : RawRat → List (List ℚ) → RawRat | acc, [] => acc | acc, row :: rows => rawRatRowsSupportProduct (rawRatListSupportProduct acc row) rows +/-- Multiplies in one support factor, loads another row when necessary, and fixes the exhausted +semantic scan. -/ def matrixSupportSemStep (s : MatrixRawSumSemState) : MatrixRawSumSemState := match s.current with | q :: qs => ⟨s.rows, qs, s.acc.mul (rawRatSupportFactor q)⟩ @@ -278,6 +305,8 @@ def matrixSupportSemStep (s : MatrixRawSumSemState) : MatrixRawSumSemState := | row :: rows => ⟨rows, row, s.acc⟩ | [] => s +/-- Bounds the support-product accumulator width plus all remaining entry costs by the supplied +budget. -/ def MatrixSupportSemInvariant (budget : ℕ) (s : MatrixRawSumSemState) : Prop := rawRatWidth s.acc + rawRatListCost s.current + rawRatRowsCost s.rows ≤ budget diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineNaturalCombinators.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineNaturalCombinators.lean index 4db9b354a5..0d49496df0 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineNaturalCombinators.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineNaturalCombinators.lean @@ -24,14 +24,18 @@ new computational primitive: each is just pairing followed by the verified binary addition or multiplication machine. -/ +/-- Adds the binary outputs of two machines evaluated on the same input word. -/ def machineBinaryAddOf (f g : List Bool → List Bool) (word : List Bool) : List Bool := machineBinaryAddBits (pair (f word) (g word)) +/-- Multiplies the binary outputs of two machines evaluated on the same input word. -/ def machineBinaryMulOf (f g : List Bool → List Bool) (word : List Bool) : List Bool := machineBinaryMulBits (pair (f word) (g word)) +/-- Returns the binary natural-number code for the fixed constant `k`, independently of the +input. -/ def machineBinaryConst (k : ℕ) (_word : List Bool) : List Bool := k.bits theorem machineBinaryAddOf_mem_FP {f g : List Bool → List Bool} diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineNearbyCoordinate.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineNearbyCoordinate.lean index f73064767b..172c1c9007 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineNearbyCoordinate.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineNearbyCoordinate.lean @@ -25,21 +25,27 @@ namespace BeyondBethe open Complexity +/-- Extracts the unary precision ruler from a nearby-coordinate request. -/ def machineNearbyCoordinatePrecisionRuler (word : List Bool) : List Bool := machinePairFirst word +/-- Extracts the regularization-and-coordinate payload following the precision ruler. -/ def machineNearbyCoordinatePayload (word : List Bool) : List Bool := machinePairSecond word +/-- Extracts the raw regularization parameter from a nearby-coordinate request. -/ def machineNearbyCoordinateTauRawCode (word : List Bool) : List Bool := machinePairFirst (machineNearbyCoordinatePayload word) +/-- Extracts the encoded rational coordinate from a nearby-coordinate request. -/ def machineNearbyCoordinateXCode (word : List Bool) : List Bool := machinePairSecond (machineNearbyCoordinatePayload word) +/-- Negates the encoded coordinate in raw rational arithmetic. -/ def machineNearbyCoordinateNegXRawCode (word : List Bool) : List Bool := machineRawRatNegCode (machineNearbyCoordinateXCode word) +/-- Adds raw one to the negated coordinate to compute its unnormalized complement. -/ def machineNearbyCoordinateComplementUnnormalizedRawCode (word : List Bool) : List Bool := machineRawRatAddCode @@ -51,29 +57,36 @@ def machineNearbyCoordinateComplementCode (word : List Bool) : List Bool := machineNormalizeRawRatEntryCode (machineNearbyCoordinateComplementUnnormalizedRawCode word) +/-- Computes the scheduled lower logarithm approximation of the coordinate complement at the +requested precision. -/ def machineNearbyCoordinateLogComplementRawCode (word : List Bool) : List Bool := machineScheduledLogLowerRawCode (pair (machineNearbyCoordinatePrecisionRuler word) (machineNearbyCoordinateComplementCode word)) +/-- Computes the scheduled lower logarithm approximation of the coordinate at the requested +precision. -/ def machineNearbyCoordinateLogXRawCode (word : List Bool) : List Bool := machineScheduledLogLowerRawCode (pair (machineNearbyCoordinatePrecisionRuler word) (machineNearbyCoordinateXCode word)) +/-- Multiplies the raw regularization parameter by the coordinate. -/ def machineNearbyCoordinateTauTimesXRawCode (word : List Bool) : List Bool := machineRawRatMulCode (pair (machineNearbyCoordinateTauRawCode word) (machineNearbyCoordinateXCode word)) +/-- Multiplies the regularized coordinate by its scheduled lower logarithm approximation. -/ def machineNearbyCoordinateWeightedLogXRawCode (word : List Bool) : List Bool := machineRawRatMulCode (pair (machineNearbyCoordinateTauTimesXRawCode word) (machineNearbyCoordinateLogXRawCode word)) +/-- Adds the lower complement logarithm to the regularized coordinate times its lower logarithm. -/ def machineNearbyCoordinateLowerRawCode (word : List Bool) : List Bool := machineRawRatAddCode (pair (machineNearbyCoordinateLogComplementRawCode word) @@ -158,9 +171,11 @@ theorem machineNearbyCoordinateLowerRawCode_mem_FP : simpa only [machineNearbyCoordinateLowerRawCode] using! machineCompose_mem_FP hpair machineRawRatAddCode_mem_FP +/-- Computes raw one minus the rational coordinate without reducing the resulting fraction. -/ def rawNearbyCoordinateComplement (x : ℚ) : RawRat := RawRat.one.add (rawRatOfRat x).neg +/-- Forms the raw expression `logLower(1 - x) + tau * x * logLower(x)` at precision `p`. -/ def rawNearbyCoordinateLower (tau : RawRat) (x : ℚ) (p : ℕ) : RawRat := (rawScheduledLogLower (1 - x) p).add ((tau.mul (rawRatOfRat x)).mul (rawScheduledLogLower x p)) diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineNearbyMatrixSum.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineNearbyMatrixSum.lean index 0e91b53409..26cec13631 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineNearbyMatrixSum.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineNearbyMatrixSum.lean @@ -27,30 +27,40 @@ namespace BeyondBethe open Complexity +/-- Packs the fixed source, remaining rows, current row suffix, accumulator, and bound for the +nearby-matrix sum. -/ def machineNearbyMatrixPack (source rows current acc bound : List Bool) : List Bool := pair source (pair rows (pair current (pair acc bound))) +/-- Extracts the fixed problem source from a nearby-matrix scan state. -/ def machineNearbyMatrixSource (state : List Bool) : List Bool := machinePairFirst state +/-- Extracts the remaining encoded matrix rows from a nearby-matrix scan state. -/ def machineNearbyMatrixRows (state : List Bool) : List Bool := machinePairFirst (machinePairSecond state) +/-- Extracts the current row suffix from a nearby-matrix scan state. -/ def machineNearbyMatrixCurrent (state : List Bool) : List Bool := machinePairFirst (machinePairSecond (machinePairSecond state)) +/-- Extracts the raw accumulated nearby-coordinate sum from a scan state. -/ def machineNearbyMatrixAcc (state : List Bool) : List Bool := machinePairFirst (machinePairSecond (machinePairSecond (machinePairSecond state))) +/-- Extracts the accumulator length-bound word from a nearby-matrix scan state. -/ def machineNearbyMatrixBound (state : List Bool) : List Bool := machinePairSecond (machinePairSecond (machinePairSecond (machinePairSecond state))) +/-- Reads the next entry of the current matrix-row suffix. -/ def machineNearbyMatrixEntry (state : List Bool) : List Bool := machineListHead (machineNearbyMatrixCurrent state) +/-- Packages the source's certificate precision and regularization scale with the current matrix +entry. -/ def machineNearbyMatrixCoordinateInput (state : List Bool) : List Bool := pair (machineCertificateLogPrecisionRuler (machineNearbyMatrixSource state)) @@ -59,19 +69,24 @@ def machineNearbyMatrixCoordinateInput (state : List Bool) : List Bool := (machineNearbyMatrixSource state)) (machineNearbyMatrixEntry state)) +/-- Computes the current matrix entry's directed nearby-coordinate lower expression. -/ def machineNearbyMatrixCoordinateRawCode (state : List Bool) : List Bool := machineNearbyCoordinateLowerRawCode (machineNearbyMatrixCoordinateInput state) +/-- Adds the current nearby-coordinate expression to the raw accumulator. -/ def machineNearbyMatrixCandidate (state : List Bool) : List Bool := machineRawRatAddCode (pair (machineNearbyMatrixAcc state) (machineNearbyMatrixCoordinateRawCode state)) +/-- Truncates the updated nearby-matrix accumulator to the stored bound length. -/ def machineNearbyMatrixNextAcc (state : List Bool) : List Bool := (machineNearbyMatrixCandidate state).take (machineNearbyMatrixBound state).length +/-- Consumes the current matrix entry and stores the bounded updated accumulator while retaining +source, remaining rows, and bound. -/ def machineNearbyMatrixProcessEntry (state : List Bool) : List Bool := machineNearbyMatrixPack (machineNearbyMatrixSource state) @@ -80,6 +95,8 @@ def machineNearbyMatrixProcessEntry (state : List Bool) : List Bool := (machineNearbyMatrixNextAcc state) (machineNearbyMatrixBound state) +/-- Loads the next matrix row while preserving the source, nearby-term accumulator, and width +bound. -/ def machineNearbyMatrixLoadRow (state : List Bool) : List Bool := machineNearbyMatrixPack (machineNearbyMatrixSource state) @@ -88,10 +105,12 @@ def machineNearbyMatrixLoadRow (state : List Bool) : List Bool := (machineNearbyMatrixAcc state) (machineNearbyMatrixBound state) +/-- Loads another row when available, otherwise retaining the completed nearby-sum state. -/ def machineNearbyMatrixAfterRow (state : List Bool) : List Bool := machineIfEmpty (machineNearbyMatrixRows state) state (machineNearbyMatrixLoadRow state) +/-- Adds the next nearby-coordinate term or loads a row when the current row is exhausted. -/ def machineNearbyMatrixStep (state : List Bool) : List Bool := machineIfEmpty (machineNearbyMatrixCurrent state) (machineNearbyMatrixAfterRow state) @@ -104,20 +123,26 @@ def machineNearbyMatrixInputBound (word : List Bool) : List Bool := machineBinaryMulWidth (machineBinaryMulWidth (machineBinaryMulWidth word)) +/-- Extracts the optimizer matrix's encoded rows for nearby-coordinate summation. -/ def machineNearbyMatrixRowsWord (word : List Bool) : List Bool := machineMatrixRowsWord (machineOptimizerMatrixWord word) +/-- Initializes nearby-coordinate summation with all rows, zero accumulator, and input-derived +bound. -/ def machineNearbyMatrixInit (word : List Bool) : List Bool := machineNearbyMatrixPack word (machineNearbyMatrixRowsWord word) [] (rawRatBinaryCode RawRat.zero) (machineNearbyMatrixInputBound word) +/-- Builds a width envelope for the source, remaining rows, current row, accumulator, and bound. -/ def machineNearbyMatrixWidth (word : List Bool) : List Bool := let bound := machineNearbyMatrixInputBound word machineNearbyMatrixPack word word word bound bound +/-- Runs nearby-coordinate summation for one step per input bit. -/ def machineNearbyMatrixFinalState (word : List Bool) : List Bool := (machineNearbyMatrixStep)^[word.length] (machineNearbyMatrixInit word) +/-- Extracts the accumulated raw-rational nearby-coordinate sum after the full scan. -/ def machineNearbyMatrixRawSumCode (word : List Bool) : List Bool := machineNearbyMatrixAcc (machineNearbyMatrixFinalState word) @@ -279,6 +304,8 @@ theorem machineNearbyMatrixWidth_mem_FP : (machineNearbyMatrixPack source rows current acc bound) = bound := by simp [machineNearbyMatrixBound, machineNearbyMatrixPack] +/-- Bounds the scan state lengths while preserving its source and input-derived accumulator +bound. -/ def MachineNearbyMatrixStateBound (word state : List Bool) : Prop := state = machineNearbyMatrixPack (machineNearbyMatrixSource state) (machineNearbyMatrixRows state) @@ -379,9 +406,11 @@ theorem machineNearbyMatrixRawSumCode_mem_FP : /-! ## Semantic invariant and exactness before discharging the size bound -/ +/-- Sums the raw widths plus one of nearby-coordinate lower approximations for a rational row. -/ def rawNearbyListCost (tau : RawRat) (p : ℕ) (xs : List ℚ) : ℕ := (xs.map fun q => rawRatWidth (rawNearbyCoordinateLower tau q p) + 1).sum +/-- Sums the nearby-coordinate width costs across a list of rational rows. -/ def rawNearbyRowsCost (tau : RawRat) (p : ℕ) (rows : List (List ℚ)) : ℕ := (rows.map (rawNearbyListCost tau p)).sum @@ -623,6 +652,7 @@ theorem machineNearbyMatrixInputBound_length_dominates (word : List Bool) : ring_nf at hcover ⊢ omega +/-- Adds nearby-coordinate lower approximations for a list into a raw-rational accumulator. -/ def rawNearbyListSum (tau : RawRat) (p : ℕ) : RawRat → List ℚ → RawRat | acc, [] => acc @@ -630,6 +660,7 @@ def rawNearbyListSum (tau : RawRat) (p : ℕ) : rawNearbyListSum tau p (acc.add (rawNearbyCoordinateLower tau q p)) qs +/-- Adds nearby-coordinate lower approximations across all rows into a raw-rational accumulator. -/ def rawNearbyRowsSum (tau : RawRat) (p : ℕ) : RawRat → List (List ℚ) → RawRat | acc, [] => acc @@ -637,10 +668,15 @@ def rawNearbyRowsSum (tau : RawRat) (p : ℕ) : rawNearbyRowsSum tau p (rawNearbyListSum tau p acc row) rows structure NearbyMatrixSemState where + /-- Rows not yet loaded by the semantic nearby-coordinate scan. -/ rows : List (List ℚ) + /-- Unprocessed entries of the current semantic scan row. -/ current : List ℚ + /-- Accumulated raw-rational sum of nearby-coordinate lower approximations. -/ acc : RawRat +/-- Adds the next nearby-coordinate term, loads another row, or leaves a completed semantic +state fixed. -/ def nearbyMatrixSemStep (tau : RawRat) (p : ℕ) (s : NearbyMatrixSemState) : NearbyMatrixSemState := match s.current with @@ -651,6 +687,7 @@ def nearbyMatrixSemStep (tau : RawRat) (p : ℕ) | row :: rows => ⟨rows, row, s.acc⟩ | [] => s +/-- Encodes a semantic nearby-coordinate scan state together with its source and width bound. -/ def nearbyMatrixSemCode (source bound : List Bool) (s : NearbyMatrixSemState) : List Bool := machineNearbyMatrixPack source @@ -658,6 +695,7 @@ def nearbyMatrixSemCode (source bound : List Bool) (binaryListCode rationalEntryBinaryCode s.current) (rawRatBinaryCode s.acc) bound +/-- Bounds accumulator width plus the remaining nearby-coordinate costs by a fixed budget. -/ def NearbyMatrixSemInvariant (tau : RawRat) (p budget : ℕ) (s : NearbyMatrixSemState) : Prop := rawRatWidth s.acc + rawNearbyListCost tau p s.current + diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerBisectionLoop.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerBisectionLoop.lean index de3afb30b2..71d6c7c63a 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerBisectionLoop.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerBisectionLoop.lean @@ -33,21 +33,25 @@ open Complexity /-! ## Exact dyadic thresholds -/ +/-- The raw-rational initial lower objective bound `-2*n^2`. -/ def rawOptimizerInitialLow (n : ℕ) : RawRat := (rawOptimizerTwiceNSquare n).neg +/-- The threshold at dyadic position `k/2^t` within the initial objective interval. -/ def optimizerDyadicThreshold {m : ℕ} (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) (k t : ℕ) : ℚ := betheNegativeObjectiveLower m + (k : ℚ) / 2 ^ t * explicitOptimizerInitialWidth A +/-- Normalizes the encoded initial lower objective bound `-2*n^2`. -/ def machineOptimizerInitialLowEntryCode (word : List Bool) : List Bool := machineNormalizeRawRatEntryCode (machineRawRatNegCode (machineOptimizerTwiceNSquareForWidthRawCode word)) +/-- Normalizes the initial interval width for use in the bisection loop. -/ def machineOptimizerInitialWidthEntryCodeForBisection (word : List Bool) : List Bool := machineNormalizeRawRatEntryCode @@ -55,51 +59,62 @@ def machineOptimizerInitialWidthEntryCodeForBisection /-! ## Persistent state -/ +/-- Encodes a bisection state as source matrix, iteration ruler, binary index, and unary depth. -/ def machineOptimizerBisectionStatePack (source ruler index depth : List Bool) : List Bool := pair source (pair ruler (pair index depth)) +/-- Extracts the source matrix from the bisection state. -/ def machineOptimizerBisectionStateSource (state : List Bool) : List Bool := machinePairFirst state +/-- Extracts the fixed bisection-iteration ruler from the state. -/ def machineOptimizerBisectionStateRuler (state : List Bool) : List Bool := machinePairFirst (machinePairSecond state) +/-- Extracts the binary index of the current dyadic interval. -/ def machineOptimizerBisectionStateIndex (state : List Bool) : List Bool := machinePairFirst (machinePairSecond (machinePairSecond state)) +/-- Extracts the unary depth of the current dyadic interval. -/ def machineOptimizerBisectionStateDepth (state : List Bool) : List Bool := machinePairSecond (machinePairSecond (machinePairSecond state)) +/-- Initializes bisection with the source matrix, scheduled ruler, and zero index and depth. -/ def machineOptimizerBisectionInit (word : List Bool) : List Bool := machineOptimizerBisectionStatePack word (machineExplicitOptimizerBisectionStepsRuler word) [] [] /-! ## Reconstruct the queried midpoint -/ +/-- Doubles the current dyadic interval index in binary. -/ def machineOptimizerBisectionEvenIndexBits (state : List Bool) : List Bool := machineBinaryMulBits (pair (machineOptimizerBisectionStateIndex state) [false, true]) +/-- Computes the odd midpoint index `2*k + 1` in binary. -/ def machineOptimizerBisectionOddIndexBits (state : List Bool) : List Bool := machineBinaryAddBits (pair (machineOptimizerBisectionEvenIndexBits state) [true]) +/-- Increments the unary bisection depth. -/ def machineOptimizerBisectionNextDepth (state : List Bool) : List Bool := true :: machineOptimizerBisectionStateDepth state +/-- Computes the binary denominator `2^(t + 1)` for the next midpoint. -/ def machineOptimizerBisectionDenominatorBits (state : List Bool) : List Bool := machineDirectedLogPowerTwoBits (machineOptimizerBisectionNextDepth state) +/-- Encodes the raw dyadic midpoint fraction `(2*k + 1)/2^(t + 1)`. -/ def machineOptimizerBisectionFractionRawCode (state : List Bool) : List Bool := pair @@ -107,6 +122,7 @@ def machineOptimizerBisectionFractionRawCode (machineOptimizerBisectionOddIndexBits state)) (machineOptimizerBisectionDenominatorBits state) +/-- Multiplies the dyadic midpoint fraction by the initial objective-interval width. -/ def machineOptimizerBisectionScaledFractionRawCode (state : List Bool) : List Bool := machineRawRatMulCode @@ -114,6 +130,7 @@ def machineOptimizerBisectionScaledFractionRawCode (machineOptimizerInitialWidthEntryCodeForBisection (machineOptimizerBisectionStateSource state))) +/-- Adds the initial lower objective bound to the scaled midpoint fraction. -/ def machineOptimizerBisectionMidpointUnnormalizedRawCode (state : List Bool) : List Bool := machineRawRatAddCode @@ -122,21 +139,25 @@ def machineOptimizerBisectionMidpointUnnormalizedRawCode (machineOptimizerBisectionStateSource state)) (machineOptimizerBisectionScaledFractionRawCode state)) +/-- Normalizes the encoded midpoint threshold. -/ def machineOptimizerBisectionMidpointRawCode (state : List Bool) : List Bool := machineNormalizeRawRatEntryCode (machineOptimizerBisectionMidpointUnnormalizedRawCode state) +/-- Pairs the source matrix with the current midpoint threshold for a feasibility query. -/ def machineOptimizerBisectionFeasibilityCall (state : List Bool) : List Bool := pair (machineOptimizerBisectionStateSource state) (machineOptimizerBisectionMidpointRawCode state) +/-- Runs the explicit threshold-feasibility machine at the current bisection midpoint. -/ def machineOptimizerBisectionFeasibilityResult (state : List Bool) : List Bool := machineExplicitBetheThresholdFeasibilityCode (machineOptimizerBisectionFeasibilityCall state) +/-- Reads the exhausted flag from the midpoint feasibility result. -/ def machineOptimizerBisectionExhaustedBit (state : List Bool) : List Bool := machineHeadBit @@ -145,12 +166,14 @@ def machineOptimizerBisectionExhaustedBit /-! ## One branch and the bounded iteration -/ +/-- Chooses index `2*k + 1` on exhaustion and `2*k` on acceptance. -/ def machineOptimizerBisectionNextIndexBits (state : List Bool) : List Bool := machineIfHead (machineOptimizerBisectionExhaustedBit state) (machineOptimizerBisectionOddIndexBits state) (machineOptimizerBisectionEvenIndexBits state) +/-- Updates the dyadic interval index and depth while preserving the source and iteration ruler. -/ def machineOptimizerBisectionStep (state : List Bool) : List Bool := machineOptimizerBisectionStatePack (machineOptimizerBisectionStateSource state) @@ -158,6 +181,7 @@ def machineOptimizerBisectionStep (state : List Bool) : List Bool := (machineOptimizerBisectionNextIndexBits state) (machineOptimizerBisectionNextDepth state) +/-- Runs bisection for the scheduled number of iterations. -/ def machineOptimizerBisectionFinalState (word : List Bool) : List Bool := (machineOptimizerBisectionStep)^[( @@ -166,11 +190,13 @@ def machineOptimizerBisectionFinalState /-! ## Re-query the certified upper endpoint -/ +/-- Computes the upper endpoint index `k + 1` of the current dyadic interval. -/ def machineOptimizerBisectionHighIndexBits (state : List Bool) : List Bool := machineBinaryAddBits (pair (machineOptimizerBisectionStateIndex state) [true]) +/-- Encodes the current upper endpoint fraction `(k + 1)/2^t`. -/ def machineOptimizerBisectionHighFractionRawCode (state : List Bool) : List Bool := pair @@ -179,6 +205,7 @@ def machineOptimizerBisectionHighFractionRawCode (machineDirectedLogPowerTwoBits (machineOptimizerBisectionStateDepth state)) +/-- Scales the upper endpoint fraction by the initial interval width. -/ def machineOptimizerBisectionHighScaledRawCode (state : List Bool) : List Bool := machineRawRatMulCode @@ -186,6 +213,7 @@ def machineOptimizerBisectionHighScaledRawCode (machineOptimizerInitialWidthEntryCodeForBisection (machineOptimizerBisectionStateSource state))) +/-- Adds the initial lower bound to the scaled upper endpoint fraction. -/ def machineOptimizerBisectionHighUnnormalizedRawCode (state : List Bool) : List Bool := machineRawRatAddCode @@ -194,17 +222,20 @@ def machineOptimizerBisectionHighUnnormalizedRawCode (machineOptimizerBisectionStateSource state)) (machineOptimizerBisectionHighScaledRawCode state)) +/-- Normalizes the encoded upper endpoint threshold. -/ def machineOptimizerBisectionHighRawCode (state : List Bool) : List Bool := machineNormalizeRawRatEntryCode (machineOptimizerBisectionHighUnnormalizedRawCode state) +/-- Runs threshold feasibility once more at the final bisection interval's upper endpoint. -/ def machineExplicitBetheOptimizerFeasibilityResultCode (word : List Bool) : List Bool := let state := machineOptimizerBisectionFinalState word machineExplicitBetheThresholdFeasibilityCode (pair word (machineOptimizerBisectionHighRawCode state)) +/-- Extracts the point payload returned by the final optimizer feasibility call. -/ def machineExplicitBetheOptimizerPointCode (word : List Bool) : List Bool := machinePairSecond @@ -387,6 +418,8 @@ theorem machineOptimizerBisectionStep_mem_FP : simp [machineOptimizerBisectionStateDepth, machineOptimizerBisectionStatePack] +/-- Records canonical state packing, fixed source and ruler, index below `2^iterations`, and +matching depth. -/ def MachineOptimizerBisectionStateBound (word : List Bool) (iterations : ℕ) (state : List Bool) : Prop := state = machineOptimizerBisectionStatePack @@ -474,6 +507,7 @@ theorem machineOptimizerBisectionIterate_bound (word : List Bool) : ∀ k, simpa only [Nat.succ_eq_add_one] using! machineOptimizerBisectionStep_bound ih +/-- Packs four copies of a source-and-ruler envelope to bound a bisection state. -/ def machineOptimizerBisectionWidth (word : List Bool) : List Bool := let envelope := false :: (word ++ machineExplicitOptimizerBisectionStepsRuler word) diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerBisectionSchedule.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerBisectionSchedule.lean index b8e2f509ff..9b501b2e83 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerBisectionSchedule.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerBisectionSchedule.lean @@ -23,61 +23,74 @@ namespace BeyondBethe open Complexity +/-- The raw-rational objective upper bound `n*B + n`. -/ def rawOptimizerObjectiveUpper (n B : ℕ) : RawRat := ((rawOptimizerDimension n).mul (rawOptimizerBitBound B)).add (rawOptimizerDimension n) +/-- Twice the explicit optimizer inner radius as a raw rational. -/ def rawOptimizerTwiceInnerRadius (n B : ℕ) : RawRat := rawOptimizerTwo.mul (rawExplicitOptimizerInnerRadius n B) +/-- The smoothing slack given by mixing times the objective range plus twice the inner radius. -/ def rawOptimizerSmoothingSlack (n B : ℕ) : RawRat := ((rawExplicitOptimizerMix n B).mul (rawOptimizerObjectiveRange n B)).add (rawOptimizerTwiceInnerRadius n B) +/-- The initial upper threshold obtained by adding smoothing slack to the objective upper bound. -/ def rawOptimizerInitialHigh (n B : ℕ) : RawRat := (rawOptimizerObjectiveUpper n B).add (rawOptimizerSmoothingSlack n B) +/-- The raw-rational quantity `2*n^2` used to form the initial interval width. -/ def rawOptimizerTwiceNSquare (n : ℕ) : RawRat := rawOptimizerTwo.mul (rawOptimizerNSquare n) +/-- The initial upper threshold minus the lower threshold `-2*n^2`. -/ def rawExplicitOptimizerInitialWidth (n B : ℕ) : RawRat := (rawOptimizerInitialHigh n B).add (rawOptimizerTwiceNSquare n) +/-- Computes the encoded objective upper bound `n*B + n`. -/ def machineOptimizerObjectiveUpperRawCode (word : List Bool) : List Bool := machineRawRatAddCode (pair (machineOptimizerNBProductRawCode word) (machineOptimizerDimensionRawCode word)) +/-- Computes twice the encoded optimizer inner radius. -/ def machineOptimizerTwiceInnerRadiusRawCode (word : List Bool) : List Bool := machineRawRatMulCode (pair (rawRatBinaryCode rawOptimizerTwo) (machineExplicitOptimizerInnerRadiusRawCode word)) +/-- Multiplies the encoded mixing parameter by the objective range. -/ def machineOptimizerMixRangeRawCode (word : List Bool) : List Bool := machineRawRatMulCode (pair (machineExplicitOptimizerMixRawCode word) (machineOptimizerObjectiveRangeRawCode word)) +/-- Adds the mixing-range product and twice the inner radius to encode smoothing slack. -/ def machineOptimizerSmoothingSlackRawCode (word : List Bool) : List Bool := machineRawRatAddCode (pair (machineOptimizerMixRangeRawCode word) (machineOptimizerTwiceInnerRadiusRawCode word)) +/-- Adds smoothing slack to the encoded objective upper bound. -/ def machineOptimizerInitialHighRawCode (word : List Bool) : List Bool := machineRawRatAddCode (pair (machineOptimizerObjectiveUpperRawCode word) (machineOptimizerSmoothingSlackRawCode word)) +/-- Computes the encoded quantity `2*n^2` used in the initial width. -/ def machineOptimizerTwiceNSquareForWidthRawCode (word : List Bool) : List Bool := machineRawRatMulCode (pair (rawRatBinaryCode rawOptimizerTwo) (machineOptimizerNSquareRawCode word)) +/-- Adds `2*n^2` to the initial upper threshold to encode the initial bisection width. -/ def machineExplicitOptimizerInitialWidthRawCode (word : List Bool) : List Bool := machineRawRatAddCode @@ -264,16 +277,19 @@ theorem rawExplicitOptimizerInitialWidth_eq {m : ℕ} /-! ## Exact unary bisection count -/ +/-- Normalizes the raw initial bisection width into a rational entry code. -/ def machineExplicitOptimizerInitialWidthEntryCode (word : List Bool) : List Bool := machineNormalizeRawRatEntryCode (machineExplicitOptimizerInitialWidthRawCode word) +/-- Measures the encoded initial interval width with an optimizer entry-length ruler. -/ def machineExplicitOptimizerInitialWidthLengthRuler (word : List Bool) : List Bool := machineOptimizerEntryLengthRuler (machineExplicitOptimizerInitialWidthEntryCode word) +/-- Concatenates the initial-width and gap length rulers with three extra bisection steps. -/ def machineExplicitOptimizerBisectionStepsRuler (word : List Bool) : List Bool := machineExplicitOptimizerInitialWidthLengthRuler word ++ diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerBisectionSemantics.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerBisectionSemantics.lean index da0117940f..774cf8a54d 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerBisectionSemantics.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerBisectionSemantics.lean @@ -52,6 +52,7 @@ theorem explicitOptimizerInitialWidth_eq_interval {m : ℕ} explicitOptimizerInitialWidth_eq_interval] norm_num +/-- The raw-rational dyadic fraction `k/2^t`. -/ def rawDyadicFraction (k t : ℕ) : RawRat := ⟨k, 2 ^ t, pow_pos (by omega) _⟩ @@ -59,6 +60,8 @@ def rawDyadicFraction (k t : ℕ) : RawRat := (rawDyadicFraction k t).value = (k : ℚ) / 2 ^ t := by simp [rawDyadicFraction, RawRat.value] +/-- Encodes a matrix, scheduled iteration ruler, binary index `k`, and unary depth `t` as +bisection state. -/ def machineOptimizerBisectionCanonicalState {m : ℕ} (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) (k t : ℕ) : List Bool := @@ -222,6 +225,7 @@ def machineOptimizerBisectionCanonicalState {m : ℕ} /-! ## Indexed semantic loop and exact step simulation -/ +/-- Updates the dyadic index to `2*k` on midpoint acceptance or `2*k + 1` on exhaustion. -/ def scannedOptimizerIndexStep {m : ℕ} (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) (k t : ℕ) : ℕ := @@ -236,6 +240,8 @@ def scannedOptimizerIndexStep {m : ℕ} | .accepted _ => 2 * k | .exhausted _ => 2 * k + 1 +/-- Runs the semantic dyadic-index update for a specified number of steps from depth `t` and +index `k`. -/ def runScannedOptimizerIndex {m : ℕ} (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) : ℕ → ℕ → ℕ → ℕ @@ -397,6 +403,8 @@ theorem optimizerDyadicThreshold_odd_high {m : ℕ} rw [pow_succ] ring +/-- Relates a bisection state's endpoints to adjacent dyadic thresholds with index `k` and depth +`t`. -/ def ScannedOptimizerIndexAgrees {m : ℕ} (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) (s : BetheBisectionState (m * m + 1)) (k t : ℕ) : Prop := diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerDerivedScales.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerDerivedScales.lean index 8e32822c19..6a5be77fbc 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerDerivedScales.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerDerivedScales.lean @@ -24,53 +24,71 @@ namespace BeyondBethe open Complexity +/-- The raw-rational constant one used in optimizer scale formulas. -/ def rawOptimizerOne : RawRat := RawRat.ofNat 1 +/-- The raw-rational constant three used in optimizer scale formulas. -/ def rawOptimizerThree : RawRat := RawRat.ofNat 3 +/-- The raw-rational constant ten used in optimizer scale formulas. -/ def rawOptimizerTen : RawRat := RawRat.ofNat 10 +/-- The raw-rational constant forty-eight used in optimizer scale formulas. -/ def rawOptimizerFortyEight : RawRat := RawRat.ofNat 48 +/-- The raw-rational representation of the fixed optimizer KKT error allowance. -/ def rawOptimizerKKTError : RawRat := rawRatOfRat explicitKKTError +/-- Half the power of one half determined by the numerical interior exponent. -/ def rawExplicitOptimizerFloor (n B : ℕ) : RawRat := (rawOptimizerHalf.pow (numericalInteriorExponent n B (explicitRegularizationScale n))).div rawOptimizerTwo +/-- The optimizer radius parameter given by the floor times the KKT error allowance divided by +48. -/ def rawExplicitOptimizerRho (n B : ℕ) : RawRat := ((rawExplicitOptimizerFloor n B).mul rawOptimizerKKTError).div rawOptimizerFortyEight +/-- The optimizer gap given by the regularization parameter times the squared radius, divided by +four. -/ def rawExplicitOptimizerGap (n B : ℕ) : RawRat := ((rawOptimizerTau n).mul ((rawExplicitOptimizerRho n B).mul (rawExplicitOptimizerRho n B))).div rawOptimizerFour +/-- The raw-rational objective range `n*B + 3*n^2`. -/ def rawOptimizerObjectiveRange (n B : ℕ) : RawRat := ((rawOptimizerDimension n).mul (rawOptimizerBitBound B)).add (rawOptimizerThree.mul (rawOptimizerNSquare n)) +/-- Four times one plus the objective range, used as the mixing denominator. -/ def rawOptimizerMixDenominator (n B : ℕ) : RawRat := rawOptimizerFour.mul ((rawOptimizerObjectiveRange n B).add rawOptimizerOne) +/-- The candidate mixing parameter obtained by dividing the optimizer gap by its mixing +denominator. -/ def rawOptimizerMixCandidate (n B : ℕ) : RawRat := (rawExplicitOptimizerGap n B).div (rawOptimizerMixDenominator n B) +/-- The smaller of one half and the candidate optimizer mixing parameter. -/ def rawExplicitOptimizerMix (n B : ℕ) : RawRat := if rawOptimizerHalf.value ≤ (rawOptimizerMixCandidate n B).value then rawOptimizerHalf else rawOptimizerMixCandidate n B +/-- The raw-rational quantity `2*n`. -/ def rawOptimizerTwiceDimension (n : ℕ) : RawRat := rawOptimizerTwo.mul (rawOptimizerDimension n) +/-- The inner radius given by the mixing parameter divided by twice the dimension. -/ def rawExplicitOptimizerInnerRadius (n B : ℕ) : RawRat := (rawExplicitOptimizerMix n B).div (rawOptimizerTwiceDimension n) /-! ## Finite-word scale machines -/ +/-- Computes the encoded floor times the KKT error allowance, divided by 48. -/ def machineExplicitOptimizerRhoRawCode (word : List Bool) : List Bool := machineRawRatDivCode (pair @@ -79,58 +97,69 @@ def machineExplicitOptimizerRhoRawCode (word : List Bool) : List Bool := (rawRatBinaryCode rawOptimizerKKTError))) (rawRatBinaryCode rawOptimizerFortyEight)) +/-- Squares the encoded optimizer radius parameter. -/ def machineExplicitOptimizerRhoSquareRawCode (word : List Bool) : List Bool := machineRawRatMulCode (pair (machineExplicitOptimizerRhoRawCode word) (machineExplicitOptimizerRhoRawCode word)) +/-- Multiplies the encoded regularization parameter by the squared radius. -/ def machineExplicitOptimizerGapNumeratorRawCode (word : List Bool) : List Bool := machineRawRatMulCode (pair (machineOptimizerTauRawCode word) (machineExplicitOptimizerRhoSquareRawCode word)) +/-- Divides the gap numerator by four. -/ def machineExplicitOptimizerGapRawCode (word : List Bool) : List Bool := machineRawRatDivCode (pair (machineExplicitOptimizerGapNumeratorRawCode word) (rawRatBinaryCode rawOptimizerFour)) +/-- Computes the encoded quantity `3*n^2`. -/ def machineOptimizerThreeNSquareRawCode (word : List Bool) : List Bool := machineRawRatMulCode (pair (rawRatBinaryCode rawOptimizerThree) (machineOptimizerNSquareRawCode word)) +/-- Adds `n*B` and `3*n^2` to encode the objective range. -/ def machineOptimizerObjectiveRangeRawCode (word : List Bool) : List Bool := machineRawRatAddCode (pair (machineOptimizerNBProductRawCode word) (machineOptimizerThreeNSquareRawCode word)) +/-- Adds one to the encoded objective range. -/ def machineOptimizerRangePlusOneRawCode (word : List Bool) : List Bool := machineRawRatAddCode (pair (machineOptimizerObjectiveRangeRawCode word) (rawRatBinaryCode rawOptimizerOne)) +/-- Multiplies the objective range plus one by four for the mixing denominator. -/ def machineOptimizerMixDenominatorRawCode (word : List Bool) : List Bool := machineRawRatMulCode (pair (rawRatBinaryCode rawOptimizerFour) (machineOptimizerRangePlusOneRawCode word)) +/-- Divides the encoded optimizer gap by the mixing denominator. -/ def machineOptimizerMixCandidateRawCode (word : List Bool) : List Bool := machineRawRatDivCode (pair (machineExplicitOptimizerGapRawCode word) (machineOptimizerMixDenominatorRawCode word)) +/-- Takes the raw-rational minimum of one half and the candidate mixing parameter. -/ def machineExplicitOptimizerMixRawCode (word : List Bool) : List Bool := machineRawRatMinCode (pair (rawRatBinaryCode rawOptimizerHalf) (machineOptimizerMixCandidateRawCode word)) +/-- Computes the encoded quantity twice the matrix dimension. -/ def machineOptimizerTwiceDimensionRawCode (word : List Bool) : List Bool := machineRawRatMulCode (pair (rawRatBinaryCode rawOptimizerTwo) (machineOptimizerDimensionRawCode word)) +/-- Divides the encoded mixing parameter by twice the dimension to obtain the inner radius. -/ def machineExplicitOptimizerInnerRadiusRawCode (word : List Bool) : List Bool := machineRawRatDivCode @@ -437,14 +466,18 @@ theorem rawExplicitOptimizerScales_value {m : ℕ} /-! ## Exact unary precision ruler -/ +/-- Normalizes the raw optimizer gap into a rational entry code. -/ def machineExplicitOptimizerGapEntryCode (word : List Bool) : List Bool := machineNormalizeRawRatEntryCode (machineExplicitOptimizerGapRawCode word) +/-- Builds an entry-length ruler for the normalized optimizer gap. -/ def machineExplicitOptimizerGapLengthRuler (word : List Bool) : List Bool := machineOptimizerEntryLengthRuler (machineExplicitOptimizerGapEntryCode word) +/-- Schedules precision from the gap length, KKT-error encoding length, twice the dimension, and +ten extra steps. -/ def machineExplicitOptimizerPrecisionRuler (word : List Bool) : List Bool := machineExplicitOptimizerGapLengthRuler word ++ diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerEntryLength.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerEntryLength.lean index 6091a81663..546c566147 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerEntryLength.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerEntryLength.lean @@ -25,13 +25,16 @@ namespace BeyondBethe open Complexity +/-- Assigns data-code size two to false and four to true. -/ def boolDataSize : Bool → ℕ | false => 2 | true => 4 +/-- Sums the data-code sizes of all bits in a word. -/ def boolDataLength (word : List Bool) : ℕ := (word.map boolDataSize).sum +/-- Expands each false bit to two unary bits and each true bit to four. -/ def boolDataRuler (word : List Bool) : List Bool := word.flatMap fun bit ↦ List.replicate (boolDataSize bit) true @@ -109,41 +112,52 @@ theorem rational_encodedBitLength_eq_boolDataLength (q : ℚ) : /-! ## A finite-word transducer for `boolDataRuler` -/ +/-- Encodes a Boolean-data length state as remaining bits and accumulated unary ruler. -/ def machineBoolDataPack (remaining acc : List Bool) : List Bool := pair remaining acc +/-- Extracts the unprocessed bits of the data-length scan. -/ def machineBoolDataRemaining (state : List Bool) : List Bool := machinePairFirst state +/-- Extracts the accumulated unary data-length ruler. -/ def machineBoolDataAcc (state : List Bool) : List Bool := machinePairSecond state +/-- Produces four unary bits for a true head and two for a false head. -/ def machineBoolDataBitRuler (state : List Bool) : List Bool := machineIfHead (machineBoolDataRemaining state) (List.replicate 4 true) (List.replicate 2 true) +/-- Consumes one source bit and appends its data-size ruler to the accumulator. -/ def machineBoolDataContinue (state : List Bool) : List Bool := machineBoolDataPack (machineBoolDataRemaining state).tail (machineBoolDataAcc state ++ machineBoolDataBitRuler state) +/-- Processes the next data bit, leaving an exhausted scan state fixed. -/ def machineBoolDataStep (state : List Bool) : List Bool := machineIfEmpty (machineBoolDataRemaining state) state (machineBoolDataContinue state) +/-- Initializes the Boolean-data length scan with the whole word and an empty ruler. -/ def machineBoolDataInit (word : List Bool) : List Bool := machineBoolDataPack word [] +/-- Provides a ruler of length `4 + 4*word.length` for the data-length state bound. -/ def machineBoolDataBound (word : List Bool) : List Bool := List.replicate 4 true ++ (word ++ (word ++ (word ++ word))) +/-- Packs two copies of the data-length bound to bound the encoded scan state. -/ def machineBoolDataWidth (word : List Bool) : List Bool := machineBoolDataPack (machineBoolDataBound word) (machineBoolDataBound word) +/-- Runs the data-length scan once per input bit. -/ def machineBoolDataFinalState (word : List Bool) : List Bool := (machineBoolDataStep)^[word.length] (machineBoolDataInit word) +/-- Extracts the complete unary ruler for the input's data-code length. -/ def machineBoolDataLengthRuler (word : List Bool) : List Bool := machineBoolDataAcc (machineBoolDataFinalState word) @@ -200,6 +214,7 @@ theorem machineBoolDataWidth_mem_FP : machineBoolDataAcc (machineBoolDataPack remaining acc) = acc := by simp [machineBoolDataAcc, machineBoolDataPack] +/-- Bounds the remaining source and an accumulator growing by at most four bits per iteration. -/ def MachineBoolDataStateBound (word : List Bool) (iterations : ℕ) (state : List Bool) : Prop := state = machineBoolDataPack @@ -295,19 +310,25 @@ theorem machineBoolDataIterate_complete (word acc : List Bool) : /-! ## One rational entry -/ +/-- Extracts the encoded integer numerator of a rational entry. -/ def machineOptimizerEntryNumeratorCode (word : List Bool) : List Bool := machineRationalEntryNumeratorWord word +/-- Extracts the numerator's absolute-value bits from a rational entry. -/ def machineOptimizerEntryNatAbsBits (word : List Bool) : List Bool := machineIntegerNatAbsBits (machineOptimizerEntryNumeratorCode word) +/-- Produces the data-size ruler for the numerator sign, with four bits for negative and two +otherwise. -/ def machineOptimizerEntrySignRuler (word : List Bool) : List Bool := machineIfHead (machineOptimizerEntryNumeratorCode word) (List.replicate 4 true) (List.replicate 2 true) +/-- Builds the Boolean-data length ruler for the numerator's absolute-value bits. -/ def machineOptimizerEntryNumeratorRuler (word : List Bool) : List Bool := machineBoolDataLengthRuler (machineOptimizerEntryNatAbsBits word) +/-- Builds the Boolean-data length ruler for the rational entry's denominator bits. -/ def machineOptimizerEntryDenominatorRuler (word : List Bool) : List Bool := machineBoolDataLengthRuler (machineRationalEntryDenominatorWord word) diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerFeasibilityCall.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerFeasibilityCall.lean index 13f4e165b8..eb4ce2d358 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerFeasibilityCall.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerFeasibilityCall.lean @@ -24,22 +24,27 @@ namespace BeyondBethe open Complexity +/-- Converts the reduced feasibility dimension to a unary ruler bounded by the source word. -/ def machineOptimizerFeasibilityReducedDimensionUnary (word : List Bool) : List Bool := machineBoundedUnary (pair (machineOptimizerFeasibilitySource word) (machineOptimizerFeasibilityReducedDimensionBits word)) +/-- Normalizes the source matrix's regularization parameter for the feasibility oracle. -/ def machineOptimizerFeasibilityTauCode (word : List Bool) : List Bool := machineNormalizeRawRatEntryCode (machineOptimizerTauRawCode (machineOptimizerFeasibilitySource word)) +/-- Obtains the encoded optimizer floor from the source matrix. -/ def machineOptimizerFeasibilityDeltaRawCode (word : List Bool) : List Bool := machineExplicitOptimizerFloorRawCode (machineOptimizerFeasibilitySource word) +/-- Packages dimension, precision, regularization, floor, threshold, and source for the static +feasibility oracle. -/ def machineOptimizerFeasibilityOracleStaticCode (word : List Bool) : List Bool := pair (machineOptimizerFeasibilityReducedDimensionUnary word) @@ -51,12 +56,15 @@ def machineOptimizerFeasibilityOracleStaticCode (pair (machineOptimizerFeasibilityUpperRawCode word) (machineOptimizerFeasibilitySource word))))) +/-- Encodes the initial rational ball using the ellipsoid dimension and outer-radius code. -/ def machineOptimizerFeasibilityInitialBallCode (word : List Bool) : List Bool := machineRationalBallStateCode (pair (machineOptimizerFeasibilityEllipsoidDimensionUnary word) (machineOptimizerFeasibilityOuterRadiusEntryCode word)) +/-- Packages the iteration budget, state bound, rounding precision, static oracle data, and +initial ball. -/ def machineOptimizerFeasibilityLoopWord (word : List Bool) : List Bool := pair (machineOptimizerFeasibilityBudgetUnary word) @@ -65,6 +73,8 @@ def machineOptimizerFeasibilityLoopWord (pair (machineOptimizerFeasibilityOracleStaticCode word) (machineOptimizerFeasibilityInitialBallCode word)))) +/-- Runs the Bethe feasibility loop on the optimizer-generated request and extracts its result +code. -/ def machineExplicitBetheThresholdFeasibilityCode (word : List Bool) : List Bool := machineBetheFeasibilityResultCode diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerFeasibilitySchedule.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerFeasibilitySchedule.lean index b6039adbc0..a45d602911 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerFeasibilitySchedule.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerFeasibilitySchedule.lean @@ -24,68 +24,84 @@ namespace BeyondBethe open Complexity +/-- Encodes a matrix and raw upper threshold as a feasibility call. -/ def optimizerFeasibilityCallCode {n : ℕ} (A : Matrix (Fin n) (Fin n) ℚ) (upper : RawRat) : List Bool := pair (rationalMatrixBinaryEncoding.encode ⟨n, A⟩) (rawRatBinaryCode upper) +/-- Extracts the source matrix word from an optimizer feasibility call. -/ def machineOptimizerFeasibilitySource (word : List Bool) : List Bool := machinePairFirst word +/-- Extracts the raw upper-threshold code from an optimizer feasibility call. -/ def machineOptimizerFeasibilityUpperRawCode (word : List Bool) : List Bool := machinePairSecond word +/-- Replaces a raw rational code's numerator by its nonnegative absolute value while preserving +the denominator. -/ def machineRawRatAbsCode (word : List Bool) : List Bool := pair (machineNaturalIntegerCode (machineIntegerNatAbsBits (machinePairFirst word))) (machinePairSecond word) +/-- Replaces a raw rational numerator by its natural absolute value, retaining the positive +denominator. -/ def rawRatAbs (q : RawRat) : RawRat := ⟨q.num.natAbs, q.den, q.den_pos⟩ +/-- Reads the binary source-matrix dimension from a feasibility call. -/ def machineOptimizerFeasibilityDimensionBits (word : List Bool) : List Bool := machineOptimizerDimensionBits (machineOptimizerFeasibilitySource word) +/-- Computes the binary reduced dimension `n - 1` using truncated natural subtraction. -/ def machineOptimizerFeasibilityReducedDimensionBits (word : List Bool) : List Bool := machineBinarySubBits (pair (machineOptimizerFeasibilityDimensionBits word) [true]) +/-- Computes the square of the reduced dimension in binary. -/ def machineOptimizerFeasibilityReducedDimensionSquareBits (word : List Bool) : List Bool := machineBinaryMulBits (pair (machineOptimizerFeasibilityReducedDimensionBits word) (machineOptimizerFeasibilityReducedDimensionBits word)) +/-- Adds one to the reduced-dimension square to obtain the ellipsoid dimension. -/ def machineOptimizerFeasibilityEllipsoidDimensionBits (word : List Bool) : List Bool := machineBinaryAddBits (pair (machineOptimizerFeasibilityReducedDimensionSquareBits word) [true]) +/-- Converts the ellipsoid dimension to a unary ruler bounded by the source matrix word. -/ def machineOptimizerFeasibilityEllipsoidDimensionUnary (word : List Bool) : List Bool := machineBoundedUnary (pair (machineOptimizerFeasibilitySource word) (machineOptimizerFeasibilityEllipsoidDimensionBits word)) +/-- Encodes the ellipsoid dimension as a raw rational with denominator one. -/ def machineOptimizerFeasibilityEllipsoidDimensionRawCode (word : List Bool) : List Bool := pair (machineNaturalIntegerCode (machineOptimizerFeasibilityEllipsoidDimensionBits word)) [true] +/-- Computes the optimizer's raw inner radius from the source matrix word. -/ def machineOptimizerFeasibilityInnerRadiusRawCode (word : List Bool) : List Bool := machineExplicitOptimizerInnerRadiusRawCode (machineOptimizerFeasibilitySource word) +/-- Multiplies the optimizer's raw inner radius by two. -/ def machineOptimizerFeasibilityTwiceInnerRadiusRawCode (word : List Bool) : List Bool := machineRawRatMulCode (pair (rawRatBinaryCode rawOptimizerTwo) (machineOptimizerFeasibilityInnerRadiusRawCode word)) +/-- Computes raw one plus the absolute value of the feasibility upper threshold. -/ def machineOptimizerFeasibilityOnePlusAbsUpperRawCode (word : List Bool) : List Bool := machineRawRatAddCode @@ -93,12 +109,14 @@ def machineOptimizerFeasibilityOnePlusAbsUpperRawCode (machineRawRatAbsCode (machineOptimizerFeasibilityUpperRawCode word))) +/-- Adds twice the inner radius to one plus the absolute upper threshold. -/ def machineOptimizerFeasibilityRadiusFactorRawCode (word : List Bool) : List Bool := machineRawRatAddCode (pair (machineOptimizerFeasibilityOnePlusAbsUpperRawCode word) (machineOptimizerFeasibilityTwiceInnerRadiusRawCode word)) +/-- Multiplies the radius factor by the ellipsoid dimension to obtain the raw outer radius. -/ def machineOptimizerFeasibilityOuterRadiusRawCode (word : List Bool) : List Bool := machineRawRatMulCode @@ -364,6 +382,7 @@ theorem optimizerEllipsoidDimension_le_sourceLength {n : ℕ} machineRawRatMulCode_encode, machineRawRatAddCode_encode, machineRawRatMulCode_encode] +/-- Forms the raw outer radius `((n - 1)^2 + 1) * (1 + abs upper + 2 * innerRadius(n, B))`. -/ def rawOptimizerFeasibilityOuterRadius (n B : ℕ) (upper : RawRat) : RawRat := (RawRat.ofNat ((n - 1) ^ 2 + 1)).mul @@ -400,99 +419,119 @@ theorem rawOptimizerFeasibilityOuterRadius_eq {m : ℕ} /-! ## Exact encoded lengths and guarded budget -/ +/-- Normalizes the raw feasibility outer radius into its rational entry encoding. -/ def machineOptimizerFeasibilityOuterRadiusEntryCode (word : List Bool) : List Bool := machineNormalizeRawRatEntryCode (machineOptimizerFeasibilityOuterRadiusRawCode word) +/-- Computes the optimizer length ruler for the normalized outer-radius entry. -/ def machineOptimizerFeasibilityOuterRadiusLengthRuler (word : List Bool) : List Bool := machineOptimizerEntryLengthRuler (machineOptimizerFeasibilityOuterRadiusEntryCode word) +/-- Normalizes the raw feasibility inner radius into its rational entry encoding. -/ def machineOptimizerFeasibilityInnerRadiusEntryCode (word : List Bool) : List Bool := machineNormalizeRawRatEntryCode (machineOptimizerFeasibilityInnerRadiusRawCode word) +/-- Computes the optimizer length ruler for the normalized inner-radius entry. -/ def machineOptimizerFeasibilityInnerRadiusLengthRuler (word : List Bool) : List Bool := machineOptimizerEntryLengthRuler (machineOptimizerFeasibilityInnerRadiusEntryCode word) +/-- Concatenates the unary ellipsoid dimension and the two radius-length rulers to seed the +feasibility-budget guard. -/ def machineOptimizerFeasibilityBudgetGuardSource (word : List Bool) : List Bool := machineOptimizerFeasibilityEllipsoidDimensionUnary word ++ (machineOptimizerFeasibilityOuterRadiusLengthRuler word ++ machineOptimizerFeasibilityInnerRadiusLengthRuler word) +/-- Reads the binary ellipsoid dimension used in the feasibility-budget formulas. -/ def machineOptimizerFeasibilityDBits (word : List Bool) : List Bool := machineOptimizerFeasibilityEllipsoidDimensionBits word +/-- Computes the square of the ellipsoid dimension in binary. -/ def machineOptimizerFeasibilityDSquareBits (word : List Bool) : List Bool := machineBinaryMulBits (pair (machineOptimizerFeasibilityDBits word) (machineOptimizerFeasibilityDBits word)) +/-- Computes the cube of the ellipsoid dimension in binary. -/ def machineOptimizerFeasibilityDCubeBits (word : List Bool) : List Bool := machineBinaryMulBits (pair (machineOptimizerFeasibilityDSquareBits word) (machineOptimizerFeasibilityDBits word)) +/-- Converts the outer-radius length ruler into its binary length. -/ def machineOptimizerFeasibilityOuterLengthBits (word : List Bool) : List Bool := machineLengthBits (machineOptimizerFeasibilityOuterRadiusLengthRuler word) +/-- Converts the inner-radius length ruler into its binary length. -/ def machineOptimizerFeasibilityInnerLengthBits (word : List Bool) : List Bool := machineLengthBits (machineOptimizerFeasibilityInnerRadiusLengthRuler word) +/-- Multiplies the outer-radius length by the ellipsoid dimension in binary. -/ def machineOptimizerFeasibilityOuterLengthTimesDBits (word : List Bool) : List Bool := machineBinaryMulBits (pair (machineOptimizerFeasibilityOuterLengthBits word) (machineOptimizerFeasibilityDBits word)) +/-- Multiplies the inner-radius length by the ellipsoid dimension in binary. -/ def machineOptimizerFeasibilityInnerLengthTimesDBits (word : List Bool) : List Bool := machineBinaryMulBits (pair (machineOptimizerFeasibilityInnerLengthBits word) (machineOptimizerFeasibilityDBits word)) +/-- Computes `D^2 + D * outerLength` in binary for the feasibility budget. -/ def machineOptimizerFeasibilityMFirstBits (word : List Bool) : List Bool := machineBinaryAddBits (pair (machineOptimizerFeasibilityDSquareBits word) (machineOptimizerFeasibilityOuterLengthTimesDBits word)) +/-- Adds `D * innerLength` to the first feasibility-budget sum. -/ def machineOptimizerFeasibilityMSecondBits (word : List Bool) : List Bool := machineBinaryAddBits (pair (machineOptimizerFeasibilityMFirstBits word) (machineOptimizerFeasibilityInnerLengthTimesDBits word)) +/-- Computes the budget factor `D^2 + D * outerLength + D * innerLength + 1` in binary. -/ def machineOptimizerFeasibilityMBits (word : List Bool) : List Bool := machineBinaryAddBits (pair (machineOptimizerFeasibilityMSecondBits word) [true]) +/-- Computes thirty-two times the cube of the ellipsoid dimension in binary. -/ def machineOptimizerFeasibilityThirtyTwoDCubeBits (word : List Bool) : List Bool := machineBinaryMulBits (pair (32 : ℕ).bits (machineOptimizerFeasibilityDCubeBits word)) +/-- Multiplies `32 * D^3` by the dimension-and-radius-length budget factor. -/ def machineOptimizerFeasibilityBudgetBits (word : List Bool) : List Bool := machineBinaryMulBits (pair (machineOptimizerFeasibilityThirtyTwoDCubeBits word) (machineOptimizerFeasibilityMBits word)) +/-- Applies the binary-width construction three times to the budget-guard source word. -/ def machineOptimizerFeasibilityBudgetGuard (word : List Bool) : List Bool := machineIteratedBinaryWidth 3 (machineOptimizerFeasibilityBudgetGuardSource word) +/-- Converts the binary feasibility budget to a unary ruler bounded by the computed guard. -/ def machineOptimizerFeasibilityBudgetUnary (word : List Bool) : List Bool := machineBoundedUnary diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerInteriorScale.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerInteriorScale.lean index de62193c25..ba80113c7e 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerInteriorScale.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerInteriorScale.lean @@ -29,114 +29,144 @@ open Complexity /-! ## Raw rational expression computed by the machine -/ +/-- The raw rational constant two used in optimizer scale formulas. -/ def rawOptimizerTwo : RawRat := RawRat.ofNat 2 +/-- The raw rational constant four used in optimizer scale formulas. -/ def rawOptimizerFour : RawRat := RawRat.ofNat 4 +/-- The raw rational one-half obtained by dividing one by two. -/ def rawOptimizerHalf : RawRat := (RawRat.ofNat 1).div rawOptimizerTwo +/-- The raw rational representation of the explicit optimizer parameter `explicitXi`. -/ def rawOptimizerXi : RawRat := rawRatOfRat explicitXi +/-- Embeds the optimizer dimension as a raw rational with denominator one. -/ def rawOptimizerDimension (n : ℕ) : RawRat := RawRat.ofNat n +/-- Embeds the matrix-entry bit bound as a raw rational with denominator one. -/ def rawOptimizerBitBound (B : ℕ) : RawRat := RawRat.ofNat B +/-- Computes the raw regularization scale `explicitXi / (4 * n)`. -/ def rawOptimizerTau (n : ℕ) : RawRat := rawOptimizerXi.div (rawOptimizerFour.mul (rawOptimizerDimension n)) +/-- Computes the dimension squared in raw rational arithmetic. -/ def rawOptimizerNSquare (n : ℕ) : RawRat := (rawOptimizerDimension n).mul (rawOptimizerDimension n) +/-- Computes the dimension cubed in raw rational arithmetic. -/ def rawOptimizerNCube (n : ℕ) : RawRat := (rawOptimizerNSquare n).mul (rawOptimizerDimension n) +/-- Computes the interior-scale sum `n * B + 2 * n^2` in raw rational arithmetic. -/ def rawOptimizerInteriorSum (n B : ℕ) : RawRat := ((rawOptimizerDimension n).mul (rawOptimizerBitBound B)).add (rawOptimizerTwo.mul (rawOptimizerNSquare n)) +/-- Computes the raw interior constant `n * (n * B + 2 * n^2) / tau(n) + n^3`. -/ def rawOptimizerInteriorK0 (n B : ℕ) : RawRat := ((rawOptimizerDimension n).mul (rawOptimizerInteriorSum n B)).div (rawOptimizerTau n) |>.add (rawOptimizerNCube n) +/-- Doubles the raw interior constant used to define optimizer scales. -/ def rawOptimizerTwiceInteriorK0 (n B : ℕ) : RawRat := rawOptimizerTwo.mul (rawOptimizerInteriorK0 n B) /-! ## Binary machines for the expression -/ +/-- Extracts the binary matrix dimension for optimizer computations. -/ def machineOptimizerDimensionBits (word : List Bool) : List Bool := machineMatrixDimensionWord word +/-- Extracts the unary matrix dimension for optimizer computations. -/ def machineOptimizerDimensionUnary (word : List Bool) : List Bool := machineMatrixDimensionUnary word +/-- Encodes the matrix dimension as a raw rational with denominator one. -/ def machineOptimizerDimensionRawCode (word : List Bool) : List Bool := pair (machineNaturalIntegerCode (machineOptimizerDimensionBits word)) [true] +/-- Computes the binary length of the matrix-entry bit-bound ruler. -/ def machineOptimizerBitBoundBits (word : List Bool) : List Bool := machineLengthBits (machineMatrixEntryBitBoundRuler word) +/-- Encodes the matrix-entry bit bound as a raw rational with denominator one. -/ def machineOptimizerBitBoundRawCode (word : List Bool) : List Bool := pair (machineNaturalIntegerCode (machineOptimizerBitBoundBits word)) [true] +/-- Computes raw four times the matrix dimension. -/ def machineOptimizerFourDimensionRawCode (word : List Bool) : List Bool := machineRawRatMulCode (pair (rawRatBinaryCode rawOptimizerFour) (machineOptimizerDimensionRawCode word)) +/-- Computes the encoded raw regularization scale by dividing `explicitXi` by four times the +dimension. -/ def machineOptimizerTauRawCode (word : List Bool) : List Bool := machineRawRatDivCode (pair (rawRatBinaryCode rawOptimizerXi) (machineOptimizerFourDimensionRawCode word)) +/-- Computes the encoded raw square of the matrix dimension. -/ def machineOptimizerNSquareRawCode (word : List Bool) : List Bool := machineRawRatMulCode (pair (machineOptimizerDimensionRawCode word) (machineOptimizerDimensionRawCode word)) +/-- Computes the encoded raw cube of the matrix dimension. -/ def machineOptimizerNCubeRawCode (word : List Bool) : List Bool := machineRawRatMulCode (pair (machineOptimizerNSquareRawCode word) (machineOptimizerDimensionRawCode word)) +/-- Computes the encoded raw product of dimension and matrix-entry bit bound. -/ def machineOptimizerNBProductRawCode (word : List Bool) : List Bool := machineRawRatMulCode (pair (machineOptimizerDimensionRawCode word) (machineOptimizerBitBoundRawCode word)) +/-- Computes the encoded raw value of twice the squared dimension. -/ def machineOptimizerTwiceNSquareRawCode (word : List Bool) : List Bool := machineRawRatMulCode (pair (rawRatBinaryCode rawOptimizerTwo) (machineOptimizerNSquareRawCode word)) +/-- Computes the encoded raw interior sum `n * B + 2 * n^2`. -/ def machineOptimizerInteriorSumRawCode (word : List Bool) : List Bool := machineRawRatAddCode (pair (machineOptimizerNBProductRawCode word) (machineOptimizerTwiceNSquareRawCode word)) +/-- Multiplies the raw interior sum by the matrix dimension. -/ def machineOptimizerNTimesInteriorSumRawCode (word : List Bool) : List Bool := machineRawRatMulCode (pair (machineOptimizerDimensionRawCode word) (machineOptimizerInteriorSumRawCode word)) +/-- Divides the dimension-scaled interior sum by the raw regularization parameter. -/ def machineOptimizerInteriorQuotientRawCode (word : List Bool) : List Bool := machineRawRatDivCode (pair (machineOptimizerNTimesInteriorSumRawCode word) (machineOptimizerTauRawCode word)) +/-- Adds the dimension cube to the interior quotient to compute the raw interior constant. -/ def machineOptimizerInteriorK0RawCode (word : List Bool) : List Bool := machineRawRatAddCode (pair (machineOptimizerInteriorQuotientRawCode word) (machineOptimizerNCubeRawCode word)) +/-- Computes the raw code for twice the optimizer interior constant. -/ def machineOptimizerTwiceInteriorK0RawCode (word : List Bool) : List Bool := machineRawRatMulCode (pair (rawRatBinaryCode rawOptimizerTwo) (machineOptimizerInteriorK0RawCode word)) +/-- Computes the natural ceiling of twice the raw interior constant in binary. -/ def machineOptimizerInteriorExponentBits (word : List Bool) : List Bool := machineRationalCeilNatBits (machineOptimizerTwiceInteriorK0RawCode word) @@ -462,6 +492,7 @@ theorem machineOptimizerInteriorExponentBits_mem_FP : /-! ## Guarded unary exponent and dyadic floor -/ +/-- The explicit interior-exponent coefficient `34 * rationalCeilNat (8 / explicitXi) + 2`. -/ def explicitOptimizerInteriorExponentCoefficient : ℕ := 34 * rationalCeilNat (8 / explicitXi) + 2 @@ -510,19 +541,24 @@ theorem numericalInteriorExponent_le_sourcePolynomial rw [hrewrite] exact hmain.trans hpoly +/-- Applies the binary-width construction six times to bound conversion of the interior exponent +to unary. -/ def machineOptimizerInteriorExponentGuard (word : List Bool) : List Bool := machineIteratedBinaryWidth 6 word +/-- Converts the interior exponent to a unary ruler under its computed guard. -/ def machineOptimizerInteriorExponentUnary (word : List Bool) : List Bool := machineBoundedUnary (pair (machineOptimizerInteriorExponentGuard word) (machineOptimizerInteriorExponentBits word)) +/-- Raises raw one-half to the unary interior exponent. -/ def machineOptimizerInteriorFloorRawCode (word : List Bool) : List Bool := machineRawRatPowerCode (pair (machineOptimizerInteriorExponentUnary word) (rawRatBinaryCode rawOptimizerHalf)) +/-- Divides the interior power-of-two floor by two to obtain the explicit optimizer floor. -/ def machineExplicitOptimizerFloorRawCode (word : List Bool) : List Bool := machineRawRatDivCode (pair (machineOptimizerInteriorFloorRawCode word) diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerMatrixBitBound.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerMatrixBitBound.lean index 5ba31aeec3..138a50f7b1 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerMatrixBitBound.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerMatrixBitBound.lean @@ -25,33 +25,43 @@ namespace BeyondBethe open Complexity +/-- Packs remaining matrix rows, the current suffix, accumulated length ruler, and bound for the +entry-length scan. -/ def machineMatrixEntryLengthPack (rows current acc bound : List Bool) : List Bool := pair rows (pair current (pair acc bound)) +/-- Extracts the remaining rows from the matrix-entry-length scan state. -/ def machineMatrixEntryLengthRows (state : List Bool) : List Bool := machinePairFirst state +/-- Extracts the current row suffix from the matrix-entry-length scan state. -/ def machineMatrixEntryLengthCurrent (state : List Bool) : List Bool := machinePairFirst (machinePairSecond state) +/-- Extracts the accumulated entry-length ruler from the scan state. -/ def machineMatrixEntryLengthAcc (state : List Bool) : List Bool := machinePairFirst (machinePairSecond (machinePairSecond state)) +/-- Extracts the length-bound word from the matrix-entry-length scan state. -/ def machineMatrixEntryLengthBound (state : List Bool) : List Bool := machinePairSecond (machinePairSecond (machinePairSecond state)) +/-- Reads the next encoded entry of the current row suffix. -/ def machineMatrixEntryLengthEntry (state : List Bool) : List Bool := machineListHead (machineMatrixEntryLengthCurrent state) +/-- Appends the current entry's optimizer length ruler to the accumulated ruler. -/ def machineMatrixEntryLengthCandidate (state : List Bool) : List Bool := machineMatrixEntryLengthAcc state ++ machineOptimizerEntryLengthRuler (machineMatrixEntryLengthEntry state) +/-- Truncates the updated length ruler to the length of the stored bound. -/ def machineMatrixEntryLengthNextAcc (state : List Bool) : List Bool := (machineMatrixEntryLengthCandidate state).take (machineMatrixEntryLengthBound state).length +/-- Consumes one matrix entry and stores its contribution in the bounded length accumulator. -/ def machineMatrixEntryLengthProcessEntry (state : List Bool) : List Bool := machineMatrixEntryLengthPack (machineMatrixEntryLengthRows state) @@ -59,6 +69,7 @@ def machineMatrixEntryLengthProcessEntry (state : List Bool) : List Bool := (machineMatrixEntryLengthNextAcc state) (machineMatrixEntryLengthBound state) +/-- Loads the next matrix row while preserving the accumulated length and bound. -/ def machineMatrixEntryLengthLoadRow (state : List Bool) : List Bool := machineMatrixEntryLengthPack (machineListTail (machineMatrixEntryLengthRows state)) @@ -66,15 +77,19 @@ def machineMatrixEntryLengthLoadRow (state : List Bool) : List Bool := (machineMatrixEntryLengthAcc state) (machineMatrixEntryLengthBound state) +/-- Fixes a scan with no remaining rows and otherwise loads its next row. -/ def machineMatrixEntryLengthAfterRow (state : List Bool) : List Bool := machineIfEmpty (machineMatrixEntryLengthRows state) state (machineMatrixEntryLengthLoadRow state) +/-- Processes the current entry when present and otherwise loads another row or finishes. -/ def machineMatrixEntryLengthStep (state : List Bool) : List Bool := machineIfEmpty (machineMatrixEntryLengthCurrent state) (machineMatrixEntryLengthAfterRow state) (machineMatrixEntryLengthProcessEntry state) +/-- Builds a bound word consisting of eight false bits followed by sixty-four copies of the +input word. -/ def machineMatrixEntryLengthInputBound (word : List Bool) : List Bool := let w2 := word ++ word let w4 := w2 ++ w2 @@ -84,14 +99,18 @@ def machineMatrixEntryLengthInputBound (word : List Bool) : List Bool := let w64 := w32 ++ w32 List.replicate 8 false ++ w64 +/-- Initializes the entry-length scan with all matrix rows, empty current row, a one-bit +accumulator, and its computed bound. -/ def machineMatrixEntryLengthInit (word : List Bool) : List Bool := machineMatrixEntryLengthPack (machineMatrixRowsWord word) [] [true] (machineMatrixEntryLengthInputBound word) +/-- Packs four copies of the computed bound to bound the encoded entry-length scan state. -/ def machineMatrixEntryLengthWidth (word : List Bool) : List Bool := let bound := machineMatrixEntryLengthInputBound word machineMatrixEntryLengthPack bound bound bound bound +/-- Runs the entry-length scan once per input bit from its initial state. -/ def machineMatrixEntryLengthFinalState (word : List Bool) : List Bool := (machineMatrixEntryLengthStep)^[word.length] (machineMatrixEntryLengthInit word) @@ -225,6 +244,8 @@ theorem machineMatrixEntryLengthWidth_mem_FP : simp [machineMatrixEntryLengthInputBound] omega +/-- Requires exact scan-state packing, remaining row data bounded by input length, bounded +accumulated ruler, and the prescribed bound word. -/ def MachineMatrixEntryLengthStateBound (word state : List Bool) : Prop := state = machineMatrixEntryLengthPack (machineMatrixEntryLengthRows state) @@ -334,17 +355,24 @@ theorem machineMatrixEntryBitBoundRuler_mem_FP : /-! ## Exact semantics -/ +/-- Sums the rational encoding bit lengths of a list of entries. -/ def matrixEntryLengthListCost (xs : List ℚ) : ℕ := (xs.map fun q ↦ encodedBitLength ℚ q).sum +/-- Sums the entry-encoding bit costs of all rows. -/ def matrixEntryLengthRowsCost (rows : List (List ℚ)) : ℕ := (rows.map matrixEntryLengthListCost).sum structure MatrixEntryLengthSemState where + /-- The unprocessed rows of the semantic matrix-entry-length scan. -/ rows : List (List ℚ) + /-- The unprocessed suffix of the current row in the semantic length scan. -/ current : List ℚ + /-- The natural-number total accumulated by the semantic entry-length scan. -/ acc : ℕ +/-- Encodes the semantic remaining rows, current suffix, and unary accumulated length using the +supplied bound word. -/ def matrixEntryLengthSemCode (bound : List Bool) (s : MatrixEntryLengthSemState) : List Bool := machineMatrixEntryLengthPack @@ -352,6 +380,8 @@ def matrixEntryLengthSemCode (bound : List Bool) (binaryListCode rationalEntryBinaryCode s.current) (List.replicate s.acc true) bound +/-- Adds the next entry's encoding length, loads the next row when needed, and fixes the +exhausted semantic scan. -/ def matrixEntryLengthSemStep : MatrixEntryLengthSemState → MatrixEntryLengthSemState | ⟨[], [], acc⟩ => ⟨[], [], acc⟩ @@ -359,6 +389,8 @@ def matrixEntryLengthSemStep : | ⟨rows, q :: qs, acc⟩ => ⟨rows, qs, acc + encodedBitLength ℚ q⟩ +/-- Bounds the accumulated length plus all unprocessed entry costs by the specified bound +length. -/ def MatrixEntryLengthSemInvariant (boundLength : ℕ) (s : MatrixEntryLengthSemState) : Prop := s.acc + matrixEntryLengthListCost s.current + diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerRoundingSchedule.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerRoundingSchedule.lean index 3677235cc2..446e017e9c 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerRoundingSchedule.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerRoundingSchedule.lean @@ -27,10 +27,12 @@ the exact iteration budget, and canonical bit lengths of the outer radius and of the initial state-magnitude bound. -/ +/-- Computes the raw initial magnitude `2 + d * R` for ellipsoid feasibility. -/ def rawOptimizerFeasibilityInitialMagnitude (d : ℕ) (R : RawRat) : RawRat := rawOptimizerTwo.add ((RawRat.ofNat d).mul R) +/-- Computes the raw initial magnitude by adding two to ellipsoid dimension times outer radius. -/ def machineOptimizerFeasibilityInitialMagnitudeRawCode (word : List Bool) : List Bool := machineRawRatAddCode @@ -39,99 +41,121 @@ def machineOptimizerFeasibilityInitialMagnitudeRawCode (pair (machineOptimizerFeasibilityEllipsoidDimensionRawCode word) (machineOptimizerFeasibilityOuterRadiusRawCode word)))) +/-- Normalizes the raw initial-magnitude code into its rational entry encoding. -/ def machineOptimizerFeasibilityInitialMagnitudeEntryCode (word : List Bool) : List Bool := machineNormalizeRawRatEntryCode (machineOptimizerFeasibilityInitialMagnitudeRawCode word) +/-- Computes the optimizer length ruler for the normalized initial magnitude. -/ def machineOptimizerFeasibilityInitialMagnitudeLengthRuler (word : List Bool) : List Bool := machineOptimizerEntryLengthRuler (machineOptimizerFeasibilityInitialMagnitudeEntryCode word) +/-- Computes the binary initial-magnitude length `K` from its ruler. -/ def machineOptimizerFeasibilityKBits (word : List Bool) : List Bool := machineLengthBits (machineOptimizerFeasibilityInitialMagnitudeLengthRuler word) +/-- Computes `L` as the outer-radius length multiplied by ellipsoid dimension. -/ def machineOptimizerFeasibilityLBits (word : List Bool) : List Bool := machineBinaryMulOf machineOptimizerFeasibilityOuterLengthBits machineOptimizerFeasibilityDBits word +/-- Doubles the binary feasibility iteration budget `T`. -/ def machineOptimizerFeasibilityTwoTBits (word : List Bool) : List Bool := machineBinaryMulOf (machineBinaryConst 2) machineOptimizerFeasibilityBudgetBits word +/-- Computes the magnitude-bound term `L + 2 * T` in binary. -/ def machineOptimizerFeasibilityFirstBaseBits (word : List Bool) : List Bool := machineBinaryAddOf machineOptimizerFeasibilityLBits machineOptimizerFeasibilityTwoTBits word +/-- Computes the magnitude-bound term `L + 2 * T + 1` in binary. -/ def machineOptimizerFeasibilityFirstBits (word : List Bool) : List Bool := machineBinaryAddOf machineOptimizerFeasibilityFirstBaseBits (machineBinaryConst 1) word +/-- Computes three times the ellipsoid dimension in binary. -/ def machineOptimizerFeasibilityThreeDBits (word : List Bool) : List Bool := machineBinaryMulOf (machineBinaryConst 3) machineOptimizerFeasibilityDBits word +/-- Computes the per-step magnitude-growth term `6 + 3 * D` in binary. -/ def machineOptimizerFeasibilitySixPlusThreeDBits (word : List Bool) : List Bool := machineBinaryAddOf (machineBinaryConst 6) machineOptimizerFeasibilityThreeDBits word +/-- Multiplies the feasibility iteration budget by the magnitude-growth term `6 + 3 * D`. -/ def machineOptimizerFeasibilityTTimesGrowthBits (word : List Bool) : List Bool := machineBinaryMulOf machineOptimizerFeasibilityBudgetBits machineOptimizerFeasibilitySixPlusThreeDBits word +/-- Adds initial-magnitude length `K` to the accumulated growth `T * (6 + 3 * D)`. -/ def machineOptimizerFeasibilityKPlusGrowthBits (word : List Bool) : List Bool := machineBinaryAddOf machineOptimizerFeasibilityKBits machineOptimizerFeasibilityTTimesGrowthBits word +/-- Adds three to the initial length plus accumulated magnitude growth. -/ def machineOptimizerFeasibilityKPlusGrowthPlusThreeBits (word : List Bool) : List Bool := machineBinaryAddOf machineOptimizerFeasibilityKPlusGrowthBits (machineBinaryConst 3) word +/-- Computes the inner magnitude term `K + T * (6 + 3 * D) + 3 + D` in binary. -/ def machineOptimizerFeasibilityInnerMagnitudeBits (word : List Bool) : List Bool := machineBinaryAddOf machineOptimizerFeasibilityKPlusGrowthPlusThreeBits machineOptimizerFeasibilityDBits word +/-- Multiplies the inner magnitude term by the ellipsoid dimension. -/ def machineOptimizerFeasibilityDInnerMagnitudeBits (word : List Bool) : List Bool := machineBinaryMulOf machineOptimizerFeasibilityDBits machineOptimizerFeasibilityInnerMagnitudeBits word +/-- Computes eight times the ellipsoid dimension in binary. -/ def machineOptimizerFeasibilityEightDBits (word : List Bool) : List Bool := machineBinaryMulOf (machineBinaryConst 8) machineOptimizerFeasibilityDBits word +/-- Computes the first denominator-exponent term `12 + 8 * D` in binary. -/ def machineOptimizerFeasibilityDenomFirstBits (word : List Bool) : List Bool := machineBinaryAddOf (machineBinaryConst 12) machineOptimizerFeasibilityEightDBits word +/-- Adds the squared dimension to the first denominator-exponent term. -/ def machineOptimizerFeasibilityDenomSecondBits (word : List Bool) : List Bool := machineBinaryAddOf machineOptimizerFeasibilityDenomFirstBits machineOptimizerFeasibilityDSquareBits word +/-- Adds dimension times the inner magnitude to `12 + 8 * D + D^2` for the denominator exponent. -/ def machineOptimizerFeasibilityDenominatorExponentBits (word : List Bool) : List Bool := machineBinaryAddOf machineOptimizerFeasibilityDenomSecondBits machineOptimizerFeasibilityDInnerMagnitudeBits word +/-- Adds the first magnitude term and denominator exponent to form the rounding-precision base. -/ def machineOptimizerFeasibilityPrecisionBaseBits (word : List Bool) : List Bool := machineBinaryAddOf machineOptimizerFeasibilityFirstBits machineOptimizerFeasibilityDenominatorExponentBits word +/-- Adds two to the rounding-precision base. -/ def machineOptimizerFeasibilityRoundingPrecisionBits (word : List Bool) : List Bool := machineBinaryAddOf machineOptimizerFeasibilityPrecisionBaseBits (machineBinaryConst 2) word +/-- Concatenates the iteration, dimension, initial-magnitude-length, and outer-radius-length +rulers to seed the rounding guard. -/ def machineOptimizerFeasibilityRoundingGuardSource (word : List Bool) : List Bool := machineOptimizerFeasibilityBudgetUnary word ++ @@ -139,11 +163,13 @@ def machineOptimizerFeasibilityRoundingGuardSource (machineOptimizerFeasibilityInitialMagnitudeLengthRuler word ++ machineOptimizerFeasibilityOuterRadiusLengthRuler word)) +/-- Applies the binary-width construction twice to the rounding-guard source. -/ def machineOptimizerFeasibilityRoundingGuard (word : List Bool) : List Bool := machineIteratedBinaryWidth 2 (machineOptimizerFeasibilityRoundingGuardSource word) +/-- Converts rounding precision from binary to unary under the computed guard. -/ def machineOptimizerFeasibilityRoundingPrecisionUnary (word : List Bool) : List Bool := machineBoundedUnary @@ -340,6 +366,8 @@ theorem machineOptimizerFeasibilityRoundingPrecisionUnary_mem_FP : rw [rawOptimizerFeasibilityInitialMagnitude_value] rfl +/-- The explicit feasibility rounding precision, combining radius length, iteration count, +dimension, and initial magnitude length. -/ def optimizerFeasibilityRoundingPrecision (d LR K T : ℕ) : ℕ := (LR * d + 2 * T + 1) + diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerStateBound.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerStateBound.lean index 27c7ddb655..2b469af201 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerStateBound.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerStateBound.lean @@ -24,6 +24,7 @@ namespace BeyondBethe open Complexity +/-- Adds `10 + 4 * D` to the rounding precision to obtain the state denominator bound in binary. -/ def machineOptimizerFeasibilityStateDenominatorBits (word : List Bool) : List Bool := machineBinaryAddOf machineOptimizerFeasibilityRoundingPrecisionBits @@ -31,26 +32,31 @@ def machineOptimizerFeasibilityStateDenominatorBits (machineBinaryMulOf (machineBinaryConst 4) machineOptimizerFeasibilityDBits)) word +/-- Doubles the initial length plus accumulated magnitude growth for the state-entry bound. -/ def machineOptimizerFeasibilityStateTwiceMagnitudeBits (word : List Bool) : List Bool := machineBinaryMulOf (machineBinaryConst 2) machineOptimizerFeasibilityKPlusGrowthBits word +/-- Quadruples the state denominator bound in binary. -/ def machineOptimizerFeasibilityStateFourDenominatorBits (word : List Bool) : List Bool := machineBinaryMulOf (machineBinaryConst 4) machineOptimizerFeasibilityStateDenominatorBits word +/-- Adds eight to the doubled magnitude bound for the first state-entry term. -/ def machineOptimizerFeasibilityStateEntryFirstBits (word : List Bool) : List Bool := machineBinaryAddOf (machineBinaryConst 8) machineOptimizerFeasibilityStateTwiceMagnitudeBits word +/-- Adds four times the denominator bound to the first state-entry term. -/ def machineOptimizerFeasibilityStateEntryBits (word : List Bool) : List Bool := machineBinaryAddOf machineOptimizerFeasibilityStateEntryFirstBits machineOptimizerFeasibilityStateFourDenominatorBits word +/-- Doubles the state-entry bound and adds two for one encoded list entry. -/ def machineOptimizerFeasibilityStateTwiceEntryPlusTwoBits (word : List Bool) : List Bool := machineBinaryAddOf @@ -58,11 +64,13 @@ def machineOptimizerFeasibilityStateTwiceEntryPlusTwoBits machineOptimizerFeasibilityStateEntryBits) (machineBinaryConst 2) word +/-- Multiplies the encoded-entry bound by the ellipsoid dimension to bound a vector. -/ def machineOptimizerFeasibilityStateVectorBits (word : List Bool) : List Bool := machineBinaryMulOf machineOptimizerFeasibilityDBits machineOptimizerFeasibilityStateTwiceEntryPlusTwoBits word +/-- Doubles the vector bound and adds two for one encoded matrix row. -/ def machineOptimizerFeasibilityStateTwiceVectorPlusTwoBits (word : List Bool) : List Bool := machineBinaryAddOf @@ -70,17 +78,20 @@ def machineOptimizerFeasibilityStateTwiceVectorPlusTwoBits machineOptimizerFeasibilityStateVectorBits) (machineBinaryConst 2) word +/-- Multiplies the encoded-row bound by the ellipsoid dimension to bound a matrix. -/ def machineOptimizerFeasibilityStateMatrixBits (word : List Bool) : List Bool := machineBinaryMulOf machineOptimizerFeasibilityDBits machineOptimizerFeasibilityStateTwiceVectorPlusTwoBits word +/-- Computes the outer dimension-encoding contribution `2 * (D + 1)`. -/ def machineOptimizerFeasibilityStateDimensionTermBits (word : List Bool) : List Bool := machineBinaryMulOf (machineBinaryConst 2) (machineBinaryAddOf machineOptimizerFeasibilityDBits (machineBinaryConst 1)) word +/-- Adds twice the vector bound and twice the matrix bound for the state inner payload. -/ def machineOptimizerFeasibilityStateInnerFirstBits (word : List Bool) : List Bool := machineBinaryAddOf @@ -89,26 +100,32 @@ def machineOptimizerFeasibilityStateInnerFirstBits (machineBinaryMulOf (machineBinaryConst 2) machineOptimizerFeasibilityStateMatrixBits) word +/-- Adds two to the combined vector-and-matrix payload bound. -/ def machineOptimizerFeasibilityStateInnerBits (word : List Bool) : List Bool := machineBinaryAddOf machineOptimizerFeasibilityStateInnerFirstBits (machineBinaryConst 2) word +/-- Doubles the inner payload bound for the outer state encoding. -/ def machineOptimizerFeasibilityStateTwiceInnerBits (word : List Bool) : List Bool := machineBinaryMulOf (machineBinaryConst 2) machineOptimizerFeasibilityStateInnerBits word +/-- Adds the dimension contribution to the doubled inner payload bound. -/ def machineOptimizerFeasibilityStateBoundFirstBits (word : List Bool) : List Bool := machineBinaryAddOf machineOptimizerFeasibilityStateDimensionTermBits machineOptimizerFeasibilityStateTwiceInnerBits word +/-- Adds the final two-bit overhead to the complete feasibility-state bound. -/ def machineOptimizerFeasibilityStateBoundBits (word : List Bool) : List Bool := machineBinaryAddOf machineOptimizerFeasibilityStateBoundFirstBits (machineBinaryConst 2) word +/-- Concatenates dimension, initial-magnitude-length, iteration-budget, and rounding-precision +rulers to seed the state guard. -/ def machineOptimizerFeasibilityStateGuardSource (word : List Bool) : List Bool := machineOptimizerFeasibilityEllipsoidDimensionUnary word ++ @@ -116,11 +133,13 @@ def machineOptimizerFeasibilityStateGuardSource (machineOptimizerFeasibilityBudgetUnary word ++ machineOptimizerFeasibilityRoundingPrecisionUnary word)) +/-- Applies the binary-width construction three times to the feasibility-state guard source. -/ def machineOptimizerFeasibilityStateGuard (word : List Bool) : List Bool := machineIteratedBinaryWidth 3 (machineOptimizerFeasibilityStateGuardSource word) +/-- Converts the computed state bound from binary to a unary ruler under its guard. -/ def machineOptimizerFeasibilityStateBoundUnary (word : List Bool) : List Bool := machineBoundedUnary diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerTests.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerTests.lean index ab54a0b5c2..b351cb7e7e 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerTests.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineOptimizerTests.lean @@ -24,9 +24,11 @@ namespace BeyondBethe open Complexity +/-- Constructs a one-coordinate rational test point with value one-quarter of the finite index. -/ def optimizerTestAffinePoint {N : ℕ} (a : Fin N) : Fin 1 → ℚ := fun _ ↦ a.val / 4 +/-- Constructs a raw rational test floor equal to one-quarter of the finite index. -/ def optimizerTestFloor {N : ℕ} (d : Fin N) : RawRat := rawRatOfRat (d.val / 4 : ℚ) @@ -87,6 +89,7 @@ theorem machineExecutablePotentialEntries_two_by_two_half : machineExecutableColumnPotentialEntryCode_encode (1 / 8) (fun _ _ ↦ 1) (fun _ ↦ 1 / 2) 1 dummy i⟩ +/-- Chooses rational test entry three-quarters for true and one-quarter for false. -/ def optimizerTestEntry (bit : Bool) : ℚ := if bit then 3 / 4 else 1 / 4 diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineOutputEncoding.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineOutputEncoding.lean index 7ede101dc7..e50fc411b1 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineOutputEncoding.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineOutputEncoding.lean @@ -24,22 +24,27 @@ namespace BeyondBethe open Complexity +/-- Squares the left binary natural-number component of a pair. -/ def machineNatPairLeftSquare (word : List Bool) : List Bool := machineBinaryMulBits (pair (machinePairFirst word) (machinePairFirst word)) +/-- Squares the right binary natural-number component of a pair. -/ def machineNatPairRightSquare (word : List Bool) : List Bool := machineBinaryMulBits (pair (machinePairSecond word) (machinePairSecond word)) +/-- Computes the natural-pairing branch `right^2 + left` in binary. -/ def machineNatPairLeftBranch (word : List Bool) : List Bool := machineBinaryAddBits (pair (machineNatPairRightSquare word) (machinePairFirst word)) +/-- Computes the intermediate natural-pairing term `left^2 + left` in binary. -/ def machineNatPairRightBranchFirst (word : List Bool) : List Bool := machineBinaryAddBits (pair (machineNatPairLeftSquare word) (machinePairFirst word)) +/-- Computes the natural-pairing branch `left^2 + left + right` in binary. -/ def machineNatPairRightBranch (word : List Bool) : List Bool := machineBinaryAddBits (pair (machineNatPairRightBranchFirst word) (machinePairSecond word)) @@ -115,13 +120,16 @@ theorem machineNatPairBits_pair_natBits (a b : ℕ) : machineBinaryAddBits_pair_natBits] simp [Nat.pair, h, Nat.add_assoc] +/-- Drops the sign bit to expose the integer code's magnitude payload. -/ def machineIntegerMagnitudeWord (word : List Bool) : List Bool := word.tail +/-- Doubles the integer payload in binary to obtain its even natural-number code. -/ def machineIntegerEvenCodeBits (word : List Bool) : List Bool := machineBinaryAddBits (pair (machineIntegerMagnitudeWord word) (machineIntegerMagnitudeWord word)) +/-- Adds one to the doubled integer payload to obtain its odd natural-number code. -/ def machineIntegerOddCodeBits (word : List Bool) : List Bool := machineBinaryAddBits (pair (machineIntegerEvenCodeBits word) [true]) diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachinePerfectMatching.lean b/LeanPool/BeyondBethe/BeyondBethe/MachinePerfectMatching.lean index f4a5fed10b..c7acc0f722 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachinePerfectMatching.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachinePerfectMatching.lean @@ -26,12 +26,15 @@ open Complexity /-! ## The finite-word program -/ +/-- Extracts the final matching payload from the completed Kuhn run. -/ def machineKuhnFinalMate (matrix : List Bool) : List Bool := machineKuhnDoneMate (machineKuhnControl (machineKuhnFinalState matrix)) +/-- Pairs the matrix dimension ruler with the final Kuhn matching for the completeness test. -/ def machineKuhnPerfectMatchingInput (matrix : List Bool) : List Bool := pair (machineKuhnInitDimension matrix) (machineKuhnFinalMate matrix) +/-- Tests whether every column of the final Kuhn matching has a present mate. -/ def machineKuhnPerfectMatchingBit (matrix : List Bool) : List Bool := machineMateAllSomeBit (machineKuhnPerfectMatchingInput matrix) @@ -55,6 +58,7 @@ theorem machineKuhnPerfectMatchingBit_mem_FP : /-! ## The column-totality criterion -/ +/-- Requires every column to have some matched row. -/ def AllColumnsMatched {n : ℕ} (mate : ColumnMate n) : Prop := ∀ col, ∃ row, mate col = some row diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachinePositiveAlgorithm.lean b/LeanPool/BeyondBethe/BeyondBethe/MachinePositiveAlgorithm.lean index 5ce0c24be7..d6574683d7 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachinePositiveAlgorithm.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachinePositiveAlgorithm.lean @@ -23,6 +23,8 @@ namespace BeyondBethe open Complexity +/-- Returns zero in dimensions zero and one; otherwise evaluates the directed certificate at the +explicit optimizer matrix and its row and column potentials. -/ def explicitNormalizedCertificateAlgorithm : ∀ n, Matrix (Fin n) (Fin n) ℚ → ℚ | 0, _ => 0 @@ -43,19 +45,24 @@ def NormalizedCertificateStringRealizesOnPositive rawRatBinaryCode (rawRatOfRat (explicitNormalizedCertificateAlgorithm (m + 2) B)) +/-- Returns raw one for a zero-dimensional positive-matrix input and its first entry otherwise. -/ def machinePositiveSmallRawCode (word : List Bool) : List Bool := machineIfHead (machineMatrixDimensionZeroBit word) (rawRatBinaryCode RawRat.one) (machineMatrixFirstEntryCode word) +/-- Normalizes the positive input matrix's entries for the certificate machine. -/ def machinePositiveNormalizedMatrixCode (word : List Bool) : List Bool := machineMatrixNormalizeEntries word +/-- Runs the supplied certificate machine on the normalized positive matrix. -/ def machinePositiveCertificateRawCode (certificateMachine : List Bool → List Bool) (word : List Bool) : List Bool := certificateMachine (machinePositiveNormalizedMatrixCode word) +/-- Multiplies the normalized-matrix certificate by the matrix-normalization scale raised to the +dimension. -/ def machinePositiveLargeProductRawCode (certificateMachine : List Bool → List Bool) (word : List Bool) : List Bool := @@ -63,12 +70,15 @@ def machinePositiveLargeProductRawCode (pair (machineMatrixNormalizationScalePowerRawCode word) (machinePositiveCertificateRawCode certificateMachine word)) +/-- Normalizes the scaled certificate product into a rational entry code. -/ def machinePositiveLargeRawCode (certificateMachine : List Bool → List Bool) (word : List Bool) : List Bool := machineNormalizeRawRatEntryCode (machinePositiveLargeProductRawCode certificateMachine word) +/-- Uses the direct small-dimension branch below dimension two and the scaled +normalized-certificate branch otherwise. -/ def machinePositiveAlgorithmRawCode (certificateMachine : List Bool → List Bool) (word : List Bool) : List Bool := diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRAMSmoke.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRAMSmoke.lean index bf9c64a357..ba1f58c941 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineRAMSmoke.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRAMSmoke.lean @@ -25,6 +25,7 @@ namespace BeyondBethe open Complexity +/-- The constant string function returning the empty word. -/ def emptyMachineTarget (_ : List Bool) : List Bool := [] theorem outputBitLanguage_emptyMachineTarget : diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalArithmetic.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalArithmetic.lean index 7f34b982a0..9eb338662b 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalArithmetic.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalArithmetic.lean @@ -23,15 +23,19 @@ namespace BeyondBethe open Complexity +/-- Extracts the signed numerator of the left raw rational in a pair. -/ def machineRawLeftNumeratorCode (word : List Bool) : List Bool := machinePairFirst (machinePairFirst word) +/-- Extracts the denominator bits of the left raw rational in a pair. -/ def machineRawLeftDenominatorBits (word : List Bool) : List Bool := machinePairSecond (machinePairFirst word) +/-- Extracts the signed numerator of the right raw rational in a pair. -/ def machineRawRightNumeratorCode (word : List Bool) : List Bool := machinePairFirst (machinePairSecond word) +/-- Extracts the denominator bits of the right raw rational in a pair. -/ def machineRawRightDenominatorBits (word : List Bool) : List Bool := machinePairSecond (machinePairSecond word) @@ -39,26 +43,31 @@ def machineRawRightDenominatorBits (word : List Bool) : List Bool := def machineNaturalIntegerCode (word : List Bool) : List Bool := false :: word +/-- Multiplies the left signed numerator by the right denominator for raw rational addition. -/ def machineRawAddLeftScaledNumerator (word : List Bool) : List Bool := machineIntegerMulCode (pair (machineRawLeftNumeratorCode word) (machineNaturalIntegerCode (machineRawRightDenominatorBits word))) +/-- Multiplies the right signed numerator by the left denominator for raw rational addition. -/ def machineRawAddRightScaledNumerator (word : List Bool) : List Bool := machineIntegerMulCode (pair (machineRawRightNumeratorCode word) (machineNaturalIntegerCode (machineRawLeftDenominatorBits word))) +/-- Adds the two cross-multiplied signed numerators for raw rational addition. -/ def machineRawAddNumeratorCode (word : List Bool) : List Bool := machineIntegerAddCode (pair (machineRawAddLeftScaledNumerator word) (machineRawAddRightScaledNumerator word)) +/-- Multiplies the two signed numerators for raw rational multiplication. -/ def machineRawProductNumeratorCode (word : List Bool) : List Bool := machineIntegerMulCode (pair (machineRawLeftNumeratorCode word) (machineRawRightNumeratorCode word)) +/-- Multiplies the two binary denominators for raw rational arithmetic. -/ def machineRawProductDenominatorBits (word : List Bool) : List Bool := machineBinaryMulBits (pair (machineRawLeftDenominatorBits word) diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalBallInit.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalBallInit.lean index 89b9d10ef9..8d38e25e9a 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalBallInit.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalBallInit.lean @@ -28,6 +28,7 @@ dimension ruler. The following section will replace the diagonal entries by the encoded radius and package the result as a complete ellipsoid state. -/ +/-- The canonical rational-entry binary code for zero. -/ def machineRationalZeroEntry : List Bool := rationalEntryBinaryCode 0 @@ -158,9 +159,11 @@ theorem rationalMatrixRows_diagonalPrefix_set /-! ## Diagonal-basis machine -/ +/-- Extracts the unary dimension ruler from a diagonal-basis request. -/ def machineDiagonalBasisRuler (word : List Bool) : List Bool := machinePairFirst word +/-- Extracts the encoded radius entry from a diagonal-basis request. -/ def machineDiagonalBasisRadiusEntry (word : List Bool) : List Bool := machinePairSecond word @@ -168,30 +171,38 @@ def machineDiagonalBasisRadiusEntry (word : List Bool) : List Bool := def machineDiagonalBasisBound (word : List Bool) : List Bool := machineBinaryMulWidth (machineBinaryMulWidth word) +/-- Packs the diagonal-basis scan index, accumulated matrix, fixed radius entry, and bound word. -/ def machineDiagonalBasisPack (index matrix radius bound : List Bool) : List Bool := pair index (pair matrix (pair radius bound)) +/-- Extracts the unary diagonal index from a diagonal-basis construction state. -/ def machineDiagonalBasisIndex (state : List Bool) : List Bool := machinePairFirst state +/-- Extracts the accumulated encoded matrix from a diagonal-basis state. -/ def machineDiagonalBasisMatrix (state : List Bool) : List Bool := machinePairFirst (machinePairSecond state) +/-- Extracts the fixed radius entry from a diagonal-basis state. -/ def machineDiagonalBasisRadius (state : List Bool) : List Bool := machinePairFirst (machinePairSecond (machinePairSecond state)) +/-- Extracts the stored field-length bound from a diagonal-basis state. -/ def machineDiagonalBasisStateBound (state : List Bool) : List Bool := machinePairSecond (machinePairSecond (machinePairSecond state)) +/-- Increments the unary diagonal index by prepending one true bit. -/ def machineDiagonalBasisNextIndexCandidate (state : List Bool) : List Bool := true :: machineDiagonalBasisIndex state +/-- Truncates the incremented diagonal index to the stored bound length. -/ def machineDiagonalBasisNextIndex (state : List Bool) : List Bool := (machineDiagonalBasisNextIndexCandidate state).take (machineDiagonalBasisStateBound state).length +/-- Updates the matrix entry at the current diagonal index to the fixed radius value. -/ def machineDiagonalBasisMatrixCandidate (state : List Bool) : List Bool := machineNestedMatrixUpdateAtUnary (pair (machineDiagonalBasisIndex state) @@ -199,34 +210,44 @@ def machineDiagonalBasisMatrixCandidate (state : List Bool) : List Bool := (pair (machineDiagonalBasisRadius state) (machineDiagonalBasisMatrix state)))) +/-- Truncates the updated matrix code to the stored bound length. -/ def machineDiagonalBasisNextMatrix (state : List Bool) : List Bool := (machineDiagonalBasisMatrixCandidate state).take (machineDiagonalBasisStateBound state).length +/-- Advances the diagonal index and updates the corresponding matrix entry while preserving +radius and bound. -/ def machineDiagonalBasisStep (state : List Bool) : List Bool := machineDiagonalBasisPack (machineDiagonalBasisNextIndex state) (machineDiagonalBasisNextMatrix state) (machineDiagonalBasisRadius state) (machineDiagonalBasisStateBound state) +/-- Constructs an encoded zero matrix of the requested dimension and truncates it to the +diagonal-basis bound. -/ def machineDiagonalBasisInitialMatrix (word : List Bool) : List Bool := (machineRationalZeroMatrixRowsCode (machineDiagonalBasisRuler word)).take (machineDiagonalBasisBound word).length +/-- Initializes diagonal-basis construction at index zero with the bounded zero matrix and +requested radius. -/ def machineDiagonalBasisInit (word : List Bool) : List Bool := machineDiagonalBasisPack [] (machineDiagonalBasisInitialMatrix word) (machineDiagonalBasisRadiusEntry word) (machineDiagonalBasisBound word) +/-- Packs four copies of the diagonal-basis bound to bound the full state encoding. -/ def machineDiagonalBasisWidth (word : List Bool) : List Bool := machineDiagonalBasisPack (machineDiagonalBasisBound word) (machineDiagonalBasisBound word) (machineDiagonalBasisBound word) (machineDiagonalBasisBound word) +/-- Iterates the diagonal-basis update once per element of the unary dimension ruler. -/ def machineDiagonalBasisFinalState (word : List Bool) : List Bool := (machineDiagonalBasisStep)^[(machineDiagonalBasisRuler word).length] (machineDiagonalBasisInit word) +/-- Extracts the encoded matrix rows after all diagonal updates. -/ def machineDiagonalBasisRowsCode (word : List Bool) : List Bool := machineDiagonalBasisMatrix (machineDiagonalBasisFinalState word) @@ -334,6 +355,8 @@ theorem machineDiagonalBasisWidth_mem_FP : machineDiagonalBasisWidth ∈ FP := machineDiagonalBasisStateBound (machineDiagonalBasisPack a b c e) = e := by simp [machineDiagonalBasisStateBound, machineDiagonalBasisPack] +/-- Requires exact diagonal-state packing and bounds each of its four field lengths by the +input-derived bound. -/ def MachineDiagonalBasisStateBound (word state : List Bool) : Prop := let B := (machineDiagonalBasisBound word).length state = machineDiagonalBasisPack @@ -411,9 +434,11 @@ theorem machineDiagonalBasisRowsCode_mem_FP : /-! ### Exact canonical semantics -/ +/-- Encodes dimension `d` as a unary ruler followed by rational radius `R`. -/ def machineDiagonalBasisCanonicalInput (d : ℕ) (R : ℚ) : List Bool := pair (List.replicate d true) (rationalEntryBinaryCode R) +/-- Encodes the semantic construction state after `k` diagonal entries have been set to `R`. -/ def machineDiagonalBasisCanonicalState (d : ℕ) (R : ℚ) (k : ℕ) : List Bool := let word := machineDiagonalBasisCanonicalInput d R diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalCompare.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalCompare.lean index dc39130bb7..b8bbfa03f6 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalCompare.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalCompare.lean @@ -23,6 +23,7 @@ namespace BeyondBethe open Complexity +/-- Compares raw rationals by comparing their signed cross-multiplied numerators. -/ def machineRawRatLeBit (word : List Bool) : List Bool := machineIntegerLeCode (pair (machineRawAddLeftScaledNumerator word) diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalDirectionUpdateMatrix.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalDirectionUpdateMatrix.lean index 624eb1e605..f3f6603473 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalDirectionUpdateMatrix.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalDirectionUpdateMatrix.lean @@ -22,19 +22,26 @@ namespace BeyondBethe open Complexity +/-- Constructs the rational direction-update matrix using the dimension-dependent perpendicular +and parallel ellipsoid scales. -/ def rationalDirectionUpdateMatrix {d : ℕ} (b : Fin d → ℚ) : Matrix (Fin d) (Fin d) ℚ := directionUpdateMatrix (rationalEllipsoidPerpScale d) (rationalEllipsoidParallelScale d) b +/-- Encodes the direction dimension in both unary and binary followed by the rational direction +vector. -/ def rationalDirectionUpdateCanonicalWord {d : ℕ} (b : Fin d → ℚ) : List Bool := pair (List.replicate d true) (pair d.bits (rationalFiniteVectorCode b)) +/-- Returns the raw perpendicular scale on the diagonal and raw zero off the diagonal. -/ def rawDirectionDiagonalEntry {d : ℕ} (i j : Fin d) : RawRat := if i = j then rawEllipsoidPerpScale d else RawRat.zero +/-- Subtracts the raw rank-one correction from the scaled diagonal entry to form a +direction-update matrix coefficient. -/ def rawDirectionMatrixEntry {d : ℕ} (b : Fin d → ℚ) (i j : Fin d) : RawRat := (rawDirectionDiagonalEntry i j).sub @@ -298,6 +305,7 @@ theorem rationalDirectionMatrix_entry_code_length_le {d : ℕ} have hwidth := rawDirectionMatrixEntry_width_le_word b i j exact hcanonical.trans (by nlinarith) +/-- Reuses the rational transpose-vector input bound for direction-update matrix generation. -/ def machineRationalDirectionUpdateMatrixInputBound (word : List Bool) : List Bool := machineRationalTransposeMulVectorInputBound word @@ -410,26 +418,31 @@ theorem rationalDirectionUpdateMatrix_code_length_le_bound {d : ℕ} /-! ## Bounded outer row scan -/ +/-- Builds the complete encoded row-index range from the unary direction dimension. -/ def machineRationalDirectionUpdateMatrixIndices (word : List Bool) : List Bool := machineUnaryRangeCode (machinePairFirst word) +/-- Computes the direction-update row at the current row index using the fixed request payload. -/ def machineRationalDirectionUpdateMatrixCurrentRow (state : List Bool) : List Bool := machineRationalDirectionUpdateRowCode (pair (machineRationalTransposeMulVectorCurrentIndex state) (machineRationalTransposeMulVectorStatePayload state)) +/-- Prepends the newly computed direction-update row to the reverse-order matrix accumulator. -/ def machineRationalDirectionUpdateMatrixCandidate (state : List Bool) : List Bool := pair (machineRationalDirectionUpdateMatrixCurrentRow state) (machineRationalTransposeMulVectorAccumulator state) +/-- Truncates the candidate matrix accumulator to the stored bound length. -/ def machineRationalDirectionUpdateMatrixNextAccumulator (state : List Bool) : List Bool := (machineRationalDirectionUpdateMatrixCandidate state).take (machineRationalTransposeMulVectorBound state).length +/-- Drops the completed row index and stores the bounded updated matrix accumulator. -/ def machineRationalDirectionUpdateMatrixAdvance (state : List Bool) : List Bool := machineRationalTransposeMulVectorPack @@ -438,27 +451,34 @@ def machineRationalDirectionUpdateMatrixAdvance (machineRationalTransposeMulVectorStatePayload state) (machineRationalTransposeMulVectorBound state) +/-- Fixes direction-matrix generation when no indices remain and otherwise computes its next +row. -/ def machineRationalDirectionUpdateMatrixStep (state : List Bool) : List Bool := machineIfEmpty (machineRationalTransposeMulVectorRemaining state) state (machineRationalDirectionUpdateMatrixAdvance state) +/-- Initializes direction-matrix generation with all row indices, empty accumulator, fixed +request, and computed bound. -/ def machineRationalDirectionUpdateMatrixInit (word : List Bool) : List Bool := machineRationalTransposeMulVectorPack (machineRationalDirectionUpdateMatrixIndices word) [] word (machineRationalDirectionUpdateMatrixInputBound word) +/-- Packs four copies of the computed bound to bound the direction-matrix generation state. -/ def machineRationalDirectionUpdateMatrixWidth (word : List Bool) : List Bool := let bound := machineRationalDirectionUpdateMatrixInputBound word machineRationalTransposeMulVectorPack bound bound bound bound +/-- Runs direction-matrix generation once per input bit from its initial state. -/ def machineRationalDirectionUpdateMatrixFinalState (word : List Bool) : List Bool := (machineRationalDirectionUpdateMatrixStep)^[word.length] (machineRationalDirectionUpdateMatrixInit word) +/-- Extracts the generated rows in reverse order from the final matrix-generation state. -/ def machineRationalDirectionUpdateMatrixReversedCode (word : List Bool) : List Bool := machineRationalTransposeMulVectorAccumulator @@ -622,11 +642,14 @@ theorem machineRationalDirectionUpdateMatrixCode_mem_FP : /-! ## Exact scan semantics -/ +/-- Lists the first `k` rows of the rational direction-update matrix in finite-index order. -/ def rationalDirectionUpdateRowsPrefix {d : ℕ} (b : Fin d → ℚ) (k : ℕ) : List (List ℚ) := ((List.finRange d).take k).map fun i ↦ List.ofFn fun j ↦ rationalDirectionUpdateMatrix b i j +/-- Encodes the remaining row indices and reversed generated row prefix after `k` rows, +preserving request and bound. -/ def machineRationalDirectionUpdateMatrixSemanticState {d : ℕ} (b : Fin d → ℚ) (k : ℕ) : List Bool := let word := rationalDirectionUpdateCanonicalWord b diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalDirectionUpdateRow.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalDirectionUpdateRow.lean index c96c1d2f91..d796054908 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalDirectionUpdateRow.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalDirectionUpdateRow.lean @@ -27,51 +27,66 @@ namespace BeyondBethe open Complexity +/-- Constructs row `i` of the scalar diagonal matrix with value `A` on its diagonal. -/ def rationalDirectionDiagonalRow {d : ℕ} (A : ℚ) (i : Fin d) : Fin d → ℚ := fun j ↦ if i = j then A else 0 +/-- Computes the raw squared Euclidean norm of the rational direction by taking its dot product +with itself. -/ def rawDirectionNormSq {d : ℕ} (b : Fin d → ℚ) : RawRat := rawRatListDot RawRat.zero (List.ofFn b) (List.ofFn b) +/-- Subtracts the parallel ellipsoid scale from the perpendicular scale in raw rational +arithmetic. -/ def rawDirectionGap (d : ℕ) : RawRat := (rawEllipsoidPerpScale d).sub (rawEllipsoidParallelScale d) +/-- Divides the raw perpendicular-parallel scale gap by the squared direction norm. -/ def rawDirectionCoefficient {d : ℕ} (b : Fin d → ℚ) : RawRat := (rawDirectionGap d).div (rawDirectionNormSq b) +/-- Multiplies the direction-update coefficient by direction coordinate `i`. -/ def rawDirectionRowScale {d : ℕ} (b : Fin d → ℚ) (i : Fin d) : RawRat := (rawDirectionCoefficient b).mul (rawRatOfRat (b i)) +/-- Extracts the unary row index from a direction-update row request. -/ def machineDirectionRowIndex (word : List Bool) : List Bool := machinePairFirst word +/-- Extracts the dimension-and-vector payload after the requested row index. -/ def machineDirectionRowPayload (word : List Bool) : List Bool := machinePairSecond word +/-- Extracts the unary direction dimension from a row request. -/ def machineDirectionRowDimensionUnary (word : List Bool) : List Bool := machinePairFirst (machineDirectionRowPayload word) +/-- Extracts the binary-dimension and vector payload from a direction-update row request. -/ def machineDirectionRowDimensionAndVector (word : List Bool) : List Bool := machinePairSecond (machineDirectionRowPayload word) +/-- Extracts the binary direction dimension from a row request. -/ def machineDirectionRowDimensionBits (word : List Bool) : List Bool := machinePairFirst (machineDirectionRowDimensionAndVector word) +/-- Extracts the encoded direction vector from a row request. -/ def machineDirectionRowVectorCode (word : List Bool) : List Bool := machinePairSecond (machineDirectionRowDimensionAndVector word) +/-- Computes the raw dot product of the direction vector with itself. -/ def machineDirectionRowNormSqRawCode (word : List Bool) : List Bool := machineRationalVectorDotRawCode (pair (machineDirectionRowVectorCode word) (machineDirectionRowVectorCode word)) +/-- Computes the raw perpendicular scale minus the parallel scale for the requested dimension. -/ def machineDirectionRowGapRawCode (word : List Bool) : List Bool := machineRawRatAddCode @@ -82,35 +97,42 @@ def machineDirectionRowGapRawCode (machineEllipsoidParallelScaleRawCode (machineDirectionRowDimensionBits word)))) +/-- Divides the raw scale gap by the squared direction norm to compute the update coefficient. -/ def machineDirectionRowCoefficientRawCode (word : List Bool) : List Bool := machineRawRatDivCode (pair (machineDirectionRowGapRawCode word) (machineDirectionRowNormSqRawCode word)) +/-- Looks up the direction coordinate at the requested unary row index. -/ def machineDirectionRowBEntry (word : List Bool) : List Bool := machineListIndex (pair (machineDirectionRowIndex word) (machineDirectionRowVectorCode word)) +/-- Multiplies the update coefficient by the selected direction coordinate. -/ def machineDirectionRowScaleRawCode (word : List Bool) : List Bool := machineRawRatMulCode (pair (machineDirectionRowCoefficientRawCode word) (machineDirectionRowBEntry word)) +/-- Scales the full direction vector by the row-dependent update coefficient. -/ def machineDirectionRowScaledVectorCode (word : List Bool) : List Bool := machineRationalVectorScaleCode (pair (machineDirectionRowScaleRawCode word) (machineDirectionRowVectorCode word)) +/-- Constructs the zero vector of the requested unary dimension. -/ def machineDirectionRowZeroVectorCode (word : List Bool) : List Bool := machineRationalZeroVectorCode (machineDirectionRowDimensionUnary word) +/-- Updates the selected entry of the zero vector to the perpendicular scale, producing a scaled +diagonal row. -/ def machineDirectionRowDiagonalCode (word : List Bool) : List Bool := machineListUpdate @@ -120,6 +142,8 @@ def machineDirectionRowDiagonalCode (machineDirectionRowDimensionBits word)) (machineDirectionRowZeroVectorCode word))) +/-- Subtracts the scaled direction vector from the diagonal row to obtain one direction-update +matrix row. -/ def machineRationalDirectionUpdateRowCode (word : List Bool) : List Bool := machineRationalVectorSubCode diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalEllipsoidCenterUpdate.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalEllipsoidCenterUpdate.lean index 0c2b3dd260..644d91a32c 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalEllipsoidCenterUpdate.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalEllipsoidCenterUpdate.lean @@ -24,12 +24,15 @@ namespace BeyondBethe open Complexity +/-- Extracts the current ellipsoid-state word from a center-update request. -/ def machineRationalCenterUpdateStateWord (word : List Bool) : List Bool := machinePairFirst word +/-- Extracts the cut-vector word from a center-update request. -/ def machineRationalCenterUpdateCutWord (word : List Bool) : List Bool := machinePairSecond word +/-- Reads the binary ellipsoid dimension from the center-update state. -/ def machineRationalCenterUpdateDimensionBits (word : List Bool) : List Bool := machineRationalEllipsoidDimensionWord @@ -42,16 +45,20 @@ def machineRationalCenterUpdateDimensionUnary (pair (machineRationalCenterUpdateStateWord word) (machineRationalCenterUpdateDimensionBits word)) +/-- Reads the encoded current center from the center-update state. -/ def machineRationalCenterUpdateCenterWord (word : List Bool) : List Bool := machineRationalEllipsoidCenterWord (machineRationalCenterUpdateStateWord word) +/-- Reads the encoded current basis matrix from the center-update state. -/ def machineRationalCenterUpdateBasisWord (word : List Bool) : List Bool := machineRationalEllipsoidBasisWord (machineRationalCenterUpdateStateWord word) +/-- Multiplies the cut vector by the transpose of the current basis to pull it into ellipsoid +coordinates. -/ def machineRationalCenterUpdatePulledBackCode (word : List Bool) : List Bool := machineRationalTransposeMulVectorCode @@ -59,11 +66,14 @@ def machineRationalCenterUpdatePulledBackCode (pair (machineRationalCenterUpdateBasisWord word) (machineRationalCenterUpdateCutWord word))) +/-- Computes the rational normalized direction associated with the pulled-back cut vector. -/ def machineRationalCenterUpdateNormalizedCode (word : List Bool) : List Bool := machineRationalNormalizedDirectionCode (machineRationalCenterUpdatePulledBackCode word) +/-- Maps the normalized pulled-back direction through the current basis to obtain a displacement +vector. -/ def machineRationalCenterUpdateDisplacementCode (word : List Bool) : List Bool := machineRationalMatrixMulVectorCode @@ -71,6 +81,8 @@ def machineRationalCenterUpdateDisplacementCode (pair (machineRationalCenterUpdateBasisWord word) (machineRationalCenterUpdateNormalizedCode word))) +/-- Scales the displacement vector by the dimension-dependent rational ellipsoid center-shift +factor. -/ def machineRationalCenterUpdateScaledDisplacementCode (word : List Bool) : List Bool := machineRationalVectorScaleCode @@ -79,6 +91,8 @@ def machineRationalCenterUpdateScaledDisplacementCode (machineRationalCenterUpdateDimensionBits word)) (machineRationalCenterUpdateDisplacementCode word)) +/-- Encodes the updated ellipsoid center by subtracting the scaled displacement from its current +center. -/ def machineRationalEllipsoidCenterUpdateCode (word : List Bool) : List Bool := machineRationalVectorSubCode diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalEllipsoidEncoding.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalEllipsoidEncoding.lean index bd38da2407..aa335cfd22 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalEllipsoidEncoding.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalEllipsoidEncoding.lean @@ -82,6 +82,7 @@ theorem rationalEllipsoidStateBinaryCode_injective_fixed {d : ℕ} : injectivity of the self-contained word representation. -/ abbrev RationalEllipsoidInput := Σ d : ℕ, RationalEllipsoidState d +/-- Encodes a dimension-indexed rational ellipsoid input using its state encoding. -/ def rationalEllipsoidInputBinaryCode : RationalEllipsoidInput → List Bool | ⟨_d, E⟩ => rationalEllipsoidStateBinaryCode E @@ -168,15 +169,19 @@ theorem rationalFeasibilityResultBinaryCode_injective {d : ℕ} : /-! ## Polynomial-time field accessors -/ +/-- Extracts the encoded ellipsoid dimension. -/ def machineRationalEllipsoidDimensionWord (word : List Bool) : List Bool := machinePairFirst word +/-- Extracts the paired center and basis payload of an encoded ellipsoid. -/ def machineRationalEllipsoidPayloadWord (word : List Bool) : List Bool := machinePairSecond word +/-- Extracts the encoded center vector from the ellipsoid payload. -/ def machineRationalEllipsoidCenterWord (word : List Bool) : List Bool := machinePairFirst (machineRationalEllipsoidPayloadWord word) +/-- Extracts the encoded basis matrix from the ellipsoid payload. -/ def machineRationalEllipsoidBasisWord (word : List Bool) : List Bool := machinePairSecond (machineRationalEllipsoidPayloadWord word) @@ -225,9 +230,11 @@ theorem machineRationalEllipsoidBasisWord_mem_FP : machineRationalEllipsoidPayloadWord, rationalEllipsoidStateBinaryCode] +/-- Extracts the tag from a tagged rational result. -/ def machineRationalTaggedResultTag (word : List Bool) : List Bool := machinePairFirst word +/-- Extracts the payload from a tagged rational result. -/ def machineRationalTaggedResultPayload (word : List Bool) : List Bool := machinePairSecond word diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalEllipsoidScalars.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalEllipsoidScalars.lean index 2e281ba77d..e335b415f2 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalEllipsoidScalars.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalEllipsoidScalars.lean @@ -24,82 +24,103 @@ namespace BeyondBethe open Complexity +/-- The raw-rational constant one used in ellipsoid updates. -/ def rawEllipsoidOne : RawRat := RawRat.ofNat 1 +/-- The raw-rational constant two used in ellipsoid updates. -/ def rawEllipsoidTwo : RawRat := RawRat.ofNat 2 +/-- The raw-rational constant four used in ellipsoid updates. -/ def rawEllipsoidFour : RawRat := RawRat.ofNat 4 +/-- Embeds the ellipsoid dimension as a raw rational. -/ def rawEllipsoidDimension (d : ℕ) : RawRat := RawRat.ofNat d +/-- The square of the ellipsoid dimension as a raw rational. -/ def rawEllipsoidDimensionSquare (d : ℕ) : RawRat := (rawEllipsoidDimension d).mul (rawEllipsoidDimension d) +/-- Four times the squared ellipsoid dimension as a raw rational. -/ def rawEllipsoidFourDimensionSquare (d : ℕ) : RawRat := rawEllipsoidFour.mul (rawEllipsoidDimensionSquare d) +/-- The raw-rational update parameter `alpha = 1/(4*d^2)`. -/ def rawEllipsoidAlpha (d : ℕ) : RawRat := rawEllipsoidOne.div (rawEllipsoidFourDimensionSquare d) +/-- The square of the ellipsoid update parameter `alpha`. -/ def rawEllipsoidAlphaSquare (d : ℕ) : RawRat := (rawEllipsoidAlpha d).mul (rawEllipsoidAlpha d) +/-- Twice the square of the ellipsoid update parameter `alpha`. -/ def rawEllipsoidTwiceAlphaSquare (d : ℕ) : RawRat := rawEllipsoidTwo.mul (rawEllipsoidAlphaSquare d) +/-- The perpendicular update scale `1 + 2*alpha^2`. -/ def rawEllipsoidPerpScale (d : ℕ) : RawRat := rawEllipsoidOne.add (rawEllipsoidTwiceAlphaSquare d) +/-- The update parameter `alpha` divided by the ellipsoid dimension. -/ def rawEllipsoidAlphaOverDimension (d : ℕ) : RawRat := (rawEllipsoidAlpha d).div (rawEllipsoidDimension d) +/-- The parallel update scale `1 - alpha/d`. -/ def rawEllipsoidParallelScale (d : ℕ) : RawRat := rawEllipsoidOne.sub (rawEllipsoidAlphaOverDimension d) /-! ## Finite-word formulas -/ +/-- Encodes binary dimension bits as a nonnegative raw rational with denominator one. -/ def machineEllipsoidDimensionRawCode (word : List Bool) : List Bool := pair (machineNaturalIntegerCode word) [true] +/-- Squares the encoded raw-rational ellipsoid dimension. -/ def machineEllipsoidDimensionSquareRawCode (word : List Bool) : List Bool := machineRawRatMulCode (pair (machineEllipsoidDimensionRawCode word) (machineEllipsoidDimensionRawCode word)) +/-- Computes four times the encoded squared dimension. -/ def machineEllipsoidFourDimensionSquareRawCode (word : List Bool) : List Bool := machineRawRatMulCode (pair (rawRatBinaryCode rawEllipsoidFour) (machineEllipsoidDimensionSquareRawCode word)) +/-- Computes the encoded update parameter `1/(4*d^2)`. -/ def machineEllipsoidAlphaRawCode (word : List Bool) : List Bool := machineRawRatDivCode (pair (rawRatBinaryCode rawEllipsoidOne) (machineEllipsoidFourDimensionSquareRawCode word)) +/-- Squares the encoded ellipsoid update parameter. -/ def machineEllipsoidAlphaSquareRawCode (word : List Bool) : List Bool := machineRawRatMulCode (pair (machineEllipsoidAlphaRawCode word) (machineEllipsoidAlphaRawCode word)) +/-- Computes twice the encoded squared update parameter. -/ def machineEllipsoidTwiceAlphaSquareRawCode (word : List Bool) : List Bool := machineRawRatMulCode (pair (rawRatBinaryCode rawEllipsoidTwo) (machineEllipsoidAlphaSquareRawCode word)) +/-- Computes the encoded perpendicular scale `1 + 2*alpha^2`. -/ def machineEllipsoidPerpScaleRawCode (word : List Bool) : List Bool := machineRawRatAddCode (pair (rawRatBinaryCode rawEllipsoidOne) (machineEllipsoidTwiceAlphaSquareRawCode word)) +/-- Divides the encoded update parameter by the dimension. -/ def machineEllipsoidAlphaOverDimensionRawCode (word : List Bool) : List Bool := machineRawRatDivCode (pair (machineEllipsoidAlphaRawCode word) (machineEllipsoidDimensionRawCode word)) +/-- Computes the encoded parallel scale `1 - alpha/d`. -/ def machineEllipsoidParallelScaleRawCode (word : List Bool) : List Bool := machineRawRatAddCode @@ -107,13 +128,16 @@ def machineEllipsoidParallelScaleRawCode (machineRawRatNegCode (machineEllipsoidAlphaOverDimensionRawCode word))) +/-- Normalizes the ellipsoid update parameter into a rational entry code. -/ def machineEllipsoidAlphaEntryCode (word : List Bool) : List Bool := machineNormalizeRawRatEntryCode (machineEllipsoidAlphaRawCode word) +/-- Normalizes the perpendicular update scale into a rational entry code. -/ def machineEllipsoidPerpScaleEntryCode (word : List Bool) : List Bool := machineNormalizeRawRatEntryCode (machineEllipsoidPerpScaleRawCode word) +/-- Normalizes the parallel update scale into a rational entry code. -/ def machineEllipsoidParallelScaleEntryCode (word : List Bool) : List Bool := machineNormalizeRawRatEntryCode diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalEllipsoidUpdate.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalEllipsoidUpdate.lean index 1657daca43..d35fd0af38 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalEllipsoidUpdate.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalEllipsoidUpdate.lean @@ -22,6 +22,7 @@ namespace BeyondBethe open Complexity +/-- Builds the direction-update matrix from the dimension and pulled-back cut direction. -/ def machineRationalEllipsoidUpdateDirectionMatrixCode (word : List Bool) : List Bool := machineRationalDirectionUpdateMatrixCode @@ -29,6 +30,7 @@ def machineRationalEllipsoidUpdateDirectionMatrixCode (pair (machineRationalCenterUpdateDimensionBits word) (machineRationalCenterUpdatePulledBackCode word))) +/-- Multiplies the current ellipsoid basis by its direction-update matrix. -/ def machineRationalEllipsoidUpdateBasisCode (word : List Bool) : List Bool := machineRationalMatrixMulCode diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalExp.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalExp.lean index 594f770ef0..3aa6a0f57f 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalExp.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalExp.lean @@ -30,39 +30,49 @@ namespace BeyondBethe open Complexity +/-- Extracts the unary guard bound from a rational exponential query. -/ def machineExpGuard (word : List Bool) : List Bool := machinePairFirst word +/-- Extracts the argument and loss payload from a rational exponential query. -/ def machineExpPayload (word : List Bool) : List Bool := machinePairSecond word +/-- Extracts the encoded raw-rational exponential argument. -/ def machineExpArgumentCode (word : List Bool) : List Bool := machinePairFirst (machineExpPayload word) +/-- Extracts the encoded raw-rational exponential loss allowance. -/ def machineExpLossCode (word : List Bool) : List Bool := machinePairSecond (machineExpPayload word) +/-- Reads the sign bit of the exponential argument's numerator. -/ def machineExpArgumentSign (word : List Bool) : List Bool := machineHeadBit (machinePairFirst (machineExpArgumentCode word)) +/-- Selects the argument or its negation to encode its nonnegative magnitude. -/ def machineExpMagnitudeCode (word : List Bool) : List Bool := machineIfHead (machineExpArgumentSign word) (machineRawRatNegCode (machineExpArgumentCode word)) (machineExpArgumentCode word) +/-- Squares the encoded magnitude of the exponential argument. -/ def machineExpSquareCode (word : List Bool) : List Bool := machineRawRatMulCode (pair (machineExpMagnitudeCode word) (machineExpMagnitudeCode word)) +/-- Divides the squared argument magnitude by the loss allowance. -/ def machineExpSquareOverLossCode (word : List Bool) : List Bool := machineRawRatDivCode (pair (machineExpSquareCode word) (machineExpLossCode word)) +/-- Adds the argument magnitude to its square divided by the loss allowance. -/ def machineExpScheduleArgumentCode (word : List Bool) : List Bool := machineRawRatAddCode (pair (machineExpMagnitudeCode word) (machineExpSquareOverLossCode word)) +/-- Computes the natural ceiling of the exponential scheduling expression. -/ def machineExpCeilBits (word : List Bool) : List Bool := machineRationalCeilNatBits (machineExpScheduleArgumentCode word) @@ -70,16 +80,20 @@ def machineExpCeilBits (word : List Bool) : List Bool := def machineExpStepsBits (word : List Bool) : List Bool := true :: machineExpCeilBits word +/-- Converts the exponential step count into a unary ruler bounded by the supplied guard. -/ def machineExpStepsRuler (word : List Bool) : List Bool := machineBoundedUnary (pair (machineExpGuard word) (machineExpStepsBits word)) +/-- Encodes the scheduled exponential step count as a raw rational with denominator one. -/ def machineExpStepsRawRatCode (word : List Bool) : List Bool := pair (machineNaturalIntegerCode (machineExpStepsBits word)) [true] +/-- Divides the exponential argument by the scheduled step count. -/ def machineExpScaledArgumentCode (word : List Bool) : List Bool := machineRawRatDivCode (pair (machineExpArgumentCode word) (machineExpStepsRawRatCode word)) +/-- Forms the rational exponential-approximation base `1 + s/N`. -/ def machineExpBaseCode (word : List Bool) : List Bool := machineRawRatAddCode (pair rawRatOneCode (machineExpScaledArgumentCode word)) @@ -96,6 +110,7 @@ def machineBoundedRationalExpLowerRawPowerCode machineRawRatPowerCode (pair (machineExpStepsRuler word) (machineExpBaseCode word)) +/-- Normalizes the bounded raw exponential power approximation into a rational entry code. -/ def machineBoundedRationalExpLowerRawEntryCode (word : List Bool) : List Bool := machineNormalizeRawRatEntryCode @@ -218,6 +233,8 @@ def expMagnitude (q : RawRat) : RawRat := | .ofNat _ => q | .negSucc _ => q.neg +/-- The scheduled number of rational exponential steps determined by argument magnitude and +loss. -/ def expApproxSteps (s loss : RawRat) : ℕ := binaryRationalExpApproxSteps (expMagnitude s).value loss.value diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalLogSeries.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalLogSeries.lean index cbdb7e1142..cc7a3dad99 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalLogSeries.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalLogSeries.lean @@ -26,55 +26,70 @@ namespace BeyondBethe open Complexity +/-- The binary encoding of the raw-rational constant zero. -/ def rawRatZeroCode : List Bool := rawRatBinaryCode RawRat.zero +/-- Encodes logarithmic-series state as sum, current odd power, squared base, odd denominator, +and bound. -/ def machineLogSeriesPack (sum power square odd bound : List Bool) : List Bool := pair sum (pair power (pair square (pair odd bound))) +/-- Extracts the partial sum from the logarithmic-series state. -/ def machineLogSeriesSumField (state : List Bool) : List Bool := machinePairFirst state +/-- Extracts the current odd power from the logarithmic-series state. -/ def machineLogSeriesPowerField (state : List Bool) : List Bool := machinePairFirst (machinePairSecond state) +/-- Extracts the fixed squared series base. -/ def machineLogSeriesSquareField (state : List Bool) : List Bool := machinePairFirst (machinePairSecond (machinePairSecond state)) +/-- Extracts the binary odd denominator of the current series term. -/ def machineLogSeriesOddField (state : List Bool) : List Bool := machinePairFirst (machinePairSecond (machinePairSecond (machinePairSecond state))) +/-- Extracts the width bound stored in the logarithmic-series state. -/ def machineLogSeriesBoundField (state : List Bool) : List Bool := machinePairSecond (machinePairSecond (machinePairSecond (machinePairSecond state))) +/-- Encodes the current odd denominator as a raw rational with denominator one. -/ def machineLogSeriesOddRawRatCode (state : List Bool) : List Bool := pair (machineNaturalIntegerCode (machineLogSeriesOddField state)) [true] +/-- Divides the current odd power by its odd denominator to form the next series term. -/ def machineLogSeriesTermCandidate (state : List Bool) : List Bool := machineRawRatDivCode (pair (machineLogSeriesPowerField state) (machineLogSeriesOddRawRatCode state)) +/-- Adds the current series term to the partial sum. -/ def machineLogSeriesSumCandidate (state : List Bool) : List Bool := machineRawRatAddCode (pair (machineLogSeriesSumField state) (machineLogSeriesTermCandidate state)) +/-- Multiplies the current odd power by the squared base to obtain the next odd power. -/ def machineLogSeriesPowerCandidate (state : List Bool) : List Bool := machineRawRatMulCode (pair (machineLogSeriesPowerField state) (machineLogSeriesSquareField state)) +/-- Increments the odd denominator by two. -/ def machineLogSeriesOddCandidate (state : List Bool) : List Bool := machineBinaryAddBits (pair (machineLogSeriesOddField state) [false, true]) +/-- Truncates a candidate state component to the stored logarithmic-series width bound. -/ def machineLogSeriesClamp (candidate : List Bool → List Bool) (state : List Bool) : List Bool := (candidate state).take (machineLogSeriesBoundField state).length +/-- Updates bounded sum, odd power, and odd denominator while retaining the square and bound. -/ def machineLogSeriesStep (state : List Bool) : List Bool := machineLogSeriesPack (machineLogSeriesClamp machineLogSeriesSumCandidate state) @@ -83,9 +98,11 @@ def machineLogSeriesStep (state : List Bool) : List Bool := (machineLogSeriesClamp machineLogSeriesOddCandidate state) (machineLogSeriesBoundField state) +/-- Extracts the unary term-count ruler from the logarithmic-series input. -/ def machineLogSeriesInputRuler (word : List Bool) : List Bool := machinePairFirst word +/-- Extracts the encoded raw-rational base of the logarithmic series. -/ def machineLogSeriesInputBase (word : List Bool) : List Bool := machinePairSecond word @@ -94,11 +111,14 @@ well-formed partial sum while remaining polynomial on arbitrary inputs. -/ def machineLogSeriesInputBound (word : List Bool) : List Bool := machineBinaryMulWidth (machineBinaryMulWidth word) +/-- Squares the encoded series base for initialization. -/ def machineLogSeriesInitialSquareCandidate (word : List Bool) : List Bool := machineRawRatMulCode (pair (machineLogSeriesInputBase word) (machineLogSeriesInputBase word)) +/-- Initializes a zero sum, bounded base and square, odd denominator one, and input-derived +bound. -/ def machineLogSeriesInit (word : List Bool) : List Bool := let bound := machineLogSeriesInputBound word machineLogSeriesPack rawRatZeroCode @@ -106,17 +126,21 @@ def machineLogSeriesInit (word : List Bool) : List Bool := (List.take bound.length (machineLogSeriesInitialSquareCandidate word)) [true] bound +/-- Packs five copies of the input bound to bound the complete series state. -/ def machineLogSeriesWidth (word : List Bool) : List Bool := let bound := machineLogSeriesInputBound word machineLogSeriesPack bound bound bound bound bound +/-- Runs one logarithmic-series step per bit of the term-count ruler. -/ def machineLogSeriesFinalState (word : List Bool) : List Bool := (machineLogSeriesStep)^[(machineLogSeriesInputRuler word).length] (machineLogSeriesInit word) +/-- Extracts the raw partial sum after the scheduled logarithmic-series iterations. -/ def machineRawRationalLogSeriesSumCode (word : List Bool) : List Bool := machineLogSeriesSumField (machineLogSeriesFinalState word) +/-- Normalizes the computed raw logarithmic-series sum into a rational encoding. -/ def machineRationalLogSeriesSumCode (word : List Bool) : List Bool := machineNormalizeRawRatBinaryCode (machineRawRationalLogSeriesSumCode word) @@ -241,6 +265,7 @@ theorem machineLogSeriesWidth_mem_FP : (machinePair_mem_FP machineLogSeriesInputBound_mem_FP machineLogSeriesInputBound_mem_FP))) +/-- Bounds all five components of a canonically packed logarithmic-series state. -/ def MachineLogSeriesStateBound (word state : List Bool) : Prop := state = machineLogSeriesPack (machineLogSeriesSumField state) @@ -592,6 +617,8 @@ private theorem logSeriesOddBits_length_le_inputBound nlinarith exact hsize.trans ((by omega : 2 * k + 2 ≤ 2 * word.length + 2).trans hlarge) +/-- Encodes the semantic series state after `k` terms, with next odd power and denominator `2*k ++ 1`. -/ def rawLogSeriesMachineState (q : RawRat) (total k : ℕ) : List Bool := let word := pair (List.replicate total true) (rawRatBinaryCode q) machineLogSeriesPack diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalMatrixColumn.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalMatrixColumn.lean index bd49bbf415..d0b58c320b 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalMatrixColumn.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalMatrixColumn.lean @@ -25,52 +25,64 @@ namespace BeyondBethe open Complexity +/-- Extracts the unary column index from a matrix-column query. -/ def machineRationalMatrixColumnIndex (word : List Bool) : List Bool := machinePairFirst word +/-- Extracts the encoded rows from a matrix-column query. -/ def machineRationalMatrixColumnRows (word : List Bool) : List Bool := machinePairSecond word +/-- Encodes column-extraction state as remaining rows, reversed column, index, and width bound. -/ def machineRationalMatrixColumnPack (remaining accumulator column bound : List Bool) : List Bool := pair remaining (pair accumulator (pair column bound)) +/-- Extracts the rows not yet processed by column extraction. -/ def machineRationalMatrixColumnRemaining (state : List Bool) : List Bool := machinePairFirst state +/-- Extracts the reversed accumulated column entries. -/ def machineRationalMatrixColumnAccumulator (state : List Bool) : List Bool := machinePairFirst (machinePairSecond state) +/-- Extracts the fixed unary column index from the scan state. -/ def machineRationalMatrixColumnColumn (state : List Bool) : List Bool := machinePairFirst (machinePairSecond (machinePairSecond state)) +/-- Extracts the width bound stored in the column-extraction state. -/ def machineRationalMatrixColumnBound (state : List Bool) : List Bool := machinePairSecond (machinePairSecond (machinePairSecond state)) +/-- Reads the first unprocessed matrix row. -/ def machineRationalMatrixColumnCurrentRow (state : List Bool) : List Bool := machineListHead (machineRationalMatrixColumnRemaining state) +/-- Looks up the selected column entry in the current row. -/ def machineRationalMatrixColumnCurrentEntry (state : List Bool) : List Bool := machineListIndex (pair (machineRationalMatrixColumnColumn state) (machineRationalMatrixColumnCurrentRow state)) +/-- Prepends the current column entry to the reversed accumulator. -/ def machineRationalMatrixColumnCandidate (state : List Bool) : List Bool := pair (machineRationalMatrixColumnCurrentEntry state) (machineRationalMatrixColumnAccumulator state) +/-- Truncates the candidate column accumulator to the stored width bound. -/ def machineRationalMatrixColumnNextAccumulator (state : List Bool) : List Bool := (machineRationalMatrixColumnCandidate state).take (machineRationalMatrixColumnBound state).length +/-- Consumes one row and stores its selected column entry while retaining the index and bound. -/ def machineRationalMatrixColumnAdvance (state : List Bool) : List Bool := machineRationalMatrixColumnPack @@ -79,24 +91,30 @@ def machineRationalMatrixColumnAdvance (machineRationalMatrixColumnColumn state) (machineRationalMatrixColumnBound state) +/-- Processes the next row, leaving exhausted column-extraction states fixed. -/ def machineRationalMatrixColumnStep (state : List Bool) : List Bool := machineIfEmpty (machineRationalMatrixColumnRemaining state) state (machineRationalMatrixColumnAdvance state) +/-- Initializes column extraction with the source rows, empty accumulator, fixed index, and +input-word bound. -/ def machineRationalMatrixColumnInit (word : List Bool) : List Bool := machineRationalMatrixColumnPack (machineRationalMatrixColumnRows word) [] (machineRationalMatrixColumnIndex word) word +/-- Packs four copies of the input word to bound a column-extraction state. -/ def machineRationalMatrixColumnWidth (word : List Bool) : List Bool := machineRationalMatrixColumnPack word word word word +/-- Runs column extraction for one step per input bit. -/ def machineRationalMatrixColumnFinalState (word : List Bool) : List Bool := (machineRationalMatrixColumnStep)^[word.length] (machineRationalMatrixColumnInit word) +/-- Extracts the selected column entries in reverse row order. -/ def machineRationalMatrixColumnReversedCode (word : List Bool) : List Bool := machineRationalMatrixColumnAccumulator @@ -210,6 +228,8 @@ theorem machineRationalMatrixColumnWidth_mem_FP : simp [machineRationalMatrixColumnBound, machineRationalMatrixColumnPack] +/-- Bounds remaining rows, accumulated entries, and the column index while retaining the input +word as bound. -/ def MachineRationalMatrixColumnStateBound (word state : List Bool) : Prop := state = machineRationalMatrixColumnPack @@ -304,9 +324,11 @@ theorem machineRationalMatrixColumnCode_mem_FP : /-! ## Exact semantics -/ +/-- Selects column `j` from each rational row, using zero when the row has no such entry. -/ def rationalColumnOfRows (rows : List (List ℚ)) (j : ℕ) : List ℚ := rows.map fun row => row.getD j 0 +/-- Requires every supplied row to contain an entry at column index `j`. -/ def RationalRowsHaveColumn (rows : List (List ℚ)) (j : ℕ) : Prop := ∀ row ∈ rows, j < row.length @@ -369,6 +391,8 @@ theorem rationalColumnOfRows_take_reverse_code_length_le rationalEntryBinaryCode (rationalColumnOfRows rows j) k).trans (rationalColumnOfRows_code_length_le j rows hvalid) +/-- Encodes column extraction after `k` rows, with the selected entries accumulated in reverse +order. -/ def machineRationalMatrixColumnSemanticState (rows : List (List ℚ)) (j k : ℕ) (bound : List Bool) : List Bool := diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalMatrixMul.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalMatrixMul.lean index 97b6a03568..58ca9c9cf2 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalMatrixMul.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalMatrixMul.lean @@ -24,6 +24,8 @@ namespace BeyondBethe open Complexity +/-- The square rational matrix product, computed by summing entrywise products over the inner +index. -/ def rationalMatrixMul {d : ℕ} (A B : Matrix (Fin d) (Fin d) ℚ) : Matrix (Fin d) (Fin d) ℚ := fun i j ↦ ∑ k, A i k * B k j @@ -33,22 +35,27 @@ theorem rationalMatrixMul_eq_matrix_mul {d : ℕ} rationalMatrixMul A B = A * B := by rfl +/-- Encodes a unary dimension and the row encodings of two square rational matrices. -/ def rationalMatrixMulCanonicalWord {d : ℕ} (A B : Matrix (Fin d) (Fin d) ℚ) : List Bool := pair (List.replicate d true) (pair (rationalSquareMatrixRowsCode A) (rationalSquareMatrixRowsCode B)) +/-- Extracts the unary dimension ruler from a matrix-product query. -/ def machineRationalMatrixMulDimensionUnary (word : List Bool) : List Bool := machinePairFirst word +/-- Extracts the paired left and right row encodings from a matrix-product query. -/ def machineRationalMatrixMulMatrices (word : List Bool) : List Bool := machinePairSecond word +/-- Extracts the left matrix's encoded rows. -/ def machineRationalMatrixMulLeftRows (word : List Bool) : List Bool := machinePairFirst (machineRationalMatrixMulMatrices word) +/-- Extracts the right matrix's encoded rows. -/ def machineRationalMatrixMulRightRows (word : List Bool) : List Bool := machinePairSecond (machineRationalMatrixMulMatrices word) @@ -133,6 +140,7 @@ theorem rationalTransposeMulVector_row_eq_matrixMul {d : ℕ} /-! ## A global ordinary-binary output bound -/ +/-- Computes a product entry as the raw dot product of a left row with a right column. -/ def rawRationalMatrixMulCoordinate {d : ℕ} (A B : Matrix (Fin d) (Fin d) ℚ) (i j : Fin d) : RawRat := rawRatListDot RawRat.zero (List.ofFn fun k ↦ A i k) @@ -192,6 +200,7 @@ theorem rationalMatrixMul_entry_code_length_le {d : ℕ} (Nat.mul_le_mul_left 36 (rawRationalMatrixMulCoordinate_width_le_word A B i j)) 64) +/-- Reuses the transpose-vector width bound for matrix-product state. -/ def machineRationalMatrixMulInputBound (word : List Bool) : List Bool := machineRationalTransposeMulVectorInputBound word @@ -300,23 +309,29 @@ theorem rationalMatrixMul_code_length_le_bound {d : ℕ} /-! ## Bounded outer row scan -/ +/-- Encodes the range of row indices to generate in the matrix product. -/ def machineRationalMatrixMulIndices (word : List Bool) : List Bool := machineUnaryRangeCode (machineRationalMatrixMulDimensionUnary word) +/-- Computes the product row at the current scan index from the stored matrix payload. -/ def machineRationalMatrixMulCurrentRow (state : List Bool) : List Bool := machineRationalMatrixMulRowCode (pair (machineRationalTransposeMulVectorCurrentIndex state) (machineRationalTransposeMulVectorStatePayload state)) +/-- Prepends the current product row to the reversed output accumulator. -/ def machineRationalMatrixMulCandidate (state : List Bool) : List Bool := pair (machineRationalMatrixMulCurrentRow state) (machineRationalTransposeMulVectorAccumulator state) +/-- Truncates the candidate product-row accumulator to the stored bound. -/ def machineRationalMatrixMulNextAccumulator (state : List Bool) : List Bool := (machineRationalMatrixMulCandidate state).take (machineRationalTransposeMulVectorBound state).length +/-- Consumes one row index and updates the bounded product accumulator, retaining payload and +bound. -/ def machineRationalMatrixMulAdvance (state : List Bool) : List Bool := machineRationalTransposeMulVectorPack (machineListTail (machineRationalTransposeMulVectorRemaining state)) @@ -324,23 +339,29 @@ def machineRationalMatrixMulAdvance (state : List Bool) : List Bool := (machineRationalTransposeMulVectorStatePayload state) (machineRationalTransposeMulVectorBound state) +/-- Generates the next product row, leaving exhausted matrix-product scans fixed. -/ def machineRationalMatrixMulStep (state : List Bool) : List Bool := machineIfEmpty (machineRationalTransposeMulVectorRemaining state) state (machineRationalMatrixMulAdvance state) +/-- Initializes matrix multiplication with all row indices, empty output, input payload, and +width bound. -/ def machineRationalMatrixMulInit (word : List Bool) : List Bool := machineRationalTransposeMulVectorPack (machineRationalMatrixMulIndices word) [] word (machineRationalMatrixMulInputBound word) +/-- Packs four copies of the matrix-product input bound to bound its scan state. -/ def machineRationalMatrixMulWidth (word : List Bool) : List Bool := let bound := machineRationalMatrixMulInputBound word machineRationalTransposeMulVectorPack bound bound bound bound +/-- Runs matrix-product row generation for one step per input bit. -/ def machineRationalMatrixMulFinalState (word : List Bool) : List Bool := (machineRationalMatrixMulStep)^[word.length] (machineRationalMatrixMulInit word) +/-- Extracts the generated matrix-product rows in reverse order. -/ def machineRationalMatrixMulReversedCode (word : List Bool) : List Bool := machineRationalTransposeMulVectorAccumulator (machineRationalMatrixMulFinalState word) @@ -493,11 +514,14 @@ theorem machineRationalMatrixMulCode_mem_FP : /-! ## Exact scan semantics -/ +/-- Lists the first `k` rows of the rational matrix product. -/ def rationalMatrixMulRowsPrefix {d : ℕ} (A B : Matrix (Fin d) (Fin d) ℚ) (k : ℕ) : List (List ℚ) := ((List.finRange d).take k).map fun i ↦ List.ofFn fun j ↦ rationalMatrixMul A B i j +/-- Encodes matrix multiplication after `k` rows, with remaining indices and reversed generated +rows. -/ def machineRationalMatrixMulSemanticState {d : ℕ} (A B : Matrix (Fin d) (Fin d) ℚ) (k : ℕ) : List Bool := let word := rationalMatrixMulCanonicalWord A B diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalMatrixMulVector.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalMatrixMulVector.lean index 77de5eeee4..8f095acd36 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalMatrixMulVector.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalMatrixMulVector.lean @@ -25,6 +25,7 @@ namespace BeyondBethe open Complexity +/-- The rational matrix-vector product computed as row dot products. -/ def rationalMatrixMulVector {d : ℕ} (A : Matrix (Fin d) (Fin d) ℚ) (v : Fin d → ℚ) : Fin d → ℚ := fun i ↦ ∑ j, A i j * v j @@ -75,6 +76,7 @@ theorem machineRationalMatrixMulVectorEntryCode_mem_FP : /-! ## The full vector -/ +/-- Computes one matrix-vector product coordinate as a raw-rational dot product. -/ def rawRationalMatrixCoordinate {d : ℕ} (A : Matrix (Fin d) (Fin d) ℚ) (v : Fin d → ℚ) (i : Fin d) : RawRat := @@ -87,6 +89,7 @@ theorem rawRationalMatrixCoordinate_value {d : ℕ} rationalMatrixMulVector A v i := by exact rawRatListDot_ofFn_value (fun j ↦ A i j) v +/-- Encodes a unary dimension, square matrix rows, and rational vector for multiplication. -/ def rationalMatrixMulVectorCanonicalWord {d : ℕ} (A : Matrix (Fin d) (Fin d) ℚ) (v : Fin d → ℚ) : List Bool := pair (List.replicate d true) @@ -139,6 +142,7 @@ theorem rationalMatrixMulVector_entry_code_length_le {d : ℕ} (Nat.mul_le_mul_left 36 (rawRationalMatrixCoordinate_width_le_word A v i)) 64) +/-- Reuses the transpose-vector input bound for matrix-vector multiplication. -/ def machineRationalMatrixMulVectorInputBound (word : List Bool) : List Bool := machineRationalTransposeMulVectorInputBound word @@ -185,22 +189,27 @@ theorem rationalMatrixMulVector_code_length_le_bound {d : ℕ} /-! The state layout and the degree-eight envelope are shared with the transpose--vector machine; only the one-coordinate routine changes. -/ +/-- Computes the matrix-vector product entry at the current scan index. -/ def machineRationalMatrixMulVectorCurrentEntry (state : List Bool) : List Bool := machineRationalMatrixMulVectorEntryCode (pair (machineRationalTransposeMulVectorCurrentIndex state) (machineRationalTransposeMulVectorStatePayload state)) +/-- Prepends the current product entry to the reversed vector accumulator. -/ def machineRationalMatrixMulVectorCandidate (state : List Bool) : List Bool := pair (machineRationalMatrixMulVectorCurrentEntry state) (machineRationalTransposeMulVectorAccumulator state) +/-- Truncates the candidate product-vector accumulator to the stored width bound. -/ def machineRationalMatrixMulVectorNextAccumulator (state : List Bool) : List Bool := (machineRationalMatrixMulVectorCandidate state).take (machineRationalTransposeMulVectorBound state).length +/-- Consumes one coordinate index and updates the bounded product vector, retaining payload and +bound. -/ def machineRationalMatrixMulVectorAdvance (state : List Bool) : List Bool := machineRationalTransposeMulVectorPack @@ -209,27 +218,33 @@ def machineRationalMatrixMulVectorAdvance (machineRationalTransposeMulVectorStatePayload state) (machineRationalTransposeMulVectorBound state) +/-- Generates the next product coordinate, leaving exhausted scans fixed. -/ def machineRationalMatrixMulVectorStep (state : List Bool) : List Bool := machineIfEmpty (machineRationalTransposeMulVectorRemaining state) state (machineRationalMatrixMulVectorAdvance state) +/-- Reuses the transpose-vector state layout to initialize matrix-vector multiplication. -/ def machineRationalMatrixMulVectorInit (word : List Bool) : List Bool := machineRationalTransposeMulVectorInit word +/-- Reuses the transpose-vector width envelope for matrix-vector multiplication. -/ def machineRationalMatrixMulVectorWidth (word : List Bool) : List Bool := machineRationalTransposeMulVectorWidth word +/-- Runs matrix-vector coordinate generation for one step per input bit. -/ def machineRationalMatrixMulVectorFinalState (word : List Bool) : List Bool := (machineRationalMatrixMulVectorStep)^[word.length] (machineRationalMatrixMulVectorInit word) +/-- Extracts the generated matrix-vector product coordinates in reverse order. -/ def machineRationalMatrixMulVectorReversedCode (word : List Bool) : List Bool := machineRationalTransposeMulVectorAccumulator (machineRationalMatrixMulVectorFinalState word) +/-- Reverses the accumulated matrix-vector product entries to restore row order. -/ def machineRationalMatrixMulVectorCode (word : List Bool) : List Bool := machineListReverse (machineRationalMatrixMulVectorReversedCode word) @@ -352,12 +367,15 @@ theorem machineRationalMatrixMulVectorCode_mem_FP : /-! ## Exact iteration semantics -/ +/-- Lists the first `k` coordinates of the rational matrix-vector product in row order. -/ def rationalMatrixMulVectorPrefix {d : ℕ} (A : Matrix (Fin d) (Fin d) ℚ) (v : Fin d → ℚ) (k : ℕ) : List ℚ := ((List.finRange d).take k).map fun i ↦ rationalMatrixMulVector A v i +/-- Encodes the remaining row indices and reversed product prefix after `k` rows, retaining the +matrix-vector payload and input bound. -/ def machineRationalMatrixMulVectorSemanticState {d : ℕ} (A : Matrix (Fin d) (Fin d) ℚ) (v : Fin d → ℚ) (k : ℕ) : List Bool := diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalMatrixUpdate.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalMatrixUpdate.lean index 19d91783aa..274fcb15b3 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalMatrixUpdate.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalMatrixUpdate.lean @@ -24,44 +24,55 @@ namespace BeyondBethe open Complexity +/-- Extracts the unary row index from a rational matrix-update request. -/ def machineRationalMatrixUpdateRow (word : List Bool) : List Bool := machinePairFirst word +/-- Extracts the matrix-update payload following its row index. -/ def machineRationalMatrixUpdateRest (word : List Bool) : List Bool := machinePairSecond word +/-- Extracts the unary column index from a rational matrix-update request. -/ def machineRationalMatrixUpdateColumn (word : List Bool) : List Bool := machinePairFirst (machineRationalMatrixUpdateRest word) +/-- Extracts the replacement-and-matrix payload following the requested indices. -/ def machineRationalMatrixUpdatePayload (word : List Bool) : List Bool := machinePairSecond (machineRationalMatrixUpdateRest word) +/-- Extracts the replacement entry from a rational matrix-update request. -/ def machineRationalMatrixUpdateReplacement (word : List Bool) : List Bool := machinePairFirst (machineRationalMatrixUpdatePayload word) +/-- Extracts the encoded matrix from a rational matrix-update request. -/ def machineRationalMatrixUpdateMatrix (word : List Bool) : List Bool := machinePairSecond (machineRationalMatrixUpdatePayload word) +/-- Reads the encoded row list of the matrix being updated. -/ def machineRationalMatrixUpdateRows (word : List Bool) : List Bool := machineMatrixRowsWord (machineRationalMatrixUpdateMatrix word) +/-- Looks up the row selected by the unary matrix-update index. -/ def machineRationalMatrixUpdateCurrentRow (word : List Bool) : List Bool := machineListIndex (pair (machineRationalMatrixUpdateRow word) (machineRationalMatrixUpdateRows word)) +/-- Replaces the selected column of the current row with the supplied entry. -/ def machineRationalMatrixUpdateNewRow (word : List Bool) : List Bool := machineListUpdate (pair (machineRationalMatrixUpdateColumn word) (pair (machineRationalMatrixUpdateReplacement word) (machineRationalMatrixUpdateCurrentRow word))) +/-- Replaces the selected matrix row with its updated row. -/ def machineRationalMatrixUpdateNewRows (word : List Bool) : List Bool := machineListUpdate (pair (machineRationalMatrixUpdateRow word) (pair (machineRationalMatrixUpdateNewRow word) (machineRationalMatrixUpdateRows word))) +/-- Reconstructs the matrix encoding from its unchanged dimension and updated row list. -/ def machineRationalMatrixUpdateAtUnary (word : List Bool) : List Bool := pair (machineMatrixDimensionWord (machineRationalMatrixUpdateMatrix word)) (machineRationalMatrixUpdateNewRows word) @@ -139,6 +150,7 @@ theorem machineRationalMatrixUpdateAtUnary_mem_FP : /-! ## Exact semantics -/ +/-- Pairs a dimension word with an encoded nested list of rational rows. -/ def rationalRowsWord (dimension : List Bool) (rows : List (List ℚ)) : List Bool := pair dimension diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalMin.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalMin.lean index b600c3f5e7..7e37d8cbf2 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalMin.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalMin.lean @@ -24,10 +24,13 @@ namespace BeyondBethe open Complexity +/-- Selects the lesser raw rational in a pair, choosing the left one when the comparison is +equal. -/ def machineRawRatMinCode (word : List Bool) : List Bool := machineIfHead (machineRawRatLeBit word) (machinePairFirst word) (machinePairSecond word) +/-- Normalizes the selected raw minimum into the rational binary output encoding. -/ def machineRationalMinCode (word : List Bool) : List Bool := machineNormalizeRawRatBinaryCode (machineRawRatMinCode word) diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalNormalization.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalNormalization.lean index 66b7ad89ab..cacb2253a3 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalNormalization.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalNormalization.lean @@ -23,26 +23,33 @@ namespace BeyondBethe open Complexity +/-- Encodes a raw rational as its signed integer numerator paired with binary denominator bits. -/ def rawRatBinaryCode (q : RawRat) : List Bool := pair (integerBinaryCode q.num) q.den.bits +/-- Computes the binary absolute value of a raw rational code's numerator. -/ def machineRawRatNatAbsBits (word : List Bool) : List Bool := machineIntegerNatAbsBits (machinePairFirst word) +/-- Computes the binary greatest common divisor of numerator magnitude and denominator. -/ def machineRawRatGcdBits (word : List Bool) : List Bool := machineBinaryGcdBits (pair (machineRawRatNatAbsBits word) (machinePairSecond word)) +/-- Divides the numerator magnitude by its gcd with the denominator and extracts the quotient. -/ def machineRawRatAbsQuotientBits (word : List Bool) : List Bool := machinePairFirst (machineBinaryDivModBits (pair (machineRawRatNatAbsBits word) (machineRawRatGcdBits word))) +/-- Divides the denominator by its gcd with the numerator magnitude and extracts the quotient. -/ def machineRawRatDenQuotientBits (word : List Bool) : List Bool := machinePairFirst (machineBinaryDivModBits (pair (machinePairSecond word) (machineRawRatGcdBits word))) +/-- Builds a normalized rational-entry code from the gcd-reduced numerator magnitude, its +original sign, and the reduced denominator. -/ def machineNormalizeRawRatEntryCode (word : List Bool) : List Bool := pair (machineIntegerCodeFromSignedAbs diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalNormalizedDirection.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalNormalizedDirection.lean index 991a7008ef..adcabfb2e2 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalNormalizedDirection.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalNormalizedDirection.lean @@ -24,10 +24,12 @@ namespace BeyondBethe open Complexity +/-- Divides every rational direction coordinate by the cut's L1 scale. -/ def rationalNormalizedDirection {d : ℕ} (b : Fin d → ℚ) : Fin d → ℚ := fun i ↦ b i / cutL1Scale b +/-- Divides the encoded rational vector by its raw L1 norm to obtain its normalized direction. -/ def machineRationalNormalizedDirectionCode (word : List Bool) : List Bool := machineRationalRowDivide diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalPower.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalPower.lean index b2a1bbe974..32b918ad95 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalPower.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalPower.lean @@ -23,60 +23,78 @@ namespace BeyondBethe open Complexity +/-- The raw rational binary code for the multiplicative identity. -/ def rawRatOneCode : List Bool := rawRatBinaryCode RawRat.one +/-- Packs the current power accumulator, fixed base, and length bound. -/ def machineRawRatPowerPack (acc base bound : List Bool) : List Bool := pair acc (pair base bound) +/-- Extracts the raw power accumulator from an exponentiation state. -/ def machineRawRatPowerAccField (state : List Bool) : List Bool := machinePairFirst state +/-- Extracts the fixed raw base from an exponentiation state. -/ def machineRawRatPowerBaseField (state : List Bool) : List Bool := machinePairFirst (machinePairSecond state) +/-- Extracts the accumulator length-bound word from an exponentiation state. -/ def machineRawRatPowerBoundField (state : List Bool) : List Bool := machinePairSecond (machinePairSecond state) +/-- Multiplies the current raw power accumulator by the fixed base. -/ def machineRawRatPowerCandidate (state : List Bool) : List Bool := machineRawRatMulCode (pair (machineRawRatPowerAccField state) (machineRawRatPowerBaseField state)) +/-- Truncates the updated power accumulator to the stored bound length. -/ def machineRawRatPowerNextAcc (state : List Bool) : List Bool := (machineRawRatPowerCandidate state).take (machineRawRatPowerBoundField state).length +/-- Updates the bounded power accumulator while preserving its base and bound. -/ def machineRawRatPowerStep (state : List Bool) : List Bool := machineRawRatPowerPack (machineRawRatPowerNextAcc state) (machineRawRatPowerBaseField state) (machineRawRatPowerBoundField state) +/-- Extracts the unary exponent ruler from a raw rational power request. -/ def machineRawRatPowerInputRuler (word : List Bool) : List Bool := machinePairFirst word +/-- Extracts the raw base code from a rational power request. -/ def machineRawRatPowerInputBase (word : List Bool) : List Bool := machinePairSecond word +/-- Builds the power accumulator bound by concatenating four copies of the binary-multiplication +width word. -/ def machineRawRatPowerInputBound (word : List Bool) : List Bool := let square := machineBinaryMulWidth word square ++ (square ++ (square ++ square)) +/-- Initializes raw exponentiation with accumulator one, the requested base, and the computed +bound. -/ def machineRawRatPowerInit (word : List Bool) : List Bool := machineRawRatPowerPack rawRatOneCode (machineRawRatPowerInputBase word) (machineRawRatPowerInputBound word) +/-- Packs three copies of the computed bound to bound the exponentiation state. -/ def machineRawRatPowerWidth (word : List Bool) : List Bool := let bound := machineRawRatPowerInputBound word machineRawRatPowerPack bound bound bound +/-- Iterates bounded multiplication for the length of the unary exponent ruler. -/ def machineRawRatPowerFinalState (word : List Bool) : List Bool := (machineRawRatPowerStep)^[(machineRawRatPowerInputRuler word).length] (machineRawRatPowerInit word) +/-- Extracts the final raw power accumulator. -/ def machineRawRatPowerCode (word : List Bool) : List Bool := machineRawRatPowerAccField (machineRawRatPowerFinalState word) +/-- Normalizes the raw power result into the rational binary output encoding. -/ def machineRationalPowerCode (word : List Bool) : List Bool := machineNormalizeRawRatBinaryCode (machineRawRatPowerCode word) diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalRowAdd.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalRowAdd.lean index b1406acf77..2855cc19d0 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalRowAdd.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalRowAdd.lean @@ -26,21 +26,27 @@ namespace BeyondBethe open Complexity +/-- Extracts the fixed raw increment from a row-addition request. -/ def machineRationalRowAddDelta (word : List Bool) : List Bool := machinePairFirst word +/-- Extracts the encoded rational row from a row-addition request. -/ def machineRationalRowAddRow (word : List Bool) : List Bool := machinePairSecond word +/-- Concatenates two copies of a word for row-addition width padding. -/ def machineRationalRowAddPadTwo (word : List Bool) : List Bool := word ++ word +/-- Concatenates four copies of a word for row-addition width padding. -/ def machineRationalRowAddPadFour (word : List Bool) : List Bool := machineRationalRowAddPadTwo word ++ machineRationalRowAddPadTwo word +/-- Concatenates eight copies of a word for row-addition width padding. -/ def machineRationalRowAddPadEight (word : List Bool) : List Bool := machineRationalRowAddPadFour word ++ machineRationalRowAddPadFour word +/-- Concatenates sixteen copies of a word for row-addition width padding. -/ def machineRationalRowAddPadSixteen (word : List Bool) : List Bool := machineRationalRowAddPadEight word ++ machineRationalRowAddPadEight word @@ -50,39 +56,51 @@ the impractical quartic padding used by an earlier draft. -/ def machineRationalRowAddInputBound (word : List Bool) : List Bool := machineBinaryMulWidth (machineRationalRowAddPadSixteen word) +/-- Packs the unprocessed row, reversed output accumulator, fixed increment, and bound for row +addition. -/ def machineRationalRowAddPack (remaining accumulator delta bound : List Bool) : List Bool := pair remaining (pair accumulator (pair delta bound)) +/-- Extracts the unprocessed encoded row from a row-addition state. -/ def machineRationalRowAddRemaining (state : List Bool) : List Bool := machinePairFirst state +/-- Extracts the reverse-order output accumulator from a row-addition state. -/ def machineRationalRowAddAccumulator (state : List Bool) : List Bool := machinePairFirst (machinePairSecond state) +/-- Extracts the fixed raw increment from a row-addition state. -/ def machineRationalRowAddDeltaField (state : List Bool) : List Bool := machinePairFirst (machinePairSecond (machinePairSecond state)) +/-- Extracts the accumulator length-bound word from a row-addition state. -/ def machineRationalRowAddBound (state : List Bool) : List Bool := machinePairSecond (machinePairSecond (machinePairSecond state)) +/-- Adds the fixed increment to the next row entry in raw rational arithmetic. -/ def machineRationalRowAddRawEntry (state : List Bool) : List Bool := machineRawRatAddCode (pair (machineListHead (machineRationalRowAddRemaining state)) (machineRationalRowAddDeltaField state)) +/-- Normalizes the updated row entry into its rational entry encoding. -/ def machineRationalRowAddEntry (state : List Bool) : List Bool := machineNormalizeRawRatEntryCode (machineRationalRowAddRawEntry state) +/-- Prepends the normalized updated entry to the reverse-order output accumulator. -/ def machineRationalRowAddCandidate (state : List Bool) : List Bool := pair (machineRationalRowAddEntry state) (machineRationalRowAddAccumulator state) +/-- Truncates the candidate row-addition accumulator to the stored bound length. -/ def machineRationalRowAddNextAccumulator (state : List Bool) : List Bool := (machineRationalRowAddCandidate state).take (machineRationalRowAddBound state).length +/-- Consumes the next row entry and stores the bounded updated accumulator, preserving increment +and bound. -/ def machineRationalRowAddAdvance (state : List Bool) : List Bool := machineRationalRowAddPack (machineListTail (machineRationalRowAddRemaining state)) @@ -90,23 +108,29 @@ def machineRationalRowAddAdvance (state : List Bool) : List Bool := (machineRationalRowAddDeltaField state) (machineRationalRowAddBound state) +/-- Fixes an exhausted row-addition state and otherwise processes one entry. -/ def machineRationalRowAddStep (state : List Bool) : List Bool := machineIfEmpty (machineRationalRowAddRemaining state) state (machineRationalRowAddAdvance state) +/-- Initializes row addition with the requested row, empty accumulator, fixed increment, and +computed bound. -/ def machineRationalRowAddInit (word : List Bool) : List Bool := machineRationalRowAddPack (machineRationalRowAddRow word) [] (machineRationalRowAddDelta word) (machineRationalRowAddInputBound word) +/-- Packs input and bound words in the four-field layout to bound the row-addition state. -/ def machineRationalRowAddWidth (word : List Bool) : List Bool := let bound := machineRationalRowAddInputBound word machineRationalRowAddPack word bound word bound +/-- Runs the row-addition scan once per input bit from its initial state. -/ def machineRationalRowAddFinalState (word : List Bool) : List Bool := (machineRationalRowAddStep)^[word.length] (machineRationalRowAddInit word) +/-- Reverses the final accumulator to return the incremented rational row in its original order. -/ def machineRationalRowAdd (word : List Bool) : List Bool := machineListReverse (machineRationalRowAddAccumulator @@ -259,6 +283,8 @@ theorem machineRationalRowAddWidth_mem_FP : (machineRationalRowAddPack a b c d) = d := by simp [machineRationalRowAddBound, machineRationalRowAddPack] +/-- Requires exact row-addition state packing, input-bounded remaining row and increment, a +bounded accumulator, and the prescribed bound word. -/ def MachineRationalRowAddStateBound (word state : List Bool) : Prop := state = machineRationalRowAddPack (machineRationalRowAddRemaining state) @@ -445,6 +471,8 @@ theorem machineRationalRowAdd_output_length_le_bound /-! ## Exact semantics -/ +/-- Adds the raw increment to each rational row entry and normalizes each resulting raw +fraction. -/ def rationalRowAddValues (delta : RawRat) (row : List ℚ) : List ℚ := row.map fun q ↦ binaryNormalizeRawRat ((rawRatOfRat q).add delta) From e901b3944e4dc0b2330ec1dda48ceb3f14285c2e Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Fri, 25 Sep 2026 20:23:17 +0000 Subject: [PATCH 26/49] Document remaining mathematical interfaces and machine semantics --- .../BeyondBethe/MachineRationalRowAdd.lean | 3 + .../BeyondBethe/MachineRationalRowDivide.lean | 30 ++++++++++ .../MachineRationalTransposeMulVector.lean | 32 +++++++++++ .../BeyondBethe/MachineRationalUnary.lean | 8 +++ .../BeyondBethe/MachineRationalVectorDot.lean | 30 ++++++++++ .../BeyondBethe/MachineRationalVectorL1.lean | 22 ++++++++ .../MachineRationalVectorScale.lean | 4 ++ .../BeyondBethe/MachineRationalVectorSub.lean | 20 +++++++ .../BeyondBethe/MachineRationalVectorSum.lean | 2 + .../BeyondBethe/MachineRepeatPair.lean | 20 +++++++ .../MachineRowComplementUpperSum.lean | 41 ++++++++++++++ .../BeyondBethe/MachineRowPairDisjoint.lean | 21 +++++++ .../MachineUnaryGridGenerator.lean | 13 +++++ .../MachineUnaryMatrixGenerator.lean | 55 +++++++++++++++++++ .../BeyondBethe/MachineUnaryRange.lean | 20 +++++++ LeanPool/BeyondBethe/BeyondBethe/Main.lean | 3 + .../BeyondBethe/MatchingAlgorithm.lean | 2 + .../BeyondBethe/BeyondBethe/NearCase.lean | 21 +++++++ .../BeyondBethe/NumericalScales.lean | 12 ++++ .../BeyondBethe/OptimizerOutputEncoding.lean | 3 + .../BeyondBethe/PairStability.lean | 5 ++ .../BeyondBethe/PairedCertificate.lean | 3 + .../BeyondBethe/RationalEllipsoid.lean | 2 + .../BeyondBethe/RationalEncodingBounds.lean | 1 + .../BeyondBethe/RationalEpigraphOracle.lean | 5 ++ .../BeyondBethe/RationalLinearOracle.lean | 5 ++ .../BeyondBethe/BeyondBethe/RawRational.lean | 9 +++ .../BeyondBethe/RawRationalBitBounds.lean | 8 +++ .../BeyondBethe/BeyondBethe/RobustCycle.lean | 5 ++ .../RoundedEllipsoidBitBounds.lean | 1 + .../RoundedEllipsoidIterationBounds.lean | 7 +++ .../BeyondBethe/RoundedFeasibility.lean | 2 + .../RoundedFeasibilityBitBounds.lean | 2 + .../BeyondBethe/BeyondBethe/RowStability.lean | 9 +++ .../BeyondBethe/ScannedBetheBisection.lean | 7 +++ .../ScannedBetheThresholdFeasibility.lean | 2 + .../ScheduledRoundedEllipsoidIteration.lean | 4 ++ .../BeyondBethe/SourceAnariRezaei.lean | 4 ++ .../BeyondBethe/SourceAnariRezaeiList.lean | 5 ++ .../BeyondBethe/SourceAnariRezaeiMerge.lean | 9 +++ .../BeyondBethe/SourceStableBivariate.lean | 2 + .../BeyondBethe/SourceStableClosure.lean | 7 +++ .../BeyondBethe/SourceStableEncoding.lean | 11 ++++ .../BeyondBethe/SourceStableSlice.lean | 6 ++ .../SourceStableSpecialization.lean | 6 ++ .../BeyondBethe/SourceStableTable.lean | 14 +++++ LeanPool/BeyondBethe/BeyondBethe/Stable.lean | 2 + .../BeyondBethe/TransferIdentity.lean | 1 + 48 files changed, 506 insertions(+) diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalRowAdd.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalRowAdd.lean index 2855cc19d0..3d1b88adb2 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalRowAdd.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalRowAdd.lean @@ -476,11 +476,14 @@ fraction. -/ def rationalRowAddValues (delta : RawRat) (row : List ℚ) : List ℚ := row.map fun q ↦ binaryNormalizeRawRat ((rawRatOfRat q).add delta) +/-- Encodes a raw increment paired with the rational row to update. -/ def machineRationalRowAddCanonicalInput (delta : RawRat) (row : List ℚ) : List Bool := pair (rawRatBinaryCode delta) (binaryListCode rationalEntryBinaryCode row) +/-- Encodes the unprocessed row suffix and reversed incremented prefix after `k` entries, +preserving increment and bound. -/ def machineRationalRowAddSemanticState (delta : RawRat) (row : List ℚ) (k : ℕ) : List Bool := let output := rationalRowAddValues delta row diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalRowDivide.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalRowDivide.lean index 2010b45974..8071d8ff0e 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalRowDivide.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalRowDivide.lean @@ -26,21 +26,27 @@ namespace BeyondBethe open Complexity +/-- Extracts the fixed raw divisor from a row-division request. -/ def machineRationalRowDivideScale (word : List Bool) : List Bool := machinePairFirst word +/-- Extracts the encoded rational row from a row-division request. -/ def machineRationalRowDivideRow (word : List Bool) : List Bool := machinePairSecond word +/-- Concatenates two copies of a word for row-division width padding. -/ def machineRationalRowDividePadTwo (word : List Bool) : List Bool := word ++ word +/-- Concatenates four copies of a word for row-division width padding. -/ def machineRationalRowDividePadFour (word : List Bool) : List Bool := machineRationalRowDividePadTwo word ++ machineRationalRowDividePadTwo word +/-- Concatenates eight copies of a word for row-division width padding. -/ def machineRationalRowDividePadEight (word : List Bool) : List Bool := machineRationalRowDividePadFour word ++ machineRationalRowDividePadFour word +/-- Concatenates sixteen copies of a word for row-division width padding. -/ def machineRationalRowDividePadSixteen (word : List Bool) : List Bool := machineRationalRowDividePadEight word ++ machineRationalRowDividePadEight word @@ -50,39 +56,51 @@ the impractical quartic padding used by an earlier draft. -/ def machineRationalRowDivideInputBound (word : List Bool) : List Bool := machineBinaryMulWidth (machineRationalRowDividePadSixteen word) +/-- Packs the unprocessed row, reversed output accumulator, fixed divisor, and bound for row +division. -/ def machineRationalRowDividePack (remaining accumulator scale bound : List Bool) : List Bool := pair remaining (pair accumulator (pair scale bound)) +/-- Extracts the unprocessed encoded row from a row-division state. -/ def machineRationalRowDivideRemaining (state : List Bool) : List Bool := machinePairFirst state +/-- Extracts the reverse-order output accumulator from a row-division state. -/ def machineRationalRowDivideAccumulator (state : List Bool) : List Bool := machinePairFirst (machinePairSecond state) +/-- Extracts the fixed raw divisor from a row-division state. -/ def machineRationalRowDivideScaleField (state : List Bool) : List Bool := machinePairFirst (machinePairSecond (machinePairSecond state)) +/-- Extracts the accumulator length-bound word from a row-division state. -/ def machineRationalRowDivideBound (state : List Bool) : List Bool := machinePairSecond (machinePairSecond (machinePairSecond state)) +/-- Divides the next row entry by the fixed scale in raw rational arithmetic. -/ def machineRationalRowDivideRawEntry (state : List Bool) : List Bool := machineRawRatDivCode (pair (machineListHead (machineRationalRowDivideRemaining state)) (machineRationalRowDivideScaleField state)) +/-- Normalizes the divided row entry into its rational entry encoding. -/ def machineRationalRowDivideEntry (state : List Bool) : List Bool := machineNormalizeRawRatEntryCode (machineRationalRowDivideRawEntry state) +/-- Prepends the normalized divided entry to the reverse-order output accumulator. -/ def machineRationalRowDivideCandidate (state : List Bool) : List Bool := pair (machineRationalRowDivideEntry state) (machineRationalRowDivideAccumulator state) +/-- Truncates the candidate row-division accumulator to the stored bound length. -/ def machineRationalRowDivideNextAccumulator (state : List Bool) : List Bool := (machineRationalRowDivideCandidate state).take (machineRationalRowDivideBound state).length +/-- Consumes the next row entry and stores the bounded updated accumulator, preserving divisor +and bound. -/ def machineRationalRowDivideAdvance (state : List Bool) : List Bool := machineRationalRowDividePack (machineListTail (machineRationalRowDivideRemaining state)) @@ -90,23 +108,29 @@ def machineRationalRowDivideAdvance (state : List Bool) : List Bool := (machineRationalRowDivideScaleField state) (machineRationalRowDivideBound state) +/-- Fixes an exhausted row-division state and otherwise processes one entry. -/ def machineRationalRowDivideStep (state : List Bool) : List Bool := machineIfEmpty (machineRationalRowDivideRemaining state) state (machineRationalRowDivideAdvance state) +/-- Initializes row division with the requested row, empty accumulator, fixed divisor, and +computed bound. -/ def machineRationalRowDivideInit (word : List Bool) : List Bool := machineRationalRowDividePack (machineRationalRowDivideRow word) [] (machineRationalRowDivideScale word) (machineRationalRowDivideInputBound word) +/-- Packs input and bound words in the four-field layout to bound the row-division state. -/ def machineRationalRowDivideWidth (word : List Bool) : List Bool := let bound := machineRationalRowDivideInputBound word machineRationalRowDividePack word bound word bound +/-- Runs the row-division scan once per input bit from its initial state. -/ def machineRationalRowDivideFinalState (word : List Bool) : List Bool := (machineRationalRowDivideStep)^[word.length] (machineRationalRowDivideInit word) +/-- Reverses the final accumulator to return the divided rational row in its original order. -/ def machineRationalRowDivide (word : List Bool) : List Bool := machineListReverse (machineRationalRowDivideAccumulator @@ -259,6 +283,8 @@ theorem machineRationalRowDivideWidth_mem_FP : (machineRationalRowDividePack a b c d) = d := by simp [machineRationalRowDivideBound, machineRationalRowDividePack] +/-- Requires exact row-division state packing, input-bounded remaining row and divisor, a +bounded accumulator, and the prescribed bound word. -/ def MachineRationalRowDivideStateBound (word state : List Bool) : Prop := state = machineRationalRowDividePack (machineRationalRowDivideRemaining state) @@ -445,14 +471,18 @@ theorem machineRationalRowDivide_output_length_le_bound /-! ## Exact semantics -/ +/-- Divides each rational row entry by the raw scale and normalizes each resulting raw fraction. -/ def rationalRowDivideValues (scale : RawRat) (row : List ℚ) : List ℚ := row.map fun q ↦ binaryNormalizeRawRat ((rawRatOfRat q).div scale) +/-- Encodes a raw divisor paired with the rational row to divide. -/ def machineRationalRowDivideCanonicalInput (scale : RawRat) (row : List ℚ) : List Bool := pair (rawRatBinaryCode scale) (binaryListCode rationalEntryBinaryCode row) +/-- Encodes the unprocessed row suffix and reversed divided prefix after `k` entries, preserving +divisor and bound. -/ def machineRationalRowDivideSemanticState (scale : RawRat) (row : List ℚ) (k : ℕ) : List Bool := let output := rationalRowDivideValues scale row diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalTransposeMulVector.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalTransposeMulVector.lean index 49878a32d4..5fcec2a451 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalTransposeMulVector.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalTransposeMulVector.lean @@ -30,6 +30,8 @@ def rationalTransposeMulVector {d : ℕ} (A : Matrix (Fin d) (Fin d) ℚ) (v : Fin d → ℚ) : Fin d → ℚ := fun j ↦ ∑ i, A i j * v i +/-- Computes coordinate `j` of the transpose-matrix product as a raw dot product of column `j` +with the vector. -/ def rawRationalTransposeCoordinate {d : ℕ} (A : Matrix (Fin d) (Fin d) ℚ) (v : Fin d → ℚ) (j : Fin d) : RawRat := @@ -46,6 +48,8 @@ theorem rawRationalTransposeCoordinate_value {d : ℕ} rationalColumnOfRows_matrix] exact rawRatListDot_ofFn_value (fun i => A i j) v +/-- Encodes unary dimension followed by the matrix rows and vector for transpose-matrix +multiplication. -/ def rationalTransposeMulVectorCanonicalWord {d : ℕ} (A : Matrix (Fin d) (Fin d) ℚ) (v : Fin d → ℚ) : List Bool := pair (List.replicate d true) @@ -97,6 +101,8 @@ theorem rationalTransposeMulVector_entry_code_length_le {d : ℕ} (Nat.mul_le_mul_left 36 (rawRationalTransposeCoordinate_width_le_word A v j)) 64) +/-- Applies the binary-multiplication width construction three times to bound transpose-matrix +vector computations. -/ def machineRationalTransposeMulVectorInputBound (word : List Bool) : List Bool := machineBinaryMulWidth @@ -146,56 +152,71 @@ theorem rationalTransposeMulVector_code_length_le_bound {d : ℕ} /-! ## Finite-word transducer -/ +/-- Extracts the unary dimension from a transpose-matrix vector request. -/ def machineRationalTransposeMulVectorDimension (word : List Bool) : List Bool := machinePairFirst word +/-- Extracts the matrix-and-vector payload from a transpose-matrix vector request. -/ def machineRationalTransposeMulVectorPayload (word : List Bool) : List Bool := machinePairSecond word +/-- Builds the complete encoded coordinate-index range from the request's unary dimension. -/ def machineRationalTransposeMulVectorIndices (word : List Bool) : List Bool := machineUnaryRangeCode (machineRationalTransposeMulVectorDimension word) +/-- Packs remaining indices, reversed output accumulator, fixed payload, and bound for a +coordinate scan. -/ def machineRationalTransposeMulVectorPack (remaining accumulator payload bound : List Bool) : List Bool := pair remaining (pair accumulator (pair payload bound)) +/-- Extracts the remaining coordinate indices from the scan state. -/ def machineRationalTransposeMulVectorRemaining (state : List Bool) : List Bool := machinePairFirst state +/-- Extracts the reverse-order coordinate accumulator from the scan state. -/ def machineRationalTransposeMulVectorAccumulator (state : List Bool) : List Bool := machinePairFirst (machinePairSecond state) +/-- Extracts the fixed matrix-and-vector payload from the scan state. -/ def machineRationalTransposeMulVectorStatePayload (state : List Bool) : List Bool := machinePairFirst (machinePairSecond (machinePairSecond state)) +/-- Extracts the accumulator length-bound word from the scan state. -/ def machineRationalTransposeMulVectorBound (state : List Bool) : List Bool := machinePairSecond (machinePairSecond (machinePairSecond state)) +/-- Reads the first remaining coordinate index of the scan. -/ def machineRationalTransposeMulVectorCurrentIndex (state : List Bool) : List Bool := machineListHead (machineRationalTransposeMulVectorRemaining state) +/-- Computes the transpose-matrix vector product entry at the current coordinate index. -/ def machineRationalTransposeMulVectorCurrentEntry (state : List Bool) : List Bool := machineRationalMatrixTransposeMulVectorEntryCode (pair (machineRationalTransposeMulVectorCurrentIndex state) (machineRationalTransposeMulVectorStatePayload state)) +/-- Prepends the current transpose-product entry to the reverse-order accumulator. -/ def machineRationalTransposeMulVectorCandidate (state : List Bool) : List Bool := pair (machineRationalTransposeMulVectorCurrentEntry state) (machineRationalTransposeMulVectorAccumulator state) +/-- Truncates the candidate coordinate accumulator to the stored bound length. -/ def machineRationalTransposeMulVectorNextAccumulator (state : List Bool) : List Bool := (machineRationalTransposeMulVectorCandidate state).take (machineRationalTransposeMulVectorBound state).length +/-- Drops the processed coordinate index and stores the bounded updated accumulator while +preserving payload and bound. -/ def machineRationalTransposeMulVectorAdvance (state : List Bool) : List Bool := machineRationalTransposeMulVectorPack @@ -204,26 +225,32 @@ def machineRationalTransposeMulVectorAdvance (machineRationalTransposeMulVectorStatePayload state) (machineRationalTransposeMulVectorBound state) +/-- Fixes an exhausted coordinate scan and otherwise computes its next transpose-product entry. -/ def machineRationalTransposeMulVectorStep (state : List Bool) : List Bool := machineIfEmpty (machineRationalTransposeMulVectorRemaining state) state (machineRationalTransposeMulVectorAdvance state) +/-- Initializes the transpose-product scan with all indices, empty accumulator, fixed payload, +and computed bound. -/ def machineRationalTransposeMulVectorInit (word : List Bool) : List Bool := machineRationalTransposeMulVectorPack (machineRationalTransposeMulVectorIndices word) [] (machineRationalTransposeMulVectorPayload word) (machineRationalTransposeMulVectorInputBound word) +/-- Packs four copies of the computed bound to bound the complete coordinate-scan state. -/ def machineRationalTransposeMulVectorWidth (word : List Bool) : List Bool := let bound := machineRationalTransposeMulVectorInputBound word machineRationalTransposeMulVectorPack bound bound bound bound +/-- Runs the transpose-product scan once per input bit from its initial state. -/ def machineRationalTransposeMulVectorFinalState (word : List Bool) : List Bool := (machineRationalTransposeMulVectorStep)^[word.length] (machineRationalTransposeMulVectorInit word) +/-- Extracts the transpose-product coordinates in reverse order from the final scan state. -/ def machineRationalTransposeMulVectorReversedCode (word : List Bool) : List Bool := machineRationalTransposeMulVectorAccumulator @@ -348,6 +375,8 @@ theorem machineRationalTransposeMulVectorWidth_mem_FP : simp [machineRationalTransposeMulVectorBound, machineRationalTransposeMulVectorPack] +/-- Requires exact coordinate-state packing, all data fields bounded by the computed input +bound, and the prescribed bound word. -/ def MachineRationalTransposeMulVectorStateBound (word state : List Bool) : Prop := let bound := machineRationalTransposeMulVectorInputBound word @@ -473,12 +502,15 @@ theorem machineRationalTransposeMulVectorCode_mem_FP : /-! ## Exact iteration semantics -/ +/-- Lists the first `k` coordinates of the rational transpose-matrix vector product. -/ def rationalTransposePrefix {d : ℕ} (A : Matrix (Fin d) (Fin d) ℚ) (v : Fin d → ℚ) (k : ℕ) : List ℚ := ((List.finRange d).take k).map fun j ↦ rationalTransposeMulVector A v j +/-- Encodes the remaining coordinate indices and reversed transpose-product prefix after `k` +coordinates, retaining payload and bound. -/ def machineRationalTransposeMulVectorSemanticState {d : ℕ} (A : Matrix (Fin d) (Fin d) ℚ) (v : Fin d → ℚ) (k : ℕ) : List Bool := diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalUnary.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalUnary.lean index acc4862441..37e301a3db 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalUnary.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalUnary.lean @@ -23,10 +23,13 @@ namespace BeyondBethe open Complexity +/-- Negates a raw rational's signed numerator while preserving its denominator. -/ def machineRawRatNegCode (word : List Bool) : List Bool := pair (machineIntegerNegCode (machinePairFirst word)) (machinePairSecond word) +/-- Encodes the reciprocal of a nonzero raw rational using its old denominator with the original +numerator sign as the new numerator, and the old numerator magnitude as the new denominator. -/ def machineRawRatInvNonzeroCode (word : List Bool) : List Bool := pair (machineCanonicalIntegerFromSignedAbs @@ -34,21 +37,26 @@ def machineRawRatInvNonzeroCode (word : List Bool) : List Bool := (machinePairSecond word))) (machineIntegerNatAbsBits (machinePairFirst word)) +/-- Returns canonical raw zero for a zero numerator and the signed reciprocal code otherwise. -/ def machineRawRatInvCode (word : List Bool) : List Bool := machineIfEmpty (machineIntegerNatAbsBits (machinePairFirst word)) (pair [false] [true]) (machineRawRatInvNonzeroCode word) +/-- Multiplies the left raw rational by the totalized reciprocal of the right. -/ def machineRawRatDivCode (word : List Bool) : List Bool := machineRawRatMulCode (pair (machinePairFirst word) (machineRawRatInvCode (machinePairSecond word))) +/-- Normalizes a raw negation into the rational binary output encoding. -/ def machineRationalNegCode (word : List Bool) : List Bool := machineNormalizeRawRatBinaryCode (machineRawRatNegCode word) +/-- Normalizes a totalized raw reciprocal into the rational binary output encoding. -/ def machineRationalInvCode (word : List Bool) : List Bool := machineNormalizeRawRatBinaryCode (machineRawRatInvCode word) +/-- Normalizes a raw quotient into the rational binary output encoding. -/ def machineRationalDivCode (word : List Bool) : List Bool := machineNormalizeRawRatBinaryCode (machineRawRatDivCode word) diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalVectorDot.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalVectorDot.lean index b57eb722d5..a3d12660d6 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalVectorDot.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalVectorDot.lean @@ -26,42 +26,53 @@ namespace BeyondBethe open Complexity +/-- Packs the unprocessed left and right vectors, raw dot-product accumulator, and bound. -/ def machineRationalVectorDotPack (left right acc bound : List Bool) : List Bool := pair left (pair right (pair acc bound)) +/-- Extracts the unprocessed left vector from a dot-product state. -/ def machineRationalVectorDotLeft (state : List Bool) : List Bool := machinePairFirst state +/-- Extracts the unprocessed right vector from a dot-product state. -/ def machineRationalVectorDotRight (state : List Bool) : List Bool := machinePairFirst (machinePairSecond state) +/-- Extracts the raw dot-product accumulator from the scan state. -/ def machineRationalVectorDotAcc (state : List Bool) : List Bool := machinePairFirst (machinePairSecond (machinePairSecond state)) +/-- Extracts the accumulator length-bound word from a dot-product state. -/ def machineRationalVectorDotBound (state : List Bool) : List Bool := machinePairSecond (machinePairSecond (machinePairSecond state)) +/-- Reads the next encoded entry of the left vector in a dot-product scan. -/ def machineRationalVectorDotLeftEntry (state : List Bool) : List Bool := machineListHead (machineRationalVectorDotLeft state) +/-- Reads the next encoded entry of the right vector in a dot-product scan. -/ def machineRationalVectorDotRightEntry (state : List Bool) : List Bool := machineListHead (machineRationalVectorDotRight state) +/-- Multiplies the two current vector entries in raw rational arithmetic. -/ def machineRationalVectorDotProduct (state : List Bool) : List Bool := machineRawRatMulCode (pair (machineRationalVectorDotLeftEntry state) (machineRationalVectorDotRightEntry state)) +/-- Adds the current entry product to the raw dot-product accumulator. -/ def machineRationalVectorDotCandidate (state : List Bool) : List Bool := machineRawRatAddCode (pair (machineRationalVectorDotAcc state) (machineRationalVectorDotProduct state)) +/-- Truncates the updated dot-product accumulator to the stored bound length. -/ def machineRationalVectorDotNextAcc (state : List Bool) : List Bool := (machineRationalVectorDotCandidate state).take (machineRationalVectorDotBound state).length +/-- Consumes one entry from each vector and stores the bounded updated dot-product accumulator. -/ def machineRationalVectorDotAdvance (state : List Bool) : List Bool := machineRationalVectorDotPack (machineListTail (machineRationalVectorDotLeft state)) @@ -75,18 +86,23 @@ def machineRationalVectorDotStep (state : List Bool) : List Bool := (machineIfEmpty (machineRationalVectorDotRight state) state (machineRationalVectorDotAdvance state)) +/-- Applies the binary-multiplication width construction to bound the dot-product accumulator. -/ def machineRationalVectorDotInputBound (word : List Bool) : List Bool := machineBinaryMulWidth word +/-- Initializes the dot-product scan with both input vectors, zero raw accumulator, and computed +bound. -/ def machineRationalVectorDotInit (word : List Bool) : List Bool := machineRationalVectorDotPack (machinePairFirst word) (machinePairSecond word) (rawRatBinaryCode RawRat.zero) (machineRationalVectorDotInputBound word) +/-- Packs two input words and two bound words to bound the dot-product state. -/ def machineRationalVectorDotWidth (word : List Bool) : List Bool := let bound := machineRationalVectorDotInputBound word machineRationalVectorDotPack word word bound bound +/-- Runs the dot-product scan once per input bit from its initial state. -/ def machineRationalVectorDotFinalState (word : List Bool) : List Bool := (machineRationalVectorDotStep)^[word.length] (machineRationalVectorDotInit word) @@ -215,6 +231,8 @@ theorem machineRationalVectorDotWidth_mem_FP : (machineRationalVectorDotPack left right acc bound) = bound := by simp [machineRationalVectorDotBound, machineRationalVectorDotPack] +/-- Requires exact dot-product state packing, input-bounded remaining vectors, a bounded +accumulator, and the prescribed bound word. -/ def MachineRationalVectorDotStateBound (word state : List Bool) : Prop := state = machineRationalVectorDotPack @@ -322,12 +340,15 @@ theorem machineRationalVectorDotEntryCode_mem_FP : /-! ## Exact semantics -/ +/-- Sums both input widths plus two per paired entry, stopping when either list is exhausted. -/ def rawRatListDotCost : List ℚ → List ℚ → ℕ | q :: qs, r :: rs => rawRatWidth (rawRatOfRat q) + rawRatWidth (rawRatOfRat r) + 2 + rawRatListDotCost qs rs | _, _ => 0 +/-- Accumulates raw products of paired rational entries from left to right, stopping when either +list is exhausted. -/ def rawRatListDot : RawRat → List ℚ → List ℚ → RawRat | acc, q :: qs, r :: rs => rawRatListDot @@ -380,10 +401,15 @@ theorem rawRatListDotCost_le_codeLength : ∀ xs ys : List ℚ, omega structure RationalVectorDotSemState where + /-- The unprocessed left entries of the semantic dot-product scan. -/ left : List ℚ + /-- The unprocessed right entries of the semantic dot-product scan. -/ right : List ℚ + /-- The raw rational accumulator of the semantic dot-product scan. -/ acc : RawRat +/-- Adds one paired-entry product and drops both entries, fixing the semantic state when either +list is empty. -/ def rationalVectorDotSemStep (s : RationalVectorDotSemState) : RationalVectorDotSemState := match s.left, s.right with @@ -391,6 +417,8 @@ def rationalVectorDotSemStep ⟨qs, rs, s.acc.add ((rawRatOfRat q).mul (rawRatOfRat r))⟩ | _, _ => s +/-- Encodes the semantic remaining vectors and raw dot-product accumulator with the supplied +bound. -/ def rationalVectorDotSemCode (bound : List Bool) (s : RationalVectorDotSemState) : List Bool := machineRationalVectorDotPack @@ -398,6 +426,8 @@ def rationalVectorDotSemCode (bound : List Bool) (binaryListCode rationalEntryBinaryCode s.right) (rawRatBinaryCode s.acc) bound +/-- Bounds the raw accumulator width plus the remaining paired-entry cost by the specified +budget. -/ def RationalVectorDotSemInvariant (budget : ℕ) (s : RationalVectorDotSemState) : Prop := rawRatWidth s.acc + rawRatListDotCost s.left s.right ≤ budget diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalVectorL1.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalVectorL1.lean index 673e7c13ec..f5329b9a6c 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalVectorL1.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalVectorL1.lean @@ -85,55 +85,69 @@ theorem machineRawRatMagnitudeCode_mem_FP : rw [machineCanonicalIntegerFromSignedAbs_pair] simp [signedMagnitudeValue, rawRatBinaryCode] +/-- Packs the remaining vector, raw L1 accumulator, and bound word. -/ def machineRationalVectorL1Pack (current acc bound : List Bool) : List Bool := pair current (pair acc bound) +/-- Extracts the unprocessed vector from an L1 scan state. -/ def machineRationalVectorL1Current (state : List Bool) : List Bool := machinePairFirst state +/-- Extracts the raw accumulated L1 sum from the scan state. -/ def machineRationalVectorL1Acc (state : List Bool) : List Bool := machinePairFirst (machinePairSecond state) +/-- Extracts the accumulator length-bound word from an L1 scan state. -/ def machineRationalVectorL1Bound (state : List Bool) : List Bool := machinePairSecond (machinePairSecond state) +/-- Reads the next rational entry of the L1 scan. -/ def machineRationalVectorL1Entry (state : List Bool) : List Bool := machineListHead (machineRationalVectorL1Current state) +/-- Computes the raw magnitude of the next rational vector entry. -/ def machineRationalVectorL1Magnitude (state : List Bool) : List Bool := machineRawRatMagnitudeCode (machineRationalVectorL1Entry state) +/-- Adds the next entry's magnitude to the raw L1 accumulator. -/ def machineRationalVectorL1Candidate (state : List Bool) : List Bool := machineRawRatAddCode (pair (machineRationalVectorL1Acc state) (machineRationalVectorL1Magnitude state)) +/-- Truncates the updated L1 accumulator to the stored bound length. -/ def machineRationalVectorL1NextAcc (state : List Bool) : List Bool := (machineRationalVectorL1Candidate state).take (machineRationalVectorL1Bound state).length +/-- Consumes the next vector entry and stores the bounded updated L1 accumulator. -/ def machineRationalVectorL1Advance (state : List Bool) : List Bool := machineRationalVectorL1Pack (machineListTail (machineRationalVectorL1Current state)) (machineRationalVectorL1NextAcc state) (machineRationalVectorL1Bound state) +/-- Fixes an exhausted L1 scan and otherwise processes its next entry. -/ def machineRationalVectorL1Step (state : List Bool) : List Bool := machineIfEmpty (machineRationalVectorL1Current state) state (machineRationalVectorL1Advance state) +/-- Applies the binary-multiplication width construction to bound the L1 accumulator. -/ def machineRationalVectorL1InputBound (word : List Bool) : List Bool := machineBinaryMulWidth word +/-- Initializes the L1 scan with the input vector, zero raw accumulator, and computed bound. -/ def machineRationalVectorL1Init (word : List Bool) : List Bool := machineRationalVectorL1Pack word (rawRatBinaryCode RawRat.zero) (machineRationalVectorL1InputBound word) +/-- Packs the input vector and two bound words to bound the complete L1 scan state. -/ def machineRationalVectorL1Width (word : List Bool) : List Bool := let bound := machineRationalVectorL1InputBound word machineRationalVectorL1Pack word bound bound +/-- Runs the L1 scan once per input bit from its initial state. -/ def machineRationalVectorL1FinalState (word : List Bool) : List Bool := (machineRationalVectorL1Step)^[word.length] (machineRationalVectorL1Init word) @@ -229,6 +243,8 @@ theorem machineRationalVectorL1Width_mem_FP : (machineRationalVectorL1Pack current acc bound) = bound := by simp [machineRationalVectorL1Bound, machineRationalVectorL1Pack] +/-- Requires exact L1 state packing, input-bounded remaining vector, a bounded accumulator, and +the prescribed bound word. -/ def MachineRationalVectorL1StateBound (word state : List Bool) : Prop := state = machineRationalVectorL1Pack @@ -321,6 +337,7 @@ theorem machineRationalVectorL1EntryCode_mem_FP : /-! ## Exact semantics -/ +/-- Adds rational entry magnitudes into a raw accumulator from left to right. -/ def rawRatListL1Sum : RawRat → List ℚ → RawRat | acc, [] => acc | acc, q :: qs => @@ -341,21 +358,26 @@ theorem rawRatWidth_listL1Sum_le (acc : RawRat) : ∀ xs : List ℚ, omega structure RationalVectorL1SemState where + /-- The unprocessed entries of the semantic L1 scan. -/ current : List ℚ + /-- The raw rational accumulator of the semantic L1 scan. -/ acc : RawRat +/-- Adds the next entry's magnitude and consumes it, fixing an exhausted semantic L1 state. -/ def rationalVectorL1SemStep (s : RationalVectorL1SemState) : RationalVectorL1SemState := match s.current with | q :: qs => ⟨qs, s.acc.add (rawRatOfRat q).magnitude⟩ | [] => s +/-- Encodes the semantic remaining vector and raw L1 accumulator with the supplied bound. -/ def rationalVectorL1SemCode (bound : List Bool) (s : RationalVectorL1SemState) : List Bool := machineRationalVectorL1Pack (binaryListCode rationalEntryBinaryCode s.current) (rawRatBinaryCode s.acc) bound +/-- Bounds the raw L1 accumulator width plus the remaining list cost by the specified budget. -/ def RationalVectorL1SemInvariant (budget : ℕ) (s : RationalVectorL1SemState) : Prop := rawRatWidth s.acc + rawRatListCost s.current ≤ budget diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalVectorScale.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalVectorScale.lean index 1875851b03..bfcdb469e6 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalVectorScale.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalVectorScale.lean @@ -24,15 +24,19 @@ namespace BeyondBethe open Complexity +/-- Multiplies every rational vector coordinate by the scalar `s`. -/ def rationalVectorScale {d : ℕ} (s : ℚ) (v : Fin d → ℚ) : Fin d → ℚ := fun i ↦ s * v i +/-- Computes raw one divided by the requested vector-scaling factor. -/ def machineRationalVectorScaleReciprocalCode (word : List Bool) : List Bool := machineRawRatDivCode (pair (rawRatBinaryCode RawRat.one) (machinePairFirst word)) +/-- Scales the encoded vector by dividing each entry by the totalized reciprocal of the +requested factor. -/ def machineRationalVectorScaleCode (word : List Bool) : List Bool := machineRationalRowDivide diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalVectorSub.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalVectorSub.lean index e5a566a5b1..3ebc45e79b 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalVectorSub.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalVectorSub.lean @@ -24,10 +24,13 @@ namespace BeyondBethe open Complexity +/-- Subtracts rational vectors coordinatewise. -/ def rationalVectorSub {d : ℕ} (x y : Fin d → ℚ) : Fin d → ℚ := fun i ↦ x i - y i +/-- Looks up both requested vector entries, subtracts them in raw arithmetic, and normalizes the +resulting entry code. -/ def machineRationalVectorSubEntryCode (word : List Bool) : List Bool := let index := machinePairFirst word @@ -77,6 +80,7 @@ theorem machineRationalVectorSubEntryCode_mem_FP : · simp · simp +/-- Computes one rational vector-difference coordinate in raw arithmetic. -/ def rawRationalVectorSubCoordinate {d : ℕ} (x y : Fin d → ℚ) (i : Fin d) : RawRat := (rawRatOfRat (x i)).sub (rawRatOfRat (y i)) @@ -89,6 +93,7 @@ theorem rawRationalVectorSubCoordinate_value {d : ℕ} RawRat.sub, RawRat.value_add, RawRat.value_neg, rawRatOfRat_value, sub_eq_add_neg] +/-- Encodes unary dimension followed by both rational vectors for subtraction. -/ def rationalVectorSubCanonicalWord {d : ℕ} (x y : Fin d → ℚ) : List Bool := pair (List.replicate d true) @@ -156,6 +161,7 @@ theorem rationalVectorSub_entry_code_length_le {d : ℕ} have hwidth := rawRationalVectorSubCoordinate_width_le x y i omega +/-- Reuses the transpose-matrix vector input bound for the vector-subtraction scan. -/ def machineRationalVectorSubInputBound (word : List Bool) : List Bool := machineRationalTransposeMulVectorInputBound word @@ -200,22 +206,26 @@ theorem rationalVectorSub_code_length_le_bound {d : ℕ} /-! ## Bounded scan -/ +/-- Computes the normalized difference entry at the current scan index. -/ def machineRationalVectorSubCurrentEntry (state : List Bool) : List Bool := machineRationalVectorSubEntryCode (pair (machineRationalTransposeMulVectorCurrentIndex state) (machineRationalTransposeMulVectorStatePayload state)) +/-- Prepends the current difference entry to the reverse-order accumulator. -/ def machineRationalVectorSubCandidate (state : List Bool) : List Bool := pair (machineRationalVectorSubCurrentEntry state) (machineRationalTransposeMulVectorAccumulator state) +/-- Truncates the candidate difference accumulator to the stored bound length. -/ def machineRationalVectorSubNextAccumulator (state : List Bool) : List Bool := (machineRationalVectorSubCandidate state).take (machineRationalTransposeMulVectorBound state).length +/-- Consumes the current coordinate index and stores the bounded updated difference accumulator. -/ def machineRationalVectorSubAdvance (state : List Bool) : List Bool := machineRationalTransposeMulVectorPack @@ -224,31 +234,38 @@ def machineRationalVectorSubAdvance (machineRationalTransposeMulVectorStatePayload state) (machineRationalTransposeMulVectorBound state) +/-- Fixes an exhausted vector-subtraction scan and otherwise computes its next entry. -/ def machineRationalVectorSubStep (state : List Bool) : List Bool := machineIfEmpty (machineRationalTransposeMulVectorRemaining state) state (machineRationalVectorSubAdvance state) +/-- Initializes subtraction with all coordinate indices, empty accumulator, both-vector payload, +and computed bound. -/ def machineRationalVectorSubInit (word : List Bool) : List Bool := machineRationalTransposeMulVectorPack (machineRationalTransposeMulVectorIndices word) [] (machineRationalTransposeMulVectorPayload word) (machineRationalVectorSubInputBound word) +/-- Packs four copies of the computed bound to bound the vector-subtraction state. -/ def machineRationalVectorSubWidth (word : List Bool) : List Bool := let bound := machineRationalVectorSubInputBound word machineRationalTransposeMulVectorPack bound bound bound bound +/-- Runs the vector-subtraction scan once per input bit from its initial state. -/ def machineRationalVectorSubFinalState (word : List Bool) : List Bool := (machineRationalVectorSubStep)^[word.length] (machineRationalVectorSubInit word) +/-- Extracts the difference entries in reverse order from the final scan state. -/ def machineRationalVectorSubReversedCode (word : List Bool) : List Bool := machineRationalTransposeMulVectorAccumulator (machineRationalVectorSubFinalState word) +/-- Reverses the accumulated entries to return the difference vector in coordinate order. -/ def machineRationalVectorSubCode (word : List Bool) : List Bool := machineListReverse (machineRationalVectorSubReversedCode word) @@ -377,10 +394,13 @@ theorem machineRationalVectorSubCode_mem_FP : /-! ## Exact scan semantics -/ +/-- Lists the first `k` coordinates of the rational vector difference. -/ def rationalVectorSubPrefix {d : ℕ} (x y : Fin d → ℚ) (k : ℕ) : List ℚ := ((List.finRange d).take k).map fun i ↦ rationalVectorSub x y i +/-- Encodes remaining coordinate indices and the reversed difference prefix after `k` +coordinates, retaining both vectors and the bound. -/ def machineRationalVectorSubSemanticState {d : ℕ} (x y : Fin d → ℚ) (k : ℕ) : List Bool := let word := rationalVectorSubCanonicalWord x y diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalVectorSum.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalVectorSum.lean index e65eda4b1d..e5e19ce36b 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineRationalVectorSum.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRationalVectorSum.lean @@ -76,6 +76,8 @@ list. The unused matrix-dimension component is the empty word. -/ def machineRationalVectorAsRowsWord (word : List Bool) : List Bool := pair [] (pair word []) +/-- Sums the encoded rational vector by viewing it as matrix rows and reusing the raw matrix-sum +machine. -/ def machineRationalVectorRawSumCode (word : List Bool) : List Bool := machineMatrixRawSumCode (machineRationalVectorAsRowsWord word) diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRepeatPair.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRepeatPair.lean index 68534a2cd1..b2499d3666 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineRepeatPair.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRepeatPair.lean @@ -27,6 +27,7 @@ matrices. Its iteration count is supplied in unary and its accumulator is clamped by an explicit quadratic envelope. -/ +/-- Prepends `n` copies of an encoded item to the supplied tail through nested pairing. -/ def repeatPairCode : ℕ → List Bool → List Bool → List Bool | 0, _, tail => tail | n + 1, item, tail => pair item (repeatPairCode n item tail) @@ -57,56 +58,71 @@ theorem repeatPairCode_binaryListCode {α : Type*} rw [repeatPairCode_succ, ih] simp only [List.replicate_succ, List.cons_append, binaryListCode] +/-- Extracts the unary repetition ruler from a repeated-pair request. -/ def machineRepeatPairRuler (word : List Bool) : List Bool := machinePairFirst word +/-- Extracts the encoded item to repeat from a repeated-pair request. -/ def machineRepeatPairItem (word : List Bool) : List Bool := machinePairFirst (machinePairSecond word) +/-- Extracts the encoded tail following the repeated items. -/ def machineRepeatPairTail (word : List Bool) : List Bool := machinePairSecond (machinePairSecond word) +/-- Applies the binary-multiplication width construction to bound repeated pairing. -/ def machineRepeatPairBound (word : List Bool) : List Bool := machineBinaryMulWidth word +/-- Packs the fixed repeated item, accumulated tail, and length bound. -/ def machineRepeatPairPack (item acc bound : List Bool) : List Bool := pair item (pair acc bound) +/-- Extracts the fixed item from a repeated-pair state. -/ def machineRepeatPairStateItem (state : List Bool) : List Bool := machinePairFirst state +/-- Extracts the accumulated encoded tail from a repeated-pair state. -/ def machineRepeatPairStateAcc (state : List Bool) : List Bool := machinePairFirst (machinePairSecond state) +/-- Extracts the length-bound word from a repeated-pair state. -/ def machineRepeatPairStateBound (state : List Bool) : List Bool := machinePairSecond (machinePairSecond state) +/-- Prepends one copy of the fixed item to the accumulated tail. -/ def machineRepeatPairCandidate (state : List Bool) : List Bool := pair (machineRepeatPairStateItem state) (machineRepeatPairStateAcc state) +/-- Truncates the candidate repeated-pair accumulator to the stored bound length. -/ def machineRepeatPairNextAcc (state : List Bool) : List Bool := (machineRepeatPairCandidate state).take (machineRepeatPairStateBound state).length +/-- Updates the bounded accumulator while preserving the repeated item and bound. -/ def machineRepeatPairStep (state : List Bool) : List Bool := machineRepeatPairPack (machineRepeatPairStateItem state) (machineRepeatPairNextAcc state) (machineRepeatPairStateBound state) +/-- Initializes repeated pairing with the requested item, initial tail, and computed bound. -/ def machineRepeatPairInit (word : List Bool) : List Bool := machineRepeatPairPack (machineRepeatPairItem word) (machineRepeatPairTail word) (machineRepeatPairBound word) +/-- Packs three copies of the computed bound to bound the repeated-pair state. -/ def machineRepeatPairWidth (word : List Bool) : List Bool := machineRepeatPairPack (machineRepeatPairBound word) (machineRepeatPairBound word) (machineRepeatPairBound word) +/-- Iterates bounded pairing for the length of the unary repetition ruler. -/ def machineRepeatPairFinalState (word : List Bool) : List Bool := (machineRepeatPairStep)^[(machineRepeatPairRuler word).length] (machineRepeatPairInit word) +/-- Extracts the final repeated-pair accumulator. -/ def machineRepeatPairCode (word : List Bool) : List Bool := machineRepeatPairStateAcc (machineRepeatPairFinalState word) @@ -177,6 +193,8 @@ theorem machineRepeatPairWidth_mem_FP : machineRepeatPairWidth ∈ FP := machineRepeatPairStateBound (machineRepeatPairPack a b c) = c := by simp [machineRepeatPairStateBound, machineRepeatPairPack] +/-- Requires exact repeated-pair state packing and bounds all three field lengths by the +input-derived bound. -/ def MachineRepeatPairStateBound (word state : List Bool) : Prop := let B := (machineRepeatPairBound word).length state = machineRepeatPairPack @@ -251,10 +269,12 @@ theorem machineRepeatPairCode_mem_FP : machineRepeatPairCode ∈ FP := by /-! ## Exact semantics on well-formed unary calls -/ +/-- Encodes unary repetition count `n` followed by the item and initial tail. -/ def machineRepeatPairCanonicalInput (n : ℕ) (item tail : List Bool) : List Bool := pair (List.replicate n true) (pair item tail) +/-- Encodes the semantic state containing `k` repeated items before the original tail. -/ def machineRepeatPairCanonicalState (n : ℕ) (item tail : List Bool) (k : ℕ) : List Bool := let word := machineRepeatPairCanonicalInput n item tail diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRowComplementUpperSum.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRowComplementUpperSum.lean index 199d124ce5..62ad349366 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineRowComplementUpperSum.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRowComplementUpperSum.lean @@ -28,49 +28,64 @@ namespace BeyondBethe open Complexity +/-- Packs the source request, unprocessed row, raw upper-sum accumulator, and bound. -/ def machineRowUpperPack (source current acc bound : List Bool) : List Bool := pair source (pair current (pair acc bound)) +/-- Extracts the fixed request from a row-complement upper-sum state. -/ def machineRowUpperSource (state : List Bool) : List Bool := machinePairFirst state +/-- Extracts the unprocessed row suffix from a row-complement upper-sum state. -/ def machineRowUpperCurrent (state : List Bool) : List Bool := machinePairFirst (machinePairSecond state) +/-- Extracts the raw accumulated upper sum from the row scan state. -/ def machineRowUpperAcc (state : List Bool) : List Bool := machinePairFirst (machinePairSecond (machinePairSecond state)) +/-- Extracts the accumulator length-bound word from the row scan state. -/ def machineRowUpperBound (state : List Bool) : List Bool := machinePairSecond (machinePairSecond (machinePairSecond state)) +/-- Extracts the unary selected-row index from a row-complement upper-sum request. -/ def machineRowUpperRowRuler (word : List Bool) : List Bool := machinePairFirst word +/-- Extracts the optimizer payload from a row-complement upper-sum request. -/ def machineRowUpperOptimizerWord (word : List Bool) : List Bool := machinePairSecond word +/-- Reads the encoded matrix from the optimizer payload of the row-sum request. -/ def machineRowUpperMatrixWord (word : List Bool) : List Bool := machineOptimizerMatrixWord (machineRowUpperOptimizerWord word) +/-- Looks up the selected matrix row to initialize the upper-sum scan. -/ def machineRowUpperInitialRow (word : List Bool) : List Bool := machineListIndex (pair (machineRowUpperRowRuler word) (machineMatrixRowsWord (machineRowUpperMatrixWord word))) +/-- Reads the next rational entry of the current row suffix. -/ def machineRowUpperEntry (state : List Bool) : List Bool := machineListHead (machineRowUpperCurrent state) +/-- Packages certificate precision, zero reference parameter, and current entry for complement +evaluation. -/ def machineRowUpperComplementInput (state : List Bool) : List Bool := pair (machineCertificateLogPrecisionRuler (machineRowUpperOptimizerWord (machineRowUpperSource state))) (pair (rawRatBinaryCode RawRat.zero) (machineRowUpperEntry state)) +/-- Computes the normalized complement of the current row entry. -/ def machineRowUpperComplementCode (state : List Bool) : List Bool := machineNearbyCoordinateComplementCode (machineRowUpperComplementInput state) +/-- Computes the scheduled upper logarithm approximation of the current entry's complement at +certificate precision. -/ def machineRowUpperLogRawCode (state : List Bool) : List Bool := machineScheduledLogUpperRawCode (pair @@ -78,13 +93,17 @@ def machineRowUpperLogRawCode (state : List Bool) : List Bool := (machineRowUpperOptimizerWord (machineRowUpperSource state))) (machineRowUpperComplementCode state)) +/-- Adds the current complement-logarithm upper approximation to the raw accumulator. -/ def machineRowUpperCandidate (state : List Bool) : List Bool := machineRawRatAddCode (pair (machineRowUpperAcc state) (machineRowUpperLogRawCode state)) +/-- Truncates the updated upper-sum accumulator to the stored bound length. -/ def machineRowUpperNextAcc (state : List Bool) : List Bool := (machineRowUpperCandidate state).take (machineRowUpperBound state).length +/-- Fixes an exhausted row scan and otherwise consumes one entry while accumulating its bounded +upper logarithm term. -/ def machineRowUpperStep (state : List Bool) : List Bool := machineIfEmpty (machineRowUpperCurrent state) state (machineRowUpperPack @@ -93,18 +112,24 @@ def machineRowUpperStep (state : List Bool) : List Bool := (machineRowUpperNextAcc state) (machineRowUpperBound state)) +/-- Applies the binary-multiplication width construction three times to bound the row-complement +upper sum. -/ def machineRowUpperInputBound (word : List Bool) : List Bool := machineBinaryMulWidth (machineBinaryMulWidth (machineBinaryMulWidth word)) +/-- Initializes the row scan with its fixed request, selected matrix row, zero accumulator, and +computed bound. -/ def machineRowUpperInit (word : List Bool) : List Bool := machineRowUpperPack word (machineRowUpperInitialRow word) (rawRatBinaryCode RawRat.zero) (machineRowUpperInputBound word) +/-- Packs two input words and two bound words to bound the upper-sum scan state. -/ def machineRowUpperWidth (word : List Bool) : List Bool := let bound := machineRowUpperInputBound word machineRowUpperPack word word bound bound +/-- Runs the row-complement upper-sum scan once per input bit from its initial state. -/ def machineRowUpperFinalState (word : List Bool) : List Bool := (machineRowUpperStep)^[word.length] (machineRowUpperInit word) @@ -230,6 +255,8 @@ theorem machineRowUpperWidth_mem_FP : machineRowUpperWidth ∈ FP := by machineRowUpperBound (machineRowUpperPack source current acc bound) = bound := by simp [machineRowUpperBound, machineRowUpperPack] +/-- Requires exact row-scan packing, the original source, input-bounded current row, bounded +accumulator, and prescribed bound word. -/ def MachineRowUpperStateBound (word state : List Bool) : Prop := state = machineRowUpperPack (machineRowUpperSource state) (machineRowUpperCurrent state) (machineRowUpperAcc state) @@ -316,9 +343,13 @@ theorem machineRowComplementUpperSumRawCode_mem_FP : /-! ## Exact semantics -/ +/-- Sums the raw widths of scheduled upper complement logarithms, adding one per row entry for +accumulator growth. -/ def rawRowComplementUpperCost (p : ℕ) (xs : List ℚ) : ℕ := (xs.map fun q => rawRatWidth (rawScheduledLogUpper (1 - q) p) + 1).sum +/-- Accumulates scheduled upper logarithms of entry complements from left to right at precision +`p`. -/ def rawRowComplementUpperSum (p : ℕ) : RawRat → List ℚ → RawRat | acc, [] => acc | acc, q :: qs => @@ -326,20 +357,28 @@ def rawRowComplementUpperSum (p : ℕ) : RawRat → List ℚ → RawRat (acc.add (rawScheduledLogUpper (1 - q) p)) qs structure RowUpperSemState where + /-- The unprocessed rational row suffix of the semantic upper-sum scan. -/ current : List ℚ + /-- The raw rational accumulator of the semantic row upper-sum scan. -/ acc : RawRat +/-- Adds one scheduled upper complement logarithm and consumes its entry, fixing an exhausted +semantic state. -/ def rowUpperSemStep (p : ℕ) (s : RowUpperSemState) : RowUpperSemState := match s.current with | [] => s | q :: qs => ⟨qs, s.acc.add (rawScheduledLogUpper (1 - q) p)⟩ +/-- Encodes a semantic remaining row and raw upper-sum accumulator with the supplied source and +bound. -/ def rowUpperSemCode (source bound : List Bool) (s : RowUpperSemState) : List Bool := machineRowUpperPack source (binaryListCode rationalEntryBinaryCode s.current) (rawRatBinaryCode s.acc) bound +/-- Bounds the raw upper-sum accumulator width plus all remaining logarithm-term costs by the +supplied budget. -/ def RowUpperSemInvariant (p budget : ℕ) (s : RowUpperSemState) : Prop := rawRatWidth s.acc + rawRowComplementUpperCost p s.current ≤ budget @@ -504,6 +543,8 @@ theorem machineRowUpper_done_iterate rw [Function.iterate_succ_apply', ih] simp [machineRowUpperStep] +/-- Provides the explicit polynomial width budget for an upper complement-logarithm term from an +input-width bound `L`. -/ def rawRowComplementUpperInputWidthBudget (L : ℕ) : ℕ := 64 * ((L + 400) + 2 * (44 + 12 * L) + 4) ^ 2 * ((44 + 12 * L) + 2) diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRowPairDisjoint.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRowPairDisjoint.lean index bbe65050eb..67ab10dd61 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineRowPairDisjoint.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRowPairDisjoint.lean @@ -25,75 +25,96 @@ namespace BeyondBethe open Complexity +/-- Encodes an ordered row pair by pairing its two unary finite-index codes. -/ def orderedRowPairCode {n : ℕ} (q : Fin n × Fin n) : List Bool := pair (finUnaryCode q.1) (finUnaryCode q.2) +/-- Extracts the first candidate row ruler from a row-pair disjointness request. -/ def machineDisjointCandidateFirst (word : List Bool) : List Bool := machinePairFirst word +/-- Extracts the disjointness request payload after its first candidate row. -/ def machineDisjointRest (word : List Bool) : List Bool := machinePairSecond word +/-- Extracts the second candidate row ruler from a row-pair disjointness request. -/ def machineDisjointCandidateSecond (word : List Bool) : List Bool := machinePairFirst (machineDisjointRest word) +/-- Extracts the encoded list of already selected row pairs. -/ def machineDisjointSelectedList (word : List Bool) : List Bool := machinePairSecond (machineDisjointRest word) +/-- Packs the unprocessed selected-pair list, accumulated conflict bit, and fixed request. -/ def machineDisjointPack (remaining conflict source : List Bool) : List Bool := pair remaining (pair conflict source) +/-- Extracts the remaining selected pairs from a disjointness scan state. -/ def machineDisjointRemaining (state : List Bool) : List Bool := machinePairFirst state +/-- Extracts the accumulated conflict bit from a disjointness scan state. -/ def machineDisjointConflict (state : List Bool) : List Bool := machinePairFirst (machinePairSecond state) +/-- Extracts the fixed candidate-and-selected-list request from a disjointness state. -/ def machineDisjointSource (state : List Bool) : List Bool := machinePairSecond (machinePairSecond state) +/-- Reads the next selected row pair to compare with the candidate. -/ def machineDisjointCurrentPair (state : List Bool) : List Bool := machineListHead (machineDisjointRemaining state) +/-- Extracts the first row ruler of the current selected pair. -/ def machineDisjointCurrentFirst (state : List Bool) : List Bool := machinePairFirst (machineDisjointCurrentPair state) +/-- Extracts the second row ruler of the current selected pair. -/ def machineDisjointCurrentSecond (state : List Bool) : List Bool := machinePairSecond (machineDisjointCurrentPair state) +/-- Tests equality of ruler lengths by computing and comparing their binary lengths. -/ def machineUnaryRulersEqualBit (lhs rhs : List Bool) : List Bool := machineBinaryNatEqBit (pair (machineLengthBits lhs) (machineLengthBits rhs)) +/-- Compares the first candidate row with the first row of the current selected pair. -/ def machineDisjointIFirstBit (state : List Bool) : List Bool := machineUnaryRulersEqualBit (machineDisjointCandidateFirst (machineDisjointSource state)) (machineDisjointCurrentFirst state) +/-- Compares the first candidate row with the second row of the current selected pair. -/ def machineDisjointISecondBit (state : List Bool) : List Bool := machineUnaryRulersEqualBit (machineDisjointCandidateFirst (machineDisjointSource state)) (machineDisjointCurrentSecond state) +/-- Compares the second candidate row with the first row of the current selected pair. -/ def machineDisjointJFirstBit (state : List Bool) : List Bool := machineUnaryRulersEqualBit (machineDisjointCandidateSecond (machineDisjointSource state)) (machineDisjointCurrentFirst state) +/-- Compares the second candidate row with the second row of the current selected pair. -/ def machineDisjointJSecondBit (state : List Bool) : List Bool := machineUnaryRulersEqualBit (machineDisjointCandidateSecond (machineDisjointSource state)) (machineDisjointCurrentSecond state) +/-- Tests whether either candidate row coincides with either row of the current selected pair. -/ def machineDisjointCurrentConflictBit (state : List Bool) : List Bool := machineOrBit (machineDisjointIFirstBit state) (machineOrBit (machineDisjointISecondBit state) (machineOrBit (machineDisjointJFirstBit state) (machineDisjointJSecondBit state))) +/-- Pairs a false bit with the source request to form the disjointness scan's input-bound word. -/ def machineDisjointInputBound (word : List Bool) : List Bool := pair [false] word +/-- Accumulates the current row-pair conflict using Boolean disjunction and truncates the result +to the input-bound length. -/ def machineDisjointNextConflict (state : List Bool) : List Bool := (machineOrBit (machineDisjointConflict state) (machineDisjointCurrentConflictBit state)).take diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineUnaryGridGenerator.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineUnaryGridGenerator.lean index 550cfafa43..e3829871dd 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineUnaryGridGenerator.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineUnaryGridGenerator.lean @@ -749,8 +749,11 @@ structure UnaryGridSemanticState (m : ℕ) where row : Fin m column : Fin m accumulator : List ℚ + /-- Whether the semantic grid scan has included its final entry. -/ done : Bool +/-- Initializes a nonempty square-grid scan at row and column zero with empty accumulator and +unset completion flag. -/ def unaryGridSemanticInit {m : ℕ} (hm : 0 < m) : UnaryGridSemanticState m where row := ⟨0, hm⟩ @@ -758,6 +761,8 @@ def unaryGridSemanticInit {m : ℕ} (hm : 0 < m) : accumulator := [] done := false +/-- Prepends the current grid value, advances in row-major order, and marks the final position +complete; completed states are fixed. -/ def unaryGridSemanticStep {m : ℕ} (f : Fin m → Fin m → ℚ) (state : UnaryGridSemanticState m) : UnaryGridSemanticState m := @@ -777,6 +782,8 @@ def unaryGridSemanticStep {m : ℕ} column := ⟨state.column.1 + 1, by omega⟩ accumulator := nextAccumulator } +/-- Encodes semantic grid indices, reverse-order accumulator, completion flag, bound, and +canonical fixed payload. -/ def machineUnaryGridGeneratorSemanticCode {m : ℕ} (bound payload : List Bool) (state : UnaryGridSemanticState m) : List Bool := @@ -950,6 +957,7 @@ theorem machineUnaryGridGeneratorStep_semanticCode {m : ℕ} · simp [machineUnaryGridGeneratorStep, unaryGridSemanticStep, machineUnaryGridGeneratorSemanticCode] +/-- The row-major grid ordinal `row * m + column`. -/ def unaryGridOrdinal {m : ℕ} (row column : Fin m) : ℕ := row.1 * m + column.1 @@ -1013,10 +1021,12 @@ theorem unaryGridOrdinal_last {m : ℕ} simp [unaryGridOrdinal] nlinarith +/-- Lists all square-grid values in the order supplied by the finite product equivalence. -/ def unaryGridValues {m : ℕ} (f : Fin m → Fin m → ℚ) : List ℚ := List.ofFn (fun k : Fin (m * m) => f (finProdFinEquiv.symm k).1 (finProdFinEquiv.symm k).2) +/-- Takes the first `k` values from the complete grid-value list. -/ def unaryGridPrefix {m : ℕ} (f : Fin m → Fin m → ℚ) (k : ℕ) : List ℚ := (unaryGridValues f).take k @@ -1049,6 +1059,8 @@ theorem unaryGridPrefix_succ_of_ordinal {m k : ℕ} simpa only [List.concat_eq_append, hget] using! (List.take_concat_get hk).symm +/-- Relates a completed grid accumulator to all values in reverse order, or an unfinished +position at ordinal `k` to the reversed prefix. -/ def UnaryGridValueInvariant {m : ℕ} (f : Fin m → Fin m → ℚ) (k : ℕ) (state : UnaryGridSemanticState m) : Prop := @@ -1125,6 +1137,7 @@ theorem unaryGridSemanticStep_valueInvariant {m k : ℕ} rw [unaryGridOrdinal_nextColumn state.row state.column hcolumn, hordinal] +/-- Runs the semantic grid scan for exactly `k` steps from its nonempty initial state. -/ def unaryGridSemanticStateAt {m : ℕ} (hm : 0 < m) (f : Fin m → Fin m → ℚ) (k : ℕ) : UnaryGridSemanticState m := (unaryGridSemanticStep f)^[k] (unaryGridSemanticInit hm) diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineUnaryMatrixGenerator.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineUnaryMatrixGenerator.lean index 01d82dc660..9793bf52a6 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineUnaryMatrixGenerator.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineUnaryMatrixGenerator.lean @@ -29,44 +29,57 @@ namespace BeyondBethe open Complexity +/-- Extracts the unary dimension from a matrix-generation request. -/ def machineUnaryMatrixGeneratorDimension (word : List Bool) : List Bool := machinePairFirst word +/-- Extracts the bound-and-entry-payload portion of a matrix-generation request. -/ def machineUnaryMatrixGeneratorRest (word : List Bool) : List Bool := machinePairSecond word +/-- Extracts the output-bound word from a matrix-generation request. -/ def machineUnaryMatrixGeneratorInputBound (word : List Bool) : List Bool := machinePairFirst (machineUnaryMatrixGeneratorRest word) +/-- Extracts the fixed entry-function payload from a matrix-generation request. -/ def machineUnaryMatrixGeneratorInputPayload (word : List Bool) : List Bool := machinePairSecond (machineUnaryMatrixGeneratorRest word) +/-- Packs row and column indices, reversed current row, reversed completed rows, bound, +completion flag, and fixed request. -/ def machineUnaryMatrixGeneratorPack (row column current rows bound done payload : List Bool) : List Bool := pair row (pair column (pair current (pair rows (pair bound (pair done payload))))) +/-- Extracts the unary row index from a matrix-generation state. -/ def machineUnaryMatrixGeneratorRow (state : List Bool) : List Bool := machinePairFirst state +/-- Extracts the unary column index from a matrix-generation state. -/ def machineUnaryMatrixGeneratorColumn (state : List Bool) : List Bool := machinePairFirst (machinePairSecond state) +/-- Extracts the reversed current-row accumulator from a matrix-generation state. -/ def machineUnaryMatrixGeneratorCurrent (state : List Bool) : List Bool := machinePairFirst (machinePairSecond (machinePairSecond state)) +/-- Extracts the reverse-order completed-row accumulator from a matrix-generation state. -/ def machineUnaryMatrixGeneratorRows (state : List Bool) : List Bool := machinePairFirst (machinePairSecond (machinePairSecond (machinePairSecond state))) +/-- Extracts the output-bound word from a matrix-generation state. -/ def machineUnaryMatrixGeneratorBound (state : List Bool) : List Bool := machinePairFirst (machinePairSecond (machinePairSecond (machinePairSecond (machinePairSecond state)))) +/-- Extracts the completion flag from a matrix-generation state. -/ def machineUnaryMatrixGeneratorDone (state : List Bool) : List Bool := machinePairFirst (machinePairSecond (machinePairSecond (machinePairSecond (machinePairSecond (machinePairSecond state))))) +/-- Extracts the fixed request from a matrix-generation state. -/ def machineUnaryMatrixGeneratorPayload (state : List Bool) : List Bool := machinePairSecond (machinePairSecond (machinePairSecond (machinePairSecond (machinePairSecond (machinePairSecond state))))) @@ -113,60 +126,73 @@ def machineUnaryMatrixGeneratorPayload (state : List Bool) : List Bool := (machineUnaryMatrixGeneratorPack row column current rows bound done payload) = payload := by simp [machineUnaryMatrixGeneratorPayload, machineUnaryMatrixGeneratorPack] +/-- Reads the requested unary dimension from the matrix-generation state's fixed payload. -/ def machineUnaryMatrixGeneratorStateDimension (state : List Bool) : List Bool := machineUnaryMatrixGeneratorDimension (machineUnaryMatrixGeneratorPayload state) +/-- Packages the current row and column with the fixed entry-function payload. -/ def machineUnaryMatrixGeneratorEntryInput (state : List Bool) : List Bool := pair (machineUnaryMatrixGeneratorRow state) (pair (machineUnaryMatrixGeneratorColumn state) (machineUnaryMatrixGeneratorInputPayload (machineUnaryMatrixGeneratorPayload state))) +/-- Increments the unary row index and truncates it to the length of the fixed request. -/ def machineUnaryMatrixGeneratorNextRow (state : List Bool) : List Bool := (machineUnaryMatrixGeneratorRow state ++ [true]).take (machineUnaryMatrixGeneratorPayload state).length +/-- Increments the unary column index and truncates it to the length of the fixed request. -/ def machineUnaryMatrixGeneratorNextColumn (state : List Bool) : List Bool := (machineUnaryMatrixGeneratorColumn state ++ [true]).take (machineUnaryMatrixGeneratorPayload state).length +/-- Tests whether the next column ruler has reached the requested dimension. -/ def machineUnaryMatrixGeneratorColumnCompletesBit (state : List Bool) : List Bool := machineHeadBit (machineUnaryRulersEqualBit (machineUnaryMatrixGeneratorNextColumn state) (machineUnaryMatrixGeneratorStateDimension state)) +/-- Tests whether the next row ruler has reached the requested dimension. -/ def machineUnaryMatrixGeneratorRowCompletesBit (state : List Bool) : List Bool := machineHeadBit (machineUnaryRulersEqualBit (machineUnaryMatrixGeneratorNextRow state) (machineUnaryMatrixGeneratorStateDimension state)) +/-- Prepends the generated current entry to the reversed current-row accumulator. -/ def machineUnaryMatrixGeneratorCurrentCandidate (entry : List Bool → List Bool) (state : List Bool) : List Bool := pair (entry (machineUnaryMatrixGeneratorEntryInput state)) (machineUnaryMatrixGeneratorCurrent state) +/-- Truncates the updated current-row accumulator to the stored output-bound length. -/ def machineUnaryMatrixGeneratorNextCurrent (entry : List Bool → List Bool) (state : List Bool) : List Bool := (machineUnaryMatrixGeneratorCurrentCandidate entry state).take (machineUnaryMatrixGeneratorBound state).length +/-- Reverses the updated current-row accumulator to obtain a completed row in column order. -/ def machineUnaryMatrixGeneratorCompletedRow (entry : List Bool → List Bool) (state : List Bool) : List Bool := machineListReverse (machineUnaryMatrixGeneratorNextCurrent entry state) +/-- Prepends the completed current row to the reverse-order matrix accumulator. -/ def machineUnaryMatrixGeneratorRowsCandidate (entry : List Bool → List Bool) (state : List Bool) : List Bool := pair (machineUnaryMatrixGeneratorCompletedRow entry state) (machineUnaryMatrixGeneratorRows state) +/-- Truncates the updated completed-row accumulator to the stored output-bound length. -/ def machineUnaryMatrixGeneratorNextRows (entry : List Bool → List Bool) (state : List Bool) : List Bool := (machineUnaryMatrixGeneratorRowsCandidate entry state).take (machineUnaryMatrixGeneratorBound state).length +/-- Stores the final completed row, clears the current-row accumulator, and sets the matrix +completion flag. -/ def machineUnaryMatrixGeneratorFinish (entry : List Bool → List Bool) (state : List Bool) : List Bool := machineUnaryMatrixGeneratorPack @@ -176,6 +202,8 @@ def machineUnaryMatrixGeneratorFinish (machineUnaryMatrixGeneratorBound state) [true] (machineUnaryMatrixGeneratorPayload state) +/-- Stores the completed row, advances the row index, and resets the column and current-row +accumulators. -/ def machineUnaryMatrixGeneratorAdvanceRow (entry : List Bool → List Bool) (state : List Bool) : List Bool := machineUnaryMatrixGeneratorPack @@ -185,6 +213,8 @@ def machineUnaryMatrixGeneratorAdvanceRow (machineUnaryMatrixGeneratorDone state) (machineUnaryMatrixGeneratorPayload state) +/-- Advances the column index and updates the bounded current row while retaining completed +rows. -/ def machineUnaryMatrixGeneratorAdvanceColumn (entry : List Bool → List Bool) (state : List Bool) : List Bool := machineUnaryMatrixGeneratorPack @@ -196,6 +226,8 @@ def machineUnaryMatrixGeneratorAdvanceColumn (machineUnaryMatrixGeneratorDone state) (machineUnaryMatrixGeneratorPayload state) +/-- Finishes at the final row end, advances rows at other row ends, and otherwise generates the +next column. -/ def machineUnaryMatrixGeneratorProcess (entry : List Bool → List Bool) (state : List Bool) : List Bool := machineIfHead (machineUnaryMatrixGeneratorColumnCompletesBit state) @@ -204,48 +236,62 @@ def machineUnaryMatrixGeneratorProcess (machineUnaryMatrixGeneratorAdvanceRow entry state)) (machineUnaryMatrixGeneratorAdvanceColumn entry state) +/-- Fixes completed matrix-generation states and processes one entry otherwise. -/ def machineUnaryMatrixGeneratorStep (entry : List Bool → List Bool) (state : List Bool) : List Bool := machineIfHead (machineHeadBit (machineUnaryMatrixGeneratorDone state)) state (machineUnaryMatrixGeneratorProcess entry state) +/-- Initializes matrix generation with zero indices, empty row accumulators, supplied bound, and +unset completion flag. -/ def machineUnaryMatrixGeneratorInit (word : List Bool) : List Bool := machineUnaryMatrixGeneratorPack [] [] [] [] (machineUnaryMatrixGeneratorInputBound word) [false] word +/-- Converts the unary matrix dimension to its binary length. -/ def machineUnaryMatrixGeneratorDimensionBits (word : List Bool) : List Bool := machineLengthBits (machineUnaryMatrixGeneratorDimension word) +/-- Computes the square of the matrix dimension in binary as the generation work count. -/ def machineUnaryMatrixGeneratorWorkBits (word : List Bool) : List Bool := machineBinaryMulBits (pair (machineUnaryMatrixGeneratorDimensionBits word) (machineUnaryMatrixGeneratorDimensionBits word)) +/-- Applies the binary-multiplication width construction to guard conversion of the work count +to unary. -/ def machineUnaryMatrixGeneratorGuard (word : List Bool) : List Bool := machineBinaryMulWidth word +/-- Converts the squared dimension to a bounded unary iteration ruler. -/ def machineUnaryMatrixGeneratorRuler (word : List Bool) : List Bool := machineBoundedUnary (pair (machineUnaryMatrixGeneratorGuard word) (machineUnaryMatrixGeneratorWorkBits word)) +/-- Adds sixteen padding bits and applies the binary-width construction twice to obtain a common +state-field envelope. -/ def machineUnaryMatrixGeneratorEnvelope (word : List Bool) : List Bool := machineIteratedBinaryWidth 2 (word ++ List.replicate 16 false) +/-- Packs seven copies of the common envelope to bound the full matrix-generation state. -/ def machineUnaryMatrixGeneratorWidth (word : List Bool) : List Bool := let envelope := machineUnaryMatrixGeneratorEnvelope word machineUnaryMatrixGeneratorPack envelope envelope envelope envelope envelope envelope envelope +/-- Iterates matrix generation for the length of the computed work ruler. -/ def machineUnaryMatrixGeneratorFinalState (entry : List Bool → List Bool) (word : List Bool) : List Bool := (machineUnaryMatrixGeneratorStep entry)^[(machineUnaryMatrixGeneratorRuler word).length] (machineUnaryMatrixGeneratorInit word) +/-- Extracts the completed matrix rows in reverse order from the final generation state. -/ def machineUnaryMatrixGeneratorReversedRowsCode (entry : List Bool → List Bool) (word : List Bool) : List Bool := machineUnaryMatrixGeneratorRows (machineUnaryMatrixGeneratorFinalState entry word) +/-- Reverses the accumulated completed rows to restore the original row order. -/ def machineUnaryMatrixGeneratorRowsCode (entry : List Bool → List Bool) (word : List Bool) : List Bool := machineListReverse (machineUnaryMatrixGeneratorReversedRowsCode entry word) @@ -503,6 +549,8 @@ theorem machineUnaryMatrixGeneratorWidth_mem_FP : (machinePair_mem_FP h (machinePair_mem_FP h (machinePair_mem_FP h h))))) +/-- Requires exact matrix-state packing, input-bounded indices, bounded current and completed +rows, fixed bound and request, and at most one completion bit. -/ def MachineUnaryMatrixGeneratorStateBound (word state : List Bool) : Prop := state = machineUnaryMatrixGeneratorPack @@ -737,6 +785,7 @@ theorem machineUnaryMatrixGeneratorRowsCode_mem_FP /-! ## Canonical inputs and exact traversal -/ +/-- Encodes unary dimension `m` followed by the supplied output bound and fixed entry payload. -/ def machineUnaryMatrixGeneratorCanonicalWord (m : ℕ) (bound payload : List Bool) : List Bool := pair (List.replicate m true) (pair bound payload) @@ -802,6 +851,7 @@ theorem machineUnaryMatrixGeneratorWork_le_guard /-! ## Typed row-major semantics -/ +/-- Lists the matrix rows and their entries in finite-index order. -/ def unaryMatrixRows {m : ℕ} (f : Fin m → Fin m → ℚ) : List (List ℚ) := List.ofFn fun i ↦ List.ofFn fun j ↦ f i j @@ -816,17 +866,22 @@ def unaryMatrixRows {m : ℕ} List.ofFn (f ⟨i, by simpa using! hi⟩) := by simp [unaryMatrixRows] +/-- Returns the reversed processed prefix of the current row, or the empty row after completion. -/ def unaryMatrixCurrent {m : ℕ} (f : Fin m → Fin m → ℚ) (state : UnaryGridSemanticState m) : List ℚ := if state.done then [] else (List.ofFn (f state.row)).take state.column.1 |>.reverse +/-- Returns all completed rows in reverse order, using the whole matrix when the scan is +complete. -/ def unaryMatrixCompletedRows {m : ℕ} (f : Fin m → Fin m → ℚ) (state : UnaryGridSemanticState m) : List (List ℚ) := if state.done then (unaryMatrixRows f).reverse else ((unaryMatrixRows f).take state.row.1).reverse +/-- Encodes the semantic grid position together with its reversed current-row prefix and +reversed completed rows. -/ def machineUnaryMatrixGeneratorSemanticCode {m : ℕ} (f : Fin m → Fin m → ℚ) (bound payload : List Bool) (state : UnaryGridSemanticState m) : List Bool := diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineUnaryRange.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineUnaryRange.lean index 77bc3e990e..efdb396fff 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineUnaryRange.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineUnaryRange.lean @@ -24,51 +24,67 @@ namespace BeyondBethe open Complexity +/-- Encodes a finite index as a ruler containing that many true bits. -/ def finUnaryCode {n : ℕ} (i : Fin n) : List Bool := List.replicate i.1 true +/-- Encodes the complete range of finite indices using unary codes in increasing order. -/ def finRangeUnaryCode (n : ℕ) : List Bool := binaryListCode finUnaryCode (List.finRange n) +/-- Packs the remaining unary countdown, accumulated encoded range, and bound. -/ def machineUnaryRangePack (remaining acc bound : List Bool) : List Bool := pair remaining (pair acc bound) +/-- Extracts the remaining countdown ruler from a unary-range state. -/ def machineUnaryRangeRemaining (state : List Bool) : List Bool := machinePairFirst state +/-- Extracts the accumulated encoded index range from a unary-range state. -/ def machineUnaryRangeAcc (state : List Bool) : List Bool := machinePairFirst (machinePairSecond state) +/-- Extracts the accumulator length-bound word from a unary-range state. -/ def machineUnaryRangeBound (state : List Bool) : List Bool := machinePairSecond (machinePairSecond state) +/-- Prepends the predecessor countdown ruler to the accumulated range. -/ def machineUnaryRangeCandidate (state : List Bool) : List Bool := pair (machineUnaryRangeRemaining state).tail (machineUnaryRangeAcc state) +/-- Truncates the candidate range accumulator to the stored bound length. -/ def machineUnaryRangeNextAcc (state : List Bool) : List Bool := (machineUnaryRangeCandidate state).take (machineUnaryRangeBound state).length +/-- Fixes an exhausted countdown and otherwise decreases it while prepending the next bounded +range entry. -/ def machineUnaryRangeStep (state : List Bool) : List Bool := machineIfEmpty (machineUnaryRangeRemaining state) state (machineUnaryRangePack (machineUnaryRangeRemaining state).tail (machineUnaryRangeNextAcc state) (machineUnaryRangeBound state)) +/-- Reuses the list-update input bound to bound unary-range generation. -/ def machineUnaryRangeInputBound (ruler : List Bool) : List Bool := machineListUpdateInputBound ruler +/-- Initializes unary-range generation with the input countdown, empty accumulator, and computed +bound. -/ def machineUnaryRangeInit (ruler : List Bool) : List Bool := machineUnaryRangePack ruler [] (machineUnaryRangeInputBound ruler) +/-- Packs three copies of the computed bound to bound the unary-range generation state. -/ def machineUnaryRangeWidth (ruler : List Bool) : List Bool := let bound := machineUnaryRangeInputBound ruler machineUnaryRangePack bound bound bound +/-- Runs unary-range generation once per bit of the input ruler. -/ def machineUnaryRangeFinalState (ruler : List Bool) : List Bool := (machineUnaryRangeStep)^[ruler.length] (machineUnaryRangeInit ruler) +/-- Extracts the final encoded increasing index range. -/ def machineUnaryRangeCode (ruler : List Bool) : List Bool := machineUnaryRangeAcc (machineUnaryRangeFinalState ruler) @@ -135,6 +151,8 @@ theorem machineUnaryRangeWidth_mem_FP : machineUnaryRangeBound (machineUnaryRangePack a b c) = c := by simp [machineUnaryRangeBound, machineUnaryRangePack] +/-- Requires exact unary-range state packing and bounds every field length by the input-derived +bound. -/ def MachineUnaryRangeStateBound (ruler state : List Bool) : Prop := let B := (machineUnaryRangeInputBound ruler).length state = machineUnaryRangePack @@ -220,6 +238,8 @@ theorem machineUnaryRangeCode_mem_FP : /-! ## Exact semantics -/ +/-- Encodes the remaining countdown `n - k` and the corresponding generated suffix of the finite +index range. -/ def machineUnaryRangeSemanticState (n k : ℕ) : List Bool := machineUnaryRangePack (List.replicate (n - k) true) (binaryListCode finUnaryCode ((List.finRange n).drop (n - k))) diff --git a/LeanPool/BeyondBethe/BeyondBethe/Main.lean b/LeanPool/BeyondBethe/BeyondBethe/Main.lean index 70edb4447f..7235502cfc 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/Main.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/Main.lean @@ -28,7 +28,10 @@ namespace BeyondBethe two-sided approximation guarantee and a concrete Turing-machine polynomial-time claim. -/ structure TheoremOneSpec where + /-- The approximation base, certified positive and strictly below `sqrt 2` by `guarantee`. -/ c : ℝ + /-- The dimension-uniform rational matrix algorithm whose output approximates the permanent + within the certified factor `c^n`. -/ alg : ∀ n, Matrix (Fin n) (Fin n) ℚ → ℚ guarantee : ApproximationGuarantee alg c polynomialTime : RunsInPolynomialTime alg diff --git a/LeanPool/BeyondBethe/BeyondBethe/MatchingAlgorithm.lean b/LeanPool/BeyondBethe/BeyondBethe/MatchingAlgorithm.lean index 7c56b27004..5ad4289dd1 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MatchingAlgorithm.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MatchingAlgorithm.lean @@ -24,6 +24,8 @@ extensionally equal to it below; the wrapper can therefore remain independent of propositional decidability throughout that refinement. -/ +/-- Decides whether the matrix support contains a permutation selecting a nonzero entry in every +column. -/ def supportMatchingDecision {n : ℕ} (A : Matrix (Fin n) (Fin n) ℚ) : Bool := decide (∃ σ : Equiv.Perm (Fin n), ∀ i, A (σ i) i ≠ 0) diff --git a/LeanPool/BeyondBethe/BeyondBethe/NearCase.lean b/LeanPool/BeyondBethe/BeyondBethe/NearCase.lean index f497727585..666eb1e575 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/NearCase.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/NearCase.lean @@ -198,11 +198,14 @@ theorem univ_sdiff_coreOutside_of_ne Finset.mem_filter, true_and, Finset.mem_insert, Finset.mem_singleton] tauto +/-- Computes row `i`'s transfer cost on the two columns selected by `f` and `g`, using the +complement of their outside set. -/ noncomputable def encodedCoreRowTransferCost {n : ℕ} (f g : Equiv.Perm (Fin n)) (P U : Matrix (Fin n) (Fin n) ℝ) (i : Fin n) : ℝ := transferCostOn (Finset.univ \ coreOutside (f i) (g i)) (P i) (U i) +/-- Sums the encoded row-transfer costs over the two rows of a clean cycle. -/ noncomputable def cleanCycleWeightedCost {n : ℕ} {η : ℝ} {P : Matrix (Fin n) (Fin n) ℝ} {f g : Equiv.Perm (Fin n)} @@ -347,6 +350,7 @@ theorem cleanCycle_minCost_mul_fourCore mul_le_mul_of_nonneg_right hsa (hlog s a), mul_le_mul_of_nonneg_right hsb (hlog s b)] +/-- Selects clean cycles whose associated four-core transfer cost exceeds the threshold `κ`. -/ noncomputable def failedCleanCycles {n : ℕ} (κ τ η : ℝ) (P X : Matrix (Fin n) (Fin n) ℝ) @@ -358,6 +362,7 @@ noncomputable def failedCleanCycles (cleanCycleRow c 0) (cleanCycleRow c 1) (f (cleanCycleRow c 0)) (g (cleanCycleRow c 0)) +/-- Selects the clean cycles outside the failed-cost set. -/ noncomputable def successfulCleanCycles {n : ℕ} (κ τ η : ℝ) (P X : Matrix (Fin n) (Fin n) ℝ) @@ -562,21 +567,26 @@ theorem successfulCleanCycles_gain_sum canonical orientation whenever a formula such as `pairGain` expects one. -/ abbrev RowPair (n : ℕ) := {q : Finset (Fin n) // q.card = 2} +/-- Enumerates the two rows of a row pair through their increasing finite-set order isomorphism. -/ def rowPairRow {n : ℕ} (q : RowPair n) : Fin 2 → Fin n := fun k ↦ (q.1.orderIsoOfFin q.2 k).1 +/-- Requires distinct selected row pairs to have disjoint underlying row sets. -/ def IsRowMatching {n : ℕ} (M : Finset (RowPair n)) : Prop := (↑M : Set (RowPair n)).PairwiseDisjoint fun q ↦ q.1 +/-- Assigns a row pair the nonnegative part of its logarithmic pair gain. -/ noncomputable def rowPairWeight {n : ℕ} (A X : Matrix (Fin n) (Fin n) ℝ) (q : RowPair n) : ℝ := max 0 (Real.log (pairGain A X (rowPairRow q 0) (rowPairRow q 1))) +/-- Sums the row-pair weights over a selected matching. -/ noncomputable def rowMatchingWeight {n : ℕ} (A X : Matrix (Fin n) (Fin n) ℝ) (M : Finset (RowPair n)) : ℝ := ∑ q ∈ M, rowPairWeight A X q +/-- Enumerates all finite sets of row pairs satisfying pairwise disjointness. -/ noncomputable def allRowMatchings (n : ℕ) : Finset (Finset (RowPair n)) := by classical exact Finset.univ.filter IsRowMatching @@ -586,6 +596,7 @@ theorem allRowMatchings_nonempty (n : ℕ) : refine ⟨∅, ?_⟩ simp [allRowMatchings, IsRowMatching] +/-- Takes the maximum total row-pair weight over all row matchings. -/ noncomputable def maximumMatchingGain {n : ℕ} (A X : Matrix (Fin n) (Fin n) ℝ) : ℝ := (allRowMatchings n).sup' (allRowMatchings_nonempty n) @@ -679,6 +690,7 @@ theorem exists_positive_maximumRowMatching intro q hq exact positiveRowPairs_logGain_pos hq +/-- Uses a clean two-cycle's support as its two-element row pair. -/ noncomputable def cleanCycleRowPair {n : ℕ} {η : ℝ} {P : Matrix (Fin n) (Fin n) ℝ} {f g : Equiv.Perm (Fin n)} @@ -713,6 +725,7 @@ theorem cleanCycleRowPair_injective have hr := cleanCycleRow_mem_support c 0 exact (Finset.disjoint_left.mp hdisj) hr (by rwa [← hsupp]) +/-- Maps successful clean cycles to their underlying row pairs. -/ noncomputable def successfulRowPairs {n : ℕ} (κ τ η : ℝ) (P X : Matrix (Fin n) (Fin n) ℝ) @@ -1022,21 +1035,26 @@ theorem rowPairRow_ne have hk := rowPairRow_injective q h norm_num at hk +/-- Takes the union of all rows occurring in the selected row pairs. -/ noncomputable def matchingRows {n : ℕ} (M : Finset (RowPair n)) : Finset (Fin n) := M.biUnion fun q ↦ q.1 +/-- The subtype of rows absent from all selected row pairs. -/ abbrev UnmatchedRow {n : ℕ} (M : Finset (RowPair n)) := {i : Fin n // i ∉ matchingRows M} +/-- A cluster is either a selected row pair or one unmatched row. -/ abbrev MatchingCluster {n : ℕ} (M : Finset (RowPair n)) := M ⊕ UnmatchedRow M +/-- Assigns size two to a matched pair cluster and size one to an unmatched-row cluster. -/ def matchingClusterSize {n : ℕ} {M : Finset (RowPair n)} : MatchingCluster M → ℕ | Sum.inl _ => 2 | Sum.inr _ => 1 +/-- Maps a cluster and its local position back to the corresponding original matrix row. -/ noncomputable def matchingRowMap {n : ℕ} (M : Finset (RowPair n)) : (Σ c : MatchingCluster M, Fin (matchingClusterSize c)) → Fin n @@ -1204,6 +1222,8 @@ theorem pairCertificateValue_eq_exp_logGain_mul_singletons rw [Real.exp_log (zero_lt_one.trans hone)] exact pairCertificateValue_eq_pairGain_mul_singletons hcard hA hX hXpos r s +/-- Assigns a matched pair cluster its logarithmic pair gain and an unmatched-row cluster zero +gain. -/ noncomputable def matchingClusterLogGain {n : ℕ} (A X : Matrix (Fin n) (Fin n) ℝ) {M : Finset (RowPair n)} : MatchingCluster M → ℝ @@ -1566,6 +1586,7 @@ theorem exists_completion_scales exact ⟨η, δ, ξ, hη, hηtenth, hδ, hξ, hξξ₀, by simpa [hratio] using hr128, hcycle.le, htransfer, hξδ, hξγ⟩ +/-- The real paper scale `max 1 (log n / log 2)`. -/ noncomputable def paperScaleEll (n : ℕ) : ℝ := max 1 (Real.log n / Real.log 2) diff --git a/LeanPool/BeyondBethe/BeyondBethe/NumericalScales.lean b/LeanPool/BeyondBethe/BeyondBethe/NumericalScales.lean index add8519912..211cdd80d9 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/NumericalScales.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/NumericalScales.lean @@ -30,8 +30,14 @@ constants can be hard-coded in a Turing machine and the regularization scale positive-matrix dichotomy. Analytic expressions are compared after casting the rational constants to `ℝ`. -/ structure RationalCompletionScales (κ₀ ξ₀ γ₀ : ℚ) where + /-- The positive rational concentration parameter, constrained by the certificate to be at + most one-tenth. -/ η : ℚ + /-- The positive rational error scale controlling the row, cycle, and transfer smallness + estimates. -/ δ : ℚ + /-- The positive rational regularization numerator, bounded by the source scale and chosen + below the error and gain margins. -/ ξ : ℚ η_pos : 0 < η η_le_tenth : (η : ℝ) ≤ 1 / 10 @@ -291,13 +297,19 @@ theorem log_natCast_le_natCast_mul_log_two /-- All absolute constants needed by the structural argument, now retained as rational data instead of being erased into an existential real constant. -/ structure RationalStructuralScales where + /-- The positive rational transfer-cost threshold in the clean-pair gain guarantee. -/ κ₀ : ℚ + /-- The positive rational upper bound on the regularization numerator in the clean-pair + guarantee. -/ ξ₀ : ℚ + /-- The positive rational lower bound on the logarithmic gain of eligible clean pairs. -/ γ₀ : ℚ κ₀_pos : 0 < κ₀ ξ₀_pos : 0 < ξ₀ γ₀_pos : 0 < γ₀ cleanGain : CleanPairGainGuarantee (κ₀ : ℝ) (ξ₀ : ℝ) (γ₀ : ℝ) + /-- Rational completion parameters satisfying the smallness inequalities for these structural + constants. -/ completion : RationalCompletionScales κ₀ ξ₀ γ₀ theorem exists_rational_structuralScales : diff --git a/LeanPool/BeyondBethe/BeyondBethe/OptimizerOutputEncoding.lean b/LeanPool/BeyondBethe/BeyondBethe/OptimizerOutputEncoding.lean index c697491168..3411753943 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/OptimizerOutputEncoding.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/OptimizerOutputEncoding.lean @@ -25,8 +25,11 @@ open Complexity /-- Rational data returned by a normalized regularized-Bethe optimizer. -/ structure RationalOptimizerOutput (n : ℕ) where + /-- The rational matrix returned by the optimizer. -/ matrix : Matrix (Fin n) (Fin n) ℚ + /-- The optimizer's rational potential indexed by matrix rows. -/ rowPotential : Fin n → ℚ + /-- The optimizer's rational potential indexed by matrix columns. -/ columnPotential : Fin n → ℚ /-- Canonical right-nested list encoding of a rational vector. -/ diff --git a/LeanPool/BeyondBethe/BeyondBethe/PairStability.lean b/LeanPool/BeyondBethe/BeyondBethe/PairStability.lean index 155b944cc2..465c837798 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/PairStability.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/PairStability.lean @@ -18,6 +18,8 @@ namespace BeyondBethe open MvPolynomial +/-- The multivariate linear polynomial whose variable coefficients are `u`; coefficient +positivity is a separate hypothesis. -/ noncomputable def positiveLinearPolynomial {ι : Type*} [Fintype ι] [DecidableEq ι] (u : ι → ℝ) : MvPolynomial ι ℝ := @@ -52,14 +54,17 @@ theorem positiveLinearPolynomial_isRealStable simp at hzero linarith +/-- The finite real dot product of coordinate functions `a` and `x`. -/ noncomputable def realDot {ι : Type*} [Fintype ι] (a x : ι → ℝ) : ℝ := ∑ i, a i * x i +/-- The product of two linear forms with their diagonal quadratic contribution removed. -/ noncomputable def pairQuadraticForm {ι : Type*} [Fintype ι] (u v x : ι → ℝ) : ℝ := realDot u x * realDot v x - ∑ i, u i * v i * x i ^ 2 +/-- The symmetric bilinear polarization of the pair quadratic form. -/ noncomputable def pairBilinearForm {ι : Type*} [Fintype ι] (u v x y : ι → ℝ) : ℝ := realDot u x * realDot v y + realDot u y * realDot v x - diff --git a/LeanPool/BeyondBethe/BeyondBethe/PairedCertificate.lean b/LeanPool/BeyondBethe/BeyondBethe/PairedCertificate.lean index 39be20a6c2..1784840e72 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/PairedCertificate.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/PairedCertificate.lean @@ -25,10 +25,13 @@ each row by its cluster and its position inside that cluster. Pair certificates use the special case in which every size is one or two, but the coefficient identity below holds for arbitrary cluster sizes. -/ structure RowClustering (n : ℕ) where + /-- The type indexing the row clusters. -/ Cluster : Type clusterFintype : Fintype Cluster clusterDecidableEq : DecidableEq Cluster + /-- The number of local row positions assigned to each cluster. -/ size : Cluster → ℕ + /-- An equivalence identifying all cluster-local row positions with the original matrix rows. -/ rows : (Σ c, Fin (size c)) ≃ Fin n attribute [instance] RowClustering.clusterFintype diff --git a/LeanPool/BeyondBethe/BeyondBethe/RationalEllipsoid.lean b/LeanPool/BeyondBethe/BeyondBethe/RationalEllipsoid.lean index 158f729b27..ff0cbc5859 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/RationalEllipsoid.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/RationalEllipsoid.lean @@ -770,7 +770,9 @@ theorem rationalEllipsoid_direction_containment_of_rational /-- Entirely rational state stored by the cutting-plane algorithm. -/ structure RationalEllipsoidState (d : ℕ) where + /-- The rational center stored by the cutting-plane algorithm. -/ center : Fin d → ℚ + /-- The rational basis matrix mapping unit-ball coordinates to ellipsoid displacements. -/ basis : Matrix (Fin d) (Fin d) ℚ /-- Pull a physical cut normal back to unit-ball coordinates. -/ diff --git a/LeanPool/BeyondBethe/BeyondBethe/RationalEncodingBounds.lean b/LeanPool/BeyondBethe/BeyondBethe/RationalEncodingBounds.lean index 0619034cea..409254397d 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/RationalEncodingBounds.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/RationalEncodingBounds.lean @@ -313,6 +313,7 @@ def rationalEllipsoidStatePayload {d : ℕ} (E : RationalEllipsoidState d) : List ℚ × List (List ℚ) := (List.ofFn E.center, rationalMatrixRows E.basis) +/-- The encoded bit length of the ellipsoid state's center-vector and basis-row payload. -/ def rationalEllipsoidStateEncodedBitLength {d : ℕ} (E : RationalEllipsoidState d) : ℕ := encodedBitLength (List ℚ × List (List ℚ)) diff --git a/LeanPool/BeyondBethe/BeyondBethe/RationalEpigraphOracle.lean b/LeanPool/BeyondBethe/BeyondBethe/RationalEpigraphOracle.lean index 91c16ee4f3..82eab31ece 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/RationalEpigraphOracle.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/RationalEpigraphOracle.lean @@ -27,14 +27,17 @@ the explicit gradient-error budget prove that the returned normal is a strict central cut for the exact epigraph. -/ +/-- Projects an epigraph point to its first `d` base coordinates. -/ def epigraphBase {d : ℕ} {R : Type*} (x : Fin (d + 1) → R) : Fin d → R := fun i ↦ x i.castSucc +/-- Reads the final height coordinate of an epigraph point. -/ def epigraphHeight {d : ℕ} {R : Type*} (x : Fin (d + 1) → R) : R := x (Fin.last d) +/-- Appends minus one to a base gradient to form the epigraph supporting normal. -/ def epigraphNormal {d : ℕ} {R : Type*} [Neg R] [OfNat R 1] (g : Fin d → R) : Fin (d + 1) → R := Fin.snoc g (-1) @@ -105,7 +108,9 @@ theorem approximateVectorEpigraphCut_valid {d : ℕ} /-- Executable lower endpoint and executable approximate gradient. -/ structure DirectedEpigraphData (d : ℕ) where + /-- The executable rational lower-endpoint function evaluated on a base point. -/ lower : (Fin d → ℚ) → ℚ + /-- The executable rational approximate-gradient function evaluated on a base point. -/ gradient : (Fin d → ℚ) → Fin d → ℚ /-- The nonlinear oracle accepts unless the rational lower endpoint exceeds diff --git a/LeanPool/BeyondBethe/BeyondBethe/RationalLinearOracle.lean b/LeanPool/BeyondBethe/BeyondBethe/RationalLinearOracle.lean index 5c074cdbed..f16b536c7a 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/RationalLinearOracle.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/RationalLinearOracle.lean @@ -26,14 +26,19 @@ central cut for every point satisfying the inequality. -/ structure RationalHalfspace (d : ℕ) where + /-- The nonzero rational normal vector defining the halfspace. -/ normal : Fin d → ℚ + /-- The rational upper offset in the halfspace inequality. -/ offset : ℚ normal_ne_zero : normal ≠ 0 +/-- Requires the real point's dot product with the cast rational normal to be at most the cast +offset. -/ def RationalHalfspace.SatisfiedBy {d : ℕ} (h : RationalHalfspace d) (x : Fin d → ℝ) : Prop := finiteDot (fun i ↦ (h.normal i : ℝ)) x ≤ (h.offset : ℝ) +/-- Requires the rational point's dot product with the rational normal to be at most the offset. -/ def RationalHalfspace.satisfiedByRational {d : ℕ} (h : RationalHalfspace d) (x : Fin d → ℚ) : Prop := finiteDot h.normal x ≤ h.offset diff --git a/LeanPool/BeyondBethe/BeyondBethe/RawRational.lean b/LeanPool/BeyondBethe/BeyondBethe/RawRational.lean index edf6ea2551..77652c1339 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/RawRational.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/RawRational.lean @@ -29,28 +29,37 @@ and Euclid recurrences. /-- A signed fraction with a strictly positive, not necessarily reduced, denominator. -/ structure RawRat where + /-- The signed integer numerator of an unreduced rational representation. -/ num : ℤ + /-- The positive natural-number denominator of an unreduced rational representation. -/ den : ℕ den_pos : 0 < den deriving DecidableEq namespace RawRat +/-- The raw rational zero represented by numerator zero and denominator one. -/ def zero : RawRat := ⟨0, 1, by omega⟩ +/-- The raw rational one represented by numerator and denominator both one. -/ def one : RawRat := ⟨1, 1, by omega⟩ /-- Mathematical value of an unreduced fraction. -/ def value (q : RawRat) : ℚ := (q.num : ℚ) / (q.den : ℚ) +/-- Negates the numerator while preserving the positive denominator. -/ def neg (q : RawRat) : RawRat := ⟨-q.num, q.den, q.den_pos⟩ +/-- Adds raw fractions by cross-multiplying numerators and multiplying denominators, without +reduction. -/ def add (q r : RawRat) : RawRat := ⟨q.num * r.den + r.num * q.den, q.den * r.den, Nat.mul_pos q.den_pos r.den_pos⟩ +/-- Subtracts raw fractions by adding the negation of the second. -/ def sub (q r : RawRat) : RawRat := add q (neg r) +/-- Multiplies raw numerators and denominators without reducing the result. -/ def mul (q r : RawRat) : RawRat := ⟨q.num * r.num, q.den * r.den, Nat.mul_pos q.den_pos r.den_pos⟩ diff --git a/LeanPool/BeyondBethe/BeyondBethe/RawRationalBitBounds.lean b/LeanPool/BeyondBethe/BeyondBethe/RawRationalBitBounds.lean index 255a2f7c4a..53e179ecd9 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/RawRationalBitBounds.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/RawRationalBitBounds.lean @@ -86,6 +86,7 @@ def inv (q : RawRat) : RawRat := <;> norm_num <;> ring +/-- Divides raw fractions by multiplying by the totalized reciprocal of the divisor. -/ def div (q r : RawRat) : RawRat := q.mul r.inv @[simp] theorem value_div (q r : RawRat) : @@ -313,36 +314,43 @@ def binaryRatAdd (q r : ℚ) : ℚ := theorem binaryRatAdd_eq_add (q r : ℚ) : binaryRatAdd q r = q + r := by simp [binaryRatAdd, binaryNormalizeRawRat_eq_value] +/-- Subtracts rational inputs through raw arithmetic and binary normalization. -/ def binaryRatSub (q r : ℚ) : ℚ := binaryNormalizeRawRat ((rawRatOfRat q).sub (rawRatOfRat r)) theorem binaryRatSub_eq_sub (q r : ℚ) : binaryRatSub q r = q - r := by simp [binaryRatSub, binaryNormalizeRawRat_eq_value] +/-- Negates a rational input through raw arithmetic and binary normalization. -/ def binaryRatNeg (q : ℚ) : ℚ := binaryNormalizeRawRat (rawRatOfRat q).neg theorem binaryRatNeg_eq_neg (q : ℚ) : binaryRatNeg q = -q := by simp [binaryRatNeg, binaryNormalizeRawRat_eq_value] +/-- Multiplies rational inputs through raw arithmetic and binary normalization. -/ def binaryRatMul (q r : ℚ) : ℚ := binaryNormalizeRawRat ((rawRatOfRat q).mul (rawRatOfRat r)) theorem binaryRatMul_eq_mul (q r : ℚ) : binaryRatMul q r = q * r := by simp [binaryRatMul, binaryNormalizeRawRat_eq_value] +/-- Computes a rational input's totalized reciprocal through raw arithmetic and binary +normalization. -/ def binaryRatInv (q : ℚ) : ℚ := binaryNormalizeRawRat (rawRatOfRat q).inv theorem binaryRatInv_eq_inv (q : ℚ) : binaryRatInv q = q⁻¹ := by simp [binaryRatInv, binaryNormalizeRawRat_eq_value] +/-- Divides rational inputs through raw arithmetic and binary normalization. -/ def binaryRatDiv (q r : ℚ) : ℚ := binaryNormalizeRawRat ((rawRatOfRat q).div (rawRatOfRat r)) theorem binaryRatDiv_eq_div (q r : ℚ) : binaryRatDiv q r = q / r := by simp [binaryRatDiv, binaryNormalizeRawRat_eq_value] +/-- Raises a rational input to a natural power in raw arithmetic and then normalizes it. -/ def binaryRatPow (q : ℚ) (k : ℕ) : ℚ := binaryNormalizeRawRat ((rawRatOfRat q).pow k) diff --git a/LeanPool/BeyondBethe/BeyondBethe/RobustCycle.lean b/LeanPool/BeyondBethe/BeyondBethe/RobustCycle.lean index 1964921eb7..1f96165c8f 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/RobustCycle.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/RobustCycle.lean @@ -359,6 +359,7 @@ theorem twoMatching_coreEncoding_sum_coordinates rw [shannonEntropy_rowOrientedMass] at hcore linarith +/-- Selects the matrix rows satisfying the good-row predicate at threshold `η`. -/ noncomputable def goodRows {n : ℕ} (η : ℝ) (P : Matrix (Fin n) (Fin n) ℝ) : Finset (Fin n) := by classical @@ -545,16 +546,19 @@ theorem sum_cycleSupport_inter_card_le (fun c ↦ (t c).card) _ ≤ S.card := hcard +/-- Counts the good rows in a permutation cycle factor's support. -/ noncomputable def cycleGoodCount {n : ℕ} (η : ℝ) (P : Matrix (Fin n) (Fin n) ℝ) (h : Equiv.Perm (Fin n)) (c : h.cycleFactorsFinset) : ℕ := ((c : Equiv.Perm (Fin n)).support ∩ goodRows η P).card +/-- Counts the bad rows in a permutation cycle factor's support. -/ noncomputable def cycleBadCount {n : ℕ} (η : ℝ) (P : Matrix (Fin n) (Fin n) ℝ) (h : Equiv.Perm (Fin n)) (c : h.cycleFactorsFinset) : ℕ := ((c : Equiv.Perm (Fin n)).support ∩ badRows η P).card +/-- Sums the long-component good-row contribution over all cycle factors of the permutation. -/ noncomputable def longCycleGoodRows {n : ℕ} (η : ℝ) (P : Matrix (Fin n) (Fin n) ℝ) (h : Equiv.Perm (Fin n)) : ℕ := @@ -570,6 +574,7 @@ noncomputable def cleanCycleIndicator if (c : Equiv.Perm (Fin n)).support.card = 2 ∧ cycleGoodCount η P h c = 2 then 1 else 0 +/-- Sums clean-cycle indicators over the permutation's cycle factors. -/ noncomputable def cleanCycleCount {n : ℕ} (η : ℝ) (P : Matrix (Fin n) (Fin n) ℝ) (h : Equiv.Perm (Fin n)) : ℕ := diff --git a/LeanPool/BeyondBethe/BeyondBethe/RoundedEllipsoidBitBounds.lean b/LeanPool/BeyondBethe/BeyondBethe/RoundedEllipsoidBitBounds.lean index 0d90b851d3..4d23d77551 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/RoundedEllipsoidBitBounds.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/RoundedEllipsoidBitBounds.lean @@ -286,6 +286,7 @@ theorem rationalMatrixAbsBound_centralUpdate_le {d : ℕ} def rationalCenterAbsBound {d : ℕ} (c : Fin d → ℚ) : ℚ := 1 + ∑ i, abs (c i) +/-- Adds the rational absolute bounds for an ellipsoid state's center and basis matrix. -/ def rationalStateAbsBound {d : ℕ} (E : RationalEllipsoidState d) : ℚ := rationalCenterAbsBound E.center + rationalMatrixAbsBound E.basis diff --git a/LeanPool/BeyondBethe/BeyondBethe/RoundedEllipsoidIterationBounds.lean b/LeanPool/BeyondBethe/BeyondBethe/RoundedEllipsoidIterationBounds.lean index 451c4e800f..96fe28be31 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/RoundedEllipsoidIterationBounds.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/RoundedEllipsoidIterationBounds.lean @@ -24,12 +24,15 @@ The bound is independent of feasibility: it uses only nonsingularity and nonzero cuts. -/ +/-- Applies adaptive rounded central updates successively along a list of cut normals. -/ def adaptiveRoundedEllipsoidIterate {d : ℕ} : RationalEllipsoidState d → List (Fin d → ℚ) → RationalEllipsoidState d | E, [] => E | E, a :: cuts => adaptiveRoundedEllipsoidIterate (adaptiveRoundedEllipsoidCentralUpdate E a) cuts +/-- Requires every cut normal to remain nonzero after pullback at its corresponding adaptively +updated ellipsoid state. -/ def AdaptiveCutSequenceRegular {d : ℕ} : RationalEllipsoidState d → List (Fin d → ℚ) → Prop | _, [] => True @@ -186,6 +189,8 @@ theorem rationalEllipsoidCentralUpdate_precision_upper (rationalEllipsoidCentralUpdate_two_pow_state_magnitude_upper hd E a hb hM) +/-- Computes the next precision bound from the accumulated radius term and dimension-dependent +denominator exponent. -/ def roundedEllipsoidNextPrecisionBound (d L K t : ℕ) : ℕ := (L + 2 * t + 1) + roundedEllipsoidDenominatorExponent d @@ -326,9 +331,11 @@ theorem roundedEllipsoidStateGrowthFactor_le_two_pow (d : ℕ) : congr 1 omega +/-- The affine magnitude exponent `K + t * (5 + 3 * d)` after `t` updates. -/ def roundedEllipsoidMagnitudeExponent (d K t : ℕ) : ℕ := K + t * (5 + 3 * d) +/-- The affine state-magnitude exponent `K + t * (6 + 3 * d)` after `t` updates. -/ def roundedEllipsoidStateMagnitudeExponent (d K t : ℕ) : ℕ := K + t * (6 + 3 * d) diff --git a/LeanPool/BeyondBethe/BeyondBethe/RoundedFeasibility.lean b/LeanPool/BeyondBethe/BeyondBethe/RoundedFeasibility.lean index f9120bb9eb..2a25340baa 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/RoundedFeasibility.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/RoundedFeasibility.lean @@ -28,6 +28,8 @@ target preservation, nonsingularity, and finite termination with the weaker rounded contraction constant. -/ +/-- Runs the central oracle until it accepts the current center or the budget is exhausted, +applying adaptive rounded updates after cuts. -/ def runRoundedRationalFeasibility {d : ℕ} (oracle : RationalCentralOracle d) : ℕ → RationalEllipsoidState d → RationalFeasibilityResult d diff --git a/LeanPool/BeyondBethe/BeyondBethe/RoundedFeasibilityBitBounds.lean b/LeanPool/BeyondBethe/BeyondBethe/RoundedFeasibilityBitBounds.lean index 391972197c..ec2eb55f6d 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/RoundedFeasibilityBitBounds.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/RoundedFeasibilityBitBounds.lean @@ -25,6 +25,8 @@ iteration bounds. No feasibility assumption is needed for the size bounds; oracle validity supplies only the nonzero-cut invariant. -/ +/-- Records the cuts encountered by the adaptive rounded feasibility run, stopping on acceptance +or budget exhaustion. -/ def roundedRationalFeasibilityCuts {d : ℕ} (oracle : RationalCentralOracle d) : ℕ → RationalEllipsoidState d → List (Fin d → ℚ) diff --git a/LeanPool/BeyondBethe/BeyondBethe/RowStability.lean b/LeanPool/BeyondBethe/BeyondBethe/RowStability.lean index 211733bc07..7bc38410ff 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/RowStability.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/RowStability.lean @@ -160,6 +160,8 @@ instance instDecidableStrictTripleOrder unfold StrictTripleOrder infer_instance +/-- The uniform probability that a permutation places the three specified indices in strict +order. -/ noncomputable def tripleOrderProbability {n : ℕ} (a b c : Fin n) : ℝ := by classical @@ -850,9 +852,11 @@ arguments are used below. -/ noncomputable def rowStabilityH (x : ℝ) : ℝ := rowStabilityF x / x +/-- The row-stability derivative expression `log (1 - x) + 1 + x + x^2`. -/ noncomputable def rowStabilityFPrime (x : ℝ) : ℝ := Real.log (1 - x) + 1 + x + x ^ 2 +/-- The row-stability derivative expression `(log (1 - x) + x + x^2 / 2 + 2 * x^3 / 3) / x^2`. -/ noncomputable def rowStabilityHPrime (x : ℝ) : ℝ := (Real.log (1 - x) + x + x ^ 2 / 2 + 2 * x ^ 3 / 3) / x ^ 2 @@ -1054,6 +1058,8 @@ noncomputable def halfHalfVector {n : ℕ} (a b : Fin n) (j : Fin n) : ℝ := if j = a ∨ j = b then 1 / 2 else 0 +/-- The L1 distance from the row vector to the half-half vector supported on the selected +indices. -/ noncomputable def halfHalfL1Distance {n : ℕ} (p : Fin n → ℝ) (a b : Fin n) : ℝ := ∑ j, |p j - halfHalfVector a b j| @@ -1269,6 +1275,8 @@ theorem separableDefect_eq_sum_gap intro i _ ring +/-- The defect between applying the row-stability function to the total tail mass and summing it +over individual tail entries. -/ noncomputable def tailSeparableDefect {n : ℕ} (p : Fin n → ℝ) (a : Fin n) : ℝ := rowStabilityF (1 - p a) - @@ -1367,6 +1375,7 @@ theorem one_add_cube_third_le_artanh norm_num [Finset.sum_range_succ] at hseries ⊢ simpa [pow_succ] using hseries +/-- Subtracts the quartic correction `u^4 / 12` from the Bernoulli excess. -/ noncomputable def correctedBernoulliExcess (u : ℝ) : ℝ := bernoulliExcess u - u ^ 4 / 12 diff --git a/LeanPool/BeyondBethe/BeyondBethe/ScannedBetheBisection.lean b/LeanPool/BeyondBethe/BeyondBethe/ScannedBetheBisection.lean index 9190d3da94..4ab11e2744 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/ScannedBetheBisection.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/ScannedBetheBisection.lean @@ -24,6 +24,8 @@ need not be byte-for-byte equal to the earlier runner's point. namespace BeyondBethe +/-- Tests the midpoint with scanned threshold feasibility, lowering the upper endpoint and +recording a witness on acceptance or raising the lower endpoint otherwise. -/ def scannedBetheBisectionStep {m : ℕ} (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) (p : ℕ) (delta : RawRat) (r : ℚ) @@ -35,6 +37,7 @@ def scannedBetheBisectionStep {m : ℕ} | .accepted q => ⟨s.low, mid, some q⟩ | .exhausted _ => ⟨mid, s.high, s.witness⟩ +/-- Iterates scanned Bethe bisection for the requested number of steps. -/ def runScannedBetheBisection {m : ℕ} (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) (p : ℕ) (delta : RawRat) (r : ℚ) : @@ -44,6 +47,8 @@ def runScannedBetheBisection {m : ℕ} | N + 1, s => runScannedBetheBisection tau A p delta r N (scannedBetheBisectionStep tau A p delta r s) +/-- Initializes the scanned bisection interval and records a witness exactly when feasibility +accepts the initial high threshold. -/ def initialScannedBetheBisectionState {m : ℕ} (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) (p : ℕ) (delta : RawRat) (mix r : ℚ) : @@ -70,6 +75,8 @@ def initialScannedBetheBisectionState {m : ℕ} rw [initialScannedBetheBisectionState] split <;> rfl +/-- Requires any stored witness to be the scanned feasibility result at the current high +threshold and to satisfy the accepted epigraph-oracle predicate. -/ def ScannedBetheBisectionWitnessValid {m : ℕ} (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) (p : ℕ) (delta : RawRat) (r : ℚ) diff --git a/LeanPool/BeyondBethe/BeyondBethe/ScannedBetheThresholdFeasibility.lean b/LeanPool/BeyondBethe/BeyondBethe/ScannedBetheThresholdFeasibility.lean index 96d9deeba1..946f89db58 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/ScannedBetheThresholdFeasibility.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/ScannedBetheThresholdFeasibility.lean @@ -25,6 +25,8 @@ file gives that exact oracle its semantic feasibility runner. The older no equality between the two tie-breaking rules is needed. -/ +/-- Runs ball-based rational feasibility with the scanned bounded epigraph oracle, explicit +threshold budget, and epigraph outer radius. -/ def runExplicitScannedBetheThresholdFeasibility {m : ℕ} (tau : ℚ) (A : Matrix (Fin (m + 1)) (Fin (m + 1)) ℚ) (p : ℕ) (delta upper : RawRat) (r : ℚ) : diff --git a/LeanPool/BeyondBethe/BeyondBethe/ScheduledRoundedEllipsoidIteration.lean b/LeanPool/BeyondBethe/BeyondBethe/ScheduledRoundedEllipsoidIteration.lean index b0eab4ce8a..37ebe7370b 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/ScheduledRoundedEllipsoidIteration.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/ScheduledRoundedEllipsoidIteration.lean @@ -25,12 +25,16 @@ budget. Induction proves that it is sufficient at every reachable regular state. No determinant is evaluated by the scheduled iteration. -/ +/-- Applies central ellipsoid updates at the fixed rounding precision `p` along a list of cut +normals. -/ def scheduledRoundedEllipsoidIterate {d : ℕ} (p : ℕ) : RationalEllipsoidState d → List (Fin d → ℚ) → RationalEllipsoidState d | E, [] => E | E, a :: cuts => scheduledRoundedEllipsoidIterate p (scheduledRoundedEllipsoidCentralUpdate p E a) cuts +/-- Requires each cut to have nonzero pullback at its corresponding ellipsoid state under the +fixed-precision update schedule. -/ def ScheduledCutSequenceRegular {d : ℕ} (p : ℕ) : RationalEllipsoidState d → List (Fin d → ℚ) → Prop | _, [] => True diff --git a/LeanPool/BeyondBethe/BeyondBethe/SourceAnariRezaei.lean b/LeanPool/BeyondBethe/BeyondBethe/SourceAnariRezaei.lean index 62ce26dc3e..9188bf8fba 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/SourceAnariRezaei.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/SourceAnariRezaei.lean @@ -521,6 +521,8 @@ private theorem anariRezaeiEdgeCertificate_eq (v : ℝ) : Fin.sum_univ_succ] ring +/-- The explicit quartic edge polynomial with constants `11/25` and `14/25` used in the +Anari-Rezaei edge estimate. -/ noncomputable def anariRezaeiEdgePolynomial (q : ℝ) : ℝ := 2*(11/25)*(14/25)*q*(q+11/25)^2 + q^2*(1-q)^2 - (14/25)^2*(q+11/25)^4 @@ -596,6 +598,7 @@ theorem hasDerivAt_anariRezaeiPhiThree_edge (anariRezaeiPhiThree_comm (11/25) x).symm exact hd.congr_of_eventuallyEq heq +/-- The edge second-derivative expression `1/q - 2/(q + 11/25) - (1 - q - 11/25)/(1 - q)^2`. -/ noncomputable def anariRezaeiEdgeSecondDerivative (q : ℝ) : ℝ := 1/q - 2/(q+11/25) - (1-q-11/25)/(1-q)^2 @@ -811,6 +814,7 @@ theorem anariRezaeiPhiThree_le_log_two exact (anariRezaeiPhiThree_le_boundary hs0 hsq hq).trans (anariRezaeiPhiThree_edge_le hs0 hs) +/-- The three-coordinate vector with entries `q`, `1 - q - s`, and `s`. -/ def anariRezaeiThreeVector (q s : ℝ) : Fin 3 → ℝ := ![q, 1-q-s, s] diff --git a/LeanPool/BeyondBethe/BeyondBethe/SourceAnariRezaeiList.lean b/LeanPool/BeyondBethe/BeyondBethe/SourceAnariRezaeiList.lean index 6709c942ec..35c050e8e4 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/SourceAnariRezaeiList.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/SourceAnariRezaeiList.lean @@ -22,13 +22,16 @@ last part of the file identifies this list functional with the canonical `Fin n` functional used by the rest of the development. -/ +/-- Sums each list entry times the logarithm of the suffix sum starting at that entry. -/ noncomputable def anariRezaeiRightScore : List ℝ → ℝ | [] => 0 | x :: xs => x * Real.log ((x :: xs).sum) + anariRezaeiRightScore xs +/-- Sums the complement terms `(1 - x) * log (1 - x)` over a list. -/ noncomputable def anariRezaeiComplementScore (p : List ℝ) : ℝ := (p.map fun x ↦ (1-x)*Real.log (1-x)).sum +/-- Adds forward and reverse suffix-log scores and subtracts twice the complement score. -/ noncomputable def anariRezaeiListPhi (p : List ℝ) : ℝ := anariRezaeiRightScore p + anariRezaeiRightScore p.reverse - 2*anariRezaeiComplementScore p @@ -58,6 +61,8 @@ theorem anariRezaeiComplementScore_merge simp [anariRezaeiComplementScore] ring +/-- The expanded logarithmic gap for merging adjacent masses `r` and `s` with surrounding masses +`q` and `t`. -/ noncomputable def anariRezaeiMergeExpandedGap (q r s t : ℝ) : ℝ := r*(Real.log (q+r)-Real.log (q+r+s)) + s*(Real.log (s+t)-Real.log (r+s+t)) - diff --git a/LeanPool/BeyondBethe/BeyondBethe/SourceAnariRezaeiMerge.lean b/LeanPool/BeyondBethe/BeyondBethe/SourceAnariRezaeiMerge.lean index e34e22eb29..824901398a 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/SourceAnariRezaeiMerge.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/SourceAnariRezaeiMerge.lean @@ -41,9 +41,12 @@ noncomputable def anariRezaeiMergePsi (r s : ℝ) : ℝ := 2*(1-s)*Real.log (1-s) + 2*(1-r-s)*Real.log (1-r-s) +/-- Restricts the merge comparison function to the line where its two arguments sum to `C`. -/ noncomputable def anariRezaeiMergePsiAlong (C x : ℝ) : ℝ := anariRezaeiMergePsi x (C-x) +/-- The explicit logarithmic and reciprocal derivative expression used for the two-mass merge +comparison. -/ noncomputable def anariRezaeiMergePsiDerivative (r s : ℝ) : ℝ := -2*Real.log ((1+s)/(1+r)) - (s-r)*(1/(1+r)+1/(1+s)) + @@ -204,9 +207,13 @@ theorem anariRezaeiMergePsi_nonpos · rw [anariRezaeiMergePsi_comm hr0 hs0] exact anariRezaeiMergePsi_nonpos_ordered hs0 hsr (by linarith) +/-- The candidate outer mass `(1 - r * (1 + r + s)) / (2 + r + s)` in the merge-gap +optimization. -/ noncomputable def anariRezaeiMergeQStar (r s : ℝ) : ℝ := (1-r*(1+r+s))/(2+r+s) +/-- The symmetric candidate outer mass `(1 - s * (1 + r + s)) / (2 + r + s)` in the merge-gap +optimization. -/ noncomputable def anariRezaeiMergeTStar (r s : ℝ) : ℝ := (1-s*(1+r+s))/(2+r+s) @@ -240,9 +247,11 @@ theorem anariRezaeiMergeStars_sum (r s : ℝ) (hden : 2+r+s ≠ 0) : field_simp [hden] ring +/-- Restricts the merge gap to outer masses `x` and `1 - r - s - x`, keeping total mass one. -/ noncomputable def anariRezaeiMergeGapAlong (r s x : ℝ) : ℝ := anariRezaeiMergeGap x r s (1-r-s-x) +/-- The explicit derivative expression for the merge gap along the fixed-total-mass line. -/ noncomputable def anariRezaeiMergeGapDerivative (r s x : ℝ) : ℝ := r*s*(1/((x+r)*(x+r+s)) - 1/((1-r-x)*(1-x))) diff --git a/LeanPool/BeyondBethe/BeyondBethe/SourceStableBivariate.lean b/LeanPool/BeyondBethe/BeyondBethe/SourceStableBivariate.lean index 0b2f5a40b2..8f9240e5c8 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/SourceStableBivariate.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/SourceStableBivariate.lean @@ -86,6 +86,7 @@ theorem bivariate_rayleigh_of_bistable /-! ## The scalar capacity inequality -/ +/-- The boundary factor `α^α * (1 - α)^(1 - α)` with real exponents. -/ noncomputable def stableBoundaryScalar (α : ℝ) : ℝ := (α : ℝ) ^ α * (1 - α) ^ (1 - α) @@ -115,6 +116,7 @@ theorem normalized_weighted_geometric_mean_le_add _ = (α ^ α * (1 - α) ^ (1 - α)) * (u + v) := by field_simp [hα0.ne', (sub_pos.mpr hα1).ne'] +/-- The candidate minimizing point `α * v / ((1 - α) * u)` for the linear capacity calculation. -/ noncomputable def linearCapacityCandidate (α u v : ℝ) : ℝ := α * v / ((1 - α) * u) diff --git a/LeanPool/BeyondBethe/BeyondBethe/SourceStableClosure.lean b/LeanPool/BeyondBethe/BeyondBethe/SourceStableClosure.lean index 6d91e09b29..788cc51eb9 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/SourceStableClosure.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/SourceStableClosure.lean @@ -504,6 +504,7 @@ theorem liebSokal_linear_contraction /-! ## Specializing an arbitrary multiaffine coordinate -/ +/-- Requires the complex multivariate polynomial to have degree at most one in each variable. -/ def IsComplexMultiaffine {σ : Type*} (p : MvPolynomial σ ℂ) : Prop := ∀ i, p.degreeOf i ≤ 1 @@ -516,10 +517,12 @@ theorem IsUpperHalfPlaneStable.rename rw [MvPolynomial.eval_rename] exact hp (z ∘ f) (fun i ↦ hz (f i)) +/-- Extracts the coefficient of degree zero in the distinguished optional variable. -/ noncomputable def optionConstantCoefficient {σ : Type*} (p : MvPolynomial (Option σ) ℂ) : MvPolynomial σ ℂ := (MvPolynomial.optionEquivLeft ℂ σ p).coeff 0 +/-- Extracts the coefficient of degree one in the distinguished optional variable. -/ noncomputable def optionLinearCoefficient {σ : Type*} (p : MvPolynomial (Option σ) ℂ) : MvPolynomial σ ℂ := (MvPolynomial.optionEquivLeft ℂ σ p).coeff 1 @@ -666,12 +669,16 @@ theorem option_specialization_multiaffine · exact (MvPolynomial.degreeOf_C_mul_le _ i _).trans ((degreeOf_optionLinearCoefficient_le p i).trans (hp (some i))) +/-- Renames coordinate `i` as the distinguished optional variable and all other coordinates by +their unequal-index subtype. -/ noncomputable def coordinateReindex {σ : Type*} (p : MvPolynomial σ ℂ) (i : σ) : MvPolynomial (Option {j : σ // j ≠ i}) ℂ := by classical exact MvPolynomial.rename (Equiv.optionSubtypeNe i).symm p +/-- Adds the distinguished constant coefficient to `c` times its linear coefficient after +reindexing coordinate `i`. -/ noncomputable def coordinateSpecialization {σ : Type*} (p : MvPolynomial σ ℂ) (i : σ) (c : ℝ) : MvPolynomial {j : σ // j ≠ i} ℂ := by diff --git a/LeanPool/BeyondBethe/BeyondBethe/SourceStableEncoding.lean b/LeanPool/BeyondBethe/BeyondBethe/SourceStableEncoding.lean index a883354588..b1c6b734de 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/SourceStableEncoding.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/SourceStableEncoding.lean @@ -23,6 +23,8 @@ namespace BeyondBethe # Encoding multiaffine polynomials by Boolean coefficient tables -/ +/-- Converts a Boolean coordinate selector to its finitely supported zero-or-one exponent +vector. -/ noncomputable def boolExponent {n : ℕ} (S : Fin n → Bool) : Fin n →₀ ℕ := Finsupp.equivFunOnFinite.symm (fun i ↦ bif S i then 1 else 0) @@ -39,6 +41,7 @@ theorem boolExponent_injective {n : ℕ} : simp only [boolExponent_apply] at hi cases hS : S i <;> cases hT : T i <;> simp [hS, hT] at hi ⊢ +/-- Marks exactly the coordinates where a finitely supported exponent vector equals one. -/ noncomputable def exponentBool {n : ℕ} (d : Fin n →₀ ℕ) : Fin n → Bool := fun i ↦ decide (d i = 1) @@ -98,6 +101,7 @@ theorem multiaffine_eq_boolExpansion rw [← h, boolExponent_apply] cases S i <;> simp +/-- The real squarefree monomial selected by the true coordinates of a Boolean vector. -/ noncomputable def boolMonomial {n : ℕ} (x : Fin n → ℝ) (S : Fin n → Bool) : ℝ := ∏ i, (x i) ^ (bif S i then (1 : ℕ) else 0) @@ -217,6 +221,7 @@ theorem pairTableEval_eq_boolDoubleSum : simp only [pairTableEval] ring +/-- The table of products of the two polynomials' coefficients at Boolean exponent vectors. -/ noncomputable def coefficientPairTable {n : ℕ} (p q : MvPolynomial (Fin n) ℝ) : PairTable n := fun S T ↦ p.coeff (boolExponent S) * q.coeff (boolExponent T) @@ -238,6 +243,7 @@ theorem coefficientPairTable_eval simp [coefficientPairTable] ring +/-- The complex squarefree monomial selected by the true coordinates of a Boolean vector. -/ noncomputable def complexBoolMonomial {n : ℕ} (x : Fin n → ℂ) (S : Fin n → Bool) : ℂ := ∏ i, (x i) ^ (bif S i then (1 : ℕ) else 0) @@ -266,6 +272,7 @@ theorem multiaffine_eval₂_eq_boolSum · intro i simp +/-- Recursively evaluates a pair table on complex vectors by its four head-coordinate sections. -/ noncomputable def pairTableComplexEval : ∀ n : ℕ, PairTable n → (Fin n → ℂ) → (Fin n → ℂ) → ℂ | 0, c, _, _ => (c (fun i ↦ Fin.elim0 i) (fun i ↦ Fin.elim0 i) : ℂ) @@ -354,11 +361,15 @@ theorem coefficientPairTable_complexEval push_cast ring +/-- Reads the left member of each recursively encoded variable pair into a finite complex +vector. -/ def pairVariablesLeft : ∀ n : ℕ, (PairVariables n → ℂ) → Fin n → ℂ | 0, _, i => Fin.elim0 i | n + 1, w, i => Fin.cases (w none) (pairVariablesLeft n ((w ∘ some) ∘ some)) i +/-- Reads the right member of each recursively encoded variable pair into a finite complex +vector. -/ def pairVariablesRight : ∀ n : ℕ, (PairVariables n → ℂ) → Fin n → ℂ | 0, _, i => Fin.elim0 i diff --git a/LeanPool/BeyondBethe/BeyondBethe/SourceStableSlice.lean b/LeanPool/BeyondBethe/BeyondBethe/SourceStableSlice.lean index a3b2fffccf..1254cc1c8a 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/SourceStableSlice.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/SourceStableSlice.lean @@ -24,6 +24,8 @@ reversed. The finite closure theorem says that the resulting polynomial in the next left--right pair is stable or zero. -/ +/-- Assigns `y` to left variables and `-z` to right variables in the recursive paired-variable +encoding. -/ def pairVariablesSignedRealPoint : ∀ n : ℕ, (Fin n → ℝ) → (Fin n → ℝ) → PairVariables n → ℝ | 0, _, _, i => PEmpty.elim i @@ -111,6 +113,8 @@ def pairHeadTailEquiv (n : ℕ) : | inl x => rfl | inr x => cases x <;> rfl +/-- Renames the signed pair-table polynomial into tail variables and a Boolean-indexed head +pair. -/ noncomputable def pairTableHeadPolynomial {n : ℕ} (c : PairTable (n + 1)) : MvPolynomial (PairVariables n ⊕ Bool) ℂ := @@ -136,6 +140,8 @@ theorem pairTableHeadPolynomial_stable IsUpperHalfPlaneStable (pairTableHeadPolynomial c) := by exact hstable.rename (pairHeadTailEquiv n) +/-- Specializes all tail variables at the signed real point, retaining the two head variables as +a complex bivariate polynomial. -/ noncomputable def pairTableBivariateSlice {n : ℕ} (c : PairTable (n + 1)) (y z : Fin n → ℝ) : MvPolynomial Bool ℂ := diff --git a/LeanPool/BeyondBethe/BeyondBethe/SourceStableSpecialization.lean b/LeanPool/BeyondBethe/BeyondBethe/SourceStableSpecialization.lean index d3519d012b..d6175659fd 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/SourceStableSpecialization.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/SourceStableSpecialization.lean @@ -25,6 +25,8 @@ proof keeps the two classes of variables separated by a sum type and performs an explicit induction on the recursively finite type `PairVariables`. -/ +/-- Evaluates the left summand variables at real constants while retaining the right summand as +polynomial variables. -/ noncomputable def partialSpecialization {κ τ : Type*} (p : MvPolynomial (κ ⊕ τ) ℂ) (x : κ → ℝ) : MvPolynomial τ ℂ := @@ -69,11 +71,15 @@ def optionSumEquiv (κ τ : Type*) : (Option κ ⊕ τ) ≃ Option (κ ⊕ τ) w | none => rfl | some x => cases x <;> rfl +/-- Renames the distinguished variable in the left summand into an optional variable over the +combined remaining indices. -/ noncomputable def sumOptionReindex {κ τ : Type*} (p : MvPolynomial (Option κ ⊕ τ) ℂ) : MvPolynomial (Option (κ ⊕ τ)) ℂ := MvPolynomial.rename (optionSumEquiv κ τ) p +/-- Forms the distinguished constant coefficient plus `c` times its linear coefficient after +sum-option reindexing. -/ noncomputable def sumOptionSpecialization {κ τ : Type*} (p : MvPolynomial (Option κ ⊕ τ) ℂ) (c : ℝ) : MvPolynomial (κ ⊕ τ) ℂ := diff --git a/LeanPool/BeyondBethe/BeyondBethe/SourceStableTable.lean b/LeanPool/BeyondBethe/BeyondBethe/SourceStableTable.lean index 1f7410ced1..bb3bbc654c 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/SourceStableTable.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/SourceStableTable.lean @@ -26,16 +26,20 @@ one recursion step into two nested `linearExtension`s, exactly the form used by the formal Lieb--Sokal contraction. -/ +/-- A real coefficient table indexed by two Boolean selectors on `n` coordinates. -/ abbrev PairTable (n : ℕ) := (Fin n → Bool) → (Fin n → Bool) → ℝ +/-- Prepends one Boolean head coordinate to a finite Boolean selector. -/ def prependBool {n : ℕ} (b : Bool) (S : Fin n → Bool) : Fin (n + 1) → Bool := Fin.cases b S +/-- Fixes the two head selector bits and retains a table on the remaining coordinates. -/ def pairTableSection {n : ℕ} (c : PairTable (n + 1)) (left right : Bool) : PairTable n := fun S T ↦ c (prependBool left S) (prependBool right T) +/-- A recursively encoded type containing two fresh optional variables for each coordinate. -/ def PairVariables : ℕ → Type | 0 => PEmpty | n + 1 => Option (Option (PairVariables n)) @@ -50,6 +54,8 @@ noncomputable instance pairVariablesFintype (n : ℕ) : Fintype (PairVariables n change Fintype (Option (Option (PairVariables n))) exact inferInstance +/-- Builds the signed polynomial associated with a pair table using two linear extensions per +coordinate and negative right-variable coefficients. -/ noncomputable def pairTableStablePolynomial : ∀ n : ℕ, PairTable n → MvPolynomial (PairVariables n) ℂ | 0, c => MvPolynomial.C (c (fun i ↦ Fin.elim0 i) (fun i ↦ Fin.elim0 i) : ℂ) @@ -60,13 +66,16 @@ noncomputable def pairTableStablePolynomial : let D := pairTableStablePolynomial n (pairTableSection c false false) linearExtension (linearExtension D (-C)) (linearExtension B (-A)) +/-- Requires every coefficient-table entry to be nonnegative. -/ def PairTableNonnegative {n : ℕ} (c : PairTable n) : Prop := ∀ S T, 0 ≤ c S T +/-- Requires the associated signed polynomial to be zero or upper-half-plane stable. -/ def PairTableStableOrZero {n : ℕ} (c : PairTable n) : Prop := pairTableStablePolynomial n c = 0 ∨ IsUpperHalfPlaneStable (pairTableStablePolynomial n c) +/-- Recursively evaluates a pair table on real vectors by its four head-coordinate sections. -/ noncomputable def pairTableEval : ∀ n : ℕ, PairTable n → (Fin n → ℝ) → (Fin n → ℝ) → ℝ | 0, c, _, _ => c (fun i ↦ Fin.elim0 i) (fun i ↦ Fin.elim0 i) @@ -79,17 +88,20 @@ noncomputable def pairTableEval : let d := pairTableEval n (pairTableSection c false false) yt zt a * y 0 * z 0 + b * y 0 + cc * z 0 + d +/-- Sums diagonal table coefficients by recursively retaining only equal head-selector pairs. -/ noncomputable def pairTableDiagonalSum : ∀ n : ℕ, PairTable n → ℝ | 0, c => c (fun i ↦ Fin.elim0 i) (fun i ↦ Fin.elim0 i) | n + 1, c => pairTableDiagonalSum n (pairTableSection c false false) + pairTableDiagonalSum n (pairTableSection c true true) +/-- Multiplies the scalar stability-boundary factors over all coordinates. -/ noncomputable def pairTableBoundary : ∀ n : ℕ, (Fin n → ℝ) → ℝ | 0, _ => 1 | n + 1, α => stableBoundaryScalar (α 0) * pairTableBoundary n (fun i ↦ α i.succ) +/-- Multiplies the coordinate powers `x i ^ α i` with real exponents. -/ noncomputable def pairTableMonomial : ∀ n : ℕ, (Fin n → ℝ) → (Fin n → ℝ) → ℝ | 0, _, _ => 1 @@ -124,9 +136,11 @@ theorem pairTableSection_nonnegative intro S T exact hc _ _ +/-- Adds pair tables entrywise. -/ def pairTableAdd {n : ℕ} (c d : PairTable n) : PairTable n := fun S T ↦ c S T + d S T +/-- Contracts a head coordinate by adding its false-false and true-true coefficient sections. -/ def pairTableContract {n : ℕ} (c : PairTable (n + 1)) : PairTable n := pairTableAdd (pairTableSection c false false) (pairTableSection c true true) diff --git a/LeanPool/BeyondBethe/BeyondBethe/Stable.lean b/LeanPool/BeyondBethe/BeyondBethe/Stable.lean index 432afc99d9..e4ff2c9fbc 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/Stable.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/Stable.lean @@ -38,10 +38,12 @@ def IsRealStableOrZero {σ : Type*} (p : MvPolynomial σ ℝ) : Prop := p = 0 ∨ IsRealStable p +/-- Requires every real coefficient of the multivariate polynomial to be nonnegative. -/ def HasNonnegativeCoefficients {σ : Type*} (p : MvPolynomial σ ℝ) : Prop := ∀ d, 0 ≤ p.coeff d +/-- Requires the real multivariate polynomial to have degree at most one in each variable. -/ def IsMultiaffine {σ : Type*} (p : MvPolynomial σ ℝ) : Prop := ∀ i, p.degreeOf i ≤ 1 diff --git a/LeanPool/BeyondBethe/BeyondBethe/TransferIdentity.lean b/LeanPool/BeyondBethe/BeyondBethe/TransferIdentity.lean index dcf1cf1812..d8c3c008dd 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/TransferIdentity.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/TransferIdentity.lean @@ -32,6 +32,7 @@ def HasLogKKT ∀ i j, Real.log (A i j) = r i + c j + (1 + τ) * Real.log (X i j) + Real.log (1 - X i j) +/-- The regularized Bethe coordinate `x * log a - (1 + τ) * x * log x + (1 - x) * log (1 - x)`. -/ noncomputable def regularizedBetheCoordinate (τ a x : ℝ) : ℝ := x * Real.log a + Real.negMulLog x + From 6405046aa761697840080cbfba00eade04c557a1 Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Fri, 25 Sep 2026 20:26:16 +0000 Subject: [PATCH 27/49] Complete reviewed API docs and split three oversized proofs --- .../BeyondBethe/MachineRowPairDisjoint.lean | 15 ++ .../BeyondBethe/MachineScheduledLog.lean | 15 ++ .../BeyondBethe/MachineScheduledLogWidth.lean | 10 ++ .../MachineScheduledRoundedEllipsoid.lean | 26 ++++ .../MachineScheduledStateEncodingBound.lean | 6 + .../BeyondBethe/MachineSmallDimension.lean | 7 + .../BeyondBethe/MachineSmoothedMatrix.lean | 5 + .../BeyondBethe/MachineSmoothingDelta.lean | 19 +++ .../BeyondBethe/MachineTrimHighZeros.lean | 7 + .../MachineUnaryGridGenerator.lean | 47 ++++++ .../BeyondBethe/NumericalScales.lean | 30 ++-- .../Classes/P/Cobham/Internal/FstBlock.lean | 125 ++++++++-------- .../Classes/P/Cobham/Internal/SndBlock.lean | 135 ++++++++++-------- 13 files changed, 322 insertions(+), 125 deletions(-) diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineRowPairDisjoint.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineRowPairDisjoint.lean index 67ab10dd61..1bd2c41994 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineRowPairDisjoint.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineRowPairDisjoint.lean @@ -120,25 +120,33 @@ def machineDisjointNextConflict (state : List Bool) : List Bool := (machineDisjointCurrentConflictBit state)).take (machineDisjointInputBound (machineDisjointSource state)).length +/-- Consume the next encoded selected pair, update the accumulated conflict bit, and retain the +original input. -/ def machineDisjointProcess (state : List Bool) : List Bool := machineDisjointPack (machineListTail (machineDisjointRemaining state)) (machineDisjointNextConflict state) (machineDisjointSource state) +/-- Keep an exhausted disjointness scan fixed; otherwise process its next selected pair. -/ def machineDisjointStep (state : List Bool) : List Bool := machineIfEmpty (machineDisjointRemaining state) state (machineDisjointProcess state) +/-- Initialize the disjointness scan with the encoded selected list, a false conflict bit, and +the input word. -/ def machineDisjointInit (word : List Bool) : List Bool := machineDisjointPack (machineDisjointSelectedList word) [false] word +/-- Pack three copies of the input bound to obtain a width envelope for a disjointness state. -/ def machineDisjointWidth (word : List Bool) : List Bool := let bound := machineDisjointInputBound word machineDisjointPack bound bound bound +/-- Run the disjointness scan for the encoded selected-list length from its initial state. -/ def machineDisjointFinalState (word : List Bool) : List Bool := (machineDisjointStep)^[(machineDisjointSelectedList word).length] (machineDisjointInit word) +/-- Extract the accumulated conflict bit after scanning the selected pairs. -/ def machineRowPairConflictBit (word : List Bool) : List Bool := machineDisjointConflict (machineDisjointFinalState word) @@ -272,6 +280,8 @@ theorem machineDisjointWidth_mem_FP : machineDisjointWidth ∈ FP := machineDisjointSource (machineDisjointPack remaining conflict source) = source := by simp [machineDisjointSource, machineDisjointPack] +/-- Require a correctly packed disjointness state, bounded remaining list and conflict word, and +unchanged source input. -/ def MachineDisjointStateBound (word state : List Bool) : Prop := let B := (machineDisjointInputBound word).length state = machineDisjointPack (machineDisjointRemaining state) @@ -368,10 +378,13 @@ theorem machineRowPairDisjointBit_mem_FP : machineRowPairDisjointBit ∈ FP := /-! ## Exact semantics -/ +/-- Test whether either candidate endpoint occurs in any selected ordered pair. -/ def orderedPairsConflict {n : ℕ} (i j : Fin n) (selected : List (Fin n × Fin n)) : Bool := selected.any fun q ↦ decide (i = q.1 ∨ i = q.2 ∨ j = q.1 ∨ j = q.2) +/-- Encode two candidate endpoints in unary together with the binary list of selected ordered +pairs. -/ def machineDisjointInput {n : ℕ} (i j : Fin n) (selected : List (Fin n × Fin n)) : List Bool := pair (finUnaryCode i) @@ -412,6 +425,8 @@ def machineDisjointInput {n : ℕ} by_cases hjx : j = x <;> by_cases hjy : j = y <;> simp [hix, hiy, hjx, hjy] +/-- Represent a disjointness scan after `k` pairs: retain the suffix and record conflicts with +the consumed prefix. -/ def machineDisjointSemanticState {n : ℕ} (i j : Fin n) (selected : List (Fin n × Fin n)) (k : ℕ) : List Bool := machineDisjointPack diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineScheduledLog.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineScheduledLog.lean index b35e4ae868..0da4f48fb8 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineScheduledLog.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineScheduledLog.lean @@ -24,28 +24,36 @@ namespace BeyondBethe open Complexity +/-- Extract the unary precision ruler from a scheduled-logarithm input. -/ def machineScheduledLogPrecisionRuler (word : List Bool) : List Bool := machinePairFirst word +/-- Extract the raw-rational argument code from a scheduled-logarithm input. -/ def machineScheduledLogArgumentRawCode (word : List Bool) : List Bool := machinePairSecond word +/-- Encode the scheduled logarithm precision in binary from the unary ruler length. -/ def machineScheduledLogPrecisionBits (word : List Bool) : List Bool := machineLengthBits (machineScheduledLogPrecisionRuler word) +/-- Compute the signed binary exponent code used in directed-logarithm reduction. -/ def machineScheduledLogExponentIntegerCode (word : List Bool) : List Bool := machineDirectedLogExponentIntegerCode word +/-- Encode the absolute value of the directed logarithm exponent as a binary natural. -/ def machineScheduledLogExponentAbsBits (word : List Bool) : List Bool := machineIntegerNatAbsBits (machineScheduledLogExponentIntegerCode word) +/-- Add the precision and absolute exponent to form the main part of the logarithm term +schedule. -/ def machineScheduledLogPrecisionPlusExponentBits (word : List Bool) : List Bool := machineBinaryAddBits (pair (machineScheduledLogPrecisionBits word) (machineScheduledLogExponentAbsBits word)) +/-- Encode the logarithm term count as precision plus absolute exponent plus two. -/ def machineScheduledLogTermsBits (word : List Bool) : List Bool := machineBinaryAddBits (pair (machineScheduledLogPrecisionPlusExponentBits word) @@ -56,16 +64,19 @@ input-dependent term count. -/ def machineScheduledLogTermsGuard (word : List Bool) : List Bool := machineBinaryMulWidth word +/-- Convert the scheduled logarithm term count to a unary ruler, bounded by the quadratic guard. -/ def machineScheduledLogTermsRuler (word : List Bool) : List Bool := machineBoundedUnary (pair (machineScheduledLogTermsGuard word) (machineScheduledLogTermsBits word)) +/-- Compute the raw lower logarithm code using the scheduled, guarded term ruler. -/ def machineScheduledLogLowerRawCode (word : List Bool) : List Bool := machineDirectedLogLowerRawCode (pair (machineScheduledLogTermsRuler word) (machineScheduledLogArgumentRawCode word)) +/-- Compute the raw upper logarithm code using the scheduled, guarded term ruler. -/ def machineScheduledLogUpperRawCode (word : List Bool) : List Bool := machineDirectedLogUpperRawCode (pair (machineScheduledLogTermsRuler word) @@ -230,9 +241,13 @@ theorem directedLogTerms_le_scheduledLogGuard (q : ℚ) (p : ℕ) : machineBoundedUnary_encode_of_le] exact directedLogTerms_le_scheduledLogGuard q p +/-- Evaluate the raw lower logarithm approximation using the term count selected for `q` and +precision `p`. -/ def rawScheduledLogLower (q : ℚ) (p : ℕ) : RawRat := RawRat.logLower q (directedLogTerms q p) +/-- Evaluate the raw upper logarithm approximation using the term count selected for `q` and +precision `p`. -/ def rawScheduledLogUpper (q : ℚ) (p : ℕ) : RawRat := RawRat.logUpper q (directedLogTerms q p) diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineScheduledLogWidth.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineScheduledLogWidth.lean index 9225f68ec6..a9438b0f3d 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineScheduledLogWidth.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineScheduledLogWidth.lean @@ -21,19 +21,27 @@ inactive without an abstract bit-complexity assumption. namespace BeyondBethe +/-- Polynomial width budget for an `N`-term raw logarithm series with input width `w`. -/ def rawLogSeriesWidthBudget (w N : ℕ) : ℕ := 1 + N * ((2 * N + 1) * w + 2 * N + 4) +/-- Width budget for the raw unit-logarithm lower approximation after its rational parameter +transformation. -/ def rawLogUnitLowerWidthBudget (w N : ℕ) : ℕ := 3 + rawLogSeriesWidthBudget (2 * w + 4) N +/-- Width budget for the raw error term in the `N`-term logarithm approximation. -/ def rawLogSeriesErrorWidthBudget (w N : ℕ) : ℕ := 6 + (2 * N + 3) * (2 * w + 4) +/-- Combine lower-approximation and error widths to budget the raw unit-logarithm upper +approximation. -/ def rawLogUnitUpperWidthBudget (w N : ℕ) : ℕ := rawLogUnitLowerWidthBudget w N + rawLogSeriesErrorWidthBudget w N + 1 +/-- Combine exponent scaling and unit-logarithm bounds into a width budget for a directed +logarithm. -/ def rawDirectedLogWidthBudget (w N : ℕ) : ℕ := (2 * w + 2 + rawLogUnitUpperWidthBudget 2 N) + rawLogUnitUpperWidthBudget (2 * w + 1) N + 1 @@ -450,6 +458,8 @@ theorem rawRatWidth_complement_le (x : ℚ) : rw [← hvalue] omega +/-- Budget the raw nearby-Bethe coordinate using scheduled logarithms of `x` and `1 - x` and the +widths of `tau` and `x`. -/ def rawNearbyCoordinateWidthBudget (tau : RawRat) (x : ℚ) (p : ℕ) : ℕ := rawDirectedLogWidthBudget (rawRatWidth (rawRatOfRat (1 - x))) (directedLogTerms (1 - x) p) + diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineScheduledRoundedEllipsoid.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineScheduledRoundedEllipsoid.lean index dcd1c2214e..050bdf5a92 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineScheduledRoundedEllipsoid.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineScheduledRoundedEllipsoid.lean @@ -23,14 +23,17 @@ namespace BeyondBethe open Complexity +/-- Represent the rounding-inflation denominator `1024 * d^4` as a raw rational. -/ def rawRoundedInflationDenominator (d : ℕ) : RawRat := (RawRat.ofNat 1024).mul ((rawEllipsoidDimensionSquare d).mul (rawEllipsoidDimensionSquare d)) +/-- Represent the inflation amount `1 / (1024 * d^4)` using total raw-rational division. -/ def rawRoundedInflation (d : ℕ) : RawRat := rawEllipsoidOne.div (rawRoundedInflationDenominator d) +/-- Add one to the raw rounding-inflation amount to obtain the basis scale factor. -/ def rawRoundedInflationFactor (d : ℕ) : RawRat := rawEllipsoidOne.add (rawRoundedInflation d) @@ -47,75 +50,93 @@ def rawRoundedInflationFactor (d : ℕ) : RawRat := simp [rawRoundedInflationFactor, rawEllipsoidOne, RawRat.value_one, RawRat.value_ofNat] +/-- Extract the unary precision ruler from a scheduled ellipsoid-rounding input. -/ def machineScheduledRoundPrecision (word : List Bool) : List Bool := machinePairFirst word +/-- Extract the encoded ellipsoid state from a scheduled-rounding input. -/ def machineScheduledRoundState (word : List Bool) : List Bool := machinePairSecond word +/-- Extract the binary dimension from the ellipsoid state being rounded. -/ def machineScheduledRoundDimensionBits (word : List Bool) : List Bool := machineRationalEllipsoidDimensionWord (machineScheduledRoundState word) +/-- Convert the ellipsoid dimension to unary, bounded by the encoded state length. -/ def machineScheduledRoundDimensionUnary (word : List Bool) : List Bool := machineBoundedUnary (pair (machineScheduledRoundState word) (machineScheduledRoundDimensionBits word)) +/-- Extract the rational center-vector code from the ellipsoid state being rounded. -/ def machineScheduledRoundCenter (word : List Bool) : List Bool := machineRationalEllipsoidCenterWord (machineScheduledRoundState word) +/-- Extract the rational basis-matrix code from the ellipsoid state being rounded. -/ def machineScheduledRoundBasis (word : List Bool) : List Bool := machineRationalEllipsoidBasisWord (machineScheduledRoundState word) +/-- Convert a binary dimension word into its raw-rational scalar code. -/ def machineRoundedInflationDimensionRawCode (word : List Bool) : List Bool := machineEllipsoidDimensionRawCode word +/-- Square the encoded dimension using raw-rational multiplication. -/ def machineRoundedInflationDimensionSquareRawCode (word : List Bool) : List Bool := machineRawRatMulCode (pair (machineRoundedInflationDimensionRawCode word) (machineRoundedInflationDimensionRawCode word)) +/-- Square the raw dimension square to encode its fourth power. -/ def machineRoundedInflationDimensionFourthRawCode (word : List Bool) : List Bool := machineRawRatMulCode (pair (machineRoundedInflationDimensionSquareRawCode word) (machineRoundedInflationDimensionSquareRawCode word)) +/-- Multiply the encoded fourth power of the dimension by 1024 to form the inflation +denominator. -/ def machineRoundedInflationDenominatorRawCode (word : List Bool) : List Bool := machineRawRatMulCode (pair (rawRatBinaryCode (RawRat.ofNat 1024)) (machineRoundedInflationDimensionFourthRawCode word)) +/-- Divide raw rational one by the encoded inflation denominator. -/ def machineRoundedInflationRawCode (word : List Bool) : List Bool := machineRawRatDivCode (pair (rawRatBinaryCode rawEllipsoidOne) (machineRoundedInflationDenominatorRawCode word)) +/-- Add raw rational one to the encoded inflation amount. -/ def machineRoundedInflationFactorRawCode (word : List Bool) : List Bool := machineRawRatAddCode (pair (rawRatBinaryCode rawEllipsoidOne) (machineRoundedInflationRawCode word)) +/-- Normalize the raw inflation factor into a rational matrix-entry code. -/ def machineRoundedInflationFactorEntryCode (word : List Bool) : List Bool := machineNormalizeRawRatEntryCode (machineRoundedInflationFactorRawCode word) +/-- Floor the ellipsoid center coordinates at the scheduled dyadic precision. -/ def machineScheduledRoundCenterCode (word : List Bool) : List Bool := machineDyadicFloorVectorCode (pair (machineScheduledRoundPrecision word) (machineScheduledRoundCenter word)) +/-- Floor the ellipsoid basis entries at the scheduled dyadic precision. -/ def machineScheduledRoundFlooredBasisCode (word : List Bool) : List Bool := machineDyadicFloorMatrixCode (pair (machineScheduledRoundPrecision word) (machineScheduledRoundBasis word)) +/-- Construct the scalar diagonal matrix whose diagonal is the normalized rounding-inflation +factor. -/ def machineScheduledRoundInflationDiagonalCode (word : List Bool) : List Bool := machineDiagonalBasisRowsCode @@ -123,6 +144,7 @@ def machineScheduledRoundInflationDiagonalCode (machineRoundedInflationFactorEntryCode (machineScheduledRoundDimensionBits word))) +/-- Left-multiply the dyadically floored basis by the scalar inflation diagonal matrix. -/ def machineScheduledRoundBasisCode (word : List Bool) : List Bool := machineRationalMatrixMulCode (pair (machineScheduledRoundDimensionUnary word) @@ -416,12 +438,16 @@ theorem rationalMatrixMul_inflationDiagonal {d : ℕ} /-! ## Exact central update followed by scheduled rounding -/ +/-- Extract the precision ruler for a central ellipsoid update followed by rounding. -/ def machineScheduledCentralPrecision (word : List Bool) : List Bool := machinePairFirst word +/-- Extract the paired ellipsoid state and cut used by the exact central update. -/ def machineScheduledCentralStateAndCut (word : List Bool) : List Bool := machinePairSecond word +/-- Perform the exact rational central ellipsoid update and then round at the supplied +precision. -/ def machineScheduledRoundedEllipsoidCentralUpdateCode (word : List Bool) : List Bool := machineScheduledRoundedEllipsoidCode diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineScheduledStateEncodingBound.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineScheduledStateEncodingBound.lean index 4ecf6de1da..4d5f6a834e 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineScheduledStateEncodingBound.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineScheduledStateEncodingBound.lean @@ -25,15 +25,21 @@ namespace BeyondBethe open Complexity open scoped BigOperators +/-- Encoding-length bound `8 + 2*K + 4*P` for a rational entry with magnitude and precision +parameters. -/ def rationalEntryMachineCodeBound (K P : ℕ) : ℕ := 8 + 2 * K + 4 * P +/-- Bound a length-`d` encoded rational vector by summing entry and list-pairing costs. -/ def rationalVectorMachineCodeBound (d K P : ℕ) : ℕ := d * (2 * rationalEntryMachineCodeBound K P + 2) +/-- Bound a square rational matrix encoding by summing vector-row and list-pairing costs. -/ def rationalMatrixMachineCodeBound (d K P : ℕ) : ℕ := d * (2 * rationalVectorMachineCodeBound d K P + 2) +/-- Combine dimension, center, basis, and pairing costs into a rational ellipsoid-state encoding +bound. -/ def rationalEllipsoidMachineCodeBound (d K P : ℕ) : ℕ := 2 * (d + 1) + 2 * (2 * rationalVectorMachineCodeBound d K P + diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineSmallDimension.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineSmallDimension.lean index 70c86f1772..a2073e9063 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineSmallDimension.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineSmallDimension.lean @@ -21,23 +21,30 @@ namespace BeyondBethe open Complexity +/-- Test whether the encoded matrix dimension is zero. -/ def machineMatrixDimensionZeroBit (word : List Bool) : List Bool := machineBinaryNatEqBit (pair (machineMatrixDimensionWord word) []) +/-- Test whether the encoded matrix dimension is one. -/ def machineMatrixDimensionOneBit (word : List Bool) : List Bool := machineBinaryNatEqBit (pair (machineMatrixDimensionWord word) [true]) +/-- Extract the first encoded row from the matrix row list. -/ def machineMatrixFirstRowCode (word : List Bool) : List Bool := machineListHead (machineMatrixRowsWord word) +/-- Extract the first entry code from the first encoded matrix row. -/ def machineMatrixFirstEntryCode (word : List Bool) : List Bool := machineListHead (machineMatrixFirstRowCode word) +/-- Convert the first matrix entry into the rational binary output encoding. -/ def machineMatrixFirstEntryOutput (word : List Bool) : List Bool := machineRationalBinaryCode (machineMatrixFirstEntryCode word) +/-- Return permanent one for dimension zero and the first entry for dimension one; return an +empty word otherwise. -/ def machineSmallDimensionPermanentCode (word : List Bool) : List Bool := machineIfHead (machineMatrixDimensionZeroBit word) (rationalBinaryCode 1) diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineSmoothedMatrix.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineSmoothedMatrix.lean index 07ab261a93..92eff8e419 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineSmoothedMatrix.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineSmoothedMatrix.lean @@ -26,20 +26,25 @@ namespace BeyondBethe open Complexity +/-- Extract the raw smoothing parameter `chi` from the smoothing-and-matrix input. -/ def machineSmoothedMatrixChiRawCode (word : List Bool) : List Bool := machinePairFirst word +/-- Extract the matrix input code paired with the raw smoothing parameter. -/ def machineSmoothedMatrixInputCode (word : List Bool) : List Bool := machinePairSecond word +/-- Normalize the matrix entries before computing and applying the smoothing increment. -/ def machineSmoothedMatrixNormalizedCode (word : List Bool) : List Bool := machineMatrixNormalizeEntries (machineSmoothedMatrixInputCode word) +/-- Compute the raw smoothing increment from `chi` and the normalized input matrix. -/ def machineSmoothedMatrixDeltaRawCode (word : List Bool) : List Bool := machineSmoothingDeltaRawCode (pair (machineSmoothedMatrixChiRawCode word) (machineSmoothedMatrixNormalizedCode word)) +/-- Add the computed raw smoothing increment to every normalized matrix entry. -/ def machineSmoothedMatrixCode (word : List Bool) : List Bool := machineMatrixAddDeltaEntries (pair (machineSmoothedMatrixDeltaRawCode word) diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineSmoothingDelta.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineSmoothingDelta.lean index 99f84ce0e9..9a0977bdb2 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineSmoothingDelta.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineSmoothingDelta.lean @@ -34,60 +34,74 @@ namespace BeyondBethe open Complexity +/-- Extract the raw `chi` code used in the smoothing-increment calculation. -/ def machineSmoothingChiRawCode (word : List Bool) : List Bool := machinePairFirst word +/-- Extract the matrix code used in the smoothing-increment calculation. -/ def machineSmoothingMatrixCode (word : List Bool) : List Bool := machinePairSecond word +/-- Obtain the matrix dimension as a unary ruler for powers and factorials. -/ def machineSmoothingDimensionRuler (word : List Bool) : List Bool := machineMatrixDimensionUnary (machineSmoothingMatrixCode word) +/-- Encode the unary dimension length as a nonnegative raw rational with denominator one. -/ def machineSmoothingDimensionRawCode (word : List Bool) : List Bool := pair (false :: machineLengthBits (machineSmoothingDimensionRuler word)) (1 : ℕ).bits +/-- Compute the raw product of the nonzero matrix entries for the smoothing bound. -/ def machineSmoothingSupportRawCode (word : List Bool) : List Bool := machineMatrixSupportRawCode (machineSmoothingMatrixCode word) +/-- Raise the raw support product to the dimension given by the unary ruler. -/ def machineSmoothingSupportPowerRawCode (word : List Bool) : List Bool := machineRawRatPowerCode (pair (machineSmoothingDimensionRuler word) (machineSmoothingSupportRawCode word)) +/-- Encode the factorial of the matrix dimension as a raw rational. -/ def machineSmoothingFactorialRawCode (word : List Bool) : List Bool := machineFactorialRawRatCode (machineSmoothingDimensionRuler word) +/-- Encode twice the matrix dimension as the first smoothing denominator. -/ def machineSmoothingFirstDenominatorRawCode (word : List Bool) : List Bool := machineRawRatMulCode (pair (rawRatBinaryCode (RawRat.ofNat 2)) (machineSmoothingDimensionRawCode word)) +/-- Encode the first smoothing candidate `1 / (2*n)` by total raw-rational division. -/ def machineSmoothingFirstRawCode (word : List Bool) : List Bool := machineRawRatDivCode (pair (rawRatBinaryCode RawRat.one) (machineSmoothingFirstDenominatorRawCode word)) +/-- Multiply the raw parameter `chi` by the dimension-th power of the support product. -/ def machineSmoothingWeightedSupportRawCode (word : List Bool) : List Bool := machineRawRatMulCode (pair (machineSmoothingChiRawCode word) (machineSmoothingSupportPowerRawCode word)) +/-- Encode four times the dimension factorial as the second smoothing denominator. -/ def machineSmoothingSecondDenominatorRawCode (word : List Bool) : List Bool := machineRawRatMulCode (pair (rawRatBinaryCode (RawRat.ofNat 4)) (machineSmoothingFactorialRawCode word)) +/-- Divide the weighted support power by four times the dimension factorial. -/ def machineSmoothingSecondRawCode (word : List Bool) : List Bool := machineRawRatDivCode (pair (machineSmoothingWeightedSupportRawCode word) (machineSmoothingSecondDenominatorRawCode word)) +/-- Select the smaller of the two raw-rational smoothing candidates. -/ def machineSmoothingDeltaRawCode (word : List Bool) : List Bool := machineRawRatMinCode (pair (machineSmoothingFirstRawCode word) (machineSmoothingSecondRawCode word)) +/-- Normalize the selected raw smoothing increment into the rational binary output encoding. -/ def machineSmoothingDeltaCode (word : List Bool) : List Bool := machineNormalizeRawRatBinaryCode (machineSmoothingDeltaRawCode word) @@ -225,15 +239,20 @@ theorem machineSmoothingDeltaCode_mem_FP : simp [machineSmoothingFactorialRawCode, machineSmoothingDimensionRuler, machineSmoothingMatrixCode] +/-- The raw first smoothing candidate `1 / (2*n)`, using total division at zero. -/ def rawRationalSmoothingFirst (n : ℕ) : RawRat := RawRat.one.div ((RawRat.ofNat 2).mul (RawRat.ofNat n)) +/-- The raw second smoothing candidate: `chi` times the support product to power `n`, divided by +`4*n!`. -/ def rawRationalSmoothingSecond {n : ℕ} (A : Matrix (Fin n) (Fin n) ℚ) (χ : RawRat) : RawRat := (χ.mul ((rawRatRowsSupportProduct RawRat.one (rationalMatrixRows A)).pow n)).div ((RawRat.ofNat 4).mul (RawRat.ofNat n.factorial)) +/-- Choose the raw smoothing candidate with smaller rational value, taking the first on +equality. -/ def rawRationalSmoothingDelta {n : ℕ} (A : Matrix (Fin n) (Fin n) ℚ) (χ : RawRat) : RawRat := if (rawRationalSmoothingFirst n).value ≤ diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineTrimHighZeros.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineTrimHighZeros.lean index 1b304a9654..607b68c4a9 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineTrimHighZeros.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineTrimHighZeros.lean @@ -24,21 +24,26 @@ namespace BeyondBethe open Complexity +/-- Extract the accumulator from the recursive fold state used to trim high zero bits. -/ def machineTrimAcc (state : List Bool) : List Bool := machinePairSecond (machinePairFirst state) +/-- Discard a false bit when the trimming accumulator is empty; otherwise prepend it. -/ def machineTrimFalseStep (state : List Bool) : List Bool := machineIfEmpty (machineTrimAcc state) [] (false :: machineTrimAcc state) +/-- Prepend a true bit to the trimming accumulator. -/ def machineTrimTrueStep (state : List Bool) : List Bool := true :: machineTrimAcc state +/-- Run the high-zero trimming fold with output clamped to the packed input length. -/ def machineTrimPacked (packed : List Bool) : List Bool := Cobham.recFoldClamp machineTrimFalseStep machineTrimTrueStep packed.length [] (machinePairFirst packed) (machinePairSecond packed) +/-- Trim high zero bits by running the packed trimming fold with an empty auxiliary word. -/ def machineTrimHighZeros (word : List Bool) : List Bool := machineTrimPacked (pair [] word) @@ -124,6 +129,8 @@ theorem machineTrimHighZeros_eq (word : List Bool) : rw [Cobham.recFoldClamp_eq_recFold word hbound, machineTrim_recFold_eq] +/-- Assemble queried bits along the given ruler and trim high zeros to obtain a canonical binary +word. -/ def machineAssembleCanonicalBits (query ruler : List Bool → List Bool) (word : List Bool) : List Bool := machineTrimHighZeros (machineAssembleBits query ruler word) diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineUnaryGridGenerator.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineUnaryGridGenerator.lean index e3829871dd..6a5741da22 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineUnaryGridGenerator.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineUnaryGridGenerator.lean @@ -30,41 +30,53 @@ namespace BeyondBethe open Complexity +/-- Extract the unary dimension ruler from a square-grid generator input. -/ def machineUnaryGridGeneratorDimension (word : List Bool) : List Bool := machinePairFirst word +/-- Extract the paired output bound and payload from a grid-generator input. -/ def machineUnaryGridGeneratorRest (word : List Bool) : List Bool := machinePairSecond word +/-- Extract the output-width bound word supplied to the square-grid generator. -/ def machineUnaryGridGeneratorInputBound (word : List Bool) : List Bool := machinePairFirst (machineUnaryGridGeneratorRest word) +/-- Extract the payload passed to each generated grid entry. -/ def machineUnaryGridGeneratorInputPayload (word : List Bool) : List Bool := machinePairSecond (machineUnaryGridGeneratorRest word) +/-- Pack row, column, reversed accumulator, output bound, completion flag, and original input +into a scan state. -/ def machineUnaryGridGeneratorPack (row column accumulator bound done payload : List Bool) : List Bool := pair row (pair column (pair accumulator (pair bound (pair done payload)))) +/-- Extract the current unary row ruler from a grid-generator state. -/ def machineUnaryGridGeneratorRow (state : List Bool) : List Bool := machinePairFirst state +/-- Extract the current unary column ruler from a grid-generator state. -/ def machineUnaryGridGeneratorColumn (state : List Bool) : List Bool := machinePairFirst (machinePairSecond state) +/-- Extract the reversed encoded-entry accumulator from a grid-generator state. -/ def machineUnaryGridGeneratorAccumulator (state : List Bool) : List Bool := machinePairFirst (machinePairSecond (machinePairSecond state)) +/-- Extract the output-width bound word from a grid-generator state. -/ def machineUnaryGridGeneratorBound (state : List Bool) : List Bool := machinePairFirst (machinePairSecond (machinePairSecond (machinePairSecond state))) +/-- Extract the completion flag word from a grid-generator state. -/ def machineUnaryGridGeneratorDone (state : List Bool) : List Bool := machinePairFirst (machinePairSecond (machinePairSecond (machinePairSecond (machinePairSecond state)))) +/-- Extract the original grid-generator input stored in the state. -/ def machineUnaryGridGeneratorPayload (state : List Bool) : List Bool := machinePairSecond (machinePairSecond (machinePairSecond (machinePairSecond (machinePairSecond state)))) @@ -105,11 +117,14 @@ def machineUnaryGridGeneratorPayload (state : List Bool) : List Bool := (machineUnaryGridGeneratorPack row column accumulator bound done payload) = payload := by simp [machineUnaryGridGeneratorPayload, machineUnaryGridGeneratorPack] +/-- Read the unary grid dimension from the original input stored in a scan state. -/ def machineUnaryGridGeneratorStateDimension (state : List Bool) : List Bool := machineUnaryGridGeneratorDimension (machineUnaryGridGeneratorPayload state) +/-- Pair the current row and column rulers with the entry payload to form one entry-machine +input. -/ def machineUnaryGridGeneratorEntryInput (state : List Bool) : List Bool := pair (machineUnaryGridGeneratorRow state) @@ -117,36 +132,44 @@ def machineUnaryGridGeneratorEntryInput (machineUnaryGridGeneratorInputPayload (machineUnaryGridGeneratorPayload state))) +/-- Append one true bit to the row ruler, truncating to the stored input length. -/ def machineUnaryGridGeneratorNextRow (state : List Bool) : List Bool := (machineUnaryGridGeneratorRow state ++ [true]).take (machineUnaryGridGeneratorPayload state).length +/-- Append one true bit to the column ruler, truncating to the stored input length. -/ def machineUnaryGridGeneratorNextColumn (state : List Bool) : List Bool := (machineUnaryGridGeneratorColumn state ++ [true]).take (machineUnaryGridGeneratorPayload state).length +/-- Test whether the next column ruler reaches the grid dimension. -/ def machineUnaryGridGeneratorColumnCompletesBit (state : List Bool) : List Bool := machineHeadBit (machineUnaryRulersEqualBit (machineUnaryGridGeneratorNextColumn state) (machineUnaryGridGeneratorStateDimension state)) +/-- Test whether the next row ruler reaches the grid dimension. -/ def machineUnaryGridGeneratorRowCompletesBit (state : List Bool) : List Bool := machineHeadBit (machineUnaryRulersEqualBit (machineUnaryGridGeneratorNextRow state) (machineUnaryGridGeneratorStateDimension state)) +/-- Prepend the generated current entry to the encoded reversed accumulator. -/ def machineUnaryGridGeneratorCandidate (entry : List Bool → List Bool) (state : List Bool) : List Bool := pair (entry (machineUnaryGridGeneratorEntryInput state)) (machineUnaryGridGeneratorAccumulator state) +/-- Truncate the candidate accumulator to the supplied output-width bound. -/ def machineUnaryGridGeneratorNextAccumulator (entry : List Bool → List Bool) (state : List Bool) : List Bool := (machineUnaryGridGeneratorCandidate entry state).take (machineUnaryGridGeneratorBound state).length +/-- Store the current entry and set the grid completion flag while retaining the current +indices. -/ def machineUnaryGridGeneratorFinish (entry : List Bool → List Bool) (state : List Bool) : List Bool := machineUnaryGridGeneratorPack @@ -156,6 +179,7 @@ def machineUnaryGridGeneratorFinish (machineUnaryGridGeneratorBound state) [true] (machineUnaryGridGeneratorPayload state) +/-- Store the current entry, advance the row ruler, and reset the column ruler. -/ def machineUnaryGridGeneratorAdvanceRow (entry : List Bool → List Bool) (state : List Bool) : List Bool := machineUnaryGridGeneratorPack @@ -165,6 +189,7 @@ def machineUnaryGridGeneratorAdvanceRow (machineUnaryGridGeneratorDone state) (machineUnaryGridGeneratorPayload state) +/-- Store the current entry and advance the column ruler within the current row. -/ def machineUnaryGridGeneratorAdvanceColumn (entry : List Bool → List Bool) (state : List Bool) : List Bool := machineUnaryGridGeneratorPack @@ -175,6 +200,8 @@ def machineUnaryGridGeneratorAdvanceColumn (machineUnaryGridGeneratorDone state) (machineUnaryGridGeneratorPayload state) +/-- Process a grid entry, finishing at the last cell or advancing the row or column as +appropriate. -/ def machineUnaryGridGeneratorProcess (entry : List Bool → List Bool) (state : List Bool) : List Bool := machineIfHead (machineUnaryGridGeneratorColumnCompletesBit state) @@ -183,50 +210,63 @@ def machineUnaryGridGeneratorProcess (machineUnaryGridGeneratorAdvanceRow entry state)) (machineUnaryGridGeneratorAdvanceColumn entry state) +/-- Keep completed grid states fixed and otherwise process the current grid entry. -/ def machineUnaryGridGeneratorStep (entry : List Bool → List Bool) (state : List Bool) : List Bool := machineIfHead (machineHeadBit (machineUnaryGridGeneratorDone state)) state (machineUnaryGridGeneratorProcess entry state) +/-- Initialize the grid scan with empty index rulers and accumulator, the supplied bound, and a +false completion flag. -/ def machineUnaryGridGeneratorInit (word : List Bool) : List Bool := machineUnaryGridGeneratorPack [] [] [] (machineUnaryGridGeneratorInputBound word) [false] word +/-- Encode the unary grid dimension length as a binary natural. -/ def machineUnaryGridGeneratorDimensionBits (word : List Bool) : List Bool := machineLengthBits (machineUnaryGridGeneratorDimension word) +/-- Square the encoded dimension to obtain the nominal number of grid-entry steps. -/ def machineUnaryGridGeneratorWorkBits (word : List Bool) : List Bool := machineBinaryMulBits (pair (machineUnaryGridGeneratorDimensionBits word) (machineUnaryGridGeneratorDimensionBits word)) +/-- Construct the quadratic input-width guard for converting the grid work count to unary. -/ def machineUnaryGridGeneratorGuard (word : List Bool) : List Bool := machineBinaryMulWidth word +/-- Convert the squared dimension to a unary iteration ruler bounded by the quadratic guard. -/ def machineUnaryGridGeneratorRuler (word : List Bool) : List Bool := machineBoundedUnary (pair (machineUnaryGridGeneratorGuard word) (machineUnaryGridGeneratorWorkBits word)) +/-- Construct a state-width envelope by two iterated binary-width expansions of the padded +input. -/ def machineUnaryGridGeneratorEnvelope (word : List Bool) : List Bool := machineIteratedBinaryWidth 2 (word ++ List.replicate 16 false) +/-- Pack six copies of the width envelope to bound the complete grid-generator state. -/ def machineUnaryGridGeneratorWidth (word : List Bool) : List Bool := let envelope := machineUnaryGridGeneratorEnvelope word machineUnaryGridGeneratorPack envelope envelope envelope envelope envelope envelope +/-- Iterate the grid step for the guarded work-ruler length from the initial state. -/ def machineUnaryGridGeneratorFinalState (entry : List Bool → List Bool) (word : List Bool) : List Bool := (machineUnaryGridGeneratorStep entry)^[(machineUnaryGridGeneratorRuler word).length] (machineUnaryGridGeneratorInit word) +/-- Extract the reversed encoded-entry list after the guarded grid scan. -/ def machineUnaryGridGeneratorReversedCode (entry : List Bool → List Bool) (word : List Bool) : List Bool := machineUnaryGridGeneratorAccumulator (machineUnaryGridGeneratorFinalState entry word) +/-- Reverse the accumulated encoded entries to return them in grid traversal order. -/ def machineUnaryGridGeneratorCode (entry : List Bool → List Bool) (word : List Bool) : List Bool := machineListReverse (machineUnaryGridGeneratorReversedCode entry word) @@ -450,6 +490,8 @@ theorem machineUnaryGridGeneratorWidth_mem_FP : (machinePair_mem_FP h (machinePair_mem_FP h (machinePair_mem_FP h h)))) +/-- Require correct state packing, bounded indices and accumulator, the supplied output bound, a +one-bit flag, and unchanged input. -/ def MachineUnaryGridGeneratorStateBound (word state : List Bool) : Prop := state = machineUnaryGridGeneratorPack @@ -680,6 +722,8 @@ theorem machineUnaryGridGeneratorCode_mem_FP /-! ## Canonical inputs and exact iteration ruler -/ +/-- Encode a canonical grid input with dimension `m` in unary, an output bound, and an entry +payload. -/ def machineUnaryGridGeneratorCanonicalWord (m : ℕ) (bound payload : List Bool) : List Bool := pair (List.replicate m true) (pair bound payload) @@ -746,8 +790,11 @@ theorem machineUnaryGridGeneratorWork_le_guard /-! ## Typed row-major semantics -/ structure UnaryGridSemanticState (m : ℕ) where + /-- Current row index of the semantic square-grid scan. -/ row : Fin m + /-- Current column index of the semantic square-grid scan. -/ column : Fin m + /-- Rational entries accumulated by the semantic grid scan, in reverse traversal order. -/ accumulator : List ℚ /-- Whether the semantic grid scan has included its final entry. -/ done : Bool diff --git a/LeanPool/BeyondBethe/BeyondBethe/NumericalScales.lean b/LeanPool/BeyondBethe/BeyondBethe/NumericalScales.lean index 211cdd80d9..dfb51a793a 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/NumericalScales.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/NumericalScales.lean @@ -59,15 +59,13 @@ structure RationalCompletionScales (κ₀ ξ₀ γ₀ : ℚ) where ξ_lt_δ : ξ < δ ξ_lt_gain : ξ < 3 * γ₀ / 8 -/-- The completion hierarchy may be chosen rationally. The proof uses -rational density only inside strict margins, so no numerical approximation is -smuggled into the theorem. -/ -theorem exists_rational_completion_scales - {κ₀ ξ₀ γ₀ : ℚ} (hκ₀ : 0 < κ₀) (hξ₀ : 0 < ξ₀) (hγ₀ : 0 < γ₀) : - Nonempty (RationalCompletionScales κ₀ ξ₀ γ₀) := by +/-- A positive rational concentration parameter can satisfy both strict analytic margins. -/ +private theorem exists_rational_concentration_margins + {κ₀ : ℚ} (hκ₀ : 0 < κ₀) : + ∃ ηq : ℚ, 0 < ηq ∧ (ηq : ℝ) < 1 / 20 ∧ + goodRowOmega (ηq : ℝ) < Real.log 2 / 384 ∧ + binaryEntropy (ηq : ℝ) + (ηq : ℝ) < (κ₀ : ℝ) / 256 := by have hκ₀r : 0 < (κ₀ : ℝ) := by exact_mod_cast hκ₀ - have hξ₀r : 0 < (ξ₀ : ℝ) := by exact_mod_cast hξ₀ - have hγ₀r : 0 < (γ₀ : ℝ) := by exact_mod_cast hγ₀ have hlog : 0 < Real.log 2 := Real.log_pos (by norm_num) have hωtarget : 0 < Real.log 2 / 384 := div_pos hlog (by norm_num) have hωevent : {x : ℝ | goodRowOmega x < Real.log 2 / 384} ∈ nhds 0 := @@ -96,6 +94,22 @@ theorem exists_rational_completion_scales exact hηa) have hωsmall : goodRowOmega η < Real.log 2 / 384 := hηmem.1 have hHsmall : binaryEntropy η + η < (κ₀ : ℝ) / 256 := hηmem.2 + exact ⟨ηq, hηq0, hηtwenty, hωsmall, hHsmall⟩ + +/-- The completion hierarchy may be chosen rationally. The proof uses +rational density only inside strict margins, so no numerical approximation is +smuggled into the theorem. -/ +theorem exists_rational_completion_scales + {κ₀ ξ₀ γ₀ : ℚ} (hκ₀ : 0 < κ₀) (hξ₀ : 0 < ξ₀) (hγ₀ : 0 < γ₀) : + Nonempty (RationalCompletionScales κ₀ ξ₀ γ₀) := by + have hκ₀r : 0 < (κ₀ : ℝ) := by exact_mod_cast hκ₀ + have hξ₀r : 0 < (ξ₀ : ℝ) := by exact_mod_cast hξ₀ + have hγ₀r : 0 < (γ₀ : ℝ) := by exact_mod_cast hγ₀ + have hlog : 0 < Real.log 2 := Real.log_pos (by norm_num) + obtain ⟨ηq, hηq0, hηtwenty, hωsmall, hHsmall⟩ := + exists_rational_concentration_margins hκ₀ + let η : ℝ := (ηq : ℝ) + have hη : 0 < η := by simpa only [η, Rat.cast_pos] using hηq0 have hηtenth : η ≤ 1 / 10 := hηtwenty.le.trans (by norm_num) have hcycleBase : 6 / Real.log 2 * goodRowOmega η < 1 / 64 := by have hcoef : 0 < 6 / Real.log 2 := div_pos (by norm_num) hlog diff --git a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/FstBlock.lean b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/FstBlock.lean index 0f295ca5a9..1eaafe5833 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/FstBlock.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/FstBlock.lean @@ -93,6 +93,73 @@ def fstBlockTM : TM 0 where | .emit => exact rightOfStart_allIdle iHead wHeads oHead | .done => exact rightOfStart_allIdle iHead wHeads oHead +/-- An incomplete final payload bit stops the first-block scanner without emitting output. -/ +private theorem fstBlockTM_scan_single + (b : Bool) (acc : List Bool) (c : Cfg 0 fstBlockTM.Q) + (hstate : c.state = ScanPhase.scanA) + (hsuf : c.input.HasBinarySuffix [b]) + (hpre : c.output.HasBinaryPrefix acc) : + ∃ c' t, t ≤ 2 * [b].length + 2 ∧ fstBlockTM.reachesIn t c c' ∧ + fstBlockTM.halted c' ∧ c'.output.HasBinaryPrefix (acc ++ fstBlock [b]) := by + have houtne : c.output.read ≠ Γ.start := by rw [hpre.read_blank]; decide + cases b with + | false => + have hread : c.input.read = Γ.ofBool false := hsuf.read_cons + let c1 : Cfg 0 fstBlockTM.Q := + { state := ScanPhase.scanBfalse + input := c.input.move Dir3.right + work := fun i => (c.work i).writeAndMove (readBackWrite (c.work i).read) + (idleDir (c.work i).read) + output := c.output.writeAndMove (readBackWrite c.output.read) + (idleDir c.output.read) } + have hstep : fstBlockTM.step c = some c1 := by + simp [TM.step, hstate, fstBlockTM, hread, Γ.ofBool, c1] + have hsuf1 : c1.input.HasBinarySuffix [] := hsuf.move_right_cons + have hpre1 : c1.output.HasBinaryPrefix acc := by + rw [show c1.output = c.output from + Tape.writeAndMove_readBack_idle_of_ne_start _ houtne] + exact hpre + have hread1 : c1.input.read = Γ.blank := hsuf1.read_nil + have houtne1 : c1.output.read ≠ Γ.start := by rw [hpre1.read_blank]; decide + refine ⟨{ state := ScanPhase.done + input := c1.input.move (idleDir c1.input.read) + work := fun i => (c1.work i).writeAndMove (readBackWrite (c1.work i).read) + (idleDir (c1.work i).read) + output := c1.output.writeAndMove (readBackWrite c1.output.read) + (idleDir c1.output.read) }, 2, by simp, + .step hstep (.step (by simp [TM.step, fstBlockTM, hread1, c1]) .zero), rfl, ?_⟩ + rw [show c1.output.writeAndMove (readBackWrite c1.output.read) (idleDir c1.output.read) + = c1.output from Tape.writeAndMove_readBack_idle_of_ne_start _ houtne1] + simpa [fstBlock] using hpre1 + | true => + have hread : c.input.read = Γ.ofBool true := hsuf.read_cons + let c1 : Cfg 0 fstBlockTM.Q := + { state := ScanPhase.scanBtrue + input := c.input.move Dir3.right + work := fun i => (c.work i).writeAndMove (readBackWrite (c.work i).read) + (idleDir (c.work i).read) + output := c.output.writeAndMove (readBackWrite c.output.read) + (idleDir c.output.read) } + have hstep : fstBlockTM.step c = some c1 := by + simp [TM.step, hstate, fstBlockTM, hread, Γ.ofBool, c1] + have hsuf1 : c1.input.HasBinarySuffix [] := hsuf.move_right_cons + have hpre1 : c1.output.HasBinaryPrefix acc := by + rw [show c1.output = c.output from + Tape.writeAndMove_readBack_idle_of_ne_start _ houtne] + exact hpre + have hread1 : c1.input.read = Γ.blank := hsuf1.read_nil + have houtne1 : c1.output.read ≠ Γ.start := by rw [hpre1.read_blank]; decide + refine ⟨{ state := ScanPhase.done + input := c1.input.move (idleDir c1.input.read) + work := fun i => (c1.work i).writeAndMove (readBackWrite (c1.work i).read) + (idleDir (c1.work i).read) + output := c1.output.writeAndMove (readBackWrite c1.output.read) + (idleDir c1.output.read) }, 2, by simp, + .step hstep (.step (by simp [TM.step, fstBlockTM, hread1, c1]) .zero), rfl, ?_⟩ + rw [show c1.output.writeAndMove (readBackWrite c1.output.read) (idleDir c1.output.read) + = c1.output from Tape.writeAndMove_readBack_idle_of_ne_start _ houtne1] + simpa [fstBlock] using hpre1 + /-- The scan of `fstBlockTM`: from `scanA` on input `w` with output holding `acc`, the machine emits the decoded payload of `w`, halting with `acc ++ fstBlock w`. -/ private theorem fstBlockTM_scan_loop : @@ -136,62 +203,8 @@ private theorem fstBlockTM_scan_loop : rw [show c.output.writeAndMove (readBackWrite c.output.read) (idleDir c.output.read) = c.output from Tape.writeAndMove_readBack_idle_of_ne_start _ houtne] simpa [fstBlock] using hpre - | [false] => - have hread : c.input.read = Γ.ofBool false := hsuf.read_cons - let c1 : Cfg 0 fstBlockTM.Q := - { state := ScanPhase.scanBfalse - input := c.input.move Dir3.right - work := fun i => (c.work i).writeAndMove (readBackWrite (c.work i).read) - (idleDir (c.work i).read) - output := c.output.writeAndMove (readBackWrite c.output.read) - (idleDir c.output.read) } - have hstep : fstBlockTM.step c = some c1 := by - simp [TM.step, hstate, fstBlockTM, hread, Γ.ofBool, c1] - have hsuf1 : c1.input.HasBinarySuffix [] := hsuf.move_right_cons - have hpre1 : c1.output.HasBinaryPrefix acc := by - rw [show c1.output = c.output from - Tape.writeAndMove_readBack_idle_of_ne_start _ houtne] - exact hpre - have hread1 : c1.input.read = Γ.blank := hsuf1.read_nil - have houtne1 : c1.output.read ≠ Γ.start := by rw [hpre1.read_blank]; decide - refine ⟨{ state := ScanPhase.done - input := c1.input.move (idleDir c1.input.read) - work := fun i => (c1.work i).writeAndMove (readBackWrite (c1.work i).read) - (idleDir (c1.work i).read) - output := c1.output.writeAndMove (readBackWrite c1.output.read) - (idleDir c1.output.read) }, 2, by simp, - .step hstep (.step (by simp [TM.step, fstBlockTM, hread1, c1]) .zero), rfl, ?_⟩ - rw [show c1.output.writeAndMove (readBackWrite c1.output.read) (idleDir c1.output.read) - = c1.output from Tape.writeAndMove_readBack_idle_of_ne_start _ houtne1] - simpa [fstBlock] using hpre1 - | [true] => - have hread : c.input.read = Γ.ofBool true := hsuf.read_cons - let c1 : Cfg 0 fstBlockTM.Q := - { state := ScanPhase.scanBtrue - input := c.input.move Dir3.right - work := fun i => (c.work i).writeAndMove (readBackWrite (c.work i).read) - (idleDir (c.work i).read) - output := c.output.writeAndMove (readBackWrite c.output.read) - (idleDir c.output.read) } - have hstep : fstBlockTM.step c = some c1 := by - simp [TM.step, hstate, fstBlockTM, hread, Γ.ofBool, c1] - have hsuf1 : c1.input.HasBinarySuffix [] := hsuf.move_right_cons - have hpre1 : c1.output.HasBinaryPrefix acc := by - rw [show c1.output = c.output from - Tape.writeAndMove_readBack_idle_of_ne_start _ houtne] - exact hpre - have hread1 : c1.input.read = Γ.blank := hsuf1.read_nil - have houtne1 : c1.output.read ≠ Γ.start := by rw [hpre1.read_blank]; decide - refine ⟨{ state := ScanPhase.done - input := c1.input.move (idleDir c1.input.read) - work := fun i => (c1.work i).writeAndMove (readBackWrite (c1.work i).read) - (idleDir (c1.work i).read) - output := c1.output.writeAndMove (readBackWrite c1.output.read) - (idleDir c1.output.read) }, 2, by simp, - .step hstep (.step (by simp [TM.step, fstBlockTM, hread1, c1]) .zero), rfl, ?_⟩ - rw [show c1.output.writeAndMove (readBackWrite c1.output.read) (idleDir c1.output.read) - = c1.output from Tape.writeAndMove_readBack_idle_of_ne_start _ houtne1] - simpa [fstBlock] using hpre1 + | [false] => exact fstBlockTM_scan_single false acc c hstate hsuf hpre + | [true] => exact fstBlockTM_scan_single true acc c hstate hsuf hpre | false :: true :: y => have hreadA : c.input.read = Γ.ofBool false := hsuf.read_cons let c1 : Cfg 0 fstBlockTM.Q := diff --git a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/SndBlock.lean b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/SndBlock.lean index 5f53da9de7..1bd441b083 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/SndBlock.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/SndBlock.lean @@ -157,6 +157,78 @@ private theorem sndBlockTM_emit_loop : refine ⟨c', t + 1, by simp; omega, .step hstep hreach, hhalt, ?_⟩ rwa [List.append_assoc, List.cons_append, List.nil_append] at hout +/-- An incomplete final payload bit halts the second-block scanner with empty output. -/ +private theorem sndBlockTM_scan_single + (b : Bool) (c : Cfg 0 sndBlockTM.Q) + (hstate : c.state = ScanPhase.scanA) + (hsuf : c.input.HasBinarySuffix [b]) + (hpre : c.output.HasBinaryPrefix []) : + ∃ c' t, t ≤ 2 * [b].length + 2 ∧ sndBlockTM.reachesIn t c c' ∧ + sndBlockTM.halted c' ∧ c'.output.HasOutput (sndBlock [b]) := by + have houtne : c.output.read ≠ Γ.start := by rw [hpre.read_blank]; decide + cases b with + | false => + -- scanA reads false → scanBfalse; next reads blank → done. + have hread : c.input.read = Γ.ofBool false := hsuf.read_cons + let c1 : Cfg 0 sndBlockTM.Q := + { state := ScanPhase.scanBfalse + input := c.input.move Dir3.right + work := fun i => (c.work i).writeAndMove (readBackWrite (c.work i).read) + (idleDir (c.work i).read) + output := c.output.writeAndMove (readBackWrite c.output.read) + (idleDir c.output.read) } + have hstep : sndBlockTM.step c = some c1 := by + simp [TM.step, hstate, sndBlockTM, hread, Γ.ofBool, c1] + have hsuf1 : c1.input.HasBinarySuffix [] := hsuf.move_right_cons + have hpre1 : c1.output.HasBinaryPrefix [] := by + rw [show c1.output = c.output from + Tape.writeAndMove_readBack_idle_of_ne_start _ houtne] + exact hpre + have hread1 : c1.input.read = Γ.blank := hsuf1.read_nil + have hout1 : c1.output.read = Γ.blank := hpre1.read_blank + have houtne1 : c1.output.read ≠ Γ.start := by rw [hout1]; decide + refine ⟨{ state := ScanPhase.done + input := c1.input.move (idleDir c1.input.read) + work := fun i => (c1.work i).writeAndMove (readBackWrite (c1.work i).read) + (idleDir (c1.work i).read) + output := c1.output.writeAndMove (readBackWrite c1.output.read) + (idleDir c1.output.read) }, 2, by simp, + .step hstep (.step (by simp [TM.step, sndBlockTM, hread1, c1]) .zero), rfl, ?_⟩ + rw [show c1.output.writeAndMove (readBackWrite c1.output.read) (idleDir c1.output.read) + = c1.output from by + rw [writeAndMove_readBack c1.output houtne1, idleDir, ite_eq_right houtne1, Tape.move]] + simpa [sndBlock] using! hpre1.hasOutput + | true => + have hread : c.input.read = Γ.ofBool true := hsuf.read_cons + let c1 : Cfg 0 sndBlockTM.Q := + { state := ScanPhase.scanBtrue + input := c.input.move Dir3.right + work := fun i => (c.work i).writeAndMove (readBackWrite (c.work i).read) + (idleDir (c.work i).read) + output := c.output.writeAndMove (readBackWrite c.output.read) + (idleDir c.output.read) } + have hstep : sndBlockTM.step c = some c1 := by + simp [TM.step, hstate, sndBlockTM, hread, Γ.ofBool, c1] + have hsuf1 : c1.input.HasBinarySuffix [] := hsuf.move_right_cons + have hpre1 : c1.output.HasBinaryPrefix [] := by + rw [show c1.output = c.output from + Tape.writeAndMove_readBack_idle_of_ne_start _ houtne] + exact hpre + have hread1 : c1.input.read = Γ.blank := hsuf1.read_nil + have hout1 : c1.output.read = Γ.blank := hpre1.read_blank + have houtne1 : c1.output.read ≠ Γ.start := by rw [hout1]; decide + refine ⟨{ state := ScanPhase.done + input := c1.input.move (idleDir c1.input.read) + work := fun i => (c1.work i).writeAndMove (readBackWrite (c1.work i).read) + (idleDir (c1.work i).read) + output := c1.output.writeAndMove (readBackWrite c1.output.read) + (idleDir c1.output.read) }, 2, by simp, + .step hstep (.step (by simp [TM.step, sndBlockTM, hread1, c1]) .zero), rfl, ?_⟩ + rw [show c1.output.writeAndMove (readBackWrite c1.output.read) (idleDir c1.output.read) + = c1.output from by + rw [writeAndMove_readBack c1.output houtne1, idleDir, ite_eq_right houtne1, Tape.move]] + simpa [sndBlock] using! hpre1.hasOutput + /-- The scan phase of `sndBlockTM`: from `scanA` with input cursor on `w`, the machine parses doubled pairs to the separator and copies the suffix, halting with output `sndBlock w`. `fuel` bounds the recursion by the input length. -/ @@ -206,67 +278,8 @@ private theorem sndBlockTM_scan_loop : = c.output from by rw [writeAndMove_readBack c.output houtne, idleDir, ite_eq_right houtne, Tape.move]] simpa [sndBlock] using! hpre.hasOutput - | [false] => - -- scanA reads false → scanBfalse; next reads blank → done. - have hread : c.input.read = Γ.ofBool false := hsuf.read_cons - let c1 : Cfg 0 sndBlockTM.Q := - { state := ScanPhase.scanBfalse - input := c.input.move Dir3.right - work := fun i => (c.work i).writeAndMove (readBackWrite (c.work i).read) - (idleDir (c.work i).read) - output := c.output.writeAndMove (readBackWrite c.output.read) - (idleDir c.output.read) } - have hstep : sndBlockTM.step c = some c1 := by - simp [TM.step, hstate, sndBlockTM, hread, Γ.ofBool, c1] - have hsuf1 : c1.input.HasBinarySuffix [] := hsuf.move_right_cons - have hpre1 : c1.output.HasBinaryPrefix [] := by - rw [show c1.output = c.output from - Tape.writeAndMove_readBack_idle_of_ne_start _ houtne] - exact hpre - have hread1 : c1.input.read = Γ.blank := hsuf1.read_nil - have hout1 : c1.output.read = Γ.blank := hpre1.read_blank - have houtne1 : c1.output.read ≠ Γ.start := by rw [hout1]; decide - refine ⟨{ state := ScanPhase.done - input := c1.input.move (idleDir c1.input.read) - work := fun i => (c1.work i).writeAndMove (readBackWrite (c1.work i).read) - (idleDir (c1.work i).read) - output := c1.output.writeAndMove (readBackWrite c1.output.read) - (idleDir c1.output.read) }, 2, by simp, - .step hstep (.step (by simp [TM.step, sndBlockTM, hread1, c1]) .zero), rfl, ?_⟩ - rw [show c1.output.writeAndMove (readBackWrite c1.output.read) (idleDir c1.output.read) - = c1.output from by - rw [writeAndMove_readBack c1.output houtne1, idleDir, ite_eq_right houtne1, Tape.move]] - simpa [sndBlock] using! hpre1.hasOutput - | [true] => - have hread : c.input.read = Γ.ofBool true := hsuf.read_cons - let c1 : Cfg 0 sndBlockTM.Q := - { state := ScanPhase.scanBtrue - input := c.input.move Dir3.right - work := fun i => (c.work i).writeAndMove (readBackWrite (c.work i).read) - (idleDir (c.work i).read) - output := c.output.writeAndMove (readBackWrite c.output.read) - (idleDir c.output.read) } - have hstep : sndBlockTM.step c = some c1 := by - simp [TM.step, hstate, sndBlockTM, hread, Γ.ofBool, c1] - have hsuf1 : c1.input.HasBinarySuffix [] := hsuf.move_right_cons - have hpre1 : c1.output.HasBinaryPrefix [] := by - rw [show c1.output = c.output from - Tape.writeAndMove_readBack_idle_of_ne_start _ houtne] - exact hpre - have hread1 : c1.input.read = Γ.blank := hsuf1.read_nil - have hout1 : c1.output.read = Γ.blank := hpre1.read_blank - have houtne1 : c1.output.read ≠ Γ.start := by rw [hout1]; decide - refine ⟨{ state := ScanPhase.done - input := c1.input.move (idleDir c1.input.read) - work := fun i => (c1.work i).writeAndMove (readBackWrite (c1.work i).read) - (idleDir (c1.work i).read) - output := c1.output.writeAndMove (readBackWrite c1.output.read) - (idleDir c1.output.read) }, 2, by simp, - .step hstep (.step (by simp [TM.step, sndBlockTM, hread1, c1]) .zero), rfl, ?_⟩ - rw [show c1.output.writeAndMove (readBackWrite c1.output.read) (idleDir c1.output.read) - = c1.output from by - rw [writeAndMove_readBack c1.output houtne1, idleDir, ite_eq_right houtne1, Tape.move]] - simpa [sndBlock] using! hpre1.hasOutput + | [false] => exact sndBlockTM_scan_single false c hstate hsuf hpre + | [true] => exact sndBlockTM_scan_single true c hstate hsuf hpre | false :: true :: y => -- separator: scanA false → scanBfalse → (reads true) → emit; copy y. have hreadA : c.input.read = Γ.ofBool false := hsuf.read_cons From 913008f4ecd33d75fbcdbb896fb023d1d455a99e Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Fri, 25 Sep 2026 20:28:25 +0000 Subject: [PATCH 28/49] Factor reorder scanner terminal cases without changing contracts --- .../Classes/P/Cobham/Internal/Reorder.lean | 300 ++++++++++-------- 1 file changed, 162 insertions(+), 138 deletions(-) diff --git a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/Reorder.lean b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/Reorder.lean index 29ee759dd3..74a38775b8 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/Reorder.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/Reorder.lean @@ -175,6 +175,73 @@ def reorderTM : TM 0 where by first | exact fun _ => rfl | exact idleDir_right_of_start⟩ | .rdone => exact rightOfStart_allIdle iHead wHeads oHead +/-- The decode phase stops on an incomplete final payload bit without emitting it. -/ +private theorem reorderTM_dec_single + (b : Bool) (acc : List Bool) (c : Cfg 0 reorderTM.Q) + (hstate : c.state = ReorderPhase.rdecA) + (hsuf : c.input.HasBinarySuffix [b]) + (hpre : c.output.HasBinaryPrefix acc) : + ∃ c' t, t ≤ 2 * [b].length + 2 ∧ reorderTM.reachesIn t c c' ∧ + reorderTM.halted c' ∧ c'.output.HasBinaryPrefix (acc ++ fstBlock [b]) := by + have houtne : c.output.read ≠ Γ.start := by rw [hpre.read_blank]; decide + cases b with + | false => + have hread : c.input.read = Γ.ofBool false := hsuf.read_cons + let c1 : Cfg 0 reorderTM.Q := + { state := ReorderPhase.rdecBf + input := c.input.move Dir3.right + work := fun i => (c.work i).writeAndMove (readBackWrite (c.work i).read) + (idleDir (c.work i).read) + output := c.output.writeAndMove (readBackWrite c.output.read) + (idleDir c.output.read) } + have hstep : reorderTM.step c = some c1 := by + simp [TM.step, hstate, reorderTM, hread, Γ.ofBool, c1] + have hsuf1 : c1.input.HasBinarySuffix [] := hsuf.move_right_cons + have hpre1 : c1.output.HasBinaryPrefix acc := by + rw [show c1.output = c.output from + Tape.writeAndMove_readBack_idle_of_ne_start _ houtne] + exact hpre + have hread1 : c1.input.read = Γ.blank := hsuf1.read_nil + have houtne1 : c1.output.read ≠ Γ.start := by rw [hpre1.read_blank]; decide + refine ⟨{ state := ReorderPhase.rdone + input := c1.input.move (idleDir c1.input.read) + work := fun i => (c1.work i).writeAndMove (readBackWrite (c1.work i).read) + (idleDir (c1.work i).read) + output := c1.output.writeAndMove (readBackWrite c1.output.read) + (idleDir c1.output.read) }, 2, by simp, + .step hstep (.step (by simp [TM.step, reorderTM, hread1, c1]) .zero), rfl, ?_⟩ + rw [show c1.output.writeAndMove (readBackWrite c1.output.read) (idleDir c1.output.read) + = c1.output from Tape.writeAndMove_readBack_idle_of_ne_start _ houtne1] + simpa [fstBlock] using hpre1 + | true => + have hread : c.input.read = Γ.ofBool true := hsuf.read_cons + let c1 : Cfg 0 reorderTM.Q := + { state := ReorderPhase.rdecBt + input := c.input.move Dir3.right + work := fun i => (c.work i).writeAndMove (readBackWrite (c.work i).read) + (idleDir (c.work i).read) + output := c.output.writeAndMove (readBackWrite c.output.read) + (idleDir c.output.read) } + have hstep : reorderTM.step c = some c1 := by + simp [TM.step, hstate, reorderTM, hread, Γ.ofBool, c1] + have hsuf1 : c1.input.HasBinarySuffix [] := hsuf.move_right_cons + have hpre1 : c1.output.HasBinaryPrefix acc := by + rw [show c1.output = c.output from + Tape.writeAndMove_readBack_idle_of_ne_start _ houtne] + exact hpre + have hread1 : c1.input.read = Γ.blank := hsuf1.read_nil + have houtne1 : c1.output.read ≠ Γ.start := by rw [hpre1.read_blank]; decide + refine ⟨{ state := ReorderPhase.rdone + input := c1.input.move (idleDir c1.input.read) + work := fun i => (c1.work i).writeAndMove (readBackWrite (c1.work i).read) + (idleDir (c1.work i).read) + output := c1.output.writeAndMove (readBackWrite c1.output.read) + (idleDir c1.output.read) }, 2, by simp, + .step hstep (.step (by simp [TM.step, reorderTM, hread1, c1]) .zero), rfl, ?_⟩ + rw [show c1.output.writeAndMove (readBackWrite c1.output.read) (idleDir c1.output.read) + = c1.output from Tape.writeAndMove_readBack_idle_of_ne_start _ houtne1] + simpa [fstBlock] using hpre1 + /-- Phase 2 of `reorderTM`: from `rdecA` on input `w` with output holding `acc`, decode and emit `fstBlock w`, halting with `acc ++ fstBlock w`. Identical in shape to `fstBlockTM_scan_loop`. -/ @@ -219,62 +286,8 @@ private theorem reorderTM_dec_loop : rw [show c.output.writeAndMove (readBackWrite c.output.read) (idleDir c.output.read) = c.output from Tape.writeAndMove_readBack_idle_of_ne_start _ houtne] simpa [fstBlock] using hpre - | [false] => - have hread : c.input.read = Γ.ofBool false := hsuf.read_cons - let c1 : Cfg 0 reorderTM.Q := - { state := ReorderPhase.rdecBf - input := c.input.move Dir3.right - work := fun i => (c.work i).writeAndMove (readBackWrite (c.work i).read) - (idleDir (c.work i).read) - output := c.output.writeAndMove (readBackWrite c.output.read) - (idleDir c.output.read) } - have hstep : reorderTM.step c = some c1 := by - simp [TM.step, hstate, reorderTM, hread, Γ.ofBool, c1] - have hsuf1 : c1.input.HasBinarySuffix [] := hsuf.move_right_cons - have hpre1 : c1.output.HasBinaryPrefix acc := by - rw [show c1.output = c.output from - Tape.writeAndMove_readBack_idle_of_ne_start _ houtne] - exact hpre - have hread1 : c1.input.read = Γ.blank := hsuf1.read_nil - have houtne1 : c1.output.read ≠ Γ.start := by rw [hpre1.read_blank]; decide - refine ⟨{ state := ReorderPhase.rdone - input := c1.input.move (idleDir c1.input.read) - work := fun i => (c1.work i).writeAndMove (readBackWrite (c1.work i).read) - (idleDir (c1.work i).read) - output := c1.output.writeAndMove (readBackWrite c1.output.read) - (idleDir c1.output.read) }, 2, by simp, - .step hstep (.step (by simp [TM.step, reorderTM, hread1, c1]) .zero), rfl, ?_⟩ - rw [show c1.output.writeAndMove (readBackWrite c1.output.read) (idleDir c1.output.read) - = c1.output from Tape.writeAndMove_readBack_idle_of_ne_start _ houtne1] - simpa [fstBlock] using hpre1 - | [true] => - have hread : c.input.read = Γ.ofBool true := hsuf.read_cons - let c1 : Cfg 0 reorderTM.Q := - { state := ReorderPhase.rdecBt - input := c.input.move Dir3.right - work := fun i => (c.work i).writeAndMove (readBackWrite (c.work i).read) - (idleDir (c.work i).read) - output := c.output.writeAndMove (readBackWrite c.output.read) - (idleDir c.output.read) } - have hstep : reorderTM.step c = some c1 := by - simp [TM.step, hstate, reorderTM, hread, Γ.ofBool, c1] - have hsuf1 : c1.input.HasBinarySuffix [] := hsuf.move_right_cons - have hpre1 : c1.output.HasBinaryPrefix acc := by - rw [show c1.output = c.output from - Tape.writeAndMove_readBack_idle_of_ne_start _ houtne] - exact hpre - have hread1 : c1.input.read = Γ.blank := hsuf1.read_nil - have houtne1 : c1.output.read ≠ Γ.start := by rw [hpre1.read_blank]; decide - refine ⟨{ state := ReorderPhase.rdone - input := c1.input.move (idleDir c1.input.read) - work := fun i => (c1.work i).writeAndMove (readBackWrite (c1.work i).read) - (idleDir (c1.work i).read) - output := c1.output.writeAndMove (readBackWrite c1.output.read) - (idleDir c1.output.read) }, 2, by simp, - .step hstep (.step (by simp [TM.step, reorderTM, hread1, c1]) .zero), rfl, ?_⟩ - rw [show c1.output.writeAndMove (readBackWrite c1.output.read) (idleDir c1.output.read) - = c1.output from Tape.writeAndMove_readBack_idle_of_ne_start _ houtne1] - simpa [fstBlock] using hpre1 + | [false] => exact reorderTM_dec_single false acc c hstate hsuf hpre + | [true] => exact reorderTM_dec_single true acc c hstate hsuf hpre | false :: true :: y => have hreadA : c.input.read = Γ.ofBool false := hsuf.read_cons let c1 : Cfg 0 reorderTM.Q := @@ -412,6 +425,95 @@ private theorem reorderTM_dec_loop : rw [hfb, List.append_assoc, List.cons_append, List.nil_append] at * exact hcout +/-- The copy phase emits a lone remaining bit and then halts. -/ +private theorem reorderTM_copy_single + (b : Bool) (acc : List Bool) (c : Cfg 0 reorderTM.Q) + (hstate : c.state = ReorderPhase.rcopyA) + (hsuf : c.input.HasBinarySuffix [b]) + (hpre : c.output.HasBinaryPrefix acc) : + ∃ c' t, t ≤ 3 * [b].length + 3 ∧ reorderTM.reachesIn t c c' ∧ + reorderTM.halted c' ∧ c'.output.HasBinaryPrefix (acc ++ reorder [b]) := by + cases b with + | false => + have hread : c.input.read = Γ.ofBool false := hsuf.read_cons + let c1 : Cfg 0 reorderTM.Q := + { state := ReorderPhase.rcopyBf + input := c.input.move Dir3.right + work := fun i => (c.work i).writeAndMove (readBackWrite (c.work i).read) + (idleDir (c.work i).read) + output := c.output.writeAndMove (readBackWrite c.input.read) Dir3.right } + have hstep : reorderTM.step c = some c1 := by + simp [TM.step, hstate, reorderTM, hread, Γ.ofBool, c1] + have hsuf1 : c1.input.HasBinarySuffix [] := hsuf.move_right_cons + have hpre1 : c1.output.HasBinaryPrefix (acc ++ [false]) := by + have hco : (readBackWrite c.input.read).toΓ = Γ.ofBool false := by rw [hread]; rfl + show (c.output.writeAndMove ((readBackWrite c.input.read).toΓ) + Dir3.right).HasBinaryPrefix + (acc ++ [false]) + rw [hco]; exact Tape.hasBinaryPrefix_write_bit false hpre + have hread1 : c1.input.read = Γ.blank := hsuf1.read_nil + have houtne1 : c1.output.read ≠ Γ.start := by rw [hpre1.read_blank]; decide + refine ⟨{ state := ReorderPhase.rdone + input := c1.input.move (idleDir c1.input.read) + work := fun i => (c1.work i).writeAndMove (readBackWrite (c1.work i).read) + (idleDir (c1.work i).read) + output := c1.output.writeAndMove (readBackWrite c1.output.read) + (idleDir c1.output.read) }, 2, by simp, + .step hstep (.step (by simp [TM.step, reorderTM, hread1, c1]) .zero), rfl, ?_⟩ + rw [show c1.output.writeAndMove (readBackWrite c1.output.read) (idleDir c1.output.read) + = c1.output from Tape.writeAndMove_readBack_idle_of_ne_start _ houtne1] + simpa [reorder] using hpre1 + | true => + have hread : c.input.read = Γ.ofBool true := hsuf.read_cons + let c1 : Cfg 0 reorderTM.Q := + { state := ReorderPhase.rcopyBt + input := c.input.move Dir3.right + work := fun i => (c.work i).writeAndMove (readBackWrite (c.work i).read) + (idleDir (c.work i).read) + output := c.output.writeAndMove (readBackWrite c.input.read) Dir3.right } + have hstep : reorderTM.step c = some c1 := by + simp [TM.step, hstate, reorderTM, hread, Γ.ofBool, c1] + have hsuf1 : c1.input.HasBinarySuffix [] := hsuf.move_right_cons + have hpre1 : c1.output.HasBinaryPrefix (acc ++ [true]) := by + have hco : (readBackWrite c.input.read).toΓ = Γ.ofBool true := by rw [hread]; rfl + show (c.output.writeAndMove ((readBackWrite c.input.read).toΓ) + Dir3.right).HasBinaryPrefix + (acc ++ [true]) + rw [hco]; exact Tape.hasBinaryPrefix_write_bit true hpre + have hread1 : c1.input.read = Γ.blank := hsuf1.read_nil + have houtne1 : c1.output.read ≠ Γ.start := by rw [hpre1.read_blank]; decide + refine ⟨{ state := ReorderPhase.rdone + input := c1.input.move (idleDir c1.input.read) + work := fun i => (c1.work i).writeAndMove (readBackWrite (c1.work i).read) + (idleDir (c1.work i).read) + output := c1.output.writeAndMove (readBackWrite c1.output.read) + (idleDir c1.output.read) }, 2, by simp, + .step hstep (.step (by simp [TM.step, reorderTM, hread1, c1]) .zero), rfl, ?_⟩ + rw [show c1.output.writeAndMove (readBackWrite c1.output.read) (idleDir c1.output.read) + = c1.output from Tape.writeAndMove_readBack_idle_of_ne_start _ houtne1] + simpa [reorder] using hpre1 + +/-- The copy phase halts on empty input without changing the output prefix. -/ +private theorem reorderTM_copy_empty + (acc : List Bool) (c : Cfg 0 reorderTM.Q) + (hstate : c.state = ReorderPhase.rcopyA) + (hsuf : c.input.HasBinarySuffix []) + (hpre : c.output.HasBinaryPrefix acc) : + ∃ c' t, t ≤ 3 ∧ reorderTM.reachesIn t c c' ∧ reorderTM.halted c' ∧ + c'.output.HasBinaryPrefix (acc ++ reorder []) := by + have houtne : c.output.read ≠ Γ.start := by rw [hpre.read_blank]; decide + have hread : c.input.read = Γ.blank := hsuf.read_nil + refine ⟨{ state := ReorderPhase.rdone + input := c.input.move (idleDir c.input.read) + work := fun i => (c.work i).writeAndMove (readBackWrite (c.work i).read) + (idleDir (c.work i).read) + output := c.output.writeAndMove (readBackWrite c.output.read) + (idleDir c.output.read) }, 1, by simp, + .step (by simp [TM.step, hstate, reorderTM, hread]) .zero, rfl, ?_⟩ + rw [show c.output.writeAndMove (readBackWrite c.output.read) (idleDir c.output.read) + = c.output from Tape.writeAndMove_readBack_idle_of_ne_start _ houtne] + simpa [reorder] using hpre + /-- Phase 1 of `reorderTM`: from `rcopyA` on input `w` with output holding `acc`, copy `w`'s leading block verbatim and decode the following block, halting with `acc ++ reorder w`. The separator case hands off to `reorderTM_dec_loop`. -/ @@ -428,93 +530,15 @@ private theorem reorderTM_copy_loop : intro w acc hw c hstate hsuf hpre have hwnil : w = [] := List.length_eq_zero_iff.mp (Nat.le_zero.mp hw) subst hwnil - have hread : c.input.read = Γ.blank := hsuf.read_nil - have houtne : c.output.read ≠ Γ.start := by rw [hpre.read_blank]; decide - refine ⟨{ state := ReorderPhase.rdone - input := c.input.move (idleDir c.input.read) - work := fun i => (c.work i).writeAndMove (readBackWrite (c.work i).read) - (idleDir (c.work i).read) - output := c.output.writeAndMove (readBackWrite c.output.read) - (idleDir c.output.read) }, 1, by simp, - .step (by simp [TM.step, hstate, reorderTM, hread]) .zero, rfl, ?_⟩ - rw [show c.output.writeAndMove (readBackWrite c.output.read) (idleDir c.output.read) - = c.output from Tape.writeAndMove_readBack_idle_of_ne_start _ houtne] - simpa [reorder] using hpre + exact reorderTM_copy_empty acc c hstate hsuf hpre | succ fuel ih => intro w acc hw c hstate hsuf hpre have houtne : c.output.read ≠ Γ.start := by rw [hpre.read_blank]; decide -- The `rcopyA` step emits the first bit `c1` verbatim. match w with - | [] => - have hread : c.input.read = Γ.blank := hsuf.read_nil - refine ⟨{ state := ReorderPhase.rdone - input := c.input.move (idleDir c.input.read) - work := fun i => (c.work i).writeAndMove (readBackWrite (c.work i).read) - (idleDir (c.work i).read) - output := c.output.writeAndMove (readBackWrite c.output.read) - (idleDir c.output.read) }, 1, by simp, - .step (by simp [TM.step, hstate, reorderTM, hread]) .zero, rfl, ?_⟩ - rw [show c.output.writeAndMove (readBackWrite c.output.read) (idleDir c.output.read) - = c.output from Tape.writeAndMove_readBack_idle_of_ne_start _ houtne] - simpa [reorder] using hpre - | [false] => - have hread : c.input.read = Γ.ofBool false := hsuf.read_cons - let c1 : Cfg 0 reorderTM.Q := - { state := ReorderPhase.rcopyBf - input := c.input.move Dir3.right - work := fun i => (c.work i).writeAndMove (readBackWrite (c.work i).read) - (idleDir (c.work i).read) - output := c.output.writeAndMove (readBackWrite c.input.read) Dir3.right } - have hstep : reorderTM.step c = some c1 := by - simp [TM.step, hstate, reorderTM, hread, Γ.ofBool, c1] - have hsuf1 : c1.input.HasBinarySuffix [] := hsuf.move_right_cons - have hpre1 : c1.output.HasBinaryPrefix (acc ++ [false]) := by - have hco : (readBackWrite c.input.read).toΓ = Γ.ofBool false := by rw [hread]; rfl - show (c.output.writeAndMove ((readBackWrite c.input.read).toΓ) - Dir3.right).HasBinaryPrefix - (acc ++ [false]) - rw [hco]; exact Tape.hasBinaryPrefix_write_bit false hpre - have hread1 : c1.input.read = Γ.blank := hsuf1.read_nil - have houtne1 : c1.output.read ≠ Γ.start := by rw [hpre1.read_blank]; decide - refine ⟨{ state := ReorderPhase.rdone - input := c1.input.move (idleDir c1.input.read) - work := fun i => (c1.work i).writeAndMove (readBackWrite (c1.work i).read) - (idleDir (c1.work i).read) - output := c1.output.writeAndMove (readBackWrite c1.output.read) - (idleDir c1.output.read) }, 2, by simp, - .step hstep (.step (by simp [TM.step, reorderTM, hread1, c1]) .zero), rfl, ?_⟩ - rw [show c1.output.writeAndMove (readBackWrite c1.output.read) (idleDir c1.output.read) - = c1.output from Tape.writeAndMove_readBack_idle_of_ne_start _ houtne1] - simpa [reorder] using hpre1 - | [true] => - have hread : c.input.read = Γ.ofBool true := hsuf.read_cons - let c1 : Cfg 0 reorderTM.Q := - { state := ReorderPhase.rcopyBt - input := c.input.move Dir3.right - work := fun i => (c.work i).writeAndMove (readBackWrite (c.work i).read) - (idleDir (c.work i).read) - output := c.output.writeAndMove (readBackWrite c.input.read) Dir3.right } - have hstep : reorderTM.step c = some c1 := by - simp [TM.step, hstate, reorderTM, hread, Γ.ofBool, c1] - have hsuf1 : c1.input.HasBinarySuffix [] := hsuf.move_right_cons - have hpre1 : c1.output.HasBinaryPrefix (acc ++ [true]) := by - have hco : (readBackWrite c.input.read).toΓ = Γ.ofBool true := by rw [hread]; rfl - show (c.output.writeAndMove ((readBackWrite c.input.read).toΓ) - Dir3.right).HasBinaryPrefix - (acc ++ [true]) - rw [hco]; exact Tape.hasBinaryPrefix_write_bit true hpre - have hread1 : c1.input.read = Γ.blank := hsuf1.read_nil - have houtne1 : c1.output.read ≠ Γ.start := by rw [hpre1.read_blank]; decide - refine ⟨{ state := ReorderPhase.rdone - input := c1.input.move (idleDir c1.input.read) - work := fun i => (c1.work i).writeAndMove (readBackWrite (c1.work i).read) - (idleDir (c1.work i).read) - output := c1.output.writeAndMove (readBackWrite c1.output.read) - (idleDir c1.output.read) }, 2, by simp, - .step hstep (.step (by simp [TM.step, reorderTM, hread1, c1]) .zero), rfl, ?_⟩ - rw [show c1.output.writeAndMove (readBackWrite c1.output.read) (idleDir c1.output.read) - = c1.output from Tape.writeAndMove_readBack_idle_of_ne_start _ houtne1] - simpa [reorder] using hpre1 + | [] => exact reorderTM_copy_empty acc c hstate hsuf hpre + | [false] => exact reorderTM_copy_single false acc c hstate hsuf hpre + | [true] => exact reorderTM_copy_single true acc c hstate hsuf hpre | false :: true :: y => -- separator: copy `false` then `true`, then decode `y`. have hreadA : c.input.read = Γ.ofBool false := hsuf.read_cons From 02ae2c290c8140cfc8469f9b93336553031e88a2 Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Fri, 25 Sep 2026 20:30:16 +0000 Subject: [PATCH 29/49] Factor framed tape restoration and parking proofs --- .../Machine/EntryAppend/Internal.lean | 64 +++++++++++++------ 1 file changed, 44 insertions(+), 20 deletions(-) diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryAppend/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryAppend/Internal.lean index b9349f0895..6d317a040d 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryAppend/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryAppend/Internal.lean @@ -39,6 +39,42 @@ private theorem parked_of_binaryPrefix {t : Tape} {bits : List Bool} ⟨by rw [h.1]; omega, (show t.HasBinaryContent bits from h.2).cells_ne_start⟩ +/-- Two parked modified tapes and a parked unchanged frame give a parked work family. -/ +private theorem parked_work_of_frame + (query replacement : Fin n) (initial current : Fin n → Tape) + (hinitial : ∀ i, TM.Parked (initial i)) + (hquery : TM.Parked (current query)) (hreplacement : TM.Parked (current replacement)) + (hframe : ∀ i, i ≠ query → i ≠ replacement → current i = initial i) : + ∀ i, TM.Parked (current i) := by + intro i + by_cases hiq : i = query + · subst i + exact hquery + · by_cases hir : i = replacement + · subst i + exact hreplacement + · rw [hframe i hiq hir] + exact hinitial i + +/-- Rewinding the two modified tapes restores the entire framed work-tape family. -/ +private theorem work_eq_of_two_rewinds + (query replacement : Fin n) (initial encoded queryRewound restored : Fin n → Tape) + (hreplacementRestored : restored replacement = initial replacement) + (hreplacementFrame : ∀ i, i ≠ replacement → restored i = queryRewound i) + (hqueryRestored : queryRewound query = initial query) + (hqueryFrame : ∀ i, i ≠ query → queryRewound i = encoded i) + (hencodedFrame : ∀ i, i ≠ query → i ≠ replacement → encoded i = initial i) : + restored = initial := by + funext i + by_cases hir : i = replacement + · subst i + exact hreplacementRestored + · rw [hreplacementFrame i hir] + by_cases hiq : i = query + · subst i + exact hqueryRestored + · exact (hqueryFrame i hiq).trans (hencodedFrame i hiq hir) + theorem entryAppendRestoreTM_hoareTime_frame_internal (tapes : EntryReplaceTapes n) (address newValue : ℕ) (emitted : List Bool) (initialWork readyWork : Fin n → Tape) @@ -93,16 +129,10 @@ theorem entryAppendRestoreTM_hoareTime_frame_internal exact hinput have hencodedOutputParked : TM.Parked encoded.output := parked_of_binaryPrefix hencodedOutput - have hencodedWorkParked : ∀ i, TM.Parked (encoded.work i) := by - intro i - by_cases hiq : i = tapes.entry.query - · subst i - exact parked_of_binarySuffix (by simpa using! hquerySuffix) - · by_cases hir : i = tapes.replacement - · subst i - exact parked_of_binarySuffix (by simpa using! hreplacementSuffix) - · rw [hencodedFrame i hiq hir] - exact hready.parked i + have hencodedWorkParked : ∀ i, TM.Parked (encoded.work i) := + parked_work_of_frame tapes.entry.query tapes.replacement readyWork encoded.work + hready.parked (parked_of_binarySuffix (by simpa using! hquerySuffix)) + (parked_of_binarySuffix (by simpa using! hreplacementSuffix)) hencodedFrame have hqueryContent : (encoded.work tapes.entry.query).HasBinaryContent address.bits := by simpa only [Tape.HasBinaryContent, hqueryCells'] using! hready.query.2 @@ -175,16 +205,10 @@ theorem entryAppendRestoreTM_hoareTime_frame_internal have hreplacementRestored : restored.work tapes.replacement = readyWork tapes.replacement := hreplacementRestoredCanonical.trans hreplacementCanonical.symm - have hrestoredWork : restored.work = readyWork := by - funext i - by_cases hir : i = tapes.replacement - · subst i - exact hreplacementRestored - · rw [hreplacementFrame i hir] - by_cases hiq : i = tapes.entry.query - · subst i - exact hqueryRestored - · exact (hqueryFrame i hiq).trans (hencodedFrame i hiq hir) + have hrestoredWork : restored.work = readyWork := + work_eq_of_two_rewinds tapes.entry.query tapes.replacement readyWork encoded.work + queryRewound.work restored.work hreplacementRestored hreplacementFrame + hqueryRestored hqueryFrame hencodedFrame obtain ⟨hqueryInputTransition, hqueryWorkTransition, hqueryOutputTransition⟩ := TM.phaseTransition_eq_self_of_reads_ne_start From d828182c60164934cea8979dbfe68e378f1b7db4 Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Fri, 25 Sep 2026 20:37:13 +0000 Subject: [PATCH 30/49] Factor tape-frame invariants for register replacement and lookup --- .../Machine/DenseInputLookup/Internal.lean | 65 +++++++---- .../Machine/EntryReplace/Internal.lean | 108 +++++++++++------- .../Machine/Instruction/Load.lean | 29 +++-- 3 files changed, 127 insertions(+), 75 deletions(-) diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/DenseInputLookup/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/DenseInputLookup/Internal.lean index 4222b8cf85..485791c5c7 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/DenseInputLookup/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/DenseInputLookup/Internal.lean @@ -866,6 +866,44 @@ private theorem parked_of_hasBinaryNat {tape : Tape} {value : ℕ} (hvalue : tape.HasBinaryNat value) : TM.Parked tape := ⟨by rw [hvalue.2.1], hvalue.2.hasBinaryContent.cells_ne_start⟩ +/-- Resetting the scan counter preserves the lookup result and its untouched tape frame. -/ +private theorem denseInputLookupResult_of_reset_counter {n : ℕ} + (query counter result scratch : Fin n) + (hqc : query ≠ counter) (hqr : query ≠ result) (hcr : counter ≠ result) + (hcs : counter ≠ scratch) (hrs : result ≠ scratch) + (input : List Bool) (address : ℕ) (initialWork work : Fin n → Tape) + (hresult : (work result).HasBinaryNat (Complexity.RAM.initRegs input address)) + (hother : ∀ i, i ≠ counter → i ≠ result → + work i = Function.update initialWork counter (denseInputNatTape address) i) + (hparked : ∀ i, TM.Parked (work i)) : + DenseInputLookupResult query counter result scratch input address initialWork + (Function.update work counter ((Tape.init []).move Dir3.right)) := by + let copiedWork := Function.update initialWork counter (denseInputNatTape address) + have hblankNat : ((Tape.init []).move Dir3.right).HasBinaryNat 0 := by + simpa using Tape.init_move_right_hasBinaryNat 0 + constructor + · rw [Function.update_of_ne hqc] + rw [hother query hqc hqr] + simp [copiedWork, Function.update_of_ne hqc] + · rw [Function.update_self] + exact hblankNat + · rw [Function.update_of_ne hcr.symm] + exact hresult + · rw [Function.update_of_ne hcs.symm] + rw [hother scratch hcs.symm hrs.symm] + simp [copiedWork, Function.update_of_ne hcs.symm] + · intro i + by_cases hi : i = counter + · subst i + rw [Function.update_self] + exact parked_of_hasBinaryNat hblankNat + · rw [Function.update_of_ne hi] + exact hparked i + · intro i _ hic hir _ + rw [Function.update_of_ne hic] + rw [hother i hic hir] + simp [copiedWork, Function.update_of_ne hic] + theorem denseInputLookupTM_hoareTime_internal {n : ℕ} (query counter result scratch : Fin n) (hqc : query ≠ counter) (hqr : query ≠ result) @@ -1021,34 +1059,11 @@ theorem denseInputLookupTM_hoareTime_internal {n : ℕ} obtain ⟨done, time, htime, hreach, hhalt, hdoneInput, hdoneWork, hdoneOutput⟩ := hrun inp work out ⟨rfl, rfl, rfl⟩ - have hblankNat : - ((Tape.init []).move Dir3.right).HasBinaryNat 0 := by - simpa using Tape.init_move_right_hasBinaryNat 0 have hdoneResult : DenseInputLookupResult query counter result scratch input address initialWork done.work := by rw [hdoneWork] - constructor - · rw [Function.update_of_ne hqc] - rw [hother query hqc hqr] - simp [copiedWork, Function.update_of_ne hqc] - · rw [Function.update_self] - exact hblankNat - · rw [Function.update_of_ne hcr.symm] - exact hresult - · rw [Function.update_of_ne hcs.symm] - rw [hother scratch hcs.symm hrs.symm] - simp [copiedWork, Function.update_of_ne hcs.symm] - · intro i - by_cases hi : i = counter - · subst i - rw [Function.update_self] - exact parked_of_hasBinaryNat hblankNat - · rw [Function.update_of_ne hi] - exact hparked i - · intro i _ hic hir _ - rw [Function.update_of_ne hic] - rw [hother i hic hir] - simp [copiedWork, Function.update_of_ne hic] + exact denseInputLookupResult_of_reset_counter query counter result scratch + hqc hqr hcr hcs hrs input address initialWork work hresult hother hparked exact ⟨done, time, htime, hreach, hhalt, hdoneInput.trans hinp, hdoneResult, hdoneOutput.trans hout⟩ have hrewindTransition : ∀ inp work out, rewoundPost inp work out → diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryReplace/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryReplace/Internal.lean index f76a941287..4b0b86035c 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryReplace/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryReplace/Internal.lean @@ -107,6 +107,65 @@ private theorem entryReplaceReadyWork_eq · simp only [entryReplaceReadyWork, hia, ite_false] exact hframe i hia +/-- Cleanup restores the original scan frame and leaves the replacement tape unchanged. -/ +private theorem entryReplaceCleanup_preserves_frame + (tapes : EntryReplaceTapes n) (entry : Entry) (rest queryBits : List Bool) + (initialWork matchedWork finalWork : Fin n → Tape) + (hmatch : ReadableEntryMatch tapes.entry entry rest queryBits initialWork matchedWork) + (hready : EntryScanReady tapes.entry rest queryBits + (entryReplaceReadyWork tapes entry matchedWork) finalWork) : + EntryScanReady tapes.entry rest queryBits initialWork finalWork ∧ + finalWork tapes.replacement = matchedWork tapes.replacement := by + let readyWork := entryReplaceReadyWork tapes entry matchedWork + have hreadyGlobal : + EntryScanReady tapes.entry rest queryBits initialWork finalWork := by + refine ⟨hready.source, hready.address, hready.addressStart, + hready.value, hready.valueStart, hready.addressCounter, + hready.addressWidth, hready.valueCounter, hready.valueWidth, + hready.query, hready.queryStart, hready.result, hready.resultStart, + hready.parked, ?_⟩ + intro i hsource haddress hvalue haddressCounter haddressWidth + hvalueCounter hvalueWidth hquery hresult + have hbase : readyWork i = matchedWork i := by + simp [readyWork, entryReplaceReadyWork, haddress] + exact (hready.frame i hsource haddress hvalue haddressCounter + haddressWidth hvalueCounter hvalueWidth hquery hresult).trans + (hbase.trans (hmatch.frame i hsource haddress hvalue haddressCounter + haddressWidth hvalueCounter hvalueWidth hquery hresult)) + refine ⟨hreadyGlobal, ?_⟩ + have hreplacementReady : readyWork tapes.replacement = + matchedWork tapes.replacement := by + have hne : tapes.replacement ≠ tapes.entry.address := + tapes.replacement_ne 1 + change (if tapes.replacement = tapes.entry.address then + { head := entry.1.bits.length + 1, + cells := (matchedWork tapes.replacement).cells } + else matchedWork tapes.replacement) = matchedWork tapes.replacement + rw [ite_eq_right hne] + exact (hready.frame tapes.replacement + (tapes.replacement_ne 0) (tapes.replacement_ne 1) + (tapes.replacement_ne 2) (tapes.replacement_ne 3) + (tapes.replacement_ne 4) (tapes.replacement_ne 5) + (tapes.replacement_ne 6) (tapes.replacement_ne 7) + (tapes.replacement_ne 8)).trans hreplacementReady + +/-- A framed work family is parked when both modified tapes have binary suffixes. -/ +private theorem parked_of_two_binary_suffixes + (first second : Fin n) (base work : Fin n → Tape) (firstBits secondBits : List Bool) + (hfirst : (work first).HasBinarySuffix firstBits) + (hsecond : (work second).HasBinarySuffix secondBits) + (hframe : ∀ i, i ≠ first → i ≠ second → work i = base i) + (hbase : ∀ i, TM.Parked (base i)) : ∀ i, TM.Parked (work i) := by + intro i + by_cases hia : i = first + · subst i + exact parked_of_binarySuffix hfirst + · by_cases hir : i = second + · subst i + exact parked_of_binarySuffix hsecond + · rw [hframe i hia hir] + exact hbase i + theorem entryReplaceCleanupTM_hoareTime_frame_internal (tapes : EntryReplaceTapes n) (entry : Entry) (newValue : ℕ) (rest queryBits emitted : List Bool) @@ -155,16 +214,10 @@ theorem entryReplaceCleanupTM_hoareTime_frame_internal exact hinput have hencodedOutputParked : TM.Parked encoded.output := parked_of_binaryPrefix hencodedOutput - have hencodedWorkParked : ∀ i, TM.Parked (encoded.work i) := by - intro i - by_cases hia : i = tapes.entry.address - · subst i - exact parked_of_binarySuffix haddressSuffix - · by_cases hir : i = tapes.replacement - · subst i - exact parked_of_binarySuffix hreplacementSuffix - · rw [hencodedFrame i hia hir] - exact hmatch.parked i + have hencodedWorkParked : ∀ i, TM.Parked (encoded.work i) := + parked_of_two_binary_suffixes tapes.entry.address tapes.replacement + matchedWork encoded.work _ _ haddressSuffix hreplacementSuffix + hencodedFrame hmatch.parked have hreplacementContent : (encoded.work tapes.replacement).HasBinaryContent newValue.bits := by have hcells : (encoded.work tapes.replacement).cells = @@ -313,39 +366,12 @@ theorem entryReplaceCleanupTM_hoareTime_frame_internal exact (TM.phase2Wrap_halted_iff (rewindEntryEncodeTM tapes.encodeTapes) (TM.seqTM (TM.rewindWorkTM tapes.replacement) (entryMissCleanupTM tapes.entry)) tailFinal).mpr htailHalt - · have hreadyGlobal : - EntryScanReady tapes.entry rest queryBits initialWork cleaned.work := by - refine ⟨hready.source, hready.address, hready.addressStart, - hready.value, hready.valueStart, hready.addressCounter, - hready.addressWidth, hready.valueCounter, hready.valueWidth, - hready.query, hready.queryStart, hready.result, hready.resultStart, - hready.parked, ?_⟩ - intro i hsource haddress hvalue haddressCounter haddressWidth - hvalueCounter hvalueWidth hquery hresult - have hbase : readyWork i = matchedWork i := by - simp [readyWork, entryReplaceReadyWork, haddress] - exact (hready.frame i hsource haddress hvalue haddressCounter - haddressWidth hvalueCounter hvalueWidth hquery hresult).trans - (hbase.trans (hmatch.frame i hsource haddress hvalue haddressCounter - haddressWidth hvalueCounter hvalueWidth hquery hresult)) - refine ⟨?_, hreadyGlobal, ?_, ?_⟩ + · obtain ⟨hreadyGlobal, hreplacementFinal⟩ := + entryReplaceCleanup_preserves_frame tapes entry rest queryBits + initialWork matchedWork cleaned.work hmatch hready + refine ⟨?_, hreadyGlobal, hreplacementFinal, ?_⟩ · change cleaned.input = inp₀ exact hcleanedInput.trans (hrewoundInput.trans hencodedInput) - · have hreplacementReady : readyWork tapes.replacement = - matchedWork tapes.replacement := by - have hne : tapes.replacement ≠ tapes.entry.address := - tapes.replacement_ne 1 - change (if tapes.replacement = tapes.entry.address then - { head := entry.1.bits.length + 1, - cells := (matchedWork tapes.replacement).cells } - else matchedWork tapes.replacement) = matchedWork tapes.replacement - rw [ite_eq_right hne] - exact (hready.frame tapes.replacement - (tapes.replacement_ne 0) (tapes.replacement_ne 1) - (tapes.replacement_ne 2) (tapes.replacement_ne 3) - (tapes.replacement_ne 4) (tapes.replacement_ne 5) - (tapes.replacement_ne 6) (tapes.replacement_ne 7) - (tapes.replacement_ne 8)).trans hreplacementReady · change cleaned.output.HasBinaryPrefix (emitted ++ Entry.encode (entry.1, newValue)) rw [hcleanedOutput, hrewoundOutput] diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Load.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Load.lean index b2f4df6ef8..61e939307a 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Load.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Load.lean @@ -189,6 +189,24 @@ private theorem phaseTransition_of_parked TM.phaseTransition_eq_self_of_reads_ne_start hinput.read_ne_start (fun i => (hwork i).read_ne_start) houtput.read_ne_start +/-- Both indirect lookups preserve the source count used by the final store update. -/ +private theorem indirectLoaded_resultCount + (tapes : BinaryInstructionTapes n) (store : Store) (addressRegister : ℕ) + (initialWork addressWork loadedWork : Fin n → Tape) + (hinitial : EntryLookupStaticReady tapes.lhsLookup store initialWork) + (haddressResult : EntryLookupStaticResult tapes.lhsLookup store addressRegister + initialWork addressWork) + (hloadedResult : EntryLookupRestoreResult tapes.indirectLoadLookup store + (RegisterStore.read store addressRegister) addressWork loadedWork) : + (loadedWork tapes.update.resultCount).HasBinaryNat store.length := by + rw [show loadedWork tapes.update.resultCount = + addressWork tapes.update.resultCount by + simpa using! hloadedResult.countSource] + rw [show addressWork tapes.update.resultCount = + initialWork tapes.update.resultCount by + simpa using! haddressResult.countSource] + simpa using! hinitial.countSource + /-- Exact semantic and time contract for one indirect sparse-register load. -/ theorem indirectLoadInstructionTM_hoareTime_frame_internal (tapes : BinaryInstructionTapes n) (store : Store) @@ -322,15 +340,8 @@ theorem indirectLoadInstructionTM_hoareTime_frame_internal have hresultCountNe : tapes.update.resultCount ≠ tapes.update.entry.query := tapes.update.ne (by decide) - have hresultCount : - (loadedWork tapes.update.resultCount).HasBinaryNat store.length := by - rw [show loadedWork tapes.update.resultCount = - addressWork tapes.update.resultCount by - simpa using! hloadedResult.countSource] - rw [show addressWork tapes.update.resultCount = - initialWork tapes.update.resultCount by - simpa using! haddressResult.countSource] - simpa using! hinitial.countSource + have hresultCount := indirectLoaded_resultCount tapes store addressRegister + initialWork addressWork loadedWork hinitial haddressResult hloadedResult have hrun := entryUpdateTM_hoareTime_frame tapes.update store destination (RegisterStore.read store (RegisterStore.read store addressRegister)) emittedBits updateWork inp₀ out₀ hcanonical hscanner From c9d9d5d3eadbc0f82e0daa9595ac8a77c22f65b7 Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Fri, 25 Sep 2026 20:40:17 +0000 Subject: [PATCH 31/49] Split buffered cleanup and sparse loop proofs into semantic stages --- .../Machine/Instruction/DenseSimData.lean | 340 +++---- .../Machine/Instruction/Sim/Internal.lean | 828 ++++++++++++++++-- .../TMConfig/Sparse/ABI/Internal/Loop.lean | 150 ++-- 3 files changed, 1016 insertions(+), 302 deletions(-) diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseSimData.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseSimData.lean index 87bbaf5faf..8f82701c50 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseSimData.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseSimData.lean @@ -745,6 +745,190 @@ theorem denseExecuteInstructionTM_load_hoareTime_frame DenseOverlay.Snapshot.stepInstr, nextStore, cleanupValues, address, value] using! hall +/-- The dense-store endpoint supplies every frame and cleanup invariant for buffering. -/ +private theorem denseStore_buffered_result + (tapes : ControlInstructionTapes n) (input : List Bool) + (overlay : Store) (pcValue addressRegister source : ℕ) + (initialWork : Fin (n + 1) → Tape) + (hready : InstructionExecutionReady tapes overlay pcValue initialWork) : + ∀ work, DenseIndirectStoreInstructionResult tapes.data input overlay + addressRegister source (fun i => initialWork (Fin.castSucc i)) work → + work tapes.pc = initialWork (Fin.castSucc tapes.pc) ∧ + (work tapes.data.update.resultCount).HasBinaryNat + (DenseOverlay.write overlay (DenseOverlay.read input overlay addressRegister) + (DenseOverlay.read input overlay source)).length ∧ + (work tapes.data.update.entry.source).HasBinaryContent + (overlay.flatMap Entry.encode) ∧ + (∀ slot, + (work (tapes.data.idx (instructionCleanupParentSlot slot))).HasBinaryNat + (denseInstructionCleanupValue input (.store addressRegister source) overlay slot)) ∧ + (work tapes.data.update.remaining).HasBinaryNat 0 ∧ + EntryScanReady tapes.data.update.entry [] + (denseInstructionCleanupValue input (.store addressRegister source) overlay 0).bits + work work ∧ + (work tapes.data.shift).HasBinaryNat 0 ∧ + (work tapes.data.tmp).HasBinaryNat 0 ∧ + (work tapes.data.dbl).HasBinaryNat 0 ∧ + ∀ i, TM.Parked (work i) := by + let baseWork : Fin n → Tape := fun i => initialWork (Fin.castSucc i) + let instruction : Instr := .store addressRegister source + let address := DenseOverlay.read input overlay addressRegister + let value := DenseOverlay.read input overlay source + let nextStore := DenseOverlay.write overlay address value + let cleanupValues := denseInstructionCleanupValue input instruction overlay + intro work hsemantic + obtain ⟨operandsWork, queryWork, updateWork, hoperands, hqueryWork, + hupdateWork, htagged⟩ := hsemantic + obtain ⟨lhsWork, hlhs, hrhsResult⟩ := hoperands + obtain ⟨taggedWork, htagValue, htagFrame, houtcome, + hsourceCells⟩ := htagged + have hpcOutcome : work tapes.pc = taggedWork tapes.pc := + houtcome.frame tapes.pc (fun slot => by + exact tapes.pc_ne ⟨slot, by omega⟩) + have hpcTag : taggedWork tapes.pc = updateWork tapes.pc := + htagFrame tapes.pc (tapes.pc_ne 10) + have hpcReplacement : + tapes.pc ≠ tapes.data.update.replacement := tapes.pc_ne 10 + have hpcUpdate : updateWork tapes.pc = queryWork tapes.pc := by + rw [hupdateWork, Function.update_of_ne hpcReplacement] + have hpcQuery : + tapes.pc ≠ tapes.data.update.entry.query := tapes.pc_ne 7 + have hpcQueryWork : queryWork tapes.pc = operandsWork tapes.pc := by + rw [hqueryWork, Function.update_of_ne hpcQuery] + have hpcRhs : operandsWork tapes.pc = lhsWork tapes.pc := + hrhsResult.frame tapes.pc (fun slot => by + exact tapes.pc_ne (BinaryInstructionTapes.rhsLookupSlot slot)) + have hpcLhs : lhsWork tapes.pc = baseWork tapes.pc := + hlhs.frame tapes.pc (fun slot => by + exact tapes.pc_ne (BinaryInstructionTapes.lhsLookupSlot slot)) + have hsourceContent : + (work tapes.data.update.entry.source).HasBinaryContent + (overlay.flatMap Entry.encode) := by + have hcells : (work tapes.data.update.entry.source).cells = + (baseWork tapes.data.update.entry.source).cells := by + calc + (work tapes.data.update.entry.source).cells = + (updateWork tapes.data.update.entry.source).cells := + hsourceCells + _ = (queryWork tapes.data.update.entry.source).cells := by + congr 1 + rw [hupdateWork] + exact Function.update_of_ne + (tapes.data.update.ne (by decide)) _ _ + _ = (operandsWork tapes.data.update.entry.source).cells := by + congr 1 + rw [hqueryWork] + exact Function.update_of_ne + (tapes.data.update.ne (by decide)) _ _ + _ = (lhsWork tapes.data.update.entry.source).cells := + hrhsResult.sourceCells + _ = (baseWork tapes.data.update.entry.source).cells := + hlhs.sourceCells + unfold Tape.HasBinaryContent + rw [hcells] + exact hready.sourceContent + have hcleanup : ∀ slot, + (work (tapes.data.idx (instructionCleanupParentSlot slot))).HasBinaryNat + (cleanupValues slot) := by + intro slot + fin_cases slot + · exact ⟨houtcome.ready.queryStart, by + simpa [instruction, cleanupValues, denseInstructionCleanupValue, + instructionCleanupParentSlot, address] using! + houtcome.ready.query⟩ + · change (work tapes.data.update.replacement).HasBinaryNat _ + rw [houtcome.replacement] + simpa [instruction, cleanupValues, denseInstructionCleanupValue, + value] using! htagValue + · simpa [instruction, cleanupValues, denseInstructionCleanupValue, + instructionCleanupParentSlot, address] using! houtcome.found + · change (work tapes.data.lhs).HasBinaryNat _ + rw [houtcome.frame tapes.data.lhs (fun role => + (tapes.data.update_ne_lhs role).symm), + htagFrame tapes.data.lhs + (tapes.data.update_ne_lhs 10).symm, + show updateWork tapes.data.lhs = queryWork tapes.data.lhs by + rw [hupdateWork] + exact Function.update_of_ne + (tapes.data.update_ne_lhs 10).symm _ _, + show queryWork tapes.data.lhs = operandsWork tapes.data.lhs by + rw [hqueryWork] + exact Function.update_of_ne + (tapes.data.update_ne_lhs 7).symm _ _, + hrhsResult.frame tapes.data.lhs (fun role => + (tapes.data.rhsLookup_ne_lhs role).symm)] + simpa [instruction, cleanupValues, denseInstructionCleanupValue, + address] using! hlhs.destination + · change (work tapes.data.rhs).HasBinaryNat _ + rw [houtcome.frame tapes.data.rhs (fun role => + (tapes.data.update_ne_rhs role).symm), + htagFrame tapes.data.rhs + (tapes.data.update_ne_rhs 10).symm, + show updateWork tapes.data.rhs = queryWork tapes.data.rhs by + rw [hupdateWork] + exact Function.update_of_ne + (tapes.data.update_ne_rhs 10).symm _ _, + show queryWork tapes.data.rhs = operandsWork tapes.data.rhs by + rw [hqueryWork] + exact Function.update_of_ne + (tapes.data.update_ne_rhs 7).symm _ _] + simpa [instruction, cleanupValues, denseInstructionCleanupValue, + value] using! hrhsResult.destination + have hshift : (work tapes.data.shift).HasBinaryNat 0 := by + have hreplacementNe : + tapes.data.shift ≠ tapes.data.update.replacement := + (tapes.data.update_ne_shift 10).symm + have hqueryNe : + tapes.data.shift ≠ tapes.data.update.entry.query := + (tapes.data.update_ne_shift 7).symm + rw [houtcome.frame tapes.data.shift (fun slot => + (tapes.data.update_ne_shift slot).symm), + htagFrame tapes.data.shift hreplacementNe, + hupdateWork, Function.update_of_ne hreplacementNe, + hqueryWork, Function.update_of_ne hqueryNe] + simpa using! hrhsResult.querySource + have htmp' : (work tapes.data.tmp).HasBinaryNat 0 := by + have hreplacementNe : + tapes.data.tmp ≠ tapes.data.update.replacement := + (tapes.data.update_ne_tmp 10).symm + have hqueryNe : tapes.data.tmp ≠ + tapes.data.update.entry.query := + (tapes.data.update_ne_tmp 7).symm + rw [houtcome.frame tapes.data.tmp (fun slot => + (tapes.data.update_ne_tmp slot).symm), + htagFrame tapes.data.tmp hreplacementNe, + hupdateWork, Function.update_of_ne hreplacementNe, + hqueryWork, Function.update_of_ne hqueryNe, + hrhsResult.frame tapes.data.tmp (fun slot => + (tapes.data.rhsLookup_ne_tmp slot).symm), + hlhs.frame tapes.data.tmp (fun slot => + (tapes.data.lhsLookup_ne_tmp slot).symm)] + exact hready.tmp + have hdbl' : (work tapes.data.dbl).HasBinaryNat 0 := by + have hreplacementNe : + tapes.data.dbl ≠ tapes.data.update.replacement := + (tapes.data.update_ne_dbl 10).symm + have hqueryNe : tapes.data.dbl ≠ + tapes.data.update.entry.query := + (tapes.data.update_ne_dbl 7).symm + rw [houtcome.frame tapes.data.dbl (fun slot => + (tapes.data.update_ne_dbl slot).symm), + htagFrame tapes.data.dbl hreplacementNe, + hupdateWork, Function.update_of_ne hreplacementNe, + hqueryWork, Function.update_of_ne hqueryNe, + hrhsResult.frame tapes.data.dbl (fun slot => + (tapes.data.rhsLookup_ne_dbl slot).symm), + hlhs.frame tapes.data.dbl (fun slot => + (tapes.data.lhsLookup_ne_dbl slot).symm)] + exact hready.dbl + refine ⟨hpcOutcome.trans (hpcTag.trans (hpcUpdate.trans + (hpcQueryWork.trans (hpcRhs.trans hpcLhs)))), ?_, hsourceContent, + hcleanup, ?_, ?_, hshift, htmp', hdbl', houtcome.ready.parked⟩ + · simpa [nextStore, DenseOverlay.write] using! houtcome.resultCount + · simpa using! houtcome.remaining + · simpa [instruction, cleanupValues, denseInstructionCleanupValue, + address] using! houtcome.ready + /-- A dense indirect store produces the generic buffered endpoint and advances the program counter. -/ theorem denseExecuteInstructionTM_store_hoareTime_frame @@ -816,159 +1000,9 @@ theorem denseExecuteInstructionTM_store_hoareTime_frame (work tapes.data.shift).HasBinaryNat 0 ∧ (work tapes.data.tmp).HasBinaryNat 0 ∧ (work tapes.data.dbl).HasBinaryNat 0 ∧ - ∀ i, TM.Parked (work i) := by - intro work hsemantic - obtain ⟨operandsWork, queryWork, updateWork, hoperands, hqueryWork, - hupdateWork, htagged⟩ := hsemantic - obtain ⟨lhsWork, hlhs, hrhsResult⟩ := hoperands - obtain ⟨taggedWork, htagValue, htagFrame, houtcome, - hsourceCells⟩ := htagged - have hpcOutcome : work tapes.pc = taggedWork tapes.pc := - houtcome.frame tapes.pc (fun slot => by - exact tapes.pc_ne ⟨slot, by omega⟩) - have hpcTag : taggedWork tapes.pc = updateWork tapes.pc := - htagFrame tapes.pc (tapes.pc_ne 10) - have hpcReplacement : - tapes.pc ≠ tapes.data.update.replacement := tapes.pc_ne 10 - have hpcUpdate : updateWork tapes.pc = queryWork tapes.pc := by - rw [hupdateWork, Function.update_of_ne hpcReplacement] - have hpcQuery : - tapes.pc ≠ tapes.data.update.entry.query := tapes.pc_ne 7 - have hpcQueryWork : queryWork tapes.pc = operandsWork tapes.pc := by - rw [hqueryWork, Function.update_of_ne hpcQuery] - have hpcRhs : operandsWork tapes.pc = lhsWork tapes.pc := - hrhsResult.frame tapes.pc (fun slot => by - exact tapes.pc_ne (BinaryInstructionTapes.rhsLookupSlot slot)) - have hpcLhs : lhsWork tapes.pc = baseWork tapes.pc := - hlhs.frame tapes.pc (fun slot => by - exact tapes.pc_ne (BinaryInstructionTapes.lhsLookupSlot slot)) - have hsourceContent : - (work tapes.data.update.entry.source).HasBinaryContent - (overlay.flatMap Entry.encode) := by - have hcells : (work tapes.data.update.entry.source).cells = - (baseWork tapes.data.update.entry.source).cells := by - calc - (work tapes.data.update.entry.source).cells = - (updateWork tapes.data.update.entry.source).cells := - hsourceCells - _ = (queryWork tapes.data.update.entry.source).cells := by - congr 1 - rw [hupdateWork] - exact Function.update_of_ne - (tapes.data.update.ne (by decide)) _ _ - _ = (operandsWork tapes.data.update.entry.source).cells := by - congr 1 - rw [hqueryWork] - exact Function.update_of_ne - (tapes.data.update.ne (by decide)) _ _ - _ = (lhsWork tapes.data.update.entry.source).cells := - hrhsResult.sourceCells - _ = (baseWork tapes.data.update.entry.source).cells := - hlhs.sourceCells - unfold Tape.HasBinaryContent - rw [hcells] - exact hready.sourceContent - have hcleanup : ∀ slot, - (work (tapes.data.idx (instructionCleanupParentSlot slot))).HasBinaryNat - (cleanupValues slot) := by - intro slot - fin_cases slot - · exact ⟨houtcome.ready.queryStart, by - simpa [instruction, cleanupValues, denseInstructionCleanupValue, - instructionCleanupParentSlot, address] using! - houtcome.ready.query⟩ - · change (work tapes.data.update.replacement).HasBinaryNat _ - rw [houtcome.replacement] - simpa [instruction, cleanupValues, denseInstructionCleanupValue, - value] using! htagValue - · simpa [instruction, cleanupValues, denseInstructionCleanupValue, - instructionCleanupParentSlot, address] using! houtcome.found - · change (work tapes.data.lhs).HasBinaryNat _ - rw [houtcome.frame tapes.data.lhs (fun role => - (tapes.data.update_ne_lhs role).symm), - htagFrame tapes.data.lhs - (tapes.data.update_ne_lhs 10).symm, - show updateWork tapes.data.lhs = queryWork tapes.data.lhs by - rw [hupdateWork] - exact Function.update_of_ne - (tapes.data.update_ne_lhs 10).symm _ _, - show queryWork tapes.data.lhs = operandsWork tapes.data.lhs by - rw [hqueryWork] - exact Function.update_of_ne - (tapes.data.update_ne_lhs 7).symm _ _, - hrhsResult.frame tapes.data.lhs (fun role => - (tapes.data.rhsLookup_ne_lhs role).symm)] - simpa [instruction, cleanupValues, denseInstructionCleanupValue, - address] using! hlhs.destination - · change (work tapes.data.rhs).HasBinaryNat _ - rw [houtcome.frame tapes.data.rhs (fun role => - (tapes.data.update_ne_rhs role).symm), - htagFrame tapes.data.rhs - (tapes.data.update_ne_rhs 10).symm, - show updateWork tapes.data.rhs = queryWork tapes.data.rhs by - rw [hupdateWork] - exact Function.update_of_ne - (tapes.data.update_ne_rhs 10).symm _ _, - show queryWork tapes.data.rhs = operandsWork tapes.data.rhs by - rw [hqueryWork] - exact Function.update_of_ne - (tapes.data.update_ne_rhs 7).symm _ _] - simpa [instruction, cleanupValues, denseInstructionCleanupValue, - value] using! hrhsResult.destination - have hshift : (work tapes.data.shift).HasBinaryNat 0 := by - have hreplacementNe : - tapes.data.shift ≠ tapes.data.update.replacement := - (tapes.data.update_ne_shift 10).symm - have hqueryNe : - tapes.data.shift ≠ tapes.data.update.entry.query := - (tapes.data.update_ne_shift 7).symm - rw [houtcome.frame tapes.data.shift (fun slot => - (tapes.data.update_ne_shift slot).symm), - htagFrame tapes.data.shift hreplacementNe, - hupdateWork, Function.update_of_ne hreplacementNe, - hqueryWork, Function.update_of_ne hqueryNe] - simpa using! hrhsResult.querySource - have htmp' : (work tapes.data.tmp).HasBinaryNat 0 := by - have hreplacementNe : - tapes.data.tmp ≠ tapes.data.update.replacement := - (tapes.data.update_ne_tmp 10).symm - have hqueryNe : tapes.data.tmp ≠ - tapes.data.update.entry.query := - (tapes.data.update_ne_tmp 7).symm - rw [houtcome.frame tapes.data.tmp (fun slot => - (tapes.data.update_ne_tmp slot).symm), - htagFrame tapes.data.tmp hreplacementNe, - hupdateWork, Function.update_of_ne hreplacementNe, - hqueryWork, Function.update_of_ne hqueryNe, - hrhsResult.frame tapes.data.tmp (fun slot => - (tapes.data.rhsLookup_ne_tmp slot).symm), - hlhs.frame tapes.data.tmp (fun slot => - (tapes.data.lhsLookup_ne_tmp slot).symm)] - exact hready.tmp - have hdbl' : (work tapes.data.dbl).HasBinaryNat 0 := by - have hreplacementNe : - tapes.data.dbl ≠ tapes.data.update.replacement := - (tapes.data.update_ne_dbl 10).symm - have hqueryNe : tapes.data.dbl ≠ - tapes.data.update.entry.query := - (tapes.data.update_ne_dbl 7).symm - rw [houtcome.frame tapes.data.dbl (fun slot => - (tapes.data.update_ne_dbl slot).symm), - htagFrame tapes.data.dbl hreplacementNe, - hupdateWork, Function.update_of_ne hreplacementNe, - hqueryWork, Function.update_of_ne hqueryNe, - hrhsResult.frame tapes.data.dbl (fun slot => - (tapes.data.rhsLookup_ne_dbl slot).symm), - hlhs.frame tapes.data.dbl (fun slot => - (tapes.data.lhsLookup_ne_dbl slot).symm)] - exact hready.dbl - refine ⟨hpcOutcome.trans (hpcTag.trans (hpcUpdate.trans - (hpcQueryWork.trans (hpcRhs.trans hpcLhs)))), ?_, hsourceContent, - hcleanup, ?_, ?_, hshift, htmp', hdbl', houtcome.ready.parked⟩ - · simpa [nextStore, DenseOverlay.write] using! houtcome.resultCount - · simpa using! houtcome.remaining - · simpa [instruction, cleanupValues, denseInstructionCleanupValue, - address] using! houtcome.ready + ∀ i, TM.Parked (work i) := + denseStore_buffered_result tapes input overlay pcValue addressRegister source + initialWork hready have hdata := retargetBufferedDataKernel_hoareTime_frame_internal tapes overlay nextStore cleanupValues 0 pcValue initialWork inp₀ (denseIndirectStoreInstructionTM tapes.data addressRegister source) diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Sim/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Sim/Internal.lean index 58c6c42ef5..00a3a66980 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Sim/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Sim/Internal.lean @@ -83,6 +83,83 @@ private theorem phaseTransition_of_parked TM.phaseTransition_eq_self_of_reads_ne_start hinput.read_ne_start (fun i => (hwork i).read_ne_start) houtput.read_ne_start +/-- Reset the dispatch selector and execute halt when the program list is empty. -/ +private theorem dispatchEmptyProgramTM_hoareTime + (tapes : ControlInstructionTapes n) + (store : Store) (pcValue selector : ℕ) + (cleanWork work₀ : Fin (n + 1) → Tape) (inp₀ out₀ : Tape) + (hready : DispatchReady tapes store pcValue selector cleanWork work₀) + (hinput : TM.Parked inp₀) (houtput : TM.Parked out₀) + (hexecute : ∀ instruction, + (executeInstructionTM tapes instruction).HoareTime + (fun inp work out => + inp = inp₀ ∧ work = cleanWork ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + InstructionExecutionResult tapes instruction pcValue store work ∧ + out = out₀) + (executeInstructionTime tapes instruction pcValue store)) : + (dispatchProgramTM tapes ([] : Program)).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + InstructionExecutionResult tapes + (selectedInstruction ([] : Program) selector) pcValue store work ∧ + out = out₀) + (dispatchProgramTime tapes store pcValue ([] : Program) selector) := by + let blankTape := (Tape.init []).move Dir3.right + have hselector : (work₀ tapes.liftedLhs).HasBinaryNat selector := by + rw [hready.2] + simp only [Function.update_self] + exact Tape.init_move_right_hasBinaryNat selector + have hcleanLhs : cleanWork tapes.liftedLhs = blankTape := by + have hzero := hready.1.control.lookup.destination + change (cleanWork tapes.liftedLhs).HasBinaryNat 0 at hzero + simpa only [blankTape] using! + Tape.HasBinaryNat.eq_init_move_right hzero + have hwork₀Parked : ∀ i, TM.Parked (work₀ i) := by + intro i + rw [hready.2] + by_cases hi : i = tapes.liftedLhs + · subst i + simp only [Function.update_self] + exact hasBinaryNat_parked (Tape.init_move_right_hasBinaryNat selector) + · simp only [Function.update_of_ne hi] + exact hready.1.control.lookup.scanner.parked i + have hreset := TM.resetBinaryWorkTM_hoareTime_frame tapes.liftedLhs + selector.bits 1 inp₀ work₀ out₀ + hselector.2.hasBinaryContent hselector.1 + ⟨by rw [hselector.2.1], by rw [hselector.2.1]⟩ + hinput (fun i _ => hwork₀Parked i) houtput + have hreset' : (TM.resetBinaryWorkTM tapes.liftedLhs).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => inp = inp₀ ∧ work = cleanWork ∧ out = out₀) + (TM.resetBinaryWorkTime 1 selector.bits.length) := by + apply hreset.consequence + · exact fun _ _ _ h => h + · rintro inp work out ⟨hinp, hworkEq, hout⟩ + refine ⟨hinp, ?_, hout⟩ + rw [hworkEq, hready.2, Function.update_idem] + change Function.update cleanWork tapes.liftedLhs blankTape = cleanWork + rw [← hcleanLhs, Function.update_eq_self] + · exact le_rfl + have hseq := TM.seqTM_hoareTime + (TM.resetBinaryWorkTM tapes.liftedLhs) + (executeInstructionTM tapes .halt) hreset' + (by + rintro inp work out ⟨hinp, hworkEq, hout⟩ + obtain ⟨hi, hw, ho⟩ := phaseTransition_of_parked + (inp := inp) (work := work) (out := out) + (by simpa [hinp] using hinput) + (by simpa [hworkEq] using + hready.1.control.lookup.scanner.parked) + (by simpa [hout] using houtput) + rw [hi, hw, ho] + exact ⟨hinp, hworkEq, hout⟩) + (hexecute .halt) + simpa only [dispatchProgramTM, dispatchProgramTime, + selectedInstruction] using hseq + /-- The finite decrementing branch tree selects the corresponding static instruction, assuming the individual instruction kernels satisfy their common semantic contract. -/ @@ -111,58 +188,8 @@ theorem dispatchProgramTM_hoareTime_of_execute_internal (dispatchProgramTime tapes store pcValue program selector) := by induction program generalizing selector work₀ with | nil => - let blankTape := (Tape.init []).move Dir3.right - have hselector : (work₀ tapes.liftedLhs).HasBinaryNat selector := by - rw [hready.2] - simp only [Function.update_self] - exact Tape.init_move_right_hasBinaryNat selector - have hcleanLhs : cleanWork tapes.liftedLhs = blankTape := by - have hzero := hready.1.control.lookup.destination - change (cleanWork tapes.liftedLhs).HasBinaryNat 0 at hzero - simpa only [blankTape] using! - Tape.HasBinaryNat.eq_init_move_right hzero - have hwork₀Parked : ∀ i, TM.Parked (work₀ i) := by - intro i - rw [hready.2] - by_cases hi : i = tapes.liftedLhs - · subst i - simp only [Function.update_self] - exact hasBinaryNat_parked (Tape.init_move_right_hasBinaryNat selector) - · simp only [Function.update_of_ne hi] - exact hready.1.control.lookup.scanner.parked i - have hreset := TM.resetBinaryWorkTM_hoareTime_frame tapes.liftedLhs - selector.bits 1 inp₀ work₀ out₀ - hselector.2.hasBinaryContent hselector.1 - ⟨by rw [hselector.2.1], by rw [hselector.2.1]⟩ - hinput (fun i _ => hwork₀Parked i) houtput - have hreset' : (TM.resetBinaryWorkTM tapes.liftedLhs).HoareTime - (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) - (fun inp work out => inp = inp₀ ∧ work = cleanWork ∧ out = out₀) - (TM.resetBinaryWorkTime 1 selector.bits.length) := by - apply hreset.consequence - · exact fun _ _ _ h => h - · rintro inp work out ⟨hinp, hworkEq, hout⟩ - refine ⟨hinp, ?_, hout⟩ - rw [hworkEq, hready.2, Function.update_idem] - change Function.update cleanWork tapes.liftedLhs blankTape = cleanWork - rw [← hcleanLhs, Function.update_eq_self] - · exact le_rfl - have hseq := TM.seqTM_hoareTime - (TM.resetBinaryWorkTM tapes.liftedLhs) - (executeInstructionTM tapes .halt) hreset' - (by - rintro inp work out ⟨hinp, hworkEq, hout⟩ - obtain ⟨hi, hw, ho⟩ := phaseTransition_of_parked - (inp := inp) (work := work) (out := out) - (by simpa [hinp] using hinput) - (by simpa [hworkEq] using - hready.1.control.lookup.scanner.parked) - (by simpa [hout] using houtput) - rw [hi, hw, ho] - exact ⟨hinp, hworkEq, hout⟩) - (hexecute .halt) - simpa only [dispatchProgramTM, dispatchProgramTime, - selectedInstruction] using hseq + exact dispatchEmptyProgramTM_hoareTime tapes store pcValue selector + cleanWork work₀ inp₀ out₀ hready hinput houtput hexecute | cons instruction program ih => let pre : TM.TapePred (n + 1) := fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀ @@ -320,32 +347,50 @@ theorem dispatchProgramTM_hoareTime_of_execute_internal hdispatch.consequence (fun _ _ _ h => h) (fun _ _ _ h => h.elim id id) le_rfl -/-- Any buffered representation endpoint is restored to the reusable clean ABI. -/ -theorem bufferedCleanupTM_hoareTime_frame_internal - (tapes : ControlInstructionTapes n) (oldStore nextStore : Store) - (nextPC : ℕ) (cleanupValues : Fin 5 → ℕ) (remainingValue : ℕ) +/-- Reset the seven cleanup targets while preserving the buffer and all other data roles. -/ +private theorem bufferedCleanup_resetPhase + (tapes : ControlInstructionTapes n) + (oldStore : Store) + (nextStore : Store) + (nextPC : ℕ) + (cleanupValues : Fin 5 → ℕ) + (remainingValue : ℕ) (sourceHeadBound : ℕ) - (initialWork : Fin (n + 1) → Tape) (inp₀ out₀ : Tape) + (initialWork : Fin (n + 1) → Tape) + (inp₀ : Tape) + (out₀ : Tape) (hready : BufferedCleanupReady tapes oldStore nextStore nextPC cleanupValues remainingValue sourceHeadBound initialWork) - (hinput : TM.Parked inp₀) (houtput : TM.Parked out₀) : - (instructionCleanupTM tapes).HoareTime - (fun inp work out => - inp = inp₀ ∧ work = initialWork ∧ out = out₀) - (fun inp work out => - inp = inp₀ ∧ - InstructionExecutionReady tapes nextStore nextPC work ∧ - out = out₀) - (bufferedCleanupTime tapes oldStore nextStore cleanupValues - remainingValue sourceHeadBound) := by - let nextBits := nextStore.flatMap Entry.encode + (hinput : TM.Parked inp₀) + (houtput : TM.Parked out₀) + : + let targets := instructionCleanupResetTargets tapes + let resetBits := bufferedCleanupResetBitsAt tapes cleanupValues + remainingValue oldStore + let resetHeads := + instructionCleanupResetHeadBoundAt tapes sourceHeadBound + let resetWork := TM.resetBinaryWorkManyResult initialWork targets + ((TM.resetBinaryWorkManyTM targets).HoareTime + (fun inp work out => inp = inp₀ ∧ work = initialWork ∧ out = out₀) + (fun inp work out => inp = inp₀ ∧ work = resetWork ∧ out = out₀) + (TM.resetBinaryWorkManyTime resetBits resetHeads targets)) ∧ + (∀ (role : Fin 18) + (hrole : ∀ slot : Fin 7, + role ≠ instructionCleanupResetParentSlot slot), + resetWork (tapes.lifted.data.idx role) = + initialWork (tapes.lifted.data.idx role)) ∧ + (resetWork tapes.buffer = initialWork tapes.buffer) ∧ + (∀ i, TM.Parked (resetWork i)) ∧ + (∀ (slot : Fin 7), + resetWork (instructionCleanupResetTape tapes slot) = + TM.resetBinaryBlank) := by + dsimp only let targets := instructionCleanupResetTargets tapes let resetBits := bufferedCleanupResetBitsAt tapes cleanupValues remainingValue oldStore let resetHeads := instructionCleanupResetHeadBoundAt tapes sourceHeadBound let resetWork := TM.resetBinaryWorkManyResult initialWork targets - let nextTape := (Tape.init (nextBits.map Γ.ofBool)).move Dir3.right have hresetContentIndexed : ∀ slot, (initialWork (instructionCleanupResetTape tapes slot)).HasBinaryContent (bufferedCleanupResetBits cleanupValues remainingValue oldStore @@ -436,6 +481,53 @@ theorem bufferedCleanupTM_hoareTime_frame_internal have hresetParked : ∀ i, TM.Parked (resetWork i) := by exact TM.resetBinaryWorkManyResult_parked initialWork targets hready.result.parked + have hresetTarget (slot : Fin 7) : + resetWork (instructionCleanupResetTape tapes slot) = + TM.resetBinaryBlank := by + exact TM.resetBinaryWorkManyResult_eq_blank_of_mem initialWork targets _ + (List.mem_ofFn.mpr ⟨slot, rfl⟩) + exact ⟨hreset, hresetDataOutside, hresetBuffer, hresetParked, hresetTarget⟩ + +/-- Rewind the preserved next-store buffer with the source blank and all tapes parked. -/ +private theorem bufferedCleanup_rewindBufferPhase + (tapes : ControlInstructionTapes n) + (oldStore : Store) + (nextStore : Store) + (nextPC : ℕ) + (cleanupValues : Fin 5 → ℕ) + (remainingValue : ℕ) + (sourceHeadBound : ℕ) + (initialWork : Fin (n + 1) → Tape) + (inp₀ : Tape) + (out₀ : Tape) + (hready : BufferedCleanupReady tapes oldStore nextStore nextPC + cleanupValues remainingValue sourceHeadBound initialWork) + (hinput : TM.Parked inp₀) + (houtput : TM.Parked out₀) + : + let nextBits := nextStore.flatMap Entry.encode + let targets := instructionCleanupResetTargets tapes + let resetWork := TM.resetBinaryWorkManyResult initialWork targets + let nextTape := (Tape.init (nextBits.map Γ.ofBool)).move Dir3.right + let rewoundWork := Function.update resetWork tapes.buffer nextTape + (resetWork tapes.buffer = initialWork tapes.buffer) → + (∀ i, TM.Parked (resetWork i)) → + (∀ (slot : Fin 7), + resetWork (instructionCleanupResetTape tapes slot) = + TM.resetBinaryBlank) → + ((TM.rewindWorkTM tapes.buffer).HoareTime + (fun inp work out => inp = inp₀ ∧ work = resetWork ∧ out = out₀) + (fun inp work out => inp = inp₀ ∧ work = rewoundWork ∧ out = out₀) + (nextBits.length + 1 + 2)) ∧ + (rewoundWork tapes.liftedSource = TM.resetBinaryBlank) ∧ + (∀ i, TM.Parked (rewoundWork i)) := by + dsimp only + intro hresetBuffer hresetParked hresetTarget + let nextBits := nextStore.flatMap Entry.encode + let targets := instructionCleanupResetTargets tapes + let resetWork := TM.resetBinaryWorkManyResult initialWork targets + let nextTape := (Tape.init (nextBits.map Γ.ofBool)).move Dir3.right + let rewoundWork := Function.update resetWork tapes.buffer nextTape have hresetBufferContent : (resetWork tapes.buffer).HasBinaryContent nextBits := by rw [hresetBuffer] @@ -452,7 +544,6 @@ theorem bufferedCleanupTM_hoareTime_frame_internal hresetBufferContent hresetBufferStart ⟨by rw [hresetBufferHead]; omega, hresetBufferHead.le⟩ hinput (fun i _ => hresetParked i) houtput - let rewoundWork := Function.update resetWork tapes.buffer nextTape have hrewind : (TM.rewindWorkTM tapes.buffer).HoareTime (fun inp work out => inp = inp₀ ∧ work = resetWork ∧ out = out₀) (fun inp work out => inp = inp₀ ∧ work = rewoundWork ∧ out = out₀) @@ -465,11 +556,6 @@ theorem bufferedCleanupTM_hoareTime_frame_internal simpa [rewoundWork, nextTape] using htarget · simp [rewoundWork, hi, hframe i hi] exact ⟨hinp, hwork, hout⟩) - have hresetTarget (slot : Fin 7) : - resetWork (instructionCleanupResetTape tapes slot) = - TM.resetBinaryBlank := by - exact TM.resetBinaryWorkManyResult_eq_blank_of_mem initialWork targets _ - (List.mem_ofFn.mpr ⟨slot, rfl⟩) have hresetSource : resetWork tapes.liftedSource = TM.resetBinaryBlank := by simpa [instructionCleanupResetTape, instructionCleanupResetParentSlot, ControlInstructionTapes.liftedSource] using! hresetTarget 6 @@ -485,6 +571,48 @@ theorem bufferedCleanupTM_hoareTime_frame_internal (Tape.init_move_right_hasBinaryString nextBits) · simp only [rewoundWork, Function.update_of_ne hi] exact hresetParked i + exact ⟨hrewind, hrewoundSource, hrewoundParked⟩ + +/-- Copy the next-store bits from the rewound buffer to the blank source with an exact frame. -/ +private theorem bufferedCleanup_copyPhase + (tapes : ControlInstructionTapes n) + (nextStore : Store) + (initialWork : Fin (n + 1) → Tape) + (inp₀ : Tape) + (out₀ : Tape) + (hinput : TM.Parked inp₀) + (houtput : TM.Parked out₀) + : + let nextBits := nextStore.flatMap Entry.encode + let targets := instructionCleanupResetTargets tapes + let resetWork := TM.resetBinaryWorkManyResult initialWork targets + let nextTape := (Tape.init (nextBits.map Γ.ofBool)).move Dir3.right + let rewoundWork := Function.update resetWork tapes.buffer nextTape + let prefixTape := instructionCleanupPrefixTape nextBits + let copiedWork := Function.update + (Function.update rewoundWork tapes.buffer prefixTape) + tapes.liftedSource prefixTape + (rewoundWork tapes.liftedSource = TM.resetBinaryBlank) → + (∀ i, TM.Parked (rewoundWork i)) → + ((TM.copyWorkToWorkTM tapes.buffer tapes.liftedSource).HoareTime + (fun inp work out => + inp = inp₀ ∧ work = rewoundWork ∧ out = out₀) + (fun inp work out => inp = inp₀ ∧ work = copiedWork ∧ out = out₀) + (nextBits.length + 1)) ∧ + (copiedWork tapes.buffer = prefixTape) ∧ + (copiedWork tapes.liftedSource = prefixTape) ∧ + (∀ i, TM.Parked (copiedWork i)) := by + dsimp only + intro hrewoundSource hrewoundParked + let nextBits := nextStore.flatMap Entry.encode + let targets := instructionCleanupResetTargets tapes + let resetWork := TM.resetBinaryWorkManyResult initialWork targets + let nextTape := (Tape.init (nextBits.map Γ.ofBool)).move Dir3.right + let rewoundWork := Function.update resetWork tapes.buffer nextTape + let prefixTape := instructionCleanupPrefixTape nextBits + let copiedWork := Function.update + (Function.update rewoundWork tapes.buffer prefixTape) + tapes.liftedSource prefixTape let copyFrame : TM.TapePred (n + 1) := fun inp work out => inp = inp₀ ∧ out = out₀ ∧ ∀ i, i ≠ tapes.buffer → i ≠ tapes.liftedSource → @@ -523,10 +651,6 @@ theorem bufferedCleanupTM_hoareTime_frame_internal exact ⟨(hrewoundParked i).read_ne_start, (hrewoundParked i).1⟩ · exact ⟨hinp, hout, fun _ _ _ => rfl⟩) (fun _ _ _ h => h) le_rfl - let prefixTape := instructionCleanupPrefixTape nextBits - let copiedWork := Function.update - (Function.update rewoundWork tapes.buffer prefixTape) - tapes.liftedSource prefixTape have hcopy : (TM.copyWorkToWorkTM tapes.buffer tapes.liftedSource).HoareTime (fun inp work out => @@ -573,6 +697,65 @@ theorem bufferedCleanupTM_hoareTime_frame_internal instructionCleanupPrefixTape_parked nextBits · simp [copiedWork, hiSource, hiBuffer] exact hrewoundParked i + exact ⟨hcopy, hcopiedBuffer, hcopiedSource, hcopiedParked⟩ + +/-- Clear the copied buffer and rewind the source, preserving the other reset tapes. -/ +private theorem bufferedCleanup_restoreSourcePhase + (tapes : ControlInstructionTapes n) + (nextStore : Store) + (initialWork : Fin (n + 1) → Tape) + (inp₀ : Tape) + (out₀ : Tape) + (hinput : TM.Parked inp₀) + (houtput : TM.Parked out₀) + : + let nextBits := nextStore.flatMap Entry.encode + let targets := instructionCleanupResetTargets tapes + let resetWork := TM.resetBinaryWorkManyResult initialWork targets + let nextTape := (Tape.init (nextBits.map Γ.ofBool)).move Dir3.right + let rewoundWork := Function.update resetWork tapes.buffer nextTape + let prefixTape := instructionCleanupPrefixTape nextBits + let copiedWork := Function.update + (Function.update rewoundWork tapes.buffer prefixTape) + tapes.liftedSource prefixTape + let bufferResetWork := Function.update copiedWork tapes.buffer + ((Tape.init []).move Dir3.right) + let sourceReadyWork := Function.update bufferResetWork tapes.liftedSource + nextTape + (copiedWork tapes.buffer = prefixTape) → + (copiedWork tapes.liftedSource = prefixTape) → + (∀ i, TM.Parked (copiedWork i)) → + (∀ i, TM.Parked (resetWork i)) → + ((TM.resetBinaryWorkTM tapes.buffer).HoareTime + (fun inp work out => inp = inp₀ ∧ work = copiedWork ∧ out = out₀) + (fun inp work out => inp = inp₀ ∧ work = bufferResetWork ∧ out = out₀) + (TM.resetBinaryWorkTime (nextBits.length + 1) nextBits.length)) ∧ + ((TM.rewindWorkTM tapes.liftedSource).HoareTime + (fun inp work out => + inp = inp₀ ∧ work = bufferResetWork ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ work = sourceReadyWork ∧ out = out₀) + (nextBits.length + 1 + 2)) ∧ + (∀ (i : Fin (n + 1)) + (hiSource : i ≠ tapes.liftedSource) (hiBuffer : i ≠ tapes.buffer), + sourceReadyWork i = resetWork i) ∧ + (∀ i, TM.Parked (sourceReadyWork i)) ∧ + (∀ i, TM.Parked (bufferResetWork i)) := by + dsimp only + intro hcopiedBuffer hcopiedSource hcopiedParked hresetParked + let nextBits := nextStore.flatMap Entry.encode + let targets := instructionCleanupResetTargets tapes + let resetWork := TM.resetBinaryWorkManyResult initialWork targets + let nextTape := (Tape.init (nextBits.map Γ.ofBool)).move Dir3.right + let rewoundWork := Function.update resetWork tapes.buffer nextTape + let prefixTape := instructionCleanupPrefixTape nextBits + let copiedWork := Function.update + (Function.update rewoundWork tapes.buffer prefixTape) + tapes.liftedSource prefixTape + let bufferResetWork := Function.update copiedWork tapes.buffer + ((Tape.init []).move Dir3.right) + let sourceReadyWork := Function.update bufferResetWork tapes.liftedSource + nextTape have hresetBufferRaw := TM.resetBinaryWorkTM_hoareTime_frame tapes.buffer nextBits (nextBits.length + 1) inp₀ copiedWork out₀ (by @@ -585,8 +768,6 @@ theorem bufferedCleanupTM_hoareTime_frame_internal rw [hcopiedBuffer] exact ⟨by simp [prefixTape, instructionCleanupPrefixTape], le_rfl⟩) hinput (fun i _ => hcopiedParked i) houtput - let bufferResetWork := Function.update copiedWork tapes.buffer - ((Tape.init []).move Dir3.right) have hresetBufferPhase : (TM.resetBinaryWorkTM tapes.buffer).HoareTime (fun inp work out => inp = inp₀ ∧ work = copiedWork ∧ out = out₀) (fun inp work out => inp = inp₀ ∧ work = bufferResetWork ∧ out = out₀) @@ -617,8 +798,6 @@ theorem bufferedCleanupTM_hoareTime_frame_internal rw [hbufferResetSource] exact ⟨by simp [prefixTape, instructionCleanupPrefixTape], le_rfl⟩) hinput (fun i _ => hbufferResetParked i) houtput - let sourceReadyWork := Function.update bufferResetWork tapes.liftedSource - nextTape have hrewindSource : (TM.rewindWorkTM tapes.liftedSource).HoareTime (fun inp work out => inp = inp₀ ∧ work = bufferResetWork ∧ out = out₀) @@ -653,6 +832,81 @@ theorem bufferedCleanupTM_hoareTime_frame_internal exact hbufferResetParked tapes.buffer · rw [hsourceReadyOutside i hiSource hiBuffer] exact hresetParked i + exact ⟨hresetBufferPhase, hrewindSource, hsourceReadyOutside, + hsourceReadyParked, hbufferResetParked⟩ + +/-- Copy the next-store entry count into the cleared remaining-count tape. -/ +private theorem bufferedCleanup_copyCountPhase + (tapes : ControlInstructionTapes n) + (oldStore : Store) + (nextStore : Store) + (nextPC : ℕ) + (cleanupValues : Fin 5 → ℕ) + (remainingValue : ℕ) + (sourceHeadBound : ℕ) + (initialWork : Fin (n + 1) → Tape) + (inp₀ : Tape) + (out₀ : Tape) + (hready : BufferedCleanupReady tapes oldStore nextStore nextPC + cleanupValues remainingValue sourceHeadBound initialWork) + (hinput : TM.Parked inp₀) + (houtput : TM.Parked out₀) + : + let nextBits := nextStore.flatMap Entry.encode + let targets := instructionCleanupResetTargets tapes + let resetWork := TM.resetBinaryWorkManyResult initialWork targets + let nextTape := (Tape.init (nextBits.map Γ.ofBool)).move Dir3.right + let rewoundWork := Function.update resetWork tapes.buffer nextTape + let prefixTape := instructionCleanupPrefixTape nextBits + let copiedWork := Function.update + (Function.update rewoundWork tapes.buffer prefixTape) + tapes.liftedSource prefixTape + let bufferResetWork := Function.update copiedWork tapes.buffer + ((Tape.init []).move Dir3.right) + let sourceReadyWork := Function.update bufferResetWork tapes.liftedSource + nextTape + let countTape := + (Tape.init (nextStore.length.bits.map Γ.ofBool)).move Dir3.right + let finalWork := Function.update sourceReadyWork + tapes.lifted.data.update.remaining countTape + (∀ (i : Fin (n + 1)) + (hiSource : i ≠ tapes.liftedSource) (hiBuffer : i ≠ tapes.buffer), + sourceReadyWork i = resetWork i) → + (∀ (role : Fin 18) + (hrole : ∀ slot : Fin 7, + role ≠ instructionCleanupResetParentSlot slot), + resetWork (tapes.lifted.data.idx role) = + initialWork (tapes.lifted.data.idx role)) → + (∀ (slot : Fin 7), + resetWork (instructionCleanupResetTape tapes slot) = + TM.resetBinaryBlank) → + (∀ i, TM.Parked (sourceReadyWork i)) → + ((TM.binaryCopyIntoTM tapes.lifted.data.update.resultCount + tapes.lifted.data.update.remaining + tapes.lifted.data.update.found).HoareTime + (fun inp work out => + inp = inp₀ ∧ work = sourceReadyWork ∧ out = out₀) + (fun inp work out => inp = inp₀ ∧ work = finalWork ∧ out = out₀) + (TM.binaryCopyTime nextStore.length 0)) := by + dsimp only + intro hsourceReadyOutside hresetDataOutside hresetTarget hsourceReadyParked + let nextBits := nextStore.flatMap Entry.encode + let targets := instructionCleanupResetTargets tapes + let resetWork := TM.resetBinaryWorkManyResult initialWork targets + let nextTape := (Tape.init (nextBits.map Γ.ofBool)).move Dir3.right + let rewoundWork := Function.update resetWork tapes.buffer nextTape + let prefixTape := instructionCleanupPrefixTape nextBits + let copiedWork := Function.update + (Function.update rewoundWork tapes.buffer prefixTape) + tapes.liftedSource prefixTape + let bufferResetWork := Function.update copiedWork tapes.buffer + ((Tape.init []).move Dir3.right) + let sourceReadyWork := Function.update bufferResetWork tapes.liftedSource + nextTape + let countTape := + (Tape.init (nextStore.length.bits.map Γ.ofBool)).move Dir3.right + let finalWork := Function.update sourceReadyWork + tapes.lifted.data.update.remaining countTape have hresultCount : (sourceReadyWork tapes.lifted.data.update.resultCount).HasBinaryNat nextStore.length := by @@ -691,10 +945,6 @@ theorem bufferedCleanupTM_hoareTime_frame_internal (tapes.lifted.data.ne (by decide)) nextStore.length 0 inp₀ sourceReadyWork out₀ hresultCount hremainingZero hfoundZero hinput (fun i _ _ _ => hsourceReadyParked i) houtput - let countTape := - (Tape.init (nextStore.length.bits.map Γ.ofBool)).move Dir3.right - let finalWork := Function.update sourceReadyWork - tapes.lifted.data.update.remaining countTape have hcountCopy : (TM.binaryCopyIntoTM tapes.lifted.data.update.resultCount tapes.lifted.data.update.remaining @@ -704,6 +954,75 @@ theorem bufferedCleanupTM_hoareTime_frame_internal (fun inp work out => inp = inp₀ ∧ work = finalWork ∧ out = out₀) (TM.binaryCopyTime nextStore.length 0) := by simpa only [finalWork, countTape] using hcountCopyRaw + exact hcountCopy + +/-- Identify the preserved, cleared, and refreshed roles in the final work-tape frame. -/ +private theorem bufferedCleanup_finalFrame + (tapes : ControlInstructionTapes n) + (nextStore : Store) + (initialWork : Fin (n + 1) → Tape) + : + let nextBits := nextStore.flatMap Entry.encode + let targets := instructionCleanupResetTargets tapes + let resetWork := TM.resetBinaryWorkManyResult initialWork targets + let nextTape := (Tape.init (nextBits.map Γ.ofBool)).move Dir3.right + let rewoundWork := Function.update resetWork tapes.buffer nextTape + let prefixTape := instructionCleanupPrefixTape nextBits + let copiedWork := Function.update + (Function.update rewoundWork tapes.buffer prefixTape) + tapes.liftedSource prefixTape + let bufferResetWork := Function.update copiedWork tapes.buffer + ((Tape.init []).move Dir3.right) + let sourceReadyWork := Function.update bufferResetWork tapes.liftedSource + nextTape + let countTape := + (Tape.init (nextStore.length.bits.map Γ.ofBool)).move Dir3.right + let finalWork := Function.update sourceReadyWork + tapes.lifted.data.update.remaining countTape + (∀ (i : Fin (n + 1)) + (hiSource : i ≠ tapes.liftedSource) (hiBuffer : i ≠ tapes.buffer), + sourceReadyWork i = resetWork i) → + (∀ (role : Fin 18) + (hrole : ∀ slot : Fin 7, + role ≠ instructionCleanupResetParentSlot slot), + resetWork (tapes.lifted.data.idx role) = + initialWork (tapes.lifted.data.idx role)) → + (∀ (slot : Fin 7), + resetWork (instructionCleanupResetTape tapes slot) = + TM.resetBinaryBlank) → + (∀ i, TM.Parked (sourceReadyWork i)) → + (∀ (role : Fin 18) + (hremaining : role ≠ 9) (hsource : role ≠ 0) + (hreset : ∀ slot : Fin 7, + role ≠ instructionCleanupResetParentSlot slot), + finalWork (tapes.lifted.data.idx role) = + initialWork (tapes.lifted.data.idx role)) ∧ + (∀ (slot : Fin 5), + finalWork (instructionCleanupTape tapes slot) = + TM.resetBinaryBlank) ∧ + (TM.resetBinaryBlank.HasBinaryNat 0) ∧ + (finalWork tapes.liftedSource = nextTape) ∧ + (finalWork tapes.buffer = (Tape.init []).move Dir3.right) ∧ + (∀ i, TM.Parked (finalWork i)) := by + dsimp only + intro hsourceReadyOutside hresetDataOutside hresetTarget hsourceReadyParked + let nextBits := nextStore.flatMap Entry.encode + let targets := instructionCleanupResetTargets tapes + let resetWork := TM.resetBinaryWorkManyResult initialWork targets + let nextTape := (Tape.init (nextBits.map Γ.ofBool)).move Dir3.right + let rewoundWork := Function.update resetWork tapes.buffer nextTape + let prefixTape := instructionCleanupPrefixTape nextBits + let copiedWork := Function.update + (Function.update rewoundWork tapes.buffer prefixTape) + tapes.liftedSource prefixTape + let bufferResetWork := Function.update copiedWork tapes.buffer + ((Tape.init []).move Dir3.right) + let sourceReadyWork := Function.update bufferResetWork tapes.liftedSource + nextTape + let countTape := + (Tape.init (nextStore.length.bits.map Γ.ofBool)).move Dir3.right + let finalWork := Function.update sourceReadyWork + tapes.lifted.data.update.remaining countTape have hfinalDataOutside (role : Fin 18) (hremaining : role ≠ 9) (hsource : role ≠ 0) : finalWork (tapes.lifted.data.idx role) = @@ -774,6 +1093,71 @@ theorem bufferedCleanupTM_hoareTime_frame_internal (Tape.init_move_right_hasBinaryNat nextStore.length) · simp only [finalWork, Function.update_of_ne hi] exact hsourceReadyParked i + exact ⟨hfinalPreservedData, hfinalReset, hblankNat, hfinalSource, hfinalBuffer, hfinalParked⟩ + +/-- Restore the reusable entry-scanner contract from the final tape frame. -/ +private theorem bufferedCleanup_finalScanner + (tapes : ControlInstructionTapes n) + (oldStore : Store) + (nextStore : Store) + (nextPC : ℕ) + (cleanupValues : Fin 5 → ℕ) + (remainingValue : ℕ) + (sourceHeadBound : ℕ) + (initialWork : Fin (n + 1) → Tape) + (hready : BufferedCleanupReady tapes oldStore nextStore nextPC + cleanupValues remainingValue sourceHeadBound initialWork) + : + let nextBits := nextStore.flatMap Entry.encode + let targets := instructionCleanupResetTargets tapes + let resetWork := TM.resetBinaryWorkManyResult initialWork targets + let nextTape := (Tape.init (nextBits.map Γ.ofBool)).move Dir3.right + let rewoundWork := Function.update resetWork tapes.buffer nextTape + let prefixTape := instructionCleanupPrefixTape nextBits + let copiedWork := Function.update + (Function.update rewoundWork tapes.buffer prefixTape) + tapes.liftedSource prefixTape + let bufferResetWork := Function.update copiedWork tapes.buffer + ((Tape.init []).move Dir3.right) + let sourceReadyWork := Function.update bufferResetWork tapes.liftedSource + nextTape + let countTape := + (Tape.init (nextStore.length.bits.map Γ.ofBool)).move Dir3.right + let finalWork := Function.update sourceReadyWork + tapes.lifted.data.update.remaining countTape + (finalWork tapes.liftedSource = nextTape) → + (∀ (role : Fin 18) + (hremaining : role ≠ 9) (hsource : role ≠ 0) + (hreset : ∀ slot : Fin 7, + role ≠ instructionCleanupResetParentSlot slot), + finalWork (tapes.lifted.data.idx role) = + initialWork (tapes.lifted.data.idx role)) → + (∀ (slot : Fin 5), + finalWork (instructionCleanupTape tapes slot) = + TM.resetBinaryBlank) → + (TM.resetBinaryBlank.HasBinaryNat 0) → + (∀ i, TM.Parked (finalWork i)) → + (EntryScanReady tapes.lifted.data.update.entry + nextBits [] finalWork finalWork) := by + dsimp only + intro hfinalSource hfinalPreservedData hfinalReset hblankNat hfinalParked + let nextBits := nextStore.flatMap Entry.encode + let targets := instructionCleanupResetTargets tapes + let resetWork := TM.resetBinaryWorkManyResult initialWork targets + let nextTape := (Tape.init (nextBits.map Γ.ofBool)).move Dir3.right + let rewoundWork := Function.update resetWork tapes.buffer nextTape + let prefixTape := instructionCleanupPrefixTape nextBits + let copiedWork := Function.update + (Function.update rewoundWork tapes.buffer prefixTape) + tapes.liftedSource prefixTape + let bufferResetWork := Function.update copiedWork tapes.buffer + ((Tape.init []).move Dir3.right) + let sourceReadyWork := Function.update bufferResetWork tapes.liftedSource + nextTape + let countTape := + (Tape.init (nextStore.length.bits.map Γ.ofBool)).move Dir3.right + let finalWork := Function.update sourceReadyWork + tapes.lifted.data.update.remaining countTape have hfinalScanner : EntryScanReady tapes.lifted.data.update.entry nextBits [] finalWork finalWork := by let entry := tapes.lifted.data.update.entry @@ -842,6 +1226,60 @@ theorem bufferedCleanupTM_hoareTime_frame_internal exact hready.result.scanner.resultStart parked := hfinalParked frame := by intro i _ _ _ _ _ _ _ _ _; rfl } + exact hfinalScanner + +/-- Preserve the program counter and transport the restored scanner to the lookup layout. -/ +private theorem bufferedCleanup_finalLookup + (tapes : ControlInstructionTapes n) + (nextStore : Store) + (initialWork : Fin (n + 1) → Tape) + : + let nextBits := nextStore.flatMap Entry.encode + let targets := instructionCleanupResetTargets tapes + let resetWork := TM.resetBinaryWorkManyResult initialWork targets + let nextTape := (Tape.init (nextBits.map Γ.ofBool)).move Dir3.right + let rewoundWork := Function.update resetWork tapes.buffer nextTape + let prefixTape := instructionCleanupPrefixTape nextBits + let copiedWork := Function.update + (Function.update rewoundWork tapes.buffer prefixTape) + tapes.liftedSource prefixTape + let bufferResetWork := Function.update copiedWork tapes.buffer + ((Tape.init []).move Dir3.right) + let sourceReadyWork := Function.update bufferResetWork tapes.liftedSource + nextTape + let countTape := + (Tape.init (nextStore.length.bits.map Γ.ofBool)).move Dir3.right + let finalWork := Function.update sourceReadyWork + tapes.lifted.data.update.remaining countTape + (∀ (i : Fin (n + 1)) + (hiSource : i ≠ tapes.liftedSource) (hiBuffer : i ≠ tapes.buffer), + sourceReadyWork i = resetWork i) → + (EntryScanReady tapes.lifted.data.update.entry + nextBits [] finalWork finalWork) → + (∀ i, TM.Parked (finalWork i)) → + (finalWork tapes.liftedPC = initialWork tapes.liftedPC) ∧ + (EntryScanReady + tapes.lifted.data.lhsLookup.scan.entry nextBits [] finalWork + finalWork) := by + dsimp only + intro hsourceReadyOutside hfinalScanner hfinalParked + let nextBits := nextStore.flatMap Entry.encode + let targets := instructionCleanupResetTargets tapes + let resetWork := TM.resetBinaryWorkManyResult initialWork targets + let nextTape := (Tape.init (nextBits.map Γ.ofBool)).move Dir3.right + let rewoundWork := Function.update resetWork tapes.buffer nextTape + let prefixTape := instructionCleanupPrefixTape nextBits + let copiedWork := Function.update + (Function.update rewoundWork tapes.buffer prefixTape) + tapes.liftedSource prefixTape + let bufferResetWork := Function.update copiedWork tapes.buffer + ((Tape.init []).move Dir3.right) + let sourceReadyWork := Function.update bufferResetWork tapes.liftedSource + nextTape + let countTape := + (Tape.init (nextStore.length.bits.map Γ.ofBool)).move Dir3.right + let finalWork := Function.update sourceReadyWork + tapes.lifted.data.update.remaining countTape have hfinalPC : finalWork tapes.liftedPC = initialWork tapes.liftedPC := by rw [show finalWork tapes.liftedPC = sourceReadyWork tapes.liftedPC by exact Function.update_of_ne (tapes.lifted.pc_ne 9) _ _] @@ -897,6 +1335,76 @@ theorem bufferedCleanupTM_hoareTime_frame_internal exact hfinalScanner.resultStart parked := hfinalParked frame := by intro i _ _ _ _ _ _ _ _ _; rfl } + exact ⟨hfinalPC, hfinalLookupScanner⟩ + +/-- Assemble the complete clean instruction ABI from the restored scanner and final frame. -/ +private theorem bufferedCleanup_finalReady + (tapes : ControlInstructionTapes n) + (oldStore : Store) + (nextStore : Store) + (nextPC : ℕ) + (cleanupValues : Fin 5 → ℕ) + (remainingValue : ℕ) + (sourceHeadBound : ℕ) + (initialWork : Fin (n + 1) → Tape) + (hready : BufferedCleanupReady tapes oldStore nextStore nextPC + cleanupValues remainingValue sourceHeadBound initialWork) + : + let nextBits := nextStore.flatMap Entry.encode + let targets := instructionCleanupResetTargets tapes + let resetWork := TM.resetBinaryWorkManyResult initialWork targets + let nextTape := (Tape.init (nextBits.map Γ.ofBool)).move Dir3.right + let rewoundWork := Function.update resetWork tapes.buffer nextTape + let prefixTape := instructionCleanupPrefixTape nextBits + let copiedWork := Function.update + (Function.update rewoundWork tapes.buffer prefixTape) + tapes.liftedSource prefixTape + let bufferResetWork := Function.update copiedWork tapes.buffer + ((Tape.init []).move Dir3.right) + let sourceReadyWork := Function.update bufferResetWork tapes.liftedSource + nextTape + let countTape := + (Tape.init (nextStore.length.bits.map Γ.ofBool)).move Dir3.right + let finalWork := Function.update sourceReadyWork + tapes.lifted.data.update.remaining countTape + (EntryScanReady + tapes.lifted.data.lhsLookup.scan.entry nextBits [] finalWork + finalWork) → + (finalWork tapes.liftedSource = nextTape) → + (∀ (role : Fin 18) + (hremaining : role ≠ 9) (hsource : role ≠ 0) + (hreset : ∀ slot : Fin 7, + role ≠ instructionCleanupResetParentSlot slot), + finalWork (tapes.lifted.data.idx role) = + initialWork (tapes.lifted.data.idx role)) → + (∀ (slot : Fin 5), + finalWork (instructionCleanupTape tapes slot) = + TM.resetBinaryBlank) → + (TM.resetBinaryBlank.HasBinaryNat 0) → + (finalWork tapes.liftedPC = initialWork tapes.liftedPC) → + (finalWork tapes.buffer = (Tape.init []).move Dir3.right) → + (InstructionExecutionReady tapes nextStore + nextPC finalWork) := by + dsimp only + intro hfinalLookupScanner hfinalSource hfinalPreservedData hfinalReset + hblankNat hfinalPC hfinalBuffer + let nextBits := nextStore.flatMap Entry.encode + let targets := instructionCleanupResetTargets tapes + let resetWork := TM.resetBinaryWorkManyResult initialWork targets + let nextTape := (Tape.init (nextBits.map Γ.ofBool)).move Dir3.right + let rewoundWork := Function.update resetWork tapes.buffer nextTape + let prefixTape := instructionCleanupPrefixTape nextBits + let copiedWork := Function.update + (Function.update rewoundWork tapes.buffer prefixTape) + tapes.liftedSource prefixTape + let bufferResetWork := Function.update copiedWork tapes.buffer + ((Tape.init []).move Dir3.right) + let sourceReadyWork := Function.update bufferResetWork tapes.liftedSource + nextTape + let countTape := + (Tape.init (nextStore.length.bits.map Γ.ofBool)).move Dir3.right + let finalWork := Function.update sourceReadyWork + tapes.lifted.data.update.remaining countTape have hfinalReady : InstructionExecutionReady tapes nextStore nextPC finalWork := by refine @@ -962,6 +1470,152 @@ theorem bufferedCleanupTM_hoareTime_frame_internal (by intro slot; fin_cases slot <;> decide)] exact hready.result.dbl buffer := hfinalBuffer } + exact hfinalReady + +/-- Any buffered representation endpoint is restored to the reusable clean ABI. -/ +theorem bufferedCleanupTM_hoareTime_frame_internal + (tapes : ControlInstructionTapes n) (oldStore nextStore : Store) + (nextPC : ℕ) (cleanupValues : Fin 5 → ℕ) (remainingValue : ℕ) + (sourceHeadBound : ℕ) + (initialWork : Fin (n + 1) → Tape) (inp₀ out₀ : Tape) + (hready : BufferedCleanupReady tapes oldStore nextStore nextPC + cleanupValues remainingValue sourceHeadBound initialWork) + (hinput : TM.Parked inp₀) (houtput : TM.Parked out₀) : + (instructionCleanupTM tapes).HoareTime + (fun inp work out => + inp = inp₀ ∧ work = initialWork ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ + InstructionExecutionReady tapes nextStore nextPC work ∧ + out = out₀) + (bufferedCleanupTime tapes oldStore nextStore cleanupValues + remainingValue sourceHeadBound) := by + let nextBits := nextStore.flatMap Entry.encode + let targets := instructionCleanupResetTargets tapes + let resetBits := bufferedCleanupResetBitsAt tapes cleanupValues + remainingValue oldStore + let resetHeads := + instructionCleanupResetHeadBoundAt tapes sourceHeadBound + let resetWork := TM.resetBinaryWorkManyResult initialWork targets + let nextTape := (Tape.init (nextBits.map Γ.ofBool)).move Dir3.right + obtain ⟨hreset, hresetDataOutside, hresetBuffer, hresetParked, hresetTarget⟩ := + bufferedCleanup_resetPhase + (tapes := tapes) + (oldStore := oldStore) + (nextStore := nextStore) + (nextPC := nextPC) + (cleanupValues := cleanupValues) + (remainingValue := remainingValue) + (sourceHeadBound := sourceHeadBound) + (initialWork := initialWork) + (inp₀ := inp₀) + (out₀ := out₀) + (hready := hready) + (hinput := hinput) + (houtput := houtput) + obtain ⟨hrewind, hrewoundSource, hrewoundParked⟩ := + bufferedCleanup_rewindBufferPhase + (tapes := tapes) + (oldStore := oldStore) + (nextStore := nextStore) + (nextPC := nextPC) + (cleanupValues := cleanupValues) + (remainingValue := remainingValue) + (sourceHeadBound := sourceHeadBound) + (initialWork := initialWork) + (inp₀ := inp₀) + (out₀ := out₀) + (hready := hready) + (hinput := hinput) + (houtput := houtput) + hresetBuffer hresetParked hresetTarget + let rewoundWork := Function.update resetWork tapes.buffer nextTape + obtain ⟨hcopy, hcopiedBuffer, hcopiedSource, hcopiedParked⟩ := + bufferedCleanup_copyPhase + (tapes := tapes) + (nextStore := nextStore) + (initialWork := initialWork) + (inp₀ := inp₀) + (out₀ := out₀) + (hinput := hinput) + (houtput := houtput) + hrewoundSource hrewoundParked + let prefixTape := instructionCleanupPrefixTape nextBits + let copiedWork := Function.update + (Function.update rewoundWork tapes.buffer prefixTape) + tapes.liftedSource prefixTape + obtain ⟨hresetBufferPhase, hrewindSource, hsourceReadyOutside, + hsourceReadyParked, hbufferResetParked⟩ := + bufferedCleanup_restoreSourcePhase + (tapes := tapes) + (nextStore := nextStore) + (initialWork := initialWork) + (inp₀ := inp₀) + (out₀ := out₀) + (hinput := hinput) + (houtput := houtput) + hcopiedBuffer hcopiedSource hcopiedParked hresetParked + let bufferResetWork := Function.update copiedWork tapes.buffer + ((Tape.init []).move Dir3.right) + let sourceReadyWork := Function.update bufferResetWork tapes.liftedSource + nextTape + have hcountCopy := + bufferedCleanup_copyCountPhase + (tapes := tapes) + (oldStore := oldStore) + (nextStore := nextStore) + (nextPC := nextPC) + (cleanupValues := cleanupValues) + (remainingValue := remainingValue) + (sourceHeadBound := sourceHeadBound) + (initialWork := initialWork) + (inp₀ := inp₀) + (out₀ := out₀) + (hready := hready) + (hinput := hinput) + (houtput := houtput) + hsourceReadyOutside hresetDataOutside hresetTarget hsourceReadyParked + let countTape := + (Tape.init (nextStore.length.bits.map Γ.ofBool)).move Dir3.right + let finalWork := Function.update sourceReadyWork + tapes.lifted.data.update.remaining countTape + obtain ⟨hfinalPreservedData, hfinalReset, hblankNat, hfinalSource, hfinalBuffer, hfinalParked⟩ := + bufferedCleanup_finalFrame + (tapes := tapes) + (nextStore := nextStore) + (initialWork := initialWork) + hsourceReadyOutside hresetDataOutside hresetTarget hsourceReadyParked + have hfinalScanner := + bufferedCleanup_finalScanner + (tapes := tapes) + (oldStore := oldStore) + (nextStore := nextStore) + (nextPC := nextPC) + (cleanupValues := cleanupValues) + (remainingValue := remainingValue) + (sourceHeadBound := sourceHeadBound) + (initialWork := initialWork) + (hready := hready) + hfinalSource hfinalPreservedData hfinalReset hblankNat hfinalParked + obtain ⟨hfinalPC, hfinalLookupScanner⟩ := + bufferedCleanup_finalLookup + (tapes := tapes) + (nextStore := nextStore) + (initialWork := initialWork) + hsourceReadyOutside hfinalScanner hfinalParked + have hfinalReady := + bufferedCleanup_finalReady + (tapes := tapes) + (oldStore := oldStore) + (nextStore := nextStore) + (nextPC := nextPC) + (cleanupValues := cleanupValues) + (remainingValue := remainingValue) + (sourceHeadBound := sourceHeadBound) + (initialWork := initialWork) + (hready := hready) + hfinalLookupScanner hfinalSource hfinalPreservedData hfinalReset + hblankNat hfinalPC hfinalBuffer have hcountFinal : (TM.binaryCopyIntoTM tapes.lifted.data.update.resultCount tapes.lifted.data.update.remaining diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/ABI/Internal/Loop.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/ABI/Internal/Loop.lean index 441e5ba987..ccba2bb106 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/ABI/Internal/Loop.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/ABI/Internal/Loop.lean @@ -24,6 +24,47 @@ namespace TMConfig namespace Sparse +/-- The final subtraction decrements the cursor while retaining constants and destination data. -/ +private theorem marshalLoop_final_controls (n : ℕ) (destinationStored : Structured.Store) + (cursor value : ℕ) + (hstoredState : destinationStored stateReg = cursor) + (hstoredZero : destinationStored (zeroReg n) = 0) + (hstoredOne : destinationStored (oneReg n) = 1) + (hstoredCount : destinationStored (tapeCountReg n) = n + 2) + (hstoredBase : destinationStored (stateScratchReg n) = cellBase n) + (hstoredDestination : destinationStored (cellReg n (inputTape n) cursor) = value + 1) : + let final := (Structured.Basic.sub stateReg stateReg (oneReg n)).exec destinationStored + final stateReg = cursor - 1 ∧ final (zeroReg n) = 0 ∧ final (oneReg n) = 1 ∧ + final (tapeCountReg n) = n + 2 ∧ final (stateScratchReg n) = cellBase n ∧ + 0 < final (cellReg n (inputTape n) cursor) := by + let final := (Structured.Basic.sub stateReg stateReg (oneReg n)).exec destinationStored + have hfinalState : final stateReg = cursor - 1 := by + simp [final, Structured.Basic.exec, hstoredState, hstoredOne] + have hfinalZero : final (zeroReg n) = 0 := by + simp only [final, Structured.Basic.exec] + rw [Function.update_of_ne (by simp [zeroReg, stateReg])] + exact hstoredZero + have hfinalOne : final (oneReg n) = 1 := by + simp only [final, Structured.Basic.exec] + rw [Function.update_of_ne (by simp [oneReg, stateReg])] + exact hstoredOne + have hfinalCount : final (tapeCountReg n) = n + 2 := by + simp only [final, Structured.Basic.exec] + rw [Function.update_of_ne (by simp [tapeCountReg, stateReg])] + exact hstoredCount + have hfinalBase : final (stateScratchReg n) = cellBase n := by + simp only [final, Structured.Basic.exec] + rw [Function.update_of_ne (by simp [stateScratchReg, stateReg])] + exact hstoredBase + have hfinalDestination : 0 < + final (cellReg n (inputTape n) (cursor)) := by + simp only [final, Structured.Basic.exec] + rw [Function.update_of_ne] + · rw [hstoredDestination] + omega + · simp [stateReg, cellReg, inputTape, cellBase] + exact ⟨hfinalState, hfinalZero, hfinalOne, hfinalCount, hfinalBase, hfinalDestination⟩ + /-- The backward-copy body always decrements its cursor and restores all four loop constants, even when the cursor itself visits one of their registers. -/ theorem marshalLoopOps_control_internal (n : ℕ) (store : Structured.Store) @@ -221,37 +262,13 @@ theorem marshalLoopOps_control_internal (n : ℕ) (store : Structured.Store) based (valueReg n) + 1 := by simp only [destinationStored, Structured.Basic.exec] rw [hdestinationAddress', Function.update_self, haddressedValue] - have hfinalState : final stateReg = store stateReg - 1 := by - simp [final, Structured.Basic.exec, hstoredState, hstoredOne] - have hfinalZero : final (zeroReg n) = 0 := by - simp only [final, Structured.Basic.exec] - rw [Function.update_of_ne (by simp [zeroReg, stateReg])] - exact hstoredZero - have hfinalOne : final (oneReg n) = 1 := by - simp only [final, Structured.Basic.exec] - rw [Function.update_of_ne (by simp [oneReg, stateReg])] - exact hstoredOne - have hfinalCount : final (tapeCountReg n) = n + 2 := by - simp only [final, Structured.Basic.exec] - rw [Function.update_of_ne (by simp [tapeCountReg, stateReg])] - exact hstoredCount - have hfinalBase : final (stateScratchReg n) = cellBase n := by - simp only [final, Structured.Basic.exec] - rw [Function.update_of_ne (by simp [stateScratchReg, stateReg])] - exact hstoredBase - have hfinalDestination : 0 < - final (cellReg n (inputTape n) (store stateReg)) := by - simp only [final, Structured.Basic.exec] - rw [Function.update_of_ne] - · rw [hstoredDestination] - omega - · simp [stateReg, cellReg, inputTape, cellBase] + have hfinalResult := marshalLoop_final_controls n destinationStored (store stateReg) + (based (valueReg n)) hstoredState hstoredZero hstoredOne hstoredCount + hstoredBase hstoredDestination simpa [marshalLoopOps, sourceAddressed, sourceLoaded, sourceCleared, zeroed, oned, counted, based, encoded, multiplied, destinationAddressed, destinationStored, final] using! - And.intro hfinalState (And.intro hfinalZero - (And.intro hfinalOne - (And.intro hfinalCount (And.intro hfinalBase hfinalDestination)))) + hfinalResult /-- One backward-copy body has an exact structured execution. -/ theorem marshalLoopOps_exec_internal (n : ℕ) (store : Structured.Store) : @@ -261,6 +278,47 @@ theorem marshalLoopOps_exec_internal (n : ℕ) (store : Structured.Store) : (marshalLoopOps n).length cost space := Structured.Internal.exec_basics_exists (marshalLoopOps n) store +/-- Data-region registers are disjoint from the cursor and all loop scratch registers. -/ +private theorem dataReg_ne_loopControls (n reg : ℕ) (hdata : cellBase n ≤ reg) : + reg ≠ stateReg ∧ reg ≠ addressReg n ∧ reg ≠ valueReg n ∧ + reg ≠ zeroReg n ∧ reg ≠ oneReg n ∧ reg ≠ tapeCountReg n ∧ + reg ≠ stateScratchReg n := by + have hregState : reg ≠ stateReg := by + intro heq + rw [heq] at hdata + simp [stateReg, cellBase] at hdata + have hregAddress : reg ≠ addressReg n := by + intro heq + rw [heq] at hdata + simp [addressReg, cellBase] at hdata + omega + have hregValue : reg ≠ valueReg n := by + intro heq + rw [heq] at hdata + simp [valueReg, cellBase] at hdata + omega + have hregZero : reg ≠ zeroReg n := by + intro heq + rw [heq] at hdata + simp [zeroReg, cellBase] at hdata + omega + have hregOne : reg ≠ oneReg n := by + intro heq + rw [heq] at hdata + simp [oneReg, cellBase] at hdata + omega + have hregCount : reg ≠ tapeCountReg n := by + intro heq + rw [heq] at hdata + simp [tapeCountReg, cellBase] at hdata + omega + have hregBase : reg ≠ stateScratchReg n := by + intro heq + rw [heq] at hdata + simp [stateScratchReg, cellBase] at hdata + omega + exact ⟨hregState, hregAddress, hregValue, hregZero, hregOne, hregCount, hregBase⟩ + /-- Away from the six captured scratch positions, one loop body clears the raw source cell and writes its Boolean value, shifted to the sparse symbol code, to the corresponding input cell. This is the relocation induction step. -/ @@ -399,40 +457,8 @@ theorem marshalLoopOps_data_internal (n : ℕ) (store : Structured.Store) simp only [destinationAddressed, Structured.Basic.exec] rw [Function.update_of_ne (by simp [valueReg, addressReg])] exact hmultipliedValue - have hregState : reg ≠ stateReg := by - intro heq - rw [heq] at hdata - simp [stateReg, cellBase] at hdata - have hregAddress : reg ≠ addressReg n := by - intro heq - rw [heq] at hdata - simp [addressReg, cellBase] at hdata - omega - have hregValue : reg ≠ valueReg n := by - intro heq - rw [heq] at hdata - simp [valueReg, cellBase] at hdata - omega - have hregZero : reg ≠ zeroReg n := by - intro heq - rw [heq] at hdata - simp [zeroReg, cellBase] at hdata - omega - have hregOne : reg ≠ oneReg n := by - intro heq - rw [heq] at hdata - simp [oneReg, cellBase] at hdata - omega - have hregCount : reg ≠ tapeCountReg n := by - intro heq - rw [heq] at hdata - simp [tapeCountReg, cellBase] at hdata - omega - have hregBase : reg ≠ stateScratchReg n := by - intro heq - rw [heq] at hdata - simp [stateScratchReg, cellBase] at hdata - omega + obtain ⟨hregState, hregAddress, hregValue, hregZero, hregOne, hregCount, hregBase⟩ := + dataReg_ne_loopControls n reg hdata have hloadedData : sourceLoaded reg = store reg := by simp only [sourceLoaded, Structured.Basic.exec] rw [Function.update_of_ne hregValue] From e129febec9c550ef76d8587c48e1d1057e60e0d5 Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Fri, 25 Sep 2026 20:44:52 +0000 Subject: [PATCH 32/49] Separate combinator definitions and factor multiplication loop invariants --- LeanPool.lean | 2 + LeanPool/BeyondBethe.lean | 2 + .../Sparse/ABI/Internal/Resources.lean | 90 +- .../Models/TuringMachine/Combinators.lean | 985 +----------------- .../TuringMachine/Combinators/Defs.lean | 908 ++++++++++++++++ .../TuringMachine/Combinators/Helpers.lean | 118 +++ .../BinaryShiftMul/Internal/Sem.lean | 170 +-- 7 files changed, 1184 insertions(+), 1091 deletions(-) create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/Defs.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/Helpers.lean diff --git a/LeanPool.lean b/LeanPool.lean index 6a562df50c..68d7717f17 100644 --- a/LeanPool.lean +++ b/LeanPool.lean @@ -780,6 +780,8 @@ public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Stru public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.UnaryDecode.Internal public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.Helpers public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.Apply public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.ForBinaryWork public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.ForBinaryWork.Defs diff --git a/LeanPool/BeyondBethe.lean b/LeanPool/BeyondBethe.lean index 2e5e3fcf2c..23720f4812 100644 --- a/LeanPool/BeyondBethe.lean +++ b/LeanPool/BeyondBethe.lean @@ -540,6 +540,8 @@ public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Stru public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.UnaryDecode.Internal public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.Helpers public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.Apply public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.ForBinaryWork public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.ForBinaryWork.Defs diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/ABI/Internal/Resources.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/ABI/Internal/Resources.lean index 7f85a51585..520d7cc8c4 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/ABI/Internal/Resources.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/ABI/Internal/Resources.lean @@ -252,6 +252,68 @@ theorem marshalConstants_measured_internal (tm : TM n) (x : List Bool) : simpa [marshalStart] using! And.intro hmeasured.1 (And.intro hmarshal (marshalStart_invariant_internal n x)) +/-- Loading, clearing, and encoding a positive source cursor retain the cursor register. -/ +private theorem marshalLoop_encodedState (n : ℕ) (store : Structured.Store) (cursor : ℕ) + (hcursor : 0 < cursor) (hstate : store stateReg = cursor) : + let sourceAddressed := + (Structured.Basic.add (addressReg n) stateReg (zeroReg n)).exec store + let sourceLoaded := + (Structured.Basic.load (valueReg n) (addressReg n)).exec sourceAddressed + let sourceCleared := + (Structured.Basic.store (addressReg n) (zeroReg n)).exec sourceLoaded + let zeroed := (Structured.Basic.imm (zeroReg n) 0).exec sourceCleared + let oned := (Structured.Basic.imm (oneReg n) 1).exec zeroed + let counted := + (Structured.Basic.imm (tapeCountReg n) (n + 2)).exec oned + let based := + (Structured.Basic.imm (stateScratchReg n) (cellBase n)).exec counted + let encoded := + (Structured.Basic.add (valueReg n) (valueReg n) (oneReg n)).exec based + sourceLoaded (addressReg n) = cursor → encoded stateReg = cursor := by + dsimp only + intro hloadedAddress + let sourceAddressed := + (Structured.Basic.add (addressReg n) stateReg (zeroReg n)).exec store + let sourceLoaded := + (Structured.Basic.load (valueReg n) (addressReg n)).exec sourceAddressed + let sourceCleared := + (Structured.Basic.store (addressReg n) (zeroReg n)).exec sourceLoaded + let zeroed := (Structured.Basic.imm (zeroReg n) 0).exec sourceCleared + let oned := (Structured.Basic.imm (oneReg n) 1).exec zeroed + let counted := + (Structured.Basic.imm (tapeCountReg n) (n + 2)).exec oned + let based := + (Structured.Basic.imm (stateScratchReg n) (cellBase n)).exec counted + let encoded := + (Structured.Basic.add (valueReg n) (valueReg n) (oneReg n)).exec based + have hsourceAddressedState : sourceAddressed stateReg = cursor := by + simp only [sourceAddressed, Structured.Basic.exec] + rw [Function.update_of_ne (by simp [stateReg, addressReg])] + exact hstate + have hsourceLoadedState : sourceLoaded stateReg = cursor := by + simp only [sourceLoaded, Structured.Basic.exec] + rw [Function.update_of_ne (by simp [stateReg, valueReg])] + exact hsourceAddressedState + have hsourceClearedState : sourceCleared stateReg = cursor := by + simp only [sourceCleared, Structured.Basic.exec] + rw [Function.update_of_ne] + · exact hsourceLoadedState + · rw [hloadedAddress] + simp [stateReg] + omega + have hbasedState : based stateReg = cursor := by + simp only [based, counted, oned, zeroed, Structured.Basic.exec] + rw [Function.update_of_ne (by simp [stateReg, stateScratchReg]), + Function.update_of_ne (by simp [stateReg, tapeCountReg]), + Function.update_of_ne (by simp [stateReg, oneReg]), + Function.update_of_ne (by simp [stateReg, zeroReg])] + exact hsourceClearedState + have hencodedState : encoded stateReg = cursor := by + simp only [encoded, Structured.Basic.exec] + rw [Function.update_of_ne (by simp [stateReg, valueReg])] + exact hbasedState + exact hencodedState + private theorem marshalLoopOps_envelopeChain (n : ℕ) (x : List Bool) {cursor processed : ℕ} {store : Structured.Store} (hcursor : 0 < cursor) @@ -400,32 +462,8 @@ private theorem marshalLoopOps_envelopeChain (n : ℕ) (x : List Bool) · simp only [Structured.Internal.Basic.writeValue] rw [hbasedOne] exact Nat.add_le_add_right hbasedValue 1 - have hsourceAddressedState : sourceAddressed stateReg = cursor := by - simp only [sourceAddressed, Structured.Basic.exec] - rw [Function.update_of_ne (by simp [stateReg, addressReg])] - exact hstate - have hsourceLoadedState : sourceLoaded stateReg = cursor := by - simp only [sourceLoaded, Structured.Basic.exec] - rw [Function.update_of_ne (by simp [stateReg, valueReg])] - exact hsourceAddressedState - have hsourceClearedState : sourceCleared stateReg = cursor := by - simp only [sourceCleared, Structured.Basic.exec] - rw [Function.update_of_ne] - · exact hsourceLoadedState - · rw [hloadedAddress] - simp [stateReg] - omega - have hbasedState : based stateReg = cursor := by - simp only [based, counted, oned, zeroed, Structured.Basic.exec] - rw [Function.update_of_ne (by simp [stateReg, stateScratchReg]), - Function.update_of_ne (by simp [stateReg, tapeCountReg]), - Function.update_of_ne (by simp [stateReg, oneReg]), - Function.update_of_ne (by simp [stateReg, zeroReg])] - exact hsourceClearedState - have hencodedState : encoded stateReg = cursor := by - simp only [encoded, Structured.Basic.exec] - rw [Function.update_of_ne (by simp [stateReg, valueReg])] - exact hbasedState + have hencodedState : encoded stateReg = cursor := + marshalLoop_encodedState n store cursor hcursor hstate hloadedAddress have hencodedCount : encoded (tapeCountReg n) = n + 2 := by simp [encoded, based, counted, Structured.Basic.exec, tapeCountReg, stateScratchReg, valueReg, Function.update_of_ne] diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators.lean index b80b0a6614..17a088ed12 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators.lean @@ -5,8 +5,7 @@ Authors: Samuel Schlesinger -/ module -public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine -public import Mathlib.Data.Fintype.Sum +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.Defs /-! # TM Combinators @@ -54,985 +53,3 @@ The union machine has three phases: `Q₁ ⊕ UnionPhase ⊕ Q₂` where `UnionPhase` encodes the four transition states between Phase 1 and Phase 2. -/ - - -@[expose] public section - -namespace Complexity - -variable {n₁ n₂ : ℕ} - -namespace TM - --- ════════════════════════════════════════════════════════════════════════ --- Helpers --- ════════════════════════════════════════════════════════════════════════ - -/-- Direction for an idle tape: move right if reading `▷`, else stay. - Satisfies `δ_right_of_start` for tapes not involved in the current phase. -/ -def idleDir (head : Γ) : Dir3 := - if head = Γ.start then .right else .stay - -/-- Direction for a tape we want to move left: move left unless reading `▷`, - in which case move right to satisfy `δ_right_of_start`. During actual - execution the tape won't be at cell 0, so this always moves left. -/ -def moveLeftDir (head : Γ) : Dir3 := - if head = Γ.start then .right else .left - -/-- `idleDir` moves right when reading the start symbol `▷`. -/ -theorem idleDir_start : idleDir Γ.start = Dir3.right := rfl -private theorem moveLeftDir_start : moveLeftDir Γ.start = Dir3.right := rfl - -/-- If the head reads `▷`, then `idleDir` moves right — the shape of the - `δ_right_of_start` obligation for idle tapes. -/ -theorem idleDir_right_of_start {head : Γ} (h : head = Γ.start) : idleDir head = Dir3.right := by - subst h; rfl - -/-- If the head reads `▷`, then `moveLeftDir` moves right — the shape of the - `δ_right_of_start` obligation for tapes being rewound. -/ -theorem moveLeftDir_right_of_start {head : Γ} (h : head = Γ.start) : moveLeftDir head = Dir3.right := - by subst h; rfl - -/-- Write back the same symbol read from a tape, preserving cell contents. - Maps `▷` to `□` since `Tape.write` at position 0 is a no-op anyway. -/ -def readBackWrite (g : Γ) : Γw := - match g with - | .zero => .zero - | .one => .one - | .blank => .blank - | .start => .blank - -/-- `readBackWrite` recovers the original symbol away from the left-end marker. -/ -theorem toΓ_readBackWrite_of_ne_start {g : Γ} (h : g ≠ Γ.start) : - (readBackWrite g).toΓ = g := by - cases g <;> simp_all [readBackWrite, Γw.toΓ] - -/-- Writing back the symbol under an off-start head is a no-op. -/ -theorem write_readBack (t : Tape) (hread : t.read ≠ Γ.start) : - t.write (readBackWrite t.read) = t := by - rw [Tape.write] - split - · rfl - · refine Tape.ext rfl ?_ - show Function.update t.cells t.head (readBackWrite t.read).toΓ = t.cells - rw [toΓ_readBackWrite_of_ne_start hread, Tape.read, Function.update_eq_self] - -/-- Writing back the symbol under an off-start head and moving is just the move. -/ -theorem writeAndMove_readBack (t : Tape) (hread : t.read ≠ Γ.start) (d : Dir3) : - t.writeAndMove (readBackWrite t.read) d = t.move d := by - show (t.write _).move d = t.move d - rw [write_readBack t hread] - -/-- The "do nothing" transition output: all writes are `□`, all directions - are `idleDir`. Used for states that only change the control state. -/ -def allIdle {σ : Type} {k : ℕ} - (newState : σ) (iHead : Γ) (wHeads : Fin k → Γ) (oHead : Γ) : - σ × (Fin k → Γw) × Γw × Dir3 × (Fin k → Dir3) × Dir3 := - (newState, fun _ => .blank, .blank, idleDir iHead, fun i => idleDir (wHeads i), idleDir oHead) - -/-- The content-preserving driver action: write every currently read work and -output symbol back, and use `idleDir` on every tape. Every off-start tape is -preserved exactly; a head on `▷` takes the structurally mandatory move right. -/ -def allReadBack {σ : Type} {k : ℕ} - (newState : σ) (iHead : Γ) (wHeads : Fin k → Γ) (oHead : Γ) : - σ × (Fin k → Γw) × Γw × Dir3 × (Fin k → Dir3) × Dir3 := - (newState, fun i => readBackWrite (wHeads i), readBackWrite oHead, - idleDir iHead, fun i => idleDir (wHeads i), idleDir oHead) - -/-- Proof that all-idle directions satisfy `δ_right_of_start`. -/ -theorem rightOfStart_allIdle (iHead : Γ) (wHeads : Fin k → Γ) (oHead : Γ) : - (iHead = Γ.start → idleDir iHead = Dir3.right) ∧ - (∀ i, wHeads i = Γ.start → idleDir (wHeads i) = Dir3.right) ∧ - (oHead = Γ.start → idleDir oHead = Dir3.right) := - ⟨idleDir_right_of_start, fun _ => idleDir_right_of_start, idleDir_right_of_start⟩ - -/-- `allReadBack` satisfies the one-sided-tape direction invariant. -/ -theorem rightOfStart_allReadBack (iHead : Γ) (wHeads : Fin k → Γ) (oHead : Γ) : - (iHead = Γ.start → idleDir iHead = Dir3.right) ∧ - (∀ i, wHeads i = Γ.start → idleDir (wHeads i) = Dir3.right) ∧ - (oHead = Γ.start → idleDir oHead = Dir3.right) := - ⟨idleDir_right_of_start, fun _ => idleDir_right_of_start, idleDir_right_of_start⟩ - --- ════════════════════════════════════════════════════════════════════════ --- State type --- ════════════════════════════════════════════════════════════════════════ - -/-- Intermediate states between Phase 1 and Phase 2 of the union machine. -/ -inductive UnionPhase where - | rewindOut -- rewind fake output (work tape n₁) to cell 0 - | checkResult -- at fake output cell 1: read and decide accept/continue - | rewindIn -- rewind input tape to cell 0 - | setup2 -- move Phase-2 tapes from cell 1 to cell 0 - deriving DecidableEq - -instance : Fintype UnionPhase where - elems := {.rewindOut, .checkResult, .rewindIn, .setup2} - complete := fun x => by cases x <;> simp - -/-- The state type for the union TM. -/ -abbrev UnionQ (Q₁ Q₂ : Type) := Q₁ ⊕ UnionPhase ⊕ Q₂ - --- ════════════════════════════════════════════════════════════════════════ --- Index helpers for the n₁ + 1 + n₂ work tapes --- ════════════════════════════════════════════════════════════════════════ - -/-- Index of the fake output tape (work tape `n₁`). -/ -def fakeOutIdx : Fin (n₁ + 1 + n₂) := ⟨n₁, by omega⟩ - -/-- Read tm₁'s work tapes from the composite work tapes. -/ -def phase1WorkReads (wHeads : Fin (n₁ + 1 + n₂) → Γ) (i : Fin n₁) : Γ := - wHeads ⟨i.val, by omega⟩ - -/-- Read tm₂'s work tapes from the composite work tapes. -/ -def phase2WorkReads (wHeads : Fin (n₁ + 1 + n₂) → Γ) (j : Fin n₂) : Γ := - wHeads ⟨n₁ + 1 + j.val, by omega⟩ - --- ════════════════════════════════════════════════════════════════════════ --- The union TM --- ════════════════════════════════════════════════════════════════════════ - -/-- Construct a TM deciding `L₁ ∪ L₂` from TMs deciding `L₁` and `L₂`. - - The composite machine has `n₁ + 1 + n₂` work tapes: - - `0 .. n₁-1` for `tm₁`'s work tapes - - `n₁` for `tm₁`'s redirected output - - `n₁+1 .. n₁+n₂` for `tm₂`'s work tapes -/ -def unionTM (tm₁ : TM n₁) (tm₂ : TM n₂) : TM (n₁ + 1 + n₂) := - haveI : Fintype tm₁.Q := tm₁.finQ - haveI : DecidableEq tm₁.Q := tm₁.decEq - haveI : Fintype tm₂.Q := tm₂.finQ - haveI : DecidableEq tm₂.Q := tm₂.decEq - { Q := UnionQ tm₁.Q tm₂.Q, - qstart := Sum.inl tm₁.qstart, - qhalt := Sum.inr (Sum.inr tm₂.qhalt), - δ := fun state iHead wHeads oHead => - match state with - -- ══════════════════════════════════════════════════════════════════ - -- Phase 1: simulate tm₁ with output redirected to work tape n₁ - -- ══════════════════════════════════════════════════════════════════ - | Sum.inl q => - if q = tm₁.qhalt then - -- Transition to rewind; preserve fake output value to avoid corrupting cell 1 - ( Sum.inr (Sum.inl .rewindOut), - fun i => if i.val = n₁ then readBackWrite (wHeads fakeOutIdx) else .blank, - .blank, - idleDir iHead, - fun i => idleDir (wHeads i), - idleDir oHead ) - else - let (q', wW, oW, iD, wD, oD) := - tm₁.δ q iHead (phase1WorkReads wHeads) (wHeads fakeOutIdx) - ( Sum.inl q', - fun i => - if h : i.val < n₁ then wW ⟨i.val, h⟩ - else if i.val = n₁ then oW - else .blank, - .blank, iD, - fun i => - if h : i.val < n₁ then wD ⟨i.val, h⟩ - else if i.val = n₁ then oD - else idleDir (wHeads i), - idleDir oHead ) - -- ══════════════════════════════════════════════════════════════════ - -- Transition states between phases - -- ══════════════════════════════════════════════════════════════════ - | Sum.inr (Sum.inl m) => - match m with - | .rewindOut => - if wHeads fakeOutIdx = Γ.start then - -- At cell 0 → move right to cell 1 - ( Sum.inr (Sum.inl .checkResult), - fun _ => .blank, .blank, idleDir iHead, - fun i => if i.val = n₁ then Dir3.right else idleDir (wHeads i), - idleDir oHead ) - else - -- Not at cell 0 → keep moving left; preserve fake output to avoid corrupting cell 1 - ( Sum.inr (Sum.inl .rewindOut), - fun i => if i.val = n₁ then readBackWrite (wHeads fakeOutIdx) else .blank, - .blank, idleDir iHead, - fun i => if i.val = n₁ then Dir3.left else idleDir (wHeads i), - idleDir oHead ) - | .checkResult => - if wHeads fakeOutIdx = Γ.one then - -- tm₁ accepted → write Γ.one to real output (at cell 1), halt - ( Sum.inr (Sum.inr tm₂.qhalt), - fun _ => .blank, .one, idleDir iHead, - fun i => idleDir (wHeads i), - idleDir oHead ) - else - -- tm₁ rejected → proceed to rewind input - allIdle (Sum.inr (Sum.inl .rewindIn)) iHead wHeads oHead - | .rewindIn => - if iHead = Γ.start then - -- At cell 0 → forced right by δ_right_of_start, then setup2 - ( Sum.inr (Sum.inl .setup2), - fun _ => .blank, .blank, Dir3.right, - fun i => idleDir (wHeads i), - idleDir oHead ) - else - -- Not at cell 0 → keep moving left - ( Sum.inr (Sum.inl .rewindIn), - fun _ => .blank, .blank, Dir3.left, - fun i => idleDir (wHeads i), - idleDir oHead ) - | .setup2 => - -- Move input, Phase-2 work tapes, and real output from cell 1 to cell 0 - ( Sum.inr (Sum.inr tm₂.qstart), - fun _ => .blank, .blank, moveLeftDir iHead, - fun i => if i.val ≤ n₁ then idleDir (wHeads i) else moveLeftDir (wHeads i), - moveLeftDir oHead ) - -- ══════════════════════════════════════════════════════════════════ - -- Phase 2: simulate tm₂ with the real output tape - -- ══════════════════════════════════════════════════════════════════ - | Sum.inr (Sum.inr q) => - if q = tm₂.qhalt then - -- Unreachable (step returns none), but δ is total - allIdle (Sum.inr (Sum.inr tm₂.qhalt)) iHead wHeads oHead - else - let (q', wW, oW, iD, wD, oD) := - tm₂.δ q iHead (phase2WorkReads wHeads) oHead - ( Sum.inr (Sum.inr q'), - fun i => - if h : i.val ≤ n₁ then .blank - else wW ⟨i.val - (n₁ + 1), by omega⟩, - oW, iD, - fun i => - if h : i.val ≤ n₁ then idleDir (wHeads i) - else wD ⟨i.val - (n₁ + 1), by omega⟩, - oD ), - δ_right_of_start := by - intro state iHead wHeads oHead - match state with - | Sum.inl q => - dsimp only [] - split - · exact rightOfStart_allIdle iHead wHeads oHead - · next hne => - have hδ := tm₁.δ_right_of_start q iHead (phase1WorkReads wHeads) (wHeads fakeOutIdx) - simp only [phase1WorkReads, fakeOutIdx] at hδ - refine ⟨hδ.1, ?_, idleDir_right_of_start⟩ - intro i hwi; simp only [] - split - · next hi => - exact hδ.2.1 ⟨i.val, hi⟩ (by - rwa [show wHeads ⟨↑i, by omega⟩ = wHeads i from by congr 1]) - · split - · next hi hn => - exact hδ.2.2 (by - rwa [show wHeads ⟨n₁, by omega⟩ = wHeads i from by congr 1; ext; simp [hn]]) - · exact idleDir_right_of_start hwi - | Sum.inr (Sum.inl m) => - match m with - | .rewindOut => - dsimp only [fakeOutIdx] - by_cases hphase : wHeads fakeOutIdx = Γ.start - all_goals simp only [fakeOutIdx] at hphase - all_goals simp only [hphase, ite_true, ite_false] - · refine ⟨idleDir_right_of_start, ?_, idleDir_right_of_start⟩ - intro i hwi; split - · rfl - · exact idleDir_right_of_start hwi - · refine ⟨idleDir_right_of_start, ?_, idleDir_right_of_start⟩ - intro i hwi; split - · next heq => - exfalso; apply hphase - rwa [show wHeads ⟨n₁, by omega⟩ = wHeads i from by congr 1; ext; simp [heq]] - · exact idleDir_right_of_start hwi - | .checkResult => - dsimp only [fakeOutIdx] - by_cases hphase : wHeads fakeOutIdx = Γ.one - all_goals simp only [fakeOutIdx] at hphase - all_goals simp only [hphase, ite_true, ite_false] - · exact ⟨idleDir_right_of_start, fun _ => idleDir_right_of_start, idleDir_right_of_start⟩ - · exact rightOfStart_allIdle iHead wHeads oHead - | .rewindIn => - dsimp only [] - split - · exact ⟨fun _ => rfl, fun _ => idleDir_right_of_start, idleDir_right_of_start⟩ - · refine ⟨?_, fun _ => idleDir_right_of_start, idleDir_right_of_start⟩ - intro hiHead; next hn => exact absurd hiHead hn - | .setup2 => - refine ⟨moveLeftDir_right_of_start, ?_, moveLeftDir_right_of_start⟩ - intro i hwi; simp only []; split - · exact idleDir_right_of_start hwi - · exact moveLeftDir_right_of_start hwi - | Sum.inr (Sum.inr q) => - dsimp only [] - split - · exact rightOfStart_allIdle iHead wHeads oHead - · next hne => - have hδ := tm₂.δ_right_of_start q iHead (phase2WorkReads wHeads) oHead - simp only [phase2WorkReads] at hδ - refine ⟨hδ.1, ?_, hδ.2.2⟩ - intro i hwi; simp only []; split - · exact idleDir_right_of_start hwi - · next hi => - exact hδ.2.1 ⟨i.val - (n₁ + 1), by omega⟩ (by - rwa [show wHeads ⟨n₁ + 1 + (↑i - (n₁ + 1)), by omega⟩ = wHeads i from by - congr 1; ext; simp; omega]) } - --- ════════════════════════════════════════════════════════════════════════ --- Complement TM --- ════════════════════════════════════════════════════════════════════════ - -/-- Intermediate states for the complement machine's output-flipping phase. -/ -inductive ComplementPhase where - | rewind -- rewind output head left to cell 0, then right to cell 1 - | flip -- at cell 1: flip the output bit and halt - | done -- halt state - deriving DecidableEq - -instance : Fintype ComplementPhase where - elems := {.rewind, .flip, .done} - complete := fun x => by cases x <;> simp - -/-- The state type for the complement TM. -/ -abbrev ComplementQ (Q : Type) := Q ⊕ ComplementPhase - -/-- Flip a readable symbol: `1 ↔ 0`, blanks stay blank. -/ -def flipBit (g : Γ) : Γw := - match g with - | .one => .zero - | .zero => .one - | .blank => .blank - | .start => .blank - -/-- Construct a TM deciding `Lᶜ` from a TM deciding `L`. - - The complement machine has the same number of work tapes as the original. - It runs in three stages: - - 1. **Simulate**: Run the original TM. When it halts, transition to `rewind`. - 2. **Rewind**: Move the output head left to `▷` (cell 0), then right to cell 1. - 3. **Flip**: Read output cell 1, write the flipped bit, and halt. -/ -def complementTM (tm : TM n) : TM n := - haveI : Fintype tm.Q := tm.finQ - haveI : DecidableEq tm.Q := tm.decEq - { Q := ComplementQ tm.Q, - qstart := Sum.inl tm.qstart, - qhalt := Sum.inr .done, - δ := fun state iHead wHeads oHead => - match state with - -- ══════════════════════════════════════════════════════════════════ - -- Simulation phase: run original TM - -- ══════════════════════════════════════════════════════════════════ - | Sum.inl q => - if q = tm.qhalt then - -- Original TM halted → begin rewinding output - -- Write back the current output symbol to preserve cell contents - ( Sum.inr .rewind, - fun _ => .blank, - readBackWrite oHead, - idleDir iHead, - fun i => idleDir (wHeads i), - idleDir oHead ) - else - -- Not halted → run original δ, wrapping state in Sum.inl - let (q', wW, oW, iD, wD, oD) := tm.δ q iHead wHeads oHead - ( Sum.inl q', wW, oW, iD, wD, oD ) - -- ══════════════════════════════════════════════════════════════════ - -- Rewind phase: move output head left to ▷, then right to cell 1 - -- ══════════════════════════════════════════════════════════════════ - | Sum.inr .rewind => - if oHead = Γ.start then - -- At cell 0 (▷) → move right to cell 1, enter flip state - ( Sum.inr .flip, - fun _ => .blank, - .blank, - idleDir iHead, - fun i => idleDir (wHeads i), - Dir3.right ) - else - -- Not at cell 0 → keep moving left, preserve output cell contents - ( Sum.inr .rewind, - fun _ => .blank, - readBackWrite oHead, - idleDir iHead, - fun i => idleDir (wHeads i), - Dir3.left ) - -- ══════════════════════════════════════════════════════════════════ - -- Flip phase: at cell 1, flip the output bit and halt - -- ══════════════════════════════════════════════════════════════════ - | Sum.inr .flip => - ( Sum.inr .done, - fun _ => .blank, - flipBit oHead, - idleDir iHead, - fun i => idleDir (wHeads i), - idleDir oHead ) - -- ══════════════════════════════════════════════════════════════════ - -- Done (= qhalt): unreachable by step, but δ is total - -- ══════════════════════════════════════════════════════════════════ - | Sum.inr .done => - allIdle (Sum.inr .done) iHead wHeads oHead, - δ_right_of_start := by - intro state iHead wHeads oHead - match state with - | Sum.inl q => - dsimp only [] - split - · exact ⟨idleDir_right_of_start, fun _ => idleDir_right_of_start, - idleDir_right_of_start⟩ - · exact tm.δ_right_of_start q iHead wHeads oHead - | Sum.inr .rewind => - dsimp only [] - split - · exact ⟨idleDir_right_of_start, fun _ => idleDir_right_of_start, fun _ => rfl⟩ - · refine ⟨idleDir_right_of_start, fun _ => idleDir_right_of_start, ?_⟩ - intro h; next hn => exact absurd h hn - | Sum.inr .flip => - exact ⟨idleDir_right_of_start, fun _ => idleDir_right_of_start, - idleDir_right_of_start⟩ - | Sum.inr .done => - exact rightOfStart_allIdle iHead wHeads oHead } - --- ════════════════════════════════════════════════════════════════════════ --- Conditional Branching --- ════════════════════════════════════════════════════════════════════════ - -/-- Intermediate states for the conditional branching machine. -/ -inductive IfPhase where - | rewindOut -- rewind output head left to ▷ (cell 0) - | check -- at cell 0, move right to cell 1, read result, branch - | done -- halt state (reached when either branch halts) - deriving DecidableEq - -instance : Fintype IfPhase where - elems := {.rewindOut, .check, .done} - complete := fun x => by cases x <;> simp - -/-- The state type for the conditional branching TM. -/ -abbrev IfQ (QT QThen QElse : Type) := QT ⊕ IfPhase ⊕ QThen ⊕ QElse - -/-- Conditional branching: run `tmTest` to completion, read its output at - cell 1, then run `tmThen` (if output = `Γ.one`) or `tmElse` (otherwise). - - All three machines share the same `n` work tapes, input tape, and output - tape. Work tape contents are preserved across all transitions via - `readBackWrite`, maintaining shared state for the branch machines. - - ## Phases - - 1. **Test**: Simulate `tmTest`. When it halts, enter rewind. - 2. **Rewind output**: Move output head left to `▷` (cell 0). - 3. **Check**: Move output head right to cell 1, read the test result. - If `Γ.one`, enter `tmThen.qstart`. Otherwise, enter `tmElse.qstart`. - 4. **Branch**: Simulate `tmThen` or `tmElse`. When the branch machine - halts, transition to the `done` halt state. - - ## Time - - `t_test + (output_head_pos + 2) + 1 + t_branch + 1` where - `output_head_pos ≤ t_test`. Total: at most `2·t_test + t_branch + 4`. -/ -def ifTM (tmTest : TM n) (tmThen : TM n) (tmElse : TM n) : TM n := - haveI : Fintype tmTest.Q := tmTest.finQ - haveI : DecidableEq tmTest.Q := tmTest.decEq - haveI : Fintype tmThen.Q := tmThen.finQ - haveI : DecidableEq tmThen.Q := tmThen.decEq - haveI : Fintype tmElse.Q := tmElse.finQ - haveI : DecidableEq tmElse.Q := tmElse.decEq - { Q := IfQ tmTest.Q tmThen.Q tmElse.Q, - qstart := Sum.inl tmTest.qstart, - qhalt := Sum.inr (Sum.inl .done), - δ := fun state iHead wHeads oHead => - match state with - -- ══════════════════════════════════════════════════════════════════ - -- Test phase: simulate tmTest - -- ══════════════════════════════════════════════════════════════════ - | Sum.inl q => - if q = tmTest.qhalt then - -- tmTest halted → begin rewinding output, preserve all tapes - ( Sum.inr (Sum.inl .rewindOut), - fun i => readBackWrite (wHeads i), - readBackWrite oHead, - idleDir iHead, - fun i => idleDir (wHeads i), - idleDir oHead ) - else - let (q', wW, oW, iD, wD, oD) := tmTest.δ q iHead wHeads oHead - ( Sum.inl q', wW, oW, iD, wD, oD ) - -- ══════════════════════════════════════════════════════════════════ - -- Transition: rewind output and check result - -- ══════════════════════════════════════════════════════════════════ - | Sum.inr (Sum.inl phase) => - match phase with - | .rewindOut => - if oHead = Γ.start then - -- At ▷ (cell 0) → move right to cell 1, enter check - ( Sum.inr (Sum.inl .check), - fun i => readBackWrite (wHeads i), - .blank, - idleDir iHead, - fun i => idleDir (wHeads i), - Dir3.right ) - else - -- Not at cell 0 → keep moving left, preserve output - ( Sum.inr (Sum.inl .rewindOut), - fun i => readBackWrite (wHeads i), - readBackWrite oHead, - idleDir iHead, - fun i => idleDir (wHeads i), - Dir3.left ) - | .check => - -- At cell 1: read output and branch - if oHead = Γ.one then - ( Sum.inr (Sum.inr (Sum.inl tmThen.qstart)), - fun i => readBackWrite (wHeads i), - readBackWrite oHead, - idleDir iHead, - fun i => idleDir (wHeads i), - idleDir oHead ) - else - ( Sum.inr (Sum.inr (Sum.inr tmElse.qstart)), - fun i => readBackWrite (wHeads i), - readBackWrite oHead, - idleDir iHead, - fun i => idleDir (wHeads i), - idleDir oHead ) - | .done => - allIdle (Sum.inr (Sum.inl .done)) iHead wHeads oHead - -- ══════════════════════════════════════════════════════════════════ - -- Then branch: simulate tmThen - -- ══════════════════════════════════════════════════════════════════ - | Sum.inr (Sum.inr (Sum.inl q)) => - if q = tmThen.qhalt then - -- tmThen halted → transition to done, preserve tapes - ( Sum.inr (Sum.inl .done), - fun i => readBackWrite (wHeads i), - readBackWrite oHead, - idleDir iHead, - fun i => idleDir (wHeads i), - idleDir oHead ) - else - let (q', wW, oW, iD, wD, oD) := tmThen.δ q iHead wHeads oHead - ( Sum.inr (Sum.inr (Sum.inl q')), wW, oW, iD, wD, oD ) - -- ══════════════════════════════════════════════════════════════════ - -- Else branch: simulate tmElse - -- ══════════════════════════════════════════════════════════════════ - | Sum.inr (Sum.inr (Sum.inr q)) => - if q = tmElse.qhalt then - -- tmElse halted → transition to done, preserve tapes - ( Sum.inr (Sum.inl .done), - fun i => readBackWrite (wHeads i), - readBackWrite oHead, - idleDir iHead, - fun i => idleDir (wHeads i), - idleDir oHead ) - else - let (q', wW, oW, iD, wD, oD) := tmElse.δ q iHead wHeads oHead - ( Sum.inr (Sum.inr (Sum.inr q')), wW, oW, iD, wD, oD ), - δ_right_of_start := by - intro state iHead wHeads oHead - match state with - | Sum.inl q => - dsimp only [] - split - · exact ⟨idleDir_right_of_start, fun _ => idleDir_right_of_start, - idleDir_right_of_start⟩ - · exact tmTest.δ_right_of_start q iHead wHeads oHead - | Sum.inr (Sum.inl phase) => - match phase with - | .rewindOut => - dsimp only [] - split - · exact ⟨idleDir_right_of_start, fun _ => idleDir_right_of_start, - fun _ => rfl⟩ - · refine ⟨idleDir_right_of_start, fun _ => idleDir_right_of_start, ?_⟩ - intro h; next hn => exact absurd h hn - | .check => - dsimp only [] - split <;> exact ⟨idleDir_right_of_start, fun _ => idleDir_right_of_start, - idleDir_right_of_start⟩ - | .done => - exact rightOfStart_allIdle iHead wHeads oHead - | Sum.inr (Sum.inr (Sum.inl q)) => - dsimp only [] - split - · exact ⟨idleDir_right_of_start, fun _ => idleDir_right_of_start, - idleDir_right_of_start⟩ - · exact tmThen.δ_right_of_start q iHead wHeads oHead - | Sum.inr (Sum.inr (Sum.inr q)) => - dsimp only [] - split - · exact ⟨idleDir_right_of_start, fun _ => idleDir_right_of_start, - idleDir_right_of_start⟩ - · exact tmElse.δ_right_of_start q iHead wHeads oHead } - --- ════════════════════════════════════════════════════════════════════════ --- Sequential Composition --- ════════════════════════════════════════════════════════════════════════ - -/-- The state type for the sequential composition TM. -/ -abbrev SeqQ (Q₁ Q₂ : Type) := Q₁ ⊕ Q₂ - -/-- Sequential composition: run tm₁ to completion, then tm₂ on the same tapes. - - Both machines share the same `n` work tapes, input tape, and output tape. - When tm₁ halts, there is one transition step that: - - Changes state from `Q₁` to `Q₂` (entering `tm₂.qstart`) - - Preserves all tape cell contents (via `readBackWrite`) - - Moves any tape head at position 0 to position 1 (forced by `δ_right_of_start`) - - Leaves all other tape head positions unchanged - - After the transition, tm₂ runs from the resulting tape state. - Total time: `t₁ + 1 + t₂` where `t₁` and `t₂` are the run times of - `tm₁` and `tm₂` respectively. -/ -def seqTM (tm₁ tm₂ : TM n) : TM n := - haveI : Fintype tm₁.Q := tm₁.finQ - haveI : DecidableEq tm₁.Q := tm₁.decEq - haveI : Fintype tm₂.Q := tm₂.finQ - haveI : DecidableEq tm₂.Q := tm₂.decEq - { Q := SeqQ tm₁.Q tm₂.Q, - qstart := Sum.inl tm₁.qstart, - qhalt := Sum.inr tm₂.qhalt, - δ := fun state iHead wHeads oHead => - match state with - -- ══════════════════════════════════════════════════════════════════ - -- Phase 1: simulate tm₁ - -- ══════════════════════════════════════════════════════════════════ - | Sum.inl q => - if q = tm₁.qhalt then - -- tm₁ halted → transition to tm₂.qstart, preserve tape contents - ( Sum.inr tm₂.qstart, - fun i => readBackWrite (wHeads i), - readBackWrite oHead, - idleDir iHead, - fun i => idleDir (wHeads i), - idleDir oHead ) - else - -- Not halted → run tm₁.δ, wrapping state in Sum.inl - let (q', wW, oW, iD, wD, oD) := tm₁.δ q iHead wHeads oHead - ( Sum.inl q', wW, oW, iD, wD, oD ) - -- ══════════════════════════════════════════════════════════════════ - -- Phase 2: simulate tm₂ - -- ══════════════════════════════════════════════════════════════════ - | Sum.inr q => - if q = tm₂.qhalt then - -- Unreachable by step, but δ is total - allIdle (Sum.inr tm₂.qhalt) iHead wHeads oHead - else - -- Not halted → run tm₂.δ, wrapping state in Sum.inr - let (q', wW, oW, iD, wD, oD) := tm₂.δ q iHead wHeads oHead - ( Sum.inr q', wW, oW, iD, wD, oD ), - δ_right_of_start := by - intro state iHead wHeads oHead - match state with - | Sum.inl q => - dsimp only [] - split - · exact ⟨idleDir_right_of_start, fun _ => idleDir_right_of_start, - idleDir_right_of_start⟩ - · exact tm₁.δ_right_of_start q iHead wHeads oHead - | Sum.inr q => - dsimp only [] - split - · exact rightOfStart_allIdle iHead wHeads oHead - · exact tm₂.δ_right_of_start q iHead wHeads oHead } - --- ════════════════════════════════════════════════════════════════════════ --- Loop Combinator --- ════════════════════════════════════════════════════════════════════════ - -/-- Intermediate states for the loop machine's output-checking phase. -/ -inductive LoopPhase where - | rewindOut -- rewind output head left to ▷ (cell 0) - | check -- at cell 1: read output, decide continue/halt - | done -- halt state - deriving DecidableEq - -instance : Fintype LoopPhase where - elems := {.rewindOut, .check, .done} - complete := fun x => by cases x <;> simp - -/-- The state type for the loop TM. -/ -abbrev LoopQ (QBody QTest : Type) := QBody ⊕ LoopPhase ⊕ QTest - -/-- Loop combinator: repeatedly run `tmBody` then `tmTest`, halting when - the test's output at cell 1 is `Γ.one`. - - Both machines share the same `n` work tapes, input tape, and output tape. - Work tape contents are preserved across transitions (via `readBackWrite`), - allowing the body to accumulate state across iterations. - - ## Phases - - 1. **Body**: Simulate `tmBody`. When it halts, transition to test. - 2. **Test**: Simulate `tmTest`. When it halts, enter rewind. - 3. **Rewind output**: Move output head left to `▷` (cell 0). - 4. **Check**: Move right to cell 1, read the test result. - If `Γ.one`, enter `done` (halt). Otherwise, transition back to body. - - ## Use case - - The UTM's main loop: `loopTM simStepTM checkHaltTM` runs one simulation - step, then checks if the simulated machine has halted. -/ -def loopTM (tmBody : TM n) (tmTest : TM n) : TM n := - haveI : Fintype tmBody.Q := tmBody.finQ - haveI : DecidableEq tmBody.Q := tmBody.decEq - haveI : Fintype tmTest.Q := tmTest.finQ - haveI : DecidableEq tmTest.Q := tmTest.decEq - { Q := LoopQ tmBody.Q tmTest.Q, - qstart := Sum.inl tmBody.qstart, - qhalt := Sum.inr (Sum.inl .done), - δ := fun state iHead wHeads oHead => - match state with - -- ══════════════════════════════════════════════════════════════════ - -- Body phase: simulate tmBody - -- ══════════════════════════════════════════════════════════════════ - | Sum.inl q => - if q = tmBody.qhalt then - -- Body halted → transition to test, preserve tape contents - ( Sum.inr (Sum.inr tmTest.qstart), - fun i => readBackWrite (wHeads i), - readBackWrite oHead, - idleDir iHead, - fun i => idleDir (wHeads i), - idleDir oHead ) - else - let (q', wW, oW, iD, wD, oD) := tmBody.δ q iHead wHeads oHead - ( Sum.inl q', wW, oW, iD, wD, oD ) - -- ══════════════════════════════════════════════════════════════════ - -- Transition phases: rewind and check output - -- ══════════════════════════════════════════════════════════════════ - | Sum.inr (Sum.inl phase) => - match phase with - | .rewindOut => - if oHead = Γ.start then - -- At ▷ (cell 0) → move right to cell 1, enter check - ( Sum.inr (Sum.inl .check), - fun i => readBackWrite (wHeads i), - .blank, - idleDir iHead, - fun i => idleDir (wHeads i), - Dir3.right ) - else - -- Not at cell 0 → keep moving left, preserve output - ( Sum.inr (Sum.inl .rewindOut), - fun i => readBackWrite (wHeads i), - readBackWrite oHead, - idleDir iHead, - fun i => idleDir (wHeads i), - Dir3.left ) - | .check => - if oHead = Γ.one then - -- Test output = 1: halt the loop - ( Sum.inr (Sum.inl .done), - fun i => readBackWrite (wHeads i), - readBackWrite oHead, - idleDir iHead, - fun i => idleDir (wHeads i), - idleDir oHead ) - else - -- Test output ≠ 1: loop back to body - ( Sum.inl tmBody.qstart, - fun i => readBackWrite (wHeads i), - readBackWrite oHead, - idleDir iHead, - fun i => idleDir (wHeads i), - idleDir oHead ) - | .done => - allIdle (Sum.inr (Sum.inl .done)) iHead wHeads oHead - -- ══════════════════════════════════════════════════════════════════ - -- Test phase: simulate tmTest - -- ══════════════════════════════════════════════════════════════════ - | Sum.inr (Sum.inr q) => - if q = tmTest.qhalt then - -- Test halted → begin rewinding output, preserve tapes - ( Sum.inr (Sum.inl .rewindOut), - fun i => readBackWrite (wHeads i), - readBackWrite oHead, - idleDir iHead, - fun i => idleDir (wHeads i), - idleDir oHead ) - else - let (q', wW, oW, iD, wD, oD) := tmTest.δ q iHead wHeads oHead - ( Sum.inr (Sum.inr q'), wW, oW, iD, wD, oD ), - δ_right_of_start := by - intro state iHead wHeads oHead - match state with - | Sum.inl q => - dsimp only [] - split - · exact ⟨idleDir_right_of_start, fun _ => idleDir_right_of_start, - idleDir_right_of_start⟩ - · exact tmBody.δ_right_of_start q iHead wHeads oHead - | Sum.inr (Sum.inl phase) => - match phase with - | .rewindOut => - dsimp only [] - split - · exact ⟨idleDir_right_of_start, fun _ => idleDir_right_of_start, - fun _ => rfl⟩ - · refine ⟨idleDir_right_of_start, fun _ => idleDir_right_of_start, ?_⟩ - intro h; next hn => exact absurd h hn - | .check => - dsimp only [] - split <;> exact ⟨idleDir_right_of_start, fun _ => idleDir_right_of_start, - idleDir_right_of_start⟩ - | .done => - exact rightOfStart_allIdle iHead wHeads oHead - | Sum.inr (Sum.inr q) => - dsimp only [] - split - · exact ⟨idleDir_right_of_start, fun _ => idleDir_right_of_start, - idleDir_right_of_start⟩ - · exact tmTest.δ_right_of_start q iHead wHeads oHead } - --- ════════════════════════════════════════════════════════════════════════ --- Finite-state scanner --- ════════════════════════════════════════════════════════════════════════ - -/-- Control states of a generic finite-state scanner parameterized by a - user-supplied scan-state type `S`. The machine has a one-time `start` - step that advances off cell 0, then a stream of `scan s` states holding - the current scan state, and finally a `done` halt state. -/ -inductive ScannerPhase (S : Type) where - | start - | scan (s : S) - | done - -instance {S : Type} [DecidableEq S] : DecidableEq (ScannerPhase S) - | .start, .start => isTrue rfl - | .start, .scan _ => isFalse (fun h => by cases h) - | .start, .done => isFalse (fun h => by cases h) - | .scan _, .start => isFalse (fun h => by cases h) - | .scan _, .done => isFalse (fun h => by cases h) - | .done, .start => isFalse (fun h => by cases h) - | .done, .scan _ => isFalse (fun h => by cases h) - | .done, .done => isTrue rfl - | .scan s₁, .scan s₂ => - if h : s₁ = s₂ then isTrue (by rw [h]) - else isFalse (fun heq => h (by cases heq; rfl)) - -instance {S : Type} [DecidableEq S] [Fintype S] : Fintype (ScannerPhase S) where - elems := insert ScannerPhase.start - (insert (ScannerPhase.done : ScannerPhase S) - (Finset.univ.image ScannerPhase.scan)) - complete := fun x => by - cases x with - | start => exact Finset.mem_insert_self _ _ - | done => exact Finset.mem_insert_of_mem (Finset.mem_insert_self _ _) - | scan s => - apply Finset.mem_insert_of_mem - apply Finset.mem_insert_of_mem - exact Finset.mem_image.mpr ⟨s, Finset.mem_univ s, rfl⟩ - -/-- **Generic finite-state scanner.** - - A 0-work-tape TM parameterized by a scan-state type `S`, an initial - state `s₀`, a transition function `scanStep : S → Bool → S` (called on - each input bit), and a finalizer `finalOutput : S → Γw` (the symbol to - emit when end-of-input is reached). - - Semantics: runs left-to-right through the input, folding `scanStep` over - the bits starting from `s₀`; when a blank is reached, writes - `finalOutput (finalState)` to output cell 1 and halts. - - This captures the common "read once, fold into a fixed-size state" - pattern used by `evenLength`, `allZeros`/`allOnes`, `containsZero`/`containsOne`, - `lengthDivBy k`, `lastBit`, and similar regular-language scanners. - - Halts in `|x| + 2` steps on every input (1 start + `|x|` scans + 1 halt). -/ -def scannerTM {S : Type} [DecidableEq S] [Fintype S] - (s₀ : S) (scanStep : S → Bool → S) (finalOutput : S → Γw) : TM 0 where - Q := ScannerPhase S - qstart := .start - qhalt := .done - δ := fun state iHead _wHeads oHead => - match state with - | .start => - -- Advance input and output from cell 0 (▷) to cell 1. Writes at cell 0 - -- are no-ops. Enter the initial scan state. - (.scan s₀, fun i => i.elim0, .blank, - .right, fun i => i.elim0, .right) - | .scan s => - if iHead = Γ.blank then - -- End of input. Emit `finalOutput s` and halt. - (.done, fun i => i.elim0, finalOutput s, - idleDir iHead, fun i => i.elim0, idleDir oHead) - else - -- Read a bit: `Γ.one ↦ true`, anything else (including the - -- structurally-unreachable `Γ.start`) ↦ `false`. - let b : Bool := decide (iHead = Γ.one) - (.scan (scanStep s b), fun i => i.elim0, readBackWrite oHead, - .right, fun i => i.elim0, idleDir oHead) - | .done => - allIdle .done iHead _wHeads oHead - δ_right_of_start := by - intro state iHead wHeads oHead - match state with - | .start => - refine ⟨fun _ => rfl, fun i => i.elim0, fun _ => rfl⟩ - | .scan _ => - dsimp only []; split - · exact ⟨idleDir_right_of_start, fun i => i.elim0, idleDir_right_of_start⟩ - · exact ⟨fun _ => rfl, fun i => i.elim0, idleDir_right_of_start⟩ - | .done => - exact rightOfStart_allIdle iHead wHeads oHead - --- ════════════════════════════════════════════════════════════════════════ --- retargetInput: read virtual input from work tape k instead of input tape --- ════════════════════════════════════════════════════════════════════════ - -/-- Given a DTM `M : TM k`, construct a DTM `retargetInput M : TM (k + 1)` - that behaves like `M` but reads its "input" from work tape `k` (the last - work tape) instead of the real input tape. - - Tape layout: - - Real input tape: ignored (moved idly each step, never read). - - Work tapes `0..k-1`: mirror `M`'s work tapes. - - Work tape `k`: plays the role of `M`'s input tape (read-only, no - writes except a no-op `readBackWrite` that preserves cells). - - When work tape `k` is initialized with `Tape.init (z.map Γ.ofBool)`, the - machine simulates `M` on input `z`. - - Used in `witnessLang` NTM constructions where the verifier DTM's - "input" (e.g. `pair(x, y)`) is built on a work tape rather than - supplied on the real input tape. -/ -def retargetInput {k : ℕ} (M : TM k) : TM (k + 1) where - Q := M.Q - qstart := M.qstart - qhalt := M.qhalt - δ := fun q _iHead wHeads oHead => - let virtualInput : Γ := wHeads ⟨k, by omega⟩ - let innerWork : Fin k → Γ := fun i => wHeads ⟨i.val, by omega⟩ - let (q', workWrites, outWrite, inDir, workDirs, outDir) := - M.δ q virtualInput innerWork oHead - ( q', - fun i => - if h : i.val < k then workWrites ⟨i.val, h⟩ - else readBackWrite virtualInput, - outWrite, - idleDir _iHead, - fun i => - if h : i.val < k then workDirs ⟨i.val, h⟩ - else inDir, - outDir ) - δ_right_of_start := by - intro q iHead wHeads oHead - have hδ := M.δ_right_of_start q (wHeads ⟨k, by omega⟩) - (fun i => wHeads ⟨i.val, by omega⟩) oHead - obtain ⟨hinp, hwork, hout⟩ := hδ - refine ⟨idleDir_right_of_start, ?_, hout⟩ - intro i hwi - dsimp only [] - split - · next hi => - -- i.val < k: use M's work condition - exact hwork ⟨i.val, hi⟩ (by - change wHeads ⟨i.val, _⟩ = _ - rwa [show wHeads ⟨i.val, by omega⟩ = wHeads i from by congr 1]) - · next hi => - -- i.val = k: use M's input condition - have hik : i.val = k := by - have := i.isLt - omega - have : wHeads ⟨k, by omega⟩ = Γ.start := by - rw [show (⟨k, by omega⟩ : Fin (k + 1)) = i from by ext; simp [hik]] - exact hwi - exact hinp this - -end TM - -end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/Defs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/Defs.lean new file mode 100644 index 0000000000..b0510bc68f --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/Defs.lean @@ -0,0 +1,908 @@ +/- +Copyright (c) 2025 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.Helpers + +/-! +# Turing-machine combinator definitions + +State spaces, tape layouts, transition functions, and start-marker invariants for +union, complement, branching, sequencing, looping, scanning, and input retargeting. +The public `Combinators` module documents and re-exports these constructions. +-/ + +@[expose] public section + +namespace Complexity + +variable {n₁ n₂ : ℕ} + +namespace TM + +-- ════════════════════════════════════════════════════════════════════════ +-- State type +-- ════════════════════════════════════════════════════════════════════════ + +/-- Intermediate states between Phase 1 and Phase 2 of the union machine. -/ +inductive UnionPhase where + | rewindOut -- rewind fake output (work tape n₁) to cell 0 + | checkResult -- at fake output cell 1: read and decide accept/continue + | rewindIn -- rewind input tape to cell 0 + | setup2 -- move Phase-2 tapes from cell 1 to cell 0 + deriving DecidableEq + +instance : Fintype UnionPhase where + elems := {.rewindOut, .checkResult, .rewindIn, .setup2} + complete := fun x => by cases x <;> simp + +/-- The state type for the union TM. -/ +abbrev UnionQ (Q₁ Q₂ : Type) := Q₁ ⊕ UnionPhase ⊕ Q₂ + +-- ════════════════════════════════════════════════════════════════════════ +-- Index helpers for the n₁ + 1 + n₂ work tapes +-- ════════════════════════════════════════════════════════════════════════ + +/-- Index of the fake output tape (work tape `n₁`). -/ +def fakeOutIdx : Fin (n₁ + 1 + n₂) := ⟨n₁, by omega⟩ + +/-- Read tm₁'s work tapes from the composite work tapes. -/ +def phase1WorkReads (wHeads : Fin (n₁ + 1 + n₂) → Γ) (i : Fin n₁) : Γ := + wHeads ⟨i.val, by omega⟩ + +/-- Read tm₂'s work tapes from the composite work tapes. -/ +def phase2WorkReads (wHeads : Fin (n₁ + 1 + n₂) → Γ) (j : Fin n₂) : Γ := + wHeads ⟨n₁ + 1 + j.val, by omega⟩ + +-- ════════════════════════════════════════════════════════════════════════ +-- The union TM +-- ════════════════════════════════════════════════════════════════════════ + +/-- Construct a TM deciding `L₁ ∪ L₂` from TMs deciding `L₁` and `L₂`. + + The composite machine has `n₁ + 1 + n₂` work tapes: + - `0 .. n₁-1` for `tm₁`'s work tapes + - `n₁` for `tm₁`'s redirected output + - `n₁+1 .. n₁+n₂` for `tm₂`'s work tapes -/ +def unionTM (tm₁ : TM n₁) (tm₂ : TM n₂) : TM (n₁ + 1 + n₂) := + haveI : Fintype tm₁.Q := tm₁.finQ + haveI : DecidableEq tm₁.Q := tm₁.decEq + haveI : Fintype tm₂.Q := tm₂.finQ + haveI : DecidableEq tm₂.Q := tm₂.decEq + { Q := UnionQ tm₁.Q tm₂.Q, + qstart := Sum.inl tm₁.qstart, + qhalt := Sum.inr (Sum.inr tm₂.qhalt), + δ := fun state iHead wHeads oHead => + match state with + -- ══════════════════════════════════════════════════════════════════ + -- Phase 1: simulate tm₁ with output redirected to work tape n₁ + -- ══════════════════════════════════════════════════════════════════ + | Sum.inl q => + if q = tm₁.qhalt then + -- Transition to rewind; preserve fake output value to avoid corrupting cell 1 + ( Sum.inr (Sum.inl .rewindOut), + fun i => if i.val = n₁ then readBackWrite (wHeads fakeOutIdx) else .blank, + .blank, + idleDir iHead, + fun i => idleDir (wHeads i), + idleDir oHead ) + else + let (q', wW, oW, iD, wD, oD) := + tm₁.δ q iHead (phase1WorkReads wHeads) (wHeads fakeOutIdx) + ( Sum.inl q', + fun i => + if h : i.val < n₁ then wW ⟨i.val, h⟩ + else if i.val = n₁ then oW + else .blank, + .blank, iD, + fun i => + if h : i.val < n₁ then wD ⟨i.val, h⟩ + else if i.val = n₁ then oD + else idleDir (wHeads i), + idleDir oHead ) + -- ══════════════════════════════════════════════════════════════════ + -- Transition states between phases + -- ══════════════════════════════════════════════════════════════════ + | Sum.inr (Sum.inl m) => + match m with + | .rewindOut => + if wHeads fakeOutIdx = Γ.start then + -- At cell 0 → move right to cell 1 + ( Sum.inr (Sum.inl .checkResult), + fun _ => .blank, .blank, idleDir iHead, + fun i => if i.val = n₁ then Dir3.right else idleDir (wHeads i), + idleDir oHead ) + else + -- Not at cell 0 → keep moving left; preserve fake output to avoid corrupting cell 1 + ( Sum.inr (Sum.inl .rewindOut), + fun i => if i.val = n₁ then readBackWrite (wHeads fakeOutIdx) else .blank, + .blank, idleDir iHead, + fun i => if i.val = n₁ then Dir3.left else idleDir (wHeads i), + idleDir oHead ) + | .checkResult => + if wHeads fakeOutIdx = Γ.one then + -- tm₁ accepted → write Γ.one to real output (at cell 1), halt + ( Sum.inr (Sum.inr tm₂.qhalt), + fun _ => .blank, .one, idleDir iHead, + fun i => idleDir (wHeads i), + idleDir oHead ) + else + -- tm₁ rejected → proceed to rewind input + allIdle (Sum.inr (Sum.inl .rewindIn)) iHead wHeads oHead + | .rewindIn => + if iHead = Γ.start then + -- At cell 0 → forced right by δ_right_of_start, then setup2 + ( Sum.inr (Sum.inl .setup2), + fun _ => .blank, .blank, Dir3.right, + fun i => idleDir (wHeads i), + idleDir oHead ) + else + -- Not at cell 0 → keep moving left + ( Sum.inr (Sum.inl .rewindIn), + fun _ => .blank, .blank, Dir3.left, + fun i => idleDir (wHeads i), + idleDir oHead ) + | .setup2 => + -- Move input, Phase-2 work tapes, and real output from cell 1 to cell 0 + ( Sum.inr (Sum.inr tm₂.qstart), + fun _ => .blank, .blank, moveLeftDir iHead, + fun i => if i.val ≤ n₁ then idleDir (wHeads i) else moveLeftDir (wHeads i), + moveLeftDir oHead ) + -- ══════════════════════════════════════════════════════════════════ + -- Phase 2: simulate tm₂ with the real output tape + -- ══════════════════════════════════════════════════════════════════ + | Sum.inr (Sum.inr q) => + if q = tm₂.qhalt then + -- Unreachable (step returns none), but δ is total + allIdle (Sum.inr (Sum.inr tm₂.qhalt)) iHead wHeads oHead + else + let (q', wW, oW, iD, wD, oD) := + tm₂.δ q iHead (phase2WorkReads wHeads) oHead + ( Sum.inr (Sum.inr q'), + fun i => + if h : i.val ≤ n₁ then .blank + else wW ⟨i.val - (n₁ + 1), by omega⟩, + oW, iD, + fun i => + if h : i.val ≤ n₁ then idleDir (wHeads i) + else wD ⟨i.val - (n₁ + 1), by omega⟩, + oD ), + δ_right_of_start := by + intro state iHead wHeads oHead + match state with + | Sum.inl q => + dsimp only [] + split + · exact rightOfStart_allIdle iHead wHeads oHead + · next hne => + have hδ := tm₁.δ_right_of_start q iHead (phase1WorkReads wHeads) (wHeads fakeOutIdx) + simp only [phase1WorkReads, fakeOutIdx] at hδ + refine ⟨hδ.1, ?_, idleDir_right_of_start⟩ + intro i hwi; simp only [] + split + · next hi => + exact hδ.2.1 ⟨i.val, hi⟩ (by + rwa [show wHeads ⟨↑i, by omega⟩ = wHeads i from by congr 1]) + · split + · next hi hn => + exact hδ.2.2 (by + rwa [show wHeads ⟨n₁, by omega⟩ = wHeads i from by congr 1; ext; simp [hn]]) + · exact idleDir_right_of_start hwi + | Sum.inr (Sum.inl m) => + match m with + | .rewindOut => + dsimp only [fakeOutIdx] + by_cases hphase : wHeads fakeOutIdx = Γ.start + all_goals simp only [fakeOutIdx] at hphase + all_goals simp only [hphase, ite_true, ite_false] + · refine ⟨idleDir_right_of_start, ?_, idleDir_right_of_start⟩ + intro i hwi; split + · rfl + · exact idleDir_right_of_start hwi + · refine ⟨idleDir_right_of_start, ?_, idleDir_right_of_start⟩ + intro i hwi; split + · next heq => + exfalso; apply hphase + rwa [show wHeads ⟨n₁, by omega⟩ = wHeads i from by congr 1; ext; simp [heq]] + · exact idleDir_right_of_start hwi + | .checkResult => + dsimp only [fakeOutIdx] + by_cases hphase : wHeads fakeOutIdx = Γ.one + all_goals simp only [fakeOutIdx] at hphase + all_goals simp only [hphase, ite_true, ite_false] + · exact ⟨idleDir_right_of_start, fun _ => idleDir_right_of_start, idleDir_right_of_start⟩ + · exact rightOfStart_allIdle iHead wHeads oHead + | .rewindIn => + dsimp only [] + split + · exact ⟨fun _ => rfl, fun _ => idleDir_right_of_start, idleDir_right_of_start⟩ + · refine ⟨?_, fun _ => idleDir_right_of_start, idleDir_right_of_start⟩ + intro hiHead; next hn => exact absurd hiHead hn + | .setup2 => + refine ⟨moveLeftDir_right_of_start, ?_, moveLeftDir_right_of_start⟩ + intro i hwi; simp only []; split + · exact idleDir_right_of_start hwi + · exact moveLeftDir_right_of_start hwi + | Sum.inr (Sum.inr q) => + dsimp only [] + split + · exact rightOfStart_allIdle iHead wHeads oHead + · next hne => + have hδ := tm₂.δ_right_of_start q iHead (phase2WorkReads wHeads) oHead + simp only [phase2WorkReads] at hδ + refine ⟨hδ.1, ?_, hδ.2.2⟩ + intro i hwi; simp only []; split + · exact idleDir_right_of_start hwi + · next hi => + exact hδ.2.1 ⟨i.val - (n₁ + 1), by omega⟩ (by + rwa [show wHeads ⟨n₁ + 1 + (↑i - (n₁ + 1)), by omega⟩ = wHeads i from by + congr 1; ext; simp; omega]) } + +-- ════════════════════════════════════════════════════════════════════════ +-- Complement TM +-- ════════════════════════════════════════════════════════════════════════ + +/-- Intermediate states for the complement machine's output-flipping phase. -/ +inductive ComplementPhase where + | rewind -- rewind output head left to cell 0, then right to cell 1 + | flip -- at cell 1: flip the output bit and halt + | done -- halt state + deriving DecidableEq + +instance : Fintype ComplementPhase where + elems := {.rewind, .flip, .done} + complete := fun x => by cases x <;> simp + +/-- The state type for the complement TM. -/ +abbrev ComplementQ (Q : Type) := Q ⊕ ComplementPhase + +/-- Flip a readable symbol: `1 ↔ 0`, blanks stay blank. -/ +def flipBit (g : Γ) : Γw := + match g with + | .one => .zero + | .zero => .one + | .blank => .blank + | .start => .blank + +/-- Construct a TM deciding `Lᶜ` from a TM deciding `L`. + + The complement machine has the same number of work tapes as the original. + It runs in three stages: + + 1. **Simulate**: Run the original TM. When it halts, transition to `rewind`. + 2. **Rewind**: Move the output head left to `▷` (cell 0), then right to cell 1. + 3. **Flip**: Read output cell 1, write the flipped bit, and halt. -/ +def complementTM (tm : TM n) : TM n := + haveI : Fintype tm.Q := tm.finQ + haveI : DecidableEq tm.Q := tm.decEq + { Q := ComplementQ tm.Q, + qstart := Sum.inl tm.qstart, + qhalt := Sum.inr .done, + δ := fun state iHead wHeads oHead => + match state with + -- ══════════════════════════════════════════════════════════════════ + -- Simulation phase: run original TM + -- ══════════════════════════════════════════════════════════════════ + | Sum.inl q => + if q = tm.qhalt then + -- Original TM halted → begin rewinding output + -- Write back the current output symbol to preserve cell contents + ( Sum.inr .rewind, + fun _ => .blank, + readBackWrite oHead, + idleDir iHead, + fun i => idleDir (wHeads i), + idleDir oHead ) + else + -- Not halted → run original δ, wrapping state in Sum.inl + let (q', wW, oW, iD, wD, oD) := tm.δ q iHead wHeads oHead + ( Sum.inl q', wW, oW, iD, wD, oD ) + -- ══════════════════════════════════════════════════════════════════ + -- Rewind phase: move output head left to ▷, then right to cell 1 + -- ══════════════════════════════════════════════════════════════════ + | Sum.inr .rewind => + if oHead = Γ.start then + -- At cell 0 (▷) → move right to cell 1, enter flip state + ( Sum.inr .flip, + fun _ => .blank, + .blank, + idleDir iHead, + fun i => idleDir (wHeads i), + Dir3.right ) + else + -- Not at cell 0 → keep moving left, preserve output cell contents + ( Sum.inr .rewind, + fun _ => .blank, + readBackWrite oHead, + idleDir iHead, + fun i => idleDir (wHeads i), + Dir3.left ) + -- ══════════════════════════════════════════════════════════════════ + -- Flip phase: at cell 1, flip the output bit and halt + -- ══════════════════════════════════════════════════════════════════ + | Sum.inr .flip => + ( Sum.inr .done, + fun _ => .blank, + flipBit oHead, + idleDir iHead, + fun i => idleDir (wHeads i), + idleDir oHead ) + -- ══════════════════════════════════════════════════════════════════ + -- Done (= qhalt): unreachable by step, but δ is total + -- ══════════════════════════════════════════════════════════════════ + | Sum.inr .done => + allIdle (Sum.inr .done) iHead wHeads oHead, + δ_right_of_start := by + intro state iHead wHeads oHead + match state with + | Sum.inl q => + dsimp only [] + split + · exact ⟨idleDir_right_of_start, fun _ => idleDir_right_of_start, + idleDir_right_of_start⟩ + · exact tm.δ_right_of_start q iHead wHeads oHead + | Sum.inr .rewind => + dsimp only [] + split + · exact ⟨idleDir_right_of_start, fun _ => idleDir_right_of_start, fun _ => rfl⟩ + · refine ⟨idleDir_right_of_start, fun _ => idleDir_right_of_start, ?_⟩ + intro h; next hn => exact absurd h hn + | Sum.inr .flip => + exact ⟨idleDir_right_of_start, fun _ => idleDir_right_of_start, + idleDir_right_of_start⟩ + | Sum.inr .done => + exact rightOfStart_allIdle iHead wHeads oHead } + +-- ════════════════════════════════════════════════════════════════════════ +-- Conditional Branching +-- ════════════════════════════════════════════════════════════════════════ + +/-- Intermediate states for the conditional branching machine. -/ +inductive IfPhase where + | rewindOut -- rewind output head left to ▷ (cell 0) + | check -- at cell 0, move right to cell 1, read result, branch + | done -- halt state (reached when either branch halts) + deriving DecidableEq + +instance : Fintype IfPhase where + elems := {.rewindOut, .check, .done} + complete := fun x => by cases x <;> simp + +/-- The state type for the conditional branching TM. -/ +abbrev IfQ (QT QThen QElse : Type) := QT ⊕ IfPhase ⊕ QThen ⊕ QElse + +/-- Conditional branching: run `tmTest` to completion, read its output at + cell 1, then run `tmThen` (if output = `Γ.one`) or `tmElse` (otherwise). + + All three machines share the same `n` work tapes, input tape, and output + tape. Work tape contents are preserved across all transitions via + `readBackWrite`, maintaining shared state for the branch machines. + + ## Phases + + 1. **Test**: Simulate `tmTest`. When it halts, enter rewind. + 2. **Rewind output**: Move output head left to `▷` (cell 0). + 3. **Check**: Move output head right to cell 1, read the test result. + If `Γ.one`, enter `tmThen.qstart`. Otherwise, enter `tmElse.qstart`. + 4. **Branch**: Simulate `tmThen` or `tmElse`. When the branch machine + halts, transition to the `done` halt state. + + ## Time + + `t_test + (output_head_pos + 2) + 1 + t_branch + 1` where + `output_head_pos ≤ t_test`. Total: at most `2·t_test + t_branch + 4`. -/ +def ifTM (tmTest : TM n) (tmThen : TM n) (tmElse : TM n) : TM n := + haveI : Fintype tmTest.Q := tmTest.finQ + haveI : DecidableEq tmTest.Q := tmTest.decEq + haveI : Fintype tmThen.Q := tmThen.finQ + haveI : DecidableEq tmThen.Q := tmThen.decEq + haveI : Fintype tmElse.Q := tmElse.finQ + haveI : DecidableEq tmElse.Q := tmElse.decEq + { Q := IfQ tmTest.Q tmThen.Q tmElse.Q, + qstart := Sum.inl tmTest.qstart, + qhalt := Sum.inr (Sum.inl .done), + δ := fun state iHead wHeads oHead => + match state with + -- ══════════════════════════════════════════════════════════════════ + -- Test phase: simulate tmTest + -- ══════════════════════════════════════════════════════════════════ + | Sum.inl q => + if q = tmTest.qhalt then + -- tmTest halted → begin rewinding output, preserve all tapes + ( Sum.inr (Sum.inl .rewindOut), + fun i => readBackWrite (wHeads i), + readBackWrite oHead, + idleDir iHead, + fun i => idleDir (wHeads i), + idleDir oHead ) + else + let (q', wW, oW, iD, wD, oD) := tmTest.δ q iHead wHeads oHead + ( Sum.inl q', wW, oW, iD, wD, oD ) + -- ══════════════════════════════════════════════════════════════════ + -- Transition: rewind output and check result + -- ══════════════════════════════════════════════════════════════════ + | Sum.inr (Sum.inl phase) => + match phase with + | .rewindOut => + if oHead = Γ.start then + -- At ▷ (cell 0) → move right to cell 1, enter check + ( Sum.inr (Sum.inl .check), + fun i => readBackWrite (wHeads i), + .blank, + idleDir iHead, + fun i => idleDir (wHeads i), + Dir3.right ) + else + -- Not at cell 0 → keep moving left, preserve output + ( Sum.inr (Sum.inl .rewindOut), + fun i => readBackWrite (wHeads i), + readBackWrite oHead, + idleDir iHead, + fun i => idleDir (wHeads i), + Dir3.left ) + | .check => + -- At cell 1: read output and branch + if oHead = Γ.one then + ( Sum.inr (Sum.inr (Sum.inl tmThen.qstart)), + fun i => readBackWrite (wHeads i), + readBackWrite oHead, + idleDir iHead, + fun i => idleDir (wHeads i), + idleDir oHead ) + else + ( Sum.inr (Sum.inr (Sum.inr tmElse.qstart)), + fun i => readBackWrite (wHeads i), + readBackWrite oHead, + idleDir iHead, + fun i => idleDir (wHeads i), + idleDir oHead ) + | .done => + allIdle (Sum.inr (Sum.inl .done)) iHead wHeads oHead + -- ══════════════════════════════════════════════════════════════════ + -- Then branch: simulate tmThen + -- ══════════════════════════════════════════════════════════════════ + | Sum.inr (Sum.inr (Sum.inl q)) => + if q = tmThen.qhalt then + -- tmThen halted → transition to done, preserve tapes + ( Sum.inr (Sum.inl .done), + fun i => readBackWrite (wHeads i), + readBackWrite oHead, + idleDir iHead, + fun i => idleDir (wHeads i), + idleDir oHead ) + else + let (q', wW, oW, iD, wD, oD) := tmThen.δ q iHead wHeads oHead + ( Sum.inr (Sum.inr (Sum.inl q')), wW, oW, iD, wD, oD ) + -- ══════════════════════════════════════════════════════════════════ + -- Else branch: simulate tmElse + -- ══════════════════════════════════════════════════════════════════ + | Sum.inr (Sum.inr (Sum.inr q)) => + if q = tmElse.qhalt then + -- tmElse halted → transition to done, preserve tapes + ( Sum.inr (Sum.inl .done), + fun i => readBackWrite (wHeads i), + readBackWrite oHead, + idleDir iHead, + fun i => idleDir (wHeads i), + idleDir oHead ) + else + let (q', wW, oW, iD, wD, oD) := tmElse.δ q iHead wHeads oHead + ( Sum.inr (Sum.inr (Sum.inr q')), wW, oW, iD, wD, oD ), + δ_right_of_start := by + intro state iHead wHeads oHead + match state with + | Sum.inl q => + dsimp only [] + split + · exact ⟨idleDir_right_of_start, fun _ => idleDir_right_of_start, + idleDir_right_of_start⟩ + · exact tmTest.δ_right_of_start q iHead wHeads oHead + | Sum.inr (Sum.inl phase) => + match phase with + | .rewindOut => + dsimp only [] + split + · exact ⟨idleDir_right_of_start, fun _ => idleDir_right_of_start, + fun _ => rfl⟩ + · refine ⟨idleDir_right_of_start, fun _ => idleDir_right_of_start, ?_⟩ + intro h; next hn => exact absurd h hn + | .check => + dsimp only [] + split <;> exact ⟨idleDir_right_of_start, fun _ => idleDir_right_of_start, + idleDir_right_of_start⟩ + | .done => + exact rightOfStart_allIdle iHead wHeads oHead + | Sum.inr (Sum.inr (Sum.inl q)) => + dsimp only [] + split + · exact ⟨idleDir_right_of_start, fun _ => idleDir_right_of_start, + idleDir_right_of_start⟩ + · exact tmThen.δ_right_of_start q iHead wHeads oHead + | Sum.inr (Sum.inr (Sum.inr q)) => + dsimp only [] + split + · exact ⟨idleDir_right_of_start, fun _ => idleDir_right_of_start, + idleDir_right_of_start⟩ + · exact tmElse.δ_right_of_start q iHead wHeads oHead } + +-- ════════════════════════════════════════════════════════════════════════ +-- Sequential Composition +-- ════════════════════════════════════════════════════════════════════════ + +/-- The state type for the sequential composition TM. -/ +abbrev SeqQ (Q₁ Q₂ : Type) := Q₁ ⊕ Q₂ + +/-- Sequential composition: run tm₁ to completion, then tm₂ on the same tapes. + + Both machines share the same `n` work tapes, input tape, and output tape. + When tm₁ halts, there is one transition step that: + - Changes state from `Q₁` to `Q₂` (entering `tm₂.qstart`) + - Preserves all tape cell contents (via `readBackWrite`) + - Moves any tape head at position 0 to position 1 (forced by `δ_right_of_start`) + - Leaves all other tape head positions unchanged + + After the transition, tm₂ runs from the resulting tape state. + Total time: `t₁ + 1 + t₂` where `t₁` and `t₂` are the run times of + `tm₁` and `tm₂` respectively. -/ +def seqTM (tm₁ tm₂ : TM n) : TM n := + haveI : Fintype tm₁.Q := tm₁.finQ + haveI : DecidableEq tm₁.Q := tm₁.decEq + haveI : Fintype tm₂.Q := tm₂.finQ + haveI : DecidableEq tm₂.Q := tm₂.decEq + { Q := SeqQ tm₁.Q tm₂.Q, + qstart := Sum.inl tm₁.qstart, + qhalt := Sum.inr tm₂.qhalt, + δ := fun state iHead wHeads oHead => + match state with + -- ══════════════════════════════════════════════════════════════════ + -- Phase 1: simulate tm₁ + -- ══════════════════════════════════════════════════════════════════ + | Sum.inl q => + if q = tm₁.qhalt then + -- tm₁ halted → transition to tm₂.qstart, preserve tape contents + ( Sum.inr tm₂.qstart, + fun i => readBackWrite (wHeads i), + readBackWrite oHead, + idleDir iHead, + fun i => idleDir (wHeads i), + idleDir oHead ) + else + -- Not halted → run tm₁.δ, wrapping state in Sum.inl + let (q', wW, oW, iD, wD, oD) := tm₁.δ q iHead wHeads oHead + ( Sum.inl q', wW, oW, iD, wD, oD ) + -- ══════════════════════════════════════════════════════════════════ + -- Phase 2: simulate tm₂ + -- ══════════════════════════════════════════════════════════════════ + | Sum.inr q => + if q = tm₂.qhalt then + -- Unreachable by step, but δ is total + allIdle (Sum.inr tm₂.qhalt) iHead wHeads oHead + else + -- Not halted → run tm₂.δ, wrapping state in Sum.inr + let (q', wW, oW, iD, wD, oD) := tm₂.δ q iHead wHeads oHead + ( Sum.inr q', wW, oW, iD, wD, oD ), + δ_right_of_start := by + intro state iHead wHeads oHead + match state with + | Sum.inl q => + dsimp only [] + split + · exact ⟨idleDir_right_of_start, fun _ => idleDir_right_of_start, + idleDir_right_of_start⟩ + · exact tm₁.δ_right_of_start q iHead wHeads oHead + | Sum.inr q => + dsimp only [] + split + · exact rightOfStart_allIdle iHead wHeads oHead + · exact tm₂.δ_right_of_start q iHead wHeads oHead } + +-- ════════════════════════════════════════════════════════════════════════ +-- Loop Combinator +-- ════════════════════════════════════════════════════════════════════════ + +/-- Intermediate states for the loop machine's output-checking phase. -/ +inductive LoopPhase where + | rewindOut -- rewind output head left to ▷ (cell 0) + | check -- at cell 1: read output, decide continue/halt + | done -- halt state + deriving DecidableEq + +instance : Fintype LoopPhase where + elems := {.rewindOut, .check, .done} + complete := fun x => by cases x <;> simp + +/-- The state type for the loop TM. -/ +abbrev LoopQ (QBody QTest : Type) := QBody ⊕ LoopPhase ⊕ QTest + +/-- Loop combinator: repeatedly run `tmBody` then `tmTest`, halting when + the test's output at cell 1 is `Γ.one`. + + Both machines share the same `n` work tapes, input tape, and output tape. + Work tape contents are preserved across transitions (via `readBackWrite`), + allowing the body to accumulate state across iterations. + + ## Phases + + 1. **Body**: Simulate `tmBody`. When it halts, transition to test. + 2. **Test**: Simulate `tmTest`. When it halts, enter rewind. + 3. **Rewind output**: Move output head left to `▷` (cell 0). + 4. **Check**: Move right to cell 1, read the test result. + If `Γ.one`, enter `done` (halt). Otherwise, transition back to body. + + ## Use case + + The UTM's main loop: `loopTM simStepTM checkHaltTM` runs one simulation + step, then checks if the simulated machine has halted. -/ +def loopTM (tmBody : TM n) (tmTest : TM n) : TM n := + haveI : Fintype tmBody.Q := tmBody.finQ + haveI : DecidableEq tmBody.Q := tmBody.decEq + haveI : Fintype tmTest.Q := tmTest.finQ + haveI : DecidableEq tmTest.Q := tmTest.decEq + { Q := LoopQ tmBody.Q tmTest.Q, + qstart := Sum.inl tmBody.qstart, + qhalt := Sum.inr (Sum.inl .done), + δ := fun state iHead wHeads oHead => + match state with + -- ══════════════════════════════════════════════════════════════════ + -- Body phase: simulate tmBody + -- ══════════════════════════════════════════════════════════════════ + | Sum.inl q => + if q = tmBody.qhalt then + -- Body halted → transition to test, preserve tape contents + ( Sum.inr (Sum.inr tmTest.qstart), + fun i => readBackWrite (wHeads i), + readBackWrite oHead, + idleDir iHead, + fun i => idleDir (wHeads i), + idleDir oHead ) + else + let (q', wW, oW, iD, wD, oD) := tmBody.δ q iHead wHeads oHead + ( Sum.inl q', wW, oW, iD, wD, oD ) + -- ══════════════════════════════════════════════════════════════════ + -- Transition phases: rewind and check output + -- ══════════════════════════════════════════════════════════════════ + | Sum.inr (Sum.inl phase) => + match phase with + | .rewindOut => + if oHead = Γ.start then + -- At ▷ (cell 0) → move right to cell 1, enter check + ( Sum.inr (Sum.inl .check), + fun i => readBackWrite (wHeads i), + .blank, + idleDir iHead, + fun i => idleDir (wHeads i), + Dir3.right ) + else + -- Not at cell 0 → keep moving left, preserve output + ( Sum.inr (Sum.inl .rewindOut), + fun i => readBackWrite (wHeads i), + readBackWrite oHead, + idleDir iHead, + fun i => idleDir (wHeads i), + Dir3.left ) + | .check => + if oHead = Γ.one then + -- Test output = 1: halt the loop + ( Sum.inr (Sum.inl .done), + fun i => readBackWrite (wHeads i), + readBackWrite oHead, + idleDir iHead, + fun i => idleDir (wHeads i), + idleDir oHead ) + else + -- Test output ≠ 1: loop back to body + ( Sum.inl tmBody.qstart, + fun i => readBackWrite (wHeads i), + readBackWrite oHead, + idleDir iHead, + fun i => idleDir (wHeads i), + idleDir oHead ) + | .done => + allIdle (Sum.inr (Sum.inl .done)) iHead wHeads oHead + -- ══════════════════════════════════════════════════════════════════ + -- Test phase: simulate tmTest + -- ══════════════════════════════════════════════════════════════════ + | Sum.inr (Sum.inr q) => + if q = tmTest.qhalt then + -- Test halted → begin rewinding output, preserve tapes + ( Sum.inr (Sum.inl .rewindOut), + fun i => readBackWrite (wHeads i), + readBackWrite oHead, + idleDir iHead, + fun i => idleDir (wHeads i), + idleDir oHead ) + else + let (q', wW, oW, iD, wD, oD) := tmTest.δ q iHead wHeads oHead + ( Sum.inr (Sum.inr q'), wW, oW, iD, wD, oD ), + δ_right_of_start := by + intro state iHead wHeads oHead + match state with + | Sum.inl q => + dsimp only [] + split + · exact ⟨idleDir_right_of_start, fun _ => idleDir_right_of_start, + idleDir_right_of_start⟩ + · exact tmBody.δ_right_of_start q iHead wHeads oHead + | Sum.inr (Sum.inl phase) => + match phase with + | .rewindOut => + dsimp only [] + split + · exact ⟨idleDir_right_of_start, fun _ => idleDir_right_of_start, + fun _ => rfl⟩ + · refine ⟨idleDir_right_of_start, fun _ => idleDir_right_of_start, ?_⟩ + intro h; next hn => exact absurd h hn + | .check => + dsimp only [] + split <;> exact ⟨idleDir_right_of_start, fun _ => idleDir_right_of_start, + idleDir_right_of_start⟩ + | .done => + exact rightOfStart_allIdle iHead wHeads oHead + | Sum.inr (Sum.inr q) => + dsimp only [] + split + · exact ⟨idleDir_right_of_start, fun _ => idleDir_right_of_start, + idleDir_right_of_start⟩ + · exact tmTest.δ_right_of_start q iHead wHeads oHead } + +-- ════════════════════════════════════════════════════════════════════════ +-- Finite-state scanner +-- ════════════════════════════════════════════════════════════════════════ + +/-- Control states of a generic finite-state scanner parameterized by a + user-supplied scan-state type `S`. The machine has a one-time `start` + step that advances off cell 0, then a stream of `scan s` states holding + the current scan state, and finally a `done` halt state. -/ +inductive ScannerPhase (S : Type) where + | start + | scan (s : S) + | done + +instance {S : Type} [DecidableEq S] : DecidableEq (ScannerPhase S) + | .start, .start => isTrue rfl + | .start, .scan _ => isFalse (fun h => by cases h) + | .start, .done => isFalse (fun h => by cases h) + | .scan _, .start => isFalse (fun h => by cases h) + | .scan _, .done => isFalse (fun h => by cases h) + | .done, .start => isFalse (fun h => by cases h) + | .done, .scan _ => isFalse (fun h => by cases h) + | .done, .done => isTrue rfl + | .scan s₁, .scan s₂ => + if h : s₁ = s₂ then isTrue (by rw [h]) + else isFalse (fun heq => h (by cases heq; rfl)) + +instance {S : Type} [DecidableEq S] [Fintype S] : Fintype (ScannerPhase S) where + elems := insert ScannerPhase.start + (insert (ScannerPhase.done : ScannerPhase S) + (Finset.univ.image ScannerPhase.scan)) + complete := fun x => by + cases x with + | start => exact Finset.mem_insert_self _ _ + | done => exact Finset.mem_insert_of_mem (Finset.mem_insert_self _ _) + | scan s => + apply Finset.mem_insert_of_mem + apply Finset.mem_insert_of_mem + exact Finset.mem_image.mpr ⟨s, Finset.mem_univ s, rfl⟩ + +/-- **Generic finite-state scanner.** + + A 0-work-tape TM parameterized by a scan-state type `S`, an initial + state `s₀`, a transition function `scanStep : S → Bool → S` (called on + each input bit), and a finalizer `finalOutput : S → Γw` (the symbol to + emit when end-of-input is reached). + + Semantics: runs left-to-right through the input, folding `scanStep` over + the bits starting from `s₀`; when a blank is reached, writes + `finalOutput (finalState)` to output cell 1 and halts. + + This captures the common "read once, fold into a fixed-size state" + pattern used by `evenLength`, `allZeros`/`allOnes`, `containsZero`/`containsOne`, + `lengthDivBy k`, `lastBit`, and similar regular-language scanners. + + Halts in `|x| + 2` steps on every input (1 start + `|x|` scans + 1 halt). -/ +def scannerTM {S : Type} [DecidableEq S] [Fintype S] + (s₀ : S) (scanStep : S → Bool → S) (finalOutput : S → Γw) : TM 0 where + Q := ScannerPhase S + qstart := .start + qhalt := .done + δ := fun state iHead _wHeads oHead => + match state with + | .start => + -- Advance input and output from cell 0 (▷) to cell 1. Writes at cell 0 + -- are no-ops. Enter the initial scan state. + (.scan s₀, fun i => i.elim0, .blank, + .right, fun i => i.elim0, .right) + | .scan s => + if iHead = Γ.blank then + -- End of input. Emit `finalOutput s` and halt. + (.done, fun i => i.elim0, finalOutput s, + idleDir iHead, fun i => i.elim0, idleDir oHead) + else + -- Read a bit: `Γ.one ↦ true`, anything else (including the + -- structurally-unreachable `Γ.start`) ↦ `false`. + let b : Bool := decide (iHead = Γ.one) + (.scan (scanStep s b), fun i => i.elim0, readBackWrite oHead, + .right, fun i => i.elim0, idleDir oHead) + | .done => + allIdle .done iHead _wHeads oHead + δ_right_of_start := by + intro state iHead wHeads oHead + match state with + | .start => + refine ⟨fun _ => rfl, fun i => i.elim0, fun _ => rfl⟩ + | .scan _ => + dsimp only []; split + · exact ⟨idleDir_right_of_start, fun i => i.elim0, idleDir_right_of_start⟩ + · exact ⟨fun _ => rfl, fun i => i.elim0, idleDir_right_of_start⟩ + | .done => + exact rightOfStart_allIdle iHead wHeads oHead + +-- ════════════════════════════════════════════════════════════════════════ +-- retargetInput: read virtual input from work tape k instead of input tape +-- ════════════════════════════════════════════════════════════════════════ + +/-- Given a DTM `M : TM k`, construct a DTM `retargetInput M : TM (k + 1)` + that behaves like `M` but reads its "input" from work tape `k` (the last + work tape) instead of the real input tape. + + Tape layout: + - Real input tape: ignored (moved idly each step, never read). + - Work tapes `0..k-1`: mirror `M`'s work tapes. + - Work tape `k`: plays the role of `M`'s input tape (read-only, no + writes except a no-op `readBackWrite` that preserves cells). + + When work tape `k` is initialized with `Tape.init (z.map Γ.ofBool)`, the + machine simulates `M` on input `z`. + + Used in `witnessLang` NTM constructions where the verifier DTM's + "input" (e.g. `pair(x, y)`) is built on a work tape rather than + supplied on the real input tape. -/ +def retargetInput {k : ℕ} (M : TM k) : TM (k + 1) where + Q := M.Q + qstart := M.qstart + qhalt := M.qhalt + δ := fun q _iHead wHeads oHead => + let virtualInput : Γ := wHeads ⟨k, by omega⟩ + let innerWork : Fin k → Γ := fun i => wHeads ⟨i.val, by omega⟩ + let (q', workWrites, outWrite, inDir, workDirs, outDir) := + M.δ q virtualInput innerWork oHead + ( q', + fun i => + if h : i.val < k then workWrites ⟨i.val, h⟩ + else readBackWrite virtualInput, + outWrite, + idleDir _iHead, + fun i => + if h : i.val < k then workDirs ⟨i.val, h⟩ + else inDir, + outDir ) + δ_right_of_start := by + intro q iHead wHeads oHead + have hδ := M.δ_right_of_start q (wHeads ⟨k, by omega⟩) + (fun i => wHeads ⟨i.val, by omega⟩) oHead + obtain ⟨hinp, hwork, hout⟩ := hδ + refine ⟨idleDir_right_of_start, ?_, hout⟩ + intro i hwi + dsimp only [] + split + · next hi => + -- i.val < k: use M's work condition + exact hwork ⟨i.val, hi⟩ (by + change wHeads ⟨i.val, _⟩ = _ + rwa [show wHeads ⟨i.val, by omega⟩ = wHeads i from by congr 1]) + · next hi => + -- i.val = k: use M's input condition + have hik : i.val = k := by + have := i.isLt + omega + have : wHeads ⟨k, by omega⟩ = Γ.start := by + rw [show (⟨k, by omega⟩ : Fin (k + 1)) = i from by ext; simp [hik]] + exact hwi + exact hinp this + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/Helpers.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/Helpers.lean new file mode 100644 index 0000000000..0726f5226e --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/Helpers.lean @@ -0,0 +1,118 @@ +/- +Copyright (c) 2025 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine +public import Mathlib.Data.Fintype.Sum + +/-! +# Tape actions shared by Turing-machine combinators + +Idle and leftward directions respect the start marker. Read-back writes preserve +off-start tape contents, providing the transition invariants used by combinators. +-/ + +@[expose] public section + +namespace Complexity + +variable {n₁ n₂ : ℕ} + +namespace TM + +-- ════════════════════════════════════════════════════════════════════════ +-- Helpers +-- ════════════════════════════════════════════════════════════════════════ + +/-- Direction for an idle tape: move right if reading `▷`, else stay. + Satisfies `δ_right_of_start` for tapes not involved in the current phase. -/ +def idleDir (head : Γ) : Dir3 := + if head = Γ.start then .right else .stay + +/-- Direction for a tape we want to move left: move left unless reading `▷`, + in which case move right to satisfy `δ_right_of_start`. During actual + execution the tape won't be at cell 0, so this always moves left. -/ +def moveLeftDir (head : Γ) : Dir3 := + if head = Γ.start then .right else .left + +/-- `idleDir` moves right when reading the start symbol `▷`. -/ +theorem idleDir_start : idleDir Γ.start = Dir3.right := rfl +private theorem moveLeftDir_start : moveLeftDir Γ.start = Dir3.right := rfl + +/-- If the head reads `▷`, then `idleDir` moves right — the shape of the + `δ_right_of_start` obligation for idle tapes. -/ +theorem idleDir_right_of_start {head : Γ} (h : head = Γ.start) : idleDir head = Dir3.right := by + subst h; rfl + +/-- If the head reads `▷`, then `moveLeftDir` moves right — the shape of the + `δ_right_of_start` obligation for tapes being rewound. -/ +theorem moveLeftDir_right_of_start {head : Γ} (h : head = Γ.start) : moveLeftDir head = Dir3.right := + by subst h; rfl + +/-- Write back the same symbol read from a tape, preserving cell contents. + Maps `▷` to `□` since `Tape.write` at position 0 is a no-op anyway. -/ +def readBackWrite (g : Γ) : Γw := + match g with + | .zero => .zero + | .one => .one + | .blank => .blank + | .start => .blank + +/-- `readBackWrite` recovers the original symbol away from the left-end marker. -/ +theorem toΓ_readBackWrite_of_ne_start {g : Γ} (h : g ≠ Γ.start) : + (readBackWrite g).toΓ = g := by + cases g <;> simp_all [readBackWrite, Γw.toΓ] + +/-- Writing back the symbol under an off-start head is a no-op. -/ +theorem write_readBack (t : Tape) (hread : t.read ≠ Γ.start) : + t.write (readBackWrite t.read) = t := by + rw [Tape.write] + split + · rfl + · refine Tape.ext rfl ?_ + show Function.update t.cells t.head (readBackWrite t.read).toΓ = t.cells + rw [toΓ_readBackWrite_of_ne_start hread, Tape.read, Function.update_eq_self] + +/-- Writing back the symbol under an off-start head and moving is just the move. -/ +theorem writeAndMove_readBack (t : Tape) (hread : t.read ≠ Γ.start) (d : Dir3) : + t.writeAndMove (readBackWrite t.read) d = t.move d := by + show (t.write _).move d = t.move d + rw [write_readBack t hread] + +/-- The "do nothing" transition output: all writes are `□`, all directions + are `idleDir`. Used for states that only change the control state. -/ +def allIdle {σ : Type} {k : ℕ} + (newState : σ) (iHead : Γ) (wHeads : Fin k → Γ) (oHead : Γ) : + σ × (Fin k → Γw) × Γw × Dir3 × (Fin k → Dir3) × Dir3 := + (newState, fun _ => .blank, .blank, idleDir iHead, fun i => idleDir (wHeads i), idleDir oHead) + +/-- The content-preserving driver action: write every currently read work and +output symbol back, and use `idleDir` on every tape. Every off-start tape is +preserved exactly; a head on `▷` takes the structurally mandatory move right. -/ +def allReadBack {σ : Type} {k : ℕ} + (newState : σ) (iHead : Γ) (wHeads : Fin k → Γ) (oHead : Γ) : + σ × (Fin k → Γw) × Γw × Dir3 × (Fin k → Dir3) × Dir3 := + (newState, fun i => readBackWrite (wHeads i), readBackWrite oHead, + idleDir iHead, fun i => idleDir (wHeads i), idleDir oHead) + +/-- Proof that all-idle directions satisfy `δ_right_of_start`. -/ +theorem rightOfStart_allIdle (iHead : Γ) (wHeads : Fin k → Γ) (oHead : Γ) : + (iHead = Γ.start → idleDir iHead = Dir3.right) ∧ + (∀ i, wHeads i = Γ.start → idleDir (wHeads i) = Dir3.right) ∧ + (oHead = Γ.start → idleDir oHead = Dir3.right) := + ⟨idleDir_right_of_start, fun _ => idleDir_right_of_start, idleDir_right_of_start⟩ + +/-- `allReadBack` satisfies the one-sided-tape direction invariant. -/ +theorem rightOfStart_allReadBack (iHead : Γ) (wHeads : Fin k → Γ) (oHead : Γ) : + (iHead = Γ.start → idleDir iHead = Dir3.right) ∧ + (∀ i, wHeads i = Γ.start → idleDir (wHeads i) = Dir3.right) ∧ + (oHead = Γ.start → idleDir oHead = Dir3.right) := + ⟨idleDir_right_of_start, fun _ => idleDir_right_of_start, idleDir_right_of_start⟩ + + +end TM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryShiftMul/Internal/Sem.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryShiftMul/Internal/Sem.lean index 9441af0f98..bbc5fd957c 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryShiftMul/Internal/Sem.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryShiftMul/Internal/Sem.lean @@ -242,6 +242,19 @@ private def binaryShiftMulDoublePost {n : ℕ} (abi : BinaryShiftMulABI n) work i = work₀ i) ∧ out = out₀ +/-- Replacing one work tape by a natural-number encoding preserves parking of every tape. -/ +private theorem binaryShiftMulUpdate_parked {n : ℕ} + (work : Fin n → Tape) (index : Fin n) (value : ℕ) + (hwork : ∀ i, Parked (work i)) : + ∀ i, Parked (Function.update work index (binaryShiftMulNatTape value) i) := by + intro i + by_cases hi : i = index + · subst i + simp only [Function.update_self] + exact hasBinaryNat_parked (binaryShiftMulNatTape_hasBinaryNat value) + simp only [Function.update_of_ne hi] + exact hwork i + private theorem binaryShiftMulDoubleTM_hoareTime_frame {n : ℕ} (abi : BinaryShiftMulABI n) (shift : ℕ) (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) @@ -264,14 +277,8 @@ private theorem binaryShiftMulDoubleTM_hoareTime_frame {n : ℕ} (fun inp work out => inp = inp₀ ∧ work = work₁ ∧ out = out₀) (binaryCopyTime shift 0) := by simpa only [work₁, binaryShiftMulNatTape] using hcopy₁ - have hwork₁ : ∀ i, Parked (work₁ i) := by - intro i - by_cases hi : i = abi.tmp - · subst i - simp only [work₁, Function.update_self] - exact hasBinaryNat_parked (binaryShiftMulNatTape_hasBinaryNat shift) - simp only [work₁, Function.update_of_ne hi] - exact hwork i + have hwork₁ : ∀ i, Parked (work₁ i) := + binaryShiftMulUpdate_parked work₀ abi.tmp shift hwork have hshift₁ : (work₁ abi.shift).HasBinaryNat shift := by simpa only [work₁, Function.update_of_ne abi.shift_ne_tmp] using hshift have htmp₁ : (work₁ abi.tmp).HasBinaryNat shift := by @@ -331,14 +338,8 @@ private theorem binaryShiftMulDoubleTM_hoareTime_frame {n : ℕ} (resetBinaryWorkTime 1 shift.size) := by simpa only [work₂, binaryShiftMulNatTape, Nat.size_eq_bits_len] using! hresetTmp - have hwork₂ : ∀ i, Parked (work₂ i) := by - intro i - by_cases hi : i = abi.tmp - · subst i - simp only [work₂, Function.update_self] - exact hasBinaryNat_parked (binaryShiftMulNatTape_hasBinaryNat 0) - simp only [work₂, Function.update_of_ne hi] - exact hworkNow i + have hwork₂ : ∀ i, Parked (work₂ i) := + binaryShiftMulUpdate_parked work abi.tmp 0 hworkNow have hdbl₂ : (work₂ abi.dbl).HasBinaryNat (shift + shift) := by simpa only [work₂, Function.update_of_ne abi.tmp_ne_dbl.symm] using hdblNow @@ -360,15 +361,8 @@ private theorem binaryShiftMulDoubleTM_hoareTime_frame {n : ℕ} (fun inp' work' out' => inp' = inp ∧ work' = work₃ ∧ out' = out) (binaryCopyTime (shift + shift) shift) := by simpa only [work₃, binaryShiftMulNatTape] using hcopy₂ - have hwork₃ : ∀ i, Parked (work₃ i) := by - intro i - by_cases hi : i = abi.shift - · subst i - simp only [work₃, Function.update_self] - exact hasBinaryNat_parked - (binaryShiftMulNatTape_hasBinaryNat (shift + shift)) - simp only [work₃, Function.update_of_ne hi] - exact hwork₂ i + have hwork₃ : ∀ i, Parked (work₃ i) := + binaryShiftMulUpdate_parked work₂ abi.shift (shift + shift) hwork₂ have hdbl₃ : (work₃ abi.dbl).HasBinaryNat (shift + shift) := by simpa only [work₃, Function.update_of_ne abi.shift_ne_dbl.symm] using hdbl₂ @@ -1017,6 +1011,75 @@ private def binaryShiftMulLoopPost {n : ℕ} (abi : BinaryShiftMulABI n) i ≠ abi.shift → i ≠ abi.tmp → i ≠ abi.dbl → work i = work₀ i) ∧ out = out₀ +/-- The completed bit loop has the full multiplication result and preserves its outside frame. -/ +private theorem binaryShiftMulDoneCfg_post {n : ℕ} + (abi : BinaryShiftMulABI n) (lhs rhs : ℕ) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hlhs : (work₀ abi.lhs).HasBinaryNat lhs) + (hrhs : (work₀ abi.rhs).HasBinaryNat rhs) : + binaryShiftMulLoopPost abi lhs rhs inp₀ work₀ out₀ + (binaryShiftMulDoneCfg abi lhs rhs inp₀ work₀ out₀).input + (binaryShiftMulDoneCfg abi lhs rhs inp₀ work₀ out₀).work + (binaryShiftMulDoneCfg abi lhs rhs inp₀ work₀ out₀).output := by + let doneWork := binaryShiftMulPartialWork abi work₀ lhs rhs rhs.size + let doneCfg := binaryShiftMulDoneCfg abi lhs rhs inp₀ work₀ out₀ + refine ⟨rfl, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_, rfl⟩ + · rw [show doneCfg.work = doneWork by rfl] + dsimp only [doneWork] + rw [binaryShiftMulPartialWork, + binaryShiftMulLoopWork_other abi work₀ rhs.size + (BinaryShiftMul.partialAcc lhs rhs rhs.size) + (BinaryShiftMul.partialShift lhs rhs.size) abi.lhs + abi.lhs_ne_rhs abi.lhs_ne_acc abi.lhs_ne_shift abi.lhs_ne_tmp + abi.lhs_ne_dbl] + exact hlhs + · rw [show doneCfg.work = doneWork by rfl] + dsimp only [doneWork] + rw [binaryShiftMulPartialWork, + binaryShiftMulLoopWork_rhs] + simpa [binaryShiftMulCursorTape, Tape.HasBinaryContent] using + hrhs.2.hasBinaryContent + · rw [show doneCfg.work = doneWork by rfl] + dsimp only [doneWork] + rw [binaryShiftMulPartialWork, + binaryShiftMulLoopWork_rhs] + simpa [binaryShiftMulCursorTape] using hrhs.1 + · rw [show doneCfg.work = doneWork by rfl] + dsimp only [doneWork] + rw [binaryShiftMulPartialWork, + binaryShiftMulLoopWork_rhs] + simp [binaryShiftMulCursorTape] + · rw [show doneCfg.work = doneWork by rfl] + dsimp only [doneWork] + rw [binaryShiftMulPartialWork, + binaryShiftMulLoopWork_acc, + BinaryShiftMul.partialAcc_full_internal] + exact binaryShiftMulNatTape_hasBinaryNat (lhs * rhs) + · rw [show doneCfg.work = doneWork by rfl] + dsimp only [doneWork] + rw [binaryShiftMulPartialWork, + binaryShiftMulLoopWork_shift, + BinaryShiftMul.partialShift_full_internal] + exact binaryShiftMulNatTape_hasBinaryNat (lhs * 2 ^ rhs.size) + · rw [show doneCfg.work = doneWork by rfl] + dsimp only [doneWork] + rw [binaryShiftMulPartialWork, + binaryShiftMulLoopWork_tmp] + exact binaryShiftMulNatTape_hasBinaryNat 0 + · rw [show doneCfg.work = doneWork by rfl] + dsimp only [doneWork] + rw [binaryShiftMulPartialWork, + binaryShiftMulLoopWork_dbl] + exact binaryShiftMulNatTape_hasBinaryNat 0 + · intro i hlhsIdx hrhsIdx haccIdx hshiftIdx htmpIdx hdblIdx + rw [show doneCfg.work = doneWork by rfl] + dsimp only [doneWork] + rw [binaryShiftMulPartialWork, + binaryShiftMulLoopWork_other abi work₀ rhs.size + (BinaryShiftMul.partialAcc lhs rhs rhs.size) + (BinaryShiftMul.partialShift lhs rhs.size) i hrhsIdx haccIdx + hshiftIdx htmpIdx hdblIdx] + private theorem binaryShiftMulLoopTM_hoareTime_frame {n : ℕ} (abi : BinaryShiftMulABI n) (lhs rhs : ℕ) (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) @@ -1167,62 +1230,7 @@ private theorem binaryShiftMulLoopTM_hoareTime_frame {n : ℕ} hinitialWork, doneCfg, body] using! hloop refine ⟨doneCfg, forBinaryWorkLoopTime bodyTime 0 rhs.size, (by simpa [binaryShiftMulLoopBound] using hloopTime), hreach, rfl, ?_⟩ - refine ⟨rfl, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_, rfl⟩ - · rw [show doneCfg.work = doneWork by rfl] - dsimp only [doneWork] - rw [binaryShiftMulPartialWork, - binaryShiftMulLoopWork_other abi work₀ rhs.size - (BinaryShiftMul.partialAcc lhs rhs rhs.size) - (BinaryShiftMul.partialShift lhs rhs.size) abi.lhs - abi.lhs_ne_rhs abi.lhs_ne_acc abi.lhs_ne_shift abi.lhs_ne_tmp - abi.lhs_ne_dbl] - exact hlhs - · rw [show doneCfg.work = doneWork by rfl] - dsimp only [doneWork] - rw [binaryShiftMulPartialWork, - binaryShiftMulLoopWork_rhs] - simpa [binaryShiftMulCursorTape, Tape.HasBinaryContent] using - hrhs.2.hasBinaryContent - · rw [show doneCfg.work = doneWork by rfl] - dsimp only [doneWork] - rw [binaryShiftMulPartialWork, - binaryShiftMulLoopWork_rhs] - simpa [binaryShiftMulCursorTape] using hrhs.1 - · rw [show doneCfg.work = doneWork by rfl] - dsimp only [doneWork] - rw [binaryShiftMulPartialWork, - binaryShiftMulLoopWork_rhs] - simp [binaryShiftMulCursorTape] - · rw [show doneCfg.work = doneWork by rfl] - dsimp only [doneWork] - rw [binaryShiftMulPartialWork, - binaryShiftMulLoopWork_acc, - BinaryShiftMul.partialAcc_full_internal] - exact binaryShiftMulNatTape_hasBinaryNat (lhs * rhs) - · rw [show doneCfg.work = doneWork by rfl] - dsimp only [doneWork] - rw [binaryShiftMulPartialWork, - binaryShiftMulLoopWork_shift, - BinaryShiftMul.partialShift_full_internal] - exact binaryShiftMulNatTape_hasBinaryNat (lhs * 2 ^ rhs.size) - · rw [show doneCfg.work = doneWork by rfl] - dsimp only [doneWork] - rw [binaryShiftMulPartialWork, - binaryShiftMulLoopWork_tmp] - exact binaryShiftMulNatTape_hasBinaryNat 0 - · rw [show doneCfg.work = doneWork by rfl] - dsimp only [doneWork] - rw [binaryShiftMulPartialWork, - binaryShiftMulLoopWork_dbl] - exact binaryShiftMulNatTape_hasBinaryNat 0 - · intro i hlhsIdx hrhsIdx haccIdx hshiftIdx htmpIdx hdblIdx - rw [show doneCfg.work = doneWork by rfl] - dsimp only [doneWork] - rw [binaryShiftMulPartialWork, - binaryShiftMulLoopWork_other abi work₀ rhs.size - (BinaryShiftMul.partialAcc lhs rhs rhs.size) - (BinaryShiftMul.partialShift lhs rhs.size) i hrhsIdx haccIdx - hshiftIdx htmpIdx hdblIdx] + exact binaryShiftMulDoneCfg_post abi lhs rhs inp₀ work₀ out₀ hlhs hrhs private def binaryShiftMulCleanupBits {n : ℕ} (abi : BinaryShiftMulABI n) (lhs rhs : ℕ) (i : Fin n) : List Bool := From e9be7ee4c86d5c933a897cbc6d2e721f0de4836c Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Fri, 25 Sep 2026 20:52:58 +0000 Subject: [PATCH 33/49] Separate tape-layout APIs and preserve entry-match frame through named invariants --- LeanPool.lean | 3 + LeanPool/BeyondBethe.lean | 3 + .../Machine/EntryMatch/Internal.lean | 236 +++++------ .../Machine/EntryUpdate/Defs.lean | 83 +--- .../Machine/EntryUpdate/Types.lean | 119 ++++++ .../Machine/Instruction/Defs.lean | 364 +--------------- .../Machine/Instruction/Tapes.lean | 400 ++++++++++++++++++ .../RegisterStore/Machine/Lookup/Defs.lean | 355 +--------------- .../Machine/Lookup/ResetLayout.lean | 393 +++++++++++++++++ 9 files changed, 1031 insertions(+), 925 deletions(-) create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Types.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Tapes.lean create mode 100644 LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/ResetLayout.lean diff --git a/LeanPool.lean b/LeanPool.lean index 68d7717f17..9b9cbe6eec 100644 --- a/LeanPool.lean +++ b/LeanPool.lean @@ -626,6 +626,7 @@ public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simu public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.BoundsInternal public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Types public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Ctrl public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.End @@ -645,6 +646,7 @@ public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simu public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Control public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Tapes public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Dense public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.DenseControl public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.DenseCtrlSim @@ -670,6 +672,7 @@ public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simu public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Store public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.ResetLayout public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.DenseInternal public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Internal public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Internal.Assemble diff --git a/LeanPool/BeyondBethe.lean b/LeanPool/BeyondBethe.lean index 23720f4812..4db1c91cb0 100644 --- a/LeanPool/BeyondBethe.lean +++ b/LeanPool/BeyondBethe.lean @@ -392,6 +392,7 @@ public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simu public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.BoundsInternal public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Types public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Ctrl public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.End public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Hit @@ -410,6 +411,7 @@ public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simu public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Control public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Tapes public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Dense public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.DenseControl public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.DenseCtrlSim @@ -433,6 +435,7 @@ public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simu public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Sim.Internal public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Store public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.ResetLayout public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.DenseInternal public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Internal.Assemble public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Internal.Bounds diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryMatch/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryMatch/Internal.lean index b3a95fe74e..347db56d2a 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryMatch/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryMatch/Internal.lean @@ -39,6 +39,97 @@ private theorem parked_of_hasBinaryNat {t : Tape} {value : ℕ} (h : t.HasBinaryNat value) : TM.Parked t := ⟨by rw [h.2.1], h.2.hasBinaryContent.cells_ne_start⟩ +/-- Decoding leaves every tape parked: its five modified roles have binary encodings. -/ +private theorem entryDecode_work_parked {n : ℕ} + (tapes : EntryMatchTapes n) (entry : Entry) (rest : List Bool) + (initial work : Fin n → Tape) + (hsource : (work tapes.source).HasBinarySuffix rest) + (haddress : (work tapes.address).HasBinaryPrefix entry.1.bits) + (hvalue : (work tapes.value).HasBinaryPrefix entry.2.bits) + (haddressCounter : (work tapes.addressCounter).HasBinaryPrefix + (List.replicate (bitlen entry.1) true)) + (hvalueCounter : (work tapes.valueCounter).HasBinaryPrefix + (List.replicate (bitlen entry.2) true)) + (hframe : ∀ i, i ≠ tapes.source → i ≠ tapes.address → i ≠ tapes.value → + i ≠ tapes.addressCounter → i ≠ tapes.valueCounter → work i = initial i) + (hinitial : ∀ i, TM.Parked (initial i)) : ∀ i, TM.Parked (work i) := by + intro i + by_cases his : i = tapes.source + · subst i + exact parked_of_hasBinarySuffix hsource + by_cases hia : i = tapes.address + · subst i + exact parked_of_hasBinaryPrefix haddress + by_cases hiv : i = tapes.value + · subst i + exact parked_of_hasBinaryPrefix hvalue + by_cases hiac : i = tapes.addressCounter + · subst i + exact parked_of_hasBinaryPrefix haddressCounter + by_cases hivc : i = tapes.valueCounter + · subst i + exact parked_of_hasBinaryPrefix hvalueCounter + rw [hframe i his hia hiv hiac hivc] + exact hinitial i + +/-- Comparing two binary tapes preserves parking of them, its result, and the outside frame. -/ +private theorem binaryComparison_work_parked {n : ℕ} + (address query result : Fin n) (addressBits queryBits resultBits : List Bool) + (initial work : Fin n → Tape) + (haddress : (work address).HasBinaryContent addressBits) + (haddressHead : 1 ≤ (work address).head) + (hquery : (work query).HasBinaryContent queryBits) + (hqueryHead : 1 ≤ (work query).head) + (hresult : (work result).HasBinaryPrefix resultBits) + (hframe : ∀ i, i ≠ address → i ≠ query → i ≠ result → work i = initial i) + (hinitial : ∀ i, TM.Parked (initial i)) : ∀ i, TM.Parked (work i) := by + intro i + by_cases hia : i = address + · subst i + exact ⟨haddressHead, haddress.cells_ne_start⟩ + by_cases hiq : i = query + · subst i + exact ⟨hqueryHead, hquery.cells_ne_start⟩ + by_cases hir : i = result + · subst i + exact parked_of_hasBinaryPrefix hresult + rw [hframe i hia hiq hir] + exact hinitial i + +/-- Linear entry decoding preserves both width tapes, the query tape, and the result tape. -/ +private theorem entryDecode_preserved_roles {n : ℕ} (tapes : EntryMatchTapes n) + (initial work : Fin n → Tape) + (hframe : ∀ i, i ≠ tapes.source → i ≠ tapes.address → i ≠ tapes.value → + i ≠ tapes.addressCounter → i ≠ tapes.valueCounter → work i = initial i) : + work tapes.addressWidth = initial tapes.addressWidth ∧ + work tapes.valueWidth = initial tapes.valueWidth ∧ + work tapes.query = initial tapes.query ∧ work tapes.result = initial tapes.result := by + refine ⟨?_, ?_, ?_, ?_⟩ + · exact hframe tapes.addressWidth + (by simpa using! tapes.ne (show (4 : Fin 9) ≠ 0 by decide)) + (by simpa using! tapes.ne (show (4 : Fin 9) ≠ 1 by decide)) + (by simpa using! tapes.ne (show (4 : Fin 9) ≠ 2 by decide)) + (by simpa using! tapes.ne (show (4 : Fin 9) ≠ 3 by decide)) + (by simpa using! tapes.ne (show (4 : Fin 9) ≠ 5 by decide)) + · exact hframe tapes.valueWidth + (by simpa using! tapes.ne (show (6 : Fin 9) ≠ 0 by decide)) + (by simpa using! tapes.ne (show (6 : Fin 9) ≠ 1 by decide)) + (by simpa using! tapes.ne (show (6 : Fin 9) ≠ 2 by decide)) + (by simpa using! tapes.ne (show (6 : Fin 9) ≠ 3 by decide)) + (by simpa using! tapes.ne (show (6 : Fin 9) ≠ 5 by decide)) + · exact hframe tapes.query + (by simpa using! tapes.ne (show (7 : Fin 9) ≠ 0 by decide)) + (by simpa using! tapes.ne (show (7 : Fin 9) ≠ 1 by decide)) + (by simpa using! tapes.ne (show (7 : Fin 9) ≠ 2 by decide)) + (by simpa using! tapes.ne (show (7 : Fin 9) ≠ 3 by decide)) + (by simpa using! tapes.ne (show (7 : Fin 9) ≠ 5 by decide)) + · exact hframe tapes.result + (by simpa using! tapes.ne (show (8 : Fin 9) ≠ 0 by decide)) + (by simpa using! tapes.ne (show (8 : Fin 9) ≠ 1 by decide)) + (by simpa using! tapes.ne (show (8 : Fin 9) ≠ 2 by decide)) + (by simpa using! tapes.ne (show (8 : Fin 9) ≠ 3 by decide)) + (by simpa using! tapes.ne (show (8 : Fin 9) ≠ 5 by decide)) + theorem entryMatchTM_reachesIn_frame_internal {n : ℕ} (tapes : EntryMatchTapes n) (entry : Entry) (rest queryBits : List Bool) (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) @@ -111,80 +202,29 @@ theorem entryMatchTM_reachesIn_frame_internal {n : ℕ} hvalueCounter.2) hvalueCounter.1 hinput.read_ne_start (fun i => (hwork i).read_ne_start) houtput.read_ne_start + obtain ⟨hpreservedAddressWidth, hpreservedValueWidth, hpreservedQuery, hpreservedResult⟩ := + entryDecode_preserved_roles tapes work₀ decodeDone.work (by simpa using! hdecodeFrame) have hdecodeAddressWidth : (decodeDone.work tapes.addressWidth).HasBinaryNat 0 := by - rw [hdecodeFrame tapes.addressWidth - (by simpa using! tapes.ne (show (4 : Fin 9) ≠ 0 by decide)) - (by simpa using! tapes.ne (show (4 : Fin 9) ≠ 1 by decide)) - (by simpa using! tapes.ne (show (4 : Fin 9) ≠ 2 by decide)) - (by simpa using! tapes.ne (show (4 : Fin 9) ≠ 3 by decide)) - (by simpa using! tapes.ne (show (4 : Fin 9) ≠ 5 by decide))] + rw [hpreservedAddressWidth] exact haddressWidth have hdecodeValueWidth : (decodeDone.work tapes.valueWidth).HasBinaryNat 0 := by - rw [hdecodeFrame tapes.valueWidth - (by simpa using! tapes.ne (show (6 : Fin 9) ≠ 0 by decide)) - (by simpa using! tapes.ne (show (6 : Fin 9) ≠ 1 by decide)) - (by simpa using! tapes.ne (show (6 : Fin 9) ≠ 2 by decide)) - (by simpa using! tapes.ne (show (6 : Fin 9) ≠ 3 by decide)) - (by simpa using! tapes.ne (show (6 : Fin 9) ≠ 5 by decide))] + rw [hpreservedValueWidth] exact hvalueWidth have hdecodeQuery : (decodeDone.work tapes.query).HasBinaryString queryBits := by - rw [hdecodeFrame tapes.query - (by simpa using! tapes.ne (show (7 : Fin 9) ≠ 0 by decide)) - (by simpa using! tapes.ne (show (7 : Fin 9) ≠ 1 by decide)) - (by simpa using! tapes.ne (show (7 : Fin 9) ≠ 2 by decide)) - (by simpa using! tapes.ne (show (7 : Fin 9) ≠ 3 by decide)) - (by simpa using! tapes.ne (show (7 : Fin 9) ≠ 5 by decide))] + rw [hpreservedQuery] exact hquery have hdecodeResult : (decodeDone.work tapes.result).HasBinaryPrefix [] := by - rw [hdecodeFrame tapes.result - (by simpa using! tapes.ne (show (8 : Fin 9) ≠ 0 by decide)) - (by simpa using! tapes.ne (show (8 : Fin 9) ≠ 1 by decide)) - (by simpa using! tapes.ne (show (8 : Fin 9) ≠ 2 by decide)) - (by simpa using! tapes.ne (show (8 : Fin 9) ≠ 3 by decide)) - (by simpa using! tapes.ne (show (8 : Fin 9) ≠ 5 by decide))] + rw [hpreservedResult] exact hresult - have hdecodeParked : ∀ i, TM.Parked (decodeDone.work i) := by - intro i - by_cases his : i = tapes.source - · subst i - exact parked_of_hasBinarySuffix (by simpa using! hdecodeSource) - · by_cases hia : i = tapes.address - · subst i - exact parked_of_hasBinaryPrefix (by simpa using! hdecodeAddress) - · by_cases hiv : i = tapes.value - · subst i - exact parked_of_hasBinaryPrefix (by simpa using! hdecodeValue) - · by_cases hiac : i = tapes.addressCounter - · subst i - exact parked_of_hasBinaryPrefix - (by simpa using! hdecodeAddressCounter) - · by_cases hiaw : i = tapes.addressWidth - · subst i - exact parked_of_hasBinaryNat - (by simpa using! hdecodeAddressWidth) - · by_cases hivc : i = tapes.valueCounter - · subst i - exact parked_of_hasBinaryPrefix - (by simpa using! hdecodeValueCounter) - · by_cases hivw : i = tapes.valueWidth - · subst i - exact parked_of_hasBinaryNat - (by simpa using! hdecodeValueWidth) - · by_cases hiq : i = tapes.query - · subst i - exact ⟨by rw [hdecodeQuery.1], - hdecodeQuery.hasBinaryContent.cells_ne_start⟩ - · by_cases hir : i = tapes.result - · subst i - exact parked_of_hasBinaryPrefix hdecodeResult - · rw [hdecodeFrame i (by simpa using! his) - (by simpa using! hia) (by simpa using! hiv) - (by simpa using! hiac) (by simpa using! hivc)] - exact hwork i + have hdecodeParked : ∀ i, TM.Parked (decodeDone.work i) := + entryDecode_work_parked tapes entry rest work₀ decodeDone.work + (by simpa using! hdecodeSource) (by simpa using! hdecodeAddress) + (by simpa using! hdecodeValue) (by simpa using! hdecodeAddressCounter) + (by simpa using! hdecodeValueCounter) (by simpa using! hdecodeFrame) hwork have hdecodeQueryStart : (decodeDone.work tapes.query).cells 0 = Γ.start := TM.work_cells_zero_eq_start_of_reachesIn tapes.query hdecodeReach @@ -236,73 +276,11 @@ theorem entryMatchTM_reachesIn_frame_internal {n : ℕ} TM.work_cells_zero_eq_start_of_reachesIn (tm := TM.seqTM decodeTM compareTM) tapes.valueCounter hfullReach hvalueCounter.1 - have hfinalParked : ∀ i, TM.Parked (finalCfg.work i) := by - intro i - change TM.Parked (compareDone.work i) - by_cases his : i = tapes.source - · subst i - apply parked_of_hasBinarySuffix - rw [hcompareFrame tapes.source - (by simpa using! tapes.ne (show (0 : Fin 9) ≠ 1 by decide)) - (by simpa using! tapes.ne (show (0 : Fin 9) ≠ 7 by decide)) - (by simpa using! tapes.ne (show (0 : Fin 9) ≠ 8 by decide))] - simpa using! hdecodeSource - · by_cases hia : i = tapes.address - · subst i - exact ⟨hcompareAddressHead, - hcompareAddress.cells_ne_start⟩ - · by_cases hiv : i = tapes.value - · subst i - apply parked_of_hasBinaryPrefix - rw [hcompareFrame tapes.value - (by simpa using! tapes.ne (show (2 : Fin 9) ≠ 1 by decide)) - (by simpa using! tapes.ne (show (2 : Fin 9) ≠ 7 by decide)) - (by simpa using! tapes.ne (show (2 : Fin 9) ≠ 8 by decide))] - simpa using! hdecodeValue - · by_cases hiac : i = tapes.addressCounter - · subst i - apply parked_of_hasBinaryPrefix - rw [hcompareFrame tapes.addressCounter - (by simpa using! tapes.ne (show (3 : Fin 9) ≠ 1 by decide)) - (by simpa using! tapes.ne (show (3 : Fin 9) ≠ 7 by decide)) - (by simpa using! tapes.ne (show (3 : Fin 9) ≠ 8 by decide))] - simpa using! hdecodeAddressCounter - · by_cases hiaw : i = tapes.addressWidth - · subst i - apply parked_of_hasBinaryNat - rw [hcompareFrame tapes.addressWidth - (by simpa using! tapes.ne (show (4 : Fin 9) ≠ 1 by decide)) - (by simpa using! tapes.ne (show (4 : Fin 9) ≠ 7 by decide)) - (by simpa using! tapes.ne (show (4 : Fin 9) ≠ 8 by decide))] - simpa using! hdecodeAddressWidth - · by_cases hivc : i = tapes.valueCounter - · subst i - apply parked_of_hasBinaryPrefix - rw [hcompareFrame tapes.valueCounter - (by simpa using! tapes.ne (show (5 : Fin 9) ≠ 1 by decide)) - (by simpa using! tapes.ne (show (5 : Fin 9) ≠ 7 by decide)) - (by simpa using! tapes.ne (show (5 : Fin 9) ≠ 8 by decide))] - simpa using! hdecodeValueCounter - · by_cases hivw : i = tapes.valueWidth - · subst i - apply parked_of_hasBinaryNat - rw [hcompareFrame tapes.valueWidth - (by simpa using! tapes.ne (show (6 : Fin 9) ≠ 1 by decide)) - (by simpa using! tapes.ne (show (6 : Fin 9) ≠ 7 by decide)) - (by simpa using! tapes.ne (show (6 : Fin 9) ≠ 8 by decide))] - simpa using! hdecodeValueWidth - · by_cases hiq : i = tapes.query - · subst i - exact ⟨hcompareQueryHead, - hcompareQuery.cells_ne_start⟩ - · by_cases hir : i = tapes.result - · subst i - exact parked_of_hasBinaryPrefix hcompareResult - · rw [hcompareFrame i hia hiq hir, - hdecodeFrame i (by simpa using! his) - (by simpa using! hia) (by simpa using! hiv) - (by simpa using! hiac) (by simpa using! hivc)] - exact hwork i + have hfinalParked : ∀ i, TM.Parked (finalCfg.work i) := + binaryComparison_work_parked tapes.address tapes.query tapes.result + entry.1.bits queryBits [decide (entry.1.bits = queryBits)] + decodeDone.work compareDone.work hcompareAddress hcompareAddressHead + hcompareQuery hcompareQueryHead hcompareResult hcompareFrame hdecodeParked refine ⟨finalCfg, entryDecodeLinearTime entry.1 entry.2 + 1 + compareTime, ?_, ?_, ?_, hcompareInput.trans hdecodeInput, ?_, hcompareAddress, hcompareAddressHead, hcompareAddressStart, ?_, ?_, ?_, diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Defs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Defs.lean index 3916a7451a..249bb1e6bc 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Defs.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Defs.lean @@ -11,6 +11,8 @@ public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryMissCopy.Defs public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryPred.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Types + /-! # Bounded encoded sparse-store update — controller definitions @@ -31,87 +33,6 @@ namespace RegisterStore namespace Machine -/-- Thirteen pairwise-distinct tapes used by encoded sparse-store update. -/ -structure EntryUpdateTapes (n : ℕ) where - /-- Assignment order: nine entry-match tapes, remaining count, replacement - value, found flag, and output count. -/ - idx : Fin 13 → Fin n - /-- The complete assignment is injective. -/ - injective : Function.Injective idx - -namespace EntryUpdateTapes - -/-- The nine-tape decode-and-match assignment. -/ -def entry {n : ℕ} (tapes : EntryUpdateTapes n) : EntryMatchTapes n where - idx := fun i => tapes.idx ⟨i, by omega⟩ - injective := by - intro i j hij - have h : (⟨i, by omega⟩ : Fin 13) = ⟨j, by omega⟩ := - tapes.injective hij - apply Fin.ext - exact congrArg (fun k : Fin 13 => k.val) h - -/-- Runtime number of old entries still unread. -/ -def remaining {n : ℕ} (tapes : EntryUpdateTapes n) : Fin n := tapes.idx 9 - -/-- Canonical source containing the requested new value. -/ -def replacement {n : ℕ} (tapes : EntryUpdateTapes n) : Fin n := tapes.idx 10 - -/-- One-bit flag recording whether a matching old address has been seen. -/ -def found {n : ℕ} (tapes : EntryUpdateTapes n) : Fin n := tapes.idx 11 - -/-- Canonical count of entries emitted by the completed update. -/ -def resultCount {n : ℕ} (tapes : EntryUpdateTapes n) : Fin n := tapes.idx 12 - -/-- Distinct indices in the thirteen-tape assignment remain distinct. -/ -theorem ne {n : ℕ} (tapes : EntryUpdateTapes n) {i j : Fin 13} (h : i ≠ j) : - tapes.idx i ≠ tapes.idx j := - fun hij => h (tapes.injective hij) - -/-- Replacement-emission view of the update assignment. -/ -def replace {n : ℕ} (tapes : EntryUpdateTapes n) : EntryReplaceTapes n where - entry := tapes.entry - replacement := tapes.replacement - replacement_ne := by - intro i h - change tapes.idx 10 = tapes.idx ⟨i.val, by omega⟩ at h - have h' : (10 : Fin 13) = ⟨i.val, by omega⟩ := tapes.injective h - have hv : (10 : ℕ) = i.val := - congrArg (fun k : Fin 13 => k.val) h' - omega - -@[simp] theorem replace_entry {n : ℕ} (tapes : EntryUpdateTapes n) : - tapes.replace.entry = tapes.entry := rfl - -@[simp] theorem replace_replacement {n : ℕ} (tapes : EntryUpdateTapes n) : - tapes.replace.replacement = tapes.replacement := rfl - -end EntryUpdateTapes - -/-- Exact preservation predicate outside the thirteen tapes owned by update. -/ -def EntryUpdateFrame {n : ℕ} (tapes : EntryUpdateTapes n) - (initialWork finalWork : Fin n → Tape) : Prop := - ∀ i, (∀ slot, i ≠ tapes.idx slot) → finalWork i = initialWork i - -/-- Auditable final work-tape contract for one encoded sparse-store update. -/ -structure EntryUpdateOutcome {n : ℕ} (tapes : EntryUpdateTapes n) - (store : Store) (address newValue : ℕ) - (initialWork finalWork : Fin n → Tape) : Prop where - /-- The encoded old store has been consumed and all entry scratch is reset. -/ - ready : EntryScanReady tapes.entry [] address.bits finalWork finalWork - /-- The external replacement source is restored literally. -/ - replacement : finalWork tapes.replacement = initialWork tapes.replacement - /-- The runtime old-entry counter is exhausted. -/ - remaining : (finalWork tapes.remaining).HasBinaryNat 0 - /-- The flag records whether the old store contained the updated address. -/ - found : (finalWork tapes.found).HasBinaryNat - (if address ∈ store.map Prod.fst then 1 else 0) - /-- The result counter is the exact cardinality of the pure sparse write. -/ - resultCount : (finalWork tapes.resultCount).HasBinaryNat - (RegisterStore.write store address newValue).length - /-- Every work tape outside the fixed assignment is unchanged. -/ - frame : EntryUpdateFrame tapes initialWork finalWork - /-- Canonical head profile after an old decoded entry has been emitted. -/ def entryUpdatePostEmitHead {n : ℕ} (tapes : EntryUpdateTapes n) (entry : Entry) (i : Fin n) : ℕ := diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Types.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Types.lean new file mode 100644 index 0000000000..b001a2693e --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Types.lean @@ -0,0 +1,119 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryAppend.Defs +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryMissCopy.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryPred.Defs + +/-! +# Tape assignment and endpoint contracts for sparse-store updates + +The thirteen distinct tape roles, their replacement view, and the complete final +frame and scanner contract used by the update controller. +-/ + +@[expose] public section + +namespace Complexity + +namespace RAM + +namespace RegisterStore + +namespace Machine + +/-- Thirteen pairwise-distinct tapes used by encoded sparse-store update. -/ +structure EntryUpdateTapes (n : ℕ) where + /-- Assignment order: nine entry-match tapes, remaining count, replacement + value, found flag, and output count. -/ + idx : Fin 13 → Fin n + /-- The complete assignment is injective. -/ + injective : Function.Injective idx + +namespace EntryUpdateTapes + +/-- The nine-tape decode-and-match assignment. -/ +def entry {n : ℕ} (tapes : EntryUpdateTapes n) : EntryMatchTapes n where + idx := fun i => tapes.idx ⟨i, by omega⟩ + injective := by + intro i j hij + have h : (⟨i, by omega⟩ : Fin 13) = ⟨j, by omega⟩ := + tapes.injective hij + apply Fin.ext + exact congrArg (fun k : Fin 13 => k.val) h + +/-- Runtime number of old entries still unread. -/ +def remaining {n : ℕ} (tapes : EntryUpdateTapes n) : Fin n := tapes.idx 9 + +/-- Canonical source containing the requested new value. -/ +def replacement {n : ℕ} (tapes : EntryUpdateTapes n) : Fin n := tapes.idx 10 + +/-- One-bit flag recording whether a matching old address has been seen. -/ +def found {n : ℕ} (tapes : EntryUpdateTapes n) : Fin n := tapes.idx 11 + +/-- Canonical count of entries emitted by the completed update. -/ +def resultCount {n : ℕ} (tapes : EntryUpdateTapes n) : Fin n := tapes.idx 12 + +/-- Distinct indices in the thirteen-tape assignment remain distinct. -/ +theorem ne {n : ℕ} (tapes : EntryUpdateTapes n) {i j : Fin 13} (h : i ≠ j) : + tapes.idx i ≠ tapes.idx j := + fun hij => h (tapes.injective hij) + +/-- Replacement-emission view of the update assignment. -/ +def replace {n : ℕ} (tapes : EntryUpdateTapes n) : EntryReplaceTapes n where + entry := tapes.entry + replacement := tapes.replacement + replacement_ne := by + intro i h + change tapes.idx 10 = tapes.idx ⟨i.val, by omega⟩ at h + have h' : (10 : Fin 13) = ⟨i.val, by omega⟩ := tapes.injective h + have hv : (10 : ℕ) = i.val := + congrArg (fun k : Fin 13 => k.val) h' + omega + +@[simp] theorem replace_entry {n : ℕ} (tapes : EntryUpdateTapes n) : + tapes.replace.entry = tapes.entry := rfl + +@[simp] theorem replace_replacement {n : ℕ} (tapes : EntryUpdateTapes n) : + tapes.replace.replacement = tapes.replacement := rfl + +end EntryUpdateTapes + +/-- Exact preservation predicate outside the thirteen tapes owned by update. -/ +def EntryUpdateFrame {n : ℕ} (tapes : EntryUpdateTapes n) + (initialWork finalWork : Fin n → Tape) : Prop := + ∀ i, (∀ slot, i ≠ tapes.idx slot) → finalWork i = initialWork i + +/-- Auditable final work-tape contract for one encoded sparse-store update. -/ +structure EntryUpdateOutcome {n : ℕ} (tapes : EntryUpdateTapes n) + (store : Store) (address newValue : ℕ) + (initialWork finalWork : Fin n → Tape) : Prop where + /-- The encoded old store has been consumed and all entry scratch is reset. -/ + ready : EntryScanReady tapes.entry [] address.bits finalWork finalWork + /-- The external replacement source is restored literally. -/ + replacement : finalWork tapes.replacement = initialWork tapes.replacement + /-- The runtime old-entry counter is exhausted. -/ + remaining : (finalWork tapes.remaining).HasBinaryNat 0 + /-- The flag records whether the old store contained the updated address. -/ + found : (finalWork tapes.found).HasBinaryNat + (if address ∈ store.map Prod.fst then 1 else 0) + /-- The result counter is the exact cardinality of the pure sparse write. -/ + resultCount : (finalWork tapes.resultCount).HasBinaryNat + (RegisterStore.write store address newValue).length + /-- Every work tape outside the fixed assignment is unchanged. -/ + frame : EntryUpdateFrame tapes initialWork finalWork + + +end Machine + +end RegisterStore + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Defs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Defs.lean index 7c4bb11bdd..a3beae1e5a 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Defs.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Defs.lean @@ -11,6 +11,8 @@ public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simu public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleSub.Defs public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryShiftMul.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Tapes + /-! # Concrete sparse-store arithmetic instruction kernel @@ -32,368 +34,6 @@ namespace RegisterStore namespace Machine -/-- The three arithmetic operations shared by RAM register instructions. -/ -inductive BinaryInstrOp where - | add - | sub - | mul - deriving DecidableEq - -/-- Eighteen pairwise-distinct tapes used by arithmetic followed by sparse -update. Slots `0..12` are the update controller, slots `13` and `14` are the -operands, and slots `15..17` are multiplication scratch. -/ -structure BinaryInstructionTapes (n : ℕ) where - /-- Complete injective physical assignment. -/ - idx : Fin 18 → Fin n - /-- No two semantic roles alias. -/ - injective : Function.Injective idx - -namespace BinaryInstructionTapes - -/-- The thirteen-tape sparse-update view. -/ -def update {n : ℕ} (tapes : BinaryInstructionTapes n) : EntryUpdateTapes n where - idx := fun i => tapes.idx ⟨i, by omega⟩ - injective := by - intro i j h - apply Fin.ext - simpa using congrArg Fin.val (tapes.injective h) - -/-- First looked-up arithmetic operand. -/ -def lhs {n : ℕ} (tapes : BinaryInstructionTapes n) : Fin n := tapes.idx 13 - -/-- Second looked-up arithmetic operand. -/ -def rhs {n : ℕ} (tapes : BinaryInstructionTapes n) : Fin n := tapes.idx 14 - -/-- Multiplication's shifted-multiplicand scratch tape. -/ -def shift {n : ℕ} (tapes : BinaryInstructionTapes n) : Fin n := tapes.idx 15 - -/-- Multiplication's first alternating scratch tape. -/ -def tmp {n : ℕ} (tapes : BinaryInstructionTapes n) : Fin n := tapes.idx 16 - -/-- Multiplication's second alternating scratch tape. -/ -def dbl {n : ℕ} (tapes : BinaryInstructionTapes n) : Fin n := tapes.idx 17 - -/-- Parent-slot inequality gives physical tape inequality. -/ -theorem ne {n : ℕ} (tapes : BinaryInstructionTapes n) - {i j : Fin 18} (hne : i ≠ j) : tapes.idx i ≠ tapes.idx j := - fun heq => hne (tapes.injective heq) - -theorem update_ne_lhs {n : ℕ} (tapes : BinaryInstructionTapes n) - (slot : Fin 13) : tapes.update.idx slot ≠ tapes.lhs := by - apply tapes.ne - intro h - have hval := congrArg Fin.val h - change slot.val = 13 at hval - omega - -theorem update_ne_rhs {n : ℕ} (tapes : BinaryInstructionTapes n) - (slot : Fin 13) : tapes.update.idx slot ≠ tapes.rhs := by - apply tapes.ne - intro h - have hval := congrArg Fin.val h - change slot.val = 14 at hval - omega - -theorem update_ne_shift {n : ℕ} (tapes : BinaryInstructionTapes n) - (slot : Fin 13) : tapes.update.idx slot ≠ tapes.shift := by - apply tapes.ne - intro h - have hval := congrArg Fin.val h - change slot.val = 15 at hval - omega - -theorem update_ne_tmp {n : ℕ} (tapes : BinaryInstructionTapes n) - (slot : Fin 13) : tapes.update.idx slot ≠ tapes.tmp := by - apply tapes.ne - intro h - have hval := congrArg Fin.val h - change slot.val = 16 at hval - omega - -theorem update_ne_dbl {n : ℕ} (tapes : BinaryInstructionTapes n) - (slot : Fin 13) : tapes.update.idx slot ≠ tapes.dbl := by - apply tapes.ne - intro h - have hval := congrArg Fin.val h - change slot.val = 17 at hval - omega - -/-- Parent slots for a reusable lookup whose destination is `lhs`. -/ -def lhsLookupSlot (i : Fin 14) : Fin 18 := - match i.val with - | 0 => 0 - | 1 => 1 - | 2 => 2 - | 3 => 3 - | 4 => 4 - | 5 => 5 - | 6 => 6 - | 7 => 7 - | 8 => 8 - | 9 => 9 - | 10 => 12 - | 11 => 15 - | 12 => 13 - | _ => 11 - -private theorem lhsLookupSlot_injective : Function.Injective lhsLookupSlot := by - intro i j h - fin_cases i <;> fin_cases j <;> simp [lhsLookupSlot] at h ⊢ - -/-- Reusable sparse lookup view targeting the first operand. -/ -def lhsLookup {n : ℕ} (tapes : BinaryInstructionTapes n) : - EntryLookupRestoreTapes n where - idx := fun i => tapes.idx (lhsLookupSlot i) - injective := fun _ _ h => by - exact lhsLookupSlot_injective (tapes.injective h) - -/-- Parent slots for a reusable lookup whose destination is `rhs`. -/ -def rhsLookupSlot (i : Fin 14) : Fin 18 := - match i.val with - | 0 => 0 - | 1 => 1 - | 2 => 2 - | 3 => 3 - | 4 => 4 - | 5 => 5 - | 6 => 6 - | 7 => 7 - | 8 => 8 - | 9 => 9 - | 10 => 12 - | 11 => 15 - | 12 => 14 - | _ => 11 - -private theorem rhsLookupSlot_injective : Function.Injective rhsLookupSlot := by - intro i j h - fin_cases i <;> fin_cases j <;> simp [rhsLookupSlot] at h ⊢ - -/-- Reusable sparse lookup view targeting the second operand. -/ -def rhsLookup {n : ℕ} (tapes : BinaryInstructionTapes n) : - EntryLookupRestoreTapes n where - idx := fun i => tapes.idx (rhsLookupSlot i) - injective := fun _ _ h => by - exact rhsLookupSlot_injective (tapes.injective h) - -@[simp] theorem lhsLookup_count {n : ℕ} (tapes : BinaryInstructionTapes n) : - tapes.lhsLookup.idx 9 = tapes.update.remaining := rfl - -@[simp] theorem rhsLookup_count {n : ℕ} (tapes : BinaryInstructionTapes n) : - tapes.rhsLookup.idx 9 = tapes.update.remaining := rfl - -@[simp] theorem lhsLookup_countSource {n : ℕ} - (tapes : BinaryInstructionTapes n) : - tapes.lhsLookup.countSource = tapes.update.resultCount := rfl - -@[simp] theorem rhsLookup_countSource {n : ℕ} - (tapes : BinaryInstructionTapes n) : - tapes.rhsLookup.countSource = tapes.update.resultCount := rfl - -@[simp] theorem lhsLookup_querySource {n : ℕ} - (tapes : BinaryInstructionTapes n) : - tapes.lhsLookup.querySource = tapes.shift := rfl - -@[simp] theorem rhsLookup_querySource {n : ℕ} - (tapes : BinaryInstructionTapes n) : - tapes.rhsLookup.querySource = tapes.shift := rfl - -@[simp] theorem lhsLookup_destination {n : ℕ} - (tapes : BinaryInstructionTapes n) : - tapes.lhsLookup.destination = tapes.lhs := rfl - -@[simp] theorem rhsLookup_destination {n : ℕ} - (tapes : BinaryInstructionTapes n) : - tapes.rhsLookup.destination = tapes.rhs := rfl - -@[simp] theorem lhsLookup_copyScratch {n : ℕ} - (tapes : BinaryInstructionTapes n) : - tapes.lhsLookup.copyScratch = tapes.update.found := rfl - -@[simp] theorem rhsLookup_copyScratch {n : ℕ} - (tapes : BinaryInstructionTapes n) : - tapes.rhsLookup.copyScratch = tapes.update.found := rfl - -theorem lhsLookup_ne_rhs {n : ℕ} (tapes : BinaryInstructionTapes n) - (slot : Fin 14) : tapes.lhsLookup.idx slot ≠ tapes.rhs := by - apply tapes.ne - fin_cases slot <;> decide - -theorem rhsLookup_ne_lhs {n : ℕ} (tapes : BinaryInstructionTapes n) - (slot : Fin 14) : tapes.rhsLookup.idx slot ≠ tapes.lhs := by - apply tapes.ne - fin_cases slot <;> decide - -theorem lhsLookup_ne_tmp {n : ℕ} (tapes : BinaryInstructionTapes n) - (slot : Fin 14) : tapes.lhsLookup.idx slot ≠ tapes.tmp := by - apply tapes.ne - fin_cases slot <;> decide - -theorem rhsLookup_ne_tmp {n : ℕ} (tapes : BinaryInstructionTapes n) - (slot : Fin 14) : tapes.rhsLookup.idx slot ≠ tapes.tmp := by - apply tapes.ne - fin_cases slot <;> decide - -theorem lhsLookup_ne_dbl {n : ℕ} (tapes : BinaryInstructionTapes n) - (slot : Fin 14) : tapes.lhsLookup.idx slot ≠ tapes.dbl := by - apply tapes.ne - fin_cases slot <;> decide - -theorem rhsLookup_ne_dbl {n : ℕ} (tapes : BinaryInstructionTapes n) - (slot : Fin 14) : tapes.rhsLookup.idx slot ≠ tapes.dbl := by - apply tapes.ne - fin_cases slot <;> decide - -theorem lhsLookup_ne_replacement {n : ℕ} - (tapes : BinaryInstructionTapes n) (slot : Fin 14) : - tapes.lhsLookup.idx slot ≠ tapes.update.replacement := by - apply tapes.ne - fin_cases slot <;> decide - -theorem rhsLookup_ne_replacement {n : ℕ} - (tapes : BinaryInstructionTapes n) (slot : Fin 14) : - tapes.rhsLookup.idx slot ≠ tapes.update.replacement := by - apply tapes.ne - fin_cases slot <;> decide - -/-- Parent slots for a loaded indirect read. The first operand supplies the -runtime address and the update replacement tape receives the loaded value. -/ -def indirectLoadLookupSlot (i : Fin 14) : Fin 18 := - match i.val with - | 0 => 0 - | 1 => 1 - | 2 => 2 - | 3 => 3 - | 4 => 4 - | 5 => 5 - | 6 => 6 - | 7 => 7 - | 8 => 8 - | 9 => 9 - | 10 => 12 - | 11 => 13 - | 12 => 10 - | _ => 11 - -private theorem indirectLoadLookupSlot_injective : - Function.Injective indirectLoadLookupSlot := by - intro i j h - fin_cases i <;> fin_cases j <;> simp [indirectLoadLookupSlot] at h ⊢ - -/-- Reusable loaded lookup view for indirect `load`. -/ -def indirectLoadLookup {n : ℕ} (tapes : BinaryInstructionTapes n) : - EntryLookupRestoreTapes n where - idx := fun i => tapes.idx (indirectLoadLookupSlot i) - injective := fun _ _ h => by - exact indirectLoadLookupSlot_injective (tapes.injective h) - -@[simp] theorem indirectLoadLookup_count {n : ℕ} - (tapes : BinaryInstructionTapes n) : - tapes.indirectLoadLookup.idx 9 = tapes.update.remaining := rfl - -@[simp] theorem indirectLoadLookup_countSource {n : ℕ} - (tapes : BinaryInstructionTapes n) : - tapes.indirectLoadLookup.countSource = tapes.update.resultCount := rfl - -@[simp] theorem indirectLoadLookup_querySource {n : ℕ} - (tapes : BinaryInstructionTapes n) : - tapes.indirectLoadLookup.querySource = tapes.lhs := rfl - -@[simp] theorem indirectLoadLookup_destination {n : ℕ} - (tapes : BinaryInstructionTapes n) : - tapes.indirectLoadLookup.destination = tapes.update.replacement := rfl - -@[simp] theorem indirectLoadLookup_copyScratch {n : ℕ} - (tapes : BinaryInstructionTapes n) : - tapes.indirectLoadLookup.copyScratch = tapes.update.found := rfl - -/-- Multiplication-role parent slots. The accumulator deliberately aliases the -update replacement slot `10`. -/ -def mulSlot (i : Fin 6) : Fin 18 := - match i.val with - | 0 => 13 - | 1 => 14 - | 2 => 10 - | 3 => 15 - | 4 => 16 - | _ => 17 - -private theorem mulSlot_injective : Function.Injective mulSlot := by - intro i j hij - fin_cases i <;> fin_cases j <;> simp [mulSlot] at hij ⊢ - -/-- Six-tape multiplication view, with its accumulator on update replacement. -/ -def mul {n : ℕ} (tapes : BinaryInstructionTapes n) : TM.BinaryShiftMulABI n where - tape := - ⟨fun i => tapes.idx (mulSlot i), fun _ _ h => - by exact mulSlot_injective (tapes.injective h)⟩ - -@[simp] theorem mul_lhs {n : ℕ} (tapes : BinaryInstructionTapes n) : - tapes.mul.lhs = tapes.lhs := rfl - -@[simp] theorem mul_rhs {n : ℕ} (tapes : BinaryInstructionTapes n) : - tapes.mul.rhs = tapes.rhs := rfl - -@[simp] theorem mul_acc {n : ℕ} (tapes : BinaryInstructionTapes n) : - tapes.mul.acc = tapes.update.replacement := rfl - -@[simp] theorem mul_shift {n : ℕ} (tapes : BinaryInstructionTapes n) : - tapes.mul.shift = tapes.shift := rfl - -@[simp] theorem mul_tmp {n : ℕ} (tapes : BinaryInstructionTapes n) : - tapes.mul.tmp = tapes.tmp := rfl - -@[simp] theorem mul_dbl {n : ℕ} (tapes : BinaryInstructionTapes n) : - tapes.mul.dbl = tapes.dbl := rfl - -/-- The addition/subtraction operands and result are pairwise distinct. -/ -theorem arithmeticDistinct {n : ℕ} (tapes : BinaryInstructionTapes n) : - TM.BinaryRippleAddDistinct tapes.lhs tapes.rhs - tapes.update.replacement := by - exact ⟨tapes.ne (by decide), tapes.ne (by decide), - tapes.ne (by decide)⟩ - -/-- The same physical inequalities as a subtraction certificate. -/ -theorem subtractionDistinct {n : ℕ} (tapes : BinaryInstructionTapes n) : - TM.BinaryRippleSubDistinct tapes.lhs tapes.rhs - tapes.update.replacement := by - exact ⟨tapes.ne (by decide), tapes.ne (by decide), - tapes.ne (by decide)⟩ - -end BinaryInstructionTapes - -/-- The arithmetic/store ABI together with one disjoint canonical program- -counter tape. Nineteen work tapes suffice for every RAM instruction. -/ -structure ControlInstructionTapes (n : ℕ) where - /-- The complete data-instruction assignment. -/ - data : BinaryInstructionTapes n - /-- Canonical binary program counter. -/ - pc : Fin n - /-- The program counter aliases no data-instruction role. -/ - pc_ne : ∀ slot, pc ≠ data.idx slot - -namespace ControlInstructionTapes - -/-- Every data-instruction role is distinct from the program counter. -/ -theorem data_ne_pc {n : ℕ} (tapes : ControlInstructionTapes n) - (slot : Fin 18) : tapes.data.idx slot ≠ tapes.pc := - (tapes.pc_ne slot).symm - -/-- The first loaded operand is distinct from the program counter. -/ -theorem lhs_ne_pc {n : ℕ} (tapes : ControlInstructionTapes n) : - tapes.data.lhs ≠ tapes.pc := tapes.data_ne_pc 13 - -/-- The program counter is distinct from the first loaded operand. -/ -theorem pc_ne_lhs {n : ℕ} (tapes : ControlInstructionTapes n) : - tapes.pc ≠ tapes.data.lhs := tapes.pc_ne 13 - -/-- No tape owned by the first lookup aliases the program counter. -/ -theorem lookup_ne_pc {n : ℕ} (tapes : ControlInstructionTapes n) - (slot : Fin 14) : tapes.data.lhsLookup.idx slot ≠ tapes.pc := by - exact tapes.data_ne_pc (BinaryInstructionTapes.lhsLookupSlot slot) - -end ControlInstructionTapes - /-- Pure result of the selected arithmetic operation. -/ def BinaryInstrOp.eval : BinaryInstrOp → ℕ → ℕ → ℕ | .add, lhs, rhs => lhs + rhs diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Tapes.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Tapes.lean new file mode 100644 index 0000000000..d5f31abeb3 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Tapes.lean @@ -0,0 +1,400 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleSub.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryShiftMul.Defs + +/-! +# Tape layouts for sparse-register instructions + +Arithmetic and control instruction tape assignments and their injectivity and +non-aliasing facts, shared by the concrete instruction machines. +-/ + +@[expose] public section + +namespace Complexity + +namespace RAM + +namespace RegisterStore + +namespace Machine + +/-- The three arithmetic operations shared by RAM register instructions. -/ +inductive BinaryInstrOp where + | add + | sub + | mul + deriving DecidableEq + +/-- Eighteen pairwise-distinct tapes used by arithmetic followed by sparse +update. Slots `0..12` are the update controller, slots `13` and `14` are the +operands, and slots `15..17` are multiplication scratch. -/ +structure BinaryInstructionTapes (n : ℕ) where + /-- Complete injective physical assignment. -/ + idx : Fin 18 → Fin n + /-- No two semantic roles alias. -/ + injective : Function.Injective idx + +namespace BinaryInstructionTapes + +/-- The thirteen-tape sparse-update view. -/ +def update {n : ℕ} (tapes : BinaryInstructionTapes n) : EntryUpdateTapes n where + idx := fun i => tapes.idx ⟨i, by omega⟩ + injective := by + intro i j h + apply Fin.ext + simpa using congrArg Fin.val (tapes.injective h) + +/-- First looked-up arithmetic operand. -/ +def lhs {n : ℕ} (tapes : BinaryInstructionTapes n) : Fin n := tapes.idx 13 + +/-- Second looked-up arithmetic operand. -/ +def rhs {n : ℕ} (tapes : BinaryInstructionTapes n) : Fin n := tapes.idx 14 + +/-- Multiplication's shifted-multiplicand scratch tape. -/ +def shift {n : ℕ} (tapes : BinaryInstructionTapes n) : Fin n := tapes.idx 15 + +/-- Multiplication's first alternating scratch tape. -/ +def tmp {n : ℕ} (tapes : BinaryInstructionTapes n) : Fin n := tapes.idx 16 + +/-- Multiplication's second alternating scratch tape. -/ +def dbl {n : ℕ} (tapes : BinaryInstructionTapes n) : Fin n := tapes.idx 17 + +/-- Parent-slot inequality gives physical tape inequality. -/ +theorem ne {n : ℕ} (tapes : BinaryInstructionTapes n) + {i j : Fin 18} (hne : i ≠ j) : tapes.idx i ≠ tapes.idx j := + fun heq => hne (tapes.injective heq) + +theorem update_ne_lhs {n : ℕ} (tapes : BinaryInstructionTapes n) + (slot : Fin 13) : tapes.update.idx slot ≠ tapes.lhs := by + apply tapes.ne + intro h + have hval := congrArg Fin.val h + change slot.val = 13 at hval + omega + +theorem update_ne_rhs {n : ℕ} (tapes : BinaryInstructionTapes n) + (slot : Fin 13) : tapes.update.idx slot ≠ tapes.rhs := by + apply tapes.ne + intro h + have hval := congrArg Fin.val h + change slot.val = 14 at hval + omega + +theorem update_ne_shift {n : ℕ} (tapes : BinaryInstructionTapes n) + (slot : Fin 13) : tapes.update.idx slot ≠ tapes.shift := by + apply tapes.ne + intro h + have hval := congrArg Fin.val h + change slot.val = 15 at hval + omega + +theorem update_ne_tmp {n : ℕ} (tapes : BinaryInstructionTapes n) + (slot : Fin 13) : tapes.update.idx slot ≠ tapes.tmp := by + apply tapes.ne + intro h + have hval := congrArg Fin.val h + change slot.val = 16 at hval + omega + +theorem update_ne_dbl {n : ℕ} (tapes : BinaryInstructionTapes n) + (slot : Fin 13) : tapes.update.idx slot ≠ tapes.dbl := by + apply tapes.ne + intro h + have hval := congrArg Fin.val h + change slot.val = 17 at hval + omega + +/-- Parent slots for a reusable lookup whose destination is `lhs`. -/ +def lhsLookupSlot (i : Fin 14) : Fin 18 := + match i.val with + | 0 => 0 + | 1 => 1 + | 2 => 2 + | 3 => 3 + | 4 => 4 + | 5 => 5 + | 6 => 6 + | 7 => 7 + | 8 => 8 + | 9 => 9 + | 10 => 12 + | 11 => 15 + | 12 => 13 + | _ => 11 + +private theorem lhsLookupSlot_injective : Function.Injective lhsLookupSlot := by + intro i j h + fin_cases i <;> fin_cases j <;> simp [lhsLookupSlot] at h ⊢ + +/-- Reusable sparse lookup view targeting the first operand. -/ +def lhsLookup {n : ℕ} (tapes : BinaryInstructionTapes n) : + EntryLookupRestoreTapes n where + idx := fun i => tapes.idx (lhsLookupSlot i) + injective := fun _ _ h => by + exact lhsLookupSlot_injective (tapes.injective h) + +/-- Parent slots for a reusable lookup whose destination is `rhs`. -/ +def rhsLookupSlot (i : Fin 14) : Fin 18 := + match i.val with + | 0 => 0 + | 1 => 1 + | 2 => 2 + | 3 => 3 + | 4 => 4 + | 5 => 5 + | 6 => 6 + | 7 => 7 + | 8 => 8 + | 9 => 9 + | 10 => 12 + | 11 => 15 + | 12 => 14 + | _ => 11 + +private theorem rhsLookupSlot_injective : Function.Injective rhsLookupSlot := by + intro i j h + fin_cases i <;> fin_cases j <;> simp [rhsLookupSlot] at h ⊢ + +/-- Reusable sparse lookup view targeting the second operand. -/ +def rhsLookup {n : ℕ} (tapes : BinaryInstructionTapes n) : + EntryLookupRestoreTapes n where + idx := fun i => tapes.idx (rhsLookupSlot i) + injective := fun _ _ h => by + exact rhsLookupSlot_injective (tapes.injective h) + +@[simp] theorem lhsLookup_count {n : ℕ} (tapes : BinaryInstructionTapes n) : + tapes.lhsLookup.idx 9 = tapes.update.remaining := rfl + +@[simp] theorem rhsLookup_count {n : ℕ} (tapes : BinaryInstructionTapes n) : + tapes.rhsLookup.idx 9 = tapes.update.remaining := rfl + +@[simp] theorem lhsLookup_countSource {n : ℕ} + (tapes : BinaryInstructionTapes n) : + tapes.lhsLookup.countSource = tapes.update.resultCount := rfl + +@[simp] theorem rhsLookup_countSource {n : ℕ} + (tapes : BinaryInstructionTapes n) : + tapes.rhsLookup.countSource = tapes.update.resultCount := rfl + +@[simp] theorem lhsLookup_querySource {n : ℕ} + (tapes : BinaryInstructionTapes n) : + tapes.lhsLookup.querySource = tapes.shift := rfl + +@[simp] theorem rhsLookup_querySource {n : ℕ} + (tapes : BinaryInstructionTapes n) : + tapes.rhsLookup.querySource = tapes.shift := rfl + +@[simp] theorem lhsLookup_destination {n : ℕ} + (tapes : BinaryInstructionTapes n) : + tapes.lhsLookup.destination = tapes.lhs := rfl + +@[simp] theorem rhsLookup_destination {n : ℕ} + (tapes : BinaryInstructionTapes n) : + tapes.rhsLookup.destination = tapes.rhs := rfl + +@[simp] theorem lhsLookup_copyScratch {n : ℕ} + (tapes : BinaryInstructionTapes n) : + tapes.lhsLookup.copyScratch = tapes.update.found := rfl + +@[simp] theorem rhsLookup_copyScratch {n : ℕ} + (tapes : BinaryInstructionTapes n) : + tapes.rhsLookup.copyScratch = tapes.update.found := rfl + +theorem lhsLookup_ne_rhs {n : ℕ} (tapes : BinaryInstructionTapes n) + (slot : Fin 14) : tapes.lhsLookup.idx slot ≠ tapes.rhs := by + apply tapes.ne + fin_cases slot <;> decide + +theorem rhsLookup_ne_lhs {n : ℕ} (tapes : BinaryInstructionTapes n) + (slot : Fin 14) : tapes.rhsLookup.idx slot ≠ tapes.lhs := by + apply tapes.ne + fin_cases slot <;> decide + +theorem lhsLookup_ne_tmp {n : ℕ} (tapes : BinaryInstructionTapes n) + (slot : Fin 14) : tapes.lhsLookup.idx slot ≠ tapes.tmp := by + apply tapes.ne + fin_cases slot <;> decide + +theorem rhsLookup_ne_tmp {n : ℕ} (tapes : BinaryInstructionTapes n) + (slot : Fin 14) : tapes.rhsLookup.idx slot ≠ tapes.tmp := by + apply tapes.ne + fin_cases slot <;> decide + +theorem lhsLookup_ne_dbl {n : ℕ} (tapes : BinaryInstructionTapes n) + (slot : Fin 14) : tapes.lhsLookup.idx slot ≠ tapes.dbl := by + apply tapes.ne + fin_cases slot <;> decide + +theorem rhsLookup_ne_dbl {n : ℕ} (tapes : BinaryInstructionTapes n) + (slot : Fin 14) : tapes.rhsLookup.idx slot ≠ tapes.dbl := by + apply tapes.ne + fin_cases slot <;> decide + +theorem lhsLookup_ne_replacement {n : ℕ} + (tapes : BinaryInstructionTapes n) (slot : Fin 14) : + tapes.lhsLookup.idx slot ≠ tapes.update.replacement := by + apply tapes.ne + fin_cases slot <;> decide + +theorem rhsLookup_ne_replacement {n : ℕ} + (tapes : BinaryInstructionTapes n) (slot : Fin 14) : + tapes.rhsLookup.idx slot ≠ tapes.update.replacement := by + apply tapes.ne + fin_cases slot <;> decide + +/-- Parent slots for a loaded indirect read. The first operand supplies the +runtime address and the update replacement tape receives the loaded value. -/ +def indirectLoadLookupSlot (i : Fin 14) : Fin 18 := + match i.val with + | 0 => 0 + | 1 => 1 + | 2 => 2 + | 3 => 3 + | 4 => 4 + | 5 => 5 + | 6 => 6 + | 7 => 7 + | 8 => 8 + | 9 => 9 + | 10 => 12 + | 11 => 13 + | 12 => 10 + | _ => 11 + +private theorem indirectLoadLookupSlot_injective : + Function.Injective indirectLoadLookupSlot := by + intro i j h + fin_cases i <;> fin_cases j <;> simp [indirectLoadLookupSlot] at h ⊢ + +/-- Reusable loaded lookup view for indirect `load`. -/ +def indirectLoadLookup {n : ℕ} (tapes : BinaryInstructionTapes n) : + EntryLookupRestoreTapes n where + idx := fun i => tapes.idx (indirectLoadLookupSlot i) + injective := fun _ _ h => by + exact indirectLoadLookupSlot_injective (tapes.injective h) + +@[simp] theorem indirectLoadLookup_count {n : ℕ} + (tapes : BinaryInstructionTapes n) : + tapes.indirectLoadLookup.idx 9 = tapes.update.remaining := rfl + +@[simp] theorem indirectLoadLookup_countSource {n : ℕ} + (tapes : BinaryInstructionTapes n) : + tapes.indirectLoadLookup.countSource = tapes.update.resultCount := rfl + +@[simp] theorem indirectLoadLookup_querySource {n : ℕ} + (tapes : BinaryInstructionTapes n) : + tapes.indirectLoadLookup.querySource = tapes.lhs := rfl + +@[simp] theorem indirectLoadLookup_destination {n : ℕ} + (tapes : BinaryInstructionTapes n) : + tapes.indirectLoadLookup.destination = tapes.update.replacement := rfl + +@[simp] theorem indirectLoadLookup_copyScratch {n : ℕ} + (tapes : BinaryInstructionTapes n) : + tapes.indirectLoadLookup.copyScratch = tapes.update.found := rfl + +/-- Multiplication-role parent slots. The accumulator deliberately aliases the +update replacement slot `10`. -/ +def mulSlot (i : Fin 6) : Fin 18 := + match i.val with + | 0 => 13 + | 1 => 14 + | 2 => 10 + | 3 => 15 + | 4 => 16 + | _ => 17 + +private theorem mulSlot_injective : Function.Injective mulSlot := by + intro i j hij + fin_cases i <;> fin_cases j <;> simp [mulSlot] at hij ⊢ + +/-- Six-tape multiplication view, with its accumulator on update replacement. -/ +def mul {n : ℕ} (tapes : BinaryInstructionTapes n) : TM.BinaryShiftMulABI n where + tape := + ⟨fun i => tapes.idx (mulSlot i), fun _ _ h => + by exact mulSlot_injective (tapes.injective h)⟩ + +@[simp] theorem mul_lhs {n : ℕ} (tapes : BinaryInstructionTapes n) : + tapes.mul.lhs = tapes.lhs := rfl + +@[simp] theorem mul_rhs {n : ℕ} (tapes : BinaryInstructionTapes n) : + tapes.mul.rhs = tapes.rhs := rfl + +@[simp] theorem mul_acc {n : ℕ} (tapes : BinaryInstructionTapes n) : + tapes.mul.acc = tapes.update.replacement := rfl + +@[simp] theorem mul_shift {n : ℕ} (tapes : BinaryInstructionTapes n) : + tapes.mul.shift = tapes.shift := rfl + +@[simp] theorem mul_tmp {n : ℕ} (tapes : BinaryInstructionTapes n) : + tapes.mul.tmp = tapes.tmp := rfl + +@[simp] theorem mul_dbl {n : ℕ} (tapes : BinaryInstructionTapes n) : + tapes.mul.dbl = tapes.dbl := rfl + +/-- The addition/subtraction operands and result are pairwise distinct. -/ +theorem arithmeticDistinct {n : ℕ} (tapes : BinaryInstructionTapes n) : + TM.BinaryRippleAddDistinct tapes.lhs tapes.rhs + tapes.update.replacement := by + exact ⟨tapes.ne (by decide), tapes.ne (by decide), + tapes.ne (by decide)⟩ + +/-- The same physical inequalities as a subtraction certificate. -/ +theorem subtractionDistinct {n : ℕ} (tapes : BinaryInstructionTapes n) : + TM.BinaryRippleSubDistinct tapes.lhs tapes.rhs + tapes.update.replacement := by + exact ⟨tapes.ne (by decide), tapes.ne (by decide), + tapes.ne (by decide)⟩ + +end BinaryInstructionTapes + +/-- The arithmetic/store ABI together with one disjoint canonical program- +counter tape. Nineteen work tapes suffice for every RAM instruction. -/ +structure ControlInstructionTapes (n : ℕ) where + /-- The complete data-instruction assignment. -/ + data : BinaryInstructionTapes n + /-- Canonical binary program counter. -/ + pc : Fin n + /-- The program counter aliases no data-instruction role. -/ + pc_ne : ∀ slot, pc ≠ data.idx slot + +namespace ControlInstructionTapes + +/-- Every data-instruction role is distinct from the program counter. -/ +theorem data_ne_pc {n : ℕ} (tapes : ControlInstructionTapes n) + (slot : Fin 18) : tapes.data.idx slot ≠ tapes.pc := + (tapes.pc_ne slot).symm + +/-- The first loaded operand is distinct from the program counter. -/ +theorem lhs_ne_pc {n : ℕ} (tapes : ControlInstructionTapes n) : + tapes.data.lhs ≠ tapes.pc := tapes.data_ne_pc 13 + +/-- The program counter is distinct from the first loaded operand. -/ +theorem pc_ne_lhs {n : ℕ} (tapes : ControlInstructionTapes n) : + tapes.pc ≠ tapes.data.lhs := tapes.pc_ne 13 + +/-- No tape owned by the first lookup aliases the program counter. -/ +theorem lookup_ne_pc {n : ℕ} (tapes : ControlInstructionTapes n) + (slot : Fin 14) : tapes.data.lhsLookup.idx slot ≠ tapes.pc := by + exact tapes.data_ne_pc (BinaryInstructionTapes.lhsLookupSlot slot) + +end ControlInstructionTapes + + +end Machine + +end RegisterStore + +end RAM + +end Complexity diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/Defs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/Defs.lean index 011116a30a..6bcd2fe6ea 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/Defs.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/Defs.lean @@ -13,6 +13,8 @@ public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simu public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryAddConst.Defs public import Mathlib.Tactic.FinCases +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.ResetLayout + /-! # Reusable sparse-register operand lookup -- definitions @@ -33,359 +35,6 @@ namespace RegisterStore namespace Machine -/-- Fourteen pairwise-distinct tapes for a reusable sparse operand lookup. -Slots `0..9` are the bounded scanner; the final four slots preserve the entry -count, supply the query, receive the value, and provide zero copy scratch. -/ -structure EntryLookupRestoreTapes (n : ℕ) where - /-- Physical work tape assigned to each logical lookup role. -/ - idx : Fin 14 → Fin n - /-- Distinct logical lookup roles occupy distinct physical tapes. -/ - injective : Function.Injective idx - -namespace EntryLookupRestoreTapes - -/-- Bounded scanner view of the reusable lookup assignment. -/ -def scan {n : ℕ} (tapes : EntryLookupRestoreTapes n) : EntryScanTapes n where - entry := - { idx := fun i => tapes.idx ⟨i, by omega⟩ - injective := by - intro i j h - apply Fin.ext - simpa using congrArg Fin.val (tapes.injective h) } - count := tapes.idx 9 - count_ne := by - intro i h - have h' : (9 : Fin 14) = ⟨i.val, by omega⟩ := tapes.injective h - have hval := congrArg Fin.val h' - change (9 : ℕ) = i.val at hval - omega - -@[simp] theorem scan_entry_idx {n : ℕ} (tapes : EntryLookupRestoreTapes n) - (slot : Fin 9) : - tapes.scan.entry.idx slot = tapes.idx ⟨slot.val, by omega⟩ := rfl - -@[simp] theorem scan_count {n : ℕ} (tapes : EntryLookupRestoreTapes n) : - tapes.scan.count = tapes.idx 9 := rfl - -/-- Preserved canonical copy of the store cardinality. -/ -def countSource {n : ℕ} (tapes : EntryLookupRestoreTapes n) : Fin n := - tapes.idx 10 - -/-- Canonical address supplied to this lookup. -/ -def querySource {n : ℕ} (tapes : EntryLookupRestoreTapes n) : Fin n := - tapes.idx 11 - -/-- Canonical destination receiving the looked-up register value. -/ -def destination {n : ℕ} (tapes : EntryLookupRestoreTapes n) : Fin n := - tapes.idx 12 - -/-- Preserved zero tape used by width-linear binary copying. -/ -def copyScratch {n : ℕ} (tapes : EntryLookupRestoreTapes n) : Fin n := - tapes.idx 13 - -/-- Inequality of logical slots gives inequality of physical tapes. -/ -theorem ne {n : ℕ} (tapes : EntryLookupRestoreTapes n) - {i j : Fin 14} (hne : i ≠ j) : tapes.idx i ≠ tapes.idx j := - fun heq => hne (tapes.injective heq) - -/-- Every scanner tape is distinct from an external reusable-lookup role. -/ -theorem scan_ne_external {n : ℕ} (tapes : EntryLookupRestoreTapes n) - (slot : Fin 10) (external : Fin 4) : - tapes.idx ⟨slot.val, by omega⟩ ≠ - tapes.idx ⟨external.val + 10, by omega⟩ := by - apply tapes.ne - intro h - have hval := congrArg Fin.val h - change slot.val = external.val + 10 at hval - omega - -theorem countSource_ne_querySource {n : ℕ} - (tapes : EntryLookupRestoreTapes n) : - tapes.countSource ≠ tapes.querySource := tapes.ne (by decide) - -theorem countSource_ne_destination {n : ℕ} - (tapes : EntryLookupRestoreTapes n) : - tapes.countSource ≠ tapes.destination := tapes.ne (by decide) - -theorem countSource_ne_copyScratch {n : ℕ} - (tapes : EntryLookupRestoreTapes n) : - tapes.countSource ≠ tapes.copyScratch := tapes.ne (by decide) - -theorem querySource_ne_destination {n : ℕ} - (tapes : EntryLookupRestoreTapes n) : - tapes.querySource ≠ tapes.destination := tapes.ne (by decide) - -theorem querySource_ne_copyScratch {n : ℕ} - (tapes : EntryLookupRestoreTapes n) : - tapes.querySource ≠ tapes.copyScratch := tapes.ne (by decide) - -theorem destination_ne_copyScratch {n : ℕ} - (tapes : EntryLookupRestoreTapes n) : - tapes.destination ≠ tapes.copyScratch := tapes.ne (by decide) - -/-- Logical parent slots reset after one lookup. -/ -def resetSlot (slot : Fin 9) : Fin 14 := - match slot.val with - | 0 => 1 - | 1 => 2 - | 2 => 3 - | 3 => 4 - | 4 => 5 - | 5 => 6 - | 6 => 8 - | 7 => 7 - | _ => 9 - -private theorem resetSlot_injective : Function.Injective resetSlot := by - intro i j h - fin_cases i <;> fin_cases j <;> simp [resetSlot] at h ⊢ - -/-- Physical reset target selected by a finite logical slot. -/ -def resetIdx {n : ℕ} (tapes : EntryLookupRestoreTapes n) - (slot : Fin 9) : Fin n := tapes.idx (resetSlot slot) - -theorem resetIdx_injective {n : ℕ} (tapes : EntryLookupRestoreTapes n) : - Function.Injective tapes.resetIdx := - fun _ _ h => resetSlot_injective (tapes.injective h) - -@[simp] theorem resetIdx_zero {n : ℕ} (tapes : EntryLookupRestoreTapes n) : - tapes.resetIdx 0 = tapes.scan.entry.address := rfl - -@[simp] theorem resetIdx_one {n : ℕ} (tapes : EntryLookupRestoreTapes n) : - tapes.resetIdx 1 = tapes.scan.entry.value := rfl - -@[simp] theorem resetIdx_two {n : ℕ} (tapes : EntryLookupRestoreTapes n) : - tapes.resetIdx 2 = tapes.scan.entry.addressCounter := rfl - -@[simp] theorem resetIdx_three {n : ℕ} (tapes : EntryLookupRestoreTapes n) : - tapes.resetIdx 3 = tapes.scan.entry.addressWidth := rfl - -@[simp] theorem resetIdx_four {n : ℕ} (tapes : EntryLookupRestoreTapes n) : - tapes.resetIdx 4 = tapes.scan.entry.valueCounter := rfl - -@[simp] theorem resetIdx_five {n : ℕ} (tapes : EntryLookupRestoreTapes n) : - tapes.resetIdx 5 = tapes.scan.entry.valueWidth := rfl - -@[simp] theorem resetIdx_six {n : ℕ} (tapes : EntryLookupRestoreTapes n) : - tapes.resetIdx 6 = tapes.scan.entry.result := rfl - -@[simp] theorem resetIdx_seven {n : ℕ} (tapes : EntryLookupRestoreTapes n) : - tapes.resetIdx 7 = tapes.scan.entry.query := rfl - -@[simp] theorem resetIdx_eight {n : ℕ} (tapes : EntryLookupRestoreTapes n) : - tapes.resetIdx 8 = tapes.scan.count := rfl - -end EntryLookupRestoreTapes - -/-- Scanner-owned tapes reset after copying out a lookup result. The encoded -source is deliberately excluded because it is read-only and merely rewound. -/ -def entryLookupResetTargets {n : ℕ} (tapes : EntryLookupRestoreTapes n) : - List (Fin n) := - List.ofFn tapes.resetIdx - -/-- Width envelope for every binary scratch value at a successful hit on one -entry. -/ -def entryLookupEntryWidth (entry : Entry) (address : ℕ) : ℕ := - max address.bits.length - (max entry.1.bits.length - (max entry.2.bits.length - (max (bitlen entry.1) - (max (bitlen entry.2) 1)))) - -/-- Width envelope contributed by possible hit entries in a complete store. -/ -def entryLookupStoreWidth (address : ℕ) : Store → ℕ - | [] => address.bits.length - | entry :: rest => - max (entryLookupEntryWidth entry address) - (entryLookupStoreWidth address rest) - -/-- Width envelope for every hit or miss reset target in a complete store. -/ -def entryLookupResetWidth (store : Store) (address : ℕ) : ℕ := - max store.length.bits.length (entryLookupStoreWidth address store) - -/-- Exact reset contents at a successful lookup endpoint. -/ -def entryLookupFoundBits {n : ℕ} (tapes : EntryLookupRestoreTapes n) - (entry : Entry) (remaining address : ℕ) (i : Fin n) : List Bool := - if i = tapes.scan.entry.query then address.bits - else if i = tapes.scan.count then remaining.bits - else entryMissBits tapes.scan.entry entry address.bits i - -/-- Exact reset contents at an unsuccessful lookup endpoint. -/ -def entryLookupMissBits {n : ℕ} (tapes : EntryLookupRestoreTapes n) - (address : ℕ) (i : Fin n) : List Bool := - if i = tapes.scan.entry.query then address.bits else [] - --- These repetitive projection simplifications intentionally share one stable --- simp set; individual cases use different subsets of it. -@[simp] theorem entryLookupFoundBits_zero {n : ℕ} - (tapes : EntryLookupRestoreTapes n) (entry : Entry) - (remaining address : ℕ) : - entryLookupFoundBits tapes entry remaining address - tapes.scan.entry.address = - entry.1.bits := by - simp [entryLookupFoundBits, entryMissBits, EntryLookupRestoreTapes.resetIdx, - EntryLookupRestoreTapes.resetSlot, EntryMatchTapes.address, - EntryMatchTapes.value, EntryMatchTapes.addressCounter, - EntryMatchTapes.addressWidth, EntryMatchTapes.valueCounter, - EntryMatchTapes.valueWidth, EntryMatchTapes.query, EntryMatchTapes.result, - tapes.injective.eq_iff] - -@[simp] theorem entryLookupFoundBits_one {n : ℕ} - (tapes : EntryLookupRestoreTapes n) (entry : Entry) - (remaining address : ℕ) : - entryLookupFoundBits tapes entry remaining address tapes.scan.entry.value = - entry.2.bits := by - simp [entryLookupFoundBits, entryMissBits, EntryLookupRestoreTapes.resetIdx, - EntryLookupRestoreTapes.resetSlot, EntryMatchTapes.address, - EntryMatchTapes.value, EntryMatchTapes.addressCounter, - EntryMatchTapes.addressWidth, EntryMatchTapes.valueCounter, - EntryMatchTapes.valueWidth, EntryMatchTapes.query, EntryMatchTapes.result, - tapes.injective.eq_iff] - -@[simp] theorem entryLookupFoundBits_two {n : ℕ} - (tapes : EntryLookupRestoreTapes n) (entry : Entry) - (remaining address : ℕ) : - entryLookupFoundBits tapes entry remaining address - tapes.scan.entry.addressCounter = - List.replicate (bitlen entry.1) true := by - simp [entryLookupFoundBits, entryMissBits, EntryLookupRestoreTapes.resetIdx, - EntryLookupRestoreTapes.resetSlot, EntryMatchTapes.address, - EntryMatchTapes.value, EntryMatchTapes.addressCounter, - EntryMatchTapes.addressWidth, EntryMatchTapes.valueCounter, - EntryMatchTapes.valueWidth, EntryMatchTapes.query, EntryMatchTapes.result, - tapes.injective.eq_iff] - -@[simp] theorem entryLookupFoundBits_three {n : ℕ} - (tapes : EntryLookupRestoreTapes n) (entry : Entry) - (remaining address : ℕ) : - entryLookupFoundBits tapes entry remaining address - tapes.scan.entry.addressWidth = - [] := by - simp [entryLookupFoundBits, entryMissBits, EntryLookupRestoreTapes.resetIdx, - EntryLookupRestoreTapes.resetSlot, EntryMatchTapes.address, - EntryMatchTapes.value, EntryMatchTapes.addressCounter, - EntryMatchTapes.addressWidth, EntryMatchTapes.valueCounter, - EntryMatchTapes.valueWidth, EntryMatchTapes.query, EntryMatchTapes.result, - tapes.injective.eq_iff] - -@[simp] theorem entryLookupFoundBits_four {n : ℕ} - (tapes : EntryLookupRestoreTapes n) (entry : Entry) - (remaining address : ℕ) : - entryLookupFoundBits tapes entry remaining address - tapes.scan.entry.valueCounter = - List.replicate (bitlen entry.2) true := by - simp [entryLookupFoundBits, entryMissBits, EntryLookupRestoreTapes.resetIdx, - EntryLookupRestoreTapes.resetSlot, EntryMatchTapes.address, - EntryMatchTapes.value, EntryMatchTapes.addressCounter, - EntryMatchTapes.addressWidth, EntryMatchTapes.valueCounter, - EntryMatchTapes.valueWidth, EntryMatchTapes.query, EntryMatchTapes.result, - tapes.injective.eq_iff] - -@[simp] theorem entryLookupFoundBits_five {n : ℕ} - (tapes : EntryLookupRestoreTapes n) (entry : Entry) - (remaining address : ℕ) : - entryLookupFoundBits tapes entry remaining address - tapes.scan.entry.valueWidth = - [] := by - simp [entryLookupFoundBits, entryMissBits, EntryLookupRestoreTapes.resetIdx, - EntryLookupRestoreTapes.resetSlot, EntryMatchTapes.address, - EntryMatchTapes.value, EntryMatchTapes.addressCounter, - EntryMatchTapes.addressWidth, EntryMatchTapes.valueCounter, - EntryMatchTapes.valueWidth, EntryMatchTapes.query, EntryMatchTapes.result, - tapes.injective.eq_iff] - -@[simp] theorem entryLookupFoundBits_six {n : ℕ} - (tapes : EntryLookupRestoreTapes n) (entry : Entry) - (remaining address : ℕ) : - entryLookupFoundBits tapes entry remaining address tapes.scan.entry.result = - [decide (entry.1.bits = address.bits)] := by - simp [entryLookupFoundBits, entryMissBits, EntryLookupRestoreTapes.resetIdx, - EntryLookupRestoreTapes.resetSlot, EntryMatchTapes.address, - EntryMatchTapes.value, EntryMatchTapes.addressCounter, - EntryMatchTapes.addressWidth, EntryMatchTapes.valueCounter, - EntryMatchTapes.valueWidth, EntryMatchTapes.query, EntryMatchTapes.result, - tapes.injective.eq_iff] - -@[simp] theorem entryLookupFoundBits_seven {n : ℕ} - (tapes : EntryLookupRestoreTapes n) (entry : Entry) - (remaining address : ℕ) : - entryLookupFoundBits tapes entry remaining address tapes.scan.entry.query = - address.bits := by - simp [entryLookupFoundBits, EntryLookupRestoreTapes.resetIdx, - EntryLookupRestoreTapes.resetSlot, EntryMatchTapes.query, - tapes.injective.eq_iff] - -@[simp] theorem entryLookupFoundBits_eight {n : ℕ} - (tapes : EntryLookupRestoreTapes n) (entry : Entry) - (remaining address : ℕ) : - entryLookupFoundBits tapes entry remaining address (tapes.idx 9) = - remaining.bits := by - simp [entryLookupFoundBits, EntryLookupRestoreTapes.resetIdx, - EntryLookupRestoreTapes.resetSlot, EntryMatchTapes.query, - tapes.injective.eq_iff] - -@[simp] theorem entryLookupMissBits_seven {n : ℕ} - (tapes : EntryLookupRestoreTapes n) (address : ℕ) : - entryLookupMissBits tapes address tapes.scan.entry.query = address.bits := by - simp [entryLookupMissBits, EntryLookupRestoreTapes.resetIdx, - EntryLookupRestoreTapes.resetSlot, EntryMatchTapes.query, - tapes.injective.eq_iff] - -@[simp] theorem entryLookupMissBits_zero {n : ℕ} - (tapes : EntryLookupRestoreTapes n) (address : ℕ) : - entryLookupMissBits tapes address tapes.scan.entry.address = [] := by - simp [entryLookupMissBits, EntryMatchTapes.address, EntryMatchTapes.query, - tapes.injective.eq_iff] - -@[simp] theorem entryLookupMissBits_one {n : ℕ} - (tapes : EntryLookupRestoreTapes n) (address : ℕ) : - entryLookupMissBits tapes address tapes.scan.entry.value = [] := by - simp [entryLookupMissBits, EntryMatchTapes.value, EntryMatchTapes.query, - tapes.injective.eq_iff] - -@[simp] theorem entryLookupMissBits_two {n : ℕ} - (tapes : EntryLookupRestoreTapes n) (address : ℕ) : - entryLookupMissBits tapes address tapes.scan.entry.addressCounter = [] := by - simp [entryLookupMissBits, EntryMatchTapes.addressCounter, - EntryMatchTapes.query, tapes.injective.eq_iff] - -@[simp] theorem entryLookupMissBits_three {n : ℕ} - (tapes : EntryLookupRestoreTapes n) (address : ℕ) : - entryLookupMissBits tapes address tapes.scan.entry.addressWidth = [] := by - simp [entryLookupMissBits, EntryMatchTapes.addressWidth, - EntryMatchTapes.query, tapes.injective.eq_iff] - -@[simp] theorem entryLookupMissBits_four {n : ℕ} - (tapes : EntryLookupRestoreTapes n) (address : ℕ) : - entryLookupMissBits tapes address tapes.scan.entry.valueCounter = [] := by - simp [entryLookupMissBits, EntryMatchTapes.valueCounter, - EntryMatchTapes.query, tapes.injective.eq_iff] - -@[simp] theorem entryLookupMissBits_five {n : ℕ} - (tapes : EntryLookupRestoreTapes n) (address : ℕ) : - entryLookupMissBits tapes address tapes.scan.entry.valueWidth = [] := by - simp [entryLookupMissBits, EntryMatchTapes.valueWidth, - EntryMatchTapes.query, tapes.injective.eq_iff] - -@[simp] theorem entryLookupMissBits_six {n : ℕ} - (tapes : EntryLookupRestoreTapes n) (address : ℕ) : - entryLookupMissBits tapes address tapes.scan.entry.result = [] := by - simp [entryLookupMissBits, EntryMatchTapes.result, EntryMatchTapes.query, - tapes.injective.eq_iff] - -@[simp] theorem entryLookupMissBits_eight {n : ℕ} - (tapes : EntryLookupRestoreTapes n) (address : ℕ) : - entryLookupMissBits tapes address (tapes.idx 9) = [] := by - simp [entryLookupMissBits, EntryMatchTapes.query, tapes.injective.eq_iff] - -@[simp] theorem entryLookupMissBits_other {n : ℕ} - (tapes : EntryLookupRestoreTapes n) (address : ℕ) (slot : Fin 9) - (hslot : slot ≠ 7) : - entryLookupMissBits tapes address (tapes.resetIdx slot) = [] := by - fin_cases slot <;> - simp_all [entryLookupMissBits, EntryLookupRestoreTapes.resetIdx, - EntryLookupRestoreTapes.resetSlot, EntryMatchTapes.query, - tapes.injective.eq_iff] /-- Uniform scanner-head bound from a canonical cell-one start. -/ def entryLookupRestoreHeadBound {n : ℕ} (tapes : EntryLookupRestoreTapes n) (store : Store) (address : ℕ) : ℕ := diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/ResetLayout.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/ResetLayout.lean new file mode 100644 index 0000000000..fee8758cb4 --- /dev/null +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/ResetLayout.lean @@ -0,0 +1,393 @@ +/- +Copyright (c) 2026 Samuel Schlesinger. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Samuel Schlesinger +-/ + +module +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryLookup.Defs +public import + LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.DenseInputLookup.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.DenseOverlay.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryAddConst.Defs +public import Mathlib.Tactic.FinCases + +/-! +# Reusable lookup tape layout and scratch encodings + +The fourteen-tape lookup assignment, fixed reset targets, width bounds, and +found/missing bit encodings used by the reusable lookup controller. +-/ + +@[expose] public section + +namespace Complexity + +namespace RAM + +namespace RegisterStore + +namespace Machine + +/-- Fourteen pairwise-distinct tapes for a reusable sparse operand lookup. +Slots `0..9` are the bounded scanner; the final four slots preserve the entry +count, supply the query, receive the value, and provide zero copy scratch. -/ +structure EntryLookupRestoreTapes (n : ℕ) where + /-- Physical work tape assigned to each logical lookup role. -/ + idx : Fin 14 → Fin n + /-- Distinct logical lookup roles occupy distinct physical tapes. -/ + injective : Function.Injective idx + +namespace EntryLookupRestoreTapes + +/-- Bounded scanner view of the reusable lookup assignment. -/ +def scan {n : ℕ} (tapes : EntryLookupRestoreTapes n) : EntryScanTapes n where + entry := + { idx := fun i => tapes.idx ⟨i, by omega⟩ + injective := by + intro i j h + apply Fin.ext + simpa using congrArg Fin.val (tapes.injective h) } + count := tapes.idx 9 + count_ne := by + intro i h + have h' : (9 : Fin 14) = ⟨i.val, by omega⟩ := tapes.injective h + have hval := congrArg Fin.val h' + change (9 : ℕ) = i.val at hval + omega + +@[simp] theorem scan_entry_idx {n : ℕ} (tapes : EntryLookupRestoreTapes n) + (slot : Fin 9) : + tapes.scan.entry.idx slot = tapes.idx ⟨slot.val, by omega⟩ := rfl + +@[simp] theorem scan_count {n : ℕ} (tapes : EntryLookupRestoreTapes n) : + tapes.scan.count = tapes.idx 9 := rfl + +/-- Preserved canonical copy of the store cardinality. -/ +def countSource {n : ℕ} (tapes : EntryLookupRestoreTapes n) : Fin n := + tapes.idx 10 + +/-- Canonical address supplied to this lookup. -/ +def querySource {n : ℕ} (tapes : EntryLookupRestoreTapes n) : Fin n := + tapes.idx 11 + +/-- Canonical destination receiving the looked-up register value. -/ +def destination {n : ℕ} (tapes : EntryLookupRestoreTapes n) : Fin n := + tapes.idx 12 + +/-- Preserved zero tape used by width-linear binary copying. -/ +def copyScratch {n : ℕ} (tapes : EntryLookupRestoreTapes n) : Fin n := + tapes.idx 13 + +/-- Inequality of logical slots gives inequality of physical tapes. -/ +theorem ne {n : ℕ} (tapes : EntryLookupRestoreTapes n) + {i j : Fin 14} (hne : i ≠ j) : tapes.idx i ≠ tapes.idx j := + fun heq => hne (tapes.injective heq) + +/-- Every scanner tape is distinct from an external reusable-lookup role. -/ +theorem scan_ne_external {n : ℕ} (tapes : EntryLookupRestoreTapes n) + (slot : Fin 10) (external : Fin 4) : + tapes.idx ⟨slot.val, by omega⟩ ≠ + tapes.idx ⟨external.val + 10, by omega⟩ := by + apply tapes.ne + intro h + have hval := congrArg Fin.val h + change slot.val = external.val + 10 at hval + omega + +theorem countSource_ne_querySource {n : ℕ} + (tapes : EntryLookupRestoreTapes n) : + tapes.countSource ≠ tapes.querySource := tapes.ne (by decide) + +theorem countSource_ne_destination {n : ℕ} + (tapes : EntryLookupRestoreTapes n) : + tapes.countSource ≠ tapes.destination := tapes.ne (by decide) + +theorem countSource_ne_copyScratch {n : ℕ} + (tapes : EntryLookupRestoreTapes n) : + tapes.countSource ≠ tapes.copyScratch := tapes.ne (by decide) + +theorem querySource_ne_destination {n : ℕ} + (tapes : EntryLookupRestoreTapes n) : + tapes.querySource ≠ tapes.destination := tapes.ne (by decide) + +theorem querySource_ne_copyScratch {n : ℕ} + (tapes : EntryLookupRestoreTapes n) : + tapes.querySource ≠ tapes.copyScratch := tapes.ne (by decide) + +theorem destination_ne_copyScratch {n : ℕ} + (tapes : EntryLookupRestoreTapes n) : + tapes.destination ≠ tapes.copyScratch := tapes.ne (by decide) + +/-- Logical parent slots reset after one lookup. -/ +def resetSlot (slot : Fin 9) : Fin 14 := + match slot.val with + | 0 => 1 + | 1 => 2 + | 2 => 3 + | 3 => 4 + | 4 => 5 + | 5 => 6 + | 6 => 8 + | 7 => 7 + | _ => 9 + +private theorem resetSlot_injective : Function.Injective resetSlot := by + intro i j h + fin_cases i <;> fin_cases j <;> simp [resetSlot] at h ⊢ + +/-- Physical reset target selected by a finite logical slot. -/ +def resetIdx {n : ℕ} (tapes : EntryLookupRestoreTapes n) + (slot : Fin 9) : Fin n := tapes.idx (resetSlot slot) + +theorem resetIdx_injective {n : ℕ} (tapes : EntryLookupRestoreTapes n) : + Function.Injective tapes.resetIdx := + fun _ _ h => resetSlot_injective (tapes.injective h) + +@[simp] theorem resetIdx_zero {n : ℕ} (tapes : EntryLookupRestoreTapes n) : + tapes.resetIdx 0 = tapes.scan.entry.address := rfl + +@[simp] theorem resetIdx_one {n : ℕ} (tapes : EntryLookupRestoreTapes n) : + tapes.resetIdx 1 = tapes.scan.entry.value := rfl + +@[simp] theorem resetIdx_two {n : ℕ} (tapes : EntryLookupRestoreTapes n) : + tapes.resetIdx 2 = tapes.scan.entry.addressCounter := rfl + +@[simp] theorem resetIdx_three {n : ℕ} (tapes : EntryLookupRestoreTapes n) : + tapes.resetIdx 3 = tapes.scan.entry.addressWidth := rfl + +@[simp] theorem resetIdx_four {n : ℕ} (tapes : EntryLookupRestoreTapes n) : + tapes.resetIdx 4 = tapes.scan.entry.valueCounter := rfl + +@[simp] theorem resetIdx_five {n : ℕ} (tapes : EntryLookupRestoreTapes n) : + tapes.resetIdx 5 = tapes.scan.entry.valueWidth := rfl + +@[simp] theorem resetIdx_six {n : ℕ} (tapes : EntryLookupRestoreTapes n) : + tapes.resetIdx 6 = tapes.scan.entry.result := rfl + +@[simp] theorem resetIdx_seven {n : ℕ} (tapes : EntryLookupRestoreTapes n) : + tapes.resetIdx 7 = tapes.scan.entry.query := rfl + +@[simp] theorem resetIdx_eight {n : ℕ} (tapes : EntryLookupRestoreTapes n) : + tapes.resetIdx 8 = tapes.scan.count := rfl + +end EntryLookupRestoreTapes + +/-- Scanner-owned tapes reset after copying out a lookup result. The encoded +source is deliberately excluded because it is read-only and merely rewound. -/ +def entryLookupResetTargets {n : ℕ} (tapes : EntryLookupRestoreTapes n) : + List (Fin n) := + List.ofFn tapes.resetIdx + +/-- Width envelope for every binary scratch value at a successful hit on one +entry. -/ +def entryLookupEntryWidth (entry : Entry) (address : ℕ) : ℕ := + max address.bits.length + (max entry.1.bits.length + (max entry.2.bits.length + (max (bitlen entry.1) + (max (bitlen entry.2) 1)))) + +/-- Width envelope contributed by possible hit entries in a complete store. -/ +def entryLookupStoreWidth (address : ℕ) : Store → ℕ + | [] => address.bits.length + | entry :: rest => + max (entryLookupEntryWidth entry address) + (entryLookupStoreWidth address rest) + +/-- Width envelope for every hit or miss reset target in a complete store. -/ +def entryLookupResetWidth (store : Store) (address : ℕ) : ℕ := + max store.length.bits.length (entryLookupStoreWidth address store) + +/-- Exact reset contents at a successful lookup endpoint. -/ +def entryLookupFoundBits {n : ℕ} (tapes : EntryLookupRestoreTapes n) + (entry : Entry) (remaining address : ℕ) (i : Fin n) : List Bool := + if i = tapes.scan.entry.query then address.bits + else if i = tapes.scan.count then remaining.bits + else entryMissBits tapes.scan.entry entry address.bits i + +/-- Exact reset contents at an unsuccessful lookup endpoint. -/ +def entryLookupMissBits {n : ℕ} (tapes : EntryLookupRestoreTapes n) + (address : ℕ) (i : Fin n) : List Bool := + if i = tapes.scan.entry.query then address.bits else [] + +-- These repetitive projection simplifications intentionally share one stable +-- simp set; individual cases use different subsets of it. +@[simp] theorem entryLookupFoundBits_zero {n : ℕ} + (tapes : EntryLookupRestoreTapes n) (entry : Entry) + (remaining address : ℕ) : + entryLookupFoundBits tapes entry remaining address + tapes.scan.entry.address = + entry.1.bits := by + simp [entryLookupFoundBits, entryMissBits, EntryLookupRestoreTapes.resetIdx, + EntryLookupRestoreTapes.resetSlot, EntryMatchTapes.address, + EntryMatchTapes.value, EntryMatchTapes.addressCounter, + EntryMatchTapes.addressWidth, EntryMatchTapes.valueCounter, + EntryMatchTapes.valueWidth, EntryMatchTapes.query, EntryMatchTapes.result, + tapes.injective.eq_iff] + +@[simp] theorem entryLookupFoundBits_one {n : ℕ} + (tapes : EntryLookupRestoreTapes n) (entry : Entry) + (remaining address : ℕ) : + entryLookupFoundBits tapes entry remaining address tapes.scan.entry.value = + entry.2.bits := by + simp [entryLookupFoundBits, entryMissBits, EntryLookupRestoreTapes.resetIdx, + EntryLookupRestoreTapes.resetSlot, EntryMatchTapes.address, + EntryMatchTapes.value, EntryMatchTapes.addressCounter, + EntryMatchTapes.addressWidth, EntryMatchTapes.valueCounter, + EntryMatchTapes.valueWidth, EntryMatchTapes.query, EntryMatchTapes.result, + tapes.injective.eq_iff] + +@[simp] theorem entryLookupFoundBits_two {n : ℕ} + (tapes : EntryLookupRestoreTapes n) (entry : Entry) + (remaining address : ℕ) : + entryLookupFoundBits tapes entry remaining address + tapes.scan.entry.addressCounter = + List.replicate (bitlen entry.1) true := by + simp [entryLookupFoundBits, entryMissBits, EntryLookupRestoreTapes.resetIdx, + EntryLookupRestoreTapes.resetSlot, EntryMatchTapes.address, + EntryMatchTapes.value, EntryMatchTapes.addressCounter, + EntryMatchTapes.addressWidth, EntryMatchTapes.valueCounter, + EntryMatchTapes.valueWidth, EntryMatchTapes.query, EntryMatchTapes.result, + tapes.injective.eq_iff] + +@[simp] theorem entryLookupFoundBits_three {n : ℕ} + (tapes : EntryLookupRestoreTapes n) (entry : Entry) + (remaining address : ℕ) : + entryLookupFoundBits tapes entry remaining address + tapes.scan.entry.addressWidth = + [] := by + simp [entryLookupFoundBits, entryMissBits, EntryLookupRestoreTapes.resetIdx, + EntryLookupRestoreTapes.resetSlot, EntryMatchTapes.address, + EntryMatchTapes.value, EntryMatchTapes.addressCounter, + EntryMatchTapes.addressWidth, EntryMatchTapes.valueCounter, + EntryMatchTapes.valueWidth, EntryMatchTapes.query, EntryMatchTapes.result, + tapes.injective.eq_iff] + +@[simp] theorem entryLookupFoundBits_four {n : ℕ} + (tapes : EntryLookupRestoreTapes n) (entry : Entry) + (remaining address : ℕ) : + entryLookupFoundBits tapes entry remaining address + tapes.scan.entry.valueCounter = + List.replicate (bitlen entry.2) true := by + simp [entryLookupFoundBits, entryMissBits, EntryLookupRestoreTapes.resetIdx, + EntryLookupRestoreTapes.resetSlot, EntryMatchTapes.address, + EntryMatchTapes.value, EntryMatchTapes.addressCounter, + EntryMatchTapes.addressWidth, EntryMatchTapes.valueCounter, + EntryMatchTapes.valueWidth, EntryMatchTapes.query, EntryMatchTapes.result, + tapes.injective.eq_iff] + +@[simp] theorem entryLookupFoundBits_five {n : ℕ} + (tapes : EntryLookupRestoreTapes n) (entry : Entry) + (remaining address : ℕ) : + entryLookupFoundBits tapes entry remaining address + tapes.scan.entry.valueWidth = + [] := by + simp [entryLookupFoundBits, entryMissBits, EntryLookupRestoreTapes.resetIdx, + EntryLookupRestoreTapes.resetSlot, EntryMatchTapes.address, + EntryMatchTapes.value, EntryMatchTapes.addressCounter, + EntryMatchTapes.addressWidth, EntryMatchTapes.valueCounter, + EntryMatchTapes.valueWidth, EntryMatchTapes.query, EntryMatchTapes.result, + tapes.injective.eq_iff] + +@[simp] theorem entryLookupFoundBits_six {n : ℕ} + (tapes : EntryLookupRestoreTapes n) (entry : Entry) + (remaining address : ℕ) : + entryLookupFoundBits tapes entry remaining address tapes.scan.entry.result = + [decide (entry.1.bits = address.bits)] := by + simp [entryLookupFoundBits, entryMissBits, EntryLookupRestoreTapes.resetIdx, + EntryLookupRestoreTapes.resetSlot, EntryMatchTapes.address, + EntryMatchTapes.value, EntryMatchTapes.addressCounter, + EntryMatchTapes.addressWidth, EntryMatchTapes.valueCounter, + EntryMatchTapes.valueWidth, EntryMatchTapes.query, EntryMatchTapes.result, + tapes.injective.eq_iff] + +@[simp] theorem entryLookupFoundBits_seven {n : ℕ} + (tapes : EntryLookupRestoreTapes n) (entry : Entry) + (remaining address : ℕ) : + entryLookupFoundBits tapes entry remaining address tapes.scan.entry.query = + address.bits := by + simp [entryLookupFoundBits, EntryLookupRestoreTapes.resetIdx, + EntryLookupRestoreTapes.resetSlot, EntryMatchTapes.query, + tapes.injective.eq_iff] + +@[simp] theorem entryLookupFoundBits_eight {n : ℕ} + (tapes : EntryLookupRestoreTapes n) (entry : Entry) + (remaining address : ℕ) : + entryLookupFoundBits tapes entry remaining address (tapes.idx 9) = + remaining.bits := by + simp [entryLookupFoundBits, EntryLookupRestoreTapes.resetIdx, + EntryLookupRestoreTapes.resetSlot, EntryMatchTapes.query, + tapes.injective.eq_iff] + +@[simp] theorem entryLookupMissBits_seven {n : ℕ} + (tapes : EntryLookupRestoreTapes n) (address : ℕ) : + entryLookupMissBits tapes address tapes.scan.entry.query = address.bits := by + simp [entryLookupMissBits, EntryLookupRestoreTapes.resetIdx, + EntryLookupRestoreTapes.resetSlot, EntryMatchTapes.query, + tapes.injective.eq_iff] + +@[simp] theorem entryLookupMissBits_zero {n : ℕ} + (tapes : EntryLookupRestoreTapes n) (address : ℕ) : + entryLookupMissBits tapes address tapes.scan.entry.address = [] := by + simp [entryLookupMissBits, EntryMatchTapes.address, EntryMatchTapes.query, + tapes.injective.eq_iff] + +@[simp] theorem entryLookupMissBits_one {n : ℕ} + (tapes : EntryLookupRestoreTapes n) (address : ℕ) : + entryLookupMissBits tapes address tapes.scan.entry.value = [] := by + simp [entryLookupMissBits, EntryMatchTapes.value, EntryMatchTapes.query, + tapes.injective.eq_iff] + +@[simp] theorem entryLookupMissBits_two {n : ℕ} + (tapes : EntryLookupRestoreTapes n) (address : ℕ) : + entryLookupMissBits tapes address tapes.scan.entry.addressCounter = [] := by + simp [entryLookupMissBits, EntryMatchTapes.addressCounter, + EntryMatchTapes.query, tapes.injective.eq_iff] + +@[simp] theorem entryLookupMissBits_three {n : ℕ} + (tapes : EntryLookupRestoreTapes n) (address : ℕ) : + entryLookupMissBits tapes address tapes.scan.entry.addressWidth = [] := by + simp [entryLookupMissBits, EntryMatchTapes.addressWidth, + EntryMatchTapes.query, tapes.injective.eq_iff] + +@[simp] theorem entryLookupMissBits_four {n : ℕ} + (tapes : EntryLookupRestoreTapes n) (address : ℕ) : + entryLookupMissBits tapes address tapes.scan.entry.valueCounter = [] := by + simp [entryLookupMissBits, EntryMatchTapes.valueCounter, + EntryMatchTapes.query, tapes.injective.eq_iff] + +@[simp] theorem entryLookupMissBits_five {n : ℕ} + (tapes : EntryLookupRestoreTapes n) (address : ℕ) : + entryLookupMissBits tapes address tapes.scan.entry.valueWidth = [] := by + simp [entryLookupMissBits, EntryMatchTapes.valueWidth, + EntryMatchTapes.query, tapes.injective.eq_iff] + +@[simp] theorem entryLookupMissBits_six {n : ℕ} + (tapes : EntryLookupRestoreTapes n) (address : ℕ) : + entryLookupMissBits tapes address tapes.scan.entry.result = [] := by + simp [entryLookupMissBits, EntryMatchTapes.result, EntryMatchTapes.query, + tapes.injective.eq_iff] + +@[simp] theorem entryLookupMissBits_eight {n : ℕ} + (tapes : EntryLookupRestoreTapes n) (address : ℕ) : + entryLookupMissBits tapes address (tapes.idx 9) = [] := by + simp [entryLookupMissBits, EntryMatchTapes.query, tapes.injective.eq_iff] + +@[simp] theorem entryLookupMissBits_other {n : ℕ} + (tapes : EntryLookupRestoreTapes n) (address : ℕ) (slot : Fin 9) + (hslot : slot ≠ 7) : + entryLookupMissBits tapes address (tapes.resetIdx slot) = [] := by + fin_cases slot <;> + simp_all [entryLookupMissBits, EntryLookupRestoreTapes.resetIdx, + EntryLookupRestoreTapes.resetSlot, EntryMatchTapes.query, + tapes.injective.eq_iff] + +end Machine + +end RegisterStore + +end RAM + +end Complexity From 3d88daa8c9c3237fa9a3057bad133ebee6408f5f Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Fri, 25 Sep 2026 20:55:21 +0000 Subject: [PATCH 34/49] Factor deletion and replacement invariants with their exact branch budget --- .../Machine/EntryUpdate/Internal/Hit.lean | 309 +++++++++++------- 1 file changed, 184 insertions(+), 125 deletions(-) diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Hit.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Hit.lean index a5fb281a04..7e4993b5f3 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Hit.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Hit.lean @@ -34,6 +34,115 @@ namespace Machine variable {n : ℕ} +/-- Deletion and both counter decrements restore the complete next-iteration invariant. -/ +private theorem entryUpdateDelete_finalInvariant + (tapes : EntryUpdateTapes n) (store : Store) (address : ℕ) + (processed emitted : Store) (entry : Entry) (rest : Store) (resultCount : ℕ) + (initialWork work deleteWork countWork remainingWork : Fin n → Tape) + (hinv : EntryUpdateLoopInv tapes store address 0 processed + (entry :: rest) emitted false resultCount initialWork work) + (haddress : address = entry.1) + (hfoundZero : (work tapes.found).HasBinaryNat 0) + (hdeleteReady : EntryScanReady tapes.entry (rest.flatMap Entry.encode) address.bits + (entryUpdateMarkFoundWork tapes work) deleteWork) + (hcountOther : ∀ i, i ≠ tapes.resultCount → countWork i = deleteWork i) + (hcountValue : (countWork tapes.resultCount).HasBinaryNat (resultCount - 1)) + (hremainingOther : ∀ i, i ≠ tapes.remaining → remainingWork i = countWork i) + (hremainingValue : (remainingWork tapes.remaining).HasBinaryNat rest.length) : + EntryUpdateLoopInv tapes store address 0 (processed ++ [entry]) rest + emitted true (resultCount - 1) initialWork remainingWork := by + have hreadyCount := hdeleteReady.change_resultCount_internal hcountOther hcountValue + have hreadyFinal := hreadyCount.change_remaining_internal hremainingOther hremainingValue + have hreplacementEq : + remainingWork tapes.replacement = + initialWork tapes.replacement := by + rw [hremainingOther tapes.replacement + (Ne.symm tapes.remaining_ne_replacement)] + rw [hcountOther tapes.replacement tapes.replacement_ne_resultCount] + rw [hdeleteReady.frame_outside_entry_internal tapes.replacement + tapes.replacement_ne_entry] + rw [entryUpdateMarkFoundWork_apply_ne_internal tapes work + tapes.replacement tapes.replacement_ne_found] + exact hinv.replacement_eq + have hreplacementFinal : + (remainingWork tapes.replacement).HasBinaryNat 0 := by + rw [hreplacementEq] + rw [← hinv.replacement_eq] + exact hinv.replacement + have hfoundFinal : + (remainingWork tapes.found).HasBinaryNat 1 := by + rw [hremainingOther tapes.found + (Ne.symm tapes.remaining_ne_found)] + rw [hcountOther tapes.found tapes.found_ne_resultCount] + rw [hdeleteReady.frame_outside_entry_internal tapes.found + tapes.found_ne_entry] + exact entryUpdateMarkFoundWork_found_one_internal tapes work hfoundZero + have hresultFinal : + (remainingWork tapes.resultCount).HasBinaryNat + (resultCount - 1) := by + rw [hremainingOther tapes.resultCount + (Ne.symm tapes.remaining_ne_resultCount)] + exact hcountValue + have hframeMarked := hinv.frame.markFound_internal + have hframeDelete := + EntryUpdateFrame.trans_ready_internal hframeMarked hdeleteReady + have hframeCount := EntryUpdateFrame.trans_single_internal hframeDelete + (12 : Fin 13) (by + intro i hi + exact hcountOther i (by + simpa [EntryUpdateTapes.resultCount] using hi)) + have hframeFinal := EntryUpdateFrame.trans_single_internal hframeCount + (9 : Fin 13) (by + intro i hi + exact hremainingOther i (by + simpa [EntryUpdateTapes.remaining] using hi)) + have hprogress := hinv.progress.delete_internal haddress + have hinvFinal : EntryUpdateLoopInv tapes store address 0 + (processed ++ [entry]) rest emitted true (resultCount - 1) + initialWork remainingWork := + { progress := hprogress + ready := hreadyFinal + replacement := hreplacementFinal + replacement_eq := hreplacementEq + remainingCount := hremainingValue + foundCount := by simpa using hfoundFinal + resultCountTape := hresultFinal + resultCount_le := (Nat.sub_le resultCount 1).trans hinv.resultCount_le + frame := hframeFinal } + exact hinvFinal + +/-- A bounded positive result counter and ready cleanup fit the controller's deletion budget. -/ +private theorem entryUpdateDelete_branchBudget + (tapes : EntryUpdateTapes n) (entry : Entry) (rest : Store) + (address resultCount total deleteTime : ℕ) (readyWork : Fin n → Tape) + (hreadyMarked : EntryScanReady tapes.entry + (Entry.encode entry ++ rest.flatMap Entry.encode) address.bits readyWork readyWork) + (hdeleteTime : deleteTime ≤ entryMissCleanupTime tapes.entry entry address.bits readyWork) + (hresultPositive : 0 < resultCount) (hresultCountLe : resultCount ≤ total) : + deleteTime + 1 + TM.binaryPredTime (resultCount - 1) + 1 ≤ + entryUpdateBranchTime tapes entry address 0 total := by + have hcleanupBound : deleteTime ≤ + entryUpdateReadyCleanupTime tapes entry address := by + rw [← entryMissCleanupTime_eq_entryUpdateReadyCleanupTime_internal + tapes entry address hreadyMarked] + exact hdeleteTime + have hcountBound : TM.binaryPredTime (resultCount - 1) ≤ + entryUpdateCountTime total := by + apply binaryPredTime_le_entryUpdateCountTime_internal + calc + resultCount - 1 + 1 = resultCount := by omega + _ ≤ total := hresultCountLe + have hdeleteBranchBound : + deleteTime + 1 + TM.binaryPredTime (resultCount - 1) + 1 ≤ + entryUpdateBranchTime tapes entry address 0 total := by + have hthird : entryUpdateReadyCleanupTime tapes entry address + 1 + + entryUpdateCountTime total + 1 ≤ + entryUpdateBranchTime tapes entry address 0 total := by + unfold entryUpdateBranchTime + exact (le_max_right _ _).trans (le_max_right _ _) + omega + exact hdeleteBranchBound + /-- A matching zero write deletes the current entry, decrements both runtime counters, and returns to the loop test with no output contribution. -/ theorem entryUpdateDeleteIteration_internal @@ -173,8 +282,6 @@ theorem entryUpdateDeleteIteration_internal have hcountSeam := entryUpdateTM_step_deleteCount_halt_internal tapes countDone hcountHalt hcountInputParked hcountWorkParked hcountOutputParked - have hreadyCount := hdeleteReady.change_resultCount_internal - hcountOther hcountValue have hcountRemaining : (countDone.work tapes.remaining).HasBinaryNat (rest.length + 1) := by rw [hcountOther tapes.remaining tapes.remaining_ne_resultCount] @@ -209,8 +316,6 @@ theorem entryUpdateDeleteIteration_internal have hloop := entryUpdateTM_step_remaining_halt_internal tapes remainingDone hremainingHalt hremainingInputParked hremainingWorkParked hremainingOutputParked - have hreadyFinal := hreadyCount.change_remaining_internal - hremainingOther hremainingValue have hprefix : (entryUpdateTM tapes).reachesIn (matchTime + 1) (entryUpdateTestCfg tapes inp work out) (entryUpdateMatchWrap tapes matchDone) := @@ -242,53 +347,93 @@ theorem entryUpdateDeleteIteration_internal have houtputEq : remainingDone.output = out := hremainingOutput.trans (hcountOutput.trans (hdeleteOutput.trans hmatchOutput)) - have hreplacementEq : - remainingDone.work tapes.replacement = - initialWork tapes.replacement := by + have hinvFinal := entryUpdateDelete_finalInvariant tapes store address processed emitted + entry rest resultCount initialWork work deleteDone.work countDone.work remainingDone.work + hinv haddress hfoundZero hdeleteReady hcountOther hcountValue + hremainingOther hremainingValue + have hdeleteBranchBound := entryUpdateDelete_branchBudget tapes entry rest address + resultCount store.length deleteTime (entryUpdateMarkFoundWork tapes work) + hreadyMarked hdeleteTime hresultPositive hinv.resultCount_le + refine ⟨remainingDone.work, remainingDone.output, + matchTime + 1 + 1 + deleteTime + 1 + + TM.binaryPredTime (resultCount - 1) + 1 + + TM.binaryPredTime rest.length + 1, + ?_, ?_, hinvFinal, ?_⟩ + · unfold entryUpdateIterationTime entryUpdateBranchTime + omega + · simpa [hinputEq, Nat.add_assoc] using htotalReach + · rw [houtputEq] + exact houtput + +/-- Replacement and the remaining-count decrement restore the next-iteration invariant. -/ +private theorem entryUpdateReplace_finalInvariant + (tapes : EntryUpdateTapes n) (store : Store) (address newValue : ℕ) + (processed emitted : Store) (entry : Entry) (rest : Store) (resultCount : ℕ) + (initialWork work matchedWork replaceWork remainingWork : Fin n → Tape) + (hinv : EntryUpdateLoopInv tapes store address newValue processed + (entry :: rest) emitted false resultCount initialWork work) + (haddress : address = entry.1) (hvalue : newValue ≠ 0) + (hfoundZero : (work tapes.found).HasBinaryNat 0) + (hmatchReplacement : matchedWork tapes.replacement = work tapes.replacement) + (hreplaceReady : EntryScanReady tapes.entry (rest.flatMap Entry.encode) address.bits + (entryUpdateMarkFoundWork tapes work) replaceWork) + (hreplaceReplacement : replaceWork tapes.replace.replacement = + entryUpdateMarkFoundWork tapes matchedWork tapes.replace.replacement) + (hremainingOther : ∀ i, i ≠ tapes.remaining → remainingWork i = replaceWork i) + (hremainingValue : (remainingWork tapes.remaining).HasBinaryNat rest.length) : + EntryUpdateLoopInv tapes store address newValue (processed ++ [entry]) rest + (emitted ++ [(address, newValue)]) true resultCount initialWork remainingWork := by + have hreadyFinal := hreplaceReady.change_remaining_internal hremainingOther hremainingValue + have hreplacementWorkEq : + remainingWork tapes.replacement = work tapes.replacement := by rw [hremainingOther tapes.replacement (Ne.symm tapes.remaining_ne_replacement)] - rw [hcountOther tapes.replacement tapes.replacement_ne_resultCount] - rw [hdeleteReady.frame_outside_entry_internal tapes.replacement - tapes.replacement_ne_entry] - rw [entryUpdateMarkFoundWork_apply_ne_internal tapes work + have hreplaceReplacement' : + replaceWork tapes.replacement = + entryUpdateMarkFoundWork tapes matchedWork + tapes.replacement := by + simpa only [EntryUpdateTapes.replace_replacement] using + hreplaceReplacement + rw [hreplaceReplacement'] + rw [entryUpdateMarkFoundWork_apply_ne_internal tapes matchedWork tapes.replacement tapes.replacement_ne_found] - exact hinv.replacement_eq + exact hmatchReplacement + have hreplacementEq : + remainingWork tapes.replacement = + initialWork tapes.replacement := + hreplacementWorkEq.trans hinv.replacement_eq have hreplacementFinal : - (remainingDone.work tapes.replacement).HasBinaryNat 0 := by - rw [hreplacementEq] - rw [← hinv.replacement_eq] + (remainingWork tapes.replacement).HasBinaryNat newValue := by + rw [hreplacementWorkEq] exact hinv.replacement have hfoundFinal : - (remainingDone.work tapes.found).HasBinaryNat 1 := by + (remainingWork tapes.found).HasBinaryNat 1 := by rw [hremainingOther tapes.found (Ne.symm tapes.remaining_ne_found)] - rw [hcountOther tapes.found tapes.found_ne_resultCount] - rw [hdeleteReady.frame_outside_entry_internal tapes.found + rw [hreplaceReady.frame_outside_entry_internal tapes.found tapes.found_ne_entry] exact entryUpdateMarkFoundWork_found_one_internal tapes work hfoundZero have hresultFinal : - (remainingDone.work tapes.resultCount).HasBinaryNat - (resultCount - 1) := by + (remainingWork tapes.resultCount).HasBinaryNat resultCount := by rw [hremainingOther tapes.resultCount (Ne.symm tapes.remaining_ne_resultCount)] - exact hcountValue + rw [hreplaceReady.frame_outside_entry_internal tapes.resultCount + tapes.resultCount_ne_entry] + rw [entryUpdateMarkFoundWork_apply_ne_internal tapes work + tapes.resultCount (Ne.symm tapes.found_ne_resultCount)] + exact hinv.resultCountTape have hframeMarked := hinv.frame.markFound_internal - have hframeDelete := - EntryUpdateFrame.trans_ready_internal hframeMarked hdeleteReady - have hframeCount := EntryUpdateFrame.trans_single_internal hframeDelete - (12 : Fin 13) (by - intro i hi - exact hcountOther i (by - simpa [EntryUpdateTapes.resultCount] using hi)) - have hframeFinal := EntryUpdateFrame.trans_single_internal hframeCount + have hframeReplace := + EntryUpdateFrame.trans_ready_internal hframeMarked hreplaceReady + have hframeFinal := EntryUpdateFrame.trans_single_internal hframeReplace (9 : Fin 13) (by intro i hi exact hremainingOther i (by simpa [EntryUpdateTapes.remaining] using hi)) - have hprogress := hinv.progress.delete_internal haddress - have hinvFinal : EntryUpdateLoopInv tapes store address 0 - (processed ++ [entry]) rest emitted true (resultCount - 1) - initialWork remainingDone.work := + have hprogress := hinv.progress.replace_internal haddress hvalue + have hinvFinal : EntryUpdateLoopInv tapes store address newValue + (processed ++ [entry]) rest (emitted ++ [(address, newValue)]) true + resultCount initialWork remainingWork := { progress := hprogress ready := hreadyFinal replacement := hreplacementFinal @@ -296,38 +441,9 @@ theorem entryUpdateDeleteIteration_internal remainingCount := hremainingValue foundCount := by simpa using hfoundFinal resultCountTape := hresultFinal - resultCount_le := (Nat.sub_le resultCount 1).trans hinv.resultCount_le + resultCount_le := hinv.resultCount_le frame := hframeFinal } - have hcleanupBound : deleteTime ≤ - entryUpdateReadyCleanupTime tapes entry address := by - rw [← entryMissCleanupTime_eq_entryUpdateReadyCleanupTime_internal - tapes entry address hreadyMarked] - exact hdeleteTime - have hcountBound : TM.binaryPredTime (resultCount - 1) ≤ - entryUpdateCountTime store.length := by - apply binaryPredTime_le_entryUpdateCountTime_internal - calc - resultCount - 1 + 1 = resultCount := by omega - _ ≤ store.length := hinv.resultCount_le - have hdeleteBranchBound : - deleteTime + 1 + TM.binaryPredTime (resultCount - 1) + 1 ≤ - entryUpdateBranchTime tapes entry address 0 store.length := by - have hthird : entryUpdateReadyCleanupTime tapes entry address + 1 + - entryUpdateCountTime store.length + 1 ≤ - entryUpdateBranchTime tapes entry address 0 store.length := by - unfold entryUpdateBranchTime - exact (le_max_right _ _).trans (le_max_right _ _) - omega - refine ⟨remainingDone.work, remainingDone.output, - matchTime + 1 + 1 + deleteTime + 1 + - TM.binaryPredTime (resultCount - 1) + 1 + - TM.binaryPredTime rest.length + 1, - ?_, ?_, hinvFinal, ?_⟩ - · unfold entryUpdateIterationTime entryUpdateBranchTime - omega - · simpa [hinputEq, Nat.add_assoc] using htotalReach - · rw [houtputEq] - exact houtput + exact hinvFinal /-- A matching nonzero write emits the replacement entry, records the hit, decrements the remaining-entry counter, and returns to the loop test. -/ @@ -479,8 +595,6 @@ theorem entryUpdateReplaceIteration_internal have hloop := entryUpdateTM_step_remaining_halt_internal tapes remainingDone hremainingHalt hremainingInputParked hremainingWorkParked hremainingOutputParked - have hreadyFinal := hreplaceReady.change_remaining_internal - hremainingOther hremainingValue have hprefix : (entryUpdateTM tapes).reachesIn (matchTime + 1) (entryUpdateTestCfg tapes inp work out) (entryUpdateMatchWrap tapes matchDone) := @@ -504,65 +618,10 @@ theorem entryUpdateReplaceIteration_internal hthroughRemaining (.step hloop .zero) have hinputEq : remainingDone.input = inp := hremainingInput.trans (hreplaceInput.trans hmatchInput) - have hreplacementWorkEq : - remainingDone.work tapes.replacement = work tapes.replacement := by - rw [hremainingOther tapes.replacement - (Ne.symm tapes.remaining_ne_replacement)] - have hreplaceReplacement' : - replaceDone.work tapes.replacement = - entryUpdateMarkFoundWork tapes matchDone.work - tapes.replacement := by - simpa only [EntryUpdateTapes.replace_replacement] using - hreplaceReplacement - rw [hreplaceReplacement'] - rw [entryUpdateMarkFoundWork_apply_ne_internal tapes matchDone.work - tapes.replacement tapes.replacement_ne_found] - exact hmatchReplacement - have hreplacementEq : - remainingDone.work tapes.replacement = - initialWork tapes.replacement := - hreplacementWorkEq.trans hinv.replacement_eq - have hreplacementFinal : - (remainingDone.work tapes.replacement).HasBinaryNat newValue := by - rw [hreplacementWorkEq] - exact hinv.replacement - have hfoundFinal : - (remainingDone.work tapes.found).HasBinaryNat 1 := by - rw [hremainingOther tapes.found - (Ne.symm tapes.remaining_ne_found)] - rw [hreplaceReady.frame_outside_entry_internal tapes.found - tapes.found_ne_entry] - exact entryUpdateMarkFoundWork_found_one_internal tapes work hfoundZero - have hresultFinal : - (remainingDone.work tapes.resultCount).HasBinaryNat resultCount := by - rw [hremainingOther tapes.resultCount - (Ne.symm tapes.remaining_ne_resultCount)] - rw [hreplaceReady.frame_outside_entry_internal tapes.resultCount - tapes.resultCount_ne_entry] - rw [entryUpdateMarkFoundWork_apply_ne_internal tapes work - tapes.resultCount (Ne.symm tapes.found_ne_resultCount)] - exact hinv.resultCountTape - have hframeMarked := hinv.frame.markFound_internal - have hframeReplace := - EntryUpdateFrame.trans_ready_internal hframeMarked hreplaceReady - have hframeFinal := EntryUpdateFrame.trans_single_internal hframeReplace - (9 : Fin 13) (by - intro i hi - exact hremainingOther i (by - simpa [EntryUpdateTapes.remaining] using hi)) - have hprogress := hinv.progress.replace_internal haddress hvalue - have hinvFinal : EntryUpdateLoopInv tapes store address newValue - (processed ++ [entry]) rest (emitted ++ [(address, newValue)]) true - resultCount initialWork remainingDone.work := - { progress := hprogress - ready := hreadyFinal - replacement := hreplacementFinal - replacement_eq := hreplacementEq - remainingCount := hremainingValue - foundCount := by simpa using hfoundFinal - resultCountTape := hresultFinal - resultCount_le := hinv.resultCount_le - frame := hframeFinal } + have hinvFinal := entryUpdateReplace_finalInvariant tapes store address newValue + processed emitted entry rest resultCount initialWork work matchDone.work replaceDone.work + remainingDone.work hinv haddress hvalue hfoundZero hmatchReplacement + hreplaceReady hreplaceReplacement hremainingOther hremainingValue have hreplaceBound : replaceTime ≤ entryUpdateReplaceTime tapes entry address newValue := by exact hreplaceTime.trans From 1c55fb0cc041ac543d871233f384588ade2cdf60 Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Fri, 25 Sep 2026 21:00:14 +0000 Subject: [PATCH 35/49] Isolate framed copying steps and composition tail phases --- .../Composition/Internal/Tail.lean | 347 +++++++++++++----- .../TuringMachine/Subroutines/Internal.lean | 292 ++++++++------- 2 files changed, 406 insertions(+), 233 deletions(-) diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Composition/Internal/Tail.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Composition/Internal/Tail.lean index 20ec2df2f5..136bdc7b77 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Composition/Internal/Tail.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Composition/Internal/Tail.lean @@ -60,27 +60,35 @@ def CompositionTailPre (nf ng : ℕ) (y : List Bool) (B : ℕ) (∀ i : Fin nf, Tape.StartInvariant (work (compositionPrefixIdx nf ng i)) ∧ 1 ≤ (work (compositionPrefixIdx nf ng i)).head) -/-- Generic post-first-computation tail driven by a virtual-input run contract. - -The prefix tapes are arbitrary stable frame tapes. The raw tape may initially -have any head up to `B`, and cells after its first output delimiter may contain -arbitrary junk. The virtual-input tape, second-machine scratch block, and real -output begin in their canonical parked blank shapes. -/ -private theorem compositionTailTM_hoareTime_of_virtualRun_internal - {nf ng : ℕ} (tmG : TM ng) {G : ℕ → ℕ} - (y : List Bool) (B : ℕ) (P : Tape → Prop) - (hG : ∀ realInput : Tape, - ∃ (c' : Cfg (ng + 1) tmG.Q) (t : ℕ), - t ≤ G y.length ∧ - (retargetInputStarted tmG).reachesIn t - (retargetInputStartedCfg tmG y realInput) c' ∧ - (retargetInputStarted tmG).halted c' ∧ P c'.output) : - (compositionTailTM nf ng tmG).HoareTime - (CompositionTailPre nf ng y B) - (fun _inp _work out => P out) - ((B + 2) + 1 + ((y.length + 1) + 1 + - ((y.length + 1 + 2) + 1 + G y.length))) := by - intro inp work out hpre +/-- Rewind raw output while preserving the input, output, and stable work-tape frame. -/ +private theorem compositionTail_rewindRawFrame + {nf ng : ℕ} (y : List Bool) (B : ℕ) + (inp : Tape) (work : Fin (compositionTapeCount nf ng) → Tape) (out : Tape) + (hpre : CompositionTailPre nf ng y B inp work out) : + let raw := compositionRawOutputIdx nf ng + let source : Tape := { head := 1, cells := (work raw).cells } + ∃ (c₁ : Cfg (compositionTapeCount nf ng) (rewindWorkTM raw).Q) (t₁ : ℕ), + (t₁ ≤ B + 2) ∧ + ((rewindWorkTM raw).reachesIn t₁ + { state := (rewindWorkTM raw).qstart, + input := inp, work := work, output := out } c₁) ∧ + ((rewindWorkTM raw).halted c₁) ∧ + (c₁.input = inp) ∧ + (c₁.output = out) ∧ + (∀ i, i ≠ raw → c₁.work i = work i) ∧ + (Tape.StartInvariant out) ∧ + (1 ≤ out.head) ∧ + (∀ i, i ≠ raw → + Tape.StartInvariant (work i) ∧ 1 ≤ (work i).head) ∧ + (c₁.work raw = source) ∧ + (Tape.StartInvariant source) ∧ + (source.HasOutput y) ∧ + (∀ i, Tape.StartInvariant (c₁.work i) ∧ + 1 ≤ (c₁.work i).head) ∧ + (transitionInput c₁.input = c₁.input) ∧ + (transitionTape c₁.output = c₁.output) ∧ + (∀ i, transitionTape (c₁.work i) = c₁.work i) := by + dsimp only rcases hpre with ⟨hrawOutput, hrawInv, hrawBound, hvinBlank, hgBlank, houtBlank, hinv, hinputHead, hprefix⟩ @@ -192,6 +200,62 @@ private theorem compositionTailTM_hoareTime_of_virtualRun_internal intro i exact transitionTape_eq_of_startInvariant (hc₁WorkStable i).1 (hc₁WorkStable i).2 + exact ⟨c₁, t₁, + ht₁, hreach₁, hhalt₁, hc₁Input, hc₁Output, hc₁Other, + houtInv, houtHead, hotherStable, hc₁Raw, hsourceInv, + hsourceOutput, hc₁WorkStable, hc₁InputTr, hc₁OutputTr, hc₁WorkTr⟩ + +/-- Copy raw output to the virtual input and preserve the stable frame for rewinding. -/ +private theorem compositionTail_copyFrame + {nf ng : ℕ} {Q : Type} (y : List Bool) + (inp : Tape) (work : Fin (compositionTapeCount nf ng) → Tape) (out : Tape) + (c₁ : Cfg (compositionTapeCount nf ng) Q) + (hinv : Tape.StartInvariant inp) (hinputHead : 1 ≤ inp.head) + (hvinBlank : work (compositionVirtualInputIdx nf ng) = + (Tape.init []).move Dir3.right) : + let raw := compositionRawOutputIdx nf ng + let vin := compositionVirtualInputIdx nf ng + let source : Tape := { head := 1, cells := (work raw).cells } + (c₁.input = inp) → + (c₁.output = out) → + (∀ i, i ≠ raw → c₁.work i = work i) → + (Tape.StartInvariant out) → + (1 ≤ out.head) → + (∀ i, i ≠ raw → + Tape.StartInvariant (work i) ∧ 1 ≤ (work i).head) → + (c₁.work raw = source) → + (Tape.StartInvariant source) → + (source.HasOutput y) → + (transitionInput c₁.input = c₁.input) → + (transitionTape c₁.output = c₁.output) → + (∀ i, transitionTape (c₁.work i) = c₁.work i) → + ∃ (c₂ : Cfg (compositionTapeCount nf ng) (copyWorkToWorkTM raw vin).Q) (t₂ : ℕ), + (t₂ ≤ y.length + 1) ∧ + ((copyWorkToWorkTM raw vin).reachesIn t₂ + { state := (copyWorkToWorkTM raw vin).qstart, + input := transitionInput c₁.input, + work := fun i => transitionTape (c₁.work i), + output := transitionTape c₁.output } c₂) ∧ + ((copyWorkToWorkTM raw vin).halted c₂) ∧ + (c₂.input = inp) ∧ + (c₂.output = out) ∧ + (∀ i, i ≠ raw → i ≠ vin → c₂.work i = work i) ∧ + ((c₂.work vin).cells = + (Tape.init (y.map Γ.ofBool)).cells) ∧ + (Tape.StartInvariant (c₂.work vin)) ∧ + (∀ i, Tape.StartInvariant (c₂.work i) ∧ + 1 ≤ (c₂.work i).head) ∧ + (transitionInput c₂.input = c₂.input) ∧ + (transitionTape c₂.output = c₂.output) ∧ + (∀ i, transitionTape (c₂.work i) = c₂.work i) ∧ + ((c₂.work vin).head = y.length + 1) := by + dsimp only + intro hc₁Input hc₁Output hc₁Other houtInv houtHead hotherStable + hc₁Raw hsourceInv hsourceOutput hc₁InputTr hc₁OutputTr hc₁WorkTr + let raw := compositionRawOutputIdx nf ng + let vin := compositionVirtualInputIdx nf ng + let source : Tape := { head := 1, cells := (work raw).cells } + have hrawVin : raw ≠ vin := compositionRawOutputIdx_ne_virtualInputIdx nf ng let FrameCopy : TapePred (compositionTapeCount nf ng) := fun inp' work' out' => inp' = inp ∧ out' = out ∧ @@ -284,6 +348,166 @@ private theorem compositionTailTM_hoareTime_of_virtualRun_internal intro i exact transitionTape_eq_of_startInvariant (hc₂WorkStable i).1 (hc₂WorkStable i).2 + exact ⟨c₂, t₂, ht₂, hreach₂, hhalt₂, hc₂Input, hc₂Output, hc₂Other, + hc₂VinCells, hc₂VinInv, hc₂WorkStable, hc₂InputTr, hc₂OutputTr, hc₂WorkTr, + hc₂VinPrefix.1⟩ + +/-- The placed virtual-input configuration equals the restored composition entry frame. -/ +private theorem compositionTail_placedEntry + {nf ng : ℕ} (tmG : TM ng) (y : List Bool) + (work work₂ work₃ : Fin (compositionTapeCount nf ng) → Tape) + (out out₃ input₃ : Tape) + (hgBlank : ∀ j : Fin ng, work (compositionSecondWorkIdx nf ng j) = + (Tape.init []).move Dir3.right) + (hc₂Other : ∀ i, i ≠ compositionRawOutputIdx nf ng → + i ≠ compositionVirtualInputIdx nf ng → work₂ i = work i) + (hc₃Other : ∀ i, i ≠ compositionVirtualInputIdx nf ng → work₃ i = work₂ i) + (hc₃WorkTr : ∀ i, transitionTape (work₃ i) = work₃ i) + (hc₃Vin : work₃ (compositionVirtualInputIdx nf ng) = + (Tape.init (y.map Γ.ofBool)).move Dir3.right) + (houtBlank : out = (Tape.init []).move Dir3.right) + (hc₃Output : out₃ = out) (hc₃OutputTr : transitionTape out₃ = out₃) : + let raw := compositionRawOutputIdx nf ng + let vin := compositionVirtualInputIdx nf ng + let secondPre := 0 + (nf + 1) + let extras : Fin (secondPre + (ng + 1) + 0) → Tape := + fun i => transitionTape (work₃ i) + let realInput := transitionInput input₃ + let gEntry : Cfg (compositionTapeCount nf ng) (compositionSecondTM nf tmG).Q := + { state := (compositionSecondTM nf tmG).qstart + input := transitionInput input₃ + work := fun i => transitionTape (work₃ i) + output := transitionTape out₃ } + placeWorkCfg (retargetInputStarted tmG) secondPre 0 extras + (retargetInputStartedCfg tmG y realInput) = gEntry := by + dsimp only + let raw := compositionRawOutputIdx nf ng + let vin := compositionVirtualInputIdx nf ng + let secondPre := 0 + (nf + 1) + let extras : Fin (secondPre + (ng + 1) + 0) → Tape := + fun i => transitionTape (work₃ i) + let realInput := transitionInput input₃ + let gEntry : Cfg (compositionTapeCount nf ng) (compositionSecondTM nf tmG).Q := + { state := (compositionSecondTM nf tmG).qstart + input := transitionInput input₃ + work := fun i => transitionTape (work₃ i) + output := transitionTape out₃ } + refine Cfg.ext rfl rfl ?_ ?_ + · funext i + by_cases hmid : placeWorkInMiddle secondPre (ng + 1) i + · let j := placeWorkCoord secondPre (ng + 1) i hmid + have hphys : placeWorkIdx secondPre 0 j = i := + placeWorkIdx_placeWorkCoord i hmid + by_cases hj : j.val < ng + · let jG : Fin ng := ⟨j.val, hj⟩ + have hjcast : Fin.castSucc jG = j := by + apply Fin.ext + rfl + have hiVal : i.val = secondPre + j.val := by + have hv := congrArg Fin.val hphys + simp only [placeWorkIdx_val] at hv + omega + have hiRaw : i ≠ raw := by + change i ≠ compositionRawOutputIdx nf ng + intro heq + have hv := congrArg Fin.val heq + simp only [compositionRawOutputIdx_val] at hv + dsimp only [secondPre] at hiVal + omega + have hiVin : i ≠ vin := by + change i ≠ compositionVirtualInputIdx nf ng + intro heq + have hv := congrArg Fin.val heq + simp only [compositionVirtualInputIdx_val] at hv + dsimp only [secondPre] at hiVal + omega + have hblank : work₃ i = (Tape.init []).move Dir3.right := by + calc + work₃ i = work₂ i := hc₃Other i hiVin + _ = work i := hc₂Other i hiRaw hiVin + _ = (Tape.init []).move Dir3.right := by + rw [← hphys, ← hjcast] + exact hgBlank jG + change + (placeWorkCfg (retargetInputStarted tmG) secondPre 0 extras + (retargetInputStartedCfg tmG y realInput)).work i = + transitionTape (work₃ i) + calc + _ = (retargetInputStartedCfg tmG y realInput).work j := by + rw [← hphys, placeWorkCfg_work_middle] + _ = (Tape.init []).move Dir3.right := by + exact retargetInputStartedCfg_work_lt tmG y realInput j hj + _ = transitionTape (work₃ i) := by + rw [hc₃WorkTr i, hblank] + · have hjval : j.val = ng := by + have := j.isLt + omega + have hjlast : j = Fin.last ng := by + apply Fin.ext + simpa using! hjval + have hiVin : i = vin := by + rw [← hphys, hjlast] + exact (compositionVirtualInputIdx_eq_secondPlacedLast nf ng).symm + change + (placeWorkCfg (retargetInputStarted tmG) secondPre 0 extras + (retargetInputStartedCfg tmG y realInput)).work i = + transitionTape (work₃ i) + calc + _ = (retargetInputStartedCfg tmG y realInput).work j := by + rw [← hphys, placeWorkCfg_work_middle] + _ = (Tape.init (y.map Γ.ofBool)).move Dir3.right := by + rw [hjlast] + simp [Fin.last] + _ = transitionTape (work₃ i) := by + rw [hiVin, hc₃WorkTr vin, hc₃Vin] + · change + (placeWorkCfg (retargetInputStarted tmG) secondPre 0 extras + (retargetInputStartedCfg tmG y realInput)).work i = + transitionTape (work₃ i) + rw [placeWorkCfg_work_extra _ _ _ _ _ i hmid] + · change (retargetInputStartedCfg tmG y realInput).output = + transitionTape out₃ + rw [retargetInputStartedCfg_output, hc₃OutputTr, hc₃Output, houtBlank] + +/-- Generic post-first-computation tail driven by a virtual-input run contract. + +The prefix tapes are arbitrary stable frame tapes. The raw tape may initially +have any head up to `B`, and cells after its first output delimiter may contain +arbitrary junk. The virtual-input tape, second-machine scratch block, and real +output begin in their canonical parked blank shapes. -/ +private theorem compositionTailTM_hoareTime_of_virtualRun_internal + {nf ng : ℕ} (tmG : TM ng) {G : ℕ → ℕ} + (y : List Bool) (B : ℕ) (P : Tape → Prop) + (hG : ∀ realInput : Tape, + ∃ (c' : Cfg (ng + 1) tmG.Q) (t : ℕ), + t ≤ G y.length ∧ + (retargetInputStarted tmG).reachesIn t + (retargetInputStartedCfg tmG y realInput) c' ∧ + (retargetInputStarted tmG).halted c' ∧ P c'.output) : + (compositionTailTM nf ng tmG).HoareTime + (CompositionTailPre nf ng y B) + (fun _inp _work out => P out) + ((B + 2) + 1 + ((y.length + 1) + 1 + + ((y.length + 1 + 2) + 1 + G y.length))) := by + intro inp work out hpre + let raw := compositionRawOutputIdx nf ng + let vin := compositionVirtualInputIdx nf ng + let source : Tape := { head := 1, cells := (work raw).cells } + obtain ⟨c₁, t₁, + ht₁, hreach₁, hhalt₁, hc₁Input, hc₁Output, hc₁Other, + houtInv, houtHead, hotherStable, hc₁Raw, hsourceInv, + hsourceOutput, hc₁WorkStable, hc₁InputTr, hc₁OutputTr, hc₁WorkTr⟩ := + compositionTail_rewindRawFrame y B inp work out hpre + rcases hpre with + ⟨hrawOutput, hrawInv, hrawBound, hvinBlank, hgBlank, houtBlank, + hinv, hinputHead, hprefix⟩ + have hrawVin : raw ≠ vin := compositionRawOutputIdx_ne_virtualInputIdx nf ng + obtain ⟨c₂, t₂, ht₂, hreach₂, hhalt₂, hc₂Input, hc₂Output, hc₂Other, + hc₂VinCells, hc₂VinInv, hc₂WorkStable, hc₂InputTr, hc₂OutputTr, hc₂WorkTr, + hc₂VinHead⟩ := + compositionTail_copyFrame y inp work out c₁ hinv hinputHead hvinBlank + hc₁Input hc₁Output hc₁Other houtInv houtHead hotherStable + hc₁Raw hsourceInv hsourceOutput hc₁InputTr hc₁OutputTr hc₁WorkTr let FrameVin : TapePred (compositionTapeCount nf ng) := fun inp' work' out' => (work' vin).cells = (Tape.init (y.map Γ.ofBool)).cells ∧ @@ -318,7 +542,7 @@ private theorem compositionTailTM_hoareTime_of_virtualRun_internal rw [hc₂WorkTr vin] exact hc₂VinInv.2 j hj · change (transitionTape (c₂.work vin)).head ≤ y.length + 1 - rw [hc₂WorkTr vin, hc₂VinPrefix.1] + rw [hc₂WorkTr vin, hc₂VinHead] · rw [hc₂InputTr, hc₂Input] exact read_ne_start_of_startInvariant hinv hinputHead · rw [hc₂OutputTr, hc₂Output] @@ -404,82 +628,9 @@ private theorem compositionTailTM_hoareTime_of_virtualRun_internal have hEntry : placeWorkCfg (retargetInputStarted tmG) secondPre 0 extras (retargetInputStartedCfg tmG y realInput) = gEntry := by - refine Cfg.ext rfl rfl ?_ ?_ - · funext i - by_cases hmid : placeWorkInMiddle secondPre (ng + 1) i - · let j := placeWorkCoord secondPre (ng + 1) i hmid - have hphys : placeWorkIdx secondPre 0 j = i := - placeWorkIdx_placeWorkCoord i hmid - by_cases hj : j.val < ng - · let jG : Fin ng := ⟨j.val, hj⟩ - have hjcast : Fin.castSucc jG = j := by - apply Fin.ext - rfl - have hiVal : i.val = secondPre + j.val := by - have hv := congrArg Fin.val hphys - simp only [placeWorkIdx_val] at hv - omega - have hiRaw : i ≠ raw := by - change i ≠ compositionRawOutputIdx nf ng - intro heq - have hv := congrArg Fin.val heq - simp only [compositionRawOutputIdx_val] at hv - dsimp only [secondPre] at hiVal - omega - have hiVin : i ≠ vin := by - change i ≠ compositionVirtualInputIdx nf ng - intro heq - have hv := congrArg Fin.val heq - simp only [compositionVirtualInputIdx_val] at hv - dsimp only [secondPre] at hiVal - omega - have hblank : c₃.work i = (Tape.init []).move Dir3.right := by - calc - c₃.work i = c₂.work i := hc₃Other i hiVin - _ = work i := hc₂Other i hiRaw hiVin - _ = (Tape.init []).move Dir3.right := by - rw [← hphys, ← hjcast] - exact hgBlank jG - change - (placeWorkCfg (retargetInputStarted tmG) secondPre 0 extras - (retargetInputStartedCfg tmG y realInput)).work i = - transitionTape (c₃.work i) - calc - _ = (retargetInputStartedCfg tmG y realInput).work j := by - rw [← hphys, placeWorkCfg_work_middle] - _ = (Tape.init []).move Dir3.right := by - exact retargetInputStartedCfg_work_lt tmG y realInput j hj - _ = transitionTape (c₃.work i) := by - rw [hc₃WorkTr i, hblank] - · have hjval : j.val = ng := by - have := j.isLt - omega - have hjlast : j = Fin.last ng := by - apply Fin.ext - simpa using! hjval - have hiVin : i = vin := by - rw [← hphys, hjlast] - exact (compositionVirtualInputIdx_eq_secondPlacedLast nf ng).symm - change - (placeWorkCfg (retargetInputStarted tmG) secondPre 0 extras - (retargetInputStartedCfg tmG y realInput)).work i = - transitionTape (c₃.work i) - calc - _ = (retargetInputStartedCfg tmG y realInput).work j := by - rw [← hphys, placeWorkCfg_work_middle] - _ = (Tape.init (y.map Γ.ofBool)).move Dir3.right := by - rw [hjlast] - simp [Fin.last] - _ = transitionTape (c₃.work i) := by - rw [hiVin, hc₃WorkTr vin, hc₃Vin] - · change - (placeWorkCfg (retargetInputStarted tmG) secondPre 0 extras - (retargetInputStartedCfg tmG y realInput)).work i = - transitionTape (c₃.work i) - rw [placeWorkCfg_work_extra _ _ _ _ _ i hmid] - · change (retargetInputStartedCfg tmG y realInput).output = - transitionTape c₃.output - rw [retargetInputStartedCfg_output, hc₃OutputTr, hc₃Output, houtBlank] + exact compositionTail_placedEntry (nf := nf) tmG y work c₂.work c₃.work + out c₃.output c₃.input hgBlank hc₂Other hc₃Other hc₃WorkTr hc₃Vin + houtBlank hc₃Output hc₃OutputTr have hreach₄' : (compositionSecondTM nf tmG).reachesIn t₄ gEntry C₄ := by change (placeWorkTM secondPre 0 (retargetInputStarted tmG)).reachesIn t₄ gEntry C₄ rw [← hEntry] diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/Internal.lean index 9049d58a7f..bda1e56c84 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/Internal.lean @@ -1684,6 +1684,148 @@ theorem copyWorkToWorkTM_started_hoareTime {n : ℕ} (Nat.zero_le _) refine ⟨c', x.length + 1, le_rfl, hreach, hhalt, hsrc_cells, hsrc_head, hprefix⟩ +private theorem copyWorkToWork_idleTape : ∀ (t : Tape), t.read ≠ Γ.start → t.head ≥ 1 → + t.writeAndMove (readBackWrite t.read) (idleDir t.read) = t := by + intro t hns hh + simp only [Tape.writeAndMove, idleDir, hns, ↓reduceIte, Tape.move, Tape.write] + split + · omega + · simp only [Tape.read] at hns ⊢ + rw [toΓ_readBackWrite_of_ne_start hns, Function.update_eq_self] + +private theorem copyWorkToWork_idleInput : ∀ (t : Tape), t.read ≠ Γ.start → + t.move (idleDir t.read) = t := by + intro t hns + simp [idleDir, hns, Tape.move] + +/-- A single copying step advances both tape heads and preserves the complete outside frame. -/ +private theorem copyWorkToWork_copyStep {n : ℕ} + (src dst : Fin n) (hne : src ≠ dst) (x : List Bool) (k : ℕ) (hk_lt : k < x.length) + (inp : Tape) (work : Fin n → Tape) (out : Tape) + (hinp_ns : inp.read ≠ Γ.start) (hout_ns : out.read ≠ Γ.start) (hout_h : out.head ≥ 1) + (hother_wf : ∀ i, i ≠ src → i ≠ dst → (work i).read ≠ Γ.start ∧ (work i).head ≥ 1) + (c : Cfg n (copyWorkToWorkTM src dst).Q) (hstate : c.state = CopyPhase.copying) + (hsrc_cells : (c.work src).cells = (Tape.init (x.map Γ.ofBool)).cells) + (hsrc_head : (c.work src).head = k + 1) + (hprefix : (c.work dst).HasBinaryPrefix (x.take k)) + (hdst_cell0 : (c.work dst).cells 0 = Γ.start) + (hinp_c : c.input = inp) (hout_c : c.output = out) + (hw_c : ∀ i, i ≠ src → i ≠ dst → c.work i = work i) : + ∃ c1 : Cfg n (copyWorkToWorkTM src dst).Q, + (copyWorkToWorkTM src dst).step c = some c1 ∧ c1.state = CopyPhase.copying ∧ + (c1.work src).cells = (Tape.init (x.map Γ.ofBool)).cells ∧ + (c1.work src).head = k + 2 ∧ (c1.work dst).HasBinaryPrefix (x.take (k + 1)) ∧ + (c1.work dst).cells 0 = Γ.start ∧ c1.input = inp ∧ c1.output = out ∧ + (∀ i, i ≠ src → i ≠ dst → c1.work i = work i) := by + have hsrc_read : (c.work src).read = Γ.ofBool (x[k]'hk_lt) := by + simp [Tape.read, hsrc_head, hsrc_cells, Tape.init_ofBool_cells_lt x k hk_lt] + have hprefix_next : + ((c.work dst).writeAndMove (Γ.ofBool (x[k]'hk_lt)) Dir3.right).HasBinaryPrefix + (x.take (k + 1)) := by + have hwrite := Tape.hasBinaryPrefix_write_bit (x[k]'hk_lt) hprefix + simpa [List.take_concat_get' x k hk_lt] using hwrite + cases hbit : x[k]'hk_lt with + | false => + have hread0 : (c.work src).read = Γ.zero := by + simpa [hbit] using! hsrc_read + let c1 : Cfg n (copyWorkToWorkTM src dst).Q := + { state := CopyPhase.copying + input := c.input.move (TM.idleDir c.input.read) + work := fun i => + (c.work i).writeAndMove + ((if i = dst then Γw.zero else TM.readBackWrite ((c.work i).read)).toΓ) + (if i = dst then Dir3.right else if i = src then Dir3.right + else TM.idleDir ((c.work i).read)) + output := c.output.writeAndMove (TM.readBackWrite c.output.read).toΓ + (TM.idleDir c.output.read) } + have hstep1 : (copyWorkToWorkTM src dst).step c = some c1 := by + simp [TM.step, hstate, copyWorkToWorkTM, hread0, c1, TM.readBackWrite] + have hinput_keep : c1.input = inp := by + simpa [c1, hinp_c] using copyWorkToWork_idleInput inp hinp_ns + have houtput_keep : c1.output = out := by + simpa [c1, hout_c] using copyWorkToWork_idleTape out hout_ns hout_h + have hother_keep : ∀ i, i ≠ src → i ≠ dst → c1.work i = work i := by + intro i hi_src hi_dst + simpa [c1, hi_src, hi_dst, hw_c i hi_src hi_dst] using + copyWorkToWork_idleTape (work i) (hother_wf i hi_src hi_dst).1 + (hother_wf i hi_src hi_dst).2 + have hsrc_cells1 : (c1.work src).cells = (Tape.init (x.map Γ.ofBool)).cells := by + have hsrc_ne : (c.work src).read ≠ Γ.start := by + rw [hread0] + decide + have hsrc_pres : + (c1.work src).cells = (c.work src).cells := by + simpa [c1, hread0, hne, TM.readBackWrite] using + (TM.tape_readBackWrite_preserves (c.work src) Dir3.right (Or.inr hsrc_ne)) + rw [hsrc_pres] + exact hsrc_cells + have hsrc_head1 : (c1.work src).head = k + 2 := by + simp [c1, hsrc_head, hne, Tape.writeAndMove, Tape.move, Tape.write_head] + have hdst_prefix1 : (c1.work dst).HasBinaryPrefix (x.take (k + 1)) := by + have hdst : + c1.work dst = (c.work dst).writeAndMove Γ.zero Dir3.right := by + simp [c1] + rw [hdst] + simpa [hbit] using! hprefix_next + have hdst_cell01 : (c1.work dst).cells 0 = Γ.start := by + have hdst : + c1.work dst = (c.work dst).writeAndMove Γ.zero Dir3.right := by + simp [c1] + rw [hdst] + exact Tape.hasBinaryPrefix_write_bit_cell0 false hprefix hdst_cell0 + exact ⟨c1, hstep1, rfl, hsrc_cells1, hsrc_head1, hdst_prefix1, hdst_cell01, + hinput_keep, houtput_keep, hother_keep⟩ + | true => + have hread1 : (c.work src).read = Γ.one := by + simpa [hbit] using! hsrc_read + let c1 : Cfg n (copyWorkToWorkTM src dst).Q := + { state := CopyPhase.copying + input := c.input.move (TM.idleDir c.input.read) + work := fun i => + (c.work i).writeAndMove + ((if i = dst then Γw.one else TM.readBackWrite ((c.work i).read)).toΓ) + (if i = dst then Dir3.right else if i = src then Dir3.right + else TM.idleDir ((c.work i).read)) + output := c.output.writeAndMove (TM.readBackWrite c.output.read).toΓ + (TM.idleDir c.output.read) } + have hstep1 : (copyWorkToWorkTM src dst).step c = some c1 := by + simp [TM.step, hstate, copyWorkToWorkTM, hread1, c1, TM.readBackWrite] + have hinput_keep : c1.input = inp := by + simpa [c1, hinp_c] using copyWorkToWork_idleInput inp hinp_ns + have houtput_keep : c1.output = out := by + simpa [c1, hout_c] using copyWorkToWork_idleTape out hout_ns hout_h + have hother_keep : ∀ i, i ≠ src → i ≠ dst → c1.work i = work i := by + intro i hi_src hi_dst + simpa [c1, hi_src, hi_dst, hw_c i hi_src hi_dst] using + copyWorkToWork_idleTape (work i) (hother_wf i hi_src hi_dst).1 + (hother_wf i hi_src hi_dst).2 + have hsrc_cells1 : (c1.work src).cells = (Tape.init (x.map Γ.ofBool)).cells := by + have hsrc_ne : (c.work src).read ≠ Γ.start := by + rw [hread1] + decide + have hsrc_pres : + (c1.work src).cells = (c.work src).cells := by + simpa [c1, hread1, hne, TM.readBackWrite] using + (TM.tape_readBackWrite_preserves (c.work src) Dir3.right (Or.inr hsrc_ne)) + rw [hsrc_pres] + exact hsrc_cells + have hsrc_head1 : (c1.work src).head = k + 2 := by + simp [c1, hsrc_head, hne, Tape.writeAndMove, Tape.move, Tape.write_head] + have hdst_prefix1 : (c1.work dst).HasBinaryPrefix (x.take (k + 1)) := by + have hdst : + c1.work dst = (c.work dst).writeAndMove Γ.one Dir3.right := by + simp [c1] + rw [hdst] + simpa [hbit] using! hprefix_next + have hdst_cell01 : (c1.work dst).cells 0 = Γ.start := by + have hdst : + c1.work dst = (c.work dst).writeAndMove Γ.one Dir3.right := by + simp [c1] + rw [hdst] + exact Tape.hasBinaryPrefix_write_bit_cell0 true hprefix hdst_cell0 + exact ⟨c1, hstep1, rfl, hsrc_cells1, hsrc_head1, hdst_prefix1, hdst_cell01, + hinput_keep, houtput_keep, hother_keep⟩ + /-- Rich HoareTime for `copyWorkToWorkTM`: copy a started Boolean work tape to another started blank work tape while preserving arbitrary frame data on the input tape, output tape, and all unrelated work tapes. The source cells are @@ -1721,18 +1863,6 @@ theorem copyWorkToWorkTM_hoareTime_frame_of_binaryString {n : ℕ} (x.length + 1) := by intro inp work out hpre rcases hpre with ⟨hsrc, hdst, hinp_ns, hout_ns, hout_h, hother_wf, hP⟩ - have tape_idle_preserve : ∀ (t : Tape), t.read ≠ Γ.start → t.head ≥ 1 → - t.writeAndMove (readBackWrite t.read) (idleDir t.read) = t := by - intro t hns hh - simp only [Tape.writeAndMove, idleDir, hns, ↓reduceIte, Tape.move, Tape.write] - split - · omega - · simp only [Tape.read] at hns ⊢ - rw [toΓ_readBackWrite_of_ne_start hns, Function.update_eq_self] - have input_idle_preserve : ∀ (t : Tape), t.read ≠ Γ.start → - t.move (idleDir t.read) = t := by - intro t hns - simp [idleDir, hns, Tape.move] suffices h_loop : ∀ rem k (c : Cfg n (copyWorkToWorkTM src dst).Q), rem = x.length - k → c.state = CopyPhase.copying → @@ -1809,13 +1939,13 @@ theorem copyWorkToWorkTM_hoareTime_frame_of_binaryString {n : ℕ} have hstep1 : (copyWorkToWorkTM src dst).step c = some c1 := by simp [TM.step, hstate, copyWorkToWorkTM, hsrc_read, c1, allIdle] have hinput_keep : c1.input = inp := by - simpa [c1, hinp_c] using input_idle_preserve inp hinp_ns + simpa [c1, hinp_c] using copyWorkToWork_idleInput inp hinp_ns have houtput_keep : c1.output = out := by - simpa [c1, hout_c] using tape_idle_preserve out hout_ns hout_h + simpa [c1, hout_c] using copyWorkToWork_idleTape out hout_ns hout_h have hother_keep : ∀ i, i ≠ src → i ≠ dst → c1.work i = work i := by intro i hi_src hi_dst simpa [c1, hi_src, hi_dst, hw_c i hi_src hi_dst] using - tape_idle_preserve (work i) (hother_wf i hi_src hi_dst).1 (hother_wf i hi_src hi_dst).2 + copyWorkToWork_idleTape (work i) (hother_wf i hi_src hi_dst).1 (hother_wf i hi_src hi_dst).2 have hsrc_keep : c1.work src = c.work src := by have hsrc_ne : (c.work src).read ≠ Γ.start := by rw [hsrc_read] @@ -1843,126 +1973,18 @@ theorem copyWorkToWorkTM_hoareTime_frame_of_binaryString {n : ℕ} intro k c hrem hstate hsrc_cells hsrc_head hprefix hdst_cell0 hk_le hinp_c hout_c hw_c have hk_lt : k < x.length := by omega - have hsrc_read : (c.work src).read = Γ.ofBool (x[k]'hk_lt) := by - simp [Tape.read, hsrc_head, hsrc_cells, Tape.init_ofBool_cells_lt x k hk_lt] - have hprefix_next : - ((c.work dst).writeAndMove (Γ.ofBool (x[k]'hk_lt)) Dir3.right).HasBinaryPrefix - (x.take (k + 1)) := by - have hwrite := Tape.hasBinaryPrefix_write_bit (x[k]'hk_lt) hprefix - simpa [List.take_concat_get' x k hk_lt] using hwrite - cases hbit : x[k]'hk_lt with - | false => - have hread0 : (c.work src).read = Γ.zero := by - simpa [hbit] using! hsrc_read - let c1 : Cfg n (copyWorkToWorkTM src dst).Q := - { state := CopyPhase.copying - input := c.input.move (TM.idleDir c.input.read) - work := fun i => - (c.work i).writeAndMove - ((if i = dst then Γw.zero else TM.readBackWrite ((c.work i).read)).toΓ) - (if i = dst then Dir3.right else if i = src then Dir3.right - else TM.idleDir ((c.work i).read)) - output := c.output.writeAndMove (TM.readBackWrite c.output.read).toΓ - (TM.idleDir c.output.read) } - have hstep1 : (copyWorkToWorkTM src dst).step c = some c1 := by - simp [TM.step, hstate, copyWorkToWorkTM, hread0, c1, TM.readBackWrite] - have hinput_keep : c1.input = inp := by - simpa [c1, hinp_c] using input_idle_preserve inp hinp_ns - have houtput_keep : c1.output = out := by - simpa [c1, hout_c] using tape_idle_preserve out hout_ns hout_h - have hother_keep : ∀ i, i ≠ src → i ≠ dst → c1.work i = work i := by - intro i hi_src hi_dst - simpa [c1, hi_src, hi_dst, hw_c i hi_src hi_dst] using - tape_idle_preserve (work i) (hother_wf i hi_src hi_dst).1 - (hother_wf i hi_src hi_dst).2 - have hsrc_cells1 : (c1.work src).cells = (Tape.init (x.map Γ.ofBool)).cells := by - have hsrc_ne : (c.work src).read ≠ Γ.start := by - rw [hread0] - decide - have hsrc_pres : - (c1.work src).cells = (c.work src).cells := by - simpa [c1, hread0, hne, TM.readBackWrite] using - (TM.tape_readBackWrite_preserves (c.work src) Dir3.right (Or.inr hsrc_ne)) - rw [hsrc_pres] - exact hsrc_cells - have hsrc_head1 : (c1.work src).head = k + 2 := by - simp [c1, hsrc_head, hne, Tape.writeAndMove, Tape.move, Tape.write_head] - have hdst_prefix1 : (c1.work dst).HasBinaryPrefix (x.take (k + 1)) := by - have hdst : - c1.work dst = (c.work dst).writeAndMove Γ.zero Dir3.right := by - simp [c1] - rw [hdst] - simpa [hbit] using! hprefix_next - have hdst_cell01 : (c1.work dst).cells 0 = Γ.start := by - have hdst : - c1.work dst = (c.work dst).writeAndMove Γ.zero Dir3.right := by - simp [c1] - rw [hdst] - exact Tape.hasBinaryPrefix_write_bit_cell0 false hprefix hdst_cell0 - have hrem1 : rem = x.length - (k + 1) := by - omega - obtain ⟨c', hreach, hhalt, hsrc_cells', hsrc_head', hprefix', hcell0', hinp', - hout', hwork'⟩ := - ih (k + 1) c1 hrem1 rfl hsrc_cells1 hsrc_head1 hdst_prefix1 hdst_cell01 - (by omega) hinput_keep houtput_keep hother_keep - exact ⟨c', .step hstep1 hreach, hhalt, hsrc_cells', hsrc_head', hprefix', hcell0', - hinp', hout', hwork'⟩ - | true => - have hread1 : (c.work src).read = Γ.one := by - simpa [hbit] using! hsrc_read - let c1 : Cfg n (copyWorkToWorkTM src dst).Q := - { state := CopyPhase.copying - input := c.input.move (TM.idleDir c.input.read) - work := fun i => - (c.work i).writeAndMove - ((if i = dst then Γw.one else TM.readBackWrite ((c.work i).read)).toΓ) - (if i = dst then Dir3.right else if i = src then Dir3.right - else TM.idleDir ((c.work i).read)) - output := c.output.writeAndMove (TM.readBackWrite c.output.read).toΓ - (TM.idleDir c.output.read) } - have hstep1 : (copyWorkToWorkTM src dst).step c = some c1 := by - simp [TM.step, hstate, copyWorkToWorkTM, hread1, c1, TM.readBackWrite] - have hinput_keep : c1.input = inp := by - simpa [c1, hinp_c] using input_idle_preserve inp hinp_ns - have houtput_keep : c1.output = out := by - simpa [c1, hout_c] using tape_idle_preserve out hout_ns hout_h - have hother_keep : ∀ i, i ≠ src → i ≠ dst → c1.work i = work i := by - intro i hi_src hi_dst - simpa [c1, hi_src, hi_dst, hw_c i hi_src hi_dst] using - tape_idle_preserve (work i) (hother_wf i hi_src hi_dst).1 - (hother_wf i hi_src hi_dst).2 - have hsrc_cells1 : (c1.work src).cells = (Tape.init (x.map Γ.ofBool)).cells := by - have hsrc_ne : (c.work src).read ≠ Γ.start := by - rw [hread1] - decide - have hsrc_pres : - (c1.work src).cells = (c.work src).cells := by - simpa [c1, hread1, hne, TM.readBackWrite] using - (TM.tape_readBackWrite_preserves (c.work src) Dir3.right (Or.inr hsrc_ne)) - rw [hsrc_pres] - exact hsrc_cells - have hsrc_head1 : (c1.work src).head = k + 2 := by - simp [c1, hsrc_head, hne, Tape.writeAndMove, Tape.move, Tape.write_head] - have hdst_prefix1 : (c1.work dst).HasBinaryPrefix (x.take (k + 1)) := by - have hdst : - c1.work dst = (c.work dst).writeAndMove Γ.one Dir3.right := by - simp [c1] - rw [hdst] - simpa [hbit] using! hprefix_next - have hdst_cell01 : (c1.work dst).cells 0 = Γ.start := by - have hdst : - c1.work dst = (c.work dst).writeAndMove Γ.one Dir3.right := by - simp [c1] - rw [hdst] - exact Tape.hasBinaryPrefix_write_bit_cell0 true hprefix hdst_cell0 - have hrem1 : rem = x.length - (k + 1) := by - omega - obtain ⟨c', hreach, hhalt, hsrc_cells', hsrc_head', hprefix', hcell0', hinp', - hout', hwork'⟩ := - ih (k + 1) c1 hrem1 rfl hsrc_cells1 hsrc_head1 hdst_prefix1 hdst_cell01 - (by omega) hinput_keep houtput_keep hother_keep - exact ⟨c', .step hstep1 hreach, hhalt, hsrc_cells', hsrc_head', hprefix', hcell0', - hinp', hout', hwork'⟩ + obtain ⟨c1, hstep1, hstate1, hsrc_cells1, hsrc_head1, hdst_prefix1, hdst_cell01, + hinput_keep, houtput_keep, hother_keep⟩ := + copyWorkToWork_copyStep src dst hne x k hk_lt inp work out + hinp_ns hout_ns hout_h hother_wf c hstate hsrc_cells hsrc_head + hprefix hdst_cell0 hinp_c hout_c hw_c + have hrem1 : rem = x.length - (k + 1) := by omega + obtain ⟨c', hreach, hhalt, hsrc_cells', hsrc_head', hprefix', hcell0', hinp', + hout', hwork'⟩ := + ih (k + 1) c1 hrem1 hstate1 hsrc_cells1 hsrc_head1 hdst_prefix1 hdst_cell01 + (by omega) hinput_keep houtput_keep hother_keep + exact ⟨c', .step hstep1 hreach, hhalt, hsrc_cells', hsrc_head', hprefix', hcell0', + hinp', hout', hwork'⟩ end TM From c0ec40a49b5e052f261809d93ae67905da45ac5e Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Fri, 25 Sep 2026 21:08:44 +0000 Subject: [PATCH 36/49] Split store updates, gate decoding, and framed blanking proofs --- .../Machine/Instruction/DenseDispatch.lean | 195 +++++++++++------- .../Machine/Instruction/DenseStore.lean | 105 ++++++---- .../Machine/Instruction/Store.lean | 140 +++++++------ .../Structured/GateStep/Internal.lean | 177 ++++++++++------ .../TuringMachine/Subroutines/Internal.lean | 157 +++++++------- 5 files changed, 454 insertions(+), 320 deletions(-) diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseDispatch.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseDispatch.lean index ba3efe0d7c..98fc2f2a95 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseDispatch.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseDispatch.lean @@ -51,6 +51,115 @@ private theorem phaseTransition_of_parked TM.phaseTransition_eq_self_of_reads_ne_start hinput.read_ne_start (fun i => (hwork i).read_ne_start) houtput.read_ne_start +/-- Dispatch's temporary selector update preserves parking of every work tape. -/ +private theorem denseDispatch_work_parked + {tapes : ControlInstructionTapes n} {overlay : Store} {pcValue selector : ℕ} + {cleanWork work₀ : Fin (n + 1) → Tape} + (hready : DispatchReady tapes overlay pcValue selector cleanWork work₀) : + ∀ i, TM.Parked (work₀ i) := by + intro i + rw [hready.2] + by_cases hi : i = tapes.liftedLhs + · subst i + simp only [Function.update_self] + exact hasBinaryNat_parked + (Tape.init_move_right_hasBinaryNat selector) + · simp only [Function.update_of_ne hi] + exact hready.1.control.lookup.scanner.parked i + +/-- A zero dispatch selector leaves the clean work configuration unchanged. -/ +private theorem denseDispatch_zero_work + {tapes : ControlInstructionTapes n} {overlay : Store} {pcValue : ℕ} + {cleanWork work₀ : Fin (n + 1) → Tape} + (hready : DispatchReady tapes overlay pcValue 0 cleanWork work₀) : + work₀ = cleanWork := by + have hcleanLhs := Tape.HasBinaryNat.eq_init_move_right + hready.1.control.lookup.destination + change cleanWork tapes.liftedLhs = + (Tape.init []).move Dir3.right at hcleanLhs + rw [hready.2] + funext i + by_cases hi : i = tapes.liftedLhs + · subst i + simp only [Function.update_self] + exact hcleanLhs.symm + · simp only [Function.update_of_ne hi] + +/-- An empty dense program clears the dispatch selector and executes the halt instruction. -/ +private theorem denseDispatchEmpty_hoareTime + (tapes : ControlInstructionTapes n) + (input : List Bool) (overlay : Store) (pcValue selector : ℕ) + (cleanWork work₀ : Fin (n + 1) → Tape) + (hvalid : DenseOverlay.Valid overlay) + (hready : DispatchReady tapes overlay pcValue selector cleanWork work₀) : + (denseDispatchProgramTM tapes ([] : Program)).HoareTime + (fun inp work out => + inp = (Tape.init (input.map Γ.ofBool)).move Dir3.right ∧ + work = work₀ ∧ out = (Tape.init []).move Dir3.right) + (fun inp work out => + inp = (Tape.init (input.map Γ.ofBool)).move Dir3.right ∧ + DenseInstructionExecutionResult tapes input + (selectedInstruction ([] : Program) selector) pcValue overlay work ∧ + out = (Tape.init []).move Dir3.right) + (denseDispatchProgramTime tapes input overlay pcValue ([] : Program) + selector) := by + let inp₀ := (Tape.init (input.map Γ.ofBool)).move Dir3.right + let out₀ := (Tape.init []).move Dir3.right + have hinput : TM.Parked inp₀ := by + simpa only [inp₀] using! denseInput_parked input + have houtput : TM.Parked out₀ := by + simpa only [out₀] using! blankOutput_parked + let blankTape := (Tape.init []).move Dir3.right + have hselector : (work₀ tapes.liftedLhs).HasBinaryNat selector := by + rw [hready.2] + simp only [Function.update_self] + exact Tape.init_move_right_hasBinaryNat selector + have hcleanLhs : cleanWork tapes.liftedLhs = blankTape := by + have hzero := hready.1.control.lookup.destination + change (cleanWork tapes.liftedLhs).HasBinaryNat 0 at hzero + simpa only [blankTape] using! + Tape.HasBinaryNat.eq_init_move_right hzero + have hwork₀Parked : ∀ i, TM.Parked (work₀ i) := + denseDispatch_work_parked hready + have hreset := TM.resetBinaryWorkTM_hoareTime_frame tapes.liftedLhs + selector.bits 1 inp₀ work₀ out₀ + hselector.2.hasBinaryContent hselector.1 + ⟨by rw [hselector.2.1], by rw [hselector.2.1]⟩ + hinput (fun i _ => hwork₀Parked i) houtput + have hreset' : (TM.resetBinaryWorkTM tapes.liftedLhs).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => + inp = inp₀ ∧ work = cleanWork ∧ out = out₀) + (TM.resetBinaryWorkTime 1 selector.bits.length) := by + apply hreset.consequence + · exact fun _ _ _ h => h + · rintro inp work out ⟨hinp, hworkEq, hout⟩ + refine ⟨hinp, ?_, hout⟩ + rw [hworkEq, hready.2, Function.update_idem] + change Function.update cleanWork tapes.liftedLhs blankTape = + cleanWork + rw [← hcleanLhs, Function.update_eq_self] + · exact le_rfl + have hhalt := denseExecuteInstructionTM_hoareTime_frame tapes input + .halt overlay pcValue cleanWork hvalid hready.1 + have hseq := TM.seqTM_hoareTime + (TM.resetBinaryWorkTM tapes.liftedLhs) + (denseExecuteInstructionTM tapes .halt) hreset' + (by + rintro inp work out ⟨hinp, hworkEq, hout⟩ + obtain ⟨hi, hw, ho⟩ := phaseTransition_of_parked + (inp := inp) (work := work) (out := out) + (by simpa [hinp] using! hinput) + (by simpa [hworkEq] using! + hready.1.control.lookup.scanner.parked) + (by simpa [hout] using! houtput) + rw [hi, hw, ho] + exact ⟨hinp, hworkEq, hout⟩) + hhalt + simpa only [denseDispatchProgramTM, dispatchWithTM, + denseDispatchProgramTime, dispatchWithTime, + selectedInstruction, inp₀, out₀] using! hseq + /-- The decrementing branch tree selects the corresponding dense instruction, including the out-of-range halt convention. -/ theorem denseDispatchProgramTM_hoareTime_frame @@ -78,64 +187,8 @@ theorem denseDispatchProgramTM_hoareTime_frame simpa only [out₀] using! blankOutput_parked induction program generalizing selector work₀ with | nil => - let blankTape := (Tape.init []).move Dir3.right - have hselector : (work₀ tapes.liftedLhs).HasBinaryNat selector := by - rw [hready.2] - simp only [Function.update_self] - exact Tape.init_move_right_hasBinaryNat selector - have hcleanLhs : cleanWork tapes.liftedLhs = blankTape := by - have hzero := hready.1.control.lookup.destination - change (cleanWork tapes.liftedLhs).HasBinaryNat 0 at hzero - simpa only [blankTape] using! - Tape.HasBinaryNat.eq_init_move_right hzero - have hwork₀Parked : ∀ i, TM.Parked (work₀ i) := by - intro i - rw [hready.2] - by_cases hi : i = tapes.liftedLhs - · subst i - simp only [Function.update_self] - exact hasBinaryNat_parked - (Tape.init_move_right_hasBinaryNat selector) - · simp only [Function.update_of_ne hi] - exact hready.1.control.lookup.scanner.parked i - have hreset := TM.resetBinaryWorkTM_hoareTime_frame tapes.liftedLhs - selector.bits 1 inp₀ work₀ out₀ - hselector.2.hasBinaryContent hselector.1 - ⟨by rw [hselector.2.1], by rw [hselector.2.1]⟩ - hinput (fun i _ => hwork₀Parked i) houtput - have hreset' : (TM.resetBinaryWorkTM tapes.liftedLhs).HoareTime - (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) - (fun inp work out => - inp = inp₀ ∧ work = cleanWork ∧ out = out₀) - (TM.resetBinaryWorkTime 1 selector.bits.length) := by - apply hreset.consequence - · exact fun _ _ _ h => h - · rintro inp work out ⟨hinp, hworkEq, hout⟩ - refine ⟨hinp, ?_, hout⟩ - rw [hworkEq, hready.2, Function.update_idem] - change Function.update cleanWork tapes.liftedLhs blankTape = - cleanWork - rw [← hcleanLhs, Function.update_eq_self] - · exact le_rfl - have hhalt := denseExecuteInstructionTM_hoareTime_frame tapes input - .halt overlay pcValue cleanWork hvalid hready.1 - have hseq := TM.seqTM_hoareTime - (TM.resetBinaryWorkTM tapes.liftedLhs) - (denseExecuteInstructionTM tapes .halt) hreset' - (by - rintro inp work out ⟨hinp, hworkEq, hout⟩ - obtain ⟨hi, hw, ho⟩ := phaseTransition_of_parked - (inp := inp) (work := work) (out := out) - (by simpa [hinp] using! hinput) - (by simpa [hworkEq] using! - hready.1.control.lookup.scanner.parked) - (by simpa [hout] using! houtput) - rw [hi, hw, ho] - exact ⟨hinp, hworkEq, hout⟩) - hhalt - simpa only [denseDispatchProgramTM, dispatchWithTM, - denseDispatchProgramTime, dispatchWithTime, - selectedInstruction, inp₀, out₀] using! hseq + exact denseDispatchEmpty_hoareTime tapes input overlay pcValue selector + cleanWork work₀ hvalid hready | cons instruction program ih => let pre : TM.TapePred (n + 1) := fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀ @@ -153,34 +206,16 @@ theorem denseDispatchProgramTM_hoareTime_frame rw [hready.2] simp only [Function.update_self] exact Tape.init_move_right_hasBinaryNat selector - have hwork₀Parked : ∀ i, TM.Parked (work₀ i) := by - intro i - rw [hready.2] - by_cases hi : i = tapes.liftedLhs - · subst i - simp only [Function.update_self] - exact hasBinaryNat_parked - (Tape.init_move_right_hasBinaryNat selector) - · simp only [Function.update_of_ne hi] - exact hready.1.control.lookup.scanner.parked i + have hwork₀Parked : ∀ i, TM.Parked (work₀ i) := + denseDispatch_work_parked hready have hblank : (denseExecuteInstructionTM tapes instruction).HoareTime blankPre post (denseExecuteInstructionTime tapes input instruction pcValue overlay) := by rintro inp work out ⟨⟨hinp, hworkEq, hout⟩, hzero⟩ subst selector - have hcleanLhs := Tape.HasBinaryNat.eq_init_move_right - hready.1.control.lookup.destination - change cleanWork tapes.liftedLhs = - (Tape.init []).move Dir3.right at hcleanLhs - have hworkClean : work = cleanWork := by - rw [hworkEq, hready.2] - funext i - by_cases hi : i = tapes.liftedLhs - · subst i - simp only [Function.update_self] - exact hcleanLhs.symm - · simp only [Function.update_of_ne hi] + have hworkClean : work = cleanWork := + hworkEq.trans (denseDispatch_zero_work hready) obtain ⟨final, time, htime, hreach, hhalt, hfinalInput, hresult, hfinalOutput⟩ := denseExecuteInstructionTM_hoareTime_frame tapes input instruction diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseStore.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseStore.lean index d3987fb3f8..770a6fca47 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseStore.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseStore.lean @@ -218,6 +218,66 @@ private theorem denseStoreUpdate_ready · simpa only [updateWork, Function.update_of_ne hresultCountReplacement, queryWork, Function.update_of_ne hresultCountQuery] using! hresultCount +/-- The dense-store update stage preserves its operand witnesses and exact encoded-write output. -/ +private theorem denseStore_updateStage + (tapes : BinaryInstructionTapes n) (input : List Bool) + (overlay : Store) (addressRegister source : ℕ) (emittedBits : List Bool) + (initialWork : Fin n → Tape) (out₀ : Tape) + (hvalid : DenseOverlay.Valid overlay) + (hinitial : EntryLookupStaticReady tapes.lhsLookup overlay initialWork) + (hinput : TM.Parked ((Tape.init (input.map Γ.ofBool)).move Dir3.right)) + (houtput : out₀.HasBinaryPrefix emittedBits) : + let inp₀ := (Tape.init (input.map Γ.ofBool)).move Dir3.right + let address := DenseOverlay.read input overlay addressRegister + let value := DenseOverlay.read input overlay source + (taggedEntryUpdateTM tapes.update).HoareTime + (fun inp work out => + inp = inp₀ ∧ + (∃ operandsWork queryWork, + DenseDirectBinaryOperandsResult tapes input overlay addressRegister + source initialWork operandsWork ∧ + queryWork = Function.update operandsWork tapes.update.entry.query + ((Tape.init (address.bits.map Γ.ofBool)).move Dir3.right) ∧ + work = Function.update queryWork tapes.update.replacement + ((Tape.init (value.bits.map Γ.ofBool)).move Dir3.right)) ∧ + out = out₀) + (fun inp work out => + inp = inp₀ ∧ + DenseIndirectStoreInstructionResult tapes input overlay addressRegister + source initialWork work ∧ + out.HasBinaryPrefix + (emittedBits ++ + (DenseOverlay.write overlay address value).flatMap Entry.encode)) + (taggedEntryUpdateTime tapes.update overlay address value) := by + dsimp only + let inp₀ := (Tape.init (input.map Γ.ofBool)).move Dir3.right + let address := DenseOverlay.read input overlay addressRegister + let value := DenseOverlay.read input overlay source + rintro inp work out ⟨hinp, ⟨operandsWork, queryWork, hops, + hqueryWork, hwork⟩, hout⟩ + subst queryWork + subst work + have hready := denseStoreUpdate_ready tapes input overlay addressRegister + source initialWork operandsWork hinitial hops + let updateWork := Function.update + (Function.update operandsWork tapes.update.entry.query + ((Tape.init (address.bits.map Γ.ofBool)).move Dir3.right)) + tapes.update.replacement + ((Tape.init (value.bits.map Γ.ofBool)).move Dir3.right) + have hrun := taggedEntryUpdateTM_hoareTime_frame tapes.update overlay + address value emittedBits updateWork inp₀ out₀ hvalid.1 hready.1 + hready.2.1 hready.2.2.1 hready.2.2.2.1 hready.2.2.2.2.1 hinput + houtput + obtain ⟨final, time, htime, hreach, hhalt, hfinalInput, + houtcome, hfinalOutput⟩ := + hrun inp updateWork out ⟨hinp, rfl, hout⟩ + exact ⟨final, time, htime, hreach, hhalt, hfinalInput, + ⟨operandsWork, + Function.update operandsWork tapes.update.entry.query + ((Tape.init (address.bits.map Γ.ofBool)).move Dir3.right), + updateWork, hops, rfl, rfl, by simpa [address, value] using! houtcome⟩, + by simpa [address, value] using! hfinalOutput⟩ + /-- Exact semantic and time contract for one dense-overlay indirect store. -/ theorem denseIndirectStoreInstructionTM_hoareTime_frame (tapes : BinaryInstructionTapes n) (input : List Bool) @@ -358,49 +418,8 @@ theorem denseIndirectStoreInstructionTM_hoareTime_frame ⟨operandsWork, queryWork, hops, rfl, by simpa [value] using! hfinalWork⟩, hfinalOutput.trans hout⟩ - have hupdate : (taggedEntryUpdateTM tapes.update).HoareTime - (fun inp work out => - inp = inp₀ ∧ - (∃ operandsWork queryWork, - DenseDirectBinaryOperandsResult tapes input overlay addressRegister - source initialWork operandsWork ∧ - queryWork = Function.update operandsWork tapes.update.entry.query - ((Tape.init (address.bits.map Γ.ofBool)).move Dir3.right) ∧ - work = Function.update queryWork tapes.update.replacement - ((Tape.init (value.bits.map Γ.ofBool)).move Dir3.right)) ∧ - out = out₀) - (fun inp work out => - inp = inp₀ ∧ - DenseIndirectStoreInstructionResult tapes input overlay addressRegister - source initialWork work ∧ - out.HasBinaryPrefix - (emittedBits ++ - (DenseOverlay.write overlay address value).flatMap Entry.encode)) - (taggedEntryUpdateTime tapes.update overlay address value) := by - rintro inp work out ⟨hinp, ⟨operandsWork, queryWork, hops, - hqueryWork, hwork⟩, hout⟩ - subst queryWork - subst work - have hready := denseStoreUpdate_ready tapes input overlay addressRegister - source initialWork operandsWork hinitial hops - let updateWork := Function.update - (Function.update operandsWork tapes.update.entry.query - ((Tape.init (address.bits.map Γ.ofBool)).move Dir3.right)) - tapes.update.replacement - ((Tape.init (value.bits.map Γ.ofBool)).move Dir3.right) - have hrun := taggedEntryUpdateTM_hoareTime_frame tapes.update overlay - address value emittedBits updateWork inp₀ out₀ hvalid.1 hready.1 - hready.2.1 hready.2.2.1 hready.2.2.2.1 hready.2.2.2.2.1 hinput - houtput - obtain ⟨final, time, htime, hreach, hhalt, hfinalInput, - houtcome, hfinalOutput⟩ := - hrun inp updateWork out ⟨hinp, rfl, hout⟩ - exact ⟨final, time, htime, hreach, hhalt, hfinalInput, - ⟨operandsWork, - Function.update operandsWork tapes.update.entry.query - ((Tape.init (address.bits.map Γ.ofBool)).move Dir3.right), - updateWork, hops, rfl, rfl, by simpa [address, value] using! houtcome⟩, - by simpa [address, value] using! hfinalOutput⟩ + have hupdate := denseStore_updateStage tapes input overlay addressRegister source emittedBits + initialWork out₀ hvalid hinitial hinput houtput have hvalueUpdate := TM.seqTM_hoareTime (TM.binaryCopyIntoTM tapes.rhs tapes.update.replacement tapes.update.found) (taggedEntryUpdateTM tapes.update) hvalue diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Store.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Store.lean index 230de8f826..cd5f27e5c6 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Store.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Store.lean @@ -268,6 +268,82 @@ private theorem storeUpdate_ready Function.update_of_ne hresultCountReplacement, queryWork, Function.update_of_ne hresultCountQuery] using! hresultCount +/-- The sparse-store update stage preserves operand witnesses, source cells, and encoded output. -/ +private theorem sparseStore_updateStage + (tapes : BinaryInstructionTapes n) (store : Store) + (addressRegister source : ℕ) (emittedBits : List Bool) + (initialWork : Fin n → Tape) (inp₀ out₀ : Tape) + (hcanonical : Canonical store) + (hinitial : EntryLookupStaticReady tapes.lhsLookup store initialWork) + (hinput : TM.Parked inp₀) (houtput : out₀.HasBinaryPrefix emittedBits) : + let address := RegisterStore.read store addressRegister + let value := RegisterStore.read store source + (entryUpdateTM tapes.update).HoareTime + (fun inp work out => + inp = inp₀ ∧ + (∃ operandsWork queryWork, + DirectBinaryOperandsResult tapes store addressRegister source + initialWork operandsWork ∧ + queryWork = Function.update operandsWork tapes.update.entry.query + ((Tape.init (address.bits.map Γ.ofBool)).move Dir3.right) ∧ + work = Function.update queryWork tapes.update.replacement + ((Tape.init (value.bits.map Γ.ofBool)).move Dir3.right)) ∧ + out = out₀) + (fun inp work out => + inp = inp₀ ∧ + IndirectStoreInstructionResult tapes store addressRegister source + initialWork work ∧ + out.HasBinaryPrefix + (emittedBits ++ + (RegisterStore.write store address value).flatMap Entry.encode)) + (entryUpdateTime tapes.update store address value) := by + dsimp only + let address := RegisterStore.read store addressRegister + let value := RegisterStore.read store source + rintro inp work out ⟨hinp, ⟨operandsWork, queryWork, hops, + hqueryWork, hwork⟩, hout⟩ + subst queryWork + subst work + have hready := storeUpdate_ready tapes store addressRegister source + initialWork operandsWork hinitial hops + let updateWork := Function.update + (Function.update operandsWork tapes.update.entry.query + ((Tape.init (address.bits.map Γ.ofBool)).move Dir3.right)) + tapes.update.replacement + ((Tape.init (value.bits.map Γ.ofBool)).move Dir3.right) + have hrun := entryUpdateTM_hoareTime_frame tapes.update store address value + emittedBits updateWork inp₀ out₀ hcanonical hready.1 hready.2.1 + hready.2.2.1 hready.2.2.2.1 hready.2.2.2.2.1 hinput houtput + obtain ⟨final, time, htime, hreach, hhalt, hfinalInput, + houtcome, hfinalOutput, hsourceCells⟩ := + hrun inp updateWork out ⟨hinp, rfl, hout⟩ + exact ⟨final, time, htime, hreach, hhalt, hfinalInput, + ⟨operandsWork, + Function.update operandsWork tapes.update.entry.query + ((Tape.init (address.bits.map Γ.ofBool)).move Dir3.right), + updateWork, hops, rfl, rfl, by simpa [address, value] using! houtcome, + by + rcases hops with ⟨lhsWork, hlhs, hrhs⟩ + calc + (final.work tapes.update.entry.source).cells = + (updateWork tapes.update.entry.source).cells := hsourceCells + _ = (operandsWork tapes.update.entry.source).cells := by + rw [show updateWork tapes.update.entry.source = + (Function.update operandsWork tapes.update.entry.query + ((Tape.init (address.bits.map Γ.ofBool)).move + Dir3.right)) tapes.update.entry.source by + exact Function.update_of_ne (tapes.update.ne (by decide)) _ _] + rw [show (Function.update operandsWork + tapes.update.entry.query + ((Tape.init (address.bits.map Γ.ofBool)).move Dir3.right)) + tapes.update.entry.source = + operandsWork tapes.update.entry.source by + exact Function.update_of_ne (tapes.update.ne (by decide)) _ _] + _ = (lhsWork tapes.update.entry.source).cells := hrhs.sourceCells + _ = (initialWork tapes.update.entry.source).cells := + hlhs.sourceCells⟩, + by simpa [address, value] using! hfinalOutput⟩ + /-- Exact semantic and time contract for one indirect sparse store. -/ theorem indirectStoreInstructionTM_hoareTime_frame_internal (tapes : BinaryInstructionTapes n) (store : Store) @@ -406,68 +482,8 @@ theorem indirectStoreInstructionTM_hoareTime_frame_internal ⟨operandsWork, queryWork, hops, rfl, by simpa [value] using! hfinalWork⟩, hfinalOutput.trans hout⟩ - have hupdate : (entryUpdateTM tapes.update).HoareTime - (fun inp work out => - inp = inp₀ ∧ - (∃ operandsWork queryWork, - DirectBinaryOperandsResult tapes store addressRegister source - initialWork operandsWork ∧ - queryWork = Function.update operandsWork tapes.update.entry.query - ((Tape.init (address.bits.map Γ.ofBool)).move Dir3.right) ∧ - work = Function.update queryWork tapes.update.replacement - ((Tape.init (value.bits.map Γ.ofBool)).move Dir3.right)) ∧ - out = out₀) - (fun inp work out => - inp = inp₀ ∧ - IndirectStoreInstructionResult tapes store addressRegister source - initialWork work ∧ - out.HasBinaryPrefix - (emittedBits ++ - (RegisterStore.write store address value).flatMap Entry.encode)) - (entryUpdateTime tapes.update store address value) := by - rintro inp work out ⟨hinp, ⟨operandsWork, queryWork, hops, - hqueryWork, hwork⟩, hout⟩ - subst queryWork - subst work - have hready := storeUpdate_ready tapes store addressRegister source - initialWork operandsWork hinitial hops - let updateWork := Function.update - (Function.update operandsWork tapes.update.entry.query - ((Tape.init (address.bits.map Γ.ofBool)).move Dir3.right)) - tapes.update.replacement - ((Tape.init (value.bits.map Γ.ofBool)).move Dir3.right) - have hrun := entryUpdateTM_hoareTime_frame tapes.update store address value - emittedBits updateWork inp₀ out₀ hcanonical hready.1 hready.2.1 - hready.2.2.1 hready.2.2.2.1 hready.2.2.2.2.1 hinput houtput - obtain ⟨final, time, htime, hreach, hhalt, hfinalInput, - houtcome, hfinalOutput, hsourceCells⟩ := - hrun inp updateWork out ⟨hinp, rfl, hout⟩ - exact ⟨final, time, htime, hreach, hhalt, hfinalInput, - ⟨operandsWork, - Function.update operandsWork tapes.update.entry.query - ((Tape.init (address.bits.map Γ.ofBool)).move Dir3.right), - updateWork, hops, rfl, rfl, by simpa [address, value] using! houtcome, - by - rcases hops with ⟨lhsWork, hlhs, hrhs⟩ - calc - (final.work tapes.update.entry.source).cells = - (updateWork tapes.update.entry.source).cells := hsourceCells - _ = (operandsWork tapes.update.entry.source).cells := by - rw [show updateWork tapes.update.entry.source = - (Function.update operandsWork tapes.update.entry.query - ((Tape.init (address.bits.map Γ.ofBool)).move - Dir3.right)) tapes.update.entry.source by - exact Function.update_of_ne (tapes.update.ne (by decide)) _ _] - rw [show (Function.update operandsWork - tapes.update.entry.query - ((Tape.init (address.bits.map Γ.ofBool)).move Dir3.right)) - tapes.update.entry.source = - operandsWork tapes.update.entry.source by - exact Function.update_of_ne (tapes.update.ne (by decide)) _ _] - _ = (lhsWork tapes.update.entry.source).cells := hrhs.sourceCells - _ = (initialWork tapes.update.entry.source).cells := - hlhs.sourceCells⟩, - by simpa [address, value] using! hfinalOutput⟩ + have hupdate := sparseStore_updateStage tapes store addressRegister source emittedBits + initialWork inp₀ out₀ hcanonical hinitial hinput houtput have hvalueUpdate := TM.seqTM_hoareTime (TM.binaryCopyIntoTM tapes.rhs tapes.update.replacement tapes.update.found) (entryUpdateTM tapes.update) hvalue diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/GateStep/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/GateStep/Internal.lean index 82b779ec6d..6533a8fc96 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/GateStep/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/GateStep/Internal.lean @@ -671,17 +671,27 @@ private theorem input_wire (gate : CircuitCode.RawGate) (wires : List Bool) simp rfl -theorem program_measured_internal (gate : CircuitCode.RawGate) (wires : List Bool) - (value0 value1 : Bool) (hvalue0 : wires[gate.input₀]? = some value0) - (hvalue1 : wires[gate.input₁]? = some value1) : - ∃ final cost space, - Exec program (inputStore gate wires) final (stepCount gate) cost space ∧ - cost ≤ timeBound gate wires ∧ space ≤ spaceBound gate wires ∧ - final GateEval.outputReg = Input.bitValue (gate.eval value0 value1) ∧ - final (memoBase gate + wires.length) = - Input.bitValue (gate.eval value0 value1) ∧ - ∀ index (hindex : index < wires.length), - final (memoBase gate + index) = Input.bitValue wires[index] := by +/-- Decode the first operand and restore the cursor for the second operand. -/ +private theorem firstDecode_restart_measured + (gate : CircuitCode.RawGate) (wires : List Bool) : + let firstRemaining := CircuitCode.NatCode.encode gate.input₀ ++ + CircuitCode.NatCode.encode gate.input₁ ++ wires + let secondRemaining := CircuitCode.NatCode.encode gate.input₁ ++ wires + ∃ (first : Store) (firstCost firstSpace : ℕ), + Exec UnaryDecode.mainLoop (headerStore gate wires) first + (UnaryDecode.loopStepCount firstRemaining) firstCost firstSpace ∧ + firstCost ≤ UnaryDecode.timeBound (inputBits gate wires).length ∧ + firstSpace ≤ UnaryDecode.spaceBound (inputBits gate wires).length ∧ + first UnaryDecode.valueReg = gate.input₀ ∧ + first UnaryDecode.activeReg = 0 ∧ + (∀ index, UnaryDecode.inputBase ≤ index → + first index = headerStore gate wires index) ∧ + CursorEnvelope gate wires first ∧ + 10 < cursorBound gate wires ∧ + UnaryDecode.CursorReady (inputBits gate wires).length + secondRemaining (4 + gate.input₀) 0 (saveRestartStore first) ∧ + CursorEnvelope gate wires (saveRestartStore first) := by + dsimp only let firstRemaining := CircuitCode.NatCode.encode gate.input₀ ++ CircuitCode.NatCode.encode gate.input₁ ++ wires let secondRemaining := CircuitCode.NatCode.encode gate.input₁ ++ wires @@ -795,6 +805,97 @@ theorem program_measured_internal (gate : CircuitCode.RawGate) (wires : List Boo ((inputBits gate wires).length + UnaryDecode.inputBase) ((inputBits gate wires).length + UnaryDecode.inputBase) saved := by simpa [cursorBound] using hsavedBound + exact ⟨first, firstCost, firstSpace, hfirst, hfirstCost, hfirstSpace, + hfirstValue, hfirstActive, hfirstFrame, hfirstBound, hlarge, + hsecondReady, hsecondBound⟩ + +/-- Marshal decoded operands and preserve the memoized wires for gate evaluation. -/ +private theorem marshal_ready_of_decoded + (gate : CircuitCode.RawGate) (wires : List Bool) (first second : Store) + (hsecondOp : second headerOpReg = Input.bitValue gate.opBit) + (hsecondNegated0 : second headerNegated0Reg = Input.bitValue gate.negated₀) + (hsecondNegated1 : second headerNegated1Reg = Input.bitValue gate.negated₁) + (hsecondInput0 : second savedInput0Reg = gate.input₀) + (hsecondValue : second UnaryDecode.valueReg = gate.input₁) + (hsecondActive : second UnaryDecode.activeReg = 0) + (hsecondRemaining : second UnaryDecode.remainingReg = wires.length) + (hsecondPointer : second UnaryDecode.pointerReg = memoBase gate) + (hfirstFrame : ∀ index, UnaryDecode.inputBase ≤ index → + first index = headerStore gate wires index) + (hsecondFrame : ∀ index, UnaryDecode.inputBase ≤ index → + second index = saveRestartStore first index) : + GateEval.ReadyAt (memoBase gate) gate wires (marshalStore second) := by + constructor + · simp [memoBase, CircuitCode.RawGate.length_encode, GateEval.wireBase, + UnaryDecode.inputBase] + omega + · change marshalStore second GateEval.opReg = _ + rw [marshal_op, hsecondOp, hsecondActive] + omega + · change marshalStore second GateEval.negated0Reg = _ + rw [marshal_negated0, hsecondNegated0, hsecondActive] + omega + · change marshalStore second GateEval.negated1Reg = _ + rw [marshal_negated1, hsecondNegated1, hsecondActive] + omega + · change marshalStore second GateEval.address0Reg = gate.input₀ + rw [marshal_address0, hsecondInput0, hsecondActive] + omega + · change marshalStore second GateEval.address1Reg = gate.input₁ + rw [marshal_address1, hsecondValue, hsecondActive] + omega + · change marshalStore second GateEval.wireCountReg = wires.length + rw [marshal_wireCount, hsecondRemaining, hsecondActive] + omega + · change marshalStore second GateEval.baseReg = memoBase gate + rw [marshal_base, hsecondPointer, hsecondActive] + omega + · intro index hindex + change marshalStore second (memoBase gate + index) = _ + rw [marshal_high second _ (by + simp [memoBase, CircuitCode.RawGate.length_encode, + UnaryDecode.inputBase] + omega)] + rw [hsecondFrame _ (by + simp [memoBase, CircuitCode.RawGate.length_encode, + UnaryDecode.inputBase] + omega)] + change saveRestartStore first (memoBase gate + index) = _ + rw [saveRestart_high first _ (by + simp [memoBase, CircuitCode.RawGate.length_encode, + UnaryDecode.inputBase] + omega)] + rw [hfirstFrame _ (by + simp [memoBase, CircuitCode.RawGate.length_encode, + UnaryDecode.inputBase] + omega)] + rw [header_high gate wires _ (by + simp [memoBase, CircuitCode.RawGate.length_encode, + UnaryDecode.inputBase] + omega)] + exact input_wire gate wires index + +theorem program_measured_internal (gate : CircuitCode.RawGate) (wires : List Bool) + (value0 value1 : Bool) (hvalue0 : wires[gate.input₀]? = some value0) + (hvalue1 : wires[gate.input₁]? = some value1) : + ∃ final cost space, + Exec program (inputStore gate wires) final (stepCount gate) cost space ∧ + cost ≤ timeBound gate wires ∧ space ≤ spaceBound gate wires ∧ + final GateEval.outputReg = Input.bitValue (gate.eval value0 value1) ∧ + final (memoBase gate + wires.length) = + Input.bitValue (gate.eval value0 value1) ∧ + ∀ index (hindex : index < wires.length), + final (memoBase gate + index) = Input.bitValue wires[index] := by + let firstRemaining := CircuitCode.NatCode.encode gate.input₀ ++ + CircuitCode.NatCode.encode gate.input₁ ++ wires + let secondRemaining := CircuitCode.NatCode.encode gate.input₁ ++ wires + obtain ⟨first, firstCost, firstSpace, hfirst, hfirstCost, hfirstSpace, + hfirstValue, hfirstActive, hfirstFrame, hfirstBound, hlarge, + hsecondReady, hsecondBound⟩ := firstDecode_restart_measured gate wires + let saved := saveRestartStore first + have hdecode0 : CircuitCode.NatCode.decodePrefix? firstRemaining = + some (gate.input₀, secondRemaining) := by + simp [firstRemaining, secondRemaining, List.append_assoc] obtain ⟨second, secondCost, secondSpace, hsecond, hsecondCost, hsecondSpace, hsecondResult, hsecondActive, _hsecondOne, hsecondFrame, hsecondFinalBound⟩ := UnaryDecode.mainLoop_measured_internal hsecondReady hsecondBound @@ -847,56 +948,10 @@ theorem program_measured_internal (gate : CircuitCode.RawGate) (wires : List Boo rw [hfirstValue, hfirstActive] omega let marshaled := marshalStore second - have hready : GateEval.ReadyAt (memoBase gate) gate wires marshaled := by - constructor - · simp [memoBase, CircuitCode.RawGate.length_encode, GateEval.wireBase, - UnaryDecode.inputBase] - omega - · change marshalStore second GateEval.opReg = _ - rw [marshal_op, hsecondOp, hsecondActive] - omega - · change marshalStore second GateEval.negated0Reg = _ - rw [marshal_negated0, hsecondNegated0, hsecondActive] - omega - · change marshalStore second GateEval.negated1Reg = _ - rw [marshal_negated1, hsecondNegated1, hsecondActive] - omega - · change marshalStore second GateEval.address0Reg = gate.input₀ - rw [marshal_address0, hsecondInput0, hsecondActive] - omega - · change marshalStore second GateEval.address1Reg = gate.input₁ - rw [marshal_address1, hsecondValue, hsecondActive] - omega - · change marshalStore second GateEval.wireCountReg = wires.length - rw [marshal_wireCount, hsecondRemaining, hsecondActive] - omega - · change marshalStore second GateEval.baseReg = memoBase gate - rw [marshal_base, hsecondPointer, hsecondActive] - omega - · intro index hindex - change marshalStore second (memoBase gate + index) = _ - rw [marshal_high second _ (by - simp [memoBase, CircuitCode.RawGate.length_encode, - UnaryDecode.inputBase] - omega)] - rw [hsecondFrame _ (by - simp [memoBase, CircuitCode.RawGate.length_encode, - UnaryDecode.inputBase] - omega)] - change saveRestartStore first (memoBase gate + index) = _ - rw [saveRestart_high first _ (by - simp [memoBase, CircuitCode.RawGate.length_encode, - UnaryDecode.inputBase] - omega)] - rw [hfirstFrame _ (by - simp [memoBase, CircuitCode.RawGate.length_encode, - UnaryDecode.inputBase] - omega)] - rw [header_high gate wires _ (by - simp [memoBase, CircuitCode.RawGate.length_encode, - UnaryDecode.inputBase] - omega)] - exact input_wire gate wires index + have hready : GateEval.ReadyAt (memoBase gate) gate wires marshaled := + marshal_ready_of_decoded gate wires first second hsecondOp hsecondNegated0 + hsecondNegated1 hsecondInput0 hsecondValue hsecondActive hsecondRemaining + hsecondPointer hfirstFrame hsecondFrame have hcursorLe : cursorBound gate wires ≤ storeBound gate wires := by simp [cursorBound, storeBound] have hwidthLe : valueWidth (cursorBound gate wires) ≤ diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/Internal.lean index bda1e56c84..cef31b64e7 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/Internal.lean @@ -886,50 +886,13 @@ theorem blankWorkTM_started_hoareTime {n : ℕ} hhead0 hcell00 hblank0 hdata0 htail0 refine ⟨c', x.length + 1, le_rfl, hreach, hhalt, hhead, hcell0, hblank⟩ -/-- Rich HoareTime for `blankWorkTM`: erase a started Boolean work tape while -preserving arbitrary frame data on the input tape, output tape, and all other -work tapes. This is the form needed to recycle a staged work tape inside a -larger verifier pipeline. -/ -theorem blankWorkTM_hoareTime_frame_of_binaryString {n : ℕ} - (idx : Fin n) (x : List Bool) - {P : Tape → (Fin n → Tape) → Tape → Prop} - (hP_preserved : ∀ (inp : Tape) (work : Fin n → Tape) (out : Tape) - (inp' : Tape) (work' : Fin n → Tape) (out' : Tape), - P inp work out → - (work' idx).head = x.length + 1 → - (work' idx).cells 0 = Γ.start → - (∀ i, (work' idx).cells (i + 1) = Γ.blank) → - inp' = inp → - out' = out → - (∀ i, i ≠ idx → work' i = work i) → - P inp' work' out') : - (blankWorkTM idx).HoareTime - (fun inp work out => - work idx = (Tape.init (x.map Γ.ofBool)).move Dir3.right ∧ - inp.read ≠ Γ.start ∧ - out.read ≠ Γ.start ∧ out.head ≥ 1 ∧ - (∀ i, i ≠ idx → (work i).read ≠ Γ.start ∧ (work i).head ≥ 1) ∧ - P inp work out) - (fun inp work out => - (work idx).head = x.length + 1 ∧ - (work idx).cells 0 = Γ.start ∧ - (∀ i, (work idx).cells (i + 1) = Γ.blank) ∧ - P inp work out) - (x.length + 1) := by - intro inp work out ⟨hwork, hinp_ns, hout_ns, hout_h, hother_wf, hP⟩ - have tape_idle_preserve : ∀ (t : Tape), t.read ≠ Γ.start → t.head ≥ 1 → - t.writeAndMove (readBackWrite t.read) (idleDir t.read) = t := by - intro t hns hh - simp only [Tape.writeAndMove, idleDir, hns, ↓reduceIte, Tape.move, Tape.write] - split - · omega - · simp only [Tape.read] at hns ⊢ - rw [toΓ_readBackWrite_of_ne_start hns, Function.update_eq_self] - have input_idle_preserve : ∀ (t : Tape), t.read ≠ Γ.start → - t.move (idleDir t.read) = t := by - intro t hns - simp [idleDir, hns, Tape.move] - suffices h_loop : ∀ rem k (c : Cfg n (blankWorkTM idx).Q), +/-- The blanking scan erases the remaining Boolean suffix and preserves the tape frame. -/ +private theorem blankWorkTM_loop_frame {n : ℕ} + (idx : Fin n) (x : List Bool) (inp : Tape) (work : Fin n → Tape) (out : Tape) + (hinp_ns : inp.read ≠ Γ.start) (hout_ns : out.read ≠ Γ.start) + (hout_h : out.head ≥ 1) + (hother_wf : ∀ i, i ≠ idx → (work i).read ≠ Γ.start ∧ (work i).head ≥ 1) : + ∀ rem k (c : Cfg n (blankWorkTM idx).Q), rem = x.length - k → k ≤ x.length → c.state = ScanPhase.scanning → @@ -950,36 +913,19 @@ theorem blankWorkTM_hoareTime_frame_of_binaryString {n : ℕ} (∀ i, (c'.work idx).cells (i + 1) = Γ.blank) ∧ c'.input = inp ∧ c'.output = out ∧ - (∀ i, i ≠ idx → c'.work i = work i) by - have hhead0 : (work idx).head = 1 := by - rw [hwork] - simp [Tape.move, Tape.init] - have hcell00 : (work idx).cells 0 = Γ.start := by - rw [hwork] - simp [Tape.move, Tape.init] - have hblank0 : ∀ i, i < 0 → (work idx).cells (i + 1) = Γ.blank := by - intro i hi - exact (Nat.not_lt_zero i hi).elim - have hdata0 : ∀ i, ∀ _ : 0 ≤ i, ∀ hi : i < x.length, - (work idx).cells (i + 1) = Γ.ofBool (x[i]'hi) := by - intro i _ hi - rw [hwork] - exact Tape.init_ofBool_cells_lt x i hi - have htail0 : ∀ i, x.length ≤ i → (work idx).cells (i + 1) = Γ.blank := by - intro i hi - rw [hwork] - exact Tape.init_ofBool_cells_ge x i hi - obtain ⟨c', hreach, hhalt, hhead, hcell0, hblank, hinp', hout', hwork'⟩ := - h_loop x.length 0 - { state := ScanPhase.scanning, input := inp, work := work, output := out } - (by simp) - (Nat.zero_le _) - rfl - hhead0 hcell00 hblank0 hdata0 htail0 - rfl rfl (fun _ _ => rfl) - refine ⟨c', x.length + 1, le_rfl, hreach, hhalt, hhead, hcell0, hblank, ?_⟩ - exact hP_preserved inp work out c'.input c'.work c'.output hP - hhead hcell0 hblank hinp' hout' hwork' + (∀ i, i ≠ idx → c'.work i = work i) := by + have tape_idle_preserve : ∀ (t : Tape), t.read ≠ Γ.start → t.head ≥ 1 → + t.writeAndMove (readBackWrite t.read) (idleDir t.read) = t := by + intro t hns hh + simp only [Tape.writeAndMove, idleDir, hns, ↓reduceIte, Tape.move, Tape.write] + split + · omega + · simp only [Tape.read] at hns ⊢ + rw [toΓ_readBackWrite_of_ne_start hns, Function.update_eq_self] + have input_idle_preserve : ∀ (t : Tape), t.read ≠ Γ.start → + t.move (idleDir t.read) = t := by + intro t hns + simp [idleDir, hns, Tape.move] intro rem induction rem with | zero => @@ -1152,6 +1098,69 @@ theorem blankWorkTM_hoareTime_frame_of_binaryString {n : ℕ} hblank_tail1 hinput_keep houtput_keep hwork_keep exact ⟨c', .step hstep1 hreach, hhalt, hhead', hcell0', hblank', hinp', hout', hwork'⟩ +/-- Rich HoareTime for `blankWorkTM`: erase a started Boolean work tape while +preserving arbitrary frame data on the input tape, output tape, and all other +work tapes. This is the form needed to recycle a staged work tape inside a +larger verifier pipeline. -/ +theorem blankWorkTM_hoareTime_frame_of_binaryString {n : ℕ} + (idx : Fin n) (x : List Bool) + {P : Tape → (Fin n → Tape) → Tape → Prop} + (hP_preserved : ∀ (inp : Tape) (work : Fin n → Tape) (out : Tape) + (inp' : Tape) (work' : Fin n → Tape) (out' : Tape), + P inp work out → + (work' idx).head = x.length + 1 → + (work' idx).cells 0 = Γ.start → + (∀ i, (work' idx).cells (i + 1) = Γ.blank) → + inp' = inp → + out' = out → + (∀ i, i ≠ idx → work' i = work i) → + P inp' work' out') : + (blankWorkTM idx).HoareTime + (fun inp work out => + work idx = (Tape.init (x.map Γ.ofBool)).move Dir3.right ∧ + inp.read ≠ Γ.start ∧ + out.read ≠ Γ.start ∧ out.head ≥ 1 ∧ + (∀ i, i ≠ idx → (work i).read ≠ Γ.start ∧ (work i).head ≥ 1) ∧ + P inp work out) + (fun inp work out => + (work idx).head = x.length + 1 ∧ + (work idx).cells 0 = Γ.start ∧ + (∀ i, (work idx).cells (i + 1) = Γ.blank) ∧ + P inp work out) + (x.length + 1) := by + intro inp work out ⟨hwork, hinp_ns, hout_ns, hout_h, hother_wf, hP⟩ + have h_loop := blankWorkTM_loop_frame idx x inp work out + hinp_ns hout_ns hout_h hother_wf + have hhead0 : (work idx).head = 1 := by + rw [hwork] + simp [Tape.move, Tape.init] + have hcell00 : (work idx).cells 0 = Γ.start := by + rw [hwork] + simp [Tape.move, Tape.init] + have hblank0 : ∀ i, i < 0 → (work idx).cells (i + 1) = Γ.blank := by + intro i hi + exact (Nat.not_lt_zero i hi).elim + have hdata0 : ∀ i, ∀ _ : 0 ≤ i, ∀ hi : i < x.length, + (work idx).cells (i + 1) = Γ.ofBool (x[i]'hi) := by + intro i _ hi + rw [hwork] + exact Tape.init_ofBool_cells_lt x i hi + have htail0 : ∀ i, x.length ≤ i → (work idx).cells (i + 1) = Γ.blank := by + intro i hi + rw [hwork] + exact Tape.init_ofBool_cells_ge x i hi + obtain ⟨c', hreach, hhalt, hhead, hcell0, hblank, hinp', hout', hwork'⟩ := + h_loop x.length 0 + { state := ScanPhase.scanning, input := inp, work := work, output := out } + (by simp) + (Nat.zero_le _) + rfl + hhead0 hcell00 hblank0 hdata0 htail0 + rfl rfl (fun _ _ => rfl) + refine ⟨c', x.length + 1, le_rfl, hreach, hhalt, hhead, hcell0, hblank, ?_⟩ + exact hP_preserved inp work out c'.input c'.work c'.output hP + hhead hcell0 hblank hinp' hout' hwork' + /-- Rich HoareTime for `clearWorkTM`: erase a started Boolean work tape and rewind it to the standard started blank tape while preserving the external frame. The user predicate only needs to be stable once the target tape has From 3e6fef1ead4c6b623ad1e6cb25acf8c466175f6c Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Fri, 25 Sep 2026 21:12:42 +0000 Subject: [PATCH 37/49] Separate initialization readiness and cleanup proof stages --- .../Machine/Program/Init/Internal.lean | 320 ++++++++++------ .../Machine/Program/Internal.lean | 355 ++++++++++-------- 2 files changed, 396 insertions(+), 279 deletions(-) diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Init/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Init/Internal.lean index 09cda7267e..2ea6eceac1 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Init/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Init/Internal.lean @@ -710,6 +710,73 @@ theorem initialZeroBitTM_hoareTime_internal rw [hframe i hlhs] exact hready.frame i hlhs hrhs hcount hbuffer +/-- Emission followed by the two counter increments restores the complete input-loop ABI. -/ +private theorem initialOneBit_finalReady + (tapes : ControlInstructionTapes n) (address count : ℕ) (entries : Store) + (work₀ emittedWork countedWork advancedWork : Fin (n + 1) → Tape) + (hready : InitialLoopReady tapes address count entries work₀) + (hemitFrame : ∀ i, i ≠ tapes.buffer → emittedWork i = work₀ i) + (hemitBuffer : (emittedWork tapes.buffer).HasBinaryPrefix + (entries.flatMap Entry.encode ++ Entry.encode (address, 1))) + (hcountFrame : ∀ i, i ≠ tapes.lifted.data.update.remaining → + countedWork i = emittedWork i) + (hcountValue : (countedWork tapes.lifted.data.update.remaining).HasBinaryNat (count + 1)) + (hcountWorkParked : ∀ i, TM.Parked (countedWork i)) + (haddressFrame : ∀ i, i ≠ tapes.liftedLhs → advancedWork i = countedWork i) + (haddressValue : (advancedWork tapes.liftedLhs).HasBinaryNat (address + 1)) : + InitialLoopReady tapes (address + 1) (count + 1) + (entries ++ [(address, 1)]) advancedWork := by + have hremainingBuffer : tapes.lifted.data.update.remaining ≠ + tapes.buffer := tapes.liftedData_ne_buffer 9 + have hlhsBuffer : tapes.liftedLhs ≠ tapes.buffer := + tapes.liftedData_ne_buffer 13 + have hrhsBuffer : tapes.lifted.data.rhs ≠ tapes.buffer := + tapes.liftedData_ne_buffer 14 + have hlhsRemaining : tapes.liftedLhs ≠ + tapes.lifted.data.update.remaining := + tapes.lifted.data.ne (by decide) + have hremainingLhs : tapes.lifted.data.update.remaining ≠ + tapes.liftedLhs := hlhsRemaining.symm + have hrhsLhs : tapes.lifted.data.rhs ≠ tapes.liftedLhs := + tapes.lifted.data.ne (by decide) + have hrhsRemaining : tapes.lifted.data.rhs ≠ + tapes.lifted.data.update.remaining := + tapes.lifted.data.ne (by decide) + refine + { address := by + change (advancedWork tapes.liftedLhs).HasBinaryNat (address + 1) + exact haddressValue + value := ?_ + count := ?_ + buffer := ?_ + parked := ?_ + frame := ?_ } + · change (advancedWork tapes.lifted.data.rhs).HasBinaryNat 1 + rw [haddressFrame _ hrhsLhs, hcountFrame _ hrhsRemaining, + hemitFrame _ hrhsBuffer] + exact hready.value + · change (advancedWork + tapes.lifted.data.update.remaining).HasBinaryNat (count + 1) + rw [haddressFrame _ hremainingLhs] + exact hcountValue + · change (advancedWork tapes.buffer).HasBinaryPrefix + ((entries ++ [(address, 1)]).flatMap Entry.encode) + rw [haddressFrame _ hlhsBuffer.symm, + hcountFrame _ hremainingBuffer.symm] + simpa [List.flatMap_append] using! hemitBuffer + · intro i + change TM.Parked (advancedWork i) + by_cases hi : i = tapes.liftedLhs + · subst i + exact parked_of_binaryNat haddressValue + · rw [haddressFrame i hi] + exact hcountWorkParked i + · intro i hlhs hrhs hcountIdx hbuffer + change advancedWork i = TM.resetBinaryBlank + rw [haddressFrame i hlhs, hcountFrame i hcountIdx, + hemitFrame i hbuffer] + exact hready.frame i hlhs hrhs hcountIdx hbuffer + /-- A one input bit appends the current `(address, 1)` entry and advances the entry count and current address, restoring every reusable source cursor. -/ theorem initialOneBitTM_hoareTime_internal @@ -904,40 +971,10 @@ theorem initialOneBitTM_hoareTime_internal · refine ⟨?_, ?_, ?_⟩ · change advanced.input = inp₀ exact haddressInput.trans (hcountInput.trans hemitInput) - · refine - { address := by - change (advanced.work tapes.liftedLhs).HasBinaryNat (address + 1) - exact haddressValue - value := ?_ - count := ?_ - buffer := ?_ - parked := ?_ - frame := ?_ } - · change (advanced.work tapes.lifted.data.rhs).HasBinaryNat 1 - rw [haddressFrame _ hrhsLhs, hcountFrame _ hrhsRemaining, - hemitFrame _ hrhsBuffer] - exact hready.value - · change (advanced.work - tapes.lifted.data.update.remaining).HasBinaryNat (count + 1) - rw [haddressFrame _ hremainingLhs] - exact hcountValue - · change (advanced.work tapes.buffer).HasBinaryPrefix - ((entries ++ [(address, 1)]).flatMap Entry.encode) - rw [haddressFrame _ hlhsBuffer.symm, - hcountFrame _ hremainingBuffer.symm] - simpa [List.flatMap_append] using! hemitBuffer - · intro i - change TM.Parked (advanced.work i) - by_cases hi : i = tapes.liftedLhs - · subst i - exact parked_of_binaryNat haddressValue - · rw [haddressFrame i hi] - exact hcountWorkParked i - · intro i hlhs hrhs hcountIdx hbuffer - change advanced.work i = TM.resetBinaryBlank - rw [haddressFrame i hlhs, hcountFrame i hcountIdx, - hemitFrame i hbuffer] - exact hready.frame i hlhs hrhs hcountIdx hbuffer + · exact initialOneBit_finalReady tapes address count entries + work₀ emitted.work counted.work advanced.work hready hemitFrame + hemitBuffer hcountFrame hcountValue hcountWorkParked + haddressFrame haddressValue · change advanced.output = out₀ exact haddressOutput.trans (hcountOutput.trans hemitOutput') @@ -1690,6 +1727,132 @@ theorem initialLengthInstallTM_hoareTime_internal · change lengthDone.output = out₀ exact hlengthOutput.trans hpredOutput +/-- Copy the sparse entry count into the ABI result counter while preserving every other tape. -/ +private theorem initialAbiCount_hoareTime + (tapes : ControlInstructionTapes n) (store : Store) (length : ℕ) + (inp₀ : Tape) (work₀ : Fin (n + 1) → Tape) (out₀ : Tape) + (hready : InitialLoopReady tapes length store.length store work₀) + (hinput : TM.Parked inp₀) (houtputParked : TM.Parked out₀) : + let W₁ := initialAbiCountWork tapes work₀ store.length + (TM.binaryCopyIntoTM + tapes.lifted.data.update.remaining + tapes.lifted.data.update.resultCount + tapes.lifted.data.update.found).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => inp = inp₀ ∧ work = W₁ ∧ out = out₀) + (TM.binaryCopyTime store.length 0) := by + dsimp only + let W₁ := initialAbiCountWork tapes work₀ store.length + have hblankNat : TM.resetBinaryBlank.HasBinaryNat 0 := by + simpa [TM.resetBinaryBlank] using! Tape.init_move_right_hasBinaryNat 0 + have hremainingResult : tapes.lifted.data.update.remaining ≠ + tapes.lifted.data.update.resultCount := + tapes.lifted.data.ne (by decide) + have hremainingFound : tapes.lifted.data.update.remaining ≠ + tapes.lifted.data.update.found := tapes.lifted.data.ne (by decide) + have hresultFound : tapes.lifted.data.update.resultCount ≠ + tapes.lifted.data.update.found := tapes.lifted.data.ne (by decide) + have hresultLhs : tapes.lifted.data.update.resultCount ≠ + tapes.liftedLhs := tapes.lifted.data.ne (by decide) + have hresultRhs : tapes.lifted.data.update.resultCount ≠ + tapes.lifted.data.rhs := tapes.lifted.data.ne (by decide) + have hresultBuffer : tapes.lifted.data.update.resultCount ≠ + tapes.buffer := tapes.liftedData_ne_buffer 12 + have hfoundLhs : tapes.lifted.data.update.found ≠ + tapes.liftedLhs := tapes.lifted.data.ne (by decide) + have hfoundRhs : tapes.lifted.data.update.found ≠ + tapes.lifted.data.rhs := tapes.lifted.data.ne (by decide) + have hfoundRemaining : tapes.lifted.data.update.found ≠ + tapes.lifted.data.update.remaining := tapes.lifted.data.ne (by decide) + have hfoundBuffer : tapes.lifted.data.update.found ≠ tapes.buffer := + tapes.liftedData_ne_buffer 11 + have hresultZero : + (work₀ tapes.lifted.data.update.resultCount).HasBinaryNat 0 := by + rw [hready.frame _ hresultLhs hresultRhs hremainingResult.symm + hresultBuffer] + exact hblankNat + have hfoundZero : + (work₀ tapes.lifted.data.update.found).HasBinaryNat 0 := by + rw [hready.frame _ hfoundLhs hfoundRhs hfoundRemaining hfoundBuffer] + exact hblankNat + have hcopy := TM.binaryCopyIntoTM_hoareTime_frame + tapes.lifted.data.update.remaining + tapes.lifted.data.update.resultCount + tapes.lifted.data.update.found hremainingResult hremainingFound + hresultFound store.length 0 inp₀ work₀ out₀ hready.count + hresultZero hfoundZero hinput + (fun i _ _ _ => hready.parked i) houtputParked + have hcopy' : + (TM.binaryCopyIntoTM + tapes.lifted.data.update.remaining + tapes.lifted.data.update.resultCount + tapes.lifted.data.update.found).HoareTime + (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) + (fun inp work out => inp = inp₀ ∧ work = W₁ ∧ out = out₀) + (TM.binaryCopyTime store.length 0) := by + simpa only [W₁, initialAbiCountWork] using! hcopy + exact hcopy' + +/-- Clear the initialization address and value tapes after installing the sparse store. -/ +private theorem initialAbiCleanup_hoareTime + (tapes : ControlInstructionTapes n) (store : Store) (length : ℕ) + (inp₀ : Tape) (work₀ W₅ : Fin (n + 1) → Tape) (out₀ : Tape) + (hready : InitialLoopReady tapes length store.length store work₀) + (hW₅Lhs : W₅ tapes.liftedLhs = work₀ tapes.liftedLhs) + (hW₅Rhs : W₅ tapes.lifted.data.rhs = work₀ tapes.lifted.data.rhs) + (hinput : TM.Parked inp₀) (hW₅Parked : ∀ i, TM.Parked (W₅ i)) + (houtputParked : TM.Parked out₀) : + let W₆ := initialAbiFinalWork tapes W₅ + (TM.resetBinaryWorkManyTM (initialCleanupTargets tapes)).HoareTime + (fun inp work out => inp = inp₀ ∧ work = W₅ ∧ out = out₀) + (fun inp work out => inp = inp₀ ∧ work = W₆ ∧ out = out₀) + (TM.resetBinaryWorkManyTime (initialCleanupBits tapes length) + (fun _ => 1) (initialCleanupTargets tapes)) := by + dsimp only + let W₆ := initialAbiFinalWork tapes W₅ + have hlhsRhs : tapes.liftedLhs ≠ tapes.lifted.data.rhs := + tapes.lifted.data.ne (by decide) + have htargetsNodup : (initialCleanupTargets tapes).Nodup := by + simp [initialCleanupTargets, hlhsRhs] + have htargetsContent : ∀ i, i ∈ initialCleanupTargets tapes → + (W₅ i).HasBinaryContent (initialCleanupBits tapes length i) := by + intro i hi + simp [initialCleanupTargets] at hi + rcases hi with rfl | rfl + · rw [hW₅Lhs] + simpa [initialCleanupBits] using! hready.address.2.hasBinaryContent + · rw [hW₅Rhs] + simpa [initialCleanupBits, hlhsRhs.symm] using! + hready.value.2.hasBinaryContent + have htargetsStart : ∀ i, i ∈ initialCleanupTargets tapes → + (W₅ i).cells 0 = Γ.start := by + intro i hi + simp [initialCleanupTargets] at hi + rcases hi with rfl | rfl + · rw [hW₅Lhs] + exact hready.address.1 + · rw [hW₅Rhs] + exact hready.value.1 + have htargetsHead : ∀ i, i ∈ initialCleanupTargets tapes → + (W₅ i).head ≤ 1 := by + intro i hi + simp [initialCleanupTargets] at hi + rcases hi with rfl | rfl + · rw [hW₅Lhs, hready.address.2.1] + · rw [hW₅Rhs, hready.value.2.1] + have hresetMany := TM.resetBinaryWorkManyTM_hoareTime_frame + (initialCleanupTargets tapes) (initialCleanupBits tapes length) + (fun _ => 1) inp₀ W₅ out₀ htargetsNodup htargetsContent + htargetsStart htargetsHead hinput hW₅Parked houtputParked + have hresetMany' : + (TM.resetBinaryWorkManyTM (initialCleanupTargets tapes)).HoareTime + (fun inp work out => inp = inp₀ ∧ work = W₅ ∧ out = out₀) + (fun inp work out => inp = inp₀ ∧ work = W₆ ∧ out = out₀) + (TM.resetBinaryWorkManyTime (initialCleanupBits tapes length) + (fun _ => 1) (initialCleanupTargets tapes)) := by + simpa only [W₆, initialAbiFinalWork] using! hresetMany + exact hresetMany' + /-- Install the completed sparse buffer into the exact clean program-loop snapshot image. -/ theorem initialAbiInstallTM_hoareTime_internal @@ -1717,27 +1880,8 @@ theorem initialAbiInstallTM_hoareTime_internal have houtputParked : TM.Parked out₀ := by rw [houtput] exact parked_of_binaryNat hblankNat - have hremainingResult : tapes.lifted.data.update.remaining ≠ - tapes.lifted.data.update.resultCount := - tapes.lifted.data.ne (by decide) - have hremainingFound : tapes.lifted.data.update.remaining ≠ - tapes.lifted.data.update.found := tapes.lifted.data.ne (by decide) - have hresultFound : tapes.lifted.data.update.resultCount ≠ - tapes.lifted.data.update.found := tapes.lifted.data.ne (by decide) - have hresultLhs : tapes.lifted.data.update.resultCount ≠ - tapes.liftedLhs := tapes.lifted.data.ne (by decide) - have hresultRhs : tapes.lifted.data.update.resultCount ≠ - tapes.lifted.data.rhs := tapes.lifted.data.ne (by decide) have hresultBuffer : tapes.lifted.data.update.resultCount ≠ tapes.buffer := tapes.liftedData_ne_buffer 12 - have hfoundLhs : tapes.lifted.data.update.found ≠ - tapes.liftedLhs := tapes.lifted.data.ne (by decide) - have hfoundRhs : tapes.lifted.data.update.found ≠ - tapes.lifted.data.rhs := tapes.lifted.data.ne (by decide) - have hfoundRemaining : tapes.lifted.data.update.found ≠ - tapes.lifted.data.update.remaining := tapes.lifted.data.ne (by decide) - have hfoundBuffer : tapes.lifted.data.update.found ≠ tapes.buffer := - tapes.liftedData_ne_buffer 11 have hsourceLhs : tapes.liftedSource ≠ tapes.liftedLhs := tapes.lifted.data.ne (by decide) have hsourceRhs : tapes.liftedSource ≠ tapes.lifted.data.rhs := @@ -1748,8 +1892,6 @@ theorem initialAbiInstallTM_hoareTime_internal tapes.lifted.data.update.resultCount := tapes.lifted.data.ne (by decide) have hsourceBuffer : tapes.liftedSource ≠ tapes.buffer := tapes.liftedSource_ne_buffer - have hlhsRhs : tapes.liftedLhs ≠ tapes.lifted.data.rhs := - tapes.lifted.data.ne (by decide) have hlhsRemaining : tapes.liftedLhs ≠ tapes.lifted.data.update.remaining := tapes.lifted.data.ne (by decide) have hlhsResult : tapes.liftedLhs ≠ @@ -1772,31 +1914,8 @@ theorem initialAbiInstallTM_hoareTime_internal have hbufferEq : work₀ tapes.buffer = programBinaryPrefixTape storeBits := by exact eq_programBinaryPrefixTape_of_hasBinaryPrefix hready.buffer hbufferStart - have hresultZero : - (work₀ tapes.lifted.data.update.resultCount).HasBinaryNat 0 := by - rw [hready.frame _ hresultLhs hresultRhs hremainingResult.symm - hresultBuffer] - exact hblankNat - have hfoundZero : - (work₀ tapes.lifted.data.update.found).HasBinaryNat 0 := by - rw [hready.frame _ hfoundLhs hfoundRhs hfoundRemaining hfoundBuffer] - exact hblankNat - have hcopy := TM.binaryCopyIntoTM_hoareTime_frame - tapes.lifted.data.update.remaining - tapes.lifted.data.update.resultCount - tapes.lifted.data.update.found hremainingResult hremainingFound - hresultFound store.length 0 inp₀ work₀ out₀ hready.count - hresultZero hfoundZero hinput - (fun i _ _ _ => hready.parked i) houtputParked - have hcopy' : - (TM.binaryCopyIntoTM - tapes.lifted.data.update.remaining - tapes.lifted.data.update.resultCount - tapes.lifted.data.update.found).HoareTime - (fun inp work out => inp = inp₀ ∧ work = work₀ ∧ out = out₀) - (fun inp work out => inp = inp₀ ∧ work = W₁ ∧ out = out₀) - (TM.binaryCopyTime store.length 0) := by - simpa only [W₁, initialAbiCountWork] using! hcopy + have hcopy' := initialAbiCount_hoareTime tapes store length inp₀ work₀ out₀ + hready hinput houtputParked have hW₁Parked : ∀ i, TM.Parked (W₁ i) := by exact parked_update hready.parked (binaryTape_parked store.length.bits) have hW₁Buffer : W₁ tapes.buffer = programBinaryPrefixTape storeBits := by @@ -1872,45 +1991,8 @@ theorem initialAbiInstallTM_hoareTime_internal simp [W₅, W₄, W₃, W₂, W₁, initialAbiBufferResetWork, initialAbiSourceWork, initialAbiCopiedWork, initialAbiBufferWork, initialAbiCountWork, hrhsBuffer, hrhsSource, hrhsResult] - have htargetsNodup : (initialCleanupTargets tapes).Nodup := by - simp [initialCleanupTargets, hlhsRhs] - have htargetsContent : ∀ i, i ∈ initialCleanupTargets tapes → - (W₅ i).HasBinaryContent (initialCleanupBits tapes length i) := by - intro i hi - simp [initialCleanupTargets] at hi - rcases hi with rfl | rfl - · rw [hW₅Lhs] - simpa [initialCleanupBits] using! hready.address.2.hasBinaryContent - · rw [hW₅Rhs] - simpa [initialCleanupBits, hlhsRhs.symm] using! - hready.value.2.hasBinaryContent - have htargetsStart : ∀ i, i ∈ initialCleanupTargets tapes → - (W₅ i).cells 0 = Γ.start := by - intro i hi - simp [initialCleanupTargets] at hi - rcases hi with rfl | rfl - · rw [hW₅Lhs] - exact hready.address.1 - · rw [hW₅Rhs] - exact hready.value.1 - have htargetsHead : ∀ i, i ∈ initialCleanupTargets tapes → - (W₅ i).head ≤ 1 := by - intro i hi - simp [initialCleanupTargets] at hi - rcases hi with rfl | rfl - · rw [hW₅Lhs, hready.address.2.1] - · rw [hW₅Rhs, hready.value.2.1] - have hresetMany := TM.resetBinaryWorkManyTM_hoareTime_frame - (initialCleanupTargets tapes) (initialCleanupBits tapes length) - (fun _ => 1) inp₀ W₅ out₀ htargetsNodup htargetsContent - htargetsStart htargetsHead hinput hW₅Parked houtputParked - have hresetMany' : - (TM.resetBinaryWorkManyTM (initialCleanupTargets tapes)).HoareTime - (fun inp work out => inp = inp₀ ∧ work = W₅ ∧ out = out₀) - (fun inp work out => inp = inp₀ ∧ work = W₆ ∧ out = out₀) - (TM.resetBinaryWorkManyTime (initialCleanupBits tapes length) - (fun _ => 1) (initialCleanupTargets tapes)) := by - simpa only [W₆, initialAbiFinalWork] using! hresetMany + have hresetMany' := initialAbiCleanup_hoareTime tapes store length inp₀ work₀ W₅ out₀ + hready hW₅Lhs hW₅Rhs hinput hW₅Parked houtputParked have htail₅ := TM.seqTM_hoareTime (TM.resetBinaryWorkTM tapes.buffer) (TM.resetBinaryWorkManyTM (initialCleanupTargets tapes)) diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Internal.lean index b0a3d61d81..00409e5ef3 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Internal.lean @@ -117,6 +117,120 @@ private theorem programSnapshotWork_other Function.update_of_ne hsource] rfl +/-- The snapshot's source and blank scratch slots initialize the entry scanner. -/ +private theorem programSnapshotWork_scanner + (tapes : ControlInstructionTapes n) (snapshot : Snapshot) + (work : Fin (n + 1) → Tape) + (hsource : work tapes.liftedSource = + programBinaryTape (snapshot.store.flatMap Entry.encode)) + (hdataBlank : ∀ (slot : Fin 18), slot ≠ 0 → slot ≠ 9 → slot ≠ 12 → + work (tapes.lifted.data.idx slot) = TM.resetBinaryBlank) + (hparked : ∀ i, TM.Parked (work i)) : + EntryScanReady tapes.lifted.data.lhsLookup.scan.entry + (snapshot.store.flatMap Entry.encode) [] work work := by + let entry := tapes.lifted.data.lhsLookup.scan.entry + have hblankNat : TM.resetBinaryBlank.HasBinaryNat 0 := by + simpa [TM.resetBinaryBlank] using! Tape.init_move_right_hasBinaryNat 0 + have hblankString : TM.resetBinaryBlank.HasBinaryString [] := hblankNat.2 + have hblankPrefix : TM.resetBinaryBlank.HasBinaryPrefix [] := + ⟨by simpa using! hblankString.1, hblankString.2⟩ + have hblankStart : TM.resetBinaryBlank.cells 0 = Γ.start := hblankNat.1 + have hslotOther (slot : Fin 9) (hslot : slot ≠ 0) : + work (entry.idx slot) = TM.resetBinaryBlank := by + fin_cases slot + · exact (hslot rfl).elim + · simpa [entry, BinaryInstructionTapes.lhsLookup, + BinaryInstructionTapes.lhsLookupSlot] using! + hdataBlank 1 (by decide) (by decide) (by decide) + · simpa [entry, BinaryInstructionTapes.lhsLookup, + BinaryInstructionTapes.lhsLookupSlot] using! + hdataBlank 2 (by decide) (by decide) (by decide) + · simpa [entry, BinaryInstructionTapes.lhsLookup, + BinaryInstructionTapes.lhsLookupSlot] using! + hdataBlank 3 (by decide) (by decide) (by decide) + · simpa [entry, BinaryInstructionTapes.lhsLookup, + BinaryInstructionTapes.lhsLookupSlot] using! + hdataBlank 4 (by decide) (by decide) (by decide) + · simpa [entry, BinaryInstructionTapes.lhsLookup, + BinaryInstructionTapes.lhsLookupSlot] using! + hdataBlank 5 (by decide) (by decide) (by decide) + · simpa [entry, BinaryInstructionTapes.lhsLookup, + BinaryInstructionTapes.lhsLookupSlot] using! + hdataBlank 6 (by decide) (by decide) (by decide) + · simpa [entry, BinaryInstructionTapes.lhsLookup, + BinaryInstructionTapes.lhsLookupSlot] using! + hdataBlank 7 (by decide) (by decide) (by decide) + · simpa [entry, BinaryInstructionTapes.lhsLookup, + BinaryInstructionTapes.lhsLookupSlot] using! + hdataBlank 8 (by decide) (by decide) (by decide) + refine + { source := by + change (work tapes.liftedSource).HasBinarySuffix _ + rw [hsource] + exact Tape.init_move_right_hasBinarySuffix _ + address := by + rw [show work entry.address = TM.resetBinaryBlank by + simpa only [EntryMatchTapes.address] using! + hslotOther 1 (by decide)] + exact hblankPrefix + addressStart := by + rw [show work entry.address = TM.resetBinaryBlank by + simpa only [EntryMatchTapes.address] using! + hslotOther 1 (by decide)] + exact hblankStart + value := by + rw [show work entry.value = TM.resetBinaryBlank by + simpa only [EntryMatchTapes.value] using! + hslotOther 2 (by decide)] + exact hblankPrefix + valueStart := by + rw [show work entry.value = TM.resetBinaryBlank by + simpa only [EntryMatchTapes.value] using! + hslotOther 2 (by decide)] + exact hblankStart + addressCounter := by + rw [show work entry.addressCounter = TM.resetBinaryBlank by + simpa only [EntryMatchTapes.addressCounter] using! + hslotOther 3 (by decide)] + exact hblankNat + addressWidth := by + rw [show work entry.addressWidth = TM.resetBinaryBlank by + simpa only [EntryMatchTapes.addressWidth] using! + hslotOther 4 (by decide)] + exact hblankNat + valueCounter := by + rw [show work entry.valueCounter = TM.resetBinaryBlank by + simpa only [EntryMatchTapes.valueCounter] using! + hslotOther 5 (by decide)] + exact hblankNat + valueWidth := by + rw [show work entry.valueWidth = TM.resetBinaryBlank by + simpa only [EntryMatchTapes.valueWidth] using! + hslotOther 6 (by decide)] + exact hblankNat + query := by + rw [show work entry.query = TM.resetBinaryBlank by + simpa only [EntryMatchTapes.query] using! + hslotOther 7 (by decide)] + exact hblankString + queryStart := by + rw [show work entry.query = TM.resetBinaryBlank by + simpa only [EntryMatchTapes.query] using! + hslotOther 7 (by decide)] + exact hblankStart + result := by + rw [show work entry.result = TM.resetBinaryBlank by + simpa only [EntryMatchTapes.result] using! + hslotOther 8 (by decide)] + exact hblankPrefix + resultStart := by + rw [show work entry.result = TM.resetBinaryBlank by + simpa only [EntryMatchTapes.result] using! + hslotOther 8 (by decide)] + exact hblankStart + parked := hparked + frame := by intros; rfl } + /-- The exact snapshot work image satisfies the complete reusable instruction ABI whenever its sparse store is canonical. -/ theorem programSnapshotWork_ready_internal @@ -129,10 +243,6 @@ theorem programSnapshotWork_ready_internal change InstructionExecutionReady tapes snapshot.store snapshot.pc work have hblankNat : TM.resetBinaryBlank.HasBinaryNat 0 := by simpa [TM.resetBinaryBlank] using! Tape.init_move_right_hasBinaryNat 0 - have hblankString : TM.resetBinaryBlank.HasBinaryString [] := hblankNat.2 - have hblankPrefix : TM.resetBinaryBlank.HasBinaryPrefix [] := - ⟨by simpa using! hblankString.1, hblankString.2⟩ - have hblankStart : TM.resetBinaryBlank.cells 0 = Γ.start := hblankNat.1 have hsource : work tapes.liftedSource = programBinaryTape (snapshot.store.flatMap Entry.encode) := by exact programSnapshotWork_source tapes snapshot @@ -180,102 +290,8 @@ theorem programSnapshotWork_ready_internal · rw [hother i hsi hri hci hpi] exact blank_parked have hscanner : EntryScanReady entry - (snapshot.store.flatMap Entry.encode) [] work work := by - have hslotOther (slot : Fin 9) (hslot : slot ≠ 0) : - work (entry.idx slot) = TM.resetBinaryBlank := by - fin_cases slot - · exact (hslot rfl).elim - · simpa [entry, BinaryInstructionTapes.lhsLookup, - BinaryInstructionTapes.lhsLookupSlot] using! - hdataBlank 1 (by decide) (by decide) (by decide) - · simpa [entry, BinaryInstructionTapes.lhsLookup, - BinaryInstructionTapes.lhsLookupSlot] using! - hdataBlank 2 (by decide) (by decide) (by decide) - · simpa [entry, BinaryInstructionTapes.lhsLookup, - BinaryInstructionTapes.lhsLookupSlot] using! - hdataBlank 3 (by decide) (by decide) (by decide) - · simpa [entry, BinaryInstructionTapes.lhsLookup, - BinaryInstructionTapes.lhsLookupSlot] using! - hdataBlank 4 (by decide) (by decide) (by decide) - · simpa [entry, BinaryInstructionTapes.lhsLookup, - BinaryInstructionTapes.lhsLookupSlot] using! - hdataBlank 5 (by decide) (by decide) (by decide) - · simpa [entry, BinaryInstructionTapes.lhsLookup, - BinaryInstructionTapes.lhsLookupSlot] using! - hdataBlank 6 (by decide) (by decide) (by decide) - · simpa [entry, BinaryInstructionTapes.lhsLookup, - BinaryInstructionTapes.lhsLookupSlot] using! - hdataBlank 7 (by decide) (by decide) (by decide) - · simpa [entry, BinaryInstructionTapes.lhsLookup, - BinaryInstructionTapes.lhsLookupSlot] using! - hdataBlank 8 (by decide) (by decide) (by decide) - refine - { source := by - change (work tapes.liftedSource).HasBinarySuffix _ - rw [hsource] - exact Tape.init_move_right_hasBinarySuffix _ - address := by - rw [show work entry.address = TM.resetBinaryBlank by - simpa only [EntryMatchTapes.address] using! - hslotOther 1 (by decide)] - exact hblankPrefix - addressStart := by - rw [show work entry.address = TM.resetBinaryBlank by - simpa only [EntryMatchTapes.address] using! - hslotOther 1 (by decide)] - exact hblankStart - value := by - rw [show work entry.value = TM.resetBinaryBlank by - simpa only [EntryMatchTapes.value] using! - hslotOther 2 (by decide)] - exact hblankPrefix - valueStart := by - rw [show work entry.value = TM.resetBinaryBlank by - simpa only [EntryMatchTapes.value] using! - hslotOther 2 (by decide)] - exact hblankStart - addressCounter := by - rw [show work entry.addressCounter = TM.resetBinaryBlank by - simpa only [EntryMatchTapes.addressCounter] using! - hslotOther 3 (by decide)] - exact hblankNat - addressWidth := by - rw [show work entry.addressWidth = TM.resetBinaryBlank by - simpa only [EntryMatchTapes.addressWidth] using! - hslotOther 4 (by decide)] - exact hblankNat - valueCounter := by - rw [show work entry.valueCounter = TM.resetBinaryBlank by - simpa only [EntryMatchTapes.valueCounter] using! - hslotOther 5 (by decide)] - exact hblankNat - valueWidth := by - rw [show work entry.valueWidth = TM.resetBinaryBlank by - simpa only [EntryMatchTapes.valueWidth] using! - hslotOther 6 (by decide)] - exact hblankNat - query := by - rw [show work entry.query = TM.resetBinaryBlank by - simpa only [EntryMatchTapes.query] using! - hslotOther 7 (by decide)] - exact hblankString - queryStart := by - rw [show work entry.query = TM.resetBinaryBlank by - simpa only [EntryMatchTapes.query] using! - hslotOther 7 (by decide)] - exact hblankStart - result := by - rw [show work entry.result = TM.resetBinaryBlank by - simpa only [EntryMatchTapes.result] using! - hslotOther 8 (by decide)] - exact hblankPrefix - resultStart := by - rw [show work entry.result = TM.resetBinaryBlank by - simpa only [EntryMatchTapes.result] using! - hslotOther 8 (by decide)] - exact hblankStart - parked := hparked - frame := by intros; rfl } + (snapshot.store.flatMap Entry.encode) [] work work := + programSnapshotWork_scanner tapes snapshot work hsource hdataBlank hparked have hlookup : EntryLookupStaticReady tapes.lifted.data.lhsLookup snapshot.store work := by refine @@ -771,6 +787,83 @@ theorem instructionHaltVerdictTM_hoareTime_frame_internal rw [hinp, hworkEq, hout] exact ⟨final, 1, le_rfl, .step hstep .zero, rfl, rfl, rfl, rfl⟩ +/-- An empty dispatch program resets its selector and emits the halt verdict. -/ +private theorem dispatchHaltEmpty_hoareTime_frame + (tapes : ControlInstructionTapes n) + (store : Store) (pcValue selector : ℕ) + (cleanWork work₀ : Fin (n + 1) → Tape) (inp₀ : Tape) + (hready : DispatchReady tapes store pcValue selector cleanWork work₀) + (hinput : TM.Parked inp₀) : + (dispatchHaltTM tapes ([] : Program)).HoareTime + (fun inp work out => + inp = inp₀ ∧ work = work₀ ∧ + out = (Tape.init []).move Dir3.right) + (fun inp work out => + inp = inp₀ ∧ work = cleanWork ∧ + out = instructionHaltOutput + (selectedInstruction ([] : Program) selector)) + (dispatchHaltTime tapes ([] : Program) selector) := by + let blankTape := (Tape.init []).move Dir3.right + have hselector : (work₀ tapes.liftedLhs).HasBinaryNat selector := by + rw [hready.2] + simp only [Function.update_self] + exact Tape.init_move_right_hasBinaryNat selector + have hcleanLhs : cleanWork tapes.liftedLhs = blankTape := by + have hzero := hready.1.control.lookup.destination + change (cleanWork tapes.liftedLhs).HasBinaryNat 0 at hzero + simpa only [blankTape] using! + Tape.HasBinaryNat.eq_init_move_right hzero + have hwork₀Parked : ∀ i, TM.Parked (work₀ i) := by + intro i + rw [hready.2] + by_cases hi : i = tapes.liftedLhs + · subst i + simp only [Function.update_self] + exact hasBinaryNat_parked + (Tape.init_move_right_hasBinaryNat selector) + · simp only [Function.update_of_ne hi] + exact hready.1.control.lookup.scanner.parked i + have hreset := TM.resetBinaryWorkTM_hoareTime_frame tapes.liftedLhs + selector.bits 1 inp₀ work₀ ((Tape.init []).move Dir3.right) + hselector.2.hasBinaryContent hselector.1 + ⟨by rw [hselector.2.1], by rw [hselector.2.1]⟩ + hinput (fun i _ => hwork₀Parked i) blank_parked + have hreset' : (TM.resetBinaryWorkTM tapes.liftedLhs).HoareTime + (fun inp work out => + inp = inp₀ ∧ work = work₀ ∧ + out = (Tape.init []).move Dir3.right) + (fun inp work out => + inp = inp₀ ∧ work = cleanWork ∧ + out = (Tape.init []).move Dir3.right) + (TM.resetBinaryWorkTime 1 selector.bits.length) := by + apply hreset.consequence + · exact fun _ _ _ h => h + · rintro inp work out ⟨hinp, hworkEq, hout⟩ + refine ⟨hinp, ?_, hout⟩ + rw [hworkEq, hready.2, Function.update_idem] + change Function.update cleanWork tapes.liftedLhs blankTape = cleanWork + rw [← hcleanLhs, Function.update_eq_self] + · exact le_rfl + have hverdict := instructionHaltVerdictTM_hoareTime_frame_internal + (.halt : Instr) inp₀ cleanWork hinput + hready.1.control.lookup.scanner.parked + have hseq := TM.seqTM_hoareTime + (TM.resetBinaryWorkTM tapes.liftedLhs) + (instructionHaltVerdictTM (.halt : Instr)) hreset' + (by + rintro inp work out ⟨hinp, hworkEq, hout⟩ + obtain ⟨hi, hw, ho⟩ := phaseTransition_of_parked + (inp := inp) (work := work) (out := out) + (by simpa [hinp] using! hinput) + (by simpa [hworkEq] using! + hready.1.control.lookup.scanner.parked) + (by simpa [hout] using! blank_parked) + rw [hi, hw, ho] + exact ⟨hinp, hworkEq, hout⟩) + hverdict + simpa only [dispatchHaltTM, dispatchHaltTime, + selectedInstruction] using! hseq + /-- The decrementing selector emits the verdict of the selected instruction and restores its scratch tape to the clean ABI. -/ theorem dispatchHaltTM_hoareTime_frame_internal @@ -790,66 +883,8 @@ theorem dispatchHaltTM_hoareTime_frame_internal (dispatchHaltTime tapes program selector) := by induction program generalizing selector work₀ with | nil => - let blankTape := (Tape.init []).move Dir3.right - have hselector : (work₀ tapes.liftedLhs).HasBinaryNat selector := by - rw [hready.2] - simp only [Function.update_self] - exact Tape.init_move_right_hasBinaryNat selector - have hcleanLhs : cleanWork tapes.liftedLhs = blankTape := by - have hzero := hready.1.control.lookup.destination - change (cleanWork tapes.liftedLhs).HasBinaryNat 0 at hzero - simpa only [blankTape] using! - Tape.HasBinaryNat.eq_init_move_right hzero - have hwork₀Parked : ∀ i, TM.Parked (work₀ i) := by - intro i - rw [hready.2] - by_cases hi : i = tapes.liftedLhs - · subst i - simp only [Function.update_self] - exact hasBinaryNat_parked - (Tape.init_move_right_hasBinaryNat selector) - · simp only [Function.update_of_ne hi] - exact hready.1.control.lookup.scanner.parked i - have hreset := TM.resetBinaryWorkTM_hoareTime_frame tapes.liftedLhs - selector.bits 1 inp₀ work₀ ((Tape.init []).move Dir3.right) - hselector.2.hasBinaryContent hselector.1 - ⟨by rw [hselector.2.1], by rw [hselector.2.1]⟩ - hinput (fun i _ => hwork₀Parked i) blank_parked - have hreset' : (TM.resetBinaryWorkTM tapes.liftedLhs).HoareTime - (fun inp work out => - inp = inp₀ ∧ work = work₀ ∧ - out = (Tape.init []).move Dir3.right) - (fun inp work out => - inp = inp₀ ∧ work = cleanWork ∧ - out = (Tape.init []).move Dir3.right) - (TM.resetBinaryWorkTime 1 selector.bits.length) := by - apply hreset.consequence - · exact fun _ _ _ h => h - · rintro inp work out ⟨hinp, hworkEq, hout⟩ - refine ⟨hinp, ?_, hout⟩ - rw [hworkEq, hready.2, Function.update_idem] - change Function.update cleanWork tapes.liftedLhs blankTape = cleanWork - rw [← hcleanLhs, Function.update_eq_self] - · exact le_rfl - have hverdict := instructionHaltVerdictTM_hoareTime_frame_internal - (.halt : Instr) inp₀ cleanWork hinput - hready.1.control.lookup.scanner.parked - have hseq := TM.seqTM_hoareTime - (TM.resetBinaryWorkTM tapes.liftedLhs) - (instructionHaltVerdictTM (.halt : Instr)) hreset' - (by - rintro inp work out ⟨hinp, hworkEq, hout⟩ - obtain ⟨hi, hw, ho⟩ := phaseTransition_of_parked - (inp := inp) (work := work) (out := out) - (by simpa [hinp] using! hinput) - (by simpa [hworkEq] using! - hready.1.control.lookup.scanner.parked) - (by simpa [hout] using! blank_parked) - rw [hi, hw, ho] - exact ⟨hinp, hworkEq, hout⟩) - hverdict - simpa only [dispatchHaltTM, dispatchHaltTime, - selectedInstruction] using! hseq + exact dispatchHaltEmpty_hoareTime_frame tapes store pcValue selector + cleanWork work₀ inp₀ hready hinput | cons instruction program ih => let pre : TM.TapePred (n + 1) := fun inp work out => inp = inp₀ ∧ work = work₀ ∧ From fcd9719b129a4adfcd44c5e63ef192a5ca3176cd Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Fri, 25 Sep 2026 21:16:34 +0000 Subject: [PATCH 38/49] Factor conditional compilation and binary arithmetic scan proofs --- .../Machine/Instruction/Sim/Control.lean | 156 +++++---- .../Structured/Internal.lean | 191 +++++----- .../Subroutines/BinaryPred/Internal.lean | 249 +++++++------ .../BinaryRippleAdd/Internal/Scan.lean | 301 ++++++++-------- .../BinaryRippleSub/Internal/Scan.lean | 328 ++++++++++-------- 5 files changed, 675 insertions(+), 550 deletions(-) diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Sim/Control.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Sim/Control.lean index bb8728658e..4e5b649f37 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Sim/Control.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Sim/Control.lean @@ -43,6 +43,94 @@ private theorem hasBinaryPrefix_parked {t : Tape} {bits : List Bool} · rw [h.2.2 i (Nat.le_of_not_gt hi)] decide +/-- Restore the empty entry scanner after copying a control instruction's store buffer. -/ +private theorem controlCopy_entryScannerReady + (tapes : ControlInstructionTapes n) (store : Store) (newPC : ℕ) + (initialWork work finalWork : Fin (n + 1) → Tape) + (hcontrolResult : + ControlInstructionResult tapes.lifted store newPC initialWork work) : + let bits := store.flatMap Entry.encode + let source := tapes.liftedSource + let buffer := tapes.buffer + (∀ i, i ≠ source → i ≠ buffer → finalWork i = work i) → + (∀ i, TM.Parked (finalWork i)) → + (work source).HasBinarySuffix bits → + (finalWork source).cells = (work source).cells → + (finalWork source).head = bits.length + 1 → + (finalWork source).HasOutput bits → + EntryScanReady tapes.lifted.data.update.entry [] [] finalWork finalWork := by + dsimp only + intro hotherFrame hfinalParked hsourceSuffix hsourceCells + hsourceFinalHead hsourceFinalOutput + let bits := store.flatMap Entry.encode + let source := tapes.liftedSource + let buffer := tapes.buffer + let entry := tapes.lifted.data.update.entry + have hrole (slot : Fin 9) (hne : slot ≠ 0) : + finalWork (entry.idx slot) = work (entry.idx slot) := by + exact hotherFrame _ (entry.ne hne) + (tapes.liftedData_ne_buffer ⟨slot, by omega⟩) + refine + { source := ?_ + address := by + change (finalWork (entry.idx 1)).HasBinaryPrefix [] + rw [hrole 1 (by decide)] + exact hcontrolResult.ready.lookup.scanner.address + addressStart := by + change (finalWork (entry.idx 1)).cells 0 = Γ.start + rw [hrole 1 (by decide)] + exact hcontrolResult.ready.lookup.scanner.addressStart + value := by + change (finalWork (entry.idx 2)).HasBinaryPrefix [] + rw [hrole 2 (by decide)] + exact hcontrolResult.ready.lookup.scanner.value + valueStart := by + change (finalWork (entry.idx 2)).cells 0 = Γ.start + rw [hrole 2 (by decide)] + exact hcontrolResult.ready.lookup.scanner.valueStart + addressCounter := by + change (finalWork (entry.idx 3)).HasBinaryNat 0 + rw [hrole 3 (by decide)] + exact hcontrolResult.ready.lookup.scanner.addressCounter + addressWidth := by + change (finalWork (entry.idx 4)).HasBinaryNat 0 + rw [hrole 4 (by decide)] + exact hcontrolResult.ready.lookup.scanner.addressWidth + valueCounter := by + change (finalWork (entry.idx 5)).HasBinaryNat 0 + rw [hrole 5 (by decide)] + exact hcontrolResult.ready.lookup.scanner.valueCounter + valueWidth := by + change (finalWork (entry.idx 6)).HasBinaryNat 0 + rw [hrole 6 (by decide)] + exact hcontrolResult.ready.lookup.scanner.valueWidth + query := by + change (finalWork (entry.idx 7)).HasBinaryString [] + rw [hrole 7 (by decide)] + exact hcontrolResult.ready.lookup.scanner.query + queryStart := by + change (finalWork (entry.idx 7)).cells 0 = Γ.start + rw [hrole 7 (by decide)] + exact hcontrolResult.ready.lookup.scanner.queryStart + result := by + change (finalWork (entry.idx 8)).HasBinaryPrefix [] + rw [hrole 8 (by decide)] + exact hcontrolResult.ready.lookup.scanner.result + resultStart := by + change (finalWork (entry.idx 8)).cells 0 = Γ.start + rw [hrole 8 (by decide)] + exact hcontrolResult.ready.lookup.scanner.resultStart + parked := hfinalParked + frame := by intro i _ _ _ _ _ _ _ _ _; rfl } + change (finalWork source).HasBinarySuffix [] + refine ⟨by omega, ?_, ?_, ?_⟩ + · intro i hi + simp at hi + · simpa [hsourceFinalHead, Nat.add_comm] using! hsourceFinalOutput.2 + · intro j hj + rw [hsourceCells] + exact hsourceSuffix.2.2.2 j hj + private theorem finishControlInstructionTM_hoareTime_frame_internal (tapes : ControlInstructionTapes n) (store : Store) (pcValue newPC : ℕ) (initialWork : Fin (n + 1) → Tape) @@ -226,71 +314,9 @@ private theorem finishControlInstructionTM_hoareTime_frame_internal · exact hotherParked i hiSource hiBuffer have hfinalScanner : EntryScanReady tapes.lifted.data.update.entry [] [] final.work final.work := by - let entry := tapes.lifted.data.update.entry - have hrole (slot : Fin 9) (hne : slot ≠ 0) : - final.work (entry.idx slot) = work (entry.idx slot) := by - exact hotherFrame _ (entry.ne hne) - (tapes.liftedData_ne_buffer ⟨slot, by omega⟩) - refine - { source := ?_ - address := by - change (final.work (entry.idx 1)).HasBinaryPrefix [] - rw [hrole 1 (by decide)] - exact hcontrolResult.ready.lookup.scanner.address - addressStart := by - change (final.work (entry.idx 1)).cells 0 = Γ.start - rw [hrole 1 (by decide)] - exact hcontrolResult.ready.lookup.scanner.addressStart - value := by - change (final.work (entry.idx 2)).HasBinaryPrefix [] - rw [hrole 2 (by decide)] - exact hcontrolResult.ready.lookup.scanner.value - valueStart := by - change (final.work (entry.idx 2)).cells 0 = Γ.start - rw [hrole 2 (by decide)] - exact hcontrolResult.ready.lookup.scanner.valueStart - addressCounter := by - change (final.work (entry.idx 3)).HasBinaryNat 0 - rw [hrole 3 (by decide)] - exact hcontrolResult.ready.lookup.scanner.addressCounter - addressWidth := by - change (final.work (entry.idx 4)).HasBinaryNat 0 - rw [hrole 4 (by decide)] - exact hcontrolResult.ready.lookup.scanner.addressWidth - valueCounter := by - change (final.work (entry.idx 5)).HasBinaryNat 0 - rw [hrole 5 (by decide)] - exact hcontrolResult.ready.lookup.scanner.valueCounter - valueWidth := by - change (final.work (entry.idx 6)).HasBinaryNat 0 - rw [hrole 6 (by decide)] - exact hcontrolResult.ready.lookup.scanner.valueWidth - query := by - change (final.work (entry.idx 7)).HasBinaryString [] - rw [hrole 7 (by decide)] - exact hcontrolResult.ready.lookup.scanner.query - queryStart := by - change (final.work (entry.idx 7)).cells 0 = Γ.start - rw [hrole 7 (by decide)] - exact hcontrolResult.ready.lookup.scanner.queryStart - result := by - change (final.work (entry.idx 8)).HasBinaryPrefix [] - rw [hrole 8 (by decide)] - exact hcontrolResult.ready.lookup.scanner.result - resultStart := by - change (final.work (entry.idx 8)).cells 0 = Γ.start - rw [hrole 8 (by decide)] - exact hcontrolResult.ready.lookup.scanner.resultStart - parked := hfinalParked - frame := by intro i _ _ _ _ _ _ _ _ _; rfl } - change (final.work source).HasBinarySuffix [] - refine ⟨by omega, ?_, ?_, ?_⟩ - · intro i hi - simp at hi - · simpa [hsourceFinalHead, Nat.add_comm] using! hsourceFinalOutput.2 - · intro j hj - rw [hsourceCells] - exact hsourceSuffix.2.2.2 j hj + exact controlCopy_entryScannerReady tapes store newPC initialWork work + final.work hcontrolResult hotherFrame hfinalParked hsourceSuffix + hsourceCells hsourceFinalHead hsourceFinalOutput have hfinalShift : (final.work tapes.lifted.data.shift).HasBinaryNat 0 := by change (final.work (tapes.lifted.data.idx 15)).HasBinaryNat 0 diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Internal.lean index 47792a12db..5e74f07eb3 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/Internal.lean @@ -145,6 +145,112 @@ private theorem run_space_le_spaceUpto (P : Program) (fuel : ℕ) (cfg : Cfg) : max (spaceUpto P fuel cfg) (run P fuel cfg).space := le_max_right _ _ _ = spaceUpto P fuel cfg := hsplit.symm +/-- Compilation preserves the nonzero conditional branch, including its exit jump cost. -/ +private theorem compileAt_ifNonzero_correct + {test : ℕ} {onZero onNonzero : Cmd} {store final : Store} + {branchSteps branchCost branchSpace : ℕ} + (htest : store test ≠ 0) + (ih : ∀ (pre suffix : Program), + let P := pre ++ onNonzero.compileAt pre.length ++ suffix + let start : Cfg := { pc := pre.length, regs := store } + run P branchSteps start = + { pc := pre.length + onNonzero.codeSize, regs := final } ∧ + logTimeUpto P branchSteps start = branchCost ∧ + spaceUpto P branchSteps start = branchSpace) + (pre suffix : Program) : + let cmd := Cmd.ifZero test onZero onNonzero + let P := pre ++ cmd.compileAt pre.length ++ suffix + let start : Cfg := { pc := pre.length, regs := store } + run P (branchSteps + 2) start = + { pc := pre.length + cmd.codeSize, regs := final } ∧ + logTimeUpto P (branchSteps + 2) start = + bitlen (store test) + 1 + branchCost + 1 ∧ + spaceUpto P (branchSteps + 2) start = max store.space branchSpace := by + dsimp only + simp only [Cmd.compileAt, Cmd.codeSize] + let zeroStart := pre.length + 1 + onNonzero.codeSize + 1 + let done := pre.length + (2 + onZero.codeSize + onNonzero.codeSize) + let nonzeroPre := pre ++ [Instr.jz test zeroStart] + have hNonzeroPre : nonzeroPre.length = pre.length + 1 := by + simp [nonzeroPre] + have hbranchRun := ih nonzeroPre + (Instr.jmp done :: onZero.compileAt zeroStart ++ suffix) + simp only [hNonzeroPre] at hbranchRun + dsimp only [nonzeroPre, zeroStart, done] at hbranchRun ⊢ + simp only [List.nil_append, List.cons_append, List.append_assoc] + at hbranchRun ⊢ + let jmpPre := pre ++ + [Instr.jz test (pre.length + 1 + onNonzero.codeSize + 1)] ++ + onNonzero.compileAt (pre.length + 1) + have hjmp := step_jmp jmpPre + (onZero.compileAt (pre.length + 1 + onNonzero.codeSize + 1) ++ suffix) + (pre.length + (2 + onZero.codeSize + onNonzero.codeSize)) final + dsimp only [jmpPre] at hjmp + have hjmp' : + step + (pre ++ Instr.jz test (pre.length + 1 + onNonzero.codeSize + 1) :: + (onNonzero.compileAt (pre.length + 1) ++ + Instr.jmp (pre.length + (2 + onZero.codeSize + onNonzero.codeSize)) :: + (onZero.compileAt (pre.length + 1 + onNonzero.codeSize + 1) ++ suffix))) + { pc := pre.length + 1 + onNonzero.codeSize, regs := final } = + { pc := pre.length + (2 + onZero.codeSize + onNonzero.codeSize), + regs := final } := by + simpa [Cmd.length_compileAt, Nat.add_assoc, Nat.add_comm, + Nat.add_left_comm] using hjmp + have hjmpInstr := curInstr_append_head jmpPre + (onZero.compileAt (pre.length + 1 + onNonzero.codeSize + 1) ++ suffix) + (Instr.jmp (pre.length + (2 + onZero.codeSize + onNonzero.codeSize))) final + dsimp only [jmpPre] at hjmpInstr + have hjmpInstr' : + curInstr + (pre ++ Instr.jz test (pre.length + 1 + onNonzero.codeSize + 1) :: + (onNonzero.compileAt (pre.length + 1) ++ + Instr.jmp (pre.length + (2 + onZero.codeSize + onNonzero.codeSize)) :: + (onZero.compileAt (pre.length + 1 + onNonzero.codeSize + 1) ++ suffix))) + { pc := pre.length + 1 + onNonzero.codeSize, regs := final } = + Instr.jmp (pre.length + (2 + onZero.codeSize + onNonzero.codeSize)) := by + simpa [Cmd.length_compileAt, Nat.add_assoc, Nat.add_comm, + Nat.add_left_comm] using hjmpInstr + have hjmpHalt : + ¬Halted + (pre ++ Instr.jz test (pre.length + 1 + onNonzero.codeSize + 1) :: + (onNonzero.compileAt (pre.length + 1) ++ + Instr.jmp (pre.length + (2 + onZero.codeSize + onNonzero.codeSize)) :: + (onZero.compileAt (pre.length + 1 + onNonzero.codeSize + 1) ++ suffix))) + { pc := pre.length + 1 + onNonzero.codeSize, regs := final } := by + simp [Halted, hjmpInstr'] + rw [run_succ, logTimeUpto_succ] + simp [Halted, curInstr] + rw [step_jz_nonzero pre _ test _ store htest] + rw [run_succ_step, hbranchRun.1] + rw [hjmp'] + rw [logTimeUpto_add _ branchSteps 1] + rw [hbranchRun.2.1, hbranchRun.1] + rw [show (1 : ℕ) = 0 + 1 from rfl, logTimeUpto_succ] + rw [ite_eq_right hjmpHalt] + simp [stepLogCost, hjmpInstr', Instr.logCost] + rw [spaceUpto] + simp [Halted, curInstr] + rw [step_jz_nonzero pre _ test _ store htest] + rw [spaceUpto_add _ branchSteps 1, hbranchRun.2.2, hbranchRun.1] + rw [show (1 : ℕ) = 0 + 1 from rfl, spaceUpto] + rw [ite_eq_right hjmpHalt, hjmp'] + simp only [spaceUpto] + have hfinalSpace : final.space ≤ branchSpace := by + have hrunSpace := run_space_le_spaceUpto + (pre ++ Instr.jz test (pre.length + 1 + onNonzero.codeSize + 1) :: + (onNonzero.compileAt (pre.length + 1) ++ + Instr.jmp (pre.length + (2 + onZero.codeSize + onNonzero.codeSize)) :: + (onZero.compileAt (pre.length + 1 + onNonzero.codeSize + 1) ++ suffix))) + branchSteps { pc := pre.length + 1, regs := store } + rw [hbranchRun.1, hbranchRun.2.2] at hrunSpace + simpa [Store.space, Cfg.space] using hrunSpace + constructor + · omega + · change max store.space (max branchSpace (max final.space final.space)) = + max store.space branchSpace + rw [max_self, max_eq_left hfinalSpace] + theorem compileAt_correct_internal {cmd : Cmd} {initial final : Store} {steps cost space : ℕ} (hexec : Exec cmd initial final steps cost space) @@ -213,90 +319,7 @@ theorem compileAt_correct_internal Cfg.space, Nat.add_assoc, Nat.add_comm, Nat.add_left_comm] all_goals omega | ifNonzero htest hbranch ih => - rename_i test onZero onNonzero store final branchSteps branchCost branchSpace - simp only [Cmd.compileAt, Cmd.codeSize] - let zeroStart := pre.length + 1 + onNonzero.codeSize + 1 - let done := pre.length + (2 + onZero.codeSize + onNonzero.codeSize) - let nonzeroPre := pre ++ [Instr.jz test zeroStart] - have hNonzeroPre : nonzeroPre.length = pre.length + 1 := by - simp [nonzeroPre] - have hbranchRun := ih nonzeroPre - (Instr.jmp done :: onZero.compileAt zeroStart ++ suffix) - simp only [hNonzeroPre] at hbranchRun - dsimp only [nonzeroPre, zeroStart, done] at hbranchRun ⊢ - simp only [List.nil_append, List.cons_append, List.append_assoc] - at hbranchRun ⊢ - let jmpPre := pre ++ - [Instr.jz test (pre.length + 1 + onNonzero.codeSize + 1)] ++ - onNonzero.compileAt (pre.length + 1) - have hjmp := step_jmp jmpPre - (onZero.compileAt (pre.length + 1 + onNonzero.codeSize + 1) ++ suffix) - (pre.length + (2 + onZero.codeSize + onNonzero.codeSize)) final - dsimp only [jmpPre] at hjmp - have hjmp' : - step - (pre ++ Instr.jz test (pre.length + 1 + onNonzero.codeSize + 1) :: - (onNonzero.compileAt (pre.length + 1) ++ - Instr.jmp (pre.length + (2 + onZero.codeSize + onNonzero.codeSize)) :: - (onZero.compileAt (pre.length + 1 + onNonzero.codeSize + 1) ++ suffix))) - { pc := pre.length + 1 + onNonzero.codeSize, regs := final } = - { pc := pre.length + (2 + onZero.codeSize + onNonzero.codeSize), - regs := final } := by - simpa [Cmd.length_compileAt, Nat.add_assoc, Nat.add_comm, - Nat.add_left_comm] using hjmp - have hjmpInstr := curInstr_append_head jmpPre - (onZero.compileAt (pre.length + 1 + onNonzero.codeSize + 1) ++ suffix) - (Instr.jmp (pre.length + (2 + onZero.codeSize + onNonzero.codeSize))) final - dsimp only [jmpPre] at hjmpInstr - have hjmpInstr' : - curInstr - (pre ++ Instr.jz test (pre.length + 1 + onNonzero.codeSize + 1) :: - (onNonzero.compileAt (pre.length + 1) ++ - Instr.jmp (pre.length + (2 + onZero.codeSize + onNonzero.codeSize)) :: - (onZero.compileAt (pre.length + 1 + onNonzero.codeSize + 1) ++ suffix))) - { pc := pre.length + 1 + onNonzero.codeSize, regs := final } = - Instr.jmp (pre.length + (2 + onZero.codeSize + onNonzero.codeSize)) := by - simpa [Cmd.length_compileAt, Nat.add_assoc, Nat.add_comm, - Nat.add_left_comm] using hjmpInstr - have hjmpHalt : - ¬Halted - (pre ++ Instr.jz test (pre.length + 1 + onNonzero.codeSize + 1) :: - (onNonzero.compileAt (pre.length + 1) ++ - Instr.jmp (pre.length + (2 + onZero.codeSize + onNonzero.codeSize)) :: - (onZero.compileAt (pre.length + 1 + onNonzero.codeSize + 1) ++ suffix))) - { pc := pre.length + 1 + onNonzero.codeSize, regs := final } := by - simp [Halted, hjmpInstr'] - rw [run_succ, logTimeUpto_succ] - simp [Halted, curInstr] - rw [step_jz_nonzero pre _ test _ store htest] - rw [run_succ_step, hbranchRun.1] - rw [hjmp'] - rw [logTimeUpto_add _ branchSteps 1] - rw [hbranchRun.2.1, hbranchRun.1] - rw [show (1 : ℕ) = 0 + 1 from rfl, logTimeUpto_succ] - rw [ite_eq_right hjmpHalt] - simp [stepLogCost, hjmpInstr', Instr.logCost] - rw [spaceUpto] - simp [Halted, curInstr] - rw [step_jz_nonzero pre _ test _ store htest] - rw [spaceUpto_add _ branchSteps 1, hbranchRun.2.2, hbranchRun.1] - rw [show (1 : ℕ) = 0 + 1 from rfl, spaceUpto] - rw [ite_eq_right hjmpHalt, hjmp'] - simp only [spaceUpto] - have hfinalSpace : final.space ≤ branchSpace := by - have hrunSpace := run_space_le_spaceUpto - (pre ++ Instr.jz test (pre.length + 1 + onNonzero.codeSize + 1) :: - (onNonzero.compileAt (pre.length + 1) ++ - Instr.jmp (pre.length + (2 + onZero.codeSize + onNonzero.codeSize)) :: - (onZero.compileAt (pre.length + 1 + onNonzero.codeSize + 1) ++ suffix))) - branchSteps { pc := pre.length + 1, regs := store } - rw [hbranchRun.1, hbranchRun.2.2] at hrunSpace - simpa [Store.space, Cfg.space] using hrunSpace - constructor - · omega - · change max store.space (max branchSpace (max final.space final.space)) = - max store.space branchSpace - rw [max_self, max_eq_left hfinalSpace] + exact compileAt_ifNonzero_correct htest ih pre suffix | whileZero htest => rename_i test body store simp only [Cmd.compileAt, Cmd.codeSize, List.cons_append, List.append_assoc] diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryPred/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryPred/Internal.lean index 2e473f8893..141f1f17d5 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryPred/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryPred/Internal.lean @@ -446,6 +446,142 @@ private theorem binaryPredTM_rewind_run (bits : List Bool) simpa [Nat.succ_eq_add_one, Nat.add_assoc] using (TM.reachesIn.step hstep hreach) +/-- Borrowing through the last one bit erases it and rewinds the completed predecessor. -/ +private theorem binaryPredTM_borrow_terminal_one + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hinp : inp₀.read ≠ Γ.start) + (hother : ∀ i, i ≠ idx → (work₀ i).read ≠ Γ.start) + (hout : out₀.read ≠ Γ.start) : + ∀ done (c : Cfg n (binaryPredTM idx).Q), + c.state = .borrow → + c.input = inp₀ → + (∀ i, i ≠ idx → c.work i = work₀ i) → + (c.work idx).HasBinaryContent (List.replicate done true ++ [true]) → + (c.work idx).cells 0 = Γ.start → + (c.work idx).head = done + 1 → + c.output = out₀ → + ∃ c', + (binaryPredTM idx).reachesIn (done + BinaryPred.steps [true]) c c' ∧ + (binaryPredTM idx).halted c' ∧ + c'.input = inp₀ ∧ + (∀ i, i ≠ idx → c'.work i = work₀ i) ∧ + (c'.work idx).HasBinaryString + (List.replicate done true ++ BinaryPred.ripple [true]) ∧ + (c'.work idx).cells 0 = Γ.start ∧ + c'.output = out₀ := by + intro done + intro c hstate hinput hwork hcontent hcell0 hhead houtput + have hread : (c.work idx).read = Γ.one := + hcontent.binaryPred_read_cons hhead + have hstep := binaryPredTM_step_one c hstate hread + (by rw [hinput]; exact hinp) + (fun i hi => by rw [hwork i hi]; exact hother i hi) + (by rw [houtput]; exact hout) + let target₁ : Tape := + ((c.work idx).write Γ.zero).move Dir3.right + have htarget₁Content : target₁.HasBinaryContent + (List.replicate done true ++ [false]) := by + have hwrite := hcontent.write_set false hhead (by simp) + rw [BinaryPred.set_true_to_false] at hwrite + simpa only [target₁, Tape.HasBinaryContent, Tape.move_cells] + using! hwrite + have htarget₁Cell0 : target₁.cells 0 = Γ.start := by + exact Tape.write_move_cell0 Γ.zero Dir3.right hcell0 + have htarget₁Head : target₁.head = done + 2 := by + simp [target₁, Tape.move, Tape.write_head, hhead] + have htarget₁Read : target₁.read = Γ.blank := by + rw [Tape.read, htarget₁Head] + exact htarget₁Content.2 (done + 1) (by simp) + let c₁ : Cfg n (binaryPredTM idx).Q := + { state := .check + input := c.input + work := Function.update c.work idx target₁ + output := c.output } + have hcheck := binaryPredTM_step_check_blank c₁ rfl + (by simpa [c₁] using htarget₁Read) + (by rw [hinput]; exact hinp) + (fun i hi => by + simp only [c₁, Function.update_of_ne hi] + rw [hwork i hi] + exact hother i hi) + (by rw [houtput]; exact hout) + let target₂ : Tape := target₁.move Dir3.left + have htarget₂Content : target₂.HasBinaryContent + (List.replicate done true ++ [false]) := by + simpa only [target₂] using htarget₁Content.move Dir3.left + have htarget₂Cell0 : target₂.cells 0 = Γ.start := by + simpa [target₂, Tape.move_cells] using htarget₁Cell0 + have htarget₂Head : target₂.head = done + 1 := by + simp [target₂, Tape.move, htarget₁Head] + have htarget₂Read : target₂.read ≠ Γ.start := + htarget₂Content.cells_ne_start target₂.head (by + rw [htarget₂Head] + omega) + let c₂ : Cfg n (binaryPredTM idx).Q := + { state := .erase + input := c.input + work := Function.update c.work idx target₂ + output := c.output } + have herase := binaryPredTM_step_erase c₂ rfl + (by simpa [c₂] using htarget₂Read) + (by rw [hinput]; exact hinp) + (fun i hi => by + simp only [c₂, Function.update_of_ne hi] + rw [hwork i hi] + exact hother i hi) + (by rw [houtput]; exact hout) + let target₃ : Tape := + (target₂.write Γ.blank).move Dir3.left + have htarget₃Content : + target₃.HasBinaryContent (List.replicate done true) := by + have herased := htarget₂Content.binaryPred_erase_last (by + simpa using htarget₂Head) + simpa only [target₃] using herased.move Dir3.left + have htarget₃Cell0 : target₃.cells 0 = Γ.start := by + exact Tape.write_move_cell0 Γ.blank Dir3.left htarget₂Cell0 + have htarget₃Head : target₃.head = done := by + simp [target₃, Tape.move, Tape.write_head, htarget₂Head] + let c₃ : Cfg n (binaryPredTM idx).Q := + { state := .rewind + input := c.input + work := Function.update c.work idx target₃ + output := c.output } + have hcheck' : (binaryPredTM idx).step c₁ = some c₂ := by + simpa [c₁, c₂, target₂] using hcheck + have herase' : (binaryPredTM idx).step c₂ = some c₃ := by + simpa [c₂, c₃, target₃] using herase + obtain ⟨c', hreach, hhalt, hinput', hwork', hstring, + hcell0', houtput'⟩ := + binaryPredTM_rewind_run (idx := idx) + (List.replicate done true) inp₀ work₀ out₀ hinp hother + hout done c₃ rfl hinput + (fun i hi => by + show Function.update c.work idx target₃ i = work₀ i + rw [Function.update_of_ne hi] + exact hwork i hi) + (by + show (Function.update c.work idx target₃ idx) + |>.HasBinaryContent _ + rw [Function.update_self] + exact htarget₃Content) + (by + show (Function.update c.work idx target₃ idx).cells 0 = _ + rw [Function.update_self] + exact htarget₃Cell0) + (by + show (Function.update c.work idx target₃ idx).head = done + rw [Function.update_self] + exact htarget₃Head) + houtput + have hprefix : (binaryPredTM idx).reachesIn 3 c c₃ := by + exact .step hstep (.step hcheck' (.step herase' .zero)) + refine ⟨c', ?_, hhalt, hinput', hwork', ?_, hcell0', houtput'⟩ + · have hrun := reachesIn_trans (binaryPredTM idx) hprefix hreach + convert! hrun using 1 + all_goals simp [BinaryPred.steps] + all_goals omega + · simpa [BinaryPred.ripple] using hstring + private theorem binaryPredTM_borrow_run (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) (hinp : inp₀.read ≠ Γ.start) @@ -573,117 +709,8 @@ private theorem binaryPredTM_borrow_run | true => cases rest with | nil => - intro c hstate hinput hwork hcontent hcell0 hhead houtput - have hread : (c.work idx).read = Γ.one := - hcontent.binaryPred_read_cons hhead - have hstep := binaryPredTM_step_one c hstate hread - (by rw [hinput]; exact hinp) - (fun i hi => by rw [hwork i hi]; exact hother i hi) - (by rw [houtput]; exact hout) - let target₁ : Tape := - ((c.work idx).write Γ.zero).move Dir3.right - have htarget₁Content : target₁.HasBinaryContent - (List.replicate done true ++ [false]) := by - have hwrite := hcontent.write_set false hhead (by simp) - rw [BinaryPred.set_true_to_false] at hwrite - simpa only [target₁, Tape.HasBinaryContent, Tape.move_cells] - using! hwrite - have htarget₁Cell0 : target₁.cells 0 = Γ.start := by - exact Tape.write_move_cell0 Γ.zero Dir3.right hcell0 - have htarget₁Head : target₁.head = done + 2 := by - simp [target₁, Tape.move, Tape.write_head, hhead] - have htarget₁Read : target₁.read = Γ.blank := by - rw [Tape.read, htarget₁Head] - exact htarget₁Content.2 (done + 1) (by simp) - let c₁ : Cfg n (binaryPredTM idx).Q := - { state := .check - input := c.input - work := Function.update c.work idx target₁ - output := c.output } - have hcheck := binaryPredTM_step_check_blank c₁ rfl - (by simpa [c₁] using htarget₁Read) - (by rw [hinput]; exact hinp) - (fun i hi => by - simp only [c₁, Function.update_of_ne hi] - rw [hwork i hi] - exact hother i hi) - (by rw [houtput]; exact hout) - let target₂ : Tape := target₁.move Dir3.left - have htarget₂Content : target₂.HasBinaryContent - (List.replicate done true ++ [false]) := by - simpa only [target₂] using htarget₁Content.move Dir3.left - have htarget₂Cell0 : target₂.cells 0 = Γ.start := by - simpa [target₂, Tape.move_cells] using htarget₁Cell0 - have htarget₂Head : target₂.head = done + 1 := by - simp [target₂, Tape.move, htarget₁Head] - have htarget₂Read : target₂.read ≠ Γ.start := - htarget₂Content.cells_ne_start target₂.head (by - rw [htarget₂Head] - omega) - let c₂ : Cfg n (binaryPredTM idx).Q := - { state := .erase - input := c.input - work := Function.update c.work idx target₂ - output := c.output } - have herase := binaryPredTM_step_erase c₂ rfl - (by simpa [c₂] using htarget₂Read) - (by rw [hinput]; exact hinp) - (fun i hi => by - simp only [c₂, Function.update_of_ne hi] - rw [hwork i hi] - exact hother i hi) - (by rw [houtput]; exact hout) - let target₃ : Tape := - (target₂.write Γ.blank).move Dir3.left - have htarget₃Content : - target₃.HasBinaryContent (List.replicate done true) := by - have herased := htarget₂Content.binaryPred_erase_last (by - simpa using htarget₂Head) - simpa only [target₃] using herased.move Dir3.left - have htarget₃Cell0 : target₃.cells 0 = Γ.start := by - exact Tape.write_move_cell0 Γ.blank Dir3.left htarget₂Cell0 - have htarget₃Head : target₃.head = done := by - simp [target₃, Tape.move, Tape.write_head, htarget₂Head] - let c₃ : Cfg n (binaryPredTM idx).Q := - { state := .rewind - input := c.input - work := Function.update c.work idx target₃ - output := c.output } - have hcheck' : (binaryPredTM idx).step c₁ = some c₂ := by - simpa [c₁, c₂, target₂] using hcheck - have herase' : (binaryPredTM idx).step c₂ = some c₃ := by - simpa [c₂, c₃, target₃] using herase - obtain ⟨c', hreach, hhalt, hinput', hwork', hstring, - hcell0', houtput'⟩ := - binaryPredTM_rewind_run (idx := idx) - (List.replicate done true) inp₀ work₀ out₀ hinp hother - hout done c₃ rfl hinput - (fun i hi => by - show Function.update c.work idx target₃ i = work₀ i - rw [Function.update_of_ne hi] - exact hwork i hi) - (by - show (Function.update c.work idx target₃ idx) - |>.HasBinaryContent _ - rw [Function.update_self] - exact htarget₃Content) - (by - show (Function.update c.work idx target₃ idx).cells 0 = _ - rw [Function.update_self] - exact htarget₃Cell0) - (by - show (Function.update c.work idx target₃ idx).head = done - rw [Function.update_self] - exact htarget₃Head) - houtput - have hprefix : (binaryPredTM idx).reachesIn 3 c c₃ := by - exact .step hstep (.step hcheck' (.step herase' .zero)) - refine ⟨c', ?_, hhalt, hinput', hwork', ?_, hcell0', houtput'⟩ - · have hrun := reachesIn_trans (binaryPredTM idx) hprefix hreach - convert! hrun using 1 - all_goals simp [BinaryPred.steps] - all_goals omega - · simpa [BinaryPred.ripple] using hstring + exact binaryPredTM_borrow_terminal_one inp₀ work₀ out₀ + hinp hother hout done | cons next rest => intro c hstate hinput hwork hcontent hcell0 hhead houtput have hread : (c.work idx).read = Γ.one := diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleAdd/Internal/Scan.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleAdd/Internal/Scan.lean index 58652de409..386a0d5da3 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleAdd/Internal/Scan.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleAdd/Internal/Scan.lean @@ -195,6 +195,159 @@ private theorem binaryRippleAddScanTM_step_terminal {n : ℕ} · intro i _ _ hires simp [finalWork, hires] +/-- With the left input exhausted, ripple addition consumes the right suffix and carry. -/ +/-- Writing one ripple-add output bit extends its prefix without changing the start marker. -/ +private theorem binaryRippleAddScanAdvanceWork_result {n : ℕ} + (lhsIdx rhsIdx resultIdx : Fin n) (sum : Bool) (emitted : List Bool) + (work₀ : Fin n → Tape) + (hresult : (work₀ resultIdx).HasBinaryPrefix emitted) + (hresultStart : (work₀ resultIdx).cells 0 = Γ.start) : + let work₁ := binaryRippleAddScanAdvanceWork lhsIdx rhsIdx resultIdx sum work₀ + (work₁ resultIdx).HasBinaryPrefix (emitted ++ [sum]) ∧ + (work₁ resultIdx).cells 0 = Γ.start := by + dsimp only + let work₁ := binaryRippleAddScanAdvanceWork lhsIdx rhsIdx resultIdx sum work₀ + have hresult₁ : + (work₁ resultIdx).HasBinaryPrefix (emitted ++ [sum]) := by + rw [show work₁ resultIdx = + (work₀ resultIdx).writeAndMove (Γw.ofBool sum).toΓ + Dir3.right by + simp [work₁, binaryRippleAddScanAdvanceWork]] + rw [Γw.ofBool_toΓ] + exact Tape.hasBinaryPrefix_write_bit sum hresult + have hresultStart₁ : (work₁ resultIdx).cells 0 = Γ.start := by + rw [show work₁ resultIdx = + (work₀ resultIdx).writeAndMove (Γw.ofBool sum).toΓ + Dir3.right by + simp [work₁, binaryRippleAddScanAdvanceWork]] + rw [Γw.ofBool_toΓ] + exact Tape.hasBinaryPrefix_write_bit_cell0 sum hresult hresultStart + exact ⟨hresult₁, hresultStart₁⟩ + +private theorem binaryRippleAddScanTM_suffix_empty_left {n : ℕ} + (lhsIdx rhsIdx resultIdx : Fin n) + (hdistinct : BinaryRippleAddDistinct lhsIdx rhsIdx resultIdx) + (carry : Bool) (rhs emitted : List Bool) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hlhs : (work₀ lhsIdx).HasBinarySuffix ([] : List Bool)) + (hrhs : (work₀ rhsIdx).HasBinarySuffix rhs) + (hresult : (work₀ resultIdx).HasBinaryPrefix emitted) + (hresultStart : (work₀ resultIdx).cells 0 = Γ.start) + (hinput : inp₀.read ≠ Γ.start) + (hother : ∀ i, i ≠ lhsIdx → i ≠ rhsIdx → i ≠ resultIdx → + (work₀ i).read ≠ Γ.start) + (houtput : out₀.read ≠ Γ.start) : + ∃ c', + (binaryRippleAddScanTM lhsIdx rhsIdx resultIdx).reachesIn + (binaryRippleAddScanTime ([] : List Bool) rhs) + { state := .scan carry, input := inp₀, work := work₀, output := out₀ } c' ∧ + (binaryRippleAddScanTM lhsIdx rhsIdx resultIdx).halted c' ∧ + c'.input = inp₀ ∧ + (c'.work lhsIdx).cells = (work₀ lhsIdx).cells ∧ + (c'.work lhsIdx).head = (work₀ lhsIdx).head + ([] : List Bool).length ∧ + (c'.work rhsIdx).cells = (work₀ rhsIdx).cells ∧ + (c'.work rhsIdx).head = (work₀ rhsIdx).head + rhs.length ∧ + (c'.work resultIdx).HasBinaryPrefix + (emitted ++ BinaryRippleAdd.ripple carry ([] : List Bool) rhs) ∧ + (c'.work resultIdx).cells 0 = Γ.start ∧ + (∀ i, i ≠ lhsIdx → i ≠ rhsIdx → i ≠ resultIdx → + c'.work i = work₀ i) ∧ + c'.output = out₀ := by + induction rhs generalizing carry emitted inp₀ work₀ out₀ with + | nil => + obtain ⟨finalWork, hstep, hfinalLhs, hfinalLhsHead, hfinalRhs, + hfinalRhsHead, hfinalResult, hfinalResultStart, hfinalOther⟩ := + binaryRippleAddScanTM_step_terminal lhsIdx rhsIdx resultIdx + hdistinct carry emitted inp₀ work₀ out₀ hlhs.read_nil + hrhs.read_nil hinput hresult hresultStart hother houtput + let c' : Cfg n BinaryRippleAddPhase := + { state := .done, input := inp₀, work := finalWork, output := out₀ } + refine ⟨c', ?_, rfl, rfl, hfinalLhs, ?_, hfinalRhs, ?_, + hfinalResult, hfinalResultStart, hfinalOther, rfl⟩ + · have hreach : + (binaryRippleAddScanTM lhsIdx rhsIdx resultIdx).reachesIn 1 + { state := .scan carry, input := inp₀, work := work₀, + output := out₀ } c' := + .step hstep .zero + simpa [binaryRippleAddScanTime] using hreach + · simpa using hfinalLhsHead + · simpa using hfinalRhsHead + | cons rhsBit rhsTail ih => + have hlhsBit : decide ((work₀ lhsIdx).read = Γ.one) = false := by + rw [hlhs.read_nil] + decide + have hrhsBit : decide ((work₀ rhsIdx).read = Γ.one) = rhsBit := by + rw [hrhs.read_cons] + cases rhsBit <;> rfl + let sum := BinaryRippleAdd.sumBit carry false rhsBit + let nextCarry := BinaryRippleAdd.carryBit carry false rhsBit + let work₁ := binaryRippleAddScanAdvanceWork lhsIdx rhsIdx resultIdx + sum work₀ + have hactive : ¬((work₀ lhsIdx).read = Γ.blank ∧ + (work₀ rhsIdx).read = Γ.blank) := by + intro hblank + rw [hrhs.read_cons] at hblank + cases rhsBit <;> simp [Γ.ofBool] at hblank + have hrhsNotBlank : (work₀ rhsIdx).read ≠ Γ.blank := by + rw [hrhs.read_cons] + cases rhsBit <;> decide + have hstep : + (binaryRippleAddScanTM lhsIdx rhsIdx resultIdx).step + { state := .scan carry, input := inp₀, work := work₀, + output := out₀ } = + some + { state := .scan nextCarry + input := inp₀ + work := work₁ + output := out₀ } := by + simpa [hlhsBit, hrhsBit, sum, nextCarry, work₁] using + binaryRippleAddScanTM_step_active lhsIdx rhsIdx resultIdx carry + inp₀ work₀ out₀ hactive hinput hlhs.read_ne_start + hrhs.read_ne_start hother houtput + have hlhs₁ : (work₁ lhsIdx).HasBinarySuffix [] := by + simpa [work₁, binaryRippleAddScanAdvanceWork, + hdistinct.lhs_result, hlhs.read_nil] using hlhs + have hrhs₁ : (work₁ rhsIdx).HasBinarySuffix rhsTail := by + simpa [work₁, binaryRippleAddScanAdvanceWork, + hdistinct.rhs_result, Ne.symm hdistinct.lhs_rhs, + hrhsNotBlank] using hrhs.move_right_cons + obtain ⟨hresult₁, hresultStart₁⟩ := + binaryRippleAddScanAdvanceWork_result lhsIdx rhsIdx resultIdx + sum emitted work₀ hresult hresultStart + have hother₁ : ∀ i, i ≠ lhsIdx → i ≠ rhsIdx → i ≠ resultIdx → + (work₁ i).read ≠ Γ.start := by + intro i hil hir hires + simpa [work₁, binaryRippleAddScanAdvanceWork, hil, hir, hires] using + hother i hil hir hires + obtain ⟨c', hreach, hhalt, hfinalInput, hfinalLhs, + hfinalLhsHead, hfinalRhs, hfinalRhsHead, hfinalResult, + hfinalResultStart, hfinalOther, hfinalOutput⟩ := + ih nextCarry + (emitted ++ [sum]) inp₀ work₁ out₀ hlhs₁ hrhs₁ hresult₁ + hresultStart₁ hinput hother₁ houtput + refine ⟨c', ?_, hhalt, hfinalInput, ?_, ?_, ?_, ?_, ?_, + hfinalResultStart, ?_, hfinalOutput⟩ + · simpa [binaryRippleAddScanTime] using + TM.reachesIn.step hstep hreach + · simpa [work₁, binaryRippleAddScanAdvanceWork, + hdistinct.lhs_result, hlhs.read_nil] using hfinalLhs + · simpa [work₁, binaryRippleAddScanAdvanceWork, + hdistinct.lhs_result, hlhs.read_nil] using hfinalLhsHead + · simpa [work₁, binaryRippleAddScanAdvanceWork, + hdistinct.rhs_result, Ne.symm hdistinct.lhs_rhs, + hrhsNotBlank, Tape.move_cells] using hfinalRhs + · rw [hfinalRhsHead] + simp only [work₁, binaryRippleAddScanAdvanceWork, + ite_eq_right hdistinct.rhs_result, + ite_eq_right (Ne.symm hdistinct.lhs_rhs), ite_eq_left, + ite_eq_right hrhsNotBlank, Tape.move, List.length_cons] + omega + · simpa [BinaryRippleAdd.ripple, sum, nextCarry, + List.append_assoc] using hfinalResult + · intro i hil hir hires + rw [hfinalOther i hil hir hires] + simp [work₁, binaryRippleAddScanAdvanceWork, hil, hir, hires] + private theorem binaryRippleAddScanTM_suffix_reachesIn {n : ℕ} (lhsIdx rhsIdx resultIdx : Fin n) (hdistinct : BinaryRippleAddDistinct lhsIdx rhsIdx resultIdx) @@ -229,115 +382,9 @@ private theorem binaryRippleAddScanTM_suffix_reachesIn {n : ℕ} | h total ih => cases lhs with | nil => - cases rhs with - | nil => - obtain ⟨finalWork, hstep, hfinalLhs, hfinalLhsHead, hfinalRhs, - hfinalRhsHead, hfinalResult, hfinalResultStart, hfinalOther⟩ := - binaryRippleAddScanTM_step_terminal lhsIdx rhsIdx resultIdx - hdistinct carry emitted inp₀ work₀ out₀ hlhs.read_nil - hrhs.read_nil hinput hresult hresultStart hother houtput - let c' : Cfg n BinaryRippleAddPhase := - { state := .done, input := inp₀, work := finalWork, output := out₀ } - refine ⟨c', ?_, rfl, rfl, hfinalLhs, ?_, hfinalRhs, ?_, - hfinalResult, hfinalResultStart, hfinalOther, rfl⟩ - · have hreach : - (binaryRippleAddScanTM lhsIdx rhsIdx resultIdx).reachesIn 1 - { state := .scan carry, input := inp₀, work := work₀, - output := out₀ } c' := - .step hstep .zero - simpa [binaryRippleAddScanTime] using hreach - · simpa using hfinalLhsHead - · simpa using hfinalRhsHead - | cons rhsBit rhsTail => - have hlhsBit : decide ((work₀ lhsIdx).read = Γ.one) = false := by - rw [hlhs.read_nil] - decide - have hrhsBit : decide ((work₀ rhsIdx).read = Γ.one) = rhsBit := by - rw [hrhs.read_cons] - cases rhsBit <;> rfl - let sum := BinaryRippleAdd.sumBit carry false rhsBit - let nextCarry := BinaryRippleAdd.carryBit carry false rhsBit - let work₁ := binaryRippleAddScanAdvanceWork lhsIdx rhsIdx resultIdx - sum work₀ - have hactive : ¬((work₀ lhsIdx).read = Γ.blank ∧ - (work₀ rhsIdx).read = Γ.blank) := by - intro hblank - rw [hrhs.read_cons] at hblank - cases rhsBit <;> simp [Γ.ofBool] at hblank - have hrhsNotBlank : (work₀ rhsIdx).read ≠ Γ.blank := by - rw [hrhs.read_cons] - cases rhsBit <;> decide - have hstep : - (binaryRippleAddScanTM lhsIdx rhsIdx resultIdx).step - { state := .scan carry, input := inp₀, work := work₀, - output := out₀ } = - some - { state := .scan nextCarry - input := inp₀ - work := work₁ - output := out₀ } := by - simpa [hlhsBit, hrhsBit, sum, nextCarry, work₁] using - binaryRippleAddScanTM_step_active lhsIdx rhsIdx resultIdx carry - inp₀ work₀ out₀ hactive hinput hlhs.read_ne_start - hrhs.read_ne_start hother houtput - have hlhs₁ : (work₁ lhsIdx).HasBinarySuffix [] := by - simpa [work₁, binaryRippleAddScanAdvanceWork, - hdistinct.lhs_result, hlhs.read_nil] using hlhs - have hrhs₁ : (work₁ rhsIdx).HasBinarySuffix rhsTail := by - simpa [work₁, binaryRippleAddScanAdvanceWork, - hdistinct.rhs_result, Ne.symm hdistinct.lhs_rhs, - hrhsNotBlank] using hrhs.move_right_cons - have hresult₁ : - (work₁ resultIdx).HasBinaryPrefix (emitted ++ [sum]) := by - rw [show work₁ resultIdx = - (work₀ resultIdx).writeAndMove (Γw.ofBool sum).toΓ - Dir3.right by - simp [work₁, binaryRippleAddScanAdvanceWork]] - rw [Γw.ofBool_toΓ] - exact Tape.hasBinaryPrefix_write_bit sum hresult - have hresultStart₁ : (work₁ resultIdx).cells 0 = Γ.start := by - rw [show work₁ resultIdx = - (work₀ resultIdx).writeAndMove (Γw.ofBool sum).toΓ - Dir3.right by - simp [work₁, binaryRippleAddScanAdvanceWork]] - rw [Γw.ofBool_toΓ] - exact Tape.hasBinaryPrefix_write_bit_cell0 sum hresult hresultStart - have hother₁ : ∀ i, i ≠ lhsIdx → i ≠ rhsIdx → i ≠ resultIdx → - (work₁ i).read ≠ Γ.start := by - intro i hil hir hires - simpa [work₁, binaryRippleAddScanAdvanceWork, hil, hir, hires] using - hother i hil hir hires - have htailLength : rhsTail.length < total := by - simp only [List.length_nil, zero_add, List.length_cons] at hlength - omega - obtain ⟨c', hreach, hhalt, hfinalInput, hfinalLhs, - hfinalLhsHead, hfinalRhs, hfinalRhsHead, hfinalResult, - hfinalResultStart, hfinalOther, hfinalOutput⟩ := - ih rhsTail.length htailLength nextCarry [] rhsTail - (emitted ++ [sum]) inp₀ work₁ out₀ hlhs₁ hrhs₁ hresult₁ - hresultStart₁ hinput hother₁ houtput (by simp) - refine ⟨c', ?_, hhalt, hfinalInput, ?_, ?_, ?_, ?_, ?_, - hfinalResultStart, ?_, hfinalOutput⟩ - · simpa [binaryRippleAddScanTime] using - TM.reachesIn.step hstep hreach - · simpa [work₁, binaryRippleAddScanAdvanceWork, - hdistinct.lhs_result, hlhs.read_nil] using hfinalLhs - · simpa [work₁, binaryRippleAddScanAdvanceWork, - hdistinct.lhs_result, hlhs.read_nil] using hfinalLhsHead - · simpa [work₁, binaryRippleAddScanAdvanceWork, - hdistinct.rhs_result, Ne.symm hdistinct.lhs_rhs, - hrhsNotBlank, Tape.move_cells] using hfinalRhs - · rw [hfinalRhsHead] - simp only [work₁, binaryRippleAddScanAdvanceWork, - ite_eq_right hdistinct.rhs_result, - ite_eq_right (Ne.symm hdistinct.lhs_rhs), ite_eq_left, - ite_eq_right hrhsNotBlank, Tape.move, List.length_cons] - omega - · simpa [BinaryRippleAdd.ripple, sum, nextCarry, - List.append_assoc] using hfinalResult - · intro i hil hir hires - rw [hfinalOther i hil hir hires] - simp [work₁, binaryRippleAddScanAdvanceWork, hil, hir, hires] + exact binaryRippleAddScanTM_suffix_empty_left lhsIdx rhsIdx resultIdx + hdistinct carry rhs emitted inp₀ work₀ out₀ hlhs hrhs hresult + hresultStart hinput hother houtput | cons lhsBit lhsTail => cases rhs with | nil => @@ -379,21 +426,9 @@ private theorem binaryRippleAddScanTM_suffix_reachesIn {n : ℕ} simpa [work₁, binaryRippleAddScanAdvanceWork, hdistinct.rhs_result, Ne.symm hdistinct.lhs_rhs, hrhs.read_nil] using hrhs - have hresult₁ : - (work₁ resultIdx).HasBinaryPrefix (emitted ++ [sum]) := by - rw [show work₁ resultIdx = - (work₀ resultIdx).writeAndMove (Γw.ofBool sum).toΓ - Dir3.right by - simp [work₁, binaryRippleAddScanAdvanceWork]] - rw [Γw.ofBool_toΓ] - exact Tape.hasBinaryPrefix_write_bit sum hresult - have hresultStart₁ : (work₁ resultIdx).cells 0 = Γ.start := by - rw [show work₁ resultIdx = - (work₀ resultIdx).writeAndMove (Γw.ofBool sum).toΓ - Dir3.right by - simp [work₁, binaryRippleAddScanAdvanceWork]] - rw [Γw.ofBool_toΓ] - exact Tape.hasBinaryPrefix_write_bit_cell0 sum hresult hresultStart + obtain ⟨hresult₁, hresultStart₁⟩ := + binaryRippleAddScanAdvanceWork_result lhsIdx rhsIdx resultIdx + sum emitted work₀ hresult hresultStart have hother₁ : ∀ i, i ≠ lhsIdx → i ≠ rhsIdx → i ≠ resultIdx → (work₁ i).read ≠ Γ.start := by intro i hil hir hires @@ -473,21 +508,9 @@ private theorem binaryRippleAddScanTM_suffix_reachesIn {n : ℕ} simpa [work₁, binaryRippleAddScanAdvanceWork, hdistinct.rhs_result, Ne.symm hdistinct.lhs_rhs, hrhsNotBlank] using hrhs.move_right_cons - have hresult₁ : - (work₁ resultIdx).HasBinaryPrefix (emitted ++ [sum]) := by - rw [show work₁ resultIdx = - (work₀ resultIdx).writeAndMove (Γw.ofBool sum).toΓ - Dir3.right by - simp [work₁, binaryRippleAddScanAdvanceWork]] - rw [Γw.ofBool_toΓ] - exact Tape.hasBinaryPrefix_write_bit sum hresult - have hresultStart₁ : (work₁ resultIdx).cells 0 = Γ.start := by - rw [show work₁ resultIdx = - (work₀ resultIdx).writeAndMove (Γw.ofBool sum).toΓ - Dir3.right by - simp [work₁, binaryRippleAddScanAdvanceWork]] - rw [Γw.ofBool_toΓ] - exact Tape.hasBinaryPrefix_write_bit_cell0 sum hresult hresultStart + obtain ⟨hresult₁, hresultStart₁⟩ := + binaryRippleAddScanAdvanceWork_result lhsIdx rhsIdx resultIdx + sum emitted work₀ hresult hresultStart have hother₁ : ∀ i, i ≠ lhsIdx → i ≠ rhsIdx → i ≠ resultIdx → (work₁ i).read ≠ Γ.start := by intro i hil hir hires diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleSub/Internal/Scan.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleSub/Internal/Scan.lean index bf06366c6a..527df951f0 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleSub/Internal/Scan.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleSub/Internal/Scan.lean @@ -170,6 +170,174 @@ private theorem binaryRippleSubCoreTM_step_terminal {n : ℕ} · intro i _ _ hires simp [binaryRippleSubScanTurnWork, hires] +/-- With the left input exhausted, ripple subtraction condiffes the right suffix and borrow. -/ +/-- Writing one ripple-sub output bit extends its prefix without changing the start marker. -/ +private theorem binaryRippleSubScanAdvanceWork_result {n : ℕ} + (lhsIdx rhsIdx resultIdx : Fin n) (diff : Bool) (emitted : List Bool) + (work₀ : Fin n → Tape) + (hresult : (work₀ resultIdx).HasBinaryPrefix emitted) + (hresultStart : (work₀ resultIdx).cells 0 = Γ.start) : + let work₁ := binaryRippleSubScanAdvanceWork lhsIdx rhsIdx resultIdx diff work₀ + (work₁ resultIdx).HasBinaryPrefix (emitted ++ [diff]) ∧ + (work₁ resultIdx).cells 0 = Γ.start := by + dsimp only + let work₁ := binaryRippleSubScanAdvanceWork lhsIdx rhsIdx resultIdx diff work₀ + have hresult₁ : + (work₁ resultIdx).HasBinaryPrefix (emitted ++ [diff]) := by + rw [show work₁ resultIdx = + (work₀ resultIdx).writeAndMove (Γw.ofBool diff).toΓ + Dir3.right by + simp [work₁, binaryRippleSubScanAdvanceWork]] + rw [Γw.ofBool_toΓ] + exact Tape.hasBinaryPrefix_write_bit diff hresult + have hresultStart₁ : (work₁ resultIdx).cells 0 = Γ.start := by + rw [show work₁ resultIdx = + (work₀ resultIdx).writeAndMove (Γw.ofBool diff).toΓ + Dir3.right by + simp [work₁, binaryRippleSubScanAdvanceWork]] + rw [Γw.ofBool_toΓ] + exact Tape.hasBinaryPrefix_write_bit_cell0 diff hresult hresultStart + exact ⟨hresult₁, hresultStart₁⟩ + +private theorem binaryRippleSubCoreTM_suffix_empty_left {n : ℕ} + (lhsIdx rhsIdx resultIdx : Fin n) + (hdistinct : BinaryRippleSubDistinct lhsIdx rhsIdx resultIdx) + (borrow : Bool) (rhs emitted : List Bool) + (inp₀ : Tape) (work₀ : Fin n → Tape) (out₀ : Tape) + (hlhs : (work₀ lhsIdx).HasBinarySuffix ([] : List Bool)) + (hrhs : (work₀ rhsIdx).HasBinarySuffix rhs) + (hresult : (work₀ resultIdx).HasBinaryPrefix emitted) + (hresultStart : (work₀ resultIdx).cells 0 = Γ.start) + (hinput : inp₀.read ≠ Γ.start) + (hother : ∀ i, i ≠ lhsIdx → i ≠ rhsIdx → i ≠ resultIdx → + (work₀ i).read ≠ Γ.start) + (houtput : out₀.read ≠ Γ.start) : + ∃ c', + (binaryRippleSubCoreTM lhsIdx rhsIdx resultIdx).reachesIn + (binaryRippleSubScanTime ([] : List Bool) rhs) + { state := .scan borrow, input := inp₀, work := work₀, output := out₀ } c' ∧ + c'.state = (if (BinaryRippleSub.scan borrow ([] : List Bool) rhs).borrow then + .erase else .trim false) ∧ + c'.input = inp₀ ∧ + (c'.work lhsIdx).cells = (work₀ lhsIdx).cells ∧ + (c'.work lhsIdx).head = (work₀ lhsIdx).head + ([] : List Bool).length ∧ + (c'.work rhsIdx).cells = (work₀ rhsIdx).cells ∧ + (c'.work rhsIdx).head = (work₀ rhsIdx).head + rhs.length ∧ + (c'.work resultIdx).HasBinaryContent + (emitted ++ (BinaryRippleSub.scan borrow ([] : List Bool) rhs).bits) ∧ + (c'.work resultIdx).head = + (emitted ++ (BinaryRippleSub.scan borrow ([] : List Bool) rhs).bits).length ∧ + (c'.work resultIdx).cells 0 = Γ.start ∧ + (∀ i, i ≠ lhsIdx → i ≠ rhsIdx → i ≠ resultIdx → + c'.work i = work₀ i) ∧ + c'.output = out₀ := by + induction rhs generalizing borrow emitted inp₀ work₀ out₀ with + | nil => + have hterminal := binaryRippleSubCoreTM_step_terminal + lhsIdx rhsIdx resultIdx hdistinct borrow emitted inp₀ work₀ out₀ + hlhs.read_nil hrhs.read_nil hinput hresult hresultStart hother houtput + let finalWork := binaryRippleSubScanTurnWork resultIdx work₀ + let c' : Cfg n BinaryRippleSubPhase := + { state := if borrow then .erase else .trim false + input := inp₀ + work := finalWork + output := out₀ } + rcases hterminal with ⟨hstep, hfinalLhs, hfinalLhsHead, hfinalRhs, + hfinalRhsHead, hfinalResult, hfinalResultHead, hfinalResultStart, + hfinalOther⟩ + refine ⟨c', ?_, by + cases borrow <;> simp [c', BinaryRippleSub.scan] <;> rfl, rfl, + hfinalLhs, ?_, hfinalRhs, ?_, ?_, ?_, + hfinalResultStart, hfinalOther, rfl⟩ + · have hreach : + (binaryRippleSubCoreTM lhsIdx rhsIdx resultIdx).reachesIn 1 + { state := .scan borrow, input := inp₀, work := work₀, + output := out₀ } c' := + .step hstep .zero + simpa [binaryRippleSubScanTime] using hreach + · simpa using hfinalLhsHead + · simpa using hfinalRhsHead + · simpa [BinaryRippleSub.scan] using hfinalResult + · simpa [BinaryRippleSub.scan] using hfinalResultHead + | cons rhsBit rhsTail ih => + have hlhsBit : decide ((work₀ lhsIdx).read = Γ.one) = false := by + rw [hlhs.read_nil] + decide + have hrhsBit : decide ((work₀ rhsIdx).read = Γ.one) = rhsBit := by + rw [hrhs.read_cons] + cases rhsBit <;> rfl + let diff := BinaryRippleSub.diffBit borrow false rhsBit + let nextBorrow := BinaryRippleSub.borrowBit borrow false rhsBit + let work₁ := binaryRippleSubScanAdvanceWork lhsIdx rhsIdx resultIdx + diff work₀ + have hactive : ¬((work₀ lhsIdx).read = Γ.blank ∧ + (work₀ rhsIdx).read = Γ.blank) := by + intro hblank + rw [hrhs.read_cons] at hblank + cases rhsBit <;> simp [Γ.ofBool] at hblank + have hrhsNotBlank : (work₀ rhsIdx).read ≠ Γ.blank := by + rw [hrhs.read_cons] + cases rhsBit <;> decide + have hstep : + (binaryRippleSubCoreTM lhsIdx rhsIdx resultIdx).step + { state := .scan borrow, input := inp₀, work := work₀, + output := out₀ } = + some + { state := .scan nextBorrow + input := inp₀ + work := work₁ + output := out₀ } := by + simpa [hlhsBit, hrhsBit, diff, nextBorrow, work₁] using + binaryRippleSubCoreTM_step_active lhsIdx rhsIdx resultIdx borrow + inp₀ work₀ out₀ hactive hinput hlhs.read_ne_start + hrhs.read_ne_start hother houtput + have hlhs₁ : (work₁ lhsIdx).HasBinarySuffix [] := by + simpa [work₁, binaryRippleSubScanAdvanceWork, + hdistinct.lhs_result, hlhs.read_nil] using hlhs + have hrhs₁ : (work₁ rhsIdx).HasBinarySuffix rhsTail := by + simpa [work₁, binaryRippleSubScanAdvanceWork, + hdistinct.rhs_result, Ne.symm hdistinct.lhs_rhs, + hrhsNotBlank] using hrhs.move_right_cons + obtain ⟨hresult₁, hresultStart₁⟩ := + binaryRippleSubScanAdvanceWork_result lhsIdx rhsIdx resultIdx + diff emitted work₀ hresult hresultStart + have hother₁ : ∀ i, i ≠ lhsIdx → i ≠ rhsIdx → i ≠ resultIdx → + (work₁ i).read ≠ Γ.start := by + intro i hil hir hires + simpa [work₁, binaryRippleSubScanAdvanceWork, hil, hir, hires] using + hother i hil hir hires + obtain ⟨c', hreach, hstate, hfinalInput, hfinalLhs, + hfinalLhsHead, hfinalRhs, hfinalRhsHead, hfinalResult, + hfinalResultHead, hfinalResultStart, hfinalOther, hfinalOutput⟩ := + ih nextBorrow + (emitted ++ [diff]) inp₀ work₁ out₀ hlhs₁ hrhs₁ hresult₁ + hresultStart₁ hinput hother₁ houtput + refine ⟨c', ?_, ?_, hfinalInput, ?_, ?_, ?_, ?_, ?_, ?_, + hfinalResultStart, ?_, hfinalOutput⟩ + · simpa [binaryRippleSubScanTime] using + TM.reachesIn.step hstep hreach + · simpa [BinaryRippleSub.scan, nextBorrow] using hstate + · simpa [work₁, binaryRippleSubScanAdvanceWork, + hdistinct.lhs_result, hlhs.read_nil] using hfinalLhs + · simpa [work₁, binaryRippleSubScanAdvanceWork, + hdistinct.lhs_result, hlhs.read_nil] using hfinalLhsHead + · simpa [work₁, binaryRippleSubScanAdvanceWork, + hdistinct.rhs_result, Ne.symm hdistinct.lhs_rhs, + hrhsNotBlank, Tape.move_cells] using hfinalRhs + · rw [hfinalRhsHead] + simp only [work₁, binaryRippleSubScanAdvanceWork, + ite_eq_right hdistinct.rhs_result, + ite_eq_right (Ne.symm hdistinct.lhs_rhs), ite_eq_left, + ite_eq_right hrhsNotBlank, Tape.move, List.length_cons] + omega + · simpa [BinaryRippleSub.scan, diff, nextBorrow, + List.append_assoc] using hfinalResult + · simpa [BinaryRippleSub.scan, diff, nextBorrow, + List.append_assoc] using hfinalResultHead + · intro i hil hir hires + rw [hfinalOther i hil hir hires] + simp [work₁, binaryRippleSubScanAdvanceWork, hil, hir, hires] + private theorem binaryRippleSubCoreTM_suffix_reachesIn {n : ℕ} (lhsIdx rhsIdx resultIdx : Fin n) (hdistinct : BinaryRippleSubDistinct lhsIdx rhsIdx resultIdx) @@ -207,127 +375,9 @@ private theorem binaryRippleSubCoreTM_suffix_reachesIn {n : ℕ} | h total ih => cases lhs with | nil => - cases rhs with - | nil => - have hterminal := binaryRippleSubCoreTM_step_terminal - lhsIdx rhsIdx resultIdx hdistinct borrow emitted inp₀ work₀ out₀ - hlhs.read_nil hrhs.read_nil hinput hresult hresultStart hother houtput - let finalWork := binaryRippleSubScanTurnWork resultIdx work₀ - let c' : Cfg n BinaryRippleSubPhase := - { state := if borrow then .erase else .trim false - input := inp₀ - work := finalWork - output := out₀ } - rcases hterminal with ⟨hstep, hfinalLhs, hfinalLhsHead, hfinalRhs, - hfinalRhsHead, hfinalResult, hfinalResultHead, hfinalResultStart, - hfinalOther⟩ - refine ⟨c', ?_, by - cases borrow <;> simp [c', BinaryRippleSub.scan] <;> rfl, rfl, - hfinalLhs, ?_, hfinalRhs, ?_, ?_, ?_, - hfinalResultStart, hfinalOther, rfl⟩ - · have hreach : - (binaryRippleSubCoreTM lhsIdx rhsIdx resultIdx).reachesIn 1 - { state := .scan borrow, input := inp₀, work := work₀, - output := out₀ } c' := - .step hstep .zero - simpa [binaryRippleSubScanTime] using hreach - · simpa using hfinalLhsHead - · simpa using hfinalRhsHead - · simpa [BinaryRippleSub.scan] using hfinalResult - · simpa [BinaryRippleSub.scan] using hfinalResultHead - | cons rhsBit rhsTail => - have hlhsBit : decide ((work₀ lhsIdx).read = Γ.one) = false := by - rw [hlhs.read_nil] - decide - have hrhsBit : decide ((work₀ rhsIdx).read = Γ.one) = rhsBit := by - rw [hrhs.read_cons] - cases rhsBit <;> rfl - let diff := BinaryRippleSub.diffBit borrow false rhsBit - let nextBorrow := BinaryRippleSub.borrowBit borrow false rhsBit - let work₁ := binaryRippleSubScanAdvanceWork lhsIdx rhsIdx resultIdx - diff work₀ - have hactive : ¬((work₀ lhsIdx).read = Γ.blank ∧ - (work₀ rhsIdx).read = Γ.blank) := by - intro hblank - rw [hrhs.read_cons] at hblank - cases rhsBit <;> simp [Γ.ofBool] at hblank - have hrhsNotBlank : (work₀ rhsIdx).read ≠ Γ.blank := by - rw [hrhs.read_cons] - cases rhsBit <;> decide - have hstep : - (binaryRippleSubCoreTM lhsIdx rhsIdx resultIdx).step - { state := .scan borrow, input := inp₀, work := work₀, - output := out₀ } = - some - { state := .scan nextBorrow - input := inp₀ - work := work₁ - output := out₀ } := by - simpa [hlhsBit, hrhsBit, diff, nextBorrow, work₁] using - binaryRippleSubCoreTM_step_active lhsIdx rhsIdx resultIdx borrow - inp₀ work₀ out₀ hactive hinput hlhs.read_ne_start - hrhs.read_ne_start hother houtput - have hlhs₁ : (work₁ lhsIdx).HasBinarySuffix [] := by - simpa [work₁, binaryRippleSubScanAdvanceWork, - hdistinct.lhs_result, hlhs.read_nil] using hlhs - have hrhs₁ : (work₁ rhsIdx).HasBinarySuffix rhsTail := by - simpa [work₁, binaryRippleSubScanAdvanceWork, - hdistinct.rhs_result, Ne.symm hdistinct.lhs_rhs, - hrhsNotBlank] using hrhs.move_right_cons - have hresult₁ : - (work₁ resultIdx).HasBinaryPrefix (emitted ++ [diff]) := by - rw [show work₁ resultIdx = - (work₀ resultIdx).writeAndMove (Γw.ofBool diff).toΓ - Dir3.right by - simp [work₁, binaryRippleSubScanAdvanceWork]] - rw [Γw.ofBool_toΓ] - exact Tape.hasBinaryPrefix_write_bit diff hresult - have hresultStart₁ : (work₁ resultIdx).cells 0 = Γ.start := by - rw [show work₁ resultIdx = - (work₀ resultIdx).writeAndMove (Γw.ofBool diff).toΓ - Dir3.right by - simp [work₁, binaryRippleSubScanAdvanceWork]] - rw [Γw.ofBool_toΓ] - exact Tape.hasBinaryPrefix_write_bit_cell0 diff hresult hresultStart - have hother₁ : ∀ i, i ≠ lhsIdx → i ≠ rhsIdx → i ≠ resultIdx → - (work₁ i).read ≠ Γ.start := by - intro i hil hir hires - simpa [work₁, binaryRippleSubScanAdvanceWork, hil, hir, hires] using - hother i hil hir hires - have htailLength : rhsTail.length < total := by - simp only [List.length_nil, zero_add, List.length_cons] at hlength - omega - obtain ⟨c', hreach, hstate, hfinalInput, hfinalLhs, - hfinalLhsHead, hfinalRhs, hfinalRhsHead, hfinalResult, - hfinalResultHead, hfinalResultStart, hfinalOther, hfinalOutput⟩ := - ih rhsTail.length htailLength nextBorrow [] rhsTail - (emitted ++ [diff]) inp₀ work₁ out₀ hlhs₁ hrhs₁ hresult₁ - hresultStart₁ hinput hother₁ houtput (by simp) - refine ⟨c', ?_, ?_, hfinalInput, ?_, ?_, ?_, ?_, ?_, ?_, - hfinalResultStart, ?_, hfinalOutput⟩ - · simpa [binaryRippleSubScanTime] using - TM.reachesIn.step hstep hreach - · simpa [BinaryRippleSub.scan, nextBorrow] using hstate - · simpa [work₁, binaryRippleSubScanAdvanceWork, - hdistinct.lhs_result, hlhs.read_nil] using hfinalLhs - · simpa [work₁, binaryRippleSubScanAdvanceWork, - hdistinct.lhs_result, hlhs.read_nil] using hfinalLhsHead - · simpa [work₁, binaryRippleSubScanAdvanceWork, - hdistinct.rhs_result, Ne.symm hdistinct.lhs_rhs, - hrhsNotBlank, Tape.move_cells] using hfinalRhs - · rw [hfinalRhsHead] - simp only [work₁, binaryRippleSubScanAdvanceWork, - ite_eq_right hdistinct.rhs_result, - ite_eq_right (Ne.symm hdistinct.lhs_rhs), ite_eq_left, - ite_eq_right hrhsNotBlank, Tape.move, List.length_cons] - omega - · simpa [BinaryRippleSub.scan, diff, nextBorrow, - List.append_assoc] using hfinalResult - · simpa [BinaryRippleSub.scan, diff, nextBorrow, - List.append_assoc] using hfinalResultHead - · intro i hil hir hires - rw [hfinalOther i hil hir hires] - simp [work₁, binaryRippleSubScanAdvanceWork, hil, hir, hires] + exact binaryRippleSubCoreTM_suffix_empty_left lhsIdx rhsIdx resultIdx + hdistinct borrow rhs emitted inp₀ work₀ out₀ hlhs hrhs hresult + hresultStart hinput hother houtput | cons lhsBit lhsTail => cases rhs with | nil => @@ -369,21 +419,9 @@ private theorem binaryRippleSubCoreTM_suffix_reachesIn {n : ℕ} simpa [work₁, binaryRippleSubScanAdvanceWork, hdistinct.rhs_result, Ne.symm hdistinct.lhs_rhs, hrhs.read_nil] using hrhs - have hresult₁ : - (work₁ resultIdx).HasBinaryPrefix (emitted ++ [diff]) := by - rw [show work₁ resultIdx = - (work₀ resultIdx).writeAndMove (Γw.ofBool diff).toΓ - Dir3.right by - simp [work₁, binaryRippleSubScanAdvanceWork]] - rw [Γw.ofBool_toΓ] - exact Tape.hasBinaryPrefix_write_bit diff hresult - have hresultStart₁ : (work₁ resultIdx).cells 0 = Γ.start := by - rw [show work₁ resultIdx = - (work₀ resultIdx).writeAndMove (Γw.ofBool diff).toΓ - Dir3.right by - simp [work₁, binaryRippleSubScanAdvanceWork]] - rw [Γw.ofBool_toΓ] - exact Tape.hasBinaryPrefix_write_bit_cell0 diff hresult hresultStart + obtain ⟨hresult₁, hresultStart₁⟩ := + binaryRippleSubScanAdvanceWork_result lhsIdx rhsIdx resultIdx + diff emitted work₀ hresult hresultStart have hother₁ : ∀ i, i ≠ lhsIdx → i ≠ rhsIdx → i ≠ resultIdx → (work₁ i).read ≠ Γ.start := by intro i hil hir hires @@ -466,21 +504,9 @@ private theorem binaryRippleSubCoreTM_suffix_reachesIn {n : ℕ} simpa [work₁, binaryRippleSubScanAdvanceWork, hdistinct.rhs_result, Ne.symm hdistinct.lhs_rhs, hrhsNotBlank] using hrhs.move_right_cons - have hresult₁ : - (work₁ resultIdx).HasBinaryPrefix (emitted ++ [diff]) := by - rw [show work₁ resultIdx = - (work₀ resultIdx).writeAndMove (Γw.ofBool diff).toΓ - Dir3.right by - simp [work₁, binaryRippleSubScanAdvanceWork]] - rw [Γw.ofBool_toΓ] - exact Tape.hasBinaryPrefix_write_bit diff hresult - have hresultStart₁ : (work₁ resultIdx).cells 0 = Γ.start := by - rw [show work₁ resultIdx = - (work₀ resultIdx).writeAndMove (Γw.ofBool diff).toΓ - Dir3.right by - simp [work₁, binaryRippleSubScanAdvanceWork]] - rw [Γw.ofBool_toΓ] - exact Tape.hasBinaryPrefix_write_bit_cell0 diff hresult hresultStart + obtain ⟨hresult₁, hresultStart₁⟩ := + binaryRippleSubScanAdvanceWork_result lhsIdx rhsIdx resultIdx + diff emitted work₀ hresult hresultStart have hother₁ : ∀ i, i ≠ lhsIdx → i ≠ rhsIdx → i ≠ resultIdx → (work₁ i).read ≠ Γ.start := by intro i hil hir hires From 8df1479e718113d9eba394c9818a43352ca9c3c4 Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Fri, 25 Sep 2026 21:22:28 +0000 Subject: [PATCH 39/49] Complete bounded proof refactors for gates, initialization, and resource costs --- .../Machine/Program/DenseBoundsProof.lean | 162 ++++++++++---- .../Machine/Program/DenseInitProof.lean | 205 ++++++++--------- .../Structured/GateEval/Internal.lean | 209 ++++++++++-------- .../Structured/GateStreamStep/Internal.lean | 183 ++++++++------- .../Combinators/Internal/Union.lean | 139 +++++++----- 5 files changed, 502 insertions(+), 396 deletions(-) diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseBoundsProof.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseBoundsProof.lean index 0c0a368167..ab4319abae 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseBoundsProof.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseBoundsProof.lean @@ -685,17 +685,52 @@ private theorem denseResourceMagnitudeSq_le_unit (encodedStoreLength overlay + inputLength + width + 1) * (width + 1) := Nat.mul_le_mul (Nat.mul_le_mul_left _ (by omega)) (by omega) -private theorem denseExecuteInstructionTime_le_product {m : ℕ} - (tapes : ControlInstructionTapes m) (input : List Bool) - (instruction : Instr) (pcValue : ℕ) (overlay : Store) - (width magnitude : ℕ) (hvalid : DenseOverlay.Valid overlay) - (hstatic : RegisterStore.Instr.staticWidth instruction ≤ width) - (hcost : instruction.logCost - (DenseOverlay.Snapshot.decode input { pc := pcValue, overlay }) ≤ width) - (hfixed : instructionResourceMagnitude instruction ≤ magnitude) +/-- Shared copying, lookup, update, and program-counter costs fit the resource unit. -/ +private theorem denseInstruction_resourceBounds + {m : ℕ} (tapes : ControlInstructionTapes m) (input : List Bool) + (pcValue : ℕ) (overlay : Store) (width magnitude : ℕ) + (hvalid : DenseOverlay.Valid overlay) (hpc : pcValue ≤ magnitude) : - denseExecuteInstructionTime tapes input instruction pcValue overlay ≤ - 6000000 * denseResourceUnit magnitude input.length overlay width := by + let unit := denseResourceUnit magnitude input.length overlay width + (1 ≤ unit) ∧ + ((encodedStoreLength overlay + input.length + width + 1) * + (width + 1) ≤ unit) ∧ + (encodedStoreLength overlay + input.length + width + 1 ≤ + unit) ∧ + ((width + 1) ^ 2 ≤ unit) ∧ + ((magnitude + 1) ^ 2 ≤ unit) ∧ + (encodedStoreLength overlay ≤ unit) ∧ + ((overlay.flatMap Entry.encode).length ≤ unit) ∧ + (∀ fixedValue, fixedValue ≤ magnitude → + TM.binaryAddConstTime fixedValue 0 ≤ 4 * unit) ∧ + (∀ address, bitlen address ≤ width → + address ≤ magnitude → + denseOverlayLookupStaticTime tapes.data.lhsLookup input.length overlay + address ≤ 1000000 * unit) ∧ + (∀ address, bitlen address ≤ width → + address ≤ magnitude → + denseOverlayLookupStaticTime tapes.data.rhsLookup input.length overlay + address ≤ 1000000 * unit) ∧ + (∀ address, bitlen address ≤ width → + denseOverlayLookupTime tapes.data.indirectLoadLookup input.length overlay + address ≤ 800000 * unit) ∧ + (∀ address value, + bitlen address ≤ width → bitlen value ≤ width → + taggedEntryUpdateTime tapes.data.update overlay address value ≤ + 20000 * unit) ∧ + (∀ op lhs rhs, bitlen lhs ≤ width → + bitlen rhs ≤ width → + binaryInstructionArithmeticTime op lhs rhs ≤ 1000 * unit) ∧ + (∀ value, bitlen value ≤ width → + TM.binaryCopyTime value 0 ≤ 23 * unit) ∧ + (∀ value, bitlen value ≤ width → + TM.resetBinaryWorkTime 1 value.bits.length ≤ 11 * unit) ∧ + (pcValue.size ≤ magnitude) ∧ + (TM.binarySuccTime pcValue ≤ 2 * pcValue.size + 2) ∧ + (TM.binarySuccTime pcValue ≤ 4 * unit) ∧ + (TM.resetBinaryWorkTime 1 pcValue.bits.length ≤ + 11 * unit) := by + dsimp only let unit := denseResourceUnit magnitude input.length overlay width have hunit : 1 ≤ unit := denseResourceUnit_pos magnitude input.length overlay width @@ -807,6 +842,78 @@ private theorem denseExecuteInstructionTime_le_product {m : ℕ} have hbits : pcValue.bits.length ≤ magnitude := by simpa [Nat.size_eq_bits_len] using! hpcSize nlinarith + exact ⟨hunit, hbase, hvolume, hwidthSq, hmagnitudeSq, hencoded, hencodedBits, + hfixedAdd, hstaticLookup, hstaticLookupRhs, hdynamicLookup, htaggedUpdate, + harithmetic, hcopy, hreset, hpcSize, hpcSucc, hpcSucc', hpcReset⟩ + +/-- The conditional jump cost is bounded after reading and clearing its test register. -/ +private theorem denseExecuteZeroJumpTime_le_product + {m : ℕ} (tapes : ControlInstructionTapes m) (input : List Bool) + (pcValue : ℕ) (overlay : Store) (width magnitude : ℕ) + (hvalid : DenseOverlay.Valid overlay) + (source target : ℕ) + (hstatic : RegisterStore.Instr.staticWidth (.jz source target) ≤ width) + (hcost : (Instr.jz source target).logCost + (DenseOverlay.Snapshot.decode input { pc := pcValue, overlay }) ≤ width) + (hfixed : instructionResourceMagnitude (.jz source target) ≤ magnitude) + (hpc : pcValue ≤ magnitude) : + denseExecuteInstructionTime tapes input (.jz source target) pcValue overlay ≤ + 6000000 * denseResourceUnit magnitude input.length overlay width := by + let unit := denseResourceUnit magnitude input.length overlay width + obtain ⟨hunit, hbase, hvolume, hwidthSq, hmagnitudeSq, hencoded, hencodedBits, + hfixedAdd, hstaticLookup, hstaticLookupRhs, hdynamicLookup, htaggedUpdate, + harithmetic, hcopy, hreset, hpcSize, hpcSucc, hpcSucc', hpcReset⟩ := + denseInstruction_resourceBounds tapes input pcValue overlay width magnitude hvalid hpc + simp only [RegisterStore.Instr.staticWidth] at hstatic + simp only [instructionResourceMagnitude] at hfixed + simp only [Instr.logCost, DenseOverlay.Snapshot.decode, + DenseOverlay.decode] at hcost + have hsourceWidth : bitlen source ≤ width := + le_trans (le_max_left _ _) hstatic + have hvalue : bitlen (DenseOverlay.read input overlay source) ≤ width := + by omega + have hlookupRaw := denseOverlayLookupStaticTime_le_product + tapes.lifted.data.lhsLookup input.length overlay source width magnitude + hvalid hsourceWidth (by omega) + have hlookup : denseOverlayLookupStaticTime + tapes.lifted.data.lhsLookup input.length overlay source ≤ + 1000000 * unit := by + calc + denseOverlayLookupStaticTime tapes.lifted.data.lhsLookup input.length + overlay source ≤ 1000000 * (magnitude + 1) ^ 2 * + (encodedStoreLength overlay + input.length + width + 1) * + (width + 1) := hlookupRaw + _ = 1000000 * unit := by + dsimp only [unit, denseResourceUnit] + ring + have htargetAdd := hfixedAdd target (by omega) + have hset : setProgramCounterTime pcValue target ≤ 16 * unit := by + unfold setProgramCounterTime + omega + have hbranch : max (setProgramCounterTime pcValue target) + (TM.binarySuccTime pcValue) ≤ 16 * unit := + max_le hset (by omega) + have hresetValue := hreset (DenseOverlay.read input overlay source) hvalue + simp only [denseExecuteInstructionTime, denseZeroJumpInstructionTime, + TM.branchWorkBlankTime] + omega + +private theorem denseExecuteInstructionTime_le_product {m : ℕ} + (tapes : ControlInstructionTapes m) (input : List Bool) + (instruction : Instr) (pcValue : ℕ) (overlay : Store) + (width magnitude : ℕ) (hvalid : DenseOverlay.Valid overlay) + (hstatic : RegisterStore.Instr.staticWidth instruction ≤ width) + (hcost : instruction.logCost + (DenseOverlay.Snapshot.decode input { pc := pcValue, overlay }) ≤ width) + (hfixed : instructionResourceMagnitude instruction ≤ magnitude) + (hpc : pcValue ≤ magnitude) : + denseExecuteInstructionTime tapes input instruction pcValue overlay ≤ + 6000000 * denseResourceUnit magnitude input.length overlay width := by + let unit := denseResourceUnit magnitude input.length overlay width + obtain ⟨hunit, hbase, hvolume, hwidthSq, hmagnitudeSq, hencoded, hencodedBits, + hfixedAdd, hstaticLookup, hstaticLookupRhs, hdynamicLookup, htaggedUpdate, + harithmetic, hcopy, hreset, hpcSize, hpcSucc, hpcSucc', hpcReset⟩ := + denseInstruction_resourceBounds tapes input pcValue overlay width magnitude hvalid hpc cases instruction with | imm destination value => simp only [RegisterStore.Instr.staticWidth] at hstatic @@ -959,39 +1066,8 @@ private theorem denseExecuteInstructionTime_le_product {m : ℕ} simp only [denseExecuteInstructionTime, denseIndirectStoreInstructionTime] omega | jz source target => - simp only [RegisterStore.Instr.staticWidth] at hstatic - simp only [instructionResourceMagnitude] at hfixed - simp only [Instr.logCost, DenseOverlay.Snapshot.decode, - DenseOverlay.decode] at hcost - have hsourceWidth : bitlen source ≤ width := - le_trans (le_max_left _ _) hstatic - have hvalue : bitlen (DenseOverlay.read input overlay source) ≤ width := - by omega - have hlookupRaw := denseOverlayLookupStaticTime_le_product - tapes.lifted.data.lhsLookup input.length overlay source width magnitude - hvalid hsourceWidth (by omega) - have hlookup : denseOverlayLookupStaticTime - tapes.lifted.data.lhsLookup input.length overlay source ≤ - 1000000 * unit := by - calc - denseOverlayLookupStaticTime tapes.lifted.data.lhsLookup input.length - overlay source ≤ 1000000 * (magnitude + 1) ^ 2 * - (encodedStoreLength overlay + input.length + width + 1) * - (width + 1) := hlookupRaw - _ = 1000000 * unit := by - dsimp only [unit, denseResourceUnit] - ring - have htargetAdd := hfixedAdd target (by omega) - have hset : setProgramCounterTime pcValue target ≤ 16 * unit := by - unfold setProgramCounterTime - omega - have hbranch : max (setProgramCounterTime pcValue target) - (TM.binarySuccTime pcValue) ≤ 16 * unit := - max_le hset (by omega) - have hresetValue := hreset (DenseOverlay.read input overlay source) hvalue - simp only [denseExecuteInstructionTime, denseZeroJumpInstructionTime, - TM.branchWorkBlankTime] - omega + exact denseExecuteZeroJumpTime_le_product tapes input pcValue overlay + width magnitude hvalid source target hstatic hcost hfixed hpc | jmp target => simp only [instructionResourceMagnitude] at hfixed have htargetAdd := hfixedAdd target (by omega) diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseInitProof.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseInitProof.lean index ed077a4dc9..eeaf7f13c9 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseInitProof.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseInitProof.lean @@ -280,6 +280,77 @@ private theorem denseProgramInitialStore_eq (input : List Bool) : simp [denseProgramInitialStore, DenseOverlay.Snapshot.initial, DenseOverlay.write, RegisterStore.write] +/-- Compose initialization phases whose parked tapes are unchanged by the phase transition. -/ +private theorem denseInit_sequence_parked {tapeCount : ℕ} + (first second : TM tapeCount) + {firstTime secondTime : ℕ} + {initial middle : Cfg tapeCount first.Q} {final : Cfg tapeCount second.Q} + (hfirst : first.reachesIn firstTime initial middle) + (hhalt : first.halted middle) + (hsecond : second.reachesIn secondTime + { state := second.qstart, input := middle.input, + work := middle.work, output := middle.output } final) + (hinput : TM.Parked middle.input) (hwork : ∀ i, TM.Parked (middle.work i)) + (houtput : TM.Parked middle.output) : + (TM.seqTM first second).reachesIn (firstTime + 1 + secondTime) + (TM.phase1Wrap first second initial) (TM.phase2Wrap first second final) := by + obtain ⟨hinputTransition, hworkTransition, houtputTransition⟩ := + TM.phaseTransition_eq_self_of_reads_ne_start hinput.read_ne_start + (fun i => (hwork i).read_ne_start) houtput.read_ne_start + apply TM.seqTM_reachesIn_of_reachesIn first second hfirst hhalt + simpa only [hinputTransition, hworkTransition, houtputTransition] using! hsecond + +/-- The installed dense snapshot provides the complete parked frame needed for input rewind. -/ +private theorem denseInitialRewind_preconditions + (tapes : ControlInstructionTapes n) (input : List Bool) + (abiInput : Tape) (abiWork : Fin (n + 1) → Tape) (abiOutput emitOutput : Tape) + (habiInputCells : abiInput.cells = (Tape.init (input.map Γ.ofBool)).cells) + (habiInputHead : abiInput.head = input.length + 1) + (habiWork : abiWork = programSnapshotWork tapes + { pc := 0, store := denseProgramInitialStore input }) + (habiOutput : abiOutput = emitOutput) + (hemitOutputParked : TM.Parked emitOutput) + (hemitOutputBlank : emitOutput = TM.resetBinaryBlank) : + InstructionExecutionReady tapes (denseProgramInitialStore input) 0 + (programSnapshotWork tapes { pc := 0, store := denseProgramInitialStore input }) ∧ + (abiInput.cells 0 = Γ.start ∧ + (∀ j, j ≥ 1 → abiInput.cells j ≠ Γ.start) ∧ + abiInput.head ≤ input.length + 1 ∧ + abiOutput.read ≠ Γ.start ∧ abiOutput.head ≥ 1 ∧ + (∀ i, (abiWork i).read ≠ Γ.start ∧ + (abiWork i).head ≥ 1) ∧ + (abiInput.cells = (Tape.init (input.map Γ.ofBool)).cells ∧ + abiWork = denseProgramSnapshotWork tapes + (DenseOverlay.Snapshot.initial input) ∧ + abiOutput = TM.resetBinaryBlank)) := by + let sparseInitial : Snapshot := + { pc := 0, store := denseProgramInitialStore input } + have hsparseCanonical : Canonical sparseInitial.store := by + simpa [sparseInitial, denseProgramInitialStore] using! + DenseOverlay.Snapshot.initial_canonical input + have habiReady : InstructionExecutionReady tapes sparseInitial.store 0 + (programSnapshotWork tapes sparseInitial) := + programSnapshotWork_ready_internal tapes sparseInitial hsparseCanonical + refine ⟨habiReady, ?_⟩ + refine ⟨?_, ?_, by omega, ?_, ?_, ?_, habiInputCells, ?_, ?_⟩ + · rw [habiInputCells] + simp [Tape.init] + · intro j hj + rw [habiInputCells] + exact Tape.init_ofBool_cells_ne_start input j hj + · rw [habiOutput] + exact hemitOutputParked.read_ne_start + · rw [habiOutput] + exact hemitOutputParked.1 + · intro i + have hiParked := habiReady.control.lookup.scanner.parked i + have hworkEq : abiWork = programSnapshotWork tapes sparseInitial := + habiWork + rw [hworkEq] + exact ⟨hiParked.read_ne_start, hiParked.1⟩ + · simpa [denseProgramSnapshotWork, sparseInitial] using! habiWork + · exact habiOutput.trans hemitOutputBlank + /-- Complete dense public-input initialization reaches the exact one-entry snapshot image and rewinds the immutable input bank to cell one. -/ theorem denseProgramInitTM_hoareTime_internal @@ -379,12 +450,6 @@ theorem denseProgramInitTM_hoareTime_internal omega let sparseInitial : Snapshot := { pc := 0, store := denseProgramInitialStore input } - have hsparseCanonical : Canonical sparseInitial.store := by - simpa [sparseInitial, denseProgramInitialStore] using! - DenseOverlay.Snapshot.initial_canonical input - have habiReady : InstructionExecutionReady tapes sparseInitial.store 0 - (programSnapshotWork tapes sparseInitial) := - programSnapshotWork_ready_internal tapes sparseInitial hsparseCanonical have hrewind := TM.rewindInputTM_hoareTime_frame (n := n + 1) (input.length + 1) (P := fun inp work out => @@ -396,35 +461,10 @@ theorem denseProgramInitTM_hoareTime_internal intro inp work out inp' work' out' hP hcells _hhead hwork' hout' exact ⟨hcells.trans hP.1, hwork'.trans hP.2.1, hout'.trans hP.2.2⟩) - have hrewindPre : - abiDone.input.cells 0 = Γ.start ∧ - (∀ j, j ≥ 1 → abiDone.input.cells j ≠ Γ.start) ∧ - abiDone.input.head ≤ input.length + 1 ∧ - abiDone.output.read ≠ Γ.start ∧ abiDone.output.head ≥ 1 ∧ - (∀ i, (abiDone.work i).read ≠ Γ.start ∧ - (abiDone.work i).head ≥ 1) ∧ - (abiDone.input.cells = (Tape.init (input.map Γ.ofBool)).cells ∧ - abiDone.work = denseProgramSnapshotWork tapes - (DenseOverlay.Snapshot.initial input) ∧ - abiDone.output = TM.resetBinaryBlank) := by - refine ⟨?_, ?_, by omega, ?_, ?_, ?_, habiInputCells, ?_, ?_⟩ - · rw [habiInputCells] - simp [Tape.init] - · intro j hj - rw [habiInputCells] - exact Tape.init_ofBool_cells_ne_start input j hj - · rw [habiOutput] - exact hemitOutputParked.read_ne_start - · rw [habiOutput] - exact hemitOutputParked.1 - · intro i - have hiParked := habiReady.control.lookup.scanner.parked i - have hworkEq : abiDone.work = programSnapshotWork tapes sparseInitial := - habiWork - rw [hworkEq] - exact ⟨hiParked.read_ne_start, hiParked.1⟩ - · simpa [denseProgramSnapshotWork, sparseInitial] using! habiWork - · exact habiOutput.trans hemitOutputBlank + obtain ⟨habiReady, hrewindPre⟩ := denseInitialRewind_preconditions + tapes input abiDone.input abiDone.work abiDone.output emitDone.output + habiInputCells habiInputHead habiWork habiOutput + hemitOutputParked hemitOutputBlank obtain ⟨rewindDone, rewindTime, hrewindTime, hrewindReach, hrewindHalt, hrewindHead, hrewindCells, hrewindWork, hrewindOutput⟩ := hrewind _ _ _ hrewindPre @@ -437,23 +477,9 @@ theorem denseProgramInitTM_hoareTime_internal intro i rw [habiWork] exact habiReady.control.lookup.scanner.parked i - obtain ⟨habiInputTransition, habiWorkTransition, - habiOutputTransition⟩ := - TM.phaseTransition_eq_self_of_reads_ne_start - habiInputParked.read_ne_start - (fun i => (habiWorkParked i).read_ne_start) - habiOutputParked.read_ne_start - have hrewindReach' : TM.rewindInputTM.reachesIn rewindTime - { state := TM.rewindInputTM.qstart - input := TM.transitionInput abiDone.input - work := fun i => TM.transitionTape (abiDone.work i) - output := TM.transitionTape abiDone.output } - rewindDone := by - simpa only [habiInputTransition, habiWorkTransition, - habiOutputTransition] using! hrewindReach - have habiRewindReach := TM.seqTM_reachesIn_of_reachesIn - (initialAbiInstallTM tapes) TM.rewindInputTM habiReach habiHalt - hrewindReach' + have habiRewindReach := denseInit_sequence_parked + (initialAbiInstallTM tapes) TM.rewindInputTM habiReach habiHalt hrewindReach + habiInputParked habiWorkParked habiOutputParked let abiRewindDone := TM.phase2Wrap (initialAbiInstallTM tapes) TM.rewindInputTM rewindDone have habiRewindHalt : @@ -461,27 +487,11 @@ theorem denseProgramInitTM_hoareTime_internal abiRewindDone := by rw [TM.phase2Wrap_halted_iff] exact hrewindHalt - obtain ⟨hemitInputTransition, hemitWorkTransition, - hemitOutputTransition⟩ := - TM.phaseTransition_eq_self_of_reads_ne_start - hemitInputParked.read_ne_start - (fun i => (hemitReady.parked i).read_ne_start) - hemitOutputParked.read_ne_start - have habiRewindReach' : - (TM.seqTM (initialAbiInstallTM tapes) TM.rewindInputTM).reachesIn - (abiTime + 1 + rewindTime) - { state := - (TM.seqTM (initialAbiInstallTM tapes) TM.rewindInputTM).qstart - input := TM.transitionInput emitDone.input - work := fun i => TM.transitionTape (emitDone.work i) - output := TM.transitionTape emitDone.output } - abiRewindDone := by - simpa only [hemitInputTransition, hemitWorkTransition, - hemitOutputTransition] using! habiRewindReach - have emitTailReach := TM.seqTM_reachesIn_of_reachesIn + have emitTailReach := denseInit_sequence_parked (initialLengthEmitTM tapes) (TM.seqTM (initialAbiInstallTM tapes) TM.rewindInputTM) - hemitReach hemitHalt habiRewindReach' + hemitReach hemitHalt habiRewindReach hemitInputParked + hemitReady.parked hemitOutputParked let emitTailDone := TM.phase2Wrap (initialLengthEmitTM tapes) (TM.seqTM (initialAbiInstallTM tapes) TM.rewindInputTM) abiRewindDone @@ -493,31 +503,12 @@ theorem denseProgramInitTM_hoareTime_internal (initialLengthEmitTM tapes) (TM.seqTM (initialAbiInstallTM tapes) TM.rewindInputTM) abiRewindDone).mpr habiRewindHalt - obtain ⟨hloopInputTransition, hloopWorkTransition, - hloopOutputTransition⟩ := - TM.phaseTransition_eq_self_of_reads_ne_start - hloopInputParked.read_ne_start - (fun i => (hloopReady.parked i).read_ne_start) - hloopOutputParked.read_ne_start - have emitTailReach' : - (TM.seqTM (initialLengthEmitTM tapes) - (TM.seqTM (initialAbiInstallTM tapes) TM.rewindInputTM)).reachesIn - (emitTime + 1 + (abiTime + 1 + rewindTime)) - { state := - (TM.seqTM (initialLengthEmitTM tapes) - (TM.seqTM (initialAbiInstallTM tapes) - TM.rewindInputTM)).qstart - input := TM.transitionInput loopDone.input - work := fun i => TM.transitionTape (loopDone.work i) - output := TM.transitionTape loopDone.output } - emitTailDone := by - simpa only [hloopInputTransition, hloopWorkTransition, - hloopOutputTransition] using! emitTailReach - have loopTailReach := TM.seqTM_reachesIn_of_reachesIn + have loopTailReach := denseInit_sequence_parked (denseInitialLengthLoopTM tapes) (TM.seqTM (initialLengthEmitTM tapes) (TM.seqTM (initialAbiInstallTM tapes) TM.rewindInputTM)) - hloopReach hloopHalt emitTailReach' + hloopReach hloopHalt emitTailReach hloopInputParked + hloopReady.parked hloopOutputParked let loopTailDone := TM.phase2Wrap (denseInitialLengthLoopTM tapes) (TM.seqTM (initialLengthEmitTM tapes) (TM.seqTM (initialAbiInstallTM tapes) TM.rewindInputTM)) @@ -532,35 +523,13 @@ theorem denseProgramInitTM_hoareTime_internal (TM.seqTM (initialLengthEmitTM tapes) (TM.seqTM (initialAbiInstallTM tapes) TM.rewindInputTM)) emitTailDone).mpr emitTailHalt - obtain ⟨hsetupInputTransition, hsetupWorkTransition, - hsetupOutputTransition⟩ := - TM.phaseTransition_eq_self_of_reads_ne_start - hsetupInputParked.read_ne_start - (fun i => (hsetupReady.parked i).read_ne_start) - hsetupOutputParked.read_ne_start - have loopTailReach' : - (TM.seqTM (denseInitialLengthLoopTM tapes) - (TM.seqTM (initialLengthEmitTM tapes) - (TM.seqTM (initialAbiInstallTM tapes) TM.rewindInputTM))).reachesIn - (loopTime + 1 + - (emitTime + 1 + (abiTime + 1 + rewindTime))) - { state := - (TM.seqTM (denseInitialLengthLoopTM tapes) - (TM.seqTM (initialLengthEmitTM tapes) - (TM.seqTM (initialAbiInstallTM tapes) - TM.rewindInputTM))).qstart - input := TM.transitionInput setupDone.input - work := fun i => TM.transitionTape (setupDone.work i) - output := TM.transitionTape setupDone.output } - loopTailDone := by - simpa only [hsetupInputTransition, hsetupWorkTransition, - hsetupOutputTransition] using! loopTailReach - have hreach := TM.seqTM_reachesIn_of_reachesIn + have hreach := denseInit_sequence_parked (initialSetupTM tapes) (TM.seqTM (denseInitialLengthLoopTM tapes) (TM.seqTM (initialLengthEmitTM tapes) (TM.seqTM (initialAbiInstallTM tapes) TM.rewindInputTM))) - hsetupReach hsetupHalt loopTailReach' + hsetupReach hsetupHalt loopTailReach hsetupInputParked + hsetupReady.parked hsetupOutputParked let finalCfg := TM.phase2Wrap (initialSetupTM tapes) (TM.seqTM (denseInitialLengthLoopTM tapes) (TM.seqTM (initialLengthEmitTM tapes) diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/GateEval/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/GateEval/Internal.lean index 1e5de6d30a..3e6fbe6924 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/GateEval/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/GateEval/Internal.lean @@ -1309,6 +1309,117 @@ private theorem routineFinal_frame {base : ℕ} {gate : CircuitCode.RawGate} (addressed outputReg) index = store index rw [haddress, Function.update_of_ne happend, haddressed, hevaluated] +/-- The six evaluation operations preserve the store envelope and their measured cost. -/ +private theorem routine_evaluation_measured {bound base : ℕ} + {gate : CircuitCode.RawGate} {wires : List Bool} {store : Store} + (hready : ReadyAt base gate wires store) + (hnegated1 : StoreEnvelope bound bound (routineNegated1 store)) + (hsmall : 10 < bound) + (value0 value1 : Bool) (hvalue0 : wires[gate.input₀]? = some value0) + (hvalue1 : wires[gate.input₁]? = some value1) : + StoreEnvelope bound bound (routineEvaluated store) ∧ + MeasuredRuns (.basics evalOps) (routineNegated1 store) + (routineEvaluated store) 6 (24 * valueWidth bound) + (envelopeSpace bound bound) := by + have htwo : 2 ≤ bound := by omega + have hvalue0Eq := routineNegated1_value0 hready value0 hvalue0 + have hvalue1Eq := routineNegated1_value hready value1 hvalue1 + have hopEq := routineNegated1_op hready + let product := (Basic.mul scratchReg value0Reg value1Reg).exec + (routineNegated1 store) + let sum := (Basic.add outputReg value0Reg value1Reg).exec product + let orStore := (Basic.sub outputReg outputReg scratchReg).exec sum + let delta := (Basic.sub address0Reg outputReg scratchReg).exec orStore + let selected := (Basic.mul address0Reg opReg address0Reg).exec delta + have hproduct : StoreEnvelope bound bound product := by + apply hnegated1.execBasic (.mul scratchReg value0Reg value1Reg) + · simp [scratchReg] + omega + · change routineNegated1 store value0Reg * + routineNegated1 store value1Reg ≤ bound + rw [hvalue0Eq, hvalue1Eq] + cases gate.negated₀ <;> cases gate.negated₁ <;> + cases value0 <;> cases value1 <;> simp [Input.bitValue] <;> omega + have hproductValue0 : product value0Reg = + Input.bitValue (gate.negated₀.xor value0) := by + rw [show product value0Reg = routineNegated1 store value0Reg by + simp [product, Basic.exec, Function.update_of_ne, value0Reg, scratchReg]] + exact hvalue0Eq + have hproductValue1 : product value1Reg = + Input.bitValue (gate.negated₁.xor value1) := by + rw [show product value1Reg = routineNegated1 store value1Reg by + simp [product, Basic.exec, Function.update_of_ne, value1Reg, scratchReg]] + exact hvalue1Eq + have hsum : StoreEnvelope bound bound sum := by + apply hproduct.execBasic (.add outputReg value0Reg value1Reg) + · simp [outputReg] + omega + · change product value0Reg + product value1Reg ≤ bound + rw [hproductValue0, hproductValue1] + cases gate.negated₀ <;> cases gate.negated₁ <;> + cases value0 <;> cases value1 <;> simp [Input.bitValue] <;> omega + have hsumOutput : sum outputReg ≤ 2 := by + change product value0Reg + product value1Reg ≤ 2 + rw [hproductValue0, hproductValue1] + cases gate.negated₀ <;> cases gate.negated₁ <;> + cases value0 <;> cases value1 <;> simp [Input.bitValue] + have hor : StoreEnvelope bound bound orStore := by + apply hsum.execBasic (.sub outputReg outputReg scratchReg) + · simp [outputReg] + omega + · exact le_trans (Nat.sub_le _ _) (le_trans hsumOutput htwo) + have horOutput : orStore outputReg ≤ 2 := + le_trans (Nat.sub_le _ _) hsumOutput + have hdelta : StoreEnvelope bound bound delta := by + apply hor.execBasic (.sub address0Reg outputReg scratchReg) + · simp [address0Reg] + omega + · exact le_trans (Nat.sub_le _ _) (le_trans horOutput htwo) + have hdeltaValue : delta address0Reg ≤ 2 := + le_trans (Nat.sub_le _ _) horOutput + have hselected : StoreEnvelope bound bound selected := by + apply hdelta.execBasic (.mul address0Reg opReg address0Reg) + · simp [address0Reg] + omega + · have hop : delta opReg = Input.bitValue gate.opBit := by + rw [show delta opReg = routineNegated1 store opReg by + simp [delta, orStore, sum, product, Basic.exec, + Function.update_of_ne, opReg, address0Reg, outputReg, scratchReg, + value0Reg, value1Reg]] + exact hopEq + change delta opReg * delta address0Reg ≤ bound + rw [hop] + cases gate.opBit <;> simp [Input.bitValue] + exact le_trans hdeltaValue htwo + have hevaluated : StoreEnvelope bound bound (routineEvaluated store) := by + change StoreEnvelope bound bound + ((Basic.sub outputReg outputReg address0Reg).exec selected) + apply hselected.execBasic (.sub outputReg outputReg address0Reg) + · simp [outputReg] + omega + · exact le_trans (Nat.sub_le _ _) (hselected.value_le outputReg) + have hevalRun0 := MeasuredRuns.basicEnvelope + (.mul scratchReg value0Reg value1Reg) (routineNegated1 store) + hnegated1 hproduct + have hevalRun1 := MeasuredRuns.basicEnvelope + (.add outputReg value0Reg value1Reg) product hproduct hsum + have hevalRun2 := MeasuredRuns.basicEnvelope + (.sub outputReg outputReg scratchReg) sum hsum hor + have hevalRun3 := MeasuredRuns.basicEnvelope + (.sub address0Reg outputReg scratchReg) orStore hor hdelta + have hevalRun4 := MeasuredRuns.basicEnvelope + (.mul address0Reg opReg address0Reg) delta hdelta hselected + have hevalRun5 := MeasuredRuns.basicEnvelope + (.sub outputReg outputReg address0Reg) selected hselected hevaluated + have hevalRun : MeasuredRuns (.basics evalOps) (routineNegated1 store) + (routineEvaluated store) 6 (24 * valueWidth bound) + (envelopeSpace bound bound) := by + have hrun := hevalRun0.seq (hevalRun1.seq (hevalRun2.seq + (hevalRun3.seq (hevalRun4.seq hevalRun5)))) + convert! hrun using 1 + ring + exact ⟨hevaluated, hevalRun⟩ + theorem routine_measured_internal {bound base : ℕ} {gate : CircuitCode.RawGate} {wires : List Bool} {store : Store} (hready : ReadyAt base gate wires store) @@ -1434,102 +1545,8 @@ theorem routine_measured_internal {bound base : ℕ} (routineNegated0 store) (routineNegated1 store) 4 (16 * valueWidth bound) (envelopeSpace bound bound) := by simpa [routineNegated1] using! hxor1.1 - have hvalue0Eq := routineNegated1_value0 hready value0 hvalue0 - have hvalue1Eq := routineNegated1_value hready value1 hvalue1 - have hopEq := routineNegated1_op hready - let product := (Basic.mul scratchReg value0Reg value1Reg).exec - (routineNegated1 store) - let sum := (Basic.add outputReg value0Reg value1Reg).exec product - let orStore := (Basic.sub outputReg outputReg scratchReg).exec sum - let delta := (Basic.sub address0Reg outputReg scratchReg).exec orStore - let selected := (Basic.mul address0Reg opReg address0Reg).exec delta - have hproduct : StoreEnvelope bound bound product := by - apply hnegated1.execBasic (.mul scratchReg value0Reg value1Reg) - · simp [scratchReg] - omega - · change routineNegated1 store value0Reg * - routineNegated1 store value1Reg ≤ bound - rw [hvalue0Eq, hvalue1Eq] - cases gate.negated₀ <;> cases gate.negated₁ <;> - cases value0 <;> cases value1 <;> simp [Input.bitValue] <;> omega - have hproductValue0 : product value0Reg = - Input.bitValue (gate.negated₀.xor value0) := by - rw [show product value0Reg = routineNegated1 store value0Reg by - simp [product, Basic.exec, Function.update_of_ne, value0Reg, scratchReg]] - exact hvalue0Eq - have hproductValue1 : product value1Reg = - Input.bitValue (gate.negated₁.xor value1) := by - rw [show product value1Reg = routineNegated1 store value1Reg by - simp [product, Basic.exec, Function.update_of_ne, value1Reg, scratchReg]] - exact hvalue1Eq - have hsum : StoreEnvelope bound bound sum := by - apply hproduct.execBasic (.add outputReg value0Reg value1Reg) - · simp [outputReg] - omega - · change product value0Reg + product value1Reg ≤ bound - rw [hproductValue0, hproductValue1] - cases gate.negated₀ <;> cases gate.negated₁ <;> - cases value0 <;> cases value1 <;> simp [Input.bitValue] <;> omega - have hsumOutput : sum outputReg ≤ 2 := by - change product value0Reg + product value1Reg ≤ 2 - rw [hproductValue0, hproductValue1] - cases gate.negated₀ <;> cases gate.negated₁ <;> - cases value0 <;> cases value1 <;> simp [Input.bitValue] - have hor : StoreEnvelope bound bound orStore := by - apply hsum.execBasic (.sub outputReg outputReg scratchReg) - · simp [outputReg] - omega - · exact le_trans (Nat.sub_le _ _) (le_trans hsumOutput htwo) - have horOutput : orStore outputReg ≤ 2 := - le_trans (Nat.sub_le _ _) hsumOutput - have hdelta : StoreEnvelope bound bound delta := by - apply hor.execBasic (.sub address0Reg outputReg scratchReg) - · simp [address0Reg] - omega - · exact le_trans (Nat.sub_le _ _) (le_trans horOutput htwo) - have hdeltaValue : delta address0Reg ≤ 2 := - le_trans (Nat.sub_le _ _) horOutput - have hselected : StoreEnvelope bound bound selected := by - apply hdelta.execBasic (.mul address0Reg opReg address0Reg) - · simp [address0Reg] - omega - · have hop : delta opReg = Input.bitValue gate.opBit := by - rw [show delta opReg = routineNegated1 store opReg by - simp [delta, orStore, sum, product, Basic.exec, - Function.update_of_ne, opReg, address0Reg, outputReg, scratchReg, - value0Reg, value1Reg]] - exact hopEq - change delta opReg * delta address0Reg ≤ bound - rw [hop] - cases gate.opBit <;> simp [Input.bitValue] - exact le_trans hdeltaValue htwo - have hevaluated : StoreEnvelope bound bound (routineEvaluated store) := by - change StoreEnvelope bound bound - ((Basic.sub outputReg outputReg address0Reg).exec selected) - apply hselected.execBasic (.sub outputReg outputReg address0Reg) - · simp [outputReg] - omega - · exact le_trans (Nat.sub_le _ _) (hselected.value_le outputReg) - have hevalRun0 := MeasuredRuns.basicEnvelope - (.mul scratchReg value0Reg value1Reg) (routineNegated1 store) - hnegated1 hproduct - have hevalRun1 := MeasuredRuns.basicEnvelope - (.add outputReg value0Reg value1Reg) product hproduct hsum - have hevalRun2 := MeasuredRuns.basicEnvelope - (.sub outputReg outputReg scratchReg) sum hsum hor - have hevalRun3 := MeasuredRuns.basicEnvelope - (.sub address0Reg outputReg scratchReg) orStore hor hdelta - have hevalRun4 := MeasuredRuns.basicEnvelope - (.mul address0Reg opReg address0Reg) delta hdelta hselected - have hevalRun5 := MeasuredRuns.basicEnvelope - (.sub outputReg outputReg address0Reg) selected hselected hevaluated - have hevalRun : MeasuredRuns (.basics evalOps) (routineNegated1 store) - (routineEvaluated store) 6 (24 * valueWidth bound) - (envelopeSpace bound bound) := by - have hrun := hevalRun0.seq (hevalRun1.seq (hevalRun2.seq - (hevalRun3.seq (hevalRun4.seq hevalRun5)))) - convert! hrun using 1 - ring + obtain ⟨hevaluated, hevalRun⟩ := routine_evaluation_measured hready + hnegated1 hsmall value0 value1 hvalue0 hvalue1 let appendAddressed := (Basic.add address1Reg baseReg wireCountReg).exec (routineEvaluated store) have happendAddressed : StoreEnvelope bound bound appendAddressed := by diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/GateStreamStep/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/GateStreamStep/Internal.lean index 37612f940f..2e241bb7b7 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/GateStreamStep/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/GateStreamStep/Internal.lean @@ -594,6 +594,106 @@ private theorem header_negated1 {gateStart base : ℕ} rw [header_high store (gateStart + 2) hlarge, hready.code_eq 2] simp [codeBits, CircuitCode.RawGate.encode] +/-- The two decoded operands and preserved metadata satisfy the parsed-gate interface. -/ +private theorem parsed_of_decoder_state {gateStart base : ℕ} + {gate : CircuitCode.RawGate} {tail wires : List Bool} {store second : Store} + (hready : Ready gateStart base gate tail wires store) + (hsecondVerdict : second UnaryDecode.verdictReg = 1) + (hsecondValue : second UnaryDecode.valueReg = gate.input₁) + (hsecondPointer : second UnaryDecode.pointerReg = gateStart + gate.encode.length) + (hsecondRemaining : second UnaryDecode.remainingReg = tail.length) + (hsecondActive : second UnaryDecode.activeReg = 0) + (hmeta : ∀ index, UnaryDecode.inputBase ≤ index → index ≠ savedInput0Reg → + second index = headerStore store index) + (hpreserved : ∀ index, 10 < index → second index = store index) + (hinput0 : second savedInput0Reg = gate.input₀) : + Parsed gateStart (gateStart + gate.encode.length) + tail.length base gate wires second := by + constructor + · exact hready.base_ge + · exact hready.memo_before_code + · exact hsecondVerdict + · exact hsecondValue + · exact hsecondPointer + · exact hsecondRemaining + · exact hsecondActive + · rw [hmeta memoBaseReg] + · simpa [headerStore, headerOps, setupStore, setupOps, Basic.execList, + Basic.exec, memoBaseReg, UnaryDecode.verdictReg, + UnaryDecode.valueReg, UnaryDecode.pointerReg, + UnaryDecode.remainingReg, UnaryDecode.oneReg, + UnaryDecode.activeReg, gateStartReg] using hready.memoBase_eq + · simp [memoBaseReg, UnaryDecode.inputBase] + · simp [memoBaseReg, savedInput0Reg] + · rw [hmeta wireCountMetaReg] + · simpa [headerStore, headerOps, setupStore, setupOps, Basic.execList, + Basic.exec, wireCountMetaReg, UnaryDecode.verdictReg, + UnaryDecode.valueReg, UnaryDecode.pointerReg, + UnaryDecode.remainingReg, UnaryDecode.oneReg, + UnaryDecode.activeReg, gateStartReg] using hready.wireCount_eq + · simp [wireCountMetaReg, UnaryDecode.inputBase] + · simp [wireCountMetaReg, savedInput0Reg] + · rw [hmeta gateStartReg] + · simp [headerStore, headerOps, setupStore, setupOps, Basic.execList, + Basic.exec, gateStartReg, UnaryDecode.pointerReg, + UnaryDecode.remainingReg] + exact hready.pointer_eq + · simp [gateStartReg, UnaryDecode.inputBase] + · simp [gateStartReg, savedInput0Reg] + · exact hinput0 + · rw [hpreserved gateStart] + · exact hready.code_eq 0 |>.trans (by + simp [codeBits, CircuitCode.RawGate.encode]) + · have hbase := hready.base_ge + have hcode := hready.memo_before_code + simp only [spillRemainingReg] at hbase + omega + · rw [hpreserved (gateStart + 1)] + · simpa [codeBits, CircuitCode.RawGate.encode] using + hready.code_eq 1 + · have hbase := hready.base_ge + have hcode := hready.memo_before_code + simp only [spillRemainingReg] at hbase + omega + · rw [hpreserved (gateStart + 2)] + · simpa [codeBits, CircuitCode.RawGate.encode] using + hready.code_eq 2 + · have hbase := hready.base_ge + have hcode := hready.memo_before_code + simp only [spillRemainingReg] at hbase + omega + · intro index + rw [hpreserved (base + index)] + · exact hready.wire_eq index + · have hbase := hready.base_ge + simp only [spillRemainingReg] at hbase + omega + +/-- Decoder preservation above the register block retains the complete trailing code stream. -/ +private theorem decoder_tail_preserved {gateStart base : ℕ} + {gate : CircuitCode.RawGate} {tail wires : List Bool} {store second : Store} + (hready : Ready gateStart base gate tail wires store) + (hpreserved : ∀ index, 10 < index → second index = store index) : + ∀ delta, + second (gateStart + gate.encode.length + delta) = + match tail[delta]? with + | some bit => Input.bitValue bit + | none => 0 := by + intro delta + rw [hpreserved (gateStart + gate.encode.length + delta)] + · have hcode := hready.code_eq (gate.encode.length + delta) + rw [show gateStart + (gate.encode.length + delta) = + gateStart + gate.encode.length + delta by omega] at hcode + rw [show (codeBits gate tail)[gate.encode.length + delta]? = + tail[delta]? by + rw [codeBits, List.getElem?_append_right (by simp)] + simp] at hcode + exact hcode + · have hbase := hready.base_ge + have hcode := hready.memo_before_code + simp only [spillRemainingReg] at hbase + omega + private theorem decoders_internal {gateStart base : ℕ} {gate : CircuitCode.RawGate} {tail wires : List Bool} {store : Store} (hready : Ready gateStart base gate tail wires store) @@ -793,86 +893,9 @@ private theorem decoders_internal {gateStart base : ℕ} {gate : CircuitCode.Raw simp [saveRestartStore, saveRestartOps, Basic.execList, Basic.exec, savedInput0Reg, UnaryDecode.verdictReg, UnaryDecode.valueReg, UnaryDecode.activeReg, hvalue, hactive] - have hparsed : Parsed gateStart (gateStart + gate.encode.length) - tail.length base gate wires second := by - constructor - · exact hready.base_ge - · exact hready.memo_before_code - · exact hsecondResult.1 - · exact hsecondValue - · exact hsecondPointer - · exact hsecondRemaining - · exact hsecondActive - · rw [hmeta memoBaseReg] - · simpa [headerStore, headerOps, setupStore, setupOps, Basic.execList, - Basic.exec, memoBaseReg, UnaryDecode.verdictReg, - UnaryDecode.valueReg, UnaryDecode.pointerReg, - UnaryDecode.remainingReg, UnaryDecode.oneReg, - UnaryDecode.activeReg, gateStartReg] using hready.memoBase_eq - · simp [memoBaseReg, UnaryDecode.inputBase] - · simp [memoBaseReg, savedInput0Reg] - · rw [hmeta wireCountMetaReg] - · simpa [headerStore, headerOps, setupStore, setupOps, Basic.execList, - Basic.exec, wireCountMetaReg, UnaryDecode.verdictReg, - UnaryDecode.valueReg, UnaryDecode.pointerReg, - UnaryDecode.remainingReg, UnaryDecode.oneReg, - UnaryDecode.activeReg, gateStartReg] using hready.wireCount_eq - · simp [wireCountMetaReg, UnaryDecode.inputBase] - · simp [wireCountMetaReg, savedInput0Reg] - · rw [hmeta gateStartReg] - · simp [headerStore, headerOps, setupStore, setupOps, Basic.execList, - Basic.exec, gateStartReg, UnaryDecode.pointerReg, - UnaryDecode.remainingReg] - exact hready.pointer_eq - · simp [gateStartReg, UnaryDecode.inputBase] - · simp [gateStartReg, savedInput0Reg] - · exact hinput0 - · rw [hpreserved gateStart] - · exact hready.code_eq 0 |>.trans (by - simp [codeBits, CircuitCode.RawGate.encode]) - · have hbase := hready.base_ge - have hcode := hready.memo_before_code - simp only [spillRemainingReg] at hbase - omega - · rw [hpreserved (gateStart + 1)] - · simpa [codeBits, CircuitCode.RawGate.encode] using - hready.code_eq 1 - · have hbase := hready.base_ge - have hcode := hready.memo_before_code - simp only [spillRemainingReg] at hbase - omega - · rw [hpreserved (gateStart + 2)] - · simpa [codeBits, CircuitCode.RawGate.encode] using - hready.code_eq 2 - · have hbase := hready.base_ge - have hcode := hready.memo_before_code - simp only [spillRemainingReg] at hbase - omega - · intro index - rw [hpreserved (base + index)] - · exact hready.wire_eq index - · have hbase := hready.base_ge - simp only [spillRemainingReg] at hbase - omega - have hsecondCode : ∀ delta, - second (gateStart + gate.encode.length + delta) = - match tail[delta]? with - | some bit => Input.bitValue bit - | none => 0 := by - intro delta - rw [hpreserved (gateStart + gate.encode.length + delta)] - · have hcode := hready.code_eq (gate.encode.length + delta) - rw [show gateStart + (gate.encode.length + delta) = - gateStart + gate.encode.length + delta by omega] at hcode - rw [show (codeBits gate tail)[gate.encode.length + delta]? = - tail[delta]? by - rw [codeBits, List.getElem?_append_right (by simp)] - simp] at hcode - exact hcode - · have hbase := hready.base_ge - have hcode := hready.memo_before_code - simp only [spillRemainingReg] at hbase - omega + have hparsed := parsed_of_decoder_state hready hsecondResult.1 hsecondValue + hsecondPointer hsecondRemaining hsecondActive hmeta hpreserved hinput0 + have hsecondCode := decoder_tail_preserved hready hpreserved refine ⟨first, saved, second, firstCost, firstSpace, secondCost, secondSpace, hfirst, rfl, hsecond, hparsed, hsecondCode, ?_⟩ simpa [hcursorEnd] using hsecondBound diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/Internal/Union.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/Internal/Union.lean index 415438dba2..3dc3b29ba1 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/Internal/Union.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/Internal/Union.lean @@ -830,6 +830,83 @@ private theorem rewind_input_work_idle (tm₁ : TM n₁) (tm₂ : TM n₂) hidle' exact ⟨c'', .step hstep hreach, hidle''⟩ +/-- The rejection check leaves the input rewind distance at most one past its original head. -/ +private theorem unionReject_rewindInput_head_bound + (tm₁ : TM n₁) (tm₂ : TM n₂) (x : List Bool) + (c₁ : Cfg n₁ tm₁.Q) + (c_rw c_at0 : Cfg (n₁ + 1 + n₂) (UnionQ tm₁.Q tm₂.Q)) (h_rw : ℕ) + (hhalt : tm₁.halted c₁) + (hinput_cells : c₁.input.cells = (Tape.init (x.map Γ.ofBool)).cells) + (hstep1 : (unionTM tm₁ tm₂).step (unionPhase1Cfg tm₁ tm₂ c₁) = some c_rw) + (hreach_rw : (unionTM tm₁ tm₂).reachesIn h_rw c_rw c_at0) + (hinp_at0 : c_rw.input.head ≥ 1 → + (∀ i, i ≥ 1 → c_rw.input.cells i ≠ Γ.start) → + c_at0.input.head = c_rw.input.head) : + let checkInput := c_at0.input.move (idleDir c_at0.input.read) + let rewindInput := checkInput.move (idleDir checkInput.read) + rewindInput.head ≤ c₁.input.head + 1 := by + dsimp only + let checkInput := c_at0.input.move (idleDir c_at0.input.read) + let rewindInput := checkInput.move (idleDir checkInput.read) + -- c_rw.input.cells = c₁.input.cells (input cells preserved through step) + have hcrw_cells : c_rw.input.cells = c₁.input.cells := by + have := union_input_cells_of_step tm₁ tm₂ hstep1 + rw [this]; rfl + -- c_rw.input cells[≥1] ≠ Γ.start + have hcrw_ino : ∀ i, i ≥ 1 → c_rw.input.cells i ≠ Γ.start := by + intro i hi; rw [hcrw_cells, hinput_cells] + simp only [Tape.init, show i ≠ 0 from by omega, ↓reduceIte] + intro heq + cases hget : (x.map Γ.ofBool)[i - 1]? with + | none => simp [hget, Option.getD] at heq + | some v => + simp [hget, Option.getD] at heq; subst heq + have hmem := List.mem_of_getElem? hget + simp [List.mem_map] at hmem; rcases hmem with ⟨_, hb⟩ | ⟨_, hb⟩ <;> simp [Γ.ofBool] at hb + -- c_rw.input.head ≤ c₁.input.head + 1 + -- From step_inl_qhalt_cfg, the input direction is idleDir(input.read) + -- Use step_inl_qhalt_cfg to get the exact form of c_rw.input + have hstateq : (unionPhase1Cfg tm₁ tm₂ c₁).state = Sum.inl tm₁.qhalt := by + show Sum.inl c₁.state = Sum.inl tm₁.qhalt; rw [hhalt] + have hstep_eq := step_inl_qhalt_cfg tm₁ tm₂ hstateq + -- c_rw.input = c₁.input.move (idleDir c₁.input.read) since unionPhase1Cfg.input = c₁.input + have hcrw_input_eq : c_rw.input = c₁.input.move (idleDir c₁.input.read) := by + have heq : some c_rw = some _ := hstep1.symm.trans hstep_eq + simp only [Option.some.injEq] at heq + rw [heq]; rfl + -- c_rw.input.head ≤ c₁.input.head + 1 + have hcrw_head : c_rw.input.head ≤ c₁.input.head + 1 := by + rw [hcrw_input_eq]; cases (idleDir c₁.input.read) <;> simp [Tape.move]; omega + -- c_rw.input.head ≥ 1 + have hcrw_hge : c_rw.input.head ≥ 1 := by + rw [hcrw_input_eq] + by_cases hh : c₁.input.head = 0 + · have hread0 : c₁.input.read = Γ.start := by + rw [Tape.read, hh, hinput_cells]; simp [Tape.init] + rw [hread0, idleDir, ite_eq_left rfl]; simp [Tape.move, hh] + · have hge : c₁.input.head ≥ 1 := by omega + have hc1_ino : ∀ i, i ≥ 1 → c₁.input.cells i ≠ Γ.start := by + intro i hi; rw [← hcrw_cells]; exact hcrw_ino i hi + rw [idleDir_stay_of_ge_one _ hge hc1_ino]; simp [Tape.move]; omega + -- Through rewind_fakeOut loop: input head preserved + have hat0_head : c_at0.input.head = c_rw.input.head := + hinp_at0 hcrw_hge hcrw_ino + -- c_at0.input.cells[≥1] ≠ start (preserved through reachesIn) + have hat0_ino : ∀ i, i ≥ 1 → c_at0.input.cells i ≠ Γ.start := by + intro i hi; rw [union_input_cells_of_reachesIn tm₁ tm₂ hreach_rw]; exact hcrw_ino i hi + -- checkInput.head = c_at0.input.head (idleDir step from head ≥ 1) + have hcr_head : checkInput.head = c_at0.input.head := by + show (c_at0.input.move (idleDir c_at0.input.read)).head = _ + exact idle_move_preserves_head _ (by omega) hat0_ino + -- rewindInput.head = checkInput.head (idleDir step from head ≥ 1) + have hcr_ino : ∀ i, i ≥ 1 → checkInput.cells i ≠ Γ.start := by + intro i hi; show (c_at0.input.move _).cells i ≠ _; rw [Tape.move_cells]; exact hat0_ino i hi + have hri_head : rewindInput.head = checkInput.head := by + show (checkInput.move (idleDir checkInput.read)).head = _ + exact idle_move_preserves_head _ (by omega) hcr_ino + -- Chain: rewindInput.head = rewindInput.head = c_rw.input.head ≤ c₁.input.head + 1 + omega + /-- After Phase 1, if tm₁ rejected, the union machine transitions to a config ready for Phase 2: state is `Sum.inr (Sum.inr tm₂.qstart)`, input/output/active work tapes match `tm₂.initCfg x`. -/ @@ -1099,65 +1176,9 @@ theorem unionTM_transition_reject (tm₁ : TM n₁) (tm₂ : TM n₂) (x : List -- Need: 1 + (h_rw + 2) + (h_ri + 2) = h_rw + h_ri + 5 ≤ c₁.output.head + c₁.input.head + 7 -- Suffices: h_rw + h_ri ≤ c₁.output.head + c₁.input.head + 2, which holds. -- Prove h_ri ≤ c₁.input.head + 1: - have hri_bound : h_ri ≤ c₁.input.head + 1 := by - -- c_rw.input.cells = c₁.input.cells (input cells preserved through step) - have hcrw_cells : c_rw.input.cells = c₁.input.cells := by - have := union_input_cells_of_step tm₁ tm₂ hstep1 - rw [this]; rfl - -- c_rw.input cells[≥1] ≠ Γ.start - have hcrw_ino : ∀ i, i ≥ 1 → c_rw.input.cells i ≠ Γ.start := by - intro i hi; rw [hcrw_cells, hinput_cells] - simp only [Tape.init, show i ≠ 0 from by omega, ↓reduceIte] - intro heq - cases hget : (x.map Γ.ofBool)[i - 1]? with - | none => simp [hget, Option.getD] at heq - | some v => - simp [hget, Option.getD] at heq; subst heq - have hmem := List.mem_of_getElem? hget - simp [List.mem_map] at hmem; rcases hmem with ⟨_, hb⟩ | ⟨_, hb⟩ <;> simp [Γ.ofBool] at hb - -- c_rw.input.head ≤ c₁.input.head + 1 - -- From step_inl_qhalt_cfg, the input direction is idleDir(input.read) - -- Use step_inl_qhalt_cfg to get the exact form of c_rw.input - have hstateq : (unionPhase1Cfg tm₁ tm₂ c₁).state = Sum.inl tm₁.qhalt := by - show Sum.inl c₁.state = Sum.inl tm₁.qhalt; rw [hhalt] - have hstep_eq := step_inl_qhalt_cfg tm₁ tm₂ hstateq - -- c_rw.input = c₁.input.move (idleDir c₁.input.read) since unionPhase1Cfg.input = c₁.input - have hcrw_input_eq : c_rw.input = c₁.input.move (idleDir c₁.input.read) := by - have heq : some c_rw = some _ := hstep1.symm.trans hstep_eq - simp only [Option.some.injEq] at heq - rw [heq]; rfl - -- c_rw.input.head ≤ c₁.input.head + 1 - have hcrw_head : c_rw.input.head ≤ c₁.input.head + 1 := by - rw [hcrw_input_eq]; cases (idleDir c₁.input.read) <;> simp [Tape.move]; omega - -- c_rw.input.head ≥ 1 - have hcrw_hge : c_rw.input.head ≥ 1 := by - rw [hcrw_input_eq] - by_cases hh : c₁.input.head = 0 - · have hread0 : c₁.input.read = Γ.start := by - rw [Tape.read, hh, hinput_cells]; simp [Tape.init] - rw [hread0, idleDir, ite_eq_left rfl]; simp [Tape.move, hh] - · have hge : c₁.input.head ≥ 1 := by omega - have hc1_ino : ∀ i, i ≥ 1 → c₁.input.cells i ≠ Γ.start := by - intro i hi; rw [← hcrw_cells]; exact hcrw_ino i hi - rw [idleDir_stay_of_ge_one _ hge hc1_ino]; simp [Tape.move]; omega - -- Through rewind_fakeOut loop: input head preserved - have hat0_head : c_at0.input.head = c_rw.input.head := - hinp_at0 hcrw_hge hcrw_ino - -- c_at0.input.cells[≥1] ≠ start (preserved through reachesIn) - have hat0_ino : ∀ i, i ≥ 1 → c_at0.input.cells i ≠ Γ.start := by - intro i hi; rw [union_input_cells_of_reachesIn tm₁ tm₂ hreach_rw]; exact hcrw_ino i hi - -- c_cr.input.head = c_at0.input.head (idleDir step from head ≥ 1) - have hcr_head : c_cr.input.head = c_at0.input.head := by - show (c_at0.input.move (idleDir c_at0.input.read)).head = _ - exact idle_move_preserves_head _ (by omega) hat0_ino - -- c_ri.input.head = c_cr.input.head (idleDir step from head ≥ 1) - have hcr_ino : ∀ i, i ≥ 1 → c_cr.input.cells i ≠ Γ.start := by - intro i hi; show (c_at0.input.move _).cells i ≠ _; rw [Tape.move_cells]; exact hat0_ino i hi - have hri_head : c_ri.input.head = c_cr.input.head := by - show (c_cr.input.move (idleDir c_cr.input.read)).head = _ - exact idle_move_preserves_head _ (by omega) hcr_ino - -- Chain: h_ri = c_ri.input.head = c_rw.input.head ≤ c₁.input.head + 1 - omega + have hri_bound : h_ri ≤ c₁.input.head + 1 := + unionReject_rewindInput_head_bound tm₁ tm₂ x c₁ c_rw c_at0 h_rw + hhalt hinput_cells hstep1 hreach_rw hinp_at0 have htime : 1 + (h_rw + (1 + 1)) + (h_ri + (1 + 1)) ≤ c₁.output.head + c₁.input.head + 7 := by omega refine ⟨1 + (h_rw + (1 + 1)) + (h_ri + (1 + 1)), c_mid, ?_, hst_mid, hin_mid, hwork_mid, From 4ab2064f8ea4324b2095d76a6ba4d625418587e5 Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Fri, 25 Sep 2026 21:27:19 +0000 Subject: [PATCH 40/49] Use ordinary import formatting and wrap remaining long code lines --- .../BeyondBethe/DirectedOptimizerOracle.lean | 3 +- .../MachineUnaryGridGenerator.lean | 3 +- .../BeyondBethe/SourceAnariRezaei.lean | 3 +- .../BeyondBethe/SourceAnariRezaeiMerge.lean | 9 +++-- .../BeyondBethe/SourceStableEncoding.lean | 9 +++-- .../P/Cobham/Internal/IterateLayout.lean | 9 +++-- .../Classes/P/Cobham/Internal/SndBlock.lean | 3 +- .../Classes/P/FinsetDomain/Internal.lean | 3 +- .../Models/RandomAccessMachine.lean | 33 +++++++------------ .../RegisterStore/Containment/Defs.lean | 6 ++-- .../RegisterStore/Containment/Internal.lean | 9 ++--- .../RegisterStore/DenseOverlay.lean | 3 +- .../RegisterStore/Machine/AddressEq.lean | 3 +- .../Machine/AddressEq/Internal.lean | 3 +- .../Machine/DenseInputLookup.lean | 3 +- .../Machine/DenseInputLookup/Internal.lean | 3 +- .../RegisterStore/Machine/EntryAppend.lean | 6 ++-- .../Machine/EntryAppend/Defs.lean | 3 +- .../Machine/EntryAppend/Internal.lean | 3 +- .../RegisterStore/Machine/EntryCleanup.lean | 6 ++-- .../Machine/EntryCleanup/Defs.lean | 3 +- .../Machine/EntryCleanup/Internal.lean | 3 +- .../RegisterStore/Machine/EntryDecode.lean | 9 ++--- .../Machine/EntryDecode/Defs.lean | 3 +- .../Machine/EntryDecode/Internal.lean | 3 +- .../Machine/EntryDecode/LinearInternal.lean | 3 +- .../RegisterStore/Machine/EntryEncode.lean | 6 ++-- .../Machine/EntryEncode/Defs.lean | 3 +- .../Machine/EntryEncode/Internal.lean | 3 +- .../RegisterStore/Machine/EntryLookup.lean | 9 ++--- .../Machine/EntryLookup/Defs.lean | 3 +- .../Machine/EntryLookup/Internal.lean | 3 +- .../Machine/EntryLookupRestore.lean | 3 +- .../RegisterStore/Machine/EntryMatch.lean | 6 ++-- .../Machine/EntryMatch/Defs.lean | 6 ++-- .../Machine/EntryMatch/Internal.lean | 3 +- .../RegisterStore/Machine/EntryMissCopy.lean | 6 ++-- .../Machine/EntryMissCopy/Defs.lean | 6 ++-- .../Machine/EntryMissCopy/Internal.lean | 3 +- .../RegisterStore/Machine/EntryReplace.lean | 6 ++-- .../Machine/EntryReplace/Defs.lean | 6 ++-- .../Machine/EntryReplace/Internal.lean | 3 +- .../RegisterStore/Machine/EntryScan.lean | 9 ++--- .../RegisterStore/Machine/EntryScan/Defs.lean | 3 +- .../Machine/EntryScan/Internal/Bounds.lean | 3 +- .../Machine/EntryScan/Internal/Ctrl.lean | 3 +- .../Machine/EntryScan/Internal/Inv.lean | 3 +- .../Machine/EntryScan/Internal/Sem.lean | 9 ++--- .../RegisterStore/Machine/EntryScanStep.lean | 6 ++-- .../Machine/EntryScanStep/Defs.lean | 3 +- .../Machine/EntryScanStep/Internal.lean | 3 +- .../RegisterStore/Machine/EntryUpdate.lean | 15 +++------ .../Machine/EntryUpdate/BoundsInternal.lean | 6 ++-- .../Machine/EntryUpdate/Defs.lean | 6 ++-- .../Machine/EntryUpdate/Internal/Ctrl.lean | 3 +- .../Machine/EntryUpdate/Internal/End.lean | 9 ++--- .../Machine/EntryUpdate/Internal/Hit.lean | 9 ++--- .../Machine/EntryUpdate/Internal/Inv.lean | 6 ++-- .../Machine/EntryUpdate/Internal/Loop.lean | 6 ++-- .../Machine/EntryUpdate/Internal/Miss.lean | 9 ++--- .../Machine/EntryUpdate/Internal/Out.lean | 6 ++-- .../Machine/EntryUpdate/Internal/Sem.lean | 6 ++-- .../Machine/EntryUpdate/Internal/Step.lean | 6 ++-- .../Machine/EntryUpdate/Internal/Time.lean | 3 +- .../Machine/EntryUpdate/Source.lean | 6 ++-- .../Machine/EntryUpdate/Tagged.lean | 3 +- .../Machine/EntryUpdate/TaggedDefs.lean | 3 +- .../Machine/EntryUpdate/TaggedProof.lean | 3 +- .../Machine/EntryUpdate/Types.lean | 6 ++-- .../RegisterStore/Machine/Instruction.lean | 21 ++++-------- .../Machine/Instruction/Control.lean | 6 ++-- .../Machine/Instruction/Defs.lean | 3 +- .../Machine/Instruction/DenseControl.lean | 6 ++-- .../Machine/Instruction/DenseCtrlSim.lean | 9 ++--- .../Machine/Instruction/DenseDefs.lean | 6 ++-- .../Machine/Instruction/DenseDirect.lean | 12 +++---- .../Machine/Instruction/DenseDispatch.lean | 6 ++-- .../Machine/Instruction/DenseImm.lean | 9 ++--- .../Machine/Instruction/DenseLoad.lean | 12 +++---- .../Machine/Instruction/DenseSim.lean | 6 ++-- .../Machine/Instruction/DenseSimData.lean | 15 +++------ .../Machine/Instruction/DenseSimDefs.lean | 6 ++-- .../Machine/Instruction/DenseStore.lean | 3 +- .../Machine/Instruction/Direct.lean | 6 ++-- .../Machine/Instruction/Dispatch.lean | 12 +++---- .../Machine/Instruction/Immediate.lean | 3 +- .../Machine/Instruction/Internal.lean | 3 +- .../Machine/Instruction/Load.lean | 6 ++-- .../Machine/Instruction/Sim/Control.lean | 3 +- .../Machine/Instruction/Sim/Data.lean | 3 +- .../Machine/Instruction/Sim/Defs.lean | 3 +- .../Machine/Instruction/Sim/Internal.lean | 3 +- .../Machine/Instruction/Store.lean | 3 +- .../Machine/Instruction/Tapes.lean | 3 +- .../RegisterStore/Machine/Lookup/Defs.lean | 6 ++-- .../Machine/Lookup/DenseInternal.lean | 6 ++-- .../Machine/Lookup/Internal/Assemble.lean | 12 +++---- .../Machine/Lookup/Internal/Reset.lean | 3 +- .../Machine/Lookup/Internal/Scan.lean | 3 +- .../Machine/Lookup/Internal/Static.lean | 3 +- .../Machine/Lookup/ResetLayout.lean | 6 ++-- .../RegisterStore/Machine/Program.lean | 3 +- .../RegisterStore/Machine/Program/Bounds.lean | 6 ++-- .../Machine/Program/Bounds/Internal.lean | 12 +++---- .../Machine/Program/Decision.lean | 6 ++-- .../Machine/Program/Decision/Defs.lean | 3 +- .../Machine/Program/DecisionInternal.lean | 9 ++--- .../RegisterStore/Machine/Program/Defs.lean | 3 +- .../Machine/Program/DenseBounds.lean | 6 ++-- .../Machine/Program/DenseBoundsDefs.lean | 3 +- .../Machine/Program/DenseBoundsProof.lean | 12 +++---- .../Machine/Program/DenseDecision.lean | 6 ++-- .../Machine/Program/DenseDecisionDefs.lean | 6 ++-- .../Machine/Program/DenseDecisionProof.lean | 9 ++--- .../Machine/Program/DenseDefs.lean | 3 +- .../Machine/Program/DenseInit.lean | 6 ++-- .../Machine/Program/DenseInitDefs.lean | 3 +- .../Machine/Program/DenseInitProof.lean | 9 ++--- .../Machine/Program/DenseInternal.lean | 6 ++-- .../Machine/Program/Init/Internal.lean | 6 ++-- .../Machine/Program/Initialization.lean | 6 ++-- .../Machine/Program/Internal.lean | 3 +- .../RegisterStore/Machine/WordDecode.lean | 9 ++--- .../Machine/WordDecode/Internal.lean | 3 +- .../Machine/WordDecode/LinearInternal.lean | 3 +- .../RegisterStore/Machine/WordEncode.lean | 6 ++-- .../Machine/WordEncode/Internal.lean | 3 +- .../Simulation/TMConfig/Sparse/ABI.lean | 3 +- .../Sparse/ABI/Internal/Decision.lean | 3 +- .../TMConfig/Sparse/ABI/Internal/Marshal.lean | 3 +- .../Sparse/ABI/Internal/Resources.lean | 6 ++-- .../TMConfig/Sparse/Containment.lean | 3 +- .../TMConfig/Sparse/Step/Internal.lean | 15 +++------ .../TMConfig/Sparse/Step/Internal/Action.lean | 3 +- .../Sparse/Step/Internal/Iteration.lean | 3 +- .../TMConfig/Sparse/Step/Internal/Load.lean | 3 +- .../Sparse/Step/Internal/Resources.lean | 3 +- .../TuringMachine/Combinators/Helpers.lean | 3 +- .../Subroutines/BinaryEq/Internal.lean | 6 ++-- .../TuringMachine/Subroutines/Counter.lean | 3 +- .../TuringMachine/Subroutines/Internal.lean | 3 +- .../Subroutines/PairEmit/Internal.lean | 6 ++-- 142 files changed, 288 insertions(+), 510 deletions(-) diff --git a/LeanPool/BeyondBethe/BeyondBethe/DirectedOptimizerOracle.lean b/LeanPool/BeyondBethe/BeyondBethe/DirectedOptimizerOracle.lean index 1b535b8b7e..b2d5815a53 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/DirectedOptimizerOracle.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/DirectedOptimizerOracle.lean @@ -235,7 +235,8 @@ theorem directedNegativeObjectiveCoordinate_bounds directedNegativeObjectiveCoordinateLower] push_cast norm_num only [Rat.cast_pow, Rat.cast_div, Rat.cast_one, - Rat.cast_ofNat] at hAweighted hXweighted hCweighted hAweightBound hXweightBound hCweightBound hdyadic ⊢ + Rat.cast_ofNat] at hAweighted hXweighted hCweighted + hAweightBound hXweightBound hCweightBound hdyadic ⊢ nlinarith /-- Rational lower endpoint for the complete negative objective. -/ diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineUnaryGridGenerator.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineUnaryGridGenerator.lean index 6a5741da22..0f9cc65e0b 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineUnaryGridGenerator.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineUnaryGridGenerator.lean @@ -96,7 +96,8 @@ def machineUnaryGridGeneratorPayload (state : List Bool) : List Bool := @[simp] theorem machineUnaryGridGeneratorAccumulator_pack (row column accumulator bound done payload : List Bool) : machineUnaryGridGeneratorAccumulator - (machineUnaryGridGeneratorPack row column accumulator bound done payload) = accumulator := by + (machineUnaryGridGeneratorPack row column accumulator bound done payload) = + accumulator := by simp [machineUnaryGridGeneratorAccumulator, machineUnaryGridGeneratorPack] @[simp] theorem machineUnaryGridGeneratorBound_pack diff --git a/LeanPool/BeyondBethe/BeyondBethe/SourceAnariRezaei.lean b/LeanPool/BeyondBethe/BeyondBethe/SourceAnariRezaei.lean index 9188bf8fba..4187631b6e 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/SourceAnariRezaei.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/SourceAnariRezaei.lean @@ -467,7 +467,8 @@ theorem anariRezaeiPhiThree_le_boundary have hx' : s < x ∧ x < 11/25 := by simpa using hx have hx0 : 0 < x := lt_of_le_of_lt (hq0.trans hqs) hx'.1 have hx1 : x < 1 := hx'.2.trans (by norm_num) - exact (hasDerivAt_anariRezaeiPhiThree_right hq1 hx0 hx1 hq0).differentiableAt.differentiableWithinAt + exact (hasDerivAt_anariRezaeiPhiThree_right hq1 hx0 hx1 + hq0).differentiableAt.differentiableWithinAt have hmono : MonotoneOn (anariRezaeiPhiThree q) (Set.Icc s (11/25)) := monotoneOn_of_deriv_nonneg (convex_Icc s (11/25)) hcont hdiff fun x hx => by diff --git a/LeanPool/BeyondBethe/BeyondBethe/SourceAnariRezaeiMerge.lean b/LeanPool/BeyondBethe/BeyondBethe/SourceAnariRezaeiMerge.lean index 824901398a..a34217dad2 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/SourceAnariRezaeiMerge.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/SourceAnariRezaeiMerge.lean @@ -166,7 +166,8 @@ theorem anariRezaeiMergePsi_nonpos_ordered have hClt : C < 1 := hC.trans_lt (by norm_num) have hcont : ContinuousOn (anariRezaeiMergePsiAlong C) (Set.Icc 0 r) := by intro x hx - exact (hasDerivAt_anariRezaeiMergePsiAlong hx.1 (hx.2.trans hrC) hClt).continuousAt.continuousWithinAt + exact (hasDerivAt_anariRezaeiMergePsiAlong hx.1 (hx.2.trans hrC) + hClt).continuousAt.continuousWithinAt have hdiff : DifferentiableOn ℝ (anariRezaeiMergePsiAlong C) (interior (Set.Icc 0 r)) := by intro x hx @@ -373,7 +374,8 @@ theorem anariRezaeiMergeGap_le_stationary intro x hx have hx' : q < x ∧ x < anariRezaeiMergeQStar r s := by simpa using hx exact (hasDerivAt_anariRezaeiMergeGapAlong hr hs - (hq0.trans hx'.1.le) (by linarith [hcapStar, hx'.2.le])).differentiableAt.differentiableWithinAt + (hq0.trans hx'.1.le) + (by linarith [hcapStar, hx'.2.le])).differentiableAt.differentiableWithinAt have hmono := monotoneOn_of_deriv_nonneg (convex_Icc q (anariRezaeiMergeQStar r s)) hcont hdiff fun x hx ↦ by have hx' : q < x ∧ x < anariRezaeiMergeQStar r s := by simpa using hx @@ -392,7 +394,8 @@ theorem anariRezaeiMergeGap_le_stationary intro x hx have hx' : anariRezaeiMergeQStar r s < x ∧ x < q := by simpa using hx exact (hasDerivAt_anariRezaeiMergeGapAlong hr hs - (hqstar0.trans hx'.1.le) (by linarith [ht0, hx'.2.le])).differentiableAt.differentiableWithinAt + (hqstar0.trans hx'.1.le) + (by linarith [ht0, hx'.2.le])).differentiableAt.differentiableWithinAt have hanti := antitoneOn_of_deriv_nonpos (convex_Icc (anariRezaeiMergeQStar r s) q) hcont hdiff fun x hx ↦ by have hx' : anariRezaeiMergeQStar r s < x ∧ x < q := by simpa using hx diff --git a/LeanPool/BeyondBethe/BeyondBethe/SourceStableEncoding.lean b/LeanPool/BeyondBethe/BeyondBethe/SourceStableEncoding.lean index b1c6b734de..24158e38e0 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/SourceStableEncoding.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/SourceStableEncoding.lean @@ -326,13 +326,16 @@ theorem pairTableComplexEval_eq_boolDoubleSum : change pairTableComplexEval (n + 1) c y z = y 0 * z 0 * (∑ S, ∑ T, (pairTableSection c true true S T : ℂ) * - complexBoolMonomial (fun i ↦ y i.succ) S * complexBoolMonomial (fun i ↦ z i.succ) T) + + complexBoolMonomial (fun i ↦ y i.succ) S * + complexBoolMonomial (fun i ↦ z i.succ) T) + z 0 * (∑ S, ∑ T, (pairTableSection c false true S T : ℂ) * - complexBoolMonomial (fun i ↦ y i.succ) S * complexBoolMonomial (fun i ↦ z i.succ) T) + + complexBoolMonomial (fun i ↦ y i.succ) S * + complexBoolMonomial (fun i ↦ z i.succ) T) + (y 0 * (∑ S, ∑ T, (pairTableSection c true false S T : ℂ) * - complexBoolMonomial (fun i ↦ y i.succ) S * complexBoolMonomial (fun i ↦ z i.succ) T) + + complexBoolMonomial (fun i ↦ y i.succ) S * + complexBoolMonomial (fun i ↦ z i.succ) T) + (∑ S, ∑ T, (pairTableSection c false false S T : ℂ) * complexBoolMonomial (fun i ↦ y i.succ) S * complexBoolMonomial (fun i ↦ z i.succ) T)) rw [← ih (pairTableSection c true true) (fun i ↦ y i.succ) (fun i ↦ z i.succ), diff --git a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/IterateLayout.lean b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/IterateLayout.lean index 68e6015ae2..bedd7978c3 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/IterateLayout.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/IterateLayout.lean @@ -444,14 +444,17 @@ theorem iterFinish_hoareTime (M : TM k) (H : ℕ) have hW₀vin : W₀ vinIdx = parkedBlank := by rw [hW₀] dsimp only - rw [ite_eq_right (fun h => resIdx_ne_vinIdx h.symm), ite_eq_right (fun h => rfIdx_ne_appIdx _ h.symm), - ite_eq_right (fun h => junkIdx_ne_appIdx _ h.symm), ite_eq_right (fun h => wfIdx_ne_appIdx _ h.symm)] + rw [ite_eq_right (fun h => resIdx_ne_vinIdx h.symm), + ite_eq_right (fun h => rfIdx_ne_appIdx _ h.symm), + ite_eq_right (fun h => junkIdx_ne_appIdx _ h.symm), + ite_eq_right (fun h => wfIdx_ne_appIdx _ h.symm)] have hW₀app : ∀ j : Fin (k + 2), appIdx j ≠ resIdx → W₀ (appIdx j) = parkedBlank := by intro j hj rw [hW₀] dsimp only rw [ite_eq_right hj, ite_eq_right (fun h => rfIdx_ne_appIdx _ h.symm), - ite_eq_right (fun h => junkIdx_ne_appIdx _ h.symm), ite_eq_right (fun h => wfIdx_ne_appIdx _ h.symm)] + ite_eq_right (fun h => junkIdx_ne_appIdx _ h.symm), + ite_eq_right (fun h => wfIdx_ne_appIdx _ h.symm)] have hW₀rf : W₀ rfIdx = rfT := by rw [hW₀] dsimp only diff --git a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/SndBlock.lean b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/SndBlock.lean index 1bd441b083..e88d800f78 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/SndBlock.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Classes/P/Cobham/Internal/SndBlock.lean @@ -433,7 +433,8 @@ private theorem sndBlockTM_scan_loop : rfl, ?_⟩ rw [show c1.output.writeAndMove (readBackWrite c1.output.read) (idleDir c1.output.read) = c1.output from by - rw [writeAndMove_readBack c1.output houtne1, idleDir, ite_eq_right houtne1, Tape.move]] + rw [writeAndMove_readBack c1.output houtne1, idleDir, + ite_eq_right houtne1, Tape.move]] have : sndBlock (true :: false :: rest) = [] := by simp [sndBlock, unpair?] rw [this]; simpa using! hpre1.hasOutput diff --git a/LeanPool/BeyondBethe/Complexitylib/Classes/P/FinsetDomain/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Classes/P/FinsetDomain/Internal.lean index 8a38ae5376..98446552f5 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Classes/P/FinsetDomain/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Classes/P/FinsetDomain/Internal.lean @@ -251,7 +251,8 @@ private theorem lookup_read_bit_step (p : List Bool) (b : Bool) · have hp' : p ++ [b] ∉ S.prefixes := fun h => hp (Finset.mem_prefixes_of_prefix (List.prefix_append p [b]) h) cases b <;> - simp [TM.step, lookupTM, hstate, hread, readState, haltState, dite_eq_right hp, dite_eq_right hp', + simp [TM.step, lookupTM, hstate, hread, readState, haltState, dite_eq_right hp, + dite_eq_right hp', Γ.ofBool] /-- Writing back the (blank) symbol under an idle output head keeps the output diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine.lean index 943486966e..6d72b3dd6d 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine.lean @@ -16,8 +16,7 @@ public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simu public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.Containment public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.DenseOverlay -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.DenseInputLookup +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.DenseInputLookup public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Containment public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.AddressEq public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryAppend @@ -25,32 +24,22 @@ public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simu public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryEncode public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryCleanup public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryLookup -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryLookupRestore -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryMissCopy +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryLookupRestore +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryMissCopy public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryMatch public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryReplace -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryScanStep +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryScanStep public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryScan public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Dense +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Dense public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Dispatch +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Dispatch public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Initialization -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.DenseInit -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.DenseDecision -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.DenseBounds -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Decision +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Initialization +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.DenseInit +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.DenseDecision +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.DenseBounds +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Decision public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.WordDecode public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.WordEncode public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Containment/Defs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Containment/Defs.lean index 790cf18b75..f018eb9130 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Containment/Defs.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Containment/Defs.lean @@ -5,10 +5,8 @@ Authors: Samuel Schlesinger -/ module -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Bounds.Defs -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Bounds.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Defs public import Mathlib.Analysis.SpecialFunctions.Pow.NNReal public import Mathlib.Tactic.Measurability.Init public import Mathlib.Tactic.NormNum.BigOperators diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Containment/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Containment/Internal.lean index fdf4b9d43e..2c373b1a80 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Containment/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Containment/Internal.lean @@ -8,12 +8,9 @@ module public import LeanPool.BeyondBethe.Complexitylib.Classes.P.NormalForm public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Classes public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Containment.Defs -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.DenseBounds -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.DenseDecision -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Decision +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.DenseBounds +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.DenseDecision +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Decision public import Mathlib.Tactic.ENatToNat public import Mathlib.Tactic.ReduceModChar public import Mathlib.Tactic.SetNotationForOrder diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/DenseOverlay.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/DenseOverlay.lean index 83eadb0654..00a17c9af5 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/DenseOverlay.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/DenseOverlay.lean @@ -5,8 +5,7 @@ Authors: Samuel Schlesinger -/ module -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.DenseOverlay.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.DenseOverlay.Internal /-! # Dense public input with a sparse mutable overlay diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/AddressEq.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/AddressEq.lean index c2feb76c96..8bc26260c7 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/AddressEq.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/AddressEq.lean @@ -5,8 +5,7 @@ Authors: Samuel Schlesinger -/ module -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.AddressEq.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.AddressEq.Internal public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.ClearWork /-! diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/AddressEq/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/AddressEq/Internal.lean index c243630d08..1dbf721f2b 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/AddressEq/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/AddressEq/Internal.lean @@ -5,8 +5,7 @@ Authors: Samuel Schlesinger -/ module -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.AddressEq.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.AddressEq.Defs public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.WordDecode public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryEq diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/DenseInputLookup.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/DenseInputLookup.lean index 3d1d34901f..5c0e72ee4f 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/DenseInputLookup.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/DenseInputLookup.lean @@ -5,8 +5,7 @@ Authors: Samuel Schlesinger -/ module -public import -LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.DenseInputLookup.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.DenseInputLookup.Internal /-! # Dense public-input lookup diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/DenseInputLookup/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/DenseInputLookup/Internal.lean index 485791c5c7..659640581c 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/DenseInputLookup/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/DenseInputLookup/Internal.lean @@ -5,8 +5,7 @@ Authors: Samuel Schlesinger -/ module -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.DenseInputLookup.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.DenseInputLookup.Defs public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.WorkBranch public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.ForInput.Internal public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryCopy diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryAppend.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryAppend.lean index d050620d68..8ed2442bee 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryAppend.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryAppend.lean @@ -5,10 +5,8 @@ Authors: Samuel Schlesinger -/ module -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryAppend.Defs -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryAppend.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryAppend.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryAppend.Internal /-! # Sparse-entry final append diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryAppend/Defs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryAppend/Defs.lean index a92d3c293f..89e3db8a07 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryAppend/Defs.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryAppend/Defs.lean @@ -5,8 +5,7 @@ Authors: Samuel Schlesinger -/ module -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryReplace.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryReplace.Defs /-! # Sparse-entry final append — definitions diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryAppend/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryAppend/Internal.lean index 6d317a040d..f24730fe45 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryAppend/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryAppend/Internal.lean @@ -5,8 +5,7 @@ Authors: Samuel Schlesinger -/ module -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryAppend.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryAppend.Defs public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryEncode public import Mathlib.Data.Rat.Cast.Order public import Mathlib.Tactic.NormNum.Abs diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryCleanup.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryCleanup.lean index ca0ce1909e..5129401483 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryCleanup.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryCleanup.lean @@ -5,10 +5,8 @@ Authors: Samuel Schlesinger -/ module -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryCleanup.Defs -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryCleanup.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryCleanup.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryCleanup.Internal /-! # Sparse-entry miss cleanup diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryCleanup/Defs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryCleanup/Defs.lean index 3463949d1e..d6e956cb23 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryCleanup/Defs.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryCleanup/Defs.lean @@ -5,8 +5,7 @@ Authors: Samuel Schlesinger -/ module -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryMatch.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryMatch.Defs public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.ResetBinaryMany.Defs /-! diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryCleanup/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryCleanup/Internal.lean index f5d4daf952..e36804219e 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryCleanup/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryCleanup/Internal.lean @@ -5,8 +5,7 @@ Authors: Samuel Schlesinger -/ module -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryCleanup.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryCleanup.Defs public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.ResetBinaryMany public import Mathlib.Tactic.FinCases public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinarySucc diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryDecode.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryDecode.lean index 3c0c5f76d4..27cdd63d91 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryDecode.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryDecode.lean @@ -5,12 +5,9 @@ Authors: Samuel Schlesinger -/ module -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryDecode.Defs -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryDecode.Internal -public import -LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryDecode.LinearInternal +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryDecode.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryDecode.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryDecode.LinearInternal /-! # RAM sparse-entry decoder diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryDecode/Defs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryDecode/Defs.lean index fa977d94de..3bc1567e58 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryDecode/Defs.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryDecode/Defs.lean @@ -5,8 +5,7 @@ Authors: Samuel Schlesinger -/ module -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.WordDecode.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.WordDecode.Defs public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Defs public import Mathlib.Tactic.NormNum.Inv public import Mathlib.Tactic.NormNum.Pow diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryDecode/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryDecode/Internal.lean index 4b19dd80c6..ff4207023c 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryDecode/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryDecode/Internal.lean @@ -5,8 +5,7 @@ Authors: Samuel Schlesinger -/ module -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryDecode.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryDecode.Defs public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.WordDecode /-! diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryDecode/LinearInternal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryDecode/LinearInternal.lean index 045ce4dfbd..47c3ba8221 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryDecode/LinearInternal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryDecode/LinearInternal.lean @@ -5,8 +5,7 @@ Authors: Samuel Schlesinger -/ module -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryDecode.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryDecode.Defs public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.WordDecode /-! diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryEncode.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryEncode.lean index f63dd7f472..f3410eb902 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryEncode.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryEncode.lean @@ -5,10 +5,8 @@ Authors: Samuel Schlesinger -/ module -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryEncode.Defs -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryEncode.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryEncode.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryEncode.Internal public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Hoare.RetargetOutput /-! diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryEncode/Defs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryEncode/Defs.lean index 46722fcd12..60670afeeb 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryEncode/Defs.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryEncode/Defs.lean @@ -5,8 +5,7 @@ Authors: Samuel Schlesinger -/ module -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.WordEncode.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.WordEncode.Defs public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Defs /-! diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryEncode/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryEncode/Internal.lean index 5e7db45975..b87a41a801 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryEncode/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryEncode/Internal.lean @@ -5,8 +5,7 @@ Authors: Samuel Schlesinger -/ module -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryEncode.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryEncode.Defs public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.WordEncode /-! diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryLookup.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryLookup.lean index f2171fb673..21f3693944 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryLookup.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryLookup.lean @@ -5,12 +5,9 @@ Authors: Samuel Schlesinger -/ module -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryLookup.Defs -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryLookup.Internal -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Source +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryLookup.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryLookup.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Source /-! # Sparse register lookup diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryLookup/Defs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryLookup/Defs.lean index d8e5b2ca9f..48c2290bbe 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryLookup/Defs.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryLookup/Defs.lean @@ -5,8 +5,7 @@ Authors: Samuel Schlesinger -/ module -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryScan.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryScan.Defs /-! # Sparse register lookup — definitions diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryLookup/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryLookup/Internal.lean index 0dda676a9c..bc8b50a3a4 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryLookup/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryLookup/Internal.lean @@ -5,8 +5,7 @@ Authors: Samuel Schlesinger -/ module -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryLookup.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryLookup.Defs public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryScan public import Mathlib.Data.Nat.Bitwise diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryLookupRestore.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryLookupRestore.lean index a49e7c6b49..115405e43c 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryLookupRestore.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryLookupRestore.lean @@ -5,8 +5,7 @@ Authors: Samuel Schlesinger -/ module -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.DenseInternal +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.DenseInternal /-! # Reusable sparse-register operand lookup diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryMatch.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryMatch.lean index c227e53dbb..9a29ab0a7e 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryMatch.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryMatch.lean @@ -5,10 +5,8 @@ Authors: Samuel Schlesinger -/ module -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryMatch.Defs -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryMatch.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryMatch.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryMatch.Internal /-! # RAM sparse-entry matching diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryMatch/Defs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryMatch/Defs.lean index 759d3979aa..112e14e795 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryMatch/Defs.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryMatch/Defs.lean @@ -5,10 +5,8 @@ Authors: Samuel Schlesinger -/ module -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.AddressEq.Defs -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryDecode.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.AddressEq.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryDecode.Defs public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Registers public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Defs diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryMatch/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryMatch/Internal.lean index 347db56d2a..3d88a699dd 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryMatch/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryMatch/Internal.lean @@ -7,8 +7,7 @@ Authors: Samuel Schlesinger module public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.AddressEq public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryDecode -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryMatch.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryMatch.Defs /-! # RAM sparse-entry matching — proof internals diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryMissCopy.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryMissCopy.lean index 1c093df071..199f3ab1c3 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryMissCopy.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryMissCopy.lean @@ -5,10 +5,8 @@ Authors: Samuel Schlesinger -/ module -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryMissCopy.Defs -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryMissCopy.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryMissCopy.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryMissCopy.Internal /-! # Sparse-entry miss copy diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryMissCopy/Defs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryMissCopy/Defs.lean index 60a3d5d2e1..3386d9077b 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryMissCopy/Defs.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryMissCopy/Defs.lean @@ -5,10 +5,8 @@ Authors: Samuel Schlesinger -/ module -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryCleanup.Defs -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryEncode.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryCleanup.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryEncode.Defs /-! # Sparse-entry miss copy — definitions diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryMissCopy/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryMissCopy/Internal.lean index ca6bd430d6..faa184a4a3 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryMissCopy/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryMissCopy/Internal.lean @@ -5,8 +5,7 @@ Authors: Samuel Schlesinger -/ module -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryMissCopy.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryMissCopy.Defs public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryCleanup public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryEncode diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryReplace.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryReplace.lean index 92ab772c24..8dd9dfba5e 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryReplace.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryReplace.lean @@ -5,10 +5,8 @@ Authors: Samuel Schlesinger -/ module -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryReplace.Defs -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryReplace.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryReplace.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryReplace.Internal /-! # Sparse-entry replacement diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryReplace/Defs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryReplace/Defs.lean index 02069d3366..5ca1547bb1 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryReplace/Defs.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryReplace/Defs.lean @@ -5,10 +5,8 @@ Authors: Samuel Schlesinger -/ module -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryCleanup.Defs -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryEncode.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryCleanup.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryEncode.Defs /-! # Sparse-entry replacement — definitions diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryReplace/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryReplace/Internal.lean index 4b0b86035c..c1f5da27f2 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryReplace/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryReplace/Internal.lean @@ -5,8 +5,7 @@ Authors: Samuel Schlesinger -/ module -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryReplace.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryReplace.Defs public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryCleanup public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryEncode diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryScan.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryScan.lean index 09b38c071b..e5dae4c8e7 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryScan.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryScan.lean @@ -5,12 +5,9 @@ Authors: Samuel Schlesinger -/ module -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryScan.Defs -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryScan.Internal.Sem -public import -LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryScan.Internal.Bounds +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryScan.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryScan.Internal.Sem +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryScan.Internal.Bounds /-! # Bounded sparse-entry scan diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryScan/Defs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryScan/Defs.lean index b59c14c242..90d9210ddd 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryScan/Defs.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryScan/Defs.lean @@ -5,8 +5,7 @@ Authors: Samuel Schlesinger -/ module -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryScanStep.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryScanStep.Defs public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryPred.Defs /-! diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryScan/Internal/Bounds.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryScan/Internal/Bounds.lean index 45fae7a9bb..66beba536e 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryScan/Internal/Bounds.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryScan/Internal/Bounds.lean @@ -7,8 +7,7 @@ Authors: Samuel Schlesinger module public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryMatch.Internal -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryScan.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryScan.Defs public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryPred public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.ResetBinaryMany diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryScan/Internal/Ctrl.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryScan/Internal/Ctrl.lean index 8dc634a35a..29faf867cb 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryScan/Internal/Ctrl.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryScan/Internal/Ctrl.lean @@ -5,8 +5,7 @@ Authors: Samuel Schlesinger -/ module -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryScan.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryScan.Defs /-! # Bounded sparse-entry scan — controller internals diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryScan/Internal/Inv.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryScan/Internal/Inv.lean index 01843d297b..9646ffc320 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryScan/Internal/Inv.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryScan/Internal/Inv.lean @@ -5,8 +5,7 @@ Authors: Samuel Schlesinger -/ module -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryScan.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryScan.Defs public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.ResetBinaryMany public import Mathlib.Tactic.FinCases public import Mathlib.Data.Rat.Cast.Order diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryScan/Internal/Sem.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryScan/Internal/Sem.lean index cd4abc51f6..8e3f81ac19 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryScan/Internal/Sem.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryScan/Internal/Sem.lean @@ -5,14 +5,11 @@ Authors: Samuel Schlesinger -/ module -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryScan.Internal.Ctrl -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryScan.Internal.Inv +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryScan.Internal.Ctrl +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryScan.Internal.Inv public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.WorkBranch public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryPred -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryScanStep +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryScanStep /-! # Bounded sparse-entry scan — semantic internals diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryScanStep.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryScanStep.lean index b27549d668..a6cfa6a848 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryScanStep.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryScanStep.lean @@ -5,10 +5,8 @@ Authors: Samuel Schlesinger -/ module -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryScanStep.Defs -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryScanStep.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryScanStep.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryScanStep.Internal /-! # One bounded sparse-entry scan iteration diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryScanStep/Defs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryScanStep/Defs.lean index 03d7f5fc51..27863760cb 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryScanStep/Defs.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryScanStep/Defs.lean @@ -5,8 +5,7 @@ Authors: Samuel Schlesinger -/ module -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryCleanup.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryCleanup.Defs public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.WorkSymbolBranch.Defs /-! diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryScanStep/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryScanStep/Internal.lean index 4424c2bca7..ca30b41bb7 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryScanStep/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryScanStep/Internal.lean @@ -6,8 +6,7 @@ Authors: Samuel Schlesinger module public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryCleanup -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryScanStep.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryScanStep.Defs public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.WorkSymbolBranch public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryMatch diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate.lean index 1ca0dbfb30..429b68faca 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate.lean @@ -5,16 +5,11 @@ Authors: Samuel Schlesinger -/ module -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Defs -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Out -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Sem -public import -LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.BoundsInternal -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Source +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Out +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Sem +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.BoundsInternal +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Source /-! # Bounded encoded sparse-store update diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/BoundsInternal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/BoundsInternal.lean index fbc9887a77..7d20a7ad3d 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/BoundsInternal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/BoundsInternal.lean @@ -6,10 +6,8 @@ Authors: Samuel Schlesinger module public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryMatch.Internal -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryMatch.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Defs public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryPred public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.ResetBinaryMany diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Defs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Defs.lean index 249bb1e6bc..84f32e4ff3 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Defs.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Defs.lean @@ -5,10 +5,8 @@ Authors: Samuel Schlesinger -/ module -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryAppend.Defs -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryMissCopy.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryAppend.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryMissCopy.Defs public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryPred.Defs public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Types diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Ctrl.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Ctrl.lean index 982a00d50a..3c5b38cccc 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Ctrl.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Ctrl.lean @@ -5,8 +5,7 @@ Authors: Samuel Schlesinger -/ module -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Defs /-! # Bounded encoded sparse-store update — controller internals diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/End.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/End.lean index be792665f3..469dd2aa66 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/End.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/End.lean @@ -5,12 +5,9 @@ Authors: Samuel Schlesinger -/ module -public import -LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Loop -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Out -public import -LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Time +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Loop +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Out +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Time public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.WorkBranch /-! diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Hit.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Hit.lean index 7e4993b5f3..ae1d20f46c 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Hit.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Hit.lean @@ -5,12 +5,9 @@ Authors: Samuel Schlesinger -/ module -public import -LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Loop -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Out -public import -LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Time +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Loop +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Out +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Time public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.WorkBranch /-! diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Inv.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Inv.lean index 12d2c0d03a..15bd9e47da 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Inv.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Inv.lean @@ -5,10 +5,8 @@ Authors: Samuel Schlesinger -/ module -public import -LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Ctrl -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryScan.Internal.Inv +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Ctrl +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryScan.Internal.Inv public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinarySucc /-! diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Loop.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Loop.lean index 0eaea0c34d..5136e6bf8e 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Loop.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Loop.lean @@ -5,10 +5,8 @@ Authors: Samuel Schlesinger -/ module -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Progress -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Inv +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Progress +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Inv /-! # Bounded encoded sparse-store update — loop invariant internals diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Miss.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Miss.lean index 9707b19b20..c980b73785 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Miss.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Miss.lean @@ -5,12 +5,9 @@ Authors: Samuel Schlesinger -/ module -public import -LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Loop -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Out -public import -LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Time +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Loop +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Out +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Time public import Mathlib.Data.Nat.Bitwise public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.WorkBranch diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Out.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Out.lean index 3450fa60eb..7efa05990b 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Out.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Out.lean @@ -5,11 +5,9 @@ Authors: Samuel Schlesinger -/ module -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Defs public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryAppend -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryMissCopy +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryMissCopy public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryReplace public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryPred public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryMatch diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Sem.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Sem.lean index be485c3797..6bd2fa464b 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Sem.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Sem.lean @@ -5,10 +5,8 @@ Authors: Samuel Schlesinger -/ module -public import -LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Step -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.End +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Step +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.End /-! # Bounded encoded sparse-store update -- semantic composition diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Step.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Step.lean index 3847feaa11..769931812e 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Step.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Step.lean @@ -5,10 +5,8 @@ Authors: Samuel Schlesinger -/ module -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Hit -public import -LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Miss +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Hit +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Miss /-! # Bounded encoded sparse-store update -- one positive iteration diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Time.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Time.lean index 3e2b198571..5c84ebdeda 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Time.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Time.lean @@ -5,8 +5,7 @@ Authors: Samuel Schlesinger -/ module -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Defs public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryPred public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinarySucc public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.ResetBinaryMany diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Source.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Source.lean index 7a537dec9d..44bb554137 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Source.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Source.lean @@ -5,10 +5,8 @@ Authors: Samuel Schlesinger -/ module -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Defs -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryScan.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryScan.Defs public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.WorkReadOnly public import Std.Tactic.BVDecide.Normalize.BitVec diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Tagged.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Tagged.lean index 37b749b96c..91360d8e1b 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Tagged.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Tagged.lean @@ -5,8 +5,7 @@ Authors: Samuel Schlesinger -/ module -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.TaggedProof +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.TaggedProof /-! # Positive-tag sparse updates diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/TaggedDefs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/TaggedDefs.lean index a1a6403d2b..a704db6aba 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/TaggedDefs.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/TaggedDefs.lean @@ -5,8 +5,7 @@ Authors: Samuel Schlesinger -/ module -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Defs /-! # Positive-tag sparse updates diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/TaggedProof.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/TaggedProof.lean index 2bd64e2b7f..32feece911 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/TaggedProof.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/TaggedProof.lean @@ -5,8 +5,7 @@ Authors: Samuel Schlesinger -/ module -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.TaggedDefs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.TaggedDefs public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.DenseOverlay.Defs diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Types.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Types.lean index b001a2693e..4a7f5c3f4b 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Types.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Types.lean @@ -5,10 +5,8 @@ Authors: Samuel Schlesinger -/ module -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryAppend.Defs -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryMissCopy.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryAppend.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryMissCopy.Defs public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryPred.Defs /-! diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction.lean index 03fdffdeaa..864ea0361c 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction.lean @@ -5,20 +5,13 @@ Authors: Samuel Schlesinger -/ module -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Defs -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Internal -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Direct -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Load -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Immediate -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Store -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Control +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Direct +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Load +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Immediate +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Store +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Control /-! # Concrete sparse-store arithmetic instruction kernel diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Control.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Control.lean index ca098ccd17..5cec84c1de 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Control.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Control.lean @@ -5,10 +5,8 @@ Authors: Samuel Schlesinger -/ module -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Defs -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryLookupRestore +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryLookupRestore /-! # Sparse-store control instructions diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Defs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Defs.lean index a3beae1e5a..990c418e04 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Defs.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Defs.lean @@ -5,8 +5,7 @@ Authors: Samuel Schlesinger -/ module -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Defs public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Defs public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleSub.Defs public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryShiftMul.Defs diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseControl.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseControl.lean index 832613d184..e9a5b715c5 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseControl.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseControl.lean @@ -5,10 +5,8 @@ Authors: Samuel Schlesinger -/ module -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.DenseDefs -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Control +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.DenseDefs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Control /-! # Dense-overlay control instructions diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseCtrlSim.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseCtrlSim.lean index 50208db266..5f3add3637 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseCtrlSim.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseCtrlSim.lean @@ -5,12 +5,9 @@ Authors: Samuel Schlesinger -/ module -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.DenseControl -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.DenseSimDefs -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Sim.Control +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.DenseControl +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.DenseSimDefs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Sim.Control /-! # Dense-overlay control-instruction simulation diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseDefs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseDefs.lean index a3f1505e12..33da66557f 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseDefs.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseDefs.lean @@ -5,10 +5,8 @@ Authors: Samuel Schlesinger -/ module -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Defs -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.TaggedDefs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.TaggedDefs /-! # Dense-overlay RAM instruction kernels -- definitions diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseDirect.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseDirect.lean index d8149e3db5..211f4e9a04 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseDirect.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseDirect.lean @@ -5,14 +5,10 @@ Authors: Samuel Schlesinger -/ module -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.DenseDefs -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Direct -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Tagged -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.DenseInternal +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.DenseDefs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Direct +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Tagged +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.DenseInternal /-! # Dense-overlay direct arithmetic instructions diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseDispatch.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseDispatch.lean index 98fc2f2a95..4bcee5251e 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseDispatch.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseDispatch.lean @@ -5,11 +5,9 @@ Authors: Samuel Schlesinger -/ module -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.DenseSim +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.DenseSim public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.DenseOverlay -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Sim.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Sim.Internal /-! # Fixed-program dense-overlay dispatch diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseImm.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseImm.lean index b39c70c917..bf6c504ba9 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseImm.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseImm.lean @@ -5,12 +5,9 @@ Authors: Samuel Schlesinger -/ module -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.DenseDefs -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Immediate -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Tagged +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.DenseDefs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Immediate +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Tagged /-! # Dense-overlay immediate instruction diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseLoad.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseLoad.lean index af166596b9..f89f98506f 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseLoad.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseLoad.lean @@ -5,14 +5,10 @@ Authors: Samuel Schlesinger -/ module -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.DenseDefs -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Load -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Tagged -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.DenseInternal +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.DenseDefs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Load +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Tagged +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.DenseInternal /-! # Dense-overlay indirect load diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseSim.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseSim.lean index 560788d744..07e7751806 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseSim.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseSim.lean @@ -5,10 +5,8 @@ Authors: Samuel Schlesinger -/ module -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.DenseCtrlSim -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.DenseSimData +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.DenseCtrlSim +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.DenseSimData /-! # Dense-overlay instruction simulation diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseSimData.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseSimData.lean index 8f82701c50..cf573f8354 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseSimData.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseSimData.lean @@ -5,16 +5,11 @@ Authors: Samuel Schlesinger -/ module -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.DenseSimDefs -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Sim.Data -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.DenseImm -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.DenseLoad -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.DenseStore +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.DenseSimDefs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Sim.Data +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.DenseImm +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.DenseLoad +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.DenseStore /-! # Dense-overlay data-instruction simulation diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseSimDefs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseSimDefs.lean index 022e3d8bad..03a811fc4e 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseSimDefs.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseSimDefs.lean @@ -5,10 +5,8 @@ Authors: Samuel Schlesinger -/ module -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.DenseDefs -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Sim.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.DenseDefs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Sim.Defs /-! # Dense-overlay instruction simulation -- controller definitions diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseStore.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseStore.lean index 770a6fca47..8730a6b923 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseStore.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseStore.lean @@ -5,8 +5,7 @@ Authors: Samuel Schlesinger -/ module -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.DenseDirect +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.DenseDirect /-! # Dense-overlay indirect store diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Direct.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Direct.lean index 674a29c533..acba0bdbf2 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Direct.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Direct.lean @@ -5,10 +5,8 @@ Authors: Samuel Schlesinger -/ module -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Internal -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Internal.Static +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Internal.Static /-! # Direct sparse-store arithmetic instructions -- proof internals diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Dispatch.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Dispatch.lean index efe3838a6e..f651b345b5 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Dispatch.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Dispatch.lean @@ -5,14 +5,10 @@ Authors: Samuel Schlesinger -/ module -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Sim.Defs -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Sim.Control -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Sim.Data -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Sim.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Sim.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Sim.Control +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Sim.Data +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Sim.Internal /-! # Fixed-program sparse RAM dispatch diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Immediate.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Immediate.lean index 158147f517..1b07ed1ec7 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Immediate.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Immediate.lean @@ -7,8 +7,7 @@ Authors: Samuel Schlesinger module public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryAddConst public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Defs /-! # Immediate sparse-store instructions -- proof internals diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Internal.lean index a2c1bc2347..ca67f1a452 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Internal.lean @@ -5,8 +5,7 @@ Authors: Samuel Schlesinger -/ module -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Defs public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleSub public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryShiftMul diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Load.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Load.lean index 61e939307a..836413ccb5 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Load.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Load.lean @@ -6,10 +6,8 @@ Authors: Samuel Schlesinger module public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Defs -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Internal.Static +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Internal.Static /-! # Indirect sparse-store load instructions -- proof internals diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Sim/Control.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Sim/Control.lean index 4e5b649f37..c31fe7147f 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Sim/Control.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Sim/Control.lean @@ -5,8 +5,7 @@ Authors: Samuel Schlesinger -/ module -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Sim.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Sim.Defs public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.CopyWorkOutput diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Sim/Data.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Sim/Data.lean index f390101a7c..c06e2d065e 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Sim/Data.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Sim/Data.lean @@ -5,8 +5,7 @@ Authors: Samuel Schlesinger -/ module -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Sim.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Sim.Defs public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction /-! diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Sim/Defs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Sim/Defs.lean index 96c46952d8..4adfdf0d34 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Sim/Defs.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Sim/Defs.lean @@ -5,8 +5,7 @@ Authors: Samuel Schlesinger -/ module -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Defs public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Lift /-! diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Sim/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Sim/Internal.lean index 00a3a66980..5eff3f8592 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Sim/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Sim/Internal.lean @@ -5,8 +5,7 @@ Authors: Samuel Schlesinger -/ module -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Sim.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Sim.Defs public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.WorkBranch public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryCopy diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Store.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Store.lean index cd5f27e5c6..92b82c445e 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Store.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Store.lean @@ -5,8 +5,7 @@ Authors: Samuel Schlesinger -/ module -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Direct +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Direct /-! # Indirect sparse-store instructions -- proof internals diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Tapes.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Tapes.lean index d5f31abeb3..874f1064f1 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Tapes.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Tapes.lean @@ -5,8 +5,7 @@ Authors: Samuel Schlesinger -/ module -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Defs public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Defs public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryRippleSub.Defs public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryShiftMul.Defs diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/Defs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/Defs.lean index 6bcd2fe6ea..5384458913 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/Defs.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/Defs.lean @@ -5,10 +5,8 @@ Authors: Samuel Schlesinger -/ module -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryLookup.Defs -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.DenseInputLookup.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryLookup.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.DenseInputLookup.Defs public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.DenseOverlay.Defs public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryAddConst.Defs public import Mathlib.Tactic.FinCases diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/DenseInternal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/DenseInternal.lean index 16bc413d8a..0d666693dc 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/DenseInternal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/DenseInternal.lean @@ -5,10 +5,8 @@ Authors: Samuel Schlesinger -/ module -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Internal.Static -public import -LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.DenseInputLookup.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Internal.Static +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.DenseInputLookup.Internal /-! # Dense overlay lookup -- proof internals diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/Internal/Assemble.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/Internal/Assemble.lean index 679eac6e05..c0935f9346 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/Internal/Assemble.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/Internal/Assemble.lean @@ -5,14 +5,10 @@ Authors: Samuel Schlesinger -/ module -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Internal.Prepare -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Internal.Restore -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Internal.Scan -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Internal.Value +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Internal.Prepare +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Internal.Restore +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Internal.Scan +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Internal.Value /-! # Reusable sparse-register lookup -- phase assembly diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/Internal/Reset.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/Internal/Reset.lean index ca7d8ebf22..17874e7bda 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/Internal/Reset.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/Internal/Reset.lean @@ -5,8 +5,7 @@ Authors: Samuel Schlesinger -/ module -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Internal.Bounds +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Internal.Bounds public import Mathlib.Data.Rat.Cast.Order public import Mathlib.Tactic.NormNum.Abs public import Mathlib.Tactic.NormNum.DivMod diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/Internal/Scan.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/Internal/Scan.lean index 9421390b43..2c7f2bee89 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/Internal/Scan.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/Internal/Scan.lean @@ -6,8 +6,7 @@ Authors: Samuel Schlesinger module public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryLookup -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Internal.Reset +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Internal.Reset /-! # Reusable sparse-register lookup -- bounded scan phase diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/Internal/Static.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/Internal/Static.lean index 4f89294d8b..712544c2ce 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/Internal/Static.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/Internal/Static.lean @@ -5,8 +5,7 @@ Authors: Samuel Schlesinger -/ module -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Internal.Assemble +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Internal.Assemble public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryAddConst /-! diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/ResetLayout.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/ResetLayout.lean index fee8758cb4..a8f81504d4 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/ResetLayout.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/ResetLayout.lean @@ -5,10 +5,8 @@ Authors: Samuel Schlesinger -/ module -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryLookup.Defs -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.DenseInputLookup.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryLookup.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.DenseInputLookup.Defs public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.DenseOverlay.Defs public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryAddConst.Defs public import Mathlib.Tactic.FinCases diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program.lean index 4f1c063858..d42e1a40ea 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program.lean @@ -6,8 +6,7 @@ Authors: Samuel Schlesinger module public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Defs -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Internal /-! # Sparse RAM program controller diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Bounds.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Bounds.lean index 779a5c7195..aad51474d4 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Bounds.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Bounds.lean @@ -5,10 +5,8 @@ Authors: Samuel Schlesinger -/ module -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Bounds.Defs -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Bounds.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Bounds.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Bounds.Internal /-! # Sparse RAM decision-machine resource bounds diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Bounds/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Bounds/Internal.lean index a10012adb7..0a19b2371b 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Bounds/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Bounds/Internal.lean @@ -5,14 +5,10 @@ Authors: Samuel Schlesinger -/ module -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Bounds.Defs -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Decision.Defs -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Init.Internal -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Bounds.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Decision.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Init.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Internal /-! # Sparse RAM decision-machine resource-bound proof internals diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Decision.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Decision.lean index f2c90f3f63..267fb61e1e 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Decision.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Decision.lean @@ -5,10 +5,8 @@ Authors: Samuel Schlesinger -/ module -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Decision.Defs -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.DecisionInternal +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Decision.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.DecisionInternal /-! # Complete sparse RAM decision machine diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Decision/Defs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Decision/Defs.lean index 2b00000367..00f2cbc16b 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Decision/Defs.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Decision/Defs.lean @@ -5,8 +5,7 @@ Authors: Samuel Schlesinger -/ module -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Init.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Init.Defs /-! # Complete sparse RAM decision machine -- definitions diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DecisionInternal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DecisionInternal.lean index 8ea9ed0b02..eb294b98cd 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DecisionInternal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DecisionInternal.lean @@ -5,12 +5,9 @@ Authors: Samuel Schlesinger -/ module -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Decision.Defs -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Init.Internal -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Decision.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Init.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Internal /-! # Complete sparse RAM decision-machine proof internals diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Defs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Defs.lean index 0f50392d51..6f4501114f 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Defs.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Defs.lean @@ -5,8 +5,7 @@ Authors: Samuel Schlesinger -/ module -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Sim.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Sim.Defs /-! # Sparse RAM program controller -- definitions diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseBounds.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseBounds.lean index bdce6c4897..232b6f2a10 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseBounds.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseBounds.lean @@ -5,10 +5,8 @@ Authors: Samuel Schlesinger -/ module -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.DenseBoundsDefs -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.DenseBoundsProof +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.DenseBoundsDefs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.DenseBoundsProof /-! # Dense-overlay RAM decision-machine resource bounds diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseBoundsDefs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseBoundsDefs.lean index 3b68417237..08b0ff3c2b 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseBoundsDefs.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseBoundsDefs.lean @@ -5,8 +5,7 @@ Authors: Samuel Schlesinger -/ module -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Bounds.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Bounds.Defs public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.DenseOverlay.Defs public import Mathlib.Data.Rat.Cast.Order public import Mathlib.Tactic.NormNum.Abs diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseBoundsProof.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseBoundsProof.lean index ab4319abae..6ad6f93302 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseBoundsProof.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseBoundsProof.lean @@ -5,16 +5,12 @@ Authors: Samuel Schlesinger -/ module -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.DenseBoundsDefs -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Bounds -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.DenseInputLookup +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.DenseBoundsDefs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Bounds +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.DenseInputLookup public import Mathlib.Algebra.Order.BigOperators.Group.Finset public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.DenseOverlay -public import -LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.DenseDecisionDefs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.DenseDecisionDefs /-! # Dense-overlay RAM decision-machine resource-bound proof internals diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseDecision.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseDecision.lean index 1e55066dfd..900af587b0 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseDecision.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseDecision.lean @@ -5,10 +5,8 @@ Authors: Samuel Schlesinger -/ module -public import -LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.DenseDecisionDefs -public import -LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.DenseDecisionProof +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.DenseDecisionDefs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.DenseDecisionProof /-! # Complete dense-overlay RAM decision machine diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseDecisionDefs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseDecisionDefs.lean index 87dbcc30ed..4cc58adf15 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseDecisionDefs.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseDecisionDefs.lean @@ -5,10 +5,8 @@ Authors: Samuel Schlesinger -/ module -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.DenseDefs -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.DenseInitDefs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.DenseDefs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.DenseInitDefs /-! # Complete dense-overlay RAM decision machine -- definitions diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseDecisionProof.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseDecisionProof.lean index 64d9da978d..76b510c931 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseDecisionProof.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseDecisionProof.lean @@ -5,12 +5,9 @@ Authors: Samuel Schlesinger -/ module -public import -LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.DenseDecisionDefs -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.DenseInitProof -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.DenseInternal +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.DenseDecisionDefs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.DenseInitProof +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.DenseInternal /-! # Complete dense-overlay RAM decision-machine proof internals diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseDefs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseDefs.lean index 14297b119d..47bbf294ea 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseDefs.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseDefs.lean @@ -6,8 +6,7 @@ Authors: Samuel Schlesinger module public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Defs -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.DenseSimDefs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.DenseSimDefs public import Mathlib.Data.Rat.Cast.Order public import Mathlib.Tactic.NormNum.Abs public import Mathlib.Tactic.NormNum.DivMod diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseInit.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseInit.lean index 49064c3014..3343f95841 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseInit.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseInit.lean @@ -5,10 +5,8 @@ Authors: Samuel Schlesinger -/ module -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.DenseInitDefs -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.DenseInitProof +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.DenseInitDefs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.DenseInitProof /-! # Dense-overlay public-input initialization diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseInitDefs.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseInitDefs.lean index 0ffbc02100..0068d986cf 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseInitDefs.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseInitDefs.lean @@ -5,8 +5,7 @@ Authors: Samuel Schlesinger -/ module -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Init.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Init.Defs /-! # Dense-overlay public-input initialization -- definitions diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseInitProof.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseInitProof.lean index eeaf7f13c9..1445db8a51 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseInitProof.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseInitProof.lean @@ -5,13 +5,10 @@ Authors: Samuel Schlesinger -/ module -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.DenseInitDefs -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Init.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.DenseInitDefs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Init.Internal public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.DenseOverlay -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Internal /-! # Dense-overlay public-input initialization -- proofs diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseInternal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseInternal.lean index b39c27be4d..d6ddebc99e 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseInternal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseInternal.lean @@ -5,11 +5,9 @@ Authors: Samuel Schlesinger -/ module -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.DenseDefs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.DenseDefs public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program -public import -LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.DenseDispatch +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.DenseDispatch /-! # Dense-overlay RAM program controller -- proof internals diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Init/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Init/Internal.lean index 2ea6eceac1..b3e6a67c21 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Init/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Init/Internal.lean @@ -5,8 +5,7 @@ Authors: Samuel Schlesinger -/ module -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Init.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Init.Defs public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryEncode public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.WorkBranch public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryCopy @@ -965,7 +964,8 @@ theorem initialOneBitTM_hoareTime_internal · omega · change (initialOneBitTM tapes).halted finalCfg unfold initialOneBitTM - exact (TM.phase2Wrap_halted_iff (rewindEntryEncodeRestoreTM (initialBitEntryTapes tapes)).retargetOutput + exact (TM.phase2Wrap_halted_iff + (rewindEntryEncodeRestoreTM (initialBitEntryTapes tapes)).retargetOutput (TM.seqTM (TM.binarySuccTM tapes.lifted.data.update.remaining) (TM.binarySuccTM tapes.liftedLhs)) tailFinal).mpr htailHalt · refine ⟨?_, ?_, ?_⟩ diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Initialization.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Initialization.lean index f7232f2fa3..a28c1a39df 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Initialization.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Initialization.lean @@ -5,10 +5,8 @@ Authors: Samuel Schlesinger -/ module -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Init.Defs -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Init.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Init.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Init.Internal /-! # Sparse RAM public-input initialization diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Internal.lean index 00409e5ef3..285adb914f 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Internal.lean @@ -6,8 +6,7 @@ Authors: Samuel Schlesinger module public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Defs -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Dispatch +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Dispatch public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.Internal.Loop /-! diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/WordDecode.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/WordDecode.lean index ea9038e85a..eafafa27c0 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/WordDecode.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/WordDecode.lean @@ -5,12 +5,9 @@ Authors: Samuel Schlesinger -/ module -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.WordDecode.Defs -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.WordDecode.Internal -public import -LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.WordDecode.LinearInternal +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.WordDecode.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.WordDecode.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.WordDecode.LinearInternal public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Defs /-! diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/WordDecode/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/WordDecode/Internal.lean index de68685a22..62df264e7e 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/WordDecode/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/WordDecode/Internal.lean @@ -5,8 +5,7 @@ Authors: Samuel Schlesinger -/ module -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.WordDecode.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.WordDecode.Defs public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.ForWorkOnes.Internal public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinarySucc public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.Internal diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/WordDecode/LinearInternal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/WordDecode/LinearInternal.lean index 6b9e18b56f..16c71f4382 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/WordDecode/LinearInternal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/WordDecode/LinearInternal.lean @@ -5,8 +5,7 @@ Authors: Samuel Schlesinger -/ module -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.WordDecode.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.WordDecode.Defs public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Internal public import Std.Tactic.BVDecide.Normalize.BitVec diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/WordEncode.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/WordEncode.lean index 4b935bce24..85d374352c 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/WordEncode.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/WordEncode.lean @@ -5,10 +5,8 @@ Authors: Samuel Schlesinger -/ module -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.WordEncode.Defs -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.WordEncode.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.WordEncode.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.WordEncode.Internal /-! # Self-delimiting word emission diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/WordEncode/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/WordEncode/Internal.lean index 17345b8760..2809b626f2 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/WordEncode/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/WordEncode/Internal.lean @@ -5,8 +5,7 @@ Authors: Samuel Schlesinger -/ module -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.WordEncode.Defs +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.WordEncode.Defs public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.ResetBinary public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Defs public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinarySucc.Defs diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/ABI.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/ABI.lean index b2fdf254e6..8be9b01f00 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/ABI.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/ABI.lean @@ -6,8 +6,7 @@ Authors: Samuel Schlesinger module public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.ABI.Defs -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.ABI.Internal.Resources +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.ABI.Internal.Resources /-! # Public RAM ABI for the fixed sparse TM simulator diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/ABI/Internal/Decision.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/ABI/Internal/Decision.lean index f45d4ad4cd..86afa77322 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/ABI/Internal/Decision.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/ABI/Internal/Decision.lean @@ -5,8 +5,7 @@ Authors: Samuel Schlesinger -/ module -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.ABI.Internal.Marshal +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.ABI.Internal.Marshal public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.Step.Internal.Iteration public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/ABI/Internal/Marshal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/ABI/Internal/Marshal.lean index d539ae0a61..f81f6174f7 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/ABI/Internal/Marshal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/ABI/Internal/Marshal.lean @@ -7,8 +7,7 @@ Authors: Samuel Schlesinger module public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.ABI.Internal.Loop public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.Internal -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.ABI.Internal.Capture +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.ABI.Internal.Capture public import Mathlib.Algebra.Order.Sub.Basic /-! diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/ABI/Internal/Resources.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/ABI/Internal/Resources.lean index 520d7cc8c4..532ce1b7f8 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/ABI/Internal/Resources.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/ABI/Internal/Resources.lean @@ -5,10 +5,8 @@ Authors: Samuel Schlesinger -/ module -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.ABI.Internal.Decision -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.Step.Internal.Resources +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.ABI.Internal.Decision +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.Step.Internal.Resources /-! # Resource bounds for the public sparse-simulator ABI -- proof internals diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Containment.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Containment.lean index 3744e1c0d3..b454a85f5f 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Containment.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Containment.lean @@ -5,8 +5,7 @@ Authors: Samuel Schlesinger -/ module -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.Containment.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.Containment.Internal /-! # TM-to-RAM time-class containment diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Step/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Step/Internal.lean index eff98e7a7b..a3b8072d68 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Step/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Step/Internal.lean @@ -5,17 +5,12 @@ Authors: Samuel Schlesinger -/ module -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.Step.Internal.Layout +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.Step.Internal.Layout public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.Step.Internal.Load -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.Step.Internal.Action -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.Step.Internal.Dispatch -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.Step.Internal.Iteration -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.Step.Internal.Resources +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.Step.Internal.Action +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.Step.Internal.Dispatch +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.Step.Internal.Iteration +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.Step.Internal.Resources /-! # Fixed sparse TM-transition block -- proof internals diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Step/Internal/Action.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Step/Internal/Action.lean index e75d47b937..bc2769166c 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Step/Internal/Action.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Step/Internal/Action.lean @@ -6,8 +6,7 @@ Authors: Samuel Schlesinger module public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.Internal.Resources -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.Step.Internal.Layout +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.Step.Internal.Layout /-! # Selected sparse TM transition actions -- proof internals diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Step/Internal/Iteration.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Step/Internal/Iteration.lean index 2fd6e61ee2..6ba14990b0 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Step/Internal/Iteration.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Step/Internal/Iteration.lean @@ -5,8 +5,7 @@ Authors: Samuel Schlesinger -/ module -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.Step.Internal.Dispatch +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.Step.Internal.Dispatch /-! # Iterating the fixed sparse TM transition -- proof internals diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Step/Internal/Load.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Step/Internal/Load.lean index b46313836d..297db80ceb 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Step/Internal/Load.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Step/Internal/Load.lean @@ -5,8 +5,7 @@ Authors: Samuel Schlesinger -/ module -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.Step.Internal.Layout +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.Step.Internal.Layout /-! # Loading sparse TM states and head symbols -- proof internals diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Step/Internal/Resources.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Step/Internal/Resources.lean index cbb0bb6e68..fa05d938b8 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Step/Internal/Resources.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/Step/Internal/Resources.lean @@ -5,8 +5,7 @@ Authors: Samuel Schlesinger -/ module -public import - LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.Step.Internal.Iteration +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.TMConfig.Sparse.Step.Internal.Iteration public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.Internal.Resources /-! diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/Helpers.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/Helpers.lean index 0726f5226e..0e72e41fd6 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/Helpers.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/Helpers.lean @@ -49,7 +49,8 @@ theorem idleDir_right_of_start {head : Γ} (h : head = Γ.start) : idleDir head /-- If the head reads `▷`, then `moveLeftDir` moves right — the shape of the `δ_right_of_start` obligation for tapes being rewound. -/ -theorem moveLeftDir_right_of_start {head : Γ} (h : head = Γ.start) : moveLeftDir head = Dir3.right := +theorem moveLeftDir_right_of_start {head : Γ} + (h : head = Γ.start) : moveLeftDir head = Dir3.right := by subst h; rfl /-- Write back the same symbol read from a tape, preserving cell contents. diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryEq/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryEq/Internal.lean index 2bf8298e34..fafb1ef685 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryEq/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryEq/Internal.lean @@ -181,10 +181,12 @@ private theorem binaryEq_terminal_reachesIn {n : ℕ} · rw [hdecision] cases result with | false => - simpa [Γ.ofBool, transitionTape, Γw.toΓ, c', binaryEqResultCfg, binaryEqResultWork, Γw.ofBool] using + simpa [Γ.ofBool, transitionTape, Γw.toΓ, c', binaryEqResultCfg, + binaryEqResultWork, Γw.ofBool] using Tape.hasBinaryPrefix_write_bit false hresult | true => - simpa [Γ.ofBool, transitionTape, Γw.toΓ, c', binaryEqResultCfg, binaryEqResultWork, Γw.ofBool] using + simpa [Γ.ofBool, transitionTape, Γw.toΓ, c', binaryEqResultCfg, + binaryEqResultWork, Γw.ofBool] using Tape.hasBinaryPrefix_write_bit true hresult · change (Function.update work₀ resultIdx _ lhsIdx).cells = _ rw [Function.update_of_ne hdistinct.lhs_result] diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/Counter.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/Counter.lean index 7836e6a480..4af7db116b 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/Counter.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/Counter.lean @@ -670,7 +670,8 @@ private theorem inputLengthPlusOneCounterTM_start_step · have hcounter_read : (work counterIdx).read = Γ.start := by rw [hcounter] simp [Tape.read, Tape.init] - simpa [idleDir, Tape.read, Tape.init, counterPreserveWork, counterIdleDirs, hcounter, hcounter_read, + simpa [idleDir, Tape.read, Tape.init, counterPreserveWork, counterIdleDirs, + hcounter, hcounter_read, Tape.writeAndMove, Tape.write] using Tape.init_nil_move_right_hasUnaryPrefix_zero · simp [counterIdleDirs, hcounter, Tape.writeAndMove, Tape.move_cells, diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/Internal.lean index cef31b64e7..2c2e2058be 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/Internal.lean @@ -1954,7 +1954,8 @@ theorem copyWorkToWorkTM_hoareTime_frame_of_binaryString {n : ℕ} have hother_keep : ∀ i, i ≠ src → i ≠ dst → c1.work i = work i := by intro i hi_src hi_dst simpa [c1, hi_src, hi_dst, hw_c i hi_src hi_dst] using - copyWorkToWork_idleTape (work i) (hother_wf i hi_src hi_dst).1 (hother_wf i hi_src hi_dst).2 + copyWorkToWork_idleTape (work i) (hother_wf i hi_src hi_dst).1 + (hother_wf i hi_src hi_dst).2 have hsrc_keep : c1.work src = c.work src := by have hsrc_ne : (c.work src).read ≠ Γ.start := by rw [hsrc_read] diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/PairEmit/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/PairEmit/Internal.lean index ad25ab8feb..23ee1ce6c8 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/PairEmit/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/PairEmit/Internal.lean @@ -69,7 +69,8 @@ private theorem pairInputWorkTM_first_loop {n : ℕ} (firstIdx : Fin n) : have hotherKeep₁ (i) (hi : i ≠ firstIdx) : c₁.work i = c.work i := by simpa [c₁] using transitionTape_eq_self (hother i hi) have houtput₁ : c₁.output.HasBinaryPrefix (emitted ++ [false]) := by - simpa [Γ.ofBool, transitionTape, Γw.toΓ, c₁] using Tape.hasBinaryPrefix_write_bit false houtput + simpa [Γ.ofBool, transitionTape, Γw.toΓ, c₁] using + Tape.hasBinaryPrefix_write_bit false houtput let c₂ : Cfg n (pairInputWorkTM firstIdx).Q := { state := PairInputWorkPhase.second input := transitionInput c₁.input @@ -165,7 +166,8 @@ private theorem pairInputWorkTM_first_loop {n : ℕ} (firstIdx : Fin n) : exact hother i hi) houtput₂ refine ⟨c', ?_, hstate', ?_, hsource', ?_, ?_, ?_⟩ - · simpa [Nat.mul_add, Nat.add_assoc] using! TM.reachesIn.step hstep₁ (TM.reachesIn.step hstep₂ hreach) + · simpa [Nat.mul_add, Nat.add_assoc] using! + TM.reachesIn.step hstep₁ (TM.reachesIn.step hstep₂ hreach) · exact hinput'.trans hinputKeep₂ · rw [hsourceCells', hsourceMove, Tape.move_cells] · intro i hi From 279484634ac315be14929ac12344dee8db44b213 Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Fri, 25 Sep 2026 21:53:23 +0000 Subject: [PATCH 41/49] Regenerate BeyondBethe module import order --- LeanPool.lean | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/LeanPool.lean b/LeanPool.lean index 1ed5f3c2ae..11751dea12 100644 --- a/LeanPool.lean +++ b/LeanPool.lean @@ -679,7 +679,6 @@ public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simu public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.BoundsInternal public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Defs -public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Types public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.Ctrl public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Internal.End @@ -696,10 +695,10 @@ public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simu public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Tagged public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.TaggedDefs public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.TaggedProof +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.EntryUpdate.Types public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Control public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Defs -public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Tapes public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Dense public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.DenseControl public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.DenseCtrlSim @@ -723,9 +722,9 @@ public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simu public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Sim.Defs public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Sim.Internal public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Store +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Instruction.Tapes public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Defs -public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.ResetLayout public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.DenseInternal public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Internal public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Internal.Assemble @@ -736,6 +735,7 @@ public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simu public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Internal.Scan public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Internal.Static public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.Internal.Value +public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Lookup.ResetLayout public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Bounds public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Simulation.RegisterStore.Machine.Program.Bounds.Defs @@ -836,9 +836,8 @@ public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Stru public import LeanPool.BeyondBethe.Complexitylib.Models.RandomAccessMachine.Structured.UnaryDecode.Internal public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators -public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.Defs -public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.Helpers public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.Apply +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.Defs public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.ForBinaryWork public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.ForBinaryWork.Defs public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.ForBinaryWork.Internal @@ -848,6 +847,7 @@ public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinator public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.ForWorkOnes public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.ForWorkOnes.Defs public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.ForWorkOnes.Internal +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.Helpers public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.Internal public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.Internal.Complement public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Combinators.Internal.Generic From 613f2daf4ce750a417dac2cb4cef78aa15e5cee7 Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Fri, 25 Sep 2026 22:02:37 +0000 Subject: [PATCH 42/49] Reuse BeyondBethe matrix and tape helper proofs --- .../BeyondBethe/MachineBooleanMemory.lean | 100 ++---------------- .../Machine/EntryUpdate/TaggedProof.lean | 11 +- .../Machine/Instruction/Control.lean | 3 +- .../Machine/Instruction/DenseControl.lean | 3 +- .../Machine/Instruction/DenseDirect.lean | 14 +-- .../Machine/Instruction/DenseDispatch.lean | 3 +- .../Machine/Instruction/DenseImm.lean | 14 +-- .../Machine/Instruction/DenseLoad.lean | 14 +-- .../Machine/Instruction/DenseStore.lean | 14 +-- .../Machine/Instruction/Direct.lean | 14 +-- .../Machine/Instruction/Immediate.lean | 14 +-- .../Machine/Instruction/Internal.lean | 11 +- .../Machine/Instruction/Load.lean | 14 +-- .../Machine/Instruction/Sim/Control.lean | 11 +- .../Machine/Instruction/Sim/Data.lean | 11 +- .../Machine/Instruction/Sim/Internal.lean | 14 +-- .../Machine/Instruction/Store.lean | 14 +-- .../Machine/Lookup/Internal/Assemble.lean | 3 +- .../Machine/Lookup/Internal/Static.lean | 3 +- .../Machine/Program/Bounds/Internal.lean | 17 +-- .../Machine/Program/DenseBoundsProof.lean | 17 +-- .../Machine/Program/DenseInternal.lean | 3 +- .../Machine/Program/Internal.lean | 3 +- .../Models/TuringMachine/Registers.lean | 25 +++++ .../Subroutines/BinaryAddConst.lean | 20 ++++ 25 files changed, 102 insertions(+), 268 deletions(-) diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineBooleanMemory.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineBooleanMemory.lean index 9fccf1331b..0b6e12601c 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineBooleanMemory.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineBooleanMemory.lean @@ -7,6 +7,7 @@ module public import LeanPool.BeyondBethe.BeyondBethe.MachineListUpdate +public import LeanPool.BeyondBethe.BeyondBethe.MachineNestedMatrixMemory public import LeanPool.BeyondBethe.BeyondBethe.MachineRationalCompare /-! @@ -68,32 +69,11 @@ theorem machineBoolVectorUpdateAtUnary_mem_FP : /-- Input: `pair rowUnary (pair columnUnary boolMatrixCode)`. -/ def machineBoolMatrixEntryAtUnary (word : List Bool) : List Bool := - let rowUnary := machinePairFirst word - let rest := machinePairSecond word - let columnUnary := machinePairFirst rest - let matrixCode := machinePairSecond rest - let rowCode := machineListIndex (pair rowUnary matrixCode) - machineListIndex (pair columnUnary rowCode) + machineNestedMatrixEntryAtUnary word theorem machineBoolMatrixEntryAtUnary_mem_FP : - machineBoolMatrixEntryAtUnary ∈ Complexity.FP := by - have hrow : (fun word : List Bool => machinePairFirst word) ∈ - Complexity.FP := machinePairFirst_mem_FP - have hrest : (fun word : List Bool => machinePairSecond word) ∈ - Complexity.FP := machinePairSecond_mem_FP - have hcolumn : - (fun word : List Bool => machinePairFirst (machinePairSecond word)) ∈ - Complexity.FP := - machineCompose_mem_FP hrest machinePairFirst_mem_FP - have hmatrix : - (fun word : List Bool => machinePairSecond (machinePairSecond word)) ∈ - Complexity.FP := - machineCompose_mem_FP hrest machinePairSecond_mem_FP - have hrowPayload := machinePair_mem_FP hrow hmatrix - have hrowCode := machineCompose_mem_FP hrowPayload machineListIndex_mem_FP - have hentryPayload := machinePair_mem_FP hcolumn hrowCode - simpa only [machineBoolMatrixEntryAtUnary] using! - machineCompose_mem_FP hentryPayload machineListIndex_mem_FP + machineBoolMatrixEntryAtUnary ∈ Complexity.FP := + machineNestedMatrixEntryAtUnary_mem_FP @[simp] theorem machineBoolMatrixEntryAtUnary_encode (M : List (List Bool)) (i j : ℕ) @@ -102,60 +82,17 @@ theorem machineBoolMatrixEntryAtUnary_mem_FP : (pair (List.replicate i true) (pair (List.replicate j true) (boolMatrixCode M))) = [M[i][j]] := by - rw [machineBoolMatrixEntryAtUnary] - simp only [machinePairFirst_pair, machinePairSecond_pair, boolMatrixCode] - rw [machineListIndex_binaryListCode boolVectorCode M i hi] - simp only [boolVectorCode] - exact machineListIndex_binaryListCode boolElementCode M[i] j hj + simpa only [machineBoolMatrixEntryAtUnary, boolMatrixCode, boolVectorCode, boolElementCode] using + machineNestedMatrixEntryAtUnary_encode boolElementCode M i j hi hj /-- Input: `pair rowUnary (pair columnUnary (pair replacementBit boolMatrixCode))`. -/ def machineBoolMatrixUpdateAtUnary (word : List Bool) : List Bool := - let rowUnary := machinePairFirst word - let restOne := machinePairSecond word - let columnUnary := machinePairFirst restOne - let restTwo := machinePairSecond restOne - let replacement := machinePairFirst restTwo - let matrixCode := machinePairSecond restTwo - let rowCode := machineListIndex (pair rowUnary matrixCode) - let updatedRow := machineListUpdate - (pair columnUnary (pair replacement rowCode)) - machineListUpdate (pair rowUnary (pair updatedRow matrixCode)) + machineNestedMatrixUpdateAtUnary word theorem machineBoolMatrixUpdateAtUnary_mem_FP : - machineBoolMatrixUpdateAtUnary ∈ Complexity.FP := by - have hrow : (fun word : List Bool => machinePairFirst word) ∈ - Complexity.FP := machinePairFirst_mem_FP - have hrestOne : (fun word : List Bool => machinePairSecond word) ∈ - Complexity.FP := machinePairSecond_mem_FP - have hcolumn : - (fun word : List Bool => machinePairFirst (machinePairSecond word)) ∈ - Complexity.FP := - machineCompose_mem_FP hrestOne machinePairFirst_mem_FP - have hrestTwo : - (fun word : List Bool => machinePairSecond (machinePairSecond word)) ∈ - Complexity.FP := - machineCompose_mem_FP hrestOne machinePairSecond_mem_FP - have hreplacement : - (fun word : List Bool => - machinePairFirst (machinePairSecond (machinePairSecond word))) ∈ - Complexity.FP := - machineCompose_mem_FP hrestTwo machinePairFirst_mem_FP - have hmatrix : - (fun word : List Bool => - machinePairSecond (machinePairSecond (machinePairSecond word))) ∈ - Complexity.FP := - machineCompose_mem_FP hrestTwo machinePairSecond_mem_FP - have hrowPayload := machinePair_mem_FP hrow hmatrix - have hrowCode := machineCompose_mem_FP hrowPayload machineListIndex_mem_FP - have hupdateRowPayload := machinePair_mem_FP hcolumn - (machinePair_mem_FP hreplacement hrowCode) - have hupdatedRow := machineCompose_mem_FP hupdateRowPayload - machineListUpdate_mem_FP - have hupdateMatrixPayload := machinePair_mem_FP hrow - (machinePair_mem_FP hupdatedRow hmatrix) - simpa only [machineBoolMatrixUpdateAtUnary] using! - machineCompose_mem_FP hupdateMatrixPayload machineListUpdate_mem_FP + machineBoolMatrixUpdateAtUnary ∈ Complexity.FP := + machineNestedMatrixUpdateAtUnary_mem_FP @[simp] theorem machineBoolMatrixUpdateAtUnary_encode (M : List (List Bool)) (i j : ℕ) (replacement : Bool) @@ -165,23 +102,8 @@ theorem machineBoolMatrixUpdateAtUnary_mem_FP : (pair (List.replicate j true) (pair [replacement] (boolMatrixCode M)))) = boolMatrixCode (M.set i (M[i].set j replacement)) := by - rw [machineBoolMatrixUpdateAtUnary] - simp only [machinePairFirst_pair, machinePairSecond_pair, boolMatrixCode] - rw [machineListIndex_binaryListCode boolVectorCode M i hi] - change machineListUpdate - (pair (List.replicate i true) - (pair - (machineListUpdate - (machineListUpdateCanonicalInput boolElementCode M[i] - replacement j)) - (binaryListCode boolVectorCode M))) = _ - rw [machineListUpdate_binaryListCode boolElementCode M[i] - replacement j hj] - change machineListUpdate - (machineListUpdateCanonicalInput boolVectorCode M - (M[i].set j replacement) i) = _ - exact machineListUpdate_binaryListCode boolVectorCode M - (M[i].set j replacement) i hi + simpa only [machineBoolMatrixUpdateAtUnary, boolMatrixCode, boolVectorCode, boolElementCode] using + machineNestedMatrixUpdateAtUnary_encode boolElementCode M i j replacement hi hj /-! ## Rational support queries -/ diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/TaggedProof.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/TaggedProof.lean index 32feece911..c4d24af397 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/TaggedProof.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/TaggedProof.lean @@ -24,15 +24,8 @@ namespace Machine variable {n : ℕ} private theorem hasBinaryPrefix_parked {t : Tape} {bits : List Bool} - (h : t.HasBinaryPrefix bits) : TM.Parked t := by - refine ⟨by rw [h.1]; omega, ?_⟩ - intro j hj - obtain ⟨i, rfl⟩ : ∃ i, j = i + 1 := ⟨j - 1, by omega⟩ - by_cases hi : i < bits.length - · rw [h.2.1 i hi] - exact Γ.ofBool_ne_start _ - · rw [h.2.2 i (Nat.le_of_not_gt hi)] - decide + (h : t.HasBinaryPrefix bits) : TM.Parked t := + TM.hasBinaryPrefix_parked h theorem taggedEntryUpdateTM_hoareTime_frame_internal (tapes : EntryUpdateTapes n) (overlay : Store) (address value : ℕ) diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Control.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Control.lean index 5cec84c1de..3e8df141f5 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Control.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Control.lean @@ -41,8 +41,7 @@ private theorem phaseTransition_of_parked TM.transitionInput inp = inp ∧ (fun i => TM.transitionTape (work i)) = work ∧ TM.transitionTape out = out := - TM.phaseTransition_eq_self_of_reads_ne_start hinput.read_ne_start - (fun i => (hwork i).read_ne_start) houtput.read_ne_start + TM.phaseTransition_of_parked hinput hwork houtput private theorem controlReady_update_pc (tapes : ControlInstructionTapes n) (store : Store) diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseControl.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseControl.lean index e9a5b715c5..1e70852f65 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseControl.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseControl.lean @@ -33,8 +33,7 @@ private theorem phaseTransition_of_parked TM.transitionInput inp = inp ∧ (fun i => TM.transitionTape (work i)) = work ∧ TM.transitionTape out = out := - TM.phaseTransition_eq_self_of_reads_ne_start hinput.read_ne_start - (fun i => (hwork i).read_ne_start) houtput.read_ne_start + TM.phaseTransition_of_parked hinput hwork houtput private def DenseZeroJumpBranchResult (tapes : ControlInstructionTapes n) (input : List Bool) diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseDirect.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseDirect.lean index 211f4e9a04..4f9ffb82cf 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseDirect.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseDirect.lean @@ -29,15 +29,8 @@ private theorem hasBinaryNat_parked {t : Tape} {value : ℕ} ⟨by rw [h.2.1], h.2.hasBinaryContent.cells_ne_start⟩ private theorem hasBinaryPrefix_parked {t : Tape} {bits : List Bool} - (h : t.HasBinaryPrefix bits) : TM.Parked t := by - refine ⟨by rw [h.1]; omega, ?_⟩ - intro j hj - obtain ⟨i, rfl⟩ : ∃ i, j = i + 1 := ⟨j - 1, by omega⟩ - by_cases hi : i < bits.length - · rw [h.2.1 i hi] - exact Γ.ofBool_ne_start _ - · rw [h.2.2 i (Nat.le_of_not_gt hi)] - decide + (h : t.HasBinaryPrefix bits) : TM.Parked t := + TM.hasBinaryPrefix_parked h private theorem phaseTransition_of_parked {inp out : Tape} {work : Fin n → Tape} @@ -46,8 +39,7 @@ private theorem phaseTransition_of_parked TM.transitionInput inp = inp ∧ (fun i => TM.transitionTape (work i)) = work ∧ TM.transitionTape out = out := - TM.phaseTransition_eq_self_of_reads_ne_start hinput.read_ne_start - (fun i => (hwork i).read_ne_start) houtput.read_ne_start + TM.phaseTransition_of_parked hinput hwork houtput private theorem denseScanner_rhs_of_lhs (tapes : BinaryInstructionTapes n) (input : List Bool) diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseDispatch.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseDispatch.lean index 4bcee5251e..5e1eb66f42 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseDispatch.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseDispatch.lean @@ -46,8 +46,7 @@ private theorem phaseTransition_of_parked TM.transitionInput inp = inp ∧ (fun i => TM.transitionTape (work i)) = work ∧ TM.transitionTape out = out := - TM.phaseTransition_eq_self_of_reads_ne_start hinput.read_ne_start - (fun i => (hwork i).read_ne_start) houtput.read_ne_start + TM.phaseTransition_of_parked hinput hwork houtput /-- Dispatch's temporary selector update preserves parking of every work tape. -/ private theorem denseDispatch_work_parked diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseImm.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseImm.lean index bf6c504ba9..7f8ee2bc12 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseImm.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseImm.lean @@ -24,15 +24,8 @@ namespace Machine variable {n : ℕ} private theorem hasBinaryPrefix_parked {t : Tape} {bits : List Bool} - (h : t.HasBinaryPrefix bits) : TM.Parked t := by - refine ⟨by rw [h.1]; omega, ?_⟩ - intro j hj - obtain ⟨i, rfl⟩ : ∃ i, j = i + 1 := ⟨j - 1, by omega⟩ - by_cases hi : i < bits.length - · rw [h.2.1 i hi] - exact Γ.ofBool_ne_start _ - · rw [h.2.2 i (Nat.le_of_not_gt hi)] - decide + (h : t.HasBinaryPrefix bits) : TM.Parked t := + TM.hasBinaryPrefix_parked h private theorem phaseTransition_of_parked {inp out : Tape} {work : Fin n → Tape} @@ -41,8 +34,7 @@ private theorem phaseTransition_of_parked TM.transitionInput inp = inp ∧ (fun i => TM.transitionTape (work i)) = work ∧ TM.transitionTape out = out := - TM.phaseTransition_eq_self_of_reads_ne_start hinput.read_ne_start - (fun i => (hwork i).read_ne_start) houtput.read_ne_start + TM.phaseTransition_of_parked hinput hwork houtput /-- Exact semantic and time contract for one immediate dense-overlay write. -/ theorem denseImmediateInstructionTM_hoareTime_frame diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseLoad.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseLoad.lean index f89f98506f..62955529c5 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseLoad.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseLoad.lean @@ -25,15 +25,8 @@ namespace Machine variable {n : ℕ} private theorem hasBinaryPrefix_parked {t : Tape} {bits : List Bool} - (h : t.HasBinaryPrefix bits) : TM.Parked t := by - refine ⟨by rw [h.1]; omega, ?_⟩ - intro j hj - obtain ⟨i, rfl⟩ : ∃ i, j = i + 1 := ⟨j - 1, by omega⟩ - by_cases hi : i < bits.length - · rw [h.2.1 i hi] - exact Γ.ofBool_ne_start _ - · rw [h.2.2 i (Nat.le_of_not_gt hi)] - decide + (h : t.HasBinaryPrefix bits) : TM.Parked t := + TM.hasBinaryPrefix_parked h private theorem phaseTransition_of_parked {inp out : Tape} {work : Fin n → Tape} @@ -42,8 +35,7 @@ private theorem phaseTransition_of_parked TM.transitionInput inp = inp ∧ (fun i => TM.transitionTape (work i)) = work ∧ TM.transitionTape out = out := - TM.phaseTransition_eq_self_of_reads_ne_start hinput.read_ne_start - (fun i => (hwork i).read_ne_start) houtput.read_ne_start + TM.phaseTransition_of_parked hinput hwork houtput private theorem denseScanner_indirect_of_lhs (tapes : BinaryInstructionTapes n) (input : List Bool) diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseStore.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseStore.lean index 8730a6b923..5f7312c135 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseStore.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/DenseStore.lean @@ -22,15 +22,8 @@ namespace Machine variable {n : ℕ} private theorem hasBinaryPrefix_parked {t : Tape} {bits : List Bool} - (h : t.HasBinaryPrefix bits) : TM.Parked t := by - refine ⟨by rw [h.1]; omega, ?_⟩ - intro j hj - obtain ⟨i, rfl⟩ : ∃ i, j = i + 1 := ⟨j - 1, by omega⟩ - by_cases hi : i < bits.length - · rw [h.2.1 i hi] - exact Γ.ofBool_ne_start _ - · rw [h.2.2 i (Nat.le_of_not_gt hi)] - decide + (h : t.HasBinaryPrefix bits) : TM.Parked t := + TM.hasBinaryPrefix_parked h private theorem phaseTransition_of_parked {inp out : Tape} {work : Fin n → Tape} @@ -39,8 +32,7 @@ private theorem phaseTransition_of_parked TM.transitionInput inp = inp ∧ (fun i => TM.transitionTape (work i)) = work ∧ TM.transitionTape out = out := - TM.phaseTransition_eq_self_of_reads_ne_start hinput.read_ne_start - (fun i => (hwork i).read_ne_start) houtput.read_ne_start + TM.phaseTransition_of_parked hinput hwork houtput private theorem denseStoreOperands_values (tapes : BinaryInstructionTapes n) (input : List Bool) diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Direct.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Direct.lean index acba0bdbf2..6dcb1b6120 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Direct.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Direct.lean @@ -265,15 +265,8 @@ private theorem directAddress_ready hrhs.scanner).parked private theorem hasBinaryPrefix_parked {t : Tape} {bits : List Bool} - (h : t.HasBinaryPrefix bits) : TM.Parked t := by - refine ⟨by rw [h.1]; omega, ?_⟩ - intro j hj - obtain ⟨i, rfl⟩ : ∃ i, j = i + 1 := ⟨j - 1, by omega⟩ - by_cases hi : i < bits.length - · rw [h.2.1 i hi] - exact Γ.ofBool_ne_start _ - · rw [h.2.2 i (Nat.le_of_not_gt hi)] - decide + (h : t.HasBinaryPrefix bits) : TM.Parked t := + TM.hasBinaryPrefix_parked h private theorem phaseTransition_of_parked {inp out : Tape} {work : Fin n → Tape} @@ -282,8 +275,7 @@ private theorem phaseTransition_of_parked TM.transitionInput inp = inp ∧ (fun i => TM.transitionTape (work i)) = work ∧ TM.transitionTape out = out := - TM.phaseTransition_eq_self_of_reads_ne_start hinput.read_ne_start - (fun i => (hwork i).read_ne_start) houtput.read_ne_start + TM.phaseTransition_of_parked hinput hwork houtput /-- The shared two-direct-operand prefix used by arithmetic and indirect store instructions. -/ diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Immediate.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Immediate.lean index 1b07ed1ec7..089fef93e5 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Immediate.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Immediate.lean @@ -27,15 +27,8 @@ namespace Machine variable {n : ℕ} private theorem hasBinaryPrefix_parked {t : Tape} {bits : List Bool} - (h : t.HasBinaryPrefix bits) : TM.Parked t := by - refine ⟨by rw [h.1]; omega, ?_⟩ - intro j hj - obtain ⟨i, rfl⟩ : ∃ i, j = i + 1 := ⟨j - 1, by omega⟩ - by_cases hi : i < bits.length - · rw [h.2.1 i hi] - exact Γ.ofBool_ne_start _ - · rw [h.2.2 i (Nat.le_of_not_gt hi)] - decide + (h : t.HasBinaryPrefix bits) : TM.Parked t := + TM.hasBinaryPrefix_parked h private theorem phaseTransition_of_parked {inp out : Tape} {work : Fin n → Tape} @@ -44,8 +37,7 @@ private theorem phaseTransition_of_parked TM.transitionInput inp = inp ∧ (fun i => TM.transitionTape (work i)) = work ∧ TM.transitionTape out = out := - TM.phaseTransition_eq_self_of_reads_ne_start hinput.read_ne_start - (fun i => (hwork i).read_ne_start) houtput.read_ne_start + TM.phaseTransition_of_parked hinput hwork houtput theorem immediateUpdate_ready_internal (tapes : BinaryInstructionTapes n) (store : Store) diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Internal.lean index ca67f1a452..85ca00054e 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Internal.lean @@ -32,15 +32,8 @@ private theorem hasBinaryNat_parked {t : Tape} {value : ℕ} ⟨by rw [h.2.1], h.2.hasBinaryContent.cells_ne_start⟩ private theorem hasBinaryPrefix_parked {t : Tape} {bits : List Bool} - (h : t.HasBinaryPrefix bits) : TM.Parked t := by - refine ⟨by rw [h.1]; omega, ?_⟩ - intro j hj - obtain ⟨i, rfl⟩ : ∃ i, j = i + 1 := ⟨j - 1, by omega⟩ - by_cases hi : i < bits.length - · rw [h.2.1 i hi] - exact Γ.ofBool_ne_start _ - · rw [h.2.2 i (Nat.le_of_not_gt hi)] - decide + (h : t.HasBinaryPrefix bits) : TM.Parked t := + TM.hasBinaryPrefix_parked h private theorem arithmeticResult_of_threeTape (tapes : BinaryInstructionTapes n) (op : BinaryInstrOp) (lhs rhs : ℕ) diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Load.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Load.lean index 836413ccb5..3e7618f3b0 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Load.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Load.lean @@ -167,15 +167,8 @@ theorem scanner_updateQuery_of_indirect_internal · simpa only [finalWork, Function.update_of_ne hi] using! hscanner.parked i private theorem hasBinaryPrefix_parked {t : Tape} {bits : List Bool} - (h : t.HasBinaryPrefix bits) : TM.Parked t := by - refine ⟨by rw [h.1]; omega, ?_⟩ - intro j hj - obtain ⟨i, rfl⟩ : ∃ i, j = i + 1 := ⟨j - 1, by omega⟩ - by_cases hi : i < bits.length - · rw [h.2.1 i hi] - exact Γ.ofBool_ne_start _ - · rw [h.2.2 i (Nat.le_of_not_gt hi)] - decide + (h : t.HasBinaryPrefix bits) : TM.Parked t := + TM.hasBinaryPrefix_parked h private theorem phaseTransition_of_parked {inp out : Tape} {work : Fin n → Tape} @@ -184,8 +177,7 @@ private theorem phaseTransition_of_parked TM.transitionInput inp = inp ∧ (fun i => TM.transitionTape (work i)) = work ∧ TM.transitionTape out = out := - TM.phaseTransition_eq_self_of_reads_ne_start hinput.read_ne_start - (fun i => (hwork i).read_ne_start) houtput.read_ne_start + TM.phaseTransition_of_parked hinput hwork houtput /-- Both indirect lookups preserve the source count used by the final store update. -/ private theorem indirectLoaded_resultCount diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Sim/Control.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Sim/Control.lean index c31fe7147f..f699566be3 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Sim/Control.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Sim/Control.lean @@ -32,15 +32,8 @@ private theorem hasBinaryNat_parked {t : Tape} {value : ℕ} exact Tape.HasBinaryContent.cells_ne_start h.2.2 private theorem hasBinaryPrefix_parked {t : Tape} {bits : List Bool} - (h : t.HasBinaryPrefix bits) : TM.Parked t := by - refine ⟨by rw [h.1]; omega, ?_⟩ - intro j hj - obtain ⟨i, rfl⟩ : ∃ i, j = i + 1 := ⟨j - 1, by omega⟩ - by_cases hi : i < bits.length - · rw [h.2.1 i hi] - exact Γ.ofBool_ne_start _ - · rw [h.2.2 i (Nat.le_of_not_gt hi)] - decide + (h : t.HasBinaryPrefix bits) : TM.Parked t := + TM.hasBinaryPrefix_parked h /-- Restore the empty entry scanner after copying a control instruction's store buffer. -/ private theorem controlCopy_entryScannerReady diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Sim/Data.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Sim/Data.lean index c06e2d065e..9291ec5069 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Sim/Data.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Sim/Data.lean @@ -31,15 +31,8 @@ private theorem hasBinaryNat_parked {t : Tape} {value : ℕ} exact Tape.HasBinaryContent.cells_ne_start h.2.2 private theorem hasBinaryPrefix_parked {t : Tape} {bits : List Bool} - (h : t.HasBinaryPrefix bits) : TM.Parked t := by - refine ⟨by rw [h.1]; omega, ?_⟩ - intro j hj - obtain ⟨i, rfl⟩ : ∃ i, j = i + 1 := ⟨j - 1, by omega⟩ - by_cases hi : i < bits.length - · rw [h.2.1 i hi] - exact Γ.ofBool_ne_start _ - · rw [h.2.2 i (Nat.le_of_not_gt hi)] - decide + (h : t.HasBinaryPrefix bits) : TM.Parked t := + TM.hasBinaryPrefix_parked h /-- Restrict the lifted clean lookup ABI to the original data-tape family. -/ theorem instructionExecutionReady_baseLookup_internal diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Sim/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Sim/Internal.lean index 5eff3f8592..4e8c93d0bf 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Sim/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Sim/Internal.lean @@ -35,15 +35,8 @@ private theorem hasBinaryNat_parked {t : Tape} {value : ℕ} exact Tape.HasBinaryContent.cells_ne_start h.2.2 private theorem hasBinaryPrefix_parked {t : Tape} {bits : List Bool} - (h : t.HasBinaryPrefix bits) : TM.Parked t := by - refine ⟨by rw [h.1]; omega, ?_⟩ - intro j hj - obtain ⟨i, rfl⟩ : ∃ i, j = i + 1 := ⟨j - 1, by omega⟩ - by_cases hi : i < bits.length - · rw [h.2.1 i hi] - exact Γ.ofBool_ne_start _ - · rw [h.2.2 i (Nat.le_of_not_gt hi)] - decide + (h : t.HasBinaryPrefix bits) : TM.Parked t := + TM.hasBinaryPrefix_parked h private theorem instructionCleanupPrefixTape_hasBinaryPrefix (bits : List Bool) : @@ -79,8 +72,7 @@ private theorem phaseTransition_of_parked TM.transitionInput inp = inp ∧ (fun i => TM.transitionTape (work i)) = work ∧ TM.transitionTape out = out := - TM.phaseTransition_eq_self_of_reads_ne_start hinput.read_ne_start - (fun i => (hwork i).read_ne_start) houtput.read_ne_start + TM.phaseTransition_of_parked hinput hwork houtput /-- Reset the dispatch selector and execute halt when the program list is empty. -/ private theorem dispatchEmptyProgramTM_hoareTime diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Store.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Store.lean index 92b82c445e..03838bc2b2 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Store.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Store.lean @@ -25,15 +25,8 @@ namespace Machine variable {n : ℕ} private theorem hasBinaryPrefix_parked {t : Tape} {bits : List Bool} - (h : t.HasBinaryPrefix bits) : TM.Parked t := by - refine ⟨by rw [h.1]; omega, ?_⟩ - intro j hj - obtain ⟨i, rfl⟩ : ∃ i, j = i + 1 := ⟨j - 1, by omega⟩ - by_cases hi : i < bits.length - · rw [h.2.1 i hi] - exact Γ.ofBool_ne_start _ - · rw [h.2.2 i (Nat.le_of_not_gt hi)] - decide + (h : t.HasBinaryPrefix bits) : TM.Parked t := + TM.hasBinaryPrefix_parked h private theorem phaseTransition_of_parked {inp out : Tape} {work : Fin n → Tape} @@ -42,8 +35,7 @@ private theorem phaseTransition_of_parked TM.transitionInput inp = inp ∧ (fun i => TM.transitionTape (work i)) = work ∧ TM.transitionTape out = out := - TM.phaseTransition_eq_self_of_reads_ne_start hinput.read_ne_start - (fun i => (hwork i).read_ne_start) houtput.read_ne_start + TM.phaseTransition_of_parked hinput hwork houtput private theorem storeOperands_values (tapes : BinaryInstructionTapes n) (store : Store) diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/Internal/Assemble.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/Internal/Assemble.lean index c0935f9346..c96daabe9f 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/Internal/Assemble.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/Internal/Assemble.lean @@ -96,8 +96,7 @@ private theorem phaseTransition_of_parked TM.transitionInput inp = inp ∧ (fun i => TM.transitionTape (work i)) = work ∧ TM.transitionTape out = out := - TM.phaseTransition_eq_self_of_reads_ne_start hinput.read_ne_start - (fun i => (hwork i).read_ne_start) houtput.read_ne_start + TM.phaseTransition_of_parked hinput hwork houtput /-- Scanner reset, source rewind, and count restoration form one reusable tail whose endpoint is the original blank-query scanner ABI. -/ diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/Internal/Static.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/Internal/Static.lean index 712544c2ce..b98f6667fb 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/Internal/Static.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Lookup/Internal/Static.lean @@ -32,8 +32,7 @@ private theorem phaseTransition_of_parked TM.transitionInput inp = inp ∧ (fun i => TM.transitionTape (work i)) = work ∧ TM.transitionTape out = out := - TM.phaseTransition_eq_self_of_reads_ne_start hinput.read_ne_start - (fun i => (hwork i).read_ne_start) houtput.read_ne_start + TM.phaseTransition_of_parked hinput hwork houtput private theorem staticAddress_parked (address : ℕ) : TM.Parked diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Bounds/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Bounds/Internal.lean index 0a19b2371b..03cafd1549 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Bounds/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Bounds/Internal.lean @@ -128,21 +128,8 @@ private theorem binaryCopyTime_le_width (srcValue dstValue width : ℕ) exact le_trans (TM.binaryCopyTime_le srcValue dstValue) (by omega) private theorem binaryAddConstTime_zero_le (fixedValue : ℕ) : - TM.binaryAddConstTime fixedValue 0 ≤ 4 * (fixedValue + 1) ^ 2 := by - induction fixedValue with - | zero => simp [TM.binaryAddConstTime] - | succ fixedValue ih => - rw [TM.binaryAddConstTime] - have hsucc := TM.binarySuccTime_le fixedValue - have hsize := size_le_self fixedValue - calc - TM.binaryAddConstTime fixedValue 0 + 1 + - TM.binarySuccTime (0 + fixedValue) ≤ - 4 * (fixedValue + 1) ^ 2 + 1 + (2 * fixedValue + 2) := by - simp only [Nat.zero_add] - exact Nat.add_le_add (Nat.add_le_add ih le_rfl) - (le_trans hsucc (by omega)) - _ ≤ 4 * (fixedValue + 1 + 1) ^ 2 := by nlinarith + TM.binaryAddConstTime fixedValue 0 ≤ 4 * (fixedValue + 1) ^ 2 := + TM.binaryAddConstTime_zero_le fixedValue private theorem binaryAddConstTime_zero_le_width (fixedValue width : ℕ) (hconstant : fixedValue ≤ width) : diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseBoundsProof.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseBoundsProof.lean index 6ad6f93302..2a26493b5d 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseBoundsProof.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseBoundsProof.lean @@ -394,21 +394,8 @@ private theorem bitlen_succ_le (value : ℕ) : omega private theorem binaryAddConstTime_zero_le (fixedValue : ℕ) : - TM.binaryAddConstTime fixedValue 0 ≤ 4 * (fixedValue + 1) ^ 2 := by - induction fixedValue with - | zero => simp [TM.binaryAddConstTime] - | succ fixedValue ih => - rw [TM.binaryAddConstTime] - have hsucc := TM.binarySuccTime_le fixedValue - have hsize := size_le_self fixedValue - calc - TM.binaryAddConstTime fixedValue 0 + 1 + - TM.binarySuccTime (0 + fixedValue) ≤ - 4 * (fixedValue + 1) ^ 2 + 1 + (2 * fixedValue + 2) := by - simp only [Nat.zero_add] - exact Nat.add_le_add (Nat.add_le_add ih le_rfl) - (le_trans hsucc (by omega)) - _ ≤ 4 * (fixedValue + 1 + 1) ^ 2 := by nlinarith + TM.binaryAddConstTime fixedValue 0 ≤ 4 * (fixedValue + 1) ^ 2 := + TM.binaryAddConstTime_zero_le fixedValue private theorem binaryInstructionArithmeticTime_le_width (op : BinaryInstrOp) (lhs rhs width : ℕ) diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseInternal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseInternal.lean index d6ddebc99e..3f0e9ff6aa 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseInternal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseInternal.lean @@ -42,8 +42,7 @@ private theorem phaseTransition_of_parked TM.transitionInput inp = inp ∧ (fun i => TM.transitionTape (work i)) = work ∧ TM.transitionTape out = out := - TM.phaseTransition_eq_self_of_reads_ne_start hinput.read_ne_start - (fun i => (hwork i).read_ne_start) houtput.read_ne_start + TM.phaseTransition_of_parked hinput hwork houtput /-- Final dense lookup and Boolean emission recover the decoded RAM verdict register. -/ diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Internal.lean index 285adb914f..d43220af27 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/Internal.lean @@ -639,8 +639,7 @@ private theorem phaseTransition_of_parked TM.transitionInput inp = inp ∧ (fun i => TM.transitionTape (work i)) = work ∧ TM.transitionTape out = out := - TM.phaseTransition_eq_self_of_reads_ne_start hinput.read_ne_start - (fun i => (hwork i).read_ne_start) houtput.read_ne_start + TM.phaseTransition_of_parked hinput hwork houtput /-- The loop's fixed three-step rewind/check tail preserves every tape exactly. -/ theorem programLoop_rewind_check_internal (tmBody tmTest : TM n) diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Registers.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Registers.lean index 5ffcb87605..e42be0fa45 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Registers.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Registers.lean @@ -6,6 +6,7 @@ Authors: Samuel Schlesinger module public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.Counter +public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Tape.Encoding /-! # Unary registers @@ -49,6 +50,18 @@ namespace TM def Parked (t : Tape) : Prop := 1 ≤ t.head ∧ ∀ j, 1 ≤ j → t.cells j ≠ Γ.start +/-- A binary prefix has its head past the start marker and no later start cells. -/ +theorem hasBinaryPrefix_parked {t : Tape} {bits : List Bool} + (h : t.HasBinaryPrefix bits) : Parked t := by + refine ⟨by rw [h.1]; omega, ?_⟩ + intro j hj + obtain ⟨i, rfl⟩ : ∃ i, j = i + 1 := ⟨j - 1, by omega⟩ + by_cases hi : i < bits.length + · rw [h.2.1 i hi] + exact Γ.ofBool_ne_start _ + · rw [h.2.2 i (Nat.le_of_not_gt hi)] + decide + /-- A parked tape never reads the start symbol `▷`. -/ theorem Parked.read_ne_start {t : Tape} (h : Parked t) : t.read ≠ Γ.start := h.2 t.head h.1 @@ -73,6 +86,18 @@ theorem Parked.transitionTape_eq_self {t : Tape} (h : Parked t) : transitionTape theorem Parked.transitionInput_eq_self {t : Tape} (h : Parked t) : transitionInput t = t := TM.transitionInput_eq_self h.read_ne_start +/-- Parked input, work, and output tapes are fixed by a phase transition. -/ +theorem phaseTransition_of_parked {n : ℕ} + {inp out : Tape} {work : Fin n → Tape} + (hinput : Parked inp) (hwork : ∀ i, Parked (work i)) + (houtput : Parked out) : + transitionInput inp = inp ∧ + (fun i => transitionTape (work i)) = work ∧ + transitionTape out = out := + ⟨hinput.transitionInput_eq_self, + funext fun i => (hwork i).transitionTape_eq_self, + houtput.transitionTape_eq_self⟩ + -- ════════════════════════════════════════════════════════════════════════ -- Registers -- ════════════════════════════════════════════════════════════════════════ diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryAddConst.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryAddConst.lean index cc5dbb7740..52cbc0ddbc 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryAddConst.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryAddConst.lean @@ -31,6 +31,26 @@ namespace TM variable {n : ℕ} +/-- Adding a fixed constant to zero has a quadratic time bound. -/ +theorem binaryAddConstTime_zero_le (fixedValue : ℕ) : + binaryAddConstTime fixedValue 0 ≤ 4 * (fixedValue + 1) ^ 2 := by + induction fixedValue with + | zero => simp [binaryAddConstTime] + | succ fixedValue ih => + rw [binaryAddConstTime] + have hsucc := binarySuccTime_le fixedValue + have hsize : fixedValue.size ≤ fixedValue := by + rw [Nat.size_le] + exact Nat.lt_pow_self (by decide) + calc + binaryAddConstTime fixedValue 0 + 1 + + binarySuccTime (0 + fixedValue) ≤ + 4 * (fixedValue + 1) ^ 2 + 1 + (2 * fixedValue + 2) := by + simp only [Nat.zero_add] + exact Nat.add_le_add (Nat.add_le_add ih le_rfl) + (le_trans hsucc (by omega)) + _ ≤ 4 * (fixedValue + 1 + 1) ^ 2 := by nlinarith + /-- Fixed-constant addition has the advertised exact runtime and changes only the destination tape. -/ theorem binaryAddConstTM_reachesIn_frame From 5c0f85ef6ef75712d35264461ee09847414f10f6 Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Sat, 26 Sep 2026 03:38:34 +0000 Subject: [PATCH 43/49] Repair literal frame transports and finite machine proof frontiers --- .../RegisterStore/Machine/EntryUpdate/Internal/Hit.lean | 2 +- .../TMConfig/Sparse/ABI/Internal/Resources.lean | 2 +- .../Structured/GateStep/Internal.lean | 9 ++++----- .../Models/TuringMachine/Combinators/Internal/Union.lean | 7 ++----- .../Models/TuringMachine/Subroutines/BinaryAddConst.lean | 1 + .../Subroutines/BinaryRippleAdd/Internal/Scan.lean | 2 +- .../Subroutines/BinaryRippleSub/Internal/Scan.lean | 2 +- 7 files changed, 11 insertions(+), 14 deletions(-) diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Hit.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Hit.lean index ae1d20f46c..efa033b3da 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Hit.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/EntryUpdate/Internal/Hit.lean @@ -356,7 +356,7 @@ theorem entryUpdateDeleteIteration_internal TM.binaryPredTime (resultCount - 1) + 1 + TM.binaryPredTime rest.length + 1, ?_, ?_, hinvFinal, ?_⟩ - · unfold entryUpdateIterationTime entryUpdateBranchTime + · unfold entryUpdateIterationTime omega · simpa [hinputEq, Nat.add_assoc] using htotalReach · rw [houtputEq] diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/ABI/Internal/Resources.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/ABI/Internal/Resources.lean index 532ce1b7f8..30bbaa69a1 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/ABI/Internal/Resources.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/TMConfig/Sparse/ABI/Internal/Resources.lean @@ -296,7 +296,7 @@ private theorem marshalLoop_encodedState (n : ℕ) (store : Structured.Store) (c simp only [sourceCleared, Structured.Basic.exec] rw [Function.update_of_ne] · exact hsourceLoadedState - · rw [hloadedAddress] + · rw [show sourceLoaded (addressReg n) = cursor from hloadedAddress] simp [stateReg] omega have hbasedState : based stateReg = cursor := by diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/GateStep/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/GateStep/Internal.lean index 6533a8fc96..780fd28f6c 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/GateStep/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Structured/GateStep/Internal.lean @@ -860,7 +860,6 @@ private theorem marshal_ready_of_decoded simp [memoBase, CircuitCode.RawGate.length_encode, UnaryDecode.inputBase] omega)] - change saveRestartStore first (memoBase gate + index) = _ rw [saveRestart_high first _ (by simp [memoBase, CircuitCode.RawGate.length_encode, UnaryDecode.inputBase] @@ -916,7 +915,7 @@ theorem program_measured_internal (gate : CircuitCode.RawGate) (wires : List Boo hsecondResult.2.2.2 have hsecondOp : second headerOpReg = Input.bitValue gate.opBit := by rw [hsecondFrame _ (by simp [headerOpReg, UnaryDecode.inputBase])] - rw [show saved headerOpReg = first headerOpReg by + rw [show saveRestartStore first headerOpReg = first headerOpReg by apply saveRestart_apply_of_ne <;> simp [headerOpReg, savedInput0Reg, UnaryDecode.verdictReg, UnaryDecode.valueReg, UnaryDecode.activeReg, UnaryDecode.inputBase]] @@ -925,7 +924,7 @@ theorem program_measured_internal (gate : CircuitCode.RawGate) (wires : List Boo have hsecondNegated0 : second headerNegated0Reg = Input.bitValue gate.negated₀ := by rw [hsecondFrame _ (by simp [headerNegated0Reg, UnaryDecode.inputBase])] - rw [show saved headerNegated0Reg = first headerNegated0Reg by + rw [show saveRestartStore first headerNegated0Reg = first headerNegated0Reg by apply saveRestart_apply_of_ne <;> simp [headerNegated0Reg, savedInput0Reg, UnaryDecode.verdictReg, UnaryDecode.valueReg, UnaryDecode.activeReg, UnaryDecode.inputBase]] @@ -934,7 +933,7 @@ theorem program_measured_internal (gate : CircuitCode.RawGate) (wires : List Boo have hsecondNegated1 : second headerNegated1Reg = Input.bitValue gate.negated₁ := by rw [hsecondFrame _ (by simp [headerNegated1Reg, UnaryDecode.inputBase])] - rw [show saved headerNegated1Reg = first headerNegated1Reg by + rw [show saveRestartStore first headerNegated1Reg = first headerNegated1Reg by apply saveRestart_apply_of_ne <;> simp [headerNegated1Reg, savedInput0Reg, UnaryDecode.verdictReg, UnaryDecode.valueReg, UnaryDecode.activeReg, UnaryDecode.inputBase]] @@ -942,7 +941,7 @@ theorem program_measured_internal (gate : CircuitCode.RawGate) (wires : List Boo exact header_negated1 gate wires have hsecondInput0 : second savedInput0Reg = gate.input₀ := by rw [hsecondFrame _ (by simp [savedInput0Reg, UnaryDecode.inputBase])] - rw [show saved savedInput0Reg = + rw [show saveRestartStore first savedInput0Reg = first UnaryDecode.valueReg + first UnaryDecode.activeReg by exact saveRestart_saved first] rw [hfirstValue, hfirstActive] diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/Internal/Union.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/Internal/Union.lean index 3dc3b29ba1..b6f2db27f4 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/Internal/Union.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/Internal/Union.lean @@ -871,9 +871,7 @@ private theorem unionReject_rewindInput_head_bound have hstep_eq := step_inl_qhalt_cfg tm₁ tm₂ hstateq -- c_rw.input = c₁.input.move (idleDir c₁.input.read) since unionPhase1Cfg.input = c₁.input have hcrw_input_eq : c_rw.input = c₁.input.move (idleDir c₁.input.read) := by - have heq : some c_rw = some _ := hstep1.symm.trans hstep_eq - simp only [Option.some.injEq] at heq - rw [heq]; rfl + exact congrArg (fun c => c.input) (Option.some.inj (hstep1.symm.trans hstep_eq)) -- c_rw.input.head ≤ c₁.input.head + 1 have hcrw_head : c_rw.input.head ≤ c₁.input.head + 1 := by rw [hcrw_input_eq]; cases (idleDir c₁.input.read) <;> simp [Tape.move]; omega @@ -904,8 +902,7 @@ private theorem unionReject_rewindInput_head_bound have hri_head : rewindInput.head = checkInput.head := by show (checkInput.move (idleDir checkInput.read)).head = _ exact idle_move_preserves_head _ (by omega) hcr_ino - -- Chain: rewindInput.head = rewindInput.head = c_rw.input.head ≤ c₁.input.head + 1 - omega + exact (hri_head.trans (hcr_head.trans hat0_head)).trans_le hcrw_head /-- After Phase 1, if tm₁ rejected, the union machine transitions to a config ready for Phase 2: state is `Sum.inr (Sum.inr tm₂.qstart)`, diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryAddConst.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryAddConst.lean index 52cbc0ddbc..f1f3238697 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryAddConst.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryAddConst.lean @@ -5,6 +5,7 @@ Authors: Samuel Schlesinger -/ module +public import Mathlib.Tactic.Linarith public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryAddConst.Defs public import LeanPool.BeyondBethe.Complexitylib.Models.TuringMachine.Subroutines.BinaryAddConst.Internal diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleAdd/Internal/Scan.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleAdd/Internal/Scan.lean index 386a0d5da3..bd2fc43fd9 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleAdd/Internal/Scan.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleAdd/Internal/Scan.lean @@ -195,7 +195,6 @@ private theorem binaryRippleAddScanTM_step_terminal {n : ℕ} · intro i _ _ hires simp [finalWork, hires] -/-- With the left input exhausted, ripple addition consumes the right suffix and carry. -/ /-- Writing one ripple-add output bit extends its prefix without changing the start marker. -/ private theorem binaryRippleAddScanAdvanceWork_result {n : ℕ} (lhsIdx rhsIdx resultIdx : Fin n) (sum : Bool) (emitted : List Bool) @@ -224,6 +223,7 @@ private theorem binaryRippleAddScanAdvanceWork_result {n : ℕ} exact Tape.hasBinaryPrefix_write_bit_cell0 sum hresult hresultStart exact ⟨hresult₁, hresultStart₁⟩ +/-- With the left input exhausted, ripple addition consumes the right suffix and carry. -/ private theorem binaryRippleAddScanTM_suffix_empty_left {n : ℕ} (lhsIdx rhsIdx resultIdx : Fin n) (hdistinct : BinaryRippleAddDistinct lhsIdx rhsIdx resultIdx) diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleSub/Internal/Scan.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleSub/Internal/Scan.lean index 527df951f0..6aec8ffb5f 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleSub/Internal/Scan.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/BinaryRippleSub/Internal/Scan.lean @@ -170,7 +170,6 @@ private theorem binaryRippleSubCoreTM_step_terminal {n : ℕ} · intro i _ _ hires simp [binaryRippleSubScanTurnWork, hires] -/-- With the left input exhausted, ripple subtraction condiffes the right suffix and borrow. -/ /-- Writing one ripple-sub output bit extends its prefix without changing the start marker. -/ private theorem binaryRippleSubScanAdvanceWork_result {n : ℕ} (lhsIdx rhsIdx resultIdx : Fin n) (diff : Bool) (emitted : List Bool) @@ -199,6 +198,7 @@ private theorem binaryRippleSubScanAdvanceWork_result {n : ℕ} exact Tape.hasBinaryPrefix_write_bit_cell0 diff hresult hresultStart exact ⟨hresult₁, hresultStart₁⟩ +/-- With the left input exhausted, ripple subtraction consumes the right suffix and borrow. -/ private theorem binaryRippleSubCoreTM_suffix_empty_left {n : ℕ} (lhsIdx rhsIdx resultIdx : Fin n) (hdistinct : BinaryRippleSubDistinct lhsIdx rhsIdx resultIdx) From 03e1396b9e6d202227415a32850d823c0ad9beec Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Sat, 26 Sep 2026 03:53:38 +0000 Subject: [PATCH 44/49] Fix explicit foundation proof steps in BeyondBethe --- .../TuringMachine/Combinators/Helpers.lean | 4 +- .../Combinators/Internal/Generic.lean | 8 ++-- .../Models/TuringMachine/Registers.lean | 2 +- .../TuringMachine/Subroutines/Counter.lean | 38 +++++++++---------- 4 files changed, 25 insertions(+), 27 deletions(-) diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/Helpers.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/Helpers.lean index 0e72e41fd6..8d02c55ba4 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/Helpers.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/Helpers.lean @@ -74,13 +74,13 @@ theorem write_readBack (t : Tape) (hread : t.read ≠ Γ.start) : split · rfl · refine Tape.ext rfl ?_ - show Function.update t.cells t.head (readBackWrite t.read).toΓ = t.cells + change Function.update t.cells t.head (readBackWrite t.read).toΓ = t.cells rw [toΓ_readBackWrite_of_ne_start hread, Tape.read, Function.update_eq_self] /-- Writing back the symbol under an off-start head and moving is just the move. -/ theorem writeAndMove_readBack (t : Tape) (hread : t.read ≠ Γ.start) (d : Dir3) : t.writeAndMove (readBackWrite t.read) d = t.move d := by - show (t.write _).move d = t.move d + change (t.write _).move d = t.move d rw [write_readBack t hread] /-- The "do nothing" transition output: all writes are `□`, all directions diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/Internal/Generic.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/Internal/Generic.lean index 4033f5ae98..4277d45b8c 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/Internal/Generic.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Combinators/Internal/Generic.lean @@ -59,9 +59,9 @@ theorem tape_writeAndMove_stable (t : Tape) t.writeAndMove (readBackWrite t.read).toΓ (idleDir t.read) = t := by have hne : t.read ≠ Γ.start := by simp only [Tape.read]; exact hns t.head hhead rw [toΓ_readBackWrite_of_ne_start hne] - show (t.write t.read).move (idleDir t.read) = t + change (t.write t.read).move (idleDir t.read) = t simp only [idleDir, hne, ↓reduceIte] - show (t.write (t.cells t.head)).move .stay = t + change (t.write (t.cells t.head)).move .stay = t simp only [Tape.write, show ¬(t.head = 0) by omega, ↓reduceIte, Function.update_eq_self, Tape.move] @@ -157,7 +157,7 @@ theorem exists_reachesIn_of_rewindStep_tape (tm : TM n) (tape : Cfg n tm.Q → T | succ p ih => intro c hstate hcell0 hnostart hhead have hread_ne : (tape c).read ≠ Γ.start := by - simp [Tape.read, hhead]; exact hnostart (p + 1) (by omega) + simpa only [Tape.read, hhead] using hnostart (p + 1) (by omega) obtain ⟨c', hstep, hst, hh, hcells⟩ := h_step_left c hstate hread_ne hcell0 hnostart have hh' : (tape c').head = p := by rw [hh, hhead]; omega obtain ⟨c_target, hreach, hst_t, hh_t, hcells_t⟩ := ih c' hst @@ -253,7 +253,7 @@ theorem exists_reachesIn_of_rewindStep_frame (tm : TM n) | succ p ih => intro c hstate hcell0 hnostart hhead h_ih h_ins h_wh h_wns have hread_ne : c.output.read ≠ Γ.start := by - simp [Tape.read, hhead]; exact hnostart (p + 1) (by omega) + simpa only [Tape.read, hhead] using hnostart (p + 1) (by omega) obtain ⟨c', hstep, hst, hh, hcells, hinp, hwork⟩ := h_step_left c hstate hread_ne hcell0 hnostart h_ih h_ins h_wh h_wns have hh' : c'.output.head = p := by rw [hh, hhead]; omega diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Registers.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Registers.lean index e42be0fa45..bdd555053f 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Registers.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Registers.lean @@ -157,7 +157,7 @@ end IsReg /-- A blank tape with the head bumped to cell 1 is the zero register. -/ theorem reg_zero_init_bumped : IsReg 0 { head := 1, cells := (Tape.init []).cells } := by refine ⟨rfl, by simp [Tape.init], fun _ hi => by omega, fun j hj => ?_⟩ - show (Tape.init []).cells j = Γ.blank + change (Tape.init []).cells j = Γ.blank simp only [Tape.init] rw [ite_eq_right (by omega : ¬ j = 0)] simp diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/Counter.lean b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/Counter.lean index 4af7db116b..d8fc3b6fcb 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/Counter.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/TuringMachine/Subroutines/Counter.lean @@ -663,8 +663,8 @@ private theorem inputLengthPlusOneCounterTM_start_step (c₁.work counterIdx).cells 0 = Γ.start := by have hread : (Tape.init (x.map Γ.ofBool)).read = Γ.start := by simp [Tape.read, Tape.init] - simp [TM.step, inputLengthPlusOneCounterTM, hread] - refine ⟨?_, ?_, ?_, ?_⟩ + simp only [TM.step, inputLengthPlusOneCounterTM, hread] + refine ⟨_, rfl, rfl, ?_, ?_, ?_, ?_⟩ · rw [Tape.move_cells] · simp [Tape.init, Tape.move] · have hcounter_read : (work counterIdx).read = Γ.start := by @@ -694,7 +694,7 @@ private theorem inputLengthPlusOneCounterTM_scan_bit_step (c'.work counterIdx).HasUnaryPrefix (k + 1) ∧ (c'.work counterIdx).cells 0 = Γ.start := by have hread : c.input.read = Γ.ofBool (x[k]'hk) := by - show c.input.cells c.input.head = _ + change c.input.cells c.input.head = _ rw [hinput_head, hinput_cells] exact Tape.init_ofBool_cells_lt x k hk have hstart : c.input.read ≠ Γ.start := by @@ -766,7 +766,7 @@ private theorem inputLengthPlusOneCounterTM_scan_blank_step (c'.work counterIdx).HasUnaryPrefix (x.length + 1) ∧ (c'.work counterIdx).cells 0 = Γ.start := by have hread : c.input.read = Γ.blank := by - show c.input.cells c.input.head = _ + change c.input.cells c.input.head = _ rw [hinput_head, hinput_cells] exact Tape.init_ofBool_cells_ge x x.length le_rfl simp only [TM.step, hstate, inputLengthPlusOneCounterTM, hread] @@ -792,15 +792,14 @@ private theorem inputLengthPlusOneCounterTM_rewind_step_left (c'.work counterIdx).cells = (c.work counterIdx).cells := by simp only [TM.step, hstate, inputLengthPlusOneCounterTM, hread] refine ⟨_, rfl, rfl, ?_, ?_, ?_⟩ - · show c.input.move (TM.idleDir c.input.read) = c.input + · change c.input.move (TM.idleDir c.input.read) = c.input exact TM.transitionInput_eq_self hinp · by_cases h0 : (c.work counterIdx).head = 0 · simp [counterRewindDirs, moveLeftDir, hread, Tape.writeAndMove, Tape.move, Tape.write, h0] · simp [counterRewindDirs, moveLeftDir, hread, Tape.writeAndMove, Tape.move, Tape.write, h0] - · simp [counterRewindDirs, moveLeftDir, hread, - Tape.writeAndMove, Tape.move_cells] + · simp only [Tape.writeAndMove, Tape.move_cells] change ((c.work counterIdx).write ((readBackWrite (c.work counterIdx).read).toΓ)).cells = (c.work counterIdx).cells @@ -828,7 +827,7 @@ private theorem inputLengthPlusOneCounterTM_rewind_step_base exact hnostart (c.work counterIdx).head (by omega) (by rwa [Tape.read] at hread) simp only [TM.step, hstate, inputLengthPlusOneCounterTM, hread] refine ⟨_, rfl, rfl, ?_, ?_, ?_⟩ - · show c.input.move (TM.idleDir c.input.read) = c.input + · change c.input.move (TM.idleDir c.input.read) = c.input exact TM.transitionInput_eq_self hinp · simp [counterAdvanceDirs, Tape.writeAndMove, Tape.move, Tape.write, hhead] · simp [counterAdvanceDirs, Tape.writeAndMove, Tape.move_cells, Tape.write, hhead] @@ -858,8 +857,7 @@ private theorem inputLengthPlusOneCounterTM_rewind_loop (counterIdx : Fin n) : | succ h ih => intro c hstate hinp hcell0 hnostart hhead have hread : (c.work counterIdx).read ≠ Γ.start := by - simp [Tape.read, hhead] - exact hnostart (h + 1) (by omega) + simpa only [Tape.read, hhead] using hnostart (h + 1) (by omega) obtain ⟨c1, hstep, hstate1, hinput1_eq, hhead1, hcells1⟩ := inputLengthPlusOneCounterTM_rewind_step_left counterIdx c hstate hinp hread hcell0 hnostart have hinp1_ns : c1.input.read ≠ Γ.start := by @@ -1128,20 +1126,20 @@ private theorem inputLengthPlusOneCounterTM_step_preserves_started_other_work cases state with | scan => by_cases hstart : input.read = Γ.start - · simp [TM.step, inputLengthPlusOneCounterTM, hstart] at hstep + · simp only [TM.step, inputLengthPlusOneCounterTM, hstart] at hstep have hcfg := Option.some.inj hstep subst c' simpa [counterPreserveWork, counterIdleDirs] using Tape.writeAndMove_readBack_idle_of_ne_start (work passiveIdx) (by simpa [hpassive] using hpassive_read) · by_cases hblank : input.read = Γ.blank - · simp [TM.step, inputLengthPlusOneCounterTM, hblank] at hstep + · simp only [TM.step, inputLengthPlusOneCounterTM, hblank] at hstep have hcfg := Option.some.inj hstep subst c' simpa [counterWriteOneWork, counterAdvanceDirs, hne] using Tape.writeAndMove_readBack_idle_of_ne_start (work passiveIdx) (by simpa [hpassive] using hpassive_read) - · simp [TM.step, inputLengthPlusOneCounterTM, hstart, hblank] at hstep + · simp only [TM.step, inputLengthPlusOneCounterTM, hstart, hblank] at hstep have hcfg := Option.some.inj hstep subst c' simpa [counterWriteOneWork, counterAdvanceDirs, hne] using @@ -1149,13 +1147,13 @@ private theorem inputLengthPlusOneCounterTM_step_preserves_started_other_work (by simpa [hpassive] using hpassive_read) | rewind => by_cases hcounter : (work counterIdx).read = Γ.start - · simp [TM.step, inputLengthPlusOneCounterTM, hcounter] at hstep + · simp only [TM.step, inputLengthPlusOneCounterTM, hcounter] at hstep have hcfg := Option.some.inj hstep subst c' simpa [counterPreserveWork, counterAdvanceDirs, hne] using Tape.writeAndMove_readBack_idle_of_ne_start (work passiveIdx) (by simpa [hpassive] using hpassive_read) - · simp [TM.step, inputLengthPlusOneCounterTM, hcounter] at hstep + · simp only [TM.step, inputLengthPlusOneCounterTM, hcounter] at hstep have hcfg := Option.some.inj hstep subst c' simpa [counterPreserveWork, counterRewindDirs, hne] using @@ -1198,20 +1196,20 @@ private theorem inputLengthPlusOneCounterTM_step_preserves_started_blank_output cases state with | scan => by_cases hstart : input.read = Γ.start - · simp [TM.step, inputLengthPlusOneCounterTM, hstart] at hstep + · simp only [TM.step, inputLengthPlusOneCounterTM, hstart] at hstep have hcfg := Option.some.inj hstep subst c' simpa [hout] using Tape.writeAndMove_readBack_idle_of_ne_start output hout_read · by_cases hblank : input.read = Γ.blank - · simp [TM.step, inputLengthPlusOneCounterTM, hblank] at hstep + · simp only [TM.step, inputLengthPlusOneCounterTM, hblank] at hstep have hcfg := Option.some.inj hstep subst c' simpa [hout] using Tape.writeAndMove_readBack_idle_of_ne_start output hout_read - · simp [TM.step, inputLengthPlusOneCounterTM, hstart, hblank] at hstep + · simp only [TM.step, inputLengthPlusOneCounterTM, hstart, hblank] at hstep have hcfg := Option.some.inj hstep subst c' simpa [hout] using @@ -1219,13 +1217,13 @@ private theorem inputLengthPlusOneCounterTM_step_preserves_started_blank_output hout_read | rewind => by_cases hcounter : (work counterIdx).read = Γ.start - · simp [TM.step, inputLengthPlusOneCounterTM, hcounter] at hstep + · simp only [TM.step, inputLengthPlusOneCounterTM, hcounter] at hstep have hcfg := Option.some.inj hstep subst c' simpa [hout] using Tape.writeAndMove_readBack_idle_of_ne_start output hout_read - · simp [TM.step, inputLengthPlusOneCounterTM, hcounter] at hstep + · simp only [TM.step, inputLengthPlusOneCounterTM, hcounter] at hstep have hcfg := Option.some.inj hstep subst c' simpa [hout] using From 6ad666d07f54f3ad51a96c3ff87f80dd13a0674a Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Sat, 26 Sep 2026 04:22:51 +0000 Subject: [PATCH 45/49] Fix optimizer location syntax and scanner source aliases --- .../BeyondBethe/BeyondBethe/DirectedOptimizerOracle.lean | 5 ++--- .../RegisterStore/Machine/Instruction/Sim/Control.lean | 7 ++++--- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/LeanPool/BeyondBethe/BeyondBethe/DirectedOptimizerOracle.lean b/LeanPool/BeyondBethe/BeyondBethe/DirectedOptimizerOracle.lean index b2d5815a53..4d52f5da73 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/DirectedOptimizerOracle.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/DirectedOptimizerOracle.lean @@ -234,9 +234,8 @@ theorem directedNegativeObjectiveCoordinate_bounds · rw [directedNegativeObjectiveCoordinateUpper, directedNegativeObjectiveCoordinateLower] push_cast - norm_num only [Rat.cast_pow, Rat.cast_div, Rat.cast_one, - Rat.cast_ofNat] at hAweighted hXweighted hCweighted - hAweightBound hXweightBound hCweightBound hdyadic ⊢ + norm_num only [Rat.cast_pow, Rat.cast_div, Rat.cast_one, Rat.cast_ofNat] at + hAweighted hXweighted hCweighted hAweightBound hXweightBound hCweightBound hdyadic ⊢ nlinarith /-- Rational lower endpoint for the complete negative objective. -/ diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Sim/Control.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Sim/Control.lean index f699566be3..4de74a2712 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Sim/Control.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Sim/Control.lean @@ -114,11 +114,12 @@ private theorem controlCopy_entryScannerReady exact hcontrolResult.ready.lookup.scanner.resultStart parked := hfinalParked frame := by intro i _ _ _ _ _ _ _ _ _; rfl } - change (finalWork source).HasBinarySuffix [] - refine ⟨by omega, ?_, ?_, ?_⟩ + change (finalWork tapes.liftedSource).HasBinarySuffix [] + refine ⟨by rw [hsourceFinalHead]; omega, ?_, ?_, ?_⟩ · intro i hi simp at hi - · simpa [hsourceFinalHead, Nat.add_comm] using! hsourceFinalOutput.2 + · rw [hsourceFinalHead] + simpa only [List.length_nil, Nat.add_zero, Nat.add_comm] using hsourceFinalOutput.2 · intro j hj rw [hsourceCells] exact hsourceSuffix.2.2.2 j hj From 7eaff9e1bc5f42d447c4896c61db2606653e4119 Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Sat, 26 Sep 2026 04:25:39 +0000 Subject: [PATCH 46/49] Preserve cleanup phase let bindings during proof introduction --- .../Machine/Instruction/Sim/Internal.lean | 158 +++--------------- 1 file changed, 21 insertions(+), 137 deletions(-) diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Sim/Internal.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Sim/Internal.lean index 4e8c93d0bf..1b9c2f1640 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Sim/Internal.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Sim/Internal.lean @@ -375,13 +375,7 @@ private theorem bufferedCleanup_resetPhase (∀ (slot : Fin 7), resetWork (instructionCleanupResetTape tapes slot) = TM.resetBinaryBlank) := by - dsimp only - let targets := instructionCleanupResetTargets tapes - let resetBits := bufferedCleanupResetBitsAt tapes cleanupValues - remainingValue oldStore - let resetHeads := - instructionCleanupResetHeadBoundAt tapes sourceHeadBound - let resetWork := TM.resetBinaryWorkManyResult initialWork targets + intro targets resetBits resetHeads resetWork have hresetContentIndexed : ∀ slot, (initialWork (instructionCleanupResetTape tapes slot)).HasBinaryContent (bufferedCleanupResetBits cleanupValues remainingValue oldStore @@ -512,13 +506,7 @@ private theorem bufferedCleanup_rewindBufferPhase (nextBits.length + 1 + 2)) ∧ (rewoundWork tapes.liftedSource = TM.resetBinaryBlank) ∧ (∀ i, TM.Parked (rewoundWork i)) := by - dsimp only - intro hresetBuffer hresetParked hresetTarget - let nextBits := nextStore.flatMap Entry.encode - let targets := instructionCleanupResetTargets tapes - let resetWork := TM.resetBinaryWorkManyResult initialWork targets - let nextTape := (Tape.init (nextBits.map Γ.ofBool)).move Dir3.right - let rewoundWork := Function.update resetWork tapes.buffer nextTape + intro nextBits targets resetWork nextTape rewoundWork hresetBuffer hresetParked hresetTarget have hresetBufferContent : (resetWork tapes.buffer).HasBinaryContent nextBits := by rw [hresetBuffer] @@ -593,17 +581,8 @@ private theorem bufferedCleanup_copyPhase (copiedWork tapes.buffer = prefixTape) ∧ (copiedWork tapes.liftedSource = prefixTape) ∧ (∀ i, TM.Parked (copiedWork i)) := by - dsimp only - intro hrewoundSource hrewoundParked - let nextBits := nextStore.flatMap Entry.encode - let targets := instructionCleanupResetTargets tapes - let resetWork := TM.resetBinaryWorkManyResult initialWork targets - let nextTape := (Tape.init (nextBits.map Γ.ofBool)).move Dir3.right - let rewoundWork := Function.update resetWork tapes.buffer nextTape - let prefixTape := instructionCleanupPrefixTape nextBits - let copiedWork := Function.update - (Function.update rewoundWork tapes.buffer prefixTape) - tapes.liftedSource prefixTape + intro nextBits targets resetWork nextTape rewoundWork prefixTape copiedWork hrewoundSource + hrewoundParked let copyFrame : TM.TapePred (n + 1) := fun inp work out => inp = inp₀ ∧ out = out₀ ∧ ∀ i, i ≠ tapes.buffer → i ≠ tapes.liftedSource → @@ -732,21 +711,8 @@ private theorem bufferedCleanup_restoreSourcePhase sourceReadyWork i = resetWork i) ∧ (∀ i, TM.Parked (sourceReadyWork i)) ∧ (∀ i, TM.Parked (bufferResetWork i)) := by - dsimp only - intro hcopiedBuffer hcopiedSource hcopiedParked hresetParked - let nextBits := nextStore.flatMap Entry.encode - let targets := instructionCleanupResetTargets tapes - let resetWork := TM.resetBinaryWorkManyResult initialWork targets - let nextTape := (Tape.init (nextBits.map Γ.ofBool)).move Dir3.right - let rewoundWork := Function.update resetWork tapes.buffer nextTape - let prefixTape := instructionCleanupPrefixTape nextBits - let copiedWork := Function.update - (Function.update rewoundWork tapes.buffer prefixTape) - tapes.liftedSource prefixTape - let bufferResetWork := Function.update copiedWork tapes.buffer - ((Tape.init []).move Dir3.right) - let sourceReadyWork := Function.update bufferResetWork tapes.liftedSource - nextTape + intro nextBits targets resetWork nextTape rewoundWork prefixTape copiedWork bufferResetWork + sourceReadyWork hcopiedBuffer hcopiedSource hcopiedParked hresetParked have hresetBufferRaw := TM.resetBinaryWorkTM_hoareTime_frame tapes.buffer nextBits (nextBits.length + 1) inp₀ copiedWork out₀ (by @@ -879,25 +845,9 @@ private theorem bufferedCleanup_copyCountPhase inp = inp₀ ∧ work = sourceReadyWork ∧ out = out₀) (fun inp work out => inp = inp₀ ∧ work = finalWork ∧ out = out₀) (TM.binaryCopyTime nextStore.length 0)) := by - dsimp only - intro hsourceReadyOutside hresetDataOutside hresetTarget hsourceReadyParked - let nextBits := nextStore.flatMap Entry.encode - let targets := instructionCleanupResetTargets tapes - let resetWork := TM.resetBinaryWorkManyResult initialWork targets - let nextTape := (Tape.init (nextBits.map Γ.ofBool)).move Dir3.right - let rewoundWork := Function.update resetWork tapes.buffer nextTape - let prefixTape := instructionCleanupPrefixTape nextBits - let copiedWork := Function.update - (Function.update rewoundWork tapes.buffer prefixTape) - tapes.liftedSource prefixTape - let bufferResetWork := Function.update copiedWork tapes.buffer - ((Tape.init []).move Dir3.right) - let sourceReadyWork := Function.update bufferResetWork tapes.liftedSource - nextTape - let countTape := - (Tape.init (nextStore.length.bits.map Γ.ofBool)).move Dir3.right - let finalWork := Function.update sourceReadyWork - tapes.lifted.data.update.remaining countTape + intro nextBits targets resetWork nextTape rewoundWork prefixTape copiedWork bufferResetWork + sourceReadyWork countTape finalWork hsourceReadyOutside hresetDataOutside hresetTarget + hsourceReadyParked have hresultCount : (sourceReadyWork tapes.lifted.data.update.resultCount).HasBinaryNat nextStore.length := by @@ -995,25 +945,9 @@ private theorem bufferedCleanup_finalFrame (finalWork tapes.liftedSource = nextTape) ∧ (finalWork tapes.buffer = (Tape.init []).move Dir3.right) ∧ (∀ i, TM.Parked (finalWork i)) := by - dsimp only - intro hsourceReadyOutside hresetDataOutside hresetTarget hsourceReadyParked - let nextBits := nextStore.flatMap Entry.encode - let targets := instructionCleanupResetTargets tapes - let resetWork := TM.resetBinaryWorkManyResult initialWork targets - let nextTape := (Tape.init (nextBits.map Γ.ofBool)).move Dir3.right - let rewoundWork := Function.update resetWork tapes.buffer nextTape - let prefixTape := instructionCleanupPrefixTape nextBits - let copiedWork := Function.update - (Function.update rewoundWork tapes.buffer prefixTape) - tapes.liftedSource prefixTape - let bufferResetWork := Function.update copiedWork tapes.buffer - ((Tape.init []).move Dir3.right) - let sourceReadyWork := Function.update bufferResetWork tapes.liftedSource - nextTape - let countTape := - (Tape.init (nextStore.length.bits.map Γ.ofBool)).move Dir3.right - let finalWork := Function.update sourceReadyWork - tapes.lifted.data.update.remaining countTape + intro nextBits targets resetWork nextTape rewoundWork prefixTape copiedWork bufferResetWork + sourceReadyWork countTape finalWork hsourceReadyOutside hresetDataOutside hresetTarget + hsourceReadyParked have hfinalDataOutside (role : Fin 18) (hremaining : role ≠ 9) (hsource : role ≠ 0) : finalWork (tapes.lifted.data.idx role) = @@ -1130,25 +1064,9 @@ private theorem bufferedCleanup_finalScanner (∀ i, TM.Parked (finalWork i)) → (EntryScanReady tapes.lifted.data.update.entry nextBits [] finalWork finalWork) := by - dsimp only - intro hfinalSource hfinalPreservedData hfinalReset hblankNat hfinalParked - let nextBits := nextStore.flatMap Entry.encode - let targets := instructionCleanupResetTargets tapes - let resetWork := TM.resetBinaryWorkManyResult initialWork targets - let nextTape := (Tape.init (nextBits.map Γ.ofBool)).move Dir3.right - let rewoundWork := Function.update resetWork tapes.buffer nextTape - let prefixTape := instructionCleanupPrefixTape nextBits - let copiedWork := Function.update - (Function.update rewoundWork tapes.buffer prefixTape) - tapes.liftedSource prefixTape - let bufferResetWork := Function.update copiedWork tapes.buffer - ((Tape.init []).move Dir3.right) - let sourceReadyWork := Function.update bufferResetWork tapes.liftedSource - nextTape - let countTape := - (Tape.init (nextStore.length.bits.map Γ.ofBool)).move Dir3.right - let finalWork := Function.update sourceReadyWork - tapes.lifted.data.update.remaining countTape + intro nextBits targets resetWork nextTape rewoundWork prefixTape copiedWork bufferResetWork + sourceReadyWork countTape finalWork hfinalSource hfinalPreservedData hfinalReset hblankNat + hfinalParked have hfinalScanner : EntryScanReady tapes.lifted.data.update.entry nextBits [] finalWork finalWork := by let entry := tapes.lifted.data.update.entry @@ -1252,25 +1170,8 @@ private theorem bufferedCleanup_finalLookup (EntryScanReady tapes.lifted.data.lhsLookup.scan.entry nextBits [] finalWork finalWork) := by - dsimp only - intro hsourceReadyOutside hfinalScanner hfinalParked - let nextBits := nextStore.flatMap Entry.encode - let targets := instructionCleanupResetTargets tapes - let resetWork := TM.resetBinaryWorkManyResult initialWork targets - let nextTape := (Tape.init (nextBits.map Γ.ofBool)).move Dir3.right - let rewoundWork := Function.update resetWork tapes.buffer nextTape - let prefixTape := instructionCleanupPrefixTape nextBits - let copiedWork := Function.update - (Function.update rewoundWork tapes.buffer prefixTape) - tapes.liftedSource prefixTape - let bufferResetWork := Function.update copiedWork tapes.buffer - ((Tape.init []).move Dir3.right) - let sourceReadyWork := Function.update bufferResetWork tapes.liftedSource - nextTape - let countTape := - (Tape.init (nextStore.length.bits.map Γ.ofBool)).move Dir3.right - let finalWork := Function.update sourceReadyWork - tapes.lifted.data.update.remaining countTape + intro nextBits targets resetWork nextTape rewoundWork prefixTape copiedWork bufferResetWork + sourceReadyWork countTape finalWork hsourceReadyOutside hfinalScanner hfinalParked have hfinalPC : finalWork tapes.liftedPC = initialWork tapes.liftedPC := by rw [show finalWork tapes.liftedPC = sourceReadyWork tapes.liftedPC by exact Function.update_of_ne (tapes.lifted.pc_ne 9) _ _] @@ -1376,33 +1277,16 @@ private theorem bufferedCleanup_finalReady (finalWork tapes.buffer = (Tape.init []).move Dir3.right) → (InstructionExecutionReady tapes nextStore nextPC finalWork) := by - dsimp only - intro hfinalLookupScanner hfinalSource hfinalPreservedData hfinalReset - hblankNat hfinalPC hfinalBuffer - let nextBits := nextStore.flatMap Entry.encode - let targets := instructionCleanupResetTargets tapes - let resetWork := TM.resetBinaryWorkManyResult initialWork targets - let nextTape := (Tape.init (nextBits.map Γ.ofBool)).move Dir3.right - let rewoundWork := Function.update resetWork tapes.buffer nextTape - let prefixTape := instructionCleanupPrefixTape nextBits - let copiedWork := Function.update - (Function.update rewoundWork tapes.buffer prefixTape) - tapes.liftedSource prefixTape - let bufferResetWork := Function.update copiedWork tapes.buffer - ((Tape.init []).move Dir3.right) - let sourceReadyWork := Function.update bufferResetWork tapes.liftedSource - nextTape - let countTape := - (Tape.init (nextStore.length.bits.map Γ.ofBool)).move Dir3.right - let finalWork := Function.update sourceReadyWork - tapes.lifted.data.update.remaining countTape + intro nextBits targets resetWork nextTape rewoundWork prefixTape copiedWork bufferResetWork + sourceReadyWork countTape finalWork hfinalLookupScanner hfinalSource hfinalPreservedData + hfinalReset hblankNat hfinalPC hfinalBuffer have hfinalReady : InstructionExecutionReady tapes nextStore nextPC finalWork := by refine { canonical := hready.nextCanonical control := { lookup := - { scanner := by simpa [nextBits] using hfinalLookupScanner + { scanner := hfinalLookupScanner sourceStart := by change (finalWork tapes.liftedSource).cells 0 = Γ.start rw [hfinalSource] From 05a5db4f54a99619477ee96d31f0cafde51f8630 Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Sat, 26 Sep 2026 04:41:44 +0000 Subject: [PATCH 47/49] Fix directed bound tactic locations and empty suffix index --- .../BeyondBethe/BeyondBethe/DirectedOptimizerOracle.lean | 6 ++++-- .../RegisterStore/Machine/Instruction/Sim/Control.lean | 2 +- 2 files changed, 5 insertions(+), 3 deletions(-) diff --git a/LeanPool/BeyondBethe/BeyondBethe/DirectedOptimizerOracle.lean b/LeanPool/BeyondBethe/BeyondBethe/DirectedOptimizerOracle.lean index 4d52f5da73..fda642f6dc 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/DirectedOptimizerOracle.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/DirectedOptimizerOracle.lean @@ -234,8 +234,10 @@ theorem directedNegativeObjectiveCoordinate_bounds · rw [directedNegativeObjectiveCoordinateUpper, directedNegativeObjectiveCoordinateLower] push_cast - norm_num only [Rat.cast_pow, Rat.cast_div, Rat.cast_one, Rat.cast_ofNat] at - hAweighted hXweighted hCweighted hAweightBound hXweightBound hCweightBound hdyadic ⊢ + norm_num only [Rat.cast_pow, Rat.cast_div, Rat.cast_one, + Rat.cast_ofNat] at hAweighted hXweighted hCweighted + norm_num only [Rat.cast_pow, Rat.cast_div, Rat.cast_one, + Rat.cast_ofNat] at hAweightBound hXweightBound hCweightBound hdyadic ⊢ nlinarith /-- Rational lower endpoint for the complete negative objective. -/ diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Sim/Control.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Sim/Control.lean index 4de74a2712..9baa75ae71 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Sim/Control.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Instruction/Sim/Control.lean @@ -119,7 +119,7 @@ private theorem controlCopy_entryScannerReady · intro i hi simp at hi · rw [hsourceFinalHead] - simpa only [List.length_nil, Nat.add_zero, Nat.add_comm] using hsourceFinalOutput.2 + simpa only [List.length_nil, Nat.add_zero] using hsourceFinalOutput.2 · intro j hj rw [hsourceCells] exact hsourceSuffix.2.2.2 j hj From a7e61adc94fe8c1e2ec404ac6886724879d7eb4e Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Sat, 26 Sep 2026 07:25:24 +0000 Subject: [PATCH 48/49] fix(BeyondBethe): qualify Turing-machine configurations --- .../RegisterStore/Machine/Program/DenseInitProof.lean | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseInitProof.lean b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseInitProof.lean index 1445db8a51..11f6abc6ca 100644 --- a/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseInitProof.lean +++ b/LeanPool/BeyondBethe/Complexitylib/Models/RandomAccessMachine/Simulation/RegisterStore/Machine/Program/DenseInitProof.lean @@ -281,7 +281,8 @@ private theorem denseProgramInitialStore_eq (input : List Bool) : private theorem denseInit_sequence_parked {tapeCount : ℕ} (first second : TM tapeCount) {firstTime secondTime : ℕ} - {initial middle : Cfg tapeCount first.Q} {final : Cfg tapeCount second.Q} + {initial middle : Complexity.Cfg tapeCount first.Q} + {final : Complexity.Cfg tapeCount second.Q} (hfirst : first.reachesIn firstTime initial middle) (hhalt : first.halted middle) (hsecond : second.reachesIn secondTime From 8671478d792b39071ebf57157b5aa1e046e3346d Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Sat, 26 Sep 2026 07:56:53 +0000 Subject: [PATCH 49/49] fix: apply generic Boolean matrix memory correctness directly --- LeanPool/BeyondBethe/BeyondBethe/MachineBooleanMemory.lean | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/LeanPool/BeyondBethe/BeyondBethe/MachineBooleanMemory.lean b/LeanPool/BeyondBethe/BeyondBethe/MachineBooleanMemory.lean index 0b6e12601c..7583f84ac8 100644 --- a/LeanPool/BeyondBethe/BeyondBethe/MachineBooleanMemory.lean +++ b/LeanPool/BeyondBethe/BeyondBethe/MachineBooleanMemory.lean @@ -82,8 +82,7 @@ theorem machineBoolMatrixEntryAtUnary_mem_FP : (pair (List.replicate i true) (pair (List.replicate j true) (boolMatrixCode M))) = [M[i][j]] := by - simpa only [machineBoolMatrixEntryAtUnary, boolMatrixCode, boolVectorCode, boolElementCode] using - machineNestedMatrixEntryAtUnary_encode boolElementCode M i j hi hj + exact machineNestedMatrixEntryAtUnary_encode boolElementCode M i j hi hj /-- Input: `pair rowUnary (pair columnUnary (pair replacementBit boolMatrixCode))`. -/ @@ -102,8 +101,7 @@ theorem machineBoolMatrixUpdateAtUnary_mem_FP : (pair (List.replicate j true) (pair [replacement] (boolMatrixCode M)))) = boolMatrixCode (M.set i (M[i].set j replacement)) := by - simpa only [machineBoolMatrixUpdateAtUnary, boolMatrixCode, boolVectorCode, boolElementCode] using - machineNestedMatrixUpdateAtUnary_encode boolElementCode M i j replacement hi hj + exact machineNestedMatrixUpdateAtUnary_encode boolElementCode M i j replacement hi hj /-! ## Rational support queries -/